!AColorSelectorMorph commentStamp: 'gvc 5/18/2007 13:52'!
ColorComponentSelector showing an alpha gradient over a hatched background.!
!AColorSelectorMorph methodsFor: 'initialization' stamp: 'gvc 9/26/2006 11:54'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		value: 1.0;
		color: Color black! !

!AColorSelectorMorph methodsFor: 'drawing' stamp: 'gvc 9/19/2006 14:28'!
drawOn: aCanvas
	"Draw a hatch pattern first."

	aCanvas
		fillRectangle: self innerBounds
		fillStyle: (InfiniteForm with: self hatchForm).
	super drawOn: aCanvas
! !

!AColorSelectorMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/6/2015 18:11'!
drawOnAthensCanvas: anAthensCanvas
	anAthensCanvas setPaint: (InfiniteForm with: self hatchForm).
	anAthensCanvas drawShape: self innerBounds.
	super drawOnAthensCanvas: anAthensCanvas! !

!AColorSelectorMorph methodsFor: 'protocol' stamp: 'gvc 9/3/2009 13:43'!
defaultFillStyle
	"Answer the hue gradient."

	^(GradientFillStyle colors: {self color alpha: 0. self color})
		origin: self topLeft;
		direction: (self bounds isWide
					ifTrue: [self width@0]
					ifFalse: [0@self height])! !

!AColorSelectorMorph methodsFor: 'visual properties' stamp: 'gvc 9/19/2006 15:46'!
fillStyle: fillStyle
	"If it is a color then override with gradient."
	
	fillStyle isColor
		ifTrue: [self color: fillStyle]
		ifFalse: [super fillStyle: fillStyle]! !

!AColorSelectorMorph methodsFor: 'accessing' stamp: 'gvc 9/3/2009 13:43'!
color: aColor
	"Set the gradient colors."
	
	super color: aColor asNontranslucentColor.
	self fillStyle: self defaultFillStyle! !

!AColorSelectorMorph methodsFor: 'private' stamp: 'gvc 9/22/2006 09:17'!
hatchForm
	"Answer a form showing a grid hatch pattern."

	^ColorPresenterMorph hatchForm! !

!AGroupHasBeenAdded commentStamp: 'TorstenBergmann 2/4/2014 21:09'!
Notify that a group has been added!
!AGroupHasBeenAdded class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 4/14/2011 16:32'!
group: aGroup into: anHolder

	^ self group: aGroup from: anHolder! !

!AGroupHasBeenCreated commentStamp: 'TorstenBergmann 2/4/2014 21:09'!
Notify that a group has been created!
!AGroupHasBeenRegistered commentStamp: 'TorstenBergmann 2/4/2014 21:09'!
Notify that a group has been registered!
!AGroupHasBeenRegistered class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 4/14/2011 13:40'!
with: aGroup

	^ self new group: aGroup! !

!AGroupHasBeenRemoved commentStamp: 'TorstenBergmann 2/4/2014 21:10'!
Notify that a group has been removed!
!AGroupHasBeenRenamed commentStamp: 'TorstenBergmann 2/4/2014 21:10'!
Notify that a group has been renamed!
!AGroupHasBeenUnregistered commentStamp: 'TorstenBergmann 2/4/2014 21:10'!
Notify that a group has been unregistered!
!AGroupHasBeenUnregistered class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 4/14/2011 13:40'!
with: aGroup

	^ self new group: aGroup! !

!AJAlignmentInstruction commentStamp: '<historical>'!
I am a pseudo instruction used to align the following instruction to a multiple of a given byte number.

Example:
	asm := AJx64Assembler noStackFrame.
	
	"align the following instruction to a word (2bytes)"
	asm alignWord.
	asm inc: asm RAX.
	
	"align the following instruction to a double (4bytes)"
	asm alignDouble.
	asm inc: asm RAX.
	
	"align the following instruction to a QuadWord (8bytes)"
	asm alignQuad.
	asm inc: asm RAX.
	
	"align the following instruction to a multiple of an arbirary count"
	asm align: 64.
	asm inc: asm RAX.!
!AJAlignmentInstruction methodsFor: 'alignment' stamp: 'CamilloBruni 4/12/2012 13:50'!
alignDouble
	self align: 4! !

!AJAlignmentInstruction methodsFor: 'alignment' stamp: 'CamilloBruni 4/12/2012 13:50'!
alignQuad
	self align: 8! !

!AJAlignmentInstruction methodsFor: 'accessing' stamp: 'MarcusDenker 12/12/2014 12:21'!
printSelfOn: aStream  
	self align <= 1 ifTrue: [ ^ self ].
	
	aStream nextPut: $|.
	self align <= 8 
		ifTrue: [
			self align timesRepeat: [
				aStream nextPutAll: '----|']]
		ifFalse: [
			aStream 
				nextPutAll: (self align asString padLeftTo: 4 with: $ );
				nextPut: $|]! !

!AJAlignmentInstruction methodsFor: 'initialization' stamp: ''!
initialize 
	super initialize.
	self alignByte.! !

!AJAlignmentInstruction methodsFor: 'visitor' stamp: 'CamilloBruni 4/12/2012 13:38'!
accept: anObject
	self shouldBeImplemented ! !

!AJAlignmentInstruction methodsFor: 'alignment' stamp: 'CamilloBruni 4/12/2012 13:50'!
alignWord
	self align: 2! !

!AJAlignmentInstruction methodsFor: 'emitting code' stamp: 'CamilloBruni 4/12/2012 13:44'!
emitCode: asm
	| padding |
	
	padding := self paddingForPosition: position.
	
	"new machine code: | padding |"
	machineCode := ByteArray new: padding .! !

!AJAlignmentInstruction methodsFor: 'accessing' stamp: ''!
align
	^ alignTo! !

!AJAlignmentInstruction methodsFor: 'alignment' stamp: 'CamilloBruni 4/12/2012 13:50'!
alignByte
	self align: 1! !

!AJAlignmentInstruction methodsFor: 'emitting code' stamp: 'CamilloBruni 4/12/2012 13:50'!
paddingForPosition: aPositionNumber
	| padding |
	
	padding := aPositionNumber \\ self align.
	padding = 0 
		ifFalse: [ padding := self align - padding ].
		
	^ padding! !

!AJAlignmentInstruction methodsFor: 'accessing' stamp: 'CamilloBruni 4/12/2012 13:56'!
name
	^ String streamContents: [ :s|
		self printSelfOn: s]! !

!AJAlignmentInstruction methodsFor: 'accessing' stamp: ''!
align: bytesSize
	"align the data to the given byte count"
	alignTo := bytesSize! !

!AJAlignmentInstruction class methodsFor: 'instance creation' stamp: ''!
alignDouble
	^ self new alignDouble! !

!AJAlignmentInstruction class methodsFor: 'instance creation' stamp: ''!
alignQuad
	^ self new alignQuad! !

!AJAlignmentInstruction class methodsFor: 'instance creation' stamp: 'CamilloBruni 4/12/2012 13:50'!
align: byteSize
	^ self new align: byteSize! !

!AJAlignmentInstruction class methodsFor: 'instance creation' stamp: ''!
alignWord
	^ self new alignWord! !

!AJAssembler commentStamp: 'TorstenBergmann 1/30/2014 09:08'!
Common superclass for assemblers. 

Add a subclass for each specific processor architecures (x86, ...)  !
!AJBaseReg commentStamp: 'MartinMcClure 1/27/2013 09:59'!
AJBaseReg  -- abstract superclass of all register operands.

Instance Variables:
	size	<Number>  Width in bytes (1, 2, 4, 8...)
	code	<Integer>  Non-negative integer, encoding varies with subclass. For AJx86GPRegisters, ten bits: xyttttnnnn
						where nnnn is the register number 0-15, tttt is the "type", which encodes size as a power of 2. 
						Higher types are used in other subclasses.
						If y is 1, REX prefix is required to encode this register.
						If x is 1, this register cannot be used when any REX prefix is present in the instruction.
	name	<Symbol>  Name by which this register may be referenced in instructions!
!AJBaseReg methodsFor: 'accessing' stamp: ''!
code
	"Answer the value of code"

	^ code! !

!AJBaseReg methodsFor: 'accessing' stamp: ''!
index
	^ code bitAnd: RegCodeMask! !

!AJBaseReg methodsFor: 'comparing' stamp: ''!
hash
	^ code hash! !

!AJBaseReg methodsFor: 'accessing' stamp: ''!
code: anObject
	"Set the value of code"

	code := anObject! !

!AJBaseReg methodsFor: 'accessing' stamp: 'CamilloBruni 7/17/2012 11:07'!
description
	^ String streamContents: [ :s | self descriptionOn: s ].! !

!AJBaseReg methodsFor: 'accessing' stamp: ''!
size
	^ size! !

!AJBaseReg methodsFor: 'private' stamp: 'CamilloBruni 10/17/2012 15:54'!
basicAnnotation: anObject
	"private setter"
	annotation := anObject! !

!AJBaseReg methodsFor: 'initialize-release' stamp: 'MartinMcClure 1/27/2013 09:35'!
initializeWithCode: aRegisterCode name: aSymbol
	super initialize.
	self code: aRegisterCode.	"Also sets size"
	name := aSymbol! !

!AJBaseReg methodsFor: 'accessing' stamp: 'CamilloBruni 7/17/2012 11:24'!
influencingRegisters
	^ #()! !

!AJBaseReg methodsFor: 'accessing' stamp: 'CamilloBruni 10/17/2012 15:54'!
annotation: anObject
	"registers gereally are used as single instances, hence putting
	an annotation on the default register will change the annotation
	for all the users. To avoid that, the receiver is copied first"
	^ self copy
		basicAnnotation: anObject;
		yourself! !

!AJBaseReg methodsFor: 'comparing' stamp: ''!
= otherReg

	^ (self class == otherReg class) and: [ code = otherReg code ]! !

!AJBaseReg methodsFor: 'printing' stamp: 'CamilloBruni 7/17/2012 11:07'!
descriptionOn: aStream
	self subclassResponsibility! !

!AJBaseReg methodsFor: 'accessing' stamp: 'CamilloBruni 4/17/2012 17:59'!
type
	^ code bitAnd: RegTypeMask! !

!AJBaseReg methodsFor: 'testing' stamp: ''!
isGeneralPurpose
	self subclassResponsibility ! !

!AJBaseReg methodsFor: 'testing' stamp: ''!
isUpperBank
	"Used for emitting the REX Prefix Byte on 64bit machines"
	^ self index > 7! !

!AJBaseReg methodsFor: 'testing' stamp: 'MartinMcClure 1/27/2013 15:34'!
isX86
	self subclassResponsibility! !

!AJBaseReg methodsFor: 'accessing' stamp: ''!
name
	^ name! !

!AJBaseReg methodsFor: 'testing' stamp: 'MartinMcClure 1/27/2013 16:04'!
requiresRex 
	"Answer true if use of this register requires that the instruction have a REX prefix.
	This can be because the register cannot be accessed except with REX (high bank or 64-only low byte)
	or because the register is 64-bits wide"
	
	^(code & RegRequiresRexMask) ~~ 0! !

!AJBaseReg methodsFor: 'testing' stamp: 'MartinMcClure 1/27/2013 16:04'!
prohibitsRex
	"Answer true if this register cannot be used in any instruction that has a REX prefix.
	Of the general-purpose registers, this is true only of SPL, BPL, SIL, DIL."

	^ (code & RegProhibitsRexMask) ~~ 0! !

!AJBaseReg class methodsFor: 'instance creation' stamp: ''!
code: aRegisterCode name: aSymbol
	^ self basicNew initializeWithCode: aRegisterCode name: aSymbol! !

!AJCallArgument commentStamp: 'TorstenBergmann 2/4/2014 21:38'!
Argument for a call!
!AJCallArgument methodsFor: 'accessing' stamp: ''!
size: aSmallInteger 

	size := aSmallInteger! !

!AJCallArgument methodsFor: 'accessing' stamp: ''!
size

	^ size ! !

!AJCallArgument methodsFor: 'accessing' stamp: ''!
instructionName
	^ #push! !

!AJCallArgument methodsFor: 'visitor' stamp: ''!
accept: anObject
	^ anObject visitCallArgument: self  ! !

!AJCallArgument methodsFor: 'function calls' stamp: ''!
prepareCallAlignments

	callInfo noticeArgument: self
! !

!AJCallArgument methodsFor: 'accessing' stamp: ''!
stackOffset: anOffset
	stackOffset := anOffset ! !

!AJCallArgument methodsFor: 'accessing' stamp: ''!
name
	^ 'argument push:'! !

!AJCallCleanup commentStamp: 'TorstenBergmann 2/4/2014 21:38'!
Cleanup for calls!
!AJCallCleanup methodsFor: 'accessing' stamp: ''!
name
	^ 'call cleanup'! !

!AJCallCleanup methodsFor: 'visitor' stamp: ''!
accept: anObject
	^ anObject visitCallCleanup: self! !

!AJCallCleanup methodsFor: 'function calls' stamp: ''!
prepareCallAlignments

	callInfo callCleanup: self
! !

!AJCallInfo commentStamp: 'TorstenBergmann 2/4/2014 21:36'!
Infos for a call!
!AJCallInfo methodsFor: 'accessing' stamp: ''!
callCleanup: aCallCleanup
	self assert: callCleanup isNil.
	
	callCleanup := aCallCleanup ! !

!AJCallInfo methodsFor: 'accessing' stamp: ''!
defaultArgumentSize
	self subclassResponsibility ! !

!AJCallInfo methodsFor: 'accessing' stamp: ''!
stackSize: anObject
	stackSize := anObject! !

!AJCallInfo methodsFor: 'accessing' stamp: ''!
noCleanup 
	^ noCleanup ! !

!AJCallInfo methodsFor: 'accessing' stamp: ''!
alignmentInsertionPoint: instruction
	alignInsertionPoint := instruction! !

!AJCallInfo methodsFor: 'accessing' stamp: ''!
noticeArgument: aCallArgument

	arguments add: aCallArgument.
	stackSize := stackSize + aCallArgument size.! !

!AJCallInfo methodsFor: 'accessing' stamp: ''!
asm: assembler
	asm := assembler! !

!AJCallInfo methodsFor: 'accessing' stamp: ''!
stackSize
	^ stackSize! !

!AJCallInfo methodsFor: 'initialization' stamp: ''!
initialize
	arguments := OrderedCollection new.
	stackSize := 0.
	stackAlignment := 1.
	noCleanup := false.! !

!AJCallInfo methodsFor: 'testing' stamp: ''!
needsAlignment
	^ stackAlignment > 1! !

!AJCallInfo methodsFor: 'accessing' stamp: ''!
disableCleanup 
	noCleanup := true! !

!AJCallInfo methodsFor: 'pushing args' stamp: ''!
push: anArgument
	
	asm pushArgument: anArgument forCall: self.
! !

!AJCallInfo methodsFor: 'accessing' stamp: ''!
name
	^ 'call info' ! !

!AJCallInfo methodsFor: 'accessing' stamp: ''!
alignment: aStackAlignment
	stackAlignment := aStackAlignment
! !

!AJCdeclCallInfo commentStamp: 'TorstenBergmann 2/4/2014 21:37'!
Infos for a class according to Cdecl spec!
!AJCdeclCallInfo methodsFor: 'accessing' stamp: ''!
defaultArgumentSize
	^ 4! !

!AJCdeclCallInfo methodsFor: 'emitting code' stamp: 'CamilloBruni 3/29/2012 14:01'!
alignedCleanup

	asm
		mov: savedSP to: asm ESP.
		
	asm releaseTemps: 1 "release our temp afterwards"  ! !

!AJCdeclCallInfo methodsFor: 'emitting code' stamp: ''!
normalCleanup 
	stackSize > 0 ifTrue: [
		asm
			add: asm ESP with: stackSize 
	]! !

!AJCdeclCallInfo methodsFor: 'emitting code' stamp: 'CamilloBruni 4/4/2012 16:57'!
emitAlignmentIfNeeded
	| alignment |
	
	self needsAlignment
		ifTrue: [ ^ self emitAlignment ].
		
	self emitCleanup! !

!AJCdeclCallInfo methodsFor: 'emitting code' stamp: 'CamilloBruni 7/23/2012 13:29'!
emitAlignment
	| instructions |
	
	instructions := asm
		instructionsFor: [ 
			asm
				decorateWith: 'align stack'
				during: [ 
					savedSP := asm reserveTemp annotation: 'saved SP'.
					asm mov: asm ESP to: savedSP.
					stackSize > 0
						ifTrue: [ asm sub: asm ESP with: (stackSize asUImm annotation: 'stack size') ].
					asm
						and: asm ESP with: stackAlignment - 1;
						neg: asm ESP;
						add: asm ESP with: savedSP ] ].
	
	asm insert: instructions after: alignInsertionPoint.
	self emitCleanup! !

!AJCdeclCallInfo methodsFor: 'emitting code' stamp: ''!
emitCleanup
	noCleanup ifTrue: [ ^ self ].
	
	asm insert: 
	(
			asm instructionsFor: [
			self needsAlignment 
				ifTrue: [ self alignedCleanup ]
				ifFalse: [ self normalCleanup ]  			
		]

	) after: callCleanup! !

!AJConstants commentStamp: 'TorstenBergmann 1/30/2014 08:58'!
A shared pool for constants from AsmJIT!
!AJConstants class methodsFor: 'initialization' stamp: 'MartinMcClure 1/27/2013 15:13'!
initialize

	"AJConstants initialize"
	
	"Operand is none, used only internally."
	OpNONE := 0.
	"Operand is register"
	OpREG := 1.
	"Operand is memory"
	OpMem := 2.
	"Operand is immediate."
	OpImm := 3.
	"Operand is label. "
	OpLabel := 4.

	RegTypeMask := 16rF0.
	RegCodeMask := 16r0F.
	RegRequiresRexMask := 16r100.
	RegProhibitsRexMask := 16r200.
	RegHighByteMask := 2r111100.
	
	"1 byte size."
	SizeByte := 1.
	"2 bytes size."
	SizeWord := 2.
	"4 bytes size."
	SizeDWord := 4.
	"8 bytes size."
	SizeQWord := 8.
	"10 bytes size."
	SizeTWord := 10.
	"16 bytes size."
	SizeDQWord := 16.


	"ID for AX/EAX/RAX registers."
	RIDEAX := 0.
	"ID for CX/ECX/RCX registers."
	RIDECX := 1.
	"ID for DX/EDX/RDX registers."
	RIDEDX := 2.
	"ID for BX/EBX/RBX registers."
	RIDEBX := 3.
	"ID for SP/ESP/RSP registers."
	RIDESP := 4.
	"ID for BP/EBP/RBP registers."
	RIDEBP := 5.
	"ID for SI/ESI/RSI registers."
	RIDESI := 6.
	"ID for DI/EDI/RDI registers."
	RIDEDI := 7.

	"8 bit general purpose register type."
	RegGPB := 16r00.
	"16 bit general purpose register type."
	RegGPW := 16r10.
	"32 bit general purpose register type."
	RegGPD := 16r20.
	"64 bit general purpose register type. "
	RegGPQ := 16r30.
	"X87 (FPU) register type. "
	RegX87 := 16r50.
	"64 bit mmx register type."
	RegMM := 16r60.
	"128 bit sse register type."
	RegXMM := 16r70.

	"Segment override prefixes."
	
	"No segment override prefix."
	SegmentNONE := 0.
	"Use 'cs' segment override prefix."
	SegmentCS := 1.
	"Use 'ss' segment override prefix."
	SegmentSS := 2.
	"Use 'ds' segment override prefix."
	SegmentDS := 3.
	"Use 'es' segment override prefix."
	SegmentES := 4.
	"Use 'fs' segment override prefix."
	SegmentFS := 5.
	"Use 'gs' segment override prefix."
	SegmentGS := 6.
  
	self initializePrefetchHints.
	self initializeConditionCodes.
	self initOpCodes.
	
! !

!AJConstants class methodsFor: 'initialization' stamp: ''!
initializePrefetchHints

	"Prefetch hints."

	"Prefetch to L0 cache."
	PrefetchT0 := 1.
	"Prefetch to L1 cache."
	PrefetchT1 := 2.
	"Prefetch to L2 cache."
	PrefetchT2  := 3.
	"Prefetch using NT hint."
	PrefetchNTA := 0.
! !

!AJConstants class methodsFor: 'initialization' stamp: ''!
initializeConditionCodes

	"Condition codes."

	"No condition code."
	CcNOCONDITION  := -1.

	"Condition codes from processor manuals."
	CcA             := 16r7.
	CcAE            := 16r3.
	CcB             := 16r2.
	CcBE            := 16r6.
	CcC             := 16r2.
	CcE             := 16r4.
	CcG             := 16rF.
	CcGE            := 16rD.
	CcL             := 16rC.
	CcLE            := 16rE.
	CcNA            := 16r6.
	CcNAE           := 16r2.
	CcNB            := 16r3.
	CcNBE           := 16r7.
	CcNC            := 16r3.
	CcNE            := 16r5.
	CcNG            := 16rE.
	CcNGE           := 16rC.
	CcNL            := 16rD.
	CcNLE           := 16rF.
	CcNO            := 16r1.
	CcNP            := 16rB.
	CcNS            := 16r9.
	CcNZ            := 16r5.
	CcO             := 16r0.
	CcP             := 16rA.
	CcPE            := 16rA.
	CcPO            := 16rB.
	CcS             := 16r8.
	CcZ             := 16r4.

	" Simplified condition codes"
	CcOVERFLOW      := 16r0.
	CcNOOVERFLOW   := 16r1.
	CcBELOW         := 16r2.
	CcABOVEEQUAL   := 16r3.
	CcEQUAL         := 16r4.
	CcNOTEQUAL     := 16r5.
	CcBELOWEQUAL   := 16r6.
	CcABOVE         := 16r7.
	CcSIGN          := 16r8.
	CcNOTSIGN      := 16r9.
	CcPARITYEVEN   := 16rA.
	CcPARITYODD    := 16rB.
	CcLESS          := 16rC.
	CcGREATEREQUAL := 16rD.
	CcLESSEQUAL    := 16rE.
	CcGREATER       := 16rF.

	"aliases"
	CcZERO          := 16r4.
	CcNOTZERO      := 16r5.
	CcNEGATIVE      := 16r8.
	CcPOSITIVE      := 16r9.

	"x87 floating point only"
	CcFPUNORDERED  := 16.
	CcFPNOTUNORDERED := 17.


! !

!AJConstants class methodsFor: 'initialization' stamp: 'CamilloBruni 3/29/2012 13:49'!
initOpCodes


  " x86 "
  OG8          := 16r01.
  OG16         := 16r02.
  OG32         := 16r04.
  OG64         := 16r08.
  OMEM         := 16r40.
  OIMM         := 16r80.

  O64Only      := 16r100.

  OG8163264    := OG64  + OG32  + OG16  + OG8.
  OG163264     := OG64  + OG32  + OG16.
  OG3264       := OG64  + OG32.

  " x87"
  OFM1        := 16r01.
  OFM2        := 16r02.
  OFM4        := 16r04.
  OFM8        := 16r08.
  OFM10       := 16r10.

  OFM24       := OFM2 + OFM4.
  OFM248      := OFM2 + OFM4 + OFM8.
  OFM48       := OFM4 + OFM8.
  OFM4810     := OFM4 + OFM8 + OFM10.

  " mm|xmm"
  ONOREX      := 16r01. " Used by MMX/SSE instructions. OG8 is never used for them "
  OMM         := 16r10.
  OXMM        := 16r20.

  OMMMEM      := OMM   + OMEM.
  OXMMMEM     := OXMM  + OMEM.
  OMMXMM      := OMM   + OXMM.
  OMMXMMMEM   := OMM   + OXMM  + OMEM.! !

!AJData commentStamp: '<historical>'!
I represent a pure data section in an assembly instruction stream.

Example:
	asm := AJx64Assembler noStackFrame.
	
	"add a raw byte"
	asm db: 16rFF.
	
	"add a raw word"
	asm dw: #[16r34 16r12].
	
	"add a raw double"
	asm dw: #[16r78 16r56 16r34 16r12].
	
	"add a arbitrary sized data section with a byteArray"
	asm data: #[1 2 3 4 5 6 7 8 9 10 11 12 ].!
!AJData methodsFor: 'accessing' stamp: 'CamilloBruni 4/12/2012 14:22'!
data: aByteArray
	"the will be put in the executable."
	machineCode := aByteArray! !

!AJData methodsFor: 'testing' stamp: ''!
is16
	^ self size = 2! !

!AJData methodsFor: 'accessing' stamp: ''!
size
	^ self data size! !

!AJData methodsFor: 'visitor' stamp: ''!
accept: anObject
	anObject instructionData: self! !

!AJData methodsFor: 'accessing' stamp: 'CamilloBruni 4/12/2012 14:22'!
data
	^ machineCode! !

!AJData methodsFor: 'emitting code' stamp: 'CamilloBruni 4/12/2012 14:22'!
emitCode: asm
	machineCode ifNil: [ machineCode := #[] ]! !

!AJData methodsFor: 'testing' stamp: ''!
is32
	^ self size = 4! !

!AJData methodsFor: 'testing' stamp: ''!
is8
	^ self size = 1! !

!AJData methodsFor: 'testing' stamp: ''!
is64
	^ self size = 8! !

!AJData methodsFor: 'accessing' stamp: ''!
name
	name ifNotNil: [ ^ name ].
	
	"standard data sections"
	self is8 ifTrue: [ ^ 'db' ].
	self is16 ifTrue: [ ^ 'dw' ].
	self is32 ifTrue: [ ^ 'dd' ].! !

!AJData class methodsFor: 'instance creation' stamp: ''!
data: aDataByteArray
	^ self new
		data: aDataByteArray;
		yourself! !

!AJData class methodsFor: 'instance creation' stamp: ''!
byte: aByteValue
	^ self data: (ByteArray with: aByteValue)! !

!AJData class methodsFor: 'instance creation' stamp: ''!
label: aLabel data: aDataByteArray
	^ self new
		label: aLabel;
		data: aDataByteArray;
		yourself! !

!AJGeneratedCode commentStamp: 'TorstenBergmann 1/30/2014 09:09'!
Instances of this class include the bytes and labels generated by AsmJIT

|asm|
asm := AJx64Assembler noStackFrame.
asm neg: asm AL.
asm ret.
asm generatedCode !
!AJGeneratedCode methodsFor: 'initialization' stamp: ''!
initialize
	labels := Dictionary new.
	! !

!AJGeneratedCode methodsFor: 'output' stamp: ''!
saveToFile
	self saveToFile: 'asm.bin'! !

!AJGeneratedCode methodsFor: 'output' stamp: ''!
dumpWithLabels

	"dump the native code , interspersed with labels"
	
	| offsets i str |
	
	offsets := OrderedCollection new.

	labels keysAndValuesDo: [ :name :offset |
		offsets add: (offset -> name)
	].

	offsets := offsets sort: [:a :b | a key < b key ].
	
	str := String new writeStream.
	i := 0.
	
	offsets do: [:offset |
		i to: offset key -1 do: [:x | str nextPutAll: ((bytes at: i+1) printStringBase: 16 nDigits: 2) ; space. i:=i+1. ].
		str cr; nextPutAll: offset value; cr.
	].

	i to: bytes size-1 do: [:x | str nextPutAll: ((bytes at: i+1) printStringBase: 16 nDigits: 2) ; space. i := i + 1] .
	^ str contents! !

!AJGeneratedCode methodsFor: 'accessing' stamp: ''!
bytes: aBytes 

	bytes := aBytes
	
! !

!AJGeneratedCode methodsFor: 'initialize-release' stamp: 'CamilloBruni 4/4/2012 16:30'!
fromInstructions: instructions
	
	bytes := ByteArray new: 100 streamContents: [:stream|
		instructions do: [ :each |
			each extractLabels: [:name :pos | labels at: name put: pos ].
			each storeOn: stream ]].! !

!AJGeneratedCode methodsFor: 'printing' stamp: ''!
printOn: aStream

	bytes notNil ifTrue: [
		aStream nextPutAll: self dumpWithLabels
		
		]! !

!AJGeneratedCode methodsFor: 'accessing' stamp: ''!
bytes
	^ bytes! !

!AJGeneratedCode methodsFor: 'accessing' stamp: ''!
offsetAt: aLabelName
	^ labels at: aLabelName! !

!AJGeneratedCode methodsFor: 'output' stamp: ''!
saveToFile: fileName

	(FileStream forceNewFileNamed: fileName)  
		nextPutAll: bytes;
		close  ! !

!AJGeneratedCode methodsFor: 'accessing' stamp: ''!
labels: aLabels

	"turn labels into a simple name->offset pairs"
	aLabels keysAndValuesDo: [:name :lbl |
		labels at: name put: lbl paddedOffset ].
		! !

!AJGeneratedCode class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/25/2012 12:44'!
fromInstructions: instructions
	^ self new fromInstructions: instructions! !

!AJImmediate commentStamp: '<historical>'!
I am an immediate (constant integer) operand used by the assembler.

Example:
	"create an immediate from an integer"
	1 asImm.
	"implicitely use an immediate in an assembly instrution"
	asm := AJx64Assembler new.
	asm add: 1 to: asm RAX.
	!
!AJImmediate methodsFor: 'testing' stamp: ''!
isInt8
	^ size ifNil:  [ self fitsInSize: 1 ]
		ifNotNil: [ size = 1 ]! !

!AJImmediate methodsFor: 'converting' stamp: 'CamilloBruni 4/4/2012 16:52'!
asQWord
	"answer the 64bit word representing a value"
	(self fitsInSize: 8)
		ifFalse: [ Error signal: self asString, ' exceeds quadword (64bit) range' ].

	(self isSigned and: [ value < 0 ]) ifTrue: [ ^ (1<<64) + value ].
	
	^ value! !

!AJImmediate methodsFor: 'emitting code' stamp: 'CamilloBruni 4/4/2012 16:53'!
emitUsing: emitter size: aSize

	label ifNotNil: [
		"this will set the label offset"
		emitter setLabelPosition: label. 
	].

	aSize = 1 ifTrue: [ ^ emitter emitByte: self asByte ].
	aSize = 2 ifTrue: [ ^ emitter emitWord: self asWord ].
	aSize = 4 ifTrue: [ ^ emitter emitDWord: self asDWord ].
	aSize = 8 ifTrue: [ ^ emitter emitQWord: self asQWord ].
	
	self error: aSize asString, 'bytes is an invalid immediate value size'! !

!AJImmediate methodsFor: 'testing' stamp: 'CamilloBruni 4/4/2012 16:54'!
fitsInSize: aSize
	| maxSize |
	maxSize := 1 << (aSize * 8).

	self isUnsigned 
		ifTrue: [ ^ maxSize > value ].

	value < 0 
		ifTrue: [ ^ 0 - value <= (maxSize >> 1) ].
		
	^ value < (maxSize>>1)! !

!AJImmediate methodsFor: 'converting' stamp: 'CamilloBruni 4/4/2012 16:52'!
asDWord
	"answer the 32bit word representing a value"
	(self fitsInSize: 4)
		ifFalse: [ Error signal: self asString, ' exceeds doubleword (32bit) range' ].

	(self isSigned and: [ value < 0 ]) ifTrue: [ ^ (1<<32) + value ].
	
	^ value! !

!AJImmediate methodsFor: 'testing' stamp: ''!
isImm
	^ true! !

!AJImmediate methodsFor: 'testing' stamp: ''!
isSigned 
	^ isUnsigned not! !

!AJImmediate methodsFor: 'converting' stamp: ''!
asByte
	"answer the byte representing a value"
	(self fitsInSize: 1)
		ifFalse: [ Error signal: self asString, ' exceeds byte (8bit) range' ].

	(self isSigned and: [ value < 0 ]) ifTrue: [ ^ (1<<8) + value ].
	
	^ value! !

!AJImmediate methodsFor: 'initialization' stamp: ''!
initialize
	value := 0.
	isUnsigned := false.! !

!AJImmediate methodsFor: 'accessing' stamp: ''!
value
	^ value! !

!AJImmediate methodsFor: 'accessing' stamp: ''!
ivalue: aValue
	"signed integer value"
	value := aValue.
	isUnsigned := false.! !

!AJImmediate methodsFor: 'printing' stamp: 'CamilloBruni 10/5/2012 14:39'!
printOn: aStream
	aStream nextPut: $(.

	self printAnnotationOn: aStream.
	  
	value > 1000000 
		ifTrue: [ aStream nextPutAll: value hex]
		ifFalse: [ aStream print: value].

	aStream space.
		
	aStream nextPut: (
		self isSigned ifTrue: [ $i ] ifFalse: [ $u ]).

	size ifNotNil: [ aStream print: size].
	
	aStream nextPut: $).

	
! !

!AJImmediate methodsFor: 'accessing' stamp: ''!
label: aLabelName

	label := aLabelName! !

!AJImmediate methodsFor: 'testing' stamp: 'MartinMcClure 1/27/2013 15:53'!
requiresRex
	"Answer true if use of this operand requires that the instruction have a REX prefix."

	^ false! !

!AJImmediate methodsFor: 'accessing' stamp: ''!
uvalue: aValue
	"unsigned value"
	self assert: (aValue >=0).
	value := aValue.
	isUnsigned := true.! !

!AJImmediate methodsFor: 'testing' stamp: 'CamilloBruni 4/4/2012 16:54'!
isInt32
	  ^ value >= -2147483648 and: [ value <= 2147483647 ]
! !

!AJImmediate methodsFor: 'converting' stamp: ''!
asWord
	"answer the 16bit word representing a value"
	(self fitsInSize: 2)
		ifFalse: [ Error signal: self asString, ' value exceeds word (16bit) range' ].

	(self isSigned and: [ value < 0 ]) ifTrue: [ ^ (1<<16) + value ].
	
	^ value! !

!AJImmediate methodsFor: 'testing' stamp: 'MartinMcClure 1/27/2013 17:49'!
prohibitsRex 
	"Answer true if use of this operand requires that the instruction *not* have a REX prefix."

	^ false! !

!AJImmediate methodsFor: 'accessing' stamp: ''!
extractLabels: aBlock

	label ifNotNil: [ label extractLabels: aBlock ]    ! !

!AJImmediate methodsFor: 'accessing' stamp: ''!
size
	^ size! !

!AJImmediate methodsFor: 'accessing' stamp: ''!
sizeFor: anOperand
	"Check if I am a valid size to be used together with anOperand
	If so, I will use as much size as it"
	self assert: (self fitsInSize: anOperand size).
	^anOperand size! !

!AJImmediate methodsFor: 'converting' stamp: 'IgorStasenko 5/28/2012 01:54'!
ptr

	"turn receiver into a memory operand with absolute address == receiver"
	
	^ AJMem new displacement: self! !

!AJImmediate methodsFor: '*NativeBoost-core' stamp: 'IgorStasenko 11/18/2012 16:49'!
asNBExternalType: gen
	 
	^ NBFFIConst value: self! !

!AJImmediate methodsFor: 'testing' stamp: ''!
isUnsigned 
	^ isUnsigned! !

!AJImmediate methodsFor: 'accessing' stamp: ''!
size: aSize
	size := aSize! !

!AJImmediate methodsFor: 'accessing' stamp: ''!
relocMode
	^ relocMode ifNil: [#RelocNone ]! !

!AJImmediate methodsFor: 'testing' stamp: ''!
isZero
	^ value = 0! !

!AJImmediate class methodsFor: 'as yet unclassified' stamp: ''!
ivalue: aValue
	^ self new
		ivalue: aValue! !

!AJInstruction commentStamp: 'TorstenBergmann 1/30/2014 09:11'!
Implement machine code instructions!
!AJInstruction methodsFor: 'iterating' stamp: ''!
last
	"answer the last instruction in the list"
	| nn l |
	nn := self.
	[ (l := nn next) notNil ] whileTrue: [ nn := l ].
	^ nn! !

!AJInstruction methodsFor: 'accessing' stamp: ''!
insert: anInstructions

	| n |
	self halt.
	n := next.
	next := anInstructions.
	anInstructions do: [:each | each increaseLevel: level ].
	anInstructions last next: n! !

!AJInstruction methodsFor: 'printing' stamp: 'MartinMcClure 11/26/2012 18:54'!
printSelfOn: aStream 
	self printAnnotationOn: aStream.
	aStream nextPutAll: (self name ). "padRightTo: 4)."
	self printOperandsOn: aStream.
	self printMachineCodeOn: aStream! !

!AJInstruction methodsFor: 'printing' stamp: ''!
printStringLimitedTo: aNumber
	^ String streamContents: [:s | self printOn: s] ! !

!AJInstruction methodsFor: 'testing' stamp: ''!
isLabelUsed: anAJJumpLabel
	^ false! !

!AJInstruction methodsFor: 'testing' stamp: ''!
hasLabel
	self shouldBeImplemented.! !

!AJInstruction methodsFor: 'accessing' stamp: ''!
next
	^ next! !

!AJInstruction methodsFor: 'helpers' stamp: ''!
find: aByteString 
	self shouldBeImplemented.! !

!AJInstruction methodsFor: 'accessing' stamp: ''!
level
	^ level! !

!AJInstruction methodsFor: 'accessing' stamp: ''!
position: anObject
	position := anObject! !

!AJInstruction methodsFor: 'accessing' stamp: ''!
annotation
	^ annotation! !

!AJInstruction methodsFor: 'accessing' stamp: ''!
annotation: anObject
	annotation := anObject! !

!AJInstruction methodsFor: 'accessing' stamp: ''!
increaseLevel: num
	level := level + num! !

!AJInstruction methodsFor: 'initialization' stamp: ''!
initialize
	level := 0! !

!AJInstruction methodsFor: 'printing' stamp: 'CamilloBruni 7/16/2012 15:29'!
printOperandsOn: aStream 
	(operands notNil
			and: [operands isEmpty not])
		ifTrue: [aStream space; nextPut: $(.
			operands
				do: [ :operand | operand printAsOperandOn: aStream]
				separatedBy: [aStream space].
			aStream nextPut: $)]! !

!AJInstruction methodsFor: 'visitor' stamp: ''!
accept: anObject
	self subclassResponsibility! !

!AJInstruction methodsFor: 'printing' stamp: 'CamilloBruni 7/16/2012 15:24'!
printOn: aStream  
"[ ^self ] value."

	self printListOn: aStream asLineStream! !

!AJInstruction methodsFor: 'visitor' stamp: ''!
setPrologue: anInstrucitons
	"do nothing"! !

!AJInstruction methodsFor: 'accessing' stamp: ''!
machineCodeSize
	^ machineCode ifNil: [ 0 ] ifNotNil: [ machineCode size ]! !

!AJInstruction methodsFor: 'emitting code' stamp: ''!
emitCodeAtOffset: offset assembler: asm

	position := offset.
	self emitCode: asm.
	next ifNotNil: [ next emitCodeAtOffset: offset + self machineCodeSize assembler: asm ].! !

!AJInstruction methodsFor: 'helpers' stamp: 'MartinMcClure 1/27/2013 17:40'!
checkOperandsForConflict
	"Subclasses may signal an error here."! !

!AJInstruction methodsFor: 'accessing' stamp: 'MartinMcClure 2/9/2013 14:30'!
operands: anObject
	operands := anObject! !

!AJInstruction methodsFor: 'accessing' stamp: ''!
operands
	^ operands! !

!AJInstruction methodsFor: 'accessing' stamp: ''!
extractLabels: aBlock

	operands ifNotNil: [ operands do: [:each | each extractLabels: aBlock ]]! !

!AJInstruction methodsFor: 'printing' stamp: ''!
storeOn: aStream
	"store machine code to binary stream"
	machineCode ifNotNil: [
		aStream nextPutAll: machineCode   
		]! !

!AJInstruction methodsFor: 'emitting code' stamp: ''!
emitCode: asm
	machineCode := #[]
! !

!AJInstruction methodsFor: 'manipulating' stamp: ''!
insert: newInstruction before: anInstruction
	
	"replace a single instruction with one or more other instructions"
	| instr  anext |
	
	anInstruction == self ifTrue: [
		newInstruction last next: self.
		^ newInstruction ].
	
	instr := self.
	[ (anext := instr next) notNil and: [ anext ~~ anInstruction ]] whileTrue: [ instr := anext ].

	instr next ifNotNil: [
		newInstruction do: [:each | 
			each increaseLevel: instr level  
			].
		newInstruction last next: instr next.
		instr next: newInstruction ].  ! !

!AJInstruction methodsFor: 'accessing' stamp: ''!
next: anObject
	next := anObject! !

!AJInstruction methodsFor: 'printing' stamp: 'CamilloBruni 7/16/2012 15:27'!
printListOn: aStream
	
	self printIndentOn: aStream.
	self printSelfOn: aStream.
	
	next ifNotNil: [
		aStream cr.
		next printListOn: aStream 
		]! !

!AJInstruction methodsFor: 'accessing' stamp: ''!
level: aLevel
	level := aLevel ! !

!AJInstruction methodsFor: 'manipulating' stamp: ''!
replace: anInstruction with: otherInstructions
	
	"replace a single instruction with one or more other instructions"
	| instr |
	
	anInstruction == self ifTrue: [
		otherInstructions last next: self next.
		^ otherInstructions ].
	
	instr := self.
	[ instr notNil and: [instr next ~~ anInstruction ]] whileTrue: [ instr := instr next ].
	instr notNil ifTrue: [
		otherInstructions last next: instr next next.
		instr next: otherInstructions 
		].  ! !

!AJInstruction methodsFor: 'accessing' stamp: ''!
instructionName 
	^ name! !

!AJInstruction methodsFor: 'iterating' stamp: ''!
do: aBlock
	"evaluate all instructions for the list"
	| nn |
	nn := self.
	[ nn notNil ] whileTrue: [
		aBlock value: nn.
		nn := nn next.
	].! !

!AJInstruction methodsFor: 'accessing' stamp: ''!
name: anObject
	name := anObject! !

!AJInstruction methodsFor: 'accessing' stamp: ''!
position
	^ position! !

!AJInstruction methodsFor: 'function calls' stamp: ''!
prepareCallAlignments
	"do nothing"! !

!AJInstruction methodsFor: 'printing' stamp: 'CamilloBruni 10/12/2012 11:40'!
printMachineCodeOn: aStream 
	(machineCode isNil
			or: [machineCode isEmpty])
		ifTrue: [^ self].
	aStream padColumn: 65;
		 nextPutAll: '#['.
	machineCode 
		do: [ :byte | 
			byte printOn: aStream base: 16 length: 2 padded: true ]
		separatedBy: [ aStream space ].
	aStream nextPut: $]! !

!AJInstruction methodsFor: 'printing' stamp: 'CamilloBruni 7/23/2012 16:44'!
printIndentOn: aStream 
	level ifNil: [ ^ self ].
	level timesRepeat: [ aStream nextPutAll: '|   ']! !

!AJInstruction methodsFor: 'visitor' stamp: ''!
processTempsWith: anObject
	"do nothing"! !

!AJInstruction methodsFor: 'accessing' stamp: ''!
name
	^ name
		ifNil: ['undefined']! !

!AJInstruction methodsFor: 'printing' stamp: 'CamilloBruni 7/16/2012 15:33'!
printAnnotationOn: aStream 
	annotation
		ifNil: [^ self].
	aStream nextPut: $";
		 nextPutAll: annotation asString;
		 nextPut: $";
		 cr.
	self printIndentOn: aStream! !

!AJInstructionDecoration commentStamp: 'TorstenBergmann 1/30/2014 09:16'!
Used to decorate instructions with annotations!
!AJInstructionDecoration methodsFor: 'accessing' stamp: ''!
end
	end := true! !

!AJInstructionDecoration methodsFor: 'printing' stamp: 'CamilloBruni 7/23/2012 16:42'!
printSelfOn: aStream  
	end 
		ifFalse: [ aStream nextPutAll: '/ "' ]
		ifTrue: [	aStream nextPutAll: '\ "end ' ].
	aStream  nextPutAll: annotation; nextPut: $".
	! !

!AJInstructionDecoration methodsFor: 'printing' stamp: 'CamilloBruni 7/23/2012 16:43'!
printIndentOn: aStream 
	end ifFalse: [ 
		super printIndentOn: aStream.
		aStream cr ].
	^ super printIndentOn: aStream! !

!AJInstructionDecoration methodsFor: 'visitor' stamp: ''!
accept: anObject
	anObject instructionDecoration: self! !

!AJInstructionDecoration methodsFor: 'accessing' stamp: ''!
start
	end := false! !

!AJJumpInstruction commentStamp: 'TorstenBergmann 1/30/2014 09:12'!
An assembler jump instruction including a jump label and a description!
!AJJumpInstruction methodsFor: 'printing' stamp: ''!
printSelfOn: aStream  
	aStream nextPutAll: name; space.
	label printSelfOn: aStream.
		
	machineCode ifNotNil: [
		aStream space; nextPut: $[ .
		machineCode do: [:byte | aStream nextPutAll: (byte printStringBase: 16)] separatedBy: [ aStream space ].
		aStream nextPut: $].	
	].

! !

!AJJumpInstruction methodsFor: 'accessing' stamp: 'CamilloBruni 4/17/2012 17:54'!
description
	^ description! !

!AJJumpInstruction methodsFor: 'accessing' stamp: ''!
label
	^ label! !

!AJJumpInstruction methodsFor: 'visitor' stamp: ''!
accept: anObject
	^ anObject jumpInstruction: self! !

!AJJumpInstruction methodsFor: 'testing' stamp: ''!
isLabelUsed: anAJJumpLabel
	^ label = anAJJumpLabel ! !

!AJJumpInstruction methodsFor: 'accessing' stamp: 'CamilloBruni 4/17/2012 17:55'!
description: anInstructionDescription
	description := anInstructionDescription! !

!AJJumpInstruction methodsFor: 'accessing' stamp: ''!
label: anObject
	label := anObject! !

!AJJumpInstruction methodsFor: 'accessing' stamp: ''!
codeSize
	^ machineCode size! !

!AJJumpLabel commentStamp: 'TorstenBergmann 1/30/2014 09:13'!
A label for a jump!
!AJJumpLabel methodsFor: 'accessing' stamp: ''!
isSet: anObject
	isSet := anObject! !

!AJJumpLabel methodsFor: 'printing' stamp: 'CamilloBruni 7/17/2012 14:48'!
printSelfOn: aStream
	aStream nextPutAll: '@@';
		nextPutAll: name asString ! !

!AJJumpLabel methodsFor: 'accessing' stamp: ''!
extractLabels: aBlock

	aBlock value: name value: position! !

!AJJumpLabel methodsFor: 'visitor' stamp: ''!
accept: anObject
	anObject jumpLabel: self! !

!AJJumpLabel methodsFor: 'accessing' stamp: ''!
isSet
	^ isSet == true! !

!AJJumpLabel methodsFor: 'emitting code' stamp: ''!
emitCode: asm
	! !

!AJJumpLabel methodsFor: 'printing' stamp: ''!
printOn: aStream
	
	aStream nextPutAll: '@@';
		nextPutAll: name asString ! !

!AJJumpLabel methodsFor: 'testing' stamp: 'CamilloBruni 8/22/2012 16:43'!
isLabel
	^ true! !

!AJJumpLabel methodsFor: 'printing' stamp: ''!
printAsOperandOn: aStream
	
	aStream nextPutAll: '@@';
		nextPutAll: name asString ! !

!AJLineStream commentStamp: 'TorstenBergmann 1/30/2014 09:10'!
Utility class implementing a specific stream for printing instructions!
!AJLineStream methodsFor: 'error handling' stamp: 'CamilloBruni 7/16/2012 14:59'!
doesNotUnderstand: aMessage
	writeStream 
		perform: aMessage selector 
		withArguments: aMessage arguments! !

!AJLineStream methodsFor: 'writing' stamp: ''!
lf
	self updateLineStart.
	writeStream lf! !

!AJLineStream methodsFor: 'writing' stamp: 'CamilloBruni 7/16/2012 15:23'!
padColumn: maxCharacterPosition
	"pad the current line up to maxCharacterPosition with spaces"
	[writeStream position - lineStart < maxCharacterPosition]
		whileTrue: [writeStream space]! !

!AJLineStream methodsFor: 'writing' stamp: ''!
crlf
	self updateLineStart.
	writeStream crlf! !

!AJLineStream methodsFor: 'writing' stamp: ''!
updateLineStart
	lineStart := writeStream position! !

!AJLineStream methodsFor: 'writing' stamp: 'CamilloBruni 7/16/2012 15:22'!
writeStream: aWriteStream 
	writeStream := aWriteStream.
	self updateLineStart! !

!AJLineStream methodsFor: 'writing' stamp: 'CamilloBruni 7/16/2012 15:00'!
on: aStream 
	^ self new 
		writeStream: aStream;
		yourself! !

!AJLineStream methodsFor: 'writing' stamp: ''!
cr
	self updateLineStart.
	writeStream cr! !

!AJLineStream class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/16/2012 15:33'!
on: aWriteStream 
	^ self new 
		writeStream: aWriteStream;
		yourself! !

!AJMMRegister commentStamp: '<historical>'!
I am register used for the MMX integer instructions on IA-32 processors.

MMX registers are 64Bit wide, depending on the instructions used the register is used either as 1 x 64bit value, 2 x 32bit values, 4 x 16bit values or 8 x 8bit values.

Note that the MMX register overlap with the floating point register and only use the lower 64bits of the 80bits FPU registers.!
!AJMMRegister methodsFor: 'testing' stamp: ''!
isRegTypeMM
	^ true! !

!AJMMRegister methodsFor: 'testing' stamp: ''!
isGeneralPurpose
	^ false! !

!AJMMRegister methodsFor: 'accessing' stamp: ''!
code: aCode

	code := aCode.
	size := 8.! !

!AJMMRegister methodsFor: 'accessing' stamp: 'CamilloBruni 5/7/2013 11:32'!
influencingRegisters
	"MMX registers overlap with the ST register"
	self shouldBeImplemented.! !

!AJMMRegister methodsFor: 'printing' stamp: 'CamilloBruni 7/17/2012 11:13'!
descriptionOn: s
	
	s nextPutAll: 'An MMX register'.! !

!AJMMRegister methodsFor: 'testing' stamp: 'MartinMcClure 1/27/2013 15:28'!
isX86
	^ true! !

!AJMem commentStamp: '<historical>'!
I am memory operand used in assembly instructions. I can be created from an immedate or a register.

Memory operands are used to read values indirectly from memory using certain offsets.

Example:
	asm := AJx86Assembler new.
	
	"create an memory operand on the address 1234"
	1234 asImm ptr
	
	"create a simple memory operand with RAX as base"
	asm RAX ptr.
	
	"the same with a 8 byte offset"
	asm RAX ptr + 8!
!AJMem methodsFor: 'testing' stamp: 'MartinMcClure 1/4/2013 22:14'!
hasUpperBankIndex
	"True iff I have an index register, and it is one of r8-r15"

	^ self hasIndex and: [ self index isUpperBank ]! !

!AJMem methodsFor: 'accessing' stamp: ''!
hasLabel
	"Answer the value of hasLabel"
	^ false! !

!AJMem methodsFor: 'testing' stamp: ''!
isRip
	^ self base isRip! !

!AJMem methodsFor: 'testing' stamp: ''!
hasBase
	^ base notNil! !

!AJMem methodsFor: 'accessing' stamp: ''!
displacement
	"Answer the value of displacement"

	^ displacement! !

!AJMem methodsFor: 'accessing' stamp: 'CamilloBruni 4/4/2012 16:45'!
+ displacementOrIndex

	displacementOrIndex isInteger 
		ifTrue: [ 
			self displacement: (AJImmediate new ivalue: displacementOrIndex).
			^ self ].
	
	displacementOrIndex isGeneralPurpose 
		ifTrue: [ 
			index := displacementOrIndex. 
			^ self ].
	
	 self error: 'Expected integer or general purpose register for memory displacement but got ', displacementOrIndex class name, '.'.! !

!AJMem methodsFor: 'accessing' stamp: 'CamilloBruni 4/4/2012 16:40'!
- aDisplacement

	aDisplacement isInteger 
		ifFalse: [ self error: 'Expected integer for memory displacement but got ', aDisplacement class name, '.' ].
	self displacement: (AJImmediate new ivalue: aDisplacement negated).
	^ self! !

!AJMem methodsFor: 'initialization' stamp: ''!
initialize
	displacement := AJImmediate new.
	shift := 0.! !

!AJMem methodsFor: 'printing' stamp: 'MartinMcClure 1/25/2013 22:21'!
printOn: aStream
	self printAnnotationOn: aStream.
	aStream nextPutAll: 'mem['.
	base
		ifNotNil: [ 
			base printAsMemBaseOn: aStream.
			(index isNil and: [ displacement isNil ])
				ifFalse: [ aStream nextPutAll: ' + ' ] ].
	index
		ifNotNil: [ 
			aStream nextPutAll: index registerName.
			self printScaleOn: aStream.
			displacement ifNotNil: [ aStream nextPutAll: ' + ' ] ].
	displacement ifNotNil: [ aStream print: displacement ].
	aStream nextPut: $]! !

!AJMem methodsFor: 'emitting' stamp: ''!
emitBaseDisplacementModRM: emitter code: rCode
	| mod |
	
	self base isRip
		ifTrue: [ 
			emitter emitMod: 0 reg: rCode rm: 2r101.
			displacement emitUsing: emitter size: 4.
			^ self ]. 
		
	mod := 0.
	displacement isZero
		ifFalse: [ 
			mod := displacement isInt8 ifTrue: [ 1 ] ifFalse: [ 2 ]].
		
	self base index == RIDESP
		ifTrue: [ 
			"ESP/RSP/R12"
			emitter emitMod: mod reg: rCode rm: RIDESP.
			emitter emitScale: 0 index: RIDESP base: RIDESP ]
		ifFalse: [ 
			(self base index ~= RIDEBP and: [ displacement isZero ])
				ifTrue: [ 
					"just base, and not EBP/RBP/R13 "
					^ emitter emitMod: 0 reg: rCode rm: base index ].
			"force emitting displacement"
			mod = 0ifTrue: [ mod := 1 ].
			emitter emitMod: mod reg: rCode rm: base index ].
			
	mod = 1 ifTrue: [ displacement emitUsing: emitter size: 1 ].
	mod = 2 ifTrue: [ displacement emitUsing: emitter size: 4 ].! !

!AJMem methodsFor: 'accessing' stamp: ''!
hasLabel: anObject
	"Set the value of hasLabel"

	hasLabel := anObject! !

!AJMem methodsFor: 'testing' stamp: 'MartinMcClure 1/27/2013 16:16'!
requiresRex
	"Answer true if use of this operand requires that the instruction have a REX prefix.
	For a memory reference, this is true if width of the transfer is 64, 
	or if either the base or index register is in the upper bank -- the
	use of a 64-bit base or index register is not enough by itself."

	^ self is64 or: [ (self hasBase and: [ base isUpperBank ]) or: [ self hasIndex and: [ index isUpperBank ] ] ]! !

!AJMem methodsFor: 'emitting' stamp: ''!
emit32BitAbsoluteDisplacementModRM: emitter code: rCode
	self hasIndex
		ifTrue: [ 
			self assert: index index ~= RIDESP.	" ESP/RSP"
			emitter emitMod: 0 reg: rCode rm: 4.
			emitter emitScale: shift index: index index base: 5 ]
		ifFalse: [ emitter emitMod: 0 reg: rCode rm: 5 ].
		
	self hasLabel
		ifTrue: [ 
			"X86 uses absolute addressing model, all relative addresses will be
			 relocated to absolute ones."
			"target is label"
			target
				addRelocationAt: emitter offset
				displacement: displacement
				absolute: true
				size: 4.
			emitter emitInt32: 0 ]
		ifFalse: [ 
			" Absolute address"
			displacement emitUsing: emitter size: 4 ]! !

!AJMem methodsFor: 'accessing' stamp: ''!
index
	"Answer the value of index"

	^ index! !

!AJMem methodsFor: 'testing' stamp: 'MartinMcClure 1/27/2013 17:49'!
prohibitsRex 
	"Answer true if use of this operand requires that the instruction *not* have a REX prefix."

	^ false! !

!AJMem methodsFor: 'testing' stamp: ''!
hasIndex
	^ index notNil! !

!AJMem methodsFor: 'accessing' stamp: 'MartinMcClure 1/27/2013 16:23'!
size

	^ size! !

!AJMem methodsFor: 'accessing' stamp: ''!
segmentPrefix
	"Answer the value of segmentPrefix"

	^ segmentPrefix! !

!AJMem methodsFor: 'accessing' stamp: ''!
base: anObject
	"Set the value of base"

	base := anObject! !

!AJMem methodsFor: 'accessing' stamp: ''!
shift
	"Answer the value of shift"

	^ shift! !

!AJMem methodsFor: 'emitting' stamp: 'MartinMcClure 1/4/2013 22:22'!
emitModRM: emitter code: rCode immSize: immSize
	"Receiver is memory location. rCode is a register number"

	"[base + displacement]"
	(self hasBase and: [ self hasIndex not ])
		ifTrue: [ ^ self emitBaseDisplacementModRM: emitter code: rCode ].	
	
	"[base + index * scale + displacement]"
	(self hasBase and: [ self hasIndex ])
		ifTrue: [ ^ self emitScaledBaseDisplacementModRM: emitter code: rCode ].
		
	" Address                       | 32-bit mode | 64-bit mode
   ------------------------------+-------------+---------------
   [displacement]                |   ABSOLUTE  | RELATIVE (RIP)
   [index * scale + displacemnt] |   ABSOLUTE  | ABSOLUTE (ZERO EXTENDED)
   In 32 bit mode is used absolute addressing model.
   In 64 bit mode is used relative addressing model together with absolute
   addressing one. The main problem is that if the instruction contains a SIB byte
   then relative addressing (RIP) is not possible. "
	emitter is32BitMode
		ifTrue: [ ^ self emit32BitAbsoluteDisplacementModRM: emitter code: rCode ].
			
	emitter is64BitMode
		ifTrue: [ self shouldBeImplemented ].
		
	self invalidInstruction! !

!AJMem methodsFor: 'testing' stamp: ''!
hasSegmentPrefix
	^ segmentPrefix notNil! !

!AJMem methodsFor: 'accessing' stamp: ''!
shift: value
	"Set the value of shift"
	self assert: (value >=0 and: [ value < 4 ]).
	shift := value! !

!AJMem methodsFor: 'accessing' stamp: ''!
size: anObject
	"Set the value of size"

	size := anObject! !

!AJMem methodsFor: 'accessing' stamp: ''!
segmentPrefix: anObject
	"Set the value of segmentPrefix"

	segmentPrefix := anObject! !

!AJMem methodsFor: 'accessing' stamp: ''!
base
	"Answer the value of base"

	^ base! !

!AJMem methodsFor: 'accessing' stamp: ''!
index: anIndex
	"Set the value of index, must be a general purpose register"
	self assert: (anIndex isGeneralPurpose).
	index := anIndex! !

!AJMem methodsFor: 'accessing' stamp: 'MartinMcClure 1/3/2013 21:15'!
scale: aScale
	"a valid scale values is 1 , 2 , 4 and 8"

	aScale = 1 ifTrue: [  shift := 0. ^ self ].	
	aScale = 2 ifTrue: [  shift := 1. ^ self ].	
	aScale = 4 ifTrue: [  shift := 2. ^ self ].	
	aScale = 8 ifTrue: [  shift := 3. ^ self ].	
		
	self error: 'invalid scale value'! !

!AJMem methodsFor: 'testing' stamp: ''!
isMem
	^ true! !

!AJMem methodsFor: 'testing' stamp: ''!
isUpperBank
	"see `AJBaseReg >> #isUpperBank` "
	^ self base isUpperBank! !

!AJMem methodsFor: 'accessing' stamp: ''!
displacement: anImm
	"Set the value of displacement"
	self assert: anImm isImm.
	displacement := anImm! !

!AJMem methodsFor: 'accessing' stamp: ''!
* aScale
	self scale: aScale! !

!AJMem methodsFor: 'emitting' stamp: ''!
emitScaledBaseDisplacementModRM: emitter code: rCode

	self assert: index index ~= RIDESP.
	(base index ~= RIDEBP and: [ displacement isZero ])
		ifTrue: [ 
			emitter emitMod: 0 reg: rCode rm: 4.
			^ emitter emitScale: shift index: index index base: base index ].
		
	displacement isInt8
		ifTrue: [ 
			emitter emitMod: 1 reg: rCode rm: 4.
			emitter emitScale: shift index: index index base: base index.
			displacement emitUsing: emitter size: 1 ]
		ifFalse: [ 
			emitter emitMod: 2 reg: rCode rm: 4.
			emitter emitScale: shift index: index index base: base index.
			displacement emitUsing: emitter size: 4 ].
	^ self! !

!AJMem methodsFor: 'printing' stamp: 'MartinMcClure 1/25/2013 22:22'!
printScaleOn: aStream
	aStream nextPutAll: ' * '.
	(2 raisedToInteger: shift) printOn: aStream! !

!AJOperand commentStamp: '<historical>'!
I am a generic operand used in the ASMJit assembler.
I define the interface for setting the final instruction code and annotations.!
!AJOperand methodsFor: 'accessing' stamp: ''!
compilerData
	^ compilerData! !

!AJOperand methodsFor: 'testing' stamp: ''!
is16
	^ self size == 2! !

!AJOperand methodsFor: 'converting' stamp: ''!
asAJOperand
	"receiver is already an operand. no nothing"! !

!AJOperand methodsFor: 'testing' stamp: ''!
isRegCode: aRegCode

	self shouldBeImplemented ! !

!AJOperand methodsFor: 'testing' stamp: ''!
isRegTypeMM
	^ false! !

!AJOperand methodsFor: 'testing' stamp: ''!
isRegTypeGPQ
	^ self isRegType: RegGPQ! !

!AJOperand methodsFor: 'testing' stamp: ''!
isRip
	^ false! !

!AJOperand methodsFor: 'accessing' stamp: ''!
size32
	^ self size: 4! !

!AJOperand methodsFor: 'testing' stamp: 'MartinMcClure 1/4/2013 22:15'!
hasUpperBankIndex
	"True iff I have an index register, and it is one of r8-r15"

	^ false	"Only can be true for memory references."! !

!AJOperand methodsFor: 'testing' stamp: ''!
isLabel

	^ false! !

!AJOperand methodsFor: 'testing' stamp: ''!
isRegTypeX87
	^ false! !

!AJOperand methodsFor: 'testing' stamp: ''!
isRegMem: aRegType

	self shouldBeImplemented ! !

!AJOperand methodsFor: 'accessing' stamp: ''!
annotation
	^ annotation! !

!AJOperand methodsFor: 'accessing' stamp: ''!
annotation: anObject
	annotation := anObject! !

!AJOperand methodsFor: 'testing' stamp: ''!
isImm

	^ false ! !

!AJOperand methodsFor: 'converting' stamp: 'IgorStasenko 5/28/2012 01:51'!
ptr16

	"turn receiver into a memory operand with receiver as base,
	with 2 bytes size"
	
	^ self ptr size: 2! !

!AJOperand methodsFor: 'converting' stamp: 'IgorStasenko 5/28/2012 01:52'!
ptr64

	"turn receiver into a memory operand with receiver as base,
	with 8 bytes size"
	
	^ self ptr size: 8! !

!AJOperand methodsFor: 'accessing' stamp: ''!
stackSize
	^ self size! !

!AJOperand methodsFor: 'accessing' stamp: ''!
clearId
	operandId := 0.! !

!AJOperand methodsFor: 'testing' stamp: ''!
isRegIndex: aRegIndex

	^ self isReg and: [ self index == (aRegIndex bitAnd: RegCodeMask ) ]
! !

!AJOperand methodsFor: 'testing' stamp: ''!
isRegTypeGPB
	^ self isRegType: RegGPB! !

!AJOperand methodsFor: 'testing' stamp: ''!
isRegTypeXMM
	^ false! !

!AJOperand methodsFor: 'printing' stamp: 'CamilloBruni 10/17/2012 15:57'!
printAsOperandOn: aStream
	self printAnnotationOn: aStream.
	^ self printOn: aStream ! !

!AJOperand methodsFor: 'code generation' stamp: ''!
emitPushOnStack: asm
	asm push: self! !

!AJOperand methodsFor: 'testing' stamp: ''!
is64
	^ self size == 8! !

!AJOperand methodsFor: 'testing' stamp: 'MartinMcClure 1/27/2013 15:54'!
requiresRex
	"Answer true if use of this operand requires that the instruction have a REX prefix."

	self subclassResponsibility! !

!AJOperand methodsFor: 'testing' stamp: 'MartinMcClure 1/27/2013 17:48'!
prohibitsRex
	"Answer true if use of this operand requires that the instruction *not* have a REX prefix."

	self subclassResponsibility! !

!AJOperand methodsFor: 'accessing' stamp: ''!
size16
	^ self size: 2! !

!AJOperand methodsFor: 'labels' stamp: ''!
extractLabels: aBlockClosure
	" do nothing"! !

!AJOperand methodsFor: 'converting' stamp: 'IgorStasenko 5/28/2012 01:52'!
ptr8

	"turn receiver into a memory operand with receiver as base,
	with 1 byte size"
	
	^ self ptr size: 1! !

!AJOperand methodsFor: 'testing' stamp: ''!
isRegTypeGPW
	^ self isRegType: RegGPW! !

!AJOperand methodsFor: 'testing' stamp: ''!
isRegMem

	^ self isReg or: [ self isMem ]! !

!AJOperand methodsFor: 'accessing' stamp: ''!
size
	"Return size of operand in bytes."
	
	self shouldBeImplemented ! !

!AJOperand methodsFor: 'converting' stamp: 'IgorStasenko 5/28/2012 01:52'!
ptr

	"turn receiver into a memory operand "
	
	self subclassResponsibility ! !

!AJOperand methodsFor: 'converting' stamp: 'IgorStasenko 5/28/2012 01:52'!
ptr32

	"turn receiver into a memory operand with receiver as base,
	with 4 bytes size"
	
	^ self ptr size: 4! !

!AJOperand methodsFor: 'testing' stamp: ''!
isRegType: aRegType

	^ self isReg and: [self type == aRegType]! !

!AJOperand methodsFor: 'accessing' stamp: ''!
size8
	^ self size: 1! !

!AJOperand methodsFor: 'testing' stamp: ''!
isNone
	"Return true if operand is none (OP_NONE)."
	self shouldBeImplemented ! !

!AJOperand methodsFor: 'testing' stamp: ''!
is32
	^ self size == 4! !

!AJOperand methodsFor: 'accessing' stamp: ''!
operandId
	^ operandId! !

!AJOperand methodsFor: 'testing' stamp: ''!
isReg

	^ false! !

!AJOperand methodsFor: 'testing' stamp: ''!
isMem

	^ false! !

!AJOperand methodsFor: 'accessing' stamp: ''!
size64
	^ self size: 8! !

!AJOperand methodsFor: 'testing' stamp: ''!
is8
	^ self size == 1! !

!AJOperand methodsFor: 'testing' stamp: ''!
isRegTypeGPD
	^ self isRegType: RegGPD! !

!AJOperand methodsFor: 'printing' stamp: 'CamilloBruni 8/24/2012 13:56'!
printAnnotationOn: aStream
	annotation ifNil: [ ^ self ].
	aStream 
		nextPut: $" ; 
		nextPutAll: annotation asString; 
		nextPut: $";  space.! !

!AJRegister commentStamp: '<historical>'!
I am an abstract superclass for the standard x86 registers.!
!AJRegister methodsFor: 'testing' stamp: ''!
isReg
	^ true! !

!AJRegister methodsFor: 'accessing' stamp: 'CamilloBruni 7/17/2012 12:43'!
influencingRegisters
	self is8
		ifFalse: [ ^ self as8 influencingRegisters ].
	^ { self as8. self as16. self as32. self as64}! !

!AJRegister methodsFor: 'accessing' stamp: ''!
code: aCode
	code := aCode.
	size :=  1 << (( code bitAnd: RegTypeMask ) >> 4).! !

!AJRegister methodsFor: 'accessing' stamp: ''!
size
	^ 1 << (( code bitAnd: RegTypeMask ) >> 4).! !

!AJRegister methodsFor: 'testing' stamp: ''!
isGeneralPurpose
	^ false! !

!AJRegister methodsFor: 'testing' stamp: 'MartinMcClure 1/30/2013 20:52'!
isX86
	"Return whether this register is available in the standard x86 instruction set"

	^ self requiresRex not & (self index < 8)! !

!AJReleaseTemps commentStamp: 'TorstenBergmann 2/4/2014 21:37'!
Handling release of temps!
!AJReleaseTemps methodsFor: 'printing' stamp: ''!
printSelfOn: aStream
	aStream nextPutAll: 'Release temps: ';
	print: count   ! !

!AJReleaseTemps methodsFor: 'accessing' stamp: ''!
count
	^ count! !

!AJReleaseTemps methodsFor: 'accessing' stamp: ''!
count: anObject
	count := anObject! !

!AJReleaseTemps methodsFor: 'visitor' stamp: ''!
accept: anObject
	anObject visitReleaseTemps: self   
! !

!AJReleaseTemps methodsFor: 'printing' stamp: ''!
printOn: aStream
	^ self printSelfOn: aStream  ! !

!AJReleaseTemps methodsFor: 'visitor' stamp: ''!
processTempsWith: anObject
	anObject releaseTemps: count! !

!AJReserveTemp commentStamp: 'IgorStasenko 1/18/2012 13:09'!
note: assembler should set size even before realizing a temp into stack location reference!
!AJReserveTemp methodsFor: 'printing' stamp: 'CamilloBruni 7/20/2012 13:29'!
printAsOperandOn: aStream
	
	annotation ifNotNil: [
		aStream nextPut: $"; nextPutAll: annotation asString; nextPut: $"; space
	].

	operands 
		ifNil: [ ^ aStream nextPutAll: 'aStackTEMP' ].
	self operand printAsOperandOn: aStream.! !

!AJReserveTemp methodsFor: 'visitor' stamp: ''!
processTempsWith: anObject
	anObject reserveTemp: self  ! !

!AJReserveTemp methodsFor: 'converting' stamp: ''!
asAJOperand
	
	^ operands first! !

!AJReserveTemp methodsFor: 'accessing' stamp: ''!
size
	^ size! !

!AJReserveTemp methodsFor: 'accessing' stamp: ''!
stackSize
	^ self size! !

!AJReserveTemp methodsFor: 'accessing' stamp: ''!
size: number
	size := number! !

!AJReserveTemp methodsFor: 'visitor' stamp: ''!
accept: anObject
	^ anObject reserveTemp: self! !

!AJReserveTemp methodsFor: 'printing' stamp: ''!
printOn: aStream
	^ self printSelfOn: aStream  ! !

!AJReserveTemp methodsFor: 'testing' stamp: ''!
isMem
	^ true! !

!AJReserveTemp methodsFor: 'accessing' stamp: ''!
operand: anObject
	anObject annotation: annotation.  
	operands := Array with: anObject ! !

!AJReserveTemp methodsFor: 'emitting code' stamp: ''!
emitPushOnStack: asm
	^ asm push: self! !

!AJReserveTemp methodsFor: 'accessing' stamp: 'CamilloBruni 8/24/2012 13:32'!
name
	^ name ifNil: [ 'Reserve temp' ]! !

!AJReserveTemp methodsFor: 'accessing' stamp: ''!
operand
	^ operands first! !

!AJReserveTemp methodsFor: 'testing' stamp: 'IgorStasenko 8/13/2013 13:45'!
prohibitsRex
"This test is used to validate if operand(s) is valid.. but reserve temp could not have an operand assigned yet and validation 
can be only performed at instruction analyzis stage (right before emitting the code), but not at instruction creation time"
	self flag: #todo. 
	^ false! !

!AJRoutineEpilogue commentStamp: 'TorstenBergmann 1/30/2014 09:15'!
In assembly language programming an epilogue is a few lines of code that appears at the end of a routine!
!AJRoutinePrologue commentStamp: 'IgorStasenko 5/11/2011 00:32'!
This is a pseudo-instruction to indicate a place in native code for routine prologue.
It is later replaced by real instructions which contain code for initializing stack frame & extra stack space required by routine.!
!AJRoutinePrologue methodsFor: 'visitor' stamp: 'CamilloBruni 10/4/2012 18:54'!
setPrologue: anInstructions
	"do nothing"
	| old |
	old := next.
	next := anInstructions.
	anInstructions last next: old ! !

!AJRoutinePrologue methodsFor: 'accessing' stamp: ''!
name
	^ 'prologue' ! !

!AJRoutinePrologue methodsFor: 'visitor' stamp: ''!
accept: anObject
	^ anObject visitRoutinePrologue: self! !

!AJRoutinePrologue methodsFor: 'emitting code' stamp: ''!
emitCode: asm
	machineCode := #[]! !

!AJRoutineStackManager commentStamp: 'TorstenBergmann 2/4/2014 21:37'!
Stack handling for routines!
!AJRoutineStackManager methodsFor: 'initialization' stamp: ''!
initialize
	self reset.
	noStackFrame := false.! !

!AJRoutineStackManager methodsFor: 'as yet unclassified' stamp: ''!
newStdCall
	self stackFrameCheck.
	^ calls add: (AJStdCallCallInfo new)
! !

!AJRoutineStackManager methodsFor: 'as yet unclassified' stamp: ''!
noStackFrame
	noStackFrame := true.! !

!AJRoutineStackManager methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 4/4/2012 16:33'!
analyzeInstructions: anInstructions assembler: asm
	
	instructions := anInstructions.
	assembler := asm.
	
	instructions do: #prepareCallAlignments.
		
	calls do: [:callInfo |
		callInfo asm: assembler.
		callInfo emitAlignmentIfNeeded ].

	instructions do: [:each | each processTempsWith: self].

	self emitPrologue.

	^ instructions ! !

!AJRoutineStackManager methodsFor: 'as yet unclassified' stamp: ''!
newCdeclCall 
	self stackFrameCheck.
	^ calls add: (AJCdeclCallInfo new)! !

!AJRoutineStackManager methodsFor: 'as yet unclassified' stamp: ''!
releaseTemps: count
	temps := temps - count! !

!AJRoutineStackManager methodsFor: 'initialize-release' stamp: ''!
reset
	instructions := nil.
	assembler := nil.
	calls := OrderedCollection new.
	temps := maxTemps := extraStackBytes := 0.
! !

!AJRoutineStackManager methodsFor: 'as yet unclassified' stamp: ''!
reserveExtraBytesOnStack: numBytes
	
	self stackFrameCheck.
	
	extraStackBytes := numBytes ! !

!AJRoutineStackManager methodsFor: 'emitting' stamp: ''!
emitPrologue

	noStackFrame == true ifTrue: [ ^self ]. 
	instructions do: [:each |
		each setPrologue: (assembler instructionsFor: [ | numBytes |
			assembler 
				push: assembler EBP;
				mov: assembler ESP to: assembler EBP.
				
			numBytes := extraStackBytes.
			numBytes := numBytes + (maxTemps * assembler wordSize ).
			 
			numBytes > 0 ifTrue: [
				(assembler 
					sub: assembler ESP with: numBytes) annotation:
						extraStackBytes asString , ' extra bytes + ' ,
						maxTemps asString , ' temps'
				]			
			]).
		]
! !

!AJRoutineStackManager methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/7/2013 19:06'!
reserveTemp: anAJReserveTemp
	self stackFrameCheck.
	temps := temps + 1.
	maxTemps := maxTemps max: temps .
	
	anAJReserveTemp operand: (assembler stackFrameValueAtOffset: extraStackBytes + (temps * assembler wordSize )).! !

!AJRoutineStackManager methodsFor: 'as yet unclassified' stamp: ''!
stackFrameCheck

	noStackFrame ifTrue: [
		self error: 'Operation requires stack frame management to be enabled for generated code'
		].! !

!AJRoutineStackManager methodsFor: 'as yet unclassified' stamp: ''!
emitEpilogue: popExtraBytes assembler: asm

	asm leave.
	
	popExtraBytes > 0 ifTrue: [
		asm ret: popExtraBytes asUImm
		]
	ifFalse: [
		asm ret.
		].! !

!AJStackAlignmentTests commentStamp: 'TorstenBergmann 2/4/2014 21:39'!
SUnit Tests for stack alignment!
!AJStackAlignmentTests methodsFor: 'tests' stamp: ''!
testNewProtocolForAlignedCalls

	| asm callInfo |
	
	asm := self newAssembler.
	
	
	asm cdeclCall:  [:call |

		call 
			push: EAX;
			push: EAX;
			push: 4.

		asm call: EAX.
		callInfo := call.
	] alignment: 32.
	
	
	asm generatedCode. "to analyze instructions"
	self assert: callInfo stackSize = 12.
	self assert: callInfo needsAlignment 

	! !

!AJStackAlignmentTests methodsFor: 'utility' stamp: ''!
newAssembler 
	^ AJx86Assembler new! !

!AJStackAlignmentTests methodsFor: 'tests' stamp: ''!
testJumps

	| asm callInfo |
	
	asm := self newAssembler.
	asm noStackFrame.
	
	asm jmp: #foo;
		nop;
		nop;
		nop;
		nop;
		nop;
		nop;
		nop;
		nop;
	label: #foo.
	
	^ asm generatedCode.! !

!AJStackInstruction commentStamp: 'TorstenBergmann 2/4/2014 21:37'!
Stack instructions!
!AJStackInstruction methodsFor: 'accessing' stamp: ''!
callInfo: anObject

	callInfo := anObject! !

!AJStackInstruction methodsFor: 'accessing' stamp: ''!
callInfo

	^ callInfo! !

!AJStdCallCallInfo commentStamp: 'IgorStasenko 8/5/2011 06:17'!
stdcall calling convention.
Used on windows. No need for stack cleanup after call. No need to align stack before making call.!
!AJStdCallCallInfo methodsFor: 'emitting code' stamp: ''!
emitAlignmentIfNeeded
	"do nothing"
	
	"stdcall calling convention requires no stack alignment, no stack cleanup after call"! !

!AJStdCallCallInfo methodsFor: 'emitting code' stamp: ''!
emitAlignment
	"do nothing"
	
	"stdcall calling convention requires no stack alignment, no stack cleanup after call"! !

!AJx64Assembler commentStamp: '<historical>'!
I am an assembler for the Intel x86-64 architecture.!
!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
R12W
	"A 16bit general purpose register
	This register overlaps with R12B, R12W, R12D, R12"
	^ R12W! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R9
	"A 64bit general purpose register
	This register overlaps with R9B, R9W, R9D, R9"
	^ R9! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
RCX
	"A 64bit general purpose register
	This register overlaps with CL, CX, ECX, RCX"
	^ RCX! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
RIP
	"A 64bit instruction pointer register
	This register overlaps with IP, EIP, RIP"
	^ RIP! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R10B
	"A 8bit general purpose register
	This register overlaps with R10B, R10W, R10D, R10"
	^ R10B! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'MartinMcClure 1/27/2013 20:55'!
SIL
	^ SIL! !

!AJx64Assembler methodsFor: 'register' stamp: ''!
basePointer
	^ RBP ! !

!AJx64Assembler methodsFor: 'accessing' stamp: ''!
numGPRegisters
	^ 16! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R14B
	"A 8bit general purpose register
	This register overlaps with R14B, R14W, R14D, R14"
	^ R14B! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R9D
	"A 32bit general purpose register
	This register overlaps with R9B, R9W, R9D, R9"
	^ R9D! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
XMM9
	"An SSE register"
	^ XMM9! !

!AJx64Assembler methodsFor: 'initialization' stamp: 'CamilloBruni 4/17/2012 18:16'!
initialize
	super initialize.
	is64 := true.! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R15W
	"A 16bit general purpose register
	This register overlaps with R15B, R15W, R15D, R15"
	^ R15W! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
R11
	"A 64bit general purpose register
	This register overlaps with R11B, R11W, R11D, R11"
	^ R11! !

!AJx64Assembler methodsFor: 'register' stamp: ''!
data
	^ RDX! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'MartinMcClure 1/27/2013 20:54'!
SPL
	^ SPL! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
R11D
	"A 32bit general purpose register
	This register overlaps with R11B, R11W, R11D, R11"
	^ R11D! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
R12D
	"A 32bit general purpose register
	This register overlaps with R12B, R12W, R12D, R12"
	^ R12D! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R10W
	"A 16bit general purpose register
	This register overlaps with R10B, R10W, R10D, R10"
	^ R10W! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
RDX
	"A 64bit general purpose register
	This register overlaps with DL, DX, EDX, RDX"
	^ RDX! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
XMM13
	"An SSE register"
	^ XMM13! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
R8B
	"A 8bit general purpose register
	This register overlaps with R8B, R8W, R8D, R8"
	^ R8B! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
R8
	"A 64bit general purpose register
	This register overlaps with R8B, R8W, R8D, R8"
	^ R8! !

!AJx64Assembler methodsFor: 'register' stamp: ''!
instructionPointer
	^ RIP! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
RDI
	"A 64bit general purpose register
	This register overlaps with BH, BX, EBX, RBX"
	^ RDI! !

!AJx64Assembler methodsFor: 'accessing' stamp: 'CamilloBruni 4/17/2012 18:17'!
instructionDesciptions
	^ AJx64InstructionDescription instructions! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
XMM8
	"An SSE register"
	^ XMM8! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
IP
	"A 16bit instruction pointer register
	This register overlaps with IP, EIP, RIP"
	^ IP! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
XMM12
	"An SSE register"
	^ XMM12! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
R12
	"A 64bit general purpose register
	This register overlaps with R12B, R12W, R12D, R12"
	^ R12! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
R8D
	"A 32bit general purpose register
	This register overlaps with R8B, R8W, R8D, R8"
	^ R8D! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R10D
	"A 32bit general purpose register
	This register overlaps with R10B, R10W, R10D, R10"
	^ R10D! !

!AJx64Assembler methodsFor: 'register' stamp: ''!
destinationIndex
	^ RDI! !

!AJx64Assembler methodsFor: 'accessing' stamp: 'CamilloBruni 4/18/2012 15:25'!
newInstruction
	^ AJx64Instruction new! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
R8W
	"A 16bit general purpose register
	This register overlaps with R8B, R8W, R8D, R8"
	^ R8W! !

!AJx64Assembler methodsFor: 'register' stamp: ''!
stackPointer
	^ RSP! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
XMM14
	"An SSE register"
	^ XMM14! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
RSP
	"A 64bit general purpose register
	This register overlaps with AH, AX, EAX, RAX"
	^ RSP! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
RBX
	"A 64bit general purpose register
	This register overlaps with BL, BX, EBX, RBX"
	^ RBX! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
RSI
	"A 64bit general purpose register
	This register overlaps with DH, DX, EDX, RDX"
	^ RSI! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
R15D
	"A 32bit general purpose register
	This register overlaps with R15B, R15W, R15D, R15"
	^ R15D! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
XMM15
	"An SSE register"
	^ XMM15! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R9W
	"A 16bit general purpose register
	This register overlaps with R9B, R9W, R9D, R9"
	^ R9W! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
R13B
	"A 8bit general purpose register
	This register overlaps with R13B, R13W, R13D, R13"
	^ R13B! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R14
	"A 64bit general purpose register
	This register overlaps with R14B, R14W, R14D, R14"
	^ R14! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
EIP
	"A 32bit instruction pointer register
	This register overlaps with IP, EIP, RIP"
	^ EIP! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R14W
	"A 16bit general purpose register
	This register overlaps with R14B, R14W, R14D, R14"
	^ R14W! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'MartinMcClure 1/27/2013 20:55'!
BPL
	^ BPL! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
R15
	"A 64bit general purpose register
	This register overlaps with R15B, R15W, R15D, R15"
	^ R15! !

!AJx64Assembler methodsFor: 'accessing' stamp: 'CamilloBruni 4/18/2012 15:24'!
newJumpInstruction
	^ AJx64JumpInstruction new! !

!AJx64Assembler methodsFor: 'register' stamp: ''!
sourceIndex
	^ RSI! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
XMM11
	"An SSE register"
	^ XMM11! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R14D
	"A 32bit general purpose register
	This register overlaps with R14B, R14W, R14D, R14"
	^ R14D! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
R12B
	"A 8bit general purpose register
	This register overlaps with R12B, R12W, R12D, R12"
	^ R12B! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R13D
	"A 32bit general purpose register
	This register overlaps with R13B, R13W, R13D, R13"
	^ R13D! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R10
	"A 64bit general purpose register
	This register overlaps with R10B, R10W, R10D, R10"
	^ R10! !

!AJx64Assembler methodsFor: 'register' stamp: ''!
counter
	^ RCX! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'MartinMcClure 1/27/2013 20:55'!
DIL
	^ DIL! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R13W
	"A 16bit general purpose register
	This register overlaps with R13B, R13W, R13D, R13"
	^ R13W! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R11W
	"A 16bit general purpose register
	This register overlaps with R11B, R11W, R11D, R11"
	^ R11W! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R11B
	"A 8bit general purpose register
	This register overlaps with R11B, R11W, R11D, R11"
	^ R11B! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R13
	"A 64bit general purpose register
	This register overlaps with R13B, R13W, R13D, R13"
	^ R13! !

!AJx64Assembler methodsFor: 'register' stamp: ''!
accumulator
	^ RAX! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
RAX
	"A 64bit general purpose register
	This register overlaps with AL, AX, EAX, RAX"
	^ RAX! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R15B
	"A 8bit general purpose register
	This register overlaps with R15B, R15W, R15D, R15"
	^ R15B! !

!AJx64Assembler methodsFor: 'accessing' stamp: ''!
pointerSize
	"see AJx86Assembler >> #pointerSize"
	^ 8! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
R9B
	"A 8bit general purpose register
	This register overlaps with R9B, R9W, R9D, R9"
	^ R9B! !

!AJx64Assembler methodsFor: 'testing' stamp: ''!
is32
	^ false! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
XMM10
	"An SSE register"
	^ XMM10! !

!AJx64Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
RBP
	"A 64bit general purpose register
	This register overlaps with CH, CX, ECX, RCX"
	^ RBP! !

!AJx64AssemblerTests commentStamp: 'TorstenBergmann 2/4/2014 21:39'!
SUnit tests for 64 bit assembler!
!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/1/2013 22:14'!
testAssemblyMemBaseDisp
	asm
		mov: RAX ptr + 1 -> EAX;
		mov: RBX ptr + ECX -> EAX.
	self assert: asm bytes = #(16r8B 16r40 16r01 16r8B 16r04 16r0B) asByteArray! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/25/2013 19:31'!
testCallInvalid
	"on 64 bit ..
	- only 32bit relative offset are allowed
	- only 64bit registers for indirect addresses"

	"relative calls with 64bit addresses are not supported"

	self asmShould: [ :a | a call: 16r123456789ABCDEF ] raise: Error.
	AJx86Registers generalPurpose
		do: [ :register | 
			register is64
				ifFalse: [ self asmShould: [ :a | a call: register ] raise: Error ]
				ifTrue: [ self deny: (self bytes: [ :a | a call: register ]) isEmpty ] ]! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'CamilloBruni 5/15/2012 14:19'!
testBitTest
	"8 Bit ====================================================="
	self asmShould: [ :a| a bt: a R8B with: 16r1. ] raise: Error.
	
	"16 bit ====================================================="
	"lower bank 16bit register opcode + ModR/M"
	self 
		assert: [ :a| a bt: a AX with: 16r01 ]
		bytes: #[ "16bit mode" 16r66  "OP" 16r0f 16rba "ModRM" 2r11100000 "immediate" 16r01].

	"upper bank 16bit register opcode + ModR/M"
	self 
		assert: [ :a| a bt: a R8W with: 16r01 ]
		bytes: #[ "16bit mode" 16r66 "REX" 2r01000001 "OP" 16r0f 16rba "ModRM" 2r11100000 "immediate" 16r01].
		
	"32 bit ====================================================="
	"lower bank 32bit register opcode + ModR/M"
	self 
		assert: [ :a| a bt: a EAX with: 16r01 ]
		bytes: #[ "OP" 16r0f 16rba "ModRM" 2r11100000 "immediate" 16r01].
	
	"upper bank 32bit register opcode + ModR/M"
	self 
		assert: [ :a| a bt: a R8D with: 16r01 ]
		bytes: #[ "REX" 2r01000001 "OP" 16r0f 16rba "ModRM" 2r11100000 "immediate" 16r01].
	
	"64 bit ====================================================="
	"lower bank 32bit register opcode + ModR/M"
	self 
		assert: [ :a| a bt: a RAX with: 16r01 ]
		bytes: #[ "REX" 2r01001000 "OP" 16r0f 16rba "ModRM" 2r11100000 "immediate" 16r01].
	
	"upper bank 32bit register opcode + ModR/M"
	self 
		assert: [ :a| a bt: a R8 with: 16r01 ]
		bytes: #[ "REX" 2r01001001 "OP" 16r0f 16rba "ModRM" 2r11100000 "immediate" 16r01].! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/1/2013 22:42'!
testPush
	"lower bank 64bit register"		
	self assert: [:a | a push: a RSP ]
		bytes: #[ 16r54 "16r50 + RSP index" ].! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/1/2013 22:42'!
testPop
	"lower bank 64bit register"		
	self assert: [:a | a pop: a RSP ]
		bytes: #[ 16r5c ].! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/1/2013 22:42'!
testNeg
	"8bit ======================================================"
	self 
		assert: [ :a | a neg: a AL]
		bytes: #[ 16rF6 "ModR/M" 2r11011000 ].
	"8bit upper bank with REX"
	self 
		assert: [ :a | a neg: a R8B]
		bytes: #[ 2r01000001 16rF6 "ModR/M" 2r11011000 ].
	
	"16bit with fallback ======================================="
	self 
		assert: [ :a | a neg: a AX]
		bytes: #[ 16r66 16rF7"ModR/M" 2r11011000 ].
	"16bit upper bank with REX"
	self 
		assert: [ :a | a neg: a R8W]
		bytes: #[ 16r66 2r01000001 16rF7"ModR/M" 2r11011000 ].
	"word 16bit IP relative "
	self 
		assert: [ :a | a neg: a IP ptr16 + 16r12345678]
		bytes: #[16r66 16rF7 "ModR/M"2r00011101 16r78 16r56 16r34 16r12].
		
	"32bit ===================================================="
	self 
		assert: [ :a | a neg: a EAX]
		bytes: #[ 16rF7"ModR/M" 2r11011000 ].
	"32bit upper bank with REX"
	self 
		assert: [ :a | a neg: a R8D]
		bytes: #[ 2r01000001 16rF7"ModR/M" 2r11011000 ].
	"negate double word 32bit EIP relative "
	self 
		assert: [ :a | a neg: a EIP ptr32 + 16r12345678]
		bytes: #[16rF7 "ModR/M"2r00011101 16r78 16r56 16r34 16r12].
		
	"64bit with REX =========================================="
	self 
		assert: [ :a | a neg: a RAX]
		bytes: #[ 2r01001000 16rF7 "ModR/M"2r11011000 ].
	"64bit upper bank"
	self 
		assert: [ :a | a neg: a R8]
		bytes: #[ 2r01001001 16rF7 "ModR/M"2r11011000 ].
	"negate quadword 64bit RIP relative "
	self 
		assert: [ :a | a neg: a RIP ptr64 + 16r12345678]
		bytes: #["REX"2r01001000 16rF7 "ModR/M"2r00011101 16r78 16r56 16r34 16r12].
		! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/1/2013 22:37'!
testMovMemory
	"mov memory to 8bit register =========================="
	self 
		assert: [:a | a mov: a RCX ptr to: a AL ] 
		bytes: #[16r8A 16r00000001 "ModR/M"].
	
! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/1/2013 22:37'!
testMovImmediate
	"8bit immediate to 8bit register"
	self 
		assert: [:a | a mov: 16r12 to: a AL ] 
		bytes: #[16rB0     16r12].
		
	"16bit immediate to 16bit register (requires 16bit fallback prefix)"
	self 
		assert: [:a | a mov: 16r1234 to: a AX ] 
		bytes: #[16r66 16rB8     16r34 16r12].
	
	"32bit immediate to 32bit register"
	self 
		assert: [:a | a mov: 16r12345678 to: a EAX ] 
		bytes: #[16rB8     16r78 16r56 16r34 16r12].
	
	"64bit immediate to 64bit register (requires REX prefix)"
	self 
		assert: [:a | a mov: 16r123456789ABCDEF0 to: a RAX ] 
		bytes: #[2r01001000 16rB8    16rF0 16rDE 16rBC 16r9A 16r78 16r56 16r34 16r12].
		
	"32bit immediate sign-extended to 64bit register (REX prefix)"
	self
		assert: [:a | a mov: 16r12345678 to: a RAX]
		bytes: #[ 2r01001000 16rc7 "ModR/M"16rc0    16r78 16r56 16r34 16r12 ]! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'HenrikSperreJohansen 2/26/2015 14:47'!
testStringOps64Mnemonics
	"Test that 64bit string operation mnemonics generate the same code as their noop versions"
	| mnemonicRegOpBytes mnemonicMemOpBytes |
	asm 
		movs: asm RAX;
		cmps: asm RAX;
		stos: asm RAX;
		lods: asm RAX;
		scas: asm RAX.
	mnemonicRegOpBytes := asm bytes.
	
	asm reset;
		movs: (AJMem new size: 8);
		cmps: (AJMem new size: 8);
		stos: (AJMem new size: 8);
		lods: (AJMem new size: 8);
		scas: (AJMem new size: 8).
	mnemonicMemOpBytes:= asm bytes.
	asm reset;
		movsq;
		cmpsq;
		stosq;
		lodsq;
		scasq.

self assert: mnemonicRegOpBytes equals: asm bytes.
self assert: mnemonicMemOpBytes equals: asm bytes.

"No 64bit locations allowed for ins/outs"
self should: [ asm reset; ins: RAX; bytes] raise: Error.
self should: [ asm reset; outs: RAX; bytes] raise: Error.! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/25/2013 20:53'!
testInvalidTest
	"In 64-bit mode, r/m8 cannot be encoded to access the following byte registers if an REX prefix is used: AH, BH, CH, DH."

	{AH.
	CH.
	DH.
	BH}
		do: [ :reg | 
			self deny: (self bytes: [ :a | a test: reg with: AL ]) isEmpty.
			self deny: (self bytes: [ :a | a test: AL with: reg ]) isEmpty.
			self deny: (self bytes: [ :a | a test: reg with: 16r12 ]) isEmpty.	"with an upper bank byte register => requires REX prefix"
			self asmShould: [ :a | a test: reg with: R8B ] raise: Error.
			self asmShould: [ :a | a test: R8B with: reg ] raise: Error.	"with a 64bit register requring again an REX prefix"
			self asmShould: [ :a | a test: reg with: RAX ] raise: Error.
			self asmShould: [ :a | a test: RAX with: reg ] raise: Error ]! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/1/2013 22:32'!
testAssemblyMemBase

	self 
		assert: [ :a | a mov: a RAX ptr to: a EAX ]
		bytes: #[ 16r8B 2r00000000 ].
		
	self 
		assert: [ :a | a mov: a RSP ptr to: a EAX]
		bytes: #[ 16r8B 16r04 16r24 ].
	self 
		assert: [ :a | a mov: a RBP ptr to: a EAX ]
		bytes: #[ 16r8B 16r45 16r00 ].! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 12/15/2012 13:13'!
testSyscall
	self assert: [ :a | a syscall ] bytes: #[16r0F 16r05]! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/1/2013 22:45'!
testXorFastCode
	self  "shortcut for AL + 8bit immedidate"
		assert: [ :a | a xor: a AL with: 16r12]
		bytes: #[ 16r34    16r12].
		
	self  "shortcut for AX + 16bit immedidate"
		assert: [ :a | a xor: a AX with: 16r1234]
		bytes: #[ 16r66 16r35    16r34 16r12].
		
	self  "shortcut for EAX + 16bit immedidate"
		assert: [ :a | a xor: a EAX with: 16r12345678]
		bytes: #[ 16r35    16r78 16r56 16r34 16r12].
		
	self  "shortcut for RAX + 32bit immedidate"
		assert: [ :a | a xor: a RAX with: 16r12345678]
		bytes: #[ 2r01001000 16r35    16r78 16r56 16r34 16r12].! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/1/2013 22:30'!
testAssembly0
	self assert: [ :a | a mov: 16rfeedface -> RAX ] 
		bytes: #[72 184 206 250 237 254 0 0 0 0]! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/26/2013 15:50'!
testHighByteRegistersInvalid
	"Can't access AH, BH, CH, DH if a REX byte is required.
	This test attempts to test every instruction supported by AsmJit that can access an 8-bit general-purpose register AND also require a REX prefix."

	| legacyHRegs op2codes opBothCodes mixedWidthOpCodes byteOperandsRequiringRex wideRegistersRequiringRex |
	legacyHRegs := {AH.
	CH.
	DH.
	BH}.
	opBothCodes := #(#adc:with: #add:with: #mov:to: #cmp:with: #or:with: #sbb:with: #sub:with #xchg:with: #xor:with:).
	op2codes := #(#cmpxchg:with: #test:with: #xadd:with:).
	mixedWidthOpCodes := #(#crc32:with: #movsx:to: #movzx:to:).
	wideRegistersRequiringRex := {RAX.
	R8D}.	"RAX requires REX.W, R8D requires REX.R or REX.B"
	byteOperandsRequiringRex := {SPL.
	BPL.
	SIL.
	DIL.
	R8B.
	(R8 ptr).
	(R8 ptr + 16r12).
	(R8 ptr + 16r1234).
	((RAX ptr + R8) * 2).
	((RAX ptr + R8) * 4 + 16r12).
	((RAX ptr + R8) * 8 + 16r1234)}.
	legacyHRegs
		do: [ :hreg | 
			byteOperandsRequiringRex
				do: [ :operand | 
					opBothCodes
						do: [ :opcode | 
							self asmShould: [ :a | a perform: opcode with: hreg with: operand ] raise: Error.
							self asmShould: [ :a | a perform: opcode with: operand with: hreg ] raise: Error ].
					op2codes do: [ :opcode | self asmShould: [ :a | a perform: opcode with: operand with: hreg ] raise: Error ] ].
			mixedWidthOpCodes
				do: [ :opcode | 
					wideRegistersRequiringRex
						do: [ :wideReg | self asmShould: [ :a | a perform: opcode with: wideReg with: hreg ] raise: Error ] ] ]! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'HenrikSperreJohansen 6/26/2014 13:04'!
testAssembly3

	" instructions without operands.

	(AJx86InstructionDescription instructions select: [:each | each group = #emit]) keys asSortedCollection
	 "
	| str |
	str :=
#(
#cbw 16r66 16r98
#cdq 16r99
#cdqe 16r48 16r98
#clc 16rF8
#cld 16rFC
#cmc 16rF5 
#cmpsb 16rA6
#cmpsd 16rA7
#cmpsq 16r48 16rA7 "64 bit"
#cmpsw 16r66 16rA7
#cpuid 16r0F 16rA2
#cqo  16r48	16r99 "64 bit "
#cwd 16r66 16r99
#cwde 16r98
"#daa 16r27 32 bit"
"#das 16r2F 32 bit"
#emms 16r0F 16r77
#f2xm1 16rD9 16rF0
#fabs  16rD9 16rE1
#fchs 16rD9 16rE0
#fclex 16r9B 16rDB 16rE2
#fcompp 16rDE 16rD9
#fcos 16rD9 16rFF
#fdecstp 16rD9 16rF6
#fincstp 16rD9 16rF7
#finit 16r9B 16rDB 16rE3
#fld1 16rD9 16rE8
#fldl2e 16rD9 16rEA
#fldl2t 16rD9 16rE9
#fldlg2 16rD9 16rEC
#fldln2 16rD9 16rED
#fldpi 16rD9 16rEB
#fldz 16rD9 16rEE
#fnclex 16rDB 16rE2
#fninit 16rDB 16rE3
#fnop 16rD9 16rD0
#fpatan 16rD9 16rF3
#fprem 16rD9 16rF8
#fprem1 16rD9 16rF5
#fptan 16rD9 16rF2
#frndint 16rD9 16rFC
#fscale 16rD9 16rFD
#fsin 16rD9 16rFE
#fsincos 16rD9 16rFB
#fsqrt 16rD9 16rFA
#ftst 16rD9 16rE4
#fucompp 16rDA 16rE9
#fwait 16r9B
#fxam 16rD9 16rE5
#fxtract  16rD9 16rF4
#fyl2x  16rD9 16rF1
#fyl2xp1 16rD9 16rF9
#insb 16r6C
#insd 16r6D
#insw 16r66 16r6D
#int3 16rCC
#leave  16rC9
#lfence 16r0F 16rAE 16rE8
#lock 16rF0 "prefix"
#lodsb 16rAC
#lodsd 16rAD
#lodsq 16r48 16rAD "- 64 bit"
#lodsw 16r66 16rAD
#mfence 16r0F 16rAE 16rF0
#monitor 16r0F 16r01 16rC8
#movsb 16rA4
#movsd 16rA5
#movsq 16r48 16rA5 "- 64 bit"
#movsw 16r66 16rA5
#mwait 16r0F 16r01 16rC9
#nop 16r90
#outsb 16r6E
#outsd 16r6F
#outsw 16r66 16r6F
#pause 16rF3 16r90
"#popad 16r61 32 bit"
#popfd 16r9D
#popfq 16r48 16r9D   "- 64 bit "
"#pushad 16r60 32 bit"
#pushf 16r66 16r9C
"#pushfd 16r9C 32 bit"
#pushfq 16r9c" -64 bit"
#rdtsc 16r0F 16r31  
#rdtscp 16r0F 16r01 16rF9
#sahf 16r9E
#scasb 16rAE
#scasd 16rAF
#scasq 16r48 16rAF
#scasw 16r66 16rAF
#sfence 16r0F 16rAE 16rF8
#stc 16rF9
#std 16rFD
#stosb 16rAA
#stosd 16rAB
#stosq 16r48 16rAB
#stosw 16r66 16rAB
#ud2 16r0F 16r0B
#std 16rFD "dummy"
) readStream.

[ str atEnd ] whileFalse: [
	| instr tst bytes |
	instr := str next.
	tst := OrderedCollection new.
	[ str peek isInteger ] whileTrue: [ tst add: str next  ].

	asm reset noStackFrame.
	asm perform: instr.
	bytes := asm bytes.
	self assert: (bytes = tst asByteArray ) description: instr, ' failed. expected ', tst asByteArray printString, ' but got ', bytes asByteArray printString.
].
! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/27/2013 21:32'!
testByteRegs4through7
	"Test valid uses of byte registers SPL BPL SIL DIL, only available in 64-bit mode, and when using a REX prefix.
	Can't be used in the same instruction with AH, CH, DH, or BH -- this is tested in testHighByteRegistersInvalid."

	| byteRegs op2codes opBothCodes mixedWidthOpCodes byteRMOperands wideRegisters |
	"byteRegs -- register -> contribution to ModRM byte when used as the reg operand"
	byteRegs := {(SPL -> 16r20).
	(BPL -> 16r28).
	(SIL -> 16r30).
	(DIL -> 16r38)}.	"opBothCodes -- #selector -> #(opcode when byteReg second arg, opcode when byteReg first arg)"
	opBothCodes := {(#adc:with: -> #(16r10 16r12)).
	(#add:with: -> #(16r00 16r02)).
	(#mov:with: -> #(16r88 16r8A)).
	(#cmp:with: -> #(16r38 16r3A)).
	(#or:with: -> #(16r08 16r0A)).
	(#sbb:with: -> #(16r18 16r1A)).
	(#sub:with -> #(16r28 16r2A)).
	(#xor:with: -> #(16r30 16r32))}.	"op2Codes -- #selector -> multiByteBytecode. ByteReg is always the second arg"
	op2codes := {(#cmpxchg:with: -> #[16r0F 16rB0]).
	(#test:with: -> #[16r84]).
	(#xadd:with: -> #[16r0F 16rC0])	"xchg is not actually supported at this time (#xchg:with: -> #[16r86])"}.	"mixedWidthOpCodes -- #selector -> multiByteBytecode. ByteReg is always the second arg"
	mixedWidthOpCodes := {(#movsx:with: -> #[16r0F 16rBE]).
	(#movzx:with: -> #[16r0F 16rB6])}.	"**** Handle #crc32:with: separately due to its legacy prefix ****"	"wideRegisters -- register -> #[REX prefix, contribution to ModRM byte when used as r/m operand]"
	wideRegisters := {(EAX -> #[16r40 16rC0]).
	(RAX -> #[16r48 16rC0]).
	(R8D -> #[16r44 16rC0]).
	(R8 -> #[16r4C 16rC0])}.	"byteRMOperands -- operand -> #(REX prefix, #[modRMContribution, SIB and displacement bytes if any])"
	byteRMOperands := {(SPL -> #(16r40 #[16rC4])).
	(BPL -> #(16r40 #[16rC5])).
	(SIL -> #(16r40 #[16rC6])).
	(DIL -> #(16r40 #[16rC7])).
	(R8B -> #(16r41 #[16rC0])).
	(AL -> #(16r40 #[16rC0])).
	(R8 ptr -> #(16r41 #[16r00])).
	(RAX ptr -> #(16r40 #[16r00])).
	(R8 ptr + 16r12 -> #(16r41 #[16r40 16r12])).
	(RAX ptr + 16r12 -> #(16r40 #[16r40 16r12])).
	(R8 ptr + 16r1234 -> #(16r41 #[16r80 16r34 16r12 16r00 16r00])).
	(RAX ptr + 16r1234 -> #(16r40 #[16r80 16r34 16r12 16r00 16r00])).
	((RAX ptr + R8) * 2 -> #(16r42 #[16r04 16r40])).
	((RAX ptr + RAX) * 2 -> #(16r40 #[16r04 16r40])).
	((RAX ptr + R8) * 4 + 16r12 -> #(16r42 #[16r44 16r80 16r12])).
	((RAX ptr + RAX) * 4 + 16r12 -> #(16r40 #[16r44 16r80 16r12])).
	((RAX ptr + R8) * 8 + 16r1234 -> #(16r42 #[16r84 16rC0 16r34 16r12 16r00 16r00])).
	((RAX ptr + RAX) * 8 + 16r1234 -> #(16r40 #[16r84 16rC0 16r34 16r12 16r00 16r00]))}.
	byteRegs
		do: [ :reg | 
			byteRMOperands
				do: [ :rm | 
					opBothCodes
						do: [ :opcode | 
							| opcodeByte op1 op2 |
							op1 := reg key.
							op2 := rm key.
							opcodeByte := opcode value last.
							self
								assert: [ :a | a perform: opcode key with: op1 with: op2 ]
								bytes:
									(ByteArray with: rm value first with: opcodeByte with: reg value | rm value last first) , rm value last allButFirst	"REX"	"ModRM"	"SIB and displacement"	"Need to add the necessary data to allow testing the reverse order of operands." ].
					op2codes
						do: [ :opcode | 
							self
								assert: [ :a | a perform: opcode key with: rm key with: reg key ]
								bytes:
									((ByteArray with: rm value first) , opcode value copyWith: reg value | rm value last first) , rm value last allButFirst	"REX"	"ModRM"	"SIB and displacement" ] ].
			mixedWidthOpCodes
				do: [ :opcode | 
					wideRegisters
						do: [ :rm | 
							self
								assert: [ :a | a perform: opcode key with: rm key with: reg key ]
								bytes: ((ByteArray with: rm value first) , opcode value copyWith: reg value >> 3 | rm value last)	"REX"	"ModRM"	"SIB and displacement" ] ] ]! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/1/2013 22:30'!
testAssembly01
	self
		assert: [ :a | 
			self assert: (a reg: 8 size: 4) = R8D.	"mov    $0xfeedface,%r8d"
			a mov: 16rfeedface asUImm to: R8D ]
		bytes: #[65 184 206 250 237 254]! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/1/2013 22:31'!
testAssembly2

	self 
		assert: [ :a|
		asm 
			push: a BP;
			mov: a SP -> a BP;
			mov: 16r400 -> a RAX;
			mov: a BP -> a SP;
			pop: a RSP;
			ret. ]
		bytes: #[
			102 85
			102 139 236 
			72	199	192 0 4 0 0
			102 139 229 
			92 
			195]
	! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/1/2013 22:31'!
testAssembly1

	
	self 
		assert: [ :a|
			a 
				push: a RBP;
				mov: a RSP -> a RBP;
				mov: 1024 -> a RAX;
				mov: a RBP -> a RSP;
				pop: a RBP;
				ret.]	
		bytes: #[
			85 
			72 139 236 
			72	199	192	0	4	0	0
			72 139 229 
			93 
			195]! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/25/2013 21:11'!
testMovZX
	"byte to word ========================================"
	"lower bank 8bit to lower bank 16bit"
	self 
		assert: [:a | a movzx: a AL to: a AX ]
		bytes: #[102 15 182 192 ].
	"lower bank 8bit to upper bank 16bit"
	self 
		assert: [:a | a movzx: a AL to: a R8W ]
		bytes: #[102 68 15 182 192].
	"upper bank 8bit to lower bank 16bit"
	self 
		assert: [:a | a movzx: a R8B to: a AX ]
		bytes: #[102 65 15 182 192].
	"upper bank 8bit to upper bank 16bit"
	self 
		assert: [:a | a movzx: a R8B to: a R8W ]
		bytes: #[102 69 15 182 192].
	
	"byte to doubleword ================================"
	"lower bank 8bit to lower bank 32bit"
	self 
		assert: [:a | a movzx: a AL to: a EAX ]
		bytes: #[15 182 192 ].
	"lower bank 8bit to upper bank 32bit"
	self 
		assert: [:a | a movzx: a AL to: a R8D ]
		bytes: #[68 15 182 192].
	"upper bank 8bit to lower bank 32bit"
	self 
		assert: [:a | a movzx: a R8B to: a EAX ]
		bytes: #[65 15 182 192].
	"upper bank 8bit to upper bank 32bit"
	self 
		assert: [:a | a movzx: a R8B to: a R8D ]
		bytes: #[69 15 182 192].
	
	"byte to quadword ==================="
	"lower bank 8bit to lower bank 64bit"
	self 
		assert: [:a | a movzx: a AL to: a RAX ]
		bytes: #[72 15 182 192 ].
	"lower bank 8bit to upper bank 64bit"
	self 
		assert: [:a | a movzx: a AL to: a R8 ]
		bytes: #[76 15 182 192].
	"upper bank 8bit to lower bank 64bit"
	self 
		assert: [:a | a movzx: a R8B to: a RAX ]
		bytes: #[73 15 182 192 ].
	"upper bank 8bit to upper bank 64bit"
	self 
		assert: [:a | a movzx: a R8B to: a R8 ]
		bytes: #[77 15 182 192].
	
	"word to quadword ==================="
	"lower bank 16bit to lower bank 64bit"
	self 
		assert: [:a | a movzx: a AX to: a RAX ]
		bytes: #[72 15 183 192].
	"lower bank 16bit to upper bank 64bit"
	self 
		assert: [:a | a movzx: a AX to: a R8 ]
		bytes: #[76 15 183 192].
	"upper bank 16bit to lower bank 64bit"
	self 
		assert: [:a| a movzx: a R8W to: a RAX ]
		bytes: #[73 15 183 192].
	"upper bank 16bit to upper bank 64bit"
	self 
		assert: [:a | a movzx: a R8W to: a R8 ]
		bytes: #[77 15 183 192].! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/25/2013 20:37'!
testAssemblyImmAddr
	"This is not supported in 64-bit mode -- the ModRM value for this results in RIP-relative addressing."

	<expectedFailure>
	super testAssemblyImmAddr! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/1/2013 22:40'!
testMul
	"8bit unsigned multiplication =================================="
	"lower bank register: AX := AL * CL"
	self 
		assert: [ :a | a mul: a CL]
		bytes: #[ 16rF6 "ModR/M" 2r11100001 ].
	"upper bank register needs an REX prefix: AX := AL * R8B"
	self 
		assert: [ :a | a mul: a R9B]
		bytes: #[ 2r01000001 16rF6 2r11100001].
		
	"16bit unsigned multiplication =================================="	
	"DX:AX := AX * CX"
	self 
		assert: [ :a | a mul: a CX]
		bytes: #[ "16bit fallback" 16r66 16rF7 2r11100001].
	"32bit unsigned multiplication =================================="	
	"EDX:EAX := EAX * ECX"
	self 
		assert: [ :a | a mul: a ECX]
		bytes: #[ 16rF7 2r11100001 ].
	"64bit unsigned multiplication =================================="	
	"RDX:RAX := RAX * RCX"
	self 
		assert: [ :a| a mul: a RCX]
		bytes: #[ 2r01001000 16rF7 2r11100001].! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/25/2013 19:41'!
testXorInvalid
	"xor registers with non-matching sizes"

	self asmShould: [ :a | a xor: AL to: RAX ] raise: Error.
	self asmShould: [ :a | a xor: RAX to: AL ] raise: Error.
	self asmShould: [ :a | a xor: R8B to: RAX ] raise: Error.
	self asmShould: [ :a | a xor: RAX to: R8B ] raise: Error.	"in 64bit mode AH CH DH and BH cannot be encoded when an REX prefix is present"
	{AH.
	CH.
	DH.
	BH} do: [ :reg | self asmShould: [ :a | a xor: reg to: a R8B ] raise: Error ]! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/3/2013 21:36'!
testIndexScales
	self
		assert: [ :a | a mov: RAX -> ((RCX ptr + RDX) * 1) ] bytes: #[16r48 16r89 16r04 16r11];
		assert: [ :a | a mov: RAX -> ((RCX ptr + RDX) * 2) ] bytes: #[16r48 16r89 16r04 16r51];
		assert: [ :a | a mov: RAX -> ((RCX ptr + RDX) * 4) ] bytes: #[16r48 16r89 16r04 16r91];
		assert: [ :a | a mov: RAX -> ((RCX ptr + RDX) * 8) ] bytes: #[16r48 16r89 16r04 16rD1].
	self
		assert: [ :a | a mov: (RCX ptr + RDX) * 1 -> RAX ] bytes: #[16r48 16r8B 16r04 16r11];
		assert: [ :a | a mov: (RCX ptr + RDX) * 2 -> RAX ] bytes: #[16r48 16r8B 16r04 16r51];
		assert: [ :a | a mov: (RCX ptr + RDX) * 4 -> RAX ] bytes: #[16r48 16r8B 16r04 16r91];
		assert: [ :a | a mov: (RCX ptr + RDX) * 8 -> RAX ] bytes: #[16r48 16r8B 16r04 16rD1]! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/1/2013 22:14'!
testAssemblyMemBytes
	asm
		mov: (RSI ptr + ECX size: 1) -> BL;
		mov: BL -> (RSI ptr + ECX size: 1).
	self assert: asm bytes = #(16r8A 16r1C 16r0E 16r88 16r1C 16r0E) asByteArray! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/27/2013 16:46'!
testCall
	"relative calls ==================================================================="
	"8bit offset"
	self assert: [:a | a call: 16r12 ] bytes: #[ 16rE8 16r12 0 0 0].
	"16bit offset"
	self assert: [:a | a call: 16r1234 ] bytes: #[ 16rE8 16r34 16r12 0 0 ].
	"32bit offset"
	self assert: [:a | a call: 16r12345678 ] bytes: #[ 16rE8 16r78 16r56 16r34 16r12 ].
	
	"indirect calls ==================================================================="
	"lower bank register"
	self assert: [:a | a call: asm RAX ] bytes: #[ 16rFF 2r11010000 ].
	self assert: [:a | a call: asm RDI ] bytes: #[ 16rFF 2r11010111 ].
	
	"upper bank register (require REX prefix)"
	self assert: [:a | a call: asm R8 ] bytes: #[ 2r01001001 16rFF 2r11010000 ].
	self assert: [:a | a call: asm R15 ] bytes: #[ 2r01001001 16rFF 2r11010111 ].
	
	"double indirect calls (with ModR/M) =============================================="
	"mod = 2r00"
	"lower bank register"
	self assert: [:a | a call: a RAX ptr ] bytes: #[ 16rFF 2r00010000 ].
	self assert: [:a | a call: a RDI ptr ] bytes: #[ 16rFF 2r00010111 ].
	
	"upper bank register (require REX prefix)"
	self assert: [:a | a call: a R8 ptr ] bytes: #[ 2r01000001 16rFF 2r00010000 ].
	self assert: [:a | a call: a R15 ptr ] bytes: #[ 2r01000001 16rFF 2r00010111 ].
	
	"double indirect calls with offsets =============================================="
	"mod = 2r01 hence with a folllwing 8bit offset"
	"lower bank register"
	self assert: [:a | a call: a RAX ptr + 8 ] bytes: #[ 16rFF 2r01010000 8].
	self assert: [:a | a call: a RDI ptr + 8 ] bytes: #[ 16rFF 2r01010111 8].
	
	"upper bank register (require REX prefix)"
	self assert: [:a | a call: a R8 ptr + 8] bytes: #[ 2r01000001 16rFF 2r01010000 8].
	self assert: [:a | a call: a R15 ptr + 8] bytes: #[ 2r01000001 16rFF 2r01010111 8].
	
	"double indirect calls with offsets =============================================="
	"mod = 2r10 hence with a following 32bit offset"
	"lower bank register"
	self assert: [:a | a call: a RAX ptr + 16r12345678 ] bytes: #[ 16rFF 2r10010000 16r78 16r56 16r34 16r12].
	self assert: [:a | a call: a RDI ptr + 16r12345678 ] bytes: #[ 16rFF 2r10010111 16r78 16r56 16r34 16r12].
	
	"upper bank register (require REX prefix)"
	self assert: [:a | a call: a R8 ptr + 16r12345678] bytes: #[ 2r01000001 16rFF 2r10010000 16r78 16r56 16r34 16r12].
	self assert: [:a | a call: a R15 ptr + 16r12345678] bytes: #[ 2r01000001 16rFF 2r10010111 16r78 16r56 16r34 16r12].! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/4/2013 21:57'!
testMovHighIndexRegister
	"Mov that use r8-r15 as an index register, therefore requiring REX.X"

	self
		assert: [ :a | a mov: RAX -> ((RCX ptr + R14) * 1) ] bytes: #[16r4A 16r89 16r04 16r31];
		assert: [ :a | a mov: (RCX ptr + R14) * 1 -> RAX ] bytes: #[16r4A 16r8B 16r04 16r31]! !

!AJx64AssemblerTests methodsFor: 'utility' stamp: ''!
newAssembler 
	^ AJx64Assembler new
		noStackFrame;
		yourself! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/1/2013 22:36'!
testJumps

	self 
		assert: [:a|
			a 
				label: #label1;
				nop;
				nop;
				nop;
				jz: #label1.
		] bytes: #[144 144 144 16r74 251 "-5 asByte"].
	
	
	
	asm 
		reset; noStackFrame;
		label: #label1.
		126 timesRepeat: [ asm nop ].
		asm jz: #label1.
	self assert: (asm bytes size = 128).


	self 
		assert: [:a |
			a
				reset; noStackFrame;
				label: #label1;
				nop;
				nop;
				nop;
				jmp: #label1.
		] bytes: #[144 144 144 235 251 ].
	
	self 
		assert: [:a |
			a 
				reset; noStackFrame;
				jmp: #label1;
				label: #label1.
		] bytes: #[ 16rEB 0 ].
		
! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/1/2013 22:14'!
testAssemblyMemBaseDisp2
	asm
		mov: RAX ptr - 1 -> EAX;
		mov: (RBX ptr + ECX) * 2 - 5 -> EAX.
	self assert: asm bytes = #(16r8B 16r40 16rFF 16r8B 16r44 16r4B 16rFB) asByteArray! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/1/2013 22:44'!
testTest
	"8bit operand  and lower bank 8bit register"		
	self assert: [:a | a test: a CL with: 16r12 ]
		bytes: #[246	 193 16r12].
	"8bit operand  and uppe bank 8bit register"	
	self assert: [:a | a test: a R8B with: 16r12]
		bytes: #[2r01000001 2r11110110  2r11000000  16r12].
	
	"16bit operand  and lower bank 16bit register"		
	self assert: [:a | a test: a CX with: 16r1234]
		bytes: #[102 247 193   16r34 16r12].
	"16bit operand  and uppe bank 16bit register"	
	self assert: [:a | a test: a R8W with: 16r1234]
		bytes: #[102 65 247 192   16r34 16r12].
	
	"32bit operand  and lower bank 32bit register"		
	self assert: [:a | a test: a ECX with: 16r12345678]
		bytes: #[247 193   16r78 16r56 16r34 16r12].
	"32bit operand  and uppe bank 32bit register"	
	self assert: [:a | a test: a R8D with: 16r12345678]
		bytes: #[65 247 192   16r78 16r56 16r34 16r12].
	
	"32bit operand  and lower bank 64bit register"		
	self assert: [:a| a test: a RCX with: 16r12345678]
		bytes: #[72 247 193   16r78 16r56 16r34 16r12].
	"32bit operand  and uppe bank 64bit register"	
	self assert: [:a| a test: a R8 with: 16r12345678]
		bytes: #[73 247 192	  16r78 16r56 16r34 16r12].
	
	
	! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/1/2013 22:44'!
testXor
	"8bit register xor 8bit immediate =================================="		
	"lower bank 8bit register opcode + ModR/M"
	self 
		assert: [ :a | a xor: a CL with: 16r12]
		bytes: #[ 16r80 2r11110001    16r12].
		
	"upper bank 8bit register requiring REX"
	self 
		assert: [ :a | a xor: a R8B with: 16r12]
		bytes: #[2r01000001 16r80 2r11110000    16r12].
		
	"16bit register xor 8bit immediate =================================="
	"lower bank 16bit register"
	self 
		assert: [ :a | a xor: a CX with: 16r1234]
		bytes: #[16r66 16r81 2r11110001    16r34 16r12].
	"upper bank 16bit"
	self 
		assert: [ :a | a xor: a R8W with: 16r1234]
		bytes: #[16r66 2r01000001 16r81 2r11110000 16r34 16r12].
		
	"32bit register ====================================================="
	"lower bank 32bit register"
	self 
		assert: [ :a | a xor: a ECX with: 16r12345678]
		bytes: #[16r81 2r11110001    16r78 16r56 16r34 16r12].
		
	"upper bank register requiring REX prefix"
	self 
		assert: [ :a | a xor: a R8D with: 16r12345678]
		bytes: #[2r01000001 16r81 2r11110000     16r78 16r56 16r34 16r12]
	! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/1/2013 22:14'!
testImmLabels
	"test immediates with labels"

	| code pos |
	asm
		mov: RAX ptr -> EAX;
		mov: (16rFFFFFFFF asUImm label: (asm labelNamed: #foo)) to: EAX.
	code := asm generatedCode.
	pos := code offsetAt: #foo.
	self assert: (code bytes at: pos + 1) = 255.
	self assert: (code bytes at: pos + 2) = 255.
	self assert: (code bytes at: pos + 3) = 255.
	self assert: (code bytes at: pos + 4) = 255! !

!AJx64AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 1/25/2013 19:34'!
testMovZxSxInvalid
	{AH.
	CH.
	DH.
	BH}
		do: [ :reg | 
			self deny: (self bytes: [ :a | a movzx: reg to: a EAX ]) isEmpty.
			self asmShould: [ :a | a movzx: reg to: a RAX ] raise: Error ]! !

!AJx64AssemblerTests class methodsFor: 'as yet unclassified' stamp: ''!
shouldInheritSelectors
	^ true! !

!AJx64Instruction commentStamp: 'TorstenBergmann 1/30/2014 09:17'!
The x86 - 64 bit machine instructions!
!AJx64Instruction methodsFor: 'accessing' stamp: ''!
instructionDesciptions
	^ AJx64InstructionDescription instructions! !

!AJx64Instruction methodsFor: 'testing' stamp: ''!
is64BitMode
	^ true! !

!AJx64Instruction methodsFor: 'testing' stamp: 'MartinMcClure 1/30/2013 20:59'!
requiresRex
	"Answer true if I absolutely must have a REX prefix."

	^ (operands
		detect: [ :rawOp | 
			| op |
			op := rawOp asAJOperand.
			op requiresRex | op is64 ]
		ifNone: [ #none ]) ~~ #none! !

!AJx64Instruction methodsFor: 'testing' stamp: ''!
is32BitMode
	^ false! !

!AJx64InstructionDescription commentStamp: 'TorstenBergmann 1/30/2014 09:19'!
X64 instruction description!
!AJx64InstructionDescription methodsFor: 'code emitting' stamp: ''!
emitbswap: emitter operand1: op1 operand2: op2 operand3: op3

	op1 isReg ifTrue: [
		emitter emitRexForSingleOperand: op1.
		emitter emitByte: 16r0F.
		^ emitter emitModR: 1 r: op1 code
	].
	self invalidInstruction.! !

!AJx64InstructionDescription methodsFor: 'code emitting' stamp: ''!
emitpop: emitter operand1: op1 operand2: op2 operand3: op3
	op1 isReg ifTrue: [
		self assert: op1 isGeneralPurpose.
		(op1 is32 or: [ op1 is8 ]) 
			ifTrue: [ Error signal: 'invalid register ', op1 name, '. push/pop requires 64bit/16bit reg in 64bit mode'].
		^ emitter emitX86Inl: opCode1 reg: op1 withRex: op1 isUpperBank.
		].
	
	op1 isMem ifFalse: [ self invalidInstruction ].
	emitter emitX86RM: opCode2 size: op1 size regOrCode: opCodeR rm: op1
! !

!AJx64InstructionDescription methodsFor: 'code emitting' stamp: 'CamilloBruni 4/17/2012 18:43'!
emitcall: emitter operand1: op1 operand2: op2 operand3: op3

	(op1 isReg and: [ op1 is64 and: [ op1 isUpperBank not ]]) ifTrue: [ 
		"shortcut"
		emitter emitByte: 16rFF. 
		op1 emitModRM: emitter code: 2 immSize: 4.
		^ self].
	
	(op1 isMem and: [op1 hasBase and: [ op1 base is64 and: [ op1 base isUpperBank not ]]]) ifTrue: [ 
		"shortcut"
		emitter emitByte: 16rFF. 
		op1 emitModRM: emitter code: 2 immSize: 4.
		^ self].
	
	(op1 isMem or: [ op1 isReg and: [ op1 is64 ] ]) ifTrue: [
		^ emitter emitX86RM:  16rFF
			size: 4
			regOrCode: 2  
			rm: op1  
	].

	op1 isImm ifTrue: [ "call by relative offset, you should be really sure what you're' doing"
		emitter emitByte: 16rE8. 
		op1 emitUsing: emitter size: 4.
		^ self.
		].
	
	op1 isLabel ifTrue: [
		emitter emitByte: 16rE8. 
		emitter emitDisplacement: op1 inlinedDisp: -4.
		^ self
	].
	self invalidInstruction.
! !

!AJx64InstructionDescription methodsFor: 'code emitting' stamp: 'MartinMcClure 1/30/2013 22:13'!
emitmovSxZx: emitter operand1: dst operand2: src operand3: op3
	dst isReg & src isRegMem
		ifFalse: [ self invalidInstruction ].
	src size >= dst size
		ifTrue: [ self invalidInstruction ].
	dst isGeneralPurpose
		ifFalse: [ self invalidInstruction ].
	src is16
		ifTrue: [ 
			^ emitter
				emitX86RM: opCode1 + 1
				size: dst size
				regOrCode: dst
				rm: src ].
	src is32
		ifTrue: [ self invalidInstruction ].	"64 bit source"
	emitter
		emitX86RM: opCode1
		size: dst size
		regOrCode: dst
		rm: src! !

!AJx64InstructionDescription methodsFor: 'code emitting' stamp: 'IgorStasenko 5/28/2012 03:01'!
emitmov: emitter operand1: dst operand2: src operand3: op3
	
	src isReg & dst isReg ifTrue: [
		self assert: (src isRegTypeGPB | src isRegTypeGPW | src isRegTypeGPD | src isRegTypeGPQ ).
		]. 
	
	" reg <- mem "
	dst isReg & src isRegMem ifTrue: [
		self assert: (dst isRegTypeGPB | dst isRegTypeGPW | dst isRegTypeGPD | dst isRegTypeGPQ ).
		src isMem
			ifTrue: [ (src base notNil and: [ src base is64 not ])
				ifTrue: [ Error signal: 'use a 64bit base register instead of ', src base asString, '(', (src base size * 8) asString, 'bit) for memory access on a 64bit CPU' ]]
			ifFalse:[ (src size = dst size) 
				ifFalse: [ Error signal: 'source ',src asString,' and destination ',dst asString,' need to have the same size' ]].
		^ emitter emitX86RM: 16r0000008A + dst isRegTypeGPB not asBit 
			size:  dst size 
			regOrCode:  dst 
			rm: src
		].

	" reg <- imm "
	dst isReg & src isImm ifTrue: [
		| immSize |
		immSize := dst size.
		"Optimize instruction size by using 32 bit immediate if value can fit to it"
		emitter is64BitMode & immSize = 8 & src isInt32 & (src relocMode == #RelocNone) ifTrue: [
			 emitter emitX86RM: 16rC7
				size: dst size
				regOrCode: 0 rm: dst.
	        immSize := 4
		] ifFalse: [
			emitter emitX86Inl: (immSize=1 ifTrue: [16rB0] ifFalse: [16rB8]) reg: dst.
		].
		^ emitter emitImmediate: src size: immSize
	].

	"mem <- reg"
	dst isMem & src isReg ifTrue: [
		self assert: (src isRegTypeGPB | src isRegTypeGPW | src isRegTypeGPD | src isRegTypeGPQ ).
		^ emitter emitX86RM: 16r88 + src isRegTypeGPB not asBit
			size: src size regOrCode: src rm: dst
	].

	"mem <- imm"
	dst isMem & src isImm ifTrue: [ | immSize |
		
		immSize := dst size <= 4 ifTrue: [ dst size ] ifFalse: [4].
		
		emitter emitX86RM: 16rC6 + ((dst size = 1) not) asBit
			size: dst size 
			regOrCode:  0 rm:  dst 
			immSize: immSize.
		
		^ emitter emitImmediate: src size: immSize
	].

	self invalidInstruction 
! !

!AJx64InstructionDescription methodsFor: 'code emitting' stamp: 'HenrikSperreJohansen 6/26/2014 14:40'!
emitalu: emitter operand1: op1 operand2: op2 operand3: op3
	| opCode opReg |
	opCode := opCode1.
	opReg := opCodeR.	" Mem <- Reg "
	(op1 isMem and: [ op2 isReg ])
		ifTrue: [ 
			^ emitter
				emitX86RM: opCode + op2 isRegTypeGPB not asBit
				size: op2 size
				regOrCode: op2
				rm: op1 ].	"Reg <- Reg|Mem"
	(op1 isReg and: [ op2 isRegMem ])
		ifTrue: [ 
			(op2 isReg and: [ op1 size ~= op2 size ])
				ifTrue: [ self invalidInstruction ].
			^ emitter
				emitX86RM: opCode + 2 + op1 isRegTypeGPB not asBit
				size: op1 size
				regOrCode: op1
				rm: op2 ].
	op2 isImm
		ifFalse: [ self invalidInstruction ].	" AL, AX, EAX, RAX register shortcuts"
	(op1 isRegIndex: 0)
		ifTrue: [ 
			emitter emitOperandSizeOverridePrefix: op1. 
			emitter emitByte: (opReg << 3 bitOr: 16r04 + op1 isRegTypeGPB not asBit).
			^ emitter emitImmediate: op2 size: (op1 size min: 4) ].	"short constant"
	op2 isInt8
		ifTrue: [ 
			| szBits |
			szBits := op1 size = 1
				ifTrue: [ 0 ]
				ifFalse: [ 3 ].
			emitter
				emitX86RM: opCode2 + szBits
				size: op1 size
				regOrCode: opReg
				rm: op1
				immSize: 1.
			^ emitter emitImmediate: op2 size: 1 ].
	op1 isRegMem
		ifTrue: [ 
			| immSize szBits |
			immSize := op2 isInt8
				ifTrue: [ 1 ]
				ifFalse: [ op1 size min: 4 ].
			szBits := op1 size ~= 1
				ifTrue: [ 
					immSize ~= 1
						ifTrue: [ 1 ]
						ifFalse: [ 3 ] ]
				ifFalse: [ 0 ].
			emitter
				emitX86RM: opCode2 + szBits
				size: op1 size
				regOrCode: opReg
				rm: op1
				immSize: immSize.
			^ emitter emitImmediate: op2 size: immSize ].
	self invalidInstruction! !

!AJx64InstructionDescription methodsFor: 'code emitting' stamp: ''!
emitmovPtr: emitter operand1: op1 operand2: op2 operand3: op3

	| reg imm opCode |
	(op1 isReg & op2 isImm) | (op1 isImm & op2 isReg) ifFalse: [
		self invalidInstruction ].
	
	opCode := op1 isReg 
		ifTrue: [reg := op1. imm := op2. 16rA0] 
		ifFalse: [reg := op2. imm := op1. 16rA2].
	
	reg index ~= 0 ifTrue: [ self invalidInstruction ].

	reg isRegTypeGPW ifTrue: [ emitter emitByte: 16r66 ].

	emitter emitRexForSingleOperand: reg.
	emitter emitByte: opCode + (reg size ~=1) asBit.
	emitter emitImmediate: imm size: reg size
! !

!AJx64JumpInstruction commentStamp: 'TorstenBergmann 1/30/2014 09:18'!
Jump instruction for X64!
!AJx64JumpInstruction methodsFor: 'accessing' stamp: ''!
instructionDesciptions
	^ AJx64InstructionDescription instructions! !

!AJx64RipRegister commentStamp: '<historical>'!
Virtual registers used for relative instruction pointer addressing in 64Bit mode

In IA-32 architecture and compatibility mode, addressing relative to the instruction pointer is available only with control-transfer instructions. In 64-bit mode, instruc- tions that use ModR/M addressing can use RIP-relative addressing. Without RIP-rela- tive addressing, all ModR/M instruction modes address memory relative to zero.!
!AJx64RipRegister methodsFor: 'converting' stamp: ''!
as64
	^ AJx86Registers at: #RIP! !

!AJx64RipRegister methodsFor: 'accessing' stamp: ''!
code
	self ripAccessError! !

!AJx64RipRegister methodsFor: 'converting' stamp: ''!
as32
	^ AJx86Registers at: #EIP! !

!AJx64RipRegister methodsFor: 'testing' stamp: ''!
isRip
	^ true! !

!AJx64RipRegister methodsFor: 'accessing' stamp: 'CamilloBruni 7/17/2012 12:48'!
influencingRegisters
	self is16
		ifFalse: [ ^ self as16 influencingRegisters ].
	^ { self as16. self as32. self as64 }! !

!AJx64RipRegister methodsFor: 'error' stamp: ''!
ripAccessError
	self error: 'RIP register ', self name, ' cannot be used only for relative addressing'! !

!AJx64RipRegister methodsFor: 'converting' stamp: ''!
as8
	
	self error: 'No 8bit register available for instruction pointer relative addressing'! !

!AJx64RipRegister methodsFor: 'printing' stamp: 'CamilloBruni 7/17/2012 11:08'!
descriptionOn: s
	s nextPutAll: 'A '; print: self size * 8; nextPutAll: 'bit instruction pointer register'.! !

!AJx64RipRegister methodsFor: 'testing' stamp: ''!
isGeneralPurpose
	^ false! !

!AJx64RipRegister methodsFor: 'testing' stamp: ''!
isUpperBank
	^ false! !

!AJx64RipRegister methodsFor: 'converting' stamp: ''!
as16
	^ AJx86Registers at: #IP! !

!AJx64RipRegister methodsFor: 'testing' stamp: 'CamilloBruni 7/17/2012 11:01'!
isX86 
	^ false! !

!AJx64RipRegister methodsFor: 'accessing' stamp: ''!
index
	self ripAccessError! !

!AJx86Assembler commentStamp: '<historical>'!
I am an Assmbler for the Intel x86 (32Bit) architecture.

Example:
	asm := AJx64Assembler new.
	"by default the assembler will set up a stack frame"
	asm noStackFrame.
	"load the constant 16r12 into the RAX register"
	asm mov: 16r12 to: asm RAX.
	"output the bytes for this instruction"
	asm bytes !
!AJx86Assembler methodsFor: 'alignment' stamp: ''!
alignDouble
	self addInstruction: AJAlignmentInstruction alignDouble! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fldenv: aMemoryOperand
	"Load x87 FPU Environment
	Pseudo Code
-----------
FPUControlWord = SRC[FPUControlWord];
FPUStatusWord = SRC[FPUStatusWord];
FPUTagWord = SRC[FPUTagWord];
FPUDataPointer = SRC[FPUDataPointer];
FPUInstructionPointer = SRC[FPUInstructionPointer];
FPULastInstructionOpcode = SRC[FPULastInstructionOpcode];

Description
-----------
Loads the complete x87 FPU operating environment from memory into the
FPU registers. The source operand specifies the first byte of the
operating-environment data in memory. This data is typically written to
the specified memory location by a FSTENV or FNSTENV instruction.

The FPU operating environment consists of the FPU control word, status
word, tag word, instruction pointer, data pointer, and last opcode.
Figures 8-9 through 8-12 in the Intel® 64 and IA-32 Architectures
Software Developer's Manual, Volume 1, show the layout in memory of the
loaded environment, depending on the operating mode of the processor
(protected or real) and the current operand-size attribute (16-bit or
32-bit). In virtual-8086 mode, the real mode layouts are used.

The FLDENV instruction should be executed in the same operating mode as
the corresponding FSTENV/FNSTENV instruction.

If one or more unmasked exception flags are set in the new FPU status
word, a floating-point exception will be generated upon execution of the
next floating-point instruction (except for the no-wait floating-point
instructions, see the section titled 'Software Exception Handling' in
Chapter 8 of the Intel®64 and IA-32 ArchitecturesSoftware Developer's
Manual, Volume 1). To avoid generating exceptions when loading a new
environment, clear all the exception flags in the FPU status word that
is being loaded.

If a page or limit fault occurs during the execution of this
instruction, the state of the x87 FPU registers as seen by the fault
handler may be different than the state being loaded from memory. In
such situations, the fault handler should ignore the status of the x87
FPU registers, handle the fault, and return. The FLDENV instruction will
then complete the loading of the x87 FPU registers with no resulting
context inconsistency.

This instruction's operation is the same in non-64-bit modes and 64-bit
mode.

"
	^ self 
		addInstruction: #fldenv
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
movzx: aDestinationRegister with: aSourceRegisterOrMemory
	"Move with Zero-Extend
	Pseudo Code
-----------
DEST = ZeroExtend(SRC);

Description
-----------
Copies the contents of the source operand (register or memory location)
to the destination operand (register) and zero extends the value. The
size of the converted value depends on the operand-size attribute.

In 64-bit mode, the instruction's default operation size is 32 bits. Use
of the REX.R prefix permits access to additional registers (R8-R15). Use
of the REX.W prefix promotes operation to 64 bit operands. See the
summary chart at the beginning of this section for encoding data and
limits.

"
	^ self 
		addInstruction: #movzx
		operands: { aDestinationRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
amdprefetch: aMemoryOperand
	"
	"
	^ self 
		addInstruction: #amdprefetch
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
jno: targetLabel
	"Jump short if not overflow (OF=0)
	"
	^ self 
		addInstruction: #jno
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
ESP
	"A 32bit general purpose register
	This register overlaps with AH, AX, EAX, RAX"
	^ ESP! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
jnae: targetLabel
	"
	"
	^ self 
		addInstruction: #jnae
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fxsave: aMemoryOperand
	"Save x87 FPU, MMX, XMM, and MXCSR State
	Description
-----------
Saves the current state of the x87 FPU, MMX technology, XMM, and MXCSR
registers to a 512-byte memory location specified in the destination
operand. The content layout of the 512 byte region depends on whether
the processor is operating in non-64-bit operating modes or 64-bit
sub-mode of IA-32e mode.

Bytes 464:511 are available to software use. The processor does not
write to bytes 464:511 of an FXSAVE area.

The operation of FXSAVE in non-64-bit modes is described first.

### Non-64-Bit Mode Operation

The following table shows the layout of the state information in memory
when the processoris operating in legacy modes.

  ------------- --------- -------- ----- -------- ----- ----- ----- --- --- --- --- --- --- --- --- --
  15            14        13       12    11       10    9     8     7   6   5   4   3   2   1   0   
  Rsrvd         CS        FPU IP   FOP   Rs rvd   FTW   FSW   FCW   0
  MXCSR\_MASK   MXCSR     Rsrvd    DS    FPU DP   16
  Reserved      ST0/MM0   32
  Reserved      ST1/MM1   48
  Reserved      ST2/MM2   64
  Reserved      ST3/MM3   80
  Reserved      ST4/MM4   96
  Reserved      ST5/MM5   112
  Reserved      ST6/MM6   128
  Reserved      ST7/MM7   144
  XMM0          160
  XMM1          176
  XMM2          192
  XMM3          208
  XMM4          224
  XMM5          240
  XMM6          256
  XMM7          272
  Reserved      288
  Reserved      304
  Reserved      320
  Reserved      336
  Reserved      352
  Reserved      368
  Reserved      384
  Reserved      400
  Reserved      416
  Reserved      432
  Reserved      448
  Available     464
  Available     480
  Available     496
  ------------- --------- -------- ----- -------- ----- ----- ----- --- --- --- --- --- --- --- --- --

  : Non-64-bit-Mode Layout of FXSAVE and FXRSTOR Memory Region

The destination operand contains the first byte of the memory image, and
it must be aligned on a 16-byte boundary. A misaligned destination
operand will result in a general-protection (\#GP) exception being
generated (or in some cases, an alignment check exception [\#AC]).

The FXSAVE instruction is used when an operating system needs to perform
a context switch or when an exception handler needs to save and examine
the current state of the x87 FPU, MMX technology, and/or XMM and MXCSR
registers.

The fields used in the previous table are defined in the following
table.

Field Definitions

Field

Definition

FCW

x87 FPU Control Word (16 bits). See Figure 8-6 in the Intel® 64 and
IA-32 Architectures Software Developer's Manual, Volume 1, for the
layout of the x87 FPU control word.

FSW

x87 FPU Status Word (16 bits). See Figure 8-4 in the Intel® 64 and IA-32
Architectures Software Developer's Manual, Volume 1, for the layout of
the x87 FPU status word.

Abridged FTW

x87 FPU Tag Word (8 bits). The tag information saved here is abridged,
as described in the following paragraphs.

FOP

x87 FPU Opcode (16 bits). The lower 11 bits of this field contain the
opcode, upper 5 bits are reserved. See Figure 8-8 in the Intel® 64 and
IA-32 Architectures Software Developer's Manual, Volume 1, for the
layout of the x87 FPU opcode field.

FPU IP

x87 FPU Instruction Pointer Offset (32 bits). The contents of this field
differ depending on the current addressing mode (32-bit or 16-bit) of
the processor when the FXSAVE instruction was executed:

-   32-bit mode — 32-bit IP offset.
-   16-bit mode — low 16 bits are IP offset; high 16 bits are reserved.

See 'x87 FPU Instruction and Operand (Data) Pointers' in Chapter 8 of
the Intel® 64 and IA-32 Architectures Software Developer's Manual,
Volume 1, for a description of the x87 FPU instruction pointer.

CS

x87 FPU Instruction Pointer Selector (16 bits).

FPU DP

x87 FPU Instruction Operand (Data) Pointer Offset (32 bits). The
contents of this field differ depending on the current addressing mode
(32-bit or 16bit) of the processor when the FXSAVE instruction was
executed:

-   32-bit mode — 32-bit DP offset.
-   16-bit mode — low 16 bits are DP offset; high 16 bits are reserved.

See 'x87 FPU Instruction and Operand (Data) Pointers' in Chapter 8 of
the Intel® 64 and IA-32 Architectures Software Developer's Manual,
Volume 1, for a description of the x87 FPU operand pointer.

DS

x87 FPU Instruction Operand (Data) Pointer Selector (16 bits).

MXCSR

MXCSR Register State (32 bits). See Figure 10-3 in the Intel® 64 and
IA-32 Architectures Software Developer's Manual, Volume 1, for the
layout of the MXCSR register. If the OSFXSR bit in control register CR4
is not set, the FXSAVE instruction may not save this register. This
behavior is implementation dependent.

MXCSR\_

MXCSR\_MASK (32 bits). This mask can be used to adjust values written to

MASK

the MXCSR register, ensuring that reserved bits are set to 0. Set the
mask bits and flags in MXCSR to the mode of operation desired for SSE
and SSE2 SIMD floating-point instructions. See 'Guidelines for Writing
to the MXCSR Register' in Chapter 11 of the Intel® 64 and IA-32
Architectures Software Developer's Manual, Volume 1, for instructions
for how to determine and use the MXCSR\_MASK value.

ST0/MM0 through

x87 FPU or MMX technology registers. These 80-bit fields contain the x87

ST7/MM7

FPU data registers or the MMX technology registers, depending on the
state of the processor prior to the execution of the FXSAVE instruction.
If the processor had been executing x87 FPU instruction prior to the
FXSAVE instruction, the x87 FPU data registers are saved; if it had been
executing MMX instructions (or SSE or SSE2 instructions that operated on
the MMX technology registers), the MMX technology registers are saved.
When the MMX technology registers are saved, the high 16 bits of the
field are reserved.

XMM0 through XMM7

XMM registers (128 bits per field). If the OSFXSR bit in control
register CR4 is not set, the FXSAVE instruction may not save these
registers. This behavior is implementation dependent.

The FXSAVE instruction saves an abridged version of the x87 FPU tag word
in the FTW field (unlike the FSAVE instruction, which saves the complete
tag word). The tag information is saved in physical register order (R0
through R7), rather than in top-ofstack (TOS) order. With the FXSAVE
instruction, however, only a single bit (1 for valid or 0 for empty) is
saved for each tag. For example, assume that the tag word is currently
set as follows:

  ---- ---- ---- ---- ---- ---- ---- ----
  R7   R6   R5   R4   R3   R2   R1   R0
  11   xx   xx   xx   11   11   11   11
  ---- ---- ---- ---- ---- ---- ---- ----

Here, 11B indicates empty stack elements and 'xx' indicates valid (00B),
zero (01B), or special (10B).

For this example, the FXSAVE instruction saves only the following 8 bits
of information:

  ---- ---- ---- ---- ---- ---- ---- ----
  R7   R6   R5   R4   R3   R2   R1   R0
  0    1    1    1    0    0    0    0
  ---- ---- ---- ---- ---- ---- ---- ----

Here, a 1 is saved for any valid, zero, or special tag, and a 0 is saved
for any empty tag.

The operation of the FXSAVE instruction differs from that of the FSAVE
instruction, the as follows:

-   FXSAVE instruction does not check for pending unmasked
    floating-point exceptions. (The FXSAVE operation in this regard is
    similar to the operation of the FNSAVE instruction).
-   After the FXSAVE instruction has saved the state of the x87 FPU, MMX
    technology, XMM, and MXCSR registers, the processor retains the
    contents of the registers. Because of this behavior, the FXSAVE
    instruction cannot be used by an application program to pass a
    'clean' x87 FPU state to a procedure, since it retains the current
    state. To clean the x87 FPU state, an application must explicitly
    execute an FINIT instruction after an FXSAVE instruction to
    reinitialize the x87 FPU state.
-   The format of the memory image saved with the FXSAVE instruction is
    the same regardless of the current addressing mode (32-bit or
    16-bit) and operating mode (protected, real address, or system
    management). This behavior differs from the FSAVE instructions,
    where the memory image format is different depending on the
    addressing mode and operating mode. Because of the different image
    formats, the memory image saved with the FXSAVE instruction cannot
    be restored correctly with the FRSTOR instruction, and likewise the
    state saved with the FSAVE instruction cannot be restored correctly
    with the FXRSTOR instruction.

The FSAVE format for FTW can be recreated from the FTW valid bits and
the stored 80-bit FP data (assuming the stored data was not the contents
of MMX technology registers) using Table 3-50.

  Exponent all 1's                    Exponent all 0's   Fraction all 0's   J and M bits   FTW valid bit   x87 FTW
  ----------------------------------- ------------------ ------------------ -------------- --------------- --------- ----
  0                                   0                  0                  0x             1               Special   10
  0                                   0                  0                  1x             1               Valid     00
  0                                   0                  1                  00             1               Special   10
  0                                   0                  1                  10             1               Valid     00
  0                                   1                  0                  0x             1               Special   10
  0                                   1                  0                  1x             1               Special   10
  0                                   1                  1                  00             1               Zero      01
  0                                   1                  1                  10             1               Special   10
  1                                   0                  0                  1x             1               Special   10
  1                                   0                  0                  1x             1               Special   10
  1                                   0                  1                  00             1               Special   10
  1                                   0                  1                  10             1               Special   10
  For all legal combinations above.   0                  Empty              11

  : Recreating FSAVE Format

The J-bit is defined to be the 1-bit binary integer to the left of the
decimal place in the significand. The M-bit is defined to be the most
significant bit of the fractional portion of the significand (i.e., the
bit immediately to the right of the decimal place).

When the M-bit is the most significant bit of the fractional portion of
the significand, it must be 0 if the fraction is all 0's.

### IA-32e Mode Operation

In compatibility sub-mode of IA-32e mode, legacy SSE registers, XMM0
through XMM7, are saved according to the legacy FXSAVE map. In 64-bit
mode, all of the SSE registers, XMM0 through XMM15, are saved.
Additionally, there are two different layouts of the FXSAVE map in
64-bit mode, corresponding to FXSAVE64 (which requires REX.W=1) and
FXSAVE (REX.W=0). In the FXSAVE64 map (following table), theFPU IP and
FPU DP pointers are 64-bit wide. In the FXSAVE map for 64-bit mode (see
the following tables), the FPU IP and FPU DP pointers are 32-bits.

  ------------- --------- ---------- ----- ----- ----- --- --- --- --- --- --- --- --- --- --- --
  15            14        13         12    11    10    9   8   7   6   5   4   3   2   1   0   
  FPU IP        FOP       Reserved   FTW   FSW   FCW   0
  MXCSR\_MASK   MXCSR     FPU DP     16
  Reserved      ST0/MM0   32
  Reserved      ST1/MM1   48
  Reserved      ST2/MM2   64
  Reserved      ST3/MM3   80
  Reserved      ST4/MM4   96
  Reserved      ST5/MM5   112
  Reserved      ST6/MM6   128
  Reserved      ST7/MM7   144
  XMM0          160
  XMM1          176
  XMM2          192
  XMM3          208
  XMM4          224
  XMM5          240
  XMM6          256
  XMM7          272
  XMM8          288
  XMM9          304
  XMM10         320
  XMM11         336
  XMM12         352
  XMM13         368
  XMM14         384
  XMM15         400
  Reserved      416
  Reserved      432
  Reserved      448
  Available     464
  Available     480
  Available     496
  ------------- --------- ---------- ----- ----- ----- --- --- --- --- --- --- --- --- --- --- --

  : Layout of the 64-bit-mode FXSAVE64 Map (requires REX.W = 1)

  ------------- --------- ---------- -------- ---------- ----- ----- ----- --- --- --- --- --- --- --- --- --
  15            14        13         12       11         10    9     8     7   6   5   4   3   2   1   0   
  Reserved      CS        FPU IP     FOP      Reserved   FTW   FSW   FCW   0
  MXCSR\_MASK   MXCSR     Reserved   FPU DP   16
  Reserved      ST0/MM0   32
  Reserved      ST1/MM1   48
  Reserved      ST2/MM2   64
  Reserved      ST3/MM3   80
  ------------- --------- ---------- -------- ---------- ----- ----- ----- --- --- --- --- --- --- --- --- --

  : Layout of the 64-bit-mode FXSAVE Map (REX.W = 0)

Reserved

ST4/MM4

96

Reserved

ST5/MM5

112

Reserved

ST6/MM6

128

Reserved

ST7/MM7

144

XMM0

160

XMM1

176

XMM2

192

XMM3

208

XMM4

224

XMM5

240

XMM6

256

XMM7

272

XMM8

288

XMM9

304

XMM10

320

XMM11

336

XMM12

352

XMM13

368

XMM14

384

XMM15

400

Reserved

416

Reserved

432

Reserved

448

Available

464

Available

480

Available

496

"
	^ self 
		addInstruction: #fxsave
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
mov: aDestinationRegisterOrMemory with: aSource
	"Move
	Description
-----------
Copies the second operand (source operand) to the first operand
(destination operand). The source operand can be an immediate value,
general-purpose register, segment register, or memory location; the
destination register can be a general-purpose register, segment
register, or memory location. Both operands must be the same size, which
can be a byte, a word, a doubleword, or a quadword.

The MOV instruction cannot be used to load the CS register. Attempting
to do so results in an invalid opcode exception (\#UD). To load the CS
register, use the far JMP, CALL, or RET instruction.

If the destination operand is a segment register (DS, ES, FS, GS, or
SS), the source operand must be a valid segment selector. In protected
mode, moving a segment selector into a segment register automatically
causes the segment descriptor information associated with that segment
selector to be loaded into the hidden (shadow) part of the segment
register. While loading this information, the segment selector and
segment descriptor information is validated (see the 'Operation'
algorithm below). The segment descriptor data is obtained from the GDT
or LDT entry for the specified segment selector.

A NULL segment selector (values 0000-0003) can be loaded into the DS,
ES, FS, and GS registers without causing a protection exception.
However, any subsequent attempt to reference a segment whose
corresponding segment register is loaded with a NULL value causes a
general protection exception (\#GP) and no memory reference occurs.

Loading the SS register with a MOV instruction inhibits all interrupts
until after the execution of the next instruction. This operation allows
a stack pointer to be loaded into the ESP register with the next
instruction (MOV ESP, stack-pointer value) before an interrupt occurs1.
Be aware that the LSS instruction offers a more efficient method of
loading the SS and ESP registers.

When operating in 32-bit mode and moving data between a segment register
and a general-purpose register, the 32-bit IA-32 processors do not
require the use of the 16-bit operand-size prefix (a byte with the value
66H) with this instruction, but most assemblers will insert it if the
standard form of the instruction is used (for example, MOV DS, AX). The
processor will execute this instruction correctly, but it will usually
require an extra clock. With most assemblers, using the instruction form
MOV DS, EAX will avoid this unneeded 66H prefix. When the processor
executes the instruction with a 32-bit general-purpose register, it
assumes that the 16 least-significant bits of the general-purpose
register are the destination or source operand. If the register is a
destination operand, the resulting value in the two high-order bytes of
the register is implementation dependent. For the Pentium 4, Intel Xeon,
and P6 family processors, the two high-order bytes are filled with
zeros; for earlier 32-bit IA-32 processors, the two high order bytes are
undefined.

In 64-bit mode, the instruction's default operation size is 32 bits. Use
of the REX.R prefix permits access to additional registers (R8-R15). Use
of the REX.W prefix promotes operation to 64 bits. See the summary chart
at the beginning of this section for encoding data and limits.

"
	^ self 
		addInstruction: #mov
		operands: { aDestinationRegisterOrMemory . aSource }! !

!AJx86Assembler methodsFor: 'initialization' stamp: 'CamilloBruni 3/30/2012 16:20'!
initialize
	is64 := false.
	self reset.! !

!AJx86Assembler methodsFor: 'register' stamp: ''!
data
	^ self is32BitMode ifTrue: [ EDX ] ifFalse: [ DX ]! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmovbe: aRegister with: aSourceRegisterOrMemory
	"Conditional Move - below or equal/not above (CF=1 AND ZF=1)
	"
	^ self 
		addInstruction: #cmovbe
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
imul: aRegister with: aRegisterOrMemory with: anImmediate
	"
	see #imul"
	^ self 
		addInstruction: #imul
		operands: { aRegister . aRegisterOrMemory . anImmediate }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
jnc: targetLabel
	"
	"
	^ self 
		addInstruction: #jnc
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
movmskpd: aRegisterOrMemory1 with: aRegisterOrMemory2
	"Extract Packed Double-FP Sign Mask
	Pseudo Code
-----------
DEST[0] = SRC[63];
DEST[1] = SRC[127];
IF DEST = r32
    DEST[31:2] = ZeroExtend;
ELSE
    DEST[63:2] = ZeroExtend;
FI;

Description
-----------
Extracts the sign bits from the packed double-precision floating-point
values in the source operand (second operand), formats them into a 2-bit
mask, and stores the mask in the destination operand (first operand).
The source operand is an XMM register, and the destination operand is a
general-purpose register. The mask is stored in the 2 low-order bits of
the destination operand. Zero-extend the upper bits of the destination.

In 64-bit mode, the instruction can access additional registers
(XMM8-XMM15, R8-R15) when used with a REX.R prefix. The default operand
size is 64-bit in 64-bit mode.

"
	^ self 
		addInstruction: #movmskpd
		operands: { aRegisterOrMemory1 . aRegisterOrMemory2 }! !

!AJx86Assembler methodsFor: 'function calls' stamp: ''!
newCdeclCall

	"answer an instance of CallInfo"
	^ stackManager newCdeclCall asm: self.! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmovae: aRegister with: aSourceRegisterOrMemory
	"
	"
	^ self 
		addInstruction: #cmovae
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'converting' stamp: ''!
imm: value
	^ value asImm ! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
jnle: targetLabel
	"Jump short if not less nor equal/greater ((ZF=0) AND (SF=OF))
	"
	^ self 
		addInstruction: #jnle
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
adc: aRegisterOrMemoryOperand with: aSource
	"Add with Carry
	"
	^ self 
		addInstruction: #adc
		operands: { aRegisterOrMemoryOperand . aSource }! !

!AJx86Assembler methodsFor: 'accessing' stamp: 'CamilloBruni 8/23/2012 16:01'!
instructionDesciptions
	^ AJx86InstructionDescription instructions! !

!AJx86Assembler methodsFor: 'register' stamp: 'CamilloBruni 1/10/2013 18:58'!
stackPointer
	^ self is32 ifTrue: [ ESP ] ifFalse: [ RSP ]! !

!AJx86Assembler methodsFor: 'options' stamp: ''!
noStackFrame
	stackManager noStackFrame.! !

!AJx86Assembler methodsFor: 'initialize-release' stamp: ''!
reset 
	instructions := last := nil. 
	labels := Dictionary new.
	stackManager
		ifNil: [stackManager := AJRoutineStackManager new.]
		ifNotNil: #reset.		
	level := 0.
	self addInstruction: AJRoutinePrologue new.  ! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
XMM1
	"An SSE register"
	^ XMM1! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fstcw: aMemoryOperand
	"Store x87 FPU Control Word
	"
	^ self 
		addInstruction: #fstcw
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
ficom: aMemoryOperand
	"Compare Integer
	"
	^ self 
		addInstruction: #ficom
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
MM4
	"An MMX register"
	^ MM4! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmovp: aRegister with: aSourceRegisterOrMemory
	"Conditional Move - parity/parity even (PF=1)
	"
	^ self 
		addInstruction: #cmovp
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fmul: aMemoryOperand
	"Multiply
	"
	^ self 
		addInstruction: #fmul
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fsubp: aX87Register
	"Subtract and Pop
	"
	^ self 
		addInstruction: #fsubp
		operands: { aX87Register }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fucomp: aX87Register
	"Unordered Compare Floating Point Values and Pop
	"
	^ self 
		addInstruction: #fucomp
		operands: { aX87Register }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
dec: aRegisterOrMemory
	"Decrement by 1
	Pseudo Code
-----------
DEST = DEST - 1;

Description
-----------
Subtracts 1 from the destination operand, while preserving the state of
the CF flag. The destination operand can be a register or a memory
location. This instruction allows a loop counter to be updated without
disturbing the CF flag. (To perform a decrement operation that updates
the CF flag, use a SUB instruction with an immediate operand of 1.)

This instruction can be used with a LOCK prefix to allow the instruction
to be executed atomically.

In 64-bit mode, DEC r16 and DEC r32 are not encodable (because opcodes
48H through 4FH are REX prefixes). Otherwise, the instruction's 64-bit
mode default operation size is 32 bits. Use of the REX.R prefix permits
access to additional registers (R8-R15). Use of the REX.W prefix
promotes operation to 64 bits.

See the summary chart at the beginning of this section for encoding data
and limits.

"
	^ self 
		addInstruction: #dec
		operands: { aRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'stack management' stamp: ''!
releaseTemps: count
	^ self addInstruction: (AJReleaseTemps new count: count).! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmove: aRegister with: aSourceRegisterOrMemory
	"
	"
	^ self 
		addInstruction: #cmove
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmpxchg16b: aMemoryOperand
	"...
	"
	^ self 
		addInstruction: #cmpxchg16b
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fbld: aMemoryOperand
	"Load Binary Coded Decimal
	Pseudo Code
-----------
TOP = TOP - 1;
ST(0) = ConvertToDoubleExtendedPrecisionFP(SRC);

Description
-----------
Converts the BCD source operand into double extended-precision
floating-point format and pushes the value onto the FPU stack. The
source operand is loaded without rounding errors. The sign of the source
operand is preserved, including that of -0.

The packed BCD digits are assumed to be in the range 0 through 9; the
instruction does not check for invalid digits (AH through FH).
Attempting to load an invalid encoding produces an undefined result.

This instruction's operation is the same in non-64-bit modes and 64-bit
mode.

"
	^ self 
		addInstruction: #fbld
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fldcw: aMemoryOperand
	"Load x87 FPU Control Word
	"
	^ self 
		addInstruction: #fldcw
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
and: aRegisterOrMemoryOperand with: aSource
	"Logical AND
	"
	^ self 
		addInstruction: #and
		operands: { aRegisterOrMemoryOperand . aSource }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
movsxd: aDestinationRegister with: aSourceRegisterOrMemory
	"Move with Sign-Extension
	"
	^ self 
		addInstruction: #movsxd
		operands: { aDestinationRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmovna: aRegister with: aSourceRegisterOrMemory
	"
	"
	^ self 
		addInstruction: #cmovna
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmovo: aRegister with: aSourceRegisterOrMemory
	"Conditional Move - overflow (OF=1)
	"
	^ self 
		addInstruction: #cmovo
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fcomip: aX87Register
	"Compare Floating Point Values and Set EFLAGS and Pop
	"
	^ self 
		addInstruction: #fcomip
		operands: { aX87Register }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
AH
	"A 8bit general purpose register
	This register overlaps with AH, AX, EAX, RAX"
	^ AH! !

!AJx86Assembler methodsFor: 'instruction list' stamp: 'CamilloBruni 4/25/2012 14:23'!
addInstruction: sel operands: operands

	^ self 
		addInstruction: sel 
		description: (self instructionDesciptions at: sel)
		operands: operands ! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmovne: aRegister with: aSourceRegisterOrMemory
	"
	"
	^ self 
		addInstruction: #cmovne
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fild: aMemoryOperand
	"Load Integer
	Pseudo Code
-----------
TOP = TOP - 1;
ST(0) = ConvertToDoubleExtendedPrecisionFP(SRC);

Description
-----------
Converts the signed-integer source operand into double
extended-precision floating-point format and pushes the value onto the
FPU register stack. The source operand can be a word, doubleword, or
quadword integer. It is loaded without rounding errors. The sign of the
source operand is preserved.

This instruction's operation is the same in non-64-bit modes and 64-bit
mode.

"
	^ self 
		addInstruction: #fild
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
bts: aDestinationRegisterOrMemory with: aSourceRegisterOrImmediate
	"Bit Test and Set
	Pseudo Code
-----------
CF = Bit(BitBase, BitOffset);
Bit(BitBase, BitOffset) = 1;

Description
-----------
Selects the bit in a bit string (specified with the first operand,
called the bit base) at the bit-position designated by the bit offset
operand (second operand), stores the value of the bit in the CF flag,
and sets the selected bit in the bit string to 1. The bit base operand
can be a register or a memory location; the bit offset operand can be a
register or an immediate value:

-   If the bit base operand specifies a register, the instruction takes
    the modulo 16, 32, or 64 of the bit offset operand (modulo size
    depends on the mode and register size; 64-bit operands are available
    only in 64-bit mode). This allows any bit position to be selected.
-   If the bit base operand specifies a memory location, the operand
    represents the address of the byte in memory that contains the bit
    base (bit 0 of the specified byte) of the bit string. The range of
    the bit position that can be referenced by the offset operand
    depends on the operand size.

See also: Bit(BitBase, BitOffset) on page 3-11.

Some assemblers support immediate bit offsets larger than 31 by using
the immediate bit offset field in combination with the displacement
field of the memory operand. See 'BT—Bit Test' in this chapter for more
information on this addressingmechanism.

This instruction can be used with a LOCK prefix to allow the instruction
to be executed atomically.

In 64-bit mode, the instruction's default operation size is 32 bits.
Using a REX prefix in the form of REX.R permits access to additional
registers (R8-R15). Using a REX prefix in the form of REX.W promotes
operation to 64 bits. See the summary chart at the beginning of this
section for encoding data and limits.

"
	^ self 
		addInstruction: #bts
		operands: { aDestinationRegisterOrMemory . aSourceRegisterOrImmediate }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmovb: aRegister with: aSourceRegisterOrMemory
	"Conditional Move - below/not above or equal/carry (CF=1)
	"
	^ self 
		addInstruction: #cmovb
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'testing' stamp: ''!
isLabelUsed: aLabel
	| used |
	used := false.
	instructions do: [:instr |
		used := used or: [instr isLabelUsed: aLabel ] ].
	^ used! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
XMM3
	"An SSE register"
	^ XMM3! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
pop: aRegisterOrMemoryDestination
	"Pop a Value from the Stack
	Description
-----------
Loads the value from the top of the stack to the location specified with
the destination operand (or explicit opcode) and then increments the
stack pointer. The destination operand can be a general-purpose
register, memory location, or segment register.

The address-size attribute of the stack segment determines the stack
pointer size (16, 32, 64 bits) and the operand-size attribute of the
current code segment determines the amount the stack pointer is
incremented (2, 4, 8 bytes).

For example, if the address- and operand-size attributes are 32, the
32-bit ESP register (stack pointer) is incremented by 4; if they are 16,
the 16-bit SP register is incremented by 2. (The B flag in the stack
segment's segment descriptor determines the stack's address-size
attribute, and the D flag in the current code segment's segment
descriptor, along with prefixes, determines the operand-size attribute
and also the address-size attribute of the destination operand.)

If the destination operand is one of the segment registers DS, ES, FS,
GS, or SS, the value loaded into the register must be a valid segment
selector. In protected mode, popping a segment selector into a segment
register automatically causes the descriptor information associated with
that segment selector to be loaded into the hidden (shadow) part of the
segment register and causes the selector and the descriptor information
to be validated (see the 'Operation' section below).

A NULL value (0000-0003) may be popped into the DS, ES, FS, or GS
register without causing a general protection fault. However, any
subsequent attempt to reference a segment whose corresponding segment
register is loaded with a NULL value causes a general protection
exception (\#GP). In this situation, no memory reference occurs and the
saved value of the segment register is NULL.

The POP instruction cannot pop a value into the CS register. To load the
CS register from the stack, use the RET instruction.

If the ESP register is used as a base register for addressing a
destination operand in memory, the POP instruction computes the
effective address of the operand after it increments the ESP register.
For the case of a 16-bit stack where ESP wraps to 0H as a result of the
POP instruction, the resulting location of the memory write is
processor-family-specific.

The POP ESP instruction increments the stack pointer (ESP) before data
at the old top of stack is written into the destination.

A POP SS instruction inhibits all interrupts, including the NMI
interrupt, until after execution of the next instruction. This action
allows sequential execution of POP SS and MOV ESP, EBP instructions
without the danger of having an invalid stack during an interrupt1.
However, use of the LSS instruction is the preferred method of loading
the SS and ESP registers.

In 64-bit mode, using a REX prefix in the form of REX.R permits access
to additional registers (R8-R15). When in 64-bit mode, POPs using 32-bit
operands are not encodable and POPs to DS, ES, SS are not valid. See the
summary chart at the beginning of this section for encoding data and
limits.

"
	^ self 
		addInstruction: #pop
		operands: { aRegisterOrMemoryDestination }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
rcl: aDestinationRegisterOrMemory with: aRegisterOrImmediate
	"Rotate
	"
	^ self 
		addInstruction: #rcl
		operands: { aDestinationRegisterOrMemory . aRegisterOrImmediate }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmovnc: aRegister with: aSourceRegisterOrMemory
	"
	"
	^ self 
		addInstruction: #cmovnc
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
shld: aDestinationRegisterOrMemory with: aSourceRegister with: aSourceRegisterOrImmediate
	"Double Precision Shift Left
	Description
-----------
The SHLD instruction is used for multi-precision shifts of 64 bits or
more.

The instruction shifts the first operand (destination operand) to the
left the number of bits specified by the third operand (count operand).
The second operand (source operand) provides bits to shift in from the
right (starting with bit 0 of the destination operand).

The destination operand can be a register or a memory location; the
source operand is a register. The count operand is an unsigned integer
that can be stored in an immediate byte or in the CL register. If the
count operand is CL, the shift count is the logical AND of CL and a
count mask. In non-64-bit modes and default 64-bit mode; only bits 0
through 4 of the count are used. This masks the count to a value between
0 and 31. If a count is greater than the operand size, the result is
undefined.

If the count is 1 or greater, the CF flag is filled with the last bit
shifted out of the destination operand. For a 1-bit shift, the OF flag
is set if a sign change occurred; otherwise, it is cleared. If the count
operand is 0, flags are not affected.

In 64-bit mode, the instruction's default operation size is 32 bits.
Using a REX prefix in the form of REX.R permits access to additional
registers (R8-R15). Using a REX prefix in the form of REX.W promotes
operation to 64 bits (upgrading the count mask to 6 bits). See the
summary chart at the beginning of this section for encoding data and
limits.

"
	^ self 
		addInstruction: #shld
		operands: { aDestinationRegisterOrMemory . aSourceRegister . aSourceRegisterOrImmediate }! !

!AJx86Assembler methodsFor: 'accessing' stamp: 'CamilloBruni 3/28/2012 14:43'!
reg8: index

	"answer one of 8bit general-purpose registers, based on index"
	
	index < 0 ifTrue: [ self invalidRegisterIndex ].
	(index >= self numGPRegisters) ifTrue: [ self invalidRegisterIndex ].

	^ AJx86Registers code: index! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
jle: targetLabel
	"Jump short if less or equal/not greater ((ZF=1) OR (SF!!=OF))
	"
	^ self 
		addInstruction: #jle
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'accessing' stamp: ''!
reg: index size: nBytes

	nBytes = 1 ifTrue: [ ^ self reg8: index ].
	nBytes = 2 ifTrue: [ ^ self reg16: index ].
	nBytes = 4 ifTrue: [ ^ self reg32: index ].
	nBytes = 8 ifTrue: [ ^ self reg64: index ].

	self error: 'invalid register size'.! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
movntpd: aRegisterOrMemory1 with: aRegisterOrMemory2
	"Store Packed Double-FP Values Using Non-Temporal Hint
	Pseudo Code
-----------
DEST = SRC;

Description
-----------
Moves the double quadword in the source operand (second operand) to the
destination operand (first operand) using a non-temporal hint to
minimize cache pollution during the write to memory. The source operand
is an XMM register, which is assumed to contain two packed
double-precision floating-point values. The destination operand is a
128-bit memory location.

The non-temporal hint is implemented by using a write combining (WC)
memory type protocol when writing the data to memory. Using this
protocol, the processor does not write the data into the cache
hierarchy, nor does it fetch the corresponding cache line from memory
into the cache hierarchy. The memory type of the region being written to
can override the non-temporal hint, if the memory address specified for
the non-temporal store is in an uncacheable (UC) or write protected (WP)
memory region. For more information on non-temporal stores, see 'Caching
of Temporal vs. Non-Temporal Data' in Chapter 10 in theIntel®64 and
IA-32 Architectures Software Developer's Manual, Volume 1.

Because the WC protocol uses a weakly-ordered memory consistency model,
a fencing operation implemented with the SFENCE or MFENCE instruction
should be used in conjunction with MOVNTPD instructions if multiple
processors might use different memory types to read/write the
destination memory locations.

In 64-bit mode, use of the REX.R prefix permits this instruction to
access additional registers (XMM8-XMM15).

"
	^ self 
		addInstruction: #movntpd
		operands: { aRegisterOrMemory1 . aRegisterOrMemory2 }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
SP
	"A 16bit general purpose register
	This register overlaps with AH, AX, EAX, RAX"
	^ SP! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
btr: aDestinationRegisterOrMemory with: aSourceRegisterOrImmediate
	"Bit Test and Reset
	Pseudo Code
-----------
CF = Bit(BitBase, BitOffset);
Bit(BitBase, BitOffset) = 0;

Description
-----------
Selects the bit in a bit string (specified with the first operand,
called the bit base) at the bit-position designated by the bit offset
operand (second operand), stores the value of the bit in the CF flag,
and clears the selected bit in the bit string to 0. The bit base operand
can be a register or a memory location; the bit offset operand can be a
register or an immediate value:

-   If the bit base operand specifies a register, the instruction takes
    the modulo 16, 32, or 64 of the bit offset operand (modulo size
    depends on the mode and register size; 64-bit operands are available
    only in 64-bit mode). This allows any bit position to be selected.
-   If the bit base operand specifies a memory location, the operand
    represents the address of the byte in memory that contains the bit
    base (bit 0 of the specified byte) of the bit string. The range of
    the bit position that can be referenced by the offset operand
    depends on the operand size.

See also: Bit(BitBase, BitOffset) on page 3-11.

Some assemblers support immediate bit offsets larger than 31 by using
the immediate bit offset field in combination with the displacement
field of the memory operand. See 'BT—Bit Test' in this chapter for more
information on this addressingmechanism.

This instruction can be used with a LOCK prefix to allow the instruction
to be executed atomically.

In 64-bit mode, the instruction's default operation size is 32 bits.
Using a REX prefix in the form of REX.R permits access to additional
registers (R8-R15). Using a REX prefix in the form of REX.W promotes
operation to 64 bits. See the summary chart at the beginning of this
section for encoding data and limits.

"
	^ self 
		addInstruction: #btr
		operands: { aDestinationRegisterOrMemory . aSourceRegisterOrImmediate }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fcom: aX87Register1 with: aX87Register2
	"
	see #fcom"
	^ self 
		addInstruction: #fcom
		operands: { aX87Register1 . aX87Register2 }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fucomi: aX87Register
	"Unordered Compare Floating Point Values and Set EFLAGS
	"
	^ self 
		addInstruction: #fucomi
		operands: { aX87Register }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
movdq2q: aRegisterOrMemory1 with: aRegisterOrMemory2
	"Move Quadword from XMM to MMX Technology Register
	Pseudo Code
-----------
DEST = SRC[63:0];

Description
-----------
Moves the low quadword from the source operand (second operand) to the
destination operand (first operand). The source operand is an XMM
register and the destination operand is an MMX technology register.

This instruction causes a transition from x87 FPU to MMX technology
operation (that is, the x87 FPU top-of-stack pointer is set to 0 and the
x87 FPU tag word is set to all 0s [valid]). If this instruction is
executed while an x87 FPU floating-point exception is pending, the
exception is handled before the MOVDQ2Q instruction is executed.

In 64-bit mode, use of the REX.R prefix permits this instruction to
access additional registers (XMM8-XMM15).

"
	^ self 
		addInstruction: #movdq2q
		operands: { aRegisterOrMemory1 . aRegisterOrMemory2 }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmovs: aRegister with: aSourceRegisterOrMemory
	"Conditional Move - sign (SF=1)
	"
	^ self 
		addInstruction: #cmovs
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'function calls' stamp: ''!
performingCall: ci in: aBlock

	ci 
		asm: self;
		alignmentInsertionPoint: last.
	aBlock value: ci.
	self callCleanup: ci.! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
movlhps: aRegisterOrMemory1 with: aRegisterOrMemory2
	"Move Packed Single-FP Values Low to High
	Pseudo Code
-----------
DEST[127:64] = SRC[63:0]; (* DEST[63:0] unchanged *)

Description
-----------
Moves two packed single-precision floating-point values from the low
quadword of the source operand (second operand) to the high quadword of
the destination operand (first operand). The low quadword of the
destination operand is left unchanged.

In 64-bit mode, use of the REX.R prefix permits this instruction to
access additional registers (XMM8-XMM15).

"
	^ self 
		addInstruction: #movlhps
		operands: { aRegisterOrMemory1 . aRegisterOrMemory2 }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
ST5
	"A floating point register"
	^ ST5! !

!AJx86Assembler methodsFor: 'instruction list' stamp: ''!
insert: newInstruction before: anInstruction

	"insert one or more instructions before an instruction"
	
	^ instructions := instructions insert: newInstruction before: anInstruction! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
movPtr: aRegisterOrImmedate1 with: aRegisterOrImmedate2
	"
	"
	^ self 
		addInstruction: #movPtr
		operands: { aRegisterOrImmedate1 . aRegisterOrImmedate2 }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
ST3
	"A floating point register"
	^ ST3! !

!AJx86Assembler methodsFor: 'alignment' stamp: ''!
alignQuad
	self addInstruction: AJAlignmentInstruction alignQuad! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fcomp: aX87Register1 with: aX87Register2
	"
	see #fcomp"
	^ self 
		addInstruction: #fcomp
		operands: { aX87Register1 . aX87Register2 }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
shrd: aDestinationRegisterOrMemory with: aSourceRegister with: aSourceRegisterOrImmediate
	"Double Precision Shift Right
	Description
-----------
The SHRD instruction is useful for multi-precision shifts of 64 bits or
more.

The instruction shifts the first operand (destination operand) to the
right the number of bits specified by the third operand (count operand).
The second operand (source operand) provides bits to shift in from the
left (starting with the most significant bit of the destination
operand).

The destination operand can be a register or a memory location; the
source operand is a register. The count operand is an unsigned integer
that can be stored in an immediate byte or the CL register. If the count
operand is CL, the shift count is the logical AND of CL and a count
mask. In non-64-bit modes and default 64-bit mode, the width of the
count mask is 5 bits. Only bits 0 through 4 of the count register are
used (masking the count to a value between 0 and 31). If the count is
greater than the operand size, the result is undefined.

If the count is 1 or greater, the CF flag is filled with the last bit
shifted out of the destination operand. For a 1-bit shift, the OF flag
is set if a sign change occurred; otherwise, it is cleared. If the count
operand is 0, flags are not affected.

In 64-bit mode, the instruction's default operation size is 32 bits.
Using a REX prefix in the form of REX.R permits access to additional
registers (R8-R15). Using a REX prefix in the form of REX.W promotes
operation to 64 bits (upgrading the count mask to 6 bits). See the
summary chart at the beginning of this section for encoding data and
limits.

"
	^ self 
		addInstruction: #shrd
		operands: { aDestinationRegisterOrMemory . aSourceRegister . aSourceRegisterOrImmediate }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fist: aMemoryOperand
	"Store Integer
	"
	^ self 
		addInstruction: #fist
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
CX
	"A 16bit general purpose register
	This register overlaps with CL, CX, ECX, RCX"
	^ CX! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
ret: anImmediate
	"
	"
	^ self 
		addInstruction: #ret
		operands: { anImmediate }! !

!AJx86Assembler methodsFor: 'stack management' stamp: 'MartinMcClure 2/9/2013 14:25'!
stackFrameValueAtOffset: offset

	^ EBP ptr32 - offset! !

!AJx86Assembler methodsFor: 'function calls' stamp: ''!
callCleanup: anAJCdeclCallInfo 

	^ self addInstruction:   (AJCallCleanup new callInfo: anAJCdeclCallInfo )! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
jl: targetLabel
	"Jump short if less/not greater (SF!!=OF)
	"
	^ self 
		addInstruction: #jl
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
ficomp: aMemoryOperand
	"Compare Integer and Pop
	"
	^ self 
		addInstruction: #ficomp
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fld: aMemoryOrX87Register
	"Load Floating Point Value
	Description
-----------
Pushes the source operand onto the FPU register stack. The source
operand can be in single-precision, double-precision, or double
extended-precision floating-point format. If the source operand is in
single-precision or double-precision floating-point format, it is
automatically converted to the double extended-precision floating-point
format before being pushed on the stack.

The FLD instruction can also push the value in a selected FPU register
[ST(i)] onto the stack. Here, pushing register ST(0) duplicates the
stack top.

This instruction's operation is the same in non-64-bit modes and 64-bit
mode.

"
	^ self 
		addInstruction: #fld
		operands: { aMemoryOrX87Register }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fbstp: aMemoryOperand
	"Store BCD Integer and Pop
	Pseudo Code
-----------
DEST = BCD(ST(0));
PopRegisterStack;

Description
-----------
Converts the value in the ST(0) register to an 18-digit packed BCD
integer, stores the result in the destination operand, and pops the
register stack. If the source value is a non-integral value, it is
rounded to an integer value, according to rounding mode specified by the
RC field of the FPU control word. To pop the register stack, the
processor marks the ST(0) register as empty and increments the stack
pointer (TOP) by 1.

The destination operand specifies the address where the first byte
destination value is to be stored. The BCD value (including its sign
bit) requires 10 bytes of space in memory.

The following table shows the results obtained when storing various
classes of numbers in packed BCD format.

  ST(0)                                    DEST
  ---------------------------------------- ------
  - = or Value Too Large for DEST Format   \*
  F \<= - 1                                - D
  -1 \< F \< -0                            \*\*
  - 0                                      - 0
  + 0                                      + 0
  + 0 \< F \< +1                           \*\*
  F \>= +1                                 + D
  + = or Value Too Large for DEST Format   \*
  NaN                                      \*

  : FBSTP Results

-   Notes:
-   F refers to a finite floating-point value.
-   D refers to packed-BCD number.
-   \* Indicates floating-point invalid-operation (\#IA) exception.
-   \*\* ±0 or ±1, depending on the rounding mode.

If the converted value is too large for the destination format, or if
the source operand is an ∞, SNaN, QNAN, or is in an unsupported format,
an invalid-arithmetic-operand condition is signaled. If the
invalid-operation exception is not masked, an invalidarithmetic-operand
exception (\#IA) is generated and no value is stored in the desti-nation
operand. If the invalid-operation exception is masked, the packed BCD
indefinite value is stored in memory.

This instruction's operation is the same in non-64-bit modes and 64-bit
mode.

"
	^ self 
		addInstruction: #fbstp
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
jpe: targetLabel
	"
	"
	^ self 
		addInstruction: #jpe
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
ECX
	"A 32bit general purpose register
	This register overlaps with CL, CX, ECX, RCX"
	^ ECX! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
movnti: aRegisterOrMemory1 with: aRegisterOrMemory2
	"Store Doubleword Using Non-Temporal Hint
	Pseudo Code
-----------
DEST = SRC;

Description
-----------
Moves the doubleword integer in the source operand (second operand) to
the destination operand (first operand) using a non-temporal hint to
minimize cache pollution during the write to memory. The source operand
is a general-purpose register. The destination operand is a 32-bit
memory location.

The non-temporal hint is implemented by using a write combining (WC)
memory type protocol when writing the data to memory. Using this
protocol, the processor does not write the data into the cache
hierarchy, nor does it fetch the corresponding cache line from memory
into the cache hierarchy. The memory type of the region being written to
can override the non-temporal hint, if the memory address specified for
the non-temporal store is in an uncacheable (UC) or write protected (WP)
memory region. For more information on non-temporal stores, see 'Caching
of Temporal vs. Non-Temporal Data' in Chapter 10 in theIntel®64 and
IA-32 Architectures Software Developer's Manual, Volume 1.

Because the WC protocol uses a weakly-ordered memory consistency model,
a fencing operation implemented with the SFENCE or MFENCE instruction
should be used in conjunction with MOVNTI instructions if multiple
processors might use different memory types to read/write the
destination memory locations.

In 64-bit mode, the instruction's default operation size is 32 bits. Use
of the REX.R prefix permits access to additional registers (R8-R15). Use
of the REX.W prefix promotes operation to 64 bits. See the summary chart
at the beginning of this section for encoding data and limits.

"
	^ self 
		addInstruction: #movnti
		operands: { aRegisterOrMemory1 . aRegisterOrMemory2 }! !

!AJx86Assembler methodsFor: 'convenience' stamp: ''!
movsx: src to: dest
	"Ensure right src/dest order"
	^ self movsx: dest with: src! !

!AJx86Assembler methodsFor: 'accessing' stamp: 'CamilloBruni 3/28/2012 14:43'!
reg32: index

	"answer one of 32bit general-purpose registers, based on index"
	| code |
	
	index < 0 ifTrue: [ self invalidRegisterIndex ].
	(index >= self numGPRegisters) ifTrue: [ self invalidRegisterIndex ].

	code := 16r20 + index.
	^ AJx86Registers code: code! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
sub: aRegisterOrMemoryOperand with: aSource
	"Subtract
	Pseudo Code
-----------
DEST = (DEST - SRC);

Description
-----------
Subtracts the second operand (source operand) from the first operand
(destination operand) and stores the result in the destination operand.
The destination operand can be a register or a memory location; the
source operand can be an immediate, register, or memory location.
(However, two memory operands cannot be used in one instruction.) When
an immediate value is used as an operand, it is sign-extended to the
length of the destination operand format.

The SUB instruction performs integer subtraction. It evaluates the
result for both signed and unsigned integer operands and sets the OF and
CF flags to indicate an overflow in the signed or unsigned result,
respectively. The SF flag indicates the sign of the signed result.

In 64-bit mode, the instruction's default operation size is 32 bits.
Using a REX prefix in the form of REX.R permits access to additional
registers (R8-R15). Using a REX prefix in the form of REX.W promotes
operation to 64 bits. See the summary chart at the beginning of this
section for encoding data and limits.

This instruction can be used with a LOCK prefix to allow the instruction
to be executed atomically.

"
	^ self 
		addInstruction: #sub
		operands: { aRegisterOrMemoryOperand . aSource }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
div: aDestination
	"Unsigned Divide
	Description
-----------
Divides unsigned the value in the AX, DX:AX, EDX:EAX, or RDX:RAX
registers (dividend) by the source operand (divisor) and stores the
result in the AX (AH:AL), DX:AX, EDX:EAX, or RDX:RAX registers. The
source operand can be a general-purpose register or a memory location.
The action of this instruction depends on the operand size
(dividend/divisor). Division using 64-bit operand is available only in
64-bit mode.

Non-integral results are truncated (chopped) towards 0. The remainder is
always less than the divisor in magnitude. Overflow is indicated with
the \#DE (divide error) exception rather than with the CF flag.

In 64-bit mode, the instruction's default operation size is 32 bits. Use
of the REX.R prefix permits access to additional registers (R8-R15). Use
of the REX.W prefix promotes operation to 64 bits. In 64-bit mode when
REX.W is applied, the instruction divides the unsigned value in RDX:RAX
by the source operand and stores the quotient in RAX, the remainder in
RDX.

See the summary chart at the beginning of this section for encoding data
and limits. See the following table.

DIV Action

Maximum

Operand Size

Dividend

Divisor

Quotient

Remainder

Quotient

Word/byte

AX

r/m8

AL

AH

255

Doubleword/word

DX:AX

r/m16

AX

DX

65,535

Quadword/doubleword

EDX:EAX

r/m32

EAX

EDX

2^32^ - 1

Doublequadword/quadword

RDX:RAX

r/m64

RAX

RDX

2^64^ - 1

"
	^ self 
		addInstruction: #div
		operands: { aDestination }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
frstor: aMemoryOperand
	"Restore x87 FPU State
	Description
-----------
Loads the FPU state (operating environment and register stack) from the
memory area specified with the source operand. This state data is
typically written to the specified memory location by a previous
FSAVE/FNSAVE instruction.

The FPU operating environment consists of the FPU control word, status
word, tag word, instruction pointer, data pointer, and last opcode.
Figures 8-9 through 8-12 in the Intel® 64 and IA-32 Architectures
Software Developer's Manual, Volume 1, show the layout in memory of the
stored environment, depending on the operating mode of the processor
(protected or real) and the current operand-size attribute (16-bit or
32-bit). In virtual-8086 mode, the real mode layouts are used. The
contents of the FPU register stack are stored in the 80 bytes
immediately following the operating environment image.

The FRSTOR instruction should be executed in the same operating mode as
the corresponding FSAVE/FNSAVE instruction.

If one or more unmasked exception bits are set in the new FPU status
word, a floating-point exception will be generated. To avoid raising
exceptions when loading a new operating environment, clear all the
exception flags in the FPU status word that is being loaded.

This instruction's operation is the same in non-64-bit modes and 64-bit
mode.

"
	^ self 
		addInstruction: #frstor
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
jge: targetLabel
	"
	"
	^ self 
		addInstruction: #jge
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fdivp: aX87Register
	"Divide and Pop
	"
	^ self 
		addInstruction: #fdivp
		operands: { aX87Register }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
jng: targetLabel
	"
	"
	^ self 
		addInstruction: #jng
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fdivr: aX87Register1 with: aX87Register2
	"
	see #fdivr"
	^ self 
		addInstruction: #fdivr
		operands: { aX87Register1 . aX87Register2 }! !

!AJx86Assembler methodsFor: 'debugging' stamp: 'IgorStasenko 5/28/2012 02:25'!
writeCodeToFile: aFileName
	aFileName asReference asReference delete writeStreamDo: [:s|
		s nextPutAll: self bytes
		]
! !

!AJx86Assembler methodsFor: 'accessing' stamp: ''!
stackManager: aStackManager
	stackManager := aStackManager ! !

!AJx86Assembler methodsFor: 'convenience' stamp: ''!
db: aByteValue
	^ self addInstruction: (AJData byte: aByteValue)! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
imul: aRegister with: aRegisterOrMemoryOrImmediate
	"
	see #imul"
	^ self 
		addInstruction: #imul
		operands: { aRegister . aRegisterOrMemoryOrImmediate }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
EDI
	"A 32bit general purpose register
	This register overlaps with BH, BX, EBX, RBX"
	^ EDI! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
jns: targetLabel
	"Jump short if not sign (SF=0)
	"
	^ self 
		addInstruction: #jns
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'register' stamp: ''!
instructionPointer
	"not available on 32bit x86 CPUs"
	self notYetImplemented ! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fcmovb: aX87Register
	"FP Conditional Move - below (CF=1)
	"
	^ self 
		addInstruction: #fcmovb
		operands: { aX87Register }! !

!AJx86Assembler methodsFor: 'labels' stamp: 'CamilloBruni 5/29/2012 13:15'!
label: aNameOrLabel
	^ self 
		label: aNameOrLabel 
		ifPresent: [ self error: 'label ', aNameOrLabel asString, ' already set' ].! !

!AJx86Assembler methodsFor: 'instruction list' stamp: ''!
insert: i after: instruction

	| next |
	i ifNil: [ "nothing to insert" ^ self ].
	i do: [:each |
		each increaseLevel: instruction level
		].
	next := instruction next.
	instruction next: i.
	i last next: next! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
movdqa: aRegisterOrMemory1 with: aRegisterOrMemory2
	"Move Aligned Double Quadword
	Pseudo Code
-----------
DEST = SRC;
(* #GP if SRC or DEST unaligned memory operand *)

Description
-----------
Moves a double quadword from the source operand (second operand) to the
destination operand (first operand). This instruction can be used to
load an XMM register from a 128-bit memory location, to store the
contents of an XMM register into a 128-bit memory location, or to move
data between two XMM registers. When the source or destination operand
is a memory operand, the operand must be aligned on a 16-byte boundary
or a general-protection exception (\#GP) will be generated.

To move a double quadword to or from unaligned memory locations, use the
MOVDQU instruction.

In 64-bit mode, use of the REX.R prefix permits this instruction to
access additional registers (XMM8-XMM15).

"
	^ self 
		addInstruction: #movdqa
		operands: { aRegisterOrMemory1 . aRegisterOrMemory2 }! !

!AJx86Assembler methodsFor: 'code generation' stamp: ''!
prepareInstructions
	"A final step before generating machine code: 
	prepare instructions by injecting a stack alignment
	and reifying jump labels.

	Prepared instructions will contain machine code, ready for use
	"
	instructions := stackManager analyzeInstructions: instructions assembler: self.
	instructions emitCodeAtOffset: 0 assembler: self.

	^ instructions! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
movlps: aRegisterOrMemory1 with: aRegisterOrMemory2
	"Move Low Packed Single-FP Values
	Pseudo Code
-----------
(* MOVLPD instruction for memory to XMM move *)
DEST[63:0] = SRC;
(* DEST[127:64] unchanged *)
(* MOVLPD instruction for XMM to memory move *)
DEST = SRC[63:0];

Description
-----------
Moves two packed single-precision floating-point values from the source
operand (second operand) and the destination operand (first operand).
The source and destination operands can be an XMM register or a 64-bit
memory location. This instruction allows two single-precision
floating-point values to be moved to and from the low quadword of an XMM
register and memory. It cannot be used for register to register or
memory to memory moves. When the destination operand is an XMM register,
the high quadword of the register remains unchanged.

In 64-bit mode, use of the REX.R prefix permits this instruction to
access additional registers (XMM8-XMM15).

"
	^ self 
		addInstruction: #movlps
		operands: { aRegisterOrMemory1 . aRegisterOrMemory2 }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
jp: targetLabel
	"Jump short if parity/parity even (PF=1)
	"
	^ self 
		addInstruction: #jp
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'instruction list' stamp: 'IgorStasenko 8/13/2013 13:39'!
newInstruction: name description: description operands: operands
	"check if name is jump "

	description isJump
		ifTrue: [ ^ self newJumpInstruction: name description: description operands: operands ].
	^ self newInstruction
		name: name;
		description: description;
		operands: operands;
		checkOperandsForConflict
	"Cannot check that at construction stage. Some operands may not be resolved yet (as AJReserveTemp)
		checkOperandsForConflict "! !

!AJx86Assembler methodsFor: 'register' stamp: ''!
destinationIndex
	^ self is32BitMode ifTrue: [ EDI ] ifFalse: [ DI ]! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
movntq: aRegisterOrMemory1 with: aRegisterOrMemory2
	"Store of Quadword Using Non-Temporal Hint
	Pseudo Code
-----------
DEST = SRC;

Description
-----------
Moves the quadword in the source operand (second operand) to the
destination operand (first operand) using a non-temporal hint to
minimize cache pollution during the write to memory. The source operand
is an MMX technology register, which is assumed to contain packed
integer data (packed bytes, words, or doublewords). The destination
operand is a 64-bit memory location.

The non-temporal hint is implemented by using a write combining (WC)
memory type protocol when writing the data to memory. Using this
protocol, the processor does not write the data into the cache
hierarchy, nor does it fetch the corresponding cache line from memory
into the cache hierarchy. The memory type of the region being written to
can override the non-temporal hint, if the memory address specified for
the non-temporal store is in an uncacheable (UC) or write protected (WP)
memory region. For more information on non-temporal stores, see 'Caching
of Temporal vs. Non-Temporal Data' in Chapter 10 in theIntel®64 and
IA-32 Architectures Software Developer's Manual, Volume 1.

Because the WC protocol uses a weakly-ordered memory consistency model,
a fencing operation implemented with the SFENCE or MFENCE instruction
should be used in conjunction with MOVNTQ instructions if multiple
processors might use different memory types to read/write the
destination memory locations.

This instruction's operation is the same in non-64-bit modes and 64-bit
mode.

"
	^ self 
		addInstruction: #movntq
		operands: { aRegisterOrMemory1 . aRegisterOrMemory2 }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmp: aRegisterOrMemoryOperand with: aSource
	"Compare Two Operands
	Pseudo Code
-----------
temp = SRC1 - SignExtend(SRC2);
ModifyStatusFlags; (* Modify status flags in the same manner as the SUB instruction *)

Description
-----------
Compares the first source operand with the second source operand and
sets the status flags in the EFLAGS register according to the results.
The comparison is performed by subtracting the second operand from the
first operand and then setting the status flags in the same manner as
the SUB instruction. When an immediate value is used as an operand, it
is sign-extended to the length of the first operand.

The condition codes used by the Jcc, CMOVcc, and SETcc instructions are
based on the results of a CMP instruction. Appendix B, 'EFLAGS Condition
Codes,' in theIntel® 64 and IA-32 Architectures Software Developer's
Manual, Volume 1, shows the relationship of the status flags and the
condition codes.

In 64-bit mode, the instruction's default operation size is 32 bits. Use
of the REX.R prefix permits access to additional registers (R8-R15). Use
of the REX.W prefix promotes operation to 64 bits. See the summary chart
at the beginning of this section for encoding data and limits.

"
	^ self 
		addInstruction: #cmp
		operands: { aRegisterOrMemoryOperand . aSource }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
or: aRegisterOrMemoryOperand with: aSource
	"Logical Inclusive OR
	Pseudo Code
-----------
DEST = DEST OR SRC;

Description
-----------
Performs a bitwise inclusive OR operation between the destination
(first) and source (second) operands and stores the result in the
destination operand location. The source operand can be an immediate, a
register, or a memory location; the destination operand can be a
register or a memory location. (However, two memory operands cannot be
used in one instruction.) Each bit of the result of the OR instruction
is set to 0 if both corresponding bits of the first and second operands
are 0; otherwise, each bit is set to 1.

This instruction can be used with a LOCK prefix to allow the instruction
to be executed atomically.

In 64-bit mode, the instruction's default operation size is 32 bits.
Using a REX prefix in the form of REX.R permits access to additional
registers (R8-R15). Using a REX prefix in the form of REX.W promotes
operation to 64 bits. See the summary chart at the beginning of this
section for encoding data and limits.

"
	^ self 
		addInstruction: #or
		operands: { aRegisterOrMemoryOperand . aSource }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
movsx: aDestinationRegister with: aSourceRegisterOrMemory
	"Move with Sign-Extension
	"
	^ self 
		addInstruction: #movsx
		operands: { aDestinationRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fiadd: aMemoryOperand
	"Add
	"
	^ self 
		addInstruction: #fiadd
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
BP
	"A 16bit general purpose register
	This register overlaps with CH, CX, ECX, RCX"
	^ BP! !

!AJx86Assembler methodsFor: 'function calls' stamp: ''!
pushArgument: anArgument forCall: call
	| arg argSize |
	
	arg := anArgument.
	anArgument isInteger ifTrue: [
		arg := anArgument asImm size: call defaultArgumentSize.
	].
	
	self addInstruction: (AJCallArgument new size: arg stackSize; callInfo: call ).
	
	arg emitPushOnStack: self! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
XMM5
	"An SSE register"
	^ XMM5! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
ja: targetLabel
	"
	"
	^ self 
		addInstruction: #ja
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
MM0
	"An MMX register"
	^ MM0! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
XMM6
	"An SSE register"
	^ XMM6! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fadd: aX87Register1 with: aX87Register2
	"
	see #fadd"
	^ self 
		addInstruction: #fadd
		operands: { aX87Register1 . aX87Register2 }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fnstcw: aMemoryOperand
	"Store x87 FPU Control Word
	"
	^ self 
		addInstruction: #fnstcw
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmovno: aRegister with: aSourceRegisterOrMemory
	"Conditional Move - not overflow (OF=0)
	"
	^ self 
		addInstruction: #cmovno
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fxch: aX87Register
	"Exchange Register Contents
	Description
-----------
Exchanges the contents of registers ST(0) and ST(i). If no source
operand is specified, the contents of ST(0) and ST(1) are exchanged.

This instruction provides a simple means of moving values in the FPU
register stack to the top of the stack [ST(0)], so that they can be
operated on by those floating-point instructions that can only operate
on values in ST(0). For example, the following instruction sequence
takes the square root of the third register from the top of the register
stack:

    FXCH ST(3);
    FSQRT;
    FXCH ST(3);

This instruction's operation is the same in non-64-bit modes and 64-bit
mode.

"
	^ self 
		addInstruction: #fxch
		operands: { aX87Register }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
bsr: aRegister with: aSourceRegisterOrMemory
	"Bit Scan Reverse
	Description
-----------
Searches the source operand (second operand) for the most significant
set bit (1 bit). If a most significant 1 bit is found, its bit index is
stored in the destination operand (first operand). The source operand
can be a register or a memory location; the destination operand is a
register. The bit index is an unsigned offset from bit 0 of the source
operand. If the content source operand is 0, the content of the
destination operand is undefined.

In 64-bit mode, the instruction's default operation size is 32 bits.
Using a REX prefix in the form of REX.R permits access to additional
registers (R8-R15). Using a REX prefix in the form of REX.W promotes
operation to 64 bits. See the summary chart at the beginning of this
section for encoding data and limits.

"
	^ self 
		addInstruction: #bsr
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
inc: aRegisterOrMemory
	"Increment by 1
	Pseudo Code
-----------
DEST = DEST + 1;
AFlags Affected
The CF flag is not affected. The OF, SF, ZF, AF, and PF flags are set according to the result.

Description
-----------
Adds 1 to the destination operand, while preserving the state of the CF
flag. The destination operand can be a register or a memory location.
This instruction allows a loop counter to be updated without disturbing
the CF flag. (Use a ADD instruction with an immediate operand of 1 to
perform an increment operation that does updates the CF flag.)

This instruction can be used with a LOCK prefix to allow the instruction
to be executed atomically.

In 64-bit mode, INC r16 and INC r32 are not encodable (because opcodes
40H through 47H are REX prefixes). Otherwise, the instruction's 64-bit
mode default operation size is 32 bits. Use of the REX.R prefix permits
access to additional registers (R8-R15). Use of the REX.W prefix
promotes operation to 64 bits.

"
	^ self 
		addInstruction: #inc
		operands: { aRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'accessing' stamp: 'CamilloBruni 3/28/2012 14:43'!
reg16: index

	"answer one of 16bit general-purpose registers, based on index"
	| code |
	
	index < 0 ifTrue: [ self invalidRegisterIndex ].
	(index >= self numGPRegisters) ifTrue: [ self invalidRegisterIndex ].

	code := 16r10 + index.
	^ AJx86Registers code: code! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmovnl: aRegister with: aSourceRegisterOrMemory
	"Conditional Move - not less/greater or equal (SF=OF)
	"
	^ self 
		addInstruction: #cmovnl
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
enter: stackFrameSize with: lexicalNesting
	"Make Stack Frame for Procedure Parameters
	Description
-----------
Creates a stack frame for a procedure. The first operand (size operand)
specifies the size of the stack frame (that is, the number of bytes of
dynamic storage allocated on the stack for the procedure). The second
operand (nesting level operand) gives the lexical nesting level (0 to
31) of the procedure. The nesting level determines the number of stack
frame pointers that are copied into the 'display area' of the new stack
frame from the preceding frame. Both of these operands are immediate
values.

The stack-size attribute determines whether the BP (16 bits), EBP (32
bits), or RBP (64 bits) register specifies the current frame pointer and
whether SP (16 bits), ESP (32 bits), or RSP (64 bits) specifies the
stack pointer. In 64-bit mode, stack-size attribute is always 64-bits.

The ENTER and companion LEAVE instructions are provided to support block
structured languages. The ENTER instruction (when used) is typically the
first instruction in a procedure and is used to set up a new stack frame
for a procedure. The LEAVE instruction is then used at the end of the
procedure (just before the RET instruction) to release the stack frame.

If the nesting level is 0, the processor pushes the frame pointer from
the BP/EBP/RBP register onto the stack, copies the current stack pointer
from the SP/ESP/RSP register into the BP/EBP/RBP register, and loads the
SP/ESP/RSP register with the current stack-pointer value minus the value
in the size operand. For nesting levels of 1 or greater, the processor
pushes additional frame pointers on the stack before adjusting the stack
pointer. These additional frame pointers provide the called procedure
with access points to other nested frames on the stack. See 'Procedure
Calls for Block-Structured Languages' in Chapter 6 of theIntel®64 and
IA-32 ArchitecturesSoftware Developer's Manual, Volume 1, for more
information about the actions of the ENTER instruction.

The ENTER instruction causes a page fault whenever a write using the
final value of the stack pointer (within the current stack segment)
would do so.

In 64-bit mode, default operation size is 64 bits; 32-bit operation size
cannot be encoded.

"
	^ self 
		addInstruction: #enter
		operands: { stackFrameSize . lexicalNesting }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
EDX
	"A 32bit general purpose register
	This register overlaps with DL, DX, EDX, RDX"
	^ EDX! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
CH
	"A 8bit general purpose register
	This register overlaps with CH, CX, ECX, RCX"
	^ CH! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
movlpd: aRegisterOrMemory1 with: aRegisterOrMemory2
	"Move Low Packed Double-FP Value
	Pseudo Code
-----------
(* MOVLPD instruction for memory to XMM move *)
DEST[63:0] = SRC;
(* DEST[127:64] unchanged *)
(* MOVLPD instruction for XMM to memory move *)
DEST = SRC[63:0];

Description
-----------
Moves a double-precision floating-point value from the source operand
(second operand) to the destination operand (first operand). The source
and destination operands can be an XMM register or a 64-bit memory
location. This instruction allows a double-precision floating-point
value to be moved to and from the low quadword of an XMM register and
memory. It cannot be used for register to register or memory to memory
moves. When the destination operand is an XMM register, the high
quad-word of the register remains unchanged.

In 64-bit mode, use of the REX.R prefix permits this instruction to
access additional registers (XMM8-XMM15).

"
	^ self 
		addInstruction: #movlpd
		operands: { aRegisterOrMemory1 . aRegisterOrMemory2 }! !

!AJx86Assembler methodsFor: 'accessing' stamp: 'CamilloBruni 8/22/2012 14:26'!
newJumpInstruction
	^ AJx86JumpInstruction new! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
movss: aRegisterOrMemory1 with: aRegisterOrMemory2
	"Move Scalar Single-FP Values
	Description
-----------
Moves a scalar single-precision floating-point value from the source
operand (second operand) to the destination operand (first operand). The
source and destination operands can be XMM registers or 32-bit memory
locations. This instruction can be used to move a single-precision
floating-point value to and from the low doubleword of an XMM register
and a 32-bit memory location, or to move a single-precision
floating-point value between the low doublewords of two XMM registers.
The instruction cannot be used to transfer data between memory
locations.

When the source and destination operands are XMM registers, the three
high-order doublewords of the destination operand remain unchanged. When
the source operand is a memory location and destination operand is an
XMM registers, the three high-order doublewords of the destination
operand are cleared to all 0s.

In 64-bit mode, use of the REX.R prefix permits this instruction to
access additional registers (XMM8-XMM15).

"
	^ self 
		addInstruction: #movss
		operands: { aRegisterOrMemory1 . aRegisterOrMemory2 }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
EBP
	"A 32bit general purpose register
	This register overlaps with CH, CX, ECX, RCX"
	^ EBP! !

!AJx86Assembler methodsFor: 'register' stamp: ''!
sourceIndex
	^ self is32BitMode ifTrue: [ RSI ] ifFalse: [ SI ]! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
xor: aRegisterOrMemoryOperand with: aSource
	"Logical Exclusive OR
	Pseudo Code
-----------
DEST = DEST XOR SRC;

Description
-----------
Performs a bitwise exclusive OR (XOR) operation on the destination
(first) and source (second) operands and stores the result in the
destination operand location. The source operand can be an immediate, a
register, or a memory location; the destination operand can be a
register or a memory location. (However, two memory operands cannot be
used in one instruction.) Each bit of the result is 1 if the
corresponding bits of the operands are different; each bit is 0 if the
corresponding bits are the same.

This instruction can be used with a LOCK prefix to allow the instruction
to be executed atomically.

In 64-bit mode, using a REX prefix in the form of REX.R permits access
to additional registers (R8-R15). Using a REX prefix in the form of
REX.W promotes operation to 64 bits. See the summary chart at the
beginning of this section for encoding data and limits.

"
	^ self 
		addInstruction: #xor
		operands: { aRegisterOrMemoryOperand . aSource }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fstenv: aMemoryOperand
	"Store x87 FPU Environment
	"
	^ self 
		addInstruction: #fstenv
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
MM1
	"An MMX register"
	^ MM1! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
jb: targetLabel
	"Jump short if below/not above or equal/carry (CF=1)
	"
	^ self 
		addInstruction: #jb
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
MM2
	"An MMX register"
	^ MM2! !

!AJx86Assembler methodsFor: 'convenience' stamp: 'IgorStasenko 5/26/2012 15:14'!
mov: src to: dest
	"Ensure right src/dest order"
	
	src = dest ifTrue: [ ^ self ]. "do not if source and dest are same "  
	
	^ self mov: dest with: src! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
jna: targetLabel
	"
	"
	^ self 
		addInstruction: #jna
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
mul: aDestination
	"Unsigned Multiply
	Description
-----------
Performs an unsigned multiplication of the first operand (destination
operand) and the second operand (source operand) and stores the result
in the destination operand. The destination operand is an implied
operand located in register AL, AX or EAX (depending on the size of the
operand); the source operand is located in a general-purpose register or
a memory location. The action of this instruction and the location of
the result depends on the opcode and the operand size as shown in the
following table.

The result is stored in register AX, register pair DX:AX, or register
pair EDX:EAX (depending on the operand size), with the high-order bits
of the product contained in register AH, DX, or EDX, respectively. If
the high-order bits of the product are 0, the CF and OF flags are
cleared; otherwise, the flags are set.

In 64-bit mode, the instruction's default operation size is 32 bits. Use
of the REX.R prefix permits access to additional registers (R8 - R15).
Use of the REX.W prefix promotes operation to 64 bits.

See the summary chart at the beginning of this section for encoding data
and limits.

  Operand Size   Source 1   Source 2   Destination
  -------------- ---------- ---------- -------------
  Byte           AL         r/m8       AX
  Word           AX         r/m16      DX:AX
  Doubleword     EAX        r/m32      EDX:EAX
  Quadword       RAX        r/m64      RDX:RAX

  : MUL Results

"
	^ self 
		addInstruction: #mul
		operands: { aDestination }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fsub: aX87Register1 with: aX87Register2
	"
	see #fsub"
	^ self 
		addInstruction: #fsub
		operands: { aX87Register1 . aX87Register2 }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
push: aSource
	"Push Word, Doubleword or Quadword Onto the Stack
	"
	^ self 
		addInstruction: #push
		operands: { aSource }! !

!AJx86Assembler methodsFor: 'stack management' stamp: ''!
reserveExtraBytesOnStack: numBytes
	^ stackManager reserveExtraBytesOnStack: numBytes ! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fstp: aMemoryOrX87Register
	"Store Floating Point Value and Pop
	"
	^ self 
		addInstruction: #fstp
		operands: { aMemoryOrX87Register }! !

!AJx86Assembler methodsFor: 'stack management' stamp: ''!
reserveTemp
	^ self addInstruction: (AJReserveTemp new size: self wordSize).
! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
crc32: aRegister with: aSourceRegisterOrMemory
	"Accumulate CRC32 Value
	Description
-----------
Starting with an initial value in the first operand (destination
operand), accumulates a CRC32 (polynomial 0x11EDC6F41) value for the
second operand (source operand) and stores the result in the destination
operand. The source operand can be a register or a memory location. The
destination operand must be an r32 or r64 register. If the destination
is an r64 register, then the 32-bit result is stored in the least
significant double word and 00000000H is stored in the most significant
double word of the r64 register.

The initial value supplied in the destination operand is a double word
integer stored in the r32 register or the least significant double word
of the r64 register. To incrementally accumulate a CRC32 value, software
retains the result of the previous CRC32 operation in the destination
operand, then executes the CRC32 instruction again with new input data
in the source operand. Data contained in the source operand is processed
in reflected bit order. This means that the most significant bit of the
source operand is treated as the least significant bit of the quotient,
and so on, for all the bits of the source operand. Likewise, the result
of the CRC operation is stored in the destination operand in reflected
bit order. This means that the most significant bit of the resulting CRC
(bit 31) is stored in the least significant bit of the destination
operand (bit 0), and so on, for all the bits of the CRC.

"
	^ self 
		addInstruction: #crc32
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
stmxcsr: aMemoryOperand
	"Store MXCSR Register State
	Pseudo Code
-----------
m32 = MXCSR;

Description
-----------
Stores the contents of the MXCSR control and status register to the
destination operand. The destination operand is a 32-bit memory
location. The reserved bits in the MXCSR register are stored as 0s.

This instruction's operation is the same in non-64-bit modes and 64-bit
mode.

"
	^ self 
		addInstruction: #stmxcsr
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
xadd: aDestinationRegisterOrMemory with: aSourceRegister
	"Exchange and Add
	Pseudo Code
-----------
TEMP = SRC + DEST;
SRC = DEST;
DEST = TEMP;

Description
-----------
Exchanges the first operand (destination operand) with the second
operand (source operand), then loads the sum of the two values into the
destination operand. The destination operand can be a register or a
memory location; the source operand is a register.

In 64-bit mode, the instruction's default operation size is 32 bits.
Using a REX prefix in the form of REX.R permits access to additional
registers (R8-R15). Using a REX prefix in the form of REX.W promotes
operation to 64 bits. See the summary chart at the beginning of this
section for encoding data and limits.

This instruction can be used with a LOCK prefix to allow the instruction
to be executed atomically.

"
	^ self 
		addInstruction: #xadd
		operands: { aDestinationRegisterOrMemory . aSourceRegister }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
bswap: aDestinationRegister
	"Byte Swap
	Description
-----------
Reverses the byte order of a 32-bit or 64-bit (destination) register.
This instruction is provided for converting little-endian values to
big-endian format and vice versa. To swap bytes in a word value (16-bit
register), use the XCHG instruction. When the BSWAP instruction
references a 16-bit register, the result is undefined.

In 64-bit mode, the instruction's default operation size is 32 bits.
Using a REX prefix in the form of REX.R permits access to additional
registers (R8-R15). Using a REX prefix in the form of REX.W promotes
operation to 64 bits. See the summary chart at the beginning of this
section for encoding data and limits.

IA-32 Architecture Legacy Compatibility

The BSWAP instruction is not supported on IA-32 processors earlier than
the Intel486™ processor family. For compatibility with this instruction,
software should include functionally equivalent code for execution on
Intel processors earlier than the Intel486 processor family.

"
	^ self 
		addInstruction: #bswap
		operands: { aDestinationRegister }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmovnp: aRegister with: aSourceRegisterOrMemory
	"Conditional Move - not parity/parity odd
	"
	^ self 
		addInstruction: #cmovnp
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fsave: aMemoryOperand
	"Store x87 FPU State
	"
	^ self 
		addInstruction: #fsave
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
ldmxcsr: aMemoryOperand
	"Load MXCSR Register
	Pseudo Code
-----------
MXCSR = m32;
C/C++ Compiler Intrinsic Equivalent
_mm_setcsr(unsigned int i)

Description
-----------
Loads the source operand into the MXCSR control/status register. The
source operand is a 32-bit memory location. See 'MXCSR Control and
Status Register' in Chapter 10, of theIntel®64 and IA-32 Architectures
Software Developer's Manual,Volume 1, for a description of the MXCSR
register and its contents.

The LDMXCSR instruction is typically used in conjunction with the
STMXCSR instruction, which stores the contents of the MXCSR register in
memory.

The default MXCSR value at reset is 1F80H.

If a LDMXCSR instruction clears a SIMD floating-point exception mask bit
and sets the corresponding exception flag bit, a SIMD floating-point
exception will not be immediately generated. The exception will be
generated only upon the execution of the next SSE or SSE2 instruction
that causes that particular SIMD floating-point exception to be
reported.

This instruction's operation is the same in non-64-bit modes and 64-bit
mode.

"
	^ self 
		addInstruction: #ldmxcsr
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fcom: aMemoryOperand
	"Compare Real
	"
	^ self 
		addInstruction: #fcom
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fcomp: aMemoryOperand
	"Compare Real and Pop
	"
	^ self 
		addInstruction: #fcomp
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
movaps: aRegisterOrMemory1 with: aRegisterOrMemory2
	"Move Aligned Packed Single-FP Values
	Pseudo Code
-----------
DEST = SRC;
(* #GP if SRC or DEST unaligned memory operand *)

Description
-----------
Moves a double quadword containing four packed single-precision
floating-point values from the source operand (second operand) to the
destination operand (first operand). This instruction can be used to
load an XMM register from a 128-bit memory location, to store the
contents of an XMM register into a 128-bit memory location, or to move
data between two XMM registers. When the source or destination operand
is a memory operand, the operand must be aligned on a 16-byte boundary
or a general-protection exception (\#GP) is generated.

To move packed single-precision floating-point values to or from
unaligned memory locations, use the MOVUPS instruction.

In 64-bit mode, use of the REX.R prefix permits this instruction to
access additional registers (XMM8-XMM15).

"
	^ self 
		addInstruction: #movaps
		operands: { aRegisterOrMemory1 . aRegisterOrMemory2 }! !

!AJx86Assembler methodsFor: 'function calls' stamp: ''!
noticePush: numBytes forCall: aCallInfo

	self addInstruction: (AJCallArgument new size: numBytes; callInfo: aCallInfo ).
! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
xchg: aDestinationRegisterOrMemory with: aSourceRegister
	"Exchange Register/Memory with Register
	Pseudo Code
-----------
TEMP = DEST;
DEST = SRC;
SRC = TEMP;

Description
-----------
Exchanges the contents of the destination (first) and source (second)
operands. The operands can be two general-purpose registers or a
register and a memory location. If a memory operand is referenced, the
processor's locking protocol is automatically implemented for the
duration of the exchange operation, regardless of the presence or
absence of the LOCK prefix or of the value of the IOPL. (See the LOCK
prefix description in this chapter for more information on the locking
protocol.)

This instruction is useful for implementing semaphores or similar data
structures for process synchronization. (See 'Bus Locking' in Chapter 8
of theIntel® 64 and IA-32Architectures Software Developer's Manual,
Volume 3A, for more information on bus locking.)

The XCHG instruction can also be used instead of the BSWAP instruction
for 16-bit operands.

In 64-bit mode, the instruction's default operation size is 32 bits.
Using a REX prefix in the form of REX.R permits access to additional
registers (R8-R15). Using a REX prefix in the form of REX.W promotes
operation to 64 bits. See the summary chart at the beginning of this
section for encoding data and limits.

"
	^ self 
		addInstruction: #xchg
		operands: { aDestinationRegisterOrMemory . aSourceRegister }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
je: targetLabel
	"
	"
	^ self 
		addInstruction: #je
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fidivr: aMemoryOperand
	"Reverse Divide
	"
	^ self 
		addInstruction: #fidivr
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
movhpd: aRegisterOrMemory1 with: aRegisterOrMemory2
	"Move High Packed Double-FP Value
	Pseudo Code
-----------
(* MOVHPD instruction for memory to XMM move *)
DEST[127:64] = SRC;
(* DEST[63:0] unchanged *)
(* MOVHPD instruction for XMM to memory move *)
DEST = SRC[127:64];

Description
-----------
Moves a double-precision floating-point value from the source operand
(second operand) to the destination operand (first operand). The source
and destination operands can be an XMM register or a 64-bit memory
location. This instruction allows a double-precision floating-point
value to be moved to and from the high quadword of an XMM register and
memory. It cannot be used for register to register or memory to memory
moves. When the destination operand is an XMM register, the low
quad-word of the register remains unchanged.

In 64-bit mode, use of the REX.R prefix permits this instruction to
access additional registers (XMM8-XMM15).

"
	^ self 
		addInstruction: #movhpd
		operands: { aRegisterOrMemory1 . aRegisterOrMemory2 }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
SI
	"A 16bit general purpose register
	This register overlaps with DH, DX, EDX, RDX"
	^ SI! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
movntps: aRegisterOrMemory1 with: aRegisterOrMemory2
	"Store Packed Single-FP Values Using Non-Temporal Hint
	Pseudo Code
-----------
DEST = SRC;

Description
-----------
Moves the double quadword in the source operand (second operand) to the
destination operand (first operand) using a non-temporal hint to
minimize cache pollution during the write to memory. The source operand
is an XMM register, which is assumed to contain four packed
single-precision floating-point values. The destination operand is a
128-bit memory location.

The non-temporal hint is implemented by using a write combining (WC)
memory type protocol when writing the data to memory. Using this
protocol, the processor does not write the data into the cache
hierarchy, nor does it fetch the corresponding cache line from memory
into the cache hierarchy. The memory type of the region being written to
can override the non-temporal hint, if the memory address specified for
the non-temporal store is in an uncacheable (UC) or write protected (WP)
memory region. For more information on non-temporal stores, see 'Caching
of Temporal vs. Non-Temporal Data' in Chapter 10 in theIntel®64 and
IA-32 Architectures Software Developer's Manual, Volume 1.

Because the WC protocol uses a weakly-ordered memory consistency model,
a fencing operation implemented with the SFENCE or MFENCE instruction
should be used in conjunction with MOVNTPS instructions if multiple
processors might use different memory types to read/write the
destination memory locations.

In 64-bit mode, use of the REX.R prefix permits this instruction to
access additional registers (XMM8-XMM15).

"
	^ self 
		addInstruction: #movntps
		operands: { aRegisterOrMemory1 . aRegisterOrMemory2 }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
DX
	"A 16bit general purpose register
	This register overlaps with DL, DX, EDX, RDX"
	^ DX! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmovge: aRegister with: aSourceRegisterOrMemory
	"
	"
	^ self 
		addInstruction: #cmovge
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fisubr: aMemoryOperand
	"Reverse Subtract
	"
	^ self 
		addInstruction: #fisubr
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instruction list' stamp: 'MartinMcClure 2/9/2013 14:29'!
newJumpInstruction: name description: description operands: operands
	| jumpInstruction destination |
	jumpInstruction := self newJumpInstruction
		name: name;
		description: description.
	operands size ~= 1
		ifTrue: [ Error signal: 'Jump instruction only takes one argument!!' ].
	destination := operands first.
	destination isString
		ifTrue: [ ^ jumpInstruction label: (self labelNamed: destination) ].
	destination isLabel
		ifTrue: [ ^ jumpInstruction label: destination ].
	^ self newInstruction
		name: name;
		description: description;
		operands: operands;
		checkOperandsForConflict! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
faddp: aX87Register
	"Add and Pop
	"
	^ self 
		addInstruction: #faddp
		operands: { aX87Register }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmovle: aRegister with: aSourceRegisterOrMemory
	"Conditional Move - less or equal/not greater ((ZF=1) OR (SF!!=OF))
	"
	^ self 
		addInstruction: #cmovle
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'testing' stamp: ''!
is32
	^ true! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
jbe: targetLabel
	"Jump short if below or equal/not above (CF=1 AND ZF=1)
	"
	^ self 
		addInstruction: #jbe
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
XMM4
	"An SSE register"
	^ XMM4! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
DL
	"A 8bit general purpose register
	This register overlaps with DL, DX, EDX, RDX"
	^ DL! !

!AJx86Assembler methodsFor: 'code generation' stamp: ''!
bytes

	^ self generatedCode bytes.! !

!AJx86Assembler methodsFor: 'labels' stamp: ''!
uniqueLabelName: aName

	^ self labelNamed: aName, labels size asString! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
movntdqa: aRegisterOrMemory1 with: aRegisterOrMemory2
	"Load Double Quadword Non-Temporal Aligned Hint
	Pseudo Code
-----------
DST = SRC;

Description
-----------
MOVNTDQA loads a double quadword from the source operand (second
operand) to the destination operand (first operand) using a non-temporal
hint. A processor implementation may make use of the non-temporal hint
associated with this instruction if the memory source is WC (write
combining) memory type. An implementation may also make use of the
non-temporal hint associated with this instruction if the memory source
is WB (write back) memory type.

A processor's implementation of the non-temporal hint does not override
the effective memory type semantics, but the implementation of the hint
is processor dependent. For example, a processor implementation may
choose to ignore the hint and process the instruction as a normal MOVDQA
for any memory type. Another implementation of the hint for WC memory
type may optimize data transfer throughput of WC reads. A third
implementation may optimize cache reads generated by MOVNTDQA on WB
memory type to reduce cache evictions.

WC Streaming Load Hint

For WC memory type in particular, the processor never appears to read
the data into the cache hierarchy. Instead, the non-temporal hint may be
implemented by loading a temporary internal buffer with the equivalent
of an aligned cache line without filling this data to the cache. Any
memory-type aliased lines in the cache will be snooped and flushed.
Subsequent MOVNTDQA reads to unread portions of the WC cache line will
receive data from the temporary internal buffer if data is available.
The temporary internal buffer may be flushed by the processor at any
time for any reason, for example:

-   A load operation other than a MOVNTDQA which references memory
    already resident in a temporary internal buffer.
-   A non-WC reference to memory already resident in a temporary
    internal buffer.
-   Interleaving of reads and writes to memory currently residing in a
    single temporary internal buffer.
-   Repeated MOVNTDQA loads of a particular 16-byte item in a streaming
    line.
-   Certain micro-architectural conditions including resource shortages,
    detection of a mis-speculation condition, and various fault
    conditions

The memory type of the region being read can override the non-temporal
hint, if the memory address specified for the non-temporal read is not a
WC memory region. Information on non-temporal reads and writes can be
found in Chapter 11, 'MemoryCache Control' ofIntel® 64 and IA-32
Architectures Software Developer's Manual,Volume 3A.

Because the WC protocol uses a weakly-ordered memory consistency model,
an MFENCE or locked instruction should be used in conjunction with
MOVNTDQA instructions if multiple processors might reference the same WC
memory locations or in order to synchronize reads of a processor with
writes by other agents in the system. Because of the speculative nature
of fetching due to MOVNTDQA, Streaming loads must not be used to
reference memory addresses that are mapped to I/O devices having side
effects or when reads to these devices are destructive. For additional
information on MOVNTDQA usages, see Section 12.10.3 in Chapter 12,
'Programming with SSE3, SSSE3 and SSE4' ofIntel®64 and IA-32
Architectures SoftwareDeveloper's Manual, Volume 1.

"
	^ self 
		addInstruction: #movntdqa
		operands: { aRegisterOrMemory1 . aRegisterOrMemory2 }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
MM7
	"An MMX register"
	^ MM7! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
jpo: targetLabel
	"
	"
	^ self 
		addInstruction: #jpo
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'convenience' stamp: ''!
movzx: src to: dest
	"Ensure right src/dest order"
	^ self movzx: dest with: src! !

!AJx86Assembler methodsFor: 'instruction list' stamp: 'CamilloBruni 7/23/2012 13:29'!
decorateWith: annotation during: aBlock

	self addInstruction: (AJInstructionDecoration new start annotation: annotation).
	level := level + 1.
	aBlock ensure: [
		level := level - 1.
		self addInstruction: (AJInstructionDecoration new end annotation: annotation)
	]	
! !

!AJx86Assembler methodsFor: 'alignment' stamp: ''!
alignWord
	self addInstruction: AJAlignmentInstruction alignWord! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
ESI
	"A 32bit general purpose register
	This register overlaps with DH, DX, EDX, RDX"
	^ ESI! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
CL
	"A 8bit general purpose register
	This register overlaps with CL, CX, ECX, RCX"
	^ CL! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmovnbe: aRegister with: aSourceRegisterOrMemory
	"Conditional Move - not below or equal/above (CF=0 AND ZF=0)
	"
	^ self 
		addInstruction: #cmovnbe
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
jnbe: targetLabel
	"Jump short if not below or equal/above (CF=0 AND ZF=0)
	"
	^ self 
		addInstruction: #jnbe
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'convenience' stamp: ''!
dw: aByteArray
	self assert: aByteArray size == SizeWord.
	^ self addInstruction: (AJData data: aByteArray)! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fcmovbe: aX87Register
	"FP Conditional Move - below or equal (CF=1 or ZF=1)
	"
	^ self 
		addInstruction: #fcmovbe
		operands: { aX87Register }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
movapd: aRegisterOrMemory1 with: aRegisterOrMemory2
	"Move Aligned Packed Double-FP Values
	Pseudo Code
-----------
DEST = SRC;
(* #GP if SRC or DEST unaligned memory operand *)

Description
-----------
Moves a double quadword containing two packed double-precision
floating-point values from the source operand (second operand) to the
destination operand (first operand). This instruction can be used to
load an XMM register from a 128-bit memory location, to store the
contents of an XMM register into a 128-bit memory location, or to move
data between two XMM registers. When the source or destination operand
is a memory operand, the operand must be aligned on a 16-byte boundary
or a general-protection exception (\#GP) will be generated.

To move double-precision floating-point values to and from unaligned
memory locations, use the MOVUPD instruction.

In 64-bit mode, use of the REX.R prefix permits this instruction to
access additional registers (XMM8-XMM15).

"
	^ self 
		addInstruction: #movapd
		operands: { aRegisterOrMemory1 . aRegisterOrMemory2 }! !

!AJx86Assembler methodsFor: 'convenience' stamp: ''!
mov: assoc
	"convenience"
	^ self mov: assoc key to: assoc value! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fcmovnb: aX87Register
	"FP Conditional Move - not below (CF=0)
	"
	^ self 
		addInstruction: #fcmovnb
		operands: { aX87Register }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmovnle: aRegister with: aSourceRegisterOrMemory
	"Conditional Move - not less nor equal/greater ((ZF=0) AND (SF=OF))
	"
	^ self 
		addInstruction: #cmovnle
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
jmp: aLabelOrRegisterOrMemory
	"Jump
	Description
-----------
Transfers program control to a different point in the instruction stream
without recording return information. The destination (target) operand
specifies the address of the instruction being jumped to. This operand
can be an immediate value, a general-purpose register, or a memory
location.

This instruction can be used to execute four different types of jumps:

-   Near jump—A jump to an instruction within the current code segment
    (the segment currently pointed to by the CS register), sometimes
    referred to as an intrasegment jump.
-   Short jump—A near jump where the jump range is limited to -128 to
    +127 from the current EIP value.
-   Far jump—A jump to an instruction located in a different segment
    than the current code segment but at the same privilege level,
    sometimes referred to as an intersegment jump.
-   Task switch—A jump to an instruction located in a different task.

A task switch can only be executed in protected mode (see Chapter 7, in
theIntel® 64 and IA-32 Architectures Software Developer's Manual, Volume
3A, for information on performing task switches with the JMP
instruction).

Near and Short Jumps. When executing a near jump, the processor jumps to
the address (within the current code segment) that is specified with the
target operand. The target operand specifies either an absolute offset
(that is an offset from the base of the code segment) or a relative
offset (a signed displacement relative to the current value of the
instruction pointer in the EIP register). A near jump to a relative
offset of 8-bits (rel8) is referred to as a short jump. The CS register
is not changed on near and short jumps.

An absolute offset is specified indirectly in a general-purpose register
or a memory location (r/m16 or r/m32). The operand-size attribute
determines the size of the target operand (16 or 32 bits). Absolute
offsets are loaded directly into the EIP register. If the operand-size
attribute is 16, the upper two bytes of the EIP register are cleared,
resulting in a maximum instruction pointer size of 16 bits.

A relative offset (rel8, rel16, or rel32) is generally specified as a
label in assembly code, but at the machine code level, it is encoded as
a signed 8-, 16-, or 32-bit immediate value. This value is added to the
value in the EIP register. (Here, the EIP register contains the address
of the instruction following the JMP instruction). When using relative
offsets, the opcode (for short vs. near jumps) and the operand-size
attribute (for near relative jumps) determines the size of the target
operand (8, 16, or 32 bits).

Far Jumps in Real-Address or Virtual-8086 Mode. When executing a far
jump in real-address or virtual-8086 mode, the processor jumps to the
code segment and offset specified with the target operand. Here the
target operand specifies an absolute far address either directly with a
pointer (ptr16:16 or ptr16:32) or indirectly with a memory location
(m16:16 or m16:32). With the pointer method, the segment and address of
the called procedure is encoded in the instruction, using a 4-byte
(16-bit operand size) or 6-byte (32-bit operand size) far address
immediate. With the indirect method, the target operand specifies a
memory location that contains a 4-byte (16-bit operand size) or 6-byte
(32-bit operand size) far address. The far address is loaded directly
into the CS and EIP registers. If the operand-size attribute is 16, the
upper two bytes of the EIP register are cleared.

Far Jumps in Protected Mode. When the processor is operating in
protected mode, the JMP instruction can be used to perform the following
three types of far jumps:

-   A far jump to a conforming or non-conforming code segment.
-   A far jump through a call gate.
-   A task switch.

(The JMP instruction cannot be used to perform inter-privilege-level far
jumps.)

In protected mode, the processor always uses the segment selector part
of the far address to access the corresponding descriptor in the GDT or
LDT. The descriptor type (code segment, call gate, task gate, or TSS)
and access rights determine the type of jump to be performed.

If the selected descriptor is for a code segment, a far jump to a code
segment at the same privilege level is performed. (If the selected code
segment is at a different privilege level and the code segment is
non-conforming, a general-protection exception is generated.) A far jump
to the same privilege level in protected mode is very similar to one
carried out in real-address or virtual-8086 mode. The target operand
specifies an absolute far address either directly with a pointer
(ptr16:16 or ptr16:32) or indirectly with a memory location (m16:16 or
m16:32). The operand-size attribute determines the size of the offset
(16 or 32 bits) in the far address. The new code segment selector and
its descriptor are loaded into CS register, and the offset from the
instruction is loaded into the EIP register. Note that a call gate
(described in the next paragraph) can also be used to perform far call
to a code segment at the same privilege level. Using this mechanism
provides an extra level of indirection and is the preferred method of
making jumps between 16-bit and 32-bit code segments.

When executing a far jump through a call gate, the segment selector
specified by the target operand identifies the call gate. (The offset
part of the target operand is ignored.) The processor then jumps to the
code segment specified in the call gate descriptor and begins executing
the instruction at the offset specified in the call gate. No stack
switch occurs. Here again, the target operand can specify the far
address of the call gate either directly with a pointer (ptr16:16 or
ptr16:32) or indirectly with a memory location (m16:16 or m16:32).

Executing a task switch with the JMP instruction is somewhat similar to
executing a jump through a call gate. Here the target operand specifies
the segment selector of the task gate for the task being switched to
(and the offset part of the target operand is ignored). The task gate in
turn points to the TSS for the task, which contains the segment
selectors for the task's code and stack segments. The TSS also contains
the EIP value for the next instruction that was to be executed before
the task was suspended. This instruction pointer value is loaded into
the EIP register so that the task begins executing again at this next
instruction.

The JMP instruction can also specify the segment selector of the TSS
directly, which eliminates the indirection of the task gate. See Chapter
7 inIntel® 64 and IA-32Architectures Software Developer's Manual, Volume
3A, for detailed information on the mechanics of a task switch.

Note that when you execute at task switch with a JMP instruction, the
nested task flag (NT) is not set in the EFLAGS register and the new
TSS's previous task link field is not loaded with the old task's TSS
selector. A return to the previous task can thus not be carried out by
executing the IRET instruction. Switching tasks with the JMP instruction
differs in this regard from the CALL instruction which does set the NT
flag and save the previous task link information, allowing a return to
the calling task with an IRET instruction.

In 64-Bit Mode — The instruction's operation size is fixed at 64 bits.
If a selector points to a gate, then RIP equals the 64-bit displacement
taken from gate; else RIP equals the zero-extended offset from the far
pointer referenced in the instruction.

See the summary chart at the beginning of this section for encoding data
and limits.

"
	^ self 
		addInstruction: #jmp
		operands: { aLabelOrRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'stack management' stamp: ''!
emitEpilogue: popExtraBytes

	^ stackManager emitEpilogue: popExtraBytes assembler: self! !

!AJx86Assembler methodsFor: 'code generation' stamp: ''!
generatedCode

	^ AJGeneratedCode new
		fromInstructions: self prepareInstructions.
! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fsubr: aX87Register1 with: aX87Register2
	"
	see #fsubr"
	^ self 
		addInstruction: #fsubr
		operands: { aX87Register1 . aX87Register2 }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fcmovnbe: aX87Register
	"FP Conditional Move - below or equal (CF=0 and ZF=0)
	"
	^ self 
		addInstruction: #fcmovnbe
		operands: { aX87Register }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
imul: aRegisterOrMemory
	"Signed Multiply
	Description
-----------
Performs a signed multiplication of two operands. This instruction has
three forms, depending on the number of operands.

-   One-operand form — This form is identical to that used by the MUL
    instruction. Here, the source operand (in a general-purpose register
    or memory location) is multiplied by the value in the AL, AX, EAX,
    or RAX register (depending on the operand size) and the product is
    stored in the AX, DX:AX, EDX:EAX, or RDX:RAX registers,
    respectively.
-   Two-operand form — With this form the destination operand (the first
    operand) is multiplied by the source operand (second operand). The
    destination operand is a general-purpose register and the source
    operand is an immediate value, a general-purpose register, or a
    memory location. The product is then stored in the destination
    operand location.
-   Three-operand form — This form requires a destination operand (the
    first operand) and two source operands (the second and the third
    operands). Here, the first source operand (which can be a
    general-purpose register or a memory location) is multiplied by the
    second source operand (an immediate value). The product is then
    stored in the destination operand (a general-purpose register).

When an immediate value is used as an operand, it is sign-extended to
the length of the destination operand format.

The CF and OF flags are set when significant bit (including the sign
bit) are carried into the upper half of the result. The CF and OF flags
are cleared when the result (including the sign bit) fits exactly in the
lower half of the result.

The three forms of the IMUL instruction are similar in that the length
of the product is calculated to twice the length of the operands. With
the one-operand form, the product is stored exactly in the destination.
With the two- and three- operand forms, however, the result is truncated
to the length of the destination before it is stored in the destination
register. Because of this truncation, the CF or OF flag should be tested
to ensure that no significant bits are lost.

The two- and three-operand forms may also be used with unsigned operands
because the lower half of the product is the same regardless if the
operands are signed or unsigned. The CF and OF flags, however, cannot be
used to determine if the upper half of the result is non-zero.

In 64-bit mode, the instruction's default operation size is 32 bits. Use
of the REX.R prefix permits access to additional registers (R8-R15). Use
of the REX.W prefix promotes operation to 64 bits. Use of REX.W modifies
the three forms of the instruction as follows.

-   One-operand form —The source operand (in a 64-bit general-purpose
    register or memory location) is multiplied by the value in the RAX
    register and the product is stored in the RDX:RAX registers.
-   Two-operand form — The source operand is promoted to 64 bits if it
    is a register or a memory location. If the source operand is an
    immediate, it is sign extended to 64 bits. The destination operand
    is promoted to 64 bits.
-   Three-operand form — The first source operand (either a register or
    a memory location) and destination operand are promoted to 64 bits.

"
	^ self 
		addInstruction: #imul
		operands: { aRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'instruction list' stamp: ''!
instructionsFor: aBlockWithCode

	| old new |

	old := instructions.
	instructions := nil.

	[
		aBlockWithCode value.
	] ensure: [ 
		new := instructions.
		instructions := old ].

	^ new! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
movhlps: aRegisterOrMemory1 with: aRegisterOrMemory2
	"Move Packed Single-FP Values High to Low
	Pseudo Code
-----------
DEST[63:0] = SRC[127:64]; (* DEST[127:64] unchanged *)

Description
-----------
Moves two packed single-precision floating-point values from the high
quadword of the source operand (second operand) to the low quadword of
the destination operand (first operand). The high quadword of the
destination operand is left unchanged.

In 64-bit mode, use of the REX.R prefix permits this instruction to
access additional registers (XMM8-XMM15).

"
	^ self 
		addInstruction: #movhlps
		operands: { aRegisterOrMemory1 . aRegisterOrMemory2 }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fdivrp: aX87Register
	"Reverse Divide and Pop
	"
	^ self 
		addInstruction: #fdivrp
		operands: { aX87Register }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
call: anAddressSource
	"Call Procedure
	Description
-----------
Saves procedure linking information on the stack and branches to the
called procedure specified using the target operand. The target operand
specifies the address of the first instruction in the called procedure.
The operand can be an immediate value, a general-purpose register, or a
memory location.

This instruction can be used to execute four types of calls:

-   Near Call — A call to a procedure in the current code segment (the
    segment currently pointed to by the CS register), sometimes referred
    to as an intrasegment call.
-   Far Call — A call to a procedure located in a different segment than
    the current code segment, sometimes referred to as an inter-segment
    call.
-   Inter-privilege-level far call — A far call to a procedure in a
    segment at a different privilege level than that of the currently
    executing program or procedure.
-   Task switch — A call to a procedure located in a different task.

The latter two call types (inter-privilege-level call and task switch)
can only be executed in protected mode. See 'Calling Procedures Using
Call and RET' in Chapter6 of the Intel®64 and IA-32 Architectures
Software Developer's Manual, Volume 1, for additional information on
near, far, and inter-privilege-level calls. See Chapter 7,'Task
Management,' in theIntel® 64 and IA-32 Architectures Software
Developer'sManual, Volume 3A, for information on performing task
switches with the CALL instruction.

Near Call. When executing a near call, the processor pushes the value of
the EIP register (which contains the offset of the instruction following
the CALL instruction) on the stack (for use later as a
return-instruction pointer). The processor then branches to the address
in the current code segment specified by the target operand. The target
operand specifies either an absolute offset in the code segment (an
offset from the base of the code segment) or a relative offset (a signed
displacement relative to the current value of the instruction pointer in
the EIP register; this value points to the instruction following the
CALL instruction). The CS register is not changed on near calls.

For a near call absolute, an absolute offset is specified indirectly in
a general-purpose register or a memory location (r/m16, r/m32, or
r/m64). The operand-size attribute determines the size of the target
operand (16, 32 or 64 bits). When in 64-bit mode, the operand size for
near call (and all near branches) is forced to 64-bits. Absolute offsets
are loaded directly into the EIP(RIP) register. If the operand size
attribute is 16, the upper two bytes of the EIP register are cleared,
resulting in a maximum instruction pointer size of 16 bits. When
accessing an absolute offset indirectly using the stack pointer [ESP] as
the base register, the base value used is the value of the ESP before
the instruction executes.

A relative offset (rel16 or rel32) is generally specified as a label in
assembly code. But at the machine code level, it is encoded as a signed,
16- or 32-bit immediate value. This value is added to the value in the
EIP(RIP) register. In 64-bit mode the relative offset is always a 32-bit
immediate value which is sign extended to 64-bits before it is added to
the value in the RIP register for the target calculation. As with
absolute offsets, the operand-size attribute determines the size of the
target operand (16, 32, or 64 bits). In 64-bit mode the target operand
will always be 64-bits because the operand size is forced to 64-bits for
near branches.

Far Calls in Real-Address or Virtual-8086 Mode. When executing a far
call in real- address or virtual-8086 mode, the processor pushes the
current value of both the CS and EIP registers on the stack for use as a
return-instruction pointer. The processor then performs a 'far branch'
to the code segment and offset specified with the target operand for the
called procedure. The target operand specifies an absolute far address
either directly with a pointer (ptr16:16 or ptr16:32) or indirectly with
a memory location (m16:16 or m16:32). With the pointer method, the
segment and offset of the called procedure is encoded in the instruction
using a 4-byte (16-bit operand size) or 6-byte (32-bit operand size) far
address immediate. With the indirect method, the target operand
specifies a memory location that contains a 4-byte (16-bit operand size)
or 6-byte (32-bit operand size) far address. The operand-size attribute
determines the size of the offset (16 or 32 bits) in the far address.
The far address is loaded directly into the CS and EIP registers. If the
operand-size attribute is 16, the upper two bytes of the EIP register
are cleared.

Far Calls in Protected Mode. When the processor is operating in
protected mode, the CALL instruction can be used to perform the
following types of far calls:

-   Far call to the same privilege level
-   Far call to a different privilege level (inter-privilege level call)
-   Task switch (far call to another task)

In protected mode, the processor always uses the segment selector part
of the far address to access the corresponding descriptor in the GDT or
LDT. The descriptor type (code segment, call gate, task gate, or TSS)
and access rights determine the type of call operation to be performed.

If the selected descriptor is for a code segment, a far call to a code
segment at the same privilege level is performed. (If the selected code
segment is at a different privilege level and the code segment is
non-conforming, a general-protection exception is generated.) A far call
to the same privilege level in protected mode is very similar to one
carried out in real-address or virtual-8086 mode. The target operand
specifies an absolute far address either directly with a pointer
(ptr16:16 or ptr16:32) or indirectly with a memory location (m16:16 or
m16:32). The operand- size attribute determines the size of the offset
(16 or 32 bits) in the far address. The new code segment selector and
its descriptor are loaded into CS register; the offset from the
instruction is loaded into the EIP register.

A call gate (described in the next paragraph) can also be used to
perform a far call to a code segment at the same privilege level. Using
this mechanism provides an extra level of indirection and is the
preferred method of making calls between 16-bit and 32-bit code
segments.

When executing an inter-privilege-level far call, the code segment for
the procedure being called must be accessed through a call gate. The
segment selector specified by the target operand identifies the call
gate. The target operand can specify the call gate segment selector
either directly with a pointer (ptr16:16 or ptr16:32) or indirectly with
a memory location (m16:16 or m16:32). The processor obtains the segment
selector for the new code segment and the new instruction pointer
(offset) from the call gate descriptor. (The offset from the target
operand is ignored when a call gate is used.)

On inter-privilege-level calls, the processor switches to the stack for
the privilege level of the called procedure. The segment selector for
the new stack segment is specified in the TSS for the currently running
task. The branch to the new code segment occurs after the stack switch.
(Note that when using a call gate to perform a far call to a segment at
the same privilege level, no stack switch occurs.) On the new stack, the
processor pushes the segment selector and stack pointer for the calling
procedure's stack, an optional set of parameters from the calling
procedures stack, and the segment selector and instruction pointer for
the calling procedure's code segment. (A value in the call gate
descriptor determines how many parameters to copy to the new stack.)
Finally, the processor branches to the address of the procedure being
called within the new code segment.

Executing a task switch with the CALL instruction is similar to
executing a call through a call gate. The target operand specifies the
segment selector of the task gate for the new task activated by the
switch (the offset in the target operand is ignored). The task gate in
turn points to the TSS for the new task, which contains the segment
selectors for the task's code and stack segments. Note that the TSS also
contains the EIP value for the next instruction that was to be executed
before the calling task was suspended. This instruction pointer value is
loaded into the EIP register to re-start the calling task.

The CALL instruction can also specify the segment selector of the TSS
directly, which eliminates the indirection of the task gate. See Chapter
7, 'Task Management,' in the

Intel® 64 and IA-32 Architectures Software Developer's Manual, Volume
3A, for information on the mechanics of a task switch.

When you execute at task switch with a CALL instruction, the nested task
flag (NT) is set in the EFLAGS register and the new TSS's previous task
link field is loaded with the old task's TSS selector. Code is expected
to suspend this nested task by executing an IRET instruction which,
because the NT flag is set, automatically uses the previous task link to
return to the calling task. (See 'Task Linking' in Chapter 7 ofthe
Intel® 64 and IA-32 Architectures Software Developer's Manual, Volume
3A, for information on nested tasks.) Switching tasks with the CALL
instruction differs in this regard from JMP instruction. JMP does not
set the NT flag and therefore does not expect an IRET instruction to
suspend the task.

Mixing 16-Bit and 32-Bit Calls. When making far calls between 16-bit and
32-bit code segments, use a call gate. If the far call is from a 32-bit
code segment to a 16-bit code segment, the call should be made from the
first 64 KBytes of the 32-bit code segment. This is because the
operand-size attribute of the instruction is set to 16, so only a 16-bit
return address offset can be saved. Also, the call should be made using
a 16-bit call gate so that 16-bit values can be pushed on the stack. See
Chapter 18,'Mixing 16-Bit and 32-Bit Code,' in theIntel® 64 and IA-32
Architectures SoftwareDeveloper's Manual, Volume 3A, for more
information.

Far Calls in Compatibility Mode. When the processor is operating in
compatibility mode, the CALL instruction can be used to perform the
following types of far calls:

-   Far call to the same privilege level, remaining in compatibility
    mode
-   Far call to the same privilege level, transitioning to 64-bit mode
-   Far call to a different privilege level (inter-privilege level
    call), transitioning to 64bit mode

Note that a CALL instruction can not be used to cause a task switch in
compatibility mode since task switches are not supported in IA-32e mode.

In compatibility mode, the processor always uses the segment selector
part of the far address to access the corresponding descriptor in the
GDT or LDT. The descriptor type (code segment, call gate) and access
rights determine the type of call operation to be performed.

If the selected descriptor is for a code segment, a far call to a code
segment at the same privilege level is performed. (If the selected code
segment is at a different privilege level and the code segment is
non-conforming, a general-protection exception is generated.) A far call
to the same privilege level in compatibility mode is very similar to one
carried out in protected mode. The target operand specifies an absolute
far address either directly with a pointer (ptr16:16 or ptr16:32) or
indirectly with a memory location (m16:16 or m16:32). The operand-size
attribute determines the size of the offset (16 or 32 bits) in the far
address. The new code segment selector and its descriptor are loaded
into CS register and the offset from the instruction is loaded into the
EIP register. The difference is that 64-bit mode may be entered. This
specified by the L bit in the new code segment descriptor.

Note that a 64-bit call gate (described in the next paragraph) can also
be used to perform a far call to a code segment at the same privilege
level. However, using this mechanism requires that the target code
segment descriptor have the L bit set, causing an entry to 64-bit mode.

When executing an inter-privilege-level far call, the code segment for
the procedure being called must be accessed through a 64-bit call gate.
The segment selector specified by the target operand identifies the call
gate. The target operand can specify the call gate segment selector
either directly with a pointer (ptr16:16 or ptr16:32) or indirectly with
a memory location (m16:16 or m16:32). The processor obtains the segment
selector for the new code segment and the new instruction pointer
(offset) from the 16-byte call gate descriptor. (The offset from the
target operand is ignored when a call gate is used.)

On inter-privilege-level calls, the processor switches to the stack for
the privilege level of the called procedure. The segment selector for
the new stack segment is set to NULL. The new stack pointer is specified
in the TSS for the currently running task. The branch to the new code
segment occurs after the stack switch. (Note that when using a call gate
to perform a far call to a segment at the same privilege level, an
implicit stack switch occurs as a result of entering 64-bit mode. The SS
selector is unchanged, but stack segment accesses use a segment base of
0x0, the limit is ignored, and the default stack size is 64-bits. The
full value of RSP is used for the offset, of which the upper 32-bits are
undefined.) On the new stack, the processor pushes the segment selector
and stack pointer for the calling procedure's stack and the segment
selector and instruction pointer for the calling procedure's code
segment. (Parameter copy is not supported in IA-32e mode.) Finally, the
processor branches to the address of the procedure being called within
the new code segment.

Near/(Far) Calls in 64-bit Mode. When the processor is operating in
64-bit mode, the CALL instruction can be used to perform the following
types of far calls:

-   Far call to the same privilege level, transitioning to compatibility
    mode
-   Far call to the same privilege level, remaining in 64-bit mode
-   Far call to a different privilege level (inter-privilege level
    call), remaining in 64-bit mode

Note that in this mode the CALL instruction can not be used to cause a
task switch in 64-bit mode since task switches are not supported in
IA-32e mode.

In 64-bit mode, the processor always uses the segment selector part of
the far address to access the corresponding descriptor in the GDT or
LDT. The descriptor type (code segment, call gate) and access rights
determine the type of call operation to be performed.

If the selected descriptor is for a code segment, a far call to a code
segment at the same privilege level is performed. (If the selected code
segment is at a different privilege level and the code segment is
non-conforming, a general-protection exception is generated.) A far call
to the same privilege level in 64-bit mode is very similar to one
carried out in compatibility mode. The target operand specifies an
absolute far address indirectly with a memory location (m16:16, m16:32
or m16:64). The form of CALL with a direct specification of absolute far
address is not defined in 64-bit mode. The operand-size attribute
determines the size of the offset (16, 32, or 64 bits) in the far
address. The new code segment selector and its descriptor are loaded
into the CS register; the offset from the instruction is loaded into the
EIP register. The new code segment may specify entry either into
compatibility or 64-bit mode, based on the L bit value.

A 64-bit call gate (described in the next paragraph) can also be used to
perform a far call to a code segment at the same privilege level.
However, using this mechanism requires that the target code segment
descriptor have the L bit set.

When executing an inter-privilege-level far call, the code segment for
the procedure being called must be accessed through a 64-bit call gate.
The segment selector specified by the target operand identifies the call
gate. The target operand can only specify the call gate segment selector
indirectly with a memory location (m16:16, m16:32 or m16:64). The
processor obtains the segment selector for the new code segment and the
new instruction pointer (offset) from the 16-byte call gate descriptor.
(The offset from the target operand is ignored when a call gate is
used.)

On inter-privilege-level calls, the processor switches to the stack for
the privilege level of the called procedure. The segment selector for
the new stack segment is set to NULL. The new stack pointer is specified
in the TSS for the currently running task. The branch to the new code
segment occurs after the stack switch.

Note that when using a call gate to perform a far call to a segment at
the same privilege level, an implicit stack switch occurs as a result of
entering 64-bit mode. The SS selector is unchanged, but stack segment
accesses use a segment base of 0x0, the limit is ignored, and the
default stack size is 64-bits. (The full value of RSP is used for the
offset.) On the new stack, the processor pushes the segment selector and
stack pointer for the calling procedure's stack and the segment selector
and instruction pointer for the calling procedure's code segment.
(Parameter copy is not supported in IA-32e mode.) Finally, the processor
branches to the address of the procedure being called within the new
code segment.

"
	^ self 
		addInstruction: #call
		operands: { anAddressSource }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fcmove: aX87Register
	"FP Conditional Move - equal (ZF=1)
	"
	^ self 
		addInstruction: #fcmove
		operands: { aX87Register }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fnsave: aMemoryOperand
	"Store x87 FPU State
	"
	^ self 
		addInstruction: #fnsave
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
ffree: aX87Register
	"Free Floating-Point Register
	"
	^ self 
		addInstruction: #ffree
		operands: { aX87Register }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fmul: aX87Register1 with: aX87Register2
	"
	see #fmul"
	^ self 
		addInstruction: #fmul
		operands: { aX87Register1 . aX87Register2 }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fmulp: aX87Register
	"Multiply and Pop
	"
	^ self 
		addInstruction: #fmulp
		operands: { aX87Register }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fnstenv: aMemoryOperand
	"Store x87 FPU Environment
	"
	^ self 
		addInstruction: #fnstenv
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmovng: aRegister with: aSourceRegisterOrMemory
	"
	"
	^ self 
		addInstruction: #cmovng
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
bsf: aRegister with: aSourceRegisterOrMemory
	"Bit Scan Forward
	Description
-----------
Searches the source operand (second operand) for the least significant
set bit (1 bit). If a least significant 1 bit is found, its bit index is
stored in the destination operand (first operand). The source operand
can be a register or a memory location; the destination operand is a
register. The bit index is an unsigned offset from bit 0 of the source
operand. If the content of the source operand is 0, the content of the
destination operand is undefined.

In 64-bit mode, the instruction's default operation size is 32 bits.
Using a REX prefix in the form of REX.R permits access to additional
registers (R8-R15). Using a REX prefix in the form of REX.W promotes
operation to 64 bits. See the summary chart at the beginning of this
section for encoding data and limits.

"
	^ self 
		addInstruction: #bsf
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
bt: aDestinationRegisterOrMemory with: aSourceRegisterOrImmediate
	"Bit Test
	Pseudo Code
-----------
CF = Bit(BitBase, BitOffset);

Description
-----------
Selects the bit in a bit string (specified with the first operand,
called the bit base) at the bit-position designated by the bit offset
(specified by the second operand) and stores the value of the bit in the
CF flag. The bit base operand can be a register or a memory location;
the bit offset operand can be a register or an immediate value:

-   If the bit base operand specifies a register, the instruction takes
    the modulo 16, 32, or 64 of the bit offset operand (modulo size
    depends on the mode and register size; 64-bit operands are available
    only in 64-bit mode).
-   If the bit base operand specifies a memory location, the operand
    represents the address of the byte in memory that contains the bit
    base (bit 0 of the specified byte) of the bit string. The range of
    the bit position that can be referenced by the offset operand
    depends on the operand size.

See also: Bit(BitBase, BitOffset) on page 3-11.

Some assemblers support immediate bit offsets larger than 31 by using
the immediate bit offset field in combination with the displacement
field of the memory operand. In this case, the low-order 3 or 5 bits (3
for 16-bit operands, 5 for 32-bit operands) of the immediate bit offset
are stored in the immediate bit offset field, and the high-order bits
are shifted and combined with the byte displacement in the addressing
mode by the assembler. The processor will ignore the high order bits if
they are not zero.

When accessing a bit in memory, the processor may access 4 bytes
starting from the memory address for a 32-bit operand size, using by the
following relationship:

Effective Address + (4 \* (BitOffset DIV 32))

Or, it may access 2 bytes starting from the memory address for a 16-bit
operand, using this relationship:

Effective Address + (2 \* (BitOffset DIV 16))

It may do so even when only a single byte needs to be accessed to reach
the given bit. When using this bit addressing mechanism, software should
avoid referencing areas of memory close to address space holes. In
particular, it should avoid references to memory-mapped I/O registers.
Instead, software should use the MOV instructions to load from or store
to these addresses, and use the register form of these instructions to
manipulate the data.

In 64-bit mode, the instruction's default operation size is 32 bits.
Using a REX prefix in the form of REX.R permits access to additional
registers (R8-R15). Using a REX prefix in the form of REX.W promotes
operation to 64 bit operands. See the summary chart at the beginning of
this section for encoding data and limits.

"
	^ self 
		addInstruction: #bt
		operands: { aDestinationRegisterOrMemory . aSourceRegisterOrImmediate }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmpxchg8b: aMemoryOperand
	"Compare and Exchange Bytes
	"
	^ self 
		addInstruction: #cmpxchg8b
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'labels' stamp: 'CamilloBruni 7/18/2012 16:27'!
label: aNameOrLabel ifPresent: anExceptionBlock
	| label |
	label := aNameOrLabel.
	label isString 
		ifTrue: [ label := self labelNamed: label ].
	
	label isSet 
		ifTrue: [ ^ anExceptionBlock cull: label ].
	
	label isSet: true.
	^ self addInstruction: label.  ! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
DH
	"A 8bit general purpose register
	This register overlaps with DH, DX, EDX, RDX"
	^ DH! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fdiv: aX87Register1 with: aX87Register2
	"
	see #fdiv"
	^ self 
		addInstruction: #fdiv
		operands: { aX87Register1 . aX87Register2 }! !

!AJx86Assembler methodsFor: 'dnu' stamp: 'CamilloBruni 4/17/2012 17:51'!
doesNotUnderstand: aMessage
	"try to dispatch a message based on instruction name"
	
	| sel pos |
	sel := aMessage selector. 
	sel isBinary ifTrue: [
		"binary selectors"
		^ super doesNotUnderstand: aMessage ].
	
	"use the first keyword to find the instruction"
	pos := sel indexOf: $:.
	pos > 0 ifTrue: [ sel := (sel first: pos - 1) asSymbol ].
	self instructionDesciptions at: sel ifPresent: [ :description|
		^ self addInstruction: sel description: description operands: aMessage arguments
	].
	
	^ super doesNotUnderstand: aMessage! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
btc: aDestinationRegisterOrMemory with: aSourceRegisterOrImmediate
	"Bit Test and Complement
	Pseudo Code
-----------
CF = Bit(BitBase, BitOffset);
Bit(BitBase, BitOffset) = NOT Bit(BitBase, BitOffset);

Description
-----------
Selects the bit in a bit string (specified with the first operand,
called the bit base) at the bit-position designated by the bit offset
operand (second operand), stores the value of the bit in the CF flag,
and complements the selected bit in the bit string. The bit base operand
can be a register or a memory location; the bit offset operand can be a
register or an immediate value:

-   If the bit base operand specifies a register, the instruction takes
    the modulo 16, 32, or 64 of the bit offset operand (modulo size
    depends on the mode and register size; 64-bit operands are available
    only in 64-bit mode). This allows any bit position to be selected.
-   If the bit base operand specifies a memory location, the operand
    represents the address of the byte in memory that contains the bit
    base (bit 0 of the specified byte) of the bit string. The range of
    the bit position that can be referenced by the offset operand
    depends on the operand size.

See also: Bit(BitBase, BitOffset) on page 3-11.

Some assemblers support immediate bit offsets larger than 31 by using
the immediate bit offset field in combination with the displacement
field of the memory operand. See 'BT—Bit Test' in this chapter for more
information on this addressingmechanism.

This instruction can be used with a LOCK prefix to allow the instruction
to be executed atomically.

In 64-bit mode, the instruction's default operation size is 32 bits.
Using a REX prefix in the form of REX.R permits access to additional
registers (R8-R15). Using a REX prefix in the form of REX.W promotes
operation to 64 bits. See the summary chart at the beginning of this
section for encoding data and limits.

"
	^ self 
		addInstruction: #btc
		operands: { aDestinationRegisterOrMemory . aSourceRegisterOrImmediate }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
add: aRegisterOrMemoryOperand with: aSource
	"Add
	Pseudo Code
-----------
DEST = DEST + SRC;

Description
-----------
Adds the destination operand (first operand) and the source operand
(second operand) and then stores the result in the destination operand.
The destination operand can be a register or a memory location; the
source operand can be an immediate, a register, or a memory location.
(However, two memory operands cannot be used in one instruction.) When
an immediate value is used as an operand, it is sign-extended to the
length of the destination operand format.

The ADD instruction performs integer addition. It evaluates the result
for both signed and unsigned integer operands and sets the OF and CF
flags to indicate a carry (overflow) in the signed or unsigned result,
respectively. The SF flag indicates the sign of the signed result.

This instruction can be used with a LOCK prefix to allow the instruction
to be executed atomically.

In 64-bit mode, the instruction's default operation size is 32 bits.
Using a REX prefix in the form of REX.R permits access to additional
registers (R8-R15). Using a REX a REX prefix in the form of REX.W
promotes operation to 64 bits. See the summary chart at the beginning of
this section for encoding data and limits.

"
	^ self 
		addInstruction: #add
		operands: { aRegisterOrMemoryOperand . aSource }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
jg: targetLabel
	"
	"
	^ self 
		addInstruction: #jg
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
test: aRegisterOrMemory with: aRegisterOrImmediate
	"Logical Compare
	Description
-----------
Computes the bit-wise logical AND of first operand (source 1 operand)
and the second operand (source 2 operand) and sets the SF, ZF, and PF
status flags according to the result. The result is then discarded.

In 64-bit mode, using a REX prefix in the form of REX.R permits access
to additional registers (R8-R15). Using a REX prefix in the form of
REX.W promotes operation to 64 bits. See the summary chart at the
beginning of this section for encoding data and limits.

"
	^ self 
		addInstruction: #test
		operands: { aRegisterOrMemory . aRegisterOrImmediate }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
ST4
	"A floating point register"
	^ ST4! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fdivr: aMemoryOperand
	"Reverse Divide
	"
	^ self 
		addInstruction: #fdivr
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fdiv: aMemoryOperand
	"Divide
	"
	^ self 
		addInstruction: #fdiv
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmovpo: aRegister with: aSourceRegisterOrMemory
	"
	"
	^ self 
		addInstruction: #cmovpo
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
ST7
	"A floating point register"
	^ ST7! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
XMM2
	"An SSE register"
	^ XMM2! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
BX
	"A 16bit general purpose register
	This register overlaps with BL, BX, EBX, RBX"
	^ BX! !

!AJx86Assembler methodsFor: 'function calls' stamp: ''!
cdeclCall: aBlock alignment: align

	^ self performingCall: (self newCdeclCall alignment: align) in: aBlock
! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fucom: aX87Register
	"Unordered Compare Floating Point Values
	"
	^ self 
		addInstruction: #fucom
		operands: { aX87Register }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmovpe: aRegister with: aSourceRegisterOrMemory
	"
	"
	^ self 
		addInstruction: #cmovpe
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
clflush: aMemoryOperand
	"Flush Cache Line
	Pseudo Code
-----------
Flush_Cache_Line(SRC);

Description
-----------
Invalidates the cache line that contains the linear address specified
with the source operand from all levels of the processor cache hierarchy
(data and instruction). The invalidation is broadcast throughout the
cache coherence domain. If, at any level of the cache hierarchy, the
line is inconsistent with memory (dirty) it is written to memory before
invalidation. The source operand is a byte memory location.

The availability of CLFLUSH is indicated by the presence of the CPUID
feature flag CLFSH (bit 19 of the EDX register, see 'CPUID—CPU
Identification' in this chapter).The aligned cache line size affected is
also indicated with the CPUID instruction (bits 8 through 15 of the EBX
register when the initial value in the EAX register is 1).

The memory attribute of the page containing the affected line has no
effect on the behavior of this instruction. It should be noted that
processors are free to speculatively fetch and cache data from system
memory regions assigned a memory-type allowing for speculative reads
(such as, the WB, WC, and WT memory types). PREFETCHh instructions can
be used to provide the processor with hints for this speculative
behavior. Because this speculative fetching can occur at any time and is
not tied to instruction execution, the CLFLUSH instruction is not
ordered with respect to PREFETCHh instructions or any of the speculative
fetching mechanisms (that is, data can be speculatively loaded into a
cache line just before, during, or after the execution of a CLFLUSH
instruction that references the cache line).

CLFLUSH is only ordered by the MFENCE instruction. It is not guaranteed
to be ordered by any other fencing or serializing instructions or by
another CLFLUSH instruction. For example, software can use an MFENCE
instruction to ensure that previous stores are included in the
write-back.

The CLFLUSH instruction can be used at all privilege levels and is
subject to all permission checking and faults associated with a byte
load (and in addition, a CLFLUSH instruction is allowed to flush a
linear address in an execute-only segment). Like a load, the CLFLUSH
instruction sets the A bit but not the D bit in the page tables.

The CLFLUSH instruction was introduced with the SSE2 extensions;
however, because it has its own CPUID feature flag, it can be
implemented in IA-32 processors that do not include the SSE2 extensions.
Also, detecting the presence of the SSE2 extensions with the CPUID
instruction does not guarantee that the CLFLUSH instruction is
implemented in the processor.

CLFLUSH operation is the same in non-64-bit modes and 64-bit mode.

"
	^ self 
		addInstruction: #clflush
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
idiv: aDestination
	"Signed Divide
	Description
-----------
Divides the (signed) value in the AX, DX:AX, or EDX:EAX (dividend) by
the source operand (divisor) and stores the result in the AX (AH:AL),
DX:AX, or EDX:EAX registers. The source operand can be a general-purpose
register or a memory location. The action of this instruction depends on
the operand size (dividend/divisor).

Non-integral results are truncated (chopped) towards 0. The remainder is
always less than the divisor in magnitude. Overflow is indicated with
the \#DE (divide error) exception rather than with the CF flag.

In 64-bit mode, the instruction's default operation size is 32 bits. Use
of the REX.R prefix permits access to additional registers (R8-R15). Use
of the REX.W prefix promotes operation to 64 bits. In 64-bit mode when
REX.W is applied, the instruction divides the signed value in RDX:RAX by
the source operand. RAX contains a 64-bit quotient; RDX contains a
64-bit remainder.

See the summary chart at the beginning of this section for encoding data
and limits. See the following.

  Operand Size              Dividend   Divisor   Quotient   Remainder   Quotient Range
  ------------------------- ---------- --------- ---------- ----------- ---------------------
  Word/byte                 AX         r/m8      AL         AH          -128 to +127
  Doubleword/word           DX:AX      r/m16     AX         DX          -32,768 to +32,767
  Quadword/doubleword       EDX:EAX    r/m32     EAX        EDX         -2^31^ to 2^32^ - 1
  Doublequadword/quadword   RDX:RAX    r/m64     RAX        RDX         -2^63^ to 2^64^ - 1

  : IDIV Results

"
	^ self 
		addInstruction: #idiv
		operands: { aDestination }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
jnl: targetLabel
	"Jump short if not less/greater or equal (SF=OF)
	"
	^ self 
		addInstruction: #jnl
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fxrstor: aMemoryOperand
	"Restore x87 FPU, MMX, XMM, and MXCSR State
	Pseudo Code
-----------
(x87 FPU, MMX, XMM7-XMM0, MXCSR) = Load(SRC);

Description
-----------
Reloads the x87 FPU, MMX technology, XMM, and MXCSR registers from the
512-byte memory image specified in the source operand. This data should
have been written to memory previously using the FXSAVE instruction, and
in the same format as required by the operating modes. The first byte of
the data should be located on a 16-byte boundary. There are three
distinct layouts of the FXSAVE state map: one for legacy and
compatibility mode, a second format for 64-bit mode FXSAVE/FXRSTOR with
REX.W=0, and the third format is for 64-bit mode with
FXSAVE64/FXRSTOR64. Table 3-48 ('Non-64-bit-Mode Layout of FXSAVE and
FXRSTOR Memory Region') shows the layout of the legacy/compatibility
mode state information inmemory and describes the fields in the memory
image for the FXRSTOR and FXSAVE instructions.Table 3-51 shows the
layout of the 64-bit mode state information whenREX.W is set
(FXSAVE64/FXRSTOR64). Table 3-52 shows the layout of the 64-bitmode
state information when REX.W is clear (FXSAVE/FXRSTOR).

The state image referenced with an FXRSTOR instruction must have been
saved using an FXSAVE instruction or be in the same format as required
by Table 3-48, Table 3-51, or Table 3-52. Referencing a state image
saved with an FSAVE, FNSAVEinstruction or incompatible field layout will
result in an incorrect state restoration.

The FXRSTOR instruction does not flush pending x87 FPU exceptions. To
check and raise exceptions when loading x87 FPU state information with
the FXRSTOR instruction, use an FWAIT instruction after the FXRSTOR
instruction.

If the OSFXSR bit in control register CR4 is not set, the FXRSTOR
instruction may not restore the states of the XMM and MXCSR registers.
This behavior is implementation dependent.

If the MXCSR state contains an unmasked exception with a corresponding
status flag also set, loading the register with the FXRSTOR instruction
will not result in a SIMD floating-point error condition being
generated. Only the next occurrence of this unmasked exception will
result in the exception being generated.

Bits 16 through 32 of the MXCSR register are defined as reserved and
should be set to 0. Attempting to write a 1 in any of these bits from
the saved state image will result in a general protection exception
(\#GP) being generated.

Bytes 464:511 of an FXSAVE image are available for software use. FXRSTOR
ignores the content of bytes 464:511 in an FXSAVE state image.

"
	^ self 
		addInstruction: #fxrstor
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
jnz: targetLabel
	"Jump short if not zero/not equal (ZF=1)
	"
	^ self 
		addInstruction: #jnz
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmovc: aRegister with: aSourceRegisterOrMemory
	"
	"
	^ self 
		addInstruction: #cmovc
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
jne: targetLabel
	"
	"
	^ self 
		addInstruction: #jne
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
movmskps: aRegisterOrMemory1 with: aRegisterOrMemory2
	"Extract Packed Single-FP Sign Mask
	Description
-----------
Extracts the sign bits from the packed single-precision floating-point
values in the source operand (second operand), formats them into a 4-bit
mask, and stores the mask in the destination operand (first operand).
The source operand is an XMM register, and the destination operand is a
general-purpose register. The mask is stored in the 4 low-order bits of
the destination operand. Zero-extend the upper bits of the destination
operand.

In 64-bit mode, the instruction can access additional registers
(XMM8-XMM15, R8-R15) when used with a REX.R prefix. The default operand
size is 64-bit in 64-bit mode.

"
	^ self 
		addInstruction: #movmskps
		operands: { aRegisterOrMemory1 . aRegisterOrMemory2 }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
movntdq: aRegisterOrMemory1 with: aRegisterOrMemory2
	"Store Double Quadword Using Non-Temporal Hint
	Pseudo Code
-----------
DEST = SRC;

Description
-----------
Moves the double quadword in the source operand (second operand) to the
destination operand (first operand) using a non-temporal hint to prevent
caching of the data during the write to memory. The source operand is an
XMM register, which is assumed to contain integer data (packed bytes,
words, doublewords, or quadwords). The destination operand is a 128-bit
memory location.

The non-temporal hint is implemented by using a write combining (WC)
memory type protocol when writing the data to memory. Using this
protocol, the processor does not write the data into the cache
hierarchy, nor does it fetch the corresponding cache line from memory
into the cache hierarchy. The memory type of the region being written to
can override the non-temporal hint, if the memory address specified for
the non-temporal store is in an uncacheable (UC) or write protected (WP)
memory region. For more information on non-temporal stores, see 'Caching
of Temporal vs. Non-Temporal Data' in Chapter 10 in theIntel®64 and
IA-32 Architectures Software Developer's Manual, Volume 1.

Because the WC protocol uses a weakly-ordered memory consistency model,
a fencing operation implemented with the SFENCE or MFENCE instruction
should be used in conjunction with MOVNTDQ instructions if multiple
processors might use different memory types to read/write the
destination memory locations.

In 64-bit mode, use of the REX.R prefix permits this instruction to
access additional registers (XMM8-XMM15).

"
	^ self 
		addInstruction: #movntdq
		operands: { aRegisterOrMemory1 . aRegisterOrMemory2 }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
neg: aDestination
	"Two's Complement Negation
	Pseudo Code
-----------
IF DEST = 0
    CF = 0;
ELSE
    CF = 1;
FI;
DEST = [- (DEST)]

Description
-----------
Replaces the value of operand (the destination operand) with its two's
complement. (This operation is equivalent to subtracting the operand
from 0.) The destination operand is located in a general-purpose
register or a memory location.

This instruction can be used with a LOCK prefix to allow the instruction
to be executed atomically.

In 64-bit mode, the instruction's default operation size is 32 bits.
Using a REX prefix in the form of REX.R permits access to additional
registers (R8-R15). Using a REX prefix in the form of REX.W promotes
operation to 64 bits. See the summary chart at the beginning of this
section for encoding data and limits.

"
	^ self 
		addInstruction: #neg
		operands: { aDestination }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
sal: aDestinationRegisterOrMemory with: aRegisterOrImmediate
	"
	"
	^ self 
		addInstruction: #sal
		operands: { aDestinationRegisterOrMemory . aRegisterOrImmediate }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fsub: aMemoryOperand
	"Subtract
	"
	^ self 
		addInstruction: #fsub
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
BL
	"A 8bit general purpose register
	This register overlaps with BL, BX, EBX, RBX"
	^ BL! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
AL
	"A 8bit general purpose register
	This register overlaps with AL, AX, EAX, RAX"
	^ AL! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fisub: aMemoryOperand
	"Subtract
	"
	^ self 
		addInstruction: #fisub
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
BH
	"A 8bit general purpose register
	This register overlaps with BH, BX, EBX, RBX"
	^ BH! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fsubrp: aX87Register
	"Reverse Subtract and Pop
	"
	^ self 
		addInstruction: #fsubrp
		operands: { aX87Register }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'MartinMcClure 12/15/2012 13:37'!
syscall
	"SYSCALL saves the RIP of the instruction following SYSCALL to RCX and loads a new
RIP from the IA32_LSTAR (64-bit mode). Upon return, SYSRET copies the value
saved in RCX to the RIP.
SYSCALL saves RFLAGS (lower 32 bit only) in R11. It then masks RFLAGS with an
OS-defined value using the IA32_FMASK (MSR C000_0084). The actual mask value
used by the OS is the complement of the value written to the IA32_FMASK MSR.
None of the bits in RFLAGS are automatically cleared (except for RF). SYSRET
restores RFLAGS from R11 (the lower 32 bits only).
Software should not alter the CS or SS descriptors in a manner that violates the
following assumptions made by SYSCALL/SYSRET:

* The CS and SS base and limit remain the same for all processes, including the
operating system (the base is 0H and the limit is 0FFFFFFFFH).

* The CS of the SYSCALL target has a privilege level of 0.

* The CS of the SYSRET target has a privilege level of 3.

SYSCALL/SYSRET do not check for violations of these assumptions.

Operation

IF (CS.L ~= 1 ) or (IA32_EFER.LMA ~= 1) or (IA32_EFER.SCE ~= 1)
(* Not in 64-Bit Mode or SYSCALL/SYSRET not enabled in IA32_EFER *)
  THEN #UD; FI;
RCX := RIP;
RIP := LSTAR_MSR;
R11 := EFLAGS;
EFLAGS := (EFLAGS MASKED BY IA32_FMASK);
CPL := 0;
CS(SEL) := IA32_STAR_MSR[47:32];
CS(DPL) := 0;
CS(BASE) := 0;
CS(LIMIT) := 0xFFFFF;
CS(GRANULAR) := 1;
SS(SEL) := IA32_STAR_MSR[47:32] + 8;
SS(DPL) := 0;
SS(BASE) := 0;
SS(LIMIT) := 0xFFFFF;
SS(GRANULAR) := 1;
SS(LIMIT) := 0xFFFFF;
SS(GRANULAR) := 1;
"

	^ self addInstruction: #syscall operands: #()! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
ST1
	"A floating point register"
	^ ST1! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
sbb: aRegisterOrMemoryOperand with: aSource
	"Integer Subtraction with Borrow
	"
	^ self 
		addInstruction: #sbb
		operands: { aRegisterOrMemoryOperand . aSource }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmovg: aRegister with: aSourceRegisterOrMemory
	"
	"
	^ self 
		addInstruction: #cmovg
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fucomip: aX87Register
	"Unordered Compare Floating Point Values and Set EFLAGS and Pop
	"
	^ self 
		addInstruction: #fucomip
		operands: { aX87Register }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
ror: aDestinationRegisterOrMemory with: aRegisterOrImmediate
	"Rotate
	"
	^ self 
		addInstruction: #ror
		operands: { aDestinationRegisterOrMemory . aRegisterOrImmediate }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
AX
	"A 16bit general purpose register
	This register overlaps with AL, AX, EAX, RAX"
	^ AX! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
XMM7
	"An SSE register"
	^ XMM7! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmovnb: aRegister with: aSourceRegisterOrMemory
	"Conditional Move - not below/above or equal/not carry (CF=0)
	"
	^ self 
		addInstruction: #cmovnb
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'register' stamp: ''!
basePointer
	^ self is32BitMode ifTrue: [ EBP ] ifFalse: [ BP ]! !

!AJx86Assembler methodsFor: 'accessing' stamp: ''!
numGPRegisters
	"answer the total number of general-purpose registers for target platform"
	^ 8
! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fst: aMemoryOrX87Register
	"Store Floating Point Value
	"
	^ self 
		addInstruction: #fst
		operands: { aMemoryOrX87Register }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
rcr: aDestinationRegisterOrMemory with: aRegisterOrImmediate
	"Rotate
	"
	^ self 
		addInstruction: #rcr
		operands: { aDestinationRegisterOrMemory . aRegisterOrImmediate }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
DI
	"A 16bit general purpose register
	This register overlaps with BH, BX, EBX, RBX"
	^ DI! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
jnb: targetLabel
	"Jump short if not below/above or equal/not carry (CF=0)
	"
	^ self 
		addInstruction: #jnb
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
movddup: aRegisterOrMemory1 with: aRegisterOrMemory2
	"Move One Double-FP and Duplicate
	Description
-----------
The linear address corresponds to the address of the least-significant
byte of the referenced memory data. When a memory address is indicated,
the 8 bytes of data at memory location m64 are loaded. When the
register-register form of this operation is used, the lower half of the
128-bit source register is duplicated and copied into the 128-bit
destination register.

In 64-bit mode, use of the REX.R prefix permits this instruction to
access additional registers (XMM8-XMM15).

"
	^ self 
		addInstruction: #movddup
		operands: { aRegisterOrMemory1 . aRegisterOrMemory2 }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fcmovu: aX87Register
	"FP Conditional Move - unordered (PF=1)
	"
	^ self 
		addInstruction: #fcmovu
		operands: { aX87Register }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
rol: aDestinationRegisterOrMemory with: aRegisterOrImmediate
	"Rotate
	"
	^ self 
		addInstruction: #rol
		operands: { aDestinationRegisterOrMemory . aRegisterOrImmediate }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
jc: targetLabel
	"
	"
	^ self 
		addInstruction: #jc
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
jo: targetLabel
	"Jump short if overflow (OF=1)
	"
	^ self 
		addInstruction: #jo
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
sar: aDestinationRegisterOrMemory with: aRegisterOrImmediate
	"Shift
	"
	^ self 
		addInstruction: #sar
		operands: { aDestinationRegisterOrMemory . aRegisterOrImmediate }! !

!AJx86Assembler methodsFor: 'accessing' stamp: ''!
undefinedLabels

	"answer a collection of labels, which having no defined position "
	| lbls |
	lbls := OrderedCollection new.
	
	labels keysAndValuesDo: [:key :value |
		value ifNil: [ lbls add: key]	
	].
	^ lbls! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmovnz: aRegister with: aSourceRegisterOrMemory
	"Conditional Move - not zero/not equal (ZF=1)
	"
	^ self 
		addInstruction: #cmovnz
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'accessing' stamp: 'CamilloBruni 4/18/2012 15:26'!
newInstruction
	^ AJx86Instruction new! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fcmovne: aX87Register
	"FP Conditional Move - not equal (ZF=0)
	"
	^ self 
		addInstruction: #fcmovne
		operands: { aX87Register }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
ST6
	"A floating point register"
	^ ST6! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
shr: aDestinationRegisterOrMemory with: aRegisterOrImmediate
	"Shift
	"
	^ self 
		addInstruction: #shr
		operands: { aDestinationRegisterOrMemory . aRegisterOrImmediate }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
XMM0
	"An SSE register"
	^ XMM0! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fsubr: aMemoryOperand
	"Reverse Subtract
	"
	^ self 
		addInstruction: #fsubr
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fcomi: aX87Register
	"Compare Floating Point Values and Set EFLAGS
	"
	^ self 
		addInstruction: #fcomi
		operands: { aX87Register }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmovnae: aRegister with: aSourceRegisterOrMemory
	"
	"
	^ self 
		addInstruction: #cmovnae
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'convenience' stamp: 'CamilloBruni 4/19/2012 13:20'!
dd: aByteArray
	self assert: aByteArray size == SizeDWord.
	^ self addInstruction: (AJData data: aByteArray)! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fcmovnu: aX87Register
	"FP Conditional Move - not unordered (PF=0)
	"
	^ self 
		addInstruction: #fcmovnu
		operands: { aX87Register }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmova: aRegister with: aSourceRegisterOrMemory
	"
	"
	^ self 
		addInstruction: #cmova
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmovns: aRegister with: aSourceRegisterOrMemory
	"Conditional Move - not sign (SF=0)
	"
	^ self 
		addInstruction: #cmovns
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fimul: aMemoryOperand
	"Multiply
	"
	^ self 
		addInstruction: #fimul
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
lea: aDestinationRegister with: aSourceMemory
	"Load Effective Address
	"
	^ self 
		addInstruction: #lea
		operands: { aDestinationRegister . aSourceMemory }! !

!AJx86Assembler methodsFor: 'function calls' stamp: ''!
newStdCall
	^ stackManager newStdCall asm: self
! !

!AJx86Assembler methodsFor: 'instruction list' stamp: ''!
replace: anInstruction with: otherInstructions

	"replace a single instruction with one or more other instructions"
	
	^ instructions := instructions replace: anInstruction with: otherInstructions.! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
EBX
	"A 32bit general purpose register
	This register overlaps with BL, BX, EBX, RBX"
	^ EBX! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
jnp: targetLabel
	"Jump short if not parity/parity odd
	"
	^ self 
		addInstruction: #jnp
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
ST0
	"A floating point register"
	^ ST0! !

!AJx86Assembler methodsFor: 'alignment' stamp: 'CamilloBruni 4/12/2012 13:52'!
align: aByteSize
	self addInstruction: (AJAlignmentInstruction align: aByteSize)! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fadd: aMemoryOperand
	"Add
	"
	^ self 
		addInstruction: #fadd
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
js: targetLabel
	"Jump short if sign (SF=1)
	"
	^ self 
		addInstruction: #js
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'instruction list' stamp: ''!
addInstruction: anInstruction
	"add one or multiple instructions to the tail"
	instructions ifNil: [
		instructions := anInstruction.
		]
	ifNotNil: [
		last := last last next: anInstruction.
		].
	anInstruction level: level.
	last := anInstruction last.
	^ anInstruction 
! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
jz: targetLabel
	"Jump short if zero/equal (ZF=0)
	"
	^ self 
		addInstruction: #jz
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'labels' stamp: 'CamilloBruni 5/29/2012 13:06'!
labelNamed: aNameOrLabel
	
	"directly use an object as label"
	aNameOrLabel isString ifFalse: [ 
		self assert: (labels at: aNameOrLabel name ) = aNameOrLabel.
		^ aNameOrLabel ].
	
	^ labels at: aNameOrLabel ifAbsentPut: [
		AJJumpLabel new
			name: aNameOrLabel 
		]! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmovl: aRegister with: aSourceRegisterOrMemory
	"Conditional Move - less/not greater (SF!!=OF)
	"
	^ self 
		addInstruction: #cmovl
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
movups: aRegisterOrMemory1 with: aRegisterOrMemory2
	"Move Unaligned Packed Single-FP Values
	Pseudo Code
-----------
DEST = SRC;

Description
-----------
Moves a double quadword containing four packed single-precision
floating-point values from the source operand (second operand) to the
destination operand (first operand). This instruction can be used to
load an XMM register from a 128-bit memory location, store the contents
of an XMM register into a 128-bit memory location, or move data between
two XMM registers. When the source or destination operand is a memory
operand, the operand may be unaligned on a 16-byte boundary without
causing a general-protection exception (\#GP) to be generated.1

To move packed single-precision floating-point values to and from memory
locations that are known to be aligned on 16-byte boundaries, use the
MOVAPS instruction.

While executing in 16-bit addressing mode, a linear address for a
128-bit data access that overlaps the end of a 16-bit segment is not
allowed and is defined as reserved behavior. A specific processor
implementation may or may not generate a general-protection exception
(\#GP) in this situation, and the address that spans the end of the
segment may or may not wrap around to the beginning of the segment.

In 64-bit mode, use of the REX.R prefix permits this instruction to
access additional registers (XMM8-XMM15).

​1. If alignment checking is enabled (CR0.AM = 1, RFLAGS.AC = 1, and CPL
= 3), an alignment-check exception (\#AC) may or may not be generated
(depending on processor implementation) when the operand is not aligned
on an 8-byte boundary.

"
	^ self 
		addInstruction: #movups
		operands: { aRegisterOrMemory1 . aRegisterOrMemory2 }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
EAX
	"A 32bit general purpose register
	This register overlaps with AL, AX, EAX, RAX"
	^ EAX! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmovnge: aRegister with: aSourceRegisterOrMemory
	"
	"
	^ self 
		addInstruction: #cmovnge
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'converting' stamp: ''!
operand: anObject

	anObject isInteger ifTrue: [
		^ anObject asImm
		].
	
	anObject isString ifTrue: [
		^ anObject
		].
	
	^ anObject! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
amdprefetchw: aMemoryOperand
	"
	"
	^ self 
		addInstruction: #amdprefetchw
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmovz: aRegister with: aSourceRegisterOrMemory
	"Conditional Move - zero/equal (ZF=0)
	"
	^ self 
		addInstruction: #cmovz
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'register' stamp: ''!
counter
	^ self is32BitMode ifTrue: [ ECX ] ifFalse: [ CX ]! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
MM3
	"An MMX register"
	^ MM3! !

!AJx86Assembler methodsFor: 'testing' stamp: ''!
hasLabelNamed: aName

	^ labels includesKey: aName ! !

!AJx86Assembler methodsFor: 'debugging' stamp: ''!
gccDisassemble
	^ self gccDisassemble: self bytes.! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
movupd: aRegisterOrMemory1 with: aRegisterOrMemory2
	"Move Unaligned Packed Double-FP Value
	Pseudo Code
-----------
DEST = SRC;

Description
-----------
Moves a double quadword containing two packed double-precision
floating-point values from the source operand (second operand) to the
destination operand (first operand). This instruction can be used to
load an XMM register from a 128-bit memory location, store the contents
of an XMM register into a 128-bit memory location, or move data between
two XMM registers. When the source or destination operand is a memory
operand, the operand may be unaligned on a 16-byte boundary without
causing a general-protection exception (\#GP) to be generated.1

To move double-precision floating-point values to and from memory
locations that are known to be aligned on 16-byte boundaries, use the
MOVAPD instruction.

While executing in 16-bit addressing mode, a linear address for a
128-bit data access that overlaps the end of a 16-bit segment is not
allowed and is defined as reserved behavior. A specific processor
implementation may or may not generate a general-protection exception
(\#GP) in this situation, and the address that spans the end of the
segment may or may not wrap around to the beginning of the segment.

In 64-bit mode, use of the REX.R prefix permits this instruction to
access additional registers (XMM8-XMM15).

​1. If alignment checking is enabled (CR0.AM = 1, RFLAGS.AC = 1, and CPL
= 3), an alignment-check exception (\#AC) may or may not be generated
(depending on processor implementation) when the operand is not aligned
on an 8-byte boundary.

"
	^ self 
		addInstruction: #movupd
		operands: { aRegisterOrMemory1 . aRegisterOrMemory2 }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
movdqu: aRegisterOrMemory1 with: aRegisterOrMemory2
	"Move Unaligned Double Quadword
	Pseudo Code
-----------
DEST = SRC;
1. If alignment checking is enabled (CR0.AM = 1, RFLAGS.AC = 1, and CPL = 3), an alignment-check exception (#AC) may or may not be generated (depending on processor implementation) when the operand is not aligned on an 8-byte boundary.

Description
-----------
Moves a double quadword from the source operand (second operand) to the
destination operand (first operand). This instruction can be used to
load an XMM register from a 128-bit memory location, to store the
contents of an XMM register into a 128-bit memory location, or to move
data between two XMM registers. When the source or destination operand
is a memory operand, the operand may be unaligned on a 16-byte boundary
without causing a general-protection exception (\#GP) to be generated.1

To move a double quadword to or from memory locations that are known to
be aligned on 16-byte boundaries, use the MOVDQA instruction.

While executing in 16-bit addressing mode, a linear address for a
128-bit data access that overlaps the end of a 16-bit segment is not
allowed and is defined as reserved behavior. A specific processor
implementation may or may not generate a general-protection exception
(\#GP) in this situation, and the address that spans the end of the
segment may or may not wrap around to the beginning of the segment.

In 64-bit mode, use of the REX.R prefix permits this instruction to
access additional registers (XMM8-XMM15).

"
	^ self 
		addInstruction: #movdqu
		operands: { aRegisterOrMemory1 . aRegisterOrMemory2 }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
movhps: aRegisterOrMemory1 with: aRegisterOrMemory2
	"Move High Packed Single-FP Values
	Pseudo Code
-----------
(* MOVHPS instruction for memory to XMM move *)
DEST[127:64] = SRC;
(* DEST[63:0] unchanged *)
(* MOVHPS instruction for XMM to memory move *)
DEST = SRC[127:64];

Description
-----------
Moves two packed single-precision floating-point values from the source
operand (second operand) to the destination operand (first operand). The
source and destination operands can be an XMM register or a 64-bit
memory location. This instruction allows two single-precision
floating-point values to be moved to and from the high quadword of an
XMM register and memory. It cannot be used for register to register or
memory to memory moves. When the destination operand is an XMM register,
the low quadword of the register remains unchanged.

In 64-bit mode, use of the REX.R prefix permits this instruction to
access additional registers (XMM8-XMM15).

"
	^ self 
		addInstruction: #movhps
		operands: { aRegisterOrMemory1 . aRegisterOrMemory2 }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fistp: aMemoryOperand
	"Store Integer and Pop
	"
	^ self 
		addInstruction: #fistp
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'register' stamp: ''!
accumulator
	^ self is32BitMode ifTrue: [ EAX ] ifFalse: [ AX ]! !

!AJx86Assembler methodsFor: 'accessing' stamp: ''!
wordSize
	^ 4! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
jnge: targetLabel
	"
	"
	^ self 
		addInstruction: #jnge
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'accessing' stamp: ''!
pointerSize
	"the default pointer size in bytes on this CPU"
	^ 4! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
jae: targetLabel
	"
	"
	^ self 
		addInstruction: #jae
		operands: { targetLabel }! !

!AJx86Assembler methodsFor: 'instruction list' stamp: 'CamilloBruni 4/17/2012 17:51'!
addInstruction: sel description: description operands: operands

	^ self addInstruction: (self newInstruction: sel description: description operands: operands)! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
popcnt: aRegister with: aSourceRegisterOrMemory
	"Bit Population Count
	Description
-----------
This instruction calculates of number of bits set to 1 in the second
operand (source) and returns the count in the first operand (a
destination register).

"
	^ self 
		addInstruction: #popcnt
		operands: { aRegister . aSourceRegisterOrMemory }! !

!AJx86Assembler methodsFor: 'debugging' stamp: 'CamilloBruni 7/23/2012 15:25'!
gccDisassemble: bytes
	
	'disas.sh' asFileReference delete writeStreamDo: [:s|
		s 
			nextPutAll: '#!!/bin/bash'; lf;
			nextPutAll: 'gcc -g -O0 ';
			nextPutAll: (self is32 ifTrue: ['-m32'] ifFalse: [ '-m64' ]);
			nextPutAll: ' disas.test.c >> /dev/null 2>&1'; lf;
			nextPutAll: 'gdb -q -x gdb.commands  a.out | grep "^0x" > disas.output'; lf].

	'gdb.commands' asFileReference delete writeStreamDo: [:s|
		s 
			nextPutAll: 'b 4'; lf;
 			nextPutAll: 'r'; lf;
			nextPutAll: 'x /'; print: bytes size; nextPutAll: 'xb &instructions'; lf;
			nextPutAll: 'x /'; print: bytes size; nextPutAll: 'ub &instructions'; lf;
 			nextPutAll: 'disas &instructions &instructions+1'; lf;
 			nextPutAll: 'q'].

	'disas.test.c' asFileReference delete writeStreamDo: [ :f|
		{
			'#include <stdio.h>'.
			'void main() {'	.
			'const char instructions[]= {'.	
			String streamContents: [:s|
				bytes 	
					do: [:b | s print: b]
					separatedBy: [ s << ', ']].
			'};'.
			'printf("%d", instructions);'.
			'}'
		}
		do: [:x | f nextPutAll: x value asString; lf ]].
	
	Smalltalk 
		at: #OSProcess 
		ifPresent: [ :cls|
			cls waitForCommand: 'cd "', Smalltalk imagePath, '"; chmod a+x ./disas.sh; sh ./disas.sh'.
			^ 'disas.output' asFileReference readStream contents asString].
	
	self inform: 'OSProcess has to be installed to run gccDisassemble'.! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
shl: aDestinationRegisterOrMemory with: aRegisterOrImmediate
	"Shift
	"
	^ self 
		addInstruction: #shl
		operands: { aDestinationRegisterOrMemory . aRegisterOrImmediate }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
ST2
	"A floating point register"
	^ ST2! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
MM6
	"An MMX register"
	^ MM6! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fisttp: aMemoryOperand
	"Store Integer with Truncation and Pop
	Pseudo Code
-----------
DEST = ST;
pop ST;

Description
-----------
FISTTP converts the value in ST into a signed integer using truncation
(chop) as rounding mode, transfers the result to the destination, and
pop ST. FISTTP accepts word, short integer, and long integer
destinations.

The following table shows the results obtained when storing various
classes of numbers in integer format.

  ST(0)                                   DEST
  --------------------------------------- ------
  -∞ or Value Too Large for DEST Format   \*
  F ≤ - 1                                 - I
  - 1 \< F \< + 1                         0
  F ≥ + 1                                 + I
  +∞ or Value Too Large for DEST Format   \*
  NaN                                     \*

  : FISTTP Results

-   Notes
-   F means finite floating-point value.
-   I means integer.
-   Indicates floating-point invalid-operation (\#IA) exception.

This instruction's operation is the same in non-64-bit modes and 64-bit
mode.

"
	^ self 
		addInstruction: #fisttp
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
MM5
	"An MMX register"
	^ MM5! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
cmpxchg: aDestinationRegisterOrMemory with: aSourceRegister
	"Compare and Exchange
	Pseudo Code
-----------
(* Accumulator = AL, AX, EAX, or RAX depending on whether a byte, word, doubleword, or quadword comparison is being performed *)
IF accumulator = DEST
    ZF = 1;
    DEST = SRC;
ELSE
    ZF = 0;
    accumulator = DEST;
FI;

Description
-----------
Compares the value in the AL, AX, EAX, or RAX register with the first
operand (destination operand). If the two values are equal, the second
operand (source operand) is loaded into the destination operand.
Otherwise, the destination operand is loaded into the AL, AX, EAX or RAX
register. RAX register is available only in 64-bit mode.

This instruction can be used with a LOCK prefix to allow the instruction
to be executed atomically. To simplify the interface to the processor's
bus, the destination operand receives a write cycle without regard to
the result of the comparison. The destination operand is written back if
the comparison fails; otherwise, the source operand is written into the
destination. (The processor never produces a locked read without also
producing a locked write.)

In 64-bit mode, the instruction's default operation size is 32 bits. Use
of the REX.R prefix permits access to additional registers (R8-R15). Use
of the REX.W prefix promotes operation to 64 bits. See the summary chart
at the beginning of this section for encoding data and limits.

"
	^ self 
		addInstruction: #cmpxchg
		operands: { aDestinationRegisterOrMemory . aSourceRegister }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
fidiv: aMemoryOperand
	"Divide
	"
	^ self 
		addInstruction: #fidiv
		operands: { aMemoryOperand }! !

!AJx86Assembler methodsFor: 'instructions generated' stamp: 'CamilloBruni 7/17/2012 13:38'!
not: aDestination
	"One's Complement Negation
	Pseudo Code
-----------
DEST = NOT DEST;

Description
-----------
Performs a bitwise NOT operation (each 1 is set to 0, and each 0 is set
to 1) on the destination operand and stores the result in the
destination operand location. The destination operand can be a register
or a memory location.

This instruction can be used with a LOCK prefix to allow the instruction
to be executed atomically.

In 64-bit mode, the instruction's default operation size is 32 bits.
Using a REX prefix in the form of REX.R permits access to additional
registers (R8-R15). Using a REX prefix in the form of REX.W promotes
operation to 64 bits. See the summary chart at the beginning of this
section for encoding data and limits.

"
	^ self 
		addInstruction: #not
		operands: { aDestination }! !

!AJx86Assembler class methodsFor: 'instance creation' stamp: 'CamilloBruni 4/19/2012 11:46'!
noStackFrame
	^ self new noStackFrame! !

!AJx86Assembler class methodsFor: 'debugging' stamp: ''!
gccDisassemble: bytesArray
	"compile the given bytes to a C binary and disassemble it using gdb"
	^ self new gccDisassemble: bytesArray! !

!AJx86AssemblerTests commentStamp: 'TorstenBergmann 2/4/2014 21:39'!
SUnit tests for x86 assembler!
!AJx86AssemblerTests methodsFor: 'tests' stamp: 'CamilloBruni 4/3/2012 10:22'!
testAssemblyMemBaseDisp

	asm 
		mov: EAX ptr + 1 -> EAX;
		mov: EBX ptr + ECX -> EAX.
	
	self assert: asm bytes = #(16r8B 16r40 16r01 16r8B 16r04 16r0B) asByteArray! !

!AJx86AssemblerTests methodsFor: 'tests' stamp: 'CamilloBruni 4/3/2012 10:22'!
testBitTest

	asm 
		bt: EAX with: 0.

	self assert: asm bytes =  #(16r0F 16rBA 16rE0 16r00) asByteArray! !

!AJx86AssemblerTests methodsFor: 'utility' stamp: 'MartinMcClure 1/1/2013 22:19'!
bytes: aBlock
	asm := self newAssembler.
	aBlock value: asm.
	^ asm bytes! !

!AJx86AssemblerTests methodsFor: 'tests' stamp: 'HenrikSperreJohansen 2/26/2015 14:45'!
testStringOpMnemonics
	"Test that string operation mnemonics using both register and memory operands generate the same code as their noop versions"
	| mnemonicRegOpBytes mnemonicMemOpBytes |
	asm 
		reset;
		ins: asm AL;
		ins: asm AX;
		ins: asm EAX;
			
		outs: asm AL;
		outs: asm AX;
		outs: asm EAX;
		
		movs: asm AL;
		movs: asm AX;
		movs: asm EAX;
		
		cmps: asm AL;
		cmps: asm AX;
		cmps: asm EAX;
		
		stos: asm AL;
		stos: asm AX;
		stos: asm EAX;
		
		lods: asm AL;
		lods: asm AX;
		lods: asm EAX;
	
		scas: asm AL;
		scas: asm AX; 
		scas: asm EAX.
	mnemonicRegOpBytes := asm bytes.
	
	asm reset;
		ins: (AJMem new size: 1);
		ins: (AJMem new size: 2);
		ins: (AJMem new size: 4);
			
		outs: (AJMem new size: 1);
		outs: (AJMem new size: 2);
		outs: (AJMem new size: 4);
		
		movs: (AJMem new size: 1);
		movs: (AJMem new size: 2);
		movs: (AJMem new size: 4);
		
		cmps:(AJMem new size: 1);
		cmps: (AJMem new size: 2);
		cmps: (AJMem new size: 4);
		
		stos: (AJMem new size: 1);
		stos: (AJMem new size: 2);
		stos: (AJMem new size: 4);
		
		lods: (AJMem new size: 1);
		lods: (AJMem new size: 2);
		lods: (AJMem new size: 4);
	
		scas: (AJMem new size: 1);
		scas: (AJMem new size: 2);
		scas: (AJMem new size: 4).
	mnemonicMemOpBytes := asm bytes.
		
	asm reset;
		insb;
		insw;
		insd;
		outsb;
		outsw;
		outsd;
		movsb;
		movsw;
		movsd;
		cmpsb;
		cmpsw;
		cmpsd;
		stosb;
		stosw;
		stosd;
		lodsb;
		lodsw;
		lodsd;
		scasb;
		scasw;
		scasd.
self assert: mnemonicRegOpBytes equals: asm bytes.
self assert: mnemonicMemOpBytes equals: asm bytes.
asm reset

! !

!AJx86AssemblerTests methodsFor: 'tests-FPU' stamp: 'CamilloBruni 7/23/2012 15:03'!
testFXCH

	self 
		assert: [ :a|
		a fxch "the same as: asm fxch: asm ST1" ]
		bytes: #[	2r11011001 2r11001001 ]
	! !

!AJx86AssemblerTests methodsFor: 'utility' stamp: 'CamilloBruni 8/22/2012 14:47'!
assert: aBlock bytes: aByteArray

	self assert: (self bytes: aBlock) equals: aByteArray .! !

!AJx86AssemblerTests methodsFor: 'tests-data' stamp: 'CamilloBruni 4/12/2012 14:25'!
testDataBytesAlignWord
	
	|data|
	data := self setUpDataBytesAlign: 2.
	
	self assert: asm bytes equals: #[144   0 16r12].! !

!AJx86AssemblerTests methodsFor: 'tests' stamp: 'CamilloBruni 4/3/2012 10:22'!
testAssemblyMemBase
	
	asm 
		mov: EAX ptr  -> EAX;
		mov: ESP ptr -> EAX;
		mov: EBP ptr -> EAX.
	
	self assert: asm bytes = #(16r8B 0 16r8B 16r04 16r24 16r8B 16r45 16r00) asByteArray! !

!AJx86AssemblerTests methodsFor: 'tests' stamp: 'MartinMcClure 12/15/2012 13:39'!
testSyscall
	"Syscall instruction is only valid in 64-bit mode"

	self asmShould: [ :a | a syscall ] raise: Error! !

!AJx86AssemblerTests methodsFor: 'tests-data' stamp: ''!
setUpDataBytesAlign: alignToBytes

	asm nop.
	asm align: alignToBytes.
	^ asm db: 16r12.! !

!AJx86AssemblerTests methodsFor: 'tests-FPU' stamp: 'CamilloBruni 7/23/2012 15:15'!
testFXCHST1

	self 
		assert: [ :a| a fxch: asm ST1 ]
		bytes: #[	2r11011001 2r11001001 ]
	! !

!AJx86AssemblerTests methodsFor: 'tests' stamp: 'CamilloBruni 4/3/2012 10:23'!
testForwardJumps
	
	asm
		jmp: #label1;
		label: #label1.

	self assert: asm bytes =  #(16rEB 0 ) asByteArray.
		
! !

!AJx86AssemblerTests methodsFor: 'tests-data' stamp: ''!
testDataWord
	
	| data|
	asm nop.
	data := asm dw: #[16r34 16r12].
	
	self assert: asm bytes equals: #[144   16r34 16r12].
	
	! !

!AJx86AssemblerTests methodsFor: 'tests-data' stamp: 'CamilloBruni 4/12/2012 14:24'!
testDataBytesAlignDouble
	
	|data|
	data := self setUpDataBytesAlign: 4.
	
	self assert: asm bytes equals: #[144   0 0 0 16r12].! !

!AJx86AssemblerTests methodsFor: 'tests-data' stamp: 'CamilloBruni 4/12/2012 14:24'!
testDataBytesAlignQuad
	
	|data|
	data := self setUpDataBytesAlign: 8. 
	self assert: asm bytes equals: #[144   0 0 0   0 0 0 0   16r12].! !

!AJx86AssemblerTests methodsFor: 'tests' stamp: 'CamilloBruni 4/3/2012 10:22'!
testAssembly3

	" instructions without operands.

	(AJInstructionDescription instructions select: [:each | each group = #emit]) keys asSortedCollection
	 "
	| str |
	str :=
#(
#cbw 16r66 16r98
#cdq 16r99
"#cdqe  64 bit "
#clc 16rF8
#cld 16rFC
#cmc 16rF5 
#cpuid 16r0F 16rA2
"#cqo  64 bit "
#cwd 16r66 16r99
#cwde 16r98
#daa 16r27
#das 16r2F
#emms 16r0F 16r77
#f2xm1 16rD9 16rF0
#fabs  16rD9 16rE1
#fchs 16rD9 16rE0
#fclex 16r9B 16rDB 16rE2
#fcompp 16rDE 16rD9
#fcos 16rD9 16rFF
#fdecstp 16rD9 16rF6
#fincstp 16rD9 16rF7
#finit 16r9B 16rDB 16rE3
#fld1 16rD9 16rE8
#fldl2e 16rD9 16rEA
#fldl2t 16rD9 16rE9
#fldlg2 16rD9 16rEC
#fldln2 16rD9 16rED
#fldpi 16rD9 16rEB
#fldz 16rD9 16rEE
#fnclex 16rDB 16rE2
#fninit 16rDB 16rE3
#fnop 16rD9 16rD0
#fpatan 16rD9 16rF3
#fprem 16rD9 16rF8
#fprem1 16rD9 16rF5
#fptan 16rD9 16rF2
#frndint 16rD9 16rFC
#fscale 16rD9 16rFD
#fsin 16rD9 16rFE
#fsincos 16rD9 16rFB
#fsqrt 16rD9 16rFA
#ftst 16rD9 16rE4
#fucompp 16rDA 16rE9
#fwait 16r9B
#fxam 16rD9 16rE5
#fxtract  16rD9 16rF4
#fyl2x  16rD9 16rF1
#fyl2xp1 16rD9 16rF9
#int3 16rCC
#leave  16rC9
#lfence 16r0F 16rAE 16rE8
#lock 16rF0 "prefix"
#mfence 16r0F 16rAE 16rF0
#monitor 16r0F 16r01 16rC8
#mwait 16r0F 16r01 16rC9
#nop 16r90
#pause 16rF3 16r90
#popad 16r61
#popfd 16r9D
" #popfq 16r48 16r9D   - 64 bit "
#pushad 16r60
#pushf 16r66 16r9C
#pushfd 16r9C
" #pushfq -64 bit"
#rdtsc 16r0F 16r31  
#rdtscp 16r0F 16r01 16rF9
#sahf 16r9E
#sfence 16r0F 16rAE 16rF8
#stc 16rF9
#std 16rFD
#ud2 16r0F 16r0B
#std 16rFD "dummy"
) readStream.

[ str atEnd ] whileFalse: [
	| instr tst |
	instr := str next.
	tst := OrderedCollection new.
	[ str peek isInteger ] whileTrue: [ tst add: str next  ].

	asm reset noStackFrame.
	asm perform: instr.
	self assert: (asm bytes = tst asByteArray )
].
! !

!AJx86AssemblerTests methodsFor: 'tests' stamp: 'CamilloBruni 4/3/2012 10:23'!
testMovSxZx

	asm 
		movsx: asm AX to: asm EAX;
		movzx: asm AX to: asm EAX;
		movsx: asm AL to: asm EAX;
		movzx: asm AH to: asm EAX.

	self assert: asm bytes = 
	#[
		16r0F 16rBF 16rC0
		16r0F 16rB7 16rC0
		16r0F 16rBE 16rC0
		16r0F 16rB6 16rC4 ]

! !

!AJx86AssemblerTests methodsFor: 'tests' stamp: 'CamilloBruni 4/3/2012 10:22'!
testAssembly1
	
	asm 
		push: EBP;
		mov: ESP -> EBP;
		mov: 1024 -> EAX;
		mov: EBP -> ESP;
		pop: EBP;
		ret.
	
	self assert: asm bytes = #(85 139 236 184 0 4 0 0 139 229 93 195) asByteArray! !

!AJx86AssemblerTests methodsFor: 'tests' stamp: 'CamilloBruni 8/22/2012 14:50'!
testJMPRegister
	
	self 
		assert: [  :assembler |
			assembler jmp: assembler EAX ]
		bytes: #[ 16rFF 2r11100000 ].
		
	self 
		assert: [  :assembler |
			assembler jmp: assembler ECX ]
		bytes: #[ 16rFF 2r11100001 ].
		
	self 
		assert: [  :assembler |
			assembler jmp: assembler EDX ]
		bytes: #[ 16rFF 2r11100010 ]! !

!AJx86AssemblerTests methodsFor: 'tests' stamp: 'IgorStasenko 5/28/2012 02:58'!
testAssemblyImmAddr
	"test generating immediate address, 
	note GDB disassembling it to:
		0x1fab <instructions.1862>:     0x8b    0x05    0xef    0xbe    0xad    0xde
		0x00001fab <instructions.1862+0>:       mov    0xdeadbeef,%eax
	which is WRONG!!
	"

	asm
		mov: 16rdeadbeef asUImm ptr32 to: asm EAX. 

	" 8b05efbeadde                   mov         eax, [deadbeef] "
	
	self assert: asm bytes =  #[139 5 239 190 173 222]
	! !

!AJx86AssemblerTests methodsFor: 'running' stamp: ''!
setUp
	super setUp.
	asm := self newAssembler.! !

!AJx86AssemblerTests methodsFor: 'tests-data' stamp: 'CamilloBruni 4/19/2012 11:51'!
testDataDouble
	
	| data|
	
	asm nop.
	data := asm dd: #[16r78 16r56 16r34 16r12].
	
	self assert: asm bytes equals: #[144   16r78 16r56 16r34 16r12].! !

!AJx86AssemblerTests methodsFor: 'tests-data' stamp: 'CamilloBruni 4/12/2012 14:25'!
setUpDataBytes
	^ self setUpDataBytesAlign: 1! !

!AJx86AssemblerTests methodsFor: 'tests' stamp: 'CamilloBruni 4/3/2012 10:22'!
testAssemblyMemBytes

	asm 
		mov: ((ESI ptr + ECX) size: 1) -> BL;
		mov: BL -> ((ESI ptr + ECX) size:1).
		
	self assert: asm bytes = #(16r8A 16r1C 16r0E 16r88 16r1C 16r0E ) asByteArray! !

!AJx86AssemblerTests methodsFor: 'tests' stamp: 'CamilloBruni 4/3/2012 10:22'!
testCall

	asm 
		call: EAX;
		call: EAX ptr - 4;
		call: EAX ptr.
	self assert: asm bytes =  #(255 208 255 80 252 255 16) asByteArray! !

!AJx86AssemblerTests methodsFor: 'tests-data' stamp: ''!
testDataBytes
	
	|data|
	data := self setUpDataBytes.
	
	self assert: asm bytes equals: #[144   16r12].! !

!AJx86AssemblerTests methodsFor: 'utility' stamp: ''!
asmShould: aBlock raise: anError

	self should: [self bytes: aBlock] raise: anError.! !

!AJx86AssemblerTests methodsFor: 'utility' stamp: 'CamilloBruni 4/3/2012 09:56'!
newAssembler 
	^ AJx86Assembler new
		noStackFrame;
		yourself! !

!AJx86AssemblerTests methodsFor: 'tests' stamp: 'CamilloBruni 4/3/2012 10:23'!
testJumps
	
	asm 
		label: #label1;
		nop;
		nop;
		nop;
		jz: #label1.
		
	self assert: asm bytes =  #(144 144 144 116 251) asByteArray.

	
	asm 
		reset; noStackFrame;
		label: #label1.
		126 timesRepeat: [ asm nop ].
		asm jz: #label1.
	self assert: (asm bytes size = 128).
	
	asm 
		reset; noStackFrame;
		label: #label1;
		nop;
		nop;
		nop;
		jmp: #label1.
		
	self assert: asm bytes =  #(144 144 144 235 251) asByteArray.
	
	asm
		reset; noStackFrame;
		jmp: #label1;
		label: #label1.
		
	self assert: asm bytes =  #(16rEB 0 ) asByteArray.
		
! !

!AJx86AssemblerTests methodsFor: 'tests' stamp: 'CamilloBruni 4/3/2012 10:22'!
testAssemblyMemBaseDisp2

	asm 
		mov: EAX ptr - 1 -> EAX;
		mov: EBX ptr + ECX * 2 - 5 -> EAX.
	
	self assert: asm bytes = #(16r8B 16r40 16rFF 16r8B 16r44 16r4B 16rFB) asByteArray! !

!AJx86AssemblerTests methodsFor: 'tests' stamp: 'CamilloBruni 4/3/2012 10:23'!
testTest
	"Special RAX opcodes"
	
	"8bit operand  opcode"		
	asm 
		test: AL with: 5.
	self assert: asm bytes = #[16rA8 05].

	
	asm reset;
		test: AX with: 5.
	"16bit operand Prefix byte, 16bit immediate (LSB)"
	self assert: asm bytes = #[16r66 16rA9 05 0].

	"32bit operand "
	asm reset;
		test: EAX with: 1.
	self assert: asm bytes =  #[16rA9 01 00 00 00].
	
	"Need more assert for non-EAX receiver, non-immediate operands"
	
	
	! !

!AJx86AssemblerTests methodsFor: 'tests' stamp: 'CamilloBruni 4/3/2012 10:23'!
testImmLabels

	"test immediates with labels"
	
	| code pos |
	
	asm 
		mov: EAX ptr  -> EAX;
		mov: (16rFFFFFFFF asUImm label: (asm labelNamed: #foo) ) to:  EAX.
	
	code := asm generatedCode.
	pos := code offsetAt: #foo.

	self assert: (code bytes at: pos+1) = 255.
	self assert: (code bytes at: pos+2) = 255.
	self assert: (code bytes at: pos+3) = 255.
	self assert: (code bytes at: pos+4) = 255.

! !

!AJx86AssemblerTests methodsFor: 'tests-FPU' stamp: 'HenrikSperreJohansen 6/26/2014 15:10'!
testMOVCMPSD
	"MOVSD/CMPSD is aliased to no-op string operations, make sure we generate correct code when the intention is to use SSE2 instruction"

	| instructions |
	instructions := asm
		instructionsFor: [ 
			[ 
			asm
				movsd: XMM1 with: XMM2;
				cmpsd:XMM1 with: XMM2;
				bytes ]
				on: ShouldBeImplemented
				do: [:e | "Dispatch to correct op happens during emission, don't let an operation whose group is unimplemented yet stop us from checking the operation is at least converted correctly."
					"We do want to run the next ops as well though, so resume this even though it can't"
					e resumeUnchecked: nil] ].
	instructions
		do: [ :instruction | 
			self
				assert:
					(AJx86InstructionDescription instructionsAmbiguous
						contains: [ :one | one first = instruction name and: [ one second = instruction description group ] ]) ]! !

!AJx86GPRegister commentStamp: 'sig 12/7/2009 03:22'!
A general purpose x86 & x64 registers!
!AJx86GPRegister methodsFor: 'converting' stamp: 'MartinMcClure 1/30/2013 21:44'!
as64
	^ self isHighByte
		ifTrue: [ self asLowByte as64 ]
		ifFalse: [ 
			AJx86Registers
				generalPurposeWithIndex: self index
				size: 8
				requiresRex: self index > 7
				prohibitsRex: false ]! !

!AJx86GPRegister methodsFor: 'converting' stamp: 'MartinMcClure 1/30/2013 21:43'!
as32
	^ self isHighByte
		ifTrue: [ self asLowByte as32 ]
		ifFalse: [ 
			AJx86Registers
				generalPurposeWithIndex: self index
				size: 4
				requiresRex: self index > 7
				prohibitsRex: false ]! !

!AJx86GPRegister methodsFor: 'testing' stamp: 'MartinMcClure 1/30/2013 21:55'!
isLowByte
	"return true for 8bit low-byte register (AL - DL)"

	"Note that this does *not* answer true for all byte registers -- send #is8 for that."

	^ self code <= 3! !

!AJx86GPRegister methodsFor: 'printing' stamp: 'MartinMcClure 1/1/2013 18:55'!
printAsMemBaseOn: aStream

	aStream nextPutAll: self registerName ! !

!AJx86GPRegister methodsFor: 'converting' stamp: ''!
ptr

	"turn receiver into a memory operand with receiver as base"
	
	^ AJMem new base: self! !

!AJx86GPRegister methodsFor: 'accessing' stamp: 'CamilloBruni 3/20/2012 18:48'!
registerName 
	^ name asString.! !

!AJx86GPRegister methodsFor: 'converting' stamp: 'MartinMcClure 1/30/2013 21:46'!
asLowByte
	self isLowByte
		ifTrue: [ ^ self ].
	self isHighByte
		ifFalse: [ Error signal: 'Can only convert high byte 8bit register to low byte' ].
	^ AJx86Registers
		generalPurposeWithIndex: self index - 2r100
		size: 1
		requiresRex: false
		prohibitsRex: false! !

!AJx86GPRegister methodsFor: 'emitting' stamp: ''!
emitModRM: emitter code: rCode immSize: immSize

	"Receiver is register, hence mod = 3 
	immSize is ignored"

	^ emitter emitMod: 3 reg: rCode rm: self code! !

!AJx86GPRegister methodsFor: 'accessing' stamp: ''!
stackSize
	^ self size! !

!AJx86GPRegister methodsFor: 'testing' stamp: 'MartinMcClure 1/30/2013 21:33'!
isHighByte
	"return true for 8bit high-byte registers (AH - DH)"

	^ self prohibitsRex! !

!AJx86GPRegister methodsFor: 'converting' stamp: 'MartinMcClure 1/30/2013 21:40'!
as8
	"8-bit low-byte registers require REX if they have a high index (>7), or if they are one of BPL, SIL, DIL, SPL (indices 4-7).
	The only way to get AH, BH, CH, or DH out of this method is to send it to one of those registers."

	^ self is8
		ifTrue: [ self ]
		ifFalse: [ 
			AJx86Registers
				generalPurposeWithIndex: self index
				size: 1
				requiresRex: self index > 3
				prohibitsRex: false ]! !

!AJx86GPRegister methodsFor: 'accessing' stamp: 'CamilloBruni 7/17/2012 11:07'!
descriptionOn: s
	s nextPutAll: 'A '; print: self size * 8; nextPutAll: 'bit general purpose register'.! !

!AJx86GPRegister methodsFor: 'printing' stamp: ''!
printOn: aStream
	
	aStream nextPutAll: self registerName ! !

!AJx86GPRegister methodsFor: 'testing' stamp: ''!
isGeneralPurpose
	^ true! !

!AJx86GPRegister methodsFor: 'converting' stamp: 'MartinMcClure 1/30/2013 21:42'!
as16
	^ self isHighByte
		ifTrue: [ self asLowByte as16 ]
		ifFalse: [ 
			AJx86Registers
				generalPurposeWithIndex: self index
				size: 2
				requiresRex: self index > 7
				prohibitsRex: false ]! !

!AJx86GPRegister methodsFor: 'converting' stamp: 'MartinMcClure 1/30/2013 21:53'!
asHighByte
	self isHighByte
		ifTrue: [ ^ self ].
	self isLowByte
		ifFalse: [ Error signal: 'Can only convert AH, BH, CH, or DH to high byte' ].
	^ AJx86Registers
		generalPurposeWithIndex: self index + 2r100
		size: 1
		requiresRex: false
		prohibitsRex: true! !

!AJx86Instruction commentStamp: 'TorstenBergmann 1/30/2014 09:17'!
The x86 machine instructions!
!AJx86Instruction methodsFor: 'code generation' stamp: ''!
emitQWord: dword

 	"Emit a qword (8 bytes) in little-endian order (since our target it x86 anyways)"
	
	self 
		emitByte: (dword bitAnd: 255);
		emitByte: (dword>>8 bitAnd: 255);
		
		emitByte: (dword>>16 bitAnd: 255);
		emitByte: (dword>>24 bitAnd: 255);
		
		emitByte: (dword>>32 bitAnd: 255);
		emitByte: (dword>>40 bitAnd: 255);
		
		emitByte: (dword>>48 bitAnd: 255);
		emitByte: (dword>>56 bitAnd: 255)
		
! !

!AJx86Instruction methodsFor: 'accessing' stamp: 'CamilloBruni 4/17/2012 17:55'!
description
	^ description! !

!AJx86Instruction methodsFor: 'code generation - prefixes' stamp: ''!
emitRexR: w opReg: opReg regCode: regCode
	"no-op in 32 bit mode"
	
! !

!AJx86Instruction methodsFor: 'code generation' stamp: ''!
setLabelPosition: label
	"set label position for immediate operand(s), if any"
	label position: self position + machineCode size.  ! !

!AJx86Instruction methodsFor: 'code generation - prefixes' stamp: 'MartinMcClure 1/4/2013 22:14'!
emitRexForOp1: op1 op2: op2
	"op1 is the general-purpose register argument (or a register number).
	op2 is the reg/mem argument.
	
	In 64-bit mode, the instruction's default operation size is 32 bits. 
	Use of the REX.W prefix promotes operation to 64 bits. 
	Use of the REX.R prefix permits access to additional registers (R8-R15) for the op1 (reg) register. 
	Use of the REX.B prefix permits access to additional registers (R8-R15) for the op2 (r/m) register, or the base register of op2 if register indirect. 
	Use of the REX.X prefix permits access to additional registers (R8-R15) for the index register of op2, if indexed.
	See the summary chart at the beginning of this section for encoding data and limits."

	| requires64Bit |
	"no-op in 32 bit mode"
	self is32BitMode
		ifTrue: [ ^ self ].
	op1 isInteger
		ifTrue: [ ^ self emitRexForInteger: op1 op2: op2 ].
	requires64Bit := op1 is64 or: [ op2 isReg and: [ op2 is64 ] ].
	self
		emitRexPrefixW: requires64Bit
		R: op1 isUpperBank
		X: op2 hasUpperBankIndex
		B: op2 isUpperBank! !

!AJx86Instruction methodsFor: 'code generation' stamp: ''!
emitOpCode: opCode
	| byte |
	"instruction prefix"
	(byte := (opCode bitAnd: 16rFF000000)) = 0 ifFalse: [
		self emitByte: byte >> 24 ].
	(byte := (opCode bitAnd: 16r00FF0000)) = 0 ifFalse: [
		self emitByte: byte >> 16 ].
	(byte := (opCode bitAnd: 16r0000FF00)) = 0 ifFalse: [
		self emitByte: byte >> 8 ].
	self emitByte: (opCode bitAnd: 16rFF).
	! !

!AJx86Instruction methodsFor: 'emitting code' stamp: ''!
emitWord: aWord 

	"little-endian"
	
	self 
		emitByte: (aWord bitAnd: 255);
		emitByte: ((aWord >> 8) bitAnd: 255)
	! !

!AJx86Instruction methodsFor: 'testing' stamp: ''!
is64BitMode
	^ false! !

!AJx86Instruction methodsFor: 'visitor' stamp: ''!
accept: anObject
	"generic instruction"
	^ anObject visitInstruction: self
	! !

!AJx86Instruction methodsFor: 'accessing' stamp: 'CamilloBruni 4/17/2012 17:55'!
description: anInstructionDescription
	description := anInstructionDescription! !

!AJx86Instruction methodsFor: 'code generation - prefixes' stamp: ''!
emitRexForInteger: anInt op2: op2
	
	self emitRexPrefixW: op2 is64 R: false X: false  B:  op2 isUpperBank.! !

!AJx86Instruction methodsFor: 'testing' stamp: ''!
is32BitMode

	^ true! !

!AJx86Instruction methodsFor: 'code generation' stamp: 'CamilloBruni 3/30/2012 17:10'!
emitX86Inl: opCode reg: reg
	"Emit instruction where register is inlined to opcode."

	^ self emitX86Inl: opCode reg: reg withRex: true! !

!AJx86Instruction methodsFor: 'testing' stamp: 'MartinMcClure 1/27/2013 15:47'!
requiresRex
	^false! !

!AJx86Instruction methodsFor: 'code generation - prefixes' stamp: 'CamilloBruni 4/4/2012 17:10'!
emitRexRM: opRequires64Bit regCode: regCode rm: rm
	
	self emitRexPrefixW: opRequires64Bit R: (regCode > 7) X: false B: rm isUpperBank
	
! !

!AJx86Instruction methodsFor: 'consistency' stamp: 'MartinMcClure 2/9/2013 14:15'!
checkOperandsForConflict
	"Signal an error if the given operands cannot be used together. Must be sent after operands are set."

	| prohibited required |
	required := self requiresRex.
	prohibited := false.
	operands
		do: [ :op | 
			(op isInteger not and: [ op prohibitsRex ])
				ifTrue: [ prohibited := true ] ].
	prohibited & required
		ifTrue: [ self error: 'Mix of operands that require and prohibit a REX prefix' ]! !

!AJx86Instruction methodsFor: 'code generation' stamp: 'CamilloBruni 3/28/2012 15:59'!
emitMod: mod reg: reg rm: rm
	"Emit MODR/M byte.
	mmrrrxxx
	
	mm = mod
	rrr = REG (r8/r16/r32/mm/xmm
	xxx = r/m
	"
	
	^ self emitByte: (mod & 3) << 3 + (reg & 7) << 3 + (rm & 7)
	! !

!AJx86Instruction methodsFor: 'accessing' stamp: 'CamilloBruni 8/23/2012 16:01'!
instructionDesciptions
	^ AJx86InstructionDescription instructions! !

!AJx86Instruction methodsFor: 'code generation - prefixes' stamp: 'HenrikSperreJohansen 6/25/2014 22:42'!
emitOperandSizeOverridePrefix: anOperand
	"If creating 64bit code, this must be called last of the prefix-generators, as the 64-bit prefixes are required to precede the opcode"

	"Switch to 16-bit operand mode for the next opcode if necessary"
	anOperand is16 ifTrue: [ self emitByte: self operandSizeOverridePrefix].
	self emitRexRM: anOperand is64 regCode: 0 rm: anOperand
	
	
! !

!AJx86Instruction methodsFor: 'code generation - prefixes' stamp: ''!
emitRexForSingleOperand: op
	"In 64-bit mode, the instruction’s default operation size is 32 bits. 
	Use of the REX.W prefix promotes operation to 64 bits. 
	Use of the REX.B prefix permits access to additional registers (R8-R15). 
	See the summary chart at the beginning of this section for encoding data and limits."
	 
	self emitRexPrefixW: op is64 R: false X: false B: op isUpperBank .! !

!AJx86Instruction methodsFor: 'code generation' stamp: 'CamilloBruni 4/17/2012 17:56'!
emitCode: asm
	"do not generate machine code if it is already there"
	machineCode ifNotNil: [ ^ self ].
	
	"make sure all operands are converted"
	operands ifNotNil: [ operands := operands collect: #asAJOperand ].
	
	machineCode := WriteStream on: (ByteArray new: 16).		
	description emitUsing: self operands: operands.

	machineCode := machineCode contents.! !

!AJx86Instruction methodsFor: 'code generation' stamp: ''!
emitDWord: dword

 	"Emit dword (4 bytes) in little-endian order (since our target it x86 anyways)"
	
	self 
		emitByte: (dword bitAnd: 255);
		emitByte: (dword>>8 bitAnd: 255);
		
		emitByte: (dword>>16 bitAnd: 255);
		emitByte: (dword>>24 bitAnd: 255)
		
! !

!AJx86Instruction methodsFor: 'code generation' stamp: ''!
emitImmediate: imm size: size

	^ imm emitUsing: self size: size! !

!AJx86Instruction methodsFor: 'prefixes' stamp: 'HenrikSperreJohansen 6/25/2014 22:33'!
operandSizeOverridePrefix
	^16r66! !

!AJx86Instruction methodsFor: 'code generation' stamp: ''!
emitSegmentPrefix: aMem

	(aMem isMem and: [ aMem hasSegmentPrefix ]) ifTrue: [
		self emitByte: aMem segmentPrefixCode.
	]
! !

!AJx86Instruction methodsFor: 'code generation' stamp: 'CamilloBruni 3/30/2012 16:50'!
emitX86RM: opCode size: aSize regOrCode: regOrCode rm: regOrMem immSize: immSize
	"Emit instruction with reg/memory operand."
	
	| byte code |
	code := regOrCode isInteger ifTrue: [ regOrCode ] ifFalse: [ regOrCode code ].

	"16 bit prefix"
	aSize == 2 ifTrue: [ self emitByte: 16r66 ].
	
	"segment prefix"
	self emitSegmentPrefix: regOrMem.
	"instruction prefix"
	(byte := (opCode bitAnd: 16rFF000000)) = 0 ifFalse: [
		self emitByte: byte >> 24 ].
	
	self emitRexForOp1: regOrCode op2: regOrMem.
	
	(byte := (opCode bitAnd: 16r00FF0000)) = 0 ifFalse: [
		self emitByte: byte >> 16 ].

	(byte := (opCode bitAnd: 16r0000FF00)) = 0 ifFalse: [
		self emitByte: byte >> 8 ].

	self emitByte: (opCode bitAnd: 16rFF).

	"ModR/M"
	^ regOrMem emitModRM: self code: code immSize: immSize
! !

!AJx86Instruction methodsFor: 'code generation - prefixes' stamp: 'MartinMcClure 1/27/2013 16:24'!
emitRexPrefixW: w R: r X: x B: b
	"
	field  bit   def
	-      7-4   2r0100 REX prefix identifier
	W      3     0 = Operand size determined by CS.D
	             1 = 64 Bit Operand Size
	R      2     Extension of the ModR/M reg field
	X      1     Extension of the SIB index field
	B      0     Extension of the ModR/M r/m field. SIB base field, or Opcode reg field
	"

	self requiresRex
		ifTrue: [ 
			self is32BitMode
				ifTrue: [ self error: 'Attempt to use a 64-bit-specific instruction or operand in 32-bit mode' ]
				ifFalse: [ self emitByte: 2r0100 << 4 | (w asBit << 3) | (r asBit << 2) | (x asBit << 1) | b asBit ] ]! !

!AJx86Instruction methodsFor: 'code generation' stamp: 'CamilloBruni 3/29/2012 13:54'!
emitByte: byte

	self assert: byte isByte.
	machineCode nextPut: byte 
! !

!AJx86Instruction methodsFor: 'code generation' stamp: ''!
emitX86Inl: opCode reg: reg withRex: useREX
	"Emit instruction where register is inlined to opcode."

	| byte |
	"16 bit prefix"
	reg size == 2 
		ifTrue: [ self emitByte: 16r66 ].
	
	"instruction prefix"
	(byte := (opCode bitAnd: 16rFF000000)) = 0 ifFalse: [
		self emitByte: byte >> 24 ].
	
	useREX ifTrue: [ self emitRexForSingleOperand: reg ].
	
	(byte := (opCode bitAnd: 16r00FF0000)) = 0 ifFalse: [
		self emitByte: byte >> 16 ].

	(byte := (opCode bitAnd: 16r0000FF00)) = 0 ifFalse: [
		self emitByte: byte >> 8 ].

	self emitByte: (opCode bitAnd: 16rFF) + (reg code bitAnd: 7).
! !

!AJx86Instruction methodsFor: 'code generation' stamp: ''!
emitX86RM: opCode size: aSize regOrCode: regOrCode rm: regOrMem 
"Emit instruction with reg/memory operand."
	
	^ self emitX86RM: opCode size: aSize regOrCode: regOrCode rm: regOrMem immSize: 0
! !

!AJx86Instruction methodsFor: 'code generation' stamp: 'MartinMcClure 1/4/2013 22:27'!
emitScale: shift index: indexCode base: baseCode
	self emitByte: ((shift << 3) + (indexCode bitAnd: 7) << 3) + (baseCode bitAnd: 7)! !

!AJx86Instruction methodsFor: 'testing' stamp: ''!
isGPNRegister: reg

	"answer true if given register is native general purpose register,
	matching the target native size i.e. 32 bits for x86 or 64 bits for x64"
	^ reg isGeneralPurpose and: [ reg size = 4 ]! !

!AJx86InstructionDescription commentStamp: 'sig 12/7/2009 10:36'!
name:		an instruction mnemonic
	group:		an instruction encoding group

	o1Flags:		operand1 flags
	o2Flags:		operand2 flags
	opCode1:		opcode 1
	opCode2:		opcode 2
	opCodeR:		code for inlining in MR field as register

Operand flags:

bit:	 9   |  8   |  7    |   6  |  5    |   4    |  3  |  2   |  1  | 0 |
______________________________________________
      *86| *64 | XMM | MM | IMM | MEM | 64 | 32 | 16 | 8|
	
- *64 , set on o1Flags, meaning that instruction available only for x64 processor mode
- *86 , set on o1Flags, meaning that instruction available only for x86 processor mode

!
!AJx86InstructionDescription methodsFor: 'emitting-dispatch' stamp: 'CamilloBruni 3/30/2012 17:05'!
emitUsing: emitter operands: operands
	|args|
	
	(self is64BitOnly and: [ emitter is64BitMode not ]) ifTrue: [ 
		self error: 'instruction ', self name asUppercase,' is only for 64 bit mode' ].

	(self is32BitOnly and: [ emitter is32BitMode not ]) ifTrue: [ 
		self error: 'instruction ', self name asUppercase,' is only for 32 bit mode' ].
	
	"manually create the arguments array"
	args := Array new: 4.
	args at: 1 put: emitter.
	args replaceFrom: 2
		to: (operands size + 1 min: 4)
		with: operands
		startingAt: 1.
		
	^ self 
		perform: groupEmitSelector 
		withArguments: args! !

!AJx86InstructionDescription methodsFor: 'accessing' stamp: 'CamilloBruni 4/13/2012 15:44'!
comment: aString
	comment := aString! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: ''!
emitrot: emitter operand1: op1 operand2: op2 operand3: op3
	| useImm8 opCode |
	op1 isRegMem & ((op2 isRegTypeGPB and: [ op2 index =  1 "cl" ]) | op2 isImm) ifFalse: [ self invalidInstruction ].
	
	useImm8 := op2 isImm and: [ (op2 value ~= 1) | (op2 relocMode ~~ #RelocNone) ].
	opCode := useImm8 ifTrue: [ 16rC0 ] ifFalse: [ 16rD0 ].

	op1 size ~= 1 ifTrue: [ opCode := opCode bitOr: 1 ].
	op2 isReg ifTrue: [ opCode := opCode bitOr: 2 ].
	
	emitter emitX86RM: opCode
		size: op1 size
		regOrCode: opCodeR
		rm: 	op1
		immSize: useImm8 asBit.
	
	useImm8 ifTrue: [
		emitter emitImmediate: op2 size: 1
		]
! !

!AJx86InstructionDescription methodsFor: 'accessing' stamp: 'CamilloBruni 4/13/2012 14:51'!
description
	^ description! !

!AJx86InstructionDescription methodsFor: 'emitting - mmu' stamp: ''!
emitmmuMov: emitter operand1: op1 operand2: op2 operand3: op3
	
	self shouldBeImplemented.
	
	self assert: o1Flags ~= 0.
	self assert: o2Flags ~= 0.
	
      "Check parameters (X)MM|GP32_64 <- (X)MM|GP32_64|Mem|Imm"
	(op1 isMem & ((o1Flags bitAnd: OMEM) = 0)) |
	(op1 isRegTypeMM & ((o1Flags bitAnd: OMM) = 0)) |
	(op1 isRegTypeXMM & ((o1Flags bitAnd: OXMM) = 0)) |
	(op1 isRegTypeGPD & ((o1Flags bitAnd: OG32) = 0)) |
	(op1 isRegTypeGPQ & ((o1Flags bitAnd: OG64) = 0)) |
	(op2 isRegTypeMM & ((o2Flags bitAnd: OMM) = 0)) |
	(op2 isRegTypeXMM & ((o2Flags bitAnd: OXMM) = 0)) |
	(op2 isRegTypeGPD & ((o2Flags bitAnd: OG32) = 0)) |
	(op2 isRegTypeGPQ & ((o2Flags bitAnd: OG64) = 0)) |
	(op2 isMem & ((o2Flags bitAnd: OMEM) = 0)) |
	(op1 isMem & op2 isMem)
		ifTrue: [ self invalidInstruction ].
	
		
! !

!AJx86InstructionDescription methodsFor: 'emitting - mmu' stamp: ''!
emitmmuPextr: emitter operand1: op1 operand2: op2 operand3: op3
	self shouldBeImplemented! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: ''!
emitmovbe: anAJx86Assembler operand1: anUndefinedObject operand2: anUndefinedObject3 operand3: anUndefinedObject4 
	self shouldBeImplemented! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: ''!
emitmovSxZx: emitter operand1: dst operand2: src operand3: op3

	dst isReg & src isRegMem ifFalse: [ self invalidInstruction ].
	
	dst isRegTypeGPB ifTrue: [ self invalidInstruction ].
	
	(src size ~= 2 and: [src size ~= 1 ]) ifTrue: [ self invalidInstruction ].
	(src size = 2 and: [dst isRegTypeGPW ]) ifTrue: [ self invalidInstruction ].
	
	src size = 2 ifTrue: [
		^ emitter emitX86RM: opCode1 + 1 size: dst size regOrCode: dst rm: src
		].
	
	emitter emitX86RM: opCode1 size: dst size regOrCode: dst rm: src
! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: ''!
emitshldShrd: emitter operand1: dst operand2: src1 operand3: src2

	(src2 isImm or: [ src2 isRegTypeGPB and: [ src2 index = 1 "cl"]]) ifFalse: [ self invalidInstruction ].
	
	dst isRegMem & src1 isReg ifFalse: [ self invalidInstruction ].
	self assert: (dst size = src1 size).
	
	emitter emitX86RM: opCode1 + src2 isReg asBit
		size: src1 size
		regOrCode: src1 rm: dst immSize: src2 isImm asBit.
		
	src2 isImm ifTrue: [
		emitter emitImmediate: src2 size: 1
		]! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: ''!
emitx87mem: emitter operand1: m operand2: op2 operand3: op3
	| opCode mod |
      m isMem ifFalse: [ ^ self invalidInstruction ].

	opCode := mod := 0.

	(m is16 and: [ (o1Flags bitAnd: OFM2) ~= 0 ]) ifTrue: [
		opCode := (opCode1 bitAnd: 16rFF000000) >> 24.
		mod := opCodeR ].

	(m is32 and: [ (o1Flags bitAnd: OFM4) ~= 0 ]) ifTrue: [
		opCode := (opCode1 bitAnd: 16r00FF0000) >> 16.
		mod := opCodeR ].
	
	(m is64 and: [ (o1Flags bitAnd: OFM8) ~= 0 ]) ifTrue: [
		opCode := (opCode1 bitAnd: 16r0000FF00) >> 8.
		mod :=  (opCode1 bitAnd: 16r000000FF) ].

	opCode = 0 ifTrue: [ self invalidInstruction ].

	emitter emitSegmentPrefix: m;
		emitByte: opCode.
	m emitModRM: emitter code: mod immSize: 0.
! !

!AJx86InstructionDescription methodsFor: 'testing' stamp: ''!
is32BitOnly
	^ (o1Flags bitAnd: 2r1000000000) ~= 0! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: ''!
emitmovPtr: emitter operand1: op1 operand2: op2 operand3: op3

	| reg imm opCode |
	(op1 isReg & op2 isImm) | (op1 isImm & op2 isReg) ifFalse: [
		self invalidInstruction ].
	
	opCode := op1 isReg 
		ifTrue: [reg := op1. imm := op2. 16rA0] 
		ifFalse: [reg := op2. imm := op1. 16rA2].
	
	reg index ~= 0 ifTrue: [ self invalidInstruction ].

	reg isRegTypeGPW ifTrue: [ emitter emitByte: 16r66 ].

	emitter emitRexR: (reg size=8) opReg: 0 regCode: 0.
	emitter emitByte: opCode + (reg size ~=1) asBit.
	emitter emitImmediate: imm size: reg size
! !

!AJx86InstructionDescription methodsFor: 'accessing' stamp: 'CamilloBruni 4/13/2012 15:44'!
comment
	^ comment! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: ''!
emitjmp: emitter operand1: target operand2: op2 operand3: op3
	
	target isString ifTrue: [
		"jump on label"
		^ emitter addJump: target condition: nil hint: nil
	].

	target isRegMem ifTrue: [
		^ emitter emitX86RM: 16rFF
			size: 0 
			regOrCode:  4
			rm:  target
	].

	emitter emitByte: 16rE9.
	emitter emitDisplacement: target inlinedDisp: -4
! !

!AJx86InstructionDescription methodsFor: 'accessing' stamp: ''!
opCode1: anObject
	"Set the value of opCode1"

	opCode1 := anObject! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: ''!
emitcrc32: emitter operand1: dst operand2: src operand3: op3

	(dst isReg and: [ src isRegMem ]) ifTrue: [
		self assert: (dst isRegTypeGPD | dst isRegTypeGPQ).

		^ emitter emitX86RM: opCode1 + (src size ~= 1) asBit
			size: src size
			regOrCode: dst
			rm: src
		].
	
	self invalidInstruction.
! !

!AJx86InstructionDescription methodsFor: 'testing' stamp: ''!
is64BitOnly
	^ (o1Flags bitAnd: 2r100000000) ~= 0! !

!AJx86InstructionDescription methodsFor: 'accessing' stamp: ''!
o2Flags: anObject
	"Set the value of o2Flags"

	o2Flags := anObject! !

!AJx86InstructionDescription methodsFor: 'accessing' stamp: 'CamilloBruni 4/13/2012 14:51'!
description: aString
	description := aString! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: ''!
emitmem: emitter operand1: op1 operand2: op2 operand3: op3

	op1 isMem ifFalse: [ self invalidInstruction ].

	self assert: (opCode2 = 0 or: [ opCode2 = 1 ]).
	emitter emitX86RM: opCode1
		size: opCode2 << 3
		regOrCode: opCodeR 
		rm: op1
! !

!AJx86InstructionDescription methodsFor: 'accessing' stamp: ''!
opCodeR: anObject
	"Set the value of opCodeR"

	opCodeR := anObject! !

!AJx86InstructionDescription methodsFor: 'initialize-release' stamp: ''!
fromArray: arr
	| tmp |
	name := arr at: 1.
	group := arr at: 2.
	groupEmitSelector := ('emit', group,':operand1:operand2:operand3:') asSymbol.
	
	tmp := arr at: 3.
	tmp isSymbol ifTrue: [ tmp := self translateSymFlag: tmp ].
	o1Flags := tmp.
	o2Flags := arr at: 4.
	opCodeR := arr at: 5.
	opCode1 := arr at: 6.
	opCode2 := arr at: 7.! !

!AJx86InstructionDescription methodsFor: 'accessing' stamp: ''!
o1Flags
	"Answer the value of o1Flags"

	^ o1Flags! !

!AJx86InstructionDescription methodsFor: 'accessing' stamp: ''!
group
	^ group! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: ''!
emitalu: emitter operand1: op1 operand2: op2 operand3: op3
	| opCode opReg |
	opCode := opCode1.
	opReg := opCodeR.
	
	" Mem <- Reg "
	(op1 isMem and: [ op2 isReg ]) ifTrue: [
		^ emitter emitX86RM: opCode + op2 isRegTypeGPB not asBit
			size: op2 size
			regOrCode: op2
			rm: op1
	].

	"Reg <- Reg|Mem"
	(op1 isReg and: [op2 isRegMem]) ifTrue: [
		^ emitter emitX86RM: opCode + 2 + op1 isRegTypeGPB not asBit
			size: op1 size
			regOrCode: op1
			rm: op2
	].

	op2 isImm ifFalse: [	self invalidInstruction ].

	"short constant"
	op2 isInt8 ifTrue: [
 		| szBits |
		szBits := op1 size = 1 ifTrue: [ 0 ] ifFalse: [ 3 ].
		emitter emitX86RM: opCode2 + szBits
			size: op1 size
			regOrCode: opReg
			rm: op1
			immSize: 1.
		^ emitter emitImmediate: op2 size: 1.
	].
	
      " AL, AX, EAX, RAX register shortcuts"
	(op1 isRegIndex: 0) ifTrue: [
		
		op1 isRegTypeGPW ifTrue: [ emitter emitByte: 16r66 " 16 bit " ].
		op1 isRegTypeGPQ ifTrue: [ emitter emitByte: 16r48 " REX.W" ].

		emitter emitByte: (opReg << 3 bitOr: (16r04 + op1 isRegTypeGPB not asBit)).
		^ emitter emitImmediate: op2 size: (op1 size min: 4)
	].

	(op1 isRegMem) ifTrue: [ | immSize szBits |
		immSize := op2 isInt8 ifTrue: [1] ifFalse: [ op1 size min: 4].
		szBits := op1 size ~= 1 ifTrue: [ immSize ~= 1 ifTrue: [1] ifFalse: [3]] ifFalse: [ 0].
		emitter emitX86RM: opCode2 + szBits
			size: op1 size
			regOrCode: opReg
			rm: op1
			immSize: immSize.
		^ emitter emitImmediate: op2 size: immSize.
	].

	self invalidInstruction.
	! !

!AJx86InstructionDescription methodsFor: 'accessing' stamp: ''!
o2Flags
	"Answer the value of o2Flags"

	^ o2Flags! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: 'CamilloBruni 4/17/2012 19:02'!
emitimul: emitter operand1: op1 operand2: op2 operand3: op3
	| immSize |
	
	op1 isRegMem ifFalse: [  ^ self invalidInstruction ].
	
	" 1 operand "
	(op2 isNil and: [ op3 isNil ]) ifTrue: [
		^ emitter emitX86RM:  16rF6 + (op1 size ~= 1) asBit
			size: op1 size
			regOrCode:  5
			rm:  op1
		].
	op1 isReg ifFalse: [  ^ self invalidInstruction ].
	
	"2 operands"
	op3 isNil ifTrue: [
"		self assert: op1 isRegTypeGPW."

		op2 isRegMem ifTrue: [
			^ emitter emitX86RM: 16r0FAF
				size: op1 size
				regOrCode: op1 code
				rm:  op2
			].
		op2 isImm ifFalse: [ ^ self invalidInstruction ].

		(op2 isInt8 and: [ op2 relocMode == #RelocNone ]) ifTrue: [
			emitter emitX86RM: 16r6B
				size: op1 size
				regOrCode:  op1 code
				rm:  op1
				immSize: 1.
			^ emitter emitImmediate: op2 size: 1.
			].

		immSize := op1 isRegTypeGPW ifTrue: [ 2 ] ifFalse: [ 4 ].
		emitter emitX86RM: 16r69
			size: op1 size
			regOrCode:  op1 code
			rm:  op1
			immSize: immSize.
		^ emitter emitImmediate: op2 size: immSize.
	].

	" 3 operands "
	(op2 isRegMem and: [op3 isImm ]) ifFalse: [ ^ self invalidInstruction ].
	
	(op3 isInt8 and: [ op3 relocMode == #RelocNone ]) ifTrue: [
		emitter emitX86RM: 16r6B
			size: op1 size
			regOrCode:  op1
			rm: op2 immSize: 1.
		^ emitter emitImmediate: op3 size: 1.
		].

    	immSize := op1 isRegTypeGPW ifTrue: [2] ifFalse: [4].
	emitter emitX86RM: 16r69
		size: op1 size
		regOrCode:  op1
		rm:  op2 immSize: immSize.
	emitter emitImmediate: op3 size: immSize.
! !

!AJx86InstructionDescription methodsFor: 'emitting - mmu' stamp: ''!
emitmmuMovD: emitter operand1: op1 operand2: op2 operand3: op3
	self shouldBeImplemented! !

!AJx86InstructionDescription methodsFor: 'code emitting' stamp: 'HenrikSperreJohansen 6/26/2014 14:37'!
emittest: emitter operand1: op1 operand2: op2 operand3: op3
	| immSize |
	op1 isRegMem & op2 isReg
		ifTrue: [ 
			op1 size notNil & (op1 size ~= op2 size)
				ifTrue: [ 
					self
						error:
							'Operands ' , op1 asString , ' and ' , op2 asString , ' don''t match in size: ' , op1 size asString , ' !!= '
								, op2 size asString ].
			^ emitter
				emitX86RM: 16r84 + op2 isRegTypeGPB not asBit
				size: op2 size
				regOrCode: op2
				rm: op1 ].
	(op1 isReg and: [ op1 index = 0 and: [ op2 isImm ] ])
		ifTrue: [ 
			immSize := op1 size min: 4.
			emitter emitOperandSizeOverridePrefix: op1.
			emitter emitByte: 16rA8 + (op1 size ~= 1) asBit.
			^ emitter emitImmediate: op2 size: immSize ].
	(op1 isRegMem and: [ op2 isImm ])
		ifFalse: [ self invalidInstruction ].
	immSize := op1 size min: 4.
	(op2 fitsInSize: immSize)
		ifFalse: [ self invalidInstruction ].
	emitter emitSegmentPrefix: op1.
	emitter emitOperandSizeOverridePrefix: op1.
	emitter emitByte: 16rF6 + (op1 size ~= 1) asBit.
	op1 emitModRM: emitter code: 0 immSize: immSize.
	emitter emitImmediate: op2 size: immSize! !

!AJx86InstructionDescription methodsFor: 'emitting - mmu' stamp: ''!
emitmmuPrefetch: emitter operand1: op1 operand2: op2 operand3: op3
	self shouldBeImplemented! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: ''!
emitx87fstsw: anAJx86Assembler operand1: anUndefinedObject operand2: anUndefinedObject3 operand3: anUndefinedObject4 
	self shouldBeImplemented! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: ''!
emitret: emitter operand1: op1 operand2: op2 operand3: op3

	op1 ifNil: [ ^ emitter emitByte: 16rC3 ].
	
	op1 isImm ifFalse: [ self invalidInstruction ].
	
	self assert: (op1 isUnsigned and: [op1 fitsInSize: 2]).
	
	(op1 value = 0 and: [ op1 relocMode  == #RelocNone ]) ifTrue: [
		^ emitter emitByte: 16rC3	].
		
	emitter emitByte: 16rC2.
	emitter emitImmediate: op1 size: 2! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: ''!
emitx87memSti: emitter operand1: op1 operand2: op2 operand3: op3

	op1 isRegTypeX87 ifTrue: [
		emitter emitByte: (opCode2 bitAnd: 16rFF000000)>>24.
		emitter emitByte: (opCode2 bitAnd: 16r00FF0000)>>16
			+ op1 index.
		^ self 
	].

      " ... fall through to I_X87_MEM ... "

	^ self emitx87mem: emitter operand1: op1 operand2: op2 operand3: op3
! !

!AJx86InstructionDescription methodsFor: 'accessing' stamp: ''!
name: anObject
	"Set the value of name"

	name := anObject! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: ''!
emitcjmp: emitter operand1: target operand2: hint operand3: op3
	"Conditional jump.
	Use only symbols as labels"

	
	target isString ifTrue: [
		"jump on label"
		^ emitter addJump: target condition: opCode1 hint: hint
	].
	
	"we could check if label is bound , and emit short jump, 
	instead of 32-bit relative jump address"
	self invalidInstruction.
	emitter emitByte: 16r0F;
		emitByte: (16r80 bitOr: opCode1);
		emitDisplacement: target inlinedDisp: -4
! !

!AJx86InstructionDescription methodsFor: 'emitting - mmu' stamp: ''!
emitmmuRm3DNow: emitter operand1: op1 operand2: op2 operand3: op3
	self shouldBeImplemented! !

!AJx86InstructionDescription methodsFor: 'emitting - mmu' stamp: ''!
emitmmurmi: emitter operand1: op1 operand2: op2 operand3: op3
	self shouldBeImplemented! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: ''!
emitrm: emitter operand1: dst operand2: src operand3: op3

	emitter emitX86RM: opCode1 + (dst isRegTypeGPB not) asBit
		size: dst size
		regOrCode: opCodeR rm: dst! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: ''!
emitcall: emitter operand1: op1 operand2: op2 operand3: op3

	(op1 isMem or: [ op1 isReg and: [ op1 index = 0 "EAX" ] ]) ifTrue: [
		^ emitter emitX86RM:  16rFF
			size: 4
			regOrCode: 2  
			rm: op1  
	].

	op1 isImm ifTrue: [ "call by relative offset, you should be really sure what you're' doing"
		emitter emitByte: 16rE8. 
		op1 emitUsing: emitter size: 4.
		^ self.
		].
	
	op1 isLabel ifTrue: [
		emitter emitByte: 16rE8. 
		emitter emitDisplacement: op1 inlinedDisp: -4.
		^ self
	].
	self invalidInstruction.
! !

!AJx86InstructionDescription methodsFor: 'accessing' stamp: ''!
name
	^ name! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: ''!
emitrrm: emitter operand1: dst operand2: src operand3: op3

	dst isReg & src isRegMem ifFalse: [ self invalidInstruction ].
	
	self assert: (dst isRegTypeGPB not).
	
	emitter emitX86RM: opCode1
		size: dst size
		regOrCode: dst rm: src! !

!AJx86InstructionDescription methodsFor: 'emitting-dispatch' stamp: ''!
emitUsing: emitter operand1: op1 operand2: op2 operand3: op3

	(self is64BitOnly and: [ emitter is64BitMode not ]) ifTrue: [ 
		self error: 'instruction is only for 64 bit mode' ].

	(self is32BitOnly and: [ emitter is32BitMode not ]) ifTrue: [ 
		self error: 'instruction is only for 32 bit mode' ].

	
	^ self perform: groupEmitSelector withArguments: 	{ emitter. op1. op2. op3 }! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: ''!
emitbswap: emitter operand1: op1 operand2: op2 operand3: op3

	op1 isReg ifTrue: [

		emitter emitRexR: op1 isRegTypeGPQ opReg: 1 regCode: op1 code.
		emitter emitByte: 16r0F.
		^ emitter emitModR: 1 r: op1 code
	].
	self invalidInstruction.! !

!AJx86InstructionDescription methodsFor: 'accessing' stamp: ''!
opCode2: anObject
	"Set the value of opCode2"

	opCode2 := anObject! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: 'IgorStasenko 3/20/2012 16:08'!
emitmov: emitter operand1: dst operand2: src operand3: op3

	src isReg & dst isReg ifTrue: [
		self assert: (src isRegTypeGPB | src isRegTypeGPW | src isRegTypeGPD | src isRegTypeGPQ ).
		]. 
	
	" reg <- mem "
	dst isReg & src isRegMem ifTrue: [
		self assert: (dst isRegTypeGPB | dst isRegTypeGPW | dst isRegTypeGPD | dst isRegTypeGPQ ).
	"	(src size = dst size) ifFalse: [ self invalidInstruction ]. "
		^ emitter emitX86RM: 16r0000008A + dst isRegTypeGPB not asBit 
			size:  dst size 
			regOrCode:  dst 
			rm: src
		].

	" reg <- imm "
	
	dst isReg & src isImm ifTrue: [
		| immSize |
		immSize := dst size.
		emitter is64BitMode & immSize = 8 & src isInt32 & (src relocMode == #RelocNone) ifTrue: [
			"Optimize instruction size by using 32 bit immediate if value can fit to it"
			 emitter emitX86RM: 16rC7
				size: dst size
				regOrCode: 0 rm: dst.
	            immSize := 4
		] ifFalse: [
			emitter emitX86Inl: (immSize=1 ifTrue: [16rB0] ifFalse: [16rB8]) reg: dst
		].
		^ emitter emitImmediate: src size: immSize
	].

	"mem <- reg"
	dst isMem & src isReg ifTrue: [
		self assert: (src isRegTypeGPB | src isRegTypeGPW | src isRegTypeGPD | src isRegTypeGPQ ).
		^ emitter emitX86RM: 16r88 + src isRegTypeGPB not asBit
			size: src size regOrCode: src rm: dst
	].

	"mem <- imm"
	dst isMem & src isImm ifTrue: [ | immSize |
		
		immSize := dst size <= 4 ifTrue: [ dst size ] ifFalse: [4].
		
		emitter emitX86RM: 16rC6 + ((dst size = 1) not) asBit
			size: dst size 
			regOrCode:  0 rm:  dst 
			immSize: immSize.
		
		^ emitter emitImmediate: src size: immSize
	].

	self invalidInstruction 
! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: 'CamilloBruni 7/17/2012 11:10'!
emitx87addp: emitter operand1: op1 operand2: op2 operand3: op3

	| opp |
	opp := op1 ifNil:  [ AJx87Register new code: 1 ].
	
	opp isRegTypeX87 ifTrue: [
		emitter emitByte: (opCode1 bitAnd: 16rFF00)>>8.
		emitter emitByte: (opCode1 bitAnd: 16rFF)
			+ opp index.
		^ self 
	].

	^self emitx87sti: emitter operand1: opp operand2: op2 operand3: op3
	! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: ''!
emitpush: emitter operand1: op1 operand2: op2 operand3: op3

	"This section is only for immediates, memory/register operands are handled in emitpop:..."
	op1 isImm ifTrue: [
		op1 isInt8 & (op1 relocMode == #RelocNone) ifTrue: [
			emitter emitByte: 16r6A.
			^ emitter emitImmediate: op1 size: 1 ].
		
		emitter emitByte: 16r68.
		^ emitter emitImmediate: op1 size: 4
		].
	
	^ self emitpop: emitter operand1: op1 operand2: op2 operand3: op3
! !

!AJx86InstructionDescription methodsFor: 'printing' stamp: ''!
printOn: aStream

	aStream nextPutAll: '(';
	nextPutAll: name printString;
	space;
	nextPutAll: group printString;
	space.

	"print o1Flags"
	o1Flags > 0 ifTrue: [ aStream nextPutAll: '"op1" 2r' , (o1Flags printStringBase: 2) ]
		ifFalse: [ aStream nextPutAll: '0'].
	aStream space.
	
	"print o2Flags"
	o2Flags > 0 ifTrue: [ aStream nextPutAll: '"op2" 2r' , (o2Flags printStringBase: 2) ]
		ifFalse: [ aStream nextPutAll: '0'].
	aStream space.

	"print opCodeR"
	aStream nextPutAll: '"R" '.
	opCodeR printOn: aStream.
	aStream space.
	
	"print opCode1"
	opCode1 > 0 ifTrue: [ 
		aStream nextPutAll: '"C1" '.
		aStream nextPutAll:  (self printDWord: opCode1 ) ]
		ifFalse: [ aStream nextPutAll: '0'].
		
	aStream space.

	"print opCode2"
	opCode2 > 0 ifTrue: [ 
		aStream nextPutAll: '"C2" '.
		aStream nextPutAll:  (self printDWord: opCode2 ) ]
		ifFalse: [ aStream nextPutAll: '0'].

	aStream space;
	nextPut: $) 
	! !

!AJx86InstructionDescription methodsFor: 'accessing' stamp: ''!
o1Flags: anObject
	"Set the value of o1Flags"

	o1Flags := anObject! !

!AJx86InstructionDescription methodsFor: 'initialize-release' stamp: ''!
translateSymFlag: aflag

	" 64-bit mode only instruction "
	aflag == #x64 ifTrue: [ ^ 2r100000000 ].

	" 32-bit mode only instruction "
	aflag == #x86 ifTrue: [ ^ 2r1000000000 ].

	self error: 'unknown flag'.! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: ''!
emitx87fpu: emitter operand1: op1 operand2: op2 operand3: op3 
	"Either we are in memory, and carry out by using D8 / DC followed by modRM where reg indicates the operation"
	op1 isMem 
		ifTrue: [
		(op2 notNil or: [op3]) notNil ifTrue: [self error: 'Invalid arguments!!'].
		
		emitter emitByte: (opCode1 >> (32 - (op1 size* 2)) bitAnd: 16rFF).
		^op1 emitModRM: emitter code: opCodeR immSize: nil].
	"Or both my arguments are X87 registers, one of which is ST0.
	Store in op1 register."
	(op1 isRegTypeX87 and: [op2 isRegTypeX87]) ifTrue: [|shift offset|
		op1 index = 0 
			ifTrue: [shift := 24.
					offset := op2 index]
			ifFalse: [
			op2 index = 0 
				ifTrue: [shift = 16.
					offset := op1 index]
				ifFalse: [self error: 'ST0 must be one of arguments']].

		"D8 if Storing in ST0, DC if storing in other"
		emitter emitByte: (opCode1 >> shift bitAnd: 16rFF).
	
		emitter emitByte: (opCode1 >> (shift - 16) bitAnd: 16rFF) + offset
		]
		ifFalse: [self error: 'Invalid arguments!!']
	! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: 'CamilloBruni 5/15/2012 14:18'!
emitbt: emitter operand1: dst operand2: src operand3: op3

	dst isRegMem
		ifFalse: [ self error: 'Expected register or memory but got ', dst asString ].
	
	(dst isReg and: [ dst is8 ])
		ifTrue: [ self error: '8 bit register ', dst asString, ' not supported for bit test operations'].
	
 	src isReg ifTrue: [
		^ emitter emitX86RM: opCode1
			size: src size
			regOrCode: src
			rm: dst
	].

	src isImm ifTrue: [
		src isInt8 
			ifFalse: [ self error: 'Expected imm8 but got ', src size asString, ' immediate.' ].
		emitter emitX86RM: opCode2
			size: dst size
			regOrCode: opCodeR
			rm: dst
			immSize: 1.
		^ emitter emitImmediate: src size: 1
	].

	self invalidInstruction
	! !

!AJx86InstructionDescription methodsFor: 'errors' stamp: ''!
invalidInstruction
	self error: 'invalid instruction'! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: ''!
emitemit: emitter operand1: op1 operand2: op2 operand3: op3

	^ emitter emitOpCode: opCode1! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: ''!
emitxchg: emitter operand1: dst operand2: src operand3: op3

	dst isRegMem & src isReg ifFalse: [ self invalidInstruction ].
	
	emitter emitSizePrefix: src segment: dst.
	
	"Special opcode for index 0 registers (AX, EAX, RAX vs register)"
	dst isReg & (dst size > 1) & (dst index =0 or: [ src index = 0 ] ) ifTrue: [
			| index |
			index := dst index + src index.
			^ emitter emitByte: 16r90 + index.
		].
	
	emitter emitByte: 16r86 + src isRegTypeGPB not asBit.
	dst emitModRM: emitter code: src code immSize: 0! !

!AJx86InstructionDescription methodsFor: 'printing' stamp: ''!
printDWord: value

	| str |
	str := value printStringBase: 16.
	
	[str size < 8] whileTrue: [ str:= '0',str ].

	^ '16r', str! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: ''!
emitmovsxd: emitter operand1: dst operand2: src operand3: op3

	emitter is64BitMode ifFalse: [ self invalidInstruction ].
	dst isReg & src isRegMem ifFalse: [ self invalidInstruction ].
	
	emitter emitX86RM: 16r63 
		size: dst size
		regOrCode: dst  rm: src! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: 'HenrikSperreJohansen 2/26/2015 14:37'!
emitsmnemonic: emitter operand1: dst operand2: op2 operand3: op3
	"Emit a string operation mnemonic. See self class >> # initStringOperations for details"
	| fauxReg|
	dst isRegMem ifFalse: [ ^ self invalidInstruction ].
	"quick test for illegal  ins/outs with 64bit-sized arg"
	(dst is64 and: [((opCode1 bitShift: -3) bitXor: 16rD) = 0 ]) ifTrue: [ ^ self invalidInstruction  ].
	"Really, movs and friends are to be called with two parameters, both of the correct size (but inconsequential location).
	We don't really care, so just check sizes are the same if a second operand happens to be there.
	It's only 'provided to allow documentation' anyways, so leave it up to user to mess that up as he sees fit"
	(op2 notNil and: [ dst size ~= op2 size]) ifTrue:[^self invalidInstruction].
	
	"Create a faux register that will have operand size prefix and REX byte set appropriately, and a code of 1 if op size > 1 byte"
	fauxReg := AJRegister new.
	  fauxReg code: ((dst size highBit - 1 << 4 ) bitOr:((dst size > 1) asBit)).
	^ emitter emitX86Inl: opCode1	reg: fauxReg
! !

!AJx86InstructionDescription methodsFor: 'accessing' stamp: ''!
group: anObject
	"Set the value of group"

	group := anObject! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: ''!
emitenter: emitter operand1: op1 operand2: op2 operand3: op3

	(op1 isImm and: [ op2 isImm ]) ifFalse: [ self invalidInstruction ].
	
	emitter emitByte: 16rC8.
	emitter emitImmediate: op1 size: 2.
	emitter emitImmediate: op2 size: 1.
! !

!AJx86InstructionDescription methodsFor: 'accessing' stamp: ''!
opCodeR
	"Answer the value of opCodeR"

	^ opCodeR! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: ''!
emitrmr: emitter operand1: dst operand2: src operand3: op3

	dst isRegMem & src isReg ifFalse: [ self invalidInstruction ].
	
	emitter emitX86RM: opCode1 + (src isRegTypeGPB not) asBit
		size: src size
		regOrCode: src rm: dst! !

!AJx86InstructionDescription methodsFor: 'emitting-dispatch' stamp: 'HenrikSperreJohansen 6/26/2014 13:39'!
emitsddisambiguate: emitter operand1: op1 operand2: op2 operand3: op3
	"XXXsd can be two different operations based on which operands are used;
	- 0 arg version is a string operation on doubleword (32bit) values
	- 2arg version is an SSE2/AVX mmu operation.
	Since mmu operations have differing emit methods, rely on the string versions being the one installed in instruction dictionary, 	"

	| correctDescription |
	op1
		ifNil: [ 
			"String op was correct"
			^ self
				emitemit: emitter
				operand1: op1
				operand2: op2
				operand3: op3 ].	"Emit other instruction instead"
	correctDescription := self class fromArray: (self class instructionsAmbiguous detect: [ :one | one first = name ]).
	emitter description: correctDescription.
	correctDescription
		emitUsing: emitter
		operand1: op1
		operand2: op2
		operand3: op3! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: 'CamilloBruni 4/17/2012 17:41'!
emitlea: emitter operand1: op1 operand2: op2 operand3: op3

	(op1 isReg and: [ op2 isMem ]) 
		ifFalse: [ self error: 'LEA: Expected Reg and Mem but got ', op1 asString, ' and ', op2 asString ].
	
	emitter emitX86RM: 16r8D
		size: op1 size
		regOrCode: op1
		rm: op2! !

!AJx86InstructionDescription methodsFor: 'emitting - mmu' stamp: ''!
emitmmuMovQ: emitter operand1: op1 operand2: op2 operand3: op3
	self shouldBeImplemented! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: 'CamilloBruni 7/23/2012 15:21'!
emitx87sti: emitter operand1: op1 operand2: op2 operand3: op3
	(op1 isNil and: [ op2 isNil and: [ op3 isNil ]])
		ifTrue: [ "Convenience fallback for ST1 "
			^ self emitx87sti: emitter operand1: AJx86Registers ST1 operand2: nil operand3: nil ].
		
	op1 isRegTypeX87 ifTrue: [
		emitter emitByte: (opCode1 bitAnd: 16rFF00)>>8.
		emitter emitByte: (opCode1 bitAnd: 16rFF) + op1 index.
		^ self 
	].

	self invalidInstruction! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: 'CamilloBruni 4/25/2012 15:15'!
emitpop: emitter operand1: op1 operand2: op2 operand3: op3

	op1 isReg ifTrue: [
		(op1 isRegTypeGPW | (emitter isGPNRegister: op1)) 
			ifFalse: [ self error: 'Invalid register given: ', op1 asString].
		^ emitter emitX86Inl: opCode1 reg: op1.
		].
	
	op1 isMem ifFalse: [ self invalidInstruction ].
	emitter emitX86RM: opCode2 size: op1 size regOrCode: opCodeR rm: op1
! !

!AJx86InstructionDescription methodsFor: 'emitting' stamp: ''!
emitincdec: emitter operand1: dst operand2: op2 operand3: op3

	dst isRegMem ifFalse: [ ^ self invalidInstruction ].

	"INC [r16|r32] in 64 bit mode is not encodable."
	emitter is32BitMode ifTrue: [
		(dst isReg & dst isRegTypeGPW & dst isRegTypeGPD) ifTrue: [ 
		^ emitter emitX86Inl: opCode1	reg: dst
	]].

	emitter emitX86RM:  opCode2 + (dst size ~= 1) asBit
		size: dst size
		regOrCode:  opCodeR
		rm:  dst
! !

!AJx86InstructionDescription methodsFor: 'accessing' stamp: ''!
opCode1
	"Answer the value of opCode1"

	^ opCode1! !

!AJx86InstructionDescription methodsFor: 'testing' stamp: ''!
isJump

	^ group == #cjmp or: [ group == #jmp ]! !

!AJx86InstructionDescription methodsFor: 'emitting - mmu' stamp: ''!
emitmmuRmImm8: emitter operand1: op1 operand2: op2 operand3: op3
	self shouldBeImplemented! !

!AJx86InstructionDescription methodsFor: 'accessing' stamp: ''!
opCode2
	"Answer the value of opCode2"

	^ opCode2! !

!AJx86InstructionDescription class methodsFor: 'initialization' stamp: 'HenrikSperreJohansen 6/26/2014 02:37'!
initInstructions
	" self initInstructions "
	| data |

	instructions := IdentityDictionary new.

	data := OrderedCollection new.
	data addAll: self instructionData;
		addAll: self instructionsCDQ;
		addAll: self instructionsStrings;
		addAll: self instructionsOther.
	
	data do: [:dt | 
		instructions at: dt first put: (self fromArray: dt) ].
	
	^ instructions! !

!AJx86InstructionDescription class methodsFor: 'initialization' stamp: 'HenrikSperreJohansen 6/26/2014 03:14'!
instructionsOther

^ #()! !

!AJx86InstructionDescription class methodsFor: 'printing' stamp: ''!
printInstructionsOn: aStream
	" AJInstructionDescription printInstructionsOn: (FileStream newFileNamed: 'asm.st'). "
	
	aStream nextPutAll: '#(' ; cr.
	
	self instructions keys asSortedCollection do: [:aname | 
		| instr |
		
		instr := instructions at: aname.
		
		instr printOn: aStream.
		aStream cr.
	].
	aStream cr;
		nextPut: $); cr
! !

!AJx86InstructionDescription class methodsFor: 'printing' stamp: ''!
printInstructions
	" AJInstructionDescription printInstructions.
	
	AJInstructionDescription printInstructions openInWorkspaceWithTitle: 'x86 instructions'
	 "
	^ String streamContents: [:str | self printInstructionsOn: str ]

! !

!AJx86InstructionDescription class methodsFor: 'accessing' stamp: ''!
instructions
	^ instructions ifNil: [ self initInstructions ]! !

!AJx86InstructionDescription class methodsFor: 'initialization' stamp: ''!
initialize

	self initInstructions.! !

!AJx86InstructionDescription class methodsFor: 'initialization' stamp: 'HenrikSperreJohansen 6/26/2014 13:38'!
instructionsStrings
"String operations, often used in conjunction with rep prefix for efficient batch operations"

"General note: 
- Memory locations written X / Y means X unless prefixed by address-size override (16r67), in that case Y."
^ #(

"Repeat prefixes, only to be used with string operations 
(Could be nice to create group emitPrefix, and build a stack of applied prefixes which can be checked for validity with next op)"
"When used, repeat string operation max (E)CX times or until condition met"

(#repne #emit 0 0 "R" 0 "C1" 16r000000F2 0 )   
(#repnz #emit 0 0 "R" 0 "C1" 16r000000F2 0 )   
(#rep #emit 0 0 "R" 0 "C1" 16r000000F3 0 )   
(#repe #emit 0 0 "R" 0 "C1" 16r000000F3 0 )   
(#repz #emit 0 0 "R" 0 "C1" 16r000000F3 0 )  

"Direction flag setters, only used by string ops"
(#cld #emit 0 0 "R" 0 "C1" 16r000000FC 0 ) "DF := 0, string ops increment addresses"
(#std #emit 0 0 "R" 0 "C1" 16r000000FD 0 )   "DF := 1, string ops decrement addresses"



"String input: 
	In 32-bit mode, input byte/word/doubleword from i/o port specified in DX to address in ES:EDI / ES:DI. 
	In 64-bit mode, input byte/word/doubleword, from i/o port specified in DX to address in RDI / EDI"
(#ins #smnemonic 0 0 "R" 0 "C1" 16r0000006C 0 )  "mnemonic, arg size determines actual prefixes/op"
(#insb #emit 0 0 "R" 0 "C1" 16r0000006C 0 )  "8 bit"
(#insw #emit 0 0 "R" 0 "C1" 16r6600006D 0 ) "16 bit" "Mandatory Operand override prefix (16r66) in 32/64bit mode"
(#insd #emit 0 0 "R" 0 "C1" 16r0000006D 0 )  "32 bit"
"(#insq #emit #x64 0  0 16r4800006D 0 ) 64bit version does not exist according to intel IS reference"

"String output:
	In 32-bit mode output byte/word/doubleword at address in DS:ESI / DS:SI to io port specified in DX. 
	In 64-bit mode, output byte/word/doubleword, at address in RSI/ESI to io port specified in DX "
(#outs #smnemonic 0 0 "R" 0 "C1" 16r0000006E 0 )  "mnemonic, arg size determines actual prefixes/op"
(#outsb #emit 0 0 "R" 0 "C1" 16r0000006E 0 )  "8 bit"
(#outsw #emit 0 0 "R" 0 "C1" 16r6600006F 0 ) "16 bit"  "Mandatory Operand override prefix (16r66) in 32/64bit mode"
(#outsd #emit 0 0 "R" 0 "C1" 16r0000006F 0 )  "32 bit"
"(#outsq #emit #x64 0 0 16r4800006F 0 ) 64bit version does not exist according to intel IS reference"

"String move:
	In 32-bit mode move byte/word/doubleword at address in DS:ESI / DS:SI to address in ES:EDI / ES:DI.
	In 64-bit mode move byte/word/doubleword/quadword at address in from RSI / ESI to address in RDI / EDI."
(#movs  #smnemonic 0 0 "R" 0 "C1" 16r000000A4 0 )  "mnemonic, arg sizes determines actual prefixes/op"
(#movsb #emit 0 0 "R" 0 "C1" 16r000000A4 0 )  "8 bit"
(#movsw #emit 0 0 "R" 0 "C1" 16r660000A5 0 ) "16 bit" "Mandatory Operand override prefix (16r66) in 32/64bit mode"
(#movsd #sddisambiguate 0 0 "R" 0 "C1" 16r000000A5 0 )  "32 bit"
(#movsq #emit #x64 0 "R" 0 "C1" 16r480000A5 0 ) "64bit, in 64-bit mode only. Naughtily embed required REX.W prefix"

"String compare: 
	In 32-bit mode compare byte/word/doubleword at address in DS:ESI / DS:SI to same at address in ES:EDI / ES:DI.
	In 64-bit mode compare byte/word/doubleword/quadword at address in RSI / ESI to same at address in RDI / EDI."
(#cmps  #smnemonic 0 0 "R" 0 "C1" 16r000000A6 0 )  "mnemonic, arg sizes determines actual prefixes/op"
(#cmpsb #emit 0 0 "R" 0 "C1" 16r000000A6 0 )  "8 bit"
(#cmpsw #emit 0 0 "R" 0  "C1" 16r660000A7 0 )  "16 bit" "Mandatory Operand override prefix (16r66) in 32/64bit mode"
(#cmpsd #sddisambiguate 0 0 "R" 0 "C1" 16r000000A7 0 )  "32 bit"
(#cmpsq #emit #x64 0 "R" 0 "C1" 16r480000A7 0 ) "64bit, in 64-bit mode only. Naughtily embed required REX.W prefix"

"String store: 
	In 32-bit mode store AL/AX/EAX at address in ES:EDI / ES:DI 
	In 64-bit mode store AL/AX/EAX/RAX to RDI / EDI "
(#stos #smnemonic 0 0 "R" 0 "C1" 16r000000AA 0 )  "mnemonic, arg sizes determines actual prefixes/op"
(#stosb #emit 0 0 "R" 0 "C1" 16r000000AA 0 ) "8bit"
(#stosw #emit 0 0 "R" 0 "C1" 16r660000AB 0 ) "16bit" "Mandatory Operand override prefix (16r66) in 32/64bit mode"
(#stosd #emit 0 0 "R" 0 "C1" 16r000000AB 0 ) "32bit"
(#stosq #emit #x64 0 "R" 0 "C1" 16r480000AB 0 ) "64bit, in 64-bit mode only. Naughtily embed required REX.W prefix"


"String load:
	In 32-bit mode load byte/word/doubleword from address in ES:EDI / ES:DI to AL/AX/ EAX 
	In 64-bit mode load byte/word/doubleword/quadword from address in RDI / EDI to AX / EAX / RAX"
(#lods  #smnemonic 0 0 "R" 0 "C1" 16r000000AC 0 )  "mnemonic, arg sizes determines actual prefixes/op"
(#lodsb #emit 0 0 "R" 0 "C1" 16r000000AC 0 ) "8bit"
(#lodsw #emit 0 0 "R" 0 "C1" 16r660000AD 0 ) "16bit"  "Mandatory Operand override prefix (16r66) in 32/64bit mode"
(#lodsd #emit 0 0 "R" 0 "C1" 16r000000AD 0 ) "32bit"
(#lodsq #emit #x64 0 "R" 0 "C1" 16r480000AD 0 ) "64bit, in 64-bit mode only. Naughtily embed required REX.W prefix"

"String scan:
	In 32-bit mode compare AL/AX/EAX L with ES:EDI / ES:DI  
	In 64-bit mode compare AL/AX/EAX/RAX with RDI / EDI"
(#scas  #smnemonic 0 0 "R" 0 "C1" 16r000000AE 0 )  "mnemonic, arg sizes determines actual op"
(#scasb #emit 0 0 "R" 0 "C1" 16r000000AE 0 ) "8bit"
(#scasw #emit 0 0 "R" 0 "C1" 16r660000AF 0 ) "16bit" "Mandatory Operand override prefix (16r66) in 32/64bit mode"
(#scasd #emit 0 0 "R" 0 "C1" 16r000000AF 0 ) "32bit"
(#scasq #emit #x64 0 "R" 0 "C1" 16r480000AF 0 ) "64bit, in 64-bit mode only. Naughtily embed required REX.W prefix"
)! !

!AJx86InstructionDescription class methodsFor: 'initialization' stamp: 'CamilloBruni 4/17/2012 17:39'!
at: instructionName
	
	^ instructions 
		at: instructionName ! !

!AJx86InstructionDescription class methodsFor: 'initialization' stamp: 'HenrikSperreJohansen 6/26/2014 11:47'!
instructionData
^ #(
(#adc #alu 0 0 "R" 2 "C1" 16r00000010 "C2" 16r00000080 )
(#add #alu 0 0 "R" 0 0 "C2" 16r00000080 )
(#addpd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r66000F58 0 )
(#addps #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r00000F58 0 )
(#addsd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF2000F58 0 )
(#addss #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF3000F58 0 )
(#addsubpd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r66000FD0 0 )
(#addsubps #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF2000FD0 0 )
(#amdprefetch #mem "op1" 2r1000000 0 "R" 0 "C1" 16r00000F0D 0 )
(#amdprefetchw #mem "op1" 2r1000000 0 "R" 1 "C1" 16r00000F0D 0 )
(#and #alu 0 0 "R" 4 "C1" 16r00000020 "C2" 16r00000080 )
(#andnpd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r66000F55 0 )
(#andnps #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r00000F55 0 )
(#andpd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r66000F54 0 )
(#andps #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r00000F54 0 )
(#blendpd #mmuRmImm8 "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3A0D 0 )
(#blendps #mmuRmImm8 "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3A0C 0 )
(#blendvpd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3815 0 )
(#blendvps #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3814 0 )
(#bsf #rrm 0 0 "R" 0 "C1" 16r00000FBC 0 )
(#bsr #rrm 0 0 "R" 0 "C1" 16r00000FBD 0 )
(#bswap #bswap 0 0 "R" 0 0 0 )
(#bt #bt "op1" 2r1001110 "op2" 2r10001110 "R" 4 "C1" 16r00000FA3 "C2" 16r00000FBA )
(#btc #bt "op1" 2r1001110 "op2" 2r10001110 "R" 7 "C1" 16r00000FBB "C2" 16r00000FBA )
(#btr #bt "op1" 2r1001110 "op2" 2r10001110 "R" 6 "C1" 16r00000FB3 "C2" 16r00000FBA )
(#bts #bt "op1" 2r1001110 "op2" 2r10001110 "R" 5 "C1" 16r00000FAB "C2" 16r00000FBA )
(#call #call 0 0 "R" 0 0 0 )
(#clc #emit 0 0 "R" 0 "C1" 16r000000F8 0 )
(#clflush #mem "op1" 2r1000000 0 "R" 7 "C1" 16r00000FAE 0 )
(#cmc #emit 0 0 "R" 0 "C1" 16r000000F5 0 )
(#cmova #rrm 0 0 "R" 0 "C1" 16r00000F47 0 )
(#cmovae #rrm 0 0 "R" 0 "C1" 16r00000F43 0 )
(#cmovb #rrm 0 0 "R" 0 "C1" 16r00000F42 0 )
(#cmovbe #rrm 0 0 "R" 0 "C1" 16r00000F46 0 )
(#cmovc #rrm 0 0 "R" 0 "C1" 16r00000F42 0 )
(#cmove #rrm 0 0 "R" 0 "C1" 16r00000F44 0 )
(#cmovg #rrm 0 0 "R" 0 "C1" 16r00000F4F 0 )
(#cmovge #rrm 0 0 "R" 0 "C1" 16r00000F4D 0 )
(#cmovl #rrm 0 0 "R" 0 "C1" 16r00000F4C 0 )
(#cmovle #rrm 0 0 "R" 0 "C1" 16r00000F4E 0 )
(#cmovna #rrm 0 0 "R" 0 "C1" 16r00000F46 0 )
(#cmovnae #rrm 0 0 "R" 0 "C1" 16r00000F42 0 )
(#cmovnb #rrm 0 0 "R" 0 "C1" 16r00000F43 0 )
(#cmovnbe #rrm 0 0 "R" 0 "C1" 16r00000F47 0 )
(#cmovnc #rrm 0 0 "R" 0 "C1" 16r00000F43 0 )
(#cmovne #rrm 0 0 "R" 0 "C1" 16r00000F45 0 )
(#cmovng #rrm 0 0 "R" 0 "C1" 16r00000F4E 0 )
(#cmovnge #rrm 0 0 "R" 0 "C1" 16r00000F4C 0 )
(#cmovnl #rrm 0 0 "R" 0 "C1" 16r00000F4D 0 )
(#cmovnle #rrm 0 0 "R" 0 "C1" 16r00000F4F 0 )
(#cmovno #rrm 0 0 "R" 0 "C1" 16r00000F41 0 )
(#cmovnp #rrm 0 0 "R" 0 "C1" 16r00000F4B 0 )
(#cmovns #rrm 0 0 "R" 0 "C1" 16r00000F49 0 )
(#cmovnz #rrm 0 0 "R" 0 "C1" 16r00000F45 0 )
(#cmovo #rrm 0 0 "R" 0 "C1" 16r00000F40 0 )
(#cmovp #rrm 0 0 "R" 0 "C1" 16r00000F4A 0 )
(#cmovpe #rrm 0 0 "R" 0 "C1" 16r00000F4A 0 )
(#cmovpo #rrm 0 0 "R" 0 "C1" 16r00000F4B 0 )
(#cmovs #rrm 0 0 "R" 0 "C1" 16r00000F48 0 )
(#cmovz #rrm 0 0 "R" 0 "C1" 16r00000F44 0 )
(#cmp #alu 0 0 "R" 7 "C1" 16r00000038 "C2" 16r00000080 )
(#cmppd #mmuRmImm8 "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r66000FC2 0 )
(#cmpps #mmuRmImm8 "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r00000FC2 0 )
(#cmpsd #mmuRmImm8 "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF2000FC2 0 )
(#cmpss #mmuRmImm8 "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF3000FC2 0 )
(#cmpxchg #rmr 0 0 "R" 0 "C1" 16r00000FB0 0 )
(#cmpxchg16b #mem "op1" 2r1000000 0 "R" 1 "C1" 16r00000FC7 "C2" 16r00000001 )
(#cmpxchg8b #mem "op1" 2r1000000 0 "R" 1 "C1" 16r00000FC7 0 )
(#comisd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r66000F2F 0 )
(#comiss #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r00000F2F 0 )
(#cpuid #emit 0 0 "R" 0 "C1" 16r00000FA2 0 )
(#crc32 #crc32 0 0 "R" 0 "C1" 16rF20F38F0 0 )
(#cvtdq2pd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF3000FE6 0 )
(#cvtdq2ps #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r00000F5B 0 )
(#cvtpd2dq #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF2000FE6 0 )
(#cvtpd2pi #mmurmi "op1" 2r10000 "op2" 2r1100000 "R" 0 "C1" 16r66000F2D 0 )
(#cvtpd2ps #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r66000F5A 0 )
(#cvtpi2pd #mmurmi "op1" 2r100000 "op2" 2r1010000 "R" 0 "C1" 16r66000F2A 0 )
(#cvtpi2ps #mmurmi "op1" 2r100000 "op2" 2r1010000 "R" 0 "C1" 16r00000F2A 0 )
(#cvtps2dq #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r66000F5B 0 )
(#cvtps2pd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r00000F5A 0 )
(#cvtps2pi #mmurmi "op1" 2r10000 "op2" 2r1100000 "R" 0 "C1" 16r00000F2D 0 )
(#cvtsd2si #mmurmi "op1" 2r1100 "op2" 2r1100000 "R" 0 "C1" 16rF2000F2D 0 )
(#cvtsd2ss #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF2000F5A 0 )
(#cvtsi2sd #mmurmi "op1" 2r100000 "op2" 2r1001100 "R" 0 "C1" 16rF2000F2A 0 )
(#cvtsi2ss #mmurmi "op1" 2r100000 "op2" 2r1001100 "R" 0 "C1" 16rF3000F2A 0 )
(#cvtss2sd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF3000F5A 0 )
(#cvtss2si #mmurmi "op1" 2r1100 "op2" 2r1100000 "R" 0 "C1" 16rF3000F2D 0 )
(#cvttpd2dq #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r66000FE6 0 )
(#cvttpd2pi #mmurmi "op1" 2r10000 "op2" 2r1100000 "R" 0 "C1" 16r66000F2C 0 )
(#cvttps2dq #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF3000F5B 0 )
(#cvttps2pi #mmurmi "op1" 2r10000 "op2" 2r1100000 "R" 0 "C1" 16r00000F2C 0 )
(#cvttsd2si #mmurmi "op1" 2r1100 "op2" 2r1100000 "R" 0 "C1" 16rF2000F2C 0 )
(#cvttss2si #mmurmi "op1" 2r1100 "op2" 2r1100000 "R" 0 "C1" 16rF3000F2C 0 )
(#daa #emit #x86 0 "R" 0 "C1" 16r00000027 0 )
(#das #emit #x86 0 "R" 0 "C1" 16r0000002F 0 )
(#dec #incdec 0 0 "R" 1 "C1" 16r00000048 "C2" 16r000000FE )
(#div #rm 0 0 "R" 6 "C1" 16r000000F6 0 )
(#divpd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r66000F5E 0 )
(#divps #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r00000F5E 0 )
(#divsd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF2000F5E 0 )
(#divss #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF3000F5E 0 )
(#dppd #mmuRmImm8 "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3A41 0 )
(#dpps #mmuRmImm8 "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3A40 0 )
(#emms #emit 0 0 "R" 0 "C1" 16r00000F77 0 )
(#enter #enter 0 0 "R" 0 "C1" 16r000000C8 0 )
(#extractps #mmuRmImm8 "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3A17 0 )
(#f2xm1 #emit 0 0 "R" 0 "C1" 16r0000D9F0 0 )
(#fabs #emit 0 0 "R" 0 "C1" 16r0000D9E1 0 )
(#fadd #x87fpu 0 0 "R" 0 "C1" 16rD8DCC0C0 0 )
(#faddp #x87sti 0 0 "R" 0 "C1" 16r0000DEC0 0 )
(#fbld #mem "op1" 2r1000000 0 "R" 4 "C1" 16r000000DF 0 )
(#fbstp #mem "op1" 2r1000000 0 "R" 6 "C1" 16r000000DF 0 )
(#fchs #emit 0 0 "R" 0 "C1" 16r0000D9E0 0 )
(#fclex #emit 0 0 "R" 0 "C1" 16r9B00DBE2 0 )
(#fcmovb #x87sti 0 0 "R" 0 "C1" 16r0000DAC0 0 )
(#fcmovbe #x87sti 0 0 "R" 0 "C1" 16r0000DAD0 0 )
(#fcmove #x87sti 0 0 "R" 0 "C1" 16r0000DAC8 0 )
(#fcmovnb #x87sti 0 0 "R" 0 "C1" 16r0000DBC0 0 )
(#fcmovnbe #x87sti 0 0 "R" 0 "C1" 16r0000DBD0 0 )
(#fcmovne #x87sti 0 0 "R" 0 "C1" 16r0000DBC8 0 )
(#fcmovnu #x87sti 0 0 "R" 0 "C1" 16r0000DBD8 0 )
(#fcmovu #x87sti 0 0 "R" 0 "C1" 16r0000DAD8 0 )
(#fcom #x87fpu 0 0 "R" 2 "C1" 16rD8DCD0D0 0 )
(#fcomi #x87sti 0 0 "R" 0 "C1" 16r0000DBF0 0 )
(#fcomip #x87sti 0 0 "R" 0 "C1" 16r0000DFF0 0 )
(#fcomp #x87fpu 0 0 "R" 3 "C1" 16rD8DCD8D8 0 )
(#fcompp #emit 0 0 "R" 0 "C1" 16r0000DED9 0 )
(#fcos #emit 0 0 "R" 0 "C1" 16r0000D9FF 0 )
(#fdecstp #emit 0 0 "R" 0 "C1" 16r0000D9F6 0 )
(#fdiv #x87fpu 0 0 "R" 6 "C1" 16rD8DCF0F8 0 )
(#fdivp #x87sti 0 0 "R" 0 "C1" 16r0000DEF8 0 )
(#fdivr #x87fpu 0 0 "R" 7 "C1" 16rD8DCF8F0 0 )
(#fdivrp #x87sti 0 0 "R" 0 "C1" 16r0000DEF0 0 )
(#ffree #x87sti 0 0 "R" 0 "C1" 16r0000DDC0 0 )
(#fiadd #x87mem "op1" 2r110 0 "R" 0 "C1" 16rDEDA0000 0 )
(#ficom #x87mem "op1" 2r110 0 "R" 2 "C1" 16rDEDA0000 0 )
(#ficomp #x87mem "op1" 2r110 0 "R" 3 "C1" 16rDEDA0000 0 )
(#fidiv #x87mem "op1" 2r110 0 "R" 6 "C1" 16rDEDA0000 0 )
(#fidivr #x87mem "op1" 2r110 0 "R" 7 "C1" 16rDEDA0000 0 )
(#fild #x87mem "op1" 2r1110 0 "R" 0 "C1" 16rDFDBDF05 0 )
(#fimul #x87mem "op1" 2r110 0 "R" 1 "C1" 16rDEDA0000 0 )
(#fincstp #emit 0 0 "R" 0 "C1" 16r0000D9F7 0 )
(#finit #emit 0 0 "R" 0 "C1" 16r9B00DBE3 0 )
(#fist #x87mem "op1" 2r110 0 "R" 2 "C1" 16rDFDB0000 0 )
(#fistp #x87mem "op1" 2r1110 0 "R" 3 "C1" 16rDFDBDF07 0 )
(#fisttp #x87mem "op1" 2r1110 0 "R" 1 "C1" 16rDFDBDD01 0 )
(#fisub #x87mem "op1" 2r110 0 "R" 4 "C1" 16rDEDA0000 0 )
(#fisubr #x87mem "op1" 2r110 0 "R" 5 "C1" 16rDEDA0000 0 )
(#fld #x87memSti "op1" 2r11100 0 "R" 0 "C1" 16r00D9DD00 "C2" 16rD9C0DB05 )
(#fld1 #emit 0 0 "R" 0 "C1" 16r0000D9E8 0 )
(#fldcw #mem "op1" 2r1000000 0 "R" 5 "C1" 16r000000D9 0 )
(#fldenv #mem "op1" 2r1000000 0 "R" 4 "C1" 16r000000D9 0 )
(#fldl2e #emit 0 0 "R" 0 "C1" 16r0000D9EA 0 )
(#fldl2t #emit 0 0 "R" 0 "C1" 16r0000D9E9 0 )
(#fldlg2 #emit 0 0 "R" 0 "C1" 16r0000D9EC 0 )
(#fldln2 #emit 0 0 "R" 0 "C1" 16r0000D9ED 0 )
(#fldpi #emit 0 0 "R" 0 "C1" 16r0000D9EB 0 )
(#fldz #emit 0 0 "R" 0 "C1" 16r0000D9EE 0 )
(#fmul #x87fpu 0 0 "R" 1 "C1" 16rD8DCC8C8 0 )
(#fmulp #x87sti 0 0 "R" 0 "C1" 16r0000DEC8 0 )
(#fnclex #emit 0 0 "R" 0 "C1" 16r0000DBE2 0 )
(#fninit #emit 0 0 "R" 0 "C1" 16r0000DBE3 0 )
(#fnop #emit 0 0 "R" 0 "C1" 16r0000D9D0 0 )
(#fnsave #mem "op1" 2r1000000 0 "R" 6 "C1" 16r000000DD 0 )
(#fnstcw #mem "op1" 2r1000000 0 "R" 7 "C1" 16r000000D9 0 )
(#fnstenv #mem "op1" 2r1000000 0 "R" 6 "C1" 16r000000D9 0 )
(#fnstsw #x87fstsw "op1" 2r1000000 0 "R" 7 "C1" 16r000000DD "C2" 16r0000DFE0 )
(#fpatan #emit 0 0 "R" 0 "C1" 16r0000D9F3 0 )
(#fprem #emit 0 0 "R" 0 "C1" 16r0000D9F8 0 )
(#fprem1 #emit 0 0 "R" 0 "C1" 16r0000D9F5 0 )
(#fptan #emit 0 0 "R" 0 "C1" 16r0000D9F2 0 )
(#frndint #emit 0 0 "R" 0 "C1" 16r0000D9FC 0 )
(#frstor #mem "op1" 2r1000000 0 "R" 4 "C1" 16r000000DD 0 )
(#fsave #mem "op1" 2r1000000 0 "R" 6 "C1" 16r9B0000DD 0 )
(#fscale #emit 0 0 "R" 0 "C1" 16r0000D9FD 0 )
(#fsin #emit 0 0 "R" 0 "C1" 16r0000D9FE 0 )
(#fsincos #emit 0 0 "R" 0 "C1" 16r0000D9FB 0 )
(#fsqrt #emit 0 0 "R" 0 "C1" 16r0000D9FA 0 )
(#fst #x87memSti "op1" 2r1100 0 "R" 2 "C1" 16r00D9DD02 "C2" 16rDDD00000 )
(#fstcw #mem "op1" 2r1000000 0 "R" 7 "C1" 16r9B0000D9 0 )
(#fstenv #mem "op1" 2r1000000 0 "R" 6 "C1" 16r9B0000D9 0 )
(#fstp #x87memSti "op1" 2r11100 0 "R" 3 "C1" 16r00D9DD03 "C2" 16rDDD8DB07 )
(#fstsw #x87fstsw "op1" 2r1000000 0 "R" 7 "C1" 16r9B0000DD "C2" 16r9B00DFE0 )
(#fsub #x87fpu 0 0 "R" 4 "C1" 16rD8DCE0E8 0 )
(#fsubp #x87sti 0 0 "R" 0 "C1" 16r0000DEE8 0 )
(#fsubr #x87fpu 0 0 "R" 5 "C1" 16rD8DCE8E0 0 )
(#fsubrp #x87sti 0 0 "R" 0 "C1" 16r0000DEE0 0 )
(#ftst #emit 0 0 "R" 0 "C1" 16r0000D9E4 0 )
(#fucom #x87sti 0 0 "R" 0 "C1" 16r0000DDE0 0 )
(#fucomi #x87sti 0 0 "R" 0 "C1" 16r0000DBE8 0 )
(#fucomip #x87sti 0 0 "R" 0 "C1" 16r0000DFE8 0 )
(#fucomp #x87sti 0 0 "R" 0 "C1" 16r0000DDE8 0 )
(#fucompp #emit 0 0 "R" 0 "C1" 16r0000DAE9 0 )
(#fwait #emit 0 0 "R" 0 "C1" 16r0000009B 0 )
(#fxam #emit 0 0 "R" 0 "C1" 16r0000D9E5 0 )
(#fxch #x87sti 0 0 "R" 0 "C1" 16r0000D9C8 0 )
(#fxrstor #mem 0 0 "R" 1 "C1" 16r00000FAE 0 )
(#fxsave #mem 0 0 "R" 0 "C1" 16r00000FAE 0 )
(#fxtract #emit 0 0 "R" 0 "C1" 16r0000D9F4 0 )
(#fyl2x #emit 0 0 "R" 0 "C1" 16r0000D9F1 0 )
(#fyl2xp1 #emit 0 0 "R" 0 "C1" 16r0000D9F9 0 )
(#haddpd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r66000F7C 0 )
(#haddps #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF2000F7C 0 )
(#hsubpd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r66000F7D 0 )
(#hsubps #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF2000F7D 0 )
(#idiv #rm 0 0 "R" 7 "C1" 16r000000F6 0 )
(#imul #imul 0 0 "R" 0 0 0 )
(#inc #incdec 0 0 "R" 0 "C1" 16r00000040 "C2" 16r000000FE )
(#int3 #emit 0 0 "R" 0 "C1" 16r000000CC 0 )
(#ja #cjmp 0 0 "R" 0 "C1" 16r00000007 0 )
(#jae #cjmp 0 0 "R" 0 "C1" 16r00000003 0 )
(#jb #cjmp 0 0 "R" 0 "C1" 16r00000002 0 )
(#jbe #cjmp 0 0 "R" 0 "C1" 16r00000006 0 )
(#jc #cjmp 0 0 "R" 0 "C1" 16r00000002 0 )
(#je #cjmp 0 0 "R" 0 "C1" 16r00000004 0 )
(#jg #cjmp 0 0 "R" 0 "C1" 16r0000000F 0 )
(#jge #cjmp 0 0 "R" 0 "C1" 16r0000000D 0 )
(#jl #cjmp 0 0 "R" 0 "C1" 16r0000000C 0 )
(#jle #cjmp 0 0 "R" 0 "C1" 16r0000000E 0 )
(#jmp #jmp 0 0 "R" 0 0 0 )
(#jna #cjmp 0 0 "R" 0 "C1" 16r00000006 0 )
(#jnae #cjmp 0 0 "R" 0 "C1" 16r00000002 0 )
(#jnb #cjmp 0 0 "R" 0 "C1" 16r00000003 0 )
(#jnbe #cjmp 0 0 "R" 0 "C1" 16r00000007 0 )
(#jnc #cjmp 0 0 "R" 0 "C1" 16r00000003 0 )
(#jne #cjmp 0 0 "R" 0 "C1" 16r00000005 0 )
(#jng #cjmp 0 0 "R" 0 "C1" 16r0000000E 0 )
(#jnge #cjmp 0 0 "R" 0 "C1" 16r0000000C 0 )
(#jnl #cjmp 0 0 "R" 0 "C1" 16r0000000D 0 )
(#jnle #cjmp 0 0 "R" 0 "C1" 16r0000000F 0 )
(#jno #cjmp 0 0 "R" 0 "C1" 16r00000001 0 )
(#jnp #cjmp 0 0 "R" 0 "C1" 16r0000000B 0 )
(#jns #cjmp 0 0 "R" 0 "C1" 16r00000009 0 )
(#jnz #cjmp 0 0 "R" 0 "C1" 16r00000005 0 )
(#jo #cjmp 0 0 "R" 0 0 0 )
(#jp #cjmp 0 0 "R" 0 "C1" 16r0000000A 0 )
(#jpe #cjmp 0 0 "R" 0 "C1" 16r0000000A 0 )
(#jpo #cjmp 0 0 "R" 0 "C1" 16r0000000B 0 )
(#js #cjmp 0 0 "R" 0 "C1" 16r00000008 0 )
(#jz #cjmp 0 0 "R" 0 "C1" 16r00000004 0 )
(#lddqu #mmurmi "op1" 2r100000 "op2" 2r1000000 "R" 0 "C1" 16rF2000FF0 0 )
(#ldmxcsr #mem "op1" 2r1000000 0 "R" 2 "C1" 16r00000FAE 0 )
(#lea #lea 0 0 "R" 0 0 0 )
(#leave #emit 0 0 "R" 0 "C1" 16r000000C9 0 )
(#lfence #emit 0 0 "R" 0 "C1" 16r000FAEE8 0 )
(#lock #emit 0 0 "R" 0 "C1" 16r000000F0 0 )
(#maskmovdqu #mmurmi "op1" 2r100000 "op2" 2r100000 "R" 0 "C1" 16r66000F57 0 )
(#maskmovq #mmurmi "op1" 2r10000 "op2" 2r10000 "R" 0 "C1" 16r00000FF7 0 )
(#maxpd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r66000F5F 0 )
(#maxps #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r00000F5F 0 )
(#maxsd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF2000F5F 0 )
(#maxss #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF3000F5F 0 )
(#mfence #emit 0 0 "R" 0 "C1" 16r000FAEF0 0 )
(#minpd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r66000F5D 0 )
(#minps #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r00000F5D 0 )
(#minsd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF2000F5D 0 )
(#minss #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF3000F5D 0 )
(#monitor #emit 0 0 "R" 0 "C1" 16r000F01C8 0 )
(#mov #mov 0 0 "R" 0 0 0 )
(#movPtr #movPtr 0 0 "R" 0 0 0 )
(#movapd #mmuMov "op1" 2r1100000 "op2" 2r1100000 "R" 0 "C1" 16r66000F28 "C2" 16r66000F29 )
(#movaps #mmuMov "op1" 2r1100000 "op2" 2r1100000 "R" 0 "C1" 16r00000F28 "C2" 16r00000F29 )
(#movbe #movbe "op1" 2r1001110 "op2" 2r1001110 "R" 0 "C1" 16r000F38F0 "C2" 16r000F38F1 )
(#movd #mmuMovD 0 0 "R" 0 0 0 )
(#movddup #mmuMov "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF2000F12 0 )
(#movdq2q #mmuMov "op1" 2r10000 "op2" 2r100000 "R" 0 "C1" 16rF2000FD6 0 )
(#movdqa #mmuMov "op1" 2r1100000 "op2" 2r1100000 "R" 0 "C1" 16r66000F6F "C2" 16r66000F7F )
(#movdqu #mmuMov "op1" 2r1100000 "op2" 2r1100000 "R" 0 "C1" 16rF3000F6F "C2" 16rF3000F7F )
(#movhlps #mmuMov "op1" 2r100000 "op2" 2r100000 "R" 0 "C1" 16r00000F12 0 )
(#movhpd #mmuMov "op1" 2r1100000 "op2" 2r1100000 "R" 0 "C1" 16r66000F16 "C2" 16r66000F17 )
(#movhps #mmuMov "op1" 2r1100000 "op2" 2r1100000 "R" 0 "C1" 16r00000F16 "C2" 16r00000F17 )
(#movlhps #mmuMov "op1" 2r100000 "op2" 2r100000 "R" 0 "C1" 16r00000F16 0 )
(#movlpd #mmuMov "op1" 2r1100000 "op2" 2r1100000 "R" 0 "C1" 16r66000F12 "C2" 16r66000F13 )
(#movlps #mmuMov "op1" 2r1100000 "op2" 2r1100000 "R" 0 "C1" 16r00000F12 "C2" 16r00000F13 )
(#movmskpd #mmuMov "op1" 2r1101 "op2" 2r100000 "R" 0 "C1" 16r66000F50 0 )
(#movmskps #mmuMov "op1" 2r1101 "op2" 2r100000 "R" 0 "C1" 16r00000F50 0 )
(#movntdq #mmuMov "op1" 2r1000000 "op2" 2r100000 "R" 0 0 "C2" 16r66000FE7 )
(#movntdqa #mmuMov "op1" 2r100000 "op2" 2r1000000 "R" 0 "C1" 16r660F382A 0 )
(#movnti #mmuMov "op1" 2r1000000 "op2" 2r1100 "R" 0 0 "C2" 16r00000FC3 )
(#movntpd #mmuMov "op1" 2r1000000 "op2" 2r100000 "R" 0 0 "C2" 16r66000F2B )
(#movntps #mmuMov "op1" 2r1000000 "op2" 2r100000 "R" 0 0 "C2" 16r00000F2B )
(#movntq #mmuMov "op1" 2r1000000 "op2" 2r10000 "R" 0 0 "C2" 16r00000FE7 )
(#movq #mmuMovQ 0 0 "R" 0 0 0 )
(#movq2dq #mmurmi "op1" 2r100000 "op2" 2r10000 "R" 0 "C1" 16rF3000FD6 0 )
(#movsd #mmuMov "op1" 2r1100000 "op2" 2r1100000 "R" 0 "C1" 16rF2000F10 "C2" 16rF2000F11 )
(#movshdup #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF3000F16 0 )
(#movsldup #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF3000F12 0 )
(#movss #mmuMov "op1" 2r1100000 "op2" 2r1100000 "R" 0 "C1" 16rF3000F10 "C2" 16rF3000F11 )
(#movsx #movSxZx 0 0 "R" 0 "C1" 16r00000FBE 0 )
(#movsxd #movsxd 0 0 "R" 0 0 0 )
(#movupd #mmuMov "op1" 2r1100000 "op2" 2r1100000 "R" 0 "C1" 16r66000F10 "C2" 16r66000F11 )
(#movups #mmuMov "op1" 2r1100000 "op2" 2r1100000 "R" 0 "C1" 16r00000F10 "C2" 16r00000F11 )
(#movzx #movSxZx 0 0 "R" 0 "C1" 16r00000FB6 0 )
(#mpsadbw #mmuRmImm8 "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3A42 0 )
(#mul #rm 0 0 "R" 4 "C1" 16r000000F6 0 )
(#mulpd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r66000F59 0 )
(#mulps #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF3000F59 0 )
(#mulsd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF2000F59 0 )
(#mulss #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF3000F59 0 )
(#mwait #emit 0 0 "R" 0 "C1" 16r000F01C9 0 )
(#neg #rm 0 0 "R" 3 "C1" 16r000000F6 0 )
(#nop #emit 0 0 "R" 0 "C1" 16r00000090 0 )
(#not #rm 0 0 "R" 2 "C1" 16r000000F6 0 )
(#or #alu 0 0 "R" 1 "C1" 16r00000008 "C2" 16r00000080 )
(#orpd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r66000F56 0 )
(#orps #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r00000F56 0 )
(#pabsb #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r000F381C 0 )
(#pabsd #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r000F381E 0 )
(#pabsw #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r000F381D 0 )
(#packssdw #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000F6B 0 )
(#packsswb #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000F63 0 )
(#packusdw #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F382B 0 )
(#packuswb #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000F67 0 )
(#paddb #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FFC 0 )
(#paddd #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FFE 0 )
(#paddq #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FD4 0 )
(#paddsb #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FEC 0 )
(#paddsw #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FED 0 )
(#paddusb #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FDC 0 )
(#paddusw #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FDD 0 )
(#paddw #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FFD 0 )
(#palignr #mmuRmImm8 "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r000F3A0F 0 )
(#pand #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FDB 0 )
(#pandn #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FDF 0 )
(#pause #emit 0 0 "R" 0 "C1" 16rF3000090 0 )
(#pavgb #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FE0 0 )
(#pavgw #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FE3 0 )
(#pblendvb #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3810 0 )
(#pblendw #mmuRmImm8 "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3A0E 0 )
(#pcmpeqb #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000F74 0 )
(#pcmpeqd #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000F76 0 )
(#pcmpeqq #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3829 0 )
(#pcmpeqw #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000F75 0 )
(#pcmpestri #mmuRmImm8 "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3A61 0 )
(#pcmpestrm #mmuRmImm8 "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3A60 0 )
(#pcmpgtb #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000F64 0 )
(#pcmpgtd #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000F66 0 )
(#pcmpgtq #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3837 0 )
(#pcmpgtw #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000F65 0 )
(#pcmpistri #mmuRmImm8 "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3A63 0 )
(#pcmpistrm #mmuRmImm8 "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3A62 0 )
(#pextrb #mmuPextr "op1" 2r1000101 "op2" 2r100000 "R" 0 "C1" 16r000F3A14 0 )
(#pextrd #mmuPextr "op1" 2r1000100 "op2" 2r100000 "R" 0 "C1" 16r000F3A16 0 )
(#pextrq #mmuPextr "op1" 2r1001100 "op2" 2r100000 "R" 1 "C1" 16r000F3A16 0 )
(#pextrw #mmuPextr "op1" 2r1000100 "op2" 2r110000 "R" 0 "C1" 16r000F3A16 0 )
(#pf2id #mmuRm3DNow "op1" 2r10000 "op2" 2r1010000 "R" 0 "C1" 16r00000F0F "C2" 16r0000001D )
(#pf2iw #mmuRm3DNow "op1" 2r10000 "op2" 2r1010000 "R" 0 "C1" 16r00000F0F "C2" 16r0000001C )
(#pfacc #mmuRm3DNow "op1" 2r10000 "op2" 2r1010000 "R" 0 "C1" 16r00000F0F "C2" 16r000000AE )
(#pfadd #mmuRm3DNow "op1" 2r10000 "op2" 2r1010000 "R" 0 "C1" 16r00000F0F "C2" 16r0000009E )
(#pfcmpeq #mmuRm3DNow "op1" 2r10000 "op2" 2r1010000 "R" 0 "C1" 16r00000F0F "C2" 16r000000B0 )
(#pfcmpge #mmuRm3DNow "op1" 2r10000 "op2" 2r1010000 "R" 0 "C1" 16r00000F0F "C2" 16r00000090 )
(#pfcmpgt #mmuRm3DNow "op1" 2r10000 "op2" 2r1010000 "R" 0 "C1" 16r00000F0F "C2" 16r000000A0 )
(#pfmax #mmuRm3DNow "op1" 2r10000 "op2" 2r1010000 "R" 0 "C1" 16r00000F0F "C2" 16r000000A4 )
(#pfmin #mmuRm3DNow "op1" 2r10000 "op2" 2r1010000 "R" 0 "C1" 16r00000F0F "C2" 16r00000094 )
(#pfmul #mmuRm3DNow "op1" 2r10000 "op2" 2r1010000 "R" 0 "C1" 16r00000F0F "C2" 16r000000B4 )
(#pfnacc #mmuRm3DNow "op1" 2r10000 "op2" 2r1010000 "R" 0 "C1" 16r00000F0F "C2" 16r0000008A )
(#pfpnacc #mmuRm3DNow "op1" 2r10000 "op2" 2r1010000 "R" 0 "C1" 16r00000F0F "C2" 16r0000008E )
(#pfrcp #mmuRm3DNow "op1" 2r10000 "op2" 2r1010000 "R" 0 "C1" 16r00000F0F "C2" 16r00000096 )
(#pfrcpit1 #mmuRm3DNow "op1" 2r10000 "op2" 2r1010000 "R" 0 "C1" 16r00000F0F "C2" 16r000000A6 )
(#pfrcpit2 #mmuRm3DNow "op1" 2r10000 "op2" 2r1010000 "R" 0 "C1" 16r00000F0F "C2" 16r000000B6 )
(#pfrsqit1 #mmuRm3DNow "op1" 2r10000 "op2" 2r1010000 "R" 0 "C1" 16r00000F0F "C2" 16r000000A7 )
(#pfrsqrt #mmuRm3DNow "op1" 2r10000 "op2" 2r1010000 "R" 0 "C1" 16r00000F0F "C2" 16r00000097 )
(#pfsub #mmuRm3DNow "op1" 2r10000 "op2" 2r1010000 "R" 0 "C1" 16r00000F0F "C2" 16r0000009A )
(#pfsubr #mmuRm3DNow "op1" 2r10000 "op2" 2r1010000 "R" 0 "C1" 16r00000F0F "C2" 16r000000AA )
(#phaddd #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r000F3802 0 )
(#phaddsw #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r000F3803 0 )
(#phaddw #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r000F3801 0 )
(#phminposuw #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3841 0 )
(#phsubd #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r000F3806 0 )
(#phsubsw #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r000F3807 0 )
(#phsubw #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r000F3805 0 )
(#pi2fd #mmuRm3DNow "op1" 2r10000 "op2" 2r1010000 "R" 0 "C1" 16r00000F0F "C2" 16r0000000D )
(#pi2fw #mmuRm3DNow "op1" 2r10000 "op2" 2r1010000 "R" 0 "C1" 16r00000F0F "C2" 16r0000000C )
(#pinsrb #mmuRmImm8 "op1" 2r100000 "op2" 2r1000100 "R" 0 "C1" 16r660F3A20 0 )
(#pinsrd #mmuRmImm8 "op1" 2r100000 "op2" 2r1000100 "R" 0 "C1" 16r660F3A22 0 )
(#pinsrq #mmuRmImm8 "op1" 2r100000 "op2" 2r1001000 "R" 0 "C1" 16r660F3A22 0 )
(#pinsrw #mmuRmImm8 "op1" 2r110000 "op2" 2r1000100 "R" 0 "C1" 16r00000FC4 0 )
(#pmaddubsw #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r000F3804 0 )
(#pmaddwd #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FF5 0 )
(#pmaxsb #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F383C 0 )
(#pmaxsd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F383D 0 )
(#pmaxsw #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FEE 0 )
(#pmaxub #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FDE 0 )
(#pmaxud #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F383F 0 )
(#pmaxuw #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F383E 0 )
(#pminsb #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3838 0 )
(#pminsd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3839 0 )
(#pminsw #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FEA 0 )
(#pminub #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FDA 0 )
(#pminud #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F383B 0 )
(#pminuw #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F383A 0 )
(#pmovmskb #mmurmi "op1" 2r1100 "op2" 2r110000 "R" 0 "C1" 16r00000FD7 0 )
(#pmovsxbd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3821 0 )
(#pmovsxbq #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3822 0 )
(#pmovsxbw #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3820 0 )
(#pmovsxdq #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3825 0 )
(#pmovsxwd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3823 0 )
(#pmovsxwq #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3824 0 )
(#pmovzxbd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3831 0 )
(#pmovzxbq #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3832 0 )
(#pmovzxbw #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3830 0 )
(#pmovzxdq #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3835 0 )
(#pmovzxwd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3833 0 )
(#pmovzxwq #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3834 0 )
(#pmuldq #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3828 0 )
(#pmulhrsw #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r000F380B 0 )
(#pmulhuw #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FE4 0 )
(#pmulhw #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FE5 0 )
(#pmulld #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3840 0 )
(#pmullw #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FD5 0 )
(#pmuludq #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FF4 0 )
(#pop #pop 0 0 "R" 0 "C1" 16r00000058 "C2" 16r0000008F )
(#popad #emit #x86 0 "R" 0 "C1" 16r00000061 0 )
(#popcnt #rrm 0 0 "R" 0 "C1" 16rF3000FB8 0 )
(#popfd #emit 0 0 "R" 0 "C1" 16r0000009D 0 )
(#popfq #emit 0 0 "R" 0 "C1" 16r4800009D 0 )
(#por #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FEB 0 )
(#prefetch #mmuPrefetch "op1" 2r1000000 "op2" 2r10000000 "R" 0 0 0 )
(#psadbw #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FF6 0 )
(#pshufb #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r000F3800 0 )
(#pshufd #mmuRmImm8 "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r66000F70 0 )
(#pshufhw #mmuRmImm8 "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF3000F70 0 )
(#pshuflw #mmuRmImm8 "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF2000F70 0 )
(#pshufw #mmuRmImm8 "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000F70 0 )
(#psignb #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r000F3808 0 )
(#psignd #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r000F380A 0 )
(#psignw #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r000F3809 0 )
(#pslld #mmurmi "op1" 2r110000 "op2" 2r11110000 "R" 6 "C1" 16r00000FF2 "C2" 16r00000F72 )
(#pslldq #mmurmi "op1" 2r100000 "op2" 2r10000000 "R" 7 0 "C2" 16r66000F73 )
(#psllq #mmurmi "op1" 2r110000 "op2" 2r11110000 "R" 6 "C1" 16r00000FF3 "C2" 16r00000F73 )
(#psllw #mmurmi "op1" 2r110000 "op2" 2r11110000 "R" 6 "C1" 16r00000FF1 "C2" 16r00000F71 )
(#psrad #mmurmi "op1" 2r110000 "op2" 2r11110000 "R" 4 "C1" 16r00000FE2 "C2" 16r00000F72 )
(#psraw #mmurmi "op1" 2r110000 "op2" 2r11110000 "R" 4 "C1" 16r00000FE1 "C2" 16r00000F71 )
(#psrld #mmurmi "op1" 2r110000 "op2" 2r11110000 "R" 2 "C1" 16r00000FD2 "C2" 16r00000F72 )
(#psrldq #mmurmi "op1" 2r100000 "op2" 2r10000000 "R" 3 0 "C2" 16r66000F73 )
(#psrlq #mmurmi "op1" 2r110000 "op2" 2r11110000 "R" 2 "C1" 16r00000FD3 "C2" 16r00000F73 )
(#psrlw #mmurmi "op1" 2r110000 "op2" 2r11110000 "R" 2 "C1" 16r00000FD1 "C2" 16r00000F71 )
(#psubb #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FF8 0 )
(#psubd #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FFA 0 )
(#psubq #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FFB 0 )
(#psubsb #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FE8 0 )
(#psubsw #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FE9 0 )
(#psubusb #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FD8 0 )
(#psubusw #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FD9 0 )
(#psubw #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FF9 0 )
(#pswapd #mmuRm3DNow "op1" 2r10000 "op2" 2r1010000 "R" 0 "C1" 16r00000F0F "C2" 16r000000BB )
(#ptest #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3817 0 )
(#punpckhbw #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000F68 0 )
(#punpckhdq #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000F6A 0 )
(#punpckhqdq #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r66000F6D 0 )
(#punpckhwd #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000F69 0 )
(#punpcklbw #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000F60 0 )
(#punpckldq #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000F62 0 )
(#punpcklqdq #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r66000F6C 0 )
(#punpcklwd #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000F61 0 )
(#push #push 0 0 "R" 6 "C1" 16r00000050 "C2" 16r000000FF )
(#pushad #emit #x86 0 "R" 0 "C1" 16r00000060 0 )
(#pushf #emit 0 0 "R" 0 "C1" 16r6600009C 0 )
(#pushfd #emit #x86 0 "R" 0 "C1" 16r0000009C 0 )
(#pushfq #emit #x64 0 "R" 0 "C1" 16r0000009C 0 )
(#pxor #mmurmi "op1" 2r110000 "op2" 2r1110000 "R" 0 "C1" 16r00000FEF 0 )
(#rcl #rot 0 0 "R" 2 0 0 )
(#rcpps #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r00000F53 0 )
(#rcpss #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF3000F53 0 )
(#rcr #rot 0 0 "R" 3 0 0 )
(#rdtsc #emit 0 0 "R" 0 "C1" 16r00000F31 0 )
(#rdtscp #emit 0 0 "R" 0 "C1" 16r000F01F9 0 )
(#ret #ret 0 0 "R" 0 0 0 )
(#rol #rot 0 0 "R" 0 0 0 )
(#ror #rot 0 0 "R" 1 0 0 )
(#roundpd #mmuRmImm8 "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3A09 0 )
(#roundps #mmuRmImm8 "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3A08 0 )
(#roundsd #mmuRmImm8 "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3A0B 0 )
(#roundss #mmuRmImm8 "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r660F3A0A 0 )
(#rsqrtps #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r00000F52 0 )
(#rsqrtss #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF3000F52 0 )
(#sahf #emit 0 0 "R" 0 "C1" 16r0000009E 0 )
(#sal #rot 0 0 "R" 4 0 0 )
(#sar #rot 0 0 "R" 7 0 0 )
(#sbb #alu 0 0 "R" 3 "C1" 16r00000018 "C2" 16r00000080 )
(#sfence #emit 0 0 "R" 0 "C1" 16r000FAEF8 0 )
(#shl #rot 0 0 "R" 4 0 0 )
(#shld #shldShrd 0 0 "R" 0 "C1" 16r00000FA4 0 )
(#shr #rot 0 0 "R" 5 0 0 )
(#shrd #shldShrd 0 0 "R" 0 "C1" 16r00000FAC 0 )
(#shufps #mmuRmImm8 "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r00000FC6 0 )
(#sqrtpd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r66000F51 0 )
(#sqrtps #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r00000F51 0 )
(#sqrtsd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF2000F51 0 )
(#sqrtss #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF3000F51 0 )
(#stc #emit 0 0 "R" 0 "C1" 16r000000F9 0 )
(#stmxcsr #mem "op1" 2r1000000 0 "R" 3 "C1" 16r00000FAE 0 )
(#sub #alu 0 0 "R" 5 "C1" 16r00000028 "C2" 16r00000080 )
(#subpd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r66000F5C 0 )
(#subps #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r00000F5C 0 )
(#subsd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF2000F5C 0 )
(#subss #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF3000F5C 0 )
(#syscall #emit "op1" 2r100000000 0 "R" 0 "C1" 16r00000F05 0 )
(#test #test 0 0 "R" 0 0 0 )
(#ucomisd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r66000F2E 0 )
(#ucomiss #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r00000F2E 0 )
(#ud2 #emit 0 0 "R" 0 "C1" 16r00000F0B 0 )
(#unpckhpd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r66000F15 0 )
(#unpckhps #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r00000F15 0 )
(#unpcklpd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r66000F14 0 )
(#unpcklps #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r00000F14 0 )
(#xadd #rmr 0 0 "R" 0 "C1" 16r00000FC0 0 )
(#xchg #xchg 0 0 "R" 0 0 0 )
(#xor #alu 0 0 "R" 6 "C1" 16r00000030 "C2" 16r00000080 )
(#xorpd #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r66000F57 0 )
(#xorps #mmurmi "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16r00000F57 0 )

)
! !

!AJx86InstructionDescription class methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 6/26/2014 12:47'!
instructionsAmbiguous
	"These instructions have differing meaning based on arguments. We drew the short straw, and the other versions group emitter decides whether we were in fact the intended target"
	^#("Disambiguated using emitsddisambiguate:"
		(#movsd #mmuMov "op1" 2r1100000 "op2" 2r1100000 "R" 0 "C1" 16rF2000F10 "C2" 16rF2000F11 )
		(#cmpsd #mmuRmImm8 "op1" 2r100000 "op2" 2r1100000 "R" 0 "C1" 16rF2000FC2 0 ))! !

!AJx86InstructionDescription class methodsFor: 'instance creation' stamp: 'CamilloBruni 4/13/2012 14:30'!
fromArray: aSpecArray
	^ self basicNew
		fromArray: aSpecArray! !

!AJx86InstructionDescription class methodsFor: 'initialization' stamp: ''!
instructionsCDQ

"CBW/CWDE/CDQE Convert Byte to Word/Convert Word to
Doubleword/Convert Doubleword to Quadword"
^#(

(#cbw #emit 0 0 "R" 0 "C1" 16r66000098 0 )
(#cwde #emit 0 0 "R" 0 "C1" 16r00000098 0 )
(#cdqe #emit #x64 0 "R" 0 "C1" 16r48000098 0 )

"CWD/CDQ/CQO Convert Word to Doubleword/Convert Doubleword to
Quadword"

(#cwd #emit 0 0 "R" 0 "C1" 16r66000099 0 )
(#cdq #emit 0 0 "R" 0 "C1" 16r00000099 0 )
(#cqo #emit #x64 0 "R" 0 "C1" 16r48000099 0 )

)! !

!AJx86InstructionDescription class methodsFor: 'testing' stamp: ''!
checkInstructionsIntegrity

	" self checkInstructionsIntegrity"
	| data |
	
	data := self instructionData.
	
	data do: [:dt | | instr |
		
		instr := instructions at: dt first.

		self assert: [
			(instr name = (dt at: 1)) &
			(instr group = (dt at: 2)) &
			(instr o1Flags = (dt at:3)) &
			(instr o2Flags = (dt at:4)) &
			(instr opCodeR = (dt at:5)) &
			(instr opCode1 = (dt at:6)) &
			(instr opCode2 = (dt at:7)) 
		].
	].

! !

!AJx86JumpInstruction commentStamp: 'TorstenBergmann 1/30/2014 09:18'!
Jump instruction for X86!
!AJx86JumpInstruction methodsFor: 'emitting code' stamp: ''!
emitLongJump: desc target: target
	| addr sz nextInstruction |
	
	sz := self isConditional
		ifTrue: [ 2 ]
		ifFalse: [ 1 ].
		
	nextInstruction := position + 4 + sz.
	addr := (AJImmediate ivalue: target - nextInstruction) asDWord.
	
	^ self isConditional
		ifFalse: [ self emitUnconditionalJumpTo: addr ]
		ifTrue: [ 	self emitConditionalJump: addr to: desc ]! !

!AJx86JumpInstruction methodsFor: 'accessing' stamp: 'CamilloBruni 8/23/2012 16:01'!
instructionDesciptions
	^ AJx86InstructionDescription instructions! !

!AJx86JumpInstruction methodsFor: 'emitting code' stamp: ''!
emitShortJump: desc offset: delta
	"short jump"
	^ self isConditional
		ifTrue: [ {(16r70 + desc opCode1). (delta asByte)} asByteArray ]
		ifFalse: [ {16rEB. (delta asByte)} asByteArray ]! !

!AJx86JumpInstruction methodsFor: 'testing' stamp: ''!
isConditional
	^ name ~~ #jmp! !

!AJx86JumpInstruction methodsFor: 'emitting code' stamp: ''!
emitConditionalJump: addr to: desc
	^ {16r0F.
	(16r80 + desc opCode1).
	(addr bitAnd: 255).
	(addr >> 8 bitAnd: 255).
	(addr >> 16 bitAnd: 255).
	(addr >> 24 bitAnd: 255)} asByteArray! !

!AJx86JumpInstruction methodsFor: 'emitting code' stamp: 'CamilloBruni 8/22/2012 14:34'!
emitCode: asm
	"generate opcodes"

	| delta code nextInstruction target desc |
	
	target := label position.
	target ifNil: [ ^ machineCode := nil ].
	
	nextInstruction := position + 2.
	delta := (target - nextInstruction) asImm.
	desc := self instructionDesciptions at: name.	"can we use 8bit offset?"
	machineCode := delta isInt8
		ifTrue: [ 	self emitShortJump: desc offset: delta ]
		ifFalse: [ self emitLongJump: desc target: target ]! !

!AJx86JumpInstruction methodsFor: 'accessing' stamp: ''!
machineCodeSize

	machineCode ifNil: [ ^ 2 ].
	
	^ machineCode size! !

!AJx86JumpInstruction methodsFor: 'emitting code' stamp: 'CamilloBruni 8/22/2012 18:07'!
emitCodeAtOffset: offset assembler: asm
	
	position := offset.
	[ | labelPos | 
		labelPos := label position.
		labelPos ifNotNil: [ self emitCode: asm ].
		next ifNotNil: [ 
			next emitCodeAtOffset: offset + self machineCodeSize assembler: asm ].
		label position ~= labelPos ] whileTrue.
	
	label position ifNil: [ self errorUndefinedLabel: label  ]! !

!AJx86JumpInstruction methodsFor: 'convenience' stamp: 'CamilloBruni 8/22/2012 18:07'!
errorUndefinedLabel: aLabel 

	^ self error: 'undefined label: ', aLabel name! !

!AJx86JumpInstruction methodsFor: 'emitting code' stamp: ''!
emitUnconditionalJumpTo: addr
	^ {
	16rE9.
	(addr bitAnd: 255).
	(addr >> 8 bitAnd: 255).
	(addr >> 16 bitAnd: 255).
	(addr >> 24 bitAnd: 255)} asByteArray! !

!AJx86JumpInstruction methodsFor: 'accessing' stamp: ''!
codeSize 
	machineCode ifNil: [  ^ 2 ].
	^ machineCode size! !

!AJx86RegisterTests commentStamp: 'TorstenBergmann 2/4/2014 21:38'!
SUnit tests for x86 registers!
!AJx86RegisterTests methodsFor: 'as yet unclassified' stamp: 'MartinMcClure 1/30/2013 21:56'!
testAsHighByte
	| highByteRegs lowByteRegs otherGPRegs |
	highByteRegs := {AH.
	CH.
	DH.
	BH}.
	lowByteRegs := {AL.
	CL.
	DL.
	BL}.
	otherGPRegs := AJx86Registers generalPurpose reject: [ :r | r isHighByte | r isLowByte ].
	self assert: (highByteRegs collect: [ :r | r asHighByte ]) equals: highByteRegs.
	self assert: (lowByteRegs collect: [ :r | r asHighByte ]) equals: highByteRegs.
	self assert: otherGPRegs size equals: 60.	"16 of each size, less the lowByteRegs"
	otherGPRegs do: [ :r | self should: [ r asHighByte ] raise: Error ]! !

!AJx86RegisterTests methodsFor: 'as yet unclassified' stamp: 'MartinMcClure 1/30/2013 19:40'!
testRegisterWidthConversions
	"Test the generalPurpose register methods #as8, #as16, #as32, #as64. 
	Some resulting registers are not valid except in 64-bit mode, but that is not checked until you try to use the register in an instruction."

	| regs8 regs16 regs32 regs64 highByteRegs |
	regs8 := {AL.
	CL.
	DL.
	BL.
	SPL.
	BPL.
	SIL.
	DIL.
	R8B.
	R9B.
	R10B.
	R11B.
	R12B.
	R13B.
	R14B.
	R15B}.
	regs16 := {AX.
	CX.
	DX.
	BX.
	SP.
	BP.
	SI.
	DI.
	R8W.
	R9W.
	R10W.
	R11W.
	R12W.
	R13W.
	R14W.
	R15W}.
	regs32 := {EAX.
	ECX.
	EDX.
	EBX.
	ESP.
	EBP.
	ESI.
	EDI.
	R8D.
	R9D.
	R10D.
	R11D.
	R12D.
	R13D.
	R14D.
	R15D}.
	regs64 := {RAX.
	RCX.
	RDX.
	RBX.
	RSP.
	RBP.
	RSI.
	RDI.
	R8.
	R9.
	R10.
	R11.
	R12.
	R13.
	R14.
	R15}.
	highByteRegs := {AH.
	CH.
	DH.
	BH}.
	self
		assert: (regs8 collect: [ :r | r as8 ]) equals: regs8;
		assert: (regs16 collect: [ :r | r as8 ]) equals: regs8;
		assert: (regs32 collect: [ :r | r as8 ]) equals: regs8;
		assert: (regs64 collect: [ :r | r as8 ]) equals: regs8.
	self
		assert: (regs8 collect: [ :r | r as16 ]) equals: regs16;
		assert: (regs16 collect: [ :r | r as16 ]) equals: regs16;
		assert: (regs32 collect: [ :r | r as16 ]) equals: regs16;
		assert: (regs64 collect: [ :r | r as16 ]) equals: regs16.
	self
		assert: (regs8 collect: [ :r | r as32 ]) equals: regs32;
		assert: (regs16 collect: [ :r | r as32 ]) equals: regs32;
		assert: (regs32 collect: [ :r | r as32 ]) equals: regs32;
		assert: (regs64 collect: [ :r | r as32 ]) equals: regs32.
	self
		assert: (regs8 collect: [ :r | r as64 ]) equals: regs64;
		assert: (regs16 collect: [ :r | r as64 ]) equals: regs64;
		assert: (regs32 collect: [ :r | r as64 ]) equals: regs64;
		assert: (regs64 collect: [ :r | r as64 ]) equals: regs64.
	self
		assert: (highByteRegs collect: [ :r | r as8 ]) equals: highByteRegs;
		assert: (highByteRegs collect: [ :r | r as16 ])
			equals:
				{AX.
					CX.
					DX.
					BX};
		assert: (highByteRegs collect: [ :r | r as32 ])
			equals:
				{EAX.
					ECX.
					EDX.
					EBX};
		assert: (highByteRegs collect: [ :r | r as64 ])
			equals:
				{RAX.
					RCX.
					RDX.
					RBX}! !

!AJx86RegisterTests methodsFor: 'as yet unclassified' stamp: 'MartinMcClure 1/30/2013 21:57'!
testAsLowByte
	| highByteRegs lowByteRegs otherGPRegs |
	highByteRegs := {AH.
	CH.
	DH.
	BH}.
	lowByteRegs := {AL.
	CL.
	DL.
	BL}.
	otherGPRegs := AJx86Registers generalPurpose reject: [ :r | r isHighByte | r isLowByte ].
	self assert: (highByteRegs collect: [ :r | r asLowByte ]) equals: lowByteRegs.
	self assert: (lowByteRegs collect: [ :r | r asLowByte ]) equals: lowByteRegs.
	self assert: otherGPRegs size equals: 60.	"16 of each size, less the lowByteRegs"
	otherGPRegs do: [ :r | self should: [ r asLowByte ] raise: Error ]! !

!AJx86Registers commentStamp: '<historical>'!
I am a SHaredPool which initializes all the registers needed by the Assmbler.!
!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
MM7
	"An MMX register"
	^ self at: #MM7! !

!AJx86Registers class methodsFor: 'initialization' stamp: 'CamilloBruni 3/20/2012 18:45'!
registerBase: base class: regClass values: names

	| val |
	val := base.
	names do: [ :regName | | reg |
		reg := regClass code: val name: regName.
		self classPool at: regName put: reg. 
		Codes at: val put: regName.
		val := val + 1].
! !

!AJx86Registers class methodsFor: 'accessing' stamp: ''!
all8
	^ self all select: [:reg| reg is8 ]! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
ESP
	"A 32bit general purpose register
	This register overlaps with AH, AX, EAX, RAX"
	^ self at: #ESP! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
ESI
	"A 32bit general purpose register
	This register overlaps with DH, DX, EDX, RDX"
	^ self at: #ESI! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
CL
	"A 8bit general purpose register
	This register overlaps with CL, CX, ECX, RCX"
	^ self at: #CL! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R14B
	"A 8bit general purpose register
	This register overlaps with R14B, R14W, R14D, R14"
	^ self at: #R14B! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R9D
	"A 32bit general purpose register
	This register overlaps with R9B, R9W, R9D, R9"
	^ self at: #R9D! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
XMM9
	"An SSE register"
	^ self at: #XMM9! !

!AJx86Registers class methodsFor: 'initialization' stamp: 'MartinMcClure 1/27/2013 14:46'!
initialize
	"AJx86Registers initialize"
		
	self classPool at: #Codes put: IdentityDictionary new. 
	
	self initializeGeneralPurpose8BitRegisters.
	self initializeGeneralPurpose16BitRegisters.
	self initializeGeneralPurpose32BitRegisters.
	self initializeGeneralPurpose64BitRegisters.
	
	self initializeInstructionPointerRegisters.
	
	self initializeX87Registers.
	self initializeMMXRegisters.
	self initializeSSERegisters.! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
R11
	"A 64bit general purpose register
	This register overlaps with R11B, R11W, R11D, R11"
	^ self at: #R11! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
R12D
	"A 32bit general purpose register
	This register overlaps with R12B, R12W, R12D, R12"
	^ self at: #R12D! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R10W
	"A 16bit general purpose register
	This register overlaps with R10B, R10W, R10D, R10"
	^ self at: #R10W! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
RDX
	"A 64bit general purpose register
	This register overlaps with DL, DX, EDX, RDX"
	^ self at: #RDX! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
XMM13
	"An SSE register"
	^ self at: #XMM13! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
R8B
	"A 8bit general purpose register
	This register overlaps with R8B, R8W, R8D, R8"
	^ self at: #R8B! !

!AJx86Registers class methodsFor: 'accessing' stamp: ''!
all16
	^ self all select: [:reg| reg is16 ]! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
RDI
	"A 64bit general purpose register
	This register overlaps with BH, BX, EBX, RBX"
	^ self at: #RDI! !

!AJx86Registers class methodsFor: 'accessing' stamp: 'MarcusDenker 5/7/2013 15:27'!
code: registerCode
	"Access a register by its code.
	Example:
		RBP == (self code: RBP code)"
	| registerName |
	self flag: 'XXX now this is some ugly code... add an instance variable for the requiresRex boolean instead of encoding it in #code'.
	registerName := Codes at: registerCode ifAbsent: [ 
				Codes at: registerCode + 16r100 ifAbsent: [ 
					Codes at: registerCode + 16r200 ifAbsent: [  KeyNotFound signalFor: registerCode ] ] ].
	^ self classPool at: registerName! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
XMM8
	"An SSE register"
	^ self at: #XMM8! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
IP
	"A 16bit instruction pointer register
	This register overlaps with IP, EIP, RIP"
	^ self at: #IP! !

!AJx86Registers class methodsFor: 'method compilation' stamp: 'CamilloBruni 7/17/2012 11:27'!
printRegister: register descriptionOn: s

	s nextPut: $".
	register descriptionOn: s.
	register influencingRegisters ifNotEmpty: [ :registers|
		s crtab nextPutAll: 'This register overlaps with '.
		registers do: [ :reg| s nextPutAll: reg name ] separatedBy: [ s nextPutAll: ', ']].
	s nextPut: $"! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
XMM1
	"An SSE register"
	^ self at: #XMM1! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
MM4
	"An MMX register"
	^ self at: #MM4! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
XMM14
	"An SSE register"
	^ self at: #XMM14! !

!AJx86Registers class methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2012 11:04'!
initializeInstructionPointerRegisters
	| ip eip rip |
	
	ip := AJx64RipRegister code: SI code name: #IP.
	eip := AJx64RipRegister code: ESI code name: #EIP.
	rip := AJx64RipRegister code: RSI code name: #RIP.
	
	Codes 
		at: SI code negated put: #IP;
		at: ESI code negated put: #EIP;
		at: RSI code negated put: #RIP.
	
	self classPool 
		at: #IP put: ip;
		at: #EIP put: eip;
		at: #RIP put: rip.! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
XMM15
	"An SSE register"
	^ self at: #XMM15! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
R13B
	"A 8bit general purpose register
	This register overlaps with R13B, R13W, R13D, R13"
	^ self at: #R13B! !

!AJx86Registers class methodsFor: 'accessing' stamp: ''!
generalPurpose
	^ self all select: [ :reg| reg isGeneralPurpose ]! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R14W
	"A 16bit general purpose register
	This register overlaps with R14B, R14W, R14D, R14"
	^ self at: #R14W! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
DH
	"A 8bit general purpose register
	This register overlaps with DH, DX, EDX, RDX"
	^ self at: #DH! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
AH
	"A 8bit general purpose register
	This register overlaps with AH, AX, EAX, RAX"
	^ self at: #AH! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
R15
	"A 64bit general purpose register
	This register overlaps with R15B, R15W, R15D, R15"
	^ self at: #R15! !

!AJx86Registers class methodsFor: 'method compilation' stamp: 'CamilloBruni 7/17/2012 11:14'!
installRegisterAccessors
	"this method creates simple accessors for all registers"

	| registerAccessorsCategory |
	
	registerAccessorsCategory := 'accessing registers'.	
	
	"remove all methods in the 'accessing register' category"
	self class methodDict values
		select: [ :method | method category = registerAccessorsCategory ]
		thenDo: [ :method | self class removeSelector: method selector ].
		
	self all 
		do: [ :register | | method |
			"install the direct accessor on this class"
			self installRegister: register accessorCategory: registerAccessorsCategory.
			"install the accessor on the assembler"
			self 
				installRegister: register 
				accessorCategory: registerAccessorsCategory
				on: (register isX86 ifTrue: [ AJx86Assembler ]  ifFalse: [ AJx64Assembler ])]
		displayingProgress: [ :each| each name ].! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
XMM3
	"An SSE register"
	^ self at: #XMM3! !

!AJx86Registers class methodsFor: 'accessing' stamp: ''!
doesNotUnderstand: aMessage
	self classPool at: aMessage selector ifPresent: [:val| ^ val ].
	^ super doesNotUnderstand: aMessage! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R14D
	"A 32bit general purpose register
	This register overlaps with R14B, R14W, R14D, R14"
	^ self at: #R14D! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R13D
	"A 32bit general purpose register
	This register overlaps with R13B, R13W, R13D, R13"
	^ self at: #R13D! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
SP
	"A 16bit general purpose register
	This register overlaps with AH, AX, EAX, RAX"
	^ self at: #SP! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R10
	"A 64bit general purpose register
	This register overlaps with R10B, R10W, R10D, R10"
	^ self at: #R10! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
ST4
	"A floating point register"
	^ self at: #ST4! !

!AJx86Registers class methodsFor: 'accessing' stamp: ''!
generalPurpose8
	^ self sortRegistersByIndex: (self generalPurpose select: [:reg| reg is8 ])! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
ST7
	"A floating point register"
	^ self at: #ST7! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
XMM2
	"An SSE register"
	^ self at: #XMM2! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
BX
	"A 16bit general purpose register
	This register overlaps with BL, BX, EBX, RBX"
	^ self at: #BX! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
ST5
	"A floating point register"
	^ self at: #ST5! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R13
	"A 64bit general purpose register
	This register overlaps with R13B, R13W, R13D, R13"
	^ self at: #R13! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
ST3
	"A floating point register"
	^ self at: #ST3! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R15B
	"A 8bit general purpose register
	This register overlaps with R15B, R15W, R15D, R15"
	^ self at: #R15B! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
R9B
	"A 8bit general purpose register
	This register overlaps with R9B, R9W, R9D, R9"
	^ self at: #R9B! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
BL
	"A 8bit general purpose register
	This register overlaps with BL, BX, EBX, RBX"
	^ self at: #BL! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
AL
	"A 8bit general purpose register
	This register overlaps with AL, AX, EAX, RAX"
	^ self at: #AL! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
CX
	"A 16bit general purpose register
	This register overlaps with CL, CX, ECX, RCX"
	^ self at: #CX! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
BH
	"A 8bit general purpose register
	This register overlaps with BH, BX, EBX, RBX"
	^ self at: #BH! !

!AJx86Registers class methodsFor: 'method compilation' stamp: 'CamilloBruni 7/17/2012 11:28'!
installRegister: register accessorCategory: registerAccessorsCategory

	^ self class
		compile:(String streamContents: [ :s | 
			s nextPutAll: register name; crtab.
			self printRegister: register descriptionOn: s.
			s crtab; nextPutAll: '^ self at: #'; nextPutAll: register name ])
		classified: registerAccessorsCategory! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
R12W
	"A 16bit general purpose register
	This register overlaps with R12B, R12W, R12D, R12"
	^ self at: #R12W! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R9
	"A 64bit general purpose register
	This register overlaps with R9B, R9W, R9D, R9"
	^ self at: #R9! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
RCX
	"A 64bit general purpose register
	This register overlaps with CL, CX, ECX, RCX"
	^ self at: #RCX! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
RIP
	"A 64bit instruction pointer register
	This register overlaps with IP, EIP, RIP"
	^ self at: #RIP! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
ST1
	"A floating point register"
	^ self at: #ST1! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R10B
	"A 8bit general purpose register
	This register overlaps with R10B, R10W, R10D, R10"
	^ self at: #R10B! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
AX
	"A 16bit general purpose register
	This register overlaps with AL, AX, EAX, RAX"
	^ self at: #AX! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
ECX
	"A 32bit general purpose register
	This register overlaps with CL, CX, ECX, RCX"
	^ self at: #ECX! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
XMM7
	"An SSE register"
	^ self at: #XMM7! !

!AJx86Registers class methodsFor: 'accessing' stamp: ''!
all64
	^ self all select: [:reg| reg is64 ]! !

!AJx86Registers class methodsFor: 'initialization' stamp: ''!
initializeMMXRegisters

	" MMX registers "
	self registerBase: 16r60  class: AJMMRegister values: #(
		#MM0 #MM1   #MM2   #MM3   #MM4   #MM5   #MM6   #MM7 ).! !

!AJx86Registers class methodsFor: 'initialization' stamp: 'MartinMcClure 1/27/2013 10:06'!
initializeGeneralPurpose8BitRegisters
	"general purpose 8 bit registers "

	self
		registerBase: 0
			class: AJx86GPRegister
			rex: #dontCare
			values: #(#AL #CL #DL #BL);
		registerBase: 4
			class: AJx86GPRegister
			rex: #prohibited
			values: #(#AH #CH #DH #BH);
		registerBase: 4
			class: AJx86GPRegister
			rex: #required
			values: #(#SPL #BPL #SIL #DIL #R8B #R9B #R10B #R11B #R12B #R13B #R14B #R15B)! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
DI
	"A 16bit general purpose register
	This register overlaps with BH, BX, EBX, RBX"
	^ self at: #DI! !

!AJx86Registers class methodsFor: 'accessing' stamp: ''!
generalPurpose16
	^ self sortRegistersByIndex: (self generalPurpose select: [:reg| reg is16 ])! !

!AJx86Registers class methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2012 11:10'!
initializeSSERegisters
	" SSE registers "
	self registerBase: 16r70 class: AJxMMRegister  values: #(
		#XMM0 #XMM1  #XMM2  #XMM3  #XMM4  #XMM5  #XMM6  #XMM7 
		#XMM8 #XMM9  #XMM10 #XMM11 #XMM12 #XMM13 #XMM14 #XMM15).! !

!AJx86Registers class methodsFor: 'initialization' stamp: 'MartinMcClure 1/27/2013 09:56'!
registerBase: base class: regClass rex: rexSymbol values: names 
	| val |
	val := 0.
	rexSymbol == #required
		ifTrue: [ val := 16r100 ].
	rexSymbol == #prohibited
		ifTrue: [ val := 16r200 ].
	val := val + base.
	names
		do: [ :regName | 
			| reg |
			reg := regClass code: val name: regName.
			self classPool at: regName put: reg.
			Codes at: val put: regName.
			val := val + 1 ]! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R15W
	"A 16bit general purpose register
	This register overlaps with R15B, R15W, R15D, R15"
	^ self at: #R15W! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
EDI
	"A 32bit general purpose register
	This register overlaps with BH, BX, EBX, RBX"
	^ self at: #EDI! !

!AJx86Registers class methodsFor: 'accessing' stamp: ''!
generalPurpose32
	^ self sortRegistersByIndex: (self generalPurpose select: [:reg| reg is32 ])! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
R11D
	"A 32bit general purpose register
	This register overlaps with R11B, R11W, R11D, R11"
	^ self at: #R11D! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
R8
	"A 64bit general purpose register
	This register overlaps with R8B, R8W, R8D, R8"
	^ self at: #R8! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
ST6
	"A floating point register"
	^ self at: #ST6! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
XMM12
	"An SSE register"
	^ self at: #XMM12! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
R12
	"A 64bit general purpose register
	This register overlaps with R12B, R12W, R12D, R12"
	^ self at: #R12! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
R8D
	"A 32bit general purpose register
	This register overlaps with R8B, R8W, R8D, R8"
	^ self at: #R8D! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R10D
	"A 32bit general purpose register
	This register overlaps with R10B, R10W, R10D, R10"
	^ self at: #R10D! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
XMM0
	"An SSE register"
	^ self at: #XMM0! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
R8W
	"A 16bit general purpose register
	This register overlaps with R8B, R8W, R8D, R8"
	^ self at: #R8W! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
BP
	"A 16bit general purpose register
	This register overlaps with CH, CX, ECX, RCX"
	^ self at: #BP! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
RBX
	"A 64bit general purpose register
	This register overlaps with BL, BX, EBX, RBX"
	^ self at: #RBX! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
RSP
	"A 64bit general purpose register
	This register overlaps with AH, AX, EAX, RAX"
	^ self at: #RSP! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
XMM5
	"An SSE register"
	^ self at: #XMM5! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
EBX
	"A 32bit general purpose register
	This register overlaps with BL, BX, EBX, RBX"
	^ self at: #EBX! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
RSI
	"A 64bit general purpose register
	This register overlaps with DH, DX, EDX, RDX"
	^ self at: #RSI! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
MM0
	"An MMX register"
	^ self at: #MM0! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
R15D
	"A 32bit general purpose register
	This register overlaps with R15B, R15W, R15D, R15"
	^ self at: #R15D! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
ST0
	"A floating point register"
	^ self at: #ST0! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R9W
	"A 16bit general purpose register
	This register overlaps with R9B, R9W, R9D, R9"
	^ self at: #R9W! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
XMM6
	"An SSE register"
	^ self at: #XMM6! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R14
	"A 64bit general purpose register
	This register overlaps with R14B, R14W, R14D, R14"
	^ self at: #R14! !

!AJx86Registers class methodsFor: 'accessing' stamp: ''!
all32
	^ self all select: [:reg| reg is32 ]! !

!AJx86Registers class methodsFor: 'accessing' stamp: ''!
generalPurpose64
	^ self sortRegistersByIndex: (self generalPurpose select: [:reg| reg is64 ])! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
EIP
	"A 32bit instruction pointer register
	This register overlaps with IP, EIP, RIP"
	^ self at: #EIP! !

!AJx86Registers class methodsFor: 'initialization' stamp: 'CamilloBruni 5/21/2013 17:28'!
initializeGeneralPurpose64BitRegisters
	"initialize general purpose 64 bit registers"
	
	self
		registerBase: 16r30
			class: AJx86GPRegister
			rex: #dontCare
			values: #(#RAX #RCX #RDX #RBX #RSP #RBP #RSI #RDI);
		registerBase: 16r38
			class: AJx86GPRegister
			rex: #required
			values: #(#R8 #R9 #R10 #R11 #R12 #R13 #R14 #R15)! !

!AJx86Registers class methodsFor: 'initialization' stamp: 'MartinMcClure 1/27/2013 09:57'!
initializeGeneralPurpose16BitRegisters
	"initialize general purpose 16 bit registers "

	self
		registerBase: 16r10
			class: AJx86GPRegister
			rex: #dontCare
			values: #(#AX #CX #DX #BX #SP #BP #SI #DI);
		registerBase: 16r18
			class: AJx86GPRegister
			rex: #required
			values: #(#R8W #R9W #R10W #R11W #R12W #R13W #R14W #R15W)! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
EDX
	"A 32bit general purpose register
	This register overlaps with DL, DX, EDX, RDX"
	^ self at: #EDX! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
CH
	"A 8bit general purpose register
	This register overlaps with CH, CX, ECX, RCX"
	^ self at: #CH! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
EAX
	"A 32bit general purpose register
	This register overlaps with AL, AX, EAX, RAX"
	^ self at: #EAX! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
EBP
	"A 32bit general purpose register
	This register overlaps with CH, CX, ECX, RCX"
	^ self at: #EBP! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
XMM11
	"An SSE register"
	^ self at: #XMM11! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
MM1
	"An MMX register"
	^ self at: #MM1! !

!AJx86Registers class methodsFor: 'accessing' stamp: 'CamilloBruni 7/17/2012 10:54'!
at: aRegisterIdentifierSymbol
	^ self classPool at: aRegisterIdentifierSymbol! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
MM2
	"An MMX register"
	^ self at: #MM2! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
R12B
	"A 8bit general purpose register
	This register overlaps with R12B, R12W, R12D, R12"
	^ self at: #R12B! !

!AJx86Registers class methodsFor: 'accessing' stamp: ''!
all
	^ Codes values collect: [ :each| self classPool at: each ]! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
MM3
	"An MMX register"
	^ self at: #MM3! !

!AJx86Registers class methodsFor: 'accessing' stamp: 'MartinMcClure 1/30/2013 21:13'!
generalPurposeWithIndex: index size: numBytes requiresRex: requiresRex prohibitsRex: prohibitsRex
	"Access a register by its properties.
	Example:
		RBP == (self generalPurposeWithIndex: RBP index size: RBP size requiresRex: RBP requiresRex prohibitsRex: RBP prohibitsRex )"

	| type code |
	type := numBytes = 1
		ifTrue: [ 0 ]
		ifFalse: [ 
			numBytes = 2
				ifTrue: [ 16r10 ]
				ifFalse: [ 
					numBytes = 4
						ifTrue: [ 16r20 ]
						ifFalse: [ 
							numBytes = 8
								ifTrue: [ 16r30 ]
								ifFalse: [ self error: 'Size must be 1, 2, 4, or 8 bytes' ] ] ] ].
	code := type + index.
	requiresRex
		ifTrue: [ code := code + RegRequiresRexMask ].
	prohibitsRex
		ifTrue: [ code := code + RegProhibitsRexMask ].
	^ self classPool at: (Codes at: code)! !

!AJx86Registers class methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2012 11:10'!
initializeX87Registers
	"X87 registers"
	self registerBase: 16r50 class: AJx87Register values: #(
		#ST0 #ST1 #ST2 #ST3 #ST4 #ST5 #ST6 #ST7 ).! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R13W
	"A 16bit general purpose register
	This register overlaps with R13B, R13W, R13D, R13"
	^ self at: #R13W! !

!AJx86Registers class methodsFor: 'initialization' stamp: ''!
sortRegistersByIndex: aRegisterCollection
	^ aRegisterCollection sort: [ :regA :regB| regA index < regB index ].! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R11W
	"A 16bit general purpose register
	This register overlaps with R11B, R11W, R11D, R11"
	^ self at: #R11W! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
R11B
	"A 8bit general purpose register
	This register overlaps with R11B, R11W, R11D, R11"
	^ self at: #R11B! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
SI
	"A 16bit general purpose register
	This register overlaps with DH, DX, EDX, RDX"
	^ self at: #SI! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
DX
	"A 16bit general purpose register
	This register overlaps with DL, DX, EDX, RDX"
	^ self at: #DX! !

!AJx86Registers class methodsFor: 'method compilation' stamp: 'CamilloBruni 7/17/2012 11:18'!
installRegister: register accessorCategory: registerAccessorsCategory on: aClass
	
	aClass 
		compile: (String	streamContents: [ :s | 
			s nextPutAll: register name; crtab.
			self printRegister: register descriptionOn: s.
			s crtab; nextPutAll: '^ '; nextPutAll: register name ])
		classified: registerAccessorsCategory ! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
RAX
	"A 64bit general purpose register
	This register overlaps with AL, AX, EAX, RAX"
	^ self at: #RAX! !

!AJx86Registers class methodsFor: 'initialization' stamp: 'MartinMcClure 1/27/2013 09:58'!
initializeGeneralPurpose32BitRegisters
	"initialize general purpose 32 bit registers "

	self
		registerBase: 16r20
			class: AJx86GPRegister
			rex: #dontCare
			values: #(#EAX #ECX #EDX #EBX #ESP #EBP #ESI #EDI);
		registerBase: 16r28
			class: AJx86GPRegister
			rex: #required
			values: #(#R8D #R9D #R10D #R11D #R12D #R13D #R14D #R15D)! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
ST2
	"A floating point register"
	^ self at: #ST2! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
XMM4
	"An SSE register"
	^ self at: #XMM4! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
DL
	"A 8bit general purpose register
	This register overlaps with DL, DX, EDX, RDX"
	^ self at: #DL! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
MM6
	"An MMX register"
	^ self at: #MM6! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
MM5
	"An MMX register"
	^ self at: #MM5! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:48'!
XMM10
	"An SSE register"
	^ self at: #XMM10! !

!AJx86Registers class methodsFor: 'accessing registers' stamp: 'AsmJIT 8/21/2012 17:47'!
RBP
	"A 64bit general purpose register
	This register overlaps with CH, CX, ECX, RCX"
	^ self at: #RBP! !

!AJx87Register commentStamp: '<historical>'!
I am an x87 Floating Point register (ST0 - ST7) used in the FPU stack. 

The lower 64bit of the floating point ST registers are shared with the MMX registers.!
!AJx87Register methodsFor: 'testing' stamp: ''!
isGeneralPurpose
	^ false! !

!AJx87Register methodsFor: 'accessing' stamp: ''!
code: aCode

	code := aCode bitOr: RegX87.
	size := 10.! !

!AJx87Register methodsFor: 'testing' stamp: ''!
isRegTypeX87
	^ true! !

!AJx87Register methodsFor: 'printing' stamp: 'CamilloBruni 7/17/2012 11:12'!
descriptionOn: s
	s nextPutAll: 'A floating point register'.! !

!AJx87Register methodsFor: 'accessing' stamp: 'CamilloBruni 5/7/2013 11:32'!
influencingRegisters
	"ST registers overlap with the MMX register"
	self shouldBeImplemented.! !

!AJx87Register methodsFor: 'testing' stamp: 'MartinMcClure 1/27/2013 15:31'!
isX86
	^ true! !

!AJxMMRegister commentStamp: '<historical>'!
I am a register used by the SSE (Streaming SIMD Extensions) for the x86 instruction set. The independent XMM registers are 128bit wide and do not overlap with any other existing registers.

Depending on the instructions used the XMM registers represent different data types:
	SSE:  4 x 32bit single precision floats
	SSE2: 2 x 64bit double prexision floats
	      2 x 64bit integers
	      4 x 32bit integers
	      8 x 16bit short integers
	      16 x 8bit bytes/characters!
!AJxMMRegister methodsFor: 'testing' stamp: ''!
isGeneralPurpose
	^ false! !

!AJxMMRegister methodsFor: 'accessing' stamp: ''!
code: aCode

	code := aCode.
	size := 16! !

!AJxMMRegister methodsFor: 'testing' stamp: ''!
isRegTypeXMM
	^ true! !

!AJxMMRegister methodsFor: 'printing' stamp: 'CamilloBruni 7/17/2012 11:15'!
descriptionOn: s
	
	s nextPutAll: 'An SSE register'.! !

!AJxMMRegister methodsFor: 'testing' stamp: 'MartinMcClure 1/27/2013 15:33'!
isX86
	^ self index < 8! !

!ASTCache commentStamp: '<historical>'!
I am a simple cache for AST nodes corresponding to CompiledMethods in the image. The cache is emptied when the image is saved.!
!ASTCache methodsFor: 'accessing' stamp: 'GuillermoPolito 5/14/2013 10:52'!
at: aCompiledMethod
	^ self 
		at: aCompiledMethod
		ifAbsentPut: [ 
			aCompiledMethod parseTree doSemanticAnalysisIn: aCompiledMethod methodClass ]! !

!ASTCache methodsFor: 'accessing' stamp: 'CamilloBruni 2/17/2012 14:29'!
reset
	self removeAll! !

!ASTCache class methodsFor: 'accessing' stamp: 'CamilloBruni 2/17/2012 14:27'!
reset
	default reset.! !

!ASTCache class methodsFor: 'class initialization' stamp: 'CamilloBruni 2/20/2012 18:54'!
initialize
	default := self new.
	Smalltalk addToShutDownList: self.! !

!ASTCache class methodsFor: 'accessing' stamp: 'CamilloBruni 2/17/2012 14:30'!
default
	^ default! !

!ASTCache class methodsFor: 'system startup' stamp: 'CamilloBruni 2/17/2012 15:10'!
shutDown	
	self reset.! !

!ASTCache class methodsFor: 'accessing' stamp: 'CamilloBruni 2/17/2012 14:30'!
default: anASTCache
	default := anASTCache.! !

!ASTCache class methodsFor: 'accessing' stamp: 'CamilloBruni 2/17/2012 14:22'!
at: aCompiledMethod
	^ default at: aCompiledMethod! !

!ASTPluginMeaningOfLife commentStamp: 'MarcusDenker 2/28/2015 15:54'!
A simple example for a AST transforming compiler plugin.

I replace 42 with a  'meaning of life'.!
!ASTPluginMeaningOfLife methodsFor: 'transformation' stamp: 'MarcusDenker 2/28/2015 15:56'!
transform
	| rule |
	rule := RBParseTreeRewriter replaceLiteral: 42 with: 'meaning of life'.
	rule executeTree: ast.
	^ast! !

!ASTTransformExamplePluginActive commentStamp: 'MarcusDenker 2/28/2015 16:02'!
This class changes the default compiler used to compile itself to include the AST transforming plugin ASTPluginMeaningOfLife.

#example42 does not mean what you think it means (see bytecode)!
!ASTTransformExamplePluginActive methodsFor: 'example' stamp: 'MarcusDenker 2/28/2015 15:53'!
example42
	^42! !

!ASTTransformExamplePluginActive class methodsFor: 'compiler' stamp: 'MarcusDenker 2/28/2015 15:17'!
compiler
	"the example plugin is active for this class"
	^super compiler addPlugin: ASTPluginMeaningOfLife.! !

!ASTTransformationPluginTest methodsFor: 'tests' stamp: 'MarcusDenker 2/28/2015 15:19'!
testClassWithPluginEnabled
	self assert: ASTTransformExamplePluginActive new example42 = 'meaning of life'! !

!ASTTransformationPluginTest methodsFor: 'tests' stamp: 'MarcusDenker 2/28/2015 15:53'!
testTransform
		| ast |
		ast := (OCOpalExamples>>#exampleReturn42) ast copy.
		self assert: ast body statements first value value =  42.
		ast := ASTPluginMeaningOfLife transform: ast.
		self assert: ast body statements first value value =  'meaning of life'.! !

!Abort commentStamp: 'TorstenBergmann 2/4/2014 21:42'!
Notify to abort a task!
!Abort methodsFor: 'accessing' stamp: 'ajh 3/24/2003 00:55'!
defaultAction
	"No one has handled this error, but now give them a chance to decide how to debug it.  If none handle this either then open debugger (see UnhandedError-defaultAction)"

	UnhandledError signalForException: self! !

!AboutDialogWindow commentStamp: 'gvc 5/18/2007 13:53'!
Default superclass for application about dialogs.!
!AboutDialogWindow methodsFor: 'actions' stamp: 'gvc 1/12/2007 16:32'!
newButtons
	"Answer new buttons as appropriate."

	^{self newCloseButton isDefault: true}! !

!AbsolutePath commentStamp: '<historical>'!
I represent an absolute path (a position starting from Path root)!
!AbsolutePath methodsFor: 'testing' stamp: 'cwp 2/26/2011 11:03'!
isRoot
	^ self size = 0! !

!AbsolutePath methodsFor: 'enumerating' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
withParents
	^ super withParents addFirst: (Path root); yourself! !

!AbsolutePath methodsFor: '*zinc-resource-meta-filesystem' stamp: 'SvenVanCaekenberghe 1/14/2013 10:03'!
asZnUrl
	"Convert the receiver in a file:// ZnUrl"

	| fileUrl |
	fileUrl := ZnUrl new.
	fileUrl scheme: #file.
	self do: [ :each | fileUrl addPathSegment: each ].
	^ fileUrl! !

!AbsolutePath methodsFor: 'printing' stamp: 'EstebanLorenzano 4/3/2012 11:15'!
printOn: aStream
	aStream nextPutAll: 'Path'.
	self isRoot
		ifTrue: [aStream nextPutAll: ' root']
		ifFalse:
			[1 to: self size do:
				[:i |
				aStream 
					nextPutAll: ' / ''';
				 	nextPutAll: (self at: i);
					nextPut: $']]! !

!AbsolutePath methodsFor: 'testing' stamp: 'cwp 2/26/2011 10:58'!
isAbsolute
	^ true! !

!AbsolutePath class methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 1/19/2012 15:12'!
addEmptyElementTo: result! !

!AbsolutePath class methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 1/19/2012 15:02'!
from: aString delimiter: aDelimiterCharater
	aString = '/'
		ifTrue: [ ^ self root ].
		
	^ super from: aString delimiter: aDelimiterCharater! !

!AbstractAcceptor commentStamp: '<historical>'!
I am an abstract acceptor.
The goal of my children is to properly dispatch the behavior when text is accepted. Depending of the context, different actions could be triggered!
!AbstractAcceptor methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/16/2013 16:45'!
model

	^ model! !

!AbstractAcceptor methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 4/16/2013 16:43'!
accept: aText notifying: aController

	self subclassResponsibility! !

!AbstractAcceptor methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/16/2013 16:41'!
model: anObject
	
	model := anObject! !

!AbstractAcceptor class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 4/16/2013 16:41'!
model: model

	^ self new
		model: model;
		yourself! !

!AbstractAdapter commentStamp: 'StephaneDucasse 2/27/2015 20:31'!
I am an abstract class.

I'm the superclass of all the adapters used to link a Spec widget model to a framework specific widget (by example ButtonModel <-> PluggableButtonMorph).

The current implementation installs my instances as dependent of the model and my changed: method propagates updates to the widget I create (via my buildWidget method). This implementation is not optimal. 

In the future my instances should just be responsible to create a widget and install all the communication between the model and the widget. I should not be a middle man. !
!AbstractAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/29/2013 12:42'!
hSpaceFill

	self subclassResponsibility! !

!AbstractAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/29/2013 14:16'!
selector
	
	^ selector! !

!AbstractAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/29/2013 12:41'!
layout: aLayout

	self subclassResponsibility! !

!AbstractAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/29/2013 12:42'!
vShrinkWrap

	self subclassResponsibility! !

!AbstractAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/29/2013 12:42'!
hRigid

	self subclassResponsibility! !

!AbstractAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/29/2013 12:42'!
hShrinkWrap

	self subclassResponsibility! !

!AbstractAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/1/2013 13:14'!
when: anAnnouncement do: aBlock

	self subclassResponsibility! !

!AbstractAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/29/2013 12:42'!
vSpaceFill

	self subclassResponsibility! !

!AbstractAdapter methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 9/25/2013 16:18'!
update: aSymbol with: anArray

	self perform: aSymbol withArguments: anArray! !

!AbstractAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/29/2013 12:42'!
removeSubWidgets

	self subclassResponsibility! !

!AbstractAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/29/2013 12:41'!
add: aWidget

	self subclassResponsibility! !

!AbstractAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/29/2013 13:42'!
asWidget

	^ self widget! !

!AbstractAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/25/2013 14:40'!
takeKeyboardFocus
	
	self widget ifNotNil: [:w | w takeKeyboardFocus ]! !

!AbstractAdapter methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 9/25/2013 14:46'!
adapt: aComposableModel

	model := aComposableModel.
	aComposableModel addDependent: self.

	widget := self buildWidget.! !

!AbstractAdapter methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 11/26/2013 17:19'!
isSpecAdapter

	^ true! !

!AbstractAdapter methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 9/25/2013 14:44'!
update: aSymbol

	self changed: aSymbol! !

!AbstractAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/29/2013 12:42'!
vRigid

	self subclassResponsibility! !

!AbstractAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/29/2013 12:42'!
useProportionalLayout

	self subclassResponsibility! !

!AbstractAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/25/2013 13:57'!
widget
	^ widget! !

!AbstractAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/29/2013 14:16'!
selector: anObject
	
	selector := anObject! !

!AbstractAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/25/2013 13:48'!
model
	^ model! !

!AbstractAdapter methodsFor: '*Spec-MorphicAdapters' stamp: 'BenjaminVanRyseghem 10/10/2013 12:15'!
isMorphicAdapter

	^ false! !

!AbstractAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/1/2013 13:32'!
isRedrawable
	"This must be overriden in the adapter representing your container"
	
	^ false! !

!AbstractAdapter methodsFor: 'factory' stamp: 'StephaneDucasse 2/26/2015 16:40'!
buildWidget

	^ self subclassResponsibility! !

!AbstractAdapter methodsFor: 'private' stamp: 'BenjaminVanRyseghem 1/10/2014 12:35'!
widgetDo: aBlock

	^ self widget ifNotNil: aBlock! !

!AbstractAdapter class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 9/25/2013 14:17'!
adapt: aComposableModel
	
	^ self new
		adapt: aComposableModel;
		yourself! !

!AbstractCache commentStamp: '<historical>'!
I am Cache.
I am an abstract class.

I am a limited cache holding onto key/value pairs.

My primary interface is #at:ifAbsentPut: which takes two arguments: a key and a block. Either the key is found (cache hit) and its value is returned, or the key is not found (cache miss). If the latter case, block should compute a new value to cache. Because block takes the key as optional argument, you can specify a factory style argument as well. With an explicit factory specified, you can also use #at: to access me.

For each addition to the cache, a weight is computed by #computeWeight (a selector or block) and added to #totalWeight. When #totalWeight is no longer below #maximumWeight, the least recently used item of the cache is evicted (removed) to make room. 

The default #computeWeight returns 1 for each value, effectively counting the number of entries. The default #maximumWeight is 16.

I count hits and misses and can return my #hitRatio.

Optionally, but not by default, I can be configured so that it is safe to access me from different threads/processess during my important operations. See #beThreadSafe.!
!AbstractCache methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/9/2013 22:01'!
at: key ifAbsentPut: block
	"If key is present in the cache, return the associated value.
	This is a hit and makes that key/value pair the most recently used.
	If key is absent, use block to compute a new value and cache it.
	Block can optionally take one argument, the key. 
	This is a miss and will create a new key/value pair entry.
	Furthermore this could result in the least recently used key/value pair 
	being removed when the specified maximum cache weight is exceeded."

	self subclassResponsibility ! !

!AbstractCache methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 12/9/2013 22:02'!
maximumWeight: limit
	"Set my maximum allowed total weight of all cached values to limit.
	If the total weight is no longer below limit,
	the least recently used key/value pair will be removed.
	The default maximum weight limit is 16."
	
	weight maximum: limit! !

!AbstractCache methodsFor: 'accessing - statistics' stamp: 'SvenVanCaekenberghe 12/9/2013 21:59'!
misses
	"Return how many misses, requests for keys not present I received."
	
	^ statistics misses! !

!AbstractCache methodsFor: 'accessing - statistics' stamp: 'SvenVanCaekenberghe 12/9/2013 22:00'!
size
	"Return the count of items currently present."
	
	self subclassResponsibility ! !

!AbstractCache methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/6/2015 10:44'!
addAll: keyedCollection
	"Populate me with all key/value pairs from keyedCollection.
	Does not affect statistics."
	
	keyedCollection keysAndValuesDo: [ :key :value | 
		self at: key put: value ]! !

!AbstractCache methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/9/2013 22:21'!
critical: block
	^ access
		ifNil: block
		ifNotNil: [ access critical: block ]! !

!AbstractCache methodsFor: 'removing' stamp: 'SvenVanCaekenberghe 12/9/2013 22:03'!
removeKey: key
	"If I currently cache key, remove the entry.
	Signal a KeyNotFound when I currently do not cache key.
	Return the removed value."
	
	^ self 
		removeKey: key 
		ifAbsent: [ KeyNotFound signalFor: key in: self ]! !

!AbstractCache methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 12/11/2013 15:36'!
beThreadSafe
	"Configure me so that I can be safely used from multiple threads/processes
	during important operations. Note that this slows down these operations."
	
	access := Monitor new! !

!AbstractCache methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 12/16/2013 20:10'!
initialize
	super initialize.
	weight := CacheWeight new.
	statistics := CacheStatistics new! !

!AbstractCache methodsFor: 'removing' stamp: 'SvenVanCaekenberghe 12/9/2013 22:04'!
removeKey: key ifAbsent: block
	"If I currently cache key, remove the entry.
	Execute block when key is currently absent.
	Return the removed value."
	
	self subclassResponsibility ! !

!AbstractCache methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/6/2015 11:26'!
at: key put: value
	"Populate me by storing value for key. Return value. 
	This is neither a hit nor a miss. Statistics remain unchanged.
	Overwrite if already present without promotion. 
	This could result in the least recently used key/value pair 
	being removed when the specified maximum cache weight is exceeded."
	
	self subclassResponsibility! !

!AbstractCache methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/4/2015 13:46'!
at: key
	"If key is present in the cache, return the associated value.
	This is a hit and makes that key/value pair the most recently used.
	If key is absent, use the factory to compute a new value and cache it.
	This is a miss and will create a new key/value pair entry.
	Furthermore this could result in the least recently used key/value pair 
	being removed when the specified maximum cache weight is exceeded.
	If there is no factory and the key is not present, signal a KeyNotFound exception."
	
	^ self 
		at: key 
		ifAbsentPut: (factory ifNil: [ [ :k | KeyNotFound signalFor: k in: self ] ])! !

!AbstractCache methodsFor: 'accessing - statistics' stamp: 'SvenVanCaekenberghe 12/9/2013 21:59'!
hits
	"Return how many hits, requests for keys present I received."

	^ statistics hits! !

!AbstractCache methodsFor: 'accessing - statistics' stamp: 'SvenVanCaekenberghe 12/9/2013 21:59'!
hitRatio
	"Return the ratio of hits against total calls I received.
	This will be a number between 0 and 1.
	When I am empty, return 0."
	
	^ statistics hitRatio! !

!AbstractCache methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 12/9/2013 22:02'!
printOn: stream
	super printOn: stream.
	stream nextPut: $(.
	self printElementsOn: stream.
	stream nextPut: $)! !

!AbstractCache methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 12/9/2013 22:02'!
factory: block
	"Set the factory to compute values from keys to block.
	The factory will be evaluated for each key not present.
	Only my #at: message will use the factory."
	
	factory := block! !

!AbstractCache methodsFor: 'accessing - statistics' stamp: 'SvenVanCaekenberghe 12/9/2013 22:00'!
totalWeight
	"Return the total weight of all cached values currently present."
	
	^ weight total! !

!AbstractCache methodsFor: 'enumerating' stamp: 'SvenVanCaekenberghe 12/9/2013 22:06'!
keysAndValuesDo: block
	"Execute block with each key and value present in me.
	This will be from least to most recently used."
	
	self subclassResponsibility ! !

!AbstractCache methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 12/9/2013 22:03'!
printElementsOn: stream
	stream nextPut: $#; print: self size.
	stream space; print: weight total; nextPut: $/; print: weight maximum.
	stream space; print: weight compute.
	factory ifNotNil: [ stream space; print: factory ].
	stream space; print: (self hitRatio * 100.0) rounded ; nextPut: $%! !

!AbstractCache methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 12/9/2013 22:02'!
computeWeight: valuable
	"Set the way to compute the weight of each cached value.
	This can be either a Symbol or one argument block.
	When the total weight is no longer below the maximum weight,
	the least recently used key/value pair will be removed.
	The default way to compute the weight returns 1 for each value,
	effectively counting the number of cached values."
	
	weight compute: valuable! !

!AbstractCache methodsFor: 'removing' stamp: 'SvenVanCaekenberghe 12/9/2013 22:03'!
removeAll
	"Remove all key/value pairs that I currently hold,
	effectiley resetting me, but not my statistics."

	self subclassResponsibility ! !

!AbstractCategoryWidget commentStamp: '<historical>'!
AbstractCategoryWidget is an abstraction describing a widget used to manage categories!
!AbstractCategoryWidget methodsFor: 'protocol' stamp: 'NicolaiHess 8/9/2014 21:43'!
resetCategoryList
	^ self subclassResponsibility! !

!AbstractCategoryWidget methodsFor: 'protocol' stamp: ''!
vScrollValue

	^ self subclassResponsibility! !

!AbstractCategoryWidget methodsFor: 'protocol' stamp: ''!
selectedCategory

	^ self model selectedCategory! !

!AbstractCategoryWidget methodsFor: 'protocol' stamp: ''!
searchedElement: index

	^ self subclassResponsibility! !

!AbstractCategoryWidget methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 5/9/2012 11:35'!
wantsDroppedMorph: transferMorph event: anEvent inMorph: destinationLM 
	"We are only interested in TransferMorphs as wrappers for             
	informations. If their content is really interesting for us, will             
	determined later in >>acceptDroppingMorph:event:."

	| srcType dstType |

	"only want drops on lists (not, for example, on pluggable texts)"
	(destinationLM isKindOf: PluggableListMorph) ifFalse: [ ^ false ].

	srcType := transferMorph dragTransferType.
	dstType := self dragTransferTypeForMorph: destinationLM.

	^ srcType == #getMethodItem: and: [ dstType == #getCategoryItem:]! !

!AbstractCategoryWidget methodsFor: 'drag and drop' stamp: ''!
dropMethod: aCollectionOfMethods inARow: aRow

	self model dropMethod: aCollectionOfMethods inARow: aRow! !

!AbstractCategoryWidget methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 5/9/2012 11:34'!
dragPassengersFor: item inMorph: dragSource 

	| transferType object |
	
	(dragSource isKindOf: PluggableListMorph) ifFalse: [^ nil ].
	transferType := self dragTransferTypeForMorph: dragSource.
	object := item originalObject.
	transferType == #getCategoryItem: ifTrue: [ ^ self selectedCategories ifEmpty: [ { object } ] ].
	^ nil! !

!AbstractCategoryWidget methodsFor: 'protocol' stamp: ''!
categoriesMenu: aMenuMorph shifted: aBoolean 
	
	^ self model categoriesMenu: aMenuMorph shifted: aBoolean ! !

!AbstractCategoryWidget methodsFor: 'protocol' stamp: ''!
showInstance

	^ self model showInstance! !

!AbstractCategoryWidget methodsFor: 'protocol' stamp: ''!
vScrollValue: aNumber

	^ self subclassResponsibility! !

!AbstractCategoryWidget methodsFor: 'item creation' stamp: ''!
buildCategoriesList

	^ self subclassResponsibility! !

!AbstractCategoryWidget methodsFor: 'protocol' stamp: ''!
categoriesSelection

	^ self subclassResponsibility! !

!AbstractCategoryWidget methodsFor: 'protocol' stamp: ''!
keyPressedOnCategory: anEvent

	^ self subclassResponsibility! !

!AbstractCategoryWidget methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 4/17/2012 16:57'!
okToChange

	^ self model okToChange! !

!AbstractCategoryWidget methodsFor: 'protocol' stamp: ''!
selectedCategories

	^ self subclassResponsibility! !

!AbstractCategoryWidget methodsFor: 'protocol' stamp: 'NicolaiHess 8/9/2014 21:06'!
resetCategorySelection

	self subclassResponsibility ! !

!AbstractCategoryWidget methodsFor: 'icon' stamp: 'NicolaiHess 7/28/2014 22:17'!
categoryIconFor: aString
	self flag: #todo. "this would work better with the new class organizer"
	"((aString beginsWith: '---')
		or: [ aString = 'no messages' ]) ifTrue: [ ^ Smalltalk ui icons protocolNoneIcon ]."
	(aString beginsWith: '*') ifTrue: [ ^ Smalltalk ui icons protocolExtensionIcon ].
	(aString beginsWith: 'private') ifTrue: [ ^ Smalltalk ui icons protocolPrivateIcon ].
	((aString = 'initialization' )
		or: [ (aString = 'initialize-release') or: [ aString = 'finalization' ]])
		ifTrue: [ ^ Smalltalk ui icons protocolProtectedIcon ].	
	
	^ Smalltalk ui icons protocolNoneIcon ! !

!AbstractCategoryWidget methodsFor: 'protocol' stamp: 'NicolaiHess 8/9/2014 21:23'!
updateCategoryList
	self changed: #getCategoryItem:! !

!AbstractCategoryWidget methodsFor: 'protocol' stamp: ''!
label: aString

	^ self subclassResponsibility! !

!AbstractCategoryWidget methodsFor: 'protocol' stamp: ''!
takeKeyboardFocus

	^ self subclassResponsibility! !

!AbstractClassInstaller commentStamp: '<historical>'!
I take a ready class and install it in a given environment.
My sublcasses implement custom strategies.!
!AbstractClassInstaller methodsFor: 'notifications' stamp: 'ToonVerwaest 3/22/2011 17:43'!
classAdded: aClass inCategory: aCategory
	self subclassResponsibility! !

!AbstractClassInstaller methodsFor: 'traits' stamp: 'MartinDias 7/1/2013 14:54'!
copyTraitCompositionFrom: oldClass to: newClass

	self 
		installTraitComposition: oldClass traitComposition copyTraitExpression 
		on: newClass.
	"We have to manually unsubcribe the newClass from its traits. Later in the class-building phase newClass becomeForward: oldClass and hence we can no longer distinguish the two. Which would leave `newClass trait users`, an IdetitySet, in an invalid state, as it's elements have been modified (the becomeForward:) without a proper rehash."
	newClass traitComposition traits do: [ :trait |
		trait removeUser: newClass ].
! !

!AbstractClassInstaller methodsFor: 'initialization' stamp: 'MartinDias 1/28/2014 15:13'!
initialize
	builder := SlotClassBuilder new.
	builder installer: self! !

!AbstractClassInstaller methodsFor: 'notifications' stamp: 'ToonVerwaest 3/22/2011 18:38'!
classDefinitionDeeplyChangedFrom: oldClass to: newClass by: classModification
	self subclassResponsibility! !

!AbstractClassInstaller methodsFor: 'accessing' stamp: 'ToonVerwaest 3/22/2011 17:42'!
builder
	^ builder! !

!AbstractClassInstaller methodsFor: 'accessing' stamp: 'ToonVerwaest 3/22/2011 17:45'!
environment: anEnvironment
	self subclassResponsibility! !

!AbstractClassInstaller methodsFor: 'traits' stamp: 'MartinDias 6/24/2013 18:25'!
installTraitComposition: aTraitComposition on: aClass
	self flag: 'Should probably send something else to test'.
	aClass setTraitComposition: aTraitComposition! !

!AbstractClassInstaller methodsFor: 'notifications' stamp: 'ToonVerwaest 3/22/2011 18:38'!
classDefinitionShallowChangedFrom: oldClass to: newClass by: classModification
	self subclassResponsibility! !

!AbstractClassInstaller methodsFor: 'migrating' stamp: 'ToonVerwaest 3/22/2011 18:30'!
migrateClasses: old to: new using: anInstanceModification
	self subclassResponsibility! !

!AbstractClassInstaller methodsFor: 'accessing' stamp: 'ToonVerwaest 3/22/2011 17:44'!
classAt: aName ifAbsent: aBlock
	self subclassResponsibility! !

!AbstractClassInstaller methodsFor: 'notifications' stamp: 'ToonVerwaest 3/22/2011 17:44'!
recategorize: aClass to: aCategory
	self subclassResponsibility! !

!AbstractClassInstaller methodsFor: 'accessing' stamp: 'CamilloBruni 6/28/2013 14:03'!
environment
	self subclassResponsibility! !

!AbstractClassInstaller class methodsFor: 'building' stamp: 'ToonVerwaest 3/22/2011 19:12'!
make: aBlock
	| builder |
	builder := self new builder.
	aBlock value: builder.
	^ builder build! !

!AbstractClassModification commentStamp: '<historical>'!
I represent a class modification. 

I content field modifications.!
!AbstractClassModification methodsFor: 'accessing' stamp: 'MartinDias 4/12/2013 13:01'!
layout: aLayout
	layout := aLayout.
	layout host: target.
	layout finalize.
	layout = target layout 
		ifFalse: [ self computeChange ]! !

!AbstractClassModification methodsFor: 'private' stamp: 'MartinDias 7/11/2013 15:30'!
propagate
	target subclassesDo: [ :subclass |
		propagations add:
			(ClassModificationPropagation
				propagate: self
				to: subclass) ].
	"recursively propagate this change down"
	propagations do: [ :propagation | propagation propagate ]
	
		! !

!AbstractClassModification methodsFor: 'accessing' stamp: 'MartinDias 7/11/2013 15:39'!
allPropagationsDo: aBlock
	propagations do: [ :aPropagation |
		aBlock value: aPropagation.
		aPropagation allPropagationsDo: aBlock ]! !

!AbstractClassModification methodsFor: 'testing' stamp: 'MartinDias 1/28/2014 16:17'!
isPropagation
	^ self subclassResponsibility ! !

!AbstractClassModification methodsFor: 'public' stamp: 'ToonVerwaest 4/1/2011 17:49'!
apply
	^ newClass := target shallowCopy
		superclass: self superclass
		layout: layout! !

!AbstractClassModification methodsFor: 'private' stamp: 'ToonVerwaest 3/21/2011 01:20'!
computeChange
	self checkSanity.! !

!AbstractClassModification methodsFor: 'accessing' stamp: 'ToonVerwaest 3/31/2011 19:53'!
result
	^ target! !

!AbstractClassModification methodsFor: 'accessing' stamp: 'ToonVerwaest 3/20/2011 13:50'!
layout
	^ layout! !

!AbstractClassModification methodsFor: 'accessing' stamp: 'ToonVerwaest 4/1/2011 17:49'!
newClass
	^ newClass! !

!AbstractClassModification methodsFor: 'accessing' stamp: 'ToonVerwaest 4/1/2011 17:24'!
newLayout
	^ layout! !

!AbstractClassModification methodsFor: 'initialization' stamp: 'ToonVerwaest 4/1/2011 03:31'!
initialize
	propagations := OrderedCollection new.! !

!AbstractClassModification methodsFor: 'accessing' stamp: 'ToonVerwaest 4/1/2011 17:38'!
oldLayout
	^ target layout! !

!AbstractClassModification methodsFor: 'accessing' stamp: 'CamilloBruni 3/30/2011 19:27'!
checkSanity
	layout checkSanity.! !

!AbstractClassModification methodsFor: 'accessing' stamp: 'ToonVerwaest 3/20/2011 19:40'!
target
	^ target! !

!AbstractClassModification methodsFor: 'accessing' stamp: 'ToonVerwaest 3/19/2011 15:57'!
target: aTarget
	target := aTarget! !

!AbstractClassWidget commentStamp: 'NicolaiHess 7/26/2014 00:22'!
AbstractClassWidget is an abstraction describing a widget used to manage a list of classes.!
!AbstractClassWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/26/2014 13:39'!
getClassesList

	^ self subclassResponsibility! !

!AbstractClassWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/26/2014 13:59'!
vScrollValue: aNumber

	^ self subclassResponsibility! !

!AbstractClassWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/26/2014 13:39'!
hasFocus

	^ self subclassResponsibility! !

!AbstractClassWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/26/2014 13:59'!
vScrollValue

	^ self subclassResponsibility! !

!AbstractClassWidget methodsFor: 'item creation' stamp: 'NicolaiHess 7/26/2014 00:26'!
buildClassesList
	^ self subclassResponsibility ! !

!AbstractClassWidget methodsFor: 'protocol' stamp: 'NicolaiHess 8/9/2014 21:17'!
resetClassList

	^ self subclassResponsibility! !

!AbstractClassWidget methodsFor: 'protocol' stamp: 'NicolaiHess 8/9/2014 21:44'!
resetClassSelection
	self subclassResponsibility ! !

!AbstractClassWidget methodsFor: 'drag and drop' stamp: 'NicolaiHess 7/30/2014 13:41'!
dragPassengersFor: item inMorph: dragSource 

	| transferType object |
	
	(dragSource isKindOf: PluggableListMorph) ifFalse: [^ nil ].
	transferType := self dragTransferTypeForMorph: dragSource.
	object := item originalObject.
	transferType == #getClassItem: ifTrue: [ 
		self model showGroups 
		ifTrue: [ self model selectedGroup
								ifNil: [ ^ nil ]
								ifNotNil: [:g | g isFillable ifFalse: [ ^ nil ]]]. 
		^ self selectedClasses ifEmpty: [ { object } ] ].
	^ nil! !

!AbstractClassWidget methodsFor: 'drag and drop' stamp: 'NicolaiHess 7/27/2014 20:49'!
wantsDroppedMorph: transferMorph event: anEvent inMorph: destinationLM
	| srcType dstType |
	"only want drops on lists (not, for example, on pluggable texts)"
	(destinationLM isKindOf: PluggableListMorph)
		ifFalse: [ ^ false ].
	srcType := transferMorph dragTransferType.
	dstType := self dragTransferTypeForMorph: destinationLM.
	srcType == #getMethodItem:
		ifTrue: [ ^ dstType == #getClassItem: ].
	srcType == #getCategoryItem:
		ifTrue: [ ^ dstType == #getClassItem: ].
	^ false! !

!AbstractClassWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/28/2014 21:40'!
selectedClasses
	self subclassResponsibility ! !

!AbstractClassWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/26/2014 01:04'!
takeKeyboardFocus

	^ self subclassResponsibility! !

!AbstractClassWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/28/2014 21:39'!
selectClass: aClass
	self subclassResponsibility ! !

!AbstractCompiler commentStamp: '<historical>'!
I define the public API of compilers that can be used as system compilers (e.g. overriding #compiler on the class side).!
!AbstractCompiler methodsFor: 'old - public' stamp: 'MarcusDenker 7/28/2013 15:06'!
evaluate: aString in: aContext to: aReceiver
	
	^self
		source: aString;
		context: aContext;
		receiver: aReceiver;
		failBlock: [^ #failedDoit];
		evaluate! !

!AbstractCompiler methodsFor: 'public access' stamp: 'MarcusDenker 7/27/2013 19:34'!
translate
	self subclassResponsibility! !

!AbstractCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 7/28/2013 15:09'!
compiledMethodTrailer: aClass
	self subclassResponsibility! !

!AbstractCompiler methodsFor: 'public access' stamp: 'MarcusDenker 7/27/2013 19:25'!
decompileMethod: aCompiledMethod
	self subclassResponsibility! !

!AbstractCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 7/28/2013 15:10'!
logged: aBoolean
	self subclassResponsibility! !

!AbstractCompiler methodsFor: 'old - public' stamp: 'MarcusDenker 7/28/2013 15:06'!
compileNoPattern: textOrStream in: aClass context: aContext notifying: aRequestor ifFail: aFailBlock

	^self 
		source: textOrStream;
		class: aClass;
		context: aContext;
		requestor: aRequestor;
		noPattern: true;
		failBlock: aFailBlock;
		translate! !

!AbstractCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 7/28/2013 15:10'!
useFaultyForParsing: anObject
	self subclassResponsibility! !

!AbstractCompiler methodsFor: 'old - public' stamp: 'MarcusDenker 7/28/2013 15:06'!
format: textOrStream in: aClass notifying: aRequestor
	^self
		source: textOrStream;
		class: aClass;
		requestor: aRequestor;
		format
		! !

!AbstractCompiler methodsFor: 'public access' stamp: 'MarcusDenker 7/27/2013 19:33'!
compile
	self subclassResponsibility! !

!AbstractCompiler methodsFor: 'old - public' stamp: 'MarcusDenker 7/28/2013 15:06'!
evaluate: textOrString logged: logFlag 

	^ self
		source: textOrString;
		logged: logFlag;
		evaluate
	
			! !

!AbstractCompiler methodsFor: 'old - public' stamp: 'MarcusDenker 7/28/2013 15:06'!
evaluate: textOrString notifying: aController logged: logFlag 

	^ self
		source: textOrString;
		logged: logFlag;
		requestor: aController;
		evaluate
	! !

!AbstractCompiler methodsFor: 'old - public' stamp: 'MarcusDenker 7/28/2013 15:06'!
parse: aString class: aClass
	^self 
		source: aString;
		class: aClass;
		parse! !

!AbstractCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 7/28/2013 15:09'!
environment: anSmallTalkImage
	self subclassResponsibility! !

!AbstractCompiler methodsFor: 'public access' stamp: 'MarcusDenker 7/27/2013 19:32'!
evaluate: textOrString 
	
	^self
		source: textOrString;
		evaluate! !

!AbstractCompiler methodsFor: 'public access' stamp: 'MarcusDenker 7/27/2013 19:33'!
options: anArray
	self subclassResponsibility! !

!AbstractCompiler methodsFor: 'old - public' stamp: 'MarcusDenker 7/28/2013 15:06'!
evaluate: textOrStream in: aContext to: aReceiver notifying: aRequestor ifFail: aFailBlock 
	
	^self
		source: textOrStream;
		context: aContext;
		receiver: aReceiver;
		requestor: aRequestor;
		failBlock: aFailBlock;
		evaluate! !

!AbstractCompiler methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/23/2015 16:34'!
silentlyDo: aBlock
	self silentlyDo: aBlock exceptionDo: [ " ignore " ]! !

!AbstractCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 7/28/2013 15:09'!
failBlock: aBlock
	self subclassResponsibility! !

!AbstractCompiler methodsFor: 'old - public' stamp: 'MarcusDenker 7/28/2013 15:06'!
compile: textOrStream in: aClass notifying: aRequestor ifFail: aFailBlock 

	^self 
		source: textOrStream;
		class: aClass;
		requestor: aRequestor;
		failBlock: aFailBlock;
		translate
	
! !

!AbstractCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 7/28/2013 15:10'!
requestor: aRequestor
	self subclassResponsibility! !

!AbstractCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 7/28/2013 15:09'!
compilationContextClass: aClass
	self subclassResponsibility! !

!AbstractCompiler methodsFor: 'plugins' stamp: 'MarcusDenker 2/28/2015 15:32'!
addPlugin: aClass 
	"do nothing"! !

!AbstractCompiler methodsFor: 'public access' stamp: 'MarcusDenker 7/27/2013 19:34'!
parse
	self subclassResponsibility! !

!AbstractCompiler methodsFor: 'old - public' stamp: 'MarcusDenker 7/28/2013 15:06'!
parse: textOrStream in: aClass notifying: req

	^self 
		source: textOrStream;
		class: aClass;
		requestor: req;
		translate.! !

!AbstractCompiler methodsFor: 'old - public' stamp: 'MarcusDenker 7/28/2013 15:06'!
parse: aString class: aClass noPattern: aBoolean context: aContext notifying: req ifFail: aBlock
	"Backwards compatibilty"
	
	^self 
		source: aString;
		class: aClass;
		noPattern: aBoolean;
		context: aContext;
		requestor: req;
		failBlock: aBlock;
		translate.! !

!AbstractCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 7/28/2013 15:09'!
context: aContext
	self subclassResponsibility! !

!AbstractCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 7/28/2013 15:10'!
noPattern: aBoolean
	self subclassResponsibility! !

!AbstractCompiler methodsFor: 'old - public' stamp: 'MarcusDenker 7/28/2013 15:06'!
evaluate: textOrStream in: aContext to: aReceiver notifying: aRequestor ifFail: aFailBlock logged: logFlag
	
	^self
		source: textOrStream;
		context: aContext;
		receiver: aReceiver;
		requestor: aRequestor;
		failBlock: aFailBlock;
		logged: logFlag;
		evaluate! !

!AbstractCompiler methodsFor: 'public access' stamp: 'MarcusDenker 7/27/2013 19:34'!
parseLiterals: aString
	self subclassResponsibility! !

!AbstractCompiler methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/23/2015 16:34'!
silentlyDo: aBlock1 exceptionDo: aBlock2
	aBlock1
		on: Error, SyntaxErrorNotification, UndeclaredVariableWarning, OCSemanticWarning, OCSemanticError
		do: aBlock2! !

!AbstractCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 7/28/2013 15:10'!
receiver: anObject
	self subclassResponsibility! !

!AbstractCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 7/28/2013 15:08'!
compilationContext
	self subclassResponsibility! !

!AbstractCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 7/28/2013 15:08'!
class: aClass
	self subclassResponsibility! !

!AbstractCompiler methodsFor: 'old - public' stamp: 'MarcusDenker 7/28/2013 15:06'!
evaluate: textOrString for: anObject notifying: aController logged: logFlag

	^ self 
		source: textOrString;
		logged: logFlag;
		receiver: anObject;
		requestor: aController;
		evaluate
	
			! !

!AbstractCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 7/28/2013 15:09'!
compilationContextClass
	self subclassResponsibility! !

!AbstractCompiler methodsFor: 'old - public' stamp: 'MarcusDenker 7/28/2013 15:06'!
compile: textOrStream in: aClass classified: aCategory notifying: aRequestor ifFail:  aFailBlock 

	^self 
		source: textOrStream;
		class: aClass;
		requestor: aRequestor;
		category: aCategory;
		failBlock: aFailBlock;
		translate! !

!AbstractCompiler methodsFor: 'public access' stamp: 'MarcusDenker 7/27/2013 19:33'!
evaluate
	self subclassResponsibility! !

!AbstractCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 7/28/2013 15:09'!
compilationContext: anObject
	self subclassResponsibility! !

!AbstractCompiler methodsFor: 'public access' stamp: 'MarcusDenker 7/27/2013 19:33'!
format
	self subclassResponsibility! !

!AbstractCompiler methodsFor: 'old - public' stamp: 'MarcusDenker 7/28/2013 15:06'!
evaluate: textOrString for: anObject logged: logFlag 

	^self
		source: textOrString;
		logged: logFlag;
		receiver: anObject;
		evaluate! !

!AbstractCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 7/28/2013 15:10'!
source: aString
	self subclassResponsibility! !

!AbstractCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 7/28/2013 15:10'!
useFaultyForParsing
	self subclassResponsibility! !

!AbstractCompiler methodsFor: 'public access' stamp: 'MarcusDenker 7/27/2013 19:34'!
parseSelector: aString 
	self subclassResponsibility! !

!AbstractCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 7/28/2013 15:08'!
category: aCategory
	self subclassResponsibility! !

!AbstractCompiler class methodsFor: 'settings' stamp: 'ClementBera 1/27/2015 16:44'!
compilerSettingsOn: aBuilder
	<systemsettings>
	(aBuilder group: #compiler)
		label: 'Compiler';
		with: [ 
					(aBuilder pickOne: #compilerClass)
						target: SmalltalkImage;
						label: 'Default Compiler';
						domainValues: AbstractCompiler subclasses.
					(aBuilder pickOne: #bytecodeBackend)
						target: CompilationContext;
						label: 'Bytecode Backend';
						domainValues:
								{#V3PlusClosures -> EncoderForV3PlusClosures.
								#SistaV1 -> EncoderForSistaV1 }.
					(aBuilder setting: #warningAllowed)
						target: CompilationContext;
						label: 'Allow Warnings';
						default: true]! !

!AbstractEcryptor commentStamp: '<historical>'!
An AbstractEcryptor is an interface for encryptor.

It's basically just an algorithm to encrypt a string, without ensuring it can be decrypted!
!AbstractEcryptor methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/6/2012 22:08'!
encrypt: aString

	^ self subclassResponsibility! !

!AbstractEcryptorDecryptor commentStamp: '<historical>'!
An AbstractEcryptorDecryptor is an interface providing the method for encrypting/decrypting a string!
!AbstractEcryptorDecryptor methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/6/2012 22:07'!
decrypt: aString base: aBase

	^ self subclassResponsibility! !

!AbstractEcryptorDecryptor methodsFor: 'protocol' stamp: 'Camillo 5/15/2012 11:21'!
encrypt: aString base: aBase

	^ self subclassResponsibility! !

!AbstractEnumerationVisitor commentStamp: '<historical>'!
I'm an abstract superclass for enumeration operations on directory entries. !
!AbstractEnumerationVisitor methodsFor: 'visiting' stamp: 'EstebanLorenzano 4/2/2012 11:37'!
breadthFirst: aReference
	^ self visit: aReference with: (BreadthFirstGuide for: self)! !

!AbstractEnumerationVisitor methodsFor: 'visiting' stamp: 'CamilloBruni 8/9/2011 15:48'!
visitReference: anEntry
	self subclassResponsibility! !

!AbstractEnumerationVisitor methodsFor: 'visiting' stamp: 'CamilloBruni 8/9/2011 15:46'!
visit: aReference with: aGuide
	out := (Array new: 10) writeStream.
	aGuide show: aReference.
	^ out contents! !

!AbstractEnumerationVisitor methodsFor: 'visiting' stamp: 'EstebanLorenzano 4/2/2012 11:38'!
preorder: aReference
	^ self visit: aReference with: (PreorderGuide for: self)! !

!AbstractEnumerationVisitor methodsFor: 'visiting' stamp: 'EstebanLorenzano 4/2/2012 11:38'!
postorder: aReference
	^ self visit: aReference with: (PostorderGuide for: self)! !

!AbstractEnumerationVisitor methodsFor: 'initialization' stamp: 'CamilloBruni 8/9/2011 15:46'!
initializeWithBlock: aBlock
	self initialize.
	block := aBlock! !

!AbstractEnumerationVisitorTest commentStamp: 'TorstenBergmann 1/31/2014 11:41'!
SUnit tests for AbstractEnumerationVisitor!
!AbstractEnumerationVisitorTest methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 8/12/2011 15:45'!
root
	^ filesystem / 'alpha'! !

!AbstractEnumerationVisitorTest methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 8/9/2011 16:01'!
setUp
	super setUp.
	self setUpGreek.! !

!AbstractEnumerationVisitorTest methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 4/10/2013 12:38'!
assertEntries: references are: expected
	| strings |
	self assert: references isArray.
	references do: [ :ea | self assert: ea class = FileSystemDirectoryEntry ].
	strings := references collect: [ :ea | ea reference pathString ].
	self assert: strings equals: expected! !

!AbstractEnumerationVisitorTest class methodsFor: 'as yet unclassified' stamp: 'EstebanLorenzano 4/3/2012 09:42'!
isAbstract
	^ self name = #AbstractEnumerationVisitorTest! !

!AbstractEyeElement commentStamp: '<historical>'!
I represent an abstract inspection element. In an EyeInspector, a eye element corresponds to a wrapper around a field element.

Public API :
label: display on left list panel of the eye inspector
description: printed on the right panel of the eye inspector
host: object inspected in the eye inspector 
value: object represented by this eye element !
!AbstractEyeElement methodsFor: 'accessing' stamp: 'YuriyTymchuk 12/20/2013 11:32'!
icon
	^ (self value iconOrThumbnailOfSize: 16)
		ifNil: [ self value class systemIcon ]! !

!AbstractEyeElement methodsFor: 'accessing' stamp: 'CamilloBruni 4/30/2013 10:48'!
description
	^ self value printStringLimitedTo: 2000! !

!AbstractEyeElement methodsFor: 'action' stamp: 'CamilloBruni 4/30/2013 10:43'!
browseValue
	^ self value browse! !

!AbstractEyeElement methodsFor: 'accessing' stamp: 'CamilloBruni 2/25/2014 18:23'!
errorWhileAccessing: selector do: aBlock
	[ self perform: selector ]
		on: Error do: [ :error |  
			aBlock cull: error cull: selector ].! !

!AbstractEyeElement methodsFor: 'accessing' stamp: 'CamilloBruni 2/25/2014 18:29'!
withErrorsDo: aBlock
	self errorPropertySelectors
		do: [ :selector | 
			self errorWhileAccessing: selector do: aBlock ].! !

!AbstractEyeElement methodsFor: 'menu' stamp: 'CamilloBruni 4/30/2013 10:58'!
customSubMenu: aMenu
	"Subclasse may add more menu items here"! !

!AbstractEyeElement methodsFor: 'action' stamp: 'CamilloBruni 4/30/2013 10:16'!
exploreValue
	^ self value explore! !

!AbstractEyeElement methodsFor: 'actions' stamp: ''!
inspectInNewWindow: anObject

	anObject inspect! !

!AbstractEyeElement methodsFor: 'actions' stamp: ''!
browseSelectedObjectClass
	self selectedObjectDo: [ :anObject | Smalltalk tools browser newOnClass: anObject class ]! !

!AbstractEyeElement methodsFor: 'testing' stamp: 'CamilloBruni 10/15/2013 17:14'!
hasSelectedObject
	^ true! !

!AbstractEyeElement methodsFor: 'accessing' stamp: 'CamilloBruni 10/15/2013 17:14'!
selectedObject
	^ self value! !

!AbstractEyeElement methodsFor: 'accessing' stamp: 'CamilloBruni 4/30/2013 10:58'!
hostClass
	^ host class! !

!AbstractEyeElement methodsFor: 'action' stamp: 'MarcusDenker 8/7/2014 11:36'!
explorePointers
	^ Smalltalk tools pointerExplorer openStrongOn: self value! !

!AbstractEyeElement methodsFor: 'accessing' stamp: 'CamilloBruni 4/30/2013 10:44'!
value
	"Answers the object associated with this EyeElement."
	self subclassResponsibility! !

!AbstractEyeElement methodsFor: 'printing' stamp: 'CamilloBruni 4/30/2013 10:46'!
printOn: aStream
	aStream
		print: self label;
		<< '->';
		<< (self value printStringLimitedTo: 50)! !

!AbstractEyeElement methodsFor: 'menu' stamp: 'CamilloBruni 2/25/2014 18:16'!
endSubMenu: aMenu 
	
	aMenu addGroup: [ :aGroup |
		aGroup addItem: [ :anItem |
			anItem 
				name: 'Copy Name';
				action: [ self copyAccessorCode ];
				shortcut: $c command mac | $c alt win | $c alt unix ] ]! !

!AbstractEyeElement methodsFor: 'actions' stamp: ''!
browseSelectedObject
	self selectedObjectDo: [ :anObject | anObject browse ]! !

!AbstractEyeElement methodsFor: 'action' stamp: 'CamilloBruni 4/30/2013 10:20'!
copyAccessorCode
	"Copy the name of the current variable, so the user can paste it into the 
	window below and work with is."

	Clipboard clipboardText: self accessorCode asText! !

!AbstractEyeElement methodsFor: 'accessing' stamp: 'CamilloBruni 4/30/2013 10:32'!
valueClass
	^ self value class! !

!AbstractEyeElement methodsFor: 'accessing' stamp: 'CamilloBruni 4/30/2013 10:51'!
host: anObject
	host := anObject! !

!AbstractEyeElement methodsFor: 'menu' stamp: 'CamilloBruni 2/25/2014 18:49'!
errorSubMenu: aMenu
	"Add debug menu entries for the failing #errorPropertySelectors of this eye element"
	
	self hasError 
		ifFalse: [ ^ self ].
		
	aMenu addGroup: [ :aGroup |
		
		self withErrorsDo: [ :accessError :itemSelector |
			aGroup addItem: [ :anItem |
				anItem 
					name: 'Debug Accessing ', itemSelector printString, ' of ', self accessorCode ;
					icon: Smalltalk ui icons smallWarningIcon;
					action: [ [ self perform: itemSelector] fork ]]]]! !

!AbstractEyeElement methodsFor: 'accessing' stamp: 'CamilloBruni 4/30/2013 10:52'!
host
	"Answers the object currently inspected by the outer inspector.
	See #value for the object represented by this EyeElement."
	^ host! !

!AbstractEyeElement methodsFor: 'action' stamp: 'CamilloBruni 10/15/2013 17:03'!
inspectValue
	"Bring up a non-special inspector"
	^ self value inspect! !

!AbstractEyeElement methodsFor: 'accessing' stamp: 'abc 10/18/2013 14:55'!
selectedObjectDo: aBlock
	aBlock value: self selectedObject ! !

!AbstractEyeElement methodsFor: 'action' stamp: 'ClementBera 4/30/2013 11:37'!
save: aValue
	"Subclasse may override this"! !

!AbstractEyeElement methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 3/30/2014 22:51'!
hash
	^ host hash! !

!AbstractEyeElement methodsFor: 'accessing' stamp: 'CamilloBruni 2/25/2014 18:30'!
errorPropertySelectors
	"Return a collection of selectors on this eye-element that are checked against errors.
	See #withErrorsDo: and #errorSubMenu:"
	^ #(icon label longLabel description)! !

!AbstractEyeElement methodsFor: 'menu' stamp: 'CamilloBruni 2/25/2014 18:15'!
exploreSubMenu: aMenu

	aMenu addGroup: [ :aGroup |
		aGroup addItem: [ :anItem |
			anItem 
				name: 'Explore Pointers';
				action: [ self explorePointers ] ] ]! !

!AbstractEyeElement methodsFor: 'menu' stamp: 'GuillermoPolito 8/10/2014 14:13'!
browseSubMenu: aMenu
	
	aMenu addGroup: [ :aGroup |
		aGroup addItem: [ :anItem |
			anItem 
				name: 'Browse Full';
				action: [ self browseSelectedObject ];
				shortcut: PharoShortcuts current browseShortcut  ].
			
		aGroup addItem: [ :anItem |
			anItem 
				name: 'Browse Class';
				action: [ self browseSelectedObjectClass ] ].
			
		aGroup addItem: [ :anItem |
			anItem 
				name: 'Browse Hierarchy';
				action: [ self browseSelectedObjectClassHierarchy ];
				shortcut: $h command mac | $h alt win | $h alt unix ] ]! !

!AbstractEyeElement methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 3/7/2014 13:21'!
longLabel
	"This is used by EyeTreeInspector"
	
	| description |
	description := self description.
	description size > 150
		ifTrue: [ description := description first: 150 ].
	^ self label 
		ifNotNil: [ :label | label , ': ' , description ] 
		ifNil: [ description ]! !

!AbstractEyeElement methodsFor: 'action' stamp: 'CamilloBruni 10/15/2013 17:03'!
browseValueClassHierarchy
	"Create and schedule a class list browser on the receiver's hierarchy."

	^ self valueClass browseHierarchy! !

!AbstractEyeElement methodsFor: 'menu' stamp: 'CamilloBruni 2/25/2014 18:14'!
inspectionMenu: aMenu
	"specific menu for the current element"
		
	self 
		exploreSubMenu: aMenu;
		browseSubMenu: aMenu;
		customSubMenu: aMenu;
		endSubMenu: aMenu;
		errorSubMenu: aMenu.! !

!AbstractEyeElement methodsFor: 'action' stamp: 'CamilloBruni 10/15/2013 17:03'!
browseValueClass
	"Open an class browser on the selectObject (class side)"
	
	^ self valueClass browse! !

!AbstractEyeElement methodsFor: 'accessing' stamp: 'CamilloBruni 4/30/2013 10:21'!
accessorCode
	"Answers a code string to access the value from the inspector"
	self subclassResponsibility! !

!AbstractEyeElement methodsFor: 'accessing' stamp: 'CamilloBruni 4/30/2013 10:45'!
label
	"Answers the label associated with this EyeElement"
	self subclassResponsibility! !

!AbstractEyeElement methodsFor: 'menu' stamp: 'StephaneDucasse 10/22/2014 21:28'!
mainInspectSubMenu: aMenu 
	aMenu 
		add: 'Inspect (i)' 
		target: self
		selector: #inspectSelectedObjectInNewWindow.
				
	aMenu
		add: 'Explore (I)' 
		target: self
		selector: #exploreSelectedObject.! !

!AbstractEyeElement methodsFor: 'comparing' stamp: 'IgorStasenko 8/14/2014 17:52'!
= anObject
	self == anObject ifTrue: [ ^ true ].
	self class = anObject class ifFalse: [ ^ false ].
	^ host == anObject host! !

!AbstractEyeElement methodsFor: 'actions' stamp: ''!
browseSelectedObjectClassHierarchy
	self selectedObjectDo: [ :anObject | anObject class browseHierarchy ]! !

!AbstractEyeElement methodsFor: 'testing' stamp: 'CamilloBruni 2/25/2014 18:24'!
hasError
	self withErrorsDo: [ ^ true ].
	^ false! !

!AbstractEyeElement methodsFor: 'actions' stamp: ''!
exploreSelectedObject
	self selectedObjectDo: [ :anObject | anObject explore ].! !

!AbstractEyeElement methodsFor: 'actions' stamp: ''!
inspectSelectedObjectInNewWindow
	self selectedObjectDo: [ :anObject | self inspectInNewWindow: anObject ].! !

!AbstractEyeElement methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/14/2014 10:29'!
shouldShowInTree
	^ true! !

!AbstractEyeElement class methodsFor: 'instance creation' stamp: 'ClementBera 4/30/2013 11:20'!
host: anObject 
	^ self new
		host: anObject;
		yourself! !

!AbstractFieldModification commentStamp: '<historical>'!
I am an abstract field modification.
Field modifications encapsulate the changes required to migrated instances.!
!AbstractFieldModification methodsFor: 'installing' stamp: 'ToonVerwaest 3/28/2011 17:07'!
installOn: aModification
	self subclassResponsibility! !

!AbstractFieldModification methodsFor: 'accessing' stamp: 'ToonVerwaest 3/28/2011 17:19'!
fieldIndex: anObject
	fieldIndex := anObject! !

!AbstractFieldModification methodsFor: 'migrating' stamp: 'ToonVerwaest 3/28/2011 20:31'!
migrateAt: index to: newInstance from: oldInstance! !

!AbstractFieldModification methodsFor: 'accessing' stamp: 'ToonVerwaest 3/28/2011 17:19'!
fieldIndex
	^ fieldIndex! !

!AbstractFileReference commentStamp: '<historical>'!
I am an abstract superclass for FileLocator and FileReference. By implementing most of the methods on myself most code duplucation between the locator and the reference can be avoided!
!AbstractFileReference methodsFor: 'testing' stamp: 'CamilloBruni 7/10/2012 15:04'!
isRoot
	^ self resolve isRoot! !

!AbstractFileReference methodsFor: 'testing' stamp: 'CamilloBruni 7/10/2012 15:05'!
hasFiles
	^self resolve hasFiles! !

!AbstractFileReference methodsFor: 'navigating' stamp: 'CamilloBruni 7/10/2012 15:05'!
resolve: anObject
	^ anObject asResolvedBy: self! !

!AbstractFileReference methodsFor: 'streams-compatibility' stamp: 'MaxLeske 1/26/2014 20:49'!
binaryReadStream
	^ self subclassResponsibility! !

!AbstractFileReference methodsFor: 'comparing' stamp: 'CamilloBruni 9/5/2012 18:07'!
isContainedBy: anObject
	"DoubleDispatch helper for #contains:"
	^ anObject containsReference: self resolve! !

!AbstractFileReference methodsFor: 'enumerating' stamp: 'CamilloBruni 7/10/2012 20:35'!
filesMatching: patterns
	"
	FileSystem disk workingDirectory filesMatching: '*'
	FileSystem disk workingDirectory filesMatching: '*.image;*.changes'
	"
	^ self 
		childGeneratorBlock: [:reference : aBlock| 
			reference fileSystem fileNamesAt: reference path do: aBlock ]
		matching:  patterns ! !

!AbstractFileReference methodsFor: 'enumerating' stamp: 'CamilloBruni 7/10/2012 20:37'!
children
	"Answer an array containing references to the direct children of this reference."
	| reference |
	reference := self resolve.
	^ (reference fileSystem childNamesAt: reference path) 
		collect: [ :aName | self / aName ]! !

!AbstractFileReference methodsFor: 'enumerating' stamp: 'CamilloBruni 7/10/2012 15:35'!
allEntries
	^ CollectVisitor breadthFirst: self resolve! !

!AbstractFileReference methodsFor: 'delegated' stamp: 'CamilloBruni 7/10/2012 15:04'!
mimeTypes
	^ self resolve mimeTypes! !

!AbstractFileReference methodsFor: 'operations' stamp: 'S 6/17/2013 13:24'!
ensureCreateFile
	"Create if necessary a file for the receiver."
	self writeStream close.
	! !

!AbstractFileReference methodsFor: 'delegated' stamp: 'CamilloBruni 7/10/2012 15:04'!
parent
	^ self withPath: self path parent! !

!AbstractFileReference methodsFor: 'enumerating' stamp: 'CamilloBruni 7/10/2012 20:46'!
allDirectories
	"Return all the directories recursively nested in the receiver."
	^ (SelectVisitor breadthFirst: self resolve select: [:entry | entry isDirectory ])
		collect: [ :each| each reference ]! !

!AbstractFileReference methodsFor: 'streams' stamp: 'CamilloBruni 7/10/2012 20:16'!
openWritable: aBoolean
	^ self resolve openWritable: aBoolean! !

!AbstractFileReference methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 20:51'!
modificationTime
	^ self resolve modificationTime ! !

!AbstractFileReference methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 15:30'!
extension
	
	^ self fullPath extension.! !

!AbstractFileReference methodsFor: 'delegated' stamp: 'CamilloBruni 7/10/2012 15:04'!
macTypeAndCreator
	^ self resolve macTypeAndCreator! !

!AbstractFileReference methodsFor: 'navigating' stamp: 'CamilloBruni 7/10/2012 15:51'!
relativeToReference: landmarkReference
	"Return the path of the receiver relative to landmarkReference."
	
	^ self fullPath relativeTo: landmarkReference path! !

!AbstractFileReference methodsFor: 'navigating' stamp: 'CamilloBruni 9/5/2012 11:26'!
relativeTo: landmark
	"Answer a new path relative to landmark."
	
	"parent/child/grandChild relativeTo: parent returns child/grandChild
	(Filesystem disk / 'griffle' / 'plonk' / 'nurp') relativeTo: (Filesystem disk / 'griffle') 
	returns plonk/nurp"

	^ landmark makeRelative: self resolve! !

!AbstractFileReference methodsFor: '*Network-Url' stamp: 'SvenVanCaekenberghe 10/25/2013 17:12'!
asUrl
	^ self asZnUrl! !

!AbstractFileReference methodsFor: 'operations' stamp: 'S 6/17/2013 13:30'!
moveTo: aReference
	"Move the receiver in the location passed as argument.
	
	(FileSystem disk workingDirectory / 'paf' ) ensureCreateFile.
	(FileSystem disk workingDirectory / 'fooFolder') ensureCreateDirectory. 
	(FileSystem disk workingDirectory / 'paf' ) moveTo: (FileSystem disk workingDirectory / 'fooFolder' / 'paf')
	"
	^ self resolve moveTo: aReference! !

!AbstractFileReference methodsFor: 'enumerating' stamp: 'CamilloBruni 7/10/2012 20:43'!
allChildren
	"Return all the files and folders recursively nested in the receiver"
	
	^ CollectVisitor breadthFirst: self resolve collect: [:entry | entry reference]! !

!AbstractFileReference methodsFor: 'accessing' stamp: 'PavelKrivanek 11/23/2012 12:21'!
fullPath
	"Returns the absolute path, better use absolutePath"
	
	^ self subclassResponsibility! !

!AbstractFileReference methodsFor: 'testing' stamp: 'PavelKrivanek 11/23/2012 12:21'!
isRelative 
	self subclassResponsibility ! !

!AbstractFileReference methodsFor: 'operations' stamp: 'S 6/17/2013 13:17'!
delete
	"Delete the receiver, does raise an error if it is not present."
	
	^ self resolve delete! !

!AbstractFileReference methodsFor: 'enumerating' stamp: 'StephaneDucasse 2/19/2015 18:03'!
allDirectoriesMatching: aPattern
    "Return all the directories recursively nested in the receiver."
    ^ (SelectVisitor 
			breadthFirst: self resolve 
			select: [:entry | entry isDirectory and: [ aPattern match: entry basename ] ])
        collect: [ :each | each reference ]
! !

!AbstractFileReference methodsFor: 'navigating' stamp: 'CamilloBruni 7/10/2012 15:50'!
relativeToPath: landmarkPath 
	
	^ self fullPath relativeTo: landmarkPath! !

!AbstractFileReference methodsFor: '*codeimport' stamp: 'CamilloBruni 7/10/2012 20:14'!
fileIn

	self readStreamDo: [ :stream | 
		CodeImporter evaluateFileStream: stream ]! !

!AbstractFileReference methodsFor: 'enumerating' stamp: 'CamilloBruni 7/10/2012 15:47'!
files
	"Return all the files (as opposed to folders) contained in the receiver"
	
	| reference |
	reference := self resolve.
	^ (reference fileSystem fileNamesAt: reference path) 
		collect: [ :aName | self withPath: self path / aName ]! !

!AbstractFileReference methodsFor: 'comparing' stamp: 'CamilloBruni 9/5/2012 18:02'!
contains: anObject
	"Return true if anObject is in a subfolder of me"
	^ anObject isContainedBy: self resolve! !

!AbstractFileReference methodsFor: 'streams' stamp: 'CamilloBruni 7/10/2012 15:26'!
readStreamDo: doBlock ifAbsent: absentBlock
	^ self isFile 
		ifTrue: [ self readStreamDo: doBlock ]
		ifFalse: absentBlock! !

!AbstractFileReference methodsFor: 'operations' stamp: 'StephaneDucasse 5/22/2013 17:24'!
createDirectory
	"Create a new repository and raise an error if the directory already exist."
	self resolve createDirectory! !

!AbstractFileReference methodsFor: 'testing' stamp: 'CamilloBruni 7/10/2012 20:19'!
isWritable
	^ self resolve isWritable! !

!AbstractFileReference methodsFor: 'enumerating' stamp: 'CamilloBruni 7/10/2012 20:35'!
childrenMatching: patterns
	"
	FileSystem disk workingDirectory childrenMatching: '*'
	FileSystem disk workingDirectory childrenMatching: '*.image;*.changes'
	"
	^ self 
		childGeneratorBlock: [:reference : aBlock| 
			reference fileSystem childNamesAt: reference path do: aBlock ]
		matching:  patterns ! !

!AbstractFileReference methodsFor: 'enumerating' stamp: 'StephaneDucasse 2/19/2015 18:02'!
allChildrenMatching: aPattern
    "Return all the files and folders recursively nested in the receiver and matching the pattern, aPattern"
    
    ^ self allChildren select: [ :each |  aPattern match: each basename ]
! !

!AbstractFileReference methodsFor: 'delegated' stamp: 'CamilloBruni 7/10/2012 15:04'!
asPathWith: anObject
	^ self resolve asPathWith: anObject! !

!AbstractFileReference methodsFor: 'testing' stamp: 'CamilloBruni 7/10/2012 20:17'!
isChildOf: anObject
	^ self parent = anObject! !

!AbstractFileReference methodsFor: 'operations' stamp: 'S 6/17/2013 13:20'!
copyAllTo: aResolvable
	"Performs a deep copy of the receiver, to a location specified by the argument. If the receiver is a file, the file will be copied; if a directory, the directory and its contents will be copied recursively. The argument must be a reference that doesn't exist; it will be created by the copy."
	
	CopyVisitor copy: self resolve asAbsolute to: aResolvable resolve! !

!AbstractFileReference methodsFor: 'streams' stamp: 'CamilloBruni 7/10/2012 22:34'!
streamWritable: writable do: aBlock
	^ writable 
		ifTrue: [ self writeStreamDo: aBlock ]
		ifFalse: [ self readStreamDo: aBlock ]! !

!AbstractFileReference methodsFor: 'enumerating' stamp: 'CamilloBruni 8/9/2012 11:38'!
directoryNames
	^ self directories collect: #basename! !

!AbstractFileReference methodsFor: 'streams-compatibility' stamp: 'MaxLeske 1/25/2014 22:48'!
binaryReadStreamDo: doBlock ifAbsent: absentBlock
	^ self isFile 
		ifTrue: [ self binaryReadStreamDo: doBlock ]
		ifFalse: absentBlock! !

!AbstractFileReference methodsFor: 'utility' stamp: 'CamilloBruni 7/10/2012 15:04'!
nextVersion
	^ self resolve nextVersion! !

!AbstractFileReference methodsFor: 'enumerating' stamp: 'CamilloBruni 7/10/2012 15:04'!
entries
	^ self resolve entries! !

!AbstractFileReference methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 22:05'!
size
	^ self resolve size! !

!AbstractFileReference methodsFor: 'printing' stamp: 'CamilloBruni 7/10/2012 20:15'!
indicator
	"Returns a string indicating the type of reference:
	- '?' for a non existing reference',
	- '/' for a directory,
	- the empty string for a file."
	"When this framework gets more complete, it is possible to extend this behavior with the following indicators (taken from unix ls utility):
	- '*' for a regular file that is executable
	- '@' for a symbolic link
	- '|' for FIFOs
	- '=' for sockets
	- '>' for doors"
	^ self exists
		ifTrue: [self isDirectory ifTrue: ['/'] ifFalse: ['']  ]
		ifFalse: ['?']! !

!AbstractFileReference methodsFor: 'navigating' stamp: 'CamilloBruni 7/10/2012 15:05'!
withExtension: aString
	^ self withPath: (self path withExtension: aString)! !

!AbstractFileReference methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 15:27'!
extensions
	  "#('foo' 'foo.tar' 'foo.tar.gz' 'foo.1.tar' 'foo.1.tar.gz') collect: [:thing| thing extensions] => #(#() #('tar') #('tar' 'gz') #('1' 'tar') #('1' 'tar' 'gz'))"
	
        ^ self fullPath extensions! !

!AbstractFileReference methodsFor: 'copying' stamp: 'PavelKrivanek 11/23/2012 12:21'!
copyWithPath: newPath
	self subclassResponsibility! !

!AbstractFileReference methodsFor: 'testing' stamp: 'PavelKrivanek 11/23/2012 12:21'!
isAbsolute 
	self subclassResponsibility ! !

!AbstractFileReference methodsFor: 'resolving' stamp: 'CamilloBruni 7/10/2012 15:20'!
asResolvedBy: anObject
	^ anObject resolveReference: self! !

!AbstractFileReference methodsFor: 'private' stamp: 'StephaneDucasse 2/19/2015 18:04'!
childGeneratorBlock: doBlock matching: patterns
	"
	FileSystem workingDirectory filesMatching: '*'
	FileSystem workingDirectory filesMatching: '*.image;*.changes'
	"
	
	| files reference|
	files := Set new.
	reference := self resolve.
	
	(patterns findTokens: ';', String crlf) do: [ :pattern | 
		doBlock value: reference value: [ :basename|
			(pattern match: basename)
				ifTrue: [ files add: (self / basename) ]]].
	
	^files asOrderedCollection! !

!AbstractFileReference methodsFor: 'streams' stamp: 'CamilloBruni 7/10/2012 15:26'!
readStreamDo: aBlock
	| stream |
	stream := self readStream.
	^ [ aBlock value: stream ] 
		ensure: [ stream close ]! !

!AbstractFileReference methodsFor: 'comparing' stamp: 'CamilloBruni 8/21/2013 17:51'!
<= other
	^ self path <= other path! !

!AbstractFileReference methodsFor: 'streams' stamp: 'CamilloBruni 7/10/2012 15:26'!
readStreamIfAbsent: absentBlock
	^ self isFile
		ifTrue: [ self readStream ]
		ifFalse: absentBlock! !

!AbstractFileReference methodsFor: 'testing' stamp: 'CamilloBruni 7/10/2012 15:04'!
isReadable
	^ self resolve isReadable! !

!AbstractFileReference methodsFor: 'operations' stamp: 'S 6/17/2013 13:29'!
ensureDeleteAll
	"Delete this directory and all children of it, and does not raise an error if the file does not exist."
	
	self exists ifFalse: [ ^ self  ].
	self deleteAll
	! !

!AbstractFileReference methodsFor: 'testing' stamp: 'CamilloBruni 7/10/2012 20:17'!
ifFile: fBlock ifDirectory: dBlock ifAbsent: aBlock
	^ self isFile
		ifTrue: fBlock
		ifFalse: [
			self isDirectory
				ifTrue: dBlock
				ifFalse: aBlock ]! !

!AbstractFileReference methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/27/2013 11:43'!
uri
	"Convert my path into a file:// type url. For odd characters use %20 notation."

	^ self asUrl! !

!AbstractFileReference methodsFor: 'operations' stamp: 'StephaneDucasse 5/22/2013 17:07'!
deleteIfAbsent: aBlock
	"Delete the receiver, when it does not exist evaluate the block"
	self resolve deleteIfAbsent: aBlock! !

!AbstractFileReference methodsFor: 'converting' stamp: 'PavelKrivanek 11/23/2012 12:21'!
asAbsolute 
	self subclassResponsibility! !

!AbstractFileReference methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 15:04'!
entry
	^ self resolve entry! !

!AbstractFileReference methodsFor: 'accessing' stamp: 'PavelKrivanek 11/23/2012 12:21'!
absolutePath
	"Returns the absolute path"
	
	^ self subclassResponsibility! !

!AbstractFileReference methodsFor: 'navigating' stamp: 'PavelKrivanek 11/23/2012 12:21'!
resolveString: aString 
	self subclassResponsibility! !

!AbstractFileReference methodsFor: '*zinc-resource-meta-filesystem' stamp: 'SvenVanCaekenberghe 1/14/2013 10:01'!
asZnUrl
	"Convert the receiver in a file:// ZnUrl.
	Only an absolute path can be represented as a file:// URL"
	
	^ self asAbsolute path asZnUrl! !

!AbstractFileReference methodsFor: 'enumerating' stamp: 'CamilloBruni 7/10/2012 20:45'!
allFiles
	"Return all the files (not directories) recursively nested in the receiver."
	^ (SelectVisitor breadthFirst: self resolve select: [:entry | entry isFile ])
		collect: [ :each| each reference ]! !

!AbstractFileReference methodsFor: 'testing' stamp: 'CamilloBruni 7/10/2012 15:05'!
hasDirectories
	^self resolve hasDirectories! !

!AbstractFileReference methodsFor: 'delegated' stamp: 'CamilloBruni 7/10/2012 15:04'!
exists
	^ self resolve exists! !

!AbstractFileReference methodsFor: 'delegated' stamp: 'CamilloBruni 7/10/2012 15:04'!
copyTo: aReference
	^ self resolve copyTo: aReference resolve! !

!AbstractFileReference methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 15:30'!
fullNameWithIndicator
	"Returns the basename with the indicator appended, i.e. /foo/gloops.taz basenameWithIndicator is '/foo/gloops.taz', whereras /foo basenameWithIndicator is '/foo/'" 
	^ self fullName, self indicator   ! !

!AbstractFileReference methodsFor: 'delegated' stamp: 'CamilloBruni 7/10/2012 15:04'!
fullName

	^ self resolve fullName! !

!AbstractFileReference methodsFor: 'navigating' stamp: 'CamilloBruni 7/10/2012 15:49'!
makeRelative: anObject
	^ anObject relativeToReference: self resolve! !

!AbstractFileReference methodsFor: 'operations' stamp: 'S 6/17/2013 13:26'!
ensureCreateDirectory
	"Verifies that the directory does not exist and only creates if necessary. Do not remove files contained if they exist."
	^ self resolve ensureCreateDirectory! !

!AbstractFileReference methodsFor: 'copying' stamp: 'CamilloBruni 2/21/2014 22:32'!
, extension
	^ self resolve, extension! !

!AbstractFileReference methodsFor: 'enumerating' stamp: 'CamilloBruni 7/10/2012 15:47'!
directories
	"Return all the directories (by opposition to files) contained in the receiver"

	| reference |
	reference := self resolve.
	^ (reference fileSystem directoryNamesAt: reference path) 
		collect: [ :aName | self withPath: self path / aName ]! !

!AbstractFileReference methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 15:01'!
fileSystem
	^ self resolve fileSystem! !

!AbstractFileReference methodsFor: 'streams' stamp: 'CamilloBruni 7/10/2012 15:24'!
writeStreamDo: aBlock
	| stream |
	stream := self writeStream.
	^ [ aBlock value: stream ]
		ensure: [ stream close ]! !

!AbstractFileReference methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 15:27'!
base
	"Returns the base of the basename, i.e. /foo/gloops.taz base is 'gloops'"
	^ self fullPath base! !

!AbstractFileReference methodsFor: 'testing' stamp: 'CamilloBruni 7/10/2012 15:05'!
hasChildren
	^self resolve hasChildren! !

!AbstractFileReference methodsFor: 'navigating' stamp: 'CamilloBruni 7/10/2012 15:18'!
resolvePath: aPath
	^ self withPath: (self path resolvePath: aPath)! !

!AbstractFileReference methodsFor: 'streams' stamp: 'PavelKrivanek 11/23/2012 12:21'!
writeStream
	self subclassResponsibility! !

!AbstractFileReference methodsFor: 'testing' stamp: 'CamilloBruni 7/10/2012 15:04'!
isFile
	^ self resolve isFile! !

!AbstractFileReference methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 15:28'!
basenameWithoutExtension
	"Returns the basename, i.e. /foo/gloops.taz basenameWithoutExtension is 'gloops'"
	^ self fullPath basenameWithoutExtension! !

!AbstractFileReference methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 15:28'!
basename
	"Returns the basename, i.e. /foo/gloops.taz basename is 'gloops.taz'"
	^ self fullPath basename! !

!AbstractFileReference methodsFor: 'navigating' stamp: 'CamilloBruni 7/10/2012 20:36'!
/ aString
	^ self withPath: self path / aString! !

!AbstractFileReference methodsFor: 'streams' stamp: 'CamilloBruni 7/10/2012 15:24'!
writeStreamDo: doBlock ifPresent: presentBlock
	^ self isFile
		ifTrue: presentBlock
		ifFalse: [ self writeStreamDo: doBlock ]! !

!AbstractFileReference methodsFor: 'operations' stamp: 'StephaneDucasse 5/22/2013 17:16'!
deleteAllChildren
	"delete all children of the receiver, raise an error if the receiver does not exist"
	
	self children do: [:aReference | aReference deleteAll ]! !

!AbstractFileReference methodsFor: 'operations' stamp: 'S 6/17/2013 13:17'!
ensureDelete
	"Delete the file and does not raise exception if it does not exist contrary to delete"
	
	self deleteIfAbsent: [].! !

!AbstractFileReference methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 20:51'!
creationTime
	^ self resolve creationTime ! !

!AbstractFileReference methodsFor: 'streams-compatibility' stamp: 'MaxLeske 1/25/2014 22:48'!
binaryReadStreamDo: aBlock
	| stream |
	stream := self binaryReadStream.
	^ [ aBlock value: stream ] 
		ensure: [ stream close ]! !

!AbstractFileReference methodsFor: 'testing' stamp: 'CamilloBruni 7/10/2012 15:04'!
isDirectory
	^ self resolve isDirectory! !

!AbstractFileReference methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 22:12'!
humanReadableSize
	^ self size humanReadableSIByteSize! !

!AbstractFileReference methodsFor: 'streams-compatibility' stamp: 'MaxLeske 1/25/2014 22:49'!
binaryReadStreamIfAbsent: absentBlock
	^ self isFile
		ifTrue: [ self binaryReadStream ]
		ifFalse: absentBlock! !

!AbstractFileReference methodsFor: 'operations' stamp: 'S 6/17/2013 13:21'!
deleteAll
	"Delete this directory and all children of it, raise an error if the file does not exist."
	DeleteVisitor delete: self resolve! !

!AbstractFileReference methodsFor: 'enumerating' stamp: 'CamilloBruni 7/10/2012 15:35'!
glob: aBlock
	^ SelectVisitor breadthFirst: self resolve select: aBlock! !

!AbstractFileReference methodsFor: 'comparing' stamp: 'CamilloBruni 7/10/2012 15:32'!
containsPath: aPath
	^ self fullPath containsPath: aPath! !

!AbstractFileReference methodsFor: 'streams' stamp: 'CamilloBruni 7/10/2012 15:24'!
writeStreamIfPresent: presentBlock
	^ self isFile 
		ifTrue: presentBlock
		ifFalse: [ self writeStream ]! !

!AbstractFileReference methodsFor: 'navigating' stamp: 'CamilloBruni 7/10/2012 15:18'!
resolveReference: aReference
	^ aReference isAbsolute
		ifTrue: [ aReference ]
		ifFalse: [ self withPath: aReference path ]! !

!AbstractFileReference methodsFor: 'comparing' stamp: 'CamilloBruni 8/9/2012 12:31'!
hash
	"Hash is reimplemented because #= is reimplemented"
	^ self path  hash! !

!AbstractFileReference methodsFor: 'delegated' stamp: 'BernardoContreras 2/20/2015 22:17'!
parentUpTo: aParentDirName
	^ self withPath: (self path parentUpTo: aParentDirName)! !

!AbstractFileReference methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 15:07'!
basenameWithIndicator
	"Returns the basename with the indicator appended, i.e. /foo/gloops.taz basenameWithIndicator is 'gloops.taz', whereras /foo basenameWithIndicator is 'foo/'" 
	^ self basename, self indicator   ! !

!AbstractFileReference methodsFor: 'enumerating' stamp: 'CamilloBruni 7/10/2012 20:35'!
directoriesMatching: patterns
	"
	FileSystem disk workingDirectory directoriesMatching: '*'
	FileSystem disk workingDirectory directoriesMatching: 'package-cache'
	"
	^ self 
		childGeneratorBlock: [:reference : aBlock| 
			reference fileSystem directoryNamesAt: reference path do: aBlock ]
		matching:  patterns ! !

!AbstractFileReference methodsFor: 'enumerating' stamp: 'CamilloBruni 7/10/2012 15:30'!
fileNames
	^ self files collect: #basename! !

!AbstractFileReference methodsFor: 'delegated' stamp: 'CamilloBruni 7/10/2012 15:04'!
pathString
	^ self resolve pathString! !

!AbstractFileReference methodsFor: 'streams' stamp: 'PavelKrivanek 11/23/2012 12:21'!
readStream
	self subclassResponsibility! !

!AbstractFileReference methodsFor: 'converting' stamp: 'PavelKrivanek 11/23/2012 12:21'!
asFileReference 
	self subclassResponsibility ! !

!AbstractFileReference methodsFor: 'enumerating' stamp: 'CamilloBruni 8/9/2012 11:38'!
childNames
	^ self children collect: #basename! !

!AbstractFileReference methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 21:29'!
permissions
	"Return the FileSystemPermission for this node"
	^ self resolve permissions! !

!AbstractFileReference methodsFor: 'accessing' stamp: 'CamilloBruni 1/23/2013 12:41'!
item
	^ self! !

!AbstractFileReference methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 15:31'!
pathSegments
	^ self fullPath segments! !

!AbstractFileReference methodsFor: 'operations' stamp: 'PavelKrivanek 11/23/2012 12:21'!
renameTo: newBasename
	self subclassResponsibility! !

!AbstractFileReference methodsFor: 'operations' stamp: 'S 6/17/2013 13:30'!
ensureDeleteAllChildren
	"delete all children of the receiver and does not raise an error if the receiver does not exist"
	
	self exists ifFalse: [ ^ self  ].
	self deleteAllChildren! !

!AbstractFileReference methodsFor: 'navigating' stamp: 'PavelKrivanek 11/23/2012 12:21'!
resolve
	^ self subclassResponsibility ! !

!AbstractFileReference methodsFor: 'navigating' stamp: 'CamilloBruni 7/10/2012 15:18'!
withPath: newPath
	^ self path == newPath
		ifTrue: [ self ]
		ifFalse: [ self copyWithPath: newPath ]! !

!AbstractFileReference methodsFor: 'accessing' stamp: 'CamilloBruni 6/13/2013 16:02'!
contents
	self readStreamDo: [ :stream |
		^ stream contents ]! !

!AbstractFont commentStamp: '<historical>'!
AbstractFont defines the generic interface that all fonts need to implement.!
!AbstractFont methodsFor: '*FreeType-addition' stamp: 'tween 8/10/2006 07:13'!
emphasisStringFor: emphasisCode
	"Answer a translated string that represents the attributes given in emphasisCode."
	
	^self class emphasisStringFor: emphasisCode! !

!AbstractFont methodsFor: 'accessing' stamp: 'yo 1/7/2005 11:19'!
ascent

	self subclassResponsibility.
! !

!AbstractFont methodsFor: '*FreeType-addition' stamp: 'tween 7/29/2006 13:51'!
displayUnderlineOn: aDisplayContext from: baselineStartPoint to: baselineEndPoint
	"display the underline if appropriate for the receiver"! !

!AbstractFont methodsFor: 'displaying' stamp: 'ar 5/19/2000 14:59'!
displayString: aString on: aDisplayContext from: startIndex to: stopIndex at: aPoint kern: kernDelta
	"Draw the given string from startIndex to stopIndex 
	at aPoint on the (already prepared) display context."
	^self subclassResponsibility! !

!AbstractFont methodsFor: 'accessing' stamp: 'nk 3/22/2004 15:15'!
textStyleName
	"Answer the name to be used as a key in the TextConstants dictionary."
	^self familyName! !

!AbstractFont methodsFor: 'measuring' stamp: 'StephaneDucasse 5/28/2011 13:17'!
widthOfString: aString
	aString ifNil: [^0].
	^self widthOfString: aString from: 1 to: aString size.
"
	TextStyle default defaultFont widthOfString: 'zort' 21
"! !

!AbstractFont methodsFor: 'caching' stamp: 'nk 3/15/2004 18:47'!
releaseCachedState
	! !

!AbstractFont methodsFor: 'accessing' stamp: 'nk 5/26/2003 09:45'!
isRegular
	^false! !

!AbstractFont methodsFor: 'accessing' stamp: 'nk 8/31/2004 09:14'!
height
	"Answer the height of the receiver, total of maximum extents of 
	characters above and below the baseline."

	^self subclassResponsibility! !

!AbstractFont methodsFor: 'displaying' stamp: 'ar 5/19/2000 14:59'!
installOn: aDisplayContext foregroundColor: foregroundColor backgroundColor: backgroundColor
	"Install the receiver on the given DisplayContext (either BitBlt or Canvas) for further drawing operations."
	^self subclassResponsibility! !

!AbstractFont methodsFor: '*FreeType-addition' stamp: 'tween 3/10/2007 13:08'!
kerningLeft: leftChar right: rightChar
	^0! !

!AbstractFont methodsFor: 'measuring' stamp: 'StephaneDucasse 5/28/2011 13:17'!
approxWidthOfText: aText 
	"Return the width of aText -- quickly, and a little bit dirty. Used by lists morphs containing Text objects to get a quick, fairly accurate measure of the width of a list item."
	| w |
	(aText isNil or: [ aText size = 0 ]) ifTrue: [ ^ 0 ].
	w := self widthOfString: aText asString.

	"If the text has no emphasis, just return the string size.  If it is empasized, 
    just approximate the width by adding about 20% to the width"
	((aText runLengthFor: 1) = aText size and: [ (aText emphasisAt: 1) = 0 ]) 
		ifTrue: [ ^ w ]
		ifFalse: [ ^ w * 6 // 5 ]! !

!AbstractFont methodsFor: 'accessing' stamp: 'yo 1/7/2005 11:20'!
descentOf: aCharacter

	^ self descent.
! !

!AbstractFont methodsFor: '*FreeType-addition' stamp: 'tween 8/10/2006 07:16'!
emphasisString
	"Answer a translated string that represents the receiver's emphasis."
	
	^self emphasisStringFor: self emphasis! !

!AbstractFont methodsFor: '*Athens-Text' stamp: 'NicolaiHess 1/13/2015 12:33'!
getPreciseHeight
	^ self height! !

!AbstractFont methodsFor: 'accessing' stamp: 'nk 8/31/2004 09:14'!
lineGrid
	"Answer the relative space between lines"

	^self subclassResponsibility! !

!AbstractFont methodsFor: 'notifications' stamp: 'nk 4/2/2004 11:25'!
pixelsPerInchChanged
	"The definition of TextStyle class>>pixelsPerInch has changed. Do whatever is necessary."! !

!AbstractFont methodsFor: 'accessing' stamp: 'nk 3/15/2004 18:57'!
derivativeFonts
	^#()! !

!AbstractFont methodsFor: 'accessing' stamp: 'ar 5/19/2000 14:57'!
xTable
	"Return the xTable for the font. The xTable defines the left x-value for each individual glyph in the receiver. If such a table is not provided, the character scanner will ask the font directly for the appropriate width of each individual character."
	^nil! !

!AbstractFont methodsFor: 'accessing' stamp: 'nk 4/2/2004 11:33'!
pixelSize
	"Make sure that we don't return a Fraction"
	^ TextStyle pointsToPixels: self pointSize! !

!AbstractFont methodsFor: 'displaying' stamp: 'yo 1/7/2005 11:36'!
displayString: aString on: aDisplayContext from: startIndex to: stopIndex at: aPoint kern: kernDelta baselineY: baselineY
	"Draw the given string from startIndex to stopIndex 
	at aPoint on the (already prepared) display context."
	^self subclassResponsibility! !

!AbstractFont methodsFor: 'accessing' stamp: 'nk 7/11/2004 21:15'!
textStyle
	^ TextStyle actualTextStyles detect:
		[:aStyle | aStyle fontArray includes: self] ifNone: [ TextStyle fontArray: { self } ]! !

!AbstractFont methodsFor: '*FreeType-addition' stamp: 'tween 3/29/2007 13:43'!
hasDistinctGlyphsForAll: asciiString
	"Answer true if the receiver has glyphs for all the characters
	in asciiString and no single glyph is shared by more than one character, false otherwise.
	The default behaviour is to answer true, but subclasses may reimplement"
	
	^true! !

!AbstractFont methodsFor: 'measuring' stamp: 'StephaneDucasse 5/28/2011 13:17'!
widthOfStringOrText: aStringOrText
    aStringOrText ifNil: [^0].
    ^aStringOrText isText
        ifTrue:[self approxWidthOfText: aStringOrText ]
        ifFalse:[self widthOfString: aStringOrText ] ! !

!AbstractFont methodsFor: 'accessing' stamp: 'yo 1/7/2005 11:18'!
ascentOf: aCharacter

	^ self ascent.
! !

!AbstractFont methodsFor: '*Text-Scanning' stamp: 'tpr 10/3/2013 12:42'!
scanMultibyteCharactersFrom: startIndex to: stopIndex in: aWideString with: aCharacterScanner rightX: rightX
	"scan a multibyte character string"
	^aCharacterScanner scanMultibyteCharactersFrom: startIndex to: stopIndex in: aWideString rightX: rightX ! !

!AbstractFont methodsFor: 'testing' stamp: 'yo 2/12/2007 19:34'!
isFontSet

	^ false.
! !

!AbstractFont methodsFor: 'accessing' stamp: 'nk 8/31/2004 09:15'!
familyName
	"Answer the name to be used as a key in the TextConstants dictionary."
	^self subclassResponsibility! !

!AbstractFont methodsFor: '*FreeType-addition' stamp: 'tween 7/29/2006 14:36'!
displayStrikeoutOn: aDisplayContext from: baselineStartPoint to: baselineEndPoint
	"display the strikeout if appropriate for the receiver"! !

!AbstractFont methodsFor: '*FreeType-addition' stamp: 'tween 3/31/2007 20:17'!
linearWidthOf: aCharacter
	"This is the scaled, unrounded advance width."
	^self widthOf: aCharacter! !

!AbstractFont methodsFor: '*Athens-Text' stamp: 'NicolaiHess 1/13/2015 12:34'!
getPreciseDescent
	^ self descent! !

!AbstractFont methodsFor: '*FreeType-addition' stamp: 'tween 3/29/2007 13:32'!
isSymbolFont
	"Answer true if the receiver is a Symbol font, false otherwise.
	The default is to answer false, subclasses can reimplement"
	
	^false! !

!AbstractFont methodsFor: 'accessing' stamp: 'nk 4/2/2004 11:06'!
baseKern
	^0! !

!AbstractFont methodsFor: '*FreeType-addition' stamp: 'ClementBera 7/26/2013 15:55'!
widthAndKernedWidthOfLeft: leftCharacter right: rightCharacterOrNil into: aTwoElementArray
	"Set the first element of aTwoElementArray to the width of leftCharacter and 
	the second element to the width of left character when kerned with
	rightCharacterOrNil. Answer aTwoElementArray"
	| w k |
	w := self widthOf: leftCharacter.
	rightCharacterOrNil 
		ifNil: [
			aTwoElementArray 
				at: 1 put: w; 
				at: 2 put: w]
		ifNotNil: [
			k := self kerningLeft: leftCharacter right: rightCharacterOrNil.
			aTwoElementArray 
				at: 1 put: w; 
				at: 2 put: w+k].
	^ aTwoElementArray
	! !

!AbstractFont methodsFor: '*FreeType-addition' stamp: 'tween 3/29/2007 13:25'!
hasGlyphsForAll: asciiString
	"Answer true if the receiver has glyphs for all the characters
	in asciiString, false otherwise.
	The default behaviour is to answer true, but subclasses may reimplement"
	
	^true! !

!AbstractFont methodsFor: 'accessing' stamp: 'ar 5/19/2000 14:56'!
characterToGlyphMap
	"Return the character to glyph mapping table. If the table is not provided the character scanner will query the font directly for the width of each individual character."
	^nil! !

!AbstractFont methodsFor: '*Multilingual-OtherLanguages' stamp: 'tpr 10/3/2013 12:57'!
scanMultibyteJapaneseCharactersFrom: startIndex to: stopIndex in: aWideString with: aCharacterScanner rightX: rightX
	"scan a multibyte Japanese character string"
	^aCharacterScanner scanJapaneseCharactersFrom: startIndex to: stopIndex in: aWideString rightX: rightX 
! !

!AbstractFont methodsFor: 'measuring' stamp: 'ar 5/19/2000 14:58'!
widthOf: aCharacter
	"Return the width of the given character"
	^self subclassResponsibility! !

!AbstractFont methodsFor: 'measuring' stamp: 'StephaneDucasse 12/29/2009 22:42'!
widthOfString: aString from: firstIndex to: lastIndex 
	"Measure the length of the given string between start and stop index"
	| resultX |
	resultX := 0.
	firstIndex 
		to: lastIndex
		do: [ :i | resultX := resultX + (self widthOf: (aString at: i)) ].
	^ resultX! !

!AbstractFont methodsFor: 'accessing' stamp: 'yo 1/7/2005 11:20'!
descent

	self subclassResponsibility.
! !

!AbstractFont methodsFor: '*FreeType-addition' stamp: 'tween 4/6/2007 12:58'!
isSubPixelPositioned
	"Answer true if the receiver is currently using subpixel positioned
	glyphs, false otherwise. This affects how padded space sizes are calculated
	when composing text. 
	Currently, only FreeTypeFonts are subPixelPositioned, and only when not
	Hinted"
	
	^false ! !

!AbstractFont methodsFor: '*Text-Scanning' stamp: 'tpr 10/3/2013 12:42'!
scanByteCharactersFrom: startIndex to: stopIndex in: aByteString with: aCharacterScanner rightX: rightX
	"scan a single byte character string"
	^aCharacterScanner scanByteCharactersFrom: startIndex to: stopIndex in: aByteString rightX: rightX! !

!AbstractFont methodsFor: 'accessing' stamp: 'yo 1/7/2005 11:19'!
basicDescentOf: aCharacter

	^ self descent.
! !

!AbstractFont methodsFor: 'accessing' stamp: 'nk 4/1/2004 10:48'!
pointSize
	self subclassResponsibility.! !

!AbstractFont methodsFor: 'accessing' stamp: 'yo 1/7/2005 11:18'!
basicAscentOf: aCharacter

	^ self ascent.
! !

!AbstractFont methodsFor: 'testing' stamp: 'nk 6/25/2003 12:54'!
isTTCFont
	^false! !

!AbstractFont class methodsFor: 'as yet unclassified' stamp: 'eem 6/11/2008 12:35'!
emphasisStringFor: emphasisCode
	"Answer a translated string that represents the attributes given in emphasisCode."

	| emphases |
	emphasisCode = 0 ifTrue: [ ^'Normal' translated ].

	emphases := (IdentityDictionary new)
		at: 1 put: 'Bold' translated;
		at: 2 put: 'Italic' translated;
		at: 4 put: 'Underlined' translated;
		at: 8 put: 'Narrow' translated;
		at: 16 put: 'StruckOut' translated;
		yourself.

	^String streamContents: [ :s | | bit |
		bit := 1.
		[ bit < 32 ] whileTrue: [ | code |
			code := emphasisCode bitAnd: bit.
			code isZero ifFalse: [ s nextPutAll: (emphases at: code); space ].
			bit := bit bitShift: 1 ].
		s position isZero ifFalse: [ s skip: -1 ].
	]! !

!AbstractFont class methodsFor: 'class initialization' stamp: 'PavelKrivanek 6/1/2011 12:47'!
initialize

  TextStyle addDependent: self.! !

!AbstractFont class methodsFor: 'updating' stamp: 'StephaneDucasse 6/2/2011 20:24'!
update: anAspect

	anAspect == #textDPIChanged ifTrue: [
		AbstractFont allSubInstancesDo: [ :font | font pixelsPerInchChanged ]].! !

!AbstractFont class methodsFor: '*system-settings-browser' stamp: 'alain.plantec 3/18/2009 14:49'!
settingInputWidgetForNode: aSettingNode
	^ aSettingNode inputWidgetForFont! !

!AbstractFontSelectorDialogWindow commentStamp: 'gvc 5/18/2007 13:04'!
Dialog based font chooser with preview.!
!AbstractFontSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 5/18/2007 13:07'!
previewText: anObject
	"Set the value of previewText"

	previewText := anObject.
	self changed: #previewText! !

!AbstractFontSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 4/21/2009 17:07'!
isUnderlined: anObject
	"Set the value of isUnderlined"

	isUnderlined := anObject.
	self changed: #isUnderlined! !

!AbstractFontSelectorDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 4/21/2009 17:21'!
updateFromSelectedFont
	"Update our state based on the selected font."

	self subclassResponsibility! !

!AbstractFontSelectorDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 9/26/2008 15:35'!
matchingFont
	"Answer the font that matches the selections."

	self subclassResponsibility! !

!AbstractFontSelectorDialogWindow methodsFor: 'actions' stamp: 'gvc 4/21/2009 17:48'!
newContentMorph
	"Answer a new content morph."

	self textPreviewMorph: self newTextPreviewMorph.
	^(self newColumn: {
		(self newRow: {
			self newGroupbox: 'Family' translated for:
				self newFontFamilyMorph.
			(self newColumn: {
				(self newGroupbox: 'Style' translated for: 
					self newFontStyleButtonRowMorph)
					vResizing: #shrinkWrap.
				self newGroupbox: 'Point size' translated for:
					self newFontSizeMorph})
				hResizing: #shrinkWrap})
			vResizing: #spaceFill.
		(self newGroupbox: 'Preview' translated for:
			self textPreviewMorph)
			vResizing: #shrinkWrap})
		minWidth: 350;
		minHeight: 400! !

!AbstractFontSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 5/3/2007 15:19'!
fontSizeIndex: anObject
	"Set the value of fontSizeIndex"

	fontSizeIndex := anObject.
	self updateSelectedFont! !

!AbstractFontSelectorDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 4/21/2009 17:33'!
textEmphasisCode
	"Answer the current bitmask for the text emphasis."

	^(((self isBold ifTrue: [1] ifFalse: [0]) bitOr:
		(self isItalic ifTrue: [2] ifFalse: [0])) bitOr:
		(self isUnderlined ifTrue: [4] ifFalse: [0])) bitOr:
		(self isStruckOut ifTrue: [16] ifFalse: [0])! !

!AbstractFontSelectorDialogWindow methodsFor: 'instance creation' stamp: 'gvc 8/7/2007 11:49'!
newFontSizeMorph
	"Answer a list for the font size of the font."

	^self
		newListFor: self
		list: #fontSizes
		selected: #fontSizeIndex
		changeSelected: #fontSizeIndex:
		help: nil! !

!AbstractFontSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 5/3/2007 13:41'!
textPreviewMorph
	"Answer the value of textPreviewMorph"

	^ textPreviewMorph! !

!AbstractFontSelectorDialogWindow methodsFor: 'instance creation' stamp: 'gvc 5/3/2007 16:31'!
newTextPreviewMorph
	"Answer a text entry morph for the preview of the font."

	^(self
		newTextEditorFor: self
		getText: #previewText 
		setText: nil
		getEnabled: nil)
		vResizing: #rigid;
		enabled: false;
		extent: 20@90! !

!AbstractFontSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 5/3/2007 14:30'!
fontSizeIndex
	"Answer the value of fontSizeIndex"

	^ fontSizeIndex! !

!AbstractFontSelectorDialogWindow methodsFor: 'initialization' stamp: 'gvc 4/21/2009 17:22'!
initialize
	"Initialize the receiver."

	self
		isBold: false;
		isItalic: false;
		isUnderlined: false;
		isStruckOut: false;
		previewText: self defaultPreviewText;
		fontFamilyIndex: 0;
		fontSizeIndex: 0.
	super initialize! !

!AbstractFontSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 5/3/2007 15:19'!
fontFamilyIndex: anObject
	"Set the value of fontFamilyIndex"

	fontFamilyIndex := anObject.
	self updateSelectedFont! !

!AbstractFontSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 5/3/2007 15:12'!
isStruckOut
	"Answer the value of isStruckOut"

	^ isStruckOut! !

!AbstractFontSelectorDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 5/3/2007 15:31'!
toggleStruckOut
	"Toggle the font struck out emphasis."

	self isStruckOut: self isStruckOut not.
	self updateSelectedFont! !

!AbstractFontSelectorDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 9/26/2008 15:49'!
defaultFontFamilies
	"Answer the set of available fonts families that are supported in the font that they represent."
	
	self subclassResponsibility! !

!AbstractFontSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 4/21/2009 17:30'!
previewText
	"Answer the value of previewText"

	^previewText asText addAttribute: (TextEmphasis new emphasisCode: self textEmphasisCode)! !

!AbstractFontSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 5/3/2007 15:12'!
isItalic
	"Answer the value of isItalic"

	^ isItalic! !

!AbstractFontSelectorDialogWindow methodsFor: 'instance creation' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
newStruckOutButtonMorph
	"Answer a button for the struck out emphasis of the font."
	
	^self
		newButtonFor: self
		getState: #isStruckOut
		action: #toggleStruckOut
		arguments: nil
		getEnabled: nil
		labelForm: Smalltalk ui icons smallStrikeOutIcon
		help: 'Toggle struck-out font' translated! !

!AbstractFontSelectorDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 5/3/2007 15:31'!
toggleItalic
	"Toggle the font italic emphasis."

	self isItalic: self isItalic not.
	self updateSelectedFont! !

!AbstractFontSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 5/3/2007 15:40'!
fontFamilies
	"Answer the set of available fonts families that are supported as Text objects
	in the font that they represent."
	
	^fontFamilies ifNil: [
		self fontFamilies: self defaultFontFamilies.
		fontFamilies]! !

!AbstractFontSelectorDialogWindow methodsFor: 'font description' stamp: 'gvc 5/3/2007 16:03'!
fontSize
	"Answer the selected font size or nil if none."

	(self fontSizeIndex between: 1 and: self fontSizes size)
		ifFalse: [^nil].
	^self fontSizes at: self fontSizeIndex! !

!AbstractFontSelectorDialogWindow methodsFor: 'instance creation' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
newItalicButtonMorph
	"Answer a button for the italic emphasis of the font."
	
	^self
		newButtonFor: self
		getState: #isItalic
		action: #toggleItalic
		arguments: nil
		getEnabled: nil
		labelForm: Smalltalk ui icons smallItalicIcon
		help: 'Toggle italic font' translated! !

!AbstractFontSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 5/3/2007 13:41'!
selectedFont
	"Answer the value of selectedFont"

	^ selectedFont! !

!AbstractFontSelectorDialogWindow methodsFor: 'instance creation' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
newBoldButtonMorph
	"Answer a button for the boldness of the font."
	
	^self
		newButtonFor: self
		getState: #isBold
		action: #toggleBold
		arguments: nil
		getEnabled: nil
		labelForm: Smalltalk ui icons smallBoldIcon
		help: 'Toggle bold font' translated! !

!AbstractFontSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 10/9/2007 14:19'!
selectedFont: anObject
	"Set the value of selectedFont"

	selectedFont := anObject ifNil: [TextStyle defaultFont].
	self updateFromSelectedFont! !

!AbstractFontSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 5/3/2007 14:30'!
fontFamilyIndex
	"Answer the value of fontFamilyIndex"

	^ fontFamilyIndex! !

!AbstractFontSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 4/21/2009 17:07'!
isStruckOut: anObject
	"Set the value of isStruckOut"

	isStruckOut := anObject.
	self changed: #isStruckOut! !

!AbstractFontSelectorDialogWindow methodsFor: 'instance creation' stamp: 'gvc 8/7/2007 11:49'!
newFontFamilyMorph
	"Answer a list for the font family of the font."

	|highestFont|
	highestFont := self fontFamilies first fontAt: 1 withStyle: TextStyle default.
	self fontFamilies do: [:ff | |f|
		f := ff fontAt: 1 withStyle: TextStyle default.
		f height > highestFont height
			ifTrue: [highestFont := f]].
	^(self
		newListFor: self
		list: #fontFamilies
		selected: #fontFamilyIndex
		changeSelected: #fontFamilyIndex:
		help: nil)
		font: highestFont! !

!AbstractFontSelectorDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 5/3/2007 15:31'!
toggleBold
	"Toggle the font bold emphasis."

	self isBold: self isBold not.
	self updateSelectedFont! !

!AbstractFontSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 5/3/2007 15:47'!
familyName
	"Answer the selected family name or nil if none."

	(self fontFamilyIndex between: 1 and: self fontFamilies size)
		ifFalse: [^nil].
	^(self fontFamilies at: self fontFamilyIndex) asString! !

!AbstractFontSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 4/21/2009 17:07'!
isItalic: anObject
	"Set the value of isItalic"

	isItalic := anObject.
	self changed: #isItalic! !

!AbstractFontSelectorDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 9/26/2008 15:31'!
defaultPreviewText
	"Answer the default text to use for the preview of the font."

	^(33 to: 127) asByteArray asString! !

!AbstractFontSelectorDialogWindow methodsFor: 'instance creation' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
newUnderlinedButtonMorph
	"Answer a button for the italic emphasis of the font."
	
	^self
		newButtonFor: self
		getState: #isUnderlined
		action: #toggleUnderlined
		arguments: nil
		getEnabled: nil
		labelForm: Smalltalk ui icons smallUnderlineIcon
		help: 'Toggle underlined font' translated! !

!AbstractFontSelectorDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 5/3/2007 14:31'!
fontSizes
	"Answer the set of available fonts sizes that are supported."

	^#(6 7 8 9 10 11 12 13 14 15 16 18 20 21 22 24 26 28 32 36 48)! !

!AbstractFontSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 5/3/2007 15:02'!
fontFamilies: anObject
	"Set the value of fontFamilies"

	fontFamilies := anObject! !

!AbstractFontSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 5/3/2007 13:41'!
textPreviewMorph: anObject
	"Set the value of textPreviewMorph"

	textPreviewMorph := anObject! !

!AbstractFontSelectorDialogWindow methodsFor: 'instance creation' stamp: 'gvc 4/21/2009 17:48'!
newFontStyleButtonRowMorph
	"Answer a new font style button row morph."

	^self newRow: {
		self newBoldButtonMorph.
		self newItalicButtonMorph.
		self newUnderlinedButtonMorph.
		self newStruckOutButtonMorph}! !

!AbstractFontSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 5/3/2007 15:12'!
isBold
	"Answer the value of isBold"

	^ isBold! !

!AbstractFontSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 5/3/2007 15:12'!
isUnderlined
	"Answer the value of isUnderlined"

	^ isUnderlined! !

!AbstractFontSelectorDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 5/3/2007 15:31'!
toggleUnderlined
	"Toggle the font underlined emphasis."

	self isUnderlined: self isUnderlined not.
	self updateSelectedFont! !

!AbstractFontSelectorDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 5/4/2007 10:25'!
updateSelectedFont
	"Update the selected font to reflect the choices."

	self selectedFont: self matchingFont! !

!AbstractFontSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 4/21/2009 17:07'!
isBold: anObject
	"Set the value of isBold"

	isBold := anObject.
	self changed: #isBold! !

!AbstractFontSelectorDialogWindow class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
taskbarIcon
	"Answer the icon for the receiver in a task bar."

	^ Smalltalk ui icons smallFontsIcon! !

!AbstractGroup commentStamp: '<historical>'!
AbstractGroup is an abstraction of what a group is.!
!AbstractGroup methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/18/2011 14:00'!
beReadOnly

	readOnly := true! !

!AbstractGroup methodsFor: 'polymorphism' stamp: 'BenjaminVanRyseghem 3/28/2011 13:50'!
blocks

	^ { [ self elements ] }! !

!AbstractGroup methodsFor: 'queries' stamp: 'BenjaminVanRyseghem 2/25/2012 15:32'!
protocolsFor: aClass

	^ aClass protocols select: [:e | self methods anySatisfy: [:m | m category = e ]].! !

!AbstractGroup methodsFor: 'announcements registration' stamp: 'BernardoContreras 10/7/2014 11:52'!
registerToMethodAnnouncements
	
	SystemAnnouncer uniqueInstance weak
		when: MethodModified send: #methodModified: to: self;
		when: MethodRemoved send: #methodRemoved: to: self.! !

!AbstractGroup methodsFor: '*Nautilus' stamp: 'EstebanLorenzano 10/10/2013 16:10'!
asNautilusSelection 
	^ PackageTreeGroupSelection group: self! !

!AbstractGroup methodsFor: 'announcements registration' stamp: 'BernardoContreras 10/7/2014 11:51'!
registerToClassAnnouncements

	SystemAnnouncer uniqueInstance weak
		when: ClassRemoved send: #classRemoved: to: self! !

!AbstractGroup methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/2/2012 17:07'!
isFillable: aBoolean

	isFillable := aBoolean! !

!AbstractGroup methodsFor: 'queries' stamp: 'EstebanLorenzano 10/9/2013 17:23'!
packages 
	^ (self classes 
		collect: #package 
		as: Set)
		asArray! !

!AbstractGroup methodsFor: 'announcements' stamp: 'BenjaminVanRyseghem 4/14/2012 12:22'!
methodRemoved: anAnnouncement

	self subclassResponsibility! !

!AbstractGroup methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 4/14/2012 12:17'!
initialize

	super initialize.
	readOnly := false.
	self registerToAnnouncements.! !

!AbstractGroup methodsFor: 'printing' stamp: 'BenjaminVanRyseghem 3/29/2011 11:20'!
printOn: aStream

	| className article |
	className := self class name.
	article := className first isVowel
				ifTrue: ['an']
				ifFalse: ['a'].
	aStream
		nextPutAll: article;
		nextPut: Character space;
		nextPutAll: className;
		nextPutAll: ' ( ';
		nextPutAll: self name asString;
		nextPutAll: ' )'.! !

!AbstractGroup methodsFor: 'queries' stamp: 'BenjaminVanRyseghem 2/25/2012 16:57'!
methodsFor: aClass categorised: aSymbol
	
	aSymbol ifNil: [ "all" 
		^ self methodsFor: aClass ].

	^ self methods select: [:e | e methodClass = aClass and: [ e category = aSymbol ]].! !

!AbstractGroup methodsFor: 'private' stamp: 'BenjaminVanRyseghem 3/18/2011 16:57'!
ifAllowed: aBlock

	^ self ifAllowed: aBlock ifNot: []! !

!AbstractGroup methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/2/2012 17:14'!
isFillable

	^ isFillable ifNil: [ isFillable := false ]! !

!AbstractGroup methodsFor: '*Nautilus' stamp: 'NicolaiHess 4/2/2015 17:22'!
asNautilusItemPath
	^ Array with: self name! !

!AbstractGroup methodsFor: 'private' stamp: 'BenjaminVanRyseghem 3/24/2011 13:16'!
sortBlock: aBlock

	sortBlock := aBlock! !

!AbstractGroup methodsFor: 'queries' stamp: 'BenjaminVanRyseghem 2/25/2012 15:26'!
methods

	^ self elements! !

!AbstractGroup methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 3/24/2011 13:41'!
removable

	^ removable ifNil: [ removable := true ]! !

!AbstractGroup methodsFor: 'queries' stamp: 'BenjaminVanRyseghem 2/25/2012 15:28'!
classes

	^ self subclassResponsibility! !

!AbstractGroup methodsFor: '*Nautilus' stamp: 'GuillermoPolito 8/10/2014 13:14'!
categoryName
	"This is the package name set if a class is intended to be created in this group"
	^ 'Unknown'! !

!AbstractGroup methodsFor: 'announcements' stamp: 'BenjaminVanRyseghem 4/14/2012 12:22'!
methodModified: anAnnouncement

	self subclassResponsibility! !

!AbstractGroup methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/24/2011 13:39'!
removable: aBoolean

	removable := aBoolean! !

!AbstractGroup methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/18/2011 14:22'!
elements

	^ self subclassResponsibility! !

!AbstractGroup methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/18/2011 14:04'!
name: aString

	self ifAllowed: [ name := aString ]! !

!AbstractGroup methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 4/14/2011 21:55'!
isReadOnly

	^ readOnly == true! !

!AbstractGroup methodsFor: 'announcements' stamp: 'BenjaminVanRyseghem 4/14/2012 12:22'!
classRemoved: anAnnouncement

	self subclassResponsibility! !

!AbstractGroup methodsFor: 'announcements registration' stamp: 'BenjaminVanRyseghem 4/14/2012 12:38'!
registerToAnnouncements

	self 
		registerToClassAnnouncements;
		registerToMethodAnnouncements! !

!AbstractGroup methodsFor: 'queries' stamp: 'BenjaminVanRyseghem 2/25/2012 15:38'!
methodsFor: aClass

	^ self methods select: [:e | e methodClass = aClass ].! !

!AbstractGroup methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/18/2011 14:03'!
name

	^ name! !

!AbstractGroup methodsFor: 'private' stamp: 'BenjaminVanRyseghem 3/18/2011 16:57'!
ifAllowed: aBlock ifNot: anotherBlock

	^ self isReadOnly
		ifTrue: anotherBlock
		ifFalse: aBlock! !

!AbstractGroup methodsFor: 'private' stamp: 'BenjaminVanRyseghem 3/24/2011 13:20'!
sortBlock

	^ sortBlock ifNil: [ sortBlock := [:a :b | a printString <= b printString ]]! !

!AbstractGroup class methodsFor: 'instance creation' stamp: 'StephaneDucasse 11/30/2013 17:23'!
cleanUp

	self unsubscribeExistingGroups.! !

!AbstractGroup class methodsFor: 'instance creation' stamp: 'MarianoMartinezPeck 8/5/2012 15:56'!
new

	| instance |
	instance := self basicNew initialize.
	GroupAnnouncer uniqueInstance announce: (AGroupHasBeenCreated group: instance).
	^ instance! !

!AbstractGroup class methodsFor: 'instance creation' stamp: 'StephaneDucasse 11/30/2013 17:24'!
unsubscribeExistingGroups
	"self unsubscribeExistingGroups"
	
	self allSubInstances do: [ :each |  SystemAnnouncer uniqueInstance unsubscribe: each ].
	! !

!AbstractGroup class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 3/18/2011 14:06'!
named: aString

	^ self new name: aString! !

!AbstractGroupAnnouncement commentStamp: 'TorstenBergmann 2/4/2014 21:09'!
Common superclass for group announcements!
!AbstractGroupAnnouncement methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/14/2011 16:31'!
holder

		^ holder! !

!AbstractGroupAnnouncement methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/14/2011 16:31'!
group

		^ group! !

!AbstractGroupAnnouncement methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/14/2011 16:31'!
group: anObject
	
		group := anObject! !

!AbstractGroupAnnouncement methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/14/2011 16:31'!
holder: anObject
	
		holder := anObject! !

!AbstractGroupAnnouncement class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 4/14/2011 22:40'!
group: aGroup

	^ self new 
		group: aGroup;
		yourself! !

!AbstractGroupAnnouncement class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 4/14/2011 16:32'!
group: aGroup from: anHolder

	^ self new 
		group: aGroup;
		holder: anHolder;
		yourself! !

!AbstractKeyPressedPlugin commentStamp: 'StephaneDucasse 10/30/2014 07:36'!
AbstractKeyPressedPlugin is an abstract plugin which reacts to key strokes by sending the message keyPressed to the plugin.!
!AbstractKeyPressedPlugin methodsFor: 'registration' stamp: 'BernardoContreras 10/22/2014 19:11'!
registerTo: aModel

	aModel announcer
		when: NautilusKeyPressed send: #keyPressed: to: self! !

!AbstractKeyPressedPlugin methodsFor: 'announcement' stamp: 'BenjaminVanRyseghem 5/4/2011 15:05'!
keyPressed: anAnnouncement

	self subclassResponsibility! !

!AbstractKeymappingTest methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 5/31/2011 19:51'!
eventKey: character 
	^ self eventKey: character
		alt: false
		ctrl: false
		command: false
		shift: false! !

!AbstractKeymappingTest methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 2/19/2011 18:44'!
tearDown
	KMRepository default: default! !

!AbstractKeymappingTest methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 5/31/2011 19:52'!
eventKey: character shift: aBoolean
	^ self eventKey: character
		alt: false
		ctrl: false
		command: false
		shift: aBoolean! !

!AbstractKeymappingTest methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 5/31/2011 19:52'!
eventKey: character command: aBoolean
	^ self eventKey: character
		alt: false
		ctrl: false
		command: aBoolean
		shift: false! !

!AbstractKeymappingTest methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 5/31/2011 19:51'!
eventKey: character ctrl: aBoolean
	^ self eventKey: character
		alt: false
		ctrl: aBoolean
		command: false
		shift: false! !

!AbstractKeymappingTest methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 5/31/2011 19:51'!
eventKey: character alt: aBoolean
	^ self eventKey: character
		alt: aBoolean
		ctrl: false
		command: false
		shift: false! !

!AbstractKeymappingTest methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 2/19/2011 18:44'!
setUp
	default := KMRepository default.
	KMRepository default: KMRepository new! !

!AbstractKeymappingTest methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 5/31/2011 19:51'!
eventKey: character alt: useAlt ctrl: useCtrl command: useCommand shift: useShift
	| event modifier code |
	event := KeyboardEvent new.
	modifier := 0.
	
	useShift 
		ifTrue: [ modifier := modifier + 8].
	useCtrl 
		ifTrue: [ modifier := modifier + 16].
	useAlt 
		ifTrue: [ modifier := modifier + 32].
	useCommand
		ifTrue: [ modifier := modifier + 64].
	
	code := character asInteger.
	event 
		setType: #keystroke
		buttons: modifier
		position:  0@0
		keyValue: code
		charCode: code
		hand: nil 
		stamp: Time now.
	^ event 	! !

!AbstractLayout commentStamp: '<historical>'!
I'm a container for slots.

There are special cases of layouts without slots, like NilLayout or BitsLayout.!
!AbstractLayout methodsFor: 'accessing' stamp: 'ToonVerwaest 4/7/2011 12:10'!
resolveSlot: aName
	self flag: 'Signal rather than error'.
	self error: 'No slots found'! !

!AbstractLayout methodsFor: 'accessing' stamp: 'ToonVerwaest 4/1/2011 03:38'!
instanceVariables
	^ {}! !

!AbstractLayout methodsFor: 'testing' stamp: 'ToonVerwaest 4/1/2011 03:37'!
hasFields
	^ false! !

!AbstractLayout methodsFor: 'accessing' stamp: 'MarcusDenker 6/25/2014 12:56'!
slots
	^ {}! !

!AbstractLayout methodsFor: 'accessing' stamp: 'MartinDias 8/6/2012 22:31'!
slotScope
	^ LayoutEmptyScope instance! !

!AbstractLayout methodsFor: 'testing' stamp: 'ToonVerwaest 4/1/2011 03:37'!
hasSlots
	^ false! !

!AbstractLayout methodsFor: 'validation' stamp: 'MartinDias 7/8/2013 17:22'!
checkIntegrity
	self checkSanity! !

!AbstractLayout methodsFor: 'accessing' stamp: 'ToonVerwaest 4/1/2011 03:37'!
fieldSize
	^ 0! !

!AbstractLayout methodsFor: 'api' stamp: 'MarcusDenker 4/9/2015 10:08'!
hasSlot: aSlot
	^ self allSlots identityIncludes: aSlot ! !

!AbstractLayout methodsFor: 'accessing' stamp: 'MarcusDenker 2/5/2015 15:47'!
visibleSlots
	^self slots select: [:slot | slot isVisible]! !

!AbstractLayout methodsFor: 'testing' stamp: 'ToonVerwaest 4/1/2011 03:37'!
isVariable
	^ false! !

!AbstractLayout methodsFor: 'accessing' stamp: 'MartinDias 8/7/2013 17:56'!
host: aClass
	host := aClass! !

!AbstractLayout methodsFor: 'testing' stamp: 'ToonVerwaest 4/1/2011 03:37'!
isWeak
	^ false! !

!AbstractLayout methodsFor: 'accessing' stamp: 'ToonVerwaest 4/1/2011 01:52'!
host
	^ host! !

!AbstractLayout methodsFor: 'comparing' stamp: 'MartinDias 4/12/2013 13:20'!
hash
	^ self class hash! !

!AbstractLayout methodsFor: 'finalization' stamp: 'ToonVerwaest 4/7/2011 12:08'!
finalize
	self allSlotsDo: [ :aSlot | aSlot finalize: self ]! !

!AbstractLayout methodsFor: 'enumerating' stamp: 'MartinDias 8/7/2012 00:42'!
allSlotsDo: aBlock
	self slotScope allSlotsDo: aBlock! !

!AbstractLayout methodsFor: 'testing' stamp: 'ToonVerwaest 4/1/2011 03:37'!
isBits
	^ false! !

!AbstractLayout methodsFor: 'api' stamp: 'MarcusDenker 4/9/2015 10:08'!
definesSlot: aSlot 
	^self slots identityIncludes: aSlot ! !

!AbstractLayout methodsFor: 'accessing' stamp: 'ToonVerwaest 4/3/2011 22:58'!
allSlots
	^ {}! !

!AbstractLayout methodsFor: 'comparing' stamp: 'MartinDias 4/12/2013 13:15'!
= other
	^ self class = other class! !

!AbstractLayout methodsFor: 'validation' stamp: 'ToonVerwaest 4/1/2011 03:38'!
checkSanity
	host ifNil: [ self error: 'Host should not be nil' ].! !

!AbstractLayout methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 1/22/2015 13:14'!
slotsDictionary

	^ Dictionary new! !

!AbstractLayout methodsFor: 'api' stamp: 'MarcusDenker 4/9/2015 10:08'!
hasSlotNamed: aString
	^self allSlots anySatisfy: [:slot | slot name = aString  ]! !

!AbstractLayout methodsFor: 'accessing' stamp: 'ToonVerwaest 4/2/2011 19:07'!
allVisibleSlots
	^ {}! !

!AbstractMethodConverter commentStamp: '<historical>'!
An AbstractMessageConverter is a wrapper used to switch which information to retrieve from a method.

This way, you can avoid switch case, you just have to use set the correct filter!
!AbstractMethodConverter methodsFor: 'accessing' stamp: ''!
method

	^ method! !

!AbstractMethodConverter methodsFor: 'accessing' stamp: ''!
method: aMessage

	method := aMessage! !

!AbstractMethodConverter methodsFor: 'protocol' stamp: ''!
getTextFor: aMethod

	method := aMethod.
	method ifNil: [ ^ '' ].
	
	^ self internalGetText! !

!AbstractMethodConverter methodsFor: 'initialization' stamp: ''!
shouldShout

	^ false! !

!AbstractMethodConverter methodsFor: 'private' stamp: ''!
internalGetText

	^ self subclassResponsibility! !

!AbstractMethodConverter methodsFor: 'protocol' stamp: ''!
getText

	method ifNil: [ ^ '' ].	
	^ self internalGetText! !

!AbstractMethodConverter class methodsFor: 'instance creation' stamp: ''!
method: aMessage

	^ self new
		method: aMessage;
		yourself! !

!AbstractMethodIconAction commentStamp: '<historical>'!
AbstractMethodIconAction is the common super class for all the method icon actions.

A method icon action is used to retrieve the correct icon the method in nautilus lists!
!AbstractMethodIconAction methodsFor: 'order' stamp: 'BenjaminVanRyseghem 1/2/2013 12:41'!
isActionHandled
	"Return true if the provided method fits this action requirement"
	
	^ self subclassResponsibility! !

!AbstractMethodIconAction methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/2/2013 12:16'!
method: aMethod

	method := aMethod! !

!AbstractMethodIconAction methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/2/2013 12:33'!
browser: aBrowser

	browser := aBrowser! !

!AbstractMethodIconAction methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/2/2013 12:33'!
browser

	^ browser! !

!AbstractMethodIconAction methodsFor: 'order' stamp: 'BenjaminVanRyseghem 1/2/2013 12:53'!
actionStateToCache
	"Return the state of the icon for caching purpose"
	
	^ IconicButtonStateHolder forNautilus: icon! !

!AbstractMethodIconAction methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/2/2013 12:34'!
method

	^ method! !

!AbstractMethodIconAction methodsFor: 'order' stamp: 'BenjaminVanRyseghem 1/2/2013 12:50'!
privateActionIcon
	
	^ self subclassResponsibility! !

!AbstractMethodIconAction methodsFor: 'order' stamp: 'BenjaminVanRyseghem 1/2/2013 12:50'!
actionIcon
	"Return the icon for this action"
	
	^ icon := self privateActionIcon! !

!AbstractMethodIconAction methodsFor: 'order' stamp: 'BenjaminVanRyseghem 1/2/2013 12:24'!
actionOrder
	"Return the priority of this action"
	
	^ self subclassResponsibility! !

!AbstractMethodIconAction class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 1/2/2013 12:34'!
for: aMethod in: aBrowser

	^ self new
		method: aMethod;
		browser: aBrowser;
		yourself! !

!AbstractMethodReferenceConverter commentStamp: 'TorstenBergmann 2/20/2014 13:48'!
Abstract wrapper for method references!
!AbstractMethodReferenceConverter methodsFor: 'private' stamp: ''!
priorVersionOfAMethod: aMethodReference
	| tempList |
	
	tempList := referencesList select:[:each | 
		(each className = aMethodReference className) & 
		(each name = aMethodReference name)].
	^ tempList detect: [:each | (self versionOfAMethod: each) = ((self versionOfAMethod: aMethodReference) -1)] ifNone: [aMethodReference].! !

!AbstractMethodReferenceConverter methodsFor: 'accessing' stamp: ''!
referencesList: aListOfReferences

	referencesList := aListOfReferences! !

!AbstractMethodReferenceConverter methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 22:52'!
initialize

	super initialize.
	referencesList := #()! !

!AbstractMethodReferenceConverter methodsFor: 'private' stamp: ''!
versionOfAMethod: aMethodReference
	| tempList |
	
	tempList := referencesList select: [:each | 
		(each className = aMethodReference className) & 
		(each name = aMethodReference name)].
	tempList := tempList sort: [:m1 :m2 | m1 timeStamp < m2 timeStamp].
	^ tempList identityIndexOf: aMethodReference ifAbsent: [0]! !

!AbstractMethodReferenceConverter class methodsFor: 'instance creation' stamp: 'MarcusDenker 8/13/2014 15:18'!
methodReference: aMessage referencesList: aListOfReferences
	^ (self method: aMessage)
		referencesList: aListOfReferences;
		yourself! !

!AbstractMethodUpdateStrategy commentStamp: '<historical>'!
I am used to update compiled methods in response to class modifications.
My sublcasses implement different strategies to update affected methods.!
!AbstractMethodUpdateStrategy methodsFor: 'updating' stamp: 'MartinDias 7/30/2012 00:08'!
transform: oldClass to: newClass using: aMethodModification

	self subclassResponsibility ! !

!AbstractMethodWidget commentStamp: '<historical>'!
AbstractMethodWidget is an abstraction describing a widget used to manage methods!
!AbstractMethodWidget methodsFor: 'protocol' stamp: ''!
vScrollValue

	^ self subclassResponsibility! !

!AbstractMethodWidget methodsFor: 'protocol' stamp: ''!
selectedMethod

	^ self model selectedMethod! !

!AbstractMethodWidget methodsFor: 'icon' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
buildUpAndDownArrowIcon: aMethod

	| container up down |
	
	container := Morph new.
	container 
		extent: 12@12;
		color: Color transparent.
		
	up := IconicButton new 
				target: self model;
				actionSelector: #arrowUp:;
				arguments: { aMethod };
				labelGraphic: (Smalltalk ui icons iconNamed: #arrowDoubleUpIcon);
				color: Color transparent;
				extent: 12 @ 6;
				helpText: 'Browse overriden message';
				borderWidth: 0.
				
	down :=  IconicButton new 
				target: self model;
				actionSelector: #arrowDown:;
				arguments: { aMethod };
				labelGraphic: (Smalltalk ui icons iconNamed: #arrowDoubleDownIcon);
				color: Color transparent;
				extent: 12 @ 6;
				helpText: 'Browse overriding messages';
				borderWidth: 0.
				
	^ (container
		changeTableLayout;
		listDirection: #topToBottom;
		addMorph: down;
		addMorph: up;
		yourself) -> {up. down}.! !

!AbstractMethodWidget methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/14/2012 11:57'!
selectMethod: aMethod

	self subclassResponsibility! !

!AbstractMethodWidget methodsFor: 'icon' stamp: ''!
rebuildUpAndDownArrowIconFrom: array

	| container up down |
	
	container := Morph new.
	container 
		extent: 12@12;
		color: Color transparent.
		
	up := array first asIconTargetting: self model.
				
	down := array second asIconTargetting: self model.
				
	^ container
		changeTableLayout;
		listDirection: #topToBottom;
		addMorph: down;
		addMorph: up;
		yourself! !

!AbstractMethodWidget methodsFor: 'item creation' stamp: ''!
buildMethodsList

	^ self subclassResponsibility! !

!AbstractMethodWidget methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 8/6/2012 19:41'!
selectedMethod: aMethod
	"I check if it's ok here to work better with the drag/drop mechanism"

	self model selectedMethod: aMethod! !

!AbstractMethodWidget methodsFor: 'protocol' stamp: ''!
selectedMethods

	^ self subclassResponsibility! !

!AbstractMethodWidget methodsFor: 'initialization' stamp: ''!
initialize

	super initialize.
	MethodsIconsCache ifNil: [ MethodsIconsCache := WeakIdentityKeyDictionary new ]! !

!AbstractMethodWidget methodsFor: 'protocol' stamp: 'NicolaiHess 8/9/2014 21:08'!
resetMethodSelection
	self subclassResponsibility ! !

!AbstractMethodWidget methodsFor: 'protocol' stamp: ''!
getMethods

	^ self model getMethods! !

!AbstractMethodWidget methodsFor: 'protocol' stamp: ''!
label: aString

	^ self subclassResponsibility! !

!AbstractMethodWidget methodsFor: 'protocol' stamp: ''!
takeKeyboardFocus

	^ self subclassResponsibility! !

!AbstractMethodWidget methodsFor: 'protocol' stamp: ''!
elementsMenu: aMenuMorph shifted: aBoolean 
	
	^ self model elementsMenu: aMenuMorph shifted: aBoolean ! !

!AbstractMethodWidget methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 4/4/2012 16:05'!
setIcon: icon for: method

	MethodsIconsCache at: method put: icon! !

!AbstractMethodWidget methodsFor: 'protocol' stamp: 'NicolaiHess 8/9/2014 21:08'!
resetMethodList
	self subclassResponsibility ! !

!AbstractMethodWidget methodsFor: 'protocol' stamp: ''!
keyPressedOnElement: anEvent 

	^ self subclassResponsibility! !

!AbstractMethodWidget methodsFor: 'protocol' stamp: ''!
removeAllFromMethodsIconsCache: aMethod

	^ self subclassResponsibility! !

!AbstractMethodWidget methodsFor: 'drag and drop' stamp: 'NicolaiHess 7/28/2014 21:56'!
dragPassengersFor: item inMorph: dragSource 

	| transferType object |
	(dragSource isKindOf: PluggableListMorph) ifFalse: [^ nil ].
	transferType := self dragTransferTypeForMorph: dragSource.
	transferType == #getMethodItem: ifFalse: [ ^ nil ].
	object := item originalObject.

	^ self selectedMethods
		ifEmpty: [
			 (self getMethods includes: object)
				ifTrue: [ { object } ]]! !

!AbstractMethodWidget methodsFor: 'protocol' stamp: ''!
methodsSelection

	^ self subclassResponsibility! !

!AbstractMethodWidget methodsFor: 'icon' stamp: ''!
methodsIconsCache

	^ MethodsIconsCache! !

!AbstractMethodWidget methodsFor: 'protocol' stamp: 'NicolaiHess 8/9/2014 21:21'!
updateMethodList
	self subclassResponsibility ! !

!AbstractMethodWidget methodsFor: 'protocol' stamp: ''!
showInstance

	^ self model showInstance! !

!AbstractMethodWidget methodsFor: 'icon' stamp: 'NicolaiHess 7/28/2014 21:56'!
methodIconFor: aMethod

	| actions button action |
	button := nil.
	MethodsIconsCache
		at: aMethod
		ifPresent: [:icon | 
			icon isArray ifTrue: [ ^ self rebuildUpAndDownArrowIconFrom: icon].
			icon class == IconicButtonStateHolder ifFalse: [ ^ icon ].
			^ icon asIcon ].

	actions := AbstractMethodIconAction allSubclasses collect: [:class | class for: aMethod in: self model ].
	actions sort: [:a :b | a actionOrder < b actionOrder ].
	action := actions 
		detect: [:each | each isActionHandled ]. 
	
	"actionIcon need to be invoked before actionStateToCache"
	button := action actionIcon.
	MethodsIconsCache at: aMethod put: action actionStateToCache.
	^ button! !

!AbstractMethodWidget methodsFor: 'protocol' stamp: ''!
vScrollValue: aNumber

	^ self subclassResponsibility! !

!AbstractMethodWidget methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 4/17/2012 17:13'!
okToChange

	^ self model okToChange. ! !

!AbstractMethodWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/28/2014 21:57'!
invalidateCacheEntryFor: aMethod
	self subclassResponsibility ! !

!AbstractMethodWidget class methodsFor: 'icon' stamp: 'CamilloBruni 5/7/2013 23:34'!
resetMethodIconCache

	MethodsIconsCache removeAll! !

!AbstractMethodWidget class methodsFor: 'icon' stamp: 'BenjaminVanRyseghem 6/18/2013 15:57'!
methodsIconsCache

	^ MethodsIconsCache! !

!AbstractModification commentStamp: '<historical>'!
Modifications to a high-level class have an impact on the related low-level structures. There are two modification models that transform the high-level model into concrete low-level modifications models, the method modification model and the instance modification model. Both models list for every field, whether it was added, removed, or shifted to a new position.

Instance Variables:
	slotShift	<Integer>
	modificationMap	<(Collection of: AbstractFieldModification)>!
!AbstractModification methodsFor: 'accessing' stamp: 'ToonVerwaest 3/24/2011 12:18'!
size
	^ modificationMap size.! !

!AbstractModification methodsFor: 'accessing' stamp: 'ToonVerwaest 3/24/2011 11:37'!
slotShift: aShift
	slotShift := aShift! !

!AbstractModification methodsFor: 'installing' stamp: 'ToonVerwaest 3/28/2011 17:12'!
installAddedSlot: addedSlot
	self subclassResponsibility! !

!AbstractModification methodsFor: 'installing' stamp: 'ToonVerwaest 3/28/2011 17:12'!
installRemovedSlot: removedSlot
	self subclassResponsibility! !

!AbstractModification methodsFor: 'initialize-release' stamp: 'ToonVerwaest 3/28/2011 19:46'!
initialize: anInteger
	self initialize.
	modificationMap := Array new: anInteger.! !

!AbstractModification methodsFor: 'installing' stamp: 'ToonVerwaest 3/28/2011 17:12'!
installModifiedSlot: modifiedSlot
	self subclassResponsibility! !

!AbstractModification methodsFor: 'accessing' stamp: 'ToonVerwaest 3/30/2011 13:52'!
modificationAt: idx
	idx > modificationMap size 
		ifTrue: [ ^ slotShift ].
	^ modificationMap at: idx! !

!AbstractModification methodsFor: 'installing' stamp: 'ToonVerwaest 3/28/2011 17:29'!
installUnmodifiedSlot: unmodifiedSlot
	modificationMap
		at: unmodifiedSlot fieldIndex
		put: unmodifiedSlot! !

!AbstractModification class methodsFor: 'instance creation' stamp: 'ToonVerwaest 3/24/2011 12:17'!
new: anInteger
	^ self new initialize: anInteger ! !

!AbstractMorphicAdapter commentStamp: '<historical>'!
I am an abstract class providing all the properties shared amongs all the morphic specific adapters!
!AbstractMorphicAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/29/2013 12:45'!
hSpaceFill
	
	self widgetDo: [ :w | w hResizing: #spaceFill ]! !

!AbstractMorphicAdapter methodsFor: 'drag and drop - private' stamp: 'BenjaminVanRyseghem 9/25/2013 14:09'!
acceptDroppingMorph: draggedMorph event: event inMorph: source

	^ self acceptDropBlock cull: draggedMorph cull: event cull: source! !

!AbstractMorphicAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/25/2013 15:28'!
enabled
	
	^ self model enabled! !

!AbstractMorphicAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/29/2013 12:44'!
hRigid
	
	self widgetDo: [ :w | w hResizing: #rigid ]! !

!AbstractMorphicAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/29/2013 12:46'!
vShrinkWrap
	
	self widgetDo: [ :w | w vResizing: #shrinkWrap ]! !

!AbstractMorphicAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/29/2013 15:20'!
layout: aLayout
	| layout |
	
	layout := aLayout asMorphicLayout.

	self widgetDo: [ :w | w layoutFrame: layout ]! !

!AbstractMorphicAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/29/2013 12:45'!
hShrinkWrap
	
	self widgetDo: [ :w | w hResizing: #shrinkWrap ]! !

!AbstractMorphicAdapter methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 9/25/2013 16:22'!
dropEnabled: aBoolean

	self widget ifNotNil: [ :w | w dropEnabled: aBoolean ]! !

!AbstractMorphicAdapter methodsFor: 'protocol-shortcuts' stamp: 'BenjaminVanRyseghem 11/12/2013 16:15'!
removeKeyCombination: aShortcut

	self widget ifNotNil: [ :w | w removeKeyCombination: aShortcut ]! !

!AbstractMorphicAdapter methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 9/25/2013 16:22'!
dragEnabled: aBoolean

	self widget ifNotNil: [ :w | w dragEnabled: aBoolean ]! !

!AbstractMorphicAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 1/23/2014 16:12'!
color: color

	self widgetDo: [ :w | w color: color ]! !

!AbstractMorphicAdapter methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 9/25/2013 15:28'!
dropEnabled

	^ self model dropEnabled! !

!AbstractMorphicAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/29/2013 12:45'!
removeSubWidgets
	
	self widgetDo: [ :w | w removeAllMorphs ]! !

!AbstractMorphicAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/25/2013 15:28'!
enable

	self model enabled: true! !

!AbstractMorphicAdapter methodsFor: 'protocol-shortcuts' stamp: 'BenjaminVanRyseghem 11/12/2013 10:47'!
bindKeyCombination: aShortcut toAction: aBlock

	self widget ifNotNil: [ :w | w bindKeyCombination: aShortcut toAction: aBlock ]! !

!AbstractMorphicAdapter methodsFor: 'dispatch' stamp: 'BenjaminVanRyseghem 9/25/2013 18:19'!
treeRenderOn: aCanvas bounds: drawBounds color: drawColor font: aFont from: aMorph
	"Specify how this object as a list item should be drawn"

	self widget ifNil: [ self buildWithSpec ].
	self widget treeRenderOn: aCanvas bounds: drawBounds color: drawColor font: aFont from: aMorph! !

!AbstractMorphicAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/25/2013 15:27'!
disable
	
	self model enabled: false! !

!AbstractMorphicAdapter methodsFor: 'dispatch' stamp: 'BenjaminVanRyseghem 9/25/2013 18:19'!
heightToDisplayInTree: aTree
	"Return the width of my representation as a list item"
	
	self extent ifNotNil: [:ex | ^ ex y ].
	self initialExtent ifNotNil: [:ex | ^ ex y ].
	
	self widget ifNil: [ self buildWithSpec ].
	^ self widget heightToDisplayInTree: aTree! !

!AbstractMorphicAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/29/2013 12:46'!
useProportionalLayout

	self widgetDo: [ :w | w changeProportionalLayout ]! !

!AbstractMorphicAdapter methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 9/25/2013 15:24'!
acceptDropBlock

	^ self model acceptDropBlock! !

!AbstractMorphicAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 12/1/2013 01:10'!
setModal: aWindow 

	self widgetDo: [ :w | w setModal: aWindow ]! !

!AbstractMorphicAdapter methodsFor: 'protocol' stamp: 'CamilloBruni 10/15/2013 20:56'!
extent

	^ self widget extent! !

!AbstractMorphicAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/21/2013 10:20'!
delete
	
	self widgetDo: [ :w | w delete ]! !

!AbstractMorphicAdapter methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 10/10/2013 12:15'!
isMorphicAdapter

	^ true! !

!AbstractMorphicAdapter methodsFor: 'protocol-shortcuts' stamp: 'BenjaminVanRyseghem 11/12/2013 10:54'!
bindMenuKeyCombination: aShortcut toAction: aBlock

	self widget ifNotNil: [ :w | w bindKeyCombination: aShortcut toAction: aBlock ]! !

!AbstractMorphicAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/25/2013 15:29'!
help

	^ self model help! !

!AbstractMorphicAdapter methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 9/25/2013 15:29'!
transferBlock

	^ self model transferBlock! !

!AbstractMorphicAdapter methodsFor: 'dispatch' stamp: 'BenjaminVanRyseghem 9/25/2013 18:19'!
widthToDisplayInTree: aTree
	"Return the width of my representation as a list item"
	
	self extent ifNotNil: [:ex | ^ ex x ].
	self initialExtent ifNotNil: [:ex | ^ ex x ].
	
	self widget ifNil: [ self buildWithSpec ].
	^ self widget widthToDisplayInTree: aTree! !

!AbstractMorphicAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/1/2013 13:14'!
when: anAnnouncement do: aBlock

	self widgetDo: [ :w | w announcer
		when: anAnnouncement do: aBlock ]! !

!AbstractMorphicAdapter methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 9/25/2013 15:28'!
dragTransformationBlock

	^ self model dragTransformationBlock! !

!AbstractMorphicAdapter methodsFor: 'drag and drop - private' stamp: 'BenjaminVanRyseghem 9/25/2013 14:09'!
wantsDroppedMorph: draggedMorph event: anEvent inMorph: source

	^ self wantDropBlock cull: draggedMorph cull: anEvent cull:source! !

!AbstractMorphicAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/25/2013 16:21'!
setBalloonText: aString

	self widget ifNotNil: [ :w | w setBalloonText: aString ]! !

!AbstractMorphicAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/29/2013 12:47'!
vSpaceFill
	
	self widgetDo: [ :w | w vResizing: #spaceFill ]! !

!AbstractMorphicAdapter methodsFor: 'dispatch' stamp: 'BenjaminVanRyseghem 3/4/2014 17:25:06'!
listRenderOn: aCanvas atRow: aRow bounds: drawBounds color: drawColor backgroundColor: backgroundColor from: aMorph
	"Specify how this object as a list item should be drawn"

	self widget ifNil: [ self buildWithSpec ].
	self widget 
		vResizing: #rigid;
		hResizing: #rigid.
		
	self widget
		listRenderOn: aCanvas
		atRow: aRow
		bounds: drawBounds
		color: drawColor
		backgroundColor: backgroundColor
		from: aMorph! !

!AbstractMorphicAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/27/2013 14:56'!
changed

	^ self widgetDo: [ :w | w changed ]! !

!AbstractMorphicAdapter methodsFor: 'drag and drop - private' stamp: 'BenjaminVanRyseghem 9/25/2013 15:29'!
transferFor: passenger from:  source

	^ self transferBlock cull:passenger cull: source! !

!AbstractMorphicAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/25/2013 16:21'!
borderWidth: width

	self widget ifNotNil: [ :w | w borderWidth: width ]! !

!AbstractMorphicAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/29/2013 13:42'!
add: aWidget
	
	self widgetDo: [ :w | w ensureLayoutAndAddMorph: aWidget asWidget ]! !

!AbstractMorphicAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/25/2013 15:24'!
borderColor

	^ self model borderColor! !

!AbstractMorphicAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/25/2013 15:24'!
borderWidth

	^ self model borderWidth! !

!AbstractMorphicAdapter methodsFor: 'drag and drop - private' stamp: 'BenjaminVanRyseghem 9/25/2013 14:09'!
dragPassengerFor: item inMorph: dragSource 
	
	^ self dragTransformationBlock cull: item cull: dragSource! !

!AbstractMorphicAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/25/2013 16:21'!
enabled: aBoolean

	self widget ifNotNil: [ :w | w enabled: aBoolean ]! !

!AbstractMorphicAdapter methodsFor: 'dispatch' stamp: 'BenjaminVanRyseghem 3/4/2014 17:25:06'!
widthToDisplayInList: aList
	"Return the width of my representation as a list item"
	
	self model extent ifNotNil: [:ex | ^ ex x ].
	self model initialExtent ifNotNil: [:ex | ^ ex x ].

	self widget ifNil: [ self buildWithSpec ].
	self widget 
		vResizing: #rigid;
		hResizing: #rigid.
		
	^ self widget widthToDisplayInList: aList! !

!AbstractMorphicAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/29/2013 12:46'!
vRigid
	
	self widgetDo: [ :w | w vResizing: #rigid ]! !

!AbstractMorphicAdapter methodsFor: 'drag and drop - private' stamp: 'BenjaminVanRyseghem 9/25/2013 14:09'!
dragPassengersFor: item inMorph: dragSource 
	
	^ { self dragTransformationBlock cull: item cull: dragSource }! !

!AbstractMorphicAdapter methodsFor: 'protocol-shortcuts' stamp: 'BenjaminVanRyseghem 11/12/2013 16:15'!
removeMenuKeyCombination: aShortcut

	self widget ifNotNil: [ :w | w removeKeyCombination: aShortcut ]! !

!AbstractMorphicAdapter methodsFor: 'dispatch' stamp: 'BenjaminVanRyseghem 9/25/2013 18:19'!
beginsWith: aString fromList: aMorph
	"This method is used bu the list for the search of elements when you are typing directly in the list"
	
	^ false! !

!AbstractMorphicAdapter methodsFor: 'dispatch' stamp: 'BenjaminVanRyseghem 3/4/2014 17:25:06'!
heightToDisplayInList: aList
	"Return the width of my representation as a list item"
	
	self model extent ifNotNil: [:ex | ^ ex y ].
	self model initialExtent ifNotNil: [:ex | ^ ex y ].
	
	self widget ifNil: [ self buildWithSpec ].
	self widget 
		vResizing: #rigid;
		hResizing: #rigid.
		
	^ self widget heightToDisplayInList: aList! !

!AbstractMorphicAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 1/23/2014 16:12'!
color

	^ self model color! !

!AbstractMorphicAdapter methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 9/25/2013 15:29'!
wantDropBlock

	^ self model wantDropBlock! !

!AbstractMorphicAdapter methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 9/25/2013 15:27'!
dragEnabled

	^ self model dragEnabled! !

!AbstractMorphicAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/25/2013 16:21'!
borderColor: color

	self widget ifNotNil: [ :w | w borderColor: color ]! !

!AbstractMorphicAdapter class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 9/25/2013 14:10'!
defaultSpec

	^ SpecLayout composed! !

!AbstractNautilusPlugin commentStamp: 'StephaneDucasse 10/30/2014 07:31'!
I'm the root of Nautilus plugins. You can get the list of Nautilus plugin using the Plugin Manager that you can find in the window menu (right menu on the window itself) of the Nautilus browser window. 

!!!! How to create Nautilus-Plugins

Here we will give some brief explanations on how to create your own plugin. There are only two requirements
to create a Nautilus-Plugin:

- the class should inherit from ==AbstractNautilusPlugin==
- it should implement the method ==registerTo: aModel==


[[[
AbstractNautilusPlugin
]]]

!!!!!! Announcement subscription

The method ==registerTo:== is used by the plugin to register itself to aModel announcements.

[[[
MyPlugin>>registerTo: aModel

    aModel announcer
   	 when: NautilusKeyPressed 
	 send: #keyPressed: 
	 to: self
]]]

In this example, the instance of ==MyPlugin== subscribes itself to ==NautilusKeyPressed==, and
tell aModel's announcer to send the message  ==keyPressed== to the instance.

So each time a key will be pressed in a Nautilus window the method ==keyPressed:== will be called.

!!!!!! Display
If you want your plugin to add a graphical widget to Nautilus you should override the ==display== method.
This method should return the Morphic element you want Nautilus to display. By default the method returns nil to
notify Nautilus not to display anything.

[[[
MyPlugin>>display
    morph := LabelMorph new contents: 'MyPlugin';
        enabled: false; 
		vResizing: #shrinkWrap; 
		hResizing: #spaceFill; 
		yourself.
	^ morph
]]]

You can also redefine the following methods on the class side:

- ==defaultPosition== defines the default position of the morph. Possible values are =={#top, #middle, #bottom, #none}==. The default value is ==#none==.

- ==possiblePositions== answers a collection of the possible positions the widget could adopt.


!!!!!! Describing your plugin

And finally you can redefine the ==pluginName== method to change the name displayed in the Nautilus Plugin Manager.

[[[
MyPlugin class>>description
	^ 'MyPlugin'
]]]

[[[
MyPlugin class>>description
	^ 'A super cool plugin'
]]]
!
!AbstractNautilusPlugin methodsFor: 'registration' stamp: 'BenjaminVanRyseghem 5/4/2011 14:45'!
registerTo: aModel

	self subclassResponsibility! !

!AbstractNautilusPlugin methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/4/2011 14:43'!
model

		^ model! !

!AbstractNautilusPlugin methodsFor: 'display' stamp: 'BenjaminVanRyseghem 8/25/2011 10:03'!
position

	^ position ifNil: [ position := self class defaultPosition ]! !

!AbstractNautilusPlugin methodsFor: 'display' stamp: 'BenjaminVanRyseghem 8/25/2011 09:49'!
position: aPosition
	
	position := aPosition! !

!AbstractNautilusPlugin methodsFor: 'display' stamp: 'BenjaminVanRyseghem 5/2/2012 13:18'!
name

	^ self class name! !

!AbstractNautilusPlugin methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/4/2011 14:44'!
model: anObject
	
		model := anObject.
		self registerTo: anObject! !

!AbstractNautilusPlugin methodsFor: 'display' stamp: 'StephaneDucasse 10/30/2014 07:11'!
display
	" should answer a morphic object ready to be integrated into a NautilusWindow "
	
	^ nil! !

!AbstractNautilusPlugin class methodsFor: 'display' stamp: 'BenjaminVanRyseghem 8/25/2011 14:18'!
pluginName

	^ self name! !

!AbstractNautilusPlugin class methodsFor: 'information' stamp: 'StephaneDucasse 10/30/2014 07:35'!
possiblePositions
	"Return all the possible positions for a plugin. Subclasses are not intented to override this method."
	^ {	#top.
		#middle.
		#bottom.
		#none. }! !

!AbstractNautilusPlugin class methodsFor: 'information' stamp: 'StephaneDucasse 10/30/2014 07:28'!
description
	^ 'No description available'! !

!AbstractNautilusPlugin class methodsFor: 'position' stamp: 'StephaneDucasse 10/30/2014 07:29'!
defaultPosition
	"Tells where in the Nautilus UI this plugin will appear. Pick an answer from #possiblePositions. By default a plugin does not have a visual representation so its position is none"
		
	^ #none! !

!AbstractNautilusPlugin class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 5/4/2011 14:43'!
model: aModel

	^ self new model: aModel! !

!AbstractNautilusUI commentStamp: '<historical>'!
An AbstractNautilusUI is an abstraction of the UI handling packages and classes.

Instance Variables
	cachedHierarchy:		<Object>
	classesSelection:		<Object>
	commentButton:		<Object>
	commentTextArea:		<Object>
	currentDisplayChoice:		<Object>
	firstColumn:		<Object>
	groupsSelection:		<Object>
	hierarchyClass:		<Object>
	list:		<Object>
	list2:		<Object>
	model:		<Object>
	packagesSelection:		<Object>
	secondColumn:		<Object>
	sourceCodeContainer:		<Object>
	sourceCodePanel:		<Object>
	sourceTextArea:		<Object>
	sourceTextAreaLimit:		<Object>
	window:		<Object>!
!AbstractNautilusUI methodsFor: 'selection' stamp: 'NicolaiHess 8/9/2014 21:53'!
resetMethodsListSelection
	self subclassResponsibility ! !

!AbstractNautilusUI methodsFor: 'menu builder' stamp: 'EstebanLorenzano 1/31/2013 19:24'!
groupsMenu: aMenu shifted: aBoolean 
	" Morphic's menus are filled up when pragma's one are returned from a method, so I have to substitute the morphic menu by the pragma one "
	
	^ aMenu addAllFrom: (self groupMenuBuilder menu)! !

!AbstractNautilusUI methodsFor: 'focus' stamp: 'BenjaminVanRyseghem 6/22/2012 18:01'!
giveFocusToSourceCode

	self giveFocusTo: sourceTextArea ! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'StephaneDucasse 8/2/2014 09:02'!
findPackage

	"Search for a package from a pattern or from the recent list"
	| foundPackage |
	self okToChange ifFalse: [^ self ].	
	foundPackage := SearchFacade rPackageSearch chooseFromOwner: self window.
	foundPackage ifNil: [ ^self ].
	self selectedPackage: foundPackage.
	self updatePackageViewAndMove.
! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/14/2012 17:33'!
sourceCodePanel

	^ sourceCodePanel! !

!AbstractNautilusUI methodsFor: 'group' stamp: 'BenjaminVanRyseghem 1/24/2013 18:06'!
addPackageAsGroup

	^ [ self addPackagesAsGroup: self selectedPackages ]
		on: GroupAlreadyExists 
		do: [:ex | 
			self alertGroupExisting: ex groupName.
			^ nil ]! !

!AbstractNautilusUI methodsFor: 'announcement registration' stamp: ''!
announce: anAnnouncement

	^ self model announce: anAnnouncement! !

!AbstractNautilusUI methodsFor: 'system announcements' stamp: ''!
methodRemoved: anAnnouncement

	^ self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'private' stamp: ''!
ifGroups: aBlock ifNot: anotherBlock

	^self showGroups
			ifTrue: aBlock
			ifFalse: anotherBlock! !

!AbstractNautilusUI methodsFor: 'selection' stamp: 'NicolaiHess 7/26/2014 13:13'!
resetClassesListSelection
	self subclassResponsibility ! !

!AbstractNautilusUI methodsFor: 'system announcements' stamp: 'NicolaiHess 8/2/2014 21:53'!
classReorganized: anAnnouncement
	
	window ifNil: [ ^ self ].
	window isDisplayed ifFalse: [ ^ self ].
	(self selectedClass = anAnnouncement classReorganized or: [ anAnnouncement classReorganized users includes: self selectedClass  ])
		ifTrue: [ self updatePackageGroupAndClassList ]! !

!AbstractNautilusUI methodsFor: 'initialization' stamp: 'NicolaiHess 7/31/2014 09:20'!
initialize

	super initialize.
	shouldUpdateTitle := true.
	testSemaphore := Semaphore new.
	sourceTextAreas := OrderedCollection new.
	contentSelection := nil.
	acceptor := ClassDefinitionAcceptor model: self.
	classifier := MethodClassifier new. ! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'NicolaiHess 6/9/2014 00:04'!
buildTearDownCodeFor: aClass 
	
	^ String streamContents: [:str | str << 'tearDown';cr.
		str tab << '"Tearing down code for '<<aClass name<<'"';cr;cr.
		aClass instVarNames copy sort do: [:name | str cr tab << name << ' := nil.' ]].
	! !

!AbstractNautilusUI methodsFor: 'protocol' stamp: ''!
title: aString

	shouldUpdateTitle := false.
	window title: aString! !

!AbstractNautilusUI methodsFor: 'group' stamp: 'MarcusDenker 7/17/2013 15:08'!
addMatchingPackagesInGroups

	self selectedPackage
		ifNotNil: [:package || separatorIndex firstPartOfTheName packages |
			separatorIndex := package name indexOf: $- ifAbsent: [ package name size + 1].
			firstPartOfTheName := package name copyFrom: 1 to: (separatorIndex - 1) .
			packages := self model packages select: [:each | each name beginsWith: firstPartOfTheName ].
			[ ^ self addPackagesAsGroups: packages ]
			on: GroupsAlreadyExist
			do: [:ex | 
				self alertGroupExisting: ex groupName.
				^ nil ]].
	^ nil! !

!AbstractNautilusUI methodsFor: 'menu pragmas' stamp: 'EstebanLorenzano 1/30/2013 17:30'!
classFixPragma
	^'nautilusGlobalClassFixMenu'! !

!AbstractNautilusUI methodsFor: 'menu builder' stamp: ''!
groupMenuBuilder

	^ PragmaMenuBuilder withAllPragmaKeywords: {self groupFixPragma. self groupPragma} model: self! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: ''!
enableSingleClassSelection

	^ self selectedClasses size <= 1! !

!AbstractNautilusUI methodsFor: 'build ui text' stamp: 'BenjaminVanRyseghem 8/6/2012 00:52'!
buildCodePane
		
	"The following method fills up sourceTextArea variable"
	self buildNewSourceTextArea.
	
	multipleMethodsEditor := MultipleMethodsEditor new.

	multipleMethodsEditor 
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		addEditor: sourceTextArea.
			
	^ multipleMethodsEditor! !

!AbstractNautilusUI methodsFor: 'Shout' stamp: ''!
shoutAboutToStyle: aPluggableShoutMorphOrView 

	^ aPluggableShoutMorphOrView == sourceTextArea! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'DamienCassou 4/24/2013 14:11'!
restrictedBrowseTraitUsers: users

	| newEnvironment |
	users ifEmpty: [ ^ self ].
	newEnvironment := self browsedEnvironment forClasses: users.
	self model class 
		openOnClass: users anyOne 
		inEnvironment: newEnvironment ! !

!AbstractNautilusUI methodsFor: 'build ui lists' stamp: 'NicolaiHess 7/31/2014 09:58'!
buildFirstColumn: aWindow
		
	| buttons |
	buttons := PanelMorph new.

	self setShortcuts: #NautilusPackageShortcuts to: buttons.
		
	buttons 
		changeProportionalLayout;
		addMorph: self buildGroupsButton
		fullFrame: ( (	0@0 corner: 0.5@0 ) asLayoutFrame
						bottomRightOffset: (-2)@25 );
		addMorph: self buildHierarchyButton
		fullFrame: ((	0.5@0 corner: 1@0 ) asLayoutFrame
						topLeftOffset: 2@0 ; bottomRightOffset: 0@25 );
		hResizing: #spaceFill;
		vResizing: #rigid;
		height: 25.
		
	^ PanelMorph new
		changeProportionalLayout;
		addMorph: self buildPackageWidget
		fullFrame: ( LayoutFrame identity bottomOffset: -25);
		addMorph: buttons
		fullFrame: ( (0@1 corner: 1@1 ) asLayoutFrame topOffset: -25);
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		yourself.! !

!AbstractNautilusUI methodsFor: 'private' stamp: 'NicolaiHess 7/26/2014 11:14'!
updateClassView

	self resetClassesList.
	self changed: #getClassItem: ! !

!AbstractNautilusUI methodsFor: 'plugins announcements' stamp: 'CamilloBruni 1/11/2013 14:13'!
openSubclass
	"Search for a superclass of the selected class from a pattern or from the recent list"

	self selectedClass ifNotNil: [ :class| | search |
		search := SearchFacade subclassSearchFor: class theNonMetaClass.
		self openClass: (search chooseFromOwner: self window) ].! !

!AbstractNautilusUI methodsFor: 'private' stamp: 'NicolaiHess 8/9/2014 23:11'!
resetPackageGroupsList
	self packageWidget resetPackageGroupList! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: 'ClementBera 7/26/2013 15:58'!
lockTextArea

	self selectedMethod ifNil: [ ^ self ].
	
	sourceTextArea lockFrom: self selectedMethod.
	self buildNewSourceTextArea.
	multipleMethodsEditor addEditor: sourceTextArea.
	self changed: #sourceCodeFrom:.! !

!AbstractNautilusUI methodsFor: 'system announcements' stamp: ''!
methodModified: anAnnouncement 
	
	^ self subclassResponsibility ! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'CamilloBruni 9/14/2012 01:49'!
findSubclass
	"Search for a subclass of the selected class from a pattern or from the recent list"
	
	self selectedClass ifNotNil: [ :class| 
		self findClass: (SearchFacade subclassSearchFor: class theNonMetaClass)].! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: 'NicolaiHess 8/9/2014 22:03'!
selectedPackage: aPackage
" Force package selection, not used by the lists "

	self okToChange
		ifTrue: [
			acceptor := ClassDefinitionAcceptor model: self.
			
			self resetPackageGroupsListSelection.
			self packageWidget selectPackage: aPackage.
				
			aPackage ifNotNil: [ self giveFocusTo: self packageWidget ].	
				
			self selectedPackageWithoutChangingSelection: aPackage]! !

!AbstractNautilusUI methodsFor: 'displaying' stamp: 'NicolaiHess 7/28/2014 23:56'!
hasFocus

	^ window hasKeyboardFocus or: 
		[ self packageWidget hasFocus or:
		[ self classWidget hasFocus or: 
		[ self categoryWidget hasFocus or:
		[ self methodWidget hasFocus or:
		[ sourceTextArea hasKeyboardFocus ]]]]]! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: ''!
addPackage

	| package |
	package := self addPackageBasedOn: self selectedPackage.
	package ifNotNil: [
			self selectedPackage: package.
			self updatePackageViewAndMove ]! !

!AbstractNautilusUI methodsFor: 'system announcements' stamp: 'MarcusDenker 9/27/2013 18:08'!
packageChanged: anAnnouncement
	window isDisplayed
		ifFalse: [ ^ self ].
	self showGroups
		ifFalse: [ self updatePackageView ]! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: 'CamilloBruni 10/4/2012 10:45'!
doItReceiver

	^ self selectedClass 
		ifNotNil: [:class | class theNonMetaClass ]! !

!AbstractNautilusUI methodsFor: 'selection' stamp: 'NicolaiHess 8/9/2014 23:13'!
resetMethodsList
	self subclassResponsibility ! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: ''!
showGroupsSilently: aBoolean

	self model showGroups: aBoolean! !

!AbstractNautilusUI methodsFor: 'buttons behavior' stamp: ''!
instanceButtonAction

	self toggleShowInstance! !

!AbstractNautilusUI methodsFor: 'icons behavior' stamp: 'NicolaiHess 7/28/2014 22:53'!
arrowDown: aMethod

	| methods methodsNames index |
	methods := aMethod methodClass allSubclasses gather: [:each | each methods ].
	methods := methods select: [:each | each selector = aMethod selector ].
	methods size = 1
		 ifTrue: [ ^ self model class openOnMethod: methods first ].
	methods isEmpty
		ifTrue:[ ^ self methodWidget invalidateCacheEntryFor: aMethod ].
	methodsNames := methods collect: [:each | each methodClass name, '>>#', each selector ].
	index := UIManager default chooseFrom: methodsNames.
	index = 0 ifTrue: [ ^ self ].
	^ self model class openOnMethod: (methods at: index)
	! !

!AbstractNautilusUI methodsFor: 'SmalltalkEditor compatibility' stamp: ''!
selectedBehavior

	^ self selectedClass! !

!AbstractNautilusUI methodsFor: 'private' stamp: 'MarcusDenker 9/27/2013 18:01'!
copyMethod: aMethod toTheClass: aClass 
	| newMethod |
	
	aMethod realClass = aClass ifTrue: [ ^ self ].
	aClass methodDict
						at: aMethod selector
						ifPresent: [:sel | 
							" here I have to fork to release the drag & drop "
							[ (self openDialogWouldYouInstall: sel into: aClass)
								ifTrue: [ 
									newMethod := aClass compile: aMethod sourceCode classified: aMethod category ]] fork.
							  ]
						ifAbsent: [ 
							newMethod := aClass compile: aMethod sourceCode classified: aMethod category]! !

!AbstractNautilusUI methodsFor: 'build ui plugins' stamp: 'NicolaiHess 7/28/2014 21:19'!
buildMiddlePlugins

	| middle container |
	middle := self model plugins select: [:each | each position = #middle ].
	middle ifEmpty: [ ^ nil ].
	middle size = 1 ifTrue: [ ^ middle first display ].
	container := Morph new.
	self setShortcuts: #NautilusSourceCodeShortcuts to: container.
	container 
		color: Color transparent;
		changeTableLayout;
		cellInset: 8;
		listDirection: #topToBottom;
		cellPositioning: #topLeft;
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap.
	middle reverse do: [:each |
		each display ifNotNil: [:morph | container addMorph: morph ]].
	^ container! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: ''!
browseMessages

	self browseMessagesFrom: self selectedMethod selector! !

!AbstractNautilusUI methodsFor: 'events handling' stamp: ''!
doubleClickOnPackage

	self selectedPackage
		ifNil: [ ^ self ]
		ifNotNil:[:package | self model class openOnPackage: package ]! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: ''!
showComment

	^ self model showComment! !

!AbstractNautilusUI methodsFor: 'icon caches' stamp: ''!
removeFromGroupsIconsCache: aClass
	" not used since the groups's icons are always the same "


	GroupsIconsCache removeKey: aClass ifAbsent: [].! !

!AbstractNautilusUI methodsFor: 'icon' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
groupIconFor: aGroup
	| icon |
	GroupsIconsCache 
		at: aGroup 
		ifPresent: [:ic | 
			 ic class == IconicButtonStateHolder ifFalse: [ ^ ic ].
			^ ic asIconTargetting: self ].
	
	icon := IconicButton new 
				target: self;
				actionSelector: #restrictedBrowseGroups:;
				arguments: {{aGroup}};
				labelGraphic: (Smalltalk ui icons iconNamed: #groupIcon);
				color: Color transparent;
				extent: 15 @ 16;
				helpText: 'Browse restricted environment';
				borderWidth: 0. 
				
	GroupsIconsCache
		at: aGroup
		put: (IconicButtonStateHolder forNautilus: icon).
	^ icon! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: ''!
moveMethodToPackage
	^ self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: ''!
selectedClassComments

	^ self selectedClass
		ifNil: ['']
		ifNotNil: [:class| class comment]! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: ''!
fullBrowse
	^ self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'announcement registration' stamp: 'BernardoContreras 10/21/2014 15:03'!
registerToMCAnnouncements
	SystemAnnouncer uniqueInstance weak	
		when: MCVersionCreated send: #newMCVersion: to: self;
		when: MCPackageModified send: #mcPackageModified: to: self;
		when: MCWorkingCopyCreated send: #mcWorkingCopyCreated: to: self;
		when: MCWorkingCopyDeleted send: #mcWorkingCopyDeleted: to: self.
! !

!AbstractNautilusUI methodsFor: 'menu builder' stamp: 'EstebanLorenzano 1/31/2013 19:24'!
sourceCodeMenu: aMenu shifted: shifted
	" Morphic's menus are filled up when pragma's one are returned from a method, so I have to substitute the morphic menu by the pragma one "
	
	^ aMenu addAllFrom: (self sourceCodeMenuBuilder menu)! !

!AbstractNautilusUI methodsFor: 'private' stamp: 'EstebanLorenzano 10/9/2013 16:18'!
parentOfClass: aClass 
	^ aClass package.! !

!AbstractNautilusUI methodsFor: 'build ui text' stamp: 'EstebanLorenzano 5/15/2014 17:45'!
buildCommentPane
	commentTextArea := PluggableTextMorph
		on: self
		text: #getComments
		accept: #addComment:notifying:
		readSelection: nil
		menu: #codePaneMenu:shifted:.		
	commentTextArea
		askBeforeDiscardingEdits: true;
		vResizing: #spaceFill;
		hResizing: #spaceFill.
	
	self setCommentShorcutsTo: commentTextArea.	
	commentTextArea spaceFillWeight: 1.

	^ commentTextArea! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: 'BenjaminVanRyseghem 10/18/2013 16:30'!
pendingText: aString

	self sourceTextArea 
		setText: aString;
		hasUnacceptedEdits: true! !

!AbstractNautilusUI methodsFor: 'announcement registration' stamp: ''!
unregisterAllPlugins

	self announcer subscriptions reset! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: ''!
removeClassFromGroup

	self selectedClasses do: [:class | 
		[ 	self groupsManager removeClass: class theNonMetaClass from: self selectedGroup.
			self updateClassView ] fork ].
	self 
		selectedClass: nil;
		updateClassView.! !

!AbstractNautilusUI methodsFor: 'build ui' stamp: 'NicolaiHess 7/28/2014 21:17'!
buildColumns: aWindow height: height
	| delta |		
			
	delta := StandardFonts defaultFont height + 15.
	
	aWindow 
		addMorph: (self buildFirstColumn: aWindow)
		fullFrame: ((0 @ 0 corner: 0.25 @ 0.5) asLayoutFrame 
						topOffset: height ).
						
	aWindow 
		addMorph: (self buildSecondColumn: aWindow)
		fullFrame: ((0.25 @ 0 corner: 0.5 @ 0.5) asLayoutFrame
						topOffset: height ).
						
	aWindow 
		addMorph: (self buildThirdColumn: aWindow)
		fullFrame: ( (0.5 @ 0 corner: 0.75 @ 0.5) asLayoutFrame
						topOffset: height ; bottomOffset: delta negated).
						
	aWindow 
		addMorph: (self buildFourthColumn: aWindow)
		fullFrame: ( (0.75 @ 0 corner: 1 @ 0.5) asLayoutFrame
						topOffset: height; bottomOffset: delta negated).
						
	aWindow
		addMorph: self buildNavigationList
		fullFrame: ((0.5 @ 0.5 corner: 1 @ 0.5) asLayoutFrame
						topOffset: delta negated).! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: ''!
selectedPackage

	^ self model selectedPackage! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'NicolaiHess 7/27/2014 13:31'!
enableSingleMenuItems

	^ self packageWidget selectedPackages size <= 1! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'SebastianTleye 4/19/2013 15:57'!
restrictedBrowseTraitUsers
	self selectedClass
		ifNil: [ ^ self ]
		ifNotNil: [ :class |
			self restrictedBrowseTraitUsers: class users ]! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'CamilloBruni 10/7/2012 22:30'!
restrictedBrowsePackageRegex
	| regex |
	
	regex := self selectedPackages
		ifEmpty: [ '' ]
		ifNotEmpty: [ :packages | 
			'^',(packages first name splitOn: $-) first , '-.*$'].
		
	regex := UIManager default request: 'Browse restricted on Packages matching:' regex: regex .
	regex ifNil: [ ^ self ].
	self restrictedBrowsePackages: (self browsedEnvironment packages select: [ :package| regex matches: package name ] )! !

!AbstractNautilusUI methodsFor: 'displaying' stamp: 'BenjaminVanRyseghem 8/3/2012 16:18'!
setWindowTitle

	| title |
	shouldUpdateTitle ifFalse: [ ^ self ].
	title := self selectedClass 
				ifNil: [ self selectedPackage
							ifNil: [ self title ]
							ifNotNil: [: p | p name ]]
				ifNotNil: [:class |
					self selectedMethod
						ifNil: [ class name asString ]
						ifNotNil: [:method |
							String streamContents: [:s | s << method methodClass name asString<< '>>#'<< method selector ]]].
	self browsedEnvironment isSystem ifFalse: [ title := String streamContents: [:s | s << '--- ' << title << ' ---']].
	window title: title.! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: 'MarcusDenker 8/10/2014 09:44'!
sourceCode

	self removeSourceTextAreaLimit.
	^self selectedClass 
		ifNil: [ self defaultClassDescriptor]
		ifNotNil: [:class | self selectedMethod 
			ifNil: [ self selectedCategory 
					ifNotNil: [ 
							self putSourceTextAreaLimit.
							class sourceCodeTemplate]
					ifNil: [ self selectedClassDescription]]
			ifNotNil: [ 
					self putSourceTextAreaLimit.
					self selectedMethodSource]].
		! !

!AbstractNautilusUI methodsFor: 'group' stamp: 'StephaneDucasse 8/22/2013 23:21'!
addPackagesAsGroups

	[ self addPackagesAsGroups: self selectedPackages ]
		on: GroupAlreadyExists 
		do: [:ex | self alertGroupExisting: ex groupName ]! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: 'BenjaminVanRyseghem 8/6/2012 00:53'!
unlockTextArea: source

	multipleMethodsEditor removeEditor: source! !

!AbstractNautilusUI methodsFor: 'displaying' stamp: ''!
taskbarIcon

	^ self class icon! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'NicolaiHess 8/2/2014 21:53'!
mergeGroups

	| group |
	group := self mergeGroups: self packageWidget selectedGroups.
	group
		ifNotNil: [ 
			self groupsManager addAGroup: group.
			self selectedGroup: group.
			self updatePackageGroupAndClassList]
! !

!AbstractNautilusUI methodsFor: 'buttons behavior' stamp: ''!
commentButtonLabel

	^ self commentLabel! !

!AbstractNautilusUI methodsFor: 'plugins announcements' stamp: 'CamilloBruni 1/16/2013 00:24'!
openClass
	self openClass: self selectedClass! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'CamilloBruni 9/4/2013 21:16'!
categorizeAllUncategorizedMethods
	"Categorize methods by looking in parent classes for a method category."
	self selectedClass ifNotNil: [ :aClass | | methods |
		methods := aClass uncategorizedSelectors collect: [ :selector| aClass >> selector ].
		self classifier classifyAll: methods ]! !

!AbstractNautilusUI methodsFor: 'private' stamp: ''!
groupsLabel

	^ 'Groups'! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: ''!
setStylerClass: aClass

	sourceTextArea
		ifNotNil: [ sourceTextArea classOrMetaClass: aClass ]! !

!AbstractNautilusUI methodsFor: 'build ui buttons' stamp: 'EstebanLorenzano 1/30/2013 14:43'!
buildGroupsButton
	| button |
	button := (PluggableButtonMorph
			on: self 
			getState: #groupsButtonState
			action: #groupsButtonAction
			label: #groupsButtonLabel) hResizing: #spaceFill; vResizing: #shrinkWrap.
	self setShortcuts: #NautilusGroupShortcuts to: button.
	^ button! !

!AbstractNautilusUI methodsFor: 'monticello announcements' stamp: 'MarcusDenker 9/27/2013 17:59'!
mcWorkingCopyCreated: anAnnouncement
	| package rpackage |
	window ifNil: [^ self ].
	window isDisplayed ifFalse: [ ^ self ].
	
	package := anAnnouncement package.
	package ifNil: [ ^ self ].
	rpackage := RPackageOrganizer default packageNamed: package name.
	(self model packages includes: rpackage)
		ifTrue: [ 
			PackagesIconsCache removeKey: rpackage  ifAbsent: [].
			self updatePackageView ]! !

!AbstractNautilusUI methodsFor: 'browser compatibility' stamp: ''!
sourceCode: aText 

	self okToChange
		ifTrue: [ 
			sourceTextArea setText: aText.
			sourceTextArea takeKeyboardFocus ]! !

!AbstractNautilusUI methodsFor: 'menu builder' stamp: ''!
categoryMenuBuilder

	^ PragmaMenuBuilder withAllPragmaKeywords: {self commonPragma. self categoryPragma} model: self! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: ''!
compileAMethodFromCategory: aCategory withSource: aString notifying: aController
	^ self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'CamilloBruni 9/14/2012 01:49'!
findClassInHierarchy
	"Search for a subclass of the selected class from a pattern or from the recent list"
	
	self selectedClass ifNotNil: [ :class| 
		self findClass: (SearchFacade hierarchySearchFor: class theNonMetaClass)].! !

!AbstractNautilusUI methodsFor: 'private' stamp: 'MarcusDenker 9/27/2013 17:59'!
addSubclassesOf: aClass in: result withIndex: index fromRestrictedCollection: aCollection

	| classes |

	classes := aClass subclasses" intersection: self shownClasses".
	
	classes := classes intersection: aCollection.
	(classes sort: [:a :b| a name <= b name]) do: [:each |
		result at: each put: index.
		self addSubclassesOf: each in: result withIndex: index + 1 fromRestrictedCollection: aCollection ]! !

!AbstractNautilusUI methodsFor: 'updating' stamp: 'BenComan 2/16/2014 23:20'!
okToChange
	sourceTextArea ifNil: [ ^ true ].
	sourceTextArea text asString trimBoth = sourceTextArea getText asString trimBoth ifTrue: [ ^ true ].
	sourceTextArea canDiscardEdits ifTrue: [ ^ true].
	sourceTextArea update: #wantToChange.
	^ sourceTextArea canDiscardEdits! !

!AbstractNautilusUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 1/6/2013 16:02'!
classLabel

	^'Class' asText allBold asMorph lock! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: ''!
showUnreferencedInstVars
	"Search for all instance variables known to the selected class, and put up a list of those that have no references anywhere in the system.  The search includes superclasses, so that you don't need to navigate your way to the class that defines each inst variable in order to determine whether it is unreferenced"

	self showUnreferencedInstVarsOf: self selectedClass! !

!AbstractNautilusUI methodsFor: 'system announcements' stamp: 'NicolaiHess 7/26/2014 11:20'!
classDefinitionModified: anAnnouncement 

	| class |
	window ifNil: [^ self ].
	window isDisplayed ifFalse: [ ^ self ].
	class := anAnnouncement oldClassDefinition. 
	self removeClassFromMethodsIconsCache: class.	
	((self showGroups 
	and: [  self selectedGroup notNil
	and: [ self selectedGroup elements includes: class ]]) 
	or: [ self classWidget getClassesList  includes: class ])
			ifTrue: [
			(model selectedClass = anAnnouncement oldClassDefinition) ifTrue: [ model selectedClass: anAnnouncement newClassDefinition ]. "Minimal change to fix Case13006. Further investigation required in Pharo 4 on Case13020"
			self updateClassView.
			self removeFromPackagesIconsCache: class package.
			sourceTextArea hasUnacceptedEdits 
				ifFalse: [ self changed: #sourceCodeFrom: ]].! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'EstebanLorenzano 1/15/2013 17:07'!
renameClass

	self okToChange ifFalse: [ ^ self ].
	 self selectedClass ifNil: [ ^ self ].

	self basicRenameClass: self selectedClass theNonMetaClass.

	self changed: #sourceCodeFrom:.! !

!AbstractNautilusUI methodsFor: 'shortcuts' stamp: 'EstebanLorenzano 2/19/2013 14:43'!
removeShortcuts: groupSymbol from: aMorph
	Nautilus useOldStyleKeys ifFalse: [ ^self ].
	
	(aMorph kmDispatcher includesKeymapCategory: groupSymbol)
		ifTrue: [ 
			aMorph 
				detachKeymapCategory: groupSymbol
				targetting: self ]
! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: 'MarcusDenker 10/14/2014 08:03'!
selectedMethodSource
	self selectedMethod ifNil: [ ^ '' ].
	^ self selectedMethod sourceCode! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: ''!
fileOutClass
	"Print a description of the selected class onto a file whose name is the 
	category name followed by .st."

	self fileOutClasses: self selectedClasses! !

!AbstractNautilusUI methodsFor: 'widget class' stamp: 'NicolaiHess 7/28/2014 23:54'!
classWidget
	self subclassResponsibility ! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: ''!
doItContext

	^ nil! !

!AbstractNautilusUI methodsFor: 'buttons behavior' stamp: 'NicolaiHess 9/7/2014 18:55'!
hierarchyButtonLabel

	^ self showHierarchy
		ifFalse: [ 'Hierarchy' ]
		ifTrue: [ 'Flat' ]! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: ''!
categorizeMethod
	^ self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'code panel' stamp: 'StephaneDucasse 12/19/2012 15:54'!
buildCodePanelWithCommentOnTop
	| splitter delta |
	
	splitter := ProportionalSplitterMorph new beSplitsTopAndBottom.
	delta := 2.

	splitter addLeftOrTop: commentTextArea.
	splitter addRightOrBottom: multipleMethodsEditor.

	sourceCodePanel
		addMorph: commentTextArea
		fullFrame: ( (0@0 corner: 1@0.5) asLayoutFrame
						 bottomRightOffset: 0@(delta negated)).
	sourceCodePanel
		addMorph: splitter
		fullFrame: ( (0@0.5 corner: 1@0.5) asLayoutFrame
						topLeftOffset: 0@(delta negated) ; bottomRightOffset: 0@delta).
	sourceCodePanel 
		addMorph: multipleMethodsEditor
		fullFrame:  ((0@0.5 corner: 1@1) asLayoutFrame
						topLeftOffset: (0@delta )).! !

!AbstractNautilusUI methodsFor: 'group' stamp: 'EstebanLorenzano 10/10/2013 13:14'!
addPackageAsGroupAndBrowse

	self addPackageAsGroup
		ifNotNil: [:group | 
			self selectedGroup: group.
			self showGroups: true]
		ifNil: [
			| group |
			group := self model groupsManager groupNamed: self selectedPackage name.
			group ifNotNil: [ 
				self selectedGroup: group.
				self showGroups: true ]]! !

!AbstractNautilusUI methodsFor: 'private' stamp: ''!
systemNavigation

	^ SystemNavigation new 
			browsedEnvironment: self browsedEnvironment;
			yourself! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: ''!
browseInstVarRefs 

	self browseInstVarRefsOf: self selectedClass! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'NicolaiHess 1/2/2014 22:37'!
restrictedBrowseGroups: aCollection

	aCollection
		ifNotEmpty: [:groups || classes newEnvironment |
			classes := groups gather: [:group | group classes].
			newEnvironment := self browsedEnvironment forClasses: classes.
			self model class openOnGroup: groups first inEnvironment: newEnvironment ]! !

!AbstractNautilusUI methodsFor: 'buttons behavior' stamp: 'MarcusDenker 12/6/2013 12:59'!
instanceButtonLabel
	| label |
	
	label := 'Class side' asMorph emphasis: 2.
	^self selectedClass 
		ifNil: [label]
		ifNotNil: [:class | 
			class theMetaClass hasMethods ifTrue: [label emphasis: 1] ifFalse:[label]]
	
	! !

!AbstractNautilusUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 12/20/2012 12:40'!
instanceButtonState

	^ "false" self showInstance not! !

!AbstractNautilusUI methodsFor: 'group announcements' stamp: 'NicolaiHess 1/19/2014 12:13'!
aGroupHasBeenRenamed: anAnnouncement
	 "(NautilusUI methodDict at: #aGroupHasBeenRegistered:) getSource"

	| group |
	window ifNil: [ ^ self ].
	window isDisplayed ifFalse: [^ self ].
	self groupsAreVisible ifFalse: [ ^ self ].
	group := anAnnouncement group.
	(self groupsManager includes: group)
		ifTrue: [ self updateGroupView ]! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: ''!
okToChangeComment

	commentTextArea canDiscardEdits ifTrue: [^ true].
	commentTextArea update: #wantToChange.  "Solicit cancel from view"
	^ commentTextArea canDiscardEdits
! !

!AbstractNautilusUI methodsFor: 'menu pragmas' stamp: 'EstebanLorenzano 1/30/2013 17:30'!
classPragma
	^'nautilusGlobalClassMenu'! !

!AbstractNautilusUI methodsFor: 'widget method' stamp: ''!
selectedMethod

	^ self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'build ui plugins' stamp: 'NicolaiHess 7/28/2014 21:19'!
buildTopPlugins

	| top container |
	top := self model plugins select: [:each | each position = #top ].
	top ifEmpty: [ ^ nil ].
	top size = 1 ifTrue: [ ^ top first display ].
	container := Morph new.
	container 
		color: Color transparent;
		changeTableLayout;
		cellInset: 8;
		listDirection: #topToBottom;
		cellPositioning: #topLeft;
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap.
	top reverse do: [:each |
		each display ifNotNil: [:morph | container addMorph: morph ]].
	^ container! !

!AbstractNautilusUI methodsFor: 'private' stamp: 'SebastianTleye 4/23/2013 13:11'!
loadList
	
	^ self 
		ifGroups: [ self getGroupsKeyList ]
		ifNot:[ self getPackagesWithoutExtensionsList ]! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: ''!
sourceCodeContainer

	^ sourceCodeContainer! !

!AbstractNautilusUI methodsFor: 'group announcements' stamp: 'NicolaiHess 1/19/2014 12:16'!
aGroupHasBeenUnregistered: anAnnouncement

	| group |
	window ifNil: [ ^ self ].
	window isDisplayed ifFalse: [^ self ].
	self groupsAreVisible ifFalse: [ ^ self ].
	group := anAnnouncement group.
	(self groupsManager includes: group)
		ifTrue: [ self updateGroupView ]! !

!AbstractNautilusUI methodsFor: 'menus' stamp: 'StephaneDucasse 8/23/2014 19:46'!
addModelItemsToWindowMenu: aMenu
	"Add model-related items to the window menu"

	aMenu addLine;
		add: 'Nautilus Plugins Manager'
		target: NautilusPluginManager new
		selector: #openInWorld.
		
	aMenu
		add: 'Shortcuts description'
		target: self
		selector: #openShortcutDescription.! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'MarcusDenker 10/15/2014 16:35'!
inspectMethod
	 self selectedMethod ifNil: [ ^ self ].
	 self selectedMethod inspect! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: 'NicolaiHess 10/1/2014 23:58'!
showHierarchy

	^ self model showHierarchy! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: ''!
fileOutPackage

	self fileOutPackages: self selectedPackages! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: 'NicolaiHess 1/19/2014 12:07'!
groupsAreVisible
^ self showGroups! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: ''!
createInitializerWithInstVars
	"Create a default initializer on the class side for a chosen list of instance variables"

	self createInitializerWithInstVarsOf: (self showInstance ifTrue: [ self selectedClass theNonMetaClass ] ifFalse: [ self selectedClass theMetaClass ])! !

!AbstractNautilusUI methodsFor: 'group' stamp: ''!
addClassesInGroup: aCollection

	(DialogGroupAdder new
		groups:	self groupsManager;
		elementsToAdd: ((aCollection collect: #theNonMetaClass) asSet asArray sort: [:a :b | a name < b name]))
		open! !

!AbstractNautilusUI methodsFor: 'plugins announcements' stamp: ''!
aKeyHasBeenPressed: aKey

	self announcer announce: (NautilusKeyPressed key: aKey )! !

!AbstractNautilusUI methodsFor: 'buttons behavior' stamp: ''!
groupsButtonState

	^ false! !

!AbstractNautilusUI methodsFor: 'browser compatibility' stamp: ''!
codeTextMorph

	^ sourceTextArea! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'MarcusDenker 1/17/2013 11:04'!
restrictedBrowseClass
	self selectedClass
		ifNil: [ ^ self ]
		ifNotNil: [ :class |
			self restrictedBrowseClasses: {class} ]! !

!AbstractNautilusUI methodsFor: 'menu builder' stamp: ''!
classMenuBuilder

	^ PragmaMenuBuilder withAllPragmaKeywords: {self classFixPragma. self classPragma} model: self! !

!AbstractNautilusUI methodsFor: 'widget method' stamp: ''!
methodsForCategory: aCategory
	^ self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'CamilloBruni 10/7/2012 22:00'!
restrictedBrowsePackages: packages
	| newEnvironment |
	newEnvironment := self browsedEnvironment forPackages: packages.
	 self model class 
		openOnPackage: self selectedPackage inEnvironment: newEnvironment! !

!AbstractNautilusUI methodsFor: 'build ui lists' stamp: 'MarcusDenker 10/14/2014 08:01'!
buildTextAreaButtonsColumn: aWindow

	| column |
	column := PanelMorph new.
	column 
		changeTableLayout;
		listDirection: #topToBottom.
		
		{    self buildBrowseInstVarsButton.
			self buildBrowseClassVarsButton} reverse do: [:each | column addMorph: each ].
	
	column 
		vResizing: #spaceFill;
		width: 24;
		hResizing: #rigid.
	
	^ column! !

!AbstractNautilusUI methodsFor: 'icon caches' stamp: ''!
removeFromClassesIconsCache: aClass
	" not used since the class's icons are always the same "
	
	ClassesIconsCache removeKey: aClass ifAbsent: [].
	self updateClassView.! !

!AbstractNautilusUI methodsFor: 'build ui buttons' stamp: 'NicolaiHess 7/31/2014 09:56'!
buildHierarchyButton

	^ (PluggableButtonMorph
			on: self 
			getState: #hierarchyButtonState
			action: #hierarchyButtonAction
			label: #hierarchyButtonLabel)
			getEnabledSelector: #hierarchyButtonEnabled;
			hResizing: #spaceFill;
			vResizing: #shrinkWrap;
			enabled: (self model selectedClass notNil);
			yourself! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: 'NicolaiHess 10/2/2014 00:02'!
showGroups: aBoolean

	self okToChange ifFalse: [ ^ self ].
	self flag:#todo.
	"test if this is necessary"
	"self setShortcuts: #NautilusClassShortcuts to: self classWidget."
	
	aBoolean 
		ifTrue: [ 
			self packageWidget enabled: true.
			self packageWidget removeShortcuts: #NautilusPackageShortcuts.
			self packageWidget setShortcuts: #NautilusGroupShortcuts]
		ifFalse: [
			self packageWidget removeShortcuts: #NautilusGroupShortcuts.
			self packageWidget setShortcuts: #NautilusPackageShortcuts].
		
	
	
	self resetPackageGroupsList.
	self showHierarchy 
		ifTrue: [ self showHierarchySilently: false ].
	self selectedGroup
		ifNil: [ self selectedClass: nil ]
		ifNotNil: [:group |
			(group elements includes: self selectedClass)
				ifFalse: [ 
						self resetClassesList.
					self selectedClass: nil ].
	aBoolean 
		ifTrue: [ 
			self packageWidget selectGroup: group ]
		ifFalse: [ 
			self packageWidget selectPackage: self selectedPackage ]].

	self model showGroups: aBoolean.
	self changed: #groupsButtonLabel.
	self changed: #hierarchyButtonLabel.
	self changedLabels.
	self updatePackageGroupAndClassList! !

!AbstractNautilusUI methodsFor: 'buttons behavior' stamp: 'NicolaiHess 9/7/2014 18:55'!
hierarchyButtonEnabled
	^ self selectedClass notNil or: [ self showHierarchy ]! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: 'EstebanLorenzano 5/15/2014 17:45'!
buildNewSourceTextArea

	sourceTextArea := self textMorphClass
				on: self
				text: #sourceCodeFrom:
				accept: #compileSource:notifying:
				readSelection: #contentsSelectionFrom:
				menu: #sourceCodeMenu:shifted:.
				
	sourceTextArea
		askBeforeDiscardingEdits: true;
		lockSelector: #lockTextArea:from:;
		canLockChangeSelector: #canChangeLockFor:;
		vResizing: #spaceFill;
		hResizing: #spaceFill; 
		font: StandardFonts codeFont;
		spaceFillWeight: 3;
		on: #keyStroke send: #keyStroke:fromSourceCodeMorph: to: self;
		warningLimit: self warningLimit.
		
	self setSourceCodeShorcutsTo: sourceTextArea.
		
	sourceTextAreaLimit := sourceTextArea warningLimit.
	
	sourceTextArea warningLimit: -1.

	sourceTextAreas addFirst: (sourceTextArea -> nil).
	
	^ sourceTextArea ! !

!AbstractNautilusUI methodsFor: 'system announcements' stamp: 'BenComan 3/23/2015 22:19'!
classRenamed: anAnnouncement
	
	| class |
	class := anAnnouncement classRenamed.
	window ifNil: [ ^ self].
	window isDisplayed ifFalse: [ ^ self ].
	((self showGroups 
	and: [ self selectedGroup elements includes: class ]) 
	or: [ self classWidget getClassesList includes: class ])
			ifTrue: [ 
				self updateClassView.
				sourceTextArea hasUnacceptedEdits 
					ifFalse: [ self changed: #sourceCodeFrom: ]
				]! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'CamilloBruni 9/14/2012 02:13'!
findClass
	"Search for a class from a pattern or from the recent list"
	self findClass: (SearchFacade classSearchInEnvironment: self browsedEnvironment).! !

!AbstractNautilusUI methodsFor: 'private' stamp: 'StephaneDucasse 9/26/2014 15:59'!
runTestsOfClass: aClass notifying: aBoolean
	| methods blockToEvaluate |

	methods := aClass methods select: [ :method | method isTestMethod ] thenCollect: [:e | e selector ].

	blockToEvaluate := [ |result |
		[ aClass resetHistory.
		result := (aClass addToSuite: TestSuite new fromMethods: methods) run.
		result updateResultsInHistory.
		ClassesIconsCache removeKey: aClass ifAbsent: [].
		testSemaphore signal. ] on: Exception do:[:e | testSemaphore signal . e defaultAction]].

	aBoolean 
		ifTrue: [ blockToEvaluate forkAt: Processor userBackgroundPriority ]
		ifFalse: [ blockToEvaluate value ].

	testSemaphore
		initSignals;
		wait.
	
	aBoolean 
		ifTrue: [ 
			| color |
			color := Color gray.
			aClass hasPassedTest ifTrue: [ color :=  Color green ].
			aClass hasFailedTest ifTrue: [ color :=  Color yellow ].
			aClass hasErrorTest ifTrue: [ color :=  Color red ].
			
			self 
				notifyTitle: 'Test Finished' 
				contents: 'Class: ', aClass name
				color: color ]! !

!AbstractNautilusUI methodsFor: 'menu pragmas' stamp: 'EstebanLorenzano 1/30/2013 17:23'!
packageFixPragma
	^ 'nautilusGlobalPackageFixMenu'! !

!AbstractNautilusUI methodsFor: 'selection' stamp: 'NicolaiHess 8/9/2014 23:13'!
resetCategoriesList
	self subclassResponsibility ! !

!AbstractNautilusUI methodsFor: 'widget category' stamp: 'NicolaiHess 7/28/2014 23:54'!
categoryWidget
	self subclassResponsibility ! !

!AbstractNautilusUI methodsFor: 'system announcements' stamp: 'NicolaiHess 7/26/2014 11:20'!
classCommented: anAnnouncement
	" announcement handled when a class has been commented " 
	| aClass |

	window ifNil: [ ^ self ].
	window isDisplayed ifFalse: [ ^ self ].

	aClass := anAnnouncement classCommented.	
	(self classWidget getClassesList includes: aClass)
		ifTrue: [ self removeFromClassesIconsCache: aClass ].
	
	((self selectedClass = aClass) and: [ self showComment ])
		ifTrue: [ self changed: #getComments ]! !

!AbstractNautilusUI methodsFor: 'build ui lists' stamp: 'NicolaiHess 7/28/2014 21:22'!
buildSecondColumn: aWindow

	| buttons |
	buttons := PanelMorph new.
	buttons 
		changeProportionalLayout;
		addMorph: self buildInstanceButton
		fullFrame: ( (0@0 corner: 0.5@0 ) asLayoutFrame bottomRightOffset: -2@25 );
		addMorph: self buildCommentButton
		fullFrame: ((	0.5@0 corner: 1@0 ) asLayoutFrame
						topLeftOffset: 2@0 ; 
						bottomRightOffset: 0@25 );
		hResizing: #spaceFill;
		vResizing: #rigid;
		height: 25.
		
	  ^PanelMorph new
						changeProportionalLayout;
						addMorph: self buildClassWidget
						fullFrame: (LayoutFrame identity
										bottomOffset: -29);
						addMorph: buttons
						fullFrame: ( (0@1 corner: 1@1 ) asLayoutFrame topOffset: -25);
						hResizing: #spaceFill;
						vResizing: #spaceFill;
						yourself.! !

!AbstractNautilusUI methodsFor: 'shortcuts' stamp: 'EstebanLorenzano 2/6/2013 14:00'!
setGroupShorcutsTo: aList
	aList attachKeymapCategory: #NautilusGroupShortcuts targetting: self! !

!AbstractNautilusUI methodsFor: 'drag and drop' stamp: 'NicolaiHess 8/2/2014 21:53'!
dropInAPackage: aCollection into: receiver 

	aCollection do:[:aClass |
		self showGroups
			ifTrue: [
				receiver addClasses: { aClass }.
				ActiveHand shiftPressed
					ifFalse: [ 
						self selectedGroup removeClass: aClass.
						self updateClassView ]]
			ifFalse: [
				receiver addClass: aClass theNonMetaClass.
				ActiveHand shiftPressed
					ifTrue: [ 
						self selectedClass: nil.
						self updateClassView ]
					ifFalse:[
						self selectedPackage: receiver.
						self selectedClass: aClass.
						self updatePackageGroupAndClassList ]]]! !

!AbstractNautilusUI methodsFor: 'private' stamp: 'EstebanLorenzano 5/28/2013 14:13'!
asYetUnclassifiedString

	^ Protocol unclassified.! !

!AbstractNautilusUI methodsFor: 'announcement registration' stamp: 'NicolaiHess 9/30/2014 21:49'!
registerToAnnouncements
	self registerToSystemAnnouncements.
	(Smalltalk 
		at: #TestCase
		ifPresent: [ self registerToTestAnnouncements ]). 
	self registerToMCAnnouncements.		
	self registerToGroupAnnouncements. ! !

!AbstractNautilusUI methodsFor: 'icons behavior' stamp: 'MarcusDenker 9/27/2013 18:05'!
saveDirtyPackages: aCollection 
	
	
	aCollection isEmptyOrNil ifTrue: [ ^ self ].
	aCollection do: [:package || workCopy browser |
		
		workCopy := MCWorkingCopy forPackage: (MCPackage named: package name).
		browser :=MCWorkingCopyBrowser new.
		browser
			show;
			workingCopy: workCopy.
		"wrap := MCDependentsWrapper with: workCopy model: browser.
		self halt.
		index := browser workingCopySelectionWrapper: wrap.
		browser workingCopyTreeMorph selectionIndex: index"]
	! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'NicolaiHess 4/8/2014 21:00'!
restrictedBrowseClasses: classes

	| newEnvironment |
	newEnvironment := self browsedEnvironment forClasses: (classes collect:#theNonMetaClass).
	self model class 
		openOnClass:self selectedClass 
		inEnvironment: newEnvironment ! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: 'NicolaiHess 7/27/2014 20:55'!
model: anObject

	model := anObject.
	self registerToAnnouncements.
	model when: #historyChanged send: #historyChanged to: self.
	anObject selectedPackage ifNotNil: [:e | self packageWidget selectPackage: e].
	anObject selectedGroup ifNotNil: [:p | self packageWidget selectGroup:p].
	anObject selectedClass ifNotNil: [:p | self classWidget selectClass: p].! !

!AbstractNautilusUI methodsFor: 'code panel' stamp: 'StephaneDucasse 12/19/2012 15:56'!
buildCodePanelWithoutComment

	sourceCodePanel 
				addMorph: multipleMethodsEditor
				fullFrame: LayoutFrame identity! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: ''!
putSourceTextAreaLimit

	sourceTextArea ifNotNil: [ sourceTextArea warningLimit: sourceTextAreaLimit ]! !

!AbstractNautilusUI methodsFor: 'private' stamp: ''!
popUpTestsResult: aClass! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'BenjaminVanRyseghem 6/28/2012 14:45'!
restrictedBrowse

	self showGroups ifTrue: [ ^ self restrictedBrowseGroup ].

	self selectedClass
		ifNil: [ self restrictedBrowsePackage ]
		ifNotNil: [ self restrictedBrowseClass ].! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'BenjaminVanRyseghem 4/6/2012 16:33'!
copyClasses
	
	| association |
	self okToChange ifFalse: [^ self].
	association := self copyClasses: (self selectedClasses collect: [:e | e theNonMetaClass ]).
	association key
		ifTrue: [
			self selectedClass: association value.
			self updateClassView]! !

!AbstractNautilusUI methodsFor: 'widget category' stamp: ''!
selectedCategory

	^ self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'group announcements' stamp: 'NicolaiHess 1/19/2014 12:06'!
aGroupHasBeenAdded: anAnnouncement
	 "(NautilusUI methodDict at: #aGroupHasBeenRegistered:) getSource"

	| group |
	window ifNil: [ ^ self ].
	window isDisplayed ifFalse: [^ self ].
	self groupsAreVisible ifFalse: [ ^ self ].
	group := anAnnouncement group.
	(self groupsManager includes: group)
		ifTrue: [ self updateGroupView ]! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'StephaneDucasse 1/31/2015 19:29'!
removeClasses
	"Remove the selected classes from the system, at interactive user request.  Make sure the user really wants to do this, since it is not reversible.  Answer true if removal actually happened."

	| result scroll |
	self okToChange ifFalse: [^ false].
	scroll := self classWidget vScrollValue.
	result := self removeClasses: (self selectedClasses collect: #theNonMetaClass).

	result
		ifTrue: [	
			self resetClassesListSelection.
			self selectedClass: nil ].
	self classWidget vScrollValue: scroll.
	^ result! !

!AbstractNautilusUI methodsFor: 'group' stamp: 'BenjaminVanRyseghem 4/6/2012 16:45'!
addPackagesInGroup
	
	self addPackagesInGroup: self selectedPackages! !

!AbstractNautilusUI methodsFor: 'source text events' stamp: ''!
keyStroke: anEvent fromSourceCodeMorph: aMorph
	
	^ self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 8/3/2012 18:48'!
showComment: aBoolean
	
	self okToChangeComment
		ifFalse: [ ^ self ].
	self model showComment: aBoolean.
	
	self updateCodePanel! !

!AbstractNautilusUI methodsFor: 'buttons behavior' stamp: 'NicolaiHess 9/7/2014 18:56'!
hierarchyButtonState

	^ self showHierarchy! !

!AbstractNautilusUI methodsFor: 'icons behavior' stamp: ''!
runTestForAMethod: aMethod notifying: anObject

	^ self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: 'NicolaiHess 9/7/2014 00:22'!
sortHierarchically

	^ self model sortHierarchically! !

!AbstractNautilusUI methodsFor: 'system announcements' stamp: 'MarcusDenker 9/27/2013 18:08'!
packageCreated: anAnnouncement
	window ifNil: [ ^ self ].
	window isDisplayed
		ifFalse: [ ^ self ].
	self showGroups
		ifFalse: [ self updatePackageView ]! !

!AbstractNautilusUI methodsFor: 'build ui lists' stamp: 'NicolaiHess 7/28/2014 21:22'!
buildFourthColumn: aWindow
		
	^ self buildMethodWidget! !

!AbstractNautilusUI methodsFor: 'shortcuts' stamp: ''!
setClassShorcutsTo: aList

	aList attachKeymapCategory: #NautilusClassShortcuts targetting: self! !

!AbstractNautilusUI methodsFor: 'private' stamp: 'NicolaiHess 8/9/2014 21:28'!
updatePackageViewAndMove
			
	self resetPackageGroupsList.
	self changed: #getPackageItem:! !

!AbstractNautilusUI methodsFor: 'announcement registration' stamp: 'BernardoContreras 10/21/2014 15:02'!
registerToTestAnnouncements
	"Since Test classes can be absent (in production, for instance, I use non-global references)"
	(Smalltalk at: #TestCase) historyAnnouncer weak
		when: (Smalltalk at: #TestCaseStarted) send: #testCaseStarted: to: self;
		when: (Smalltalk at: #TestSuiteEnded) send: #testRunned: to: self.! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 8/3/2012 18:48'!
updateCodePanel
	commentTextArea ifNil: [ self buildCommentPane ].
	sourceCodePanel removeAllMorphs.
	self model showComment
		ifTrue: [ self buildCodePanelWithComment ]
		ifFalse: [ self buildCodePanelWithoutComment ]! !

!AbstractNautilusUI methodsFor: 'private' stamp: ''!
packageLabel

	^'Packages'! !

!AbstractNautilusUI methodsFor: 'system announcements' stamp: ''!
methodRecategorized: anAnnouncement
	
	^ self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'vincentBlondeau 12/12/2014 13:59'!
runTestsOfGroups: aCollection notifying: aBoolean
	
	| classes label |
	label := 'Group: '.
	aCollection size >1 ifTrue: [ label := 'Groups: '].
	classes := aCollection gather:[:each | each elements ].
	classes := classes select: [:class | class isTestCase ].
	self runClassTests: classes notifying: false.
	aBoolean
		ifFalse: [ self
					notifyTitle: 'Test Finished'
					contents: label,((aCollection collect: #name) joinUsing: ', ') ]! !

!AbstractNautilusUI methodsFor: 'events handling' stamp: ''!
doubleClickOnGroup

	self selectedGroup 
		ifNil: [ ^self ]
		ifNotNil:[:group | self model class openOnGroup: group ]! !

!AbstractNautilusUI methodsFor: 'monticello announcements' stamp: 'EstebanLorenzano 4/14/2014 17:40'!
mcPackageModified: anAnnouncement
	" handled when a package become dirty "
	
	| rpackages |
	window ifNil: [^ self ].
	window isDisplayed ifFalse: [ ^ self ].

	rpackages := anAnnouncement package packageSet packages.
	rpackages isEmptyOrNil ifTrue: [ ^ self ].
	(self model packages includesAnyOf: rpackages )
		ifTrue: [ 
			rpackages do: [:rpackage | PackagesIconsCache removeKey: rpackage ifAbsent: []].
			self updatePackageView ]! !

!AbstractNautilusUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 8/1/2012 19:46'!
toggleShowComment

	self showComment: self showComment not.
	self changed: #commentButtonState! !

!AbstractNautilusUI methodsFor: 'private' stamp: 'MarcusDenker 9/27/2013 18:08'!
getGroupsKeyList
	| env |
	env := self browsedEnvironment.
	^ env isSystem
		ifTrue: [ self groupsManager groups ]
		ifFalse: [ self groupsManager groups reject: [ :g | (g classes intersection: self model classes) isEmpty ] ]! !

!AbstractNautilusUI methodsFor: 'group announcements' stamp: 'NicolaiHess 8/2/2014 21:54'!
aGroupHasBeenRemoved: anAnnouncement
	 "(NautilusUI methodDict at: #aGroupHasBeenRegistered:) getSource"

	window ifNil: [ ^ self ].
	window isDisplayed ifFalse: [^ self ].
	self groupsAreVisible ifFalse: [ ^ self ].
	(self groupsManager =  anAnnouncement holder)
		ifTrue: [ 
			self selectedGroup = anAnnouncement group
				ifTrue: [ self selectedGroup: nil ].
			self updateGroupView.
			self updateCategoryAndMethodList ]! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: 'EstebanLorenzano 1/31/2013 19:24'!
codePaneMenu: aMenu shifted: shifted 
	"Note that unless we override perform:orSendTo:, 
	PluggableTextController will respond to all menu items in a 
	text pane"
	| donorMenu |
	donorMenu := shifted
		ifTrue: [SmalltalkEditor shiftedYellowButtonMenu]
		ifFalse: [SmalltalkEditor yellowButtonMenu].
	^ aMenu addAllFrom: donorMenu! !

!AbstractNautilusUI methodsFor: 'private' stamp: 'NicolaiHess 8/9/2014 21:27'!
updateGroupView

	self resetPackageGroupsList.
	self changed: #getPackageItem:! !

!AbstractNautilusUI methodsFor: 'build ui lists' stamp: 'NicolaiHess 7/28/2014 21:22'!
buildThirdColumn: aWindow

	^ self buildCategoryWidget! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'CamilloBruni 10/7/2012 22:02'!
restrictedBrowseSuperclasses

	self selectedClass
		ifNil: [ ^ self ]
		ifNotNil: [ :class |
			self restrictedBrowseClasses: class withAllSuperclasses ]! !

!AbstractNautilusUI methodsFor: 'private' stamp: 'NicolaiHess 7/27/2014 13:25'!
selectedPackages
	^ self packageWidget selectedPackages! !

!AbstractNautilusUI methodsFor: 'code panel' stamp: 'StephaneDucasse 12/19/2012 15:47'!
buildCodePanelWithCommentOnBottom
	| splitter delta |
	
	splitter := ProportionalSplitterMorph new beSplitsTopAndBottom.
	delta := 2.

	splitter addLeftOrTop: multipleMethodsEditor.
	splitter addRightOrBottom: commentTextArea.

	sourceCodePanel
		addMorph: multipleMethodsEditor
		fullFrame: ( (0@0 corner: 1@0.5) asLayoutFrame 
						bottomOffset: delta negated).
	sourceCodePanel
		addMorph: splitter
		fullFrame: ( (0@0.5 corner: 1@0.5) asLayoutFrame
						topLeftOffset: 0@(delta negated) ; bottomRightOffset: 0@delta).
	sourceCodePanel 
		addMorph: commentTextArea
		fullFrame: ( (0@0.5 corner: 1@1) asLayoutFrame
						topLeftOffset: (0@delta)).! !

!AbstractNautilusUI methodsFor: 'menu builder' stamp: 'EstebanLorenzano 1/31/2013 19:24'!
classesMenu: aMenu shifted: aBoolean 

	^ aMenu addAllFrom: self classMenuBuilder menu.! !

!AbstractNautilusUI methodsFor: 'build ui buttons' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
buildBrowseClassVarsButton

	^ ( PluggableThreePhaseButtonMorph on: self )
					actionSelector: #browseClassVars;
					stateSelector: #isAClassSelected ;
					onImage: (Smalltalk ui icons iconNamed: #classVarsSelectedIcon);
					offImage: (Smalltalk ui icons iconNamed: #classVarsUnselectedIcon);
					pressedImage: (Smalltalk ui icons iconNamed: #classVarsPressedIcon);	
					extent: 24@24;
					helpText: 'Show class variables';
					yourself.! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'BenjaminVanRyseghem 4/14/2012 12:05'!
addClass

	self selectedPackage ifNotNil: [:package | self addClassIn: package ]! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: 'NicolaiHess 8/2/2014 21:54'!
showInstance: aBoolean

	self okToChange
		ifTrue:[
			self model showInstance: aBoolean.
			self resetClassesListSelection.
			self selectedClass 
				ifNotNil: [:class |
					aBoolean 
						ifTrue: [self selectedClass: class theNonMetaClass.
								acceptor := ClassOrMethodDefinitionAcceptor model: self ]
						ifFalse: [self selectedClass: class theMetaClass.
								acceptor := ClassDefinitionAcceptor model: self ]].
			self updateCategoryAndMethodList.
			self changed: #instanceButtonState.
			self changed: #instanceButtonLabel ]! !

!AbstractNautilusUI methodsFor: 'icons behavior' stamp: 'TorstenBergmann 8/23/2014 00:11'!
runExampleMethod: aMethod
	"Perform the method as an example method"
 
	aMethod methodClass baseClass perform: aMethod selector! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'vincentBlondeau 12/12/2014 13:58'!
forceGenerateInitialize

	self selectedClass ifNotNil: [:class || code index |
		(class isMeta not and: [class isTestCase])
			ifTrue: [
				index := 34.
				code := self buildSetUpCodeFor: class.
				class compile: code classified: 'initialization'.
				code := self buildTearDownCodeFor: class.
				class compile: code classified: 'initialization'.
				self selectedMethod: (class>>#setUp) ]
			ifFalse: [
				index := 62.
				code := self buildInitializeCodeFor: class.
				class compile: code classified: 'initialization' .
				self selectedMethod: (class>>#initialize) ].
		self updateCategoryAndMethodList.
		self giveFocusTo: sourceTextArea.
		sourceTextArea selectFrom: index+class name size to: index-1+class name size ].! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: ''!
sourceTextArea

	^ sourceTextArea! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: ''!
browseUnusedMethods
	
	self browseUnusedMethodsOf: self selectedClass! !

!AbstractNautilusUI methodsFor: 'selection' stamp: 'NicolaiHess 8/9/2014 21:50'!
resetClassesList
	self subclassResponsibility ! !

!AbstractNautilusUI methodsFor: 'group' stamp: 'NicolaiHess 1/19/2014 12:05'!
addNewGroup

	[ self groupsManager createAnEmptyStaticGroup ]
		on: GroupAlreadyExists 
		do:[ :ex | self alertGroupExisting: ex groupName ].
	! !

!AbstractNautilusUI methodsFor: 'icons behavior' stamp: 'TorstenBergmann 1/16/2015 20:24'!
runScriptMethod: aMethod
	"Perform the method as a script method"
 
	"For each <script> pragma run the method"		 
	aMethod isScriptMethod ifTrue: [ 
		aMethod pragmas 
					select: [:pragma | pragma keyword = #script ] 
					thenDo: [:pragma | aMethod methodClass baseClass perform: aMethod selector.
								 			UIManager default inform: 'Script executed: ', aMethod name asString  ]].

	"For each <script: '...'> pragma run the action code"
	aMethod isScriptMethodWithScript ifTrue: [ 
		aMethod pragmas 
					select: [:pragma | pragma keyword = #script: ]
					thenDo: [:pragma | Smalltalk compiler evaluate: pragma arguments first for: aMethod methodClass baseClass logged: false.
											UIManager default inform: 'Script with argument executed: ', aMethod name asString  ]].
	
	! !

!AbstractNautilusUI methodsFor: 'system announcements' stamp: 'NicolaiHess 8/9/2014 21:20'!
testCaseStarted: anAnnouncement
	| class selector |
	window ifNil: [ ^ self ].
	window isDisplayed ifFalse: [ ^ self ].
	class := anAnnouncement testCase class.
	selector := anAnnouncement testSelector.
	self selectedClass = class
		ifTrue: [| method icon |
			icon := Smalltalk ui icons iconNamed: #testNotRunIcon.
			method := class methodNamed: selector.
			self methodWidget 
				setIcon: icon for: method;
				updateMethodList ]! !

!AbstractNautilusUI methodsFor: 'plugins announcements' stamp: 'CamilloBruni 1/11/2013 14:12'!
openClass: aClass
	aClass ifNil: [ ^ self ].
	self open browseClass: aClass! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: ''!
renameCategory
	^ self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'widget method' stamp: ''!
forceSelectedMethod: aMethod

	^ self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'selection' stamp: 'NicolaiHess 8/9/2014 21:55'!
resetAllListSelections
	self subclassResponsibility ! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: ''!
window: anObject

	window := anObject! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: ''!
window

	^ window! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'CamilloBruni 10/7/2012 22:02'!
restrictedBrowseSubclasses

	self selectedClass
		ifNil: [ ^ self ]
		ifNotNil: [ :class |
			self restrictedBrowseClasses: class withAllSubclasses]! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: ''!
browseClassVarRefs

	self browseClassVarRefsOf: self selectedClass! !

!AbstractNautilusUI methodsFor: 'icons behavior' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
openCommentEditor: aClass
	| newComment |

	newComment := Smalltalk ui theme
		textEditorIn: window
		text: 'Enter a comment for the class ', aClass theNonMetaClass name,':'
		title: 'Comment Editor'
		entryText: aClass theNonMetaClass comment
		entryHeight: 300.
	
	newComment
		ifNotNil: [ aClass theNonMetaClass comment: newComment asString ]! !

!AbstractNautilusUI methodsFor: 'build ui buttons' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
buildBrowseInstVarsButton

	^ ( PluggableThreePhaseButtonMorph on: self )
					actionSelector: #browseInstVars;
					stateSelector: #isAClassSelected ;
					onImage: (Smalltalk ui icons iconNamed: #instVarsSelectedIcon);
					offImage: (Smalltalk ui icons iconNamed: #instVarsUnselectedIcon);
					pressedImage: (Smalltalk ui icons iconNamed: #instVarsPressedIcon);	
					extent: 24@24;
					helpText: 'Show instance variables';
					yourself.! !

!AbstractNautilusUI methodsFor: 'group' stamp: ''!
addPackagesInGroup: aCollection
	
	aCollection
		ifNotEmpty: [:packages || classes |
			classes := packages gather: [:package | package classes ].
			(DialogGroupAdder new
				groups:	self groupsManager;
				elementsToAdd: (self model classes intersection: classes))
				open]! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: 'NicolaiHess 10/2/2014 00:01'!
showHierarchySilently: aBoolean

	self model showHierarchy: aBoolean.! !

!AbstractNautilusUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 4/20/2012 00:03'!
runTestForMethods: aCollection notifying: aBoolean

	aCollection
		do: [ :each | 
			each isTestMethod
				ifTrue: [ self runTestForAMethod: each notifying: aBoolean ]]! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'CamilloBruni 10/7/2012 22:03'!
restrictedBrowseHierarchy

	self selectedClass
		ifNil: [ ^ self ]
		ifNotNil: [ :class |
			self restrictedBrowseClasses: (class withAllSuperclasses, class allSubclasses) ]! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: ''!
selectedMethodComments

	^ self selectedMethod comment! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'NicolaiHess 8/2/2014 21:53'!
renameGroup

	| group |
	group := self selectedGroup.
	group ifNil: [ ^ self ].
	[self groupsManager renameAGroup: group ]
		on: GroupAlreadyExists 
		do:[ :ex | self alertGroupExisting: ex groupName ].
	self updatePackageGroupAndClassList! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'NicolaiHess 8/2/2014 21:53'!
findClass: aSearchInstance
	"select the class returned by the search block"
	| aClass |
	self okToChange ifFalse: [^ self flashPackage ].
	aClass := aSearchInstance chooseFromOwner: self window.
	aClass ifNil: [^ self flashPackage].
	self showGroups: false.
	self selectedPackage: (self parentOfClass: aClass).
	self selectedClass: aClass.
	self updatePackageGroupAndClassList! !

!AbstractNautilusUI methodsFor: 'NOCompletion' stamp: 'BenjaminVanRyseghem 4/18/2012 13:16'!
selectedClassOrMetaClass

	^ self selectedClass! !

!AbstractNautilusUI methodsFor: 'private' stamp: 'NicolaiHess 8/9/2014 21:27'!
updatePackageView
	| scroll |
	
	self resetPackageGroupsList.
	scroll := self packageWidget scrollValue y.
	self changed: #getPackageItem:.
	self packageWidget vScrollValue: scroll! !

!AbstractNautilusUI methodsFor: 'widget package' stamp: 'NicolaiHess 7/28/2014 21:24'!
buildPackageWidget
	self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'system announcements' stamp: ''!
methodAdded: anAnnouncement

	^ self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'menu builder' stamp: 'EstebanLorenzano 1/31/2013 19:24'!
packagesMenu: aMenu shifted: aBoolean 
	^ aMenu addAllFrom: (self packageMenuBuilder menu)! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: ''!
methodHierarchy
	"Create and schedule a method browser on the hierarchy of implementors."

	self methodHierarchyFrom: self selectedMethod! !

!AbstractNautilusUI methodsFor: 'announcement registration' stamp: ''!
unregisterAPlugin: aPlugin

	self announcer unsubscribe: aPlugin! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: 'BenjaminVanRyseghem 8/6/2012 01:23'!
canChangeLockFor: source

	^ source locked or: [ self selectedMethod isNil not ]! !

!AbstractNautilusUI methodsFor: 'buttons behavior' stamp: 'NicolaiHess 10/2/2014 00:05'!
hierarchyButtonAction

	self hierarchyButtonEnabled
		ifTrue: [ 
			self toggleShowHierarchy.
			self changed: #hierarchyButtonEnabled. ]! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: ''!
selectedGroup
	
	^ self model selectedGroup! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: 'BenjaminVanRyseghem 2/8/2013 16:35'!
highlight: autoSelectString
	| first |

	first := sourceTextArea getText findString: autoSelectString.
	contentSelection := first to: first+autoSelectString size-1.
	self changed: #sourceCodeFrom:! !

!AbstractNautilusUI methodsFor: 'widget method' stamp: 'NicolaiHess 7/28/2014 21:24'!
buildMethodWidget
	self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'icons behavior' stamp: 'StephaneDucasse 10/26/2014 18:05'!
runClassInitializeMethod: aMethod
	"Perform the method as an example method"
 	|selectedClass|
	(UIManager default confirm: 'Would you like to (re)initialize the class')
		ifFalse: [ ^self ].
	selectedClass := aMethod methodClass baseClass.	
	selectedClass perform: aMethod selector.
	UIManager default inform: selectedClass name asString, ' initialized'.
	 ! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: ''!
getComments

	^ self selectedClass
		ifNil: [
			self selectedPackage
				ifNil: [ '' ]
				ifNotNil: [:package | '' "package comment" ]]
		ifNotNil: [:class | class comment ]! !

!AbstractNautilusUI methodsFor: 'buttons behavior' stamp: ''!
toggleShowGroups

	self showGroups: self showGroups not.! !

!AbstractNautilusUI methodsFor: 'menu builder' stamp: ''!
packageMenuBuilder

	^ PragmaMenuBuilder withAllPragmaKeywords: {self packageFixPragma. self packagePragma} model: self! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: ''!
fileOutMethods
	^ self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: 'EstebanLorenzano 6/26/2013 17:58'!
noMethodsString

	^ Protocol nullCategory! !

!AbstractNautilusUI methodsFor: 'system announcements' stamp: 'MarcusDenker 10/24/2013 11:15'!
packageRenamed: anAnnouncement
	window isDisplayed
		ifFalse: [ ^ self ].
	self showGroups
		ifFalse: [ self updatePackageView ]! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: 'NicolaiHess 8/2/2014 21:55'!
okToChangeSourceAndComment

	^ self okToChange and: [ self okToChangeComment ]! !

!AbstractNautilusUI methodsFor: 'selection' stamp: 'NicolaiHess 8/9/2014 21:54'!
resetPackageGroupsListSelection
	self subclassResponsibility ! !

!AbstractNautilusUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 3/23/2012 18:57'!
changedLabels

	"firstColumn label: self labelText."
	"secondColumn label: self labelText2."! !

!AbstractNautilusUI methodsFor: 'icon' stamp: 'YuriyTymchuk 12/20/2013 11:15'!
classIconFor: aClass

	ClassesIconsCache 
		at: aClass 
		ifPresent: [:icon | 
			 icon class == IconicButtonStateHolder ifFalse: [ ^ icon ].
			^ icon asIconTargetting: self ].

	((aClass includesBehavior: (Smalltalk globals at: #TestCase ifAbsent: [ false ])) and: [ aClass isAbstract not ])
		ifTrue: [ | icon button |
			icon :=  Smalltalk ui icons iconNamed: #testNotRunIcon.

			aClass hasPassedTest ifTrue: [ icon :=  Smalltalk ui icons iconNamed: #testGreenIcon ].
			aClass hasFailedTest ifTrue: [ icon :=  Smalltalk ui icons iconNamed: #testYellowIcon ].
			aClass hasErrorTest ifTrue: [ icon :=  Smalltalk ui icons iconNamed: #testRedIcon ].
					
			button := IconicButton new 
						target: self;
						actionSelector: #runTestsOfClass:notifying:;
						arguments: { aClass. true };
						labelGraphic: icon ;
						color: Color transparent;
						extent: 12 @ 12;
						helpText: 'Run the tests';
						borderWidth: 0.
			 ClassesIconsCache at: aClass put: (IconicButtonStateHolder forNautilus: button).
			^ button ]
		ifFalse: [
			(aClass organization classComment isEmpty and: [ Nautilus emptyCommentWarning ])
				ifTrue: [| button |
					button := IconicButton new 
								target: self;
								actionSelector: #openCommentEditor:;
								arguments: { aClass };
								labelGraphic: (Smalltalk ui icons iconNamed: #uncommentedClassIcon) ;
								color: Color transparent;
								extent: 12 @ 12;
								helpText:'Edit the comment';
								borderWidth: 0.
					 ClassesIconsCache at: aClass put: (IconicButtonStateHolder forNautilus: button).
					^ button ]].

	^ ClassesIconsCache at: aClass put: (aClass systemIcon)! !

!AbstractNautilusUI methodsFor: 'widget method' stamp: ''!
methodsIconsCache

	^ self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: ''!
clearUserEditFlag
	
	self changed: #clearUserEdits! !

!AbstractNautilusUI methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 6/13/2012 21:36'!
changed: aSymbol

	super changed: aSymbol.
	self announce: (NautilusChanged symbol: aSymbol)! !

!AbstractNautilusUI methodsFor: 'menu builder' stamp: ''!
sourceCodeMenuBuilder

	^ PragmaMenuBuilder pragmaKeyword: self sourceCodePragma model: self! !

!AbstractNautilusUI methodsFor: 'menu pragmas' stamp: 'EstebanLorenzano 1/30/2013 17:30'!
commonPragma
	^'nautilusGlobalCommonMenu'! !

!AbstractNautilusUI methodsFor: 'displaying' stamp: 'EstebanLorenzano 4/30/2014 11:54'!
open
	window := NautilusWindow new model: self.
	self addAll: window.
	window openInWorld.
	self changed:#sourceCodeFrom:.
	self setWindowTitle.! !

!AbstractNautilusUI methodsFor: 'announcement registration' stamp: 'BernardoContreras 10/21/2014 15:04'!
registerToGroupAnnouncements
	GroupAnnouncer uniqueInstance weak
		when: AGroupHasBeenRegistered send: #aGroupHasBeenRegistered: to: self;
		when: AGroupHasBeenUnregistered send: #aGroupHasBeenUnregistered to: self;
		when: AGroupHasBeenAdded send: #aGroupHasBeenAdded: to: self;
		when: AGroupHasBeenRemoved send: #aGroupHasBeenRemoved: to: self;
		when: AGroupHasBeenRenamed send: #aGroupHasBeenRenamed: to: self! !

!AbstractNautilusUI methodsFor: 'group announcements' stamp: 'NicolaiHess 1/19/2014 12:11'!
aGroupHasBeenRegistered: anAnnouncement
	 "(NautilusUI methodDict at: #aGroupHasBeenRegistered:) getSource"

	| group |
	window ifNil: [ ^ self ].
	window isDisplayed ifFalse: [^ self ].
	self groupsAreVisible ifFalse: [ ^ self ].
	group := anAnnouncement group.
	(self groupsManager includes: group)
		ifTrue: [ self updateGroupView ]! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'EstebanLorenzano 11/27/2013 14:05'!
restrictedBrowsePackage

	self selectedPackages
		ifEmpty: [ ^ self ]
		ifNotEmpty: [ :packages |
			^ self restrictedBrowsePackages: packages ]! !

!AbstractNautilusUI methodsFor: 'test creation' stamp: ''!
buildTestClassNameFrom: aClass
	
	^ (aClass name asString,'Test') asSymbol! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: ''!
browseClassRefs
	
	self browseClassRefsOf: self selectedClass.! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: 'NicolaiHess 12/26/2013 12:02'!
addComment: aText notifying: aController

	self selectedClass
		ifNil: [
			self selectedPackage
				ifNotNil: [:package | 
					"commentTextArea update: #clearUserEdits.
					package comment: aText"]]
		ifNotNil: [:class |
			commentTextArea update: #clearUserEdits.
			class comment: aText stamp: Author changeStamp]! !

!AbstractNautilusUI methodsFor: 'displaying' stamp: 'CamilloBruni 9/21/2012 13:47'!
close

	window close! !

!AbstractNautilusUI methodsFor: 'buttons behavior' stamp: 'NicolaiHess 7/29/2014 00:18'!
toggleShowInstance

	self showInstance: self showInstance not.
	self changed: #instanceButtonState.
	self categoryWidget label: self categoriesLabel.
	self methodWidget label: self methodsLabel.! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: 'MarcusDenker 8/10/2014 09:57'!
sourceCodeFrom: aTextMorph

	aTextMorph locked ifTrue: [ ^ aTextMorph textMorph text ].
	^ self sourceCode! !

!AbstractNautilusUI methodsFor: 'menu pragmas' stamp: 'EstebanLorenzano 1/30/2013 17:30'!
groupFixPragma
	^'nautilusGlobalGroupFixMenu'! !

!AbstractNautilusUI methodsFor: 'private' stamp: ''!
warningLimit
	
	^ self model 
		ifNil: [ 350 ]
		ifNotNil: [:mod | model warningLimit ]! !

!AbstractNautilusUI methodsFor: 'drag and drop' stamp: ''!
dropInAClass: aCollection into: aClass

	aCollection do: [:anObject | 
		(anObject isBehavior)
			ifFalse: [
				(anObject isString or: [ anObject isSymbol ])
					ifTrue: ["category"
						ActiveHand shiftPressed
							ifTrue: [ self copyCategory: anObject toTheClass: aClass ]
							ifFalse: [ self moveCategory: anObject toTheClass: aClass ]]
					ifFalse: [
						"a method"
						ActiveHand shiftPressed
							ifTrue: [ self copyMethod: anObject toTheClass: aClass ]
							ifFalse: [ self moveMethod: anObject toTheClass: aClass autoRemove: false ]]]]! !

!AbstractNautilusUI methodsFor: 'monticello announcements' stamp: 'EstebanLorenzano 4/14/2014 17:40'!
mcWorkingCopyDeleted: anAnnouncement
	| package rpackages |
	
	window ifNil: [^ self ].
	window isDisplayed ifFalse: [ ^ self ].
	
	package := anAnnouncement package.
	package ifNil: [ ^ self ].
	rpackages := package packageSet packages.
	rpackages isEmptyOrNil ifTrue: [ ^ self ].
	rpackages do: [:rpackage | 
		PackagesIconsCache removeKey: rpackage ifAbsent: []].
	self updatePackageView! !

!AbstractNautilusUI methodsFor: 'group' stamp: ''!
addMatchingPackagesInGroupsAndBrowse

	( self addMatchingPackagesInGroups )
		ifNotNil: [:group | 
			self selectedGroup: group.
			self showGroups: true]! !

!AbstractNautilusUI methodsFor: 'test creation' stamp: ''!
generateCommentForTestClass: testClass from: aClass

	^ String streamContents: [:stream || name |
			name := testClass name. 
			name first isVowel
				ifTrue: [ stream << 'An ']
				ifFalse:[ stream <<'A '].
			stream << name << ' is a test class for testing the behavior of '<< aClass name ]! !

!AbstractNautilusUI methodsFor: 'private' stamp: 'NicolaiHess 7/26/2014 12:20'!
selectedClasses
	^ self classWidget selectedClasses! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: 'StephaneDucasse 8/29/2013 22:15'!
classifier

	^ classifier! !

!AbstractNautilusUI methodsFor: 'private' stamp: 'NicolaiHess 7/27/2014 13:24'!
renamePackage: aPackage
	| isCurrent |
	isCurrent := self isSelectedPackage: aPackage.
	super renamePackage: aPackage.	
	isCurrent ifTrue: [ self selectedPackage: aPackage ].
	self packageWidget selectPackage: aPackage.! !

!AbstractNautilusUI methodsFor: 'shortcuts' stamp: 'BenjaminVanRyseghem 6/28/2012 15:18'!
openShortcutDescription

	KMDescription new
		categories: #(NautilusGlobalShortcuts "NautilusClassShortcuts NautilusSourceCodeShortcuts NautilusPackageShortcuts NautilusProtocolShortcuts NautilusMethodShortcuts") sort;
		openWithSpec! !

!AbstractNautilusUI methodsFor: 'private' stamp: ''!
commentLabel

	^ 'Comments'! !

!AbstractNautilusUI methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 10/28/2014 16:54'!
shiftedTextPaneMenuRequest! !

!AbstractNautilusUI methodsFor: 'announcement registration' stamp: ''!
announcer

	^ self model announcer! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/18/2012 09:43'!
selectedClass

	| class |
	class := self model selectedClass.
	(self model selectedCategory isNil and: [ self model selectedMethod isNil ])
		ifTrue: [ self setStylerClass: nil ]
		ifFalse: [ self setStylerClass: class ].
	^ class! !

!AbstractNautilusUI methodsFor: 'buttons behavior' stamp: 'StephaneDucasse 12/19/2012 16:04'!
toggleShowFullComment

	self showComment ifFalse: [ ^ self ].
	
	sourceCodePanel removeAllMorphs.
	sourceCodePanel 
		addMorph: self commentTextArea
		fullFrame: LayoutFrame identity! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: 'BenjaminVanRyseghem 8/1/2012 19:10'!
commentTextArea

	^ commentTextArea! !

!AbstractNautilusUI methodsFor: 'events handling' stamp: ''!
keyPressedOnElement: anEvent

	^ self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: 'NicolaiHess 10/2/2014 00:03'!
showHierarchy: aBoolean
	self okToChange
		ifFalse: [ ^ self ].
	self resetPackageGroupsList.
	self resetClassesList.
	self packageWidget enabled: aBoolean not.
	self classWidget showHierarchy: aBoolean.
	aBoolean
		ifTrue: [ 
			| class |
			class := self selectedClass theNonMetaClass.
			self classWidget selectClass: class.
			self resetPackageGroupsList.
			self resetClassesList.
			self showGroups
				ifTrue: [ self showGroupsSilently: false ] ].
	self resetPackageGroupsList.
	self resetClassesList.
	self model showHierarchy: aBoolean.
	self changed: #groupsButtonLabel.
	self updatePackageGroupAndClassList.
	self changed: #hierarchyButtonState.
	self changed: #hierarchyButtonLabel.
	self changedLabels! !

!AbstractNautilusUI methodsFor: 'test creation' stamp: 'vincentBlondeau 12/12/2014 13:58'!
createTestForClass: aClass

	| definition testClass className |

	aClass ifNil: [ ^ nil ].
	aClass isTestCase ifTrue: [ ^ nil ].
	aClass isMeta ifTrue: [ ^ nil ].

	className := self buildTestClassNameFrom: aClass.
	testClass := self class environment 
		at: className
		ifPresent: [:class | class ]
		ifAbsent: [ 
			definition := self buildTestClassDefinitionFrom: aClass.
			testClass := self 
				compileANewClassFrom: definition
				notifying: nil
				startingFrom: self selectedClass.
			self class environment at: className.
			testClass comment: (self generateCommentForTestClass: testClass from: aClass)].
	self showGroups: false.
	self selectedPackage: (self parentOfClass: testClass).
	self selectedClass: testClass.
	self updatePackageGroupAndClassList.
	^ testClass! !

!AbstractNautilusUI methodsFor: 'private' stamp: ''!
buildInitializerFor: aVariableList

	^ String streamContents: [ :stream|
		aVariableList 
			do: [ :varName|	stream << varName << ': ' << varName]
			separatedBy: [ stream << ' ' ].
		stream cr cr tab << '^ self new'; cr.
		aVariableList do: [ :varName|
			stream tab tab << varName << ': ' << varName << ';'; cr].
		stream tab tab << 'yourself']! !

!AbstractNautilusUI methodsFor: 'menu-packages' stamp: 'EstebanLorenzano 2/21/2014 12:42'!
demoteSelectedPackageAsPackageWithTag
	self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'private' stamp: ''!
browseInstVars

	| cls |
	cls := self selectedClass.
	(cls notNil and: [cls isTrait not])
		ifTrue: [ 
			self systemNavigation browseInstVarRefs: cls ].
	self changed: #isAClassSelected! !

!AbstractNautilusUI methodsFor: 'buttons behavior' stamp: ''!
groupsButtonAction

	self toggleShowGroups! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'NicolaiHess 7/29/2014 22:43'!
renamePackage

	self renamePackages: self selectedPackages.
	self updatePackageView.
	! !

!AbstractNautilusUI methodsFor: 'menu pragmas' stamp: 'EstebanLorenzano 1/30/2013 17:24'!
packagePragma
	^ 'nautilusGlobalPackageMenu'! !

!AbstractNautilusUI methodsFor: 'menu pragmas' stamp: 'EstebanLorenzano 1/30/2013 17:30'!
categoryPragma
	^'nautilusGlobalProtocolMenu'! !

!AbstractNautilusUI methodsFor: 'plugins announcements' stamp: 'CamilloBruni 1/11/2013 14:07'!
openSuperclass
	"Search for a superclass of the selected class from a pattern or from the recent list"

	self selectedClass ifNotNil: [ :class| 
		self openClass: class superclass ].! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'NicolaiHess 6/9/2014 00:04'!
buildSetUpCodeFor: aClass 
	
	^ String streamContents: [:str | str << 'setUp';cr.
		str tab << '"Setting up code for '<<aClass name<<'"';cr;cr.
		aClass instVarNames copy sort do: [:name | str cr tab << name << ' := nil.' ]].
	! !

!AbstractNautilusUI methodsFor: 'menu pragmas' stamp: 'EstebanLorenzano 1/30/2013 17:30'!
methodPragma
	^'nautilusGlobalMethodMenu'! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: 'MarcusDenker 8/10/2014 09:46'!
contentSelectionFor: aTextMorph

	aTextMorph locked ifTrue: [ ^ (1 to: 0) ].

	self selectedClass 	
		ifNotNil: [:class | self selectedMethod 
			ifNil: [ self selectedCategory 
				ifNotNil: [^ (1 to: class sourceCodeTemplate size) ]]].
	^ (1 to: 0)
! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: ''!
removeSourceTextAreaLimit

	sourceTextArea ifNotNil: [ sourceTextArea warningLimit: -1 ]! !

!AbstractNautilusUI methodsFor: 'code panel' stamp: ''!
buildCodePanelWithComment

	self model commentPosition == #right
		ifTrue: [ self buildCodePanelWithCommentOnRight ].
	self model commentPosition == #bottom
		ifTrue: [ self buildCodePanelWithCommentOnBottom ].
	self model commentPosition == #left
		ifTrue: [ self buildCodePanelWithCommentOnLeft ].
	self model commentPosition == #top
		ifTrue: [ self buildCodePanelWithCommentOnTop ].! !

!AbstractNautilusUI methodsFor: 'private' stamp: 'NicolaiHess 8/9/2014 21:28'!
updatePackageViewContent

	| vScrollValue |
	vScrollValue := self packageWidget scrollValue y.
	self resetPackageGroupsList.
	self changed: #getPackageItem:.
	self packageWidget vScrollValue: vScrollValue! !

!AbstractNautilusUI methodsFor: 'shortcuts' stamp: 'EstebanLorenzano 2/6/2013 17:30'!
setShortcuts: groupSymbol to: aMorph
	aMorph 
		attachKeymapCategory: (	Nautilus useOldStyleKeys 
			ifTrue: [ groupSymbol ]
			ifFalse: [ #NautilusGlobalShortcuts ])
		targetting: self
! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'NicolaiHess 7/27/2014 21:01'!
restrictedBrowseGroup

	self restrictedBrowseGroups: self packageWidget selectedGroups! !

!AbstractNautilusUI methodsFor: 'system announcements' stamp: 'NicolaiHess 8/2/2014 21:53'!
classRemoved: anAnnouncement
	
	| class oldPackage |
	window ifNil: [ ^ self ].
	window isDisplayed ifFalse: [ ^ self ].
	class := anAnnouncement classRemoved.
	((self showGroups 
	and: [ self selectedGroup ifNil: [ ^self ] ifNotNil: [:gp | gp elements includes: class ]]) 
	or: [ self classWidget getClassesList  includes: class ])
			ifTrue: [
				self selectedClass = class
					ifTrue: [ self selectedClass: nil ].
				window isDisplayed ifFalse: [ ^ self ].
				oldPackage := RPackageOrganizer default packageMatchingExtensionName: (anAnnouncement categoryName).
				self removeFromPackagesIconsCache: oldPackage.
				self updatePackageGroupAndClassList ].
	! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: ''!
model

	^ model! !

!AbstractNautilusUI methodsFor: 'build ui plugins' stamp: 'NicolaiHess 7/28/2014 21:19'!
buildBottomPlugins

	| bottom container |
	bottom := self model plugins select: [:each | each position = #bottom ].
	bottom ifEmpty: [ ^ nil ].
	bottom size = 1 ifTrue: [ ^ bottom first display ].
	container := Morph new.
	self setShortcuts: #NautilusSourceCodeShortcuts to: container.
	container 
		color: Color transparent;
		changeTableLayout;
		cellInset: 8;
		listDirection: #topToBottom;
		cellPositioning: #topLeft;
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap.
	bottom reverse do: [:each |
		each display ifNotNil: [:morph | container addMorph: morph ]].
	^ container! !

!AbstractNautilusUI methodsFor: 'code panel' stamp: 'StephaneDucasse 12/19/2012 15:53'!
buildCodePanelWithCommentOnRight
	| splitter delta |
	
	splitter := ProportionalSplitterMorph new.
	delta := 2.

	splitter addLeftOrTop: multipleMethodsEditor.
	splitter addRightOrBottom: commentTextArea.

	sourceCodePanel
		addMorph: multipleMethodsEditor
		fullFrame: ( (0@0 corner: 0.5@1) asLayoutFrame
						  bottomRightOffset: (delta negated)@0).
	sourceCodePanel
		addMorph: splitter
		fullFrame: ( (0.5@0 corner: 0.5@1) asLayoutFrame
						topLeftOffset: (delta negated)@0 ; bottomRightOffset: delta@0).
	sourceCodePanel 
		addMorph: commentTextArea
		fullFrame: ( (0.5@0 corner: 1@1) asLayoutFrame
						topLeftOffset: delta@0 ; bottomRightOffset: 0@0).! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: 'NicolaiHess 8/2/2014 21:53'!
compileAClassFrom: aString notifying: aController

	sourceTextArea update: #clearUserEdits.
	( self compileANewClassFrom: aString notifying: aController startingFrom: self selectedClass )
		ifNil: [^ sourceTextArea hasUnacceptedEdits: true. ]
		ifNotNil: [:class | 
			self selectedPackage: (self parentOfClass: class).
			self selectedClass: class.
			self showGroups
				ifTrue: [ self updateClassView ]
				ifFalse: [ self updatePackageGroupAndClassList ]]! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: 'NicolaiHess 7/30/2014 13:37'!
selectedGroup: anObject
	self okToChange
		ifFalse: [ ^ self ].
	self packageWidget resetGroupsSelection.
	anObject ifNotNil: [ self giveFocusTo: self packageWidget ].
	self packageWidget selectGroup: anObject.
	self selectedGroupWithoutChangingSelection: anObject! !

!AbstractNautilusUI methodsFor: 'system announcements' stamp: 'NicolaiHess 8/2/2014 21:54'!
testRunned: anAnnouncement

	| collection class correspondingClass |
	window ifNil: [ ^ self ].
	window isDisplayed ifFalse: [ ^ self ].
	
	class := anAnnouncement testResult.
	correspondingClass := anAnnouncement testResult correspondingClass.
	collection :=  self classWidget getClassesList.
	
	(collection includesAnyOf: {class. correspondingClass})
		ifTrue: [ 
			self removeClassFromMethodsIconsCache: class.
			self removeClassFromMethodsIconsCache: correspondingClass.
			self updateClassView.
			self updateCategoryAndMethodList ].! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'NicolaiHess 7/27/2014 21:01'!
removeGroups

	self okToChange ifFalse: [ ^ self ].
	self packageWidget selectedGroups
		ifNotEmpty:[:groups |
			self packageWidget resetGroupsSelection.
			groups do: [:group | self groupsManager removeAGroupSilently: group ].
			self selectedGroup: nil].
		! !

!AbstractNautilusUI methodsFor: 'icon caches' stamp: ''!
removeFromPackagesIconsCache: aPackage

	PackagesIconsCache removeKey: aPackage ifAbsent: [].! !

!AbstractNautilusUI methodsFor: 'shortcuts' stamp: 'BenjaminVanRyseghem 8/1/2012 19:13'!
setCommentShorcutsTo: aList

	aList attachKeymapCategory: #NautilusCommentShortcuts targetting: self! !

!AbstractNautilusUI methodsFor: 'icon caches' stamp: 'MarcusDenker 10/2/2013 20:16'!
removeClassFromMethodsIconsCache: aClass

	self methodsIconsCache keysDo: [:method | 
		" for overrides "
		method methodClass = aClass
			ifTrue: [ 
				self removeFromClassesIconsCache: aClass.
				self methodsIconsCache removeKey: method ifAbsent: [ ]]].! !

!AbstractNautilusUI methodsFor: 'build ui' stamp: 'NicolaiHess 7/28/2014 21:17'!
addAll: aWindow
	| topHeight middleHeight bottomMorph bottomHeight delta |
	
	delta := 0.
	bottomHeight := 0.
	middleHeight := 0.
	topHeight := 0.

	" reverse order in column ..."
	"column vResizing: #rigid."
	self buildTopPlugins ifNotNil: [:top |
		topHeight := top height.
		aWindow 
			addMorph: top
			fullFrame: ((0 @ 0 corner: 1 @ 0) asLayoutFrame bottomOffset: topHeight).
		delta := 4.
		topHeight := topHeight + delta.
		top color: Color transparent].
	
	"navigationRow := self buildNavigationRow: aWindow height: topHeight."

	self buildColumns: aWindow height: topHeight"+navigationRow".
	self setShortcuts: #NautilusSourceCodeShortcuts to: aWindow.
	
	self buildMiddlePlugins ifNotNil: [:middle |
		middleHeight := middle height+4.
		aWindow 
			addMorph: middle
			fullFrame: ((0 @ 0.5 corner: 1 @ 0.5) asLayoutFrame bottomOffset: middleHeight).
		middle color: Color transparent].
	
	sourceCodePanel := PanelMorph new.
	self setShortcuts: #NautilusSourceCodeShortcuts to: sourceCodePanel.
	sourceCodePanel changeProportionalLayout.
		
	sourceCodePanel 
		addMorph: self buildCodePane
		fullFrame: LayoutFrame identity.
		
	"self buildCommentPane."
	sourceCodePanel 
		hResizing: #spaceFill;
		vResizing: #spaceFill.
	sourceCodeContainer := PanelMorph new.
	self setShortcuts: #NautilusSourceCodeShortcuts to: sourceCodeContainer.
	sourceCodeContainer 
		changeTableLayout;
		listDirection: #leftToRight.

	{	sourceCodePanel.
		self buildTextAreaButtonsColumn: aWindow} reverse do: [:each | sourceCodeContainer addMorph: each].
	
	bottomMorph := self buildBottomPlugins.
	
	bottomMorph ifNotNil: [:bottom | bottomHeight := bottom height + 8].
	aWindow
		addMorph: sourceCodeContainer
		fullFrame: ( (0@0.5 corner: 1 @ 1) asLayoutFrame 
						topOffset: middleHeight;  bottomOffset: bottomHeight negated).
						
	bottomMorph ifNotNil: [:bottom |					
		aWindow				
			addMorph: bottom
			fullFrame: ((0 @ 1 corner: 1 @ 1) asLayoutFrame topOffset:  bottomHeight negated).
		bottom color: Color transparent]! !

!AbstractNautilusUI methodsFor: 'monticello announcements' stamp: ''!
newMCVersion: anAnnouncement

	| rpackage |
	window ifNil: [ ^ self ].
	window isDisplayed ifFalse: [ ^ self ].
	
	rpackage := anAnnouncement version package correspondingRPackage.
	rpackage ifNil: [ ^ self ].
	( self model packages includes: rpackage )
		ifTrue: [ 
			self removeFromPackagesIconsCache: rpackage.
			self updatePackageView ]! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'EstebanLorenzano 3/31/2015 12:21'!
browseVersions
	"Create and schedule a Versions Browser, showing all versions of the 
	currently selected message. Answer the browser or nil."
	self selectedMethod ifNil: [ ^ self inform: 'No method selected' ].
	self browseVersionsFrom: self selectedMethod! !

!AbstractNautilusUI methodsFor: 'build ui buttons' stamp: 'BenjaminVanRyseghem 12/20/2012 12:27'!
buildInstanceButton

	^ (CheckboxMorph
		on: self 
		selected: #instanceButtonState 
		changeSelected: #instanceButtonAction)
		getLabelSelector: #instanceButtonLabel;
		labelClickable: true;
		 hResizing: #spaceFill; 
		vResizing: #shrinkWrap;
		yourself
	"^ (PluggableButtonMorph
			on: self 
			getState: #instanceButtonState
			action: #instanceButtonAction
			label: #instanceButtonLabel) hResizing: #spaceFill; vResizing: #shrinkWrap"! !

!AbstractNautilusUI methodsFor: 'private' stamp: 'vincentBlondeau 12/12/2014 13:59'!
runClassTests: aCollection notifying: aBoolean

	(aCollection allSatisfy: [:each | each isTestCase ]) ifFalse: [ ^ self ].
	
	aCollection
		ifNotEmpty:[:classes | 
			classes do: [:class | self runTestsOfClass: class notifying: aBoolean ]]! !

!AbstractNautilusUI methodsFor: 'widget method' stamp: 'NicolaiHess 7/28/2014 23:54'!
methodWidget
	self subclassResponsibility ! !

!AbstractNautilusUI methodsFor: 'system announcements' stamp: 'NicolaiHess 8/2/2014 21:53'!
classRecategorized: anAnnouncement
	
	window ifNil: [ ^ self ].
	window isDisplayed ifFalse: [ ^ self ].
	self selectedPackage ifNotNil:[:selection |
	({ anAnnouncement oldCategory. anAnnouncement newCategory }
		anySatisfy: [ :each | selection includesCategory: each ])
			ifTrue: [ self updatePackageGroupAndClassList ]]! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: 'NicolaiHess 9/7/2014 18:57'!
selectedPackageWithoutChangingSelection: aPackage

	self okToChange
		ifTrue: [| class |
			class := self selectedClass.
			(self showHierarchy not and: [class notNil and: [class package ~= aPackage]])
				ifTrue: [ self selectedClass: nil ].
			self model package: aPackage class: self selectedClass category: nil method: nil.
			self packageWidget selectPackage:aPackage .
			self updateClassView.
			self updateCategoryAndMethodList.
			self changed: #getComments.
			self changed: #sourceCodeFrom:]! !

!AbstractNautilusUI methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 5/9/2012 11:28'!
dragTransferTypeForMorph: dragSource 

	^(dragSource isKindOf: PluggableListMorph)
		ifTrue: [ dragSource getListElementSelector ]! !

!AbstractNautilusUI methodsFor: 'NOCompletion' stamp: 'BenjaminVanRyseghem 4/18/2012 13:16'!
receiverClass

	^ self selectedClass! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'NicolaiHess 2/24/2015 09:35'!
generateInitialize
	
	self selectedClass ifNotNil: [:class || code index protocol |
		protocol := 'initialization'.
		(class isMeta not and: [class isTestCase])
			ifTrue: [
				index := 34.
				(class includesSelector:  #setUp) 
					ifFalse: [
						code := self buildSetUpCodeFor: class.
						class compile: code classified: protocol ].
				(class includesSelector: #tearDown) 
					ifFalse: [
						code := self buildTearDownCodeFor: class.
						class compile: code classified: protocol ].
				self selectedMethod: (class>>#setUp) 
				]
			ifFalse: [
				index := 62.
				(class includesSelector: #initialize) 
					ifFalse: [
						code := self buildInitializeCodeFor: class.
						class compile: code classified: protocol ].
				self selectedMethod: (class>>#initialize) ].
		self updateCategoryAndMethodList.
		self giveFocusTo: sourceTextArea.
		sourceTextArea selectFrom: index+class name size to: index-1+class name size ].! !

!AbstractNautilusUI methodsFor: 'code panel' stamp: 'StephaneDucasse 12/19/2012 15:49'!
buildCodePanelWithCommentOnLeft
	| splitter delta |
	
	splitter := ProportionalSplitterMorph new.
	delta := 2.

	splitter addLeftOrTop: commentTextArea.
	splitter addRightOrBottom: multipleMethodsEditor.

	sourceCodePanel
		addMorph: commentTextArea
		fullFrame: ( (0@0 corner: 0.5@1) asLayoutFrame 
						bottomRightOffset: (delta negated)@0).
	sourceCodePanel
		addMorph: splitter
		fullFrame:  ((0.5@0 corner: 0.5@1) asLayoutFrame 
						topLeftOffset: (delta negated)@0;  bottomRightOffset: delta@0).
	sourceCodePanel 
		addMorph: multipleMethodsEditor
		fullFrame: ( (0.5@0 corner: 1@1) asLayoutFrame 
						topLeftOffset: (delta@0)).! !

!AbstractNautilusUI methodsFor: 'private' stamp: 'NicolaiHess 8/9/2014 21:27'!
updatePackageGroupAndClassList

	self resetPackageGroupsList.
	self resetClassesList.
	self changed: #getPackageItem:.
	self changed: #getClassItem:! !

!AbstractNautilusUI methodsFor: 'build ui lists' stamp: 'NicolaiHess 7/28/2014 21:22'!
buildNavigationList
	| navigation |
	
	navigation := (DropListMorph
					on: self 
					list: #getHistoryList
					selected: #currentHistoryIndex
					changeSelected: #setHistory:)
					hResizing: #spaceFill;
					vResizing: #spaceFill;
					wrapSelector: #wrapHistory:;
					ghostText: 'History Navigator';
					yourself.
			
	self setShortcuts: #NautilusSourceCodeShortcuts to: navigation.
	
	^ navigation! !

!AbstractNautilusUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 4/17/2012 15:44'!
openDialogWouldYouInstall: aMethod into: aClass

	"open a dialog to ask user if he wants to override the existing method or not"
	^ UIManager default confirm: 'Are you sure you want to override the method ', aMethod selector, ' in ', aClass name label: 'Override' ! !

!AbstractNautilusUI methodsFor: 'private' stamp: 'NicolaiHess 7/28/2014 22:07'!
setCachedHierarchyClass: aClass
    | classesToBuild |
    classesToBuild :=
    model showInstance 
        ifTrue:  [  (aClass withAllSuperclasses, aClass allSubclasses) reject: [ :class | class isClassSide ] ]
        ifFalse: [  (aClass class withAllSuperclasses, aClass class allSubclasses) select: [ :class | class isClassSide ] ].
    cachedHierarchy := SortHierarchically buildHierarchyForClasses: classesToBuild.! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: 'BenjaminVanRyseghem 2/8/2013 16:22'!
resetContentsSelectionFrom: aTextMorph

	contentSelection at: aTextMorph put: (self contentSelectionFor: aTextMorph)! !

!AbstractNautilusUI methodsFor: 'icon caches' stamp: ''!
removeFromMethodsIconsCache: aMethod
	" if a test method has changed, we should reset the correspondng method "
	
	| corresponding |
	corresponding := aMethod correspondingMethods.
	corresponding do: [:each | self methodsIconsCache removeKey: each ifAbsent: []].
	self removeFromClassesIconsCache: aMethod methodClass.
	self methodsIconsCache removeKey: aMethod ifAbsent: [ ].! !

!AbstractNautilusUI methodsFor: 'test creation' stamp: ''!
buildTestClassDefinitionFrom: aClass

	^ 'TestCase subclass: ', (self buildTestClassNameFrom: aClass) printString, '
	instanceVariableNames: ''''
	classVariableNames: ''''
	poolDictionaries: ''''
	category: ''',(self buildTestPackageNameFrom:aClass),''''! !

!AbstractNautilusUI methodsFor: 'build ui buttons' stamp: 'EstebanLorenzano 1/30/2013 14:40'!
buildCommentButton
	| button |
	
	button := (PluggableButtonMorph
		on: self 
		getState: #commentButtonState
		action: #commentButtonAction
		label: #commentButtonLabel) hResizing: #spaceFill; vResizing: #shrinkWrap.
		
	self setShortcuts: #NautilusCommentShortcuts to: button.
	button submorphs first
		on: #doubleClick
		send: #toggleShowFullComment
		to: self;
		on: #mouseDown
		send: #mouseDown:
		to: button;
		on: #mouseMove
		send: #mouseMove:
		to: button;
		on: #mouseEnter
		send: #mouseEnter:
		to: button;
		on: #mouseLeave
		send: #mouseLeave:
		to: button;
		on: #mouseUp
		send: #mouseUp:
		to: button.
		
	^ button! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: 'MarcusDenker 1/7/2015 16:41'!
defaultClassDescriptor

	| string |
	string := Slot showSlotClassDefinition 
		ifTrue: [  
'Object subclass: #NameOfSubclass
	slots: {}
	classVariables: {}
	category: ''']
		ifFalse: [
'Object subclass: #NameOfSubclass
	instanceVariableNames: ''''
	classVariableNames: ''''
	category: ''' ].
	^ self selectedPackage
		ifNil: [string, '''' ]
		ifNotNil: [:package | string, package name, '''' ]! !

!AbstractNautilusUI methodsFor: 'widget method' stamp: ''!
methodsForCategories: aCollection

	^ self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: ''!
compileSource: aText notifying: aController
	^ self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'system announcements' stamp: 'EstebanLorenzano 10/14/2013 16:23'!
classAdded: anAnnouncement
	
	| class |
	window ifNil: [^ self ].
	window isDisplayed ifFalse: [ ^ self ].
	class := anAnnouncement classAdded.
	((self showGroups 
	and: [ self selectedGroup ifNil: [ ^ self ] ifNotNil: [:gp | gp elements includes: class ]]) 
	or: [ self selectedPackage = (self parentOfClass: class)])
				ifTrue: [
					self updateClassView.
					self removeFromPackagesIconsCache: class package ]! !

!AbstractNautilusUI methodsFor: 'buttons behavior' stamp: ''!
commentButtonAction

	self toggleShowComment.! !

!AbstractNautilusUI methodsFor: 'announcement registration' stamp: 'BernardoContreras 10/21/2014 15:06'!
registerToSystemAnnouncements

	self browsedEnvironment packageOrganizer announcer weak
		when: RPackageCreated send: #packageCreated: to: self;
		when: RPackageUnregistered send: #packageUnregistred: to: self;
		when: RPackageRenamed send: #packageRenamed: to: self.
		
	SystemAnnouncer uniqueInstance weak
		when: ClassAdded send: #classAdded: to: self;
		when: ClassCommented send: #classCommented: to: self;
		when: ClassRecategorized send: #classRecategorized: to: self;
		when: ClassModifiedClassDefinition send: #classDefinitionModified: to: self;
		when: ClassRemoved send: #classRemoved: to: self;
		when: ClassRenamed send: #classRenamed: to: self;
		when: ClassReorganized send: #classReorganized: to: self;
		
		when: MethodAdded send: #methodAdded: to: self;
		when: MethodModified send: #methodModified: to: self;
		when: MethodRecategorized send: #methodRecategorized: to: self;
		when: MethodRemoved send: #methodRemoved: to: self;
		
		when: ProtocolAdded send: #classReorganized: to: self;
		when: ProtocolRemoved send: #classReorganized: to: self.
	! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: ''!
addTrait

	self selectedPackage ifNotNil: [:package | self addTraitIn: package ]
	
	" No need of update, announcements will do the job "! !

!AbstractNautilusUI methodsFor: 'private' stamp: ''!
giveFocusTo: aMorph

	self hasFocus ifTrue: [aMorph takeKeyboardFocus]! !

!AbstractNautilusUI methodsFor: 'group' stamp: 'BenjaminVanRyseghem 4/6/2012 16:45'!
addPackagesAsGroupsAndBrowse

	(self addPackagesAsGroups: self selectedPackages)
		ifNotNil: [:group | 
			self selectedGroup: group.
			self showGroups: true]! !

!AbstractNautilusUI methodsFor: 'events handling' stamp: 'NicolaiHess 9/7/2014 19:13'!
listMouseDown: anEvent

	self showHierarchy
		ifTrue: [ 
			self showHierarchy: false.
			self packageWidget mouseDown: anEvent ].
! !

!AbstractNautilusUI methodsFor: 'private' stamp: ''!
isAClassSelected

	^ self selectedClass notNil! !

!AbstractNautilusUI methodsFor: 'private' stamp: ''!
copyCategory: anObject toTheClass: aClass
	
	| originClass methods |
	originClass := self selectedClass.
	methods := originClass methodsInProtocol: anObject.
	methods do: [:meth | self copyMethod: meth toTheClass: aClass ].! !

!AbstractNautilusUI methodsFor: 'private' stamp: 'MarcusDenker 9/27/2013 18:03'!
moveMethod: aMethod toTheClass: aClass autoRemove: autoRemove
	
	aMethod realClass = aClass ifTrue: [ ^ self ].
	aClass methodDict
						at: aMethod selector
						ifPresent: [:sel | 
							" here I have to fork to release the drag & drop "
							[ (self openDialogWouldYouInstall: sel into: aClass)
								ifTrue: [ | originClass oldCategory |
									oldCategory := aMethod category.
									originClass := aMethod realClass.
									aClass compile: aMethod sourceCode classified: oldCategory.
									self selectedMethod: nil.
									
									originClass removeSelector: aMethod selector.
									autoRemove
										ifTrue: [ (originClass selectorsInProtocol: oldCategory )
													ifEmpty: [ originClass removeProtocol: oldCategory ]]]] fork]
						ifAbsent: [ 
							 | originClass oldCategory |
							oldCategory := aMethod category.
							originClass := aMethod realClass.
							aClass compile: aMethod sourceCode classified: oldCategory.
							self selectedMethod: nil.
							originClass removeSelector: aMethod selector.
							autoRemove
								ifTrue: [
									( originClass selectorsInProtocol: oldCategory )
										ifEmpty: [ originClass removeProtocol: oldCategory ]]]! !

!AbstractNautilusUI methodsFor: 'widget class' stamp: 'NicolaiHess 7/28/2014 21:24'!
buildClassWidget
	self subclassResponsibility ! !

!AbstractNautilusUI methodsFor: 'menu pragmas' stamp: 'EstebanLorenzano 1/30/2013 17:30'!
sourceCodePragma
	^ 'nautilusGlobalSourceCodeMenu'! !

!AbstractNautilusUI methodsFor: 'widget category' stamp: 'NicolaiHess 7/28/2014 21:26'!
buildCategoryWidget
	self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'focus' stamp: 'NicolaiHess 7/26/2014 23:58'!
giveFocusToPackage

	self giveFocusTo: self packageWidget! !

!AbstractNautilusUI methodsFor: 'dispatch' stamp: 'CamilloBruni 10/7/2012 23:27'!
basicRenameClass: aClass

	self renameClass: aClass! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: ''!
showUnreferencedClassVars
	"Search for all class variables known to the selected class, and put up a 
	list of those that have no references anywhere in the system. The 
	search includes superclasses, so that you don't need to navigate your 
	way to the class that defines each class variable in order to determine 
	whether it is unreferenced"
	self showUnreferencedClassVarsOf: self selectedClass.! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: 'NicolaiHess 9/7/2014 18:57'!
selectedPackageWithoutChangingSelectionInternally: aPackage
	| class |
	class := self selectedClass.
	(self showHierarchy not and: [class notNil and: [class package ~= aPackage]])
		ifTrue: [ self selectedClass: nil ].
	self packageWidget selectPackage: aPackage.
	
	aPackage ifNotNil: [ self giveFocusTo: self packageWidget ].
	
	self updateClassView.
	self updateCategoryAndMethodList.
	self changed: #getComments.
	self changed: #sourceCodeFrom:! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'ClementBera 12/12/2014 11:44'!
toggleBytecodes
	self selectedMethod ifNil: [ ^ self ].
	sourceTextArea setText: (sourceTextArea text asString startsWithDigit 
		ifTrue: [ sourceTextArea getText ]
		ifFalse: [ self selectedMethod symbolic ])
	! !

!AbstractNautilusUI methodsFor: 'private' stamp: 'StephaneDucasse 8/29/2013 20:58'!
moveCategory: anObject toTheClass: aClass
	
	| originClass methods |
	originClass := self selectedClass.
	methods := originClass methodsInProtocol: anObject.
	methods do: [:meth | self moveMethod: meth toTheClass: aClass autoRemove: true ].
	
	(originClass methodsInProtocol: anObject)
		ifEmpty: [ 
			originClass removeProtocol: anObject.
			self selectedCategory: nil ].! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: 'BenjaminVanRyseghem 8/6/2012 00:49'!
lockTextArea: aBoolean from: source

	aBoolean
		ifTrue: [ self lockTextArea ]
		ifFalse: [ self unlockTextArea: source ].! !

!AbstractNautilusUI methodsFor: 'widget package' stamp: 'NicolaiHess 7/27/2014 14:08'!
packageWidget
	self subclassResponsibility ! !

!AbstractNautilusUI methodsFor: 'system announcements' stamp: 'NicolaiHess 7/27/2014 13:23'!
packageUnregistred: anAnnouncement
	| package |
	self showGroups
		ifTrue: [ ^ self ].
	package := anAnnouncement package.
	self selectedPackage = package
		ifTrue: [ self selectedPackage: nil ].
	self packageWidget selectPackage: package.
	window isDisplayed
		ifFalse: [ ^ self ].
	self updatePackageView! !

!AbstractNautilusUI methodsFor: 'test creation' stamp: 'TorstenBergmann 9/16/2014 13:03'!
createTestForSelectedClass
 
	self createTestForClass: self selectedClass theNonMetaClass ! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: ''!
showGroups

	^ self model showGroups! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: 'NicolaiHess 7/30/2014 13:47'!
selectedPackageGroup
	"give selected element from package/group pane, whatever is selected"
	^ self packageWidget selectedPackageGroup! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: ''!
browseInstVarDefs 

	self browseInstVarDefsOf: self selectedClass! !

!AbstractNautilusUI methodsFor: 'private' stamp: ''!
browseClassVars

	| cls |
	self selectedClass ifNil: [ 
		self changed: #isAClassSelected.
		^ self ].
	cls := self selectedClass theNonMetaClass.
	(cls notNil and: [cls isTrait not])
		ifTrue: [ self systemNavigation browseClassVarRefs: cls ].
		
	! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'BenjaminVanRyseghem 6/26/2012 23:52'!
browseSendersOfMessages
	"Present a menu of the currently selected message, as well as all messages sent by it.  Open a message set browser of all senders of the selector chosen."

	self selectedMethod ifNotNil: [:met | 
		self browseSendersOfMessagesFrom: met selector ]! !

!AbstractNautilusUI methodsFor: 'private' stamp: 'SebastianTleye 4/23/2013 13:09'!
getPackagesWithoutExtensionsList
	
	^ self model packagesWithoutExtensions sort: [:a :b | a name <= b name ]! !

!AbstractNautilusUI methodsFor: 'private' stamp: ''!
addSubclassesOf: aClass in: result withIndex: index

	| classes |
	classes := aClass subclasses "self selectedPackage
					ifNil: [ {} ]
					ifNotNil: [:p | aClass subclasses intersection: p classes ]".

	classes do: [:each |
		result at: each put: index.
		self addSubclassesOf: each theNonMetaClass in: result withIndex: index + 1 ]! !

!AbstractNautilusUI methodsFor: 'drag and drop' stamp: 'NicolaiHess 7/27/2014 20:09'!
wantsDroppedMorph: transferMorph event: anEvent inMorph: destinationLM 
	"We are only interested in TransferMorphs as wrappers for             
	informations. If their content is really interesting for us, will             
	determined later in >>acceptDroppingMorph:event:."

	| srcType dstType |

	"only want drops on lists (not, for example, on pluggable texts)"
	(destinationLM isKindOf: PluggableListMorph) ifFalse: [^ false].

	srcType := transferMorph dragTransferType.
	dstType := self dragTransferTypeForMorph: destinationLM.

	srcType == #getMethodItem:
		ifTrue: [
			^ (dstType == #getCategoryItem: or: [ dstType == #getClassItem: ])].

	srcType == #getCategoryItem:
		ifTrue: [ ^  dstType == #getClassItem: ].
	
	(srcType == #getClassItem: and: [ dstType = #getPackageItem: ]) 
		ifTrue: [ 
			(destinationLM potentialDropItem isKindOf: PluggableListMorph)
				ifTrue: [ ^ true ].
			self showGroups
				ifTrue: [ | receiver |
					receiver := destinationLM potentialDropItem originalObject.
					^ receiver isFillable ]
				ifFalse: [ ^ true ]]
		ifFalse:[ ^ false ].

	^ false! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: ''!
groupsManager

	^ self model groupsManager! !

!AbstractNautilusUI methodsFor: 'buttons behavior' stamp: 'NicolaiHess 10/2/2014 00:05'!
toggleShowHierarchy

	self showHierarchy: self showHierarchy not.! !

!AbstractNautilusUI methodsFor: 'private' stamp: ''!
textMorphClass

	^ PluggableTextMorphWithLimits! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'NicolaiHess 8/2/2014 21:54'!
removeEmptyCategories

	self okToChange ifFalse: [^ self].
	(self methodsForCategory: self selectedCategory) 
		ifEmpty: [ self selectedCategory: nil ].
		
	self removeEmptyCategoriesFrom: self selectedClass.
	
	self updateCategoryAndMethodList.! !

!AbstractNautilusUI methodsFor: 'test creation' stamp: ''!
buildTestPackageNameFrom:aClass

	^ aClass package name asString, '-Tests' ! !

!AbstractNautilusUI methodsFor: 'widget method' stamp: ''!
selectedMethod: aMethod

	^ self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'menu-packages' stamp: 'EstebanLorenzano 2/19/2014 16:32'!
promoteSelectedPackageTagAsPackage
	self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'private' stamp: ''!
title

	^'Nautilus'! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: 'NicolaiHess 8/2/2014 21:55'!
selectedClass: aClass
	self okToChangeSourceAndComment
		ifFalse: [ ^ self ].
	self resetClassesListSelection.
	aClass ifNotNil: [ self giveFocusTo: self classWidget ].
	self selectedClassWithoutChangingSelection: aClass! !

!AbstractNautilusUI methodsFor: 'selection' stamp: 'NicolaiHess 8/9/2014 21:53'!
resetCategoriesListSelection
	self subclassResponsibility ! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'TorstenBergmann 9/9/2014 16:07'!
compareTwoMethods
	^ self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'menu builder' stamp: ''!
methodMenuBuilder

	^ PragmaMenuBuilder withAllPragmaKeywords: {self commonPragma. self methodPragma} model: self! !

!AbstractNautilusUI methodsFor: 'menu pragmas' stamp: 'EstebanLorenzano 1/30/2013 17:30'!
groupPragma
	^'nautilusGlobalGroupMenu'! !

!AbstractNautilusUI methodsFor: 'icons behavior' stamp: ''!
runClassTests

	self runClassTests: self selectedClasses notifying: true! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'NicolaiHess 7/28/2014 22:39'!
removePackages

	| names |
	self selectedPackages 
		ifNotEmpty: [:packages |
			names := packages collect: [:package | package name ].
			names := names joinUsing: String cr.
			(UIManager default confirm: ('Are you sure you want to delete the package(s) named ', String cr, names, ' and their classes ?'))
				ifTrue: [| scroll |
					packages do: [:package |
						package definedClasses do:[: classToRemove |
									classToRemove subclasses notEmpty
									ifTrue: [ | message |
										message := 'Are you certain that you
want to REMOVE the class ', classToRemove name, '
from the system?'.
										(self confirm: 'class has subclasses: ' , message)
										ifFalse: [^ nil]].
									classToRemove removeFromSystem ].
						self browsedEnvironment packageOrganizer unregisterPackage: package ].
					scroll := self packageWidget scrollValue y .
					self selectedPackage: nil.
					self updatePackageView.
					self packageWidget vScrollValue: scroll ]]! !

!AbstractNautilusUI methodsFor: 'plugins announcements' stamp: 'CamilloBruni 1/11/2013 13:35'!
browseSuperclassOf: class
	^ self browseClass: class superclass! !

!AbstractNautilusUI methodsFor: 'buttons behavior' stamp: ''!
commentButtonState

	^ self showComment! !

!AbstractNautilusUI methodsFor: 'private' stamp: ''!
browsedEnvironment

	^ self model browsedEnvironment! !

!AbstractNautilusUI methodsFor: 'buttons behavior' stamp: 'NicolaiHess 1/19/2014 12:21'!
groupsButtonLabel

	^ 
		((self showGroups) and:[self groupsAreVisible])
			ifTrue: [ self packageLabel ]
			ifFalse: [ self groupsLabel ]! !

!AbstractNautilusUI methodsFor: 'widget category' stamp: ''!
selectedCategory: anObject

	^ self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'private' stamp: ''!
flashPackage

	^ nil! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'md 10/25/2014 11:01'!
buildInitializeCodeFor: aClass 

	^ String streamContents: [:str | 
		str << 'initialize';cr.
		aClass isMeta ifFalse: [str cr tab << 'super initialize.';cr.].
		aClass instVarNames copy sort do: [ :name | 
			str cr tab << name << ' := nil.' ]].
	! !

!AbstractNautilusUI methodsFor: 'plugins announcements' stamp: 'CamilloBruni 1/11/2013 13:35'!
browseSuperclass

	self selectedClass
		ifNil: [ ^ self ]
		ifNotNil: [ :class |
			self browseSuperclassOf: class ]! !

!AbstractNautilusUI methodsFor: 'icon' stamp: 'MarcusDenker 7/16/2014 17:24'!
packageIconFor: aPackage
	| mcpackage |
	
	PackagesIconsCache
		at: aPackage
		ifPresent: [:icon |
			 icon class == IconicButtonStateHolder ifFalse: [ ^ icon ].
			^ icon asIconTargetting: self ].

	aPackage classes isEmpty ifTrue: [^ PackagesIconsCache at: aPackage put: (Smalltalk ui icons iconNamed: #emptyPackageIcon) ].
	
	mcpackage := aPackage mcPackage.
	(mcpackage notNil and: [ mcpackage isDirty ])
		ifTrue: [ | icon |
			icon := IconicButton new 
						target: self;
						actionSelector: #saveDirtyPackages:;
						arguments: {{ aPackage }};
						labelGraphic: (aPackage definedClasses
											ifEmpty: [ (Smalltalk ui icons iconNamed: #dirtyMonticelloPackageIcon) ]
											ifNotEmpty: [ (Smalltalk ui icons iconNamed: #dirtyPackageIcon) ]);
						color: Color transparent;
						extent: 15 @ 16;
						helpText: 'Save the package';
						borderWidth: 0.
			 PackagesIconsCache at: aPackage put: (IconicButtonStateHolder forNautilus: icon).
			^ icon ].

	(mcpackage notNil and: [(mcpackage name = aPackage name ) and: [ aPackage definedClasses isEmpty]])
		ifTrue: [ ^ PackagesIconsCache at: aPackage put: (Smalltalk ui icons iconNamed: #monticelloPackageIcon) ].

	^ PackagesIconsCache at: aPackage put: (Smalltalk ui icons iconNamed: #packageIcon)! !

!AbstractNautilusUI methodsFor: 'private' stamp: 'vincentBlondeau 12/12/2014 13:59'!
runPackagesTestsNotifying: aBoolean

	self selectedPackages
		ifNotNil: [:packages || classes label |
			label := 
			packages size > 1
				ifTrue: [ 'Packages: ' ]
				ifFalse: [ 'Package: ' ].
			classes := packages gather: [:package | package definedClasses ].
			classes := classes select: [:class | class isTestCase ].
			self runClassTests: classes notifying: false.
			aBoolean
				ifTrue: [ 
					| color |
					color := Color gray.
					(classes anySatisfy:[:e  | e hasPassedTest ]) ifTrue: [ color := Color green ].
					(classes anySatisfy:[:e  | e hasFailedTest ]) ifTrue: [ color := Color yellow ].
					(classes anySatisfy:[:e  | e hasErrorTest ]) ifTrue: [ color := Color red ].
					self 
						notifyTitle: 'Test Finished'
						contents: label , ((packages collect: #name) joinUsing: ', ')
						color: color ]].! !

!AbstractNautilusUI methodsFor: 'drag and drop' stamp: 'NicolaiHess 7/27/2014 20:09'!
dragPassengersFor: item inMorph: dragSource 
	| transferType object |
	
	object := item originalObject.

	(dragSource isKindOf: PluggableListMorph)
		ifFalse: [^ nil ].
	transferType := self dragTransferTypeForMorph: dragSource.
	transferType == #getCategoryItem:
		ifTrue: [ ^ self selectedCategories ifEmpty: [ { object } ] ].
	
	transferType == #getClassItem:
			ifTrue: [ 
				self showGroups 
					ifTrue: [ self selectedGroup
								ifNil: [ ^ nil ]
								ifNotNil: [:g | g isFillable ifFalse: [ ^ nil ]]].
				
				^ self selectedClasses ifEmpty: [ { object } ]].

	transferType == #getMethodItem:
			ifFalse: [ ^ nil ].

	^ self selectedMethods
		ifEmpty: [
			 (self getMethods includes: object)
				ifTrue: [{ object }]
				ifFalse: [ nil ]]! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: ''!
addCategory
	^ self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'source code area' stamp: 'johanfabry 1/20/2014 11:29'!
selectedClassDescription

	^ self selectedClass definitionForNautilus
! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: ''!
selectedClassWithoutChangingSelection: aClass 
	^ self subclassResponsibility! !

!AbstractNautilusUI methodsFor: 'private' stamp: ''!
extensionColor

	^ Color gray darker! !

!AbstractNautilusUI methodsFor: 'build ui' stamp: 'BenjaminVanRyseghem 4/3/2014 13:46'!
buildSeparator

	^ Morph new height: 8; width: 0; color: Color transparent.! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'MarcusDenker 10/15/2014 16:29'!
inspectMethods
	 self selectedClass ifNil: [ ^ self ].
	 self selectedClass methods inspect! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: ''!
showInstance

	^ self model showInstance! !

!AbstractNautilusUI methodsFor: 'shortcuts' stamp: 'EstebanLorenzano 1/30/2013 14:37'!
setSourceCodeShorcutsTo: aList

	aList attachKeymapCategory: #NautilusSourceCodeShortcuts targetting: self! !

!AbstractNautilusUI methodsFor: 'group' stamp: ''!
addClassesInGroup

	self selectedClasses ifNotNil: [:classes | self addClassesInGroup: classes ].! !

!AbstractNautilusUI methodsFor: 'plugins announcements' stamp: 'NicolaiHess 8/2/2014 21:53'!
browseClass: aClass
	
	self showGroups: false.
	self selectedPackage: (self parentOfClass: aClass).
	self selectedClass: aClass.
	self updatePackageGroupAndClassList! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'GuillermoPolito 9/26/2014 14:11'!
moveInPackage

	"Present a choice of categories or prompt for a new category name and add it before the current selection, or at the end if no current selection"
	| foundPackage |
	self okToChange ifFalse: [^ self].
	foundPackage := SearchFacade rPackageSearch chooseFromOwner: self window.
	foundPackage ifNil: [ ^self ].
	self selectedClasses 
		do: [:aClass | aClass category: foundPackage name ].
		self flag: #esteban. "unclear that we should still use category:"
	 self selectedPackage: foundPackage.
	self updatePackageGroupAndClassList! !

!AbstractNautilusUI methodsFor: 'icons behavior' stamp: 'NicolaiHess 7/11/2014 10:42'!
arrowUp: aMethod
	| newMethod |
	newMethod := aMethod methodClass superclass lookupSelector: aMethod selector.
	newMethod
		ifNil: [ self methodWidget invalidateCacheEntryFor: aMethod ]
		ifNotNil: [ self model class openOnMethod: newMethod ]! !

!AbstractNautilusUI methodsFor: 'menus behavior' stamp: 'CamilloBruni 9/14/2012 01:48'!
findSuperclass
	"Search for a superclass of the selected class from a pattern or from the recent list"
	self selectedClass ifNotNil: [ :class| 
		self findClass: (SearchFacade superclassSearchFor: class theNonMetaClass)].! !

!AbstractNautilusUI methodsFor: 'accessing' stamp: 'NicolaiHess 7/27/2014 20:58'!
selectedGroupWithoutChangingSelection: anObject

	self okToChange
		ifTrue: [
			anObject ifNil: [ self packageWidget resetGroupsSelection ].
			self model selectedGroup: anObject.
			self packageWidget selectGroup: anObject.
			self selectedClass: nil.
			self updateClassView ]! !

!AbstractNautilusUI class methodsFor: 'shortcut-old' stamp: 'EstebanLorenzano 2/6/2013 16:41'!
buildCommentShortcutsOn: aBuilder
	<keymap>	

	self buildEditorCommentKeymappingsOldOn: aBuilder.
	
	(aBuilder shortcut: #runTest)
		category: #NautilusCommentShortcuts
		default: $t command
		do: [:target |
				(target selectedMethod isTestMethod and: [ target commentTextArea hasUnacceptedEdits not ])
					ifTrue: [ target runTestForAMethod: target selectedMethod notifying: true
				]]
		description: 'Run the current test method'.! !

!AbstractNautilusUI class methodsFor: 'menu' stamp: 'NicolaiHess 12/17/2014 00:15'!
sourceCodeMenuExtra: aBuilder
	<contextMenu>
	<nautilusGlobalSourceCodeMenu>
	| target method |
	target := aBuilder model.
	target selectedClass ifNil: [ ^ self ].
	method := target selectedMethod.
	(target selectedClass isTestCase and: [ method notNil and: [ method selector beginsWith: 'test' ]])
		ifTrue: [
			(aBuilder item: #'Run Test')
					order: 1;
					keyText: 'j, m' if: Nautilus useOldStyleKeys not;
					selector: #runTestForAMethod:notifying:;
					arguments: { target selectedMethod. true };
					enabledBlock: [ target sourceTextArea hasUnacceptedEdits not ];
					withSeparatorAfter ].! !

!AbstractNautilusUI class methodsFor: 'menu' stamp: 'MarcusDenker 5/28/2014 16:31'!
classesFixMenu: aBuilder
	<contextMenu>
	<nautilusGlobalClassFixMenu>
	| target |
	target := aBuilder model.
	
	(aBuilder item: #'Find Method...')
		keyText: 'f, m' if: Nautilus useOldStyleKeys not;
		keyText: 'f' if: Nautilus useOldStyleKeys;
		action: [target findMethod];
		order: 100;
		help: 'Search for a method by selector'.
		
	(aBuilder item: #'Find Class...')
		keyText: 'f, c' if: Nautilus useOldStyleKeys not;
		keyText: 'F' if: Nautilus useOldStyleKeys;
		action: [ target findClass ];
		order: 200;
		help: 'Search for a method by selector'.
	
	(aBuilder item: #'Add Class...')
		keyText: 'n, c' if: Nautilus useOldStyleKeys not;
		keyText: 'n' if: Nautilus useOldStyleKeys;
		action: [ target addClass ];
		order: 400;
		help: 'Create a new class'.
	(aBuilder item: #'Add Trait...')
		action: [ target addTrait ];
		order: 500;
		withSeparatorAfter.
		
	(aBuilder item: #'Browse full')
		keyText: 'b, f' if: Nautilus useOldStyleKeys not;
		keyText: 'b' if: Nautilus useOldStyleKeys;
		action: [target fullBrowse];
		order: 999;
		help: 'Open the same browser'.! !

!AbstractNautilusUI class methodsFor: 'icon' stamp: 'EstebanLorenzano 5/14/2013 12:00'!
resetIconCaches
	ClassesIconsCache removeAll.
	GroupsIconsCache removeAll.
	PackagesIconsCache removeAll.
	MethodWidget resetMethodIconCache.! !

!AbstractNautilusUI class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/18/2013 17:40'!
classesIconsCache: anObject
	
	ClassesIconsCache := anObject! !

!AbstractNautilusUI class methodsFor: 'accessing' stamp: ''!
groupsIconsCache

		^ GroupsIconsCache! !

!AbstractNautilusUI class methodsFor: 'icon' stamp: 'EstebanLorenzano 5/10/2013 13:04'!
resetClassesIconsCache
	ClassesIconsCache removeAll.
! !

!AbstractNautilusUI class methodsFor: 'shortcuts' stamp: 'StephaneDucasse 2/11/2014 10:58'!
buildEditorCommentKeymappingsOn: aBuilder

	(aBuilder shortcut: #selectAll) 
		category: #NautilusCommentShortcuts
		default: $a command
		do: [ :target | target commentTextArea handleEdit: [ target commentTextArea selectAll ] ].
		
	(aBuilder shortcut: #copySelection) 
		category: #NautilusCommentShortcuts
		default: $c command
		do: [ :target | target commentTextArea copySelection ].
		
	(aBuilder shortcut: #find) 
		category: #NautilusCommentShortcuts
		default: $f command, $f command
		do: [ :target | target commentTextArea find ].
		
	(aBuilder shortcut: #findAgain) 
		category: #NautilusCommentShortcuts
		default:  $f command, $g command
		do: [ :target | target commentTextArea findAgain ].
		
	(aBuilder shortcut: #setSearchString)
		category: #NautilusCommentShortcuts
		default: $h command
		do: [ :target | target commentTextArea setSearchString ].
		
	(aBuilder shortcut: #cancel) 
		category: #NautilusCommentShortcuts
		default: $l command
		do: [ :target | target commentTextArea cancelWithoutConfirmation ].
		
	(aBuilder shortcut: #paste) 
		category: #NautilusCommentShortcuts
		default: $v command
		do: [ :target | target commentTextArea paste ].
		
	(aBuilder shortcut: #cut) 
		category: #NautilusCommentShortcuts
		default: $x command
		do: [ :target | target commentTextArea cut ].
				
	(aBuilder shortcut: #undo) 
		category: #NautilusCommentShortcuts
		default: $z command
		do: [ :target | target commentTextArea undo ].
		
	(aBuilder shortcut: #redo) 
		category: #NautilusCommentShortcuts
		default: $z command shift
		do: [ :target | target commentTextArea redo ].
	
	(aBuilder shortcut: #cursorHome)
		category: #NautilusCommentShortcuts
		default: Character home command
		do: [ :target :morph :event | target commentTextArea cursorHome: event ].
	
	(aBuilder shortcut: #cursorEnd)
		category: #NautilusCommentShortcuts
		default: Character end command
		do: [ :target :morph :event | target commentTextArea cursorEnd: event ].

	(aBuilder shortcut: #browseIt) 
		category: #NautilusCommentShortcuts
		default: $b command
		do: [ :target | target commentTextArea browseIt ].
				
	(aBuilder shortcut: #doIt) 
		category: #NautilusCommentShortcuts
		default: $d command
		do: [ :target | target commentTextArea doIt ].

	(aBuilder shortcut: #inspectIt) 
		category: #NautilusCommentShortcuts
		default: $i command
		do: [ :target | target commentTextArea inspectIt ].
		
	(aBuilder shortcut: #implementorsOfIt) 
		category: #NautilusCommentShortcuts
		default: $m command
		do: [ :target | target commentTextArea implementorsOfIt ].
		
	(aBuilder shortcut: #sendersOfIt)
		category: #NautilusCommentShortcuts
		default: $n command
		do: [ :target | target commentTextArea sendersOfIt ].

	(aBuilder shortcut: #printIt) 
		category: #NautilusCommentShortcuts
		default: $p command
		do: [ :target | target commentTextArea printIt ].! !

!AbstractNautilusUI class methodsFor: 'shortcut-old' stamp: 'StephaneDucasse 2/11/2014 10:58'!
buildEditorCommentKeymappingsOldOn: aBuilder

	(aBuilder shortcut: #selectAll) 
		category: #NautilusCommentShortcuts
		default: $a command
		do: [ :target | target commentTextArea handleEdit: [ target commentTextArea selectAll ] ].
		
	(aBuilder shortcut: #copySelection) 
		category: #NautilusCommentShortcuts
		default: $c command
		do: [ :target | target commentTextArea copySelection ].
		
	(aBuilder shortcut: #find) 
		category: #NautilusCommentShortcuts
		default: $f command
		do: [ :target | target commentTextArea find ].
		
	(aBuilder shortcut: #findAgain) 
		category: #NautilusCommentShortcuts
		default:  $g command
		do: [ :target | target commentTextArea findAgain ].
		
	(aBuilder shortcut: #setSearchString)
		category: #NautilusCommentShortcuts
		default: $h command
		do: [ :target | target commentTextArea setSearchString ].
		
	(aBuilder shortcut: #cancel) 
		category: #NautilusCommentShortcuts
		default: $l command
		do: [ :target | target commentTextArea cancelWithoutConfirmation  ].
		
	(aBuilder shortcut: #paste) 
		category: #NautilusCommentShortcuts
		default: $v command
		do: [ :target | target commentTextArea paste ].
		
	(aBuilder shortcut: #cut) 
		category: #NautilusCommentShortcuts
		default: $x command
		do: [ :target | target commentTextArea cut ].
				
	(aBuilder shortcut: #undo) 
		category: #NautilusCommentShortcuts
		default: $z command
		do: [ :target | target commentTextArea undo ].
		
	(aBuilder shortcut: #redo) 
		category: #NautilusCommentShortcuts
		default: $z command shift
		do: [ :target | target commentTextArea redo ].
	
	(aBuilder shortcut: #cursorHome)
		category: #NautilusCommentShortcuts
		default: Character home command
		do: [ :target :morph :event | target commentTextArea cursorHome: event ].
	
	(aBuilder shortcut: #cursorEnd)
		category: #NautilusCommentShortcuts
		default: Character end command
		do: [ :target :morph :event | target commentTextArea cursorEnd: event ].

	(aBuilder shortcut: #browseIt) 
		category: #NautilusCommentShortcuts
		default: $b command
		do: [ :target | target commentTextArea browseIt ].
				
	(aBuilder shortcut: #doIt) 
		category: #NautilusCommentShortcuts
		default: $d command
		do: [ :target | target commentTextArea doIt ].

	(aBuilder shortcut: #inspectIt) 
		category: #NautilusCommentShortcuts
		default: $i command
		do: [ :target | target commentTextArea inspectIt ].
		
	(aBuilder shortcut: #implementorsOfIt) 
		category: #NautilusCommentShortcuts
		default: $m command
		do: [ :target | target commentTextArea implementorsOfIt ].
		
	(aBuilder shortcut: #sendersOfIt)
		category: #NautilusCommentShortcuts
		default: $n command
		do: [ :target | target commentTextArea sendersOfIt ].

	(aBuilder shortcut: #printIt) 
		category: #NautilusCommentShortcuts
		default: $p command
		do: [ :target | target commentTextArea printIt ].! !

!AbstractNautilusUI class methodsFor: 'shortcuts' stamp: 'BenjaminVanRyseghem 6/28/2012 15:16'!
buildRefactoringShortcutsOn: aBuilder
	<keymap>

	(aBuilder shortcut: #generateInitialize)
		category: #NautilusGlobalShortcuts
		default: $h command, $i command 
		do: [ :target | target generateInitialize ]
		description: 'Generate the initialize method'.
		
	(aBuilder shortcut: #forceGenerateInitialize)
		category: #NautilusGlobalShortcuts
		default: $h command, $k command
		do: [ :target | target forceGenerateInitialize ]
		description: 'Regenerate the initialize method'.
		
	(aBuilder shortcut: #createTestForSelectedClass)
		category: #NautilusGlobalShortcuts
		default: $n command, $j command, $c command
		do: [ :target | target enableSingleClassSelection ifTrue: [ target createTestForSelectedClass ]]
		description: 'Generate a test class for the selected class'.
		
	(aBuilder shortcut: #generateTestAndJump)
		category: #NautilusGlobalShortcuts
		default: $h command, $j command
		do: [ :target | target generateTestMethodsAndFocus: true ]
		description: 'Generate test and jump'.
		
	(aBuilder shortcut: #generateTest)
		category: #NautilusGlobalShortcuts
		default: $h command, $j command shift
		do: [ :target | target generateTestMethodsAndFocus: false ]
		description: 'Generate test'.
		
	(aBuilder shortcut: #categorizeAllUncategorized)
		category: #NautilusGlobalShortcuts
		default: $h command, $c command shift
		do: [ :target | target categorizeAllUncategorizedMethods ]
		description: 'Categorize all uncategorized'.! !

!AbstractNautilusUI class methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
icon
	^ Smalltalk ui icons nautilusIcon ! !

!AbstractNautilusUI class methodsFor: 'accessing' stamp: ''!
groupsIconsCache: anObject
	
		GroupsIconsCache := anObject! !

!AbstractNautilusUI class methodsFor: 'menu' stamp: 'NicolaiHess 7/28/2014 21:04'!
groupsMenu: aBuilder
	<contextMenu>
	<nautilusGlobalGroupMenu>
	| target |
	
	target := aBuilder model.
	target selectedGroup ifNil: [ ^ target ].
		
	(aBuilder item: #'Browse scoped')
		keyText: 'b, s' if: Nautilus useOldStyleKeys not;
		action: [ target restrictedBrowseGroups: target packageWidget selectedGroups ];
		order: 1000;
		withSeparatorAfter.
		
	(aBuilder item: #'Run tests')
		keyText: 'j, g' if: Nautilus useOldStyleKeys not;
		keyText: 't' if: Nautilus useOldStyleKeys;
		action: [ target runTestsOfGroups: target packageWidget selectedGroups notifying: true ];
		order: 1100.
				
	(aBuilder item: #'Merge groups')
		action: [target mergeGroups];
		enabledBlock: [ target packageWidget selectedGroups size > 1];
		order: 1200.

	target selectedGroup
		ifNotNil: [
			target selectedGroup isReadOnly
				ifFalse: [
					(aBuilder item: #'Rename...')
						keyText: 'r, g' if: Nautilus useOldStyleKeys not;
						keyText: 'r' if: Nautilus useOldStyleKeys;
						action: [ target renameGroup ];
						enabledBlock: [ target packageWidget selectedGroups size <= 1];
						order: 1300 ].
			target selectedGroup removable
				ifTrue: [
					(aBuilder item: #'Remove groups')
						keyText: 'x, g' if: Nautilus useOldStyleKeys not;
						keyText: 'x' if: Nautilus useOldStyleKeys;
						icon: (Smalltalk ui icons iconNamed: #removeIcon);
						action: [target removeGroups];
						order: 1400 ] ]! !

!AbstractNautilusUI class methodsFor: 'accessing' stamp: ''!
packagesIconsCache: anObject
	
		PackagesIconsCache := anObject! !

!AbstractNautilusUI class methodsFor: 'shortcuts' stamp: 'CamilloBruni 10/4/2012 10:39'!
buildGotoNavigationShortcutsOn: aBuilder
	<keymap>

	(aBuilder shortcut: #jumpToClass)
		category: #NautilusGlobalShortcuts
		default: $g command , $c command 
		do: [ :target | target giveFocusToClass ]
		description: 'Jump to the selected class'.
			
	(aBuilder shortcut: #jumpToPackage)
		category: #NautilusGlobalShortcuts
		default: $g command, $p command 
		do: [ :target | target giveFocusToPackage ]
		description: 'Jump to the selected package'.

	(aBuilder shortcut: #jumpToProtocol)
		category: #NautilusGlobalShortcuts
		default: $g command , $t command 
		do: [ :target | target giveFocusToProtocol ]
		description: 'Jump to the selected protocol'.
		
	(aBuilder shortcut: #jumpToMethod)
		category: #NautilusGlobalShortcuts
		default: $g command , $m command  
		do: [ :target | target giveFocusToMethod ]
		description: 'Jump to the selected method'.
		
	(aBuilder shortcut: #jumpToSourceCode)
		category: #NautilusGlobalShortcuts
		default: $g command , $s command  
		do: [ :target | target giveFocusToSourceCode ]
		description: 'Jump to the selected method'.
		
	(aBuilder shortcut: #jumpToTestClass)
		category: #NautilusGlobalShortcuts
		default: $g command , $j command , $c command
		do: [ :target | target createTestForSelectedClass ]
		description: 'Jump to test class'.! !

!AbstractNautilusUI class methodsFor: 'class initialization' stamp: 'EstebanLorenzano 10/17/2013 13:55'!
initialize
	" self initialize "

	ClassesIconsCache := WeakIdentityKeyDictionary new.
	GroupsIconsCache := WeakIdentityKeyDictionary new.
	PackagesIconsCache := WeakIdentityKeyDictionary new.
	
	NextFocusKey := Character arrowRight.
	PreviousFocusKey := Character arrowLeft.
	
	self registerSystemAnnouncements.! !

!AbstractNautilusUI class methodsFor: 'menu' stamp: 'EstebanLorenzano 2/6/2013 14:48'!
groupsFixMenu: aBuilder
	<contextMenu>
	<nautilusGlobalGroupFixMenu>
	| target |
	target := aBuilder model.
	(aBuilder item: #'Find Class...')
		keyText: 'f, c' if: Nautilus useOldStyleKeys not;
		keyText: 'f' if: Nautilus useOldStyleKeys;
		action: [target findClass];
		order: 0;
		help: 'Search for a class by name'.

	(aBuilder item: #'New group...')
		keyText: 'n, g' if: Nautilus useOldStyleKeys not;
		keyText: 'n' if: Nautilus useOldStyleKeys;
		action: [target addNewGroup];
		order: 100;
		withSeparatorAfter.
	
	(aBuilder item: #'Browse full')
		keyText: 'b, f' if: Nautilus useOldStyleKeys not;
		keyText: 'b' if: Nautilus useOldStyleKeys;
		action: [target fullBrowse];
		order: 999.! !

!AbstractNautilusUI class methodsFor: 'shortcuts' stamp: 'BenjaminVanRyseghem 6/28/2012 14:54'!
buildRemoveShortcutsOn: aBuilder
	<keymap>

	(aBuilder shortcut: #removeClass)
		category: #NautilusGlobalShortcuts
		default: $x command  ,$c command 
		do: [ :target | target removeClasses ]
		description: 'Remove the selected classes'.
			
	(aBuilder shortcut: #removePackage)
		category: #NautilusGlobalShortcuts
		default: $x command  , $p command 
		do: [ :target | target removePackages ]
		description: 'Remove the selected packages'.

	(aBuilder shortcut: #removeProtocol)
		category: #NautilusGlobalShortcuts
		default: $x command , $t command 
		do: [ :target | target removeCategories ]
		description: 'Remove the selected protocols'.
		
	(aBuilder shortcut: #removeMethod)
		category: #NautilusGlobalShortcuts
		default: $x command , $m command 
		do: [ :target | target removeMethods ]
		description: 'Remove the selected methods'.
		
	(aBuilder shortcut: #removeGroups)
		category: #NautilusGlobalShortcuts
		default: $x command , $g command 
		do: [ :target | target removeGroups ]
		description: 'Remove the selected groups'.! !

!AbstractNautilusUI class methodsFor: 'shortcuts' stamp: 'SebastianTleye 8/30/2013 14:13'!
buildRenameShortcutsOn: aBuilder
	<keymap>

	(aBuilder shortcut: #renameClass)
		category: #NautilusGlobalShortcuts
		default: $r command  ,$c command 
		do: [ :target | target renameClass ]
		description: 'Rename the selected class'.
			
	(aBuilder shortcut: #renamePackage)
		category: #NautilusGlobalShortcuts
		default: $r command  , $p command 
		do: [ :target | target renamePackage ]
		description: 'Rename the selected package'.

	(aBuilder shortcut: #renameProtocol)
		category: #NautilusGlobalShortcuts
		default: $r command , $t command 
		do: [ :target | target renameCategory ]
		description: 'Rename the selected protocol'.
		
	(aBuilder shortcut: #renameGroup)
		category: #NautilusGlobalShortcuts
		default: $r command , $g command 
		do: [ :target | target renameGroup ]
		description: 'Rename the selected group'.! !

!AbstractNautilusUI class methodsFor: 'menu' stamp: 'EstebanLorenzano 2/6/2013 14:39'!
packagesFixMenu: aBuilder
	<contextMenu>
	<nautilusGlobalPackageFixMenu>
	| target |
	target := aBuilder model.
	
	(aBuilder item: #'Find Class...')
		keyText: 'f, c' if: Nautilus useOldStyleKeys not;
		keyText: 'f' if: Nautilus useOldStyleKeys;
		action: [target findClass];
		order: 0;
		help: 'Search for a class by name'.
		
	(aBuilder item: #'Find Package...')
		keyText: 'f, p' if: Nautilus useOldStyleKeys not;
		keyText: 'F' if: Nautilus useOldStyleKeys;
		action: [ target findPackage ];
		order: 100;
		help: 'Search for a package by name';
		withSeparatorAfter.
		
	(aBuilder item: #'Add package...')
		keyText: 'n, p' if: Nautilus useOldStyleKeys not;
		keyText: 'n' if: Nautilus useOldStyleKeys;
		action: [target addPackage];
		order: 200;
		help: 'Add a package';
		withSeparatorAfter.
		
	(aBuilder item: #'Browse full')
		keyText: 'b, f' if: Nautilus useOldStyleKeys not;
		keyText: 'b' if: Nautilus useOldStyleKeys;
		action: [target fullBrowse];
		order: 999;
		help: 'Open the same browser'.! !

!AbstractNautilusUI class methodsFor: 'instance creation' stamp: ''!
on: aNautilus

	^ self new model: aNautilus! !

!AbstractNautilusUI class methodsFor: 'menu' stamp: 'SebastianTleye 8/30/2013 10:43'!
analyzeSubMenu: aBuilder
	<contextMenu>
	<nautilusGlobalClassMenu>
	| target |
	
	target := aBuilder model.
	target selectedClass ifNil: [^target].
	target selectedClass buildAnalyzeSubMenu: aBuilder.! !

!AbstractNautilusUI class methodsFor: 'shortcuts' stamp: 'SebastianTleue 8/28/2013 10:53'!
buildBrowseShortcutsOn: aBuilder
	<keymap>

	(aBuilder shortcut: #browseSenders)
		category: #NautilusGlobalShortcuts
		default: $b command , $n command 
		do: [:target | target browseSendersOfMessages ]
		description: 'Browse senders of the selected method'.
		
	(aBuilder shortcut: #browseClassRefs)
		category: #NautilusGlobalShortcuts
		default: $b command, $n command shift
		do: [ :target | target browseClassRefs ]
		description: 'Browse class references'.

	(aBuilder shortcut: #browseImplementors)
		category: #NautilusGlobalShortcuts
		default: $b command , $m command 
		do: [:target | target browseMessages ]
		description: 'Browse implementors of the selected method'.
		
	(aBuilder shortcut: #browseRestricted)
		category: #NautilusGlobalShortcuts
		default: $b command , $s command
		do: [:target | target restrictedBrowse ]
		description: 'Open a restricted browser'.
	
	(aBuilder shortcut: #browseRestrictedClass)
		category: #NautilusGlobalShortcuts
		default: $b command , $r command , $c command
		do: [:target | target restrictedBrowseClass ]
		description: 'Open a restricted browser on the selected class'.
	
	(aBuilder shortcut: #browseSuperclass)
		category: #NautilusGlobalShortcuts
		default: $b command , $s command shift
		do: [:target | target browseSuperclass ]
		description: 'Open a browser on the superclass of the selected class'.
		
	(aBuilder shortcut: #browseRestrictedPackage)
		category: #NautilusGlobalShortcuts
		default: $b command , $r command , $p command
		do: [:target | target restrictedBrowsePackage ]
		description: 'Open a restricted browser on the selected package'.
		
	(aBuilder shortcut: #browseRestrictedRegex)
		category: #NautilusGlobalShortcuts
		default: $b command , $r command , $r command
		do: [:target | target restrictedBrowsePackageRegex ]
		description: 'Open a restricted browser on a package regex'.
		
	(aBuilder shortcut: #browseRestrictedSuperclasses)
		category: #NautilusGlobalShortcuts
		default: $b command , $r command , $S shift command
		do: [:target | target restrictedBrowseSuperclasses ]
		description: 'Open a restricted browser the superclasses'.
		
	(aBuilder shortcut: #browseRestrictedSubclasses)
		category: #NautilusGlobalShortcuts
		default: $b command , $r command , $s command
		do: [:target | target restrictedBrowseSubclasses ]
		description: 'Open a restricted browser the subclasses'.
	
	(aBuilder shortcut: #browseInheritance)
		category: #NautilusGlobalShortcuts
		default: $b command , $i command 
		do: [:target | target methodHierarchy ]
		description: 'Open a restricted browser'.
		
	(aBuilder shortcut: #browseFull)
		category: #NautilusGlobalShortcuts
		default: $b command , $f command 
		do: [:target | target fullBrowse ]
		description: 'Open the same browser'.		
	
	(aBuilder shortcut: #browseVersion)
		category: #NautilusGlobalShortcuts
		default: $b command , $v command 
		do: [:target | target browseVersions ]
		description: 'Browse senders of the selected method'.
! !

!AbstractNautilusUI class methodsFor: 'menu' stamp: 'vincentBlondeau 12/12/2014 13:59'!
packagesMenu: aBuilder
	<contextMenu>
	<nautilusGlobalPackageMenu>
	| package target |
	target := aBuilder model.

	(package := target selectedPackage) ifNil: [ ^ target ].
	
	(aBuilder item: #'Browse scoped')
		keyText: 'b, s' if: Nautilus useOldStyleKeys not;
		action: [ target restrictedBrowsePackage ];
		order: 1000;
		help: 'Open a browser on a restricted view';
		withSeparatorAfter.
						
	(aBuilder item: #'Rename...')
		keyText: 'r, p' if: Nautilus useOldStyleKeys not;
		keyText: 'r' if: Nautilus useOldStyleKeys;
		action: [target renamePackage];
		order: 1100;
		help: 'Rename a package';
		enabledBlock: [ target selectedPackages size < 2 ].
		
	(aBuilder item: #'Remove...')
		keyText: 'x, p' if: Nautilus useOldStyleKeys not;
		keyText: 'x' if: Nautilus useOldStyleKeys;
		action: [target removePackages ];
		order: 1200;
		help: 'Remove a package';
		icon: (Smalltalk ui icons iconNamed: #removeIcon).
		
	(aBuilder item: #'Run tests...')
		keyText: 'j, p' if: Nautilus useOldStyleKeys not;
		keyText: 't' if: Nautilus useOldStyleKeys;
		action: [target runPackagesTestsNotifying: true ];
		enabled: (package classes anySatisfy: [:e | e isTestCase ]);
		order: 1250;
		help: 'Run tests';
		withSeparatorAfter.
	
	(aBuilder item: #'Promote as package')
		action: [ target promoteSelectedPackageTagAsPackage ];
		enabled: package isPackageTag;
		order: 1260;
		help: 'Promote this package tag as one package'.
		
	(aBuilder item: #'Demote to package with tag')
		action: [ target demoteSelectedPackageAsPackageWithTag  ];
		enabled: (package isPackageTag not and: [ package name includes: $- ]);
		order: 1261;
		help: 'Downgrade this package as one package with a tag';
		withSeparatorAfter.
		
		
	(aBuilder item: #'File Out')
		action: [target fileOutPackage];
		order: 1300;
		help: 'File out a package';
		withSeparatorAfter.
	
	target selectedPackages size > 1
		ifTrue: [
			(aBuilder item: #'Add as Groups & Browse')
				keyText: 'n, g' if: Nautilus useOldStyleKeys not;
				action: [ target addPackagesAsGroupsAndBrowse ];
				order: 1400;
				help: 'Create a group based on the current package and browse it'.

			(aBuilder item: #'Add as Groups')
				keyText: 'n, G' if: Nautilus useOldStyleKeys not;
				action: [ target addPackagesAsGroups ];
				order: 1600;
				help: 'Create a group based on the current package'.

			(aBuilder item: #'Add as Group')
				action: [target addPackageAsGroup];
				order: 1700;
				help: 'Create a group based on the current package'.	
					]
		ifFalse: [
			(aBuilder item: #'Add as Group & Browse')
				keyText: 'n, g' if: Nautilus useOldStyleKeys not;
				keyText: 'G' if: Nautilus useOldStyleKeys;
				action: [ target addPackageAsGroupAndBrowse ];
				order: 1500;
				help: 'Create a group based on the current package and browse it'.
				
			(aBuilder item: #'Add as Group')
				keyText: 'n, G' if: Nautilus useOldStyleKeys not;
				action: [target addPackageAsGroup];
				order: 1700;
				help: 'Create a group based on the current package' ].			
				
	(aBuilder item: #'Add Matching Packages as Groups and Browse')
		keyText: 'n, m' if: Nautilus useOldStyleKeys not;
		keyText: 'M' if: Nautilus useOldStyleKeys;
		action: [ target addMatchingPackagesInGroupsAndBrowse ];
		order: 1800.
	
	(aBuilder item: #'Add in Group...')
		keyText: 'n, e, p' if: Nautilus useOldStyleKeys not;
		action: [target addPackagesInGroup];
		order: 1900;
		help: 'Add current package in a group';
		withSeparatorAfter.! !

!AbstractNautilusUI class methodsFor: 'menu' stamp: 'MarcusDenker 2/15/2013 14:03'!
sourceCodeMenu: aBuilder
	<contextMenu>
	<nautilusGlobalSourceCodeMenu>
	
	| donorMenu items |
	items := OrderedCollection new.
	donorMenu := SmalltalkEditor yellowButtonMenu.
	donorMenu submorphs doWithIndex: [:each :index |
		(each isKindOf: MenuLineMorph)
			ifTrue: [ items last withSeparatorAfter ]
			ifFalse: [
				items add: ((aBuilder item: each contents asSymbol)
								keyText: each keyText;
								selector: each selector;
								target: each target;
								arguments: each arguments;
								order: (index*100)).
				each icon ifNotNil: [:ic | items last icon: ic ]]].
	(items last: 2) doWithIndex: [:e :i | e order: (9998 + i) ].
	
	(aBuilder item: #'Lock this text area')
			selector: #lockTextArea;
			target: aBuilder model;
			order: 0.! !

!AbstractNautilusUI class methodsFor: 'shortcuts' stamp: 'SebastianTleue 8/28/2013 11:40'!
buildAddGroupsShortcutsOn: aBuilder
	<keymap>

	(aBuilder shortcut: #newGroupAndBrowseForPackage)
		category: #NautilusGlobalShortcuts
		default: $n command  ,$g command 
		do: [ :target | target addPackagesAsGroupsAndBrowse ]
		description: 'Create a new group and browse'.
			
	(aBuilder shortcut: #newGroupForPackage)
		category: #NautilusGlobalShortcuts
		default: $n command  , $g shift command 
		do: [ :target | target addPackagesAsGroups ]
		description: 'Create a new group'.

	(aBuilder shortcut: #addInGroupPackage)
		category: #NautilusGlobalShortcuts
		default: $n command , $e command, $p command 
		do: [ :target | target addPackagesInGroup ]
		description: 'Add the selected packages in a group'.
		
	(aBuilder shortcut: #addMethodsInGroup)
		category: #NautilusGlobalShortcuts
		default: $n command , $e command, $m command 
		do: [ :target | target addMethodsInGroup ]
		description: 'Add the selected methods in a group'.
	
	"This shortcut was removed because this shortcut is the same for packages"	
	"(aBuilder shortcut: #addProtocolsInGroup)
		category: #NautilusGlobalShortcuts
		default: $n command , $e command, $p command 
		do: [ :target | target addProtocolsInGroup ]
		description: 'Add the selected protocols in a group'."
		
	(aBuilder shortcut: #addInGroupClass)
		category: #NautilusGlobalShortcuts
		default: $n command , $e command, $c command 
		do: [ :target | target addClassesInGroup ]
		description: 'Add the selected classes in a group'.	
		
	(aBuilder shortcut: #addMatchingAndBrowse)
		category: #NautilusGlobalShortcuts
		default: $n command , $m command 
		do: [ :target | target addMatchingPackagesInGroupsAndBrowse ]
		description: 'Add packages matching the selected package as groups and browse'.
		
	(aBuilder shortcut: #addInGroupMethod)
		category: #NautilusGlobalShortcuts
		default: $n command , $m command shift
		do: [ :target | target addMatchingPackagesInGroups ]
		description: 'Add packages matching the selected package as groups'.! !

!AbstractNautilusUI class methodsFor: 'shortcuts' stamp: 'ClementBera 12/12/2014 11:37'!
buildExtraShortcutsOn: aBuilder
	<keymap>

	(aBuilder shortcut: #openBrowser)
		category: #NautilusGlobalShortcuts
		default: $o command, $o command
		do: [:target| target fullBrowse ]
		description: 'Open a new browser'.
		
	
	(aBuilder shortcut: #openBrowserOnSubclass)
		category: #NautilusGlobalShortcuts
		default: $o command, $s command
		do: [:target| target openSubclass ]
		description: 'Open a new browser on a subclass'.
		
		
	(aBuilder shortcut: #openBrowserOnSuperclass)
		category: #NautilusGlobalShortcuts
		default: $o command, $s command shift
		do: [:target| target openSuperclass ]
		description: 'Open a new browser on a superclass'.
		
	(aBuilder shortcut: #openBrowserOnClass)
		category: #NautilusGlobalShortcuts
		default: $o command, $c command
		do: [:target| target openClass ]
		description: 'Open a new browser on a class'.
		
	(aBuilder shortcut: #toggleBytecodes)
		category: #NautilusGlobalShortcuts
		default: $b command, $b command
		do: [ :target | target toggleBytecodes ] 
		description: 'ToggleBytecodes'.
	! !

!AbstractNautilusUI class methodsFor: 'shortcuts' stamp: 'BenjaminVanRyseghem 6/24/2012 19:06'!
buildCopyShortcutsOn: aBuilder
	<keymap>

	(aBuilder shortcut: #copyClass)
		category: #NautilusGlobalShortcuts
		default: $c command , $c command 
		do: [ :target | target copyClasses ]
		description: 'Copy the selected classes'.! !

!AbstractNautilusUI class methodsFor: 'shortcuts' stamp: 'StephaneDucasse 8/2/2014 09:03'!
buildRecategorizeShortcutsOn: aBuilder
	<keymap>

	(aBuilder shortcut: #recategorizeMethod)
		category: #NautilusGlobalShortcuts
		default: $m command , $m command 
		do: [ :target | target categorizeMethod ]
		description: 'Categorize the selected method'.
		
	(aBuilder shortcut: #recategorizeClass)
		category: #NautilusGlobalShortcuts
		default: $m command , $c command 
		do: [ :target | target moveInPackage ]
		description: 'Categorize the selected class'.! !

!AbstractNautilusUI class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/25/2012 11:08'!
previousFocusKey

	^ PreviousFocusKey! !

!AbstractNautilusUI class methodsFor: 'menu pragmas' stamp: 'EstebanLorenzano 10/15/2013 18:36'!
packageFixPragma
	^ 'nautilusGlobalPackageFixMenu'! !

!AbstractNautilusUI class methodsFor: 'menu' stamp: 'StephaneDucasse 3/15/2015 17:25'!
shiftedSourceCodeMenu: aBuilder
	<contextMenu>
	<nautilusGlobalSourceCodeMenu>
	| donorMenu items |
	
	items := OrderedCollection new.
	donorMenu := SmalltalkEditor shiftedYellowButtonMenu.
	donorMenu submorphs doWithIndex: [:each :index |
		(each isKindOf: MenuLineMorph)
			ifTrue: [ items last withSeparatorAfter ]
			ifFalse: [
				items add: ((aBuilder item: each contents asSymbol)
								keyText: each keyText;
								selector: each selector;
								target: each target;
								parent: #'Code search...';
								arguments: each arguments;
								order: (index*100)).
				each icon ifNotNil: [:ic | items last icon: ic ]]].
	(items last: 2) doWithIndex: [:e :i | e order: (9998 + i) ]! !

!AbstractNautilusUI class methodsFor: 'shortcut-old' stamp: 'BenjaminVanRyseghem 4/6/2012 16:43'!
buildClassShortcutsOn: aBuilder
	<keymap>

	(aBuilder shortcut: #fullBrowse)
		category: #NautilusClassShortcuts
		default: $b command
		do: [ :target | target fullBrowse ]
		description: 'Open a new browser on the selection'.
		
	(aBuilder shortcut: #restrictedBrowseClass)
		category: #NautilusClassShortcuts
		default: $b command shift
		do: [ :target | target restrictedBrowseClass ]
		description: 'Open a restricted browser'.

	(aBuilder shortcut: #copyClasses)
		category: #NautilusClassShortcuts
		default: $c command
		do: [ :target | target copyClasses ]
		description: 'Copy the selected classes'.
	
	(aBuilder shortcut: #addClassesInGroup)
		category: #NautilusClassShortcuts
		default: $e command
		do: [ :target | target addClassesInGroup ]
		description: 'Add the selected classes in a group'.
	
	(aBuilder shortcut: #findMethod)
		category: #NautilusClassShortcuts
		default: $f command
		do: [ :target | target findMethod ]
		description: 'Find a method'.
		
	(aBuilder shortcut: #findClass)
		category: #NautilusClassShortcuts
		default: $f command shift
		do: [ :target | target findClass ]
		description: 'Find a class'.
		
	(aBuilder shortcut: #generateInitialize)
		category: #NautilusClassShortcuts
		default: $i command shift
		do: [ :target | target generateInitialize ]
		description: 'Generate the initialize method'.
		
	(aBuilder shortcut: #createTestForSelectedClass)
		category: #NautilusClassShortcuts
		default: $j command
		do: [ :target | target enableSingleClassSelection ifTrue: [ target createTestForSelectedClass ]]
		description: 'Generate a test class for the selected class'.
		
	(aBuilder shortcut: #forceGenerateInitialize)
		category: #NautilusClassShortcuts
		default: $k command shift
		do: [ :target | target forceGenerateInitialize ]
		description: 'Regenerate the initialize method'.
		
	(aBuilder shortcut: #browseClassRefs)
		category: #NautilusClassShortcuts
		default: $n command shift
		do: [ :target | target browseClassRefs ]
		description: 'Browse class references'.
	
	(aBuilder shortcut: #addClass)
		category: #NautilusClassShortcuts
		default: $n command
		do: [ :target | target addClass ]
		description: 'Add a class'.
		
	(aBuilder shortcut: #renameClass)
		category: #NautilusClassShortcuts
		default: $r command
		do: [ :target | target enableSingleClassSelection ifTrue: [ target renameClass ]]
		description: 'Rename the selected class'.
		
	(aBuilder shortcut: #runClassTests)
		category: #NautilusClassShortcuts
		default: $t command
		do: [ :target | target runClassTests ]
		description: 'Run the tests for the selected class'.
		
	(aBuilder shortcut: #removeClasses)
		category: #NautilusClassShortcuts
		default: $x command
		do: [ :target | target removeClasses ]
		description: 'Remove the selected classes'.
		
	(aBuilder shortcut: #removeClassesFromGroup)
		category: #NautilusClassShortcuts
		default: $x command shift
		do: [ :target |
			(target showGroups and: [ target selectedGroup isReadOnly not ])
				ifTrue: [ target removeClassFromGroup ]]
		description: 'Remove the selected classes from the selected group'! !

!AbstractNautilusUI class methodsFor: 'shortcut-old' stamp: 'EstebanLorenzano 2/6/2013 17:58'!
buildPackageShortcutsOn: aBuilder
	<keymap>

	(aBuilder shortcut: #fullBrowse)
		category: #NautilusPackageShortcuts
		default: $b command
		do: [ :target | target fullBrowse ]
		description: 'Open a new browser on the selection'.
		
	(aBuilder shortcut: #addPackagesInGroup)
		category: #NautilusPackageShortcuts
		default: $e command
		do: [ :target | target addPackagesInGroup ]
		description: 'Add the selected package in a group'.
		
	(aBuilder shortcut: #findClass)
		category: #NautilusPackageShortcuts
		default: $f command
		do: [ :target | target findClass ]
		description: 'Find a class'.
		
	(aBuilder shortcut: #findPackage)
		category: #NautilusPackageShortcuts
		default: $f command shift
		do: [ :target | target findPackage ]
		description: 'Find a package'.

	(aBuilder shortcut: #addPackagesAsGroupsAndBrowse)
		category: #NautilusPackageShortcuts
		default: $g command
		do: [ :target | target addPackagesAsGroupsAndBrowse ]
		description: 'Add the selected packages as groups and browse'.
	
	(aBuilder shortcut: #addPackagesAsGroups)
		category: #NautilusPackageShortcuts
		default: $g command shift
		do: [ :target | target addPackageAsGroupAndBrowse ]
		description: 'Add the selected packages as groups'.
	
	(aBuilder shortcut: #addMatchingPackagesInGroupsAndBrowse)
		category: #NautilusPackageShortcuts
		default: $m command shift
		do: [ :target | target addMatchingPackagesInGroupsAndBrowse ]
		description: 'Add packages matching the selected package as groups and browse'.
	
	(aBuilder shortcut: #addMatchingPackagesInGroups)
		category: #NautilusPackageShortcuts
		default: $m command
		do: [ :target | target addMatchingPackagesInGroups ]
		description: 'Add packages matching the selected package as groups'.
		
	(aBuilder shortcut: #addPackage)
		category: #NautilusPackageShortcuts
		default: $n command 
		do: [ :target | target addPackage ]
		description: 'Add a new package'.
	
	(aBuilder shortcut: #renamePackage)
		category: #NautilusPackageShortcuts
		default: $r command 
		do: [ :target | target enableSingleMenuItems ifTrue: [ target renamePackage ]]
		description: 'Rename the selected package'.	
	
	(aBuilder shortcut: #runPackagesTests)
		category: #NautilusPackageShortcuts
		default: $t command 
		do: [ :target | target runPackagesTestsNotifying: true ]
		description: 'Run the tests for the selected packages'.
	
	(aBuilder shortcut: #removePackages)
		category: #NautilusPackageShortcuts
		default: $x command 
		do: [ :target | target removePackages ]
		description: 'Remove the selected packages'.! !

!AbstractNautilusUI class methodsFor: 'shortcuts' stamp: 'CamilloBruni 9/14/2012 01:31'!
buildFindShortcutsOn: aBuilder
<keymap>

	(aBuilder shortcut: #findClass)
		category: #NautilusGlobalShortcuts
		default: $f command , $c command 
		do: [ :target | target findClass ]
		description: 'Find a class'.
	
	(aBuilder shortcut: #findClassInHierarchy)
		category: #NautilusGlobalShortcuts
		default: $f command , $h command 
		do: [ :target | target findClassInHierarchy ]
		description: 'Find a class in the hierarchy'.
		
	(aBuilder shortcut: #findSuperclass)
		category: #NautilusGlobalShortcuts
		default: $f command , $S shift command 
		do: [ :target | target findSuperclass]
		description: 'Find a superclass'.
		
	(aBuilder shortcut: #findSubclass)
		category: #NautilusGlobalShortcuts
		default: $f command , $s command 
		do: [ :target | target findSubclass]
		description: 'Find a subclass'.
		
	(aBuilder shortcut: #findPackage)
		category: #NautilusGlobalShortcuts
		default: $f command  , $p command 
		do: [ :target | target findPackage ]
		description: 'Find a package'.
		
	(aBuilder shortcut: #findProtocol)
		category: #NautilusGlobalShortcuts
		default: $f command  , $t command 
		do: [ :target | target findProtocol ]
		description: 'Find a protocol'.
		
	(aBuilder shortcut: #findMethod)
		category: #NautilusGlobalShortcuts
		default: $f command , $m command 
		do: [ :target | target findMethod ]
		description: 'Find a method'.
	
	(aBuilder shortcut: #findRespondingMethod)
		category: #NautilusGlobalShortcuts
		default: $f command, $M shift command 
		do: [ :target | target findAllMethod ]
		description: 'Find methods instances of this class may respond to'.! !

!AbstractNautilusUI class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/24/2012 17:55'!
nextFocusKey

	^ NextFocusKey! !

!AbstractNautilusUI class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/18/2013 17:40'!
classesIconsCache

	^ ClassesIconsCache! !

!AbstractNautilusUI class methodsFor: 'shortcuts' stamp: 'NicolaiHess 7/27/2014 21:01'!
buildRunTestKeymappingsOn: aBuilder
	<keymap>

	(aBuilder shortcut: #runTestForClasses)
		category: #NautilusGlobalShortcuts
		default: $j command  ,$c command 
		do: [ :target | target runClassTests ]
		description: 'runTestFor the selected classes'.
			
	(aBuilder shortcut: #runTestForPackages)
		category: #NautilusGlobalShortcuts
		default: $j command  , $p command 
		do: [ :target | target runPackagesTestsNotifying: true ]
		description: 'runTestFor the selected packages'.
		
	(aBuilder shortcut: #runTestForGroups)
		category: #NautilusGlobalShortcuts
		default: $j command  , $g command 
		do: [ :target | target runTestsOfGroups: target packageWidget selectedGroups notifying: true ]
		description: 'runTestFor the selected groups'.
		
	(aBuilder shortcut: #runTestForMethods)
		category: #NautilusGlobalShortcuts
		default: $j command , $m command 
		do: [ :target |  target runTestForMethods: target selectedMethods notifying: true ]
		description: 'runTestFor the selected methods'.! !

!AbstractNautilusUI class methodsFor: 'shortcut-old' stamp: 'EstebanLorenzano 2/6/2013 15:19'!
buildSourceCodeShortcutsOn: aBuilder
	<keymap>	

	self buildEditorKeymappingsOn: aBuilder.
	(aBuilder shortcut: #runTest)
		category: #NautilusSourceCodeShortcuts
		default: $j command, $m command
		do: [:target |
				(target selectedMethod isTestMethod and: [ target sourceTextArea hasUnacceptedEdits not ])
					ifTrue: [ target runTestForAMethod: target selectedMethod notifying: true
				]]
		description: 'Run the current test method'.
		
	"This is not working anyway"
	"(aBuilder shortcut: #findClass)
		category: #NautilusSourceCodeShortcuts
		default: $f command, $c command 
		do: [:target | target findClass ]
		description: 'Find class'."! !

!AbstractNautilusUI class methodsFor: 'shortcuts' stamp: 'BenjaminVanRyseghem 6/28/2012 14:52'!
buildAddShortcutsOn: aBuilder
	<keymap>

	(aBuilder shortcut: #newClass)
		category: #NautilusGlobalShortcuts
		default: $n command  ,$c command 
		do: [ :target | target addClass ]
		description: 'Create a new class'.
			
	(aBuilder shortcut: #newPackage)
		category: #NautilusGlobalShortcuts
		default: $n command  , $p command 
		do: [ :target | target addPackage ]
		description: 'Create a new package'.

	(aBuilder shortcut: #newProtocol)
		category: #NautilusGlobalShortcuts
		default: $n command , $t command 
		do: [ :target | target addCategory ]
		description: 'Create a new protocol'.
		
	(aBuilder shortcut: #newGroup)
		category: #NautilusGlobalShortcuts
		default: $n command , $g command 
		do: [ :target | target addNewGroup ]
		description: 'Create a new group'.
		
"	(aBuilder shortcut: #newMethod)
		category: #NautilusGlobalShortcuts
		default: $n command , $m command 
		do: [ :target | target addMethod ]
		description: 'Create a new method'."! !

!AbstractNautilusUI class methodsFor: 'menu' stamp: 'vincentBlondeau 12/12/2014 13:59'!
classesMenu: aBuilder
	<contextMenu>
	<nautilusGlobalClassMenu>
	| target |

	target := aBuilder model.
	target selectedClass ifNil: [^target].

	(aBuilder item: #'Rename...')
		keyText: 'r,c' if: Nautilus useOldStyleKeys not;
		keyText: 'r' if: Nautilus useOldStyleKeys;
		action: [ target renameClass ];
		enabledBlock: [ target selectedClasses size <= 1 ];
		order: -99;
		withSeparatorAfter.	
		
	(aBuilder item: #'Browse scoped')
		keyText: 'b, s' if: Nautilus useOldStyleKeys not;
		keyText: 'B' if: Nautilus useOldStyleKeys;
		action: [target restrictedBrowseClass];
		order: 1000;
		help: 'Open a browser on a restricted view'.

	(target selectedClass isTrait) 
		ifTrue: [ (aBuilder item: #'Browse users')
				action:  [ target restrictedBrowseTraitUsers ];
				order: 1050].

	(aBuilder item: #'Add in Group...')
		keyText: 'n, e, c' if: Nautilus useOldStyleKeys not;
		keyText: 'e' if: Nautilus useOldStyleKeys;
		action: [ target addClassesInGroup ];
		order: 1100;
		withSeparatorAfter.
	
	(target selectedClasses allSatisfy: [:each | each isTestCase and:[ each isAbstract not] ])
		ifTrue:[	
			(aBuilder item:#'Run tests')
				keyText: 'j, c' if: Nautilus useOldStyleKeys not;
				keyText: 't' if: Nautilus useOldStyleKeys;
				action: [ target runClassTests ];
				order: 1200].
						
	(aBuilder item: #Analyze)
		enabledBlock: [ target selectedClasses size <= 1 ];
		order: 0;
		withSeparatorAfter.

	(aBuilder item: #'Jump to test class')
		keyText: 'g, j' if: Nautilus useOldStyleKeys not;
		keyText: 'j' if: Nautilus useOldStyleKeys;
		action: [ target createTestForSelectedClass ];
		enabledBlock: [ target selectedClasses size = 1 ];
		order: 300;
		withSeparatorAfter.
		
		
	(aBuilder item: #'Move to package...')
		keyText: 'm, c' if: Nautilus useOldStyleKeys not;
		action: [ target moveInPackage ];
		order: 1400.	
			
	(aBuilder item: #'Copy...')
		keyText: 'c, c' if: Nautilus useOldStyleKeys not;
		keyText: 'c' if: Nautilus useOldStyleKeys;
		action: [ target copyClasses ];
		order: 1600.	
			
	(aBuilder item: #'Remove...')
		keyText: 'x, c' if: Nautilus useOldStyleKeys not;
		keyText: 'x' if: Nautilus useOldStyleKeys;
		action: [ target removeClassWithRefactoringEngine: target selectedClasses asOrderedCollection ];
		icon: (Smalltalk ui icons iconNamed: #removeIcon);
		order: 1700;
		withSeparatorAfter.
	
	(aBuilder item: #'Inspect Methods')
		action: [ target inspectMethods ];
		withSeparatorAfter;
		order: 1750.	
			
	(aBuilder item: #'File Out')
		action: [ target fileOutClass ];
		withSeparatorAfter;
		order: 1800.	

	target showGroups
		ifTrue: [
			target selectedGroup isReadOnly 
				ifFalse: [
					(aBuilder item: #'Remove from Group')
						keyText: 'X' if: Nautilus useOldStyleKeys not;
						action: [ target removeClassFromGroup ];
						order: 1900] ].! !

!AbstractNautilusUI class methodsFor: 'shortcuts' stamp: 'StephaneDucasse 2/11/2014 10:59'!
buildEditorKeymappingsOn: aBuilder

	(aBuilder shortcut: #selectAll) 
		category: #NautilusSourceCodeShortcuts
		default: $a command
		do: [ :target | target sourceTextArea handleEdit: [ target sourceTextArea selectAll ] ].
		
	(aBuilder shortcut: #copySelection) 
		category: #NautilusSourceCodeShortcuts
		default: $c command
		do: [ :target | target sourceTextArea copySelection ].
		
	(aBuilder shortcut: #find) 
		category: #NautilusSourceCodeShortcuts
		default: $f command, $f command
		do: [ :target | target sourceTextArea find ].
		
	(aBuilder shortcut: #findAgain) 
		category: #NautilusSourceCodeShortcuts
		default:  $f command, $g command
		do: [ :target | target sourceTextArea findAgain ].
		
	(aBuilder shortcut: #setSearchString)
		category: #NautilusSourceCodeShortcuts
		default: $h command
		do: [ :target | target sourceTextArea setSearchString ].
		
	(aBuilder shortcut: #cancel) 
		category: #NautilusSourceCodeShortcuts
		default: $l command
		do: [ :target | target sourceTextArea cancelWithoutConfirmation ].
		
	(aBuilder shortcut: #paste) 
		category: #NautilusSourceCodeShortcuts
		default: $v command
		do: [ :target | target sourceTextArea paste ].
		
	(aBuilder shortcut: #cut) 
		category: #NautilusSourceCodeShortcuts
		default: $x command
		do: [ :target | target sourceTextArea cut ].
				
	(aBuilder shortcut: #undo) 
		category: #NautilusSourceCodeShortcuts
		default: $z command
		do: [ :target | target sourceTextArea undo ].
		
	(aBuilder shortcut: #redo) 
		category: #NautilusSourceCodeShortcuts
		default: $z command shift
		do: [ :target | target sourceTextArea redo ].
	
	(aBuilder shortcut: #cursorHome)
		category: #NautilusSourceCodeShortcuts
		default: Character home command
		do: [ :target :morph :event | target sourceTextArea cursorHome: event ].
	
	(aBuilder shortcut: #cursorEnd)
		category: #NautilusSourceCodeShortcuts
		default: Character end command
		do: [ :target :morph :event | target sourceTextArea cursorEnd: event ].

	(aBuilder shortcut: #browseIt) 
		category: #NautilusSourceCodeShortcuts
		default: $b command
		do: [ :target | target sourceTextArea browseIt ].
				
	(aBuilder shortcut: #doIt) 
		category: #NautilusSourceCodeShortcuts
		default: $d command
		do: [ :target | target sourceTextArea doIt ].

	(aBuilder shortcut: #inspectIt) 
		category: #NautilusSourceCodeShortcuts
		default: $i command
		do: [ :target | target sourceTextArea inspectIt ].
		
	(aBuilder shortcut: #implementorsOfIt) 
		category: #NautilusSourceCodeShortcuts
		default: $m command
		do: [ :target | target sourceTextArea implementorsOfIt ].
		
	(aBuilder shortcut: #sendersOfIt)
		category: #NautilusSourceCodeShortcuts
		default: $n command
		do: [ :target | target sourceTextArea sendersOfIt ].

	(aBuilder shortcut: #printIt) 
		category: #NautilusSourceCodeShortcuts
		default: $p command
		do: [ :target | target sourceTextArea printIt ].! !

!AbstractNautilusUI class methodsFor: 'shortcut-old' stamp: 'NicolaiHess 7/27/2014 21:02'!
buildGroupShortcutsOn: aBuilder
	<keymap>

	(aBuilder shortcut: #fullBrowse)
		category: #NautilusGroupShortcuts
		default: $b command
		do: [ :target | target fullBrowse ]
		description: 'Open a new browser on the current selection'.
		
	(aBuilder shortcut: #restrictedBrowseGroup)
		category: #NautilusGroupShortcuts
		default: $b command shift
		do: [ :target | target  restrictedBrowseGroups: target packageWidget selectedGroups ]
		description: 'Open a browser on a restricted view'.
	
	(aBuilder shortcut: #findClass)
		category: #NautilusGroupShortcuts
		default: $f command
		do: [ :target | target findClass ]
		description: 'Find a class'.
		
	(aBuilder shortcut: #addNewGroup)
		category: #NautilusGroupShortcuts
		default: $n command
		do: [ :target | target addNewGroup ]
		description: 'Create a new group'.
	
	(aBuilder shortcut: #renameGroup)
		category: #NautilusGroupShortcuts
		default: $r command
		do: [ :target | target enableSingleMenuItems ifTrue:[ target renameGroup ]]
		description: 'Rename the selected group'.
	
	(aBuilder shortcut: #runTestsOfGroups)
		category: #NautilusGroupShortcuts
		default: $t command
		do: [ :target | target runTestsOfGroups: target packageWidget selectedGroups notifying: true ]
		description: 'Run the tests of the selected groups'.
		
	(aBuilder shortcut: #removeGroups)
		category: #NautilusGroupShortcuts
		default: $x command
		do: [ :target | target removeGroups ]
		description: 'Remove the selected groups'.! !

!AbstractNautilusUI class methodsFor: 'accessing' stamp: ''!
packagesIconsCache

		^ PackagesIconsCache! !

!AbstractNautilusUI class methodsFor: 'menu' stamp: 'MarcusDenker 8/6/2014 10:33'!
debugMenu: aBuilder
	<contextMenu>
	<nautilusGlobalMethodMenu>
	<nautilusGlobalProtocolMenu>
	<nautilusGlobalClassMenu>
	<nautilusGlobalPackageMenu>
	<nautilusGlobalGroupMenu>
	
	| target |
	
	Nautilus showDebugMenus ifFalse: [ ^self ].
	
	target := aBuilder model.
	(aBuilder item: #DebugMenu)
			order: 9999;
			label: 'DEBUG'.
			
	(aBuilder item: #'Reset icon cache')
			order: 0;
			action: [ 
				self resetIconCaches.
				AbstractMethodWidget resetMethodIconCache ];
			parent: #DebugMenu.
			
	(aBuilder item: #'Inspect me')
			order: 100;
			action: [ target inspect ];
			parent: #DebugMenu.
			
	(aBuilder item: #'Inspect my model ')
			order: 200;
			action: [ target model inspect];
			parent: #DebugMenu.! !

!AbstractNautilusUI class methodsFor: 'shortcuts' stamp: 'NicolaiHess 9/7/2014 19:14'!
buildButtonsShortcutsOn: aBuilder
	<keymap>

	(aBuilder shortcut: #showPackage)
		category: #NautilusGlobalShortcuts
		default: $t command  ,$p command
		do: [ :target | target showGroups: false ]
		description: 'Find a class'.
			
	(aBuilder shortcut: #showGroup)
		category: #NautilusGlobalShortcuts
		default: $t command  , $g command 
		do: [ :target | target showGroups: true ]
		description: 'Find a package'.
		
	(aBuilder shortcut: #showInstanceSide)
		category: #NautilusGlobalShortcuts
		default: $t command  ,$i command 
		do: [ :target | target showInstance: true ]
		description: 'Show instance side'.

	(aBuilder shortcut: #showClassSide)
		category: #NautilusGlobalShortcuts
		default: $t command  ,$c command 
		do: [ :target | target showInstance: false ]
		description: 'Show class side'.

	(aBuilder shortcut: #showHierarchy)
		category: #NautilusGlobalShortcuts
		default: $t command  ,$h command 
		do: [ :target | target showHierarchy: true ]
		description: 'Show Hierarchy'.
		
	(aBuilder shortcut: #showFlat)
		category: #NautilusGlobalShortcuts
		default: $t command  ,$f command 
		do: [ :target | target showHierarchy: false ]
		description: 'Show normal view'.
! !

!AbstractNautilusUI class methodsFor: 'class initialization' stamp: 'EstebanLorenzano 10/17/2013 13:55'!
registerSystemAnnouncements
	SystemAnnouncer uniqueInstance unsubscribe: self.
	SystemAnnouncer uniqueInstance weak
		when: IconSetChanged
		send: #resetIconCaches
		to: self! !

!AbstractNautilusUITest commentStamp: '<historical>'!
An AbstractNautilusUITest is a test class for testing the behavior of AbstractNautilusUI!
!AbstractNautilusUITest methodsFor: 'initialization' stamp: ''!
setUp
	"Setting up code for AbstractNautilusUITest"

	model := AbstractNautilusUI new.! !

!AbstractNautilusUITest methodsFor: 'tests' stamp: ''!
testSortClassesInCachedHierarchyB! !

!AbstractObjectsAsMethod methodsFor: 'compatibility' stamp: 'MarcusDenker 2/11/2013 15:34'!
pragmas
	^#()! !

!AbstractObjectsAsMethod methodsFor: 'compatibility' stamp: 'md 3/1/2006 14:23'!
methodClass: aMethodClass! !

!AbstractObjectsAsMethod methodsFor: 'compatibility' stamp: 'md 3/1/2006 14:23'!
selector: aSymbol! !

!AbstractObjectsAsMethod methodsFor: 'compatibility' stamp: 'md 3/1/2006 14:25'!
flushCache! !

!AbstractObjectsAsMethod methodsFor: 'compatibility' stamp: 'MarcusDenker 2/11/2013 16:06'!
origin
	^self class! !

!AbstractPackageSelectedPlugin commentStamp: '<historical>'!
AbstractKeyPressedPlugin is an abstraction of plugin which react when a package is selected!
!AbstractPackageSelectedPlugin methodsFor: 'registration' stamp: 'BernardoContreras 10/22/2014 19:12'!
registerTo: aModel

	aModel announcer
		when: NautilusPackageSelected send: #packageSelected: to: self! !

!AbstractPackageSelectedPlugin methodsFor: 'announcement' stamp: 'BenjaminVanRyseghem 5/10/2011 14:39'!
packageSelected: anAnnouncement

	^ self subclassResponsibility! !

!AbstractPackageWidget commentStamp: '<historical>'!
AbstractPackageWidget is an abstraction describing a widget used to manage packages!
!AbstractPackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/28/2014 21:48'!
updateList
	self subclassResponsibility ! !

!AbstractPackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 13:55'!
deselectAll
	self subclassResponsibility ! !

!AbstractPackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 20:57'!
selectedGroups
	self subclassResponsibility ! !

!AbstractPackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 14:07'!
resetPackagesSelection
	self subclassResponsibility ! !

!AbstractPackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/30/2014 13:06'!
selectedGroup
	"return the selected group, on multiselection, return selections first element"
	self subclassResponsibility ! !

!AbstractPackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 20:53'!
selectPackage: aPackage
	self subclassResponsibility ! !

!AbstractPackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 20:56'!
resetGroupsSelection
	self subclassResponsibility! !

!AbstractPackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 20:57'!
selectedPackages
	self subclassResponsibility ! !

!AbstractPackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 13:58'!
setShortcuts: aSymbol
	self subclassResponsibility ! !

!AbstractPackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 20:54'!
selectGroup: aGroup
	self subclassResponsibility ! !

!AbstractPackageWidget methodsFor: 'item creation' stamp: 'NicolaiHess 7/26/2014 21:44'!
buildPackagesList
	self subclassResponsibility ! !

!AbstractPackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 14:13'!
buildContents
	self subclassResponsibility .! !

!AbstractPackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 13:39'!
hasFocus
	self subclassResponsibility ! !

!AbstractPackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 13:55'!
updatePackageView
	self subclassResponsibility ! !

!AbstractPackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 14:01'!
removeShortcuts: aSymbol
	self subclassResponsibility ! !

!AbstractPackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/30/2014 13:06'!
selectedPackage
	"return the selected package, on multiselection, return selections first element"
	self subclassResponsibility ! !

!AbstractPackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/28/2014 21:43'!
enabled: aValue
	self subclassResponsibility ! !

!AbstractPackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 13:39'!
takeKeyboardFocus
	self subclassResponsibility ! !

!AbstractPackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/30/2014 13:05'!
selectedPackageGroup
	"return the selected package or group - whatever
	  is selected."
	self subclassResponsibility ! !

!AbstractResizerMorph commentStamp: 'jmv 1/29/2006 17:15'!
I am the superclass of a hierarchy of morph specialized in allowing the user to resize or rearrange windows and panes.!
!AbstractResizerMorph methodsFor: 'event handling' stamp: 'gvc 3/12/2007 10:59'!
mouseUp: anEvent
	"Change the cursor back to normal if necessary."
	
	(self bounds containsPoint: anEvent cursorPoint) ifFalse: [
		anEvent hand showTemporaryCursor: nil.
		self
			setDefaultColors;
			changed]! !

!AbstractResizerMorph methodsFor: 'testing' stamp: 'gvc 5/13/2008 10:20'!
shouldDraw
	"Answer whether the resizer should be drawn."
	
	^self fillStyle isTransparent not! !

!AbstractResizerMorph methodsFor: 'actions' stamp: 'jrp 7/5/2005 21:37'!
resizeCursor

	self subclassResponsibility! !

!AbstractResizerMorph methodsFor: 'event handling' stamp: 'jrp 7/5/2005 21:37'!
handlesMouseDown: anEvent

	^ true! !

!AbstractResizerMorph methodsFor: 'actions' stamp: 'gvc 3/27/2008 21:34'!
adoptPaneColor: paneColor
	"Just get the resizer fill style for the theme."
	
	paneColor ifNil: [^super adoptPaneColor: paneColor].
	self fillStyle: (self theme resizerGripNormalFillStyleFor: self)! !

!AbstractResizerMorph methodsFor: 'testing' stamp: 'gvc 5/13/2008 10:35'!
shouldInvalidateOnMouseTransition
	"Answer whether the resizer should be invalidated
	when the mouse enters or leaves."
	
	^false! !

!AbstractResizerMorph methodsFor: 'event handling' stamp: 'jrp 7/5/2005 21:37'!
handlesMouseOver: anEvent

	^ true
	! !

!AbstractResizerMorph methodsFor: 'event handling' stamp: 'gvc 5/13/2008 10:36'!
mouseEnter: anEvent

	self isCursorOverHandle ifTrue:
		[self setInverseColors.
		self shouldInvalidateOnMouseTransition ifTrue: [self changed]. "avoid unnecessary invalidation"
		anEvent hand showTemporaryCursor: self resizeCursor]! !

!AbstractResizerMorph methodsFor: 'initialization' stamp: 'md 2/24/2006 23:01'!
initialize

	super initialize.
	self color: Color transparent! !

!AbstractResizerMorph methodsFor: 'testing' stamp: 'jrp 7/5/2005 21:40'!
isCursorOverHandle

	^ true! !

!AbstractResizerMorph methodsFor: 'actions' stamp: 'jrp 7/5/2005 21:36'!
dotColor

	^ dotColor ifNil: [self setDefaultColors. dotColor]! !

!AbstractResizerMorph methodsFor: 'event handling' stamp: 'jrp 7/5/2005 21:42'!
mouseDown: anEvent

	lastMouse := anEvent cursorPoint! !

!AbstractResizerMorph methodsFor: 'event handling' stamp: 'StephaneDucasse 6/22/2014 18:26'!
mouseLeave: anEvent

	anEvent hand showTemporaryCursor: nil.
	self setDefaultColors.
	self shouldInvalidateOnMouseTransition ifTrue: [self changed]. 
	"avoid unnecessary invalidation"! !

!AbstractResizerMorph methodsFor: 'actions' stamp: 'jrp 7/5/2005 21:35'!
handleColor

	^ handleColor ifNil: [self setDefaultColors. handleColor]! !

!AbstractResizerMorph methodsFor: 'actions' stamp: 'jrp 7/30/2005 21:30'!
setInverseColors

	handleColor := Color lightGray.
	dotColor := Color white! !

!AbstractResizerMorph methodsFor: 'actions' stamp: 'jrp 7/29/2005 13:25'!
setDefaultColors

	handleColor := Color lightGray lighter lighter.
	dotColor := Color gray lighter! !

!AbstractSpecLayoutAction commentStamp: '<historical>'!
AbstractSpecLayoutAction is an abstract class representing a spec layout action.!
!AbstractSpecLayoutAction methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/31/2012 15:10'!
generateArguments

	! !

!AbstractSpecLayoutAction methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/18/2012 04:47'!
asSpecElements

	self subclassResponsibility ! !

!AbstractTextChangedPlugin commentStamp: '<historical>'!
An AbstractTextChangedPlugin is a plugin which simply log each time the method displayer changed!
!AbstractTextChangedPlugin methodsFor: 'registration' stamp: 'BernardoContreras 10/22/2014 19:14'!
registerTo: aModel

	aModel announcer
		when: NautilusTextDisplayerChanged send: #displayerChanged: to: self! !

!AbstractTextChangedPlugin methodsFor: 'private' stamp: 'BenjaminVanRyseghem 6/13/2012 21:18'!
displayerChanged: anAnnouncement

	self logCr: anAnnouncement displayerSymbol! !

!AbstractTimeZone commentStamp: '<historical>'!
I am an abstract superclass for timezones.
See my subclasses for specific implementations.

Timezones are used to encapsulate the offset from the Coordinated Univeral Time (UTC) used for proper Date and Time display and manipulations.!
!AbstractTimeZone methodsFor: 'accessing' stamp: 'CamilloBruni 8/24/2013 00:15'!
abbreviation
	^ self subclassResponsibility! !

!AbstractTimeZone methodsFor: 'printing' stamp: 'CamilloBruni 10/16/2013 18:21'!
printOn: aStream
 
 	super printOn: aStream.
 	aStream
 		nextPut: $(;
 		nextPutAll: self abbreviation;
 		nextPut: $).! !

!AbstractTimeZone methodsFor: 'accessing' stamp: 'CamilloBruni 8/24/2013 00:15'!
offset
	"Return a duration representing the offset from UTC for this timezone"
	self subclassResponsibility! !

!AbstractTimeZone methodsFor: 'accessing' stamp: 'CamilloBruni 8/24/2013 00:15'!
name
	^ self subclassResponsibility! !

!AbstractTool commentStamp: '<historical>'!
I'm an abstract class grouping generic methods for managing packages/classes/groups/methods from a browser!
!AbstractTool methodsFor: 'package' stamp: 'BenjaminVanRyseghem 2/5/2013 14:06'!
addPackageBasedOn: aPackage

	| name initialAnswer package |
	initialAnswer := aPackage ifNil: [''] ifNotNil: [:p | p name].
	name := UIManager default request: 'Name of the new package:' initialAnswer: initialAnswer title: 'Create a new package'.
	(self isValidPackageName: name)
		ifTrue: [ package := self browsedEnvironment packageOrganizer createPackageNamed: name ]
		ifFalse: [ self alertInvalidPackageName:name ].
	^ package! !

!AbstractTool methodsFor: 'method' stamp: 'BenjaminVanRyseghem 4/13/2011 13:13'!
removeNonLocalSelector: aSymbol from: aClass
	| traits isAlias |
	traits := aClass traitsProvidingSelector: aSymbol.
	isAlias := aClass isLocalAliasSelector: aSymbol.
	isAlias
		ifTrue: [
			[traits size = 1] assert.
			aClass removeAlias: aSymbol of: traits first]
		ifFalse: [
			traits do: [:each |
				aClass addExclusionOf: aSymbol to: each ]]! !

!AbstractTool methodsFor: 'package' stamp: 'NicolaiHess 4/7/2014 22:46'!
addPackagesAsGroup: aCollection

	aCollection
		ifNotEmpty: [| packages blocks name | 
			packages := aCollection sort: [:a :b | a name <= b name ].
			blocks := OrderedCollection new.
			packages do: [:package | blocks add: (self class groupBlockFor: package)].
			name := ( packages collect: [:package | package name]) joinUsing: ' + '.
			^ (self groupsManager	
					addADynamicClassGroupNamed: name
					blocks: blocks)]! !

!AbstractTool methodsFor: 'method' stamp: 'MarcusDenker 6/27/2014 16:00'!
browseVersionsFrom: aMethod
	"Create and schedule a Versions Browser, showing all versions of the 
	currently selected message. Answer the browser or nil."

	aMethod selector
		ifNil: [ self inform: 'Sorry, only actual methods have retrievable versions.'. ^nil ]
		ifNotNil: [:selector |
			Smalltalk tools versionBrowser browseVersionsForClass: aMethod methodClass selector: selector]
				! !

!AbstractTool methodsFor: 'group' stamp: 'BenjaminVanRyseghem 1/24/2013 15:17'!
alertGroupExisting: name
	

	UIManager default alert: 'The group named ', name, ' already exists' title: 'Already exists'! !

!AbstractTool methodsFor: 'package' stamp: 'BenjaminVanRyseghem 2/5/2013 14:04'!
isValidPackageName: name

	^ (name isNil or: [ name isEmpty or: [ name first = $* ]]) not! !

!AbstractTool methodsFor: 'class' stamp: 'EstebanLorenzano 12/12/2013 21:37'!
addTraitIn: aPackage
	" add a new class in the provided package. A dialog will be opened to let the user set the class definition "
	|  systemCategory classDefinition |
	
	systemCategory := aPackage
		ifNotNil: [ aPackage categoryName ]
		ifNil: [ 'Unknown' ].
	classDefinition := self class defineTraitTemplate 
		format: { #TNameOfTrait. '{}'. systemCategory }.
	classDefinition := UIManager default 
		multiLineRequest: 'Define class definition:'
		initialAnswer: classDefinition
		answerHeight: 250.
	(classDefinition isNil or: [ classDefinition isEmpty ])
		ifTrue: [ ^ self ].
	self class evaluate: classDefinition.! !

!AbstractTool methodsFor: 'package' stamp: 'MarcusDenker 6/14/2014 12:18'!
renamePackages: aCollection

	aCollection
		 ifNotEmpty: [ :packages |
			packages do: [ :selectedPackage | self renamePackage: selectedPackage ] ].! !

!AbstractTool methodsFor: 'class' stamp: 'MarcusDenker 10/15/2013 18:07'!
browseUnusedMethodsOf: aClass
	| classes unsent messageList |
	
	aClass
		ifNil: [^ self].
		
	classes := Array with: aClass with: aClass class.
	unsent := Set new.
	classes
		do: [:c | unsent addAll: c selectors ].
	unsent := self systemNavigation allUnsentMessagesIn: unsent.
	messageList := OrderedCollection new.
	classes
		do: [:c | (c selectors
				select: [:s | unsent includes: s]) asSortedCollection
				do: [:sel | messageList add: ((c compiledMethodAt: sel) methodReference) ]].
	self systemNavigation browseMessageList: messageList name: 'Unsent Methods in ' , aClass name! !

!AbstractTool methodsFor: 'class' stamp: 'BenjaminVanRyseghem 1/10/2014 15:24'!
addCategoryIn: aClass

	^ self addCategoryIn: aClass before: nil! !

!AbstractTool methodsFor: 'group' stamp: 'MarcusDenker 8/13/2014 15:11'!
mergeGroups: aCollection

	aCollection
		ifNotEmpty: [:groups || group |
			group := groups reduce: [:a :b | a or: [b]].
			groups do: [:gp | 
				gp removable
					ifTrue: [self groupsManager removeAGroupSilently: gp]].
				^ group].
	^ nil! !

!AbstractTool methodsFor: 'class' stamp: 'BenjaminVanRyseghem 4/13/2011 12:26'!
browseClassVarRefsOf: aClass

	| cls |
	cls := aClass theNonMetaClass.
	(cls notNil and: [cls isTrait not])
		ifTrue: [self systemNavigation browseClassVarRefs: cls]! !

!AbstractTool methodsFor: 'class' stamp: 'StephaneDucasse 1/31/2015 20:56'!
removeClass: aClass
	"Remove the selected class from the system, at interactive user request.  Make certain the user really wants to do this, since it is not reversible.  Answer true if removal actually happened."

	| message className classToRemove result |
	aClass ifNil: [ ^ false ].
	classToRemove := aClass theNonMetaClass.
	className := classToRemove name.
	message := self removeClassMessageFor: className.
	(result := self confirm: message)
		ifTrue: [ 
			classToRemove subclasses notEmpty
				ifTrue: [ 
					(self confirm: 'class has subclasses: ' , message)
						ifFalse: [ ^ false ] ].
			classToRemove removeFromSystem ].
	^ result! !

!AbstractTool methodsFor: 'method' stamp: 'MarcusDenker 10/13/2013 07:57'!
selectThenBrowseSendersOfMessagesFrom: aSelector
	"Present a menu of the currently selected message, as well as all messages sent by it.  Open a message set browser of all senders of the selector chosen."

	self selectThenGetSelectorAndSendQuery: #browseAllSendersOf: to: self systemNavigation with: {} selector: aSelector! !

!AbstractTool methodsFor: 'method' stamp: 'SeanDeNigris 6/13/2013 09:12'!
fileOutMethods: aCollection

	self 
		do: [ :method | method methodClass fileOutMethod: method selector ]
		on: aCollection
		displaying: 'Filing out methods...'.! !

!AbstractTool methodsFor: 'class' stamp: 'MarcusDenker 8/28/2013 10:51'!
defineTrait: defString notifying: aController  

	| defTokens keywdIx envt oldTrait newTraitName trait |
	self selectedClassOrMetaClass isTrait ifTrue:[oldTrait := self selectedClassOrMetaClass].
	defTokens := defString findTokens: Character separators.
	keywdIx := defTokens findFirst: [:x | x = 'category'].
	envt := self class environment.
	keywdIx := defTokens findFirst: [:x | x = 'named:'].
	newTraitName := (defTokens at: keywdIx+1) copyWithoutAll: '#()'.
	((oldTrait isNil or: [oldTrait baseTrait name asString ~= newTraitName])
		and: [envt includesKey: newTraitName asSymbol]) ifTrue:
			["Attempting to define new class/trait over existing one when
				not looking at the original one in this browser..."
			(self confirm: ((newTraitName , ' is an existing class/trait in this system.
Redefining it might cause serious problems.
Is this really what you want to do?') asText makeBoldFrom: 1 to: newTraitName size))
				ifFalse: [^ nil ]].

	trait := self class compiler source: defString; requestor: aController; logged: true; evaluate.
	^ trait! !

!AbstractTool methodsFor: 'package' stamp: 'MarcusDenker 8/4/2014 10:07'!
packageFromPattern: pattern withCaption: aCaption
	"If there is a package whose name exactly given by pattern, return it.
	If there is only one package in the system whose name matches pattern, return it.
	Otherwise, put up a menu offering the names of all packages that match pattern, and return the class chosen, else nil if nothing chosen.
	This method ignores tab, space, & cr characters in the pattern"

	| toMatch potentialPackageNames packageNames exactMatch index |
	(toMatch := pattern
		copyWithoutAll:
			{(Character space).
			(Character cr).
			(Character tab)}) isEmpty
		ifTrue: [ ^ nil ].
	
	RPackageOrganizer default packageNamed: toMatch ifAbsent: [ nil ].
	
	toMatch := (toMatch copyWithout: $.) asLowercase.
	potentialPackageNames := (RPackageOrganizer default packages collect: [:each | each name]) asOrderedCollection.
	packageNames := pattern last = $.
		ifTrue: [ potentialPackageNames select: [ :nm | nm asLowercase = toMatch ] ]
		ifFalse: [ potentialPackageNames select: [ :n | n includesSubstring: toMatch caseSensitive: false ] ].
	packageNames isEmpty
		ifTrue: [ ^ nil ].
	exactMatch := packageNames detect: [ :each | each asLowercase = toMatch ] ifNone: [ nil ].
	index := packageNames size = 1
		ifTrue: [ 1 ]
		ifFalse: [ 
			exactMatch
				ifNil: [ UIManager default chooseFrom: packageNames lines: #() title: aCaption ]
				ifNotNil: [ 
					packageNames addFirst: exactMatch.
					UIManager default chooseFrom: packageNames lines: #(1) title: aCaption ] ].
	index = 0
		ifTrue: [ ^ nil ].
	^ RPackageOrganizer default packageNamed: (packageNames at: index)"
	self default packageFromPattern: 'Nau' withCaption: ''
	self default packageFromPattern: 'orph' withCaption: ''
	self default packageFromPattern: 'TCompil' withCaption: ''
"! !

!AbstractTool methodsFor: 'method' stamp: 'BenjaminVanRyseghem 4/13/2011 13:06'!
moveMethod: aMethod inPackage: aPackage

	aMethod methodClass organization
				classify: aMethod selector
				under: '*', aPackage name
				suppressIfDefault: true.! !

!AbstractTool methodsFor: 'category' stamp: 'EstebanLorenzano 1/16/2014 11:20'!
renameCategory: aCategory from: aClass
	"Prompt for a new category name and add it before the
	current selection, or at the end if no current selection"
	
	| oldName newName |
	
	aClass ifNil: [^ nil].
	aCategory ifNil: [^ nil].
	
	oldName := aCategory.
	newName := self class requestProtocolNameFor: aClass initialAnswer: oldName.
	newName isEmptyOrNil
		ifTrue: [^ nil ]
		ifFalse: [newName := newName asSymbol].
	newName = oldName ifTrue: [^ nil ].
	aClass organization
		renameCategory: oldName
		toBe: newName.
	
	^ newName! !

!AbstractTool methodsFor: 'class' stamp: 'StephaneDucasse 1/31/2015 20:44'!
basicRemoveClass: classToRemove
	^ classToRemove subclasses notEmpty
		ifTrue: [ 
			(self
				confirm:
					classToRemove name
						,
							' has subclasses.
Do you really want to REMOVE it from the system ?')
				ifTrue: [ classToRemove removeFromSystem ] ]
		ifFalse: [ classToRemove removeFromSystem ]! !

!AbstractTool methodsFor: 'method' stamp: 'BenjaminVanRyseghem 2/7/2012 09:20'!
browseMessagesFrom: aSelector
	" badly named, it browses implementors "

	self getSelectorAndSendQuery: #browseAllImplementorsOf: to: self systemNavigation with: {} selector: aSelector! !

!AbstractTool methodsFor: 'class' stamp: 'MarcusDenker 3/13/2015 09:09'!
showUnreferencedClassVarsOf: aClass
	"Search for all class variables known to the selected class, and put up a 
	list of those that have no references anywhere in the system. The 
	search includes superclasses, so that you don't need to navigate your 
	way to the class that defines each class variable in order to determine 
	whether it is unreferenced"

	| aList aReport |
	(aClass isNil or: [ aClass isTrait ])
		ifTrue: [ ^ self ].
	aList := self systemNavigation allUnreferencedClassVariablesOf: aClass.
	aList isEmpty
		ifTrue: [ 
			^ UIManager default
				inform:
					'There are no unreferenced
class variables in
' , aClass name ].
	aReport := String
		streamContents: [ :aStream | 
			aStream
				nextPutAll: 'Unreferenced class variable(s) in ' translated;
				nextPutAll: aClass name;
				cr.
			aList
				do: [ :el | 
					aStream
						tab;
						nextPutAll: el;
						cr ] ].
	UIManager default inform: aReport! !

!AbstractTool methodsFor: 'method' stamp: ''!
selectThenGetSelectorAndSendQuery: querySelector to: queryPerformer with: queryArgs selector: aSelector
	"Obtain a selector relevant to the current context, and then send the querySelector to the queryPerformer with the selector obtained and queryArgs as its arguments.  If no message is currently selected, then obtain a method name from a user type-in"
	| strm array |
	
	strm := (array := Array new: queryArgs size + 1) writeStream.
	strm nextPut: nil.
	strm nextPutAll: queryArgs.
	
	aSelector ifNil: [ ^ self 
						defaultGetSelectorAndSendQuery: querySelector
						to: queryPerformer
						with: array ].
	self
		selectMessageAndEvaluate: [ :selector | 
			array at: 1 put: selector.
			queryPerformer perform: querySelector withArguments: array ]
		defaultValue: aSelector! !

!AbstractTool methodsFor: 'class' stamp: 'DamienPollet 8/14/2014 15:49'!
addClassIn: aPackage
	" Add a new class in the provided package. A dialog will be opened to let the user set the class definition "

	| classSymbol systemCategory proposedSuperclass classDefinition newClass  |
	classSymbol := #NameOfSubclass.
	systemCategory := aPackage
		ifNotNil: [ aPackage categoryName ]
		ifNil: [ 'Unknown' ].
	proposedSuperclass := self selectedClasses in: [ :classes |
		classes size == 1
			ifFalse: [ Object ]
			ifTrue: [ classes first ]].
	classDefinition := self class defineClassTemplate 
		format: { proposedSuperclass. classSymbol. systemCategory }.
	classDefinition := UIManager default 
		multiLineRequest: 'Define class definition:'
		initialAnswer: classDefinition
		answerHeight: 250.
	classDefinition isEmptyOrNil 
		ifTrue: [ ^ self ].
		
	newClass := self class evaluate: classDefinition.
	self browseClass: newClass! !

!AbstractTool methodsFor: 'method' stamp: 'MarcusDenker 6/14/2014 12:18'!
categorizeMethods: aCollection of: aClass from: aCategory
	"Present a choice of categories or prompt for a new category name and add it before the current selection, or at the end if no current selection"
	
	| labels lines newName |
	aCollection ifEmpty: [^ self].
	aClass ifNil: [^self].	
	labels := OrderedCollection new.
	labels
		addAll: aClass organization categories copy sort;
		add: Protocol unclassified.
	lines := OrderedCollection new.
	lines add: labels size -1.
	newName := UIManager default chooseOrRequestFrom: labels lines: lines title: ('Change Protocol (current: ', aCategory, ')').
	newName ifNil: [ ^self ].
	newName := newName asSymbol.
	aCollection do: [:item | 
		item methodClass organization
					classify: item selector
					under: newName 
					suppressIfDefault: true ].! !

!AbstractTool methodsFor: 'method' stamp: 'MarcusDenker 8/13/2014 15:21'!
findMethodIn: aClass
	| recentList pattern  |
	aClass ifNil: [ ^ nil ].
	recentList := aClass selectors.
	pattern := recentList isEmpty
		ifTrue: [ UIManager default request: 'Message name or fragment?' ]
		ifFalse: [ UIManager default enterOrRequestFrom: recentList lines: #() title: 'Message name or fragment?' ].
	pattern isEmptyOrNil
		ifTrue: [ ^ nil ].
	^ self selectorFromPattern: pattern withCaption: '' startingFrom: self selectedClass.
	! !

!AbstractTool methodsFor: 'method' stamp: 'MarcusDenker 10/13/2013 07:57'!
browseSendersOfMessagesFrom: aSelector
	"Present a menu of the currently selected message, as well as all messages sent by it.  Open a message set browser of all senders of the selector chosen."

	self getSelectorAndSendQuery: #browseAllSendersOf: to: self systemNavigation with: {} selector: aSelector! !

!AbstractTool methodsFor: 'class' stamp: 'MarcusDenker 8/13/2014 15:13'!
browseClassRefsOf: aClass

	| class |
	aClass ifNil: [ ^self ].
	class := aClass theNonMetaClass ifNil: [^self].
	class isTrait 
		ifTrue: [self systemNavigation browseAllUsersOfTrait: class]
		ifFalse: [self systemNavigation browseAllCallsOnClass: class]
! !

!AbstractTool methodsFor: 'package' stamp: 'MarcusDenker 7/17/2013 15:08'!
addPackagesAsGroups: aCollection
	| name |
	name := WriteStream on: ''.
	aCollection
		ifNotEmpty: [| packages firstGroup | 
			packages := aCollection sort: [:a :b | a name <= b name ].
			packages do: [:package || group |
				[ group := self addPackagesAsGroup: {package}. ]
				on: GroupAlreadyExists 
				do: [:ex | 
					name nextPutAll: ex groupName; nextPut: Character cr.
					group := nil ].
				firstGroup ifNil: [ group ifNotNil: [ firstGroup := group ]]].
			name := name contents.
			name isEmpty ifFalse: [ (GroupsAlreadyExist groupName: name) signal ].
			^ firstGroup ].
	^ nil
		
	! !

!AbstractTool methodsFor: 'package' stamp: 'StephaneDucasse 11/11/2013 18:56'!
fileOutPackages: aCollection

	self 
		do: [ :package |  package item package fileOut ]
		on: aCollection
		displaying: 'Filing out packages...'.! !

!AbstractTool methodsFor: 'method' stamp: 'ChristopheDemarey 10/18/2013 17:39'!
removeMethod: aMethod inClass: aClass
	"If a message is selected, create a Confirmer so the user can verify that  
	the currently selected message should be removed from the system. If 
	so, remove it. "
	| messageName confirmation |
	
	aMethod ifNil: [^ false].
	messageName := aMethod selector.
	confirmation := self systemNavigation confirmRemovalOf: messageName on: aClass.
	confirmation = 3
		ifTrue: [^ false].
	(aClass includesLocalSelector: messageName)
		ifTrue: [ aClass removeSelector: messageName ]
		ifFalse: [ self removeNonLocalSelector: messageName ].

	"In case organization not cached"
	confirmation = 2
		ifTrue: [self systemNavigation browseAllSendersOf: messageName].
		
	self removeEmptyUnclassifiedCategoryFrom: aClass.
	^ true! !

!AbstractTool methodsFor: 'method' stamp: 'BenjaminVanRyseghem 3/25/2012 20:58'!
selectThenBrowseMessagesFrom: aSelector
	" badly named, it browses implementors "

	self selectThenGetSelectorAndSendQuery: #browseAllImplementorsOf: to: self systemNavigation with: {} selector: aSelector! !

!AbstractTool methodsFor: 'class' stamp: 'SvenVanCaekenberghe 2/1/2014 20:24'!
addCategoryIn: aClass before: aCategory
	"Present a choice of categories or prompt for a new category name 
	and add it before the current selection, or at the end if no current selection"

	| newName |
	newName := self class requestProtocolNameFor: aClass initialAnswer: ''.
	(newName isEmptyOrNil) ifTrue: [ ^ nil ].
	newName := newName asSymbol.

	aClass organization
		addCategory: newName
		before: aCategory.
	
	^ newName! !

!AbstractTool methodsFor: '*SmartSuggestions' stamp: 'GiselaDecuzzi 4/17/2013 10:01'!
browseAllStoresInto: aVariableName from: aClass 
	^self systemNavigation browseAllStoresInto: aVariableName from: aClass ! !

!AbstractTool methodsFor: '*SmartSuggestions' stamp: 'GiselaDecuzzi 4/18/2013 15:19'!
browseSendersOf: target name: windowName autoSelect: isAutoSelect 
	^self systemNavigation browseSendersOf: target name: windowName autoSelect: isAutoSelect ! !

!AbstractTool methodsFor: 'class' stamp: 'SeanDeNigris 6/13/2013 09:12'!
fileOutClasses: aCollection
	"Print a description of the selected class onto a file whose name is the 
	category name followed by .st."

	self 
		do: [ :class | class theNonMetaClass fileOut ]
		on: aCollection
		displaying: 'Filing out classes...'.! !

!AbstractTool methodsFor: 'class' stamp: 'BenjaminVanRyseghem 4/13/2011 12:29'!
browseInstVarRefsOf: aClass

	(aClass notNil and: [aClass isTrait not])
		ifTrue: [self systemNavigation browseInstVarRefs: aClass]! !

!AbstractTool methodsFor: 'method' stamp: 'CamilloBruni 9/22/2012 21:44'!
compileANewMethodInClass: aClass categorized: aCategory from: aString notifyng: aController

	| selector existingMethod targetClass |
	
	targetClass := aClass.	
	"try to guess the selector form the first line XXX hack"
	selector := aString lines first findSelector.
	
	"Warn the user if a Trait method would be overridden"
	(aClass includesSelector: selector) ifTrue: [
		existingMethod := aClass methodNamed: selector.
		existingMethod isFromTrait ifTrue: [
			targetClass := UIManager default 
				chooseFrom:  {'Create copy in ', aClass name. 
								'Compile Trait method in ', existingMethod origin name}
				values: { aClass. existingMethod origin}
				title: 'Where do you want to compile this trait method?'.
			targetClass ifNil: [ ^ nil ]]].
	
	"Run the normal compilation either on aClass or the Trait"
	^ targetClass compile: aString classified: aCategory notifying: aController.! !

!AbstractTool methodsFor: 'class' stamp: 'StephaneDucasse 1/31/2015 20:48'!
removeClassMessageFor: className
	^ 'Are you certain that you
want to REMOVE the class ' , className
		,
			'
from the system?'! !

!AbstractTool methodsFor: 'class' stamp: 'StephaneDucasse 1/31/2015 21:15'!
removeClasses: aCollection
	"Remove the selected classes from the system.  Check that the user really wants to do this, since it is not reversible.  Answer true if removal actually happened."

	| classNames classesToRemove result |
	aCollection isEmptyOrNil
		ifTrue: [ ^ false ].
	classesToRemove := aCollection collect: #theNonMetaClass.
	classNames := (classesToRemove collect: #name) joinUsing: ', '.
	(result := self confirm: (self removeClassesMessageFor: classNames))
		ifTrue: [ 
			classesToRemove
				do: [ :classToRemove | 
					classToRemove subclasses notEmpty
						ifTrue: [ 
							(self confirm: (self removedClassHasSubclassesMessageFor: classToRemove name))
								ifTrue: [ classToRemove removeFromSystem ] ]
						ifFalse: [ classToRemove removeFromSystem ] ] ].
	^ result! !

!AbstractTool methodsFor: '*necompletion-extensions' stamp: 'EstebanLorenzano 4/12/2012 13:20'!
isCodeCompletionAllowed 
	^true! !

!AbstractTool methodsFor: '*necompletion-extensions' stamp: 'EstebanLorenzano 4/23/2012 13:48'!
guessTypeForName: aString
	^nil! !

!AbstractTool methodsFor: 'private' stamp: 'BernardoContreras 7/15/2014 19:23'!
renamePackage: anRPackage

	| newName |
	newName := UIManager default 
		request: 'New name of the package' 
		initialAnswer: anRPackage name 
		title: 'Rename a package'.
	newName = anRPackage name ifTrue: [ ^ self ].
	(self isValidPackageName: newName)
		ifTrue: [ anRPackage renameTo: newName ]
		ifFalse: [ self alertInvalidPackageName:newName ].! !

!AbstractTool methodsFor: 'package' stamp: 'BenjaminVanRyseghem 4/13/2011 12:21'!
addPackagesAsGroup: aCollection named: aString

	aCollection
		ifNotEmpty: [:packages || blocks | 
			blocks := OrderedCollection new.
			packages do: [:package | blocks add: [ package orderedClasses]].
			^ (self groupsManager	
					addADynamicGroupSilentlyNamed: aString 
					blocks: blocks)]! !

!AbstractTool methodsFor: 'category' stamp: 'BenjaminVanRyseghem 2/18/2012 21:05'!
fileOutCategories: aCollection from: aClass

	aCollection do: [:name | aClass fileOutCategory: name ]! !

!AbstractTool methodsFor: 'category' stamp: 'BenjaminVanRyseghem 4/13/2011 13:10'!
removeEmptyCategoriesFrom: aClass

	aClass organization removeEmptyCategories.! !

!AbstractTool methodsFor: 'class' stamp: 'MarcusDenker 8/13/2014 15:15'!
createInitializerWithInstVarsOf: aClass
	"Create a default initializer on the class side for a chosen list of instance variables"

	| newMessage instVars |
	aClass ifNil: [ ^ self ].
	instVars := (TickDialogWindow
		itemsList: aClass instVarNames copy sort
		itemsHeaderName: 'Inst Var Names'
		wrapBlockOrSelector: [ :e | e ]
		title: 'Create entry point'
		defaultValue: true) chooseFromOwner: self window.
	instVars ifNil: [ ^ self ].
	instVars
		do: [ :aVariable | 
			(aClass canUnderstand: (aVariable , ':') asSymbol)
				ifFalse: [ 
					newMessage := self buildSetterFor: aVariable.
					aClass compile: newMessage classified: 'accessing' notifying: nil ] ].
	(aClass theMetaClass canUnderstand: (($: join: instVars) , ':') asSymbol)
		ifTrue: [ ^ self ].
	newMessage := self buildInitializerFor: instVars.
	aClass theMetaClass compile: newMessage classified: 'instance creation' notifying: nil! !

!AbstractTool methodsFor: 'package' stamp: 'BenjaminVanRyseghem 2/5/2013 14:09'!
alertInvalidPackageName:name
	| errorMessage |

	(name isNil or: [ name isEmpty ]) ifTrue: [ ^ self ]. "User cancelled the action"
	
	errorMessage := String streamContents: [:stream |
		stream << name << ' is not a valid package name.
A package name can not begin with a *' ].
	
	UIManager default inform: errorMessage! !

!AbstractTool methodsFor: 'class' stamp: 'BenjaminVanRyseghem 4/13/2011 12:28'!
browseInstVarDefsOf: aClass

	(aClass notNil and: [aClass isTrait not])
		ifTrue: [self systemNavigation browseInstVarDefs: aClass]! !

!AbstractTool methodsFor: 'class' stamp: 'CamilloBruni 9/12/2011 15:06'!
copyClasses: aCollection
	
	| needsRefresh lastDuplicate | 
	
	aCollection ifEmpty: [ ^ false -> nil ].
	
	needsRefresh := false.
	aCollection do: [:class || copysName |
		copysName := UIManager default request: 'Please type new class name' initialAnswer: class name.
		copysName isEmptyOrNil
			ifFalse: [
				needsRefresh ifFalse: [ needsRefresh := true ].
				lastDuplicate := class duplicateClassWithNewName: copysName ]].

	^(needsRefresh -> lastDuplicate)! !

!AbstractTool methodsFor: 'method' stamp: 'BenjaminVanRyseghem 3/25/2012 20:54'!
defaultGetSelectorAndSendQuery: array to: queryPerformer with: querySelector
	| selector |
	
	selector := UIManager default request: 'Type selector:' initialAnswer: 'flag:'.
	selector ifNil: [ selector := String new ].
	selector := selector copyWithout: Character space.
	^ selector isEmptyOrNil
		ifFalse: [ 
			(Symbol
				hasInterned: selector
				ifTrue: [ :aSymbol | 
					array at: 1 put: aSymbol.
					queryPerformer perform: querySelector withArguments: array ])
				ifFalse: [ self inform: 'no such selector' ] ]! !

!AbstractTool methodsFor: 'category' stamp: 'MarcusDenker 8/13/2014 15:14'!
removeCategory: aCategory inClass: aClass

	aCategory ifNil: [ ^ false ].
	self okToChange ifFalse: [ ^ false].
	
	(aClass organization listAtCategoryNamed: aCategory) isEmpty
		ifTrue: [
			aClass removeProtocol: aCategory.
			^ true ].
		
	(self confirm: 'Are you sure you want to
remove the protocol ', aCategory,'
and all its methods?')
		ifTrue: [
			aClass removeProtocol: aCategory.
			^ true ].
	^ false! !

!AbstractTool methodsFor: 'method' stamp: 'BenjaminVanRyseghem 2/8/2013 16:11'!
getSelectorAndSendQuery: querySelector to: queryPerformer with: queryArgs selector: aSelector
	"Obtain a selector relevant to the current context, and then send the querySelector to the queryPerformer with the selector obtained and queryArgs as its arguments.  If no message is currently selected, then obtain a method name from a user type-in"
	| strm array |
	
	array := Array new: queryArgs size + 1.
	strm := array writeStream.
	strm nextPut: nil.
	strm nextPutAll: queryArgs.
	
	aSelector ifNil: [ ^ self 
						defaultGetSelectorAndSendQuery: querySelector
						to: queryPerformer
						with: array ].
	
	array at: 1 put: aSelector.
	queryPerformer perform: querySelector withArguments: array.! !

!AbstractTool methodsFor: 'private' stamp: 'SeanDeNigris 6/13/2013 08:52'!
do: aBlock on: aCollection displaying: aString

	| job |
	aCollection ifEmpty: [ ^ self ].
	job := [ :bar | 
		aCollection do: [ :element | 
			aBlock value: element.
			bar increment ] ] asJob.
	job
		title: aString;
		min: 0;
		max: aCollection size;
		run.! !

!AbstractTool methodsFor: 'method' stamp: ''!
selectMessageAndEvaluate: aBlock defaultValue: aSelector
	"Subclass may override me to allow the user to choose one selector, chosen from the currently selected message's selector, as well as those of all messages sent by it, and evaluate aBlock on behalf of chosen selector.  If there is only one possible choice, simply make it; if there are multiple choices, put up a menu, and evaluate aBlock on behalf of the the chosen selector, doing nothing if the user declines to choose any"

	aBlock value: aSelector! !

!AbstractTool methodsFor: '*SmartSuggestions' stamp: 'GiselaDecuzzi 4/17/2013 09:58'!
browseAllAccessesTo: variableName from: aClass 
	^self systemNavigation browseAllAccessesTo: variableName from: aClass ! !

!AbstractTool methodsFor: 'method' stamp: 'MarcusDenker 8/4/2014 10:10'!
selectorFromPattern: pattern withCaption: aCaption startingFrom: aClass
	"I look after a selector matching the given pattern in the withSuperclasses of the given class"

	| toMatch potentialSelectorsList potentialSelectorsListNames methodsNames exactMatch index foundSelector separatorIndex className separatorName class |
	(toMatch := pattern
		copyWithoutAll:
			{(Character space).
			(Character cr).
			(Character tab)}) isEmpty
		ifTrue: [ ^ nil ].
	potentialSelectorsList := aClass withAllSuperclasses reverse gather: [:each | each methodDict ].
	Symbol
		hasInterned: toMatch
		ifTrue: [ :patternSymbol || result |
			"Exact symbol provided"
			result := OrderedCollection new.
			potentialSelectorsList do: [:each | 
				(each selector = patternSymbol)
				ifTrue: [result add: each]].
			result size = 1 ifTrue: [^ result first ]].
	toMatch := (toMatch copyWithout: $.) asLowercase.
	potentialSelectorsListNames := potentialSelectorsList collect: [:each | each methodClass name, '>>#', each selector ].
	methodsNames := pattern last = $.
		ifTrue: [ potentialSelectorsListNames select: [ :nm | nm asLowercase = toMatch ] ]
		ifFalse: [ potentialSelectorsListNames select: [ :n | n includesSubstring: toMatch caseSensitive: false ] ].
	methodsNames isEmpty
		ifTrue: [ ^ nil ].
	exactMatch := methodsNames detect: [ :each | each asLowercase = toMatch ] ifNone: [ nil ].
	index := methodsNames size = 1
		ifTrue: [ 1 ]
		ifFalse: [ 
			exactMatch
				ifNil: [ UIManager default chooseFrom: methodsNames lines: #() title: aCaption ]
				ifNotNil: [ 
					methodsNames addFirst: exactMatch.
					UIManager default chooseFrom: methodsNames lines: #(1) title: aCaption ] ].
	index = 0
		ifTrue: [ ^ nil ].
	foundSelector := methodsNames at: index.
	separatorIndex := foundSelector findString: '>>#'.
	className := foundSelector copyFrom: 1 to: separatorIndex-1.
	separatorName := foundSelector copyFrom: separatorIndex + 2 to: foundSelector size.
	class := Smalltalk at: className asSymbol.

	
	^ class methodDict at: (Symbol readFromString: separatorName)
"
	self default selectorFromPattern: 'op' withCaption: '' startingFrom: Boolean
	self default selectorFromPattern: 'zork' withCaption: '' startingFrom: Boolean
	self default selectorFromPattern: 'op' withCaption: '' startingFrom: NautilusWindow
	self default selectorFromPattern: 'openInWorld' withCaption: '' startingFrom: NautilusWindow
"! !

!AbstractTool methodsFor: 'method' stamp: 'MarcusDenker 8/13/2014 15:16'!
removeMethods: aCollection inClass: aClass
	"If a message is selected, create a Confirmer so the user can verify that  
	the currently selected message should be removed from the system. If 
	so, remove it. "
	| messagesName confirmation |
	
	aCollection isEmptyOrNil ifTrue: [^ false].
	aCollection size = 1
		ifTrue: [ ^ self removeMethod: aCollection first inClass: aClass ].
	messagesName := aCollection collect: #selector.
	confirmation := self systemNavigation confirmRemovalOfSelectors: messagesName on: aClass.
	confirmation = 3
		ifTrue: [ ^ false ].
	aCollection do: [:message|| messageName |	
		messageName := message selector.
		(aClass includesLocalSelector: messageName)
			ifTrue: [ aClass removeSelector: messageName ]
			ifFalse: [ self removeNonLocalSelector: messageName ]].

	"In case organization not cached"
	confirmation = 2
		ifTrue: [ 
			aCollection do: [:message || messageName |	
				messageName := message selector.
				((self systemNavigation allCallsOn: messageName) notEmpty)
					ifTrue: [ self systemNavigation browseAllSendersOf: messageName ]]].
	^ true! !

!AbstractTool methodsFor: 'category' stamp: 'GabrielOmarCotelli 11/30/2013 16:09'!
removeEmptyUnclassifiedCategoryFrom: aClass
	"Remove the 'as yet unclassified' category from the class if empty"

	| protocolOrganizer |
	protocolOrganizer := aClass organization protocolOrganizer.
	protocolOrganizer protocols
		detect: [ :protocol | protocol name = Protocol unclassified and: [ protocol isEmpty ] ]
		ifFound: [ :unclassifiedProtocol | protocolOrganizer removeProtocol: unclassifiedProtocol ]! !

!AbstractTool methodsFor: 'class' stamp: 'BenjaminVanRyseghem 4/13/2011 16:06'!
renameClass: aClass
	| oldName newName obs |

	aClass ifNil: [ ^ self ].
	
	oldName := aClass name.
	newName := UIManager default  request: 'Please type new class name' initialAnswer: oldName.
	newName isEmptyOrNil ifTrue: [ ^ self ].	"Cancel returns"
	newName := newName asSymbol.
	newName = oldName ifTrue: [ ^ self ].
	(self class environment includesKey: newName)
		ifTrue: [ ^ self error: newName , ' already exists' ].
	aClass rename: newName.

	obs := self systemNavigation allReferencesTo: (aClass environment associationAt: newName).
	obs isEmpty
		ifFalse: [ self systemNavigation browseMessageList: obs name: 'Obsolete References to ' , oldName autoSelect: oldName ].
	^ newName! !

!AbstractTool methodsFor: 'class' stamp: 'StephaneDucasse 1/31/2015 20:54'!
removedClassHasSubclassesMessageFor: className

	^ className, ' has subclasses.
Do you really want to REMOVE it from the system ?'! !

!AbstractTool methodsFor: 'class' stamp: 'StephaneDucasse 1/31/2015 20:50'!
removeClassesMessageFor: classNames
	^ 'Are you certain that you
want to REMOVE the classes ' , classNames
		,
			'
from the system?'! !

!AbstractTool methodsFor: 'method' stamp: 'BenjaminVanRyseghem 6/28/2012 15:11'!
methodHierarchyFrom: aMethod
	"Create and schedule a method browser on the hierarchy of implementors."

	aMethod ifNil: [ ^ self ].
	self systemNavigation 
			methodHierarchyBrowserForClass: aMethod methodClass
			selector: aMethod selector! !

!AbstractTool methodsFor: 'package' stamp: 'MarcusDenker 8/13/2014 15:15'!
findPackageIn: aPackageNamesList
	| pattern foundPackage |
	pattern := aPackageNamesList isEmpty
		ifTrue: [ UIManager default request: 'Package name or fragment?' ]
		ifFalse: [ UIManager default enterOrRequestFrom: aPackageNamesList lines: #() title: 'Package name or fragment?' ].
	pattern isEmptyOrNil
		ifTrue: [ ^ self flashPackage ].
	foundPackage := self packageFromPattern: pattern withCaption: ''.
	foundPackage ifNil: [ ^ self flashPackage ].
	^ foundPackage! !

!AbstractTool methodsFor: 'class' stamp: 'MarcusDenker 8/13/2014 15:16'!
showUnreferencedInstVarsOf: aClass
	"Search for all instance variables known to the selected class, and put up a list of those that have no references anywhere in the system.  The search includes superclasses, so that you don't need to navigate your way to the class that defines each inst variable in order to determine whether it is unreferenced"

	|  aList aReport |
	(aClass isNil or: [aClass isTrait]) ifTrue: [^ self].
	aList := aClass allUnreferencedInstanceVariables.
	aList isEmpty ifTrue: [^ UIManager default inform: 'There are no unreferenced
instance variables in
', aClass name].
	aReport := String streamContents:
		[:aStream |
			aStream nextPutAll: 'Unreferenced instance variable(s) in ' translated, aClass name; cr.
			aList do: [:el | aStream tab; nextPutAll: el; cr]].
	UIManager default inform: aReport! !

!AbstractTool methodsFor: 'class' stamp: 'MarcusDenker 6/14/2014 12:18'!
createInstVarAccessorsOf: aClass
	"Create getters and setters for all inst vars defined at the level of the current class selection, except do NOT clobber or override any selectors already understood by the instances of the selected class"

	| instVars |
	aClass ifNil: [ ^ self ].
	
	instVars := (TickDialogWindow 
						itemsList: aClass instVarNames copy sort 
						itemsHeaderName: 'Inst Var Names' 
						wrapBlockOrSelector: [:e | e ]
						title: 'Getter/Setter Creator' 
						defaultValue: true) chooseFromOwner: self window.
	
	instVars ifNil: [ ^ self ].
	
	instVars do: [:aName || newMessage |
		(aClass canUnderstand: aName asSymbol)
			ifFalse: [
				newMessage := self buildGetterFor: aName.
				aClass compile: newMessage classified: 'accessing' notifying: nil].
		(aClass canUnderstand: (aName, ':') asSymbol)
			ifFalse:[
				newMessage :=self buildSetterFor: aName.
				aClass compile: newMessage classified: 'accessing' notifying: nil]]! !

!AbstractTool methodsFor: 'class' stamp: 'MarcusDenker 8/28/2013 16:05'!
compileANewClassFrom: aString notifying: aController startingFrom: aClass
	
	" Copied from Browser "
	
	"The receiver's textual content is a request to define a new class. The
	source code is defString. If any errors occur in compilation, notify
	aController."
	| oldClass class newClassName defTokens keywdIx envt |
	oldClass := aClass.
	defTokens := aString findTokens: Character separators.
	
	((defTokens first = 'Trait' and: [defTokens second = 'named:'])
		or: [defTokens second = 'classTrait'])
		ifTrue: [^ self defineTrait: aString notifying: aController ].
		
	keywdIx := defTokens findFirst: [:x | x beginsWith: 'category'].
	envt := Smalltalk globals.
	keywdIx := defTokens findFirst: [:x | '*subclass*' match: x].
	newClassName := (defTokens at: keywdIx+1) copyWithoutAll: '#()'.
	((oldClass isNil or: [oldClass theNonMetaClass name asString ~= newClassName])
		and: [envt includesKey: newClassName asSymbol]) ifTrue:
			["Attempting to define new class over existing one when
				not looking at the original one in this browser..."
			(self confirm: ((newClassName , ' is an existing class in this system.
Redefining it might cause serious problems.
Is this really what you want to do?') asText makeBoldFrom: 1 to: newClassName size))
				ifFalse: [^ nil]].
	"ar 8/29/1999: Use oldClass superclass for defining oldClass
	since oldClass superclass knows the definerClass of oldClass."
	oldClass ifNotNil:[oldClass := oldClass superclass].
	class := oldClass subclassDefinerClass new
				source: aString;
				requestor: aController;
				logged: true;
				evaluate.
	^ (class isKindOf: Behavior)
		ifTrue: [ class ]
		ifFalse: [ nil ]! !

!AbstractTool class methodsFor: 'world menu' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
menuCommandOn: aBuilder  
	<worldMenu>
	(aBuilder item: #Tools)
		order: 1.0;
		target: self;
		icon: (Smalltalk ui icons iconNamed: #toolsIcon). ! !

!AbstractTool class methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/8/2013 16:27'!
protocolSuggestionsFor: aClass

	| allExistingProtocols interestingProtocols reject |
	reject := Set new.
	reject
		addAll: aClass organization categories;
		add: AllProtocol defaultName;
		add: Protocol nullCategory;
		add: Protocol unclassified.
	allExistingProtocols := Smalltalk allClassesAndTraits inject: Set new into: [ :col :e | 
		col
			addAll: e protocols;
			yourself ].
	interestingProtocols := allExistingProtocols reject: [ :e | reject includes: e ].
	^ interestingProtocols asOrderedCollection sort: [ :a :b | a asLowercase < b asLowercase ].! !

!AbstractTool class methodsFor: 'private' stamp: 'NicolaiHess 4/7/2014 22:46'!
groupBlockFor: aPackage
	^ [ aPackage orderedClasses ]! !

!AbstractTool class methodsFor: 'private' stamp: 'DamienPollet 8/6/2014 13:55'!
defineClassTemplate 
	^ '{1} subclass: #{2}
		instanceVariableNames: '''' 
		classVariableNames: ''''
		poolDictionaries: ''''
		category: ''{3}'''! !

!AbstractTool class methodsFor: 'private' stamp: 'EstebanLorenzano 10/14/2013 16:53'!
defineTraitTemplate 
	^ 'Trait named: #{1}
	uses: {2}
	category: ''{3}'''! !

!AbstractTool class methodsFor: 'world menu' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
theme
	^ Smalltalk ui theme ! !

!AbstractTool class methodsFor: 'private' stamp: 'MarcusDenker 8/23/2014 08:38'!
requestProtocolNameFor: aClass initialAnswer: aString
	| ui |
	ui := ListDialogWindow new
		getList: [ :r | (self protocolSuggestionsFor: aClass) select: [ :e | r search: e name ] ];
		displayBlock: [ :e | e ];
		initialAnswer: aString;
		acceptNewEntry: true;
		title: 'New Protocol' translated;
		yourself.
	^ ui chooseFromOwner: World! !

!AbstractTreeFilter commentStamp: '<historical>'!
I am an abstract class for tree filters.
My children should propose a filter for tree nodes!
!AbstractTreeFilter methodsFor: 'filtering' stamp: 'BenjaminVanRyseghem 4/18/2013 17:12'!
keepTreeNode: aNode

	^ false! !

!AbstractTutorial commentStamp: 'CamilloBruni 2/22/2014 19:03'!
Parent class of all Pharo tutorials.

To create your own tutorial:
- subclass AbstractTutorial
- implement a few methods which returns a Lesson instance
- implement tutorial which returns a Collection of selectors to the methods you've created.

For example, see MockTutorial (minimalist) and PharoySntaxTutorial (default PharoTutorial one).

See the PharoTutorial class comment to execute your own tutorial.!
!AbstractTutorial methodsFor: 'tutorial' stamp: 'LaurentLaffont 1/21/2010 13:51'!
lessonAt: anInteger
	| lessonSelector |
	lessonSelector := self tutorial at: anInteger.
	^ self perform: lessonSelector.! !

!AbstractTutorial methodsFor: 'accessing' stamp: 'LaurentLaffont 9/19/2010 16:35'!
lessons
	^ self tutorial collect: [:aSelector| self perform: aSelector]! !

!AbstractTutorial methodsFor: 'tutorial' stamp: 'DannyChan 2/1/2010 21:21'!
indexOfLesson: aSelector
	^self tutorial indexOf: aSelector.! !

!AbstractTutorial methodsFor: 'accessing' stamp: 'LaurentLaffont 1/21/2010 13:49'!
size
	^ self tutorial size! !

!AbstractTutorial methodsFor: 'printing' stamp: 'CamilloBruni 2/22/2014 18:44'!
printOn: aStream
	aStream 
		nextPutAll: 'a Pharo Tutorial (';
		nextPutAll: self class title;
		nextPutAll: ')'.    ! !

!AbstractTutorial methodsFor: 'tutorial' stamp: 'LaurentLaffont 1/21/2010 13:44'!
tutorial
	"Should return an Array of selectors which returns Lesson instances.
	See SmalltalkSyntaxTutorial."
	^ self shouldBeImplemented.! !

!AbstractTutorial class methodsFor: 'tutorial metainfo' stamp: 'LaurentLaffont 1/27/2010 21:02'!
title	
	"Return the title of the tutorial by parsing the class name 	
	like a Wiki link and interspersing whitespaces between the tokens"	
	| className separators groups |	
			
	className := self name.	
	separators := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.	
	groups := className findTokens: separators keep: separators.	
	^' ' join: (groups pairsCollect: [ :sep :rest | sep , rest ]).
! !

!AbstractTutorial class methodsFor: 'tutorial metainfo' stamp: 'CamilloBruni 2/22/2014 19:08'!
tutorials
	^ (self subclasses 
		sort: [:a :b |  a name < b name]) 
		select: [:aTutorial |
			(aTutorial category = 'ProfStef-Tests') not ].
! !

!AbstractTutorialTest commentStamp: 'TorstenBergmann 2/12/2014 22:51'!
SUnit tests for AbstractTutorial!
!AbstractTutorialTest methodsFor: 'tests' stamp: 'LaurentLaffont 9/21/2010 20:32'!
testLessonsReturnsAllLessonInstances
	|lessons|
	lessons := MockTutorial new lessons.
	self assert:3 equals:lessons size.
	self assert: 'first' equals: lessons first title.
	self assert: 'second' equals: (lessons at:2 ) title.
	self assert: 'third' equals: lessons last title.! !

!AbstractTutorialTest methodsFor: 'tests' stamp: 'CamilloBruni 2/22/2014 19:10'!
testTitleHumanizeClassName
	self assert: 'How To Make Your Own Tutorial' equals: HowToMakeYourOwnTutorial title.
	self assert: 'Pharo Syntax Tutorial' equals: PharoSyntaxTutorial title.! !

!AbstractTutorialTest methodsFor: 'tests' stamp: 'LaurentLaffont 4/26/2011 12:46'!
testTutorialRaisesShouldBeImplemented
	| tutorial |
	tutorial := AbstractTutorial new.
	self 
		should: [tutorial tutorial]
		raise: Error
		withExceptionDo: [:anException | 
			self 
				assert:  ShouldBeImplemented 
				equals: anException class
		].
	! !

!AbstractTutorialTest methodsFor: 'tests' stamp: 'CamilloBruni 2/22/2014 18:48'!
testTutorialsReturnsAllButMockTutorial
	| tutorials |
	tutorials := AbstractTutorial tutorials.
	self assert: (tutorials includes: PharoSyntaxTutorial).
	self assert: (tutorials includes: HowToMakeYourOwnTutorial).
	self deny: (tutorials includes: MockTutorial).! !

!AbstractWidget commentStamp: '<historical>'!
AbstractWidget is an abstraction for the different widget which could be used to compose the Nautilus UI!
!AbstractWidget methodsFor: 'accessing' stamp: ''!
model

	^ model! !

!AbstractWidget methodsFor: 'updating' stamp: ''!
update: aSymbol

	self changed: aSymbol! !

!AbstractWidget methodsFor: 'accessing' stamp: 'NicolaiHess 7/28/2014 22:25'!
model: anObject

	model ifNotNil: [  model removeDependent: self].
	anObject ifNotNil: [  anObject addDependent:self].
	model := anObject.
! !

!AbstractWidget methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 5/9/2012 11:34'!
dragTransferTypeForMorph: dragSource 

	^(dragSource isKindOf: PluggableListMorph)
		ifTrue: [ dragSource getListElementSelector ]! !

!AbstractWidget methodsFor: 'updating' stamp: 'NicolaiHess 8/9/2014 21:23'!
updateCategoryList
	self subclassResponsibility ! !

!AbstractWidget class methodsFor: 'instance creation' stamp: ''!
model: model

	^ self new
		model: model;
		yourself! !

!AbstractWidgetModel commentStamp: '<historical>'!
AbstractBasicWidget is an abstract class for basic widgets!
!AbstractWidgetModel methodsFor: 'api-focus' stamp: 'BenjaminVanRyseghem 5/4/2013 22:42'!
eventKeyStrokesForPreviousFocus
	"String describing the keystroke to perform to jump to the next widget"
	
	^ { Character arrowLeft asKeyCombination. Character tab shift asKeyCombination}! !

!AbstractWidgetModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:11'!
enabled
	"<api: #inspect>"
	^ enabledHolder value! !

!AbstractWidgetModel methodsFor: 'initialization' stamp: 'EstebanLorenzano 5/15/2014 17:47'!
defaultColor
	^ Smalltalk ui theme backgroundColor! !

!AbstractWidgetModel methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
dragTransformationBlock

	^ dragTransformationBlock value! !

!AbstractWidgetModel methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
dropEnabled: aBoolean

	dropEnabled value: aBoolean! !

!AbstractWidgetModel methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
dragEnabled: anObject

	dragEnabled value: anObject! !

!AbstractWidgetModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 1/24/2014 17:56'!
color: aColor

	^ color value: aColor! !

!AbstractWidgetModel methodsFor: 'initialization' stamp: 'DucasseStephane 9/10/2014 09:59'!
initialize

	super initialize.

	helpHolder := nil asValueHolder.
	borderWidth := 0 asValueHolder.
	borderColor := Color transparent asValueHolder.
	enabledHolder := true asValueHolder.
	dragEnabled := false asValueHolder.
	dropEnabled := false asValueHolder.
	dragTransformationBlock := [ :item :source | item ] asValueHolder.
	wantDropBlock := [ :draggedItem :event :source | self dropEnabled ] asValueHolder.
	acceptDropBlock := [ :draggedItem :event :source | ] asValueHolder.
	transferBlock := [:passenger :source | super transferFor: passenger from: source ] asValueHolder.
	color := self defaultColor asValueHolder.
	
	helpHolder whenChangedDo: [:string | 
		self widget ifNotNil: [:w | w update: #setBalloonText: with: { string } ] ].
	
	borderWidth whenChangedDo: [:int | 
		self widget ifNotNil: [:w | w update: #borderWidth: with: { int } ] ].
	
	borderColor whenChangedDo: [:newColor | 
		self widget ifNotNil: [:w | w update: #borderColor: with: { newColor } ] ].
	
	color whenChangedDo: [:newColor | 
		self widget ifNotNil: [:w | w update: #color: with: { newColor } ] ].
	
	enabledHolder whenChangedDo: [:b |
		self widget ifNotNil: [:w | w update: #enabled: with: { b } ] ].
	
	dragEnabled whenChangedDo: [:b |
		self widget ifNotNil: [:w | w update: #dragEnabled: with: { b } ] ].
	
	dropEnabled whenChangedDo: [:b |
		self widget ifNotNil: [:w | w update: #dropEnabled: with: { b } ] ].! !

!AbstractWidgetModel methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
dropEnabled

	^ dropEnabled value! !

!AbstractWidgetModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:12'!
borderColor
	"<api: #inspect>"
	"Return the border color"
	
	^ borderColor value! !

!AbstractWidgetModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:53'!
borderWidth: anInteger
	"<api: #integer min:0 max: 5 getter:#borderWidth registration: #whenBorderWidthChanged:>"
	"Set the border width"
	
	borderWidth value: anInteger! !

!AbstractWidgetModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:31'!
whenHelpChanged: aBlock
	"Set a block to be performed when the help changed"
	
	helpHolder whenChangedDo: aBlock! !

!AbstractWidgetModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:04'!
borderWidth
	"<api: #inspect>"
	"Return the border width"
	
	^ borderWidth value! !

!AbstractWidgetModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:59'!
enable
	"<api: #do>"
	"Enable the label"
	
	self enabled: true! !

!AbstractWidgetModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:55'!
enabled: aBoolean
	"<api: #boolean getter: #enabled registration: #whenEnabledChanged:>"
	"Set if the button is enabled (clickable)"
	
	enabledHolder value: aBoolean! !

!AbstractWidgetModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:49'!
help: aString
	"<api: #string getter:#help registration: #whenHelpChanged:>"
	"Set the help string"
	
	helpHolder value: aString! !

!AbstractWidgetModel methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
acceptDropBlock: aBlock

	acceptDropBlock value: aBlock! !

!AbstractWidgetModel methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
dragTransformationBlock: aBlock

	dragTransformationBlock value: aBlock! !

!AbstractWidgetModel methodsFor: 'api-focus' stamp: 'BenjaminVanRyseghem 5/4/2013 22:42'!
eventKeyStrokesForNextFocus
	"String describing the keystroke to perform to jump to the next widget"
	
	^ { Character arrowRight asKeyCombination. Character tab asKeyCombination}! !

!AbstractWidgetModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:16'!
disable
	"<api: #do>"
	"Disable the label"
	
	self enabled: false! !

!AbstractWidgetModel methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 6/12/2012 18:10'!
initializeWidgets 
	"ignore this method since there is no composition in basic widgets"! !

!AbstractWidgetModel methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
acceptDropBlock

	^ acceptDropBlock value! !

!AbstractWidgetModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:30'!
whenBorderWidthChanged: aBlock
	"Set a block to be performed when the brder width changed"
	
	borderWidth whenChangedDo: aBlock! !

!AbstractWidgetModel methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
transferBlock: aBlock

	transferBlock value: aBlock! !

!AbstractWidgetModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 1/24/2014 17:56'!
color

	^ color value! !

!AbstractWidgetModel methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
wantDropBlock: aBlock

	wantDropBlock value: aBlock! !

!AbstractWidgetModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:29'!
whenBorderColorChanged: aBlock
	"Set a block to be performed when the brder width changed"
	
	borderColor whenChangedDo: aBlock! !

!AbstractWidgetModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:00'!
help
	"<api: #inspect>"
	"Return the ballon text"
	
	^ helpHolder value! !

!AbstractWidgetModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:21'!
borderColor: aColor
	"<api: #color getter:#borderColor registration: #whenBorderColorChanged:>"
	"Set the border width"
	
	borderColor value: aColor ! !

!AbstractWidgetModel methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
dragEnabled

	^ dragEnabled value! !

!AbstractWidgetModel methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
transferBlock

	^ transferBlock value! !

!AbstractWidgetModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:31'!
whenEnabledChanged: aBlock
	"Set a block to performed when the widget is enabled or disabled"
	
	enabledHolder whenChangedDo: aBlock! !

!AbstractWidgetModel methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
wantDropBlock

	^ wantDropBlock value! !

!AbstractWidgetModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/13/2014 15:31'!
defaultSpec

	^ { self adapterName. #adapt:. #model }! !

!AbstractWidgetModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/13/2014 15:31'!
adapterName

	^ self subclassResponsibility! !

!AccessorInstanceVariableSlot commentStamp: 'MarcusDenker 2/6/2015 17:09'!
NOTE: this is an example of what can be done with Slots. It is *not* an example of what *should* be done with Slots.

I am a slot that compiles accessor methods in the Class that it is installes in.  When the slot is removed, the accessors are removed, too.

This example shows how Slots can change the class that they are part of.!
!AccessorInstanceVariableSlot methodsFor: 'class building' stamp: 'MarcusDenker 2/6/2015 17:04'!
installingIn: aClass
	| reader writer | 
	
	reader := String streamContents: [ :str |
		str 
			nextPutAll: self name;
			cr;tab;
			nextPutAll: ' ^';
			nextPutAll: self name.
		 ].
	writer := String streamContents: [ :str |
		str 
			nextPutAll: self name;
			nextPutAll: ': anObject';
			cr;tab;
			nextPutAll: self name;
			nextPutAll: ':= anObject.'.
		].
	aClass compile: reader classified: 'accessing'.
	aClass compile: writer classified: 'accessing'.! !

!AccessorInstanceVariableSlot methodsFor: 'class building' stamp: 'MarcusDenker 2/6/2015 17:05'!
removingFrom: aClass
	
	aClass removeSelector: self name.
	aClass removeSelector: self name asMutator.
	! !

!ActiveMetaContext commentStamp: 'MarcusDenker 3/11/2015 08:45'!
I am a process local variable that stores the currently active meta level !
!AddedField commentStamp: '<historical>'!
I represent the change of a newly added field on an instance.!
!AddedField methodsFor: 'installing' stamp: 'ToonVerwaest 3/28/2011 17:07'!
installOn: aModification
	aModification installAddedSlot: self! !

!AddedField methodsFor: 'accessing' stamp: 'ToonVerwaest 3/28/2011 17:19'!
newFieldIndex
	^ newSlot index + fieldIndex! !

!AddedField methodsFor: 'accessing' stamp: 'ToonVerwaest 3/28/2011 19:48'!
name
	^ newSlot name! !

!AddedField methodsFor: 'accessing' stamp: 'ToonVerwaest 3/28/2011 16:35'!
newSlot
	^ newSlot! !

!AddedField methodsFor: 'accessing' stamp: 'ToonVerwaest 3/28/2011 16:35'!
newSlot: anObject
	newSlot := anObject! !

!AdditionalMethodState commentStamp: '<historical>'!
I am class holding state for compiled methods. All my instance variables should be actually part of the CompiledMethod itself, but the current implementation of the VM doesn't allow this.  Currently I hold the selector and any pragmas or properties the compiled method has.  Pragmas and properties are stored in indexable fields; pragmas as instances of Pragma, properties as instances of Association.

I am a reimplementation of much of MethodProperties, but eliminating the explicit properties and pragmas dictionaries.  Hence I answer true to isMethodProperties.!
!AdditionalMethodState methodsFor: 'testing' stamp: 'eem 12/3/2013 11:42'!
analogousCodeTo: aMethodProperties
	| bs |
	self class == aMethodProperties class ifFalse:
		[^false].
	(bs := self basicSize) = aMethodProperties basicSize ifFalse:
		[^false].
	1 to: bs do:
		[:i|
		((self basicAt: i) analogousCodeTo: (aMethodProperties basicAt: i)) ifFalse:
			[^false]].
	^true! !

!AdditionalMethodState methodsFor: 'decompiling' stamp: 'eem 6/11/2009 17:06'!
method: aMethodNodeOrNil
	"For decompilation"
	method := aMethodNodeOrNil! !

!AdditionalMethodState methodsFor: 'accessing' stamp: 'md 2/16/2006 17:50'!
selector
	^selector! !

!AdditionalMethodState methodsFor: 'copying' stamp: 'eem 9/16/2011 11:27'!
copyWithout: aPropertyOrPragma "<Association|Pragma>"
	"Answer a copy of the receiver which no longer includes aPropertyOrPragma"
	| bs copy offset |
	"no need to initialize here; we're copying all inst vars"
	copy := self class basicNew: (bs := self basicSize) - ((self includes: aPropertyOrPragma)
															ifTrue: [1]
															ifFalse: [0]).
	offset := 0.
	1 to: bs do:
		[:i|
		(self basicAt: i) = aPropertyOrPragma
			ifTrue: [offset := 1]
			ifFalse: [copy basicAt: i - offset put: (self basicAt: i) shallowCopy]].
	1 to: self class instSize do:
		[:i| copy instVarAt: i put: (self instVarAt: i)].
	^copy! !

!AdditionalMethodState methodsFor: 'accessing' stamp: 'eem 11/29/2008 14:11'!
pragmas
	"Answer the raw messages comprising my pragmas."
	| pragmaStream |
	pragmaStream := WriteStream on: (Array new: self basicSize).
	1 to: self basicSize do: [:i |
		| propertyOrPragma "<Association|Message>" |
		(propertyOrPragma := self basicAt: i) isVariableBinding ifFalse:
			[pragmaStream nextPut: propertyOrPragma]].
	^pragmaStream contents! !

!AdditionalMethodState methodsFor: 'accessing' stamp: 'eem 11/29/2008 19:32'!
removeKey: aKey ifAbsent: aBlock
	"Remove the property with aKey. Answer the value or, if aKey isn't found, answer the result of evaluating aBlock."
	
	1 to: self basicSize do: [:i |
		| propertyOrPragma "<Association|Pragma>" |
		propertyOrPragma := self basicAt: i.
		(propertyOrPragma isVariableBinding
				ifTrue: [propertyOrPragma key]
				ifFalse: [propertyOrPragma keyword])
			== aKey ifTrue:
			[^method removeProperty: aKey]].
	^aBlock value! !

!AdditionalMethodState methodsFor: 'accessing' stamp: 'CamilloBruni 4/27/2012 17:47'!
at: aKey ifPresent: aBlock
	"Lookup the given key in the receiver. If it is present, answer the value of evaluating the given block with the value associated with the key. Otherwise, answer self."
	^ aBlock value: (self at: aKey ifAbsent: [ ^ self ])! !

!AdditionalMethodState methodsFor: 'accessing' stamp: 'eem 11/29/2008 10:19'!
at: aKey
	"Answer the property value or pragma associated with aKey."
	
	^self at: aKey ifAbsent: [self error: 'not found']! !

!AdditionalMethodState methodsFor: 'testing' stamp: 'nice 11/8/2009 12:27'!
hasAtLeastTheSamePropertiesAs: aMethodProperties
	"Answer if the recever has at least the same properties as the argument.
	 N.B. The receiver may have additional properties and still answer true."
	aMethodProperties keysAndValuesDo:
		[:k :v|
		(v isKindOf: Pragma)
			"ifTrue: [Pragmas have already been checked]"
			ifFalse: [
				(self includes: k->v) ifFalse: [^false]]].
	^true! !

!AdditionalMethodState methodsFor: 'accessing' stamp: 'eem 12/1/2008 10:55'!
at: aKey ifAbsent: aBlock
	"Answer the property value or pragma associated with aKey or,
	 if aKey isn't found, answer the result of evaluating aBlock."

	1 to: self basicSize do:
		[:i |
		| propertyOrPragma "<Association|Pragma>" |
		(propertyOrPragma := self basicAt: i) key == aKey ifTrue:
			[^propertyOrPragma isVariableBinding
				ifTrue: [propertyOrPragma value]
				ifFalse: [propertyOrPragma]]].
	^aBlock value! !

!AdditionalMethodState methodsFor: 'printing' stamp: 'eem 9/14/2011 17:18'!
printOn: aStream
	super printOn: aStream.
	aStream space; nextPut: $(; print: self identityHash; nextPut: $)! !

!AdditionalMethodState methodsFor: 'testing' stamp: 'eem 12/1/2008 10:53'!
includesKey: aKey
	"Test if the property aKey or pragma with selector aKey is present."

	1 to: self basicSize do:
		[:i |
		(self basicAt: i) key == aKey ifTrue:
			[^true]].
	^false! !

!AdditionalMethodState methodsFor: 'properties' stamp: 'eem 11/29/2008 11:46'!
propertyValueAt: aKey
	"Answer the property value associated with aKey."
	
	^ self propertyValueAt: aKey ifAbsent: [ self error: 'Property not found' ].! !

!AdditionalMethodState methodsFor: 'accessing' stamp: 'eem 12/1/2008 10:54'!
at: aKey ifAbsentPut: aBlock
	"Answer the property value or pragma associated with aKey or,
	 if aKey isn't found, answer the result of evaluating aBlock."

	1 to: self basicSize do:
		[:i |
		| propertyOrPragma "<Association|Pragma>" |
		(propertyOrPragma := self basicAt: i) key == aKey ifTrue:
			[^propertyOrPragma isVariableBinding
				ifTrue: [propertyOrPragma value]
				ifFalse: [propertyOrPragma]]].
	^method propertyValueAt: aKey put: aBlock value! !

!AdditionalMethodState methodsFor: 'copying' stamp: 'eem 9/16/2011 11:26'!
copyWith: aPropertyOrPragma "<Association|Pragma>"
	"Answer a copy of the receiver which includes aPropertyOrPragma"
	| bs copy |
	(Association == aPropertyOrPragma class
	 or: [Pragma == aPropertyOrPragma class]) ifFalse:
		[self error: self class name, ' instances should hold only Associations or Pragmas.'].
	"no need to initialize here; we're copying all inst vars"
	copy := self class basicNew: (bs := self basicSize) + 1.
	1 to: bs do:
		[:i|
		copy basicAt: i put: (self basicAt: i) shallowCopy].
	copy basicAt: bs + 1 put: aPropertyOrPragma.
	1 to: self class instSize do:
		[:i| copy instVarAt: i put: (self instVarAt: i)].
	^copy! !

!AdditionalMethodState methodsFor: 'accessing' stamp: 'eem 11/29/2008 18:28'!
setMethod: aMethod
	method := aMethod.
	1 to: self basicSize do:
		[:i| | propertyOrPragma "<Association|Pragma>" |
		(propertyOrPragma := self basicAt: i) isVariableBinding ifFalse:
			[propertyOrPragma setMethod: aMethod]]! !

!AdditionalMethodState methodsFor: 'testing' stamp: 'eem 11/29/2008 13:47'!
isEmpty
	^self basicSize = 0! !

!AdditionalMethodState methodsFor: 'properties' stamp: 'eem 11/29/2008 10:28'!
includesProperty: aKey
	"Test if the property aKey is present."

	1 to: self basicSize do: [:i |
		| propertyOrPragma "<Association|Pragma>" |
		propertyOrPragma := self basicAt: i.
		(propertyOrPragma isVariableBinding
		 and: [propertyOrPragma key == aKey]) ifTrue:
			[^true]].
	^false! !

!AdditionalMethodState methodsFor: 'accessing' stamp: 'eem 11/29/2008 10:25'!
properties

	| propertyStream |
	propertyStream := WriteStream on: (Array new: self basicSize * 2).
	1 to: self basicSize do: [:i |
		| propertyOrPragma "<Association|Pragma>" |
		(propertyOrPragma := self basicAt: i) isVariableBinding ifTrue:
			[propertyStream nextPut: propertyOrPragma key; nextPut: propertyOrPragma value]].
	^IdentityDictionary newFromPairs: propertyStream contents! !

!AdditionalMethodState methodsFor: 'properties' stamp: 'eem 11/29/2008 10:18'!
propertyKeysAndValuesDo: aBlock
	"Enumerate the receiver with all the keys and values."

	1 to: self basicSize do: [:i |
		| propertyOrPragma "<Association|Pragma>" |
		(propertyOrPragma := self basicAt: i) isVariableBinding ifTrue:
			[aBlock value: propertyOrPragma key value: propertyOrPragma value]]! !

!AdditionalMethodState methodsFor: 'accessing' stamp: 'GabrielBarbuto 11/30/2010 11:30'!
method

	^method.! !

!AdditionalMethodState methodsFor: 'properties' stamp: 'lr 2/6/2006 20:48'!
removeKey: aKey
	"Remove the property with aKey. Answer the property or raise an error if aKey isn't found."
	
	^ self removeKey: aKey ifAbsent: [ self error: 'Property not found' ].! !

!AdditionalMethodState methodsFor: 'testing' stamp: 'md 2/19/2006 11:24'!
isMethodProperties
	^true! !

!AdditionalMethodState methodsFor: 'accessing' stamp: 'md 2/16/2006 17:50'!
selector: aSymbol
	selector := aSymbol! !

!AdditionalMethodState methodsFor: 'testing' stamp: 'eem 12/1/2008 10:53'!
includes: aPropertyOrPragma "<Association|Pragma>"
	"Test if the property or pragma is present."

	1 to: self basicSize do:
		[:i |
		(self basicAt: i) = aPropertyOrPragma ifTrue:
			[^true]].
	^false! !

!AdditionalMethodState methodsFor: 'testing' stamp: 'eem 12/1/2008 16:49'!
notEmpty
	^self basicSize > 0! !

!AdditionalMethodState methodsFor: 'accessing' stamp: 'Alexandre Bergel 12/21/2009 23:53'!
at: aKey put: aValue
       "Replace the property value or pragma associated with aKey."
       | keyAlreadyExists |
       keyAlreadyExists := false.

       1 to: self basicSize do:
               [:i |
               | propertyOrPragma "<Association|Pragma>" |
               (propertyOrPragma := self basicAt: i) key == aKey ifTrue: [
                       keyAlreadyExists := true.
                       propertyOrPragma isVariableBinding
                               ifTrue: [propertyOrPragma value: aValue]
                               ifFalse: [self basicAt: i put: aValue]]].

       keyAlreadyExists ifFalse: [
               method propertyValueAt: aKey put: aValue ].

       ^ aValue
! !

!AdditionalMethodState methodsFor: 'testing' stamp: 'JohanBrichau 10/7/2009 20:07'!
refersToLiteral: aLiteral 
	^ self pragmas anySatisfy: [ :pragma | pragma hasLiteral: aLiteral ]! !

!AdditionalMethodState methodsFor: 'copying' stamp: 'eem 9/14/2011 17:50'!
postCopy
	"After copying we must duplicate any associations and pragmas so they don't end up being shared."
	1 to: self basicSize do:
		[:i| self basicAt: i put: (self basicAt: i) shallowCopy]! !

!AdditionalMethodState methodsFor: 'accessing' stamp: 'eem 11/29/2008 18:36'!
keysAndValuesDo: aBlock
	"Enumerate the receiver with all the keys and values."

	1 to: self basicSize do: [:i |
		| propertyOrPragma "<Association|Pragma>" |
		(propertyOrPragma := self basicAt: i) isVariableBinding
			ifTrue: [aBlock value: propertyOrPragma key value: propertyOrPragma value]
			ifFalse: [aBlock value: propertyOrPragma keyword value: propertyOrPragma]]! !

!AdditionalMethodState methodsFor: 'properties' stamp: 'eem 11/29/2008 11:45'!
propertyValueAt: aKey ifAbsent: aBlock
	"Answer the property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock."

	1 to: self basicSize do: [:i |
		| propertyOrPragma "<Association|Pragma>" |
		propertyOrPragma := self basicAt: i.
		(propertyOrPragma isVariableBinding
		 and: [propertyOrPragma key == aKey]) ifTrue:
			[^propertyOrPragma value]].
	^aBlock value! !

!AdditionalMethodState methodsFor: 'testing' stamp: 'eem 11/29/2008 16:40'!
hasLiteralThorough: literal
	"Answer true if any literal in these properties is literal,
	 even if embedded in array structure."
	1 to: self basicSize do: [:i |
		| propertyOrPragma "<Association|Pragma>" |
		propertyOrPragma := self basicAt: i.
		(propertyOrPragma isVariableBinding
			ifTrue: [propertyOrPragma key == literal
					or: [propertyOrPragma value == literal
					or: [propertyOrPragma value isArray
						and: [propertyOrPragma value hasLiteral: literal]]]]
			ifFalse: [propertyOrPragma hasLiteral: literal]) ifTrue:
			[^true]].
	^false! !

!AdditionalMethodState methodsFor: 'testing' stamp: 'bgf 12/6/2008 12:15'!
hasLiteralSuchThat: aBlock
	"Answer true if litBlock returns true for any literal in this array, even if embedded in further array structure.
	 This method is only intended for private use by CompiledMethod hasLiteralSuchThat:"
	1 to: self basicSize do: [:i |
		| propertyOrPragma "<Association|Pragma>" |
		propertyOrPragma := self basicAt: i.
		(propertyOrPragma isVariableBinding
			ifTrue: [(aBlock value: propertyOrPragma key)
					or: [(aBlock value: propertyOrPragma value)
					or: [propertyOrPragma value isArray
						and: [propertyOrPragma value hasLiteralSuchThat: aBlock]]]]
			ifFalse: [propertyOrPragma hasLiteralSuchThat: aBlock]) ifTrue:
			[^true]].
	^false! !

!AdditionalMethodState class methodsFor: 'instance creation' stamp: 'eem 9/16/2011 11:26'!
selector: aSelector with: aPropertyOrPragma
	^(self new: 1)
		selector: aSelector;
		basicAt: 1 put: aPropertyOrPragma;
		yourself! !

!AdditionalMethodState class methodsFor: 'instance creation' stamp: 'eem 9/16/2011 11:25'!
forMethod: aMethod selector: aSelector
	^(self new: 0)
		selector: aSelector;
		setMethod: aMethod;
		yourself! !

!AdditionalMethodStateTest commentStamp: 'TorstenBergmann 2/5/2014 08:30'!
SUnit tests for AdditionalMethodState!
!AdditionalMethodStateTest methodsFor: 'tests' stamp: 'MaxLeske 1/25/2014 22:14'!
testAnalogousCodeTo
	"create a fake traitSource association property"
	| state |
	state := AdditionalMethodState new: 1.
	state 
		basicAt: 1
		put: #traitSource -> (TBehavior methodNamed: #>>).
		
	self 
		shouldnt: [ state analogousCodeTo: state ]
		raise: MessageNotUnderstood! !

!AdditionalMethodStateTest methodsFor: 'tests' stamp: 'GabrielBarbuto 11/30/2010 11:29'!
testCopy

	| copy |
	copy := atState copy.

	self deny: atState == copy.
	self assert: atState method == copy method.
	self assert: atState selector == copy selector.

	self assert: atState pragmas = copy pragmas.
	self assert: atState properties = copy properties.

	1 to: atState pragmas size do: [:index | self deny: (atState pragmas at: index) == (copy pragmas at: index)].! !

!AdditionalMethodStateTest methodsFor: 'running' stamp: 'MarcusDenker 12/6/2013 13:00'!
setUp

	| pragma |

	pragma := (Object compiledMethodAt: #at:) penultimateLiteral at: #primitive:.
	
	atState := AdditionalMethodState selector: #at: with: pragma copy.
! !

!Adler32 commentStamp: '<historical>'!
The Adler32 checksum algorithm was developed by Mark Adler for his ZLib algorithm. It is defined in IETF RFC 1950: http://tools.ietf.org/html/rfc1950#page-10.

The purpose of this class is mainly grouping as the ZipPlugin already implements Adler32. See also the comment in #update:from:to:in:

Note that Adler32 is not a CRC, strictly speaking.!
!Adler32 class methodsFor: 'primitives' stamp: 'MaxLeske 7/8/2013 21:20'!
update: adler from: start to: stop in: aCollection
	"Update crc using the Adler32 checksum technique from RFC1950"
"
        unsigned long s1 = adler & 0xffff;
        unsigned long s2 = (adler >> 16) & 0xffff;
        int n;

        for (n = 0; n < len; n++) {
          s1 = (s1 + buf[n]) % BASE;
          s2 = (s2 + s1)     % BASE;
        }
        return (s2 << 16) + s1;
"
	<primitive: 'primitiveUpdateAdler32' module: 'ZipPlugin'>
	
	| s1 s2 |
	s1 := adler bitAnd: 16rFFFF.
	s2 := (adler bitShift: -16) bitAnd: 16rFFFF.
	start to: stop do: [ :n | | b |
		b := aCollection byteAt: n.
		s1 := (s1 + b) \\ 65521.
		s2 := (s2 + s1) \\ 65521. ].
	^(s2 bitShift: 16) + s1! !

!AdvancedHelpBrowserDummy commentStamp: 'tbn 5/3/2010 19:30'!
This is a dummy for a custom Help browser that can be registered as a replacement for the HelpBrowser class.

Instance Variables
	rootTopic:		<HelpTopic>

rootTopic
	- The root help topic
!
!AdvancedHelpBrowserDummy methodsFor: 'mocking' stamp: 'tbn 5/3/2010 19:32'!
open
	isOpen := true! !

!AdvancedHelpBrowserDummy methodsFor: 'initialization' stamp: 'tbn 5/3/2010 19:34'!
initialize
	isOpen := false! !

!AdvancedHelpBrowserDummy methodsFor: 'mocking' stamp: 'tbn 5/3/2010 19:33'!
rootTopic
	^rootTopic! !

!AdvancedHelpBrowserDummy methodsFor: 'testing' stamp: 'tbn 5/3/2010 19:32'!
isOpen
	^isOpen! !

!AdvancedHelpBrowserDummy methodsFor: 'mocking' stamp: 'tbn 5/3/2010 19:33'!
rootTopic: aTopic
	rootTopic := aTopic! !

!AlertDialogWindow commentStamp: 'gvc 5/18/2007 13:52'!
Message dialog with a warning icon.!
!AlertDialogWindow methodsFor: 'visual properties' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
icon
	"Answer an icon for the receiver."
	
	^ Smalltalk ui icons warningIcon! !

!AlertDialogWindow class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
taskbarIcon
	"Answer the icon for the receiver in a task bar."

	^ Smalltalk ui icons smallWarningIcon! !

!AlexPlugin commentStamp: '<historical>'!
An AlexPlugin is a plugin which show the setUp when a test method is selected!
!AlexPlugin methodsFor: 'registration' stamp: 'BernardoContreras 10/22/2014 19:11'!
registerTo: aModel

	aModel announcer
		when: NautilusMethodSelected send: #methodSelected: to: self.! !

!AlexPlugin methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 8/21/2011 12:08'!
initialize
	
	text := ''.
	container := PanelMorph new
					color: Color transparent;
					changeTableLayout;
					cellInset: 8;
					listDirection: #topToBottom;
					cellPositioning: #topLeft;
					hResizing: #shrinkWrap;
					vResizing: #shrinkWrap.
	self buildTextMorph! !

!AlexPlugin methodsFor: 'private' stamp: 'BenjaminVanRyseghem 8/21/2011 12:03'!
updateContainer

	^ text isEmpty
		ifTrue: [ container removeMorph: textMorph.
			container hide ]
		ifFalse: [
			container addMorph: textMorph.
			container show ]! !

!AlexPlugin methodsFor: 'updating' stamp: 'MarcusDenker 4/29/2012 10:32'!
methodSelected: anAnnouncement
	
	anAnnouncement method
		ifNotNil: [:method |
			( method methodClass inheritsFrom: TestCase )
			 	ifTrue: [ text := (method methodClass lookupSelector: #setUp) sourceCode ]]
		ifNil: [ text := ''] .
	self changed: #getText.
	self updateContainer! !

!AlexPlugin methodsFor: 'private' stamp: 'BenjaminVanRyseghem 8/21/2011 11:43'!
getText

	^ text! !

!AlexPlugin methodsFor: 'private' stamp: 'BenjaminVanRyseghem 8/21/2011 11:54'!
buildTextMorph

	textMorph := PluggableTextMorph
					on: self
					text: #getText
					accept: nil! !

!AlexPlugin methodsFor: 'display' stamp: 'BenjaminVanRyseghem 8/21/2011 11:52'!
display

	^ container! !

!AlexPlugin class methodsFor: 'position' stamp: 'BenjaminVanRyseghem 8/25/2011 10:02'!
defaultPosition

	^ #middle! !

!AlexPlugin class methodsFor: 'information' stamp: 'BenjaminVanRyseghem 2/17/2012 16:42'!
description

	^ 'Display the setUp of test methods'! !

!AlignmentMorph commentStamp: 'kfr 10/27/2003 10:25'!
Used for layout.
Since all morphs now support layoutPolicy the main use of this class is no longer needed.
Kept around for compability. 
Supports a few methods not found elsewhere that can be convenient, eg. newRow
!
!AlignmentMorph methodsFor: 'adding' stamp: 'stephane.ducasse 1/15/2009 15:52'!
addARowCentered: aCollectionOfMorphs cellInset: cellInsetInteger

	^(self addARow: aCollectionOfMorphs)
		hResizing: #shrinkWrap;
		wrapCentering: #center;
		cellPositioning: #leftCenter;
		cellInset: cellInsetInteger! !

!AlignmentMorph methodsFor: 't-rotating' stamp: ''!
rotationDegrees: degrees	
	"redefined in all morphs which are using myself"! !

!AlignmentMorph methodsFor: 'initialization' stamp: 'StephaneDucasse 7/26/2014 17:40'!
defaultColor
	"answer the default color/fill style for the receiver"
	
	^ Color
		r: 0.8
		g: 1.0
		b: 0.8! !

!AlignmentMorph methodsFor: 't-rotating' stamp: ''!
forwardDirection: newDirection
	"Set the receiver's forward direction (in eToy terms)"
	self setProperty: #forwardDirection toValue: newDirection.! !

!AlignmentMorph methodsFor: 'adding' stamp: 'StephaneDucasse 7/26/2014 17:38'!
addARow: aCollectionOfMorphs

	| row |
	row := self class inARow: aCollectionOfMorphs.
	self addMorphBack: row.
	^row! !

!AlignmentMorph methodsFor: 'visual properties' stamp: 'StephaneDucasse 7/26/2014 17:21'!
setAsColumn

	self 
		listDirection: #topToBottom;
		hResizing: #spaceFill;
		extent: 1@1;
		vResizing: #spaceFill
! !

!AlignmentMorph methodsFor: 'visual properties' stamp: 'StephaneDucasse 7/26/2014 17:55'!
inARightColumn: aCollectionOfMorphs 
	
	self setAsColumn 
				 vResizing: #shrinkWrap;
				 layoutInset: 1;
				 wrapCentering: #bottomRight;
				 cellPositioning: #topCenter.
	aCollectionOfMorphs
		do: [ :each | self addMorphBack: each ].! !

!AlignmentMorph methodsFor: 't-rotating' stamp: ''!
heading
	"Return the receiver's heading"
	^ self owner 
		ifNil: [self forwardDirection]
		ifNotNil: [self forwardDirection + self owner degreesOfFlex]! !

!AlignmentMorph methodsFor: 't-rotating' stamp: ''!
forwardDirection
	"Return the receiver's forward direction (in eToy terms)"
	^self valueOfProperty: #forwardDirection ifAbsent:[0.0]! !

!AlignmentMorph methodsFor: 'visual properties' stamp: 'StephaneDucasse 7/26/2014 18:04'!
inAColumn: aCollectionOfMorphs

	self setAsColumn
			color: Color transparent;
			vResizing: #shrinkWrap;
			hResizing: #shrinkWrap;
			layoutInset: 1;
			wrapCentering: #center;
			cellPositioning: #topCenter.
	aCollectionOfMorphs do: [ :each | self addMorphBack: each ].
	^ self ! !

!AlignmentMorph methodsFor: 'adding' stamp: 'stephane.ducasse 1/15/2009 15:52'!
addARowCentered: aCollectionOfMorphs

	^(self addARow: aCollectionOfMorphs)
		hResizing: #shrinkWrap;
		wrapCentering: #center;
		cellPositioning: #leftCenter! !

!AlignmentMorph methodsFor: 'initialization' stamp: 'StephaneDucasse 7/26/2014 17:40'!
initialize
	
	super initialize.
	self
		layoutPolicy: TableLayout new;
		listDirection: #leftToRight;
	 	wrapCentering: #topLeft;
	 	hResizing: #spaceFill;
	 	vResizing: #spaceFill;
	 	layoutInset: 2;
	 	rubberBandCells: true
	
! !

!AlignmentMorph methodsFor: 'adding' stamp: 'StephaneDucasse 7/26/2014 17:36'!
addAColumn: aCollectionOfMorphs

	| col |
	col := self class inAColumn: aCollectionOfMorphs.
	self addMorphBack: col.
	^col! !

!AlignmentMorph methodsFor: 'visual properties' stamp: 'StephaneDucasse 7/26/2014 18:04'!
inARow: aCollectionOfMorphs 

	 self setAsRow 
				color: Color transparent;
				vResizing: #shrinkWrap;
				hResizing: #shrinkWrap;
				layoutInset: 1;
				wrapCentering: #center;
				cellPositioning: #leftCenter.
	aCollectionOfMorphs
		do: [ :each | self addMorphBack: each].
! !

!AlignmentMorph methodsFor: 'visual properties' stamp: 'StephaneDucasse 7/26/2014 17:22'!
setAsSpacer: aColor

	self hResizing: #spaceFill;
		vResizing: #spaceFill;
		layoutInset: 0;
		borderWidth: 0;
		extent: 1@1;
		color: aColor.! !

!AlignmentMorph methodsFor: 'testing' stamp: 'di 5/7/1998 01:20'!
isAlignmentMorph

	^ true
! !

!AlignmentMorph methodsFor: 't-rotating' stamp: ''!
prepareForRotating
	"If I require a flex shell to rotate,
	then wrap it in one and return it.
	Polygons, eg, may override to do nothing."

	^ self addFlexShell! !

!AlignmentMorph methodsFor: 'event handling' stamp: 'sw 5/6/1998 15:58'!
wantsKeyboardFocusFor: aSubmorph
	aSubmorph wouldAcceptKeyboardFocus ifTrue: [^ true].
	^ super wantsKeyboardFocusFor: aSubmorph! !

!AlignmentMorph methodsFor: 'opening' stamp: 'ar 11/9/2000 20:34'!
openInWindowLabeled: aString inWorld: aWorld

	self layoutInset: 0.
	^super openInWindowLabeled: aString inWorld: aWorld.! !

!AlignmentMorph methodsFor: 't-rotating' stamp: ''!
setDirectionFrom: aPoint
	| delta degrees |
	delta := (self transformFromWorld globalPointToLocal: aPoint) - self referencePosition.
	degrees := delta degrees + 90.0.
	self forwardDirection: (degrees \\ 360) rounded.
! !

!AlignmentMorph methodsFor: 'visual properties' stamp: 'StephaneDucasse 7/26/2014 17:21'!
setAsRow

	self
		listDirection: #leftToRight;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		borderWidth: 0
! !

!AlignmentMorph methodsFor: 't-rotating' stamp: ''!
rotationDegrees
	"Default implementation."

	^ 0.0
! !

!AlignmentMorph methodsFor: 'initialization' stamp: 'StephaneDucasse 7/26/2014 17:40'!
defaultBorderWidth
	"answer the default border width for the receiver"
	
	^ 0! !

!AlignmentMorph class methodsFor: 'instance creation' stamp: 'StephaneDucasse 7/26/2014 17:26'!
newVariableTransparentSpacer
	"Answer a space-filling instance of me of the given color."

	^ self new setAsSpacer: Color transparent
! !

!AlignmentMorph class methodsFor: 'example' stamp: 'StephaneDucasse 7/26/2014 17:43'!
columnPrototype
	"Answer a prototypical column"
	"self columnPrototype openInHand"
	<exampleWidget>
	
	| sampleMorphs aColumn |
	sampleMorphs := #(red yellow green) collect:
		[:aColor | Morph new extent: 130 @ 38; color: (Color perform: aColor); setNameTo: aColor asString; yourself].
	aColumn := self inAColumn: sampleMorphs.
	aColumn setNameTo: 'Column'.
	aColumn color: Color veryVeryLightGray.
	aColumn cellInset: 4; layoutInset: 6.
	aColumn enableDragNDrop.
	aColumn setBalloonText: 'Things dropped into here will automatically be organized into a column. Once you have added your own items here, you will want to remove the sample colored rectangles that this started with, and you will want to change this balloon help message to one of your own!!'.
	^ aColumn! !

!AlignmentMorph class methodsFor: 'instance creation' stamp: 'StephaneDucasse 7/26/2014 17:23'!
newSpacer: aColor
	"Answer a space-filling instance of me of the given color."

	^ self new setAsSpacer: aColor! !

!AlignmentMorph class methodsFor: 'instance creation' stamp: 'StephaneDucasse 7/26/2014 17:33'!
inARow: aCollectionOfMorphs
	"Answer a row-oriented AlignmentMorph holding the given collection"

	^ self new inARow: aCollectionOfMorphs! !

!AlignmentMorph class methodsFor: 'instance creation' stamp: 'StephaneDucasse 7/26/2014 17:22'!
newColumn

	^ self new setAsColumn
! !

!AlignmentMorph class methodsFor: 'example' stamp: 'StephaneDucasse 7/26/2014 17:43'!
rowPrototype
	"Answer a prototypical row"
	"self rowPrototype openInHand"
	<exampleWidget>
	
	| sampleMorphs aRow |
	sampleMorphs := (1 to: (2 + 3 atRandom)) collect:
		[:integer | EllipseMorph new extent: ((60 + (20 atRandom)) @ (80 + ((20 atRandom)))); color: Color random; setNameTo: ('egg',  integer asString); yourself].
	aRow := self inARow: sampleMorphs.
	aRow setNameTo: 'Row'.
	aRow enableDragNDrop.
	aRow cellInset: 6.
	aRow layoutInset: 8.
	aRow setBalloonText: 'Things dropped into here will automatically be organized into a row. Once you have added your own items here, you will want to remove the sample colored eggs that this started with, and you will want to change this balloon help message to one of your own!!'.
	aRow color: Color veryVeryLightGray.
	^ aRow

			! !

!AlignmentMorph class methodsFor: 'instance creation' stamp: 'StephaneDucasse 7/26/2014 17:34'!
inAColumn: aCollectionOfMorphs
	"Answer a columnar AlignmentMorph holding the given collection"

	^ self new inAColumn: aCollectionOfMorphs ! !

!AlignmentMorph class methodsFor: 'instance creation' stamp: 'StephaneDucasse 7/26/2014 17:22'!
newRow

	^ self new setAsRow! !

!AllInstVarsEyeElement commentStamp: '<historical>'!
I am an eye element for all inst vars, printing a description of all the instance vriables (usually second field in the inspector)!
!AllInstVarsEyeElement methodsFor: 'accessing' stamp: 'ClementBera 4/30/2013 11:36'!
label
	^ 'all inst vars'! !

!AllInstVarsEyeElement methodsFor: 'accessing' stamp: 'CamilloBruni 9/14/2013 17:30'!
description
	^ self host longPrintStringLimitedTo: 2000! !

!AllProtocol commentStamp: '<historical>'!
An AllProtocol is a special protocol to hanlde the "all" case!
!AllProtocol methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/12/2012 14:15'!
protocolOrganizer: anObject
	
	protocolOrganizer := anObject.! !

!AllProtocol methodsFor: 'testing' stamp: 'EstebanLorenzano 11/29/2013 16:11'!
canBeRenamed
	^ false! !

!AllProtocol methodsFor: 'accessing' stamp: 'EstebanLorenzano 11/29/2013 15:57'!
name: aString 
	self error: 'You cannot change my name'.! !

!AllProtocol methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/12/2012 14:15'!
methods

	^ self protocolOrganizer allMethods! !

!AllProtocol methodsFor: 'testing' stamp: 'EstebanLorenzano 11/29/2013 16:04'!
canBeRemoved
	^ false! !

!AllProtocol methodsFor: 'testing' stamp: 'EstebanLorenzano 6/27/2013 15:53'!
isVirtualProtocol 
	^ true! !

!AllProtocol methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/24/2012 14:50'!
name

	^ (self methods isEmpty and: [ protocolOrganizer protocols isEmpty])
		ifTrue: [ self class nullCategory ]
		ifFalse: [ name ]! !

!AllProtocol methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/12/2012 14:15'!
protocolOrganizer
	
	^ protocolOrganizer! !

!AllProtocol class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 4/12/2012 14:14'!
protocolOrganizer: protocolOrganizer

	^ self new
		protocolOrganizer: protocolOrganizer;
		yourself! !

!AllProtocol class methodsFor: 'data' stamp: 'MarcusDenker 4/11/2014 15:15'!
defaultName

	^ #'-- all --'! !

!AllocationTest commentStamp: 'StephaneDucasse 12/18/2009 12:03'!
Test originally from Andreas Raab!
!AllocationTest methodsFor: 'testing' stamp: 'MarcusDenker 8/20/2011 13:38'!
testOutOfMemorySignal
	"Ensure that OOM is signaled eventually"
	| sz |
	sz := 512*1024*1024. "work around the 1GB alloc bug"
	self should: [(1 to: 2000) collect: [:i| Array new: sz]] raise: OutOfMemory.

	"Call me when this test fails, I want your machine"
	sz := 1024*1024*1024*1024.
	self should:[Array new: sz] raise: OutOfMemory.
! !

!AllocationTest methodsFor: 'testing' stamp: 'StephaneDucasse 4/23/2010 16:11'!
testOneGigAllocation
	"Documentating a weird bug in the allocator"
	
	| sz array failed |
	failed := false.
	sz := 1024*1024*1024.
	array := [Array new: sz] on: OutOfMemory do: [:ex| failed := true].
	self assert: (failed or:[array size = sz]).
	! !

!AllocationTest methodsFor: 'testing' stamp: 'StephaneDucasse 4/23/2010 16:12'!
testOneMegAllocation
	"Documentating a weird bug in the allocator"
	
	| sz array failed |
	failed := false.
	sz := 1024*1024.
	array := [Array new: sz] on: OutOfMemory do: [:ex| failed := true].
	self assert: (failed or:[array size = sz]).
	! !

!AlphaBlendingCanvas commentStamp: 'LaurentLaffont 2/23/2011 20:17'!
see ColorMappingCanvas comment.!
!AlphaBlendingCanvas methodsFor: 'accessing' stamp: 'ar 8/8/2001 14:24'!
alpha: newAlpha
	alpha := newAlpha.! !

!AlphaBlendingCanvas methodsFor: 'accessing' stamp: 'ar 8/8/2001 14:24'!
alpha
	^alpha! !

!AlphaBlendingCanvas methodsFor: 'drawing-images' stamp: 'gvc 9/1/2008 16:31'!
image: aForm at: aPoint sourceRect: sourceRect rule: rule
	"Draw the given form. For the 'paint' combination rule use stenciling otherwise simply fill the source rectangle.
	Do a blendAlpha if the rule is blend to cope with translucent images being drawn (via translucentImage:...)."
	
	rule = Form paint ifTrue:[
		^myCanvas
			image: aForm
			at: aPoint
			sourceRect: sourceRect
			rule: Form paintAlpha
			alpha: alpha.
	].
	rule = Form over ifTrue:[
		^myCanvas
			image: aForm
			at: aPoint
			sourceRect: sourceRect
			rule: Form blendAlpha
			alpha: alpha.
	].
	rule = Form blend ifTrue:[
		^myCanvas
			image: aForm
			at: aPoint
			sourceRect: sourceRect
			rule: Form blendAlpha
			alpha: alpha.
	].! !

!AlphaBlendingCanvas methodsFor: 'initialization' stamp: 'ar 8/8/2001 14:18'!
on: aCanvas
	myCanvas := aCanvas.
	alpha := 1.0.! !

!AlphaBlendingCanvas methodsFor: 'private' stamp: 'ar 8/8/2001 14:23'!
mapColor: aColor
	aColor isColor ifFalse:[^aColor]. "Should not happen but who knows..."
	aColor isTransparent ifTrue:[^aColor].
	aColor isOpaque ifTrue:[^aColor alpha: alpha].
	^aColor alpha: (aColor alpha * alpha)! !

!AlphaImageMorph commentStamp: 'StephaneDucasse 6/23/2014 16:33'!
Displays an image with the specified alpha value (translucency) and optional scale and layout (scaled, top-right etc.).


!
!AlphaImageMorph methodsFor: 'accessing' stamp: 'GaryChambers 8/4/2011 13:04'!
layout: aSymbol
	"Set the value of layout"

	|old|
	(old := layout) = aSymbol ifTrue: [^self].
	layout := aSymbol.
	((old = #scaled or: [old = #scaledAspect]) or: [aSymbol = #scaled or: [aSymbol = #scaledAspect]])
		ifTrue: [self cachedForm: nil].
	self changed! !

!AlphaImageMorph methodsFor: 'initialization' stamp: 'gvc 9/26/2006 12:40'!
defaultColor
	"Answer the default color for the receiver."

	^Color transparent! !

!AlphaImageMorph methodsFor: 'accessing' stamp: 'gvc 1/13/2009 17:56'!
enabled
	"Answer the value of enabled"

	^enabled! !

!AlphaImageMorph methodsFor: 'geometry' stamp: 'GaryChambers 10/5/2011 15:14'!
displayBounds
	"Answer a rectangle in display coordinates that
	bounds the image (may be larger/smaller than visible area).
	Just one rep for the tiled case."

	^self layoutPosition extent: self cachedForm extent
	! !

!AlphaImageMorph methodsFor: 'accessing' stamp: 'GaryChambers 3/5/2012 13:28'!
image: aForm size: aPoint
	"Set the image to be the form scaled to the given size and padded if neccesary."

	|f|
	"Convert color forms etc. to 32 bit before resizing since scaling of ColorForm introduces degraded color resolution.
	Most noticable with grayscale forms."
	(aForm depth < 32 and: [aForm depth > 4])
		ifTrue: [f := Form extent: aPoint depth: 32.
				f fillColor: (Color white alpha: 0.003922).
				f getCanvas translucentImage: aForm at: 0@0.
				f fixAlpha]
		ifFalse: [f := aForm].
	f := f scaledToSize: aPoint.
	self autoSize
		ifTrue: [super image: f]
		ifFalse: [image := f.
				self changed].
	self cachedForm: nil.
	self changed: #imageExtent! !

!AlphaImageMorph methodsFor: 'accessing' stamp: 'gvc 9/27/2006 15:02'!
cachedForm: anObject
	"Set the value of cachedForm"

	cachedForm := anObject! !

!AlphaImageMorph methodsFor: 'initialization' stamp: 'gvc 2/3/2010 17:55'!
initialize
	"Initialize the receiver.
	Use the 32 bit depth default image to avoid
	unnecessary conversions."

	enabled := true.
	autoSize := true.
	scale := 1.0.
	layout := #topLeft.
	alpha := 1.0.
	super initialize! !

!AlphaImageMorph methodsFor: 'accessing' stamp: 'gvc 9/26/2006 09:40'!
alpha
	"Answer the value of alpha"

	^ alpha! !

!AlphaImageMorph methodsFor: 'accessing' stamp: 'gvc 10/11/2006 12:43'!
scale
	"Answer the value of scale"

	^ scale! !

!AlphaImageMorph methodsFor: 'geometry' stamp: 'StephaneDucasse 5/23/2013 18:06'!
imageRectangleFromDisplayRectangle: aRectangle
	"Answer a rectangle in (original) image coordinates that
	corresponds to the given rectangle (in relative display coordinates)."

	|db|
	db := self displayBounds .
	db area = 0 ifTrue: [^db].
	self layout == #scaledAspect ifTrue: [
		^((aRectangle translateBy: self layoutPosition negated)
			scaleBy: self form width / db width) rounded].
	self layout == #scaled ifTrue: [
		^((aRectangle translateBy: self layoutPosition negated)
			scaleBy: (self form width / db width) @ (self form height / db height)) rounded].
	^self scale = 1
		ifTrue: [aRectangle translateBy: self layoutPosition negated]
		ifFalse: [((aRectangle translateBy: self layoutPosition negated)
					scaleBy: 1 / self scale) rounded]! !

!AlphaImageMorph methodsFor: 'geometry' stamp: 'StephaneDucasse 5/23/2013 18:07'!
optimalExtent
	"Answer the optimal extent for the receiver."
	
	^self form extent * self scale + (self borderWidth * 2)! !

!AlphaImageMorph methodsFor: 'accessing' stamp: 'gvc 8/8/2007 15:34'!
alpha: anObject
	"Set the value of alpha"

	alpha := anObject.
	self
		cachedForm: nil;
		changed;
		changed: #alpha! !

!AlphaImageMorph methodsFor: 'accessing' stamp: 'gvc 1/13/2009 17:57'!
enabled: anObject
	"Set the value of enabled"

	enabled := anObject.
	self
		cachedForm: nil;
		changed! !

!AlphaImageMorph methodsFor: 'accessing' stamp: 'gvc 9/28/2006 14:15'!
image: anImage 
	"Clear the cached form."
	
	^self image: anImage size: anImage extent! !

!AlphaImageMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 5/23/2013 18:07'!
scaledImage
	"Answer the image scaled as required."
	
	|i|
	i := self form.
	i boundingBox area = 0 ifTrue: [^i].
	(self layout == #scaled and: [self extent ~= i extent]) ifTrue: [
		^i magnify: i boundingBox by: (self extent / i extent) smoothing: 2].
	(self layout == #scaledAspect and: [self extent ~= i extent]) ifTrue: [
		^self width / i width > (self height / i height)
			ifTrue: [i magnify: i boundingBox by: (self height / i height) smoothing: 2]
			ifFalse: [i magnify: i boundingBox by: (self width / i width) smoothing: 2]].
	self scale ~= 1 ifTrue: [
		^i magnify: i boundingBox by: self scale smoothing: 2].
	^i! !

!AlphaImageMorph methodsFor: 'accessing' stamp: 'GaryChambers 8/4/2011 13:04'!
layoutSymbols
	"Answer the available layout options."

	^#(#center #tiled #scaled #scaledAspect
		#topLeft #topCenter #topRight #rightCenter
		#bottomRight #bottomCenter #bottomLeft #leftCenter)! !

!AlphaImageMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 5/23/2013 18:06'!
imageExtent
	"Answer the extent of the original form."

	^self form extent! !

!AlphaImageMorph methodsFor: 'accessing' stamp: 'GaryChambers 8/30/2011 15:22'!
getImageSelector

	^ getImageSelector! !

!AlphaImageMorph methodsFor: 'accessing' stamp: 'GaryChambers 8/30/2011 15:23'!
update: aSymbol
	"Update the image if changed."
	
	super update: aSymbol.
	aSymbol = self getImageSelector ifTrue: [
		self updateImage]! !

!AlphaImageMorph methodsFor: 'drawing' stamp: 'gvc 8/8/2007 16:25'!
drawOn: aCanvas
	"Draw with the current alpha
	Can't do simple way since BitBlt rules are dodgy!!."
	
	aCanvas fillRectangle: self bounds fillStyle: self fillStyle borderStyle: self borderStyle.
	(self cachedForm width = 0 or: [self cachedForm height = 0]) ifTrue: [^self].
	self layout == #tiled
		ifTrue: [aCanvas fillRectangle: self innerBounds fillStyle: (AlphaInfiniteForm with: self cachedForm)]
		ifFalse: [aCanvas clipBy: self innerBounds during: [:c |
					c translucentImage: self cachedForm at: self layoutPosition]]! !

!AlphaImageMorph methodsFor: 'geometry' stamp: 'GaryChambers 8/4/2011 13:06'!
extent: aPoint
	"Allow as normal."
	
	self perform: #extent: withArguments: {aPoint} inSuperclass: Morph.
	(self layout = #scaled or: [self layout = #scaledAspect]) ifTrue: [self cachedForm: nil]
! !

!AlphaImageMorph methodsFor: 'geometry' stamp: 'GaryChambers 8/4/2011 13:07'!
layoutPosition
	"Answer the position that the cached form should be drawn
	based on the layout"
	
	self layout == #topCenter ifTrue: [^self innerBounds topCenter - (self cachedForm width // 2 @ 0)].
	self layout == #topRight ifTrue: [^self innerBounds topRight - (self cachedForm width @ 0)].
	self layout == #rightCenter ifTrue: [^self innerBounds rightCenter - (self cachedForm width @ (self cachedForm height // 2))].
	self layout == #bottomRight ifTrue: [^self innerBounds bottomRight - self cachedForm extent].
	self layout == #bottomCenter ifTrue: [^self innerBounds bottomCenter - (self cachedForm width // 2 @ self cachedForm height)].
	self layout == #bottomLeft ifTrue: [^self innerBounds bottomLeft - (0 @ self cachedForm height)].
	self layout == #leftCenter ifTrue: [^self innerBounds leftCenter - (0 @ (self cachedForm height // 2))].
	(self layout == #center or: [self layout == #scaledAspect]) ifTrue: [^self innerBounds center - (self cachedForm extent // 2)].
	^self innerBounds topLeft! !

!AlphaImageMorph methodsFor: 'accessing' stamp: 'gvc 10/11/2006 12:00'!
layout
	"Answer the value of layout"

	^ layout! !

!AlphaImageMorph methodsFor: 'accessing' stamp: 'GaryChambers 8/30/2011 15:32'!
model

	^ model! !

!AlphaImageMorph methodsFor: 'accessing' stamp: 'GaryChambers 8/30/2011 15:35'!
updateImage
	"Get the image from the model."
	
	(self model notNil and: [self getImageSelector notNil]) ifTrue: [
		(self model perform: self getImageSelector) ifNotNil: [:i | self image: i]]! !

!AlphaImageMorph methodsFor: 'accessing' stamp: 'GaryChambers 8/30/2011 15:22'!
getImageSelector: anObject

	getImageSelector := anObject! !

!AlphaImageMorph methodsFor: 'accessing' stamp: 'GaryChambers 8/4/2011 12:59'!
cachedForm
	"Answer the value of cachedForm"
	
	|form i effectiveAlpha|
	cachedForm ifNil: [
		i := self scaledImage.
		effectiveAlpha := self enabled
			ifTrue: [self alpha]
			ifFalse: [self alpha / 2].
		effectiveAlpha = 1.0
			ifTrue: [self cachedForm: i]
			ifFalse: [form := Form extent: i extent depth: 32.
					form fillColor: (Color white alpha: 0.003922).
					(form getCanvas asAlphaBlendingCanvas: effectiveAlpha)
						drawImage: i
					at: 0@0.
					self cachedForm: form]].
	^cachedForm! !

!AlphaImageMorph methodsFor: 'accessing' stamp: 'gvc 2/3/2010 17:46'!
autoSize: anObject
	"Set the value of autoSize"

	autoSize := anObject! !

!AlphaImageMorph methodsFor: 'accessing' stamp: 'gvc 8/8/2007 15:34'!
scale: aNumber
	"Set the value of scale"

	scale = aNumber ifTrue: [^self].
	scale := aNumber.
	self
		cachedForm: nil;
		changed;
		changed: #scale! !

!AlphaImageMorph methodsFor: 'initialization' stamp: 'gvc 12/3/2007 11:37'!
defaultImage
	"Answer the default image for the receiver."

	^DefaultImage ifNil: [DefaultImage := DefaultForm asFormOfDepth: 32]! !

!AlphaImageMorph methodsFor: 'accessing' stamp: 'gvc 2/3/2010 17:46'!
autoSize
	"Answer the value of autoSize"

	^ autoSize! !

!AlphaImageMorph methodsFor: 'accessing' stamp: 'GaryChambers 8/30/2011 15:33'!
model: anObject
	"Set my model and make me me a dependent of the given object."

	model ifNotNil: [model removeDependent: self].
	anObject ifNotNil: [anObject addDependent: self].
	model := anObject
! !

!AlphaImageMorph class methodsFor: 'instance creation' stamp: 'GaryChambers 9/8/2011 10:35'!
defaultImage: aForm
	"Set the default image used for new instances of the receiver."

	DefaultImage := aForm! !

!AlphaInfiniteForm commentStamp: 'gvc 5/18/2007 13:49'!
Alpha aware InfiniteForm.!
!AlphaInfiniteForm methodsFor: 'accessing' stamp: 'gvc 10/7/2008 14:00'!
extent
	"Answer the extent of the repeating area."

	^extent ifNil: [SmallInteger maxVal @ SmallInteger maxVal]! !

!AlphaInfiniteForm methodsFor: 'accessing' stamp: 'gvc 10/3/2008 12:48'!
extent: anObject
	"Set the value of extent"

	extent := anObject! !

!AlphaInfiniteForm methodsFor: 'accessing' stamp: 'gvc 10/3/2008 12:42'!
origin
	"Answer the origin."
	
	^origin ifNil: [0@0]! !

!AlphaInfiniteForm methodsFor: 'accessing' stamp: 'gvc 12/3/2008 17:09'!
direction: aPoint
	"Ignore"
! !

!AlphaInfiniteForm methodsFor: 'displaying' stamp: 'gvc 10/7/2008 13:59'!
computeBoundingBox 
	"Refer to the comment in DisplayObject|computeBoundingBox."

	^self origin extent: self extent! !

!AlphaInfiniteForm methodsFor: 'displaying' stamp: 'gvc 8/10/2009 11:42'!
displayOnPort: aPort offsetBy: offset

	| targetBox patternBox savedMap top left |

	aPort destForm depth < 32 ifTrue: [^super displayOnPort: aPort offsetBy: offset].
	"this version tries to get the form aligned where the user wants it and not just aligned with the cliprect"

	(patternForm isForm) ifFalse: [
		"patternForm is a Pattern or Color; just use it as a mask for BitBlt"
		^ aPort fill: aPort clipRect fillColor: patternForm rule: Form over].

	"do it iteratively"
	targetBox := aPort clipRect.
	patternBox := patternForm boundingBox.
	savedMap := aPort colorMap.
	aPort sourceForm: patternForm;
		fillColor: nil;
		combinationRule: Form blend;
		sourceRect: (0@0 extent: patternBox extent);
		colorMap: (patternForm colormapIfNeededFor: aPort destForm).
	top := (targetBox top truncateTo: patternBox height) + offset y.
	left :=  (targetBox left truncateTo: patternBox width) + offset x.

	left to: (targetBox right - 1) by: patternBox width do:
		[:x | top to: (targetBox bottom - 1) by: patternBox height do:
			[:y | aPort destOrigin: x@y; copyBits]].
	aPort colorMap: savedMap.
! !

!AlphaInfiniteForm methodsFor: 'accessing' stamp: 'gvc 10/3/2008 12:42'!
origin: aPoint
	"Set the origin."

	origin := aPoint! !

!AlphaInfiniteForm methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/6/2015 18:25'!
asAthensPaintOn: canvas
	^ (canvas surface createFormPaint: self asForm)
		repeat;
		origin: self origin;
		direction: self direction;
		extent: self extent;
		yourself! !

!AmbiguousSelector commentStamp: 'nice 2/23/2010 15:40'!
An AmbiguousSelector is a notification produced by the Scanner/Parser/Compiler when encountering this ambiguous construct:

1@-2

Upper expression can be interpreted both
1 @ -2 (regular st-80 and former Squeak syntax, the minus is attached to the literal number)
1 @- 2 (extended binary selector, the minus sign is allowed at any position and thus part of the binary selector)
!
!AmbiguousSelector methodsFor: 'private' stamp: 'nice 2/23/2010 16:51'!
setName: aString range: anInterval 
	name := aString.
	interval := anInterval! !

!AmbiguousSelector methodsFor: 'handling' stamp: 'nice 3/5/2010 22:54'!
openMenuIn: aBlock 
	"Ask the user which selector to choose.
	Answer the choosen selector or nil if cancellation is requested."
	
	| labels actions lines caption choice |
	labels := {
		'Yes I want selector ' , name , ' with positive argument'.
		'Oops, I want ' , (name copyFrom: 1 to: name size - 1) , ' with negative argument'.
		'cancel, I must think twice'}.
	actions := {
		name.
		name copyReplaceFrom: name size to: name size - 1 with: ' '.
		nil.
	}.
	lines := {2}.
	caption := 'Ambiguous selector: ' , name , ' please correct, or cancel:'.
	choice := aBlock value: labels value: lines value: caption.
	self resume: (actions at: choice ifAbsent: [nil])! !

!AmbiguousSelector class methodsFor: 'instance creation' stamp: 'nice 2/23/2010 16:52'!
signalName: aString inRange: anInterval 
	^ (self new setName: aString range: anInterval) signal! !

!AndreasSystemProfiler commentStamp: '<historical>'!
AndreasSystemProfiler uses sub-msec VM supported PC sampling.

	In Memory of Andreas Raab.  Author, Friend, Colleague. 	http://forum.world.st/In-Memory-of-Andreas-Raab-td4663424.html
	Released by Ron, Julie and David

Example:
AndreasSystemProfiler spyOn: [ 10000 timesRepeat: [ 3.14159 printString ] ]

-=-=-=-=-=-=-=
Apparently, the time taken to run the provided block is as twice as long as run without the profiler.

-=-=-=-=-=-=-=
Both AndreasSystemProfiler and MessageTally are periodic sampling profilers.  The essential difference between AndreasSystemProfiler and MessageTally is in how the current method is sampled.

MessageTally is driven from a high-priority process in a loop waiting on a delay.  When the delay fires the lower-priority process being profiled is interrupted, its stack is walked to determine the methods along the call chain, and that data is recorded.  But since the sampling occurs when the high-priority process preempts the lower-priority process, a sample is only taken at a preemption point.  In particular, primitives are *not* profiled because they are not suspension points.  A process can only be suspended on method activation (a non-primitive method activation, or primitive failure) or on backward branch.  The cost of primitives is charged to a caller and is inferred by subtracting the cost of children of the caller from the caller itself (subtracting the number of samples in children of the caller form the number of samples in the caller itself).  

Another problem is that using the clock that underlies Delay, which is typically the clock used by processes being profiled, causes sampling errors due to the sampling and sampled processes cohering.  Delays are limited in resolution (at best 1 millisecond) so if the profiled process waits on a delay it'll fire immediately after the profiling process (because the profiling process is at higher priority) and so the sampling process may only ever see the sampled process in a wait state.

If MessageTally is used to profile multiple processes then a third problem is that if a primitive causes a process switch then its cost will end up being charged to the process switched-to, not switched from.  This is again because sampling can only occur after a primitive has completed (successfully or not).

AndreasSystemProfiler is driven from a high-priority process in a loop waiting on a Semaphore known to the VM.  The profiling process uses a primitive to schedule a sample some number of ticks of the VM's high-performance clock in the future.  When the time is reached the VM samples the current method and the current process, *before any process preemption takes place*, and independently of the standard clock, and signals the semaphore.  The profiling process then collects the method,process pair via primitives.  So AndreasSystemProfiler provides much more accurate results.

That said there are still limitations with primitives and Cog.  Currently Cog only samples "interpreter" primitives.  Those primitives it implements in machine code (integer and float arithmetic, closure evaluation, at:, identityHash) are not sampled and won't show up; they will be charged to the calling method.  This is fixable, since Cog actually compiles the sampling direct into interpreter primitive invocation when profiling is in effect and not at other times, but sampling could be a significant cost in these simple and performance-critical primitives.!
!AndreasSystemProfiler methodsFor: 'profiling' stamp: 'AlexandreBergel 1/29/2013 10:31'!
spyOn: aBlock
	"Profile system activity during execution of aBlock. 
	The argument is the desired samples per *milli* second.
	Mostly for polymorphism with MessageTally."
	self startProfiling.
	aBlock ensure: [ self stopProfiling ]
! !

!AndreasSystemProfiler methodsFor: 'reporting' stamp: 'RJT 1/23/2013 15:28'!
doReport
	"Report the results of this profiler run"
	UIManager default edit: self report label: 'Spy Results'.! !

!AndreasSystemProfiler methodsFor: 'reporting' stamp: 'AlexandreBergel 1/29/2013 10:30'!
report
	"Answer a report, with cutoff percentage of each element of the tree"
	^String streamContents: [ :s | self report: s ]! !

!AndreasSystemProfiler methodsFor: 'profiling' stamp: 'AlexandreBergel 1/29/2013 10:32'!
stopProfiling
	"Stop the profiler process"
	Smalltalk profileSemaphore: nil.
	Smalltalk profileStart: 0. "<- profile stops now"
	totalTime := Time millisecondClockValue - startTime.
	Smalltalk vm getParameters keysAndValuesDo: [ :idx :value | 
		value isInteger ifTrue: [ vmStats at: idx put: (value - ((vmStats at: idx) ifNil: [ 0 ])) ].
	].
	profilerProcess ifNotNil: [
		profilerProcess suspend.
		profilerProcess := nil.
	].
! !

!AndreasSystemProfiler methodsFor: 'profiling' stamp: 'AlexandreBergel 1/29/2013 10:31'!
runProfilerProcess
	"Run the profiler process"
	| process tallyStart tallyTicks tallyStop method leaf |
	tallyRoot := QSystemTally new class: nil method: nil.
	totalTally := 0.
	Smalltalk profileSemaphore: semaphore.
	totalTicks := 0.
	tallyStart := tallyStop := Smalltalk highResClock.
	[ true ] whileTrue: [
		tallyStart := tallyStop.
		tallyStart := Smalltalk highResClock.
		Smalltalk profileStart: ticks. "run for n ticks"
		semaphore wait.
		tallyStop := Smalltalk highResClock.
		tallyTicks := tallyStop - tallyStart.
		totalTicks := totalTicks + tallyTicks.
		process := Smalltalk profileSample.
		method := Smalltalk profilePrimitive.
		totalTally := totalTally + 1.
		process ifNotNil:[
			leaf := tallyRoot tally: (process suspendedContext ifNil: [ thisContext ] ) by: tallyTicks.
			method ifNotNil: [ leaf tallyMethod: method by: tallyTicks ].
		].
	].
! !

!AndreasSystemProfiler methodsFor: 'reporting' stamp: 'AlexandreBergel 1/29/2013 10:12'!
reportProcessStatsOn: str
	| totalSwitches pageOverflows pageDivorces actualSwitches |
	vmStats size >= 61 ifFalse: [ ^ self ]. "don't try this on the closure VM"
	totalSwitches := vmStats at: 56.
	actualSwitches := totalSwitches - (2*totalTally). "exclude to/from profiler"
	pageOverflows := vmStats at: 60.
	pageDivorces := vmStats at: 61.

	str cr.
	str nextPutAll: '**Processes**'; cr.
	str tab; nextPutAll: 'Total process switches: ', totalSwitches printString; cr.
	str tab; nextPutAll: 'Without Profiler: ', actualSwitches printString; cr.
	str tab; nextPutAll: 'Stack page overflows: ', pageOverflows printString; cr.
	str tab; nextPutAll: 'Stack page divorces: ', pageDivorces printString; cr.
! !

!AndreasSystemProfiler methodsFor: 'reporting' stamp: 'ClementBera 7/26/2013 16:01'!
report: strm cutoff: threshold 
	tallyRoot ifNil: [ strm nextPutAll: 'The profiler has not been run'. ^ self ].
	
	tallyRoot tally isZero
		ifTrue: [ strm nextPutAll: ' - no tallies obtained' ] 
		ifFalse: [
			strm nextPutAll: 'Reporting - ', totalTally asStringWithCommas,' tallies, ',
							 totalTime asStringWithCommas, ' msec.'; cr; cr.
			tallyRoot fullPrintOn: strm tallyExact: false orThreshold: threshold time: totalTime.
	].

	totalTime isZero ifFalse: [
		self reportGCStatsOn: strm.
		self reportProcessStatsOn: strm.
	].! !

!AndreasSystemProfiler methodsFor: 'profiling' stamp: 'AlexandreBergel 1/29/2013 10:31'!
startProfiling
	"Start the profiler process taking samplesPerMsec samples per *milli* second"
	| t0 |
	semaphore := Semaphore new.
	"Run a 100 msec busy loop to figure out the ticks per msec"
	t0 := Time millisecondClockValue + 2.
	[Time millisecondClockValue >= t0] whileFalse.
	ticksPerMSec := Smalltalk highResClock.
	[Time millisecondClockValue >= (t0 + 100)] whileFalse.
	ticksPerMSec := (Smalltalk highResClock - ticksPerMSec) 
			// (Time millisecondClockValue - t0).
	"Try to get 10 samples per msec"
	ticks := ticksPerMSec // 10.
	startTime := Time millisecondClockValue.
	vmStats := Smalltalk vm getParameters.
	profilerProcess := [ self runProfilerProcess ] forkAt: Processor timingPriority - 1.
! !

!AndreasSystemProfiler methodsFor: 'reporting' stamp: 'RJT 1/23/2013 15:28'!
report: strm 
	"Print a report, with cutoff percentage of each element of the tree 
	(leaves, roots, tree)=2, on the stream, strm."

	self report: strm cutoff: 1! !

!AndreasSystemProfiler methodsFor: 'reporting' stamp: 'RJT 1/23/2013 15:28'!
reportGCStatsOn: str
	| oldSpaceEnd youngSpaceEnd memoryEnd fullGCs fullGCTime incrGCs incrGCTime tenureCount upTime rootOverflows |
	upTime := totalTime.
	oldSpaceEnd			:= vmStats at: 1.
	youngSpaceEnd		:= vmStats at: 2.
	memoryEnd			:= vmStats at: 3.
	fullGCs				:= vmStats at: 7.
	fullGCTime			:= vmStats at: 8.
	incrGCs				:= vmStats at: 9.
	incrGCTime			:= vmStats at: 10.
	tenureCount			:= vmStats at: 11.
	rootOverflows		:= vmStats at: 22.

	str cr.
	str	nextPutAll: '**Memory**'; cr.
	str	nextPutAll:	'	old			';
		nextPutAll: oldSpaceEnd asStringWithCommasSigned; nextPutAll: ' bytes'; cr.
	str	nextPutAll: '	young		';
		nextPutAll: (youngSpaceEnd - oldSpaceEnd) asStringWithCommasSigned; nextPutAll: ' bytes'; cr.
	str	nextPutAll: '	used		';
		nextPutAll: youngSpaceEnd asStringWithCommasSigned; nextPutAll: ' bytes'; cr.
	str	nextPutAll: '	free		';
		nextPutAll: (memoryEnd - youngSpaceEnd) asStringWithCommasSigned; nextPutAll: ' bytes'; cr.

	str cr.
	str	nextPutAll: '**GCs**'; cr.
	str	nextPutAll: '	full			';
		print: fullGCs; nextPutAll: ' totalling '; nextPutAll: fullGCTime asStringWithCommas; nextPutAll: 'ms (';
		print: ((fullGCTime / upTime * 100) roundTo: 1.0);
		nextPutAll: '% uptime)'.
	fullGCs = 0 ifFalse:
		[str	nextPutAll: ', avg '; print: ((fullGCTime / fullGCs) roundTo: 1.0); nextPutAll: 'ms'].
	str	cr.
	str	nextPutAll: '	incr		';
		print: incrGCs; nextPutAll: ' totalling '; nextPutAll: incrGCTime asStringWithCommas; nextPutAll: 'ms (';
		print: ((incrGCTime / upTime * 100) roundTo: 1.0);
		nextPutAll: '% uptime)'.
	incrGCs = 0 ifFalse:
		[str nextPutAll:', avg '; print: ((incrGCTime / incrGCs) roundTo: 1.0); nextPutAll: 'ms'].
	str cr.
	str	nextPutAll: '	tenures		';
		nextPutAll: tenureCount asStringWithCommas.
	tenureCount = 0 ifFalse:
		[str nextPutAll: ' (avg '; print: (incrGCs / tenureCount) asInteger; nextPutAll: ' GCs/tenure)'].
	str	cr.
	str	nextPutAll: '	root table	';
		nextPutAll: rootOverflows asStringWithCommas; nextPutAll:' overflows'.
	str cr.
! !

!AndreasSystemProfiler class methodsFor: 'spying' stamp: 'AlexandreBergel 1/29/2013 10:21'!
spyFor: seconds
	"Run the system profiler for the specified number of seconds"
	"self spyFor: 5"
	^self spyOn: [ (Delay forSeconds: seconds) wait ].! !

!AndreasSystemProfiler class methodsFor: 'spying' stamp: 'MarcusDenker 6/14/2014 12:17'!
spyOn: aBlock
	"The main method for profiling and showing the report "

	"self spyOn: [ 10000 timesRepeat: [ 3.14159 printString ] ]"

	| profiler |
	profiler := self new.
	^ [ profiler spyOn: aBlock ]
		ensure: [ profiler doReport ]! !

!AndreasSystemProfiler class methodsFor: 'spying' stamp: 'RJT 1/23/2013 15:28'!
default
	^self new! !

!AndreasSystemProfiler class methodsFor: 'spying' stamp: 'RJT 1/23/2013 15:28'!
spyOnWorldFor: seconds
	"Run the system profiler for the specified number of seconds,
	 spying on the morphic world in which it was launched. 
	 Handy for running Workspace do-its."

	^self spyOn: [  | deadline |
		deadline := Time totalSeconds + seconds.
		[Time totalSeconds < deadline]
			whileTrue: [ World doOneCycle ]].! !

!AndreasSystemProfiler class methodsFor: 'LICENSE' stamp: 'RJT 1/23/2013 15:34'!
LICENSE
	^'Project Squeak

	In Memory of Andreas Raab.  Author, Friend, Colleague. 	http://forum.world.st/In-Memory-of-Andreas-Raab-td4663424.html
	Copyright (c) 2005-2013, 3D Immersive Collaboration Consulting, LLC., All Rights Reserved

	Redistributions in source code form must reproduce the above
	copyright and this condition.

Licensed under MIT License (MIT)
Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.'! !

!AndreasSystemProfilerTest commentStamp: 'TorstenBergmann 2/4/2014 20:45'!
SUnit tests for AndreasSystemProfiler!
!AndreasSystemProfilerTest methodsFor: 'tests tally' stamp: 'AlexandreBergel 1/29/2013 10:48'!
testPrintingTally

	self assert: tally printString =  'AndreasSystemProfilerTest>>#testPrintingTally -- 0'! !

!AndreasSystemProfilerTest methodsFor: 'tests tally' stamp: 'AlexandreBergel 1/29/2013 10:40'!
testPrintingTallyUninitialized
	
	self assert: QSystemTally new printString = 'nil>>nil -- nil'! !

!AndreasSystemProfilerTest methodsFor: 'tests tally' stamp: 'AlexandreBergel 1/29/2013 11:43'!
testFullPrintOn
	| stream |
	stream := WriteStream on: String new.
	tally 
		fullPrintOn: stream tallyExact: false orThreshold: 0 time: 10.
	
	self assert: stream contents =  '**Tree**

**Leaves**
'! !

!AndreasSystemProfilerTest methodsFor: 'tests tally' stamp: 'AlexandreBergel 1/29/2013 11:16'!
testGetNewTab
	| tabs |
	
	self assert: (tally getNewTabsFor: #()) = #().
	self assert: (tally getNewTabsFor: #(' ')) =  #(' ').
	
	tabs := OrderedCollection new.
	tabs add: '['.
	(tally maxTabs + 1) timesRepeat: [ tabs add: ' ' ].
	self assert: (tally getNewTabsFor: tabs) asArray =  #('[' '[').! !

!AndreasSystemProfilerTest methodsFor: 'tests tally' stamp: 'AlexandreBergel 1/29/2013 11:08'!
testTallyTreePrint
	| stream |
	stream := WriteStream on: String new.
	tally 
		treePrintOn: stream 
		tabs: #() 
		thisTab: nil 
		total: 50 
		totalTime: 100 
		tallyExact: true 
		orThreshold: 1.
	
	"Nothing is printed since there is no tab"
	self assert: stream contents isEmpty! !

!AndreasSystemProfilerTest methodsFor: 'tests profiler' stamp: 'CamilloBruni 8/31/2013 20:23'!
testSimpleReport
	AndreasSystemProfiler new report! !

!AndreasSystemProfilerTest methodsFor: 'tests profiler' stamp: 'CamilloBruni 8/31/2013 20:23'!
testSimple
	AndreasSystemProfiler new spyOn: [ 200 timesRepeat: [ 1.23 printString ] ]! !

!AndreasSystemProfilerTest methodsFor: 'tests tally' stamp: 'AlexandreBergel 1/29/2013 10:45'!
setUp
	tally := QSystemTally new.
	tally class: self class method: self class >> #testPrintingTally	
	"tally class: Object method: Object >> #printString."! !

!AndreasSystemProfilerTest methodsFor: 'tests tally' stamp: 'AlexandreBergel 1/29/2013 11:10'!
testTallyTreePrintWithTab
	| stream |
	stream := WriteStream on: String new.
	tally 
		treePrintOn: stream 
		tabs: #(' ')
		thisTab: nil 
		total: 50 
		totalTime: 100 
		tallyExact: true 
		orThreshold: 1.
	
	
	self assert: stream contents = ' 0 AndreasSystemProfilerTest  testPrintingTally
'! !

!AnimatedGIFReadWriter commentStamp: 'LaurentLaffont 5/4/2011 21:27'!
Read an animated GIF file.

Example: open all images of an animated GIF file in a Morphic window

gifPath :=  '/path/to/my_animated.gif'.
forms := (AnimatedGIFReadWriter formsFromFileNamed: gifPath) forms.
content := UITheme builder newRow: (forms collect: [:aForm| UITheme builder newImage: aForm]).
content openInWindowLabeled: 'Content of ', gifPath.!
!AnimatedGIFReadWriter methodsFor: 'accessing' stamp: 'mir 11/19/2003 14:16'!
forms
	^ forms! !

!AnimatedGIFReadWriter methodsFor: 'private' stamp: 'mir 11/19/2003 12:25'!
comment: aString
	comments add: aString! !

!AnimatedGIFReadWriter methodsFor: 'accessing' stamp: 'mir 11/19/2003 14:16'!
delays
	^ delays! !

!AnimatedGIFReadWriter methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
allImages
	| body colorTable |
	stream class == ReadWriteStream ifFalse: 
		[ stream binary.
		self on: (ReadWriteStream with: stream contentsOfEntireFile) ].
	localColorTable := nil.
	forms := OrderedCollection new.
	delays := OrderedCollection new.
	comments := OrderedCollection new.
	self readHeader.
	[ (body := self readBody) isNil ] whileFalse: 
		[ colorTable := localColorTable ifNil: [ colorPalette ].
		transparentIndex ifNotNil: 
			[ transparentIndex + 1 > colorTable size ifTrue: 
				[ colorTable := colorTable 
					forceTo: transparentIndex + 1
					paddingWith: Color white ].
			colorTable 
				at: transparentIndex + 1
				put: Color transparent ].
		body colors: colorTable.
		forms add: body.
		delays add: delay ].
	^ forms! !

!AnimatedGIFReadWriter methodsFor: 'private-decoding' stamp: 'mir 11/19/2003 12:21'!
readBitData
	| form |
	form := super readBitData.
	form offset: offset.
	^form! !

!AnimatedGIFReadWriter class methodsFor: 'image reading/writing' stamp: 'asm 12/11/2003 21:29'!
wantsToHandleGIFs
	^true! !

!AnimatedGIFReadWriter class methodsFor: 'image reading/writing' stamp: 'lr 7/4/2009 10:42'!
formsFromStream: stream 
	| reader |
	reader := self new on: stream reset.
	Cursor read showWhile: 
		[ reader allImages.
		reader close ].
	^ reader! !

!AnimatedGIFReadWriter class methodsFor: 'image reading/writing' stamp: 'lr 7/4/2009 10:42'!
formsFromFileNamed: fileName 
	| stream |
	stream := FileStream readOnlyFileNamed: fileName.
	^ self formsFromStream: stream! !

!AnimatedGIFReadWriter class methodsFor: 'image reading/writing' stamp: 'nk 6/12/2004 13:12'!
typicalFileExtensions
	"Answer a collection of file extensions (lowercase) which files that I can read might commonly have"
	^#('gif')! !

!AnimationSettings commentStamp: 'TorstenBergmann 2/5/2014 10:31'!
Animation settings!
!AnimationSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/15/2009 10:21'!
animateClosing
	^ animateClosing ifNil: [animateClosing := false]! !

!AnimationSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/15/2009 10:23'!
numberOfSteps: anInteger
	numberOfSteps := anInteger! !

!AnimationSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/15/2009 10:23'!
numberOfSteps
	^ numberOfSteps ifNil: [numberOfSteps := 20]! !

!AnimationSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/15/2009 10:20'!
useAnimation
	^ useAnimation ifNil: [useAnimation := false]! !

!AnimationSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/15/2009 10:22'!
delay: anInteger
	delay := anInteger! !

!AnimationSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/15/2009 10:21'!
animateClosing: aBoolean
	animateClosing := aBoolean! !

!AnimationSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/15/2009 10:21'!
useAnimation: aBoolean
	useAnimation := aBoolean! !

!AnimationSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/15/2009 10:24'!
delay
	^ delay ifNil: [delay := 8]! !

!AnnotationPanePlugin commentStamp: '<historical>'!
An IgorsPlugin is a plugin which displays info about the current selection!
!AnnotationPanePlugin methodsFor: 'private' stamp: 'StephaneDucasse 10/30/2014 08:19'!
buildString
	| mdl stringBuilder |
	mdl := self model.
	stringBuilder := WriteStream on: ''.
	mdl selectedClass
		ifNil: [ '' ]
		ifNotNil: [ :class |
			mdl selectedMethod
				ifNotNil: [:method | 
					stringBuilder nextPutAll:  (AnnotationRequest onClass: class selector: method selector) getAnnotations ]].		
	^ stringBuilder contents! !

!AnnotationPanePlugin class methodsFor: 'information' stamp: 'BenjaminVanRyseghem 2/17/2012 16:39'!
description

	^ 'Display the information of the selected class/method'! !

!AnnotationRequest methodsFor: 'initialization' stamp: 'MAD 1/14/2009 11:44'!
onClass: aClass selector: aSelector
	class := aClass.
	selector := aSelector.
	separator := ' - '.! !

!AnnotationRequest methodsFor: 'requests' stamp: 'lr 8/15/2010 17:10'!
firstComment
	"The first comment in the method, if any."
	
	^ class firstCommentAt: selector! !

!AnnotationRequest methodsFor: 'requests' stamp: 'lr 8/15/2010 17:11'!
masterComment
	"The comment at the beginning of the supermost implementor of the method if any."
	
	^ class supermostPrecodeCommentFor: selector! !

!AnnotationRequest methodsFor: 'accessing' stamp: 'dc 5/2/2007 18:14'!
separator: aString
	separator := aString! !

!AnnotationRequest methodsFor: 'accessing' stamp: 'dc 6/18/2007 18:55'!
method
	^ class compiledMethodAt: selector ifAbsent: [nil]! !

!AnnotationRequest methodsFor: 'requests' stamp: 'lr 8/15/2010 17:13'!
allChangeSets
	"A list of all change sets bearing the method."
	
	| changeSets |
	changeSets := ChangeSet 
		allChangeSetsWithClass: class
		selector: selector.
	^ changeSets isEmpty
		ifFalse: [ 
			String streamContents: [ :aStream | 
				changeSets size = 1 
					ifTrue: [ aStream nextPutAll: 'only in change set ' ]
					ifFalse: [ aStream nextPutAll: 'in change sets: ' ].
				changeSets do: [ :aChangeSet | 
					aStream
						nextPutAll: aChangeSet name;
						nextPutAll: ' ' ] ] ]
		ifTrue: [ 'in no change set' ]! !

!AnnotationRequest methodsFor: 'actions' stamp: 'MarcusDenker 7/19/2014 09:07'!
defaultAnnotationInfo
		"Answer a list of symbol characterizing all the available kinds of annotations"
		
	^  #(#timeStamp #messageCategory #implementorsCount #allChangeSets)
		
	"Each symbol represents the info type:
		#timeStamp	: 
			The time stamp of the last submission of the method.
		#firstComment: 
			The first comment in the method, if any.
		#masterComment: 
			The comment at the beginning of the supermost implementor 
			of the method if any.
		#documentation: 
			Comment at beginning of the method or, if it has none, 
			comment at the beginning of a superclass's implementation of the method.
		#messageCategory: 
			Which method category the method lies in.
		#sendersCount: 
			A report of how many senders there of the message.
		#implementorsCount: 
			A report of how many implementors there are of the message.
		#recentChangeSet	: 
			The most recent change set bearing the method.
		#allChangeSets	: 
			A list of all change sets bearing the method.
		#priorVersionsCount: 
			A report of how many previous versions there are of the method.
		#priorTimeStamp: 
			The time stamp of the penultimate submission of the method, if any.
		"
	
	
! !

!AnnotationRequest methodsFor: 'actions' stamp: 'MarcusDenker 7/19/2014 09:07'!
annotationRequests
	^ self defaultAnnotationInfo ! !

!AnnotationRequest methodsFor: 'requests' stamp: 'lr 8/15/2010 17:11'!
documentation
	"Comment at beginning of the method or, if it has none, comment at the beginning of a superclass's implementation of the method."
	
	^ class precodeCommentOrInheritedCommentFor: selector! !

!AnnotationRequest methodsFor: 'requests' stamp: 'MarcusDenker 6/27/2014 11:25'!
priorVersionsCount
	"A report of how many previous versions there are of the method."
	
	| versionsCount |
	versionsCount := class changeRecordsAt: selector.
	^ versionsCount > 1
		ifTrue: [
			versionsCount = 2
				ifTrue: [ '1 prior version' ]
				ifFalse: [ versionsCount printString, ' prior versions' ] ]
		ifFalse: [ 'no prior versions' ]! !

!AnnotationRequest methodsFor: 'requests' stamp: 'lr 8/15/2010 17:12'!
sendersCount
	"A report of how many senders there of the message."
	
	| sendersCount |
	sendersCount := (self systemNavigation allCallsOn: selector)
		size.
	^ sendersCount = 1
		ifTrue: [ '1 sender' ]
		ifFalse: [ sendersCount printString , ' senders' ]! !

!AnnotationRequest methodsFor: 'requests' stamp: 'ClementBera 7/26/2013 16:02'!
timeStamp
	"The time stamp of the last submission of the method."
	
	^ self method ifNotNil: [ self method timeStamp ]! !

!AnnotationRequest methodsFor: 'requests' stamp: 'lr 8/15/2010 17:15'!
messageCategory
	"Which method category the method lies in."
	
	^ class organization categoryOfElement: selector! !

!AnnotationRequest methodsFor: 'actions' stamp: 'lr 8/15/2010 17:10'!
getAnnotations
	^ String streamContents: [ :aStream | 
		((self annotationRequests 
			collect: [ :request | self perform: request ]) 
			reject: [ :stringOrNil | stringOrNil isEmptyOrNil ]) 
				do: [ :each | aStream nextPutAll: each ]
				separatedBy: [ aStream nextPutAll: separator ] ]! !

!AnnotationRequest methodsFor: 'requests' stamp: 'MarcusDenker 8/7/2014 16:53'!
implementorsCount
	"A report of how many implementors there are of the message."
	
	| implementorsCount |
	implementorsCount := selector implementors size.
	^ implementorsCount = 1
		ifTrue: [ '1 implementor' ]
		ifFalse: [ implementorsCount printString , ' implementors' ]! !

!AnnotationRequest methodsFor: 'requests' stamp: 'lr 8/15/2010 17:13'!
recentChangeSet
	"The most recent change set bearing the method."
	
	^ ChangeSet mostRecentChangeSetWithChangeForClass: class selector: selector! !

!AnnotationRequest class methodsFor: 'instance-creation' stamp: 'PDC 6/25/2007 22:01'!
onClass: aClass selector: aSelector
	^ self new
		onClass: aClass selector: aSelector;
		yourself! !

!Announcement commentStamp: 'Tbn 11/12/2010 10:57'!
This class is the superclass for events that someone might want to announce, such as a button click or an attribute change. Typically you create subclasses for your own events you want to announce.

 
!
!Announcement methodsFor: 'converting' stamp: 'lr 10/3/2006 14:32'!
asAnnouncement
	^ self! !

!Announcement class methodsFor: 'testing' stamp: 'StephaneDucasse 2/22/2013 17:35'!
handlesAnnouncement: anAnnouncement
	"The receiver acts as a filter to determine whether subscribers who used the receiver as signaling tag (event identifier class or symbol) should receive incoming announcement. In particular, registering to a superclass will receive the announcements from all subclasses."


	^ anAnnouncement class == self or: [ anAnnouncement class inheritsFrom: self ]! !

!Announcement class methodsFor: 'public' stamp: 'lr 9/20/2006 08:18'!
, anAnnouncementClass
	^ AnnouncementSet with: self with: anAnnouncementClass! !

!Announcement class methodsFor: 'converting' stamp: 'lr 10/3/2006 14:31'!
asAnnouncement
	^ self new! !

!Announcement class methodsFor: '*Polymorph-Widgets-Themes' stamp: 'YuriyTymchuk 12/20/2013 11:16'!
systemIcon

	^ Smalltalk ui icons iconNamed: #announcementIcon! !

!AnnouncementLogger commentStamp: 'StephaneDucasse 5/9/2011 17:17'!
Use me to debug and log to the transcript annoncements.


AnnouncementLogger new subscribeTo: SystemAnnouncer announcer

To unsubscribe

AnnouncementLogger  allInstancesDo: [:each | SystemAnnouncer announcer unsubscribe: each ]!
!AnnouncementLogger methodsFor: 'as yet unclassified' stamp: 'BernardoContreras 10/30/2014 19:30'!
subscribeTo: anAnnouncer

	anAnnouncer "weak" 
		when: Announcement send: #logAnnouncement: to: self! !

!AnnouncementLogger methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 5/9/2011 17:11'!
logAnnouncement: ann

	Transcript show: ann printString ; cr! !

!AnnouncementMockA commentStamp: 'Tbn 11/12/2010 10:54'!
This is a simple test mock.!
!AnnouncementMockB commentStamp: 'Tbn 11/12/2010 10:54'!
This is a simple test mock!
!AnnouncementMockC commentStamp: 'Tbn 11/12/2010 10:54'!
This is a simple test mock!
!AnnouncementSet commentStamp: '<historical>'!
If you want to register the same action for multiple events, simply create an AnnouncementSet using a comma: 

	Parent>>initialize 
	    super initialize. 
	    self session announcer on: AddChild, RemoveChild do: [:it | self changeChild: it child]
	
Motivation example: Often the UI is built after/independently from the model. You want to have the model raise fine-grained announcements to enable the layers on top, but sometimes it is easier in the UI to refresh everything whenever something happens.!
!AnnouncementSet methodsFor: 'adding' stamp: 'lr 6/13/2006 08:13'!
, anAnnouncementClass
	self add: anAnnouncementClass! !

!AnnouncementSet methodsFor: 'testing' stamp: 'StephaneDucasse 2/22/2013 17:36'!
handlesAnnouncement: anAnnouncement
	"If any of the set handles the announcements, subscribers should receive it."
	^ self anySatisfy: [ :each | each handlesAnnouncement: anAnnouncement ]! !

!AnnouncementSetTest commentStamp: 'TorstenBergmann 2/20/2014 15:16'!
SUnit tests for announcement sets!
!AnnouncementSetTest methodsFor: 'testing' stamp: 'Tbn 11/12/2010 11:07'!
testIncludeOnlyOnce
	|set|
	set := AnnouncementMockA, AnnouncementMockB, AnnouncementMockA.
	self assert: set size = 2! !

!AnnouncementSetTest methodsFor: 'testing' stamp: 'Sd 11/26/2010 17:31'!
testInstanceCreation
	|set|
	set := AnnouncementMockA, AnnouncementMockB.
	self assert: set size = 2 ! !

!AnnouncementSubscription commentStamp: 'IgorStasenko 3/12/2011 20:23'!
The subscription is a single entry in a SubscriptionRegistry.
Several subscriptions by the same object is possible.

I know how to make myself weak or strong, only use this capability if it can't be determined at subscribe time though, as it uses become: (for thread-safety), which is quite slow.!
!AnnouncementSubscription methodsFor: 'accessing' stamp: 'IgorStasenko 3/12/2011 15:15'!
announcer

	^ announcer! !

!AnnouncementSubscription methodsFor: 'accessing' stamp: 'IgorStasenko 3/12/2011 15:14'!
subscriber
	^ subscriber! !

!AnnouncementSubscription methodsFor: 'accessing' stamp: 'IgorStasenko 3/12/2011 15:16'!
valuable: aValuable
	"Used when subscriber should be extracted from valuable object"
	self action:  aValuable.
	self subscriber: aValuable receiver.! !

!AnnouncementSubscription methodsFor: 'converting' stamp: 'IgorStasenko 3/12/2011 17:37'!
makeStrong
	" i am already strong. Do nothing "! !

!AnnouncementSubscription methodsFor: 'accessing' stamp: 'IgorStasenko 3/12/2011 15:14'!
subscriber: aSubscriber
	subscriber := aSubscriber! !

!AnnouncementSubscription methodsFor: 'accessing' stamp: 'IgorStasenko 3/12/2011 15:15'!
action: anObject

	action := anObject! !

!AnnouncementSubscription methodsFor: 'accessing' stamp: 'IgorStasenko 3/12/2011 15:13'!
announcer: anAnnouncer
	announcer := anAnnouncer! !

!AnnouncementSubscription methodsFor: 'accessing' stamp: 'IgorStasenko 3/12/2011 15:18'!
announcementClass

	^ announcementClass! !

!AnnouncementSubscription methodsFor: 'accessing' stamp: 'IgorStasenko 3/12/2011 15:15'!
action

	^ action! !

!AnnouncementSubscription methodsFor: 'announcing' stamp: 'IgorStasenko 1/3/2012 12:22'!
deliver: anAnnouncement
	" deliver an announcement to receiver. In case of failure, it will be handled in separate process"

	^ (self handlesAnnouncement: anAnnouncement ) ifTrue: [
		[action cull: anAnnouncement cull: announcer] 
			on: UnhandledError fork: [:ex | ex pass ]]! !

!AnnouncementSubscription methodsFor: 'testing' stamp: 'IgorStasenko 1/3/2012 12:19'!
handlesAnnouncement: anAnnouncement

	^ announcementClass handlesAnnouncement: anAnnouncement! !

!AnnouncementSubscription methodsFor: 'converting' stamp: 'IgorStasenko 3/22/2011 15:41'!
makeWeak
	
	action isBlock ifTrue: [
		self error: 'Not currently available due to missing ephemerons support'
		].

	^ announcer replace: self with: 
		(WeakAnnouncementSubscription new
			announcer: announcer;
			action: action asWeakMessageSend;
			subscriber: subscriber;
			announcementClass: announcementClass)! !

!AnnouncementSubscription methodsFor: 'accessing' stamp: 'IgorStasenko 3/12/2011 15:18'!
announcementClass: anObject

	announcementClass := anObject! !

!AnnouncementsAPIDocumentation commentStamp: 'Tbn 11/12/2010 11:17'!
This is a custom help book providing the API documentation for the announcements framework.
!
!AnnouncementsAPIDocumentation class methodsFor: 'accessing' stamp: 'Tbn 11/12/2010 10:41'!
bookName
	^'API Documentation'! !

!AnnouncementsAPIDocumentation class methodsFor: 'defaults' stamp: 'Tbn 11/12/2010 10:41'!
builder
	^PackageAPIHelpBuilder! !

!AnnouncementsAPIDocumentation class methodsFor: 'accessing' stamp: 'StephanEggermont 12/9/2013 19:48'!
helpPackages
	^#('Announcements-Core' 'Announcements-View' 'Announcements-Tests-Core')! !

!AnnouncementsHelp commentStamp: 'Tbn 11/12/2010 11:17'!
This is a custom help book for the announcements framework.
!
!AnnouncementsHelp class methodsFor: 'pages' stamp: 'MarianoMartinezPeck 4/30/2011 15:42'!
links
	"This method was automatically generated. Edit it using:"
	"AnnouncementsHelp edit: #links"
	^HelpTopic
		title: 'Links'
		contents: 'You can get more informations on the framework on the following websites:

http://book.pharo-project.org/book/announcements
				
http://www.cincomsmalltalk.com/userblogs/vbykov/blogView?searchCategory=Announcements%20Framework

http://www.cincomsmalltalk.com/userblogs/vbykov/blogView?entry=3310034894

http://dougedmunds.com/pmwiki.php?n=Pharo.AnnouncementsTutorial
'! !

!AnnouncementsHelp class methodsFor: 'accessing' stamp: 'Tbn 11/12/2010 10:35'!
bookName
	^'Announcements framework'! !

!AnnouncementsHelp class methodsFor: 'accessing' stamp: 'Tbn 11/12/2010 11:30'!
pages
	^#(introduction AnnouncementsTutorial AnnouncementsAPIDocumentation links)! !

!AnnouncementsHelp class methodsFor: 'pages' stamp: 'Tbn 11/12/2010 11:18'!
introduction
	"This method was automatically generated. Edit it using:"
	"AnnouncementsHelp edit: #introduction"
	^HelpTopic
		title: 'Introduction'
		contents: 
'The announcement framwork is an event notification framework. Compared to "traditional" Smalltalk event systems in this new framework, an event is a real object rather than a symbol.

An event someone might want to announce, such as a button click or an attribute change, is defined as a subclass of the abstract superclass Announcement. The subclass can have instance variables for additional information to pass along, such as a timestamp, or mouse coordinates at the time of the event, or the old value of the parameter that has changed. To signal the actual occurrence of an event, the "announcer" creates and configures an instance of an appropriate announcement, then broadcasts that instance. Objects subscribed to receive such broadcasts from the announcer receive a broadcast notification together with the instance. They can talk to the instance to find out any additional information about the event that has occurred.!!'  ! !

!AnnouncementsTutorial commentStamp: 'Tbn 11/12/2010 11:17'!
This is a custom help book providing a tutorial for the announcements framework.
!
!AnnouncementsTutorial class methodsFor: 'pages' stamp: 'BenComan 1/29/2015 23:46'!
step2
	"This method was automatically generated. Edit it using:"
	"AnnouncementsTutorial edit: #step2"
	^HelpTopic
		title: 'Step 2 - Publishers and subscribers'
		contents: 
'If an object wants to announce an event it needs someone to make the announcement to. This is typically an instance of class Announcer which acts as the mediator between the object that has to announce something (publisher) and one or many (anonymous) subscribers who are interested in the event.

	| announcer |
	announcer := Announcer new.
	announcer announce: MyInterestingAnnouncement new

Using #announce: we can make an announcement - but since nobody is interested yet nothing will happen.

Lets add some consumers/subscribers. Subscribers just register on the Announcer instance to note that they are interested on a particular event/announcement: 

	| announcer |
	announcer := Announcer new.	
	announcer when: MyInterestingAnnouncement send: #open to: Browser.     
	announcer when: MyInterestingAnnouncement send: #inspect to: Smalltalk.    	

So anytime an interesting announcement is made we want to inform the two consumers with a specific message. Still nothing happens - we have to additionally make the announcement:

	| announcer |
	announcer := Announcer new.	
	announcer when: MyInterestingAnnouncement send: #open to: Browser.    
	announcer when: MyInterestingAnnouncement send: #inspect to: Smalltalk.    	
	announcer announce: MyInterestingAnnouncement new	

Note that the subscribers are decoupled from the original announcement publisher. They dont have to know each other. Decoupling is the key thing here ... subscribers can register for particular events/announcements and remain anonymous to the original publisher. !!' readStream nextChunkText! !

!AnnouncementsTutorial class methodsFor: 'pages' stamp: 'Tbn 11/12/2010 12:59'!
step1
	"This method was automatically generated. Edit it using:"
	"AnnouncementsTutorial edit: #step1"
	^HelpTopic
		title: 'Step 1 - Define an announcememt'
		contents: 
'To define an announcement you just have to subclass the Announcement class:

   Announcement subclass: #MyInterestingAnnouncement
   	   instanceVariableNames: ''''
	   classVariableNames: ''''
	   poolDictionaries: ''''
	   category: ''MyApp-Core''
	
If required you can add instance variables to hold data that should be transferred when an announcement is made:

   Announcement subclass: #GameLostAnnouncement
	   instanceVariableNames: ''score''
	   classVariableNames: ''''
	   poolDictionaries: ''''
	   category: ''MyGame-Core''!!' readStream nextChunkText! !

!AnnouncementsTutorial class methodsFor: 'accessing' stamp: 'Tbn 11/12/2010 11:16'!
bookName
	^'Tutorial'! !

!AnnouncementsTutorial class methodsFor: 'accessing' stamp: 'Tbn 11/12/2010 13:54'!
pages
	^#(step1 step2 step3)! !

!AnnouncementsTutorial class methodsFor: 'pages' stamp: 'BernardoContreras 9/26/2014 12:26'!
step3
	"This method was automatically generated. Edit it using:"
	"AnnouncementsTutorial edit: #step3"
	^HelpTopic
		title: 'Step 3 - More examples'
		contents: 
'In Pharo there is a global called "World" pointing to the desktop morph. This world also has an announcer we can use to demonstrate the features of the framework:

	World announcer 
		when: WindowOpened 
		send: #value 
		to: [ Transcript show: ''A new window was opened'';cr].

So anytime a window is opened in the system a message is shown in the transcript:
		
	Transcript open.
	
	World announcer 
		when: WindowOpened 
		send: #value 
		to: [ Transcript show: ''A new window was opened'';cr].
!!' readStream nextChunkText! !

!Announcer commentStamp: 'IgorStasenko 3/12/2011 18:45'!
The code is based on the announcements as described by Vassili Bykov in <http://www.cincomsmalltalk.com/userblogs/vbykov/blogView?searchCategory=Announcements%20Framework>. The implementation uses a threadsafe subscription registry, in the sense that registering, unregistering, and announcing from an announcer at the same time in different threads should never cause failures.

For security reasons, registry is kept private, and has no accessor like in other implementations!
!Announcer methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 6/8/2014 23:34'!
gtInspectorSubscriptionsIn: composite
	<gtInspectorPresentationOrder: 30>
	composite table
		title: 'Subscriptions';
		display: [ self subscriptions glmSubscriptions ];
		when: [ self numberOfSubscriptions isZero not ];
		column: 'Subscriber' evaluated: [ :each | each subscriber asString ];
		column: 'Announcement' evaluated: [ :each | each announcementClass name ];
		column: 'Kind' evaluated: [ :each | each class name ];
		act: [ :table | 
			self subscriptions reset.
			table update ] icon: GLMUIThemeExtraIcons glamorousCancel entitled: 'Reset';
		selectionAct: [ :table | 
			self subscriptions remove: table selection.
			table update ] entitled: 'Remove subscription'! !

!Announcer methodsFor: 'convenience' stamp: 'StephaneDucasse 8/27/2013 21:52'!
when: anAnnouncementClass do: aValuable
	"Declare that when anAnnouncementClass is raised, aValuable is executed.  Pay attention that ushc method as well as when:do: should not be used on weak announcer since the block holds the receiver and more strongly."
	
	^ self subscribe: anAnnouncementClass do: aValuable! !

!Announcer methodsFor: 'private' stamp: 'IgorStasenko 3/12/2011 20:30'!
basicSubscribe: subscription
	^ registry add: subscription! !

!Announcer methodsFor: 'deprecated' stamp: 'StephaneDucasse 8/27/2013 21:52'!
on: anAnnouncementClass do: aValuable
	"This method is deprecated!!
	Declare that when anAnnouncementClass is raised, aValuable is executed.
	In addition pay attention that ushc method as well as when:do: should not be used on weak announcer since the
	block holds the receiver and more strongly."
	
	^ self when: anAnnouncementClass do: aValuable! !

!Announcer methodsFor: 'deprecated' stamp: 'StephaneDucasse 8/22/2013 23:01'!
on: anAnnouncementClass send: aSelector to: anObject
	"This method is deprecated!! Use when:send:to:.
	Declare that when anAnnouncementClass is raised, anObject should receive the message aSelector.
    When the message expects one argument (eg #fooAnnouncement:) the announcement is passed as argument.
    When the message expects two arguments (eg #fooAnnouncement:announcer:) both the announcement and the announcer 
    are passed as argument"

	^ self when: anAnnouncementClass send: aSelector to: anObject! !

!Announcer methodsFor: 'statistics' stamp: 'IgorStasenko 3/12/2011 21:02'!
numberOfSubscriptions
	^ registry numberOfSubscriptions
! !

!Announcer methodsFor: 'announce' stamp: 'StephaneDucasse 4/24/2011 11:06'!
announce: anAnnouncement

	| announcement |
	announcement := anAnnouncement asAnnouncement.	
	registry ifNotNil: [
		registry deliver: announcement
		].
	^ announcement! !

!Announcer methodsFor: 'convenience' stamp: 'StephaneDucasse 8/27/2013 21:47'!
when: anAnnouncementClass do: aValuable for: aSubscriber
	"Declare that when anAnnouncementClass is raised, aValuable is executed and define the subscriber."
	
    ^ (self subscribe: anAnnouncementClass do: aValuable) subscriber: aSubscriber; yourself! !

!Announcer methodsFor: 'subscription' stamp: 'StephaneDucasse 4/24/2011 12:16'!
subscribe: anAnnouncementClass send: aSelector to: anObject
	"Declare that when anAnnouncementClass is raised, anObject should receive the message aSelector."
	
	^ self subscribe: anAnnouncementClass do: (MessageSend receiver: anObject selector: aSelector)! !

!Announcer methodsFor: 'initialization' stamp: 'IgorStasenko 3/12/2011 16:50'!
initialize
	super initialize.
	registry := SubscriptionRegistry new.! !

!Announcer methodsFor: 'private' stamp: 'IgorStasenko 3/22/2011 15:27'!
replace: subscription with: newOne
	^ registry replace: subscription with: newOne
! !

!Announcer methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 10/27/2014 10:17'!
gtInspectorAnnouncementsIn: composite context: aGTContext
	<gtInspectorPresentationOrder: 40>
	| recordedAnnouncements messageSend |
	
	recordedAnnouncements := CollectionValueHolder value: OrderedCollection new.
	messageSend := MessageSend receiver: recordedAnnouncements selector: #addAnnouncementFirst:.
	self
		when: Announcement
		send: #cull:
		to: messageSend.
	aGTContext when: GLMBrowserClosing do: [ self unsubscribe: messageSend ].
	composite table
		title: 'Announcements';
		display: [ recordedAnnouncements value ];
		column: 'Time' evaluated: #key;
		column: 'Announcement' evaluated: #value;
		send: #value;
		showOnly: 50;
		format: #gtDisplayString;
		filterOn: [:text :each | Smalltalk compiler evaluate: '| date each | date := self key. each := self value. ', text for: each logged: false ];
		updateOn: Announcement from: recordedAnnouncements gtAnnouncer;
		act: [ :table | 
			recordedAnnouncements := OrderedCollection new.
			table update ] 
			icon: GLMUIThemeExtraIcons glamorousCancel 
			entitled: 'Reset'! !

!Announcer methodsFor: '*RPackage-core' stamp: 'EstebanLorenzano 8/3/2012 15:01'!
hasSubscriber: anObject

	registry subscriptionsOf: anObject do: [:each | ^ true].
	^ false! !

!Announcer methodsFor: '*RPackage-core' stamp: 'StephaneDucasse 4/23/2011 12:43'!
subscriptions

	^ registry! !

!Announcer methodsFor: 'subscription' stamp: 'StephaneDucasse 4/24/2011 11:09'!
removeSubscription: subscription
	"Remove the given subscription from the receiver"
	
	^ registry remove: subscription
! !

!Announcer methodsFor: 'subscription' stamp: 'StephaneDucasse 4/24/2011 12:17'!
subscribe: anAnnouncementClass do: aValuable 
	"Declare that when anAnnouncementClass is raised, aValuable is executed."
	^ registry add: (
		AnnouncementSubscription new 
			announcer: self;
			announcementClass: anAnnouncementClass;
			valuable: aValuable)! !

!Announcer methodsFor: 'weak' stamp: 'IgorStasenko 3/12/2011 20:26'!
weak
	"announcer weak subscribe: foo"
	^ WeakSubscriptionBuilder on: self! !

!Announcer methodsFor: 'subscription' stamp: 'StephaneDucasse 4/24/2011 12:15'!
unsubscribe: anObject
	"Unsubscribe all subscriptions of anObject from the receiver"
	
	registry removeSubscriber: anObject! !

!Announcer methodsFor: 'convenience' stamp: 'StephaneDucasse 8/22/2013 22:59'!
when: anAnnouncementClass send: aSelector to: anObject
	"Declare that when anAnnouncementClass is raised, anObject should receive the message aSelector.
    When the message expects one argument (eg #fooAnnouncement:) the announcement is passed as argument.
    When the message expects two arguments (eg #fooAnnouncement:announcer:) both the announcement and the announcer 
    are passed as argument"

	^ self subscribe: anAnnouncementClass send: aSelector to: anObject! !

!Announcer class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 15:10'!
gtExampleSystemAnnouncer
	<gtExample: 'System Announcer'>
	^ SystemAnnouncer uniqueInstance! !

!Announcer class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 16:54'!
gtExampleEmptyAnnouncer
	<gtExample: 'Empty Announcer'>
	^ self new! !

!AnnouncerTest commentStamp: 'Tbn 11/12/2010 10:55'!
An AnnouncerTest is a test class used to test Announcer.

Instance Variables
	announcer:		<Announcer>  the announcer to test

announcer
	- the announcer that is tested
!
!AnnouncerTest methodsFor: 'testing' stamp: 'lr 9/25/2006 09:10'!
testUnsubscribeBlock
	| announcement |
	announcer
		subscribe: AnnouncementMockA
		do: [ :ann | announcement := ann ].
	announcer
		unsubscribe: self.

	announcement := nil.
	announcer announce: AnnouncementMockA new.
	self assert: announcement isNil! !

!AnnouncerTest methodsFor: 'testing' stamp: 'MarcusDenker 7/30/2014 20:19'!
testNoArgBlock
	"we are supposed to accept zero-argument blocks as actions "

	| counter |
	counter := nil.
	announcer subscribe: AnnouncementMockA do: [ counter := 1 ].
	announcer announce: AnnouncementMockA new.
	self assert: counter = 1! !

!AnnouncerTest methodsFor: 'testing' stamp: 'BernardoContreras 9/26/2014 11:14'!
testSymbolIdentifier
	| passed |
	passed := false.
	
	[announcer 
		when: #FOO send: #bar to: nil;
		announce: #FOO ] 
		on: MessageNotUnderstood 
		do: [ :ex | passed := (ex message selector = #bar). ].
		
	self assert: passed ! !

!AnnouncerTest methodsFor: 'testing' stamp: 'lr 3/2/2009 10:07'!
testSubscribeSet
	| announcement instance |
	announcer
		subscribe: AnnouncementMockA , AnnouncementMockC
		do: [ :ann | announcement := ann ].
		
	announcement := nil.
	instance := announcer announce: AnnouncementMockA.
	self assert: announcement = instance.
	
	announcement := nil.
	instance := announcer announce: AnnouncementMockB.
	self assert: announcement isNil.
	
	announcement := nil.
	instance := announcer announce: AnnouncementMockC.
	self assert: announcement = instance! !

!AnnouncerTest methodsFor: 'testing' stamp: 'lr 9/25/2006 09:13'!
testUnsubscribeSet
	| announcement |
	announcer
		subscribe: AnnouncementMockA , AnnouncementMockB
		do: [ :ann | announcement := ann ].
	announcer
		unsubscribe: self.

	announcement := nil.
	announcer announce: AnnouncementMockA new.
	self assert: announcement isNil.
	
	announcement := nil.
	announcer announce: AnnouncementMockB new.
	self assert: announcement isNil.! !

!AnnouncerTest methodsFor: 'testing' stamp: 'lr 3/2/2009 10:06'!
testSubscribeSubclass
	| announcement instance |
	announcer
		subscribe: AnnouncementMockB
		do: [ :ann | announcement := ann ].
		
	announcement := nil.
	instance := announcer announce: AnnouncementMockA.
	self assert: announcement isNil.

	announcement := nil.
	instance := announcer announce: AnnouncementMockB.
	self assert: announcement = instance.
	
	announcement := nil.
	instance := announcer announce: AnnouncementMockC.
	self assert: announcement = instance.! !

!AnnouncerTest methodsFor: 'running' stamp: 'lr 2/26/2011 11:34'!
setUp
	super setUp.
	announcer := self newAnnouncer! !

!AnnouncerTest methodsFor: 'testing' stamp: 'lr 9/25/2006 09:13'!
testUnsubscribeSend
	| announcement receiver |
	announcer
		subscribe: AnnouncementMockA
		send: #value:
		to: (receiver := [ :ann | announcement := ann ]).
	announcer
		unsubscribe: receiver.

	announcement := nil.
	announcer announce: AnnouncementMockA new.
	self assert: announcement isNil! !

!AnnouncerTest methodsFor: 'private' stamp: 'lr 2/26/2011 11:34'!
newAnnouncer
	^ Announcer new! !

!AnnouncerTest methodsFor: 'testing' stamp: 'MarcusDenker 7/30/2014 20:19'!
testTwoArgBlock
	"we are supposed to accept two-argument blocks as actions "

	| flag |
	flag := false.
	announcer subscribe: AnnouncementMockA do: [ :ann :announcer2 | flag := announcer2 == announcer ].
	announcer announce: AnnouncementMockA new.
	self assert: flag! !

!AnnouncerTest methodsFor: 'testing' stamp: 'BernardoContreras 9/26/2014 11:40'!
testAnnouncingReentrant
	" Test that it is safe to announce when handling announcement,
	so announcer are reentrant "

	" self run: #testAnnouncingReentrant "

	| bool ok |

	ok := bool := false.
	announcer when: Announcement do: [
		bool ifFalse: [
			bool := true.
		announcer announce:  Announcement new. ]
		ifTrue: [ ok := true ] 
	].

	self should: [ announcer announce: Announcement new. ] notTakeMoreThan: 1 second.
	self assert: ok

! !

!AnnouncerTest methodsFor: 'testing' stamp: 'lr 3/2/2009 10:07'!
testSubscribeSend
	| announcement instance |
	announcer
		subscribe: AnnouncementMockA
		send: #value:
		to: [ :ann | announcement := ann ].
		
	announcement := nil.
	instance := announcer announce: AnnouncementMockA.
	self assert: announcement = instance.
	
	announcement := nil.
	instance := announcer announce: AnnouncementMockB new.
	self assert: announcement isNil! !

!AnnouncerTest methodsFor: 'testing' stamp: 'lr 3/2/2009 10:11'!
testAnnounceClass
	self assert: (announcer announce: AnnouncementMockA) 
		class = AnnouncementMockA! !

!AnnouncerTest methodsFor: 'testing' stamp: 'lr 3/2/2009 10:10'!
testAnnounceInstance
	| instance |
	instance := AnnouncementMockA new.
	self assert: (announcer announce: instance) = instance! !

!AnnouncerTest methodsFor: 'testing' stamp: 'lr 3/2/2009 10:08'!
testSubscribeBlock
	| announcement instance |
	announcer
		subscribe: AnnouncementMockA
		do: [ :ann | announcement := ann ].
		
	announcement := nil.
	instance := announcer announce: AnnouncementMockA.
	self assert: announcement = instance.
	
	announcement := nil.
	instance := announcer announce: AnnouncementMockB.
	self assert: announcement isNil! !

!AnnouncerTest class methodsFor: 'testing' stamp: 'lr 2/26/2011 11:35'!
shouldInheritSelectors
	^ true! !

!AnonymousClassInstaller commentStamp: '<historical>'!
I am a class installer that does not expose the class to the global environment nor announces that a new class has been created.
As it's name suggest it is used for anonymous classes, for instance in Tests.!
!AnonymousClassInstaller methodsFor: 'notifications' stamp: 'ToonVerwaest 3/22/2011 17:45'!
classAdded: aClass inCategory: aCategory! !

!AnonymousClassInstaller methodsFor: 'notifications' stamp: 'ToonVerwaest 3/22/2011 18:38'!
classDefinitionDeeplyChangedFrom: oldClass to: newClass by: classModification! !

!AnonymousClassInstaller methodsFor: 'accessing' stamp: 'ToonVerwaest 3/22/2011 17:46'!
environment: anEnvironment! !

!AnonymousClassInstaller methodsFor: 'notifications' stamp: 'ToonVerwaest 3/22/2011 18:38'!
classDefinitionShallowChangedFrom: oldClass to: newClass by: classModification! !

!AnonymousClassInstaller methodsFor: 'migrating' stamp: 'ToonVerwaest 3/22/2011 18:30'!
migrateClasses: old to: new using: anInstanceModification! !

!AnonymousClassInstaller methodsFor: 'accessing' stamp: 'ToonVerwaest 3/22/2011 17:46'!
classAt: aName ifAbsent: aBlock
	^ aBlock value! !

!AnonymousClassInstaller methodsFor: 'notifications' stamp: 'ToonVerwaest 3/22/2011 17:46'!
recategorize: aClass to: aCategory! !

!ApplicationWithToolbar commentStamp: 'BenjaminVanRyseghem 2/18/2014 23:30'!
I am a simple example showing how to use a menu model to have a menu toolbar.

ApplicationWithToolbar new openWithSpec!
!ApplicationWithToolbar methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 2/18/2014 23:51'!
initializeWidgets

	menu := MenuModel new
		addGroup: [ :group |
			group addItem: [ :item |
				item 
					name: 'File';
					icon: Smalltalk ui icons openIcon;
					subMenu: self subMenu ].
			group addItem: [ :item |
				item
					name: nil;
					description: 'Open file';
					icon: Smalltalk ui icons openIcon;
					action: [ self inform: 'Open File' ] ].
			group addItem: [ :item |
				item 
					name: nil;
					description: 'Save File';
					icon: Smalltalk ui icons smallSaveIcon;
					action: [ self inform: 'Save File' ] ].
			group addItem: [ :item |
				item
					name: nil;
					description: 'Print file';
					icon: Smalltalk ui icons smallPrintIcon;
					action: [ self inform: 'Print file' ] ] ];
		addGroup: [ :group |
			group addItem: [ :item |
				item
					name: nil;
					description: 'Undo';
					icon: Smalltalk ui icons smallUndoIcon;
					action: [ self inform: 'Undo' ] ].
			group addItem: [ :item |
				item
					name: nil;
					description: 'Redo';
					icon: Smalltalk ui icons smallRedoIcon;
					action: [ self inform: 'Redo' ] ] ].
		
	menu applyTo: self.
	text := self newText.
	self focusOrder add: text! !

!ApplicationWithToolbar methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 2/18/2014 23:52'!
subMenu 

	^ MenuModel new
		addGroup: [ :group |
			group addItem: [ :item |
				item
					name: 'Open';
					icon: Smalltalk ui icons openIcon;
					shortcut: $o command;
					action: [ self inform: 'Open' ] ].
			group addItem: [ :item |
				item 
					name: 'Save';
					icon: Smalltalk ui icons smallSaveIcon;
					shortcut: $s command;
					action: [ self inform: 'Save' ] ].
			group addItem: [ :item |
				item 
					name: 'Print';
					shortcut: $p command;
					icon: Smalltalk ui icons smallPrintIcon;
					action: [ self inform: 'Print' ] ].
			group addItem: [ :item |
				item 
					name: 'Kill';
					shortcut: $k command;
					icon: Smalltalk ui icons smallCancelIcon;
					action: [ self inform: 'Kill' ] ] ]! !

!ApplicationWithToolbar methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/18/2014 23:20'!
menu
	^ menu! !

!ApplicationWithToolbar methodsFor: 'api' stamp: 'BenjaminVanRyseghem 2/18/2014 23:47'!
title

	^ 'Text editor'! !

!ApplicationWithToolbar methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/18/2014 23:20'!
text
	^ text! !

!ApplicationWithToolbar class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 2/18/2014 23:21'!
defaultSpec
	<spec: #default>
	
	^ SpecLayout composed
		newColumn: [ :c | 
			c 
				add: #menu height: self toolbarHeight;
				add: #text ];
		yourself! !

!Archive commentStamp: '<historical>'!
This is the abstract superclass for file archives. Archives can be read from or written to files, and contain members that represent files and directories.!
!Archive methodsFor: 'archive operations' stamp: 'tak 2/2/2005 13:00'!
addTree: aFileNameOrDirectory removingFirstCharacters: n 
	^ self
		addTree: aFileNameOrDirectory
		removingFirstCharacters: n
		match: [:e | true]! !

!Archive methodsFor: 'archive operations' stamp: 'nk 12/20/2002 14:50'!
membersMatching: aString
	^members select: [ :ea | (aString match: ea fileName) or: [ aString match: ea localFileName ] ]! !

!Archive methodsFor: 'archive operations' stamp: 'StephaneDucasse 6/22/2012 19:01'!
addTree: aFileNameOrDirectory match: aBlock 
	| nameSize |
	nameSize := aFileNameOrDirectory isString
				ifTrue: [aFileNameOrDirectory size]
				ifFalse: [aFileNameOrDirectory fullName size].
	^ self
		addTree: aFileNameOrDirectory
		removingFirstCharacters: nameSize + 1
		match: aBlock! !

!Archive methodsFor: 'private' stamp: 'nk 2/21/2001 18:14'!
memberClass
	self subclassResponsibility! !

!Archive methodsFor: 'archive operations' stamp: 'nk 2/21/2001 18:29'!
addFile: aFileName
	^self addFile: aFileName as: aFileName! !

!Archive methodsFor: 'archive operations' stamp: 'CamilloBruni 5/4/2012 21:18'!
extractMember: aMemberOrName
	| member |
	member := self member: aMemberOrName.
	member ifNil: [ ^nil ].
	member 
		extractToFileNamed: member localFileName 
		inDirectory: FileSystem workingDirectory.! !

!Archive methodsFor: 'archive operations' stamp: 'nk 2/21/2001 17:59'!
numberOfMembers
	^members size! !

!Archive methodsFor: 'archive operations' stamp: 'nk 2/21/2001 20:58'!
writeTo: aStream
	self subclassResponsibility! !

!Archive methodsFor: 'archive operations' stamp: 'CamilloBruni 5/4/2012 21:18'!
extractMemberWithoutPath: aMemberOrName
	self 
		extractMemberWithoutPath: aMemberOrName
		inDirectory: FileSystem workingDirectory.! !

!Archive methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 09:39'!
initialize
	super initialize.
	members := OrderedCollection new.! !

!Archive methodsFor: 'archive operations' stamp: 'nk 2/22/2001 19:09'!
addDirectory: aFileName
	^self addDirectory: aFileName as: aFileName
! !

!Archive methodsFor: 'archive operations' stamp: 'nk 2/22/2001 19:09'!
addMember: aMember
	^members addLast: aMember! !

!Archive methodsFor: 'archive operations' stamp: 'nk 2/22/2001 07:57'!
extractMember: aMemberOrName toFileNamed: aFileName
	| member |
	member := self member: aMemberOrName.
	member ifNil: [ ^nil ].
	member extractToFileNamed: aFileName! !

!Archive methodsFor: 'archive operations' stamp: 'nk 12/20/2002 15:03'!
addString: aString as: aFileName
	| newMember |
	newMember := self memberClass newFromString: aString named: aFileName.
	self addMember: newMember.
	newMember localFileName: aFileName.
	^newMember! !

!Archive methodsFor: 'archive operations' stamp: 'nk 12/20/2002 14:50'!
memberNamed: aString
	"Return the first member whose zip name or local file name matches aString, or nil"
	^members detect: [ :ea | ea fileName = aString or: [ ea localFileName = aString ]] ifNone: [ ]! !

!Archive methodsFor: 'archive operations' stamp: 'nk 2/22/2001 07:57'!
contentsOf: aMemberOrName
	| member |
	member := self member: aMemberOrName.
	member ifNil: [ ^nil ].
	^member contents! !

!Archive methodsFor: 'archive operations' stamp: 'nk 2/22/2001 07:57'!
removeMember: aMemberOrName
	| member |
	member := self member: aMemberOrName.
	member ifNotNil: [ members remove: member ].
	^member! !

!Archive methodsFor: 'private' stamp: 'nk 2/22/2001 07:56'!
member: aMemberOrName
	^(members includes: aMemberOrName)
		ifTrue: [ aMemberOrName ]
		ifFalse: [ self memberNamed: aMemberOrName ].! !

!Archive methodsFor: 'archive operations' stamp: 'SeanDeNigris 2/5/2013 15:14'!
addTree: aFileNameOrDirectory removingFirstCharacters: n match: aBlock
	| dir relativePath matches |
	dir := aFileNameOrDirectory asFileReference.
	relativePath := (dir fullName allButFirst: n) asFileReference.
	matches := dir entries select: [ :entry | aBlock value: entry ].
	matches
		do: [ :e | | newMember |
			newMember := e isDirectory
					ifTrue: [ self memberClass newFromDirectory: e fullName ]
					ifFalse: [ self memberClass newFromFile: e fullName ].
		newMember localFileName: (relativePath / e name) fullName.
		self addMember: newMember.
		e isDirectory ifTrue: [ self addTree: e fullName removingFirstCharacters: n match: aBlock ].
	].
! !

!Archive methodsFor: 'archive operations' stamp: 'nk 2/22/2001 17:24'!
setContentsOf: aMemberOrName to: aString
	| newMember oldMember |
	oldMember := self member: aMemberOrName.
	newMember := (self memberClass newFromString: aString named: oldMember fileName)
		copyFrom: oldMember.
	self replaceMember: oldMember with: newMember.! !

!Archive methodsFor: 'archive operations' stamp: 'StephaneDucasse 2/25/2010 18:02'!
writeToFileNamed: aFileName

	"Catch attempts to overwrite existing zip file"
	(self canWriteToFileNamed: aFileName)
		ifFalse: [ ^self error: (aFileName, ' is needed by one or more members in this archive') ].
	StandardFileStream 
		forceNewFileNamed: aFileName
		do:  [:stream | self writeTo: stream ]
		! !

!Archive methodsFor: 'archive operations' stamp: 'nk 12/20/2002 14:57'!
addDirectory: aFileName as: anotherFileName
	| newMember |
	newMember := self memberClass newFromDirectory: aFileName.
	self addMember: newMember.
	newMember localFileName: anotherFileName.
	^newMember! !

!Archive methodsFor: 'archive operations' stamp: 'CamilloBruni 5/7/2012 02:03'!
extractMemberWithoutPath: aMemberOrName inDirectory: dir
	| member |
	member := self member: aMemberOrName.
	member ifNil: [ ^nil ].
	member extractToFileNamed: (member asFileReference basename) inDirectory: dir! !

!Archive methodsFor: 'archive operations' stamp: 'nk 2/21/2001 18:00'!
memberNames
	^members collect: [ :ea | ea fileName ]! !

!Archive methodsFor: 'archive operations' stamp: 'nk 2/22/2001 07:57'!
replaceMember: aMemberOrName with: newMember
	| member |
	member := self member: aMemberOrName.
	member ifNotNil: [ members replaceAll: member with: newMember ].
	^member! !

!Archive methodsFor: 'archive operations' stamp: 'nk 2/24/2001 14:12'!
canWriteToFileNamed: aFileName
	"Catch attempts to overwrite existing zip file"
	^(members anySatisfy: [ :ea | ea usesFileNamed: aFileName ]) not.
! !

!Archive methodsFor: 'archive operations' stamp: 'nk 2/21/2001 17:58'!
members
	^members! !

!Archive methodsFor: 'archive operations' stamp: 'SeanDeNigris 5/18/2012 22:16'!
addFile: aFileName as: anotherFileName
	| newMember |
	newMember := self memberClass newFromFile: aFileName.
	newMember localFileName: anotherFileName.
	self addMember: newMember.
	^newMember! !

!ArchiveMember commentStamp: '<historical>'!
This is the abstract superclass for archive members, which are files or directories stored in archives.!
!ArchiveMember methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 09:39'!
initialize
	super initialize.
	fileName := ''.
	isCorrupt := false.! !

!ArchiveMember methodsFor: 'accessing' stamp: 'SeanDeNigris 6/19/2012 09:23'!
localFileName: aString
	"Set my internal filename.
	Returns the (possibly new) filename"

	^fileName := aString copyReplaceAll: FileSystem disk delimiter asString with: UnixStore delimiter asString.! !

!ArchiveMember methodsFor: 'initialization' stamp: 'ar 3/2/2001 18:46'!
close
! !

!ArchiveMember methodsFor: 'accessing' stamp: 'nk 2/22/2001 16:00'!
fileName
	^fileName! !

!ArchiveMember methodsFor: 'accessing' stamp: 'nk 2/22/2001 16:00'!
fileName: aName
	fileName := aName! !

!ArchiveMember methodsFor: 'printing' stamp: 'nk 12/20/2002 15:11'!
printOn: aStream
	super printOn: aStream.
	aStream nextPut: $(;
		nextPutAll: self fileName;
		nextPut: $)! !

!ArchiveMember methodsFor: 'accessing' stamp: 'nk 3/7/2004 16:06'!
isCorrupt: aBoolean
	"Mark this member as being corrupt."
	isCorrupt := aBoolean! !

!ArchiveMember methodsFor: 'accessing' stamp: 'nk 3/7/2004 16:16'!
isCorrupt
	^isCorrupt ifNil: [ isCorrupt := false ]! !

!ArchiveMember methodsFor: 'testing' stamp: 'nk 2/21/2001 19:43'!
usesFileNamed: aFileName
	"Do I require aFileName? That is, do I care if it's clobbered?"
	^false! !

!ArchiveMember class methodsFor: 'as yet unclassified' stamp: 'nk 2/21/2001 18:32'!
newFromFile: aFileName
	self subclassResponsibility! !

!ArchiveMember class methodsFor: 'as yet unclassified' stamp: 'nk 2/21/2001 18:32'!
newFromString: aString
	self subclassResponsibility! !

!ArchiveMember class methodsFor: 'as yet unclassified' stamp: 'nk 2/21/2001 18:33'!
newDirectoryNamed: aString
	self subclassResponsibility! !

!ArgumentNamesTest commentStamp: 'TorstenBergmann 2/4/2014 20:45'!
SUnit tests for generating argument names!
!ArgumentNamesTest methodsFor: 'tests' stamp: 'SeanDeNigris 5/28/2013 18:45'!
testClass

	self argumentNameForInstanceOf: Class shouldBe: 'aClass'.
	self argumentNameFor: Integer shouldBe: 'aClass'.
	self argumentNameFor: Collection shouldBe: 'aClass'.! !

!ArgumentNamesTest methodsFor: 'tests' stamp: 'SeanDeNigris 5/28/2013 18:01'!
testString

	self argumentNameForInstanceOf: String shouldBe: 'aString'.
	self argumentNameForInstanceOf: ByteString shouldBe: 'aString'.! !

!ArgumentNamesTest methodsFor: 'tests' stamp: 'SeanDeNigris 5/28/2013 18:01'!
testDefault

	self argumentNameForInstanceOf: Object shouldBe: 'anObject'.! !

!ArgumentNamesTest methodsFor: 'asserting' stamp: 'SeanDeNigris 5/28/2013 18:10'!
argumentNameForInstanceOf: aClass shouldBe: aString 
	
	self assert: aClass canonicalArgumentName equals: aString.! !

!ArgumentNamesTest methodsFor: 'tests' stamp: 'SeanDeNigris 5/28/2013 18:01'!
testInteger

	self argumentNameForInstanceOf: Integer shouldBe: 'anInteger'.! !

!ArgumentNamesTest methodsFor: 'tests' stamp: 'SeanDeNigris 5/28/2013 18:01'!
testNumber

	self argumentNameForInstanceOf: Number shouldBe: 'aNumber'.
	self argumentNameForInstanceOf: Float shouldBe: 'aNumber'.! !

!ArgumentNamesTest methodsFor: 'tests' stamp: 'SeanDeNigris 5/28/2013 18:01'!
testCollection

	self argumentNameForInstanceOf: Collection shouldBe: 'aCollection'.! !

!ArgumentNamesTest methodsFor: 'tests' stamp: 'SeanDeNigris 5/28/2013 18:29'!
testAnPrefixForClassNameStartingWithVowel

	self testInteger.! !

!ArgumentNamesTest methodsFor: 'tests' stamp: 'SeanDeNigris 5/28/2013 18:29'!
testAPrefixForClassNameStartingWithConsonant

	self testCollection.! !

!ArgumentNamesTest methodsFor: 'asserting' stamp: 'SeanDeNigris 5/28/2013 18:12'!
argumentNameFor: anObject shouldBe: aString 

	self assert: anObject class canonicalArgumentName equals: aString.! !

!ArithmeticError commentStamp: '<historical>'!
I am ArithmeticError, the superclass of all exceptions related to arithmetic.!
!Array commentStamp: '<historical>'!
I present an ArrayedCollection whose elements are objects.!
!Array methodsFor: 'testing' stamp: 'eem 5/8/2008 11:13'!
isArray
	^true! !

!Array methodsFor: 'private' stamp: 'nice 7/20/2011 09:03'!
hasLiteral: literal
	"Answer true if literal is identical to any literal in this array, even 
	if imbedded in further array structure. This method is only intended 
	for private use by CompiledMethod hasLiteralSymbol:"

	| lit |
	1 to: self size do: 
		[:index | 
		((lit := self at: index) literalEqual: literal) ifTrue: [^true].
		(Array == lit class and: [lit hasLiteral: literal]) ifTrue: [^true]].
	^false! !

!Array methodsFor: '*Fuel' stamp: 'MartinDias 3/29/2012 03:12'!
fuelAccept: aGeneralMapper
	
	"This IF is because there are subclasses of Array that are weak. If we do not put this IF, all subclasses fuel be using the #visitVariableObject:, loosing the capability of the weak
	However, this method is just to optimize the method lookup of the message #fuelAccept:. If this method is removed, the default behavior of Object shuld work as well. If the performance is not that different, then we can remove this method which has an ugly if."
	^ self class isWeak
		ifTrue: [ aGeneralMapper visitWeakObject: self ]
		ifFalse: [ aGeneralMapper visitVariableObject: self ]
	
	! !

!Array methodsFor: 'self evaluating' stamp: 'sd 7/31/2005 21:44'!
printAsLiteralFormOn: aStream
	aStream nextPut: $#.
	self printElementsOn: aStream
! !

!Array methodsFor: '*Collections-arithmetic' stamp: 'StephaneDucasse 2/15/2015 14:26'!
preMultiplyByMatrix: m
	"Answer m+*self where m is a Matrix."

	m numberOfColumns = self size ifFalse: [self error: 'dimensions do not conform'].
	^ (1 to: m numberOfRows) collect: [ :row | 
			| s |
			s := 0.
			1 to: self size do: [:k | s := (m at: row at: k) * (self at: k) + s].
		s ]! !

!Array methodsFor: '*Collections-arithmetic' stamp: 'raok 10/22/2002 20:10'!
preMultiplyByArray: a
	"Answer a+*self where a is an Array.  Arrays are always understood as column vectors,
	 so an n element Array is an n*1 Array.  This multiplication is legal iff self size = 1."

	self size = 1 ifFalse: [self error: 'dimensions do not conform'].
	^a * self first! !

!Array methodsFor: '*Collections-arithmetic' stamp: 'raok 10/22/2002 20:09'!
+* aCollection
	"Premultiply aCollection by self.  aCollection should be an Array or Matrix.
	 The name of this method is APL's +.x squished into Smalltalk syntax."

	^aCollection preMultiplyByArray: self
! !

!Array methodsFor: 'printing' stamp: 'BernardoContreras 11/6/2011 02:47'!
printOn: aStream
	self shouldBePrintedAsLiteral ifTrue: [self printAsLiteralFormOn: aStream. ^ self].
	self isSelfEvaluating ifTrue: [self printAsSelfEvaluatingFormOn: aStream. ^ self].

	super printOn: aStream! !

!Array methodsFor: 'filter streaming' stamp: 'BernardoContreras 11/6/2011 17:04'!
storeOnStream: aStream
	
	self shouldBePrintedAsLiteral 
		ifTrue:  [ super storeOnStream: aStream ]
		ifFalse: [ aStream writeCollection: self ]
! !

!Array methodsFor: '*Morphic-Base' stamp: 'StephaneDucasse 12/21/2012 13:53'!
asLayoutFrame
	 ^ LayoutFrame new fromArray: self! !

!Array methodsFor: '*monticellofiletree-core' stamp: 'dkh 4/6/2012 15:56:14'!
writeCypressJsonOn: aStream forHtml: forHtml indent: startIndent
    "by default ignore <forHtml> ... <forHtml> is used for Dictionary and Array, i.e., container objects and String which actually encodes itself differently for HTML"

    | indent |
    aStream
        nextPutAll: '[';
        lf.
    indent := startIndent + 1.
    1 to: self size do: [ :index | 
        | item |
        item := self at: index.
        aStream tab: indent.
        item writeCypressJsonOn: aStream forHtml: forHtml indent: indent.
        index < self size
            ifTrue: [ 
                aStream
                    nextPutAll: ',';
                    lf ] ].
    self size = 0
        ifTrue: [ aStream tab: indent ].
    aStream nextPutAll: ' ]'! !

!Array methodsFor: 'accessing' stamp: 'ar 8/26/2001 22:03'!
atWrap: index put: anObject
	"Optimized to go through the primitive if possible"
	<primitive: 61>
	^ self at: index - 1 \\ self size + 1 put: anObject! !

!Array methodsFor: 'converting' stamp: 'tpr 11/2/2004 11:31'!
elementsExchangeIdentityWith: otherArray
	"This primitive performs a bulk mutation, causing all pointers to the elements of this array to be replaced by pointers to the corresponding elements of otherArray.  At the same time, all pointers to the elements of otherArray are replaced by pointers to the corresponding elements of this array.  The identityHashes remain with the pointers rather than with the objects so that objects in hashed structures should still be properly indexed after the mutation."

	<primitive: 128>
	otherArray class == Array ifFalse: [^ self error: 'arg must be array'].
	self size = otherArray size ifFalse: [^ self error: 'arrays must be same size'].
	(self anySatisfy: [:obj | obj class == SmallInteger]) ifTrue: [^ self error: 'can''t become SmallIntegers'].
	(otherArray anySatisfy: [:obj | obj class == SmallInteger]) ifTrue: [^ self error: 'can''t become SmallIntegers'].
	self with: otherArray do:[:a :b| a == b ifTrue:[^self error:'can''t become yourself']].

	"Must have failed because not enough space in forwarding table (see ObjectMemory-prepareForwardingTableForBecoming:with:twoWay:).  Do GC and try again only once"
	(Smalltalk bytesLeft: true) = Smalltalk primitiveGarbageCollect
		ifTrue: [^ self primitiveFailed].
	^ self elementsExchangeIdentityWith: otherArray! !

!Array methodsFor: 'self evaluating' stamp: 'StephaneDucasse 10/8/2011 12:07'!
printAsSelfEvaluatingFormOn: aStream

	aStream nextPut: ${.
	self do: [:el | el printOn: aStream] separatedBy: [ aStream nextPutAll: '. '].
	aStream nextPut: $}! !

!Array methodsFor: '*System-Settings-Browser' stamp: 'AlainPlantec 1/31/2010 10:35'!
settingStoreOn: aStream 
	"Use the literal form if possible."

	self isLiteral
		ifTrue: 
			[aStream nextPut: $#; nextPut: $(.
			self do: 
				[:element | 
				element settingStoreOn: aStream.
				aStream space].
			aStream nextPut: $)]
		ifFalse: [super settingStoreOn: aStream]! !

!Array methodsFor: 'converting' stamp: 'sma 5/12/2000 17:32'!
asArray
	"Answer with the receiver itself."

	^ self! !

!Array methodsFor: 'printing' stamp: 'ul 11/23/2010 13:28'!
storeOn: aStream 
	"Use the literal form if possible."

	self shouldBePrintedAsLiteral
		ifTrue: 
			[aStream nextPut: $#; nextPut: $(.
			self do: 
				[:element | 
				element storeOn: aStream.
				aStream space].
			aStream nextPut: $)]
		ifFalse: [super storeOn: aStream]! !

!Array methodsFor: 'testing' stamp: 'nice 11/2/2009 19:06'!
isLiteral
	^self class == Array and: [self allSatisfy: [:each | each isLiteral]]! !

!Array methodsFor: 'comparing' stamp: 'ajh 2/2/2002 15:03'!
literalEqual: other

	self class == other class ifFalse: [^ false].
	self size = other size ifFalse: [^ false].
	self with: other do: [:e1 :e2 |
		(e1 literalEqual: e2) ifFalse: [^ false]].
	^ true! !

!Array methodsFor: '*Spec-Core' stamp: 'BenjaminVanRyseghem 1/15/2014 17:14'!
generateSpec
	| str spec |
	str := self readStream.	
	
	spec :=  OrderedCollection with: #SpecLayoutFrame.
		
	#( leftFraction: topFraction: rightFraction: bottomFraction: leftOffset: topOffset: rightOffset: bottomOffset: ) do: [:sel |
		spec add: sel.
		str next ifNil: [ spec add: 0 ] ifNotNil: [:value | spec add: value ]].
	^ spec asArray! !

!Array methodsFor: 'testing' stamp: 'ul 11/23/2010 13:28'!
shouldBePrintedAsLiteral

	^self class == Array and: [ self allSatisfy: [ :each | each shouldBePrintedAsLiteral ] ]! !

!Array methodsFor: '*Fuel' stamp: 'M 3/9/2014 21:34'!
fuelReplacement
	^ self == Smalltalk specialObjectsArray
		ifTrue: [ nil ]
		ifFalse: [ self ]! !

!Array methodsFor: 'copying' stamp: 'ar 2/11/2001 01:55'!
copyWithDependent: newElement
	self size = 0 ifTrue:[^DependentsArray with: newElement].
	^self copyWith: newElement! !

!Array methodsFor: 'converting' stamp: 'MartinDias 7/1/2013 15:11'!
elementsForwardIdentityTo: otherArray copyHash: copyHash
	"This primitive performs a bulk mutation, causing all pointers to the elements of this array to be replaced by pointers to the corresponding elements of otherArray.  
	If copyHash is true, 
		the identityHashes remain with the pointers rather than with the objects so that the objects in this array should still be properly indexed in any existing hashed structures after the mutation.
		That means that the identityHashes of the elements in otherArray are modified to be the ones of the corresponding elements in this array.
	If copyHash is false,
		then identityHashes stay with the objects and thus the elements in otherArray are not modified.
		In this case only the pointers to the elements in this array are forwarded."
	<primitive: 249>
	self primitiveFailed! !

!Array methodsFor: 'private' stamp: 'nice 7/20/2011 18:01'!
refersToLiteral: literal 
	"Answer true if literal is identical to any literal in this array, even if imbedded in further array structures or closure methods"
	1 
		to: self size
		do: 
			[ :index | 
			| lit |
			(literal literalEqual: (lit := self at: index)) ifTrue: [ ^ true ].
			(lit refersToLiteral: literal) ifTrue: [ ^ true ] ].
	^ false! !

!Array methodsFor: 'converting' stamp: 'di 3/28/1999 10:23'!
elementsForwardIdentityTo: otherArray
	"This primitive performs a bulk mutation, causing all pointers to the elements of this array to be replaced by pointers to the corresponding elements of otherArray.  The identityHashes remain with the pointers rather than with the objects so that the objects in this array should still be properly indexed in any existing hashed structures after the mutation."
	<primitive: 72>
	self primitiveFailed! !

!Array methodsFor: 'private' stamp: ''!
replaceFrom: start to: stop with: replacement startingAt: repStart 
	"Primitive. This destructively replaces elements from start to stop in the receiver starting at index, repStart, in the collection, replacement. Answer the receiver. Range checks are performed in the primitive only. Optional. See Object documentation whatIsAPrimitive."
	<primitive: 105>
	super replaceFrom: start to: stop with: replacement startingAt: repStart! !

!Array methodsFor: 'self evaluating' stamp: 'sd 7/31/2005 21:44'!
isSelfEvaluating
	^ (self allSatisfy: [:each | each isSelfEvaluating]) and: [self class == Array]! !

!Array methodsFor: 'accessing' stamp: 'ar 8/26/2001 22:02'!
atWrap: index 
	"Optimized to go through the primitive if possible"
	<primitive: 60>
	^ self at: index - 1 \\ self size + 1! !

!Array methodsFor: 'private' stamp: 'md 3/1/2006 21:09'!
hasLiteralSuchThat: testBlock
	"Answer true if testBlock returns true for any literal in this array, even if imbedded in 	further Arrays or CompiledMethods.  This method is only intended for private use by 	CompiledMethod 	hasLiteralSuchThat:"
	| lit |
	1 to: self size do: [:index |
		(testBlock value: (lit := self at: index)) ifTrue: [^ true].
		(lit hasLiteralSuchThat: testBlock) ifTrue: [^ true]].
	^ false! !

!Array class methodsFor: 'brace support' stamp: 'di 11/19/1999 08:17'!
braceWith: a with: b with: c with: d
	"This method is used in compilation of brace constructs.
	It MUST NOT be deleted or altered."

	| array |
	array := self new: 4.
	array at: 1 put: a.
	array at: 2 put: b.
	array at: 3 put: c.
	array at: 4 put: d.
	^ array! !

!Array class methodsFor: 'brace support' stamp: 'di 11/19/1999 08:16'!
braceWith: a
	"This method is used in compilation of brace constructs.
	It MUST NOT be deleted or altered."

	| array |
	array := self new: 1.
	array at: 1 put: a.
	^ array! !

!Array class methodsFor: 'instance creation' stamp: 'md 7/19/2004 12:34'!
new: sizeRequested 
	"Answer an instance of this class with the number of indexable
	variables specified by the argument, sizeRequested.
	
	This is a shortcut (direct call of primitive, no #initialize, for performance"

	<primitive: 71>  "This method runs primitively if successful"
	^ self basicNew: sizeRequested  "Exceptional conditions will be handled in basicNew:"
! !

!Array class methodsFor: 'brace support' stamp: 'di 11/18/1999 22:53'!
braceStream: nElements
	"This method is used in compilation of brace constructs.
	It MUST NOT be deleted or altered."

	^ WriteStream basicNew braceArray: (self new: nElements)
! !

!Array class methodsFor: 'instance creation' stamp: 'StephaneDucasse 2/13/2010 12:18'!
empty
	"A canonicalized empty Array instance."
	^ #()! !

!Array class methodsFor: 'brace support' stamp: 'di 11/19/1999 08:17'!
braceWith: a with: b with: c 
	"This method is used in compilation of brace constructs.
	It MUST NOT be deleted or altered."

	| array |
	array := self new: 3.
	array at: 1 put: a.
	array at: 2 put: b.
	array at: 3 put: c.
	^ array! !

!Array class methodsFor: 'brace support' stamp: 'di 11/19/1999 08:16'!
braceWithNone
	"This method is used in compilation of brace constructs.
	It MUST NOT be deleted or altered."

	^ self new: 0! !

!Array class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 3/26/2015 00:03'!
gtExample
	<gtExample>
	^ #(42 42.0 #fourtytwo 'fourtytwo')! !

!Array class methodsFor: 'brace support' stamp: 'di 11/19/1999 08:15'!
braceWith: a with: b 
	"This method is used in compilation of brace constructs.
	It MUST NOT be deleted or altered."

	| array |
	array := self new: 2.
	array at: 1 put: a.
	array at: 2 put: b.
	^ array! !

!ArrayTest commentStamp: '<historical>'!
This is the unit test for the class Array. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see: 
	- http://www.c2.com/cgi/wiki?UnitTest
	- there is a chapter in the PharoByExample book (http://pharobyexample.org/)	
	- the sunit class category!
!ArrayTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButLast
	"self debug: #testAllButLast"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButLast.
	self deny: abf last = col last.
	self assert: abf size + 1 = col size! !

!ArrayTest methodsFor: 'requirements' stamp: 'SebastianTleye 6/28/2013 14:36'!
simpleCollection
	^simpleCollection.! !

!ArrayTest methodsFor: 'tests - begins ends with' stamp: ''!
testsEndsWith
	
	self assert: (self nonEmpty endsWith: self nonEmpty copyWithoutFirst).
	self assert: (self nonEmpty endsWith: self nonEmpty).
	self deny: (self nonEmpty endsWith: (self nonEmpty copyWith: self nonEmpty first)).! !

!ArrayTest methodsFor: 'tests - copying with replacement' stamp: ''!
testCopyReplaceAllWith1Occurence
	| result  firstIndexesOfOccurrence index endPartIndexResult endPartIndexCollection |
	
	result := self collectionWith1TimeSubcollection  copyReplaceAll: self oldSubCollection with: self replacementCollection .
	
	"detecting indexes of olSubCollection"
	firstIndexesOfOccurrence  := self firstIndexesOf: self oldSubCollection in: self collectionWith1TimeSubcollection .
	index:= firstIndexesOfOccurrence at: 1.
	
	"verify content of 'result' : "
	"first part of 'result'' : '"

	1 to: (index -1) do: 
		[
		:i |  
		self assert: (self collectionWith1TimeSubcollection  at:i)=(result at: i)
		].

	" middle part containing replacementCollection : "
	
	index to: (index + self replacementCollection size-1) do: 
		[
		:i |
		self assert: ( result at: i )=(self replacementCollection at: ( i - index + 1 ))
		].
	
	" end part :"
	
	endPartIndexResult :=  index + self replacementCollection  size .
	endPartIndexCollection :=   index + self oldSubCollection size  .
	
	1 to: (result size - endPartIndexResult - 1 ) do:
		[ 
		:i |
		self assert: (result at: ( endPartIndexResult + i - 1 ) ) = (self collectionWith1TimeSubcollection  at: ( endPartIndexCollection + i - 1 ) ).
		].
	
	
	! !

!ArrayTest methodsFor: 'tests - equality' stamp: ''!
testHasEqualElementsOfIdenticalCollectionObjects
	"self debug: #testHasEqualElementsOfIdenticalCollectionObjects"
	
	self assert: (self empty hasEqualElements: self empty). 
	self assert: (self nonEmpty hasEqualElements: self nonEmpty). 
	! !

!ArrayTest methodsFor: 'tests - index access' stamp: ''!
testLastIndexOf
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection lastIndexOf: element) = 1.
	self assert: (collection lastIndexOf: self elementNotInForIndexAccessing) = 0! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyWithReplacementTest
	self replacementCollection.
	self oldSubCollection.
	self collectionWith1TimeSubcollection.
	self assert: (self howMany: self oldSubCollection in: self collectionWith1TimeSubcollection) = 1! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 10:53'!
moreThan4Elements

" return a collection including at leat 4 elements"
	^ example1 ! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 3/31/2009 10:29'!
secondIndex
	^ secondIndex ! !

!ArrayTest methodsFor: 'tests - subcollections access' stamp: ''!
testFirstNElements
	"self debug: #testFirstNElements"
	| result |
	result := self moreThan3Elements first: self moreThan3Elements size - 1.
	1 
		to: result size
		do: [ :i | self assert: (result at: i) = (self moreThan3Elements at: i) ].
	self assert: result size = (self moreThan3Elements size - 1).
	self 
		should: [ self moreThan3Elements first: self moreThan3Elements size + 1 ]
		raise: Error! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/17/2009 10:29'!
collectionWith2TimeSubcollection
	^ (self oldSubCollection copyWithoutFirst),self oldSubCollection,(self oldSubCollection copyWithoutFirst),self oldSubCollection .! !

!ArrayTest methodsFor: 'tests - puting with indexes' stamp: ''!
testFromToPut
	
	| collection index |
	index := self indexArray anyOne.
	collection := self nonEmpty copy.
	collection from: 1 to: index  put: self aValue..
	1 to: index do:
		[:i | self assert: (collection at: i)= self aValue].
	(index +1) to: collection size do:
		[:i | self assert: (collection at:i)= (self nonEmpty at:i)].! !

!ArrayTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithoutFirst

	| result |
	result := self nonEmpty copyWithoutFirst.
	
	self assert: result size = (self nonEmpty size - 1).
	
	1 to: result size do:
		[:i |
		self assert: (result at: i)= (self nonEmpty at: (i + 1))].! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0TStructuralEqualityTest
	self empty.
	self nonEmpty.
	self assert: self empty isEmpty.
	self deny: self nonEmpty isEmpty! !

!ArrayTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionTwoSimilarElementsInIntersection
	"self debug: #testIntersectionBasic"
	| inter |
	inter := self collection intersection: (self collectionClass with: self anotherElementOrAssociationIn).
	self assert: (self collection occurrencesOf: self anotherElementOrAssociationIn) = self numberOfSimilarElementsInIntersection.
	self assert: (inter includes: self anotherElementOrAssociationIn value)! !

!ArrayTest methodsFor: 'testing' stamp: 'nice 11/3/2009 21:28'!
testIsLiteral
	"We work with a copy of literalArray, to avoid corrupting the code."
	
	| aLiteralArray |
	aLiteralArray := literalArray copy.
	self assert: aLiteralArray isLiteral.
	aLiteralArray at: 1 put: self class.
	self deny: aLiteralArray isLiteral.
	self deny: (literalArray as: WeakArray) isLiteral description: 'instances of Array subclasses are not literal'.! !

!ArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testBefore
	"self debug: #testBefore"
	self assert: (self moreThan4Elements before: (self moreThan4Elements at: 2)) = (self moreThan4Elements at: 1).
	self 
		should: [ self moreThan4Elements before: (self moreThan4Elements at: 1) ]
		raise: Error.
	self 
		should: [ self moreThan4Elements before: 66 ]
		raise: Error! !

!ArrayTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testLastIndexOfDuplicate
	"self debug: #testLastIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection first.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'lastIndexOf: should return the position of the last occurrence :'"
	self assert: (collection lastIndexOf: element) = collection size! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 3/27/2009 15:20'!
unsortedCollection
	^unsortedCollection .! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/15/2009 14:07'!
collectionOfFloat
	^ collectionOfCollection! !

!ArrayTest methodsFor: 'requirements' stamp: 'CamilloBruni 9/9/2011 12:09'!
collectionWithoutEqualElements
	^ withoutEqualElements ! !

!ArrayTest methodsFor: 'test - creation' stamp: ''!
testWith
	"self debug: #testWith"
	
	| aCol anElement |
	anElement := self collectionMoreThan5Elements anyOne.
	aCol := self collectionClass with: anElement.
	self assert: (aCol includes: anElement).! !

!ArrayTest methodsFor: 'tests - sequence isempty' stamp: ''!
testSequenceIfNotEmptyifEmpty

	self assert: (self nonEmpty ifEmpty: [false] ifNotEmpty: [:s | (self accessValuePutInOn: s) = self valuePutIn])! !

!ArrayTest methodsFor: 'tests - converting' stamp: ''!
testAsArray
	"self debug: #testAsArray3"
	self 
		assertSameContents: self collectionWithoutEqualElements
		whenConvertedTo: Array! !

!ArrayTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedArray
	| result collection |
	collection := self collectionWithSortableElements .
	result := collection  asArray sort.
	self assert: (result class includesBehavior: Array).
	self assert: result isSorted.
	self assert: result size = collection size! !

!ArrayTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAnyNoneThere
	"self debug: #testIncludesAnyOfNoneThere'"
	
	self deny: (self nonEmpty includesAny: self empty).
	self deny: (self nonEmpty includesAny: { self elementNotIn. self anotherElementNotIn })! !

!ArrayTest methodsFor: 'tests - copy' stamp: ''!
testCopyNotSame
	"self debug: #testCopySameClass"
	"A copy of a collection should always be of the same class as the instance it copies"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: copy  == self nonEmpty.! !

!ArrayTest methodsFor: 'tests - set arithmetic' stamp: ''!
testUnionOfEmpties
	"self debug: #testUnionOfEmpties"
	
	self assert:  (self empty union: self empty) isEmpty.
	
	! !

!ArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindFirst

	| element result |
	element := self nonEmptyMoreThan1Element   at:1.
	 result:=self nonEmptyMoreThan1Element  findFirst: [:each | each =element].
	
	self assert: result=1. ! !

!ArrayTest methodsFor: 'tests - copying part of sequenceable for multipliness' stamp: ''!
testCopyUpToWithDuplicate
	| result element  collection |
	collection := self collectionWithSameAtEndAndBegining .
	element := collection  last.
	
	" collectionWithSameAtEndAndBegining first and last elements are equals.
	'copyUpTo:' should copy until the first occurence :"
	result := collection   copyUpTo: (element ).
	
	"verifying content: "
	self assert: result isEmpty.

! !

!ArrayTest methodsFor: 'requirements' stamp: 'damiencassou 1/27/2009 10:35'!
firstOdd
	"Returns the first odd number of #collection"
	^ 1! !

!ArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithIndexCollect
	
	| result index collection |
	index := 0.
	collection := self nonEmptyMoreThan1Element .
	result := collection  withIndexCollect: [:each :i | 
		self assert: i = (index := index + 1).	
		self assert: i = (collection  indexOf: each) .
		each] . 
	
	1 to: result size do:[: i | self assert: (result at:i)= (collection at: i)].
	self assert: result size = collection size.! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 3/31/2009 10:29'!
firstIndex
	^ firstIndex ! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
testOFixtureReplacementSequencedTest

	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	
	self elementInForReplacement.
	self assert: (self nonEmpty includes: self elementInForReplacement ) .
	
	self newElement.
	
	self firstIndex.
	self assert: (self firstIndex >= 1 & self firstIndex <= self nonEmpty size).
	
	self secondIndex.
	self assert: (self secondIndex >= 1 & self secondIndex <= self nonEmpty size).
	
	self assert: self firstIndex <=self secondIndex .
	
	self replacementCollection.
	
	self replacementCollectionSameSize.
	self assert: (self secondIndex  - self firstIndex +1)= self replacementCollectionSameSize size
	! !

!ArrayTest methodsFor: 'tests - printing' stamp: ''!
testPrintElementsOn

	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printElementsOn: aStream .
	allElementsAsString:=(result findBetweenSubStrs: ' ' ).
	1 to: allElementsAsString size do:
		[:i | 
		self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString).
			].! !

!ArrayTest methodsFor: 'tests - begins ends with' stamp: ''!
testsEndsWithEmpty
	
	self deny: (self nonEmpty endsWith: self empty).
	self deny: (self empty endsWith: self nonEmpty).
	! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIterateSequencedReadableTest

	| res |
	
	self nonEmptyMoreThan1Element.
	self assert: self nonEmptyMoreThan1Element  size > 1.
	
	
	self empty.
	self assert: self empty isEmpty .
	
	res := true.
	self nonEmptyMoreThan1Element    
	detect: [ :each | (self nonEmptyMoreThan1Element    occurrencesOf: each) > 1 ]
	ifNone: [ res := false ].
	self assert: res = false.! !

!ArrayTest methodsFor: 'tests - concatenation' stamp: ''!
testConcatenationWithEmpty
	| result |
	result:= self empty,self secondCollection .
	
	1 to: self secondCollection size do:
		[:i | 
		self assert: (self secondCollection at:i)= (result at:i).
		].
	"size : "
	self assert: result size = ( self secondCollection size).! !

!ArrayTest methodsFor: 'tests - accessing' stamp: 'delaunay 4/10/2009 16:19'!
testAtWrap2
	| tabTest |
	tabTest := #(5 6 8 ).
	self assert: (tabTest atWrap: 2) = 6.
	self assert: (tabTest atWrap: 7) = 5.
	self assert: (tabTest atWrap: 5) = 6.
	self assert: (tabTest atWrap: 0) = 8.
	self assert: (tabTest atWrap: 1) = 5.
	self assert: (tabTest atWrap: -2) = 5! !

!ArrayTest methodsFor: 'tests - copying part of sequenceable for multipliness' stamp: ''!
testCopyUpToLastWithDuplicate
	| result element  collection |
	collection := self collectionWithSameAtEndAndBegining .
	element := collection  first.
	
	" collectionWithSameAtEndAndBegining first and last elements are equals.
	'copyUpToLast:' should copy until the last occurence :"
	result := collection   copyUpToLast: (element ).
	
	"verifying content: "
	1 to: result size do:
		[:i |
		self assert: (result at: i ) = ( collection at: i )  
		].
	
	self assert: result size = (collection size - 1).

! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/24/2009 14:45'!
anotherElementNotIn
	^ elementNotInForCopy ! !

!ArrayTest methodsFor: 'tests - puting with indexes' stamp: ''!
testAtAllIndexesPut
	
	self nonEmpty atAllPut: self aValue.
	self nonEmpty do:[ :each| self assert: each = self aValue].
	! !

!ArrayTest methodsFor: 'tests - puting with indexes' stamp: ''!
testSwapWith
	"self debug: #testSwapWith"
	| result index |
	index := self indexArray anyOne.
	result:= self nonEmpty copy .
	result swap: index with: 1.
	self assert: (result at: index) = (self nonEmpty at:1).
	self assert: (result at: 1) = (self nonEmpty at: index).
	! !

!ArrayTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithSequenceable

	| result index element |
	index := self indexInNonEmpty .
	element := self nonEmpty at: index.
	result := self nonEmpty copyWith: (element ).
	
	self assert: result size = (self nonEmpty size + 1).
	self assert: result last = element .
	
	1 to: (result size - 1) do:
	[ :i |
	self assert: (result at: i) = ( self nonEmpty at: ( i  ))].! !

!ArrayTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterLastEmpty

	| delim emptyStream |
	delim := ', '.
	emptyStream := ReadWriteStream on: ''.
	self empty asStringOn: emptyStream delimiter: delim last:'and'.
	self assert: emptyStream contents = ''.
! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/17/2009 10:28'!
collectionWith1TimeSubcollection
	^ (self oldSubCollection copyWithoutFirst),self oldSubCollection,(self oldSubCollection copyWithoutFirst). ! !

!ArrayTest methodsFor: 'tests - puting with indexes' stamp: ''!
testAtAllPut
	| |
	self nonEmpty atAll: self indexArray put: self aValue..
	
	self indexArray do:
		[:i | self assert: (self nonEmpty at: i)=self aValue ].
	! !

!ArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testAtOutOfBounds
	"self debug: #testAtOutOfBounds"
	self 
		should: [ self moreThan4Elements at: self moreThan4Elements size + 1 ]
		raise: Error.
	self 
		should: [ self moreThan4Elements at: -1 ]
		raise: Error! !

!ArrayTest methodsFor: 'test - creation' stamp: ''!
testOfSize
	"self debug: #testOfSize"
	
	| aCol |
	aCol := self collectionClass ofSize: 3.
	self assert: (aCol size = 3).
! !

!ArrayTest methodsFor: 'tests - occurrencesOf' stamp: 'delaunay 4/2/2009 11:52'!
testOccurrencesOfEmpty
	| result |
	result := self empty occurrencesOf: self elementInForOccurrences.
	self assert: result = 0! !

!ArrayTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyEmpty
	"self debug: #testCopyEmpty"
	
	| copy | 
	copy := self empty copy.
	self assert: copy isEmpty.! !

!ArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithCollect
	
	| result firstCollection secondCollection index  |

	firstCollection := self nonEmptyMoreThan1Element.
	secondCollection := firstCollection copy.
	index := 0.
	
	result := firstCollection  with: secondCollection collect:
		[:a :b |
		( index := index + 1).
		self assert: (firstCollection at: index) equals:  a. 
		self assert: (secondCollection at: index) equals:  b.
		b].
	
	1 to: result size do:[: i | self assert: (result at:i)= (secondCollection  at: i)].
	self assert: result size = secondCollection  size.! !

!ArrayTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterLastOne

	| delim oneItemStream result |
	
	delim := ', '.
	result:=''.
	oneItemStream := ReadWriteStream on: result.
	self nonEmpty1Element  asStringOn: oneItemStream delimiter: delim last: 'and'.
	oneItemStream do:[:each | self assert: each = (self nonEmpty1Element first asString)].
	

	! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSetAritmeticTest
	self collection.
	self deny: self collection isEmpty.
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self anotherElementOrAssociationNotIn.
	self collection isDictionary
		ifTrue: [ self deny: (self collection associations includes: self anotherElementOrAssociationNotIn key) ]
		ifFalse: [ self deny: (self collection includes: self anotherElementOrAssociationNotIn) ].
	self collectionClass! !

!ArrayTest methodsFor: 'tests - printing' stamp: ''!
testPrintOnDelimiter
	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printOn: aStream delimiter: ', ' .
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString).
			].! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/15/2009 14:22'!
elementInCollectionOfFloat
	^ collectionOfCollection atRandom! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/23/2009 11:39'!
collectionWithoutNilElements
" return a collection that doesn't includes a nil element  and that doesn't includes equal elements'"
	^ collectionWithoutNil  ! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixturePutTest
	self aValue.
	self anotherValue.
	
	self anIndex.
	self nonEmpty isDictionary 
		ifFalse:[self assert: (self anIndex >=1 & self anIndex <= self nonEmpty size).].
	
	self empty.
	self assert: self empty isEmpty .
	
	self nonEmpty.
	self deny: self nonEmpty  isEmpty.! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIncludeWithIdentityTest
	| anElement |
	self collectionWithCopyNonIdentical.
	anElement := self collectionWithCopyNonIdentical anyOne.
	self deny: anElement == anElement copy! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureTConvertTest
	"a collection of number without equal elements:"

	| res |
	self collectionWithoutEqualElements.
	res := true.
	self collectionWithoutEqualElements
		detect: [ :each | (self collectionWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false! !

!ArrayTest methodsFor: 'tests - replacing' stamp: ''!
testReplaceFromToWithStartingAt
	| result  repStart collection replacementCollec firstInd secondInd |
	collection := self nonEmpty .
	result := collection copy.
	replacementCollec := self replacementCollectionSameSize .
	firstInd := self firstIndex .
	secondInd := self secondIndex .
	repStart := replacementCollec  size - ( secondInd  - firstInd   + 1 ) + 1.
	result replaceFrom: firstInd  to: secondInd with: replacementCollec  startingAt: repStart   .
	
	"verify content of 'result' : "
	"first part of 'result'' : '" 
	
	1 to: ( firstInd  - 1 ) do: [ :i | self assert: ( collection  at:i ) = ( result at: i ) ].
	
	" middle part containing replacementCollection : "
	
	( firstInd ) to: ( replacementCollec   size - repStart +1 ) do: 
		[:i|
		self assert: (result at: i)=( replacementCollec   at: ( repStart  + ( i  - firstInd  ) ) ) ].
	
	" end part :"
	( firstInd  + replacementCollec   size ) to: ( result size ) do:
		[ :i |
		self assert: ( result at: i ) = ( collection  at: ( secondInd  + 1 - ( firstInd  + replacementCollec   size ) + i ) ) ].! !

!ArrayTest methodsFor: 'requirements' stamp: ''!
valueArray
" return a collection (with the same size than 'indexArray' )of values to be put in 'nonEmpty'  at indexes in 'indexArray' "
	| result |
	result := Array new: self indexArray size.
	1 to: result size do:
		[:i |
		result at:i put: (self aValue ).
		].
	^ result.! !

!ArrayTest methodsFor: 'tests - converting' stamp: 'TorstenBergmann 11/19/2014 10:30'!
testAsArrayKeepsIdentity
	 
	|x y|
	x := #(1 2 3 4 5).
	y := x asArray.
	self assert: y identityHash = x identityHash! !

!ArrayTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterMore

	| delim multiItemStream result index |
	"delim := ', '.
	multiItemStream := '' readWrite.
	self oneTwoThreeItemCol asStringOn: multiItemStream delimiter: ', '.
	self assert: multiItemStream contents = '1, 2, 3'."
	
	delim := ', '.
	result:=''.
	multiItemStream := ReadWriteStream on:result.
	self nonEmpty  asStringOn: multiItemStream delimiter: ', '.
	
	index:=1.
	(result findBetweenSubStrs: ', ' )do:
		[:each |
		self assert: each= ((self nonEmpty at:index)asString).
		index:=index+1
		].! !

!ArrayTest methodsFor: 'helpers' stamp: 'stephane.ducasse 1/12/2009 17:13'!
anIndex

	^ 2! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 14:01'!
collectionMoreThan5Elements
" return a collection including at least 5 elements"
	
	^ collection5Elements ! !

!ArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testDetectSequenced
" testing that detect keep the first element returning true for sequenceable collections "

	| element result |
	element := self nonEmptyMoreThan1Element   at:1.
	result:=self nonEmptyMoreThan1Element  detect: [:each | each notNil ].
	self assert: result = element. ! !

!ArrayTest methodsFor: 'tests - includes' stamp: ''!
testIdentityIncludesNonSpecificComportement
	" test the same comportement than 'includes: '  "
	| collection |	
	collection := self nonEmpty  .
	
	self deny: (collection identityIncludes: self elementNotIn ).
	self assert:(collection identityIncludes: collection anyOne)
! !

!ArrayTest methodsFor: 'test - iterate' stamp: 'delaunay 4/14/2009 14:13'!
testDo2

	| res |
	res := OrderedCollection new.  
	self collection do: [:each | res add: each class].
	self assert: res asArray = self result. ! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureAsStringCommaAndDelimiterTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty.
	self nonEmpty1Element.
	self assert: self nonEmpty1Element size = 1! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/23/2009 15:16'!
collectionMoreThan1NoDuplicates
	" return a collection of size 5 without equal elements"
	^ withoutEqualElements ! !

!ArrayTest methodsFor: 'tests - sorting' stamp: ''!
testSorted
	| result tmp unsorted |
	unsorted := self unsortedCollection.
	result := unsorted sorted.
	self deny: unsorted == result.
	tmp := result at: 1.
	result
		do: [ :each | 
			self assert: each >= tmp.
			tmp := each ]! !

!ArrayTest methodsFor: 'tests - enumerating' stamp: ''!
testFlattened

	self assert: self simpleCollection flattened equals: #(1 8 3).
	self assert: self collectionOfCollectionsOfInts flattened equals: #( 1 2 3 4 5 6 ).
	self assert: self collectionWithCharacters flattened equals: #($a $x $d $c $m).
	self assert: self collectionOfCollectionsOfStrings flattened equals: #('foo' 'bar' 'zorg').! !

!ArrayTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAnyAllThere
	"self debug: #testIncludesAnyOfAllThere'"
	self deny: (self nonEmpty includesAny: self empty).
	self assert: (self nonEmpty includesAny: { self nonEmpty anyOne }).
	self assert: (self nonEmpty includesAny: self nonEmpty).! !

!ArrayTest methodsFor: 'test - copy' stamp: 'delaunay 4/17/2009 15:26'!
elementToAdd
	^ 55! !

!ArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testPairsDo
	| index |
	index:=1.
	
	self nonEmptyMoreThan1Element  pairsDo: 
		[:each1 :each2 | 
		self assert:(self nonEmptyMoreThan1Element at:index)=each1.
		self assert:(self nonEmptyMoreThan1Element at:(index+1))=each2.
		index:=index+2].
	
	self nonEmptyMoreThan1Element size odd
		ifTrue:[self assert: index=self nonEmptyMoreThan1Element size]
		ifFalse:[self assert: index=(self nonEmptyMoreThan1Element size+1)].! !

!ArrayTest methodsFor: 'requirements' stamp: ''!
collectionWithCopy
	"return a collection of type 'self collectionWIithoutEqualsElements class' containing no elements equals ( with identity equality)
	but  2 elements only equals with classic equality"
	| result collection |
	collection := OrderedCollection withAll: self elementsCopyNonIdenticalWithoutEqualElements.
	collection add: collection first copy.
	result := self elementsCopyNonIdenticalWithoutEqualElements class withAll: collection.
	^ result! !

!ArrayTest methodsFor: 'tests - subcollections access' stamp: ''!
testLastNElements
	"self debug: #testLastNElements"
	| result |
	result := self moreThan3Elements last: self moreThan3Elements size - 1.
	1 
		to: result size
		do: [ :i | self assert: (result at: i) = (self moreThan3Elements at: i + 1) ].
	self assert: result size = (self moreThan3Elements size - 1).
	self 
		should: [ self moreThan3Elements last: self moreThan3Elements size + 1 ]
		raise: Error! !

!ArrayTest methodsFor: 'requirements' stamp: 'stephane.ducasse 10/30/2008 19:02'!
accessCollection

	^ example1! !

!ArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testCollectFromTo
	
	| result |
	result:=self nonEmptyMoreThan1Element 
		collect: [ :each | each ]
		from: 1
		to: (self nonEmptyMoreThan1Element size - 1).
		
	1 to: result size
		do: [ :i | self assert: (self nonEmptyMoreThan1Element at: i) = (result at: i) ].
	self assert: result size = (self nonEmptyMoreThan1Element size - 1)! !

!ArrayTest methodsFor: 'tests - enumerating' stamp: ''!
testFlatCollect

	self assert: (self simpleCollection flatCollect: [ :x | { x } ]) equals: self simpleCollection.
	self assert: (self simpleCollection flatCollect: [ :x | { x } ]) species = self simpleCollection species.
	
	self 
		assert: (self collectionOfCollectionsOfInts flatCollect: [ :x | { x } ]) 
		equals: self collectionOfCollectionsOfInts.
	self 
		assert: (self collectionWithCharacters flatCollect: [ :x | { x } ]) 
		equals: self collectionWithCharacters.
	self 
		assert: (self collectionOfCollectionsOfStrings flatCollect: [ :x | { x } ]) 
		equals: self collectionOfCollectionsOfStrings! !

!ArrayTest methodsFor: 'tests - printing' stamp: ''!
testPrintNameOn

	| aStream result |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printNameOn: aStream .
	Transcript show: result asString.
	self nonEmpty class name first isVowel
		ifTrue:[ self assert: aStream contents =('an ',self nonEmpty class name ) ]
		ifFalse:[self assert: aStream contents =('a ',self nonEmpty class name)].! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0SortingArrayedTest
	| tmp sorted |
	" an unsorted collection of number "
	self unsortedCollection.
	self unsortedCollection do: [ :each | each isNumber ].
	sorted := true.
	self unsortedCollection
		pairsDo: [ :each1 :each2 | 
			each2 < each1
				ifTrue: [ sorted := false ] ].
	self assert: sorted = false.	" a collection of number sorted in an ascending order"
	self sortedInAscendingOrderCollection.
	self sortedInAscendingOrderCollection do: [ :each | each isNumber ].
	tmp := self sortedInAscendingOrderCollection at: 1.
	self sortedInAscendingOrderCollection
		do: [ :each | 
			self assert: each >= tmp.
			tmp := each ]! !

!ArrayTest methodsFor: 'tests - copying with replacement' stamp: ''!
testCopyReplaceAllWithManyOccurence
	| result firstIndexesOfOccurrence resultBetweenPartIndex collectionBetweenPartIndex diff |
	" testing fixture here as this method may be not used for collection that can't contain equals element :"
	self collectionWith2TimeSubcollection.
	self assert: (self howMany: self oldSubCollection in: self collectionWith2TimeSubcollection) = 2.	" test :"
	diff := self replacementCollection size - self oldSubCollection size.
	result := self collectionWith2TimeSubcollection copyReplaceAll: self oldSubCollection with: self replacementCollection.	"detecting indexes of olSubCollection"
	firstIndexesOfOccurrence := self firstIndexesOf: self oldSubCollection in: self collectionWith2TimeSubcollection.	" verifying that replacementCollection has been put in places of oldSubCollections "
	firstIndexesOfOccurrence
		do: [ :each | 
			(firstIndexesOfOccurrence indexOf: each) = 1
				ifTrue: [ each to: self replacementCollection size do: [ :i | self assert: (result at: i) = (self replacementCollection at: i - each + 1) ] ]
				ifFalse: [ each + diff to: self replacementCollection size do: [ :i | self assert: (result at: i) = (self replacementCollection at: i - each + 1) ] ] ].	" verifying that the 'between' parts correspond to the initial collection : "
	1 to: firstIndexesOfOccurrence size do: [ :i | 
		i = 1
			ifTrue: [ 1 to: (firstIndexesOfOccurrence at: i) - 1 do: [ :j | self assert: (result at: i) = (self collectionWith2TimeSubcollection at: i) ] ]
			ifFalse: [ 
				resultBetweenPartIndex := (firstIndexesOfOccurrence at: i - 1) + self replacementCollection size.
				collectionBetweenPartIndex := (firstIndexesOfOccurrence at: i - 1) + self oldSubCollection size.
				1 to: (firstIndexesOfOccurrence at: i) - collectionBetweenPartIndex - 1 do: [ :j | 
					self
						assert:
							(result at: resultBetweenPartIndex + i - 1)
								= (self collectionWith2TimeSubcollection at: collectionBetweenPartIndex + i - 1) ] ]	" specific comportement for the begining of the collection :"	" between parts till the end : " ].	"final part :"
	1 to: self collectionWith2TimeSubcollection size - (firstIndexesOfOccurrence last + self oldSubCollection size) do: [ :i | 
		self
			assert:
				(result at: firstIndexesOfOccurrence last + self replacementCollection size - 1 + i)
					= (self collectionWith2TimeSubcollection at: firstIndexesOfOccurrence last + self oldSubCollection size - 1 + i) ]! !

!ArrayTest methodsFor: 'test - equality' stamp: ''!
testEqualSignIsTrueForNonIdenticalButEqualCollections
	"self debug: #testEqualSignIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty = self empty copy). 
	self assert: (self empty copy = self empty).
	self assert: (self empty copy = self empty copy).
		
	self assert: (self nonEmpty = self nonEmpty copy). 
	self assert: (self nonEmpty copy = self nonEmpty).
	self assert: (self nonEmpty copy = self nonEmpty copy).! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 14:39'!
elementInForElementAccessing
" return an element inculded in 'accessCollection '"
	^ self accessCollection anyOne! !

!ArrayTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testIndexOfStartingAtDuplicate
	"self debug: #testLastIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection last.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'indexOf:ifAbsent:startingAt: should return the position of the first occurrence :'"
	self assert: (collection 
			indexOf: element
			startingAt: 1
			ifAbsent: [ 55 ]) = 1.
	self assert: (collection 
			indexOf: element
			startingAt: 2
			ifAbsent: [ 55 ]) = collection size! !

!ArrayTest methodsFor: 'tests - copying with replacement' stamp: ''!
testCopyReplaceFromToWithInsertion
	| result  indexOfSubcollection |
	
	indexOfSubcollection := (self firstIndexesOf: self oldSubCollection  in:  self collectionWith1TimeSubcollection) at: 1. 
	
	result := self collectionWith1TimeSubcollection  copyReplaceFrom: indexOfSubcollection  to: ( indexOfSubcollection - 1 ) with: self replacementCollection .
	
	"verify content of 'result' : "
	"first part of 'result'' : '"
	
	1 to: (indexOfSubcollection -1) do: 
		[
		:i | 
		self assert: (self collectionWith1TimeSubcollection  at:i)=(result at: i)
		].
	
	" middle part containing replacementCollection : "
	indexOfSubcollection  to: (indexOfSubcollection  + self replacementCollection size-1) do: 
		[
		:i |
		self assert: ( result at: i )=(self replacementCollection at: ( i - indexOfSubcollection +1 ))
		].
	
	" end part :"
	(indexOfSubcollection  + self replacementCollection size) to: (result size) do:
		[:i|
		self assert: (result at: i)=(self collectionWith1TimeSubcollection  at: (i-self replacementCollection size))].
	
	" verify size: "	
	self assert: result size=(self collectionWith1TimeSubcollection  size + self replacementCollection size).
	

	

	
	! !

!ArrayTest methodsFor: 'tests - replacing' stamp: ''!
testReplaceFromToWith
	| result  collection replacementCollec firstInd secondInd |
	collection := self nonEmpty .
	replacementCollec := self replacementCollectionSameSize .
	firstInd := self firstIndex .
	secondInd := self secondIndex .
	result := collection  copy.
	result replaceFrom: firstInd  to: secondInd  with: replacementCollec .
	
	"verify content of 'result' : "
	"first part of 'result'' : '"
	
	1 to: ( firstInd - 1 ) do: [ :i | self assert: (collection  at:i ) = ( result at: i ) ].
	
	" middle part containing replacementCollection : "
	
	( firstInd ) to: ( firstInd  + replacementCollec size - 1 ) do: 
		[ :i |
		self assert: ( result at: i ) = ( replacementCollec  at: ( i - firstInd  +1 ) ) 
		].
	
	" end part :"
	( firstInd  + replacementCollec   size) to: (result size) do:
		[:i|
		self assert: ( result at: i ) = ( collection at: ( secondInd  + 1 - ( firstInd + replacementCollec size ) + i ) ) ].
	
	! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/6/2009 10:16'!
newElement
	^999! !

!ArrayTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsCommaStringMore

	"self assert: self oneTwoThreeItemCol asCommaString = '1, 2, 3'.
	self assert: self oneTwoThreeItemCol asCommaStringAnd = '1, 2 and 3'
"

	| result resultAnd index allElementsAsString |
	result:= self nonEmpty asCommaString .
	resultAnd:= self nonEmpty asCommaStringAnd .
 
	index := 1.
	(result findBetweenSubStrs: ',' )do:
		[:each |
		index = 1
			ifTrue: [self assert: each= ((self nonEmpty at:index)asString)]
			ifFalse: [self assert: each= (' ',(self nonEmpty at:index) asString)].
		index:=index+1
		].
	
	"verifying esultAnd :"
	allElementsAsString:=(resultAnd findBetweenSubStrs: ',' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size )
			ifTrue: [
			i = 1
				ifTrue:[self assert: (allElementsAsString at:i)=((self nonEmpty at:i) asString)]
				ifFalse:[self assert: (allElementsAsString at:i)=(' ',(self nonEmpty at:i) asString)]
				].
		i=(allElementsAsString size)
			ifTrue:[ 
			i = 1
				ifTrue:[self assert: (allElementsAsString at:i)=( (self nonEmpty at:i ) asString ,' and ', (self nonEmpty at: ( i + 1) ) asString )]
				ifFalse:[self assert: (allElementsAsString at:i)=( ' ' , (self nonEmpty at:i ) asString ,' and ', (self nonEmpty at: ( i + 1) ) asString )]
				].
		
		
			].! !

!ArrayTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWith
	"self debug: #testCopyNonEmptyWith"
	| res anElement |
	anElement := self elementToAdd .
	res := self nonEmpty copyWith: anElement.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self assert: (res includes: (anElement value)).
	self nonEmpty do: [ :each | res includes: each ]! !

!ArrayTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfterLastEmpty
	| result |
	result := self empty copyAfterLast: self collectionWithoutEqualElements first.
	self assert: result isEmpty.! !

!ArrayTest methodsFor: 'tests - copy' stamp: 'delaunay 3/30/2009 10:33'!
testCopyNonEmptyWithoutAllNotIncluded
	! !

!ArrayTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyEmptyMethod
	| result |
	result := self collectionWithoutEqualElements  copyEmpty .
	self assert: result isEmpty .
	self assert: result class= self nonEmpty class.! !

!ArrayTest methodsFor: 'tests - index access' stamp: ''!
testIdentityIndexOfIAbsent
	| collection element |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			identityIndexOf: element
			ifAbsent: [ 0 ]) = 1.
	self assert: (collection 
			identityIndexOf: self elementNotInForIndexAccessing
			ifAbsent: [ 55 ]) = 55! !

!ArrayTest methodsFor: 'tests - puting with indexes' stamp: ''!
testAtAllPutAll

	| aValueArray |
	aValueArray := self valueArray .
	self nonEmpty atAll: self indexArray putAll: aValueArray  .
	
	1 to: self indexArray size do:
		[:i |
		self assert: (self nonEmpty at:(self indexArray at: i))= (aValueArray  at:i) ]! !

!ArrayTest methodsFor: 'tests - find binary' stamp: 'SvenVanCaekenberghe 3/8/2012 14:17'!
testFindBinary
	self assert: (#(1 3 5 7 11 15 23) findBinary: [ :arg | 1 - arg ]) = 1.
	self assert: (#(1 3 5 7 11 15 23) findBinary: [ :arg | 23 - arg ]) = 23.
	self assert: (#(1 3 5 7 11 15 23) findBinary: [ :arg | 11 - arg ]) = 11.
	self should: [ #(1 3 5 7 11 15 23) findBinary: [ :arg | 8 - arg ] ] raise: NotFound! !

!ArrayTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 3/26/2009 09:57'!
collectionWithEqualElements
	^ withEqualElements.! !

!ArrayTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfSubCollectionStartingAt
	"self debug: #testIndexOfIfAbsent"
	| subcollection index collection |
	collection := self collectionMoreThan1NoDuplicates.
	subcollection := self collectionMoreThan1NoDuplicates.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 1.
	self assert: index = 1.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 2.
	self assert: index = 0! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/24/2009 10:27'!
collectionWithSortableElements
" return a collection elements that can be sorte ( understanding message ' < '  or ' > ')"
	^ withoutEqualElements ! !

!ArrayTest methodsFor: 'tests - copying part of sequenceable for multipliness' stamp: ''!
testCopyAfterWithDuplicate
	| result element  collection |
	collection := self collectionWithSameAtEndAndBegining .
	element := collection  last.
	
	" collectionWithSameAtEndAndBegining first and last elements are equals.
	'copyAfter:' should copy after the first occurence :"
	result := collection   copyAfter: (element ).
	
	"verifying content: "
	1 to: result size do: 
		[:i |
		self assert: (collection  at:(i + 1 )) = (result at: (i))
		].

	"verify size: "
	self assert: result size = (collection size - 1).! !

!ArrayTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedCollectionWithSortBlock
	| result tmp |
	result := self collectionWithSortableElements  asSortedCollection: [:a :b | a > b].
	self assert: (result class includesBehavior: SortedCollection).
	result do: 
		[ :each | 
		self assert: (self collectionWithSortableElements   occurrencesOf: each) = (result occurrencesOf: each) ].
	self assert: result size = self collectionWithSortableElements  size.
	tmp:=result at: 1.
	result do: [:each| self assert: tmp>=each. tmp:=each].
	! !

!ArrayTest methodsFor: 'tests - enumerating' stamp: ''!
testFlatCollectAs

	self 
		assert: (self simpleCollection flatCollect: [ :x | { x }, { x } ] as: IdentitySet) 
		equals: self simpleCollection asIdentitySet! !

!ArrayTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:23'!
test0FixtureTConvertAsSetForMultiplinessTest
	"a collection ofFloat with equal elements:"

	| res |
	self withEqualElements.
	self withEqualElements do: [ :each | self assert: each class = Float ].
	res := true.
	self withEqualElements detect: [ :each | (self withEqualElements occurrencesOf: each) > 1 ] ifNone: [ res := false ].
	self assert: res = true.	"a collection of Float without equal elements:"
	self elementsCopyNonIdenticalWithoutEqualElements.
	self elementsCopyNonIdenticalWithoutEqualElements do: [ :each | self assert: each class = Float ].
	res := true.
	self elementsCopyNonIdenticalWithoutEqualElements
		detect: [ :each | (self elementsCopyNonIdenticalWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false! !

!ArrayTest methodsFor: 'tests - sorting' stamp: ''!
testSortedUsingBlock
	| result tmp |
	result := self unsortedCollection sorted:  [:a :b | a>b]..
	tmp := result at: 1.
	result do:
		[:each | self assert: each<=tmp. tmp:= each. ].! !

!ArrayTest methodsFor: 'tests - index access' stamp: 'delaunay 4/15/2009 14:22'!
testIdentityIndexOf
	"self debug: #testIdentityIndexOf"
	| collection element |
	element := self elementInCollectionOfFloat copy.
	self deny: self elementInCollectionOfFloat == element.
	collection := self collectionOfFloat copyWith: element.
	self assert: (collection identityIndexOf: element) = collection size! !

!ArrayTest methodsFor: 'testing' stamp: 'dc 5/24/2007 10:56'!
testNewWithSize
	|array|
	array := Array new: 5.
	self assert: array size = 5.
	1 to: 5 do: [:index | self assert: (array at: index) isNil]! !

!ArrayTest methodsFor: 'test - creation' stamp: ''!
testWithAll
	"self debug: #testWithAll"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection .
	aCol := self collectionClass withAll: collection  .
	
	collection do: [ :each | self assert: (aCol occurrencesOf: each ) = ( collection occurrencesOf: each ) ].
	
	self assert: (aCol size = collection size ).! !

!ArrayTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:53'!
test0FixtureOccurrencesTest
	self empty.
	self assert: self empty isEmpty.
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self elementInForOccurrences.
	self assert: (self nonEmpty includes: self elementInForOccurrences).
	self elementNotInForOccurrences.
	self deny: (self nonEmpty includes: self elementNotInForOccurrences)! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIndexAccessTest
	| res collection element |
	self collectionMoreThan1NoDuplicates.
	self assert: self collectionMoreThan1NoDuplicates size > 1.
	res := true.
	self collectionMoreThan1NoDuplicates
		detect: [ :each | (self collectionMoreThan1NoDuplicates occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false.
	self elementInForIndexAccessing.
	self
		assert: ((collection := self collectionMoreThan1NoDuplicates) includes: (element := self elementInForIndexAccessing)).
	self elementNotInForIndexAccessing.
	self deny: (self collectionMoreThan1NoDuplicates includes: self elementNotInForIndexAccessing)! !

!ArrayTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testComplexIsSelfEvaluating
	"self run: #testComplexIsSelfEvaluating"

	| complexArray restoredArray |
	complexArray := {1.
	true.
	false.
	nil.
	#a.
	'a'.
	$a.
	(Float pi).
	(Float halfPi).
	(4 / 5).
	(Float infinity negated).
	(Color red).
	(1 @ 2).
	(0 @ 0 extent: 1 @ 1).
	('hola' -> 0).
	Object.
	(Object class)}.
	complexArray := complexArray copyWith: complexArray.
	self assert: complexArray isSelfEvaluating.
	restoredArray := self class evaluate: complexArray printString.
	self assert: restoredArray = complexArray! !

!ArrayTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyCreatesNewObject
	"self debug: #testCopyCreatesNewObject"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: self nonEmpty == copy.
	! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 3/27/2009 15:20'!
sortedInAscendingOrderCollection
	^sortedInAscendingOrderCollection .
	! !

!ArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithDo
	
	| firstCollection secondCollection index |

	firstCollection := self nonEmptyMoreThan1Element.
	secondCollection := firstCollection copy.
	index := 0.
	
	firstCollection  with: secondCollection do:
		[:a :b |
		( index := index + 1).
		self assert: (firstCollection at: index) equals:  a. 
		self assert: (secondCollection at: index) equals:  b.]
	
	! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/2/2009 16:41'!
secondCollection
	^example2 ! !

!ArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithDoError
	
	self should: [self nonEmptyMoreThan1Element with: self empty do:[:a :b | ]] raise: Error.! !

!ArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testAllButFirstDo
	
	| result |
	result:= OrderedCollection  new.
	
	self nonEmptyMoreThan1Element  allButFirstDo: [:each | result add: each].
	
	1 to: (result size) do:
		[:i|
		self assert: (self nonEmptyMoreThan1Element  at:(i +1))=(result at:i)].
	
	self assert: result size=(self nonEmptyMoreThan1Element  size-1).! !

!ArrayTest methodsFor: 'test - iterate' stamp: 'damienpollet 1/13/2009 16:28'!
testAnySatisfy

	self assert: ( self collection anySatisfy: [:each | each = -2]).
	self deny: (self collection anySatisfy: [:each | each isString]).! !

!ArrayTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithout
	"self debug: #testCopyNonEmptyWithout"
	
	| res anElementOfTheCollection |
	anElementOfTheCollection :=  self nonEmpty anyOne.
	res := (self nonEmpty copyWithout: anElementOfTheCollection).
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self deny: (res includes: anElementOfTheCollection).
	self nonEmpty do:
		[:each | (each = anElementOfTheCollection) 
					ifFalse: [self assert: (res includes: each)]].
	
! !

!ArrayTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutNotIncluded
	"self debug: #testCopyNonEmptyWithoutNotIncluded"
	| res |
	res := self nonEmpty copyWithout: self elementToAdd.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self nonEmpty do: [ :each | self assert: (res includes: each) ]! !

!ArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testAtWrap
	"self debug: #testAt"
	"
	self assert: (self accessCollection at: 1) = 1.
	self assert: (self accessCollection at: 2) = 2.
	"
	| index |
	index := self moreThan4Elements indexOf: self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: index) = self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: index + self moreThan4Elements size) = self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: index - self moreThan4Elements size) = self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: 1 + self moreThan4Elements size) = (self moreThan4Elements at: 1)! !

!ArrayTest methodsFor: 'tests - concatenation' stamp: ''!
testConcatenation
	| result index |
	result:= self firstCollection,self secondCollection .
	"first part : "
	index := 1.
	self firstCollection do: 
		[:each | 
		self assert: (self firstCollection at: index)=each.
		index := index+1.].
	"second part : "
	1 to: self secondCollection size do:
		[:i | 
		self assert: (self secondCollection at:i)= (result at:index).
		index:=index+1].
	"size : "
	self assert: result size = (self firstCollection size + self secondCollection size).! !

!ArrayTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionItself
	"self debug: #testIntersectionItself"
	
	| result |
	result :=  (self collectionWithoutEqualElements intersection: self collectionWithoutEqualElements).
	self assert: result size  = self collectionWithoutEqualElements size.
	self collectionWithoutEqualElements do: [ :each|
		self assert: (result includes: each) ].
	! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 3/31/2009 10:29'!
elementNotInForCopy
	^ elementNotInForCopy ! !

!ArrayTest methodsFor: 'tests - occurrencesOf' stamp: 'delaunay 4/2/2009 11:52'!
testOccurrencesOf
	| result expected |
	result := self nonEmpty occurrencesOf: self elementInForOccurrences.
	expected := 0.
	self nonEmpty do: [ :each | self elementInForOccurrences = each ifTrue: [ expected := expected + 1 ] ].
	self assert: result = expected! !

!ArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testKeysAndValuesDo
	"| result |
	result:= OrderedCollection new.
	
	self nonEmptyMoreThan1Element  keysAndValuesDo: 
		[:i :value|
		result add: (value+i)].
	
	1 to: result size do:
		[:i|
		self assert: (result at:i)=((self nonEmptyMoreThan1Element at:i)+i)]"
	|  indexes elements |
	indexes:= OrderedCollection new.
	elements := OrderedCollection new.
	
	self nonEmptyMoreThan1Element  keysAndValuesDo: 
		[:i :value|
		indexes  add: (i).
		elements add: value].
	
	(1 to: self nonEmptyMoreThan1Element size )do:
		[ :i |
		self assert: (indexes at: i) = i.
		self assert: (elements at: i) = (self nonEmptyMoreThan1Element at: i).	
		].
	
	self assert: indexes size = elements size. 
	self assert: indexes size = self nonEmptyMoreThan1Element size . 
	
	! !

!ArrayTest methodsFor: 'tests - converting' stamp: ''!
testAsOrderedCollection
	
	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: OrderedCollection! !

!ArrayTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:53'!
test0CopyTest
	self empty.
	self assert: self empty size = 0.
	self nonEmpty.
	self assert: (self nonEmpty size = 0) not.
	self collectionWithElementsToRemove.
	self assert: (self collectionWithElementsToRemove size = 0) not.
	self elementToAdd! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/13/2009 16:13'!
elementTwiceInForOccurrences
" return an element included exactly two time in # collectionWithEqualElements"
^ duplicateElement ! !

!ArrayTest methodsFor: 'tests - streaming' stamp: ''!
testStreamContentsProtocol
	| result index |
	result:= self collectionClass << [ :s|
		s 
			nextPutAll: self firstCollection;
			nextPutAll: self secondCollection ].
	self assert: result equals: self firstCollection, self secondCollection.! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/16/2009 16:56'!
indexInNonEmpty
	^ 2 ! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 14:17'!
collectionWithNonIdentitySameAtEndAndBegining
	" return a collection with elements at end and begining equals only with classic equality (they are not the same object).
(others elements of the collection are not equal to those elements)"
	^ floatCollectionWithSameBeginingAnEnd ! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSequencedConcatenationTest
	self empty.
	self assert: self empty isEmpty.
	self firstCollection.
	self secondCollection! !

!ArrayTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testIdentityIndexOfDuplicate
	"self debug: #testIdentityIndexOf"

	| collection element |
	"testing fixture here as this method may not be used by some collections testClass"
	self collectionWithNonIdentitySameAtEndAndBegining.
	collection := self collectionWithNonIdentitySameAtEndAndBegining.
	self assert: collection first = collection last.
	self deny: collection first == collection last.
	1 to: collection size do: [ :i | 
		i > 1 & (i < collection size)
			ifTrue: [ self deny: (collection at: i) = collection first ] ].
	element := collection last.	" floatCollectionWithSameAtEndAndBegining first and last elements are equals but are not the same object"
	self assert: (collection identityIndexOf: element) = collection size! !

!ArrayTest methodsFor: 'initialization' stamp: 'cyrille.delaunay 12/18/2009 11:59'!
result
	
	^ collectResult! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 10:22'!
collectionWithCopyNonIdentical
	" return a collection that include elements for which 'copy' return a different object (this is not the case of SmallInteger)"
	^ collectionOfCollection! !

!ArrayTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWithout
	"self debug: #testCopyEmptyWithout"
	| res |
	res := self empty copyWithout: self elementToAdd.
	self assert: res size = self empty size.
	self deny: (res includes: self elementToAdd)! !

!ArrayTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedCollection

	| aCollection result |
	aCollection := self collectionWithSortableElements .
	result := aCollection asSortedCollection.
	
	self assert: (result class includesBehavior: SortedCollection).
	result do: 
		[ :each | 
		self assert: (aCollection occurrencesOf: each) = (result occurrencesOf: each) ].
	
	self assert: result size = aCollection size.! !

!ArrayTest methodsFor: 'tests - begins ends with' stamp: ''!
testsBeginsWith
	
	self assert: (self nonEmpty beginsWith:(self nonEmpty copyUpTo: self nonEmpty last)).
	self assert: (self nonEmpty beginsWith:(self nonEmpty )).
	self deny: (self nonEmpty beginsWith:(self nonEmpty copyWith:self nonEmpty first)).! !

!ArrayTest methodsFor: 'test - creation' stamp: 'stephane.ducasse 12/9/2008 22:00'!
collectionClass 
	
	^ Array! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/8/2009 11:40'!
nonEmpty1Element

	^ nonEmpty1Element  ! !

!ArrayTest methodsFor: 'tests - begins ends with' stamp: ''!
testsBeginsWithEmpty
	
	self deny: (self nonEmpty beginsWith:(self empty)).
	self deny: (self empty beginsWith:(self nonEmpty )).
! !

!ArrayTest methodsFor: 'tests - set arithmetic' stamp: ''!
testUnion
	"self debug: #testUnionOfEmpties"
	
	| union |
	union := self empty union: self nonEmpty.
	self containsAll: union of: self empty andOf: self nonEmpty.
	union := self nonEmpty union: self empty.
	self containsAll: union of: self empty andOf: self nonEmpty.
	union := self collection union: self nonEmpty.
	self containsAll: union of: self collection andOf: self nonEmpty.! !

!ArrayTest methodsFor: 'tests - copying with replacement' stamp: ''!
testCopyReplaceFromToWith
	| result  indexOfSubcollection lastIndexOfOldSubcollection lastIndexOfReplacementCollection |
	
	indexOfSubcollection := (self firstIndexesOf: self oldSubCollection  in:  self collectionWith1TimeSubcollection) at: 1. 
	lastIndexOfOldSubcollection := indexOfSubcollection + self oldSubCollection size -1.
	lastIndexOfReplacementCollection := indexOfSubcollection + self replacementCollection  size -1.
	
	result := self collectionWith1TimeSubcollection  copyReplaceFrom: indexOfSubcollection  to: lastIndexOfOldSubcollection   with: self replacementCollection .
	
	"verify content of 'result' : "
	"first part of 'result'  "
	
	1 to: (indexOfSubcollection  - 1) do: 
		[ 
		:i | 
		self assert: (self collectionWith1TimeSubcollection  at:i) = (result at: i)
		].
	
	" middle part containing replacementCollection : "
	
	(indexOfSubcollection ) to: ( lastIndexOfReplacementCollection  ) do: 
		[
		:i |
		self assert: (result at: i)=(self replacementCollection at: (i - indexOfSubcollection +1))
		].
	
	" end part :"
	1 to: (result size - lastIndexOfReplacementCollection   ) do:
		[ 
		:i |
		self assert: (result at: ( lastIndexOfReplacementCollection  + i  ) ) = (self collectionWith1TimeSubcollection  at: ( lastIndexOfOldSubcollection  + i  ) ).
		].
	
	
	

	
	! !

!ArrayTest methodsFor: 'testing' stamp: 'MarcusDenker 5/2/2013 11:26'!
testPrinting
	"self debug: #testPrinting"
	
	self assert: literalArray printString = '#(1 true 3 #four)'.
	self assert: (literalArray = (self class compiler evaluate: literalArray printString)).
	self assert: (selfEvaluatingArray = (self class compiler evaluate: selfEvaluatingArray printString)).
	self assert: nonSEArray1 printString =  'an Array(1 a Set(1))'.
	self assert: nonSEarray2 printString = '{#Array->Array}'
! !

!ArrayTest methodsFor: 'test - iterate' stamp: 'delaunay 4/14/2009 14:12'!
testDo

	| res |
	res := OrderedCollection new.  
	self collection do: [:each | res add: each class].
	self assert: res asArray = self result.! !

!ArrayTest methodsFor: 'tests - equality' stamp: ''!
testHasEqualElements
	"self debug: #testHasEqualElements"

	self deny: (self empty hasEqualElements: self nonEmpty).
	self deny: (self nonEmpty hasEqualElements: self nonEmpty asSet). 
	self deny: (self nonEmpty reversed hasEqualElements: self nonEmpty).
	self deny: (self nonEmpty hasEqualElements: self nonEmpty reversed).! !

!ArrayTest methodsFor: 'requirements' stamp: 'damiencassou 1/27/2009 10:35'!
firstEven
	"Returns the first even number of #collection"
	^ -2! !

!ArrayTest methodsFor: 'tests - copying same contents' stamp: ''!
testShuffled
	| result |
	result := self nonEmpty shuffled .
	
	"verify content of 'result: '"
	result do: [:each | self assert: (self nonEmpty occurrencesOf: each)=(result occurrencesOf: each)].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!ArrayTest methodsFor: 'parameters' stamp: 'stephane.ducasse 10/5/2008 15:12'!
selectorToAccessValuePutIn
	"return the selector of the method that should be invoked to access an element"
	
	^ #second! !

!ArrayTest methodsFor: 'tests - equality' stamp: ''!
testHasEqualElementsIsTrueForNonIdenticalButEqualCollections
	"self debug: #testHasEqualElementsIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty hasEqualElements: self empty copy). 
	self assert: (self empty copy hasEqualElements: self empty).
	self assert: (self empty copy hasEqualElements: self empty copy).
		
	self assert: (self nonEmpty hasEqualElements: self nonEmpty copy). 
	self assert: (self nonEmpty copy hasEqualElements: self nonEmpty).
	self assert: (self nonEmpty copy hasEqualElements: self nonEmpty copy).! !

!ArrayTest methodsFor: 'testing' stamp: 'zz 12/5/2005 17:18'!
testIsSelfEvaluating

	self assert: example1 isSelfEvaluating.
	example1 at: 1 put: Bag new.
	self deny: example1 isSelfEvaluating.
	example1 at: 1 put: 1.! !

!ArrayTest methodsFor: 'tests - as identity set' stamp: ''!
testAsIdentitySetWithIdentityEqualsElements
	| result |
	result := self collectionWithIdentical asIdentitySet.
	" Only one element should have been removed as two elements are equals with Identity equality"
	self assert: result size = (self collectionWithIdentical size - 1).
	self collectionWithIdentical do: 
		[ :each | 
		(self collectionWithIdentical occurrencesOf: each) > 1 
			ifTrue: 
				[ "the two elements equals only with classic equality shouldn't 'have been removed"
				self assert: (result asOrderedCollection occurrencesOf: each) = 1
				" the other elements are still here" ]
			ifFalse: [ self assert: (result asOrderedCollection occurrencesOf: each) = 1 ] ].
	self assert: result class = IdentitySet! !

!ArrayTest methodsFor: 'test - equality' stamp: ''!
testEqualSign
	"self debug: #testEqualSign"

	self deny: (self empty = self nonEmpty).! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0TSequencedStructuralEqualityTest
	self nonEmpty at: 1	"Ensures #nonEmpty is sequenceable"! !

!ArrayTest methodsFor: 'tests - copy' stamp: ''!
testCopySameClass
	"self debug: #testCopySameClass"
	"A copy of a collection should always be of the same class as the instance it copies"
	
	| copy | 
	copy := self empty copy.
	self assert: copy class == self empty class.! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 3/31/2009 10:28'!
elementInForCopy
	^ elementInForCopy ! !

!ArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testAfter
	"self debug: #testAfter"
	self assert: (self moreThan4Elements after: (self moreThan4Elements at: 1)) = (self moreThan4Elements at: 2).
	self 
		should: 
			[ self moreThan4Elements after: (self moreThan4Elements at: self moreThan4Elements size) ]
		raise: Error.
	self 
		should: [ self moreThan4Elements after: self elementNotInForElementAccessing ]
		raise: Error! !

!ArrayTest methodsFor: 'tests - sorting' stamp: ''!
testIsSortedBy
	self assert: (self sortedInAscendingOrderCollection isSortedBy: [:a :b | a<b]).
	self deny: (self sortedInAscendingOrderCollection isSortedBy: [:a :b | a>b]).
! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/6/2009 11:41'!
oldSubCollection
	^oldSubCollection ! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureAsSetForIdentityMultiplinessTest
	"a collection (of elements for which copy is not identical ) without equal elements:"

	| anElement res |
	self elementsCopyNonIdenticalWithoutEqualElements.
	anElement := self elementsCopyNonIdenticalWithoutEqualElements anyOne.
	self deny: anElement copy == anElement.
	res := true.
	self elementsCopyNonIdenticalWithoutEqualElements
		detect: [ :each | (self elementsCopyNonIdenticalWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixturePrintTest
	self nonEmpty! !

!ArrayTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButFirstNElements
	"self debug: #testAllButFirst"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButFirst: 2.
	1 
		to: abf size
		do: [ :i | self assert: (abf at: i) = (col at: i + 2) ].
	self assert: abf size + 2 = col size! !

!ArrayTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfter
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyAfter: (collection  at:index ).
	
	"verifying content: "
	(1) to: result size do: 
		[:i |
		self assert: (collection   at:(i + index ))=(result at: (i))].

	"verify size: "
	self assert: result size = (collection   size - index).! !

!ArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testReverseWithDo
	
	| firstCollection secondCollection index |

	firstCollection := self nonEmptyMoreThan1Element.
	secondCollection := firstCollection copy.
	index := firstCollection size.
	
	firstCollection  reverseWith: secondCollection do:
		[:a :b |
	
		self assert: (firstCollection at: index) equals:  a. 
		self assert: (secondCollection at: index) equals:  b.
			( index := index - 1).]
	
	
	! !

!ArrayTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyFromTo
	| result  index collection |
	collection := self collectionWithoutEqualElements .
	index :=self indexInForCollectionWithoutDuplicates .
	result := collection   copyFrom: index  to: collection  size .
	
	"verify content of 'result' : "
	1 to: result size do:
		[:i | 
		self assert: (result at:i)=(collection  at: (i + index - 1))].
	
	"verify size of 'result' : "
	self assert: result size = (collection  size - index + 1).! !

!ArrayTest methodsFor: 'tests - arithmetic' stamp: 'stephane.ducasse 10/6/2008 16:53'!
testPremultiply
	self assert: example1 +* #(2 ) = #(2 4 6 8 10 ) ! !

!ArrayTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAllNoneThere
	"self debug: #testIncludesAllOfNoneThere'"
	self deny: (self empty includesAll: self nonEmpty ).
	self deny: (self nonEmpty includesAll: { self elementNotIn. self anotherElementNotIn })! !

!ArrayTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfStartingAt
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			indexOf: element
			startingAt: 2
			ifAbsent: [ 99 ]) = 99.
	self assert: (collection 
			indexOf: element
			startingAt: 1
			ifAbsent: [ 99 ]) = 1.
	self assert: (collection 
			indexOf: self elementNotInForIndexAccessing
			startingAt: 1
			ifAbsent: [ 99 ]) = 99! !

!ArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testKeysAndValuesDoEmpty
	| result |
	result:= OrderedCollection new.
	
	self empty  keysAndValuesDo: 
		[:i :value|
		result add: (value+i)].
	
	self assert: result isEmpty .! !

!ArrayTest methodsFor: 'requirements' stamp: 'SebastianTleye 6/26/2013 11:15'!
collectionOfCollectionsOfInts
	^collectionOfCollectionsOfInts.! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 14:39'!
elementNotInForElementAccessing
" return an element not included in 'accessCollection' "
	^ elementNotInForCopy ! !

!ArrayTest methodsFor: 'tests - as set tests' stamp: ''!
testAsSetWithEqualsElements
	| result |
	result := self withEqualElements asSet.
	self withEqualElements do: [ :each | self assert: (result occurrencesOf: each) = 1 ].
	self assert: result class = Set! !

!ArrayTest methodsFor: 'tests - printing' stamp: ''!
testPrintOnDelimiterLast

	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printOn: aStream delimiter: ', ' last: 'and'.
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 )
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString)].
		i=(allElementsAsString size-1)
			ifTrue:[ self deny: (allElementsAsString at:i)=('and')asString].
		i=(allElementsAsString size)
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:(i-1))asString)].
			].! !

!ArrayTest methodsFor: 'tests - converting' stamp: ''!
testAsBag

	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: Bag! !

!ArrayTest methodsFor: 'tests - enumerating' stamp: ''!
testFlatCollectAsSet

	self 
		assert: (self simpleCollection flatCollectAsSet: [ :x | { x }, { x } ]) 
		equals: self simpleCollection asSet! !

!ArrayTest methodsFor: 'tests - copying part of sequenceable for multipliness' stamp: ''!
testCopyAfterLastWithDuplicate
	| result element  collection |
	collection := self collectionWithSameAtEndAndBegining .
	element := collection  first.
	
	" collectionWithSameAtEndAndBegining first and last elements are equals.
	'copyAfter:' should copy after the last occurence of element :"
	result := collection   copyAfterLast: (element ).
	
	"verifying content: "
	self assert: result isEmpty.

! !

!ArrayTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWith
	"self debug: #testCopyWith"
	| res anElement |
	anElement := self elementToAdd.
	res := self empty copyWith: anElement.
	self assert: res size = (self empty size + 1).
	self assert: (res includes: (anElement value))! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/16/2009 15:59'!
indexInForCollectionWithoutDuplicates
	^ 2.! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
howMany: aSubCollection in: collection
" return an integer representing how many time 'subCollection'  appears in 'collection'  "
	| tmp nTime |
	tmp := collection.
	nTime:= 0.
	
	[tmp isEmpty ]whileFalse:
		[
		(tmp beginsWith: aSubCollection)
			ifTrue: [ 	
				nTime := nTime + 1.
				1 to: aSubCollection size do: [:i | tmp := tmp copyWithoutFirst.]
				]
			ifFalse: [tmp := tmp copyWithoutFirst.]
		 ].
	
	^ nTime.
	! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureConverAsSortedTest
	self collectionWithSortableElements.
	self deny: self collectionWithSortableElements isEmpty! !

!ArrayTest methodsFor: 'tests - printing' stamp: ''!
testStoreOn
" for the moment work only for collection that include simple elements such that Integer"

"| string str result cuttedResult index elementsAsStringExpected elementsAsStringObtained tmp |
string := ''.
str := ReadWriteStream  on: string.
elementsAsStringExpected := OrderedCollection new.
elementsAsStringObtained := OrderedCollection new.
self nonEmpty do: [ :each | elementsAsStringExpected  add: each asString].

self nonEmpty storeOn: str.
result := str contents .
cuttedResult := ( result findBetweenSubStrs: ';' ).

index := 1.

cuttedResult do:
	[ :each |
	index = 1 
		ifTrue: [ self assert: (each beginsWith: ( tmp := '((' , self nonEmpty class asString , ' new) add: '           )).
				tmp := each copyFrom: ( tmp size + 1) to: ( each size ).
				elementsAsStringObtained add: tmp.
				index := index + 1. ]
		ifFalse:  [ 
		 index < cuttedResult size
			ifTrue:[self assert: (each beginsWith: ( tmp:=  ' add: '   )).
				tmp := each copyFrom: ( tmp size + 1) to: ( each size ).
				elementsAsStringObtained add: tmp.
					index := index + 1.]
			ifFalse: [self assert: ( each = ' yourself)' ) ].
			]
	
	].


	elementsAsStringExpected do: [ :each | self assert: (elementsAsStringExpected occurrencesOf: each ) = ( elementsAsStringObtained occurrencesOf: each) ]"

! !

!ArrayTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfStartingAtIfAbsent
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			indexOf: element
			startingAt: 2
			ifAbsent: [ 99 ]) = 99.
	self assert: (collection 
			indexOf: element
			startingAt: 1
			ifAbsent: [ 99 ]) = 1.
	self assert: (collection 
			indexOf: self elementNotInForIndexAccessing
			startingAt: 1
			ifAbsent: [ 99 ]) = 99! !

!ArrayTest methodsFor: 'requirements' stamp: 'SebastianTleye 6/26/2013 11:00'!
collectionOfCollectionsOfStrings
	^ collectionOfCollectionsOfStrings.! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/9/2009 15:53'!
integerCollection
	^example1 .! !

!ArrayTest methodsFor: 'tests - replacing' stamp: ''!
testReplaceAllWith
	| result  collection oldElement newElement oldOccurrences |
	collection := self nonEmpty .
	result := collection  copy.
	oldElement := self elementInForReplacement .
	newElement := self newElement .
	oldOccurrences := (result occurrencesOf: oldElement) + (result occurrencesOf: newElement).
	result replaceAll: oldElement  with: newElement  .
	
	self assert: oldOccurrences = (result occurrencesOf: newElement)! !

!ArrayTest methodsFor: 'tests - set arithmetic' stamp: ''!
numberOfSimilarElementsInIntersection
	^ self collection occurrencesOf: self anotherElementOrAssociationIn! !

!ArrayTest methodsFor: 'tests - occurrencesOf for multipliness' stamp: ''!
testOccurrencesOfForMultipliness

| collection elem |
collection := self collectionWithEqualElements .
elem := self elementTwiceInForOccurrences .

self assert: (collection occurrencesOf: elem ) = 2.  ! !

!ArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testAtAll
	"self debug: #testAtAll"
	"	self flag: #theCollectionshouldbe102030intheFixture.
	
	self assert: (self accessCollection atAll: #(2 1)) first = self accessCollection second.
	self assert: (self accessCollection atAll: #(2)) first = self accessCollection second."
	| result |
	result := self moreThan4Elements atAll: #(2 1 2 ).
	self assert: (result at: 1) = (self moreThan4Elements at: 2).
	self assert: (result at: 2) = (self moreThan4Elements at: 1).
	self assert: (result at: 3) = (self moreThan4Elements at: 2).
	self assert: (self moreThan4Elements atAll: #()) = self moreThan4Elements species new! !

!ArrayTest methodsFor: 'tests - converting' stamp: ''!
assertNonDuplicatedContents: aCollection whenConvertedTo: aClass 
	| result |
	result := aCollection perform: ('as' , aClass name) asSymbol.
	self assert: (result class includesBehavior: aClass).
	result do: 
		[ :each | 
		self assert: (aCollection occurrencesOf: each) = (result occurrencesOf: each) ].
	^ result! !

!ArrayTest methodsFor: 'tests - copying same contents' stamp: ''!
testShallowCopy
	| result |
	result := self nonEmpty shallowCopy .
	
	"verify content of 'result: '"
	1 to: self nonEmpty size do:
		[:i | self assert: ((result at:i)=(self nonEmpty at:i))].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!ArrayTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfIfAbsent
	"self debug: #testIndexOfIfAbsent"
	| collection |
	collection := self collectionMoreThan1NoDuplicates.
	self assert: (collection 
			indexOf: collection first
			ifAbsent: [ 33 ]) = 1.
	self assert: (collection 
			indexOf: self elementNotInForIndexAccessing
			ifAbsent: [ 33 ]) = 33! !

!ArrayTest methodsFor: 'tests - streaming' stamp: ''!
testStreamContentsSized
	| result |
	result:= self collectionClass new: 1 streamContents: [ :s|
		s 
			nextPutAll: self firstCollection;
			nextPutAll: self secondCollection ].
	self assert: result equals: self firstCollection, self secondCollection.
	
	result:= self collectionClass new: 1000 streamContents: [ :s|
		s 
			nextPutAll: self firstCollection;
			nextPutAll: self secondCollection ].
	self assert: result equals: self firstCollection, self secondCollection.! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyPartOfSequenceableTest
	self collectionWithoutEqualElements.
	self collectionWithoutEqualElements
		do: [ :each | self assert: (self collectionWithoutEqualElements occurrencesOf: each) = 1 ].
	self indexInForCollectionWithoutDuplicates.
	self
		assert:
			(self indexInForCollectionWithoutDuplicates > 0 & self indexInForCollectionWithoutDuplicates)
				< self collectionWithoutEqualElements size.
	self empty.
	self assert: self empty isEmpty! !

!ArrayTest methodsFor: 'test - creation' stamp: ''!
testWithWithWith
	"self debug: #testWithWithWith"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom:1 to: 3 .
	aCol := self collectionClass with: (collection at:1) with: ( collection at:2 ) with: ( collection at: 3).

	1 to: 3 do: [ :i | self assert: ( aCol occurrencesOf: ( collection at: i ) ) = ( collection occurrencesOf: ( collection at: i ) ) ].! !

!ArrayTest methodsFor: 'tests - converting' stamp: ''!
testAsIdentitySet
	"test with a collection without equal elements :"
	self 
		assertSameContents: self collectionWithoutEqualElements
		whenConvertedTo: IdentitySet.
! !

!ArrayTest methodsFor: 'tests - converting' stamp: ''!
testAsByteArray
	| res |
	self integerCollectionWithoutEqualElements.
	self integerCollectionWithoutEqualElements do: [ :each | self assert: each class = SmallInteger ].
	res := true.
	self integerCollectionWithoutEqualElements
		detect: [ :each | (self integerCollectionWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false.
	self assertSameContents: self integerCollectionWithoutEqualElements whenConvertedTo: ByteArray! !

!ArrayTest methodsFor: 'tests - converting' stamp: ''!
testAsSet
	| |
	"test with a collection without equal elements :"
	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: Set.
	! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyWithOrWithoutSpecificElementsTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self indexInNonEmpty.
	self assert: self indexInNonEmpty > 0.
	self assert: self indexInNonEmpty <= self nonEmpty size! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/7/2009 11:18'!
elementNotInForIndexAccessing

	^elementNotInForCopy ! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/2/2009 16:41'!
firstCollection
	^example1 ! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/9/2009 11:11'!
collectionInForIncluding
	^ self nonEmpty copyWithoutFirst.! !

!ArrayTest methodsFor: 'parameters' stamp: ''!
accessValuePutIn
	"return access the element put in the non-empty collection"
	
	^ self perform: self selectorToAccessValuePutIn! !

!ArrayTest methodsFor: 'parameters' stamp: 'stephane.ducasse 10/9/2008 18:49'!
valuePutIn
	"the value that we will put in the non empty collection"
	
	^ 2! !

!ArrayTest methodsFor: 'tests - includes' stamp: ''!
testIncludesElementIsThere
	"self debug: #testIncludesElementIsThere"
	
	self assert: (self nonEmpty includes: self nonEmpty anyOne).! !

!ArrayTest methodsFor: 'tests - sorting' stamp: ''!
testSortUsingSortBlock
	| result tmp |
	result := self unsortedCollection sort: [:a :b | a>b].
	tmp := result at: 1.
	result do:
		[:each | self assert: each<=tmp. tmp:= each. ].! !

!ArrayTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifferenceWithSeparateCollection
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifferenceWithSeparateCollection"
	| res separateCol |
	
	separateCol := self collectionClass with: self anotherElementOrAssociationNotIn.
	res := self collectionWithoutEqualElements difference: separateCol.
	
	self deny: (res includes: self anotherElementOrAssociationNotIn).
	self assert: res size equals: self collectionWithoutEqualElements size.
	
	self collectionWithoutEqualElements do: [ :each|
		self assert: (res includes: each)].
	
	res := separateCol difference: self collection.
	self deny: (res includes: self collection anyOne).
	self assert: res equals: separateCol! !

!ArrayTest methodsFor: 'testing' stamp: 'StephaneDucasse 1/16/2010 10:07'!
testLiteralEqual

	self deny: (example1 literalEqual: example1 asIntegerArray)! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureEmptySequenceableTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!ArrayTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfSubCollectionStartingAtIfAbsent
	"self debug: #testIndexOfIfAbsent"
	| index absent subcollection collection |
	collection := self collectionMoreThan1NoDuplicates.
	subcollection := self collectionMoreThan1NoDuplicates.
	absent := false.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 1
		ifAbsent: [ absent := true ].
	self assert: absent = false.
	absent := false.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 2
		ifAbsent: [ absent := true ].
	self assert: absent = true! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 14:11'!
withEqualElements
	" return a collection of float including equal elements (classic equality)"
	^ collectionOfFloatWithEqualElements! !

!ArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testAtLastError
	"self debug: #testAtLast"
	self 
		should: [ self moreThan4Elements atLast: self moreThan4Elements size + 1 ]
		raise: Error! !

!ArrayTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpToLastEmpty
	| result |
	result := self empty copyUpToLast: self collectionWithoutEqualElements first.
	self assert: result isEmpty.! !

!ArrayTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpToLast
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyUpToLast: (collection  at:index).
	
	"verify content of 'result' :"
	1 to: result size do: [:i| self assert: (collection   at:i)=(result at:i)].
	
	"verify size of 'result' :"
	self assert: result size = (index-1).! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/10/2009 14:49'!
elementInForIndexAccess
	^ elementInForCopy ! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCloneTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!ArrayTest methodsFor: 'tests - printing' stamp: ''!
testPrintOn
	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printOn: aStream .
	allElementsAsString:=(result findBetweenSubStrs: ' ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i=1
			ifTrue:[
			self accessCollection class name first isVowel 
				ifTrue:[self assert: (allElementsAsString at:i)='an' ]
				ifFalse:[self assert: (allElementsAsString at:i)='a'].].
		i=2
			ifTrue:[self assert: (allElementsAsString at:i)=self accessCollection class name].
		i>2
			ifTrue:[self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString).].	
			].! !

!ArrayTest methodsFor: 'tests - at put' stamp: ''!
testAtPutTwoValues
	"self debug: #testAtPutTwoValues"
	
	self nonEmpty at: self anIndex put: self aValue.
	self nonEmpty at: self anIndex put: self anotherValue.
	self assert: (self nonEmpty at: self anIndex) = self anotherValue.! !

!ArrayTest methodsFor: 'tests - find binary' stamp: 'SvenVanCaekenberghe 3/8/2012 14:10'!
testFindBinaryIfNone
	self assert: (#(1 3 5 7 11 15 23) findBinary: [ :arg | 11 - arg ] ifNone: [ #none ]) = 11.
	self should: (#(1 3 5 7 11 15 23) findBinary: [ :arg | 8 - arg ] ifNone: [ #none ]) = #none! !

!ArrayTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpTo
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyUpTo: (collection  at:index).
	
	"verify content of 'result' :"
	1 to: result size do: [:i| self assert: (collection   at:i)=(result at:i)].
	
	"verify size of 'result' :"
	self assert: result size = (index-1).
	! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/17/2009 15:24'!
collectionWithElementsToRemove
	^ removedCollection! !

!ArrayTest methodsFor: 'tests - copying same contents' stamp: ''!
testReversed
	| result |
	result := self nonEmpty reversed .
	
	"verify content of 'result: '"
	1 to:  result size do:
		[:i | self assert: ((result at:i)=(self nonEmpty at:(self nonEmpty size-i+1)))].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!ArrayTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterLastMore

	| delim multiItemStream result last allElementsAsString |
	
	delim := ', '.
	last := 'and'.
	result:=''.
	multiItemStream := ReadWriteStream on:result.
	self nonEmpty  asStringOn: multiItemStream delimiter: ', ' last: last.
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 )
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString)].
		i=(allElementsAsString size-1)
			ifTrue:[ self deny: (allElementsAsString at:i)=(last)asString].
		i=(allElementsAsString size)
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:(i-1))asString)].
			].
	
! !

!ArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testLast
	"self debug: #testLast"
	self assert: self moreThan4Elements last = (self moreThan4Elements at: self moreThan4Elements size)! !

!ArrayTest methodsFor: 'test - iterate' stamp: 'luc.fabresse 11/29/2008 23:10'!
expectedSizeAfterReject
	^1! !

!ArrayTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:23'!
test0FixtureIncludeTest
	| anElementIn |
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self elementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self elementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self anotherElementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self anotherElementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self collection.
	self empty.
	self assert: self empty isEmpty.
	self collectionOfFloat.
	self collectionOfFloat do: [ :each | self assert: each class = Float ].
	self elementInForIncludesTest.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self elementInForIncludesTest ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = true! !

!ArrayTest methodsFor: 'tests - includes' stamp: 'CamilloBruni 8/31/2013 20:23'!
testIdentityIncludes
	" test the comportement in presence of elements 'includes' but not 'identityIncludes' "

	" can not be used by collections that can't include elements for wich copy doesn't return another instance "

	| collection element |
	self collectionWithCopyNonIdentical.
	collection := self collectionWithCopyNonIdentical.
	element := collection anyOne copy.	"self assert: (collection includes: element)."
	self deny: (collection identityIncludes: element)! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIndexAccessFotMultipliness
	self collectionWithSameAtEndAndBegining.
	self assert: self collectionWithSameAtEndAndBegining first = self collectionWithSameAtEndAndBegining last.
	self assert: self collectionWithSameAtEndAndBegining size > 1.
	1 to: self collectionWithSameAtEndAndBegining size do: [ :i | 
		i > 1 & (i < self collectionWithSameAtEndAndBegining size)
			ifTrue: [ self deny: (self collectionWithSameAtEndAndBegining at: i) = self collectionWithSameAtEndAndBegining first ] ]! !

!ArrayTest methodsFor: 'tests - includes' stamp: ''!
testIncludesElementIsNotThere
	"self debug: #testIncludesElementIsNotThere"
	
	self deny: (self nonEmpty includes: self elementNotIn).
	self assert: (self nonEmpty includes: self nonEmpty anyOne).
	self deny: (self empty includes: self elementNotIn)! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 3/31/2009 10:29'!
replacementCollection
	^replacementCollection .! !

!ArrayTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithoutIndex
	| result index |
	index := self indexInNonEmpty .
	result := self nonEmpty copyWithoutIndex: index .
	
	"verify content of 'result:'"
	1 to: result size do:
		[:i | 
		i<( index ) ifTrue: [self assert: ((result at:i )= (self nonEmpty at:i))].
		i>=( index ) ifTrue: [self assert: (result at:i )= (self nonEmpty at:(i+1))]].
	
	"verify size of result : "
	self assert: result size=(self nonEmpty size -1).! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/22/2009 11:15'!
collectionWithSameAtEndAndBegining
" return a collection with elements at end and begining equals .
(others elements of the collection are not equal to those elements)"
	^ floatCollectionWithSameBeginingAnEnd ! !

!ArrayTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testLastIndexOfStartingAtDuplicate
	"self debug: #testLastIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection last.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'lastIndexOf:ifAbsent:startingAt: should return the position of the last occurrence :'"
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size
			ifAbsent: [ 55 ]) = collection size.
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size - 1
			ifAbsent: [ 55 ]) = 1! !

!ArrayTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfterEmpty
	| result |
	result := self empty copyAfter: self collectionWithoutEqualElements first.
	self assert: result isEmpty.
	! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 10:28'!
integerCollectionWithoutEqualElements
	^{1. 2. 6. 5.}! !

!ArrayTest methodsFor: 'tests - puting with indexes' stamp: ''!
testAtWrapPut
	"self debug: #testAtWrapPut"
	| index |
	index := self indexArray anyOne.
	
	self nonEmpty atWrap: 0 put: self aValue.
	self assert: (self nonEmpty at:(self nonEmpty size))=self aValue.
	
	self nonEmpty atWrap: (self nonEmpty size+1) put: self aValue.
	self assert: (self nonEmpty at:(1))=self aValue.
	
	self nonEmpty atWrap: (index  ) put: self aValue.
	self assert: (self nonEmpty at: index ) = self aValue.
	
	self nonEmpty atWrap: (self nonEmpty size+index  ) put: self aValue .
	self assert: (self nonEmpty at:(index ))=self aValue .! !

!ArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testReverseDo
	| result |
	result:= OrderedCollection new.
	self nonEmpty reverseDo: [: each | result add: each].
	
	1 to: result size do:
		[:i|
		self assert: (result at: i)=(self nonEmpty at:(self nonEmpty size-i+1))].! !

!ArrayTest methodsFor: 'tests - copy' stamp: ''!
testCopyEquals
	"self debug: #testCopySameClass"
	"A copy should be equivalent to the things it's a copy of"
	
	| copy | 
	copy := self nonEmpty copy.
	self assert: copy  = self nonEmpty.! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/2/2009 11:54'!
elementInForOccurrences
	^ elementInForCopy ! !

!ArrayTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testIndexOfDuplicate
	"self debug: #testIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection last.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'indexOf: should return the position of the first occurrence :'"
	self assert: (collection indexOf: element) = 1! !

!ArrayTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWithoutAll
	"self debug: #testCopyEmptyWithoutAll"
	| res |
	res := self empty copyWithoutAll: self collectionWithElementsToRemove.
	self assert: res size = self empty size.
	self collectionWithElementsToRemove do: [ :each | self deny: (res includes: each) ]! !

!ArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testAtPin
	"self debug: #testAtPin"
	self assert: (self moreThan4Elements atPin: 2) = self moreThan4Elements second.
	self assert: (self moreThan4Elements atPin: 99) = self moreThan4Elements last.
	self assert: (self moreThan4Elements atPin: -99) = self moreThan4Elements first! !

!ArrayTest methodsFor: 'tests - sequence isempty' stamp: ''!
testSequenceIfNotEmpty

	self assert: (self nonEmpty 
					ifNotEmpty: [:s | self accessValuePutInOn: s]) = self valuePutIn! !

!ArrayTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutAll
	"self debug: #testCopyNonEmptyWithoutAll"
	| res |
	res := self nonEmpty copyWithoutAll: self collectionWithElementsToRemove.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self collectionWithElementsToRemove do: [ :each | self deny: (res includes: (each)) ].
	self nonEmpty do: 
		[ :each | 
		(self collectionWithElementsToRemove includes: each) ifFalse: [ self assert: (res includes: each) ] ]! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 13:46'!
elementsCopyNonIdenticalWithoutEqualElements
	" return a collection that does niot include equal elements ( classic equality )"
	^ collectionOfCollection! !

!ArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testAtLastIfAbsent
	"self debug: #testAtLastIfAbsent"
	self assert: (self moreThan4Elements 
			atLast: 1
			ifAbsent: [ nil ]) = self moreThan4Elements last.
	self assert: (self moreThan4Elements 
			atLast: self moreThan4Elements size + 1
			ifAbsent: [ 222 ]) = 222! !

!ArrayTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButLastNElements
	"self debug: #testAllButFirst"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButLast: 2.
	1 
		to: abf size
		do: [ :i | self assert: (abf at: i) = (col at: i) ].
	self assert: abf size + 2 = col size! !

!ArrayTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfterLast
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyAfterLast: (collection  at:index ).
	
	"verifying content: "
	(1) to: result size do: 
		[:i |
		self assert: (collection   at:(i + index ))=(result at: (i))].

	"verify size: "
	self assert: result size = (collection   size - index).! !

!ArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindFirstNotIn

	| result |
	
	 result:=self empty findFirst: [:each | true].
	
	self assert: result=0. ! !

!ArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testAfterIfAbsent
	"self debug: #testAfterIfAbsent"
	self assert: (self moreThan4Elements 
			after: (self moreThan4Elements at: 1)
			ifAbsent: [ 33 ]) = (self moreThan4Elements at: 2).
	self assert: (self moreThan4Elements 
			after: (self moreThan4Elements at: self moreThan4Elements size)
			ifAbsent: [ 33 ]) = 33.
	self assert: (self moreThan4Elements 
			after: self elementNotInForElementAccessing
			ifAbsent: [ 33 ]) = 33! !

!ArrayTest methodsFor: 'tests - converting' stamp: ''!
assertNoDuplicates: aCollection whenConvertedTo: aClass 
	| result |
	result := self collectionWithEqualElements asIdentitySet.
	self assert: (result class includesBehavior: IdentitySet).
	self collectionWithEqualElements do: [ :initial | self assert: (result occurrencesOf: initial) = 1 ]! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureOccurrencesForMultiplinessTest
	| cpt anElement collection |
	self collectionWithEqualElements.
	self collectionWithEqualElements.
	self elementTwiceInForOccurrences.
	anElement := self elementTwiceInForOccurrences.
	collection := self collectionWithEqualElements.
	cpt := 0.	" testing with identity check ( == ) so that identy collections can use this trait : "
	self collectionWithEqualElements
		do: [ :each | 
			each == self elementTwiceInForOccurrences
				ifTrue: [ cpt := cpt + 1 ] ].
	self assert: cpt = 2! !

!ArrayTest methodsFor: 'tests - copying with or without' stamp: ''!
testForceToPaddingWith

	| result element |
	element := self nonEmpty at: self indexInNonEmpty .
	result := self nonEmpty forceTo: (self nonEmpty size+2) paddingWith: ( element ).
	
	"verify content of 'result' : "
	1 to: self nonEmpty  size do:
		[:i | self assert: ( self nonEmpty at: i ) = ( result at:(i) ). ].
	
	(result size - 1) to: result size do:
		[:i | self assert: ( result at:i ) = ( element ) ].

	"verify size of 'result' :"
	self assert: result size = (self nonEmpty size + 2).! !

!ArrayTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsCommaStringEmpty

	self assert: self empty asCommaString = ''.
	self assert: self empty asCommaStringAnd = ''.
	
! !

!ArrayTest methodsFor: 'initialization' stamp: 'stephane.ducasse 10/5/2008 15:06'!
nonEmpty

	^ example1! !

!ArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindLast

	| element result |
	element := self nonEmptyMoreThan1Element  at:self nonEmptyMoreThan1Element  size.
	 result:=self nonEmptyMoreThan1Element  findLast: [:each | each =element].
	
	self assert: result=self nonEmptyMoreThan1Element  size. ! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCreationWithTest
	self collectionMoreThan5Elements.
	self assert: self collectionMoreThan5Elements size >= 5! !

!ArrayTest methodsFor: 'test - equality' stamp: ''!
testEqualSignIsTrueForEmptyButNonIdenticalCollections
	"self debug: #testEqualSignIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty = self empty copy). 
	self assert: (self empty copy = self empty).
	self assert: (self empty copy = self empty copy).
		
! !

!ArrayTest methodsFor: 'tests - streaming' stamp: ''!
testNewStreamContentsReturnsCollectionOfCorrectSize
	| result item originalSize |
	originalSize := 10.
	item := self firstCollection first.
	result := self collectionClass
		new: originalSize
		streamContents: [ :stream | 
			1 to: originalSize + 1 do: [ :each | stream nextPut: item ].
			stream position: originalSize ].
	self assert: result size equals: originalSize! !

!ArrayTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyNonEmpty
	"self debug: #testCopyNonEmpty"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: copy isEmpty.
	self assert: copy size = self nonEmpty size.
	self nonEmpty do: 
		[:each | copy includes: each]! !

!ArrayTest methodsFor: 'tests - at put' stamp: ''!
testAtPut
	"self debug: #testAtPut"
	
	self nonEmpty at: self anIndex put: self aValue.
	self assert: (self nonEmpty at: self anIndex) = self aValue.
	! !

!ArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testReverseDoEmpty
	| result |
	result:= OrderedCollection new.
	self empty reverseDo: [: each | result add: each].
	
	self assert: result isEmpty .! !

!ArrayTest methodsFor: 'test - creation' stamp: ''!
testWithWith
	"self debug: #testWithWith"
	
	| aCol collection element1 element2 |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom: 1 to: 2  .
	element1 := collection at: 1.
	element2 := collection at:2.
	
	aCol := self collectionClass with: element1  with: element2 .
	self assert: (aCol occurrencesOf: element1 ) = ( collection occurrencesOf: element1).
	self assert: (aCol occurrencesOf: element2 ) = ( collection occurrencesOf: element2).
	
	! !

!ArrayTest methodsFor: 'requirements' stamp: ''!
collectionWithIdentical
	"return a collection of type : 'self collectionWIithoutEqualsElements class containing two elements equals ( with identity equality)"
	| result collection anElement |
	collection := OrderedCollection withAll: self elementsCopyNonIdenticalWithoutEqualElements.
	anElement := collection first.
	collection add: anElement.
	result := self elementsCopyNonIdenticalWithoutEqualElements class withAll: collection.
	^ result! !

!ArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testFirstSecondThird
	"self debug: #testFirstSecondThird"
	self assert: self moreThan4Elements first = (self moreThan4Elements at: 1).
	self assert: self moreThan4Elements second = (self moreThan4Elements at: 2).
	self assert: self moreThan4Elements third = (self moreThan4Elements at: 3).
	self assert: self moreThan4Elements fourth = (self moreThan4Elements at: 4)! !

!ArrayTest methodsFor: 'tests - copying with or without' stamp: ''!
testForceToPaddingStartWith

	| result element |
	element := self nonEmpty at: self indexInNonEmpty .
	result := self nonEmpty forceTo: (self nonEmpty size+2) paddingStartWith: ( element ).
	
	"verify content of 'result' : "
	1 to: 2   do:
		[:i | self assert: ( element ) = ( result at:(i) ) ].
	
	3 to: result size do:
		[:i | self assert: ( result at:i ) = ( self nonEmpty at:(i-2) ) ].

	"verify size of 'result' :"
	self assert: result size = (self nonEmpty size + 2).! !

!ArrayTest methodsFor: 'requirements' stamp: 'damienpollet 1/13/2009 16:59'!
sizeCollection

	^ self collection! !

!ArrayTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 3/26/2009 09:58'!
collectionWithCharacters
	^ withCharacters.! !

!ArrayTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithFirst

	| index element result |
	index:= self indexInNonEmpty .
	element:= self nonEmpty at: index.
	
	result := self nonEmpty copyWithFirst: element.	
	
	self assert: result size = (self nonEmpty size + 1).
	self assert: result first = element .
	
	2 to: result size do:
	[ :i |
	self assert: (result at: i) = ( self nonEmpty at: ( i - 1 ))].! !

!ArrayTest methodsFor: 'helpers' stamp: 'stephane.ducasse 1/12/2009 17:12'!
aValue

	^ 33! !

!ArrayTest methodsFor: 'initialization' stamp: 'stephane.ducasse 10/5/2008 15:06'!
empty

	^ empty! !

!ArrayTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterEmpty

	| delim emptyStream |
	delim := ', '.
	emptyStream := ReadWriteStream on: ''.
	self empty asStringOn: emptyStream delimiter: delim.
	self assert: emptyStream contents = ''.
! !

!ArrayTest methodsFor: 'testing' stamp: 'zz 12/5/2005 17:12'!
testIsArray
	
	self assert: example1 isArray! !

!ArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testAtLast
	"self debug: #testAtLast"
	| index |
	self assert: (self moreThan4Elements atLast: 1) = self moreThan4Elements last.
	"tmp:=1.
	self do:
		[:each | 
		each =self elementInForIndexAccessing 
			ifTrue:[index:=tmp].
		tmp:=tmp+1]."
	index := self moreThan4Elements indexOf: self elementInForElementAccessing.
	self assert: (self moreThan4Elements atLast: index) = (self moreThan4Elements at: self moreThan4Elements size - index + 1)! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 3/31/2009 16:00'!
indexArray
	^ indexArray .! !

!ArrayTest methodsFor: 'initialization' stamp: 'cyrille.delaunay 12/18/2009 12:59'!
collection 

	^ collectionWith4Elements ! !

!ArrayTest methodsFor: 'tests - puting with indexes' stamp: ''!
testAtLastPut
	| result index |
	index := self indexArray anyOne.
	result := self nonEmpty atLast: index  put: self aValue.
	
	self assert: (self nonEmpty at: (self nonEmpty size +1 - index)) = self aValue .! !

!ArrayTest methodsFor: 'tests - sorting' stamp: ''!
testSort
	| result tmp |
	result := self unsortedCollection sort.
	tmp := result at: 1.
	result do:
		[:each | self assert: each>=tmp. tmp:= each. ].! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 12:05'!
anotherElementOrAssociationIn
	" return an element (or an association for Dictionary ) present  in 'collection' "
	^ self collection anyOne.! !

!ArrayTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionEmpty
	"self debug: #testIntersectionEmpty"
	
	| inter |
	inter := self empty intersection: self empty.
	self assert: inter isEmpty. 
	inter := self empty intersection: self collection .
	self assert: inter =  self empty.
	! !

!ArrayTest methodsFor: 'tests - sorting' stamp: ''!
testIsSorted
	self assert: self sortedInAscendingOrderCollection isSorted.
	self deny: self unsortedCollection isSorted! !

!ArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testAtRandom
	| result |
	result := self nonEmpty atRandom .
	self assert: (self nonEmpty includes: result).! !

!ArrayTest methodsFor: 'tests - converting' stamp: 'cyrille.delaunay 3/26/2009 12:35'!
assertSameContents: aCollection whenConvertedTo: aClass 
	| result |
	result := aCollection perform: ('as' , aClass name) asSymbol.
	self assert: (result class includesBehavior: aClass).
	result do: 
		[ :each | 
		self assert: (aCollection occurrencesOf: each) = (result occurrencesOf: each) ].
	self assert: result size = aCollection size! !

!ArrayTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testIdentityIndexOfIAbsentDuplicate
	"self debug: #testIdentityIndexOfIfAbsent"
	| collection element elementCopy |
	collection := self collectionWithNonIdentitySameAtEndAndBegining .
	element := collection last.
	elementCopy := element copy.
	self deny: element  == elementCopy .
	self assert: (collection 
			identityIndexOf: element
			ifAbsent: [ 0 ]) = collection size.
	self assert: (collection 
			identityIndexOf: elementCopy
			ifAbsent: [ 55 ]) = 55! !

!ArrayTest methodsFor: 'tests - equality' stamp: ''!
testEqualSignForSequenceableCollections
	"self debug: #testEqualSign"

	self deny: (self nonEmpty = self nonEmpty asSet). 
	self deny: (self nonEmpty reversed = self nonEmpty).
	self deny: (self nonEmpty = self nonEmpty reversed).! !

!ArrayTest methodsFor: 'tests - streaming' stamp: ''!
testStreamContents
	| result index |
	result:= self collectionClass streamContents: [ :s|
		s 
			nextPutAll: self firstCollection;
			nextPutAll: self secondCollection ].
	self assert: result equals: self firstCollection, self secondCollection.! !

!ArrayTest methodsFor: 'tests - occurrencesOf' stamp: 'delaunay 4/2/2009 11:53'!
testOccurrencesOfNotIn
	| result |
	result := self empty occurrencesOf: self elementNotInForOccurrences.
	self assert: result = 0! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureBeginsEndsWithTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self assert: self nonEmpty size > 1.
	self empty.
	self assert: self empty isEmpty! !

!ArrayTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifferenceWithNonNullIntersection
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifferenceWithNonNullIntersection"
	"	#(1 2 3) difference: #(2 4) 
	->  #(1 3)"
	| res overlapping |
	overlapping := self collectionClass 
		with: self anotherElementOrAssociationNotIn
		with: self anotherElementOrAssociationIn.
	res := self collection difference: overlapping.
	self deny: (res includes: self anotherElementOrAssociationIn).
	overlapping do: [ :each | self deny: (res includes: each) ]! !

!ArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testAtIfAbsent
	"self debug: #testAt"
	| absent |
	absent := false.
	self moreThan4Elements 
		at: self moreThan4Elements size + 1
		ifAbsent: [ absent := true ].
	self assert: absent = true.
	absent := false.
	self moreThan4Elements 
		at: self moreThan4Elements size
		ifAbsent: [ absent := true ].
	self assert: absent = false! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 3/30/2009 10:51'!
collectionNotIncluded
	^ collectionNotIncluded.! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/24/2009 14:45'!
elementNotInForOccurrences
	^ elementNotInForCopy ! !

!ArrayTest methodsFor: 'test - equality' stamp: ''!
testEqualSignOfIdenticalCollectionObjects
	"self debug: #testEqualSignOfIdenticalCollectionObjects"
	
	self assert: (self empty = self empty). 
	self assert: (self nonEmpty = self nonEmpty). 
	! !

!ArrayTest methodsFor: 'tests - index access' stamp: ''!
testIndexOf
	"self debug: #testIndexOf"
	| tmp index collection |
	collection := self collectionMoreThan1NoDuplicates.
	tmp := collection size.
	collection reverseDo: 
		[ :each | 
		each = self elementInForIndexAccessing ifTrue: [ index := tmp ].
		tmp := tmp - 1 ].
	self assert: (collection indexOf: self elementInForIndexAccessing) = index! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSubcollectionAccessTest
	self moreThan3Elements.
	self assert: self moreThan3Elements size > 2! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 12:05'!
anotherElementOrAssociationNotIn
	" return an element (or an association for Dictionary )not present  in 'collection' "
	^ elementNotInForCopy ! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/23/2009 15:18'!
elementInForIndexAccessing

	^ withoutEqualElements anyOne! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 3/31/2009 14:08'!
smallerIndex
	^ firstIndex -1! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSequencedElementAccessTest
	self moreThan4Elements.
	self assert: self moreThan4Elements size >= 4.
	self subCollectionNotIn.
	self subCollectionNotIn detect: [ :each | (self moreThan4Elements includes: each) not ] ifNone: [ self assert: false ].
	self elementNotInForElementAccessing.
	self deny: (self moreThan4Elements includes: self elementNotInForElementAccessing).
	self elementInForElementAccessing.
	self assert: (self moreThan4Elements includes: self elementInForElementAccessing)! !

!ArrayTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionBasic
	"self debug: #testIntersectionBasic"
	| inter |
	inter := self collection intersection: (self collectionClass with: self anotherElementOrAssociationIn).
	self deny: inter isEmpty.
	self assert: (inter includes: self anotherElementOrAssociationIn value)! !

!ArrayTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifference
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifference"
	
	| difference |
	self assert: (self collectionWithoutEqualElements difference: self collectionWithoutEqualElements) isEmpty.
	self assert: (self empty difference: self collectionWithoutEqualElements) isEmpty.
	difference := (self collectionWithoutEqualElements difference: self empty).
	self assert: difference size = self collectionWithoutEqualElements	 size.
	self collectionWithoutEqualElements do: [ :each |
		self assert: (difference includes: each)].
! !

!ArrayTest methodsFor: 'helpers' stamp: 'stephane.ducasse 1/12/2009 17:19'!
anotherValue

	^ 66! !

!ArrayTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testLastIndexOfIfAbsentDuplicate
	"self debug: #testIndexOfIfAbsent"
	"self debug: #testLastIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection first.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'lastIndexOf: should return the position of the last occurrence :'"
	self assert: (collection 
			lastIndexOf: element
			ifAbsent: [ 55 ]) = collection size! !

!ArrayTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButFirst
	"self debug: #testAllButFirst"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButFirst.
	self deny: abf first = col first.
	self assert: abf size + 1 = col size! !

!ArrayTest methodsFor: 'tests - as set tests' stamp: ''!
testAsIdentitySetWithEqualsElements
	| result collection |
	collection := self withEqualElements .
	result := collection asIdentitySet.
	collection do: [ :each | self assert: (result occurrencesOf: each) = 1 ].
	self assert: result class = IdentitySet.! !

!ArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testAllButLastDo
	
	| result |
	result:= OrderedCollection  new.
	
	self nonEmptyMoreThan1Element  allButLastDo: [:each | result add: each].
	
	1 to: (result size) do:
		[:i|
		self assert: (self nonEmptyMoreThan1Element  at:(i ))=(result at:i)].
	
	self assert: result size=(self nonEmptyMoreThan1Element  size-1).! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyPartOfForMultipliness
	self collectionWithSameAtEndAndBegining.
	self assert: self collectionWithSameAtEndAndBegining first = self collectionWithSameAtEndAndBegining last.
	self assert: self collectionWithSameAtEndAndBegining size > 1.
	1 to: self collectionWithSameAtEndAndBegining size do: [ :i | 
		i > 1 & (i < self collectionWithSameAtEndAndBegining size)
			ifTrue: [ self deny: (self collectionWithSameAtEndAndBegining at: i) = self collectionWithSameAtEndAndBegining first ] ]! !

!ArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testPairsCollect
	
	| index result |
	index:=0.
	
	result:=self nonEmptyMoreThan1Element  pairsCollect: 
		[:each1 :each2 | 
		self assert: ( self nonEmptyMoreThan1Element indexOf: each2 ) = (index := index + 2).
		(self nonEmptyMoreThan1Element indexOf: each2) = ((self nonEmptyMoreThan1Element indexOf: each1) + 1).
		].
	
	result do: 
		[:each | self assert: each = true].
	
! !

!ArrayTest methodsFor: 'tests - copying same contents' stamp: ''!
testShallowCopyEmpty
	| result |
	result := self empty shallowCopy .
	self assert: result isEmpty .! !

!ArrayTest methodsFor: 'parameters' stamp: ''!
accessValuePutInOn: s

	"return access the element put in the non-empty collection"
	
	^ s perform: self selectorToAccessValuePutIn! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/3/2009 11:35'!
subCollectionNotIn

	^subCollectionNotIn ! !

!ArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithIndexDo
	
	"| result |
	result:=Array new: self nonEmptyMoreThan1Element size.
	self nonEmptyMoreThan1Element  withIndexDo: [:each :i | result at:i put:(each+i)].
	
	1 to: result size do:[: i | self assert: (result at:i)= ((self nonEmptyMoreThan1Element at: i) + i)]"
	|  indexes elements |
	indexes:= OrderedCollection new.
	elements := OrderedCollection new.
	
	self nonEmptyMoreThan1Element  withIndexDo: 
		[:value :i  |
		indexes  add: (i).
		elements add: value].
	
	(1 to: self nonEmptyMoreThan1Element size )do:
		[ :i |
		self assert: (indexes at: i) = i.
		self assert: (elements at: i) = (self nonEmptyMoreThan1Element at: i).	
		].
	
	self assert: indexes size = elements size. 
	self assert: indexes size = self nonEmptyMoreThan1Element size . 
	! !

!ArrayTest methodsFor: 'tests - copying same contents' stamp: ''!
testReverse

	| result |
	result := self nonEmpty reversed.	
	"verify content of 'result: '"
	1 to: result size do:
		[:i | self assert: ((result at: i) 
			= (self nonEmpty at: (self nonEmpty size - i + 1)))].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!ArrayTest methodsFor: 'test - creation' stamp: ''!
testWithWithWithWith
	"self debug: #testWithWithWithWith"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom: 1 to: 4.
	aCol := self collectionClass with: (collection at:1) with: ( collection at:2 ) with: ( collection at: 3) with: ( collection at: 4).

	1 to: 3 do: [ :i | self assert: ( aCol occurrencesOf: ( collection at: i ) ) = ( collection occurrencesOf: ( collection at: i ) ) ].! !

!ArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testBeforeIfAbsent
	"self debug: #testBefore"
	self assert: (self moreThan4Elements 
			before: (self moreThan4Elements at: 1)
			ifAbsent: [ 99 ]) = 99.
	self assert: (self moreThan4Elements 
			before: (self moreThan4Elements at: 2)
			ifAbsent: [ 99 ]) = (self moreThan4Elements at: 1)! !

!ArrayTest methodsFor: 'tests - as identity set' stamp: ''!
testAsIdentitySetWithoutIdentityEqualsElements
	| result collection |
	collection := self collectionWithCopy.
	result := collection asIdentitySet.
	" no elements should have been removed as no elements are equels with Identity equality"
	self assert: result size = collection size.
	collection do: 
		[ :each | 
		(collection occurrencesOf: each) = (result asOrderedCollection occurrencesOf: each) ].
	self assert: result class = IdentitySet! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixturePutOneOrMoreElementsTest
	self aValue.

	
	self indexArray.
	self indexArray do: [
		:each| 
		self assert: each class = SmallInteger. 
		self assert: (each>=1 & each<= self nonEmpty size).
		].
	
	self assert: self indexArray size = self valueArray size.
	
	self empty.
	self assert: self empty isEmpty .
	
	self nonEmpty.
	self deny: self nonEmpty  isEmpty.! !

!ArrayTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpToEmpty
	| result |
	result := self empty copyUpTo: self collectionWithoutEqualElements first.
	self assert: result isEmpty.
	! !

!ArrayTest methodsFor: 'test - iterate' stamp: 'stephane.ducasse 10/6/2008 17:39'!
speciesClass
	
	^ Array! !

!ArrayTest methodsFor: 'tests - set arithmetic' stamp: ''!
containsAll: union of: one andOf: another
			
	self assert: (one allSatisfy: [:each | union includes: each]).
	self assert: (another allSatisfy: [:each | union includes: each])! !

!ArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindLastNotIn

	| result |
	
	 result:=self empty findFirst: [:each | true].
	
	self assert: result=0. ! !

!ArrayTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsCommaStringOne
	
	"self assert: self oneItemCol asCommaString = '1'.
	self assert: self oneItemCol asCommaStringAnd = '1'."

	self assert: self nonEmpty1Element  asCommaString = (self nonEmpty1Element first asString).
	self assert: self nonEmpty1Element  asCommaStringAnd = (self nonEmpty1Element first asString).
	! !

!ArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopySameContentsTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!ArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFromToDo
	
	| result |
	result:= OrderedCollection  new.
	
	self nonEmptyMoreThan1Element  from: 1 to: (self nonEmptyMoreThan1Element  size -1) do: [:each | result add: each].
	
	1 to: (self nonEmptyMoreThan1Element  size -1) do:
		[:i|
		self assert: (self nonEmptyMoreThan1Element  at:i )=(result at:i)].
	self assert: result size=(self nonEmptyMoreThan1Element  size-1).! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 14:00'!
floatCollectionWithSameAtEndAndBegining
" return a collection with elements at end and begining equals only with classic equality (they are not the same object).
(others elements of the collection are not equal to those elements)"
	^ floatCollectionWithSameBeginingAnEnd ! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/6/2009 10:32'!
replacementCollectionSameSize
	^replacementCollectionSameSize ! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/24/2009 14:45'!
elementNotIn
"return an element not included in 'nonEmpty' "

	^ elementNotInForCopy ! !

!ArrayTest methodsFor: 'initialization' stamp: 'SebastianTleye 6/28/2013 14:46'!
setUp

	
	literalArray := #(1 true 3 #four).
	selfEvaluatingArray := { 1. true. (3/4). Color black. (2 to: 4) . 5 }.
	nonSEArray1 := { 1 . Set with: 1 }.
	nonSEarray2 := { Smalltalk globals associationAt: #Array }.
	example1 := #(1 2 3 4 5) copy.
	indexArray:= {2. 3. 4.}.
	valueArray:={0. 0. 0.}.
	oldSubCollection:= {2. 3. 4.}.
	nonEmptyMoreThan1Element:= example1.
	subCollectionNotIn:= {1. 8. 3.}.
	collectionNotIncluded:= {7. 8. 9.}.
	removedCollection:=  { 2. 4. }.
	
	example2 := {1. 2. 3/4. 4. 5}.
	collectionWith4Elements := #(1 -2 3 1). 
	collectionWithoutNil := #( 1 2 3 4).
	simpleCollection := #( 1 8 3).
	collectionOfCollectionsOfInts := { 1. { 2. 3 }. { 4. { 5. 6} } }.
	collectionOfCollectionsOfStrings:= {{{'foo'}. {'bar'}}. 'zorg'}.
	collectResult := {SmallInteger. SmallInteger. SmallInteger. SmallInteger.}.
	empty := #().
	duplicateElement := 5.2.
	withEqualElements := {1.5. duplicateElement . 6.1. 2.0. duplicateElement .} .
	withoutEqualElements := {1.1. 4.4. 6.5. 2.4. 3.1.}.
	withCharacters := {$a. $x. $d. $c. $m.}.
	unsortedCollection := {1. 2.  8. 5. 6. 7.}.
	sortedInAscendingOrderCollection := {1. 2. 3. 4. 5. 6.}.
	elementInForCopy:= 2.
	elementNotInForCopy:= 9.
	firstIndex:= 2.
	secondIndex:= 4.
	replacementCollection:= {4. 3. 2. 1.}.
	replacementCollectionSameSize := {5. 4. 3.}.	
	nonEmpty1Element:={ 5.}.
	collectionOfCollection:={1.5. 5.5. 6.5.}.
	collectionOfFloatWithEqualElements:={1.5. 5.5. 6.5. 1.5}.
	floatCollectionWithSameBeginingAnEnd := {1.5. 5.5. 1.5 copy}.
	collection5Elements := { 1. 2. 5. 3. 4.}.! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/6/2009 10:16'!
elementInForReplacement
	^ elementInForCopy ! !

!ArrayTest methodsFor: 'test - creation' stamp: ''!
testWithWithWithWithWith
	"self debug: #testWithWithWithWithWith"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom: 1 to: 5 .
	aCol := self collectionClass with: (collection at:1) with: ( collection at:2 ) with: ( collection at: 3) with: (collection at: 4 ) with: ( collection at: 5 ).

	1 to: 3 do: [ :i | self assert: ( aCol occurrencesOf: ( collection at: i ) ) = ( collection occurrencesOf: ( collection at: i ) ) ].! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 10:53'!
moreThan3Elements
	" return a collection including atLeast 3 elements"
	^ example1 ! !

!ArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testMiddle
	"self debug: #testMiddle"
	self assert: self moreThan4Elements middle = (self moreThan4Elements at: self moreThan4Elements size // 2 + 1)! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/2/2009 15:20'!
nonEmptyMoreThan1Element
	^nonEmptyMoreThan1Element .! !

!ArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testAt
	"self debug: #testAt"
	"
	self assert: (self accessCollection at: 1) = 1.
	self assert: (self accessCollection at: 2) = 2.
	"
	| index |
	index := self moreThan4Elements indexOf: self elementInForElementAccessing.
	self assert: (self moreThan4Elements at: index) = self elementInForElementAccessing! !

!ArrayTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testIndexOfIfAbsentDuplicate
	"self debug: #testIndexOfIfAbsent"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection last.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'indexOf:ifAbsent: should return the position of the first occurrence :'"
	self assert: (collection 
			indexOf: element
			ifAbsent: [ 55 ]) = 1! !

!ArrayTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterOne

	| delim oneItemStream result |
	"delim := ', '.
	oneItemStream := '' readWrite.
	self oneItemCol asStringOn: oneItemStream delimiter: delim.
	self assert: oneItemStream contents = '1'."
	
	delim := ', '.
	result:=''.
	oneItemStream := ReadWriteStream on: result.
	self nonEmpty1Element  asStringOn: oneItemStream delimiter: delim.
	oneItemStream do:[:each | self assert: each = (self nonEmpty1Element first asString)].
	

	! !

!ArrayTest methodsFor: 'tests - at put' stamp: ''!
testAtPutOutOfBounds
	"self debug: #testAtPutOutOfBounds"
	
	self should: [self empty at: self anIndex put: self aValue] raise: Error
	! !

!ArrayTest methodsFor: 'requirements' stamp: 'delaunay 4/14/2009 13:55'!
elementInForIncludesTest

	^ elementInForCopy ! !

!ArrayTest methodsFor: 'tests - index access' stamp: ''!
testLastIndexOfIfAbsent
	"self debug: #testIndexOfIfAbsent"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			lastIndexOf: element
			ifAbsent: [ 99 ]) = 1.
	self assert: (collection 
			lastIndexOf: self elementNotInForIndexAccessing
			ifAbsent: [ 99 ]) = 99! !

!ArrayTest methodsFor: 'tests - index access' stamp: ''!
testLastIndexOfStartingAt
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection last.
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size
			ifAbsent: [ 99 ]) = collection size.
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size - 1
			ifAbsent: [ 99 ]) = 99.
	self assert: (collection 
			lastIndexOf: self elementNotInForIndexAccessing
			startingAt: collection size
			ifAbsent: [ 99 ]) = 99! !

!ArrayTest methodsFor: 'tests - copying with replacement' stamp: ''!
firstIndexesOf: aSubCollection in: collection
" return an OrderedCollection with the first indexes of the occurrences of subCollection in  collection "
	| tmp result currentIndex |
	tmp:= collection.
	result:= OrderedCollection new.
	currentIndex := 1.
	
	[tmp isEmpty ]whileFalse:
		[
		(tmp beginsWith: aSubCollection)
			ifTrue: [ 	
				result add: currentIndex.
				1 to: aSubCollection size do: 
					[:i | 
					tmp := tmp copyWithoutFirst.
					currentIndex := currentIndex + 1]
				]
			ifFalse: [
				tmp := tmp copyWithoutFirst.
				currentIndex := currentIndex +1.
				]
		 ].
	
	^ result.
	! !

!ArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithCollectError
	self should: [self nonEmptyMoreThan1Element with: self empty collect:[:a :b | ]] raise: Error.! !

!ArrayedCollection commentStamp: '<historical>'!
I am an abstract collection of elements with a fixed range of integers (from 1 to n>=0) as external keys.!
!ArrayedCollection methodsFor: 'accessing' stamp: 'sma 5/12/2000 11:36'!
size
	"Answer how many elements the receiver contains."

	<primitive: 62>
	^ self basicSize! !

!ArrayedCollection methodsFor: 'printing' stamp: ''!
storeOn: aStream

	aStream nextPutAll: '(('.
	aStream nextPutAll: self class name.
	aStream nextPutAll: ' new: '.
	aStream store: self size.
	aStream nextPut: $).
	(self storeElementsFrom: 1 to: self size on: aStream)
		ifFalse: [aStream nextPutAll: '; yourself'].
	aStream nextPut: $)! !

!ArrayedCollection methodsFor: 'objects from disk' stamp: 'jb 4/30/2010 17:26'!
writeOn: aStream 
	"Store the array of bits onto the argument, aStream.  (leading byte ~= 16r80) identifies this as raw bits (uncompressed).  Always store in Big Endian (Mac) byte order.  Do the writing at BitBlt speeds. We only intend this for non-pointer arrays.  Do nothing if I contain pointers."
	(self class isPointers or: [ self class isWords not ]) ifTrue: [^ self ].
	aStream nextInt32Put: self basicSize.
	aStream nextWordsPutAll: self.! !

!ArrayedCollection methodsFor: 'objects from disk' stamp: 'nk 3/17/2004 15:22'!
byteSize
	^self basicSize * self bytesPerBasicElement
! !

!ArrayedCollection methodsFor: '*Graphics-Primitives' stamp: 'CamilloBruni 11/2/2012 14:26'!
restoreEndianness
 	"This word object was just read in from a stream.  It was stored in Big Endian (Mac) format.  Reverse the byte order if the current machine is Little Endian.
 	We only intend this for non-pointer arrays.  Do nothing if I contain pointers."
 
 	self class isPointers | self class isWords not ifTrue: [^self].
 	Smalltalk isLittleEndian 
 		ifTrue: 
 			[Bitmap 
 				swapBytesIn: self
 				from: 1
 				to: self basicSize]! !

!ArrayedCollection methodsFor: 'private' stamp: 'ul 11/21/2009 01:15'!
fillFrom: aCollection with: aBlock
	"Evaluate aBlock with each of aCollections's elements as the argument.  
	Collect the resulting values into self. Answer self."

	| index |
	index := 0.
	aCollection do: [ :each |
		self at: (index := index + 1) put: (aBlock value: each) ]! !

!ArrayedCollection methodsFor: 'private' stamp: ''!
defaultElement

	^nil! !

!ArrayedCollection methodsFor: 'adding' stamp: 'sma 5/12/2000 14:09'!
add: newObject
	self shouldNotImplement! !

!ArrayedCollection methodsFor: 'private' stamp: ''!
storeElementsFrom: firstIndex to: lastIndex on: aStream

	| noneYet defaultElement arrayElement |
	noneYet := true.
	defaultElement := self defaultElement.
	firstIndex to: lastIndex do: 
		[:index | 
		arrayElement := self at: index.
		arrayElement = defaultElement
			ifFalse: 
				[noneYet
					ifTrue: [noneYet := false]
					ifFalse: [aStream nextPut: $;].
				aStream nextPutAll: ' at: '.
				aStream store: index.
				aStream nextPutAll: ' put: '.
				aStream store: arrayElement]].
	^noneYet! !

!ArrayedCollection methodsFor: 'objects from disk' stamp: 'nk 3/17/2004 16:28'!
bytesPerBasicElement
	"Answer the number of bytes that each of my basic elements requires.
	In other words:
		self basicSize * self bytesPerBasicElement
	should equal the space required on disk by my variable sized representation."
	^self class isBytes ifTrue: [ 1 ] ifFalse: [ 4 ]! !

!ArrayedCollection methodsFor: '*Graphics-Primitives' stamp: 'CamilloBruni 11/2/2012 14:26'!
swapHalves
 		"A normal switch in endianness (byte order in words) reverses the order of 4 bytes.  That is not correct for SoundBuffers, which use 2-bytes units.  If a normal switch has be done, this method corrects it further by swapping the two halves of the long word.
 	This method is only used for 16-bit quanities in SoundBuffer, ShortIntegerArray, etc."
 
 	| hack blt |
 	"The implementation is a hack, but fast for large ranges"
 	hack := Form new hackBits: self.
 	blt := (BitBlt toForm: hack) sourceForm: hack.
 	blt combinationRule: Form reverse.  "XOR"
 	blt sourceY: 0; destY: 0; height: self size; width: 2.
 	blt sourceX: 0; destX: 2; copyBits.  "Exchange bytes 0&1 with 2&3"
 	blt sourceX: 2; destX: 0; copyBits.
 	blt sourceX: 0; destX: 2; copyBits.
! !

!ArrayedCollection methodsFor: '*NativeBoost-Core' stamp: 'Igor.Stasenko 5/2/2010 20:32'!
hexDump
	"Utility method, for inspecting the native code"
	^ String streamContents: [:str |
		
		self do: [:each |
			str nextPutAll: (each printStringBase: 16) ] separatedBy: [ str space ] ]! !

!ArrayedCollection methodsFor: '*Compression' stamp: 'tk 3/7/2001 18:07'!
writeOnGZIPByteStream: aStream 
	"We only intend this for non-pointer arrays.  Do nothing if I contain pointers."

	self class isPointers | self class isWords not ifTrue: [^ super writeOnGZIPByteStream: aStream].
		"super may cause an error, but will not be called."
	
	aStream nextPutAllWordArray: self! !

!ArrayedCollection methodsFor: 'removing' stamp: 'klub 9/14/2009 16:27'!
removeAll

	self shouldNotImplement! !

!ArrayedCollection class methodsFor: 'instance creation' stamp: 'sw 10/24/1998 22:22'!
with: firstObject with: secondObject with: thirdObject with: fourthObject with: fifthObject with: sixthObject
	"Answer a new instance of me, containing only the 6 arguments as elements."

	| newCollection |
	newCollection := self new: 6.
	newCollection at: 1 put: firstObject.
	newCollection at: 2 put: secondObject.
	newCollection at: 3 put: thirdObject.
	newCollection at: 4 put: fourthObject.
	newCollection at: 5 put: fifthObject.
	newCollection at: 6 put: sixthObject.
	^ newCollection! !

!ArrayedCollection class methodsFor: 'instance creation' stamp: ''!
with: firstObject with: secondObject with: thirdObject with: fourthObject 
	"Answer a new instance of me, containing only the three arguments as
	elements."

	| newCollection |
	newCollection := self new: 4.
	newCollection at: 1 put: firstObject.
	newCollection at: 2 put: secondObject.
	newCollection at: 3 put: thirdObject.
	newCollection at: 4 put: fourthObject.
	^newCollection! !

!ArrayedCollection class methodsFor: 'instance creation' stamp: ''!
with: firstObject with: secondObject with: thirdObject 
	"Answer a new instance of me, containing only the three arguments as
	elements."

	| newCollection |
	newCollection := self new: 3.
	newCollection at: 1 put: firstObject.
	newCollection at: 2 put: secondObject.
	newCollection at: 3 put: thirdObject.
	^newCollection! !

!ArrayedCollection class methodsFor: 'instance creation' stamp: ''!
new
	"Answer a new instance of me, with size = 0."

	^self new: 0! !

!ArrayedCollection class methodsFor: 'instance creation' stamp: ''!
newFrom: aCollection 
	"Answer an instance of me containing the same elements as aCollection."
	| newArray |
	newArray := self new: aCollection size.
	1 to: aCollection size do: [:i | newArray at: i put: (aCollection at: i)].
	^ newArray

"	Array newFrom: {1. 2. 3}
	{1. 2. 3} as: Array
	{1. 2. 3} as: ByteArray
	{$c. $h. $r} as: String
	{$c. $h. $r} as: Text
"! !

!ArrayedCollection class methodsFor: '*Glamour-Helpers' stamp: 'tg 5/4/2009 22:14'!
with: anObject withAll: aCollection

	| newArray |
	newArray := self new: aCollection size + 1.
	newArray at: 1 put: anObject.
	newArray
		replaceFrom: 2
		to: newArray size
		with: aCollection.
	^newArray
	
"Array with: 1 withAll: #(2 3 4)"! !

!ArrayedCollection class methodsFor: 'instance creation' stamp: ''!
with: firstObject with: secondObject 
	"Answer a new instance of me, containing firstObject and secondObject."

	| newCollection |
	newCollection := self new: 2.
	newCollection at: 1 put: firstObject.
	newCollection at: 2 put: secondObject.
	^newCollection! !

!ArrayedCollection class methodsFor: 'instance creation' stamp: ''!
with: anObject 
	"Answer a new instance of me, containing only anObject."

	| newCollection |
	newCollection := self new: 1.
	newCollection at: 1 put: anObject.
	^newCollection! !

!ArrayedCollection class methodsFor: 'instance creation' stamp: 'MarianoMartinezPeck 10/30/2011 15:53'!
newFromStream: s
	"Only meant for my subclasses that are raw bits and word-like.  For quick unpack form the disk."
	| len |

	(self isPointers not & self isWords) ifFalse: [ 
		self error: 'This method is only meant for raw bits and word-like subclasses '].

	s next = 16r80 ifTrue:
		["A compressed format.  Could copy what BitMap does, or use a 
		special sound compression format.  Callers normally compress their own way."
		^ self error: 'not implemented'].
	s skip: -1.
	len := s nextInt32.
	^ s nextWordsInto: (self basicNew: len)! !

!ArrayedCollection class methodsFor: 'instance creation' stamp: ''!
new: size withAll: value 
	"Answer an instance of me, with number of elements equal to size, each 
	of which refers to the argument, value."

	^(self new: size) atAllPut: value! !

!ArrayedCollection class methodsFor: 'instance creation' stamp: ''!
with: firstObject with: secondObject with: thirdObject with: fourthObject with: fifthObject
	"Answer a new instance of me, containing only the five arguments as
	elements."

	| newCollection |
	newCollection := self new: 5.
	newCollection at: 1 put: firstObject.
	newCollection at: 2 put: secondObject.
	newCollection at: 3 put: thirdObject.
	newCollection at: 4 put: fourthObject.
	newCollection at: 5 put: fifthObject.
	^newCollection! !

!ArrayedCollection class methodsFor: 'instance creation' stamp: 'sma 5/12/2000 17:37'!
withAll: aCollection
	"Create a new collection containing all the elements from aCollection."

	^ (self new: aCollection size) replaceFrom: 1 to: aCollection size with: aCollection! !

!AssertionFailure commentStamp: 'gh 5/2/2002 20:29'!
AsssertionFailure is the exception signaled from Object>>assert: when the assertion block evaluates to false.!
!AssignmentNode commentStamp: '<historical>'!
AssignmentNode comment: 'I represent a (var_expr) construct.'!
!AssignmentNode methodsFor: 'initialize-release' stamp: 'di 3/22/1999 12:00'!
variable: aVariable value: expression from: encoder

	(aVariable isMemberOf: MessageAsTempNode)
		ifTrue: ["Case of remote temp vars"
				^ aVariable store: expression from: encoder].
	variable := aVariable.
	value := expression! !

!AssignmentNode methodsFor: 'initialize-release' stamp: 'hmm 7/15/2001 21:17'!
variable: aVariable value: expression from: encoder sourceRange: range

	encoder noteSourceRange: range forNode: self.
	^self
		variable: aVariable
		value: expression
		from: encoder! !

!AssignmentNode methodsFor: 'initialize-release' stamp: ''!
toDoIncrement: var
	var = variable ifFalse: [^ nil].
	(value isMemberOf: MessageNode) 
		ifTrue: [^ value toDoIncrement: var]
		ifFalse: [^ nil]! !

!AssignmentNode methodsFor: 'code generation (closures)' stamp: 'eem 5/30/2008 09:37'!
analyseTempsWithin: scopeBlock "<BlockNode>"  rootNode: rootNode "<MethodNode>" assignmentPools: assignmentPools "<Dictionary>"
	"N.B.  since assigment happens _after_ the value is evaluated the value is sent the message _first_."
	value analyseTempsWithin: scopeBlock rootNode: rootNode assignmentPools: assignmentPools.
	variable beingAssignedToAnalyseTempsWithin: scopeBlock rootNode: rootNode assignmentPools: assignmentPools! !

!AssignmentNode methodsFor: 'code generation' stamp: 'eem 6/4/2008 11:27'!
emitCodeForEffect: stack encoder: encoder

	variable emitCodeForLoad: stack encoder: encoder.
	value emitCodeForValue: stack encoder: encoder.
	pc := encoder methodStreamPosition + 1. "debug pc is first byte of the store, i.e. the next byte".
	variable emitCodeForStorePop: stack encoder: encoder! !

!AssignmentNode methodsFor: 'code generation' stamp: 'eem 5/20/2008 15:16'!
sizeCodeForValue: encoder

	^(variable sizeCodeForLoad: encoder)
	+ (value sizeCodeForValue: encoder)
	+ (variable sizeCodeForStore: encoder)! !

!AssignmentNode methodsFor: 'printing' stamp: 'eem 5/9/2008 18:44'!
printOn: aStream indent: level precedence: p

	aStream nextPut: $(.
	self printOn: aStream indent: level.
	aStream nextPut: $)! !

!AssignmentNode methodsFor: 'initialize-release' stamp: ''!
value
	^ value! !

!AssignmentNode methodsFor: 'equation translation' stamp: ''!
variable
	^variable! !

!AssignmentNode methodsFor: 'initialize-release' stamp: ''!
variable: aVariable value: expression

	variable := aVariable.
	value := expression! !

!AssignmentNode methodsFor: 'code generation' stamp: 'eem 6/4/2008 11:27'!
emitCodeForValue: stack encoder: encoder

	variable emitCodeForLoad: stack encoder: encoder.
	value emitCodeForValue: stack encoder: encoder.
	pc := encoder methodStreamPosition + 1. "debug pc is first byte of the store, i.e. the next byte".
	variable emitCodeForStore: stack encoder: encoder! !

!AssignmentNode methodsFor: 'visiting' stamp: 'eem 9/6/2009 12:33'!
accept: aVisitor
	^aVisitor visitAssignmentNode: self! !

!AssignmentNode methodsFor: 'testing' stamp: 'eem 6/16/2008 09:37'!
isAssignmentNode
	^true! !

!AssignmentNode methodsFor: 'code generation' stamp: 'eem 5/20/2008 15:16'!
sizeCodeForEffect: encoder

	^(variable sizeCodeForLoad: encoder)
	+ (value sizeCodeForValue: encoder)
	+ (variable sizeCodeForStorePop: encoder)! !

!AssignmentNode methodsFor: 'printing' stamp: 'eem 5/6/2008 13:48'!
printOn: aStream indent: level 
	variable printOn: aStream indent: level.
	aStream nextPutAll: ' := '.
	value printOn: aStream indent: level + 2! !

!Association commentStamp: 'StephaneDucasse 2/13/2010 15:13'!
I represent a pair of associated objects--a key and a value. My instances can serve as entries in a dictionary.


Implementation notes: 
Note that hash is not redefined even if the = was redefined because Association>>hash may cause extreme slowdowns in compiling Unicode methods. Association>>hash does not need to hash the value; it's slow and useless.

!
!Association methodsFor: 'testing' stamp: 'MaxLeske 1/25/2014 22:13'!
analogousCodeTo: anAssociation
	^ self = anAssociation! !

!Association methodsFor: '*System-Settings-Browser' stamp: 'alain.plantec 3/24/2009 23:20'!
settingFixedDomainValueNodeFrom: aSettingNode 
	^ aSettingNode fixedDomainValueNodeForAssociation: self! !

!Association methodsFor: 'printing' stamp: ''!
storeOn: aStream
	"Store in the format (key->value)"
	aStream nextPut: $(.
	key storeOn: aStream.
	aStream nextPutAll: '->'.
	value storeOn: aStream.
	aStream nextPut: $)! !

!Association methodsFor: 'testing' stamp: 'nice 7/20/2011 09:00'!
literalEqual: otherLiteral
	"Answer true if the receiver and otherLiteral represent the same literal.
	Variable bindings are literally equals only if identical.
	This is how variable sharing works, by preserving identity and changing only the value."
	^self == otherLiteral! !

!Association methodsFor: '*Morphic-Base' stamp: 'BenjaminVanRyseghem 10/11/2013 15:17'!
head

	^ (key isKindOf: Association)
		ifTrue: [ key head ]
		ifFalse: [ key ]! !

!Association methodsFor: '*Morphic-Base' stamp: 'BenjaminVanRyseghem 10/11/2013 15:20'!
tail

	^ (key isKindOf: Association)
		ifTrue: [ key tail -> value ]
		ifFalse: [ value ]! !

!Association methodsFor: 'accessing' stamp: ''!
key: aKey value: anObject 
	"Store the arguments as the variables of the receiver."

	key := aKey.
	value := anObject! !

!Association methodsFor: 'accessing' stamp: ''!
value
	"Answer the value of the receiver."

	^value! !

!Association methodsFor: 'accessing' stamp: ''!
value: anObject 
	"Store the argument, anObject, as the value of the receiver."

	value := anObject! !

!Association methodsFor: 'comparing' stamp: 'md 1/27/2004 17:27'!
= anAssociation

	^ super = anAssociation and: [value = anAssociation value]! !

!Association methodsFor: 'printing' stamp: ''!
printOn: aStream

	super printOn: aStream.
	aStream nextPutAll: '->'.
	value printOn: aStream! !

!Association methodsFor: '*Glamour-Helpers' stamp: 'tg 10/25/2010 02:00'!
asGlamourOriginIdentifier
	^ GLMPortIdentifier new 
		paneName: self key;
		portName: self value! !

!Association methodsFor: '*Glamour-Helpers' stamp: 'tg 10/25/2010 02:01'!
asGlamourTargetIdentifier
	^ GLMPortIdentifier new 
		paneName: self key;
		portName: self value! !

!Association methodsFor: 'self evaluating' stamp: 'nice 10/30/2009 20:24'!
isSelfEvaluating
	^ self class == Association and: [self key isSelfEvaluating and: [self value isSelfEvaluating]]! !

!Association class methodsFor: 'instance creation' stamp: ''!
key: newKey value: newValue
	"Answer an instance of me with the arguments as the key and value of 
	the association."

	^(super key: newKey) value: newValue! !

!AssociationTest commentStamp: 'TorstenBergmann 2/20/2014 15:19'!
SUnit tests for Associations!
!AssociationTest methodsFor: 'tests' stamp: 'al 10/13/2008 20:32'!
testHash

	self 
		assert: (a hash = a copy hash);
		assert: (a hash = b hash)! !

!AssociationTest methodsFor: 'tests' stamp: 'md 3/8/2004 16:37'!
testEquality
	
	self 
		assert: (a key = b key);
		deny: (a value = b value);
		deny: (a = b)

! !

!AssociationTest methodsFor: 'tests' stamp: 'ab 12/29/2008 07:59'!
testComparison
	self assert: ((#a -> 'foo') < (#b -> 'zork'))! !

!AssociationTest methodsFor: 'setup' stamp: 'zz 12/5/2005 18:33'!
setUp

	a := 1 -> 'one'.
	b := 1 -> 'een'.! !

!AssociationTest methodsFor: 'tests' stamp: 'MarcusDenker 5/2/2013 11:24'!
testIsSelfEvaluating
	| anotherAssociation |
	self assert: (a isSelfEvaluating).
	
	self assert: (a printString = '1->''one''').
	
	anotherAssociation := Object new -> Object new.
	anotherAssociation isSelfEvaluating ifTrue: [self
		assert: (self class compiler evaluate: anotherAssociation printString) = anotherAssociation
		description: 'a self evaluating should evaluate as self'].
! !

!AsyncFile commentStamp: 'HenrikSperreJohansen 2/16/2012 11:40'!
An asynchronous file allows simple file read and write operations to be performed in parallel with other processing. This is useful in multimedia applications that need to stream large amounts of sound or image data from or to a file while doing other work.

Closing the file after its use is currently required to not leak external semaphores. 
!
!AsyncFile methodsFor: 'write and read' stamp: 'nice 4/16/2009 10:02'!
writeBuffer: buffer atFilePosition: fPosition onCompletionDo: aBlock
	"Start an operation to write the contents of the buffer at given position in this file, and fork a process to await its completion. When the write completes, evaluate the given block. Note that, since the completion block runs asynchronously, the client may need to use a SharedQueue or a semaphore for synchronization."

	self primWriteStart: fileHandle
		fPosition: fPosition
		fromBuffer: buffer
		at: 1
		count: buffer size.
	"here's the process that awaits the results:"
	[| n |
		[	semaphore wait.
		  	n := self primWriteResult: fileHandle.
		  	n = Busy.
		] whileTrue.  "loop while busy in case the semaphore had excess signals"
		n = ErrorCode ifTrue: [^ self error: 'asynchronous write operation failed'].
		n = buffer size ifFalse: [^ self error: 'did not write the entire buffer'].
		aBlock value.
	] forkAt: Processor userInterruptPriority.
! !

!AsyncFile methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primOpen: fileName forWrite: openForWrite semaIndex: semaIndex
	"Open a file of the given name, and return a handle for that file. Answer the receiver if the primitive succeeds, nil otherwise."

	<primitive: 'primitiveAsyncFileOpen' module: 'AsynchFilePlugin'>
	^ nil
! !

!AsyncFile methodsFor: 'accessing' stamp: 'di 7/6/1998 10:58'!
fileHandle
	^ fileHandle! !

!AsyncFile methodsFor: 'write and read' stamp: 'di 7/6/1998 10:58'!
waitForCompletion
	semaphore wait! !

!AsyncFile methodsFor: 'open/close' stamp: 'stephaneducasse 2/4/2006 20:31'!
close

	fileHandle ifNil: [^ self].  "already closed"
	self primClose: fileHandle.
	Smalltalk unregisterExternalObject: semaphore.
	semaphore := nil.
	fileHandle := nil.
! !

!AsyncFile methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primReadStart: fHandle fPosition: fPosition count: count
	"Start a read operation of count bytes starting at the given offset in the given file."

	<primitive: 'primitiveAsyncFileReadStart' module: 'AsynchFilePlugin'>
	self error: 'READ THE COMMENT FOR THIS METHOD.'

"NOTE: This method will fail if there is insufficient C heap to allocate an internal buffer of the required size (the value of count).  If you are trying to read a movie file, then the buffer size will be height*width*2 bytes.  Each Squeak image retains a value to be used for this allocation, and it it initially set to 0.  If you are wish to play a 640x480 movie, you need room for a buffer of 640*480*2 = 614400 bytes.  You should execute the following...

	Smalltalk extraVMMemory 2555000.

Then save-and-quit, restart, and try to open the movie file again.  If you are using Async files in another way, find out the value of count when this failure occurs (call it NNNN), and instead of the above, execute...

	Smalltalk extraVMMemory: Smalltalk extraVMMemory + NNNN

then save-and-quit, restart, and try again.
"

! !

!AsyncFile methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primClose: fHandle
	"Close this file. Do nothing if primitive fails."

	<primitive: 'primitiveAsyncFileClose' module: 'AsynchFilePlugin'>
! !

!AsyncFile methodsFor: 'tests' stamp: 'CamilloBruni 5/4/2012 21:16'!
test: byteCount fileName: fileName
	"AsyncFile new test: 10000 fileName: 'testData'"

	| buf1 buf2 bytesWritten bytesRead |
	buf1 := String new: byteCount withAll: $x.
	buf2 := String new: byteCount.
	self open: fileName  asFileReference fullName forWrite: true.
	self primWriteStart: fileHandle
		fPosition: 0
		fromBuffer: buf1
		at: 1
		count: byteCount.
	semaphore wait.
	bytesWritten := self primWriteResult: fileHandle.
	self close.
	
	self open: fileName asFileReference fullName forWrite: false.
	self primReadStart: fileHandle fPosition: 0 count: byteCount.
	semaphore wait.
	bytesRead :=
		self primReadResult: fileHandle
			intoBuffer: buf2
			at: 1
			count: byteCount.
	self close.

	buf1 = buf2 ifFalse: [self error: 'buffers do not match'].
	^ 'wrote ', bytesWritten printString, ' bytes; ',
	   'read ', bytesRead printString, ' bytes'
! !

!AsyncFile methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primWriteResult: fHandle
	"Answer the number of bytes written. A negative result means:
		-1 the last operation is still in progress
		-2 the last operation encountered an error"

	<primitive: 'primitiveAsyncFileWriteResult' module: 'AsynchFilePlugin'>
	self primitiveFailed
! !

!AsyncFile methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primWriteStart: fHandle fPosition: fPosition fromBuffer: buffer at: startIndex count: count
	"Start a write operation of count bytes starting at the given index in the given buffer. The buffer may be any sort of bytes or words object, excluding CompiledMethods. The contents of the buffer are copied into an internal buffer immediately, so the buffer can be reused after the write operation has been started. Fail if there is insufficient C heap to allocate an internal buffer of the requested size."

	<primitive: 'primitiveAsyncFileWriteStart' module: 'AsynchFilePlugin'>
	writeable ifFalse: [^ self error: 'attempt to write a file opened read-only'].
	self primitiveFailed
! !

!AsyncFile methodsFor: 'write and read' stamp: 'nice 4/16/2009 10:02'!
readByteCount: byteCount fromFilePosition: fPosition onCompletionDo: aBlock
	"Start a read operation to read byteCount's from the given position in this file. and fork a process to await its completion. When the operation completes, evaluate the given block. Note that, since the completion block may run asynchronous, the client may need to use a SharedQueue or a semaphore for synchronization."

	| buffer |
	buffer := String new: byteCount.
	self primReadStart: fileHandle fPosition: fPosition count: byteCount.
	"here's the process that awaits the results:"
	[| n |
		[	semaphore wait.
		  	n := self primReadResult: fileHandle intoBuffer: buffer at: 1 count: byteCount.
		  	n = Busy.
		] whileTrue.  "loop while busy in case the semaphore had excess signals"
		n = ErrorCode ifTrue: [^ self error: 'asynchronous read operation failed'].
		aBlock value: buffer.
	] forkAt: Processor userInterruptPriority.
! !

!AsyncFile methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primReadResult: fHandle intoBuffer: buffer at: startIndex count: count
	"Copy the result of the last read operation into the given buffer starting at the given index. The buffer may be any sort of bytes or words object, excluding CompiledMethods. Answer the number of bytes read. A negative result means:
		-1 the last operation is still in progress
		-2 the last operation encountered an error"

	<primitive: 'primitiveAsyncFileReadResult' module: 'AsynchFilePlugin'>
	self primitiveFailed
! !

!AsyncFile methodsFor: 'open/close' stamp: 'ar 6/3/2007 22:13'!
open: fullFileName forWrite: aBoolean
	"Open a file of the given name, and return a handle for that file. Answer the receiver if the primitive succeeds, nil otherwise.
	If openForWrite is true, then:
		if there is no existing file with this name, then create one
		else open the existing file in read-write mode
	otherwise:
		if there is an existing file with this name, then open it read-only
		else answer nil."
	"Note: if an exisiting file is opened for writing, it is NOT truncated. If truncation is desired, the file should be deleted before being opened as an asynchronous file."
	"Note: On some platforms (e.g., Mac), a file can only have one writer at a time."

	| semaIndex |
	name := fullFileName.
	writeable := aBoolean.
	semaphore := Semaphore new.
	semaIndex := Smalltalk registerExternalObject: semaphore.
	fileHandle := self primOpen: name asVmPathName forWrite: writeable semaIndex: semaIndex.
	fileHandle ifNil: [
		Smalltalk unregisterExternalObject: semaphore.
		semaphore := nil.
		^ nil].
! !

!AsyncFile class methodsFor: 'initialization' stamp: 'bootstrap 5/31/2006 20:45'!
initialize
	"AsyncFile initialize"

	"Possible abnormal I/O completion results."
	Busy := -1.
	ErrorCode := -2.
! !

!AthensAbstractPaint commentStamp: 'FernandoOlivero 3/9/2012 14:03'!
I am an abstract paint, which should be converted before it can be used by Athens.
I am backend agnostic, as opposed to concrete paint(s).
Also, any other object can play the role of paint, as long as it implements the conversion method, #asAthensPaintOn:

See other implementors of #asAthensPaintOn:, such as Color and Form.!
!AthensAbstractPaint methodsFor: 'converting' stamp: 'IgorStasenko 9/3/2013 14:23'!
asAthensPaintOn: aCanvas	
	^ self! !

!AthensAbstractShape commentStamp: '<historical>'!
In Athens, any object can play role of a shape.

I demonstrating the minimal protocol which should be supported
by "shape" role, to be used with Athens canvas.
See my methods comments for more details.
!
!AthensAbstractShape methodsFor: 'converting' stamp: 'IgorStasenko 5/6/2013 05:40'!
asAthensShapeOn: canvas
	"Note: The answered object of this message should conform with AthensShape protocol.	"
	self subclassResponsibility.! !

!AthensAffineTransform commentStamp: '<historical>'!
I support the same protocol than AthensTransform,
but in addition I store a plain 2x3 matrix with state accessible at any moment.

This is different to AthensTransform because it does not expose its internal storage, because it can be backend specific.!
!AthensAffineTransform methodsFor: 'accessing' stamp: ''!
translation
	^ x@y! !

!AthensAffineTransform methodsFor: 'accessing' stamp: 'IgorStasenko 10/20/2011 18:48'!
x
	^ x! !

!AthensAffineTransform methodsFor: 'accessing' stamp: 'IgorStasenko 4/24/2012 14:04'!
shy: number
	shy := number! !

!AthensAffineTransform methodsFor: 'transformations' stamp: 'IgorStasenko 10/21/2011 12:55'!
clearTranslation
	"reset a translation from matrix, leaving only scale and rotation"
	
	x := y := 0.0! !

!AthensAffineTransform methodsFor: 'vector-transform' stamp: 'NicolaiHess 11/25/2014 23:25'!
inverseTransform: aPoint 
"  (we assume matrix is never degenerate)"
	| px py y0 x0 |
	
	px := aPoint x.
	py := aPoint y.
	"for rotations around +/- half pi"
	(sx = 0 and:[ sy = 0]) ifTrue:[
		^ self inverseTransformHalfPi: aPoint.
		].
	"for rotations around +/- pi or 0"
	(shx = 0 and:[ shy = 0]) ifTrue:[
		^ self inverseTransformPiOrZero: aPoint.
		].
    "otherwise:
     Given straight transformation formulae:
		
	px := x0*sx + y0*shx + x.
	py := x0*shy + y0*sy + y.
	
	we doing inverse one, trying to find x0,y0 for rest of given variables (px,py,x,y,sx,sy,shx,shy).
	
	x0 := px - x - (shx*y0) / sx.
	y0 := py - y - (shy*x0) / sy.
	
	y0 := py - y - (shy*(px - x - (shx*y0) / sx)) / sy.

	sy * y0  == py - y - (shy*(px - x - (shx*y0) / sx)).

	sx * sy * y0  == (sx*(py - y)) - (shy*(px - x - (shx*y0))).

	sx * sy * y0  == sx*py - (sx*y) - (shy*px) + (shy*x) + (shy*shx*y0).

	(sx * sy * y0) - (shy*shx*y0)  == sx*py - (sx*y) - (shy*px) + (shy*x) .
	
	y0* ((sx * sy) - (shy*shx))  == sx*py - (sx*y) - (shy*px) + (shy*x) .

"
	y0  := sx*py - (sx*y) - (shy*px) + (shy*x) / ((sx * sy) - (shy*shx)).
	x0 := px - x - (shx*y0) / sx.

	^ x0@y0
	! !

!AthensAffineTransform methodsFor: 'accessing' stamp: 'IgorStasenko 10/20/2011 18:48'!
y
	^ y! !

!AthensAffineTransform methodsFor: 'transformations' stamp: 'IgorStasenko 3/26/2011 01:46'!
rotateByDegrees: angle


	^ self rotateByRadians: angle degreesToRadians! !

!AthensAffineTransform methodsFor: 'accessing' stamp: 'IgorStasenko 10/20/2011 18:48'!
sx
	^ sx! !

!AthensAffineTransform methodsFor: 'initialize-release' stamp: 'IgorStasenko 3/26/2011 02:09'!
initialize
	self loadIdentity! !

!AthensAffineTransform methodsFor: 'accessing' stamp: ''!
scale
	^ sx@sy! !

!AthensAffineTransform methodsFor: 'accessing' stamp: ''!
translation: aPoint
	x := aPoint x.
	y := aPoint y.! !

!AthensAffineTransform methodsFor: 'accessing' stamp: 'IgorStasenko 4/24/2012 14:04'!
sx: number
	sx := number! !

!AthensAffineTransform methodsFor: 'transformations' stamp: 'IgorStasenko 3/7/2012 14:02'!
loadAffineTransform: m

	x := m x.
	y := m y.
	sx := m sx.
	sy := m sy.
	shx := m shx.
	shy := m shy.! !

!AthensAffineTransform methodsFor: 'transformations' stamp: 'IgorStasenko 4/24/2012 14:47'!
multiplyBy: m

	"multiply receiver by given affine matrix"
"
| sx   shx   x   |        | sx'   shx'   x'   | 
| shy sy     y    |   *    | shy' sy'     y'   |
|  0     0     1   |        | 0  	0   		1	|       

"	
	
	| nsx nshx nx nshy nsy ny |
	
	nsx := sx * m sx + (shx  * m shy).
	nshx := sx * m shx + (shx * m sy).
	nx := sx * m x + (shx * m y) + x.
	
	nshy := shy * m sx + (sy * m shy).
	nsy := shy * m shx  + (sy * m sy).
	ny := shy* m x + (sy * m y) + y.
	
	sx := nsx.
	sy := nsy.
	shx := nshx.
	shy := nshy.
	x := nx.
	y := ny.		! !

!AthensAffineTransform methodsFor: 'vector-transform' stamp: 'IgorStasenko 3/26/2011 03:02'!
transform: aPoint 
	| px py |
	
	px := aPoint x.
	py := aPoint y.
	^ Point 
		x: (sx*px +(shx*py) + x)
		y: (shy*px + (sy*py) + y) ! !

!AthensAffineTransform methodsFor: 'transformations' stamp: 'IgorStasenko 10/24/2011 17:24'!
translateX: px y: py

" multiply receiver by translation matrix :

| sx   shx   x   |        | 1  0  px |             |	sx  shx  (sx*px + shx*py + x) |
| shy sy     y   |   *   | 0  1  py |   ===> | shy  sy  (shy*px + sy*py + y)  |
|  0     0     1   |       | 0  0   1  |             |  0     0    1  |

"
	x := (sx*px) + (shx*py) + x.
	y := (shy*px) + (sy*py) + y.
! !

!AthensAffineTransform methodsFor: 'accessing' stamp: 'IgorStasenko 4/24/2012 14:04'!
sy: number
	sy := number! !

!AthensAffineTransform methodsFor: 'accessing' stamp: 'IgorStasenko 10/20/2011 18:48'!
sy
	^ sy! !

!AthensAffineTransform methodsFor: 'transformations' stamp: 'IgorStasenko 3/7/2012 14:01'!
restoreAfter: aBlock
	|previous|
	previous := self copy.
	aBlock ensure: [ 	self loadAffineTransform: previous ]! !

!AthensAffineTransform methodsFor: 'transformations' stamp: 'IgorStasenko 10/25/2011 13:20'!
transposed
	
	| s |
	s := shx.
	shx := shy.
	shy := s.! !

!AthensAffineTransform methodsFor: 'private' stamp: 'NicolaiHess 11/25/2014 23:20'!
inverseTransformHalfPi: aPoint
	"assume sx,sy = 0
		
	px := y0*shx + x.
	py := x0*shy + y.
	
	we doing inverse one, trying to find x0,y0 for rest of given variables (px,py,x,y,sx,sy,shx,shy)"
	| px py y0 x0 |
	
	px := aPoint x.
	py := aPoint y.

	x0 := py - y  / shy.
	y0 := px - x  / shx.

	^ x0@y0
	! !

!AthensAffineTransform methodsFor: 'transformations' stamp: 'IgorStasenko 3/26/2011 03:17'!
translateBy: aPoint

	^ self translateX: aPoint x Y: aPoint y! !

!AthensAffineTransform methodsFor: 'accessing' stamp: 'NicolaiHess 11/25/2014 23:32'!
inverted
	"answer an inverse transformation of receiver"
	| det |
	det := sx * sy - (shx * shy).
	^ self class new
		sx: sy / det;
		sy: sy / det;
		shx: shx * -1 / det;
		shy: shy * -1 / det;
		x: shx * y - (x * sy) / det;
		y: shy * x - (sx * y) / det;
		yourself! !

!AthensAffineTransform methodsFor: 'accessing' stamp: 'IgorStasenko 4/24/2012 14:04'!
y: number
	y := number! !

!AthensAffineTransform methodsFor: 'accessing' stamp: 'IgorStasenko 10/20/2011 18:48'!
shx
	^ shx! !

!AthensAffineTransform methodsFor: 'transformations' stamp: 'IgorStasenko 3/26/2011 01:52'!
scaleX: fx Y: fy

	"multiply receiver by scale matrix

| sx   shx   x   |        | fx 0 0  |              | sx*fx    shx*fx  x |
| shy sy     y   |   *   | 0 fy 0  |    ===> | shy*fy  sy*fy   y |
|  0     0     1   |       | 0 0  1  |              |  0          0        1  |

"
	sx := sx*fx.
	shx := shx*fx.
	sy := sy*fy.
	shy := shy*fy.
! !

!AthensAffineTransform methodsFor: 'accessing' stamp: 'IgorStasenko 4/24/2012 14:03'!
x: number
	x := number! !

!AthensAffineTransform methodsFor: 'transformations' stamp: 'IgorStasenko 3/21/2012 18:26'!
scaleBy: factor

	"multiply receiver by uniform scale matrix

| sx   shx   x   |       | (f x) 0 0  |             | sx*(f x)    shx*(f y)  x |
| shy sy     y   |   *   | 0 (f y) 0  |    ===> | shy*(f x)     sy*(f y)    y |
|  0     0     1  |        | 0 0     1  |                |  0      0              1  |

"	
	factor isPoint ifTrue: [
		sx := sx*factor x.
		shx := shx*factor y.
		sy := sy*factor y.
		shy := shy*factor x. 		
	] ifFalse: [
		sx := sx*factor.
		shx := shx*factor.
		sy := sy*factor.
		shy := shy*factor. ]
! !

!AthensAffineTransform methodsFor: 'transformations' stamp: 'IgorStasenko 3/21/2012 18:23'!
translateX: px Y: py


" multiply receiver by translation matrix :

| sx   shx   x   |        | 1  0  px |             |	sx  shx  (sx*px + shx*py + x) |
| shy sy     y   |   *   | 0  1  py |   ===> | shy  sy  (shy*px + sy*py + y)  |
|  0     0     1   |       | 0  0   1  |             |  0     0    1  |

"
	x := (sx*px) + (shx*py) + x.
	y := (shy*px) + (sy*py) + y.
! !

!AthensAffineTransform methodsFor: 'transformations' stamp: 'IgorStasenko 3/26/2011 03:21'!
rotateByRadians: angle

	"multiply receiver by rotation matrix

| sx   shx   x   |        | cos -sin 0  |             | (sx*cos)+(shx*sin)   (-sx*sin+shx*cos)  x |
| shy sy     y   |   *   | sin   cos 0 |   ===> | (shy*cos)+(sy*sin)   (-shy*sin)+sy*cos) y |
|  0     0     1   |       | 0     0   1   |             |        0                                 0                1  |

"
	| cos sin newSx newSy |
	
	cos := angle cos.
	sin := angle sin.
	
	
	newSx := sx*cos + (shx*sin).
	newSy := sy*cos - (shy*sin).
	
	shx := shx*cos - (sx*sin).
	shy := shy*cos + (sy*sin).

	sx := newSx.
	sy := newSy.! !

!AthensAffineTransform methodsFor: 'accessing' stamp: 'IgorStasenko 4/24/2012 14:04'!
shx: number
	shx := number! !

!AthensAffineTransform methodsFor: 'accessing' stamp: 'IgorStasenko 10/20/2011 18:48'!
shy
	^ shy! !

!AthensAffineTransform methodsFor: 'vector-transform' stamp: 'IgorStasenko 3/27/2011 18:40'!
transformX: px Y: py
	" transform x and y coordinates by receiver. Answer a Point"
	^ Point 
		x: (sx*px +(shx*py) + x)
		y: (shy*px + (sy*py) + y) ! !

!AthensAffineTransform methodsFor: 'transformations' stamp: 'IgorStasenko 3/26/2011 02:09'!
loadIdentity
	"initialize with identity transform"
	sx := sy := 1.0.
	shx := shy := x := y := 0.0.
	
	! !

!AthensAffineTransform methodsFor: 'private' stamp: 'NicolaiHess 11/25/2014 23:22'!
inverseTransformPiOrZero: aPoint
	"assume shx,shy = 0
		
	px := x0*sx + x.
	py := y0*sy + y.
	we doing inverse one, trying to find x0,y0 for rest of given variables (px,py,x,y,sx,sy,shx,shy)"
	
	| px py y0 x0 |
	
	px := aPoint x.
	py := aPoint y.

	x0 := px - x / sx.
	y0 := py - y / sy.

	^ x0@y0
	! !

!AthensArcSegment commentStamp: 'IgorStasenko 3/7/2012 13:41'!
i am abstract class , representing an arc segment!
!AthensArcSegment methodsFor: 'accessors' stamp: 'IgorStasenko 3/7/2012 13:44'!
angle
	^ angle! !

!AthensArcSegment methodsFor: 'accessors' stamp: 'IgorStasenko 3/7/2012 13:30'!
endPoint: pt angle: a

	endPoint := pt.
	angle := a! !

!AthensArcSegment methodsFor: 'accessors' stamp: 'IgorStasenko 3/7/2012 13:31'!
endPoint
	^ endPoint! !

!AthensBackgroundChange commentStamp: 'IgorStasenko 2/6/2012 16:16'!
Text display command for changing the background color!
!AthensBackgroundChange methodsFor: 'initialize-release' stamp: 'IgorStasenko 10/28/2011 14:45'!
initialize
	width :=0.
	color := Color transparent.! !

!AthensBackgroundChange methodsFor: 'accessing' stamp: 'IgorStasenko 10/28/2011 14:33'!
width: anObject

	width := anObject! !

!AthensBackgroundChange methodsFor: 'accessing' stamp: 'IgorStasenko 10/28/2011 14:33'!
width

	^ width! !

!AthensBackgroundChange methodsFor: 'accessing' stamp: 'IgorStasenko 11/7/2011 13:41'!
start
	^ start! !

!AthensBackgroundChange methodsFor: 'accessing' stamp: 'IgorStasenko 10/28/2011 14:33'!
color

	^ color! !

!AthensBackgroundChange methodsFor: 'rendering' stamp: 'IgorStasenko 11/7/2011 13:42'!
renderOn: renderer
	color isTransparent ifFalse: [
		renderer renderBackground: self
	]! !

!AthensBackgroundChange methodsFor: 'accessing' stamp: 'IgorStasenko 11/7/2011 13:41'!
start: aStart
	start := aStart! !

!AthensBackgroundChange methodsFor: 'adding' stamp: 'IgorStasenko 10/28/2011 14:44'!
addWidth: aWidth
	width := width + aWidth! !

!AthensBackgroundChange methodsFor: 'accessing' stamp: 'IgorStasenko 10/28/2011 14:33'!
color: anObject

	color := anObject! !

!AthensBalloonEngine commentStamp: 'IgorStasenko 3/29/2011 01:04'!
- balloon engine using only first 4 variables of receiver instance:

 - work buffer
 - span
 - bitBlt (Bitblt object)
 - forms

!
!AthensBalloonEngine methodsFor: 'paints' stamp: 'IgorStasenko 4/1/2011 16:01'!
registerLinearGradient: colorRamp origin: origin corner: corner 
	| pixelRamp direction normal |
	
	pixelRamp := GradientFillStyle pixelRampCache at: colorRamp.
	direction := corner - origin.
	normal := direction y negated @ direction x.
	
	currentFill := 
		self primAddGradientFill: pixelRamp
			from: origin
			along: direction
			normal:  normal
			radial:  false.! !

!AthensBalloonEngine methodsFor: 'drawing' stamp: 'IgorStasenko 4/21/2011 16:20'!
copyBits
	(bitBlt notNil and:[bitBlt destForm notNil]) ifTrue:[bitBlt destForm unhibernate].
	self copyLoopFastest.! !

!AthensBalloonEngine methodsFor: 'registering fills' stamp: 'NicolaiHess 6/24/2014 23:18'!
registerFormFill: form origin: orig direction: dir normal: norm
	self
		registerFormFill: form
		origin: orig
		direction: dir
		normal: norm
		tileFlag: true! !

!AthensBalloonEngine methodsFor: 'paints' stamp: 'IgorStasenko 4/14/2011 16:26'!
registerRadialGradient: colorRamp center: aCenter radius: r 
	| pixelRamp |
	
	pixelRamp := GradientFillStyle pixelRampCache at: colorRamp.
	
	currentFill := 
		self primAddGradientFill: pixelRamp
			from: aCenter
			along: (aCenter x + r @ aCenter y)
			normal:  (aCenter x  @ aCenter y - r)
			radial:  true.! !

!AthensBalloonEngine methodsFor: 'initialize' stamp: 'IgorStasenko 4/22/2011 14:00'!
reset
	workBuffer ifNil:[workBuffer := self class allocateOrRecycleBuffer: 10000].
	self primInitializeBuffer: workBuffer.
	self primSetAALevel: 4.
	self primSetOffset: 0@0.
	self primSetClipRect: clipRect.
	self primSetEdgeTransform: edgeTransform.
	self primSetColorTransform: colorTransform.
	forms := #().! !

!AthensBalloonEngine methodsFor: 'drawing' stamp: 'IgorStasenko 5/2/2011 04:36'!
strokeRectangle: rect borderWidth: width

	currentFill = 0 ifTrue: [ ^ self ]. "no fill "
	self primAddRectFrom: rect origin 
			to: rect corner
			fillIndex: 0
			borderWidth: width
			borderColor: currentFill.

	self copyBits.
	! !

!AthensBalloonEngine methodsFor: 'drawing' stamp: 'IgorStasenko 4/22/2011 13:56'!
drawImage: aForm transform: m 
	| orig dir normal tr corner rect |

	rect := aForm boundingBox.
	orig := 0@0. 
	dir := aForm width @ 0.
	normal := 0 @ aForm height.
	
	tr := edgeTransform.
	edgeTransform := m.

	self prepareForRendering.
	self registerFormFill: aForm
		origin: orig
		direction: dir
		normal: normal.
	self fillRectangle: rect.

	edgeTransform := tr.
! !

!AthensBalloonEngine methodsFor: 'drawing' stamp: 'IgorStasenko 9/19/2011 15:38'!
strokeRectangle: rect width: aWidth

	currentFill = 0 ifTrue: [ ^ self ]. "no fill "
	self primAddRectFrom: rect origin 
			to: rect corner
			fillIndex: 0
			borderWidth: aWidth asInteger
			borderColor: currentFill.

	self copyBits.
	! !

!AthensBalloonEngine methodsFor: 'paints' stamp: 'IgorStasenko 4/14/2011 17:15'!
registerRadialGradient: colorRamp center: aCenter direction: dir normal: n 
	| pixelRamp |
	
	pixelRamp := GradientFillStyle pixelRampCache at: colorRamp.
	
	currentFill := 
		self primAddGradientFill: pixelRamp
			from: aCenter
			along: dir
			normal:  n
			radial:  true.! !

!AthensBalloonEngine methodsFor: 'accessing' stamp: 'IgorStasenko 4/1/2011 09:03'!
setFill: aFill
	currentFill := aFill! !

!AthensBalloonEngine methodsFor: 'private' stamp: 'IgorStasenko 9/19/2011 16:37'!
fastReset

	workBuffer ifNil: [ ^ self reset ].

	workBuffer 
		at: (1+GWState) put: GEStateUnlocked;
		at: (1+GWObjUsed) put: 4;
		at: (1+GWNeedsFlush) put: 0;
		at: (1+GWCurrentZ) put: 0;
		at: (1+GWGETStart) put: 0";

		at: (1+GWGETUsed) put: 0;
		at: (1+GWAETStart) put: 0;
		at: (1+GWAETUsed) put: 0".
	
	self primSetEdgeTransform: edgeTransform.
	self primSetClipRect: clipRect.
	self primSetColorTransform: colorTransform.
	self primSetDepth: self primGetDepth + 1. 

	postFlushNeeded := false.
	forms := #().

"	
-	self magicNumberPut: GWMagicNumber.
- 	self wbSizePut: size.
+	self wbTopPut: size.
+	self statePut: GEStateUnlocked.
-	self objStartPut: GWHeaderSize.
+	self objUsedPut: 4.	
-	self objectTypeOf: 0 put: GEPrimitiveFill.
-	self objectLengthOf: 0 put: 4.
-	self objectIndexOf: 0 put: 0.

	self getStartPut: 0.
	self getUsedPut: 0.
	self aetStartPut: 0.
	self aetUsedPut: 0.
	self stopReasonPut: 0.

+	self needsFlushPut: 0.
-	self clipMinXPut: 0.
-	self clipMaxXPut: 0.
-	self clipMinYPut: 0.
-	self clipMaxYPut: 0.
+	self currentZPut: 0.
	self resetGraphicsEngineStats.
	self initEdgeTransform.
	self initColorTransform.
"! !

!AthensBalloonEngine methodsFor: 'private' stamp: 'IgorStasenko 4/13/2011 12:15'!
prepareForRendering
	self fastReset! !

!AthensBalloonEngine methodsFor: 'drawing' stamp: 'IgorStasenko 4/21/2011 15:04'!
fillRectangle: rect 

	currentFill = 0 ifTrue: [ ^ self ]. "no fill "
	self primAddRectFrom: rect origin 
			to: rect corner
			fillIndex: currentFill
			borderWidth: 0
			borderColor: 0.

	self copyBits.
	! !

!AthensBalloonEngine methodsFor: 'private' stamp: 'IgorStasenko 9/14/2011 15:12'!
strokeBezierShape: contours width: aWidth

	contours do:[ :points |
		self primAddBezierShape: points
			segments: (points size // 3)
			fill: 0
			lineWidth: aWidth
			lineFill: currentFill.
			
		"Note: To avoid premature flushing of the pipeline we need to reset the flush bit within the engine."
		self primFlushNeeded: false.
	].

	self copyBits. 
! !

!AthensBalloonEngine methodsFor: 'drawing' stamp: 'IgorStasenko 4/1/2011 09:26'!
fillBezierShape: contours

	contours do:[ :points |
		self primAddBezierShape: points
			segments: (points size // 3)
			fill: currentFill
			lineWidth: 0
			lineFill: 0.
			
		"Note: To avoid premature flushing of the pipeline we need to reset the flush bit within the engine."
		self primFlushNeeded: false.
	].

	self copyBits.! !

!AthensBalloonEngine methodsFor: 'registering fills' stamp: 'IgorStasenko 4/1/2011 09:16'!
registerColorFill: aColor 

	currentFill := aColor scaledPixelValue32.
! !

!AthensBalloonEngine methodsFor: 'registering fills' stamp: 'NicolaiHess 6/24/2014 23:18'!
registerFormFill: form origin: orig direction: dir normal: norm tileFlag: tileFlag

	forms := forms copyWith: form.
	form unhibernate.
	currentFill := self primAddBitmapFill: form
			colormap: (form colormapIfNeededForDepth: 32)
			tile: tileFlag
			from: orig
			along: dir
			normal: norm
			xIndex: forms size.
			
! !

!AthensBalloonGradientPaint commentStamp: '<historical>'!
my subclasses used internally in balloon backend for Athens to represenet gradient paints.!
!AthensBalloonGradientPaint methodsFor: 'accessing' stamp: 'IgorStasenko 4/14/2011 16:27'!
colorRamp: anObject

	colorRamp := anObject! !

!AthensBalloonGradientPaint methodsFor: 'accessing' stamp: 'IgorStasenko 4/14/2011 16:27'!
colorRamp

	^ colorRamp! !

!AthensBalloonGradientPaint methodsFor: 'rendering' stamp: 'NicolaiHess 6/24/2014 22:46'!
strokeRect: aRectangle on: anAthensCanvas strokeWidth: strokeWidth
	self shouldBeImplemented.! !

!AthensBalloonGradientPaint methodsFor: 'rendering' stamp: 'IgorStasenko 9/19/2011 15:34'!
strokeRect: aRectangle on: anAthensCanvas stroke: anAthensBalloonStrokePaint 
	self shouldBeImplemented.! !

!AthensBalloonImagePaint commentStamp: '<historical>'!
i representing an image (form) paint  !
!AthensBalloonImagePaint methodsFor: 'accessing' stamp: 'IgorStasenko 4/21/2011 15:30'!
form

	^ form! !

!AthensBalloonImagePaint methodsFor: 'rendering' stamp: 'IgorStasenko 8/30/2013 16:32'!
athensFillPath: aPath on: anAthensCanvas

	anAthensCanvas surface engine
		prepareForRendering;
		registerFormFill: form origin: origin direction: direction normal: self normal;
		fillBezierShape: aPath contoursForFilling! !

!AthensBalloonImagePaint methodsFor: 'initialize' stamp: 'NicolaiHess 6/24/2014 23:17'!
initialize

	super initialize.

	direction := 0@0.
	form := nil.
	origin := 0@0.
	tileFlag := false.! !

!AthensBalloonImagePaint methodsFor: 'accessing' stamp: 'IgorStasenko 4/21/2011 15:45'!
direction

	^ direction! !

!AthensBalloonImagePaint methodsFor: 'accessing' stamp: 'IgorStasenko 4/21/2011 15:45'!
origin

	^ origin! !

!AthensBalloonImagePaint methodsFor: 'accessing' stamp: 'IgorStasenko 4/21/2011 15:45'!
direction: anObject

	direction := anObject! !

!AthensBalloonImagePaint methodsFor: 'accessing' stamp: 'NicolaiHess 6/24/2014 23:17'!
repeat
	tileFlag:=true! !

!AthensBalloonImagePaint methodsFor: 'accessing' stamp: 'IgorStasenko 4/21/2011 15:47'!
normal
	^ ((direction y negated @ direction x) *  form height / form width ) rounded! !

!AthensBalloonImagePaint methodsFor: 'rendering' stamp: 'NicolaiHess 6/24/2014 23:48'!
athensFillRectangle: aRect on: anAthensCanvas
	"This is a terminal method in rendering dispatch scheme
	canvas->shape->paint. See AthensCanvas>>fillShape: "
	|rotation normal|
	rotation := anAthensCanvas surface paintTransform transform: direction.
	normal := anAthensCanvas surface paintTransform transform:self normal.
	

	anAthensCanvas surface engine reset
		prepareForRendering;
		registerFormFill: form origin: origin direction: rotation normal: normal tileFlag: tileFlag;
		fillRectangle: aRect
! !

!AthensBalloonImagePaint methodsFor: 'accessing' stamp: 'IgorStasenko 4/21/2011 15:49'!
form: anObject

	form := anObject.
	origin := 0@0.
	direction := form extent x @0.! !

!AthensBalloonImagePaint methodsFor: 'accessing' stamp: 'IgorStasenko 4/21/2011 15:45'!
origin: anObject

	origin := anObject! !

!AthensBalloonLinearGradient commentStamp: '<historical>'!
i represent a linear gradient paint in balloon backend.!
!AthensBalloonLinearGradient methodsFor: 'rendering' stamp: 'IgorStasenko 3/8/2012 13:59'!
strokeRect: rect on: canvas stroke: strokePaint

	| torigin tcorner |

	"A gradient fill coordinates are first transformed by 
	paintTransform matrix,
	then
	by pathTransform matrix"
		
	torigin := canvas paintTransform transform: origin.
	tcorner :=  canvas paintTransform transform: corner.

	^ canvas surface engine
		prepareForRendering;
		registerLinearGradient: colorRamp origin: torigin corner: tcorner;
		strokeRectangle: rect width: strokePaint width! !

!AthensBalloonLinearGradient methodsFor: 'rendering' stamp: 'IgorStasenko 8/30/2013 16:32'!
athensFillPath: aPath on: anAthensCanvas
	| torigin tcorner |

	"A gradient fill coordinates are first transformed by 
	paintTransform matrix,
	then
	by pathTransform matrix"
		
	torigin := anAthensCanvas paintTransform transform: origin.
	tcorner :=  anAthensCanvas paintTransform transform: corner.

	^ anAthensCanvas surface engine
		prepareForRendering;
		registerLinearGradient: colorRamp origin: torigin corner: tcorner;
		fillBezierShape: aPath contoursForFilling! !

!AthensBalloonLinearGradient methodsFor: 'accessing' stamp: 'IgorStasenko 4/1/2011 10:47'!
corner

	^ corner! !

!AthensBalloonLinearGradient methodsFor: 'accessing' stamp: 'IgorStasenko 4/1/2011 10:47'!
origin

	^ origin! !

!AthensBalloonLinearGradient methodsFor: 'accessing' stamp: 'IgorStasenko 4/1/2011 10:47'!
corner: anObject

	corner := anObject! !

!AthensBalloonLinearGradient methodsFor: 'rendering' stamp: 'IgorStasenko 8/30/2013 16:35'!
athensFillRectangle: aRect on: anAthensCanvas
	"This is a terminal method in rendering dispatch scheme
	canvas->shape->paint. See AthensCanvas>>fillShape: "
	
	| torigin tcorner |

	"A gradient fill coordinates are first transformed by 
	paintTransform matrix,
	then
	by pathTransform matrix"
		
	torigin := anAthensCanvas paintTransform transform: origin.
	tcorner :=  anAthensCanvas paintTransform transform: corner.

	^ anAthensCanvas surface engine
		prepareForRendering;
		registerLinearGradient: colorRamp origin: torigin corner: tcorner;
		fillRectangle: aRect! !

!AthensBalloonLinearGradient methodsFor: 'rendering' stamp: 'NicolaiHess 6/24/2014 22:47'!
strokeRect: rect on: canvas strokeWidth: strokeWidth

	| torigin tcorner |

	"A gradient fill coordinates are first transformed by 
	paintTransform matrix,
	then
	by pathTransform matrix"
		
	torigin := canvas paintTransform transform: origin.
	tcorner :=  canvas paintTransform transform: corner.

	^ canvas surface engine
		prepareForRendering;
		registerLinearGradient: colorRamp origin: torigin corner: tcorner;
		strokeRectangle: rect width: strokeWidth! !

!AthensBalloonLinearGradient methodsFor: 'accessing' stamp: 'IgorStasenko 4/1/2011 10:47'!
origin: anObject

	origin := anObject! !

!AthensBalloonPaint commentStamp: '<historical>'!
i am an abstract root of many balloon-specific paints!
!AthensBalloonPaint methodsFor: 'converting' stamp: 'IgorStasenko 4/27/2012 11:18'!
asStrokePaintOn: aCanvas
	^ AthensBalloonStrokePaint new fillPaint: self! !

!AthensBalloonPaint methodsFor: 'converting' stamp: 'IgorStasenko 3/21/2012 19:11'!
asAthensPaintOn: surf
	^ self ! !

!AthensBalloonPath commentStamp: '<historical>'!
i represent a path shape in balloon backend!
!AthensBalloonPath methodsFor: 'converting' stamp: 'IgorStasenko 9/14/2011 15:08'!
contoursForStroke
	"answer a collection of contours, ready for stroking by balloon engine"
	^ contours collect: [:contour | contour asArray ]! !

!AthensBalloonPath methodsFor: 'private' stamp: 'IgorStasenko 3/27/2011 17:40'!
duplicateLastPoint

	contours last size < 2 ifFalse: [
		"duplicate last contour point"
		contours last add: (contours last last).
		]. 
! !

!AthensBalloonPath methodsFor: 'converting' stamp: 'IgorStasenko 3/27/2011 17:40'!
visitLineSegment: line
	self duplicateLastPoint.
	contours last add: line endPoint;
		add: line endPoint.! !

!AthensBalloonPath methodsFor: 'drawing' stamp: 'IgorStasenko 9/13/2011 16:21'!
paintStrokeUsing: paint on: anAthensCanvas 
	
	^ paint strokePath: self on: anAthensCanvas
! !

!AthensBalloonPath methodsFor: 'accessing' stamp: 'IgorStasenko 3/27/2011 00:23'!
contours
	
	^ contours! !

!AthensBalloonPath methodsFor: 'converting' stamp: 'IgorStasenko 3/29/2011 14:53'!
contoursForFilling
	"answer a collection of contours, ready for filling by balloon engine"
	^ contours collect: [:contour |
		contour last = contour first 
		ifTrue: [contour asArray] 
		ifFalse: [ (contour , { contour last. contour last. contour first }) ]
	]! !

!AthensBalloonPath methodsFor: 'converting' stamp: 'IgorStasenko 3/27/2011 00:05'!
visitMoveSegment: seg
	
	contours ifNil: [
		contours := OrderedCollection new ].
	
	contours add: OrderedCollection new.
	contours last add: seg endPoint.! !

!AthensBalloonPath methodsFor: 'converting' stamp: 'IgorStasenko 3/29/2011 14:55'!
convertFromBuilder: aBuilder
	| segment cContours |
	bounds := aBuilder pathBounds.
	segment := aBuilder pathStart.
	

	[ segment notNil ] whileTrue: [
		segment visitWith: self.
		segment := segment next ].
	
	" finally make all OrderedColllections ==> Array "
	cContours := Array new: contours size.
	1 to: cContours size do: [:i |
		cContours at: i put: (contours at: i) asArray.
		].
	contours := cContours.! !

!AthensBalloonPath methodsFor: 'converting' stamp: 'IgorStasenko 3/27/2011 17:40'!
visitQuadSegment: quadSegment

	self duplicateLastPoint.

	contours last add: quadSegment via;
		add: quadSegment to! !

!AthensBalloonPath methodsFor: 'drawing' stamp: 'IgorStasenko 8/30/2013 16:32'!
paintFillsUsing: aPaint on: anAthensCanvas 
	
	"This method is a part of rendering dispatch  Canvas->receiver->paint"
	
	^ aPaint athensFillPath: self on: anAthensCanvas! !

!AthensBalloonPath methodsFor: 'accessing' stamp: 'IgorStasenko 3/27/2011 13:54'!
numContours
	^ contours size! !

!AthensBalloonPath methodsFor: 'converting' stamp: 'IgorStasenko 3/27/2011 17:31'!
visitCloseSegment: closeSegment
	
	"see if its alredy closed"
	contours last last = contours last first ifFalse: [
		
		contours last 
			add: (contours last last);
			add: closeSegment endPoint;
			add: closeSegment endPoint
	]! !

!AthensBalloonRadialGradient commentStamp: '<historical>'!
i represent a radial gradient paint in balloon backend.!
!AthensBalloonRadialGradient methodsFor: 'accessing' stamp: 'IgorStasenko 4/14/2011 16:27'!
radius: anObject

	radius := anObject! !

!AthensBalloonRadialGradient methodsFor: 'rendering' stamp: 'IgorStasenko 8/30/2013 16:32'!
athensFillPath: aPath on: anAthensCanvas
	"This is a terminal method in rendering dispatch scheme
	canvas->shape->paint. See AthensCanvas>>fillShape: "
	
	| c |

	c := anAthensCanvas paintTransform transform: center.

	^ anAthensCanvas surface engine
		prepareForRendering;
		registerRadialGradient: colorRamp center: c radius: radius;
		fillBezierShape: aPath contoursForFilling
! !

!AthensBalloonRadialGradient methodsFor: 'accessing' stamp: 'IgorStasenko 4/14/2011 16:27'!
center: anObject

	center := anObject! !

!AthensBalloonRadialGradient methodsFor: 'accessing' stamp: 'IgorStasenko 4/14/2011 16:27'!
radius

	^ radius! !

!AthensBalloonRadialGradient methodsFor: 'rendering' stamp: 'IgorStasenko 8/30/2013 16:35'!
athensFillRectangle: aRect on: anAthensCanvas
	"This is a terminal method in rendering dispatch scheme
	canvas->shape->paint. See AthensCanvas>>fillShape: "
	
	| c dir n |

	c := anAthensCanvas paintTransform transform: center.
	dir :=  (radius@0).
	n := (0@radius).
	
	^ anAthensCanvas surface engine
		prepareForRendering;
		registerRadialGradient: colorRamp center: c direction: dir normal: n;
		fillRectangle: aRect! !

!AthensBalloonRadialGradient methodsFor: 'accessing' stamp: 'IgorStasenko 4/14/2011 16:27'!
center

	^ center! !

!AthensBalloonSolidColorPaint commentStamp: 'IgorStasenko 12/20/2011 15:27'!
maybe Color could act as a AthensPaint by itself by implementing a corresponding protocol!
!AthensBalloonSolidColorPaint methodsFor: 'rendering' stamp: 'IgorStasenko 9/14/2011 15:17'!
strokeRect: rect on: canvas stroke: strokePaint

	^ canvas surface strokeRectangle: rect color: color width: strokePaint width! !

!AthensBalloonSolidColorPaint methodsFor: 'rendering' stamp: 'IgorStasenko 8/30/2013 16:32'!
athensFillPath: athensBalloonPath on: anAthensCanvas 

	^ anAthensCanvas surface 
		fillBezierShape: athensBalloonPath contoursForFilling  
		color: color.
		! !

!AthensBalloonSolidColorPaint methodsFor: 'accessing' stamp: 'IgorStasenko 3/22/2011 21:59'!
color

	^ color! !

!AthensBalloonSolidColorPaint methodsFor: 'rendering' stamp: 'NicolaiHess 6/24/2014 22:51'!
strokePath: aPath on: anAthensCanvas strokeWidth: strokeWidth
	
	 anAthensCanvas surface 
		strokeBezierShape: aPath contoursForStroke
		color: color
		width: strokeWidth.
		! !

!AthensBalloonSolidColorPaint methodsFor: 'rendering' stamp: 'IgorStasenko 8/30/2013 16:35'!
athensFillRectangle: aRect on: canvas
	"This is a terminal method in rendering dispatch scheme
	canvas->shape->paint. See AthensCanvas>>fillShape: "
	

	^ canvas surface fillRectangle: aRect color: color! !

!AthensBalloonSolidColorPaint methodsFor: 'rendering' stamp: 'IgorStasenko 9/14/2011 15:10'!
strokePath: aPath on: anAthensCanvas stroke: strokePaint 
	
	 anAthensCanvas surface 
		strokeBezierShape: aPath contoursForStroke
		color: color
		width: strokePaint width.
		! !

!AthensBalloonSolidColorPaint methodsFor: 'as yet unclassified' stamp: 'NicolaiHess 6/24/2014 22:53'!
strokeRect: rect on: canvas strokeWidth: strokeWidth

	^ canvas surface strokeRectangle: rect color: color width: strokeWidth! !

!AthensBalloonSolidColorPaint methodsFor: 'accessing' stamp: 'IgorStasenko 3/22/2011 21:59'!
color: anObject

	color := anObject! !

!AthensBalloonStrokePaint commentStamp: '<historical>'!
i represent stroke paint for balloon backend!
!AthensBalloonStrokePaint methodsFor: 'rendering' stamp: 'NicolaiHess 6/24/2014 22:48'!
athensFillPath: aPath on: aCanvas

	^ fillPaint strokePath: aPath on: aCanvas strokeWidth: width
! !

!AthensBalloonStrokePaint methodsFor: 'setting cap styles' stamp: 'NicolaiHess 6/24/2014 22:38'!
capSquare
	self flag:#todo! !

!AthensBalloonStrokePaint methodsFor: 'setting join styles' stamp: 'NicolaiHess 6/24/2014 22:38'!
joinRound
	self flag:#todo! !

!AthensBalloonStrokePaint methodsFor: 'setting cap styles' stamp: 'NicolaiHess 6/24/2014 22:38'!
capRound
	self flag:#todo! !

!AthensBalloonStrokePaint methodsFor: 'rendering' stamp: 'NicolaiHess 6/24/2014 22:47'!
athensFillRectangle: aRect on: aCanvas

	^ fillPaint strokeRect: aRect on: aCanvas strokeWidth: width! !

!AthensBalloonStrokePaint methodsFor: 'setting cap styles' stamp: 'NicolaiHess 6/24/2014 22:37'!
capButt
	self flag:#todo! !

!AthensBalloonStrokePaint methodsFor: 'setting join styles' stamp: 'NicolaiHess 6/24/2014 22:38'!
joinMiter
	self flag:#todo! !

!AthensBalloonStrokePaint methodsFor: 'setting join styles' stamp: 'NicolaiHess 6/24/2014 22:38'!
joinBevel
	self flag:#todo! !

!AthensBalloonSurface commentStamp: '<historical>'!
I am concrete implementation of Athens surface which using balloon engine for rendering. !
!AthensBalloonSurface methodsFor: 'accessing matrices' stamp: 'IgorStasenko 3/26/2011 02:12'!
pathTransform

	^ pathTransform! !

!AthensBalloonSurface methodsFor: 'drawing' stamp: 'IgorStasenko 4/1/2011 09:24'!
fillRectangle: rect color: aColor

	engine
		prepareForRendering;
		registerColorFill: aColor	;
		fillRectangle: rect
! !

!AthensBalloonSurface methodsFor: 'converting' stamp: 'sig 2/29/2012 21:52'!
asForm
	^ form! !

!AthensBalloonSurface methodsFor: 'paints' stamp: 'IgorStasenko 4/14/2011 17:12'!
createCircularGradient: colorRamp center: aCenter radius: aRadius

	^ AthensBalloonRadialGradient new
		colorRamp: colorRamp;
		center: aCenter;
		radius: aRadius;
		yourself! !

!AthensBalloonSurface methodsFor: 'accessing matrices' stamp: 'IgorStasenko 10/17/2011 13:52'!
pathTransform: anObject

	pathTransform := anObject copy.
	engine edgeTransform: pathTransform.! !

!AthensBalloonSurface methodsFor: 'initialize-release' stamp: 'IgorStasenko 3/21/2012 19:12'!
initialize
	pathTransform := AthensAffineTransform new.
	paintTransform := AthensAffineTransform new.
	
	imageTransform := AthensAffineTransform new " AthensGenericTransform new".
	fillTransform := AthensAffineTransform new.
	strokeTransform := AthensAffineTransform new.
	maskEnabled := false.! !

!AthensBalloonSurface methodsFor: 'paints' stamp: 'NicolaiHess 6/24/2014 20:59'!
createLinearGradient: colorRamp start: pt1 stop: pt2
 
	^ AthensBalloonLinearGradient new
		colorRamp: colorRamp;
		origin: pt1;
		corner: pt2;
		yourself! !

!AthensBalloonSurface methodsFor: 'accessing' stamp: 'IgorStasenko 11/21/2011 16:33'!
clipRect
	^ engine clipRect! !

!AthensBalloonSurface methodsFor: 'paints' stamp: 'IgorStasenko 4/27/2012 11:22'!
createStrokePaintFor: aPaint

	^ AthensBalloonStrokePaint new fillPaint: aPaint! !

!AthensBalloonSurface methodsFor: 'accessing matrices' stamp: 'IgorStasenko 3/26/2011 02:12'!
strokeTransform

	^ strokeTransform! !

!AthensBalloonSurface methodsFor: 'masking' stamp: 'IgorStasenko 3/27/2011 18:16'!
enableMask
	maskEnabled := true! !

!AthensBalloonSurface methodsFor: 'drawing' stamp: 'IgorStasenko 9/14/2011 15:24'!
strokeRectangle: rect color: aColor width: aWidth
	 
	engine
		prepareForRendering;
		registerColorFill: aColor	;
		strokeRectangle: rect width: aWidth! !

!AthensBalloonSurface methodsFor: 'paths' stamp: 'IgorStasenko 4/18/2013 04:46'!
createPath: aPathCreatingBlock
	"Create a path from provided path builder instance"
	
	| builder |
	builder := AthensSimplePathBuilder new.
	aPathCreatingBlock value: builder.

	^ AthensBalloonPath new convertFromBuilder: builder.
	
	! !

!AthensBalloonSurface methodsFor: 'drawing' stamp: 'IgorStasenko 9/14/2011 15:08'!
fillBezierShape: anArray color: aColor width: aSmallInteger 
	self shouldBeImplemented.! !

!AthensBalloonSurface methodsFor: 'masking' stamp: 'IgorStasenko 3/27/2011 18:16'!
disableMask
	maskEnabled := false.! !

!AthensBalloonSurface methodsFor: 'testing' stamp: 'IgorStasenko 4/1/2011 09:36'!
clearForm

	form bits: ( Bitmap new: form bits size).
	! !

!AthensBalloonSurface methodsFor: 'drawing' stamp: 'IgorStasenko 4/1/2011 09:25'!
fillBezierShape: contours color: aColor 

	engine
		prepareForRendering;
		registerColorFill: aColor	;
		fillBezierShape: contours! !

!AthensBalloonSurface methodsFor: 'drawing' stamp: 'sig 2/29/2012 21:49'!
clear
	^ self clearForm! !

!AthensBalloonSurface methodsFor: 'accessing matrices' stamp: 'IgorStasenko 3/26/2011 02:12'!
fillTransform

	^ fillTransform! !

!AthensBalloonSurface methodsFor: 'paints' stamp: 'IgorStasenko 3/8/2012 13:48'!
createFormPaint: aForm  
	^ AthensBalloonImagePaint new
		form: aForm! !

!AthensBalloonSurface methodsFor: 'accessing' stamp: 'IgorStasenko 3/21/2011 15:10'!
form
	^ form! !

!AthensBalloonSurface methodsFor: 'converting' stamp: 'NicolaiHess 6/24/2014 22:56'!
asAthensPaintOn: aCanvas
	^ AthensBalloonImagePaint new form: self asForm; yourself! !

!AthensBalloonSurface methodsFor: 'paints' stamp: 'NicolaiHess 6/24/2014 21:00'!
createRadialGradient: colorRamp center: aCenter radius: aRadius focalPoint: fp
	^ self createCircularGradient: colorRamp center: aCenter radius: aRadius! !

!AthensBalloonSurface methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 6/24/2014 21:06'!
displayOnMorphicCanvas: canvas at: aPoint
	"display receiver on morphic canvas"
	canvas
		image: self asForm
		at: aPoint
		sourceRect: (0@0 extent: self asForm extent )
		rule: 34.! !

!AthensBalloonSurface methodsFor: 'rendering dispatch' stamp: 'NicolaiHess 6/24/2014 21:04'!
fillRectangle: aRectangle withSolidColor: aColor
	self fillRectangle: aRectangle color: aColor! !

!AthensBalloonSurface methodsFor: 'drawing' stamp: 'IgorStasenko 4/21/2011 16:35'!
drawImage: aForm 

	engine drawImage: aForm transform: imageTransform! !

!AthensBalloonSurface methodsFor: 'masking' stamp: 'IgorStasenko 3/27/2011 18:17'!
maskEnabled
	^ maskEnabled! !

!AthensBalloonSurface methodsFor: 'accessing' stamp: 'IgorStasenko 4/21/2011 16:17'!
form: aForm

	form := aForm.
	mask := Form extent: form extent depth: 1. 

	engine := AthensBalloonEngine new.
	engine bitBlt: (GrafPort toForm: form) .
	engine clipRect: (0@0 extent: form extent).
	engine edgeTransform: pathTransform.
	engine destOffset: 0@0.
	engine reset.! !

!AthensBalloonSurface methodsFor: 'paints' stamp: 'IgorStasenko 3/22/2011 21:59'!
createSolidColorPaint: aColor 
	^ AthensBalloonSolidColorPaint new color: aColor! !

!AthensBalloonSurface methodsFor: 'accessing matrices' stamp: 'IgorStasenko 3/26/2011 02:12'!
imageTransform

	^ imageTransform! !

!AthensBalloonSurface methodsFor: 'drawing' stamp: 'IgorStasenko 9/14/2011 15:12'!
strokeBezierShape: contours color: aColor width: aWidth 
	
	engine
		prepareForRendering;
		registerColorFill: aColor	;
		strokeBezierShape: contours width: aWidth! !

!AthensBalloonSurface methodsFor: 'rendering dispatch' stamp: 'NicolaiHess 6/24/2014 21:10'!
fillPath: aPath withSolidColor: aColor
	self fillBezierShape: aPath contoursForFilling color: aColor! !

!AthensBalloonSurface methodsFor: 'accessing' stamp: 'IgorStasenko 3/21/2012 19:12'!
paintTransform 
	^ paintTransform ! !

!AthensBalloonSurface methodsFor: 'accessing' stamp: 'IgorStasenko 3/27/2011 20:30'!
engine
	^ engine! !

!AthensBalloonSurface methodsFor: 'fonts' stamp: 'IgorStasenko 10/20/2011 10:03'!
getFreetypeFontRendererFor: aFreeTypeFont 
	
	^ (FT2GlyphRenderer forFont: aFreeTypeFont surface: self)! !

!AthensBalloonSurface methodsFor: 'accessing matrices' stamp: 'IgorStasenko 3/26/2011 02:12'!
fillTransform: anObject

	fillTransform := anObject! !

!AthensBalloonSurface methodsFor: 'accessing matrices' stamp: 'IgorStasenko 3/26/2011 02:12'!
strokeTransform: anObject

	strokeTransform := anObject! !

!AthensBalloonSurface methodsFor: 'clipping' stamp: 'NicolaiHess 6/24/2014 22:57'!
clipBy: aRectangle during: aBlock

	| oldRect transformedClip|
	transformedClip := (pathTransform transform:aRectangle origin) corner: (pathTransform transform:aRectangle corner).
	oldRect := engine clipRect.
	engine clipRect: (oldRect intersect: transformedClip).

	aBlock ensure: [ engine clipRect: oldRect ]! !

!AthensBalloonSurface class methodsFor: 'as yet unclassified' stamp: 'sig 2/29/2012 21:45'!
extent: aPoint
	"Create a new surface with given extent."
	
	^ self new form: (Form extent: aPoint depth: 32)! !

!AthensBalloonSurfaceExamples commentStamp: 'TorstenBergmann 2/12/2014 22:18'!
Athens example using Ballon as surface

 !
!AthensBalloonSurfaceExamples class methodsFor: 'instance creation' stamp: 'sig 2/29/2012 21:37'!
newSurface: extent
	
	^ AthensBalloonSurface extent: extent! !

!AthensBezier3Scene commentStamp: '<historical>'!
I just a helper class used to debug & visualize rendering of bezier segment. This class is subject of changes or complete removal!
!AthensBezier3Scene methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 5/2/2013 18:25'!
renderOn: canvas

	| path pathBlock polygonizedPath |
	
	canvas surface clear:  Color black.
	pathBlock :=  [ :builder |
		builder 
			absolute;
			moveTo: pt1;
			curveVia: pt2 and: pt3 to: pt4
	 ].
	

	"First , we draw the curve using Cairo"	
	(canvas setStrokePaint: Color green).
	canvas drawShape: (canvas createPath: pathBlock).
		
	"draw a polygon, connecting control points"
	(canvas setStrokePaint: Color blue) width: 0.5.
	canvas drawShape: (canvas createPath: [ :builder |
		builder 
			absolute;
			moveTo: pt1;
			lineTo: pt2;
			lineTo: pt3;
			lineTo: pt4
		 ]).
	
		
	
	canvas setPaint: Color red.
	
	path := AthensSimplePathBuilder createPath: pathBlock.
"	polygonizedPath := path asPolygon: canvas pathTransform. "
	
	canvas drawShape: (
		canvas createPath: [ :builder | | flattener |
			builder absolute.
	
		flattener := AthensCurveFlattener new dest: builder.
		flattener transform: (canvas pathTransform). 
		flattener convert:path. 
	]).! !

!AthensBezier3Scene methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 4/29/2013 21:51'!
curvePathBlock
	^ [ :builder |
		builder 
			absolute;
			moveTo: pt1;
			curveVia: pt2 and: pt3 to: pt4
	 ].
! !

!AthensBezier3Scene methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 4/26/2013 17:54'!
initFromArray: aControlPointsArray
	
		pt1 := aControlPointsArray at: 1.
		pt2 := aControlPointsArray at: 2.
		pt3 := aControlPointsArray at: 3.
		pt4 := aControlPointsArray at: 4.
! !

!AthensBezier3Scene class methodsFor: 'instance creation' stamp: 'IgorStasenko 4/26/2013 17:51'!
on: anControlPointArray

	^ self basicNew
		initFromArray: anControlPointArray! !

!AthensBezier3Scene class methodsFor: '*Athens-Morphic' stamp: 'IgorStasenko 4/26/2013 17:53'!
openViewOn: aControlPointsArray
	
	^ AthensSceneView new
		scene: 	(self on: aControlPointsArray );
		openInWindow! !

!AthensBezierConverter commentStamp: 'IgorStasenko 5/1/2011 21:50'!
I converting all bezier segments to a sequence of line segments, by approximating the curve along its path.

This classs is used for generating strokes.!
!AthensBezierConverter methodsFor: 'helpers' stamp: 'IgorStasenko 5/1/2011 21:45'!
angleBetween: p1 and: p2 ifDegenerate: aBlock

" Calculate an angle (in radians) between two vectors. 
Evaluate a block, in case if calculation not possible because one of the vectors has zero length "

	| x1 y1 x2 y2 dot2 n2 |
	x1 := p1 x.
	y1 := p1 y.
	x2 := p2 x.
	y2 := p2 y.
	
	dot2 := x1 * x2 + (y1 * y2).
	dot2 := dot2 * dot2.
	
	n2 := (x1*x1 + (y1*y1)) * (x2*x2 + (y2*y2)).
	
	n2 = 0 ifTrue: [ ^ aBlock value ].
	
	^ (dot2 / n2) arcCos! !

!AthensBezierConverter methodsFor: 'initialize-release' stamp: 'IgorStasenko 4/29/2011 18:11'!
initialize

	distanceTolerance := 0.5.
	angleTolerance := 0.1 . ! !

!AthensBezierConverter methodsFor: 'testing' stamp: 'IgorStasenko 4/29/2011 18:09'!
isFlatBezier2_x1: x1 y1: y1 x2: x2 y2: y2 x3: x3 y3: y3

	| dx dy d da angle |
	
	dx := x3-x1.
	dy := y3-y1.
	
 	d := (((x2 - x3) * dy) - ((y2 - y3) * dx)) abs.

	d > CollinearityEps ifTrue: [
		
		"regular case"

		d*d <= (distanceTolerance * ( dx*dx + (dy*dy))) ifTrue: [
			
			angleTolerance < CurveAngleTolerance ifTrue: [ ^ true ].
			
			angle := self angleBetween: x2-x1 @ (y2-y1) and: x3-x2 @ (y3-y2)
				ifDegenerate: [ 0.0 ].
			
			"parallel. no need to proceed further"
			angle <= angleTolerance ifTrue: [ ^ true ]					
		]
	]
	ifFalse: [ 
		"collinear"
		da := dx*dx + (dy*dy).
		
		da = 0 
			ifTrue: [ d := (x1-x2) squared + (y1-y2) squared ]
			ifFalse: [
				d = ((x2 - x1)*dx + ((y2 - y1)*dy)) / da.

				(d > 0.0 and: [ d < 1.0 ] ) ifTrue: [ 
					"Simple collinear case, 1---2---3" 
					^ true
     				].
				d <= 0.0 
					ifTrue: [ d := (x1-x2) squared + (y1-y2) squared ]
					ifFalse: [
						d >= 1.0 
							ifTrue: [ d:= (x2-x3) squared + (y2-y3) squared ]
							ifFalse: [ d:= (x2 - x1 - (d*dx)) squared + (y2 - y1 - (d*dy)) squared ]
					].
			].

			d < self distanceToleranceSquared ifTrue: [ ^ true ]		
	].

	^ false! !

!AthensBezierConverter methodsFor: 'converting path commands' stamp: 'IgorStasenko 5/1/2011 22:03'!
curveVia: pt1 to: pt2


	self	 recursiveBezier2_x1: endPoint x y1: endPoint y
		x2: pt1 x y2: pt1 y
		x3: pt2 x y3: pt2 y! !

!AthensBezierConverter methodsFor: 'helpers' stamp: 'IgorStasenko 5/1/2011 21:47'!
recursiveBezier2_x1: x1 y1: y1 x2: x2 y2: y2 x3: x3 y3: y3

	"recursively subdive bezier curve as long as #isFlatBezier2.. answers false "

	(self isFlatBezier2_x1: x1 y1: y1 x2: x2 y2: y2 x3: x3 y3: y3) ifTrue: [
		
		dest 
			lineTo: x2 @ y2;
			lineTo: x3 @ y3
	] ifFalse: [
		| x12 y12 x23 y23 x123 y123 |	
	"calculate midpoints of line segments "
		x12 := (x1 + x2) * 0.5.
		y12 := (y1 + y2) * 0.5 .

		x23 := (x2 + x3) * 0.5 .
		y23 := (y2 + y3) * 0.5 .

		x123 := (x12 + x23) * 0.5.
		y123 := (y12 + y23) * 0.5.
		
		self recursiveBezier2_x1: x1 y1: y1 
			x2: x12 
			y2: y12 
			x3: x123 
			y3: y123.
			
		self recursiveBezier2_x1: x123 
			y1: y123
			x2: x23
			y2: y23 
			x3: x3 
			y3: y3.
	]
! !

!AthensBezierConverter class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 4/29/2011 18:10'!
initialize

	CollinearityEps := 1e-30.
	DistanceEps := 1e-30.
	CurveAngleTolerance := 0.01.! !

!AthensBorderStrokePaint commentStamp: '<historical>'!
i am used to convert 
ComplexBorder (raised/inset) into paint, used in Morphic.!
!AthensBorderStrokePaint methodsFor: 'accessing' stamp: 'NicolaiHess 1/6/2015 22:26'!
width: aWidth
	width:= aWidth! !

!AthensBorderStrokePaint methodsFor: 'accessing' stamp: 'NicolaiHess 1/6/2015 22:26'!
width
	^ width! !

!AthensBorderStrokePaint methodsFor: 'private' stamp: 'NicolaiHess 1/6/2015 22:26'!
pathForTopLeftBorderOf: aRectangle on: anAthensCanvas
	^ anAthensCanvas
		createPath: [ :builder | 
			builder
				absolute;
				moveToX: aRectangle left Y: aRectangle bottom;
				lineToX: aRectangle left Y: aRectangle top;
				lineToX: aRectangle right Y: aRectangle top;
				lineToX: aRectangle right - width Y: aRectangle top + width;
				lineToX: aRectangle left + width Y: aRectangle top + width;
				lineToX: aRectangle left + width Y: aRectangle bottom - width;
				close ]! !

!AthensBorderStrokePaint methodsFor: 'accessing' stamp: 'NicolaiHess 1/6/2015 22:26'!
topLeftPaint: anAthensPaint
	topLeftPaint := anAthensPaint! !

!AthensBorderStrokePaint methodsFor: 'drawing' stamp: 'NicolaiHess 1/6/2015 22:26'!
asStrokePaintOn: aCanvas
	"receiver is stroke paint already"
	^ self! !

!AthensBorderStrokePaint methodsFor: 'private' stamp: 'NicolaiHess 1/6/2015 22:26'!
pathForBottomRightBorderOf: aRectangle on: anAthensCanvas
	^ anAthensCanvas
		createPath: [ :builder | 
			builder
				absolute;
				moveToX: aRectangle left Y: aRectangle bottom;
				lineToX: aRectangle right Y: aRectangle bottom;
				lineToX: aRectangle right Y: aRectangle top;
				lineToX: aRectangle right - width Y: aRectangle top + width;
				lineToX: aRectangle right - width Y: aRectangle bottom - width;
				lineToX: aRectangle left + width Y: aRectangle bottom - width;
				close ]! !

!AthensBorderStrokePaint methodsFor: 'drawing' stamp: 'NicolaiHess 1/6/2015 22:27'!
athensFillRectangle: aRect on: anAthensCanvas
	"This is a terminal method in rendering dispatch scheme
	canvas->shape->paint. See AthensCanvas>>fillShape: "

	topLeftPaint
		athensFillPath: (self pathForTopLeftBorderOf: (aRect expandBy: width/2.0) on: anAthensCanvas)
		on: anAthensCanvas.
	bottomRightPaint
		athensFillPath: (self pathForBottomRightBorderOf: (aRect expandBy: width/2.0) on: anAthensCanvas)
		on: anAthensCanvas! !

!AthensBorderStrokePaint methodsFor: 'accessing' stamp: 'NicolaiHess 1/6/2015 22:26'!
bottomRightPaint: anAthensPaint
	bottomRightPaint := anAthensPaint! !

!AthensBorderStrokePaint class methodsFor: 'instance creation' stamp: 'NicolaiHess 1/6/2015 22:27'!
topLeftColor: aColor1 bottomRightColor: aColor2 width: aNumber on: anAthensCanvas
	^ self new
		topLeftPaint: (aColor1 asAthensPaintOn: anAthensCanvas);
		bottomRightPaint: (aColor2 asAthensPaintOn: anAthensCanvas);
		width: aNumber;
		yourself! !

!AthensCCWArcSegment commentStamp: '<historical>'!
i represent a circular arc, connecting  
previous segment endpoint and my endpoing
of given angle, passing in counter-clockwise direction.!
!AthensCCWArcSegment methodsFor: 'visitor' stamp: 'IgorStasenko 4/18/2013 04:39'!
accept: aVisitor
	^ aVisitor ccwArcSegment: self! !

!AthensCCWArcSegment methodsFor: 'visitor' stamp: 'IgorStasenko 4/18/2013 05:21'!
sendCommandTo: aBuilder
	^ aBuilder ccwArcTo: endPoint angle: angle! !

!AthensCWArcSegment commentStamp: '<historical>'!
i represent a circular arc, connecting  
previous segment endpoint and my endpoing
of given angle, passing in clockwise direction.!
!AthensCWArcSegment methodsFor: 'visitor' stamp: 'IgorStasenko 4/18/2013 04:39'!
accept: aVisitor
	^ aVisitor cwArcSegment: self! !

!AthensCWArcSegment methodsFor: 'visitor' stamp: 'IgorStasenko 4/18/2013 05:21'!
sendCommandTo: aBuilder
	^ aBuilder cwArcTo: endPoint angle: angle! !

!AthensCairoCanvas commentStamp: 'IgorStasenko 12/20/2011 15:58'!
my instances representing a low-level cairo context and mapped to cairo_t * C type!
!AthensCairoCanvas methodsFor: 'initialize-release' stamp: 'IgorStasenko 10/11/2012 18:45'!
initializeWithSurface: anAthensSurface	
	super initializeWithSurface: anAthensSurface.
	self paintMode default.! !

!AthensCairoCanvas methodsFor: 'path segments visitor' stamp: 'FernandoOlivero 2/14/2012 08:16'!
visitCubicSegment: anAthensCubicSegment
	|  destination controlPoint controlPoint2 |
	destination := anAthensCubicSegment to.
	controlPoint := anAthensCubicSegment via1.
	controlPoint2 := anAthensCubicSegment via2.
	self
		curveToX: destination x Y: destination y
		viaX: controlPoint x Y: controlPoint y
		andX: controlPoint2 x Y: controlPoint2 y
		 		
! !

!AthensCairoCanvas methodsFor: 'accessing' stamp: 'IgorStasenko 12/20/2011 16:48'!
pathTransform
	^ pathTransform! !

!AthensCairoCanvas methodsFor: 'private' stamp: 'IgorStasenko 4/3/2013 06:23'!
primSetLineWidth: width
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	self nbCall: #(void cairo_set_line_width (
				self,
				double width) )
! !

!AthensCairoCanvas methodsFor: 'private' stamp: 'IgorStasenko 12/20/2011 16:05'!
rectangleX: x y: y width: aWidth height: aHeight
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCall: #(void cairo_rectangle (self,
		 double x, double y,
		 double aWidth, double aHeight) )
! !

!AthensCairoCanvas methodsFor: 'private' stamp: 'IgorStasenko 3/30/2012 17:59'!
primGetSource
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	self nbCall: #( cairo_pattern_t cairo_get_source ( self ) )! !

!AthensCairoCanvas methodsFor: 'accessing' stamp: 'IgorStasenko 9/2/2012 19:06'!
surface: aCairoSurface
	
	"initialize for given surface"
	surface := aCairoSurface.
	
	pathTransform := AthensCairoMatrix new.
	paintTransform := AthensCairoMatrix new.
	paintMode := AthensCairoPaintMode new canvas: self.
	
	self setAA: CAIRO_ANTIALIAS_SUBPIXEL.! !

!AthensCairoCanvas methodsFor: 'private' stamp: 'IgorStasenko 6/3/2012 04:02'!
primPaint
	"A drawing operator that paints the current source everywhere within the current clip region."
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #(void cairo_paint (self))
! !

!AthensCairoCanvas methodsFor: 'private' stamp: 'IgorStasenko 8/19/2013 15:04'!
showGlyphs: glyphs size: numGlyphs

	"A drawing operator that generates the shape from a string of UTF-8 characters, rendered according to the current font_face, font_size (font_matrix), and font_options. "
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #(
	
		void cairo_show_glyphs ( self ,
			void * glyphs,
			int numGlyphs) )
! !

!AthensCairoCanvas methodsFor: 'private' stamp: 'IgorStasenko 8/28/2012 13:56'!
showText: anUTF8String
	"A drawing operator that generates the shape from a string of UTF-8 characters, rendered according to the current font_face, font_size (font_matrix), and font_options. "
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #(void cairo_show_text (self, char * anUTF8String ))
! !

!AthensCairoCanvas methodsFor: 'path segments visitor' stamp: 'FernandoOlivero 2/14/2012 08:17'!
visitQuadSegment: anAthensCubicSegment
	| destination controlPoint |
	destination := anAthensCubicSegment to.
	controlPoint := anAthensCubicSegment via.
	self
		curveToX: destination x Y: destination y
		viaX: controlPoint x Y: controlPoint y
		 ! !

!AthensCairoCanvas methodsFor: 'private' stamp: 'IgorStasenko 9/1/2012 18:43'!
setPathMatrix: aMatrix
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCall: #(void cairo_set_matrix (self,
			AthensCairoMatrix * aMatrix) )
! !

!AthensCairoCanvas methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/22/2015 22:46'!
transformBy: aDisplayTransform withClip: aClipRectangle in: aSubRectangle during: aDrawBlock
	self
		clipBy: currentClipRect
		during: [ 
			| subClip oldClip |
			subClip := aDisplayTransform globalBoundsToLocal: aClipRectangle.
			oldClip := currentClipRect.
			currentClipRect := aDisplayTransform globalBoundsToLocal: self clipRect.
			pathTransform
				restoreAfter: [ 
					pathTransform translateBy: aDisplayTransform offset negated.
					pathTransform rotateByRadians: aDisplayTransform angle negated.
					pathTransform scaleBy: aDisplayTransform scale.
					self clipBy: subClip during: [ aDrawBlock value: self ] ].
			currentClipRect := oldClip ]! !

!AthensCairoCanvas methodsFor: 'private' stamp: 'IgorStasenko 9/1/2012 19:45'!
getCurrentPoint

	| x y |
	"since we use pointers to floats we must create a copy of original values to not scratch them"
	x := 0.0 shallowCopy.
	y := 0.0 shallowCopy.
	self primGetCurrentPointX: x Y: y.
	^ x @ y
! !

!AthensCairoCanvas methodsFor: 'private' stamp: 'IgorStasenko 12/20/2011 16:10'!
fill
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCall: #(void cairo_fill (self))
! !

!AthensCairoCanvas methodsFor: 'private' stamp: 'IgorStasenko 9/2/2012 22:18'!
setClipRect: aRectOrNil
	

	aRectOrNil 
		ifNil: [ self resetClip ]
		ifNotNil: [
			self newPath;
				rectangleX: aRectOrNil left
				y: aRectOrNil top
				width: aRectOrNil width
				height: aRectOrNil height;
				primClip
			]! !

!AthensCairoCanvas methodsFor: 'accessing' stamp: 'IgorStasenko 5/31/2012 01:47'!
handle
	^ handle value! !

!AthensCairoCanvas methodsFor: 'private' stamp: 'IgorStasenko 9/1/2012 19:44'!
primGetCurrentPointX: x Y: y

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self nbCall: #( void cairo_get_current_point (self, double * x, double * y))! !

!AthensCairoCanvas methodsFor: 'library path' stamp: 'IgorStasenko 12/20/2011 16:11'!
nbLibraryNameOrHandle
	^ self class nbLibraryNameOrHandle
! !

!AthensCairoCanvas methodsFor: 'private' stamp: 'IgorStasenko 5/31/2012 01:53'!
setPathMatrix
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCall: #(void cairo_set_matrix (self,
			AthensCairoMatrix * pathTransform) )
! !

!AthensCairoCanvas methodsFor: 'accessing' stamp: 'NicolaiHess 1/9/2015 21:50'!
clipRect
	^ currentClipRect ifNil: [ 0 @ 0 extent: self surface extent ]! !

!AthensCairoCanvas methodsFor: 'private' stamp: 'IgorStasenko 4/3/2013 06:23'!
primSetLineCap: capStyle
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCall: #(void cairo_set_line_cap (
			self,
			cairo_line_cap_t capStyle) )! !

!AthensCairoCanvas methodsFor: 'private' stamp: 'IgorStasenko 12/20/2011 16:17'!
setSourceR: red g: green b: blue a: alpha

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCall: #( 
		void cairo_set_source_rgba ( self ,
			double red,
			double green,
			double blue,
			double alpha) )! !

!AthensCairoCanvas methodsFor: 'private' stamp: 'IgorStasenko 9/3/2013 13:04'!
stroke
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCall: #(void cairo_stroke (self))
! !

!AthensCairoCanvas methodsFor: 'private' stamp: 'IgorStasenko 8/28/2012 14:01'!
setScaledFont: aFont
	"Replaces the current font face, font matrix, and font options in the cairo_t with those of the cairo_scaled_font_t. Except for some translation, the current CTM of the cairo_t should be the same as that of the cairo_scaled_font_t, which can be accessed using cairo_scaled_font_get_ctm().
 "
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #( void cairo_set_scaled_font (self , CairoScaledFont aFont))
! !

!AthensCairoCanvas methodsFor: 'private' stamp: 'IgorStasenko 9/1/2012 19:39'!
text: utf8String extents: extentsObj 
"cairo_text_extents ()

void                cairo_text_extents                  (cairo_t *cr,
                                                         const char *utf8,
                                                         cairo_text_extents_t *extents);
"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>

	^ self nbCall: #( void cairo_text_extents (self, char * utf8String, cairo_text_extents_t * extentsObj) )
	! !

!AthensCairoCanvas methodsFor: 'private' stamp: 'IgorStasenko 9/1/2012 22:45'!
setFontSize: aSize
	"
	void                cairo_set_font_size                 (cairo_t *cr,
                                                         double size);
	"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #( void cairo_set_font_size (self , double aSize ))
! !

!AthensCairoCanvas methodsFor: 'private' stamp: 'NicolaiHess 1/25/2015 23:00'!
setAA: antiAlias

	"cairo_set_antialias ()

void                cairo_set_antialias                 (cairo_t *cr,
                                                         cairo_antialias_t antialias);

Set the antialiasing mode of the rasterizer used for drawing shapes. This value is a hint, and a particular backend may or may not support a particular value. At the current time, no backend supports CAIRO_ANTIALIAS_SUBPIXEL when drawing shapes.

Note that this option does not affect text rendering, instead see cairo_font_options_set_antialias().

"
<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCall: #(void cairo_set_antialias (self, uint antiAlias))
! !

!AthensCairoCanvas methodsFor: 'path segments visitor' stamp: 'IgorStasenko 12/20/2011 18:49'!
visitLineSegment: line

	^ self lineToX: line endPoint x Y: line endPoint y! !

!AthensCairoCanvas methodsFor: 'private' stamp: 'IgorStasenko 12/20/2011 15:56'!
destroy

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #( 	void cairo_destroy (self) )! !

!AthensCairoCanvas methodsFor: 'path segments visitor' stamp: 'IgorStasenko 12/20/2011 18:46'!
visitMoveSegment: mov 
	^ self moveToX: mov endPoint x Y: mov endPoint y! !

!AthensCairoCanvas methodsFor: 'private' stamp: 'IgorStasenko 8/22/2013 13:51'!
setFontMatrix: aMatrix
	"
void                cairo_set_font_matrix               (cairo_t *cr,
                                                         const cairo_matrix_t *matrix);
	"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #( void cairo_set_font_matrix (self , AthensCairoMatrix  * aMatrix ))
! !

!AthensCairoCanvas methodsFor: 'drawing text' stamp: 'IgorStasenko 8/30/2013 16:14'!
setFont: aFont
	^ fontRenderer := aFont glyphRendererOn: surface.
	! !

!AthensCairoCanvas methodsFor: 'private' stamp: ''!
newPath
 
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #( void cairo_new_path ( self ) )! !

!AthensCairoCanvas methodsFor: 'private' stamp: 'IgorStasenko 3/8/2012 17:32'!
loadPath: aPath

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	 
	^ self nbCall: #( void cairo_append_path (self , AthensCairoPath aPath))
! !

!AthensCairoCanvas methodsFor: 'private' stamp: 'IgorStasenko 9/2/2012 20:55'!
primClip
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCall: #(void cairo_clip (self))
! !

!AthensCairoCanvas methodsFor: 'private' stamp: 'IgorStasenko 4/3/2013 05:55'!
resetDash
	self primResetDashes: 0.0! !

!AthensCairoCanvas methodsFor: 'drawing' stamp: 'IgorStasenko 10/11/2012 18:42'!
draw
	"Fill the shape (anObject) using currently selected paint
	an object should implement double-dispatch to currently selected paint"
	
	"set the trasformation matrix"
	self setPathMatrix.
	
	^ shape paintFillsUsing: paint on: self

! !

!AthensCairoCanvas methodsFor: 'accessing' stamp: ''!
paintTransform
	^ paintTransform
! !

!AthensCairoCanvas methodsFor: 'private' stamp: 'IgorStasenko 4/3/2013 05:42'!
primResetDashes: anOffset
"	void                cairo_set_dash                      (cairo_t *cr,
                                                         double *dashes,
                                                         int num_dashes,
                                                         double offset);"
<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	self nbCall: #(void cairo_set_dash (
				self,
				0,
				0,
				double anOffset) )
! !

!AthensCairoCanvas methodsFor: 'private' stamp: 'IgorStasenko 8/28/2012 18:19'!
moveToX: x Y: y
	" move command always starts a new contour "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #(void cairo_move_to (self, double x, double y ) )
! !

!AthensCairoCanvas methodsFor: 'private' stamp: 'IgorStasenko 4/3/2013 06:21'!
primSetLineJoin: joinStyle
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	self nbCall: #(void cairo_set_line_join (
			self,
			cairo_line_join_t joinStyle) )! !

!AthensCairoCanvas methodsFor: 'private' stamp: 'FernandoOlivero 1/17/2012 11:22'!
resetClip
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCall: #(void cairo_reset_clip (self))
! !

!AthensCairoCanvas methodsFor: 'path segments visitor' stamp: 'FernandoOlivero 1/15/2012 14:58'!
visitCloseSegment: closeSegment
	self closePath! !

!AthensCairoCanvas methodsFor: 'clipping' stamp: 'NicolaiHess 1/26/2015 20:29'!
clipBy: aRectangle during: aBlock
	| oldClip newClip |

	oldClip := currentClipRect.
	newClip := oldClip ifNil: [ aRectangle ] ifNotNil: [ oldClip intersect: aRectangle ifNone:[^ self] ]. 
	
	self setPathMatrix; resetClip; setClipRect: newClip.
	
	currentClipRect := newClip.

	[aBlock value] ensure: [ 
		self 
		setPathMatrix;
		resetClip;
		setClipRect: oldClip. 
		currentClipRect := oldClip. ].
	
! !

!AthensCairoCanvas class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 12/20/2011 15:45'!
asNBExternalType: gen
	"use handle ivar to hold my instance (cairo_t)"
	^ NBExternalObjectType objectClass: self! !

!AthensCairoCanvas class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 12/20/2011 16:14'!
on: cairoSurface

	^ (self primCreate: cairoSurface) surface: cairoSurface! !

!AthensCairoCanvas class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 12/20/2011 16:14'!
primCreate: cairoSurface

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #( 
		AthensCairoCanvas cairo_create (AthensCairoSurface cairoSurface) )! !

!AthensCairoCanvas class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 12/20/2011 16:12'!
nbLibraryNameOrHandle
	^ AthensCairoSurface nbLibraryNameOrHandle! !

!AthensCairoDefs commentStamp: 'TorstenBergmann 2/12/2014 22:22'!
I hold a lot of different constants needed to work with cairo library!
!AthensCairoDefs class methodsFor: 'as yet unclassified' stamp: ''!
initialize_cairo_status_t
"	typedef enum _cairo_status {"
    CAIRO_STATUS_SUCCESS := 0.

    CAIRO_STATUS_NO_MEMORY:=1.
    CAIRO_STATUS_INVALID_RESTORE:=2.
    CAIRO_STATUS_INVALID_POP_GROUP:=3.
    CAIRO_STATUS_NO_CURRENT_POINT:=4.
    CAIRO_STATUS_INVALID_MATRIX:=5.
    CAIRO_STATUS_INVALID_STATUS:=6.
    CAIRO_STATUS_NULL_POINTER:=7.
    CAIRO_STATUS_INVALID_STRING:=8.
    CAIRO_STATUS_INVALID_PATH_DATA:=9.
    CAIRO_STATUS_READ_ERROR:= 10.
    CAIRO_STATUS_WRITE_ERROR:=11.
    CAIRO_STATUS_SURFACE_FINISHED:=12.
    CAIRO_STATUS_SURFACE_TYPE_MISMATCH:=13.
    CAIRO_STATUS_PATTERN_TYPE_MISMATCH:=14.
    CAIRO_STATUS_INVALID_CONTENT:=15.
    CAIRO_STATUS_INVALID_FORMAT:=16.
    CAIRO_STATUS_INVALID_VISUAL:=17.
    CAIRO_STATUS_FILE_NOT_FOUND:=18.
    CAIRO_STATUS_INVALID_DASH:=19.
    CAIRO_STATUS_INVALID_DSC_COMMENT:=20.
    CAIRO_STATUS_INVALID_INDEX:=21.
    CAIRO_STATUS_CLIP_NOT_REPRESENTABLE:=22.
    CAIRO_STATUS_TEMP_FILE_ERROR:=23.
    CAIRO_STATUS_INVALID_STRIDE:=24.
    CAIRO_STATUS_FONT_TYPE_MISMATCH:=25.
    CAIRO_STATUS_USER_FONT_IMMUTABLE:=26.
    CAIRO_STATUS_USER_FONT_ERROR:=27.
    CAIRO_STATUS_NEGATIVE_COUNT:=28.
    CAIRO_STATUS_INVALID_CLUSTERS:=29.
    CAIRO_STATUS_INVALID_SLANT:=30.
    CAIRO_STATUS_INVALID_WEIGHT:=31.
    CAIRO_STATUS_INVALID_SIZE:=32.
    CAIRO_STATUS_USER_FONT_NOT_IMPLEMENTED:=33.
    CAIRO_STATUS_DEVICE_TYPE_MISMATCH:=34.
    CAIRO_STATUS_DEVICE_ERROR:=35.

    
! !

!AthensCairoDefs class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 9/2/2012 01:11'!
initialize_cairo_hint_style_t

"typedef enum { "
    CAIRO_HINT_STYLE_DEFAULT := 0.
    CAIRO_HINT_STYLE_NONE := 1.
    CAIRO_HINT_STYLE_SLIGHT := 2.
    CAIRO_HINT_STYLE_MEDIUM := 3.
    CAIRO_HINT_STYLE_FULL := 4.
"} cairo_hint_style_t; "

! !

!AthensCairoDefs class methodsFor: 'as yet unclassified' stamp: ''!
initialize_cairo_font_slant_t

	"typedef enum _cairo_font_slant {"
    CAIRO_FONT_SLANT_NORMAL := 0.
    CAIRO_FONT_SLANT_ITALIC := 1.
    CAIRO_FONT_SLANT_OBLIQUE := 2

! !

!AthensCairoDefs class methodsFor: 'as yet unclassified' stamp: ''!
initialize_cairo_font_type_t 
	"typedef enum _cairo_font_type {"
    CAIRO_FONT_TYPE_TOY := 0.
    CAIRO_FONT_TYPE_FT := 1.
    CAIRO_FONT_TYPE_WIN32 := 2.
    CAIRO_FONT_TYPE_QUARTZ := 3.
    CAIRO_FONT_TYPE_USER := 4.
	! !

!AthensCairoDefs class methodsFor: 'as yet unclassified' stamp: 'FernandoOlivero 4/19/2012 13:33'!
initialize_cairo_extend_t
"typedef enum {"
    CAIRO_EXTEND_NONE := 0 .
    CAIRO_EXTEND_REPEAT := 1.
    CAIRO_EXTEND_REFLECT :=2.
    CAIRO_EXTEND_PAD := 3.
"} cairo_extend_t"
! !

!AthensCairoDefs class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 9/2/2012 01:22'!
initialize_cairo_antialias_t

"typedef enum {"
    CAIRO_ANTIALIAS_DEFAULT := 0.

    " method "
    CAIRO_ANTIALIAS_NONE := 1.
    CAIRO_ANTIALIAS_GRAY := 2.
    CAIRO_ANTIALIAS_SUBPIXEL := 3.

    " hints "
    CAIRO_ANTIALIAS_FAST := 4.
    CAIRO_ANTIALIAS_GOOD := 5.
    CAIRO_ANTIALIAS_BEST := 6.
"} cairo_antialias_t; "
! !

!AthensCairoDefs class methodsFor: 'as yet unclassified' stamp: ''!
initialize_cairo_font_weight_t

	"typedef enum _cairo_font_weight {"
    CAIRO_FONT_WEIGHT_NORMAL := 0.
    CAIRO_FONT_WEIGHT_BOLD := 1.
! !

!AthensCairoDefs class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 9/1/2012 19:40'!
initialize_types
	
	cairo_status_t := cairo_font_type_t :=  cairo_line_join_t  := cairo_line_cap_t := cairo_status_t := cairo_font_slant_t := cairo_font_weight_t := cairo_operator_t  := #int.
	
	cairo_pattern_t := #AthensCairoPatternPaint.
	
	cairo_t := #AthensCairoCanvas.
	
	cairo_surface_t := #AthensCairoSurface .
	cairo_text_extents_t := #CairoTextExtents.! !

!AthensCairoDefs class methodsFor: 'as yet unclassified' stamp: ''!
initialize_cairo_operator_t 
"	typedef enum _cairo_operator {"
    CAIRO_OPERATOR_CLEAR := 0.

    CAIRO_OPERATOR_SOURCE:= 1.
    CAIRO_OPERATOR_OVER:= 2.
    CAIRO_OPERATOR_IN:= 3.
    CAIRO_OPERATOR_OUT:= 4.
    CAIRO_OPERATOR_ATOP:= 5.

    CAIRO_OPERATOR_DEST:= 6.
    CAIRO_OPERATOR_DEST_OVER:= 7.
    CAIRO_OPERATOR_DEST_IN:= 8.
    CAIRO_OPERATOR_DEST_OUT:= 9.
    CAIRO_OPERATOR_DEST_ATOP:= 10.

    CAIRO_OPERATOR_XOR:= 11.
    CAIRO_OPERATOR_ADD:= 12.
    CAIRO_OPERATOR_SATURATE:= 13.

    CAIRO_OPERATOR_MULTIPLY:= 14.
    CAIRO_OPERATOR_SCREEN:= 15.
    CAIRO_OPERATOR_OVERLAY:= 16.
    CAIRO_OPERATOR_DARKEN := 17.
    CAIRO_OPERATOR_LIGHTEN := 18.
    CAIRO_OPERATOR_COLOR_DODGE := 19.
    CAIRO_OPERATOR_COLOR_BURN := 20.
    CAIRO_OPERATOR_HARD_LIGHT := 21.
    CAIRO_OPERATOR_SOFT_LIGHT := 22.
    CAIRO_OPERATOR_DIFFERENCE := 23.
    CAIRO_OPERATOR_EXCLUSION := 24.
    CAIRO_OPERATOR_HSL_HUE := 25.
    CAIRO_OPERATOR_HSL_SATURATION := 26.
    CAIRO_OPERATOR_HSL_COLOR := 27.
    CAIRO_OPERATOR_HSL_LUMINOSITY := 28.
"} cairo_operator_t;"! !

!AthensCairoDefs class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/11/2013 18:32'!
initialize

	"
	self initialize
	"

	self
		initialize_types; 
		initialize_cairo_format_t;
		initialize_cairo_font_slant_t;
		initialize_cairo_font_weight_t;
		initialize_cairo_font_type_t ;
		initialize_cairo_operator_t ;
		initialize_cairo_line_cap_t ;
		initialize_cairo_line_join_t;
		initialize_cairo_status_t;
		initialize_cairo_extend_t;
		initialize_cairo_hint_style_t;
		initialize_cairo_antialias_t;
		init_cairo_subpixel_order_t;
		initialize_cairo_hint_metrics_t.
		
! !

!AthensCairoDefs class methodsFor: 'as yet unclassified' stamp: ''!
initialize_cairo_format_t

	"enum cairo_format_t"
	CAIRO_FORMAT_INVALID :=  -1.
	CAIRO_FORMAT_ARGB32 :=  0.
	CAIRO_FORMAT_RGB24 := 1.
	CAIRO_FORMAT_A8 := 2.
	CAIRO_FORMAT_A1 := 3.
	CAIRO_FORMAT_RGB16_565 := 4! !

!AthensCairoDefs class methodsFor: 'as yet unclassified' stamp: ''!
initialize_cairo_line_join_t
"	typedef enum _cairo_line_join {"
    CAIRO_LINE_JOIN_MITER := 0.
    CAIRO_LINE_JOIN_ROUND := 1.
    CAIRO_LINE_JOIN_BEVEL := 2.

! !

!AthensCairoDefs class methodsFor: 'as yet unclassified' stamp: ''!
initialize_cairo_line_cap_t 
	"typedef enum _cairo_line_cap { "
    CAIRO_LINE_CAP_BUTT := 0.
    CAIRO_LINE_CAP_ROUND := 1.
    CAIRO_LINE_CAP_SQUARE := 2.
! !

!AthensCairoDefs class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 9/2/2012 19:52'!
init_cairo_subpixel_order_t

"typedef enum {"
    CAIRO_SUBPIXEL_ORDER_DEFAULT := 0.
    CAIRO_SUBPIXEL_ORDER_RGB := 1.
    CAIRO_SUBPIXEL_ORDER_BGR := 2.
    CAIRO_SUBPIXEL_ORDER_VRGB := 3.
    CAIRO_SUBPIXEL_ORDER_VBGR := 4.
"} cairo_subpixel_order_t;"
! !

!AthensCairoDefs class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/11/2013 18:32'!
initialize_cairo_hint_metrics_t
"typedef enum {"
    CAIRO_HINT_METRICS_DEFAULT := 0.
    CAIRO_HINT_METRICS_OFF := 1.
    CAIRO_HINT_METRICS_ON := 2.
! !

!AthensCairoGradientPaint commentStamp: '<historical>'!
i used to represent gradient paints (both radial and linear)  in cairo backend!
!AthensCairoGradientPaint methodsFor: 'primitives' stamp: 'IgorStasenko 4/12/2013 10:21'!
primAddColorStopOffset: offset R: red G: green B: blue A: alpha 
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCall:#( void cairo_pattern_add_color_stop_rgba ( cairo_pattern_t  self,
					double offset,
					double red,
					double green,
					double blue,
					double alpha ))
		! !

!AthensCairoGradientPaint methodsFor: 'initialize-release' stamp: 'FernandoOlivero 4/19/2012 14:13'!
defaultExtend
"The default extend mode is CAIRO_EXTEND_NONE for surface patterns and CAIRO_EXTEND_PAD for gradient patterns.
"
	^  CAIRO_EXTEND_PAD! !

!AthensCairoGradientPaint methodsFor: 'private' stamp: 'IgorStasenko 4/12/2013 10:19'!
addColorStopAt: anOffset colored: aColor

	self
		primAddColorStopOffset: anOffset R: aColor red G: aColor green B: aColor blue A: aColor alpha
		! !

!AthensCairoGradientPaint methodsFor: 'private' stamp: 'IgorStasenko 4/12/2013 10:17'!
populateRamp: aRamp
	aRamp do: [ :each |
		self
			addColorStopAt: each key
			colored: each value ]
	! !

!AthensCairoGradientPaint methodsFor: 'initialize-release' stamp: 'FernandoOlivero 4/19/2012 13:56'!
initializeRadialBetween: origin
			extending: innerRadius
			and: outerOrigin
			extending: outerRadius
			withColorRamp: aRamp
			
	self initialize.		
	aRamp do:[:each|
		self
			addColorStopAt: each key
			colored: each value ]
	! !

!AthensCairoGradientPaint class methodsFor: 'primitives' stamp: 'IgorStasenko 4/12/2013 10:23'!
primCreateLinearX0: x0 y0: y0 x1: x1 y1: y1
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #(AthensCairoGradientPaint cairo_pattern_create_linear (
		double x0,
		double y0,
		double x1,
		double y1 ) )
! !

!AthensCairoGradientPaint class methodsFor: 'as yet unclassified' stamp: 'FernandoOlivero 4/19/2012 13:56'!
radialBetween: origin
	extending: innerRadius
	and: outerOrigin
	extending: outerRadius
	withColorRamp: colorRamp
	| paint |

	paint := self
		primCreateRadialXo: origin x 
		yo: origin y 
		radiuso: innerRadius 
		x1: outerOrigin x
		y1: outerOrigin y 
		radius1: outerRadius.
	paint
		initializeRadialBetween: origin
			extending: innerRadius
			and: outerOrigin
			extending: outerRadius
			withColorRamp: colorRamp.
	^ paint.! !

!AthensCairoGradientPaint class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 4/12/2013 10:25'!
createLinearGradient: aColorRamp start: aStartPoint stop: aStopPoint
	| paint |
	paint := self
		primCreateLinearX0: aStartPoint x asFloat
		y0: aStartPoint y asFloat
		x1: aStopPoint x asFloat
		y1: aStopPoint y asFloat.
	
	"note, we do #initialize here because instance was created by primitive"
	paint initialize; populateRamp: aColorRamp.
	^ paint
! !

!AthensCairoGradientPaint class methodsFor: 'primitives' stamp: 'FernandoOlivero 4/19/2012 13:55'!
primCreateRadialXo: xo yo: yo radiuso: radiuso x1: x1 y1: y1 radius1: radius1
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #(AthensCairoGradientPaint cairo_pattern_create_radial (
		double xo,
		double yo,
		double radiuso,
		double x1,
		double y1,
		double radius1 ) )
! !

!AthensCairoMatrix commentStamp: '<historical>'!
I implement an AthensAffineTransform interface.!
!AthensCairoMatrix methodsFor: 'transformations' stamp: 'IgorStasenko 5/31/2012 01:43'!
setScaleX: x Y: y

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self nbCall: #( void cairo_matrix_init_scale (AthensCairoMatrix * self, double  x, double  y))

! !

!AthensCairoMatrix methodsFor: 'transformations' stamp: ''!
clearTranslation
	"reset a translation from matrix, leaving only scale and rotation"
	
	self x: 0.
	self y: 0.! !

!AthensCairoMatrix methodsFor: 'private' stamp: 'IgorStasenko 8/14/2013 13:39'!
initx: x y: y sx: sx sy: sy shx: shx shy: shy

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self nbCall: #(
		void cairo_matrix_init (AthensCairoMatrix * self,
			double sx,
			double shy,
			double shx,
			double sy,
			double x,
			double y))

! !

!AthensCairoMatrix methodsFor: 'transformations' stamp: ''!
inverseTransform: aPoint 

	^ self inverted transform: aPoint! !

!AthensCairoMatrix methodsFor: 'private' stamp: 'jb 8/9/2013 16:16'!
copyFromMatrix: m

	NativeBoost memCopy: m address to: self address size: self class instanceSize.! !

!AthensCairoMatrix methodsFor: 'transformations' stamp: ''!
rotateByDegrees: angle


	^ self rotateByRadians: angle degreesToRadians! !

!AthensCairoMatrix methodsFor: 'initialize-release' stamp: ''!
initialize
	self loadIdentity.! !

!AthensCairoMatrix methodsFor: 'accessing' stamp: 'IgorStasenko 8/31/2012 22:31'!
getMatrix
	
	"Shall we answer an AthensAffineMatrix instead?
	
	^ AthensAffineMatrix new loadAffineTransform: self
	 "

	^ self copy! !

!AthensCairoMatrix methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ self class nbLibraryNameOrHandle
! !

!AthensCairoMatrix methodsFor: 'transformations' stamp: 'IgorStasenko 8/14/2013 13:38'!
loadAffineTransform: m
	self 
		initx: m x 
		y: m y 
		sx: m sx 
		sy: m sy 
		shx: m shx 
		shy: m shy! !

!AthensCairoMatrix methodsFor: 'transformations' stamp: 'IgorStasenko 3/28/2012 16:32'!
multiplyBy: anAthensAffineTransform
	
	self primMultiplyBy: (
		self class new loadAffineTransform: anAthensAffineTransform)! !

!AthensCairoMatrix methodsFor: 'transformations' stamp: ''!
transform: aPoint
	| x y |
	"since we use pointers to floats we must create a copy of original values to not scratch them"
	x := aPoint x asFloat shallowCopy.
	y := aPoint y asFloat shallowCopy.
	
	self primTransformX: x Y: y.
	^ x @ y! !

!AthensCairoMatrix methodsFor: 'private' stamp: 'IgorStasenko 5/31/2012 01:42'!
primLoadIdentity
	"initialize with identity transform"
	
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>

	^ self nbCall: #( void cairo_matrix_init_identity (AthensCairoMatrix * self ) )! !

!AthensCairoMatrix methodsFor: 'transformations' stamp: 'IgorStasenko 5/31/2012 01:57'!
primMultiplyBy: m
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>

	^self nbCall: #(void   cairo_matrix_multiply
		(AthensCairoMatrix * self,
		AthensCairoMatrix * m ,
		AthensCairoMatrix * self ) )

! !

!AthensCairoMatrix methodsFor: 'transformations' stamp: 'IgorStasenko 6/3/2012 04:07'!
restoreAfter: aBlock
	|previous|
	previous := self copy.
	aBlock ensure: [ 
		self copyFromMatrix: previous. "just copy the memory"
		"self loadAffineTransform: previous" ]! !

!AthensCairoMatrix methodsFor: 'private' stamp: 'IgorStasenko 5/31/2012 01:42'!
primTransformX: x Y: y

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self nbCall: #( void cairo_matrix_transform_point (AthensCairoMatrix *  self, double * x, double * y))

! !

!AthensCairoMatrix methodsFor: 'transformations' stamp: 'IgorStasenko 5/31/2012 01:43'!
setTranslateX: x Y: y

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self nbCall: #( void cairo_matrix_init_translate (AthensCairoMatrix * self, double  x, double  y))

! !

!AthensCairoMatrix methodsFor: 'transformations' stamp: ''!
translateBy: aPoint
	self translateX: aPoint x Y: aPoint y
! !

!AthensCairoMatrix methodsFor: 'transformations' stamp: 'FernandoOlivero 4/21/2012 02:35'!
inverted
 	| m |
	m := self copy.
	m invert.
	^ m! !

!AthensCairoMatrix methodsFor: 'transformations' stamp: 'IgorStasenko 5/31/2012 01:41'!
invert

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self nbCall: #( cairo_status_t cairo_matrix_invert (AthensCairoMatrix *  self))

! !

!AthensCairoMatrix methodsFor: 'transformations' stamp: 'IgorStasenko 5/31/2012 01:43'!
scaleX: fx Y: fy

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self nbCall: #(
		void cairo_matrix_scale (AthensCairoMatrix * self,
                                                         double fx,
                                                         double fy))

! !

!AthensCairoMatrix methodsFor: 'transformations' stamp: 'FernandoOlivero 3/22/2012 13:35'!
scaleBy: factor

	"if factor is number, do a uniform scale, 
	if not, then factor is assument to be an instance of Point containing non-uniform scale for each axis"
	factor isPoint 
		ifTrue: [ self scaleX: factor x asFloat Y: factor y asFloat ] 
		ifFalse: [ self scaleX: factor asFloat Y: factor asFloat ]
! !

!AthensCairoMatrix methodsFor: 'transformations' stamp: 'IgorStasenko 5/31/2012 01:43'!
setRotationInRadians: radians

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self nbCall: #( void cairo_matrix_init_rotate (AthensCairoMatrix * self, double  radians))

! !

!AthensCairoMatrix methodsFor: 'transformations' stamp: 'IgorStasenko 5/31/2012 01:43'!
rotateByRadians: angle

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self nbCall: #(
		void cairo_matrix_rotate (AthensCairoMatrix *  self,
                                                         double angle))

! !

!AthensCairoMatrix methodsFor: 'transformations' stamp: 'IgorStasenko 5/31/2012 01:44'!
translateX: px Y: py

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self nbCall: #(
		void cairo_matrix_translate (AthensCairoMatrix * self,
                                                         double px,
                                                         double py))

! !

!AthensCairoMatrix methodsFor: 'transformations' stamp: ''!
loadIdentity
	"initialize with identity transform"
	
	self primLoadIdentity ! !

!AthensCairoMatrix class methodsFor: 'as yet unclassified' stamp: ''!
fieldsDesc
	^ #(
   double sx; double shx;
   double shy; double sy;
   double x; double y;	
	)! !

!AthensCairoMatrix class methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ CairoLibraryLoader getLibraryHandle! !

!AthensCairoPDFSurface commentStamp: '<historical>'!
i am a concrete implementation of Athens surface which using cairo graphics library for rendering for generating PDF files
as output.

<currently it is not functional and need more testing and coding>!
!AthensCairoPDFSurface methodsFor: 'private' stamp: 'IgorStasenko 5/4/2012 18:29'!
showPage

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #( void cairo_surface_show_page (self) )! !

!AthensCairoPDFSurface methodsFor: 'initialize-release' stamp: 'IgorStasenko 5/4/2012 18:15'!
resourceData
	^ handle value ! !

!AthensCairoPDFSurface methodsFor: 'private' stamp: 'IgorStasenko 5/4/2012 18:22'!
newCanvas

	^ self primCreateCanvas surface: self! !

!AthensCairoPDFSurface class methodsFor: 'private' stamp: 'IgorStasenko 5/4/2012 18:12'!
createPDF: fileName width: width_in_points height: height_in_points

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #(AthensCairoPDFSurface cairo_pdf_surface_create (String fileName,
                                                      double width_in_points,
                                                      double height_in_points) )
! !

!AthensCairoPDFSurface class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 5/4/2012 18:14'!
registerSurface: surface
	"do not register my instances with SurfacePlugin"! !

!AthensCairoPDFSurface class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 5/4/2012 18:13'!
extent: anExtent fileName: fileName

	^ (self createPDF: fileName width: anExtent x height: anExtent y) initialize! !

!AthensCairoPDFSurface class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 5/4/2012 18:34'!
finalizeResourceData: handle

	self destroySurfaceHandle: handle.
! !

!AthensCairoPaintMode commentStamp: '<historical>'!
I control the paint modes supported by Cairo backend.

for the list and description of paint modes supported by Cairo library, see
http://cairographics.org/operators/!
!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 16:01'!
dest
	"Set 'dest' drawing mode.
	
	Drawing under this mode will ignore the source, as if nothing drawn"
		
	^ self setOperator: CAIRO_OPERATOR_DEST! !

!AthensCairoPaintMode methodsFor: 'private' stamp: 'IgorStasenko 9/1/2012 15:40'!
getOperator
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #(
		cairo_operator_t cairo_get_operator (AthensCairoCanvas canvas) )
! !

!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:11'!
atop
	
	^ self setOperator: CAIRO_OPERATOR_ATOP! !

!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:11'!
destOver
	
	^ self setOperator: CAIRO_OPERATOR_DEST_OVER! !

!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 16:01'!
over
	"Set 'over' drawing mode. This is default paint mode.
	
	Drawing under this mode will blend source with destination color using source alpha component"
			
	^ self setOperator: CAIRO_OPERATOR_OVER! !

!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:11'!
in
	
	^ self setOperator: CAIRO_OPERATOR_IN! !

!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:12'!
destAtop
	
	^ self setOperator: CAIRO_OPERATOR_DEST_ATOP! !

!AthensCairoPaintMode methodsFor: 'initialize-release' stamp: 'IgorStasenko 9/1/2012 15:32'!
canvas: aCanvas
	canvas := aCanvas! !

!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:13'!
multiply
	
	^ self setOperator: CAIRO_OPERATOR_MULTIPLY! !

!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:11'!
out
	
	^ self setOperator: CAIRO_OPERATOR_OUT! !

!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:13'!
overlay
	
	^ self setOperator: CAIRO_OPERATOR_OVERLAY! !

!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 16:01'!
source
	"Set 'source' drawing mode.
	
	Drawing under this mode will replace the content with incoming source under the shape boundaries"
	
	^ self setOperator: CAIRO_OPERATOR_SOURCE! !

!AthensCairoPaintMode methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ self class nbLibraryNameOrHandle
! !

!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:15'!
hslSaturation
	
	^ self setOperator: CAIRO_OPERATOR_HSL_SATURATION! !

!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:12'!
destOut
	
	^ self setOperator: CAIRO_OPERATOR_DEST_OUT! !

!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:15'!
hslColor
	
	^ self setOperator: CAIRO_OPERATOR_HSL_COLOR! !

!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 16:00'!
clear
	"Set 'clear' drawing mode.
	
	Drawing under this mode will clear the surface under the shape boundaries"
	
	^ self setOperator: CAIRO_OPERATOR_CLEAR! !

!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:13'!
screen
	
	^ self setOperator: CAIRO_OPERATOR_SCREEN! !

!AthensCairoPaintMode methodsFor: 'private' stamp: 'IgorStasenko 9/1/2012 15:37'!
setOperator: aCairoOperatorT
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #(void cairo_set_operator (AthensCairoCanvas canvas, cairo_operator_t aCairoOperatorT) )
! !

!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:14'!
colorBurn
	
	^ self setOperator: CAIRO_OPERATOR_COLOR_BURN! !

!AthensCairoPaintMode methodsFor: 'convenience' stamp: 'IgorStasenko 9/1/2012 15:36'!
restoreAfter: aBlock
	| op |
	op := self getOperator.
	
	aBlock ensure: [ self setOperator: op ]! !

!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:13'!
darken
	
	^ self setOperator: CAIRO_OPERATOR_DARKEN! !

!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:15'!
difference
	
	^ self setOperator: CAIRO_OPERATOR_DIFFERENCE! !

!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:12'!
add
	
	^ self setOperator: CAIRO_OPERATOR_ADD! !

!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:14'!
colorDodge
	
	^ self setOperator: CAIRO_OPERATOR_COLOR_DODGE! !

!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:12'!
destIn
	
	^ self setOperator: CAIRO_OPERATOR_DEST_IN! !

!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:16'!
hslLuminosity
	
	^ self setOperator: CAIRO_OPERATOR_HSL_LUMINOSITY! !

!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:14'!
lighten
	
	^ self setOperator: CAIRO_OPERATOR_LIGHTEN! !

!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:12'!
xor
	
	^ self setOperator: CAIRO_OPERATOR_XOR! !

!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:14'!
softLight
	
	^ self setOperator: CAIRO_OPERATOR_SOFT_LIGHT! !

!AthensCairoPaintMode methodsFor: 'capabilities' stamp: 'IgorStasenko 9/1/2012 17:18'!
availableModes

	^ #(
		clear
		source
		over
		in
		out 
		atop
		dest
		destOver
		destIn
		destOut
		destAtop
		xor
		add
		saturate
		multiply
		screen
		overlay
		darken
		lighten
		colorDodge
		colorBurn
		hardLight
		softLight
		difference
		exclusion
		hslHue
		hslSaturation
		hslColor
		hslLuminosity
	)! !

!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:13'!
saturate
	
	^ self setOperator: CAIRO_OPERATOR_SATURATE! !

!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:15'!
hslHue
	
	^ self setOperator: CAIRO_OPERATOR_HSL_HUE! !

!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:14'!
hardLight
	
	^ self setOperator: CAIRO_OPERATOR_HARD_LIGHT! !

!AthensCairoPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:15'!
exclusion
	
	^ self setOperator: CAIRO_OPERATOR_EXCLUSION! !

!AthensCairoPaintMode class methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ CairoLibraryLoader getLibraryHandle! !

!AthensCairoPath commentStamp: '<historical>'!
i used to hold shapes built by path builder in cairo backend!
!AthensCairoPath methodsFor: 'instance creation' stamp: 'FernandoOlivero 3/28/2012 19:12'!
primDestroyPath: aHandle

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #(void cairo_path_destroy ( ulong aHandle ))
! !

!AthensCairoPath methodsFor: 'initialize-release' stamp: 'FernandoOlivero 3/28/2012 19:10'!
initialize 
	handle value = 0 ifTrue: [ 
		self error: 'Error creating new path' ].

	NBExternalResourceManager addResource: self data: handle! !

!AthensCairoPath methodsFor: 'drawing' stamp: 'IgorStasenko 8/30/2013 16:32'!
paintFillsUsing: aPaint on: anAthensCanvas 
	
	"This method is a part of rendering dispatch  Canvas->receiver->paint"
	
	^ aPaint athensFillPath: self on: anAthensCanvas! !

!AthensCairoPath methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ self class nbLibraryNameOrHandle
! !

!AthensCairoPath methodsFor: 'converting' stamp: 'IgorStasenko 5/6/2013 05:44'!
asAthensShapeOn: anAthensCanvas 
	
	^ self! !

!AthensCairoPath class methodsFor: 'instance creation' stamp: ''!
primDestroyPath: aHandle

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #(void cairo_path_destroy ( ulong aHandle ))
! !

!AthensCairoPath class methodsFor: 'instance creation' stamp: ''!
finalizeResourceData: aHandle

	self primDestroyPath: aHandle value ! !

!AthensCairoPath class methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ CairoLibraryLoader getLibraryHandle! !

!AthensCairoPathBuilder commentStamp: '<historical>'!
i implement cairo-specific path builder. see my superclass for more details.!
!AthensCairoPathBuilder methodsFor: 'path commands' stamp: 'JochenRick 1/8/2014 08:24'!
lineTo: aPoint

	endPoint := self toAbsolute: aPoint.
	lastControlPoint := nil.
	^ self lineToX: endPoint x asFloat Y: endPoint y asFloat! !

!AthensCairoPathBuilder methodsFor: 'path commands' stamp: 'JochenRick 1/7/2014 19:14'!
hLineTo: x
	^ self lineTo: (absolute ifTrue: [ x @ endPoint y] ifFalse: [ x @ 0 ])! !

!AthensCairoPathBuilder methodsFor: 'path commands' stamp: 'JochenRick 1/8/2014 08:23'!
close

	self closePath.
	
	endPoint := self getCurrentPoint.
	lastControlPoint := nil! !

!AthensCairoPathBuilder methodsFor: 'path commands' stamp: 'JochenRick 1/8/2014 08:28'!
reflectedCurveVia: p2 to: aPoint
	|  pt1 |

	pt1 := lastControlPoint
		ifNil: [ endPoint ]
		ifNotNil: [ endPoint * 2 - lastControlPoint].
	lastControlPoint := self toAbsolute: p2.
	endPoint := self toAbsolute: aPoint.

	self curveViaX: pt1 x Y: pt1 y viaX: lastControlPoint x Y: lastControlPoint y toX: endPoint x Y: endPoint y
! !

!AthensCairoPathBuilder methodsFor: 'private' stamp: 'IgorStasenko 9/3/2012 02:40'!
getCurrentPoint
	^ context getCurrentPoint! !

!AthensCairoPathBuilder methodsFor: 'path commands' stamp: 'JochenRick 1/8/2014 08:25'!
curveVia: p1 and: p2 to: aPoint
	|  pt1 |

	pt1 := self toAbsolute: p1.
	lastControlPoint := self toAbsolute: p2.
	endPoint := self toAbsolute: aPoint.

	self curveViaX: pt1 x Y: pt1 y viaX: lastControlPoint x Y: lastControlPoint y toX: endPoint x Y: endPoint y
! !

!AthensCairoPathBuilder methodsFor: 'private' stamp: 'IgorStasenko 3/8/2012 16:47'!
arcCenterX: xc centerY: yc radius: radius startAngle: angle1 endAngle: angle2 
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	self nbCall: #(void cairo_arc (AthensCairoCanvas context,
				double xc,
				double yc,
				double radius,
				double angle1,
				double angle2) )
				
			! !

!AthensCairoPathBuilder methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ self class nbLibraryNameOrHandle
! !

!AthensCairoPathBuilder methodsFor: 'private' stamp: 'FernandoOlivero 3/9/2012 14:43'!
closePath
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	self nbCall: #(void cairo_close_path (AthensCairoCanvas context))! !

!AthensCairoPathBuilder methodsFor: 'path commands' stamp: 'IgorStasenko 3/7/2012 16:45'!
relative
	absolute := false! !

!AthensCairoPathBuilder methodsFor: 'path commands' stamp: 'IgorStasenko 3/7/2012 16:45'!
absolute
	absolute := true! !

!AthensCairoPathBuilder methodsFor: 'accessing' stamp: 'IgorStasenko 3/7/2012 17:15'!
createPath: aBlock
	
	self newPath.
	"set default to relative"
	absolute := false.
	endPoint := ZeroPoint.
	
	"set the implicit path origin"
	self moveToX: 0 Y: 0.
		
	aBlock value: self.
	
	^ self copyPath initialize ! !

!AthensCairoPathBuilder methodsFor: 'path commands' stamp: 'IgorStasenko 3/8/2012 17:06'!
ccwArcTo: newEndPoint angle: angle
	" Add a counter-clockwise arc segment, starting from current path endpoint and
	ending at andPt. Angle should be specified in radians 
	"
	^ self arcTo: newEndPoint angle: angle cw: false! !

!AthensCairoPathBuilder methodsFor: 'private' stamp: 'IgorStasenko 3/8/2012 16:54'!
calcCenter: start end: end angle: angle

	| v  rot  center radius len sina cosa m |	

	v := end - start.
	
	m := AthensAffineTransform new rotateByRadians: (Float pi - angle   /2).

	v := m transform: v.		
	len := v r.
	radius := len / 2 / (angle /2) sin.
	
	center := v * (radius/len) + start.

	^ center! !

!AthensCairoPathBuilder methodsFor: 'path commands' stamp: 'IgorStasenko 3/7/2012 16:20'!
toAbsolute: aPoint

	^ absolute ifTrue: [ aPoint ] ifFalse: [ endPoint + aPoint ]! !

!AthensCairoPathBuilder methodsFor: 'path commands' stamp: 'JochenRick 1/7/2014 19:14'!
vLineTo: y
	^ self lineTo: (absolute ifTrue: [ endPoint x @ y] ifFalse: [ 0 @ y ])! !

!AthensCairoPathBuilder methodsFor: 'accessing' stamp: 'IgorStasenko 3/7/2012 15:15'!
context: anObject

	context := anObject! !

!AthensCairoPathBuilder methodsFor: 'path commands' stamp: 'JochenRick 1/8/2014 08:24'!
curveVia: p1 to: aPoint
	| pt0 pt1 cp1 cp2 twoThirds |
	"Quad bezier curve"

	pt0 := endPoint.
	pt1 := self toAbsolute: p1.
	endPoint := self toAbsolute: aPoint.
	lastControlPoint := nil.
	
"Any quadratic spline can be expressed as a cubic (where the cubic term is zero). The end points of the cubic will be the same as the quadratic's.

	CP0 = QP0
	CP3 = QP2

The two control points for the cubic are:

	CP1 = QP0 + 2/3 *(QP1-QP0)
	CP2 = QP2 + 2/3 *(QP1-QP2)"

	twoThirds := (2/3) asFloat.

	cp1 := pt1 - pt0 * twoThirds + pt0.
	cp2 := pt1 - endPoint * twoThirds + endPoint.
	
	self curveViaX: cp1 x Y: cp1 y viaX: cp2 x Y: cp2 y toX: endPoint x Y: endPoint y
! !

!AthensCairoPathBuilder methodsFor: 'private' stamp: 'IgorStasenko 3/8/2012 16:36'!
angleOfVector: v

	| n acos |
	
	n := v normalized.
	acos := n x arcCos.
	
	^ v y < 0 ifTrue: [ Float pi * 2 - acos ] ifFalse: [ acos ]! !

!AthensCairoPathBuilder methodsFor: 'private' stamp: 'IgorStasenko 3/7/2012 16:04'!
newPath
 
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #( void cairo_new_path ( AthensCairoCanvas context ) )! !

!AthensCairoPathBuilder methodsFor: 'path commands' stamp: 'JochenRick 1/8/2014 08:24'!
moveTo: aPoint
	
	endPoint := self toAbsolute: aPoint.
	lastControlPoint := nil.
	
	^ self moveToX: endPoint x asFloat Y: endPoint y asFloat ! !

!AthensCairoPathBuilder methodsFor: 'private' stamp: 'IgorStasenko 3/7/2012 17:39'!
curveViaX: x1 Y: y1 viaX: x2 Y: y2 toX: x3 Y: y3
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #(void cairo_curve_to(AthensCairoCanvas context,
                                                         double x1,
                                                         double y1,
                                                         double x2,
                                                         double y2,
                                                         double x3,
                                                         double y3))

! !

!AthensCairoPathBuilder methodsFor: 'path commands' stamp: 'IgorStasenko 3/8/2012 17:05'!
cwArcTo: newEndPoint angle: angle
	" Add a clockwise arc segment, starting from current path endpoint and
	ending at andPt. Angle should be specified in radians 
	"
	^ self arcTo: newEndPoint angle: angle cw: true! !

!AthensCairoPathBuilder methodsFor: 'private' stamp: 'IgorStasenko 3/7/2012 16:08'!
lineToX: x Y: y

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #(void cairo_line_to (AthensCairoCanvas context,
		 double x, double y ) )
! !

!AthensCairoPathBuilder methodsFor: 'private' stamp: 'IgorStasenko 3/8/2012 17:01'!
arcNegativeCenterX: xc centerY: yc radius: radius startAngle: angle1 endAngle: angle2 
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	self nbCall: #(void cairo_arc_negative (AthensCairoCanvas context,
				double xc,
				double yc,
				double radius,
				double angle1,
				double angle2) )
				
			! !

!AthensCairoPathBuilder methodsFor: 'private' stamp: 'IgorStasenko 3/7/2012 16:47'!
copyPath 


	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #( AthensCairoPath cairo_copy_path (AthensCairoCanvas context) )
! !

!AthensCairoPathBuilder methodsFor: 'private' stamp: 'JochenRick 1/8/2014 08:23'!
arcTo: newEndPoint angle: angle cw: aBool

	" Add a clockwise arc segment, starting from current path endpoint and
	ending at andPt. Angle should be specified in radians 
	"

	| start end center v radius startAngle endAngle cwAngle |	
	lastControlPoint := nil.
	angle isZero ifTrue: [ ^ self lineTo: newEndPoint ].
	 
	start := endPoint.
	endPoint := end := self toAbsolute: newEndPoint.
	
	start = end ifTrue: [ ^ self ].

	"we have to transform the input. because Cario expects 
	the center , radius, starting and ending angle,
	and we have the starting point, the ending point , and the angle.
	"
	aBool ifTrue: [cwAngle := angle] ifFalse: [cwAngle := angle negated].
	center := self calcCenter: start end: end  angle: cwAngle.
	v := (start - center).
	radius := v r.
	startAngle := self angleOfVector: v.
	endAngle := self angleOfVector: (end-center).
	aBool ifTrue: [ self arcCenterX: center x centerY: center y  radius: radius  startAngle: startAngle endAngle: endAngle ]
		ifFalse: [ self arcNegativeCenterX: center x centerY: center y  radius: radius  startAngle: startAngle  endAngle: endAngle ]
		! !

!AthensCairoPathBuilder methodsFor: 'private' stamp: 'IgorStasenko 3/7/2012 16:07'!
moveToX: x Y: y
	" move command always starts a new contour "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #(void cairo_move_to (AthensCairoCanvas context,
		 double x, double y ) )
! !

!AthensCairoPathBuilder class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 3/7/2012 14:53'!
buildPathFrom:  aPathCreatingBlock 

	! !

!AthensCairoPathBuilder class methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ CairoLibraryLoader getLibraryHandle! !

!AthensCairoPatternPaint commentStamp: '<historical>'!
i am abstract class for different kinds of paints in cairo backend.!
!AthensCairoPatternPaint methodsFor: 'accessing' stamp: 'IgorStasenko 5/31/2012 01:53'!
setMatrix: m

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	self nbCall: #( 
		void
			cairo_pattern_set_matrix ( self, AthensCairoMatrix * m)
		)
! !

!AthensCairoPatternPaint methodsFor: 'drawing' stamp: 'IgorStasenko 9/3/2013 15:00'!
athensFillPath: path on: aCanvas 

	aCanvas
		newPath;
		loadPath: path.
	self setMatrix: aCanvas paintTransform inverted.
	self loadOnCairoCanvas: aCanvas.
	
	aCanvas fill.! !

!AthensCairoPatternPaint methodsFor: 'testing' stamp: 'IgorStasenko 3/28/2012 18:50'!
isPatternTypeMismatch
	^ self status = CAIRO_STATUS_PATTERN_TYPE_MISMATCH.! !

!AthensCairoPatternPaint methodsFor: 'testing' stamp: ''!
isSuccess
	^ self status  =	CAIRO_STATUS_SUCCESS! !

!AthensCairoPatternPaint methodsFor: 'accessing' stamp: 'IgorStasenko 8/31/2012 01:12'!
noRepeat
	self primSetExtend: CAIRO_EXTEND_NONE.
! !

!AthensCairoPatternPaint methodsFor: 'drawing' stamp: 'IgorStasenko 9/3/2013 12:40'!
athensLoadOn: anAthensCanvas 
	"
	Note: The pattern's transformation matrix will be locked to the user space in effect at the time of cairo_set_source(). This means that further modifications of the current transformation matrix will not affect the source pattern. See cairo_pattern_set_matrix().
	"

	self isSuccess
		ifTrue:[ self primSetSourceOn: anAthensCanvas.]
		ifFalse:[ anAthensCanvas setSourceR: 1.0 g: 0.0 b: 0.0 a: 1.0].
	 
		
! !

!AthensCairoPatternPaint methodsFor: 'drawing' stamp: 'IgorStasenko 9/3/2013 15:00'!
athensFillRectangle: aRectangle on: aCanvas
	"This is a terminal method in rendering dispatch scheme
	canvas->shape->paint. See AthensCanvas>>fillShape: "

	aCanvas
		rectangleX: aRectangle left
		y: aRectangle top
		width: aRectangle width
		height: aRectangle height.
	
	self setMatrix: aCanvas paintTransform inverted.
	self loadOnCairoCanvas: aCanvas.
	aCanvas fill! !

!AthensCairoPatternPaint methodsFor: 'accessing' stamp: 'IgorStasenko 8/31/2012 01:13'!
reflect
	self primSetExtend: CAIRO_EXTEND_REFLECT.! !

!AthensCairoPatternPaint methodsFor: 'drawing' stamp: 'FernandoOlivero 4/19/2012 15:01'!
maskOn: anAthensCanvas
"
A drawing operator that paints the current source using the alpha channel of pattern as a mask. (Opaque areas of pattern are painted with the source, transparent areas are not painted.)
"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCall: #(void cairo_mask(cairo_t anAthensCanvas, self))! !

!AthensCairoPatternPaint methodsFor: 'drawing' stamp: 'IgorStasenko 9/3/2013 14:58'!
loadOnCairoCanvas: aCanvas
	"
	Note: The pattern's transformation matrix will be locked to the user space in effect at the time of cairo_set_source(). This means that further modifications of the current transformation matrix will not affect the source pattern. See cairo_pattern_set_matrix().
	"

	self isSuccess
		ifTrue:[ self primSetSourceOn: aCanvas.]
		ifFalse:[ aCanvas setSourceR: 1.0 g: 0.0 b: 0.0 a: 1.0].
	 
		
! !

!AthensCairoPatternPaint methodsFor: 'initialize-release' stamp: ''!
initialize
	
	handle value = 0 ifTrue: [ 
		self error: 'Error creating new paint' ].
	
	"register to be finalized"
	NBExternalResourceManager addResource: self data: handle.! !

!AthensCairoPatternPaint methodsFor: 'accessing' stamp: 'IgorStasenko 4/12/2013 10:29'!
setExtend: aSymbol
	"
	typedef enum {
    CAIRO_EXTEND_NONE,
    CAIRO_EXTEND_REPEAT,
    CAIRO_EXTEND_REFLECT,
    CAIRO_EXTEND_PAD
} cairo_extend_t;
	"
	| enum |
	enum := self defaultExtend.
	aSymbol = #None ifTrue: [ enum := CAIRO_EXTEND_NONE ].
	aSymbol = #Repeat ifTrue: [ enum := CAIRO_EXTEND_REPEAT ].
	aSymbol = #Reflect ifTrue: [ enum := CAIRO_EXTEND_REFLECT ].
	aSymbol = #Pad ifTrue: [ enum := CAIRO_EXTEND_PAD ].
	self primSetExtend: enum.! !

!AthensCairoPatternPaint methodsFor: 'accessing' stamp: 'IgorStasenko 8/31/2012 01:14'!
repeat
	self primSetExtend: CAIRO_EXTEND_REPEAT.! !

!AthensCairoPatternPaint methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ self class nbLibraryNameOrHandle
! !

!AthensCairoPatternPaint methodsFor: 'primitives' stamp: 'IgorStasenko 3/30/2012 18:13'!
primSetExtend: extend

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall:#(
		void cairo_pattern_set_extend ( self , ulong extend) )
		! !

!AthensCairoPatternPaint methodsFor: 'accessing' stamp: 'FernandoOlivero 1/13/2012 20:15'!
status
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCall: #(int cairo_pattern_status (cairo_pattern_t  self))
		! !

!AthensCairoPatternPaint methodsFor: 'converting' stamp: 'IgorStasenko 4/27/2012 11:30'!
asStrokePaintOn: aCanvas
	^ aCanvas surface createStrokePaintFor: self! !

!AthensCairoPatternPaint methodsFor: 'initialize-release' stamp: 'FernandoOlivero 4/19/2012 14:14'!
defaultExtend
"The default extend mode is CAIRO_EXTEND_NONE for surface patterns and CAIRO_EXTEND_PAD for gradient patterns.
"
	
	^  CAIRO_EXTEND_NONE! !

!AthensCairoPatternPaint methodsFor: 'primitives' stamp: 'FernandoOlivero 4/19/2012 14:00'!
primSetSourceOn: aCanvas
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCall: #(void cairo_set_source ( cairo_t  aCanvas,  self))
		! !

!AthensCairoPatternPaint methodsFor: 'converting' stamp: ''!
asAthensPaintOn: anAthensCanvas	
	^ self! !

!AthensCairoPatternPaint class methodsFor: 'private' stamp: ''!
finalizeResourceData: handle

	self primDestroyPattern: handle value ! !

!AthensCairoPatternPaint class methodsFor: 'private' stamp: ''!
primDestroyPattern: aHandle
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	self nbCall: #(void cairo_pattern_destroy (ulong aHandle) )
 ! !

!AthensCairoPatternPaint class methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ CairoLibraryLoader getLibraryHandle! !

!AthensCairoPatternSurfacePaint commentStamp: '<historical>'!
i represent texture/image/form/surface paints in cairo backend.!
!AthensCairoPatternSurfacePaint methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 7/3/2013 16:17'!
setMatrix: aMatrix

	aMatrix restoreAfter: [
		origin ifNotNil: [ aMatrix translateBy: origin negated ].
		super setMatrix: aMatrix.
	]! !

!AthensCairoPatternSurfacePaint methodsFor: 'accessing' stamp: 'NicolaiHess 1/6/2015 18:23'!
extent
	^ extent ifNil:[surface extent]! !

!AthensCairoPatternSurfacePaint methodsFor: 'accessing' stamp: 'NicolaiHess 1/6/2015 18:24'!
extent: aPatternExtent
	extent:= aPatternExtent! !

!AthensCairoPatternSurfacePaint methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/11/2012 17:29'!
direction: aPoint 
	direction := aPoint.! !

!AthensCairoPatternSurfacePaint methodsFor: 'initialize-release' stamp: 'FernandoOlivero 4/19/2012 13:58'!
initializeFor: anAthensCairoSurface 
	self initialize.
	surface := anAthensCairoSurface .
	! !

!AthensCairoPatternSurfacePaint methodsFor: 'drawing' stamp: 'NicolaiHess 1/6/2015 18:24'!
athensFillRectangle: aRectangle on: aCanvas
	"This is a terminal method in rendering dispatch scheme
	canvas->shape->paint. See AthensCanvas>>fillShape: "

	extent
		ifNotNil: [ self setRect: (origin extent: extent) forFillOn: aCanvas ]
		ifNil: [ self setRect: aRectangle forFillOn: aCanvas ].
		
	self setMatrix: aCanvas paintTransform inverted.
	self loadOnCairoCanvas: aCanvas.
	aCanvas fill! !

!AthensCairoPatternSurfacePaint methodsFor: 'private' stamp: 'NicolaiHess 1/6/2015 18:24'!
setRect: aRectangle forFillOn: aCanvas
	aCanvas
		rectangleX: aRectangle left
		y: aRectangle top
		width: aRectangle width
		height: aRectangle height! !

!AthensCairoPatternSurfacePaint methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/11/2012 17:15'!
origin: aPoint 
	origin := aPoint.! !

!AthensCairoPatternSurfacePaint class methodsFor: 'as yet unclassified' stamp: 'FernandoOlivero 4/19/2012 13:57'!
primCreateForSurface: anAthensCairoSurface
	
"	pattern = cairo_pattern_create_for_surface (image);"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #(AthensCairoPatternSurfacePaint cairo_pattern_create_for_surface(
		cairo_surface_t  anAthensCairoSurface ) )
! !

!AthensCairoPatternSurfacePaint class methodsFor: 'as yet unclassified' stamp: 'FernandoOlivero 4/19/2012 13:57'!
createForSurface: anAthensCairoSurface
	|pat|
	pat := self primCreateForSurface: anAthensCairoSurface .
	pat initializeFor: anAthensCairoSurface  .
	^ pat! !

!AthensCairoSolidPaint commentStamp: '<historical>'!
i represent solid color paint in cairo backend!
!AthensCairoSolidPaint methodsFor: 'drawing' stamp: 'IgorStasenko 9/3/2013 12:56'!
athensFillPath: path on: aCanvas 

	aCanvas
		setSourceR: r g: g b: b a: a; 
		newPath;
		loadPath: path;
		fill.
	
! !

!AthensCairoSolidPaint methodsFor: 'accessing' stamp: 'NicolaiHess 1/6/2015 18:29'!
extent: anExtent
	extent := anExtent! !

!AthensCairoSolidPaint methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ self class nbLibraryNameOrHandle
! !

!AthensCairoSolidPaint methodsFor: 'drawing' stamp: 'NicolaiHess 1/6/2015 18:30'!
athensFillRectangle: aRect on: aCanvas
	"This is a terminal method in rendering dispatch scheme
	canvas->shape->paint. See AthensCanvas>>fillShape: "
	|o e toFillRect|
	o := origin ifNil:[aRect origin] ifNotNil:[origin].
	e := extent ifNil:[aRect extent] ifNotNil:[extent].
	toFillRect := o extent:e.
	
	aCanvas
		setSourceR: r g: g b: b a: a; 
		newPath;
		rectangleX: toFillRect left y: toFillRect top width: toFillRect width height: toFillRect height;
		fill.! !

!AthensCairoSolidPaint methodsFor: 'accessing' stamp: 'IgorStasenko 3/28/2012 18:27'!
color: aColor
	r := aColor red.
	g := aColor green.
	b := aColor blue.
	a := aColor alpha.! !

!AthensCairoSolidPaint methodsFor: 'drawing' stamp: 'IgorStasenko 9/3/2013 14:56'!
loadOnCairoCanvas: aCanvas
	aCanvas
		setSourceR: r g: g b: b a: a! !

!AthensCairoSolidPaint methodsFor: 'accessing' stamp: 'NicolaiHess 1/6/2015 18:29'!
origin: aPoint
	origin := aPoint! !

!AthensCairoSolidPaint class methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ CairoLibraryLoader getLibraryHandle! !

!AthensCairoStrokePaint commentStamp: '<historical>'!
i represent stroke paint in cairo backend!
!AthensCairoStrokePaint methodsFor: 'drawing' stamp: 'IgorStasenko 9/3/2013 13:05'!
athensFillPath: aPath on: aCanvas
	
	self prepareForDrawingOn: aCanvas.
	
	aCanvas 
		newPath; 
		loadPath: aPath;
		stroke! !

!AthensCairoStrokePaint methodsFor: 'private' stamp: 'FernandoOlivero 1/12/2012 23:20'!
primSetLineCapOn: aCanvas
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCall: #(void cairo_set_line_cap (
			AthensCairoCanvas aCanvas,
			cairo_line_cap_t capStyle) )! !

!AthensCairoStrokePaint methodsFor: 'private' stamp: 'FernandoOlivero 1/12/2012 23:51'!
primSetDashesOn: aCanvas lengths: dashesLengths count: dashesCount offset: anOffset
"	void                cairo_set_dash                      (cairo_t *cr,
                                                         double *dashes,
                                                         int num_dashes,
                                                         double offset);"
<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	self nbCall: #(void cairo_set_dash (
				AthensCairoCanvas aCanvas,
				double* dashesLengths,
				int dashesCount,
				double anOffset) )
! !

!AthensCairoStrokePaint methodsFor: 'private' stamp: 'IgorStasenko 4/3/2013 05:53'!
setDashesOn: aCanvas 
	| buf |
	
	buf := ByteArray new: 8*dashLenghts size.
	
	dashLenghts withIndexDo: [:len :i |
		
		buf nbFloat64AtOffset: (i-1)*8 put: len asFloat
		].

	self
		primSetDashesOn: aCanvas
		lengths: buf
		count: dashLenghts size
		offset: dashOffset
		! !

!AthensCairoStrokePaint methodsFor: 'drawing' stamp: 'IgorStasenko 9/3/2013 13:06'!
athensFillRectangle: aRect on: aCanvas

	self prepareForDrawingOn: aCanvas.
	
	aCanvas 
		newPath;
		rectangleX: aRect left
		y: aRect top 
		width: aRect width
		height: aRect height;
		stroke.
! !

!AthensCairoStrokePaint methodsFor: 'setting join styles' stamp: 'IgorStasenko 9/3/2013 14:44'!
joinMiter
	joinStyle := CAIRO_LINE_JOIN_MITER! !

!AthensCairoStrokePaint methodsFor: 'setting join styles' stamp: 'IgorStasenko 9/3/2013 14:44'!
joinBevel
	joinStyle := CAIRO_LINE_JOIN_BEVEL! !

!AthensCairoStrokePaint methodsFor: 'initialize-release' stamp: 'IgorStasenko 9/3/2013 12:32'!
initialize
	super initialize.

	self setDefaults! !

!AthensCairoStrokePaint methodsFor: 'setting cap styles' stamp: 'IgorStasenko 9/3/2013 14:14'!
capSquare
	capStyle := CAIRO_LINE_CAP_SQUARE! !

!AthensCairoStrokePaint methodsFor: 'setting join styles' stamp: 'IgorStasenko 9/3/2013 14:44'!
joinRound
	joinStyle := CAIRO_LINE_JOIN_ROUND ! !

!AthensCairoStrokePaint methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ self class nbLibraryNameOrHandle
! !

!AthensCairoStrokePaint methodsFor: 'setting dashes' stamp: 'IgorStasenko 4/3/2013 05:54'!
dashes: anAlternateCollectionOfLenghts offset: anOffset
	dashLenghts := anAlternateCollectionOfLenghts.
	dashOffset := anOffset asFloat.! !

!AthensCairoStrokePaint methodsFor: 'private' stamp: 'FernandoOlivero 1/12/2012 23:19'!
primSetLineWidthOn: aCanvas
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	self nbCall: #(void cairo_set_line_width (
				AthensCairoCanvas aCanvas,
				double width) )
! !

!AthensCairoStrokePaint methodsFor: 'private' stamp: 'IgorStasenko 9/3/2013 13:02'!
prepareForDrawingOn: aCanvas
	
	fillPaint 
		loadOnCairoCanvas: aCanvas.
	
	self 
		primSetLineWidthOn: aCanvas;
		primSetLineJoinOn: aCanvas;
		primSetLineCapOn: aCanvas.
	
	dashLenghts 
		ifNil: [ aCanvas resetDash ] 
		ifNotNil: [ self setDashesOn: aCanvas ].! !

!AthensCairoStrokePaint methodsFor: 'setting cap styles' stamp: 'IgorStasenko 9/3/2013 14:14'!
capRound
	capStyle := CAIRO_LINE_CAP_ROUND! !

!AthensCairoStrokePaint methodsFor: 'setting cap styles' stamp: 'IgorStasenko 9/3/2013 14:44'!
capButt
	capStyle := CAIRO_LINE_CAP_BUTT.! !

!AthensCairoStrokePaint methodsFor: 'private' stamp: 'FernandoOlivero 1/12/2012 23:21'!
primSetLineJoinOn: aCanvas
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	self nbCall: #(void cairo_set_line_join (
			AthensCairoCanvas aCanvas,
			cairo_line_join_t joinStyle) )! !

!AthensCairoStrokePaint class methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ CairoLibraryLoader getLibraryHandle! !

!AthensCairoSurface commentStamp: 'IgorStasenko 4/29/2014 17:05'!
i am a concrete implementation of Athens surface which using cairo graphics library for rendering.

Cairo library, by itself can have multiple surface types.
This class uses image surface (a bitmap located in system memory) and maps to cairo_image_surface_t* C type.

**NOTE**
As a workaround of bitblt bug, the actual Cairo surfaces, created internally is with 1 extra pixel higher than requested. This is, however completely hidden from users.!
!AthensCairoSurface methodsFor: 'private' stamp: 'FernandoOlivero 1/12/2012 12:00'!
statusToString: aCairoStatusT
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	^ self nbCall: #(String   cairo_status_to_string  (cairo_status_t aCairoStatusT))! !

!AthensCairoSurface methodsFor: 'private' stamp: 'IgorStasenko 4/29/2014 16:59'!
privateHeight
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #(
		int cairo_image_surface_get_height ( self ) )

! !

!AthensCairoSurface methodsFor: 'converting' stamp: 'IgorStasenko 4/26/2013 15:20'!
asForm

	"create a form and copy an image data there"
	self checkSession.
	
	self flush.
	^ Form extent: (self width@self height) depth: 32 bits: id! !

!AthensCairoSurface methodsFor: 'private' stamp: 'IgorStasenko 4/26/2013 15:21'!
checkSession

	session  == Smalltalk session ifFalse: [ 
		
		self error: 'Attempt to use invalid external resource (left from previous session)'
		
		 ]! !

!AthensCairoSurface methodsFor: 'testing' stamp: 'FernandoOlivero 1/12/2012 11:59'!
isSuccess
	^ self status  =	CAIRO_STATUS_SUCCESS! !

!AthensCairoSurface methodsFor: 'initialize-release' stamp: 'IgorStasenko 5/31/2012 01:48'!
resourceData
	^ { handle value. id. context handle }! !

!AthensCairoSurface methodsFor: 'private' stamp: 'IgorStasenko 8/31/2012 00:37'!
markDirty

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #( void cairo_surface_mark_dirty (self) )! !

!AthensCairoSurface methodsFor: 'accessing' stamp: 'IgorStasenko 4/29/2014 16:59'!
height
	
	^self privateHeight - 1
! !

!AthensCairoSurface methodsFor: 'accessing' stamp: ''!
handle
	^ handle value! !

!AthensCairoSurface methodsFor: 'initialize-release' stamp: 'IgorStasenko 4/26/2013 15:19'!
initialize
	"the handle should be set already since we using an NB callout to create an instance"
	handle value = 0 ifTrue: [ 
		self error: 'Error creating new surface' ].
	
	session := Smalltalk session.
	
	id := self class registerSurface: self.
		
	context := self newCanvas.
	builder := AthensCairoPathBuilder new.
	builder context: context.
	ftFontRenderer := CairoFreetypeFontRenderer new
		canvas: context. 
	
	NBExternalResourceManager addResource: self.! !

!AthensCairoSurface methodsFor: 'paints' stamp: 'IgorStasenko 4/12/2013 10:01'!
createLinearGradient: aColorRamp start: aStartPoint stop: aStopPoint
	^ AthensCairoGradientPaint 
		createLinearGradient: aColorRamp 
		start: aStartPoint 
		stop: aStopPoint
	! !

!AthensCairoSurface methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ self class nbLibraryNameOrHandle
! !

!AthensCairoSurface methodsFor: 'accessing' stamp: 'IgorStasenko 10/11/2012 18:05'!
clear: clearPaint
	currentCanvas pathTransform restoreAfter: [
		currentCanvas pathTransform loadIdentity.
		currentCanvas paintMode restoreAfter: [
			currentCanvas paintMode source.
			currentCanvas 
				setPaint: clearPaint;
				drawShape: (0@0 extent: self extent).
				
        ]].

! !

!AthensCairoSurface methodsFor: 'paints' stamp: 'IgorStasenko 4/27/2012 11:22'!
createStrokePaintFor: aPaint

	^ AthensCairoStrokePaint new fillPaint: aPaint! !

!AthensCairoSurface methodsFor: 'accessing' stamp: 'FernandoOlivero 1/12/2012 11:55'!
status

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCall: #(int cairo_surface_status (self) )
	! !

!AthensCairoSurface methodsFor: 'private' stamp: 'IgorStasenko 10/17/2012 17:15'!
newCanvas
	"Answer a preinitialized instance of AthensCanvas.
	Private to receiver and its subclasses, override seldom"
	
	^ self primCreateCanvas surface: self

! !

!AthensCairoSurface methodsFor: '*Athens-Morphic' stamp: 'IgorStasenko 12/21/2013 02:17'!
displayOnMorphicCanvas: canvas at: aPoint
	
	canvas
		image: self asForm
		at: aPoint
		sourceRect: (0@0 extent: self extent )
		rule: 34.
! !

!AthensCairoSurface methodsFor: 'creation' stamp: 'FernandoOlivero 3/26/2012 18:47'!
createPath: aPathCreatingBlock
	^ builder createPath:  aPathCreatingBlock ! !

!AthensCairoSurface methodsFor: 'converting' stamp: 'FernandoOlivero 4/19/2012 14:03'!
asAthensPaintOn: aCanvas
	^ AthensCairoPatternSurfacePaint createForSurface: self.
 ! !

!AthensCairoSurface methodsFor: 'paints' stamp: 'IgorStasenko 4/27/2012 12:25'!
createRadialGradient: colorRamp center: aCenter radius: aRadius focalPoint: fp
	^AthensCairoGradientPaint	
		radialBetween: fp
		extending: 0
		and: aCenter
		extending: aRadius
		withColorRamp: colorRamp! !

!AthensCairoSurface methodsFor: 'private' stamp: 'IgorStasenko 10/17/2012 17:15'!
primCreateCanvas

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^self nbCall: #( AthensCairoCanvas cairo_create (self) )! !

!AthensCairoSurface methodsFor: 'rendering dispatch' stamp: 'IgorStasenko 8/30/2013 16:58'!
fillRectangle: aRectangle withSolidColor: aColor

	self loadSolidColor: aColor.
	
	currentCanvas
		newPath;
		rectangleX: aRectangle left y: aRectangle top width: aRectangle width height: aRectangle height;
		fill
	! !

!AthensCairoSurface methodsFor: 'accessing' stamp: 'IgorStasenko 10/9/2012 19:22'!
clear
	^ self clear: Color transparent! !

!AthensCairoSurface methodsFor: 'paints' stamp: 'BenjaminVanRyseghem 7/3/2013 13:29'!
createFormPaint: aForm 
	"here we should convert form to cairo surface"
	
	| newSurface |

	newSurface := self class fromForm: (aForm asFormOfDepth: 32).
	
	^ newSurface asAthensPaintOn: context

! !

!AthensCairoSurface methodsFor: 'accessing' stamp: 'IgorStasenko 12/20/2011 15:12'!
width
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #(
		int cairo_image_surface_get_width ( self ) )

! !

!AthensCairoSurface methodsFor: 'caching' stamp: 'IgorStasenko 10/12/2012 03:24'!
cacheAt: anObject ifAbsentPut: aBlock
	"Answer an object from surface's cache identified by anObject,
	if there is no cached object under such identifier, evaluate a block
	and put it into cache. Then answer the result of evaluation.
	A surface using identity comparison for object identifiers.
	"
	^ CairoBackendCache soleInstance at: anObject ifAbsentPut: aBlock! !

!AthensCairoSurface methodsFor: 'accessing' stamp: 'IgorStasenko 12/20/2011 15:19'!
getDataPtr
	"get a pointer to surface bitmap data"
	
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #(
		void* cairo_image_surface_get_data ( self ) )

! !

!AthensCairoSurface methodsFor: 'rendering dispatch' stamp: 'IgorStasenko 8/30/2013 16:58'!
loadSolidColor: aColor
	currentCanvas setSourceR: aColor red g: aColor green b: aColor blue a: aColor alpha; resetDash! !

!AthensCairoSurface methodsFor: 'accessing' stamp: 'IgorStasenko 12/20/2011 15:10'!
stride
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #(
		int cairo_image_surface_get_stride ( self ) )

! !

!AthensCairoSurface methodsFor: 'caching' stamp: 'IgorStasenko 10/12/2012 03:54'!
flushCacheAt: anObject

	"Flush (delete) any cached value(s) identified by given object, anObject.
	Do nothing if there's no cached values stored for given object.
	Answer receiver.

	A surface using identity comparison for object identifiers.
	"
	CairoBackendCache soleInstance removeAt: anObject! !

!AthensCairoSurface methodsFor: 'paints' stamp: 'FernandoOlivero 1/13/2012 20:12'!
createSolidColorPaint: aColor 

	^ AthensCairoSolidPaint new color: aColor! !

!AthensCairoSurface methodsFor: 'accessing' stamp: 'IgorStasenko 12/20/2011 15:18'!
extent
	^ self width @ self height! !

!AthensCairoSurface methodsFor: 'private' stamp: 'IgorStasenko 9/3/2013 14:13'!
privSetDefaults
	"reset matrices"
	currentCanvas pathTransform loadIdentity.
	currentCanvas paintTransform loadIdentity.
	currentCanvas paintMode over.
	
! !

!AthensCairoSurface methodsFor: 'drawing' stamp: 'IgorStasenko 4/26/2013 15:19'!
drawDuring: aBlock

	"You may draw on receiver only when inside a block and only using provided canvas object.
	This ensures releasing system resources used after finishing drawing"

	self checkSession.
	
	currentCanvas ifNotNil: [ self attemptToRecurseDrawing ].
	[
		currentCanvas := context.
		self privSetDefaults.
		aBlock value: currentCanvas.
		self flush.
	] ensure: [
		currentCanvas := nil.
	].! !

!AthensCairoSurface methodsFor: 'rendering dispatch' stamp: 'IgorStasenko 9/3/2013 12:19'!
fillPath: aPath withSolidColor: aColor 

	self loadSolidColor: aColor.
	
	currentCanvas 
		newPath;
		loadPath: aPath;
		fill
	! !

!AthensCairoSurface methodsFor: 'private' stamp: 'IgorStasenko 5/4/2012 18:32'!
flush

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #( void cairo_surface_flush (self) )! !

!AthensCairoSurface methodsFor: 'drawing' stamp: ''!
attemptToRecurseDrawing
	^ self ! !

!AthensCairoSurface methodsFor: 'text support' stamp: 'IgorStasenko 9/2/2012 00:50'!
getFreetypeFontRendererFor: aFreetypeFont 
	"answer the same instance, just reset it's font and advance"
	
	^ ftFontRenderer font: aFreetypeFont; advance: 0@0; yourself! !

!AthensCairoSurface methodsFor: 'converting' stamp: 'FernandoOlivero 1/12/2012 12:54'!
writeToPng: aFileName
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	self nbCall: #(void cairo_surface_write_to_png (self, String aFileName) )
! !

!AthensCairoSurface methodsFor: 'text support' stamp: 'NicolaiHess 6/30/2014 09:48'!
getStrikeFontRendererFor: aStrikeFont 
	"answer the same instance, just reset it's font and advance"
	
	^ AthensStrikeFontRenderer on: context  forFont: aStrikeFont.! !

!AthensCairoSurface class methodsFor: 'instance creation' stamp: 'IgorStasenko 4/12/2013 09:05'!
createFromFile: aFileName ifFailed: aBlock
	"Right now, this protocol is Cairo backend only. "
	
 	| surface cstring |
	cstring := aFileName , (Character value: 0) asString.
	surface :=  self primCreateFromFile: cstring.
	surface isSuccess not
		ifTrue: [ 
			self destroySurfaceHandle: surface handle value.
			^ aBlock cull: surface status ]
		ifFalse: [ surface initialize ].
	^ surface .! !

!AthensCairoSurface class methodsFor: 'private' stamp: ''!
unregisterSurfaceWithId: anAthensCairoSurfaceId

	self ioUnregisterSurface: anAthensCairoSurfaceId! !

!AthensCairoSurface class methodsFor: 'surface plugin callbacks' stamp: ''!
createUnlockSurfaceFn

	"
		int unlockSurface(int handle, int x, int y, int w, int h);
		Unlock the bits of a (possibly modified) surface after BitBlt completed.
		The return value is ignored.

		The arguments provided specify the dirty region of the surface. If the
		surface is unmodified all arguments are set to zero.

	"

	| fn |

	fn := NBNativeFunctionGen 
		cdecl: #(int (int handle, int x, int y, int w, int h) )
		emit: [:gen :proxy :asm | 
			"do nothing"
		].
	
	fn install.
	^ fn address! !

!AthensCairoSurface class methodsFor: 'session management' stamp: ''!
checkSession
	uniqueSession == NativeBoost uniqueSessionObject ifFalse: [
		self initializeForNewSession
	].! !

!AthensCairoSurface class methodsFor: 'private' stamp: ''!
ioUnregisterSurface: aCairoSurfaceId
"
	ioUnregisterSurface:
	Unregister the surface with the given id.
	Returns true if successful, false otherwise. 

"

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	self nbCall: #( int ioUnregisterSurface(ulong aCairoSurfaceId) ) module: #SurfacePlugin! !

!AthensCairoSurface class methodsFor: 'private' stamp: ''!
testGetSurfaceFormat: handle width: wBuf height: hBuf depth: depthBuf isMSB: isMSBBuf

<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	NBFFICallout cdecl:  #( int (ulong handle, int* wBuf, int* hBuf, int* depthBuf, int* isMSBBuf) ) emitCall: [:gen :proxy :asm | 
		asm
			mov: (self dispatchStruct getSurfaceFormatFn) asUImm32 to: asm EAX;
			call: asm EAX
		]

! !

!AthensCairoSurface class methodsFor: 'private' stamp: ''!
ioFindSurface: id dispatch: dispPtr handle: handlePtr
"	int ioFindSurface(int surfaceID, sqSurfaceDispatch *fn, int *surfaceHandle);
		Find the surface with the given ID, and, optionally,
		the given set of surface functions. The registered handle
		is returned in surfaceHandle. Return true if successful
		(e.g., the surface has been found), false otherwise.
"


	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	self nbCall: #( bool ioFindSurface(int id, void * dispPtr, int *handlePtr) ) module: #SurfacePlugin! !

!AthensCairoSurface class methodsFor: 'private' stamp: 'FernandoOlivero 1/12/2012 13:02'!
primImage: aFormat width: aWidth height: aHeight
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #(AthensCairoSurface cairo_image_surface_create (int aFormat,
                                                         int aWidth,
                                                         int aHeight) )

! !

!AthensCairoSurface class methodsFor: 'private' stamp: ''!
destroySurfaceHandle: handle
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self nbCall: #( void cairo_surface_destroy ( ulong handle ) )

! !

!AthensCairoSurface class methodsFor: 'surface plugin callbacks' stamp: 'jb 8/9/2013 16:03'!
createGetSurfaceFormatFn

	"
		int getSurfaceFormat(int handle, int* width, int* height, int* depth, int* isMSB);

		Return general information about the OS drawing surface.
		Return true if successful, false otherwise.

		The returned values describe the basic properties such as
		width, height, depth and LSB vs. MSB pixels.
	"

	| fn |

	fn := NBNativeFunctionGen 
		cdecl: #( int (int handle, int* width, int* height, int* depth, int* isMSB) )
		emit: [:gen :proxy :asm | | callInfo fnPtr |

			" the handle is a handle to cairo image surface (cairo_surface_t *) "

			"*width = cairo_image_surface_get_width ( handle )"
			asm cdeclCall: [:call |
				call push: (gen arg: #handle).
				asm
					mov: (self fnPtr: 'cairo_image_surface_get_width') asUImm32 to: asm EAX;
					call: asm EAX
			] alignment: gen stackAlignment;
			
			mov: (gen arg: #width) to: asm EDX;
			mov: asm EAX to: asm EDX ptr.
		
			"*height = cairo_image_surface_get_height ( handle )"
			asm cdeclCall: [:call |
				call push: (gen arg: #handle).
				asm
					mov: (self fnPtr: 'cairo_image_surface_get_height') asUImm32 to: asm EAX;
					call: asm EAX
			] alignment: gen stackAlignment;

			mov: (gen arg: #height) to: asm EDX;
			
"work around the bitblt bug which tries to access past the buffer size designated by width*height*depth "			
			dec: asm EAX;
			mov: asm EAX to: asm EDX ptr.

			"*depth = 32"
			asm 
				mov: (gen arg: #depth) to: asm EAX;
				mov: 32 to: asm EAX ptr32.
			
			" *isMSB = false "
			asm 
				mov: (gen arg: #isMSB) to: asm EAX;
				mov: 0 to: asm EAX ptr32;

			"return true"
				mov: 1 to: asm EAX
						
		].
	fn install.
	^ fn address! !

!AthensCairoSurface class methodsFor: 'instance creation' stamp: 'IgorStasenko 10/11/2012 18:41'!
fromForm: aForm
	| form surface newBits |
	
	form := aForm unhibernate; asFormOfDepth: 32.
	surface := self extent: aForm extent.
	
	"we should convert form bits with premultiplied alpha"
	
	newBits := form bits collect:[:pixel |
		| alpha r g b|
		alpha := (pixel >> 24) / 255.
		
		r := ( (pixel bitAnd: 255) * alpha ) asInteger.
		g := ( (pixel >>8 bitAnd: 255) * alpha ) asInteger.
		b := ( (pixel >>16 bitAnd: 255) * alpha ) asInteger.
		
		(pixel bitAnd: 16rFF000000) + (b<<16) + (g<<8) + r
		].
	
	NativeBoost memCopy: newBits to: surface getDataPtr size: (form width * form height *4).
	
	surface markDirty.

	^ surface.! !

!AthensCairoSurface class methodsFor: 'private' stamp: 'IgorStasenko 12/20/2011 15:01'!
primWidth: aWidth height: aHeight
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #( AthensCairoSurface cairo_image_surface_create (
						CAIRO_FORMAT_ARGB32,
						int aWidth,
						int aHeight) )! !

!AthensCairoSurface class methodsFor: 'private' stamp: ''!
testSurfacePluginCallbacks

	| surface wb hb db mb ptr |
	
	surface := AthensCairoSurface extent: 800@800.
	
	wb := ByteArray new: 4.
	hb := ByteArray new: 4.
	db := ByteArray new: 4.
	mb := ByteArray new: 4.
	
	self testGetSurfaceFormat: surface handle width: wb height: hb depth: db isMSB: mb.

	self assert: (surface width = (wb nbUlongAt: 1)).
	self assert: (surface height = (hb nbUlongAt: 1)).	
	self assert: (32 = (db nbUlongAt: 1)).
	self assert: (0 = (mb nbUlongAt: 1)).
	
	ptr := self testLockSurface: surface handle pitch:  wb x: 0  y: 0  w:  100 h: 100.
	self assert: (wb nbUlongAt: 1) = surface stride.
	self assert: ptr = surface getDataPtr! !

!AthensCairoSurface class methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ CairoLibraryLoader getLibraryHandle! !

!AthensCairoSurface class methodsFor: 'private' stamp: ''!
ioRegisterSurface: aCairoSurfaceHandle dispatch: sqSurfaceDispatchPtr surfaceId: idHolder
"
	int ioRegisterSurface(int surfaceHandle, sqSurfaceDispatch *fn, int *surfaceID);

	Register a new surface with the given handle and
	the set of surface functions. The new ID is returned
	in surfaceID. Returns true if successful, false 
	otherwise.

"

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	self nbCall: #( bool ioRegisterSurface(ulong aCairoSurfaceHandle, void * sqSurfaceDispatchPtr, int *idHolder) ) module: #SurfacePlugin! !

!AthensCairoSurface class methodsFor: 'surface plugin callbacks' stamp: ''!
fnPtr: anFnName

	^ NativeBoost loadSymbol: anFnName fromModule: self nbLibraryNameOrHandle.

! !

!AthensCairoSurface class methodsFor: 'private' stamp: 'IgorStasenko 5/31/2012 01:50'!
destroyContextHandle: aHandle

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self nbCall: #( 	void cairo_destroy (size_t aHandle) )! !

!AthensCairoSurface class methodsFor: 'surface plugin callbacks' stamp: ''!
createShowSurfaceFn

	"
	int showSurface(int handle, int x, int y, int w, int h);
		Display the contents of the surface on the actual screen.

		If ioShowSurface() is called the surface in question represents
		a Squeak DisplayScreen.

	"

	| fn |

	fn := NBNativeFunctionGen 
		cdecl: #(int (int handle, int x, int y, int w, int h))
		emit: [:gen :proxy :asm | 
			"do nothing"
			asm mov: 1 to: asm EAX
		].
	
	fn install.
	^ fn address! !

!AthensCairoSurface class methodsFor: 'instance creation' stamp: 'IgorStasenko 3/7/2012 15:32'!
extent: anExtent
	^ self extent: anExtent format: CAIRO_FORMAT_ARGB32 ! !

!AthensCairoSurface class methodsFor: 'instance creation' stamp: 'IgorStasenko 4/29/2014 17:00'!
extent: anExtent format: aFormat
	^ ( self primImage: aFormat width: anExtent x height: anExtent y + 1) initialize
! !

!AthensCairoSurface class methodsFor: 'private' stamp: 'FernandoOlivero 3/29/2012 12:04'!
primCreateFromFile: aFileName

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin> 
	
	^self nbCall: #(AthensCairoSurface cairo_image_surface_create_from_png (char* aFileName)) 
! !

!AthensCairoSurface class methodsFor: 'surface plugin callbacks' stamp: ''!
createLockSurfaceFn

	"
	int lockSurface(int handle, int *pitch, int x, int y, int w, int h);
		Lock the bits of the surface.
		Return a pointer to the actual surface bits, or NULL on failure.
		If successful, store the pitch of the surface (e.g., the bytes
		per scan line).

		For equal source/dest handles only one locking operation is performed.
		This is to prevent locking of overlapping areas which does not work with
		certain APIs (e.g., DirectDraw prevents locking of overlapping areas). 
		A special case for non-overlapping but equal source/dest handle would 
		be possible but we would have to transfer this information over to 
		unlockSurfaces somehow (currently, only one unlock operation is 
		performed for equal source and dest handles). Also, this would require
		a change in the notion of ioLockSurface() which is right now interpreted
		as a hint and not as a requirement to lock only the specific portion of
		the surface.

		The arguments in ioLockSurface() provide the implementation with
		an explicit hint what area is affected. It can be very useful to
		know the max. affected area beforehand if getting the bits requires expensive
		copy operations (e.g., like a roundtrip to the X server or a glReadPixel op).
		However, the returned pointer *MUST* point to the virtual origin of the surface
		and not to the beginning of the rectangle. The promise made by BitBlt
		is to never access data outside the given rectangle (aligned to 4byte boundaries!!)
		so it is okay to return a pointer to the virtual origin that is actually outside
		the valid memory area.

		The area provided in ioLockSurface() is already clipped (e.g., it will always
		be inside the source and dest boundingBox) but it is not aligned to word boundaries
		yet. It is up to the support code to compute accurate alignment if necessary.
	"

	| fn |

	fn := NBNativeFunctionGen 
		cdecl: #(int (int handle, int *pitch, int x, int y, int w, int h) )
		emit: [:gen :proxy :asm | | callInfo fnPtr |

			" the handle is a handle to cairo image surface (cairo_surface_t *) "

			"*pitch = cairo_image_surface_get_stride ( handle )"
			asm cdeclCall: [:call |
				call push: (gen arg: #handle).
				asm
					mov: (self fnPtr: 'cairo_image_surface_get_stride') asUImm32 to: asm EAX;
					call: asm EAX
			] alignment: gen stackAlignment;
			
			mov: (gen arg: #pitch) to: asm EDX;
			mov: asm EAX to: asm EDX ptr.
		
			" return cairo_image_surface_get_data ()"
			asm cdeclCall: [:call |
				call push: (gen arg: #handle).
				asm
					mov: (self fnPtr: 'cairo_image_surface_get_data') asUImm32 to: asm EAX;
					call: asm EAX
			] alignment: gen stackAlignment
		].
	
	fn install.
	^ fn address! !

!AthensCairoSurface class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 12/20/2011 14:49'!
asNBExternalType: gen
	"use handle ivar to hold my instance (cairo_surface_t)"
	^ NBExternalObjectType objectClass: self! !

!AthensCairoSurface class methodsFor: 'private' stamp: ''!
findSurface: surfaceId
	| buf |
	buf := ByteArray new: 4.  "sizeof(int)"
	
	
	(self ioFindSurface: surfaceId handle: buf) ifTrue: [
		^ buf nbUlongAt: 1
		].
	
	^ nil. ! !

!AthensCairoSurface class methodsFor: 'surface plugin callbacks' stamp: ''!
dispatchStruct
	self checkSession.
	^ dispatchStruct! !

!AthensCairoSurface class methodsFor: 'session management' stamp: 'jb 8/9/2013 16:11'!
initializeForNewSession
	| ptr |
	uniqueSession := NativeBoost uniqueSessionObject.
	
	"create a dispatch structure"
	dispatchStruct := dispatch := SQSurfaceDispatch new.
	
	dispatch 
		getSurfaceFormatFn: self createGetSurfaceFormatFn;
		lockSurfaceFn: self createLockSurfaceFn;
		unlockSurfaceFn: self createUnlockSurfaceFn;
		showSurfaceFn: self createShowSurfaceFn.
		
	"now we should place this structure to external memory"
	
	ptr := NativeBoost allocate: (SQSurfaceDispatch instanceSize).
	NativeBoost memCopy: dispatch address to: ptr size: (SQSurfaceDispatch instanceSize).
	
	dispatch := ptr.! !

!AthensCairoSurface class methodsFor: 'private' stamp: 'IgorStasenko 10/12/2012 03:37'!
registerSurface: anAthensCairoSurface
	"register the cairo surface with surface plugin,
	so, it can be used directly by bitblt operations.
	
	Answer an id and unique session object
	 "
	| id |
	self checkSession.
	
	id := ByteArray new: 8 "we need 4, but put some more (NBExternalType sizeOf: #int)".

	(self ioRegisterSurface: anAthensCairoSurface handle value dispatch: dispatch surfaceId: id)
		ifFalse: [ self error: 'Unable to register surface with SurfacePlugin'].
	
	id := id nbLongAt: 1.
	
	^ id! !

!AthensCairoSurface class methodsFor: 'private' stamp: ''!
ioFindSurface: id handle: handlePtr
"	int ioFindSurface(int surfaceID, sqSurfaceDispatch *fn, int *surfaceHandle);
		Find the surface with the given ID, and, optionally,
		the given set of surface functions. The registered handle
		is returned in surfaceHandle. Return true if successful
		(e.g., the surface has been found), false otherwise.
"


	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	self nbCall: #( bool ioFindSurface(int id, 0 , int *handlePtr) ) module: #SurfacePlugin! !

!AthensCairoSurface class methodsFor: 'private' stamp: ''!
testLockSurface: handle pitch: pBuf x: x y: y w: w h: h

<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	NBFFICallout cdecl:  #( 	void *  (int handle, int *pBuf, int x, int y, int w, int h) ) emitCall: [:gen :proxy :asm | 
		asm
			mov: (self dispatchStruct lockSurfaceFn) asUImm32 to: asm EAX;
			call: asm EAX
		]

! !

!AthensCairoSurface class methodsFor: 'instance creation' stamp: 'IgorStasenko 4/29/2014 17:00'!
width: aWidth height: aHeight
	^ (self primWidth: aWidth height: aHeight+1) initialize! !

!AthensCairoSurface class methodsFor: 'finalize resources' stamp: 'IgorStasenko 5/31/2012 01:49'!
finalizeResourceData: data
	| handle id contextHandle |
	handle := data first.
	id := data second.
	contextHandle := data third.
	
	(self findSurface: id) = handle ifFalse: [ 
		self error: 'surface is not registered with surface plugin'.
		].
	
	self unregisterSurfaceWithId: id.
	self destroyContextHandle: contextHandle. 
	self destroySurfaceHandle: handle.
! !

!AthensCairoSurfaceExamples commentStamp: 'FernandoOlivero 4/18/2012 13:59'!
self example1!
!AthensCairoSurfaceExamples class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/31/2012 01:02'!
exampleInterop

"
self exampleInterop

Test the interoperability with bitblt.
A cairo image surface bits are exposed to bitblt operations via surface plugin.
"
	| surf |
	
	surf := self newSurface: 100@100.

	surf asForm getCanvas fillRectangle: (0@0 corner: 50@50) color: Color red.
	surf markDirty. 
	
	surf drawDuring: [:can |
		can pathTransform loadIdentity.
		can pathTransform translateX: 30 Y: 30.
		can pathTransform rotateByDegrees: 35.
		can setPaint: (Color red).
		
		can setShape: (-20@ -20 corner: 20@ 20).
		2 timesRepeat: [ can draw. can setPaint: (Color green alpha:0.5)]
	].
	Display getCanvas drawImage: 	surf asForm  at: 0@0
! !

!AthensCairoSurfaceExamples class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 2/6/2012 15:29'!
newSurface: extent
	
	^ AthensCairoSurface extent: extent! !

!AthensCairoText commentStamp: '<historical>'!
do not use this class. this is subject of change or removal!
!AthensCairoText methodsFor: 'drawing' stamp: 'FernandoOlivero 4/7/2012 12:12'!
showOn: aCanvas
	| cString|
	aCanvas setPathMatrix.
	cString := self asString copyWith: (Character value: 0).
	self primShowText: cString on: aCanvas! !

!AthensCairoText methodsFor: 'font description' stamp: 'FernandoOlivero 1/14/2012 18:23'!
fontFamily

	^ fontFamily! !

!AthensCairoText methodsFor: 'font description' stamp: 'FernandoOlivero 1/14/2012 19:40'!
beNormal
	self fontWeight: CAIRO_FONT_WEIGHT_NORMAL! !

!AthensCairoText methodsFor: 'font description' stamp: 'FernandoOlivero 1/14/2012 18:23'!
beBold
	self fontWeight: CAIRO_FONT_WEIGHT_BOLD! !

!AthensCairoText methodsFor: 'font description' stamp: 'FernandoOlivero 1/14/2012 20:10'!
readFrom: aFontDescription
	self fontFamily: aFontDescription fontFamily.
	self fontSlant: aFontDescription fontSlant.
	self fontWeight:  aFontDescription fontWeight.
	self fontSize: aFontDescription fontSize.! !

!AthensCairoText methodsFor: 'font description' stamp: 'FernandoOlivero 1/14/2012 18:23'!
beSlantNormal
	self fontSlant: CAIRO_FONT_SLANT_NORMAL! !

!AthensCairoText methodsFor: 'font description' stamp: 'FernandoOlivero 1/14/2012 18:24'!
fontWeight

	^ fontWeight! !

!AthensCairoText methodsFor: 'accessing' stamp: 'FernandoOlivero 1/14/2012 18:24'!
text

	^ text! !

!AthensCairoText methodsFor: 'initialization' stamp: 'FernandoOlivero 3/30/2012 14:49'!
initialize
	super initialize.
	
	self beNormal; beSlantNormal.
	 fontSize := 10.! !

!AthensCairoText methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ self class nbLibraryNameOrHandle
! !

!AthensCairoText methodsFor: 'private' stamp: 'FernandoOlivero 1/25/2012 00:59'!
primShowText: aString on: aCanvas
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	self nbCall: #(void cairo_show_text (
			cairo_t aCanvas,
			char * aString) )
! !

!AthensCairoText methodsFor: 'drawing' stamp: 'NicolaiHess 1/13/2015 12:39'!
loadOn: aCanvas
	fontFamily notNil ifTrue:[
		self
			primSelectFont:  fontFamily
				slant:  fontSlant
				weight:  fontWeight 
				on: aCanvas] .
	fontSize notNil ifTrue:[		
		self primSetFontSize:  (TextStyle pointsToPixels: fontSize) on: aCanvas ]! !

!AthensCairoText methodsFor: 'font description' stamp: 'FernandoOlivero 1/14/2012 18:23'!
fontSize

	^ fontSize! !

!AthensCairoText methodsFor: 'font description' stamp: 'FernandoOlivero 1/14/2012 20:00'!
fontSlant: anObject
	anObject isSymbol
		ifTrue:[ fontSlant := self slantFrom: anObject ]
		ifFalse:[ fontSlant := anObject ]! !

!AthensCairoText methodsFor: 'private' stamp: 'FernandoOlivero 1/25/2012 01:02'!
slantFrom: aSymbol
	^ aSymbol caseOf: {
		[#normal]->[ CAIRO_FONT_SLANT_NORMAL ].
 		[#italic]->[   CAIRO_FONT_SLANT_ITALIC ].
		[#oblique]->[ CAIRO_FONT_SLANT_OBLIQUE ] }! !

!AthensCairoText methodsFor: 'accessing' stamp: 'FernandoOlivero 1/14/2012 18:35'!
asString
	^ text asString! !

!AthensCairoText methodsFor: 'font description' stamp: 'FernandoOlivero 1/14/2012 18:23'!
fontSize: anObject

	fontSize := anObject! !

!AthensCairoText methodsFor: 'private' stamp: 'FernandoOlivero 1/25/2012 01:03'!
weightFrom: aSymbol
	^ aSymbol caseOf: {
		[#normal]->[ CAIRO_FONT_WEIGHT_NORMAL  ].
 		[#bold]->[    CAIRO_FONT_WEIGHT_BOLD ] }
! !

!AthensCairoText methodsFor: 'drawing' stamp: 'FernandoOlivero 4/7/2012 12:12'!
drawOn: aCanvas
	self loadOn: aCanvas.
	self showOn: aCanvas! !

!AthensCairoText methodsFor: 'font description' stamp: 'FernandoOlivero 1/25/2012 01:03'!
fontWeight: anObject
	anObject isSymbol
		ifTrue:[ fontWeight := self weightFrom: anObject ]
		ifFalse:[ fontWeight :=  anObject ] ! !

!AthensCairoText methodsFor: 'accessing' stamp: 'FernandoOlivero 1/14/2012 18:24'!
text: anObject

	text := anObject! !

!AthensCairoText methodsFor: 'private' stamp: 'FernandoOlivero 1/25/2012 01:00'!
primSelectFont: aFontFamily
		slant: aFontSlant
		weight: aFontWeight 
		on: aCanvas
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	self nbCall: #(void cairo_select_font_face (
			cairo_t aCanvas,
   			char * aFontFamily,
      		cairo_font_slant_t aFontSlant,
        	cairo_font_weight_t aFontWeight) )
	! !

!AthensCairoText methodsFor: 'font description' stamp: 'FernandoOlivero 1/14/2012 19:42'!
fontFamily: anObject
	"CSS2 generic family names: serif, sans-serif, cursive, fantasy, monospace"
	fontFamily := anObject! !

!AthensCairoText methodsFor: 'private' stamp: 'FernandoOlivero 1/14/2012 18:31'!
primSetFontSize: aFontSize on: aCanvas
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	self nbCall: #(void cairo_set_font_size (
			cairo_t aCanvas,
			double aFontSize) )
! !

!AthensCairoText methodsFor: 'font description' stamp: 'FernandoOlivero 1/14/2012 18:24'!
fontSlant

	^ fontSlant! !

!AthensCairoText class methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ CairoLibraryLoader getLibraryHandle! !

!AthensCairoTransform commentStamp: '<historical>'!
i implement AthensTransform protocol using cairo-specific functions.!
!AthensCairoTransform methodsFor: 'transformations' stamp: 'IgorStasenko 3/7/2012 13:55'!
restoreAfter: aBlock
	self save.
	aBlock ensure:  [ self restore ].! !

!AthensCairoTransform methodsFor: 'primitives' stamp: 'IgorStasenko 12/21/2011 13:43'!
primTransformX: x Y: y

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #(
		void cairo_user_to_device (AthensCairoCanvas canvas,
                                                         NBFloatPtr x,
                                                         NBFloatPtr y) )
! !

!AthensCairoTransform methodsFor: 'primitives' stamp: 'FernandoOlivero 1/14/2012 00:32'!
restore
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCall: #(void cairo_restore(AthensCairoCanvas canvas))
! !

!AthensCairoTransform methodsFor: 'transformations' stamp: 'FernandoOlivero 1/14/2012 00:38'!
translateBy: aPoint
	self translateX: aPoint x Y: aPoint y
! !

!AthensCairoTransform methodsFor: 'transformations' stamp: 'FernandoOlivero 1/15/2012 19:39'!
moveTo: aPoint
	self moveToX: aPoint x asFloat Y: aPoint y asFloat! !

!AthensCairoTransform methodsFor: 'transformations' stamp: 'IgorStasenko 12/20/2011 16:45'!
rotateByDegrees: angle

	^ self rotateByRadians: angle degreesToRadians! !

!AthensCairoTransform methodsFor: 'initializing' stamp: 'IgorStasenko 12/20/2011 16:43'!
canvas: aCairoCanvas
	canvas := aCairoCanvas! !

!AthensCairoTransform methodsFor: 'primitives' stamp: 'IgorStasenko 12/20/2011 16:44'!
scaleX: fx Y: fy

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #(
		void cairo_scale (AthensCairoCanvas canvas,
                                                         double fx,
                                                         double fy))

! !

!AthensCairoTransform methodsFor: 'transformations' stamp: 'FernandoOlivero 1/15/2012 16:49'!
scaleBy: aScalarOrPoint
	| double |
	aScalarOrPoint isPoint
		ifTrue:[
			self
				scaleX: aScalarOrPoint x asFloat
				Y: aScalarOrPoint y asFloat ]
		ifFalse:[ 
			double := aScalarOrPoint asFloat.
			self scaleX: double Y: double ].
! !

!AthensCairoTransform methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ self class nbLibraryNameOrHandle
! !

!AthensCairoTransform methodsFor: 'primitives' stamp: 'IgorStasenko 12/20/2011 16:45'!
rotateByRadians: angle

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #(
		void cairo_rotate (AthensCairoCanvas canvas,
                                                         double angle))

! !

!AthensCairoTransform methodsFor: 'primitives' stamp: 'FernandoOlivero 1/14/2012 00:32'!
save
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCall: #(void cairo_save (AthensCairoCanvas canvas))
! !

!AthensCairoTransform methodsFor: 'vector-transform' stamp: 'IgorStasenko 12/21/2011 13:42'!
transform: aPoint
	| x y |
	"since we use pointers to floats we must create a copy of original values to not scratch them"
	x := aPoint x asFloat shallowCopy.
	y := aPoint y asFloat shallowCopy.
	
	self primTransformX: x Y: y.
	^ x @ y! !

!AthensCairoTransform methodsFor: 'primitives' stamp: 'IgorStasenko 12/20/2011 16:54'!
translateX: px Y: py

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #(
		void cairo_translate (AthensCairoCanvas canvas,
                                                         double px,
                                                         double py))

! !

!AthensCairoTransform methodsFor: 'primitives' stamp: 'FernandoOlivero 1/14/2012 20:31'!
moveToX: px Y: py

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #(
		void cairo_move_to (AthensCairoCanvas canvas,
                                                         double px,
                                                         double py))

! !

!AthensCairoTransform methodsFor: 'primitives' stamp: 'IgorStasenko 12/20/2011 16:47'!
loadIdentity

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #(
		void cairo_identity_matrix (AthensCairoCanvas canvas) )

! !

!AthensCairoTransform class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 12/20/2011 16:49'!
for: cairoCanvas
	^ self new canvas: cairoCanvas! !

!AthensCairoTransform class methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ CairoLibraryLoader getLibraryHandle! !

!AthensCanvas commentStamp: '<historical>'!
The Athens canvas is a central object which is used to performs drawings on a surface.
Please note, that Athens does not allows you to instantiate canvas directly, instead you obtain a ready for use instance as an argument in 
#drawDuring: message, sent to athens surface:

surface drawDuring: [:canvas | .... ]

Using canvas outside a #drawDuring: method is highly discouraged. Doing so may lead to unpredicted behavior/data corruption/image crash.!
!AthensCanvas methodsFor: 'initialization' stamp: 'IgorStasenko 3/22/2011 11:13'!
initializeWithSurface: anAthensSurface	
	surface := anAthensSurface! !

!AthensCanvas methodsFor: 'transformation matrices' stamp: 'IgorStasenko 11/19/2012 05:14'!
pathTransform
	"Answer the path transformation matrix controller.
	The answered object should conform to AthensTransform public protocol."
	^ surface pathTransform
! !

!AthensCanvas methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/23/2015 13:58'!
morphicDrawString: string in: rect font: aFont color: aColor
	self
		clipBy: rect
		during: [ 
			self pathTransform
				restoreAfter: [ 
					self pathTransform translateX: rect left Y: rect top.
					self setFont: aFont.
					self pathTransform translateX: 0 Y: aFont getPreciseAscent.
					self
						setPaint: aColor;
						drawString: string ] ]! !

!AthensCanvas methodsFor: '*Athens-Morphic' stamp: 'IgorStasenko 4/21/2011 14:27'!
fullDrawMorph: aMorph

"Hook method for potential other canvases. In the core, this method looks supefluous but PostscriptCanvases and other canvases can specialized it for Morph rendering. Therefore it should not be merged with fullDraw:."

	aMorph fullDrawOnAthensCanvas: self! !

!AthensCanvas methodsFor: 'accessing' stamp: 'FernandoOlivero 2/14/2012 12:12'!
paint
	^ paint  ! !

!AthensCanvas methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/17/2015 12:36'!
asCanvasWrapper
	^  AthensCanvasWrapper on: self! !

!AthensCanvas methodsFor: 'accessing' stamp: 'IgorStasenko 5/6/2013 05:41'!
setShape: anObject
	"Set the current shape of receiver"
	shape := anObject asAthensShapeOn: self.! !

!AthensCanvas methodsFor: 'accessing' stamp: 'IgorStasenko 11/19/2012 05:14'!
paintMode
	"Answer the current paint mode controller.
	The answered object should conform to AthensPaintMode public protocol."

	^ paintMode! !

!AthensCanvas methodsFor: 'paint' stamp: 'IgorStasenko 11/19/2012 05:11'!
setStrokePaint: aPaint
	"use paint as stroke paint, note conversion to #asStrokePaintOn:"
	paint := (aPaint asAthensPaintOn: self) asStrokePaintOn: self.
	^ paint! !

!AthensCanvas methodsFor: '*Athens-Morphic' stamp: 'IgorStasenko 10/11/2012 15:25'!
morphicDrawString: string at: position font: aFont color: aColor

	self pathTransform restoreAfter: [
		self pathTransform translateX: position x Y: position y + aFont getPreciseAscent.
		self 
			setFont: aFont;
			setPaint: aColor;
			drawString: string.
	]
! !

!AthensCanvas methodsFor: 'masking' stamp: 'IgorStasenko 3/27/2011 18:06'!
enableMask
	^ surface enableMask! !

!AthensCanvas methodsFor: 'paths' stamp: 'IgorStasenko 11/19/2012 05:21'!
createPath: aPathCreatingBlock
	"Create new path. A path creating block should be a monadic block,
	which will get a path builder instance as argument. See AthensPathBuilder
	for available protocol.
	The resulting path object can be later used for drawing.
	" 
	^ surface createPath: aPathCreatingBlock! !

!AthensCanvas methodsFor: 'masking' stamp: 'IgorStasenko 3/27/2011 18:06'!
disableMask
	^ surface disableMask! !

!AthensCanvas methodsFor: 'drawing' stamp: 'IgorStasenko 11/19/2012 05:18'!
draw: anObject
	"A generic dispatch method to draw anObject on receiver. 
	the object should understand #drawOnAthensCanvas: message"
	^ anObject drawOnAthensCanvas: self! !

!AthensCanvas methodsFor: 'caching' stamp: 'IgorStasenko 10/12/2012 03:20'!
cacheAt: anObject ifAbsentPut: aBlock

	^ surface cacheAt: anObject ifAbsentPut: aBlock! !

!AthensCanvas methodsFor: 'accessing' stamp: 'IgorStasenko 11/19/2012 05:10'!
surface
	"Answer an Athens surface, to which receiver is bound to"
	^ surface! !

!AthensCanvas methodsFor: 'drawing text' stamp: 'IgorStasenko 8/30/2013 16:14'!
setFont: aFont
	"Set the current font of receiver. Font object should answer a glyph renderer instance,
	compatible with glyph renderer protocol" 
	^ fontRenderer := aFont glyphRendererOn: surface.! !

!AthensCanvas methodsFor: 'clipping' stamp: 'IgorStasenko 4/21/2011 14:40'!
isVisible: aRectangle 
	"check if rectangle are not fully clipped by current clipping coordinates"
	
	^ true! !

!AthensCanvas methodsFor: 'caching' stamp: 'AlainPlantec 3/3/2015 18:41'!
flushCacheAt: anObject
	"Flush (delete) any cached value(s) identified by given object, anObject.
	A surface using identity comparison for object identifiers.

	Answer receiver.
	"

	surface flushCacheAt: anObject! !

!AthensCanvas methodsFor: 'paths' stamp: 'IgorStasenko 3/22/2011 22:04'!
createRectanglePath: aRectangle 
	^ surface createRectanglePath: aRectangle 
! !

!AthensCanvas methodsFor: 'drawing' stamp: 'IgorStasenko 11/19/2012 05:17'!
drawShape: anObject
	"A convenience method, which sets the current shape to anObject and then fills it
	with currently selected paint" 
	self setShape: anObject.
	self draw.
	! !

!AthensCanvas methodsFor: 'masking' stamp: 'IgorStasenko 3/27/2011 18:31'!
clearMask: aShape
	"set mask pixels to 0 for all pixels covered by shape, aShape"
	^ aShape paintFillsUsing: surface clearMaskPaint on: self
! !

!AthensCanvas methodsFor: 'drawing' stamp: 'IgorStasenko 7/3/2013 16:28'!
draw
	"Fill the currently selected shape with currently selected paint"
	
	^ shape paintFillsUsing: paint on: self

! !

!AthensCanvas methodsFor: 'drawing text' stamp: 'IgorStasenko 9/1/2012 22:08'!
drawString: aString from: start to: end

	"Draw a portion of string using currently selected font.
	Answer a total advance of rendered portion"
	^ fontRenderer renderCharacters: aString from: start to: end! !

!AthensCanvas methodsFor: 'masking' stamp: 'IgorStasenko 3/27/2011 18:35'!
setMask: aShape
	"set mask pixels to 1 for all pixels covered by shape, aShape"

	^ aShape paintFillsUsing: surface setMaskPaint on: self
! !

!AthensCanvas methodsFor: 'transformation matrices' stamp: 'IgorStasenko 11/19/2012 05:14'!
paintTransform
	"Answer the paint transformation matrix controller.
	The answered object should conform to AthensTransform public protocol."

	^ surface paintTransform
! !

!AthensCanvas methodsFor: 'drawing text' stamp: 'IgorStasenko 9/1/2012 22:08'!
drawString: aString
	"Draw a string using currently selected font.
	Answer a total advance of rendered string "
	^ fontRenderer renderCharacters: aString from: 1 to: aString size.! !

!AthensCanvas methodsFor: 'paint' stamp: 'IgorStasenko 11/19/2012 05:11'!
setPaint: aPaint
	"set the current paint of receiver"
	paint = aPaint ifTrue:[ ^ paint ].
	paint := aPaint asAthensPaintOn: self.
	^ paint.! !

!AthensCanvas methodsFor: 'clipping' stamp: 'IgorStasenko 4/21/2011 14:47'!
clipBy: aRectangle during: aBlock
	
	" Set a clipping rectangle during drawing operations performed in a block.
	Note that clipping rectangle are intetersected with currently active clipping
	rectangle "
	
	 ^surface clipBy: aRectangle during: aBlock! !

!AthensCanvas class methodsFor: 'private' stamp: 'IgorStasenko 3/21/2011 00:17'!
on: aSurface
	^ self basicNew initializeWithSurface: aSurface! !

!AthensCanvas class methodsFor: 'private' stamp: 'IgorStasenko 3/21/2011 00:19'!
new
	"use #on: instead"
	self shouldNotImplement! !

!AthensCanvasWrapper commentStamp: '<historical>'!
I am a wrapper for a (Form-)Canvas that implements the Canvas API on top of an AthensCanvas.!
!AthensCanvasWrapper methodsFor: 'canvas drawing-polygons' stamp: 'NicolaiHess 1/16/2015 23:47'!
drawPolygon: vertices fillStyle: aFillStyle borderWidth: aBorderWidth borderColor: aBorderColor
	self drawPolygon: vertices color:  aFillStyle borderWidth:  aBorderWidth borderColor: aBorderColor! !

!AthensCanvasWrapper methodsFor: 'private clip transform' stamp: 'NicolaiHess 1/16/2015 23:23'!
clipWrapperTransformBy: aDisplayTransform clippingTo: aClipRect during: aBlock smoothing: cellSize
"the clipTransform methods are just trial and error attemps on getting this right"
	| rect |
	rect := aDisplayTransform globalBoundsToLocal: aClipRect.
	self canvas pathTransform
		restoreAfter: [ 
			self canvas pathTransform translateBy: aDisplayTransform offset negated.
			self canvas pathTransform rotateByRadians: aDisplayTransform angle negated.
			self canvas pathTransform scaleBy: aDisplayTransform scale.
			self clipBy: rect during: [ :c | aBlock value: c ]]

		! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-text' stamp: 'NicolaiHess 1/23/2015 00:50'!
drawString: aString in: bounds font: aFontOrNil color: aColor
	| font |
	font := aFontOrNil ifNil: [ TextStyle defaultFont ].
	self canvasClipBy: (bounds intersect: self canvas clipRect) during:[
			self canvas pathTransform restoreAfter:[ 
			self canvas pathTransform translateBy: bounds origin.
			self canvas pathTransform translateX: 0 Y: font getPreciseAscent.
			self flag: #todo.	"scaled, so that FT-Plugin and Athens don't mix cached faces"
			self canvas pathTransform scaleBy: 1.0000001 @ 1.0000001.
			self canvas setPaint: aColor.
			self canvas setFont: font.
			self canvas drawString: aString from: 1 to: aString size ] ]! !

!AthensCanvasWrapper methodsFor: 'canvas accessing' stamp: 'NicolaiHess 1/4/2015 00:24'!
depth
	^ 32! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-general' stamp: 'NicolaiHess 1/10/2015 16:17'!
fullDrawMorph: aMorph
	"Hook method for potential other canvases. In the core, this method looks supefluous but PostscriptCanvases and other canvases can specialized it for Morph rendering. Therefore it should not be merged with fullDraw:."

	self fullDraw: aMorph ! !

!AthensCanvasWrapper methodsFor: 'formcanvas copying' stamp: 'NicolaiHess 1/3/2015 22:52'!
rubParagraph: para bounds: bounds color: c
	self paragraph: para bounds: bounds color: c! !

!AthensCanvasWrapper methodsFor: 'canvas converting' stamp: 'NicolaiHess 1/16/2015 23:15'!
asShadowDrawingCanvas
	self flag: #todo.	"this may not work, but it
doesn't hurt yet and HandMorph relies on this"
	^ (ShadowDrawingCanvas on: self) shadowColor: (Color orange alpha: 0.2)! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-support' stamp: 'NicolaiHess 1/4/2015 00:24'!
translateBy: offset during: aBlock
	^ self copyOrigin: origin + offset clipRect: self clipRect! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-ovals' stamp: 'NicolaiHess 1/3/2015 22:49'!
fillOval: aRectangle fillStyle: aFillStyle
	^self fillOval: aRectangle fillStyle: aFillStyle borderWidth: 0 borderColor: Color transparent! !

!AthensCanvasWrapper methodsFor: 'accessing' stamp: 'NicolaiHess 1/3/2015 22:45'!
canvas: anAthensCanvas
	athensCanvas := anAthensCanvas! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-rectangles' stamp: 'NicolaiHess 1/3/2015 22:50'!
fillRectangle: aRectangle fillStyle: aFillStyle
	self fillRectangle: aRectangle color: aFillStyle! !

!AthensCanvasWrapper methodsFor: 'initialization' stamp: 'NicolaiHess 1/3/2015 22:52'!
initialize

	super initialize.

	athensCanvas := nil.
	currentClipRect := nil.
	origin := 0@0.
! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-ovals' stamp: 'NicolaiHess 1/3/2015 22:49'!
fillOval: r color: c

	self fillOval: r color: c borderWidth: 0 borderColor: Color transparent.
! !

!AthensCanvasWrapper methodsFor: 'accessing' stamp: 'NicolaiHess 1/16/2015 15:43'!
allocateForm: extentPoint
	^ Form extent: extentPoint depth:32! !

!AthensCanvasWrapper methodsFor: 'canvas accessing' stamp: 'NicolaiHess 1/23/2015 00:59'!
clipRect
	^ self canvas clipRect! !

!AthensCanvasWrapper methodsFor: 'canvas accessing' stamp: 'NicolaiHess 1/17/2015 00:59'!
contentsOfArea: aRectangle into: aForm
	"this may conflict with current pathtransformations, but up to now"
	"it works"
	| bb |
	self flush.
	bb := BitBlt toForm: aForm.
	bb
		sourceForm: self form;
		combinationRule: Form over;
		sourceX: aRectangle left + origin x;
		sourceY: aRectangle top + origin y;
		width: aRectangle width;
		height: aRectangle height;
		copyBits.
	^ aForm! !

!AthensCanvasWrapper methodsFor: 'private' stamp: 'NicolaiHess 1/3/2015 22:46'!
createClosedEllipsePathIn: aRectangle
	| radius width |
	aRectangle area > 0
		ifFalse: [ ^ self ].
	width := aRectangle width.
	radius := width / 2.
	^ self canvas
		createPath: [ :builder | 
			builder
				absolute;
				moveTo: width @ radius;
				cwArcTo: 0 @ radius angle: Float pi;
				cwArcTo: width @ radius angle: Float pi ]! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-general' stamp: 'NicolaiHess 1/3/2015 22:48'!
draw: anObject
	^anObject drawOn: self! !

!AthensCanvasWrapper methodsFor: 'accessing' stamp: 'NicolaiHess 1/16/2015 15:28'!
form
	^ self canvas surface asForm! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-images' stamp: 'NicolaiHess 1/17/2015 00:21'!
translucentImage: aForm at: aPoint sourceRect: sourceRect
	self canvas paintMode over.
	self imagePaint: aForm at: aPoint sourceRect: sourceRect
! !

!AthensCanvasWrapper methodsFor: 'canvas drawing' stamp: 'NicolaiHess 1/16/2015 23:58'!
fillColor: aColor
	self flag:#NoKnownSender! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-general' stamp: 'NicolaiHess 1/3/2015 22:48'!
fullDraw: anObject
	^anObject fullDrawOn: self! !

!AthensCanvasWrapper methodsFor: 'canvas testing' stamp: 'NicolaiHess 1/3/2015 22:51'!
isVisible: aRectangle
	"Return true if the given rectangle is (partially) visible"

	^ self clipRect intersects: aRectangle.! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-images' stamp: 'NicolaiHess 1/23/2015 01:38'!
paintImage: aForm at: aPoint sourceRect: sourceRect
	self canvas paintMode over.
	self imagePaint: aForm at: aPoint sourceRect: sourceRect! !

!AthensCanvasWrapper methodsFor: 'canvas drawing' stamp: 'NicolaiHess 2/26/2015 20:38'!
stencil: stencilForm at: aPoint sourceRect: sourceRect color: aColor
	|mask|
	mask := stencilForm asFormOfDepth: 32.
	mask mapColor:Color white to: Color transparent.
	mask:= mask asAthensPaintOn: self canvas.
	self canvas pathTransform restoreAfter:[
		self canvas pathTransform translateBy: aPoint.
		self canvas setPaint: aColor.
		self canvas draw.
		mask maskOn: self canvas.
		].
! !

!AthensCanvasWrapper methodsFor: 'canvas accessing' stamp: 'NicolaiHess 1/16/2015 23:56'!
extent
	^ self canvas surface extent! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-rectangles' stamp: 'NicolaiHess 1/3/2015 22:50'!
frameAndFillRectangle: r fillColor: fillColor borderWidth: borderWidth topLeftColor: topLeftColor bottomRightColor: bottomRightColor
	self fillRectangle: r fillStyle: fillColor.
	topLeftColor = bottomRightColor
		ifTrue: [ self frameRectangle: r width: borderWidth color: bottomRightColor ]! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-rectangles' stamp: 'NicolaiHess 1/3/2015 22:50'!
frameRectangle: aRectangle width: width colors: colors dashes: dashes
	| stroke |
	stroke := self canvas setStrokePaint: colors first.
	stroke width: width.
	stroke dashes: dashes offset: 0.
	self canvas drawShape: aRectangle.
	colors allButFirst
		ifNotEmpty: [ :e | 
			stroke fillPaint: e first.
			stroke dashes: dashes reverse offset: dashes first.
			self canvas drawShape: aRectangle ]! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-general' stamp: 'NicolaiHess 1/3/2015 22:48'!
roundCornersOf: aMorph during: aBlock
	^ self roundCornersOf: aMorph in: aMorph bounds during: aBlock! !

!AthensCanvasWrapper methodsFor: 'formcanvas copying' stamp: 'NicolaiHess 1/16/2015 23:31'!
copyClipRect: aRectangle
"dont know why this exists, all calls with a different cliprect should go through"
"clipBy:during: and I don't know if this properly works with athens canvases because"
"we can not handle to different clipstates for the same canvas."
	^ self copyOrigin: origin clipRect: aRectangle
! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-rectangles' stamp: 'NicolaiHess 1/17/2015 00:07'!
frameRectangle: aRectangle width: aBorderWidth color: aColor
	(self canvas setStrokePaint: aColor) width: aBorderWidth.
	self canvas drawShape: aRectangle! !

!AthensCanvasWrapper methodsFor: 'private' stamp: 'NicolaiHess 1/3/2015 22:46'!
createClosedPolygonPathFrom: aPointsArray
	^ self canvas
		createPath: [ :builder | 
			aPointsArray ifEmpty: [ builder ].
			builder absolute.
			builder moveTo: aPointsArray first.
			aPointsArray allButFirstDo: [ :p | builder lineTo: p ].
			builder close.
			builder ]! !

!AthensCanvasWrapper methodsFor: 'canvas drawing' stamp: 'NicolaiHess 1/3/2015 22:47'!
line: pt1 to: pt2 color: c
	self
		line: pt1
		to: pt2
		width: 1
		color: c! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-rectangles' stamp: 'NicolaiHess 1/17/2015 13:38'!
fillRectangle: aRectangle fillStyle: aFillStyle borderStyle: aBorderStyle
	self
		canvasClipBy: self clipRect
		during: [ 
			self canvas setPaint: aFillStyle.
			self canvas drawShape: (aRectangle insetBy: aBorderStyle width).
			self canvas setStrokePaint: aBorderStyle.
			self canvas drawShape: (aRectangle insetBy: aBorderStyle width / 2 asFloat) ]! !

!AthensCanvasWrapper methodsFor: 'canvas accessing' stamp: 'NicolaiHess 1/3/2015 22:52'!
origin
	^ origin! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-rectangles' stamp: 'NicolaiHess 1/10/2015 19:12'!
fillRectangle: aRectangle color: aColor
	self canvas setPaint: aColor.
	self canvas drawShape: aRectangle! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-images' stamp: 'NicolaiHess 1/16/2015 15:33'!
drawImage: aForm at: aPoint sourceRect: sourceRect
	"Draw the given form."

	^self image: aForm
		at: aPoint
		sourceRect: sourceRect
		rule: Form over! !

!AthensCanvasWrapper methodsFor: 'canvas drawing' stamp: 'NicolaiHess 1/3/2015 22:48'!
line: pt1 to: pt2 width: w color: c
	| path |
	path := self createClosedPolygonPathFrom: {pt1 . pt2}.
		
	(self canvas setStrokePaint: c) width:w.
	self canvas drawShape: path.
	! !

!AthensCanvasWrapper methodsFor: 'private' stamp: 'NicolaiHess 1/3/2015 22:46'!
canvas
	^ athensCanvas! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-general' stamp: 'NicolaiHess 1/3/2015 22:48'!
roundCornersOf: aMorph in: bounds during: aBlock
	^ aBlock value! !

!AthensCanvasWrapper methodsFor: 'private debug' stamp: 'NicolaiHess 1/3/2015 22:47'!
isVisibleDebug: aRectangle
	"Return true if the given rectangle is (partially) visible"

	| vis canvasLocalClip |
	canvasLocalClip := Rectangle
		encompassing:
			(self clipRect corners
				collect: [ :c | (self canvas pathTransform transform: (c translateBy: origin)) translateBy: origin negated ]).	"canvasLocalClip := (self canvas pathTransform inverseTransform: aRectangle origin)
		corner: (self canvas pathTransform inverseTransform: aRectangle corner)."
	vis := self clipRect intersects: aRectangle.
	"self frameRectangle: aRectangle width: 1 color: Color red.
	self frameRectangle: self clipRect width: 1 color: Color green.
	self frameRectangle: canvasLocalClip width: 1 color: Color yellow."
	^ vis! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-ovals' stamp: 'NicolaiHess 1/3/2015 22:49'!
fillOval: aRectangle color: aColor borderWidth: aBorderWidth borderColor: aBorderColor
	self
		fillOval: aRectangle
		fillStyle: aColor
		borderWidth: aBorderWidth
		borderColor: aBorderColor! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-general' stamp: 'NicolaiHess 1/16/2015 00:00'!
drawMorph: aMorph
	(self isVisible: aMorph fullBounds)
		ifFalse: [ ^ self ].
	self draw: aMorph! !

!AthensCanvasWrapper methodsFor: 'private' stamp: 'NicolaiHess 1/3/2015 23:14'!
origin: aPoint
	origin := aPoint! !

!AthensCanvasWrapper methodsFor: 'private' stamp: 'NicolaiHess 1/16/2015 23:38'!
image: aForm at: aPoint sourceRect: sourceRect rule: rule
"AFAIK only used by HandMorph and probably never used for a transformed canvas"
"So, we may be save to used BitBlitting instead of an athens pattern paint"
self flag:#MayBeWrong.
	(BitBlt
		destForm: self form
		sourceForm: aForm
		fillColor: nil
		combinationRule: rule
		destOrigin: aPoint
		sourceOrigin: sourceRect origin
		extent: sourceRect extent
		clipRect:self clipRect) copyBits! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-support' stamp: 'NicolaiHess 2/26/2015 20:39'!
transformBy: aDisplayTransform clippingTo: aClipRect during: aBlock smoothing: cellSize
	self canvas
		transformBy: aDisplayTransform
		withClip: aClipRect
		in: aClipRect
		during: [ :v | aBlock value: self ]! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-text' stamp: 'NicolaiHess 1/3/2015 22:51'!
drawString: aString in: bounds
	self drawString: aString in: bounds font:nil color: Color black! !

!AthensCanvasWrapper methodsFor: 'private clip transform' stamp: 'NicolaiHess 1/16/2015 23:22'!
clipWrapperAndAthensTransformBy: aDisplayTransform clippingTo: aClipRect during: aBlock smoothing: cellSize
"the clipTransform methods are just trial and error attemps on getting this right"
	| rect |
	rect := aDisplayTransform globalBoundsToLocal: aClipRect.
	self
		clipBy: rect
		during: [ :c | 
			c canvas pathTransform
				restoreAfter: [ 
					"c canvas morphicClipBy: rect during: [ "
					c canvas pathTransform translateBy: aDisplayTransform offset negated.
					c canvas pathTransform rotateByRadians: aDisplayTransform angle negated.
					c  canvas pathTransform scaleBy: aDisplayTransform scale.
					aBlock value: self ] ]	"]"! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-rectangles' stamp: 'NicolaiHess 1/17/2015 13:21'!
frameRectangle: aRectangle color: aColor
	self frameRectangle: aRectangle width: 1 color: aColor! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-text' stamp: 'NicolaiHess 1/3/2015 22:51'!
drawString: aString at: aPoint font: aFontOrNil color: aColor
	self
		drawString: aString
		in: (origin + aPoint extent: self clipRect extent)
		font: aFontOrNil
		color: aColor! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-support' stamp: 'NicolaiHess 1/16/2015 23:23'!
cache: aRectangle using: aCache during: aBlock 
	self flag:#noKnownSender! !

!AthensCanvasWrapper methodsFor: 'formcanvas copying' stamp: 'NicolaiHess 1/3/2015 22:52'!
setOrigin: aPoint clipRect: aRectangle
	origin := aPoint.
	currentClipRect := aRectangle ! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-polygons' stamp: 'NicolaiHess 1/16/2015 23:45'!
drawPolygon: vertices color: aColor borderWidth: aBorderWidth borderColor: aBorderColor
	| path |
	self canvas pathTransform
		restoreAfter: [ 
			self canvas pathTransform.
			path := self createClosedPolygonPathFrom: vertices ].
	self canvas setPaint: aColor.
	self canvas drawShape: path.
	(self canvas setStrokePaint: aBorderColor) width: aBorderWidth.
	self canvas drawShape: path! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-images' stamp: 'NicolaiHess 1/17/2015 00:23'!
paintImage: aForm at: aPoint
	self paintImage: aForm at: aPoint sourceRect: aForm boundingBox! !

!AthensCanvasWrapper methodsFor: 'private clip transform' stamp: 'NicolaiHess 2/26/2015 20:36'!
canvasClipBy: aClipRect during: aBlock
	| oldRect |
	oldRect := self clipRect.
	currentClipRect := aClipRect.
	[ self canvas clipBy: currentClipRect during:[ aBlock value ]]
		ensure: [ currentClipRect := oldRect ]! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-ovals' stamp: 'NicolaiHess 1/17/2015 00:00'!
fillOval: aRectangle fillStyle: aFillStyle borderWidth: aBorderWidth borderColor: aBorderColor
	self canvas setPaint: aFillStyle.
	self canvas pathTransform
		restoreAfter: [ 
			| path t |
			path := self createClosedEllipsePathIn: aRectangle.
			t := self canvas pathTransform.
			t translateBy: aRectangle origin.
			t scaleBy: 1 @ (aRectangle height / aRectangle width).
			self canvas setShape: path.
			self canvas draw.
			(self canvas setStrokePaint: aBorderColor) width: aBorderWidth.
			self canvas draw ]! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-polygons' stamp: 'NicolaiHess 1/3/2015 22:50'!
drawPolygon: vertices fillStyle: aFillStyle
	| path |
	self canvas pathTransform
		restoreAfter: [ 
			self canvas pathTransform.
			path := self createClosedPolygonPathFrom: vertices ].
	self canvas setPaint: aFillStyle.
	self canvas drawShape: path! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-images' stamp: 'NicolaiHess 1/16/2015 15:33'!
drawImage: aForm at: aPoint
	"Draw the given Form, which is assumed to be a Form or ColorForm"

	self drawImage: aForm
		at: aPoint
		sourceRect: aForm boundingBox! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-support' stamp: 'NicolaiHess 2/26/2015 20:39'!
translateBy: offset clippingTo: aRect during: aBlock
	self
		canvasClipBy: aRect
		during: [ 
			self canvas pathTransform
				restoreAfter: [ 
					self canvas pathTransform translateBy: offset.
					aBlock value: self ] ]! !

!AthensCanvasWrapper methodsFor: 'canvas drawing' stamp: 'NicolaiHess 1/15/2015 22:19'!
paragraph: aParagraph bounds: aRectangle color: aColor
	aParagraph drawOnAthensCanvas: self canvas bounds: aRectangle color: aColor! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-rectangles' stamp: 'NicolaiHess 1/17/2015 01:02'!
frameAndFillRectangle: aRectangle fillColor: aFillColor borderWidth: aBorderWidth borderColor: aBorderColor
	self
		canvasClipBy: self clipRect
		during: [ 
			self canvas setPaint: aFillColor.
			self canvas drawShape: aRectangle.
			(self canvas setStrokePaint: aBorderColor) width: aBorderWidth.
			self canvas drawShape: aRectangle ]! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-support' stamp: 'NicolaiHess 1/16/2015 15:29'!
flush
	^ self canvas surface flush.! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-images' stamp: 'NicolaiHess 1/17/2015 00:16'!
translucentImage: aForm at: aPoint
	self translucentImage: aForm at: aPoint sourceRect: aForm boundingBox! !

!AthensCanvasWrapper methodsFor: 'private' stamp: 'NicolaiHess 1/17/2015 00:24'!
imagePaint: aForm at: aPoint sourceRect: sourceRect
	self canvas pathTransform
		restoreAfter: [ 
			self canvas setPaint: aForm.
			self canvas pathTransform translateBy: aPoint.
			self canvas drawShape: sourceRect]! !

!AthensCanvasWrapper methodsFor: 'formcanvas copying' stamp: 'NicolaiHess 1/6/2015 11:27'!
copyOrigin: aPoint clipRect: aRectangle
	^ self copy
		setOrigin: aPoint
		clipRect: (self clipRect intersect: aRectangle ifNone: [0@0 corner: 0@0])! !

!AthensCanvasWrapper methodsFor: 'initialization' stamp: 'NicolaiHess 1/17/2015 00:01'!
finish
	self flush! !

!AthensCanvasWrapper methodsFor: 'canvas drawing-support' stamp: 'NicolaiHess 1/16/2015 23:21'!
clipBy: aRectangle during: aBlock
	self canvasClipBy: aRectangle during: [ aBlock value: self ]! !

!AthensCanvasWrapper class methodsFor: 'instance creation' stamp: 'NicolaiHess 1/3/2015 22:53'!
on: anAthensCanvas
	^ self new
		canvas: anAthensCanvas;
		yourself! !

!AthensCharacterSpan commentStamp: 'IgorStasenko 2/6/2012 16:17'!
A text command to render a character span containing the range of characters for with same attributes!
!AthensCharacterSpan methodsFor: 'rendering' stamp: 'IgorStasenko 10/17/2011 12:52'!
renderOn: renderer
	renderer renderCharactersFrom: start to: stop! !

!AthensCharacterSpan methodsFor: 'accessing' stamp: 'IgorStasenko 11/10/2011 10:31'!
splitAt: position
	| newSpan |
	"split receiver on two character spans "
	" position points to first character which should be included in newly created span "
	
	position == start ifTrue: [ ^ self ].
	(position < start or: [ position > stop ]) ifTrue: [ self error: 'invalid position' ].

	newSpan := self class new
		start: position;
		stop: stop.

	stop := position - 1.
	self insert: newSpan.! !

!AthensCharacterSpan methodsFor: 'accessing' stamp: 'IgorStasenko 10/17/2011 12:02'!
stop

	^ stop! !

!AthensCharacterSpan methodsFor: 'accessing' stamp: 'IgorStasenko 10/17/2011 12:02'!
stop: anObject

	stop := anObject! !

!AthensCharacterSpan methodsFor: 'accessing' stamp: 'IgorStasenko 10/17/2011 12:02'!
start: anObject

	start := anObject! !

!AthensCharacterSpan methodsFor: 'accessing' stamp: 'IgorStasenko 10/17/2011 12:02'!
start

	^ start! !

!AthensCloseSegment commentStamp: '<historical>'!
i represent close segment (when user issuing #close command to path builder)!
!AthensCloseSegment methodsFor: 'visitor' stamp: 'IgorStasenko 4/18/2013 04:40'!
accept: aVisitor
	^ aVisitor closeSegment: self! !

!AthensCloseSegment methodsFor: 'visitor' stamp: 'IgorStasenko 4/18/2013 05:22'!
sendCommandTo: aBuilder
	^ aBuilder close
	! !

!AthensColorChange commentStamp: 'IgorStasenko 2/6/2012 16:17'!
A command to change the current font color!
!AthensColorChange methodsFor: 'rendering' stamp: 'IgorStasenko 10/17/2011 12:51'!
renderOn: renderer
	renderer setCurrentColor: color! !

!AthensColorChange methodsFor: 'accessing' stamp: 'IgorStasenko 10/11/2011 16:58'!
color: anObject

	color := anObject! !

!AthensColorChange methodsFor: 'accessing' stamp: 'IgorStasenko 10/11/2011 16:58'!
color

	^ color! !

!AthensCompositePaint commentStamp: '<historical>'!
i am used to convert CompositeFillStyle into paint, used in Morphic.!
!AthensCompositePaint methodsFor: 'drawing' stamp: 'IgorStasenko 8/30/2013 16:35'!
athensFillRectangle: aRect on: anAthensCanvas
	"This is a terminal method in rendering dispatch scheme
	canvas->shape->paint. See AthensCanvas>>fillShape: "
	

	paints do: [:paint | 
				paint athensFillRectangle: aRect on: anAthensCanvas ]
! !

!AthensCompositePaint methodsFor: 'drawing' stamp: 'IgorStasenko 8/30/2013 16:32'!
athensFillPath: athensPath on: anAthensCanvas 

	"This is a terminal method in rendering dispatch scheme
	canvas->shape->paint. See AthensCanvas>>fillShape: "

	paints do: [:paint | 
				paint athensFillPath: athensPath on: anAthensCanvas ]
! !

!AthensCompositePaint methodsFor: 'initialize-release' stamp: 'IgorStasenko 10/9/2012 19:07'!
fromFillStyles: fillStyles on: aCanvas

	paints := fillStyles collect: [:each | each asAthensPaintOn: aCanvas ]! !

!AthensCompositeStrokePaint commentStamp: '<historical>'!
i am used to convert CompositeBorderStyle into paint, used in Morphic.
The "withInset" attribute defines whether each sub stroke  outlines
a smaller rectangle. If not, all strokes draw the same rectangle.
(useful for multi-color-dashes)!
!AthensCompositeStrokePaint methodsFor: 'private' stamp: 'NicolaiHess 1/15/2015 11:51'!
fromDashedBorderStyle: border on: anAthensCanvas
	| allDashLength offset width |
	width := border width.
	allDashLength := border dashLengths detectSum: #yourself.
	offset := 0.
	strokePaints := border dashColors
		collectWithIndex: [ :c :i | 
			| stroke dashLength |
			dashLength := border dashLengths at: i.
			stroke := c asStrokePaintOn: anAthensCanvas.
			stroke width: width.
			stroke capButt.
			stroke
				dashes:
					{(dashLength * width).
					((allDashLength - dashLength) * width)}
				offset: (allDashLength - offset) * width.
			offset := offset + dashLength.
			stroke ].
	self withInset: false! !

!AthensCompositeStrokePaint methodsFor: 'drawing' stamp: 'NicolaiHess 1/15/2015 10:20'!
initialize

	super initialize.

	strokePaints := nil.
	withInset := true.! !

!AthensCompositeStrokePaint methodsFor: 'converting' stamp: 'NicolaiHess 1/6/2015 18:33'!
asStrokePaintOn: aCanvas
	"receiver is stroke paint already"
	^ self! !

!AthensCompositeStrokePaint methodsFor: 'private' stamp: 'NicolaiHess 1/6/2015 18:32'!
fromBorderStyles: borders on: anAthensCanvas
	strokePaints := borders collect: [:each | (each asAthensPaintOn: anAthensCanvas ) asStrokePaintOn: anAthensCanvas]! !

!AthensCompositeStrokePaint methodsFor: 'drawing' stamp: 'NicolaiHess 1/15/2015 10:23'!
athensFillRectangle: aRect on: anAthensCanvas
	"This is a terminal method in rendering dispatch scheme
	canvas->shape->paint. See AthensCanvas>>fillShape: "

	| r |
	r := aRect.
	strokePaints
		do: [ :paint | 
			paint athensFillRectangle: r on: anAthensCanvas.
			withInset ifTrue:[r := r insetBy: paint width ]]! !

!AthensCompositeStrokePaint methodsFor: 'accessing' stamp: 'NicolaiHess 1/15/2015 10:20'!
withInset: aBoolean
	withInset := aBoolean! !

!AthensCubicBezier commentStamp: '<historical>'!
Cubic bezier with 4 control points encapsulation.

Main purpose of this class is to keep subdivision logic in clean and separate place!
!AthensCubicBezier methodsFor: 'accessing' stamp: 'IgorStasenko 4/26/2013 17:07'!
x4: anObject
	
	x4 := anObject! !

!AthensCubicBezier methodsFor: 'accessing' stamp: 'IgorStasenko 4/26/2013 17:07'!
x3
	
	^ x3! !

!AthensCubicBezier methodsFor: 'accessing' stamp: 'IgorStasenko 4/26/2013 17:07'!
x4
	
	^ x4! !

!AthensCubicBezier methodsFor: 'accessing' stamp: 'IgorStasenko 4/26/2013 17:07'!
x3: anObject
	
	x3 := anObject! !

!AthensCubicBezier methodsFor: 'accessing' stamp: 'IgorStasenko 4/26/2013 17:07'!
y2
	
	^ y2! !

!AthensCubicBezier methodsFor: 'accessing' stamp: 'IgorStasenko 4/26/2013 17:07'!
y3
	
	^ y3! !

!AthensCubicBezier methodsFor: 'accessing' stamp: 'IgorStasenko 4/26/2013 17:07'!
x1
	
	^ x1! !

!AthensCubicBezier methodsFor: 'subdivision' stamp: 'IgorStasenko 4/24/2013 16:21'!
subdivideAt: t do: aBinaryBlock
	| x12 y12 x23 y23 x34 y34 x1223 y1223 x2334 y2334 xsplit ysplit |
	
	x12 := x1 interpolateTo: x2 at: t.
	y12 := y1 interpolateTo: y2 at: t.
	x23 := x2 interpolateTo: x3 at: t.
	y23 := y2 interpolateTo: y3 at: t.
	x34 := x3 interpolateTo: x4 at: t.
	y34 := y3 interpolateTo: y4 at: t.

	x1223 := x12 interpolateTo: x23 at: t.
	x2334 := x23 interpolateTo: x34 at: t.
	y1223 := y12 interpolateTo: y23 at: t.
	y2334 := y23 interpolateTo: y34 at: t.
	
	xsplit := x1223 interpolateTo: x2334 at: t.
	ysplit := y1223 interpolateTo: y2334 at: t.
	
	^ aBinaryBlock 
		value: 
		"p1 - p12 - p1223 - psplit"
		(self copy 
			x2: x12;
			y2: y12;
			x3: x1223;
			y3: y1223;
			x4: xsplit;
			y4: ysplit )
		value:
		"psplit - p2334 - p34 - p4" 
		(self copy 
			x1: xsplit;
			y1: ysplit;
			x2: x2334;
			y2: y2334;
			x3: x34;
			y3: y34
		)	
! !

!AthensCubicBezier methodsFor: 'accessing' stamp: 'IgorStasenko 4/26/2013 17:07'!
y3: anObject
	
	y3 := anObject! !

!AthensCubicBezier methodsFor: 'accessing' stamp: 'IgorStasenko 4/26/2013 17:07'!
y4
	
	^ y4! !

!AthensCubicBezier methodsFor: 'accessing' stamp: 'IgorStasenko 4/26/2013 17:07'!
y1
	
	^ y1! !

!AthensCubicBezier methodsFor: 'accessing' stamp: 'IgorStasenko 4/26/2013 17:07'!
x2: anObject
	
	x2 := anObject! !

!AthensCubicBezier methodsFor: 'subdivision' stamp: 'IgorStasenko 4/29/2013 21:42'!
recursiveSubDiv: flattener level: level

	| dx dy d2 d3 da1 da2 k f1 f2 |
	
	
	" Try to approximate the full cubic curve by a single straight line "
	level > flattener subdivisionLimit ifTrue: [  ^ self ].
	
	dx := x4-x1.
	dy := y4-y1.

	d2 := ((x2 - x4) * dy - ((y2 - y4) * dx)) abs.
	d3 := ((x3 - x4) * dy - ((y3 - y4) * dx)) abs.

	f1 := d2 > flattener curveCollinearityEpsilon.
	f2 := d3 > flattener curveCollinearityEpsilon.
	

	f1 ifTrue: [ 
		f2 ifTrue: [
			" Regular case "
			
			(d2 + d3) squared <= (flattener distanceToleranceSquared * (dx squared + dy squared)) ifTrue: [ 
				"If the curvature doesn't exceed the distance_tolerance value
				we tend to finish subdivisions."
			"	flattener accountForAngleTolerance ifFalse: [
					^ flattener lineToX: (x2 interpolateTo: x3 at: 0.5) y: (y2 interpolateTo: y3 at: 0.5)
					].
			"
				"Angle & Cusp Condition"

				k := (y3-y2) arcTan: (x3 - x2).
				da1 := (k - ((y2-y1) arcTan: (x2-x1))) abs.
				da2 := ((y4-y3 arcTan: x4-x3) - k) abs.

				da1 >= Float pi ifTrue: [  da1 := Float pi*2 - da1 ].
				da2 >= Float pi ifTrue: [  da2 := Float pi*2 - da2 ].
			
				(da1 + da2) < flattener angleTolerance ifTrue: [ 
					" Finally we can stop the recursion "
					^ flattener lineToX: (x2 interpolateTo: x3 at: 0.5) y: (y2 interpolateTo: y3 at: 0.5)
					 ].
		 
				(flattener overCuspLimit: da1) ifTrue: [ ^ flattener lineToX: x2 y: y2 ].
            	   	(flattener overCuspLimit: da2) ifTrue: [ ^ flattener lineToX: x3 y: y3 ].
			]
			
		] ifFalse: [ 
			
			"p1,p3,p4 are collinear, p2 is significant"

			(d2 squared <= (flattener distanceToleranceSquared * (dx squared + dy squared) )  )
				ifTrue: [
					flattener accountForAngleTolerance ifFalse: [ 
						^ flattener lineToX: (x2 interpolateTo: x3 at: 0.5)  y: (y2 interpolateTo: y3 at: 0.5) ].

					"Angle Condition"
					da1 := ((y3-y2 arcTan: (x3-x2)) - (y2-y1 arcTan:(x2-x1))) abs.
					da1 >= Float pi ifTrue: [  da1 := Float pi * 2 - da1 ].
					
					da1 < flattener angleTolerance ifTrue: [ 
						^ flattener 
							lineToX: x2 y: y2;
							lineToX: x3 y: y3 ].
						
					(flattener overCuspLimit: da1) ifTrue: [ ^ flattener lineToX: x2 y: y2 ]
				]			
			 ]
	] ifFalse: [
		f2 ifTrue: [
		"p1,p2,p4 are collinear, p3 is significant "
			
			(d3 squared <= (flattener distanceToleranceSquared * (dx squared + dy squared) )  )
				ifTrue: [
					flattener accountForAngleTolerance ifFalse: [ 
						^ flattener lineToX: (x2 interpolateTo: x3 at: 0.5)  y: (y2 interpolateTo: y3 at: 0.5) ].

					"Angle Condition"
					da1 := ((y4-y3 arcTan: (x4-x3)) - (y3-y2 arcTan:(x3-x2))) abs.
					da1 >= Float pi ifTrue: [  da1 := Float pi * 2 - da1 ].
					
					da1 < flattener angleTolerance ifTrue: [ 
						^ flattener 
							lineToX: x2 y: y2;
							lineToX: x3 y: y3 ].
						
					(flattener overCuspLimit: da1) ifTrue: [ ^ flattener lineToX: x3 y: y3 ]
				]			
			  ] ifFalse: [
		"All collinear OR p1==p4 "
			k := dx*dx + (dy*dy).
			
			(k = 0.0) ifTrue: [
				d2 := (x1-x2) squared + (y1-y2) squared.
				d3 := (x3-x4) squared + (y3-y4) squared ] 
			ifFalse: [ 

				k := 1 / k.
				da1 := x2 - x1.
				da2 := y2 - y1.
				d2  := k * (da1*dx + (da2*dy)).
				da1 := x3 - x1.
				da2 := y3 - y1.
				d3  := k * (da1*dx + (da2*dy)).
				
				(d2 > 0.0 and: [ d2 < 1.0 and: [d3>0.0 and: [d3 < 1.0]]]) ifTrue: [ 
						" Simple collinear case, 1---2---3---4  We can leave just two endpoints"
							^ self ].
				d2 <= 0.0 
					ifTrue: [ d2 := (x1-x2) squared + (y1-y2) squared ]
					ifFalse: [  
						d2 >= 1.0 
							ifTrue: [ d2 := (x2-x4) squared + (y2-y4) squared ]
							ifFalse: [ d2 := (x2 - x1 - (d2*dx)) squared + (y2 - y1 - (d2*dy)) squared ]].

				d3 <= 0.0 
					ifTrue: [  d3 := (x3-x1) squared + (y3-y1) squared ]
					ifFalse: [ 
						d3 >= 1.0 
							ifTrue: [ d3 := (x3-x4) squared + (y3-y4) squared   ]
							ifFalse: [ d3 := (x3 - x1 - (d3*dx)) squared + (y3-y1- (d3*dy)) squared ]].
			].

			(d2 > d3) ifTrue: [
				(d2 < flattener distanceToleranceSquared)
					ifTrue: [ ^ flattener lineToX: x2 y: y2 ]
				]
			ifFalse: [ 
				(d3 < flattener distanceToleranceSquared )
					ifTrue: [  ^ flattener lineToX: x3 y: y3 ]
				 ].
		]
	].
	self subdivideAt: 0.5 do:  [  :b1 :b2 |
		b1 recursiveSubDiv: flattener level: level +1.	
		b2 recursiveSubDiv: flattener level: level +1.	
	].
	! !

!AthensCubicBezier methodsFor: 'accessing' stamp: 'IgorStasenko 4/26/2013 17:07'!
x1: anObject
	
	x1 := anObject! !

!AthensCubicBezier methodsFor: 'accessing' stamp: 'IgorStasenko 4/26/2013 17:07'!
x2
	
	^ x2! !

!AthensCubicBezier methodsFor: 'accessing' stamp: 'IgorStasenko 4/26/2013 17:07'!
y1: anObject
	
	y1 := anObject! !

!AthensCubicBezier methodsFor: 'accessing' stamp: 'IgorStasenko 4/26/2013 17:07'!
y4: anObject
	
	y4 := anObject! !

!AthensCubicBezier methodsFor: 'accessing' stamp: 'IgorStasenko 4/26/2013 17:07'!
y2: anObject
	
	y2 := anObject! !

!AthensCubicSegment commentStamp: 'IgorStasenko 3/7/2012 13:32'!
i represent a cubic Bezier path segment!
!AthensCubicSegment methodsFor: 'accessing' stamp: 'JochenRick 1/8/2014 08:11'!
via2reflected
	^self endPoint * 2 - via2! !

!AthensCubicSegment methodsFor: 'accessing' stamp: 'FernandoOlivero 2/14/2012 08:17'!
from: origin
	via: controlPoint
	and: secondControlPoint
	to: destination
	
	
	via1:= controlPoint.
	via2 := secondControlPoint.
	to := destination.! !

!AthensCubicSegment methodsFor: 'accessing' stamp: 'FernandoOlivero 2/14/2012 08:09'!
via2
	^ via2! !

!AthensCubicSegment methodsFor: 'visitor' stamp: 'IgorStasenko 4/18/2013 04:39'!
accept: aVisitor
	^ aVisitor cubicBezierSegment: self! !

!AthensCubicSegment methodsFor: 'visitor' stamp: 'IgorStasenko 4/18/2013 05:22'!
sendCommandTo: aBuilder
	^ aBuilder curveVia: via1 and: via2  to: to 
	! !

!AthensCubicSegment methodsFor: 'accessing' stamp: 'FernandoOlivero 2/14/2012 08:09'!
via1
	^ via1! !

!AthensCubicSegment methodsFor: 'accessing' stamp: 'FernandoOlivero 2/14/2012 08:05'!
to

	^ to! !

!AthensCubicSegment methodsFor: 'accessing' stamp: 'FernandoOlivero 2/14/2012 11:39'!
endPoint
	^ to! !

!AthensCubicSegment methodsFor: 'testing' stamp: 'JochenRick 1/8/2014 06:32'!
isCubic
	^true! !

!AthensCurveFlattener commentStamp: '<historical>'!
This converter flattens all curves by converting them to series of lines.
This means that path can be rendered using simple polygon rendering technique
and nothing else.!
!AthensCurveFlattener methodsFor: 'path commands' stamp: 'IgorStasenko 4/18/2013 21:46'!
lineTo: aPoint 

	endPoint := aPoint.
	
	^ dest lineTo: aPoint! !

!AthensCurveFlattener methodsFor: 'accessing' stamp: 'IgorStasenko 4/18/2013 17:56'!
toleranceMultiplier: aToleranceMultiplier

	"	
	A tolerance multiplier is a number .. which
		if = 1 , the default error tolerance is used,
		if > 1 you will get more coarse approximation
		if < 1 you will get more finer approximation
	
	"
	
	lengthTolerance := aToleranceMultiplier.
	lengthToleranceSquared := lengthTolerance squared.
	
! !

!AthensCurveFlattener methodsFor: 'path commands' stamp: 'IgorStasenko 4/18/2013 21:47'!
curveVia: via to: end 
	| pt1 pt2 pt3 |
	
	pt1 := transform transform: endPoint.
	pt2 := transform transform: via.
	pt3 := transform transform: end.
	
	endPoint := end.

	self flattenQuadBezier: pt1 x y1: pt1 y x2: pt2 x y2: pt2 y x3: pt3 x y3: pt3 y.
! !

!AthensCurveFlattener methodsFor: 'subdivision callbacks' stamp: 'IgorStasenko 4/29/2013 21:32'!
overCuspLimit: angleInRadians
	 "if(m_cusp_limit !!= 0.0)
                {
                    if(da1 > m_cusp_limit)
                    {
	
	^ angleInRadians > 1.01"
	^ false. ! !

!AthensCurveFlattener methodsFor: 'accessing' stamp: 'IgorStasenko 4/18/2013 21:59'!
defaultTolerance
	^ 1! !

!AthensCurveFlattener methodsFor: 'subdivision callbacks' stamp: 'IgorStasenko 4/25/2013 01:14'!
lineToX: trX y: trY

	^ dest lineTo: (self inverseTransform: trX @ trY) ! !

!AthensCurveFlattener methodsFor: 'helpers' stamp: 'IgorStasenko 4/18/2013 18:06'!
inverseTransform: aPoint 
	^ transform inverseTransform: aPoint! !

!AthensCurveFlattener methodsFor: 'path commands' stamp: 'IgorStasenko 4/18/2013 18:04'!
moveTo: aPoint 

	contourStartPt := endPoint := aPoint.
	
	^ dest moveTo: aPoint! !

!AthensCurveFlattener methodsFor: 'subdivision callbacks' stamp: 'IgorStasenko 4/29/2013 21:48'!
accountForAngleTolerance
	" It's important only when we want to draw an equidistant curve, that is, a stroke of considerable width. If we don't need to draw a stroke or the stroke width is one pixel or less, the distance criterion works quite well. "
	^ false.! !

!AthensCurveFlattener methodsFor: 'subdivision callbacks' stamp: 'IgorStasenko 5/2/2013 17:43'!
distanceToleranceSquared
	^ self lengthToleranceSquared ! !

!AthensCurveFlattener methodsFor: 'subdivision callbacks' stamp: 'IgorStasenko 4/29/2013 21:48'!
angleTolerance
	^ CurveAngleToleranceEpsilon ! !

!AthensCurveFlattener methodsFor: 'initialize-release' stamp: 'IgorStasenko 4/18/2013 17:58'!
initialize

	super initialize.
	
	transform := AthensAffineTransform new. "identity"
	self toleranceMultiplier: self defaultTolerance! !

!AthensCurveFlattener methodsFor: 'path commands' stamp: 'IgorStasenko 4/26/2013 17:34'!
curveVia: via1 and: via2 to: end 
	| pt1 pt2 pt3 pt4 curve |
	
	pt1 := transform transform: endPoint.
	pt2 := transform transform: via1.
	pt3 := transform transform: via2.
	pt4 := transform transform: end.
	
	endPoint := end.

	curve := AthensCubicBezier new
		x1: pt1 x;
		y1: pt1 y;
		x2: pt2 x;
		y2: pt2 y;
		x3: pt3 x;
		y3: pt3 y;
		x4: pt4 x;
		y4: pt4 y.
		
	curve recursiveSubDiv: self level: 0.
	self lineTo: endPoint.
	
	! !

!AthensCurveFlattener methodsFor: 'subdivision callbacks' stamp: 'IgorStasenko 4/25/2013 00:59'!
curveCollinearityEpsilon

	^ CurveCollinearityEpsilon ! !

!AthensCurveFlattener methodsFor: 'public API' stamp: 'ClementBera 6/28/2013 10:29'!
flattenPath: aPath transform: aTransformation

	"This is an entry point for flattening path.
	An additional argument, transform is an Affine matrix, used to map path geometry to screen,
	and therefore used to calculate the error tolerance for path subdivisions"
	
	^ self flattenPath: aPath transform: aTransformation toleranceMultiplier: 1 ! !

!AthensCurveFlattener methodsFor: 'helpers' stamp: 'IgorStasenko 4/18/2013 23:34'!
flattenQuadBezier: x1 y1: y1 x2: x2 y2: y2 x3: x3 y3: y3

	"Recursively subdive quadric bezier curve as long as #isFlatBezier.. answers false "

	"The points here is unboxed intentionally to avoid generating extra garbage
	(which contributes to performance loss)"

	(self isFlatQuadBezier: x1 y1: y1 x2: x2 y2: y2 x3: x3 y3: y3) ifTrue: [
		| midx midy |
		midx := (x2 + x1 + x2+x3) * 0.25 .  "mid ( mid(pt1,pt2), mid(pt2,pt3)) "
		midy := (y2 + y1 + y2+y3) * 0.25 . 

		dest 
			lineTo: (self inverseTransform: midx @ midy);
			lineTo: (self inverseTransform: x3 @ y3)
			
	"	dest 
			lineTo: (self inverseTransform: x2 @ y2);
			lineTo: (self inverseTransform: x3 @ y3)
	"
	
	] ifFalse: [
		| x12 y12 x23 y23 x123 y123 |	
	"calculate midpoints of line segments "
		x12 := (x1 + x2) * 0.5.
		y12 := (y1 + y2) * 0.5 .

		x23 := (x2 + x3) * 0.5 .
		y23 := (y2 + y3) * 0.5 .

		x123 := (x12 + x23) * 0.5.
		y123 := (y12 + y23) * 0.5.
		
		self flattenQuadBezier: x1 y1: y1 
			x2: x12 
			y2: y12 
			x3: x123 
			y3: y123.
			
		self flattenQuadBezier: x123 
			y1: y123
			x2: x23
			y2: y23 
			x3: x3 
			y3: y3.
	]
! !

!AthensCurveFlattener methodsFor: 'accessing' stamp: 'IgorStasenko 4/18/2013 17:49'!
lengthToleranceSquared

	^ lengthToleranceSquared! !

!AthensCurveFlattener methodsFor: 'helpers' stamp: 'IgorStasenko 4/19/2013 22:17'!
flattenCubicBezier: x1 y1: y1 x2: x2 y2: y2 x3: x3 y3: y3 x4: x4 y4: y4
! !

!AthensCurveFlattener methodsFor: 'accessing' stamp: 'IgorStasenko 4/18/2013 17:49'!
lengthTolerance

	^ lengthTolerance! !

!AthensCurveFlattener methodsFor: 'visiting' stamp: 'IgorStasenko 4/18/2013 17:24'!
quadricBezierSegment: segment
	| pt1 pt2 pt3 |
	
	pt1 := transform transform: endPoint.
	pt2 := transform transform: segment via.
	pt3 := transform transform: segment endPoint.
	
	endPoint := segment endPoint.

	self flattenQuadBezier: pt1 x y1: pt1 y x2: pt2 x y2: pt2 y x3: pt3 x y3: pt3 y.
! !

!AthensCurveFlattener methodsFor: 'subdivision callbacks' stamp: 'IgorStasenko 5/2/2013 17:43'!
subdivisionLimit
	"max number of recursive subdivisions for single curve"
	^ SubdivisionLimit ! !

!AthensCurveFlattener methodsFor: 'accessing' stamp: 'IgorStasenko 4/18/2013 17:56'!
transform: aTransform 
	"
	- transform is an Affine matrix, used to map path geometry to screen,
	and therefore used to calculate the error tolerance for path subdivisions
	
	
	- a tolerance multiplier is a number .. which
		if = 1 , the default error tolerance is used,
		if > 1 you will get more coarse approximation
		if < 1 you will get more finer approximation
	
	"
	
	transform := aTransform.
	
! !

!AthensCurveFlattener methodsFor: 'public API' stamp: 'IgorStasenko 4/18/2013 17:48'!
flattenPath: aPath transform: aTransform toleranceMultiplier: aToleranceMultiplier

	"This is an entry point for flattening path (converting all curves into line segments by approximating them).
	
	- transform is an Affine matrix, used to map path geometry to screen,
	and therefore used to calculate the error tolerance for path subdivisions
	
	
	- a tolerance multiplier is a number .. which
		if = 1 , the default error tolerance is used,
		if > 1 you will get more coarse approximation
		if < 1 you will get more finer approximation
	
	"
	
	transform := aTransform.
	lengthTolerance := aToleranceMultiplier.
	lengthToleranceSquared := lengthTolerance squared.
	
! !

!AthensCurveFlattener methodsFor: 'helpers' stamp: 'IgorStasenko 4/18/2013 22:33'!
isFlatQuadBezier: x1 y1: y1 x2: x2 y2: y2 x3: x3 y3: y3

	| dx dy d da |
	
	dx := x3-x1.
	dy := y3-y1.
	
	"This is the area of triangle enclosing curve * 2"
 	d := (((x2 - x3) * dy) - ((y2 - y3) * dx)) abs.

	d > (self lengthToleranceSquared ) ifTrue: [
		
		"Non-collinear case (regular one)"
		| dot |

		"if dot product is close to zero, that means we having flat curve"			
		dot := ( (x2-x1)*(x2-x3) + ((y1-y2)*(y2-y3)) ) abs.
		dot < (self lengthToleranceSquared * 0.5 ) ifTrue: [  ^ true ].
	]
	ifFalse: [ 
		"collinear"
		da := dx*dx + (dy*dy).
		
		da = 0 "end points coincide"
			ifTrue: [ d := (x1-x2) squared + (y1-y2) squared  "pointy case" ]
			ifFalse: [
				"the control point lies on line between endpoints?"
				d := ((x2 - x1)*dx + ((y2 - y1)*dy)) / da.

				(d > 0.0 and: [ d < 1.0 ] ) ifTrue: [ 
					"Simple collinear case, 1---2---3" 
					^ true
     				].
				d <= 0.0 
					ifTrue: [ d := (x1-x2) squared + (y1-y2) squared ]
					ifFalse: [
						d >= 1.0 
							ifTrue: [ d:= (x2-x3) squared + (y2-y3) squared ]
							ifFalse: [ d:= (x2 - x1 - (d*dx)) squared + (y2 - y1 - (d*dy)) squared ]
					].
			].

			d < (self lengthToleranceSquared) ifTrue: [ ^ true ]		
	].

	^ false! !

!AthensCurveFlattener class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 4/26/2013 17:40'!
initialize
	CurveCollinearityEpsilon := 1e-30 asFloat.
	CurveDistanceEpsilon := 1e-30 asFloat.
	CurveAngleToleranceEpsilon := 0.01.
	SubdivisionLimit := 10.! !

!AthensDemoMorph commentStamp: 'TorstenBergmann 9/5/2014 17:38'!
Demos for Athens, just run:

   AthensDemoMorph example

You can find an implementation of each figure in
corresponding #figure<#>: method!
!AthensDemoMorph methodsFor: 'accessing' stamp: ''!
nextFigure

	current := current + 1.
	
	current > self figures size ifTrue: [ current := 1 ].! !

!AthensDemoMorph methodsFor: 'figures' stamp: 'FernandoOlivero 4/19/2012 14:38'!
figure9: aCanvas
	| pt ellipsePath patternPaint |
	ellipsePath := aCanvas createPath: [ :builder |
		builder
			moveTo: 10@200;
			cwArcTo: 360@0  angle: Float pi ;
			lineTo: -100@180;
			lineTo: -150@ -0;
			lineTo: -110@ -180].

	aCanvas setPaint: Color black.
	aCanvas drawShape: ellipsePath.

	aCanvas paintTransform loadIdentity.
	aCanvas paintTransform scaleBy: ((frame/200) sin abs)*3.
	
	
	patternPaint := aCanvas setPaint: esugBallon .
	patternPaint setExtend: #None.
	aCanvas draw.! !

!AthensDemoMorph methodsFor: 'drawing' stamp: 'IgorStasenko 3/30/2012 16:52'!
wheelColor
	^ Color brown darker! !

!AthensDemoMorph methodsFor: 'accessing' stamp: ''!
defaultExtent
	^ 400@400! !

!AthensDemoMorph methodsFor: 'figures' stamp: 'IgorStasenko 4/12/2013 10:06'!
figure6: aCanvas
	| pt c linearGradient |
	
	self figure5: aCanvas.
	
	linearGradient := 
		aCanvas surface createLinearGradient: {
			0 -> self coloredCarColor .
			0.25 -> self coloredCarColor muchLighter.
			0.5 -> Color white.
			0.75 -> (self coloredCarColor muchLighter ).
			1 -> (self coloredCarColor alpha: 0)	
		}
		start:  0@100  
		stop: 0@300.
	
	aCanvas setShape: (self roundedRectanglePathOn: aCanvas).
	
	aCanvas setPaint: linearGradient.
	
	aCanvas draw.
		! !

!AthensDemoMorph methodsFor: 'initialize-release' stamp: 'NicolaiHess 6/17/2014 21:55'!
initialize 
	| ref loadFileFailBlock|
	super initialize.
	self extent: self defaultExtent.
	self color: self backColor.
	surface := AthensCairoSurface extent: self extent.
	current := 1.
	frame := 0.
      loadFileFailBlock:= AthensCairoSurface fromForm:(Form fromDisplay: (0@0 extent:(300@150))).
	ref := 	'Pharo.png' asFileReference.
	pharoLogo := AthensCairoSurface createFromFile:  ref fullName ifFailed:  [ loadFileFailBlock ].

	ref := 'esug-balloon.png' asFileReference.
	esugBallon := AthensCairoSurface createFromFile:  ref fullName ifFailed:  [ loadFileFailBlock ].

	
	self startStepping.
	! !

!AthensDemoMorph methodsFor: 'accessing' stamp: 'FernandoOlivero 3/30/2012 11:51'!
carColor
	^ Color veryVeryLightGray! !

!AthensDemoMorph methodsFor: 'figures' stamp: 'IgorStasenko 3/30/2012 16:42'!
roundedRectanglePathOn: aCanvas

	^ aCanvas createPath: [:builder |
		builder
			absolute;
			moveTo: 70@100;
			lineTo: 330@100;
			cwArcTo: 350@120 angle: 90 degreesToRadians;
			lineTo: 350@280;
			cwArcTo: 330@300 angle: 90 degreesToRadians;
			lineTo: 70@300;
			cwArcTo: 50@280 angle: 90 degreesToRadians;
			lineTo: 50@120;
			cwArcTo: 70@100 angle: 90 degreesToRadians
	].

! !

!AthensDemoMorph methodsFor: 'drawing' stamp: 'IgorStasenko 3/30/2012 18:22'!
render 

	surface drawDuring: [:canvas | 
		surface clear.
		canvas pathTransform loadIdentity.
		canvas setPaint: Color lightGray;
		drawShape: (0@0 corner: self extent).
		self perform: (self figures at: current)  with: canvas
	].
! !

!AthensDemoMorph methodsFor: 'initialize-release' stamp: 'FernandoOlivero 4/19/2012 14:21'!
figures
	^ #(
	figure1:
	figure2:
	figure3:
	figure4:
	figure5:
	figure6:
	figure7:
	figure8:
	figure9:
	figure10:
	).
	
	! !

!AthensDemoMorph methodsFor: 'figures' stamp: 'DamienPollet 12/22/2012 01:38'!
figure7: aCanvas
	| pt |

	self drawBackgroundOn: aCanvas.

	pt := aCanvas pathTransform.

	pt restoreAfter:[

		pt scaleBy: self extent .
		self drawCarOn: aCanvas.

		pt scaleBy: 0.25@0.25. 
		self drawCarOn: aCanvas.
	
		pt  translateBy: 2@0; rotateByDegrees: 35.
		self drawCarOn: aCanvas.
	].
		! !

!AthensDemoMorph methodsFor: 'accessing' stamp: 'FernandoOlivero 3/30/2012 15:17'!
stepTime
	^ 0! !

!AthensDemoMorph methodsFor: 'drawing' stamp: 'FernandoOlivero 3/30/2012 15:00'!
drawBackgroundOn: aCanvas
	aCanvas setPaint: Color veryLightGray; drawShape: (0@0 extent: 1@1)! !

!AthensDemoMorph methodsFor: 'accessing' stamp: 'FernandoOlivero 3/30/2012 14:24'!
chasisLineColor
	^ Color white! !

!AthensDemoMorph methodsFor: 'figures' stamp: 'IgorStasenko 3/30/2012 18:26'!
figure3: aCanvas
	| pt path |
	
	path := aCanvas createPath: [:builder |
		builder
			relative;
			moveTo: 0.3@0.3 ;
			lineTo: 0.4@0;
			curveVia: 0.1@0 to: 0.1@0.1;
			lineTo: 0@0.2;
			curveVia: 0@0.1 to: -0.1@0.1;
			lineTo: -0.4@0;
			curveVia: -0.1@0 to: (-0.1@ -0.1);
			lineTo: 0@ -0.2  ;
			curveVia: 0@ -0.1 to: 0.1@ -0.1 ].

	aCanvas pathTransform scaleBy: self extent.
	aCanvas
		setPaint: self carColor;
		drawShape: path 
! !

!AthensDemoMorph methodsFor: 'drawing' stamp: 'IgorStasenko 3/30/2012 18:23'!
drawOn: aCanvas

	self render.

	aCanvas
		drawImage: surface asForm at: self bounds origin! !

!AthensDemoMorph methodsFor: 'figures' stamp: 'IgorStasenko 3/30/2012 18:29'!
figure4: aCanvas
	| path stroke |
	
	path := self roundedRectanglePathOn: aCanvas.
	
	aCanvas setShape: path.
	
	aCanvas setPaint: self carColor.
	aCanvas draw.
	
	stroke := aCanvas setStrokePaint: Color black.
	stroke width: 3.
	
	aCanvas draw. ! !

!AthensDemoMorph methodsFor: 'figures' stamp: 'IgorStasenko 3/30/2012 18:27'!
figure8: aCanvas
	| pt |
	pt := aCanvas pathTransform.
	pt restoreAfter:[
		| stroke p  wheel decorator |
		pt scaleBy: self extent .
		self drawBackgroundOn: aCanvas.

		pt scaleBy: (frame/100) sin abs.
		self drawCarOn: aCanvas.
		pt scaleBy: 0.25@0.2.5. 
		self drawCarOn: aCanvas.
	
		pt  translateBy: 2@0; rotateByDegrees: 35.
		self drawCarOn: aCanvas.
	
	  ].
		! !

!AthensDemoMorph methodsFor: 'figures' stamp: 'IgorStasenko 3/30/2012 18:25'!
figure2: aCanvas
	| pt path |
	
	path := aCanvas createPath: [:builder |
		builder
			absolute;
			moveTo: 70@100;
			lineTo: 330@100;
			cwArcTo: 350@120 angle: 90 degreesToRadians;
			lineTo: 350@280;
			cwArcTo: 330@300 angle: 90 degreesToRadians;
			lineTo: 70@300;
			cwArcTo: 50@280 angle: 90 degreesToRadians;
			lineTo: 50@120;
			cwArcTo: 70@100 angle: 90 degreesToRadians
	].

	aCanvas
		setPaint: self carColor;
		drawShape: path 
! !

!AthensDemoMorph methodsFor: 'initialize-release' stamp: ''!
backColor
	^ Color white.! !

!AthensDemoMorph methodsFor: 'accessing' stamp: 'FernandoOlivero 3/30/2012 15:20'!
step
	frame := frame + 1.
	self changed! !

!AthensDemoMorph methodsFor: 'drawing' stamp: 'IgorStasenko 3/30/2012 17:20'!
drawCarOn: aCanvas
	"chasis -----------------------------------------------------------------------"
		| p stroke wheel decorator |
	p := aCanvas createPath:[:b|
			b 
				moveTo: 0.3@0.3 ;
				lineTo: 0.4@0;
				curveVia: 0.1@0 to: 0.1@0.1;
				lineTo: 0@0.2;
				curveVia: 0@0.1 to: -0.1@0.1;
				lineTo: -0.4@0;
				curveVia: -0.1@0 to: (0.1@0.1) negated;
				lineTo: 0@0.2 negated ;
				curveVia: 0@0.1 negated to: 0.1@0.1 negated ].
		aCanvas	
			setPaint: self coloredCarColor;
			drawShape: p.
		stroke := aCanvas setStrokePaint: self wheelColor.
		stroke width: 0.01.
		aCanvas draw.
		
		"wheels-----------------------------------------------------------------------"
		wheel := aCanvas createPath:[:b|
			b
				moveTo: 	0.3@0.3;		
				cwArcTo: 0.15@0 angle: Float halfPi ;
				moveTo: 	0.1@0;				
				cwArcTo: 0.15@0 angle: Float halfPi ;					
				moveTo: 	0.0@0.4;				
				cwArcTo: 0.15 negated@0 angle: Float halfPi; 
				moveTo: 	-0.1@0; 
				cwArcTo: 0.15 negated@0 angle: Float halfPi 	].
		aCanvas	
			setPaint: self wheelColor;
			drawShape: wheel.
		
		"chasis decorator-----------------------------------------------------------------------"
		decorator  := aCanvas createPath:[:b|
			b
				moveTo: 	0.2@0.45;	
				lineTo: 0.225@0 ;		
				cwArcTo: 0.15@0 angle: Float halfPi ;
				lineTo: 	0.225@0;				
				lineTo: 0@0.1 ;
				lineTo: -0.225@ 0;
				cwArcTo: -0.15@0 angle: Float halfPi ;
				lineTo: -0.225@ 0	;
				lineTo: 0@0.1 negated].
		stroke := aCanvas setStrokePaint: self chasisDecoratorColor.
		stroke width: 0.01.	
		aCanvas drawShape: decorator.
		aCanvas setPaint: self chasisLineColor.
		aCanvas draw.		
			
			! !

!AthensDemoMorph methodsFor: 'figures' stamp: 'IgorStasenko 3/30/2012 18:26'!
figure5: aCanvas
	| wheels |
	self figure4: aCanvas.

	wheels := aCanvas createPath: [:builder |
		builder
			moveTo:  100@100;		
			cwArcTo: 60@0 angle: 90 degreesToRadians;
			moveTo:  80@0;				
			cwArcTo: 60@0 angle: 90 degreesToRadians;
			moveTo:  0.0@200;
			cwArcTo: -60@0 angle: 90 degreesToRadians;
			moveTo:  -80@0; 
			cwArcTo: -60@0 angle: 90 degreesToRadians ].

	aCanvas	
		setPaint: self wheelColor;
		drawShape: wheels! !

!AthensDemoMorph methodsFor: 'accessing' stamp: ''!
coloredCarColor
	^ Color red! !

!AthensDemoMorph methodsFor: 'accessing' stamp: ''!
prevFigure

	current := current - 1.
	
	current < 1 ifTrue: [ current := self figures size ].! !

!AthensDemoMorph methodsFor: 'figures' stamp: 'IgorStasenko 3/30/2012 18:25'!
figure1: aCanvas
	aCanvas
		setPaint: self carColor;
		drawShape: (50@100 extent: 300@200) 
		! !

!AthensDemoMorph methodsFor: 'accessing' stamp: ''!
chasisDecoratorColor
	^ Color black! !

!AthensDemoMorph methodsFor: 'figures' stamp: 'FernandoOlivero 4/19/2012 14:20'!
figure10: aCanvas
	| pt ellipsePath patternPaint rectangle |
	ellipsePath := aCanvas createPath: [ :builder |
		builder
			moveTo: 0@200;
			cwArcTo: 240@0  angle: Float pi ;
			 cwArcTo: -240@0 angle: Float pi ].
	aCanvas setPaint: Color black.
	aCanvas drawShape: ellipsePath.
	rectangle := 250@40 extent: 140@300.
	aCanvas drawShape: rectangle.


	aCanvas paintTransform loadIdentity.
	aCanvas paintTransform scaleBy: ((frame/100) sin abs)*5.
	aCanvas paintTransform rotateByDegrees: (frame/100) sin * 360.
	
	patternPaint := aCanvas setPaint: pharoLogo.
	patternPaint setExtend: #Repeat.
	aCanvas drawShape: ellipsePath.
	
	aCanvas setPaint: patternPaint.
	patternPaint setExtend: #Reflect.
	aCanvas drawShape: rectangle.
! !

!AthensDemoMorph class methodsFor: 'examples' stamp: 'TorstenBergmann 9/5/2014 17:45'!
example
	"self example"
	
	| demo model window |
	demo := AthensDemoMorph new openInWorld. 
	(model := DynamicComposableModel new)
		instantiateModels: #(backButton ButtonModel forwardButton ButtonModel).
	model backButton label: 'Previous Figure'; action: [ demo prevFigure ].
	model forwardButton label: 'Next Figure'; action: [ demo nextFigure ].
	window := model openWithSpecLayout: (SpecLayout composed
 				   newColumn: [: c | c add: #backButton. c add: #forwardButton ];
    				   yourself).
	window title: 'Athens demos'! !

!AthensDisplayScanner commentStamp: '<historical>'!
An AthensDisplayScanner displays the paragraphs text on an AthensCanvas.!
!AthensDisplayScanner methodsFor: 'displaying' stamp: 'NicolaiHess 1/15/2015 00:21'!
fillTextBackground
	backgroundColor ifNotNil: [ canvas drawShape: (line left @ lineY extent: line width @ line lineHeight) ]! !

!AthensDisplayScanner methodsFor: 'initialization' stamp: 'NicolaiHess 1/15/2015 00:39'!
initWithParagraph: aParagraph andCanvas: anAthensCanvas
	self text: aParagraph text textStyle: aParagraph textStyle.
	canvas := anAthensCanvas! !

!AthensDisplayScanner methodsFor: 'initialization' stamp: 'NicolaiHess 1/14/2015 23:54'!
initialize
	super initialize.! !

!AthensDisplayScanner methodsFor: 'displaying' stamp: 'NicolaiHess 1/15/2015 00:41'!
setFont
	super setFont.
	canvas setFont:font.
	canvas setPaint: foregroundColor! !

!AthensDisplayScanner methodsFor: 'displaying' stamp: 'NicolaiHess 1/15/2015 12:40'!
displayString: string from: startIndex to: stopIndex at: aPoint
	canvas pathTransform
		restoreAfter: [ 
			canvas pathTransform translateBy: aPoint + (0@font ascent).
			canvas drawString: string from: startIndex to: stopIndex ]! !

!AthensDisplayScanner class methodsFor: 'as yet unclassified' stamp: 'NicolaiHess 1/15/2015 00:01'!
for: aParagraph on: anAthensCanvas
	^ self new initWithParagraph: aParagraph andCanvas: anAthensCanvas; yourself! !

!AthensDisplayScanner class methodsFor: 'as yet unclassified' stamp: 'NicolaiHess 1/14/2015 23:58'!
on: anAthensCanvas
	^ self new initWith: anAthensCanvas; yourself! !

!AthensEllipticalArcSegment commentStamp: '<historical>'!
I representing an elliptical arc, using endpoint parametrization:

- initial endpoint (x0,y0), which comes from previous segment
- final endpoint (x1,y1)

- rh, rv , the radii of unrotated ellipse

- Large arc flag: true if more than 180 degrees of the arc is to be traversed (as measured on the unscaled circle), false otherwise

- Sweep flag: true if the arc is to be traversed in the counter-clockwise direction, false otherwise

(not functional yet)!
!AthensEllipticalArcSegment methodsFor: 'visitor' stamp: 'IgorStasenko 4/18/2013 04:42'!
accept: aVisitor
	^ aVisitor ellipticalArcSegment: self! !

!AthensFlakeDemo commentStamp: '<historical>'!
AthensFlakeDemo new openInWindow
!
!AthensFlakeDemo methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 7/2/2012 18:27'!
circle
	^ circle ! !

!AthensFlakeDemo methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 7/2/2012 19:31'!
initialize 

	super initialize.
	self extent: self defaultExtent.

	surface := AthensCairoSurface extent: self extent.

	circle := surface createPath: [:builder |
		builder
			absolute;
			moveTo: -1 @ 0 ; 
			ccwArcTo: 0@ 1 angle: 90 degreesToRadians ;
			ccwArcTo: 1@0 angle: 90 degreesToRadians ;
			ccwArcTo: 0@ -1 angle: 90 degreesToRadians ;
			ccwArcTo: -1@0 angle:  90 degreesToRadians 
	].

	spike := surface createPath: [:builder |
		
		builder
			absolute;
			moveTo:  -0.1 @ 0;
			lineTo: -0.05 @ 1;
			lineTo: 0.05 @ 1;
			lineTo: 0.1 @ 0		
		].

	frame := 1.
	self startStepping.
	
! !

!AthensFlakeDemo methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 7/2/2012 19:18'!
step
	frame := Time millisecondClockValue / 100.
	
	self changed! !

!AthensFlakeDemo methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 12/29/2013 15:38'!
drawOn: aCanvas

	self render.
	surface displayOnMorphicCanvas: aCanvas at: bounds origin. 
! !

!AthensFlakeDemo methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 7/2/2012 19:33'!
drawSpike: canvas


	|  dist |
	
	
	dist := (canvas pathTransform transform: 1@0) - (canvas pathTransform transform: 0@0).
  	dist r < 2 ifTrue: [ ^ self ].
	
	canvas
		setPaint: (Color black alpha: 0.5);
		drawShape: spike.
		
	canvas pathTransform restoreAfter: [
 		canvas pathTransform translateX: 0 Y: 	1;
			scaleBy: 0.5 + ((frame *0.1) sin * 0.1 ).
			
		canvas pathTransform  rotateByDegrees: -180.
		1 to: 2 do:[ :i |
				canvas pathTransform  rotateByDegrees: 120 + ((frame * 0.1) cos * 20).
			canvas pathTransform  restoreAfter:  [
				self drawSpike: canvas.
			]
		].

			
		self drawCircles: canvas
	]

! !

!AthensFlakeDemo methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 7/2/2012 19:16'!
defaultExtent
	^ 800@800! !

!AthensFlakeDemo methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 7/3/2012 16:54'!
render 

	surface drawDuring: [:canvas | 
		canvas pathTransform loadIdentity.
		surface clear. 
		
"		canvas 
			setPaint: Color white;
			drawShape: (0@0 corner: self extent ).
"
		canvas pathTransform
			 translateX: self extent x *0.5  Y:  self extent y * 0.5;
			scaleBy: 160. 
			
		canvas pathTransform  rotateByDegrees:  (frame * 0.5 + ((frame *0.1 + 1.7) cos * 5)).
		1 to: 3 do:[ :i |
			canvas pathTransform  rotateByDegrees: 120.
			self drawSpike: canvas.
		].
		 self drawCircles: canvas
	].
! !

!AthensFlakeDemo methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 7/2/2012 18:21'!
drawCircles: canvas

	canvas pathTransform restoreAfter: [
		
		canvas pathTransform scaleBy: 0.5 .
		
		canvas 
			setPaint: Color black;
			setShape: self circle;
			draw.

		canvas
			pathTransform scaleBy: 0.8.
		canvas
			setPaint: Color white;
			draw.
		canvas 
			pathTransform scaleBy: 0.8.
		canvas
			setPaint: Color black;
			draw
	]! !

!AthensFlakeDemo methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 7/2/2012 19:12'!
stepTime
	^ 0! !

!AthensFontChange commentStamp: 'IgorStasenko 2/6/2012 16:17'!
A command to change the currently selected font!
!AthensFontChange methodsFor: 'rendering' stamp: 'IgorStasenko 10/17/2011 12:50'!
renderOn: anAthensTextRenderer 
	anAthensTextRenderer setCurrentFont: font.! !

!AthensFontChange methodsFor: 'accessing' stamp: 'IgorStasenko 11/10/2011 11:07'!
font
	^ font! !

!AthensFontChange methodsFor: 'accessing' stamp: 'IgorStasenko 10/11/2011 16:55'!
font: aFont
	font := aFont! !

!AthensFontChange class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/11/2011 16:55'!
font: aFont 
	^ self new font: aFont! !

!AthensFontDescription commentStamp: 'FernandoOlivero 1/24/2012 18:30'!
Creates a new font description from a string representation in the form 
"[FAMILY-LIST] [STYLE-OPTIONS] [SIZE]", 

1)FAMILY-LIST is a comma separated list of families optionally terminated by a comma,

2)STYLE_OPTIONS is a whitespace separated list of words where each WORD describes one of style, variant, weight, stretch, or gravity. If STYLE-OPTIONS is missing, then all style options will be set to the default values

3)SIZE is a decimal number (size in points) or optionally followed by the unit modifier "px" for absolute size. 

!
!AthensFontDescription methodsFor: 'cairo-options' stamp: 'FernandoOlivero 1/10/2012 12:12'!
fontSize: aPointSize
	size := aPointSize! !

!AthensFontDescription methodsFor: 'cairo-options' stamp: 'FernandoOlivero 1/14/2012 20:10'!
fontFamily
	^ family! !

!AthensFontDescription methodsFor: 'accessing' stamp: 'FernandoOlivero 1/14/2012 20:07'!
beNormal
	self slant: #normal ; weight: #normal.! !

!AthensFontDescription methodsFor: 'accessing' stamp: 'FernandoOlivero 1/14/2012 20:07'!
beBold
	self weight: #bold! !

!AthensFontDescription methodsFor: 'pango-options' stamp: 'FernandoOlivero 1/17/2012 16:26'!
fontGravity
	^ options at: #gravity! !

!AthensFontDescription methodsFor: 'pango-options' stamp: 'FernandoOlivero 1/17/2012 16:26'!
fontStretch
	^ options at: #stretch! !

!AthensFontDescription methodsFor: 'pango-options' stamp: 'FernandoOlivero 1/17/2012 16:28'!
gravity: aNumber
	options at: #gravity put: aNumber.		
! !

!AthensFontDescription methodsFor: 'cairo-options' stamp: 'FernandoOlivero 1/14/2012 19:52'!
weight: aNumber
	options at: #weight put: aNumber.		
! !

!AthensFontDescription methodsFor: 'cairo-options' stamp: 'FernandoOlivero 1/14/2012 19:42'!
family: aFamilyName
	"CSS2 generic family names: serif, sans-serif, cursive, fantasy, monospace"
	family := aFamilyName.
	! !

!AthensFontDescription methodsFor: 'cairo-options' stamp: 'FernandoOlivero 1/14/2012 20:06'!
fontWeight
	^ options at: #weight ! !

!AthensFontDescription methodsFor: 'pango-options' stamp: 'FernandoOlivero 1/17/2012 16:25'!
fontVariant
	^ options at: #variant ! !

!AthensFontDescription methodsFor: 'cairo-options' stamp: 'FernandoOlivero 1/14/2012 19:52'!
slant: aNumber
	options at: #slant put: aNumber.		
! !

!AthensFontDescription methodsFor: 'initialize-release' stamp: 'FernandoOlivero 1/14/2012 20:08'!
initialize
	super initialize.
	family := 'monospace'.
	options := Dictionary new.
	options
		at:#weight put: #normal; 
		at:#slant put: #normal.
	size := 14.
	! !

!AthensFontDescription methodsFor: 'pango-options' stamp: 'FernandoOlivero 1/17/2012 16:28'!
variant: aNumber
	options at: #variant put: aNumber.		
! !

!AthensFontDescription methodsFor: 'pango-options' stamp: 'FernandoOlivero 1/17/2012 16:28'!
stretch: aNumber
	options at: #stretch put: aNumber.		
! !

!AthensFontDescription methodsFor: 'accessing' stamp: 'FernandoOlivero 1/14/2012 20:06'!
beOblique
	self slant: #oblique! !

!AthensFontDescription methodsFor: 'accessing' stamp: 'FernandoOlivero 1/14/2012 20:06'!
beItalic
	self slant: #italic! !

!AthensFontDescription methodsFor: 'cairo-options' stamp: 'FernandoOlivero 1/14/2012 20:09'!
fontSize
	^ size ! !

!AthensFontDescription methodsFor: 'cairo-options' stamp: 'FernandoOlivero 1/25/2012 01:02'!
fontSlant
	^ options at: #slant ! !

!AthensFontDescription methodsFor: 'accessing' stamp: 'FernandoOlivero 1/17/2012 16:31'!
asString
	"[FAMILY-LIST] [STYLE-OPTIONS] [SIZE]"
	| str |
	str := '' writeStream.
	str nextPutAll:  family; space.
	"	
2)STYLE_OPTIONS is a whitespace separated list of words where each WORD describes one of style, variant, weight, stretch, or gravity. If STYLE-OPTIONS is missing, then all style options will be set to the default values
"
	#(slant. variant. weight. stretch. gravity) do:[:each|
		|val|
		val := options at: each ifAbsent: nil.
		val notNil ifTrue:[str nextPutAll: val ; space ]].
	
	self fontSize notNil ifTrue:[
		str
			space;
			nextPutAll: self fontSize asString ].
	^ str contents! !

!AthensFontDescription class methodsFor: 'examples' stamp: 'FernandoOlivero 1/24/2012 18:43'!
example
	| fDesc |
	fDesc := AthensFontDescription new. 
	fDesc
		family: 'monospace';
		fontSize: 22.
	^ fDesc! !

!AthensGenericTransform commentStamp: '<historical>'!
I am an extended version of my supeclass,
and I represent generic 3x3 matrix.

<Currently I have no use>!
!AthensGenericTransform methodsFor: 'transformations' stamp: 'IgorStasenko 3/26/2011 02:10'!
loadIdentity
	"initialize with identity transform"
	super loadIdentity.
	w0 := w1 := 0.0.
	w2 := 1.0! !

!AthensInteractiveScene commentStamp: '<historical>'!
i am like my superclass, can display any scene (object which understands #renderOn:  message)
and support free-form pan and zoom.

but in addition, i expecting that scene object understands following:

scene handleEvent: event in: sceneView at: position
 
This method should answer true if scene object wants to handle event by itself , preventing default handling of view (pan & zoom).
The point is coordinates of event in scene coordinate space (not screen coordinate space). The event is MorphicEvent (currently limited only to mouse move&button events).

Note that if scene view enters zooming or panning state, no events will be passed to scene object as long as state is active. 


!
!AthensInteractiveScene methodsFor: 'event handling' stamp: 'IgorStasenko 6/1/2013 05:17'!
mouseDown: evt

	((self inState: #panning) or: [ self inState:#zooming ]) 
		ifFalse: [
			(self eventHandledByScene: evt) ifTrue: [ ^ self ]. 	
		].

	^ super mouseDown: evt! !

!AthensInteractiveScene methodsFor: 'event handling' stamp: 'IgorStasenko 6/1/2013 05:08'!
eventPositionInScene: evt
	| pt | 
	
	pt := evt position - self topLeft.
	
	^ transform transform: pt! !

!AthensInteractiveScene methodsFor: 'event handling' stamp: 'IgorStasenko 6/1/2013 05:13'!
eventHandledByScene: evt

	^  true == (scene handleEvent: evt in: self at: (self eventPositionInScene:evt))
	! !

!AthensInteractiveScene methodsFor: 'event handling' stamp: 'IgorStasenko 6/1/2013 05:16'!
mouseUp: evt

	((self inState: #panning) or: [ self inState:#zooming ]) 
		ifFalse: [
			(self eventHandledByScene: evt) ifTrue: [ ^ self ]. 	
		].
		
	^ super mouseUp:evt ! !

!AthensInteractiveScene methodsFor: 'event handling' stamp: 'IgorStasenko 6/1/2013 05:12'!
mouseMove: evt

	((self inState: #panning) or: [ self inState:#zooming ]) 
		ifFalse: [
			(self eventHandledByScene: evt) ifTrue: [ ^ self ]. 	
		].
	^ super mouseMove: evt! !

!AthensLineSegment commentStamp: '<historical>'!
i represent a line segment,
created using 
	#lineTo: 
command of AthensPathBuilder!
!AthensLineSegment methodsFor: 'accessing' stamp: 'IgorStasenko 3/26/2011 16:16'!
point

	^ point! !

!AthensLineSegment methodsFor: 'accessing' stamp: 'IgorStasenko 3/26/2011 16:21'!
endPoint
	^ point! !

!AthensLineSegment methodsFor: 'accessing' stamp: 'IgorStasenko 3/26/2011 16:16'!
point: anObject

	point := anObject! !

!AthensLineSegment methodsFor: 'visitor' stamp: 'NicolaiHess 6/24/2014 20:58'!
visitWith: visitor

	visitor visitLineSegment:  self! !

!AthensLineSegment methodsFor: 'visitor' stamp: 'IgorStasenko 4/18/2013 04:41'!
accept: aVisitor
	^ aVisitor lineSegment: self! !

!AthensLineSegment methodsFor: 'visitor' stamp: 'IgorStasenko 4/18/2013 05:23'!
sendCommandTo: aBuilder
	^ aBuilder lineTo: point
	! !

!AthensMorphScene commentStamp: 'TorstenBergmann 2/12/2014 22:01'!
Allows to render a morph as a scene in athens!
!AthensMorphScene methodsFor: 'accessing' stamp: 'IgorStasenko 5/6/2013 18:09'!
renderOn:aCanvas
	morph fullDrawOnAthensCanvas: aCanvas! !

!AthensMorphScene methodsFor: 'accessing' stamp: 'IgorStasenko 5/6/2013 18:06'!
morph: anObject
	
	morph := anObject! !

!AthensMorphScene methodsFor: 'accessing' stamp: 'IgorStasenko 5/6/2013 18:06'!
morph
	
	^ morph! !

!AthensMorphicGradientPaint commentStamp: '<historical>'!
i am used to convert gradient fill style(s) used in Morphic to appropriate paint(s) in Athens.!
!AthensMorphicGradientPaint methodsFor: 'rendering' stamp: 'NicolaiHess 8/7/2014 11:06'!
athensFillPath: aPath on: canvas
	"This is a terminal method in rendering dispatch scheme
	canvas->shape->paint. See AthensCanvas>>fillShape: "
	
	| fill |
	fill := self convertGradientToPaintOn: canvas.
	fill athensFillPath: aPath on: canvas.
! !

!AthensMorphicGradientPaint methodsFor: 'rendering' stamp: 'NicolaiHess 8/7/2014 11:06'!
athensFillRectangle: aRect on: canvas
	"This is a terminal method in rendering dispatch scheme
	canvas->shape->paint. See AthensCanvas>>fillShape: "
	
	| fill |
	fill := self convertGradientToPaintOn: canvas.
	fill athensFillRectangle: aRect on: canvas.
! !

!AthensMorphicGradientPaint methodsFor: 'private' stamp: 'NicolaiHess 8/7/2014 11:05'!
convertGradientToPaintOn: aCanvas
	"This is a terminal method in rendering dispatch scheme
	canvas->shape->paint. See AthensCanvas>>fillShape: "
	
	^ gradient radial ifTrue: [
		aCanvas surface
			createRadialGradient: gradient colorRamp
			center:  (aCanvas pathTransform inverseTransform: gradient origin )
			radius: gradient direction y ]
	ifFalse: [
		aCanvas surface
			createLinearGradient: gradient colorRamp
			start: (aCanvas pathTransform inverseTransform: gradient origin)
			stop: (aCanvas pathTransform inverseTransform: gradient origin + gradient direction ) ].

! !

!AthensMorphicGradientPaint methodsFor: 'accessing' stamp: 'IgorStasenko 10/11/2012 16:14'!
gradient: aGradient
	gradient := aGradient! !

!AthensMoveSegment commentStamp: 'IgorStasenko 5/2/2011 05:35'!
Move segment always indicates starting of a new contour.
If contour ends with close command, then my insntance will have 'closed' flag set to true.

See AthensPathBuilder , which is responsible for building paths.!
!AthensMoveSegment methodsFor: 'visitor' stamp: 'IgorStasenko 4/18/2013 04:40'!
accept: aVisitor
	^ aVisitor moveSegment: self! !

!AthensMoveSegment methodsFor: 'accessing' stamp: 'FernandoOlivero 1/15/2012 14:59'!
reopen: aBoolean
	closed := aBoolean! !

!AthensMoveSegment methodsFor: 'visitor' stamp: 'IgorStasenko 4/18/2013 05:23'!
sendCommandTo: aBuilder
	^ aBuilder moveTo: point
	! !

!AthensMoveSegment methodsFor: 'testing' stamp: 'IgorStasenko 3/27/2011 17:48'!
isMove
	^ true! !

!AthensMoveSegment methodsFor: 'testing' stamp: 'IgorStasenko 5/2/2011 05:37'!
isClosed
	^ closed == true! !

!AthensMoveSegment methodsFor: 'accessing' stamp: 'IgorStasenko 5/2/2011 05:37'!
closed: aBoolean
	closed := aBoolean! !

!AthensMoveSegment methodsFor: 'visitor' stamp: 'NicolaiHess 6/24/2014 20:57'!
visitWith: visitor

	visitor visitMoveSegment: self! !

!AthensPaint commentStamp: '<historical>'!
I am a base class, which defines a paint.

My subclasses represent a concreate paint by implementing my protocol,  that actually draws a specific shapes with me. My subclasses usually backend-specific, but as long as you implement my protocol, any object can be treated as paint:

 - athensFillPath: aPath on: aCanvas
 - athensFillRectangle: aRectangle on: aCanvas
 - asStrokePaint





!
!AthensPaint methodsFor: 'rendering' stamp: 'IgorStasenko 9/3/2013 14:23'!
athensFillRectangle: aRectangle on: aCanvas
	"This is a terminal method in rendering dispatch scheme
	canvas->shape->paint. See AthensCanvas>>fillShape: "
	
	self subclassResponsibility! !

!AthensPaint methodsFor: 'converting' stamp: 'IgorStasenko 4/27/2012 11:28'!
asStrokePaintOn: aCanvas
	"default implementation"
	^ aCanvas surface createStrokePaintFor: self
	! !

!AthensPaint methodsFor: 'rendering' stamp: 'IgorStasenko 9/3/2013 14:22'!
athensFillPath: aPath on: aCanvas 

	"This is a terminal method in rendering dispatch scheme
	canvas->shape->paint. See AthensCanvas>>fillShape: "
	
	self subclassResponsibility! !

!AthensPaintMode commentStamp: '<historical>'!
A paint mode controls how the incoming color (source) will be transferred to surface (destination).

To set a paint mode for canvas, send a message with corresponding mode name to my instance.
My instance(s) is available via canvas protocol, i.e. 'canvas paintMode'.

For example, to set an 'over' paint mode, use following:

	canvas paintMode over.

If you want to restore original paint mode after performing drawing operations, which may change it, use #restoreAfter: method , i.e. 

	canvas paintMode restoreAfter: [
		.. perform any drawing operations here..
		].

Since different backends may support different set of paint modes, the default implementation in AthensPaintMode for 
all mode setters is to signal an error.
To query a set of available paint modes, supported by backend, use #availableModes message.

!
!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:02'!
dest
	"Set 'dest' drawing mode.
	
	Drawing under this mode will ignore the source, as if nothing drawn"
	
	self notAvailable! !

!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:04'!
atop
	"Set 'atop' painting mode "
	
	self notAvailable! !

!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:04'!
destOver
	
	self notAvailable! !

!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 16:50'!
over
	"Set 'over' drawing mode. This is default paint mode.
	
	Drawing under this mode will blend source with destination color using source alpha component"
	
	self notAvailable! !

!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 16:48'!
in
	self notAvailable! !

!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:05'!
destAtop
	
	self notAvailable! !

!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:05'!
multiply
	self notAvailable! !

!AthensPaintMode methodsFor: 'errors' stamp: 'IgorStasenko 9/1/2012 16:49'!
notAvailable
	^ self error: 'A requested paint mode is not supported by backend'! !

!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:04'!
out
	"Set 'out' painting mode "
	
	self notAvailable! !

!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:06'!
overlay
	self notAvailable! !

!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 16:50'!
source
	"Set 'source' drawing mode.
	
	Drawing under this mode will replace the content with incoming source under the shape boundaries"
	
	self notAvailable! !

!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:07'!
hslSaturation
	self notAvailable! !

!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:05'!
destOut
	
	self notAvailable! !

!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:07'!
hslColor
	self notAvailable! !

!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:02'!
clear
	"Set 'clear' drawing mode.
	
	Drawing under this mode will clear the surface under the shape boundaries"
	
	self notAvailable! !

!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:06'!
screen
	self notAvailable! !

!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:06'!
colorBurn
	self notAvailable! !

!AthensPaintMode methodsFor: 'convenience' stamp: 'IgorStasenko 9/1/2012 14:40'!
restoreAfter: aBlock

	"restore current paint mode after evaluating a block"
	
	self subclassResponsibility! !

!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:06'!
darken
	self notAvailable! !

!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:07'!
difference
	self notAvailable! !

!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:05'!
add
	self notAvailable! !

!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:06'!
colorDodge
	self notAvailable! !

!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:05'!
destIn
	
	self notAvailable! !

!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:07'!
hslLuminosity
	self notAvailable! !

!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:06'!
lighten
	self notAvailable! !

!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:05'!
xor
	self notAvailable! !

!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:06'!
softLight
	self notAvailable! !

!AthensPaintMode methodsFor: 'default mode' stamp: 'IgorStasenko 9/1/2012 16:41'!
default
	"Set the default paint mode. The default paint mode in Athens, is 'over' "
	^ self over! !

!AthensPaintMode methodsFor: 'capabilities' stamp: 'IgorStasenko 9/1/2012 17:01'!
availableModes

	"Answer a collection of paint mode names, currently supported by backend. 
	Different backends may support different sets of paint modes.
	
	You may need to structure your code depending on modes available"
	
	^ #()! !

!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:05'!
saturate
	self notAvailable! !

!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:07'!
hslHue
	self notAvailable! !

!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:06'!
hardLight
	self notAvailable! !

!AthensPaintMode methodsFor: 'modes' stamp: 'IgorStasenko 9/1/2012 17:07'!
exclusion
	self notAvailable! !

!AthensParagraph commentStamp: '<historical>'!
this class is subject of changes/removal. do not use it.!
!AthensParagraph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/21/2011 13:07'!
extraSelectionChanged
"
	refreshExtraSelection := true
"

	self flag: #foo! !

!AthensParagraph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/31/2012 01:28'!
showCared ! !

!AthensParagraph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/21/2011 13:04'!
defaultCharacterBlock
	^ (CharacterBlock new stringIndex: 1 text: text
			topLeft: 0@0 extent: 0 @ 0)
		textLine: lines first! !

!AthensParagraph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/21/2011 12:20'!
textOwner: anUndefinedObject 
	self shouldBeImplemented.! !

!AthensParagraph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/21/2011 13:00'!
positionWhenComposed: pos
	positionWhenComposed := pos! !

!AthensParagraph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/21/2011 13:09'!
selectionStart: startBlock selectionStop: stopBlock
	selectionStart := startBlock.
	selectionStop := stopBlock.! !

!AthensParagraph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/21/2011 13:02'!
selectionColor: anUndefinedObject 
	self shouldBeImplemented.! !

!AthensParagraph methodsFor: 'drawing' stamp: 'IgorStasenko 10/7/2012 23:32'!
drawOnAthensCanvas: canvas bounds: aRectangle 

	| renderer |
	"self halt."
"	canvas
		clipBy: aRectangle 
		during: [  
"			renderer := AthensTextRenderer new.
			renderer render: text lines: lines on: canvas.
"		].
"! !

!AthensParagraph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/31/2012 01:28'!
focused ^ false! !

!AthensParagraph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/21/2011 13:08'!
selectionRects
	^ #()! !

!AthensParagraph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/21/2011 13:05'!
text
	^ text! !

!AthensParagraph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/21/2011 12:48'!
extent
	^ containerRect width @ lines last bottom! !

!AthensParagraph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/21/2011 12:22'!
compose: aText style: aTextStyle from: startingIndex in: aRectangle 
	text := aText.
	textStyle := aTextStyle
	
	self shouldBeImplemented.! !

!AthensParagraph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/31/2012 01:29'!
showCaret: abool  ! !

!AthensParagraph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/21/2011 16:08'!
characterBlockForIndex: index 

		^ self defaultCharacterBlock! !

!AthensParagraph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/21/2011 12:50'!
compose: aText style: aTextStyle in: rect 

	text := aText.
	textStyle := aTextStyle.
	containerRect := rect.
	lines := (AthensTextComposer scan: aText for: AthensTextScanner new) lines.! !

!AthensParagraph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/21/2011 12:45'!
focused: bool

	"why we should care?"
	
	"self flag: #ooo"! !

!AthensParagraph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/21/2011 13:06'!
secondarySelection: aSubString
"	secondarySelection := aSubString."
	self flag: #foo.! !

!AthensParagraph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/31/2012 01:31'!
caretRect ^ (0@0 corner: 0@0)  ! !

!AthensParagraph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/31/2012 01:29'!
showCaret  ! !

!AthensParagraph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/21/2011 13:06'!
findReplaceSelectionRegex: aRegex
"	findReplaceSelectionRegex := aRegex. "
	self flag: #foo
! !

!AthensPath commentStamp: '<historical>'!
This class represents an interface, which should be supported by all paths (special kind of shape) used for drawing with Athens framework.

Path data organization is up to surface where it built,
therefore paths are not interchangeable between different surfaces.

!
!AthensPathBuilder commentStamp: '<historical>'!
i am abstract path builder, to specify an interface protocol which is available for building paths,
by using  canvas or surface #createPath: method.!
!AthensPathBuilder methodsFor: 'path commands' stamp: 'IgorStasenko 3/7/2012 14:27'!
lineTo: aPoint
	"add a line segment, starting from current path endpoint to aPoint"
	
	self subclassResponsibility! !

!AthensPathBuilder methodsFor: 'path commands' stamp: 'IgorStasenko 3/7/2012 14:28'!
cwArcTo: endPt angle: rot
	" Add a clockwise arc segment, starting from current path endpoint and
	ending at andPt. Angle should be specified in radians "
	

	self subclassResponsibility! !

!AthensPathBuilder methodsFor: 'path commands' stamp: 'IgorStasenko 3/7/2012 14:30'!
curveVia: cp1 and: cp2 to: aPoint
	"Add a cubic bezier curve,
	starting from current path endpoint, using control points cp1, cp2
	and ending at aPoint "
	
	self subclassResponsibility 	! !

!AthensPathBuilder methodsFor: 'path commands' stamp: 'IgorStasenko 3/7/2012 14:30'!
close
	"close the current path controur"
	self subclassResponsibility ! !

!AthensPathBuilder methodsFor: 'path commands' stamp: 'IgorStasenko 3/7/2012 14:29'!
curveVia: cp1 to: aPoint

	"Add a quadric bezier curve,
	starting from current path endpoint, using control point cp1, 
	and ending at aPoint "
	
	self subclassResponsibility ! !

!AthensPathBuilder methodsFor: 'path commands' stamp: 'JochenRick 1/8/2014 06:27'!
reflectedCurveVia: cp2 to: aPoint
	"Add a reflected cubic bezier curve, starting from current path endpoint and ending at aPoint.
	The first control point is calculated as a reflection from the current point, if the last command was also a cubic bezier curve.
	Otherwise, the first control point is the current point. The second control point is cp2."
	
	self subclassResponsibility 	! !

!AthensPathBuilder methodsFor: 'path commands' stamp: 'IgorStasenko 3/7/2012 14:27'!
relative

	"next commands will use relative coordinates for all segment points"
	self subclassResponsibility! !

!AthensPathBuilder methodsFor: 'path commands' stamp: 'IgorStasenko 3/7/2012 14:26'!
absolute
	"next commands will use absolute coordinates for all segment points"
	self subclassResponsibility! !

!AthensPathBuilder methodsFor: 'path commands' stamp: 'IgorStasenko 3/7/2012 14:27'!
moveTo: aPoint
	" move command always starts a new contour "
	self subclassResponsibility! !

!AthensPathBuilder methodsFor: 'creating path' stamp: 'IgorStasenko 4/18/2013 17:46'!
createPath:	aBlock

		"aBlock value: self ...."	
	self subclassResponsibility ! !

!AthensPathBuilder methodsFor: 'path commands' stamp: 'IgorStasenko 3/7/2012 14:28'!
ccwArcTo: endPt angle: rot
	" Add a counter-clockwise arc segment, starting from current path endpoint and
	ending at andPt. Angle should be specified in radians "
	

	self subclassResponsibility! !

!AthensPathBuilder class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 3/7/2012 15:26'!
initialize
	ZeroPoint := 0@0! !

!AthensPathBuilder class methodsFor: 'instance creation' stamp: 'IgorStasenko 4/18/2013 17:45'!
createPath: aBlock

	^ self new createPath: aBlock! !

!AthensPathConverter commentStamp: 'IgorStasenko 5/1/2011 23:14'!
i am a base class for path conversion. 
i take a path as input and producing a path commands as output.

My default implementation just passing all path commands without changes to destination without any conversion

Example of use:

 
converter := AthensXYZConverter dest: (AthensPolygonPath new).
convertedPath := converter convert: sourcePath.

You can chain multiple converters:

basicConverter := AthensZYXConv dest: AthensPolygonPath new. 
compoundConverter := AthensABCConverter dest: basicConverter.

compoundConverter convert: somePath

in this case, an initial conversion is performed by instance of AthensABCConverter, and then conversion results are passed down to AthensZYXConv,
and then finally to instance of AthensPolygonPath.
!
!AthensPathConverter methodsFor: 'converting path commands' stamp: 'IgorStasenko 4/29/2011 18:36'!
lineTo: aPoint 
	^ dest lineTo: aPoint! !

!AthensPathConverter methodsFor: 'accessing' stamp: 'IgorStasenko 5/1/2011 22:18'!
dest: anObject
	dest := anObject! !

!AthensPathConverter methodsFor: 'converting path commands' stamp: 'IgorStasenko 5/2/2011 05:18'!
close: aPoint 
	^ dest close: aPoint! !

!AthensPathConverter methodsFor: 'converting path commands' stamp: 'IgorStasenko 4/29/2011 18:31'!
curveVia: pt1 to: pt2

	^ dest curveVia: pt1 to: pt2
! !

!AthensPathConverter methodsFor: 'actions' stamp: 'IgorStasenko 5/1/2011 22:16'!
convert: aSourcePath
	
	" iterate over segments and do conversion "
	
	| segment |
	
	segment := aSourcePath.
	
	[ segment notNil ] whileTrue: [
		segment convertWith: self.
		endPoint := segment endPoint.
		segment := segment next.
	].

	^ dest finish! !

!AthensPathConverter methodsFor: 'accessing' stamp: 'IgorStasenko 4/29/2011 18:18'!
source: aSource dest: aDest

	sourcePath := aSource.
	dest := aDest! !

!AthensPathConverter methodsFor: 'converting path commands' stamp: 'IgorStasenko 4/29/2011 18:28'!
moveTo: aPoint 
	^ dest moveTo: aPoint! !

!AthensPathConverter methodsFor: 'actions' stamp: 'IgorStasenko 5/1/2011 22:13'!
finish
	^ dest finish! !

!AthensPathConverter class methodsFor: 'instance creation' stamp: 'IgorStasenko 5/1/2011 22:20'!
source: aSource dest: aDest
	" answer a converted path from source to dest, using my instance as a converter"
	
	^ self new source: aSource dest: aDest! !

!AthensPathConverter class methodsFor: 'instance creation' stamp: 'IgorStasenko 5/1/2011 22:18'!
dest: aDest

	^ self new dest: aDest! !

!AthensPathSegment commentStamp: '<historical>'!
The path segment is path building block.
Path is formed from list of connected path segments. At building stage, there is no container nor separately defined "path" object, just a linked list of segments.
Later the segments are accumulated in backend-specific path object, and the way how it is organized may vary.

My (sub)instances usually are not created directly by user, but instead by instance
of AthensPathBuilder.
Therefore, all my subclasses are considered private and implementation detail.!
!AthensPathSegment methodsFor: 'accessing' stamp: 'IgorStasenko 4/18/2013 21:51'!
size
	"answer 1 + the number of segments next to receiver"
	
	| segment count |
	segment := self.
	count := 0.
	[ segment notNil ] whileTrue: [  count := count + 1. segment := segment next ].

	^ count.! !

!AthensPathSegment methodsFor: 'iterating' stamp: 'IgorStasenko 4/18/2013 04:52'!
do: aBlock
	| segment |
	
	segment := self.
	
	[  aBlock value: segment. segment := segment next. segment notNil ] whileTrue.! !

!AthensPathSegment methodsFor: 'visitor' stamp: 'IgorStasenko 4/18/2013 04:38'!
accept: aVisitor
	self subclassResponsibility ! !

!AthensPathSegment methodsFor: 'accessing' stamp: 'IgorStasenko 3/26/2011 16:14'!
next

	^ next! !

!AthensPathSegment methodsFor: 'iterating' stamp: 'IgorStasenko 4/18/2013 05:20'!
sendCommandsTo: aBuilder

	self do: [ :segment |
		segment sendCommandTo: aBuilder
	]! !

!AthensPathSegment methodsFor: 'testing' stamp: 'IgorStasenko 3/26/2011 16:44'!
isMove
	^ false! !

!AthensPathSegment methodsFor: 'accessing' stamp: 'IgorStasenko 3/26/2011 16:14'!
next: anObject

	next := anObject! !

!AthensPathSegment methodsFor: 'visitor' stamp: 'IgorStasenko 4/29/2011 18:13'!
convertWith: anObject
	self subclassResponsibility! !

!AthensPathSegment methodsFor: 'visitor' stamp: 'IgorStasenko 4/13/2013 17:33'!
visitWith: visitor

	self subclassResponsibility! !

!AthensPathSegment methodsFor: 'testing' stamp: 'JochenRick 1/8/2014 06:31'!
isCubic
	^ false! !

!AthensPathSegmentConverter commentStamp: '<historical>'!
this class is subject of changes/removal. do not use it.!
!AthensPathSegmentConverter methodsFor: 'converting' stamp: 'IgorStasenko 4/18/2013 17:50'!
convert: aPath
	"pipe the path segments to destination, converting
	segments on the way"
	
	contourStartPt := endPoint := 0@0.
	
	aPath sendCommandsTo: self.
	
	
	! !

!AthensPathSegmentConverter methodsFor: 'accessing' stamp: 'IgorStasenko 4/18/2013 17:39'!
dest: aDest
	dest := aDest! !

!AthensPluggableTextMorph commentStamp: '<historical>'!
this class is subject of changes/removal. do not use it.!
!AthensPluggableTextMorph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/21/2011 12:01'!
textMorphClass
	^ AthensTextMorph! !

!AthensPolygon commentStamp: 'IgorStasenko 12/20/2011 18:38'!
i am special kind of shape which using only straight line segments, unlike from more generic paths.!
!AthensPolygon methodsFor: 'conversion' stamp: 'IgorStasenko 4/29/2011 18:32'!
lineTo: aPoint 
	currentContour add: aPoint! !

!AthensPolygon methodsFor: 'conversion' stamp: 'IgorStasenko 4/29/2011 18:30'!
newContour
	contours ifNil: [ contours := OrderedCollection new ].
	
	currentContour := contours add: OrderedCollection new.! !

!AthensPolygon methodsFor: 'drawing' stamp: 'IgorStasenko 5/2/2011 04:48'!
paintFillsUsing: aPaint on: anAthensCanvas 
	
	"This method is a part of rendering dispatch  Canvas->receiver->paint"
	
	^ aPaint fillPolygon: self on: anAthensCanvas! !

!AthensPolygon methodsFor: 'conversion' stamp: 'IgorStasenko 4/29/2011 18:29'!
moveTo: aPoint 
	" create a new contour "
	
	self newContour.
	currentContour add: aPoint.! !

!AthensPolygon methodsFor: 'conversion' stamp: 'IgorStasenko 5/1/2011 22:11'!
finish
	"Finally convert contours to arrays"
	
	contours := contours collect: [:ea | ea asArray ]! !

!AthensPolygonTester commentStamp: '<historical>'!
I implementing a simple and efficient algorithm to test whether given point
lies withing a polygon or not.

A polygon is a collection of points 1...size.!
!AthensPolygonTester methodsFor: 'testing' stamp: 'IgorStasenko 4/19/2013 16:29'!
includesPoint: aPoint
"
Thanks to Google and Randolph Franklin i don't have to reinvent this very simple algorithm.
See [ 1 ] for details, copyrights etc.

[1] http://www.ecse.rpi.edu/Homepages/wrf/Research/Short_Notes/pnpoly.html

"
	| inside testX testY i j size |
	
	inside := false.
	
	i := 1.
	size := polygon size.
	j := size.
	testX := aPoint x.
	testY := aPoint y.
	
	[ i <= size ] whileTrue: [  | pi pj |
		pi := polygon at: i.
		pj := polygon at: j. 
	
		(((pi y > testY) ~= (pj y > testY)) and: [ 
			testX < 
			(
				pj x - pi x
				* (testY - pi y) 
				/ ( pj y - pi y )
				+ pi x 
			)
			 ]) ifTrue: [ inside := inside not ].
	
		j := i.
		i := i + 1.
	 ].
	^ inside
	! !

!AthensPolygonTester methodsFor: 'accessing' stamp: 'IgorStasenko 4/19/2013 15:56'!
polygon: poly

	polygon := poly! !

!AthensQuadSegment commentStamp: 'IgorStasenko 3/7/2012 13:32'!
i represent a quadric Bezier path segment.

Any quadratic spline can be expressed as a cubic (where the cubic term is zero). The end points of the cubic will be the same as the quadratic's.

    CP0 = QP0
    CP3 = QP2 

The two control points for the cubic are:

    CP1 = QP0 + 2/3 *(QP1-QP0)
    CP2 = QP2 + 2/3 *(QP1-QP2) !
!AthensQuadSegment methodsFor: 'accessing' stamp: 'IgorStasenko 3/26/2011 16:52'!
via

	^ via! !

!AthensQuadSegment methodsFor: 'visitor' stamp: 'IgorStasenko 4/18/2013 04:40'!
accept: aVisitor
	^ aVisitor quadricBezierSegment: self! !

!AthensQuadSegment methodsFor: 'visitor' stamp: 'IgorStasenko 4/18/2013 05:22'!
sendCommandTo: aBuilder
	^ aBuilder curveVia: via to: to 
	! !

!AthensQuadSegment methodsFor: 'initialize-release' stamp: 'IgorStasenko 3/26/2011 16:52'!
from: pt0 via: pt1 to: p

	via := pt1.
	to := p.! !

!AthensQuadSegment methodsFor: 'accessing' stamp: 'IgorStasenko 3/26/2011 16:52'!
to

	^ to! !

!AthensQuadSegment methodsFor: 'accessing' stamp: 'IgorStasenko 3/26/2011 16:52'!
endPoint
	^ to! !

!AthensQuadSegment methodsFor: 'visitor' stamp: 'NicolaiHess 6/24/2014 20:58'!
visitWith: visitor

	visitor visitQuadSegment: self! !

!AthensQuartzSurface commentStamp: '<historical>'!
The Quartz surface is used to render cairo graphics targeting the Apple OS X Quartz rendering system.
!
!AthensQuartzSurface class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/17/2012 17:33'!
registerSurface: quartzSurface
	"we cannot use SurfacePlugin for quartz surfaces"
	
	^ nil ! !

!AthensQuartzSurface class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/17/2012 17:36'!
finalizeResourceData: data
	| handle contextHandle |
	handle := data first.
	"	id := data second.  - id is not used "
	contextHandle := data third.
	
	self destroyContextHandle: contextHandle. 
	self destroySurfaceHandle: handle.
! !

!AthensQuartzSurface class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/17/2012 17:02'!
primImage: aFormat width: aWidth height: aHeight
"Creates a Quartz surface backed by a CGBitmap. The surface is created using the Device RGB (or Device Gray, for A8) color space. All Cairo operations, including those that require software rendering, will succeed on this surface. "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #(AthensQuartzSurface  cairo_quartz_surface_create (int aFormat,
                                                         int aWidth,
                                                         int aHeight) )

! !

!AthensSceneView commentStamp: '<historical>'!
i am simple morph for representing some scene.

The scene is any object which implements #renderOn: method,
or a block with single argument.
(an argument passed is an Athens canvas).

I implement a simple view panning and zooming with mouse drag and mouse-wheel (correspondigly).

Example1: open scene view, by passing a simple rendering block.

| view |
view  := AthensSceneView new.

view scene: [:canvas |
	canvas surface clear:  Color black.
	canvas setPaint: Color red.
	canvas drawShape: (0@0 corner:120@100)
].
view openInWindow.

Example2: open scene view on imported SVG file (note you need 'Athens-SVG' package loaded):

| view |
view  := AthensSceneView new.
view scene: (AthensSVGConverter fromFile: 'lion.svg').

view openInWindow.
!
!AthensSceneView methodsFor: 'session management' stamp: 'IgorStasenko 4/21/2013 04:40'!
createSurface
	| extent |
	extent := self extent asIntegerPoint.
	(scene respondsTo: #createSurface:) ifTrue: [
		surface := scene createSurface: extent.
	  ] ifFalse: [ surface := AthensCairoSurface extent: extent].
! !

!AthensSceneView methodsFor: 'event handling' stamp: 'IgorStasenko 4/21/2013 05:44'!
mouseUp: evt

	"self halt."
	
	self resetState: #panning! !

!AthensSceneView methodsFor: 'accessing' stamp: 'IgorStasenko 6/3/2013 14:27'!
keepRefreshing: aBoolean
	keepRefreshing := aBoolean.
	
	keepRefreshing ifTrue: [  self startStepping ].! !

!AthensSceneView methodsFor: 'state tracking' stamp: 'IgorStasenko 4/21/2013 05:39'!
setState: stateName

	state at: stateName put: true.

	"receiver's state changed"
	
	self changed.! !

!AthensSceneView methodsFor: 'session management' stamp: 'IgorStasenko 4/21/2013 04:37'!
checkSession

	session == Smalltalk session ifFalse: [ 
		self initializeForNewSession
		 ]! !

!AthensSceneView methodsFor: 'event handling' stamp: 'SeanDeNigris 2/10/2015 13:41'!
mouseWheel: event


	"Handle a mouseWheel event."
	
	| center zoom  |
	
	center := transform inverseTransform: (event cursorPoint - bounds origin).

	zoom := 1.
	
	event isUp ifTrue: [ zoom := 1.25 ].
	event isDown ifTrue: [ zoom := 1/1.25 ].
	
	
	(self inState: #zooming) ifTrue: [   
		self updateZoom: zoom cursor: event cursorPoint.
	] ifFalse: [
		self startZooming: zoom center: center.
	]  ! !

!AthensSceneView methodsFor: 'event handling' stamp: 'IgorStasenko 4/21/2013 05:02'!
handlesMouseDown: evt
	^ true! !

!AthensSceneView methodsFor: 'accessing' stamp: 'IgorStasenko 4/21/2013 05:51'!
scene
	^ scene! !

!AthensSceneView methodsFor: 'event handling' stamp: 'IgorStasenko 4/21/2013 05:13'!
handlesMouseOver: evt
	^ true! !

!AthensSceneView methodsFor: 'colors' stamp: 'IgorStasenko 4/21/2013 15:01'!
backgroundColor
	^ Color gray! !

!AthensSceneView methodsFor: 'zoom animation' stamp: 'IgorStasenko 4/22/2013 14:41'!
startZooming: zoom center: center
	| start end |

		
	start := Time millisecondClockValue.
	end := start + 250.

	self setState: #zooming value: {  center. transform copy. zoom. start. end}.

	self startStepping! !

!AthensSceneView methodsFor: 'initialize-release' stamp: 'IgorStasenko 8/8/2013 18:37'!
initialize

	super initialize.
	keepRefreshing := false.
	transform := AthensAffineTransform new.
	
	self hResizing: #spaceFill.
	self vResizing: #spaceFill.
	color := Color transparent.
	state := Dictionary new.
	self extent: self minimumExtent.
	
! !

!AthensSceneView methodsFor: 'state tracking' stamp: 'IgorStasenko 4/21/2013 05:37'!
inState: stateName


	^ (state at: stateName ifAbsent: nil) notNil! !

!AthensSceneView methodsFor: 'layout' stamp: 'IgorStasenko 4/21/2013 05:39'!
layoutChanged 
	"react on morph resize"
	super layoutChanged.
	surface ifNotNil: [  
		self extent asIntegerPoint ~= surface extent ifTrue: [ 
			self createSurface ]
	].
	! !

!AthensSceneView methodsFor: 'zoom animation' stamp: 'IgorStasenko 4/22/2013 14:22'!
stepTime
	^ 0! !

!AthensSceneView methodsFor: 'event handling' stamp: 'IgorStasenko 4/21/2013 06:15'!
mouseMove: evt

	self inState: #panning do: [ :startPanAndPos |
		| delta |
		delta := startPanAndPos first + ( evt cursorPoint - startPanAndPos second ).
		
		transform 
			x: delta x;
			y: delta y.
		self changed.
	] ! !

!AthensSceneView methodsFor: 'drawing' stamp: 'IgorStasenko 4/26/2013 14:46'!
showDebugInfo
	^ true ! !

!AthensSceneView methodsFor: 'drawing' stamp: 'IgorStasenko 8/12/2013 15:18'!
renderScene

	self checkSession.

	scene ifNotNil: [ 
		surface drawDuring: [ :acanvas | 
			surface clear.
			acanvas pathTransform loadAffineTransform: transform.
			scene isBlock
				ifTrue: [ scene cull: acanvas cull: self ]
				ifFalse: [ scene renderOn: acanvas ] ] ]! !

!AthensSceneView methodsFor: 'state tracking' stamp: 'IgorStasenko 4/21/2013 05:39'!
resetState: stateName

	state at: stateName put: nil.

	"receiver's state changed"
	
	self changed.! !

!AthensSceneView methodsFor: 'drawing' stamp: 'IgorStasenko 12/21/2013 02:17'!
drawOn: canvas
	| px py |
	canvas fillRectangle: bounds color: self backgroundColor.
	self renderScene.

	surface displayOnMorphicCanvas: canvas at: bounds origin.

"	 translucentImage: surface asForm at: bounds origin."
	
	self showDebugInfo
		ifTrue: [ 
			px := transform x printShowingDecimalPlaces: 3.
			py := transform y printShowingDecimalPlaces: 3.
			canvas
				drawString: 'zoom: ' , (transform sx printShowingDecimalPlaces: 3) , ' pan: ' , px , ' @ ' , py
				at: bounds origin
				font: nil
				color: Color white ]! !

!AthensSceneView methodsFor: 'accessing' stamp: 'IgorStasenko 4/25/2013 01:19'!
scene: aScene
	
	scene := aScene.
	
	self changed.! !

!AthensSceneView methodsFor: 'state tracking' stamp: 'IgorStasenko 4/21/2013 05:45'!
inState: stateName do: aBlock


	^ (state at: stateName ifAbsent: nil) ifNotNil: aBlock ! !

!AthensSceneView methodsFor: 'session management' stamp: 'IgorStasenko 4/21/2013 04:40'!
initializeForNewSession

	self createSurface.
	session := Smalltalk session.
! !

!AthensSceneView methodsFor: 'state tracking' stamp: 'IgorStasenko 4/21/2013 05:39'!
setState: stateName value: aValue

	state at: stateName put: aValue.

	"receiver's state changed"
	
	self changed.! !

!AthensSceneView methodsFor: 'zoom animation' stamp: 'IgorStasenko 6/1/2013 14:09'!
step

	self inState: #zooming do: [ :zoomState |
		| now start end center targetZoom factor |
		now := Time millisecondClockValue.
		start := zoomState at: 4.
		end := zoomState at: 5.
		
		(now between: start and:end) ifFalse: [ now := end.
			self resetState: #zooming.
			self stopStepping ].
		
		transform := (zoomState at: 2) copy.
		center := zoomState at: 1.
		
		factor :=  (now-start)/(end - start ).
		targetZoom := zoomState at: 3.
		targetZoom := 1* (1-factor) + (targetZoom * factor).
		
		transform
			translateBy: center;
			scaleBy:targetZoom;
			translateBy: center negated.
		
	].
	self changed.
! !

!AthensSceneView methodsFor: 'event handling' stamp: 'IgorStasenko 4/21/2013 05:41'!
mouseEnter: evt

	self setState: #mouseIn! !

!AthensSceneView methodsFor: 'initialize-release' stamp: 'IgorStasenko 4/21/2013 06:50'!
minimumExtent
	^ 300@300! !

!AthensSceneView methodsFor: 'event handling' stamp: 'IgorStasenko 4/21/2013 06:01'!
handlesMouseWheel: event
	^ true! !

!AthensSceneView methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 6/3/2013 14:27'!
stopStepping
	keepRefreshing ifFalse: [
			^ super stopStepping ]! !

!AthensSceneView methodsFor: 'event handling' stamp: 'IgorStasenko 4/21/2013 06:12'!
mouseDown: evt

	| pos |
	
	pos := evt cursorPoint.
	
	"left button"
	evt redButtonPressed ifTrue: [ 
		self setState: #panning value: { transform x@transform y. pos }
		 ].
	
! !

!AthensSceneView methodsFor: 'event handling' stamp: 'IgorStasenko 4/21/2013 05:44'!
mouseLeave: evt
	self 
		resetState: #mouseIn;
		resetState: #panning.! !

!AthensSceneView methodsFor: 'zoom animation' stamp: 'IgorStasenko 4/22/2013 15:01'!
updateZoom: zoom cursor: cursorPoint

	| zoomState targetZoom start end now fraction newCenter |
	zoomState := state at:#zooming.
		
	"change the target zoom and increase time a bit"
	targetZoom := zoomState at: 3.
	
	start := zoomState at: 4.
	end := zoomState at: 5.
		
	now := Time millisecondClockValue.
	
	(now > end) ifTrue: [  now := end ].
	
	 "interpolate linearly the target zoom factor over time start ... end"
	fraction := (now - start) / (end - start).
	
	"zoom goes from 1..target zoom"
	targetZoom := 1*(1-fraction) + (targetZoom * fraction).

	self step. "to update transform"
	zoomState at: 3 put: targetZoom * zoom.
	newCenter :=   transform inverseTransform: (cursorPoint - bounds origin).
	zoomState at: 1 put: newCenter.
	zoomState at: 2 put: transform copy.
	zoomState at: 4 put: now.
	zoomState at: 5 put: now + 250 .
! !

!AthensShape commentStamp: '<historical>'!
This class represents an interface, which should be supported by all shapes used for drawing with Athens framework.

Shapes do not have to inherit directly from me, for example Rectangle implements my protocol (via extensions), and as result can be used as a valid shape for drawing with Athens.!
!AthensShape methodsFor: 'converting' stamp: 'IgorStasenko 5/6/2013 05:32'!
asAthensShapeOn: canvas
	"Receiver is a shape, no conversion is needed."
	^ self! !

!AthensShape methodsFor: 'drawing' stamp: 'IgorStasenko 12/20/2011 18:36'!
paintFillsUsing: aPaint on: anAthensCanvas 
	"This method is a part of rendering dispatch  Canvas->receiver->paint"
	
	self subclassResponsibility! !

!AthensSimplePathBuilder commentStamp: '<historical>'!
i building path containing from AthensPathSegment. 
the resulting path is backend neutral (while different backend may implement own builder which is more efficient)!
!AthensSimplePathBuilder methodsFor: 'path commands' stamp: 'IgorStasenko 3/26/2011 16:45'!
lineTo: aPoint

	^ self addSegment: (AthensLineSegment new point: (self toAbsolute: aPoint)).

! !

!AthensSimplePathBuilder methodsFor: 'private' stamp: 'IgorStasenko 3/26/2011 16:43'!
toAbsolute: aPoint
	| pt |
	pt := absolute 
		ifTrue: [ aPoint ]
		ifFalse: [ lastSegment endPoint + aPoint ].

	"note the coordinate to calculate the path's bounding box"
	xMin ifNil: [
		xMin := xMax := pt x.
		yMin := yMax := pt y.	
		] 
	ifNotNil: [
		xMin := pt x min: xMin.
		yMin := pt y min: yMin.
		xMax := pt x max: xMax.
		yMax := pt y max: yMax.	
	].
	^ pt! !

!AthensSimplePathBuilder methodsFor: 'path commands' stamp: 'IgorStasenko 3/26/2011 16:47'!
close
	"close the current contour"
	self addSegment: (AthensCloseSegment new point: contourStartPt).

	contourStartPt := nil.
	open := false! !

!AthensSimplePathBuilder methodsFor: 'path commands' stamp: 'IgorStasenko 3/26/2011 16:51'!
curveVia: cp1 to: aPoint
	| pt1 pt2 |
	"Quad bezier curve"

	pt1 := self toAbsolute: cp1.
	pt2 := self toAbsolute: aPoint.
	^ self addSegment: (
		AthensQuadSegment new 
			from: lastSegment endPoint 
			via: pt1 
			to: pt2)

! !

!AthensSimplePathBuilder methodsFor: 'path commands' stamp: 'JochenRick 1/8/2014 08:11'!
reflectedCurveVia: cp2 to: aPoint
	"Reflected cubic bezier curve"
	
	| pt1 pt2 pt3 |

	pt2 := self toAbsolute: cp2.
	pt1 := lastSegment isCubic
		ifTrue: [ lastSegment via2reflected ]
		ifFalse: [ lastSegment endPoint ].
	pt3 := self toAbsolute: aPoint.
	^ self addSegment: (
		AthensCubicSegment new 
			from: lastSegment endPoint 
			via: pt1
			and: pt2
			to: pt3)

! !

!AthensSimplePathBuilder methodsFor: 'accessing' stamp: 'IgorStasenko 3/26/2011 19:50'!
pathStart
	^ pathStart! !

!AthensSimplePathBuilder methodsFor: 'path commands' stamp: 'IgorStasenko 3/26/2011 16:50'!
moveTo: aPoint
	" move command always starts a new contour "
	contourStartPt := self toAbsolute: aPoint.
	
	"collapse multiple moves to a single one"
	lastSegment isMove ifTrue: [
		lastSegment point: contourStartPt.
		^ self
	].

	self addSegment: (AthensMoveSegment new point: contourStartPt; reopen: open).
	open := true.! !

!AthensSimplePathBuilder methodsFor: 'path commands' stamp: 'IgorStasenko 3/7/2012 13:37'!
cwArcTo: endPt angle: rot
	" angle should be specified in radians "
	^ self addSegment: (AthensCWArcSegment new endPoint: (self toAbsolute: endPt) angle: rot).

! !

!AthensSimplePathBuilder methodsFor: 'initialize-release' stamp: 'IgorStasenko 4/18/2013 14:26'!
initialize
	"A new path always starts from implicit (moveTo:0@0) segment.
	If next segment is moveTo: , the point of already existing move segment will be changed,
	avoiding creating extra move segments.
	
	"
	absolute := false.
	contourStartPt := ZeroPoint.
	pathStart := lastSegment := (AthensMoveSegment new  point: ZeroPoint).! !

!AthensSimplePathBuilder methodsFor: 'path commands' stamp: 'IgorStasenko 3/26/2011 19:26'!
curveVia: cp1 and: cp2 to: aPoint
	"Cubic bezier curve"
	
	| pt1 pt2 pt3 |
	"Quad bezier curve"

	pt1 := self toAbsolute: cp1.
	pt2 := self toAbsolute: cp2.
	pt3 := self toAbsolute: aPoint.
	^ self addSegment: (
		AthensCubicSegment new 
			from: lastSegment endPoint 
			via: pt1
			and: pt2
			to: pt3)

! !

!AthensSimplePathBuilder methodsFor: 'accessing' stamp: 'IgorStasenko 3/26/2011 19:40'!
pathBounds
	^ xMin@yMin corner: xMax@yMax! !

!AthensSimplePathBuilder methodsFor: 'path commands' stamp: 'IgorStasenko 3/21/2011 03:40'!
relative
	absolute := false.! !

!AthensSimplePathBuilder methodsFor: 'path commands' stamp: 'IgorStasenko 3/21/2011 03:40'!
absolute
	absolute := true.! !

!AthensSimplePathBuilder methodsFor: 'private' stamp: 'IgorStasenko 3/26/2011 16:32'!
addSegment: aSegment
	lastSegment next: aSegment.
	lastSegment := aSegment.
 ! !

!AthensSimplePathBuilder methodsFor: 'creating path' stamp: 'IgorStasenko 4/18/2013 17:47'!
createPath:	aBlock

		"aBlock value: self ...."	

	aBlock value: self.
	
	^ pathStart! !

!AthensSimplePathBuilder methodsFor: 'path commands' stamp: 'IgorStasenko 3/7/2012 13:41'!
ccwArcTo: endPt angle: rot
	" angle should be specified in radians "
	^ self addSegment: (AthensCCWArcSegment new endPoint: (self toAbsolute: endPt) angle: rot).

! !

!AthensSimpleTreeNode commentStamp: 'TorstenBergmann 2/12/2014 22:17'!
A node in an AthensTreeView!
!AthensSimpleTreeNode methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 5/3/2013 23:55'!
midBottom
	^ originX +(extent x *0.5) @ (originY + extent y)! !

!AthensSimpleTreeNode methodsFor: 'accessing' stamp: 'IgorStasenko 5/3/2013 22:09'!
extent: anObject
	
	extent := anObject! !

!AthensSimpleTreeNode methodsFor: 'accessing' stamp: 'IgorStasenko 5/3/2013 22:38'!
width
	
	^ extent x! !

!AthensSimpleTreeNode methodsFor: 'accessing' stamp: 'IgorStasenko 5/3/2013 22:09'!
box
	
	^ box! !

!AthensSimpleTreeNode methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 5/4/2013 00:32'!
renderOn: aCanvas

	aCanvas setPaint: color.
	aCanvas drawShape: (originX @ originY extent: extent).
"	children do: [ :each |
		each renderOn: aCanvas
	].
	[  ^ self ] value.
	"
	children do: [ :each | | path |
		
		"we cache the path connecting each child and its parent, to not recreate it each time"
		path := aCanvas cacheAt: each ifAbsentPut: [ 
			| midTop midBot |
			
			midTop := self midBottom.
			midBot := each midTop.
			
			aCanvas createPath: [:builder | 
				builder 
					absolute;
					moveTo: self midBottom;
					curveVia: midTop x@midBot y and: midBot x@ midTop y to: midBot
					"lineTo: each midTop"
			]].

		aCanvas setStrokePaint: (Color red alpha:0.5).
		aCanvas drawShape: path. 
		
		each renderOn: aCanvas
	]! !

!AthensSimpleTreeNode methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 5/3/2013 22:10'!
children
	^ children! !

!AthensSimpleTreeNode methodsFor: 'accessing' stamp: 'IgorStasenko 5/3/2013 23:47'!
originY
	^ originY! !

!AthensSimpleTreeNode methodsFor: 'accessing' stamp: 'IgorStasenko 5/3/2013 23:13'!
originY: aNumber
	originY := aNumber! !

!AthensSimpleTreeNode methodsFor: 'accessing' stamp: 'IgorStasenko 5/3/2013 22:09'!
subject
	
	^ subject! !

!AthensSimpleTreeNode methodsFor: 'accessing' stamp: 'IgorStasenko 5/3/2013 23:29'!
color: aColor
	color := aColor! !

!AthensSimpleTreeNode methodsFor: 'accessing' stamp: 'IgorStasenko 5/3/2013 22:38'!
height
	
	^ extent y! !

!AthensSimpleTreeNode methodsFor: 'accessing' stamp: 'IgorStasenko 5/3/2013 23:12'!
layoutHorizontally: center
	| pos |
	"position ourselves in the middle X"
	originX := center - (self width * 0.5).
	
	"childs"
	pos := center - (self layoutWidth *0.5).
	
	children do: [ :each |
		each layoutHorizontally: pos + (each layoutWidth *0.5).
		pos := pos + each layoutWidth + self spacingBetweenChilds. 
	]! !

!AthensSimpleTreeNode methodsFor: 'accessing' stamp: 'IgorStasenko 5/3/2013 22:09'!
box: anObject
	
	box := anObject! !

!AthensSimpleTreeNode methodsFor: 'accessing' stamp: 'IgorStasenko 5/3/2013 22:09'!
extent
	
	^ extent! !

!AthensSimpleTreeNode methodsFor: 'accessing' stamp: 'IgorStasenko 5/3/2013 23:16'!
layoutWidth 

	^ layoutWidth ifNil: [  
		| childWidth |

		childWidth := 0.
		children isEmpty ifFalse: [  
			children do: [ :each | childWidth := childWidth + each layoutWidth  ].
			childWidth := childWidth + (self spacingBetweenChilds * (children size-1)).
		].

		layoutWidth := self width max: childWidth.
	].
! !

!AthensSimpleTreeNode methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 5/3/2013 23:55'!
midTop
	^ originX +(extent x *0.5) @ originY ! !

!AthensSimpleTreeNode methodsFor: 'accessing' stamp: 'IgorStasenko 5/3/2013 22:09'!
subject: anObject
	
	subject := anObject! !

!AthensSimpleTreeNode methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 5/3/2013 22:10'!
children: aCollection

	children := aCollection! !

!AthensSimpleTreeNode methodsFor: 'accessing' stamp: 'IgorStasenko 5/3/2013 23:28'!
color
	^ color
	! !

!AthensSimpleTreeNode methodsFor: 'accessing' stamp: 'IgorStasenko 5/3/2013 22:37'!
spacingBetweenChilds
	^ 10! !

!AthensSimpleTreeNode methodsFor: 'accessing' stamp: 'IgorStasenko 5/3/2013 23:47'!
originX
	^ originX! !

!AthensStrikeFontRenderer commentStamp: 'StephaneDucasse 7/6/2014 18:39'!
I am used to render font with cairo "toy" text api if no freetype
font is used.


AthensCairoSurfaceExamples exampleDrawText!
!AthensStrikeFontRenderer methodsFor: 'rendering' stamp: 'NicolaiHess 7/2/2014 20:03'!
renderCharacters: aString from: start to: end
	| cairoText |
	aString isEmpty
		ifTrue: [ ^ self ].
	cairoText := self createCairoText: (aString copyFrom: start to: end).
	canvas paint loadOnCairoCanvas: canvas.
	canvas newPath.
	cairoText drawOn: canvas! !

!AthensStrikeFontRenderer methodsFor: 'accessing' stamp: 'NicolaiHess 7/2/2014 20:02'!
canvas: aCanvas
	canvas := aCanvas! !

!AthensStrikeFontRenderer methodsFor: 'initialize' stamp: 'NicolaiHess 7/2/2014 20:02'!
initialize
	super initialize.
	font := nil.
	canvas := nil! !

!AthensStrikeFontRenderer methodsFor: 'accessing' stamp: 'NicolaiHess 6/30/2014 09:35'!
font
	
	^ font! !

!AthensStrikeFontRenderer methodsFor: 'private' stamp: 'NicolaiHess 7/2/2014 20:00'!
createCairoText: aString
	| fdesc at |
	at := AthensCairoText new.
	at text: aString.
	fdesc := font asAthensFontDescription.
	at readFrom: fdesc.
	^ at! !

!AthensStrikeFontRenderer methodsFor: 'accessing' stamp: 'NicolaiHess 6/30/2014 09:35'!
font: anObject
	
	font := anObject! !

!AthensStrikeFontRenderer class methodsFor: 'instance creation' stamp: 'NicolaiHess 6/30/2014 09:48'!
on: aCanvas forFont: aFont
	^ self new canvas: aCanvas; font: aFont; yourself! !

!AthensStrokePaint commentStamp: '<historical>'!
I representing a stroke paint object used by Athens.
My subclasses provide backend-specific implementation.
I am more serving to define the common protocols and
requirements for all backends (such as defaults).


IMPORTANT NOTE: a stroke paint object provides a protocol 
only for setting stroke properties, but not retrieving them back.
This is intentionally, because the way how these properties is
managed are highly backend-specific. 

The stroke paint has following properties:
 - fill paint. A paint to use for filling strokes.
	Can be any athens basic paint, except from stroke one.

 - stroke width. Can be set using #width:

	Default: if width is not set explicitly for stroke paint,
		it is assumed to be equal to 1.0.
		
 - join style. 
		Currently there are 3 kinds of joins supported:
			bevel
			miter
			round
		To set join style for paint, use 
			#joinBevel, #joinMiter or #joinRound methods.

	Default: if join style is not explicitly set for stroke paint,
		it will use bevel join style.

 - cap style
		supported: butt, round and square.
		To set cap style, use
			#capButt, #capRound or #capSquare methods.

	Default: if cap style is not explicitly set for stroke paint,
		it will use butt cap style.

 - miter limit, set with #miterLimit: accessor.
	(default and meaning of limit is not yet determined)

Dashes: 
	stroke can use dashing. 
	Dash is special kind of stroke which won't draw a continuous
	stroke connecting path segments, but instead stroke with
	alternating fill-gap style , defined by provided input.
	
	Protocol:
	
	paint 
		dashes: dashPattern 
		offset: anOffset.
		
	The dash pattern is a simple 
	collection of alternating lengths, like: 
	#("fill" 50 "gap" 50) 
	
	in this example , first 50 length units of path
	will be filled with stroke, and next 50 will be skipped,
	forming a gap, then again filled and again skipped,
	and so on until path ends.
	The dash pattern can contain as many length elements
	as needed. Just remember that each odd element represents
	length to fill with stroke, and each even element, length to skip,
	while traversing along the path.
	
	The offset controls the shift in length units, 
	relative to path start.
	
	Default: if dash is not explicitly set for stroke paint,
		it will fill the path using continuous stroke (no gaps). !
!AthensStrokePaint methodsFor: 'accessing' stamp: 'IgorStasenko 9/3/2013 13:10'!
width: anObject
	"set the stroke width"
	width := anObject! !

!AthensStrokePaint methodsFor: 'accessing' stamp: 'NicolaiHess 1/6/2015 19:35'!
width
	^ width! !

!AthensStrokePaint methodsFor: 'accessing' stamp: 'IgorStasenko 4/29/2011 15:28'!
miterLimit: anObject

	miterLimit := anObject! !

!AthensStrokePaint methodsFor: 'accessing' stamp: 'IgorStasenko 4/29/2011 15:28'!
fillPaint: anObject

	fillPaint := anObject! !

!AthensStrokePaint methodsFor: 'setting join styles' stamp: 'IgorStasenko 9/3/2013 14:19'!
joinBevel
	"Set receiver to use bevel join style"
	self subclassResponsibility! !

!AthensStrokePaint methodsFor: 'setting join styles' stamp: 'IgorStasenko 9/3/2013 14:19'!
joinMiter
	"Set receiver to use miter join style"
	self subclassResponsibility! !

!AthensStrokePaint methodsFor: 'initialize-release' stamp: 'IgorStasenko 9/3/2013 14:18'!
initialize
	self setDefaults.! !

!AthensStrokePaint methodsFor: 'setting cap styles' stamp: 'IgorStasenko 9/3/2013 13:08'!
capSquare
	"Set this paint to use square cap style"
	self subclassResponsibility! !

!AthensStrokePaint methodsFor: 'setting join styles' stamp: 'IgorStasenko 9/3/2013 14:19'!
joinRound
	"Set receiver to use round join style"
	self subclassResponsibility! !

!AthensStrokePaint methodsFor: 'setting dashes' stamp: 'IgorStasenko 9/3/2013 13:36'!
dashes: anAlternateCollectionOfLenghts offset: anOffset
	
	'self dashes: #( "fill" 20  "gap" 10 "fill" 35 "gap" 30) offset: 0. '.
	
	self subclassResponsibility

	! !

!AthensStrokePaint methodsFor: 'converting' stamp: 'IgorStasenko 4/27/2012 11:12'!
asStrokePaintOn: aCanvas
	"receiver is stroke paint already"
	^ self! !

!AthensStrokePaint methodsFor: 'setting cap styles' stamp: 'IgorStasenko 9/3/2013 13:08'!
capRound
	"Set this paint to use round cap style"
	self subclassResponsibility! !

!AthensStrokePaint methodsFor: 'initialize-release' stamp: 'IgorStasenko 9/3/2013 13:13'!
setDefaults

	"Set the default values for strokes"
	width := 1.
	self 
		capButt; 
		joinBevel;
		miterLimit: 4.0
	
	
	! !

!AthensStrokePaint methodsFor: 'setting cap styles' stamp: 'IgorStasenko 9/3/2013 13:08'!
capButt
	"Set this paint to use butt cap style"
	self subclassResponsibility! !

!AthensSurface commentStamp: '<historical>'!
I representing a surface, where all drawing operations will happen.

I also having a number of factory methods to create paints, paths and other objects involved in drawing.

AthensSurface is an abstract, while subclasses implement a specific kind of surface for one or another backend.

The primary role of AthensSurface class is to define a public protocol for all Athens surfaces, which can be used by applications which using Athens framework.

To get a new surface, use:

<one of my subclasses> extent: x@y

for surfaces which don't need to have dimensions specified,
it would just #new.!
!AthensSurface methodsFor: 'paints' stamp: 'IgorStasenko 4/27/2012 12:16'!
createRadialGradient: colorRamp center: aCenter radius: aRadius focalPoint: fp
 
	self subclassResponsibility! !

!AthensSurface methodsFor: 'rendering dispatch' stamp: 'IgorStasenko 8/30/2013 16:38'!
fillRectangle: aRectangle withSolidColor: aColor

	self subclassResponsibility! !

!AthensSurface methodsFor: 'public' stamp: 'IgorStasenko 12/20/2011 15:38'!
clear
	"clear the surface"
	
	self subclassResponsibility! !

!AthensSurface methodsFor: 'private' stamp: 'IgorStasenko 3/22/2011 22:40'!
releaseCanvas
	currentCanvas := nil! !

!AthensSurface methodsFor: 'paints' stamp: 'IgorStasenko 3/8/2012 13:46'!
createFormPaint: aForm 
	self subclassResponsibility.! !

!AthensSurface methodsFor: 'caching' stamp: 'IgorStasenko 10/12/2012 03:22'!
cacheAt: anObject ifAbsentPut: aBlock
	"Answer an object from surface's cache identified by anObject,
	if there is no cached object under such identifier, evaluate a block
	and put it into cache. Then answer the result of evaluation.
	A surface using identity comparison for object identifiers.
	"

	self subclassResponsibility! !

!AthensSurface methodsFor: 'converting' stamp: 'sig 2/29/2012 21:51'!
asForm
	"Answer a Form , which contains a bits, converted from surface "
	self subclassResponsibility! !

!AthensSurface methodsFor: 'masking' stamp: 'IgorStasenko 3/27/2011 18:16'!
maskEnabled
	self subclassResponsibility! !

!AthensSurface methodsFor: 'caching' stamp: 'IgorStasenko 10/12/2012 03:56'!
flushCacheAt: anObject

	"Flush (delete) any cached value(s) identified by given object, anObject.
	A surface using identity comparison for object identifiers.

	Answer receiver.
	"

	self subclassResponsibility! !

!AthensSurface methodsFor: 'paints' stamp: 'IgorStasenko 4/27/2012 12:17'!
createRadialGradient: colorRamp center: aCenter radius: aRadius
	"by default, focal point coincede with center"
	^ self createRadialGradient: colorRamp center: aCenter radius: aRadius focalPoint: aCenter
! !

!AthensSurface methodsFor: 'paths' stamp: 'FernandoOlivero 1/13/2012 03:08'!
createRectanglePath: aRectangle 
	^ aRectangle! !

!AthensSurface methodsFor: 'paints' stamp: 'IgorStasenko 12/20/2011 15:25'!
createSolidColorPaint: aColor 
	 "Answer an instance of AthensPaint, valid for use with given surface"
	
	self subclassResponsibility! !

!AthensSurface methodsFor: 'public' stamp: 'IgorStasenko 3/7/2012 15:06'!
drawDuring: aBlock

	"You may draw on receiver only when inside a block and only using provided canvas object.
	This ensures releasing system resources used after finishing drawing"


	currentCanvas ifNotNil: [ self attemptToRecurseDrawing ].
	
	[
		currentCanvas := self newCanvas.
		aBlock value: currentCanvas.
	] ensure: [
		self releaseCanvas.
		currentCanvas := nil.
	].! !

!AthensSurface methodsFor: 'paints' stamp: 'IgorStasenko 4/12/2013 09:59'!
createLinearGradient: colorRamp start: pt1 stop: pt2
 
	"This protocol is deprecated. Use #createLinearGradient: start:stop: instead"
	
	
	self shouldNotImplement ! !

!AthensSurface methodsFor: 'rendering dispatch' stamp: 'NicolaiHess 6/24/2014 21:08'!
fillPath: aPath withSolidColor: aColor 

	self subclassResponsibility! !

!AthensSurface methodsFor: 'public' stamp: 'IgorStasenko 9/1/2012 20:06'!
clear: clearColor
	"clear the surface"
	
	self subclassResponsibility! !

!AthensSurface methodsFor: 'paints' stamp: 'IgorStasenko 4/27/2012 11:20'!
createStrokePaintFor: aPaint
	 "Answer an instance of AthensPaint, valid for use as stroke paint on receiver,
	using an argument, paint for fills"
	
	self subclassResponsibility! !

!AthensSurface methodsFor: '*Athens-Morphic' stamp: 'IgorStasenko 12/21/2013 02:16'!
displayOnMorphicCanvas: canvas at: aPoint
	"display receiver on morphic canvas"
	self subclassResponsibility! !

!AthensSurface methodsFor: 'masking' stamp: 'IgorStasenko 3/27/2011 18:15'!
enableMask
	self subclassResponsibility! !

!AthensSurface methodsFor: 'private' stamp: 'IgorStasenko 3/21/2011 02:35'!
newCanvas
	"Answer a preinitialized instance of AthensCanvas.
	Private to receiver and its subclasses, override seldom"
	^ AthensCanvas on: self
! !

!AthensSurface methodsFor: 'paths' stamp: 'IgorStasenko 3/26/2011 19:32'!
createPath: aPathBuilder
	"Create a path from provided path builder instance"
	self subclassResponsibility! !

!AthensSurface methodsFor: 'masking' stamp: 'IgorStasenko 3/27/2011 18:15'!
disableMask
	self subclassResponsibility! !

!AthensSurface methodsFor: 'clipping' stamp: 'IgorStasenko 4/21/2011 14:47'!
clipBy: aRectangle during: aBlockClosure 
	self subclassResponsibility.! !

!AthensSurface class methodsFor: 'instance creation' stamp: 'sig 2/29/2012 21:43'!
extent: aPoint
	"Create a new surface with given extent. 
	Note that some surfaces may not support this method, since they may represent an infinite surface."
	
	self subclassResponsibility! !

!AthensSurfaceExamples commentStamp: 'IgorStasenko 1/17/2012 16:42'!
AthensCairoSurfaceExamples example1.
AthensCairoSurfaceExamples example2.

AthensBalloonSurfaceExamples example6.!
!AthensSurfaceExamples methodsFor: 'drawing' stamp: 'NicolaiHess 6/24/2014 20:47'!
renderOn: aCanvas
	renderBlock value: aCanvas! !

!AthensSurfaceExamples methodsFor: 'initialize' stamp: 'NicolaiHess 6/24/2014 20:46'!
initialize

	super initialize.

	renderBlock := nil.! !

!AthensSurfaceExamples methodsFor: 'accessing' stamp: 'NicolaiHess 6/24/2014 20:46'!
renderBlock: anObject
	
	renderBlock := anObject! !

!AthensSurfaceExamples methodsFor: 'accessing' stamp: 'NicolaiHess 6/24/2014 20:46'!
renderBlock
	
	^ renderBlock! !

!AthensSurfaceExamples methodsFor: 'surface management' stamp: 'NicolaiHess 6/24/2014 20:54'!
createSurface: anExtent
	^ self class newSurface: anExtent! !

!AthensSurfaceExamples class methodsFor: 'examples' stamp: 'IgorStasenko 4/8/2014 15:56'!
example1

"
self  example1
"
	self openViewOn: [ :can |
		can pathTransform restoreAfter: [ 

			can pathTransform translateX: 30 Y: 30.
			can pathTransform rotateByDegrees: 35.
			can setPaint: (Color red).
			
			can setShape: (-20@ -20 corner: 20@ 20).
			2 timesRepeat: [ can draw. can setPaint: (Color green alpha:0.5)].
			].
	].
! !

!AthensSurfaceExamples class methodsFor: 'examples' stamp: 'IgorStasenko 3/21/2012 18:58'!
example10 
" draw a rounded rectangle, using the arc segments

AthensCairoSurfaceExamples example10.
"

	| surf |
	
	surf := self newSurface: 440@440.
	
	surf drawDuring: [:can |
		| p |
		surf clear.
		can pathTransform
			scaleBy: 3;
			translateX: 10 Y: 10.
		p:= can createPath: [:path | |halfPi |
				halfPi := Float pi /2.
				path 
					relative;
					moveTo: 10@0;
					lineTo: 40@0;
					ccwArcTo: 10@10 angle: halfPi;
					lineTo: 0@40;
					cwArcTo: -10@10 angle: halfPi;
					lineTo: -40@0;
					cwArcTo: -10@ -10 angle: halfPi;
					lineTo: 0@ -40;
					ccwArcTo: 10@ -10 angle: halfPi].
				
		can setShape: p.
		can setPaint: Color white.
		can draw.
		can setStrokePaint: Color red.
		can draw ].
		
	Display getCanvas drawImage: 	surf asForm  at: 0@0
! !

!AthensSurfaceExamples class methodsFor: 'examples' stamp: 'NicolaiHess 6/25/2014 00:10'!
example3stroke
" 
Draw simple stroke  path, changing the transformation and colors to get some animated effects.

 self  example3stroke 
"

	| surf |
	
	surf := self newSurface: 400@400.
	
	surf drawDuring: [:can | |  path |
	
		(can setStrokePaint: Color blue) width: 1.

		can pathTransform translateX: 200 Y: 200.	
		can pathTransform scaleBy: 1.

		path := can createPath: [:pathbuilder |
				pathbuilder 
					absolute;
					moveTo: -25 @ -25;
					curveVia: 25@ -25 to: 25@25;
					curveVia: -25@25 to: -25@ -25
			].
		
		1 to: 1000 do: [:i |
		
			(can setStrokePaint: Color random) width: 1.
			can pathTransform restoreAfter: [
				can pathTransform rotateByDegrees: i*5.
				can pathTransform scaleBy: (1- ( i/2000)).
				can drawShape: path.
			].
			Display getCanvas drawImage: 	surf asForm  at: 0@0. 
		]	
	].
! !

!AthensSurfaceExamples class methodsFor: 'examples' stamp: 'IgorStasenko 4/8/2014 15:57'!
example2
"
Draw a path on surface.

self example2.


"
	self openViewOn: [ :can |
		can setPaint: Color blue.
		
		can drawShape: (
			can createPath: [:path |
				path 
					absolute;
					lineTo: 50@0;
					lineTo: 50@50;
					lineTo: 0@100
			])
	
	].
 ! !

!AthensSurfaceExamples class methodsFor: 'examples' stamp: 'NicolaiHess 6/25/2014 00:11'!
example6point1
"Draw two rectangles, filled by linear gradient. 

Note that it should produce same rectangles with exact same fills, because gradient paint 
coordinates are affected by pathTransform matrix.


self example6point1
"

	| surf paint |
	
	surf := self newSurface: 100@200.
	
	paint := surf 
		createLinearGradient: { 0->Color red .  1->Color green } 
		start: 0@0 
		stop: 30@30.
	
	surf drawDuring: [:can |
		surf clear.
		
		can setPaint: paint.

		can drawShape: (0@0 corner: 50@50).
	].

	Display getCanvas drawImage: 	surf asForm  at: 0@0
! !

!AthensSurfaceExamples class methodsFor: 'examples' stamp: 'IgorStasenko 4/12/2013 10:14'!
example6stroke
"
self example6stroke


Draw two rectangles, stoked by linear gradient. 

Note that it should produce same rectangles with exact same fills, because gradient paint 
coordinates are affected by pathTransform matrix.
"

	| surf paint |
	
	surf := self newSurface: 100@100.
	
	paint := surf 
		createLinearGradient: { 0->Color red .  1->Color green } 
		start: 0@0 
		stop: 50@50.
	
	surf drawDuring: [:can | | stroke |
		surf clear.
		
		stroke := can setStrokePaint: paint.
		stroke width: 4.
		can drawShape: (0@0 corner: 50@50).
		
		can pathTransform translateX: 50 Y: 50.
		can drawShape: (0@0 corner: 50@50).
		
	].

	Display getCanvas drawImage: 	surf asForm  at: 0@0
! !

!AthensSurfaceExamples class methodsFor: 'examples' stamp: 'NicolaiHess 6/25/2014 00:12'!
exampleDrawForm2
"self exampleDrawForm2"
	| surf  |
		
	surf := self newSurface: 300@300.
	
	surf drawDuring: [:can |
		surf clear.
		can pathTransform loadIdentity.

		can setShape: (0@0 corner: 300@300).
		can setPaint: Color black.
		can draw.
		can pathTransform scaleBy: 0.5;
		 translateX: 60 Y: 60. 
		(can setPaint: Smalltalk ui icons helpIcon) repeat.
		can paintTransform scaleBy: 3; rotateByDegrees: 30.
		can draw.
	].
	Display getCanvas drawImage: surf asForm  at: 0@0
! !

!AthensSurfaceExamples class methodsFor: 'examples' stamp: 'IgorStasenko 10/9/2012 19:18'!
exampleDrawText
"
self subclasses anyOne exampleDrawText
"
	| surf  font |
	
	font := LogicalFont familyName: 'Arial' pointSize: 20.

	surf := self newSurface: 300@100.
	
	surf drawDuring: [:can |
		"clear background"
		surf clear: Color white.

		"set font and color"
		can setFont: font.
		can setPaint: Color black.
		
		"translate an origin by font's ascent, otherwise 
		we will see only things below baseline"
		can pathTransform translateX: 0 Y: (font getPreciseAscent).
		can drawString: 'Hello Athens!!'.
	].
	Display getCanvas drawImage: 	surf asForm  at: 0@0
! !

!AthensSurfaceExamples class methodsFor: 'examples' stamp: 'IgorStasenko 9/2/2012 20:15'!
exampleStrokeRect
" 
Draw a frame rectangle, rotate & transform it in a loop

 self exampleStrokeRect
"

	| surf |
	
	surf := self newSurface: 400@400.
	
	surf drawDuring: [:can | | path |
	
		can pathTransform translateX: 200 Y: 200.	
		can pathTransform scaleBy: 8.
		
		1 to: 1000 do: [:i |
		
			(can setStrokePaint: Color random) width: 1.
			can pathTransform restoreAfter: [
				can pathTransform rotateByDegrees: i*5.
				can pathTransform scaleBy: (1- ( i/2000)).
				surf clear.
				can drawShape: (0@0 corner: 25@25) ].
			Display getCanvas drawImage: 	surf asForm  at: 0@0. 
		]	
	].
! !

!AthensSurfaceExamples class methodsFor: 'examples' stamp: 'NicolaiHess 6/25/2014 00:11'!
example7
"Draw two rectangles, filled by linear gradient. 
Rotate the gradient in a loop.

Note that it should produce same rectangles with exact same fills, because gradient paint 
coordinates are affected by pathTransform matrix.

self example7
"

	| surf paint |
	
	surf := self newSurface: 100@100.
	
	paint := surf 
		createLinearGradient: { 0->Color red .  1->Color green } 
		start: 0@0 
		stop: 50@50.
	
	surf drawDuring: [:can |

		1 to: 10000 do: [:i |
			surf clear.

			can pathTransform loadIdentity.

			can paintTransform loadIdentity translateX: 15 Y: 15; rotateByDegrees: (i/10000 * 360).		
			can setPaint: paint.

			can drawShape: (0@0 corner: 50@50).
		
			can pathTransform translateX: 50 Y: 50.
			can drawShape: (0@0 corner: 50@50).

			Display getCanvas drawImage: 	surf asForm  at: 0@0
		].		
	].

! !

!AthensSurfaceExamples class methodsFor: 'examples' stamp: 'NicolaiHess 6/25/2014 00:12'!
exampleDrawForm
"self exampleDrawForm"
	| surf surf2   |

	surf2 := self newSurface: 100@100.
	surf2 drawDuring: [:c |
		c setPaint: (Color red alpha: 0.5) .
		c drawShape: (0@0 corner: 100@100).
		].
	
	surf := self newSurface: 300@300.
	
	surf drawDuring: [:can |
		surf clear.
		can pathTransform loadIdentity.

		can setShape: (0@0 corner: 300@300).
		can setPaint: Color black.
		can draw.
		can pathTransform translateX: 30 Y: 30. 
		can setPaint: surf2.
		can draw.

		can pathTransform translateX: 30 Y: 30. 
		can draw.

	].
	Display getCanvas drawImage: surf asForm  at: 0@0
! !

!AthensSurfaceExamples class methodsFor: 'examples' stamp: 'IgorStasenko 9/2/2012 20:09'!
draw2Strings
"
self subclasses anyOne exampleDrawText
"
	| surf  font1 font2 ascent advance |
	
	font1 := LogicalFont familyName: 'Arial' pointSize: 10.
	font2 := LogicalFont familyName: 'Tahoma' pointSize: 20.

	ascent := font1 getPreciseAscent max: font2 getPreciseAscent.
	
	surf := self newSurface: 600@200.
	
	surf drawDuring: [:can |
		surf clear: Color white.
		can pathTransform loadIdentity.

		can pathTransform translateX: 30 Y: 30;
		scaleBy: 1.9.

		can setPaint: (Color black).
		can setFont: font1.
		can pathTransform translateX: 0 Y: ascent.

		advance := can drawString: 'Keep '.
		can setFont: font2.

		"The #drawString: method answers a cumulative advance of rendered string,
		so by translating origin with advance, we can draw another string on 'same' line "
		can pathTransform translateBy: advance.
		
		advance := can drawString: 'IT'.
		can setFont: font1.
		can pathTransform translateBy: advance.
		can drawString: 'in mind.'.
		
	].
	Display getCanvas drawImage: 	surf asForm  at: 0@0
! !

!AthensSurfaceExamples class methodsFor: 'examples' stamp: 'NicolaiHess 6/25/2014 00:11'!
example9
"
Fill the rectangle using image paint.
self example9
"

	| surf paint f  |
	
	surf := self newSurface: 200@200.
	
	surf asForm getCanvas fillRectangle: surf asForm boundingBox color: Color white.
	
	f := Form extent: 10@10 depth: 32.
	f getCanvas fillRectangle: (0@0 corner: 5@5) color: (Color red alpha: 0.1).
	f getCanvas fillRectangle: (5@5 corner: 10@10) color: (Color green alpha: 0.1).

	paint := surf createFormPaint: f.
	
	surf drawDuring: [:can |

			can setPaint: paint.

			can drawShape: (0@0 corner: 100@200).
		
			Display getCanvas drawImage: 	surf asForm  at: 0@0
	].

! !

!AthensSurfaceExamples class methodsFor: 'examples' stamp: 'NicolaiHess 6/25/2014 00:13'!
exampleUseForm
" self exampleUseForm"
	| surf  form |
	
	form := Form extent: 100@100 depth: 32.
	form getCanvas fillRectangle: (0@0 corner: 30@30)  color: (Color red).
	form getCanvas fillRectangle: (10@10 corner: 40@40)  color: (Color green).
	form getCanvas fillRectangle: (20@20 corner: 50@50)  color: (Color blue).
	
	surf := AthensCairoSurface fromForm: form.
	Display getCanvas drawImage: surf asForm  at: 0@0
! !

!AthensSurfaceExamples class methodsFor: 'instance initialization' stamp: 'NicolaiHess 7/11/2014 13:26'!
newSurface:  extent
	^ AthensCairoSurfaceExamples newSurface: extent! !

!AthensSurfaceExamples class methodsFor: 'examples' stamp: 'IgorStasenko 4/7/2014 15:42'!
drawFontMetrics
"
self  drawFontMetrics
"
	|   font |
	
	
	font := LogicalFont familyName: 'Arial' pointSize: 10.
	self openViewOn: [ :can |

		can pathTransform restoreAfter: [

		can pathTransform translateX: 30 Y: 30;
		scaleBy: 20.

		can setPaint: (Color r:1 g:0.9 b:0.9);
			drawShape: (0@0 corner: 400@ (font getPreciseHeight)).		

		can setPaint: (Color r: 0.9 g: 0.9 b: 1);
			drawShape: (0@0 corner: 400@ (font getPreciseAscent+font getPreciseDescent)).		

		(can setStrokePaint: Color green) width: 0.05.
		can drawShape: (can createPath: [:builder |
			builder 
				moveTo: 0@0;
				lineTo: 0@font getPreciseAscent
			 ] ).

		(can setStrokePaint: Color red) width: 0.05.
		can drawShape: (can createPath: [:builder |
			builder 
				moveTo: 0@font getPreciseAscent;
				lineTo: 0@font getPreciseDescent
			 ] ).

		(can setStrokePaint: Color blue) width: 0.05.
		can drawShape: (can createPath: [:builder |
			builder 
				moveTo: 0@font getPreciseAscent;
				lineTo: 400@0
			 ] ).
				
		can setFont: font.
		can setPaint: (Color black).
		can pathTransform translateX: 0 Y: (font getPreciseAscent).
		can drawString: 'yh'.
		] ]

 ! !

!AthensSurfaceExamples class methodsFor: 'examples' stamp: 'NicolaiHess 6/25/2014 00:11'!
example8
"Draw a rectangle filled by radial gradient. 
self example8
"

	| surf paint |
	
	surf := self newSurface: 200@200.
	
	paint := surf 
		createRadialGradient: { 0->Color red . 1->Color green } 
		center: 100@100
		radius: 100.
	
	surf drawDuring: [:can |
			surf clear.

			can pathTransform loadIdentity.
			can setPaint: paint.

			can drawShape: (0@0 corner: 200@200).
		
			Display getCanvas drawImage: 	surf asForm  at: 0@0
	].

! !

!AthensSurfaceExamples class methodsFor: 'opening view' stamp: 'NicolaiHess 6/24/2014 20:45'!
openViewOn: aBlock

	^ AthensSceneView new
		scene: (self newAsSceneFrom:aBlock);
		openInWindow ! !

!AthensSurfaceExamples class methodsFor: 'examples' stamp: 'NicolaiHess 6/25/2014 00:12'!
exampleClip

"
self exampleClip
"
	| surf |
	
	surf := self newSurface: 100@100.
	
	surf drawDuring: [:can |
		surf clear.
		can pathTransform loadIdentity.
		can setPaint: (Color blue).
		can drawShape: (0@0 corner: 100@ 100).

		can pathTransform translateX: -20 Y: -20.
		can clipBy: (20@20 corner: 80@80) during: [
			can pathTransform translateX: 20 Y: 20.
			can setPaint: (Color red).
			can drawShape: (0@0 corner: 100@ 100).
		]
	].
	Display getCanvas drawImage: 	surf asForm  at: 0@0
! !

!AthensSurfaceExamples class methodsFor: 'examples' stamp: 'NicolaiHess 6/25/2014 00:11'!
example4
	" 
	This example demostrates that same path could be reused multiple times when drawing.
	First, we creating a path, and later we can use it in #drawShape: command.
	self example4
	"

	| surf path |
	
	surf := self newSurface: 100@100.
	
	path :=  surf createRectanglePath: (0@ 0 corner: 20@ 20).
	
	surf drawDuring: [:can |
		surf clear.
		can pathTransform loadIdentity.
		can setPaint: (Color red).
		can pathTransform translateX: 5 Y: 5.
		can drawShape: path.
		can setPaint: (Color blue).
		can pathTransform translateX: 5 Y: 5.
		can drawShape: path.
	].
	Display getCanvas drawImage: 	surf asForm  at: 0@0
! !

!AthensSurfaceExamples class methodsFor: 'examples' stamp: 'NicolaiHess 6/25/2014 00:11'!
example5
" draw a hollow rectangle (frame) using lineTo/moveTo commands,
 with path, consisting of two contours: outer and inner one.

Note how #moveTo: command implicitly starts new contour
when inssued in the middle of command chain.
self example5
"

	| surf |
	
	surf := self newSurface: 100@100.
	
	surf drawDuring: [:can |
		surf clear.
		
		can setPaint: Color blue.
		
		can drawShape: (
			can createPath: [:path |
				path 
					absolute;
					lineTo: 50@0;
					lineTo: 50@50;
					lineTo: 0@50;
					moveTo: 10@10;
					lineTo: 10@40;
					lineTo: 40@40;
					lineTo: 40@10
			])
	
	].

	Display getCanvas drawImage: 	surf asForm  at: 0@0
! !

!AthensSurfaceExamples class methodsFor: 'examples' stamp: 'IgorStasenko 3/28/2012 14:03'!
example3
" 
Draw simple filled path, changing the transformation and colors to get some animated effects.

 self example3 
"

	| surf |
	
	surf := self newSurface: 800@800.
	
	surf drawDuring: [:can | | transform path |
	
		can setPaint: Color blue.

		can pathTransform translateX: 200 Y: 200.	
		can pathTransform scaleBy: 6.

		path := can createPath: [:pathbuilder |
			pathbuilder 
				absolute;
				moveTo: -25 @ -25;
				curveVia: 25@ -25 to: 25@25;
				curveVia: -25@25 to: -25@ -25
		].
		
		
			1 to: 1000 do: [:i |
				can setPaint: Color random.

				can pathTransform restoreAfter: [

					can pathTransform rotateByDegrees: i*5.
					can pathTransform scaleBy: (1- ( i/2000)).
					can drawShape: path.
				].
				Display getCanvas drawImage: 	surf asForm  at: 0@0. 
		]	
	].
! !

!AthensSurfaceExamples class methodsFor: 'examples' stamp: 'IgorStasenko 4/12/2013 10:13'!
example6
"Draw two rectangles, filled by linear gradient. 

Note that it should produce same rectangles with exact same fills, because gradient paint 
coordinates are affected by pathTransform matrix.


self example6
"

	| surf paint |
	
	surf := self newSurface: 100@200.
	
	paint := surf 
		createLinearGradient: { 0->Color red .  1->Color green } 
		start: 0@0 
		stop: 50@50.
	
	surf drawDuring: [:can |
		surf clear.
		
		can setPaint: paint.

		can drawShape: (0@0 corner: 50@50).
		
		can pathTransform translateX: 50 Y: 50; rotateByDegrees: 30.
		can drawShape: (0@0 corner: 50@50).
		
	].

	Display getCanvas drawImage: 	surf asForm  at: 0@0
! !

!AthensSurfaceExamples class methodsFor: 'instance creation' stamp: 'NicolaiHess 6/24/2014 20:53'!
newAsSceneFrom: aBlock
	^ self new renderBlock: aBlock; yourself! !

!AthensTextBackground commentStamp: 'TorstenBergmann 2/12/2014 22:21'!
Athens text background !
!AthensTextBackground methodsFor: 'scanning' stamp: 'IgorStasenko 10/28/2011 14:31'!
emphasizeScanner: scanner
	"Set the emphasis for text display"
	scanner textBackground: color! !

!AthensTextBackground methodsFor: 'comparing' stamp: 'IgorStasenko 10/28/2011 14:31'!
hash
	^ color hash! !

!AthensTextBackground methodsFor: 'scanning' stamp: 'IgorStasenko 10/28/2011 14:31'!
dominates: other
	^ other class == self class! !

!AthensTextBackground methodsFor: 'printing' stamp: 'IgorStasenko 10/28/2011 14:32'!
printOn: aStream
	super printOn: aStream.
	aStream nextPutAll: ' code: '; print: color! !

!AthensTextBackground methodsFor: 'accessing' stamp: 'IgorStasenko 10/28/2011 14:42'!
color: anObject

	color := anObject! !

!AthensTextBackground methodsFor: 'accessing' stamp: 'IgorStasenko 10/28/2011 14:42'!
color

	^ color! !

!AthensTextComposer commentStamp: 'TorstenBergmann 2/12/2014 22:20'!
Compose text!
!AthensTextComposer methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/21/2011 12:51'!
lines
	^ lines! !

!AthensTextComposer methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/30/2011 19:14'!
scan: aText for: scanner
	" scan text from starting index,
	answer the index of first character for potential next line"
	| index top |	

	text := aText.
	scanner text: text.

	"edge case, text is empty "
	text isEmpty ifTrue: [ ^ scanner ].
	
	scanner newLine: 1.
	index := 1.

	text runs withStartStopAndValueDo: [:start :stop :values |
		
		scanner setAttributes: values.
		start to: stop do: [:i |  | ch |
			ch := text at: i.
			ch = Character cr 
				ifTrue: [ 
					scanner endLine: i - 1.
					scanner newLine: i + 1 ]
				ifFalse: [
					scanner addCharacter: i.
				]
			]
	].
	scanner endLine: (text size).

	lines := scanner lines.

	"set the lines top offset"
	top := 0.
	lines do: [:line |
		line top: top.
		top := top + line height ].
	
! !

!AthensTextComposer methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/17/2011 12:42'!
renderOn: aCanvas

	| renderer |
	
	renderer := AthensTextRenderer new.
	renderer render: text lines: lines on: aCanvas.
! !

!AthensTextComposer class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/11/2011 16:07'!
scan: aText for: scanner
	^ self new scan: aText for: scanner! !

!AthensTextDisplayCommand commentStamp: 'IgorStasenko 2/6/2012 16:20'!
An abstract base class for all text rendering commands.

A text rendered takes a stream (or list) of my (sub)instances and in that way it renders the text!
!AthensTextDisplayCommand methodsFor: 'accessing' stamp: 'IgorStasenko 11/10/2011 10:19'!
insert: aCommands

	| nn |
	nn := next.
	next := aCommands.
	next tail next: nn! !

!AthensTextDisplayCommand methodsFor: 'accessing' stamp: 'IgorStasenko 11/10/2011 10:21'!
do: aBlock
	| nn |
	nn := self.
	
	[ nn isNil ] whileFalse: [ 
		aBlock value: nn.
		nn := nn next. ]! !

!AthensTextDisplayCommand methodsFor: 'copying' stamp: 'IgorStasenko 11/10/2011 10:47'!
postCopy
	"unlink the copy by default"
	next := nil! !

!AthensTextDisplayCommand methodsFor: 'accessing' stamp: 'IgorStasenko 11/10/2011 10:12'!
next

	^ next! !

!AthensTextDisplayCommand methodsFor: 'rendering' stamp: 'IgorStasenko 10/30/2011 18:57'!
renderOn: renderer
	self shouldBeImplemented ! !

!AthensTextDisplayCommand methodsFor: 'accessing' stamp: 'IgorStasenko 11/10/2011 10:15'!
tail
	| nn |
	nn := self.
	[ nn next notNil ] whileTrue: [ nn := nn next ].
	^ nn! !

!AthensTextDisplayCommand methodsFor: 'accessing' stamp: 'IgorStasenko 11/10/2011 10:12'!
next: anObject
	
	next := anObject! !

!AthensTextDisplayCommand methodsFor: 'accessing' stamp: 'IgorStasenko 11/10/2011 10:14'!
addLast: aCommand
	self tail next: aCommand! !

!AthensTextLine commentStamp: 'IgorStasenko 2/6/2012 16:20'!
I representing a single line of text!
!AthensTextLine methodsFor: 'accessing' stamp: 'IgorStasenko 10/11/2011 17:19'!
endIndex

	^ endIndex! !

!AthensTextLine methodsFor: 'accessing' stamp: 'IgorStasenko 11/7/2011 14:44'!
heightAndDescent

	^ height + maxDescent! !

!AthensTextLine methodsFor: 'accessing' stamp: 'IgorStasenko 10/5/2011 18:04'!
height
	^ height! !

!AthensTextLine methodsFor: 'accessing' stamp: 'IgorStasenko 10/11/2011 17:19'!
text

	^ text! !

!AthensTextLine methodsFor: 'accessing' stamp: 'IgorStasenko 10/11/2011 17:19'!
height: anObject

	height := anObject! !

!AthensTextLine methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/10/2011 10:15'!
initialize
	commands := tail := nil.
	width := height := maxAscent := maxDescent := 0.! !

!AthensTextLine methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/28/2011 12:41'!
maxHeight: aHeight
	height := height max: aHeight! !

!AthensTextLine methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/10/2011 10:20'!
addCommand: aCommand

	commands 
		ifNil: [ tail := commands := aCommand. ]
		ifNotNil: [ tail next: aCommand ].
	tail := tail tail.
! !

!AthensTextLine methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/5/2011 18:05'!
top: aTop
	top := aTop! !

!AthensTextLine methodsFor: 'accessing' stamp: 'IgorStasenko 10/28/2011 11:00'!
maxAscent
	^ maxAscent! !

!AthensTextLine methodsFor: 'accessing' stamp: 'IgorStasenko 10/11/2011 17:19'!
width: anObject

	width := anObject! !

!AthensTextLine methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/11/2011 16:10'!
startIndex: index
	startIndex := index! !

!AthensTextLine methodsFor: 'accessing' stamp: 'IgorStasenko 10/11/2011 17:19'!
endIndex: anObject

	endIndex := anObject! !

!AthensTextLine methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/5/2011 18:04'!
width
	^ width! !

!AthensTextLine methodsFor: 'accessing' stamp: 'IgorStasenko 11/7/2011 14:43'!
maxDescent: mascent

	maxDescent := mascent max: maxDescent! !

!AthensTextLine methodsFor: 'rendering' stamp: 'IgorStasenko 11/10/2011 12:23'!
renderOn: aTextRenderer
	
	commands ifNil: [ ^ self ]. 
	commands do: [ :cmd |
		cmd renderOn: aTextRenderer
	].
! !

!AthensTextLine methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/28/2011 12:43'!
addWidth: aNumber
	width := width + aNumber.! !

!AthensTextLine methodsFor: 'accessing' stamp: 'IgorStasenko 11/21/2011 12:47'!
top
	^ top! !

!AthensTextLine methodsFor: 'accessing' stamp: 'IgorStasenko 10/11/2011 17:19'!
commands: anObject

	commands := anObject! !

!AthensTextLine methodsFor: 'accessing' stamp: 'IgorStasenko 11/21/2011 12:47'!
bottom
	^ top + self heightAndDescent! !

!AthensTextLine methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/11/2011 16:48'!
text: aText 
	text := aText! !

!AthensTextLine methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/20/2011 10:30'!
renderOn: anAthensTextRenderer x: aSmallInteger y: aSmallInteger3 
	self shouldBeImplemented.! !

!AthensTextLine methodsFor: 'accessing' stamp: 'IgorStasenko 10/28/2011 11:05'!
maxAscent: mascent
	maxAscent := mascent max: maxAscent! !

!AthensTextLine methodsFor: 'accessing' stamp: 'IgorStasenko 10/11/2011 17:19'!
commands

	^ commands! !

!AthensTextLine methodsFor: 'accessing' stamp: 'IgorStasenko 11/7/2011 14:36'!
maxDescent
	^ maxDescent! !

!AthensTextLine methodsFor: 'accessing' stamp: 'IgorStasenko 10/11/2011 17:19'!
startIndex

	^ startIndex! !

!AthensTextMorph commentStamp: '<historical>'!
this class is subject of changes/removal. do not use it.!
!AthensTextMorph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/21/2011 12:23'!
createParagraph
	| newParagraph |
	self setDefaultContentsIfNil.

	"...Code here to recreate the paragraph..."
	newParagraph  := AthensParagraph new.
	
	newParagraph
		compose: text
		style: textStyle copy
		in: self container.
		
		
	wrapFlag ifFalse:
		["Was given huge container at first... now adjust"
		newParagraph adjustRightX].
	
	newParagraph focused: (self currentHand keyboardFocus == self).
	
	paragraph := newParagraph.
	self fit.

	^ paragraph! !

!AthensTextMorph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/21/2011 13:02'!
selectionColor: aColor
	selectionColor := aColor.
	! !

!AthensTextMorph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/21/2011 12:18'!
paragraph
	^ paragraph ifNil: [ paragraph := self createParagraph ].
! !

!AthensTextMorph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/21/2011 12:42'!
contents: stringOrText wrappedTo: width
	"Accept new text contents.  Lay it out, wrapping to width.
	Then fit my height to the result."
	wrapFlag := true.
	super extent: width truncated@self height.
	self newContents: stringOrText! !

!AthensTextRenderTest commentStamp: 'TorstenBergmann 2/12/2014 22:20'!
Visual tests for correct rendering of text using Athens!
!AthensTextRenderTest class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/30/2012 19:01'!
test5
	|  t  c surf |

"t := '12345 pi kl mn op gj the text must flow' "

t := 'U' 
asText .
	t addAttribute: (TextFontReference toFont: (
LogicalFont
 familyName: 'Tahoma'
 pointSize: 10
)).
	c := AthensTextComposer scan: t for: AthensTextScanner new.

	surf := self surfaceClass extent: Display extent.
	surf drawDuring: [ :canvas | 
		
		canvas setPaint: (Color yellow alpha: 0.5).
		canvas drawShape: (0@0 corner: 300@300).

		canvas pathTransform scaleBy: 1.
		1 to: 20 do: [:i |
			c renderOn: canvas.
			canvas pathTransform translateBy: 10@0.1.
		]
	].
	Display getCanvas translucentImage: surf form at: 100@100

! !

!AthensTextRenderTest class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 9/2/2012 21:08'!
testText
	|  t  |

t := 'The safety Dconstraint is that the garbage collector 
MUST NOT collect any storage that then becomes needed to continue correct execution of the program. Should weak references 
be added, then garbage collection decisions become observable. 
Based on a suggestion from Cameron McCormack, we state the 
safety constraint as follows: So long as operational semantics of 
the remainder of the program execution includes the possibility that 
a reference to an object X may be dereferenced, then X MUST NOT 
be collected. Thus, the garbage collector is allowed to ignore any 
references that remain present in the semantic state, but which it 
can ascertain will never be dereferenced in any possible execution. 
This sets an upper bound on what state MAY be collected. Put 
another way, if the garbage collector ever reports that X has been 
collected, such as by nullifying a weak reference to X, if operational 
semantics of remaining execution requires the traversal of a strong 
(non-weak) reference to X, then the previous report demonstrates a 
safety violation. 
' 
asText .
	t addAttribute: (TextFontReference toFont: (
LogicalFont
 familyName: 'Arial'
 pointSize: 8
)).
	t addAttribute: (TextEmphasis italic) from: 5 to: 100.
	t addAttribute: (TextColor new color: (Color red)) from: 10 to: 60.
	t addAttribute: (TextEmphasis italic) from: 100 to: 200.
	t addAttribute: (TextColor new color: Color green) from: 230 to: 360.

	t addAttribute: (
		TextFontReference toFont: ( LogicalFont familyName: 'Tahoma'  pointSize: 14)) from: 88 to: 200.

	^ t! !

!AthensTextRenderTest class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/19/2011 14:39'!
testBlitting
	| fnt form blt |

	fnt := LogicalFont
	 familyName: 'Arial'
 	pointSize: 24.

	form := fnt realFont
		glyphOf: $W
				destDepth: 8
				colorValue: 1
				subpixelPosition: 0.


	blt := BitBlt toForm: Display.
	
	blt 
		sourceForm: form;
		destOrigin: 0@0;
		sourceOrigin: 0@0;
		halftoneForm: nil;
		combinationRule: 41;
		width: form width;
		height: form height;
		
		copyBitsColor: 0
		alpha: 255
		gammaTable:  FreeTypeSettings current gammaTable
		ungammaTable: FreeTypeSettings current gammaInverseTable.
		
"	blt copyForm: form to: 100@100 rule: 41."
	Display forceToScreen.
	
"
	Display getCanvas translucentImage: form at: 0@0.		

"
	
	
! !

!AthensTextRenderTest class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/30/2012 19:01'!
test4
	|  t  c surf |

"t := '12345 pi kl mn op gj the text must flow' "

t := 'Unfortunately this class has not been documented yet.' 
asText .
	t addAttribute: (TextFontReference toFont: (
LogicalFont
 familyName: 'Tahoma'
 pointSize: 10
)).
	t addAttribute: (TextColor new color: Color red) from: 3 to: 10.


	c := AthensTextComposer scan: t for: AthensTextScanner new.

	surf := self surfaceClass extent: Display extent.
	
	surf drawDuring: [ :canvas | 
		
		canvas setPaint: (Color yellow alpha: 0.5).
		canvas drawShape: (0@0 corner: 300@300).

		canvas pathTransform scaleBy: 1.
		1 to: 20 do: [:i |
			c renderOn: canvas.
			canvas pathTransform translateBy: 0.1@10.
		]
	].
	Display getCanvas translucentImage: surf form at: 100@100

! !

!AthensTextRenderTest class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/30/2012 18:59'!
surfaceClass
	^ AthensCairoSurface! !

!AthensTextRenderTest class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/30/2012 19:00'!
test2
	|  t  c surf |
	t := self testText. 
	t addAttribute: (AthensTextBackground new color: (Color green alpha: 0.3 )) from: 1 to: 267.

	c := AthensTextComposer scan: t for: AthensTextScanner new.

	surf := self surfaceClass extent: Display extent.
	
	surf drawDuring: [ :canvas | 
		
		canvas setPaint: (Color white ).
		canvas drawShape: (0@0 corner: 300@300).
		canvas pathTransform scaleBy: 1.

		canvas pathTransform translateX: 300 Y: 0.

		canvas setPaint: Color yellow.
		canvas pathTransform rotateByDegrees: 0.
		c renderOn: canvas
	].

	Display getCanvas translucentImage: surf form at: 0@0

! !

!AthensTextRenderTest class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 9/2/2012 22:25'!
testWindowRender
	| surf |
	surf := self surfaceClass extent: Display extent.

	surf drawDuring: [ :canvas | 
		
		canvas pathTransform scaleBy: 1.
		canvas fullDrawMorph: self testWindow.

	].

	Display getCanvas translucentImage: surf asForm at: 0@0

! !

!AthensTextRenderTest class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/30/2012 19:01'!
test3
	|  t  c surf |

"t := '12345 pi kl mn op gj the text must flow' "

t := 'qW' 
asText .
	t addAttribute: (TextFontReference toFont: (
LogicalFont
 familyName: 'Arial'
 pointSize: 8
)).

	c := AthensTextComposer scan: t for: AthensTextScanner new.

	surf := self surfaceClass extent: Display extent.
	surf drawDuring: [ :canvas | 
		
		canvas setPaint: (Color yellow alpha: 0.5).
		canvas drawShape: (0@0 corner: 300@300).

		canvas pathTransform translateBy: 200@200.
				
"		canvas pathTransform rotateByDegrees: 90. "
		canvas pathTransform scaleBy: 4.
	1 to: 10 do: [:i |
		
		canvas setPaint: (Color blue alpha: 0.5).
		canvas drawShape: (0@0 corner: 100@10).
		
		c renderOn: canvas.
		
		canvas pathTransform rotateByDegrees: 5. 
		canvas pathTransform translateBy: 0 @11 .
	].
	].
	Display getCanvas translucentImage: surf form at: 100@100

! !

!AthensTextRenderTest class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/21/2011 16:25'!
testWindow

	^ (AthensPluggableTextMorph
		on: self
		text: #testText
		accept: nil) embeddedInMorphicWindowLabeled: 'A fancy looking title text'
! !

!AthensTextRenderTest class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/8/2013 18:35'!
test1
	|  t  c  |

t := '
AthensTextRenderTest test1

leftFlush
p := MultiNewParagraph new.

p compose: t
	style: TextStyle default
	from: 1
	in: (0@0 corner: 100@100).
p

MultiNewParagraph
TextStyle default alignment


globalBounds:  toLocal: 
' 
asText .

	t addAttribute: (TextColor new color: Color red) from: 3 to: 10.
	t addAttribute: (TextEmphasis italic) from: 5 to: 13.

	c := AthensTextComposer scan: t for: AthensTextScanner new.


	AthensSceneView new
	scene:  [:canvas |
		canvas pathTransform scaleBy: 0.8.
		c renderOn: canvas
	];
	openInWindow
	 
! !

!AthensTextRenderer commentStamp: 'IgorStasenko 10/20/2011 10:14'!
This is a text renderer, which pipelining a text command(s) , produced by AthensTextComposer
into a concrete calls to canvas.

Its using a glyph renderer instance(s) to draw separate font glyphs on a surface in a most suitable/efficient
manner for given Athens surface.
!
!AthensTextRenderer methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/7/2011 14:41'!
renderBackground: aColor width: w
"self halt."
	canvas setPaint: aColor.
	canvas drawShape: ( advance x@0 corner: advance x + w +1@ currentLine heightAndDescent)
! !

!AthensTextRenderer methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/20/2011 13:07'!
initialize
	color := Color black.! !

!AthensTextRenderer methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 9/2/2012 19:01'!
setCurrentColor: aColor
	color = aColor ifTrue: [ ^ self ].
	color := aColor.
"	canvas setPaint: aColor."
	glyphRenderer ifNotNil:  [ glyphRenderer setColor: aColor ].! !

!AthensTextRenderer methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 9/2/2012 19:02'!
renderCharactersFrom: start to: stop

	" accumulate advance while rendering spans"
	"canvas drawShape: (advance x @ advance y extent: 2 @ 2)."
	glyphRenderer advance: advance.
	advance := advance + (glyphRenderer renderCharacters: text from: start to: stop).
	
! !

!AthensTextRenderer methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/7/2011 14:44'!
renderBackground: bkObj
"self halt."
	canvas setPaint: bkObj color.
	canvas drawShape: ( bkObj start@0 corner: bkObj start + bkObj width @ currentLine heightAndDescent)
! !

!AthensTextRenderer methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 9/1/2012 21:23'!
render: aText lines: lines on: aCanvas

	text := aText.
	canvas := aCanvas.
	
	canvas pathTransform restoreAfter: [

		lines do: [:line | | origY |
			currentLine := line.
			maxAscent := line maxAscent.
			"set the origin to font's baseline position"
			canvas pathTransform translateX: 0 Y: maxAscent.
			"reset advance"
			advance := 0@0.
			line renderOn: self.
			"line is rendered, advance vertically by line height"
			canvas pathTransform translateX: 0 Y: line height * 1.2 - maxAscent.
		] ]! !

!AthensTextRenderer methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 9/1/2012 22:03'!
setCurrentFont: aFont
	font := aFont.
	glyphRenderer := font glyphRendererOn: canvas surface.
	glyphRenderer 
		advance: advance;
		setColor: color.! !

!AthensTextRenderer class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 9/1/2012 21:16'!
textGoryDetails

"
Took from: http://www.freetype.org/freetype2/docs/tutorial/step2.html

(Font face metrics)
In this case, you can access the global design metrics as:

units_per_EM 	

This is the size of the EM square for the font face. It is used by scalable formats to scale design coordinates to device pixels, as described in the last chapter of this section. Its value usually is 2048 (for TrueType) or 1000 (for Type 1), but others are possible too. It is set to 1 for fixed-size formats like FNT/FON/PCF/BDF.

bbox 	

The global bounding box is defined as the largest rectangle that can enclose all the glyphs in a font face.

ascender 	

The ascender is the vertical distance from the horizontal baseline to the highest ‘character’ coordinate in a font face. Unfortunately, font formats define the ascender differently. For some, it represents the ascent of all capital latin characters (without accents), for others it is the ascent of the highest accented character, and finally, other formats define it as being equal to bbox.yMax.

descender 	

The descender is the vertical distance from the horizontal baseline to the lowest ‘character’ coordinate in a font face. Unfortunately, font formats define the descender differently. For some, it represents the descent of all capital latin characters (without accents), for others it is the ascent of the lowest accented character, and finally, other formats define it as being equal to bbox.yMin. This field is negative for values below the baseline.

height 	

This field is simply used to compute a default line spacing (i.e., the baseline-to-baseline distance) when writing text with this font. Note that it usually is larger than the sum of the ascender and descender taken as absolute values. There is also no guarantee that no glyphs extend above or below subsequent baselines when using this distance.

max_advance_width 	

This field gives the maximum horizontal cursor advance for all glyphs in the font. It can be used to quickly compute the maximum advance width of a string of text. It doesn't correspond to the maximum glyph image width!!

max_advance_height 	

Same as max_advance_width but for vertical text layout.

underline_position 	

When displaying or rendering underlined text, this value corresponds to the vertical position, relative to the baseline, of the underline bar's center. It is negative if it is below the baseline.

underline_thickness 	

When displaying or rendering underlined text, this value corresponds to the vertical thickness of the underline.


"! !

!AthensTextScanner commentStamp: 'IgorStasenko 2/6/2012 16:22'!
I responsible for scanning the Text and transforming it into a list of AthensTextLine, where each line is a list of AthensTextDisplayCommand (sub)instances!
!AthensTextScanner methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/11/2011 17:19'!
endLine: index

	currentLine  endIndex: index! !

!AthensTextScanner methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/10/2011 11:13'!
defaultColor
	^ Color black! !

!AthensTextScanner methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/11/2011 16:53'!
defaultTextStyle

	^ TextStyle default! !

!AthensTextScanner methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/17/2011 12:45'!
lines
	^ lines! !

!AthensTextScanner methodsFor: 'text attributes' stamp: 'IgorStasenko 10/11/2011 16:52'!
setFont: fontNumber

	self setActualFont: (self textStyle fontAt: fontNumber).
	
	! !

!AthensTextScanner methodsFor: 'text attributes' stamp: 'IgorStasenko 11/10/2011 11:31'!
textBackground: aColor

	"background is transparent by default "
	
	(currentBackground notNil and: [ currentBackground color = aColor ])
		ifTrue: [ ^ self].
		
	currentBackground ifNil: [ aColor isTransparent ifTrue: [ ^ self ] ].
	
	currentBackground := AthensBackgroundChange new color: aColor.
	currentBackground start: currentLine width.
	currentLine addCommand: currentBackground.! !

!AthensTextScanner methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/11/2011 16:08'!
text: aText 
	text := aText! !

!AthensTextScanner methodsFor: 'text attributes' stamp: 'IgorStasenko 11/10/2011 11:14'!
addEmphasis: emphasis
	| fnt |
	
	fnt := currentFont ifNil: [ self defaultFont ] ifNotNil: [ currentFont font ].
	
	self setActualFont: (fnt emphasized: emphasis)! !

!AthensTextScanner methodsFor: 'text attributes' stamp: 'IgorStasenko 11/10/2011 12:04'!
setActualFont: aFont

	currentFont ifNil: [
		
		currentFont := AthensFontChange new font: aFont.
		self addCommand: currentFont.
		^ self 
	].

	aFont = currentFont font ifFalse: [
		currentFont := AthensFontChange new font: aFont.
		self addCommand: currentFont.
	].
! !

!AthensTextScanner methodsFor: 'text attributes' stamp: 'IgorStasenko 11/10/2011 11:15'!
textColor: aColor

	currentColor ifNil: [
		currentColor := AthensColorChange new color: aColor.
		self addCommand: currentColor.
		^ self 
	].

	currentColor color = aColor ifFalse: [
		currentColor := AthensColorChange new color: aColor.
		self addCommand: currentColor.	
	].
	! !

!AthensTextScanner methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/10/2011 11:54'!
initialize
	lines := OrderedCollection new.
	currentAttributes := #().! !

!AthensTextScanner methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/10/2011 12:21'!
newLine: startingIndex 

	currentLine := lines add: (AthensTextLine new text: text;
		startIndex: startingIndex; yourself).

"	currentStrip ifNotNil: [
		
		currentLine addCommand: currentFont copy.
		currentLine addCommand: currentColor copy.

		currentBackground ifNotNil: [
			currentBackground := currentBackground copy start: 0; width: 0. 
			currentLine addCommand: currentBackground ].
	].
"
"reset everything, to make sure all attributes will be reapplied for new line"
	
	currentColor := currentBackground := currentFont := currentStrip := nil.! !

!AthensTextScanner methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/10/2011 12:13'!
setAttributes: anArray 
	currentBackground := nil.
	currentAttributes := anArray.
	
	"we should reset character string here"
	currentStrip := nil.
! !

!AthensTextScanner methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/10/2011 12:00'!
addCharacter: position
	| charWidth fnt |

	currentStrip ifNil: [

		self applyAttributes.
		
		fnt := currentFont font.
		currentLine maxAscent: fnt getPreciseAscent.
		currentLine maxDescent: fnt getPreciseDescent.
		currentLine maxHeight: fnt getPreciseHeight.
		
		currentStrip := AthensCharacterSpan new.
		currentLine addCommand: currentStrip.
		currentStrip start: position.
	].
	
	charWidth := currentFont font getGlyphWidth: (text at: position).
	currentLine addWidth: charWidth.
	currentBackground ifNotNil: [
		currentBackground addWidth: charWidth ].
	
	currentStrip stop: position.
! !

!AthensTextScanner methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/10/2011 11:26'!
addCommand: aCommand
	currentLine addCommand: aCommand! !

!AthensTextScanner methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/28/2011 14:58'!
resetBackground
	self textBackground: Color transparent.! !

!AthensTextScanner methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/10/2011 11:58'!
applyAttributes
	currentAttributes do: [:attr |
		attr emphasizeScanner: self ]. 
	
	currentFont ifNil: [ self setActualFont: self defaultFont ].
	currentColor ifNil: [ self textColor: self defaultColor ].
	! !

!AthensTextScanner methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/11/2011 16:53'!
textStyle
	^ textStyle ifNil: [ textStyle := self defaultTextStyle ]! !

!AthensTextScanner methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/10/2011 11:13'!
defaultFont

	^ self textStyle defaultFont! !

!AthensTigerShape commentStamp: 'TorstenBergmann 2/12/2014 22:16'!
The tiger shape (see VGTigerDemo runDemo)!
!AthensTigerShape methodsFor: 'as yet unclassified' stamp: ''!
setPath: anAthensCairoPath
		path := anAthensCairoPath! !

!AthensTigerShape methodsFor: 'as yet unclassified' stamp: ''!
fillRule
	^ fillRule! !

!AthensTigerShape methodsFor: 'as yet unclassified' stamp: ''!
capStyle: cap
	capStyle := cap.! !

!AthensTigerShape methodsFor: 'as yet unclassified' stamp: ''!
miterLimit: lim
	miterLimit := lim.! !

!AthensTigerShape methodsFor: 'as yet unclassified' stamp: ''!
renderOn: can

	fill ifTrue: [ 
		can setPaint: fillPaint.
		can drawShape: path.	
	].

	stroke ifTrue: [
		can setStrokePaint: strokePaint.	
		can drawShape: path.	
	]! !

!AthensTigerShape methodsFor: 'as yet unclassified' stamp: ''!
addStroke
	stroke := true.! !

!AthensTigerShape methodsFor: 'as yet unclassified' stamp: ''!
fillPaint: aColor 
	fillPaint := aColor! !

!AthensTigerShape methodsFor: 'as yet unclassified' stamp: ''!
initialize 
	fill := stroke := false.! !

!AthensTigerShape methodsFor: 'as yet unclassified' stamp: ''!
joinStyle: join
	joinStyle := join.! !

!AthensTigerShape methodsFor: 'as yet unclassified' stamp: ''!
fillRule: rule 
	fillRule := rule.! !

!AthensTigerShape methodsFor: 'as yet unclassified' stamp: ''!
strokePaint: aColor 
	strokePaint := aColor! !

!AthensTigerShape methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 4/27/2012 11:26'!
prepareFor: surface
	fill ifTrue: [
		fillPaint := surface createSolidColorPaint: fillPaint.
	].

	stroke ifTrue: [
		strokePaint := 
			surface createStrokePaintFor: (surface createSolidColorPaint: strokePaint).
	].

	! !

!AthensTigerShape methodsFor: 'as yet unclassified' stamp: ''!
strokeWidth: w
	strokeWidth := w! !

!AthensTigerShape methodsFor: 'as yet unclassified' stamp: ''!
addFill
	fill := true.! !

!AthensTransform commentStamp: 'IgorStasenko 3/7/2012 14:41'!
My instances represent an interface for coordinate system transformation defined by 3x3 matrix of following kind:

| sx   shx   x   |
| shy sy     y   |
|  w0  w1  w2 |

sx and sy define scaling in the x and y directions, respectively;
shx and shy define shearing in the x and y directions, respectively;
tx and ty define translation in the x and y directions, respectively.

AthensSurface are responsible for providing specific implementation 
of me, which is most appropriate for backend its using.

My internal representation isnt available for manipulation, for example dont assume i'm a matrix. In short, do not copy my state or modify it directly, instead use methods such as #loadAffineTransformation:, and talk to my surface.

My subclasses should implement a common protocol for applying generic types of affine transformations
on coordinate system:
- translate
- rotate
- shear
- scale
- matrix multiply
- matrix load

Surface must support 4 kinds of transformations of coordinate system(s):
- path-to-surface (#pathTransform) to transform path coordinates to surface space
- image-to-surface (#imageTransform) to transform between user coordinates and surface pixels

- fill-paint-to-user (#fillTransform)
- stroke-paint-to-user (#strokeTransform)

Given a (fill or stroke) paint-to-user transformation Tp and user-to-surface transformation Tu, the paint color and alpha of a pixel to be drawn with surface coordinates (x, y) is defined by mapping its center point (x + 1/2, y + 1/2) through the inverse transformation (Tu * Tp)^-1 , resulting in a sample point in the paint coordinate space.

All transformations, except image-to-surface , ignoring w0 , w1 and w2 values and always assume them set to { 0 , 0 , 1 } respectively.

For accessing a particular kind of transformation, send message to canvas, i.e.:

canvas pathTransform translateBy: 10@10.

It is safe to store transformation in temporary variable, as long as canvas is valid.
!
!AthensTransform methodsFor: 'transformations' stamp: 'IgorStasenko 3/7/2012 13:52'!
restoreAfter: aBlock
	"i should save the current transform state, evaluate the block, and then restore the saved transform state"
	self subclassResponsibility! !

!AthensTransform methodsFor: 'transformations' stamp: 'IgorStasenko 3/26/2011 01:55'!
translateBy: aPoint

	self subclassResponsibility! !

!AthensTransform methodsFor: 'transformations' stamp: ''!
invert
	"i should invert"
	self subclassResponsibility! !

!AthensTransform methodsFor: 'transformations' stamp: 'IgorStasenko 3/26/2011 01:56'!
rotateByDegrees: angle

	self subclassResponsibility! !

!AthensTransform methodsFor: 'transformations' stamp: 'IgorStasenko 3/26/2011 01:55'!
scaleX: fx Y: fy

	self subclassResponsibility! !

!AthensTransform methodsFor: 'accessing' stamp: 'IgorStasenko 8/31/2012 22:29'!
getMatrix
	"Answer an affine transformation matrix currently used by receiver.
	Note, that resulting matrix should be copied from receiver's data, i.e.
	no future modifications of receiver should affect the answered object.
	
	The default implementation is to answer a copy of receiver"
	
	^ self copy! !

!AthensTransform methodsFor: 'transformations' stamp: 'IgorStasenko 3/26/2011 01:55'!
scaleBy: factor

	self subclassResponsibility! !

!AthensTransform methodsFor: 'transformations' stamp: 'IgorStasenko 3/7/2012 14:00'!
loadAffineTransform: anAthenTransform
	self subclassResponsibility! !

!AthensTransform methodsFor: 'transformations' stamp: 'IgorStasenko 3/26/2011 01:55'!
rotateByRadians: angle

	self subclassResponsibility! !

!AthensTransform methodsFor: 'vector-transform' stamp: 'IgorStasenko 3/27/2011 18:42'!
transform: aPoint 
	self subclassResponsibility! !

!AthensTransform methodsFor: 'vector-transform' stamp: 'IgorStasenko 3/27/2011 18:42'!
transformX: px Y: py 
	self subclassResponsibility! !

!AthensTransform methodsFor: 'transformations' stamp: 'IgorStasenko 12/21/2011 12:39'!
translateX: px Y: py

	self subclassResponsibility! !

!AthensTransform methodsFor: 'transformations' stamp: 'IgorStasenko 12/20/2011 16:46'!
loadIdentity
	"load the identity matrix into receiver"
	self subclassResponsibility! !

!AthensTreeView commentStamp: 'TorstenBergmann 2/12/2014 22:16'!
A tree visualization using Athens for display!
!AthensTreeView methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 5/3/2013 23:14'!
root: aRootObject extentBlock: extBlock childsBlock: childsBlock

	nodeExtentBlock := extBlock.
	nodeChildsBlock := childsBlock.

	root := self buildSubtreeFor: aRootObject level: 1.
	
	self layOutGeometry! !

!AthensTreeView methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 5/3/2013 22:22'!
root: aRootObject

	root := self buildSubtreeFor: aRootObject level: 1.
	
	self layOutGeometry! !

!AthensTreeView methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 5/3/2013 23:30'!
layOutGeometry

	"first do a vertical layout"
	
	| origin |
	
	origin := 0.
	
	
	rows do: [:row |  | rowHeight color |
		
		rowHeight := 0.
		color := Color random.
		
		row do: [ :node |
			node originY: origin.
			node color: color.
			rowHeight := rowHeight max: node height.
		].
	
		origin := origin + rowHeight + self spacingBetweenRows.
	].

	"now do a horizontal one"
	
	root layoutHorizontally: 0.! !

!AthensTreeView methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 5/3/2013 22:55'!
rowAt: aLevel
	rows ifNil: [  rows := OrderedCollection new ].
	
	[ aLevel > rows size ] whileTrue: [  rows add: OrderedCollection new ].

	^ rows at: aLevel! !

!AthensTreeView methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 5/4/2013 00:34'!
renderOn: aCanvas
	aCanvas surface clear: Color white.
	root renderOn: aCanvas! !

!AthensTreeView methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 5/3/2013 22:24'!
buildSubtreeFor: aNodeObject level: aLevel
	| node childs |
	
	node := AthensSimpleTreeNode new.
	node 
		subject: aNodeObject;
		extent: (nodeExtentBlock value: aNodeObject).
		
	childs := (nodeChildsBlock value: aNodeObject) collect:  [ :each | self buildSubtreeFor: each level: aLevel+1 ].
	node children: childs.

	(self rowAt: aLevel) add: node.
	
	^ node	
! !

!AthensTreeView methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 5/3/2013 22:59'!
spacingBetweenRows
	^ 30! !

!AthensTreeView class methodsFor: 'examples' stamp: 'TorstenBergmann 2/12/2014 22:15'!
example1

	AthensTreeView openOn: Collection extentBlock: [ :each | (5 + each instVarNames size)@(5 + each methodDict size)  ] childsBlock: [:el | el subclasses ] ! !

!AthensTreeView class methodsFor: 'instance creation' stamp: 'IgorStasenko 5/3/2013 23:21'!
openOn: root extentBlock: extBlock childsBlock: childsBlock

	| scene |
	
	scene := self new root: root extentBlock: extBlock childsBlock: childsBlock.
		

	^ AthensSceneView new
		scene: scene;
		openInWindow.! !

!AthensWorldMorph commentStamp: 'NicolaiHess 1/4/2015 18:32'!
An AthensWorldMorph is a special version of a WorldMorph.
It is within a real Morph in a real morphic world. The Morph it is in defines the DisplayScreen dimension. (see AthensWrappedWorldDisplay)!
!AthensWorldMorph methodsFor: 'world state' stamp: 'NicolaiHess 1/4/2015 18:33'!
viewBox: newViewBox
	"I am now displayed within newViewBox; react."

	(self viewBox isNil or: [ self viewBox extent ~= newViewBox extent ])
		ifTrue: [ worldState canvas: nil ].
	worldState viewBox: newViewBox.
	super viewBox: newViewBox.
	worldState handsDo: [ :hand | hand releaseKeyboardFocus ].
	self fullRepaintNeeded! !

!AthensWorldMorph methodsFor: 'initialization' stamp: 'NicolaiHess 1/4/2015 18:33'!
initialize
	super initialize.
	worldState := AthensWorldState new! !

!AthensWorldMorph methodsFor: 'world state' stamp: 'NicolaiHess 1/4/2015 18:33'!
display: aWrappedDisplay
	worldState display: aWrappedDisplay! !

!AthensWorldMorph methodsFor: 'world state' stamp: 'NicolaiHess 1/4/2015 18:33'!
restoreMorphicDisplay
"overwritten for using its own display dimension"
	DisplayScreen startUp.

	self
		extent: self display extent;
		viewBox: self display boundingBox;
		handsDo: [:h | h visible: true; showTemporaryCursor: nil];
		resizeBackgroundMorph;
		restoreMainDockingBarDisplay;
		fullRepaintNeeded.
		
	self defer: [Cursor normal show].
		
	self layoutChanged.
! !

!AthensWorldMorph methodsFor: 'world state' stamp: 'NicolaiHess 1/4/2015 18:33'!
display
	worldState display! !

!AthensWorldState commentStamp: 'NicolaiHess 1/4/2015 18:31'!
An AthensWorldState is a subclass of WorldState, that uses a special (fake) Display based on a real Morph. This is used to simulate a WorldMorph that actually resides in another Morph. This display adapts the owner dimensions as the "DisplayScreen"-Dimension.

!
!AthensWorldState methodsFor: 'accessing' stamp: 'NicolaiHess 1/4/2015 18:32'!
display: aDisplay
	display := aDisplay! !

!AthensWorldState methodsFor: 'update cycle' stamp: 'NicolaiHess 1/4/2015 18:32'!
doDeferredUpdatingFor: aWorld
	"overwritten from WorldState to use ower own display"

	(self display deferUpdates: true) ifNil: [ ^ false ].
	(canvas notNil and: [ canvas form == Display ])
		ifFalse: [ 
			aWorld viewBox: self display boundingBox.	"do first since it may clear canvas"
			self canvas: (self display getCanvas copyClipRect: self display boundingBox) ].
	^ true! !

!AthensWorldState methodsFor: 'accessing' stamp: 'NicolaiHess 1/4/2015 18:32'!
display
	^ display! !

!AthensWrapMorph commentStamp: '<historical>'!
i making sure that all my submorphs will be drawn
using athens, but not balloon.

For that i use separate surface.!
!AthensWrapMorph methodsFor: 'surface management' stamp: 'IgorStasenko 9/6/2013 12:46'!
createSurface
	| extent |
	extent := bounds extent asIntegerPoint.
	surface := AthensCairoSurface extent: extent.
! !

!AthensWrapMorph methodsFor: 'accessing' stamp: 'IgorStasenko 9/6/2013 12:18'!
athensSurface
	self checkSurface.
	
	^ surface! !

!AthensWrapMorph methodsFor: 'drawing' stamp: 'IgorStasenko 8/26/2013 11:41'!
drawOn: aCanvas

	"do nothing"! !

!AthensWrapMorph methodsFor: 'drawing' stamp: 'IgorStasenko 8/26/2013 13:03'!
drawOnAthensCanvas: aCanvas

	"do nothing"! !

!AthensWrapMorph methodsFor: 'drawing' stamp: 'IgorStasenko 8/26/2013 12:58'!
fullDrawOnAthensCanvas: anAthensCanvas 
	"Draw the full Morphic structure on the given Canvas"

	self visible ifFalse: [^ self].
	(anAthensCanvas isVisible: self fullBounds) ifFalse: [^self].
	(self hasProperty: #errorOnDraw) ifTrue: [^self "drawErrorOn: aCanvas" ].

	(anAthensCanvas isVisible: self bounds) ifTrue: [ anAthensCanvas draw: self ].
	
	submorphs reverseDo: [:m | anAthensCanvas fullDrawMorph: m ] 
! !

!AthensWrapMorph methodsFor: 'drawing' stamp: 'JochenRick 1/10/2014 06:35'!
render
	surface drawDuring: [ :canvas |
		surface clear.
		canvas pathTransform restoreAfter: [ 
			"before rendering transform from a global coordinates (Morphic) to relative coordinates (Athens)"
			canvas pathTransform translateBy: self bounds origin negated.
			self fullDrawOnAthensCanvas: canvas.
		].
	].
! !

!AthensWrapMorph methodsFor: 'drawing' stamp: 'IgorStasenko 12/21/2013 02:18'!
fullDrawOn: aCanvas

	"Draw the full Morphic structure on the given Canvas"

	self visible ifFalse: [^ self].
	(aCanvas isVisible: self fullBounds) ifFalse:[^self].
	(self hasProperty: #errorOnDraw) ifTrue:[^self drawErrorOn: aCanvas].
	
	self checkSurface.

	[
		self render.
		surface displayOnMorphicCanvas: aCanvas at: bounds origin.
	
	] on: Error do: [:err |
		self setProperty: #errorOnDraw toValue: true.
		self setProperty: #drawError toValue: err freeze.
		^ self drawErrorOn: aCanvas
	]! !

!AthensWrapMorph methodsFor: 'surface management' stamp: 'IgorStasenko 9/6/2013 12:47'!
checkSurface

	session == Smalltalk session ifFalse: [ 
		self initializeForNewSession
		 ].
	
	bounds extent ~= surface extent ifTrue: [ 
		"recreate a surface if dimensions are changed"	
		self createSurface
	 ]
! !

!AthensWrapMorph methodsFor: 'events handling' stamp: 'FernandoOlivero 9/2/2013 14:53'!
handlesMouseDown: evt
	^ true ! !

!AthensWrapMorph methodsFor: 'surface management' stamp: 'IgorStasenko 8/26/2013 11:44'!
initializeForNewSession

	self createSurface.
	session := Smalltalk session.
! !

!AthensWrapWorldMorph commentStamp: 'NicolaiHess 1/4/2015 18:35'!
An AthensWrapWorldMorph is a AthensWrapMorph holding a specialized Athens WorldMorph. This Athens WorldMorph draws the submorphs with an AthensCanvas.

Instance Variables
	worldmorph:		the Athens WorldMorph
	wrappedWorldDisplay:		a display wrapper
!
!AthensWrapWorldMorph methodsFor: 'stepping' stamp: 'NicolaiHess 1/4/2015 18:36'!
step
	self changed! !

!AthensWrapWorldMorph methodsFor: 'initialization' stamp: 'NicolaiHess 1/4/2015 18:36'!
initialize
	super initialize.
	self extent: self defaultExtent.
	self hResizing: #spaceFill.
	self vResizing: #spaceFill.
	wrappedWorldDisplay := AthensWrappedWorldDisplay on: self.
	worldmorph := AthensWorldMorph new.
	worldmorph color: Color orange.
	worldmorph addHand: HandMorph new.
	worldmorph display: wrappedWorldDisplay.
	self addMorph: worldmorph! !

!AthensWrapWorldMorph methodsFor: 'layout' stamp: 'NicolaiHess 1/4/2015 18:36'!
layoutChanged
	super layoutChanged.
	worldmorph ifNotNil:[:w |  w extent: self extent].! !

!AthensWrapWorldMorph methodsFor: 'drawing' stamp: 'NicolaiHess 2/17/2015 21:17'!
fullDrawOnAthensCanvas: anAthensCanvas 
	"Draw the full Morphic structure on the given Canvas"

	self visible ifFalse: [^ self].
	(anAthensCanvas isVisible: self fullBounds) ifFalse: [^self].
	(self hasProperty: #errorOnDraw) ifTrue: [^self "drawErrorOn: aCanvas" ].
	"draw athens wrap morph"
	(anAthensCanvas isVisible: self bounds) ifTrue: [ anAthensCanvas draw: self ].
	"draw wrapped world and its submorphs"
	submorphs reverseDo: [:m | anAthensCanvas fullDrawMorph: m ] ! !

!AthensWrapWorldMorph methodsFor: 'initialization' stamp: 'NicolaiHess 1/4/2015 18:36'!
defaultExtent
	^ 400 @ 400! !

!AthensWrapWorldMorph methodsFor: 'drawing' stamp: 'NicolaiHess 1/6/2015 11:42'!
render
	surface
		drawDuring: [ :canvas | 
			surface clear.
			canvas pathTransform
				restoreAfter: [ 
					"before rendering transform from a global coordinates (Morphic) to relative coordinates (Athens)"
					canvas pathTransform translateBy: self bounds origin negated.
					self fullDrawOnAthensCanvas: canvas ] ]! !

!AthensWrapWorldMorph methodsFor: 'stepping' stamp: 'NicolaiHess 1/4/2015 18:36'!
stepTime
	^ 20! !

!AthensWrappedWorldDisplay commentStamp: 'NicolaiHess 1/4/2015 18:29'!
An AthensWrappedWorldDisplay acts as a DisplayScreen
for a wrapped WorldMorph.

Instance Variables
	realDisplay:		the realdisplay
	wrapMorph:	the wrapped world
!
!AthensWrappedWorldDisplay methodsFor: 'display protocol' stamp: 'NicolaiHess 1/4/2015 18:30'!
doesNotUnderstand: aMessage
	"delegate all not implemented methods to the real display"

	^ (realDisplay respondsTo: aMessage selector)
		ifTrue: [ realDisplay perform: aMessage selector withEnoughArguments: aMessage arguments ]
		ifFalse: [ super doesNotUnderstand: aMessage ]! !

!AthensWrappedWorldDisplay methodsFor: 'display protocol' stamp: 'NicolaiHess 1/4/2015 18:30'!
extent
	^ wrapMorph ifNotNil: [ wrapMorph extent ] ifNil: [ 0 @ 0 ]! !

!AthensWrappedWorldDisplay methodsFor: 'initialization' stamp: 'NicolaiHess 1/4/2015 18:30'!
initialize

	super initialize.

	realDisplay := Display.
	wrapMorph := nil.! !

!AthensWrappedWorldDisplay methodsFor: 'display protocol' stamp: 'NicolaiHess 1/4/2015 18:30'!
boundingBox
	^ wrapMorph ifNotNil: [ wrapMorph fullBounds ] ifNil: [ 0 @ 0 extent: 0 @ 0 ]! !

!AthensWrappedWorldDisplay methodsFor: 'accessing' stamp: 'NicolaiHess 1/4/2015 18:30'!
wrapMorph: anObject
	wrapMorph := anObject! !

!AthensWrappedWorldDisplay methodsFor: 'accessing' stamp: 'NicolaiHess 1/4/2015 18:30'!
wrapMorph
	^ wrapMorph! !

!AthensWrappedWorldDisplay class methodsFor: 'instance creation' stamp: 'NicolaiHess 1/4/2015 18:30'!
on: aWorldWrapMorph
	^ self new wrapMorph:aWorldWrapMorph! !

!AtomicCollection commentStamp: 'Igor.Stasenko 10/16/2010 03:54'!
I am just a base abstract class,
containing common behavior for various queue types!
!AtomicCollection methodsFor: 'utils' stamp: 'IgorStasenko 2/28/2011 15:58'!
newItem
	"override in subclass, if you need to instantiate queue items of different class or initialize them in some specific way"
	^ AtomicQueueItem new! !

!AtomicCollection methodsFor: 'yielding' stamp: 'Igor.Stasenko 10/15/2010 17:30'!
yield
	"Yield the current process.
	Used internally by spin loops, once detected that 
	current process can't make any progress
	without some external event to happen"
	Processor yield! !

!AtomicCollection methodsFor: 'signaling' stamp: 'Igor.Stasenko 10/16/2010 03:54'!
signalNoMoreItems
	"Optional, override in subclass(es) to signal that queue is currently empty.
	Default implementation does nothing"! !

!AtomicCollection methodsFor: 'copying' stamp: 'Igor.Stasenko 10/16/2010 04:09'!
deepCopy
	^ self errorDontCopy! !

!AtomicCollection methodsFor: 'signaling' stamp: 'Igor.Stasenko 10/16/2010 03:54'!
waitForNewItems
	"Override in subclass. By default, yield current process.
	If you run more than one process, which popping items from queue,
	then there is no guarantee, that after wait, #next won't block the queue"
	^ self yield! !

!AtomicCollection methodsFor: 'copying' stamp: 'Igor.Stasenko 10/16/2010 04:11'!
errorDontCopy
	"copying a structure, involved in concurrent operations is a bad idea"
	^ self error: 'Copying not available'! !

!AtomicCollection methodsFor: 'copying' stamp: 'Igor.Stasenko 10/16/2010 04:09'!
copy
	^ self errorDontCopy! !

!AtomicCollection methodsFor: 'debug support' stamp: 'Igor.Stasenko 10/15/2010 17:30'!
interrupt
	"simulate interrupt , for debugging purposes only"
	Processor yield! !

!AtomicCollection methodsFor: 'signaling' stamp: 'Igor.Stasenko 10/16/2010 03:54'!
signalAddedNewItem
	"Optional, override in subclass(es) to signal that new item available in queue.
	Default implementation does nothing"! !

!AtomicQueueItem commentStamp: 'Igor.Stasenko 10/16/2010 02:29'!
i am a queue item , used by atomic queues.
All my new instances are circular i.e. next=self!
!AtomicQueueItem methodsFor: 'accessing' stamp: 'Igor.Stasenko 10/15/2010 16:52'!
object: anObject
	"Set the value of object"

	object := anObject! !

!AtomicQueueItem methodsFor: 'initialization' stamp: 'IgorStasenko 2/28/2011 16:00'!
initialize
	"make circular"
	super initialize.
	next := self.! !

!AtomicQueueItem methodsFor: 'accessing' stamp: 'Igor.Stasenko 10/15/2010 16:52'!
object
	"Answer the value of object"

	^ object! !

!AtomicQueueItem methodsFor: 'accessing' stamp: 'Igor.Stasenko 10/15/2010 16:52'!
next
	"Answer the value of next"

	^ next! !

!AtomicQueueItem methodsFor: 'accessing' stamp: 'Igor.Stasenko 10/15/2010 16:52'!
next: anObject
	"Set the value of next"

	next := anObject! !

!AtomicQueueItem methodsFor: 'accessing' stamp: 'Igor.Stasenko 10/15/2010 17:45'!
makeCircular
	"Make a receiver circular, i.e. point to itself,
	answer the old value of next variable. 
	Note, this operation should be atomic"
	
	| temp |

	" atomic swap here"
	temp := next.
	next := self.

	^ temp! !

!AtomicQueueItem methodsFor: 'accessing' stamp: 'Igor.Stasenko 10/15/2010 17:45'!
isCircular
	^ next == self! !

!AtomicSharedQueue commentStamp: 'IgorStasenko 2/28/2011 15:33'!
I am using semaphore to signal/wait for new items available in queue

I am introducing extra protocol - #next,
which blocks the sender until it can successfully fetch next item from queue.
!
!AtomicSharedQueue methodsFor: 'signaling' stamp: 'Igor.Stasenko 10/15/2010 17:00'!
signalAddedNewItem
	availSema signal! !

!AtomicSharedQueue methodsFor: 'initialization' stamp: 'Igor.Stasenko 10/15/2010 16:59'!
initialize
	super initialize.
	availSema := Semaphore new.
	! !

!AtomicSharedQueue methodsFor: 'signaling' stamp: 'CamilloBruni 10/14/2013 22:25'!
signalNoMoreItems
	"queue is empty, reset sema signals"
	availSema consumeAllSignals ! !

!AtomicSharedQueue methodsFor: 'signaling' stamp: 'Igor.Stasenko 10/15/2010 17:00'!
waitForNewItems
	availSema wait! !

!AtomicSharedQueue methodsFor: 'accessing' stamp: 'IgorStasenko 2/28/2011 15:20'!
next
	"Fetch the next item from queue. If queue is locked or empty, block the sender until operation can complete"
	 
	| result |
	
	[ | keepWaiting | 
		keepWaiting := false. 
		result := self nextIfNone: [ keepWaiting := true ]. 
		keepWaiting ] whileTrue: [ self waitForNewItems ].

	^ result! !

!Author commentStamp: 'MiguelCoba 7/25/2009 01:09'!
I am responsible for the full name used to identify the current code author.!
!Author methodsFor: 'accessing' stamp: 'CamilloBruni 7/17/2013 23:20'!
fullNamePerSe

	"Answer the currently-prevailing author full name, such as it is, empty or not"
	#UserManager asClassIfPresent: [ :userManager | 
		^ userManager default currentUser userNameFor: #author ].
	^ fullName! !

!Author methodsFor: 'initialization' stamp: ''!
initialize
	super initialize.
	fullName := ''.! !

!Author methodsFor: 'accessing' stamp: 'CamilloBruni 7/17/2013 23:20'!
fullName: aString
	fullName := aString.
	
	#UserManager asClassIfPresent: [ :userManager | 
		userManager default currentUser 
			setUserName: aString
			forGroup: #author ].! !

!Author methodsFor: 'ui-requests' stamp: 'CamilloBruni 10/20/2012 21:04'!
requestFullName
	| initialAnswer |
	
	initialAnswer := fullName isEmptyOrNil
				ifTrue: ['FirstnameLastname' translated]
				ifFalse: [fullName].
				
	self checkAndSetFullNameWith: (AuthorNameRequest new initialAnswer: initialAnswer) signal! !

!Author methodsFor: 'accessing' stamp: ''!
fullName
	"Answer the full name to be used to identify the current code author."

	[fullName isEmptyOrNil] whileTrue: [
		self requestFullName.
		(fullName isNil or:[fullName = 'FirstnameLastname' translated]) ifTrue: [fullName := nil. ^'Anonymous']].
	^ fullName! !

!Author methodsFor: 'compatibility' stamp: ''!
reset
	fullName := ''! !

!Author methodsFor: 'accessing' stamp: 'Lr 12/9/2010 17:34'!
checkAndSetFullNameWith: aString 
	| s allowed |
	aString ifNil: [^self].
	s := ''.
	allowed := ($A to: $Z)
				, ($a to: $z)
				, ($0 to: $9).
	aString
		do: [:c | (allowed includes: c)
				ifTrue: [s := s , c asString]].
	self fullName: s! !

!Author methodsFor: 'compatibility' stamp: 'ClementBera 4/11/2013 14:01'!
ifUnknownAuthorUse: aString during: aBlock
	"If no author is set use the name aString while executing aBlock."
	"for compatibility with 1.0"
	
	fullName isEmptyOrNil ifFalse: [ ^ aBlock value ].
	fullName := aString.
	^ aBlock ensure: [ self reset ]! !

!Author methodsFor: 'testing-support' stamp: ''!
useAuthor: aString during: aBlock
	| previous |
	previous := fullName.
	fullName := aString.
	^ aBlock ensure: [ fullName := previous ]! !

!Author class methodsFor: 'convenience' stamp: 'Zork 10/13/2013 17:35'!
fullNamePerSe
	^ Author uniqueInstance fullNamePerSe ! !

!Author class methodsFor: 'settings' stamp: 'StephaneDucasse 11/11/2014 18:15'!
authorSettingOn: aBuilder
	<systemsettings>
	(aBuilder setting: #authorFullName)
		order: -100000;
		parent: #pharoSystem;
		label: 'Author identification';
		target: Author;
		getSelector: #fullNamePerSe;
		setSelector: #fullName:;
		notInStyle;
		default: '';
		ghostHelp: 'VincentVanGogh';
		description: AuthorNameRequest messagePrompt
! !

!Author class methodsFor: 'utilities' stamp: ''!
changeStamp 
	"Answer a string to be pasted into source code to mark who changed it and when."
	^ Author fullName , ' ' , Date today mmddyyyy, ' ',
		((String streamContents: [:s | Time now print24: true on: s]) copyFrom: 1 to: 5)! !

!Author class methodsFor: 'convenience' stamp: ''!
fullName: aString 
	^ Author uniqueInstance checkAndSetFullNameWith: aString! !

!Author class methodsFor: 'instance creation' stamp: ''!
new
	self error: 'Author is a singleton -- send uniqueInstance instead'! !

!Author class methodsFor: 'convenience' stamp: ''!
requestFullName
	^ Author uniqueInstance requestFullName! !

!Author class methodsFor: 'utilities' stamp: ''!
changeStampPerSe
	"Answer a string to be pasted into source code to mark who changed it and when."

	^ (Author fullNamePerSe ifNil: ['.']) , ' ' , Date today mmddyyyy, ' ',
		((String streamContents: [:s | Time now print24: true on: s]) 
			copyFrom: 1 to: 5)! !

!Author class methodsFor: 'convenience' stamp: ''!
fullName
	^ Author uniqueInstance fullName! !

!Author class methodsFor: 'utilities' stamp: 'MarcusDenker 10/9/2013 17:05'!
fixStamp: changeStamp 
	| parts |
	parts := changeStamp findTokens: ' '.
	(parts notEmpty and: [parts last first isLetter]) ifTrue:
		["Put initials first in all time stamps..."
		^ String streamContents:
				[:s | s nextPutAll: parts last.
				parts allButLast do: [:p | s space; nextPutAll: p]]].
	^ changeStamp! !

!Author class methodsFor: 'instance creation' stamp: 'IgorStasenko 10/13/2013 18:09'!
reset

	#UserManager asClassIfPresent: [ :userManager | 
		userManager default currentUser 
			setUserName: nil
			forGroup: #author ].
		
	^ uniqueInstance := nil! !

!Author class methodsFor: 'instance creation' stamp: ''!
uniqueInstance
	^ uniqueInstance ifNil: [ uniqueInstance := super new ]! !

!Author class methodsFor: 'testing-support' stamp: ''!
useAuthor: aString during: aBlock
	^ self uniqueInstance useAuthor: aString during: aBlock! !

!AuthorNameRequest commentStamp: '<historical>'!
I am used to request a new author name.!
!AuthorNameRequest methodsFor: 'accessing' stamp: 'CamilloBruni 10/20/2012 21:03'!
initialAnswer: anObject
	
	initialAnswer := anObject! !

!AuthorNameRequest methodsFor: 'accessing' stamp: 'CamilloBruni 10/20/2012 21:03'!
initialAnswer
	
	^ initialAnswer! !

!AuthorNameRequest methodsFor: 'exception handling' stamp: 'CamilloBruni 10/20/2012 21:03'!
defaultAction
	^ UIManager default
			request: self messagePrompt
			initialAnswer: initialAnswer
			title: 'Author identification' translated! !

!AuthorNameRequest methodsFor: 'ui-requests' stamp: 'CamilloBruni 10/22/2012 23:21'!
messagePrompt
	^ self class messagePrompt! !

!AuthorNameRequest class methodsFor: 'accessing' stamp: 'CamilloBruni 10/22/2012 23:21'!
messagePrompt
	^
'Please type your full name. 
It will be used to sign the changes you make to the image.
Spaces, accents, dashes, underscore and similar characters are not allowed
'! !

!AuthorTest methodsFor: 'tests' stamp: 'on 5/10/2008 13:35'!
testUniqueness
	self should: [ Author new ] raise: Error.! !

!AverageCost commentStamp: 'StephaneDucasse 6/9/2010 20:53'!
Part of an test resource to verify that super is well bound.
See CompilerEvaluationTest!
!AverageCost methodsFor: 'as yet unclassified' stamp: 'NikoSchwarz 6/5/2010 16:11'!
total

	^super total / 12! !

!BMPReadWriter commentStamp: 'LaurentLaffont 5/4/2011 21:27'!
I read and write BMP files.

Example to save and load a screenshot of the world in a .bmp file:

BMPReadWriter 
   putForm: (Form fromDisplay: (0@0 corner: 400@400))
   onFileNamed: '/tmp/screenshot.bmp'.

(ImageMorph withForm: (BMPReadWriter formFromFileNamed: '/tmp/screenshot.bmp')) openInWindow.!
!BMPReadWriter methodsFor: 'writing' stamp: 'StephaneDucasse 12/22/2010 16:09'!
store24BitBmpLine: pixelLine from: formBits startingAt: formBitsIndex width: width
	"Stores a single scanline containing 32bpp RGBA values in a 24bpp scanline. Swizzles the bytes as needed."
	<primitive: 'primitiveWrite24BmpLine' module:'BMPReadWriterPlugin'>

	| pixIndex rgb bitsIndex |	
	pixIndex := 0. "pre-increment"
	bitsIndex := formBitsIndex-1. "pre-increment"
	1 to: width do: [:j |
		rgb := (formBits at: (bitsIndex := bitsIndex+1)) bitAnd: 16rFFFFFF.
		pixelLine at: (pixIndex := pixIndex+1) put: (rgb bitAnd: 255).
		pixelLine at: (pixIndex := pixIndex+1) put: ((rgb bitShift: -8) bitAnd: 255).
		pixelLine at: (pixIndex := pixIndex+1) put: ((rgb bitShift: -16) bitAnd: 255).
	].
! !

!BMPReadWriter methodsFor: 'reading' stamp: 'ar 6/16/2002 15:36'!
nextImage
	| colors |
	stream binary.
	self readHeader.
	biBitCount = 24 ifTrue:[^self read24BmpFile].
	"read the color map"
	colors := self readColorMap.
	^self readIndexedBmpFile: colors! !

!BMPReadWriter methodsFor: 'writing' stamp: 'StephaneDucasse 12/22/2010 16:04'!
nextPutImage: aForm
	| bhSize rowBytes rgb data colorValues depth image ppw scanLineLen pixline |
	depth := aForm depth.
	depth := #(1 4 8 32 ) detect: [ :each | each >= depth].
	image := aForm asFormOfDepth: depth.
	image unhibernate.
	bhSize := 14.  "# bytes in file header"
	biSize := 40.  "info header size in bytes"
	biWidth := image width.
	biHeight := image height.
	biClrUsed := depth = 32 ifTrue: [0] ifFalse:[1 << depth].  "No. color table entries"
	bfOffBits := biSize + bhSize + (4*biClrUsed).
	rowBytes := ((depth min: 24) * biWidth + 31 // 32) * 4.
	biSizeImage := biHeight * rowBytes.

	"Write the file header"
	stream position: 0.
	stream nextLittleEndianNumber: 2 put: 19778.  "bfType = BM"
	stream nextLittleEndianNumber: 4 put: bfOffBits + biSizeImage.  "Entire file size in bytes"
	stream nextLittleEndianNumber: 4 put: 0.  "bfReserved"
	stream nextLittleEndianNumber: 4 put: bfOffBits.  "Offset of bitmap data from start of hdr (and file)"

	"Write the bitmap info header"
	stream position: bhSize.
	stream nextLittleEndianNumber: 4 put: biSize.  "info header size in bytes"
	stream nextLittleEndianNumber: 4 put: image width.  "biWidth"
	stream nextLittleEndianNumber: 4 put: image height.  "biHeight"
	stream nextLittleEndianNumber: 2 put: 1.  "biPlanes"
	stream nextLittleEndianNumber: 2 put: (depth min: 24).  "biBitCount"
	stream nextLittleEndianNumber: 4 put: 0.  "biCompression"
	stream nextLittleEndianNumber: 4 put: biSizeImage.  "size of image section in bytes"
	stream nextLittleEndianNumber: 4 put: 2800.  "biXPelsPerMeter"
	stream nextLittleEndianNumber: 4 put: 2800.  "biYPelsPerMeter"
	stream nextLittleEndianNumber: 4 put: biClrUsed.
	stream nextLittleEndianNumber: 4 put: 0.  "biClrImportant"
	biClrUsed > 0 ifTrue: [
		"write color map; this works for ColorForms, too"
		colorValues := image colormapIfNeededForDepth: 32.
		1 to: biClrUsed do: [:i |
			rgb := colorValues at: i.
			0 to: 24 by: 8 do: [:j | stream nextPut: (rgb >> j bitAnd: 16rFF)]]].

	depth < 32 ifTrue: [
		"depth = 1, 4 or 8."
		data := image bits asByteArray.
		ppw := 32 // depth.
		scanLineLen := biWidth + ppw - 1 // ppw * 4.  "# of bytes in line"
		1 to: biHeight do: [:i |
			stream next: scanLineLen putAll: data startingAt: (biHeight-i)*scanLineLen+1.
		].
	] ifFalse: [
		data := image bits.
		pixline := ByteArray new: (((biWidth * 3 + 3) // 4) * 4).
		1 to: biHeight do:[:i |
			self store24BitBmpLine: pixline from: data startingAt: (biHeight-i)*biWidth+1 width: biWidth.
			stream nextPutAll: pixline.
		].
	].
	stream position = (bfOffBits + biSizeImage) ifFalse: [self error:'Write failure'].
	stream close.! !

!BMPReadWriter methodsFor: 'reading' stamp: 'lr 7/4/2009 10:42'!
readIndexedBmpFile: colors 
	"Read uncompressed pixel data of depth d from the given BMP stream, where d is 1, 4, 8, or 16"
	| form bytesPerRow pixelData pixelLine startIndex map bitBlt mask |
	colors 
		ifNil: 
			[ form := Form 
				extent: biWidth @ biHeight
				depth: biBitCount ]
		ifNotNil: 
			[ form := ColorForm 
				extent: biWidth @ biHeight
				depth: biBitCount.
			form colors: colors ].
	bytesPerRow := (biBitCount * biWidth + 31) // 32 * 4.
	pixelData := ByteArray new: bytesPerRow * biHeight.
	biHeight 
		to: 1
		by: -1
		do: 
			[ :y | 
			pixelLine := stream next: bytesPerRow.
			startIndex := (y - 1) * bytesPerRow + 1.
			pixelData 
				replaceFrom: startIndex
				to: startIndex + bytesPerRow - 1
				with: pixelLine
				startingAt: 1 ].
	form bits copyFromByteArray: pixelData.
	biBitCount = 16 ifTrue: 
		[ map := ColorMap 
			shifts: #(8 -8 0 0 )
			masks: #(255 65280 0 0 ).
		mask := 2147516416 ].
	biBitCount = 32 ifTrue: 
		[ map := ColorMap 
			shifts: #(24 8 -8 -24 )
			masks: #(255 65280 16711680 4278190080 ).
		mask := 4278190080 ].
	map ifNotNil: 
		[ bitBlt := BitBlt toForm: form.
		bitBlt sourceForm: form.
		bitBlt colorMap: map.
		bitBlt combinationRule: Form over.
		bitBlt copyBits ].
	mask ifNotNil: 
		[ bitBlt := BitBlt toForm: form.
		bitBlt combinationRule: 7.	"bitOr:with:"
		bitBlt halftoneForm: (Bitmap with: mask).
		bitBlt copyBits ].
	^ form! !

!BMPReadWriter methodsFor: 'reading' stamp: 'lr 7/4/2009 10:42'!
readHeader
	| reserved |
	bfType := stream nextLittleEndianNumber: 2.
	bfSize := stream nextLittleEndianNumber: 4.
	reserved := stream nextLittleEndianNumber: 4.
	bfOffBits := stream nextLittleEndianNumber: 4.
	biSize := stream nextLittleEndianNumber: 4.
	biWidth := stream nextLittleEndianNumber: 4.
	biHeight := stream nextLittleEndianNumber: 4.
	biPlanes := stream nextLittleEndianNumber: 2.
	biBitCount := stream nextLittleEndianNumber: 2.
	biCompression := stream nextLittleEndianNumber: 4.
	biSizeImage := stream nextLittleEndianNumber: 4.
	biXPelsPerMeter := stream nextLittleEndianNumber: 4.
	biYPelsPerMeter := stream nextLittleEndianNumber: 4.
	biClrUsed := stream nextLittleEndianNumber: 4.
	biClrImportant := stream nextLittleEndianNumber: 4! !

!BMPReadWriter methodsFor: 'reading' stamp: 'damiencassou 5/30/2008 14:51'!
readColorMap
	"Read colorCount BMP color map entries from the given binary stream. Answer an array of Colors."
	| colorCount colors maxLevel b g r ccStream |
	colorCount := (bfOffBits - 54) // 4.
	"Note: some programs (e.g. Photoshop 4.0) apparently do not set colorCount; assume that any data between the end of the header and the start of the pixel data is the color map"
	biBitCount >= 16 ifTrue: [ ^ nil ].
	colorCount = 0 ifTrue: 
		[ "this BMP file does not have a color map"
		"default monochrome color map"
		biBitCount = 1 ifTrue: 
			[ ^ Array 
				with: Color white
				with: Color black ].
		"default gray-scale color map"
		maxLevel := (2 raisedTo: biBitCount) - 1.
		^ (0 to: maxLevel) collect: [ :level | Color gray: level asFloat / maxLevel ] ].
	ccStream := (stream next: colorCount * 4) readStream.
	colors := Array new: colorCount.
	1 
		to: colorCount
		do: 
			[ :i | 
			b := ccStream next.
			g := ccStream next.
			r := ccStream next.
			ccStream next.	"skip reserved"
			colors 
				at: i
				put: (Color 
						r: r
						g: g
						b: b
						range: 255) ].
	^ colors! !

!BMPReadWriter methodsFor: 'reading' stamp: 'lr 7/4/2009 10:42'!
read24BmpFile
	"Read 24-bit pixel data from the given a BMP stream."
	| form formBits pixelLine bitsIndex bitBlt |
	form := Form 
		extent: biWidth @ biHeight
		depth: 32.
	pixelLine := ByteArray new: (24 * biWidth + 31) // 32 * 4.
	bitsIndex := (form height - 1) * biWidth + 1.
	formBits := form bits.
	1 
		to: biHeight
		do: 
			[ :i | 
			pixelLine := stream nextInto: pixelLine.
			self 
				read24BmpLine: pixelLine
				into: formBits
				startingAt: bitsIndex
				width: biWidth.
			bitsIndex := bitsIndex - biWidth ].
	bitBlt := BitBlt toForm: form.
	bitBlt combinationRule: 7.	"bitOr:with:"
	bitBlt halftoneForm: (Bitmap with: 4278190080).
	bitBlt copyBits.
	^ form! !

!BMPReadWriter methodsFor: 'reading' stamp: 'StephaneDucasse 12/22/2010 16:08'!
read24BmpLine: pixelLine into: formBits startingAt: formBitsIndex width: width
	"Swizzles the bytes in a 24bpp scanline and fills in the given 32bpp form bits. Ensures that color black is represented as 16rFF000001 so that Form paint works properly."
	<primitive: 'primitiveRead24BmpLine' module:'BMPReadWriterPlugin'>
	
	| pixIndex rgb bitsIndex |
	pixIndex := 0. "pre-increment"
	bitsIndex := formBitsIndex-1. "pre-increment"
	1 to: width do: [:j |
		rgb :=  (pixelLine at: (pixIndex := pixIndex+1)) +
				((pixelLine at: (pixIndex := pixIndex+1)) bitShift: 8) +
				((pixelLine at: (pixIndex := pixIndex+1)) bitShift: 16).
		rgb = 0 ifTrue:[rgb := 16rFF000001] ifFalse:[rgb := rgb + 16rFF000000].
		formBits at: (bitsIndex := bitsIndex+1) put: rgb].
! !

!BMPReadWriter methodsFor: 'testing' stamp: 'ar 6/16/2002 15:27'!
understandsImageFormat
	stream size < 54 ifTrue:[^false]. "min size = BITMAPFILEHEADER+BITMAPINFOHEADER"
	self readHeader.
	bfType = 19778 "BM" ifFalse:[^false].
	biSize = 40 ifFalse:[^false].
	biPlanes = 1 ifFalse:[^false].
	bfSize <= stream size ifFalse:[^false].
	biCompression = 0 ifFalse:[^false].
	^true! !

!BMPReadWriter class methodsFor: 'image reading/writing' stamp: 'nk 7/16/2003 17:56'!
typicalFileExtensions
	"Answer a collection of file extensions (lowercase) which files that I can read might commonly have"
	^#('bmp')! !

!BMPReadWriter class methodsFor: 'testing' stamp: 'CamilloBruni 5/7/2012 01:06'!
displayAllFrom: fd
	"BMPReadWriter displayAllFrom: FileDirectory default"
	fd fileNames do:[:fName|
		(fName endsWith: '.bmp') ifTrue:[
			[(Form fromBinaryStream: (fd readOnlyFileNamed: fName)) display.
			Display forceDisplayUpdate] on: Error do:[:nix|].
		].
	].
	fd directoryNames do:[:fdName|
		self displayAllFrom: (fd / fdName)
	].! !

!BMPReadWriter class methodsFor: 'testing' stamp: 'CamilloBruni 5/7/2012 01:06'!
readAllFrom: fd
	"MessageTally spyOn:[BMPReadWriter readAllFrom: FileDirectory default]"
	fd fileNames do:[:fName|
		(fName endsWith: '.bmp') ifTrue:[
			[Form fromBinaryStream: (fd readOnlyFileNamed: fName)] on: Error do:[:nix].
		].
	].
	fd directoryNames do:[:fdName|
		self readAllFrom: (fd / fdName)
	].! !

!BMPReadWriterTest methodsFor: 'data' stamp: 'ar 10/25/2005 02:22'!
bmpData32bit
	"Created via:
		(Base64MimeConverter mimeEncode: 
			(FileStream readOnlyFileNamed: 'bmptest32b.bmp') binary)
				contents
	"
	^(Base64MimeConverter mimeDecodeToBytes:
'Qk04AQAAAAAAADYAAAAoAAAACAAAAAgAAAABACAAAAAAAAIBAADDDgAAww4AAAAAAAAAAAAA
AP8AAAD/AAAA/wAAAP8AAP8AAAD/AAAA/wAAAP8AAAAA/wAAAP8AAAD/AAAA/wAA/wAAAP8A
AAD/AAAA/wAAAAD/AAAA/wAA////AP///wD///8A////AP8AAAD/AAAAAP8AAAD/AAD///8A
////AP///wD///8A/wAAAP8AAAAAAAAAAAAAAP///wD///8A////AP///wAAAP8AAAD/AAAA
AAAAAAAA////AP///wD///8A////AAAA/wAAAP8AAAAAAAAAAAAAAAAAAAAAAAAA/wAAAP8A
AAD/AAAA/wAAAAAAAAAAAAAAAAAAAAAAAAD/AAAA/wAAAP8AAAD/AAAA'
readStream) contents! !

!BMPReadWriterTest methodsFor: 'data' stamp: 'ar 10/24/2005 21:27'!
bmpData24bit
	"Created via:
		(Base64MimeConverter mimeEncode: 
			(FileStream readOnlyFileNamed: 'bmptest24.bmp') binary)
				contents
	"
	^(Base64MimeConverter mimeDecodeToBytes:
'Qk32AAAAAAAAADYAAAAoAAAACAAAAAgAAAABABgAAAAAAAAAAADEDgAAxA4AAAAAAAAAAAAA
AP8AAP8AAP8AAP8A/wAA/wAA/wAA/wAAAP8AAP8AAP8AAP8A/wAA/wAA/wAA/wAAAP8AAP8A
/////////////////wAA/wAAAP8AAP8A/////////////////wAA/wAAAAAAAAAA////////
////////AAD/AAD/AAAAAAAA////////////////AAD/AAD/AAAAAAAAAAAAAAAAAAD/AAD/
AAD/AAD/AAAAAAAAAAAAAAAAAAD/AAD/AAD/AAD/' readStream) contents! !

!BMPReadWriterTest methodsFor: 'data' stamp: 'ar 10/25/2005 14:04'!
bmpDataR5G6B5
	"This is a BMP file based on BitmapV4Header which is currently unsupported."
	"Created via:
		(Base64MimeConverter mimeEncode: 
			(FileStream readOnlyFileNamed: 'bmptest16-R5G6B5.bmp') binary)
				contents
	"
	^(Base64MimeConverter mimeDecodeToBytes:
'Qk3IAAAAAAAAAEYAAAA4AAAACAAAAAgAAAABABAAAwAAAIIAAADDDgAAww4AAAAAAAAAAAAA
APgAAOAHAAAfAAAAAAAAAOAH4AfgB+AHHwAfAB8AHwDgB+AH4AfgBx8AHwAfAB8A4AfgB///
////////HwAfAOAH4Af//////////x8AHwAAAAAA//////////8A+AD4AAAAAP//////////
APgA+AAAAAAAAAAAAPgA+AD4APgAAAAAAAAAAAD4APgA+AD4AAA='
readStream) contents! !

!BMPReadWriterTest methodsFor: 'data' stamp: 'ar 10/25/2005 02:22'!
bmpData16bit
	"Created via:
		(Base64MimeConverter mimeEncode: 
			(FileStream readOnlyFileNamed: 'bmptest16b.bmp') binary)
				contents
	"
	^(Base64MimeConverter mimeDecodeToBytes:
'Qk24AAAAAAAAADYAAAAoAAAACAAAAAgAAAABABAAAAAAAIIAAADDDgAAww4AAAAAAAAAAAAA
4APgA+AD4AMfAB8AHwAfAOAD4APgA+ADHwAfAB8AHwDgA+AD/3//f/9//38fAB8A4APgA/9/
/3//f/9/HwAfAAAAAAD/f/9//3//fwB8AHwAAAAA/3//f/9//38AfAB8AAAAAAAAAAAAfAB8
AHwAfAAAAAAAAAAAAHwAfAB8AHwAAA==' readStream) contents! !

!BMPReadWriterTest methodsFor: 'reading' stamp: 'damiencassou 5/30/2008 14:57'!
testBmp16Bit
	| reader form |
	reader := BMPReadWriter new on: self bmpData16bit readStream.
	form := reader nextImage.
	"special black here to compensate for zero-is-transparent effect"
	self assert: (form colorAt: 7 @ 1) = Color red.
	self assert: (form colorAt: 1 @ 7) = Color green.
	self assert: (form colorAt: 7 @ 7) = Color blue.
	self assert: (form colorAt: 4 @ 4) = Color white.
	self assert: (form pixelValueAt: 1 @ 1) = 32768! !

!BMPReadWriterTest methodsFor: 'data' stamp: 'ar 10/24/2005 21:41'!
bmpData4bit
	"Created via:
		(Base64MimeConverter mimeEncode: 
			(FileStream readOnlyFileNamed: 'bmptest4.bmp') binary)
				contents
	"
	^(Base64MimeConverter mimeDecodeToBytes:
'Qk12BAAAAAAAADYEAAAoAAAACAAAAAgAAAABAAgAAAAAAEAAAADEDgAAxA4AAAAAAAAAAAAA
AAAAAAAAgAAAgAAAAICAAIAAAACAAIAAgIAAAMDAwADA3MAA8MqmAAAgQAAAIGAAACCAAAAg
oAAAIMAAACDgAABAAAAAQCAAAEBAAABAYAAAQIAAAECgAABAwAAAQOAAAGAAAABgIAAAYEAA
AGBgAABggAAAYKAAAGDAAABg4AAAgAAAAIAgAACAQAAAgGAAAICAAACAoAAAgMAAAIDgAACg
AAAAoCAAAKBAAACgYAAAoIAAAKCgAACgwAAAoOAAAMAAAADAIAAAwEAAAMBgAADAgAAAwKAA
AMDAAADA4AAA4AAAAOAgAADgQAAA4GAAAOCAAADgoAAA4MAAAODgAEAAAABAACAAQABAAEAA
YABAAIAAQACgAEAAwABAAOAAQCAAAEAgIABAIEAAQCBgAEAggABAIKAAQCDAAEAg4ABAQAAA
QEAgAEBAQABAQGAAQECAAEBAoABAQMAAQEDgAEBgAABAYCAAQGBAAEBgYABAYIAAQGCgAEBg
wABAYOAAQIAAAECAIABAgEAAQIBgAECAgABAgKAAQIDAAECA4ABAoAAAQKAgAECgQABAoGAA
QKCAAECgoABAoMAAQKDgAEDAAABAwCAAQMBAAEDAYABAwIAAQMCgAEDAwABAwOAAQOAAAEDg
IABA4EAAQOBgAEDggABA4KAAQODAAEDg4ACAAAAAgAAgAIAAQACAAGAAgACAAIAAoACAAMAA
gADgAIAgAACAICAAgCBAAIAgYACAIIAAgCCgAIAgwACAIOAAgEAAAIBAIACAQEAAgEBgAIBA
gACAQKAAgEDAAIBA4ACAYAAAgGAgAIBgQACAYGAAgGCAAIBgoACAYMAAgGDgAICAAACAgCAA
gIBAAICAYACAgIAAgICgAICAwACAgOAAgKAAAICgIACAoEAAgKBgAICggACAoKAAgKDAAICg
4ACAwAAAgMAgAIDAQACAwGAAgMCAAIDAoACAwMAAgMDgAIDgAACA4CAAgOBAAIDgYACA4IAA
gOCgAIDgwACA4OAAwAAAAMAAIADAAEAAwABgAMAAgADAAKAAwADAAMAA4ADAIAAAwCAgAMAg
QADAIGAAwCCAAMAgoADAIMAAwCDgAMBAAADAQCAAwEBAAMBAYADAQIAAwECgAMBAwADAQOAA
wGAAAMBgIADAYEAAwGBgAMBggADAYKAAwGDAAMBg4ADAgAAAwIAgAMCAQADAgGAAwICAAMCA
oADAgMAAwIDgAMCgAADAoCAAwKBAAMCgYADAoIAAwKCgAMCgwADAoOAAwMAAAMDAIADAwEAA
wMBgAMDAgADAwKAA8Pv/AKSgoACAgIAAAAD/AAD/AAAA//8A/wAAAP8A/wD//wAA////APr6
+vr8/Pz8+vr6+vz8/Pz6+v/////8/Pr6//////z8AAD/////+fkAAP/////5+QAAAAD5+fn5
AAAAAPn5+fk=' readStream) contents! !

!BMPReadWriterTest methodsFor: 'reading' stamp: 'damiencassou 5/30/2008 14:57'!
testBmp8Bit
	| reader form |
	reader := BMPReadWriter new on: self bmpData8bit readStream.
	form := reader nextImage.
	self assert: (form colorAt: 1 @ 1) = Color black.
	self assert: (form colorAt: 7 @ 1) = Color red.
	self assert: (form colorAt: 1 @ 7) = Color green.
	self assert: (form colorAt: 7 @ 7) = Color blue.
	self assert: (form colorAt: 4 @ 4) = Color white! !

!BMPReadWriterTest methodsFor: 'data' stamp: 'ar 10/24/2005 21:27'!
bmpData8bit
	"Created via:
		(Base64MimeConverter mimeEncode: 
			(FileStream readOnlyFileNamed: 'bmptest8.bmp') binary)
				contents
	"
	^(Base64MimeConverter mimeDecodeToBytes:
'Qk12BAAAAAAAADYEAAAoAAAACAAAAAgAAAABAAgAAAAAAEAAAADEDgAAxA4AAAAAAAAAAAAA
AAAAAAAAgAAAgAAAAICAAIAAAACAAIAAgIAAAMDAwADA3MAA8MqmAAAgQAAAIGAAACCAAAAg
oAAAIMAAACDgAABAAAAAQCAAAEBAAABAYAAAQIAAAECgAABAwAAAQOAAAGAAAABgIAAAYEAA
AGBgAABggAAAYKAAAGDAAABg4AAAgAAAAIAgAACAQAAAgGAAAICAAACAoAAAgMAAAIDgAACg
AAAAoCAAAKBAAACgYAAAoIAAAKCgAACgwAAAoOAAAMAAAADAIAAAwEAAAMBgAADAgAAAwKAA
AMDAAADA4AAA4AAAAOAgAADgQAAA4GAAAOCAAADgoAAA4MAAAODgAEAAAABAACAAQABAAEAA
YABAAIAAQACgAEAAwABAAOAAQCAAAEAgIABAIEAAQCBgAEAggABAIKAAQCDAAEAg4ABAQAAA
QEAgAEBAQABAQGAAQECAAEBAoABAQMAAQEDgAEBgAABAYCAAQGBAAEBgYABAYIAAQGCgAEBg
wABAYOAAQIAAAECAIABAgEAAQIBgAECAgABAgKAAQIDAAECA4ABAoAAAQKAgAECgQABAoGAA
QKCAAECgoABAoMAAQKDgAEDAAABAwCAAQMBAAEDAYABAwIAAQMCgAEDAwABAwOAAQOAAAEDg
IABA4EAAQOBgAEDggABA4KAAQODAAEDg4ACAAAAAgAAgAIAAQACAAGAAgACAAIAAoACAAMAA
gADgAIAgAACAICAAgCBAAIAgYACAIIAAgCCgAIAgwACAIOAAgEAAAIBAIACAQEAAgEBgAIBA
gACAQKAAgEDAAIBA4ACAYAAAgGAgAIBgQACAYGAAgGCAAIBgoACAYMAAgGDgAICAAACAgCAA
gIBAAICAYACAgIAAgICgAICAwACAgOAAgKAAAICgIACAoEAAgKBgAICggACAoKAAgKDAAICg
4ACAwAAAgMAgAIDAQACAwGAAgMCAAIDAoACAwMAAgMDgAIDgAACA4CAAgOBAAIDgYACA4IAA
gOCgAIDgwACA4OAAwAAAAMAAIADAAEAAwABgAMAAgADAAKAAwADAAMAA4ADAIAAAwCAgAMAg
QADAIGAAwCCAAMAgoADAIMAAwCDgAMBAAADAQCAAwEBAAMBAYADAQIAAwECgAMBAwADAQOAA
wGAAAMBgIADAYEAAwGBgAMBggADAYKAAwGDAAMBg4ADAgAAAwIAgAMCAQADAgGAAwICAAMCA
oADAgMAAwIDgAMCgAADAoCAAwKBAAMCgYADAoIAAwKCgAMCgwADAoOAAwMAAAMDAIADAwEAA
wMBgAMDAgADAwKAA8Pv/AKSgoACAgIAAAAD/AAD/AAAA//8A/wAAAP8A/wD//wAA////APr6
+vr8/Pz8+vr6+vz8/Pz6+v/////8/Pr6//////z8AAD/////+fkAAP/////5+QAAAAD5+fn5
AAAAAPn5+fk=' readStream) contents! !

!BMPReadWriterTest methodsFor: 'data' stamp: 'ar 10/25/2005 14:05'!
bmpDataX8R8G8B8
	"This is a BMP file based on BitmapV4Header which is currently unsupported."
	"Created via:
		(Base64MimeConverter mimeEncode: 
			(FileStream readOnlyFileNamed: 'bmptest32-X8R8G8B8.bmp') binary)
				contents
	"
	^(Base64MimeConverter mimeDecodeToBytes:
'Qk1IAQAAAAAAAEYAAAA4AAAACAAAAAgAAAABACAAAwAAAAIBAADDDgAAww4AAAAAAAAAAAAA
AAAA/wAA/wAA/wAAAAAAAAAA/wAAAP8AAAD/AAAA/wAA/wAAAP8AAAD/AAAA/wAAAAD/AAAA
/wAAAP8AAAD/AAD/AAAA/wAAAP8AAAD/AAAAAP8AAAD/AAD///8A////AP///wD///8A/wAA
AP8AAAAA/wAAAP8AAP///wD///8A////AP///wD/AAAA/wAAAAAAAAAAAAAA////AP///wD/
//8A////AAAA/wAAAP8AAAAAAAAAAAD///8A////AP///wD///8AAAD/AAAA/wAAAAAAAAAA
AAAAAAAAAAAAAAD/AAAA/wAAAP8AAAD/AAAAAAAAAAAAAAAAAAAAAAAAAP8AAAD/AAAA/wAA
AP8AAA=='
readStream) contents! !

!BMPReadWriterTest methodsFor: 'data' stamp: 'ar 10/25/2005 14:04'!
bmpDataX4R4G4B4
	"This is a BMP file based on BitmapV4Header which is currently unsupported."
	"Created via:
		(Base64MimeConverter mimeEncode: 
			(FileStream readOnlyFileNamed: 'bmptest16-X4R4G4B4.bmp') binary)
				contents
	"
	^(Base64MimeConverter mimeDecodeToBytes:
'Qk3IAAAAAAAAAEYAAAA4AAAACAAAAAgAAAABABAAAwAAAIIAAADDDgAAww4AAAAAAAAAAAAA
AA8AAPAAAAAPAAAAAAAAAPAA8ADwAPAADwAPAA8ADwDwAPAA8ADwAA8ADwAPAA8A8ADwAP8P
/w//D/8PDwAPAPAA8AD/D/8P/w//Dw8ADwAAAAAA/w//D/8P/w8ADwAPAAAAAP8P/w//D/8P
AA8ADwAAAAAAAAAAAA8ADwAPAA8AAAAAAAAAAAAPAA8ADwAPAAA='
readStream) contents! !

!BMPReadWriterTest methodsFor: 'reading' stamp: 'tbn 12/27/2010 10:17'!
testBmp24Bit
	| reader form |
	reader := BMPReadWriter new on: (ReadStream on: self bmpData24bit).
	form := reader nextImage.
	self assert: (form colorAt: 7@1) = Color red.
	self assert: (form colorAt: 1@7) = Color green.
	self assert: (form colorAt: 7@7) = Color blue.
	self assert: (form colorAt: 4@4) = Color white.
	self assert: (form pixelValueAt: 1@1) = 16rFF000001.
! !

!BMPReadWriterTest methodsFor: 'reading' stamp: 'damiencassou 5/30/2008 14:57'!
testBmp4Bit
	| reader form |
	reader := BMPReadWriter new on: self bmpData4bit readStream.
	form := reader nextImage.
	self assert: (form colorAt: 1 @ 1) = Color black.
	self assert: (form colorAt: 7 @ 1) = Color red.
	self assert: (form colorAt: 1 @ 7) = Color green.
	self assert: (form colorAt: 7 @ 7) = Color blue.
	self assert: (form colorAt: 4 @ 4) = Color white! !

!BMPReadWriterTest methodsFor: 'reading' stamp: 'damiencassou 5/30/2008 14:57'!
testBmp32Bit
	| reader form |
	reader := BMPReadWriter new on: self bmpData32bit readStream.
	form := reader nextImage.
	self assert: (form colorAt: 7 @ 1) = Color red.
	self assert: (form colorAt: 1 @ 7) = Color green.
	self assert: (form colorAt: 7 @ 7) = Color blue.
	self assert: (form colorAt: 4 @ 4) = Color white.
	self assert: (form pixelValueAt: 1 @ 1) = 4278190080! !

!BadEqualer commentStamp: 'mjr 8/20/2003 13:28'!
I am an object that doesn't always report #= correctly.  Used for testing the EqualityTester.!
!BadEqualer methodsFor: 'comparing' stamp: 'mjr 8/20/2003 18:56'!
= other 
	self class = other class
		ifFalse: [^ false].
	^ 100 atRandom < 30 ! !

!BadHasher commentStamp: 'mjr 8/20/2003 13:28'!
I am an object that doesn't always hash correctly.  I am used for testing the HashTester.!
!BadHasher methodsFor: 'comparing' stamp: 'mjr 8/20/2003 18:56'!
hash
	"answer with a different hash some of the time"
	100 atRandom < 30
		ifTrue: [^ 1]. 
	^ 2! !

!Bag commentStamp: '<historical>'!
I represent an unordered collection of possibly duplicate elements.
	
I store these elements in a dictionary, tallying up occurrences of equal objects. Because I store an occurrence only once, my clients should beware that objects they store will not necessarily be retrieved such that == is true. If the client cares, a subclass of me should be created.!
!Bag methodsFor: 'accessing' stamp: 'sma 5/12/2000 17:23'!
at: index put: anObject 
	self errorNotKeyed! !

!Bag methodsFor: 'removing' stamp: 'nice 9/14/2009 20:28'!
removeAll
	"Implementation Note: as contents will be overwritten, a shallowCopy of self would be modified.
	An alternative implementation preserving capacity would be to create a new contents:
	self setContents: (self class contentsClass new: contents size)."
	
	contents removeAll! !

!Bag methodsFor: 'accessing' stamp: 'sma 5/12/2000 11:35'!
size
	"Answer how many elements the receiver contains."

	| tally |
	tally := 0.
	contents do: [:each | tally := tally + each].
	^ tally! !

!Bag methodsFor: 'testing' stamp: ''!
occurrencesOf: anObject 
	"Refer to the comment in Collection|occurrencesOf:."

	(self includes: anObject)
		ifTrue: [^contents at: anObject]
		ifFalse: [^0]! !

!Bag methodsFor: 'adding' stamp: 'sma 5/12/2000 17:20'!
add: newObject withOccurrences: anInteger 
	"Add newObject anInteger times to the receiver. Answer newObject."

	contents at: newObject put: (contents at: newObject ifAbsent: [0]) + anInteger.
	^ newObject! !

!Bag methodsFor: 'removing' stamp: 'sma 5/12/2000 14:32'!
remove: oldObject ifAbsent: exceptionBlock 
	"Refer to the comment in Collection|remove:ifAbsent:."

	| count |
	count := contents at: oldObject ifAbsent: [^ exceptionBlock value].
	count = 1
		ifTrue: [contents removeKey: oldObject]
		ifFalse: [contents at: oldObject put: count - 1].
	^ oldObject! !

!Bag methodsFor: 'accessing' stamp: 'tao 1/5/2000 18:25'!
cumulativeCounts
	"Answer with a collection of cumulative percents covered by elements so far."
	| s n |
	s := self size / 100.0. n := 0.
	^ self sortedCounts asArray collect:
		[:a | n := n + a key. (n / s roundTo: 0.1) -> a value]! !

!Bag methodsFor: 'private' stamp: 'sma 5/12/2000 14:49'!
setContents: aDictionary
	contents := aDictionary! !

!Bag methodsFor: 'accessing' stamp: 'md 1/20/2006 15:58'!
valuesAndCounts

	^ contents! !

!Bag methodsFor: 'testing' stamp: ''!
includes: anObject 
	"Refer to the comment in Collection|includes:."

	^contents includesKey: anObject! !

!Bag methodsFor: 'converting' stamp: 'nice 10/20/2009 19:37'!
asSet
	"Answer a set with the elements of the receiver."

	^ contents keys asSet! !

!Bag methodsFor: 'copying' stamp: 'nice 10/5/2009 08:54'!
postCopy
	super postCopy.
	contents := contents copy! !

!Bag methodsFor: 'accessing' stamp: 'sma 5/12/2000 17:23'!
at: index 
	self errorNotKeyed! !

!Bag methodsFor: 'enumerating' stamp: 'StephaneDucasse 8/12/2013 15:39'!
do: aBlock 
	"Evaluate aBlock with each of the receiver's elements as the argument."

	contents associationsDo: [:assoc | assoc value timesRepeat: [aBlock value: assoc key]]! !

!Bag methodsFor: 'enumerating' stamp: 'StephaneDucasse 8/12/2013 15:38'!
doWithOccurrences: aTwoArgBlock 
    "Iterate over the receiver and apply a two argument block on the element and its occurrences."
        
    contents associationsDo: [:assoc | aTwoArgBlock value: assoc key value: assoc value ]! !

!Bag methodsFor: 'accessing' stamp: 'StephaneDucasse 12/25/2009 12:32'!
sortedElements
	"Answer with a collection of elements with counts, sorted by element."
	"Suggested by l. Uzonyi"
	
	^contents associations
 		sort;
 		yourself! !

!Bag methodsFor: 'adding' stamp: 'sma 5/12/2000 17:18'!
add: newObject 
	"Include newObject as one of the receiver's elements. Answer newObject."

	^ self add: newObject withOccurrences: 1! !

!Bag methodsFor: 'enumerating' stamp: 'StephaneDucasse 8/12/2013 15:39'!
keysAndValuesDo: aTwoArgBlock 
    "Iterate over the receiver and apply a two argument block on the element and its occurrences."
     
    contents associationsDo: [:assoc | aTwoArgBlock value: assoc key value: assoc value ]! !

!Bag methodsFor: 'comparing' stamp: 'md 10/17/2004 16:09'!
= aBag
	"Two bags are equal if
	 (a) they are the same 'kind' of thing.
	 (b) they have the same size.
	 (c) each element occurs the same number of times in both of them"

	(aBag isKindOf: Bag) ifFalse: [^false].
	self size = aBag size ifFalse: [^false].
	contents associationsDo: [:assoc|
		(aBag occurrencesOf: assoc key) = assoc value
			ifFalse: [^false]].
	^true

! !

!Bag methodsFor: 'converting' stamp: 'sma 5/12/2000 14:34'!
asBag
	^ self! !

!Bag methodsFor: '*GT-InspectorExtensions-Core' stamp: 'JurajKubelka 3/30/2015 13:38'!
gtInspectorOccurrencesIn: composite
	<gtInspectorPresentationOrder: 1>  
	^ (composite table)
		title: 'Occurrences';
		display: [ :aCollection | self asSet ];
		column: 'Item' 
			evaluated: [ :each | GTObjectPrinter new asTruncatedTextFrom: each ];
		column: 'Occurences' 
			evaluated: [ :each | self occurrencesOf: each ];
		beMultiple;
		withSmalltalkSearch;
		showOnly: 50;
		send: [ :result | (result notNil and: [result size = 1]) 
				ifTrue: [result anyOne] 
				ifFalse: [self species withAll: result]];
		helpMessage: 'Quick selection field. Given your INPUT, it executes: self select: [:each | INPUT ]'.! !

!Bag methodsFor: 'accessing' stamp: 'StephaneDucasse 12/25/2009 12:11'!
sortedCounts
	"Answer with a collection of counts with elements, sorted by decreasing
	count."
	"Suggested by l. Uzonyi"

	^(Array new: contents size streamContents: [ :stream |
 			contents associationsDo: [ :each |
 				stream nextPut: each value -> each key ] ])
 		sort: [:x :y | x >= y ];
 		yourself! !

!Bag methodsFor: 'math functions' stamp: 'ul 11/7/2010 01:46'!
sum
	"Faster than the superclass implementation when you hold many instances of the same value (which you probably do, otherwise you wouldn't be using a Bag)."
	
	| sum first |
	first := true.
	contents keysAndValuesDo: [ :value :count |
		first 
			ifTrue: [ sum := value * count. first := false ]
			ifFalse: [ sum := sum + (value * count) ] ].
	first ifTrue: [ self errorEmptyCollection ].
	^sum! !

!Bag class methodsFor: 'instance creation' stamp: 'nk 3/17/2001 09:52'!
new: nElements
	^ super new setContents: (self contentsClass new: nElements)! !

!Bag class methodsFor: 'instance creation' stamp: 'nk 3/17/2001 09:52'!
contentsClass
	^Dictionary! !

!Bag class methodsFor: 'instance creation' stamp: 'sma 5/12/2000 13:31'!
new
	^ self new: 4! !

!Bag class methodsFor: 'instance creation' stamp: 'sma 5/12/2000 17:17'!
newFrom: aCollection 
	"Answer an instance of me containing the same elements as aCollection."

	^ self withAll: aCollection

"Examples:
	Bag newFrom: {1. 2. 3. 3}
	{1. 2. 3. 3} as: Bag
"! !

!Bag class methodsFor: '*Spec-Inspector' stamp: 'ClementBera 8/12/2013 10:28'!
inspectorClass
	^ EyeBagInspector! !

!Bag class methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:04'!
gtExampleBagWithOneElement
	<gtExample>
	^ Bag with: 42! !

!Bag class methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:03'!
gtExampleBagWithTenElements
	<gtExample>
	^ #(1 2 3 1 2 3 3 4 5 3) asBag! !

!Bag class methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:03'!
gtExampleEmptyBag
	<gtExample>
	^ Bag new! !

!BagEyeElement commentStamp: '<historical>'!
I am an eye element for bags, showing appropriate thing with occurrences!
!BagEyeElement methodsFor: 'accessing' stamp: 'ClementBera 8/12/2013 10:24'!
accessorCode
	^ '(self occurrencesOf: ', self label, ')'! !

!BagEyeElement methodsFor: 'actions' stamp: 'ClementBera 8/12/2013 10:36'!
save: aValue
	self host valuesAndCounts at: self index put: aValue! !

!BagEyeElement methodsFor: 'accessing' stamp: 'ClementBera 8/12/2013 10:35'!
value
	^ self host valuesAndCounts at: self index! !

!BagTest commentStamp: 'TorstenBergmann 2/20/2014 15:20'!
SUnit tests for bags!
!BagTest methodsFor: 'tests - set arithmetic' stamp: ''!
numberOfSimilarElementsInIntersection
	^ self collection occurrencesOf: self anotherElementOrAssociationIn! !

!BagTest methodsFor: 'tests - occurrencesOf for multipliness' stamp: ''!
testOccurrencesOfForMultipliness

| collection elem |
collection := self collectionWithEqualElements .
elem := self elementTwiceInForOccurrences .

self assert: (collection occurrencesOf: elem ) = 2.  ! !

!BagTest methodsFor: 'tests' stamp: 'stephane.ducasse 5/20/2009 18:02'!
testCumulativeCounts
	"self run: #testCumulativeCounts" 
	"self debug: #testCumulativeCounts"
		
	| bag cumulativeCounts |
	bag := Bag new.
	bag add: '1' withOccurrences: 50.
	bag add: '2' withOccurrences: 40.
	bag add: '3' withOccurrences: 10.
	
	cumulativeCounts := bag cumulativeCounts.
	
	self assert: cumulativeCounts size = 3.
	self assert: cumulativeCounts first = (50 -> '1').
	self assert: cumulativeCounts second = (90 -> '2').
	self assert: cumulativeCounts third = (100 -> '3').
! !

!BagTest methodsFor: 'tests - remove' stamp: ''!
testRemoveElementReallyRemovesElement
	"self debug: #testRemoveElementReallyRemovesElement"
	| size |
	size := self nonEmptyWithoutEqualElements size.
	self nonEmptyWithoutEqualElements remove: self nonEmptyWithoutEqualElements anyOne.
	self assert: size - 1 = self nonEmptyWithoutEqualElements size! !

!BagTest methodsFor: 'tests - converting' stamp: ''!
assertNonDuplicatedContents: aCollection whenConvertedTo: aClass 
	| result |
	result := aCollection perform: ('as' , aClass name) asSymbol.
	self assert: (result class includesBehavior: aClass).
	result do: 
		[ :each | 
		self assert: (aCollection occurrencesOf: each) = (result occurrencesOf: each) ].
	^ result! !

!BagTest methodsFor: 'tests' stamp: 'stephane.ducasse 5/20/2009 18:03'!
testSortedElements
	"self run: #testSortedElements" 
	"self debug: #testSortedElements"
	
	| bag sortedElements|
	bag := Bag new.
	bag add: '2' withOccurrences: 1.
	bag add: '1' withOccurrences: 10.
	bag add: '3' withOccurrences: 5.
	
	sortedElements := bag sortedElements.
	
	self assert: sortedElements size = 3.
	
	self assert: sortedElements first = ('1'->10).
	self assert: sortedElements second =  ('2'->1).
	self assert: sortedElements third =  ('3'->5).
	! !

!BagTest methodsFor: 'tests - converting' stamp: ''!
testAsIdentitySet
	"test with a collection without equal elements :"
	self 
		assertSameContents: self collectionWithoutEqualElements
		whenConvertedTo: IdentitySet.
! !

!BagTest methodsFor: 'basic tests' stamp: 'sd 3/21/2006 22:29'!
testAsSet

	| aBag aSet |
	aBag := Bag new.	
	aBag add:'a' withOccurrences: 4.
	aBag add:'b' withOccurrences: 2.
	aSet := aBag asSet.
	self assert: aSet size = 2.
	self assert: (aSet occurrencesOf: 'a') = 1 
	! !

!BagTest methodsFor: 'tests - adding' stamp: ''!
testTWrite
	| added collection elem |
	collection := self otherCollection  .
	elem := self element .
	added := collection  write: elem .
	
	self assert: added == elem .	"test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection  includes: elem )	.
	self assert: (collection  includes: elem ).
	
	! !

!BagTest methodsFor: 'tests - converting' stamp: ''!
testAsByteArray
	| res |
	self integerCollectionWithoutEqualElements.
	self integerCollectionWithoutEqualElements do: [ :each | self assert: each class = SmallInteger ].
	res := true.
	self integerCollectionWithoutEqualElements
		detect: [ :each | (self integerCollectionWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false.
	self assertSameContents: self integerCollectionWithoutEqualElements whenConvertedTo: ByteArray! !

!BagTest methodsFor: 'tests - fixture' stamp: ''!
test0TStructuralEqualityTest
	self empty.
	self nonEmpty.
	self assert: self empty isEmpty.
	self deny: self nonEmpty isEmpty! !

!BagTest methodsFor: 'test - creation' stamp: ''!
testWithWithWith
	"self debug: #testWithWithWith"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom:1 to: 3 .
	aCol := self collectionClass with: (collection at:1) with: ( collection at:2 ) with: ( collection at: 3).

	1 to: 3 do: [ :i | self assert: ( aCol occurrencesOf: ( collection at: i ) ) = ( collection occurrencesOf: ( collection at: i ) ) ].! !

!BagTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionTwoSimilarElementsInIntersection
	"self debug: #testIntersectionBasic"
	| inter |
	inter := self collection intersection: (self collectionClass with: self anotherElementOrAssociationIn).
	self assert: (self collection occurrencesOf: self anotherElementOrAssociationIn) = self numberOfSimilarElementsInIntersection.
	self assert: (inter includes: self anotherElementOrAssociationIn value)! !

!BagTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 11:53'!
firstCollection
" return a collection that will be the first part of the concatenation"
	^ nonEmpty ! !

!BagTest methodsFor: 'requirements' stamp: 'delaunay 4/14/2009 12:07'!
collectionInForIncluding
	 ^ collectionIn ! !

!BagTest methodsFor: 'tests - concatenation' stamp: ''!
testConcatenationWithDuplicate


| collection1 collection2 result |
collection1 := self firstCollection .
collection2 := self firstCollection .
result := collection1 , collection2.

result do: [ :each | self assert: (result occurrencesOf: each) = (( collection1 occurrencesOf: each ) + ( collection2 occurrencesOf: each ) ). ].
self assert: result size = (collection1 size * 2)! !

!BagTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAnyNoneThere
	"self debug: #testIncludesAnyOfNoneThere'"
	
	self deny: (self nonEmpty includesAny: self empty).
	self deny: (self nonEmpty includesAny: { self elementNotIn. self anotherElementNotIn })! !

!BagTest methodsFor: 'tests - includes' stamp: ''!
testIncludesElementIsThere
	"self debug: #testIncludesElementIsThere"
	
	self assert: (self nonEmpty includes: self nonEmpty anyOne).! !

!BagTest methodsFor: 'requirements' stamp: 'delaunay 4/15/2009 14:07'!
collectionOfFloat
	^ collectionOfString! !

!BagTest methodsFor: 'basic tests' stamp: 'sd 3/21/2006 22:28'!
testAdd
	"self run: #testAdd"
	"self debug: #testAdd"

	| aBag |
	aBag := Bag new.
	aBag add: 'a'.
	aBag add: 'b'.
	
	self assert: aBag size = 2.
	aBag add: 'a'.
	self assert: aBag size = 3.
	self assert: (aBag occurrencesOf: 'a') = 2
	
! !

!BagTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifferenceWithSeparateCollection
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifferenceWithSeparateCollection"
	| res separateCol |
	
	separateCol := self collectionClass with: self anotherElementOrAssociationNotIn.
	res := self collectionWithoutEqualElements difference: separateCol.
	
	self deny: (res includes: self anotherElementOrAssociationNotIn).
	self assert: res size equals: self collectionWithoutEqualElements size.
	
	self collectionWithoutEqualElements do: [ :each|
		self assert: (res includes: each)].
	
	res := separateCol difference: self collection.
	self deny: (res includes: self collection anyOne).
	self assert: res equals: separateCol! !

!BagTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 11:27'!
collectionWithoutEqualElements
	^ otherCollectionWithoutEqualElements! !

!BagTest methodsFor: 'tests - converting' stamp: ''!
testAsArray
	"self debug: #testAsArray3"
	self 
		assertSameContents: self collectionWithoutEqualElements
		whenConvertedTo: Array! !

!BagTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedArray
	| result collection |
	collection := self collectionWithSortableElements .
	result := collection  asArray sort.
	self assert: (result class includesBehavior: Array).
	self assert: result isSorted.
	self assert: result size = collection size! !

!BagTest methodsFor: 'requirements' stamp: 'sd 1/28/2009 16:32'!
collectionWithElement
	"Returns a collection that already includes what is returned by #element."
	^ collectionWithElement! !

!BagTest methodsFor: 'tests - set arithmetic' stamp: ''!
testUnionOfEmpties
	"self debug: #testUnionOfEmpties"
	
	self assert:  (self empty union: self empty) isEmpty.
	
	! !

!BagTest methodsFor: 'tests - adding' stamp: ''!
testTWriteTwice
	| added oldSize collection elem |
	collection := self collectionWithElement .
	elem := self element .
	oldSize := collection  size.
	added := collection 
		write: elem ;
		write: elem .
	self assert: added == elem .	"test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection  includes: elem ).
	self assert: collection  size = (oldSize + 2)! !

!BagTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 14:21'!
withEqualElements
	" return a collection  including equal elements (classic equality)"
	^ nonEmpty .! !

!BagTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCloneTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!BagTest methodsFor: 'test - creation' stamp: ''!
testWith
	"self debug: #testWith"
	
	| aCol anElement |
	anElement := self collectionMoreThan5Elements anyOne.
	aCol := self collectionClass with: anElement.
	self assert: (aCol includes: anElement).! !

!BagTest methodsFor: 'tests - copy' stamp: ''!
testCopyNotSame
	"self debug: #testCopySameClass"
	"A copy of a collection should always be of the same class as the instance it copies"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: copy  == self nonEmpty.! !

!BagTest methodsFor: 'tests - adding' stamp: ''!
testTAddIfNotPresentWithElementAlreadyIn

	| added oldSize collection anElement |
	collection := self collectionWithElement .
	oldSize := collection size.
	anElement := self element .
	self assert: (collection  includes: anElement ).
	
	added := collection  addIfNotPresent: anElement .
	
	self assert: added == anElement .	"test for identiy because #add: has not reason to copy its parameter."
	self assert: collection  size = oldSize! !

!BagTest methodsFor: 'tests - printing' stamp: ''!
testPrintOn
	| aStream result allElementsAsString tmp |
	result:=''.
	aStream:= ReadWriteStream on: result.
	tmp:= OrderedCollection new.
	self nonEmpty do: [:each | tmp add: each asString].
	
	self nonEmpty printOn: aStream .
	allElementsAsString:=(result findBetweenSubStrs: ' ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i=1
			ifTrue:[
			self accessCollection class name first isVowel 
				ifTrue:[self assert: (allElementsAsString at:i)='an' ]
				ifFalse:[self assert: (allElementsAsString at:i)='a'].].
		i=2
			ifTrue:[self assert: (allElementsAsString at:i)=self accessCollection class name].
		i>2
			ifTrue:[self assert: (tmp occurrencesOf:(allElementsAsString at:i))=(allElementsAsString  occurrencesOf:(allElementsAsString at:i)).].	
			].! !

!BagTest methodsFor: 'tests - adding' stamp: ''!
testTAddAll
	| added collection toBeAdded |
	collection := self collectionWithElement .
	toBeAdded := self otherCollection .
	added := collection addAll: toBeAdded .
	self assert: added == toBeAdded .	"test for identiy because #addAll: has not reason to copy its parameter."
	self assert: (collection includesAll: toBeAdded )! !

!BagTest methodsFor: 'tests - printing' stamp: ''!
testPrintElementsOn

	| aStream result allElementsAsString tmp |
	result:=''.
	aStream:= ReadWriteStream on: result.
	tmp:= OrderedCollection new.
	self nonEmpty do: [:each | tmp add: each asString].
	
	self nonEmpty printElementsOn: aStream .
	allElementsAsString:=(result findBetweenSubStrs: ' ' ).
	1 to: allElementsAsString size do:
		[:i | 
		self assert: (tmp occurrencesOf:(allElementsAsString at:i))=(allElementsAsString  occurrencesOf:(allElementsAsString at:i)).
			].! !

!BagTest methodsFor: 'tests - adding' stamp: ''!
testTAddWithOccurences
	| added oldSize collection anElement |
	collection := self collectionWithElement .
	anElement := self element .
	oldSize := collection  size.
	added := collection  add: anElement withOccurrences: 5.
	
	self assert: added == anElement.	"test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection  includes: anElement).
	self assert: collection  size = (oldSize + 5)! !

!BagTest methodsFor: 'tests - concatenation' stamp: ''!
testConcatenationWithEmpty
	| result |
	result := self firstCollection , self empty.
	self assert: result = self firstCollection! !

!BagTest methodsFor: 'basic tests' stamp: 'sd 3/21/2006 22:30'!
testCopy
	"self run: #testCopy"
	
	| aBag newBag |
	aBag := Bag new.
	aBag add:'a' withOccurrences: 4.
	aBag add:'b' withOccurrences: 2.
	newBag := aBag copy.
	self assert: newBag = newBag.
	self assert: newBag asSet size = 2.! !

!BagTest methodsFor: 'basic tests' stamp: 'sd 3/21/2006 22:28'!
testAddWithOccurrences
	"self debug:#testAddWithOccurrences"
	
	| aBag |
 	aBag := Bag new.	
	aBag add: 'a' withOccurrences: 3.
	self assert: (aBag size = 3).
	
	
	
	
		
! !

!BagTest methodsFor: 'tests - includes' stamp: 'stephane.ducasse 11/21/2008 14:58'!
anotherElementNotIn
	^ 42! !

!BagTest methodsFor: 'tests - remove' stamp: ''!
testRemoveElementFromEmpty
	"self debug: #testRemoveElementFromEmpty"
	self 
		should: [ self empty remove: self nonEmptyWithoutEqualElements anyOne ]
		raise: Error! !

!BagTest methodsFor: 'tests - remove' stamp: ''!
testRemoveIfAbsent
	"self debug: #testRemoveElementThatExists"

	| el res |
	el := self elementNotIn.
	res := self nonEmptyWithoutEqualElements remove: el ifAbsent: [ 33 ].
	self assert: res = 33! !

!BagTest methodsFor: 'requirements' stamp: 'delaunay 4/17/2009 15:24'!
collectionWithElementsToRemove
	^ collectionIn! !

!BagTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsStringOnDelimiterLastMore

	| delim multiItemStream result last allElementsAsString tmp |
	
	delim := ', '.
	last := 'and'.
	result:=''.
	tmp := self nonEmpty collect: [:each | each asString].
	multiItemStream := ReadWriteStream on:result.
	self nonEmpty  asStringOn: multiItemStream delimiter: ', ' last: last.
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 ) | i= allElementsAsString size
			ifTrue: [self assert: (tmp occurrencesOf:(allElementsAsString at:i))=(allElementsAsString 			occurrencesOf:(allElementsAsString at:i))].
		i=(allElementsAsString size-1)
			ifTrue:[ self assert: (allElementsAsString at:i)=('and')].
			].
! !

!BagTest methodsFor: 'test - iterate' stamp: 'damienpollet 1/30/2009 17:37'!
expectedSizeAfterReject
	^ 2! !

!BagTest methodsFor: 'test - remove' stamp: 'damienpollet 1/30/2009 17:15'!
elementTwiceIn
	^ super elementTwiceIn! !

!BagTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsStringOnDelimiterLastEmpty

	| delim emptyStream |
	delim := ', '.
	emptyStream := ReadWriteStream on: ''.
	self empty asStringOn: emptyStream delimiter: delim last:'and'.
	self assert: emptyStream contents = ''.
! !

!BagTest methodsFor: 'tests - adding' stamp: ''!
testTAdd
	| added collection |
	collection :=self otherCollection .
	added := collection add: self element.
	
	self assert: added == self element.	"test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection includes: self element)	.
	self assert: (self collectionWithElement includes: self element).
	
	! !

!BagTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIncludeTest
	| anElementIn |
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self elementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self elementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self anotherElementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self anotherElementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self empty.
	self assert: self empty isEmpty! !

!BagTest methodsFor: 'tests - includes' stamp: 'CamilloBruni 8/31/2013 20:23'!
testIdentityIncludes
	" test the comportement in presence of elements 'includes' but not 'identityIncludes' "

	" can not be used by collections that can't include elements for wich copy doesn't return another instance "

	| collection anElement |
	self collectionWithCopyNonIdentical.
	collection := self collectionWithCopyNonIdentical.
	anElement := collection anyOne copy.	"self assert: (collection includes: element)."
	self deny: (collection identityIncludes: anElement)! !

!BagTest methodsFor: 'tests' stamp: 'stephane.ducasse 5/20/2009 18:02'!
testEqual
	"(self run: #testEqual)"
	"(self debug: #testEqual)"
	| bag1 bag2 |
	bag1 := Bag new.
	bag2 := Bag new.
	self assert: bag1 = bag2.
	bag1 add: #a;
		 add: #b.
	bag2 add: #a;
		 add: #a.
	self deny: bag1 = bag2.
	self assert: bag1 = bag1.
	bag1 add: #a.
	bag2 add: #b.
	self assert: bag1 = bag2.
	bag1 add: #c.
	self deny: bag1 = bag2.
	bag2 add: #c.
	self assert: bag1 = bag2! !

!BagTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOfEmpty
	| result |
	result := self empty occurrencesOf: (self collectionWithoutEqualElements anyOne).
	self assert: result = 0! !

!BagTest methodsFor: 'tests - includes' stamp: 'delaunay 4/2/2009 11:53'!
testIncludesElementIsNotThere
	"self debug: #testIncludesElementIsNotThere"
	self deny: (self nonEmpty includes: self elementNotInForOccurrences).
	self assert: (self nonEmpty includes: self nonEmpty anyOne).
	self deny: (self empty includes: self elementNotInForOccurrences)! !

!BagTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyEmpty
	"self debug: #testCopyEmpty"
	
	| copy | 
	copy := self empty copy.
	self assert: copy isEmpty.! !

!BagTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsStringOnDelimiterLastOne

	| delim oneItemStream result |
	
	delim := ', '.
	result:=''.
	oneItemStream := ReadWriteStream on: result.
	self nonEmpty1Element  asStringOn: oneItemStream delimiter: delim last: 'and'.
	oneItemStream  do:
		[:each1 |
		self nonEmpty1Element do: [:each2 |self assert: each1 = (each2 asString) ]
		 ].
	

! !

!BagTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSetAritmeticTest
	self collection.
	self deny: self collection isEmpty.
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self anotherElementOrAssociationNotIn.
	self collection isDictionary
		ifTrue: [ self deny: (self collection associations includes: self anotherElementOrAssociationNotIn key) ]
		ifFalse: [ self deny: (self collection includes: self anotherElementOrAssociationNotIn) ].
	self collectionClass! !

!BagTest methodsFor: 'tests - printing' stamp: ''!
testPrintOnDelimiter
	| aStream result allElementsAsString tmp |
	result:=''.
	aStream:= ReadWriteStream on: result.
	tmp:= OrderedCollection new.
	self nonEmpty do: [:each | tmp add: each asString].
	
	
	
	self nonEmpty printOn: aStream delimiter: ', ' .
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		self assert: (tmp occurrencesOf:(allElementsAsString at:i))=(allElementsAsString  occurrencesOf:(allElementsAsString at:i))
			].! !

!BagTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIncludeWithIdentityTest
	| anElement |
	self collectionWithCopyNonIdentical.
	anElement := self collectionWithCopyNonIdentical anyOne.
	self deny: anElement == anElement copy! !

!BagTest methodsFor: 'tests - adding' stamp: ''!
testTAddTwice
	| added oldSize collection anElement |
	collection := self collectionWithElement .
	anElement := self element .
	oldSize := collection  size.
	added := collection 
		add: anElement ;
		add: anElement .
	self assert: added == anElement .	"test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection  includes: anElement ).
	self assert: collection  size = (oldSize + 2)! !

!BagTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 12:15'!
collectionWithoutNilElements
	" return a collection that doesn't includes a nil element  and that doesn't includes equal elements'"
	^ collectionWithoutNilMoreThan5! !

!BagTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 11:27'!
integerCollectionWithoutEqualElements
	^ otherCollectionWithoutEqualElements! !

!BagTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureTConvertTest
	"a collection of number without equal elements:"

	| res |
	self collectionWithoutEqualElements.
	res := true.
	self collectionWithoutEqualElements
		detect: [ :each | (self collectionWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false! !

!BagTest methodsFor: 'tests - copy' stamp: ''!
testCopyEquals
	"self debug: #testCopySameClass"
	"A copy should be equivalent to the things it's a copy of"
	
	| copy | 
	copy := self nonEmpty copy.
	self assert: copy  = self nonEmpty.! !

!BagTest methodsFor: 'tests' stamp: 'stephane.ducasse 5/20/2009 18:02'!
testCreation
	"self run: #testCreation" 
	"self debug: #testCreation"
		
	| bag |
	bag := Bag new.
	self assert: (bag size) = 0.
	self assert: (bag isEmpty).
	
! !

!BagTest methodsFor: 'requirements' stamp: 'delaunay 5/13/2009 14:32'!
elementInForOccurrences
" return an element included in nonEmpty"
	^self nonEmpty anyOne.! !

!BagTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsStringOnDelimiterMore

	| delim multiItemStream result allElementsAsString tmp |
	
	
	delim := ', '.
	result:=''.
	tmp:= self nonEmpty collect:[:each | each asString].
	multiItemStream := ReadWriteStream on:result.
	self nonEmpty  asStringOn: multiItemStream delimiter: ', '.
	
	allElementsAsString := (result findBetweenSubStrs: ', ' ).
	allElementsAsString do:
		[:each |
		self assert: (tmp occurrencesOf: each)=(allElementsAsString occurrencesOf: each).
		].! !

!BagTest methodsFor: 'tests - remove' stamp: ''!
testRemoveElementThatExists
	"self debug: #testRemoveElementThatExists"

	| el res |
	el := self nonEmptyWithoutEqualElements anyOne.
	res := self nonEmptyWithoutEqualElements remove: el.
	self assert: res == el! !

!BagTest methodsFor: 'tests - adding' stamp: ''!
testTAddIfNotPresentWithNewElement

	| added oldSize collection elem |
	collection := self otherCollection .
	oldSize := collection  size.
	elem := self element .
	self deny: (collection  includes: elem ).
	
	added := collection  addIfNotPresent: elem .
	self assert: added == elem . "test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection  size = (oldSize + 1)).

	! !

!BagTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWithoutAll
	"self debug: #testCopyEmptyWithoutAll"
	| res |
	res := self empty copyWithoutAll: self collectionWithElementsToRemove.
	self assert: res size = self empty size.
	self collectionWithElementsToRemove do: [ :each | self deny: (res includes: each) ]! !

!BagTest methodsFor: 'tests - iterating' stamp: 'damienpollet 1/13/2009 15:57'!
testAnySastify

	self assert: ( self collection anySatisfy: [:each | each = self element]).
	self deny: (self collection anySatisfy: [:each | each isString]).! !

!BagTest methodsFor: 'tests - includes' stamp: ''!
testIdentityIncludesNonSpecificComportement
	" test the same comportement than 'includes: '  "
	| collection |	
	collection := self nonEmpty  .
	
	self deny: (collection identityIncludes: self elementNotIn ).
	self assert:(collection identityIncludes: collection anyOne)
! !

!BagTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutAll
	"self debug: #testCopyNonEmptyWithoutAll"
	| res |
	res := self nonEmpty copyWithoutAll: self collectionWithElementsToRemove.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self collectionWithElementsToRemove do: [ :each | self deny: (res includes: (each)) ].
	self nonEmpty do: 
		[ :each | 
		(self collectionWithElementsToRemove includes: each) ifFalse: [ self assert: (res includes: each) ] ]! !

!BagTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 12:16'!
collectionMoreThan5Elements
" return a collection including at least 5 elements"
	
	^ collectionWithoutNilMoreThan5 ! !

!BagTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 14:19'!
elementsCopyNonIdenticalWithoutEqualElements
	" return a collection that does niot incllude equal elements ( classic equality )
	all elements included are elements for which copy is not identical to the element  "
	^ collectionOfString ! !

!BagTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureAsStringCommaAndDelimiterTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty.
	self nonEmpty1Element.
	self assert: self nonEmpty1Element size = 1! !

!BagTest methodsFor: 'tests' stamp: 'stephane.ducasse 5/20/2009 18:03'!
testRemove
	"self run: #testRemove"
	"self debug: #testRemove" 
	
	| bag item |
	item := 'test item'.
	bag := Bag new. 
	
	bag add: item.
	self assert: (bag size) = 1.
	bag remove: item.
	self assert: bag isEmpty.
	
	bag add: item withOccurrences: 2.
	bag remove: item.
	bag remove: item.
	self assert: (bag size) = 0.
	
	self should: [bag remove: item.] raise: Error.! !

!BagTest methodsFor: 'tests' stamp: 'stephane.ducasse 5/20/2009 18:03'!
testSortedCounts
	"self run: #testSortedCounts"
	"self debug: #testSortedCounts" 
	
	| bag sortedCounts|
	bag := Bag new.
	bag add: '1' withOccurrences: 10.
	bag add: '2' withOccurrences: 1.
	bag add: '3' withOccurrences: 5.
	
	sortedCounts := bag sortedCounts.
	self assert: sortedCounts size = 3.
	
	self assert: sortedCounts first = (10->'1').
	self assert: sortedCounts second =  (5->'3').
	self assert: sortedCounts third =  (1->'2').	! !

!BagTest methodsFor: 'tests - converting' stamp: ''!
assertNoDuplicates: aCollection whenConvertedTo: aClass 
	| result |
	result := self collectionWithEqualElements asIdentitySet.
	self assert: (result class includesBehavior: IdentitySet).
	self collectionWithEqualElements do: [ :initial | self assert: (result occurrencesOf: initial) = 1 ]! !

!BagTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureOccurrencesForMultiplinessTest
	| cpt anElement collection |
	self collectionWithEqualElements.
	self collectionWithEqualElements.
	self elementTwiceInForOccurrences.
	anElement := self elementTwiceInForOccurrences.
	collection := self collectionWithEqualElements.
	cpt := 0.	" testing with identity check ( == ) so that identy collections can use this trait : "
	self collectionWithEqualElements
		do: [ :each | 
			each == self elementTwiceInForOccurrences
				ifTrue: [ cpt := cpt + 1 ] ].
	self assert: cpt = 2! !

!BagTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsCommaStringEmpty

	self assert: self empty asCommaString = ''.
	self assert: self empty asCommaStringAnd = ''.
	
! !

!BagTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAnyAllThere
	"self debug: #testIncludesAnyOfAllThere'"
	self deny: (self nonEmpty includesAny: self empty).
	self assert: (self nonEmpty includesAny: { self nonEmpty anyOne }).
	self assert: (self nonEmpty includesAny: self nonEmpty).! !

!BagTest methodsFor: 'setup' stamp: 'stephane.ducasse 10/5/2008 15:14'!
nonEmpty

	^ nonEmpty
	
	! !

!BagTest methodsFor: 'test - copy' stamp: 'delaunay 4/17/2009 15:26'!
elementToAdd
	^ 42! !

!BagTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCreationWithTest
	self collectionMoreThan5Elements.
	self assert: self collectionMoreThan5Elements size >= 5! !

!BagTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyNonEmpty
	"self debug: #testCopyNonEmpty"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: copy isEmpty.
	self assert: copy size = self nonEmpty size.
	self nonEmpty do: 
		[:each | copy includes: each]! !

!BagTest methodsFor: 'tests - remove' stamp: ''!
testRemoveAllFoundIn
	"self debug: #testRemoveElementThatExists"
	| el aSubCollection res |
	el := self nonEmptyWithoutEqualElements anyOne.
	aSubCollection := (self nonEmptyWithoutEqualElements copyWithout: el) copyWith: self elementNotIn.
	res := self nonEmptyWithoutEqualElements removeAllFoundIn: aSubCollection.
	self assert: self nonEmptyWithoutEqualElements size = 1.
	self nonEmptyWithoutEqualElements do: [ :each | self assert: each = el ]! !

!BagTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureRequirementsOfTAddTest
	self collectionWithElement.
	self otherCollection.
	self element.
	self assert: (self collectionWithElement includes: self element).
	self deny: (self otherCollection includes: self element)! !

!BagTest methodsFor: 'tests - printing' stamp: ''!
testPrintNameOn

	| aStream result |
	result:=''.
	aStream:= ReadWriteStream on: result.
	self nonEmpty printNameOn: aStream.
	self nonEmpty class name first isVowel
		ifTrue:[ self assert: aStream contents =('an ',self nonEmpty class name ) ]
		ifFalse:[self assert: aStream contents =('a ',self nonEmpty class name)].! !

!BagTest methodsFor: 'test - equality' stamp: ''!
testEqualSignIsTrueForNonIdenticalButEqualCollections
	"self debug: #testEqualSignIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty = self empty copy). 
	self assert: (self empty copy = self empty).
	self assert: (self empty copy = self empty copy).
		
	self assert: (self nonEmpty = self nonEmpty copy). 
	self assert: (self nonEmpty copy = self nonEmpty).
	self assert: (self nonEmpty copy = self nonEmpty copy).! !

!BagTest methodsFor: 'test - creation' stamp: ''!
testWithWith
	"self debug: #testWithWith"
	
	| aCol collection element1 element2 |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom: 1 to: 2  .
	element1 := collection at: 1.
	element2 := collection at:2.
	
	aCol := self collectionClass with: element1  with: element2 .
	self assert: (aCol occurrencesOf: element1 ) = ( collection occurrencesOf: element1).
	self assert: (aCol occurrencesOf: element2 ) = ( collection occurrencesOf: element2).
	
	! !

!BagTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureTRemoveTest
	| duplicate |
	self empty.
	self nonEmptyWithoutEqualElements.
	self deny: self nonEmptyWithoutEqualElements isEmpty.
	duplicate := true.
	self nonEmptyWithoutEqualElements
		detect: [ :each | (self nonEmptyWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ duplicate := false ].
	self assert: duplicate = false.
	self elementNotIn.
	self assert: self empty isEmpty.
	self deny: self nonEmptyWithoutEqualElements isEmpty.
	self deny: (self nonEmptyWithoutEqualElements includes: self elementNotIn)! !

!BagTest methodsFor: 'setup' stamp: 'delaunay 5/11/2009 11:27'!
sizeCollection
	^ otherCollectionWithoutEqualElements! !

!BagTest methodsFor: 'requirements' stamp: 'delaunay 4/14/2009 14:22'!
collectionWithCharacters
	^ collectionWithCharacters .! !

!BagTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsCommaStringMore

	| result resultAnd index allElementsAsString tmp |
	result:= self nonEmpty asCommaString .
	resultAnd:= self nonEmpty asCommaStringAnd .
	tmp :=OrderedCollection new. 
	self nonEmpty do: [ :each | tmp add: each asString].

	"verifying result  :"
	index := 1.
	allElementsAsString := (result findBetweenSubStrs: ', ' ).
	allElementsAsString do:
		[:each |
		self assert: (tmp occurrencesOf: each)=(allElementsAsString occurrencesOf: each).
		].
	
	"verifying esultAnd :"
	allElementsAsString:=(resultAnd findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 ) | i= allElementsAsString size
			ifTrue: [self assert: (tmp occurrencesOf:(allElementsAsString at:i))=(allElementsAsString  occurrencesOf:(allElementsAsString at:i))].
		i=(allElementsAsString size-1)
			ifTrue:[ self assert: (allElementsAsString at:i)=('and')].
			].! !

!BagTest methodsFor: 'setup' stamp: 'stephane.ducasse 10/5/2008 15:13'!
empty

	^ empty
	
	! !

!BagTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWith
	"self debug: #testCopyNonEmptyWith"
	| res anElement |
	anElement := self elementToAdd .
	res := self nonEmpty copyWith: anElement.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self assert: (res includes: (anElement value)).
	self nonEmpty do: [ :each | res includes: each ]! !

!BagTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsStringOnDelimiterEmpty

	| delim emptyStream |
	delim := ', '.
	emptyStream := ReadWriteStream on: ''.
	self empty asStringOn: emptyStream delimiter: delim.
	self assert: emptyStream contents = ''.
! !

!BagTest methodsFor: 'tests - copy' stamp: 'delaunay 3/30/2009 10:33'!
testCopyNonEmptyWithoutAllNotIncluded
	! !

!BagTest methodsFor: 'setup' stamp: 'stephane.ducasse 10/6/2008 17:22'!
collection

	^ nonEmpty.
	! !

!BagTest methodsFor: 'test - iterate' stamp: 'damienpollet 1/30/2009 17:36'!
doWithoutNumber

	^ 4! !

!BagTest methodsFor: 'tests' stamp: 'nice 9/14/2009 21:05'!
testRemoveAll
	"Allows one to remove all elements of a collection" 
	
	| c1 c2 s2 |
	c1 := #(10 9 8 7 5 4 4 2) asBag.
	c2 := c1 copy.
	s2 := c2 size.
	
	c1 removeAll.
	
	self assert: c1 size = 0.
	self assert: c2 size = s2 description: 'the copy has not been modified'.! !

!BagTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 12:01'!
anotherElementOrAssociationIn
	" return an element (or an association for Dictionary ) present  in 'collection' "
	^ self collection anyOne! !

!BagTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionEmpty
	"self debug: #testIntersectionEmpty"
	
	| inter |
	inter := self empty intersection: self empty.
	self assert: inter isEmpty. 
	inter := self empty intersection: self collection .
	self assert: inter =  self empty.
	! !

!BagTest methodsFor: 'requirements' stamp: 'delaunay 4/14/2009 14:20'!
collectionWithEqualElements
	^ nonEmpty ! !

!BagTest methodsFor: 'requirements' stamp: 'delaunay 4/24/2009 10:31'!
collectionWithSortableElements
" return a collection elements that can be sorte ( understanding message ' < '  or ' > ')"
	^ nonEmpty ! !

!BagTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedCollectionWithSortBlock
	| result tmp |
	result := self collectionWithSortableElements  asSortedCollection: [:a :b | a > b].
	self assert: (result class includesBehavior: SortedCollection).
	result do: 
		[ :each | 
		self assert: (self collectionWithSortableElements   occurrencesOf: each) = (result occurrencesOf: each) ].
	self assert: result size = self collectionWithSortableElements  size.
	tmp:=result at: 1.
	result do: [:each| self assert: tmp>=each. tmp:=each].
	! !

!BagTest methodsFor: 'tests - converting' stamp: ''!
assertSameContents: aCollection whenConvertedTo: aClass 
	| result |
	result := self assertNonDuplicatedContents: aCollection whenConvertedTo: aClass.
	self assert: result size = aCollection size! !

!BagTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureTConvertAsSetForMultiplinessTest
	"a collection  with equal elements:"

	| res |
	self withEqualElements.
	res := true.
	self withEqualElements detect: [ :each | (self withEqualElements occurrencesOf: each) > 1 ] ifNone: [ res := false ].
	self assert: res = true! !

!BagTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOfNotIn
	| result |
	result := self collectionWithoutEqualElements occurrencesOf: self elementNotInForOccurrences.
	self assert: result = 0! !

!BagTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifferenceWithNonNullIntersection
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifferenceWithNonNullIntersection"
	"	#(1 2 3) difference: #(2 4) 
	->  #(1 3)"
	| res overlapping |
	overlapping := self collectionClass 
		with: self anotherElementOrAssociationNotIn
		with: self anotherElementOrAssociationIn.
	res := self collection difference: overlapping.
	self deny: (res includes: self anotherElementOrAssociationIn).
	overlapping do: [ :each | self deny: (res includes: each) ]! !

!BagTest methodsFor: 'test - creation' stamp: ''!
testWithAll
	"self debug: #testWithAll"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection .
	aCol := self collectionClass withAll: collection  .
	
	collection do: [ :each | self assert: (aCol occurrencesOf: each ) = ( collection occurrencesOf: each ) ].
	
	self assert: (aCol size = collection size ).! !

!BagTest methodsFor: 'requirements' stamp: 'delaunay 4/14/2009 12:08'!
collectionNotIncluded
	^ collectionNotIn ! !

!BagTest methodsFor: 'tests - includes' stamp: 'delaunay 4/2/2009 11:53'!
elementNotInForOccurrences
	^ 666! !

!BagTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureOccurrencesTest
	| tmp |
	self empty.
	self assert: self empty isEmpty.
	self collectionWithoutEqualElements.
	self deny: self collectionWithoutEqualElements isEmpty.
	tmp := OrderedCollection new.
	self collectionWithoutEqualElements
		do: [ :each | 
			self deny: (tmp includes: each).
			tmp add: each ].
	self elementNotInForOccurrences.
	self deny: (self collectionWithoutEqualElements includes: self elementNotInForOccurrences)! !

!BagTest methodsFor: 'test - equality' stamp: ''!
testEqualSignOfIdenticalCollectionObjects
	"self debug: #testEqualSignOfIdenticalCollectionObjects"
	
	self assert: (self empty = self empty). 
	self assert: (self nonEmpty = self nonEmpty). 
	! !

!BagTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyCreatesNewObject
	"self debug: #testCopyCreatesNewObject"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: self nonEmpty == copy.
	! !

!BagTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 12:01'!
anotherElementOrAssociationNotIn
	" return an element (or an association for Dictionary )not present  in 'collection' "
	^ elementNotIn ! !

!BagTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 11:53'!
secondCollection
" return a collection that will be the second part of the concatenation"
	^ collectionWithCharacters ! !

!BagTest methodsFor: 'tests - concatenation' stamp: ''!
testConcatenation

"| collection1 collection2 result |
collection1 := self firstCollection .
collection2 := self secondCollection .
result := collection1 , collection2.

collection1 do:[ :each | self assert: (result includes: each)].
collection2 do:[ :each | self assert: (result includes: each)]."

| collection1 collection2 result |
collection1 := self firstCollection .
collection2 := self secondCollection .
result := collection1 , collection2.

result do: [ :each | self assert: (result occurrencesOf: each) = (( collection1 occurrencesOf: each ) + ( collection2 occurrencesOf: each ) ). ].
self assert: result size = (collection1 size + collection2 size)! !

!BagTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionBasic
	"self debug: #testIntersectionBasic"
	| inter |
	inter := self collection intersection: (self collectionClass with: self anotherElementOrAssociationIn).
	self deny: inter isEmpty.
	self assert: (inter includes: self anotherElementOrAssociationIn value)! !

!BagTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithout
	"self debug: #testCopyNonEmptyWithout"
	
	| res anElementOfTheCollection |
	anElementOfTheCollection :=  self nonEmpty anyOne.
	res := (self nonEmpty copyWithout: anElementOfTheCollection).
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self deny: (res includes: anElementOfTheCollection).
	self nonEmpty do:
		[:each | (each = anElementOfTheCollection) 
					ifFalse: [self assert: (res includes: each)]].
	
! !

!BagTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutNotIncluded
	"self debug: #testCopyNonEmptyWithoutNotIncluded"
	| res |
	res := self nonEmpty copyWithout: self elementToAdd.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self nonEmpty do: [ :each | self assert: (res includes: each) ]! !

!BagTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifference
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifference"
	
	| difference |
	self assert: (self collectionWithoutEqualElements difference: self collectionWithoutEqualElements) isEmpty.
	self assert: (self empty difference: self collectionWithoutEqualElements) isEmpty.
	difference := (self collectionWithoutEqualElements difference: self empty).
	self assert: difference size = self collectionWithoutEqualElements	 size.
	self collectionWithoutEqualElements do: [ :each |
		self assert: (difference includes: each)].
! !

!BagTest methodsFor: 'tests - as set tests' stamp: ''!
testAsIdentitySetWithEqualsElements
	| result collection |
	collection := self withEqualElements .
	result := collection asIdentitySet.
	collection do: [ :each | self assert: (result occurrencesOf: each) = 1 ].
	self assert: result class = IdentitySet.! !

!BagTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionItself
	"self debug: #testIntersectionItself"
	
	| result |
	result :=  (self collectionWithoutEqualElements intersection: self collectionWithoutEqualElements).
	self assert: result size  = self collectionWithoutEqualElements size.
	self collectionWithoutEqualElements do: [ :each|
		self assert: (result includes: each) ].
	! !

!BagTest methodsFor: 'basic tests' stamp: 'sd 3/21/2006 22:32'!
testOccurrencesOf
	"self debug: #testOccurrencesOf"

	| aBag |
 	aBag := Bag new.	
	aBag add: 'a' withOccurrences: 3.
	aBag add: 'b'.
	aBag add: 'b'.
	aBag add: 'b'.
	aBag add: 'b'.	
	self assert: (aBag occurrencesOf:'a') = 3.
	self assert: (aBag occurrencesOf:'b') = 4.
	self assert: (aBag occurrencesOf:'c') = 0.
	self assert: (aBag occurrencesOf: nil) =0.
	aBag add: nil.
	self assert: (aBag occurrencesOf: nil) =1.
	! !

!BagTest methodsFor: 'tests - converting' stamp: ''!
testAsOrderedCollection
	
	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: OrderedCollection! !

!BagTest methodsFor: 'requirements' stamp: 'delaunay 5/13/2009 15:33'!
elementTwiceInForOccurrences
" return an element included exactly two time in # collectionWithEqualElements"
^ self elementTwiceIn ! !

!BagTest methodsFor: 'requirements' stamp: 'damienpollet 1/30/2009 17:32'!
element
	^ super element! !

!BagTest methodsFor: 'setup' stamp: 'stephane.ducasse 10/6/2008 17:26'!
emptyButAllocatedWith20 
	
		^ emptyButAllocatedWith20! !

!BagTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 11:27'!
otherCollection
	^ otherCollectionWithoutEqualElements! !

!BagTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:53'!
test0CopyTest
	self empty.
	self assert: self empty size = 0.
	self nonEmpty.
	self assert: (self nonEmpty size = 0) not.
	self collectionWithElementsToRemove.
	self assert: (self collectionWithElementsToRemove size = 0) not.
	self elementToAdd! !

!BagTest methodsFor: 'tests - remove' stamp: ''!
testRemoveAllSuchThat
	"self debug: #testRemoveElementThatExists"
	| el aSubCollection |
	el := self nonEmptyWithoutEqualElements anyOne.
	aSubCollection := self nonEmptyWithoutEqualElements copyWithout: el.
	self nonEmptyWithoutEqualElements removeAllSuchThat: [ :each | aSubCollection includes: each ].
	self assert: self nonEmptyWithoutEqualElements size = 1.
	self nonEmptyWithoutEqualElements do: [ :each | self assert: each = el ]! !

!BagTest methodsFor: 'test - remove' stamp: 'damienpollet 1/30/2009 17:07'!
testRemoveElementThatExistsTwice
	"self debug: #testRemoveElementThatDoesExistsTwice"
	| size |
	size := self nonEmpty size.
	self assert: (self nonEmpty includes: self elementTwiceIn).
	self nonEmpty remove: self elementTwiceIn.
	self assert: size - 1 = self nonEmpty size! !

!BagTest methodsFor: 'setup' stamp: 'cyrille.delaunay 12/18/2009 13:12'!
result

	^ collectResult.
	! !

!BagTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 10:22'!
collectionWithCopyNonIdentical
	" return a collection that include elements for which 'copy' return a different object (this is not the case of SmallInteger)"
	^ collectionOfString! !

!BagTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWithout
	"self debug: #testCopyEmptyWithout"
	| res |
	res := self empty copyWithout: self elementToAdd.
	self assert: res size = self empty size.
	self deny: (res includes: self elementToAdd)! !

!BagTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedCollection

	| aCollection result |
	aCollection := self collectionWithSortableElements .
	result := aCollection asSortedCollection.
	
	self assert: (result class includesBehavior: SortedCollection).
	result do: 
		[ :each | 
		self assert: (aCollection occurrencesOf: each) = (result occurrencesOf: each) ].
	
	self assert: result size = aCollection size.! !

!BagTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 11:28'!
nonEmptyWithoutEqualElements
" return a collection without equal elements "
	^ otherCollectionWithoutEqualElements ! !

!BagTest methodsFor: 'test - set arithmetic' stamp: 'stephane.ducasse 12/20/2008 22:46'!
collectionClass

	^ Bag! !

!BagTest methodsFor: 'requirements' stamp: 'delaunay 4/30/2009 10:54'!
nonEmpty1Element

	^ self speciesClass  new add: self element ;yourself.! !

!BagTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureConcatenationTest
	self firstCollection.
	self deny: self firstCollection isEmpty.
	self firstCollection.
	self deny: self firstCollection isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!BagTest methodsFor: 'tests - set arithmetic' stamp: ''!
testUnion
	"self debug: #testUnionOfEmpties"
	
	| union |
	union := self empty union: self nonEmpty.
	self containsAll: union of: self empty andOf: self nonEmpty.
	union := self nonEmpty union: self empty.
	self containsAll: union of: self empty andOf: self nonEmpty.
	union := self collection union: self nonEmpty.
	self containsAll: union of: self collection andOf: self nonEmpty.! !

!BagTest methodsFor: 'test - equality' stamp: ''!
testEqualSign
	"self debug: #testEqualSign"

	self deny: (self empty = self nonEmpty).! !

!BagTest methodsFor: 'test - creation' stamp: ''!
testWithWithWithWith
	"self debug: #testWithWithWithWith"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom: 1 to: 4.
	aCol := self collectionClass with: (collection at:1) with: ( collection at:2 ) with: ( collection at: 3) with: ( collection at: 4).

	1 to: 3 do: [ :i | self assert: ( aCol occurrencesOf: ( collection at: i ) ) = ( collection occurrencesOf: ( collection at: i ) ) ].! !

!BagTest methodsFor: 'tests - copy' stamp: ''!
testCopySameClass
	"self debug: #testCopySameClass"
	"A copy of a collection should always be of the same class as the instance it copies"
	
	| copy | 
	copy := self empty copy.
	self assert: copy class == self empty class.! !

!BagTest methodsFor: 'requirements' stamp: 'stephane.ducasse 10/6/2008 17:39'!
speciesClass
	
	^ Bag! !

!BagTest methodsFor: 'tests - set arithmetic' stamp: ''!
containsAll: union of: one andOf: another
			
	self assert: (one allSatisfy: [:each | union includes: each]).
	self assert: (another allSatisfy: [:each | union includes: each])! !

!BagTest methodsFor: 'requirements' stamp: 'damienpollet 1/30/2009 17:40'!
selectedNumber
	^ 4! !

!BagTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsCommaStringOne
	
	self nonEmpty1Element do: 
		[:each | 
		self assert: each asString =self nonEmpty1Element  asCommaString.
		self assert: each asString=self nonEmpty1Element  asCommaStringAnd.].

	! !

!BagTest methodsFor: 'tests - fixture' stamp: ''!
test0FixturePrintTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty! !

!BagTest methodsFor: 'requirements' stamp: 'delaunay 4/14/2009 13:40'!
elementNotIn

	^elementNotIn ! !

!BagTest methodsFor: 'setup' stamp: 'cyrille.delaunay 12/18/2009 13:12'!
setUp
	empty := self speciesClass new.
	nonEmpty := self speciesClass new
		add: 13;
		add: -2;
		add: self elementTwiceIn;
		add: 10;
		add: self elementTwiceIn;
		add: self element;
		yourself.
	elementNotIn := 0.
	collectionIn := self speciesClass new
		add: -2;
		add: self elementTwiceIn;
		add: 10;
		yourself.
	collectionNotIn := self speciesClass new
		add: self elementNotIn;
		add: 5;
		yourself.
	collectionOfString := self speciesClass new
		add: 1.5;
		add: 5.5;
		add: 7.5;
		yourself.
	otherCollectionWithoutEqualElements := self speciesClass new
		add: 1;
		add: 20;
		add: 30;
		add: 40;
		yourself.
	collectionWithoutNilMoreThan5 := self speciesClass new
		add: 1;
		add: 2;
		add: 3;
		add: 4;
		add: 5;
		add: 6;
		yourself.
	collectResult := self speciesClass new
		add: SmallInteger;
		add: SmallInteger;
		add: SmallInteger;
		add: SmallInteger;
		add: SmallInteger;
		add: SmallInteger;
		yourself.
	emptyButAllocatedWith20 := self speciesClass new: 20.
	collectionWithElement := self speciesClass new
		add: self element;
		yourself.
	collectionWithCharacters := self speciesClass new
		add: $p;
		add: $v;
		add: $i;
		add: $y;
		yourself! !

!BagTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAllNoneThere
	"self debug: #testIncludesAllOfNoneThere'"
	self deny: (self empty includesAll: self nonEmpty ).
	self deny: (self nonEmpty includesAll: { self elementNotIn. self anotherElementNotIn })! !

!BagTest methodsFor: 'test - creation' stamp: ''!
testWithWithWithWithWith
	"self debug: #testWithWithWithWithWith"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom: 1 to: 5 .
	aCol := self collectionClass with: (collection at:1) with: ( collection at:2 ) with: ( collection at: 3) with: (collection at: 4 ) with: ( collection at: 5 ).

	1 to: 3 do: [ :i | self assert: ( aCol occurrencesOf: ( collection at: i ) ) = ( collection occurrencesOf: ( collection at: i ) ) ].! !

!BagTest methodsFor: 'tests - as set tests' stamp: ''!
testAsSetWithEqualsElements
	| result |
	result := self withEqualElements asSet.
	self withEqualElements do: [ :each | self assert: (result occurrencesOf: each) = 1 ].
	self assert: result class = Set! !

!BagTest methodsFor: 'tests - printing' stamp: ''!
testPrintOnDelimiterLast

	| aStream result allElementsAsString tmp |
	result:=''.
	aStream:= ReadWriteStream on: result.
	tmp:= OrderedCollection new.
	self nonEmpty do: [:each | tmp add: each asString].
	
	self nonEmpty printOn: aStream delimiter: ', ' last: 'and'.
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 )
			ifTrue: [self assert: (tmp occurrencesOf: (allElementsAsString at:i))=(allElementsAsString  occurrencesOf: (allElementsAsString at:i))].
		i=(allElementsAsString size-1)
			ifTrue:[ self deny: (allElementsAsString at:i)=('and')asString].
		i=(allElementsAsString size)
			ifTrue: [self assert: (tmp occurrencesOf: (allElementsAsString at:i))=(allElementsAsString  occurrencesOf: (allElementsAsString at:i))].
			].! !

!BagTest methodsFor: 'basic tests' stamp: 'TJ 3/8/2006 08:42'!
testAsBag

	| aBag |
 
	aBag := Bag new.	
	
	self assert: aBag asBag = aBag.! !

!BagTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsStringOnDelimiterOne

	| delim oneItemStream result |

	delim := ', '.
	result:=''.
	oneItemStream := ReadWriteStream on: result.
	self nonEmpty1Element  asStringOn: oneItemStream delimiter: delim.
	oneItemStream  do:
		[:each1 |
		self nonEmpty1Element do: [:each2 |self assert: each1 = (each2 asString) ]
		 ].
	
! !

!BagTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWith
	"self debug: #testCopyWith"
	| res anElement |
	anElement := self elementToAdd.
	res := self empty copyWith: anElement.
	self assert: res size = (self empty size + 1).
	self assert: (res includes: (anElement value))! !

!BagTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureConverAsSortedTest
	self collectionWithSortableElements.
	self deny: self collectionWithSortableElements isEmpty! !

!BagTest methodsFor: 'requirements' stamp: 'delaunay 4/14/2009 14:19'!
elementInForIncludesTest

	^ self element ! !

!BagTest methodsFor: 'tests - printing' stamp: ''!
testStoreOn
" for the moment work only for collection that include simple elements such that Integer"

"| string str result cuttedResult index elementsAsStringExpected elementsAsStringObtained tmp |
string := ''.
str := ReadWriteStream  on: string.
elementsAsStringExpected := OrderedCollection new.
elementsAsStringObtained := OrderedCollection new.
self nonEmpty do: [ :each | elementsAsStringExpected  add: each asString].

self nonEmpty storeOn: str.
result := str contents .
cuttedResult := ( result findBetweenSubStrs: ';' ).

index := 1.

cuttedResult do:
	[ :each |
	index = 1 
		ifTrue: [ self assert: (each beginsWith: ( tmp := '((' , self nonEmpty class asString , ' new) add: '           )).
				tmp := each copyFrom: ( tmp size + 1) to: ( each size ).
				elementsAsStringObtained add: tmp.
				index := index + 1. ]
		ifFalse:  [ 
		 index < cuttedResult size
			ifTrue:[self assert: (each beginsWith: ( tmp:=  ' add: '   )).
				tmp := each copyFrom: ( tmp size + 1) to: ( each size ).
				elementsAsStringObtained add: tmp.
					index := index + 1.]
			ifFalse: [self assert: ( each = ' yourself)' ) ].
			]
	
	].


	elementsAsStringExpected do: [ :each | self assert: (elementsAsStringExpected occurrencesOf: each ) = ( elementsAsStringObtained occurrencesOf: each) ]"

! !

!BagTest methodsFor: 'tests - remove' stamp: ''!
testRemoveAllError
	"self debug: #testRemoveElementThatExists"
	| el aSubCollection |
	el := self elementNotIn.
	aSubCollection := self nonEmptyWithoutEqualElements copyWith: el.
	self 
		should: [ | res | res := self nonEmptyWithoutEqualElements removeAll: aSubCollection ]
		raise: Error! !

!BalloonBezierSimulation commentStamp: '<historical>'!
This class is a simulation of the code that's run by the Balloon engine. For debugging purposes only.!
!BalloonBezierSimulation methodsFor: 'accessing' stamp: 'ar 10/27/1998 20:45'!
end: aPoint
	end := aPoint! !

!BalloonBezierSimulation methodsFor: 'computing' stamp: 'MarcusDenker 9/10/2013 12:07'!
floatStepToNextScanLineAt: yValue in: edgeTableEntry
	"Float version of forward differencing"
	[yValue asFloat > lastY] whileTrue:[
		self assert: [fwDx < -50.0 or:[fwDx > 50.0]].
		self assert: [fwDy < -50.0 or:[fwDy > 50.0]].
		self assert: [fwDDx < -50.0 or:[fwDDx > 50.0]].
		self assert: [fwDDy < -50.0 or:[fwDDy > 50.0]].
		lastY := lastY + fwDy.
		fwDx := fwDx + fwDDx.
		fwDy := fwDy + fwDDy.
	].
	edgeTableEntry xValue: lastX asInteger.
	edgeTableEntry zValue: 0.! !

!BalloonBezierSimulation methodsFor: 'accessing' stamp: 'ar 10/27/1998 20:45'!
initialY
	^start y <= end y
		ifTrue:[start y]
		ifFalse:[end y]! !

!BalloonBezierSimulation methodsFor: 'accessing' stamp: 'ar 10/27/1998 20:45'!
initialX
	^start y <= end y
		ifTrue:[start x]
		ifFalse:[end x]! !

!BalloonBezierSimulation methodsFor: 'private' stamp: 'ar 10/30/1998 22:13'!
quickPrint: curve first: aBool
	aBool ifTrue:[Transcript cr].
	Transcript nextPut:$(;
		print: curve start;
		space;
		print: curve via;
		space;
		print: curve end;
		nextPut:$).
	Transcript endEntry.! !

!BalloonBezierSimulation methodsFor: 'computing' stamp: 'ar 10/30/1998 01:34'!
floatStepToFirstScanLineAt: yValue in: edgeTableEntry
	"Float version of forward differencing"
	|  startX endX startY endY deltaY fwX1 fwX2 fwY1 fwY2 
	steps scaledStepSize squaredStepSize |
	(end y) >= (start y) ifTrue:[
		startX := start x.	endX := end x.
		startY := start y.	endY := end y.
	] ifFalse:[
		startX := end x.	endX := start x.
		startY := end y.	endY := start y.
	].

	deltaY := endY - startY.

	"Quickly check if the line is visible at all"
	(yValue >= endY or:[deltaY = 0]) ifTrue:[
		^edgeTableEntry lines: 0].

	fwX1 := (startX + endX - (2 * via x)) asFloat.
	fwX2 := (via x - startX * 2) asFloat.
	fwY1 := (startY + endY - (2 * via y)) asFloat.
	fwY2 := ((via y - startY) * 2) asFloat.
	steps := deltaY asInteger * 2.
	scaledStepSize := 1.0 / steps asFloat.
	squaredStepSize := scaledStepSize * scaledStepSize.
	fwDx := fwX2 * scaledStepSize.
	fwDDx := 2.0 * fwX1 * squaredStepSize.
	fwDy := fwY2 * scaledStepSize.
	fwDDy := 2.0 * fwY1 * squaredStepSize.
	fwDx := fwDx + (fwDDx * 0.5).
	fwDy := fwDy + (fwDDy * 0.5).

	lastX := startX asFloat.
	lastY := startY asFloat.

	"self xDirection: xDir.
	self yDirection: yDir."
	edgeTableEntry xValue: startX.
	edgeTableEntry yValue: startY.
	edgeTableEntry zValue: 0.
	edgeTableEntry lines: deltaY.

	"If not at first scan line then step down to yValue"
	yValue = startY ifFalse:[
		self stepToNextScanLineAt: yValue in: edgeTableEntry.
		"And adjust remainingLines"
		edgeTableEntry lines: deltaY - (yValue - startY).
	].! !

!BalloonBezierSimulation methodsFor: 'computing' stamp: 'pmm 3/13/2010 11:20'!
computeSplitAt: t
	"Split the receiver at the parametric value t"
	| left right newVia1 newVia2 newPoint |
	left := self shallowCopy.
	right := self shallowCopy.
	"Compute new intermediate points"
	newVia1 := (via - start) * t + start.
	newVia2 := (end - via) * t + via.
	"Compute new point on curve"
	newPoint := ((newVia1 - newVia2) * t + newVia2) asIntegerPoint.
	left via: newVia1 asIntegerPoint.
	left end: newPoint.
	right start: newPoint.
	right via: newVia2 asIntegerPoint.
	^Array with: left with: right! !

!BalloonBezierSimulation methodsFor: 'computing' stamp: 'ar 11/1/1998 00:31'!
subdivide
	"Subdivide the receiver"
	| dy dx |
	"Test 1: If the bezier curve is not monoton in Y, we need a subdivision"
	self isMonoton ifFalse:[
		MonotonSubdivisions := MonotonSubdivisions + 1.
		^self subdivideToBeMonoton].

	"Test 2: If the receiver is horizontal, don't do anything"
	(end y = start y) ifTrue:[^nil].

	"Test 3: If the receiver can be represented as a straight line,
			make a line from the receiver and declare it invalid"
	((end - start) crossProduct: (via - start)) = 0 ifTrue:[
		LineConversions := LineConversions + 1.
		^self subdivideToBeLine].

	"Test 4: If the height of the curve exceeds 256 pixels, subdivide 
			(forward differencing is numerically not very stable)"
	dy := end y - start y.
	dy < 0 ifTrue:[dy := dy negated].
	(dy > 255) ifTrue:[
		HeightSubdivisions := HeightSubdivisions + 1.
		^self subdivideAt: 0.5].

	"Test 5: Check if the incremental values could possibly overflow the scaled integer range"
	dx := end x - start x.
	dx < 0 ifTrue:[dx := dx negated].
	dy * 32 < dx ifTrue:[
		OverflowSubdivisions := OverflowSubdivisions + 1.
		^self subdivideAt: 0.5].

	^nil! !

!BalloonBezierSimulation methodsFor: 'computing' stamp: 'ar 10/31/1998 16:36'!
stepToFirstScanLineAt: yValue in: edgeTableEntry
	"Compute the initial x value for the scan line at yValue"
	^self intStepToFirstScanLineAt: yValue in: edgeTableEntry! !

!BalloonBezierSimulation methodsFor: 'private' stamp: 'ar 10/30/1998 03:53'!
stepToFirst
	|  startX endX startY endY deltaY fwX1 fwX2 fwY1 fwY2 
	steps scaledStepSize squaredStepSize |
	(end y) >= (start y) ifTrue:[
		startX := start x.	endX := end x.
		startY := start y.	endY := end y.
	] ifFalse:[
		startX := end x.	endX := start x.
		startY := end y.	endY := start y.
	].

	deltaY := endY - startY.

	"Quickly check if the line is visible at all"
	(deltaY = 0) ifTrue:[^self].

	fwX1 := (startX + endX - (2 * via x)) asFloat.
	fwX2 := (via x - startX * 2) asFloat.
	fwY1 := (startY + endY - (2 * via y)) asFloat.
	fwY2 := ((via y - startY) * 2) asFloat.
	steps := deltaY asInteger * 2.
	scaledStepSize := 1.0 / steps asFloat.
	squaredStepSize := scaledStepSize * scaledStepSize.
	fwDx := fwX2 * scaledStepSize.
	fwDDx := 2.0 * fwX1 * squaredStepSize.
	fwDy := fwY2 * scaledStepSize.
	fwDDy := 2.0 * fwY1 * squaredStepSize.
	fwDx := fwDx + (fwDDx * 0.5).
	fwDy := fwDy + (fwDDy * 0.5).

	lastX := startX asFloat.
	lastY := startY asFloat.
! !

!BalloonBezierSimulation methodsFor: 'accessing' stamp: 'ar 10/30/1998 01:57'!
inTangent
	"Return the tangent at the start point"
	^via - start! !

!BalloonBezierSimulation methodsFor: 'accessing' stamp: 'ar 10/27/1998 20:45'!
via
	^via! !

!BalloonBezierSimulation methodsFor: 'accessing' stamp: 'ar 10/27/1998 20:45'!
start
	^start! !

!BalloonBezierSimulation methodsFor: 'private' stamp: 'ar 5/25/2000 17:57'!
debugDraw2
	| canvas last max t next |
	canvas := Display getCanvas.
	max := 100.
	last := nil.
	0 to: max do:[:i|
		t := i asFloat / max asFloat.
		next := self valueAt: t.
		last ifNotNil:[
			canvas line: last to: next rounded width: 2 color: Color blue.
		].
		last := next rounded.
	].! !

!BalloonBezierSimulation methodsFor: 'printing' stamp: 'ar 10/30/1998 00:35'!
printOn: aStream
	aStream 
		nextPutAll: self class name;
		nextPut:$(;
		print: start;
		nextPutAll:' - ';
		print: via;
		nextPutAll:' - ';
		print: end;
		nextPut:$)! !

!BalloonBezierSimulation methodsFor: 'accessing' stamp: 'ar 10/27/1998 20:45'!
start: aPoint
	start := aPoint! !

!BalloonBezierSimulation methodsFor: 'private' stamp: 'ar 10/30/1998 21:56'!
quickPrint: curve
	Transcript nextPut:$(;
		print: curve start;
		space;
		print: curve via;
		space;
		print: curve end;
		nextPut:$).! !

!BalloonBezierSimulation methodsFor: 'private' stamp: 'GuillermoPolito 5/24/2010 14:34'!
stepToFirstInt
	"Scaled integer version of forward differencing"
	|  startX endX startY endY deltaY fwX1 fwX2 fwY1 fwY2 
	 scaledStepSize squaredStepSize |
	(end y) >= (start y) ifTrue:[
		startX := start x.	endX := end x.
		startY := start y.	endY := end y.
	] ifFalse:[
		startX := end x.	endX := start x.
		startY := end y.	endY := start y.
	].

	deltaY := endY - startY.

	"Quickly check if the line is visible at all"
	(deltaY = 0) ifTrue:[^nil].

	fwX1 := (startX + endX - (2 * via x)).
	fwX2 := (via x - startX * 2).
	fwY1 := (startY + endY - (2 * via y)).
	fwY2 := ((via y - startY) * 2).
	maxSteps := deltaY asInteger * 2.
	scaledStepSize := 16r1000000 // maxSteps.
	"@@: Okay, we need some fancy 64bit multiplication here"
	squaredStepSize := (scaledStepSize * scaledStepSize) bitShift: -24.
	fwDx := fwX2 * scaledStepSize.
	fwDDx := 2 * fwX1 * squaredStepSize.
	fwDy := fwY2 * scaledStepSize.
	fwDDy := 2 * fwY1 * squaredStepSize.
	fwDx := fwDx + (fwDDx // 2).
	fwDy := fwDy + (fwDDy // 2).

	self validateIntegerRange.

	lastX := startX * 256.
	lastY := startY * 256.
! !

!BalloonBezierSimulation methodsFor: 'accessing' stamp: 'ar 10/27/1998 20:45'!
initialZ
	^0 "Assume no depth given"! !

!BalloonBezierSimulation methodsFor: 'private' stamp: 'ar 10/30/1998 00:26'!
stepToNext
		lastX := lastX + fwDx.
		lastY := lastY + fwDy.
		fwDx := fwDx + fwDDx.
		fwDy := fwDy + fwDDy.! !

!BalloonBezierSimulation methodsFor: 'private' stamp: 'ar 5/25/2000 17:57'!
debugDrawWide: n
	| entry minY maxY canvas curve p1 p2 entry2 y |
	curve := self class new.
	curve start: start + (0@n).
	curve via: via + (0@n).
	curve end: end + (0@n).
	entry := BalloonEdgeData new.
	entry2 := BalloonEdgeData new.
	canvas := Display getCanvas.
	minY := (start y min: end y) min: via y.
	maxY := (start y max: end y) max: via y.
	entry yValue: minY.
	entry2 yValue: minY + n.
	self stepToFirstScanLineAt: minY in: entry.
	curve stepToFirstScanLineAt: minY+n in: entry2.
	y := minY.
	1 to: n do:[:i|
		y := y + 1.
		self stepToNextScanLineAt: y in: entry.
		p1 := entry xValue @ y.
		canvas line: p1 to: p1 + (n@0) width: 1 color: Color black.
	].
	[y < maxY] whileTrue:[
		y := y + 1.
		self stepToNextScanLineAt: y in: entry.
		p2 := (entry xValue + n) @ y.
		curve stepToNextScanLineAt: y in: entry2.
		p1 := entry2 xValue @ y.
		canvas line: p1 to: p2 width: 1 color: Color black.
	].
! !

!BalloonBezierSimulation methodsFor: 'computing' stamp: 'ar 10/30/1998 03:40'!
stepToNextScanLineAt: yValue in: edgeTableEntry
	"Compute the next x value for the scan line at yValue.
	This message is sent during incremental updates. 
	The yValue parameter is passed in here for edges
	that have more complicated computations,"
	^self intStepToNextScanLineAt: yValue in: edgeTableEntry! !

!BalloonBezierSimulation methodsFor: 'accessing' stamp: 'ar 10/30/1998 01:57'!
outTangent
	"Return the tangent at the end point"
	^end - via! !

!BalloonBezierSimulation methodsFor: 'computing' stamp: 'ar 10/27/1998 20:46'!
computeInitialStateFrom: source with: transformation
	"Compute the initial state in the receiver."
	start := (transformation localPointToGlobal: source start) asIntegerPoint.
	end := (transformation localPointToGlobal: source end) asIntegerPoint.
	via := (transformation localPointToGlobal: source via) asIntegerPoint.! !

!BalloonBezierSimulation methodsFor: 'private' stamp: 'ar 10/30/1998 16:37'!
absoluteSquared8Dot24: value
	"Compute the squared value of a 8.24 number with 0.0 <= value < 1.0,
	e.g., compute (value * value) bitShift: -24"
	| halfWord1 halfWord2 result |
	(value >= 0 and:[value < 16r1000000]) ifFalse:[^self error:'Value out of range'].
	halfWord1 := value bitAnd: 16rFFFF.
	halfWord2 := (value bitShift: -16) bitAnd: 255.

	result := (halfWord1 * halfWord1) bitShift: -16. "We don't need the lower 16bits at all"
	result := result + ((halfWord1 * halfWord2) * 2).
	result := result + ((halfWord2 * halfWord2) bitShift: 16).
	"word1 := halfWord1 * halfWord1.
	word2 := (halfWord2 * halfWord1) + (word1 bitShift: -16).
	word1 := word1 bitAnd: 16rFFFF.
	word2 := word2 + (halfWord1 * halfWord2).
	word2 := word2 + ((halfWord2 * halfWord2) bitShift: 16)."

	^result bitShift: -8! !

!BalloonBezierSimulation methodsFor: 'private' stamp: 'MarcusDenker 9/10/2013 12:09'!
validateIntegerRange
	self assert: [fwDx class == SmallInteger].
	self assert: [fwDy class == SmallInteger].
	self assert: [fwDDx class == SmallInteger].
	self assert: [fwDDy class == SmallInteger].
! !

!BalloonBezierSimulation methodsFor: 'accessing' stamp: 'ar 10/27/1998 20:45'!
end
	^end! !

!BalloonBezierSimulation methodsFor: 'private' stamp: 'ar 5/25/2000 17:57'!
debugDraw
	| entry minY maxY lX lY canvas |
	entry := BalloonEdgeData new.
	canvas := Display getCanvas.
	minY := (start y min: end y) min: via y.
	maxY := (start y max: end y) max: via y.
	entry yValue: minY.
	self stepToFirstScanLineAt: minY in: entry.
	lX := entry xValue.
	lY := entry yValue.
	minY+1 to: maxY do:[:y|
		self stepToNextScanLineAt: y in: entry.
		canvas line: lX@lY to: entry xValue @ y width: 2 color: Color black.
		lX := entry xValue.
		lY := y.
	].
! !

!BalloonBezierSimulation methodsFor: 'computing' stamp: 'ar 10/30/1998 16:23'!
intStepToFirstScanLineAt: yValue in: edgeTableEntry
	"Scaled integer version of forward differencing"
	|  startX endX startY endY deltaY fwX1 fwX2 fwY1 fwY2 
	 scaledStepSize squaredStepSize |
	(end y) >= (start y) ifTrue:[
		startX := start x.	endX := end x.
		startY := start y.	endY := end y.
	] ifFalse:[
		startX := end x.	endX := start x.
		startY := end y.	endY := start y.
	].

	deltaY := endY - startY.

	"Quickly check if the line is visible at all"
	(yValue >= endY or:[deltaY = 0]) ifTrue:[
		^edgeTableEntry lines: 0].

	fwX1 := (startX + endX - (2 * via x)).
	fwX2 := (via x - startX * 2).
	fwY1 := (startY + endY - (2 * via y)).
	fwY2 := ((via y - startY) * 2).
	maxSteps := deltaY asInteger * 2.
	scaledStepSize := 16r1000000 // maxSteps.
	"@@: Okay, we need some fancy 64bit multiplication here"
	squaredStepSize := self absoluteSquared8Dot24: scaledStepSize.
	squaredStepSize = ((scaledStepSize * scaledStepSize) bitShift: -24)
		ifFalse:[self error:'Bad computation'].
	fwDx := fwX2 * scaledStepSize.
	fwDDx := 2 * fwX1 * squaredStepSize.
	fwDy := fwY2 * scaledStepSize.
	fwDDy := 2 * fwY1 * squaredStepSize.
	fwDx := fwDx + (fwDDx // 2).
	fwDy := fwDy + (fwDDy // 2).

	self validateIntegerRange.

	lastX := startX * 256.
	lastY := startY * 256.

	edgeTableEntry xValue: startX.
	edgeTableEntry yValue: startY.
	edgeTableEntry zValue: 0.
	edgeTableEntry lines: deltaY.

	"If not at first scan line then step down to yValue"
	yValue = startY ifFalse:[
		self stepToNextScanLineAt: yValue in: edgeTableEntry.
		"And adjust remainingLines"
		edgeTableEntry lines: deltaY - (yValue - startY).
	].! !

!BalloonBezierSimulation methodsFor: 'computing' stamp: 'MarcusDenker 9/10/2013 12:07'!
subdivideAt: parameter
	"Subdivide the receiver at the given parameter"
	| both |
	self assert: [parameter <= 0.0 or:[parameter >= 1.0]].
	both := self computeSplitAt: parameter.
	"Transcript cr.
	self quickPrint: self.
	Transcript space.
	self quickPrint: both first.
	Transcript space.
	self quickPrint: both last.
	Transcript endEntry."
	self via: both first via.
	self end: both first end.
	^both last! !

!BalloonBezierSimulation methodsFor: 'computing' stamp: 'MarcusDenker 9/10/2013 12:08'!
subdivideToBeMonoton
	"Subdivide the receiver at it's extreme point"
	| v1 v2 t other |
	v1 := (via - start).
	v2 := (end - via).
	t := (v1 y / (v2 y - v1 y)) negated asFloat.
	other := self subdivideAt: t.
	self assert: [self isMonoton].
	self assert: [other isMonoton].
	^other! !

!BalloonBezierSimulation methodsFor: 'accessing' stamp: 'ar 10/27/1998 20:45'!
via: aPoint
	via := aPoint! !

!BalloonBezierSimulation methodsFor: 'computing' stamp: 'ar 10/30/1998 04:02'!
intStepToNextScanLineAt: yValue in: edgeTableEntry
	"Scaled integer version of forward differencing"
	[maxSteps >= 0 and:[yValue * 256 > lastY]] whileTrue:[
		self validateIntegerRange.
		lastX := lastX + ((fwDx + 16r8000) // 16r10000).
		lastY := lastY + ((fwDy + 16r8000) // 16r10000).
		fwDx := fwDx + fwDDx.
		fwDy := fwDy + fwDDy.
		maxSteps := maxSteps - 1.
	].
	edgeTableEntry xValue: lastX // 256.
	edgeTableEntry zValue: 0.! !

!BalloonBezierSimulation methodsFor: 'computing' stamp: 'ar 10/29/1998 22:14'!
isMonoton
	"Return true if the receiver is monoton along the y-axis,
	e.g., check if the tangents have the same sign"
	^(via y - start y) * (end y - via y) >= 0! !

!BalloonBezierSimulation methodsFor: 'computing' stamp: 'ar 11/11/1998 22:15'!
subdivideToBeLine
	"Not a true subdivision.
	Just return a line representing the receiver and fake me to be of zero height"
	| line |
	line := BalloonLineSimulation new.
	line start: start.
	line end: end.
	"Make me invalid"
	end := start.
	via := start.
	 ^line! !

!BalloonBezierSimulation methodsFor: 'private' stamp: 'ar 10/29/1998 21:26'!
valueAt: parameter
	"Return the point at the value parameter:
		p(t) =	(1-t)^2 * p1 + 
				2*t*(1-t) * p2 + 
				t^2 * p3.
	"
	| t1 t2 t3 |
	t1 := (1.0 - parameter) squared.
	t2 := 2 * parameter * (1.0 - parameter).
	t3 := parameter squared.
	^(start * t1) + (via * t2) + (end * t3)! !

!BalloonBezierSimulation class methodsFor: 'initialization' stamp: 'MarcusDenker 9/30/2009 11:56'!
initialize
	HeightSubdivisions := 0.
	LineConversions := 0.
	MonotonSubdivisions := 0.
	OverflowSubdivisions := 0.! !

!BalloonBuffer commentStamp: '<historical>'!
BalloonBuffer is a repository for primitive data used by the BalloonEngine.!
!BalloonBuffer methodsFor: 'accessing' stamp: 'ar 10/26/1998 21:12'!
at: index put: anInteger
	"For simulation only"
	| word |
	anInteger < 0
		ifTrue:["word := 16r100000000 + anInteger"
				word := (anInteger + 1) negated bitInvert32]
		ifFalse:[word := anInteger].
	self  basicAt: index put: word.
	^anInteger! !

!BalloonBuffer methodsFor: 'accessing' stamp: 'ar 10/26/1998 21:12'!
at: index
	"For simulation only"
	| word |
	word := self basicAt: index.
	word < 16r3FFFFFFF ifTrue:[^word]. "Avoid LargeInteger computations"
	^word >= 16r80000000	"Negative?!!"
		ifTrue:["word - 16r100000000"
				(word bitInvert32 + 1) negated]
		ifFalse:[word]! !

!BalloonBuffer methodsFor: 'accessing' stamp: 'ar 2/2/2001 15:47'!
floatAt: index
	"For simulation only"
	<primitive: 'primitiveAt' module: 'FloatArrayPlugin'>
	^Float fromIEEE32Bit: (self basicAt: index)! !

!BalloonBuffer methodsFor: 'accessing' stamp: 'ar 2/2/2001 15:47'!
floatAt: index put: value
	"For simulation only"
	<primitive: 'primitiveAtPut' module: 'FloatArrayPlugin'>
	value isFloat 
		ifTrue:[self basicAt: index put: value asIEEE32BitWord]
		ifFalse:[self at: index put: value asFloat].
	^value! !

!BalloonBuffer class methodsFor: 'instance creation' stamp: 'ar 10/26/1998 21:11'!
new
	^self new: 256.! !

!BalloonCanvas commentStamp: '<historical>'!
BalloonCanvas is a canvas using the BalloonEngine for drawing wherever possible. It has various methods which other canvases do not support due to the extra features of the balloon engine.!
!BalloonCanvas methodsFor: 'balloon drawing' stamp: 'DSM 10/15/1999 15:14'!
drawBezier3Shape: vertices color: c borderWidth: borderWidth borderColor:
borderColor
	self drawBezierShape: (Bezier3Segment convertBezier3ToBezier2:
vertices) color: c borderWidth: borderWidth borderColor: borderColor! !

!BalloonCanvas methodsFor: 'balloon drawing' stamp: 'IgorStasenko 7/18/2011 18:07'!
drawRectangle: r color: c borderWidth: borderWidth borderColor: borderColor
	"Draw a rectangle"

	self ensuredEngine
		drawRectangle: r
		fill: c
		borderWidth: borderWidth
		borderColor: borderColor
		transform: transform.! !

!BalloonCanvas methodsFor: 'accessing' stamp: 'ar 12/30/1998 10:54'!
deferred
	^deferred! !

!BalloonCanvas methodsFor: 'drawing' stamp: 'ar 2/9/1999 05:40'!
fillRectangle: r color: c
	"Fill the rectangle with the given color"
	^self frameAndFillRectangle: r
			fillColor: c
			borderWidth: 0
			borderColor: nil! !

!BalloonCanvas methodsFor: 'todo' stamp: 'tween 3/10/2009 07:49'!
drawString: s from: firstIndex to: lastIndex in: boundsRect font: fontOrNil color: c underline: underline underlineColor: uc strikethrough: strikethrough strikethroughColor: sc
	(self ifNoTransformWithIn: boundsRect)
		ifTrue:[^super drawString: s from: firstIndex to: lastIndex in: boundsRect font: fontOrNil color: c underline: underline underlineColor: uc strikethrough: strikethrough strikethroughColor: sc]! !

!BalloonCanvas methodsFor: 'drawing' stamp: 'StephaneDucasse 8/15/2013 18:27'!
line: pt1 to: pt2 width: w color: c
	"Draw a line from pt1 to: pt2"

	(aaLevel = 1 and: [self ifNoTransformWithIn:(pt1 rectangle: pt2)])
		ifTrue:[^super line: pt1 to: pt2 width: w color: c].
	^self drawPolygon: (Array with: pt1 with: pt2)
		color: c
		borderWidth: w
		borderColor: c! !

!BalloonCanvas methodsFor: 'balloon drawing' stamp: 'StephaneDucasse 2/9/2011 14:34'!
fillRectangle: aRectangle basicFillStyle: aFillStyle
	"Fill the given rectangle with the given, non-composite, fill style."
	
	^self drawRectangle: aRectangle
			color: aFillStyle
			borderWidth: 0
			borderColor: nil
! !

!BalloonCanvas methodsFor: 'drawing' stamp: 'ar 2/9/1999 05:51'!
fillOval: r color: c borderWidth: borderWidth borderColor: borderColor
	"Draw a filled and outlined oval"
	"Note: The optimization test below should actually read:
		self ifNoTransformWithIn: (r insetBy: borderWidth // 2)
	but since borderWidth is assumed to be very small related to r we don't check it."

	(self ifNoTransformWithIn: r)
		ifTrue:[^super fillOval: r color: c borderWidth: borderWidth borderColor: borderColor].

	^self drawOval: (r insetBy: borderWidth // 2) 
			color: c 
			borderWidth: borderWidth 
			borderColor: borderColor! !

!BalloonCanvas methodsFor: 'balloon drawing' stamp: 'ar 11/24/1998 15:16'!
drawCompressedShape: compressedShape
	"Draw a compressed shape"
	self ensuredEngine
		drawCompressedShape: compressedShape
		transform: transform.! !

!BalloonCanvas methodsFor: 'balloon drawing' stamp: 'IgorStasenko 7/18/2011 18:07'!
drawOval: r color: c borderWidth: borderWidth borderColor: borderColor
	"Draw the oval defined by the given rectangle"

	self ensuredEngine
		drawOval: r
		fill: c
		borderWidth: borderWidth
		borderColor: borderColor
		transform: transform.! !

!BalloonCanvas methodsFor: 'balloon drawing' stamp: 'IgorStasenko 7/18/2011 18:06'!
drawGeneralPolygon: contours color: c borderWidth: borderWidth borderColor: borderColor
	"Draw a general polygon (e.g., a polygon that can contain holes)"

	self ensuredEngine
		drawGeneralPolygon: contours
		fill: c
		borderWidth: borderWidth
		borderColor: borderColor
		transform: transform.! !

!BalloonCanvas methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 09:42'!
initialize
	super initialize.
	aaLevel := 1.
	deferred := false.! !

!BalloonCanvas methodsFor: 'private' stamp: 'MarcusDenker 10/28/2010 14:02'!
image: aForm at: aPoint sourceRect: sourceRect rule: rule
	| warp dstRect srcQuad dstOffset |
	(self ifNoTransformWithIn: sourceRect) & false
		ifTrue:[^super image: aForm at: aPoint sourceRect: sourceRect rule: rule].
	dstRect := (transform localBoundsToGlobal: (aForm boundingBox translateBy: aPoint)).
	dstOffset := 0@0. "dstRect origin."
	"dstRect := 0@0 corner: dstRect extent."
	srcQuad := transform globalPointsToLocal: (dstRect innerCorners).
	srcQuad := srcQuad collect:[:pt| pt - aPoint].
	warp := (WarpBlt current toForm: form)
			sourceForm: aForm;
			cellSize: 2;  "installs a new colormap if cellSize > 1"
			combinationRule: Form over.
	warp copyQuad: srcQuad toRect: (dstRect translateBy: dstOffset).

	self frameRectangle: (aForm boundingBox translateBy: aPoint) color: Color green.

	"... TODO ... create a bitmap fill style from the form and use it for a simple rectangle."! !

!BalloonCanvas methodsFor: 'todo' stamp: 'ar 12/31/2001 02:27'!
drawString: s from: firstIndex to: lastIndex in: boundsRect font: fontOrNil color: c
	(self ifNoTransformWithIn: boundsRect)
		ifTrue:[^super drawString: s from: firstIndex to: lastIndex in: boundsRect font: fontOrNil color: c]! !

!BalloonCanvas methodsFor: 'accessing' stamp: 'ar 12/30/1998 10:53'!
aaLevel: newLevel
	"Only allow changes to aaLevel if we're working on >= 8 bit forms"
	form depth >= 8 ifFalse:[^self].
	aaLevel = newLevel ifTrue:[^self].
	self flush.	"In case there are pending primitives in the engine"
	aaLevel := newLevel.
	engine ifNotNil:[engine aaLevel: aaLevel].! !

!BalloonCanvas methodsFor: 'accessing' stamp: 'ar 11/13/1998 01:02'!
aaLevel
	^aaLevel! !

!BalloonCanvas methodsFor: 'transforming' stamp: 'ar 11/24/1998 14:45'!
colorTransformBy: aColorTransform
	aColorTransform ifNil:[^self].
	colorTransform 
		ifNil:[colorTransform := aColorTransform]
		ifNotNil:[colorTransform := colorTransform composedWithLocal: aColorTransform]! !

!BalloonCanvas methodsFor: 'accessing' stamp: 'ar 12/30/1998 10:55'!
deferred: aBoolean
	deferred == aBoolean ifTrue:[^self].
	self flush. "Force pending prims on screen"
	deferred := aBoolean.
	engine ifNotNil:[engine deferred: aBoolean].! !

!BalloonCanvas methodsFor: 'accessing' stamp: 'ar 2/13/2001 21:07'!
ensuredEngine
	engine ifNil:[
		engine := BalloonEngine new.
		"engine := BalloonDebugEngine new"
		engine aaLevel: aaLevel.
		engine bitBlt: port.
		engine destOffset: origin.
		engine clipRect: clipRect.
		engine deferred: deferred.
		engine].
	engine colorTransform: colorTransform.
	engine edgeTransform: transform.
	^engine! !

!BalloonCanvas methodsFor: 'transforming' stamp: 'ar 12/30/1998 10:47'!
preserveStateDuring: aBlock
	| state result |
	state := BalloonState new.
	state transform: transform.
	state colorTransform: colorTransform.
	state aaLevel: self aaLevel.
	result := aBlock value: self.
	transform := state transform.
	colorTransform := state colorTransform.
	self aaLevel: state aaLevel.
	^result! !

!BalloonCanvas methodsFor: 'testing' stamp: 'ar 11/13/1998 13:19'!
isBalloonCanvas
	^true! !

!BalloonCanvas methodsFor: 'private' stamp: 'marcus.denker 9/14/2008 21:01'!
ifNoTransformWithIn: box
	"Return true if the current transformation does not affect the given bounding box"
	| delta |
	transform ifNil: [^true].
	delta := (transform localPointToGlobal: box origin) - box origin.
	^(transform localPointToGlobal: box corner) - box corner = delta! !

!BalloonCanvas methodsFor: 'balloon drawing' stamp: 'DSM 10/15/1999 15:18'!
drawGeneralBezier3Shape: contours color: c borderWidth: borderWidth
borderColor: borderColor
	| b2 |
	b2 := contours collect: [:b3 | Bezier3Segment
convertBezier3ToBezier2: b3 ].
	self drawGeneralBezierShape: b2 color: c borderWidth: borderWidth
borderColor: borderColor! !

!BalloonCanvas methodsFor: 'drawing' stamp: 'ar 2/9/1999 05:40'!
fillColor: c
	"Note: This always fills, even if the color is transparent."
	"Note2: To achieve the above we must make sure that c is NOT transparent"
	self frameAndFillRectangle: form boundingBox 
		fillColor: (c alpha: 1.0)
		borderWidth: 0
		borderColor: nil! !

!BalloonCanvas methodsFor: 'transforming' stamp: 'ar 11/12/1998 00:32'!
transformBy: aTransform
	aTransform ifNil:[^self].
	transform 
		ifNil:[transform := aTransform]
		ifNotNil:[transform := transform composedWithLocal: aTransform]! !

!BalloonCanvas methodsFor: 'transforming' stamp: 'ar 5/29/1999 08:59'!
transformBy: aDisplayTransform during: aBlock
	| myTransform result |
	myTransform := transform.
	self transformBy: aDisplayTransform.
	result := aBlock value: self.
	transform := myTransform.
	^result! !

!BalloonCanvas methodsFor: 'testing' stamp: 'ar 11/12/1998 01:07'!
isVisible: aRectangle
	^transform 
		ifNil:[super isVisible: aRectangle]
		ifNotNil:[super isVisible: (transform localBoundsToGlobal: aRectangle)]! !

!BalloonCanvas methodsFor: 'drawing-ovals' stamp: 'StephaneDucasse 2/9/2011 14:26'!
fillOval: aRectangle fillStyle: aFillStyle borderWidth: bw borderColor: bc
	"Fill the given rectangle."
	^self drawOval: (aRectangle insetBy: bw // 2)
			color: aFillStyle 
			borderWidth: bw
			borderColor: bc
! !

!BalloonCanvas methodsFor: 'drawing-polygons' stamp: 'ar 8/26/2001 22:14'!
drawPolygon: vertices fillStyle: aFillStyle
	"Fill the given polygon."
	self drawPolygon: vertices fillStyle: aFillStyle borderWidth: 0 borderColor: nil! !

!BalloonCanvas methodsFor: 'drawing' stamp: 'ar 2/9/1999 05:52'!
frameAndFillRectangle: r fillColor: fillColor borderWidth: borderWidth topLeftColor: topLeftColor bottomRightColor: bottomRightColor
	"Draw a beveled or raised rectangle"
	| bw |

	"Note: The optimization test below should actually read:
		self ifNoTransformWithIn: (r insetBy: borderWidth // 2)
	but since borderWidth is assumed to be very small related to r we don't check it."

	(self ifNoTransformWithIn: r)
		ifTrue:[^super frameAndFillRectangle: r fillColor: fillColor borderWidth: borderWidth topLeftColor: topLeftColor bottomRightColor: bottomRightColor].

	"Fill rectangle and draw top and left border"
	bw := borderWidth // 2.
	self drawRectangle: (r insetBy: bw)
		color: fillColor
		borderWidth: borderWidth
		borderColor: topLeftColor.
	"Now draw bottom right border."
	self drawPolygon: (Array with: r topRight + (bw negated@bw) 
							with: r bottomRight - bw asPoint
							with: r bottomLeft + (bw@bw negated))
		color: nil
		borderWidth: borderWidth
		borderColor: bottomRightColor.! !

!BalloonCanvas methodsFor: 'converting' stamp: 'ar 11/11/1998 22:57'!
asBalloonCanvas
	^self! !

!BalloonCanvas methodsFor: 'todo' stamp: 'ar 2/9/1999 05:46'!
paragraph: para bounds: bounds color: c
	(self ifNoTransformWithIn: bounds)
		ifTrue:[^super paragraph: para bounds: bounds color: c].! !

!BalloonCanvas methodsFor: 'copying' stamp: 'nice 1/13/2010 21:22'!
postCopy
	self flush.
	super postCopy.
	self resetEngine! !

!BalloonCanvas methodsFor: 'drawing' stamp: 'ar 2/9/1999 06:26'!
frameAndFillRectangle: r fillColor: c borderWidth: borderWidth borderColor: borderColor
	"Draw a filled and outlined rectangle"
	"Note: The optimization test below should actually read:
		self ifNoTransformWithIn: (r insetBy: borderWidth // 2)
	but since borderWidth is assumed to be very small related to r we don't check it."

	(self ifNoTransformWithIn: r)
		ifTrue:[^super frameAndFillRectangle: r fillColor: c borderWidth: borderWidth borderColor: borderColor].

	^self drawRectangle: (r insetBy: borderWidth // 2) 
			color: c 
			borderWidth: borderWidth 
			borderColor: borderColor! !

!BalloonCanvas methodsFor: 'initialize' stamp: 'ar 11/24/1998 15:28'!
flush
	"Force all pending primitives onscreen"
	engine ifNotNil:[engine flush].! !

!BalloonCanvas methodsFor: 'balloon drawing' stamp: 'IgorStasenko 7/18/2011 18:06'!
drawGeneralBezierShape: contours color: c borderWidth: borderWidth borderColor: borderColor
	"Draw a general boundary shape (e.g., possibly containing holes)"

	self ensuredEngine
		drawGeneralBezierShape: contours
		fill: c
		borderWidth: borderWidth
		borderColor: borderColor
		transform: transform.! !

!BalloonCanvas methodsFor: 'balloon drawing' stamp: 'IgorStasenko 7/18/2011 18:06'!
drawBezierShape: vertices color: c borderWidth: borderWidth borderColor: borderColor
	"Draw a boundary shape that is defined by a list of vertices.
	Each three subsequent vertices define a quadratic bezier segment.
	For lines, the control point should be set to either the start or the end
	of the bezier curve."

	self ensuredEngine
		drawBezierShape: vertices
		fill: c
		borderWidth: borderWidth
		borderColor: borderColor
		transform: transform.! !

!BalloonCanvas methodsFor: 'initialize' stamp: 'ar 11/11/1998 20:25'!
resetEngine
	engine := nil.! !

!BalloonCanvas methodsFor: 'drawing-polygons' stamp: 'IgorStasenko 7/18/2011 18:07'!
drawPolygon: vertices fillStyle: aFillStyle borderWidth: borderWidth borderColor: borderColor
	"Draw a simple polygon defined by the list of vertices."

	self ensuredEngine
		drawPolygon: (vertices copyWith: vertices first)
		fill: aFillStyle
		borderWidth: borderWidth
		borderColor: borderColor
		transform: transform.! !

!BalloonEdgeData commentStamp: '<historical>'!
BalloonEdgeData defines an entry in the internal edge table of the Balloon engine.

Instance Variables:
	index	<Integer>	The index into the external objects array of the associated graphics engine
	xValue	<Integer>	The computed x-value of the requested operation
	yValue	<Integer>	The y-value for the requested operation
	height	<Integer>	The (remaining) height of the edge
	source	<Object>		The object from the external objects array!
!BalloonEdgeData methodsFor: 'computing' stamp: 'ar 10/27/1998 15:53'!
stepToNextScanLine
	source stepToNextScanLineAt: yValue in: self! !

!BalloonEdgeData methodsFor: 'accessing' stamp: 'ar 10/27/1998 15:34'!
yValue
	^yValue! !

!BalloonEdgeData methodsFor: 'accessing' stamp: 'ar 10/27/1998 15:34'!
xValue
	^xValue! !

!BalloonEdgeData methodsFor: 'accessing' stamp: 'ar 10/27/1998 20:13'!
lines
	^lines! !

!BalloonEdgeData methodsFor: 'accessing' stamp: 'ar 10/27/1998 15:35'!
xValue: anInteger
	xValue := anInteger! !

!BalloonEdgeData methodsFor: 'accessing' stamp: 'ar 10/27/1998 20:13'!
lines: anInteger
	^lines := anInteger! !

!BalloonEdgeData methodsFor: 'accessing' stamp: 'ar 10/27/1998 19:56'!
zValue: anInteger
	zValue := anInteger! !

!BalloonEdgeData methodsFor: 'accessing' stamp: 'ar 10/27/1998 15:35'!
yValue: anInteger
	yValue := anInteger! !

!BalloonEdgeData methodsFor: 'accessing' stamp: 'ar 10/27/1998 15:34'!
source
	^source! !

!BalloonEdgeData methodsFor: 'accessing' stamp: 'ar 10/27/1998 15:35'!
index: anInteger
	index := anInteger! !

!BalloonEdgeData methodsFor: 'computing' stamp: 'ar 10/27/1998 15:53'!
stepToFirstScanLine
	source stepToFirstScanLineAt: yValue in: self! !

!BalloonEdgeData methodsFor: 'accessing' stamp: 'ar 10/27/1998 19:56'!
zValue
	^zValue! !

!BalloonEdgeData methodsFor: 'accessing' stamp: 'ar 10/27/1998 21:39'!
source: anObject
	source := anObject! !

!BalloonEdgeData methodsFor: 'accessing' stamp: 'ar 10/27/1998 15:34'!
index
	^index! !

!BalloonEngine commentStamp: '<historical>'!
BalloonEngine is the representative for the Balloon engine inside Squeak. For most purposes it should not be used directly but via BalloonCanvas since this ensures proper initialization and is polymorphic with other canvas uses.!
!BalloonEngine methodsFor: 'primitives-incremental' stamp: 'ar 2/2/2001 15:48'!
primDisplaySpanBuffer
	"Display the current scan line if necessary"
	<primitive: 'primitiveDisplaySpanBuffer' module: 'B2DPlugin'>
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'copying' stamp: 'ar 3/6/2001 12:06'!
copyBits
	(bitBlt notNil and:[bitBlt destForm notNil]) ifTrue:[bitBlt destForm unhibernate].
	self copyLoopFaster.! !

!BalloonEngine methodsFor: 'copying' stamp: 'ar 11/14/1998 19:32'!
copyLoop
	"This is the basic rendering loop using as little primitive support as possible."
	| finished edge fill |
	edge := BalloonEdgeData new.
	fill := BalloonFillData new.
	self primInitializeProcessing. "Initialize the GE for processing"
	[self primFinishedProcessing] whileFalse:[
		"Step 1: Process the edges in the global edge table that will be added in this step"
		[finished := self primNextGlobalEdgeEntryInto: edge.
		finished] whileFalse:[
			edge source: (externals at: edge index).
			edge stepToFirstScanLine.
			self primAddActiveEdgeTableEntryFrom: edge].

		"Step 2: Scan the active edge table"
		[finished := self primNextFillEntryInto: fill.
		finished] whileFalse:[
			fill source: (externals at: fill index).
			"Compute the new fill"
			fill computeFill.
			"And mix it in the out buffer"
			self primMergeFill: fill destForm bits from: fill].

		"Step 3: Display the current span buffer if necessary"
		self primDisplaySpanBuffer.

		"Step 4: Advance and resort the active edge table"
		[finished := self primNextActiveEdgeEntryInto: edge.
		finished] whileFalse:[
			"If the index is zero then the edge has been handled by the GE"
			edge source: (externals at: edge index).
			edge stepToNextScanLine.
			self primChangeActiveEdgeTableEntryFrom: edge].
	].
	self primGetTimes: Times.
	self primGetCounts: Counts.
	self primGetBezierStats: BezierStats.! !

!BalloonEngine methodsFor: 'primitives-access' stamp: 'ar 2/2/2001 15:49'!
primGetAALevel
	"Set the AA level"
	<primitive: 'primitiveGetAALevel' module: 'B2DPlugin'>
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'drawing' stamp: 'ar 11/26/1998 19:45'!
drawRectangle: rect fill: fillStyle borderWidth: borderWidth borderColor: borderColor transform: aMatrix

	| fills |
	self edgeTransform: aMatrix.
	self resetIfNeeded.
	fills := self registerFill: fillStyle and: borderColor.
	self primAddRectFrom: rect origin 
			to: rect corner
			fillIndex: (fills at: 1)
			borderWidth: borderWidth
			borderColor: (fills at: 2).
	self postFlushIfNeeded.! !

!BalloonEngine methodsFor: 'primitives-access' stamp: 'ar 2/2/2001 15:49'!
primSetClipRect: rect
	<primitive: 'primitiveSetClipRect' module: 'B2DPlugin'>
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'drawing' stamp: 'bf 4/3/2004 01:36'!
registerFill: aFillStyle
	"Register the given fill style."
	| theForm |
	aFillStyle ifNil:[^0].
	aFillStyle isSolidFill 
		ifTrue:[^aFillStyle scaledPixelValue32].

	aFillStyle isGradientFill ifTrue:[
		^self primAddGradientFill: aFillStyle pixelRamp
			from: aFillStyle origin
			along: aFillStyle direction
			normal: aFillStyle normal
			radial: aFillStyle isRadialFill
		].
	aFillStyle isBitmapFill ifTrue:[
		theForm := aFillStyle form asSourceForm.
		theForm unhibernate.
		forms := forms copyWith: theForm.
		^self primAddBitmapFill: theForm
				colormap: (theForm colormapIfNeededForDepth: 32)
				tile: aFillStyle isTiled
				from: aFillStyle origin
				along: aFillStyle direction
				normal: aFillStyle normal
				xIndex: forms size].
	^0! !

!BalloonEngine methodsFor: 'primitives-access' stamp: 'ar 2/2/2001 15:49'!
primGetTimes: statsArray
	<primitive: 'primitiveGetTimes' module: 'B2DPlugin'>
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'primitives-adding' stamp: 'ar 2/2/2001 15:47'!
primAddBezierShape: points segments: nSegments fill: fillStyle lineWidth: lineWidth lineFill: lineFill
	<primitive: 'primitiveAddBezierShape' module: 'B2DPlugin'>
	(self canProceedAfter: self primGetFailureReason) ifTrue:[
		^self primAddBezierShape: points segments: nSegments fill: fillStyle lineWidth: lineWidth lineFill: lineFill
	].
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'primitives-adding' stamp: 'ar 2/2/2001 15:47'!
primAddRectFrom: start to: end fillIndex: fillIndex borderWidth: width borderColor: pixelValue32
	<primitive: 'primitiveAddRect' module: 'B2DPlugin'>
	(self canProceedAfter: self primGetFailureReason) ifTrue:[
		^self primAddRectFrom: start to: end fillIndex: fillIndex borderWidth: width borderColor: pixelValue32
	].
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'primitives-access' stamp: 'ar 2/2/2001 15:49'!
primGetBezierStats: statsArray
	<primitive: 'primitiveGetBezierStats' module: 'B2DPlugin'>
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'primitives-access' stamp: 'ar 2/2/2001 15:47'!
primSetEdgeTransform: transform
	<primitive: 'primitiveSetEdgeTransform' module: 'B2DPlugin'>
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'initialization' stamp: 'stephane.ducasse 6/14/2009 22:37'!
initialize
	| w |
	super initialize.
	w := Display width > 2048 ifTrue: [ 4096 ] ifFalse: [ 2048 ].
	externals := OrderedCollection new: 100.
	span := Bitmap new: w.
	bitBlt := nil.
	self bitBlt: ((BitBlt toForm: Display) destRect: Display boundingBox; yourself).
	forms := #().
	deferred := false.! !

!BalloonEngine methodsFor: 'primitives-incremental' stamp: 'ar 2/2/2001 15:49'!
primInitializeProcessing
	"Initialize processing in the GE.
	Create the active edge table and sort it."
	<primitive: 'primitiveInitializeProcessing' module: 'B2DPlugin'>
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'accessing' stamp: 'ClementBera 7/26/2013 16:03'!
bitBlt: aBitBlt
	bitBlt := aBitBlt.
	bitBlt ifNil: [^self].
	self class primitiveSetBitBltPlugin: bitBlt getPluginName.
	self clipRect: bitBlt clipRect.
	bitBlt 
		sourceForm: (Form extent: span size @ 1 depth: 32 bits: span);
		sourceRect: (0@0 extent: 1@span size);
		colorMap: (Color colorMapIfNeededFrom: 32 to: bitBlt destForm depth);
		combinationRule: (bitBlt destForm depth >= 8 ifTrue:[34] ifFalse:[Form paint]).! !

!BalloonEngine methodsFor: 'accessing' stamp: 'ar 11/11/1998 23:04'!
aaLevel
	^aaLevel ifNil:[1]! !

!BalloonEngine methodsFor: 'primitives-access' stamp: 'ar 2/2/2001 15:49'!
primGetCounts: statsArray
	<primitive: 'primitiveGetCounts' module: 'B2DPlugin'>
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'accessing' stamp: 'ar 11/1/1998 02:57'!
clipRect
	^clipRect! !

!BalloonEngine methodsFor: 'accessing' stamp: 'ar 11/24/1998 15:04'!
colorTransform
	^colorTransform! !

!BalloonEngine methodsFor: 'initialize' stamp: 'ar 11/25/1998 22:43'!
preFlushIfNeeded
	"Force all pending primitives onscreen"
	workBuffer ifNil:[^self].
	self primFlushNeeded ifTrue:[
		self copyBits.
		self reset].! !

!BalloonEngine methodsFor: 'primitives-incremental' stamp: 'ar 2/2/2001 15:49'!
primNextActiveEdgeEntryInto: edgeEntry
	"Store the next entry of the AET at the current y-value in edgeEntry.
	Return false if there is no entry, true otherwise."
	<primitive: 'primitiveNextActiveEdgeEntry' module: 'B2DPlugin'>
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'primitives-adding' stamp: 'ar 2/2/2001 15:47'!
primAddGradientFill: colorRamp from: origin along: direction normal: normal radial: isRadial
	<primitive: 'primitiveAddGradientFill' module: 'B2DPlugin'>
	(self canProceedAfter: self primGetFailureReason) ifTrue:[
		^self primAddGradientFill: colorRamp 
				from: origin 
				along: direction 
				normal: normal 
				radial: isRadial
	].
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'primitives-adding' stamp: 'ar 2/2/2001 15:47'!
primAddExternalFill: index
	<primitive: 'primitiveRegisterExternalFill' module: 'B2DPlugin'>
	(self canProceedAfter: self primGetFailureReason) ifTrue:[
		^self primAddExternalFill: index
	].
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'primitives-access' stamp: 'ar 2/2/2001 15:47'!
primFlushNeeded: aBoolean
	<primitive: 'primitiveNeedsFlushPut' module: 'B2DPlugin'>
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'initialize' stamp: 'ar 11/11/1998 22:52'!
release
	self class recycleBuffer: workBuffer.
	workBuffer := nil.! !

!BalloonEngine methodsFor: 'accessing' stamp: 'ar 11/25/1998 22:34'!
edgeTransform: aTransform
	edgeTransform := aTransform.! !

!BalloonEngine methodsFor: 'primitives-access' stamp: 'ar 2/2/2001 15:47'!
primFlushNeeded
	<primitive: 'primitiveNeedsFlush' module: 'B2DPlugin'>
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'primitives-access' stamp: 'ar 2/2/2001 15:47'!
primSetDepth: depth
	<primitive: 'primitiveSetDepth' module: 'B2DPlugin'>
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'initialize' stamp: 'ar 11/25/1998 22:42'!
postFlushIfNeeded
	"Force all pending primitives onscreen"
	workBuffer ifNil:[^self].
	(deferred not or:[postFlushNeeded]) ifTrue:[
		self copyBits.
		self release].! !

!BalloonEngine methodsFor: 'primitives-incremental' stamp: 'ar 2/2/2001 15:49'!
primNextFillEntryInto: fillEntry
	"Store the next fill entry of the active edge table in fillEntry.
	Return false if there is no such entry, true otherwise"
	<primitive: 'primitiveNextFillEntry' module: 'B2DPlugin'>
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'initialize' stamp: 'ar 11/25/1998 22:34'!
reset
	workBuffer ifNil:[workBuffer := self class allocateOrRecycleBuffer: 10000].
	self primInitializeBuffer: workBuffer.
	self primSetAALevel: self aaLevel.
	self primSetOffset: destOffset.
	self primSetClipRect: clipRect.
	self primSetEdgeTransform: edgeTransform.
	self primSetColorTransform: colorTransform.
	forms := #().! !

!BalloonEngine methodsFor: 'copying' stamp: 'ar 11/25/1998 00:45'!
canProceedAfter: failureReason
	"Check if we can proceed after the failureReason indicated."
	| newBuffer |
	failureReason = GErrorNeedFlush ifTrue:[
		"Need to flush engine before proceeding"
		self copyBits.
		self reset.
		^true].
	failureReason = GErrorNoMoreSpace ifTrue:[
		"Work buffer is too small"
		newBuffer := workBuffer species new: workBuffer size * 2.
		self primCopyBufferFrom: workBuffer to: newBuffer.
		workBuffer := newBuffer.
		^true].
	"Not handled"
	^false! !

!BalloonEngine methodsFor: 'copying' stamp: 'ar 11/14/1998 19:32'!
copyLoopFaster
	"This is a copy loop drawing one scan line at a time"
	| edge fill reason |
	edge := BalloonEdgeData new.
	fill := BalloonFillData new.
	[self primFinishedProcessing] whileFalse:[
		reason := self primRenderScanline: edge with: fill.
		"reason ~= 0 means there has been a problem"
		reason = 0 ifFalse:[
			self processStopReason: reason edge: edge fill: fill.
		].
	].
	self primGetTimes: Times.
	self primGetCounts: Counts.
	self primGetBezierStats: BezierStats.! !

!BalloonEngine methodsFor: 'accessing' stamp: 'ar 11/12/1998 00:22'!
destOffset: aPoint
	destOffset := aPoint asIntegerPoint.
	bitBlt destX: aPoint x; destY: aPoint y.! !

!BalloonEngine methodsFor: 'primitives-misc' stamp: 'ar 2/2/2001 15:49'!
primInitializeBuffer: buffer
	<primitive: 'primitiveInitializeBuffer' module: 'B2DPlugin'>
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'primitives-adding' stamp: 'ar 2/2/2001 15:47'!
primAddCompressedShape: points segments: nSegments leftFills: leftFills rightFills: rightFills lineWidths: lineWidths lineFills: lineFills fillIndexList: fillIndexList
	<primitive: 'primitiveAddCompressedShape' module: 'B2DPlugin'>
	(self canProceedAfter: self primGetFailureReason) ifTrue:[
		^self primAddCompressedShape: points segments: nSegments leftFills: leftFills rightFills: rightFills lineWidths: lineWidths lineFills: lineFills fillIndexList: fillIndexList
	].
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'initialize' stamp: 'ar 11/25/1998 22:39'!
resetIfNeeded
	workBuffer ifNil:[self reset].
	self primSetEdgeTransform: edgeTransform.
	self primSetColorTransform: colorTransform.
	self primSetDepth: self primGetDepth + 1.
	postFlushNeeded := false.! !

!BalloonEngine methodsFor: 'primitives-access' stamp: 'ar 2/2/2001 15:49'!
primGetOffset
	<primitive: 'primitiveGetOffset' module: 'B2DPlugin'>
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'primitives-access' stamp: 'ar 2/2/2001 15:47'!
primSetColorTransform: transform
	<primitive: 'primitiveSetColorTransform' module: 'B2DPlugin'>
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'drawing' stamp: 'ar 11/26/1998 19:44'!
drawCompressedShape: shape transform: aTransform
	| fillIndexList |
	self edgeTransform: aTransform.
	self resetIfNeeded.

	fillIndexList := self registerFills: shape fillStyles.

	self primAddCompressedShape: shape points
		segments: shape numSegments
		leftFills: shape leftFills
		rightFills: shape rightFills
		lineWidths: shape lineWidths
		lineFills: shape lineFills
		fillIndexList: fillIndexList.
	self postFlushIfNeeded.! !

!BalloonEngine methodsFor: 'primitives-adding' stamp: 'ar 2/2/2001 15:47'!
primAddPolygon: points segments: nSegments fill: fillStyle lineWidth: lineWidth lineFill: lineFill
	<primitive: 'primitiveAddPolygon' module: 'B2DPlugin'>
	(self canProceedAfter: self primGetFailureReason) ifTrue:[
		^self primAddPolygon: points segments: nSegments fill: fillStyle lineWidth: lineWidth lineFill: lineFill
	].
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'drawing' stamp: 'di 11/21/1999 20:15'!
registerFills: fills

	| fillIndexList index fillIndex |
	((colorTransform notNil and:[colorTransform isAlphaTransform]) or:[
		fills anySatisfy: [:any| any notNil and:[any isTranslucent]]])
			ifTrue:[	self flush.
					self reset.
					postFlushNeeded := true].
	fillIndexList := WordArray new: fills size.
	index := 1.
	[index <= fills size] whileTrue:[
		fillIndex := self registerFill: (fills at: index).
		fillIndex == nil 
			ifTrue:[index := 1] "Need to start over"
			ifFalse:[fillIndexList at: index put: fillIndex.
					index := index+1]
	].
	^fillIndexList! !

!BalloonEngine methodsFor: 'primitives-access' stamp: 'ar 2/2/2001 15:48'!
primClipRectInto: rect
	<primitive: 'primitiveGetClipRect' module: 'B2DPlugin'>
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'primitives-incremental' stamp: 'ar 2/2/2001 15:49'!
primFinishedProcessing
	"Return true if there are no more entries in AET and GET and the last scan line has been displayed"
	<primitive: 'primitiveFinishedProcessing' module: 'B2DPlugin'>
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'accessing' stamp: 'ar 10/13/1998 02:44'!
clipRect: aRect
	clipRect := aRect truncated! !

!BalloonEngine methodsFor: 'primitives-access' stamp: 'ar 2/2/2001 15:49'!
primGetFailureReason
	<primitive: 'primitiveGetFailureReason' module: 'B2DPlugin'>
	^0! !

!BalloonEngine methodsFor: 'primitives-incremental' stamp: 'ar 2/2/2001 15:48'!
primChangeActiveEdgeTableEntryFrom: edgeEntry
	"Change the entry in the active edge table from edgeEntry"
	<primitive: 'primitiveChangedActiveEdgeEntry' module: 'B2DPlugin'>
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'primitives-incremental' stamp: 'ar 2/2/2001 15:49'!
primRenderImage: edge with: fill
	"Start/Proceed rendering the current scan line"
	<primitive: 'primitiveRenderImage' module: 'B2DPlugin'>
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'primitives-access' stamp: 'ar 2/2/2001 15:47'!
primGetDepth
	<primitive: 'primitiveGetDepth' module: 'B2DPlugin'>
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'primitives-adding' stamp: 'ar 2/2/2001 15:47'!
primAddBezierFrom: start to: end via: via leftFillIndex: leftFillIndex rightFillIndex: rightFillIndex
	<primitive: 'primitiveAddBezier' module: 'B2DPlugin'>
	(self canProceedAfter: self primGetFailureReason) ifTrue:[
		^self primAddBezierFrom: start to: end via: via leftFillIndex: leftFillIndex rightFillIndex: rightFillIndex
	].
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'accessing' stamp: 'ar 12/30/1998 11:24'!
deferred
	^deferred! !

!BalloonEngine methodsFor: 'primitives-adding' stamp: 'ar 2/2/2001 15:47'!
primAddBitmapFill: form colormap: cmap tile: tileFlag from: origin along: direction normal: normal xIndex: xIndex
	<primitive: 'primitiveAddBitmapFill' module: 'B2DPlugin'>
	(self canProceedAfter: self primGetFailureReason) ifTrue:[
		^self primAddBitmapFill: form colormap: cmap tile: tileFlag from: origin along: direction normal: normal xIndex: xIndex
	].
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'primitives-adding' stamp: 'ar 2/2/2001 15:47'!
primAddOvalFrom: start to: end fillIndex: fillIndex borderWidth: width borderColor: pixelValue32
	<primitive: 'primitiveAddOval' module: 'B2DPlugin'>
	(self canProceedAfter: self primGetFailureReason) ifTrue:[
		^self primAddOvalFrom: start to: end fillIndex: fillIndex borderWidth: width borderColor: pixelValue32
	].
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'accessing' stamp: 'ar 10/13/1998 03:04'!
bitBlt
	^bitBlt! !

!BalloonEngine methodsFor: 'primitives-misc' stamp: 'ar 2/2/2001 15:48'!
primCopyBufferFrom: oldBuffer to: newBuffer
	"Copy the contents of oldBuffer into the (larger) newBuffer"
	<primitive: 'primitiveCopyBuffer' module: 'B2DPlugin'>
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'copying' stamp: 'ar 11/14/1998 19:33'!
copyLoopFastest
	"This is a copy loop drawing the entire image"
	| edge fill reason |
	edge := BalloonEdgeData new.
	fill := BalloonFillData new.
	[self primFinishedProcessing] whileFalse:[
		reason := self primRenderImage: edge with: fill.
		"reason ~= 0 means there has been a problem"
		reason = 0 ifFalse:[
			self processStopReason: reason edge: edge fill: fill.
		].
	].
	self primGetTimes: Times.
	self primGetCounts: Counts.
	self primGetBezierStats: BezierStats.! !

!BalloonEngine methodsFor: 'drawing' stamp: 'ar 11/26/1998 19:45'!
registerFill: fill1 and: fill2
	^self registerFills: (Array with: fill1 with: fill2)! !

!BalloonEngine methodsFor: 'accessing' stamp: 'ar 11/11/1998 23:04'!
aaLevel: anInteger
	aaLevel := (anInteger min: 4) max: 1.! !

!BalloonEngine methodsFor: 'accessing' stamp: 'ar 12/30/1998 11:24'!
deferred: aBoolean
	deferred := aBoolean.! !

!BalloonEngine methodsFor: 'primitives-access' stamp: 'ar 2/2/2001 15:49'!
primSetAALevel: level
	"Set the AA level"
	<primitive: 'primitiveSetAALevel' module: 'B2DPlugin'>
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'primitives-adding' stamp: 'ar 2/2/2001 15:47'!
primAddLineFrom: start to: end leftFillIndex: leftFillIndex rightFillIndex: rightFillIndex
	<primitive: 'primitiveAddLine' module: 'B2DPlugin'>
	(self canProceedAfter: self primGetFailureReason) ifTrue:[
		^self primAddLineFrom: start to: end leftFillIndex: leftFillIndex rightFillIndex: rightFillIndex
	].
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'primitives-access' stamp: 'ar 2/2/2001 15:49'!
primSetOffset: point
	<primitive: 'primitiveSetOffset' module: 'B2DPlugin'>
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'drawing' stamp: 'ar 11/26/1998 19:45'!
drawPolygon: points fill: fillStyle borderWidth: borderWidth borderColor: borderFill transform: aTransform

	| fills |
	self edgeTransform: aTransform.
	self resetIfNeeded.
	fills := self registerFill: fillStyle and: borderFill.
	self primAddPolygon: points
		segments: points size
		fill: (fills at: 1)
		lineWidth: borderWidth
		lineFill: (fills at: 2).
	self postFlushIfNeeded.! !

!BalloonEngine methodsFor: 'primitives-incremental' stamp: 'ar 2/2/2001 15:49'!
primRenderScanline: edge with: fill
	"Start/Proceed rendering the current scan line"
	<primitive: 'primitiveRenderScanline' module: 'B2DPlugin'>
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'drawing' stamp: 'ar 10/11/1999 16:49'!
drawBezierShape: points fill: fillStyle borderWidth: borderWidth borderColor: borderFill transform: aTransform
	| fills |
	self edgeTransform: aTransform.
	self resetIfNeeded.
	fills := self registerFill: fillStyle and: borderFill.
	self primAddBezierShape: points
		segments: (points size) // 3
		fill: (fills at: 1)
		lineWidth: borderWidth
		lineFill: (fills at: 2).
	self postFlushIfNeeded.! !

!BalloonEngine methodsFor: 'drawing' stamp: 'ar 11/26/1998 19:45'!
drawOval: rect fill: fillStyle borderWidth: borderWidth borderColor: borderColor transform: aMatrix

	| fills |
	self edgeTransform: aMatrix.
	self resetIfNeeded.
	fills := self registerFill: fillStyle and: borderColor.
	self primAddOvalFrom: rect origin 
			to: rect corner
			fillIndex: (fills at: 1)
			borderWidth: borderWidth
			borderColor: (fills at: 2).
	self postFlushIfNeeded.! !

!BalloonEngine methodsFor: 'accessing' stamp: 'ar 11/1/1998 02:56'!
destOffset
	^destOffset! !

!BalloonEngine methodsFor: 'primitives-adding' stamp: 'ar 2/2/2001 15:47'!
primAddExternalEdge: index initialX: initialX initialY: initialY initialZ: initialZ leftFillIndex: leftFillIndex rightFillIndex: rightFillIndex
	<primitive: 'primitiveRegisterExternalEdge' module: 'B2DPlugin'>
	(self canProceedAfter: self primGetFailureReason) ifTrue:[
		^self primAddExternalEdge: index initialX: initialX initialY: initialY initialZ: initialZ leftFillIndex: leftFillIndex rightFillIndex: rightFillIndex
	].
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'primitives-incremental' stamp: 'ar 2/2/2001 15:49'!
primMergeFill: fillBitmap from: fill
	"Merge the filled bitmap into the current output buffer."
	<primitive: 'primitiveMergeFillFrom' module: 'B2DPlugin'>
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'accessing' stamp: 'ar 11/24/1998 15:04'!
colorTransform: aColorTransform
	colorTransform := aColorTransform! !

!BalloonEngine methodsFor: 'drawing' stamp: 'ar 1/15/1999 03:02'!
drawGeneralBezierShape: contours fill: fillStyle borderWidth: borderWidth borderColor: borderFill transform: aTransform

	| fills |
	self edgeTransform: aTransform.
	self resetIfNeeded.
	fills := self registerFill: fillStyle and: borderFill.
	contours do:[:points|
		self primAddBezierShape: points
			segments: (points size // 3)
			fill: (fills at: 1)
			lineWidth: borderWidth
			lineFill: (fills at: 2).
		"Note: To avoid premature flushing of the pipeline we need to
		reset the flush bit within the engine."
		self primFlushNeeded: false.
	].
	"And set the flush bit afterwards"
	self primFlushNeeded: true.
	self postFlushIfNeeded.! !

!BalloonEngine methodsFor: 'accessing' stamp: 'ar 11/25/1998 22:34'!
edgeTransform
	^edgeTransform! !

!BalloonEngine methodsFor: 'copying' stamp: 'ar 11/11/1998 21:19'!
processStopReason: reason edge: edge fill: fill
	"The engine has stopped because of some reason.
	Try to figure out how to respond and do the necessary actions."
	"Note: The order of operations below can affect the speed"

	"Process unknown fills first"
	reason = GErrorFillEntry ifTrue:[
		fill source: (externals at: fill index).
		"Compute the new fill"
		fill computeFill.
		"And mix it in the out buffer"
		^self primMergeFill: fill destForm bits from: fill].

	"Process unknown steppings in the AET second"
	reason = GErrorAETEntry ifTrue:[
		edge source: (externals at: edge index).
		edge stepToNextScanLine.
		^self primChangeActiveEdgeTableEntryFrom: edge].

	"Process unknown entries in the GET third"
	reason = GErrorGETEntry ifTrue:[
		edge source: (externals at: edge index).
		edge stepToFirstScanLine.
		^self primAddActiveEdgeTableEntryFrom: edge].

	"Process generic problems last"
	(self canProceedAfter: reason) ifTrue:[^self]. "Okay."

	^self error:'Unkown stop reason in graphics engine'
! !

!BalloonEngine methodsFor: 'primitives-access' stamp: 'ar 2/2/2001 15:49'!
primGetClipRect: rect
	<primitive: 'primitiveGetClipRect' module: 'B2DPlugin'>
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'drawing' stamp: 'ar 1/15/1999 03:02'!
drawGeneralPolygon: contours fill: fillStyle borderWidth: borderWidth borderColor: borderFill transform: aTransform

	| fills |
	self edgeTransform: aTransform.
	self resetIfNeeded.
	fills := self registerFill: fillStyle and: borderFill.
	contours do:[:points|
		self primAddPolygon: points
			segments: points size
			fill: (fills at: 1)
			lineWidth: borderWidth
			lineFill: (fills at: 2).
		"Note: To avoid premature flushing of the pipeline we need to
		reset the flush bit within the engine."
		self primFlushNeeded: false.
	].
	"And set the flush bit afterwards"
	self primFlushNeeded: true.
	self postFlushIfNeeded.! !

!BalloonEngine methodsFor: 'primitives-incremental' stamp: 'ar 2/2/2001 15:48'!
primAddActiveEdgeTableEntryFrom: edgeEntry
	"Add edge entry to the AET."
	<primitive: 'primitiveAddActiveEdgeEntry' module: 'B2DPlugin'>
	(self canProceedAfter: self primGetFailureReason) ifTrue:[
		^self primAddActiveEdgeTableEntryFrom: edgeEntry
	].
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'initialize' stamp: 'ar 11/25/1998 22:29'!
flush
	"Force all pending primitives onscreen"
	workBuffer ifNil:[^self].
	self copyBits.
	self release.! !

!BalloonEngine methodsFor: 'primitives-incremental' stamp: 'ar 2/2/2001 15:49'!
primNextGlobalEdgeEntryInto: edgeEntry
	"Store the next entry of the GET at the current y-value in edgeEntry.
	Return false if there is no entry, true otherwise."
	<primitive: 'primitiveNextGlobalEdgeEntry' module: 'B2DPlugin'>
	^self primitiveFailed! !

!BalloonEngine methodsFor: 'accessing' stamp: 'ar 10/29/1998 01:51'!
fullTransformFrom: aMatrix
	| m |
	m := self aaTransform composedWith: aMatrix.
	"m offset: m offset + destOffset."
	^m! !

!BalloonEngine methodsFor: 'accessing' stamp: 'ar 10/29/1998 01:51'!
aaTransform
	"Return a transformation for the current anti-aliasing level"
	| matrix |
	matrix := MatrixTransform2x3 withScale: (self aaLevel) asFloat asPoint.
	matrix offset: (self aaLevel // 2) asFloat asPoint.
	^matrix composedWith:(MatrixTransform2x3 withOffset: destOffset asFloatPoint)! !

!BalloonEngine class methodsFor: 'private' stamp: 'ar 11/11/1998 22:50'!
allocateOrRecycleBuffer: initialSize
	"Try to recycly a buffer. If this is not possibly, create a new one."
	| buffer |
	CacheProtect critical:[
		buffer := BufferCache at: 1.
		BufferCache at: 1 put: nil.
	].
	^buffer ifNil:[BalloonBuffer new: initialSize]! !

!BalloonEngine class methodsFor: 'initialization' stamp: 'ar 11/11/1998 22:49'!
initialize
	"BalloonEngine initialize"
	BufferCache := WeakArray new: 1.
	Smalltalk garbageCollect. "Make the cache old"
	CacheProtect := Semaphore forMutualExclusion.
	Times := WordArray new: 10.
	Counts := WordArray new: 10.
	BezierStats := WordArray new: 4.
	Debug ifNil:[Debug := false].! !

!BalloonEngine class methodsFor: 'private' stamp: 'eem 6/11/2008 13:00'!
recycleBuffer: balloonBuffer
	"Try to keep the buffer for later drawing operations."

	CacheProtect critical:[ | buffer |
		buffer := BufferCache at: 1.
		(buffer isNil or:[buffer size < balloonBuffer size] )
			ifTrue:[BufferCache at: 1 put: balloonBuffer].
	].! !

!BalloonEngine class methodsFor: 'accessing' stamp: 'ar 10/30/1998 23:57'!
resetBezierStats
	BezierStats := WordArray new: 4.! !

!BalloonEngine class methodsFor: 'accessing' stamp: 'ar 1/12/1999 10:52'!
printStats
	"BalloonEngine doProfileStats: true"
	"BalloonEngine printStats"
	"BalloonEngine resetStats"
	Transcript cr; nextPutAll:'/************** BalloonEngine statistics ****************/'.
	self printStat: (Times at: 1) count: (Counts at: 1) string: 'Initialization'.
	self printStat: (Times at: 2) count: (Counts at: 2) string: 'Finish test'.
	self printStat: (Times at: 3) count: (Counts at: 3) string: 'Fetching/Adding GET entries'.
	self printStat: (Times at: 4) count: (Counts at: 4) string: 'Adding AET entries'.
	self printStat: (Times at: 5) count: (Counts at: 5) string: 'Fetching/Computing fills'.
	self printStat: (Times at: 6) count: (Counts at: 6) string: 'Merging fills'.
	self printStat: (Times at: 7) count: (Counts at: 7) string: 'Displaying span buffer'.
	self printStat: (Times at: 8) count: (Counts at: 8) string: 'Fetching/Updating AET entries'.
	self printStat: (Times at: 9) count: (Counts at: 9) string: 'Changing AET entries'.
	Transcript cr; print: Times sum; nextPutAll:' mSecs for all operations'.
	Transcript cr; print: Counts sum; nextPutAll: ' overall operations'.
	Transcript endEntry.! !

!BalloonEngine class methodsFor: 'accessing' stamp: 'ar 10/28/1998 23:59'!
printStat: time count: n string: aString
	Transcript
		cr;
		print: time; tab;
		nextPutAll:' mSecs -- ';
		print: n; tab;
		nextPutAll:' ops -- ';
		print: ((time asFloat / (n max: 1) asFloat) roundTo: 0.01); tab;
		nextPutAll: ' avg. mSecs/op -- ';
		nextPutAll: aString.! !

!BalloonEngine class methodsFor: 'accessing' stamp: 'ar 10/28/1998 23:38'!
resetStats
	Times := WordArray new: 10.
	Counts := WordArray new: 10.! !

!BalloonEngine class methodsFor: 'accessing' stamp: 'ar 10/30/1998 23:57'!
printBezierStats
	"BalloonEngine printBezierStats"
	"BalloonEngine resetBezierStats"
	Transcript 
		cr; nextPutAll:'Bezier statistics:';
		crtab; print: (BezierStats at: 1); tab; nextPutAll:' non-monoton curves splitted';
		crtab; print: (BezierStats at: 2); tab; nextPutAll:' curves splitted for numerical accuracy';
		crtab; print: (BezierStats at: 3); tab; nextPutAll:' curves splitted to avoid integer overflow';
		crtab; print: (BezierStats at: 4); tab; nextPutAll:' curves internally converted to lines';
	endEntry.! !

!BalloonEngine class methodsFor: 'accessing' stamp: 'ar 2/2/2001 15:47'!
doProfileStats: aBool
	"Note: On Macintosh systems turning on profiling can significantly
	degrade the performance of Balloon since we're using the high
	accuracy timer for measuring."
	"BalloonEngine doProfileStats: true"
	"BalloonEngine doProfileStats: false"
	<primitive: 'primitiveDoProfileStats' module: 'B2DPlugin'>
	^false! !

!BalloonEngine class methodsFor: 'private' stamp: 'ar 5/28/2000 22:17'!
primitiveSetBitBltPlugin: pluginName
	<primitive: 'primitiveSetBitBltPlugin' module: 'B2DPlugin'>
	^nil! !

!BalloonEngine class methodsFor: 'accessing' stamp: 'ar 10/25/1998 17:37'!
debug: aBoolean
	"BalloonEngine debug: true"
	"BalloonEngine debug: false"
	Debug := aBoolean! !

!BalloonEngineConstants commentStamp: 'TorstenBergmann 1/31/2014 11:12'!
Constants for the baloon engine!
!BalloonEngineConstants class methodsFor: 'pool definition' stamp: 'ar 5/18/2003 20:00'!
initStateConstants
	"Initialize the state Constants"

	GEStateUnlocked := 0.			"Buffer is unlocked and can be modified as wanted"
	GEStateAddingFromGET := 1.	"Adding edges from the GET"
	GEStateWaitingForEdge := 2.	"Waiting for edges added to GET"
	GEStateScanningAET := 3.		"Scanning the active edge table"
	GEStateWaitingForFill := 4.		"Waiting for a fill to mix in during AET scan"
	GEStateBlitBuffer := 5.			"Blt the current scan line"
	GEStateUpdateEdges := 6.		"Update edges to next scan line"
	GEStateWaitingChange := 7.	"Waiting for a changed edge"
	GEStateCompleted := 8.			"Rendering completed"

	"Error constants"
	GErrorNoMoreSpace := 1.		"No more space in collection"
	GErrorBadState := 2.			"Tried to call a primitive while engine in bad state"
	GErrorNeedFlush := 3.			"Tried to call a primitive that requires flushing before"

	"Incremental error constants"
	GErrorGETEntry := 4.			"Unknown entry in GET"
	GErrorFillEntry := 5.			"Unknown FILL encountered"
	GErrorAETEntry := 6.			"Unknown entry in AET"
! !

!BalloonEngineConstants class methodsFor: 'pool definition' stamp: 'ar 5/18/2003 20:08'!
initialize
	"BalloonEngineConstants initialize"
	self initStateConstants.
	self initWorkBufferConstants.
	self initPrimitiveConstants.
	self initEdgeConstants.
	self initFillConstants.
	self initializeInstVarNames: BalloonEngine prefixedBy: 'BE'.
	self initializeInstVarNames: BalloonEdgeData prefixedBy: 'ET'.
	self initializeInstVarNames: BalloonFillData prefixedBy: 'FT'.! !

!BalloonEngineConstants class methodsFor: 'pool definition' stamp: 'ar 5/18/2003 19:55'!
initEdgeConstants
	"Initialize the edge constants"

	"Edge primitive types"
	GEPrimitiveEdge := 2.			"External edge - not handled by the GE"
	GEPrimitiveWideEdge := 3.		"Wide external edge"
	GEPrimitiveLine := 4.			"Straight line"
	GEPrimitiveWideLine := 5.		"Wide line"
	GEPrimitiveBezier := 6.		"Quadratic bezier curve"
	GEPrimitiveWideBezier := 7.	"Wide bezier curve"

	"Special flags"
	GEPrimitiveWide := 16r01.		"Flag determining a wide primitive"
	GEPrimitiveWideMask := 16rFE.	"Mask for clearing the wide flag"
	GEEdgeFillsInvalid := 16r10000. "Flag determining if left/right fills of an edge are invalid"
	GEEdgeClipFlag := 16r20000.	"Flag determining if this is a clip edge"

	"General edge state constants"
	GEXValue := 4.					"Current raster x"
	GEYValue := 5.					"Current raster y"
	GEZValue := 6.					"Current raster z"
	GENumLines := 7.					"Number of scan lines remaining"
	GEFillIndexLeft := 8.				"Left fill index"
	GEFillIndexRight := 9.				"Right fill index"
	GEBaseEdgeSize := 10.				"Basic size of each edge"

	"General fill state constants"
	GEBaseFillSize := 4.				"Basic size of each fill"

	"General Line state constants"
	GLXDirection := 10.				"Direction of edge (1: left-to-right; -1: right-to-left)"
	GLYDirection := 11.				"Direction of edge (1: top-to-bottom; -1: bottom-to-top)"
	GLXIncrement := 12.				"Increment at each scan line"
	GLError := 13.						"Current error"
	GLErrorAdjUp := 14.				"Error to add at each scan line"
	GLErrorAdjDown := 15.				"Error to subtract on roll-over"
			"Note: The following entries are only needed before the incremental
			state is computed. They are therefore aliased to the error values above"
	GLEndX := 14.						"End X of line"
	GLEndY := 15.						"End Y of line"
	GLBaseSize := 16.					"Basic size of each line"

	"Additional stuff for wide lines"
	GLWideFill := 16.					"Current fill of line"
	GLWideWidth := 17.				"Current width of line"
	GLWideEntry := 18.				"Initial steps"
	GLWideExit := 19.					"Final steps"
	GLWideExtent := 20.				"Target width"
	GLWideSize := 21.					"Size of wide lines"

	"General Bezier state constants"
	GBUpdateData := 10.				"Incremental update data for beziers"
	GBUpdateX := 0.				"Last computed X value (24.8)"
	GBUpdateY := 1.				"Last computed Y value (24.8)"
	GBUpdateDX := 2.				"Delta X forward difference step (8.24)"
	GBUpdateDY := 3.				"Delta Y forward difference step (8.24)"
	GBUpdateDDX := 4.				"Delta DX forward difference step (8.24)"
	GBUpdateDDY := 5.				"Delta DY forward difference step (8.24)"
		"Note: The following four entries are only needed before the incremental
			state is computed. They are therefore aliased to the incremental values above"
	GBViaX := 12.						"via x"
	GBViaY := 13.						"via y"
	GBEndX := 14.						"end x"
	GBEndY := 15.						"end y"
	GBBaseSize := 16.					"Basic size of each bezier.
										Note: MUST be greater or equal to the size of lines"
	"Additional stuff for wide beziers"
	GBWideFill := 16.					"Current fill of line"
	GBWideWidth := 17.				"Current width of line"
	GBWideEntry := 18.				"Initial steps"
	GBWideExit := 19.					"Final steps"
	GBWideExtent := 20.				"Target extent"
	GBFinalX := 21.					"Final X value"
	GBWideUpdateData := 22.	"Update data for second curve"
	GBWideSize := 28.					"Size of wide beziers"

! !

!BalloonEngineConstants class methodsFor: 'pool definition' stamp: 'StephaneDucasse 8/27/2010 10:54'!
initializeInstVarNames: aClass prefixedBy: aString

	| token |
	aClass instVarNames doWithIndex:[:instVarName :index| | value aToken |
		aToken := (aString, instVarName first asUppercase asString, (instVarName copyFrom: 2 to: instVarName size),'Index') asSymbol.
		value := index - 1.
		(self bindingOf: aToken) ifNil:[self addClassVarNamed: aToken].
		(self bindingOf: aToken) value: value.
	].
	token := (aString, aClass name,'Size') asSymbol.
	(self bindingOf: token) ifNil:[self addClassVarNamed: token].
	(self bindingOf: token) value: aClass instSize.! !

!BalloonEngineConstants class methodsFor: 'pool definition' stamp: 'ar 5/18/2003 20:08'!
initFillConstants
	"Initialize the fill constants"

	"Fill primitive types"
	GEPrimitiveFill := 16r100.
	GEPrimitiveLinearGradientFill := 16r200.
	GEPrimitiveRadialGradientFill := 16r300.
	GEPrimitiveClippedBitmapFill := 16r400.
	GEPrimitiveRepeatedBitmapFill := 16r500.

	"General fill state constants"
	GEBaseFillSize := 4.				"Basic size of each fill"

	"Oriented fill constants"
	GFOriginX := 4.				"X origin of fill"
	GFOriginY := 5.				"Y origin of fill"
	GFDirectionX := 6.				"X direction of fill"
	GFDirectionY := 7.				"Y direction of fill"
	GFNormalX := 8.				"X normal of fill"
	GFNormalY := 9.				"Y normal of fill"

	"Gradient fill constants"
	GFRampLength := 10.			"Length of following color ramp"
	GFRampOffset := 12.			"Offset of first ramp entry"
	GGBaseSize := 12.

	"Bitmap fill constants"
	GBBitmapWidth := 10.			"Width of bitmap"
	GBBitmapHeight := 11.			"Height of bitmap"
	GBBitmapDepth := 12.			"Depth of bitmap"
	GBBitmapSize := 13.			"Size of bitmap words"
	GBBitmapRaster := 14.			"Size of raster line"
	GBColormapSize := 15.			"Size of colormap, if any"
	GBTileFlag := 16.				"True if the bitmap is tiled"
	GBColormapOffset := 18.		"Offset of colormap, if any"
	GBMBaseSize := 18.			"Basic size of bitmap fill"
! !

!BalloonEngineConstants class methodsFor: 'pool definition' stamp: 'ar 5/18/2003 20:04'!
initWorkBufferConstants
	"Initialize the work buffer constants"

	"General work buffer constants"
	GWMagicNumber := 16r416E6469.	"Magic number"
	GWHeaderSize := 128.				"Size of header"
	GWMinimalSize := 256.				"Minimal size of work buffer"

	"Header entries"
	GWMagicIndex := 0.				"Index of magic number"
	GWSize := 1.						"Size of full buffer"
	GWState := 2.						"Current state (e.g., locked or not."
	"Buffer entries"
	GWObjStart := 8.					"objStart"
	GWObjUsed := 9.					"objUsed"
	GWBufferTop := 10.				"wbTop"
	GWGETStart := 11.					"getStart"
	GWGETUsed := 12.					"getUsed"
	GWAETStart := 13.					"aetStart"
	GWAETUsed := 14.					"aetUsed"

	"Transform entries"
	GWHasEdgeTransform := 16.		"True if we have an edge transformation"
	GWHasColorTransform := 17.		"True if we have a color transformation"
	GWEdgeTransform := 18.			"2x3 edge transformation"
	GWColorTransform := 24.			"8 word RGBA color transformation"

	"Span entries"
	GWSpanStart := 32.				"spStart"
	GWSpanSize := 33.					"spSize"
	GWSpanEnd := 34.					"spEnd"
	GWSpanEndAA := 35.				"spEndAA"

	"Bounds entries"
	GWFillMinX := 36.					"fillMinX"
	GWFillMaxX := 37.					"fillMaxX"
	GWFillMinY := 38.					"fillMinY"
	GWFillMaxY := 39.					"fillMaxY"
	GWFillOffsetX := 40.				"fillOffsetX"
	GWFillOffsetY := 41.				"fillOffsetY"
	GWClipMinX := 42.
	GWClipMaxX := 43.
	GWClipMinY := 44.
	GWClipMaxY := 45.
	GWDestOffsetX := 46.
	GWDestOffsetY := 47.

	"AA entries"
	GWAALevel := 48.					"aaLevel"
	GWAAShift := 49.					"aaShift"
	GWAAColorShift := 50.				"aaColorShift"
	GWAAColorMask := 51.				"aaColorMask"
	GWAAScanMask := 52.				"aaScanMask"
	GWAAHalfPixel := 53.				"aaHalfPixel"

	"Misc entries"
	GWNeedsFlush := 63.				"True if the engine may need a flush"
	GWStopReason := 64.				"stopReason"
	GWLastExportedEdge := 65.			"last exported edge"
	GWLastExportedFill := 66.			"last exported fill"
	GWLastExportedLeftX := 67.			"last exported leftX"
	GWLastExportedRightX := 68.		"last exported rightX"
	GWClearSpanBuffer := 69.			"Do we have to clear the span buffer?"
	GWPointListFirst := 70.				"First point list in buffer"

	GWPoint1 := 80.
	GWPoint2 := 82.
	GWPoint3 := 84.
	GWPoint4 := 86.

	GWCurrentY := 88.

	"Profile stats"
	GWTimeInitializing := 90.
	GWCountInitializing := 91.
	GWTimeFinishTest := 92.
	GWCountFinishTest := 93.
	GWTimeNextGETEntry := 94.
	GWCountNextGETEntry := 95.
	GWTimeAddAETEntry := 96.
	GWCountAddAETEntry := 97.
	GWTimeNextFillEntry := 98.
	GWCountNextFillEntry := 99.
	GWTimeMergeFill := 100.
	GWCountMergeFill := 101.
	GWTimeDisplaySpan := 102.
	GWCountDisplaySpan := 103.
	GWTimeNextAETEntry := 104.
	GWCountNextAETEntry := 105.
	GWTimeChangeAETEntry := 106.
	GWCountChangeAETEntry := 107.

	"Bezier stats"
	GWBezierMonotonSubdivisions := 108. 	"# of subdivision due to non-monoton beziers"
	GWBezierHeightSubdivisions := 109.		"# of subdivisions due to excessive height"
	GWBezierOverflowSubdivisions := 110.	"# of subdivisions due to possible int overflow"
	GWBezierLineConversions := 111.		"# of beziers converted to lines"

	GWHasClipShapes := 112.		"True if the engine contains clip shapes"
	GWCurrentZ := 113.			"Current z value of primitives"
! !

!BalloonEngineConstants class methodsFor: 'pool definition' stamp: 'ar 5/18/2003 19:59'!
initPrimitiveConstants
	"Initialize the primitive constants"

	"Primitive type constants"
	GEPrimitiveUnknown := 0.
	GEPrimitiveEdgeMask := 16rFF.
	GEPrimitiveFillMask := 16rFF00.
	GEPrimitiveTypeMask := 16rFFFF.

	"General state constants (Note: could be compressed later)"
	GEObjectType := 0.				"Type of object"
	GEObjectLength := 1.			"Length of object"
	GEObjectIndex := 2.			"Index into external objects"
	GEObjectUnused := 3.			"Currently unused"

! !

!BalloonFillData commentStamp: '<historical>'!
This class is a simulation of the code that's run by the Balloon engine. For debugging purposes only.!
!BalloonFillData methodsFor: 'accessing' stamp: 'ar 10/27/1998 15:56'!
destForm: aForm
	destForm := aForm! !

!BalloonFillData methodsFor: 'accessing' stamp: 'ar 10/27/1998 15:55'!
yValue
	^yValue! !

!BalloonFillData methodsFor: 'accessing' stamp: 'ar 10/28/1998 16:35'!
width
	^maxX - minX! !

!BalloonFillData methodsFor: 'accessing' stamp: 'ar 10/27/1998 15:55'!
maxX: anInteger
	maxX := anInteger! !

!BalloonFillData methodsFor: 'accessing' stamp: 'ar 10/27/1998 15:55'!
minX
	^minX! !

!BalloonFillData methodsFor: 'accessing' stamp: 'ar 10/27/1998 15:55'!
yValue: anInteger
	yValue := anInteger! !

!BalloonFillData methodsFor: 'accessing' stamp: 'ar 10/27/1998 15:56'!
source
	^source! !

!BalloonFillData methodsFor: 'accessing' stamp: 'ar 10/27/1998 15:56'!
destForm
	^destForm! !

!BalloonFillData methodsFor: 'accessing' stamp: 'ar 10/27/1998 15:55'!
index: anInteger
	index := anInteger! !

!BalloonFillData methodsFor: 'accessing' stamp: 'ar 10/27/1998 15:55'!
maxX
	^maxX! !

!BalloonFillData methodsFor: 'computing' stamp: 'ar 11/14/1998 19:32'!
computeFill
	(destForm isNil or:[destForm width < self width]) ifTrue:[
		destForm := Form extent: (self width + 10) @ 1 depth: 32.
	].
	source computeFillFrom: minX to: maxX at: yValue in: destForm! !

!BalloonFillData methodsFor: 'accessing' stamp: 'ar 10/27/1998 15:55'!
minX: anInteger
	minX := anInteger! !

!BalloonFillData methodsFor: 'accessing' stamp: 'ar 10/27/1998 15:56'!
source: anObject
	source := anObject! !

!BalloonFillData methodsFor: 'accessing' stamp: 'ar 10/27/1998 15:55'!
index
	^index! !

!BalloonLineSimulation commentStamp: '<historical>'!
This class is a simulation of the code that's run by the Balloon engine. For debugging purposes only.!
!BalloonLineSimulation methodsFor: 'accessing' stamp: 'ar 10/30/1998 03:02'!
end: aPoint
	end := aPoint! !

!BalloonLineSimulation methodsFor: 'computing' stamp: 'ar 10/27/1998 20:39'!
stepToNextScanLineAt: yValue in: edgeTableEntry
	"Compute the next x value for the scan line at yValue.
	This message is sent during incremental updates. 
	The yValue parameter is passed in here for edges
	that have more complicated computations,"
	| x |
	x := edgeTableEntry xValue + xIncrement.
	error := error + errorAdjUp.
	error > 0 ifTrue:[
		x := x + xDirection.
		error := error - errorAdjDown.
	].
	edgeTableEntry xValue: x.! !

!BalloonLineSimulation methodsFor: 'computing' stamp: 'ar 10/27/1998 23:22'!
stepToFirstScanLineAt: yValue in: edgeTableEntry
	"Compute the initial x value for the scan line at yValue"
	|  startX endX startY endY yDir deltaY deltaX widthX |
	(start y) <= (end y) ifTrue:[
		startX := start x.	endX := end x.
		startY := start y.	endY := end y.
		yDir := 1.
	] ifFalse:[
		startX := end x.	endX := start x.
		startY := end y.	endY := start y.
		yDir := -1.
	].

	deltaY := endY - startY.
	deltaX := endX - startX.

	"Quickly check if the line is visible at all"
	(yValue >= endY or:[deltaY = 0]) ifTrue:[^edgeTableEntry lines: 0].

	"Check if edge goes left to right"
	deltaX >= 0 ifTrue:[
		xDirection := 1.
		widthX := deltaX.
		error := 0.
	] ifFalse:[
		xDirection := -1.
		widthX := 0 - deltaX.
		error := 1 - deltaY.
	].

	"Check if edge is horizontal"
	deltaY = 0 
		ifTrue:[	xIncrement := 0.
				errorAdjUp := 0]
		ifFalse:["Check if edge is y-major"
			deltaY > widthX 
				ifTrue:[	xIncrement := 0.
						errorAdjUp := widthX]
				ifFalse:[	xIncrement := (widthX // deltaY) * xDirection.
						errorAdjUp := widthX \\ deltaY]].

	errorAdjDown := deltaY.

	edgeTableEntry xValue: startX.
	edgeTableEntry lines: deltaY.

	"If not at first scan line then step down to yValue"
	yValue = startY ifFalse:[
		startY to: yValue do:[:y| self stepToNextScanLineAt: y in: edgeTableEntry].
		"And adjust remainingLines"
		edgeTableEntry lines: deltaY - (yValue - startY).
	].! !

!BalloonLineSimulation methodsFor: 'accessing' stamp: 'ar 10/27/1998 20:31'!
initialY
	^start y <= end y
		ifTrue:[start y]
		ifFalse:[end y]! !

!BalloonLineSimulation methodsFor: 'computing' stamp: 'ar 10/27/1998 20:52'!
computeInitialStateFrom: source with: aTransformation
	"Compute the initial state in the receiver."
	start := (aTransformation localPointToGlobal: source start) asIntegerPoint.
	end := (aTransformation localPointToGlobal: source end) asIntegerPoint.! !

!BalloonLineSimulation methodsFor: 'accessing' stamp: 'ar 10/27/1998 20:31'!
initialX
	^start y <= end y
		ifTrue:[start x]
		ifFalse:[end x]! !

!BalloonLineSimulation methodsFor: 'accessing' stamp: 'ar 10/30/1998 03:02'!
start
	^start! !

!BalloonLineSimulation methodsFor: 'printing' stamp: 'ar 10/27/1998 23:20'!
printOn: aStream
	aStream 
		nextPutAll: self class name;
		nextPut:$(;
		print: start;
		nextPutAll:' - ';
		print: end;
		nextPut:$)! !

!BalloonLineSimulation methodsFor: 'accessing' stamp: 'ar 10/30/1998 03:02'!
end
	^end! !

!BalloonLineSimulation methodsFor: 'accessing' stamp: 'ar 10/30/1998 03:02'!
start: aPoint
	start := aPoint! !

!BalloonLineSimulation methodsFor: 'accessing' stamp: 'ar 10/27/1998 20:31'!
initialZ
	^0 "Assume no depth given"! !

!BalloonLineSimulation methodsFor: 'computing' stamp: 'ar 10/29/1998 23:42'!
subdivide
	^nil! !

!BalloonMorph commentStamp: '<historical>'!
A balloon with text used for the display of explanatory information.

Balloon help is integrated into Morphic as follows:
If a Morph has the property #balloonText, then it will respond to #showBalloon by adding a text balloon to the world, and to #deleteBalloon by removing the balloon.

Moreover, if mouseOverEnabled is true (see class msg), then the Hand will arrange to cause display of the balloon after the mouse has lingered over the morph for a while, and removal of the balloon when the mouse leaves the bounds of that morph.  In any case, the Hand will attempt to remove any such balloons before handling mouseDown events, or displaying other balloons.

Balloons should not be duplicated with veryDeepCopy unless their target is also duplicated at the same time.!
!BalloonMorph methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 1/20/2011 12:21'!
defaultColor
	"answer the default color/fill style for the receiver"
	^ self balloonColor! !

!BalloonMorph methodsFor: 'private' stamp: 'sma 12/23/1999 14:06'!
setTarget: aMorph
	(target := aMorph) ifNotNil: [offsetFromTarget := self position - target position]! !

!BalloonMorph methodsFor: 'initialization' stamp: 'RAA 7/1/2001 18:48'!
popUpForHand: aHand
	"Pop up the receiver as balloon help for the given hand"
	| worldBounds |

	self lock.
	self fullBounds. "force layout"
	self setProperty: #morphicLayerNumber toValue: self morphicLayerNumber.
	aHand world addMorphFront: self.
	"So that if the translation below makes it overlap the receiver, it won't
	interfere with the rootMorphsAt: logic and hence cause flashing.  Without
	this, flashing happens, believe me!!"
	((worldBounds := aHand world bounds) containsRect: self bounds) ifFalse:
		[self bounds: (self bounds translatedToBeWithin: worldBounds)].
	aHand balloonHelp: self.
! !

!BalloonMorph methodsFor: 'menus' stamp: 'wiz 12/30/2004 17:14'!
adjustedCenter
	"Return the center of the original textMorph box within the balloon."

	^ (self vertices last: 4) average rounded  ! !

!BalloonMorph methodsFor: 'accessing' stamp: 'ar 10/3/2000 17:19'!
balloonOwner
	^balloonOwner! !

!BalloonMorph methodsFor: 'stepping and presenter' stamp: 'sma 12/23/1999 14:05'!
step
	"Move with target."

	target ifNotNil: [self position: target position + offsetFromTarget].
! !

!BalloonMorph methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 1/20/2011 12:25'!
initialize
	"initialize the state of the receiver"
	
	balloonColor := self class balloonColor.
	super initialize.
	self beSmoothCurve.
	offsetFromTarget := 0@0.! !

!BalloonMorph methodsFor: 'initialization' stamp: 'dgd 3/12/2006 14:27'!
defaultBorderColor
	"answer the default border color/fill style for the receiver"
	^ self defaultColor muchDarker"Color black"! !

!BalloonMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/20/2011 12:25'!
balloonColor

	^ balloonColor! !

!BalloonMorph methodsFor: 'testing' stamp: 'di 9/18/97 10:10'!
stepTime
	^ 0  "every cycle"! !

!BalloonMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/20/2011 12:35'!
balloonColor: aColor

	balloonColor := aColor.
	self color: aColor! !

!BalloonMorph methodsFor: 'wiw support' stamp: 'RAA 6/27/2000 18:07'!
morphicLayerNumber

	"helpful for insuring some morphs always appear in front of or behind others.
	smaller numbers are in front"

	^5		"Balloons are very front-like things"! !

!BalloonMorph methodsFor: 'initialization' stamp: 'ar 10/4/2000 10:13'!
popUpFor: aMorph hand: aHand
	"Pop up the receiver as balloon help for the given hand"
	balloonOwner := aMorph.
	self popUpForHand: aHand.! !

!BalloonMorph methodsFor: 'initialization' stamp: 'AlainPlantec 10/20/2010 20:12'!
defaultBorderWidth
	"answer the default border width for the receiver"
	^ 1! !

!BalloonMorph class methodsFor: 'utility' stamp: 'AlainPlantec 11/30/2009 09:27'!
balloonFont
	^ BalloonFont ifNil: [BalloonFont := StandardFonts defaultFont]! !

!BalloonMorph class methodsFor: 'instance creation' stamp: 'HilaireFernandes 5/14/2011 16:25'!
initialize 
	"BalloonMorph initialize"
	self setBalloonColorTo: BalloonMorph defaultBalloonColor.
	self balloonFont: StandardFonts defaultFont! !

!BalloonMorph class methodsFor: 'private' stamp: 'MarcusDenker 2/24/2011 21:09'!
defaultBalloonColor

	^ (Color fromArray: #(0.85 0.9 1.0 )) twiceLighter alpha: 0.95! !

!BalloonMorph class methodsFor: 'instance creation' stamp: 'sma 12/23/1999 20:05'!
string: str for: morph
	^ self string: str for: morph corner: #bottomLeft! !

!BalloonMorph class methodsFor: 'utility' stamp: 'BenjaminVanRyseghem 1/20/2011 11:29'!
balloonColor
	^ BalloonColor ifNil: [BalloonColor := self defaultBalloonColor]! !

!BalloonMorph class methodsFor: 'utility' stamp: 'AlainPlantec 11/30/2009 09:40'!
balloonFont: aFont
	BalloonFont := aFont! !

!BalloonMorph class methodsFor: 'instance creation' stamp: 'FranciscoGarau 4/29/2012 15:23'!
string: str for: morph corner: cornerName 
	"Make up and return a balloon for morph. Find the quadrant that 
	clips the text the least, using cornerName as a tie-breaker. tk 9/12/97"
	| tm vertices |
	tm := self getTextMorph: str for: morph.
	tm composeToBounds. 
	vertices := self getVertices: tm bounds.
	vertices := self
				getBestLocation: vertices
				for: morph
				corner: cornerName.
	^ self new color: self balloonColor;
		 setVertices: vertices;
		 addMorph: tm;
		 setTarget: morph! !

!BalloonMorph class methodsFor: 'private' stamp: 'CamilloBruni 8/1/2012 16:07'!
getBestLocation: vertices for: morph corner: cornerName
	| rect maxArea verts rectCorner morphPoint mbc a mp dir bestVerts result usableArea |
	"Choose rect independantly of vertice order or size. Would be nice it this took into account curveBounds but it does not." 
	rect := Rectangle encompassing: vertices.  
	maxArea := -1.
	verts := vertices.
	usableArea := (morph world ifNil: [self currentWorld]) viewBox.
	1 to: 4 do: [:i |
		dir := #(vertical horizontal) atWrap: i.
		verts := verts collect: [:p | p flipBy: dir centerAt: rect center].
		rectCorner := #(bottomLeft bottomRight topRight topLeft) at: i.
		morphPoint := #(topCenter topCenter bottomCenter bottomCenter) at: i.
		a := ((rect
			align: (rect perform: rectCorner)
			with: (mbc := morph boundsForBalloon perform: morphPoint))
				intersect: usableArea) area.
		(a > maxArea or: [a = rect area and: [rectCorner = cornerName]]) ifTrue:
			[maxArea := a.
			bestVerts := verts.
			mp := mbc]].
	result := bestVerts collect: [:p | p + (mp - bestVerts first)] "Inlined align:with:".
	^ result! !

!BalloonMorph class methodsFor: 'private' stamp: 'AlainPlantec 11/30/2009 09:45'!
getTextMorph: aStringOrMorph for: balloonOwner
	"Construct text morph."
	| m text |
	aStringOrMorph isMorph
		ifTrue: [m := aStringOrMorph]
		ifFalse: [balloonOwner balloonFont
				ifNil: [text := aStringOrMorph]
				ifNotNil: [text := Text
								string: aStringOrMorph
								attribute: (TextFontReference toFont: balloonOwner balloonFont)].
			m := (TextMorph new contents: text) centered].
	m setToAdhereToEdge: #adjustedCenter.
	^ m! !

!BalloonMorph class methodsFor: 'private' stamp: 'wiz 1/8/2005 18:05'!
getVertices: bounds
	"Construct vertices for a balloon up and to left of anchor"

	| corners |
	corners := bounds corners atAll: #(1 4 3 2).
	^ (Array
		with: corners first + (0 - bounds width // 2 @ 0)
		with: corners first + (0 - bounds width // 4 @ (bounds height // 2))) , corners! !

!BalloonMorph class methodsFor: 'utility' stamp: 'sma 11/11/2000 14:59'!
setBalloonColorTo: aColor 
	aColor ifNotNil: [BalloonColor := aColor]! !

!BalloonSolidFillSimulation commentStamp: '<historical>'!
This class is a simulation of the code that's run by the Balloon engine. For debugging purposes only.!
!BalloonSolidFillSimulation methodsFor: 'computing' stamp: 'ar 10/27/1998 23:08'!
computeInitialStateFrom: source with: aColorTransform
	color := source asColor.! !

!BalloonSolidFillSimulation methodsFor: 'computing' stamp: 'ar 10/27/1998 23:07'!
computeFillFrom: minX to: maxX at: yValue in: form
	| bb |
	color isTransparent ifFalse:[
		bb := BitBlt toForm: form.
		bb fillColor: color.
		bb destX: 0 destY: 0 width: (maxX - minX) height: 1.
		bb combinationRule: Form over.
		bb copyBits].! !

!BalloonState commentStamp: '<historical>'!
This class is a repository for data which needs to be preserved during certain operations of BalloonCanvas.!
!BalloonState methodsFor: 'accessing' stamp: 'ar 12/30/1998 10:42'!
colorTransform
	^colorTransform! !

!BalloonState methodsFor: 'accessing' stamp: 'ar 12/30/1998 10:42'!
transform: aMatrixTransform
	transform := aMatrixTransform! !

!BalloonState methodsFor: 'accessing' stamp: 'ar 12/30/1998 10:42'!
colorTransform: aColorTransform
	colorTransform := aColorTransform! !

!BalloonState methodsFor: 'accessing' stamp: 'ar 12/30/1998 10:47'!
aaLevel: aNumber
	aaLevel := aNumber! !

!BalloonState methodsFor: 'accessing' stamp: 'ar 12/30/1998 10:47'!
aaLevel
	^aaLevel! !

!BalloonState methodsFor: 'accessing' stamp: 'ar 12/30/1998 10:41'!
transform
	^transform! !

!Base64MimeConverter commentStamp: '<historical>'!
This class encodes and decodes data in Base64 format.  This is MIME encoding.  We translate a whole stream at once, taking a Stream as input and giving one as output.  Returns a whole stream for the caller to use.
           0 A            17 R            34 i            51 z
           1 B            18 S            35 j            52 0
           2 C            19 T            36 k            53 1
           3 D            20 U            37 l            54 2
           4 E            21 V            38 m            55 3
           5 F            22 W            39 n            56 4
           6 G            23 X            40 o            57 5
           7 H            24 Y            41 p            58 6
           8 I            25 Z            42 q            59 7
           9 J            26 a            43 r            60 8
          10 K            27 b            44 s            61 9
          11 L            28 c            45 t            62 +
          12 M            29 d            46 u            63 /
          13 N            30 e            47 v
          14 O            31 f            48 w         (pad) =
          15 P            32 g            49 x
          16 Q            33 h            50 y
Outbound: bytes are broken into 6 bit chunks, and the 0-63 value is converted to a character.  3 data bytes go into 4 characters.
Inbound: Characters are translated in to 0-63 values and shifted into 8 bit bytes.

(See: N. Borenstein, Bellcore, N. Freed, Innosoft, Network Working Group, Request for Comments: RFC 1521, September 1993, MIME (Multipurpose Internet Mail Extensions) Part One: Mechanisms for Specifying and Describing the Format of Internet Message Bodies. Sec 6.2)

By Ted Kaehler, based on Tim Olson's Base64Filter.!
!Base64MimeConverter methodsFor: 'initialization' stamp: 'dik 9/22/2010 18:09'!
initialize 
	super initialize.
		
	multiLine := true.! !

!Base64MimeConverter methodsFor: 'conversion' stamp: 'tk 12/9/97 13:39'!
mimeDecodeToByteArray
	"Convert a stream in base 64 with only a-z,A-Z,0-9,+,/ to a full ByteArray of 0-255 values.  Reutrn a whole stream for the user to read."

	| nibA nibB nibC nibD |
	[mimeStream atEnd] whileFalse: [
		(nibA := self nextValue) ifNil: [^ dataStream].
		(nibB := self nextValue) ifNil: [^ dataStream].
		dataStream nextPut: ((nibA bitShift: 2) + (nibB bitShift: -4)).
		nibB := nibB bitAnd: 16rF.
		(nibC := self nextValue) ifNil: [^ dataStream].
		dataStream nextPut: ((nibB bitShift: 4) + (nibC bitShift: -2)).
		nibC := nibC bitAnd: 16r3.
		(nibD := self nextValue) ifNil: [^ dataStream].
		dataStream nextPut: ((nibC bitShift: 6) + nibD).
		].
	^ dataStream! !

!Base64MimeConverter methodsFor: 'conversion' stamp: 'tk 12/9/97 13:34'!
mimeDecode
	"Convert a stream in base 64 with only a-z,A-Z,0-9,+,/ to a full byte stream of characters.  Reutrn a whole stream for the user to read."

	| nibA nibB nibC nibD |
	[mimeStream atEnd] whileFalse: [
		(nibA := self nextValue) ifNil: [^ dataStream].
		(nibB := self nextValue) ifNil: [^ dataStream].
		dataStream nextPut: ((nibA bitShift: 2) + (nibB bitShift: -4)) asCharacter.
		nibB := nibB bitAnd: 16rF.
		(nibC := self nextValue) ifNil: [^ dataStream].
		dataStream nextPut: ((nibB bitShift: 4) + (nibC bitShift: -2)) asCharacter.
		nibC := nibC bitAnd: 16r3.
		(nibD := self nextValue) ifNil: [^ dataStream].
		dataStream nextPut: ((nibC bitShift: 6) + nibD) asCharacter.
		].
	^ dataStream! !

!Base64MimeConverter methodsFor: 'accessing' stamp: 'dik 9/22/2010 18:07'!
multiLine: anObject
	multiLine := anObject! !

!Base64MimeConverter methodsFor: 'accessing' stamp: 'dik 9/22/2010 18:07'!
multiLine
	^ multiLine! !

!Base64MimeConverter methodsFor: 'conversion' stamp: 'tk 12/9/97 13:21'!
nextValue
	"The next six bits of data char from the mimeStream, or nil.  Skip all other chars"
	| raw num |
	[raw := mimeStream next.
	raw ifNil: [^ nil].	"end of stream"
	raw == $= ifTrue: [^ nil].
	num := FromCharTable at: raw asciiValue + 1.
	num ifNotNil: [^ num].
	"else ignore space, return, tab, ..."
	true] whileTrue.! !

!Base64MimeConverter methodsFor: 'conversion' stamp: 'MarcusDenker 7/22/2014 13:18'!
mimeEncode
	"Convert from data to 6 bit characters."

	| phase1 phase2 raw nib lineLength data |
	phase1 := phase2 := false.
	lineLength := 0.
	[dataStream atEnd] whileFalse: [
		(multiLine and:[lineLength >= 70]) ifTrue: [ mimeStream cr.  lineLength := 0. ].
		data := raw := dataStream next asInteger.
		nib := (data bitAnd: 16rFC) bitShift: -2.
		mimeStream nextPut: (ToCharTable at: nib+1).
		(raw := dataStream next) ifNil: [raw := 0. phase1 := true].
		data := ((data bitAnd: 3) bitShift: 8) + raw asInteger.
		nib := (data bitAnd: 16r3F0) bitShift: -4.
		mimeStream nextPut: (ToCharTable at: nib+1).
		(raw := dataStream next) ifNil: [raw := 0. phase2 := true].
		data := ((data bitAnd: 16rF) bitShift: 8) + (raw asInteger).
		nib := (data bitAnd: 16rFC0) bitShift: -6.
		mimeStream nextPut: (ToCharTable at: nib+1).
		nib := (data bitAnd: 16r3F).
		mimeStream nextPut: (ToCharTable at: nib+1).

		lineLength := lineLength + 4.].
	phase1 ifTrue: [mimeStream skip: -2; nextPut: $=; nextPut: $=.
			^ mimeStream].
	phase2 ifTrue: [mimeStream skip: -1; nextPut: $=.
			^ mimeStream].

! !

!Base64MimeConverter class methodsFor: 'class initialization' stamp: 'tk 12/9/97 13:53'!
initialize

	FromCharTable := Array new: 256.	"nils"
	ToCharTable := Array new: 64.
	($A asciiValue to: $Z asciiValue) doWithIndex: [:val :ind | 
		FromCharTable at: val+1 put: ind-1.
		ToCharTable at: ind put: val asCharacter].
	($a asciiValue to: $z asciiValue) doWithIndex: [:val :ind | 
		FromCharTable at: val+1 put: ind+25.
		ToCharTable at: ind+26 put: val asCharacter].
	($0 asciiValue to: $9 asciiValue) doWithIndex: [:val :ind | 
		FromCharTable at: val+1 put: ind+25+26.
		ToCharTable at: ind+26+26 put: val asCharacter].
	FromCharTable at: $+ asciiValue + 1 put: 62.
	ToCharTable at: 63 put: $+.
	FromCharTable at: $/ asciiValue + 1 put: 63.
	ToCharTable at: 64 put: $/.
	! !

!Base64MimeConverter class methodsFor: 'encoding' stamp: 'dik 9/22/2010 18:08'!
mimeEncode: aStream multiLine: aBool
	"Return a ReadWriteStream of characters.  The data of aStream is encoded as 65 innocuous characters.  (See class comment). 3 bytes in aStream goes to 4 bytes in output."

	| me |
	me := self new dataStream: aStream.
	me multiLine: aBool.
	me mimeStream: (ReadWriteStream on: (String new: aStream size + 20 * 4 // 3)).
	me mimeEncode.
	me mimeStream position: 0.
	^ me mimeStream! !

!Base64MimeConverter class methodsFor: 'encoding' stamp: 'tk 12/9/97 13:01'!
mimeDecodeToChars: aStream 
	"Return a ReadWriteStream of the original String.  aStream has only 65 innocuous character values.  It is not binary.  (See class comment). 4 bytes in aStream goes to 3 bytes in output."

	| me |
	aStream position: 0.
	me := self new mimeStream: aStream.
	me dataStream: (ReadWriteStream on: (String new: aStream size * 3 // 4)).
	me mimeDecode.
	me dataStream position: 0.
	^ me dataStream! !

!Base64MimeConverter class methodsFor: 'encoding' stamp: 'tk 12/12/97 11:41'!
mimeDecodeToBytes: aStream 
	"Return a RWBinaryOrTextStream of the original ByteArray.  aStream has only 65 innocuous character values.  aStream is not binary.  (See class comment). 4 bytes in aStream goes to 3 bytes in output."

	| me |
	aStream position: 0.
	me := self new mimeStream: aStream.
	me dataStream: (RWBinaryOrTextStream on: (ByteArray new: aStream size * 3 // 4)).
	me mimeDecodeToByteArray.
	me dataStream position: 0.
	^ me dataStream! !

!Base64MimeConverter class methodsFor: 'encoding' stamp: 'dik 9/22/2010 18:08'!
mimeEncode: aStream
	"Return a ReadWriteStream of characters.  The data of aStream is encoded as 65 innocuous characters.  (See class comment). 3 bytes in aStream goes to 4 bytes in output."

	^self mimeEncode: aStream multiLine: true! !

!Base64MimeConverter class methodsFor: 'encoding' stamp: 'tk 2/21/2000 17:22'!
encodeInteger: int
	| strm |
	"Encode an integer of any length and return the MIME string"

	strm := ReadWriteStream on: (ByteArray new: int digitLength).
	1 to: int digitLength do: [:ii | strm nextPut: (int digitAt: ii)].
	strm reset.
	^ ((self mimeEncode: strm) contents) copyUpTo: $=	"remove padding"! !

!Base64MimeConverter class methodsFor: 'encoding' stamp: 'MarcusDenker 7/22/2014 13:18'!
decodeInteger: mimeString 
	"Decode the MIME string into an integer of any length"
	| bytes sum |
	bytes := (self class mimeDecodeToBytes: mimeString readStream) contents.
	sum := 0.
	bytes reverseDo: [ :by | sum := sum * 256 + by ].
	^ sum! !

!Base64MimeConverterTest commentStamp: '<historical>'!
This is the unit test for the class Base64MimeConverter. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see: 
	- http://www.c2.com/cgi/wiki?UnitTest
	- there is a chapter in the PharoByExample book (http://pharobyexample.org/)
	- the sunit class category!
!Base64MimeConverterTest methodsFor: 'tests' stamp: 'HenrikSperreJohansen 6/25/2012 12:31'!
testDecodeMimeHeader
        "Test MIME decoding from single-byte encoding to Unicode"
        "self run: #testDecodeMimeHeader"
        | mimeHeader expected multiStream characters|
        characters := #[16rBE 16rFD 16r5F 16rE1 16r2E 16rC8] asString.
        mimeHeader := '=?ISO-8859-2?Q?=BE=FD=5F=E1=2E=C8?=' decodeMimeHeader.
      
        expected := characters convertFromEncoding: 'ISO-8859-2'.
        
        self assert: mimeHeader = expected! !

!Base64MimeConverterTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/16/2010 12:54'!
testMimeEncodeDecode
	"self run: #testMimeEncodeDecode"
	
	| encoded |
	encoded := Base64MimeConverter mimeEncode: message.
	self assert: (encoded contents = 'SGkgVGhlcmUh').
      self assert: ((Base64MimeConverter mimeDecodeToChars: encoded) contents = message contents).

	"Encoding should proceed from the current stream position."
	message reset.
	message skip: 2.
	encoded := Base64MimeConverter mimeEncode: message.
	self assert: (encoded contents = 'IFRoZXJlIQ==').! !

!Base64MimeConverterTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/16/2010 12:45'!
testBase64Encoded
	"self run: #testBase64Encoded"
	
	| encoded |
	encoded := (Base64MimeConverter mimeEncode: message) contents.
	self assert: encoded = 'Hi There!!' base64Encoded.
	! !

!Base64MimeConverterTest methodsFor: 'setup' stamp: 'StephaneDucasse 1/16/2010 12:53'!
setUp
	message := 'Hi There!!' readStream.! !

!Base64MimeConverterTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/16/2010 12:54'!
testOnByteArray
	"self run: #testOnByteArray"
	
	self assert: ('Hi There!!' base64Encoded = 'Hi There!!' asByteArray base64Encoded)! !

!BaseSlot commentStamp: 'MarcusDenker 4/1/2015 10:57'!
I am a hidden non-virtual slot that the virtual slots BooleanSlot and PropertySlot store into.

They, when a class is created containing it, makes sure that there is one slot of me defined. When the last virtual slot is removed, I am removed.!
!BaseSlot methodsFor: 'testing' stamp: 'MarcusDenker 4/1/2015 10:53'!
isVisible
	^ false! !

!BaseSlot methodsFor: 'initalize' stamp: 'MarcusDenker 4/1/2015 10:54'!
initialize: anObject
	self write: default to: anObject! !

!BaseSlot methodsFor: 'initalize' stamp: 'MarcusDenker 4/1/2015 10:54'!
default: anObject
	default := anObject! !

!BaseSlot methodsFor: 'meta-object-protocol' stamp: 'MarcusDenker 4/1/2015 10:53'!
wantsInitalization
	"if a slot wants to hable initalization, return true here"
	^true! !

!BaseStreamTest methodsFor: 'testing' stamp: 'Cami 7/9/2012 10:52'!
testReadOnlyFileNamed
	| testString fileName file |
	"Given"
	fileName := self testFileName.
	testString := 'testString'.
	"When"
	[self baseStreamType
		fileNamed: fileName
		do: [:streamType | streamType nextPut: testString].
	"Then"
	file := self baseStreamType readOnlyFileNamed: fileName.
	self assert: file next = testString.
	file close]
		ensure: [ fileName asFileReference delete ]! !

!BaseStreamTest methodsFor: 'accessing' stamp: 'CarloTeixeira 2/26/2012 00:19'!
baseStreamType
	"Answer the stream type to be tested"
	self shouldBeImplemented.! !

!BaseStreamTest methodsFor: 'accessing' stamp: 'Cami 7/9/2012 10:51'!
testFileName
	^ self class name,'_', testSelector , '_test'! !

!BaseStreamTest methodsFor: 'testing' stamp: 'S 6/17/2013 13:16'!
testFileNamed
	| testString fileName |
	"Given"
	fileName := self testFileName.
	testString := 'testString'.
	"When"
	[self baseStreamType
		fileNamed: fileName
		do: [:streamType | streamType nextPut: testString].
	"Then"
	self baseStreamType
		fileNamed: fileName
		do: [:streamType | self assert: streamType next = testString]]
		ensure: [ (FileSystem disk workingDirectory / fileName) ensureDelete ].! !

!BaseStreamTest class methodsFor: 'as yet unclassified' stamp: 'CarloTeixeira 2/26/2012 00:23'!
isAbstract
	^ self = BaseStreamTest.! !

!BaseStreamTest class methodsFor: 'as yet unclassified' stamp: 'CarloTeixeira 2/26/2012 00:25'!
isUnitTest
	^false! !

!BaselineOf commentStamp: 'dkh 5/30/2012 16:30'!
You should use a *baseline* when you are using a disk-based source
code manager (SCM) like [git][1].

When using a disk-based SCM it is not necessary to use the Metacello
*version* method, because it is intended for use with `.mcz` files. 

With a disk-based SCM you only need a single `baseline:` method. When
you change the structure of your project you can change the baseline and
save everything in a single commit. So multiple `baseline:` methods are
no longer needed.

You may still need a *configuration* when using a *baseline*. The
[Sample project][3] on GitHub has a good example of a configuration used
in conjunction with a *baseline*. See the [**ConfigurationOf** class comment][2] 
for information on creating a *configuration*.

To create a new Metacello baseline:

1. Create a subclass of the **BaselineOf** class. The baseline
   class for your project should be named by appending the name of
   your project to the string `BaselineOf`. The name of the category and
   package should be the same as the name of the class:

    ```Smalltalk
    BaselineOf subclass: #BaselineOfExample
      instanceVariableNames: ''
      classVariableNames: ''
      poolDictionaries: ''
      category: 'BaselineOfExample'
    ```

2. Create a **baseline:** method where you specify the structure of your project:

    ```Smalltalk
    baseline: spec
      <baseline>

      spec for: #common do: [
        spec
          package: 'Example-Core';
          package: 'Example-Tests' with: [
            spec requires: 'Example-Core' ]].
    ```

3. Create a Monticello package for your **BaselineOf** class and save it in the repository where your packages are stored.

[1]: http://git-scm.com/
[2]: https://github.com/dalehenrich/metacello-work/blob/master/repository/Metacello-Base.package/ConfigurationOf.class/README.md
[3]: https://github.com/dalehenrich/sample/tree/configuration/ConfigurationOfSample.package/ConfigurationOfSample.class
!
!BaselineOf methodsFor: 'accessing' stamp: 'dkh 6/22/2012 12:09'!
versionNumberClass
    ^ MetacelloVersionNumber! !

!BaselineOf methodsFor: 'accessing' stamp: 'dkh 5/31/2012 17:57:13'!
projectClass
    ^ MetacelloMCBaselineProject! !

!BasicBehaviorClassMetaclassTest commentStamp: '<historical>'!
This class contains some tests regarding the classes 
	Behavior
		ClassDescription
			Class
			Metaclass
---
	!
!BasicBehaviorClassMetaclassTest methodsFor: 'testing' stamp: 'sd 6/5/2005 08:12'!
testMetaclassNumberOfInstances
	"self run: #testMetaclassNumberOfInstances"

	self assert: Dictionary class allInstances size  = 1.
	self assert: OrderedCollection class allInstances size  = 1.! !

!BasicBehaviorClassMetaclassTest methodsFor: 'testing' stamp: 'sd 6/5/2005 08:21'!
testObjectAllSubclasses
	"self run: #testObjectAllSubclasses"

	| n2 |
	n2 := Object allSubclasses size.
	self assert: n2 = (Object allSubclasses
			select: [:cls | cls class class == Metaclass
					or: [cls class == Metaclass]]) size! !

!BasicBehaviorClassMetaclassTest methodsFor: 'testing' stamp: 'sd 6/5/2005 08:18'!
testMetaclassPointOfCircularity
	"self run: #testMetaclassPointOfCircularity"

	self assert: Metaclass class instanceCount = 1.
	self assert: Metaclass class someInstance == Metaclass.


	
	
	



	
	

	! !

!BasicBehaviorClassMetaclassTest methodsFor: 'testing' stamp: 'sd 6/5/2005 08:12'!
testMetaclassName
	"self run: #testMetaclassName"

	self assert: Dictionary class  name = 'Dictionary class'.
	self assert: OrderedCollection class name = 'OrderedCollection class'.
	! !

!BasicBehaviorClassMetaclassTest methodsFor: 'testing' stamp: 'sd 6/5/2005 08:17'!
testMetaclass
	"self run: #testMetaclass"
	
	self assert: OrderedCollection class class == Metaclass.
	self assert: Dictionary class class == Metaclass.
	self assert: Object class class == Metaclass.




	
	
	



	
	

	! !

!BasicBehaviorClassMetaclassTest methodsFor: 'testing' stamp: 'sd 6/5/2005 08:14'!
testMetaclassSuperclassHierarchy
	"self run: #testMetaclassSuperclassHierarchy"

	| s |
	self assert: SequenceableCollection class instanceCount  = 1.
	self assert: Collection class instanceCount  = 1.
	self assert: Object class instanceCount  = 1.
	self assert: ProtoObject class instanceCount  = 1.
	
	s := OrderedCollection new.
	s add: SequenceableCollection class.
	s add: Collection class.
	s add: Object class.
	s add: ProtoObject class.

	s add: Class.
	s add: ClassDescription.
	s add: Behavior.
	s add: Object.
	s add: ProtoObject.

	self assert: OrderedCollection class allSuperclasses  = s.



	
	

	! !

!BasicBehaviorClassMetaclassTest methodsFor: 'testing' stamp: 'sd 6/5/2005 08:19'!
testBehaviorClassClassDescriptionMetaclassHierarchy
	"self run: #testBehaviorClassClassDescriptionMetaclassHierarchy"
	
	self assert: Class superclass  == ClassDescription.
	self assert: Metaclass superclass == ClassDescription.

	self assert: ClassDescription superclass  == Behavior.
	self assert: Behavior superclass  = Object.

	self assert: Class class class ==  Metaclass.
	self assert: Metaclass class class  == Metaclass.
	self assert: ClassDescription class class == Metaclass.
	self assert: Behavior class class == Metaclass.




	
	
	



	
	

	! !

!BasicBehaviorClassMetaclassTest methodsFor: 'testing' stamp: 'StephaneDucasse 5/12/2010 10:18'!
testMetaclassSuperclass
	"self run: #testMetaclassSuperclass"

	self assert: Dictionary class superclass == Dictionary superclass class.
	self assert: OrderedCollection class superclass == OrderedCollection superclass class.! !

!BasicBehaviorClassMetaclassTest methodsFor: 'testing' stamp: 'StephaneDucasse 5/12/2010 10:18'!
testSuperclass
	"self debug: #testSuperclass"

	| s b |
	s := OrderedCollection new.
	b := [:cls | cls ifNotNil: [s add: cls. b value: cls superclass] ].
	b value: OrderedCollection.

	self assert: OrderedCollection allSuperclasses = s allButFirst.
	self assert: OrderedCollection withAllSuperclasses = s.! !

!BasicCommandLineHandler commentStamp: '<historical>'!
I'm a command line handler who is not aware of any UI or Tools present in the system.
I'm used as base handler for loading executing stripped images (kernel images, for example). 

My usage is the same as PharoCommandLineHandler, see his comment as better explanation.!
!BasicCommandLineHandler methodsFor: 'activation' stamp: 'CamilloBruni 5/26/2013 14:05'!
handleArgument: aString

	"give priority to subcommands"
	self handleSubcommand == self
		ifFalse: [ ^ self ].

	"check for default options"
	aString ifEmpty: [ ^ self default ].
	
	aString = '--version'
		ifTrue: [ ^ self version ].
		
	aString = '--help'
		ifTrue: [ ^ self help ].
		
	aString = '--list'
		ifTrue: [ ^ self list ].
		
	aString = '--copyright'
		ifTrue: [ ^ self copyright ].
		
	aString = '--no-quit'
		ifTrue: [ ^ self noQuit ].
	
	"none of the previous options matched hence we output an error message"
	self error.! !

!BasicCommandLineHandler methodsFor: 'activation' stamp: 'EstebanLorenzano 5/23/2013 14:27'!
activateSubCommand: aCommandLinehandler
	[ aCommandLinehandler activateWith: commandLine ] on: Exit do: [ :exit |
		^ self handleExit: exit for: aCommandLinehandler ].
	"the return value of this method is used to check if the subcommand was successfull"
	^ aCommandLinehandler! !

!BasicCommandLineHandler methodsFor: 'private' stamp: 'DamienCassou 12/11/2013 15:35'!
selectHandlers
	| handlers |
	handlers := (self subCommandsRoot selectHandlersFor: commandLine) copyWithout: self class.
	handlers := handlers sort: [ :a :b | a priority >= b priority ].
	^ handlers! !

!BasicCommandLineHandler methodsFor: 'commands' stamp: 'EstebanLorenzano 5/23/2013 14:27'!
version
	self stdout 
		nextPutAll: 'Image: '; print: SystemVersion current; cr;
		nextPutAll: 'VM:    '; nextPutAll: Smalltalk vm version; cr.
	self quit.! !

!BasicCommandLineHandler methodsFor: 'activation' stamp: 'EstebanLorenzano 5/23/2013 15:33'!
handleSubcommand
	"check if there is an active subcommand"
	
	| handlers |
	
	handlers := self selectHandlers.
	
	"If there is no handler, use myself"
	handlers ifEmpty: [ ^ self ].
		
	^self activateSubCommand: handlers first .
	! !

!BasicCommandLineHandler methodsFor: 'private' stamp: 'DamienCassou 12/11/2013 15:35'!
subCommandsRoot
	^ CommandLineHandler! !

!BasicCommandLineHandler methodsFor: 'initialization' stamp: 'EstebanLorenzano 5/23/2013 14:27'!
initialize
	super initialize.
	commandLine := CommandLineArguments new! !

!BasicCommandLineHandler methodsFor: 'commands' stamp: 'CamilloBruni 5/26/2013 14:08'!
default
	^ self 
		help;
		exitSuccess! !

!BasicCommandLineHandler methodsFor: 'activation' stamp: 'EstebanLorenzano 5/23/2013 14:27'!
handleExit: exit 
	^ self handleExit: exit  for: self! !

!BasicCommandLineHandler methodsFor: 'activation' stamp: 'EstebanLorenzano 5/23/2013 14:27'!
handleExit: exit for: aCommandLinehandler

	Smalltalk isInteractive 
		ifFalse: [ ^ exit pass ].
		
	exit isSuccess 
		ifFalse: [ ^ Error signal: exit messageText ].
	
	self inform: aCommandLinehandler name, ' successfully finished'.
		
	"for failing subcommands return self which is used to check if the subcommand failed"
	exit isSuccess 
		ifTrue: [ ^ aCommandLinehandler ].! !

!BasicCommandLineHandler methodsFor: 'private' stamp: 'CamilloBruni 5/26/2013 13:59'!
selectedHandler
	^ self selectHandlers 
		ifEmpty: [ nil ] 
		ifNotEmpty: [ :handlers | handlers first ]! !

!BasicCommandLineHandler methodsFor: 'activation' stamp: 'CamilloBruni 5/26/2013 13:42'!
handleEmptyArguments
	Smalltalk isHeadless
		ifFalse: [ ^ self ].
	
	self help.! !

!BasicCommandLineHandler methodsFor: 'commands' stamp: 'CamilloBruni 5/26/2013 14:01'!
noQuit
	"Nothing to be done, unlike the other commands the image continues running"! !

!BasicCommandLineHandler methodsFor: 'commands' stamp: 'EstebanLorenzano 5/23/2013 14:27'!
copyright
	self stdout 
		nextPutAll: Smalltalk licenseString; cr.
	self quit.! !

!BasicCommandLineHandler methodsFor: 'commands' stamp: 'CamilloBruni 9/4/2013 17:13'!
list
	| handlers shortNames maxShortNameSize |
	self stdout 
		nextPutAll: 'Currently installed Command Line Handlers:'; lf.

	handlers := self allHandlers reject: [ :cls | 
			cls includesBehavior: BasicCommandLineHandler ].
	shortNames := handlers collect: #commandName.
	maxShortNameSize := (shortNames detectMax: [ :name|  name size ]) size.
	
	handlers do: [ :handler|
		self stdout 
			nextPutAll: '    ';
			nextPutAll: (handler commandName padRightTo: maxShortNameSize); 
			nextPutAll: '    ';
			nextPutAll: (handler description ifNil: [ '--']); lf].
	self quit.! !

!BasicCommandLineHandler methodsFor: 'activation' stamp: 'StephaneDucasse 8/22/2013 23:21'!
activate
	
	[ self handleArgument: (self arguments 
			ifEmpty: [ '' ] 
			ifNotEmpty: [ :arguments| arguments first ])] 
		on: Exit 
		do: [ :exit | ^ self handleExit: exit ]! !

!BasicCommandLineHandler methodsFor: 'commands' stamp: 'EstebanLorenzano 5/23/2013 14:27'!
error
	self arguments size = 1
		ifTrue:  [
			(self arguments first beginsWith: '-')
				ifTrue:  [ self << 'Invalid option: ']
				ifFalse: [ self << 'Invalid sub command: ']]
		ifFalse: [ self << 'Invalid arguments: "'].
		
	(self << (' ' join: self arguments)) 
		nextPutAll: '"'; cr.
		
	self printHelp.
	
	self exitFailure.! !

!BasicCommandLineHandler class methodsFor: 'handler selection' stamp: 'EstebanLorenzano 5/23/2013 15:10'!
isResponsibleFor: aCommandLine
	"I do not match ever, because my activation is manual"
	^ false! !

!BasicCommandLineHandler class methodsFor: 'class initialization' stamp: 'SeanDeNigris 10/4/2013 13:14'!
initialize 
	"hook into the startup list"
	Smalltalk addToStartUpList: self.! !

!BasicCommandLineHandler class methodsFor: 'accessing' stamp: 'CamilloBruni 5/31/2013 11:32'!
priority 
	"Lowest priority"
	^ Float infinity negated! !

!BasicCommandLineHandler class methodsFor: 'handler selection' stamp: 'EstebanLorenzano 5/23/2013 14:30'!
description
	^ 'basic responsible for the default options and activating other commands'! !

!BasicCommandLineHandler class methodsFor: 'class initialization' stamp: 'EstebanLorenzano 5/23/2013 14:31'!
startUp: resuming

	"only handle when lauching a new image"
	resuming ifFalse: [ ^ self ].

	Smalltalk addDeferredStartupAction: [ self new activate ]	
! !

!BasicCommandLineHandler class methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/23/2013 14:28'!
commandName
	^ ''! !

!BasicIndexedEyeElement commentStamp: '<historical>'!
I am an eye element for indexable fields. (basicAt:)!
!BasicIndexedEyeElement methodsFor: 'action' stamp: 'ClementBera 4/30/2013 15:33'!
save: aValue
	self host basicAt: self index put: aValue! !

!BasicIndexedEyeElement methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 3/30/2014 13:09'!
= anObject
	^ super = anObject and: [ index = anObject index ]! !

!BasicIndexedEyeElement methodsFor: 'accessing' stamp: 'ClementBera 4/30/2013 12:59'!
value
	^ self host basicAt: self index! !

!BasicIndexedEyeElement methodsFor: 'accessing' stamp: 'ClementBera 4/30/2013 13:04'!
accessorCode
	^ '(self basicAt: ', self index asString, ')'! !

!BasicIndexedEyeElement methodsFor: 'accessing' stamp: 'ClementBera 4/30/2013 16:09'!
label
	^ self index printString! !

!BasicIndexedEyeElement methodsFor: 'accessing' stamp: 'ClementBera 4/30/2013 12:56'!
index: anObject
	index := anObject! !

!BasicIndexedEyeElement methodsFor: 'comparing' stamp: 'MarcusDenker 8/8/2014 09:53'!
hash
	^ index hash! !

!BasicIndexedEyeElement methodsFor: 'accessing' stamp: 'ClementBera 4/30/2013 12:56'!
index
	^ index! !

!BasicIndexedEyeElement class methodsFor: 'instance creation' stamp: 'ClementBera 4/30/2013 12:55'!
host: anObject index: index
	^ (self host: anObject) index: index! !

!BecomeTest methodsFor: 'testing' stamp: 'brp 9/19/2003 15:30'!
testBecomeHash

	| a b c d ha hb |

	a := 'ab' copy.
	b := 'cd' copy.
	c := a.
	d := b.
	ha := a hash.
	hb := b hash.

	a become: b.

	self 
		assert: a hash = hb;
		assert: b hash = ha;
		assert: c hash = hb;
		assert: d hash = ha.


! !

!BecomeTest methodsFor: 'testing' stamp: 'brp 9/19/2003 15:28'!
testBecomeForward
	"Test the forward become."
	| a b c d |

	a := 'ab' copy.
	b := 'cd' copy.
	c := a.
	d := b.

	a becomeForward: b.

	self 
		assert: a = 'cd';
		assert: b = 'cd';
		assert: c = 'cd';
		assert: d = 'cd'.


! !

!BecomeTest methodsFor: 'testing' stamp: 'brp 9/19/2003 15:29'!
testBecomeForwardHash

	| a b c hb |

	a := 'ab' copy.
	b := 'cd' copy.
	c := a.
	hb := b hash.

	a becomeForward: b.

	self 
		assert: a hash = hb;
		assert: b hash = hb;
		assert: c hash = hb.


! !

!BecomeTest methodsFor: 'testing' stamp: 'brp 9/19/2003 15:27'!
testBecomeForwardIdentityHash
	"Check that
		1. the argument to becomeForward: is modified to have the receiver's identity hash.
		2. the receiver's identity hash is unchanged."

 	| a b ha |

	a := 'ab' copy.
	b := 'cd' copy.
	ha := a identityHash.

	a becomeForward: b.

	self 
		assert: a identityHash = ha;
		assert: b identityHash = ha.

! !

!BecomeTest methodsFor: 'testing' stamp: 'MartinDias 7/1/2013 15:09'!
testBecomeForwardDontCopyIdentityHash
	"Check that
		1. the argument to becomeForward: is NOT modified to have the receiver's identity hash.
		2. the receiver's identity hash is unchanged."

 	| a b identityHashOfB |

	a := 'ab' copy.
	b := 'cd' copy.
	identityHashOfB := b identityHash.

	a becomeForward: b copyHash: false.

	self 
		assert: a == b;
		assert: a identityHash = identityHashOfB;
		assert: b identityHash = identityHashOfB.

! !

!BecomeTest methodsFor: 'testing' stamp: 'MartinDias 7/1/2013 15:09'!
testBecomeForwardCopyIdentityHash
	"Check that
		1. the argument to becomeForward: IS modified to have the sender's identity hash.
		2. the sender's identity hash is unchanged."

 	| a b identityHashOfA |

	a := 'ab' copy.
	b := 'cd' copy.
	identityHashOfA := a identityHash.

	a becomeForward: b copyHash: true.

	self 
		assert: a == b;
		assert: a identityHash = identityHashOfA;
		assert: b identityHash = identityHashOfA.

! !

!BecomeTest methodsFor: 'testing' stamp: 'brp 9/19/2003 15:31'!
testBecomeIdentityHash
	"Note. The identity hash of both objects seems to change after the become:"

	| a b c d |

	a := 'ab' copy.
	b := 'cd' copy.
	c := a.
	d := b.

	a become: b.

	self 
		assert: a identityHash = c identityHash;
		assert: b identityHash = d identityHash;
		deny: a identityHash = b identityHash.
! !

!BecomeTest methodsFor: 'testing' stamp: 'brp 9/19/2003 15:28'!
testBecome
	"Test the two way become. Note. we cannot use string literals for this test"
	| a b c d |

	a := 'ab' copy.
	b := 'cd' copy.
	c := a.
	d := b.

	a become: b.

	self 
		assert: a = 'cd';
		assert: b = 'ab';
		assert: c = 'cd';
		assert: d = 'ab'.


! !

!Beeper commentStamp: 'gk 2/26/2004 22:44'!
Beeper provides simple audio (or in some other way) feedback to the user.

The recommended use is "Beeper beep" to give the user the equivalence of a beep. If you want to force the beep to use the primitive in the VM for beeping, then use "Beeper beepPrimitive". In either case, if sounds are disabled there will be no beep.

The actual beeping, when you use "Beeper beep", is done by sending a #play message to a registered playable object. You can register your own playable object by invoking the class side method #setDefault: passing in an object that responds to the #play message.

The default playable object is an instance of Beeper itself which implements #play on the instance side. That implementation delegates the playing of the beep to the default SoundService.

Note that #play is introduced as a common interface between AbstractSound and Beeper.
This way we can register instances of AbstractSound as playable entities, for example:

	Beeper setDefault: (SampledSound new
						setSamples: self coffeeCupClink
						samplingRate: 12000).

Then "Beeper beep" will play the coffeeCup sound.!
!Beeper methodsFor: 'play interface' stamp: 'CamilloBruni 5/8/2013 11:41'!
play
	"This is how the default Beeper makes a beep,
	by sending beep to the default sound service.
	The sound system will check if sounds are enabled."

	(#SoundService asClassIfAbsent: [ ^ self ]) default new beep! !

!Beeper class methodsFor: 'customize' stamp: ''!
setDefault: aPlayableEntity
	"Set the playable entity used when making a beep.
	The playable entity should implement the message #play."

	default := aPlayableEntity! !

!Beeper class methodsFor: 'customize' stamp: ''!
clearDefault
	"Clear the default playable.
	Will be lazily initialized in Beeper class >>default."

	default := nil! !

!Beeper class methodsFor: 'customize' stamp: 'ClementBera 7/26/2013 16:12'!
default
	"When the default is not defined it is
	initialized using #newDefault."

	^ default ifNil: [default := self newDefault ] ! !

!Beeper class methodsFor: 'beeping' stamp: ''!
beep
	"The preferred way of producing an audible feedback.
	The default playable entity (an instance of Beeper)
	also uses the pluggable SoundService
	mechanism, so it will use the primitive beep only
	if there is no other sound mechanism available."
	
	self default 
		ifNil: [self beepPrimitive]
		ifNotNil: [ self default play].
! !

!Beeper class methodsFor: 'private' stamp: ''!
primitiveBeep
	"Make a primitive beep. Not to be called directly.
	It is much better to use Beeper class>>beep
	or Beeper class>>beepPrimitive
	since this method bypasses the current
	registered playable entity and does not
	check SoundSettings class>>soundEnabled."

	<primitive: 140>
	self primitiveFailed! !

!Beeper class methodsFor: 'customize' stamp: ''!
newDefault
	"Subclasses may override me to provide a default beep.
	This base implementation returns an instance of Beeper
	which uses the pluggable sound service."

	^ self new! !

!Beeper class methodsFor: 'beeping' stamp: 'NorbertHartl 2/19/2014 11:54'!
beepPrimitive
	"Make a primitive beep. Only use this if
	you want to force this to be a primitive beep.
	Otherwise use Beeper class>>beep
	since this method bypasses the current
	registered playable entity."

	SoundSystem current soundEnabled
		ifTrue: [self primitiveBeep]! !

!Behavior commentStamp: 'al 12/8/2005 20:44'!
My instances describe the behavior of other objects. I provide the minimum state necessary for compiling methods, and creating and running instances. Most objects are created as instances of the more fully supported subclass, Class, but I am a good starting point for providing instance-specific behavior (as in Metaclass).!
!Behavior methodsFor: 'traits' stamp: ''!
noteChangedSelectors: aCollection
	"Start update of my methodDict (after changes to traits in traitComposition
	or after a local method was removed from my methodDict). The argument 
	is a collection of method selectors that may have been changed. Most of the time
	aCollection only holds one selector. But when there are aliases involved 
	there may be several method changes that have to be propagated to users."

	| affectedSelectors |
	affectedSelectors := IdentitySet new.
	aCollection do: [:selector |
		affectedSelectors addAll: (self updateMethodDictionarySelector: selector)].
	self notifyUsersOfChangedSelectors: affectedSelectors.
	^ affectedSelectors! !

!Behavior methodsFor: 'enumerating' stamp: ''!
allUnreferencedInstanceVariables
	"Return a list of the instance variables known to the receiver which are not referenced in the receiver or any of its subclasses OR superclasses"

	^ self allInstVarNames reject: [:ivn |
		| definingClass |		
		definingClass := self classThatDefinesInstanceVariable: ivn.
		definingClass withAllSubclasses anySatisfy: [:class |  
				(class whichSelectorsAccess: ivn asSymbol) notEmpty]]! !

!Behavior methodsFor: 'private' stamp: ''!
becomeCompact
	"Make me compact.
	This means: 
	- find a free slot in 'Smalltalk compactClassArray'
	- add me in that array
	- update my format with the index
	- update my instances
	"
	| compactClassesArray index |
	self isWeak 
		ifTrue: [^ self error: 'You must not make a weak class compact'].
	compactClassesArray := Smalltalk compactClassesArray.
	(self isCompact or: [compactClassesArray includes: self])
		ifTrue: [^ self error: self name , 'is already compact'].
	index := compactClassesArray indexOf: nil
		ifAbsent: [^ self error: 'compact class table is full'].
	"Install this class in the compact class table"
	compactClassesArray at: index put: self.

	"Update instspec so instances will be compact. 
	The layout has the responsibility for setting the format."
	self layout compactClassIndex: index.

	"Make up new instances and become old ones into them"
	self updateInstancesFrom: self.
	"Purge any old instances"
	Smalltalk garbageCollect.! !

!Behavior methodsFor: 'testing' stamp: ''!
isObsolete
	"Return true if the receiver is obsolete."
	^self instanceCount = 0! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
methodDictionary
	^self methodDict! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
compiledMethodAt: selector ifAbsent: aBlock
	"Answer the compiled method associated with the argument, selector (a Symbol), a message selector in the receiver's method dictionary. If the selector is not in the dictionary, return the value of aBlock"

	^ self methodDict at: selector ifAbsent: aBlock! !

!Behavior methodsFor: 'accessing class hierarchy' stamp: ''!
allSuperclassesIncluding: aClass
	"Answer an OrderedCollection of the receiver's and the receiver's  ancestor's superclasses
	up to aClass included. If aClass is not part of the receiver's superclass, returns up to the root."
	| temp |
	self class == ProtoObject class ifTrue: [ ^ OrderedCollection new].
	^ self superclass == aClass
		ifTrue: [ OrderedCollection with: aClass]
		ifFalse: [temp := self superclass allSuperclassesIncluding: aClass.
			temp addFirst: self superclass.
			temp]! !

!Behavior methodsFor: 'queries' stamp: ''!
copiesFromSuperclass: method
	"Checks whether the receiver copied the argument,  method, from its superclasses"
	
	self allSuperclassesDo: [ :cls|
		(cls includesSelector: method selector)
			ifTrue: [ ^ (cls >> method selector) sourceCode  = method sourceCode]].
	^ false! !

!Behavior methodsFor: 'testing method dictionary' stamp: ''!
whichSelectorsReferTo: literal special: specialFlag byte: specialByte
	"Answer a set of selectors whose methods access the argument as a literal."

	| who |
	who := IdentitySet new.
	self selectorsAndMethodsDo: 
		[:sel :method |
		((method hasLiteral: literal) or: [specialFlag and: [method scanFor: specialByte]])
			ifTrue:
				[((literal isVariableBinding) not
					or: [method literals allButLast identityIncludes: literal])
						ifTrue: [who add: sel]]].
	^ who! !

!Behavior methodsFor: 'initialization' stamp: ''!
initializeSlots: anObject 
	self layout initializeInstance: anObject! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
supermostPrecodeCommentFor: selector 
	"Answer a string representing the precode comment in the most distant 
	superclass's implementation of the selector. Return nil if none found."
	| aSuper superComment |
	(self == Behavior
			or: [self superclass == nil
					or: [(aSuper := self superclass whichClassIncludesSelector: selector) == nil]])
		ifFalse: ["There is a super implementor"
			superComment := aSuper supermostPrecodeCommentFor: selector].
	^ superComment
		ifNil: [self firstPrecodeCommentFor: selector
			"ActorState supermostPrecodeCommentFor: #printOn:"]! !

!Behavior methodsFor: 'initialization' stamp: ''!
emptyMethodDictionary

	^ MethodDictionary new! !

!Behavior methodsFor: 'user interface' stamp: ''!
withAllSubAndSuperclassesDo: aBlock

	self withAllSubclassesDo: aBlock.
	self allSuperclassesDo: aBlock.
! !

!Behavior methodsFor: 'queries' stamp: ''!
copiedFromSuperclass: method
	"Returns the methods that the receiver copied with its ancestors"
	
	self allSuperclassesDo: [ :cls|
		(cls includesSelector: method selector)
			ifTrue: [ 
				((cls >> method selector) sourceCode  = method sourceCode)
					ifTrue: [ ^ {cls >> method selector}]
					ifFalse: [ ^ #()]]].
	^ #().
	! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
localSelectors: aSet 
	self basicLocalSelectors: aSet! !

!Behavior methodsFor: 'queries' stamp: ''!
whichSelectorsRead: aString
	
	| index |
	index := self
		instVarIndexFor: aString
		ifAbsent: [ ^ IdentitySet new ].
	^ self selectors select: [ :each |
		(self compiledMethodAt: each)
			readsField: index ]! !

!Behavior methodsFor: 'initialization' stamp: ''!
initialize
	"moved here from the class side's #new"
	super initialize.
	self superclass: Object.
	"no longer sending any messages, some of them crash the VM"
	self methodDict: self emptyMethodDictionary.
	self setFormat: Object format.
	self traitComposition: nil.
	self users: IdentitySet new.! !

!Behavior methodsFor: 'system startup' stamp: ''!
startUp
	"This message is sent to registered classes when the system is coming up."
 ! !

!Behavior methodsFor: 'testing' stamp: ''!
isPointers
	"Answer whether the receiver contains just pointers (not bits)."

	^self isBits not! !

!Behavior methodsFor: 'testing' stamp: 'SebastianTleye 7/16/2013 17:04'!
instSize
	"Answer the number of named instance variables
	(as opposed to indexed variables) of the receiver."

	self flag: #instSizeChange.  "Smalltalk browseAllCallsOn: #instSizeChange"
"
	NOTE: This code supports the backward-compatible extension to 8 bits of instSize.
	When we revise the image format, it should become...
	^ ((format bitShift: -1) bitAnd: 16rFF) - 1
	Note also that every other method in this category will require
	2 bits more of right shift after the change.
"
	^ ((self format bitShift: -10) bitAnd: 16rC0) + ((self format bitShift: -1) bitAnd: 16r3F) - 1! !

!Behavior methodsFor: '*OpalCompiler-Core' stamp: ''!
evaluate: aString
	^self compiler evaluate: aString! !

!Behavior methodsFor: 'traits' stamp: ''!
setTraitComposition: aTraitComposition
	| oldComposition |
	(self hasTraitComposition not and: [aTraitComposition isEmpty]) ifTrue: [^self].
	aTraitComposition assertValidUser: self.

	oldComposition := self traitComposition.
	self traitComposition: aTraitComposition.
	self applyChangesOfNewTraitCompositionReplacing: oldComposition.
	
	oldComposition traits do: [:each | each removeUser: self].
	aTraitComposition traits do: [:each | each addUser: self]! !

!Behavior methodsFor: '*ast-core' stamp: ''!
parseTreeFor: aSymbol	
	^ RBParser parseMethod: (self sourceCodeAt: aSymbol) onError: [ :msg :pos | ^ nil ]! !

!Behavior methodsFor: 'private' stamp: ''!
becomeCompactSimplyAt: index
	"The same as #becomeCompact but without updating my instances."

	| compactClassesArray |

	self isWeak 
		ifTrue: [^ self error: 'You must not make a weak class compact'].
	compactClassesArray := Smalltalk compactClassesArray.
	(self isCompact or: [compactClassesArray includes: self])
		ifTrue: [^ self error: self name, 'is already compact'].		
	(compactClassesArray at: index) ifNotNil: [^ self error: 'compact table slot already in use'].
	"Install this class in the compact class table"
	compactClassesArray at: index put: self.

	"Update instspec so instances will be compact. 
	The layout has the responsibility for setting the format."
	self layout compactClassIndex: index.! !

!Behavior methodsFor: 'adding/removing methods' stamp: ''!
addSelector: selector withMethod: compiledMethod notifying: requestor
	^ self addSelectorSilently: selector withMethod: compiledMethod! !

!Behavior methodsFor: '*System-Support' stamp: ''!
referencedClasses
	"Return the set of classes that are directly referenced by my methods"

	| answer |
	answer := Set new.
	self methods do: [ :cm |
		answer addAll: 
			( cm literals select: [ :l | l isKindOf: Association ] thenCollect: #value ) ].
		
	^ answer! !

!Behavior methodsFor: 'accessing-properties' stamp: 'MarcusDenker 3/2/2015 18:18'!
properties
	^ ClassProperties at: self ifAbsent: nil
		! !

!Behavior methodsFor: 'accessing class hierarchy' stamp: ''!
allSuperclasses
	"Answer an OrderedCollection of the receiver's and the receiver's  
	ancestor's superclasses. The first element is the receiver's immediate  
	superclass, followed by its superclass; the last element is Object."
	| temp |
	^ self superclass == nil
		ifTrue: [ OrderedCollection new]
		ifFalse: [temp := self superclass allSuperclasses.
			temp addFirst: self superclass.
			temp]! !

!Behavior methodsFor: '*OpalCompiler-Core' stamp: ''!
sourceCodeTemplate
	"Answer an expression to be edited and evaluated in order to define 
	methods in this class or trait."

	^ 'messageSelectorAndArgumentNames
	"comment stating purpose of message"

	| temporary variable names |
	statements'! !

!Behavior methodsFor: '*OpalCompiler-Core' stamp: ''!
recompileChanges
	"Compile all the methods that are in the changes file.
	This validates sourceCode and variable references and forces
	methods to use the current bytecode set"

	self selectorsAndMethodsDo:
		[:sel :meth | meth fileIndex > 1 ifTrue:
			[self recompile: sel from: self]]! !

!Behavior methodsFor: 'testing' stamp: ''!
isBits
	"Answer whether the receiver contains just bits (not pointers)."

	^ self instSpec >= 6! !

!Behavior methodsFor: 'accessing instances and variables' stamp: ''!
instanceCount
	"Answer the number of instances of the receiver that are currently in 
	use."

	| count |
	count := 0.
	self allInstancesDo: [:x | count := count + 1].
	^count! !

!Behavior methodsFor: 'queries' stamp: ''!
whichSuperclassSatisfies: aBlock 
	(aBlock value: self) ifTrue: [^self].
	^self superclass ifNotNil: [self superclass whichSuperclassSatisfies: aBlock]! !

!Behavior methodsFor: 'traits' stamp: ''!
removeFromComposition: aTrait
	self setTraitComposition: (self traitComposition copyTraitExpression
		removeFromComposition: aTrait)! !

!Behavior methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterSuperclassesFor: aStep
	<spotterOrder: 40>
	aStep listProcessor
			title: 'All superclasses';
			allCandidates: [ self allSuperclasses ];
			itemIcon: #systemIcon;
			filter: GTFilterSubstring! !

!Behavior methodsFor: 'traits' stamp: ''!
purgeLocalSelectors
	self basicLocalSelectors: nil! !

!Behavior methodsFor: 'accessing' stamp: ''!
format
	"Answer an Integer that encodes the kinds and numbers of variables of 
	instances of the receiver."

	^format! !

!Behavior methodsFor: 'enumerating' stamp: ''!
allSubclassesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the receiver's subclasses."

	self subclassesDo: 
		[:cl | 
		aBlock value: cl.
		cl allSubclassesDo: aBlock]! !

!Behavior methodsFor: 'testing method dictionary' stamp: ''!
isDisabledSelector: selector
	^ self classAndMethodFor: selector do: [:c :m | m isDisabled] ifAbsent: [false]! !

!Behavior methodsFor: 'accessing' stamp: ''!
numberOfInstanceVariables
	^ self instVarNames size
! !

!Behavior methodsFor: 'enumerating' stamp: ''!
allSubInstancesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the current instances of the 
	receiver and all its subclasses."

	self allInstancesDo: aBlock.
	self allSubclassesDo: [:sub | sub allInstancesDo: aBlock]! !

!Behavior methodsFor: '*Ring-Core-Kernel' stamp: ''!
methodsInProtocol: aString

	^ (self organization listAtCategoryNamed: aString) 
			collect: [ :each | (self compiledMethodAt: each) ]! !

!Behavior methodsFor: 'queries' stamp: ''!
methodsAccessingSlot: aSlot
	^self methods select: [ :method | method accessesSlot: aSlot ]! !

!Behavior methodsFor: 'queries' stamp: ''!
whichClassDefinesClassVar: aString 
	Symbol hasInterned: aString ifTrue: [ :aSymbol |
		^self whichSuperclassSatisfies: 
			[:aClass | 
			aClass classVarNames anySatisfy: [:each | each = aSymbol]]].
	^#()! !

!Behavior methodsFor: 'testing' stamp: ''!
isAnonymous
	^true! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
changeRecordsAt: selector
	"Return a list of ChangeRecords for all versions of the method at selector. Source code can be retrieved by sending string to any one.  Return nil if the method is absent."

	"(Pen changeRecordsAt: #go:) collect: [:cRec | cRec string]"
	^ChangeSet 
		scanVersionsOf: (self compiledMethodAt: selector ifAbsent: [^ nil])
		class: self meta: self isMeta
		category: (self whichCategoryIncludesSelector: selector)
		selector: selector.! !

!Behavior methodsFor: 'instance creation' stamp: 'SebastianTleye 7/17/2013 10:06'!
basicNew
	"Primitive. Answer an instance of the receiver (which is a class) with no 
	indexable variables. Fail if the class is indexable. Essential. See Object 
	documentation whatIsAPrimitive."

	<primitive: 70>
	self isVariable ifTrue: [ ^ self basicNew: 0 ].
	"space must be low"
	OutOfMemory signal.
	^ self basicNew  "retry if user proceeds"! !

!Behavior methodsFor: '*OpalCompiler-Core' stamp: ''!
compileAllFrom: oldClass
	"Compile all the methods in the receiver's method dictionary.
	This validates sourceCode and variable references and forces
	all methods to use the current bytecode set"
	
	oldClass localSelectors do: [:sel | self recompile: sel from: oldClass].
	! !

!Behavior methodsFor: 'system startup' stamp: ''!
shutDown
	"This message is sent on system shutdown to registered classes"
! !

!Behavior methodsFor: 'adding/removing methods' stamp: ''!
removeSelectorSilently: selector 
	"Remove selector without sending system change notifications"

	^ SystemAnnouncer uniqueInstance suspendAllWhile: [self removeSelector: selector].! !

!Behavior methodsFor: 'traits' stamp: ''!
hasTraitComposition

	^ self traitComposition notEmpty.! !

!Behavior methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterUsedTraitsFor: aStep
	<spotterOrder: 60>
	aStep listProcessor
			title: 'Uses Traits';
			allCandidates: [ self traits asArray ];
			itemIcon: #systemIcon;
			filter: GTFilterSubstring! !

!Behavior methodsFor: 'adding/removing methods' stamp: ''!
adoptInstance: anInstance
	"Change the class of anInstance to me.
	Primitive (found in Cog and new VMs)  follows the same rules as primitiveChangeClassTo:, but returns the 	class rather than the modified instance"
	<primitive: 160 error: ec>
	anInstance primitiveChangeClassTo: self basicNew.
	^self! !

!Behavior methodsFor: 'accessing instances and variables' stamp: ''!
allSubInstances 
	"Answer a list of all current instances of the receiver and all of its subclasses."
	| aCollection |
	aCollection := OrderedCollection new.
	self allSubInstancesDo:
		[:x | x == aCollection ifFalse: [aCollection add: x]].
	^ aCollection! !

!Behavior methodsFor: 'printing' stamp: ''!
printHierarchy
	"Answer a description containing the names and instance variable names 
	of all of the subclasses and superclasses of the receiver."

	| aStream index |
	index := 0.
	aStream := (String new: 16) writeStream.
	self allSuperclasses reverseDo: 
		[:aClass | 
		aStream crtab: index.
		index := index + 1.
		aStream nextPutAll: aClass name.
		aStream space.
		aStream print: aClass instVarNames].
	aStream cr.
	self printSubclassesOn: aStream level: index.
	^aStream contents! !

!Behavior methodsFor: 'enumerating' stamp: ''!
allSuperclassesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the receiver's superclasses."

	self superclass == nil
		ifFalse: [aBlock value: self superclass.
				self superclass allSuperclassesDo: aBlock]! !

!Behavior methodsFor: 'testing method dictionary' stamp: ''!
hasMethods
	"Answer whether the receiver has any methods in its method dictionary."

	^ self methodDict notEmpty! !

!Behavior methodsFor: 'accessing-properties' stamp: ''!
propertyValueAt: propName put: propValue
	^ self ensureProperties
		at: propName
		ifAbsentPut: propValue
		! !

!Behavior methodsFor: 'testing method dictionary' stamp: ''!
includesSelector: aSymbol 
	"Answer whether the message whose selector is the argument is in the 
	method dictionary of the receiver's class."

	^ self methodDict includesKey: aSymbol! !

!Behavior methodsFor: '*System-Support' stamp: ''!
allUnsentMessages
	"Answer an array of all the messages defined by the receiver that are not sent anywhere in the system."

	^ SystemNavigation new allUnsentMessagesIn: self selectors! !

!Behavior methodsFor: '*OpalCompiler-Core' stamp: ''!
compileAll
	^ self compileAllFrom: self! !

!Behavior methodsFor: 'traits' stamp: ''!
addTraitSelector: aSymbol withMethod: aCompiledMethod
	"Add aMethod with selector aSymbol to my
	methodDict. aMethod must not be defined locally."

	| source method |
	[(self includesLocalSelector: aSymbol) not] assert.
	self ensureLocalSelectors.
		
	source := aCompiledMethod getSourceReplacingSelectorWith: aSymbol.
	method  := aCompiledMethod copy.
	method selector: aSymbol.
	method methodClass: self.
		
	method putSource: source inFile: 2
		withPreamble: [:f | f cr; nextPut: $!!; nextChunkPut: 'Trait method'; cr].
	
	self isTrait ifFalse: [ method properties at: #traitSource put: aCompiledMethod].
	
	self basicAddSelector: aSymbol withMethod: method! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
deregisterLocalSelector: aSymbol
	self basicLocalSelectors notNil ifTrue: [
		self basicLocalSelectors remove: aSymbol ifAbsent: []]! !

!Behavior methodsFor: 'traits' stamp: 'al 3/25/2006 12:36'!
traitComposition
	self subclassResponsibility! !

!Behavior methodsFor: 'testing method dictionary' stamp: ''!
canPerform: selector
	"Answer whether the receiver can safely perform to the message whose selector 
	is the argument: it is not an abstract or cancelled method"

	^ self classAndMethodFor: selector do: [:c :m | m isProvided] ifAbsent: [false].! !

!Behavior methodsFor: 'enumerating' stamp: ''!
allInstancesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the current instances of the 
	receiver.
	
	Because aBlock might change the class of inst (for example, using become:),
	it is essential to compute next before aBlock value: inst."
	| inst next |
	inst := self someInstance.
	[inst == nil]
		whileFalse:
		[
		next := inst nextInstance.
		aBlock value: inst.
		inst := next]! !

!Behavior methodsFor: 'accessing instances and variables' stamp: ''!
allInstVarNames
	"Answer an Array of the names of the receiver's instance variables. The 
	Array ordering is the order in which the variables are stored and 
	accessed by the interpreter."

	| vars |
	self superclass == nil
		ifTrue: [vars := self instVarNames copy]	"Guarantee a copy is answered."
		ifFalse: [vars := self superclass allInstVarNames , self instVarNames].
	^vars! !

!Behavior methodsFor: 'accessing-properties' stamp: ''!
propertyValueAt: propName
	^ self
		propertyValueAt: propName
		ifAbsent: [ nil ]
		! !

!Behavior methodsFor: 'private' stamp: 'sd 11/19/2004 15:13'!
setFormat: aFormatInstanceDescription
	"only use this method with extreme care since it modifies the format of the class 
     ie a description of the number of instance variables and whether the class is
     compact, variable sized"

	format := aFormatInstanceDescription

! !

!Behavior methodsFor: 'dependencies' stamp: ''!
dependentClasses
	"Return the list of classes used myself"
	
	"Morph dependentClasses"
	| cll | 
	cll := Set new.
	"A class depends on its superclass"
	self superclass ifNotNil: [ cll add: self superclass ].
	
	"We unify a class and its metaclass"
	(self methods, self class methods) 
		do: [ :m | m literalsDo: [ :l | 
					"We also check if the method is not an extension"
					((((l isVariableBinding 
					and: [ l value notNil ]) 
					and: [ l value isBehavior ])
					and: [ m category notEmpty ] )
					and: [ m category first ~= $* ])  ifTrue: [ cll add: l value ] ]  ].
	^ cll asArray! !

!Behavior methodsFor: 'queries' stamp: ''!
copiesMethodsFromSuperclass
	"Checks whether the receiver copied some method from its superclass"

	self methodsDo: [ :method|
		(self copiesFromSuperclass: method)
			ifTrue: [ ^ true ]].
	^ false! !

!Behavior methodsFor: 'accessing instances and variables' stamp: ''!
allSharedPools
	"Answer an ordered collection of the shared pools that the receiver and the receiver's ancestors share."

	^self superclass allSharedPools! !

!Behavior methodsFor: 'traits' stamp: 'NicolaiHess 11/27/2014 23:10'!
traitUsers
	"Compatibility purposes"
	^IdentitySet new.! !

!Behavior methodsFor: 'printing' stamp: ''!
literalScannedAs: scannedLiteral notifying: requestor
	"Postprocesses a literal scanned by Scanner scanToken (esp. xLitQuote).
	If scannedLiteral is not an association, answer it.
	Else, if it is of the form:
		nil->#NameOfMetaclass
	answer nil->theMetaclass, if any has that name, else report an error.
	Else, if it is of the form:
		#NameOfGlobalVariable->anythiEng
	answer the global, class, or pool association with that nameE, if any, else
	add it to Undeclared a answer the new Association."

	| key value |
	(scannedLiteral isVariableBinding)
		ifFalse: [^ scannedLiteral].
	key := scannedLiteral key.
	value := scannedLiteral value.
	key ifNil: "###<metaclass soleInstance name>"
			[(self bindingOf: value) ifNotNil:[:assoc|
				 (assoc value isKindOf: Behavior)
					ifTrue: [^ nil->assoc value class]].
			 requestor notify: 'No such metaclass'.
			 ^false].
	(key isSymbol)
		ifTrue: "##<global var name>"
			[(self bindingOf: key) ifNotNil:[:assoc | ^assoc].
			Undeclared at: key put: nil.
			 ^Undeclared bindingOf: key].
	requestor notify: '## must be followed by a non-local variable name'.
	^false

"	Form literalScannedAs: 14 notifying: nil 14
	Form literalScannedAs: #OneBitForm notiEfying: nil  OneBitForm
	Form literalScannedAs: ##OneBitForm notifying: nil  OneBitForm->a Form
	Form literalScannedAs: ##Form notifying: nil   Form->Form
	Form literalScannedAs: ###Form notifying: nil   nilE->Form class
"! !

!Behavior methodsFor: 'accessing class hierarchy' stamp: ''!
superclass
	"Answer the receiver's superclass, a Class."

	^superclass! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
compress
	"Compact the method dictionary of the receiver."

	self methodDict rehash! !

!Behavior methodsFor: 'traits' stamp: 'SebastianTleye 7/4/2013 11:04'!
users
	"Compatibility purposes"
	^IdentitySet new.! !

!Behavior methodsFor: '*NativeBoost-Core' stamp: 'Igor.Stasenko 9/28/2010 08:03'!
externalTypeAlias: aTypeName
	"override, if you want to introduce type aliases.
	Answering nil means no type alias for given type name exists"
	^ nil! !

!Behavior methodsFor: 'traits' stamp: ''!
classesComposedWithMe
	self isTrait
		ifTrue: [ ^ self traitUsers gather: [ :u | u classesComposedWithMe ] ]
		ifFalse: [ ^ {self} ]! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
commentsIn: sourceString

	
	| commentStart nextQuotePos someComments aPos |
	('*"*' match: sourceString) ifFalse: [^#()].
	someComments:= OrderedCollection new.
	sourceString size = 0 ifTrue: [^ someComments].
	aPos:=1.
	nextQuotePos:= 0.
	[commentStart := sourceString findString: '"' startingAt: aPos.
	nextQuotePos:= self nextQuotePosIn: sourceString startingFrom: commentStart.
	(commentStart ~= 0 and: [nextQuotePos >commentStart])] whileTrue: [
		commentStart ~= nextQuotePos ifTrue: [
			someComments add: ((sourceString copyFrom: commentStart + 1 to: nextQuotePos - 1) copyReplaceAll: '""' with: '"').].
	aPos := nextQuotePos+1].
	^someComments! !

!Behavior methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterSubclassesFor: aStep
	<spotterOrder: 50>
	aStep listProcessor
			title: 'All subclasses';
			allCandidates: [ self allSubclasses ];
			itemIcon: #systemIcon;
			filter: GTFilterSubstring! !

!Behavior methodsFor: '*Slot' stamp: 'MarcusDenker 9/24/2014 14:14'!
layout: aClassLayout
	layout := aClassLayout! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
allSelectors
	"Answer all selectors understood by instances of the receiver"

	^ self allSelectorsBelow: nil! !

!Behavior methodsFor: 'accessing instances and variables' stamp: ''!
subclassInstVarNames
	"Answer a Set of the names of the receiver's subclasses' instance 
	variables."
	| vars |
	vars := Set new.
	self allSubclasses do: [:aSubclass | vars addAll: aSubclass instVarNames].
	^vars! !

!Behavior methodsFor: '*System-Support' stamp: ''!
allCallsOn
	"Answer a SortedCollection of all the methods that refer to me by name or as part of an association in a global dict."
	
	^ (self allCallsOnIn: self systemNavigation)! !

!Behavior methodsFor: 'traits' stamp: 'SebastianTleye 7/17/2013 13:13'!
traitComposition: aTraitComposition
	"Compatibility purposes"! !

!Behavior methodsFor: 'traits' stamp: ''!
addUser: aClassOrTrait
	self traitUsers add: aClassOrTrait.! !

!Behavior methodsFor: 'testing method dictionary' stamp: ''!
classBindingOf: varName
	"Answer the binding of some variable resolved in the scope of the receiver's class"
	^self bindingOf: varName! !

!Behavior methodsFor: 'queries' stamp: ''!
methodsWritingSlot: aSlot
	^self methods select: [ :method | method writesSlot: aSlot ]! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
zapAllMethods
	"Remove all methods in this class which is assumed to be obsolete"

	self methodDict: self emptyMethodDictionary.
	self class isMeta ifTrue: [self class zapAllMethods]! !

!Behavior methodsFor: 'printing' stamp: ''!
longPrintOn: aStream
	"Append to the argument, aStream, the names and values of all of the receiver's instance variables.  But, not useful for a class with a method dictionary."

	aStream nextPutAll: '<<too complex to show>>'; cr.! !

!Behavior methodsFor: 'accessing instances and variables' stamp: ''!
allInstances
	"Answer a collection of all current instances of the receiver."

	| all inst next |
	all := OrderedCollection new.
	inst := self someInstance.
	[inst == nil]
		whileFalse: [
		next := inst nextInstance.
		inst == all ifFalse: [all add: inst].
		inst := next].
	^ all asArray! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
methodsDo: aBlock
	"Evaluate aBlock for all the compiled methods in my method dictionary."

	^ self methodDict valuesDo: aBlock! !

!Behavior methodsFor: 'compiling' stamp: ''!
instVarNamesAndOffsetsDo: aBinaryBlock
	"This is part of the interface between the compiler and a class's instance or field names.
	 The class should enumerate aBinaryBlock with the instance variable name strings and
	 their integer offsets.  The order is important. Names evaluated later will override the
	 same names occurring earlier."

	"Nothing to do here; ClassDescription introduces named instance variables"
	^self! !

!Behavior methodsFor: 'system startup' stamp: ''!
startUp: resuming
	"This message is sent to registered classes when the system is coming up."
	^self startUp! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
commentsAt:  selector
	"Answer a string representing the first comment in the method associated with selector.  Return an empty string if the relevant source file is not available, or if the method's source code does not contain a comment.  Not smart enough to bypass quotes in string constants, but does map doubled quote into a single quote."


	^self commentsIn:  (self sourceCodeAt: selector) asString.
	
"Behavior commentsAt: #commentsAt:"! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
removeSelector: aSelector
	"Assuming that the argument, selector (a Symbol), is a message selector 
	in my method dictionary, remove it and its method.
	
	If the method to remove will be replaced by a method from my trait composition,
	the current method does not have to be removed because we mark it as non-local.
	If it is not identical to the actual method from the trait it will be replaced automatically
	by #noteChangedSelectors:.
	
	This is useful to avoid bootstrapping problems when moving methods to a trait
	(e.g., from TBehavior to TMethodDictionaryBehavior). Manual moving (implementing
	the method in the trait and then remove it from the class) does not work if the methods
	themselves are used for this process (such as compiledMethodAt:, includesLocalSelector: or
	addTraitSelector:withMethod:)"
	
	| changeFromLocalToTraitMethod |
	changeFromLocalToTraitMethod := (self includesLocalSelector: aSelector)
		and: [self hasTraitComposition
				and: [self traitComposition includesMethod: aSelector]].

	changeFromLocalToTraitMethod
		ifFalse: [self basicRemoveSelector: aSelector]
		ifTrue: [self ensureLocalSelectors].
	self deregisterLocalSelector: aSelector.
	self noteChangedSelectors: (Array with: aSelector).
	
	self isTrait ifTrue: [ self notifyUsersOfChangedSelector: aSelector].! !

!Behavior methodsFor: 'initialization' stamp: ''!
obsolete
	"Invalidate and recycle local methods,
	e.g., zap the method dictionary if can be done safely."
	self canZapMethodDictionary
		ifTrue: [self methodDict: self emptyMethodDictionary].
	self hasTraitComposition ifTrue: [
		self traitComposition traits do: [:each |
			each removeUser: self]]! !

!Behavior methodsFor: '*OpalCompiler-Core' stamp: ''!
recompile
	self compileAll! !

!Behavior methodsFor: '*System-Support' stamp: ''!
allCallsOnIn: aSystemNavigation
	"Answer a SortedCollection of all the methods that refer to me by name or as part of an association in a global dict."

	^ (aSystemNavigation 
		allReferencesTo: (self environment associationAt: self theNonMetaClass name)), 
		(aSystemNavigation allCallsOn: self theNonMetaClass name)	! !

!Behavior methodsFor: '*Slot' stamp: 'SebastianTleye 7/17/2013 11:42'!
layout
	^ layout! !

!Behavior methodsFor: 'accessing' stamp: ''!
classDepth

	self superclass ifNil: [^ 1].
	^ self superclass classDepth + 1! !

!Behavior methodsFor: 'testing method dictionary' stamp: ''!
isLocalAliasSelector: aSymbol
	"Return true if the selector aSymbol is an alias defined
	in my trait composition."

	^(self includesLocalSelector: aSymbol) not
		and: [self hasTraitComposition
				and: [self traitComposition isLocalAliasSelector: aSymbol]]! !

!Behavior methodsFor: 'compiling' stamp: ''!
variablesAndOffsetsDo: aBinaryBlock
	"This is the interface between the compiler and a class's instance or field names.  The
	 class should enumerate aBinaryBlock with the field definitions (with nil offsets) followed
	 by the instance variable name strings and their integer offsets (1-relative).  The order is
	 important; names evaluated later will override the same names occurring earlier."

	"Only need to do instance variables here.  CProtoObject introduces field definitions."
	self instVarNamesAndOffsetsDo: aBinaryBlock! !

!Behavior methodsFor: 'copying' stamp: ''!
postCopy
	super postCopy.
	self methodDict: self copyOfMethodDictionary! !

!Behavior methodsFor: 'testing' stamp: ''!
sourceMatchesBytecodeAt: selector
	"Answers true if the source code at the selector compiles to the bytecode at the selector, and false
	otherwise. Implemented to detect an error where Monticello did not recompile sources when the class
	shape changed"

	"This code was copied from #recompile:from:, with few changes. Several methods would benefit from a
	method which turned a selector and class into a CompiledMethod, without  installing it into the 
	methodDictionary"

	| method newMethod |

	method := self compiledMethodAt: selector.
	newMethod := self compiler
			source: (self sourceCodeAt: selector);
			class: self;
			failBlock: [^ false];
			compiledMethodTrailer: method trailer;
			compile.   "Assume OK after proceed from SyntaxError"
	selector == newMethod selector ifFalse: [self error: 'selector changed!!!!'].
	^ newMethod = method! !

!Behavior methodsFor: 'accessing class hierarchy' stamp: 'ClementBera 9/27/2013 17:41'!
superclass: aClass 
	"Change the receiver's superclass to be aClass."
	"Note: Do not use 'aClass isKindOf: Behavior' here
		in case we recompile from Behavior itself."
	(aClass isNil or: [aClass isBehavior])
		ifTrue: [superclass := aClass.
				Object flushCache]
		ifFalse: [self error: 'superclass must be a class-describing object']! !

!Behavior methodsFor: 'traits' stamp: 'SebastianTleye 7/4/2013 11:06'!
users: aCollection
	"Compatibility purposes"! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
compiledMethodAt: selector ifPresent: anotherBlock ifAbsent: aBlock
	"Answer the compiled method associated with the argument, selector (a Symbol), a message selector in the receiver's method dictionary. If the selector is not in the dictionary, return the value of aBlock"

	^ self methodDict at: selector ifPresent: anotherBlock ifAbsent: aBlock! !

!Behavior methodsFor: 'traits' stamp: ''!
traitTransformations 
	^ self traitComposition transformations ! !

!Behavior methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterInstanceVariablesFor: aStep
	<spotterOrder: 20>
	self isTrait ifTrue: [ ^ self ].
	aStep listProcessor
			title: 'Instance variables';
			allCandidates: [ self layout allSlots ];
			itemName: [:each | each name asString];
			filter: GTFilterSubstring! !

!Behavior methodsFor: 'private' stamp: ''!
checkCanBeUncompact 
	"Certain classes cannot be uncompacted in CogVM.  If you download VMMaker and see the VM code, these are as defined by StackInterpreter>>#checkAssumedCompactClasses and the ones that can't be uncompacted are the following: "
	({ Array. LargeNegativeInteger. LargePositiveInteger. Float. Context } includes: self)
		 ifTrue: [ self error: 'Class ', self name, ' cannot be uncompact. ' ]
! !

!Behavior methodsFor: 'testing method dictionary' stamp: ''!
canUnderstand: selector
	"Answer whether the receiver can respond to the message whose selector 
	is the argument."

	^ self
		classAndMethodFor: selector
		do: [ :c :m | true ]
		ifAbsent: [ false ].! !

!Behavior methodsFor: 'obsolete subclasses' stamp: ''!
obsoleteSubclasses
	"Return all the weakly remembered obsolete subclasses of the receiver"
	| obs |
	obs := self basicObsoleteSubclasses at: self ifAbsent: [^ #()].
	^ obs copyWithout: nil! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
firstPrecodeCommentFor:  selector
	"If there is a comment in the source code at the given selector that preceeds the body of the method, return it here, else return nil"

	| method |
	"Behavior firstPrecodeCommentFor: #firstPrecodeCommentFor:"
	(#(Comment Definition Hierarchy) includes: selector)
		ifTrue: [^ nil].
	method := self compiledMethodAt: selector asSymbol ifAbsent: [^ nil].
	^method ast firstPrecodeComment.
	! !

!Behavior methodsFor: 'enumerating' stamp: ''!
withAllSuperclassesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the receiver's superclasses."
	aBlock value: self.
	self superclass == nil
		ifFalse: [self superclass withAllSuperclassesDo: aBlock]! !

!Behavior methodsFor: 'traits' stamp: ''!
flattenDown: aTrait
	| selectors |
	[self hasTraitComposition and: [self traitComposition allTraits includes: aTrait]] assert.
	selectors := (self traitComposition transformationOfTrait: aTrait) selectors.
	self basicLocalSelectors: self basicLocalSelectors , selectors.
	self removeFromComposition: aTrait.! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
allSelectorsAbove

	^ self allSelectorsAboveUntil: ProtoObject 
	

! !

!Behavior methodsFor: 'accessing instances and variables' stamp: ''!
someInstance
	"Primitive. Answer the first instance in the enumeration of all instances 
	of the receiver. Fails if there are none. Essential. See Object 
	documentation whatIsAPrimitive."

	<primitive: 77>
	^nil! !

!Behavior methodsFor: 'testing' stamp: ''!
isCompact

	^self indexIfCompact ~= 0! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
ultimateSourceCodeAt: selector ifAbsent: aBlock
	"Return the source code at selector, deferring to superclass if necessary"
	^ self sourceCodeAt: selector ifAbsent:
		[self superclass
			ifNil:
				[aBlock value]
			 ifNotNil:
				[self superclass ultimateSourceCodeAt: selector ifAbsent: aBlock]]! !

!Behavior methodsFor: 'accessing-properties' stamp: ''!
removeProperty: propName ifAbsent: aBlock
	| property |
	self properties ifNil: [^aBlock value].
	property := self properties
		removeKey: propName
		ifAbsent: aBlock.
	self removePropertiesIfEmpty.
	^ property! !

!Behavior methodsFor: 'copying' stamp: ''!
deepCopy
	"Classes should only be shallowCopied or made anew."

	^ self shallowCopy! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
methodDictionary: aDictionary
	self methodDict: aDictionary! !

!Behavior methodsFor: 'testing' stamp: ''!
isMeta
	^ false! !

!Behavior methodsFor: 'enumerating' stamp: ''!
withAllSuperAndSubclassesDo: aBlock
	self allSuperclassesDo: aBlock.
	aBlock value: self.
	self allSubclassesDo: aBlock! !

!Behavior methodsFor: 'accessing' stamp: ''!
isComposedBy: aTrait
	"Answers if this object includes trait aTrait into its composition"
	aTrait isTrait ifFalse: [ ^false].
	^self hasTraitComposition 
		ifTrue: [ self traitComposition includesTrait: aTrait ]
		ifFalse: [ false ]! !

!Behavior methodsFor: 'testing' stamp: ''!
canZapMethodDictionary
	"Return true if it is safe to zap the method dictionary on #obsolete"
	^true! !

!Behavior methodsFor: '*Tools' stamp: ''!
browseHierarchy
	self systemNavigation browseHierarchy: self! !

!Behavior methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterUsedSlotsFor: aStep
	<spotterOrder: 70>
	aStep listProcessor
			title: 'Special Slots';
			allCandidates: [ self slots select: [ :slot | slot isSpecial ] ];
			itemName: [ :item | item definitionString ];
			filter: GTFilterSubstring! !

!Behavior methodsFor: 'traits' stamp: ''!
flattenDownAllTraits
	self traitComposition allTraits do: [:each | self flattenDown: each].
	[ self traitComposition isEmpty ] assert.
	self traitComposition: nil.! !

!Behavior methodsFor: '*Refactoring-Environment' stamp: ''!
asEnvironment
	^ RBClassEnvironment class: self! !

!Behavior methodsFor: 'instance creation' stamp: ''!
new
	"Answer a new initialized instance of the receiver (which is a class) with no indexable variables. Fail if the class is indexable."

	^ self basicNew initialize
! !

!Behavior methodsFor: 'adding/removing methods' stamp: ''!
addSelectorSilently: selector withMethod: compiledMethod
	self methodDictAddSelectorSilently: selector withMethod: compiledMethod.
	self registerLocalSelector: selector.
	self isTrait ifTrue: [ self notifyUsersOfChangedSelector: selector].! !

!Behavior methodsFor: 'accessing' stamp: ''!
basicLocalSelectors
	^nil! !

!Behavior methodsFor: 'enumerating' stamp: ''!
selectSubclasses: aBlock 
	"Evaluate the argument, aBlock, with each of the receiver's (next level) 
	subclasses as its argument. Collect into a Set only those subclasses for 
	which aBlock evaluates to true. In addition, evaluate aBlock for the 
	subclasses of each of these successful subclasses and collect into the set 
	those for which aBlock evaluates true. Answer the resulting set."

	| aSet |
	aSet := Set new.
	self allSubclasses do: 
		[:aSubclass | 
		(aBlock value: aSubclass) ifTrue: [aSet add: aSubclass]].
	^aSet! !

!Behavior methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterTraitUsersFor: aStep
	<spotterOrder: 20>
	self isTrait ifFalse: [ ^ self ].
	aStep listProcessor
			title: 'Users';
			allCandidates: [ self traitUsers asArray ];
			itemIcon: #systemIcon;
			filter: GTFilterSubstring! !

!Behavior methodsFor: 'traits' stamp: ''!
setTraitCompositionFrom: aTraitExpression
	^ self setTraitComposition: aTraitExpression asTraitComposition! !

!Behavior methodsFor: 'instance creation' stamp: ''!
new: sizeRequested 
	"Answer an initialized instance of this class with the number of indexable
	variables specified by the argument, sizeRequested."

	^ (self basicNew: sizeRequested) initialize  ! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
allSelectorsWithout: behaviors
	"Returns all the selectors of the receiver and its superclasses, except the ones define in behaviors"

	| selectors |
	selectors := IdentitySet new.
	self withAllSuperclassesDo: [ :class | 
			(behaviors includes: class)
				ifFalse: [ selectors addAll: class selectors ] ].
	^ selectors! !

!Behavior methodsFor: '*Fuel' stamp: ''!
fuelNew: sizeRequested 
	"Answer an instance of mine in which serialized references will be injected."

	^ self basicNew: sizeRequested! !

!Behavior methodsFor: 'obsolete subclasses' stamp: ''!
removeAllObsoleteSubclasses
	"Remove all the obsolete subclasses of the receiver"
	self basicObsoleteSubclasses removeKey: self ifAbsent: [].
! !

!Behavior methodsFor: 'testing class hierarchy' stamp: ''!
includesBehavior: aClass
	
	self isTrait ifTrue: [ ^false ].
	^self == aClass or:[self inheritsFrom: aClass]! !

!Behavior methodsFor: 'accessing instances and variables' stamp: ''!
instVarNames
	"Answer an Array of the instance variable names. Behaviors must make 
	up fake local instance variable names because Behaviors have instance 
	variables for the purpose of compiling methods, but these are not named 
	instance variables."

	| mySize superSize |
	mySize := self instSize.
	superSize := 
		self superclass == nil
			ifTrue: [0]
			ifFalse: [self superclass instSize].
	mySize = superSize ifTrue: [^#()].	
	^(superSize + 1 to: mySize) collect: [:i | 'inst' , i printString]! !

!Behavior methodsFor: 'adding/removing methods' stamp: ''!
basicAddSelector: selector withMethod: compiledMethod 
	"Add the message selector with the corresponding compiled method to the 
	receiver's method dictionary.
	Do this without sending system change notifications"

	| oldMethodOrNil |	
	oldMethodOrNil := self lookupSelector: selector.
	self methodDict at: selector put: compiledMethod.
	compiledMethod methodClass: self.
	compiledMethod selector: selector.

	"Now flush Pharo's method cache, either by selector or by method"
	oldMethodOrNil ifNotNil: [oldMethodOrNil flushCache].
	selector flushCache.! !

!Behavior methodsFor: 'accessing-properties' stamp: ''!
removeProperty: propName
	^ self
		removeProperty: propName
		ifAbsent: [ nil ]! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
classAndMethodFor: aSymbol do: binaryBlock ifAbsent: absentBlock
	"Looks up the selector aSymbol in the class chain. If it is found, binaryBlock is evaluated
	with the class that defines the selector and the associated method. Otherwise
	absentBlock is evaluated."

	
	self withAllSuperclassesDo: [:class | | method |
		method := class compiledMethodAt: aSymbol ifAbsent: [nil].
		method ifNotNil: [^ binaryBlock value: class value: method].
	].
	^ absentBlock value.! !

!Behavior methodsFor: 'accessing-properties' stamp: 'MarcusDenker 3/2/2015 18:20'!
ensureProperties
	^ ClassProperties at: self ifAbsentPut: WeakKeyDictionary new
		! !

!Behavior methodsFor: 'accessing class hierarchy' stamp: ''!
withAllSubclassesDo: aBlock
	"Evaluate the argument, aBlock, for the receiver and each of its 
	subclasses."
	self withAllSubclasses do: [ :subclass | aBlock value: subclass ].! !

!Behavior methodsFor: 'instance creation' stamp: 'SebastianTleye 7/17/2013 10:06'!
basicNew: sizeRequested 
	"Primitive. Answer an instance of this class with the number
	of indexable variables specified by the argument, sizeRequested.
	Fail if this class is not indexable or if the argument is not a
	positive Integer, or if there is not enough memory available. 
	Essential. See Object documentation whatIsAPrimitive."

	<primitive: 71>
	self isVariable ifFalse:
		[self error: self printString, ' cannot have variable sized instances'].
	(sizeRequested isInteger and: [sizeRequested >= 0]) ifTrue:
		["arg okay; space must be low."
		OutOfMemory signal.
		^ self basicNew: sizeRequested  "retry if user proceeds"].
	self primitiveFailed! !

!Behavior methodsFor: '*OpalCompiler-Core' stamp: ''!
compile: code 
	"Compile the argument, code, as source code in the context of the 
	receiver. Create an error notification if the code can not be compiled. 
	The argument is either a string or an object that converts to a string or a 
	PositionableStream on an object that converts to a string."

	^self compile: code notifying: nil! !

!Behavior methodsFor: 'accessing class hierarchy' stamp: ''!
withAllSubclasses
	"Answer a Set of the receiver, the receiver's descendent's, and the  
	receiver's descendent's subclasses."

	^ self allSubclasses add: self;
		 yourself! !

!Behavior methodsFor: 'queries' stamp: ''!
whichSelectorsAssign: instVarName 
	"Answer a Set of selectors whose methods store into the argument, 
	instVarName, as a named instance variable."
	^self whichSelectorsStoreInto: instVarName! !

!Behavior methodsFor: 'testing class hierarchy' stamp: ''!
kindOfSubclass
	"Answer a String that is the keyword that describes the receiver's kind 
	of subclass, either a regular subclass, a variableSubclass, a  
	variableByteSubclass, a variableWordSubclass, or a weakSubclass."
	self isWeak
		ifTrue: [^ ' weakSubclass: '].
	^ self isVariable
		ifTrue: [self isBits
				ifTrue: [self isBytes
						ifTrue: [ ' variableByteSubclass: ']
						ifFalse: [ ' variableWordSubclass: ']]
				ifFalse: [ ' variableSubclass: ']]
		ifFalse: [ ' subclass: ']! !

!Behavior methodsFor: 'initialize-release' stamp: ''!
superclass: aClass methodDictionary: mDict format: fmt
	"Basic initialization of the receiver.
	Must only be sent to a new instance; else we would need Object flushCache."
	self superclass: aClass.
	self setFormat: fmt.
	self methodDict: mDict.
	self traitComposition: nil! !

!Behavior methodsFor: '*NativeBoost-Core' stamp: 'Igor.Stasenko 5/18/2010 13:02'!
nbBindingOf: aName
	"answer a binding for a type name,
	by default use smalltalk name bindings"
	^ self bindingOf: aName! !

!Behavior methodsFor: 'queries' stamp: ''!
copiedMethodsFromSuperclass
	"Returns the methods that the receiver copied with its ancestors"
	
	| methods |
	methods := OrderedCollection new.
	self methodsDo: [ :method|
		methods addAll:  (self copiedFromSuperclass: method)].
	^ methods! !

!Behavior methodsFor: '*OpalCompiler-Core' stamp: ''!
compile: code notifying: requestor 
	"Compile the argument, code, as source code in the context of the 
	receiver and insEtall the result in the receiver's method dictionary. The 
	second argument, requestor, is to be notified if an error occurs. The 
	argument code is either a string or an object that converts to a string or 
	a PositionableStream. This method also saves the source code."
	
	| method |
	method  := self compiler
		source: code;
		requestor: requestor;
		failBlock: [ ^nil ];
		compile.
		
	method putSource: code inFile: 2
			withPreamble: [:f | f cr; nextPut: $!!; nextChunkPut: 'Behavior method'; cr].
	self addSelector: method selector withMethod: method notifying: requestor.
	^ method selector! !

!Behavior methodsFor: 'adding/removing methods' stamp: ''!
addSelector: selector withMethod: compiledMethod 
	^ self addSelector: selector withMethod: compiledMethod notifying: nil! !

!Behavior methodsFor: '*System-Support' stamp: ''!
allCallsOn: aSymbol
	"Answer a SortedCollection of all the methods that call on aSymbol."

	^ self  systemNavigation allCallsOn: aSymbol from: self .
	! !

!Behavior methodsFor: 'adding/removing methods' stamp: ''!
methodDictAddSelectorSilently: selector withMethod: compiledMethod
	self basicAddSelector: selector withMethod: compiledMethod! !

!Behavior methodsFor: 'traits' stamp: ''!
traitOrClassOfSelector: aSymbol
	"Return the trait or the class which originally defines the method aSymbol
	or return self if locally defined or if it is a conflict marker method.
	This is primarly used by Debugger to determin the behavior in which a recompiled
	method should be put. If a conflict method is recompiled it should be put into
	the class, thus return self. Also see TraitComposition>>traitProvidingSelector:"
	
	((self includesLocalSelector: aSymbol) or: [
		self hasTraitComposition not]) ifTrue: [^self].
	^(self traitComposition traitProvidingSelector: aSymbol) ifNil: [self]! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
methods
	
	^ self methodDict values! !

!Behavior methodsFor: 'accessing class hierarchy' stamp: ''!
allSubclassesWithLevelDo: classAndLevelBlock startingLevel: level 
	"Walk the tree of subclasses, giving the class and its level"
	| subclassNames |
	classAndLevelBlock value: self value: level.
	self == Class ifTrue:  [^ self].  "Don't visit all the metaclasses"
	"Visit subclasses in alphabetical order"
	subclassNames := SortedCollection new.
	self subclassesDo: [:subC | subclassNames add: subC name].
	subclassNames do:
		[:name | (self environment at: name)
			allSubclassesWithLevelDo: classAndLevelBlock
			startingLevel: level+1]! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
allSelectorsAboveUntil: aRootClass

	| coll |
	coll := IdentitySet new.
	(self allSuperclassesIncluding: aRootClass) 
		do: [:aClass | 
				aClass selectorsDo: [ :sel | coll add: sel ]].
	^ coll
	

! !

!Behavior methodsFor: 'accessing-properties' stamp: 'YuriyTymchuk 10/7/2014 19:24'!
removePropertiesIfEmpty
	^ ClassProperties at: self ifPresent: [ :dict |
		dict ifEmpty: [ ClassProperties removeKey: self ] ]
		! !

!Behavior methodsFor: 'obsolete subclasses' stamp: ''!
allLocalCallsOn: aSymbol
	"Answer a SortedCollection of all the methods that call on aSymbol, anywhere in my class hierarchy."

	^(SystemNavigation new allLocalCallsOn: aSymbol ofClass: (self theNonMetaClass)).
! !

!Behavior methodsFor: '*Ring-Core-Kernel' stamp: ''!
protocols
	
	^ self organization categories copy! !

!Behavior methodsFor: 'system startup' stamp: ''!
shutDown: quitting
	"This message is sent on system shutdown to registered classes"
	^self shutDown.! !

!Behavior methodsFor: 'accessing' stamp: ''!
sharedPoolNames
	^ self sharedPools collect: [:ea |
		ea isObsolete
			ifTrue: [ ea name ]
			ifFalse: [ self environment keyAtIdentityValue: ea ] ]! !

!Behavior methodsFor: 'private' stamp: ''!
flushCache
	"Tell the interpreter to remove the contents of its method lookup cache, if it has 
	one.  Essential.  See Object documentation whatIsAPrimitive."

	<primitive: 89>
	self primitiveFailed! !

!Behavior methodsFor: 'testing' stamp: 'SebastianTleye 7/4/2013 13:06'!
isBehavior
	"Return true if the receiver is a behavior"
	^true! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
sourceCodeAt: selector

	^ (self compiledMethodAt: selector) sourceCode.! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
registerLocalSelector: aSymbol
	self basicLocalSelectors notNil ifTrue: [
		self basicLocalSelectors add: aSymbol]! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
firstCommentAt:  selector
	"Answer a string representing the first comment in the method associated with selector.  Return an empty string if the relevant source file is not available, or if the method's source code does not contain a comment.  Not smart enough to bypass quotes in string constants, but does map doubled quote into a single quote."

	|someComments|
	someComments := self commentsAt: selector.
	^someComments isEmpty ifTrue: [''] ifFalse: [someComments first]


"Behavior firstCommentAt: #firstCommentAt:"! !

!Behavior methodsFor: 'traits' stamp: ''!
addToComposition: aTrait
	self setTraitComposition: (self traitComposition copyTraitExpression
		add: aTrait;
		yourself)! !

!Behavior methodsFor: 'traits' stamp: ''!
applyChangesOfNewTraitCompositionReplacing: oldComposition
	| changedSelectors |
	changedSelectors := self traitComposition
		changedSelectorsComparedTo: oldComposition.
	changedSelectors isEmpty ifFalse: [
		self noteChangedSelectors: changedSelectors].
	self traitComposition isEmpty ifTrue: [
		self purgeLocalSelectors].
	^changedSelectors! !

!Behavior methodsFor: '*Ring-Core-Kernel' stamp: ''!
methodNamed: aSelector

	^ self methodDict at: aSelector! !

!Behavior methodsFor: 'testing' stamp: ''!
isFixed
	"Answer whether the receiver does not have a variable (indexable) part."

	^self isVariable not! !

!Behavior methodsFor: 'printing' stamp: ''!
printOn: aStream 
	"Refer to the comment in Object|printOn:." 

	aStream nextPutAll: 'a descendent of '.
	self superclass printOn: aStream! !

!Behavior methodsFor: '*OpalCompiler-Core' stamp: ''!
compilerClass
	"Answer a compiler class appropriate for source methods of this class."

	^Smalltalk compilerClass! !

!Behavior methodsFor: 'traits' stamp: ''!
addExclusionOf: aSymbol to: aTrait
	self setTraitComposition: (
		self traitComposition copyWithExclusionOf: aSymbol to: aTrait)! !

!Behavior methodsFor: 'traits' stamp: ''!
traitsProvidingSelector: aSymbol
	| result |
	result := OrderedCollection new.
	self hasTraitComposition ifFalse: [^result].
	(self traitComposition methodDescriptionsForSelector: aSymbol)
		do: [:methodDescription | methodDescription selector = aSymbol ifTrue: [
			result addAll: (methodDescription locatedMethods
				collect: [:each | each methodClass])]].
	^result! !

!Behavior methodsFor: 'cleanup' stamp: ''!
cleanUp: aggressive
	"Clean out any caches and other state that should be flushed when trying to get an image into a pristine state. The argument should be used to indicate how aggressive the cleanup should be. Some subclasses may act differently depending on its value - for example, ChangeSet will only delete all unused and reinitialize the current change set if we're asking it to be aggressive."

	^self cleanUp! !

!Behavior methodsFor: '*Manifest-Core' stamp: ''!
isManifest
	(self name beginsWith: 'Manifest')
		ifTrue: [ self deprecated: 'Package Manifest should now inherit from PackageManifest class' ].
	^ false! !

!Behavior methodsFor: 'traits' stamp: ''!
removeUser: aClassOrTrait
	self traitUsers remove: aClassOrTrait ifAbsent: []! !

!Behavior methodsFor: 'testing' stamp: ''!
isWeak
	"Answer whether the receiver has contains weak references."
	^ self instSpec = 4! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
selectorsAndMethodsDo: selectorAndMethodBlock
	"Evaluate selectorAndMethodBlock with two arguments for each selector/method pair in my method dictionary."

	^ self methodDict keysAndValuesDo: selectorAndMethodBlock! !

!Behavior methodsFor: 'enumerating' stamp: ''!
subclassesDo: aBlock
	"Evaluate the argument, aBlock, for each of the receiver's immediate subclasses."
	self subclasses do: aBlock! !

!Behavior methodsFor: 'traits' stamp: ''!
ensureLocalSelectors
	"Ensures that the instance variable localSelectors is effectively used to maintain
	the set of local selectors.
	This method must be called before any non-local selectors are added to the
	method dictionary!!"

	self basicLocalSelectors ifNil: [self basicLocalSelectors: self selectors asSet]! !

!Behavior methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterClassInstanceVariablesFor: aStep
	<spotterOrder: 25>
	self isTrait ifTrue: [ ^ self ].
	aStep listProcessor
			title: 'Class instance variables';
			allCandidates: [ self class layout allSlots ];
			itemName: [:each | each name asString];
			filter: GTFilterSubstring! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
localSelectors
	"Return a set of selectors defined locally.
	The instance variable is lazily initialized. If it is nil then there
	are no non-local selectors"

	^ self basicLocalSelectors 
		ifNil: [self selectors asSet]
		ifNotNil: [self basicLocalSelectors].! !

!Behavior methodsFor: 'printing' stamp: ''!
storeLiteral: aCodeLiteral on: aStream
	"Store aCodeLiteral on aStream, changing an Association to ##GlobalName
	 or ###MetaclassSoleInstanceName format if appropriate"
	| key value |
	(aCodeLiteral isVariableBinding)
		ifFalse:
			[aCodeLiteral storeOn: aStream.
			 ^self].
	key := aCodeLiteral key.
	(key isNil and: [(value := aCodeLiteral value) isMemberOf: Metaclass])
		ifTrue:
			[aStream nextPutAll: '###'; nextPutAll: value soleInstance name.
			 ^self].
	(key isSymbol and: [(self bindingOf: key) notNil])
		ifTrue:
			[aStream nextPutAll: '##'; nextPutAll: key.
			 ^self].
	aCodeLiteral storeOn: aStream! !

!Behavior methodsFor: 'accessing' stamp: ''!
realClass

	^ self! !

!Behavior methodsFor: 'testing method dictionary' stamp: ''!
thoroughWhichSelectorsReferTo: literal special: specialFlag byte: specialByte
	"Answer a set of selectors whose methods access the argument as a 
	literal. Dives into the compact literal notation, making it slow but 
	thorough "
	| selectors |
	selectors := IdentitySet new.
	self selectorsAndMethodsDo: 
		[ :sel :method |
			((self isTrait ifTrue: [method hasLiteralThorough: literal]
				     		 ifFalse: [method refersToLiteral: literal]) or: [specialFlag and: [method scanFor: specialByte]]) ifTrue: [selectors add: sel]].
	^ selectors! !

!Behavior methodsFor: '*OpalCompiler-Core' stamp: ''!
recompile: selector
	"Compile the method associated with selector in the receiver's method dictionary."
	^self recompile: selector from: self! !

!Behavior methodsFor: '*Fuel' stamp: ''!
fuelIgnoredInstanceVariableNames
	"Indicates which variables have to be ignored during serialization."

	^#()! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
allSelectorsBelow: topClass 
	| coll |
	coll := IdentitySet new.
	self withAllSuperclassesDo: 
			[:aClass | 
			aClass = topClass
				ifTrue: [^ coll ]
				ifFalse: [aClass selectorsDo: [ :sel | coll add: sel ]]].
	^ coll
	

! !

!Behavior methodsFor: 'adding/removing methods' stamp: ''!
basicRemoveSelector: selector 
	"Assuming that the argument, selector (a Symbol), is a message selector 
	in my method dictionary, remove it and its method."

	| oldMethod |
	oldMethod := self methodDict at: selector ifAbsent: [^ self].
	self methodDict removeKey: selector.

	"Now flush the method cache"
	oldMethod flushCache.
	selector flushCache.! !

!Behavior methodsFor: '*OpalCompiler-Core' stamp: ''!
compiler
	"Answer a compiler appropriate for source methods of this class."

	^self compilerClass new
		environment: self environment;
		class: self! !

!Behavior methodsFor: 'user interface' stamp: ''!
unreferencedInstanceVariables
	"Return a list of the instance variables defined in the receiver which are not referenced in the receiver or any of its subclasses."

	^ self instVarNames reject: [:ivn | 
		self withAllSubclasses anySatisfy: [:class | 
			(class whichSelectorsAccess: ivn) notEmpty]]! !

!Behavior methodsFor: 'testing method dictionary' stamp: ''!
isAliasSelector: aSymbol
	"Return true if the selector aSymbol is an alias defined
	in my or in another composition somewhere deeper in 
	the tree of traits compositions."

	^(self includesLocalSelector: aSymbol) not
		and: [self hasTraitComposition
				and: [self traitComposition isAliasSelector: aSymbol]]! !

!Behavior methodsFor: 'testing class hierarchy' stamp: ''!
inheritsFrom: aClass 
	"Answer whether the argument, aClass, is on the receiver's superclass 
	chain."

	| aSuperclass |
	aSuperclass := self superclass.
	[aSuperclass == nil]
		whileFalse: 
			[aSuperclass == aClass ifTrue: [^true].
			aSuperclass := aSuperclass superclass].
	^false! !

!Behavior methodsFor: 'accessing' stamp: ''!
typeOfClass
	"Answer a symbol uniquely describing the type of the receiver"
	self instSpec = CompiledMethod instSpec ifTrue:[^#compiledMethod]. "Very special!!"
	self isBytes ifTrue:[^#bytes].
	(self isWords and:[self isPointers not]) ifTrue:[^#words].
	self isWeak ifTrue:[^#weak].
	self isVariable ifTrue:[^#variable].
	^#normal.! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
allMethods
	"Return the collection of compiled method I and my superclasses are defining"
	"asArray is used to not bump into a bug when comparing compiled methods."
	
	^ self allSelectors asArray collect: [ :s | self lookupSelector: s ]! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
sourceCodeAt: selector ifAbsent: aBlock

	^ (self compiledMethodAt: selector ifAbsent: [^ aBlock value]) sourceCode.! !

!Behavior methodsFor: 'traits' stamp: ''!
removeAlias: aSymbol of: aTrait
	self setTraitComposition: (
		self traitComposition copyWithoutAlias: aSymbol of: aTrait)! !

!Behavior methodsFor: 'traits' stamp: ''!
traits
	"Returns a collection of all traits used by the receiver"
	^ self traitComposition traits! !

!Behavior methodsFor: 'testing method dictionary' stamp: ''!
includesLocalSelector: aSymbol
	^self basicLocalSelectors 
		ifNil: [self includesSelector: aSymbol]
		ifNotNil: [self localSelectors includes: aSymbol]! !

!Behavior methodsFor: '*Tools' stamp: ''!
browse

	^  Smalltalk tools browser fullOnClass: self! !

!Behavior methodsFor: 'traits' stamp: ''!
notifyUsersOfChangedSelector: aSelector
	self notifyUsersOfChangedSelectors: (Array with: aSelector)! !

!Behavior methodsFor: 'testing' stamp: ''!
isBytes
	"Answer whether the receiver has 8-bit instance variables."

	^ self instSpec >= 8! !

!Behavior methodsFor: 'accessing instances and variables' stamp: ''!
allClassVarNames
	"Answer a Set of the names of the receiver's and the receiver's ancestor's 
	class variables."

	^self superclass allClassVarNames! !

!Behavior methodsFor: 'testing' stamp: ''!
isVariable
	"Answer whether the receiver has indexable variables."

	^ self instSpec >= 2! !

!Behavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/5/2013 17:16'!
bindingOf: varName
	"Answer the binding of some variable resolved in the scope of the receiver"
	^self superclass bindingOf: varName! !

!Behavior methodsFor: 'queries' stamp: ''!
whichClassDefinesInstVar: aString 
	^self 
		whichSuperclassSatisfies: [:aClass | aClass instVarNames includes: aString]! !

!Behavior methodsFor: 'testing' stamp: ''!
isWords
	"Answer true if the receiver is made of 32-bit instance variables."

	^self isBytes not! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
nextQuotePosIn: sourceString startingFrom: commentStart
	| pos nextQuotePos |
	pos := commentStart + 1.
	[((nextQuotePos := sourceString findString: '"' startingAt: pos) == (sourceString findString: '""' startingAt: pos)) and: [nextQuotePos ~= 0]]
		whileTrue:
			[pos := nextQuotePos + 2].
	^nextQuotePos! !

!Behavior methodsFor: 'traits' stamp: ''!
traitCompositionString
	^self hasTraitComposition
		ifTrue: [self traitComposition asString]
		ifFalse: ['{}']! !

!Behavior methodsFor: 'testing method dictionary' stamp: ''!
whichSelectorsReferTo: literal 
	"Answer a Set of selectors whose methods access the argument as a
literal."

	| special byte |
	special := Smalltalk hasSpecialSelector: literal ifTrueSetByte: [:b |
byte := b].
	^self whichSelectorsReferTo: literal special: special byte: byte

	"Rectangle whichSelectorsReferTo: #+."! !

!Behavior methodsFor: '*Tools' stamp: ''!
inspectSubInstances 
	"Inspect all instances of the receiver and all its subclasses.  CAUTION - don't do this for something as generic as Object!!"

	| all allSize prefix |
	all := self allSubInstances.
	(allSize := all size) isZero ifTrue: [^ self inform: 'There are no 
instances of ', self name, '
or any of its subclasses'].
	prefix := allSize = 1
		ifTrue: 	['The lone instance']
		ifFalse:	['The ', allSize printString, ' instances'].
	
	all asArray inspectWithLabel: (prefix, ' of ', self name, ' & its subclasses')! !

!Behavior methodsFor: 'memory usage' stamp: ''!
instancesSizeInMemory
	"Answers the number of bytes consumed by all its instances including their object header"
	
	| bytes |
	bytes := 0.
	self allInstancesDo: [:each | bytes := bytes + each sizeInMemory  ].
	^ bytes! !

!Behavior methodsFor: 'private' stamp: ''!
indexIfCompact
	"If these 5 bits are non-zero, then instances of this class
	will be compact.  It is crucial that there be an entry in
	Smalltalk compactClassesArray for any class so optimized.
	See the msgs becomeCompact and becomeUncompact."
	^ (self format bitShift: -11) bitAnd: 16r1F


"
Array indexIfCompact

Verify if the compactClassesArray and indexIfCompact are coheren
Smalltalk compactClassesArray doWithIndex: 
	[:c :i | c == nil ifFalse:
		[c indexIfCompact = i ifFalse: [self halt]]]
"! !

!Behavior methodsFor: '*Tools' stamp: ''!
inspectAllInstances 
	"Inspect all instances of the receiver."

	| all allSize prefix |
	all := self allInstances.
	(allSize := all size) isZero ifTrue: [^ self inform: 'There are no 
instances of ', self name].
	prefix := allSize = 1
		ifTrue: 	['The lone instance']
		ifFalse:	['The ', allSize printString, ' instances'].
	
	all asArray inspectWithLabel: (prefix, ' of ', self name)! !

!Behavior methodsFor: 'cleanup' stamp: ''!
cleanUp
	"Clean out any caches and other state that should be flushed when trying to get an image into a pristine state. Subclasses may override #cleanUp: to provide different levels of cleanliness"
! !

!Behavior methodsFor: 'private' stamp: ''!
becomeUncompact
	"The inverse of #becomeCompact. However, some classes can not be uncompact see #checkCanBeUncompact."

	| compactClassesArray index |
	compactClassesArray := Smalltalk compactClassesArray.
	(index := self indexIfCompact) = 0
		ifTrue: [^ self].
	self assert:[compactClassesArray includes: self].
	self checkCanBeUncompact.

	"Update instspec so instances will be compact. 
	The layout has the responsibility for setting the format."
	self layout compactClassIndex: 0.
	
	"Make up new instances and become old ones into them"
	self updateInstancesFrom: self.
	"Make sure there are no compact ones left around"
	Smalltalk garbageCollect.
	"Remove this class from the compact class table"
	compactClassesArray at: index put: nil.
! !

!Behavior methodsFor: 'accessing' stamp: ''!
binding
	^ nil -> self! !

!Behavior methodsFor: 'accessing' stamp: ''!
allSlots
	^#()! !

!Behavior methodsFor: 'obsolete subclasses' stamp: ''!
addObsoleteSubclass: aClass
	"Weakly remember that aClass was a subclass of the receiver and is now obsolete"
	| obs |

	obs := self basicObsoleteSubclasses at: self ifAbsent:[WeakArray new].
	(obs includes: aClass) ifTrue:[^self].
	obs := obs copyWithout: nil.
	obs := obs copyWith: aClass.
	self basicObsoleteSubclasses at: self put: obs.! !

!Behavior methodsFor: 'testing' stamp: ''!
hasAbstractMethods
	"Tells whether the receiver locally defines an abstract method, i.e., a method sending subclassResponsibility"
	
	^ (self methods anySatisfy: [:cm | cm sendsSelector: #subclassResponsibility ])! !

!Behavior methodsFor: 'traits' stamp: ''!
notifyUsersOfChangedSelectors: aCollection! !

!Behavior methodsFor: 'accessing' stamp: 'SebastianTleye 7/17/2013 11:31'!
name
	"Answer a String that is the name of the receiver."
	^'a subclass of ', self superclass name.! !

!Behavior methodsFor: 'queries' stamp: ''!
allMethodsAccessingSlot: aSlot
	"return all methods that access aSlot in this class and subclasses"
	^self withAllSubclasses flatCollect: [ :class |
		class methodsAccessingSlot: aSlot.
	]! !

!Behavior methodsFor: 'accessing-properties' stamp: ''!
propertyValueAt: propName ifAbsent: aBlock
	self properties ifNil: [^aBlock value].
	^ self properties
		at: propName
		ifAbsent: aBlock
		! !

!Behavior methodsFor: '*Fuel' stamp: ''!
fuelNew
	"Answer an instance of mine in which serialized references will be injected."

	^ self basicNew! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
selectorsWithArgs: numberOfArgs
	"Return all selectors defined in this class that take this number of arguments"

	^ self selectors select: [:selector | selector numArgs = numberOfArgs]! !

!Behavior methodsFor: 'traits' stamp: 'NicolaiHess 11/27/2014 23:11'!
traitUsers: aCollection
	"Compatibility purposes"! !

!Behavior methodsFor: 'testing' stamp: ''!
instSpec
	^ (self format bitShift: -7) bitAnd: 16rF! !

!Behavior methodsFor: 'traits' stamp: ''!
traitCompositionIncludes: aTrait
	^self == aTrait or: 
		[self hasTraitComposition and: 
			[self traitComposition allTraits includes: aTrait]]! !

!Behavior methodsFor: '*OpalCompiler-Core' stamp: 'SebastianTleye 7/16/2013 17:05'!
recompile: selector from: oldClass
	"Compile the method associated with selector in the receiver's method dictionary."

	| method newMethod |
	method := oldClass compiledMethodAt: selector.
	newMethod := self compiler
				source: (oldClass sourceCodeAt: selector);
				class: self;
				failBlock: [^ self];
				compiledMethodTrailer: method trailer;
				compile.   "Assume OK after proceed from SyntaxError"
	selector == newMethod selector ifFalse: [self error: 'selector changed!!'].
	self basicAddSelector: selector withMethod: newMethod.! !

!Behavior methodsFor: 'copying' stamp: ''!
copyOfMethodDictionary
	"Return a copy of the receiver's method dictionary"

	^ self methodDict copy! !

!Behavior methodsFor: 'queries' stamp: ''!
methodsReadingSlot: aSlot
	^self methods select: [ :method | method readsSlot: aSlot ]! !

!Behavior methodsFor: 'naming' stamp: ''!
environment
	"Return the environment in which the receiver is visible"
	^Smalltalk globals! !

!Behavior methodsFor: 'testing method dictionary' stamp: ''!
thoroughHasSelectorReferringTo: literal special: specialFlag byte: specialByte
	"Answer true if any of my methods access the argument as a 
	literal. Dives into the compact literal notation, making it slow but 
	thorough "

	
	self methodsDo: [ :method |
		((method hasLiteralThorough: literal) or: [specialFlag and: [method scanFor: specialByte]])
			ifTrue: [^true]].
	^false! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
lookupSelector: selector
	"Look up the given selector in my methodDictionary.
	Return the corresponding method if found.
	Otherwise chase the superclass chain and try again.
	Return nil if no method is found."
	| lookupClass |
	lookupClass := self.
	[lookupClass == nil]
		whileFalse: 
			[(lookupClass includesSelector: selector)
				ifTrue: [^ lookupClass compiledMethodAt: selector].
			lookupClass := lookupClass superclass].
	^ nil! !

!Behavior methodsFor: 'traits' stamp: ''!
updateMethodDictionarySelector: aSymbol
	"A method with selector aSymbol in myself or my traitComposition has been changed.
	Do the appropriate update to my methodDict (remove or update method) and
	return all affected selectors of me so that my useres get notified."

	| modifiedSelectors descriptions oldProtocol |
	modifiedSelectors := IdentitySet new.
	descriptions := self traitComposition methodDescriptionsForSelector: aSymbol.
	descriptions do: [:methodDescription | | effectiveMethod selector |
		selector := methodDescription selector.
		(self includesLocalSelector: selector) ifFalse: [
			methodDescription isEmpty
				ifTrue: [
					self removeTraitSelector: selector.
					modifiedSelectors add: selector]
				ifFalse: [
					effectiveMethod := methodDescription effectiveMethod.
					self addTraitSelector: selector withMethod: effectiveMethod.
					
					"If the method was not categorized yet, we categorize it "
					oldProtocol := self organization categoryOfElement: selector.
					(oldProtocol isNil or: [ oldProtocol = Protocol unclassified ]) 
						ifTrue: [ self organization classify: selector under: methodDescription effectiveMethodCategory. ].
					
					modifiedSelectors add: selector]]].
	^modifiedSelectors! !

!Behavior methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterCompositionFor: aStep
	<spotterOrder: 25>
	aStep listProcessor
			title: 'Composing traits';
			allCandidates: [ self traitComposition allTraits ];
			itemIcon: #systemIcon;
			filter: GTFilterSubstring! !

!Behavior methodsFor: 'accessing instances and variables' stamp: ''!
classVarNames
	"Answer a collection of the receiver's class variable names."

	^#()! !

!Behavior methodsFor: 'obsolete subclasses' stamp: 'ST 6/21/2013 10:12'!
basicObsoleteSubclasses
	^ObsoleteSubclasses.! !

!Behavior methodsFor: 'testing method dictionary' stamp: ''!
whichSelectorsAccess: instVarName 
	"Answer a set of selectors whose methods access the argument, 
	instVarName, as a named instance variable."

	| instVarIndex |
	instVarIndex := self instVarIndexFor: instVarName ifAbsent: [^IdentitySet new].
	^ self selectors select:  [:sel | 
		((self compiledMethodAt: sel)
			readsField: instVarIndex)
			or: [(self compiledMethodAt: sel) writesField: instVarIndex]]! !

!Behavior methodsFor: 'initialize-release' stamp: ''!
nonObsoleteClass
	"Attempt to find and return the current version of this obsolete class"

	| obsName |
	obsName := self name.
	[obsName beginsWith: 'AnObsolete']
		whileTrue: [obsName := obsName copyFrom: 'AnObsolete' size + 1 to: obsName size].
	^ self environment at: obsName asSymbol! !

!Behavior methodsFor: 'accessing' stamp: 'ClementBera 9/27/2013 17:41'!
methodDict
       "The method dictionary of a class can be nil when we want to use the #cannotInterpret: hook. Indeed when a class dictionary is nil, the VM sends the message cannotInterpret: to the receiver but starting the look up in the superclass of the class whose method dictionary was nil.
	 Now the system relies that when the message methodDict is sent to a class a method dictionary is returned. In order to prevent the complaints of tools and IDE unaware of this feature, we fool them by providing an empty MethodDictionary. This will hopefully work in most cases, but the tools will loose the ability to modify the behaviour of this behavior. The user of #cannotInterpret: should be aware of this."

       methodDict ifNil: [^ MethodDictionary new ].
       ^ methodDict! !

!Behavior methodsFor: 'accessing class hierarchy' stamp: ''!
allSubclasses
	"Answer an orderedCollection of the receiver's and the receiver's descendent's subclasses. "

	| scan scanTop |
	scan := OrderedCollection withAll: self subclasses.
	scanTop := 1.
	[scanTop > scan size]
		whileFalse: [scan addAll: (scan at: scanTop) subclasses.
			scanTop := scanTop + 1].
	^ scan! !

!Behavior methodsFor: 'accessing class hierarchy' stamp: ''!
withAllSuperclasses
	"Answer an OrderedCollection of the receiver and the receiver's 
	superclasses. The first element is the receiver, 
	followed by its superclass; the last element is Object."

	| temp |
	temp := self allSuperclasses.
	temp addFirst: self.
	^ temp! !

!Behavior methodsFor: 'traits' stamp: ''!
removeTraitSelector: aSymbol
	[(self includesLocalSelector: aSymbol) not] assert.
	self basicRemoveSelector: aSymbol! !

!Behavior methodsFor: 'accessing' stamp: 'SebastianTleye 7/16/2013 17:04'!
subclassDefinerClass
	"Answer an evaluator class appropriate for evaluating definitions of new 
	subclasses of this class."

	^self compilerClass! !

!Behavior methodsFor: '*Rpackage-Core' stamp: ''!
originalName
	^ ((self isObsolete and: [ self name beginsWith: 'AnObsolete' ])
		ifTrue: [ (self name copyFrom:   'AnObsolete' size + 1 to: self name size ) ]
		ifFalse:  [ self name ]) asSymbol! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
precodeCommentOrInheritedCommentFor: selector 
	"Answer a string representing the first comment in the method associated 
	with selector, considering however only comments that occur before the 
	beginning of the actual code. If the version recorded in the receiver is 
	uncommented, look up the inheritance chain. Return nil if none found."
	
	| aSuper aComment |
	^ (aComment := self firstPrecodeCommentFor: selector) isEmptyOrNil
		ifTrue: [(self == Behavior
					or: [self superclass == nil
							or: [(aSuper := self superclass whichClassIncludesSelector: selector) == nil]])
				ifFalse: [aSuper precodeCommentOrInheritedCommentFor: selector]]
		ifFalse: [aComment]! !

!Behavior methodsFor: 'testing method dictionary' stamp: ''!
whichClassIncludesSelector: aSymbol 
	"Answer the class on the receiver's superclass chain where the 
	argument, aSymbol (a message selector), will be found. Answer nil if none found."
	"Rectangle whichClassIncludesSelector: #inspect."
	(self includesSelector: aSymbol)
		ifTrue: [^ self].
	self superclass == nil
		ifTrue: [^ nil].
	^ self superclass whichClassIncludesSelector: aSymbol! !

!Behavior methodsFor: 'testing method dictionary' stamp: ''!
whichSelectorsStoreInto: instVarName 
	"Answer a Set of selectors whose methods access the argument, 
	instVarName, as a named instance variable."
	| instVarIndex |
	instVarIndex := self instVarIndexFor: instVarName ifAbsent: [^IdentitySet new].
	^ self selectors select: [:sel | (self compiledMethodAt: sel) writesField: instVarIndex]

	"Point whichSelectorsStoreInto: 'x'."! !

!Behavior methodsFor: 'accessing method dictionary' stamp: 'dvf 9/27/2005 17:08'!
methodDict: aDictionary
	methodDict := aDictionary! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
compiledMethodAt: selector 
	"Answer the compiled method associated with the argument, selector (a 
	Symbol), a message selector in the receiver's method dictionary. If the 
	selector is not in the dictionary, create an error notification."

	^ self methodDict at: selector! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
>> selector 
	"Answer the compiled method associated with the argument, selector (a 
	Symbol), a message selector in the receiver's method dictionary. If the 
	selector is not in the dictionary, create an error notification."

	^self compiledMethodAt: selector
! !

!Behavior methodsFor: '*NativeBoost-Core' stamp: 'Igor.Stasenko 4/30/2010 12:34'!
nbFnArgument: argName generator: gen

	"Load the instance variable with given name" 

	(self allInstVarNames includes: argName) ifFalse: [ ^ nil ].
	^ NBSTIvarArgument new receiverClass: self; ivarName: argName! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
selectors
	"Answer a Set of all the message selectors specified in the receiver's 
	method dictionary."

	^ self methodDict keys! !

!Behavior methodsFor: 'enumerating' stamp: ''!
selectSuperclasses: aBlock 
	"Evaluate the argument, aBlock, with the receiver's superclasses as the 
	argument. Collect into an OrderedCollection only those superclasses for 
	which aBlock evaluates to true. In addition, evaluate aBlock for the 
	superclasses of each of these successful superclasses and collect into the 
	OrderedCollection ones for which aBlock evaluates to true. Answer the 
	resulting OrderedCollection."

	| aSet |
	aSet := Set new.
	self allSuperclasses do: 
		[:aSuperclass | 
		(aBlock value: aSuperclass) ifTrue: [aSet add: aSuperclass]].
	^aSet! !

!Behavior methodsFor: 'private' stamp: ''!
spaceUsed
	"Answer a rough estimate of number of bytes used by this class and its metaclass. Does not include space used by class variables."

	| space |
	space := 0.
	self methodsDo: [:method  |
		space := space + 16.  "dict and org'n space"
		space := space + (method size + 6 "hdr + avg pad").
		method literalsDo: [:lit |
			(lit isMemberOf: Array) ifTrue: [space := space + ((lit size + 1) * 4)].
			(lit isMemberOf: Float) ifTrue: [space := space + 12].
			(lit isMemberOf: ByteString) ifTrue: [space := space + (lit size + 6)].
			(lit isMemberOf: LargeNegativeInteger) ifTrue: [space := space + ((lit size + 1) * 4)].
			(lit isMemberOf: LargePositiveInteger) ifTrue: [space := space + ((lit size + 1) * 4)]]].
		^ space! !

!Behavior methodsFor: 'accessing method dictionary' stamp: ''!
selectorsDo: selectorBlock
	"Evaluate selectorBlock for all the message selectors in my method dictionary."

	^ self methodDict keysDo: selectorBlock! !

!Behavior methodsFor: 'accessing instances and variables' stamp: ''!
includesSharedPoolNamed:  aSharedPoolString 
	"Answer whether the receiver uses the shared pool named aSharedPoolString"
	
	^ (self sharedPools anySatisfy: [:each | each name = aSharedPoolString])! !

!Behavior class methodsFor: 'class initialization' stamp: 'apb 7/12/2004 23:46'!
initializeObsoleteSubclasses
	ObsoleteSubclasses := WeakKeyToCollectionDictionary new.! !

!Behavior class methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
gtExampleAllSubclasses
	<gtExample: 'All Subclasses'>
	^ Object! !

!Behavior class methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
gtExampleClassVariables
	<gtExample: 'Class Variables'>
	^ Behavior! !

!Behavior class methodsFor: 'testing' stamp: 'dvf 9/27/2005 16:12'!
canZapMethodDictionary
	"Return false since zapping the method dictionary of Behavior class or its subclasses will cause the system to fail."
	^false! !

!Behavior class methodsFor: 'class initialization' stamp: 'YuriyTymchuk 10/6/2014 19:46'!
initializeClassProperties
	ClassProperties := WeakIdentityKeyDictionary new.! !

!Behavior class methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
gtExampleTraits
	<gtExample: 'Traits'>
	^ Class! !

!Behavior class methodsFor: 'cleanup' stamp: 'StephaneDucasse 3/9/2010 16:08'!
cleanUp
	"Flush the obsolete subclasses."

	self flushObsoleteSubclasses! !

!Behavior class methodsFor: 'class initialization' stamp: 'YuriyTymchuk 10/6/2014 19:47'!
initialize
	"Behavior initialize"
	"Never called for real"
	ObsoleteSubclasses
		ifNil: [ self initializeObsoleteSubclasses ]
		ifNotNil: [ | newDict | 
			newDict := WeakKeyToCollectionDictionary newFrom: ObsoleteSubclasses.
			newDict rehash.
			ObsoleteSubclasses := newDict ].
		
	ClassProperties
		ifNil: [ self initializeClassProperties ]
		ifNotNil: [ | newDict | 
			newDict := WeakIdentityKeyDictionary newFrom: ClassProperties.
			newDict rehash.
			ClassProperties := newDict ]! !

!Behavior class methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
gtExampleTraitUsers
	<gtExample: 'Trait Users'>
	^ TBehavior! !

!Behavior class methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
gtExampleInstanceVariables
	<gtExample: 'Instance Variables'>
	^ ClassDescription! !

!Behavior class methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
gtExampleSuperclasses
	<gtExample: 'Superclasses'>
	^ Metaclass! !

!Behavior class methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
gtExampleTraitComposition
	<gtExample: 'Trait Composition'>
	^ Class! !

!Behavior class methodsFor: '*Collections-Abstract' stamp: 'CamilloBruni 2/22/2013 23:14'!
sortBlock
	^ [ :a :b | a name <= b name ]! !

!Behavior class methodsFor: 'class initialization' stamp: 'apb 7/12/2004 23:23'!
flushObsoleteSubclasses
	"Behavior flushObsoleteSubclasses"
	ObsoleteSubclasses finalizeValues.! !

!BehaviorInstallingDeclaration commentStamp: '<historical>'!
I'm an abstract class grouping the behavior of the code declarations that will be instaled in a behavior, such as methods, class comments, organizations...!
!BehaviorInstallingDeclaration methodsFor: 'accessing' stamp: 'GuillermoPolito 5/5/2012 20:35'!
isMeta: aBoolean
	isMeta := aBoolean! !

!BehaviorInstallingDeclaration methodsFor: 'accessing' stamp: 'GuillermoPolito 5/5/2012 20:35'!
behaviorName: aBehaviorName
	behaviorName := aBehaviorName! !

!BehaviorInstallingDeclaration methodsFor: 'testing' stamp: 'GuillermoPolito 5/5/2012 20:37'!
existsBehavior
	^self class environment includesKey: behaviorName! !

!BehaviorInstallingDeclaration methodsFor: 'accessing' stamp: 'GuillermoPolito 5/5/2012 20:36'!
targetClass
	| target |
	target := self class environment at: behaviorName.
	^isMeta
		ifTrue: [ target classSide ]
		ifFalse: [ target ]! !

!BehaviorTest commentStamp: 'TorstenBergmann 2/5/2014 08:31'!
SUnit tests for Behavior!
!BehaviorTest methodsFor: 'tests' stamp: 'SeanDeNigris 8/29/2011 12:26'!
testAllSelectorsAboveUntil
	"self debug: #testAllSelectorsAboveUntil"
	
	|sels |
	sels := Date allSelectorsAboveUntil: Object..
	self deny: (sels includes: #mmddyyyy). 
	self deny: (sels includes: #weekday).
	self assert: (sels includes: #at:).
	self deny: (sels includes: #cannotInterpret: )
	! !

!BehaviorTest methodsFor: 'tests' stamp: 'YuriyTymchuk 9/6/2014 12:24'!
testCanPerform
	
	| c1 c2 |

	c1 := Object subclass: 'MySuperclass' instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self class category.
	c1 compile: 'method1 ^self subclassResponsibility'.
	c1 compile: 'method2 ^123'.
	
	self deny: (c1 canPerform: #method1).
	self assert: (c1 canPerform: #method2).
	self deny: (c1 canPerform: #method3).
	
	c2 := c1 subclass: 'MySubclass' instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self class category.
	c2 compile: 'method1 ^ 3'.
	c2 compile: 'method3 ^5'.
	
	self assert: (c2 canPerform: #method1).
	self assert: (c2 canPerform: #method3).
	
	c2 removeFromSystem.
	c1 removeFromSystem.! !

!BehaviorTest methodsFor: 'tests' stamp: 'nice 12/25/2009 18:58'!
sampleMessageWithFirstArgument: firstArgument "This is a comment intended to explain arg1"
   andInterleavedCommentBeforeSecondArgument: secondArgument

	"This method is here to test a few utilities like formalParametersAt:"
	
	| thisIsAnUnusedTemp |
	thisIsAnUnusedTemp := self.
	^thisIsAnUnusedTemp! !

!BehaviorTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 12/16/2011 10:54'!
testUncompactClassNotAllowed
	"As explained in Behavior >> #checkCanBeUncompact certain classes cannot be uncompact, like Array"
	self should: [Array becomeUncompact] raise: Error.! !

!BehaviorTest methodsFor: 'tests' stamp: 'MarcusDenker 5/10/2013 00:23'!
testAllMethods
	| allMethods nonOverridenMethods |
	allMethods := IdentitySet new
		addAll: Object allMethods;
		yourself.
	self assert: (allMethods includesAllOf: Object methods).	"We fetch all compiled methods that are not redefined in Object"
	nonOverridenMethods := OrderedCollection new.
	ProtoObject
		selectorsAndMethodsDo: [ :sel :method | 
			(Object includesSelector: sel)
				ifFalse: [ nonOverridenMethods add: method ] ].
	self assert: (allMethods includesAllOf: nonOverridenMethods)! !

!BehaviorTest methodsFor: 'tests' stamp: 'MarcusDenker 10/10/2014 17:47'!
testCompile
	| behavior |
	behavior := Behavior new.
	behavior compile: 'thisIsATest ^2'.
	behavior new thisIsATest! !

!BehaviorTest methodsFor: 'tests' stamp: 'MarcusDenker 7/12/2012 17:59'!
testAllReferencesTo
	| result |
	result := SystemNavigation new allReferencesTo: Point binding.
	result do: [ :each | self assert: (each compiledMethod hasLiteral: Point binding) ].
	self assert: (result anySatisfy: [ :each | each actualClass = self class and: [ each selector = #testAllReferencesTo ] ]).
		
	result := SystemNavigation new allReferencesTo: #printOn:.
	result do: [ :each | self assert: (each compiledMethod hasLiteralThorough: #printOn:) ].
	self assert: (result anySatisfy: [ :each | each actualClass = self class and: [ each selector = #testAllReferencesTo ] ]).
	
	result := SystemNavigation new allReferencesTo: #+.
	result do: [ :each | self assert: ((each compiledMethod sendsSelector: #+) or: [ each compiledMethod hasLiteralThorough: #+ ]) ].
	self assert: (result anySatisfy: [ :each | each actualClass = self class and: [ each selector = #testAllReferencesTo ] ])! !

!BehaviorTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 1/9/2012 22:31'!
testCompactAndUncompactClass
	self assert: ExampleForTest1 isCompact not.
	ExampleForTest1 becomeCompact.
	self assert: ExampleForTest1 isCompact.
	ExampleForTest1 becomeUncompact.
	self assert: ExampleForTest1 isCompact not.
	! !

!BehaviorTest methodsFor: 'tests - queries' stamp: 'MarcusDenker 7/19/2014 14:33'!
testMethodsWritingSlot
	| numberViaSlot numberViaIVar |
	numberViaSlot := (Point methodsWritingSlot: (Point slotNamed: #x)) size.
	numberViaIVar := (Point whichSelectorsAssign: 'x') size.
	self assert: numberViaSlot = numberViaIVar.! !

!BehaviorTest methodsFor: 'tests - testing method dictionary' stamp: 'marcus.denker 9/29/2008 15:11'!
testWhichSelectorsAccess
	self assert: ((Point whichSelectorsAccess: 'x') includes: #x).
	self deny:  ((Point whichSelectorsAccess: 'y') includes: #x).! !

!BehaviorTest methodsFor: 'tests' stamp: 'SeanDeNigris 8/29/2011 12:25'!
testAllSelectorsAbove
	"self debug: #testAllSelectorsAbove"
	
	|sels |
	sels := Date allSelectorsAbove.
	self deny: (sels includes: #mmddyyyy). 
	self deny: (sels includes: #weekday).
	self assert: (sels includes: #at:).
	self assert: (sels includes: #cannotInterpret: )
	! !

!BehaviorTest methodsFor: 'tests' stamp: 'sd 11/19/2004 15:38'!
testBehaviornewnewShouldNotCrash

	Behavior new new.
	"still not working correctly but at least does not crash the image"
	! !

!BehaviorTest methodsFor: 'tests' stamp: 'marcus.denker 9/14/2008 21:14'!
testBinding
	self assert: Object binding value = Object.
	self assert: Object binding key = #Object.
	
	self assert: Object class binding value = Object class.
	
	"returns nil for Metaclasses... like Encoder>>#associationFor:"
	
	self assert: Object class binding key isNil.! !

!BehaviorTest methodsFor: 'tests' stamp: 'YuriyTymchuk 9/6/2014 12:24'!
testCanUnderstand
	
	| c1 c2 |

	c1 := Object subclass: 'MySuperclass' instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self class category.
	c1 compile: 'method1 ^self subclassResponsibility'.
	c1 compile: 'method2 ^123'.
	
	self assert: (c1 canUnderstand: #method1).
	self assert: (c1 canUnderstand: #method2).
	self deny: (c1 canUnderstand: #method3).
	
	c2 := c1 subclass: 'MySubclass' instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self class category.
	c2 compile: 'method1 ^ 3'.
	c2 compile: 'method3 ^5'.
	
	self assert: (c2 canUnderstand: #method1).
	self assert: (c2 canUnderstand: #method3).
	
	c2 removeFromSystem.
	c1 removeFromSystem.! !

!BehaviorTest methodsFor: 'tests - queries' stamp: 'MarcusDenker 7/19/2014 14:33'!
testMethodsReadingSlot
	| numberViaSlot numberViaIVar |
	numberViaSlot := (Point methodsReadingSlot: (Point slotNamed: #x)) size.
	numberViaIVar := (Point whichSelectorsRead: 'x') size.
	self assert: numberViaSlot = numberViaIVar.! !

!BehaviorTest methodsFor: 'test - properties' stamp: 'YuriyTymchuk 10/6/2014 20:17'!
testRemoveProperty

	self class propertyValueAt: #testKeySelector put: 1.
		
	self class removeProperty: #testKeySelector.
	self
		assert: (self class propertyValueAt: #testKeySelector)
		equals: nil.! !

!BehaviorTest methodsFor: 'tests - queries' stamp: 'MarcusDenker 7/19/2014 14:31'!
testMethodsAccessingSlot
	| numberViaSlot numberViaIVar |
	numberViaSlot := (Point methodsAccessingSlot: (Point slotNamed: #x)) size.
	numberViaIVar := (Point whichSelectorsAccess: 'x') size.
	self assert: numberViaSlot = numberViaIVar.! !

!BehaviorTest methodsFor: 'test - properties' stamp: 'YuriyTymchuk 10/7/2014 19:34'!
testPropertyValueAtPut

	| testValue |
	
	testValue := Date today.
	self class propertyValueAt: #testKeySelector put: testValue.
	self
		assert: (self class propertyValueAt: #testKeySelector)
		equals: testValue.
	self class removeProperty: #testKeySelector! !

!BehaviorTest methodsFor: 'tests' stamp: 'sd 1/28/2009 14:25'!
testallSuperclassesIncluding
	"self debug: #testallSuperclassesIncluding"
	
	|cls |
	cls := ArrayedCollection allSuperclassesIncluding: Collection.
	self deny: (cls includes: ArrayedCollection).
	self deny: (cls includes: Object). 
	self assert: (cls includes: Collection). 
	self assert: (cls includes: SequenceableCollection). ! !

!BehaviorTest methodsFor: 'tests' stamp: 'MarcusDenker 10/23/2014 16:48'!
testBehaviorRespectsPolymorphismWithTraitBehavior
	| repeatedMethodsThatDoNotAccessInstanceVariables differentMethodsWithSameSelector |
	"If the method is in Behavior and TraitBehavior it must access some instance variable, otherwise the method can be implemented in TBehavior"
	repeatedMethodsThatDoNotAccessInstanceVariables := self
		repeatedMethodsThatDoNotAccessInstanceVariablesBetween: Behavior
		and: TraitBehavior.
	self assert: repeatedMethodsThatDoNotAccessInstanceVariables size equals: 0.	"If the method is in Behavior and TraitBehavior, and they have different implementations, it must be declared in TBehavior as an explicitRequirement method"
	differentMethodsWithSameSelector := self differentMethodsWithSameSelectorBetween: Behavior and: TraitBehavior.
	differentMethodsWithSameSelector
		do: [ :selector | 
			(TBehavior >> selector) sourceCode.
			self assert: (TBehavior >> selector) isRequired ].	"Only a few methods are allowed to belong to one class and not to the other"	"If you want to remove methods for this list, then go ahead. But is NOT good idea add methods to this list"	"format -> the instance variable format belongs to Behavior but not to TraitBehavior, if we add the getter to TraitBehavior, what should we return?
	isBehavior -> returns true for all the classes but false for the traits, the implementation for traits (and the rest of the objects) is implemented in Object>>isBehavior
	layout -> is an instance variable of Behavior but not of TraitBehavior"
	self
		assert: (Behavior localSelectors difference: TraitBehavior localSelectors)
		equals: #(#externalTypeAlias: #nbBindingOf: #format #nbFnArgument:generator: #layout #layout: #isBehavior) asSet.	"localSelectors, localSelectors:, basicLocalSelectors, basicLocalSelectors: -> the instance variable localSelectors belongs to TraitBehavior but not to Behavior"	"browse is implemeted differently for traits, the implementation for classes is in Object"	"isTrait answers true for traits, for the rest of objects answer false, the implementation is in Object"
	self
		assert: (TraitBehavior localSelectors difference: Behavior localSelectors)
		equals: #(#basicLocalSelectors #basicLocalSelectors: #isTrait) asSet! !

!BehaviorTest methodsFor: 'tests' stamp: 'MarcusDenker 1/15/2013 10:30'!
testHasAbstractMethods
	self deny: Object hasAbstractMethods.
	self deny: Object class hasAbstractMethods.
		
	"Behavior has abstract methods, for example hasTraitComposition, basicLocalSelectors:"
	self assert: Behavior hasAbstractMethods.
	self deny: Behavior class hasAbstractMethods.
	
	
	self assert: DiskStore hasAbstractMethods.
	"DiskStore defines methods because its class side contains abstract methods"
	self assert: DiskStore class hasAbstractMethods.
	
	! !

!BehaviorTest methodsFor: 'metrics' stamp: 'Alexandre Bergel 4/27/2010 14:06'!
testNumberOfInstanceVariables
	self assert: Object numberOfInstanceVariables = 0.
	self assert: Point numberOfInstanceVariables = 2.
	self assert: Metaclass numberOfInstanceVariables = 3! !

!BehaviorTest methodsFor: 'tests' stamp: 'nice 12/3/2009 23:58'!
testAllSelectors
	self assert: ProtoObject allSelectors asSet = ProtoObject selectors asSet.
	self assert: Object allSelectors asSet = (Object selectors asSet union: ProtoObject selectors).
	self assert: (Object allSelectorsBelow: ProtoObject) asSet = (Object selectors) asSet.! !

!BehaviorTest methodsFor: 'tests' stamp: 'MarcusDenker 3/25/2013 22:07'!
testComposedBy
	"tests the #isComposedBy: aTrait method"
	

	self deny: (Object isComposedBy: TSortable).
	self assert: (SequenceableCollection isComposedBy: TSortable).
	self assert: (Trait3 isComposedBy: Trait2).
	self deny: (Trait2 isComposedBy: Trait3).
	self deny: (Trait3 isComposedBy: Object).
	! !

!BehaviorTest methodsFor: 'tests' stamp: 'StephaneDucasse 8/12/2011 14:55'!
testAllLocalCallsOn
	" self debug: #testAllLocalCallsOn"
	
	self assert: (( Point allLocalCallsOn: #asPoint )  notEmpty).
	self assert: (( Point allLocalCallsOn: #asPoint )  size = 4).
	self assert: (( Point allLocalCallsOn: #asPoint )  includes: (Point>> #roundDownTo:) asRingDefinition).
	self assert: (( Point allLocalCallsOn: #asPoint )  includes: (Point >> #roundUpTo:) asRingDefinition).
	self assert: (( Point allLocalCallsOn: #asPoint )  includes: (Point >> #roundTo:) asRingDefinition).
	self assert: (( Point allLocalCallsOn: #asPoint )  includes: (Point >> #truncateTo: ) asRingDefinition).
	! !

!BenchmarkResult commentStamp: 'SvenVanCaekenberghe 2/18/2015 17:10'!
I am BenchmarkResult. 

I know how much iterations where executed in a specific elapsed time duration.

I am the result of running the same piece of code multiple times.

I can compute my average #frequencey (#executionsPerSecond) and #period (#timePerExecution).

I have a human friendly print representation.

BenchmarkResult new
	iterations: 20000;
	elapsedTime: 10 seconds;
	yourself.
!
!BenchmarkResult methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 2/19/2015 11:14'!
shortPrintString
	self isEmpty
		ifTrue: [ ^ self printString ].
	^ String streamContents: [ :out | 
		iterations = 1
			ifTrue: [ elapsedTime printHumanReadableOn: out ]
			ifFalse: [ self printFrequenceOn: out ] ]! !

!BenchmarkResult methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/25/2015 12:43'!
timePerExecution
	"Return the average duration of one iteration"

	^ self period! !

!BenchmarkResult methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/18/2015 14:19'!
period
	"Return the average duration of one iteration"
	
	^ elapsedTime / iterations! !

!BenchmarkResult methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/18/2015 14:56'!
isEmpty
	iterations isNil | elapsedTime isNil 
		ifTrue: [ ^ true ].
	iterations isZero | elapsedTime isZero 
		ifTrue: [ ^ true ].
	^ false! !

!BenchmarkResult methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/18/2015 14:21'!
iterations
	"Return the number of iterations that were executed"
	
	^ iterations! !

!BenchmarkResult methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 2/19/2015 11:02'!
printOn: stream
	super printOn: stream.
	stream nextPut: $(.
	self isEmpty
		ifTrue: [ 
			stream << ' empty' ]
		ifFalse: [ 
			iterations printWithCommasOn: stream.
			stream space; << ('iteration' asPluralBasedOn: iterations).
			stream << ' in '.
			elapsedTime printHumanReadableOn: stream.
			stream << '. '.
			self printFrequenceOn: stream ].
	stream nextPut: $)! !

!BenchmarkResult methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/25/2015 12:43'!
executionsPerSecond
	"Return the average number of executions per second"

	^ self frequency! !

!BenchmarkResult methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/18/2015 14:20'!
frequency
	"Return the average number of executions per second"
	
	^ iterations / elapsedTime totalSeconds! !

!BenchmarkResult methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/18/2015 14:20'!
elapsedTime: duration
	"Set the duration of the total execution time"
	
	elapsedTime := duration! !

!BenchmarkResult methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/18/2015 14:21'!
iterations: integer
	"Set the number of iterations that were executed"

	iterations := integer! !

!BenchmarkResult methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/18/2015 14:20'!
elapsedTime
	"Return the duration of the total execution time"
	
	^ elapsedTime! !

!BenchmarkResult methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 2/19/2015 11:00'!
printFrequenceOn: stream
	self frequency > 999
		ifTrue: [ self frequency rounded printWithCommasOn: stream ]
		ifFalse: [ self frequency printOn: stream showingDecimalPlaces: 3 ].
	stream << ' per second'! !

!BenchmarkResultTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/19/2015 11:39'!
testEmpty
	| benchmarkResult |
	benchmarkResult := BenchmarkResult new.
	self assert: benchmarkResult isEmpty.
	self assert: benchmarkResult iterations isNil.
	self assert: benchmarkResult elapsedTime isNil.
	"cover the code at least"
	self deny: benchmarkResult shortPrintString isEmpty.
	self deny: benchmarkResult printString isEmpty
! !

!BenchmarkResultTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/19/2015 11:39'!
testSimple
	| benchmarkResult |
	benchmarkResult := BenchmarkResult new.
	benchmarkResult iterations: 100.
	benchmarkResult elapsedTime: 4 seconds.
	self deny: benchmarkResult isEmpty.
	self assert: benchmarkResult iterations equals: 100.
	self assert: benchmarkResult elapsedTime equals: 4 seconds.
	self assert: benchmarkResult frequency equals: 25.
	self assert: benchmarkResult executionsPerSecond equals: 25.
	self assert: benchmarkResult period equals: 40 milliSeconds.
	self assert: benchmarkResult timePerExecution equals: 40 milliSeconds.
	"cover the code at least"
	self deny: benchmarkResult shortPrintString isEmpty.
	self deny: benchmarkResult printString isEmpty
	
! !

!BenchmarkResultTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/19/2015 11:38'!
testOne
	| benchmarkResult |
	benchmarkResult := BenchmarkResult new.
	benchmarkResult iterations: 1.
	benchmarkResult elapsedTime: 1 second.
	self deny: benchmarkResult isEmpty.
	self assert: benchmarkResult iterations equals: 1.
	self assert: benchmarkResult elapsedTime equals: 1 second.
	self assert: benchmarkResult frequency equals: 1.
	self assert: benchmarkResult executionsPerSecond equals: 1.
	self assert: benchmarkResult period equals: 1 second.
	self assert: benchmarkResult timePerExecution equals: 1 second.
	"cover the code at least"
	self deny: benchmarkResult shortPrintString isEmpty.
	self deny: benchmarkResult printString isEmpty
	
! !

!Bezier2Segment commentStamp: '<historical>'!
This class represents a quadratic bezier segment between two points

Instance variables:
	via		<Point>	The additional control point (OFF the curve)!
!Bezier2Segment methodsFor: 'converting' stamp: 'ar 6/7/2003 21:05'!
asBezier3Segment
	"Represent the receiver as cubic bezier segment"
	^Bezier3Segment
		from: start
		via: 2*via+start / 3.0
		and: 2*via+end / 3.0
		to: end! !

!Bezier2Segment methodsFor: 'bezier clipping' stamp: 'ar 6/7/2003 23:45'!
bezierClipHeight: dir
	| dirX dirY uMin uMax dx dy u |
	dirX := dir x.
	dirY := dir y.
	uMin := 0.0.
	uMax := (dirX * dirX) + (dirY * dirY).
	dx := via x - start x.
	dy := via y - start y.
	u := (dirX * dx) + (dirY * dy).
	u < uMin ifTrue:[uMin := u].
	u > uMax ifTrue:[uMax := u].
	^uMin@uMax! !

!Bezier2Segment methodsFor: 'accessing' stamp: 'ar 11/2/1998 12:14'!
bounds
	"Return the bounds containing the receiver"
	^super bounds encompass: via! !

!Bezier2Segment methodsFor: 'initialize' stamp: 'ar 6/6/2003 03:03'!
from: startPoint to: endPoint withMidPoint: pointOnCurve at: parameter
	"Initialize the receiver with the pointOnCurve at the given parametric value"
	| t1 t2 t3 |
	start := startPoint.
	end := endPoint.
	"Compute via"
	t1 := (1.0 - parameter) squared.
	t2 := 1.0 / (2 * parameter * (1.0 - parameter)).
	t3 := parameter squared.
	via := (pointOnCurve - (start * t1)  - (end * t3)) * t2! !

!Bezier2Segment methodsFor: 'vector functions' stamp: 'ar 6/9/2003 03:43'!
parameterAtExtremeY
	"Note: Only valid for non-monoton receivers"
	^self parameterAtExtreme: 1.0@0.0.
! !

!Bezier2Segment methodsFor: 'initialize' stamp: 'ar 11/2/1998 12:13'!
from: startPoint to: endPoint
	"Initialize the receiver as straight line"
	start := startPoint.
	end := endPoint.
	via := (start + end) // 2.! !

!Bezier2Segment methodsFor: 'initialize' stamp: 'ar 6/7/2003 22:37'!
from: startPoint to: endPoint withMidPoint: pointOnCurve
	"Initialize the receiver with the pointOnCurve assumed at the parametric value 0.5"
	start := startPoint.
	end := endPoint.
	"Compute via"
	via := (pointOnCurve * 2) - (start + end * 0.5).! !

!Bezier2Segment methodsFor: 'vector functions' stamp: 'ar 11/2/1998 12:16'!
tangentAtStart
	"Return the tangent for the first point"
	^via - start! !

!Bezier2Segment methodsFor: 'converting' stamp: 'ar 11/2/1998 12:17'!
asBezier2Segment
	"Represent the receiver as quadratic bezier segment"
	^self! !

!Bezier2Segment methodsFor: 'testing' stamp: 'ar 11/2/1998 12:15'!
isStraight
	"Return true if the receiver represents a straight line"
	^(self tangentAtStart crossProduct: self tangentAtEnd) = 0! !

!Bezier2Segment methodsFor: 'testing' stamp: 'ar 11/2/1998 12:15'!
hasZeroLength
	"Return true if the receiver has zero length"
	^start = end and:[start = via]! !

!Bezier2Segment methodsFor: 'accessing' stamp: 'ar 11/2/1998 12:14'!
via
	"Return the control point"
	^via! !

!Bezier2Segment methodsFor: 'vector functions' stamp: 'ar 11/2/1998 12:16'!
tangentAtEnd
	"Return the tangent for the last point"
	^end - via! !

!Bezier2Segment methodsFor: 'printing' stamp: 'ar 11/2/1998 12:18'!
printOn: aStream
	"Print the receiver on aStream"
	aStream 
		nextPutAll: self class name;
		nextPutAll:' from: ';
		print: start;
		nextPutAll: ' via: ';
		print: via;
		nextPutAll: ' to: ';
		print: end;
		space.! !

!Bezier2Segment methodsFor: 'vector functions' stamp: 'ar 6/7/2003 00:08'!
controlPoints
	^{start. via. end}! !

!Bezier2Segment methodsFor: 'vector functions' stamp: 'ar 6/7/2003 23:39'!
controlPointsDo: aBlock
	aBlock value: start; value: via; value: end! !

!Bezier2Segment methodsFor: 'vector functions' stamp: 'ar 11/2/1998 12:15'!
length
	"Return the length of the receiver"
	"Note: Overestimates the length"
	^(start dist: via) + (via dist: end)! !

!Bezier2Segment methodsFor: 'vector functions' stamp: 'pmm 3/13/2010 11:21'!
curveFrom: param1 to: param2
	"Return a new curve from param1 to param2"
	| newStart newEnd newVia tan1 tan2 d1 d2 |
	tan1 := via - start.
	tan2 := end - via.
	param1 <= 0.0 ifTrue:[
		newStart := start.
	] ifFalse:[
		d1 := tan1 * param1 + start.
		d2 := tan2 * param1 + via.
		newStart := (d2 - d1) * param1 + d1
	].
	param2 >= 1.0 ifTrue:[
		newEnd := end.
	] ifFalse:[
		d1 := tan1 * param2 + start.
		d2 := tan2 * param2 + via.
		newEnd := (d2 - d1) * param2 + d1.
	].
	tan2 := (tan2 - tan1 * param1 + tan1) * (param2 - param1).
	newVia := newStart + tan2.
	^self shallowCopy from: newStart to: newEnd via: newVia.! !

!Bezier2Segment methodsFor: 'vector functions' stamp: 'ar 11/6/1998 23:39'!
lineSegmentsDo: aBlock
	"Evaluate aBlock with the receiver's line segments"
	"Note: We could use forward differencing here."
	| steps last deltaStep t next |
	steps := 1 max: (self length // 10). "Assume 10 pixels per step"
	last := start.
	deltaStep := 1.0 / steps asFloat.
	t := deltaStep.
	1 to: steps do:[:i|
		next := self valueAt: t.
		aBlock value: last value: next.
		last := next.
		t := t + deltaStep].! !

!Bezier2Segment methodsFor: 'initialize' stamp: 'ar 6/7/2003 00:09'!
initializeFrom: controlPoints
	controlPoints size = 3 ifFalse:[self error:'Wrong number of control points'].
	start := controlPoints at: 1.
	via := controlPoints at: 2.
	end := controlPoints at: 3.! !

!Bezier2Segment methodsFor: 'vector functions' stamp: 'ar 6/9/2003 03:43'!
parameterAtExtremeX
	"Note: Only valid for non-monoton receivers"
	^self parameterAtExtreme: 0.0@1.0.
! !

!Bezier2Segment methodsFor: 'vector functions' stamp: 'ar 6/8/2003 00:54'!
tangentAtMid
	"Return the tangent at the given parametric value along the receiver"
	| in out |
	in := self tangentAtStart.
	out := self tangentAtEnd.
	^in + out * 0.5! !

!Bezier2Segment methodsFor: 'vector functions' stamp: 'ar 11/2/1998 12:16'!
tangentAt: parameter
	"Return the tangent at the given parametric value along the receiver"
	| in out |
	in := self tangentAtStart.
	out := self tangentAtEnd.
	^in + (out - in * parameter)! !

!Bezier2Segment methodsFor: 'converting' stamp: 'ar 6/7/2003 20:58'!
asTangentSegment
	^LineSegment from: via-start to: end-via! !

!Bezier2Segment methodsFor: 'vector functions' stamp: 'nk 12/27/2003 13:00'!
roundTo: quantum
	super roundTo: quantum.
	via := via roundTo: quantum.
! !

!Bezier2Segment methodsFor: 'converting' stamp: 'ar 6/8/2003 04:19'!
asBezier2Points: error
	^Array with: start with: via with: end! !

!Bezier2Segment methodsFor: 'vector functions' stamp: 'ar 6/7/2003 17:21'!
lineSegments: steps do: aBlock
	"Evaluate aBlock with the receiver's line segments"
	"Note: We could use forward differencing here."
	| last deltaStep t next |
	last := start.
	deltaStep := 1.0 / steps asFloat.
	t := deltaStep.
	1 to: steps do:[:i|
		next := self valueAt: t.
		aBlock value: last value: next.
		last := next.
		t := t + deltaStep].! !

!Bezier2Segment methodsFor: 'initialize' stamp: 'ar 11/2/1998 12:13'!
from: startPoint to: endPoint via: viaPoint
	"Initialize the receiver"
	start := startPoint.
	end := endPoint.
	via := viaPoint.! !

!Bezier2Segment methodsFor: 'vector functions' stamp: 'ar 6/7/2003 00:04'!
outlineSegment: width
	| delta newStart newEnd param newMid |
	delta := self tangentAtStart normalized * width.
	delta := delta y @ delta x negated.
	newStart := start + delta.
	delta := self tangentAtEnd normalized * width.
	delta := delta y @ delta x negated.
	newEnd := end + delta.
	param := 0.5. "self tangentAtStart r / (self tangentAtStart r + self tangentAtEnd r)."
	delta := (self tangentAt: param) normalized * width.
	delta := delta y @ delta x negated.
	newMid := (self valueAt: param) + delta.
	^self class from: newStart to: newEnd withMidPoint: newMid at: param! !

!Bezier2Segment methodsFor: 'converting' stamp: 'ar 11/2/1998 12:18'!
asIntegerSegment
	"Convert the receiver into integer representation"
	^self species 
			from: start asIntegerPoint 
			to: end asIntegerPoint 
			via: via asIntegerPoint! !

!Bezier2Segment methodsFor: 'accessing' stamp: 'ar 6/8/2003 00:07'!
degree
	^2! !

!Bezier2Segment methodsFor: 'testing' stamp: 'ar 11/2/1998 12:15'!
isBezier2Segment
	"Return true if the receiver is a quadratic bezier segment"
	^true! !

!Bezier2Segment methodsFor: 'vector functions' stamp: 'ar 11/2/1998 12:17'!
valueAt: parameter
	"Evaluate the receiver at the given parametric value"
	"Return the point at the parametric value t:
		p(t) =	(1-t)^2 * p1 + 
				2*t*(1-t) * p2 + 
				t^2 * p3.
	"
	| t1 t2 t3 |
	t1 := (1.0 - parameter) squared.
	t2 := 2 * parameter * (1.0 - parameter).
	t3 := parameter squared.
	^(start * t1) + (via * t2) + (end * t3)! !

!Bezier2Segment methodsFor: 'vector functions' stamp: 'ar 6/9/2003 03:43'!
parameterAtExtreme: tangentDirection
	"Compute the parameter value at which the tangent reaches tangentDirection.
	We need to find the parameter value t at which the following holds

		((t * dir + in) crossProduct: tangentDirection) = 0.

	Since this is pretty ugly we use the normal direction rather than the tangent and compute the equivalent relation using the dot product as

		((t * dir + in) dotProduct: nrm) = 0.

	Reformulation yields

		((t * dir x + in x) * nrm x) + ((t * dir y + in y) * nrm y) = 0.
		(t * dir x * nrm x) + (in x * nrm x) + (t * dir y * nrm y) + (in y * nrm y) = 0.
		(t * dir x * nrm x) + (t * dir y * nrm y) = 0 - ((in x * nrm x) + (in y * nrm y)).

				(in x * nrm x) + (in y * nrm y)
		t = 0 -	---------------------------------------
			 	(dir x * nrm x) + (dir y * nrm y)
	And that's that. Note that we can get rid of the negation by computing 'dir' the other way around (e.g., in the above it would read '-dir') which is trivial to do. Note also that the above does not generalize easily beyond 2D since its not clear how to express the 'normal direction' of a tangent plane.
	"
	| inX inY dirX dirY nrmX nrmY |
	"Compute in"
	inX := via x - start x.
	inY := via y - start y.
	"Compute -dir"
	dirX := inX - (end x - via x).
	dirY := inY - (end y - via y).
	"Compute nrm"
	nrmX := tangentDirection y.
	nrmY := 0 - tangentDirection x.
	"Compute result"
	^((inX * nrmX) + (inY * nrmY)) / 
		((dirX * nrmX) + (dirY * nrmY))! !

!Bezier2Segment class methodsFor: 'instance creation' stamp: 'ar 11/1/1998 21:30'!
from: startPoint withMidPoint: pointOnCurve to: endPoint 
	^self new from: startPoint to: endPoint withMidPoint: pointOnCurve! !

!Bezier2Segment class methodsFor: 'instance creation' stamp: 'ar 11/1/1998 21:32'!
from: startPoint to: endPoint withMidPoint: pointOnCurve at: parameter
	^self new from: startPoint to: endPoint withMidPoint: pointOnCurve at: parameter! !

!Bezier2Segment class methodsFor: 'instance creation' stamp: 'ar 11/1/1998 21:30'!
from: startPoint via: viaPoint to: endPoint 
	^self new from: startPoint to: endPoint via: viaPoint! !

!Bezier2Segment class methodsFor: 'utilities' stamp: 'ar 6/7/2003 18:33'!
makeEllipseSegments: aRectangle
	"Answer a set of bezier segments approximating an ellipsoid fitting the given rectangle.
	This method creates eight bezier segments (two for each quadrant) approximating the oval."
	"EXAMPLE: 
	This example draws an oval with a red border and overlays the approximating bezier segments on top of the oval (drawn in black), thus giving an impression of how closely the bezier resembles the oval. Change the rectangle to see how accurate the approximation is for various radii of the oval.
		| rect |
		rect := 100@100 extent: 1200@500.
		Display getCanvas fillOval: rect color: Color yellow borderWidth: 1 borderColor: Color red.
		(Bezier2Segment makeEllipseSegments: rect) do:[:seg|
			seg lineSegmentsDo:[:last :next|
				Display getCanvas line: last to: next width: 1 color: Color black]].
	"
	"EXAMPLE: 
		| minRadius maxRadius |
		maxRadius := 300.
		minRadius := 20.
		maxRadius to: minRadius by: -10 do:[:rad|
			| rect |
			rect := 400@400 - rad corner: 400@400 + rad.
			Display getCanvas fillOval: rect color: Color yellow borderWidth: 1 borderColor: Color red.
			(Bezier2Segment makeEllipseSegments: rect) do:[:seg|
				seg lineSegmentsDo:[:last :next|
					Display getCanvas line: last to: next width: 1 color: Color black]]].
	"
	| nrm topCenter leftCenter rightCenter bottomCenter dir scale seg1a topRight seg1b seg2a bottomRight seg2b center bottomLeft topLeft seg3a seg3b seg4a seg4b |
	dir := aRectangle width * 0.5.
	nrm := aRectangle height * 0.5.

	"Compute the eight control points on the oval"
	scale := 0.7071067811865475. "45 degreesToRadians cos = 45 degreesToRadians sin = 2 sqrt / 2"
	center := aRectangle origin + aRectangle corner * 0.5.

	topCenter := aRectangle topCenter.
	rightCenter := aRectangle rightCenter.
	leftCenter := aRectangle leftCenter.
	bottomCenter := aRectangle bottomCenter.

	topRight := (center x + (dir * scale)) @ (center y - (nrm * scale)).
	bottomRight := (center x + (dir * scale)) @ (center y + (nrm * scale)).
	bottomLeft := (center x - (dir * scale)) @ (center y + (nrm * scale)).
	topLeft := (center x - (dir * scale)) @ (center y - (nrm * scale)).

	scale := 0.414213562373095. "2 sqrt - 1"

	dir := (dir * scale) @ 0.
	nrm := 0 @ (nrm * scale).
	
	seg1a := self from: topCenter via: topCenter + dir to: topRight.
	seg1b := self from: topRight via: rightCenter - nrm to: rightCenter.

	seg2a := self from: rightCenter via: rightCenter + nrm to: bottomRight.
	seg2b := self from: bottomRight via: bottomCenter + dir to: bottomCenter.

	seg3a := self from: bottomCenter via: bottomCenter - dir to: bottomLeft.
	seg3b := self from: bottomLeft via: leftCenter + nrm to: leftCenter.

	seg4a := self from: leftCenter via: leftCenter - nrm to: topLeft.
	seg4b := self from: topLeft via: topCenter - dir to: topCenter.

	^{seg1a. seg1b. seg2a. seg2b. seg3a. seg3b. seg4a. seg4b}! !

!Bezier2Segment class methodsFor: 'instance creation' stamp: 'ar 11/1/1998 21:30'!
from: startPoint to: endPoint withMidPoint: pointOnCurve
	^self new from: startPoint to: endPoint withMidPoint: pointOnCurve! !

!Bezier2Segment class methodsFor: 'instance creation' stamp: 'ar 11/1/1998 21:14'!
from: startPoint to: endPoint via: viaPoint
	^self new from: startPoint to: endPoint via: viaPoint! !

!Bezier2Segment class methodsFor: 'instance creation' stamp: 'ar 11/1/1998 21:32'!
from: startPoint withMidPoint: pointOnCurve at: parameter to: endPoint 
	^self new from: startPoint to: endPoint withMidPoint: pointOnCurve at: parameter! !

!Bezier3Segment commentStamp: '<historical>'!
This class represents a cubic bezier segment between two points

Instance variables:
	via1, via2	<Point>	The additional control points (OFF the curve)!
!Bezier3Segment methodsFor: 'initialization' stamp: 'DSM 10/14/1999 15:33'!
from: aPoint1 via: aPoint2 and: aPoint3 to: aPoint4
	start := aPoint1.
	via1 := aPoint2.
	via2 := aPoint3.
	end := aPoint4! !

!Bezier3Segment methodsFor: 'accessing' stamp: 'DSM 10/15/1999 15:20'!
bounds
	^ ((super bounds encompassing: via1) encompassing: via2)! !

!Bezier3Segment methodsFor: 'bezier clipping' stamp: 'ar 6/7/2003 23:45'!
bezierClipHeight: dir
	"Check if the argument overlaps the receiver somewhere 
	along the line from start to end. Optimized for speed."
	| u dirX dirY dx dy uMin uMax |
	dirX := dir x.
	dirY := dir y.
	uMin := 0.0.
	uMax := (dirX * dirX) + (dirY * dirY).

	dx := via1 x - start x.
	dy := via1 y - start y.
	u := (dirX * dx) + (dirY * dy).
	u < uMin ifTrue:[uMin := u].
	u > uMax ifTrue:[uMax := u].

	dx := via2 x - start x.
	dy := via2 y - start y.
	u := (dirX * dx) + (dirY * dy).
	u < uMin ifTrue:[uMin := u].
	u > uMax ifTrue:[uMax := u].

	^uMin@uMax! !

!Bezier3Segment methodsFor: 'vector functions' stamp: 'ar 6/6/2003 22:01'!
tangentAtStart
	^via1 - start! !

!Bezier3Segment methodsFor: 'converting' stamp: 'ar 6/6/2003 22:23'!
asBezierShape
	"Demote a cubic bezier to a set of approximating quadratic beziers."
	^self asBezierShape: 0.5! !

!Bezier3Segment methodsFor: 'vector functions' stamp: 'ar 6/6/2003 22:02'!
tangentAtEnd
	^end - via2! !

!Bezier3Segment methodsFor: 'vector functions' stamp: 'ar 6/8/2003 00:56'!
tangentAtMid
	| tan1 tan2 tan3 |
	tan1 := via1 - start.
	tan2 := via2 - via1.
	tan3 := end - via2.
	^(tan1 + (2*tan2) + tan3) * 0.25
! !

!Bezier3Segment methodsFor: 'vector functions' stamp: 'ar 6/7/2003 23:39'!
controlPointsDo: aBlock
	aBlock value: start; value: via1; value: via2; value: end! !

!Bezier3Segment methodsFor: 'vector functions' stamp: 'ar 6/7/2003 00:08'!
controlPoints
	^{start. via1. via2. end}! !

!Bezier3Segment methodsFor: 'accessing' stamp: 'ar 6/6/2003 21:59'!
length
	"Answer a gross approximation of the length of the receiver"
	^(start dist: via1) + (via1 dist: via2) + (via2 dist: end)! !

!Bezier3Segment methodsFor: 'private' stamp: 'DSM 10/14/1999 16:25'!
bezier2SegmentCount
	"Compute the number of quadratic bezier segments needed to approximate
	this cubic with less than a 1-pixel error"
	^ self bezier2SegmentCount: 1.0! !

!Bezier3Segment methodsFor: 'vector functions' stamp: 'ar 6/6/2003 21:52'!
lineSegmentsDo: aBlock
	"Evaluate aBlock with the receiver's line segments"
	"Note: We could use forward differencing here."
	| steps last deltaStep t next |
	steps := 1 max: (self length // 10). "Assume 10 pixels per step"
	last := start.
	deltaStep := 1.0 / steps asFloat.
	t := deltaStep.
	1 to: steps do:[:i|
		next := self valueAt: t.
		aBlock value: last value: next.
		last := next.
		t := t + deltaStep].! !

!Bezier3Segment methodsFor: 'initialization' stamp: 'ar 6/7/2003 00:09'!
initializeFrom: controlPoints
	controlPoints size = 4 ifFalse:[self error:'Wrong number of control points'].
	start := controlPoints at: 1.
	via1 := controlPoints at: 2.
	via2 := controlPoints at: 3.
	end := controlPoints at: 4.! !

!Bezier3Segment methodsFor: 'accessing' stamp: 'ar 6/6/2003 22:37'!
via1
	^via1! !

!Bezier3Segment methodsFor: 'vector functions' stamp: 'ar 6/7/2003 19:25'!
tangentAt: parameter
	| tan1 tan2 tan3 t1 t2 t3 |
	tan1 := via1 - start.
	tan2 := via2 - via1.
	tan3 := end - via2.
	t1 := (1.0 - parameter) squared.
	t2 := 2 * parameter * (1.0 - parameter).
	t3 := parameter squared.
	^(tan1 * t1) + (tan2 * t2) + (tan3 * t3)! !

!Bezier3Segment methodsFor: 'converting' stamp: 'ar 6/7/2003 20:58'!
asTangentSegment
	^Bezier2Segment 
		from: via1-start 
		via: via2-via1
		to: end-via2! !

!Bezier3Segment methodsFor: 'converting' stamp: 'ar 6/7/2003 21:07'!
asBezier2Points: error
	"Demote a cubic bezier to a set of approximating quadratic beziers.
	Should convert to forward differencing someday"

	| curves pts step prev index a b f |
	curves := self bezier2SegmentCount: error.
	pts := Array new: curves * 3.
	step := 1.0 / (curves * 2).
	prev := start.
	1 to: curves do: [ :c |
		index := 3*c.
		a := pts at: index-2 put: prev.
		b := (self valueAt: (c*2-1)*step).
		f := pts at: index put: (self valueAt: (c*2)*step).
		pts at: index-1 put: (4 * b - a - f) / 2.
		prev := pts at: index.
		].
	^ pts.
	! !

!Bezier3Segment methodsFor: 'vector functions' stamp: 'ar 6/7/2003 17:21'!
lineSegments: steps do: aBlock
	"Evaluate aBlock with the receiver's line segments"
	"Note: We could use forward differencing here."
	| last deltaStep t next |
	last := start.
	deltaStep := 1.0 / steps asFloat.
	t := deltaStep.
	1 to: steps do:[:i|
		next := self valueAt: t.
		aBlock value: last value: next.
		last := next.
		t := t + deltaStep].! !

!Bezier3Segment methodsFor: 'vector functions' stamp: 'ar 6/7/2003 00:04'!
outlineSegment: width
	| tan1 nrm1 tan2 nrm2 newStart newVia1 newEnd newVia2 dist |
	tan1 := (via1 - start) normalized.
	nrm1 := tan1 * width.
	nrm1 := nrm1 y @ nrm1 x negated.
	tan2 := (end - via2) normalized.
	nrm2 := tan2 * width.
	nrm2 := nrm2 y @ nrm2 x negated.
	newStart := start + nrm1.
	newEnd := end + nrm2.
	dist := (newStart dist: newEnd) * 0.3.
	newVia1 := newStart + (tan1 * dist).
	newVia2 := newEnd - (tan2 * dist).
	^self class from: newStart via: newVia1 and: newVia2 to: newEnd.
! !

!Bezier3Segment methodsFor: 'accessing' stamp: 'DSM 10/14/1999 15:31'!
via2: aPoint
	via2 := aPoint! !

!Bezier3Segment methodsFor: 'accessing' stamp: 'ar 6/6/2003 22:37'!
via2
	^via2! !

!Bezier3Segment methodsFor: 'accessing' stamp: 'DSM 10/14/1999 15:31'!
via1: aPoint
	via1 := aPoint! !

!Bezier3Segment methodsFor: 'converting' stamp: 'ar 6/7/2003 21:09'!
asBezierShape: error
	"Demote a cubic bezier to a set of approximating quadratic beziers.
	Should convert to forward differencing someday"
	^(self asBezier2Points: error) asPointArray.! !

!Bezier3Segment methodsFor: 'accessing' stamp: 'ar 6/8/2003 00:07'!
degree
	^3! !

!Bezier3Segment methodsFor: 'converting' stamp: 'DSM 3/10/2000 12:10'!
bezier2SegmentCount: pixelError
	"Compute the number of quadratic bezier segments needed to approximate
	this cubic with no more than a specified error"
	| a |
	a := (start x negated @ start y negated) + (3 * via1) - (3 * via2) +
(end).
	^ (((a r / (20.0 * pixelError)) raisedTo: 0.333333) ceiling) max: 1.

! !

!Bezier3Segment methodsFor: 'converting' stamp: 'ar 6/7/2003 21:07'!
asBezier2Segments
	"Demote a cubic bezier to a set of approximating quadratic beziers."
	^self asBezier2Segments: 0.5! !

!Bezier3Segment methodsFor: 'accessing' stamp: 'DSM 10/15/1999 15:01'!
valueAt: t
	| a b c d |

	"| p1 p2 p3 |
	p1 := start interpolateTo: via1 at: t.
	p2 := via1 interpolateTo: via2 at: t.
	p3 := via2 interpolateTo: end at: t.
	p1 := p1 interpolateTo: p2 at: t.
	p2 := p2 interpolateTo: p3 at: t.
	^ p1 interpolateTo: p2 at: t"

	a := (start negated) + (3 * via1) - (3 * via2) + (end).
	b := (3 * start) - (6 * via1) + (3 * via2).
	c := (3 * start negated) + (3 * via1).
	d := start.
	^ ((a * t + b) * t + c) * t + d

! !

!Bezier3Segment methodsFor: 'converting' stamp: 'DSM 10/15/1999 15:45'!
asPointArray
	| p |
	p := PointArray new: 4.
	p at: 1 put: start.
	p at: 2 put: via1.
	p at: 3 put: via2.
	p at: 4 put: end.
	^ p! !

!Bezier3Segment class methodsFor: 'utilities' stamp: 'ar 6/8/2003 03:53'!
makePieSegments: aRectangle from: angle1 to: angle2
	"Create a series of cubic bezier segments for the oval inscribed in aRectangle between angle1 and angle2. The segments are oriented clockwise, to get counter-clockwise segments simply switch angle1 and angle2."
	angle2 < angle1 ifTrue:[
		"ccw segments"
		^(self makePieSegments: aRectangle from: angle2 to: angle1) 
			reversed collect:[:seg| seg reversed]
	].
	"Split up segments if larger than 120 degrees"
	angle2 - angle1 > 120 ifTrue:["subdivide"
		| midAngle |
		midAngle := angle1 + angle2 * 0.5.
		^(self makePieSegments: aRectangle from: angle1 to: midAngle),
			(self makePieSegments: aRectangle from: midAngle to: angle2).
	].
	"Create actual pie segment"
	^self makePieSegment: aRectangle from: angle1 to: angle2
! !

!Bezier3Segment class methodsFor: 'instance creation' stamp: 'DSM
10/15/1999 15:24'!
from: p1 via: p2 and: p3 to: p4
	^ self new from: p1 via: p2 and: p3 to: p4! !

!Bezier3Segment class methodsFor: 'utilities' stamp: 'ar 6/8/2003 03:26'!
makePieSegment: aRectangle from: angle1 to: angle2
	"Create a single pie segment for the oval inscribed in aRectangle between angle1 and angle2. If angle1 is less than angle2 this method creates a CW pie segment, otherwise it creates a CCW pie segment."
	| seg center scale |
	angle1 > angle2 ifTrue:["ccw"
		^(self makePieSegment: aRectangle from: angle2 to: angle1) reversed
	].
	"create a unit circle pie segment from angle1 to angle2"
	seg := self makeUnitPieSegmentFrom: angle1 to: angle2.
	"scale the segment to fit aRectangle"
	center := aRectangle origin + aRectangle corner * 0.5.
	scale := aRectangle extent * 0.5.
	^self controlPoints: (seg controlPoints collect:[:pt| pt * scale + center])! !

!Bezier3Segment class methodsFor: 'utilities' stamp: 'DSM 10/15/1999 16:06'!
convertBezier3ToBezier2: vertices
	| pa pts index c |
	pts := OrderedCollection new.
	1 to: vertices size // 4 do:
		[:i |
		index := i * 4 - 3.
		c := Bezier3Segment new
					from: (vertices at: index)
					via: (vertices at: index + 1)
					and: (vertices at: index + 2)
					to: (vertices at: index + 3).
		pts addAll: c asBezierShape].
	pa := PointArray new: pts size.
	pts withIndexDo: [:p :i | pa at: i put: p ].
	^ pa! !

!Bezier3Segment class methodsFor: 'utilities' stamp: 'ar 6/8/2003 04:45'!
makeUnitPieSegmentWith: point1 and: point2
	"Create a clockwise unit pie segment from point1 to point2, that is a pie segment for a circle centered at zero with radius one."
	| pt1 pt2 dir1 dir2 mid length scale cp1 cp2 pt3 magic |
	"point1 and point2 are the points on the unit circle
	for accuracy (or broken input), renormalize them."
	pt1 := point1 normalized.
	pt2 := point2 normalized.
	"compute the normal vectors - those are tangent directions for the bezier"
	dir1 := pt1 y negated @ pt1 x.
	dir2 := pt2 y negated @ pt2 x.
	"Okay, now that we have the points and tangents on the unit circle, let's do the magic. For fitting a cubic bezier onto a circle section we know that we want the end points be on the circle and the tangents to point towards the right direction (both of which we have in the above). What we do NOT know is how to scale the tangents so that midpoint of the bezier is exactly on the circle.
	The good news is that there is a linear relation between the length of the tangent vectors and the distance of the midpoint from the circle's origin. The bad news is that I don't know how to derive it analytically. So what I do here is simply sampling the bezier twice (not really - the first sample is free) and then to compute the distance from the sample."

	"The first sample is just between the two points on the curve"
	mid := pt1 + pt2 * 0.5.

	"The second sample will be taken from the curve with coincident control points at the intersection of dir1 and dir2, which simplifies significantly with a little understanding about trigonometry, since the angle formed between mid, pt1 and the intersection is the same as between the center, pt1 and mid."
	length := mid r.
	"length is not only the distance from the center of the unit circle but also the sine of the angle between the circle's center, pt1 and mid (since center is at zero and pt1 has unit length). Therefore, to scale dir1 to the intersection with dir2 we can use mid's distance from pt1 and simply divide it by the sine value."
	scale := (mid dist: pt1).
	length > 0.0 ifTrue:[ scale := scale / length].
	"now sample the cubic bezier (optimized version for coincident control points)"
	cp1 := pt1 + (dir1 * (scale * 0.75)).
	cp2 := pt2 - (dir2 * (scale * 0.75)).
	pt3 := cp1 + cp2 * 0.5.
	"compute the magic constant"
	scale := (pt3 - mid) r / scale.
	magic := 1.0 - length / scale.
	"and finally answer the pie segment"
	^self
		from: pt1
		via: pt1 + (dir1 * magic)
		and: pt2 - (dir2 * magic)
		to: pt2! !

!Bezier3Segment class methodsFor: 'instance creation' stamp: 'DSM
10/15/1999 15:23'!
from: p1 to: p2
	^ self new from: p1 via: (p1 interpolateTo: p2 at: 0.3333) and: (p1
interpolateTo: p2 at: 0.66667) to: p2! !

!Bezier3Segment class methodsFor: 'utilities' stamp: 'ar 6/8/2003 03:25'!
makeEllipseSegments: aRectangle
	"Answer a set of bezier segments approximating an ellipsoid fitting the given rectangle.
	This method creates four bezier segments (one for each quadrant) approximating the oval."
	"EXAMPLE: 
	This example draws an oval with a red border and overlays the approximating bezier segments on top of the oval (drawn in black), thus giving an impression of how closely the bezier resembles the oval. Change the rectangle to see how accurate the approximation is for various radii of the oval.
		| rect |
		rect := 100@100 extent: 500@200.
		Display getCanvas fillOval: rect color: Color yellow borderWidth: 1 borderColor: Color red.
		(Bezier3Segment makeEllipseSegments: rect) do:[:seg|
			seg lineSegmentsDo:[:last :next|
				Display getCanvas line: last to: next width: 1 color: Color black]].
	"
	"EXAMPLE: 
		| minRadius maxRadius |
		maxRadius := 300.
		minRadius := 20.
		maxRadius to: minRadius by: -10 do:[:rad|
			| rect |
			rect := 400@400 - rad corner: 400@400 + rad.
			Display getCanvas fillOval: rect color: Color yellow borderWidth: 1 borderColor: Color red.
			(Bezier3Segment makeEllipseSegments: rect) do:[:seg|
				seg lineSegmentsDo:[:last :next|
					Display getCanvas line: last to: next width: 1 color: Color black]]].
	"
	^self makeEllipseSegments: aRectangle count: 4! !

!Bezier3Segment class methodsFor: 'utilities' stamp: 'ar 6/8/2003 03:59'!
makeUnitPieSegmentFrom: angle1 to: angle2
	"Create a clockwise unit pie segment from angle1 to angle2, that is a pie segment for a circle centered at zero with radius one. Note: This method can be used to create at most a quarter circle."
	| pt1 pt2 rad1 rad2 |
	rad1 := angle1 degreesToRadians.
	rad2 := angle2 degreesToRadians.
	pt1 := rad1 sin @ rad1 cos negated.
	pt2 := rad2 sin @ rad2 cos negated.
	^self makeUnitPieSegmentWith: pt1 and: pt2! !

!Bezier3Segment class methodsFor: 'utilities' stamp: 'eem 6/11/2008 16:08'!
makeEllipseSegments: aRectangle count: segmentCount
	"Answer a set of bezier segments approximating an ellipsoid fitting the given rectangle.
	This method creates segmentCount bezier segments (one for each quadrant) approximating the oval."
	| count angle center scale |
	center := aRectangle origin + aRectangle corner * 0.5.
	scale := aRectangle extent * 0.5.
	count := segmentCount max: 2. "need at least two segments"
	angle := 360.0 / count.
	^(1 to: count) collect:[:i| | seg |
		seg := self makeUnitPieSegmentFrom: i-1*angle to: i*angle.
		self controlPoints: (seg controlPoints collect:[:pt| pt * scale + center])
	].! !

!BigCogInitialState commentStamp: '<historical>'!
I am the initial state!
!BigCogInitialState methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/26/2013 22:28'!
nextState

	^ BigCogState2 new! !

!BigCogInitialState methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/26/2013 22:30'!
stepTime

	^ 50! !

!BigCogInitialState class methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/26/2013 22:41'!
imageData

	^ #(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 144678815 1538898361 2327559099 2679814842 2595862969 2411313593 2109389498 1740290746 1287240121 783792055 229749169 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1186642618 3904617403 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3904617403 3250240186 2545597114 1790556601 767278011 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1169799609 4240095930 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3116022458 515619771 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 246855350 3904617403 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3854219962 548911031 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2025569211 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3283860411 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3552230074 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1035516088 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 279949231 4273716155 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2361047738 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1203485627 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3166354106 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2143009723 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3686447802 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3065690810 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4038835131 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3988437690 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 129414838 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 649442741 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 481736374 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1589164216 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 850966712 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 93952409 1538898361 2881141434 3552230074 3652959163 3065690810 1807399610 279949231 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2528885691 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1220065464 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 314095800 1706802107 2847587002 3569007290 3703290811 3183131322 1639693243 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 448445114 3585850299 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4038835131 1622850234 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3451632571 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1589164216 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 75530368 2327559099 4156275643 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2830875579 75530368 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 397521329 3636181947 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2881141434 196721081 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 162179754 4223384507 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1958460347 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 397521329 3267083195 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2830875579 61516458 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 364295862 3585850299 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3535518651 599176886 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1035516088 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2327559099 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 934918585 3837508539 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2763766715 41975936 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 330215086 3535518651 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4005214906 1236908473 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1958460347 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2696592058 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1723447737 4189764282 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2679814842 16777216 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 297055412 3485121210 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4256873146 2143009723 16777216 0 0 0 0 0 0 0 0 0 0 0 0 2897984443 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3048913594 0 0 0 0 0 0 0 0 0 0 0 0 0 129414838 2612705978 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2595862969 16777216 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 279949231 3434789562 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3065690810 314095800 0 0 0 0 0 0 0 0 0 0 0 3837508539 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3418012346 0 0 0 0 0 0 0 0 0 0 0 0 481736374 3384457914 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2495265466 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 246855350 3384457914 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3753556666 867809721 0 0 0 0 0 0 0 0 0 481736374 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3837508539 111848106 0 0 0 0 0 0 0 0 0 0 1069202106 3921328826 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2394667963 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 229749169 3350903482 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4172987066 1723447737 0 0 0 0 0 0 0 0 1404614840 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4005214906 2595862969 1085781943 41975936 0 0 0 0 0 0 1891351483 4223384507 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2277227451 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 41975936 3132799674 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2730146490 179549107 0 0 61516458 700169147 1471789497 2260384442 3535518651 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3837508539 2361047738 850966712 0 0 179549107 2780543931 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1891351483 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1907997113 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3552230074 2629483194 3418012346 4156275643 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3619338938 2143009723 3501898426 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4122655418 414561717 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3636181947 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1991948986 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4273716155 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2965093307 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 16777216 4055546554 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3166354106 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3032202171 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2629483194 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1287240121 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1236908473 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3267083195 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3099245242 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 666351543 4139498427 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3938106042 498710969 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1740290746 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4206607291 1035516088 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2881141434 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1824242619 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 279949231 3753556666 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2730146490 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 934918585 4206607291 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3518741435 162179754 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1958460347 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4055546554 632994490 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 16777216 3032202171 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1404614840 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 330215086 3803888314 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2428156602 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 968341431 4223384507 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3384457914 93952409 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1941617338 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4005214906 532002229 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2948316091 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1354348985 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 279949231 3720068027 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2444933818 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2461776827 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1354348985 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3787176891 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2730146490 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 884652730 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3904617403 3434789562 3032202171 2612705978 2713435067 3132799674 3552230074 4055546554 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4022057915 93952409 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2277227451 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4256873146 3300571834 2008726202 716617398 0 0 0 0 0 0 0 61516458 1035516088 2327559099 3636181947 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1203485627 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3652959163 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2998581946 750369209 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1270594491 3535518651 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2595862969 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 733526200 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3451632571 985250233 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 41975936 1555741370 3904617403 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3921328826 41975936 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2126166714 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2780543931 144678815 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 498710969 3485121210 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1069202106 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3501898426 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4273716155 2059057850 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 179549107 2897984443 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2461776827 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 129414838 783792055 1505409722 2226764217 2948316091 3686447802 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1907997113 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 16777216 2914695866 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4223384507 3569007290 2830875579 2109389498 1354348985 632994490 41975936 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 162179754 817543866 1522252731 2226764217 2931473082 3652959163 4240095930 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2730146490 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 212511402 3552230074 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4139498427 3451632571 2713435067 1975105977 1236908473 498710969 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 464761779 1606007225 2327559099 3015424955 3720068027 4256873146 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3434789562 144678815 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 599176886 4005214906 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4055546554 3334192059 2595862969 1857665465 1169799609 464761779 0 0 0 0 0 0 0 0 330215086 2780543931 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4273716155 767278011 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1740290746 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3401300923 1169799609 0 0 0 0 0 330215086 3585850299 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2814032570 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 93952409 3720068027 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1673116089 0 0 0 0 2998581946 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4240095930 649442741 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1572518586 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4172987066 397521329 0 0 1186642618 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2914695866 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 41975936 3854219962 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1907997113 0 0 3032202171 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1639693243 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2595862969 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2512108475 0 0 3619338938 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4273716155 397521329 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1337505976 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2814032570 0 0 3652959163 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3451632571 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 196721081 4206607291 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2797255354 0 0 3669670586 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2830875579 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3770399675 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2780543931 0 0 3686447802 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2428156602 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3350903482 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2763766715 0 0 3703290811 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2025569211 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2948316091 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2763766715 0 0 3703290811 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1824242619 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2730146490 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2763766715 0 0 3703290811 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2193275578 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3082533819 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2763766715 0 0 3686447802 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2595862969 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3501898426 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2780543931 0 0 3652959163 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3015424955 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3904617403 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2797255354 0 0 3619338938 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3921328826 16777216 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 532002229 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2830875579 0 0 3518741435 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 918075576 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1773910971 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2847587002 0 0 2965093307 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2176498362 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3032202171 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2495265466 0 0 1840888249 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3602561722 41975936 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 347321267 4139498427 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1320860346 0 0 162179754 3602561722 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1522252731 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2344204729 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3350903482 41975936 0 0 0 481736374 3334192059 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3669670586 75530368 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 431536312 4139498427 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3451632571 397521329 0 0 0 0 0 41975936 1354348985 2830875579 3736779450 4273716155 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1773910971 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2595862969 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3971726267 2981804730 1589164216 61516458 0 0 0 0 0 0 0 0 0 0 196721081 884652730 1622850234 2344204729 3065690810 3787176891 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4156275643 867809721 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1538898361 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4240095930 3669670586 2965093307 2293938874 1622850234 968341431 347321267 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 229749169 951827387 1673116089 2394667963 3132799674 3854219962 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3803888314 381270457 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 850966712 4139498427 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3770399675 3015424955 2277227451 1538898361 800635064 129414838 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 279949231 1002093242 1740290746 4022057915 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3283860411 229749169 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 532002229 3787176891 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3736779450 1773910971 1002093242 246855350 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2713435067 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3585850299 582268084 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1018936251 3921328826 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2092546489 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1304017337 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3971726267 1085781943 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1656338873 4189764282 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 683260345 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 129414838 4072389563 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4256873146 2713435067 548911031 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 850966712 3116022458 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3569007290 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2797255354 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4189764282 2428156602 700169147 0 0 0 0 0 0 0 0 0 0 0 16777216 934918585 2847587002 4273716155 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2176498362 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1404614840 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3703290811 2411313593 1287240121 817543866 397521329 41975936 75530368 464761779 884652730 1438300858 2646326203 3904617403 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 767278011 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 179549107 4122655418 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4240095930 4273716155 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3669670586 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2897984443 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2260384442 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2025569211 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1253751482 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 666351543 4072389563 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3569007290 179549107 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 212511402 3602561722 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2763766715 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2881141434 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1773910971 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1941617338 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4172987066 901232567 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1069202106 4223384507 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3770399675 314095800 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 448445114 3904617403 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3065690810 16777216 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 93952409 3300571834 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2109389498 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2428156602 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4256873146 1152956600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1438300858 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3938106042 481736374 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 666351543 4072389563 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3334192059 93952409 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 179549107 3552230074 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2444933818 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2579217339 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1304017337 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 985250233 4273716155 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3501898426 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3166354106 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 850966712 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 314095800 4240095930 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1991948986 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 800635064 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2612705978 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 548911031 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2545597114 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3585850299 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1639693243 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1186642618 4256873146 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4273716155 2293938874 1320860346 3166354106 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4189764282 3434789562 2579217339 1723447737 918075576 2797255354 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3753556666 229749169 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1555741370 4256873146 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4038835131 1337505976 0 0 0 750369209 2579217339 4139498427 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2260384442 834057910 93952409 0 0 0 0 0 2042214841 4256873146 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4089166779 918075576 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1622850234 4273716155 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3518741435 616085688 0 0 0 0 0 0 314095800 2008726202 3803888314 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 397521329 0 0 0 0 0 0 0 0 1270594491 4038835131 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4105878202 1035516088 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1723447737 4273716155 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2713435067 162179754 0 0 0 0 0 0 0 0 0 61516458 1421457849 3283860411 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3820665530 0 0 0 0 0 0 0 0 0 0 666351543 3602561722 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4105878202 1069202106 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1824242619 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4189764282 1757067962 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3870997178 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2965093307 0 0 0 0 0 0 0 0 0 0 0 229749169 2931473082 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4122655418 1085781943 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1924840122 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3787176891 901232567 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3887840187 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2092546489 0 0 0 0 0 0 0 0 0 0 0 0 16777216 2008726202 4240095930 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4122655418 1102624952 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2025569211 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3099245242 330215086 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3904617403 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1236908473 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1119467961 3921328826 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4139498427 1119467961 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2109389498 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4273716155 2176498362 41975936 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3904617403 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 381270457 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 431536312 3250240186 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4139498427 1136310970 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2193275578 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3988437690 1236908473 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3870997178 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3803888314 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 61516458 2210118587 4256873146 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4189764282 1320860346 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1975105977 4223384507 4290493371 4290493371 4290493371 4290493371 4256873146 2881141434 532002229 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3837508539 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2948316091 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1052359097 3485121210 4290493371 4290493371 4290493371 4290493371 4290493371 3736779450 1035516088 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 750369209 2277227451 2864364218 2713435067 1891351483 532002229 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3787176891 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2092546489 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 16777216 1404614840 2512108475 3082533819 2713435067 1555741370 144678815 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3703290811 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1220065464 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3585850299 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 364295862 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3468409787 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3787176891 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3300571834 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2931473082 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3082533819 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2075900859 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2545597114 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1337505976 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1773910971 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 515619771 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 364295862 4172987066 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3602561722 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2327559099 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1958460347 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 129414838 3216751547 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3720068027 179549107 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 162179754 2663037626 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3787176891 750369209 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 918075576 2461776827 2629483194 2663037626 2696592058 2730146490 2763766715 2780543931 2797255354 2797255354 2780543931 2763766715 2730146490 2679814842 2495265466 1673116089 229749169 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 )! !

!BigCogInitialState class methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/26/2013 22:43'!
size 

	^ 128! !

!BigCogState2 commentStamp: '<historical>'!
Another state in the loading animation!
!BigCogState2 methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/26/2013 22:29'!
nextState

	^ BigCogState3 new! !

!BigCogState2 methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/26/2013 22:30'!
stepTime

	^ 50! !

!BigCogState2 class methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/25/2013 16:22'!
imageData
	
	^ #(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 297055412 884652730 448445114 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 532002229 2897984443 4256873146 4290493371 4290493371 3652959163 2444933818 1236908473 162179754 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1002093242 3971726267 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4156275643 3116022458 1891351483 683260345 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 867809721 4089166779 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3753556666 2528885691 1304017337 196721081 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 297055412 3803888314 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4055546554 2025569211 41975936 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2059057850 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2981804730 75530368 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 431536312 1757067962 2344204729 2210118587 1354348985 111848106 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 16777216 3720068027 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2243607226 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 111848106 1471789497 3099245242 4256873146 4290493371 4290493371 4290493371 4290493371 3870997178 1354348985 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1136310970 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4139498427 297055412 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 565819833 2310716090 3954949051 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1874508474 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2830875579 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1287240121 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 968341431 2914695866 4256873146 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4256873146 1287240121 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 347321267 4189764282 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1740290746 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1002093242 3183131322 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3971726267 431536312 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1924840122 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1538898361 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 347321267 2897984443 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3065690810 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3602561722 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1052359097 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 616085688 3770399675 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1790556601 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1002093242 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 364295862 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 16777216 3384457914 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4122655418 649442741 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2696592058 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4005214906 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1136310970 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3401300923 75530368 0 0 0 0 0 0 0 0 0 0 0 0 263961531 4122655418 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3401300923 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2293938874 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2176498362 0 0 0 0 0 0 0 0 0 0 0 0 1790556601 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2797255354 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2780543931 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4223384507 934918585 0 0 0 0 0 0 0 0 0 0 0 3485121210 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2226764217 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2696592058 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3669670586 196721081 0 0 0 0 0 0 0 0 0 884652730 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1656338873 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2109389498 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2545597114 0 0 0 0 0 0 0 0 75530368 2663037626 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1102624952 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 968341431 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1253751482 0 0 263961531 1035516088 1840888249 2629483194 3434789562 4156275643 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 565819833 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 16777216 3870997178 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3904617403 2948316091 3753556666 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4256873146 75530368 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2512108475 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3820665530 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1152956600 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3300571834 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 75530368 3988437690 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2797255354 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2696592058 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2310716090 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1320860346 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1975105977 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 330215086 1874508474 2948316091 3300571834 2830875579 1354348985 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 144678815 4089166779 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4089166779 1169799609 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 75530368 1304017337 2881141434 4172987066 4290493371 4290493371 4290493371 4290493371 4290493371 2814032570 61516458 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2864364218 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4189764282 1488566713 0 0 0 0 0 0 0 0 0 0 0 0 0 850966712 2428156602 3938106042 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2210118587 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1488566713 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4273716155 1857665465 0 0 0 0 0 0 0 0 0 448445114 1975105977 3569007290 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4240095930 783792055 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 246855350 4172987066 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2260384442 0 0 0 0 0 179549107 1538898361 3116022458 4256873146 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3166354106 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3032202171 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2663037626 61516458 16777216 1069202106 2663037626 4072389563 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1337505976 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1673116089 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3334192059 3770399675 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3703290811 111848106 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 347321267 4240095930 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1991948986 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3216751547 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4072389563 414561717 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1840888249 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2679814842 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1505409722 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4273716155 918075576 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1740290746 4223384507 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3367680698 16777216 0 0 0 0 0 0 0 0 0 0 0 0 0 0 196721081 834057910 1236908473 951827387 565819833 41975936 0 0 0 0 0 0 0 0 0 0 0 0 0 41975936 2377824954 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1488566713 0 0 0 0 0 0 0 0 0 0 0 0 649442741 2797255354 4172987066 4290493371 4290493371 4290493371 4290493371 4156275643 3518741435 2881141434 2243607226 1622850234 1018936251 431536312 0 0 0 0 0 0 196721081 2965093307 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3048913594 0 0 0 0 0 0 0 0 0 0 0 1438300858 4139498427 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4105878202 3535518651 2948316091 2377824954 1807399610 1320860346 3451632571 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3703290811 0 0 0 0 0 0 0 0 0 0 1102624952 4240095930 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3535518651 0 0 0 0 0 0 0 0 0 0 3703290811 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2428156602 0 0 0 0 0 0 0 0 0 733526200 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4072389563 464761779 0 0 0 0 0 0 0 0 0 1824242619 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4156275643 1270594491 0 0 0 0 0 0 0 0 0 0 2914695866 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3971726267 1102624952 0 0 0 0 0 0 0 0 0 0 16777216 3988437690 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4206607291 3350903482 2344204729 1555741370 1371191994 1236908473 1102624952 1438300858 2176498362 2914695866 3686447802 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3434789562 532002229 0 0 0 0 0 0 0 0 0 0 0 817543866 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3317349050 1388035003 162179754 0 0 0 0 0 0 0 0 0 0 834057910 2512108475 4022057915 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2746923706 144678815 0 0 0 0 0 0 0 0 0 0 0 0 1924840122 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3082533819 968341431 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 162179754 1874508474 4089166779 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4240095930 1941617338 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3015424955 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4139498427 1773910971 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 515619771 3048913594 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4038835131 1220065464 0 0 0 0 0 0 0 0 0 0 0 0 0 0 61516458 4055546554 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3569007290 700169147 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1790556601 4256873146 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3669670586 666351543 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 934918585 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3652959163 381270457 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1572518586 4240095930 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3166354106 297055412 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2042214841 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3787176891 498710969 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1404614840 4240095930 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2545597114 75530368 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3032202171 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4156275643 683260345 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2176498362 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4240095930 1840888249 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3585850299 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2092546489 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 75530368 3350903482 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4055546554 1220065464 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3485121210 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3619338938 111848106 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 582268084 4122655418 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 951827387 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2461776827 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1220065464 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2444933818 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1102624952 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 464761779 4038835131 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3803888314 16777216 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 548911031 4240095930 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2008726202 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1052359097 4038835131 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2243607226 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2814032570 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2914695866 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 599176886 3199974331 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 666351543 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1287240121 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3820665530 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1236908473 3283860411 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3837508539 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 279949231 4256873146 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 431536312 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 901232567 2797255354 4223384507 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3183131322 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3485121210 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1354348985 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 481736374 2277227451 3971726267 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2512108475 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2512108475 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2260384442 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 162179754 1706802107 3552230074 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1891351483 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2193275578 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3250240186 16777216 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1085781943 2914695866 4240095930 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1857665465 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1991948986 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3703290811 1941617338 314095800 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 498710969 2260384442 3938106042 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2059057850 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1790556601 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4139498427 2679814842 884652730 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 129414838 3334192059 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2260384442 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1857665465 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3401300923 1622850234 144678815 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2260384442 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2595862969 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2495265466 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3988437690 2361047738 599176886 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1320860346 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3585850299 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3149642683 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4273716155 3082533819 1304017337 41975936 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 397521329 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4273716155 347321267 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3820665530 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3770399675 1991948986 144678815 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3753556666 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1388035003 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 666351543 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3569007290 632994490 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2830875579 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2931473082 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2260384442 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3938106042 683260345 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1891351483 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4256873146 649442741 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 41975936 3803888314 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3652959163 129414838 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 968341431 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2579217339 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1253751482 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1824242619 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1035516088 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4172987066 700169147 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 129414838 3652959163 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3099245242 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1505409722 4156275643 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3485121210 111848106 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2143009723 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3418012346 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 16777216 2243607226 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2344204729 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 733526200 4172987066 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2931473082 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 212511402 2948316091 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4273716155 1589164216 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 548911031 3837508539 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1907997113 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 548911031 3518741435 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4273716155 1757067962 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 431536312 3703290811 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 783792055 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1052359097 3938106042 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2008726202 16777216 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 783792055 3636181947 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3938106042 16777216 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1723447737 4206607291 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3233462970 632994490 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 16777216 1891351483 4172987066 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2847587002 0 0 0 0 0 0 0 0 0 0 0 0 0 75530368 2495265466 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4156275643 2059057850 246855350 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1102624952 3216751547 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1723447737 0 0 0 0 0 0 0 0 0 0 0 0 330215086 3199974331 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4122655418 2696592058 1018936251 0 0 0 0 0 0 0 0 0 0 263961531 1522252731 3451632571 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 582268084 0 0 0 0 0 0 0 0 0 0 0 767278011 3736779450 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3854219962 3082533819 2344204729 1606007225 1270594491 1404614840 1538898361 1706802107 2495265466 3501898426 4256873146 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3753556666 0 0 0 0 0 0 0 0 0 0 0 1253751482 4105878202 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2612705978 0 0 0 0 0 0 0 0 0 0 934918585 4156275643 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1522252731 0 0 0 0 0 0 0 0 0 0 3367680698 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 548911031 0 0 0 0 0 0 0 0 0 616085688 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3350903482 0 0 0 0 0 0 0 0 0 0 1455143867 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1169799609 0 0 0 0 0 0 0 0 0 0 1757067962 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3451632571 1136310970 1723447737 2444933818 3132799674 3820665530 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2176498362 0 0 0 0 0 0 0 0 0 0 0 1572518586 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3048913594 212511402 0 0 0 0 0 212511402 850966712 1488566713 2109389498 2713435067 3300571834 3854219962 4273716155 4290493371 4290493371 4290493371 4290493371 4290493371 3753556666 1505409722 0 0 0 0 0 0 0 0 0 0 0 0 884652730 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2595862969 61516458 0 0 0 0 0 0 0 0 0 0 0 0 0 144678815 616085688 1119467961 1354348985 1253751482 817543866 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3116022458 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2075900859 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 733526200 4240095930 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1941617338 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2512108475 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2210118587 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 330215086 4005214906 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3652959163 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1874508474 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 817543866 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 75530368 3602561722 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3283860411 2965093307 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2277227451 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1186642618 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3753556666 2193275578 599176886 0 0 2277227451 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3720068027 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2965093307 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4089166779 2663037626 1085781943 16777216 0 0 0 0 0 1857665465 4256873146 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 884652730 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 565819833 4156275643 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4256873146 3166354106 1572518586 179549107 0 0 0 0 0 0 0 0 0 1455143867 4189764282 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2327559099 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1773910971 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3636181947 2059057850 498710969 0 0 0 0 0 0 0 0 0 0 0 0 0 1119467961 4055546554 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3770399675 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2008726202 4189764282 4290493371 4290493371 4290493371 4290493371 4005214906 2545597114 934918585 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 817543866 3887840187 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 951827387 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 498710969 1790556601 2277227451 2059057850 1236908473 129414838 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1874508474 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2394667963 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2411313593 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3820665530 16777216 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3015424955 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1002093242 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3619338938 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2461776827 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 41975936 4172987066 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3870997178 41975936 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 515619771 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1253751482 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1119467961 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4105878202 3619338938 3132799674 2646326203 2143009723 1656338873 1169799609 683260345 397521329 3870997178 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2646326203 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1706802107 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3418012346 314095800 0 0 0 0 0 0 0 0 0 1639693243 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3636181947 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2277227451 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1656338873 0 0 0 0 0 0 0 0 0 0 41975936 3418012346 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4206607291 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2864364218 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4038835131 179549107 0 0 0 0 0 0 0 0 0 0 0 985250233 4273716155 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4223384507 16777216 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3434789562 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2461776827 0 0 0 0 0 0 0 0 0 0 0 0 0 2730146490 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3602561722 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4005214906 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 733526200 0 0 0 0 0 0 0 0 0 0 0 0 0 431536312 4055546554 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1891351483 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 263961531 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3267083195 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1891351483 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2646326203 61516458 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 817543866 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1522252731 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 61516458 3501898426 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3837508539 1471789497 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1354348985 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3954949051 129414838 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 951827387 4256873146 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4189764282 2277227451 212511402 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1723447737 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2327559099 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2461776827 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2965093307 599176886 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1840888249 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4273716155 616085688 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 212511402 3569007290 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3552230074 1152956600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1622850234 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3132799674 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 582268084 3854219962 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3938106042 1757067962 61516458 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 716617398 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1388035003 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 397521329 2998581946 4290493371 4290493371 4290493371 4290493371 4290493371 4189764282 2344204729 263961531 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3250240186 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3870997178 75530368 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 767278011 2059057850 2763766715 2914695866 2444933818 582268084 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 649442741 3938106042 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2193275578 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 481736374 2780543931 4139498427 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4022057915 381270457 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 111848106 1136310970 2361047738 3585850299 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1455143867 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 515619771 1723447737 2948316091 4072389563 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4273716155 1891351483 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 93952409 1069202106 2277227451 3468409787 4273716155 4290493371 4290493371 3569007290 1203485627 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 297055412 817543866 532002229 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 )! !

!BigCogState2 class methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/26/2013 22:43'!
size 

	^ 128! !

!BigCogState3 commentStamp: '<historical>'!
The last state of the loading animation!
!BigCogState3 methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/26/2013 22:28'!
nextState

	^ BigCogInitialState new! !

!BigCogState3 methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/26/2013 22:30'!
stepTime

	^ 50! !

!BigCogState3 class methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/25/2013 16:23'!
imageData
	
	^ #(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 41975936 498710969 1002093242 1471789497 1891351483 2260384442 2210118587 1371191994 162179754 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 464761779 1371191994 2210118587 2931473082 3619338938 4189764282 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3870997178 1388035003 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 431536312 2243607226 3669670586 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4273716155 1673116089 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1220065464 4055546554 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4172987066 733526200 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 767278011 1874508474 2126166714 1354348985 93952409 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 716617398 4139498427 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2814032570 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 918075576 3267083195 4290493371 4290493371 4290493371 4290493371 3720068027 1304017337 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3032202171 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4240095930 448445114 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 41975936 2226764217 4256873146 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3032202171 599176886 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 381270457 4273716155 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1958460347 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2444933818 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4172987066 2210118587 162179754 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1354348985 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3501898426 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1354348985 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3770399675 1371191994 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1824242619 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 750369209 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 515619771 4005214906 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3082533819 632994490 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1773910971 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2293938874 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 75530368 3317349050 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4189764282 2226764217 111848106 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1572518586 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3803888314 16777216 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2260384442 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3132799674 129414838 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1371191994 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1085781943 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1152956600 4273716155 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2377824954 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1169799609 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2629483194 0 0 0 0 0 0 0 0 0 0 0 0 0 397521329 3904617403 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4206607291 464761779 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 968341431 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4038835131 129414838 0 0 0 0 0 0 0 0 0 0 0 16777216 3132799674 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1706802107 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 767278011 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1404614840 0 0 0 0 0 0 0 0 0 0 0 2042214841 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2243607226 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 565819833 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2948316091 0 0 0 0 0 0 0 0 0 0 985250233 4223384507 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2008726202 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 364295862 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4189764282 297055412 0 0 0 0 0 0 0 0 297055412 3787176891 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 934918585 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 179549107 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2713435067 1706802107 1371191994 1035516088 700169147 364295862 61516458 0 0 2948316091 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3753556666 16777216 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4256873146 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4273716155 3988437690 3753556666 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1924840122 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4072389563 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4072389563 246855350 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3870997178 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2495265466 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3669670586 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 683260345 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 196721081 783792055 951827387 498710969 16777216 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3468409787 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3166354106 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 750369209 2914695866 4172987066 4290493371 4290493371 4290493371 3753556666 2277227451 599176886 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3267083195 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1388035003 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1706802107 4206607291 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4256873146 2931473082 1035516088 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3065690810 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3854219962 75530368 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 985250233 4273716155 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3468409787 1622850234 144678815 0 0 0 0 0 0 0 0 0 0 0 0 2864364218 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2176498362 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3367680698 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3954949051 2277227451 515619771 0 0 0 0 0 0 0 0 364295862 2243607226 4072389563 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4240095930 498710969 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1488566713 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4240095930 2948316091 1136310970 0 0 0 0 498710969 2444933818 4139498427 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3015424955 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 129414838 3753556666 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3619338938 1857665465 834057910 2646326203 4206607291 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1304017337 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2008726202 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3837508539 61516458 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 364295862 4055546554 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2210118587 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2528885691 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1656338873 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 716617398 4240095930 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3921328826 314095800 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3065690810 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2696592058 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1186642618 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1169799609 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3132799674 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3736779450 179549107 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 279949231 4273716155 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2377824954 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 16777216 397521329 867809721 800635064 179549107 0 0 0 0 0 0 0 0 0 0 0 0 0 649442741 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4240095930 901232567 0 0 0 0 279949231 666351543 1069202106 1471789497 1874508474 2260384442 2663037626 3065690810 3468409787 3854219962 4223384507 4290493371 4290493371 4290493371 4156275643 2629483194 279949231 0 0 0 0 0 0 0 0 0 0 0 162179754 4206607291 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3720068027 2981804730 3367680698 3770399675 4172987066 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3485121210 162179754 0 0 0 0 0 0 0 0 0 0 0 2881141434 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2143009723 0 0 0 0 0 0 0 0 0 0 0 616085688 4072389563 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3820665530 41975936 0 0 0 0 0 0 0 0 0 0 0 1287240121 4206607291 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 850966712 0 0 0 0 0 0 0 0 0 0 0 0 1287240121 4105878202 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1958460347 0 0 0 0 0 0 0 0 0 0 0 0 0 834057910 3787176891 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3753556666 3032202171 2310716090 1706802107 1757067962 1874508474 2008726202 2528885691 3535518651 4256873146 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3099245242 0 0 0 0 0 0 0 0 0 0 0 0 0 0 364295862 3233462970 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3803888314 2226764217 616085688 0 0 0 0 0 0 0 0 0 279949231 1320860346 3132799674 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4122655418 111848106 0 0 0 0 0 0 0 0 0 0 0 0 0 0 75530368 2478488250 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3803888314 1404614840 41975936 0 0 0 0 0 0 0 0 0 0 0 0 0 0 834057910 2797255354 4256873146 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1069202106 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1622850234 4156275643 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4240095930 2394667963 212511402 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1102624952 3854219962 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2210118587 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 884652730 3803888314 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4072389563 1102624952 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 347321267 3048913594 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3367680698 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 364295862 3183131322 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3988437690 901232567 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 16777216 2562374330 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4240095930 279949231 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 61516458 2310716090 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4005214906 750369209 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 41975936 2914695866 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1404614840 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1388035003 4072389563 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1438300858 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 129414838 3233462970 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2562374330 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 649442741 3652959163 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2696592058 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 498710969 4105878202 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3585850299 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2562374330 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3787176891 229749169 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1991948986 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3837508539 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2780543931 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1857665465 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 93952409 3602561722 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3317349050 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2998581946 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4038835131 229749169 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1639693243 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1874508474 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3199974331 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2377824954 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 229749169 4122655418 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3418012346 93952409 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3418012346 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 834057910 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2746923706 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3048913594 263961531 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3619338938 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4105878202 61516458 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1354348985 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3233462970 1186642618 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3837508539 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3233462970 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 565819833 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4172987066 2663037626 783792055 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4038835131 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2327559099 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 16777216 4122655418 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3988437690 2210118587 414561717 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 548911031 2461776827 4273716155 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1975105977 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3418012346 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3753556666 1840888249 196721081 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 834057910 2797255354 4240095930 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1891351483 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3183131322 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3485121210 1505409722 61516458 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1186642618 3149642683 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1790556601 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3283860411 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3233462970 1220065464 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 75530368 1538898361 3501898426 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1840888249 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3367680698 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4273716155 2981804730 951827387 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 229749169 1924840122 3803888314 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2512108475 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3552230074 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2780543931 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 481736374 2327559099 4038835131 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3233462970 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 162179754 4206607291 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2512108475 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 750369209 2746923706 4206607291 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3954949051 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1018936251 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2277227451 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2210118587 4240095930 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 850966712 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1958460347 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2042214841 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2109389498 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2444933818 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3233462970 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1807399610 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 582268084 4206607291 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3938106042 93952409 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 817543866 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1589164216 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2310716090 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1538898361 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2713435067 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1354348985 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3518741435 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3854219962 229749169 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 498710969 4189764282 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1119467961 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 41975936 4223384507 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2377824954 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 16777216 3166354106 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1354348985 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 61516458 4105878202 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4223384507 951827387 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1924840122 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4172987066 1723447737 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3082533819 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3971726267 683260345 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 850966712 4172987066 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2713435067 162179754 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1958460347 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3787176891 464761779 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 918075576 4005214906 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3535518651 632994490 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 834057910 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3703290811 834057910 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1102624952 4089166779 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4055546554 1388035003 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 16777216 3971726267 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4189764282 1857665465 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 75530368 1975105977 4156275643 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2361047738 75530368 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2864364218 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3065690810 850966712 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 951827387 3518741435 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3267083195 431536312 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1723447737 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3149642683 1169799609 0 0 0 0 0 0 0 0 0 0 0 129414838 1455143867 3082533819 4273716155 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3904617403 1085781943 0 0 0 0 0 0 0 0 0 0 0 0 0 0 565819833 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3904617403 2897984443 1891351483 951827387 666351543 532002229 397521329 548911031 1253751482 1958460347 2730146490 4005214906 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4240095930 2008726202 16777216 0 0 0 0 0 0 0 0 0 0 0 0 0 3686447802 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2981804730 212511402 0 0 0 0 0 0 0 0 0 0 0 0 2512108475 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3116022458 41975936 0 0 0 0 0 0 0 0 0 0 0 1253751482 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1991948986 0 0 0 0 0 0 0 0 0 0 0 61516458 3753556666 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4105878202 314095800 0 0 0 0 0 0 0 0 0 0 0 1236908473 4240095930 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4189764282 3837508539 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1824242619 0 0 0 0 0 0 0 0 0 0 0 0 1186642618 3669670586 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4005214906 3602561722 3183131322 2780543931 2377824954 1958460347 1555741370 1136310970 733526200 330215086 0 0 2948316091 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2797255354 0 0 0 0 0 0 0 0 0 0 0 0 0 0 850966712 1572518586 1689959098 1354348985 934918585 532002229 129414838 0 0 0 0 0 0 0 0 0 0 0 0 448445114 4038835131 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2864364218 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1689959098 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2025569211 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3199974331 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4156275643 448445114 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 599176886 4139498427 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2226764217 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1958460347 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3887840187 212511402 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 61516458 3418012346 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1656338873 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3166354106 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3468409787 41975936 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 700169147 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1069202106 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2512108475 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3367680698 2126166714 3787176891 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2914695866 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 246855350 4089166779 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3334192059 1203485627 0 0 75530368 1505409722 3434789562 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4172987066 582268084 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1857665465 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3300571834 1169799609 0 0 0 0 0 0 0 1069202106 2965093307 4256873146 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2361047738 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 16777216 3636181947 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2075900859 0 0 0 0 0 0 0 0 0 0 0 582268084 2394667963 4038835131 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3988437690 347321267 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1169799609 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1840888249 0 0 0 0 0 0 0 0 0 0 0 0 0 196721081 1757067962 3535518651 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4240095930 1320860346 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2965093307 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2126166714 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1018936251 2730146490 4139498427 4290493371 4290493371 4290493371 4290493371 4290493371 4038835131 1404614840 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 515619771 4240095930 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2394667963 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 279949231 1522252731 2579217339 3183131322 2965093307 1991948986 397521329 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2243607226 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2663037626 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 111848106 3921328826 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2931473082 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1505409722 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3199974331 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3267083195 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3485121210 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 716617398 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3384457914 1270594491 1907997113 2545597114 3183131322 3820665530 4273716155 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3753556666 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2159655353 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4005214906 532002229 0 0 0 0 0 179549107 800635064 1438300858 2075900859 2981804730 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4022057915 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3418012346 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1320860346 0 0 0 0 0 0 0 0 0 0 196721081 4206607291 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4256873146 16777216 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4055546554 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2344204729 0 0 0 0 0 0 0 0 0 0 0 0 3283860411 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 263961531 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4172987066 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3334192059 75530368 0 0 0 0 0 0 0 0 0 0 0 0 2143009723 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 532002229 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3418012346 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3971726267 498710969 0 0 0 0 0 0 0 0 0 0 0 0 0 985250233 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 817543866 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1723447737 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4273716155 1253751482 0 0 0 0 0 0 0 0 0 0 0 0 0 0 61516458 4038835131 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1085781943 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 41975936 2881141434 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2277227451 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2914695866 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1438300858 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 41975936 1874508474 4022057915 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3267083195 61516458 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1689959098 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1807399610 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 381270457 2679814842 4273716155 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3938106042 448445114 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 464761779 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1874508474 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 985250233 3485121210 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4256873146 1186642618 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3468409787 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 1572518586 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 61516458 1807399610 4005214906 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2193275578 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2176498362 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 783792055 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 364295862 2629483194 4273716155 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2847587002 61516458 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 817543866 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3602561722 16777216 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 934918585 3401300923 4290493371 4290493371 4290493371 4290493371 4290493371 4206607291 2126166714 16777216 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3501898426 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4240095930 1203485627 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 41975936 1522252731 3216751547 3870997178 3636181947 2512108475 649442741 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1538898361 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3485121210 1203485627 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2965093307 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4139498427 3099245242 1907997113 683260345 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 212511402 3032202171 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4273716155 3451632571 2310716090 1152956600 144678815 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 41975936 1639693243 3619338938 4290493371 4290493371 4290493371 3686447802 2562374330 1438300858 330215086 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 632994490 1253751482 498710969 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 )! !

!BigCogState3 class methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/26/2013 22:43'!
size 

	^ 128! !

!BitBlt commentStamp: '<historical>'!
I represent a block transfer (BLT) of pixels into a rectangle (destX, destY, width, height) of the destinationForm.  The source of pixels may be a similar rectangle (at sourceX, sourceY) in the sourceForm, or a constant color, currently called halftoneForm.  If both are specified, their pixel values are combined with a logical AND function prior to transfer.  In any case, the pixels from the source are combined with those of the destination by as specified by the combinationRule.

The combination rule whose value is 0 through 15 programs the transfer to produce 1 or 0 according to its 4-bit representation as follows:
	8:	if source is 0 and destination is 0
	4:	if source is 0 and destination is 1
	2:	if source is 1 and destination is 0
	1:	if source is 1 and destination is 1.
At each pixel the corresponding bits of the source and destination pixel values determine one of these conditions;  if the combination rule has a 1 in the corresponding bit position, then the new destination value will be 1, otherwise it will be zero.  Forms may be of different depths, see the comment in class Form.

In addition to the original 16 combination rules, this BitBlt supports
	16	fails (to simulate paint bits)
	17	fails (to simulate erase bits)
	18	sourceWord + destinationWord
	19	sourceWord - destinationWord
	20	rgbAdd: sourceWord with: destinationWord.  Sum of color components
	21	rgbSub: sourceWord with: destinationWord.  Difference of color components
	22	OLDrgbDiff: sourceWord with: destinationWord.  Sum of abs of differences in components
	23	OLDtallyIntoMap: destinationWord.  Tallies pixValues into a colorMap
			these old versions don't do bitwise dest clipping.  Use 32 and 33 now.
	24	alphaBlend: sourceWord with: destinationWord.  32-bit source and dest only
	25	pixPaint: sourceWord with: destinationWord.  Wherever the sourceForm is non-zero, it replaces the destination.  Can be used with a 1-bit source color mapped to (0, FFFFFFFF), and a fillColor to fill the dest with that color wherever the source is 1.
	26	pixMask: sourceWord with: destinationWord.  Like pixPaint, but fills with 0.
	27	rgbMax: sourceWord with: destinationWord.  Max of each color component.
	28	rgbMin: sourceWord with: destinationWord.  Min of each color component.
	29	rgbMin: sourceWord bitInvert32 with: destinationWord.  Min with (max-source)
	30	alphaBlendConst: sourceWord with: destinationWord.  alpha is an arg. works in 16 bits.
	31	alphaPaintConst: sourceWord with: destinationWord.  alpha is an arg. works in 16 bits.
	32	rgbDiff: sourceWord with: destinationWord.  Sum of abs of differences in components
	33	tallyIntoMap: destinationWord.  Tallies pixValues into a colorMap
	34	alphaBlendScaled: srcWord with: dstWord. Alpha blend of scaled srcWord and destWord.

The color specified by halftoneForm may be either a Color or a Pattern.   A Color is converted to a pixelValue for the depth of the destinationForm.  If a Pattern, BitBlt will simply interpret its bitmap as an array of Color pixelValues.  BitBlt aligns the first element of this array with the top scanline of the destinationForm, the second with the second, and so on, cycling through the color array as necessary.  Within each scan line the 32-bit value is repeated from left to right across the form.  If the value repeats on pixels boudaries, the effect will be a constant color;  if not, it will produce a halftone that repeats on 32-bit boundaries.

Any transfer specified is further clipped by the specified rectangle (clipX, clipY, clipWidth, clipHeight), and also by the bounds of the source and destination forms.
	To make a small Form repeat and fill a big form, use an InfiniteForm as the source.
	To write on a form and leave with both transparent and opapue areas, use a MaskedForm as the source.

Pixels from a source to a destination whose pixels have a different depth are converted based on the optional colorMap.  If colorMap is nil, then conversion to more bits is done by filling the new high-order bits with zero, and conversion to fewer bits is done by truncating the lost high-order bits.  

The colorMap, if specified, must be a either word array (ie Bitmap) with 2^n elements, where n is the pixel depth of the source, or a fully specified ColorMap which may contain a lookup table (ie Bitmap) and/or four separate masks and shifts which are applied to the pixels. For every source pixel, BitBlt will first perform masking and shifting and then index the lookup table, and select the corresponding pixelValue and mask it to the destination pixel size before storing.
	When blitting from a 32 or 16 bit deep Form to one 8 bits or less, the default is truncation.  This will produce very strange colors, since truncation of the high bits does not produce the nearest encoded color.  Supply a 512 long colorMap, and red, green, and blue will be shifted down to 3 bits each, and mapped.  The message copybits...stdColors will use the best map to the standard colors for destinations of depths 8, 4, 2 and 1.  Two other sized of colorMaps are allowed, 4096 (4 bits per color) and 32786 (five bits per color).
	Normal blits between 16 and 32 bit forms truncates or pads the colors automatically to provide the best preservation of colors.
	Colors can be remapped at the same depth.  Sometimes a Form is in terms of colors that are not the standard colors for this depth, for example in a GIF file.  Convert the Form to a MaskedForm and send colorMap: the list of colors that the picture is in terms of.  MaskedForm will use the colorMap when copying to the display or another Form. (Note also that a Form can be copied to itself, and transformed in the process, if a non-nil colorMap is supplied.)!
!BitBlt methodsFor: 'copying' stamp: 'lr 7/4/2009 10:42'!
copyBits
	"Primitive. Perform the movement of bits from the source form to the 
	destination form. Fail if any variables are not of the right type (Integer, 
	Float, or Form) or if the combination rule is not implemented. 
	In addition to the original 16 combination rules, this BitBlt supports
	16	fail (to simulate paint)
	17	fail (to simulate mask)
	18	sourceWord + destinationWord
	19	sourceWord - destinationWord
	20	rgbAdd: sourceWord with: destinationWord
	21	rgbSub: sourceWord with: destinationWord
	22	rgbDiff: sourceWord with: destinationWord
	23	tallyIntoMap: destinationWord
	24	alphaBlend: sourceWord with: destinationWord
	25	pixPaint: sourceWord with: destinationWord
	26	pixMask: sourceWord with: destinationWord
	27	rgbMax: sourceWord with: destinationWord
	28	rgbMin: sourceWord with: destinationWord
	29	rgbMin: sourceWord bitInvert32 with: destinationWord
"
	"Check for compressed source, destination or halftone forms"
	<primitive: 'primitiveCopyBits' module: 'BitBltPlugin'>
	(combinationRule >= 30 and: [ combinationRule <= 31 ]) ifTrue: 
		[ "No alpha specified -- re-run with alpha = 1.0"
		^ self copyBitsTranslucent: 255 ].
	(sourceForm isForm and: [ sourceForm unhibernate ]) ifTrue: [ ^ self copyBits ].
	(destForm isForm and: [ destForm unhibernate ]) ifTrue: [ ^ self copyBits ].
	(halftoneForm isForm and: [ halftoneForm unhibernate ]) ifTrue: [ ^ self copyBits ].

	"Check for unimplmented rules"
	combinationRule = Form oldPaint ifTrue: [ ^ self paintBits ].
	combinationRule = Form oldErase1bitShape ifTrue: [ ^ self eraseBits ].

	"Check if BitBlt doesn't support full color maps"
	(colorMap notNil and: [ colorMap isColormap ]) ifTrue: 
		[ colorMap := colorMap colors.
		^ self copyBits ].
	"Check if clipping gots us way out of range"
	self clipRange ifTrue: 
		[ self roundVariables.
		^ self copyBitsAgain ].
	self error: 'Bad BitBlt arg (Fraction?); proceed to convert.'.
	"Convert all numeric parameters to integers and try again."
	self roundVariables.
	^ self copyBitsAgain! !

!BitBlt methodsFor: 'accessing' stamp: 'ar 5/17/2000 18:58'!
clipX
	^clipX! !

!BitBlt methodsFor: 'accessing' stamp: ''!
colorMap
	^ colorMap! !

!BitBlt methodsFor: 'accessing' stamp: ''!
sourceForm

	^ sourceForm! !

!BitBlt methodsFor: '*Graphics-Fonts' stamp: 'Henrik Sperre Johansen 9/1/2009 22:40'!
displayGlyph: aForm at: aPoint left: leftX right: rightX font: aFont
	"Display a glyph in a multi-lingual font. Do 2 pass rendering if necessary.
	This happens when #installStrikeFont:foregroundColor:backgroundColor: sets rule 37 (rgbMul).
	the desired effect is to do two bitblt calls. The first one is with rule 37 and special colormap.
	The second one is rule 34, with a colormap for applying the requested foreground color.
	This two together do component alpha blending, i.e. alpha blend red, green and blue separatedly.
	This is needed for arbitrary color over abitrary background text with subpixel AA."

	| prevRule secondPassMap |
	self sourceForm: aForm.
	destX := aPoint x.
	destY := aPoint y.
	sourceX := leftX.
	sourceY := 0.
	width := rightX - leftX.
	height := aFont height.
	combinationRule = 37 ifTrue:[
		"We need to do a second pass. The colormap set is for use in the second pass."
		secondPassMap := colorMap.
		colorMap := sourceForm depth = destForm depth
			ifFalse: [ self cachedFontColormapFrom: sourceForm depth to: destForm depth ].
		self copyBits.
		prevRule := combinationRule.
		combinationRule := 20. "rgbAdd"
		colorMap := secondPassMap.
		self copyBits.
		combinationRule := prevRule.
	] ifFalse:[self copyBits].! !

!BitBlt methodsFor: 'copying' stamp: 'lr 7/4/2009 10:42'!
pixelAt: aPoint put: pixelValue 
	"Assumes this BitBlt has been set up specially (see the init message,
	BitBlt bitPokerToForm:.  Overwrites the pixel at aPoint."
	destX := aPoint x.
	destY := aPoint y.
	sourceForm unhibernate.	"before poking"
	sourceForm bits 
		at: 1
		put: pixelValue.
	self copyBits
	"
| bb |
bb := (BitBlt bitPokerToForm: Display).
[Sensor anyButtonPressed] whileFalse:
	[bb pixelAt: Sensor cursorPoint put: 55]
"! !

!BitBlt methodsFor: 'accessing' stamp: 'ar 5/17/2000 18:58'!
clipHeight
	^clipHeight! !

!BitBlt methodsFor: 'copying' stamp: 'nk 4/17/2004 19:42'!
copyBitsTranslucent: factor
	"This entry point to BitBlt supplies an extra argument to specify translucency
	for operations 30 and 31.  The argument must be an integer between 0 and 255."

	<primitive: 'primitiveCopyBits' module: 'BitBltPlugin'>

	"Check for compressed source, destination or halftone forms"
	((sourceForm isForm) and: [sourceForm unhibernate])
		ifTrue: [^ self copyBitsTranslucent: factor].
	((destForm isForm) and: [destForm unhibernate])
		ifTrue: [^ self copyBitsTranslucent: factor].
	((halftoneForm isForm) and: [halftoneForm unhibernate])
		ifTrue: [^ self copyBitsTranslucent: factor].

	self primitiveFailed  "Later do nicer error recovery -- share copyBits recovery"! !

!BitBlt methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
clipX: anInteger 
	"Set the receiver's clipping area top left x coordinate to be the argument, 
	anInteger."
	clipX := anInteger! !

!BitBlt methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
destOrigin: aPoint 
	"Set the receiver's destination top left coordinates to be those of the 
	argument, aPoint."
	destX := aPoint x.
	destY := aPoint y! !

!BitBlt methodsFor: 'copying' stamp: 'lr 7/4/2009 10:42'!
copyForm: srcForm to: destPt rule: rule color: color 
	sourceForm := srcForm.
	halftoneForm := color.
	combinationRule := rule.
	destX := destPt x + sourceForm offset x.
	destY := destPt y + sourceForm offset y.
	sourceX := 0.
	sourceY := 0.
	width := sourceForm width.
	height := sourceForm height.
	self copyBits! !

!BitBlt methodsFor: 'private' stamp: 'lr 7/4/2009 10:42'!
copyBitsFrom: x0 to: x1 at: y 
	destX := x0.
	destY := y.
	sourceX := x0.
	width := x1 - x0.
	self copyBits! !

!BitBlt methodsFor: 'accessing' stamp: ''!
fillColor
	^ halftoneForm! !

!BitBlt methodsFor: 'private' stamp: 'MarcusDenker 9/13/2013 14:06'!
paintBits
	"Perform the paint operation, which requires two calls to BitBlt."
	| color oldMap saveRule |
	sourceForm depth = 1 ifFalse: 
		[ ^ self error: 'paint operation is only defined for 1-bit deep sourceForms' ].
	saveRule := combinationRule.
	color := halftoneForm.
	halftoneForm := nil.
	oldMap := colorMap.
	"Map 1's to ALL ones, not just one"
	self colorMap: (Bitmap 
			with: 0
			with: 4294967295).
	combinationRule := Form erase.
	self copyBits.	"Erase the dest wherever the source is 1"
	halftoneForm := color.
	combinationRule := Form under.
	self copyBits.	"then OR, with whatever color, into the hole"
	colorMap := oldMap.
	combinationRule := saveRule

	" | dot |
dot := Form dotOfSize: 32.
((BitBlt destForm: Display
		sourceForm: dot
		fillColor: Color lightGray
		combinationRule: Form paint
		destOrigin: Sensor cursorPoint
		sourceOrigin: 0@0
		extent: dot extent
		clipRect: Display boundingBox)
		colorMap: (Bitmap with: 0 with: 16rFFFFFFFF)) copyBits"! !

!BitBlt methodsFor: 'accessing' stamp: ''!
clipRect
	"Answer the receiver's clipping area rectangle."

	^clipX @ clipY extent: clipWidth @ clipHeight! !

!BitBlt methodsFor: 'copying' stamp: 'ar 5/14/2001 23:32'!
copyForm: srcForm to: destPt rule: rule
	^ self copyForm: srcForm to: destPt rule: rule
		colorMap: (srcForm colormapIfNeededFor: destForm)! !

!BitBlt methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
sourceRect: aRectangle 
	"Set the receiver's source form top left x and y, width and height to be 
	the top left coordinate and extent of the argument, aRectangle."
	sourceX := aRectangle left.
	sourceY := aRectangle top.
	width := aRectangle width.
	height := aRectangle height! !

!BitBlt methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
width: anInteger 
	"Set the receiver's destination form width to be the argument, anInteger."
	width := anInteger! !

!BitBlt methodsFor: 'line drawing' stamp: 'lr 7/4/2009 10:42'!
drawFrom: startPoint to: stopPoint withFirstPoint: drawFirstPoint 
	"Draw a line whose end points are startPoint and stopPoint.
	The line is formed by repeatedly calling copyBits at every
	point along the line.  If drawFirstPoint is false, then omit
	the first point so as not to overstrike at line junctions."
	"Always draw down, or at least left-to-right"
	| offset point1 point2 forwards |
	forwards := (startPoint y = stopPoint y and: [ startPoint x < stopPoint x ]) or: [ startPoint y < stopPoint y ].
	forwards 
		ifTrue: 
			[ point1 := startPoint.
			point2 := stopPoint ]
		ifFalse: 
			[ point1 := stopPoint.
			point2 := startPoint ].
	sourceForm == nil 
		ifTrue: 
			[ destX := point1 x.
			destY := point1 y ]
		ifFalse: 
			[ width := sourceForm width.
			height := sourceForm height.
			offset := sourceForm offset.
			destX := (point1 x + offset x) rounded.
			destY := (point1 y + offset y) rounded ].

	"Note that if not forwards, then the first point is the last and vice versa.
	We agree to always paint stopPoint, and to optionally paint startPoint."
	(drawFirstPoint or: [ forwards == false	"ie this is stopPoint" ]) ifTrue: [ self copyBits ].
	self 
		drawLoopX: (point2 x - point1 x) rounded
		Y: (point2 y - point1 y) rounded.
	(drawFirstPoint or: 
		[ "ie this is stopPoint"
		forwards ]) ifTrue: [ self copyBits ]! !

!BitBlt methodsFor: 'accessing' stamp: 'ar 5/17/2000 18:58'!
clipY
	^clipY! !

!BitBlt methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
sourceX: anInteger 
	"Set the receiver's source form top left x to be the argument, anInteger."
	sourceX := anInteger! !

!BitBlt methodsFor: 'copying' stamp: 'lr 7/4/2009 10:42'!
copyForm: srcForm to: destPt rule: rule colorMap: map 
	sourceForm := srcForm.
	halftoneForm := nil.
	combinationRule := rule.
	destX := destPt x + sourceForm offset x.
	destY := destPt y + sourceForm offset y.
	sourceX := 0.
	sourceY := 0.
	width := sourceForm width.
	height := sourceForm height.
	colorMap := map.
	self copyBits! !

!BitBlt methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
tallyMap: aBitmap 
	"Install the map used for tallying pixels"
	colorMap := aBitmap! !

!BitBlt methodsFor: 'accessing' stamp: 'CamilloBruni 8/1/2012 16:05'!
fillColor: aColorOrPattern 
	"The destForm will be filled with this color or pattern of colors.  May be an old Color, a new type Color, a Bitmap (see BitBlt comment), a Pattern, or a Form."
	aColorOrPattern == nil ifTrue: 
		[ halftoneForm := nil.
		^ self ].
	destForm == nil ifTrue: [ self error: 'Must set destForm first' ].
	halftoneForm := destForm bitPatternFor: aColorOrPattern! !

!BitBlt methodsFor: 'accessing' stamp: 'ar 5/17/2000 18:58'!
clipWidth
	^clipWidth! !

!BitBlt methodsFor: 'accessing' stamp: 'tbn 9/14/2004 20:39'!
halftoneForm: aBitmap
	"Sets the receivers half tone form. See class commment."
	
	halftoneForm := aBitmap
	
 ! !

!BitBlt methodsFor: 'private' stamp: 'HenrikSperreJohansen 8/31/2010 22:56'!
primDisplayString: aString from: startIndex to: stopIndex map: glyphMap xTable: xTable kern: kernDelta 
	| ascii |
	<primitive:'primitiveDisplayString' module:'BitBltPlugin'>
	startIndex 
		to: stopIndex
		do: 
			[ :charIndex | 
			ascii := (aString at: charIndex) asciiValue.
			glyphMap ifNotNil: [:map | ascii := map at: ascii +1].
			sourceX := xTable at: ascii + 1.
			width := (xTable at: ascii + 2) - sourceX.
			self copyBits.
			destX := destX + width + kernDelta ]! !

!BitBlt methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
clipWidth: anInteger 
	"Set the receiver's clipping area width to be the argument, anInteger."
	clipWidth := anInteger! !

!BitBlt methodsFor: 'private' stamp: 'lr 7/4/2009 10:42'!
setDestForm: df 
	| bb |
	bb := df boundingBox.
	destForm := df.
	clipX := bb left.
	clipY := bb top.
	clipWidth := bb width.
	clipHeight := bb height! !

!BitBlt methodsFor: 'private' stamp: 'ClementBera 7/26/2013 16:03'!
colorConvertingMap: targetColor from: sourceDepth to: destDepth keepSubPixelAA: keepSubPix 
	| srcIndex map mapsForSource mapsForSourceAndDest |
	ColorConvertingMaps class == Array ifFalse: [ ColorConvertingMaps := (1 to: 10) collect: [ :i | Array new: 32 ] ].
	srcIndex := sourceDepth.
	sourceDepth > 8 ifTrue: 
		[ srcIndex := keepSubPix 
			ifTrue: [ 9 ]
			ifFalse: [ 10 ] ].
	mapsForSource := ColorConvertingMaps at: srcIndex.
	(mapsForSourceAndDest := mapsForSource at: destDepth) ifNil: 
		[ mapsForSourceAndDest := mapsForSource 
			at: destDepth
			put: Dictionary new ].
	map := mapsForSourceAndDest 
		at: targetColor
		ifAbsentPut: 
			[ Color 
				computeColorConvertingMap: targetColor
				from: sourceDepth
				to: destDepth
				keepSubPixelAA: keepSubPix ].
	^ map! !

!BitBlt methodsFor: '*FreeType-Addition' stamp: 'tween 7/28/2006 17:54'!
copyBitsColor: argbColorSmallInteger alpha: argbAlphaSmallInteger gammaTable: gammaByteArray ungammaTable: ungammaByteArray
	"This entry point to BitBlt supplies an extra argument to specify the fore color
	argb value for operation 41. This is split into an alpha value and an rgb value,
	so that both can be passed as smallIntegers to the primitive.  
	rgbColorInteger must be a smallInteger between 0 and 16rFFFFFF.
	alpha must be a smallInteger between 0 and 16rFF."

	<primitive: 'primitiveCopyBits' module: 'BitBltPlugin'>

	"Check for compressed source, destination or halftone forms"
	((sourceForm isForm) and: [sourceForm unhibernate])
		ifTrue: [^ self copyBitsColor: argbColorSmallInteger alpha: argbAlphaSmallInteger gammaTable: gammaByteArray ungammaTable: ungammaByteArray].
	((destForm isForm) and: [destForm unhibernate ])
		ifTrue: [^ self copyBitsColor: argbColorSmallInteger alpha: argbAlphaSmallInteger gammaTable: gammaByteArray ungammaTable: ungammaByteArray].
	((halftoneForm isForm) and: [halftoneForm unhibernate])
		ifTrue: [^ self copyBitsColor: argbColorSmallInteger alpha: argbAlphaSmallInteger gammaTable: gammaByteArray ungammaTable: ungammaByteArray].

	self primitiveFailed  "Later do nicer error recovery -- share copyBits recovery"! !

!BitBlt methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
destX: anInteger 
	"Set the top left x coordinate of the receiver's destination form to be the 
	argument, anInteger."
	destX := anInteger! !

!BitBlt methodsFor: '*Graphics-Fonts' stamp: 'ar 10/25/2005 01:12'!
displayString: aString from: startIndex to: stopIndex at: aPoint kern: kernDelta font: aFont
	"Double dispatch into the font. This method is present so that other-than-bitblt entities can be used by CharacterScanner and friends to display text."
	^ aFont displayString: aString on: self from: startIndex to: stopIndex at: aPoint kern: kernDelta! !

!BitBlt methodsFor: 'copying' stamp: 'CamilloBruni 8/1/2012 16:05'!
fill: destRect fillColor: grayForm rule: rule 
	"Fill with a Color, not a Form."
	sourceForm := nil.
	self fillColor: grayForm.	"sets halftoneForm"
	combinationRule := rule.
	destX := destRect left.
	destY := destRect top.
	sourceX := 0.
	sourceY := 0.
	width := destRect width.
	height := destRect height.
	self copyBits! !

!BitBlt methodsFor: 'private' stamp: 'lr 7/4/2009 10:42'!
clipRange
	"clip and adjust source origin and extent appropriately"
	"first in x"
	"fill in the lazy state if needed"
	| sx sy dx dy bbW bbH |
	destX ifNil: [ destX := 0 ].
	destY ifNil: [ destY := 0 ].
	width ifNil: [ width := destForm width ].
	height ifNil: [ height := destForm height ].
	sourceX ifNil: [ sourceX := 0 ].
	sourceY ifNil: [ sourceY := 0 ].
	clipX ifNil: [ clipX := 0 ].
	clipY ifNil: [ clipY := 0 ].
	clipWidth ifNil: [ clipWidth := destForm width ].
	clipHeight ifNil: [ clipHeight := destForm height ].
	destX >= clipX 
		ifTrue: 
			[ sx := sourceX.
			dx := destX.
			bbW := width ]
		ifFalse: 
			[ sx := sourceX + (clipX - destX).
			bbW := width - (clipX - destX).
			dx := clipX ].
	dx + bbW > (clipX + clipWidth) ifTrue: [ bbW := bbW - (dx + bbW - (clipX + clipWidth)) ].
	"then in y"
	destY >= clipY 
		ifTrue: 
			[ sy := sourceY.
			dy := destY.
			bbH := height ]
		ifFalse: 
			[ sy := sourceY + clipY - destY.
			bbH := height - (clipY - destY).
			dy := clipY ].
	dy + bbH > (clipY + clipHeight) ifTrue: [ bbH := bbH - (dy + bbH - (clipY + clipHeight)) ].
	sourceForm ifNotNil: 
		[ sx < 0 ifTrue: 
			[ dx := dx - sx.
			bbW := bbW + sx.
			sx := 0 ].
		sx + bbW > sourceForm width ifTrue: [ bbW := bbW - (sx + bbW - sourceForm width) ].
		sy < 0 ifTrue: 
			[ dy := dy - sy.
			bbH := bbH + sy.
			sy := 0 ].
		sy + bbH > sourceForm height ifTrue: [ bbH := bbH - (sy + bbH - sourceForm height) ] ].
	(bbW <= 0 or: [ bbH <= 0 ]) ifTrue: 
		[ sourceX := sourceY := destX := destY := clipX := clipY := width := height := 0.
		^ true ].
	(sx = sourceX and: 
		[ sy = sourceY and: 
			[ dx = destX and: [ dy = destY and: [ bbW = width and: [ bbH = height ] ] ] ] ]) ifTrue: [ ^ false ].
	sourceX := sx.
	sourceY := sy.
	destX := dx.
	destY := dy.
	width := bbW.
	height := bbH.
	^ true! !

!BitBlt methodsFor: '*Graphics-Fonts' stamp: 'ar 10/24/2005 21:49'!
displayString: aString from: startIndex to: stopIndex at: aPoint kern: kernDelta baselineY: baselineY font: aFont
	"Double dispatch into the font. This method is present so that other-than-bitblt entities can be used by CharacterScanner and friends to display text."
	^ aFont displayString: aString on: self from: startIndex to: stopIndex at: aPoint kern: kernDelta baselineY: baselineY! !

!BitBlt methodsFor: '*Graphics-Fonts' stamp: 'ar 10/24/2005 21:48'!
installFont: aFont foregroundColor: foregroundColor backgroundColor: backgroundColor
	"Double dispatch into the font. This method is present so that other-than-bitblt entities can be used by CharacterScanner and friends to display text."
	^aFont installOn: self foregroundColor: foregroundColor backgroundColor: backgroundColor! !

!BitBlt methodsFor: '*FreeType-Addition' stamp: 'FernandoOlivero 6/10/2011 16:34'!
lastFontForegroundColor
	^ nil ! !

!BitBlt methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
clipRect: aRectangle 
	"Set the receiver's clipping area rectangle to be the argument, aRectangle."
	clipX := aRectangle left truncated.
	clipY := aRectangle top truncated.
	clipWidth := aRectangle right truncated - clipX.
	clipHeight := aRectangle bottom truncated - clipY! !

!BitBlt methodsFor: 'copying' stamp: 'lr 7/4/2009 10:42'!
copy: destRectangle from: sourcePt in: srcForm 
	| destOrigin |
	sourceForm := srcForm.
	halftoneForm := nil.
	combinationRule := 3.	"store"
	destOrigin := destRectangle origin.
	destX := destOrigin x.
	destY := destOrigin y.
	sourceX := sourcePt x.
	sourceY := sourcePt y.
	width := destRectangle width.
	height := destRectangle height.
	self copyBits! !

!BitBlt methodsFor: 'line drawing' stamp: ''!
drawFrom: startPoint to: stopPoint 
	
	 ^ self drawFrom: startPoint to: stopPoint withFirstPoint: true! !

!BitBlt methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
clipY: anInteger 
	"Set the receiver's clipping area top left y coordinate to be the argument, 
	anInteger."
	clipY := anInteger! !

!BitBlt methodsFor: 'accessing' stamp: 'ar 5/25/2000 19:39'!
tallyMap
	"Return the map used for tallying pixels"
	^colorMap! !

!BitBlt methodsFor: 'private' stamp: 'lr 7/4/2009 10:42'!
eraseBits
	"Perform the erase operation, which puts 0's in the destination
	wherever the source (which is assumed to be just 1 bit deep)
	has a 1.  This requires the colorMap to be set in order to AND
	all 1's into the destFrom pixels regardless of their size."
	| oldMask oldMap |
	oldMask := halftoneForm.
	halftoneForm := nil.
	oldMap := colorMap.
	self colorMap: (Bitmap 
			with: 0
			with: 4294967295).
	combinationRule := Form erase.
	self copyBits.	"Erase the dest wherever the source is 1"
	halftoneForm := oldMask.	"already converted to a Bitmap"
	colorMap := oldMap! !

!BitBlt methodsFor: 'copying' stamp: 'lr 7/4/2009 10:42'!
copyFrom: sourceRectangle in: srcForm to: destPt 
	| sourceOrigin |
	sourceForm := srcForm.
	halftoneForm := nil.
	combinationRule := 3.	"store"
	destX := destPt x.
	destY := destPt y.
	sourceOrigin := sourceRectangle origin.
	sourceX := sourceOrigin x.
	sourceY := sourceOrigin y.
	width := sourceRectangle width.
	height := sourceRectangle height.
	colorMap := srcForm colormapIfNeededFor: destForm.
	self copyBits! !

!BitBlt methodsFor: 'private' stamp: 'lr 7/4/2009 10:42'!
roundVariables
	| maxVal minVal |
	maxVal := SmallInteger maxVal.
	minVal := SmallInteger minVal.
	destX := destX asInteger 
		min: maxVal
		max: minVal.
	destY := destY asInteger 
		min: maxVal
		max: minVal.
	width := width asInteger 
		min: maxVal
		max: minVal.
	height := height asInteger 
		min: maxVal
		max: minVal.
	sourceX := sourceX asInteger 
		min: maxVal
		max: minVal.
	sourceY := sourceY asInteger 
		min: maxVal
		max: minVal.
	clipX := clipX asInteger 
		min: maxVal
		max: minVal.
	clipY := clipY asInteger 
		min: maxVal
		max: minVal.
	clipWidth := clipWidth asInteger 
		min: maxVal
		max: minVal.
	clipHeight := clipHeight asInteger 
		min: maxVal
		max: minVal! !

!BitBlt methodsFor: 'accessing' stamp: 'tbn 9/14/2004 20:38'!
halftoneForm
	"Returns the receivers half tone form. See class commment."
	
	^halftoneForm! !

!BitBlt methodsFor: 'copying' stamp: 'CamilloBruni 8/1/2012 16:02'!
copy: destRectangle from: sourcePt in: srcForm fillColor: hf rule: rule 
	"Specify a Color to fill, not a Form."
	| destOrigin |
	sourceForm := srcForm.
	self fillColor: hf.	"sets halftoneForm"
	combinationRule := rule.
	destOrigin := destRectangle origin.
	destX := destOrigin x.
	destY := destOrigin y.
	sourceX := sourcePt x.
	sourceY := sourcePt y.
	width := destRectangle width.
	height := destRectangle height.
	srcForm == nil ifFalse: [ colorMap := srcForm colormapIfNeededFor: destForm ].
	^ self copyBits! !

!BitBlt methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
height: anInteger 
	"Set the receiver's destination form height to be the argument, anInteger."
	height := anInteger! !

!BitBlt methodsFor: '*Graphics-Fonts' stamp: 'JuanVuletich 8/22/2009 23:39'!
displayString: aString from: startIndex to: stopIndex at: aPoint strikeFont: font kern: kernDelta
	"If required, do a second pass with new rule and colorMap.
	This happens when #installStrikeFont:foregroundColor:backgroundColor: sets rule 37 (rgbMul).
	the desired effect is to do two bitblt calls. The first one is with rule 37 and special colormap.
	The second one is rule 34, with a colormap for applying the requested foreground color.
	This two together do component alpha blending, i.e. alpha blend red, green and blue separatedly.
	This is needed for arbitrary color over abitrary background text with subpixel AA."

	| answer prevRule secondPassMap |
	"If combinationRule is rgbMul, we might need the special two-pass technique for component alpha blending.
	If not, do it simply"
	combinationRule = 37 "rgbMul" ifFalse: [
		^self basicDisplayString: aString from: startIndex to: stopIndex at: aPoint strikeFont: font kern: kernDelta ].
	
	"We need to do a second pass. The colormap set is for use in the second pass."
	secondPassMap := colorMap.
	colorMap := sourceForm depth ~= destForm depth
		ifTrue: [ self cachedFontColormapFrom: sourceForm depth to: destForm depth ].
	answer := self basicDisplayString: aString from: startIndex to: stopIndex at: aPoint strikeFont: font kern: kernDelta.
	colorMap := secondPassMap.
	secondPassMap ifNotNil: [
		prevRule := combinationRule.
		combinationRule := 20. "rgbAdd"
		self basicDisplayString: aString from: startIndex to: stopIndex at: aPoint strikeFont: font kern: kernDelta.
		combinationRule := prevRule ].
	^answer! !

!BitBlt methodsFor: '*Graphics-Fonts' stamp: 'lr 7/4/2009 10:42'!
cachedFontColormapFrom: sourceDepth to: destDepth 
	"Modified from computeColormapFrom:to:."
	| srcIndex map |
	CachedFontColorMaps class == Array ifFalse: [ CachedFontColorMaps := (1 to: 9) collect: [ :i | Array new: 32 ] ].
	srcIndex := sourceDepth.
	sourceDepth > 8 ifTrue: [ srcIndex := 9 ].
	(map := (CachedFontColorMaps at: srcIndex) at: destDepth) ~~ nil ifTrue: [ ^ map ].
	map := (Color 
		cachedColormapFrom: sourceDepth
		to: destDepth) copy.
	(CachedFontColorMaps at: srcIndex) 
		at: destDepth
		put: map.
	^ map! !

!BitBlt methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
sourceY: anInteger 
	"Set the receiver's source form top left y to be the argument, anInteger."
	sourceY := anInteger! !

!BitBlt methodsFor: 'private' stamp: 'lr 7/4/2009 10:42'!
setDestForm: df sourceForm: sf fillColor: hf combinationRule: cr destOrigin: destOrigin sourceOrigin: sourceOrigin extent: extent clipRect: clipRect 
	| aPoint |
	destForm := df.
	sourceForm := sf.
	self fillColor: hf.	"sets halftoneForm"
	combinationRule := cr.
	destX := destOrigin x.
	destY := destOrigin y.
	sourceX := sourceOrigin x.
	sourceY := sourceOrigin y.
	width := extent x.
	height := extent y.
	aPoint := clipRect origin.
	clipX := aPoint x.
	clipY := aPoint y.
	aPoint := clipRect corner.
	clipWidth := aPoint x - clipX.
	clipHeight := aPoint y - clipY.
	sourceForm == nil ifFalse: [ colorMap := sourceForm colormapIfNeededFor: destForm ]! !

!BitBlt methodsFor: 'accessing' stamp: ''!
destForm
	^ destForm! !

!BitBlt methodsFor: 'copying' stamp: 'lr 7/4/2009 10:42'!
copy: destRectangle from: sourcePt in: srcForm halftoneForm: hf rule: rule 
	| destOrigin |
	sourceForm := srcForm.
	self fillColor: hf.	"sets halftoneForm"
	combinationRule := rule.
	destOrigin := destRectangle origin.
	destX := destOrigin x.
	destY := destOrigin y.
	sourceX := sourcePt x.
	sourceY := sourcePt y.
	width := destRectangle width.
	height := destRectangle height.
	self copyBits! !

!BitBlt methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
destX: x destY: y width: w height: h 
	"Combined init message saves 3 sends from DisplayScanner"
	destX := x.
	destY := y.
	width := w.
	height := h! !

!BitBlt methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
destY: anInteger 
	"Set the top left y coordinate of the receiver's destination form to be the 
	argument, anInteger."
	destY := anInteger! !

!BitBlt methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
destRect: aRectangle 
	"Set the receiver's destination form top left coordinates to be the origin of 
	the argument, aRectangle, and set the width and height of the receiver's 
	destination form to be the width and height of aRectangle."
	destX := aRectangle left.
	destY := aRectangle top.
	width := aRectangle width.
	height := aRectangle height! !

!BitBlt methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
clipHeight: anInteger 
	"Set the receiver's clipping area height to be the argument, anInteger."
	clipHeight := anInteger! !

!BitBlt methodsFor: 'line drawing' stamp: 'lr 7/4/2009 10:42'!
drawLoopX: xDelta Y: yDelta 
	"Primitive. Implements the Bresenham plotting algorithm (IBM Systems
	Journal, Vol. 4 No. 1, 1965). It chooses a principal direction, and
	maintains a potential, P. When P's sign changes, it is time to move in
	the minor direction as well. This particular version does not write the
	first and last points, so that these can be called for as needed in client code.
	Optional. See Object documentation whatIsAPrimitive."
	| dx dy px py P |
	<primitive: 'primitiveDrawLoop' module: 'BitBltPlugin'>
	dx := xDelta sign.
	dy := yDelta sign.
	px := yDelta abs.
	py := xDelta abs.
	"self copyBits."
	py > px 
		ifTrue: 
			[ "more horizontal"
			P := py // 2.
			1 
				to: py
				do: 
					[ :i | 
					destX := destX + dx.
					(P := P - px) < 0 ifTrue: 
						[ destY := destY + dy.
						P := P + py ].
					i < py ifTrue: [ self copyBits ] ] ]
		ifFalse: 
			[ "more vertical"
			P := px // 2.
			1 
				to: px
				do: 
					[ :i | 
					destY := destY + dy.
					(P := P - py) < 0 ifTrue: 
						[ destX := destX + dx.
						P := P + px ].
					i < px ifTrue: [ self copyBits ] ] ]! !

!BitBlt methodsFor: '*FreeType-Addition' stamp: 'tween 8/1/2006 17:52'!
combinationRule
	"Answer the receiver's combinationRule"
	
	^combinationRule! !

!BitBlt methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
clipBy: aRectangle 
	| aPoint right bottom |
	right := clipX + clipWidth.
	bottom := clipY + clipHeight.
	aPoint := aRectangle origin.
	aPoint x > clipX ifTrue: [ clipX := aPoint x ].
	aPoint y > clipY ifTrue: [ clipY := aPoint y ].
	aPoint := aRectangle corner.
	aPoint x < right ifTrue: [ right := aPoint x ].
	aPoint y < bottom ifTrue: [ bottom := aPoint y ].
	clipWidth := right - clipX.
	clipHeight := bottom - clipY.
	clipWidth < 0 ifTrue: [ clipWidth := 0 ].
	clipHeight < 0 ifTrue: [ clipHeight := 0 ]! !

!BitBlt methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
clipByX1: x1 y1: y1 x2: x2 y2: y2 
	| right bottom |
	right := clipX + clipWidth.
	bottom := clipY + clipHeight.
	x1 > clipX ifTrue: [ clipX := x1 ].
	y1 > clipY ifTrue: [ clipY := y1 ].
	x2 < right ifTrue: [ right := x2 ].
	y2 < bottom ifTrue: [ bottom := y2 ].
	clipWidth := right - clipX.
	clipHeight := bottom - clipY.
	clipWidth < 0 ifTrue: [ clipWidth := 0 ].
	clipHeight < 0 ifTrue: [ clipHeight := 0 ]! !

!BitBlt methodsFor: 'accessing' stamp: 'CamilloBruni 8/1/2012 16:02'!
colorMap: map 
	"See last part of BitBlt comment."
	colorMap := map! !

!BitBlt methodsFor: 'private' stamp: 'ar 2/2/2001 15:09'!
copyBitsAgain
	"Primitive. See BitBlt|copyBits, also a Primitive. Essential. See Object
	documentation whatIsAPrimitive."

	<primitive: 'primitiveCopyBits' module: 'BitBltPlugin'>
	self primitiveFailed! !

!BitBlt methodsFor: '*Graphics-Fonts' stamp: 'MarcusDenker 3/19/2012 20:45'!
installStrikeFont: aStrikeFont foregroundColor: foregroundColor backgroundColor: backgroundColor
	| lastSourceDepth targetColor |
	sourceForm ifNotNil:[lastSourceDepth := sourceForm depth].
	sourceForm := aStrikeFont glyphs.

	"Ignore any halftone pattern since we use a color map approach here"
	halftoneForm := nil.
	sourceY := 0.
	height := aStrikeFont height.

	sourceForm depth = 1 ifTrue: [
		self combinationRule: Form paint.
		(colorMap notNil and:[lastSourceDepth = sourceForm depth]) ifFalse: [
			"Set up color map for a different source depth (color font)"
			"Uses caching for reasonable efficiency"
			colorMap := self cachedFontColormapFrom: sourceForm depth to: destForm depth.
			colorMap at: 1 put: (destForm pixelValueFor: backgroundColor)].
		colorMap at: 2 put: (destForm pixelValueFor: foregroundColor).
	]
	ifFalse: [
			destForm depth > 8 ifTrue: [
				"rgbMul is equivalent to component alpha blend if text is black (only faster, hehe)"
				self combinationRule: 37.		"RGBMul"
				colorMap := (destForm depth = 32 or: [ (foregroundColor = Color black) not ]) ifTrue: [
					"rgbMul / rgbAdd IS component alpha blend for any color of text (neat trick, eh!!)"
					"This colorMap is to be used on the second pass with rule 20 (rgbAdd)
					See #displayString:from:to:at:strikeFont:kern:"
					"Note: In 32bpp we always need the second pass, as the source could have transparent pixels, and we need to add to the alpha channel"
					self colorConvertingMap: foregroundColor from: sourceForm depth to: destForm depth keepSubPixelAA: true]]
			ifFalse: [
				self combinationRule: 25.		"Paint"
				targetColor := foregroundColor = Color black ifFalse: [ foregroundColor ].
				colorMap := self colorConvertingMap: targetColor from: sourceForm depth to: destForm depth keepSubPixelAA: true]
		]! !

!BitBlt methodsFor: '*Graphics-Fonts' stamp: 'jmv 8/4/2009 16:29'!
basicDisplayString: aString from: startIndex to: stopIndex at: aPoint strikeFont: font kern: kernDelta

	destY := aPoint y.
	destX := aPoint x.

	"the following are not really needed, but theBitBlt primitive will fail if not set"
	sourceX ifNil: [sourceX := 100].
	width ifNil: [width := 100].

	self primDisplayString: aString from: startIndex to: stopIndex
			map: font characterToGlyphMap xTable: font xTable
			kern: kernDelta.
	^ destX@destY.
! !

!BitBlt methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
sourceForm: aForm 
	"Set the receiver's source form to be the argument, aForm."
	sourceForm := aForm! !

!BitBlt methodsFor: 'copying' stamp: 'lr 7/4/2009 10:42'!
copyForm: srcForm to: destPt rule: rule fillColor: color 
	sourceForm := srcForm.
	self fillColor: color.	"sets halftoneForm"
	combinationRule := rule.
	destX := destPt x + sourceForm offset x.
	destY := destPt y + sourceForm offset y.
	sourceX := 0.
	sourceY := 0.
	width := sourceForm width.
	height := sourceForm height.
	self copyBits! !

!BitBlt methodsFor: 'private' stamp: 'ar 5/26/2000 16:38'!
getPluginName
	"Private. Return the name of the plugin representing BitBlt.
	Used for dynamically switching between different BB representations only."
	^'BitBltPlugin'! !

!BitBlt methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
sourceOrigin: aPoint 
	"Set the receiver's source form coordinates to be those of the argument, 
	aPoint."
	sourceX := aPoint x.
	sourceY := aPoint y! !

!BitBlt methodsFor: 'accessing' stamp: 'tk 8/15/2001 10:56'!
color
	"Return the current fill color as a Color.  
	 Gives the wrong answer if the halftoneForm is a complex pattern of more than one word."

	halftoneForm ifNil: [^ Color black].
	^ Color colorFromPixelValue: halftoneForm first depth: destForm depth! !

!BitBlt methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
combinationRule: anInteger 
	"Set the receiver's combination rule to be the argument, anInteger, a 
	number in the range 0-15."
	combinationRule := anInteger! !

!BitBlt methodsFor: 'copying' stamp: 'lr 7/4/2009 10:42'!
pixelAt: aPoint 
	"Assumes this BitBlt has been set up specially (see the init message,
	BitBlt bitPeekerFromForm:.  Returns the pixel at aPoint."
	sourceX := aPoint x.
	sourceY := aPoint y.
	destForm unhibernate.	"before poking"
	destForm bits 
		at: 1
		put: 0.	"Just to be sure"
	self copyBits.
	^ destForm bits at: 1! !

!BitBlt methodsFor: 'accessing' stamp: 'tk 3/19/97'!
destRect
	"The rectangle we are about to blit to or just blitted to.  "

	^ destX @ destY extent: width @ height! !

!BitBlt methodsFor: '*FreeType-Addition' stamp: 'tween 4/4/2007 20:59'!
installFreeTypeFont: aFreeTypeFont foregroundColor: foregroundColor backgroundColor: backgroundColor
	"Set up the parameters.  Since the glyphs in a TTCFont is 32bit depth form, it tries to use rule=34 to get better AA result if possible."

	(FreeTypeSettings current bitBltSubPixelAvailable and: [destForm depth >= 8])
		ifTrue:[
			self combinationRule: 41.
			destForm depth = 8
				ifTrue:[self colorMap: (self cachedFontColormapFrom: 32 to: destForm depth)]
				ifFalse:[self colorMap: nil]]
		ifFalse:[
			"use combination rule 34 when rule 41 is not available in the BitBlt plugin,
			or the destination form depth <= 8"
			destForm depth <= 8 
				ifTrue: [
					self colorMap: (self cachedFontColormapFrom: 32 to: destForm depth).
					self combinationRule: Form paint.] 
				ifFalse: [
					self colorMap: nil.
					self combinationRule: 34]].
	halftoneForm := nil.
	sourceX := sourceY := 0.
	height := aFreeTypeFont height.
! !

!BitBlt class methodsFor: 'class initialization' stamp: 'jmv 9/7/2009 09:32'!
initialize
	self recreateColorMaps! !

!BitBlt class methodsFor: 'instance creation' stamp: 'lr 7/4/2009 10:42'!
bitPeekerFromForm: sourceForm 
	"Answer an instance to be used extract individual pixels from the given Form. The destination for a 1x1 copyBits will be the low order bits of (bits at: 1)."
	| pixPerWord |
	pixPerWord := 32 // sourceForm depth.
	sourceForm unhibernate.
	^ self 
		destForm: (Form 
				extent: pixPerWord @ 1
				depth: sourceForm depth)
		sourceForm: sourceForm
		halftoneForm: nil
		combinationRule: Form over
		destOrigin: (pixPerWord - 1) @ 0
		sourceOrigin: 0 @ 0
		extent: 1 @ 1
		clipRect: (0 @ 0 extent: pixPerWord @ 1)! !

!BitBlt class methodsFor: 'instance creation' stamp: ''!
toForm: aForm
	^ self new setDestForm: aForm! !

!BitBlt class methodsFor: 'instance creation' stamp: ''!
destForm: df sourceForm: sf halftoneForm: hf combinationRule: cr destOrigin: destOrigin sourceOrigin: sourceOrigin extent: extent clipRect: clipRect 
	"Answer an instance of me with values set according to the arguments."

	^ self new
		setDestForm: df
		sourceForm: sf
		fillColor: hf
		combinationRule: cr
		destOrigin: destOrigin
		sourceOrigin: sourceOrigin
		extent: extent
		clipRect: clipRect! !

!BitBlt class methodsFor: 'instance creation' stamp: 'lr 7/4/2009 10:42'!
bitPokerToForm: destForm 
	"Answer an instance to be used for valueAt: aPoint put: pixValue.
	The source for a 1x1 copyBits will be the low order of (bits at: 1)"
	| pixPerWord |
	pixPerWord := 32 // destForm depth.
	destForm unhibernate.
	^ self 
		destForm: destForm
		sourceForm: (Form 
				extent: pixPerWord @ 1
				depth: destForm depth)
		halftoneForm: nil
		combinationRule: Form over
		destOrigin: 0 @ 0
		sourceOrigin: (pixPerWord - 1) @ 0
		extent: 1 @ 1
		clipRect: (0 @ 0 extent: destForm extent)! !

!BitBlt class methodsFor: 'private' stamp: 'StephaneDucasse 10/17/2009 17:15'!
recreateColorMaps
	CachedFontColorMaps := ColorConvertingMaps := nil! !

!BitBlt class methodsFor: 'instance creation' stamp: ''!
destForm: df sourceForm: sf fillColor: hf combinationRule: cr destOrigin: destOrigin sourceOrigin: sourceOrigin extent: extent clipRect: clipRect 
	"Answer an instance of me with values set according to the arguments."

	^ self new
		setDestForm: df
		sourceForm: sf
		fillColor: hf
		combinationRule: cr
		destOrigin: destOrigin
		sourceOrigin: sourceOrigin
		extent: extent
		clipRect: clipRect! !

!BitBlt class methodsFor: 'deprecated' stamp: 'StephaneDucasse 10/25/2013 16:20'!
current
	"Return the class currently to be used for BitBlt"
	"deprecated normally should be removed."
	^self! !

!BitBlt class methodsFor: 'cleanup' stamp: 'StephaneDucasse 3/9/2010 16:18'!
cleanUp
	"Flush caches"

	self recreateColorMaps.! !

!BitBltClipBugsTest methodsFor: 'accessing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testFillingWayOutside
	| f1 bb |
	f1 := Form extent: 100 @ 100 depth: 1.
	bb := BitBlt toForm: f1.
	bb combinationRule: 3.
	bb fillColor: Color black.
	bb destOrigin: SmallInteger maxVal squared asPoint.
	bb
		width: 100;
		height: 100.
	bb copyBits! !

!BitBltClipBugsTest methodsFor: 'accessing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testFillingWayOutside3
	| f1 bb |
	f1 := Form extent: 100 @ 100 depth: 1.
	bb := BitBlt toForm: f1.
	bb combinationRule: 3.
	bb fillColor: Color black.
	bb destOrigin: SmallInteger maxVal squared asPoint.
	bb
		width: SmallInteger maxVal squared;
		height: SmallInteger maxVal squared.
	bb copyBits! !

!BitBltClipBugsTest methodsFor: 'accessing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testFillingWayOutside2
	| f1 bb |
	f1 := Form extent: 100 @ 100 depth: 1.
	bb := BitBlt toForm: f1.
	bb combinationRule: 3.
	bb fillColor: Color black.
	bb destOrigin: 0 @ 0.
	bb
		width: SmallInteger maxVal squared;
		height: SmallInteger maxVal squared.
	bb copyBits! !

!BitBltClipBugsTest methodsFor: 'accessing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testDrawingWayOutside2
	| f1 bb f2 |
	f1 := Form extent: 100 @ 100 depth: 1.
	f2 := Form extent: 100 @ 100 depth: 1.
	bb := BitBlt toForm: f1.
	bb combinationRule: 3.
	bb sourceForm: f2.
	bb destOrigin: 0 @ 0.
	bb
		width: SmallInteger maxVal squared;
		height: SmallInteger maxVal squared.
	bb copyBits! !

!BitBltClipBugsTest methodsFor: 'accessing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testDrawingWayOutside3
	| f1 bb f2 |
	f1 := Form extent: 100 @ 100 depth: 1.
	f2 := Form extent: 100 @ 100 depth: 1.
	bb := BitBlt toForm: f1.
	bb combinationRule: 3.
	bb sourceForm: f2.
	bb destOrigin: SmallInteger maxVal squared asPoint.
	bb
		width: SmallInteger maxVal squared;
		height: SmallInteger maxVal squared.
	bb copyBits! !

!BitBltClipBugsTest methodsFor: 'accessing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testDrawingWayOutside4
	| f1 bb f2 |
	f1 := Form extent: 100 @ 100 depth: 1.
	f2 := Form extent: 100 @ 100 depth: 1.
	bb := BitBlt toForm: f1.
	bb combinationRule: 3.
	bb sourceForm: f2.
	bb destOrigin: SmallInteger maxVal squared asPoint.
	bb
		width: 100;
		height: 100.
	bb sourceOrigin: SmallInteger maxVal squared asPoint.
	bb copyBits! !

!BitBltClipBugsTest methodsFor: 'accessing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testDrawingWayOutside
	| f1 bb f2 |
	f1 := Form extent: 100 @ 100 depth: 1.
	f2 := Form extent: 100 @ 100 depth: 1.
	bb := BitBlt toForm: f1.
	bb combinationRule: 3.
	bb sourceForm: f2.
	bb destOrigin: SmallInteger maxVal squared asPoint.
	bb
		width: 100;
		height: 100.
	bb copyBits! !

!BitBltClipBugsTest methodsFor: 'accessing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testDrawingWayOutside6
	| f1 bb f2 |
	f1 := Form extent: 100 @ 100 depth: 1.
	f2 := Form extent: 100 @ 100 depth: 1.
	bb := BitBlt toForm: f1.
	bb combinationRule: 3.
	bb sourceForm: f2.
	bb destOrigin: SmallInteger maxVal squared asPoint.
	bb
		width: SmallInteger maxVal squared;
		height: SmallInteger maxVal squared.
	bb sourceOrigin: SmallInteger maxVal squared asPoint.
	bb copyBits! !

!BitBltClipBugsTest methodsFor: 'accessing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testDrawingWayOutside5
	| f1 bb f2 |
	f1 := Form extent: 100 @ 100 depth: 1.
	f2 := Form extent: 100 @ 100 depth: 1.
	bb := BitBlt toForm: f1.
	bb combinationRule: 3.
	bb sourceForm: f2.
	bb destOrigin: 0 @ 0.
	bb
		width: SmallInteger maxVal squared;
		height: SmallInteger maxVal squared.
	bb sourceOrigin: SmallInteger maxVal squared asPoint.
	bb copyBits! !

!BitBltDisplayScanner commentStamp: 'nice 10/12/2013 01:36'!
A BitBltDisplayScanner displays characters on Screen or other Form with help of a BitBlt.

Instance Variables
	bitBlt:		<BitBlt>
	fillBlt:		<BitBlt>

bitBlt
	- the object which knows how to copy bits from one Form (the font glyph data) to another (the destination Form)

fillBlt
	- another object for copying form bits, initialized for displaying the background.

!
!BitBltDisplayScanner methodsFor: 'private' stamp: 'hmm 9/16/2000 21:29'!
setPort: aBitBlt
	"Install the BitBlt to use"
	bitBlt := aBitBlt.
	bitBlt sourceX: 0; width: 0.	"Init BitBlt so that the first call to a primitive will not fail"
	bitBlt sourceForm: nil. "Make sure font installation won't be confused"
! !

!BitBltDisplayScanner methodsFor: 'private' stamp: 'ar 5/17/2000 19:26'!
setDestForm: df
	bitBlt setDestForm: df.! !

!BitBltDisplayScanner methodsFor: 'displaying' stamp: 'SeanDeNigris 1/7/2014 20:59'!
displayEmbeddedForm: aForm

	aForm 
		displayOn: bitBlt destForm 
		at: destX @ (lineY + line baseline - aForm height)
		clippingBox: bitBlt clipRect
		rule: Form blend
		fillColor: Color white! !

!BitBltDisplayScanner methodsFor: 'displaying' stamp: 'nice 10/12/2013 01:06'!
displayString: string from: startIndex to: stopIndex at: aPoint
	font displayString: string on: bitBlt 
		from: startIndex 
		to: stopIndex 
		at: aPoint kern: kern! !

!BitBltDisplayScanner methodsFor: 'displaying' stamp: 'nice 10/12/2013 01:08'!
fillTextBackground
	fillBlt == nil ifFalse:
		["Not right"
		fillBlt destX: line left destY: lineY
			width: line width left height: line lineHeight; copyBits].! !

!BitBltDisplayScanner methodsFor: 'private' stamp: 'nice 10/12/2013 01:32'!
text: t textStyle: ts foreground: foreColor background: backColor fillBlt: blt ignoreColorChanges: shadowMode
	text := t.
	textStyle := ts. 
	foregroundColor := defaultTextColor := foreColor.
	(backgroundColor := backColor) isTransparent ifFalse:
		[fillBlt := blt.
		fillBlt fillColor: backgroundColor].
	ignoreColorChanges := shadowMode! !

!BitBltDisplayScanner methodsFor: 'stop conditions' stamp: 'nice 10/13/2013 22:10'!
plainTab
	| nextDestX |
 	nextDestX := super plainTab.
	fillBlt == nil ifFalse:
		[fillBlt destX: destX destY: destY width: nextDestX - destX height: font height; copyBits].
	^nextDestX! !

!BitBltDisplayScanner methodsFor: 'private' stamp: 'nice 10/12/2013 01:29'!
setFont 
	super setFont.  "Sets font and emphasis bits, and maybe foregroundColor"
	font installOn: bitBlt foregroundColor: foregroundColor backgroundColor: Color transparent! !

!BitBltDisplayScanner class methodsFor: 'queries' stamp: 'ar 5/17/2000 17:39'!
defaultFont
	^ TextStyle defaultFont! !

!BitBltTest methodsFor: 'bugs' stamp: 'sd 6/5/2005 10:12'!
testAlphaCompositing
	"self run: #testAlphaCompositing"

	| bb f1 f2 mixColor result eps |
	f1 := Form extent: 1@1 depth: 32.
	f2 := Form extent: 1@1 depth: 32.
	eps := 0.5 / 255.
	0 to: 255 do:[:i|
		f1 colorAt: 0@0 put: Color blue.
		mixColor := Color red alpha: i / 255.0.
		f2 colorAt: 0@0 put: mixColor.
		mixColor := f2 colorAt: 0@0.
		bb := BitBlt toForm: f1.
		bb sourceForm: f2.
		bb combinationRule: Form blend.
		bb copyBits.
		result := f1 colorAt: 0@0.
		self assert: (result red - mixColor alpha) abs < eps.
		self assert: (result blue - (1.0 - mixColor alpha)) abs < eps.
		self assert: result alpha = 1.0.
	].! !

!BitBltTest methodsFor: 'bugs' stamp: 'sd 6/5/2005 10:12'!
testAlphaCompositing2
	"self run: #testAlphaCompositing2"

	| bb f1 f2 mixColor result eps |
	f1 := Form extent: 1@1 depth: 32.
	f2 := Form extent: 1@1 depth: 32.
	eps := 0.5 / 255.
	0 to: 255 do:[:i|
		f1 colorAt: 0@0 put: Color transparent.
		mixColor := Color red alpha: i / 255.0.
		f2 colorAt: 0@0 put: mixColor.
		mixColor := f2 colorAt: 0@0.
		bb := BitBlt toForm: f1.
		bb sourceForm: f2.
		bb combinationRule: Form blend.
		bb copyBits.
		result := f1 colorAt: 0@0.
		self assert: (result red - mixColor alpha) abs < eps.
		self assert: result alpha = mixColor alpha.
	].! !

!BitBltTest methodsFor: 'bugs' stamp: 'CamilloBruni 8/31/2013 20:23'!
testPeekerUnhibernateBug
	"self run: #testPeekerUnhibernateBug"

	| bitBlt |
	bitBlt := BitBlt bitPeekerFromForm: Display.
	bitBlt destForm hibernate.
	bitBlt pixelAt: 1 @ 1! !

!BitBltTest methodsFor: 'bugs' stamp: 'CamilloBruni 8/31/2013 20:23'!
testPokerUnhibernateBug
	"self run: #testPokerUnhibernateBug"

	| bitBlt |
	bitBlt := BitBlt bitPokerToForm: Display.
	bitBlt sourceForm hibernate.
	bitBlt pixelAt: 1 @ 1 put: 0! !

!BitBltTest methodsFor: 'bugs' stamp: 'lr 3/14/2010 21:13'!
testAlphaCompositing2Simulated
	"self run: #testAlphaCompositing2Simulated"

	Smalltalk globals
		at: #BitBltSimulation
		ifPresent: [ :bitblt | 
			| bb f1 mixColor f2 result eps |
			f1 := Form extent: 1 @ 1 depth: 32.
			f2 := Form extent: 1 @ 1 depth: 32.
			eps := 0.5 / 255.
			0 to: 255 do: [ :i | 
				f1 colorAt: 0 @ 0 put: Color transparent.
				mixColor := Color red alpha: i / 255.0.
				f2 colorAt: 0 @ 0 put: mixColor.
				mixColor := f2 colorAt: 0 @ 0.
				bb := BitBlt toForm: f1.
				bb sourceForm: f2.
				bb combinationRule: Form blend.
				result := f1 colorAt: 0 @ 0.
				self assert: (result red - mixColor alpha) abs < eps.
				self assert: result alpha = mixColor alpha ] ]! !

!BitBltTest methodsFor: 'bugs' stamp: 'lr 3/14/2010 21:13'!
testAlphaCompositingSimulated
	"self run: #testAlphaCompositingSimulated"

	Smalltalk globals
		at: #BitBltSimulation
		ifPresent: [ :bitblt | 
			| mixColor result eps f1 bb f2 |
			f1 := Form extent: 1 @ 1 depth: 32.
			f2 := Form extent: 1 @ 1 depth: 32.
			eps := 0.5 / 255.
			0 to: 255 do: [ :i | 
				f1 colorAt: 0 @ 0 put: Color blue.
				mixColor := Color red alpha: i / 255.0.
				f2 colorAt: 0 @ 0 put: mixColor.
				mixColor := f2 colorAt: 0 @ 0.
				bb := BitBlt toForm: f1.
				bb sourceForm: f2.
				bb combinationRule: Form blend.
				result := f1 colorAt: 0 @ 0.
				self assert: (result red - mixColor alpha) abs < eps.
				self assert: (result blue - (1.0 - mixColor alpha)) abs < eps.
				self assert: result alpha = 1.0 ] ]! !

!Bitmap commentStamp: '<historical>'!
My instances provide contiguous storage of bits, primarily to hold the graphical data of Forms. Forms and their subclasses provide the additional structural information as to how the bits should be interpreted in two dimensions.!
!Bitmap methodsFor: 'conversion' stamp: 'CamilloBruni 11/2/2012 10:12'!
restoreEndianness
	"nothing to do here?"! !

!Bitmap methodsFor: 'accessing' stamp: 'ar 3/3/2001 16:18'!
byteSize
	^self size * 4! !

!Bitmap methodsFor: 'accessing' stamp: 'CamilloBruni 8/1/2012 16:01'!
bitPatternForDepth: depth
	"The raw call on BitBlt needs a Bitmap to represent this color.  I already am Bitmap like. I am already adjusted for a specific depth.  Interpret me as an array of (32/depth) Color pixelValues. BitBlt aligns the first element of this array with the top scanline of the destinationForm, the second with the second, and so on, cycling through the color array as necessary."

	^ self! !

!Bitmap methodsFor: 'accessing' stamp: ''!
primFill: aPositiveInteger
	"Fill the receiver, an indexable bytes or words object, with the given positive integer. The range of possible fill values is [0..255] for byte arrays and [0..(2^32 - 1)] for word arrays."

	<primitive: 145>
	self errorImproperStore.! !

!Bitmap methodsFor: 'accessing' stamp: 'tk 3/15/97'!
pixelValueForDepth: depth
	"Self is being used to represent a single color.  Answer bits that appear in ONE pixel of this color in a Bitmap of the given depth. The depth must be one of 1, 2, 4, 8, 16, or 32.  Returns an integer.  First pixel only.  "

	^ (self at: 1) bitAnd: (1 bitShift: depth) - 1! !

!Bitmap methodsFor: 'accessing' stamp: 'StephaneDucasse 3/17/2010 20:52'!
copyFromByteArray: byteArray 
	"This method should work with either byte orderings"

	| myHack byteHack |
	myHack := Form new hackBits: self.
	byteHack := Form new hackBits: byteArray.
	Smalltalk  isLittleEndian ifTrue: [byteHack swapEndianness].
	byteHack displayOn: myHack! !

!Bitmap methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
integerAt: index put: anInteger 
	"Store the integer at the given index"
	| word |
	<primitive: 166>
	anInteger < 0 
		ifTrue: 
			[ "word := 16r100000000 + anInteger"
			word := (anInteger + 1) negated bitInvert32 ]
		ifFalse: [ word := anInteger ].
	self 
		basicAt: index
		put: word.
	^ anInteger! !

!Bitmap methodsFor: '*Compression' stamp: 'lr 7/4/2009 10:42'!
compressGZip
	"just hacking around to see if further compression would help Nebraska"
	| ba hackwa hackba blt rowsAtATime sourceOrigin rowsRemaining bufferStream gZipStream |
	bufferStream := RWBinaryOrTextStream on: (ByteArray new: 5000).
	gZipStream := GZipWriteStream on: bufferStream.
	ba := nil.
	rowsAtATime := 20000.	"or 80000 bytes"
	hackwa := Form new hackBits: self.
	sourceOrigin := 0 @ 0.
	[ (rowsRemaining := hackwa height - sourceOrigin y) > 0 ] whileTrue: 
		[ rowsAtATime := rowsAtATime min: rowsRemaining.
		(ba isNil or: [ ba size ~= (rowsAtATime * 4) ]) ifTrue: 
			[ ba := ByteArray new: rowsAtATime * 4.
			hackba := Form new hackBits: ba.
			blt := (BitBlt toForm: hackba) sourceForm: hackwa ].
		blt
			combinationRule: Form over;
			sourceOrigin: sourceOrigin;
			destX: 0
				destY: 0
				width: 4
				height: rowsAtATime;
			copyBits.
		"bufferStream nextPutAll: ba."
		sourceOrigin := sourceOrigin x @ (sourceOrigin y + rowsAtATime) ].
	gZipStream close.
	^ bufferStream contents! !

!Bitmap methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
integerAt: index 
	"Return the integer at the given index"
	| word |
	<primitive: 165>
	word := self basicAt: index.
	word < 1073741823 ifTrue: [ ^ word ].	"Avoid LargeInteger computations"
	^ word >= 2147483648 
		ifTrue: 
			[ "Negative?!!"
			"word - 16r100000000"
			(word bitInvert32 + 1) negated ]
		ifFalse: [ word ]! !

!Bitmap methodsFor: 'printing' stamp: 'sma 6/1/2000 09:42'!
printOn: aStream
	self printNameOn: aStream.
	aStream nextPutAll: ' of length '; print: self size! !

!Bitmap methodsFor: 'filing' stamp: 'tk 2/19/1999 07:36'!
writeUncompressedOn: aStream 
	"Store the array of bits onto the argument, aStream.
	(leading byte ~= 16r80) identifies this as raw bits (uncompressed)."

	aStream nextInt32Put: self size.
	aStream nextPutAll: self
! !

!Bitmap methodsFor: 'filing' stamp: 'lr 7/4/2009 10:42'!
compressToByteArray
	"Return a run-coded compression of this bitmap into a byteArray"
	"Without skip codes, it is unlikely that the compressed bitmap will be any larger than was the original.  The run-code cases are...
	N >= 1 words of equal bytes:  4N bytes -> 2 bytes (at worst 4 -> 2)
	N > 1 equal words:  4N bytes -> 5 bytes (at worst 8 -> 5)
	N > 1 unequal words:  4N bytes -> 4N + M, where M is the number of bytes required to encode the run length.

The worst that can happen is that the method begins with unequal words, and than has interspersed occurrences of a word with equal bytes.  Thus we require a run-length at the beginning, and after every interspersed word of equal bytes.  However, each of these saves 2 bytes, so it must be followed by a run of 1984 (7936//4) or more (for which M jumps from 2 to 5) to add any extra overhead.  Therefore the worst case is a series of runs of 1984 or more, with single interspersed words of equal bytes.  At each break we save 2 bytes, but add 5.  Thus the overhead would be no more than 5 (encoded size) + 2 (first run len) + (S//1984*3)."
	"NOTE: This code is copied in Form hibernate for reasons given there."
	| byteArray lastByte |
	byteArray := ByteArray new: self size * 4 + 7 + (self size // 1984 * 3).
	lastByte := self 
		compress: self
		toByteArray: byteArray.
	^ byteArray 
		copyFrom: 1
		to: lastByte! !

!Bitmap methodsFor: 'testing' stamp: 'ar 5/25/2000 19:42'!
isColormap
	"Bitmaps were used as color maps for BitBlt.
	This method allows to recognize real color maps."
	^false! !

!Bitmap methodsFor: 'filing' stamp: 'nk 12/31/2003 16:02'!
storeBits: startBit to: stopBit on: aStream 
	"Store my bits as a hex string, breaking the lines every 100 bytes or 
	so to comply with the maximum line length limits of Postscript (255 
	bytes). "
	| lineWidth |
	lineWidth := 0.
	self
		do: [:word | 
			startBit
				to: stopBit
				by: -4
				do: [:shift | 
					aStream nextPut: (word >> shift bitAnd: 15) asHexDigit.
					lineWidth := lineWidth + 1].
			(lineWidth > 100)
				ifTrue: [aStream cr.
					lineWidth := 0]].
	lineWidth > 0 ifTrue: [ aStream cr ].! !

!Bitmap methodsFor: 'accessing' stamp: 'CamilloBruni 8/1/2012 16:02'!
byteAt: byteAddress 
	"Extract a byte from a Bitmap.  Note that this is a byte address and it is one-order.  For repeated use, create an instance of BitBlt and use pixelAt:.  See Form>>#pixelAt:"
	| lowBits |
	lowBits := byteAddress - 1 bitAnd: 3.
	^ ((self at: (byteAddress - 1 - lowBits) // 4 + 1) bitShift: (lowBits - 3) * 8) bitAnd: 255! !

!Bitmap methodsFor: 'filing' stamp: 'MarcusDenker 3/17/2012 09:34'!
compress: bm toByteArray: ba
	"Store a run-coded compression of the receiver into the byteArray ba,
	and return the last index stored into. ba is assumed to be large enough.
	The encoding is as follows...
		S {N D}*.
		S is the size of the original bitmap, followed by run-coded pairs.
		N is a run-length * 4 + data code.
		D, the data, depends on the data code...
			0	skip N words, D is absent
			1	N words with all 4 bytes = D (1 byte)
			2	N words all = D (4 bytes)
			3	N words follow in D (4N bytes)
		S and N are encoded as follows...
			0-223	0-223
			224-254	(0-30)*256 + next byte (0-7935)
			255		next 4 bytes"
	| size k word j lowByte eqBytes i |
	<primitive: 'primitiveCompressToByteArray' module: 'MiscPrimitivePlugin'>
	
	<var: #bm declareC: 'int *bm'>
	<var: #ba declareC: 'unsigned char *ba'>
	
	size := bm size.
	i := self 
		encodeInt: size
		in: ba
		at: 1.
	k := 1.
	[ k <= size ] whileTrue: 
		[ word := bm at: k.
		lowByte := word bitAnd: 255.
		eqBytes := (word >> 8 bitAnd: 255) = lowByte and: 
			[ (word >> 16 bitAnd: 255) = lowByte and: [ (word >> 24 bitAnd: 255) = lowByte ] ].
		j := k.
		[ j < size and: [ word = (bm at: j + 1) ]	"scan for = words..." ] whileTrue: [ j := j + 1 ].
		j > k 
			ifTrue: 
				[ "We have two or more = words, ending at j"
				eqBytes 
					ifTrue: 
						[ "Actually words of = bytes"
						i := self 
							encodeInt: (j - k + 1) * 4 + 1
							in: ba
							at: i.
						ba 
							at: i
							put: lowByte.
						i := i + 1 ]
					ifFalse: 
						[ i := self 
							encodeInt: (j - k + 1) * 4 + 2
							in: ba
							at: i.
						i := self 
							encodeBytesOf: word
							in: ba
							at: i ].
				k := j + 1 ]
			ifFalse: 
				[ "Check for word of 4 = bytes"
				eqBytes 
					ifTrue: 
						[ "Note 1 word of 4 = bytes"
						i := self 
							encodeInt: 1 * 4 + 1
							in: ba
							at: i.
						ba 
							at: i
							put: lowByte.
						i := i + 1.
						k := k + 1 ]
					ifFalse: 
						[ "Finally, check for junk"
						[ j < size and: [ (bm at: j) ~= (bm at: j + 1) ]	"scan for ~= words..." ] whileTrue: [ j := j + 1 ].
						j = size ifTrue: [ j := j + 1 ].
						"We have one or more unmatching words, ending at j-1"
						i := self 
							encodeInt: (j - k) * 4 + 3
							in: ba
							at: i.
						k 
							to: j - 1
							do: 
								[ :m | 
								i := self 
									encodeBytesOf: (bm at: m)
									in: ba
									at: i ].
						k := j ] ] ].
	^ i - 1	"number of bytes actually stored"! !

!Bitmap methodsFor: 'initialize' stamp: 'ar 12/23/1999 14:35'!
fromByteStream: aStream 
	"Initialize the array of bits by reading integers from the argument, 
	aStream."
	aStream nextWordsInto: self! !

!Bitmap methodsFor: 'filing' stamp: 'lr 7/4/2009 10:42'!
writeOn: aStream 
	"Store the array of bits onto the argument, aStream. A leading byte of 16r80 identifies this as compressed by compressToByteArray (qv)."
	| b |
	aStream nextPut: 128.
	b := self compressToByteArray.
	aStream
		nextPutAll: (self encodeInt: b size);
		nextPutAll: b! !

!Bitmap methodsFor: 'filing' stamp: 'PeterHugossonMiller 9/3/2009 00:15'!
readCompressedFrom: strm 
	"Decompress an old-style run-coded stream into this bitmap:
		[0 means end of runs]
		[n = 1..127] [(n+3) copies of next byte]
		[n = 128..191] [(n-127) next bytes as is]
		[n = 192..255] [(n-190) copies of next 4 bytes]"
	| n byte out outBuff bytes |
	out := (outBuff := ByteArray new: self size * 4) writeStream.
	[ (n := strm next) > 0 ] whileTrue: 
		[ (n 
			between: 1
			and: 127) ifTrue: 
			[ byte := strm next.
			1 
				to: n + 3
				do: [ :i | out nextPut: byte ] ].
		(n 
			between: 128
			and: 191) ifTrue: 
			[ 1 
				to: n - 127
				do: [ :i | out nextPut: strm next ] ].
		(n 
			between: 192
			and: 255) ifTrue: 
			[ bytes := (1 to: 4) collect: [ :i | strm next ].
			1 
				to: n - 190
				do: [ :i | bytes do: [ :b | out nextPut: b ] ] ] ].
	out position = outBuff size ifFalse: [ self error: 'Decompression size error' ].
	"Copy the final byteArray into self"
	self copyFromByteArray: outBuff! !

!Bitmap methodsFor: 'filing' stamp: 'HenrikSperreJohansen 10/25/2010 15:33'!
decompress: bm fromByteArray: ba at: index 
	"Decompress the body of a byteArray encoded by compressToByteArray (qv)...
	The format is simply a sequence of run-coded pairs, {N D}*.
		N is a run-length * 4 + data code.
		D, the data, depends on the data code...
			0	skip N words, D is absent
				(could be used to skip from one raster line to the next)
			1	N words with all 4 bytes = D (1 byte)
			2	N words all = D (4 bytes)
			3	N words follow in D (4N bytes)
		S and N are encoded as follows (see decodeIntFrom:)...
			0-223	0-223
			224-254	(0-30)*256 + next byte (0-7935)
			255		next 4 bytes"
	"NOTE:  If fed with garbage, this routine could read past the end of ba, but it should fail before writing past the ned of bm."
	| i code n anInt data end k pastEnd |
	<primitive: 'primitiveDecompressFromByteArray' module: 'MiscPrimitivePlugin'>
	
	<var: #bm declareC: 'int *bm'>
	<var: #ba declareC: 'unsigned char *ba'>
	
	i := index.	"byteArray read index"
	end := ba size.
	k := 1.	"bitmap write index"
	pastEnd := bm size + 1.
	[ i <= end ] whileTrue: 
		[ "Decode next run start N"
		anInt := ba at: i.
		i := i + 1.
		anInt <= 223 ifFalse: 
			[ anInt <= 254 
				ifTrue: 
					[ anInt := (anInt - 224) * 256 + (ba at: i).
					i := i + 1 ]
				ifFalse: 
					[ anInt := 0.
					1 
						to: 4
						do: 
							[ :j | 
							anInt := (anInt bitShift: 8) + (ba at: i).
							i := i + 1 ] ] ].
		n := anInt >> 2.
		k + n > pastEnd ifTrue: [ ^ self primitiveFail ].
		code := anInt bitAnd: 3.
		code = 0 ifTrue: 
			[ "skip"
			 ].
		code = 1 ifTrue: 
			[ "n consecutive words of 4 bytes = the following byte"
			data := ba at: i.
			i := i + 1.
			data := data bitOr: (data bitShift: 8).
			data := data bitOr: (data bitShift: 16).
			1 
				to: n
				do: 
					[ :j | 
					bm 
						at: k
						put: data.
					k := k + 1 ] ].
		code = 2 ifTrue: 
			[ "n consecutive words = 4 following bytes"
			data := 0.
			1 
				to: 4
				do: 
					[ :j | 
					data := (data bitShift: 8) bitOr: (ba at: i).
					i := i + 1 ].
			1 
				to: n
				do: 
					[ :j | 
					bm 
						at: k
						put: data.
					k := k + 1 ] ].
		code = 3 ifTrue: 
			[ "n consecutive words from the data..."
			1 
				to: n
				do: 
					[ :m | 
					data := 0.
					1 
						to: 4
						do: 
							[ :j | 
							data := (data bitShift: 8) bitOr: (ba at: i).
							i := i + 1 ].
					bm 
						at: k
						put: data.
					k := k + 1 ] ] ]! !

!Bitmap methodsFor: 'accessing' stamp: 'CamilloBruni 8/1/2012 16:01'!
byteAt: byteAddress put: byte 
	"Insert a byte into a Bitmap.  Note that this is a byte address and it is one-order.  For repeated use, create an instance of BitBlt and use pixelAt:put:.  See Form>>#pixelAt:put:"
	| longWord shift lowBits longAddr |
	(byte < 0 or: [ byte > 255 ]) ifTrue: [ ^ self errorImproperStore ].
	lowBits := byteAddress - 1 bitAnd: 3.
	longWord := self at: (longAddr := (byteAddress - 1 - lowBits) // 4 + 1).
	shift := (3 - lowBits) * 8.
	longWord := longWord - (longWord bitAnd: (255 bitShift: shift)) + (byte bitShift: shift).
	self 
		at: longAddr
		put: longWord.
	^ byte! !

!Bitmap methodsFor: 'filing' stamp: 'lr 7/4/2009 10:42'!
encodeInt: int 
	"Encode the integer int as per encodeInt:in:at:, and return it as a ByteArray"
	| byteArray next |
	byteArray := ByteArray new: 5.
	next := self 
		encodeInt: int
		in: byteArray
		at: 1.
	^ byteArray 
		copyFrom: 1
		to: next - 1! !

!Bitmap methodsFor: 'filing' stamp: 'HenrikSperreJohansen 10/25/2010 15:29'!
encodeInt: anInt in: ba at: i
	"Encode the integer anInt in byteArray ba at index i, and return the next index.
	The encoding is as follows...
		0-223	0-223
		224-254	(0-30)*256 + next byte (0-7935)
		255		next 4 bytes"		

	<inline: true>
	<var: #ba declareC: 'unsigned char *ba'>
	
	anInt <= 223 ifTrue: [ba at: i put: anInt. ^ i+1].
	anInt <= 7935 ifTrue: [ba at: i put: anInt//256+224. ba at: i+1 put: anInt\\256.  ^ i+2].
	ba at: i put: 255.
	^ self encodeBytesOf: anInt in: ba at: i+1! !

!Bitmap methodsFor: 'accessing' stamp: 'ar 11/2/1998 12:19'!
defaultElement
	"Return the default element of the receiver"
	^0! !

!Bitmap methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 8/22/2011 11:49'!
gtInspectorItemsIn: composite
	"No items presentation for a Bitmap"! !

!Bitmap methodsFor: 'filing' stamp: 'HenrikSperreJohansen 10/25/2010 15:29'!
encodeBytesOf: anInt in: ba at: i
	"Copy the integer anInt into byteArray ba at index i, and return the next index"

	<inline: true>
	<var: #ba declareC: 'unsigned char *ba'>
	
	0 to: 3 do:
		[:j | ba at: i+j put: (anInt >> (3-j*8) bitAnd: 16rFF)].
	^ i+4! !

!Bitmap methodsFor: 'accessing' stamp: ''!
replaceFrom: start to: stop with: replacement startingAt: repStart 
	"Primitive. This destructively replaces elements from start to stop in the receiver starting at index, repStart, in the collection, replacement. Answer the receiver. Range checks are performed in the primitive only. Optional. See Object documentation whatIsAPrimitive."
	<primitive: 105>
	super replaceFrom: start to: stop with: replacement startingAt: repStart! !

!Bitmap methodsFor: 'accessing' stamp: 'ar 3/3/2001 16:11'!
atAllPut: value
	"Fill the receiver, an indexable bytes or words object, with the given positive integer. The range of possible fill values is [0..255] for byte arrays and [0..(2^32 - 1)] for word arrays."
	<primitive: 145>
	super atAllPut: value.! !

!Bitmap methodsFor: 'conversion' stamp: 'StephaneDucasse 3/17/2010 20:52'!
asByteArray
	"Faster way to make a byte array from me.
	copyFromByteArray: makes equal Bitmap."
	| f bytes hack |
	f := Form 
		extent: 4 @ self size
		depth: 8
		bits: self.
	bytes := ByteArray new: self size * 4.
	hack := Form new hackBits: bytes.
	Smalltalk isLittleEndian ifTrue: [ hack swapEndianness ].
	hack 
		copyBits: f boundingBox
		from: f
		at: 0 @ 0
		clippingBox: hack boundingBox
		rule: Form over
		fillColor: nil
		map: nil.

	"f displayOn: hack."
	^ bytes! !

!Bitmap class methodsFor: 'utilities' stamp: 'lr 7/4/2009 10:42'!
swapBytesIn: aNonPointerThing from: start to: stop 
	"Perform a bigEndian/littleEndian byte reversal of my words.
	We only intend this for non-pointer arrays.  Do nothing if I contain pointers."
	"The implementation is a hack, but fast for large ranges"
	| hack blt |
	hack := Form new hackBits: aNonPointerThing.
	blt := (BitBlt toForm: hack) sourceForm: hack.
	blt combinationRule: Form reverse.	"XOR"
	blt
		sourceY: start - 1;
		destY: start - 1;
		height: stop - start + 1;
		width: 1.
	blt
		sourceX: 0;
		destX: 3;
		copyBits.	"Exchange bytes 0 and 3"
	blt
		sourceX: 3;
		destX: 0;
		copyBits.
	blt
		sourceX: 0;
		destX: 3;
		copyBits.
	blt
		sourceX: 1;
		destX: 2;
		copyBits.	"Exchange bytes 1 and 2"
	blt
		sourceX: 2;
		destX: 1;
		copyBits.
	blt
		sourceX: 1;
		destX: 2;
		copyBits! !

!Bitmap class methodsFor: 'instance creation' stamp: 'damiencassou 5/30/2008 14:51'!
decompressFromByteArray: byteArray 
	| s bitmap size |
	s := byteArray readStream.
	size := self decodeIntFrom: s.
	bitmap := self new: size.
	bitmap 
		decompress: bitmap
		fromByteArray: byteArray
		at: s position + 1.
	^ bitmap! !

!Bitmap class methodsFor: 'instance creation' stamp: 'lr 7/4/2009 10:42'!
decodeIntFrom: s 
	"Decode an integer in stream s as follows...
		0-223	0-223
		224-254	(0-30)*256 + next byte (0-7935)
		255		next 4 bytes	"
	| int |
	int := s next.
	int <= 223 ifTrue: [ ^ int ].
	int <= 254 ifTrue: [ ^ (int - 224) * 256 + s next ].
	int := s next.
	1 
		to: 3
		do: [ :j | int := (int bitShift: 8) + s next ].
	^ int! !

!Bitmap class methodsFor: 'instance creation' stamp: 'lr 7/4/2009 10:42'!
newFromStream: s 
	| len |
	s next = 128 ifTrue: 
		[ "New compressed format"
		len := self decodeIntFrom: s.
		^ Bitmap decompressFromByteArray: (s nextInto: (ByteArray new: len)) ].
	s skip: -1.
	len := s nextInt32.
	len <= 0 
		ifTrue: 
			[ "Old compressed format"
			^ (self new: len negated) readCompressedFrom: s ]
		ifFalse: 
			[ "Old raw data format"
			^ s nextWordsInto: (self new: len) ]! !

!Bitmap class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:15'!
gtExampleIconBits
	<gtExample: 'Icon bits'>
	^ ThemeIcons current pharoIcon bits! !

!BitmapFillStyle commentStamp: '<historical>'!
A BitmapFillStyle fills using any kind of form.

Instance variables:
	form	<Form>	The form to be used as fill.
	tileFlag	<Boolean>	If true, then the form is repeatedly drawn to fill the area.!
!BitmapFillStyle methodsFor: 'accessing' stamp: 'ar 11/27/1998 14:30'!
tileFlag: aBoolean
	tileFlag := aBoolean! !

!BitmapFillStyle methodsFor: 'accessing' stamp: 'ar 11/11/1998 22:40'!
form
	^form! !

!BitmapFillStyle methodsFor: 'testing' stamp: 'ar 11/11/1998 22:40'!
isBitmapFill
	^true! !

!BitmapFillStyle methodsFor: 'converting' stamp: 'ar 11/11/1998 22:41'!
asColor
	^form colorAt: 0@0! !

!BitmapFillStyle methodsFor: '*Morphic-Base-Balloon' stamp: 'ar 6/25/1999 11:57'!
newForm: aForm forMorph: aMorph
	self form: aForm.
	self direction: (aForm width @ 0).
	self normal: (0 @ aForm height).
	aMorph changed.! !

!BitmapFillStyle methodsFor: 'accessing' stamp: 'StephaneDucasse 3/5/2010 15:17'!
direction

	^direction ifNil: [direction :=( (normal y @ normal x negated) * form width / form height ) rounded]! !

!BitmapFillStyle methodsFor: 'testing' stamp: 'ar 11/27/1998 14:37'!
isTiled
	"Return true if the receiver should be repeated if the fill shape is larger than the form"
	^tileFlag == true! !

!BitmapFillStyle methodsFor: 'accessing' stamp: 'StephaneDucasse 3/5/2010 15:17'!
normal
	^normal ifNil: [normal := ((direction y negated @ direction x) *  form height / form width ) rounded]! !

!BitmapFillStyle methodsFor: '*Morphic-Base-Balloon' stamp: 'wiz 8/30/2003 16:54'!
grabNewGraphicIn: aMorph event: evt 
	"Used by any morph that can be represented by a graphic"
	| fill |
	fill := Form fromUser.
	fill boundingBox area = 0
		ifTrue: [^ self].
	self form: fill.
	self direction: fill width @ 0.
	self normal: 0 @ fill height.
	aMorph changed! !

!BitmapFillStyle methodsFor: 'accessing' stamp: 'ar 11/11/1998 22:40'!
form: aForm
	form := aForm! !

!BitmapFillStyle methodsFor: 'accessing' stamp: 'ar 11/27/1998 14:37'!
tileFlag
	^tileFlag! !

!BitmapFillStyle class methodsFor: 'instance creation' stamp: 'KLC 1/27/2004 13:33'!
fromForm: aForm
	| fs |
	fs := self form: aForm.
	fs origin: 0@0.
	fs direction: aForm width @ 0.
	fs normal: 0 @ aForm height.
	fs tileFlag: true.
	^fs! !

!BitmapFillStyle class methodsFor: 'instance creation' stamp: 'ar 11/13/1998 20:32'!
form: aForm
	^self new form: aForm! !

!BitmapFillStyle class methodsFor: 'instance creation' stamp: 'ar 6/18/1999 07:09'!
fromUser
	| fill |
	fill := self form: Form fromUser.
	fill origin: 0@0.
	fill direction: fill form width @ 0.
	fill normal: 0 @ fill form height.
	fill tileFlag: true. "So that we can fill arbitrary objects"
	^fill! !

!BitsLayout commentStamp: '<historical>'!
I am a specialized layout which does not hold slots but only raw data (bytes or words).!
!BitsLayout methodsFor: 'testing' stamp: 'ToonVerwaest 4/1/2011 01:25'!
isBits
	^ true! !

!BitsLayout methodsFor: 'testing' stamp: 'MartinDias 1/31/2014 16:19'!
isBytes
	^ self subclassResponsibility! !

!BitsLayout methodsFor: 'initialize-release' stamp: 'ToonVerwaest 4/1/2011 01:53'!
initializeInstance: anInstance! !

!BitsLayout methodsFor: 'extending' stamp: 'MartinDias 9/5/2013 15:50'!
extend
	"Answer a default extension of me."

	^ self species new ! !

!BitsLayout methodsFor: 'reshaping' stamp: 'MartinDias 9/5/2013 15:49'!
extendAgain: aLayout with: aScope 
	"Answer my default layout since any subclass of me only can have my layout type."

	^ self extend
		host: host;
		yourself! !

!BitsLayout methodsFor: 'reshaping' stamp: 'MartinDias 8/28/2013 15:48'!
reshapeFrom: oldScope to: newParentLayout
	"Answer the reshaped version of me for a new parent layout.

	If the new parent layout has not fields, then the new version 
	is just a copy of me. But if it has fields, that means that 
	the new version of me cannot be a bits layout anymore, so the
	answer is a new default layout. "

	^ newParentLayout hasFields 
		ifTrue: [ 
			(newParentLayout extend)
				host: host;
				yourself ]
		ifFalse: [ 
			self copy ]
! !

!BitsLayout methodsFor: 'testing' stamp: 'ToonVerwaest 4/1/2011 01:26'!
isVariable
	^ true! !

!BitsLayout methodsFor: 'testing' stamp: 'MartinDias 1/31/2014 16:18'!
isWords
	^ self isBytes not! !

!BlockCannotReturn commentStamp: '<historical>'!
This class is private to the EHS implementation.  Its use allows for ensured execution to survive code such as:

[self doThis.
^nil]
	ensure: [self doThat]

Signaling or handling this exception is not recommended.!
!BlockCannotReturn methodsFor: 'exceptiondescription' stamp: 'tfei 4/2/1999 15:49'!
isResumable

	^true! !

!BlockCannotReturn methodsFor: 'accessing' stamp: 'ajh 2/6/2002 11:12'!
deadHome

	^ deadHome! !

!BlockCannotReturn methodsFor: 'accessing' stamp: 'tfei 3/30/1999 12:54'!
result: r

	result := r! !

!BlockCannotReturn methodsFor: 'exceptiondescription' stamp: 'tfei 3/30/1999 12:55'!
defaultAction

	self messageText: 'Block cannot return'.
	^super defaultAction! !

!BlockCannotReturn methodsFor: 'accessing' stamp: 'tfei 3/30/1999 12:54'!
result

	^result! !

!BlockCannotReturn methodsFor: 'accessing' stamp: 'ajh 2/6/2002 11:12'!
deadHome: context

	deadHome := context! !

!BlockClosure commentStamp: '<historical>'!
I contain a sequence of operations. I am defined by Smalltalk expressions inside square brackets. I permit to defer the enclosed operations until I execute a variant of #value. I can have my own arguments and temporaries as a regular method, but I am also able to use external variables: my enclosing method or block temporaries, arguments and receiver.

examples :
[ 1 + 2 ] value
[ :arg | 
	| temp | 
	temp := arg. 
	temp ] value: 5
[ ^ 5 ] value

My return value corresponds to my final expression. A non local return (^) has the same effect as if I did not exist: it returns from my enclosing method, even if I'm nested in other blocks. 

Implementation:

Instance variables:
	outerContext <Context|nil> context that defined me
	startpc: <SmallInteger> (pc = program counter) offset of my first bytecode instruction in the compiledMethod bytecode  
	numArgs: <SmallInteger> my number of arguments

I am created at runtime through a special bytecode:
closureNumCopied: x numArgs: y bytes z1 to z2
On creation, the currently executed context is set to my outerContext, z1 is set as my startpc and y is set as my numArgs. After my creation, the current execution flow jumps to my last bytecode, z2, to skip the execution of my bytecode which is deferred until I execute a variant of #value.

I am executed when I receive a variant of the message value. This message creates a new context, a block context <MethodContext>, which reference me in its variable closureOrNil. This new context executes my bytecode, which correspond to a subset of the bytecode of my enclosing method, starting at startpc and ending in blockReturn/return bytecode.

Accessing variables of the my enclosing context is different depending on variables because of various optimizations:
- self: I access the receiver of my enclosing method by accessing my context's receiver, which is always set to the enclosing method receiver.
- copied variables: If I read a variable from an outerContext but I don't write into it and the variable is not modified after the BlockClosure creation, then the variable is copied in the blockClosure to be more efficient. 
- full variable: If I access and edit a variable from an outerContext, then the variable is stored in an external heap allocated array (named tempVector). The tempVector is known by the method and the block so they can both read and write these variables.

Optimized block closures: 
Common blocks (2/3 of the blocks) are optimized directly in the compiler and have special behaviors. These blocks are the arguments/receiver of control structures: #ifNil:, #ifNotNil:, #ifTrue:, #ifFalse:, #whileTrue:, #whileFalse:, #to:do:, #to:by:do: .
!
!BlockClosure methodsFor: 'evaluating' stamp: 'HenrikSperreJohansen 6/28/2010 12:12'!
ifError: errorHandlerBlock
	"Evaluate the block represented by the receiver, and normally return it's value.  If an error occurs, the errorHandlerBlock is evaluated, and it's value is instead returned.  The errorHandlerBlock must accept zero, one, or two parameters (the error message and the receiver)."
	"Examples:
		[1 whatsUpDoc] ifError: [:err :rcvr | 'huh?'].
		[1 / 0] ifError: [:err :rcvr |
			'ZeroDivide' = err
				ifTrue: [Float infinity]
				ifFalse: [self error: err]]
"

	^ self on: Error do: [:ex |
		errorHandlerBlock cull: ex description cull: ex receiver]! !

!BlockClosure methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setBlessingInMetacelloConfig: aMetacelloConfig

	aMetacelloConfig setBlessingWithBlock: self! !

!BlockClosure methodsFor: 'testing' stamp: 'eem 4/26/2012 10:21'!
hasMethodReturn
	"Answer whether the receiver has a method-return ('^') in its code."
	| scanner endpc |
	scanner := InstructionStream new method: outerContext method pc: startpc.
	endpc := self endPC.
	scanner scanFor: [:byte | (byte between: 120 and: 124) or: [scanner pc > endpc]].
	^scanner pc <= endpc! !

!BlockClosure methodsFor: 'accessing' stamp: 'ajh 1/21/2003 13:16'!
isBlock

	^ true! !

!BlockClosure methodsFor: 'scheduling' stamp: 'ajh 9/29/2001 21:00'!
forkAt: priority 
	"Create and schedule a Process running the code in the receiver at the given priority. Answer the newly created process."

	^ self newProcess
		priority: priority;
		resume! !

!BlockClosure methodsFor: '*Text-Core' stamp: 'stephane.ducasse 4/21/2009 11:52'!
asText

	^ self asString asText! !

!BlockClosure methodsFor: 'private' stamp: 'eem 5/28/2008 14:50'!
copyForSaving
	"Answer a copy of the receiver suitable for serialization.
	 Notionally, if the receiver's outerContext has been returned from then nothing
	 needs to be done and we can use the receiver. But there's a race condition
	 determining if the receiver has been returned from (it could be executing in a
	 different process). So answer a copy anyway."
	^self shallowCopy postCopy! !

!BlockClosure methodsFor: 'evaluating' stamp: 'nk 3/11/2001 11:49'!
valueWithEnoughArguments: anArray
	"call me with enough arguments from anArray"
	| args |
	(anArray size == self numArgs)
		ifTrue: [ ^self valueWithArguments: anArray ].

	args := Array new: self numArgs.
	args replaceFrom: 1
		to: (anArray size min: args size)
		with: anArray
		startingAt: 1.

	^ self valueWithArguments: args! !

!BlockClosure methodsFor: '*DebuggerFilters-Extension' stamp: 'AndreiChis 9/30/2013 10:52'!
asFilter
 	^ BlockFilter forBlock: self. ! !

!BlockClosure methodsFor: 'accessing' stamp: 'eem 7/28/2008 13:58'!
home
	^outerContext home! !

!BlockClosure methodsFor: 'evaluating' stamp: 'ClementBera 10/3/2013 10:21'!
valueSupplyingAnswers: aListOfPairs
	"evaluate the block using a list of questions / answers that might be called upon to
	automatically respond to Object>>confirm: or FillInTheBlank requests"

	^ self 
		on: ProvideAnswerNotification
		do: 
			[:notify | | answer caption |
			
			caption := notify messageText withSeparatorsCompacted. "to remove new lines"
			answer := aListOfPairs
				detect: 
					[:each | caption = each first or:
						[(caption includesSubstring: each first caseSensitive: false) or:
						[(each first match: caption) or:
						[(String includesSelector: #matchesRegex:) and: 
						[ [ caption matchesRegex: each first ] on: Error do: [:ignored | false ]]]]]]
					ifNone: [nil].
			answer
				ifNotNil: [notify resume: answer second]
				ifNil: 
					[ | outerAnswer |
					outerAnswer := ProvideAnswerNotification signal: notify messageText.
					outerAnswer 
						ifNil: [notify resume] 
						ifNotNil: [notify resume: outerAnswer]]]! !

!BlockClosure methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 1/23/2015 21:45'!
phlowValue: anObject withEnoughArguments: aCollection

	^ self valueWithEnoughArguments:  aCollection! !

!BlockClosure methodsFor: '*GT-Spotter' stamp: 'StefanReichhart 3/20/2015 11:48'!
hasDynamicItems
	^ self numArgs ~= 0! !

!BlockClosure methodsFor: 'evaluating' stamp: 'MarcusDenker 9/9/2013 14:10'!
durationToRun
	"Answer the duration taken to execute this block."

	^ self timeToRun



! !

!BlockClosure methodsFor: 'controlling' stamp: 'jf 9/3/2003 16:39'!
doWhileTrue: conditionBlock
	"Evaluate the receiver once, then again as long the value of conditionBlock is true."
 
	| result |
	[result := self value.
	conditionBlock value] whileTrue.

	^ result! !

!BlockClosure methodsFor: 'exceptions' stamp: 'HenrikSperreJohansen 6/28/2010 12:12'!
onDNU: selector do: handleBlock
	"Catch MessageNotUnderstood exceptions but only those of the given selector (DNU stands for doesNotUnderstand:)"

	^ self on: MessageNotUnderstood do: [:exception |
		exception message selector = selector
			ifTrue: [handleBlock cull: exception]
			ifFalse: [exception pass]
	  ]! !

!BlockClosure methodsFor: 'scanning' stamp: 'eem 4/26/2012 10:45'!
abstractBytecodeMessagesDo: aBlock
	"Evaluate aBlock with the sequence of abstract bytecodes in the receiver."
	self method
		abstractBytecodeMessagesFrom: startpc
		to: self endPC
		do: aBlock

	"| msgs |
	 msgs := OrderedCollection new.
	 (SortedCollection sortBlock: [:a :b| a compare: b caseSensitive: false]) sortBlock
		abstractBytecodeMessagesDo: [:msg| msgs add: msg selector].
	 msgs"! !

!BlockClosure methodsFor: 'controlling' stamp: 'CamilleTeruel 10/16/2014 17:34'!
whileFalse: aBlock 
	"Ordinarily compiled in-line, and therefore not overridable.
	This is in case the message is sent to other than a literal block.
	Evaluate the argument, aBlock, as long as the value of the receiver is false."

	self value ifFalse: [ aBlock value. self whileFalse: aBlock ]! !

!BlockClosure methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setProject: aString withInMetacelloConfig: aMetacelloConfig

	aMetacelloConfig setProject: aString withBlock: self! !

!BlockClosure methodsFor: '*Jobs' stamp: 'SeanDeNigris 8/29/2012 13:41'!
asJob

	^ Job block: self.! !

!BlockClosure methodsFor: 'evaluating' stamp: 'HenrikSperreJohansen 8/2/2010 04:40'!
value: firstArg value: secondArg
	"Activate the receiver, creating a closure activation (MethodContext)
	 whose closure is the receiver and whose caller is the sender of this message.
	 Supply the arguments and copied values to the activation as its arguments and copied temps.
	 Primitive. Optional (but you're going to want this for performance)."
	| newContext ncv |
	<primitive: 203>
	numArgs ~= 2 ifTrue:
		[self numArgsError: 2].
	^self primitiveFailed! !

!BlockClosure methodsFor: 'evaluating' stamp: 'al 4/3/2009 18:24'!
valueSuppressingMessages: aListOfStrings supplyingAnswers: aListOfPairs

	^ self valueSupplyingAnswers: aListOfPairs, (aListOfStrings collect: [:each | {each. true}])! !

!BlockClosure methodsFor: 'accessing' stamp: 'eem 9/3/2008 14:07'!
numCopiedValues
	"Answer the number of copied values of the receiver.  Since these are
	 stored in the receiver's indexable fields this is the receiver's basic size.
	 Primitive. Answer the number of indexable variables in the receiver. 
	 This value is the same as the largest legal subscript."

	<primitive: 62>
	^self basicSize! !

!BlockClosure methodsFor: '*Glamour-Helpers' stamp: ' 4/5/09 22:18'!
glamourValueWithArgs: anArray 
	"This is the same as valueWithPossibleArgs: from squeak. 
	Unfortunately, VW's cullValue: is incompatible." 
	 
	self numArgs = 0 ifTrue: [^self value]. 
	self numArgs = anArray size ifTrue: [^self valueWithArguments: anArray]. 
	self numArgs > anArray size 
		ifTrue: 
			[^self 
				valueWithArguments: anArray , (Array new: self numArgs - anArray size)]. 
	^self 
		valueWithArguments: 
			(anArray 
				copyFrom: 1 
				to: self numArgs)! !

!BlockClosure methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 1/22/2015 21:34'!
phlowValue: anObject value: otherObject

	^ self cull: anObject cull: otherObject! !

!BlockClosure methodsFor: 'error handing' stamp: 'eem 11/26/2008 20:03'!
numArgsError: numArgsForInvocation

	| printNArgs |
	printNArgs := [:n| n printString, ' argument', (n = 1 ifTrue: [''] ifFalse:['s'])]. 
	self error: 
			'This block accepts ', (printNArgs value: numArgs), 
			', but was called with ', (printNArgs value: numArgsForInvocation), '.'! !

!BlockClosure methodsFor: 'evaluating' stamp: 'HenrikSperreJohansen 8/2/2010 04:40'!
value: firstArg value: secondArg value: thirdArg value: fourthArg
	"Activate the receiver, creating a closure activation (MethodContext)
	 whose closure is the receiver and whose caller is the sender of this message.
	 Supply the arguments and copied values to the activation as its arguments and copied temps.
	 Primitive. Optional (but you're going to want this for performance)."
	| newContext ncv |
	<primitive: 205>
	numArgs ~= 4 ifTrue:
		[self numArgsError: 4].
	^self primitiveFailed! !

!BlockClosure methodsFor: 'evaluating' stamp: 'eem 9/3/2008 14:08'!
valueWithArguments: anArray
	"Activate the receiver, creating a closure activation (MethodContext)
	 whose closure is the receiver and whose caller is the sender of this message.
	 Supply the arguments in an anArray and copied values to the activation as its arguments and copied temps.
	 Primitive. Optional (but you're going to want this for performance)."
	| newContext ncv |
	<primitive: 206>
	numArgs ~= anArray size ifTrue:
		[self numArgsError: anArray size].
	newContext := self asContextWithSender: thisContext sender.
	ncv := self numCopiedValues.
	newContext stackp: ncv + numArgs.
	1 to: numArgs do:
		[:i| newContext at: i put: (anArray at: i)].
	1 to: ncv do:
		[:i| newContext at: i + numArgs put: (self at: i)].
	thisContext privSender: newContext! !

!BlockClosure methodsFor: 'evaluating' stamp: 'BenjaminVanRyseghem 9/9/2013 11:07'!
timeToRun
	"Answer the number of milliseconds taken to execute this block."

	^ Duration milliSeconds: (Time millisecondsToRun: self)! !

!BlockClosure methodsFor: 'accessing' stamp: 'ClementBera 12/29/2014 11:43'!
numLocalTemps
	"Answer the number of local temporaries for the receiver"
	^ self method encoderClass numLocalTempsForBlockAt: startpc in: outerContext method! !

!BlockClosure methodsFor: '*Fuel' stamp: 'MartinDias 3/26/2012 19:21'!
cleanCopy
	"Answer a copy of myself preserving in outerContext just the receiver and method, which are the only needed by a clean block closure."

	^ self shallowCopy
		cleanOuterContext;
		yourself! !

!BlockClosure methodsFor: 'private' stamp: 'ClementBera 5/27/2014 13:49'!
asContextWithSender: aContext
	"Inner private support method for evaluation.  Do not use unless you know what you're doing."

	^(Context newForMethod: outerContext method)
		setSender: aContext
		receiver: outerContext receiver
		method: outerContext method
		closure: self
		startpc: startpc;
		privRefresh! !

!BlockClosure methodsFor: 'scanning' stamp: 'eem 4/26/2012 11:02'!
blockCreationBytecodeMessage
	"Answer the abstract bytecode message that created the receiver."
	| blockCreationBytecodeSize |
	^self method abstractBytecodeMessageAt: startpc - (blockCreationBytecodeSize := 4)

	"(SortedCollection sortBlock: [:a :b| a compare: b caseSensitive: false]) sortBlock blockCreationBytecodeMessage"! !

!BlockClosure methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 1/23/2015 21:43'!
phlowValue: anObject

	^ self cull: anObject! !

!BlockClosure methodsFor: 'evaluating' stamp: 'jrp 10/10/2004 22:28'!
valueSuppressingAllMessages

	^ self valueSuppressingMessages: #('*')! !

!BlockClosure methodsFor: 'scheduling' stamp: 'marcus.denker 6/10/2009 20:28'!
newProcessWith: anArray 
	"Answer a Process running the code in the receiver. The receiver's block 
	arguments are bound to the contents of the argument, anArray. The 
	process is not scheduled."
	<primitive: 19> "Simulation guard"
	^Process
		forContext: 
			[self valueWithArguments: anArray.
			Processor terminateActive] asContext
		priority: Processor activePriority! !

!BlockClosure methodsFor: 'controlling' stamp: 'CamilleTeruel 10/16/2014 17:45'!
whileTrue
	"Ordinarily compiled in-line, and therefore not overridable.
	This is in case the message is sent to other than a literal block.
	Evaluate the receiver, as long as its value is true."
 
	self value ifTrue: [ self whileTrue ]! !

!BlockClosure methodsFor: 'evaluating' stamp: 'eem 5/25/2008 14:47'!
valueWithPossibleArgument: anArg 
	"Evaluate the block represented by the receiver. 
	 If the block requires one argument, use anArg, if it requires more than one,
	 fill up the rest with nils."

	| a |
	numArgs = 0 ifTrue: [^self value].
	numArgs = 1 ifTrue: [^self value: anArg].
	a := Array new: numArgs.
	a at: 1 put: anArg.
	^self valueWithArguments: a! !

!BlockClosure methodsFor: 'scheduling' stamp: 'ajh 7/15/2001 16:03'!
fork
	"Create and schedule a Process running the code in the receiver."

	^ self newProcess resume! !

!BlockClosure methodsFor: 'exceptions' stamp: 'MarcusDenker 7/23/2014 22:30'!
assertWithDescription: aStringOrABlock
	| value |
	self value
		ifTrue: [ ^ self ].
	value := aStringOrABlock value.
	AssertionFailure signal: value! !

!BlockClosure methodsFor: 'printing' stamp: 'MarcusDenker 5/27/2013 16:43'!
printOn: aStream
	OpalCompiler isActive 
		ifTrue: [ aStream nextPutAll:  self sourceNode formattedCode ]
		ifFalse: [ aStream nextPutAll: '[...]']! !

!BlockClosure methodsFor: 'private' stamp: 'eem 5/28/2008 14:56'!
reentrant
	"Answer a version of the recever that can be reentered.
	 Closures are reentrant (unlike BlockContect) so simply answer self."
	^self! !

!BlockClosure methodsFor: 'private' stamp: 'MarcusDenker 9/30/2011 16:27'!
valueUnpreemptively
	"Evaluate the receiver (block), without the possibility of preemption by higher priority processes. Use this facility VERY sparingly!!"
	"Think about using Block>>valueUninterruptably first, and think about using Semaphore>>critical: before that, and think about redesigning your application even before that!! 
	After you've done all that thinking, go right ahead and use it..."
	| activeProcess oldPriority result semaphore |
	activeProcess := Processor activeProcess.
	oldPriority := activeProcess priority.
	activeProcess priority: Processor highestPriority.
	result := self ensure: [activeProcess priority: oldPriority].
	
	"Yield after restoring priority to give the preempted processes a chance to run.
	We inline the code of Processor yield here, but without the primitive.
	The reason: the yield primitive does not take into account a change of priority as done above" 
	semaphore := Semaphore new.
	[semaphore signal] fork.
	semaphore wait.
	^result! !

!BlockClosure methodsFor: 'controlling' stamp: 'CamilleTeruel 10/16/2014 17:45'!
whileFalse
	"Ordinarily compiled in-line, and therefore not overridable.
	This is in case the message is sent to other than a literal block.
	Evaluate the receiver, as long as its value is false."
 
	self value ifFalse: [ self whileFalse ]! !

!BlockClosure methodsFor: '*OpalCompiler-Core' stamp: 'MarcusDenker 10/22/2014 11:12'!
sourceNode
	"the bytecode just before the first bytecode of the block is a bytecode that creates the complete block"
	^ self method sourceNodeForPC: self startpc - 1.! !

!BlockClosure methodsFor: 'controlling' stamp: 'CamilleTeruel 10/16/2014 17:34'!
whileTrue: aBlock 
	"Ordinarily compiled in-line, and therefore not overridable.
	This is in case the message is sent to other than a literal block.
	Evaluate the argument, aBlock, as long as the value of the receiver is true."

	self value ifTrue: [ aBlock value. self whileTrue: aBlock ]! !

!BlockClosure methodsFor: 'accessing' stamp: 'stephane.ducasse 5/20/2009 21:19'!
argumentCount
	"Answer the number of arguments that must be used to evaluate this block"

	^numArgs
	
! !

!BlockClosure methodsFor: 'scheduling' stamp: 'svp 6/23/2003 10:59'!
forkNamed: aString

	"Create and schedule a Process running the code in the receiver and

	having the given name."



	^ self newProcess name: aString; resume! !

!BlockClosure methodsFor: 'scheduling' stamp: 'ajh 2/10/2003 14:25'!
newProcess
	"Answer a Process running the code in the receiver. The process is not 
	scheduled."
	<primitive: 19> "Simulation guard"
	^Process
		forContext: 
			[self value.
			Processor terminateActive] asContext
		priority: Processor activePriority! !

!BlockClosure methodsFor: 'evaluating' stamp: 'SvenVanCaekenberghe 2/25/2015 12:47'!
benchFor: duration
	"Run me for duration and return a BenchmarkResult"
	
	"[ 100 factorial ] benchFor: 2 seconds"
	
	| count run started |
	count := 0.
	run := true.
	[ duration wait. run := false ] forkAt: Processor timingPriority - 1.
	started := Time millisecondClockValue.
	[ run ] whileTrue: [ self value. count := count + 1 ].
	^ BenchmarkResult new 
		iterations: count; 
		elapsedTime: (Time millisecondsSince: started) milliSeconds; 
		yourself! !

!BlockClosure methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setDescriptionInMetacelloConfig: aMetacelloConfig

	aMetacelloConfig setDescriptionWithBlock: self! !

!BlockClosure methodsFor: 'evaluating' stamp: 'ClementBera 4/30/2013 13:45'!
valueWithInterval: aDelay
	"Executes the block every x milliseconds specified in arguments. Answers the process, so you can terminate it"
	
	^ [ [ self value. aDelay wait. ] repeat ] 
		forkAt: Processor userBackgroundPriority 
		named: (String streamContents: [ :s |
				s 
					<< 'every ';
					print: aDelay;
					<<' do: ';
					print: self ] )! !

!BlockClosure methodsFor: 'exceptions' stamp: 'MartinMcClureWithAndresValloud 8/17/2014 07:39'!
on: exception do: handlerAction
	"Evaluate the receiver in the scope of an exception handler.
	The following primitive is just a marker used to find the error handling context. 
	See MethodContext>>#isHandlerOrSignalingContext. "
	<primitive: 199>  
	^ self value! !

!BlockClosure methodsFor: 'evaluating' stamp: 'HenrikSperreJohansen 2/18/2010 14:36'!
cull: firstArg cull: secondArg cull: thirdArg
	^numArgs < 3 
		ifTrue: [self cull: firstArg cull: secondArg]
		ifFalse: [self value: firstArg value: secondArg value: thirdArg]
	! !

!BlockClosure methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setPackage: aString withInMetacelloConfig: aMetacelloConfig

	aMetacelloConfig setPackage: aString withBlock: self! !

!BlockClosure methodsFor: 'accessing' stamp: 'eem 6/26/2008 09:17'!
receiver
	^outerContext receiver! !

!BlockClosure methodsFor: 'accessing' stamp: 'eem 9/3/2008 13:57'!
copiedValueAt: i
	<primitive: 60>
	^self basicAt: i! !

!BlockClosure methodsFor: '*Tool-Profilers' stamp: 'BernardoContreras 8/15/2011 20:25'!
timeProfile
	^Smalltalk tools timeProfiler onBlock: self! !

!BlockClosure methodsFor: '*FuelTests' stamp: 'MarianoMartinezPeck 4/20/2012 21:16'!
assertWellMaterializedInto: aBlockClosure in: aTestCase
	
	aTestCase assert: self ~~ aBlockClosure. 
	aTestCase assert: (self class == aBlockClosure class).
	aTestCase assert: numArgs = aBlockClosure numArgs.
	aTestCase assert: startpc = aBlockClosure startpc.
	
	outerContext isNil
        ifTrue: [ self assert: aBlockClosure outerContext isNil ]
        ifFalse: [
            self isClean
                ifTrue: [    
                    "self assert: self receiver = aBlockClosure receiver."
                    self assert: (self method isEqualRegardlessTrailerTo: aBlockClosure method).
                    self assert: aBlockClosure outerContext sender isNil.
                    self assert: aBlockClosure outerContext arguments isEmpty.
                      ]
                ifFalse: [outerContext assertWellMaterializedInto: aBlockClosure outerContext in: aTestCase]
             ]
! !

!BlockClosure methodsFor: 'exceptions' stamp: 'StephaneDucasse 8/17/2011 22:39'!
on: exception fork: handlerAction
	"Activate the receiver. In case of exception, fork a new process, which will handle an error.
	An original process will continue running as if receiver evaluation finished and answered nil,
	i.e., an expression like:
	
	[ self error: 'some error'] on: Error fork: [:ex |  123 ] 
	
	will always answer nil for original process, not 123.

	The context stack , starting from context which sent this message to receiver and
	up to the top of the stack will be transferred to forked process, with handlerAction on top.
	(so when the forked process will be resuming, it will enter the handlerAction)
	 "
		
	^ self on: exception do: [:ex |
		| copy onDoCtx process handler bottom thisCtx |
		
		onDoCtx := thisContext.
		thisCtx := onDoCtx home.

		"find the context on stack for which this method's is sender"

		[ onDoCtx sender == thisCtx] whileFalse: [ 
			onDoCtx := onDoCtx sender.
			onDoCtx ifNil: [ 
				"Can't find our home context. seems like we're already forked
				and handling another exception in new thread. In this case, just pass it through handler."
				^ handlerAction cull: ex ]
		 ].

		bottom := [ Processor terminateActive ] asContext.
		onDoCtx privSender: bottom.

		handler := [ handlerAction cull: ex ] asContext.
		handler privSender: thisContext sender.

		(Process forContext: handler priority: Processor activePriority) resume.

		"cut the stack of current process"
		thisContext privSender: thisCtx.
		nil
	]
! !

!BlockClosure methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setConfiguration: aString withInMetacelloConfig: aMetacelloConfig
    aMetacelloConfig setConfiguration: aString withBlock: self! !

!BlockClosure methodsFor: 'evaluating' stamp: 'al 4/3/2009 18:22'!
valueAt: blockPriority 
	"Evaluate the receiver (block), with another priority as the actual one 
	and restore it afterwards. The caller should be careful with using 
	higher priorities."
	| activeProcess result outsidePriority |
	activeProcess := Processor activeProcess.
	outsidePriority := activeProcess priority.
	activeProcess priority: blockPriority.
	result := self ensure: [activeProcess priority: outsidePriority].
	"Yield after restoring lower priority to give the preempted processes a  
	chance to run."
	blockPriority > outsidePriority
		ifTrue: [Processor yield].
	^ result! !

!BlockClosure methodsFor: 'evaluating' stamp: 'al 4/3/2009 18:24'!
valueSuppressingMessages: aListOfStrings

	^ self
		valueSuppressingMessages: aListOfStrings
		supplyingAnswers: #()! !

!BlockClosure methodsFor: 'initialize-release' stamp: 'eem 9/3/2008 14:08'!
outerContext: aContext startpc: aStartpc numArgs: argCount copiedValues: anArrayOrNil
	outerContext := aContext.
	startpc := aStartpc.
	numArgs := argCount.
	1 to: self numCopiedValues do:
		[:i|
		self at: i put: (anArrayOrNil at: i)]! !

!BlockClosure methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setBaseline: aString withInMetacelloConfig: aMetacelloConfig
    aMetacelloConfig setBaseline: aString withBlock: self! !

!BlockClosure methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 1/20/2015 17:25'!
brickValue: aBrick

	^ self cull: aBrick! !

!BlockClosure methodsFor: 'evaluating' stamp: 'SvenVanCaekenberghe 2/25/2015 12:47'!
bench
	"Return how many times the receiver can get executed in 5 seconds. 
	Answer a string with meaningful description.
	See #benchFor: which returns a BenchmarkResult"
	
	"[3.14 printString] bench"
	
	| benchmarkResult |
	benchmarkResult := self benchFor: 5 seconds.
	^ benchmarkResult shortPrintString ! !

!BlockClosure methodsFor: 'exceptions' stamp: 'ajh 7/26/2002 11:49'!
valueUninterruptably
	"Prevent remote returns from escaping the sender.  Even attempts to terminate (unwind) this process will be halted and the process will resume here.  A terminate message is needed for every one of these in the sender chain to get the entire process unwound."

	^ self ifCurtailed: [^ self]! !

!BlockClosure methodsFor: 'scheduling' stamp: 'eem 5/28/2008 16:16'!
asContext
	"Create a MethodContext that is ready to execute self.  Assumes self takes no args (if it does the args will be nil)"

	^self asContextWithSender: nil! !

!BlockClosure methodsFor: 'accessing' stamp: 'eem 4/26/2012 10:20'!
endPC
	^self blockCreationBytecodeMessage arguments last + startpc - 1! !

!BlockClosure methodsFor: '*GT-Spotter' stamp: 'StefanReichhart 3/20/2015 16:18'!
gtIterator
	" 1:filter 2:context[optional] "
	self assert: (self numArgs between: 1 and: 2). 
	
	^ GTSpotterBlockIterator new 
		onDo: self;
		yourself! !

!BlockClosure methodsFor: 'controlling' stamp: 'ls 9/24/1999 09:45'!
repeatWithGCIf: testBlock
	| ans |
	"run the receiver, and if testBlock returns true, garbage collect and run the receiver again"
	ans := self value.
	(testBlock value: ans) ifTrue: [ Smalltalk garbageCollect. ans := self value ].
	^ans! !

!BlockClosure methodsFor: 'evaluating' stamp: 'HenrikSperreJohansen 8/2/2010 04:39'!
value
	"Activate the receiver, creating a closure activation (MethodContext)
	 whose closure is the receiver and whose caller is the sender of this message.
	 Supply the copied values to the activation as its arguments and copied temps.
	 Primitive. Optional (but you're going to want this for performance)."
	| newContext ncv |
	<primitive: 201>
	numArgs ~= 0 ifTrue:
		[self numArgsError: 0].
	^self primitiveFailed! !

!BlockClosure methodsFor: 'evaluating' stamp: 'HenrikSperreJohansen 8/2/2010 04:39'!
value: anArg
	"Activate the receiver, creating a closure activation (MethodContext)
	 whose closure is the receiver and whose caller is the sender of this message.
	 Supply the argument and copied values to the activation as its arguments and copied temps.
	 Primitive. Optional (but you're going to want this for performance)."
	| newContext ncv |
	<primitive: 202>
	numArgs ~= 1 ifTrue:
		[self numArgsError: 1].
	self primitiveFailed! !

!BlockClosure methodsFor: 'scheduling' stamp: 'svp 6/23/2003 10:59'!
forkAt: priority named: name

	"Create and schedule a Process running the code in the receiver at the

	given priority and having the given name. Answer the newly created 

	process."



	| forkedProcess |

	forkedProcess := self newProcess.

	forkedProcess priority: priority.

	forkedProcess name: name.

	^ forkedProcess resume! !

!BlockClosure methodsFor: 'evaluating' stamp: 'eem 8/22/2008 14:21'!
valueNoContextSwitch
	"An exact copy of BlockClosure>>value except that this version will not preempt
	 the current process on block activation if a higher-priority process is runnable.
	 Primitive. Essential."
	<primitive: 221>
	numArgs ~= 0 ifTrue:
		[self numArgsError: 0].
	self primitiveFailed! !

!BlockClosure methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
valueSupplyingMetacelloAnswers: aListOfPairs
	"evaluate the block using a list of questions / answers that might be called upon to
	automatically respond to Object>>confirm: or FillInTheBlank requests"

	^ [self value] 
		on: ProvideAnswerNotification
		do: 
			[:notify | | answer caption |
			
			caption := notify messageText withSeparatorsCompacted. "to remove new lines"
			answer := aListOfPairs
				detect: 
					[:each | caption = each first or:
						[(caption includesSubstring: each first caseSensitive: false) or:
						[(each first match: caption) or:
						[(String includesSelector: #matchesRegex:) and: 
						[ [ caption matchesRegex: each first ] on: Error do: [:ignored | false ]]]]]]
					ifNone: [nil].
			answer
				ifNotNil: [notify resume: answer second]
				ifNil: 
					[ | outerAnswer |
					outerAnswer := ProvideAnswerNotification signal: notify messageText.
					outerAnswer 
						ifNil: [notify resume] 
						ifNotNil: [notify resume: outerAnswer]]]! !

!BlockClosure methodsFor: 'evaluating' stamp: 'eem 8/22/2008 14:21'!
valueNoContextSwitch: anArg
	"An exact copy of BlockClosure>>value: except that this version will not preempt
	 the current process on block activation if a higher-priority process is runnable.
	 Primitive. Essential."
	<primitive: 222>
	numArgs ~= 1 ifTrue:
		[self numArgsError: 1].
	self primitiveFailed! !

!BlockClosure methodsFor: 'testing' stamp: 'eem 11/26/2008 20:27'!
isDead
	"Has self finished"
	^false! !

!BlockClosure methodsFor: '*System-Caching' stamp: 'BenComan 11/13/2014 00:55'!
memoized
	"Returns a memoized version of a one argument block (so values that were
	  already calculated will not be computed a second time but returned from a cache)."
	
	^ self memoizedUsing:  Dictionary new.! !

!BlockClosure methodsFor: 'debugger access' stamp: 'nice 4/14/2009 19:09'!
sender
	"Answer the context that sent the message that created the receiver."

	^outerContext sender! !

!BlockClosure methodsFor: '*Tool-Profilers' stamp: 'MarcusDenker 2/16/2015 16:20'!
timeToRunWithoutGC
	"Answer the number of milliseconds taken to execute this block without GC time."
 
	^ Smalltalk vm totalGCTime + self timeToRun asMilliSeconds -  Smalltalk vm totalGCTime
! !

!BlockClosure methodsFor: 'controlling' stamp: 'jf 9/3/2003 16:45'!
doWhileFalse: conditionBlock
	"Evaluate the receiver once, then again as long the value of conditionBlock is false."
 
	| result |
	[result := self value.
	conditionBlock value] whileFalse.

	^ result! !

!BlockClosure methodsFor: 'evaluating' stamp: 'HenrikSperreJohansen 2/18/2010 14:35'!
cull: anArg
	^numArgs = 0 
		ifTrue: [self value]
		ifFalse: [self value: anArg]
	! !

!BlockClosure methodsFor: '*GT-Spotter' stamp: 'StefanReichhart 2/24/2015 14:21'!
gtFilter
	^ self ! !

!BlockClosure methodsFor: 'controlling' stamp: 'sma 5/12/2000 13:22'!
repeat
	"Evaluate the receiver repeatedly, ending only if the block explicitly returns."

	[self value. true] whileTrue! !

!BlockClosure methodsFor: 'evaluating' stamp: 'SeanDeNigris 1/22/2013 12:58'!
valueWithin: aDuration onTimeout: timeoutBlock
	"Evaluate the receiver.
	If the evaluation does not complete in less than aDuration evaluate the timeoutBlock instead"

	| theProcess delay watchdog tag |

	aDuration <= Duration zero ifTrue: [^ timeoutBlock value ].

	"the block will be executed in the current process"
	theProcess := Processor activeProcess.
	delay := aDuration asDelay.
	tag := self.

	"make a watchdog process"
	watchdog := [
		delay wait. 	"wait for timeout or completion"
		theProcess ifNotNil:[ theProcess signalException: (TimedOut new tag: tag)] 
	] newProcess.

	"Watchdog needs to run at high priority to do its job (but not at timing priority)"
	watchdog priority: Processor timingPriority-1.

	"catch the timeout signal"
	^ [	watchdog resume.				"start up the watchdog"
		self ensure:[						"evaluate the receiver"
			theProcess := nil.				"it has completed, so ..."
			delay delaySemaphore signal.	"arrange for the watchdog to exit"
		]] on: TimedOut do: [ :e | 
			e tag == tag 
				ifTrue:[ timeoutBlock value ]
				ifFalse:[ e pass]].! !

!BlockClosure methodsFor: 'testing' stamp: 'eem 5/23/2008 13:48'!
isClosure
	^true! !

!BlockClosure methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 2/17/2015 13:02'!
brickValue: anObject withEnoughArguments: aCollection

	^ self valueWithEnoughArguments:  { anObject }, aCollection! !

!BlockClosure methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setAuthorInMetacelloConfig: aMetacelloConfig

	aMetacelloConfig setAuthorWithBlock: self! !

!BlockClosure methodsFor: 'exceptions' stamp: 'jannik.laval 5/2/2010 06:40'!
assert

	self value ifFalse: [AssertionFailure signal: 'Assertion failed']
! !

!BlockClosure methodsFor: 'evaluating' stamp: 'al 4/3/2009 18:23'!
valueSupplyingAnswer: anObject
	^ (anObject isCollection and: [anObject isString not])
		ifTrue: [self valueSupplyingAnswers: {anObject}]
		ifFalse: [self valueSupplyingAnswers: {{'*'. anObject}}]! !

!BlockClosure methodsFor: 'evaluating' stamp: 'HenrikSperreJohansen 8/2/2010 04:40'!
value: firstArg value: secondArg value: thirdArg
	"Activate the receiver, creating a closure activation (MethodContext)
	 whose closure is the receiver and whose caller is the sender of this message.
	 Supply the arguments and copied values to the activation as its arguments and copied temps.
	 Primitive. Optional (but you're going to want this for performance)."
	| newContext ncv |
	<primitive: 204>
	numArgs ~= 3 ifTrue:
		[self numArgsError: 3].
	^self primitiveFailed! !

!BlockClosure methodsFor: 'evaluating' stamp: 'md 3/28/2006 20:17'!
valueWithExit 
	  self value: [ ^nil ]! !

!BlockClosure methodsFor: '*Fuel' stamp: 'MarianoMartinezPeck 9/24/2013 14:48'!
shouldBeSubstitutedByCleanCopy
	^ self isClean ! !

!BlockClosure methodsFor: '*Fuel' stamp: 'MarianoMartinezPeck 9/24/2013 14:49'!
fuelAccept: aGeneralMapper

	^ self shouldBeSubstitutedByCleanCopy
		"The 'onRecursionDo:' is just to avoid an infinitive loop for the substitution. The cleanCopy MUST be a clean copy so it can be serialized normally"
		ifTrue: [ aGeneralMapper visitSubstitution: self by: self cleanCopy onRecursionDo: [ aGeneralMapper visitVariableObject: self ]  ]
		ifFalse: [ aGeneralMapper visitVariableObject: self ]! !

!BlockClosure methodsFor: 'exceptions' stamp: 'ar 12/4/2009 18:30'!
ensure: aBlock
	"Evaluate a termination block after evaluating the receiver, regardless of
	 whether the receiver's evaluation completes.  N.B.  This method is *not*
	 implemented as a primitive.  Primitive 198 always fails.  The VM uses prim
	 198 in a context's method as the mark for an ensure:/ifCurtailed: activation."

	| complete returnValue |
	<primitive: 198>
	returnValue := self valueNoContextSwitch.
	complete ifNil:[
		complete := true.
		aBlock value.
	].
	^ returnValue! !

!BlockClosure methodsFor: 'testing' stamp: 'eem 4/26/2012 10:42'!
isClean
	"Answer if the receiver does not close-over any variables other than globals, and does
	 not ^-return (does not close over the home context).  Clean blocks are amenable to
	 being created at compile-time."
	self numCopiedValues > 0 ifTrue:
		[^false].
	self abstractBytecodeMessagesDo:
		[:msg|
		(#(	pushReceiver
			pushReceiverVariable: popIntoReceiverVariable: storeIntoReceiverVariable:
			methodReturnConstant: methodReturnReceiver methodReturnTop)
				includes: msg selector) ifTrue:
					[^false]].
	^true

	"clean:"
		"[] isClean"
		"[:a :b| a < b] isClean"
	"unclean"
		"[^nil] isClean"
		"[self class] isClean"
		"| v | v := 0.
		 [v class] isClean"! !

!BlockClosure methodsFor: 'accessing' stamp: 'eem 5/24/2008 11:21'!
outerContext
	^outerContext! !

!BlockClosure methodsFor: 'scheduling' stamp: 'ajh 10/16/2002 11:14'!
forkAndWait
	"Suspend current process and execute self in new process, when it completes resume current process"

	| semaphore |
	semaphore := Semaphore new.
	[self ensure: [semaphore signal]] fork.
	semaphore wait.
! !

!BlockClosure methodsFor: 'private' stamp: 'sd 3/22/2009 19:33'!
isValid
	"Answer the receiver."

	^true! !

!BlockClosure methodsFor: 'evaluating' stamp: 'StephaneDucasse 8/17/2011 22:24'!
cull: firstArg cull: secondArg cull: thirdArg cull: fourthArg
	"Execute the receiver with four or less arguments. Check cull:cull: for examples"
	
	^numArgs < 4 
		ifTrue: [self cull: firstArg cull: secondArg cull: thirdArg]
		ifFalse: [self value: firstArg value: secondArg value: thirdArg value: fourthArg]
	! !

!BlockClosure methodsFor: 'exceptions' stamp: 'ar 12/4/2009 18:41'!
ifCurtailed: aBlock
	"Evaluate the receiver with an abnormal termination action.
	 Evaluate aBlock only if execution is unwound during execution
	 of the receiver.  If execution of the receiver finishes normally do
	 not evaluate aBlock.  N.B.  This method is *not* implemented as a
	 primitive.  Primitive 198 always fails.  The VM uses prim 198 in a
	 context's method as the mark for an ensure:/ifCurtailed: activation."
	| complete result |
	<primitive: 198>
	result := self valueNoContextSwitch.
	complete := true.
	^result! !

!BlockClosure methodsFor: 'evaluating' stamp: 'HenrikSperreJohansen 2/18/2010 14:36'!
cull: firstArg cull: secondArg
	^numArgs < 2 
		ifTrue: [self cull: firstArg]
		ifFalse: [self value: firstArg value: secondArg]
	! !

!BlockClosure methodsFor: 'controlling' stamp: 'jcg 7/8/2007 18:25'!
whileNil: aBlock 
	"Unlike #whileTrue/False: this is not compiled inline."
	^ [self value isNil] whileTrue: [aBlock value]
	! !

!BlockClosure methodsFor: 'accessing' stamp: 'eem 6/1/2008 09:39'!
startpc
	^startpc! !

!BlockClosure methodsFor: 'controlling' stamp: 'jcg 7/8/2007 18:25'!
whileNotNil: aBlock 
	"Unlike #whileTrue/False: this is not compiled inline."
	^ [self value notNil] whileTrue: [aBlock value]
	! !

!BlockClosure methodsFor: 'accessing' stamp: 'eem 5/29/2008 12:18'!
method
	^outerContext method! !

!BlockClosure methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 7/23/2014 15:32'!
gtInspectorSourceCodeIn: composite 
	<gtInspectorPresentationOrder: 40>
	self sourceNode gtInspectorSourceCodeIn: composite! !

!BlockClosure methodsFor: '*system-announcements' stamp: 'EstebanLorenzano 8/8/2012 11:20'!
valueWithoutNotifications 
	^SystemAnnouncer uniqueInstance suspendAllWhile: self! !

!BlockClosure methodsFor: 'private' stamp: 'sd 3/22/2009 19:33'!
asMinimalRepresentation
	"Answer the receiver."

	^self! !

!BlockClosure methodsFor: '*Reflectivity-Contexts' stamp: 'ClaraAllende 7/24/2014 16:11'!
ctxtEnsure: aBlock
	"Evaluate a termination block after evaluating the receiver, regardless of whether the receiver's evaluation completes."

	| returnValue b |
	<primitive: 198>

	returnValue := self value.
	aBlock == nil ifFalse: [
		"nil out aBlock temp before evaluating aBlock so it is not executed again if aBlock remote returns"
		b := aBlock.
		thisContext tempAt: 1 put: nil.  
		b value.
	].
	^ returnValue! !

!BlockClosure methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setTimestampInMetacelloConfig: aMetacelloConfig

	aMetacelloConfig setTimestampWithBlock: self! !

!BlockClosure methodsFor: 'evaluating' stamp: 'eem 5/28/2008 15:03'!
valueWithPossibleArgs: anArray 

	^numArgs = 0
		ifTrue: [self value]
		ifFalse:
			[self valueWithArguments:
				(numArgs = anArray size
					ifTrue: [anArray]
					ifFalse:
						[numArgs > anArray size
							ifTrue: [anArray, (Array new: numArgs - anArray size)]
							ifFalse: [anArray copyFrom: 1 to: numArgs]])]! !

!BlockClosure methodsFor: '*Collections-Abstract-splitjoin' stamp: 'CamilloBruni 1/19/2013 12:40'!
split: aSequenceableCollection indicesDo: aBlock
	"Example:
		[ :char| char isSeparator ] split: 'aa bb cc dd'"
	
	| position |
	
	position := 1.
	
	aSequenceableCollection withIndexDo: [:element :idx |
		(self value: element) 
			ifTrue: [
				aBlock value: position value: idx - 1.
				position := idx + 1 ]].
		
	aBlock value: position value: aSequenceableCollection size! !

!BlockClosure methodsFor: 'accessing' stamp: 'eem 5/28/2008 16:02'!
numArgs
	"Answer the number of arguments that must be used to evaluate this block"

	^numArgs! !

!BlockClosure methodsFor: '*Fuel' stamp: 'MartinDias 3/26/2012 19:22'!
cleanOuterContext
	"Clean my outerContext preserving just the receiver and method, which are the only needed by a clean block closure."

	outerContext := outerContext cleanCopy! !

!BlockClosure methodsFor: 'accessing' stamp: 'CamilleTeruel 2/14/2014 14:52'!
numTemps
	"Answer the number of temporaries for the receiver; this includes
	 the number of arguments and the number of copied values."
	^self numCopiedValues
	 + self numArgs
	 + self numLocalTemps! !

!BlockClosure methodsFor: '*FuelTests' stamp: 'MarianoMartinezPeck 8/19/2012 15:46'!
fuelValueWithoutNotifications
	SystemAnnouncer uniqueInstance suspendAllWhile: self! !

!BlockClosure methodsFor: 'evaluating' stamp: 'ClementBera 4/30/2013 13:46'!
valueAfterWaiting: aDelay
	"Waits for a delay, then executes the block. Answers the process so you can terminate it"
	
	^ [ aDelay wait. self value ] 
		forkAt: Processor userBackgroundPriority
		named: (String streamContents: [ :s |
				s 
					<< 'After ';
					print: aDelay;
					<<' do: ';
					print: self ] )! !

!BlockClosure methodsFor: 'evaluating' stamp: 'ClementBera 5/27/2014 13:49'!
simulateValueWithArguments: anArray caller: aContext
	| newContext sz |
	(anArray class ~~ Array
	 or: [numArgs ~= anArray size]) ifTrue:
		[^Context primitiveFailToken].
	newContext := (Context newForMethod: outerContext method)
						setSender: aContext
						receiver: outerContext receiver
						method: outerContext method
						closure: self
						startpc: startpc.
	sz := self basicSize.
	newContext stackp: sz + numArgs.
	1 to: numArgs do:
		[:i| newContext at: i put: (anArray at: i)].
	1 to: sz do:
		[:i| newContext at: i + numArgs put: (self at: i)].
	^newContext! !

!BlockClosure methodsFor: 'accessing' stamp: 'MarcusDenker 10/12/2013 08:46'!
argumentNames
	^ self sourceNode arguments collect: [ :each | each name ]
! !

!BlockClosure methodsFor: '*System-Caching' stamp: 'TorstenBergmann 11/11/2014 18:06'!
memoizedUsing: cache
	"Provide a memoization block using the given cache. So one can tune by
     passing a LRUCache for instance"
  
    ^[ :x | cache at: x ifAbsentPut: [ self value: x ] ]
! !

!BlockClosure methodsFor: '*metacello-core-scripting' stamp: 'dkh 7/16/2012 10:51'!
execute: projectSpecBlock against: aScriptExecutor
    aScriptExecutor executeBlock: self do: projectSpecBlock! !

!BlockClosure class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 3/26/2015 00:09'!
gtExampleEmpty
	<gtExample: 'Empty'>
	^ [  ]! !

!BlockClosure class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 3/26/2015 00:09'!
gtExampleTwoArguments
	<gtExample: 'With two arguments'>
	^ [ :x :y | x + y ]! !

!BlockClosure class methodsFor: 'instance creation' stamp: 'eem 9/3/2008 14:02'!
outerContext: aContext startpc: aStartpc numArgs: argCount copiedValues: anArrayOrNil
	^(self new: anArrayOrNil basicSize)
		outerContext: aContext
		startpc: aStartpc
		numArgs: argCount
		copiedValues: anArrayOrNil! !

!BlockClosure class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 3/26/2015 00:09'!
gtExampleOneArgument
	<gtExample: 'With one argument'>
	^ [ :x | x ]! !

!BlockClosureTest commentStamp: 'TorstenBergmann 2/5/2014 08:31'!
SUnit tests for BlockClosure!
!BlockClosureTest methodsFor: 'tests' stamp: 'MarcusDenker 2/24/2010 12:28'!
testSupplyAnswerUsingOnlySubstringOfQuestion

	self should: [false = ([self confirm: 'You like Smalltalk?'] 
		valueSupplyingAnswer: #('like' false))]! !

!BlockClosureTest methodsFor: 'tests' stamp: 'MarcusDenker 2/24/2010 12:28'!
testSupplyAnswerUsingRegexMatchOfQuestion

	(String includesSelector: #matchesRegex:) ifFalse: [^ self].
	
	self should: [true = ([self confirm: 'You like Smalltalk?'] 
		valueSupplyingAnswer: #('.*Smalltalk\?' true))]! !

!BlockClosureTest methodsFor: 'tests - on-fork' stamp: 'SvenVanCaekenberghe 3/1/2014 13:29'!
testOnForkSplit
	"Test that when forking, the stack are split correctly (there is no any contexts referenced by both processes)"
	
	| sema timeout forkedContexts myContexts c |
	
	self flag: 'This test is too brittle, failing often on CI'; skip.
		
	sema := Semaphore new.
	
	[ 1/0 ] on: Exception fork: [  | ctx |
		forkedContexts := IdentitySet new.
		ctx := thisContext.
		[ ctx notNil ] whileTrue: [ forkedContexts add: ctx. ctx := ctx sender ].
		sema signal ].
	
	timeout := (sema waitTimeoutSeconds: 1).
	self assert: timeout == false description: 'fork lasted more than one second'.

	myContexts := IdentitySet new.
	c := thisContext.
	[ c notNil ] whileTrue: [ myContexts add: c. c := c sender ].

	self assert: (myContexts noneSatisfy: [:b | forkedContexts includes: b ]) description: 'myContexts are not within forkedContexts'.
	self assert: (forkedContexts noneSatisfy: [:b | myContexts includes: b ]) description: 'forkedContexts are not within myContexts'.! !

!BlockClosureTest methodsFor: 'tests - on-fork' stamp: 'GuillermoPolito 5/28/2011 14:35'!
testOnForkErrorOnSeparateProcess
	"Test that if code runs with error, there is fork"
	
	| result forkedProc sema |
	
	sema := Semaphore new.	
	result := [ 1/0 ] on: Exception fork: [ forkedProc := Processor activeProcess. sema signal ].

	sema wait.
	self assert: (forkedProc ~~ Processor activeProcess).! !

!BlockClosureTest methodsFor: 'tests - evaluating' stamp: 'CamilloBruni 8/31/2013 20:23'!
testCullCullCull
	[  ] cull: 1 cull: 2 cull: 3.
	[ :x |  ] cull: 1 cull: 2 cull: 3.
	[ :x :y |  ] cull: 1 cull: 2 cull: 3.
	[ :x :y :z |  ] cull: 1 cull: 2 cull: 3.
	self should: [ [ :x :y :z :a |  ] cull: 1 cull: 2 cull: 3 ] raise: Error.
	self should: [ [ :x :y :z :a :b |  ] cull: 1 cull: 2 cull: 3 ] raise: Error.
	self assert: ([ 0 ] cull: 1 cull: 2 cull: 3) = 0.
	self assert: ([ :x | x ] cull: 1 cull: 2 cull: 3) = 1.
	self assert: ([ :x :y | y ] cull: 1 cull: 2 cull: 3) = 2.
	self assert: ([ :x :y :z | z ] cull: 1 cull: 2 cull: 3) = 3! !

!BlockClosureTest methodsFor: 'tests - evaluating' stamp: 'CamilloBruni 8/31/2013 20:23'!
testCullCullCullCull
	[  ]
		cull: 1
		cull: 2
		cull: 3
		cull: 4.
	[ :x |  ]
		cull: 1
		cull: 2
		cull: 3
		cull: 4.
	[ :x :y |  ]
		cull: 1
		cull: 2
		cull: 3
		cull: 4.
	[ :x :y :z |  ]
		cull: 1
		cull: 2
		cull: 3
		cull: 4.
	[ :x :y :z :a |  ]
		cull: 1
		cull: 2
		cull: 3
		cull: 4.
	self
		should: [ 
			[ :x :y :z :a :b |  ]
				cull: 1
				cull: 2
				cull: 3
				cull: 4 ]
		raise: Error.
	self
		assert:
			([ 0 ]
				cull: 1
				cull: 2
				cull: 3
				cull: 4) = 0.
	self
		assert:
			([ :x | x ]
				cull: 1
				cull: 2
				cull: 3
				cull: 4) = 1.
	self
		assert:
			([ :x :y | y ]
				cull: 1
				cull: 2
				cull: 3
				cull: 4) = 2.
	self
		assert:
			([ :x :y :z | z ]
				cull: 1
				cull: 2
				cull: 3
				cull: 4) = 3.
	self
		assert:
			([ :x :y :z :a | a ]
				cull: 1
				cull: 2
				cull: 3
				cull: 4) = 4! !

!BlockClosureTest methodsFor: 'tests - on-fork' stamp: 'GuillermoPolito 5/28/2011 14:34'!
testOnForkErrorReturnsNil
	"Test that if code runs with error, there is fork"
	
	| result sema |
	
	sema := Semaphore new.	
	result := [ 1/0 ] on: Exception fork: [ sema signal. ].
	
	sema wait.
	"in case of error, evaluation result should be nil"
	self assert: result isNil.! !

!BlockClosureTest methodsFor: 'tests - evaluating' stamp: 'MarcusDenker 2/24/2010 12:28'!
testValueWithPossibleArgument
	| block  blockWithArg blockWith2Arg |

	block := [1].
	blockWithArg  := [:arg | arg].
	blockWith2Arg := [:arg1 :arg2 | {arg1. arg2}].

	self assert: (block valueWithPossibleArgument: 1) = 1.
	
	self assert: (blockWithArg valueWithPossibleArgument: 1) = 1.
	
	self assert: (blockWith2Arg valueWithPossibleArgument: 1) = {1 . nil}.
	

	! !

!BlockClosureTest methodsFor: 'tests - evaluating' stamp: 'SvenVanCaekenberghe 2/25/2015 12:53'!
testBenchFor
	| benchmarkResult duration minimumIterations |
	duration := 500 milliSeconds.
	benchmarkResult := [ 100 factorial ] benchFor: duration.
	self deny: benchmarkResult isEmpty.
	self assert: benchmarkResult elapsedTime >= duration.
	"These should pass even on a very slow machine or simulation"
	minimumIterations := 10.
	self assert: benchmarkResult iterations > minimumIterations.
	self assert: benchmarkResult period < (duration / minimumIterations)  ! !

!BlockClosureTest methodsFor: 'tests' stamp: 'ClementBera 5/27/2014 13:49'!
testTrace
	self assert: (Context trace: aBlockContext) class = Rectangle.! !

!BlockClosureTest methodsFor: 'testing' stamp: 'MarcusDenker 2/24/2010 12:28'!
testSupplyAnswerOfFillInTheBlankUsingDefaultAnswer

	self should: ['red' = ([UIManager default  request: 'Your favorite color?' initialAnswer: 'red'] 
		valueSupplyingAnswer: #('Your favorite color?' #default))]! !

!BlockClosureTest methodsFor: 'tests' stamp: 'MarcusDenker 2/24/2010 12:28'!
testSupplySpecificAnswerToQuestion

	self should: [false = ([self confirm: 'You like Smalltalk?'] 
		valueSupplyingAnswer: #('You like Smalltalk?' false))]! !

!BlockClosureTest methodsFor: 'tests - evaluating' stamp: 'GabrielOmarCotelli 5/25/2010 21:22'!
testValueWithPossibleArgs
	| block blockWithArg blockWith2Arg |
	block := [ 1 ].
	blockWithArg := [ :arg | arg ].
	blockWith2Arg := [ :arg1 :arg2 | 
	{arg1.
	arg2} ].
	self assert: (block valueWithPossibleArgs: #()) = 1.
	self assert: (block valueWithPossibleArgs: #(1)) = 1.
	self assert: (blockWithArg valueWithPossibleArgs: #()) isNil.
	self assert: (blockWithArg valueWithPossibleArgs: #(1)) = 1.
	self assert: (blockWithArg valueWithPossibleArgs: #(1 2)) = 1.
	self
		assert:
			(blockWith2Arg valueWithPossibleArgs: #())
				=
					{nil.
					nil}.
	self
		assert:
			(blockWith2Arg valueWithPossibleArgs: #(1))
				=
					{1.
					nil}.
	self assert: (blockWith2Arg valueWithPossibleArgs: #(1 2)) = #(1 2).
	self assert: (blockWith2Arg valueWithPossibleArgs: #(1 2 3)) = #(1 2)! !

!BlockClosureTest methodsFor: 'tests - evaluating' stamp: 'MarcusDenker 2/24/2010 12:28'!
testValueWithExitContinue

	| val last |	
	val := 0. 

	1 to: 10 do: [ :i |
		[ :continue |
			i = 4 ifTrue: [continue value].
			val := val + 1.
			last := i
		] valueWithExit.
	].

	self assert: val = 9.
	self assert: last = 10.	! !

!BlockClosureTest methodsFor: 'tests' stamp: 'HenrikSperreJohansen 6/28/2010 12:18'!
testOneArgument
	| c |
	c := OrderedCollection new.
	c add: 'hello'.
	[c
		do: [1 + 2]]
		ifError: [:err | self deny: err = 'This block requires 0 arguments.'].
	[c
		do: [:arg1 :arg2 | 1 + 2]]
		ifError: [:err | self deny: err = 'This block requires 2 arguments.'] ! !

!BlockClosureTest methodsFor: 'tests - on-fork' stamp: 'IgorStasenko 5/23/2011 12:29'!
testOnFork
	"Test that if code runs without errors, there is no fork!! "
	
	| result1 result2 |
	
	result2 := nil.
	result1 := [ 1 ] on: Exception fork: [ result2 := 2 ].
	
	Processor yield.
	
	self assert: (result1 = 1).
	self assert: (result2 isNil ).! !

!BlockClosureTest methodsFor: 'tests' stamp: 'MarcusDenker 2/24/2010 12:28'!
testSupplyAnswerThroughNestedBlocks

	self should: [true = ([[self confirm: 'You like Smalltalk?'] 
		valueSupplyingAnswer: #('Blub' false)] valueSupplyingAnswer: #('Smalltalk' true))]! !

!BlockClosureTest methodsFor: 'tests - evaluating' stamp: 'CamilloBruni 8/31/2013 20:23'!
testCullCull
	[  ] cull: 1 cull: 2.
	[ :x |  ] cull: 1 cull: 2.
	[ :x :y |  ] cull: 1 cull: 2.
	self should: [ [ :x :y :z |  ] cull: 1 cull: 2 ] raise: Error.
	self should: [ [ :x :y :z :a |  ] cull: 1 cull: 2 ] raise: Error.
	self should: [ [ :x :y :z :a :b |  ] cull: 1 cull: 2 ] raise: Error.
	self assert: ([ 0 ] cull: 1 cull: 2) = 0.
	self assert: ([ :x | x ] cull: 1 cull: 2) = 1.
	self assert: ([ :x :y | y ] cull: 1 cull: 2) = 2! !

!BlockClosureTest methodsFor: 'tests' stamp: 'MarcusDenker 2/24/2010 12:28'!
testSupplySameAnswerToAllQuestions

	self should: [true = ([self confirm: 'You like Smalltalk?'] valueSupplyingAnswer: true)].
	
	self should: [#(true true) = ([{self confirm: 'One'. self confirm: 'Two'}] valueSupplyingAnswer: true)].! !

!BlockClosureTest methodsFor: 'tests - evaluating' stamp: 'MarcusDenker 2/24/2010 12:28'!
testValueWithExitBreak

	| val |	

	[ :break |
	    1 to: 10 do: [ :i |
			val := i.
			i = 4 ifTrue: [break value].
		] 
	] valueWithExit.

	self assert: val = 4.! !

!BlockClosureTest methodsFor: 'tests' stamp: 'MarcusDenker 2/24/2010 12:28'!
testSuppressInform

	self should: [[nil inform: 'Should not see this message or this test failed!!'] valueSuppressingAllMessages isNil]! !

!BlockClosureTest methodsFor: '*System-CachingTests' stamp: 'BenComan 11/21/2014 09:31'!
testMemoizedLRUCache
	| cache factorial result |
	cache := LRUCache new maximumWeight: 3.
	factorial := 0. "avoid not-initialised warning when saving method source"
	factorial := [ :n | n = 1 ifTrue: [1] ifFalse: [(factorial value: n - 1) * n] ] memoizedUsing: cache.
	result := (1 to: 5) collect: factorial.
	self assert: result equals: #(1 2 6 24 120).
	self assert: cache testSupportGetCachedAssociations equals: { 3->6.   4->24.   5->120 }.
! !

!BlockClosureTest methodsFor: 'tests - on-fork' stamp: 'GuillermoPolito 5/28/2011 14:33'!
testOnForkErrorExecutesBlock
	"Test that if code runs with error, there is fork"
	
	| result sema |
	
	sema := Semaphore new.	
	result := nil.
	[ 1/0 ] on: Exception fork: [ result := 2. sema signal].
		
	sema wait.	
	"and of course result should be not nil "
	self assert: result = 2.! !

!BlockClosureTest methodsFor: 'tests' stamp: 'HenrikSperreJohansen 6/28/2010 12:19'!
testNoArguments
	[10
		timesRepeat: [:arg | 1 + 2]]
		ifError: [:err | self deny: err = 'This block requires 1 arguments.'].
	[10
		timesRepeat: [:arg1 :arg2 | 1 + 2]]
		ifError: [:err  | self deny: err = 'This block requires 2 arguments.'] ! !

!BlockClosureTest methodsFor: 'tests' stamp: 'ClementBera 5/27/2014 13:49'!
testRunSimulated
	self assert: (Context runSimulated: aBlockContext) class = Rectangle.! !

!BlockClosureTest methodsFor: 'tests' stamp: 'MarcusDenker 2/24/2010 12:28'!
testSupplySeveralAnswersToSeveralQuestions

	self should: [#(false true) = ([{self confirm: 'One'. self confirm: 'Two'}] 
		valueSupplyingAnswers: #( ('One' false) ('Two' true) ))].
	
	self should: [#(true false) = ([{self confirm: 'One'. self confirm: 'Two'}] 
		valueSupplyingAnswers: #( ('One' true) ('Two' false) ))]! !

!BlockClosureTest methodsFor: 'setup' stamp: 'MarcusDenker 2/24/2010 12:28'!
setUp
	super setUp.
	aBlockContext := [100@100 corner: 200@200].
	contextOfaBlockContext := thisContext.! !

!BlockClosureTest methodsFor: 'tests - evaluating' stamp: 'CamilloBruni 8/31/2013 20:23'!
testCull
	[  ] cull: 1.
	[ :x |  ] cull: 1.
	self should: [ [ :x :y |  ] cull: 1 ] raise: Error.
	self should: [ [ :x :y :z |  ] cull: 1 ] raise: Error.
	self should: [ [ :x :y :z :a |  ] cull: 1 ] raise: Error.
	self should: [ [ :x :y :z :a :b |  ] cull: 1 ] raise: Error.
	self assert: ([ 0 ] cull: 1) = 0.
	self assert: ([ :x | x ] cull: 1) = 1! !

!BlockClosureTest methodsFor: 'tests' stamp: 'ClementBera 5/27/2014 13:49'!
testNew
	self	should: [Context new: 5] raise: Error.
	[Context new: 5]
		ifError: [:error | error = 'Error: Contexts must only be created with newForMethod:'].
	[Context new]
		ifError: [:error  | error = 'Error: Contexts must only be created with newForMethod:'].	
	[Context basicNew]
		ifError: [:error | error = 'Error: Contexts must only be created with newForMethod:'].				

! !

!BlockClosureTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/30/2012 12:04'!
testSetUp
	"Note: In addition to verifying that the setUp worked the way it was expected to, testSetUp is used to illustrate the meaning of the simple access methods, methods that are not normally otherwise 'tested'"

	self assert: aBlockContext home = contextOfaBlockContext.
	self assert: aBlockContext receiver = self.
	self assert: (aBlockContext method isKindOf: CompiledMethod).! !

!BlockClosureTest methodsFor: 'tests' stamp: 'MarcusDenker 8/7/2014 17:44'!
testTallyMethods
	self assert: (Context tallyMethods: aBlockContext) size = 7.! !

!BlockClosureTest methodsFor: 'tests - astmapping' stamp: 'MarcusDenker 10/22/2014 11:20'!
testSourceNodeOptimized
	| block | 
	block := [ :ctx | [ ctx atEnd ] whileTrue:[1+2 ] ] .
	self assert: block sourceNode printString = 'RBBlockNode([ :ctx | [ ctx atEnd ] whileTrue: [ 1 + 2 ] ])'.
! !

!BlockClosureTest methodsFor: 'tests - evaluating' stamp: 'CamilloBruni 8/31/2013 20:23'!
testValueWithArguments
	self should: [ aBlockContext valueWithArguments: #(1) ] raise: Error.
	aBlockContext valueWithArguments: #().
	[ aBlockContext valueWithArguments: #(1) ]
		ifError: [ :err | self assert: err = 'Error: This block accepts 0 arguments, but was called with 1 argument.' ].
	[ [ :i | 3 + 4 ] valueWithArguments: #(1 2) ]
		ifError: [ :err | self assert: err = 'Error: This block accepts 1 argument, but was called with 2 arguments.' ]! !

!BlockClosureTest methodsFor: 'tests' stamp: 'MarcusDenker 9/25/2014 14:18'!
testTallyInstructions
	self assert: (Context tallyInstructions: aBlockContext) size =  26.! !

!BlockClosureTest methodsFor: 'tests' stamp: 'MarcusDenker 2/24/2010 12:28'!
testSuppressInformUsingStringMatchOptions

	self should: [([nil inform: 'Should not see this message or this test failed!!'] valueSuppressingMessages: #('Should not see this message or this test failed!!')) isNil].
	
	self should: [([nil inform: 'Should not see this message or this test failed!!'] valueSuppressingMessages: #('not see this message')) isNil].
	
	self should: [([nil inform: 'Should not see this message or this test failed!!'] valueSuppressingMessages: #('*message*failed#')) isNil].
! !

!BlockClosureTest methodsFor: 'testing' stamp: 'MarcusDenker 2/24/2010 12:28'!
testSupplyAnswerOfFillInTheBlank

	self should: ['blue' = ([UIManager default request: 'Your favorite color?'] 
		valueSupplyingAnswer: #('Your favorite color?' 'blue'))]! !

!BlockClosureTest methodsFor: 'tests - on-fork' stamp: 'SvenVanCaekenberghe 2/20/2014 23:38'!
testOnForkErrorTakesLessThanOneSecond
	"Test that if code runs with error, there is fork"
	
	| sema timeout |

	self flag: 'This test is too brittle, failing often on Windows CI'; skip.
		
	self flag: 'The following line makes the test pass under headless linux. Everywhere else this test works'.
	Smalltalk os isUnix
		ifTrue: [ 1 milliSecond wait ].
	
	sema := Semaphore new.
	[ 1/0 ] on: Exception fork: [ sema signal ].
		
	timeout := (sema waitTimeoutSeconds: 1).	
	self assert: timeout == false! !

!BlockClosureTest methodsFor: '*System-CachingTests' stamp: 'BenComan 11/21/2014 09:31'!
testMemoizedDictionary
	| cache factorial result |
	cache := Dictionary new.
	factorial := 0. "avoid not-initialised warning when saving method source"
	factorial := [ :n | n = 1 ifTrue: [1] ifFalse: [(factorial value: n - 1) * n] ] memoizedUsing: cache.
	result := (1 to: 5) collect: factorial.
	self assert: result equals: #(1 2 6 24 120).
	self assert: cache associations equals: { 1->1.   2->2.   3->6.   4->24.   5->120 }.! !

!BlockClosureTest methodsFor: 'tests' stamp: 'MarcusDenker 2/24/2010 12:28'!
testSupplyAnswerUsingTraditionalMatchOfQuestion

	self should: [true = ([self confirm: 'You like Smalltalk?'] 
		valueSupplyingAnswer: #('*Smalltalk#' true))]! !

!BlockClosuresTestCase commentStamp: '<historical>'!
This test case collects examples for block uses that require full block closures.!
!BlockClosuresTestCase methodsFor: 'examples' stamp: 'rw 1/26/2002 01:14'!
constructFibonacciBlockInDeadFrame

	| fib |
	fib := [:val | 
		(val <= 0) ifTrue: [self error: 'not a natural number'].
		(val <= 2) ifTrue: [1]
		     ifFalse: [(fib value: (val - 1)) + (fib value: (val - 2))]].
	^fib
! !

!BlockClosuresTestCase methodsFor: 'testing' stamp: 'BG 1/24/2002 16:05'!
testExample1

   self assert: ((self example1: 5) = 5 factorial)
  ! !

!BlockClosuresTestCase methodsFor: 'testing' stamp: 'StephaneDucasse 6/9/2012 22:43'!
testReentrantBlockOldEnvironmentWithBlockArguement

	| fib |
	fib := self constructFibonacciBlockWithBlockArgumentInDeadFrame.
	self 
		should: [fib value: 0 value: fib] 
		raise: self classForTestResult error.
	self assert: ((fib value: 1 value: fib) = 1).
	self assert: ((fib value: 2 value: fib) = 1).
	self assert: ((fib value: 3 value: fib) = 2).
	self assert: ((fib value: 4 value: fib) = 3).
	self assert: ((fib value: 5 value: fib) = 5).
	self assert: ((fib value: 6 value: fib) = 8).
! !

!BlockClosuresTestCase methodsFor: 'examples' stamp: 'lr 3/31/2009 09:31'!
example2: anInteger

  " BlockClosuresTestCase new example2: 6"
  " to complicate the example1, we set up a dynamic reference chain that is
    used to dump all calls of facorial when recursion depth is maximal.
    The return value is an instance of orderedCollection, the trace. "

    | factorial trace |

   trace := OrderedCollection new.
   factorial :=
       [:x :dumper :trace2 |  | localDumper |
          localDumper := [ :collection |
                             collection add: x. 
                             dumper value: collection.].
            x = 1 ifTrue:
                    [localDumper value: trace2.
                     1]
                  ifFalse:
                    [(factorial value: x - 1
                                 value: localDumper
                                 value: trace2)* x.
                   ]
         ].
  factorial value: anInteger
             value: [ :collection | ]
             value: trace.
  ^trace! !

!BlockClosuresTestCase methodsFor: 'testing' stamp: 'BG 1/24/2002 16:40'!
testNestedLoopsExample1

   | arrays result |
   arrays := OrderedCollection new.
   arrays add: #(#a #b);
             add: #(1 2 3 4);
             add: #('w' 'x' 'y' 'z').
    result := OrderedCollection new.
    CollectionCombinator new
          forArrays:  arrays
          processWith: [:item |result addLast: item].
   self assert: ((self nestedLoopsExample: arrays) = result)
  ! !

!BlockClosuresTestCase methodsFor: 'examples' stamp: 'rw 1/26/2002 01:15'!
constructSharedClosureEnvironmentInDeadFrame

	|array result| 
	result := 10.
	array := Array new: 2.
	array at: 1 put: [:arg | result := arg].
	array at: 2 put: [result].
	^array
! !

!BlockClosuresTestCase methodsFor: 'jensen device examples' stamp: 'BG 1/25/2002 10:01'!
comment

  "  The Jensen device was something very sophisticated in the days of Algol 60.
Essentially it was tricky use of a parameter passing policy that was called 'call by name'. In modern terminology, a call by name parameter was a pair of blocks (in a system with full block closures, of course.)

For the lovers of Algol 60, here is a short example:

 BEGIN
  REAL PROCEDURE JensenSum (A, I, N);
     REAL  A;   INTEGER   I, N;
  BEGIN
    REAL  S;
    S := 0.0;
    FOR I := 1 STEP 1 UNTIL N DO  S := S + A;
  JensenSum := S;
  END;

  ARRAY X [1:10], Y[1:10, 1:10];
  COMMENT Do array initialization here ;

  JensenSum (X[I], I, 10);
  JensenSum (Y[I, I], I, 10);
  JensenSum(JensenSum(Y[I, J], J, 10), I, 10);
END;

The first call sums the elements of X, the second sums the diagonal elements of Y and the third call sums up all elements of Y.

It is possible to reimplement all this with blocks only and that is what is done in the jensen device examples.

Additional remark:
The Jensen device was something for clever minds. I remember an artice written by Donald Knuth and published in the Communications of the ACM (I think in 1962, but I may err) about that programming trick. That article showed how a simple procedure (called the general problem solver) could be used to do almost anything. The problem was of course to find out the right parameters. I seached my collection of photocopies for that article, but regrettably I could not find it. Perhaps I can find it later.
 "! !

!BlockClosuresTestCase methodsFor: 'examples' stamp: 'BG 1/24/2002 17:27'!
continuationExample3: aCollection

  " see comment in method continuationExample1:.
    The block named 'processor' takes a value with contiuation
    and a processing block. It creates a new value with continuation.
    Here we set up a chain of three values with continuation:
    one data source and two value processors.
    Again we use a collector to collect all values.  "

    | stream processor collector |

   stream := [:collection | | i localBlock |
                i := 1.
                localBlock :=
                    [  | current |
                     current := collection at: i.
                     i := i + 1.
                     Array with: current
                           with: (i<= collection size ifTrue: [localBlock]
                                                      ifFalse: [nil])
                    ].
             ].
 
  processor := 
            [:valueWithContinuation :activity | | localBlock |
                localBlock :=
                 [ | current |
                   current := valueWithContinuation value. 
                   Array with: (activity value: current first)
                         with: (current last notNil ifTrue: [localBlock])].
               localBlock
           ].

 collector := [:valueWithContinuation |  | oc |
                 oc := OrderedCollection new.
                 [ | local |
                  local := valueWithContinuation value.
                  oc add: local first.
                  local last notNil]
                 whileTrue: [].
                 oc.
               ].

  ^collector value: (processor value: (processor value: (stream value: aCollection)
                                                                     value: [:x | x * x])
                                            value: [:x | x - 10]).! !

!BlockClosuresTestCase methodsFor: 'examples' stamp: 'VeronicaUquillas 6/11/2010 12:47'!
example1: anInteger

  " this example is very simple. A named block recursively computes the factorial.
    The example tests whether the value of x is still available after the recursive call.
    Note that the recursive call precedes the multiplication. For the purpose of the test
    this is essential. (When you commute the factors, the example will work also in
    some system without block closures, but not in Pharo.) "

    | factorial |

   factorial := [:x | x = 1 ifTrue: [1]
                            ifFalse: [(factorial value: x - 1)* x]].
  ^ factorial value: anInteger


  ! !

!BlockClosuresTestCase methodsFor: 'testing' stamp: 'BG 1/25/2002 09:57'!
testGpsExample2

  | result array |

  "  integer matrix elements should be used for the purpose of this test. " 
  array := #(#(1 2 3 4 5) #(6 7 8 9 10) #(11 12 13 14 15) #(16 17 18 19 20) #(21 22 23 24 25)).
  result := array inject: 0
              into: [:sum :subarray |
                      sum + (subarray inject: 0
                                          into: [:s :elem | s + elem])].
 self assert: ((self gpsExample2: array) = result)
  ! !

!BlockClosuresTestCase methodsFor: 'testing' stamp: 'BG 1/24/2002 17:45'!
testContinuationExample1

   | array |
    array := (1 to: 20) asOrderedCollection.
   self assert: ((self continuationExample1: array) = array)
  ! !

!BlockClosuresTestCase methodsFor: 'examples' stamp: 'BG 1/24/2002 17:44'!
continuationExample2: aCollection

  " see comment in method continuationExample1:.
    The block named 'processor' takes a value with contiuation
    and a processing block. It creates a new value with continuation.
   Again we use a collector to collect all values.  "

     | stream processor collector |

   stream := [:collection | | i localBlock |
                i := 1.
                localBlock :=
                    [  | current |
                     current := collection at: i.
                     i := i + 1.
                     Array with: current
                           with: (i<= collection size ifTrue: [localBlock]
                                                      ifFalse: [nil])
                    ].
             ].
 
  processor := 
            [:valueWithContinuation :activity | | localBlock |
                localBlock :=
                 [ | current |
                   current := valueWithContinuation value. 
                   Array with: (activity value: current first)
                         with: (current last notNil ifTrue: [localBlock])].
               localBlock
           ].

 collector := [:valueWithContinuation |  | oc |
                 oc := OrderedCollection new.
                 [ | local |
                  local := valueWithContinuation value.
                  oc add: local first.
                  local last notNil]
                 whileTrue: [].
                 oc.
               ].

  ^collector value: (processor value: (stream value: aCollection)
                                           value: [:x | x * x]).! !

!BlockClosuresTestCase methodsFor: 'examples' stamp: 'PeterHugossonMiller 9/2/2009 16:19'!
nestedLoopsExample: arrays

 " A while ago, Hans Baveco asked for a way to
   dynamically nest loops. Better solutions than this one
   were proposed, but this one is a beautiful test for
   recursive block usage. "
 
  | result sizeOfResult streams block |


"arrays := OrderedCollection new.
arrays add: #(#a #b);
       add: #(1 2 3 4);
       add: #('w' 'x' 'y' 'z')."
sizeOfResult :=
   arrays inject: 1 into:
          [:prod :array | prod * array size].
streams := arrays collect:
			[:a | a readStream]. " This is an OrderedCollection of Streams "

result := OrderedCollection new: sizeOfResult.
block :=
 [:r :tupel :allStreams | | innerBlock |
   innerBlock :=
    [:myIdx |
       [myIdx = allStreams size
	  ifTrue: [1 to: allStreams size do:
		   [:i | tupel at: i put: (allStreams at: i) peek].
			 r addLast: tupel shallowCopy]
	 ifFalse:  [innerBlock value: myIdx + 1].
	(allStreams at: myIdx) next.     
	(allStreams at: myIdx) atEnd
      ] 
       whileFalse: [].
     (allStreams at: myIdx) reset.
    ].
    innerBlock value: 1.
   r   
  ].
 block value: result 
         value: (Array new: streams size) " this is a buffer "
         value: streams.

  ^result
! !

!BlockClosuresTestCase methodsFor: 'testing' stamp: 'rw 1/26/2002 01:22'!
testCannotReturn

	| blk |
	blk := self constructCannotReturnBlockInDeadFrame.
	self 
		should: [blk value: 1]
		raise: Exception
! !

!BlockClosuresTestCase methodsFor: 'testing' stamp: 'StephaneDucasse 6/9/2012 22:42'!
testReentrantBlockOldEnvironment

	| fib |
	fib := self constructFibonacciBlockInDeadFrame.
	self 
		should: [fib value: 0] 
		raise: self classForTestResult error.
	self assert: ((fib value: 1) = 1).
	self assert: ((fib value: 2) = 1).
	self assert: ((fib value: 3) = 2).
	self assert: ((fib value: 4) = 3).
	self assert: ((fib value: 5) = 5).
	self assert: ((fib value: 6) = 8).
! !

!BlockClosuresTestCase methodsFor: 'testing' stamp: 'StephaneDucasse 5/28/2011 13:39'!
testSharedClosureEnvironment
	|blockArray|
	blockArray := self constructSharedClosureEnvironmentInDeadFrame.
	self assert: ((blockArray at: 2) value = 10).
	self assert: (((blockArray at: 1) value: 5) = 5).
	self assert: ((blockArray at: 2) value = 5).
! !

!BlockClosuresTestCase methodsFor: 'examples' stamp: 'BG 1/24/2002 17:44'!
continuationExample1: aCollection

  " see comment below.
    Here we simply collect the values of a value with continuation block "


     | streamCreator collector |

   streamCreator := [:collection | | i localBlock |
                i := 1.
                localBlock :=
                    [  | current |
                     current := collection at: i.
                     i := i + 1.
                     Array with: current
                           with: (i<= collection size ifTrue: [localBlock]
                                                      ifFalse: [nil])
                    ].
             ].
 

 collector := [:valueWithContinuation |  | oc |
                 oc := OrderedCollection new.
                 [ | local |
                  local := valueWithContinuation value.
                  oc add: local first.
                  local last notNil]
                 whileTrue: [].
                 oc.
               ].

  ^collector value: (streamCreator value: aCollection).

"The continuation examples are examples of a 'back to LISP' style.
These examples use blocks to process the elements of a collection in a
fashion that is similar to streaming.
The creator block creates a blocks that act like a stream. In the
following, this block is called a 'value with continuation block'.
When such a value with continuation block receives the message
value, it returns a Array of two elements, the value and the
continuation
 1. the next collection element
 2. a so-called continuation, which is either nil or a block
    that can return the next value with continuation.
    
To collect all elements of a value with continuation stream,
use the collector block. "
! !

!BlockClosuresTestCase methodsFor: 'testing' stamp: 'BG 1/24/2002 17:45'!
testContinuationExample3

   | array |
    array := (1 to: 20) asOrderedCollection.
   self assert: ((self continuationExample3: array) = (array collect: [:x | x * x - 10]))
  ! !

!BlockClosuresTestCase methodsFor: 'testing' stamp: 'StephaneDucasse 6/9/2012 22:42'!
testReentrantBlock

	| fib |
	fib := [:val | 
		(val <= 0) ifTrue: [self error: 'not a natural number'].
		(val <= 2) 
			ifTrue: [1]
			ifFalse: [(fib value: (val - 1)) + (fib value: (val - 2))]].

	self 
		should: [fib value: 0] 
		raise: self classForTestResult error.
	self assert: ((fib value: 1) = 1).
	self assert: ((fib value: 2) = 1).
	self assert: ((fib value: 3) = 2).
	self assert: ((fib value: 4) = 3).
	self assert: ((fib value: 5) = 5).
	self assert: ((fib value: 6) = 8).
! !

!BlockClosuresTestCase methodsFor: 'jensen device examples' stamp: 'BG 1/25/2002 10:03'!
gpsExample2: aCollection

   " BlockClosuresTestCase new 
       gpsExample2: #(#(1 2 3 4 5) #(6 7 8 9 10) #(11 12 13 14 15) #(16 17 18 19 20) #(21 22 23 24 25))"

    | js i j |

  "  js is the translation of the Algol procedure from method comment. "
  js := [:a :idx :n | | sum |
               sum := 0.
               idx first value: 1.
               [idx last value <= n last value]
                 whileTrue:
                   [sum :=  sum  + a last value. 
                    idx first value:  idx last value + 1.].
              sum
             ].

  "  This is the most complicated call that is mentioned in method comment. Note that  js  is called recursively. "

  ^ js value: (Array with: [:val | self error: 'can not assign to procedure']
                        with: [ js value: (Array with: [:val | (aCollection at: i) at: j put: val]
                                                     with: [ (aCollection at: i) at: j])
                                   value: (Array with:[:val | j := val]
                                                     with: [ j])
                                   value: (Array with: [:val | self error: 'can not assign to constant']
                                                     with: [ aCollection size])
                               ]
               )
    value: (Array with:[:val | i := val]
                  with: [ i])
    value: (Array with: [:val | self error: 'can not assign to constant']
                  with: [ aCollection size])

! !

!BlockClosuresTestCase methodsFor: 'testing' stamp: 'BG 1/24/2002 17:59'!
testGpsExample1

  | result array |

  array := (1 to: 100) asArray.
  result := array inject: 0
              into: [:sum :val | sum + val].
 self assert: ((self gpsExample1: array) = result)
  ! !

!BlockClosuresTestCase methodsFor: 'jensen device examples' stamp: 'BG 1/24/2002 18:00'!
gpsExample1: aCollection

   " BlockClosuresTestCase new gpsExample1: (1 to: 100) asArray"

 | gps i  s |

  gps := [:idx :exp :sum | | cnt |
               cnt := 1.
               sum first value: 0.
               [idx first value: cnt.
                sum first value: (sum last value + exp last value). 
                cnt := cnt + 1.
                cnt <= aCollection size] whileTrue: [   ].
              sum last value
             ].


  ^gps value: (Array with: [:val | i := val]
                    with: [ i])
      value: (Array with: [:val | aCollection at: i put:  val]
                    with: [ aCollection at: i])
      value: (Array with: [:val | s := val]
                    with: [ s])
! !

!BlockClosuresTestCase methodsFor: 'testing' stamp: 'BG 1/24/2002 18:28'!
testExample2

   self assert: ((self example2: 5) = (1 to: 5) asOrderedCollection)
  ! !

!BlockClosuresTestCase methodsFor: 'testing' stamp: 'BG 1/24/2002 17:45'!
testContinuationExample2

   | array |
    array := (1 to: 20) asOrderedCollection.
   self assert: ((self continuationExample2: array) = (array collect: [:x | x * x]))
  ! !

!BlockClosuresTestCase methodsFor: 'examples' stamp: 'rw 1/26/2002 01:14'!
constructFibonacciBlockWithBlockArgumentInDeadFrame

	^ [:val :blk | 
		(val <= 0) ifTrue: [self error: 'not a natural number'].
		(val <= 2) ifTrue: [1]
		    ifFalse: [(blk value: (val - 1) value: blk) + (blk value: (val - 2) value: blk)]].
! !

!BlockClosuresTestCase methodsFor: 'examples' stamp: 'rw 1/26/2002 01:20'!
constructCannotReturnBlockInDeadFrame

	^ [:arg | ^arg].
! !

!BlockFilter commentStamp: 'TorstenBergmann 1/31/2014 11:30'!
A filter for blocks!
!BlockFilter methodsFor: 'accessing' stamp: 'ClaraAllende 8/14/2013 20:24'!
block
	 ^block! !

!BlockFilter methodsFor: 'accessing' stamp: 'ClaraAllende 8/14/2013 20:24'!
block: aBlockClosure
	block:= aBlockClosure! !

!BlockFilter methodsFor: 'testing' stamp: 'ClaraAllende 8/14/2013 20:25'!
shouldDisplay: aContext
	 ^self block value: aContext! !

!BlockFilter class methodsFor: 'instance creation' stamp: 'AndreiChis 8/27/2013 23:31'!
forBlock: aBlockClosure
	^ self new block: aBlockClosure! !

!BlockLocalTempCounter commentStamp: '<historical>'!
I am a support class for the decompiler that is used to find the number of local temps in a block by finding out what the stack offset is at the end of a block.!
!BlockLocalTempCounter methodsFor: 'instruction decoding' stamp: 'eem 9/23/2008 16:20'!
popIntoTemporaryVariable: offset 
	"Remove Top Of Stack And Store Into Temporary Variable bytecode."
	stackPointer := stackPointer - 1! !

!BlockLocalTempCounter methodsFor: 'instruction decoding' stamp: 'eem 9/23/2008 16:21'!
pushConstant: value
	"Push Constant, value, on Top Of Stack bytecode."
	stackPointer := stackPointer + 1! !

!BlockLocalTempCounter methodsFor: 'private' stamp: 'eem 9/26/2008 13:40'!
doJoin
	scanner pc < blockEnd ifTrue:
		[stackPointer := joinOffsets at: scanner pc]! !

!BlockLocalTempCounter methodsFor: 'initialize-release' stamp: 'MarcusDenker 7/24/2014 10:10'!
tempCountForBlockAt: pc in: method
	"Compute the number of local temporaries in a block.
	 If the block begins with a sequence of push: nil bytecodes then some of
	 These could be initializing local temps.  We can only reliably disambuguate
	 them from other uses of nil by parsing the stack and seeing what the offset
	 of the stack pointer is at the end of the block.

	 There are short-cuts.  The ones we take here are
		- if there is no sequence of push nils there can be no local temps
		- we follow forward jumps to shorten the amount of scanning"
	stackPointer := 0.
	scanner := InstructionStream new method: method pc: pc.
	scanner interpretNextInstructionFor: self.
	blockEnd ifNil:
		[self error: 'pc is not that of a block'].
	scanner nextByte = 115 "pushNil" ifTrue:
		[joinOffsets := Dictionary new.
		 [scanner pc < blockEnd] whileTrue:
			[scanner interpretNextInstructionFor: self]].
	^stackPointer! !

!BlockLocalTempCounter methodsFor: 'instruction decoding' stamp: 'eem 9/23/2008 16:19'!
popIntoLiteralVariable: anAssociation 
	"Remove Top Of Stack And Store Into Literal Variable bytecode."
	stackPointer := stackPointer - 1! !

!BlockLocalTempCounter methodsFor: 'instruction decoding' stamp: 'eem 9/23/2008 16:24'!
send: selector super: supered numArgs: numberArguments
	"Send Message With Selector, selector, bytecode. The argument, 
	supered, indicates whether the receiver of the message is specified with 
	'super' in the source method. The arguments of the message are found in 
	the top numArguments locations on the stack and the receiver just 
	below them."

	stackPointer := stackPointer - numberArguments! !

!BlockLocalTempCounter methodsFor: 'instruction decoding' stamp: 'eem 9/26/2008 13:40'!
jump: offset if: condition 
	"Conditional Jump bytecode."
	stackPointer := stackPointer - 1.
	offset > 0 ifTrue:
		[joinOffsets at: scanner pc + offset put: stackPointer]! !

!BlockLocalTempCounter methodsFor: 'instruction decoding' stamp: 'eem 9/23/2008 16:16'!
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
	"Push Closure bytecode.  Either compute the end of the block if this is
	 the block we're analysing, or skip it, adjusting the stack as appropriate."
	blockEnd
		ifNil: [blockEnd := scanner pc + blockSize]
		ifNotNil:
			[stackPointer := stackPointer - numCopied + 1.
			 scanner pc: scanner pc + blockSize]! !

!BlockLocalTempCounter methodsFor: 'instruction decoding' stamp: 'eem 9/23/2008 16:22'!
pushNewArrayOfSize: numElements 
	"Push New Array of size numElements bytecode."
	stackPointer := stackPointer + 1! !

!BlockLocalTempCounter methodsFor: 'instruction decoding' stamp: 'eem 9/23/2008 16:17'!
doPop
	"Remove Top Of Stack bytecode."
	stackPointer := stackPointer - 1! !

!BlockLocalTempCounter methodsFor: 'instruction decoding' stamp: 'eem 9/23/2008 16:23'!
pushTemporaryVariable: offset
	"Push Contents Of Temporary Variable Whose Index Is the 
	argument, offset, On Top Of Stack bytecode."
	stackPointer := stackPointer + 1! !

!BlockLocalTempCounter methodsFor: 'instruction decoding' stamp: 'ClementBera 12/28/2014 17:30'!
blockReturnConstant: cst
	"Return Top Of Stack bytecode."
	scanner pc < blockEnd ifTrue:
		[self doJoin]! !

!BlockLocalTempCounter methodsFor: 'instruction decoding' stamp: 'eem 9/26/2008 11:36'!
methodReturnTop
	"Return Top Of Stack bytecode."
	stackPointer := stackPointer - 1.
	self doJoin! !

!BlockLocalTempCounter methodsFor: 'instruction decoding' stamp: 'eem 9/23/2008 16:19'!
popIntoReceiverVariable: offset 
	"Remove Top Of Stack And Store Into Instance Variable bytecode."
	stackPointer := stackPointer - 1! !

!BlockLocalTempCounter methodsFor: 'instruction decoding' stamp: 'eem 9/23/2008 16:19'!
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
	"Remove Top Of Stack And Store Into Offset of Temp Vector bytecode."
	stackPointer := stackPointer - 1! !

!BlockLocalTempCounter methodsFor: 'instruction decoding' stamp: 'eem 9/26/2008 13:40'!
jump: offset
	"Unconditional Jump bytecode."
	offset > 0 ifTrue:
		[joinOffsets at: scanner pc + offset put: stackPointer.
		 self doJoin]! !

!BlockLocalTempCounter methodsFor: 'instruction decoding' stamp: 'eem 9/23/2008 16:21'!
pushConsArrayWithElements: numElements
	"Push Cons Array of size numElements popping numElements items from the stack into the array bytecode."
	stackPointer := stackPointer - numElements + 1! !

!BlockLocalTempCounter methodsFor: 'instruction decoding' stamp: 'eem 9/26/2008 11:36'!
methodReturnConstant: value 
	"Return Constant bytecode."
	self doJoin! !

!BlockLocalTempCounter methodsFor: 'instruction decoding' stamp: 'eem 9/23/2008 16:20'!
pushActiveContext
	"Push Active Context On Top Of Its Own Stack bytecode."
	stackPointer := stackPointer + 1! !

!BlockLocalTempCounter methodsFor: 'instruction decoding' stamp: 'eem 9/23/2008 16:23'!
pushReceiverVariable: offset
	"Push Contents Of the Receiver's Instance Variable Whose Index 
	is the argument, offset, On Top Of Stack bytecode."
	stackPointer := stackPointer + 1! !

!BlockLocalTempCounter methodsFor: 'instruction decoding' stamp: 'eem 9/23/2008 16:22'!
pushLiteralVariable: anAssociation
	"Push Contents Of anAssociation On Top Of Stack bytecode."
	stackPointer := stackPointer + 1! !

!BlockLocalTempCounter methodsFor: 'instruction decoding' stamp: 'eem 9/23/2008 16:23'!
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
	"Push Contents at Offset in Temp Vector bytecode."
	stackPointer := stackPointer + 1! !

!BlockLocalTempCounter methodsFor: 'instruction decoding' stamp: 'eem 9/23/2008 16:13'!
doDup
	"Duplicate Top Of Stack bytecode."
	stackPointer := stackPointer + 1! !

!BlockLocalTempCounter methodsFor: 'instruction decoding' stamp: 'eem 9/26/2008 11:36'!
methodReturnReceiver
	"Return Self bytecode."
	self doJoin! !

!BlockLocalTempCounter methodsFor: 'instruction decoding' stamp: 'eem 9/23/2008 16:22'!
pushReceiver
	"Push Active Context's Receiver on Top Of Stack bytecode."
	stackPointer := stackPointer + 1! !

!BlockLocalTempCounter methodsFor: 'instruction decoding' stamp: 'eem 9/26/2008 11:36'!
blockReturnTop
	"Return Top Of Stack bytecode."
	stackPointer := stackPointer - 1.
	scanner pc < blockEnd ifTrue:
		[self doJoin]! !

!BlockLocalTempCounter class methodsFor: 'instance creation' stamp: 'eem 9/23/2008 16:07'!
tempCountForBlockAt: pc in: method
	^self new tempCountForBlockAt: pc in: method! !

!BlockNode commentStamp: '<historical>'!
I represent a bracketed block with 0 or more arguments and 1 or more statements. If I am initialized with no statements, I create one. I have a flag to tell whether my last statement returns a value from the enclosing method. My last three fields remember data needed for code generation. I can emit for value in the usual way, in which case I create a literal method (actually a context remotely copied) to be evaluated by sending it value: at run time. Or I can emit code to be evaluated in line; this only happens at the top level of a method and in conditionals and while-loops, none of which have arguments.!
!BlockNode methodsFor: 'accessing' stamp: 'eem 6/2/2008 14:00'!
addArgument: aTempVariableNode
	temporaries := temporaries copyWith: aTempVariableNode! !

!BlockNode methodsFor: 'code generation (closures)' stamp: 'eem 8/4/2009 11:42'!
addHoistedTemps: additionalTemporaries "<SequenceableCollection>"
	additionalTemporaries do:
		[:temp|
		temp definingScope ifNil:
			[temp definingScope: self]].
	temporaries := (temporaries isNil or: [temporaries isEmpty])
					ifTrue: [additionalTemporaries copy]
					ifFalse:
						[temporaries last isIndirectTempVector
							ifTrue: [temporaries allButLast, additionalTemporaries, { temporaries last }]
							ifFalse: [temporaries, additionalTemporaries]]! !

!BlockNode methodsFor: 'accessing' stamp: 'eem 8/22/2008 10:01'!
closureCreationNode
	closureCreationNode ifNil:
		[closureCreationNode := LeafNode new
									key: #closureCreationNode
									code: nil].
	^closureCreationNode! !

!BlockNode methodsFor: 'accessing' stamp: 'eem 8/4/2008 10:48'!
startOfLastStatement
	^startOfLastStatement! !

!BlockNode methodsFor: 'code generation (closures)' stamp: 'eem 7/22/2009 10:48'!
remoteTempNodeName
	"Answer a useful name for a RemoteTempVectorNode in the receiver."
	| prefix scope extent |
	prefix := actualScopeIfOptimized ifNil: ['<'] ifNotNil: [ '<...'].
	scope := self.
	[extent := scope blockExtent.
	 extent == nil
	 and: [scope actualScope ~~ scope]] whileTrue:
		[scope := scope actualScope].
	^extent
		ifNil: [prefix, '?-?>']
		ifNotNil:
			[prefix, extent first printString, '-',
				(extent last isZero
					ifTrue: ['?']
					ifFalse: [extent last printString]), '>']! !

!BlockNode methodsFor: 'code generation' stamp: 'jannik.laval 5/1/2010 15:59'!
emitCodeForEvaluatedEffect: stack encoder: encoder
	| position |
	position := stack position.
	self returns
		ifTrue: 
			[self emitCodeForEvaluatedValue: stack encoder: encoder.
			stack pop: 1]
		ifFalse: 
			[self emitCodeExceptLast: stack encoder: encoder.
			statements last emitCodeForEffect: stack encoder: encoder].
	[stack position = position] assert! !

!BlockNode methodsFor: 'equation translation' stamp: ''!
statements: val
	statements := val! !

!BlockNode methodsFor: 'visiting' stamp: 'eem 9/6/2009 12:33'!
accept: aVisitor
	^aVisitor visitBlockNode: self! !

!BlockNode methodsFor: 'code generation (closures)' stamp: 'nice 3/1/2010 23:01'!
makeTemporariesRemovable
	"Utilities for when we want to remove some temporaries."
	
	temporaries isArray ifTrue:
		[temporaries := temporaries asOrderedCollection].! !

!BlockNode methodsFor: 'accessing' stamp: ''!
returnLast

	self returns
		ifFalse: 
			[returns := true.
			statements at: statements size put: statements last asReturnNode]! !

!BlockNode methodsFor: 'accessing' stamp: 'sma 2/27/2000 22:37'!
temporaries: aCollection
	temporaries := aCollection! !

!BlockNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 14:52'!
sizeCodeForEvaluatedValue: encoder

	^(self sizeCodeExceptLast: encoder)
		+ (statements last sizeCodeForBlockValue: encoder)! !

!BlockNode methodsFor: 'code generation (closures)' stamp: 'nice 3/1/2010 23:13'!
removeTempNode: aTempVariableNode ifAbsent: aBlock
	"Utilities for when we want to remove some temporaries."
	
	self makeTemporariesRemovable.
	^temporaries remove: aTempVariableNode ifAbsent: aBlock
	! !

!BlockNode methodsFor: 'printing' stamp: 'eem 7/21/2009 13:12'!
printTemporaries: tempSequence on: aStream doPrior: aBlock
	"Print any in-scope temporaries.  If there are any evaluate aBlock
	 prior to printing.  Answer whether any temporaries were printed."
	| tempStream seen |
	tempSequence ifNil:
		[^false].
	tempStream := (String new: 16) writeStream.
	"This is for the decompiler which canmot work out which optimized block a particular temp is
	 local to and hence may produce diplicates as in
		expr ifTrue: [| aTemp | ...] ifFalse: [| aTemp | ...]"
	seen := Set new.
	tempSequence do:
		[:tempNode |
		tempNode isIndirectTempVector
			ifTrue:
				[tempNode remoteTemps do:
					[:tempVariableNode|
					 (tempVariableNode scope >= 0
					  and: [(seen includes: tempNode key) not]) ifTrue:
						[tempStream space; nextPutAll: (seen add: tempVariableNode key)]]]
			ifFalse:
				[(tempNode scope >= -1
				  and: ["This is for the decompiler which may create a block arg when converting
						a while into a to:do: but won't remove it form temporaries"
					   tempNode isBlockArg not
				  and: [(seen includes: tempNode key) not]]) ifTrue:
					[tempStream space; nextPutAll: (seen add: tempNode key)]]].
	tempStream position = 0 ifTrue:
		[^false].
	aBlock value.
	aStream nextPut: $|; nextPutAll: tempStream contents; space; nextPut: $|.
	^true! !

!BlockNode methodsFor: 'printing' stamp: 'alain.plantec 5/18/2009 15:34'!
decompileString 
	"Answer a string description of the parse tree whose root is the receiver."

	^ self printString
! !

!BlockNode methodsFor: 'accessing' stamp: 'eem 7/24/2008 12:37'!
optimized
	^optimized! !

!BlockNode methodsFor: 'accessing' stamp: ''!
firstArgument
	^ arguments first! !

!BlockNode methodsFor: 'accessing' stamp: 'tk 8/4/1999 22:53'!
block
	^ self! !

!BlockNode methodsFor: 'accessing' stamp: 'gk 4/6/2006 11:29'!
returnSelfIfNoOther: encoder

	self returns ifTrue:[^self].
	statements last == NodeSelf ifFalse: [
		statements := statements copyWith: (encoder encodeVariable: 'self').
	].
	self returnLast.
! !

!BlockNode methodsFor: 'code generation (closures)' stamp: 'eem 7/24/2009 18:56'!
ifHasRemoteTempNodeEnsureInitializationStatementExists: rootNode
	"If a remoteTempNode has been added ensure a statement exists to initialize it."
	remoteTempNode ~~ nil ifTrue:
		[(statements notEmpty
		  and: [statements first isAssignmentNode
		  and: [statements first variable isTemp
		  and: [statements first variable isIndirectTempVector]]])
			ifTrue: "If this is a decompiled tree, or if a temporary has been added later in
					the analysis then there already is a temp vector initialization node."
				[(statements first variable ~~ remoteTempNode) ifTrue:
					[statements first variable become: remoteTempNode].
				 statements first value numElements: remoteTempNode remoteTemps size]
			ifFalse:
				[statements addFirst: (remoteTempNode nodeToInitialize: rootNode encoder)]].! !

!BlockNode methodsFor: 'testing' stamp: ''!
isQuick
	^ statements size = 1
		and: [statements first isVariableReference
				or: [statements first isSpecialConstant]]! !

!BlockNode methodsFor: 'printing' stamp: 'eem 5/6/2008 14:28'!
printArgumentsOn: aStream indent: level
	arguments size = 0 ifTrue: [^ self].
	arguments do:
		[:arg | aStream nextPut: $:;  nextPutAll: arg key;  space].
	aStream nextPut: $|; space.
	"If >0 args and >1 statement, put all statements on separate lines"
	statements size > 1 ifTrue:
		[aStream crtab: level]! !

!BlockNode methodsFor: 'initialize-release' stamp: 'eem 5/20/2008 13:40'!
statements: statementsCollection returns: returnBool 
	"Decompile."

	| returnLast |
	returnLast := returnBool.
	returns := false.
	statements := 
		(statementsCollection size > 1 
			and: [(statementsCollection at: statementsCollection size - 1) 
					isReturningIf])
				ifTrue: 
					[returnLast := false.
					statementsCollection allButLast]
				ifFalse: [statementsCollection size = 0
						ifTrue: [Array with: NodeNil]
						ifFalse: [statementsCollection]].
	arguments := #().
	temporaries := #().
	optimized := false.
	returnLast ifTrue: [self returnLast]! !

!BlockNode methodsFor: 'testing' stamp: ''!
isJustCaseError

	^ statements size = 1 and:
		[statements first
			isMessage: #caseError
			receiver: [:r | r==NodeSelf]
			arguments: nil]! !

!BlockNode methodsFor: 'code generation' stamp: 'jannik.laval 5/1/2010 15:59'!
emitCodeExceptLast: stack encoder: encoder
	| position nextToLast |
	position := stack position.
	nextToLast := statements size - 1.
	1 to: nextToLast do:
		[:i | | statement |
		statement := statements at: i.
		statement emitCodeForEffect: stack encoder: encoder.
		[stack position = position] assert].! !

!BlockNode methodsFor: 'accessing' stamp: 'eem 5/30/2008 12:12'!
nArgsSlot
	"Private for the Encoder to use in bindArg"
	^nArgsNode! !

!BlockNode methodsFor: 'testing' stamp: ''!
returns

	^returns or: [statements last isReturningIf]! !

!BlockNode methodsFor: 'code generation (closures)' stamp: 'eem 7/24/2009 16:23'!
postNumberingProcessTempsWithin: scopeBlock "<BlockNode>" rootNode: rootNode "<MethodNode>"
	"A temp can be local (and copied) if it is not written to after it is captured.
	 A temp cannot be local if it is written to remotely.
	 Need to enumerate a copy of the temporaries because any temps becoming remote
	 will be removed from temporaries in analyseClosure: (and a single remote temp node
	 will get added)"
	temporaries copy do:
		[:each|
		each isIndirectTempVector ifFalse:
			[each analyseClosure: rootNode]].

	"If this is an optimized node we need to hoist temporaries up into the relevant block scope."
	optimized ifTrue:
		[self optimizedBlockHoistTempsInto: scopeBlock].

	"Now we may have added a remoteTempNode.  So we need a statement to initialize it."
	self ifHasRemoteTempNodeEnsureInitializationStatementExists: rootNode.

	"Now add all arguments and locals to the pool so that copiedValues can be computed during sizing."
	rootNode
		addLocalsToPool: arguments;
		addLocalsToPool: temporaries! !

!BlockNode methodsFor: 'code generation (closures)' stamp: 'MarcusDenker 2/25/2012 19:42'!
emitCodeForValue: stack encoder: encoder
	"if not supportsClosureOpcodes closureCreationSupportNode is the
	 node for thisContext closureCopy: numArgs [ copiedValues: { values } ]"
	encoder supportsClosureOpcodes
		ifTrue:
			[copiedValues do:
				[:copiedValue| copiedValue emitCodeForValue: stack encoder: encoder].
			 closureCreationNode pc: encoder methodStreamPosition + 1.
			 encoder
				genPushClosureCopyNumCopiedValues: copiedValues size
				numArgs: arguments size
				jumpSize: size.
			 stack
				pop: copiedValues size;
				push: 1]
		ifFalse:
			[closureCreationNode emitCodeForValue: stack encoder: encoder.
			 encoder genJumpLong: size]. "Force a two byte jump."
	"Emit the body of the block"
	self emitCodeForEvaluatedClosureValue: stack encoder: encoder! !

!BlockNode methodsFor: 'code generation (closures)' stamp: 'jannik.laval 5/1/2010 16:58'!
reindexingLocalsDo: aBlock encoder: encoderOrNil
	"Evaluate aBlock wih arguments, temporaries and copiedValues reindexed for
	 their positions within the receiver's block, restoring the correct indices afterwards.
	 If encoder is not nil remember the temps for this block's extent."
	| tempIndices result tempsToReindex |
	[copiedValues notNil] assert.
	tempsToReindex := arguments asArray, copiedValues, temporaries.
	tempIndices := tempsToReindex collect: [:temp| temp index].
	tempsToReindex withIndexDo:
		[:temp :newIndex| temp index: newIndex - 1. [temp index + 1 = newIndex] assert].
	encoderOrNil ifNotNil:
		[encoderOrNil noteBlockExtent: blockExtent hasLocals: tempsToReindex].
	result := aBlock ensure:
				["Horribly pragmatic hack.  The copiedValues will have completely
				  unrelated indices within the closure method and sub-method.
				  Avoiding the effort of rebinding temps in the inner scope simply
				  update the indices to their correct ones during the generation of
				  the closure method and restore the indices immedately there-after."
				 tempsToReindex with: tempIndices do:
					[:temp :oldIndex| temp index: oldIndex. [temp index = oldIndex] assert]].
	^result! !

!BlockNode methodsFor: 'code generation (closures)' stamp: 'eem 9/3/2009 12:55'!
actualScope
	"Answer the actual scope for the receiver.  If this is an unoptimized block then it is its
	 actual scope, but if this is an optimized block then the actual scope is some outer block."
	^actualScopeIfOptimized ifNil: [self]! !

!BlockNode methodsFor: 'accessing' stamp: 'eem 8/31/2010 12:30'!
temporaries
	^temporaries ifNil: [#()]! !

!BlockNode methodsFor: 'initialize-release' stamp: 'eem 8/4/2008 14:12'!
noteSourceRangeStart: start end: end encoder: encoder
	"Note two source ranges for this node.  One is for the debugger
	 and is of the last expression, the result of the block.  One is for
	 source analysis and is for the entire block."
	encoder
		noteSourceRange: (start to: end)
		forNode: self closureCreationNode.
	startOfLastStatement
		ifNil:
			[encoder
				noteSourceRange: (start to: end)
				forNode: self]
		ifNotNil:
			[encoder
				noteSourceRange: (startOfLastStatement to: end - 1)
				forNode: self]! !

!BlockNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 17:13'!
sizeCodeForEvaluatedEffect: encoder

	^self returns
		ifTrue: [self sizeCodeForEvaluatedValue: encoder]
		ifFalse: [(self sizeCodeExceptLast: encoder)
				+ (statements last sizeCodeForEffect: encoder)]! !

!BlockNode methodsFor: 'code generation (closures)' stamp: 'jannik.laval 5/1/2010 15:59'!
optimizedBlockHoistTempsInto: scopeBlock "<BlockNode>"
	"This is a No-op for all nodes except non-optimized BlockNodes."
	"Let's assume the special > 0 guard in MessageNode>>analyseTempsWithin:forValue:encoder: is correct.
	 Then we can simply hoist our temps up."
	[arguments isNil or: [arguments size <= 1]] assert.
	(arguments notNil and: [arguments notEmpty]) ifTrue:
		[scopeBlock addHoistedTemps: arguments.
		arguments := #()].
	temporaries notEmpty ifTrue:
		[scopeBlock addHoistedTemps: temporaries.
		temporaries := #()]! !

!BlockNode methodsFor: 'code generation (closures)' stamp: 'eem 9/12/2008 10:55'!
emitCodeForEvaluatedClosureValue: stack encoder: encoder
	| position |
	position := stack position.
	stack position: arguments size + copiedValues size.
	temporaries size timesRepeat:
		[NodeNil emitCodeForValue: stack encoder: encoder].
	self
		reindexingLocalsDo: [self emitCodeForEvaluatedValue: stack encoder: encoder]
		encoder: encoder.
	self returns ifFalse:
		[encoder genReturnTopToCaller.
		 pc := encoder methodStreamPosition].
	stack position: position! !

!BlockNode methodsFor: 'code generation (closures)' stamp: 'eem 9/6/2009 19:23'!
analyseTempsWithin: scopeBlock "<BlockNode>" rootNode: rootNode "<MethodNode>" assignmentPools: assignmentPools "<Dictionary>"
	| effectiveScope blockStart |
	effectiveScope := optimized
						ifTrue: [actualScopeIfOptimized := scopeBlock]
						ifFalse: [self].

	arguments ifNotNil:
		[arguments do: [:temp| temp definingScope: self]].
	temporaries ifNotNil:
		[temporaries do: [:temp| temp definingScope: self]].

	optimized ifFalse: "if optimized this isn't an actual scope"
		[rootNode noteBlockEntry:
			[:entryNumber|
			 blockExtent := (blockStart := entryNumber) to: 0]].

	"Need to enumerate a copy because closure analysis can add a statement
	 via ifHasRemoteTempNodeEnsureInitializationStatementExists:."
	statements copy do:
		[:statement|
		 statement analyseTempsWithin: effectiveScope rootNode: rootNode assignmentPools: assignmentPools].

	optimized
		ifTrue: "if optimized loop need to add nils for any temps read before written"
			[optimizedMessageNode isOptimizedLoop ifTrue:
				[self nilReadBeforeWrittenTemps]]
		ifFalse: "if optimized this isn't an actual scope"
			[rootNode noteBlockExit:
				[:exitNumber|
				 blockExtent := blockStart to: exitNumber]].

	"Now that the analysis is done move any temps that need to be moved."
	self postNumberingProcessTempsWithin: effectiveScope rootNode: rootNode.

	"This is simply a nicety for compiler developers..."
	temporaries do:
		[:temp|
		(temp isIndirectTempVector and: [temp name includes: $?]) ifTrue:
			[temp name: temp definingScope remoteTempNodeName]]! !

!BlockNode methodsFor: 'code generation (closures)' stamp: 'eem 2/3/2011 09:19'!
deoptimize
	optimized := false.
	optimizedMessageNode := nil! !

!BlockNode methodsFor: 'printing' stamp: 'eem 9/23/2008 15:05'!
printStatementsOn: aStream indent: levelOrZero
	| len shown thisStatement level |
	level := 1 max: levelOrZero.
	comment == nil
		ifFalse: 
			[self printCommentOn: aStream indent: level.
			aStream crtab: level].
	len := shown := statements size.
	(levelOrZero = 0 "top level" and: [statements last isReturnSelf])
		ifTrue: [shown := 1 max: shown - 1]
		ifFalse: ["should a trailing nil be printed or not? Not if it is an implicit result."
				(arguments size = 0
				and: [len >= 1
				and: [(statements at: len) == NodeNil
				and: [len = 1
					or: [len > 1
						and: [(statements at: len - 1) isMessageNode
						and: [(statements at: len - 1) isNilIf]]]]]])
					ifTrue: [shown := shown - 1]].
	1 to: shown do: 
		[:i | 
		thisStatement := statements at: i.
		thisStatement printOn: aStream indent: level.
		i < shown ifTrue: [aStream nextPut: $.; crtab: level].
		(thisStatement comment ~~ nil and: [thisStatement comment size > 0])
			ifTrue: 
				[i = shown ifTrue: [aStream crtab: level].
				thisStatement printCommentOn: aStream indent: level.
				i < shown ifTrue: [aStream crtab: level]]]! !

!BlockNode methodsFor: 'code generation (closures)' stamp: 'MarcusDenker 2/25/2012 19:41'!
sizeCodeForValue: encoder
	"Compute the size for the creation of the block and its code."
	"If we have the closure bytecodes constructClosureCreationNode: will note
	 the copied values in the copiedValues inst var and answer #pushCopiedValues."
	closureCreationNode := self constructClosureCreationNode: encoder.
	"Remember size of body for emit time so we know the size of the jump around it."
	size := self sizeCodeForEvaluatedClosureValue: encoder.
	^encoder supportsClosureOpcodes
		ifTrue:
			[(copiedValues inject: 0 into: [:sum :node| sum + (node sizeCodeForValue: encoder)])
			 + (encoder sizePushClosureCopyNumCopiedValues: copiedValues size numArgs: arguments size jumpSize: size)
			 + size]
		ifFalse:
			["closureCreationSupportNode is send closureCopy:copiedValues:"
			(closureCreationNode sizeCodeForValue: encoder)
			 + (encoder sizeJumpLong: size)
			 + size]! !

!BlockNode methodsFor: 'accessing' stamp: 'ar 11/17/2002 19:57'!
returnNilIfNoOther

	self returns
		ifFalse: 
			[statements last == NodeNil ifFalse: [statements add: NodeNil].
			self returnLast]! !

!BlockNode methodsFor: 'code generation (closures)' stamp: 'eem 9/6/2009 13:30'!
noteOptimizedIn: anOptimizedMessageNode
	optimized := true.
	optimizedMessageNode := anOptimizedMessageNode! !

!BlockNode methodsFor: 'equation translation' stamp: ''!
statements
	^statements! !

!BlockNode methodsFor: 'code generation (closures)' stamp: 'nice 3/1/2010 23:14'!
addTempNode: aTempVariableNode
	"Utilities for when we want to add some temporaries."
	
	self makeTemporariesRemovable.
	^temporaries add: aTempVariableNode! !

!BlockNode methodsFor: 'accessing' stamp: ''!
numberOfArguments

	^arguments size! !

!BlockNode methodsFor: 'initialize-release' stamp: 'eem 5/20/2008 13:40'!
arguments: argNodes statements: statementsCollection returns: returnBool from: encoder
	"Compile."

	arguments := argNodes.
	statements := statementsCollection size > 0
				ifTrue: [statementsCollection]
				ifFalse: [argNodes size > 0
						ifTrue: [statementsCollection copyWith: arguments last]
						ifFalse: [Array with: NodeNil]].
	optimized := false.
	returns := returnBool! !

!BlockNode methodsFor: 'testing' stamp: ''!
isComplex

	^statements size > 1 or: [statements size = 1 and: [statements first isComplex]]! !

!BlockNode methodsFor: 'code generation (closures)' stamp: 'eem 5/31/2008 14:31'!
sizeCodeForEvaluatedClosureValue: encoder
	"The closure value primitives push the arguments and the copied values.
	 The compiler guarantees that any copied values come before all local temps.
	 So on closure activation we only need to push nils for the remaining temporaries."
	^temporaries size * (NodeNil sizeCodeForValue: encoder)
	+ (self
		reindexingLocalsDo: [self sizeCodeForEvaluatedValue: encoder]
		encoder: nil "don't store temps yet")
	+ (self returns ifTrue: [0] ifFalse: [encoder sizeReturnTopToCaller])! !

!BlockNode methodsFor: 'code generation (closures)' stamp: 'eem 5/19/2008 17:12'!
noteOptimized
	optimized := true! !

!BlockNode methodsFor: 'printing' stamp: 'eem 9/25/2008 12:48'!
printOn: aStream indent: level

	"statements size <= 1 ifFalse: [aStream crtab: level]."
	aStream nextPut: $[.
	self printArgumentsOn: aStream indent: level.
	(self printTemporaries: temporaries on: aStream doPrior: []) ifTrue:
		["If >0 temps and >1 statement, put all statements on separate lines"
		 statements size > 1
			ifTrue: [aStream crtab: level]
			ifFalse: [aStream space]].
	self printStatementsOn: aStream indent: level.
	aStream nextPut: $]! !

!BlockNode methodsFor: 'code generation' stamp: ''!
code

	^statements first code! !

!BlockNode methodsFor: 'code generation' stamp: 'eem 5/29/2008 15:21'!
sizeCodeExceptLast: encoder
	| codeSize |
	codeSize := 0.
	1 to: statements size - 1 do: 
		[:i | | statement |
		 statement := statements at: i.
		 codeSize := codeSize + (statement sizeCodeForEffect: encoder)].
	^codeSize! !

!BlockNode methodsFor: 'code generation (closures)' stamp: 'eem 5/20/2008 12:16'!
blockExtent "^<Interval>"
	^blockExtent! !

!BlockNode methodsFor: 'accessing' stamp: 'eem 8/4/2008 10:50'!
startOfLastStatement: anInteger
	"Note the source index of the start of the last full statement.  The
	 last full statement is the value answered by a block and hence the
	 expression the debugger should display as the value of the block."
	startOfLastStatement := anInteger! !

!BlockNode methodsFor: 'accessing' stamp: 'eem 5/30/2008 12:12'!
nArgsSlot: anInteger
	"Private for the Encoder to use in bindArg"
	nArgsNode := anInteger! !

!BlockNode methodsFor: 'code generation (closures)' stamp: 'eem 9/6/2009 13:36'!
nilReadBeforeWrittenTemps
	| visitor readBeforeWritten |
	self accept: (visitor := OptimizedBlockLocalTempReadBeforeWrittenVisitor new).
	readBeforeWritten := visitor readBeforeWritten.
	temporaries reverseDo:
		[:temp|
		((readBeforeWritten includes: temp)
		 and: [temp isRemote not]) ifTrue:
			[statements addFirst: (AssignmentNode new variable: temp value: NodeNil)]]! !

!BlockNode methodsFor: 'accessing' stamp: ''!
arguments: argNodes 
	"Decompile."

	arguments := argNodes! !

!BlockNode methodsFor: 'code generation (closures)' stamp: 'nice 8/19/2010 16:31'!
computeCopiedValues: rootNode
	| referencedValues |
	referencedValues := rootNode referencedValuesWithinBlockExtent: blockExtent.
	^(referencedValues reject: [:temp| temp isDefinedWithinBlockExtent: blockExtent])
		asArray sort: ParseNode tempSortBlock! !

!BlockNode methodsFor: 'testing' stamp: ''!
isJust: node

	returns ifTrue: [^false].
	^statements size = 1 and: [statements first == node]! !

!BlockNode methodsFor: 'code generation (closures)' stamp: 'nice 3/2/2010 00:58'!
addRemoteTemp: aTempVariableNode rootNode: rootNode "<MethodNode>"
	"Add aTempVariableNode to my actualScope's sequence of
	 remote temps.  If I am an optimized block then the actual
	 scope is my actualScopeIfOptimized, otherwise it is myself."
	remoteTempNode == nil ifTrue:
		[remoteTempNode := RemoteTempVectorNode new
								name: self remoteTempNodeName
								index: arguments size + temporaries size
								type: LdTempType
								scope: 0.
		 actualScopeIfOptimized
			ifNil:
				[self addTempNode: remoteTempNode.
				 remoteTempNode definingScope: self]
			ifNotNil: [actualScopeIfOptimized addHoistedTemps: { remoteTempNode }]].
	remoteTempNode addRemoteTemp: aTempVariableNode encoder: rootNode encoder.
	"use remove:ifAbsent: because the deferred analysis for optimized
	 loops can result in the temp has already been hoised into the root."
	self removeTempNode: aTempVariableNode ifAbsent: [
		self actualScope removeTempNode: aTempVariableNode ifAbsent: ["should not happen"]].
	^remoteTempNode! !

!BlockNode methodsFor: 'code generation (closures)' stamp: 'eem 8/4/2008 14:10'!
constructClosureCreationNode: encoder
	copiedValues := self computeCopiedValues: encoder rootNode.
	encoder supportsClosureOpcodes ifTrue:
		[^self closureCreationNode].
	"Without the bytecode we can still get by."
	^MessageNode new
		receiver: (encoder encodeVariable: 'thisContext')
		selector: #closureCopy:copiedValues:
		arguments: (Array
						with: (encoder encodeLiteral: arguments size)
						with: (copiedValues isEmpty
								ifTrue: [NodeNil]
								ifFalse: [BraceNode new elements: copiedValues]))
		precedence: 3
		from: encoder! !

!BlockNode methodsFor: 'testing' stamp: 'eem 9/25/2008 12:10'!
isBlockNode
	^true! !

!BlockNode methodsFor: 'accessing' stamp: 'eem 8/31/2010 12:31'!
arguments
	^arguments ifNil: [#()]! !

!BlockNode methodsFor: 'code generation' stamp: 'jannik.laval 5/1/2010 15:59'!
emitCodeForEvaluatedValue: stack encoder: encoder
	| position |
	position := stack position.
	self emitCodeExceptLast: stack encoder: encoder.
	statements last emitCodeForBlockValue: stack encoder: encoder.
	[stack position - 1 = position] assert! !

!BlockNode methodsFor: 'code generation (closures)' stamp: 'jannik.laval 5/1/2010 16:58'!
analyseArguments: methodArguments temporaries: methodTemporaries rootNode: rootNode "<MethodNode>" "^<Sequence of: <TempVarNade>>"
	"Top level entry-point for analysing temps within the hierarchy of blocks in the receiver's method.
	 Answer the (possibly modified) sequence of temp vars.
	 Need to hoist temps out of macro-optimized blocks into their actual blocks.
	 Need to note reads and writes to temps from blocks other than their actual blocks to determine
	 whether blocks can be local (simple slots within a block/method context) or remote (slots in
	 indirection vectors that are shared between contexts by sharing indirection vectors).

	 The algorithm is based on numbering temporary reads and writes and block extents.
	 The index used for numbering starts at zero and is incremented on every block entry
	 and block exit.  So the following
		| a b blk r1 r2 t |
		a := 1. b := 2. t := 0.
		blk := [ | s | s := a + b. t := t + s].
		r1 := blk value.
		b := -100.
		r2 := blk value.
		r1 -> r2 -> t
	is numbered as
		method block 0 to: 6:
		| a b blk r1 r2 t |
		a w@1 := 1. b w@1 := 2. t w@1 := 0.
		blk w@5 := [entry@2 | s |
					 t  w@3 := t r@3 + a r@3 + b r@3
					] exit@4.
		r1 w@5 := blk r@5 value.
		b w@5 := nil.
		r2 w@5 := blk r@5 value.
		r1 r@5 -> r2 r@5 -> t r@5
	So:
		b and blk cannot be copied because for both there exists a write @5 that follows a
			read @4 within block 2 through 4
		t must be remote because there exists a write @3 within block (2 to: 4)
	Complications are introduced by optimized blocks.  In the following temp is written to
	after it is closed over by [ temp ] since the inlined block is executed more than once.
		| temp coll |
		coll := OrderedCollection new.
		1 to: 5 do: [ :index | 
			temp := index. 
			coll add: [ temp ] ].
		[(coll collect: [:ea| ea value]) asArray = #(5 5 5 5 5)] assert.
	In the following i is local to the block and must be initialized each time around the loop
	but if the block is inlined it must be declared at method level.
		| col |
		col := OrderedCollection new.
		1 to: 3 do: [ :each | | i | i := each. col add: [ i ]. i := i + 1 ].
		[(col collect: [ :each | each value ]) asArray = #(2 3 4)] assert"
	[arguments isEmpty or: [arguments hasEqualElements: methodArguments]] assert.
	arguments := methodArguments asArray. "won't change"
	[temporaries isNil or: [temporaries isEmpty or: [temporaries hasEqualElements: methodTemporaries]]] assert.
	temporaries := OrderedCollection withAll: methodTemporaries.

	[optimized not] assert. "the top-level block should not be optimized."
	self analyseTempsWithin: self rootNode: rootNode assignmentPools: Dictionary new.

	"The top-level block needs to reindex temporaries since analysis may have rearranged them.
	 This happens when temps are made remote and/or a remote node is added."
	temporaries withIndexDo:
		[:temp :offsetPlusOne| temp index: arguments size + offsetPlusOne - 1].

	"Answer the (possibly modified) sequence of temps."
	^temporaries asArray! !

!BlockNode class methodsFor: 'instance creation' stamp: 'sma 3/3/2000 13:34'!
statements: statements returns: returns
	^ self new statements: statements returns: returns! !

!BlockNode class methodsFor: 'instance creation' stamp: 'eem 5/19/2008 17:10'!
withJust: aNode
	^ self new statements: (Array with: aNode) returns: false! !

!BlockStartLocator commentStamp: 'TorstenBergmann 1/31/2014 11:21'!
Locates the start of a block!
!BlockStartLocator methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 09:43'!
initialize
	super initialize.
	nextJumpIsAroundBlock := false! !

!BlockStartLocator methodsFor: 'instruction decoding' stamp: 'eem 5/31/2008 14:16'!
send: selector super: supered numArgs: numberArguments
	nextJumpIsAroundBlock := #closureCopy:copiedValues: == selector
	"Don't use
		nextJumpIsAroundBlock := #(blockCopy: closureCopy:copiedValues:) includes: selector
	 since BlueBook BlockContexts do not have their own temps."! !

!BlockStartLocator methodsFor: 'instruction decoding' stamp: 'eem 5/31/2008 13:54'!
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
	"Answer the size of the block"
	^blockSize! !

!BlockStartLocator methodsFor: 'instruction decoding' stamp: 'eem 5/31/2008 13:48'!
jump: offset
	"If this jump is around a block answer the size of that block."

	nextJumpIsAroundBlock ifTrue:
		[nextJumpIsAroundBlock := false.
		 ^offset]! !

!Boolean commentStamp: '<historical>'!
Boolean is an abstract class defining the protocol for logic testing operations and conditional control structures for the logical values represented by the instances of its subclasses True and False.

Boolean redefines #new so no instances of Boolean can be created. It also redefines several messages in the 'copying' protocol to ensure that only one instance of each of its subclasses True (the global true, logical assertion) and False (the global false, logical negation) ever exist in the system.!
!Boolean methodsFor: 'converting' stamp: 'CamilloBruni 3/27/2012 17:20'!
asBit
	"convert myself to an Integer representing 1 for true and 0 for false"
	self subclassResponsibility! !

!Boolean methodsFor: 'logical operations' stamp: ''!
| aBoolean 
	"Evaluating disjunction (OR). Evaluate the argument. Then answer true 
	if either the receiver or the argument is true."

	self subclassResponsibility! !

!Boolean methodsFor: 'logical operations' stamp: ''!
eqv: aBoolean 
	"Answer true if the receiver is equivalent to aBoolean."

	^self == aBoolean! !

!Boolean methodsFor: 'controlling' stamp: ''!
ifTrue: trueAlternativeBlock ifFalse: falseAlternativeBlock
	"If the receiver is true (i.e., the condition is true), then answer the value 
	of the argument trueAlternativeBlock. If the receiver is false, answer the 
	result of evaluating the argument falseAlternativeBlock. If the receiver 
	is a nonBoolean then create an error notification. Execution does not 
	actually reach here because the expression is compiled in-line."

	self subclassResponsibility! !

!Boolean methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	"Refer to the comment in Object|storeOn:."

	self printOn: aStream! !

!Boolean methodsFor: 'copying' stamp: ''!
deepCopy 
	"Receiver has two concrete subclasses, True and False.
	Only one instance of each should be made, so return self."! !

!Boolean methodsFor: 'printing' stamp: 'apb 4/21/2006 09:22'!
isLiteral 
	^ true! !

!Boolean methodsFor: 'logical operations' stamp: ''!
not
	"Negation. Answer true if the receiver is false, answer false if the 
	receiver is true."

	self subclassResponsibility! !

!Boolean methodsFor: '*Fuel' stamp: 'MartinDias 2/21/2013 12:49'!
fuelAccept: aGeneralMapper

	^aGeneralMapper visitHookPrimitive: self! !

!Boolean methodsFor: '*NativeBoost-Core' stamp: 'cb 4/22/2013 14:15'!
asNBExternalType: gen
	"boolean value in argument description array defines a simple 0 or 1 constant
	
	#( true false )  - turned into a 1 and 0
	"
	^ NBFFIConst value: self asBit! !

!Boolean methodsFor: 'controlling' stamp: ''!
ifFalse: falseAlternativeBlock ifTrue: trueAlternativeBlock 
	"Same as ifTrue:ifFalse:."

	self subclassResponsibility! !

!Boolean methodsFor: 'copying' stamp: ''!
shallowCopy 
	"Receiver has two concrete subclasses, True and False.
	Only one instance of each should be made, so return self."! !

!Boolean methodsFor: 'logical operations' stamp: 'stephane.ducasse 5/20/2009 21:28'!
==> aBlock
	"The material conditional, also known as the material implication or truth functional conditional.
	Correspond to not ... or ... and does not correspond to the English if...then... construction.
		
	 known as:
			b if a 
			a implies b
			if a then b
			b is a consequence of a
			a therefore b (but note: 'it is raining therefore it is cloudy' is implication; 'it is autumn therefore the leaves are falling' is equivalence).
		
	Here is the truth table for material implication:
	
	   p   |   q   |   p ==> q
	-------|-------|-------------
	   T   |   T   |      T
	   T   |   F   |      F
	   F   |   T   |      T
	   F   |   F   |      T
	"

	^self not or: [aBlock value]! !

!Boolean methodsFor: '*Fuel' stamp: 'MartinDias 2/21/2013 12:49'!
serializeOn: anEncoder
	"Do nothing"! !

!Boolean methodsFor: 'controlling' stamp: ''!
ifTrue: alternativeBlock 
	"If the receiver is false (i.e., the condition is false), then the value is the 
	false alternative, which is nil. Otherwise answer the result of evaluating 
	the argument, alternativeBlock. Create an error notification if the 
	receiver is nonBoolean. Execution does not actually reach here because 
	the expression is compiled in-line."

	self subclassResponsibility! !

!Boolean methodsFor: 'controlling' stamp: ''!
or: alternativeBlock 
	"Nonevaluating disjunction. If the receiver is false, answer the value of 
	the argument, alternativeBlock; otherwise answer true without 
	evaluating the argument."

	self subclassResponsibility! !

!Boolean methodsFor: 'controlling' stamp: ''!
ifFalse: alternativeBlock 
	"If the receiver is true (i.e., the condition is true), then the value is the 
	true alternative, which is nil. Otherwise answer the result of evaluating 
	the argument, alternativeBlock. Create an error notification if the 
	receiver is nonBoolean. Execution does not actually reach here because 
	the expression is compiled in-line."

	self subclassResponsibility! !

!Boolean methodsFor: 'logical operations' stamp: ''!
& aBoolean 
	"Evaluating conjunction. Evaluate the argument. Then answer true if 
	both the receiver and the argument are true."

	self subclassResponsibility! !

!Boolean methodsFor: 'copying' stamp: 'tk 8/20/1998 16:07'!
veryDeepCopyWith: deepCopier
	"Return self.  I can't be copied.  Do not record me."! !

!Boolean methodsFor: '*monticellofiletree-core' stamp: 'dkh 4/6/2012 15:56:14'!
writeCypressJsonOn: aStream forHtml: forHtml indent: startIndent
    "by default ignore <forHtml> ... <forHtml> is used for Dictionary and Array, i.e., container objects and String which actually encodes itself differently for HTML"

    aStream nextPutAll: self printString! !

!Boolean methodsFor: 'self evaluating' stamp: 'sd 7/31/2005 21:45'!
isSelfEvaluating
	^ true! !

!Boolean methodsFor: 'controlling' stamp: ''!
and: alternativeBlock 
	"Nonevaluating conjunction. If the receiver is true, answer the value of 
	the argument, alternativeBlock; otherwise answer false without 
	evaluating the argument."

	self subclassResponsibility! !

!Boolean class methodsFor: '*System-Settings-Browser' stamp: 'alain.plantec 3/18/2009 14:48'!
settingInputWidgetForNode: aSettingNode
	^ aSettingNode inputWidgetForBoolean! !

!Boolean class methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 8/13/2013 16:47'!
asNBExternalType: gen
	^ NBBool asNBExternalType: gen! !

!Boolean class methodsFor: 'instance creation' stamp: ''!
new
	self error: 'You may not create any more Booleans - this is two-valued logic'! !

!BooleanFilter commentStamp: 'TorstenBergmann 1/31/2014 11:30'!
A filter for booleans!
!BooleanFilter methodsFor: 'accessing' stamp: 'AndreiChis 9/30/2013 10:53'!
filters
	^filters! !

!BooleanFilter methodsFor: 'accessing' stamp: 'AndreiChis 9/30/2013 10:53'!
booleanOperator
	^booleanOperator! !

!BooleanFilter methodsFor: 'accessing' stamp: 'AndreiChis 9/30/2013 10:53'!
booleanOperator: aSymbol
	booleanOperator:= aSymbol! !

!BooleanFilter methodsFor: 'testing' stamp: 'ClaraAllende 8/14/2013 20:49'!
shouldDisplay: aContext
	^ (self filters first shouldDisplay: aContext) perform: booleanOperator with: [self filters last shouldDisplay: aContext]  ! !

!BooleanFilter methodsFor: 'accessing' stamp: 'ClaraAllende 8/14/2013 20:34'!
filters: theFilters
	filters:= theFilters! !

!BooleanFilter class methodsFor: 'instance creation' stamp: 'AndreiChis 9/30/2013 10:55'!
withFilters: someFilters operator: booleanOperator
	^self new 
		filters: someFilters; 
		booleanOperator: booleanOperator! !

!BooleanSlot commentStamp: 'MarcusDenker 3/31/2015 15:58'!
**Unfinished, see #todo**

I am a Slot that does not allocate one field for each slot. Instead, all Booleanlots of the whole hierarchy are allocated in an integrer that is stored in an invisible slot .

!
!BooleanSlot methodsFor: 'meta-object-protocol' stamp: 'MarcusDenker 3/26/2015 15:55'!
write: aValue to: anObject
	| newInteger |
	newInteger := (baseSlot read: anObject) bitAt: offset put: aValue asBit.
	baseSlot write: newInteger to: anObject.
	^aValue! !

!BooleanSlot methodsFor: 'class building' stamp: 'MarcusDenker 4/1/2015 16:11'!
installingIn: aClass
	super installingIn: aClass.
	offset := self calculateOffset: aClass.! !

!BooleanSlot methodsFor: 'accessing' stamp: 'MarcusDenker 4/1/2015 15:38'!
offset
	^offset! !

!BooleanSlot methodsFor: 'TODO' stamp: 'MarcusDenker 3/31/2015 16:16'!
todo
	'
    - adding a Booleanslot in between --> offsets need to be updated?
	 - removing BooleanSlot in the middle	
	 - adding booleanslot higher in the hierarchy: move baseselot (same as in TODO for DictionarySlot)
	 - emit* methods
	'! !

!BooleanSlot methodsFor: 'class building' stamp: 'MarcusDenker 4/1/2015 10:56'!
layoutChanged: aClass
	super layoutChanged: aClass.
	"we check on the slot level as the slot is hidden"
	(aClass layout hasSlotNamed: baseSlot name) ifTrue: [
		baseSlot := aClass layout slotNamed: baseSlot name. "make sure we all use the same baseSlot"
		^self. ].
	"here we need to be more clever: if a subclass defines it, 
	move the difiniton here"
	self flag: #TBD.
	aClass addSlot: (baseSlot := #'_booleanBaseSlot' => BaseSlot default: 0).
	! !

!BooleanSlot methodsFor: 'meta-object-protocol' stamp: 'MarcusDenker 3/31/2015 16:44'!
read: anObject
	^((baseSlot read: anObject) bitAt: offset) == 1
		! !

!BooleanSlot methodsFor: 'class building' stamp: 'MarcusDenker 4/1/2015 16:14'!
calculateOffset: aClass
	| booleanSlots  calculatedOffset |
	"first we get all boolean slots and sort them by index"
	booleanSlots := aClass allSlots select: [ :each | each isKindOf: self class ].
	booleanSlots := booleanSlots select: [ :each | each offset isNotNil ].
	booleanSlots sort: [ :a :b | a offset < b offset ]. 
	booleanSlots ifEmpty: [ ^1 ]. "we are the first one!!"

	"now we find the first spot where the next offset is not yet taken"
	calculatedOffset := (booleanSlots withIndexCollect: [ :each :myIndex | myIndex ->each offset ]) 
		findFirst: [ :each | each key ~= each value ].
	calculatedOffset = 0  "no hole found: use the next index after the last slot"
		ifTrue: [ ^ booleanSlots last offset + 1 ].
	^calculatedOffset
	! !

!BooleanSlotTest methodsFor: 'tests' stamp: 'MarcusDenker 3/31/2015 16:02'!
testExampleBooleanSlot

	| object slot reader writer |
	
	slot := #slot1 => BooleanSlot.

	aClass := self make: [ :builder |
		builder 
			slots: {slot}
		].

	self assert: (slot instVarNamed: 'baseSlot') isNotNil.

	object := aClass new. 
	"test refletive write and read"
	slot write: true to: object.
	self assert: (slot read: object) = true.
	
		"compiled accessors to test code gen"
	reader := String streamContents: [ :str |
		str 
			nextPutAll: slot name;
			cr;tab;
			nextPutAll: ' ^';
			nextPutAll: slot name.
		 ].
	writer := String streamContents: [ :str |
		str 
			nextPutAll: slot name;
			nextPutAll: ': anObject';
			cr;tab;
			nextPutAll: slot name;
			nextPutAll: ':= anObject.'.
		].
	aClass compile: reader classified: 'accessing'.
	aClass compile: writer classified: 'accessing'.
	
	self assert: object slot1 == true.
	object slot1: false.
	self assert: object slot1 == false.! !

!BooleanSlotTest methodsFor: 'tests' stamp: 'MarcusDenker 4/1/2015 16:00'!
testExampleTwoBooleanSlots

	| object slot1 slot2 |
	
	slot1 := #slot1 => BooleanSlot.
	slot2 := #slot2 => BooleanSlot.

	aClass := self make: [ :builder |
		builder 
			slots: {slot1 . slot2 }
		].

	self assert: (slot1 instVarNamed: 'baseSlot') isNotNil.
	self assert: (slot1 instVarNamed: 'baseSlot') == (slot2 instVarNamed: 'baseSlot').

	object := aClass new. 
	"test reflective write and read"
	slot1 write: true to: object.
	self assert: (slot1 read: object) = true.
	
	slot2 write: true to: object.
	self assert: (slot2 read: object) = true.
	
	slot2 write: true to: object.
	slot1 write: false to: object.
	self assert: (slot2 read: object) = true.
	slot2 write: false to: object.
	self assert: (slot2 read: object) = false.
	
	
	! !

!BooleanTest commentStamp: '<historical>'!
This is the unit test for the class Boolean. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see: 
	- http://www.c2.com/cgi/wiki?UnitTest
	- there is a chapter in the PharoByExample book (http://pharobyexample.org/)
	- the sunit class category
!
!BooleanTest methodsFor: 'tests instance creation' stamp: 'NicolaiHess 12/1/2014 08:46'!
testNew

	self should: [Boolean new] raise: self defaultTestError ! !

!BorderStyle commentStamp: 'kfr 10/27/2003 10:19'!
See BorderedMorph

BorderedMorh new borderStyle: (BorderStyle inset width: 2); openInWorld.!
!BorderStyle methodsFor: 'drawing' stamp: 'ar 8/25/2001 17:01'!
drawLineFrom: startPoint to: stopPoint on: aCanvas
	^aCanvas line: startPoint to: stopPoint width: self width color: self color! !

!BorderStyle methodsFor: 'initialize' stamp: 'ar 8/25/2001 16:06'!
releaseCachedState
	"Release any associated cached state"! !

!BorderStyle methodsFor: 'accessing' stamp: 'ar 8/25/2001 16:07'!
color: aColor
	"Ignored"! !

!BorderStyle methodsFor: 'accessing' stamp: 'ar 8/25/2001 18:15'!
baseColor
	^Color transparent! !

!BorderStyle methodsFor: 'printing' stamp: 'gvc 2/25/2009 15:35'!
printOn: aStream
	"Print a description of the
	receiver on the given stream."

	self storeOn: aStream! !

!BorderStyle methodsFor: 'color tracking' stamp: 'ar 8/25/2001 17:29'!
trackColorFrom: aMorph
	"If necessary, update our color to reflect a change in aMorphs color"! !

!BorderStyle methodsFor: 'testing' stamp: 'ar 8/26/2001 19:30'!
isComplex
	^false! !

!BorderStyle methodsFor: 'accessing' stamp: 'ar 8/25/2001 18:15'!
baseColor: aColor
	"Ignored"! !

!BorderStyle methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/6/2015 19:29'!
asAthensPaintOn: anAthensCanvas
	| stroke |
	stroke := self color asStrokePaintOn: anAthensCanvas.
	stroke width: self width.
	stroke joinMiter.
	^ stroke! !

!BorderStyle methodsFor: 'accessing' stamp: 'ar 8/25/2001 16:08'!
widthForRounding
	^self width! !

!BorderStyle methodsFor: 'accessing' stamp: 'ar 8/25/2001 16:07'!
width: aNumber
	"Ignored"! !

!BorderStyle methodsFor: 'comparing' stamp: 'ar 8/25/2001 16:08'!
hash
	"hash is implemented because #= is implemented"
	^self species hash bitXor: (self width hash bitXor: self color hash)! !

!BorderStyle methodsFor: 'accessing' stamp: 'ar 8/25/2001 16:07'!
width
	^0! !

!BorderStyle methodsFor: 'testing' stamp: 'gvc 6/25/2008 12:09'!
hasFillStyle
	"Answer false."

	^false! !

!BorderStyle methodsFor: 'printing' stamp: 'MarcusDenker 10/21/2013 14:23'!
storeOn: aStream
	"Store a reconstructable representation of the
	receiver on the given stream."

	aStream
		nextPutAll: '(';
		nextPutAll: self class name;
		nextPutAll: ' width: ';
		print: self width;
		nextPutAll: ' color: ';
		print: self color;
		nextPutAll: ')'! !

!BorderStyle methodsFor: 'drawing' stamp: 'dgd 2/21/2003 22:59'!
framePolyline: vertices on: aCanvas 
	"Frame the given rectangle on aCanvas"

	| prev next |
	prev := vertices first.
	2 to: vertices size
		do: 
			[:i | 
			next := vertices at: i.
			self 
				drawLineFrom: prev
				to: next
				on: aCanvas.
			prev := next]! !

!BorderStyle methodsFor: 'testing' stamp: 'gvc 3/14/2007 10:31'!
isComposite
	"Answer false."

	^false! !

!BorderStyle methodsFor: 'drawing' stamp: 'ar 8/25/2001 16:24'!
frameRectangle: aRectangle on: aCanvas
	"Frame the given rectangle on aCanvas"
	aCanvas frameRectangle: aRectangle width: self width color: self color! !

!BorderStyle methodsFor: 'drawing' stamp: 'ar 8/25/2001 16:57'!
framePolygon: vertices on: aCanvas
	"Frame the given rectangle on aCanvas"
	self framePolyline: vertices on: aCanvas.
	self drawLineFrom: vertices last to: vertices first on: aCanvas.! !

!BorderStyle methodsFor: 'accessing' stamp: 'ar 11/26/2001 15:22'!
colorsAtCorners
	^Array new: 4 withAll: self color! !

!BorderStyle methodsFor: 'accessing' stamp: 'ar 8/25/2001 17:51'!
style
	^#none! !

!BorderStyle methodsFor: 'drawing' stamp: 'ar 8/25/2001 16:24'!
frameOval: aRectangle on: aCanvas
	"Frame the given rectangle on aCanvas"
	aCanvas frameOval: aRectangle width: self width color: self color! !

!BorderStyle methodsFor: 'comparing' stamp: 'ar 8/25/2001 18:38'!
= aBorderStyle
	^self species = aBorderStyle species
		and:[self style == aBorderStyle style
		and:[self width = aBorderStyle width
		and:[self color = aBorderStyle color]]].! !

!BorderStyle methodsFor: 'testing' stamp: 'ar 8/25/2001 16:08'!
isBorderStyle
	^true! !

!BorderStyle methodsFor: 'accessing' stamp: 'ar 8/25/2001 16:07'!
color
	^Color transparent! !

!BorderStyle methodsFor: 'accessing' stamp: 'ar 8/25/2001 16:07'!
dotOfSize: diameter forDirection: aDirection
	| form |
	form := Form extent: diameter@diameter depth: Display depth.
	form getCanvas fillOval: form boundingBox color: self color.
	^form! !

!BorderStyle class methodsFor: 'instance creation' stamp: 'rr 6/21/2005 13:50'!
thinGray
	^ self width: 1 color: Color gray! !

!BorderStyle class methodsFor: 'instance creation' stamp: 'sw 11/26/2001 16:05'!
borderStyleChoices
	"Answer the superset of all supported borderStyle symbols"

	^ #(simple inset raised complexAltFramed complexAltInset complexAltRaised complexFramed complexInset complexRaised)! !

!BorderStyle class methodsFor: 'instance creation' stamp: 'EstebanLorenzano 5/3/2014 13:51'!
width: aNumber
	^self width: aNumber color: Smalltalk ui theme borderColor! !

!BorderStyle class methodsFor: 'instance creation' stamp: 'MarcusDenker 7/18/2010 15:43'!
borderStyleForSymbol: sym
	"Answer a border style corresponding to the given symbol"

	| aSymbol |
	aSymbol := sym == #none ifTrue: [#simple] ifFalse: [sym].
	^ self perform: aSymbol! !

!BorderStyle class methodsFor: '*Morphic-Base' stamp: 'ar 11/26/2001 15:00'!
complexAltRaised
	^ComplexBorder style: #complexAltRaised! !

!BorderStyle class methodsFor: '*Morphic-Base' stamp: 'ar 11/26/2001 15:01'!
complexAltInset
	^ComplexBorder style: #complexAltInset! !

!BorderStyle class methodsFor: '*Morphic-Base' stamp: 'sw 11/27/2001 15:22'!
simple
	"Answer a simple border style"

	^ SimpleBorder new! !

!BorderStyle class methodsFor: '*Morphic-Base' stamp: 'ar 11/26/2001 15:00'!
complexFramed
	^ComplexBorder style: #complexFramed! !

!BorderStyle class methodsFor: '*Morphic-Base' stamp: 'ar 11/26/2001 14:59'!
raised
	^RaisedBorder new! !

!BorderStyle class methodsFor: '*Polymorph-Widgets' stamp: 'gvc 8/8/2007 17:20'!
dashed
	"Answer a dashed border style"

	^DashedBorder new! !

!BorderStyle class methodsFor: 'instance creation' stamp: 'ar 8/25/2001 23:52'!
color: aColor width: aNumber
	^self width: aNumber color: aColor! !

!BorderStyle class methodsFor: '*Morphic-Base' stamp: 'ar 11/26/2001 15:01'!
complexAltFramed
	^ComplexBorder style: #complexAltFramed! !

!BorderStyle class methodsFor: 'instance creation' stamp: 'ar 8/25/2001 17:26'!
default
	^Default ifNil:[Default := self new]! !

!BorderStyle class methodsFor: '*Morphic-Base' stamp: 'ar 8/25/2001 16:19'!
width: aNumber color: aColor
	^SimpleBorder new color: aColor; width: aNumber; yourself! !

!BorderStyle class methodsFor: '*Morphic-Base' stamp: 'ar 11/26/2001 14:59'!
inset
	^InsetBorder new! !

!BorderStyle class methodsFor: '*Morphic-Base' stamp: 'ar 11/26/2001 15:00'!
complexInset
	^ComplexBorder style: #complexInset! !

!BorderStyle class methodsFor: '*Morphic-Base' stamp: 'ar 11/26/2001 15:00'!
complexRaised
	^ComplexBorder style: #complexRaised! !

!BorderedMorph commentStamp: 'kfr 10/27/2003 11:17'!
BorderedMorph introduce borders to morph. Borders have the instanceVariables borderWidth and borderColor.
 
BorderedMorph new borderColor: Color red; borderWidth: 10; openInWorld.

BorderedMorph also have a varaity of border styles: simple, inset, raised, complexAltFramed, complexAltInset, complexAltRaised, complexFramed, complexInset, complexRaised.
These styles are set using the classes BorderStyle, SimpleBorder, RaisedBorder, InsetBorder and ComplexBorder.

BorderedMorph new borderStyle: (SimpleBorder width: 1 color: Color white); openInWorld.
BorderedMorph new borderStyle: (BorderStyle inset width: 2); openInWorld.


!
!BorderedMorph methodsFor: 'geometry' stamp: 'nk 4/5/2001 14:24'!
closestPointTo: aPoint
	"account for round corners. Still has a couple of glitches at upper left and right corners"
	| pt |
	pt := self bounds pointNearestTo: aPoint.
	self wantsRoundedCorners ifFalse: [ ^pt ].
	self bounds corners with: (self bounds insetBy: 6) corners do: [ :out :in |
		(pt - out) abs < (6@6)
			ifTrue: [ ^(in + (Point r: 5.0 degrees: (pt - in) degrees)) asIntegerPoint ].
	].
	^pt.! !

!BorderedMorph methodsFor: '*Morphic-Base' stamp: 'StephaneDucasse 5/30/2013 21:34'!
addCornerGrips
	self addMorphBack: (TopLeftGripMorph new target: self; position: self position).
	self addMorphBack: (TopRightGripMorph new target: self; position: self position).
	self addMorphBack: (BottomLeftGripMorph new target: self; position: self position).
	self addMorphBack: (BottomRightGripMorph new target: self; position: self position)! !

!BorderedMorph methodsFor: 'lookenhancements' stamp: 'jrp 7/23/2005 22:16'!
linkSubmorphsToSplitters

	self splitters do:
		[:each |
		each splitsTopAndBottom
			ifTrue:
				[self submorphsDo:
					[:eachMorph |
					(eachMorph ~= each and: [eachMorph layoutFrame bottomFraction = each layoutFrame topFraction]) ifTrue: [each addLeftOrTop: eachMorph].
					(eachMorph ~= each and: [eachMorph layoutFrame topFraction = each layoutFrame bottomFraction]) ifTrue: [each addRightOrBottom: eachMorph]]]
			ifFalse:
				[self submorphsDo:
					[:eachMorph |
					(eachMorph ~= each and: [eachMorph layoutFrame rightFraction = each layoutFrame leftFraction]) ifTrue: [each addLeftOrTop: eachMorph].
					(eachMorph ~= each and: [eachMorph layoutFrame leftFraction = each layoutFrame rightFraction]) ifTrue: [each addRightOrBottom: eachMorph]]]]! !

!BorderedMorph methodsFor: 'testing' stamp: 'FernandoOlivero 9/5/2013 10:55'!
isTranslucentButNotTransparent
	"Answer true if this any of this morph is translucent but not transparent."

	(color isColor and: [color isTranslucentButNotTransparent]) ifTrue: [^ true].
	(borderColor isColor and: [borderColor isTranslucentButNotTransparent]) ifTrue: [^ true].
	^ false
! !

!BorderedMorph methodsFor: 'initialization' stamp: 'MarcusDenker 12/11/2009 23:56'!
initialize
	"initialize the state of the receiver"
	super initialize.
	
	self borderInitialize! !

!BorderedMorph methodsFor: 'lookenhancements' stamp: 'jrp 7/23/2005 22:28'!
removePaneSplitters

	self splitters do: [:each | each delete]! !

!BorderedMorph methodsFor: 'accessing' stamp: 'di 6/4/1999 09:42'!
borderWidth: anInteger
	borderColor ifNil: [borderColor := Color black].
	borderWidth := anInteger max: 0.
	self changed! !

!BorderedMorph methodsFor: 'menu' stamp: 'NicolaiHess 11/22/2014 00:12'!
addBorderStyleMenuItems: aMenu hand: aHandMorph
	"Add border-style menu items"

	| subMenu |
	subMenu := UIManager default newMenuIn: self for: self.
	subMenu addStayUpItem.
	subMenu add: 'border width...' selector: #changeBorderWidth:.
	subMenu add: 'border color...' selector: #changeBorderColor:.
	subMenu addLine.
	BorderStyle borderStyleChoices do:
		[:sym | (self borderStyleForSymbol: sym)
			ifNotNil:
				[subMenu add: sym target: self selector: #setBorderStyle: argument: sym]].
	aMenu add: 'border style' subMenu: subMenu
! !

!BorderedMorph methodsFor: 'private' stamp: 'EstebanLorenzano 5/14/2014 15:02'!
basicBorderColor: aColor 
	borderColor := aColor! !

!BorderedMorph methodsFor: 'accessing' stamp: 'sw 8/6/97 14:34'!
borderColor
	^ borderColor! !

!BorderedMorph methodsFor: 'accessing' stamp: 'di 6/20/97 11:09'!
borderWidth
	^ borderWidth! !

!BorderedMorph methodsFor: 'accessing' stamp: 'di 6/20/97 11:24'!
borderInset
	self borderColor: #inset! !

!BorderedMorph methodsFor: '*Morphic-Base' stamp: 'NicolaiHess 11/22/2014 00:24'!
changeBorderColor: evt
	self theme
		chooseColorIn: self
		title: 'Choose Color' translated
		color: self borderStyle color
		for: [ :newColor | self borderColor: newColor ]! !

!BorderedMorph methodsFor: 'accessing' stamp: 'gvc 9/11/2009 17:16'!
borderStyle: aBorderStyle 
	"Work around the borderWidth/borderColor pair"

	aBorderStyle = self borderStyle ifTrue: [^self].
	self assureExtension.
	"secure against invalid border styles"
	(self canDrawBorder: aBorderStyle) 
		ifFalse: 
			["Replace the suggested border with a simple one"

			^self borderStyle: (BorderStyle width: aBorderStyle width
						color: (aBorderStyle trackColorFrom: self) color)].
	aBorderStyle width = self borderStyle width ifFalse: [self changed].
	(aBorderStyle isNil or: [aBorderStyle == BorderStyle default]) 
		ifTrue: 
			[extension borderStyle: nil.
			borderWidth := 0.
			^self changed].
	extension borderStyle: aBorderStyle.
	borderWidth := aBorderStyle width.
	borderColor := aBorderStyle style == #simple 
				ifTrue: [aBorderStyle color]
				ifFalse: [aBorderStyle style].
	self changed! !

!BorderedMorph methodsFor: 'accessing' stamp: 'gvc 9/11/2009 17:17'!
borderStyle
	"Work around the borderWidth/borderColor pair"

	| style |
	borderColor ifNil: [^BorderStyle default].
	borderWidth isZero ifTrue: [^BorderStyle default].
	self assureExtension.
	style := extension borderStyle ifNil: [BorderStyle default].
	(borderWidth = style width and: 
			["Hah!! Try understanding this..."

			borderColor == style style or: 
					["#raised/#inset etc"

					#simple == style style and: [borderColor = style color]]]) 
		ifFalse: 
			[style := borderColor isColor 
				ifTrue: [BorderStyle width: borderWidth color: borderColor]
				ifFalse: [(BorderStyle perform: borderColor) width: borderWidth	"argh."].
			extension borderStyle: style].
	^style trackColorFrom: self! !

!BorderedMorph methodsFor: 'accessing' stamp: 'sw 11/29/1999 17:37'!
useSquareCorners
	self cornerStyle: #square! !

!BorderedMorph methodsFor: 'initialization' stamp: 'EstebanLorenzano 5/15/2014 18:58'!
defaultBorderWidth
	"answer the default border width for the receiver"
	^ self theme borderWidth! !

!BorderedMorph methodsFor: '*Morphic-Base' stamp: 'MarcusDenker 9/13/2013 15:55'!
changeBorderWidth: evt
	| aHand origin handle newWidth |
	aHand := evt ifNil: [self primaryHand] ifNotNil: [evt hand].
	origin := aHand position.
	handle := HandleMorph new
		forEachPointDo:
			[:newPoint | handle removeAllMorphs.
			handle addMorph:
				(LineMorph from: origin to: newPoint color: Color black width: 1).
			newWidth := (newPoint - origin) r asInteger // 5.
			self borderWidth: newWidth]
		lastPointDo:
			[:newPoint | handle deleteBalloon.
			self halo ifNotNil: [:halo | halo addHandles]].
	aHand attachMorph: handle.
	handle setProperty: #helpAtCenter toValue: true.
	handle showBalloon:
'Move cursor farther from
this point to increase border width.
Click when done.' translated hand: evt hand.
	handle startStepping! !

!BorderedMorph methodsFor: 'private' stamp: 'EstebanLorenzano 5/14/2014 15:03'!
basicBorderWidth: aNumber 
	borderWidth := aNumber! !

!BorderedMorph methodsFor: '*Morphic-Base' stamp: 'IgorStasenko 12/19/2012 17:23'!
addPaneVSplitterBetween: leftMorph and: rightMorphs 

	| targetX minY maxY splitter |
	targetX := leftMorph layoutFrame rightFraction.
	minY := (rightMorphs detectMin: [:each | each layoutFrame topFraction]) layoutFrame topFraction.
	maxY := (rightMorphs detectMax: [:each | each layoutFrame bottomFraction]) layoutFrame bottomFraction.
	
	splitter := ProportionalSplitterMorph new.
	splitter layoutFrame: ( (targetX @ minY corner: targetX @ maxY) asLayoutFrame 
		leftOffset: leftMorph layoutFrame rightOffset;
		rightOffset: 4+ leftMorph layoutFrame rightOffset;
		topOffset:  leftMorph layoutFrame topOffset;
		bottomOffset: leftMorph layoutFrame bottomOffset).

	self addMorphBack: (splitter position: self position).! !

!BorderedMorph methodsFor: 'initialization' stamp: 'dgd 3/7/2003 15:53'!
borderInitialize
	"initialize the receiver state related to border"
	borderColor:= self defaultBorderColor.
	borderWidth := self defaultBorderWidth! !

!BorderedMorph methodsFor: 'accessing' stamp: 'di 6/20/97 11:19'!
doesBevels
	"To return true means that this object can show bevelled borders, and
	therefore can accept, eg, #raised or #inset as valid borderColors.
	Must be overridden by subclasses that do not support bevelled borders."

	^ true! !

!BorderedMorph methodsFor: '*Morphic-Base' stamp: 'jrp 7/23/2005 00:03'!
removeCornerGrips

	| corners |
	corners := self submorphsSatisfying: [:each | each isKindOf: CornerGripMorph].
	corners do: [:each | each delete]! !

!BorderedMorph methodsFor: 'accessing' stamp: 'gvc 5/9/2006 15:50'!
colorForInsets
	"Return the color to be used for shading inset borders."
	
	self owner isSystemWindow
		ifTrue: [^self owner colorForInsets].
	^super colorForInsets! !

!BorderedMorph methodsFor: 'initialization' stamp: 'dgd 2/14/2003 22:33'!
defaultBorderColor
	"answer the default border color/fill style for the receiver"
	^ Color black! !

!BorderedMorph methodsFor: '*Morphic-Base' stamp: 'jrp 7/23/2005 22:16'!
splitters

	^ self submorphsSatisfying: [:each | each isKindOf: ProportionalSplitterMorph]! !

!BorderedMorph methodsFor: '*Morphic-Base' stamp: 'IgorStasenko 12/19/2012 17:19'!
addPaneSplitters
	| splitter remaining target targetX sameX minY maxY targetY sameY minX maxX |
	self removePaneSplitters.
	self removeCornerGrips.

	remaining := submorphs reject: [:each | each layoutFrame rightFraction = 1].
	[remaining notEmpty] whileTrue:
		[target := remaining first.
		targetX := target layoutFrame rightFraction.
		sameX := submorphs select: [:each | each layoutFrame rightFraction = targetX].
		minY := (sameX detectMin: [:each | each layoutFrame topFraction]) layoutFrame topFraction.
		maxY := (sameX detectMax: [:each | each layoutFrame bottomFraction]) layoutFrame bottomFraction.
		splitter := ProportionalSplitterMorph new.
		splitter layoutFrame: (
		
		 (targetX @ minY corner: targetX @ maxY) asLayoutFrame 
			leftOffset: target layoutFrame rightOffset;
			topOffset: target layoutFrame topOffset;
			rightOffset: 4 + target layoutFrame rightOffset;
			bottomOffset: target layoutFrame bottomOffset).
			
		self addMorphBack: (splitter position: self position).
		remaining := remaining copyWithoutAll: sameX].

	remaining := submorphs copy reject: [:each | each layoutFrame bottomFraction = 1].
	[remaining notEmpty]
		whileTrue: [target := remaining first.
			targetY := target layoutFrame bottomFraction.
			sameY := submorphs select: [:each | each layoutFrame bottomFraction = targetY].
			minX := (sameY detectMin: [:each | each layoutFrame leftFraction]) layoutFrame leftFraction.
			maxX := (sameY detectMax: [:each | each layoutFrame rightFraction]) layoutFrame rightFraction.
			splitter := ProportionalSplitterMorph new beSplitsTopAndBottom; yourself.
			splitter layoutFrame: (
				(minX @ targetY corner: maxX @ targetY) asLayoutFrame
					leftOffset: target layoutFrame leftOffset;
					topOffset: target layoutFrame bottomOffset;
					rightOffset: target layoutFrame rightOffset;
					bottomOffset: 4 + target layoutFrame bottomOffset ).
			self addMorphBack: (splitter position: self position).
			remaining := remaining copyWithoutAll: sameY].

	self linkSubmorphsToSplitters.
	self splitters do: [:each | each comeToFront].
! !

!BorderedMorph methodsFor: 'geometry' stamp: 'StephaneDucasse 5/28/2011 13:31'!
acquireBorderWidth: aBorderWidth
	"Gracefully acquire the new border width, keeping the interior area intact and not seeming to shift"

	| delta |
	(delta := aBorderWidth- self borderWidth) = 0 ifTrue: [^ self].
	self bounds: ((self bounds origin - (delta @ delta)) corner: (self bounds corner + (delta @ delta))).
	self borderWidth: aBorderWidth.
	self layoutChanged! !

!BorderedMorph methodsFor: 'accessing' stamp: 'di 6/20/97 11:25'!
borderRaised
	self borderColor: #raised! !

!BorderedMorph methodsFor: 'accessing' stamp: 'ar 8/17/2001 16:52'!
borderColor: colorOrSymbolOrNil
	self doesBevels ifFalse:[
		colorOrSymbolOrNil isColor ifFalse:[^self]].
	borderColor = colorOrSymbolOrNil ifFalse: [
		borderColor := colorOrSymbolOrNil.
		self changed].
! !

!BorderedMorph class methodsFor: '*Morphic-Base' stamp: 'MarcusDenker 7/8/2012 12:09'!
exampleGradient
	"self exampleGradient"
	
	| morph fs |
	morph := BorderedMorph new.
	fs := GradientFillStyle ramp: {0.0 -> Color red. 1.0 -> Color green}.
	fs origin: morph bounds center.
	fs direction: (morph bounds width // 2) @ 0.
	fs radial: true.
	morph fillStyle: fs.
	World primaryHand attachMorph: morph.! !

!BottomLeftGripMorph commentStamp: 'jmv 1/29/2006 17:17'!
I am the handle in the left bottom of windows used for resizing them.!
!BottomLeftGripMorph methodsFor: 'accessing' stamp: 'jmv 1/29/2006 17:52'!
resizeCursor

	^ Cursor resizeForEdge: #bottomLeft! !

!BottomLeftGripMorph methodsFor: 'accessing' stamp: 'md 2/24/2006 22:43'!
ptName
	^#bottomLeft! !

!BottomLeftGripMorph methodsFor: 'target resize' stamp: 'jmv 1/29/2006 18:06'!
apply: delta 
	| oldBounds |
	oldBounds := target bounds.
	target
		bounds: (oldBounds origin + (delta x @ 0) corner: oldBounds corner + (0 @ delta y))! !

!BottomLeftGripMorph methodsFor: 'drawing' stamp: 'gvc 5/13/2008 10:21'!
drawOn: aCanvas
	"Draw the grip on the given canvas."

	| dotBounds alphaCanvas windowBorderWidth dotBounds2 |
	
	self shouldDraw ifFalse: [^self].

	windowBorderWidth := SystemWindow borderWidth.
	alphaCanvas := aCanvas asAlphaBlendingCanvas: 0.7.	
	"alphaCanvas
		frameRectangle: bounds color: Color blue."

	dotBounds := self bounds.
	dotBounds2 := dotBounds right: (dotBounds left + windowBorderWidth).
	dotBounds2 := dotBounds2 top: (dotBounds2 bottom - windowBorderWidth).
	alphaCanvas
		fillRectangle: dotBounds2
		color: self handleColor.
	
	dotBounds2 := dotBounds left: (dotBounds left + windowBorderWidth).
	dotBounds2 := dotBounds2 top: (dotBounds2 bottom - windowBorderWidth).
	alphaCanvas
		fillRectangle: dotBounds2
		color: self handleColor.

	dotBounds2 := dotBounds2 left: (dotBounds2 left + 7).
	dotBounds2 := dotBounds2 right: (dotBounds2 right - 7).
	alphaCanvas
		fillRectangle: dotBounds2
		color: self dotColor.

	dotBounds2 := dotBounds right: (dotBounds left + windowBorderWidth).
	dotBounds2 := dotBounds2 bottom: (dotBounds2 bottom - windowBorderWidth).
	alphaCanvas
		fillRectangle: dotBounds2
		color: self handleColor.

	dotBounds2 := dotBounds2 top: (dotBounds2 top + 7).
	dotBounds2 := dotBounds2 bottom: (dotBounds2 bottom - 7).
	alphaCanvas
		fillRectangle: dotBounds2
		color: self dotColor! !

!BottomLeftGripMorph methodsFor: 'accessing' stamp: 'IgorStasenko 12/19/2012 17:46'!
gripLayoutFrame
	^  (0 @ 1 corner: 0 @ 1) asLayoutFrame 
			topOffset: self defaultHeight negated;
			rightOffset: self defaultWidth! !

!BottomLeftGripMorph methodsFor: 'testing' stamp: 'gvc 7/30/2009 13:47'!
containsPoint: aPoint
	"Answer true only if on edges."
	
	|w|
	^(super containsPoint: aPoint) and: [
		w := SystemWindow borderWidth.
		((self bounds translateBy: w@w negated)
			containsPoint: aPoint) not]! !

!BottomRightGripMorph commentStamp: 'jmv 1/29/2006 17:18'!
I am the handle in the right bottom of windows used for resizing them.!
!BottomRightGripMorph methodsFor: 'accessing' stamp: 'jmv 1/29/2006 17:51'!
resizeCursor

	^ Cursor resizeForEdge: #bottomRight! !

!BottomRightGripMorph methodsFor: 'accessing' stamp: 'md 2/24/2006 22:43'!
ptName
	^#bottomRight! !

!BottomRightGripMorph methodsFor: 'target resize' stamp: 'jmv 1/29/2006 17:59'!
apply: delta 
	| oldBounds |
	oldBounds := target bounds.
	target
		bounds: (oldBounds origin corner: oldBounds corner + delta)! !

!BottomRightGripMorph methodsFor: 'drawing' stamp: 'gvc 5/13/2008 10:21'!
drawOn: aCanvas
	"Draw the grip on the given canvas."

	| dotBounds alphaCanvas windowBorderWidth dotBounds2 |
	
	self shouldDraw ifFalse: [^self].

	windowBorderWidth := SystemWindow borderWidth.
	alphaCanvas := aCanvas asAlphaBlendingCanvas: 0.7.	
	"alphaCanvas
		frameRectangle: bounds color: Color blue."

	dotBounds := self bounds.
	dotBounds2 := dotBounds left: (dotBounds right - windowBorderWidth).
	dotBounds2 := dotBounds2 top: (dotBounds2 bottom - windowBorderWidth).
	alphaCanvas
		fillRectangle: dotBounds2
		color: self handleColor.
	
	dotBounds2 := dotBounds right: (dotBounds right - windowBorderWidth).
	dotBounds2 := dotBounds2 top: (dotBounds2 bottom - windowBorderWidth).
	alphaCanvas
		fillRectangle: dotBounds2
		color: self handleColor.

	dotBounds2 := dotBounds2 left: (dotBounds2 left + 7).
	dotBounds2 := dotBounds2 right: (dotBounds2 right - 7).
	alphaCanvas
		fillRectangle: dotBounds2
		color: self dotColor.

	dotBounds2 := dotBounds left: (dotBounds right - windowBorderWidth).
	dotBounds2 := dotBounds2 bottom: (dotBounds2 bottom - windowBorderWidth).
	alphaCanvas
		fillRectangle: dotBounds2
		color: self handleColor.

	dotBounds2 := dotBounds2 top: (dotBounds2 top + 7).
	dotBounds2 := dotBounds2 bottom: (dotBounds2 bottom - 7).
	alphaCanvas
		fillRectangle: dotBounds2
		color: self dotColor! !

!BottomRightGripMorph methodsFor: 'accessing' stamp: 'IgorStasenko 12/19/2012 17:48'!
gripLayoutFrame
	^ (1 @ 1 corner: 1 @ 1) asLayoutFrame 
		topLeftOffset: (0 - self defaultWidth @ (0 - self defaultHeight))
		
	! !

!BottomRightGripMorph methodsFor: 'testing' stamp: 'gvc 3/12/2007 10:52'!
containsPoint: aPoint
	"Answer true only if on edges."
	
	|w|
	^(super containsPoint: aPoint) and: [
		w := SystemWindow borderWidth.
		((self bounds translateBy: (w@w) negated)
			containsPoint: aPoint) not]! !

!BoundedGradientFillStyle commentStamp: 'gvc 3/13/2009 12:19'!
Gradient fillstyle that draws with optional extent.!
!BoundedGradientFillStyle methodsFor: 'accessing' stamp: 'gvc 3/13/2009 12:22'!
extent
	"Answer the value of extent"

	^ extent! !

!BoundedGradientFillStyle methodsFor: 'comparing' stamp: 'gvc 3/13/2009 12:39'!
hash
	"Hash is implemented because #= is implemented."
	
	^super hash bitXor: self extent hash! !

!BoundedGradientFillStyle methodsFor: 'accessing' stamp: 'gvc 3/13/2009 12:22'!
extent: anObject
	"Set the value of extent"

	extent := anObject! !

!BoundedGradientFillStyle methodsFor: 'comparing' stamp: 'gvc 3/13/2009 12:39'!
= aGradientFillStyle
	"Answer whether equal."

	^super = aGradientFillStyle
		and: [self extent = aGradientFillStyle extent]! !

!BoundedGradientFillStyle methodsFor: '*Polymorph-Widgets' stamp: 'IgorStasenko 12/22/2012 03:41'!
fillRectangle: aRectangle on: aCanvas
	"Fill the given rectangle on the given canvas with the receiver."
	
	self extent ifNil: [^super fillRectangle: aRectangle on: aCanvas].
	aCanvas fillRectangle: ((self origin extent: self extent) intersect: aRectangle ifNone: [^ self ]) basicFillStyle: self! !

!BraceNode commentStamp: '<historical>'!
Used for compiling and decompiling brace constructs.

These now compile into either a fast short form for 4 elements or less:
	Array braceWith: a with: b ... 
or a long form of indefinfite length:
	(Array braceStream: N) nextPut: a; nextPut: b; ...; braceArray.

The erstwhile brace assignment form is no longer supported.!
!BraceNode methodsFor: 'enumerating' stamp: ''!
casesReverseDo: aBlock
	"For each case in reverse order, evaluate aBlock with three arguments:
	 the key block, the value block, and whether it is the last case."

	| numCases case |
	(numCases := elements size) to: 1 by: -1 do:
		[:i |
		case := elements at: i.
		aBlock value: case receiver value: case arguments first value: i=numCases]! !

!BraceNode methodsFor: 'initialize-release' stamp: ''!
elements: collection sourceLocations: locations
	"Compile."

	elements := collection.
	sourceLocations := locations! !

!BraceNode methodsFor: 'initialize-release' stamp: ''!
elements: collection
	"Decompile."

	elements := collection! !

!BraceNode methodsFor: 'testing' stamp: 'eem 9/25/2008 14:48'!
blockAssociationCheck: encoder
	"If all elements are MessageNodes of the form [block]->[block], and there is at
	 least one element, answer true.
	 Otherwise, notify encoder of an error."

	elements size = 0
		ifTrue: [^encoder notify: 'At least one case required'].
	elements with: sourceLocations do:
			[:x :loc |
			(x 	isMessage: #->
				receiver:
					[:rcvr |
					rcvr isBlockNode and: [rcvr numberOfArguments = 0]]
				arguments:
					[:arg |
					arg isBlockNode and: [arg numberOfArguments = 0]])
			  ifFalse:
				[^encoder notify: 'Association between 0-argument blocks required' at: loc]].
	^true! !

!BraceNode methodsFor: 'initialize-release' stamp: 'di 11/19/1999 11:19'!
matchBraceWithReceiver: receiver selector: selector arguments: arguments

	selector = (self selectorForShortForm: arguments size)
		ifFalse: [^ nil "no match"].

	"Appears to be a short form brace construct"
	self elements: arguments! !

!BraceNode methodsFor: 'code generation (closures)' stamp: 'eem 7/20/2009 09:33'!
analyseTempsWithin: scopeBlock "<BlockNode>" rootNode: rootNode "<MethodNode>" assignmentPools: assignmentPools "<Dictionary>"
	elements do:
		[:node|
		node analyseTempsWithin: scopeBlock rootNode: rootNode assignmentPools: assignmentPools]! !

!BraceNode methodsFor: 'code generation (closures)' stamp: 'eem 5/30/2008 17:22'!
maxElementsForConsArray
	"Hack; we have no way of knowing how much stack space is available during sizing"
	^8! !

!BraceNode methodsFor: 'code generation' stamp: 'eem 5/30/2008 17:22'!
sizeCodeForValue: encoder

	(encoder supportsClosureOpcodes
		"Hack; we have no way of knowing how much stack space is available"
	 and: [elements size <= self maxElementsForConsArray]) ifTrue:
		[^(elements inject: 0 into: [:sum :node| sum + (node sizeCodeForValue: encoder)])
		  + (encoder sizePushConsArray: elements size)].
	emitNode := elements size <= 4
		ifTrue: ["Short form: Array braceWith: a with: b ... "
				MessageNode new
					receiver: (encoder encodeVariable: #Array)
					selector: (self selectorForShortForm: elements size)
					arguments: elements precedence: 3 from: encoder]
		ifFalse: ["Long form: (Array braceStream: N) nextPut: a; nextPut: b; ...; braceArray"
				CascadeNode new
					receiver: (MessageNode new
								receiver: (encoder encodeVariable: #Array)
								selector: #braceStream:
								arguments: (Array with: (encoder encodeLiteral: elements size))
								precedence: 3 from: encoder)
					messages: ((elements collect: [:elt | MessageNode new receiver: nil
														selector: #nextPut:
														arguments: (Array with: elt)
														precedence: 3 from: encoder])
								copyWith: (MessageNode new receiver: nil
														selector: #braceArray
														arguments: (Array new)
														precedence: 1 from: encoder))].
	^emitNode sizeCodeForValue: encoder! !

!BraceNode methodsFor: 'initialize-release' stamp: 'di 11/19/1999 11:06'!
matchBraceStreamReceiver: receiver messages: messages

	((receiver isMessage: #braceStream: receiver: nil arguments: [:arg | arg isConstantNumber])
		and: [messages last isMessage: #braceArray receiver: nil arguments: nil])
		ifFalse: [^ nil "no match"].

	"Appears to be a long form brace construct"
	self elements: (messages allButLast collect:
		[:msg | (msg isMessage: #nextPut: receiver: nil arguments: nil)
					ifFalse: [^ nil "not a brace element"].
		msg arguments first])! !

!BraceNode methodsFor: 'code generation' stamp: 'di 1/4/2000 11:24'!
selectorForShortForm: nElements

	nElements > 4 ifTrue: [^ nil].
	^ #(braceWithNone braceWith: braceWith:with:
			braceWith:with:with: braceWith:with:with:with:) at: nElements + 1! !

!BraceNode methodsFor: 'enumerating' stamp: ''!
casesForwardDo: aBlock
	"For each case in forward order, evaluate aBlock with three arguments:
	 the key block, the value block, and whether it is the last case."

	| numCases case |
	1 to: (numCases := elements size) do:
		[:i |
		case := elements at: i.
		aBlock value: case receiver value: case arguments first value: i=numCases]! !

!BraceNode methodsFor: 'code generation' stamp: 'eem 5/30/2008 17:40'!
emitCodeForValue: stack encoder: encoder

	(encoder supportsClosureOpcodes
		"Hack; we have no way of knowing how much stack space is available"
	 and: [elements size <= self maxElementsForConsArray]) ifTrue:
		[elements do: [:node| node emitCodeForValue: stack encoder: encoder].
		 encoder genPushConsArray: elements size.
		 stack
			pop: elements size;
			push: 1.
		 ^self].
	^emitNode emitCodeForValue: stack encoder: encoder! !

!BraceNode methodsFor: 'visiting' stamp: 'eem 9/6/2009 12:33'!
accept: aVisitor
	^aVisitor visitBraceNode: self! !

!BraceNode methodsFor: 'code generation (closures)' stamp: 'eem 5/21/2008 10:40'!
elements
	^elements! !

!BraceNode methodsFor: 'testing' stamp: ''!
numElements

	^ elements size! !

!BraceNode methodsFor: 'printing' stamp: 'di 11/19/1999 09:17'!
printOn: aStream indent: level

	aStream nextPut: ${.
	1 to: elements size do: 
		[:i | (elements at: i) printOn: aStream indent: level.
		i < elements size ifTrue: [aStream nextPutAll: '. ']].
	aStream nextPut: $}! !

!BraceNode class methodsFor: 'examples' stamp: 'di 11/19/1999 09:05'!
example
	"Test the {a. b. c} syntax."

	| x |
	x := {1. {2. 3}. 4}.
	^ {x first. x second first. x second last. x last. 5} as: Set

"BraceNode example Set (0 1 2 3 4 5 )"
! !

!BracketMorph commentStamp: 'gvc 5/18/2007 13:48'!
Morph displaying opposing arrows.!
!BracketMorph methodsFor: 'initialization' stamp: 'gvc 9/19/2006 15:52'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		orientation: #horizontal! !

!BracketMorph methodsFor: 'accessing' stamp: 'gvc 9/21/2006 15:48'!
horizontal
	"Answer whether horizontal or vertical."
	
	^self orientation == #horizontal! !

!BracketMorph methodsFor: 'drawing' stamp: 'gvc 9/21/2006 16:16'!
drawOn: aCanvas
	"Draw triangles at the edges."
	
	|r|
	r := self horizontal
		ifTrue: [self bounds insetBy: (2@1 corner: 2@1)]
		ifFalse: [self bounds insetBy: (1@2 corner: 1@2)].
	aCanvas
		drawPolygon: (self leftOrTopVertices: self bounds)
		fillStyle: self borderColor;
		drawPolygon: (self leftOrTopVertices: r)
		fillStyle: self fillStyle;
		drawPolygon: (self rightOrBottomVertices: self bounds)
		fillStyle: self borderColor;
		drawPolygon: (self rightOrBottomVertices: r)
		fillStyle: self fillStyle! !

!BracketMorph methodsFor: 'accessing' stamp: 'gvc 9/19/2006 15:52'!
orientation: anObject
	"Set the value of orientation"

	orientation := anObject.
	self changed! !

!BracketMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/15/2015 14:11'!
drawOnAthensCanvas: anAthensCanvas
	"Draw triangles at the edges."

	| r |
	r := self horizontal
		ifTrue: [ self bounds insetBy: (2 @ 1 corner: 2 @ 1) ]
		ifFalse: [ self bounds insetBy: (1 @ 2 corner: 1 @ 2) ].
	anAthensCanvas setPaint: self borderColor.
	anAthensCanvas drawShape: (self createClosedPolygonPathFrom: 
	(self leftOrTopVertices: self bounds) on: anAthensCanvas).
	
	anAthensCanvas setPaint: self fillStyle.
	anAthensCanvas drawShape: (self createClosedPolygonPathFrom: 
	(self leftOrTopVertices: r) on: anAthensCanvas).
	
	anAthensCanvas setPaint: self borderColor.
	anAthensCanvas drawShape: (self createClosedPolygonPathFrom: 
	(self rightOrBottomVertices: self bounds) on: anAthensCanvas).
	
	anAthensCanvas setPaint: self fillStyle.
	anAthensCanvas drawShape: (self createClosedPolygonPathFrom:
	(self rightOrBottomVertices: r) on: anAthensCanvas)! !

!BracketMorph methodsFor: 'geometry' stamp: 'gvc 9/21/2006 16:18'!
rightOrBottomVertices: r
	"Answer the vertices for a right or bottom bracket in the given rectangle."
	
	^self orientation == #vertical
		ifTrue: [{r topRight - (0@1). r right - (r height // 2 + (r height \\ 2))@(r center y - (r height + 1 \\ 2)).
				r right - (r height // 2 + (r height \\ 2))@(r center y). r bottomRight}]
		ifFalse: [{(r center x)@(r bottom - 1 - (r width // 2 + (r width \\ 2))).
				r center x @(r bottom - 1 - (r width // 2 + (r width \\ 2))). r bottomRight. r bottomLeft - (1@0)}]! !

!BracketMorph methodsFor: 'accessing' stamp: 'gvc 9/19/2006 15:54'!
horizontal: aBoolean
	"Set whether horizontal or vertical."
	
	^self orientation: (aBoolean ifTrue: [#horizontal] ifFalse: [#vertical])! !

!BracketMorph methodsFor: 'geometry' stamp: 'gvc 9/21/2006 15:45'!
leftOrTopVertices: r
	"Answer the vertices for a left or top bracket in the given rectangle."
	
	^self orientation == #vertical
		ifTrue: [{r topLeft - (0@1). r left + (r height // 2 + (r height \\ 2))@(r center y - (r height + 1 \\ 2)).
				r left + (r height // 2 + (r height \\ 2))@(r center y). r bottomLeft}]
		ifFalse: [{r topLeft. (r center x - (r width + 1 \\ 2))@(r top + (r width // 2 + (r width \\ 2))).
				r center x@(r top + (r width // 2 + (r width \\ 2))). r topRight}]! !

!BracketMorph methodsFor: 'accessing' stamp: 'gvc 9/19/2006 15:51'!
orientation
	"Answer the value of orientation"

	^ orientation! !

!BracketMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/15/2015 14:08'!
createClosedPolygonPathFrom: aPointsArray on: anAthensCanvas
	^ anAthensCanvas
		createPath: [ :builder | 
			aPointsArray ifEmpty: [ builder ].
			builder absolute.
			builder moveTo: aPointsArray first.
			aPointsArray allButFirstDo: [ :p | builder lineTo: p ].
			builder close.
			builder ]! !

!BracketSliderMorph commentStamp: 'gvc 5/18/2007 13:39'!
Abstract superclass for morphs that are used to select a component (R, G, B or A) of a colour.!
!BracketSliderMorph methodsFor: 'initialization' stamp: 'gvc 9/3/2009 13:39'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		fillStyle: self defaultFillStyle;
		borderStyle: (BorderStyle inset baseColor: self paneColor; width: 1);
		sliderColor: Color black;
		clipSubmorphs: true! !

!BracketSliderMorph methodsFor: 'geometry' stamp: 'gvc 9/26/2006 12:02'!
sliderThickness
	"Answer the thickness of the slider."
	
	^((self bounds isWide
		ifTrue: [self height]
		ifFalse: [self width]) // 2 max: 8) // 2 * 2 + 1! !

!BracketSliderMorph methodsFor: 'geometry' stamp: 'gvc 9/3/2009 13:40'!
extent: aPoint
	"Update the gradient directions."

	super extent: aPoint.
	self updateFillStyle! !

!BracketSliderMorph methodsFor: 'protocol' stamp: 'gvc 9/3/2009 13:41'!
updateFillStyle
	"Update the fill style directions."

	|b fs|
	fs := self fillStyle.
	fs isOrientedFill ifTrue: [
		b := self innerBounds.
		fs origin: b topLeft.
		fs direction: (b isWide
			ifTrue: [b width@0]
			ifFalse: [0@b height])]! !

!BracketSliderMorph methodsFor: 'layout' stamp: 'gvc 9/3/2009 13:41'!
layoutBounds: aRectangle
	"Set the bounds for laying out children of the receiver.
	Note: written so that #layoutBounds can be changed without touching this method"
	
	super layoutBounds: aRectangle.
	self updateFillStyle.
	slider horizontal: self bounds isWide.
	sliderShadow horizontal: self bounds isWide! !

!BracketSliderMorph methodsFor: 'protocol' stamp: 'gvc 9/3/2009 13:40'!
defaultFillStyle
	"Answer the defauolt fill style."

	^Color gray! !

!BracketSliderMorph methodsFor: 'accessing' stamp: 'gvc 8/7/2007 16:05'!
fillStyleToUse
	"Answer the fillStyle that should be used for the receiver."
	
	^self fillStyle! !

!BracketSliderMorph methodsFor: 'as yet unclassified' stamp: 'gvc 9/19/2006 14:06'!
gradient
	"Answer the gradient."

	self subclassResponsibility! !

!BracketSliderMorph methodsFor: 'access' stamp: 'gvc 9/19/2006 15:43'!
sliderShadowColor
	"Answer the color for the slider shadow."
	
	^Color black alpha: 0.6! !

!BracketSliderMorph methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 7/18/2012 16:16'!
initializeSlider
	"Make the slider raised."
	
	self 
		setSlider: (( BracketMorph newBounds: self totalSliderArea)
						horizontal: self bounds isWide;
						color: self thumbColor;
						borderStyle: (BorderStyle raised baseColor: Color white; width: 1))
		 withShadow: ((BracketMorph newBounds: self totalSliderArea)
						horizontal: self bounds isWide;
						color: self pagingArea color;
						borderStyle: (BorderStyle inset baseColor: (Color white alpha: 0.6); width: 1)).! !

!BracketSliderMorph methodsFor: 'access' stamp: 'gvc 9/8/2009 13:29'!
sliderColor: newColor
	"Set the slider colour."
	
	super sliderColor: (self enabled ifTrue: [Color black] ifFalse: [self sliderShadowColor]).
	slider ifNotNil: [slider borderStyle baseColor: Color white]! !

!BracketSliderMorph methodsFor: 'geometry' stamp: 'gvc 9/21/2006 11:34'!
roomToMove
	"Allow to run off the edges a bit."
	
	^self bounds isWide
		ifTrue: [self totalSliderArea insetBy: ((self sliderThickness // 2@0) negated corner: (self sliderThickness // 2 + 1)@0)]
		ifFalse: [self totalSliderArea insetBy: (0@(self sliderThickness // 2) negated corner: 0@(self sliderThickness // 2 - (self sliderThickness \\ 2) + 1))]! !

!BreadthFirstGuide commentStamp: 'cwp 11/18/2009 12:13'!
I traverse the filesystem in breadth-first order. Given this hierarchy:

alpha
	beta
	gamma
delta
	epsilon

I would visit the nodes in the following order:  alpha, delta, beta, gamma, epsilon.

I use my work instance variable as a queue, adding nodes to be visited to the end and retrieving them from the beginning.
!
!BreadthFirstGuide methodsFor: 'showing' stamp: 'CamilloBruni 4/10/2013 12:41'!
visitNextEntry: entry
		
	entry isFile 
		ifTrue: [ ^ visitor visitFile: entry ].
	
	visitor visitDirectory: entry.
	
	(self shouldVisitChildrenOf: entry)
		ifTrue: [ self pushAll: entry reference entries ].! !

!BreadthFirstGuide methodsFor: 'showing' stamp: 'CamilloBruni 8/12/2011 18:23'!
show: aReference 
	self push: aReference entry.
	self whileNotDoneDo: [ self visitNextEntry: self top ]! !

!BreadthFirstGuideTest commentStamp: 'TorstenBergmann 1/31/2014 11:43'!
SUnit tests for class BreadthFirstGuide!
!BreadthFirstGuideTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:37'!
testAll
	guide := BreadthFirstGuide for: self.
	guide show: (filesystem / 'alpha').
	self assertVisitedIs: #(
			'alpha'
			'beta'
			'epsilon'
			'delta'
			'gamma'
			'zeta'
		)! !

!BrowseDebugAction commentStamp: '<historical>'!
A BrowseDebugAction is a debugging actions sending a unary message to the stack widget.
!
!BrowseDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/26/2013 19:07'!
receiver

	^ self debugger stack! !

!BrowseDebugAction methodsFor: 'initialization' stamp: 'AndreiChis 9/25/2013 17:33'!
initialize

	super initialize.
	self needsUpdate: false.
	self needsValidation: false.! !

!BrowseDebugAction class methodsFor: 'actions creation' stamp: 'AndreiChis 9/24/2013 16:41'!
debugActionsFor: aDebugger
	<contextMenuDebuggingAction>
	| initilOrder |
	
	initilOrder := 60.
	^ { 
		self new
			id: #browseSendersOfMessages;
			order: initilOrder;
			keyText: 'n';
			label: 'Senders of...'.
		self new
			id: #browseMessages;
			order: initilOrder + 5;
			keyText: 'm';
			label: 'Implementors of...'.
		self new
			id: #methodHierarchy;
			order: initilOrder + 10;
			keyText: 'i';
			label: 'Inheritance'.
		self new
			id: #browseVersions;
			order: initilOrder + 15;
			keyText: 'v';
			label: 'Versions'.
		self new
			id: #browseInstVarRefs;
			order: initilOrder + 20;
			label: 'Inst var refs...'.
		self new
			id: #browseClassVarRefs;
			order: initilOrder + 25;
			label: 'Class var refs...'.
		self new
			id: #browseClassVariables;
			order: initilOrder + 30;
			label: 'Class variables';
			withSeparatorAfter.
			
		self new
			id: #browseClassRefs;
			order: initilOrder + 35;
			keyText: 'N';
			label: 'Class refs'.
		self new
			id: #browseMethodFull;
			order: initilOrder + 40;
			keyText: 'b';
			label: 'Browse full'.
		self new
			id: #fileOutMessage;
			order: initilOrder + 45;
			label: 'File out'.
		self new
			id: #inspectInstances;
			order: initilOrder + 50;
			label: 'Inspect instances'.
		self new
			id: #inspectSubInstances;
			order: initilOrder + 55;
			label: 'Inspect subinstances';
			withSeparatorAfter
	 }! !

!Browser commentStamp: '<historical>'!
I represent a query path into the class descriptions, the software of the system.!
!Browser methodsFor: 'traits' stamp: 'BernardoContreras 2/25/2012 17:33'!
spawnHierarchyForClass: aClass selector: aSelector
	"Create and schedule a new hierarchy browser for the given class and selector."
	self setClass: aClass selector: aSelector.
	self spawnHierarchy.
	! !

!Browser methodsFor: 'drag and drop' stamp: 'nk 6/12/2004 17:43'!
acceptDroppingMorph: transferMorph event: evt inMorph: dstListMorph 
	"Here we are fetching informations from the dropped transferMorph 
	and  
	performing the correct action for this drop."
	| srcType success srcBrowser |
	success := false.
	srcType := transferMorph dragTransferType.
	srcBrowser := transferMorph source model.
	srcType == #messageList
		ifTrue: [ | srcClass srcSelector srcCategory |
			srcClass := transferMorph passenger key.
			srcSelector := transferMorph passenger value.
			srcCategory := srcBrowser selectedMessageCategoryName.
			srcCategory
				ifNil: [srcCategory := srcClass organization categoryOfElement: srcSelector].
			success := self
						acceptMethod: srcSelector
						messageCategory: srcCategory
						class: srcClass
						atListMorph: dstListMorph
						internal: self == srcBrowser
						copy: transferMorph shouldCopy].
	srcType == #classList
		ifTrue: [success := self
						changeCategoryForClass: transferMorph passenger
						srcSystemCategory: srcBrowser selectedSystemCategoryName
						atListMorph: dstListMorph
						internal: self == srcBrowser
						copy: transferMorph shouldCopy].
	^ success! !

!Browser methodsFor: 'message category list' stamp: 'EstebanLorenzano 6/26/2013 18:08'!
recategorizeMethodSelector: sel 
	"Categorize method named sel by looking in parent classes for a 
	method category. 
	Answer true if recategorized."
	
	self selectedClassOrMetaClass allSuperclasses
		do: [:ea | | thisCat | 
			thisCat := ea organization categoryOfElement: sel.
			(thisCat ~= Protocol unclassified
					and: [thisCat notNil])
				ifTrue: [self classOrMetaClassOrganizer classify: sel under: thisCat.
					self changed: #messageCategoryList.
					^ true]].
	^ false! !

!Browser methodsFor: 'message category list' stamp: 'sd 11/20/2005 21:26'!
setOriginalCategoryIndexForCurrentMethod
	"private - Set the message category index for the currently selected method. 
	 
	 Note:  This should only be called when somebody tries to save  
	 a method that they are modifying while ALL is selected."

	messageCategoryListIndex := self messageCategoryList indexOf: self categoryOfCurrentMethod
	! !

!Browser methodsFor: 'accessing' stamp: 'rbb 3/1/2005 10:26'!
request: prompt initialAnswer: initialAnswer

	^ UIManager default
		request: prompt
		initialAnswer: initialAnswer
! !

!Browser methodsFor: 'initialization' stamp: 'StephaneDucasse 12/19/2012 16:29'!
openAsMorphSysCatEditing: editString
	"Create a pluggable version of all the views for a Browser, including views and controllers."
	| window hSepFrac switchHeight mySingletonList |

	window := (SystemWindow labelled: 'later') model: self.
	hSepFrac := 0.30.
	switchHeight := 25.
	mySingletonList := PluggableListMorph on: self list: #systemCategorySingleton
			selected: #indexIsOne changeSelected: #indexIsOne:
			menu: #systemCatSingletonMenu: keystroke: #systemCatSingletonKey:from:.
 	mySingletonList enableDragNDrop: true.
	mySingletonList hideScrollBarsIndefinitely.
	window 
		addMorph: mySingletonList
		fullFrame: (  (0@0 corner: 1@0) asLayoutFrame bottomOffset: switchHeight).	

	self 
		addClassAndSwitchesTo: window 
		at: (0@0 corner: 0.3333@hSepFrac)
		plus: switchHeight.

	window 
		addMorph: self buildMorphicMessageCatList
		fullFrame: ( (0.3333@0 corner: 0.6666@hSepFrac) asLayoutFrame topOffset: switchHeight).

	window 
		addMorph: self buildMorphicMessageList
		fullFrame: ( (0.6666@0 corner: 1@hSepFrac) asLayoutFrame  topOffset: switchHeight).

	self 
		addLowerPanesTo: window 
		at: (0@hSepFrac corner: 1@1) 
		with: editString.

	window setUpdatablePanesFrom: #( classList messageCategoryList messageList).
	^ window! !

!Browser methodsFor: 'message list' stamp: ''!
messageListIndex
	"Answer the index of the selected message selector into the currently 
	selected message category."

	^messageListIndex! !

!Browser methodsFor: 'drag and drop' stamp: 'ls 6/22/2001 23:21'!
dstCategoryDstListMorph: dstListMorph
	^(dstListMorph getListSelector == #systemCategoryList)
		ifTrue: [dstListMorph potentialDropItem ]
		ifFalse: [self selectedSystemCategoryName]! !

!Browser methodsFor: 'system category functions' stamp: 'sd 11/20/2005 21:26'!
buildSystemCategoryBrowserEditString: aString 
	"Create and schedule a new system category browser with initial textual 
	contents set to aString."

	| newBrowser |
	systemCategoryListIndex > 0
		ifTrue: 
			[newBrowser := self class new.
			newBrowser systemCategoryListIndex: systemCategoryListIndex.
			newBrowser setClass: self selectedClassOrMetaClass selector: self selectedMessageName.
			self class openBrowserView: (newBrowser openSystemCatEditString: aString)
				label: 'Classes in category ', newBrowser selectedSystemCategoryName]! !

!Browser methodsFor: 'class list' stamp: 'onierstrasz 11/11/2013 12:24'!
recent
	"Let the user select from a list of recently visited classes.  11/96 stp.
	 12/96 di:  use class name, not classes themselves.
	 : dont fall into debugger in empty case"

	| className class recentList |
	recentList := RecentClasses select: [ :n | Smalltalk globals includesKey: n ].
	recentList size = 0
		ifTrue: [ ^ self inform: 'No recent classes found' ].
	className := UIManager default chooseFrom: recentList values: recentList.
	className isNil
		ifTrue: [ ^ self ].
	class := Smalltalk globals at: className.
	self selectCategoryForClass: class.
	self classListIndex: (self classList indexOf: class name)! !

!Browser methodsFor: 'message list' stamp: 'BenjaminVanRyseghem 4/24/2012 15:07'!
messageList
	"Answer an Array of the message selectors of the currently selected message category, provided that the messageCategoryListIndex is in proper range.  Otherwise, answer an empty Array  If messageCategoryListIndex is found to be larger than the number of categories (it happens!!), it is reset to zero."
	| sel |
	(sel := self messageCategoryListSelection) ifNil: [
		^ self classOrMetaClassOrganizer
			ifNil: [Array new]
			ifNotNil: [self classOrMetaClassOrganizer allMethodSelectors]
	].

	^ (self classOrMetaClassOrganizer listAtCategoryNumber: messageCategoryListIndex)
				ifNil: [messageCategoryListIndex := 0.  Array new]! !

!Browser methodsFor: 'message category list' stamp: 'AlainPlantec 8/26/2011 17:45'!
messageCategoryListIndex: anInteger
	"Set the selected message category to be the one indexed by anInteger."

	messageCategoryListIndex := anInteger.
	messageListIndex := 0.
	self changed: #messageCategorySelectionChanged.
	self changed: #messageCategoryListIndex. "update my selection"
	self changed: #messageList.
	self editSelection: (anInteger > 0
		ifTrue: [#newMessage]
		ifFalse: [self classListIndex > 0
			ifTrue: [	#editClass]
			ifFalse: [#newClass]]).
	contents := nil.
	self contentsChanged.
	self changed: #relabel.! !

!Browser methodsFor: 'message category functions' stamp: 'DamienCassou 9/29/2009 09:05'!
renameCategory
	"Prompt for a new category name and add it before the
	current selection, or at the end if no current selection"
	| oldIndex oldName newName |
	classListIndex = 0 ifTrue: [^ self].
	self okToChange ifFalse: [^ self].
	(oldIndex := messageCategoryListIndex) = 0 ifTrue: [^ self].
	oldName := self selectedMessageCategoryName.
	newName := self
		request: 'Please type new category name'
		initialAnswer: oldName.
	newName isEmptyOrNil
		ifTrue: [^ self]
		ifFalse: [newName := newName asSymbol].
	newName = oldName ifTrue: [^ self].
	self classOrMetaClassOrganizer
		renameCategory: oldName
		toBe: newName.
	self classListIndex: classListIndex.
	self messageCategoryListIndex: oldIndex.
	self changed: #messageCategoryList.
! !

!Browser methodsFor: 'initialization' stamp: 'AlainPlantec 2/25/2011 12:02'!
labelString
	self selectedClass ifNil: [ ^ self defaultBrowserTitle ].
	^ String streamContents: [ :s|
		self selectedClass printOn: s.
		self metaClassIndicated ifTrue: [ s << ' class' ].
		self selectedMessageName ifNotNil: [ :name| s << '>>' << name ]]
! !

!Browser methodsFor: 'drag and drop' stamp: 'alain.plantec 2/6/2009 16:33'!
overwriteDialogHierarchyChange: hierarchyChange higher: higherFlag sourceClassName: srcClassName destinationClassName: dstClassName methodSelector: methodSelector 
	| lf |
	lf := Character cr asString.
	^ UIManager default
				confirm: 'There is a conflict.' translated, ' Overwrite' translated, (hierarchyChange
							ifTrue: [higherFlag
									ifTrue: [' superclass' translated]
									ifFalse: [' subclass' translated]]
							ifFalse: ['']) , ' method' translated, lf , dstClassName , '>>' , methodSelector , lf , 'by ' translated, (hierarchyChange
							ifTrue: ['moving' translated]
							ifFalse: ['copying' translated]) , ' method' translated, lf , srcClassName name , '>>' , methodSelector , ' ?'.
				
! !

!Browser methodsFor: 'system category functions' stamp: 'MarcusDenker 10/7/2012 11:56'!
systemCatSingletonMenu: aMenu

	^ aMenu addList: #(
		('browse'			buildSystemCategoryBrowser)
		('fileOut'			fileOutSystemCategory)
		-
		('update'			updateSystemCategories)
		('rename...'			renameSystemCategory)
		-
		('remove'			removeSystemCategory))! !

!Browser methodsFor: 'class list' stamp: ''!
classListIndex
	"Answer the index of the current class selection."

	^classListIndex! !

!Browser methodsFor: 'metaclass' stamp: 'al 4/24/2004 11:47'!
selectedClassOrMetaClass
	"Answer the selected class/trait or metaclass/classTrait."

	| cls |
	^self metaClassIndicated
		ifTrue: [(cls := self selectedClass) ifNil: [nil] ifNotNil: [cls classSide]]
		ifFalse: [self selectedClass]! !

!Browser methodsFor: 'class functions' stamp: 'StephaneDucasse 10/27/2014 08:40'!
classListMenu: aMenu shifted: shifted
	"Set up the menu to apply to the receiver's class list, honoring the #shifted boolean"

	shifted
		ifTrue: [^ self shiftedClassListMenu: aMenu].
	aMenu addList: #(
		-
		('Browse full (b)'			browseMethodFull)
		('Browse hierarchy (h)'		spawnHierarchy)
		-
		('FileOut'					fileOutClass)
		-
		('Show hierarchy'			hierarchy)
		('Show definition'			editClass)
		('Show comment'			editComment)
		-
		('Inst var refs...'			browseInstVarRefs)
		('Inst var defs...'			browseInstVarDefs)
		-
		('Class var refs...'			browseClassVarRefs)
		('Class vars'					browseClassVariables)
		('Class refs (N)'				browseClassRefs)
		-
		('Rename class ...'			renameClass)
		('Copy class'				copyClass)
		('Remove class (x)'			removeClass)
		-
		('Find method...'				findMethod)
		('Find method wildcard...'	findMethodWithWildcard)
		-
		('More...'					offerShiftedClassListMenu)).
	^ aMenu
! !

!Browser methodsFor: 'message category list' stamp: 'BenjaminVanRyseghem 4/24/2012 15:00'!
messageCategoryList
	"Answer the selected category of messages."

	classListIndex = 0
		ifTrue: [^ Array new]
		ifFalse: [^ self classOrMetaClassOrganizer categoriesSorted ]! !

!Browser methodsFor: 'metaclass' stamp: 'sd 11/20/2005 21:26'!
metaClassIndicated: trueOrFalse 
	"Indicate whether browsing instance or class messages."

	metaClassIndicated := trueOrFalse.
	self setClassOrganizer.
	systemCategoryListIndex > 0 ifTrue:
		[self editSelection: (classListIndex = 0
			ifTrue: [metaClassIndicated
				ifTrue: [#none]
				ifFalse: [#newClass]]
			ifFalse: [#editClass])].
	messageCategoryListIndex := 0.
	messageListIndex := 0.
	contents := nil.
	self changed: #classSelectionChanged.
	self changed: #messageCategoryList.
	self changed: #messageList.
	self changed: #contents.
	self changed: #annotation.
	self decorateButtons
! !

!Browser methodsFor: 'accessing' stamp: ''!
editSelection
	^editSelection! !

!Browser methodsFor: 'metaclass' stamp: 'AlainPlantec 8/26/2011 17:56'!
indicateInstanceMessages
	"Indicate that the message selection should come from the class (instance) 
	messages."

	self metaClassIndicated: false! !

!Browser methodsFor: '*Shout-Styling' stamp: 'AlainPlantec 8/27/2011 00:52'!
shoutAboutToStyle: aPluggableShoutMorphOrView 
	| type |
	self shoutIsModeStyleable
		ifFalse: [^ false].
	type := self editSelection.
	(#(#newMessage #editMessage #editClass #newClass ) includes: type)
		ifFalse: [^ false].
	aPluggableShoutMorphOrView
		classOrMetaClass: (type = #editClass
				ifFalse: [self selectedClassOrMetaClass]).
	^ true! !

!Browser methodsFor: 'message category list' stamp: 'ccn 3/24/1999 11:02'!
messageCategoryListSelection
	"Return the selected category name or nil."

	^ ((self messageCategoryList size = 0 
		or: [self messageCategoryListIndex = 0]) 
		or: [self messageCategoryList size < self messageCategoryListIndex])
			ifTrue: [nil]
			ifFalse: [self messageCategoryList at: (self messageCategoryListIndex max: 1)]! !

!Browser methodsFor: 'message functions' stamp: 'MarcusDenker 7/28/2014 21:10'!
shiftedMessageListMenu: aMenu
	"Fill aMenu with the items appropriate when the shift key is held down"

	aMenu addStayUpItem.
	aMenu addList: #(
		('Toggle diffing (D)'						toggleDiffing)
		-
		('Inspect instances'						inspectInstances)
		('Inspect subinstances'					inspectSubInstances)).

	self addExtraShiftedItemsTo: aMenu.
	aMenu addList: #(
		-
		('Change category...'					changeCategory)).

	self canShowMultipleMessageCategories ifTrue: [aMenu addList:
		 #(('Show category (C)'						showHomeCategory))].
	aMenu addList: #(
		-
		('More...' 								unshiftedYellowButtonActivity)).
	^ aMenu
! !

!Browser methodsFor: 'system category list' stamp: 'AlainPlantec 8/26/2011 17:42'!
systemCategoryListIndex: anInteger 
	"Set the selected system category index to be anInteger. Update all other 
	selections to be deselected."

	systemCategoryListIndex := anInteger.
	classListIndex := 0.
	messageCategoryListIndex := 0.
	messageListIndex := 0.
	self editSelection: ( anInteger = 0 ifTrue: [#none] ifFalse: [#newClass]).
	metaClassIndicated := false.
	self setClassOrganizer.
	contents := nil.
	self changed: #systemCategorySelectionChanged.
	self changed: #systemCategoryListIndex.	"update my selection"
	self changed: #classList.
	self changed: #messageCategoryList.
	self changed: #messageList.
	self changed: #relabel.
	self contentsChanged! !

!Browser methodsFor: 'system category functions' stamp: 'di 4/12/98 13:17'!
updateSystemCategories
	"The class categories were changed in another browser. The receiver must 
	reorganize its lists based on these changes."

	self okToChange ifFalse: [^ self].
	self changed: #systemCategoryList! !

!Browser methodsFor: 'class comment pane' stamp: 'AlainPlantec 8/26/2011 21:24'!
noCommentNagString

	^ 'Unfortunately this class has not been documented yet. The class comment should describe the purpose of the class, its collaborations and its variables. We encourage you to fill up the following template.

Class intention
	I m doing the following ...

Class collaborations
	I usually do not work in isolation but with the help of ...

Class main API
	My main public API is ...My subclasses may want to override such specific hooks ...
Implementation notes
' translated asText
		! !

!Browser methodsFor: 'construction' stamp: 'AlainPlantec 11/17/2010 11:35'!
addLowerPanesTo: window at: nominalFractions with: editString
	| commentPane |
	super addLowerPanesTo: window at: nominalFractions with: editString.
	commentPane := self buildMorphicCommentPane.
	window addMorph: commentPane fullFrame: commentPane defaultLayoutFrame.
	self changed: #editSelection.! !

!Browser methodsFor: 'message category functions' stamp: 'MarcusDenker 10/7/2012 12:01'!
messageCategoryMenu: aMenu
	^ aMenu addList: #(
		('Browse'								buildMessageCategoryBrowser)
		('FileOut'								fileOutMessageCategories)
		('Reorganize'							editMessageCategories)
		-
		('Alphabetize'							alphabetizeMessageCategories)
		('Remove empty categories'			removeEmptyCategories)
		('Categorize all uncategorized'			categorizeAllUncategorizedMethods)
		('New Category...'						addCategory)
		('Rename...'								renameCategory)
		-
		('Remove'								removeMessageCategory))
! !

!Browser methodsFor: 'system category functions' stamp: 'DamienCassou 9/29/2009 09:04'!
addSystemCategory
	"Prompt for a new category name and add it before the
	current selection, or at the end if no current selection"
	| oldIndex newName |
	self okToChange ifFalse: [^ self].
	oldIndex := systemCategoryListIndex.
	newName := self
		request: 'Please type new category name'
		initialAnswer: 'Category-Name'.
	newName isEmptyOrNil
		ifTrue: [^ self]
		ifFalse: [newName := newName asSymbol].
	systemOrganizer
		addCategory: newName
		before: (systemCategoryListIndex = 0
				ifTrue: [nil]
				ifFalse: [self selectedSystemCategoryName]).
	self systemCategoryListIndex:
		(oldIndex = 0
			ifTrue: [self systemCategoryList size]
			ifFalse: [oldIndex]).
	self changed: #systemCategoryList.! !

!Browser methodsFor: 'system category list' stamp: 'tk 5/4/1998 15:46'!
indexIsOne
	"When used as a singleton list, index is always one"
	^ 1! !

!Browser methodsFor: 'message category list' stamp: 'nk 6/13/2004 06:20'!
selectMessageCategoryNamed: aSymbol 
	"Given aSymbol, select the category with that name.  Do nothing if 
	aSymbol doesn't exist."
	self messageCategoryListIndex: (self messageCategoryList indexOf: aSymbol ifAbsent: [ 1])! !

!Browser methodsFor: 'metaclass' stamp: 'mir 9/25/2008 14:56'!
classMessagesIndicated
	"Answer whether the messages to be presented should come from the metaclass."

	^ self metaClassIndicated and: [self classCommentIndicated not]! !

!Browser methodsFor: 'metaclass' stamp: 'di 1/14/98 12:25'!
classCommentIndicated
	"Answer true iff we're viewing the class comment."

	^ editSelection == #editComment 
! !

!Browser methodsFor: 'class functions' stamp: 'nk 2/14/2004 15:07'!
makeNewSubclass

	self selectedClassOrMetaClass ifNil: [^ self].
	self okToChange ifFalse: [^ self].
	self editSelection: #newClass.
	self contentsChanged! !

!Browser methodsFor: 'class functions' stamp: 'AlainPlantec 8/26/2011 21:23'!
classCommentText
	"return the text to display for the comment of the currently selected class"
	| theClass |
	theClass := self selectedClassOrMetaClass.
	theClass ifNil: [ ^''].

	^ theClass hasComment
		ifTrue: [ theClass comment]
		ifFalse: [ self noCommentNagString ]! !

!Browser methodsFor: 'message category list' stamp: 'EstebanLorenzano 6/26/2013 18:08'!
selectOriginalCategoryForCurrentMethod
	"private - Select the message category for the current method. 
	 
	 Note:  This should only be called when somebody tries to save  
	 a method that they are modifying while ALL is selected. 
	 
	 Returns: true on success, false on failure."
	| aSymbol selectorName |
	aSymbol := self categoryOfCurrentMethod.
	selectorName := self selectedMessageName.
	(aSymbol notNil and: [aSymbol ~= AllProtocol defaultName ])
		ifTrue: 
			[messageCategoryListIndex := (self messageCategoryList indexOf: aSymbol).
			messageListIndex := (self messageList indexOf: selectorName).
			self changed: #messageCategorySelectionChanged.
			self changed: #messageCategoryListIndex.	"update my selection"
			self changed: #messageList.
			self changed: #messageListIndex.
			^ true].
	^ false! !

!Browser methodsFor: 'accessing' stamp: 'nice 3/31/2011 22:34'!
doItReceiver
	"This class's classPool has been jimmied to be the classPool of the class 
	being browsed. A doIt in the code pane will let the user see the value of 
	the class variables."

	^ self selectedClass! !

!Browser methodsFor: 'class comment pane' stamp: 'JB 2/12/2010 15:22'!
classComment: aText notifying: aPluggableTextMorph 
	"The user has just entered aText.
	It may be all red (a side-effect of replacing the default comment), so remove the color if it is."

	| theClass cleanedText redRange |
	theClass := self selectedClassOrMetaClass.
	theClass
		ifNotNil: [cleanedText := aText asText.
			redRange := cleanedText rangeOf: TextColor red startingAt: 1.
			redRange size = cleanedText size
				ifTrue: [cleanedText
						removeAttribute: TextColor red
						from: 1
						to: redRange last ].
			theClass comment: aText stamp: Author changeStamp].
	self changed: #classCommentText.
	^ true! !

!Browser methodsFor: 'initialization' stamp: 'rr 6/21/2005 13:24'!
addMorphicSwitchesTo: window at: aLayoutFrame

	window 
		addMorph: self buildMorphicSwitches
		fullFrame: aLayoutFrame.

! !

!Browser methodsFor: 'initialization' stamp: 'sw 9/22/1999 17:13'!
methodCategoryChanged
	self changed: #messageCategoryList.
	self changed: #messageList.
	self changed: #annotation.
	self messageListIndex: 0! !

!Browser methodsFor: 'class list' stamp: 'sr 10/29/1999 20:28'!
selectClass: classNotMeta
	self classListIndex: (self classList indexOf: classNotMeta name)! !

!Browser methodsFor: 'initialization' stamp: 'sd 11/20/2005 21:26'!
systemOrganizer: aSystemOrganizer
	"Initialize the receiver as a perspective on the system organizer, 
	aSystemOrganizer. Typically there is only one--the system variable 
	SystemOrganization."
	
	contents := nil.
	systemOrganizer := aSystemOrganizer.
	systemCategoryListIndex := 0.
	classListIndex := 0.
	messageCategoryListIndex := 0.
	messageListIndex := 0.
	metaClassIndicated := false.
	self setClassOrganizer.
	self editSelection: #none.! !

!Browser methodsFor: 'system category functions' stamp: 'DamienCassou 9/29/2009 09:05'!
renameSystemCategory
	"Prompt for a new category name and add it before the
	current selection, or at the end if no current selection"
	| oldIndex oldName newName |
	(oldIndex := systemCategoryListIndex) = 0
		ifTrue: [^ self].  "no selection"
	self okToChange ifFalse: [^ self].
	oldName := self selectedSystemCategoryName.
	newName := self
		request: 'Please type new category name'
		initialAnswer: oldName.
	newName isEmptyOrNil 
		ifTrue: [^ self]
		ifFalse: [newName := newName asSymbol].
	oldName = newName ifTrue: [^ self].
	systemOrganizer
		renameCategory: oldName
		toBe: newName.
	self systemCategoryListIndex: oldIndex.
	self changed: #systemCategoryList.! !

!Browser methodsFor: 'message category list' stamp: ''!
messageCategoryListIndex
	"Answer the index of the selected message category."

	^messageCategoryListIndex! !

!Browser methodsFor: 'message functions' stamp: 'MarcusDenker 10/13/2013 07:59'!
removeMessage
	"If a message is selected, create a Confirmer so the user can verify that  
	the currently selected message should be removed from the system. If 
	so, remove it. "
	| messageName confirmation |
	messageListIndex = 0
		ifTrue: [^ self].
	self okToChange
		ifFalse: [^ self].
	messageName := self selectedMessageName.
	confirmation := self systemNavigation   confirmRemovalOf: messageName on: self selectedClassOrMetaClass.
	confirmation = 3
		ifTrue: [^ self].
	(self selectedClassOrMetaClass includesLocalSelector: messageName)
		ifTrue: [self selectedClassOrMetaClass removeSelector: messageName]
		ifFalse: [self removeNonLocalSelector: messageName].
	self messageListIndex: 0.
	self changed: #messageList.
	self setClassOrganizer.
	"In case organization not cached"
	confirmation = 2
		ifTrue: [self systemNavigation browseAllSendersOf: messageName]! !

!Browser methodsFor: 'class functions' stamp: 'StephaneDucasse 5/13/2010 11:43'!
createInstVarAccessors
	"Create getters and setters for all inst vars defined at the level of the current class selection, except do NOT clobber or override any selectors already understood by the instances of the selected class"

	| aClass |
	(aClass := self selectedClassOrMetaClass) ifNotNil:
		[aClass instVarNames do: 
			[:aName | | setter newMessage |
				(aClass canUnderstand: aName asSymbol)
					ifFalse:
						[newMessage := aName, '

	^ ', aName.
						aClass compile: newMessage classified: 'accessing' notifying: nil].
				(aClass canUnderstand: (setter := aName, ':') asSymbol)
					ifFalse:
						[newMessage := setter, ' anObject

	', aName, ' := anObject'.
						aClass compile: newMessage classified: 'accessing' notifying: nil]]]! !

!Browser methodsFor: 'class functions' stamp: 'StephaneDucasse 12/5/2009 21:25'!
addAllMethodsToCurrentChangeSet
	"Add all the methods in the selected class or metaclass to the current change set.  You ought to know what you're doing before you invoke this!!"

	| aClass |
	(aClass := self selectedClassOrMetaClass) ifNotNil:
		[aClass selectorsDo:
			[:sel |
				ChangeSet current adoptSelector: sel forClass: aClass].
		self changed: #annotation]
! !

!Browser methodsFor: 'class functions' stamp: 'MarcusDenker 3/5/2010 14:30'!
findMethod
	"Pop up a list of the current class's methods, and select the one chosen by the user"

	| aClass selectors reply cat messageCatIndex messageIndex choices |
	self classListIndex = 0 ifTrue: [^ self].
	self okToChange ifFalse: [^ self].
	aClass := self selectedClassOrMetaClass.
	selectors := aClass selectors sort.
	selectors isEmpty ifTrue: [self inform: aClass name, ' has no methods.' translated. ^ self].
	choices := (Array with: 'Enter Wildcard' translated), selectors.
	reply := UIManager default chooseFrom: choices lines: #(1).
	reply = 0 ifTrue: [^self].
	reply = 1
		ifTrue: [
			reply := UIManager default request: 'Enter partial method name:' translated.
			(reply isNil or: [reply isEmpty])
				ifTrue: [^self].
			(reply includes: $*)
				ifFalse: [reply := '*', reply, '*'].
			selectors := selectors select: [:each | reply match: each].
			selectors isEmpty ifTrue: [self inform: aClass name, ' has no matching methods.' translated. ^ self].
			reply := selectors size = 1
				ifTrue: [selectors first]
				ifFalse: [	UIManager default chooseFrom: selectors values: selectors].
			reply isNil ifTrue: [^self]]
		ifFalse: [reply := choices at: reply].

	cat := aClass whichCategoryIncludesSelector: reply.
	messageCatIndex := self messageCategoryList indexOf: cat.
	self messageCategoryListIndex: messageCatIndex.
	messageIndex := (self messageList indexOf: reply).
	self messageListIndex: messageIndex! !

!Browser methodsFor: 'annotation' stamp: 'sd 11/20/2005 21:26'!
annotation
	"Provide a line of content for an annotation pane, representing information about the method associated with the selected class and selector in the receiver."

	|  aSelector aClass |
	(aClass := self selectedClassOrMetaClass) == nil ifTrue: [^ '------'].
	self editSelection == #editComment ifTrue:
		[^ self annotationForSelector: #Comment ofClass: aClass].

	self editSelection == #editClass ifTrue:
		[^ self annotationForSelector: #Definition ofClass: aClass].
	(aSelector := self selectedMessageName) ifNil: [^ '------'].
	^ self annotationForSelector: aSelector ofClass: aClass! !

!Browser methodsFor: 'message list' stamp: 'MarcusDenker 4/28/2013 21:32'!
selectedMessage
	"Answer a copy of the source code for the selected message."

	| class selector method |
	contents == nil ifFalse: [^ contents copy].

	class := self selectedClassOrMetaClass.
	selector := self selectedMessageName.
	method := class compiledMethodAt: selector ifAbsent: [^ ''].	"method deleted while in another project"
	currentCompiledMethod := method.
	^ contents :=  self sourceStringPrettifiedAndDiffed
	! !

!Browser methodsFor: 'class list' stamp: 'sd 11/20/2005 21:26'!
selectedClassName
	| aClassList |
	"Answer the name of the current class. Answer nil if no selection exists."

	(classListIndex = 0 or: [classListIndex > (aClassList := self classList) size]) ifTrue: [^ nil].
	^ aClassList at: classListIndex! !

!Browser methodsFor: 'message functions' stamp: 'sw 1/11/2001 07:22'!
addExtraShiftedItemsTo: aMenu
	"The shifted selector-list menu is being built; some menu items are appropriate only for certain kinds of browsers, and this gives a hook for them to be added as approrpiate.  If any is added here, a line should be added first -- browse reimplementors of this message for examples."
! !

!Browser methodsFor: 'code pane' stamp: 'EstebanLorenzano 6/26/2013 18:08'!
compileMessage: aText notifying: aController
	"Compile the code that was accepted by the user, placing the compiled method into an appropriate message category.  Return true if the compilation succeeded, else false."

	| fallBackCategoryIndex fallBackMethodIndex originalSelectorName result |

	self selectedMessageCategoryName ifNil:
			[ self selectOriginalCategoryForCurrentMethod 	
										ifFalse:["Select the '--all--' category"
											self messageCategoryListIndex: 1]]. 


	self selectedMessageCategoryName asSymbol = AllProtocol defaultName
		ifTrue:
			[ "User tried to save a method while the ALL category was selected"
			fallBackCategoryIndex := messageCategoryListIndex.
			fallBackMethodIndex := messageListIndex.
			editSelection == #newMessage
				ifTrue:
					[ "Select the 'as yet unclassified' category"
					messageCategoryListIndex := 0.
					(result := self defineMessageFrom: aText notifying: aController)
						ifNil:
							["Compilation failure:  reselect the original category & method"
							messageCategoryListIndex := fallBackCategoryIndex.
							messageListIndex := fallBackMethodIndex]
						ifNotNil:
							[self setSelector: result]]
				ifFalse:
					[originalSelectorName := self selectedMessageName.
					self setOriginalCategoryIndexForCurrentMethod.
					messageListIndex := fallBackMethodIndex := self messageList indexOf: originalSelectorName.			
					(result := self defineMessageFrom: aText notifying: aController)
						ifNotNil:
							[self setSelector: result]
						ifNil:
							[ "Compilation failure:  reselect the original category & method"
							messageCategoryListIndex := fallBackCategoryIndex.
							messageListIndex := fallBackMethodIndex.
							^ result notNil]].
			self changed: #messageCategoryList.
			^ result notNil]
		ifFalse:
			[ "User tried to save a method while the ALL category was NOT selected"
			^ (self defineMessageFrom: aText notifying: aController) notNil]! !

!Browser methodsFor: 'drag and drop' stamp: 'MarcusDenker 9/28/2013 13:47'!
changeCategoryForClass: class srcSystemCategory: srcSystemCategorySel atListMorph: dstListMorph internal: internal copy: copyFlag
	"only move semantic"

	| newClassCategory success |
	self flag: #stringSymbolProblem.
	success := copyFlag
		ifTrue: [ ^ false ].
	newClassCategory := self dstCategoryDstListMorph: dstListMorph.
	(success := newClassCategory notNil & (newClassCategory ~= class category))
		ifTrue: [ 
			class category: newClassCategory.
			self changed: #classList.
			internal
				ifFalse: [ self selectClass: class ] ].
	^ success! !

!Browser methodsFor: 'message category functions' stamp: ''!
buildMessageCategoryBrowser
	"Create and schedule a message category browser for the currently 
	selected message category."

	self buildMessageCategoryBrowserEditString: nil! !

!Browser methodsFor: 'message category functions' stamp: 'MarcusDenker 2/17/2012 15:52'!
buildMessageCategoryBrowserEditString: aString 
	"Create and schedule a message category browser for the currently 
	selected message category. The initial text view contains the characters 
	in aString."

	| newBrowser |
	messageCategoryListIndex ~= 0
		ifTrue: 
			[newBrowser := self class new.
			newBrowser systemCategoryListIndex: systemCategoryListIndex.
			newBrowser classListIndex: (newBrowser classList indexOf: self selectedClassName).
			newBrowser metaClassIndicated: metaClassIndicated.
			newBrowser messageCategoryListIndex: messageCategoryListIndex.
			newBrowser messageListIndex: messageListIndex.
			self class openBrowserView: (newBrowser openMessageCatEditString: aString)
				label: 'Message Category Browser (' , 
						newBrowser selectedClassOrMetaClassName , ')']! !

!Browser methodsFor: 'initialization' stamp: 'alain.plantec 6/10/2008 18:33'!
openEditString: aString
        "Create a pluggable version of all the views for a Browser, including views and controllers."
         ^ self openAsMorphEditing: aString! !

!Browser methodsFor: 'traits' stamp: 'al 4/24/2004 11:48'!
newTrait
	self classListIndex: 0.
	self editClass.
	editSelection := #newTrait.
	self contentsChanged! !

!Browser methodsFor: 'drag and drop' stamp: 'MarcusDenker 9/28/2013 13:47'!
message: messageSel compileInClass: dstClassOrMeta fromClass: srcClassOrMeta dstMessageCategory: dstMessageCategorySel srcMessageCategory: srcMessageCategorySel internal: internal copySemantic: copyFlag
	| source messageCategorySel tm success oldOrNoMethod newMethod |
	source := srcClassOrMeta sourceCodeAt: messageSel.
	messageCategorySel := dstMessageCategorySel ifNil: [ srcMessageCategorySel ].
	self selectClass: dstClassOrMeta theNonMetaClass.
	(self messageCategoryList includes: messageCategorySel)
		ifFalse: [ 
			"create message category"
			self classOrMetaClassOrganizer addCategory: messageCategorySel ].
	self selectMessageCategoryNamed: messageCategorySel.
	tm := self codeTextMorph.
	tm setText: source.
	tm setSelection: (0 to: 0).
	tm hasUnacceptedEdits: true.
	oldOrNoMethod := srcClassOrMeta compiledMethodAt: messageSel ifAbsent: [  ].
	tm accept.	"compilation successful?"
	newMethod := dstClassOrMeta compiledMethodAt: messageSel ifAbsent: [  ].
	success := newMethod ~~ nil & (newMethod ~~ oldOrNoMethod).	"	success ifFalse: [TransferMorph allInstances do: [:e | e delete]].            
	 "
	success
		ifTrue: [ 
			copyFlag
				ifFalse: [ 
					"remove old method in move semantic if new exists"
					srcClassOrMeta removeSelector: messageSel ].
			internal
				ifTrue: [ self selectClass: srcClassOrMeta ]
				ifFalse: [ self selectClass: dstClassOrMeta ].
			self setSelector: messageSel ].
	^ success! !

!Browser methodsFor: 'message category list' stamp: 'sd 11/20/2005 21:26'!
messageCatListSingleton

	| name |
	name := self selectedMessageCategoryName.
	^ name ifNil: [Array new]
		ifNotNil: [Array with: name]! !

!Browser methodsFor: 'initialization' stamp: 'alain.plantec 5/15/2009 09:36'!
buildMorphicSystemCatList
	| dragNDropFlag myCatList |
	dragNDropFlag := true.
	(myCatList := PluggableListMorph new) 
			on: self list: #systemCategoryList
			selected: #systemCategoryListIndex changeSelected: #systemCategoryListIndex:
			menu: #systemCategoryMenu: keystroke: #systemCatListKey:from:.
	myCatList enableDragNDrop: dragNDropFlag.
	^myCatList
! !

!Browser methodsFor: 'drag and drop' stamp: 'MarcusDenker 6/27/2014 17:04'!
dragPassengerFor: item inMorph: dragSource 
	| transferType smn |
	(dragSource isKindOf: PluggableListMorph)
		ifFalse: [^nil].
	transferType := self dragTransferTypeForMorph: dragSource.
	transferType == #classList
		ifTrue: [^self selectedClass].
	transferType == #messageList
		ifFalse: [ ^nil ].
	smn := self selectedMessageName ifNil: [ ^nil ].
	(#(Comment Definition Hierarchy) includes: smn) ifTrue: [ ^nil ].

	^ self selectedClassOrMetaClass -> smn.
! !

!Browser methodsFor: 'initialization' stamp: 'sw 1/13/2000 16:45'!
defaultBrowserTitle
	^ 'System Browser'! !

!Browser methodsFor: 'message list' stamp: 'sd 11/20/2005 21:26'!
selectedMessageName: aSelector
	"Make the given selector be the selected message name"

	| anIndex |
	anIndex := self messageList indexOf: aSelector.
	anIndex > 0 ifTrue:
		[self messageListIndex: anIndex]! !

!Browser methodsFor: 'class functions' stamp: 'nk 2/14/2004 15:09'!
hierarchy
	"Display the inheritance hierarchy of the receiver's selected class."

	classListIndex = 0 ifTrue: [^ self].
	self okToChange ifFalse: [^ self].
	self messageCategoryListIndex: 0.
	self editSelection: #hierarchy.
	self changed: #editComment.
	self contentsChanged.
	^ self! !

!Browser methodsFor: 'class list' stamp: 'sd 11/20/2005 21:26'!
selectedClass
	"Answer the class that is currently selected. Answer nil if no selection 
	exists."

	| name envt |
	(name := self selectedClassName) ifNil: [^ nil].
	(envt := self selectedEnvironment) ifNil: [^ nil].
	^ envt at: name! !

!Browser methodsFor: 'class list' stamp: 'AlainPlantec 8/26/2011 17:54'!
classListIndex: anInteger 
	"Set anInteger to be the index of the current class selection."

	| className |
	classListIndex := anInteger.
	self setClassOrganizer.
	messageCategoryListIndex := 0.
	messageListIndex := 0.
	self classCommentIndicated
		ifTrue: []
		ifFalse: [self editSelection: (anInteger = 0
					ifTrue: [metaClassIndicated | (systemCategoryListIndex = 0)
						ifTrue: [#none]
						ifFalse: [#newClass]]
					ifFalse: [#editClass])].
	contents := nil.
	self selectedClass isNil
		ifFalse: [className := self selectedClass name.
					(RecentClasses includes: className)
				ifTrue: [RecentClasses remove: className].
			RecentClasses addFirst: className.
			RecentClasses size > 16
				ifTrue: [RecentClasses removeLast]].
	self changed: #classSelectionChanged.
	self changed: #classCommentText.
	self changed: #classListIndex.	"update my selection"
	self changed: #messageCategoryList.
	self changed: #messageList.
	self changed: #relabel.
	self contentsChanged! !

!Browser methodsFor: 'class list' stamp: 'sd 11/20/2005 21:26'!
classListSingleton

	| name |
	name := self selectedClassName.
	^ name ifNil: [Array new]
		ifNotNil: [Array with: name]! !

!Browser methodsFor: 'metaclass' stamp: 'di 1/14/98 13:20'!
instanceMessagesIndicated
	"Answer whether the messages to be presented should come from the 
	class."

	^metaClassIndicated not and: [self classCommentIndicated not]! !

!Browser methodsFor: 'system category functions' stamp: 'brp 8/4/2003 21:38'!
alphabetizeSystemCategories

	self okToChange ifFalse: [^ false].
	systemOrganizer sortCategories.
	self systemCategoryListIndex: 0.
	self changed: #systemCategoryList.
! !

!Browser methodsFor: 'drag and drop' stamp: 'EstebanLorenzano 6/26/2013 18:09'!
dstMessageCategoryDstListMorph: dstListMorph
	| dropItem |
	^dstListMorph getListSelector == #messageCategoryList
		ifTrue: 
			[dropItem := dstListMorph potentialDropItem.
			dropItem ifNotNil: [dropItem asSymbol]]
		ifFalse: [self selectedMessageCategoryName ifNil: [ Protocol unclassified ]]! !

!Browser methodsFor: 'message category list' stamp: 'GabrielOmarCotelli 11/30/2013 16:21'!
categorizeAllUncategorizedMethods
	"Categorize methods by looking in parent classes for a method category."

	| organizer organizers |
	organizer := self classOrMetaClassOrganizer.
	organizers := self selectedClassOrMetaClass withAllSuperclasses collect: [ :ea | ea organization ].
	(organizer listAtCategoryNamed: Protocol unclassified)
		do: [ :sel | 
			(organizers collect: [ :org | org categoryOfElement: sel ])
				detect: [ :ea | ea ~= Protocol unclassified and: [ ea ~= nil ] ]
				ifFound: [ :found | organizer classify: sel under: found ] ].
	self changed: #messageCategoryList! !

!Browser methodsFor: 'message list' stamp: 'AlainPlantec 8/26/2011 17:52'!
messageListIndex: anInteger
	"Set the selected message selector to be the one indexed by anInteger."

	messageListIndex := anInteger.
	self editSelection: (anInteger > 0
		ifTrue: [#editMessage]
		ifFalse: [self messageCategoryListIndex > 0
			ifTrue: [#newMessage]
			ifFalse: [self classListIndex > 0
				ifTrue: [#editClass]
				ifFalse: [#newClass]]]).
	contents := nil.
	self changed: #messageListIndex. "update my selection"
	self contentsChanged.
	self decorateButtons.
	self changed: #relabel.! !

!Browser methodsFor: 'initialization' stamp: 'tbn 8/1/2010 14:06'!
buildMorphicSwitches

	| instanceSwitch commentSwitch classSwitch row |

	instanceSwitch := PluggableButtonMorph
		on: self
		getState: #instanceMessagesIndicated
		action: #indicateInstanceMessages.
	instanceSwitch
		label: 'Instance';
		askBeforeChanging: true;
		setBalloonText: 'Display instance side';
		borderWidth: 1;
		borderColor: Color gray.
	commentSwitch := PluggableButtonMorph
		on: self
		getState: #classCommentIndicated
		action: #plusButtonHit.
		
	commentSwitch
		label: '?' asText allBold;
		askBeforeChanging: true;
		setBalloonText: 'Cycle among definition, comment, and hierachy';
		borderWidth: 1;
		borderColor: Color gray.
	classSwitch := PluggableButtonMorph
		on: self
		getState: #classMessagesIndicated
		action: #indicateClassMessages.
	classSwitch
		label: 'Class';
		askBeforeChanging: true;
		setBalloonText: 'Display class side';		
		borderWidth: 1;
		borderColor: Color gray.
	row := AlignmentMorph newRow
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		cellInset: 0;
		borderWidth: 0;
		layoutInset: 0;
		addMorphBack: instanceSwitch;
		addMorphBack: commentSwitch;
		addMorphBack: classSwitch.

	row color: Color white.
	{instanceSwitch. commentSwitch. classSwitch} do: [:m | 
		m 
			color: Color transparent;
			hResizing: #spaceFill;
			vResizing: #spaceFill.].
	^OverflowRowMorph new
		baseMorph: row;
		height: row minExtent y
! !

!Browser methodsFor: 'drag and drop' stamp: 'nice 10/22/2009 15:13'!
acceptMethod: methodSel dstMessageCategory: dstMessageCategorySel srcMessageCategory: srcMessageCategorySel dstClass: dstClass dstClassOrMeta: dstClassOrMeta srcClassOrMeta: srcClassOrMeta internal: internal copySemantic: copyFlag 
	| success hierarchyChange higher checkForOverwrite |
	(success := dstClassOrMeta ~~ nil) ifFalse: [^false].
	checkForOverwrite := dstClassOrMeta includesSelector: methodSel.
	hierarchyChange := (higher := srcClassOrMeta inheritsFrom: dstClassOrMeta) | (dstClassOrMeta inheritsFrom: srcClassOrMeta).
	success := (checkForOverwrite not
				or: [self
						overwriteDialogHierarchyChange: hierarchyChange
						higher: higher
						sourceClassName: srcClassOrMeta name
						destinationClassName: dstClassOrMeta name
						methodSelector: methodSel])
				and: [self
						message: methodSel
						compileInClass: dstClassOrMeta
						fromClass: srcClassOrMeta
						dstMessageCategory: dstMessageCategorySel
						srcMessageCategory: srcMessageCategorySel
						internal: internal
						copySemantic: copyFlag].
	^ success! !

!Browser methodsFor: 'traits' stamp: 'al 4/24/2004 11:48'!
newClass
	(self selectedClassOrMetaClass notNil and: 
		[self selectedClassOrMetaClass isTrait]) ifTrue: [self classListIndex: 0].
	self editClass.
	editSelection := #newClass.
	self contentsChanged! !

!Browser methodsFor: 'system category functions' stamp: 'di 4/12/98 13:55'!
removeSystemCategory
	"If a class category is selected, create a Confirmer so the user can 
	verify that the currently selected class category and all of its classes
 	should be removed from the system. If so, remove it."

	systemCategoryListIndex = 0 ifTrue: [^ self].
	self okToChange ifFalse: [^ self].
	(self classList size = 0
		or: [self confirm: 'Are you sure you want to
remove this system category 
and all its classes?'])
		ifTrue: 
		[systemOrganizer removeSystemCategory: self selectedSystemCategoryName.
		self systemCategoryListIndex: 0.
		self changed: #systemCategoryList]! !

!Browser methodsFor: 'class functions' stamp: 'sd 11/20/2005 21:26'!
editComment
	"Retrieve the description of the class comment."

	classListIndex = 0 ifTrue: [^ self].
	self okToChange ifFalse: [^ self].
	self messageCategoryListIndex: 0.
	metaClassIndicated := false.
	self editSelection: #editComment.
	self changed: #classSelectionChanged.
	self changed: #messageCategoryList.
	self changed: #messageList.
	self decorateButtons.
	self contentsChanged
! !

!Browser methodsFor: 'initialization' stamp: 'sd 11/20/2005 21:26'!
setClass: aBehavior selector: aSymbol
	"Set the state of a new, uninitialized Browser."

	| isMeta aClass messageCatIndex |
	aBehavior ifNil: [^ self].
	(aBehavior isKindOf: Metaclass)
		ifTrue: [
			isMeta := true.
			aClass := aBehavior soleInstance]
		ifFalse: [
			isMeta := false.
			aClass := aBehavior].
	self selectCategoryForClass: aClass.
	self classListIndex: (
		(systemOrganizer listAtCategoryNamed: self selectedSystemCategoryName)
			indexOf: aClass name).
	self metaClassIndicated: isMeta.
	aSymbol ifNil: [^ self].
	messageCatIndex := aBehavior organization numberOfCategoryOfElement: aSymbol.
	self messageCategoryListIndex: (messageCatIndex > 0
		ifTrue: [messageCatIndex + 1]
		ifFalse: [0]).
	messageCatIndex = 0 ifTrue: [^ self].
	self messageListIndex: (
		(aBehavior organization listAtCategoryNumber: messageCatIndex)
			indexOf: aSymbol).! !

!Browser methodsFor: 'class functions' stamp: 'nk 2/15/2004 13:23'!
editClass
	"Retrieve the description of the class definition."

	classListIndex = 0 ifTrue: [^ self].
	self okToChange ifFalse: [^ self].
	self messageCategoryListIndex: 0.
	self editSelection: #editClass.
	self changed: #contents.
	self changed: #classCommentText.
! !

!Browser methodsFor: 'initialization' stamp: 'MarcusDenker 9/30/2013 20:03'!
openAsMorphEditing: editString
	"Create a pluggable version of all the morphs for a Browser in Morphic"
	| window hSepFrac |

	hSepFrac := 0.4.
	window := (SystemWindow labelled: 'later') model: self.

		
	window 
		addMorph: self buildMorphicSystemCatList
		frame: (0@0 corner: 0.25@hSepFrac).
		
	self 
		addClassAndSwitchesTo: window 
		at: (0.25@0 corner: 0.5@hSepFrac)
		plus: 0.
		
	window 
		addMorph: self buildMorphicMessageCatList
		frame: (0.5@0 extent: 0.25@hSepFrac).
		
	window addMorph: self buildMorphicMessageList
		frame: (0.75@0 extent: 0.25@hSepFrac).

	self 
			addLowerPanesTo: window 
			at: (0@hSepFrac corner: 1@1) 
			with: editString.

	window setUpdatablePanesFrom: #(systemCategoryList classList messageCategoryList messageList).
	^ window! !

!Browser methodsFor: 'class functions' stamp: 'MartinDias 6/24/2013 15:27'!
copyClass
	| copysName nameOk |
	classListIndex = 0
		ifTrue: [^ self].
	self okToChange 
		ifFalse: [^ self].
	copysName := self request: 'Please type new class name' initialAnswer: self selectedClass name.
	copysName isEmptyOrNil
		ifTrue: [^ self].
	nameOk := [self selectedClass classBuilder validateClassName: copysName asSymbol] 
		on: Error 
		do: [ :ex | ^ self inform: ex printString].
	nameOk
		ifTrue: [
		"Cancel returns ''"
		self selectedClass duplicateClassWithNewName: copysName.
		self classListIndex: 0.
		self changed: #classList]! !

!Browser methodsFor: 'initialization' stamp: 'alain.plantec 6/10/2008 18:34'!
openMessageCatEditString: aString
        "Create a pluggable version of the views for a Browser that just shows one message category."
         ^ self openAsMorphMsgCatEditing: aString! !

!Browser methodsFor: 'class functions' stamp: 'MarcusDenker 6/14/2014 12:23'!
renameClass
	| oldName newName obs okToRename |
	classListIndex = 0
		ifTrue: [ ^ self ].
	self okToChange
		ifFalse: [ ^ self ].
	oldName := self selectedClass name.
	newName := self request: 'Please type new class name' initialAnswer: oldName.
	newName isEmptyOrNil
		ifTrue: [ ^ self ].	"Cancel returns ''"
	newName := newName asSymbol.
	newName = oldName
		ifTrue: [ ^ self ].
	(Smalltalk globals includesKey: newName)
		ifTrue: [ ^ self inform: newName , ' already exists' ].
	okToRename := [ self selectedClass classBuilder validateClassName: newName ]
		on: Error
		do: [ :ex | ^ self inform: ex printString ].
	okToRename
		ifFalse: [ ^ self ].
	self selectedClass rename: newName.
	self changed: #classList.
	self classListIndex: ((systemOrganizer listAtCategoryNamed: self selectedSystemCategoryName) indexOf: newName).
	obs := self systemNavigation allReferencesTo: (self selectedClass environment associationAt: newName).
	obs isEmpty
		ifFalse: [ self systemNavigation browseMessageList: obs name: 'Obsolete References to ' , oldName autoSelect: oldName ]! !

!Browser methodsFor: 'class functions' stamp: 'AlainPlantec 11/25/2010 09:27'!
fileOutClass
	"Print a description of the selected class onto a file whose name is the 
	category name followed by .st."

	Cursor write showWhile:
		[classListIndex ~= 0 ifTrue: [self selectedClass fileOut]]! !

!Browser methodsFor: 'metaclass' stamp: 'AlainPlantec 8/26/2011 17:42'!
indicateClassMessages
	"Indicate that the message selection should come from the metaclass 
	messages."

	self metaClassIndicated: true! !

!Browser methodsFor: 'class functions' stamp: 'MarcusDenker 4/21/2011 22:27'!
shiftedClassListMenu: aMenu
	"Set up the menu to apply to the receiver's class list when the shift key is down"

	^ aMenu addList: #(
			-
			('Unsent methods'			browseUnusedMethods	'Browse all methods defined by this class that have no senders')
			('Unreferenced inst vars'	showUnreferencedInstVars	'Show a list of all instance variables that are not referenced in methods')
			('Unreferenced class vars'	showUnreferencedClassVars	'Show a list of all class variables that are not referenced in methods')
			('Subclass template'			makeNewSubclass		'Put a template into the code pane for defining of a subclass of this class')
			-
			('Inspect instances'			inspectInstances			'Open an inspector on all the extant instances of this class')
			('Inspect subinstances'		inspectSubInstances		'Open an inspector on all the extant instances of this class and of all of its subclasses')
			-
			('Add all meths to current chgs'		addAllMethodsToCurrentChangeSet
																'Place all the methods defined by this class into the current change set')
			('Create inst var accessors'	createInstVarAccessors	'Compile instance-variable access methods for any instance variables that do not yet have them')
			-
			('More...'					offerUnshiftedClassListMenu	'Return to the standard class-list menu'))! !

!Browser methodsFor: 'message category functions' stamp: 'NS 4/7/2004 22:56'!
changeMessageCategories: aString 
	"The characters in aString represent an edited version of the the message 
	categories for the selected class. Update this information in the system 
	and inform any dependents that the categories have been changed. This 
	message is invoked because the user had issued the categories command 
	and edited the message categories. Then the user issued the accept 
	command."

	self classOrMetaClassOrganizer changeFromString: aString.
	self clearUserEditFlag.
	self editClass.
	self classListIndex: classListIndex.
	^ true! !

!Browser methodsFor: 'message functions' stamp: 'MarcusDenker 7/21/2014 11:41'!
messageListMenu: aMenu shifted: shifted 
	"Answer the message-list menu"
	shifted
		ifTrue: [^ self shiftedMessageListMenu: aMenu].
	aMenu addList: #(
			('What to show...'			offerWhatToShowMenu)
			-
			('Browse full (b)' 			browseMethodFull)
			('Browse hierarchy (h)'			classHierarchy)
			-
			('FileOut'				fileOutMessage)
			-
			('Senders of... (n)'			browseSendersOfMessages)
			('Implementors of... (m)'		browseMessages)
			('Inheritance (i)'			methodHierarchy)
			('Versions (v)'				browseVersions)
			-
			('Inst var refs...'			browseInstVarRefs)
			('Inst var defs...'			browseInstVarDefs)
			('Class var refs...'			browseClassVarRefs)
			('Class variables'			browseClassVariables)
			('Class refs (N)'			browseClassRefs)
			-
			('Remove method (x)'			removeMessage)
			-
			('More...'				shiftedYellowButtonActivity)).
	^ aMenu! !

!Browser methodsFor: 'message category functions' stamp: 'nk 2/14/2004 15:06'!
editMessageCategories
	"Indicate to the receiver and its dependents that the message categories of 
	the selected class have been changed."

	self okToChange ifFalse: [^ self].
	classListIndex ~= 0
		ifTrue: 
			[self messageCategoryListIndex: 0.
			self editSelection: #editMessageCategories.
			self changed: #editMessageCategories.
			self contentsChanged]! !

!Browser methodsFor: 'system category list' stamp: 'tk 5/4/1998 15:46'!
indexIsOne: value
	"When used as a singleton list, can't change it"

	^ self! !

!Browser methodsFor: 'class functions' stamp: 'eem 5/7/2008 12:04'!
classDefinitionText
	"return the text to display for the definition of the currently selected class"
	| theClass |
	^(theClass := self selectedClassOrMetaClass) ifNil: [''] ifNotNil: [theClass definition]! !

!Browser methodsFor: 'message category list' stamp: ''!
selectedMessageCategoryName
	"Answer the name of the selected message category, if any. Answer nil 
	otherwise."

	messageCategoryListIndex = 0 ifTrue: [^nil].
	^self messageCategoryList at: messageCategoryListIndex! !

!Browser methodsFor: 'initialization' stamp: 'StephaneDucasse 8/5/2013 22:39'!
openAsMorphClassEditing: editString
	"Create a pluggable version a Browser on just a single class."
	| window dragNDropFlag hSepFrac switchHeight mySingletonClassList |

	window := (SystemWindow labelled: 'later') model: self.
	dragNDropFlag := true.
	hSepFrac := 0.3.
	switchHeight := 25.
	mySingletonClassList := PluggableListMorph on: self list: #classListSingleton
			selected: #indexIsOne changeSelected: #indexIsOne:
			menu: #classListMenu:shifted: keystroke: #classListKey:from:.
	mySingletonClassList enableDragNDrop: dragNDropFlag.

	self 
		addLowerPanesTo: window 
		at: (0@hSepFrac corner: 1@1) 
		with: editString.
	window 
		addMorph: mySingletonClassList
		fullFrame: ((0@0 corner: 0.5@0) asLayoutFrame bottomOffset: switchHeight).
	
	self 
		addMorphicSwitchesTo: window 
		at: ((0.5@0 corner: 1.0@0) asLayoutFrame bottomOffset: switchHeight).

	window 
		addMorph: self buildMorphicMessageCatList
		fullFrame: ((0@0 corner: 0.5@hSepFrac) asLayoutFrame topOffset: switchHeight).

	window 
		addMorph: self buildMorphicMessageList
		fullFrame: ((0.5@0 corner: 1.0@hSepFrac) asLayoutFrame topOffset: switchHeight).

	window setUpdatablePanesFrom: #(messageCategoryList messageList).
	^ window! !

!Browser methodsFor: 'initialization' stamp: 'alain.plantec 5/30/2008 10:16'!
openSystemCatEditString: aString
	"Create a pluggable version of all the views for a Browser, including views and controllers.  The top list view is of the currently selected system class category--a single item list."

	^ self openAsMorphSysCatEditing: aString! !

!Browser methodsFor: 'class comment pane' stamp: 'AlainPlantec 1/7/2010 21:39'!
buildMorphicCommentPane
	"Construct the pane that shows the class comment.
	Respect the setting StandardFonts codeFont."

	| commentPane |
	commentPane := BrowserCommentTextMorph
				on: self
				text: #classCommentText
				accept: #classComment:notifying:
				readSelection: nil
				menu: #codePaneMenu:shifted:.
	commentPane font: StandardFonts codeFont.
	^ commentPane! !

!Browser methodsFor: 'drag and drop' stamp: 'panda 4/28/2000 16:18'!
dragTransferTypeForMorph: dragSource 
	^(dragSource isKindOf: PluggableListMorph)
		ifTrue: [dragSource getListSelector]! !

!Browser methodsFor: 'metaclass' stamp: 'StephaneDucasse 2/12/2011 14:15'!
classOrMetaClassOrganizer
	"Answer the class organizer for the metaclass or class, depending on 
	which (instance or class) is indicated."

	^ self metaClassIndicated
		ifTrue: [ metaClassOrganizer]
		ifFalse: [ classOrganizer]! !

!Browser methodsFor: 'class list' stamp: ''!
classList
	"Answer an array of the class names of the selected category. Answer an 
	empty array if no selection exists."

	systemCategoryListIndex = 0
		ifTrue: [^Array new]
		ifFalse: [^systemOrganizer listAtCategoryNumber: systemCategoryListIndex]! !

!Browser methodsFor: 'system category functions' stamp: ''!
buildSystemCategoryBrowser
	"Create and schedule a new system category browser."

	self buildSystemCategoryBrowserEditString: nil! !

!Browser methodsFor: 'copying' stamp: 'sd 11/20/2005 21:26'!
veryDeepInner: deepCopier
	"Copy all of my instance variables.  Some need to be not copied at all, but shared.  See DeepCopier class comment."

super veryDeepInner: deepCopier.
"systemOrganizer := systemOrganizer. 	clone has the old value. we share it"
"classOrganizer := classOrganizer		clone has the old value. we share it"
"metaClassOrganizer 	:= metaClassOrganizer	clone has the old value. we share it"
systemCategoryListIndex := systemCategoryListIndex veryDeepCopyWith: deepCopier.
classListIndex := classListIndex veryDeepCopyWith: deepCopier.
messageCategoryListIndex := messageCategoryListIndex veryDeepCopyWith: deepCopier.
messageListIndex := messageListIndex veryDeepCopyWith: deepCopier.
editSelection := editSelection veryDeepCopyWith: deepCopier.
metaClassIndicated := metaClassIndicated veryDeepCopyWith: deepCopier.
! !

!Browser methodsFor: 'system category functions' stamp: 'MarcusDenker 10/7/2012 12:03'!
systemCategoryMenu: aMenu
	^ aMenu addList: #(
		('Find Class... (f)'				findClass)
		('Browse'						buildSystemCategoryBrowser)
		-
		('FileOut'						fileOutSystemCategory)
		('Reorganize'					editSystemCategories)
		-
		('Alphabetize'					alphabetizeSystemCategories)
		('Update'						updateSystemCategories)
		-
		('Add Category...'				addSystemCategory)
		('Rename...'						renameSystemCategory)
		-
		('Remove'						removeSystemCategory))! !

!Browser methodsFor: 'initialization' stamp: 'alain.plantec 5/15/2009 09:36'!
buildMorphicClassList

	| myClassList |

	(myClassList := PluggableListMorph new) 
			on: self list: #classList
			selected: #classListIndex changeSelected: #classListIndex:
			menu: #classListMenu:shifted: keystroke: #classListKey:from:.
	myClassList borderWidth: 0.
	myClassList enableDragNDrop: true.
	myClassList doubleClickSelector: #browseSelectionInPlace.
	"For doubleClick to work best disable autoDeselect"
	myClassList autoDeselect: false .
	^myClassList

! !

!Browser methodsFor: 'message category functions' stamp: 'sd 11/20/2005 21:26'!
showHomeCategory
	"Show the home category of the selected method.  This is only really useful if one is in a tool that supports the showing of categories.  Thus, it's good in browsers and hierarchy browsers but not in message-list browsers"

	| aSelector |
	self okToChange ifTrue:
		[(aSelector := self selectedMessageName) ifNotNil:
			[self selectOriginalCategoryForCurrentMethod.
			self selectedMessageName: aSelector]]! !

!Browser methodsFor: 'accessing' stamp: 'JB 2/12/2010 15:22'!
contents: input notifying: aController 
	"The retrieved information has changed and its source must now be
	 updated. The information can be a variety of things, depending on
	 the list selections (such as templates for class or message definition,
	 methods) or the user menu commands (such as definition, comment,
	 hierarchy).  Answer the result of updating the source."

	| aString aText theClass |
	self changed: #annotation.
	aString := input asString.
	aText := input asText.
	editSelection == #newTrait ifTrue: [^self defineTrait: input asString notifying: aController].
	editSelection == #editSystemCategories ifTrue: [^ self changeSystemCategories: aString].
	editSelection == #editClass | (editSelection == #newClass) ifTrue: [^ self defineClass: aString notifying: aController].
	editSelection == #editComment
		ifTrue: 
			[theClass := self selectedClass.
			theClass
				ifNil: 
					[self inform: 'You must select a class
before giving it a comment.'.
					^ false].
			theClass comment: aText stamp: Author changeStamp.
			self changed: #classCommentText.
			^ true].
	editSelection == #hierarchy ifTrue: [^ true].
	editSelection == #editMessageCategories ifTrue: [^ self changeMessageCategories: aString].
	editSelection == #editMessage | (editSelection == #newMessage)
		ifTrue:
			[^ self okayToAccept
				ifFalse:
					[false]
				ifTrue:
					[self compileMessage: aText notifying: aController]].
	editSelection == #none
		ifTrue: 
			[self inform: 'This text cannot be accepted
in this part of the browser.'.
			^ false].
	self error: 'unacceptable accept'! !

!Browser methodsFor: 'initialization' stamp: 'alain.plantec 5/30/2008 10:13'!
openOnClassWithEditString: aString
	"Create a pluggable version of all the views for a Browser, including views and controllers."
	^ self openAsMorphClassEditing: aString.

! !

!Browser methodsFor: 'message category functions' stamp: 'StephaneDucasse 8/29/2013 21:04'!
removeMessageCategory
	"If a message category is selected, create a Confirmer so the user can 
	verify that the currently selected message category should be removed
 	from the system. If so, remove it."

	| messageCategoryName |
	messageCategoryListIndex = 0 ifTrue: [^ self].
	self okToChange ifFalse: [^ self].
	messageCategoryName := self selectedMessageCategoryName.
	(self messageList isEmpty
		or: [self confirm: 'Are you sure you want to
remove this method category 
and all its methods?'])
		ifTrue: 
			[self selectedClassOrMetaClass removeProtocol: messageCategoryName.
			self messageCategoryListIndex: 0.
			self changed: #classSelectionChanged].
	self changed: #messageCategoryList.
! !

!Browser methodsFor: 'traits' stamp: 'MarcusDenker 8/28/2013 10:52'!
defineTrait: defString notifying: aController  

	| defTokens keywdIx envt oldTrait newTraitName trait |
	oldTrait := self selectedClassOrMetaClass.
	defTokens := defString findTokens: Character separators.
	keywdIx := defTokens findFirst: [:x | x = 'category'].
	envt := self selectedEnvironment.
	keywdIx := defTokens findFirst: [:x | x = 'named:'].
	newTraitName := (defTokens at: keywdIx+1) copyWithoutAll: '#()'.
	((oldTrait isNil or: [oldTrait baseTrait name asString ~= newTraitName])
		and: [envt includesKey: newTraitName asSymbol]) ifTrue:
			["Attempting to define new class/trait over existing one when
				not looking at the original one in this browser..."
			(self confirm: ((newTraitName , ' is an existing class/trait in this system.
Redefining it might cause serious problems.
Is this really what you want to do?') asText makeBoldFrom: 1 to: newTraitName size))
				ifFalse: [^ false]].

	trait := self class compiler source: defString; requestor: aController; logged: true; evaluate.
	^(trait isKindOf: TraitBehavior)
		ifTrue: [
			self changed: #classList.
			self classListIndex: (self classList indexOf: trait baseTrait name).
			self clearUserEditFlag; editClass.
			true]
		ifFalse: [ false ]
! !

!Browser methodsFor: 'traits' stamp: 'lr 3/14/2010 21:13'!
addTrait
	| input trait |
	input := UIManager default request: 'add trait'.
	input isEmptyOrNil
		ifFalse: [ 
			trait := Smalltalk globals classNamed: input.
			(trait isNil or: [ trait isTrait not ])
				ifTrue: [ ^ self inform: 'Input invalid. ' , input , ' does not exist or is not a trait' ].
			self selectedClass addToComposition: trait.
			self contentsChanged ]! !

!Browser methodsFor: 'accessing' stamp: 'tak 9/25/2008 14:58'!
contentsSelection
	"Return the interval of text in the code pane to select when I set the pane's contents"

	messageCategoryListIndex > 0 & (messageListIndex = 0)
		ifTrue: [^ 1 to: 500]	"entire empty method template"
		ifFalse: [^ 1 to: 0]		"null selection"! !

!Browser methodsFor: 'system category functions' stamp: 'MarcusDenker 10/15/2013 18:09'!
findClass
	"Search for a class from a pattern or from the recent list"
	| foundClassOrTrait  |

	self okToChange ifFalse: [^ self classNotFound].
	
	foundClassOrTrait := SearchFacade classSearch chooseFromOwner: self dependents first.
	foundClassOrTrait ifNil: [^ self classNotFound].
 	self selectCategoryForClass: foundClassOrTrait.
	self selectClass: foundClassOrTrait
! !

!Browser methodsFor: 'message functions' stamp: 'EstebanLorenzano 8/17/2014 11:43'!
defineMessageFrom: aString notifying: aController
	"Compile the expressions in aString. Notify aController if a syntax error occurs. Install the compiled method in the selected class classified under  the currently selected message category name. Answer the selector obtained if compilation succeeds, nil otherwise."
	| selectedMessageName selector category oldMessageList |
	selectedMessageName := self selectedMessageName.
	oldMessageList := self messageList.
	contents := nil.
	selector := self selectedClassOrMetaClass
				compile: aString
				classified: ((category := self selectedMessageCategoryName) ifNil: [ Protocol unclassified ])
				notifying: aController.
	selector == nil ifTrue: [^ nil].
	contents := aString copy.
	selector ~~ selectedMessageName
		ifTrue: 
			[category = Protocol nullCategory
				ifTrue: [self changed: #classSelectionChanged.
						self changed: #classList.
						self messageCategoryListIndex: 1].
			self setClassOrganizer.  "In case organization not cached"
			(oldMessageList includes: selector)
				ifFalse: [self changed: #messageList].
			self messageListIndex: (self messageList indexOf: selector)].
	^ selector! !

!Browser methodsFor: 'message functions' stamp: 'CamilloBruni 8/1/2012 16:10'!
inspectSubInstances
	"Inspect all instances of the selected class and all its subclasses"

	| aClass |
	((aClass := self selectedClassOrMetaClass) isNil or: [aClass isTrait])
		ifFalse: [
			aClass := aClass theNonMetaClass.
			aClass inspectSubInstances].
! !

!Browser methodsFor: 'initialization' stamp: 'StephaneDucasse 12/19/2012 16:26'!
openAsMorphMsgCatEditing: editString
	"Create a pluggable version a Browser on just a message category."

	| window hSepFrac |
	window := (SystemWindow labelled: 'later') model: self.
	hSepFrac := 0.3.
	window 
		addMorph: ((PluggableListMorph on: self list: #messageCatListSingleton
			selected: #indexIsOne changeSelected: #indexIsOne:
			menu: #messageCategoryMenu:) enableDragNDrop: true)
		fullFrame: (  (0@0 corner: 1@0) asLayoutFrame bottomOffset: 25).
	window 
		addMorph: self buildMorphicMessageList
		fullFrame: ((0@0 corner: 1@hSepFrac) asLayoutFrame topOffset: 0@25).

	self 
		addLowerPanesTo: window 
		at: (0@hSepFrac corner: 1@1) 
		with: editString.
	window setUpdatablePanesFrom: #(messageCatListSingleton messageList).
	^ window! !

!Browser methodsFor: 'system category list' stamp: 'md 3/3/2006 11:02'!
selectedEnvironment
	"Answer the name of the selected system category or nil."

	systemCategoryListIndex = 0 ifTrue: [^nil].
	^ Smalltalk! !

!Browser methodsFor: 'class functions' stamp: 'AlainPlantec 8/26/2011 17:55'!
plusButtonHit
	"Cycle among definition, comment, and hierachy"
	
	editSelection == #editComment
		ifTrue: [self hierarchy. ^ self].
	editSelection == #hierarchy
		ifTrue: [self editSelection: #editClass.
			classListIndex = 0 ifTrue: [^ self].
			self okToChange ifFalse: [^ self].
			self changed: #editComment.
			self contentsChanged.
			^ self].
	self editComment! !

!Browser methodsFor: 'class functions' stamp: 'MarcusDenker 8/28/2013 16:05'!
defineClass: defString notifying: aController  
	"The receiver's textual content is a request to define a new class. The
	source code is defString. If any errors occur in compilation, notify
	aController."
	| oldClass class newClassName defTokens keywdIx envt |
	oldClass := self selectedClassOrMetaClass.
	defTokens := defString findTokens: Character separators.
	
	((defTokens first = 'Trait' and: [defTokens second = 'named:'])
		or: [defTokens second = 'classTrait'])
		ifTrue: [^self defineTrait: defString notifying: aController].
		
	keywdIx := defTokens findFirst: [:x | x beginsWith: 'category'].
	envt := Smalltalk globals.
	keywdIx := defTokens findFirst: [:x | '*subclass*' match: x].
	newClassName := (defTokens at: keywdIx+1) copyWithoutAll: '#()'.
	((oldClass isNil or: [oldClass theNonMetaClass name asString ~= newClassName])
		and: [envt includesKey: newClassName asSymbol]) ifTrue:
			["Attempting to define new class over existing one when
				not looking at the original one in this browser..."
			(self confirm: ((newClassName , ' is an existing class in this system.
Redefining it might cause serious problems.
Is this really what you want to do?') asText makeBoldFrom: 1 to: newClassName size))
				ifFalse: [^ false]].
	"ar 8/29/1999: Use oldClass superclass for defining oldClass
	since oldClass superclass knows the definerClass of oldClass."
	oldClass ifNotNil:[oldClass := oldClass superclass].
	class := oldClass subclassDefinerClass new
				source: defString;
				requestor: aController;
				logged: true;
				evaluate.
	(class isKindOf: Behavior)
		ifTrue: [self changed: #systemCategoryList.
				self changed: #classList.
				self clearUserEditFlag.
				self setClass: class selector: nil.
				"self clearUserEditFlag; editClass."
				^ true]
		ifFalse: [^ false]! !

!Browser methodsFor: 'drag and drop' stamp: 'MarcusDenker 3/26/2010 16:48'!
destinationClassDestinationListMorph: dstListMorph
	| dropItem |
	^ dstListMorph getListSelector == #classList
		ifTrue: [ (dropItem := dstListMorph potentialDropItem) ifNotNil: [ Smalltalk globals at: dropItem withBlanksCondensed asSymbol ] ]
		ifFalse: [ dstListMorph model selectedClass ]! !

!Browser methodsFor: 'system category functions' stamp: 'di 4/12/98 13:21'!
changeSystemCategories: aString 
	"Update the class categories by parsing the argument aString."

	systemOrganizer changeFromString: aString.
	self changed: #systemCategoryList.
	^ true! !

!Browser methodsFor: 'system category list' stamp: 'sd 11/20/2005 21:26'!
systemCategorySingleton

	| cat |
	cat := self selectedSystemCategoryName.
	^ cat ifNil: [Array new]
		ifNotNil: [Array with: cat]! !

!Browser methodsFor: 'message list' stamp: 'sd 11/20/2005 21:26'!
selectedMessageName
	"Answer the message selector of the currently selected message, if any. 
	Answer nil otherwise."

	| aList |
	messageListIndex = 0 ifTrue: [^ nil].
	^ (aList := self messageList) size >= messageListIndex
		ifTrue:
			[aList at: messageListIndex]
		ifFalse:
			[nil]! !

!Browser methodsFor: 'system category list' stamp: ''!
systemCategoryList
	"Answer the class categories modelled by the receiver."

	^systemOrganizer categories! !

!Browser methodsFor: 'initialization' stamp: 'EstebanLorenzano 8/17/2014 11:50'!
setSelector: aSymbol
	"Make the receiver point at the given selector, in the currently chosen class"

	| aClass messageCatIndex |
	aSymbol ifNil: [^ self].
	(aClass := self selectedClassOrMetaClass) ifNil: [^ self].
	messageCatIndex := aClass organization protocols 
		indexOf: (aClass organization protocolOrganizer protocolsOfSelector: aSymbol) anyOne.
	self messageCategoryListIndex: messageCatIndex + 1.
	messageCatIndex = 0 ifTrue: [^ self].
	self messageListIndex:
			((aClass organization listAtCategoryNumber: messageCatIndex)
					indexOf: aSymbol)! !

!Browser methodsFor: 'system category list' stamp: 'stp 01/13/2000 12:25'!
selectCategoryForClass: theClass

	self systemCategoryListIndex: (self systemCategoryList indexOf: theClass category)
! !

!Browser methodsFor: 'message functions' stamp: 'tk 4/2/98 17:03'!
removeMessageFromBrowser
	"Our list speaks the truth and can't have arbitrary things removed"

	^ self changed: #flash! !

!Browser methodsFor: 'initialization' stamp: 'RAA 1/10/2001 11:46'!
addClassAndSwitchesTo: window at: nominalFractions plus: verticalOffset

	^self
		addAListPane: self buildMorphicClassList 
		to: window 
		at: nominalFractions 
		plus: verticalOffset
! !

!Browser methodsFor: 'message category functions' stamp: 'sw 10/8/2001 14:10'!
canShowMultipleMessageCategories
	"Answer whether the receiver is capable of showing multiple message categories"

	^ true! !

!Browser methodsFor: 'traits' stamp: 'jannik.laval 5/1/2010 16:00'!
removeNonLocalSelector: aSymbol
	| traits isAlias |
	traits := self selectedClassOrMetaClass traitsProvidingSelector: aSymbol.
	isAlias := self selectedClassOrMetaClass isLocalAliasSelector: aSymbol.
	isAlias
		ifTrue: [
			[traits size = 1] assert.
			self selectedClassOrMetaClass removeAlias: aSymbol of: traits first]
		ifFalse: [
			traits do: [:each |
				self selectedClassOrMetaClass addExclusionOf: aSymbol to: each ]]
	! !

!Browser methodsFor: 'drag and drop' stamp: 'sd 11/20/2005 21:26'!
wantsDroppedMorph: transferMorph event: anEvent inMorph: destinationLM 
	"We are only interested in TransferMorphs as wrappers for             
	informations. If their content is really interesting for us, will             
	determined later in >>acceptDroppingMorph:event:."

	| srcType dstType |

	"only want drops on lists (not, for example, on pluggable texts)"
	(destinationLM isKindOf: PluggableListMorph) ifFalse: [^ false].

	srcType := transferMorph dragTransferType.
	dstType := destinationLM getListSelector.

	(srcType == #messageList
		and: [dstType == #messageCategoryList or: [dstType == #classList]])
		ifTrue: [^true].
	(srcType == #classList
		and: [dstType == #systemCategoryList])
		ifTrue: [^true].
"			[
			srcLS == #messageList ifTrue: [^ dstLS == #messageList | (dstLS == #messageCategoryList) | (dstLS == #classList)].
			srcLS == #classList ifTrue: [^ dstLS == #classList | (dstLS == #systemCategoryList)]].
"
	^ false! !

!Browser methodsFor: 'message list' stamp: 'sw 12/1/2000 11:17'!
reformulateList
	"If the receiver has a way of reformulating its message list, here is a chance for it to do so"

	super reformulateList.
	self messageListIndex: 0! !

!Browser methodsFor: 'accessing' stamp: 'sd 11/20/2005 21:26'!
editSelection: aSelection
	"Set the editSelection as requested."

	editSelection := aSelection.
	self changed: #editSelection.! !

!Browser methodsFor: 'class functions' stamp: 'MarcusDenker 3/5/2010 14:30'!
findMethodWithWildcard
	"Pop up a list of the current class's methods, and select the one chosen by the user"

	| aClass selectors reply cat messageCatIndex messageIndex |
	self classListIndex = 0 ifTrue: [^ self].
	self okToChange ifFalse: [^ self].
	aClass := self selectedClassOrMetaClass.
	selectors := aClass selectors sort.
	selectors isEmpty ifTrue: [self inform: aClass name, ' has no methods.' translated. ^ self].

	reply := UIManager default request: 'Enter partial method name:' translated.
	(reply isNil or: [reply isEmpty])
		ifTrue: [^self].
	(reply includes: $*)
		ifFalse: [reply := '*', reply, '*'].
	selectors := selectors select: [:each | reply match: each].
	selectors isEmpty ifTrue: [self inform: aClass name, ' has no matching methods.'. ^ self].
	reply := selectors size = 1
		ifTrue: [selectors first]
		ifFalse: [UIManager default chooseFrom: selectors values: selectors].
	reply == nil ifTrue: [^ self].

	cat := aClass whichCategoryIncludesSelector: reply.
	messageCatIndex := self messageCategoryList indexOf: cat.
	self messageCategoryListIndex: messageCatIndex.
	messageIndex := (self messageList indexOf: reply).
	self messageListIndex: messageIndex! !

!Browser methodsFor: 'class functions' stamp: 'sw 3/5/2001 18:04'!
removeClass
	"If the user confirms the wish to delete the class, do so"

	super removeClass ifTrue:
		[self classListIndex: 0]! !

!Browser methodsFor: 'initialization' stamp: 'rww 8/18/2002 09:31'!
browseSelectionInPlace

	"In place code - incomplete"
"	self systemCategoryListIndex: 
		(self systemCategoryList indexOf: self selectedClass category).
	self classListIndex: (self classList indexOf: self selectedClass name)"

	self spawnHierarchy.! !

!Browser methodsFor: 'message category functions' stamp: 'nk 4/23/2004 09:18'!
removeEmptyCategories
	self okToChange ifFalse: [^ self].
	self selectedClassOrMetaClass organization removeEmptyCategories.
	self changed: #messageCategoryList
! !

!Browser methodsFor: 'initialization' stamp: 'IgorStasenko 12/20/2012 14:39'!
addAListPane: aListPane to: window at: nominalFractions plus: verticalOffset

	| row switchHeight |

	row := AlignmentMorph newColumn
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		layoutInset: 0;
		borderWidth: 1;
		layoutPolicy: ProportionalLayout new.
	switchHeight := StandardFonts buttonFont height + 12.
	self 
		addMorphicSwitchesTo: row 
		at: ((0@1 corner: 1@1) asLayoutFrame topOffset: switchHeight negated).
	row 
		addMorph: aListPane
		fullFrame: (LayoutFrame identity bottomOffset: switchHeight negated).	

	window 
		addMorph: row
		fullFrame: (nominalFractions asLayoutFrame topOffset: verticalOffset).	
	row on: #mouseEnter send: #paneTransition: to: window.
	row on: #mouseLeave send: #paneTransition: to: window.

! !

!Browser methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 4/24/2012 15:05'!
buildMorphicMessageCatList

	| myMessageCatList |

	(myMessageCatList := PluggableListMorph new) 
			on: self list: #messageCategoryList
			selected: #messageCategoryListIndex changeSelected: #messageCategoryListIndex:
			menu: #messageCategoryMenu: 
			keystroke: #arrowKey:from:.
	myMessageCatList enableDragNDrop: true.
	^myMessageCatList
! !

!Browser methodsFor: 'message functions' stamp: 'CamilloBruni 8/1/2012 16:10'!
inspectInstances
	"Inspect all instances of the selected class."

	| myClass |
	((myClass := self selectedClassOrMetaClass) isNil or: [myClass isTrait])
		ifFalse: [myClass theNonMetaClass inspectAllInstances]
! !

!Browser methodsFor: 'system category functions' stamp: 'tk 4/2/98 13:43'!
classNotFound

	self changed: #flash.! !

!Browser methodsFor: 'drag and drop' stamp: 'EstebanLorenzano 6/26/2013 18:08'!
changeMessageCategoryForMethod: methodSel dstMessageCategory: dstMessageCategorySel srcMessageCategory: srcMessageCategorySel insideClassOrMeta: classOrMeta internal: internal copySemantic: copyFlag 
	"Recategorize the method named by methodSel. 
	If the dstMessageCategorySel is the allCategory, then recategorize 
	it from its parents."
	| success messageCategorySel |
	copyFlag
		ifTrue: [^ false].
	"only move semantic"
	messageCategorySel := dstMessageCategorySel
				ifNil: [srcMessageCategorySel].
	(success := messageCategorySel notNil
					and: [messageCategorySel ~= srcMessageCategorySel])
		ifTrue: [success := messageCategorySel == AllProtocol defaultName
						ifTrue: [self recategorizeMethodSelector: methodSel]
						ifFalse: [(classOrMeta organization categories includes: messageCategorySel)
								and: [classOrMeta organization
										classify: methodSel
										under: messageCategorySel
										suppressIfDefault: false.
									true]]].
	success
		ifTrue: [self changed: #messageList.
			internal
				ifFalse: [self setSelector: methodSel]].
	^ success! !

!Browser methodsFor: 'system category functions' stamp: 'tk 3/31/98 07:52'!
fileOutSystemCategory
	"Print a description of each class in the selected category onto a file 
	whose name is the category name followed by .st."

	systemCategoryListIndex ~= 0
		ifTrue: [systemOrganizer fileOutCategory: self selectedSystemCategoryName]! !

!Browser methodsFor: 'drag and drop' stamp: 'MarcusDenker 3/26/2010 16:49'!
acceptMethod: methodSel messageCategory: srcMessageCategorySel class: srcClassOrMeta atListMorph: dstListMorph internal: internal copy: copyFlag 
	| success dstClassOrMeta dstClass dstMessageCategorySel |
	dstClass := self destinationClassDestinationListMorph: dstListMorph.
	dstClassOrMeta := dstClass
				ifNotNil: [self metaClassIndicated
						ifTrue: [dstClass classSide]
						ifFalse: [dstClass]].
	dstMessageCategorySel := self dstMessageCategoryDstListMorph: dstListMorph.
	success := (dstClassOrMeta notNil
				and: [dstClassOrMeta == srcClassOrMeta])
						ifTrue: ["one class"
							self
								changeMessageCategoryForMethod: methodSel
								dstMessageCategory: dstMessageCategorySel
								srcMessageCategory: srcMessageCategorySel
								insideClassOrMeta: dstClassOrMeta
								internal: internal
								copySemantic: copyFlag]
						ifFalse: ["different classes"
							self
								acceptMethod: methodSel
								dstMessageCategory: dstMessageCategorySel
								srcMessageCategory: srcMessageCategorySel
								dstClass: dstClass
								dstClassOrMeta: dstClassOrMeta
								srcClassOrMeta: srcClassOrMeta
								internal: internal
								copySemantic: copyFlag].
	^ success! !

!Browser methodsFor: 'initialization' stamp: 'alain.plantec 5/15/2009 09:36'!
buildMorphicMessageList
	"Build a morphic message list, with #messageList as its list-getter"

	| aListMorph |
	(aListMorph := PluggableListMorph new) 
			on: self list: #messageList
			selected: #messageListIndex changeSelected: #messageListIndex:
			menu: #messageListMenu:shifted:
			keystroke: #messageListKey:from:.
	aListMorph enableDragNDrop: true.
	aListMorph menuTitleSelector: #messageListSelectorTitle.
	^aListMorph

! !

!Browser methodsFor: 'system category list' stamp: ''!
systemCategoryListIndex
	"Answer the index of the selected class category."

	^systemCategoryListIndex! !

!Browser methodsFor: 'code pane' stamp: 'AlainPlantec 1/7/2010 21:06'!
codePaneMenu: aMenu shifted: shifted 
	super codePaneMenu: aMenu shifted: shifted.
	^ aMenu! !

!Browser methodsFor: 'metaclass' stamp: ''!
selectedClassOrMetaClassName
	"Answer the selected class name or metaclass name."

	^self selectedClassOrMetaClass name! !

!Browser methodsFor: 'message category functions' stamp: 'MarcusDenker 9/28/2013 13:46'!
addCategory
	"Present a choice of categories or prompt for a new category name and add it before the current selection, or at the end if no current selection"

	| labels reject lines oldIndex newName |
	self okToChange
		ifFalse: [ ^ self ].
	classListIndex = 0
		ifTrue: [ ^ self ].
	labels := OrderedCollection new.
	reject := Set new.
	reject
		addAll: self selectedClassOrMetaClass organization categories;
		add: Protocol nullCategory;
		add: Protocol unclassified.
	lines := OrderedCollection new.
	self selectedClassOrMetaClass allSuperclasses
		do: [ :cls | 
			| cats |
			cls = Object
				ifFalse: [ 
					cats := cls organization categories reject: [ :cat | reject includes: cat ].
					cats isEmpty
						ifFalse: [ 
							lines add: labels size.
							labels addAll: cats.
							reject addAll: cats ] ] ].
	newName := UIManager default chooseOrRequestFrom: labels lines: lines title: 'Add Category'.
	newName ifNil: [ ^ self ].
	newName := newName asSymbol.
	oldIndex := messageCategoryListIndex.
	self classOrMetaClassOrganizer
		addCategory: newName
		before:
			(messageCategoryListIndex = 0
				ifTrue: [ nil ]
				ifFalse: [ self selectedMessageCategoryName ]).
	self changed: #messageCategoryList.
	self
		messageCategoryListIndex:
			(oldIndex = 0
				ifTrue: [ self classOrMetaClassOrganizer categories size + 1 ]
				ifFalse: [ oldIndex ]).
	self changed: #messageCategoryList! !

!Browser methodsFor: 'metaclass' stamp: 'sr 6/21/2000 17:23'!
metaClassIndicated
	"Answer the boolean flag that indicates which of the method dictionaries, 
	class or metaclass."

	^ metaClassIndicated! !

!Browser methodsFor: 'message category functions' stamp: 'EstebanLorenzano 6/26/2013 18:08'!
categoryOfCurrentMethod
	"Determine the method category associated with the receiver at the current moment, or nil if none"

	| aCategory |
	^ super categoryOfCurrentMethod ifNil:
		[(aCategory := self messageCategoryListSelection) == AllProtocol defaultName
					ifTrue:
						[nil]
					ifFalse:
						[aCategory]]! !

!Browser methodsFor: 'message category functions' stamp: 'tk 4/2/98 13:53'!
fileOutMessageCategories
	"Print a description of the selected message category of the selected class 
	onto an external file."

Cursor write showWhile:
	[messageCategoryListIndex ~= 0
		ifTrue: 
			[self selectedClassOrMetaClass fileOutCategory: self selectedMessageCategoryName]]! !

!Browser methodsFor: 'system category functions' stamp: 'nk 2/14/2004 15:09'!
editSystemCategories
	"Retrieve the description of the class categories of the system organizer."

	self okToChange ifFalse: [^ self].
	self systemCategoryListIndex: 0.
	self editSelection: #editSystemCategories.
	self changed: #editSystemCategories.
	self contentsChanged! !

!Browser methodsFor: 'system category list' stamp: ''!
selectedSystemCategoryName
	"Answer the name of the selected system category or nil."

	systemCategoryListIndex = 0 ifTrue: [^nil].
	^self systemCategoryList at: systemCategoryListIndex! !

!Browser methodsFor: 'message category functions' stamp: 'NS 4/7/2004 22:47'!
alphabetizeMessageCategories
	classListIndex = 0 ifTrue: [^ false].
	self okToChange ifFalse: [^ false].
	self classOrMetaClassOrganizer sortCategories.
	self clearUserEditFlag.
	self editClass.
	self classListIndex: classListIndex.
	^ true! !

!Browser methodsFor: 'initialization' stamp: 'sw 11/8/1999 13:36'!
systemCatSingletonKey: aChar from: aView
	^ self messageListKey: aChar from: aView! !

!Browser methodsFor: 'accessing' stamp: 'MarcusDenker 7/5/2014 18:58'!
contents
	"Depending on the current selection, different information is retrieved.
	Answer a string description of that information. This information is the
	method of the currently selected class and message."

	| comment theClass latestCompiledMethod |
	latestCompiledMethod := currentCompiledMethod.
	currentCompiledMethod := nil.

	editSelection == #newTrait
		ifTrue: [^Trait newTemplateIn: self selectedSystemCategoryName].
	editSelection == #none ifTrue: [^ ''].
	editSelection == #editSystemCategories 
		ifTrue: [^ systemOrganizer printString].
	editSelection == #newClass 
		ifTrue: [^ (theClass := self selectedClass)
			ifNil:
				[Class template: self selectedSystemCategoryName]
			ifNotNil:
				[Class templateForSubclassOf: theClass category: self selectedSystemCategoryName]].
	editSelection == #editClass 
		ifTrue: [^self classDefinitionText].
	editSelection == #editComment 
		ifTrue:
			[(theClass := self selectedClass) ifNil: [^ ''].
			comment := theClass comment.
			currentCompiledMethod := theClass organization commentRemoteString.
			^ comment size = 0
				ifTrue: ['This class has not yet been commented.']
				ifFalse: [comment]].
	editSelection == #hierarchy 
		ifTrue: [
			self selectedClassOrMetaClass isTrait
				ifTrue: [^'']
				ifFalse: [^self selectedClassOrMetaClass printHierarchy]].
	editSelection == #editMessageCategories 
		ifTrue: [^ self classOrMetaClassOrganizer printString].
	editSelection == #newMessage
		ifTrue:
			[^ (theClass := self selectedClassOrMetaClass) 
				ifNil: ['']
				ifNotNil: [theClass sourceCodeTemplate]].
	editSelection == #editMessage
		ifTrue:
			[self showingByteCodes ifTrue: [^ self selectedBytecodes].
			currentCompiledMethod := latestCompiledMethod.
			^ self selectedMessage].

	self error: 'Browser internal error: unknown edit selection.'! !

!Browser methodsFor: 'metaclass' stamp: 'md 2/18/2006 16:31'!
setClassOrganizer
	"Install whatever organization is appropriate"
	| theClass |
	classOrganizer := nil.
	metaClassOrganizer := nil.
	classListIndex = 0 ifTrue: [^ self].
	theClass := self selectedClass ifNil: [ ^self ].
	classOrganizer := theClass organization.
	metaClassOrganizer := theClass classSide organization.! !

!Browser methodsFor: 'accessing' stamp: 'sd 11/20/2005 21:26'!
noteSelectionIndex: anInteger for: aSymbol
	aSymbol == #systemCategoryList
		ifTrue:
			[systemCategoryListIndex := anInteger].
	aSymbol == #classList
		ifTrue:
			[classListIndex := anInteger].
	aSymbol == #messageCategoryList
		ifTrue:
			[messageCategoryListIndex := anInteger].
	aSymbol == #messageList
		ifTrue:
			[messageListIndex := anInteger].! !

!Browser class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
taskbarIcon
	"Answer the icon for the receiver in a task bar."

	^ Smalltalk ui icons smallSystemBrowserIcon! !

!Browser class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 3/19/2012 23:38'!
fullOnClass: aClass 
	"Open a new full browser set to class."
	^ self newOnClass: aClass label: 'System Browser'! !

!Browser class methodsFor: 'instance creation' stamp: 'MarcusDenker 5/5/2013 09:15'!
fullOnClass: aClass selector: aSelector
	"Open a new full browser set to class."

	| brower |
	brower := self new.
	brower setClass: aClass selector: aSelector.
	^ self 
		openBrowserView: (brower openEditString: nil)
		label: brower labelString! !

!Browser class methodsFor: 'instance creation' stamp: 'nk 6/2/2004 12:55'!
systemOrganizer: anOrganizer

	^(super new)
		systemOrganizer: anOrganizer;
		yourself! !

!Browser class methodsFor: 'instance creation' stamp: 'sd 11/20/2005 21:28'!
newOnClass: aClass selector: aSymbol
	"Open a new class browser on this class."
	| newBrowser |

	newBrowser := self new.
	newBrowser setClass: aClass selector: aSymbol.
	^ self 
		openBrowserView: (newBrowser openOnClassWithEditString: nil)
		label: 'Class Browser: ', aClass name
! !

!Browser class methodsFor: 'instance creation' stamp: 'sd 11/20/2005 21:28'!
newOnClass: aClass label: aLabel
	"Open a new class browser on this class."
	| newBrowser |

	newBrowser := self new.
	newBrowser setClass: aClass selector: nil.
	^ self 
		openBrowserView: (newBrowser openOnClassWithEditString: nil)
		label: aLabel
! !

!Browser class methodsFor: 'cleanup' stamp: 'MarcusDenker 4/17/2011 21:46'!
cleanUp

	self flushCaches.! !

!Browser class methodsFor: 'initialization' stamp: 'MarcusDenker 4/17/2011 21:46'!
flushCaches
	RecentClasses := OrderedCollection new.! !

!Browser class methodsFor: 'initialization' stamp: 'MarcusDenker 5/5/2013 09:17'!
initialize
	"Browser initialize"

	self flushCaches.! !

!Browser class methodsFor: 'instance creation' stamp: 'di 10/18/1999 22:03'!
new

	^super new systemOrganizer: SystemOrganization! !

!Browser class methodsFor: 'instance creation' stamp: 'tk 4/18/1998 16:28'!
newOnClass: aClass 
	"Open a new class browser on this class."
	^ self newOnClass: aClass label: 'Class Browser: ', aClass name! !

!Browser class methodsFor: 'instance creation' stamp: 'alain.plantec 6/19/2008 09:43'!
openBrowserView: aBrowserView label: aString 
	"Schedule aBrowserView, labelling the view aString."

	(aBrowserView setLabel: aString) openInWorld.
	^ aBrowserView model
! !

!Browser class methodsFor: 'instance creation' stamp: 'MarcusDenker 6/30/2014 08:49'!
open
	"Create and schedule a BrowserView with default browser label. The
	view consists of five subviews, starting with the list view of system
	categories of SystemOrganization. The initial text view part is empty."

	| br |
	br := self new.
	^ self
		openBrowserView: (br openEditString: nil)
		label: br defaultBrowserTitle.


! !

!Browser class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 2/7/2012 10:39'!
fullOnEnvironment: anEnvironment
" I am not environment aware "
	
	self open! !

!Browser class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 2/8/2013 16:14'!
fullOnClass: class selector: selector highlight: autoSelectString
				
		self 
			fullOnClass: class 
			selector: selector! !

!BrowserCommentTextMorph commentStamp: '<historical>'!
I am a PluggableTextMorph that knows enough to make myself invisible when necessary.!
!BrowserCommentTextMorph methodsFor: 'accessing' stamp: 'nk 2/15/2004 14:12'!
lowerPane
	"Answer the AlignmentMorph that I live beneath"
	^self valueOfProperty: #browserLowerPane! !

!BrowserCommentTextMorph methodsFor: 'accessing' stamp: 'nk 2/15/2004 14:07'!
window
	^self owner ifNil: [ self valueOfProperty: #browserWindow ].! !

!BrowserCommentTextMorph methodsFor: 'initialization' stamp: 'AlainPlantec 8/26/2011 17:53'!
initialize 
	super initialize.
	self styled: false ! !

!BrowserCommentTextMorph methodsFor: 'updating' stamp: 'AlainPlantec 8/26/2011 19:08'!
update: anAspect
	super update: anAspect.
	anAspect == #editSelection ifFalse: [ ^self ].
	self hideOrShowPane! !

!BrowserCommentTextMorph methodsFor: 'displaying' stamp: 'IgorStasenko 12/19/2012 17:23'!
defaultLayoutFrame
	^ (0@0.75 corner: 1@1) asLayoutFrame.
! !

!BrowserCommentTextMorph methodsFor: 'displaying' stamp: 'AlainPlantec 11/17/2010 11:35'!
showPane
	"Fixed to not keep doing the splitters. If we are showing don't show again!!"
	
	| win |
	self owner ifNil: [
		win := self window ifNil: [ ^self ].
		win addMorph: self fullFrame: self defaultLayoutFrame.
		win updatePanesFromSubmorphs.
		self lowerPane ifNotNil: [ :lp | lp layoutFrame bottomFraction: self layoutFrame topFraction ].
		win addPaneSplitters]! !

!BrowserCommentTextMorph methodsFor: 'displaying' stamp: 'nk 2/15/2004 13:41'!
hideOrShowPane
	(self model editSelection == #editClass)
		ifTrue: [ self showPane ]
		ifFalse: [ self hidePane ]! !

!BrowserCommentTextMorph methodsFor: 'displaying' stamp: 'marcus.denker 11/10/2008 10:04'!
hidePane
	"Fixed to not keep doing the splitters. If we are hiden don't hide again!!"

	| win |
	self owner ifNotNil: [
		win := self window ifNil: [^self].
		self window ifNotNil: [:window | window removePaneSplitters].
		self lowerPane ifNotNil: [:lp | 
			lp layoutFrame bottomFraction: self layoutFrame bottomFraction.
			lp layoutFrame bottomOffset: SystemWindow borderWidth negated].
		self delete.
		win updatePanesFromSubmorphs.
		win addPaneSplitters]! !

!BrowserCommentTextMorph methodsFor: 'updating' stamp: 'stephane.ducasse 10/9/2008 18:50'!
noteNewOwner: win
	"Dirty fix for when the 'lower pane' hasn't been reset to the bottom at the
	time the receiver is added"

	super noteNewOwner: win.
	self setProperty: #browserWindow toValue: win.
	win ifNil: [ ^self ].
	win setProperty: #browserClassCommentPane toValue: self.
	self setProperty: #browserLowerPane toValue: (win submorphThat: [ :m | m isAlignmentMorph and: [ m layoutFrame bottomFraction = 1 or: [ m layoutFrame bottomFraction = self layoutFrame topFraction]]] ifNone: []).
! !

!BuilderManifestTest commentStamp: '<historical>'!
A ManifestBuilderTest is a class to test the behavior of ManifestBuilder!
!BuilderManifestTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/6/2014 20:51'!
testAddToDo
	
	| manifestBuilder cl mth|
	cl := MFClassA.
	mth := MFClassA >> #method.
	manifestBuilder := TheManifestBuilder of: MFClassA .
	manifestBuilder  installToDoOf: 'test' version: 0.
	
	self deny: ((manifestBuilder toDoOf: 'test' version: 0) anySatisfy: [:each| each = cl]).
	self deny: ((manifestBuilder toDoOf: 'test' version: 0) anySatisfy: [:each| each = mth]).
	
	manifestBuilder addToDo: cl of: 'test' version: 0. 
	manifestBuilder addToDo: mth of: 'test' version: 0. 
	
	self assert: ((manifestBuilder  toDoOf: 'test' version: 0) anySatisfy: [:each| each = cl]).
	self assert: ((manifestBuilder  toDoOf: 'test' version: 0) anySatisfy: [:each| each = mth]).
	
	manifestBuilder removeToDo: cl of: 'test' version: 0. 
	manifestBuilder removeToDo: mth of: 'test' version: 0. 
	
	self deny: ((manifestBuilder toDoOf: 'test' version: 0) anySatisfy: [:each| each = cl]).
	self deny: ((manifestBuilder toDoOf: 'test' version: 0) anySatisfy: [:each| each = mth]).
	! !

!BuilderManifestTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/6/2014 20:51'!
testAddAllToDo
	
	| manifestBuilder array|
	
	array := {MFClassA. MFClassB  }.
	manifestBuilder := TheManifestBuilder of: MFClassA .
	manifestBuilder  installToDoOf: 'test' version: 0.
	
	self deny: ((manifestBuilder toDoOf: 'test' version: 0) anySatisfy: [:each| each = MFClassA]).
	self deny: ((manifestBuilder toDoOf: 'test' version: 0) anySatisfy: [:each| each = MFClassB]).
	
	manifestBuilder addAllToDo: array of: 'test' version: 0. 
	
	self assert: ((manifestBuilder toDoOf: 'test' version: 0) anySatisfy: [:each| each = MFClassA]).
	self assert: ((manifestBuilder toDoOf: 'test' version: 0) anySatisfy: [:each| each = MFClassB]).
	
	manifestBuilder addAllToDo: array of: 'test' version: 0. 
	
	self assert:  (manifestBuilder manifest ruletestV0TODO size = 2).
! !

!BuilderManifestTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/6/2014 20:51'!
testAddClass
	
	| manifestBuilder|
	
	manifestBuilder := TheManifestBuilder of: MFClassA .
	
	self deny: ((manifestBuilder rejectClasses) anySatisfy: [:each| each = MFClassA]).
	
	manifestBuilder addRejectClass: MFClassA..
	
	self assert: ((manifestBuilder rejectClasses) anySatisfy: [:each| each = MFClassA]).

	manifestBuilder removeRejectClass: MFClassA.	.

	self deny: ((manifestBuilder rejectClasses) anySatisfy: [:each| each = MFClassA]).
	! !

!BuilderManifestTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/6/2014 20:51'!
testAddRule
	
	| manifestBuilder|
	
	manifestBuilder := TheManifestBuilder of: MFClassA .
	
	self deny: ((manifestBuilder rejectRules) anySatisfy: [:each| each = 0]).
	
	manifestBuilder addRejectRule: 0.
	
	self assert: ((manifestBuilder rejectRules) anySatisfy: [:each| each = 0]).

	manifestBuilder removeRejectRule: 0.	

	self deny: ((manifestBuilder rejectRules) anySatisfy: [:each| each = 0]).
	! !

!BuilderManifestTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/6/2014 20:51'!
testCreationManifest
	| manifestBuilder cl |
	manifestBuilder := TheManifestBuilder new.
	cl := Smalltalk globals at: #ManifestManifestResourcesTests ifAbsent: [ nil ].
	cl
		ifNotNil: [ 
			cl
				removeFromChanges;
				removeFromSystemUnlogged ].
	self assert: (manifestBuilder manifestOf: MFClassA ) isNil.
	self assert: (manifestBuilder createManifestOf: MFClassA) notNil.
	self assert: (manifestBuilder manifestOf: MFClassA) notNil! !

!BuilderManifestTest methodsFor: 'running' stamp: 'SimonAllier 5/29/2012 11:19'!
tearDown
	
	| cl |
	cl := Smalltalk globals at: #ManifestManifestResourcesTests ifAbsent: [ nil ].
	cl
		ifNotNil: [ 
			cl
				removeFromChanges;
				removeFromSystemUnlogged ].
! !

!BuilderManifestTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/6/2014 20:51'!
testAddFalsePositive
	
	| manifestBuilder cl mth|
	cl := MFClassA.
	mth := MFClassA >> #method.
	manifestBuilder := TheManifestBuilder of: MFClassA .
	manifestBuilder  installFalsePositiveOf: 'test' version: 0.
	
	self deny: ((manifestBuilder falsePositiveOf: 'test' version: 0) anySatisfy: [:each| each = cl]).
	self deny: ((manifestBuilder falsePositiveOf: 'test' version: 0) anySatisfy: [:each| each = mth]).
	
	manifestBuilder addFalsePositive: cl of: 'test' version: 0. 
	manifestBuilder addFalsePositive: mth of: 'test' version: 0. 
	
	self assert: ((manifestBuilder falsePositiveOf: 'test' version: 0) anySatisfy: [:each| each = cl]).
	self assert: ((manifestBuilder falsePositiveOf: 'test' version: 0) anySatisfy: [:each| each = mth]).
	
	manifestBuilder removeFalsePositive: cl of: 'test' version: 0. 
	manifestBuilder removeFalsePositive: mth of: 'test' version: 0. 
	
	self deny: ((manifestBuilder falsePositiveOf: 'test' version: 0) anySatisfy: [:each| each = cl]).
	self deny: ((manifestBuilder falsePositiveOf: 'test'version: 0) anySatisfy: [:each| each = mth]).
! !

!BuilderManifestTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/6/2014 20:51'!
testContainsToDo
	
	| manifestBuilder |
	

	manifestBuilder := TheManifestBuilder of: MFClassA .
	manifestBuilder  installToDoOf: 'test' version: 0.
	
	manifestBuilder addToDo: MFClassA of: 'test' version: 0. 
	
	self assert: (manifestBuilder containsToDo: MFClassA onRule: 'test' version: 0).
	self deny: (manifestBuilder containsToDo: MFClassB onRule: 'test' version: 0).
	
	
	! !

!BuilderManifestTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/6/2014 20:51'!
testInstallFalsePositive
	| manifestBuilder |
	manifestBuilder := TheManifestBuilder of: MFClassA. .
	self deny: (manifestBuilder hasFalsePositiveOf: 'test' version: 0).
	manifestBuilder installFalsePositiveOf: 'test' version: 0.
	self assert: (manifestBuilder hasFalsePositiveOf: 'test' version: 0).
	self assert: (manifestBuilder falsePositiveOf: 'test' version: 0) notNil.
! !

!BuilderManifestTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/6/2014 20:51'!
testResetFalsePositive
	
	| manifestBuilder array|
	
	array := {MFClassA. MFClassB  }.
	manifestBuilder := TheManifestBuilder of: MFClassA .
	manifestBuilder  installFalsePositiveOf: 'test' version: 0.
	
	manifestBuilder addAllFalsePositive: array of: 'test' version: 0. 
	
	self assert: ((manifestBuilder falsePositiveOf: 'test' version: 0) anySatisfy: [:each| each = MFClassA]).
	self assert: ((manifestBuilder falsePositiveOf: 'test' version: 0) anySatisfy: [:each| each = MFClassB]).
	
	manifestBuilder resetFalsePositiveOf: 'test' version: 0. 
	
	self assert:  (manifestBuilder manifest ruletestV0FalsePositive size = 0).
	
	! !

!BuilderManifestTest methodsFor: 'running' stamp: 'SimonAllier 5/29/2012 11:05'!
setUp
	
	| cl |
	cl := Smalltalk globals at: #ManifestManifestResourcesTests ifAbsent: [ nil ].
	cl
		ifNotNil: [ 
			cl
				removeFromChanges;
				removeFromSystemUnlogged ].
! !

!BuilderManifestTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/6/2014 20:51'!
testAddAllFalsePositive
	
	| manifestBuilder array|
	
	array := {MFClassA. MFClassB  }.
	manifestBuilder := TheManifestBuilder of: MFClassA .
	manifestBuilder  installFalsePositiveOf: 'test' version: 0.
	
	self deny: ((manifestBuilder falsePositiveOf: 'test' version: 0) anySatisfy: [:each| each = MFClassA]).
	self deny: ((manifestBuilder falsePositiveOf: 'test' version: 0) anySatisfy: [:each| each = MFClassB]).
	
	manifestBuilder addAllFalsePositive: array of: 'test' version: 0. 
	
	self assert: ((manifestBuilder falsePositiveOf: 'test' version: 0) anySatisfy: [:each| each = MFClassA]).
	self assert: ((manifestBuilder falsePositiveOf: 'test' version: 0) anySatisfy: [:each| each = MFClassB]).
	
	manifestBuilder addAllFalsePositive: array of: 'test' version: 0. 
	
	self assert:  (manifestBuilder manifest ruletestV0FalsePositive size = 2).
	
	manifestBuilder removeAllFalsePositive: array of: 'test' version: 0. 
	
	self deny: ((manifestBuilder falsePositiveOf: 'test' version: 0) anySatisfy: [:each| each = MFClassA]).
	self deny: ((manifestBuilder falsePositiveOf: 'test' version: 0) anySatisfy: [:each| each = MFClassB]).
	
	"manifestBuilder manifest class removeSelector: (manifestBuilder selectorFalsePositiveOf: 'test' version: 0)"! !

!BuilderManifestTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/6/2014 20:51'!
testCleanUpFP
	| manifestBuilder |
	
	manifestBuilder := TheManifestBuilder of: MFClassA. .
	MFClassA compile:  'foo'.
	manifestBuilder installFalsePositiveOf: 'test' version: 0.
	manifestBuilder addFalsePositive: (MFClassA>>#foo) of:  'test' version: 0. 
	
	self assert: (manifestBuilder containsFalsePositive: (MFClassA>>#foo) onRule: 'test' version: 0).
	
	MFClassA removeSelector: #foo.
	manifestBuilder cleanUp.
	
	self assert: ((manifestBuilder falsePositiveOf: 'test' version: 0 ) size = 0) .
! !

!BuilderManifestTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/6/2014 20:51'!
testDateOfFalsePositive
	
	| manifestBuilder date1 date2 |
	

	manifestBuilder := TheManifestBuilder of: MFClassA .
	manifestBuilder  installFalsePositiveOf: 'test' version: 0.
	
	date1 :=  DateAndTime current.
	manifestBuilder addFalsePositive: MFClassA of: 'test' version: 0. 
	date2 :=  DateAndTime current.
	
	self assert: (manifestBuilder dateOfFalsePositive: MFClassA onRule: 'test' version: 0) >= date1 .
	self assert: (manifestBuilder dateOfFalsePositive: MFClassA onRule: 'test' version: 0) <= date2 .
	
	
	
	! !

!BuilderManifestTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/6/2014 20:51'!
testIsClassAManifest
	"self debug: #testIsClassAManifest"
	
	self deny: Point isManifest.
	TheManifestBuilder of: MFClassA. 
	self assert: ( (Smalltalk at: #ManifestManifestResourcesTests) isManifest)! !

!BuilderManifestTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/6/2014 20:51'!
testCreationManifestOn
	| manifestBuilder cl |
	manifestBuilder := TheManifestBuilder new.
	cl := Smalltalk globals at: #ManifestManifestResourcesTests ifAbsent: [ nil ].
	cl
		ifNotNil: [ 
			cl
				removeFromChanges;
				removeFromSystemUnlogged ].
	self assert: (manifestBuilder manifestOf: MFClassA ) isNil.
	self assert: (TheManifestBuilder of: MFClassA) notNil.
	self assert: (manifestBuilder manifestOf: MFClassA) notNil! !

!BuilderManifestTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/6/2014 20:51'!
testResetToDo
	
	| manifestBuilder array|
	
	array := {MFClassA. MFClassB  }.
	manifestBuilder := TheManifestBuilder of: MFClassA .
	manifestBuilder  installToDoOf: 'test' version: 0.
	
	manifestBuilder addAllToDo: array of: 'test' version: 0. 
	
	self assert: ((manifestBuilder toDoOf: 'test' version: 0) anySatisfy: [:each| each = MFClassA]).
	self assert: ((manifestBuilder toDoOf: 'test' version: 0) anySatisfy: [:each| each = MFClassB]).
	
	manifestBuilder resetToDoOf: 'test' version: 0. 
	
	self assert:  (manifestBuilder manifest ruletestV0TODO size = 0).
	
	! !

!BuilderManifestTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/6/2014 20:51'!
testCleanUpTD
	| manifestBuilder |
	
	manifestBuilder := TheManifestBuilder of: MFClassA. .
	MFClassA compile:  'foo'.
	manifestBuilder installToDoOf: 'test' version: 0.
	manifestBuilder addToDo: (MFClassA>>#foo) of: 'test' version: 0. 
	
	self assert: (manifestBuilder containsToDo: (MFClassA>>#foo) onRule: 'test' version: 0).
	
	MFClassA removeSelector: #foo.
	manifestBuilder cleanUp.
	
	self assert: ((manifestBuilder toDoOf: 'test' version: 0 ) size = 0) .
! !

!BuilderManifestTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/6/2014 20:51'!
testDateOfToDo
	
	| manifestBuilder date1 date2 |
	

	manifestBuilder := TheManifestBuilder of: MFClassA .
	manifestBuilder  installToDoOf: 'test' version: 0.
	
	date1 :=  DateAndTime current.
	manifestBuilder addToDo: MFClassA of: 'test' version: 0. 
	date2 :=  DateAndTime current.
	
	self assert: (manifestBuilder dateOfToDo: MFClassA onRule: 'test' version: 0) >= date1 .
	self assert: (manifestBuilder dateOfToDo: MFClassA onRule: 'test' version: 0) <= date2 .
	
	
	
	! !

!BuilderManifestTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/6/2014 20:51'!
testContainsFalsePositive
	
	| manifestBuilder |
	

	manifestBuilder := TheManifestBuilder of: MFClassA .
	manifestBuilder  installFalsePositiveOf: 'test' version: 0.
	
	manifestBuilder addFalsePositive: MFClassA of: 'test' version: 0. 
	
	self assert: (manifestBuilder containsFalsePositive: MFClassA onRule: 'test' version: 0).
	self deny: (manifestBuilder containsFalsePositive: MFClassB onRule: 'test' version: 0).
	
	
	! !

!BuilderManifestTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/6/2014 20:51'!
testInstallToDo
	| manifestBuilder |
	
	manifestBuilder := TheManifestBuilder of: MFClassA. .
	self deny: (manifestBuilder hasToDoOf: 'test' version: 0).
	manifestBuilder installToDoOf: 'test' version: 0.
	self assert: (manifestBuilder hasToDoOf: 'test' version: 0).
	self assert: (manifestBuilder toDoOf: 'test' version: 0) notNil.
	! !

!BuilderManifestTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/6/2014 20:51'!
testIsFalsePositive
	
	| manifestBuilder cl mth|
	cl := MFClassA.
	mth := cl >> #method.
	manifestBuilder := TheManifestBuilder of: MFClassA .
	self deny: (manifestBuilder isFalsePositive: mth onRule: 'test' version:0 ).
	
	manifestBuilder addRejectClass: MFClassA.
	self assert: (manifestBuilder isFalsePositive: mth onRule: 'test' version:0 ).
	
	manifestBuilder removeRejectClass: MFClassA.	.
	self deny: (manifestBuilder isFalsePositive: mth onRule: 'test' version:0 ).
	
	manifestBuilder addRejectRule: 'test'.
	self assert: (manifestBuilder isFalsePositive: mth onRule: 'test' version:0 ).
	
	manifestBuilder removeRejectRule: 'test'.
	self deny: (manifestBuilder isFalsePositive: mth onRule: 'test' version:0 ).
	
	manifestBuilder installFalsePositiveOf: 'test' version: 0.
	manifestBuilder addFalsePositive:  mth of: 'test' version: 0.
	self assert: (manifestBuilder isFalsePositive: mth onRule: 'test' version:0 ).
	
	! !

!ButtonModel commentStamp: '<historical>'!
A ButtonComposableModel is an applicative model which handle a basic button.

self example!
!ButtonModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:31'!
whenLabelChangedDo: aBlock
	"set a block to perform after that the button has been aclicked, and its action performed"

	labelHolder whenChangedDo: aBlock! !

!ButtonModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
askBeforeChanging

	^ askBeforeChangingHolder value! !

!ButtonModel methodsFor: 'morphic' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
performAction

	actionHolder value value.
	" Here I set a dummy value just to make the holder raise an event "
	actionPerformedHolder value: nil.! !

!ButtonModel methodsFor: 'initialization' stamp: 'StephaneDucasse 2/26/2015 16:23'!
initialize

	super initialize.

	actionHolder := [] asValueHolder.
	labelHolder := '' asValueHolder.
	iconHolder := nil asValueHolder.
	stateHolder := false asValueHolder.
	helpHolder := nil asValueHolder.
	actionPerformedHolder := nil asValueHolder.
	askBeforeChangingHolder := false asValueHolder.
	shortcutHolder := nil asValueHolder.
	
	labelHolder whenChangedDo: [ self changed: #label ].
	iconHolder whenChangedDo: [ self changed: #label ].
	stateHolder whenChangedDo: [ self changed: #state ].
	enabledHolder whenChangedDo: [ self changed: #enabled ].
	askBeforeChangingHolder whenChangedDo: [:newValue | self changed: { #askBeforeChanging: . newValue} ].
	shortcutHolder whenChangedDo: [ :newShortcut :oldShortcut |
		self unregisterShortcut: oldShortcut.
		self registerShortcut: newShortcut.
		self changed: #label ].
	
	menuHolder := MenuModel new asValueHolder.	
	menuHolder whenChangedDo: [ :aMenuModel :oldMenu | 
		(oldMenu isNil or: [ oldMenu isBlock ]) ifFalse: [ oldMenu neglect: self ].
		(aMenuModel isNil or: [ aMenuModel isBlock ]) ifFalse: [ aMenuModel applyTo: self ] ].
		
	self bindKeyCombination: Character space toAction: [ self action ].! !

!ButtonModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 1/5/2014 15:54'!
menu: aMenu

	menuHolder value: aMenu! !

!ButtonModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 1/15/2014 10:15'!
addShortcutTipFor: aCharacter on: aString
	| index text |
	
	aString isNil ifTrue: [ ^ nil ].
	text := aString asText.
	aCharacter ifNil: [ ^ text ].
	index := aString asLowercase indexOf: aCharacter asLowercase.
	index isZero ifTrue: [ ^ text ].
	
	^ text
		addAttribute: (TextEmphasis underlined) 
		from: index
		to: index;
		yourself! !

!ButtonModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:18'!
action
	"<api: #inspect>"
	"get the block performed when the button is clicked"

	^ actionHolder value! !

!ButtonModel methodsFor: 'private-focus' stamp: 'BenjaminVanRyseghem 12/11/2013 18:14'!
ensureKeyBindingsFor: widget

	super ensureKeyBindingsFor: widget.
	self shortcut ifNotNil: [ :s | self registerShortcut: s ]! !

!ButtonModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:22'!
label: aStringOrImageMorph
	"<api: #string getter: #label registration: #whenLabelChangedDo:>"

	labelHolder value: aStringOrImageMorph! !

!ButtonModel methodsFor: 'api-events' stamp: 'BenjaminVanRyseghem 9/25/2013 14:49'!
whenActionChangedDo: aBlock 

	actionHolder whenChangedDo: aBlock! !

!ButtonModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
askBeforeChanging: aBoolean

	askBeforeChangingHolder value: aBoolean! !

!ButtonModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:22'!
state: aBoolean
	"<api: #boolean getter: #state registration: #whenStateChangedDo:>"
	"set if the button is highlighted"
	
	^ stateHolder value: aBoolean! !

!ButtonModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:31'!
whenActionPerformedDo: aBlock
	"set a block to perform after that the button has been aclicked, and its action performed"

	actionPerformedHolder whenChangedDo: aBlock! !

!ButtonModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 1/5/2014 15:54'!
menu

	^ menuHolder value! !

!ButtonModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:23'!
shortcut: aShortcut

	shortcutHolder value: aShortcut! !

!ButtonModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/11/2013 18:27'!
registerShortcut: newShortcut
	| receiver |
	receiver := self window.
	(receiver isNil or: [ newShortcut isNil ]) ifTrue: [ ^ self ].

	receiver model
		bindKeyCombination: newShortcut 
		toAction: [ self performAction ]! !

!ButtonModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:45'!
action: aBlock
	"set the block performed when the button is clicked"
	"<api: #block getter: #getAction registration: #whenActionChangedDo:>"

	actionHolder value: aBlock! !

!ButtonModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:23'!
shortcut

	^ shortcutHolder value! !

!ButtonModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:11'!
getAction
	"<api: #inspect>"
	"get the block performed when the button is clicked"

	^ actionHolder value! !

!ButtonModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/11/2013 18:27'!
unregisterShortcut: oldShortcut
	| receiver |
	receiver := self window.
	(receiver isNil or: [ oldShortcut isNil ]) ifTrue: [ ^ self ].

	receiver model
		removeKeyCombination: oldShortcut ! !

!ButtonModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
icon: anIcon

	iconHolder value: anIcon! !

!ButtonModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:31'!
whenStateChangedDo: aBlock
	"set a block to perform after that the button has been aclicked, and its action performed"

	stateHolder whenChangedDo: aBlock! !

!ButtonModel methodsFor: 'morphic' stamp: 'StephaneDucasse 2/26/2015 17:06'!
state
	"<api: #inspect>"
	^ stateHolder value! !

!ButtonModel methodsFor: 'morphic' stamp: 'StephaneDucasse 2/26/2015 17:17'!
label
	"<api: #inspect>"
	
 	^ self addShortcutTipFor: labelHolder value! !

!ButtonModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/11/2013 14:56'!
addShortcutTipFor: aString

	^ self 
		addShortcutTipFor: self shortcutCharacter
		on: aString! !

!ButtonModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/11/2013 15:05'!
shortcutCharacter

	^ self shortcut 
		ifNil: [ nil ]
		ifNotNil: [ :s | s currentCharacter ]! !

!ButtonModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
icon

	^ iconHolder value! !

!ButtonModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/1/2013 13:38'!
defaultSpec
	<spec>
	
	^ #(ButtonAdapter
		adapt: #(model))! !

!ButtonModel class methodsFor: 'example' stamp: 'BenjaminVanRyseghem 9/25/2013 14:50'!
example

	| b |
	b:= ButtonModel new.
	b openWithSpec.
	b label: 'Click me'.! !

!ButtonModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 9/25/2013 14:50'!
title

	^ 'Button'! !

!ButtonModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/13/2014 15:19'!
adapterName

	^ #ButtonAdapter! !

!ButtonModelTest commentStamp: 'TorstenBergmann 2/5/2014 09:21'!
SUnit tests for Button model!
!ButtonModelTest methodsFor: 'as yet unclassified' stamp: 'BenjaminVanRyseghem 7/18/2013 13:48'!
testAskBeforeChanging
	|buttonModel window state|
	
	buttonModel := ButtonModel new.

	self assert: buttonModel askBeforeChanging not.
	window := buttonModel openWithSpec.
	state := buttonModel widget askBeforeChanging.
	self assert: state not.
	buttonModel askBeforeChanging: true.
	state := buttonModel widget askBeforeChanging.
	window close.
	self assert: state
! !

!ByteArray commentStamp: '<historical>'!
I represent an ArrayedCollection whose elements are integers between 0 and 255.
!
!ByteArray methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 11/23/2012 18:07'!
nbUInt16AtOffset: zeroBasedOffset
	
	"Reads unsigned 16-bit integer from memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(uint16 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			mov: asm EAX ptr16 + asm ECX to: asm AX
	]
! !

!ByteArray methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 11/23/2012 18:07'!
nbUInt64AtOffset: zeroBasedOffset
	
	"Reads unsigned 64-bit integer from memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(uint64 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			mov: asm EAX ptr + asm ECX + 4 to: asm EDX;
			mov: asm EAX ptr + asm ECX to: asm EAX
	]
! !

!ByteArray methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 11/23/2012 18:04'!
nbFloat64AtOffset: zeroBasedOffset put: value
	"Store 64-bit float at ZERO-based index.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCallout function: #(void (self, ulong zeroBasedOffset, float64 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			add: asm EAX with: asm ECX;
			
			mov: asm ESP ptr to: asm ECX;
			mov: asm ECX to: asm EAX ptr;

			mov: asm ESP ptr +4 to: asm ECX;
			mov: asm ECX to: asm EAX ptr +4 
	] ! !

!ByteArray methodsFor: '*System-Hashing-Core' stamp: 'StephaneDucasse 10/17/2009 17:15'!
bitXor: aByteArray 
	| answer |
	answer := self copy.
	1 
		to: (self size min: aByteArray size)
		do: 
			[ :each | 
			answer 
				at: each
				put: ((self at: each) bitXor: (aByteArray at: each)) ].
	^ answer! !

!ByteArray methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 11/23/2012 18:07'!
nbUInt16AtOffset: zeroBasedOffset  put: value
	
	"Store unsigned 16-bit integer into memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCallout function: #(void (self, ulong zeroBasedOffset, uint16 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX; "value"
			mov: asm DX to: asm EAX ptr16 + asm ECX
	] ! !

!ByteArray methodsFor: 'platform independent access' stamp: 'jmb 12/3/2004 14:54'!
doubleAt: index bigEndian: bool 
	"Return a 64 bit float starting from the given byte index"
	| w1 w2 dbl |
	w1 := self unsignedLongAt: index bigEndian: bool.
	w2 := self unsignedLongAt: index + 4 bigEndian: bool.
	dbl := Float new: 2. 
	bool
		ifTrue: [dbl basicAt: 1 put: w1.
			dbl basicAt: 2 put: w2]
		ifFalse: [dbl basicAt: 1 put: w2.
			dbl basicAt: 2 put: w1].
	^ dbl! !

!ByteArray methodsFor: '*Zinc-Character-Encoding-Core' stamp: 'SvenVanCaekenberghe 9/15/2014 13:37'!
utf8Decoded
	"Produce a String decoding the receiver using UTF-8,
	the recommended encoding for Strings, unless you know what you are doing."

	"#[76 101 115 32 195 169 108 195 168 118 101 115 32 102 114 97 110 195 167 97 105 115] utf8Decoded"
	
	^ self decodeWith: #utf8! !

!ByteArray methodsFor: 'platform independent access' stamp: 'ar 11/1/1998 20:44'!
longAt: index bigEndian: aBool
	"Return a 32bit integer quantity starting from the given byte index"
	| b0 b1 b2 w h |
	aBool ifTrue:[
		b0 := self at: index.
		b1 := self at: index+1.
		b2 := self at: index+2.
		w := self at: index+3.
	] ifFalse:[
		w := self at: index.
		b2 := self at: index+1.
		b1 := self at: index+2.
		b0 := self at: index+3.
	].
	"Minimize LargeInteger arithmetic"
	h := ((b0 bitAnd: 16r7F) - (b0 bitAnd: 16r80) bitShift: 8) + b1.
	b2 = 0 ifFalse:[w := (b2 bitShift: 8) + w].
	h = 0 ifFalse:[w := (h bitShift: 16) + w].
	^w! !

!ByteArray methodsFor: 'platform independent access' stamp: 'ar 8/2/2003 19:29'!
longAt: index put: value bigEndian: aBool
	"Return a 32bit integer quantity starting from the given byte index"
	| b0 b1 b2 b3 |
	b0 := value bitShift: -24.
	b0 := (b0 bitAnd: 16r7F) - (b0 bitAnd: 16r80).
	b0 < 0 ifTrue:[b0 := 256 + b0].
	b1 := (value bitShift: -16) bitAnd: 255.
	b2 := (value bitShift: -8) bitAnd: 255.
	b3 := value bitAnd: 255.
	aBool ifTrue:[
		self at: index put: b0.
		self at: index+1 put: b1.
		self at: index+2 put: b2.
		self at: index+3 put: b3.
	] ifFalse:[
		self at: index put: b3.
		self at: index+1 put: b2.
		self at: index+2 put: b1.
		self at: index+3 put: b0.
	].
	^value! !

!ByteArray methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 11/23/2012 18:05'!
nbInt64AtOffset: zeroBasedOffset  put: value
	
	"Store signed 64-bit integer into memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong zeroBasedOffset, int64 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX; "value low word"
			mov: asm EDX to: asm EAX ptr32 + asm ECX;
			pop: asm EDX; "value high word"
			mov: asm EDX to: asm EAX ptr32 + asm ECX + 4
	]
! !

!ByteArray methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 10/6/2014 06:48'!
gtInspectorBytesIn: composite
	<gtInspectorPresentationOrder: 30>
	^ composite table
		title: 'Bytes';
		display: [ 
			(self size < 2048 or: [ self confirm: 'Looking at more than 2048 bytes might be slow. Continue ?' ])
				ifTrue: [ {
					'hex string' -> (String streamContents: [ :out | 
						self do: [ :each | 
							each printOn: out base: 16 nDigits: 2 ] ]).
					'hex lines' -> (String streamContents: [ :out |
						self withIndexDo: [ :each :index |
							index = 1 ifFalse: [ 
								index - 1 \\ 8 = 0 ifTrue: [ out cr ] ifFalse: [ out space ] ].
								each printOn: out base: 16 nDigits: 2 ] ]).
					'latin1' -> ([ ZnByteEncoder latin1 decodeBytes: self ]
											on: ZnCharacterEncodingError do: [ :exception | exception ]).
					'utf8' -> ([ ZnUTF8Encoder new decodeBytes: self ] 
											on: ZnCharacterEncodingError do: [ :exception | exception ]).
					'integer' -> self asInteger.
					'integer reversed' -> self reversed asInteger } ]
				ifFalse: [ #() ] ];
		column: 'Key' evaluated: #key;
		column: 'Value' evaluated: #value;
		send: #value! !

!ByteArray methodsFor: '*Network-Mime' stamp: 'StephaneDucasse 10/3/2010 15:15'!
base64Encoded
	"Encode the receiver as base64"
	"'Hello World' asByteArray base64Encoded"
	^(Base64MimeConverter mimeEncode: self readStream) contents! !

!ByteArray methodsFor: '*Compression' stamp: 'nk 8/21/2004 15:23'!
lastIndexOfPKSignature: aSignature
	"Answer the last index in me where aSignature (4 bytes long) occurs, or 0 if not found"
	| a b c d |
	a := aSignature first.
	b := aSignature second.
	c := aSignature third.
	d := aSignature fourth.
	(self size - 3) to: 1 by: -1 do: [ :i |
		(((self at: i) = a)
			and: [ ((self at: i + 1) = b)
				and: [ ((self at: i + 2) = c)
					and: [ ((self at: i + 3) = d) ]]])
						ifTrue: [ ^i ]
	].
	^0! !

!ByteArray methodsFor: 'accessing' stamp: 'StephaneDucasse 9/18/2010 21:24'!
indexOf: anInteger startingAt: start

	(anInteger isInteger and: [
		anInteger >= 0 and: [
		anInteger <= 255 ] ]) ifFalse: [ ^0 ].
	^ByteString indexOfAscii: anInteger inString: self startingAt: start! !

!ByteArray methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 11/23/2012 18:06'!
nbLongAt: index put: value
	"Store signed long at one-based index.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong index, long value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "index"
			add: asm EAX with: asm ECX;
			pop: asm ECX; "value"
			mov: asm ECX to: asm EAX ptr -1
	] ! !

!ByteArray methodsFor: '*Zinc-Character-Encoding-Core' stamp: 'SvenVanCaekenberghe 9/15/2014 13:37'!
decodeWith: encoding
	"Produce a String that decodes the receiver, using a specified encoding.
	Encoding is either a ZnCharacterEncoder instance or an identifier for one."
	
	"#[76 101 115 32 195 169 108 195 168 118 101 115 32 102 114 97 110 195 167 97 105 115] decodeWith: #utf8"
	
	^ encoding asZnCharacterEncoder decodeBytes: self! !

!ByteArray methodsFor: 'converting' stamp: ''!
asString
	"Convert to a String with Characters for each byte.
	Fast code uses primitive that avoids character conversion"

	^ (String new: self size) replaceFrom: 1 to: self size with: self! !

!ByteArray methodsFor: 'accessing' stamp: 'ar 12/5/1998 14:52'!
byteAt: index
	<primitive: 60>
	^self at: index! !

!ByteArray methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 11/23/2012 18:08'!
nbUInt8AtOffset: zeroBasedOffset
	
	"Reads unsigned 8-bit integer from memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(uint8 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			mov: asm EAX ptr8 + asm ECX to: asm AL
	]
! !

!ByteArray methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 11/23/2012 18:08'!
nbUInt8AtOffset: zeroBasedOffset  put: value
	
	"Store unsigned 8-bit integer into memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong zeroBasedOffset, uint8 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX; "value"
			mov: asm DL to: asm EAX ptr8 + asm ECX
	] ! !

!ByteArray methodsFor: '*System-Hashing-Core' stamp: 'cmm 2/21/2006 00:05'!
destroy
	1 to: self size do: 
		[ : x |
		self at: x put: 0 ]! !

!ByteArray methodsFor: 'platform independent access' stamp: 'SergeStinckwich 2/19/2009 13:33'!
floatAt: index bigEndian: boolean 
	^ Float
		fromIEEE32Bit: (self unsignedLongAt: index bigEndian: boolean)! !

!ByteArray methodsFor: 'platform independent access' stamp: 'ar 11/1/1998 20:51'!
unsignedShortAt: index bigEndian: aBool
	"Return a 16 bit unsigned integer quantity starting from the given byte index"
	^aBool 
		ifTrue:[((self at: index) bitShift: 8) + (self at: index+1)]
		ifFalse:[((self at: index+1) bitShift: 8) + (self at: index)].! !

!ByteArray methodsFor: '*System-Hashing-Core' stamp: 'rww 4/11/2004 14:48'!
asByteArrayOfSize: size
	"
		'34523' asByteArray asByteArrayOfSize: 100.

	(((
		| repeats bytes | 
		repeats := 1000000.
		bytes := '123456789123456789123456789123456789123456789123456789' asByteArray.
		 [repeats timesRepeat: (bytes asByteArrayOfSize: 1024) ] timeToRun.
	)))"

	| bytes |
	size < self size
		ifTrue: [^ self error: 'bytearray bigger than ', size asString].
	bytes := self asByteArray.
	^ (ByteArray new: (size - bytes size)), bytes
! !

!ByteArray methodsFor: 'platform independent access' stamp: 'jmb 12/3/2004 14:54'!
doubleAt: index put: value bigEndian: bool 
	"Store a 64 bit float starting from the given byte index"
	| w1 w2 |
	bool
		ifTrue: [w1 := value basicAt: 1.
			w2 := value basicAt: 2]
		ifFalse: [w1 := value basicAt: 2.
			w2 := value basicAt: 1]. 
	self unsignedLongAt: index put: w1 bigEndian: bool.
	self unsignedLongAt: index + 4 put: w2 bigEndian: bool.
	^ value! !

!ByteArray methodsFor: 'private' stamp: ''!
replaceFrom: start to: stop with: replacement startingAt: repStart 
	"Primitive. This destructively replaces elements from start to stop in the receiver starting at index, repStart, in the collection, replacement. Answer the receiver. Range checks are performed in the primitive only. Optional. See Object documentation whatIsAPrimitive."
	<primitive: 105>
	super replaceFrom: start to: stop with: replacement startingAt: repStart! !

!ByteArray methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 11/23/2012 18:07'!
nbUInt64AtOffset: zeroBasedOffset  put: value
	
	"Store unsigned 64-bit integer into memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong zeroBasedOffset, uint64 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX; "value low word"
			mov: asm EDX to: asm EAX ptr32 + asm ECX;
			pop: asm EDX; "value high word"
			mov: asm EDX to: asm EAX ptr32 + asm ECX + 4
	]
! !

!ByteArray methodsFor: 'accessing' stamp: 'sma 4/22/2000 17:47'!
atAllPut: value
	"Fill the receiver with the given value"

	<primitive: 145>
	super atAllPut: value! !

!ByteArray methodsFor: 'converting' stamp: 'sma 5/12/2000 17:35'!
asByteArray
	^ self! !

!ByteArray methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 11/23/2012 18:06'!
nbLongAt: index
	"Read signed long at one-based index.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout 
		options: #( optCheckFailOnEveryArgument );
		function: #(long (self, ulong index)) emit: [:gen |
			| asm |
			
			asm := gen asm.
			asm 
				pop: asm EAX;  "pointer to receiver's first byte"
				pop: asm ECX; "index"
				mov: asm EAX ptr + asm ECX -1 to: asm EAX.
		] ! !

!ByteArray methodsFor: 'converting' stamp: 'StephaneDucasse 2/28/2010 11:56'!
hex
    " an alternate implementation was | result stream |
	result := String new: self size * 2.
	stream := result writeStream.
	1 to: self size do: [ :ix | |each|
		each := self at: ix.
		stream
			nextPut: ('0123456789ABCDEF' at: each // 16 + 1);
			nextPut: ('0123456789ABCDEF' at: each \\ 16 + 1)].
    ^ result"
	
	"Answer a hexa decimal representation of the receiver"
	| string v index map |
	map := '0123456789abcdef'.
	string := String new: self size * 2. "hex"
	index := 0.
	1 to: self size do: [ :i |
		v := self at: i.
		string at: (index := index + 1) put: (map at: (v bitShift: -4) + 1).
		string at: (index := index + 1) put: (map at: (v bitAnd: 15) + 1)].
	^string! !

!ByteArray methodsFor: 'platform independent access' stamp: 'ar 11/3/1998 14:20'!
shortAt: index put: value bigEndian: aBool
	"Store a 16 bit integer quantity starting from the given byte index"
	self unsignedShortAt: index put: (value bitAnd: 16r7FFF) - (value bitAnd: -16r8000) bigEndian: aBool.
	^value! !

!ByteArray methodsFor: 'accessing' stamp: 'ar 3/3/2001 16:17'!
byteSize
	^self size! !

!ByteArray methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 11/23/2012 18:03'!
nbFloat32AtOffset: zeroBasedOffset put: value
	"Store 32-bit float at ZERO-based index.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function:#(void (self, ulong zeroBasedOffset, float32 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX;
			mov: asm EDX to: asm EAX ptr + asm ECX
	] ! !

!ByteArray methodsFor: '*Fuel' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper

	^aGeneralMapper visitBytesObject: self! !

!ByteArray methodsFor: 'platform independent access' stamp: 'ar 11/1/1998 20:57'!
shortAt: index bigEndian: aBool
	"Return a 16 bit integer quantity starting from the given byte index"
	| uShort |
	uShort := self unsignedShortAt: index bigEndian: aBool.
	^(uShort bitAnd: 16r7FFF) - (uShort bitAnd: 16r8000)! !

!ByteArray methodsFor: 'platform independent access' stamp: 'ar 11/1/1998 20:53'!
unsignedShortAt: index put: value bigEndian: aBool
	"Store a 16 bit unsigned integer quantity starting from the given byte index"
	aBool ifTrue:[
		self at: index put: (value bitShift: -8).
		self at: index+1 put: (value bitAnd: 255).
	] ifFalse:[
		self at: index+1 put: (value bitShift: -8).
		self at: index put: (value bitAnd: 255).
	].
	^value! !

!ByteArray methodsFor: 'accessing' stamp: 'ar 4/12/2005 17:35'!
asWideString

	^ WideString fromByteArray: self.
! !

!ByteArray methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 11/23/2012 18:09'!
nbUlongAt: index put: value
	"Store unsigned long at one-based index.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^  self nbCallout function: #(void (self, ulong index, ulong value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "index"
			add: asm EAX with: asm ECX;
			pop: asm ECX; "value"
			mov: asm ECX to: asm EAX ptr -1
	] ! !

!ByteArray methodsFor: '*System-Hashing-Core' stamp: 'SvenVanCaekenberghe 4/18/2011 20:40'!
asInteger
	"Convert me to an Integer, network byte order, most significant byte first, big endian"
	
	| integer |
	integer := 0.
	self withIndexDo: [ :each :index | 
		integer := integer + (each bitShift: (self size - index) * 8) ].
	^ integer! !

!ByteArray methodsFor: 'printing' stamp: 'stephane.ducasse 2/1/2009 22:39'!
printOn: aStream

	aStream nextPutAll: '#['.
	self
		do: [ :each | each printOn: aStream ]
		separatedBy: [ aStream nextPut: $ ].
	aStream nextPut: $]! !

!ByteArray methodsFor: 'platform independent access' stamp: 'ar 11/1/1998 20:49'!
unsignedLongAt: index put: value bigEndian: aBool
	"Store a 32bit unsigned integer quantity starting from the given byte index"
	| b0 b1 b2 b3 |
	b0 := value bitShift: -24.
	b1 := (value bitShift: -16) bitAnd: 255.
	b2 := (value bitShift: -8) bitAnd: 255.
	b3 := value bitAnd: 255.
	aBool ifTrue:[
		self at: index put: b0.
		self at: index+1 put: b1.
		self at: index+2 put: b2.
		self at: index+3 put: b3.
	] ifFalse:[
		self at: index put: b3.
		self at: index+1 put: b2.
		self at: index+2 put: b1.
		self at: index+3 put: b0.
	].
	^value! !

!ByteArray methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 11/23/2012 18:04'!
nbInt32AtOffset: zeroBasedOffset
	
	"Reads signed 32-bit integer from memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(int32 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			mov: asm EAX ptr32 + asm ECX to: asm EAX
	]
! !

!ByteArray methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 11/23/2012 18:05'!
nbInt32AtOffset: zeroBasedOffset  put: value
	
	"Store signed 32-bit integer into memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong zeroBasedOffset, int32 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX; "value"
			mov: asm EDX to: asm EAX ptr32 + asm ECX
	]
! !

!ByteArray methodsFor: 'initialize-release' stamp: 'StephaneDucasse 2/28/2010 12:03'!
readHexFrom: aStream
	"Initialize the receiver from a hexadecimal string representation"
	| map v ch value |
	map := '0123456789abcdefABCDEF'.
	1 to: self size do: [ :i |
		ch := aStream next.
		v := (map indexOf: ch) - 1.
		((v between: 0 and: 15) or: [((v:= v - 6) between: 0 and: 15)]) ifFalse:[^self error: 'Hex digit 
expected'].
		value := v bitShift: 4.
		ch := aStream next.
		v := (map indexOf: ch) - 1.
		((v between: 0 and: 15) or: [((v:= v - 6) between: 0 and: 15)]) ifFalse:[^self error: 'Hex digit 
expected'].
		value := value + v.
		self at: i put: value].! !

!ByteArray methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 11/23/2012 18:05'!
nbInt64AtOffset: zeroBasedOffset
	
	"Reads signed 64-bit integer from memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(int64 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			mov: asm EAX ptr + asm ECX + 4 to: asm EDX;
			mov: asm EAX ptr + asm ECX to: asm EAX
	]
! !

!ByteArray methodsFor: 'comparing' stamp: 'SqR 8/13/2002 10:52'!
hash
	"#hash is implemented, because #= is implemented"

	^self class
		hashBytes: self
		startingWith: self species hash! !

!ByteArray methodsFor: 'printing' stamp: 'stephane.ducasse 2/1/2009 22:40'!
storeOn: aStream
	aStream nextPutAll: '#['.
	self
		do: [ :each | each storeOn: aStream ]
		separatedBy: [ aStream nextPut: $ ].
	aStream nextPut: $]! !

!ByteArray methodsFor: 'platform independent access' stamp: 'ar 11/1/1998 20:49'!
unsignedLongAt: index bigEndian: aBool
	"Return a 32bit unsigned integer quantity starting from the given byte index"
	| b0 b1 b2 w |
	aBool ifTrue:[
		b0 := self at: index.
		b1 := self at: index+1.
		b2 := self at: index+2.
		w := self at: index+3.
	] ifFalse:[
		w := self at: index.
		b2 := self at: index+1.
		b1 := self at: index+2.
		b0 := self at: index+3.
	].
	"Minimize LargeInteger arithmetic"
	b2 = 0 ifFalse:[w := (b2 bitShift: 8) + w].
	b1 = 0 ifFalse:[w := (b1 bitShift: 16) + w].
	b0 = 0 ifFalse:[w := (b0 bitShift: 24) + w].
	^w! !

!ByteArray methodsFor: 'testing' stamp: 'StephaneDucasse 12/30/2010 14:29'!
isLiteral
	"so that #(1 #[1 2 3] 5) prints itself"
	""
	^ self class == ByteArray! !

!ByteArray methodsFor: 'accessing' stamp: 'ar 12/5/1998 14:52'!
byteAt: index put: value
	<primitive: 61>
	^self at: index put: value! !

!ByteArray methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 11/23/2012 18:03'!
nbFloat32AtOffset: zeroBasedOffset
	"Read 32-bit float at ZERO-based index.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(float32 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			add: asm EAX with: asm ECX;
			fld: asm EAX ptr32. "load a floating point value from memory, at base address, held in EAX register into fp(0) register,
				we are using #ptr32, to indicate that memory operand size is 32bits long"
	] ! !

!ByteArray methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 11/23/2012 18:04'!
nbFloat64AtOffset: zeroBasedOffset
	"Read 64-bit float at ZERO-based index.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCallout function: #(float64 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "index"
			add: asm EAX with: asm ECX;
			fld: asm EAX ptr64. "load a floating point value from memory, at base address, held in EAX register into fp(0) register,
				we are using #ptr64, to indicate that memory operand size is 64bits long"
	] ! !

!ByteArray methodsFor: '*Network-Kernel' stamp: 'mir 6/17/2007 23:12'!
asSocketAddress
	^SocketAddress fromOldByteAddress: self! !

!ByteArray methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 11/23/2012 18:04'!
nbInt16AtOffset: zeroBasedOffset
	
	"Reads signed 16-bit integer from memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(int16 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			mov: asm EAX ptr16 + asm ECX to: asm AX
	]
! !

!ByteArray methodsFor: 'private' stamp: ''!
defaultElement

	^0! !

!ByteArray methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 11/23/2012 18:04'!
nbInt16AtOffset: zeroBasedOffset  put: value
	
	"Store signed 16-bit integer into memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong zeroBasedOffset, int16 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX; "value"
			mov: asm DX to: asm EAX ptr16 + asm ECX
	]
! !

!ByteArray methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 11/23/2012 18:05'!
nbInt8AtOffset: zeroBasedOffset
	
	"Reads signed 8-bit integer from memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(int8 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			mov: asm EAX ptr8 + asm ECX to: asm AL
	]
! !

!ByteArray methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 11/23/2012 18:05'!
nbInt8AtOffset: zeroBasedOffset  put: value
	
	"Store signed 8-bit integer into memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong zeroBasedOffset, int8 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX; "value"
			mov: asm DL to: asm EAX ptr8 + asm ECX
	]
! !

!ByteArray methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 11/23/2012 18:07'!
nbUInt32AtOffset: zeroBasedOffset
	
	"Reads unsigned 32-bit integer from memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(uint32 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			mov: asm EAX ptr32 + asm ECX to: asm EAX
	]
! !

!ByteArray methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 11/23/2012 18:08'!
nbUlongAt: index
	"Read unsigned long at one-based index.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout 
		options: #( optCheckFailOnEveryArgument );
	
		function: #(ulong (self, ulong index)) emit: [:gen |
			| asm |
			
			asm := gen asm.
			asm 
				pop: asm EAX;  "pointer to receiver's first byte"
				pop: asm ECX; "index"
				mov: asm EAX ptr + asm ECX -1 to: asm EAX. ]! !

!ByteArray methodsFor: 'private' stamp: 'ar 1/28/2000 17:45'!
asByteArrayPointer
	"Return a ByteArray describing a pointer to the contents of the receiver."
	^self shouldNotImplement! !

!ByteArray methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 11/23/2012 18:07'!
nbUInt32AtOffset: zeroBasedOffset  put: value
	
	"Store unsigned 32-bit integer into memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong zeroBasedOffset, uint32 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX; "value"
			mov: asm EDX to: asm EAX ptr32 + asm ECX
	]
! !

!ByteArray class methodsFor: 'byte based hash' stamp: 'HenrikSperreJohansen 10/25/2010 15:33'!
hashBytes: aByteArray startingWith: speciesHash
	"Answer the hash of a byte-indexed collection,
	using speciesHash as the initial value.
	See SmallInteger>>hashMultiply.

	The primitive should be renamed at a
	suitable point in the future"

	| byteArraySize hash low |
	<primitive: 'primitiveStringHash' module: 'MiscPrimitivePlugin'>

	<var: #aHash declareC: 'int speciesHash'>
	<var: #aByteArray declareC: 'unsigned char *aByteArray'>

	byteArraySize := aByteArray size.
	hash := speciesHash bitAnd: 16rFFFFFFF.
	1 to: byteArraySize do: [:pos |
		hash := hash + (aByteArray basicAt: pos).
		"Begin hashMultiply"
		low := hash bitAnd: 16383.
		hash := (16r260D * low + ((16r260D * (hash bitShift: -14) + (16r0065 * low) bitAnd: 16383) * 16384)) bitAnd: 16r0FFFFFFF.
	].
	^ hash! !

!ByteArray class methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 8/3/2011 19:55'!
asNBExternalType: gen

	^ NBByteArrayPtr new! !

!ByteArray class methodsFor: '*Spec-Inspector' stamp: 'cb 6/25/2013 13:43'!
inspectorClass
	^ EyeByteArrayInspector! !

!ByteArray class methodsFor: 'instance creation' stamp: 'StephaneDucasse 2/28/2010 12:04'!
readHexFrom: aString
	"Create a byte array from a hexadecimal representation"
	^(self new: aString size // 2) readHexFrom: aString readStream! !

!ByteArray class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 3/26/2015 00:04'!
gtExampleSimple
	<gtExample>
	^ #[2r1010 8r333 16rFF]! !

!ByteArrayTest commentStamp: 'TorstenBergmann 2/20/2014 15:19'!
SUnit tests for ByteArray!
!ByteArrayTest methodsFor: 'tests' stamp: 'jannik.laval 5/2/2010 07:23'!
testFourthByteArraysReturnTheCorrectValues
	"self run: #testFourthByteArraysReturnTheCorrectValues"
	
	self assert: ((#[16r3F 16r80 0 0]  floatAt:1 bigEndian: true) = 1.0).
	self assert: ((#[16rC0 0 0 0]  floatAt:1 bigEndian: true) = -2.0).

! !

!ByteArrayTest methodsFor: 'tests' stamp: 'StephaneDucasse 12/30/2010 14:30'!
testIsLiteral
	self assert: #[122 43 213 7] isLiteral description: 'ByteArray instances are literal'.
	self deny: thisContext method isLiteral description: 'ByteArray sub instances are not literal'! !

!ByteArrayTest methodsFor: 'tests' stamp: 'PavelKrivanek 6/4/2011 17:01'!
testHex
	"self debug: #testHex"
	
	self assert: #[122 43 213 7] hex = '7a2bd507'.
	self assert: #[151 193 242 221 249 32 153 72 179 41 49 154 48 193 99 134] hex = '97c1f2ddf9209948b329319a30c16386'.
					
	self assert: (ByteArray readHexFrom: '7A2BD507') = #[122 43 213 7].
	self assert: (ByteArray readHexFrom: '7a2bd507') = #[122 43 213 7].
	! !

!ByteArrayTest methodsFor: 'tests' stamp: 'StephaneDucasse 9/18/2010 21:27'!
testindexOfStartingAt
	"self run: #testindexOfStartingAt"
	
	self assert: (#[1 2 3 4 5 6 7 8 9 10 11 1 2 3 4 5 6 7 8 0 0]  indexOf: 1 startingAt: 10) = 12.
	self assert: (#[1 2 3 4 5 6 7 8 9 10 11 1 2 3 4 5 6 7 8 0 0]  indexOf: 17 startingAt: 10) = 0.

! !

!ByteLayout commentStamp: '<historical>'!
I am a raw data layout that holds bytes (8 bit).!
!ByteLayout methodsFor: 'format' stamp: 'ToonVerwaest 4/1/2011 01:27'!
instanceSpecification
	^ 8! !

!ByteLayout methodsFor: 'extending' stamp: 'MartinDias 7/24/2013 13:21'!
extendWord
	IncompatibleLayoutConflict new
		layout: self;
		subType: #word;
		signal! !

!ByteLayout methodsFor: 'testing' stamp: 'MartinDias 1/31/2014 16:19'!
isBytes
	^ true! !

!ByteLayout class methodsFor: 'instance creation' stamp: 'MartinDias 7/11/2013 16:14'!
extending: superLayout scope: aScope host: aClass
	^ superLayout extendByte
		host: aClass;
		yourself! !

!ByteString commentStamp: '<historical>'!
This class represents the array of 8 bit wide characters.
!
!ByteString methodsFor: 'testing' stamp: 'HenrikSperreJohansen 9/1/2009 00:44'!
hasWideCharacterFrom: start to: stop
	"Only WideStrings contain these characters"
	^false! !

!ByteString methodsFor: 'testing' stamp: 'ar 4/10/2005 18:04'!
isByteString
	"Answer whether the receiver is a ByteString"
	^true! !

!ByteString methodsFor: 'comparing' stamp: 'nice 3/23/2007 00:50'!
beginsWith: prefix
	"Answer whether the receiver begins with the given prefix string.
	The comparison is case-sensitive."


	"IMPLEMENTATION NOTE:
	following algorithm is optimized in primitive only in case self and prefix are bytes like.
	Otherwise, if self is wide, then super outperforms,
	Otherwise, if prefix is wide, primitive is not correct"
	
	prefix class isBytes ifFalse: [^super beginsWith: prefix].
	
	self size < prefix size ifTrue: [^ false].
	^ (self findSubstring: prefix in: self startingAt: 1
			matchTable: CaseSensitiveOrder) = 1
! !

!ByteString methodsFor: 'testing' stamp: 'HenrikSperreJohansen 1/26/2010 15:21'!
isAsciiString


 ^(self class findFirstInString: self inSet: NonAsciiMap startingAt: 1) = 0! !

!ByteString methodsFor: 'accessing' stamp: 'ar 12/27/1999 13:44'!
byteAt: index
	<primitive: 60>
	^(self at: index) asciiValue! !

!ByteString methodsFor: 'accessing' stamp: 'ar 3/3/2001 16:17'!
byteSize
	^self size! !

!ByteString methodsFor: '*Multilingual-Languages' stamp: 'StephaneDucasse 8/2/2013 22:39'!
convertFromSystemString

	| readStream |
	readStream := self readStream.
	^ self class new: self size streamContents: [ :writeStream |
		| converter |
		converter := LanguageEnvironment defaultSystemConverter.
		[readStream atEnd] whileFalse: [
			writeStream nextPut: (converter nextFromStream: readStream)]].
! !

!ByteString methodsFor: '*NativeBoost-Examples' stamp: 'IgorStasenko 11/24/2012 15:52'!
nbBeginsWithByteString: prefix
"an assembler implementation of #beginsWith: ,
note, works only for byte strings "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCallout function: #( oop (oop self, oop prefix) ) emit: [:gen :proxy :asm |
		| string sz1 prefixStr sz2 returnFalse done |
		
		string := gen reserveTemp.
		sz1 := gen reserveTemp.
		prefixStr := gen reserveTemp.
		sz2 := gen reserveTemp.
		returnFalse := asm uniqueLabelName: 'returnFalse'.
		done := asm uniqueLabelName: 'done'.
		
		asm mov: asm ESP ptr to: asm EAX  "self ".
		proxy varBytesFirstFieldOf:  asm EAX.
		asm mov: asm EAX to: string.

		asm pop: asm EAX  "self ".
		proxy byteSizeOf: asm EAX. 
		asm mov: asm EAX to: sz1.


		asm mov: asm ESP ptr to: asm EAX  "self ".
		proxy varBytesFirstFieldOf: asm EAX.
		asm mov: asm EAX to: prefixStr.

		asm pop: asm EAX  "self ".
		proxy byteSizeOf: asm EAX. 
		asm mov: asm EAX to: sz2.
		
		asm 
			mov: sz1 to: asm EAX;
			cmp: asm EAX with: sz2;
			jl: returnFalse.

		asm 
			mov: string to: asm ESI;
			mov: prefixStr to: asm EDI;
			mov: sz2 to: asm ECX;
			cld;
			repe; cmpsb;
			
			cmp: asm ECX with: 0;
			jnz: returnFalse.

		proxy trueObject.
		asm jmp: done.

		asm label: returnFalse.
		proxy falseObject.
		asm label: done
	] 
! !

!ByteString methodsFor: '*Fuel' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper

	^aGeneralMapper visitHookPrimitive: self! !

!ByteString methodsFor: 'accessing' stamp: 'ar 12/27/1999 13:44'!
byteAt: index put: value
	<primitive: 61>
	self at: index put: value asCharacter.
	^value! !

!ByteString methodsFor: '*Keymapping-KeyCombinations' stamp: 'GuillermoPolito 3/19/2013 20:28'!
asKeyCombination
	self size > 1 
		ifTrue: [ self error: 'Shortcuts only take a single letter'].
	^ KMSingleKeyCombination from: self first! !

!ByteString methodsFor: '*Fuel' stamp: 'MartinDias 12/30/2011 10:50'!
serializeOn: anEncoder

	anEncoder encodeString: self! !

!ByteString methodsFor: '*Slot' stamp: 'MarcusDenker 1/16/2015 12:12'!
asClassVariable
	^ self asSymbol asClassVariable! !

!ByteString methodsFor: 'accessing' stamp: 'ar 4/12/2005 17:33'!
at: index put: aCharacter
	"Primitive. Store the Character in the field of the receiver indicated by
	the index. Fail if the index is not an Integer or is out of bounds, or if
	the argument is not a Character. Essential. See Object documentation
	whatIsAPrimitive."

	<primitive: 64>
	aCharacter isCharacter 
		ifFalse:[^self errorImproperStore].
	aCharacter isOctetCharacter ifFalse:[
		"Convert to WideString"
		self becomeForward: (WideString from: self).
		^self at: index put: aCharacter.
	].
	index isInteger
		ifTrue: [self errorSubscriptBounds: index]
		ifFalse: [self errorNonIntegerIndex]! !

!ByteString methodsFor: 'accessing' stamp: 'yo 8/26/2002 20:33'!
at: index 
	"Primitive. Answer the Character stored in the field of the receiver
	indexed by the argument. Fail if the index argument is not an Integer or
	is out of bounds. Essential. See Object documentation whatIsAPrimitive."

	<primitive: 63>
	^ Character value: (super at: index)! !

!ByteString methodsFor: 'accessing' stamp: 'nice 12/9/2009 15:40'!
indexOfAnyOf: aCollection startingAt: start ifAbsent: aBlock
	"Use double dispatching for speed"
	| index |
	^(index := aCollection findFirstInByteString: self startingAt: start) = 0
		ifTrue: [aBlock value]
		ifFalse: [index]! !

!ByteString methodsFor: 'testing' stamp: 'ar 4/10/2005 17:28'!
isOctetString
	"Answer whether the receiver can be represented as a byte string. 
	This is different from asking whether the receiver *is* a ByteString 
	(i.e., #isByteString)"
	^ true.
! !

!ByteString methodsFor: 'accessing' stamp: 'nice 12/9/2009 15:39'!
indexOfAnyOf: aCollection startingAt: start
	"Use double dispatching for speed"
	^aCollection findFirstInByteString: self startingAt: start! !

!ByteString methodsFor: 'converting' stamp: 'yo 8/28/2002 16:52'!
asOctetString

	^ self.
! !

!ByteString methodsFor: '*Slot' stamp: 'ToonVerwaest 4/1/2011 03:57'!
asSlot
	^ self asSymbol asSlot! !

!ByteString methodsFor: 'accessing' stamp: 'ar 4/12/2005 17:33'!
replaceFrom: start to: stop with: replacement startingAt: repStart 
	"Primitive. This destructively replaces elements from start to stop in the receiver starting at index, repStart, in the collection, replacement. Answer the receiver. Range checks are performed in the primitive only. Optional. See Object documentation whatIsAPrimitive."
	<primitive: 105>
	replacement class == WideString ifTrue: [
		self becomeForward: (WideString from: self).
	]. 

	super replaceFrom: start to: stop with: replacement startingAt: repStart.
! !

!ByteString methodsFor: '*Text-Scanning' stamp: 'tpr 10/2/2013 17:36'!
scanCharactersFrom: startIndex to: stopIndex with: aCharacterScanner rightX: rightX  font: aFont
	"NB: strongly consider getting almost all these parameters from the scanner"
	"Since I'm a byte char string, I know that we have to scan single-byte characters and don't have to handle encodings etc"
	startIndex > stopIndex
		ifTrue: [^aCharacterScanner handleEndOfRunAt: stopIndex].
	^aFont scanByteCharactersFrom: startIndex to: stopIndex in: self with: aCharacterScanner rightX: rightX! !

!ByteString methodsFor: 'comparing' stamp: 'SeanDeNigris 1/24/2011 23:37'!
findSubstring: key in: body startingAt: start matchTable: matchTable
	
	^ key findIn: body startingAt: start matchTable: matchTable.! !

!ByteString methodsFor: 'converting' stamp: 'ar 4/10/2005 17:20'!
asByteArray
	| ba sz |
	sz := self byteSize.
	ba := ByteArray new: sz.
	ba replaceFrom: 1 to: sz with: self startingAt: 1.
	^ba! !

!ByteString class methodsFor: 'primitives' stamp: 'HenrikSperreJohansen 10/25/2010 15:31'!
stringHash: aString initialHash: speciesHash

	| stringSize hash low |
	<primitive: 'primitiveStringHash' module: 'MiscPrimitivePlugin'>

	<var: #aHash declareC: 'int speciesHash'>
	<var: #aString declareC: 'unsigned char *aString'>

	stringSize := aString size.
	hash := speciesHash bitAnd: 16rFFFFFFF.
	1 to: stringSize do: [:pos |
		hash := hash + (aString at: pos) asciiValue.
		"Begin hashMultiply"
		low := hash bitAnd: 16383.
		hash := (16r260D * low + ((16r260D * (hash bitShift: -14) + (16r0065 * low) bitAnd: 16383) * 16384)) bitAnd: 16r0FFFFFFF.
	].
	^ hash! !

!ByteString class methodsFor: 'primitives' stamp: 'HenrikSperreJohansen 10/25/2010 15:32'!
findFirstInString: aString  inSet: inclusionMap  startingAt: start
	| i stringSize |
	<primitive: 'primitiveFindFirstInString' module: 'MiscPrimitivePlugin'>
	
	<var: #aString declareC: 'unsigned char *aString'>
	<var: #inclusionMap  declareC: 'char *inclusionMap'>

	inclusionMap size ~= 256 ifTrue: [ ^0 ].

	i := start.
	stringSize := aString size.
	[ i <= stringSize and: [ (inclusionMap at: (aString at: i) asciiValue+1) = 0 ] ] whileTrue: [ 
		i := i + 1 ].

	i > stringSize ifTrue: [ ^0 ].
	^i! !

!ByteString class methodsFor: 'initialization' stamp: 'BernardoContreras 9/9/2014 20:41'!
initialize
	"ByteString initialize"

	NonAsciiMap := ByteArray new: 256.
	0 to: 255 do: [ :i | 
		i < 128
			ifTrue: [ NonAsciiMap at: i + 1 put: 0	"valid ascii subset" ]
			ifFalse: [ NonAsciiMap at: i + 1 put: 1	"extended charset" ] ]! !

!ByteString class methodsFor: 'primitives' stamp: 'HenrikSperreJohansen 10/25/2010 15:31'!
indexOfAscii: anInteger inString: aString startingAt: start

	| stringSize |
	<primitive: 'primitiveIndexOfAsciiInString' module: 'MiscPrimitivePlugin'>

	<var: #aCharacter declareC: 'int anInteger'>
	<var: #aString declareC: 'unsigned char *aString'>

	stringSize := aString size.
	start to: stringSize do: [:pos |
		(aString at: pos) asciiValue = anInteger ifTrue: [^ pos]].

	^ 0
! !

!ByteString class methodsFor: 'primitives' stamp: 'HenrikSperreJohansen 10/25/2010 15:32'!
compare: string1 with: string2 collated: order
	"Return 1, 2 or 3, if string1 is <, =, or > string2, with the collating order of characters given by the order array."

	| len1 len2 c1 c2 |
	<primitive: 'primitiveCompareString' module: 'MiscPrimitivePlugin'>
	
	<var: #string1 declareC: 'unsigned char *string1'>
	<var: #string2 declareC: 'unsigned char *string2'>
	<var: #order declareC: 'unsigned char *order'>

	len1 := string1 size.
	len2 := string2 size.
	1 to: (len1 min: len2) do:
		[:i |
		c1 := order at: (string1 basicAt: i) + 1.
		c2 := order at: (string2 basicAt: i) + 1.
		c1 = c2 ifFalse: 
			[c1 < c2 ifTrue: [^ 1] ifFalse: [^ 3]]].
	len1 = len2 ifTrue: [^ 2].
	len1 < len2 ifTrue: [^ 1] ifFalse: [^ 3].
! !

!ByteString class methodsFor: 'primitives' stamp: 'HenrikSperreJohansen 10/25/2010 15:32'!
translate: aString from: start  to: stop  table: table
	"translate the characters in the string by the given table, in place"
	<primitive: 'primitiveTranslateStringWithTable' module: 'MiscPrimitivePlugin'>
	
	<var: #table  declareC: 'unsigned char *table'>
	<var: #aString  declareC: 'unsigned char *aString'>

	start to: stop do: [ :i |
		aString at: i put: (table at: (aString at: i) asciiValue+1) ]! !

!ByteString class methodsFor: 'contants' stamp: 'HenrikSperreJohansen 1/27/2010 17:50'!
nonAsciiMap
	^NonAsciiMap! !

!ByteString class methodsFor: '*Fuel' stamp: 'MartinDias 12/30/2011 10:56'!
materializeFrom: aDecoder

	^ aDecoder nextEncodedString! !

!ByteSymbol commentStamp: '<historical>'!
This class represents the symbols containing 8bit characters.!
!ByteSymbol methodsFor: 'testing' stamp: 'nice 11/9/2009 22:35'!
hasWideCharacterFrom: start to: stop
	"Always false because I only contains byte characters"
	^false! !

!ByteSymbol methodsFor: 'testing' stamp: 'ar 4/10/2005 22:14'!
isByteString
	"Answer whether the receiver is a ByteString"
	^true! !

!ByteSymbol methodsFor: 'accessing' stamp: 'ar 4/10/2005 22:10'!
byteAt: index
	<primitive: 60>
	^(self at: index) asciiValue! !

!ByteSymbol methodsFor: 'accessing' stamp: 'ar 4/12/2005 17:51'!
species
	"Answer the preferred class for reconstructing the receiver."
	^ByteString
! !

!ByteSymbol methodsFor: 'private' stamp: 'CamilloBruni 9/5/2011 20:04'!
string: aString
	1 to: aString size do: [:j | 
		self privateAt: j put: (aString at: j)].
	^self! !

!ByteSymbol methodsFor: 'comparing' stamp: 'nice 3/23/2007 00:50'!
beginsWith: prefix
	"Answer whether the receiver begins with the given prefix string.
	The comparison is case-sensitive."


	"IMPLEMENTATION NOTE:
	following algorithm is optimized in primitive only in case self and prefix are bytes like.
	Otherwise, if self is wide, then super outperforms,
	Otherwise, if prefix is wide, primitive is not correct"
	
	prefix class isBytes ifFalse: [^super beginsWith: prefix].
	
	self size < prefix size ifTrue: [^ false].
	^ (self findSubstring: prefix in: self startingAt: 1
			matchTable: CaseSensitiveOrder) = 1
! !

!ByteSymbol methodsFor: 'private' stamp: 'CamilloBruni 9/5/2011 18:10'!
privateAt: index put: aCharacter
	"Primitive. Store the Character in the field of the receiver indicated by
	the index. Fail if the index is not an Integer or is out of bounds, or if
	the argument is not a Character. Essential. See Object documentation
	whatIsAPrimitive."

	<primitive: 64>
	aCharacter isCharacter 
		ifFalse:[^self errorImproperStore].
	index isInteger
		ifTrue: [self errorSubscriptBounds: index]
		ifFalse: [self errorNonIntegerIndex]! !

!ByteSymbol methodsFor: 'accessing' stamp: 'ar 4/10/2005 22:11'!
byteSize
	^self size! !

!ByteSymbol methodsFor: 'accessing' stamp: 'ar 4/10/2005 22:10'!
byteAt: anInteger put: anObject 
	"You cannot modify the receiver."
	self errorNoModification! !

!ByteSymbol methodsFor: '*Fuel' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper

	^aGeneralMapper visitHookPrimitive: self! !

!ByteSymbol methodsFor: '*Fuel' stamp: 'MartinDias 12/30/2011 10:51'!
serializeOn: anEncoder

	anEncoder encodeString: self! !

!ByteSymbol methodsFor: 'accessing' stamp: 'ar 4/10/2005 22:10'!
at: index 
	"Primitive. Answer the Character stored in the field of the receiver
	indexed by the argument. Fail if the index argument is not an Integer or
	is out of bounds. Essential. See Object documentation whatIsAPrimitive."

	<primitive: 63>
	^ Character value: (super at: index)! !

!ByteSymbol methodsFor: 'accessing' stamp: 'nice 12/9/2009 15:40'!
indexOfAnyOf: aCollection startingAt: start ifAbsent: aBlock
	"Use double dispatching for speed"
	| index |
	^(index := aCollection findFirstInByteString: self startingAt: start) = 0
		ifTrue: [aBlock value]
		ifFalse: [index]! !

!ByteSymbol methodsFor: 'testing' stamp: 'ar 4/10/2005 22:14'!
isOctetString
	"Answer whether the receiver can be represented as a byte string. 
	This is different from asking whether the receiver *is* a ByteString 
	(i.e., #isByteString)"
	^ true.
! !

!ByteSymbol methodsFor: 'converting' stamp: 'ar 4/10/2005 22:12'!
asOctetString
	^ self! !

!ByteSymbol methodsFor: 'accessing' stamp: 'nice 12/9/2009 15:40'!
indexOfAnyOf: aCollection startingAt: start
	"Use double dispatching for speed"
	^aCollection findFirstInByteString: self startingAt: start! !

!ByteSymbol methodsFor: '*Keymapping-Core' stamp: 'GuillermoPolito 5/3/2013 15:58'!
asKmCategoryIn: aKmRepository
	^aKmRepository categoryForName: self! !

!ByteSymbol methodsFor: '*Text-Scanning' stamp: 'nice 10/9/2013 01:47'!
scanCharactersFrom: startIndex to: stopIndex with: aCharacterScanner rightX: rightX  font: aFont
	"NB: strongly consider getting almost all these parameters from the scanner"
	"Since I'm a byte char string, I know that we have to scan single-byte characters and don't have to handle encodings etc"
	startIndex > stopIndex
		ifTrue: [^aCharacterScanner handleEndOfRunAt: stopIndex].
	^aFont scanByteCharactersFrom: startIndex to: stopIndex in: self with: aCharacterScanner rightX: rightX! !

!ByteSymbol methodsFor: 'comparing' stamp: 'ar 4/10/2005 22:14'!
findSubstring: key in: body startingAt: start matchTable: matchTable
	"Answer the index in the string body at which the substring key first occurs, at or beyond start.  The match is determined using matchTable, which can be used to effect, eg, case-insensitive matches.  If no match is found, zero will be returned."
	<primitive: 'primitiveFindSubstring' module: 'MiscPrimitivePlugin'>
	^super findSubstring: key in: body startingAt: start matchTable: matchTable! !

!ByteSymbol methodsFor: 'converting' stamp: 'ar 4/10/2005 22:12'!
asByteArray
	| ba sz |
	sz := self byteSize.
	ba := ByteArray new: sz.
	ba replaceFrom: 1 to: sz with: self startingAt: 1.
	^ba! !

!ByteSymbol class methodsFor: 'primitives' stamp: 'ar 8/18/2005 13:46'!
stringHash: aString initialHash: speciesHash
	^ByteString stringHash: aString initialHash: speciesHash! !

!ByteSymbol class methodsFor: 'primitives' stamp: 'ar 8/18/2005 13:46'!
findFirstInString: aString inSet: inclusionMap startingAt: start
	^ByteString findFirstInString: aString  inSet: inclusionMap startingAt: start! !

!ByteSymbol class methodsFor: 'primitives' stamp: 'ar 8/18/2005 13:47'!
translate: aString from: start  to: stop  table: table
	^ByteString translate: aString from: start  to: stop  table: table! !

!ByteSymbol class methodsFor: '*Fuel' stamp: 'MartinDias 12/30/2011 10:56'!
materializeFrom: aDecoder

	^ aDecoder nextEncodedString asSymbol! !

!ByteSymbol class methodsFor: 'primitives' stamp: 'ar 8/18/2005 13:46'!
indexOfAscii: anInteger inString: aString startingAt: start
	^ByteString indexOfAscii: anInteger inString: aString startingAt: start! !

!ByteSymbolTest commentStamp: 'TorstenBergmann 2/20/2014 15:29'!
SUnit tests for byte symbols!
!ByteSymbolTest methodsFor: 'test - creation' stamp: 'SheridanMahoney 12/6/2009 17:38'!
testNewFrom
	"self debug: #testNewFrom"

| dt newFrom1 newFrom2 |

dt := DateAndTime now asString .
newFrom1 := ByteSymbol newFrom: dt .

self assert:
	(Symbol allSymbols select: [:e | e asString  = dt  ]  ) size = 1 .
self assert:
	(ByteSymbol allInstances select: [:e | e = dt  ] ) size = 1 .
self assert:
	(Symbol allSymbols select: [:e | e asString  = dt  ]  ) =
			(ByteSymbol allInstances select: [:e | e = dt ] ) .
			
newFrom2 := ByteSymbol newFrom: dt . 
self assert:
	(Symbol allSymbols select: [:e | e asString  = dt  ]  ) size = 1 .
self assert:
	(ByteSymbol allInstances select: [:e | e = dt ] ) size = 1 .
	! !

!ByteSymbolTest methodsFor: 'test - creation' stamp: 'SheridanMahoney 12/6/2009 17:39'!
testAs
	"self debug: #testAs"

| tStr tAs1 tAs2 |

tStr := DateAndTime now asString .
tAs1 :=  tStr as: ByteSymbol . 
self assert: 	(Symbol allSymbols select: [:e | e asString  = tStr ]  ) size = 1 .
self assert: 	(ByteSymbol allInstances select: [:e | e asString = tStr] ) size = 1 .  
self assert: 	(ByteSymbol allInstances select: [:e | e asString = tStr] ) =
		(Symbol allSymbols select: [:e | e asString  = tStr ]  ) .
		
tAs2 :=  tStr as: ByteSymbol . 
self assert: 	(Symbol allSymbols select: [:e | e asString  = tStr ]  ) size = 1 .
self assert: 	(ByteSymbol allInstances select: [:e | e asString = tStr] ) size = 1 .  

! !

!ByteSymbolTest methodsFor: 'test - non-creation' stamp: 'StephaneDucasse 6/9/2012 22:54'!
testNew
	"self debug: #testNew"

	
	self should: [ByteSymbol new: 5 ] raise: self defaultTestError. ! !

!ByteSymbolTest methodsFor: 'test - creation' stamp: 'SheridanMahoney 12/6/2009 19:02'!
testReadFromString
	"self debug: #testReadFromString"

| str strWithPound readFrom1 readFrom2 |
Smalltalk garbageCollect. 
str := 'notYetExisting' .
self assert: (Symbol allSymbols select: [:e | e asString  = str ]  ) size = 0 .
self assert: (ByteSymbol allInstances select: [:e | e asString = str] ) size = 0 .  
strWithPound := ('#' , str) .
readFrom1 := ByteSymbol readFromString: strWithPound .
self assert:	(Symbol allSymbols select: [:e | e asString  = str  ]  ) size = 1 .
self assert:	(ByteSymbol allInstances select: [:e | e = str ] ) size = 1 .
self assert:	(Symbol allSymbols select: [:e | e asString  = str  ]  ) =
			(ByteSymbol allInstances select: [:e | e = str ] ) .
			
readFrom2  := ByteSymbol readFromString: strWithPound .
self assert:
	(Symbol allSymbols select: [:e | e asString  = str  ]  ) size = 1 .
self assert:
	(ByteSymbol allInstances select: [:e | e = str ] ) size = 1 .! !

!ByteTextConverter commentStamp: 'michael.rueger 1/27/2009 18:00'!
A ByteTextConverter is the abstract class for text converters on single byte encodings.!
!ByteTextConverter methodsFor: 'conversion' stamp: 'michael.rueger 2/5/2009 14:10'!
unicodeToByte: unicodeChar

	^unicodeChar charCode < 128
		ifTrue: [unicodeChar]
		ifFalse: [self class unicodeToByteTable at: unicodeChar charCode ifAbsent: [0 asCharacter]]! !

!ByteTextConverter methodsFor: 'conversion' stamp: 'michael.rueger 2/5/2009 14:10'!
nextPut: unicodeCharacter toStream: aStream
	"Write the unicode character to aStream."

	aStream isBinary
		ifTrue: [aStream basicNextPut: unicodeCharacter charCode]
		ifFalse: [aStream basicNextPut: (self unicodeToByte: unicodeCharacter)]! !

!ByteTextConverter methodsFor: 'conversion' stamp: 'michael.rueger 2/5/2009 14:11'!
byteToUnicode: char
	"Map from my byte based encoding to unicode.
	Due to the leading char encoding this is not strictly true, but hopefully at some point we can get rid of the leading char overhead."
	| value |
	value := char charCode.

	value < 128
		ifTrue: [^ char].
	value > 255
		ifTrue: [^ char].
	^self class byteToUnicodeTable at: (value - 128 + 1)! !

!ByteTextConverter methodsFor: 'conversion' stamp: 'michael.rueger 2/5/2009 14:11'!
nextFromStream: aStream
	"Read the next byte (we are only dealing with byte based encodings here) character from aStream and return the result converted to unicode."

	| byteOrChar |
	byteOrChar := aStream basicNext.
	aStream isBinary
		ifTrue: [^byteOrChar].
	^byteOrChar
		ifNotNil: [self byteToUnicode: byteOrChar]! !

!ByteTextConverter class methodsFor: 'class initialization' stamp: 'michael.rueger 1/27/2009 18:40'!
initialize
	"ByteTextConverter initialize"

	self allSubclassesDo: [:subclass |
		subclass initializeTables]! !

!ByteTextConverter class methodsFor: 'class initialization' stamp: 'SvenVanCaekenberghe 3/7/2012 21:56'!
initializeTables
	"Initialize the mappings to and from Unicode."

	byteToUnicode := Array new: 128.
	unicodeToByte := Dictionary new.
	"Mind the offset because first 128 characters are not stored into byteToUnicodeSpec"
	"Some entries are nil, make them pass-through for compatibility, for now"
	self byteToUnicodeSpec keysAndValuesDo: [ :index :unicode | | unicodeValue |
		unicodeValue := unicode ifNil: [ 127 + index ] ifNotNil: [ unicode ].
		byteToUnicode at: index put: (Character value: unicodeValue).
		unicodeToByte at: unicodeValue put: (127 + index) asCharacter ]! !

!ByteTextConverter class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 3/7/2012 21:50'!
unicodeToByteTable
	"Return the table mapping from unicode to my byte based encoding"
	
	^ unicodeToByte! !

!ByteTextConverter class methodsFor: '*Unicode-Initialization' stamp: 'SvenVanCaekenberghe 1/15/2013 15:03'!
parseUnicodeOrgSpec: url
	"Parse and return a mapping from byte to unicode values from url."
	"self parseUnicodeOrgSpec: 'http://unicode.org/Public/MAPPINGS/ISO8859/8859-2.TXT'."
	
	| mapping |
	mapping := Dictionary new: 256.
	url asZnUrl retrieveContents linesDo: [ :each |
		(each isEmpty or: [ each beginsWith: '#' ])
			ifFalse: [ | tokens hexReader |
				hexReader := [ :string | Integer readFrom: (string readStream skip: 2; yourself) base: 16 ].
				tokens := each findTokens: String tab. 
				(tokens last = '<control>' or: [ tokens last = '#UNDEFINED' ]) ifFalse: [
					mapping
						at: (hexReader value: tokens first)
						put: (hexReader value: tokens second) ] ] ].
	^ mapping ! !

!ByteTextConverter class methodsFor: 'accessing' stamp: 'michael.rueger 1/30/2009 11:01'!
languageEnvironment
	self subclassResponsibility! !

!ByteTextConverter class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 3/7/2012 21:49'!
byteToUnicodeTable
	"Return the table mapping from my byte based encoding to unicode"
	
	^ byteToUnicode! !

!ByteTextConverter class methodsFor: '*Unicode-Initialization' stamp: 'ClementBera 7/26/2013 16:34'!
generateByteToUnicodeSpec: url
	"Return the formatted source code for an array mapping 
	the top 128 byte to unicode values from a Unicode.org url"
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/ISO8859/8859-2.TXT'."

	| mapping |
	mapping := self parseUnicodeOrgSpec: url.  
	^ String streamContents: [ :stream |
		stream tab; << '"'; << self name; << ' generateByteToUnicodeSpec: '; print: url; << '"'; cr; cr; tab; << '^ #('.
		128 to: 255 do: [ :each | | unicode |
			each \\ 8 = 0 ifTrue: [ stream cr; tab ].
			(unicode := mapping at: each ifAbsent: [ nil ]) 
				ifNil: [ stream print: nil; space ]  
				ifNotNil: [ stream << '16r' << (unicode printPaddedWith: $0 to: 4 base: 16); space ] ].
		stream nextPut: $); cr ]! !

!ByteTextConverter class methodsFor: 'class initialization' stamp: 'SvenVanCaekenberghe 3/7/2012 21:42'!
byteToUnicodeSpec
	"Sepcify a table mapping the entries 0x80 to 0xFF to their unicode counterparts by returning a 128 element array..
	The entries 0x00 to 0x7F map to identical values so we don't need to specify them.
	See #generateByteToUnicodeSpec: for an automated way to generate these mappings."

	self subclassResponsibility! !

!ByteTextConverterTest commentStamp: 'TorstenBergmann 2/5/2014 10:18'!
SUnit tests for ByteTextConverter!
!ByteTextConverterTest methodsFor: 'testing' stamp: 'HenrikSperreJohansen 6/25/2012 12:55'!
testUnicodeToLatin2Conversion
        | latin2Bytes internalString encodingStream encodedBytes  |

        latin2Bytes := #[16rBE 16rFD 16rE1 16rC8] .
	internalString := String streamContents: [:s | 
		s nextPut: 16r017E asCharacter;
		   nextPut: 16rFD asCharacter;
		  nextPut: 16rE1 asCharacter;
		  nextPut: 16r010C asCharacter].
	"Converters assume that characters you want to put/get from a stream are Unicode characters"
	"So we use a stream with an encoder, then put the internalString to it"
	encodingStream := (MultiByteBinaryOrTextStream 
                with:  String new 
                encoding: 'ISO-8859-2') reset.
	encodingStream nextPutAll: internalString.
	"the encoded string in the stream does not contain any characters > 255"
	encodedBytes := encodingStream binary reset contents.
	
	
	self assert: (encodedBytes at: 1)  = (latin2Bytes at: 1) .
	self assert: (encodedBytes at: 2)  = (latin2Bytes at: 2) .
	self assert: (encodedBytes at: 3)  = (latin2Bytes at: 3) .
	self assert: (encodedBytes at: 4)  = (latin2Bytes at: 4) .! !

!ByteTextConverterTest methodsFor: 'testing' stamp: 'HenrikSperreJohansen 6/25/2012 12:43'!
testLatin2ToUnicodeConversion
        | latin2Characters utfCodePoints decodingStream unicodeString |

        latin2Characters := #[16rBE 16rFD 16rE1 16rC8] asString.
	utfCodePoints := #(16r017E 16rFD 16rE1 16r010C).
	
	"Converters assume that characters you want to put/get from a stream are Unicode characters"
	"So our source is a string of latin 2"
	decodingStream := (MultiByteBinaryOrTextStream 
                with:  latin2Characters 
                encoding: 'ISO-8859-2') reset.
	unicodeString := decodingStream contents.
	"our sourcelatin2 string contains characters outside latin1"
	self assert: unicodeString isWideString.
	self assert: (unicodeString at: 1) charCode = (utfCodePoints at: 1) .
	self assert: (unicodeString at: 2) charCode = (utfCodePoints at: 2) .
	self assert: (unicodeString at: 3) charCode = (utfCodePoints at: 3) .
	self assert: (unicodeString at: 4) charCode = (utfCodePoints at: 4) .! !

!ByteTextConverterTest methodsFor: 'testing' stamp: 'nice 7/26/2009 22:44'!
testConversionToFrom
	"Non regresson test for http://code.google.com/p/pharo/issues/detail?id=986"

	self assert: (('äöü' convertToEncoding: 'mac-roman') convertFromEncoding: 'mac-roman') = 'äöü'! !

!BytecodeEncoder commentStamp: '<historical>'!
I am an abstract superclass for different bytecode set encoders.  Subclasses inherit the literal management of Encoder and encapsulate the mapping of opcodes to specific bytecodes.!
!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/14/2008 17:26'!
sizePushTemp: tempIndex
	^self sizeOpcodeSelector: #genPushTemp: withArguments: {tempIndex}! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/14/2008 16:11'!
sizeSend: selectorLiteralIndex numArgs: nArgs
	^self sizeOpcodeSelector: #genSend:numArgs: withArguments: {selectorLiteralIndex. nArgs}! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 6/19/2008 08:54'!
sizeStorePopInstVarLong: instVarIndex
	^self sizeOpcodeSelector: #genStorePopInstVarLong: withArguments: {instVarIndex}! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/24/2008 22:59'!
sizePushRemoteTemp: tempIndex inVectorAt: tempVectorIndex
	^self sizeOpcodeSelector: #genPushRemoteTemp:inVectorAt: withArguments: {tempIndex. tempVectorIndex}! !

!BytecodeEncoder methodsFor: 'temps' stamp: 'ClementBera 7/26/2013 16:06'!
bindBlockArg: name within: aBlockNode
	"Read the comment in the superclass's method.
	 If we have closures we should check the argument
	 count against the block, not the method.

	(Note that this isn't entirely adequate either since optimized blocks
	 will slip through the cracks (their arguments (i.e. ifNotNil: [:expr|)
	 are charged against their enclosing block, not themselves))."
	| nArgs |
	self supportsClosureOpcodes ifFalse:
		[^super bindBlockArg: name within: aBlockNode].
	(nArgs := aBlockNode nArgsSlot) ifNil:
		[aBlockNode nArgsSlot: (nArgs := 0)].
	nArgs  >= 15 ifTrue:
		[^self notify: 'Too many arguments'].
	aBlockNode nArgsSlot: nArgs + 1.
	^(self bindTemp: name)
		beBlockArg;
		nowHasDef;
		nowHasRef;
		yourself! !

!BytecodeEncoder methodsFor: 'temps' stamp: 'eem 6/3/2008 12:33'!
noteBlockExtent: blockExtent hasLocals: tempNodes
	blockExtentsToLocals ifNil:
		[blockExtentsToLocals := Dictionary new].
	blockExtentsToLocals at: blockExtent put: tempNodes asArray! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/14/2008 17:40'!
sizeJumpLong: distance
	^self sizeOpcodeSelector: #genJumpLong: withArguments: {distance}! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/14/2008 17:28'!
sizePushThisContext
	^self sizeOpcodeSelector: #genPushThisContext withArguments: #()! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/15/2008 09:07'!
sizeReturnReceiver
	^self sizeOpcodeSelector: #genReturnReceiver withArguments: #()! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/15/2008 09:06'!
sizeReturnTopToCaller
	^self sizeOpcodeSelector: #genReturnTopToCaller withArguments: #()! !

!BytecodeEncoder methodsFor: 'testing' stamp: 'eem 7/17/2008 12:34'!
supportsClosureOpcodes
	"Answer if the receiver supports the
		genPushNewArray:/genPushConsArray:
		genPushRemoteTemp:inVectorAt:
		genStoreRemoteTemp:inVectorAt:
		genStorePopRemoteTemp:inVectorAt:
		genPushClosureCopyCopiedValues:numArgs:jumpSize:
	 opcodes"
	^false! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/14/2008 18:22'!
sizeBranchPopFalse: distance
	^self sizeOpcodeSelector: #genBranchPopFalse: withArguments: {distance}! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/14/2008 17:44'!
sizeStoreInstVar: instVarIndex
	^self sizeOpcodeSelector: #genStoreInstVar: withArguments: {instVarIndex}! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/14/2008 17:37'!
sizePushSpecialLiteral: specialLiteral
	^self sizeOpcodeSelector: #genPushSpecialLiteral: withArguments: {specialLiteral}! !

!BytecodeEncoder methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 16:52'!
outOfRangeError: string index: index range: rangeStart to: rangeEnd
	"For now..."
	^self error: thisContext sender method selector, ' ', string
				, ' index ', index printString
				, ' is out of range ', rangeStart printString, ' to ', rangeEnd printString! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/14/2008 17:43'!
sizePushLiteralVar: literalIndex
	^self sizeOpcodeSelector: #genPushLiteralVar: withArguments: {literalIndex}! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/14/2008 17:43'!
sizeStoreLiteralVar: literalIndex
	^self sizeOpcodeSelector: #genStoreLiteralVar: withArguments: {literalIndex}! !

!BytecodeEncoder methodsFor: 'bytecode generation' stamp: 'ClementBera 1/27/2015 14:14'!
genPushNClosureTemps: numTemps
	numTemps timesRepeat: [ self genPushSpecialLiteral: nil ]! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/14/2008 17:40'!
sizeJump: distance
	^self sizeOpcodeSelector: #genJump: withArguments: {distance}! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/30/2008 16:36'!
sizePushConsArray: numElements
	^self sizeOpcodeSelector: #genPushConsArray: withArguments: {numElements}! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/14/2008 17:45'!
sizeStoreTemp: tempIndex
	^self sizeOpcodeSelector: #genStoreTemp: withArguments: {tempIndex}! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/24/2008 12:35'!
sizePushNewArray: size
	^self sizeOpcodeSelector: #genPushNewArray: withArguments: {size}! !

!BytecodeEncoder methodsFor: 'temps' stamp: 'Alexandre Bergel 5/22/2010 12:47'!
blockExtentsToTempsMap
	"Answer a Dictionary of blockExtent to temp locations for the current method.
	 This is used by the debugger to locate temp vars in contexts.  A temp map
	 entry is a pair of the temp's name and its index, where an index is either an
	 integer for a normal temp or a pair of the index of the indirect temp vector
	 containing  the temp and the index of the temp in its indirect temp vector."
	| blockExtentsToTempsMap |
	blockExtentsToLocals ifNil:
		[^nil].
	blockExtentsToTempsMap := Dictionary new.
	blockExtentsToLocals keysAndValuesDo:
		[:blockExtent :locals|
		blockExtentsToTempsMap
			at: blockExtent
			put: (Array streamContents:
					[:str|
					locals withIndexDo:
						[:local :index|
						local isIndirectTempVector
							ifTrue: [local remoteTemps withIndexDo:
										[:remoteLocal :innerIndex| str nextPut: { remoteLocal key. { index. innerIndex } }]]
							ifFalse: [str nextPut: { local key. index }]]])].
	^blockExtentsToTempsMap! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/14/2008 16:22'!
sizePushInstVar: instVarIndex
	^self sizeOpcodeSelector: #genPushInstVar: withArguments: {instVarIndex}! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 6/19/2008 08:54'!
sizePushInstVarLong: instVarIndex
	^self sizeOpcodeSelector: #genPushInstVarLong: withArguments: {instVarIndex}! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/14/2008 17:36'!
sizeStorePopTemp: tempIndex
	^self sizeOpcodeSelector: #genStorePopTemp: withArguments: {tempIndex}! !

!BytecodeEncoder methodsFor: 'temps' stamp: 'ClementBera 7/26/2013 16:06'!
bindBlockTemp: name within: aBlockNode
	"Read the comment in the superclass's bindBlockArg:within: method.
	 If we have closures we should check the argument
	 count against the block, not the method.

	(Note that this isn't entirely adequate either since optimized blocks
	 will slip through the cracks (their arguments (i.e. ifNotNil: [:expr|)
	 are charged against their enclosing block, not themselves))."
	| nArgs |
	self supportsClosureOpcodes ifFalse:
		[^super bindBlockTemp: name within: aBlockNode].
	(nArgs := aBlockNode nArgsSlot) ifNil:
		[aBlockNode nArgsSlot: (nArgs := 0)].
	nArgs >= (CompiledMethod fullFrameSize - 1) ifTrue:
		[^self notify: 'Too many temporaries'].
	aBlockNode nArgsSlot: nArgs + 1.
	^self bindTemp: name! !

!BytecodeEncoder methodsFor: 'testing' stamp: 'eem 6/29/2009 11:11'!
hasGeneratedMethod
	^blockExtentsToLocals notNil! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 7/27/2008 00:39'!
sizeOpcodeSelector: genSelector withArguments: args
	stream := self.
	position := 0.
	self perform: genSelector withArguments: args.
	^position! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/14/2008 16:21'!
sizePushReceiver
	^self sizeOpcodeSelector: #genPushReceiver withArguments: #()! !

!BytecodeEncoder methodsFor: 'initialize-release' stamp: 'eem 7/24/2008 17:24'!
streamToMethod: aCompiledMethod
	stream := WriteStream with: aCompiledMethod.
	stream position: aCompiledMethod initialPC - 1! !

!BytecodeEncoder methodsFor: 'accessing' stamp: 'ClementBera 1/27/2015 14:14'!
stream: s
	stream := s! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/14/2008 17:43'!
sizePushLiteral: literalIndex
	^self sizeOpcodeSelector: #genPushLiteral: withArguments: {literalIndex}! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/14/2008 17:28'!
sizePop
	^self sizeOpcodeSelector: #genPop withArguments: #()! !

!BytecodeEncoder methodsFor: 'accessing' stamp: 'eem 5/24/2008 11:56'!
rootNode: node "<BlockNode>"
	rootNode := node! !

!BytecodeEncoder methodsFor: 'temps' stamp: 'eem 6/23/2008 10:55'!
bindAndJuggle: name
	"This is used to insert a new temp and reorcder temps on editing.
	 It doesn't really work for closure compilation since we have multiple
	 locations for temps.  Simply signal a reparse is necessary."

	ReparseAfterSourceEditing signal! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'ClementBera 12/28/2014 17:30'!
sizeTrapIfNotInstanceOf: litIndex 
	^ self sizeOpcodeSelector: #genTrapIfNotInstanceOf: withArguments: {litIndex}
! !

!BytecodeEncoder methodsFor: 'special literal encodings' stamp: 'eem 5/14/2008 17:49'!
if: code isSpecialLiteralForReturn: aBlock
	"If code is that of a special literal for return then evaluate aBlock with the special literal.
	 The special literals for return are nil true false which have special encodings
	 in the blue book bytecode set.  Answer whether it was a special literal."
	^(code between: LdTrue and: LdNil)
	   and: [aBlock value: (#(true false nil) at: code - LdSelf).
			true]! !

!BytecodeEncoder methodsFor: 'accessing' stamp: 'eem 5/24/2008 11:56'!
rootNode "^<BlockNode>"
	^rootNode! !

!BytecodeEncoder methodsFor: 'special literal encodings' stamp: 'eem 5/14/2008 16:02'!
if: code isSpecialLiteralForPush: aBlock
	"If code is that of a special literal for push then evaluate aBlock with the special literal
	 The special literals for push are nil true false -1 0 1 & 2 which have special encodings
	 in the blue book bytecode set.  Answer whether it was a special literal."
	^(code between: LdTrue and: LdNil + 4)
	    and: [aBlock value: (#(true false nil -1 0 1 2) at: code - LdSelf).
			true]! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/15/2008 10:00'!
sizeStorePopInstVar: instVarIndex
	^self sizeOpcodeSelector: #genStorePopInstVar: withArguments: {instVarIndex}! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/15/2008 10:20'!
sizeStorePopLiteralVar: literalIndex
	^self sizeOpcodeSelector: #genStorePopLiteralVar: withArguments: {literalIndex}! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/30/2008 16:46'!
sizePushClosureCopyNumCopiedValues: numCopied numArgs: numArgs jumpSize: jumpSize
	^self
		sizeOpcodeSelector: #genPushClosureCopyNumCopiedValues:numArgs:jumpSize:
		withArguments: {numCopied. numArgs. jumpSize}! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 7/27/2008 00:39'!
nextPut: aByte
	"For sizing make the encoder its own stream and
	 keep track of position with this version of nextPut:"
	position := position + 1! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/24/2008 23:02'!
sizeStorePopRemoteTemp: tempIndex inVectorAt: tempVectorIndex
	^self sizeOpcodeSelector: #genStorePopRemoteTemp:inVectorAt: withArguments: {tempIndex. tempVectorIndex}! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 6/19/2008 08:54'!
sizeStoreInstVarLong: instVarIndex
	^self sizeOpcodeSelector: #genStoreInstVarLong: withArguments: {instVarIndex}! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/14/2008 16:11'!
sizeSendSuper: selectorLiteralIndex numArgs: nArgs
	^self sizeOpcodeSelector: #genSendSuper:numArgs: withArguments: {selectorLiteralIndex. nArgs}! !

!BytecodeEncoder methodsFor: 'accessing' stamp: 'eem 5/14/2008 17:47'!
methodStreamPosition
	^stream position! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/14/2008 17:34'!
sizeReturnTop
	^self sizeOpcodeSelector: #genReturnTop withArguments: #()! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/14/2008 17:28'!
sizeDup
	^self sizeOpcodeSelector: #genDup withArguments: #()! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/14/2008 18:22'!
sizeBranchPopTrue: distance
	^self sizeOpcodeSelector: #genBranchPopTrue: withArguments: {distance}! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/24/2008 23:02'!
sizeStoreRemoteTemp: tempIndex inVectorAt: tempVectorIndex
	^self sizeOpcodeSelector: #genStoreRemoteTemp:inVectorAt: withArguments: {tempIndex. tempVectorIndex}! !

!BytecodeEncoder methodsFor: 'temps' stamp: 'JorgeRessia 3/13/2010 16:09'!
bindTemp: name
	"Declare a temporary; error not if a field or class variable or out-of-scope temp.
	 Read the comment in Encoder5>>bindBlockArg:within: and subclass implementations."
	self supportsClosureOpcodes ifFalse:
		[^super bindTemp: name].
	scopeTable at: name ifPresent:
		[:node|
			(requestor interactive)
						ifTrue: [self evaluateShadowingInteractivelyOf: node]
						ifFalse: [self evaluateShadowingNotInteractivelyOf: node] ].
	^self reallyBind: name! !

!BytecodeEncoder methodsFor: 'opcode sizing' stamp: 'eem 5/14/2008 17:38'!
sizeReturnSpecialLiteral: specialLiteral
	^self sizeOpcodeSelector: #genReturnSpecialLiteral: withArguments: {specialLiteral}! !

!BytecodeEncoder class methodsFor: 'bytecode decoding' stamp: 'ClementBera 12/28/2014 17:30'!
stackDeltaForPrimitive: primitiveIndex in: method 
	"This is the default implementation. Subclasses with inline primitives
	will need to override."
	^ 0! !

!BytecodeEncoder class methodsFor: 'bytecode decoding' stamp: 'ClementBera 1/27/2015 14:14'!
specialSelectors	
	^ #(#+ #- #< #> #'<=' #'>=' #= #'~=' #* #/ #'\\' #@ #bitShift: #'//' #bitAnd: #bitOr: #at: #at:put: #size #next #nextPut: #atEnd #'==' nil "class" nil "blockCopy:" #value #value: #do: #new #new: #x #y)! !

!CCompilationContext commentStamp: 'ClementBera 1/27/2015 13:10'!
I am a copy of the CompilationContext.

It is used

-> in the old Compiler so it is independed from Opal
-> in the new Compiler the class CompilationContext parametrizes Opal to use this Context so it can add instance variables to the context.

The second option is a workaround, we will need a copy of Opal to develop itself *or* need to add transactions to the language ;--)!
!CCompilationContext methodsFor: 'options' stamp: 'MarcusDenker 7/22/2013 16:11'!
optionInlineCase
	^ options includes: #optionInlineCase
! !

!CCompilationContext methodsFor: 'options' stamp: 'MarcusDenker 9/30/2013 14:42'!
optionInlineTimesRepeat
	^ options includes: #optionInlineTimesRepeat
! !

!CCompilationContext methodsFor: 'accessing' stamp: 'ClementBera 6/7/2013 09:56'!
compiledMethodTrailer: anObject
	compiledMethodTrailer := anObject! !

!CCompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/27/2013 15:47'!
astTranslatorClass
	^ astTranslatorClass ifNil: [ astTranslatorClass := OCASTTranslator ]! !

!CCompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/26/2013 09:29'!
logged
	^logged ifNil: [ false ].! !

!CCompilationContext methodsFor: 'options' stamp: 'MarcusDenker 7/22/2013 16:12'!
optionInlineWhile
	^ options includes: #optionInlineWhile
! !

!CCompilationContext methodsFor: 'options' stamp: 'MarcusDenker 7/22/2013 16:12'!
optionLongIvarAccessBytecodes
	^ options includes: #optionLongIvarAccessBytecodes
! !

!CCompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/26/2013 09:29'!
logged: anObject
	logged := anObject! !

!CCompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/26/2013 09:29'!
environment
	^ environment! !

!CCompilationContext methodsFor: 'options' stamp: 'MarcusDenker 5/26/2013 09:29'!
doesNotUnderstand: message

	(message selector isUnary and: [ message selector beginsWith: 'opt'] )
		ifTrue: [ ^ options includes: message selector ].
		
	^ super doesNotUnderstand: message! !

!CCompilationContext methodsFor: 'initialization' stamp: 'MarcusDenker 2/28/2015 15:21'!
initialize
	options := Set new.
	astTransformPlugins := OrderedCollection new.! !

!CCompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/26/2013 09:29'!
requestor
	^ requestor! !

!CCompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/26/2013 09:29'!
environment: anObject
	environment := anObject! !

!CCompilationContext methodsFor: 'accessing' stamp: 'ClementBera 6/7/2013 10:00'!
compiledMethodTrailer
	^ compiledMethodTrailer ifNil: [ compiledMethodTrailer := CompiledMethodTrailer empty ]! !

!CCompilationContext methodsFor: 'accessing' stamp: 'ClementBera 1/28/2015 09:24'!
encoderClass
	^ encoderClass ifNil: [ encoderClass := BytecodeBackend ]! !

!CCompilationContext methodsFor: 'options' stamp: 'MarcusDenker 7/22/2013 16:11'!
optionInlineAndOr
	^ options includes: #optionInlineAndOr
! !

!CCompilationContext methodsFor: 'options' stamp: 'MarcusDenker 7/22/2013 16:11'!
optionInlineToDo
	^ options includes: #optionInlineToDo
! !

!CCompilationContext methodsFor: 'options' stamp: 'MarcusDenker 7/22/2013 16:11'!
optionInlineIfNil
	^ options includes: #optionInlineIfNil
! !

!CCompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/26/2013 09:29'!
requestor: anObject
	requestor := anObject! !

!CCompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/26/2013 09:29'!
scope
	| newScope |

	newScope := OCClassScope for: class.
	requestor ifNotNil: [
		"the requestor is allowed to manage variables, the workspace is using it to auto-define vars"  
		newScope := (OCRequestorScope new requestor: requestor) outerScope: newScope].
	^newScope
	! !

!CCompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/27/2013 15:48'!
bytecodeGeneratorClass: anObject
	bytecodeGeneratorClass := anObject! !

!CCompilationContext methodsFor: 'options' stamp: 'MarcusDenker 5/26/2013 09:29'!
compilerOptions: anArray
	self parseOptions: anArray! !

!CCompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 6/14/2013 15:49'!
parserClass
	^ parserClass ifNil: [ parserClass := RBExplicitVariableParser ]! !

!CCompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/26/2013 09:29'!
failBlock: anObject
	failBlock := anObject! !

!CCompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/27/2013 15:50'!
parserClass: anObject
	parserClass := anObject! !

!CCompilationContext methodsFor: 'plugins' stamp: 'MarcusDenker 2/28/2015 15:27'!
astTransformPlugins
	^astTransformPlugins! !

!CCompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/26/2013 09:29'!
category
	^ category! !

!CCompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/27/2013 15:51'!
semanticAnalyzerClass: anObject
	semanticAnalyzerClass := anObject! !

!CCompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/26/2013 09:29'!
noPattern: anObject
	noPattern := anObject! !

!CCompilationContext methodsFor: 'accessing' stamp: 'ClementBera 1/27/2015 13:09'!
bytecodeGeneratorClass
	^ bytecodeGeneratorClass ifNil: [ bytecodeGeneratorClass := IRBytecodeGenerator ]! !

!CCompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/27/2013 15:47'!
astTranslatorClass: anObject
	astTranslatorClass := anObject! !

!CCompilationContext methodsFor: 'options' stamp: 'MarcusDenker 7/22/2013 16:11'!
optionInlineIf
	^ options includes: #optionInlineIf
! !

!CCompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/26/2013 09:29'!
interactive: anObject
	interactive := anObject! !

!CCompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/26/2013 09:29'!
getClass
	^ class! !

!CCompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/27/2013 15:50'!
semanticAnalyzerClass
	^ semanticAnalyzerClass ifNil: [ semanticAnalyzerClass := OCASTSemanticAnalyzer  ]! !

!CCompilationContext methodsFor: 'options' stamp: 'MarcusDenker 7/22/2013 16:12'!
optionOptimizeIR
	^ options includes: #optionOptimizeIR
! !

!CCompilationContext methodsFor: 'plugins' stamp: 'MarcusDenker 2/28/2015 15:22'!
addASTTransformationPlugin: aPlugin
	astTransformPlugins add: aPlugin! !

!CCompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/26/2013 09:29'!
class: anObject
	class := anObject! !

!CCompilationContext methodsFor: 'accessing' stamp: 'ClementBera 1/28/2015 09:21'!
encoderClass: anObject
	encoderClass := anObject! !

!CCompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/26/2013 09:29'!
interactive
	^ interactive ifNil: [ false ]! !

!CCompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/26/2013 09:29'!
failBlock
	^ failBlock! !

!CCompilationContext methodsFor: 'options' stamp: 'MarcusDenker 5/26/2013 09:29'!
parseOptions: optionsArray

	"parse an array, which is a sequence of options in a form of: 
	
	#( + option1 option2 - option3 ... )
	
	each time the #+ is seen, the options which follow it will be subject for inclusion
	and, correspondingly, if #- seen, then they will be excluded	.

	By default, (if none of #+ or #- specified initially), all options are subject for inclusion.
	"
	| include |
	
	include := true.
	
	optionsArray do: [:option |
		option == #+ 
			ifTrue: [ include := true ]
			ifFalse: [
				option == #- 
					ifTrue: [ include := false ]
					ifFalse: [ 
						include ifTrue: [ options add: option ] 
						ifFalse: [ options remove: option ifAbsent:[] ]]]
		].! !

!CCompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/26/2013 09:29'!
noPattern
	^noPattern ifNil: [ false ].! !

!CCompilationContext methodsFor: 'options' stamp: 'ClementBera 10/27/2014 11:25'!
optionInlineNone
	^ options includes: #optionInlineNone
! !

!CCompilationContext methodsFor: 'accessing' stamp: 'ClementBera 11/26/2013 13:42'!
warningAllowed
	^ self class warningAllowed! !

!CCompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/26/2013 09:29'!
category: anObject
	category := anObject! !

!CCompilationContext class methodsFor: 'initialize' stamp: 'ClementBera 1/28/2015 09:22'!
initialize
	super initialize.
	BytecodeBackend := EncoderForV3PlusClosures  ! !

!CCompilationContext class methodsFor: 'instance creation' stamp: 'MarcusDenker 5/26/2013 09:29'!
default 
	^ self new parseOptions: OpalCompiler defaultOptions! !

!CCompilationContext class methodsFor: 'compiler' stamp: 'MarcusDenker 5/26/2013 09:56'!
compiler
	^self compilerClass new
		compilationContextClass: CompilationContext;
		environment: self environment;
		class: self! !

!CCompilationContext class methodsFor: 'accessing' stamp: 'ClementBera 11/26/2013 13:42'!
warningAllowed: aBoolean
	WarningAllowed := aBoolean! !

!CCompilationContext class methodsFor: 'accessing' stamp: 'ClementBera 7/7/2014 10:55'!
bytecodeBackend: bytecodeSet
	BytecodeBackend := bytecodeSet! !

!CCompilationContext class methodsFor: 'accessing' stamp: 'ClementBera 11/26/2013 13:42'!
warningAllowed
	^ WarningAllowed ifNil: [ WarningAllowed := true ]! !

!CCompilationContext class methodsFor: 'accessing' stamp: 'ClementBera 7/7/2014 10:54'!
bytecodeBackend
	^ BytecodeBackend ifNil: [ self initialize ]! !

!CNGBTextConverter commentStamp: '<historical>'!
Text converter for Simplified Chinese variation of EUC.  (Even though the name doesn't look so, it is what it is.)!
!CNGBTextConverter methodsFor: 'private' stamp: 'yo 10/23/2002 14:42'!
leadingChar

	^ GB2312 leadingChar
! !

!CNGBTextConverter methodsFor: 'private' stamp: 'yo 3/17/2004 00:41'!
languageEnvironment

	^ SimplifiedChineseEnvironment.
! !

!CNGBTextConverter class methodsFor: 'utilities' stamp: 'yo 10/23/2002 14:42'!
encodingNames 

	^ #('gb2312' ) copy
! !

!CP1250TextConverter commentStamp: '<historical>'!
Text converter for CP1250.  Windows code page used in Eastern Europe.!
!CP1250TextConverter class methodsFor: 'as yet unclassified' stamp: ''!
initialize
	self initializeTables! !

!CP1250TextConverter class methodsFor: 'accessing' stamp: 'michael.rueger 1/30/2009 11:02'!
languageEnvironment
	^Latin2Environment! !

!CP1250TextConverter class methodsFor: 'accessing' stamp: 'pk 1/19/2005 14:35'!
encodingNames 

	^ #('cp-1250') copy
! !

!CP1250TextConverter class methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 3/7/2012 21:36'!
byteToUnicodeSpec
	"ByteTextConverter generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1250.TXT'"

	^ #(
	16r20AC nil 16r201A nil 16r201E 16r2026 16r2020 16r2021 
	nil 16r2030 16r0160 16r2039 16r015A 16r0164 16r017D 16r0179 
	nil 16r2018 16r2019 16r201C 16r201D 16r2022 16r2013 16r2014 
	nil 16r2122 16r0161 16r203A 16r015B 16r0165 16r017E 16r017A 
	16r00A0 16r02C7 16r02D8 16r0141 16r00A4 16r0104 16r00A6 16r00A7 
	16r00A8 16r00A9 16r015E 16r00AB 16r00AC 16r00AD 16r00AE 16r017B 
	16r00B0 16r00B1 16r02DB 16r0142 16r00B4 16r00B5 16r00B6 16r00B7 
	16r00B8 16r0105 16r015F 16r00BB 16r013D 16r02DD 16r013E 16r017C 
	16r0154 16r00C1 16r00C2 16r0102 16r00C4 16r0139 16r0106 16r00C7 
	16r010C 16r00C9 16r0118 16r00CB 16r011A 16r00CD 16r00CE 16r010E 
	16r0110 16r0143 16r0147 16r00D3 16r00D4 16r0150 16r00D6 16r00D7 
	16r0158 16r016E 16r00DA 16r0170 16r00DC 16r00DD 16r0162 16r00DF 
	16r0155 16r00E1 16r00E2 16r0103 16r00E4 16r013A 16r0107 16r00E7 
	16r010D 16r00E9 16r0119 16r00EB 16r011B 16r00ED 16r00EE 16r010F 
	16r0111 16r0144 16r0148 16r00F3 16r00F4 16r0151 16r00F6 16r00F7 
	16r0159 16r016F 16r00FA 16r0171 16r00FC 16r00FD 16r0163 16r02D9 )! !

!CP1252TextConverter commentStamp: '<historical>'!
Text converter for CP1252.  Windows code page used in Western Europe.!
!CP1252TextConverter class methodsFor: 'initialization' stamp: 'pmm 8/16/2010 10:58'!
initialize
	self initializeTables! !

!CP1252TextConverter class methodsFor: 'accessing' stamp: 'pmm 8/16/2010 10:30'!
languageEnvironment
	^Latin9Environment! !

!CP1252TextConverter class methodsFor: 'accessing' stamp: 'pmm 8/16/2010 10:59'!
encodingNames 

	^ #('cp-1252') copy
! !

!CP1252TextConverter class methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 3/7/2012 21:37'!
byteToUnicodeSpec
	"ByteTextConverter generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1252.TXT'"

	^ #(
	16r20AC nil 16r201A 16r0192 16r201E 16r2026 16r2020 16r2021 
	16r02C6 16r2030 16r0160 16r2039 16r0152 nil 16r017D nil 
	nil 16r2018 16r2019 16r201C 16r201D 16r2022 16r2013 16r2014 
	16r02DC 16r2122 16r0161 16r203A 16r0153 nil 16r017E 16r0178 
	16r00A0 16r00A1 16r00A2 16r00A3 16r00A4 16r00A5 16r00A6 16r00A7 
	16r00A8 16r00A9 16r00AA 16r00AB 16r00AC 16r00AD 16r00AE 16r00AF 
	16r00B0 16r00B1 16r00B2 16r00B3 16r00B4 16r00B5 16r00B6 16r00B7 
	16r00B8 16r00B9 16r00BA 16r00BB 16r00BC 16r00BD 16r00BE 16r00BF 
	16r00C0 16r00C1 16r00C2 16r00C3 16r00C4 16r00C5 16r00C6 16r00C7 
	16r00C8 16r00C9 16r00CA 16r00CB 16r00CC 16r00CD 16r00CE 16r00CF 
	16r00D0 16r00D1 16r00D2 16r00D3 16r00D4 16r00D5 16r00D6 16r00D7 
	16r00D8 16r00D9 16r00DA 16r00DB 16r00DC 16r00DD 16r00DE 16r00DF 
	16r00E0 16r00E1 16r00E2 16r00E3 16r00E4 16r00E5 16r00E6 16r00E7 
	16r00E8 16r00E9 16r00EA 16r00EB 16r00EC 16r00ED 16r00EE 16r00EF 
	16r00F0 16r00F1 16r00F2 16r00F3 16r00F4 16r00F5 16r00F6 16r00F7 
	16r00F8 16r00F9 16r00FA 16r00FB 16r00FC 16r00FD 16r00FE 16r00FF )! !

!CP1253TextConverter commentStamp: '<historical>'!
Text converter for CP1253.  Windows code page used for Greek. !
!CP1253TextConverter class methodsFor: 'as yet unclassified' stamp: ''!
initialize
	self initializeTables! !

!CP1253TextConverter class methodsFor: 'accessing' stamp: 'michael.rueger 2/2/2009 18:49'!
languageEnvironment
	^GreekEnvironment! !

!CP1253TextConverter class methodsFor: 'accessing' stamp: 'yo 2/19/2004 10:11'!
encodingNames 

	^ #('cp-1253') copy
! !

!CP1253TextConverter class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 3/7/2012 21:37'!
byteToUnicodeSpec
	"ByteTextConverter generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1253.TXT'"

	^ #(
	16r20AC nil 16r201A 16r0192 16r201E 16r2026 16r2020 16r2021 
	nil 16r2030 nil 16r2039 nil nil nil nil 
	nil 16r2018 16r2019 16r201C 16r201D 16r2022 16r2013 16r2014 
	nil 16r2122 nil 16r203A nil nil nil nil 
	16r00A0 16r0385 16r0386 16r00A3 16r00A4 16r00A5 16r00A6 16r00A7 
	16r00A8 16r00A9 nil 16r00AB 16r00AC 16r00AD 16r00AE 16r2015 
	16r00B0 16r00B1 16r00B2 16r00B3 16r0384 16r00B5 16r00B6 16r00B7 
	16r0388 16r0389 16r038A 16r00BB 16r038C 16r00BD 16r038E 16r038F 
	16r0390 16r0391 16r0392 16r0393 16r0394 16r0395 16r0396 16r0397 
	16r0398 16r0399 16r039A 16r039B 16r039C 16r039D 16r039E 16r039F 
	16r03A0 16r03A1 nil 16r03A3 16r03A4 16r03A5 16r03A6 16r03A7 
	16r03A8 16r03A9 16r03AA 16r03AB 16r03AC 16r03AD 16r03AE 16r03AF 
	16r03B0 16r03B1 16r03B2 16r03B3 16r03B4 16r03B5 16r03B6 16r03B7 
	16r03B8 16r03B9 16r03BA 16r03BB 16r03BC 16r03BD 16r03BE 16r03BF 
	16r03C0 16r03C1 16r03C2 16r03C3 16r03C4 16r03C5 16r03C6 16r03C7 
	16r03C8 16r03C9 16r03CA 16r03CB 16r03CC 16r03CD 16r03CE nil )! !

!CPUWatcher commentStamp: 'VeronicaUquillas 6/11/2010 12:47'!
CPUWatcher implements a simple runaway process monitoring tool
that will suspend a process that is taking up too much of Pharo's
time and allow user interaction. By default it watches for a Process that
is taking more than 80% of the time; this threshold can be changed.

CPUWatcher can also be used to show cpu percentages for each process 
from within the ProcessBrowser.

	CPUWatcher startMonitoring.	"process period 20 seconds, sample rate 100 msec"
	CPUWatcher current monitorProcessPeriod: 10 sampleRate: 20.
	CPUWatcher current threshold: 0.5.	"change from 80% to 50%"
	CPUWatcher stopMonitoring.
!
!CPUWatcher methodsFor: 'startup-shutdown' stamp: 'IgorStasenko 3/6/2011 18:11'!
stopMonitoring
	watcher ifNotNil: [
		self processBrowser terminateProcess: watcher.
		watcher := nil.
	]! !

!CPUWatcher methodsFor: 'accessing' stamp: 'nk 3/8/2001 18:36'!
tally
	^tally copy! !

!CPUWatcher methodsFor: 'accessing' stamp: 'sd 11/20/2005 21:27'!
threshold: thresh
	"What fraction of the time can a process be the active process before we stop it?"
	threshold := (thresh max: 0.02) min: 1.0! !

!CPUWatcher methodsFor: 'porcine capture' stamp: 'StephaneDucasse 10/26/2014 11:19'!
openMorphicWindowForSuspendedProcess: aProcess
	| menu rules |
	menu := UIManager default newMenuIn: self for: self.
	"nickname  allow-stop  allow-debug"
	rules := self  processBrowser nameAndRulesFor: aProcess.
	menu add: 'Dismiss this menu' 
		target: menu 
		selector: #delete; 
		addLine.
	menu add: 'Open Process Browser' 
		target: self processBrowser 
		selector: #open.
	menu add: 'Resume'
		target: self
		selector: #resumeProcess:fromMenu:
		argumentList: { aProcess . menu }.
	menu add: 'Terminate'
		target: self
		selector: #terminateProcess:fromMenu:
		argumentList: { aProcess . menu }.
	rules third ifTrue: [
		menu add: 'Debug at a lower priority'
			target: self
			selector: #debugProcess:fromMenu:
			argumentList: { aProcess . menu }.
	].
	menu addTitle: aProcess identityHash asString,
		' ', rules first,
		' is taking too much time and has been suspended.
What do you want to do with it?'.
	menu stayUp: true.
	menu popUpInWorld
! !

!CPUWatcher methodsFor: 'accessing' stamp: 'nk 3/14/2001 07:56'!
isMonitoring
	^watcher notNil! !

!CPUWatcher methodsFor: 'process operations' stamp: 'IgorStasenko 3/6/2011 18:11'!
resumeProcess: aProcess fromMenu: aMenuMorph
	aMenuMorph delete.
	self processBrowser resumeProcess: aProcess.! !

!CPUWatcher methodsFor: 'accessing' stamp: 'nk 3/8/2001 18:49'!
threshold
	"What fraction of the time can a process be the active process before we stop it?"
	^threshold! !

!CPUWatcher methodsFor: 'startup-shutdown' stamp: 'nk 3/14/2001 08:07'!
startMonitoring
	self
		monitorProcessPeriod: 20 sampleRate: 100! !

!CPUWatcher methodsFor: 'process operations' stamp: 'nk 3/8/2001 17:27'!
debugProcess: aProcess fromMenu: aMenuMorph
	aMenuMorph delete.
	self debugProcess: aProcess.! !

!CPUWatcher methodsFor: 'porcine capture' stamp: 'CamilloBruni 8/21/2013 19:22'!
catchThePig: aProcess
	| rules  |
	"nickname, allow-stop, allow-debug"
	rules := self processBrowser nameAndRulesFor: aProcess.

	(self processBrowser isUIProcess: aProcess)
		ifTrue: [ "aProcess debugWithTitle: 'Interrupted from the CPUWatcher'." ]
		ifFalse: [ 
			rules second ifFalse: [ ^self ].
			self processBrowser suspendProcess: aProcess.
			self openWindowForSuspendedProcess: aProcess ]
! !

!CPUWatcher methodsFor: 'accessing' stamp: 'nk 3/14/2001 08:26'!
watcherProcess
	^watcher! !

!CPUWatcher methodsFor: 'accessing' stamp: 'IgorStasenko 3/6/2011 18:10'!
processBrowser
	^ Smalltalk tools processBrowser! !

!CPUWatcher methodsFor: 'porcine capture' stamp: 'MarcusDenker 9/28/2013 13:50'!
findThePig
	"tally has been updated. Look at it to see if there is a bad process.
	This runs at a very high priority, so make it fast"

	| countAndProcess process |
	countAndProcess := tally sortedCounts first.
	countAndProcess key / tally size > self threshold
		ifFalse: [ ^ self ].
	process := countAndProcess value.
	process == Processor backgroundProcess
		ifTrue: [ ^ self ].	"idle process? OK"
	self catchThePig: process! !

!CPUWatcher methodsFor: 'porcine capture' stamp: 'AlainPlantec 7/9/2013 11:09'!
openWindowForSuspendedProcess: aProcess

	 UIManager default defer: [ self openMorphicWindowForSuspendedProcess: aProcess ] 
	! !

!CPUWatcher methodsFor: 'process operations' stamp: 'MarcusDenker 8/1/2014 13:16'!
debugProcess: aProcess
	| uiPriority  |
	uiPriority := Processor activeProcess priority.
	aProcess priority >= uiPriority ifTrue: [
		self processBrowser setProcess: aProcess toPriority: uiPriority - 1
	].
	self processBrowser debugProcess: aProcess.! !

!CPUWatcher methodsFor: 'startup-shutdown' stamp: 'sd 11/20/2005 21:27'!
monitorProcessPeriod: secs sampleRate: msecs
	self stopMonitoring.

	watcher := [ [ | promise |
		promise := Processor tallyCPUUsageFor: secs every: msecs.
		tally := promise value.
		promise := nil.
		self findThePig.
	] repeat ] forkAt: Processor highestPriority.
	Processor yield ! !

!CPUWatcher methodsFor: 'process operations' stamp: 'IgorStasenko 3/6/2011 18:11'!
terminateProcess: aProcess fromMenu: aMenuMorph
	aMenuMorph delete.
	self processBrowser terminateProcess: aProcess.! !

!CPUWatcher class methodsFor: 'monitoring' stamp: 'sd 11/20/2005 21:28'!
stopMonitoring
	"CPUWatcher stopMonitoring"

	CurrentCPUWatcher ifNotNil: [ CurrentCPUWatcher stopMonitoring. ].
	CurrentCPUWatcher := nil.
! !

!CPUWatcher class methodsFor: 'system startup' stamp: 'nk 6/18/2003 07:14'!
shutDown
	self stopMonitoring.! !

!CPUWatcher class methodsFor: 'testing' stamp: 'nk 3/14/2001 08:06'!
isMonitoring

	^CurrentCPUWatcher notNil and: [ CurrentCPUWatcher isMonitoring ]
! !

!CPUWatcher class methodsFor: 'setting' stamp: 'AlainPlantec 12/5/2009 19:44'!
cpuWatcherEnabled: aBoolean
	CpuWatcherEnabled = aBoolean ifTrue: [^ self].
	CpuWatcherEnabled := aBoolean.
	self monitorPreferenceChanged
! !

!CPUWatcher class methodsFor: 'startup-shutdown' stamp: 'nk 3/14/2001 08:17'!
startMonitoring
	"CPUWatcher startMonitoring"

	^self startMonitoringPeriod: 20 rate: 100 threshold: 0.8! !

!CPUWatcher class methodsFor: 'class initialization' stamp: 'nk 6/18/2003 07:15'!
initialize
	"CPUWatcher initialize"
	Smalltalk addToStartUpList: self.
	Smalltalk addToShutDownList: self.! !

!CPUWatcher class methodsFor: 'system startup' stamp: 'nk 6/18/2003 07:14'!
startUp
	self monitorPreferenceChanged.! !

!CPUWatcher class methodsFor: 'monitoring' stamp: 'sd 11/20/2005 21:28'!
startMonitoringPeriod: pd rate: rt threshold: th
	"CPUWatcher startMonitoring"

	CurrentCPUWatcher ifNotNil: [ ^CurrentCPUWatcher startMonitoring. ].
	CurrentCPUWatcher := (self new)
		monitorProcessPeriod: pd sampleRate: rt;
		threshold: th;
		yourself.
	^CurrentCPUWatcher
! !

!CPUWatcher class methodsFor: 'setting' stamp: 'AlainPlantec 12/5/2009 19:43'!
monitorPreferenceChanged
	self cpuWatcherEnabled
		ifTrue: [ self startMonitoring ]
		ifFalse: [ self stopMonitoring ]! !

!CPUWatcher class methodsFor: 'accessing' stamp: 'nk 3/14/2001 08:28'!
currentWatcherProcess
	^CurrentCPUWatcher ifNotNil: [ CurrentCPUWatcher watcherProcess ]
! !

!CPUWatcher class methodsFor: 'setting' stamp: 'AlainPlantec 12/5/2009 19:42'!
cpuWatcherEnabled
	^ CpuWatcherEnabled ifNil: [CpuWatcherEnabled := false]! !

!CPUWatcher class methodsFor: 'accessing' stamp: 'nk 3/8/2001 18:45'!
current
	^CurrentCPUWatcher
! !

!CPUWatcher class methodsFor: 'monitoring' stamp: 'IgorStasenko 3/6/2011 18:11'!
dumpTallyOnTranscript
	self current ifNotNil: [
		self processBrowser dumpTallyOnTranscript: self current tally
	]! !

!CRC commentStamp: '<historical>'!
Parameterized implementation of the cyclic redundancy check (CRC) algorithm.

INTRODUCTION
=================
This implementation is based on the (awesome) paper "A Painless Guide to CRC Error Detection Algorithms" by Ross Williams. You should find a copy of the paper here: http://www.ross.net/crc/. In this paper Ross describes a parameterized implementation that enables the different variations of the CRC algorithm to be used in a consistent way, simply by adjusting the parameters. If you don't have a clue about CRC (like me) then I strongly suggest reading the paper. It will also help you to understand how to make the best use of this implementation.

The "CRC RevEng" project on sourceforge implements Williams's "RockSoft" parameterized CRC program (as does this class) and comes with a handy list of parameters for various CRC algorithm: http://reveng.sourceforge.net/crc-catalogue/.

For ease of use and better performance, the two defacto standard variations "CRC16" and "CRC32" have been predefined. The lookup tables for these implementations are included on the class side. For all other variations the lookup table will be generated at runtime before the first run.

If you want to define your own algorithm you can do so by using the methods in the "accessing-parameters" protocol. Note that there are no default values. Here's a short overview:
	#width: 			defines the width of the register (usually 16 or 32)
	#polynome: 		defines the polynome to use for polynome division / lookup table creation
	#registerFill: 		defines the start content of the working register (usually all ones or all zeros)
	#reflectInput: 		if true every byte will be reflected before processing (e.g. 100101 -> 101001)
	#reflectOutpu: 		if true the entire register will be reflected before the final XOR stage
	#finallyXorWith: 	defines the final XOR for the entire register
	#lookupTable: 		the only OPTIONAL parameter. The lookup table will be generated at runtime if none has been supplied
	#message: 			the message to calculate the CRC on 
		

EXAMPLES
=================
The simplest possible snippet uses the class side methods for "CRC16" and "CRC32":
	CRC crc16FromCollection: 'some message'. --> 55709
	CRC crc32FromCollection: 'some message'. --> 191312361

Let's assume, you wanted to use "CRC16 reversed" (neither input nor output reflected). Then you would have to change the parameters like so (the reversed form uses a different polynome and a different start register content):
	crc := CRC new
		beCrc16;
		polynome: 16r1021;
		registerFill: 16rFFFF;
		reflectInput: false;
		reflectOutput: false;
		message: 'some message';
		yourself.
	crc run. --> 46785
	
Using a single instance as in the code above will of course be faster than using the class side methods when performing multiple runs. But if you are really concerned about performance (see PERFORMANCE) you should use the "raw" methods (no checks!! If you forget to set parameters there will be errors....):
	crc := CRC new
		beCrc16;
		message: 'some message';
		yourself.
	crc runRefInRefOut. --> 55709
	
	crc := CRC new
		beCrc16;
		polynome: 16r1021;
		registerFill: 16rFFFF;
		message: 'some message';
		yourself.
	crc runNonRefInNonRefOut. --> 46785
	

PERFORMANCE
=================
The performance of this implementation (tested for crc16) is equal to the performance of String>>crc16 if executed "raw" (see EXAMPLES). For the users sake however, the implementation does a few extra checks to improve ease of use. The cost is a loss of performance of about factor 1.15 (single instance) and 1.42 (one instance per run) (note that although I took an average of 10, the results will vary quite a bit each time you run the code):
	crc := CRC new 
		beCrc16; 
		message: 'this is a test message'; 
		yourself.
	
	"String>>crc16"	
	times := OrderedCollection new.
	10 timesRepeat: [ times add: [ 1000000 timesRepeat: [ 'this is a test message' crc16 ] ] timeToRun ].
	times average floor. --> 530
	
	"raw"
	times := OrderedCollection new.
	10 timesRepeat: [ times add: [ 1000000 timesRepeat: [ crc runRefInRefOut ] ] timeToRun ].
	times average floor. --> 535
	
	"user friendly, one instance"	
	times := OrderedCollection new.
	10 timesRepeat: [ times add: [ 1000000 timesRepeat: [ crc run ] ] timeToRun ].
	times average floor. --> 616
	
	"user friendly, one instance per run"
	times := OrderedCollection new.
	10 timesRepeat: [ times add: [ 1000000 timesRepeat: [ CRC crc16FromCollection: 'this is a test message' ] ] timeToRun ].
	times average floor. --> 759!
!CRC methodsFor: 'accessing-implementations' stamp: 'MaxLeske 3/17/2012 21:04'!
beCrc16
	self
		width: 16;
		lookupTable: self class crc16Table;
		polynome: 16r8005;
		registerFill: 16r0;
		reflectInput: true;
		reflectOutput: true;
		finallyXorWith: 16r0! !

!CRC methodsFor: 'private-bit-manipulation' stamp: 'MaxLeske 3/18/2012 10:07'!
lowestByteShift
	^ lowestByteShift ifNil: [ lowestByteShift := width - 8 ]! !

!CRC methodsFor: 'accessing-parameters' stamp: 'MaxLeske 3/18/2012 10:15'!
width: anInteger
	"width of the register (on how many bits the CRC is calculated).
	usually 16 or 32"
	width := anInteger! !

!CRC methodsFor: 'accessing-implementations' stamp: 'MaxLeske 3/17/2012 21:05'!
beCrc32
	self
		width: 32;
		lookupTable: self class crc32Table;
		polynome: 16r04C11DB7;
		registerFill: 16rFFFFFFFF;
		reflectInput: true;
		reflectOutput: true;
		finallyXorWith: 16rFFFFFFFF! !

!CRC methodsFor: 'private-run-methods' stamp: 'MaxLeske 3/18/2012 10:28'!
runNonRefInNonRefOut
	theRegister := registerFill.
	1 to: message size do: [ :byteIndex | 
		theRegister := 
			(lookupTable at: (((theRegister bitShift: 0 - self lowestByteShift) bitXor: (message byteAt: byteIndex)) bitAnd: 255) + 1)
			bitXor: ((theRegister bitShift: 8) bitAnd: self widthMask) ].
			
	^ finalXorBytes bitXor: theRegister! !

!CRC methodsFor: 'accessing-parameters' stamp: 'MaxLeske 3/16/2012 16:50'!
message: anObject
	message := anObject asByteArray! !

!CRC methodsFor: 'accessing-parameters' stamp: 'MaxLeske 3/18/2012 10:11'!
registerFill: anInteger
	"The initial value of the CRC register"
	registerFill := anInteger! !

!CRC methodsFor: 'private-tables' stamp: 'MaxLeske 3/18/2012 10:01'!
generateLookupTable
	"lookup tables have 256 entries"
	^ Array 
		new: 256
		streamContents: [ :aStream | self printLookupTableOn: aStream ]! !

!CRC methodsFor: 'private-tables' stamp: 'MaxLeske 3/18/2012 10:06'!
printLookupTableOn: aStream
	| topBit |
	topBit := self bitMaskAt: width.
	0 to: 255 do: [ :index || register indexByte |
		indexByte := index.
		shouldReflectInput ifTrue: [ indexByte := self reflect: indexByte onLowerBits: 8 ].
		register := indexByte << self lowestByteShift.
		1 to: 8 do: [ : byteIndex |
			register :=
				(register bitAnd: topBit) > 0 
					ifTrue: [ (register << 1) bitXor: polynome ]
					ifFalse: [ register << 1 ] ].
		shouldReflectInput ifTrue: [ 
			register := self reflect: register onLowerBits: width ].
		register := (register bitAnd: self widthMask).
		aStream nextPut: register ]! !

!CRC methodsFor: 'public' stamp: 'MaxLeske 3/17/2012 21:13'!
run
	lookupTable ifNil: [ lookupTable := self generateLookupTable ].
	^ self perform: self runMethodSelector! !

!CRC methodsFor: 'private-run-methods' stamp: 'MaxLeske 3/18/2012 10:27'!
runRefInRefOut
	theRegister := registerFill.
	1 to: message size do: [ :byteIndex | 
		theRegister := 
			(lookupTable at: ((theRegister bitXor: (message byteAt: byteIndex)) bitAnd: 255) + 1) 
			bitXor: (theRegister bitShift: -8) ].
			
	^ finalXorBytes bitXor: theRegister! !

!CRC methodsFor: 'private-run-methods' stamp: 'MaxLeske 3/18/2012 10:57'!
runRefInNonRefOut
	Warning signal: 'unverified implementation'.
	theRegister := registerFill.
	1 to: message size do: [ :byteIndex | 
		theRegister := 
			(lookupTable at: ((theRegister bitXor: (message byteAt: byteIndex)) bitAnd: 255) + 1) 
			bitXor: ((theRegister bitShift: 8) bitAnd: self widthMask) ].
			
	^ finalXorBytes bitXor: theRegister! !

!CRC methodsFor: 'accessing-parameters' stamp: 'MaxLeske 3/18/2012 10:11'!
reflectOutput: aBoolean
	"Determines if the output is reflected before the final XOR."
	shouldReflectOutput := aBoolean! !

!CRC methodsFor: 'private-bit-manipulation' stamp: 'MaxLeske 3/18/2012 10:14'!
widthMask 	
	"bit mask (all ones)"
	^ widthMask ifNil: [ widthMask := (2 raisedTo: width) - 1 ]! !

!CRC methodsFor: 'private-bit-manipulation' stamp: 'MaxLeske 3/4/2012 19:37'!
bitMaskAt: anInteger
	^ 0 bitAt: anInteger put: 1! !

!CRC methodsFor: 'private-bit-manipulation' stamp: 'MaxLeske 3/18/2012 09:31'!
invertedBitMaskAt: anInteger
	anInteger < 1 ifTrue: [ ^ 16rFFFFFFFF ].
	^ 16rFFFFFFFF bitAt: anInteger put: 0! !

!CRC methodsFor: 'accessing-parameters' stamp: 'MaxLeske 3/18/2012 09:59'!
polynome: anInteger
	"The polynome used for polynomial division.
	It should be of the same length as the register width (see #width:)."
	polynome := anInteger! !

!CRC methodsFor: 'private-bit-manipulation' stamp: 'MaxLeske 3/16/2012 16:02'!
reflect: anInteger onLowerBits: anotherInteger
	| register test |
	register := anInteger.
	test := anInteger.
	0 to: anotherInteger - 1 do: [ :index |
		register := 
			(test bitAnd: 1) = 1
				ifTrue: [ register bitOr: (self bitMaskAt: anotherInteger - index) ]
				ifFalse: [ register bitAnd: (self invertedBitMaskAt: anotherInteger - index) ].
	test := test bitShift: -1 ].

	^ register! !

!CRC methodsFor: 'accessing-parameters' stamp: 'MaxLeske 3/18/2012 10:11'!
reflectInput: aBoolean
	"Determines if each byte should be reflected before processing.
	If false, bit 7 will be treated as most significant bit.
	If true, each byte will be reflected (bit 0 will be most significant)."
	shouldReflectInput := aBoolean! !

!CRC methodsFor: 'private-run-methods' stamp: 'MaxLeske 3/18/2012 09:27'!
runMethodSelector
	^ runMethodSelector ifNil: [ 
		runMethodSelector := 
			shouldReflectInput
				ifTrue: [ 
					shouldReflectOutput
						ifTrue: [ #runRefInRefOut ] 
						ifFalse: [ #runRefInNonRefOut ] ]
				ifFalse: [ 
					shouldReflectOutput 
						ifTrue: [ #runNonRefInRefOut ] 
						ifFalse: [ #runNonRefInNonRefOut ] ] ]! !

!CRC methodsFor: 'private-run-methods' stamp: 'MaxLeske 3/18/2012 10:57'!
runNonRefInRefOut
	Warning signal: 'unverified implementation'.
	theRegister := registerFill.
	1 to: message size do: [ :byteIndex | 
		theRegister := 
			(lookupTable at: (((theRegister bitShift: 0 - self lowestByteShift) bitXor: (message byteAt: byteIndex)) bitAnd: 255) + 1)
			bitXor: (theRegister bitShift: -8) ].
			
	^ finalXorBytes bitXor: theRegister! !

!CRC methodsFor: 'accessing-parameters' stamp: 'MaxLeske 3/6/2012 08:25'!
lookupTable: anArray
	lookupTable := anArray! !

!CRC methodsFor: 'accessing-parameters' stamp: 'MaxLeske 3/3/2012 22:50'!
finallyXorWith: anInteger
	"The final XOR of the output will be performed with this value"
	finalXorBytes := anInteger! !

!CRC class methodsFor: 'accessing-tables' stamp: 'MaxLeske 3/6/2012 10:03'!
crc32Table
	^ #(	 16r00000000	 16r77073096	 16rEE0E612C	 16r990951BA	
			 16r076DC419	 16r706AF48F	 16rE963A535	 16r9E6495A3	
			 16r0EDB8832	 16r79DCB8A4	 16rE0D5E91E	 16r97D2D988	
			 16r09B64C2B	 16r7EB17CBD	 16rE7B82D07	 16r90BF1D91	
			 16r1DB71064	 16r6AB020F2	 16rF3B97148	 16r84BE41DE	
			 16r1ADAD47D	 16r6DDDE4EB	 16rF4D4B551	 16r83D385C7	
			 16r136C9856	 16r646BA8C0	 16rFD62F97A	 16r8A65C9EC	
			 16r14015C4F	 16r63066CD9	 16rFA0F3D63	 16r8D080DF5	
			 16r3B6E20C8	 16r4C69105E	 16rD56041E4	 16rA2677172	
			 16r3C03E4D1	 16r4B04D447	 16rD20D85FD	 16rA50AB56B	
			 16r35B5A8FA	 16r42B2986C	 16rDBBBC9D6	 16rACBCF940	
			 16r32D86CE3	 16r45DF5C75	 16rDCD60DCF	 16rABD13D59	
			 16r26D930AC	 16r51DE003A	 16rC8D75180	 16rBFD06116	
			 16r21B4F4B5	 16r56B3C423	 16rCFBA9599	 16rB8BDA50F	
			 16r2802B89E	 16r5F058808	 16rC60CD9B2	 16rB10BE924	
			 16r2F6F7C87	 16r58684C11	 16rC1611DAB	 16rB6662D3D	
			 16r76DC4190	 16r01DB7106	 16r98D220BC	 16rEFD5102A	
			 16r71B18589	 16r06B6B51F	 16r9FBFE4A5	 16rE8B8D433	
			 16r7807C9A2	 16r0F00F934	 16r9609A88E	 16rE10E9818	
			 16r7F6A0DBB	 16r086D3D2D	 16r91646C97	 16rE6635C01	
			 16r6B6B51F4	 16r1C6C6162	 16r856530D8	 16rF262004E	
			 16r6C0695ED	 16r1B01A57B	 16r8208F4C1	 16rF50FC457	
			 16r65B0D9C6	 16r12B7E950	 16r8BBEB8EA	 16rFCB9887C	
			 16r62DD1DDF	 16r15DA2D49	 16r8CD37CF3	 16rFBD44C65	
			 16r4DB26158	 16r3AB551CE	 16rA3BC0074	 16rD4BB30E2	
			 16r4ADFA541	 16r3DD895D7	 16rA4D1C46D	 16rD3D6F4FB	
			 16r4369E96A	 16r346ED9FC	 16rAD678846	 16rDA60B8D0	
			 16r44042D73	 16r33031DE5	 16rAA0A4C5F	 16rDD0D7CC9	
			 16r5005713C	 16r270241AA	 16rBE0B1010	 16rC90C2086	
			 16r5768B525	 16r206F85B3	 16rB966D409	 16rCE61E49F	
			 16r5EDEF90E	 16r29D9C998	 16rB0D09822	 16rC7D7A8B4	
			 16r59B33D17	 16r2EB40D81	 16rB7BD5C3B	 16rC0BA6CAD	
			 16rEDB88320	 16r9ABFB3B6	 16r03B6E20C	 16r74B1D29A	
			 16rEAD54739	 16r9DD277AF	 16r04DB2615	 16r73DC1683	
			 16rE3630B12	 16r94643B84	 16r0D6D6A3E	 16r7A6A5AA8	
			 16rE40ECF0B	 16r9309FF9D	 16r0A00AE27	 16r7D079EB1	
			 16rF00F9344	 16r8708A3D2	 16r1E01F268	 16r6906C2FE	
			 16rF762575D	 16r806567CB	 16r196C3671	 16r6E6B06E7	
			 16rFED41B76	 16r89D32BE0	 16r10DA7A5A	 16r67DD4ACC	
			 16rF9B9DF6F	 16r8EBEEFF9	 16r17B7BE43	 16r60B08ED5	
			 16rD6D6A3E8	 16rA1D1937E	 16r38D8C2C4	 16r4FDFF252	
			 16rD1BB67F1	 16rA6BC5767	 16r3FB506DD	 16r48B2364B	
			 16rD80D2BDA	 16rAF0A1B4C	 16r36034AF6	 16r41047A60	
			 16rDF60EFC3	 16rA867DF55	 16r316E8EEF	 16r4669BE79	
			 16rCB61B38C	 16rBC66831A	 16r256FD2A0	 16r5268E236	
			 16rCC0C7795	 16rBB0B4703	 16r220216B9	 16r5505262F	
			 16rC5BA3BBE	 16rB2BD0B28	 16r2BB45A92	 16r5CB36A04	
			 16rC2D7FFA7	 16rB5D0CF31	 16r2CD99E8B	 16r5BDEAE1D	
			 16r9B64C2B0	 16rEC63F226	 16r756AA39C	 16r026D930A	
			 16r9C0906A9	 16rEB0E363F	 16r72076785	 16r05005713	
			 16r95BF4A82	 16rE2B87A14	 16r7BB12BAE	 16r0CB61B38	
			 16r92D28E9B	 16rE5D5BE0D	 16r7CDCEFB7	 16r0BDBDF21	
			 16r86D3D2D4	 16rF1D4E242	 16r68DDB3F8	 16r1FDA836E	
			 16r81BE16CD	 16rF6B9265B	 16r6FB077E1	 16r18B74777	
			 16r88085AE6	 16rFF0F6A70	 16r66063BCA	 16r11010B5C	
			 16r8F659EFF	 16rF862AE69	 16r616BFFD3	 16r166CCF45	
			 16rA00AE278	 16rD70DD2EE	 16r4E048354	 16r3903B3C2	
			 16rA7672661	 16rD06016F7	 16r4969474D	 16r3E6E77DB	
			 16rAED16A4A	 16rD9D65ADC	 16r40DF0B66	 16r37D83BF0	
			 16rA9BCAE53	 16rDEBB9EC5	 16r47B2CF7F	 16r30B5FFE9	
			 16rBDBDF21C	 16rCABAC28A	 16r53B39330	 16r24B4A3A6	
			 16rBAD03605	 16rCDD70693	 16r54DE5729	 16r23D967BF	
			 16rB3667A2E	 16rC4614AB8	 16r5D681B02	 16r2A6F2B94	
			 16rB40BBE37	 16rC30C8EA1	 16r5A05DF1B	 16r2D02EF8D)! !

!CRC class methodsFor: 'primitives' stamp: 'MaxLeske 7/8/2013 21:41'!
update: oldCrc from: start to: stop in: aCollection
	| newCrc |
	<primitive: 'primitiveUpdateGZipCrc32' module: 'ZipPlugin'>
	newCrc := oldCrc.
	start to: stop do: [ :i |
		newCrc := (self crc32Table at: ((newCrc bitXor: (aCollection byteAt: i)) 
				bitAnd: 255) + 1) bitXor: (newCrc bitShift: -8) ].
	^newCrc! !

!CRC class methodsFor: 'accessing-tables' stamp: 'MaxLeske 3/6/2012 08:22'!
crc16Table
	^ #(	16r0000	16rC0C1	16rC181	16r0140	16rC301	16r03C0	16r0280	16rC241
			16rC601	16r06C0	16r0780	16rC741	16r0500	16rC5C1	16rC481	16r0440
			16rCC01	16r0CC0	16r0D80	16rCD41	16r0F00	16rCFC1	16rCE81	16r0E40
			16r0A00	16rCAC1	16rCB81	16r0B40	16rC901	16r09C0	16r0880	16rC841
			16rD801	16r18C0	16r1980	16rD941	16r1B00	16rDBC1	16rDA81	16r1A40
			16r1E00	16rDEC1	16rDF81	16r1F40	16rDD01	16r1DC0	16r1C80	16rDC41
			16r1400	16rD4C1	16rD581	16r1540	16rD701	16r17C0	16r1680	16rD641
			16rD201	16r12C0	16r1380	16rD341	16r1100	16rD1C1	16rD081	16r1040
			16rF001	16r30C0	16r3180	16rF141	16r3300	16rF3C1	16rF281	16r3240
			16r3600	16rF6C1	16rF781	16r3740	16rF501	16r35C0	16r3480	16rF441
			16r3C00	16rFCC1	16rFD81	16r3D40	16rFF01	16r3FC0	16r3E80	16rFE41
			16rFA01	16r3AC0	16r3B80	16rFB41	16r3900	16rF9C1	16rF881	16r3840
			16r2800	16rE8C1	16rE981	16r2940	16rEB01	16r2BC0	16r2A80	16rEA41
			16rEE01	16r2EC0	16r2F80	16rEF41	16r2D00	16rEDC1	16rEC81	16r2C40
			16rE401	16r24C0	16r2580	16rE541	16r2700	16rE7C1	16rE681	16r2640
			16r2200	16rE2C1	16rE381	16r2340	16rE101	16r21C0	16r2080	16rE041
			16rA001	16r60C0	16r6180	16rA141	16r6300	16rA3C1	16rA281	16r6240
			16r6600	16rA6C1	16rA781	16r6740	16rA501	16r65C0	16r6480	16rA441
			16r6C00	16rACC1	16rAD81	16r6D40	16rAF01	16r6FC0	16r6E80	16rAE41
			16rAA01	16r6AC0	16r6B80	16rAB41	16r6900	16rA9C1	16rA881	16r6840
			16r7800	16rB8C1	16rB981	16r7940	16rBB01	16r7BC0	16r7A80	16rBA41
			16rBE01	16r7EC0	16r7F80	16rBF41	16r7D00	16rBDC1	16rBC81	16r7C40
			16rB401	16r74C0	16r7580	16rB541	16r7700	16rB7C1	16rB681	16r7640
			16r7200	16rB2C1	16rB381	16r7340	16rB101	16r71C0	16r7080	16rB041
			16r5000	16r90C1	16r9181	16r5140	16r9301	16r53C0	16r5280	16r9241
			16r9601	16r56C0	16r5780	16r9741	16r5500	16r95C1	16r9481	16r5440
			16r9C01	16r5CC0	16r5D80	16r9D41	16r5F00	16r9FC1	16r9E81	16r5E40
			16r5A00	16r9AC1	16r9B81	16r5B40	16r9901	16r59C0	16r5880	16r9841
			16r8801	16r48C0	16r4980	16r8941	16r4B00	16r8BC1	16r8A81	16r4A40
			16r4E00	16r8EC1	16r8F81	16r4F40	16r8D01	16r4DC0	16r4C80	16r8C41
			16r4400	16r84C1	16r8581	16r4540	16r8701	16r47C0	16r4680	16r8641
			16r8201	16r42C0	16r4380	16r8341	16r4100	16r81C1	16r8081	16r4040)! !

!CRC class methodsFor: 'instance creation' stamp: 'MaxLeske 7/8/2013 21:33'!
crc16FromCollection: aCollection
	| instance |
	instance := 
		self new
			beCrc16;
			message: aCollection;
			yourself.
			
	^ instance runRefInRefOut! !

!CRC class methodsFor: 'instance creation' stamp: 'MaxLeske 3/18/2012 10:16'!
crc32FromCollection: aCollection
	| instance |
	instance := 
		self new
			beCrc32;
			message: aCollection;
			yourself.
	
	^ instance runRefInRefOut! !

!CRCError commentStamp: 'TorstenBergmann 2/3/2014 23:03'!
CRC failed!
!CRCError methodsFor: 'testing' stamp: 'nk 3/7/2004 15:56'!
isResumable
	^true! !

!CacheStatistics commentStamp: '<historical>'!
I am CacheStatistics.
I keep track of hits and misses of a cache.!
!CacheStatistics methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 12/2/2013 15:59'!
initialize
	super initialize.
	hits := misses := 0! !

!CacheStatistics methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/2/2013 15:59'!
misses
	^ misses! !

!CacheStatistics methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:00'!
addMiss
	misses := misses + 1! !

!CacheStatistics methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/2/2013 15:59'!
hits
	^ hits! !

!CacheStatistics methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:01'!
addHit
	hits := hits + 1! !

!CacheStatistics methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:01'!
hitRatio
	"Return the ratio of hits against total calls I received.
	This will be a number between 0 and 1.
	When I am empty, return 0."
	
	| total |
	total := hits + misses.
	total = 0 ifTrue: [ ^ 0 ].
	^ hits / total! !

!CacheStatistics methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 12/2/2013 16:00'!
reset
	hits := misses := 0! !

!CacheWeight commentStamp: '<historical>'!
I  am CacheWeight.
I keep track of the weight of a cache.

The weight of a cache is the sum of the weight of all values currently present. The simplest and default weight calculation returns a constant 1 for each value, effectively counting the number of values.

The default maximum is 16.

Using compute, a selector or block, applied to a value, different calculation can be made. Consider for example #sizeInMemory.!
!CacheWeight methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:27'!
isBelowMaximum
	^ total <= maximum ! !

!CacheWeight methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 12/2/2013 16:16'!
initialize
	super initialize.
	total := 0.
	maximum := 16.
	compute := [ 1 ]! !

!CacheWeight methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:25'!
compute
	^ compute! !

!CacheWeight methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:17'!
add: value
	| weight |
	weight := compute cull: value.
	total := total + weight! !

!CacheWeight methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:25'!
maximum
	^ maximum! !

!CacheWeight methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:19'!
total
	^ total! !

!CacheWeight methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:17'!
remove: value
	| weight |
	weight := compute cull: value.
	total := total - weight! !

!CacheWeight methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 12/2/2013 16:19'!
reset
	total := 0! !

!CacheWeight methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 12/2/2013 16:18'!
compute: valuable
	compute := valuable! !

!CacheWeight methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 12/2/2013 16:18'!
maximum: integer
	maximum := integer! !

!CaesarEcryptorDecryptor commentStamp: '<historical>'!
A CaesarEcryptorDecryptor is a world know encryptng algorithm by rotation!
!CaesarEcryptorDecryptor methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/6/2012 22:41'!
decrypt: aString base: aBase

	^ String streamContents: [:s | 
		aString do: [:c | s nextPut: ( Character value: (c asciiValue - aBase size )) ]]! !

!CaesarEcryptorDecryptor methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/6/2012 22:42'!
encrypt: aString base: aBase

	^ String streamContents: [:s | 
		aString do: [:c | s nextPut: ( Character value: (c asciiValue + aBase size )) ]]! !

!CairoBackendCache commentStamp: '<historical>'!
I providing a simple [weak]key->value storage used to cache various objects used by Athens for Cairo backend, like fonts/forms etc.

The cache is global (there's only a single instance of me used at a time) and
cache is visible globally by all entities of Cairo backend.

The cached objects is held weakly.
The cache is flushed for a new image session.!
!CairoBackendCache methodsFor: 'accessing' stamp: 'IgorStasenko 9/2/2012 00:31'!
at: anObject ifAbsentPut: aBlock

	^ cache at: anObject  ifAbsentPut: aBlock! !

!CairoBackendCache methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/3/2013 13:25'!
for: anObject at: key ifAbsentPut: aBlock

	| subCache |
	subCache := cache 
		at: anObject
		ifAbsentPut: [ WeakIdentityKeyDictionary new ].

	^ subCache at: key ifAbsentPut: aBlock! !

!CairoBackendCache methodsFor: 'initialize-release' stamp: 'BenjaminVanRyseghem 7/3/2013 13:26'!
initialize

	self flush! !

!CairoBackendCache methodsFor: 'removing' stamp: 'IgorStasenko 10/12/2012 03:54'!
removeAt: anObject

	^ cache removeKey: anObject  ifAbsent: nil! !

!CairoBackendCache methodsFor: 'accessing' stamp: 'IgorStasenko 9/2/2012 19:15'!
at: anObject 

	^ cache at: anObject  ifAbsent: nil! !

!CairoBackendCache methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/3/2013 13:26'!
flush

	cache := WeakIdentityKeyDictionary new! !

!CairoBackendCache methodsFor: 'initialize-release' stamp: 'IgorStasenko 9/2/2012 01:54'!
nbSessionChanged

	self initialize.
	! !

!CairoBackendCache class methodsFor: 'accessing' stamp: 'IgorStasenko 9/1/2012 23:55'!
soleInstance
	^ soleInstance! !

!CairoBackendCache class methodsFor: 'class initialization' stamp: 'IgorStasenko 9/2/2012 01:57'!
initialize
	"self initialize "	
	soleInstance ifNotNil: [ NativeBoost announcer unsubscribe: soleInstance. soleInstance initialize ]. 
	soleInstance := self new.
	"be notified about session change"
	NativeBoost notifyAboutSessionChange: soleInstance! !

!CairoBackendCache class methodsFor: 'flushing' stamp: 'IgorStasenko 8/12/2013 16:20'!
flush
	self soleInstance flush! !

!CairoFontExtents commentStamp: '<historical>'!
I represent the
cairo_font_extents_t structure type

The cairo_font_extents_t structure stores metric information for a font. Values are given in the current user-space coordinate system.

Because font metrics are in user-space coordinates, they are mostly, but not entirely, independent of the current transformation matrix. If you call cairo_scale(cr, 2.0, 2.0), text will be drawn twice as big, but the reported text extents will not be doubled. They will change slightly due to hinting (so you can't assume that metrics are independent of the transformation matrix), but otherwise will remain unchanged.

double ascent;
	the distance that the font extends above the baseline. Note that this is not always exactly equal to the maximum of the extents of all the glyphs in the font, but rather is picked to express the font designer's intent as to how the font should align with elements above it.

double descent;
	the distance that the font extends below the baseline. This value is positive for typical fonts that include portions below the baseline. Note that this is not always exactly equal to the maximum of the extents of all the glyphs in the font, but rather is picked to express the font designer's intent as to how the font should align with elements below it.

double height;
	the recommended vertical distance between baselines when setting consecutive lines of text with the font. This is greater than ascent+descent by a quantity known as the line spacing or external leading. When space is at a premium, most fonts can be set with only a distance of ascent+descent between lines.

double max_x_advance;
	the maximum distance in the X direction that the origin is advanced for any glyph in the font.

double max_y_advance;
	the maximum distance in the Y direction that the origin is advanced for any glyph in the font. This will be zero for normal fonts used for horizontal writing. (The scripts of East Asia are sometimes written vertically.)!
!CairoFontExtents class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 6/11/2012 06:56'!
fieldsDesc 

	^ #(
	double ascent;
	double descent;
	double height;
	double max_x_advance;
	double max_y_advance;
	)! !

!CairoFontFace commentStamp: '<historical>'!
I am a private class, used to represent a 'cairo_font_face_t *' data structure 
of Cairo library.

I am not useful for direct use nor providing any functionality. My only purpose is to keep a strong reference to original FT2Face object
(so it won't be freed before a corresponding instance of mine will release it).

!
!CairoFontFace methodsFor: 'external resource management' stamp: 'IgorStasenko 6/11/2012 06:00'!
resourceData 
	^ handle value! !

!CairoFontFace methodsFor: 'initialize-release' stamp: 'IgorStasenko 6/11/2012 06:00'!
initialize 
	
	self registerAsExternalResource ! !

!CairoFontFace methodsFor: 'accessing' stamp: 'IgorStasenko 6/11/2012 06:29'!
status
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #(int cairo_font_face_status (self))
		! !

!CairoFontFace methodsFor: 'initialize-release' stamp: 'IgorStasenko 8/28/2012 11:54'!
initializeWithFreetypeFace: aFace
	ftFace := aFace.
	
	self registerAsExternalResource.! !

!CairoFontFace methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ self class nbLibraryNameOrHandle
! !

!CairoFontFace class methodsFor: 'instance creation' stamp: 'SeanDeNigris 4/3/2014 17:50'!
fromFreetypeFace: aFace
	| handle cairoFace |
	
	handle := aFace handle nbUlongAt: 1.
	cairoFace := self primFtFace: handle loadFlags: ( LoadNoHinting | LoadTargetLCD | LoadNoAutohint | LoadNoBitmap). 
	
	^ cairoFace initializeWithFreetypeFace: aFace! !

!CairoFontFace class methodsFor: 'finalizing' stamp: 'IgorStasenko 6/11/2012 06:03'!
finalizeResourceData: handle

"
void                cairo_font_face_destroy             (cairo_font_face_t *font_face);
"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #( void cairo_font_face_destroy (size_t handle)) ! !

!CairoFontFace class methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ CairoLibraryLoader getLibraryHandle! !

!CairoFontFace class methodsFor: 'instance creation' stamp: 'IgorStasenko 6/11/2012 05:30'!
primFtFace: aFace loadFlags: flags

"
cairo_font_face_t * cairo_ft_font_face_create_for_ft_face
                                                        (FT_Face face,
                                                         int load_flags);
"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #( CairoFontFace cairo_ft_font_face_create_for_ft_face(uint aFace , int flags )) ! !

!CairoFontMetricsProvider commentStamp: 'TorstenBergmann 2/12/2014 22:22'!
Provide font metrics (Cairo)!
!CairoFontMetricsProvider methodsFor: 'accessing' stamp: 'SeanDeNigris 4/3/2014 16:11'!
font: aFont
	font := aFont asFreetypeFont.
	cairoFont :=	CairoScaledFont fromFreetypeFont: font.
	extents := cairoFont extents.! !

!CairoFontMetricsProvider methodsFor: 'initialization' stamp: 'IgorStasenko 8/22/2013 14:22'!
initialize
	utfConverter := CairoUTF8Converter new.
	glyphExtents := CairoTextExtents new.
	cache := CairoBackendCache soleInstance.! !

!CairoFontMetricsProvider methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ self class nbLibraryNameOrHandle
! !

!CairoFontMetricsProvider methodsFor: 'accessing' stamp: 'SeanDeNigris 4/4/2014 13:20'!
fontHeight
	^ extents height ! !

!CairoFontMetricsProvider methodsFor: '*TxText-Athens' stamp: 'SeanDeNigris 4/4/2014 14:53'!
newCharacterSpanDisplayCommand: span start: startPos stop: stopPos advance: aPoint

	^ TxCairoCharacterSpanDisplayCommand new 
			span: span start: startPos stop: stopPos;
			advance: aPoint;
			yourself! !

!CairoFontMetricsProvider methodsFor: 'accessing' stamp: 'IgorStasenko 4/8/2014 15:23'!
getGlyphWidth: aCharacter
	cairoFont getExtentsOf: (utfConverter convertChar: aCharacter) into: glyphExtents.
	^ glyphExtents x_advance! !

!CairoFontMetricsProvider methodsFor: '*TxText-Athens' stamp: 'IgorStasenko 8/7/2014 15:00'!
newTabDisplayCommand: span start: startPos stop: stopPos advance: aPoint 

	^ TxTabDisplayCommand new 
		span: span start: startPos stop: stopPos;
		advance: aPoint;
		yourself! !

!CairoFontMetricsProvider methodsFor: 'accessing' stamp: 'IgorStasenko 8/22/2013 13:25'!
fontAscent
	^ extents ascent! !

!CairoFontMetricsProvider methodsFor: '*TxText-Athens' stamp: 'IgorStasenko 8/21/2014 12:37'!
newEmbeddedObjectCommand: anEmbeddedObjectSpan 

	^ TxEmbeddedObjectCommand new 
		span: anEmbeddedObjectSpan;
		yourself! !

!CairoFontMetricsProvider class methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ CairoLibraryLoader getLibraryHandle! !

!CairoFontOptions commentStamp: '<historical>'!
i represent various font options exposed by cairo library!
!CairoFontOptions methodsFor: 'hint options' stamp: 'IgorStasenko 10/11/2013 18:34'!
hintMetricsOn
	^ self setHintMetrics: CAIRO_HINT_METRICS_ON! !

!CairoFontOptions methodsFor: 'defaults' stamp: 'IgorStasenko 10/23/2013 02:37'!
setDefaults

	self hintStyleSlight; hintMetricsOff; subpixelOrderRGB; aaSubpixel! !

!CairoFontOptions methodsFor: 'antialiasing' stamp: 'IgorStasenko 9/2/2012 01:28'!
aaBest

	^ self setAA: CAIRO_ANTIALIAS_BEST.! !

!CairoFontOptions methodsFor: 'initialize-release' stamp: 'IgorStasenko 8/28/2012 12:07'!
resourceData

	^ handle value! !

!CairoFontOptions methodsFor: 'antialiasing' stamp: 'IgorStasenko 9/2/2012 01:28'!
aaFast

	^ self setAA: CAIRO_ANTIALIAS_FAST.! !

!CairoFontOptions methodsFor: 'hint options' stamp: 'IgorStasenko 10/11/2013 18:34'!
hintMetricsDefault
	^ self setHintMetrics: CAIRO_HINT_METRICS_DEFAULT! !

!CairoFontOptions methodsFor: 'subpixel order' stamp: 'IgorStasenko 9/2/2012 19:50'!
setSubpixelOrder: order
	"void cairo_font_options_set_subpixel_order
		(cairo_font_options_t *options,
		cairo_subpixel_order_t subpixel_order)"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #(
		void cairo_font_options_set_subpixel_order (self, uint order))
 ! !

!CairoFontOptions methodsFor: 'subpixel order' stamp: 'IgorStasenko 9/2/2012 19:25'!
subpixelOrderDefault
	^ self setSubpixelOrder: CAIRO_SUBPIXEL_ORDER_DEFAULT! !

!CairoFontOptions methodsFor: 'initialize-release' stamp: 'IgorStasenko 9/2/2012 01:16'!
initialize 
	self registerAsExternalResource.
	self setDefaults! !

!CairoFontOptions methodsFor: 'subpixel order' stamp: 'IgorStasenko 9/2/2012 19:25'!
subpixelOrderRGB
	^ self setSubpixelOrder: CAIRO_SUBPIXEL_ORDER_RGB! !

!CairoFontOptions methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ self class nbLibraryNameOrHandle
! !

!CairoFontOptions methodsFor: 'antialiasing' stamp: 'IgorStasenko 9/2/2012 01:27'!
aaNone

	^ self setAA: CAIRO_ANTIALIAS_NONE.! !

!CairoFontOptions methodsFor: 'antialiasing' stamp: 'IgorStasenko 9/2/2012 01:29'!
setAA: antialias

"cairo_font_options_set_antialias ()

void                cairo_font_options_set_antialias    (cairo_font_options_t *options,
                                                         cairo_antialias_t antialias);

Sets the antialiasing mode for the font options object. This specifies the type of antialiasing to do when rendering text.

options :
	a cairo_font_options_t

antialias :
	the new antialiasing mode"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #( 
	void cairo_font_options_set_antialias (self, uint antialias))
! !

!CairoFontOptions methodsFor: 'hint options' stamp: 'IgorStasenko 10/11/2013 18:31'!
setHintMetrics: hintMetrics
"
	void	cairo_font_options_set_hint_metrics (cairo_font_options_t *options,
		cairo_hint_metrics_t hint_metrics);

 Sets the metrics hinting mode for the font options object. This controls whether metrics are quantized to integer values in device units. See the documentation for cairo_hint_metrics_t for full details.

"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #(void cairo_font_options_set_hint_metrics (self,  uint hintMetrics))

 ! !

!CairoFontOptions methodsFor: 'antialiasing' stamp: 'IgorStasenko 9/2/2012 01:28'!
aaGood

	^ self setAA: CAIRO_ANTIALIAS_GOOD.! !

!CairoFontOptions methodsFor: 'antialiasing' stamp: 'IgorStasenko 9/2/2012 01:27'!
aaGray

	^ self setAA: CAIRO_ANTIALIAS_GRAY.! !

!CairoFontOptions methodsFor: 'hint options' stamp: 'IgorStasenko 9/2/2012 01:14'!
setHintStyle: aStyle
	"cairo_font_options_set_hint_style ()

void                cairo_font_options_set_hint_style   (cairo_font_options_t *options,
                                                         cairo_hint_style_t hint_style);

Sets the hint style for font outlines for the font options object. This controls whether to fit font outlines to the pixel grid, and if so, whether to optimize for fidelity or contrast. See the documentation for cairo_hint_style_t for full details. "
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #( 
		void cairo_font_options_set_hint_style (self, uint aStyle))

 ! !

!CairoFontOptions methodsFor: 'hint options' stamp: 'IgorStasenko 9/2/2012 01:16'!
hintStyleFull
	^ self setHintStyle: CAIRO_HINT_STYLE_FULL! !

!CairoFontOptions methodsFor: 'hint options' stamp: 'IgorStasenko 9/2/2012 01:15'!
hintStyleSlight
	^ self setHintStyle: CAIRO_HINT_STYLE_SLIGHT! !

!CairoFontOptions methodsFor: 'subpixel order' stamp: 'IgorStasenko 9/2/2012 19:26'!
subpixelOrderVRGB
	^ self setSubpixelOrder: CAIRO_SUBPIXEL_ORDER_VRGB! !

!CairoFontOptions methodsFor: 'antialiasing' stamp: 'IgorStasenko 9/2/2012 01:27'!
aaDefault

	^ self setAA: CAIRO_ANTIALIAS_DEFAULT.! !

!CairoFontOptions methodsFor: 'subpixel order' stamp: 'IgorStasenko 9/2/2012 19:26'!
subpixelOrderVBGR
	^ self setSubpixelOrder: CAIRO_SUBPIXEL_ORDER_VBGR! !

!CairoFontOptions methodsFor: 'antialiasing' stamp: 'IgorStasenko 9/2/2012 01:28'!
aaSubpixel

	^ self setAA: CAIRO_ANTIALIAS_SUBPIXEL.! !

!CairoFontOptions methodsFor: 'hint options' stamp: 'IgorStasenko 10/11/2013 18:34'!
hintMetricsOff
	^ self setHintMetrics: CAIRO_HINT_METRICS_OFF! !

!CairoFontOptions methodsFor: 'subpixel order' stamp: 'IgorStasenko 9/2/2012 19:26'!
subpixelOrderBGR
	^ self setSubpixelOrder: CAIRO_SUBPIXEL_ORDER_BGR! !

!CairoFontOptions methodsFor: 'hint options' stamp: 'IgorStasenko 9/2/2012 01:15'!
hintStyleNone
	^ self setHintStyle: CAIRO_HINT_STYLE_NONE! !

!CairoFontOptions methodsFor: 'hint options' stamp: 'IgorStasenko 9/2/2012 01:15'!
hintStyleDefault
	^ self setHintStyle: CAIRO_HINT_STYLE_DEFAULT! !

!CairoFontOptions methodsFor: 'hint options' stamp: 'IgorStasenko 9/2/2012 01:15'!
hintStyleMedium
	^ self setHintStyle: CAIRO_HINT_STYLE_MEDIUM! !

!CairoFontOptions class methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ CairoLibraryLoader getLibraryHandle! !

!CairoFontOptions class methodsFor: 'instance creation' stamp: 'IgorStasenko 8/28/2012 12:06'!
new
	^ self primCreate initialize! !

!CairoFontOptions class methodsFor: 'finalizing' stamp: 'IgorStasenko 8/28/2012 12:11'!
finalizeResourceData: aData
	"finalize the external resource data, returned by #resourceData on instance side"
	
	self primDestroy: aData! !

!CairoFontOptions class methodsFor: 'private' stamp: 'IgorStasenko 8/28/2012 12:09'!
primDestroy: anOptions
"void                cairo_font_options_destroy          (cairo_font_options_t *options);

Destroys a cairo_font_options_t object created with cairo_font_options_create() or cairo_font_options_copy().

options :
	a cairo_font_options_t"

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #(void cairo_font_options_destroy (size_t anOptions))! !

!CairoFontOptions class methodsFor: 'private' stamp: 'IgorStasenko 8/28/2012 12:05'!
primCreate
"cairo_font_options_t * cairo_font_options_create        (void);

Allocates a new font options object with all options initialized to default values.

Returns :
	a newly allocated cairo_font_options_t. Free with cairo_font_options_destroy(). This function always returns a valid pointer; if memory cannot be allocated, then a special error object is returned where all operations on the object do nothing. You can check for this with cairo_font_options_status().

"	
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #(CairoFontOptions cairo_font_options_create ())! !

!CairoFreetypeFontRenderer commentStamp: 'SeanDeNigris 4/4/2014 13:33'!
I am used to render freetype font(s) with cairo library.

Before start rendering, you must set:
 - canvas
 - font
!
!CairoFreetypeFontRenderer methodsFor: 'accessing' stamp: 'IgorStasenko 9/1/2012 21:29'!
advance
	^ advance! !

!CairoFreetypeFontRenderer methodsFor: 'private' stamp: 'IgorStasenko 4/7/2014 18:08'!
convertString: utf8String len: strlen ofFont: aScaledFont toGlyphs: glyphs numGlyphs: numGlyphs x: x y: y
"
all of this for using 
http://www.cairographics.org/manual/cairo-User-Fonts.html#cairo-user-scaled-font-text-to-glyphs-func-t

"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self nbCall: #(
		cairo_status_t cairo_scaled_font_text_to_glyphs (CairoScaledFont aScaledFont,
			double x,
			double y,
			void * utf8String,
			int strlen,
			NBExternalAddress * glyphs,
			int * numGlyphs,
			0,
			0,
			0))! !

!CairoFreetypeFontRenderer methodsFor: 'private' stamp: 'IgorStasenko 8/19/2013 15:30'!
freeGlyphs: glyphs
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self nbCall: #( void cairo_glyph_free (void *glyphs))! !

!CairoFreetypeFontRenderer methodsFor: 'accessing - font metrics' stamp: 'IgorStasenko 9/6/2013 12:51'!
getGlyphWidth: aCharacter
	utfConverter convert: aCharacter asString from: 1 to: 1.
	font getExtentsOf: utfConverter buffer into: glyphExtents.
	^ glyphExtents x_advance! !

!CairoFreetypeFontRenderer methodsFor: 'accessing - font metrics' stamp: 'IgorStasenko 4/8/2014 16:11'!
glyphsOf: aString from: start to: end
	| len glyphs ptr lenValue glyphsSize utf8Len error |

	len := end-start+1.
	utf8Len := utfConverter convert: aString from: start to: end.

	ptr := NBExternalAddress new.
	
	lenValue := ByteArray new: 4.
	lenValue nbUInt32AtOffset: 0 put: len.
			
	error := self convertString: utfConverter buffer len: utf8Len
		ofFont: font toGlyphs: ptr numGlyphs: lenValue x: 0.0 y: 0.0 .
		
	error = CAIRO_STATUS_SUCCESS ifFalse: [  ^ CairoGlyphsArray new: 0 ].

	glyphsSize := lenValue nbUInt32AtOffset: 0.

	glyphs := CairoGlyphsArray new: glyphsSize.

	NativeBoost memCopy: ptr to:  glyphs address size: (glyphsSize * CairoGlyphsArray elementSize).
	self freeGlyphs: ptr.

	^ glyphs
	! !

!CairoFreetypeFontRenderer methodsFor: 'accessing - font metrics' stamp: 'IgorStasenko 9/6/2013 12:50'!
fontAscent
	^ fontExtents ascent! !

!CairoFreetypeFontRenderer methodsFor: 'accessing' stamp: 'SeanDeNigris 4/3/2014 16:10'!
font: aFreetypeFont 

	font := CairoScaledFont fromFreetypeFont: aFreetypeFont.
	fontExtents := font extents.
	originalFont := aFreetypeFont.
! !

!CairoFreetypeFontRenderer methodsFor: 'rendering' stamp: 'SeanDeNigris 4/4/2014 14:59'!
renderCharacters: aString from: start to: end

	| glyphs |

	glyphs := self glyphsOf: aString from: start to: end.
	self renderGlyphs: glyphs.
! !

!CairoFreetypeFontRenderer methodsFor: 'accessing' stamp: 'IgorStasenko 9/2/2012 00:24'!
canvas: aCairoCanvas
	
	canvas := aCairoCanvas.! !

!CairoFreetypeFontRenderer methodsFor: 'accessing' stamp: 'IgorStasenko 9/1/2012 21:30'!
advance: aPoint 
	advance := aPoint! !

!CairoFreetypeFontRenderer methodsFor: 'initialize' stamp: 'IgorStasenko 9/6/2013 12:52'!
initialize 
	utfConverter := CairoUTF8Converter new.
	advance := 0@0.
	cache := CairoBackendCache soleInstance.
	glyphExtents := CairoTextExtents new.! !

!CairoFreetypeFontRenderer methodsFor: 'rendering' stamp: 'SeanDeNigris 4/4/2014 13:28'!
renderGlyphs: cairoGlyphs

	font lock.
	canvas 
		setPathMatrix;
		setScaledFont: font.
	canvas paint loadOnCairoCanvas: canvas.

	canvas showGlyphs: cairoGlyphs address size: cairoGlyphs size.
	font unlock.

	
! !

!CairoFreetypeFontRenderer methodsFor: 'rendering' stamp: 'IgorStasenko 8/30/2012 18:27'!
render: aString

	^ self renderCharacters: aString from: 1 to: aString size! !

!CairoFreetypeFontRenderer methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ self class nbLibraryNameOrHandle
! !

!CairoFreetypeFontRenderer methodsFor: 'accessing - font metrics' stamp: 'SeanDeNigris 4/3/2014 15:36'!
fontHeight
	^ fontExtents height! !

!CairoFreetypeFontRenderer methodsFor: 'accessing' stamp: 'IgorStasenko 9/2/2012 01:43'!
setColor: aColor 
	(canvas setPaint: aColor )! !

!CairoFreetypeFontRenderer class methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ CairoLibraryLoader getLibraryHandle! !

!CairoGlyph commentStamp: '<historical>'!
i correspond to cairo_glyph_t structure:

typedef struct {
    unsigned long        index;
    double               x;
    double               y;
} cairo_glyph_t;!
!CairoGlyph methodsFor: '*generated-code-non-existing-package' stamp: 'NativeBoost 2/4/2014 13:23'!
y
	"This method was automatically generated"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self fieldAt: #y! !

!CairoGlyph methodsFor: '*generated-code-non-existing-package' stamp: 'NativeBoost 2/4/2014 13:23'!
x: anObject
	"This method was automatically generated"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self fieldAt: #x put: anObject! !

!CairoGlyph methodsFor: '*generated-code-non-existing-package' stamp: 'NativeBoost 2/4/2014 13:23'!
x
	"This method was automatically generated"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self fieldAt: #x! !

!CairoGlyph methodsFor: '*generated-code-non-existing-package' stamp: 'NativeBoost 2/4/2014 13:23'!
y: anObject
	"This method was automatically generated"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self fieldAt: #y put: anObject! !

!CairoGlyph methodsFor: '*generated-code-non-existing-package' stamp: 'NativeBoost 2/4/2014 13:23'!
index: anObject
	"This method was automatically generated"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self fieldAt: #index put: anObject! !

!CairoGlyph methodsFor: '*generated-code-non-existing-package' stamp: 'NativeBoost 2/4/2014 13:23'!
index
	"This method was automatically generated"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self fieldAt: #index! !

!CairoGlyph class methodsFor: 'fields description' stamp: 'IgorStasenko 8/14/2013 16:19'!
fieldsDesc
	^ #(
	ulong        index;
	double               x;
	double               y;
	)! !

!CairoGlyph class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 3/31/2014 16:17'!
byteAlignment
	NativeBoost platformId = NativeBoostConstants win32PlatformId ifTrue: [  ^ 8 ].
	^ super byteAlignment! !

!CairoGlyphsArray commentStamp: '<historical>'!
Captain obvious tells this is an array of CairoGlyph(s),
corresponds to cairo_glyph_t structure:

typedef struct {
    unsigned long        index;
    double               x;
    double               y;
} cairo_glyph_t;!
!CairoGlyphsArray methodsFor: 'accessing' stamp: 'IgorStasenko 8/19/2013 15:39'!
allocatedByCairo: aBoolean
	allocatedByCairo := aBoolean! !

!CairoGlyphsArray methodsFor: '*generated-code-non-existing-package' stamp: 'IgorStasenko 12/7/2012 16:42'!
at: index put: value
	"Set value at 1-based index.
	Note, this method used as a template for my anonymous subclasses. "
	
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self emitWrite ! !

!CairoGlyphsArray methodsFor: 'accessing' stamp: 'IgorStasenko 8/19/2013 15:38'!
allocatedByCairo
	^ allocatedByCairo ! !

!CairoGlyphsArray methodsFor: '*generated-code-non-existing-package' stamp: 'IgorStasenko 12/7/2012 16:42'!
at: index
	"Answer an element using 1-based index.
	Note, this method used as a template for my anonymous subclasses. "
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self emitRead! !

!CairoGlyphsArray class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/14/2013 16:28'!
initialize
	self initElementType: #CairoGlyph! !

!CairoLibraryLoader commentStamp: '<historical>'!
i am a service class, which responsible to finding and loading cairo dynamic library!
!CairoLibraryLoader class methodsFor: 'public' stamp: 'IgorStasenko 6/10/2012 05:46'!
getLibraryHandle

	(NativeBoost sessionChanged: session) ifTrue: [
		libHandle := self loadCairoLibrary.
		session := NativeBoost uniqueSessionObject.
	].

	^ libHandle
	! !

!CairoLibraryLoader class methodsFor: 'linux' stamp: 'IgorStasenko 7/29/2013 10:41'!
pathToCairoOnLinux
	"On different flavors of linux the path to library may differ
	depending on OS distro or whether system is 32 or 64 bit.
	
	"
	#( 
		'/usr/lib/i386-linux-gnu/libcairo.so.2'
		'/usr/lib32/libcairo.so.2'
		'/usr/lib/libcairo.so.2'
		
	) do: [ :path |
		
		path asFileReference exists ifTrue: [  ^ path ]
	].

	^ self cantFindCairoOnLinux

	! !

!CairoLibraryLoader class methodsFor: 'private' stamp: 'IgorStasenko 4/16/2013 15:50'!
getLibraryPath

	(NativeBoost platformId = NativeBoostConstants linux32PlatformId) ifTrue: [
		^ self pathToCairoOnLinux.
	].
	(NativeBoost platformId = NativeBoostConstants mac32PlatformId) ifTrue: [
		^ 'libcairo.2.dylib'
	].
	(NativeBoost platformId = NativeBoostConstants win32PlatformId) ifTrue: [
		^ 'libcairo-2.dll'
	].
	self error: 'define your own path'

! !

!CairoLibraryLoader class methodsFor: 'private' stamp: 'IgorStasenko 6/10/2012 05:42'!
loadCairoLibrary 
	^ NativeBoost forCurrentPlatform loadModule: self getLibraryPath
! !

!CairoLibraryLoader class methodsFor: 'linux' stamp: 'IgorStasenko 4/16/2013 15:56'!
cantFindCairoOnLinux
	"
	Cog VM is a 32-bit process, and therefore won't link with 64-bit libraries on 64-bit OS.
	In case if you have problems with cairo library on linux system, try following:
	
	Installing 32-bit version of Cairo library.
	
	for Fedora it is:
		$ yum install cairo.i686
		/usr/lib/libcairo.so.2
	for Ubuntu:
		$ sudo apt-get install libcairo2:i386
		/usr/lib/i386-linux-gnu/libcairo.so.2

	If library is installed try to locate it and add path to it to #pathToCairoOnLinux method.
	
	"
	
	self error: 'Cannot locate cairo library. Please check if it installed on your system'! !

!CairoPNGPaint commentStamp: '<historical>'!
I am a surface paint with lazy initialization scheme, that i loading image from .png file
the first time i will be used.

<Do not use me, because i am really Cairo specific>!
!CairoPNGPaint methodsFor: 'converting' stamp: 'IgorStasenko 4/12/2013 09:09'!
asAthensPaintOn: anAthensCanvas

	| surface |

	 surface := AthensCairoSurface createFromFile: fileName ifFailed: [ :status | 

		status =  CAIRO_STATUS_READ_ERROR ifTrue: [ 
			self error: 'Cairo couldnt read the file named ', fileName ].
		status = CAIRO_STATUS_FILE_NOT_FOUND ifTrue: [
			self error: 'Cairo cant find the file named ', fileName ].

		^ self error: 'Cannot create surface. Cairo status code: ', status asString 
	].
	
	^ surface asAthensPaintOn: anAthensCanvas.
 ! !

!CairoPNGPaint methodsFor: 'initialize-release' stamp: 'FernandoOlivero 1/12/2012 12:47'!
initializeOnFileNamed: aFileName
	fileName := aFileName.! !

!CairoPNGPaint class methodsFor: 'as yet unclassified' stamp: 'FernandoOlivero 1/12/2012 12:47'!
fileNamed: aFileName
	| image|
	image := self new.
	image initializeOnFileNamed: aFileName.
	^ image! !

!CairoScaledFont commentStamp: '<historical>'!
my instances map to
cairo_scaled_font_t * 
data type!
!CairoScaledFont methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 9/1/2012 23:33'!
lock

"
FT_Face             cairo_ft_scaled_font_lock_face      (cairo_scaled_font_t *scaled_font);

"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #( 
		void cairo_ft_scaled_font_lock_face (self)) ! !

!CairoScaledFont methodsFor: 'initialize-release' stamp: 'IgorStasenko 8/28/2012 12:34'!
initialize 

	self status ~= CAIRO_STATUS_SUCCESS ifTrue: [ self error: 'Something is wrong!!' ].
		
	self registerAsExternalResource ! !

!CairoScaledFont methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ self class nbLibraryNameOrHandle
! !

!CairoScaledFont methodsFor: 'accessing' stamp: 'IgorStasenko 8/28/2012 11:26'!
extents
	| extents |
	extents := CairoFontExtents new.

	self getExtents: extents.
	
	^ extents! !

!CairoScaledFont methodsFor: 'external resource management' stamp: 'IgorStasenko 6/11/2012 06:49'!
resourceData 
	^ handle value! !

!CairoScaledFont methodsFor: 'accessing' stamp: 'IgorStasenko 6/11/2012 06:51'!
status
"cairo_status_t      cairo_scaled_font_status            (cairo_scaled_font_t *scaled_font);"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #(int cairo_scaled_font_status (self))
		! !

!CairoScaledFont methodsFor: 'accessing' stamp: 'IgorStasenko 6/11/2012 06:58'!
getExtents: cairoFontExtents
	"void                cairo_scaled_font_extents           (cairo_scaled_font_t *scaled_font,
                                                         cairo_font_extents_t *extents);
	"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #(int cairo_scaled_font_extents (self, CairoFontExtents * cairoFontExtents ))
		! !

!CairoScaledFont methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 9/1/2012 23:33'!
unlock

"
FT_Face             cairo_ft_scaled_font_lock_face      (cairo_scaled_font_t *scaled_font);

"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #( 
		void cairo_ft_scaled_font_unlock_face  (self)) ! !

!CairoScaledFont methodsFor: 'accessing' stamp: 'IgorStasenko 8/22/2013 12:14'!
getExtentsOf: utf8String into: extentObj 
	"void                cairo_scaled_font_extents           (cairo_scaled_font_t *scaled_font,
                                                         cairo_font_extents_t *extents);
	"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #(
		void cairo_scaled_font_text_extents (self,
			void *utf8String,
			cairo_text_extents_t * extentObj))
		! !

!CairoScaledFont methodsFor: 'initialize-release' stamp: 'IgorStasenko 8/28/2012 12:28'!
initWithFace: cairo_face

	face := cairo_face.
	
	self registerAsExternalResource.! !

!CairoScaledFont class methodsFor: 'private' stamp: 'IgorStasenko 8/28/2012 12:18'!
primCreate: face fontMatrix: fontMatrix userToDeviceMatrix: ctm options: options
"
cairo_scaled_font_t * cairo_scaled_font_create          (cairo_font_face_t *font_face,
                                                         const cairo_matrix_t *font_matrix,
                                                         const cairo_matrix_t *ctm,
                                                         const cairo_font_options_t *options);


 Creates a cairo_scaled_font_t object from a font face and matrices that describe the size of the font and the environment in which it will be used.

font_face :
	a cairo_font_face_t

font_matrix :
	font space to user space transformation matrix for the font. In the simplest case of a N point font, this matrix is just a scale by N, but it can also be used to shear the font or stretch it unequally along the two axes. See cairo_set_font_matrix().

ctm :
	user to device transformation matrix with which the font will be used.

options :
	options to use when getting metrics for the font and rendering with it.

Returns :
	a newly created cairo_scaled_font_t. Destroy with cairo_scaled_font_destroy()
"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #( 
		CairoScaledFont cairo_scaled_font_create (
			CairoFontFace face,
			AthensCairoMatrix * fontMatrix,
			AthensCairoMatrix * ctm,
			CairoFontOptions  options ) )
 ! !

!CairoScaledFont class methodsFor: 'instance creation' stamp: 'SeanDeNigris 4/4/2014 02:51'!
fromFreetypeFont: aFont cairoFace: face

	| options fontMatrix deviceMatrix font |

	options := CairoBackendCache soleInstance 
		at: #AAOptions ifAbsentPut: [ CairoFontOptions new ].
	fontMatrix := AthensCairoMatrix new.
	deviceMatrix := AthensCairoMatrix new.

	fontMatrix scaleBy: (TextStyle pointsToPixels: aFont pointSize).
	
	font := self primCreate: face fontMatrix: fontMatrix  userToDeviceMatrix: deviceMatrix options: options. 
	
	"to keep a reference to cairo face in instance"
	^ font initWithFace: face.
	
! !

!CairoScaledFont class methodsFor: 'instance creation' stamp: 'SeanDeNigris 4/3/2014 16:09'!
fromFreetypeFont: aFont 
	|  ftFace face |
	^ CairoBackendCache soleInstance at: aFont ifAbsentPut: [
			ftFace := aFont face.
			face := CairoBackendCache soleInstance at: ftFace ifAbsentPut: [
				CairoFontFace fromFreetypeFace: ftFace
			]. 
		self fromFreetypeFont: aFont  cairoFace: face
	].
! !

!CairoScaledFont class methodsFor: 'finalizing' stamp: 'IgorStasenko 6/11/2012 06:50'!
finalizeResourceData: handle

"
void                cairo_scaled_font_destroy           (cairo_scaled_font_t *scaled_font);
"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCall: #( void  cairo_scaled_font_destroy (size_t handle) )! !

!CairoScaledFont class methodsFor: 'library path' stamp: ''!
nbLibraryNameOrHandle
	^ CairoLibraryLoader getLibraryHandle! !

!CairoTextExtents commentStamp: '<historical>'!
I represent the
cairo_text_extents_t
structure type

The cairo_text_extents_t structure stores the extents of a single glyph or a string of glyphs in user-space coordinates. Because text extents are in user-space coordinates, they are mostly, but not entirely, independent of the current transformation matrix. If you call cairo_scale(cr, 2.0, 2.0), text will be drawn twice as big, but the reported text extents will not be doubled. They will change slightly due to hinting (so you can't assume that metrics are independent of the transformation matrix), but otherwise will remain unchanged.

double x_bearing;
	the horizontal distance from the origin to the leftmost part of the glyphs as drawn. Positive if the glyphs lie entirely to the right of the origin.

double y_bearing;
	the vertical distance from the origin to the topmost part of the glyphs as drawn. Positive only if the glyphs lie completely below the origin; will usually be negative.

double width;
	width of the glyphs as drawn

double height;
	height of the glyphs as drawn

double x_advance;
	distance to advance in the X direction after drawing these glyphs

double y_advance;
	distance to advance in the Y direction after drawing these glyphs. Will typically be zero except for vertical text layout as found in East-Asian languages.!
!CairoTextExtents class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 6/11/2012 07:01'!
fieldsDesc 
	^ #(
	double x_bearing;
	double y_bearing;
	double width;
	double height;
	double x_advance;
	double y_advance;
	)! !

!CairoUTF8Converter commentStamp: '<historical>'!
i use persistent buffer to convert strings to utf-8 strings (an input neede by cairo)!
!CairoUTF8Converter methodsFor: 'initialize' stamp: 'IgorStasenko 4/8/2014 15:45'!
initialize
	encoder := ZnUTF8Encoder new.! !

!CairoUTF8Converter methodsFor: 'accessing' stamp: 'IgorStasenko 8/28/2012 18:03'!
buffer
	^ buffer! !

!CairoUTF8Converter methodsFor: 'not finished yet' stamp: 'ClementBera 6/28/2013 10:30'!
convertUnicode: anAsm
"
input:
- EAX  32-bit unicode value to convert
.
output:
- EAX - utf-8 encoded character (in little-endian byte order) max 4 bytes
- EDX - number of encoded bytes
"
	| moreThanOne moreThanTwo moreThanThree end |
	
	moreThanOne := anAsm uniqueLabelName: 'moreThanOne'.
	moreThanTwo := anAsm uniqueLabelName: 'moreThanTwo'.
	moreThanThree := anAsm uniqueLabelName: 'moreThanThree'.
	end := anAsm uniqueLabelName: 'end'.
	
	anAsm
		cmp:  anAsm EAX with: 16r7F;
		jg: moreThanOne;
	"one byte"
		mov: 1 to: anAsm EDX;
		jmp: end;
	label: moreThanOne;
		cmp: anAsm EAX with: 16r7FF;
	 	jg: moreThanTwo;
"two bytes 80 .. 7FF"
" 	AH 			AL 	      "
"00000aaa aabbbbbb"
	
"110aaaaa 10bbbbbb
	AL                      AH   (little endian order)
"
		shr: anAsm EAX with: 2;
		shl: anAsm AL with: 2;
		or: anAsm AX with: 2r1100000010000000;
		xchg: anAsm AL with: anAsm AH;
		mov: 2 to: anAsm EDX; 
		jmp: end;
	label: moreThanTwo;
		cmp: anAsm EAX with: 16rFFFF;
	 	jg: moreThanThree;
"three bytes 800 ... FFFF"	
" 	AH 			AL 	      "
"aaaabbbb bbcccccc"
" => 1110aaaa 10bbbbbb 10cccccc"
		shl: anAsm EAX with: 4;
		shr: anAsm AX with: 2;
		shr: anAsm AL with: 2;
	" EAX = ...aaaa xxbbbbbb xxcccccc "
		or: anAsm EAX with: 2r111000001000000010000000;  "16rE08080"	
		shl: anAsm EAX with: 8;
		bswap: anAsm EAX;
		mov: 3 to: anAsm EDX;
		jmp: end;
"four bytes 1000 ... 10FFFF"	
" 	AH 			AL 	      "
"000aaabb bbbbcccc ccdddddd"
"=> 11110aaa 10bbbbbb 10cccccc 10dddddd"		
		mov: anAsm EAX to: anAsm EDX;
		shl: anAsm EAX with: 4;
		shr: anAsm AX with: 2;
		shr: anAsm AL with: 2;
	" EAX = 0000000a aabbbbbb xxcccccc xxdddddd "
		and: anAsm EAX with: 16r3F3F3F;
		bswap: anAsm EAX;
		shr: anAsm EDX with: 18; "6*3"
		or: anAsm DL with: 16r11110000;
		mov: anAsm DL to: anAsm AL;
		mov: 4 to: anAsm EDX;
	label: end
! !

!CairoUTF8Converter methodsFor: 'not finished yet' stamp: 'IgorStasenko 6/22/2012 15:10'!
store: numBytes accumulated: accumBytes

	| toShift left |
	
	asm label: ('write', numBytes asString , 'to' , accumBytes asString) asSymbol.
	
	(accumBytes + numBytes ) > 4 
		ifTrue: [ toShift := 4 - accumBytes. left := numBytes - toShift ] 
		ifFalse: [ toShift := numBytes. left := 0 ].
	
	(accumBytes = 0 and: [numBytes = 4]) ifTrue: [
		"just store directly"
		asm mov: asm EAX to: asm EDI ptr.	
	].
	asm shrd: asm EBX with: asm EAX with: toShift * 8.
	
! !

!CairoUTF8Converter methodsFor: 'converting' stamp: 'IgorStasenko 4/8/2014 15:46'!
checkBufferSpace: minimalSize
	| size |
	
	size := buffer ifNil: [ 0 ] ifNotNil: [ buffer size ].
	
	size < minimalSize ifTrue: [
		buffer := ByteArray new: minimalSize.
		bs := buffer writeStream.
		
		]
! !

!CairoUTF8Converter methodsFor: 'converting' stamp: 'IgorStasenko 4/8/2014 15:50'!
convert: aString from: start to: end

	self checkBufferSpace: 4*(end-start + 2).
	bs reset.
	
	encoder next: end-start+1 
		putAll: aString 
		startingAt: start 
		toStream: bs .
		
	"DO NOT NULL-Terminate because its not used"

	^ bs position.! !

!CairoUTF8Converter methodsFor: 'converting' stamp: 'IgorStasenko 4/8/2014 15:48'!
convertChar: aCharacter 

	self checkBufferSpace: 8.

	bs reset.
	encoder nextPut: aCharacter toStream: bs.
	bs nextPut: 0.
	^ buffer! !

!CairoUTF8Converter methodsFor: 'not finished yet' stamp: 'IgorStasenko 6/12/2012 18:02'!
convertWideString: aWideString ! !

!CairoUTF8Converter methodsFor: 'not finished yet' stamp: 'ClementBera 6/28/2013 10:30'!
convertUnicode: anAsm conversionLabels: convLabels
"
input:
- EAX  32-bit unicode value to convert
.
output:
- EAX - utf-8 encoded character (in little-endian byte order) max 4 bytes
- EDX - number of encoded bytes
"
	|  moreThanTwo moreThanThree |
	
	moreThanTwo := anAsm uniqueLabelName: 'moreThanTwo'.
	moreThanThree := anAsm uniqueLabelName: 'moreThanThree'.
	
	anAsm
		cmp:  anAsm EAX with: 16r7F;
		jle: (convLabels at: 1); "one byte"

		cmp: anAsm EAX with: 16r7FF;
	 	jg: moreThanTwo;
"two bytes 80 .. 7FF"
" 	AH 			AL 	      "
"00000aaa aabbbbbb"
	
"110aaaaa 10bbbbbb
	AL                      AH   (little endian order)
"
		shr: anAsm EAX with: 2;
		shl: anAsm AL with: 2;
		or: anAsm AX with: 2r1100000010000000;
		xchg: anAsm AL with: anAsm AH;
		jmp: (convLabels at: 2);
	label: moreThanTwo;
		cmp: anAsm EAX with: 16rFFFF;
	 	jg: moreThanThree;
"three bytes 800 ... FFFF"	
" 	AH 			AL 	      "
"aaaabbbb bbcccccc"
" => 1110aaaa 10bbbbbb 10cccccc"
		shl: anAsm EAX with: 4;
		shr: anAsm AX with: 2;
		shr: anAsm AL with: 2;
	" EAX = ...aaaa xxbbbbbb xxcccccc "
		or: anAsm EAX with: 2r111000001000000010000000;  "16rE08080"	
		shl: anAsm EAX with: 8;
		bswap: anAsm EAX;
		jmp: (convLabels at: 3);
"four bytes 1000 ... 10FFFF"	
" 	AH 			AL 	      "
"000aaabb bbbbcccc ccdddddd"
"=> 11110aaa 10bbbbbb 10cccccc 10dddddd"		
		mov: anAsm EAX to: anAsm EDX;
		shl: anAsm EAX with: 4;
		shr: anAsm AX with: 2;
		shr: anAsm AL with: 2;
	" EAX = 0000000a aabbbbbb xxcccccc xxdddddd "
		and: anAsm EAX with: 16r3F3F3F;
		or: anAsm EAX with: 16r808080;
		bswap: anAsm EAX;
		shr: anAsm EDX with: 18; "6*3"
		or: anAsm DL with: 16r11110000;
		mov: anAsm DL to: anAsm AL;
		jmp: (convLabels at: 4)! !

!CairoUTF8Converter methodsFor: 'not finished yet' stamp: 'ClementBera 6/28/2013 10:31'!
convertByteString: aByteString 

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ NBFFICallout cdecl: #( void (void * aByteString)) emitCall: [:gen :proxy :anAsm |
		
		
		
		
		
	]! !

!CairoUTF8ConverterTest commentStamp: '<historical>'!
A CairoUTF8ConverterTest is a test class for testing the behavior of CairoUTF8Converter!
!CairoUTF8ConverterTest methodsFor: 'tests' stamp: 'IgorStasenko 4/8/2014 15:21'!
testUnicodencodingShouldTerminateWithNull
	| buf |
	buf := encoder convertChar: $a.
	
	
	self assert: (buf first:2)   equals: #[97 0 ]
! !

!CairoUTF8ConverterTest methodsFor: 'tests' stamp: 'IgorStasenko 4/8/2014 16:01'!
testEncodingString
	|  pos |

	
	pos := encoder convert: 'abc' from: 1 to: 3.
	
	self assert: pos equals: 3.
	self assert: (encoder buffer first:3)   equals: #[97 98 99]
! !

!CairoUTF8ConverterTest methodsFor: 'tests' stamp: 'IgorStasenko 4/8/2014 15:41'!
testReusingConverterShouldReplaceOldData
	| buf |
	buf := encoder convertChar: 223 asCharacter.
	
	
	self assert: (buf first:3)   equals: #[195 159 0 ].

	buf := encoder convertChar: $b.
	self assert: (buf first:2)   equals: #[98 0 ]
! !

!CairoUTF8ConverterTest methodsFor: 'running' stamp: 'IgorStasenko 4/8/2014 15:20'!
setUp
	encoder := CairoUTF8Converter new.! !

!CalendarDayMorph commentStamp: '<historical>'!
A CalendarDyaMorph represents a specific day on a monthly calendar.


Instance Variables
	bounds:		<Rectangle>
	date:		<Date>
	highlighted:	<Boolean>
	owner:		<CalendarChooserMorph>

bounds
	- owner-relative bounding box

date
	- the specific date (year/month/day) the CalendarMorph represents

highlighted
	- flag to keep track of when a CalendarMorph has the mouse dragging over it, and is thus highlighted

owner
	- the morph that contains the CalendarMorph, and all its siblings
!
!CalendarDayMorph methodsFor: 'printing' stamp: 'Jon 11/2/2011 08:39'!
debugPrint

	^(WriteStream on: (String new: 10))
		print: self class;
		nextPutAll: ' (';
		print: self date;
		nextPutAll: ' - ';
		print: self bounds;
		nextPut: $);
		contents! !

!CalendarDayMorph methodsFor: 'accessing' stamp: 'Jon 11/2/2011 21:19'!
owner

	^ owner! !

!CalendarDayMorph methodsFor: 'initialization' stamp: 'StephaneDucasse 1/27/2013 12:42'!
initialize
	super initialize.
	self highlighted: false! !

!CalendarDayMorph methodsFor: 'accessing' stamp: 'Jon 11/2/2011 21:18'!
bounds

	^ bounds! !

!CalendarDayMorph methodsFor: 'accessing' stamp: 'Jon 11/2/2011 08:51'!
highlighted: aBoolean

	highlighted := aBoolean! !

!CalendarDayMorph methodsFor: 'drawing' stamp: 'Jon 11/2/2011 09:00'!
drawOn: aCanvas offset: origin

	| box dayString textColor textTopLeft textWidth today |
	dayString := date dayOfMonth printString.
	textWidth := owner weekdayFont widthOfString: dayString.
	textTopLeft := bounds topCenter translateBy: (textWidth // -2) @ 3.
	box := ((textTopLeft extent: textWidth @ owner weekdayFont height) insetBy: -8 @ -1) translateBy: origin.
	today := date = Date today.
	textColor := date month = owner date month
		ifTrue: [Color black]
		ifFalse: [Color veryLightGray].
	(date = owner date or: [self highlighted])
		ifTrue: [
			| lineColor fillColor |
			lineColor := today
				ifTrue: [Color red]
				ifFalse: [Color veryLightGray].
			fillColor := self highlighted
				ifTrue: [Color veryVeryLightGray]
				ifFalse: [Color veryLightGray].
			aCanvas fillOval: box color: fillColor borderWidth: 1 borderColor: lineColor].
	today & (date ~= owner date) & self highlighted not
		ifTrue: [aCanvas fillOval: box color: Color white borderWidth: 1 borderColor: Color red].
	aCanvas
		drawString: dayString
		at: textTopLeft + origin
		font: owner weekdayFont
		color: textColor.! !

!CalendarDayMorph methodsFor: 'accessing' stamp: 'Jon 11/2/2011 21:18'!
bounds: aRectangle

	bounds := aRectangle! !

!CalendarDayMorph methodsFor: 'accessing' stamp: 'Jon 11/2/2011 21:18'!
date

	^ date! !

!CalendarDayMorph methodsFor: 'accessing' stamp: 'Jon 11/2/2011 08:51'!
highlighted

	^highlighted! !

!CalendarDayMorph methodsFor: 'accessing' stamp: 'Jon 11/2/2011 21:19'!
owner: aCalendarChooserMorph

	owner := aCalendarChooserMorph! !

!CalendarDayMorph methodsFor: 'printing' stamp: 'Jon 11/2/2011 08:19'!
printOn: aStream

	aStream
		print: self class;
		nextPutAll: ' (';
		print: self date;
		nextPut: $)! !

!CalendarDayMorph methodsFor: 'accessing' stamp: 'Jon 11/2/2011 21:18'!
date: aDate

	date := aDate.
! !

!CalendarDayMorph class methodsFor: 'instance creation' stamp: 'Jon 11/2/2011 08:06'!
on: aDate for: aCalendarChooserMorph

	^self new
		date: aDate;
		owner: aCalendarChooserMorph;
		yourself.
! !

!CalendarMorph commentStamp: '<historical>'!
A CalendarMorph is a standalone morph that represents a selectable monthly calendar.

CalendarMorph openOn: Date today



Instance Variables
	date:		<Date>
	days:		<OrderedCollection of: <CalendarChooserDay>>
	touchPoints:	<Dictionary key: <Rectangle> value: <Symbol>>

date
	- the currently selected date (always within the current month)

days
	- all the days that are visible, including days from the previous month, the current month, and the next month

touchPoints
	- extra hotspots that are touch-responsive (key rectangle is in world coordinates)
!
!CalendarMorph methodsFor: 'accessing' stamp: 'SeanDeNigris 1/22/2013 14:18'!
weekdayFont

	^ LogicalFont familyName: 'Bitmap DejaVu Sans' pointSize: 9.! !

!CalendarMorph methodsFor: 'event handling' stamp: 'SeanDeNigris 1/20/2013 21:18'!
mouseUp: event
	"Check for hotspot hits - handle them if they match.
	Otherwise, convert the event cursor to morph-local, and find the day under it.
	If there is nothing under the mouse when it goes up, nothing happens."

	| morphRelativeHitPoint |
	touchPoints keysAndValuesDo: [:eachBox :eachSelector |
		(eachBox containsPoint: event cursorPoint)
			ifTrue: [self perform: eachSelector]].
	morphRelativeHitPoint := event cursorPoint translateBy: bounds origin negated.
	days do: [:each |
		each highlighted: false.
		(each bounds containsPoint: morphRelativeHitPoint)
			ifTrue: [
				self date: each date.
				self announceDate ]].
	self changed.
! !

!CalendarMorph methodsFor: 'announcing' stamp: 'BernardoContreras 10/3/2014 16:48'!
onChoiceSend: aSymbol to: anObject

	self announcer when: ChoseDate send: aSymbol to: anObject.! !

!CalendarMorph methodsFor: 'event handling' stamp: 'Jon 11/2/2011 08:46'!
handlesMouseDown: event

	^true! !

!CalendarMorph methodsFor: 'accessing' stamp: 'Jon 11/2/2011 08:31'!
date: aDate

	| recompute |
	recompute := date isNil or: [date month ~= aDate month].
	date := aDate.
	recompute
		ifTrue: [self computeDays]! !

!CalendarMorph methodsFor: 'drawing' stamp: 'Jon 11/2/2011 09:14'!
drawTodayOn: aCanvas

	| text textHeight textTopLeft textWidth textBox |
	text := 'Today: ', (Date today printFormat: #(2 1 3 $  3 1 1)).
	textWidth := self weekdayFont widthOfString: text.
	textHeight := self weekdayFont height.
	textTopLeft := self bounds bottomCenter translateBy: (textWidth // -2) @ (textHeight negated - 5).
	textBox := textTopLeft extent: textWidth @ textHeight.
	touchPoints at: textBox put: #handleTodayTouched.
	aCanvas
		drawString: text
		at: textTopLeft
		font: self weekdayFont
		color: Color gray! !

!CalendarMorph methodsFor: 'initialize' stamp: 'Jon 11/3/2011 10:16'!
defaultBounds
	"Answer the default bounds for the receiver."

	^0 @ 0 corner: 200 @ 160! !

!CalendarMorph methodsFor: 'event handling' stamp: 'SeanDeNigris 1/26/2013 18:13'!
handleNextMonthTouched

	self date: date onNextMonth.
	self changed.
! !

!CalendarMorph methodsFor: 'initialization' stamp: 'Jon 11/3/2011 10:16'!
initialize

	super initialize.
	touchPoints := Dictionary new.
! !

!CalendarMorph methodsFor: 'event handling' stamp: 'SeanDeNigris 1/26/2013 18:13'!
handlePreviousMonthTouched

	self date: date onPreviousMonth.
	self changed.
! !

!CalendarMorph methodsFor: 'private' stamp: 'Jon 11/2/2011 15:20'!
daysForLine: aNumber
	"Return an array of numbers that correspond to the day-of-month numbers of the given line (row) 
	in the calendar for the month of the receiver's date."

	| dayCount firstWeekday previousDayCount previousMonthDays lastDay |
	dayCount := date month daysInMonth.
	firstWeekday := Date firstWeekdayOfMonth: date monthIndex year: date year.
	previousDayCount := date month previous daysInMonth.
	"First case - handle the first line specially"
	aNumber = 1
		ifTrue: [
			"If this month's first day is Sunday, the first line is the last week from last month"
			firstWeekday = 1
				ifTrue: [^(previousDayCount - 6 to: previousDayCount) asArray].

			"Otherwise, its a mix of last month and this month"
			previousMonthDays := (firstWeekday - 1 to: 1 by: -1) collect: [:each | previousDayCount - each + 1].
			^previousMonthDays, ((1 to: 7) asArray copyFrom: 1 to: 7 - previousMonthDays size)].

	"Recompute the last day from the previous line (I love recursion)"
	lastDay := (self daysForLine: aNumber - 1) last.
	"Second case - the first week of this month starts on Sunday"
	(aNumber = 2 and: [lastDay = previousDayCount])
		ifTrue: [^(1 to: 7) asArray].

	"Third case - the first week of next month starts on Sunday"
	lastDay = dayCount
		ifTrue: [^(1 to: 7) asArray].

	"Fourth case - everything else"
	^(lastDay + 1 to: lastDay + 7) collect: [:each |
		each <= dayCount
			ifTrue: [each]
			ifFalse: [each - dayCount]]! !

!CalendarMorph methodsFor: 'event handling' stamp: 'MarcusDenker 9/13/2013 16:18'!
handleMonthNameTouched

	| newMonthName dayCount |
	newMonthName := UIManager default 
		chooseDropList: 'Choose a month:'
		list: #('January' 'February' 'March' 'April' 'May' 'June' 'July'
			'August' 'September' 'October' 'November' 'December').

	newMonthName isNil
		ifTrue: [^self].

	dayCount := (Month year: date year month: newMonthName) daysInMonth.
	self date: (Date 
		year: date year
		month: newMonthName
		day: (date dayOfMonth min: dayCount)).
	self changed.
! !

!CalendarMorph methodsFor: 'event handling' stamp: 'Jon 11/2/2011 08:52'!
mouseMove: event

	self mouseDown: event! !

!CalendarMorph methodsFor: 'private' stamp: 'SeanDeNigris 1/20/2013 21:10'!
announcer

	^ announcer ifNil: [ announcer := Announcer new ].! !

!CalendarMorph methodsFor: 'accessing' stamp: 'Jon 11/2/2011 16:39'!
extent: aPoint
	"Since the day objects cache their bounding box, we have to recompute them if the receiver resizes."

	| result |
	result := super extent: aPoint.
	date notNil
		ifTrue: [self computeDays].
	^result! !

!CalendarMorph methodsFor: 'event handling' stamp: 'Jon 11/2/2011 09:21'!
handleTodayTouched

	self date: Date today.
	self changed.
! !

!CalendarMorph methodsFor: 'drawing' stamp: 'Jon 11/2/2011 09:16'!
drawOn: aCanvas

	touchPoints := Dictionary new.
	aCanvas
		clipBy: self bounds
		during: [:clippedCanvas |
			clippedCanvas
				fillRectangle: self bounds
				color: Color white.

			self 
				drawMonthHeaderOn: clippedCanvas;
				drawWeekDayNamesOn: clippedCanvas;
				drawDaysOn: clippedCanvas;
				drawTodayOn: aCanvas.

			clippedCanvas
				frameRectangle: self bounds
				width: 1
				color: Color black].



	! !

!CalendarMorph methodsFor: 'event handling' stamp: 'CamilloBruni 8/22/2013 19:49'!
handleYearTouched

	| newYear dayCount |
	newYear := UIManager default 
		chooseOrRequestFrom: (2000 to: 2020)
		lines: #()
		title: 'Choose a year:'.

	newYear isNil
		ifTrue: [^self].

	newYear := newYear asNumber.
	dayCount := (Month year: newYear month: date monthIndex) daysInMonth.
	self date: (Date 
			year: newYear
			month: date monthIndex 
			day: (date dayOfMonth min: dayCount)).
	self changed.! !

!CalendarMorph methodsFor: 'drawing' stamp: 'Jon 11/1/2011 21:40'!
drawWeekDayNamesOn: aCanvas

	| cellHeight height topLeft topRight cellWidth |
	topLeft := self bounds topLeft translateBy: 0 @ 25.
	topRight := self bounds topRight translateBy: 0 @ 25.
	height := self bounds height - 25.
	cellHeight := height // 8.
	cellWidth := self bounds width // 7.
	aCanvas
		line: (topLeft translateBy: 0 @ cellHeight) 
		to: (topRight translateBy: 0 @ cellHeight) 
		width: 1
		color: Color black.

	#('Sun' 'Mon' 'Tue' 'Wed' 'Thu' 'Fri' 'Sat') withIndexDo: [:dayName :dayIndex |
		| cellPosX cellTopCenter textWidth |
		cellPosX := cellWidth * (dayIndex - 1).
		cellTopCenter := topLeft translateBy: ((cellPosX + (cellWidth // 2)) + 1) @ 0.
		textWidth := self weekdayFont widthOfString: dayName.
		aCanvas
			drawString: dayName
			at: (cellTopCenter translateBy: (textWidth // -2) @ 3)
			font: self weekdayFont
			color: Color darkGray]
! !

!CalendarMorph methodsFor: 'drawing' stamp: 'Jon 11/2/2011 08:29'!
drawDaysOn: aCanvas

	days do: [:each |
		each
			drawOn: aCanvas
			offset: self bounds topLeft]! !

!CalendarMorph methodsFor: 'drawing' stamp: 'Jon 11/2/2011 15:01'!
drawMonthHeaderOn: aCanvas

	| headerWidth headerString box textBox textTopLeft monthBox monthNameWidth yearBox previousMonthBox nextMonthBox |
	headerString := date asMonth printString.
	headerWidth := self monthNameFont widthOfString: headerString.
	box := self bounds topLeft extent: self bounds width @ 23.
	textTopLeft := self bounds topCenter translateBy: (headerWidth // -2) @ 5.
	textBox := textTopLeft extent: headerWidth @ self monthNameFont height.
	monthNameWidth := self monthNameFont widthOfString: self date monthName, ' '.
	monthBox := textBox topLeft extent: monthNameWidth @ textBox height.
	yearBox := monthBox topRight corner: textBox bottomRight.
	previousMonthBox := (self bounds topLeft translateBy: 10 @ 5) extent: 10 @ self monthNameFont height.
	nextMonthBox := (self bounds topRight translateBy: -20 @ 5) extent: 10 @ self monthNameFont height.
	touchPoints
		at: monthBox put: #handleMonthNameTouched;
		at: yearBox put: #handleYearTouched;
		at: (previousMonthBox expandBy: 10 @ 5) put: #handlePreviousMonthTouched;
		at: (nextMonthBox expandBy: 10 @ 5) put: #handleNextMonthTouched.
	aCanvas
		frameAndFillRectangle: box
		fillColor: Color veryLightGray
		borderWidth: 1
		borderColor: Color black;
		
		line: box bottomLeft
		to: box bottomRight
		width: 2
		color: Color black;
		
		drawString: '<'
		at: previousMonthBox origin
		font: self monthNameFont
		color: Color black;
		
		drawString: '>'
		at: nextMonthBox origin
		font: self monthNameFont
		color: Color black;

		drawString: headerString
		at: (self bounds topCenter translateBy: (headerWidth // -2) @ 5)
		font: self monthNameFont
		color: Color black.
! !

!CalendarMorph methodsFor: 'private' stamp: 'SeanDeNigris 1/22/2013 14:57'!
computeDays
	"Populate the days instance variable with CalendarChooserDay instances for the receiver's month."

	| cellHeight cellWidth height topLeft lastMonth nextMonth theDay thisMonth |
	topLeft := 0 @ 25.
	height := self bounds height - 25.
	cellHeight := height // 8.
	height := height - cellHeight.
	cellWidth := self bounds width // 7.
	lastMonth := date month previous.
	thisMonth := date month.
	nextMonth := date month next.
	days := OrderedCollection new.
	1 to: 6 do: [:lineIndex |
		| yOffset |
		yOffset := topLeft y + (lineIndex * cellHeight).
		(self daysForLine: lineIndex) withIndexDo: [:day :dayIndex |
			| cellPosX dayDate |
			dayDate := thisMonth asDate addDays: day - 1.
			(lineIndex = 1 and: [day > 7])
				ifTrue: [dayDate := lastMonth asDate addDays: day - 1].
			(lineIndex > 4 and: [day < 15])
				ifTrue: [dayDate := nextMonth asDate addDays: day - 1].
			cellPosX := cellWidth * (dayIndex - 1).
			days add: (theDay := CalendarDayMorph on: dayDate for: self).
			theDay bounds: (cellPosX @ yOffset extent: cellWidth @ cellHeight)]]! !

!CalendarMorph methodsFor: 'private' stamp: 'SeanDeNigris 1/26/2013 17:57'!
announceDate

	| announcement |
	announcement := ChoseDate of: self date from: self.
	announcer ifNotNil: [ announcer announce: announcement ].! !

!CalendarMorph methodsFor: 'accessing' stamp: 'Jon 11/1/2011 20:57'!
date

	^date! !

!CalendarMorph methodsFor: 'accessing' stamp: 'SeanDeNigris 1/26/2013 17:56'!
monthNameFont

	| font boldItalic |
	font := LogicalFont familyName: 'Bitmap DejaVu Sans' pointSize: 12.
	boldItalic := TextEmphasis italic emphasisCode | TextEmphasis bold emphasisCode.
	^ font emphasis: boldItalic.! !

!CalendarMorph methodsFor: 'event handling' stamp: 'SeanDeNigris 1/26/2013 17:22'!
mouseDown: event
	"Handle mouse down and mouse movement. Highlight the day under the mouse."

	| morphRelativeHitPoint |
	morphRelativeHitPoint := event cursorPoint translateBy: bounds origin negated.
	days do: [:each |
		each highlighted: (each bounds containsPoint: morphRelativeHitPoint)].
	self changed.
! !

!CalendarMorph class methodsFor: 'instance creation' stamp: 'Jon 11/3/2011 09:59'!
openOn: aDate

	^(self on: aDate) openInWorld! !

!CalendarMorph class methodsFor: 'instance creation' stamp: 'Jon 11/3/2011 10:11'!
on: aDate

	^self new
		"extent: 200 @ 160;"
		date: aDate;
		yourself.
! !

!CannotDeleteFileException commentStamp: 'TorstenBergmann 2/3/2014 23:37'!
Notfify when not able to delete!
!Canvas commentStamp: '<historical>'!
A canvas is a two-dimensional medium on which morphs are drawn in a device-independent manner. Canvases keep track of the origin and clipping rectangle, as well as the underlying drawing medium (such as a window, pixmap, or postscript script).

Subclasses must implement (at least) the following methods:
	* Drawing:
		#fillOval:color:borderWidth:borderColor:
		#frameAndFillRectangle:fillColor:borderWidth:borderColor:
		#drawPolygon:color:borderWidth:borderColor:
		#image:at:sourceRect:rule:
		#stencil:at:sourceRect:rule:
		#line:to:width:color:
		#paragraph:bounds:color:
		#text:bounds:font:color:
	* Support
		#clipBy:during:
		#translateBy:during:
		#translateBy:clippingTo:during:
		#transformBy:clippingTo:during:
!
!Canvas methodsFor: 'initialization' stamp: 'ar 5/27/2000 21:50'!
finish
	"If there are any pending operations on the receiver complete them. Do not return before all modifications have taken effect."
	^self flush! !

!Canvas methodsFor: 'drawing-text' stamp: 'ar 12/31/2001 02:13'!
drawString: s in: boundsRect font: fontOrNil color: c
	^self drawString: s from: 1 to: s size in: boundsRect font: fontOrNil color: c! !

!Canvas methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 7/14/2014 06:51'!
gtInspectorFormIn: composite
	<gtInspectorPresentationOrder: 40>
	^ self form gtInspectorFormIn: composite ! !

!Canvas methodsFor: 'drawing-ovals' stamp: 'ar 6/18/1999 08:45'!
frameOval: r color: c

	self fillOval: r color: Color transparent borderWidth: 1 borderColor: c.
! !

!Canvas methodsFor: 'drawing-general' stamp: 'StephaneDucasse 2/8/2011 09:30'!
fullDrawMorph: aMorph
	"Hook method for potential other canvases. In the core, this method looks supefluous but PostscriptCanvases and other canvases can specialized it for Morph rendering. Therefore it should not be merged with fullDraw:."

	self fullDraw: aMorph! !

!Canvas methodsFor: 'accessing' stamp: ''!
depth

	^ Display depth
! !

!Canvas methodsFor: 'drawing-support' stamp: 'di 10/16/1999 16:02'!
transformBy: aDisplayTransform clippingTo: aClipRect during: aBlock
	"Transform the receiver by the given display transformation during the execution of aBlock. The given clip rectangle defines the *global* (e.g., outer) rectangle against which the receiver should clip (which would be equivalent to 'self clipRect: aClipRect; transformBy: aDisplayTransform')."
	^ self transformBy: aDisplayTransform clippingTo: aClipRect during: aBlock smoothing: 1
! !

!Canvas methodsFor: 'drawing-images' stamp: 'ar 6/25/1999 12:17'!
stencil: stencilForm at: aPoint color: aColor
	"Flood this canvas with aColor wherever stencilForm has non-zero pixels"
	^self stencil: stencilForm
		at: aPoint
		sourceRect: stencilForm boundingBox
		color: aColor! !

!Canvas methodsFor: 'drawing-text' stamp: 'ar 12/30/2001 20:35'!
drawString: s at: pt

	^ self drawString: s from: 1 to: s size at: pt font: nil color: Color black! !

!Canvas methodsFor: 'drawing-rectangles' stamp: 'gvc 9/18/2006 16:52'!
frameRectangle: aRectangle width: width colors: colors dashes: dashes offset: offset
	"Draw a rectangle with the given width, colors and dash lengths.
	The offset specifies how the coordinate system is translated from the screen origin
	(infinite forms are 0@0 screen based)."

	|o s hf vf c r ds di d os l|
	width < 1 ifTrue: [^self].
	dashes size < 2
		ifTrue: [^self  frameRectangle: aRectangle width: width color: colors first].
	r := aRectangle.
	s := dashes sum * width.
	ds := dashes size.
	di := 1.
	d := (dashes at: di) * width.
	c := colors at: di.
	hf := Form extent: s @ 1 depth: 32.
	r height >= width ifTrue: [
		o := r left + offset x \\ s.
		0 to: s - 1 do: [:x |
			hf colorAt: x + o \\ s  @ 0 put: c.
			d := d - 1.
			d = 0 ifTrue: [
				di := di \\ ds + 1.
				d := (dashes at: di) * width.
				c := colors at: di]].
		os := 0.
		l := r width truncateTo: width.
		self
			fillRectangle: (r topLeft + (os@0) extent: l@width)
			color: (InfiniteForm with: hf)].
	vf := Form extent: 1 @ s depth: 32.
	r width >= width ifTrue: [
		o := r top + offset y + width + (s - (r width \\ s)) \\ s.
		0 to: s - 1 do: [:y |
			vf colorAt: 0 @ (y + o \\ s) put: c.
			d := d - 1.
			d = 0 ifTrue: [
				di := di \\ ds + 1.
				d := (dashes at: di) * width.
				c := colors at: di]].
		os := width - (r width \\ width).
		l := r height - os truncateTo: width.
		self
			fillRectangle: (r topRight + (width negated @ os) extent: width@l)
			color: (InfiniteForm with: vf)].
	r height > width ifTrue: [
		o := r right + offset x - (width * 2) + (r height \\ s) + (r width \\ s) \\ s.
		0 to: s - 1 do: [:x |
			hf colorAt: o + s -1 - x \\ s  @ 0 put: c.
			d := d - 1.
			d = 0 ifTrue: [
				di := di \\ ds + 1.
				d := (dashes at: di) * width.
				c := colors at: di]].
		os := width - (r width \\ width + (r height \\ width) \\ width).
		l := r width - os truncateTo: width.
		os := (r width - os) \\ width.
		self
			fillRectangle: (r bottomLeft + (os @ width negated) extent: l@width)
			color: (InfiniteForm with: hf)].
	r width > width ifTrue: [
		o :=  r top + offset y + (r height * 2 \\ s) + (r width * 2 \\ s) - (width * 3) \\ s.
		0 to: s - 1 do: [:y |
			vf colorAt: 0 @ (o + s -1 - y \\ s) put: c.
			d := d - 1.
			d = 0 ifTrue: [
				di := di \\ ds + 1.
				d := (dashes at: di) * width.
				c := colors at: di]].
		l := r height - (2 * width) + os.
		os := width.
		self
			fillRectangle: (r topLeft + (0@os) extent: width@l)
			color: (InfiniteForm with: vf)]! !

!Canvas methodsFor: 'converting' stamp: 'ar 8/8/2001 14:14'!
asShadowDrawingCanvas: aColor
	^(ShadowDrawingCanvas on: self) shadowColor: aColor! !

!Canvas methodsFor: 'converting' stamp: 'ar 6/24/1999 17:46'!
asShadowDrawingCanvas
	^self asShadowDrawingCanvas: (Color black alpha: 0.5).! !

!Canvas methodsFor: 'drawing-support' stamp: 'ar 6/17/1999 03:00'!
translateBy: delta during: aBlock
	"Set a translation only during the execution of aBlock."
	^self subclassResponsibility! !

!Canvas methodsFor: 'testing' stamp: 'di 9/24/2000 16:10'!
seesNothingOutside: aRectangle
	"Return true if this canvas will not touch anything outside aRectangle"
	^ aRectangle containsRect: self clipRect
! !

!Canvas methodsFor: 'drawing-ovals' stamp: 'ar 6/18/1999 08:51'!
fillOval: aRectangle fillStyle: aFillStyle
	"Fill the given oval."
	^self fillOval: aRectangle fillStyle: aFillStyle borderWidth: 0 borderColor: Color transparent! !

!Canvas methodsFor: '*Rubric-Editing-Core' stamp: 'AlainPlantec 3/26/2013 18:27'!
rubParagraph: paragraph bounds: bounds color: c
	"Draw the given paragraph"
	^self subclassResponsibility! !

!Canvas methodsFor: 'drawing-text' stamp: 'ar 12/30/2001 20:37'!
drawString: s from: firstIndex to: lastIndex in: boundsRect font: fontOrNil color: c
	^self subclassResponsibility! !

!Canvas methodsFor: 'drawing-rectangles' stamp: 'StephaneDucasse 2/9/2011 14:36'!
fillRectangle: aRectangle fillStyle: aFillStyle
	"Fill the given rectangle. Double-dispatched via the fill style."
	
	aFillStyle fillRectangle: aRectangle on: self! !

!Canvas methodsFor: 'drawing-ovals' stamp: 'ar 6/18/1999 08:45'!
fillOval: r color: c

	self fillOval: r color: c borderWidth: 0 borderColor: Color transparent.
! !

!Canvas methodsFor: 'drawing-ovals' stamp: 'ar 6/18/1999 08:45'!
frameOval: r width: w color: c

	self fillOval: r color: Color transparent borderWidth: w borderColor: c.
! !

!Canvas methodsFor: 'accessing' stamp: 'ar 6/22/1999 14:07'!
clipRect
	"Return the currently active clipping rectangle"
	^self subclassResponsibility! !

!Canvas methodsFor: 'drawing-general' stamp: 'GaryChambers 9/8/2011 14:47'!
roundShadowCornersOf: aMorph during: aBlock
	^self roundShadowCornersOf: aMorph in: aMorph bounds during: aBlock! !

!Canvas methodsFor: 'testing' stamp: 'ar 11/13/1998 13:19'!
isBalloonCanvas
	^false! !

!Canvas methodsFor: 'accessing' stamp: 'jm 6/2/1998 06:39'!
form

	^ Display
! !

!Canvas methodsFor: 'drawing-general' stamp: 'ar 5/29/1999 05:14'!
draw: anObject
	^anObject drawOn: self! !

!Canvas methodsFor: 'testing' stamp: 'IgorStasenko 7/18/2011 18:53'!
isShadowDrawing
	^false! !

!Canvas methodsFor: 'accessing' stamp: 'ar 2/12/2000 18:17'!
contentsOfArea: aRectangle into: aForm
	"Return the contents of the given area"
	^self subclassResponsibility! !

!Canvas methodsFor: 'drawing-images' stamp: 'IgorStasenko 7/18/2011 18:08'!
translucentImage: aForm at: aPoint sourceRect: sourceRect
	"Draw a translucent image using the best available way of representing translucency.
	Note: This will be fixed in the future."

	(self depth < 32 or:[aForm isTranslucent not]) 
		ifTrue:[^self paintImage: aForm at: aPoint sourceRect: sourceRect].
	self image: aForm
		at: aPoint
		sourceRect: sourceRect
		rule: Form blend! !

!Canvas methodsFor: 'drawing' stamp: 'ar 6/17/1999 01:18'!
fillColor: aColor
	"Fill the receiver with the given color.
	Note: This method should be named differently since it is intended to fill the background and thus fills even if the color is transparent"
	^self fillRectangle: self clipRect color: (aColor alpha: 1.0).! !

!Canvas methodsFor: 'initialization' stamp: 'MarcusDenker 10/21/2013 14:21'!
reset
	"Reset the canvas."

	self initWithTarget:self class defaultTarget.
! !

!Canvas methodsFor: 'drawing-images' stamp: 'ar 12/28/2001 23:54'!
warpImage: aForm transform: aTransform at: extraOffset
	"Warp the given form using aTransform.
	TODO: Use transform to figure out appropriate cell size"
	^self warpImage: aForm transform: aTransform at: extraOffset sourceRect: aForm boundingBox cellSize: 1! !

!Canvas methodsFor: 'drawing-general' stamp: ''!
fullDraw: anObject
	^anObject fullDrawOn: self! !

!Canvas methodsFor: 'testing' stamp: 'ar 6/22/1999 14:10'!
isVisible: aRectangle
	"Return true if the given rectangle is (partially) visible"
	^self clipRect intersects: aRectangle
! !

!Canvas methodsFor: 'drawing-images' stamp: 'IgorStasenko 7/18/2011 18:08'!
paintImage: aForm at: aPoint sourceRect: sourceRect
	"Draw the given Form, which is assumed to be a Form or ColorForm following the convention that zero is the transparent pixel value."

	^self image: aForm
		at: aPoint
		sourceRect: sourceRect
		rule: Form paint! !

!Canvas methodsFor: 'drawing-images' stamp: 'ar 6/25/1999 12:17'!
stencil: stencilForm at: aPoint sourceRect: sourceRect color: aColor
	"Flood this canvas with aColor wherever stencilForm has non-zero pixels"
	^self subclassResponsibility! !

!Canvas methodsFor: 'accessing' stamp: 'ar 6/22/1999 14:15'!
extent
	"Return the physical extent of the output device"
	^self subclassResponsibility! !

!Canvas methodsFor: 'drawing-rectangles' stamp: 'gvc 9/14/2006 14:33'!
frameRectangle: aRectangle width: width colors: colors dashes: dashes
	"Draw a rectangle with the given width, colors and dash lengths."

	self
		frameRectangle: aRectangle
		width: width
		colors: colors
		dashes: dashes
		offset: self origin! !

!Canvas methodsFor: 'drawing-rectangles' stamp: 'RAA 8/14/2000 14:22'!
frameAndFillRectangle: r fillColor: fillColor borderWidth: borderWidth topLeftColor: topLeftColor bottomRightColor: bottomRightColor
	"Draw the rectangle using the given attributes.
	Note: This is a *very* simple implementation"
	| bw pt |
	self frameAndFillRectangle: r
		fillColor: fillColor
		borderWidth: borderWidth
		borderColor: bottomRightColor.
	bottomRightColor = topLeftColor ifFalse: [
		bw := borderWidth asPoint.
		pt := r topLeft + (bw // 2).
		self line: pt to: pt + ((r extent x - bw x)@0) width: borderWidth color: topLeftColor.
		self line: pt to: pt + (0@(r extent y - bw y)) width: borderWidth color: topLeftColor.
	].! !

!Canvas methodsFor: 'drawing-general' stamp: 'ar 12/30/2001 18:47'!
roundCornersOf: aMorph during: aBlock
	^self roundCornersOf: aMorph in: aMorph bounds during: aBlock! !

!Canvas methodsFor: 'drawing' stamp: 'sr 4/27/2000 03:31'!
line: pt1 to: pt2 width: w1 color: c1 stepWidth: s1 secondWidth: w2 secondColor: c2 secondStepWidth: s2 
	"Draw a line using the given width, colors and steps; both steps can  
	have different stepWidths (firstStep, secondStep), draw widths and  
	colors."
	| bigSteps offsetPoint dist p1p2Vec deltaBig delta1 delta2 lastPoint bigStep |
	s1 = 0 & (s2 = 0) ifTrue: [^ self].
	dist := pt1 dist: pt2.
	dist = 0 ifTrue: [^ self].
	bigStep := s1 + s2.
	bigSteps := dist / bigStep.
	p1p2Vec := pt2 - pt1.
	deltaBig := p1p2Vec / bigSteps.
	delta1 := deltaBig * (s1 / bigStep).
	delta2 := deltaBig * (s2 / bigStep).
	dist <= s1
		ifTrue: 
			[self
				line: pt1 rounded
				to: pt2 rounded
				width: w1
				color: c1.
			^ self].
	0 to: bigSteps truncated - 1 do: 
		[:bigStepIx | 
		self
			line: (pt1 + (offsetPoint := deltaBig * bigStepIx)) rounded
			to: (pt1 + (offsetPoint := offsetPoint + delta1)) rounded
			width: w1
			color: c1.
		self
			line: (pt1 + offsetPoint) rounded
			to: (pt1 + (offsetPoint + delta2)) rounded
			width: w2
			color: c2].
	"if there was no loop, offsetPoint is nil"
	lastPoint := pt1 + ((offsetPoint ifNil: [0 @ 0])
					+ delta2).
	(lastPoint dist: pt2)
		<= s1
		ifTrue: [self
				line: lastPoint rounded
				to: pt2 rounded
				width: w1
				color: c1]
		ifFalse: 
			[self
				line: lastPoint rounded
				to: (lastPoint + delta1) rounded
				width: w1
				color: c1.
			self
				line: (lastPoint + delta1) rounded
				to: pt2
				width: w1
				color: c2]! !

!Canvas methodsFor: '*Morphic-Base' stamp: 'ls 3/20/2000 21:24'!
copyClipRect: newClipRect

	^ ClippingCanvas canvas: self clipRect: newClipRect
! !

!Canvas methodsFor: 'drawing-rectangles' stamp: 'marcus.denker 8/15/2008 17:43'!
frameRectangle: r width: w color: c
	"Draw a frame around the given rectangle"
	^self frameAndFillRectangle: r
			fillColor: Color transparent
			borderWidth: w
			borderColor: c! !

!Canvas methodsFor: 'drawing-general' stamp: 'GaryChambers 9/8/2011 14:47'!
roundShadowCornersOf: aMorph in: bounds during: aBlock
	^aBlock value! !

!Canvas methodsFor: 'drawing' stamp: 'jm 8/2/97 13:54'!
line: pt1 to: pt2 color: c

	self line: pt1 to: pt2 width: 1 color: c.
! !

!Canvas methodsFor: 'drawing-rectangles' stamp: 'AlexandreBergel 1/29/2013 14:13'!
fillRectangle: aRectangle fillStyle: aFillStyle borderStyle: aBorderStyle
	"Fill the given rectangle."
       aFillStyle isTransparent ifFalse: [
               self fillRectangle: (aRectangle insetBy: aBorderStyle width) fillStyle: aFillStyle ].
       
       (aBorderStyle notNil and: [aBorderStyle width]) >= 0 ifTrue: [ aBorderStyle frameRectangle: aRectangle on: self ].
       ! !

!Canvas methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 5/4/2012 16:47'!
encryptedParagraph: para bounds: bounds color: c
	"Draw the given paragraph"
	^self subclassResponsibility! !

!Canvas methodsFor: 'drawing-text' stamp: 'tween 3/10/2009 07:42'!
drawString: s from: firstIndex to: lastIndex in: boundsRect font: fontOrNil color: c underline: underline underlineColor: uc strikethrough: strikethrough strikethroughColor: sc
	^self subclassResponsibility! !

!Canvas methodsFor: 'accessing' stamp: 'ar 6/22/1999 14:11'!
origin
	"Return the current origin for drawing operations"
	^self subclassResponsibility! !

!Canvas methodsFor: 'drawing-rectangles' stamp: 'ar 6/18/1999 07:32'!
fillRectangle: r color: c
	"Fill the rectangle using the given color"
	^self 
		frameAndFillRectangle: r
		fillColor: c
		borderWidth: 0
		borderColor: Color transparent! !

!Canvas methodsFor: 'drawing-support' stamp: 'ar 6/22/1999 14:08'!
translateTo: newOrigin clippingTo: aRectangle during: aBlock
	"Set a new origin and clipping rectangle only during the execution of aBlock."
	self translateBy: newOrigin - self origin 
		clippingTo: (aRectangle translateBy: self origin negated) 
		during: aBlock! !

!Canvas methodsFor: 'drawing' stamp: 'ar 6/17/1999 01:31'!
line: pt1 to: pt2 width: w color: c
	"Draw a line using the given width and color"
	^self subclassResponsibility! !

!Canvas methodsFor: 'drawing-images' stamp: 'IgorStasenko 7/18/2011 18:08'!
drawImage: aForm at: aPoint sourceRect: sourceRect
	"Draw the given form."

	^self image: aForm
		at: aPoint
		sourceRect: sourceRect
		rule: Form over! !

!Canvas methodsFor: 'drawing-general' stamp: 'ar 12/30/2001 18:47'!
roundCornersOf: aMorph in: bounds during: aBlock
	^aBlock value! !

!Canvas methodsFor: 'drawing-rectangles' stamp: 'gvc 3/21/2008 16:34'!
fillRectangle: aRectangle basicFillStyle: aFillStyle
	"Fill the given rectangle with the given, non-composite, fill style
	Note: The default implementation does not recognize any enhanced fill styles."
	
	self fillRectangle: aRectangle color: aFillStyle asColor.! !

!Canvas methodsFor: 'other' stamp: 'StephaneDucasse 2/9/2011 14:51'!
flushDisplay
	"Empty hook method."! !

!Canvas methodsFor: 'drawing' stamp: 'gvc 6/17/2006 10:42'!
line: pt1 to: pt2 width: width colors: colors dashes: dashes startingOffset: startingOffset 
	"Draw a line using the given width, colors and dash lengths.
	Dash lengths are considered as multiples of width."

	|dist deltaBig segmentOffset phase segmentLength startPoint distDone endPoint segLens lens l ep|
	width = 0 ifTrue: [^startingOffset].
	dist := pt1 dist: pt2.
	dist = 0 ifTrue: [^startingOffset].
	(dashes allSatisfy: [:d | d = 0]) ifTrue: [^startingOffset].
	deltaBig := pt2 - pt1.
	segLens := dashes collect: [:d | d * width].
	
	"Figure out what phase we are in and how far, given startingOffset."
	segmentOffset := startingOffset \\ segLens sum.
	lens := segLens readStream.
	l := 0.
	[lens atEnd or: [segmentOffset <= (l := l + lens next)]] whileFalse: [].
	segmentLength := lens atEnd
		ifTrue: [phase := segLens size.
				segLens sum - segmentOffset]
		ifFalse: [phase := lens position.
				(segLens first: phase) sum - segmentOffset.].
	startPoint := pt1.
	distDone := 0.0.
	segmentLength < (segLens at: phase)
		ifTrue: [startPoint := startPoint + (deltaBig * segmentLength / dist).
				distDone := distDone + segmentLength.
				phase := phase \\ segLens size + 1.
				segmentLength :=  (segLens at: phase)].
	[distDone < dist] whileTrue: 
			[segmentLength := segmentLength min: dist - distDone.
			endPoint := startPoint + (deltaBig * segmentLength / dist).
			ep := startPoint + (deltaBig * (segmentLength - width max: 0) / dist).
			self 
				line: startPoint truncated
				to: ep truncated
				width: width
				color: (colors at: phase).
			distDone := distDone + segmentLength.
			phase := phase \\ segLens size + 1.
			startPoint := endPoint.
			segmentLength := segLens at: phase].
	^startingOffset + distDone! !

!Canvas methodsFor: 'drawing-ovals' stamp: 'ar 6/18/1999 08:45'!
fillOval: r color: c borderWidth: borderWidth borderColor: borderColor
	"Fill the given oval."
	^self subclassResponsibility! !

!Canvas methodsFor: 'drawing-general' stamp: 'StephaneDucasse 2/8/2011 09:10'!
drawMorph: aMorph
	"Draw the receiver morph on the receiver"
	
	"Changed to improve performance. Have seen a 30% improvement."	
	(aMorph fullBounds intersects: self clipRect)
		ifFalse: [^self].
	self draw: aMorph! !

!Canvas methodsFor: 'other' stamp: 'StephaneDucasse 2/9/2011 14:51'!
forceToScreen: rect
	"Empty hook method"
! !

!Canvas methodsFor: 'private' stamp: 'ar 2/12/2000 18:12'!
image: aForm at: aPoint sourceRect: sourceRect rule: rule
	"Note: The public use of this protocol is deprecated. It will become private. Nobody in the outside world must assume that a thing like a combination rule has any specific effect."
	^self subclassResponsibility! !

!Canvas methodsFor: 'accessing' stamp: 'ar 2/17/2000 01:46'!
shadowColor
	"Return the current override color or nil if no such color exists"
	^nil! !

!Canvas methodsFor: 'drawing' stamp: 'ar 2/5/1999 18:28'!
render: anObject
	"Do some 3D operations with the object if possible"! !

!Canvas methodsFor: 'drawing-support' stamp: 'di 10/16/1999 15:56'!
transformBy: aDisplayTransform clippingTo: aClipRect during: aBlock smoothing: cellSize
	"Transform the receiver by the given display transformation during the execution of aBlock. The given clip rectangle defines the *global* (e.g., outer) rectangle against which the receiver should clip (which would be equivalent to 'self clipRect: aClipRect; transformBy: aDisplayTransform')."
	^ self subclassResponsibility! !

!Canvas methodsFor: 'drawing-support' stamp: 'ar 6/17/1999 01:43'!
preserveStateDuring: aBlock
	"Preserve the full canvas state during the execution of aBlock"
	^aBlock value: self copy! !

!Canvas methodsFor: 'drawing-images' stamp: 'ar 12/28/2001 23:44'!
warpImage: aForm transform: aTransform
	"Warp the given form using aTransform"
	^self warpImage: aForm transform: aTransform at: 0@0! !

!Canvas methodsFor: 'drawing-text' stamp: 'ar 12/31/2001 02:39'!
drawString: s in: boundsRect
	^self drawString: s from: 1 to: s size in: boundsRect font: nil color: Color black! !

!Canvas methodsFor: 'private' stamp: 'ar 8/8/2001 14:21'!
image: aForm at: aPoint sourceRect: sourceRect rule: rule alpha: sourceAlpha
	"Privately used for blending forms w/ constant alpha. Fall back to simpler case by defaul."
	^self image: aForm at: aPoint sourceRect: sourceRect rule: rule! !

!Canvas methodsFor: 'drawing-rectangles' stamp: 'ar 6/18/1999 07:33'!
frameRectangle: r color: c

	self frameRectangle: r width: 1 color: c.
! !

!Canvas methodsFor: 'drawing-text' stamp: 'ar 12/31/2001 02:25'!
drawString: s at: pt font: aFont color: aColor

	^ self drawString: s from: 1 to: s size at: pt font: aFont color: aColor! !

!Canvas methodsFor: 'drawing-text' stamp: 'ar 12/30/2001 20:36'!
drawString: s from: firstIndex to: lastIndex at: pt font: font color: aColor
	self drawString: s from: firstIndex to: lastIndex in: (pt extent: 10000@10000) font: font color: aColor! !

!Canvas methodsFor: 'drawing-support' stamp: 'gm 2/22/2003 14:53'!
cache: aRectangle using: aCache during: aBlock 
	"Cache the execution of aBlock by the given cache.
	Note: At some point we may want to actually *create* the cache here;
		for now we're only using it."

	(aCache notNil 
		and: [(aCache isForm) and: [aCache extent = aRectangle extent]]) 
			ifTrue: [^self paintImage: aCache at: aRectangle origin].
	aBlock value: self! !

!Canvas methodsFor: 'drawing-polygons' stamp: 'ar 6/18/1999 08:56'!
drawPolygon: vertices color: aColor borderWidth: bw borderColor: bc
	"Draw the given polygon."
	^self subclassResponsibility! !

!Canvas methodsFor: 'drawing-text' stamp: 'tween 3/10/2009 08:12'!
drawString: s in: boundsRect font: fontOrNil color: c underline: underline underlineColor: uc strikethrough: strikethrough strikethroughColor: sc
	^self drawString: s from: 1 to: s size in: boundsRect font: fontOrNil color: c underline: underline underlineColor: uc strikethrough: strikethrough strikethroughColor: sc! !

!Canvas methodsFor: '*Morphic-Base' stamp: 'ar 8/8/2001 14:22'!
asAlphaBlendingCanvas: alpha
	^(AlphaBlendingCanvas on: self) alpha: alpha! !

!Canvas methodsFor: 'drawing-ovals' stamp: 'ar 6/18/1999 08:50'!
fillOval: aRectangle fillStyle: aFillStyle borderWidth: bw borderColor: bc
	"Fill the given oval.
	Note: The default implementation does not recognize any enhanced fill styles"
	self fillOval: aRectangle color: aFillStyle asColor borderWidth: bw borderColor: bc! !

!Canvas methodsFor: 'drawing-images' stamp: 'ar 2/16/2000 23:48'!
paintImage: aForm at: aPoint
	"Draw the given Form, which is assumed to be a Form or ColorForm following the convention that zero is the transparent pixel value."

	self paintImage: aForm
		at: aPoint
		sourceRect: aForm boundingBox
! !

!Canvas methodsFor: 'drawing-polygons' stamp: 'ar 6/25/1999 12:18'!
drawPolygon: vertices fillStyle: aFillStyle
	"Fill the given polygon."
	self drawPolygon: vertices fillStyle: aFillStyle borderWidth: 0 borderColor: Color transparent! !

!Canvas methodsFor: 'testing' stamp: 'di 8/12/2000 15:04'!
doesRoundedCorners 

	^ true! !

!Canvas methodsFor: 'accessing' stamp: 'ar 2/12/2000 18:17'!
contentsOfArea: aRectangle
	"Return the contents of the given area"
	^self contentsOfArea: aRectangle into: (Form extent: aRectangle extent depth: self depth)! !

!Canvas methodsFor: 'accessing' stamp: 'ar 2/17/2000 01:46'!
shadowColor: aColor
	"Set a shadow color. If set this color overrides any client-supplied color."! !

!Canvas methodsFor: 'other' stamp: ''!
translateBy:aPoint clippingTo:aRect during:aBlock
	^aBlock value:(self copyOffset:aPoint clipRect:aRect).! !

!Canvas methodsFor: 'drawing-images' stamp: 'ar 2/16/2000 23:45'!
drawImage: aForm at: aPoint
	"Draw the given Form, which is assumed to be a Form or ColorForm"

	self drawImage: aForm
		at: aPoint
		sourceRect: aForm boundingBox! !

!Canvas methodsFor: 'drawing-text' stamp: 'tween 3/10/2009 08:07'!
drawString: s from: firstIndex to: lastIndex at: pt font: font color: aColor underline: underline underlineColor: uc strikethrough: strikethrough strikethroughColor: sc
	self drawString: s from: firstIndex to: lastIndex in: (pt extent: 10000@10000) font: font color: aColor underline: underline underlineColor: uc strikethrough: strikethrough strikethroughColor: sc! !

!Canvas methodsFor: 'drawing' stamp: 'ar 6/17/1999 01:31'!
paragraph: paragraph bounds: bounds color: c
	"Draw the given paragraph"
	^self subclassResponsibility! !

!Canvas methodsFor: 'drawing-rectangles' stamp: 'ar 6/18/1999 07:32'!
frameAndFillRectangle: r fillColor: fillColor borderWidth: borderWidth borderColor: borderColor
	"Draw the rectangle using the given attributes"
	^self subclassResponsibility! !

!Canvas methodsFor: 'initialization' stamp: 'ar 2/9/1999 06:29'!
flush! !

!Canvas methodsFor: 'drawing-images' stamp: 'ar 12/29/2001 00:20'!
warpImage: aForm transform: aTransform at: extraOffset sourceRect: sourceRect cellSize: cellSize
	"Warp the given using the appropriate transform and offset."
	^self subclassResponsibility! !

!Canvas methodsFor: 'drawing-images' stamp: 'ar 2/17/2000 14:05'!
translucentImage: aForm at: aPoint
	"Draw a translucent image using the best available way of representing translucency."
	self translucentImage: aForm
		at: aPoint
		sourceRect: aForm boundingBox! !

!Canvas methodsFor: 'drawing' stamp: 'aoy 2/15/2003 21:41'!
line: pt1 to: pt2 width: width color: color1 dashLength: s1 secondColor: color2 secondDashLength: s2 startingOffset: startingOffset 
	"Draw a line using the given width, colors and dash lengths.
	Originally written by Stephan Rudlof; tweaked by Dan Ingalls
	to use startingOffset for sliding offset as in 'ants' animations.
	Returns the sum of the starting offset and the length of this line."

	| dist deltaBig colors nextPhase segmentOffset phase segmentLength startPoint distDone endPoint segLens |
	dist := pt1 dist: pt2.
	dist = 0 ifTrue: [^startingOffset].
	s1 = 0 & (s2 = 0) ifTrue: [^startingOffset].
	deltaBig := pt2 - pt1.
	colors := { 
				color1.
				color2}.
	segLens := { 
				s1 asFloat.
				s2 asFloat}.
	nextPhase := { 
				2.
				1}.

	"Figure out what phase we are in and how far, given startingOffset."
	segmentOffset := startingOffset \\ (s1 + s2).
	segmentLength := segmentOffset < s1 
		ifTrue: 
			[phase := 1.
			s1 - segmentOffset]
		ifFalse: 
			[phase := 2.
			 s1 + s2 - segmentOffset].
	startPoint := pt1.
	distDone := 0.0.
	[distDone < dist] whileTrue: 
			[segmentLength := segmentLength min: dist - distDone.
			endPoint := startPoint + (deltaBig * segmentLength / dist).
			self 
				line: startPoint truncated
				to: endPoint truncated
				width: width
				color: (colors at: phase).
			distDone := distDone + segmentLength.
			phase := nextPhase at: phase.
			startPoint := endPoint.
			segmentLength := segLens at: phase].
	^startingOffset + dist! !

!Canvas methodsFor: 'drawing-polygons' stamp: 'ar 6/18/1999 08:58'!
drawPolygon: vertices fillStyle: aFillStyle borderWidth: bw borderColor: bc
	"Fill the given polygon.
	Note: The default implementation does not recognize any enhanced fill styles"
	self drawPolygon: vertices color: aFillStyle asColor borderWidth: bw borderColor: bc! !

!Canvas methodsFor: 'drawing-support' stamp: 'ar 6/17/1999 02:53'!
clipBy: aRectangle during: aBlock
	"Set a clipping rectangle active only during the execution of aBlock.
	Note: In the future we may want to have more general clip shapes - not just rectangles"
	^self subclassResponsibility! !

!Canvas class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 15:36'!
gtExampleWorldCanvasWithShadow
	<gtExample: 'Canvas: World+Shadow'>
	^ ShadowDrawingCanvas on: Canvas new! !

!Canvas class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 15:30'!
gtExampleNullCanvas
	<gtExample: 'Canvas: Null'>
	^ NullCanvas new! !

!Canvas class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 15:37'!
gtExampleWorldCanvasWithAlpha
	<gtExample: 'Canvas: World+ALpha'>
	^ AlphaBlendingCanvas on: Canvas new! !

!Canvas class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 15:30'!
gtExampleWorldCanvas
	<gtExample: 'Canvas: World'>
	^ Canvas new! !

!CascadeNode commentStamp: '<historical>'!
The first message has the common receiver, the rest have receiver == nil, which signifies cascading.!
!CascadeNode methodsFor: 'code generation' stamp: 'eem 5/15/2008 09:41'!
emitCodeForValue: stack encoder: encoder
	receiver emitCodeForValue: stack encoder: encoder.
	1 to: messages size - 1 do: 
		[:i | 
		encoder genDup.
		stack push: 1.
		(messages at: i) emitCodeForValue: stack encoder: encoder.
		encoder genPop.
		stack pop: 1].
	messages last emitCodeForValue: stack encoder: encoder! !

!CascadeNode methodsFor: 'visiting' stamp: 'eem 9/6/2009 12:33'!
accept: aVisitor
	^aVisitor visitCascadeNode: self! !

!CascadeNode methodsFor: 'accessing' stamp: 'eem 9/10/2008 15:15'!
messages
	^messages! !

!CascadeNode methodsFor: 'code generation (closures)' stamp: 'eem 5/19/2008 20:26'!
analyseTempsWithin: scopeBlock "<BlockNode>" rootNode: rootNode "<MethodNode>" assignmentPools: assignmentPools "<Dictionary>"
	{ receiver }, messages do:
		[:node| node analyseTempsWithin: scopeBlock rootNode: rootNode assignmentPools: assignmentPools]! !

!CascadeNode methodsFor: 'initialize-release' stamp: ''!
receiver: receivingObject messages: msgs
	" Transcript show: 'abc'; cr; show: 'def' "

	receiver := receivingObject.
	messages := msgs! !

!CascadeNode methodsFor: 'code generation' stamp: 'eem 5/15/2008 09:39'!
sizeCodeForValue: encoder
	| size |
	size := (receiver sizeCodeForValue: encoder)
			 + (messages size - 1 * (encoder sizeDup + encoder sizePop)).
	messages do: [:aMessage | size := size + (aMessage sizeCodeForValue: encoder)].
	^size! !

!CascadeNode methodsFor: 'accessing' stamp: 'tk 10/22/2000 16:55'!
receiver
	^receiver! !

!CascadeNode methodsFor: 'printing' stamp: 'di 4/25/2000 19:17'!
printOn: aStream indent: level precedence: p 

	p > 0 ifTrue: [aStream nextPut: $(].
	messages first printReceiver: receiver on: aStream indent: level.
	1 to: messages size do: 
		[:i | (messages at: i) printOn: aStream indent: level.
		i < messages size ifTrue: 
				[aStream nextPut: $;.
				messages first precedence >= 2 ifTrue: [aStream crtab: level + 1]]].
	p > 0 ifTrue: [aStream nextPut: $)]! !

!CascadeNode methodsFor: 'printing' stamp: ''!
printOn: aStream indent: level
	self printOn: aStream indent: level precedence: 0! !

!Categorizer commentStamp: 'StephaneDucasse 5/9/2010 20:11'!
A Categorizer is responsible to manage the class categories and method protocols. 

Instances consist of an Array of category names (categoryArray), each of which refers to an Array of elements (elementArray). This association is made through an Array of stop indices (categoryStops), each of which is 
the index in elementArray of the last element (if any) of the corresponding category. For example: categories := Array with: 'firstCat' with: 'secondCat' with: 'thirdCat'. stops := Array with: 1 with: 4 with: 4. 
elements := Array with: #a with: #b with: #c with: #d. This means that category firstCat has only #a, secondCat has #b, #c, and #d, and thirdCat has no elements. This means that stops at: stops size must be the same as elements size.

 Instance Variables
      categoryArray:          <SequenceableCollection of: Object>
      categoryStops:          <SequenceableCollection of: Integer>
      elementArray:           <SequenceableCollection of: Object>

categoryArray
       - holds the list of categories.
       A category could be any Object but is generally a String or Symbol.
       Categories should be unique (categoryArray asSet size = categoryArray size)

categoryStops
       - holds the index of last element belonging to each category.
       There should be a category stop for each category (categoryStops size = categoryArray size).
       The categoryStops should be sorted (categoryStops sorted = categoryStops).
       A category stop equal to its predecessor (= 0 for the first category stop) denotes an empty category.

elementArray
      - holds the elements to be classified. The elements are sorted by category.

Class variables
       Default is the default category used to classify yet unclassified methods of a class
       NullCategory is the category to be displayed in a Browser for a class having no method.!
!Categorizer methodsFor: 'accessing' stamp: 'MarcusDenker 7/23/2014 22:31'!
categories
	"Answer an Array of categories (names)."
	categoryArray ifNil: [^ nil].
	(categoryArray size = 1 
		and: [categoryArray first = Default & (elementArray isEmpty)])
		ifTrue: [^Array with: NullCategory].
	^categoryArray! !

!Categorizer methodsFor: 'file in/out' stamp: 'BenjaminVanRyseghem 4/12/2012 17:27'!
stringForFileOut

	^ String streamContents: [:aStream || elementIndex |
			elementIndex := 1.
			1 to: categoryArray size do: 
				[:i | 
				aStream nextPut: $(.
				(categoryArray at: i) asString printOn: aStream.
				[elementIndex <= (categoryStops at: i)]
					whileTrue: 
						[aStream space; nextPutAll: (elementArray at: elementIndex).
						elementIndex := elementIndex + 1].
				aStream nextPut: $); cr ]]! !

!Categorizer methodsFor: 'accessing' stamp: 'NS 4/5/2004 17:44'!
addCategory: newCategory
	^ self addCategory: newCategory before: nil ! !

!Categorizer methodsFor: 'accessing' stamp: 'MarcusDenker 7/23/2014 22:34'!
removeCategory: cat 
	"Remove the category named, cat. Create an error notificiation if the 
	category has any elements in it."

	| index lastStop |
	index := categoryArray indexOf: cat ifAbsent: [^self].
	lastStop := 
		index = 1
			ifTrue: [0]
			ifFalse: [categoryStops at: index - 1].
	(categoryStops at: index) - lastStop > 0 
		ifTrue: [^self error: 'cannot remove non-empty category ', cat].
	categoryArray := categoryArray copyReplaceFrom: index to: index with: Array new.
	categoryStops := categoryStops copyReplaceFrom: index to: index with: Array new.
	categoryArray isEmpty
		ifTrue:
			[categoryArray := Array with: Default.
			categoryStops := Array with: 0]
! !

!Categorizer methodsFor: 'accessing' stamp: 'NS 4/15/2004 12:33'!
isEmptyCategoryNumber: anInteger

	| firstIndex lastIndex |
	(anInteger < 1 or: [anInteger > categoryStops size])
		ifTrue: [^ true].
	firstIndex := self firstIndexOfCategoryNumber: anInteger.
	lastIndex :=  self lastIndexOfCategoryNumber: anInteger.
	^ firstIndex > lastIndex! !

!Categorizer methodsFor: 'file in/out' stamp: 'NS 4/5/2004 17:44'!
scanFrom: aStream
	"Reads in the organization from the next chunk on aStream.
	Categories or elements not found in the definition are not affected.
	New elements are ignored."

	self changeFromString: aStream nextChunk.
	aStream skipStyleChunk.! !

!Categorizer methodsFor: 'accessing' stamp: 'MarcusDenker 10/10/2013 16:37'!
sortCategories
	| privateCategories publicCategories newCategories |
	privateCategories := self categories
		select: [ :one | (one findString: 'private' startingAt: 1 caseSensitive: false) = 1 ].
	publicCategories := self categories copyWithoutAll: privateCategories.
	newCategories := publicCategories asSortedCollection asOrderedCollection
		addAll: privateCategories;
		asArray.
	self categories: newCategories! !

!Categorizer methodsFor: 'accessing' stamp: 'CamilloBruni 2/28/2012 14:21'!
categories: anArray
	"Reorder my categories to be in order of the argument, anArray. If the 
	resulting organization does not include all elements, then give an error."

	| newCategories newStops newElements newElementsSet catName list runningTotal | 
	
	anArray size < 2 ifTrue: [ ^ self ].
	
	newCategories := Array new: anArray size.
	newStops := Array new: anArray size.
	newElements := OrderedCollection new: anArray size.
	runningTotal := 0.
	1 to: anArray size do:
		[:i |
		catName := (anArray at: i) asSymbol.
		list := self listAtCategoryNamed: catName.
		newElements addAllLast: list.
		newCategories at: i put: catName.
		newStops at: i put: (runningTotal := runningTotal + list size)].
	newElements := newElements asArray.
	"create a temporary set for super-fast includes check"
	newElementsSet := newElements asSet.
	elementArray do:
		[:element | "check to be sure all elements are included"
		(newElementsSet includes: element)
			ifFalse: [^self error: 'New categories must match old ones']].
	"Everything is good, now update my three arrays."
	categoryArray := newCategories.
	categoryStops := newStops.
	elementArray := newElements! !

!Categorizer methodsFor: 'accessing' stamp: 'MarcusDenker 5/18/2013 15:44'!
changeFromString: aString 
	"Parse the argument, aString, and make this be the receiver's structure."

	| categorySpecs |
	categorySpecs := aString parseLiterals.
	"If nothing was scanned and I had no elements before, then default me"
	(categorySpecs isEmpty and: [elementArray isEmpty])
		ifTrue: [^ self setDefaultList: Array new].

	^ self changeFromCategorySpecs: categorySpecs! !

!Categorizer methodsFor: 'accessing' stamp: 'MarcusDenker 7/23/2014 22:34'!
removeEmptyCategories
	"Remove empty categories."

	| categoryIndex currentStop keptCategories keptStops |
	keptCategories := (Array new: 16) writeStream.
	keptStops := (Array new: 16) writeStream.
	currentStop := categoryIndex := 0.
	[(categoryIndex := categoryIndex + 1) <= categoryArray size]
		whileTrue: 
			[(categoryStops at: categoryIndex) > currentStop
				ifTrue: 
					[keptCategories nextPut: (categoryArray at: categoryIndex).
					keptStops nextPut: (currentStop := categoryStops at: categoryIndex)]].
	categoryArray := keptCategories contents.
	categoryStops := keptStops contents.
	categoryArray isEmpty
		ifTrue:
			[categoryArray := Array with: Default.
			categoryStops := Array with: 0]

	"ClassOrganizer allInstancesDo: [:co | co removeEmptyCategories]."! !

!Categorizer methodsFor: 'private' stamp: 'NS 4/5/2004 17:50'!
setDefaultList: aSortedCollection

	categoryArray := Array with: Default.
	categoryStops := Array with: aSortedCollection size.
	elementArray := aSortedCollection asArray! !

!Categorizer methodsFor: 'private' stamp: 'PeterHugossonMiller 9/3/2009 00:15'!
basicRemoveElement: element 
	"Remove the selector, element, from all categories."
	| categoryIndex elementIndex nextStop newElements |
	categoryIndex := 1.
	elementIndex := 0.
	nextStop := 0.
	"nextStop keeps track of the stops in the new element array"
	newElements := (Array new: elementArray size) writeStream.
	[(elementIndex := elementIndex + 1) <= elementArray size]
		whileTrue: 
			[[elementIndex > (categoryStops at: categoryIndex)]
				whileTrue: 
					[categoryStops at: categoryIndex put: nextStop.
					categoryIndex := categoryIndex + 1].
			(elementArray at: elementIndex) = element
				ifFalse: 
					[nextStop := nextStop + 1.
					newElements nextPut: (elementArray at: elementIndex)]].
	[categoryIndex <= categoryStops size]
		whileTrue: 
			[categoryStops at: categoryIndex put: nextStop.
			categoryIndex := categoryIndex + 1].
	elementArray := newElements contents.
	self assertInvariant.! !

!Categorizer methodsFor: 'accessing' stamp: 'NS 4/5/2004 17:44'!
classify: element under: heading 
	self classify: element under: heading suppressIfDefault: true! !

!Categorizer methodsFor: 'accessing' stamp: 'NS 4/5/2004 17:44'!
listAtCategoryNamed: categoryName
	"Answer the array of elements associated with the name, categoryName."

	| i |
	i := categoryArray indexOf: categoryName ifAbsent: [^Array new].
	^self listAtCategoryNumber: i! !

!Categorizer methodsFor: 'accessing' stamp: 'NS 4/6/2004 13:51'!
listAtCategoryNumber: anInteger 
	"Answer the array of elements stored at the position indexed by anInteger.  Answer nil if anInteger is larger than the number of categories."

	| firstIndex lastIndex |
	(anInteger < 1 or: [anInteger > categoryStops size])
		ifTrue: [^ nil].
	firstIndex := self firstIndexOfCategoryNumber: anInteger.
	lastIndex :=  self lastIndexOfCategoryNumber: anInteger.
	^elementArray copyFrom: firstIndex to: lastIndex! !

!Categorizer methodsFor: 'accessing' stamp: 'NS 4/5/2004 17:44'!
allMethodSelectors
	"give a list of all method selectors."

	^ elementArray copy sort! !

!Categorizer methodsFor: 'accessing' stamp: 'NS 4/12/2004 20:50'!
removeElement: element 
	^ self basicRemoveElement: element! !

!Categorizer methodsFor: 'accessing' stamp: 'ClementBera 7/26/2013 16:06'!
elementCategoryDict
	| dict firstIndex lastIndex |
	elementArray ifNil: [^ nil].
	dict := Dictionary new: elementArray size.
	1to: categoryStops size do: [:cat |
		firstIndex := self firstIndexOfCategoryNumber: cat.
		lastIndex := self lastIndexOfCategoryNumber: cat.
		firstIndex to: lastIndex do: [:el |
			dict at: (elementArray at: el) put: (categoryArray at: cat)].
	].
	^ dict.! !

!Categorizer methodsFor: 'private' stamp: 'NS 4/6/2004 13:51'!
firstIndexOfCategoryNumber: anInteger
	anInteger < 1 ifTrue: [^ nil].
	^ (anInteger > 1
			ifTrue: [(categoryStops at: anInteger - 1) + 1]
			ifFalse: [1]).! !

!Categorizer methodsFor: 'accessing' stamp: 'NS 4/5/2004 17:44'!
categoryOfElement: element 
	"Answer the category associated with the argument, element."

	| index |
	index := self numberOfCategoryOfElement: element.
	index = 0
		ifTrue: [^nil]
		ifFalse: [^categoryArray at: index]! !

!Categorizer methodsFor: 'accessing' stamp: 'NS 4/5/2004 17:44'!
numberOfCategoryOfElement: element 
	"Answer the index of the category with which the argument, element, is 
	associated."

	| categoryIndex elementIndex |
	categoryIndex := 1.
	elementIndex := 0.
	[(elementIndex := elementIndex + 1) <= elementArray size]
		whileTrue: 
			["point to correct category"
			[elementIndex > (categoryStops at: categoryIndex)]
				whileTrue: [categoryIndex := categoryIndex + 1].
			"see if this is element"
			element = (elementArray at: elementIndex) ifTrue: [^categoryIndex]].
	^0! !

!Categorizer methodsFor: 'private' stamp: 'jannik.laval 5/1/2010 16:01'!
assertInvariant
	[elementArray size = categoryStops last] assert! !

!Categorizer methodsFor: 'accessing' stamp: 'NS 4/5/2004 17:44'!
classifyAll: aCollection under: heading

	aCollection do:
		[:element | self classify: element under: heading]! !

!Categorizer methodsFor: 'accessing' stamp: 'NS 4/5/2004 17:44'!
renameCategory: oldCatString toBe: newCatString
	"Rename a category. No action if new name already exists, or if old name does not exist."
	| index oldCategory newCategory |
	oldCategory := oldCatString asSymbol.
	newCategory := newCatString asSymbol.
	(categoryArray indexOf: newCategory) > 0
		ifTrue: [^ self].	"new name exists, so no action"
	(index := categoryArray indexOf: oldCategory) = 0
		ifTrue: [^ self].	"old name not found, so no action"
	categoryArray := categoryArray copy.  "need to change identity so smart list update will notice the change"
	categoryArray at: index put: newCategory! !

!Categorizer methodsFor: 'accessing' stamp: 'al 11/28/2005 22:05'!
classify: element under: heading suppressIfDefault: aBoolean
	"Store the argument, element, in the category named heading.   If aBoolean is true, then invoke special logic such that the classification is NOT done if the new heading is the Default and the element already had a non-Default classification -- useful for filein"

	| catName catIndex elemIndex realHeading |
	((heading = NullCategory) or: [heading == nil])
		ifTrue: [realHeading := Default]
		ifFalse: [realHeading := heading asSymbol].
	(catName := self categoryOfElement: element) = realHeading
		ifTrue: [^ self].  "done if already under that category"

	catName ~~ nil ifTrue: 
		[(aBoolean and: [realHeading = Default])
				ifTrue: [^ self].	  "return if non-Default category already assigned in memory"
		self basicRemoveElement: element].	"remove if in another category"

	(categoryArray indexOf: realHeading) = 0 ifTrue: [self addCategory: realHeading].

	catIndex := categoryArray indexOf: realHeading.
	elemIndex := 
		catIndex > 1
			ifTrue: [categoryStops at: catIndex - 1]
			ifFalse: [0].
	[(elemIndex := elemIndex + 1) <= (categoryStops at: catIndex) 
		and: [element >= (elementArray at: elemIndex)]] whileTrue.

	"elemIndex is now the index for inserting the element. Do the insertion before it."
	elementArray := elementArray copyReplaceFrom: elemIndex to: elemIndex-1
						with: (Array with: element).

	"add one to stops for this and later categories"
	catIndex to: categoryArray size do: 
		[:i | categoryStops at: i put: (categoryStops at: i) + 1].

	((categoryArray includes: Default)
		and: [(self listAtCategoryNamed: Default) size = 0]) ifTrue: [self removeCategory: Default].
		
	self assertInvariant.! !

!Categorizer methodsFor: 'accessing' stamp: 'MarcusDenker 10/10/2013 16:38'!
changeFromCategorySpecs: categorySpecs
	"Tokens is an array of categorySpecs as scanned from a browser 'reorganize' pane, or built up by some other process, such as a scan of an environment."

	| newCategories newStops temp cc currentStop oldElements newElements |
	oldElements := elementArray asSet.
	newCategories := Array new: categorySpecs size.
	newStops := Array new: categorySpecs size.
	currentStop := 0.
	newElements := (Array new: 16) writeStream.
	1 to: categorySpecs size do: [ :i | 
		| selectors catSpec |
		catSpec := categorySpecs at: i.
		newCategories at: i put: catSpec first asSymbol.
		selectors := catSpec allButFirst
			collect: [ :each | 
				each isSymbol
					ifTrue: [ each ]
					ifFalse: [ each printString asSymbol ] ].
		selectors asSortedCollection
			do: [ :elem | 
				(oldElements remove: elem ifAbsent: [ nil ]) notNil
					ifTrue: [ 
						newElements nextPut: elem.
						currentStop := currentStop + 1 ] ].
		newStops at: i put: currentStop ].	"Ignore extra elements but don't lose any existing elements!!"
	oldElements := oldElements collect: [ :elem | Array with: (self categoryOfElement: elem) with: elem ].
	newElements := newElements contents.
	categoryArray := newCategories.
	(cc := categoryArray asSet) size = categoryArray size
		ifFalse: [ 
			"has duplicate element"
			temp := categoryArray asOrderedCollection.
			temp removeAll: categoryArray asSet.
			temp
				do: [ :dup | 
					| tmp ii |
					tmp := dup.
					ii := categoryArray indexOf: tmp.
					[ 
					tmp := (tmp , ' #2') asSymbol.
					cc includes: tmp ] whileTrue.
					cc add: tmp.
					categoryArray at: ii put: tmp ] ].
	categoryStops := newStops.
	elementArray := newElements.
	oldElements do: [ :pair | self classify: pair last under: pair first ]! !

!Categorizer methodsFor: 'accessing' stamp: 'NS 4/5/2004 17:44'!
addCategory: catString before: nextCategory
	"Add a new category named heading.
	If default category exists and is empty, remove it.
	If nextCategory is nil, then add the new one at the end,
	otherwise, insert it before nextCategory."
	| index newCategory |
	newCategory := catString asSymbol.
	(categoryArray indexOf: newCategory) > 0
		ifTrue: [^self].	"heading already exists, so done"
	index := categoryArray indexOf: nextCategory
		ifAbsent: [categoryArray size + 1].
	categoryArray := categoryArray
		copyReplaceFrom: index
		to: index-1
		with: (Array with: newCategory).
	categoryStops := categoryStops
		copyReplaceFrom: index
		to: index-1
		with: (Array with: (index = 1
				ifTrue: [0]
				ifFalse: [categoryStops at: index-1])).
	"remove empty default category"
	(newCategory ~= Default
			and: [(self listAtCategoryNamed: Default) isEmpty])
		ifTrue: [self removeCategory: Default]! !

!Categorizer methodsFor: 'private' stamp: 'NS 4/6/2004 13:52'!
lastIndexOfCategoryNumber: anInteger
	anInteger > categoryStops size ifTrue: [^ nil].
	^ categoryStops at: anInteger! !

!Categorizer methodsFor: 'accessing' stamp: 'NS 4/15/2004 12:33'!
isEmptyCategoryNamed: categoryName
	| i |
	i := categoryArray indexOf: categoryName ifAbsent: [^false].
	^self isEmptyCategoryNumber: i! !

!Categorizer class methodsFor: 'class initialization' stamp: 'NS 4/6/2004 11:48'!
initialize
	"	self  initialize	"
	
	Default := 'as yet unclassified' asSymbol.
	NullCategory := 'no messages' asSymbol.! !

!Categorizer class methodsFor: 'class initialization' stamp: 'NS 4/5/2004 17:44'!
default 
	^ Default! !

!Categorizer class methodsFor: 'instance creation' stamp: 'NS 4/5/2004 17:44'!
defaultList: aSortedCollection 
	"Answer an instance of me with initial elements from the argument, 
	aSortedCollection."

	^self new setDefaultList: aSortedCollection! !

!Categorizer class methodsFor: 'class initialization' stamp: 'NS 4/5/2004 17:44'!
nullCategory
	^ NullCategory! !

!Categorizer class methodsFor: 'documentation' stamp: 'NS 4/5/2004 17:44'!
documentation
	"Instances consist of an Array of category names (categoryArray), each of 
	which refers to an Array of elements (elementArray). This association is 
	made through an Array of stop indices (categoryStops), each of which is 
	the index in elementArray of the last element (if any) of the 
	corresponding category. For example: categories := Array with: 'firstCat' 
	with: 'secondCat' with: 'thirdCat'. stops := Array with: 1 with: 4 with: 4. 
	elements := Array with: #a with: #b with: #c with: #d. This means that 
	category firstCat has only #a, secondCat has #b, #c, and #d, and 
	thirdCat has no elements. This means that stops at: stops size must be the 
	same as elements size." ! !

!Categorizer class methodsFor: 'housekeeping' stamp: 'NS 4/6/2004 11:48'!
sortAllCategories

	self allSubInstances
		do: [:x | x sortCategories]! !

!Categorizer class methodsFor: 'class initialization' stamp: 'eem 1/7/2009 16:04'!
allCategory
	"Return a symbol that represents the virtual all methods category."

	^#'-- all --'! !

!CategoryAdded commentStamp: 'cyrilledelaunay 1/18/2011 12:29'!
This announcement will be emited when adding a category using:
=> SystemOrganizer >> addCategory:!
!CategoryAdded methodsFor: 'accessing' stamp: 'GuillermoPolito 8/1/2012 17:58'!
categoryName

	^ categoryName! !

!CategoryAdded methodsFor: 'accessing' stamp: 'GuillermoPolito 8/1/2012 17:56'!
categoryName: aCategoryName
	categoryName := aCategoryName! !

!CategoryAdded class methodsFor: 'instance creation' stamp: 'GuillermoPolito 8/1/2012 17:57'!
categoryName: aCategoryName
	^self new
			categoryName: aCategoryName;
			yourself! !

!CategoryRemoved commentStamp: 'cyrilledelaunay 1/18/2011 12:28'!
This announcement will be emited when removing a category using:
=> SystemOrganizer >> removeCategory:!
!CategoryRemoved methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:03'!
categoryName
	^categoryName! !

!CategoryRemoved methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:02'!
categoryName: aCategoryName
	categoryName := aCategoryName! !

!CategoryRemoved class methodsFor: 'instance creation' stamp: 'GuillermoPolito 8/2/2012 00:02'!
categoryName: aCategoryName
	^self new
			categoryName: aCategoryName;
			yourself! !

!CategoryRenamed commentStamp: 'cyrilledelaunay 1/18/2011 12:26'!
This announcement will be emited when renaming a category using:
=> SystemOrganizer >> renameCategory:toBe:!
!CategoryRenamed methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:05'!
newCategoryName: aCategoryName
	newCategoryName := aCategoryName! !

!CategoryRenamed methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:05'!
newCategoryName
	^newCategoryName! !

!CategoryRenamed methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:05'!
oldCategoryName
	^oldCategoryName! !

!CategoryRenamed methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:05'!
oldCategoryName: aCategoryName
	oldCategoryName := aCategoryName! !

!CategoryRenamed class methodsFor: 'instance creation' stamp: 'GuillermoPolito 8/2/2012 00:05'!
classCategoryRenamedFrom: anOldCategoryName to: aNewCategoryName
	^self new
			newCategoryName: aNewCategoryName;
			oldCategoryName: anOldCategoryName;
			yourself! !

!CategoryWidget commentStamp: '<historical>'!
CategoryWidget is the basic implementation of a wiget managing categories!
!CategoryWidget methodsFor: 'selection' stamp: ''!
categorySelectionAt: anIndex

	| elt |
	elt := self getCategories at: anIndex ifAbsent: [ nil ].
	^ categoriesSelection at: elt ifAbsent: [ false ].! !

!CategoryWidget methodsFor: 'private' stamp: ''!
categoryWrapper: anItem
	| package class result |

	package := self model selectedPackage.
	class := self model selectedClass.
	result := anItem asMorph.
	anItem first == $*
		ifTrue: [ | item |
			item := anItem allButFirst asLowercase.
			((item = package name asLowercase) or: 
				[ (item beginsWith: package name asLowercase) and: [ (item at: (package name size +1)) =$-]])
				ifFalse: [ result := anItem asMorph color: self model extensionColor; yourself ]]
		ifFalse: [
			(package extendedClasses includes: class)
				ifTrue: [ result := anItem asMorph color: self model extensionColor; yourself ]].
	self model showInstance
		ifFalse: [ result emphasis: 1 ].
	^ result! !

!CategoryWidget methodsFor: 'private' stamp: 'MarcusDenker 9/27/2013 18:04'!
sortCategories: allProtocols forClass: class firstInPackage: currentPackage
	"List the protocols in this order: 
		1. the -- all -- category
		2. the extension protocols of the given package
		3. the extension protocols
		4. the normal protocols"
		
	|  sortBlock currentPackageProtocols otherProtocols |

	currentPackageProtocols := allProtocols reject: [ :protocolName | protocolName beginsWith: '*' ].
	
	"Filter out the existing protocols so that we can sort them later separately"
	otherProtocols := allProtocols difference: currentPackageProtocols.
		
	sortBlock := [ :a :b | (a compare: b caseSensitive: false) = 1 ].
	
	^ (currentPackageProtocols sort: sortBlock), (otherProtocols sort: sortBlock)! !

!CategoryWidget methodsFor: 'private' stamp: ''!
loadPackagesCategoriesFor: class
	| env |
	
	env :=  self model browsedEnvironment.
	^env isSystem
		ifTrue: [ self loadPackagesCategoriesInSystemEnvironmentFor: class ]
		ifFalse: [ self loadPackagesCategoriesInARestrictedEnvironment: env for: class  ]! !

!CategoryWidget methodsFor: 'private' stamp: ''!
selectProtocol: aString

	categoriesSelection at: aString put: true! !

!CategoryWidget methodsFor: 'protocol' stamp: ''!
vScrollValue

	^ categoriesList scrollValue y! !

!CategoryWidget methodsFor: 'private' stamp: 'CamilloBruni 5/4/2013 14:23'!
loadGroupsCategoriesInSytemEnvironmentFor: class
	| group |

	group := self model selectedGroup.
	^ self sortCategories: (group protocolsFor: class ) forClass: class! !

!CategoryWidget methodsFor: 'protocol' stamp: ''!
getCategories

	^ categories ifNil: [ categories := self loadCategories ].! !

!CategoryWidget methodsFor: 'selection' stamp: 'CamilloBruni 10/4/2012 10:50'!
selectedCategoryIndex: anInteger

	| anObject |
	anObject := self getCategories at: anInteger ifAbsent: [ nil ].
	self model selectedCategory: anObject.
	
	self changed: #selectedCategoryIndex.
	self model categorySelectionChanged.
	self model changed: #currentHistoryIndex.! !

!CategoryWidget methodsFor: 'initialization' stamp: ''!
initialize

	super initialize.
	categoriesSelection := Dictionary new.! !

!CategoryWidget methodsFor: 'private' stamp: 'MarcusDenker 9/27/2013 18:03'!
loadPackagesCategoriesInSystemEnvironmentFor: class
	
	^ self sortCategories: class protocols forClass: class! !

!CategoryWidget methodsFor: 'protocol' stamp: ''!
categoriesSelection

	^ categoriesSelection! !

!CategoryWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/28/2014 22:14'!
selectedCategories

	| associations |
	associations := self categoriesSelection associations select: [:assoc | assoc value ].
	associations := associations collect: [:assoc | assoc key ].
	^ associations select: [:each | each notNil ]! !

!CategoryWidget methodsFor: 'private' stamp: 'EstebanLorenzano 12/20/2013 12:35'!
loadPackagesCategoriesInARestrictedEnvironment: env for: class
	^ self 
		sortCategories: 
			((model browsedEnvironment protocolsFor: class) copyWithFirst:  AllProtocol defaultName)
		forClass: class! !

!CategoryWidget methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 3/23/2012 18:54'!
label: aString

	"categoriesGroup label: aString"! !

!CategoryWidget methodsFor: 'protocol' stamp: ''!
takeKeyboardFocus

	categoriesList takeKeyboardFocus! !

!CategoryWidget methodsFor: 'private' stamp: 'CamilloBruni 5/4/2013 14:25'!
sortCategories: protocols forClass: class
	^ self 
		sortCategories: protocols
		forClass: class
		firstInPackage: self model selectedPackage! !

!CategoryWidget methodsFor: 'private' stamp: ''!
getCategoryItem: anIndex

	^ self getCategories at: anIndex! !

!CategoryWidget methodsFor: 'protocol' stamp: 'NicolaiHess 8/9/2014 21:43'!
resetCategoryList

	categories := nil! !

!CategoryWidget methodsFor: 'private' stamp: ''!
loadGroupsCategoriesFor: class
	| env |
	
	env := model browsedEnvironment.
	^ env isSystem
		ifTrue: [ self loadGroupsCategoriesInSytemEnvironmentFor: class ]
		ifFalse: [ self loadGroupsCategoriesInARestrictedEnvironment: env for: class ]! !

!CategoryWidget methodsFor: 'private' stamp: 'CamilloBruni 5/4/2013 14:23'!
loadGroupsCategoriesInARestrictedEnvironment: env for: class
	| group |
	
	group := self model selectedGroup.
	^ self sortCategories: ((group protocolsFor: class ) intersection: ( env protocolsFor: class )) forClass: class! !

!CategoryWidget methodsFor: 'protocol' stamp: ''!
searchedElement: index

	categoriesList searchedElement: index! !

!CategoryWidget methodsFor: 'selection' stamp: ''!
selectedCategoryIndex

	^ self getCategories indexOf: self selectedCategory ifAbsent: [ 0 ]! !

!CategoryWidget methodsFor: 'private' stamp: ''!
loadCategories
	| class |
	class := self model selectedClass.
	class ifNil: [ ^ #() ].
	
	^ self model showGroups
		ifTrue: [ self loadGroupsCategoriesFor: class ]
		ifFalse: [ self loadPackagesCategoriesFor: class ]! !

!CategoryWidget methodsFor: 'protocol' stamp: ''!
vScrollValue: aNumber

	^ categoriesList vScrollValue: aNumber! !

!CategoryWidget methodsFor: 'private' stamp: ''!
hasFocus
	
	^ categoriesList hasKeyboardFocus! !

!CategoryWidget methodsFor: 'item creation' stamp: 'NicolaiHess 8/9/2014 21:47'!
buildCategoriesList
	^ categoriesList := PluggableIconListMorph new
		basicWrapSelector: #categoryWrapper:;
		resetListSelector: #resetCategorySelection;
		keystrokeSelector: #keyPressedOnCategory:;
		autoDeselect: true;
		getListSizeSelector: #categoryListSize;
		
		dropItemSelector: #dropMethod:inARow:;
		dragEnabled: true; dropEnabled: true;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		
		getIconSelector: #categoryIconFor:; "WARNING: This needs to be set before the model"
		model: self;
		getIndexSelector: #selectedCategoryIndex;
		setIndexSelector: #selectedCategoryIndex:;
		getSelectionListSelector: #categorySelectionAt:;
		setSelectionListSelector: #categorySelectionAt:put:;
		getMenuSelector: #categoriesMenu:shifted:;
		beMultipleSelection;
		
		getListElementSelector: #getCategoryItem:;
		
		changed;
		
		yourself
	
! !

!CategoryWidget methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 4/25/2012 11:12'!
keyPressedOnCategory: anEvent
	| aCharacter |

	aCharacter := anEvent keyCharacter.

	(aCharacter == self model class nextFocusKey) ifTrue: [ ^ self model giveFocusTo: self model methodWidget ].
	(aCharacter == self model class previousFocusKey) ifTrue: [ ^ self model giveFocusTo: self model classWidget ].
	! !

!CategoryWidget methodsFor: 'protocol' stamp: 'NicolaiHess 8/9/2014 21:07'!
resetCategorySelection

	categoriesSelection removeAll! !

!CategoryWidget methodsFor: 'private' stamp: ''!
categoryListSize

	^ self getCategories size! !

!CategoryWidget methodsFor: 'private' stamp: ''!
categoriesLabel

	^ self showInstance
		ifTrue: ['Instance protocols:' asText]
		ifFalse: ['Class protocols:' asText allBold ]! !

!CategoryWidget methodsFor: 'private' stamp: ''!
deselectProtocol: aString

	categoriesSelection at: aString put: false! !

!CategoryWidget methodsFor: 'selection' stamp: 'BenjaminVanRyseghem 5/7/2012 14:37'!
categorySelectionAt: anIndex put: aBoolean
	| elt |
	
	elt := self getCategories at: anIndex ifAbsent: [ nil ].
	categoriesSelection at: elt put: aBoolean.
	self model categorySelectionChanged.
	^ aBoolean! !

!CategoryWidget methodsFor: 'accessing' stamp: ''!
model: aModel
	
	super model: aModel.
	self selectedCategory
		ifNotNil: [:cat | categoriesSelection at: cat put: true ]! !

!CategoryWidget class methodsFor: 'shortcuts' stamp: 'BenjaminVanRyseghem 4/6/2012 16:57'!
buildProtocolShortcutsOn: aBuilder
	<keymap>

	(aBuilder shortcut: #fullBrowse)
		category: #NautilusProtocolShortcuts
		default: $b command
		do: [ :target | target fullBrowse ]
		description: 'Open a new browser on the selection'.
		
	(aBuilder shortcut: #restrictedBrowseClass)
		category: #NautilusProtocolShortcuts
		default: $b command shift
		do: [ :target | target restrictedBrowseClass ]
		description: 'Open a restricted browser'.

	(aBuilder shortcut: #addProtocolsInGroup)
		category: #NautilusProtocolShortcuts
		default: $e command
		do: [ :target | target addProtocolsInGroup ]
		description: 'Add the selected protocols in a group'.
		
	(aBuilder shortcut: #findMethod)
		category: #NautilusProtocolShortcuts
		default: $f command
		do: [ :target | target findMethod ]
		description: 'Find a method'.
	
	(aBuilder shortcut: #addCategory)
		category: #NautilusProtocolShortcuts
		default: $n command
		do: [ :target | target addCategory ]
		description: 'Add a new protocol'.
	
	(aBuilder shortcut: #renameCategory)
		category: #NautilusProtocolShortcuts
		default: $r command
		do: [ :target | target enableCategorySingleSelection ifTrue: [target renameCategory ]]
		description: 'Rename the selected protocol'.
	
	(aBuilder shortcut: #removeCategories)
		category: #NautilusProtocolShortcuts
		default: $x command
		do: [ :target | target removeCategories ]
		description: 'Remove the selected protocols'.! !

!CategoryWidget class methodsFor: 'menu' stamp: 'SebastianTleye 8/30/2013 14:14'!
categoriesMenu: aBuilder
	<nautilusGlobalProtocolMenu>
	| target |
	
	target := aBuilder model.
	(aBuilder item: #'Find Method...')
		keyText: 'f, m' if: Nautilus useOldStyleKeys not;
		keyText: 'f' if: Nautilus useOldStyleKeys;
		action: [ target findMethod ];
		order: 0;
		help: 'Search for a method by name'.
			
	(aBuilder item: #'Add protocol...')
		keyText: 'n, t' if: Nautilus useOldStyleKeys not;
		action: [ target addCategory ];
		order: 100;
		withSeparatorAfter.
	
	(aBuilder item: #'Browse full')
		keyText: 'b, f' if: Nautilus useOldStyleKeys not;
		keyText: 'b' if: Nautilus useOldStyleKeys;
		action: [ target fullBrowse ];
		order: 200;
		withSeparatorAfter.
		
	(aBuilder item: #'Categorize all uncategorized')
		keyText: 'h, C' if: Nautilus useOldStyleKeys not;
		action: [ target categorizeAllUncategorizedMethods ];
		order: 1100.	
		
	(aBuilder item: #'Remove empty protocols')
		action: [ target removeEmptyCategories ];
		order: 1200;
		withSeparatorAfter.
		
	target selectedCategory ifNil: [ ^ target ].
	
	(aBuilder item: #'Rename...')
		keyText: 'r, t' if: Nautilus useOldStyleKeys not;
		keyText: 'r' if: Nautilus useOldStyleKeys;
		action: [ target renameCategory ];
		order: 1300;
		enabledBlock: [ target enableCategorySingleSelection ].	
		
	(aBuilder item: #'Remove...')
		keyText: 'x, t' if: Nautilus useOldStyleKeys not;
		keyText: 'x' if: Nautilus useOldStyleKeys;
		action: [ target removeCategories ];
		order: 1400;
		icon: (Smalltalk ui icons iconNamed: #removeIcon);
		withSeparatorAfter.
		
	(aBuilder item: #'Add in group...')
		action: [ target addProtocolsInGroup ];
		order: 1500.
	
	(aBuilder item: #'File Out')
		action: [ target fileOutCategories ];
		order: 1600.! !

!ChangeList commentStamp: 'StephaneDucasse 7/23/2010 21:17'!
A ChangeList represents a list of changed methods that reside on a file in fileOut format.  The classes and methods in my list are not necessarily in this image!!  Used as the model when changes are recovered.

It holds three lists:
	changeList - a list of ChangeRecords
	list - a list of one-line printable headers
	listSelections - a list of Booleans (true = selected, false = not selected) multiple OK.
	listIndex 
Items that are removed (removeDoits, remove an item) are removed from all three lists.
Most recently clicked item is the one showing in the bottom pane.!
!ChangeList methodsFor: 'accessing' stamp: ''!
file
	^file! !

!ChangeList methodsFor: 'scanning' stamp: 'MarcusDenker 4/28/2013 11:14'!
scanCategory: category class: class meta: meta stamp: stamp
	| itemPosition method selector |
	[itemPosition := file position.
	method := file nextChunk.
	file skipStyleChunk.
	method size > 0]						"done when double terminators"
		whileTrue:
		[self addItem: (ChangeRecord new file: file position: itemPosition type: #method
							class: class category: category meta: meta stamp: stamp)
			text: 'method: ' , class , (meta ifTrue: [' class '] ifFalse: [' '])
				, ((selector := (Smalltalk globals at: class ifAbsent: [Object]) compiler parseSelector: method) isNil
					ifTrue: ['unparsableSelector']
					ifFalse: [selector])
				, (stamp isEmpty ifTrue: [''] ifFalse: ['; ' , stamp])]! !

!ChangeList methodsFor: 'initialization-release' stamp: 'MarcusDenker 6/30/2014 11:33'!
optionalButtonRow
	"Answer a row of buttons to occur in a tool pane"

	| aRow |
	aRow := AlignmentMorph newRow.
	aRow hResizing: #spaceFill.
	aRow clipSubmorphs: true.
	aRow layoutInset: 2@2; cellInset: 3.
	aRow wrapCentering: #center; cellPositioning: #leftCenter.
	self changeListButtonSpecs do:
		[:triplet | | aButton |
			aButton := PluggableButtonMorph
				on: self
				getState: nil
				action: triplet second.
			aButton
				hResizing: #spaceFill;
				vResizing: #spaceFill;
				label: triplet first asString;
				askBeforeChanging: true;
				onColor: Color white offColor: Color white.

			aRow addMorphBack: aButton.
			aButton setBalloonText: triplet third].
	aRow addMorphBack: self regularDiffButton.
	aRow addMorphBack: self prettyDiffButton.
	^ aRow! !

!ChangeList methodsFor: 'menu actions' stamp: 'StephaneDucasse 10/22/2014 21:57'!
changeListMenu: aMenu
	"Fill aMenu up so that it comprises the primary changelist-browser menu"

	aMenu addTitle: 'Change list'.
	aMenu addStayUpItem.
	aMenu addAllFromPragma: 'changeListMenu' target: self.
	^aMenu ! !

!ChangeList methodsFor: 'menu actions' stamp: 'MarcusDenker 10/15/2013 18:10'!
browseVersions
	| change browser |
	listIndex = 0
		ifTrue: [^ nil ].
	change := changeList at: listIndex.
	change classIncludesSelector		
			ifFalse: [ ^nil ].
	browser := super browseVersions.
	browser ifNotNil: [ browser addedChangeRecord: change ].
	^browser! !

!ChangeList methodsFor: 'menu actions' stamp: 'MarcusDenker 9/24/2013 14:16'!
selectUnchangedMethods
	"Selects all method definitions for which there is already a method in the current image, whose source is exactly the same."
	
	Cursor read showWhile: 
	[ | change |1 to: changeList size do:
		[:i | change := changeList at: i.
		listSelections at: i put: change isUnchangedMethod]].
	self changed: #allSelections! !

!ChangeList methodsFor: 'viewing access' stamp: 'MarcusDenker 5/18/2013 15:44'!
contentsDiffedFromCurrent
	"Answer the contents diffed forward from current (in-memory) method version"

	| aChange aClass |
	listIndex = 0
		ifTrue: [^ ''].
	aChange := changeList at: listIndex.
	 (aChange type == #method
	 and: [(aClass := aChange methodClass) notNil
	 and: [aClass includesSelector: aChange methodSelector]]) ifTrue:
		[^TextDiffBuilder
			buildDisplayPatchFrom: (aClass sourceCodeAt: aChange methodSelector)
			to: aChange text
			inClass: aClass
			prettyDiffs: self showingPrettyDiffs].

	aChange type == #doIt ifTrue:
		[| tokens |
		 tokens := aChange string parseLiterals.
		 ((tokens select:
				[:substr| #(subclass: variableByteSubclass: variableWordSubclass:
							instanceVariableNames: classVariableNames: ) includes: substr])
					asSet size >= 3
		  and: [(aClass := Smalltalk globals at: tokens third ifAbsent: []) notNil
		  and: [aClass isBehavior]]) ifTrue:
			[^TextDiffBuilder buildDisplayPatchFrom: aClass definition to: aChange string].

		(tokens size = 4
		 and: [tokens second == #class
		 and: [tokens third == #instanceVariableNames:
		 and: [(aClass := Smalltalk globals at: tokens first ifAbsent: []) notNil
		 and: [aClass isBehavior]]]]) ifTrue:
			[^TextDiffBuilder buildDisplayPatchFrom: aClass class definition to: aChange string]].

	(aChange type == #classComment
	and: [(aClass := aChange commentClass) notNil]) ifTrue:
		[^TextDiffBuilder buildDisplayPatchFrom: aClass comment asString to: aChange string].

	^(changeList at: listIndex) text! !

!ChangeList methodsFor: 'menu actions' stamp: 'StephaneDucasse 7/23/2010 22:16'!
removeSelections
	"Remove the selected items from the receiver."

	| newChangeList newList |
	newChangeList := OrderedCollection new.
	newList := OrderedCollection new.
	1 to: changeList size do:
		[:i | (listSelections at: i) ifFalse:
			[newChangeList add: (changeList at: i).
			newList add: (list at: i)]].
	self refreshNewList: newChangeList andList: newList

	! !

!ChangeList methodsFor: 'menu actions' stamp: 'nice 1/5/2010 15:59'!
selectConflicts
	"Selects all method definitions for which there is ALSO an entry in changes"
	
	Cursor read showWhile: 
	[ | class change |1 to: changeList size do:
		[:i | change := changeList at: i.
		listSelections at: i put:
			(change type = #method
			and: [(class := change methodClass) notNil
			and: [(ChangeSet current atSelector: change methodSelector
						class: class) ~~ #none]])]].
	self changed: #allSelections! !

!ChangeList methodsFor: 'initialization' stamp: 'MarcusDenker 8/10/2014 11:20'!
initialize
	"Initialize a blank ChangeList.  Set the contentsSymbol to reflect whether diffs will be prettyPrinted or not"

	contentsSymbol := self defaultDiffsSymbol.
	changeList := OrderedCollection new.
	list := OrderedCollection new.
	listIndex := 0.
	super initialize! !

!ChangeList methodsFor: 'menu actions' stamp: 'StephaneDucasse 7/23/2010 22:00'!
changeListKey: aChar from: view
	"Respond to a Command key in the list pane."

	aChar == $D ifTrue: [ ^self toggleDiffing ].
	aChar == $a ifTrue: [ ^self selectAll ].
	^ self arrowKey: aChar from: view! !

!ChangeList methodsFor: 'initialization-release' stamp: 'sd 11/20/2005 21:26'!
addItem: item text: text
	| cr |
	cr := Character cr.
	changeList addLast: item.
	list addLast: (text collect: [:x | x = cr ifTrue: [$/] ifFalse: [x]])! !

!ChangeList methodsFor: 'viewing access' stamp: 'sd 11/20/2005 21:26'!
selectedClassOrMetaClass
	| c |
	^ (c := self currentChange) ifNotNil: [c methodClass]! !

!ChangeList methodsFor: 'menu actions' stamp: 'CamilloBruni 8/1/2012 16:15'!
removeDoIts
	"Remove doits from the receiver, other than initializes."

	self removeRecordsWhere: 
		[:record :displayString | 
			record type = #doIt and: [(displayString endsWith: 'initialize') not]]! !

!ChangeList methodsFor: 'accessing' stamp: 'sd 11/20/2005 21:26'!
changes: changeRecords file: aFile
	file := aFile.
	changeList := OrderedCollection new.
	list := OrderedCollection new.
	listIndex := 0.
	changeRecords do: [:each |
		(each respondsTo: #methodClass)
			ifFalse: [self addItem: ChangeRecord new text: each asString]
			ifTrue:
				[self addItem: each text: ('method: ' , each methodClass name , (each isMetaClassChange ifTrue: [' class '] ifFalse: [' '])
					, each methodSelector
					, '; ' , each stamp)]].
	listSelections := Array new: list size withAll: false! !

!ChangeList methodsFor: 'menu actions' stamp: 'StephaneDucasse 7/23/2010 22:37'!
selectMethodsForExtantClasses
	"Select methods for classes which are in the current image"
	
	^self selectSuchThat:
		[ :change | Smalltalk globals hasClassNamed: change methodClassName]! !

!ChangeList methodsFor: 'menu actions' stamp: 'StephaneDucasse 7/23/2010 22:12'!
refreshNewList: newChangeList andList: newList

	newChangeList size < changeList size
		ifTrue:
			[changeList := newChangeList.
			list := newList.
			listIndex := 0.
			listSelections := Array new: list size withAll: false].
	self changed: #list


! !

!ChangeList methodsFor: 'menu actions' stamp: 'HenrikSperreJohansen 9/12/2010 10:54'!
removeOlderMethodVersions
	"Remove older versions of entries from the receiver."
	| equivalent toRemove|

	equivalent := Dictionary new.
	toRemove := Set new.
	changeList with: list do:
		[:change :displayString | 
			(equivalent at: (displayString copyUpTo: $;) ifAbsentPut: [OrderedCollection new.]) add: change ].
	equivalent do: #removeLast.
	equivalent do: [:each | toRemove addAll: each].
	self removeRecordsWhere: [:change | toRemove includes: change]! !

!ChangeList methodsFor: 'accessing' stamp: 'ls 5/12/1999 07:55'!
currentChange
	"return the current change being viewed, or nil if none"
	listIndex = 0 ifTrue: [ ^nil ].
	^changeList at: listIndex! !

!ChangeList methodsFor: 'viewing access' stamp: ''!
list
	^ list! !

!ChangeList methodsFor: 'viewing access' stamp: 'sw 11/13/2001 09:12'!
contentsSymbolQuints
	"Answer a list of quintuplets representing information on the alternative views available in the code pane"

	^ self sourceAndDiffsQuintsOnly! !

!ChangeList methodsFor: 'menu actions' stamp: 'MarcusDenker 9/24/2013 14:17'!
selectConflicts: changeSetOrList
	"Selects all method definitions for which there is ALSO an entry in the specified changeSet or changList"
	Cursor read showWhile: 
	[ | change class |(changeSetOrList isKindOf: ChangeSet) ifTrue: [
	1 to: changeList size do:
		[:i | change := changeList at: i.
		listSelections at: i put:
			(change type = #method
			and: [(class := change methodClass) notNil
			and: [(changeSetOrList atSelector: change methodSelector
						class: class) ~~ #none]])]]
	ifFalse: ["a ChangeList"
	1 to: changeList size do:
		[:i | change := changeList at: i.
		listSelections at: i put:
			(change type = #method
			and: [(class := change methodClass) notNil
			and: [changeSetOrList list includes: (list at: i)]])]]
	].
	self changed: #allSelections! !

!ChangeList methodsFor: 'accessing' stamp: ''!
changeList
	^ changeList! !

!ChangeList methodsFor: 'menu actions' stamp: 'sd 11/20/2005 21:26'!
selectSuchThat: aBlock
	"select all changes for which block returns true"
	listSelections := changeList collect: [ :change | aBlock value: change ].
	self changed: #allSelections! !

!ChangeList methodsFor: 'viewing access' stamp: 'sd 11/20/2005 21:26'!
selectedMessageName
	| c |
	^ (c := self currentChange) ifNotNil: [c methodSelector]! !

!ChangeList methodsFor: 'viewing access' stamp: ''!
listSelectionAt: index
	^ listSelections at: index! !

!ChangeList methodsFor: 'viewing access' stamp: 'sw 1/25/1999 14:45'!
undiffedContents
	^ listIndex = 0
		ifTrue: ['']
		ifFalse: [(changeList at: listIndex) text]! !

!ChangeList methodsFor: 'menu actions' stamp: 'MarcusDenker 5/2/2013 11:24'!
selectSuchThat
	"query the user for a selection criterium.  NB: the UI for invoking this from a changelist browser is currently commented out; to reenfranchise it, you'll need to mild editing to ChangeList method #changeListMenu:"
	
	| code block |
	code := UIManager default request: 'selection criteria for a change named aChangeRecord?\For instance, ''aChangeRecord category = ''System-Network''''' withCRs.
	code isEmptyOrNil ifTrue: [^ self ].
	block := self class compiler evaluate: '[:aChangeRecord | ', code, ']'.
	self selectSuchThat: block! !

!ChangeList methodsFor: 'menu actions' stamp: 'sd 11/20/2005 21:26'!
selectAll
	listIndex := 0.
	listSelections atAllPut: true.
	self changed: #allSelections! !

!ChangeList methodsFor: 'scanning' stamp: 'MarcusDenker 5/18/2013 15:44'!
scanCategory  
	"Scan anything that involves more than one chunk; method name is historical only"

	| itemPosition item tokens stamp anIndex |
	itemPosition := file position.
	item := file nextChunk.

	((item includesSubstring: 'commentStamp:')
	or: [(item includesSubstring: 'methodsFor:')
	or: [item endsWith: 'reorganize']]) ifFalse:
		["Maybe a preamble, but not one we recognize; bail out with the preamble trick"
		^ self addItem: (ChangeRecord new file: file position: itemPosition type: #preamble)
				 text: ('preamble: ' , item contractTo: 50)].

	tokens := item parseLiterals.
	tokens size >= 3 ifTrue:
		[stamp := ''.
		anIndex := tokens indexOf: #stamp: ifAbsent: [nil].
		anIndex ifNotNil: [stamp := tokens at: (anIndex + 1)].

		tokens second == #methodsFor:
			ifTrue: [^ self scanCategory: tokens third class: tokens first
							meta: false stamp: stamp].
		tokens third == #methodsFor:
			ifTrue: [^ self scanCategory: tokens fourth class: tokens first
							meta: true stamp: stamp]].

	tokens second == #commentStamp:
		ifTrue:
			[stamp := tokens third.
			self addItem:
					(ChangeRecord new file: file position: file position type: #classComment
									class: tokens first category: nil meta: false stamp: stamp)
					text: 'class comment for ' , tokens first, 
						  (stamp isEmpty ifTrue: [''] ifFalse: ['; ' , stamp]).
			file nextChunk.
			^ file skipStyleChunk].

	self assert: tokens last == #reorganize.
	self addItem:
		(ChangeRecord new
			file: file position: file position type: #reorganize
			class: tokens first category: nil meta: false stamp: stamp)
		text: 'organization for ' , tokens first, (tokens second == #class ifTrue: [' class'] ifFalse: ['']).
	file nextChunk! !

!ChangeList methodsFor: 'initialization-release' stamp: 'tbn 7/6/2010 16:46'!
changeListButtonSpecs

	^#(
		('Select all' 			selectAll				'select all entries')
		('Deselect all'		deselectAll			'deselect all entries')
		('Select conflicts'	selectAllConflicts	'select all methods that occur in any change set')
		('File in selections' 	fileInSelections		'file in all selected entries')
		)! !

!ChangeList methodsFor: 'menu actions' stamp: 'sd 11/20/2005 21:26'!
invertSelections
	"Invert the selectedness of each item in the changelist"

	listSelections := listSelections collect: [ :ea | ea not].
	listIndex := 0.
	self changed: #allSelections.
	self contentsChanged! !

!ChangeList methodsFor: 'menu actions' stamp: 'sd 11/20/2005 21:26'!
fileInSelections 
	| any |
	any := false.
	listSelections with: changeList do: 
		[:selected :item | selected ifTrue: [any := true. item fileIn]].
	any ifFalse:
		[self inform: 'nothing selected, so nothing done']! !

!ChangeList methodsFor: 'menu actions' stamp: 'StephaneDucasse 11/6/2011 12:48'!
compareToCurrentVersion
	"If the current selection corresponds to a method in the system, then spawn a window showing the diffs as text"

	| change class s1 s2 |
	listIndex = 0 ifTrue: [^ self].
	change := changeList at: listIndex.
	((class := change methodClass) notNil
			and: [ class includesSelector: change methodSelector])
		ifTrue: [ s1 := (class sourceCodeAt: change methodSelector) asString.
			s2 := change string.
			s1 = s2
				ifTrue: [ self inform: 'Exact Match']
				ifFalse: [ UIManager default
					openComparisonFrom: s2
					to: s1
					belongingTo: class
					from: change
					labeled: (class compiledMethodAt: change methodSelector) timeStamp 
					inWindowLabeled: 'Comparison to Current Version' ]]					
		ifFalse: [self flash]! !

!ChangeList methodsFor: 'viewing access' stamp: 'sd 11/20/2005 21:26'!
annotation
	"Answer the string to be shown in an annotation pane.  Make plain that the annotation is associated with the current in-image version of the code, not of the selected disk-based version, and if the corresponding method is missing from the in-image version, mention that fact."

	| annot aChange aClass |

	annot := super annotation.
	annot asString = '------' ifTrue: [^ annot].

	^ ((aChange := self currentChange) notNil and: [aChange methodSelector notNil])
		ifFalse:
			[annot]
		ifTrue:
			[((aClass := aChange methodClass) isNil or: [(aClass includesSelector: aChange methodSelector) not])
				ifTrue:
					[aChange methodClassName, ' >> ', aChange methodSelector, ' is not present in the current image.']
				ifFalse:
					['current version: ', annot]]! !

!ChangeList methodsFor: 'menu actions' stamp: 'HenrikSperreJohansen 9/12/2010 10:37'!
removeRecordsWhere: aBlock
	"Remove records for which the block returns true."

	| newChangeList newList |

	newChangeList := OrderedCollection new.
	newList := OrderedCollection new.

	changeList with: list do:
		[:record :textualDescription |
		(aBlock cull: record cull: textualDescription)
					ifFalse:
						[newChangeList add: record.
						newList add: textualDescription]].
	newChangeList size < changeList size
		ifTrue:
			[changeList := newChangeList.
			list := newList.
			listIndex := 0.
			listSelections := Array new: list size withAll: false].
	self changed: #list.! !

!ChangeList methodsFor: 'menu actions' stamp: 'StephaneDucasse 5/28/2011 13:31'!
browseAllVersionsOfSelections
	"Opens a Versions browser on all the currently selected methods, showing each alongside all of their historical versions."
	
	|  oldSelection aList |
	oldSelection := self listIndex.
	aList := OrderedCollection new.
	Cursor read showWhile: [
		1 to: changeList size do: [:i |
			(listSelections at: i) ifTrue: [
				listIndex := i.
				self browseVersions.
				aList add: i. ]]].
	listIndex := oldSelection.

	aList size = 0 ifTrue: [^ self inform: 'no selected methods have in-memory counterparts'].
! !

!ChangeList methodsFor: 'menu actions' stamp: 'StephaneDucasse 7/23/2010 21:08'!
selectAllConflicts
	"Selects all method definitions in the receiver which are also in any existing change set in the system.  This makes no statement about whether the content of the methods differ, only whether there is a change represented."

	Cursor read showWhile: 
		[ | aChange aClass |
		1 to: changeList size do:
			[:i | aChange := changeList at: i.
			listSelections at: i put:
				(aChange type = #method
				and: [(aClass := aChange methodClass) notNil
				and: [ChangeSet doesAnyChangeSetHaveClass: aClass andSelector:  aChange methodSelector]])]].
	self changed: #allSelections! !

!ChangeList methodsFor: 'viewing access' stamp: 'di 1/13/1999 14:59'!
listSelectionAt: index put: value

	^ listSelections at: index put: value! !

!ChangeList methodsFor: 'viewing access' stamp: 'AlainPlantec 11/13/2009 23:16'!
toggleListIndex: newListIndex

	listIndex ~= 0 ifTrue: [listSelections at: listIndex put: false].
	newListIndex ~= 0 ifTrue: [listSelections at: newListIndex put: true].
	listIndex := newListIndex.
	self changed: #listIndex.
	self contentsChanged! !

!ChangeList methodsFor: 'menu actions' stamp: 'MarcusDenker 5/18/2013 15:44'!
selectUnchangedDefinitions
	"Selects all recognizable definitions for which there is already a definition in the current image, whose source is exactly the same."
	| change class tokens |
	Cursor read showWhile: 
	[1 to: changeList size do:
		[:i | change := changeList at: i.
		listSelections at: i put: false.

		(change type = #method
		 and: [(class := change methodClass) notNil
		 and: [class includesSelector: change methodSelector]]) ifTrue:
			[listSelections
				at: i
				put: change string withBlanksCondensed
					= (class sourceCodeAt: change methodSelector) asString withBlanksCondensed].

		(change type == #classComment
		and: [(class := change commentClass) notNil]) ifTrue:
			[listSelections at: i put: change string = class comment asString].

		change type == #doIt ifTrue:
			[tokens := change string parseLiterals.

			 ((tokens select:
				[:substr| #(subclass: variableSubclass: variableByteSubclass: variableWordSubclass:
							instanceVariableNames: classVariableNames: ) includes: substr])
					asSet size >= 3
			 and: [(class := Smalltalk globals at: tokens third ifAbsent: []) notNil
			 and: [class isBehavior]]) ifTrue:
				[listSelections
					at: i
					put: change string withBlanksCondensed
						= class definition withBlanksCondensed].

			(tokens size = 4
			 and: [tokens second == #class
			 and: [tokens third == #instanceVariableNames:
			 and: [(class := Smalltalk globals at: tokens first ifAbsent: []) notNil
			 and: [class isBehavior]]]]) ifTrue:
				[listSelections
					at: i
					put: change string withBlanksCondensed
						= class class definition withBlanksCondensed].

			(tokens size = 3
			 and: [tokens second == #removeSelector:
			 and: [(class := Smalltalk at: tokens first ifAbsent: []) isNil
			 	or: [class isBehavior and: [(class includesSelector: tokens third) not]]]]) ifTrue:
				[listSelections at: i put: true].

			(tokens size = 4
			 and: [tokens second == #class
			 and: [tokens third == #removeSelector:
			 and: [(class := Smalltalk at: tokens first ifAbsent: []) isNil
			 	or: [class isBehavior and: [(class class includesSelector: tokens fourth) not]]]]]) ifTrue:
				[listSelections at: i put: true]]]].

	self changed: #allSelections! !

!ChangeList methodsFor: 'menu actions' stamp: 'EstebanLorenzano 8/17/2012 16:41'!
selectContentsMatching
	| pattern |
	pattern := UIManager default request: 'pattern to match'.
	pattern isEmpty ifTrue: [^self].
	^Cursor execute showWhile:
		[self selectSuchThat: ((pattern includesAnyOf: '?*')
								ifTrue: [ [:change | pattern match: change string]]
								ifFalse: [ [:change | change string includesSubstring: pattern]])]! !

!ChangeList methodsFor: 'viewing access' stamp: 'nk 2/26/2004 13:50'!
selectedClass
	^(self selectedClassOrMetaClass ifNil: [ ^nil ]) theNonMetaClass ! !

!ChangeList methodsFor: 'menu actions' stamp: 'IgorStasenko 3/6/2011 18:18'!
selectConflictsWith
	"Selects all method definitions for which there is ALSO an entry in the specified changeSet or changList chosen by the user."
	| aStream all index |
	aStream := (String new: 200) writeStream.
	(all := ChangeSet allChangeSets copy) do:
		[:sel | aStream nextPutAll: (sel name contractTo: 40); cr].
	self allSubInstancesDo:
		[:sel | aStream nextPutAll: (sel file name); cr.
			all addLast: sel].
	aStream skip: -1.
	index := (UIManager default chooseFrom: (aStream contents substrings)).
	index > 0 ifTrue: [
		self selectConflicts: (all at: index)].
! !

!ChangeList methodsFor: 'menu actions' stamp: 'sd 11/20/2005 21:26'!
deselectAll 
	"Deselect all items in the list pane, and clear the code pane"

	listIndex := 0.
	listSelections atAllPut: false.
	self changed: #allSelections.
	self contentsChanged! !

!ChangeList methodsFor: 'menu actions' stamp: 'MarcusDenker 7/28/2014 21:25'!
browseCurrentVersionsOfSelections
	"Opens a message-list browser on the current in-memory versions of all methods that are currently seleted"
	
	| aList  |
	aList := OrderedCollection new.
		1 to: changeList size do: [:i |
			(listSelections at: i) ifTrue: [ | aChange |
				aChange := changeList at: i.
			 	aChange methodClass notNil
					and: [aChange isMethodDefinedInImage
								ifTrue: [ aList add: aChange asRingDefinition]]]].
	aList isEmpty ifTrue: [^ self inform: 'no selected methods have in-memory counterparts'].
	Smalltalk tools messageList
		browse: aList 
		title: 'Current versions of selected methods in ', file localName
! !

!ChangeList methodsFor: 'menu actions' stamp: 'StephaneDucasse 7/23/2010 22:37'!
selectMethodsForThisClass
	| name |
	self currentChange ifNil: [ ^self ].
	name := self currentChange methodClassName.
	name ifNil: [ ^self ].
	^self selectSuchThat: [ :change | change methodClassName = name ].! !

!ChangeList methodsFor: 'scanning' stamp: 'SeanDeNigris 6/21/2012 08:41'!
scanFile: aFile from: startPosition to: stopPosition
	
	file := aFile.
	changeList := OrderedCollection new.
	list := OrderedCollection new.
	listIndex := 0.
	file position: startPosition.
'Scanning ', aFile localName, '...'
	displayProgressFrom: startPosition to: stopPosition
	during: [:bar | | item prevChar itemPosition |
	[file position < stopPosition]
		whileTrue:
		[bar current: file position.
		[file atEnd not and: [file peek isSeparator]]
				whileTrue: [prevChar := file next].
		(file peekFor: $!!)
		ifTrue:
			[(prevChar = Character cr or: [prevChar = Character lf])
				ifTrue: [self scanCategory]]
		ifFalse:
			[itemPosition := file position.
			item := file nextChunk.
			file skipStyleChunk.
			item size > 0 ifTrue:
				[self addItem: (ChangeRecord new file: file position: itemPosition type: #doIt)
					text: 'do it: ' , (item contractTo: 50)]]]].
	listSelections := Array new: list size withAll: false! !

!ChangeList methodsFor: 'menu actions' stamp: 'PeterHugossonMiller 9/3/2009 00:17'!
fileOutSelections 
	| fileName internalStream |
	fileName := UIManager default request: 'Enter the base of file name' initialAnswer: 'Filename'.
	internalStream := (String new: 1000) writeStream.
	internalStream header; timeStamp.
	listSelections with: changeList do: 
		[:selected :item | selected ifTrue: [item fileOutOn: internalStream]].

	FileStream writeSourceCodeFrom: internalStream baseName: fileName isSt: true
! !

!ChangeList methodsFor: 'viewing access' stamp: ''!
listIndex
	^ listIndex! !

!ChangeList methodsFor: 'menu actions' stamp: 'MarcusDenker 4/28/2013 11:13'!
removeExistingMethodVersions
	"Remove all up to date version of entries from the receiver"
	
	| newChangeList newList |
	newChangeList := OrderedCollection new.
	newList := OrderedCollection new.

	changeList with: list do: [ :chRec :strNstamp | 
			| str keep sel cls | 
			keep := true.
			(cls := chRec methodClass) ifNotNil:
				[ str := chRec string.
				sel := cls compiler parseSelector: str.
				keep := (cls sourceCodeAt: sel ifAbsent: ['']) asString ~= str].
			keep ifTrue:
					[ newChangeList add: chRec.
					newList add: strNstamp]].
	self refreshNewList: newChangeList andList: newList! !

!ChangeList methodsFor: 'menu actions' stamp: 'MarcusDenker 10/15/2013 18:13'!
selectNewMethods
	"Selects all method definitions for which there is no counterpart method in the current image"

	Cursor read showWhile: 
		[ | change |
		1 to: changeList size do:
			[:i | change := changeList at: i.
			listSelections at: i put: change isMethodNotDefinedInImage]].
	self changed: #allSelections! !

!ChangeList methodsFor: 'menu actions' stamp: 'MarianoMartinezPeck 4/27/2012 14:08'!
buildMorphicCodePaneWith: editString

	| codePane |
	codePane := (PluggableTextMorph
		on: self
		text: #contents 
		accept: nil
		readSelection: #contentsSelection 
		menu: #codePaneMenu:shifted:) 
		enabled: false;
		yourself.
	codePane font: StandardFonts codeFont.
	editString ifNotNil: [
		codePane editString: editString.
		codePane hasUnacceptedEdits: true ].
	^codePane
! !

!ChangeList methodsFor: 'viewing access' stamp: 'MarcusDenker 6/30/2014 11:31'!
contents: aString
	listIndex = 0 ifTrue: [self changed: #flash. ^ false].
	self okToChange "means not dirty" ifFalse: ["is dirty"
		self inform: 'This is a view of a method on a file.\Please cancel your changes.  You may\accept, but only when the method is untouched.' withCRs.  ^ false].
		"Can't accept changes here.  Method text must be unchanged!!"
	(changeList at: listIndex) fileIn.
	^ true! !

!ChangeList methodsFor: 'menu actions' stamp: 'StephaneDucasse 5/28/2011 13:32'!
removeNonSelections
	"Remove the unselected items from the receiver."

	| newChangeList newList |
	newChangeList := OrderedCollection new.
	newList := OrderedCollection new.

	1 to: changeList size do:
		[ :i | (listSelections at: i)
			ifTrue:
				[ newChangeList add: (changeList at: i).
				newList add: (list at: i) ]].
	newChangeList size = 0 
		ifTrue: [^ self inform: 'That would remove everything.
Why would you want to do that?'].
	
	self refreshNewList: newChangeList andList: newList.
	
	! !

!ChangeList methodsFor: 'viewing access' stamp: 'MarcusDenker 6/30/2014 11:36'!
contents
	"Answer the contents string, obeying diffing directives if needed"

	^ self showingAnyKindOfDiffs
		ifFalse: [self undiffedContents]
		ifTrue: [self contentsDiffedFromCurrent]! !

!ChangeList methodsFor: 'initialization-release' stamp: 'MarcusDenker 7/27/2014 08:44'!
openAsMorphName: labelString 
	"Open a morphic view for the messageSet, whose label is labelString. 
	The listView may be either single or multiple selection type"

	"Open a morphic view for the messageSet, whose label is labelString. 
	The listView may be either single or multiple selection type"
	| window listHeight listPane |
	listHeight := 0.4.
	window := (SystemWindow labelled: labelString)
				model: self.
	listPane := PluggableListMorph
						on: self
						list: #list
						primarySelection: #listIndex
						changePrimarySelection: #toggleListIndex:
						listSelection: #listSelectionAt:
						changeListSelection: #listSelectionAt:put:
						menu: #changeListMenu:.
	listPane keystrokeActionSelector: #changeListKey:from:.
	window
		addMorph: listPane
		frame: (0 @ 0 extent: 1 @ listHeight).
	self
		addLowerPanesTo: window
		at: (0 @ listHeight corner: 1 @ 1)
		with: nil.
	^ window openInWorld
! !

!ChangeList class methodsFor: 'System-FileRegistry' stamp: 'CamilloBruni 2/3/2013 17:21'!
fileReaderServicesForFile: fullName suffix: suffix
	<fileService>
	| services |
	services := OrderedCollection new.
	(FileStream isSourceFileSuffix: suffix) | (suffix = '*')
		ifTrue: [ services add: self serviceBrowseChangeFile ].
	(suffix = 'changes') | (suffix = '*')
		ifTrue: [ services add: self serviceBrowseDotChangesFile ].
	(fullName asLowercase endsWith: '.cs.gz') | (suffix = '*')
		ifTrue: [ services add: self serviceBrowseCompressedChangeFile ].
	^services! !

!ChangeList class methodsFor: 'System-FileRegistry' stamp: 'MarcusDenker 6/14/2014 12:18'!
browseCompressedChangesFile: fullName
	"Browse the selected file in fileIn format."

	| unzipped stream |
	fullName ifNil: [ ^ self inform: 'Missing file name' ].
	stream := FileStream readOnlyFileNamed: fullName.
	unzipped := [ 
	| zipped |
	stream converter: Latin1TextConverter new.
	zipped := GZipReadStream on: stream.
	zipped contents asString ]
		ensure: [ stream close ].
	stream := (MultiByteBinaryOrTextStream with: unzipped) reset.
	self browseStream: stream! !

!ChangeList class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
taskbarIcon
	"Answer the icon for the receiver in a task bar."

	^ Smalltalk ui icons smallSaveIcon! !

!ChangeList class methodsFor: 'menu' stamp: 'MarcusDenker 10/16/2013 10:38'!
changeListMenu: aBuilder
	<contextMenu>
	<changeListMenu>
	
	| target |
	
	target := aBuilder model.
	
	(aBuilder item: #'FileIn selections')
		help: 'Import the selected items into the image';
		target: target;
		selector: #fileInSelections.
	(aBuilder item: #'FileOut selections...')
		help: 'Create a new file containing the selected items';
		target: target;
		selector: #fileOutSelections;
		withSeparatorAfter.
	
	(aBuilder item: #'Compare to current')
		help: 'Open a separate window which shows the text differences between the on-file version and the in-image version';
		target: target;
		selector: #compareToCurrentVersion.
	(aBuilder item: #'Toggle diffing')
		keyText: 'D';
		help: 'Start or stop showing diffs in the code pane';
		target: target;
		selector: #toggleDiffing;
		withSeparatorAfter.
		
	(aBuilder item: #'Select conflicts with any changeset')
		help: 'Select methods in the file which also occur in any change-set in the system';
		target: target;
		selector: #selectAllConflicts.
	(aBuilder item: #'Select conflicts with current changeset')
		help: 'Select methods in the file which also occur in the current change-set';
		target: target;
		selector: #selectConflicts.
	(aBuilder item: #'Select conflicts with...')
		help: 'Allows you to designate a file or change-set against which to check for code conflicts';
		target: target;
		selector: #selectConflictsWith;
		withSeparatorAfter.
		
	(aBuilder item: #'Select unchanged definitions')
		help: 'Select class definitions, class comments and methods in the file whose in-image versions are the same as their in-file counterparts';
		target: target;
		selector: #selectUnchangedDefinitions.
	(aBuilder item: #'Select unchanged methods')
		help: 'Select methods in the file whose in-image versions are the same as their in-file counterparts';
		target: target;
		selector: #selectUnchangedMethods.
	(aBuilder item: #'Select new methods')
		help: 'Select methods in the file that do not current occur in the image';
		target: target;
		selector: #selectNewMethods.
	(aBuilder item: #'Select methods for this class')
		help: 'Select all methods in the file that belong to the currently-selected class';
		target: target;
		selector: #selectMethodsForThisClass.
	(aBuilder item: #'Select methods for classes in image')
		help: 'Select all methods in the file that belong to a class that exists in the image';
		target: target;
		selector: #selectMethodsForExtantClasses.
	(aBuilder item: #'Select changes with contents matching')
		help: 'Select all changes in the file whose text includes a pattern';
		target: target;
		selector: #selectContentsMatching;
		withSeparatorAfter.
		
	(aBuilder item: #'Select all')
		keyText: 'a';
		help: 'Select all the items in the list';
		target: target;
		selector: #selectAll.
	(aBuilder item: #'Deselect all')
		help: 'Deselect all the items in the list';
		target: target;
		selector: #deselectAll.
	(aBuilder item: #'Invert selections')
		help: 'Select every item that is not currently selected, and deselect every item that *is* currently selected';
		target: target;
		selector: #invertSelections;
		withSeparatorAfter.
		
	(aBuilder item: #'Browse all versions of single selection')
		help: 'Open a version browser showing the versions of the currently selected method';
		target: target;
		selector: #browseVersions.
	(aBuilder item: #'Browse all versions of selections')
		help: 'Open a version browser showing all the versions of all the selected methods';
		target: target;
		selector: #browseAllVersionsOfSelections.
	(aBuilder item: #'Browse current versions of selections')
		help: 'Open a message-list browser showing the current (in-image) counterparts of the selected methods';
		target: target;
		selector: #browseCurrentVersionsOfSelections.
		
	(aBuilder item: #'Remove doIts')
		help: 'Remove all items that are doIts rather than methods';
		target: target;
		selector: #removeDoIts.
	(aBuilder item: #'Remove older versions')
		help: 'Remove all but the most recent versions of methods in the list';
		target: target;
		selector: #removeOlderMethodVersions.
	(aBuilder item: #'Remove up-to-date versions')
		help: 'Remove all items whose code is the same as the counterpart in-image code';
		target: target;
		selector: #removeExistingMethodVersions.
	(aBuilder item: #'Remove selected items')
		help: 'Remove the selected items from the change-list';
		target: target;
		selector: #removeSelections.
	(aBuilder item: #'Remove unselected items')
		help: 'Remove all the items not currently selected from the change-list';
		target: target;
		selector: #removeNonSelections.
! !

!ChangeList class methodsFor: 'public access' stamp: 'ClementBera 7/26/2013 16:13'!
browseRecentLogOn: origChangesFile startingFrom: initialPos 
	"Prompt with a menu of how far back to go when browsing a changes file."

	| end banners positions pos chunk i changesFile |
	changesFile := origChangesFile readOnlyCopy.
	banners := OrderedCollection new.
	positions := OrderedCollection new.
	end := changesFile size.
	changesFile setConverterForCode.
	pos := initialPos.
	[pos = 0
		or: [banners size > 20]]
		whileFalse: [changesFile position: pos.
			chunk := changesFile nextChunk.
			i := chunk indexOfSubCollection: 'priorSource: ' startingAt: 1.
			i > 0
				ifTrue: [positions addLast: pos.
					banners
						addLast: (chunk copyFrom: 5 to: i - 2).
					pos := Number
								readFrom: (chunk copyFrom: i + 13 to: chunk size)]
				ifFalse: [pos := 0]].
	changesFile close.
	banners size = 0 ifTrue: [^ self inform: 
'this image has never been saved
since changes were compressed' translated].
	pos := UIManager default chooseFrom:  banners values: positions title: 'Browse as far back as...' translated.
	pos ifNil: [^ self].
	self browseRecent: end - pos on: origChangesFile! !

!ChangeList class methodsFor: 'System-FileRegistry' stamp: 'tbn 8/11/2010 10:11'!
serviceBrowseDotChangesFile
	"Answer a service for opening a changelist browser on the tail end of a .changes file"

	^ SimpleServiceEntry 
		provider: self 
		label: 'Recent changes in file'
		selector: #browseRecentLogOnPath:
		description: 'Open a changelist tool on recent changes in file'
		buttonLabel: 'Recent changes'! !

!ChangeList class methodsFor: 'instance creation' stamp: 'StephaneDucasse 7/20/2014 21:43'!
browseChangesFile: fullName
    "Browse the selected file in fileIn format."

    fullName
        ifNotNil:
            [self browseStream: (FileStream readOnlyFileNamed:  fullName)]
        ifNil:
            [self inform: 'Missing file name' ]! !

!ChangeList class methodsFor: 'System-FileRegistry' stamp: 'nk 12/13/2002 12:04'!
services
	"Answer potential file services associated with this class"

	^ { self serviceBrowseChangeFile. 
		self serviceBrowseDotChangesFile.
		self serviceBrowseCompressedChangeFile }! !

!ChangeList class methodsFor: 'public access' stamp: 'tak 9/25/2008 16:25'!
browseRecent: charCount 
	"ChangeList browseRecent: 5000"
	"Opens a changeList on the end of the changes log file"
	"The core was moved to browserRecent:on:."
	^ self browseRecent: charCount on: (SourceFiles at: 2) ! !

!ChangeList class methodsFor: 'initialize-release' stamp: 'GabrielOmarCotelli 6/4/2009 20:38'!
initialize

	FileServices registerFileReader: self! !

!ChangeList class methodsFor: 'public access' stamp: 'StephaneDucasse 3/17/2010 20:53'!
browseRecentLog
	"ChangeList browseRecentLog"
	"Prompt with a menu of how far back to go to browse the current image's changes log file"
	^ self
		browseRecentLogOn: (SourceFiles at: 2)
		startingFrom: Smalltalk lastQuitLogPosition! !

!ChangeList class methodsFor: 'public access' stamp: 'onierstrasz 11/11/2013 12:21'!
browseRecentLogOnPath: fullName 
	"figure out where the last snapshot or quit was, then browse the recent  entries."

	fullName
		ifNotNil:
			[self browseRecentLogOn: (FileStream readOnlyFileNamed: fullName)]
		ifNil:
			[self inform: 'Missing file name' ]
	! !

!ChangeList class methodsFor: 'tool registry' stamp: 'IgorStasenko 2/20/2011 14:41'!
registerToolsOn: registry

	registry register: self as: #changeList ! !

!ChangeList class methodsFor: 'public access' stamp: 'di 1/18/2001 15:30'!
browseFile: fileName    "ChangeList browseFile: 'AutoDeclareFix.st'"
	"Opens a changeList on the file named fileName"

	^ self browseStream: (FileStream readOnlyFileNamed: fileName)! !

!ChangeList class methodsFor: 'initialization' stamp: 'GabrielOmarCotelli 6/4/2009 20:38'!
unload

	FileServices unregisterFileReader: self ! !

!ChangeList class methodsFor: 'System-FileRegistry' stamp: 'tbn 8/11/2010 10:11'!
serviceBrowseCompressedChangeFile
	"Answer a service for opening a changelist browser on a file"

	^ SimpleServiceEntry 
		provider: self 
		label: 'Changelist browser'
		selector: #browseCompressedChangesFile:
		description: 'Open a changelist tool on this file'
		buttonLabel: 'Changes'! !

!ChangeList class methodsFor: 'public access' stamp: 'MarcusDenker 7/27/2014 08:44'!
browseRecent: charCount on: origChangesFile 
	"Opens a changeList on the end of the specified changes log file"
	| changeList end changesFile |
	changesFile := origChangesFile readOnlyCopy.
	changesFile setConverterForCode.
	end := changesFile size.
	Cursor read
		showWhile: [changeList := self new
						scanFile: changesFile
						from: (0 max: end - charCount)
						to: end].
	changesFile close.
	changeList openAsMorphName:  'Recent changes'
	! !

!ChangeList class methodsFor: 'public access' stamp: 'sd 11/20/2005 21:28'!
browseRecentLogOn: origChangesFile 
	"figure out where the last snapshot or quit was, then browse the recent entries."

	| end done block pos chunk changesFile positions prevBlock |
	changesFile := origChangesFile readOnlyCopy.
	positions := SortedCollection new.
	end := changesFile size.
	prevBlock := end.
	block := end - 1024 max: 0.
	done := false.
	[done
		or: [positions size > 0]]
		whileFalse: [changesFile position: block.
			"ignore first fragment"
			changesFile nextChunk.
			[changesFile position < prevBlock]
				whileTrue: [pos := changesFile position.
					chunk := changesFile nextChunk.
					((chunk indexOfSubCollection: '----' startingAt: 1) = 1) ifTrue: [
						({ '----QUIT'. '----SNAPSHOT' } anySatisfy: [ :str |
							chunk beginsWith: str ])
								ifTrue: [positions add: pos]]].
			block = 0
				ifTrue: [done := true]
				ifFalse: [prevBlock := block.
					block := block - 1024 max: 0]].
	changesFile close.
	positions isEmpty
		ifTrue: [self inform: 'File ' , changesFile name , ' does not appear to be a changes file']
		ifFalse: [self browseRecentLogOn: origChangesFile startingFrom: positions last]! !

!ChangeList class methodsFor: 'System-FileRegistry' stamp: 'tbn 4/2/2012 16:56'!
serviceBrowseChangeFile
	"Answer a service for opening a changelist browser on a file"

	^ (SimpleServiceEntry 
		provider: self 
		label: 'Changelist browser'
		selector: #browseStream:
		description: 'Open a changelist tool on this file'
		buttonLabel: 'Changes')
		argumentGetter: [ :fileList | fileList readOnlyStream ]! !

!ChangeList class methodsFor: 'public access' stamp: 'MarcusDenker 7/27/2014 08:44'!
browseStream: changesFile
	"Opens a changeList on a fileStream"
	| changeList charCount |
	changesFile readOnly.
	changesFile setConverterForCode.
	charCount := changesFile size.
	charCount > 1000000 ifTrue:
		[(self confirm: 'The file ', changesFile name , '
is really long (' , charCount printString , ' characters).
Would you prefer to view only the last million characters?')
			ifTrue: [charCount := 1000000]].
	"changesFile setEncoderForSourceCodeNamed: changesFile name."
	Cursor read showWhile:
		[changeList := self new
			scanFile: changesFile from: changesFile size-charCount to: changesFile size].
	changesFile close.
	changeList openAsMorphName: ' log'
! !

!ChangeRecord commentStamp: '<historical>'!
A ChangeRecord represents a change recorded on a file in fileOut format.
It includes a type (more needs to be done here), and additional information
for certain types such as method defs which need class and category.!
!ChangeRecord methodsFor: 'access' stamp: 'tk 9/7/2000 15:09'!
stamp: threePartString

	stamp := threePartString! !

!ChangeRecord methodsFor: 'access' stamp: 'di 1/13/98 16:57'!
string 
	| string |
	file openReadOnly.
	file position: position.
	string := file nextChunk.
	file close.
	^ string! !

!ChangeRecord methodsFor: 'access' stamp: 'StephaneDucasse 7/23/2010 21:45'!
methodClass
	| methodClass |
	type == #method
		ifFalse: [ ^ nil ].
	(Smalltalk globals includesKey: class asSymbol)
		ifFalse: [ ^ nil ].
	methodClass := Smalltalk globals at: class asSymbol.
	^ meta
		ifTrue: [ methodClass class ]
		ifFalse: [ methodClass ]! !

!ChangeRecord methodsFor: 'access' stamp: ''!
methodClassName
	^class! !

!ChangeRecord methodsFor: 'access' stamp: 'tk 6/23/1999 08:20'!
text
	| text |
	^ file ifNil: ['']
		ifNotNil: [
			file openReadOnly.
			file position: position.
			text := file nextChunkText.
			file close.
			text]! !

!ChangeRecord methodsFor: 'access' stamp: 'sumim 9/1/2003 18:27'!
fileIndex
	^ (SourceFiles collect: [ :sf | sf name]) 
		indexOf: file name ifAbsent: [^ nil].
! !

!ChangeRecord methodsFor: 'access' stamp: 'sw 10/20/2002 02:53'!
fileOutOn: aFileStream
	"File the receiver out on the given file stream"

	| aString |
	type == #method
		ifTrue:
			[aFileStream nextPut: $!!.
			aString :=  class asString
							, (meta ifTrue: [' class methodsFor: ']
									ifFalse: [' methodsFor: '])
							, category asString printString.
			stamp ifNotNil:
				[aString := aString, ' stamp: ''', stamp, ''''].
			aFileStream nextChunkPut: aString.
			aFileStream cr].

	type == #preamble ifTrue: [aFileStream nextPut: $!!].

	type == #classComment
		ifTrue:
			[aFileStream nextPut: $!!.
			aFileStream nextChunkPut: class asString, ' commentStamp: ', stamp storeString.
			aFileStream cr].

	aFileStream nextChunkPut: self string.
	type == #method ifTrue: [aFileStream nextChunkPut: ' '].
	aFileStream cr! !

!ChangeRecord methodsFor: 'access' stamp: 'nk 1/7/2004 10:28'!
fileName
	^(file ifNotNil: [ file name ]) 
			ifNil: [ '<no file>' ]! !

!ChangeRecord methodsFor: 'initialization' stamp: '6/6/97 08:48 dhhi'!
file: f position: p type: t class: c category: cat meta: m stamp: s
	self file: f position: p type: t.
	class := c.
	category := cat.
	meta := m.
	stamp := s! !

!ChangeRecord methodsFor: 'printing' stamp: 'BenjaminVanRyseghem 5/6/2011 17:48'!
printOn: aStream

	aStream 
		nextPutAll: self type printString.
	self stamp ifNotNil: [ aStream nextPutAll: self stamp ]! !

!ChangeRecord methodsFor: 'access' stamp: ''!
type
	^ type! !

!ChangeRecord methodsFor: 'access' stamp: 'SvenVanCaekenberghe 12/22/2013 16:37'!
timeStamp
	"Answer a TimeStamp that corresponds to my (text) stamp"

	| tokens |
	tokens := self stamp findTokens: Character separators.
	^ tokens size > 2
		ifTrue: [ 
			[ 
			| time date |
			date := Date fromString: (tokens at: tokens size - 1).
			time := Time fromString: tokens last.
			DateAndTime date: date time: time ]
				on: Error
				do: [ :ex | ex return: DateAndTime new ] ]
		ifFalse: [ DateAndTime new ]! !

!ChangeRecord methodsFor: 'testing' stamp: 'StephaneDucasse 7/23/2010 21:59'!
classIncludesSelector
	
	| aClass | 
	^ (aClass := self methodClass) notNil
			and: [aClass includesSelector: self methodSelector]! !

!ChangeRecord methodsFor: 'access' stamp: 'BenjaminVanRyseghem 6/14/2012 11:51'!
sourceCode
	
	self type= #preamble ifTrue: [ ^ #preamble printString ].
	self type= #doIt ifTrue: [ ^ #preamble printString ].
	self type= #classComment ifTrue: [ self commentClass ifNotNil: [ :comment | ^ comment comment ]].

	^ self string! !

!ChangeRecord methodsFor: '*Ring-Monticello' stamp: 'CamilloBruni 5/25/2012 14:28'!
asMCMethodDefinition
	"Creates a MCMethodDefinition from the receiver when this was created for a method (type=#method)"
	
	self type == #method ifFalse: [ ^nil ]. "This case shouldn't happen"
	
	^ MCMethodDefinition 
		className: class
		classIsMeta: meta
		selector: self methodSelector
		category: category
		timeStamp: stamp
		source: self string! !

!ChangeRecord methodsFor: 'access' stamp: 'MarcusDenker 4/28/2013 11:04'!
methodSelector
	^ type == #method
		ifTrue: [ (Smalltalk globals at: class ifAbsent: [ Object ]) compiler parseSelector: self string ]! !

!ChangeRecord methodsFor: 'access' stamp: ''!
category
	^category! !

!ChangeRecord methodsFor: 'testing' stamp: 'StephaneDucasse 1/7/2011 17:22'!
isMethodDefinedInImage
	"answer whether the method represented by the receiver is present in the image"
	
	^ self type = #method
		and: [self classIncludesSelector]! !

!ChangeRecord methodsFor: 'access' stamp: ''!
isMetaClassChange
	^meta! !

!ChangeRecord methodsFor: 'access' stamp: 'HenrikSperreJohansen 9/12/2010 10:02'!
commentClass 
	| commentClass |
	type == #classComment ifFalse: [^ nil].
	(Smalltalk includesKey: class asSymbol) ifFalse: [^ nil].
	commentClass := Smalltalk at: class asSymbol.
	^meta ifTrue: [commentClass class]
		ifFalse: [commentClass]
! !

!ChangeRecord methodsFor: 'testing' stamp: 'StephaneDucasse 7/23/2010 22:40'!
isMethodNotDefinedInImage
	"answer whether the method represented by the receiver is not present in the image.
	pay attention is it not just isMethodDefinedInImage not"
	
	| aClass |
	^ self type = #method and:
			[(aClass := self methodClass) isNil or:
				[(aClass includesSelector: self methodSelector) not]]! !

!ChangeRecord methodsFor: 'initialization' stamp: ''!
file: f position: p type: t
	file := f.
	position := p.
	type := t! !

!ChangeRecord methodsFor: 'access' stamp: '6/6/97 08:56 dhhi'!
stamp
	^ stamp! !

!ChangeRecord methodsFor: 'access' stamp: 'sumim 9/2/2003 14:07'!
position
	^ position! !

!ChangeRecord methodsFor: '*Ring-Core-Kernel' stamp: 'StephaneDucasse 7/8/2011 15:31'!
asRingDefinition
	"Retrieves a RGMethodDefinition object based on the data of the receiver"
	
	self type == #method
		ifTrue: [ ^self createMethodDefinition ].
	self type == #classComment
		ifTrue: [ ^self createCommentDefinition ].
	^nil! !

!ChangeRecord methodsFor: 'initialization' stamp: 'GuillermoPolito 6/28/2013 10:37'!
fileIn
	"File the receiver in.  If I represent a method or a class-comment, file the method in and make a note of it in the recent-submissions list; if I represent a do-it, then, well, do it."

	Cursor read
		showWhile: [ 
			| methodClass s |
			(methodClass := self methodClass) notNil
				ifTrue: [ 
					methodClass
						compile: self text
						classified: category
						withStamp: stamp
						notifying: nil ].
			type == #doIt
				ifTrue: [ 
					((s := self string) beginsWith: '----')
						ifFalse: [ self class compiler evaluate: s ] ].
			type == #classComment
				ifTrue: [ (Smalltalk globals at: class asSymbol) comment: self text stamp: stamp ] ]! !

!ChangeRecord methodsFor: '*Ring-Core-Kernel' stamp: 'MarcusDenker 9/25/2014 13:01'!
createCommentDefinition
	"Retrieves a RGCommentDefinition object based on the data of the receiver"

	^ (RGCommentDefinition class: self commentClass)
		content: self string;
		stamp: stamp;
		yourself ! !

!ChangeRecord methodsFor: '*Ring-Core-Kernel' stamp: 'MarcusDenker 8/1/2014 14:12'!
createMethodDefinition
	"Retrieves a RGMethodDefinition object based on the data of the receiver"
	
	^(RGMethodDefinition named: self methodSelector)
		parentName: self methodClass name;
		isMetaSide: meta;  
		sourceCode: self string;
		protocol: category;
		stamp: stamp;
		yourself! !

!ChangeRecord methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 5/6/2011 17:39'!
<= anotherOne

	self stamp ifNil: [ ^ false ].
	anotherOne stamp ifNil: [ ^ true ].
	^ self timeStamp <= anotherOne timeStamp ! !

!ChangeRecord methodsFor: 'testing' stamp: 'StephaneDucasse 7/23/2010 22:52'!
isUnchangedMethod

	^ self isMethodDefinedInImage 
		and: [self string withBlanksCondensed 
				= (self methodClass sourceCodeAt: self methodSelector) asString withBlanksCondensed ]! !

!ChangeSet commentStamp: '<historical>'!
ChangeSets keep track of the changes made to a system, so they can be written on a file as source code (a "fileOut"). 

---
preamble and postscript:  two strings that serve as prefix (useful for documentation) and suffix (useful for doits) to the fileout of the changeSet.


changeRecords -  Dictionary {class name -> a ClassChangeRecord}.
These classChangeRecords (qv) remember all of the system changes.!
!ChangeSet methodsFor: 'accessing' stamp: 'sw 6/29/1999 14:44'!
hasPostscript
	^ postscript notNil! !

!ChangeSet methodsFor: 'filein/out' stamp: 'ar 7/16/2005 17:55'!
preamble
	"Answer the string representing the preamble"
	^preamble ifNotNil:[preamble isString ifTrue:[preamble] ifFalse:[preamble contents asString]]! !

!ChangeSet methodsFor: 'filein/out' stamp: 'MarcusDenker 8/9/2014 13:34'!
checkForUncommentedMethods
	| aList |
	"Check to see if there are any methods in the receiver that have no comments, and open a browser on all found"

	(aList := self methodsWithoutComments) notEmpty
		ifFalse:
			[^ self inform: 'All methods in "', self name, '" have comments']
		ifTrue:
			[self systemNavigation  browseMessageList: aList name: 'methods in "', self name, '" that lack comments']! !

!ChangeSet methodsFor: 'accessing' stamp: 'sw 6/29/1999 14:48'!
removePostscript
	postscript := nil! !

!ChangeSet methodsFor: 'moving changes' stamp: 'di 4/4/2000 11:49'!
expungeEmptyClassChangeEntries

	changeRecords keysAndValuesRemove:
		[:className :classRecord | classRecord hasNoChanges]! !

!ChangeSet methodsFor: 'filein/out' stamp: 'StephaneDucasse 5/23/2011 22:45'!
checkForSlips
	"Return a collection of method refs with possible debugging code in them."
	| slips |
	slips := OrderedCollection new.
	self changedClasses do:
		[:aClass |
		(self methodChangesAtClass: aClass name) associationsDo: 
				[:mAssoc | | method | (#(remove addedThenRemoved) includes: mAssoc value) ifFalse:
					[method := aClass compiledMethodAt: mAssoc key ifAbsent: [nil].
					method ifNotNil:
						[method hasReportableSlip
							ifTrue: [ slips add: (aClass >> mAssoc key) methodReference ]]]]].
	^ slips! !

!ChangeSet methodsFor: 'method changes' stamp: 'di 4/1/2000 12:00'!
methodChangesAtClass: className
	"Return an old-style dictionary of method change types."

	^(changeRecords at: className ifAbsent: [^ Dictionary new])
		methodChangeTypes! !

!ChangeSet methodsFor: 'private' stamp: 'MarcusDenker 8/9/2014 13:32'!
fileOutClassDefinition: class on: stream
	"Write out class definition for the given class on the given stream, if the class definition was added or changed."

	(self atClass: class includes: #rename)
		ifTrue: [ 
			stream
				nextChunkPut: 'Smalltalk renameClassNamed: #' , (self oldNameFor: class) , ' as: #' , class name;
				cr ].
	(self atClass: class includes: #change)
		ifTrue: [ 
			"fat definition only needed for changes"
			stream
				nextChunkPut: (self fatDefForClass: class);
				cr.
			DeepCopier new checkClass: class	"If veryDeepCopy weakly copies some inst 
			vars in this class, warn author when new ones are added." ]
		ifFalse: [ 
			(self atClass: class includes: #add)
				ifTrue: [ 
					"use current definition for add"
					stream
						nextChunkPut: class definition;
						cr.
					DeepCopier new checkClass: class	"If veryDeepCopy weakly copies some inst 
				vars in this class, warn author when new ones are added." ] ].
	(self atClass: class includes: #comment)
		ifFalse: [ ^ self ].
	class theNonMetaClass organization
		putCommentOnFile: stream
		numbered: 0
		moveSource: false
		forClass: class theNonMetaClass.
	stream cr! !

!ChangeSet methodsFor: 'filein/out' stamp: 'AlainPlantec 12/18/2009 14:11'!
preambleTemplate
	"Answer a string that will form the default contents for a change set's preamble.
	Just a first stab at what the content should be."

	^ String streamContents: [:strm |
		strm nextPutAll: '"Change Set:'.  "NOTE: fileIn recognizes preambles by this string."
		strm tab;tab; nextPutAll: self name.
		strm cr; nextPutAll: 'Date:'; tab; tab; tab; nextPutAll: Date today printString.
		strm cr; nextPutAll: 'Author:'; tab; tab; tab; nextPutAll:  Author fullName.
		strm cr; cr; nextPutAll: '<your descriptive text goes here>"']
"ChangeSet current preambleTemplate"! !

!ChangeSet methodsFor: 'change logging' stamp: 'CamilleTeruel 9/4/2014 16:37'!
methodRemoved: anEvent
	self
		removeSelector: anEvent selector
		class: anEvent methodClass
		priorMethod: anEvent method
		lastMethodInfo: {anEvent method sourcePointer. anEvent protocol}! !

!ChangeSet methodsFor: 'initialization' stamp: 'MarcusDenker 8/25/2010 20:55'!
initialize 
	"Initialize the receiver to be empty."

	super initialize.
	name ifNil: [^ self error: 'All changeSets must be registered, as in ChangeSorter newChangeSet'].
	self clear.
! !

!ChangeSet methodsFor: 'filein/out' stamp: 'MarianoMartinezPeck 9/3/2012 12:39'!
fileOutOn: stream 
	"Write out all the changes the receiver knows about"

	| classList traits classes traitList list |
	(self isEmpty and: [stream isKindOf: FileStream])
		ifTrue: [self inform: 'Warning: no changes to file out'].
		
	traits := self changedClasses reject: [:each | each isBehavior].
	classes := self changedClasses select: [:each | each isBehavior].
	traitList := self class traitsOrder: traits asOrderedCollection.
	classList := self class classesOrder: classes asOrderedCollection.
	list := OrderedCollection new
		addAll: traitList;
		addAll: classList;
		yourself.
	
	"First put out rename, max classDef and comment changes."
	list do: [:aClass | self fileOutClassDefinition: aClass on: stream].

	"Then put out all the method changes"
	list do: [:aClass | self fileOutChangesFor: aClass on: stream].

	"Finally put out removals, final class defs and reorganization if any"
	list reverseDo: [:aClass | self fileOutPSFor: aClass on: stream].

	self classRemoves asSortedCollection do:
		[:aClassName | stream nextChunkPut: 'Smalltalk removeClassNamed: #', aClassName; cr].! !

!ChangeSet methodsFor: 'change logging' stamp: 'GuillermoPolito 8/3/2012 13:26'!
classReorganized: anEvent
	self reorganizeClass: anEvent classReorganized! !

!ChangeSet methodsFor: 'private' stamp: 'di 3/28/2000 14:40'!
atClass: class add: changeType

	(self changeRecorderFor: class)
		noteChangeType: changeType fromClass: class! !

!ChangeSet methodsFor: 'change logging' stamp: 'GuillermoPolito 8/3/2012 13:25'!
classRecategorized: anEvent
	self changeClass: anEvent classRecategorized from: anEvent classRecategorized! !

!ChangeSet methodsFor: 'testing' stamp: 'stephane.ducasse 7/10/2009 16:44'!
okayToRemoveInforming: aBoolean
	"Answer whether it is okay to remove the receiver.  If aBoolean is true, inform the receiver if it is not okay"

	| aName |
	aName := self name.
	self == self class current ifTrue:
		[aBoolean ifTrue: [self inform: 'Cannot remove "', aName, '"
because it is the 
current change set.'].
		^ false].
	^ true
! !

!ChangeSet methodsFor: 'change logging' stamp: 'EstebanLorenzano 2/28/2013 16:34'!
addClass: class 
	"Include indication that a new class was created."

	class wantsChangeSetLogging ifFalse: [^ self].
	self atClass: class add: #new.
	self atClass: class add: #change.
	self addCoherency: class name! !

!ChangeSet methodsFor: 'class changes' stamp: 'lr 3/14/2010 21:13'!
changedClasses
	"Answer an OrderedCollection of changed or edited classes.
	Does not include removed classes.  Sort alphabetically by name."

	"Much faster to sort names first, then convert back to classes.  Because metaclasses reconstruct their name at every comparison in the sorted collection.
	8/91 sw chgd to filter out non-existent classes (triggered by problems with class-renames"

	^ self changedClassNames
		collect: [ :className | Smalltalk globals classNamed: className ]
		thenSelect: [ :aClass | aClass notNil ]! !

!ChangeSet methodsFor: 'change logging' stamp: 'GuillermoPolito 8/3/2012 13:27'!
methodAdded: anEvent
	self noteNewMethod: anEvent method forClass: anEvent methodClass selector: anEvent selector priorMethod: nil! !

!ChangeSet methodsFor: 'private' stamp: 'MarcusDenker 7/25/2014 09:30'!
changeRecorderFor: class
	| cname |
	cname := class isString
		ifTrue: [ class ]
		ifFalse: [ class name ].	"Later this will init the changeRecords so according to whether they should be revertable."
	^ changeRecords at: cname ifAbsent: [ ^ changeRecords at: cname put: (ClassChangeRecord new initFor: cname) ]! !

!ChangeSet methodsFor: 'filein/out' stamp: 'ar 7/16/2005 18:02'!
assurePreambleExists
	"Make sure there is a StringHolder holding the preamble; if it's found to have reverted to empty contents, put up the template"

	(preamble isEmptyOrNil)
		ifTrue: [preamble := self preambleTemplate]! !

!ChangeSet methodsFor: 'class changes' stamp: 'NS 1/26/2004 09:46'!
commentClass: class 
	"Include indication that a class comment has been changed."

	class wantsChangeSetLogging ifFalse: [^ self].
	self atClass: class add: #comment! !

!ChangeSet methodsFor: 'testing' stamp: 'RAA 10/19/2000 13:17'!
isEmpty
	"Answer whether the receiver contains any elements."
	
	changeRecords ifNil: [^true].
	^ changeRecords isEmpty ! !

!ChangeSet methodsFor: 'method changes' stamp: 'MarcusDenker 7/25/2014 09:30'!
adoptSelector: aSelector forClass: aClass
	"Adopt the given selector/class combination as a change in the receiver"

	self noteNewMethod: (aClass compiledMethodAt: aSelector)
			forClass: aClass selector: aSelector priorMethod: nil! !

!ChangeSet methodsFor: 'change logging' stamp: 'GuillermoPolito 8/3/2012 13:26'!
classRenamed: anEvent
	self renameClass: anEvent classRenamed from: anEvent oldName to: anEvent newName! !

!ChangeSet methodsFor: 'change logging' stamp: 'GuillermoPolito 8/3/2012 13:24'!
classAdded: anEvent
	self addClass: anEvent classAdded! !

!ChangeSet methodsFor: 'method changes' stamp: 'SqR 6/13/2000 19:16'!
selectorsInClass: aClassName
	"Used by a ChangeSorter to access the list methods."

	^ (changeRecords at: aClassName ifAbsent: [^#()]) changedSelectors! !

!ChangeSet methodsFor: 'filein/out' stamp: 'MarcusDenker 8/9/2014 13:32'!
fileOutChangesFor: class on: stream
	"Write out all the method changes for this class."

	| changes |
	changes := Set new.
	(self methodChangesAtClass: class name)
		associationsDo: [ :mAssoc | 
			(mAssoc value = #remove or: [ mAssoc value = #addedThenRemoved ])
				ifFalse: [ changes add: mAssoc key ] ].
	changes isEmpty
		ifTrue: [ ^ self ].
	class fileOutChangedMessages: changes on: stream.
	stream cr! !

!ChangeSet methodsFor: 'class changes' stamp: 'NS 1/19/2004 17:49'!
noteRemovalOf: class
	"The class is about to be removed from the system.
	Adjust the receiver to reflect that fact."

	class wantsChangeSetLogging ifFalse: [^ self].
	(self changeRecorderFor: class)
		noteChangeType: #remove fromClass: class.
	changeRecords removeKey: class class name ifAbsent: [].! !

!ChangeSet methodsFor: 'filein/out' stamp: 'MarcusDenker 8/9/2014 13:32'!
fileOutPSFor: class on: stream
	"Write out removals and initialization for this class."

	| dict classRecord currentDef |
	classRecord := changeRecords at: class name ifAbsent: [ ^ self ].
	dict := classRecord methodChangeTypes.
	dict keysSortedSafely
		do: [ :key | 
			| changeType |
			changeType := dict at: key.
			(#(#remove #addedThenRemoved) includes: changeType)
				ifTrue: [ 
					stream
						nextChunkPut: class name , ' removeSelector: ' , key storeString;
						cr ]
				ifFalse: [ 
					(key = #initialize and: [ class isMeta ])
						ifTrue: [ 
							stream
								nextChunkPut: class soleInstance name , ' initialize';
								cr ] ] ].
	((classRecord includesChangeType: #change) and: [ (currentDef := class definition) ~= (self fatDefForClass: class) ])
		ifTrue: [ 
			stream
				nextChunkPut: currentDef;
				cr ].
	(classRecord includesChangeType: #reorganize)
		ifFalse: [ ^ self ].
	class fileOutOrganizationOn: stream.
	stream cr! !

!ChangeSet methodsFor: 'class changes' stamp: 'di 5/16/2000 09:03'!
trimHistory 
	"Drop non-essential history:  methods added and then removed, as well as rename and reorganization of newly-added classes."

	changeRecords do: [:chgRecord | chgRecord trimHistory]! !

!ChangeSet methodsFor: 'moving changes' stamp: 'MarcusDenker 9/29/2013 15:33'!
forgetAllChangesFoundIn: otherChangeSet
	"Remove from the receiver all method changes found in aChangeSet. The intention is facilitate the process of factoring a large set of changes into disjoint change sets.  To use:  in a change sorter, copy over all the changes you want into some new change set, then use the subtract-other-side feature to subtract those changes from the larger change set, and continue in this manner."

	otherChangeSet == self ifTrue: [^ self].
	otherChangeSet changedClassNames do:
		[:className | self forgetChangesForClass: className in: otherChangeSet].
	self expungeEmptyClassChangeEntries.
! !

!ChangeSet methodsFor: 'accessing' stamp: ''!
name: anObject
	name := anObject! !

!ChangeSet methodsFor: 'testing' stamp: 'StephaneDucasse 3/30/2010 23:02'!
isNumbered
	"Answer whether a change set is numbered"

	^  self name startsWithDigit! !

!ChangeSet methodsFor: 'change logging' stamp: 'GuillermoPolito 8/3/2012 13:27'!
methodModified: anEvent
	self
		noteNewMethod: anEvent newMethod
		forClass: anEvent methodClass
		selector: anEvent selector
		priorMethod: anEvent oldMethod! !

!ChangeSet methodsFor: 'filein/out' stamp: 'MarcusDenker 8/9/2014 13:35'!
fileOutPreambleOn: stream
	"If the receiver has a preamble, put it out onto the stream.  "

	| aString |
	aString := self preambleString.
	(aString notNil and: [ aString notEmpty ])
		ifFalse: [ ^ self ].
	stream nextChunkPut: aString.	"surroundedBySingleQuotes"
	stream
		cr;
		cr! !

!ChangeSet methodsFor: 'change logging' stamp: 'GuillermoPolito 8/3/2012 13:24'!
classCommented: anEvent
	self commentClass: anEvent classCommented! !

!ChangeSet methodsFor: 'filein/out' stamp: 'ar 7/16/2005 18:03'!
postscript
	"Answer the string representing the postscript.  "
	^postscript ifNotNil:[postscript isString ifTrue:[postscript] ifFalse:[postscript contents asString]]! !

!ChangeSet methodsFor: 'change logging' stamp: 'VeronicaUquillas 6/11/2010 11:37'!
noteNewMethod: newMethod forClass: class selector: selector priorMethod: methodOrNil

	class wantsChangeSetLogging ifFalse: [^ self].
	(self changeRecorderFor: class)
		noteNewMethod: newMethod selector: selector priorMethod: methodOrNil
! !

!ChangeSet methodsFor: 'private' stamp: 'di 4/1/2000 12:00'!
atSelector: selector class: class

	^ (changeRecords at: class name ifAbsent: [^ #none])
		atSelector: selector ifAbsent: [^ #none]! !

!ChangeSet methodsFor: 'class changes' stamp: 'PeterHugossonMiller 9/3/2009 00:18'!
fatDefForClass: class 
	| newDef oldDef oldStrm newStrm outStrm oldVars newVars addedVars |
	class isBehavior ifFalse: [ ^ class definition ].
	newDef := class definition.
	oldDef := (self changeRecorderFor: class) priorDefinition.
	oldDef ifNil: [ ^ newDef ].
	oldDef = newDef ifTrue: [ ^ newDef ].
	oldStrm := oldDef readStream.
	newStrm := newDef readStream.
	outStrm := (String new: newDef size * 2) writeStream.

	"Merge inst vars from old and new defs..."
	oldStrm
		upToAll: 'instanceVariableNames';
		upTo: $'.
	outStrm
		nextPutAll: (newStrm upToAll: 'instanceVariableNames');
		nextPutAll: 'instanceVariableNames:'.
	newStrm peek = $: ifTrue: [ newStrm next ].	"may or may not be there, but already written"
	outStrm
		nextPutAll: (newStrm upTo: $');
		nextPut: $'.
	oldVars := (oldStrm upTo: $') findTokens: Character separators.
	newVars := (newStrm upTo: $') findTokens: Character separators.
	addedVars := oldVars asSet
		addAll: newVars;
		removeAll: oldVars;
		asOrderedCollection.
	oldVars , addedVars do: 
		[ :var | 
		outStrm
			nextPutAll: var;
			space ].
	outStrm nextPut: $'.
	class isMeta ifFalse: 
		[ "Merge class vars from old and new defs..."
		oldStrm
			upToAll: 'classVariableNames:';
			upTo: $'.
		outStrm
			nextPutAll: (newStrm upToAll: 'classVariableNames:');
			nextPutAll: 'classVariableNames:';
			nextPutAll: (newStrm upTo: $');
			nextPut: $'.
		oldVars := (oldStrm upTo: $') findTokens: Character separators.
		newVars := (newStrm upTo: $') findTokens: Character separators.
		addedVars := oldVars asSet
			addAll: newVars;
			removeAll: oldVars;
			asOrderedCollection.
		oldVars , addedVars do: 
			[ :var | 
			outStrm
				nextPutAll: var;
				space ].
		outStrm nextPut: $' ].
	outStrm nextPutAll: newStrm upToEnd.
	^ outStrm contents! !

!ChangeSet methodsFor: 'accessing' stamp: 'ClementBera 7/26/2013 16:07'!
name
	"The name of this changeSet. If name is nil, we've got garbage.  Help to identify."

	^ name
		ifNil: [ '<no name -- garbage?>' ]
		ifNotNil: [ name ]! !

!ChangeSet methodsFor: 'moving changes' stamp: 'ar 7/16/2005 18:59'!
editPreamble
	"edit the receiver's preamble, in a separate window.  "
	self assurePreambleExists.
	UIManager default
		edit: self preamble 
		label: 'Preamble for ChangeSet named ', name
		accept:[:aString| self preamble: aString]! !

!ChangeSet methodsFor: 'change logging' stamp: 'GuillermoPolito 8/3/2012 13:25'!
classModified: anEvent
	self changeClass: anEvent newClassDefinition from: anEvent oldClassDefinition! !

!ChangeSet methodsFor: 'accessing' stamp: 'ar 7/16/2005 18:04'!
postscriptHasDependents
	^false! !

!ChangeSet methodsFor: 'change logging' stamp: 'MarcusDenker 7/22/2013 13:12'!
changeClass: class from: oldClass
	"Remember that a class definition has been changed.  Record the original structure, so that a conversion method can be built."

	class wantsChangeSetLogging ifFalse: [^ self]. 
	class isMeta 
		ifFalse: [self atClass: class add: #change]	"normal"
		ifTrue: [((self classChangeAt: class theNonMetaClass name) includes: #add) 
			ifTrue: [self atClass: class add: #add] 	"When a class is defined, the metaclass
				is not recorded, even though it was added.  A further change is
				really just part of the original add."
			ifFalse: [self atClass: class add: #change]].
	self addCoherency: class name.
	(self changeRecorderFor: class) notePriorDefinition: oldClass.! !

!ChangeSet methodsFor: 'change logging' stamp: 'VeronicaUquillas 6/11/2010 11:37'!
removeSelector: selector class: class priorMethod: priorMethod lastMethodInfo: info
	"Include indication that a method has been forgotten.
	info is a pair of the source code pointer and message category
	for the method that was removed."

	class wantsChangeSetLogging ifFalse: [^ self].
	(self changeRecorderFor: class)
		noteRemoveSelector: selector priorMethod: priorMethod lastMethodInfo: info
! !

!ChangeSet methodsFor: 'filein/out' stamp: 'ar 7/16/2005 18:00'!
preambleString: aString
	"Establish aString as the new contents of the preamble.  "
	self preamble: aString.! !

!ChangeSet methodsFor: 'method changes' stamp: 'MarcusDenker 8/9/2014 13:33'!
hasAnyChangeForSelector: aSelector
	"Answer whether the receiver has any change under the given selector, whether it be add, change, or remove, for any class"

	^ changeRecords anySatisfy: [ :aRecord | aRecord changedSelectors includes: aSelector ]! !

!ChangeSet methodsFor: 'accessing' stamp: 'nice 1/5/2010 15:59'!
methodChanges

	| methodChangeDict |
	methodChangeDict := Dictionary new.
	changeRecords associationsDo:
		[:assn | | changeTypes |
		changeTypes := assn value methodChangeTypes.
		changeTypes isEmpty ifFalse: [methodChangeDict at: assn key put: changeTypes]].
	^ methodChangeDict! !

!ChangeSet methodsFor: 'filein/out' stamp: 'ar 7/16/2005 18:03'!
postscriptString
	"Answer the string representing the postscript.  "
	^self postscript! !

!ChangeSet methodsFor: 'class changes' stamp: 'di 4/1/2000 12:00'!
changedClassNames
	"Answer a OrderedCollection of the names of changed or edited classes.
	DOES include removed classes.  Sort alphabetically."

	^ changeRecords keysSortedSafely ! !

!ChangeSet methodsFor: 'filein/out' stamp: 'MarcusDenker 8/9/2014 13:35'!
lookForSlips
	"Scan the receiver for changes that the user may regard as slips to be remedied"

	| slips nameLine msg |
	nameLine := '
"', self name, '"
'.
	(slips := self checkForSlips) isEmpty ifTrue:
		[^ self inform: 'No slips detected in change set', nameLine].

	msg := slips size = 1
		ifTrue:
			[ 'One method in change set', nameLine, 
'has a halt, reference to the Transcript,
and/or some other ''slip'' in it.
Would you like to browse it? ?']
		ifFalse:
			[ slips size printString,
' methods in change set', nameLine, 'have halts or references to the
Transcript or other ''slips'' in them.
Would you like to browse them?'].

	(UIManager default  chooseFrom: #('Ignore' 'Browse slips') title: msg) = 2
		ifTrue: [self systemNavigation  browseMessageList: slips
							name: 'Possible slips in ', name]! !

!ChangeSet methodsFor: 'class changes' stamp: 'nk 6/26/2002 12:30'!
containsClass: aClass
	^ self changedClasses includes: aClass! !

!ChangeSet methodsFor: 'method changes' stamp: 'sd 9/22/2011 17:55'!
changedMessageList
	"Used by a message set browser to access the list view information."

	| messageList |
	messageList := OrderedCollection new.
	changeRecords associationsDo: [:clAssoc | | className classIsMeta |
		className := clAssoc key asSymbol.
		classIsMeta := (className findTokens: ' ') size > 1.

		(clAssoc value allChangeTypes includes: #comment) ifTrue:
			[messageList add:
				(RGCommentDefinition new
					parentName: className) asActive ].

		clAssoc value methodChangeTypes associationsDo: [:mAssoc |
			(#(remove addedThenRemoved) includes: mAssoc value) ifFalse:
				[messageList add:
					((RGMethodDefinition named: mAssoc key)
						parentName: className;
						isMetaSide: classIsMeta) asActive ]]].
	^ messageList asArray sort! !

!ChangeSet methodsFor: 'filein/out' stamp: 'MarcusDenker 8/9/2014 13:34'!
checkForUnsentMessages
	"Check the change set for unsent messages, and if any are found, open 
	up a message-list browser on them"
	| nameLine allChangedSelectors augList unsent |
	nameLine := '"' , self name , '"'.
	allChangedSelectors := Set new.
	(augList := self changedMessageList)
		do: [:each | each isValid
				ifTrue: [allChangedSelectors add: each selector]].
	unsent := self systemNavigation allUnsentMessagesIn: allChangedSelectors.
	unsent notEmpty
		ifTrue: [^ self inform: 'There are no unsent 
messages in change set
' , nameLine].
	self systemNavigation
		browseMessageList: (augList
				select: [:each | unsent includes: each selector])
		name: 'Unsent messages in ' , nameLine! !

!ChangeSet methodsFor: 'initialization' stamp: 'CamilloBruni 8/1/2012 16:10'!
isMoribund
	"Answer whether the receiver is obsolete and about to die; part of an effort to get such guys cleared out from the change sorter."

	^ name isNil! !

!ChangeSet methodsFor: 'method changes' stamp: 'Alexandre Bergel 11/21/2009 10:36'!
atSelector: selector class: class put: changeType

	(self changeRecorderFor: class) atSelector: selector put: changeType.
! !

!ChangeSet methodsFor: 'printing' stamp: 'MarcusDenker 8/9/2014 13:33'!
printOn: aStream
	super printOn: aStream.
	aStream
		nextPutAll: ' named ';
		nextPutAll: self name! !

!ChangeSet methodsFor: 'filein/out' stamp: 'ar 7/16/2005 18:03'!
postscript: aString
	"Answer the string representing the postscript.  "
	postscript := aString! !

!ChangeSet methodsFor: 'testing' stamp: 'sw 8/3/1998 16:25'!
okayToRemove
	^ self okayToRemoveInforming: true! !

!ChangeSet methodsFor: 'initialization' stamp: 'sw 3/6/1999 09:31'!
veryDeepCopyWith: deepCopier
	"Return self; this is NOT the way to launch new change sets!! Having this method here allows Change Sorters to be in parts bins"! !

!ChangeSet methodsFor: 'filein/out' stamp: 'ar 7/16/2005 18:00'!
preamble: aString
	"Establish aString as the new contents of the preamble.  "

	preamble := aString! !

!ChangeSet methodsFor: 'private' stamp: 'di 4/1/2000 12:00'!
atClass: class includes: changeType

	^(changeRecords at: class name ifAbsent: [^false])
		includesChangeType: changeType! !

!ChangeSet methodsFor: 'class changes' stamp: 'di 4/1/2000 12:00'!
classChangeAt: className
	"Return what we know about class changes to this class."

	^ (changeRecords at: className ifAbsent: [^ Set new])
		allChangeTypes! !

!ChangeSet methodsFor: 'moving changes' stamp: 'sw 3/5/1999 19:32'!
removePreamble
	preamble := nil! !

!ChangeSet methodsFor: 'change logging' stamp: 'GuillermoPolito 8/3/2012 14:14'!
methodRecategorized: anEvent
	self reorganizeClass: anEvent methodClass! !

!ChangeSet methodsFor: 'change logging' stamp: 'MarcusDenker 7/22/2013 13:12'!
renameClass: class from: oldName to: newName 
	"Include indication that a class has been renamed."

	| recorder oldMetaClassName newMetaClassName |
	(recorder := self changeRecorderFor: oldName)
		noteChangeType: #rename;
		noteNewName: newName asSymbol.
		
	"store under new name (metaclass too)"
	changeRecords at: newName put: recorder.
	changeRecords removeKey: oldName.


	newMetaClassName := newName, ' class'.
	oldMetaClassName := oldName, ' class'.
	recorder := changeRecords at: oldMetaClassName ifAbsent: [^ nil].
	changeRecords at: newMetaClassName put: recorder.
	changeRecords removeKey: oldMetaClassName.
	recorder noteNewName: newMetaClassName! !

!ChangeSet methodsFor: 'filein/out' stamp: 'ar 7/16/2005 18:00'!
preambleString
	"Answer the string representing the preamble"

	^self preamble! !

!ChangeSet methodsFor: 'moving changes' stamp: 'nice 10/20/2009 20:55'!
methodsWithoutComments
	"Return a collection representing methods in the receiver which have no precode comments"

	| slips |
	slips := OrderedCollection new.
	self changedClasses do:
		[:aClass |
		(self methodChangesAtClass: aClass name) associationsDo: 
				[:mAssoc | (#(remove addedThenRemoved) includes: mAssoc value) ifFalse:
					[(aClass includesSelector:  mAssoc key) ifTrue:
						[(aClass firstPrecodeCommentFor: mAssoc key) isEmptyOrNil
								ifTrue: [slips add: aClass name , ' ' , mAssoc key]]]]].
	^ slips

	"Smalltalk browseMessageList: (ChangeSet current methodsWithoutComments) name: 'methods lacking comments'"! !

!ChangeSet methodsFor: 'initialization' stamp: 'di 4/1/2000 12:00'!
clear 
	"Reset the receiver to be empty.  "

	changeRecords := Dictionary new.
	preamble := nil.
	postscript := nil! !

!ChangeSet methodsFor: 'private' stamp: 'di 4/1/2000 12:00'!
oldNameFor: class

	^ (changeRecords at: class name) priorName! !

!ChangeSet methodsFor: 'accessing' stamp: 'di 4/1/2000 12:00'!
classRemoves

	^ changeRecords keys select:
		[:className | (changeRecords at: className) isClassRemoval]! !

!ChangeSet methodsFor: 'moving changes' stamp: 'CamilloBruni 8/1/2012 16:15'!
removeClassAndMetaClassChanges: class
	"Remove all memory of changes associated with this class and its metaclass."

	changeRecords removeKey: class name ifAbsent: [].
	changeRecords removeKey: class class name ifAbsent: [].
! !

!ChangeSet methodsFor: 'filein/out' stamp: 'MarcusDenker 8/9/2014 13:34'!
fileOutPostscriptOn: stream
	"If the receiver has a postscript, put it out onto the stream.  "

	| aString |
	aString := self postscriptString.
	(aString notNil and: [ aString notEmpty ])
		ifFalse: [ ^ self ].
	stream nextChunkPut: aString.	"surroundedBySingleQuotes"
	stream
		cr;
		cr! !

!ChangeSet methodsFor: 'filein/out' stamp: 'ar 7/16/2005 18:03'!
postscriptString: aString
	"Establish aString as the new contents of the postscript.  "
	self postscript: aString! !

!ChangeSet methodsFor: 'method changes' stamp: 'di 4/4/2000 11:14'!
removeSelectorChanges: selector class: class 
	"Remove all memory of changes associated with the argument, selector, in 
	this class."

	| chgRecord |
	(chgRecord := changeRecords at: class name ifAbsent: [^ self])
		removeSelector: selector.
	chgRecord hasNoChanges ifTrue: [changeRecords removeKey: class name]! !

!ChangeSet methodsFor: 'moving changes' stamp: 'di 3/23/2000 11:52'!
absorbMethod: selector class: aClass from: aChangeSet
	"Absorb into the receiver all the changes for the method in the class in the other change set."

	| info |
	info := aChangeSet methodChanges at: aClass name ifAbsent: [Dictionary new].
	self atSelector: selector class: aClass put: (info at: selector).

! !

!ChangeSet methodsFor: 'moving changes' stamp: 'MarcusDenker 7/25/2014 09:30'!
removeClassChanges: class
	"Remove all memory of changes associated with this class"

	| cname |
	cname := class isString
		ifTrue: [ class ]
		ifFalse: [ class name ].
	changeRecords removeKey: cname ifAbsent: [  ]! !

!ChangeSet methodsFor: 'initialization' stamp: 'CamilloBruni 8/1/2012 16:18'!
wither
	"The receiver is to be clobbered. Clear it out."

	self clear.
	name := nil! !

!ChangeSet methodsFor: 'filein/out' stamp: 'nk 10/15/2003 09:55'!
defaultChangeSetDirectory
	^self class defaultChangeSetDirectory! !

!ChangeSet methodsFor: 'moving changes' stamp: 'MarcusDenker 7/22/2013 13:12'!
forgetChangesForClass: className in: otherChangeSet
	"See forgetAllChangesFoundIn:.  Used in culling changeSets."

	(self changeRecorderFor: className)
			forgetChangesIn: (otherChangeSet changeRecorderFor: className).
! !

!ChangeSet methodsFor: 'accessing' stamp: 'ar 7/16/2005 18:59'!
editPostscript
	"edit the receiver's postscript, in a separate window.  "
	self assurePostscriptExists.
	UIManager default
		edit: self postscript 
		label: 'Postscript for ChangeSet named ', name
		accept:[:aString| self postscript: aString].! !

!ChangeSet methodsFor: 'moving changes' stamp: 'sw 3/5/1999 19:27'!
hasPreamble
	^ preamble notNil! !

!ChangeSet methodsFor: 'filein/out' stamp: 'MarcusDenker 8/9/2014 13:34'!
checkForUnclassifiedMethods
	"Open a message list browser on all methods in the current change set that have not been categorized,"

	| aList |
	(aList := self methodsWithoutClassifications) notEmpty
		ifFalse:
			[^ self inform: 'All methods in "', self name, '"
are categorized.']
		ifTrue:
			[self systemNavigation  browseMessageList: aList name: 'methods in "', self name, '" which have not been categorized']! !

!ChangeSet methodsFor: 'filein/out' stamp: 'ClementBera 7/26/2013 16:07'!
assurePostscriptExists
	"Make sure there is a StringHolder holding the postscript.  "

	"NOTE: FileIn recognizes the postscript by the line with Postscript: on it"

	postscript ifNil: [ 
			postscript := '"Postscript:
Leave the line above, and replace the rest of this comment by a useful one.
Executable statements should follow this comment, and should
be separated by periods, with no exclamation points (!!).
Be sure to put any further comments in double-quotes, like this one."
' ]! !

!ChangeSet methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/8/2012 14:42'!
author
	| author |
	self assurePreambleExists.
	author := self preambleString lineNumber: 3.
	author := author copyFrom: 8 to: author size. "Strip the 'Author:' prefix. Ugly ugly."	
	^ author trimBoth! !

!ChangeSet methodsFor: 'moving changes' stamp: 'di 4/4/2000 11:21'!
assimilateAllChangesFoundIn: otherChangeSet
	"Make all changes in otherChangeSet take effect on self as if they happened just now."

	otherChangeSet changedClassNames do:
		[:className | self absorbClass: className from: otherChangeSet]
! !

!ChangeSet methodsFor: 'change logging' stamp: 'GuillermoPolito 8/3/2012 13:25'!
classRemoved: anEvent
	self noteRemovalOf: anEvent classRemoved.! !

!ChangeSet methodsFor: 'moving changes' stamp: 'MarcusDenker 7/22/2013 13:11'!
absorbClass: className from: otherChangeSet
	"Absorb into the receiver all the changes found in the class in the other change set.
	*** Classes renamed in otherChangeSet may have problems"

	(self changeRecorderFor: className) assimilateAllChangesIn: (otherChangeSet changeRecorderFor: className).
! !

!ChangeSet methodsFor: 'class changes' stamp: ''!
reorganizeClass: class 
	"Include indication that a class was reorganized."

	self atClass: class add: #reorganize! !

!ChangeSet methodsFor: 'filein/out' stamp: 'NicolaiHess 8/15/2014 21:54'!
fileOut
	"File out the receiver, to a file whose name is a function of the  
	change-set name and a unique numeric tag."
	| slips nameToUse |
	self class promptForDefaultChangeSetDirectoryIfNecessary.
	nameToUse := (self defaultChangeSetDirectory / self name , 'cs') nextVersion basename.
	Cursor write showWhile: [ | internalStream |
			internalStream := (String new: 10000) writeStream.
			internalStream header; timeStamp.
			self fileOutPreambleOn: internalStream.
			self fileOutOn: internalStream.
			self fileOutPostscriptOn: internalStream.
			internalStream trailer.

			FileStream writeSourceCodeFrom: internalStream baseName: (nameToUse copyFrom: 1 to: nameToUse size - 3) isSt: false.
	].
	self class  mustCheckForSlips
		ifFalse: [^ self].
	slips := self checkForSlips.
	(slips notEmpty and: [self confirm: 'Methods in this fileOut have halts
or references to the Transcript
or other ''slips'' in them.
Would you like to browse them?' translated])
		ifTrue: [self systemNavigation browseMessageList: slips name: 'Possible slips in ' , name]! !

!ChangeSet methodsFor: 'testing' stamp: 'nice 1/5/2010 15:59'!
methodsWithoutClassifications
	"Return a collection representing methods in the receiver which have not been categorized"

	| slips notClassified |

	notClassified := {'as yet unclassified' asSymbol. #all}.
	slips := OrderedCollection new.
	self changedClasses do:
		[:aClass |
		(self methodChangesAtClass: aClass name) associationsDo: 
				[:mAssoc | | aSelector | (aClass includesSelector:  (aSelector := mAssoc key)) ifTrue:
						[(notClassified includes: (aClass organization categoryOfElement: aSelector))
								ifTrue: [slips add: aClass name , ' ' , aSelector]]]].
	^ slips

	"Smalltalk browseMessageList: (ChangeSet current methodsWithoutClassifications) name: 'unclassified methods'"! !

!ChangeSet methodsFor: 'private' stamp: 'di 3/23/2000 08:37'!
addCoherency: className
	"SqR!! 19980923: If I recreate the class then don't remove it"

	(self changeRecorderFor: className)
		checkCoherence.
"
	classRemoves remove: className ifAbsent: [].
	(classChanges includesKey: className) ifTrue:
		[(classChanges at: className) remove: #remove ifAbsent: []]
"! !

!ChangeSet class methodsFor: 'current changeset' stamp: 'StephaneDucasse 12/19/2012 10:50'!
newChanges: aChangeSet 
	"Set the system ChangeSet to be the argument, aChangeSet."
	"pay attention not to use newChanges in current and other methods to avoid infinite cycles."
	
	self newChanges: aChangeSet withOld: self current.
	

	! !

!ChangeSet class methodsFor: 'enumerating' stamp: 'CamilloBruni 8/1/2012 16:11'!
named: aName
	"Return the change set of the given name, or nil if none found."

	^ AllChangeSets
			detect: [:aChangeSet | aChangeSet name = aName]
			ifNone: [nil]! !

!ChangeSet class methodsFor: '*System-FileRegistry' stamp: 'ar 7/15/2005 21:36'!
services
	^ Array with: self serviceFileIntoNewChangeSet! !

!ChangeSet class methodsFor: 'enumerating' stamp: 'ar 7/15/2005 21:22'!
allChangeSetsWithClass: class selector: selector
	class ifNil: [^ #()].
	^ self allChangeSets select: 
		[:cs | (cs atSelector: selector class: class) ~~ #none]! !

!ChangeSet class methodsFor: 'filein/out' stamp: 'MarcusDenker 8/9/2014 13:33'!
fileOutChangeSetsNamed: nameList
	"File out the list of change sets whose names are provided"
     "ChangesOrganizer fileOutChangeSetsNamed: #('New Changes' 'miscTidies-sw')"

	| notFound empty infoString |
	notFound := OrderedCollection new.
	empty := OrderedCollection new.
	nameList do:
		[:aName | | aChangeSet | 
			(aChangeSet := self named: aName)
				ifNotNil: [aChangeSet isEmpty
							ifTrue: [empty add: aName]
							ifFalse: [aChangeSet fileOut]]
				ifNil: [notFound add: aName]].

	infoString := (nameList size - notFound size) printString, ' change set(s) filed out'.
	notFound notEmpty ifTrue:
		[infoString := infoString, '

', notFound size printString, ' change set(s) not found:'.
		notFound do:
			[:aName | infoString := infoString, '
', aName]].
	empty notEmpty ifTrue:
		[infoString := infoString, '
', empty size printString, ' change set(s) were empty:'.
		empty do:
			[:aName | infoString := infoString, '
', aName]].

	self inform: infoString! !

!ChangeSet class methodsFor: 'initialization' stamp: 'ClementBera 7/26/2013 16:13'!
initialize
	"ChangeSet initialize"

	AllChangeSets ifNil: [ AllChangeSets := OrderedCollection new ].
	self gatherChangeSets.
	FileServices registerFileReader: self! !

!ChangeSet class methodsFor: 'scanning' stamp: 'MartinDias 11/6/2013 16:32'!
scanVersionsOf: aMethod class: aClass meta: isMeta category: aCategory selector: aSelector

	| changeRecords |
	changeRecords := OrderedCollection new.

	SourceFiles 
		changeRecordsFrom: aMethod sourcePointer
		className: aClass name
		isMeta: isMeta
		do: [ :changeRecord |
			changeRecords add: changeRecord ].
		
	^ changeRecords! !

!ChangeSet class methodsFor: 'enumerating' stamp: 'ar 7/15/2005 21:29'!
mostRecentChangeSetWithChangeForClass: class selector: selector
	| hits |
	hits := self allChangeSets select: 
		[:cs | (cs atSelector: selector class: class) ~~ #none].
	hits isEmpty ifTrue: [^ 'not in any change set'].
	^ 'recent cs: ', hits last name! !

!ChangeSet class methodsFor: 'services' stamp: 'MarcusDenker 8/9/2014 13:32'!
newChangeSet
	"Prompt the user for a name, and establish a new change set of
	that name (if ok), making it the current changeset.  Return nil
	of not ok, else return the actual changeset."

	| newName newSet |
	newName := UIManager default
		request: 'Please name the new change set:'
		initialAnswer: self defaultName.
	newName isEmptyOrNil ifTrue:
		[^ nil].
	newSet := self basicNewChangeSet: newName.
	newSet ifNotNil:
		[self  newChanges: newSet].
	^ newSet! !

!ChangeSet class methodsFor: 'settings' stamp: 'AlainPlantec 12/18/2009 14:14'!
defaultChangeSetDirectoryName: aName
	DefaultChangeSetDirectoryName  := aName! !

!ChangeSet class methodsFor: 'enumerating' stamp: 'ar 7/15/2005 21:11'!
changeSetsNamedSuchThat: nameBlock
	"(ChangeSet changeSetsNamedSuchThat:
		[:name | name first isDigit and: [name initialInteger >= 373]])
		do: [:cs | AllChangeSets remove: cs wither]"

	^ AllChangeSets select: [:aChangeSet | nameBlock value: aChangeSet name]! !

!ChangeSet class methodsFor: 'settings' stamp: 'AlainPlantec 12/7/2009 10:58'!
mustCheckForSlips: aBoolean
	MustCheckForSlips := aBoolean! !

!ChangeSet class methodsFor: 'defaults' stamp: 'lr 3/12/2010 22:16'!
uniqueNameLike: aString 
	| try index |
	(self named: aString)
		ifNil: [ ^ aString ].
	index := 1.
	[ try := aString , index printString.
	  (self named: try)
		ifNil: [ ^ try ].
	  index := index + 1 ] repeat
! !

!ChangeSet class methodsFor: '*System-FileRegistry' stamp: 'CamilloBruni 2/3/2013 17:21'!
fileReaderServicesForFile: fullName suffix: suffix
	<fileService>

	^ (FileStream isSourceFileSuffix: suffix)
		ifTrue: [ self services]
		ifFalse: [#()]! !

!ChangeSet class methodsFor: 'enumerating' stamp: 'ar 7/15/2005 21:26'!
removeChangeSetsNamedSuchThat: nameBlock
	(self changeSetsNamedSuchThat: nameBlock)
		do: [:cs | self removeChangeSet: cs]! !

!ChangeSet class methodsFor: 'enumerating' stamp: 'ar 7/15/2005 21:20'!
allChangeSetNames
	^ self allChangeSets collect: [:c | c name]! !

!ChangeSet class methodsFor: 'current changeset' stamp: 'BernardoContreras 11/1/2014 18:47'!
newChanges: aChangeSet withOld: old
	"Set the system ChangeSet to be the argument, aChangeSet."

	SystemAnnouncer uniqueInstance unsubscribe: old.
	current := aChangeSet.
	
	SystemAnnouncer uniqueInstance private weak
		when: ClassRemoved send: #classRemoved: to: aChangeSet;
		when: ClassAdded send: #classAdded: to: aChangeSet;
		when: ClassCommented send: #classCommented: to: aChangeSet;
		when: ClassRenamed send: #classRenamed: to: aChangeSet;
		when: ClassReorganized send: #classReorganized: to: aChangeSet;
		when: ClassRecategorized send: #classRecategorized: to: aChangeSet;
		when: ClassModifiedClassDefinition send: #classModified: to: aChangeSet.
	
	SystemAnnouncer uniqueInstance private weak
		when: MethodAdded send: #methodAdded: to: aChangeSet;
		when: MethodModified send: #methodModified: to: aChangeSet;
		when: MethodRemoved send: #methodRemoved: to: aChangeSet;
		when: MethodRecategorized  send: #methodRecategorized: to: aChangeSet.
		
	
	SystemAnnouncer uniqueInstance announce: (CurrentChangeSetChanged new old: old; new: aChangeSet ; yourself).
	! !

!ChangeSet class methodsFor: 'enumerating' stamp: 'MarcusDenker 8/9/2014 13:32'!
gatherChangeSets		"ChangeSet gatherChangeSets"
	"Collect any change sets created in other projects"
	| allChangeSets |
	allChangeSets := AllChangeSets asSet.
	self allSubInstances do: [:each | | obsolete |
		(allChangeSets includes: each) == (obsolete := each isMoribund) ifTrue:[
			obsolete
				ifTrue: ["Was included and is obsolete."
						AllChangeSets remove: each]
				ifFalse: ["Was not included and is not obsolete."
						AllChangeSets add: each]]].
	^ AllChangeSets! !

!ChangeSet class methodsFor: 'enumerating' stamp: 'ar 7/15/2005 21:17'!
allChangeSets: aCollection
	"Return the list of all current ChangeSets"

	AllChangeSets := aCollection.! !

!ChangeSet class methodsFor: 'filein/out' stamp: 'MarcusDenker 5/8/2013 19:28'!
traitsOrder: aCollection 
	"Arrange the traits in the collection, first who don't depend on others."

	| unprocessed |
	unprocessed := aCollection asSet. 
	^ Array new: unprocessed size streamContents: [ :stream |
		unprocessed size timesRepeat: [ 
			| aTrait |
			aTrait := unprocessed detect: [ :each | self hasNoDependenciesFor: each in: unprocessed ].
			stream nextPut: aTrait.
			unprocessed remove: aTrait] ]! !

!ChangeSet class methodsFor: 'current changeset' stamp: 'MarcusDenker 7/16/2013 11:32'!
current
	"return the current changeset assure first that we have a named changeset."
	
	(current isNil or: [current isMoribund])
		ifTrue: [self newChanges: (self assuredChangeSetNamed: 'Unnamed') withOld: current] .
	^ current! !

!ChangeSet class methodsFor: '*System-FileRegistry' stamp: 'tbn 8/11/2010 10:11'!
serviceFileIntoNewChangeSet
	"Answer a service for installing a file into a new change set"

	^ SimpleServiceEntry 
		provider: self 
		label: 'Install into new change set'
		selector: #fileIntoNewChangeSet:
		description: 'Install the file as a body of code in the image: create a new change set and file-in the selected file into it'
		buttonLabel: 'Install'! !

!ChangeSet class methodsFor: 'services' stamp: 'MarcusDenker 10/3/2013 23:44'!
assuredChangeSetNamed: aName
	"Answer a change set of the given name.  If one already exists, answer that, else create a new one and answer it."

	^ (self named: aName)
		ifNotNil: [:existing | existing]
		ifNil: [self basicNewChangeSet: aName]! !

!ChangeSet class methodsFor: 'services' stamp: 'StephaneDucasse 3/30/2010 23:03'!
reorderChangeSets
	"Change the order of the change sets to something more convenient:
		First come all numbered updates.
		Next come all remaining changesets"

	"self reorderChangeSets"
	
	| newMid newTail |
	newMid := OrderedCollection new.
	newTail := OrderedCollection new.
	self allChangeSets do:
		[:aChangeSet |
			aChangeSet isNumbered
						ifTrue: [newMid add: aChangeSet]
						ifFalse: [newTail add: aChangeSet]].
	self  allChangeSets: newMid, newTail.
	! !

!ChangeSet class methodsFor: 'settings' stamp: 'AlainPlantec 12/7/2009 10:58'!
mustCheckForSlips
	^ MustCheckForSlips ifNil: [MustCheckForSlips := true]! !

!ChangeSet class methodsFor: 'defaults' stamp: 'dgd 9/6/2003 19:56'!
defaultName
	^ self uniqueNameLike: 'Unnamed' translated! !

!ChangeSet class methodsFor: 'enumerating' stamp: 'ar 7/15/2005 21:10'!
allChangeSets
	"Return the list of all current ChangeSets"

	^ AllChangeSets! !

!ChangeSet class methodsFor: 'services' stamp: 'ar 7/15/2005 21:38'!
doesAnyChangeSetHaveClass: aClass andSelector: aSelector
	"Answer whether any known change set bears a change for the given class and selector"

	^ (self countOfChangeSetsWithClass: aClass andSelector: aSelector) > 0! !

!ChangeSet class methodsFor: 'instance creation' stamp: 'di 4/6/2001 09:43'!
basicNewNamed: aName

	^ (self basicNew name: aName) initialize! !

!ChangeSet class methodsFor: 'filein/out' stamp: 'MarianoMartinezPeck 9/3/2012 12:36'!
hasNoDependenciesFor: aTrait in: traits
	"Answer if the trait does not depend on a trait in the collection."

	^ traits allSatisfy: [ :another |
		aTrait == another or: [ "are the same"
			aTrait ~= another classSide and: [ "is not the classTrait of another"
				(aTrait traitComposition allTraits includes: another) not ] ] ]! !

!ChangeSet class methodsFor: 'enumerating' stamp: 'ar 7/15/2005 21:14'!
basicNewChangeSet: newName
	| newSet |
	newName ifNil: [^ nil].
	(self named: newName) ifNotNil:
		[self inform: 'Sorry that name is already used'.
		^ nil].
	newSet := self basicNewNamed: newName.
	AllChangeSets add: newSet.
	^ newSet! !

!ChangeSet class methodsFor: 'cleanup' stamp: 'MarcusDenker 8/9/2014 13:32'!
cleanUp: aggressive
	"Only delete change sets when being aggressive"

	aggressive
		ifFalse: [ ^ self ].
	ChangeSet removeChangeSetsNamedSuchThat: [ :each | true ].
	ChangeSet resetCurrentToNewUnnamedChangeSet! !

!ChangeSet class methodsFor: 'scanning' stamp: 'MarcusDenker 5/18/2013 15:44'!
scanCategory: file
	"Scan anything that involves more than one chunk; method name is historical only"
	| itemPosition item tokens stamp isComment anIndex |
	itemPosition := file position.
	item := file nextChunk.

	isComment := (item includesSubstring: 'commentStamp:').
	(isComment or: [item includesSubstring: 'methodsFor:']) ifFalse:
		["Maybe a preamble, but not one we recognize; bail out with the preamble trick"
		^{(ChangeRecord new file: file position: itemPosition type: #preamble)}].

	tokens := item parseLiterals.
	tokens size >= 3 ifTrue:
		[stamp := ''.
		anIndex := tokens indexOf: #stamp: ifAbsent: [nil].
		anIndex ifNotNil: [stamp := tokens at: (anIndex + 1)].

		tokens second == #methodsFor:
			ifTrue: [^ self scanFile: file category: tokens third class: tokens first
							meta: false stamp: stamp].
		tokens third == #methodsFor:
			ifTrue: [^ self scanFile: file category: tokens fourth class: tokens first
							meta: true stamp: stamp]].

		tokens second == #commentStamp:
			ifTrue:
				[stamp := tokens third.
				item := (ChangeRecord new file: file position: file position type: #classComment
										class: tokens first category: nil meta: false stamp: stamp).
				file nextChunk.
				file skipStyleChunk.
				^Array with: item].
	^#()! !

!ChangeSet class methodsFor: 'enumerating' stamp: 'ar 7/15/2005 21:13'!
promoteToTop: aChangeSet
	"Make aChangeSet the first in the list from now on"

	AllChangeSets remove: aChangeSet ifAbsent: [^ self].
	AllChangeSets add: aChangeSet! !

!ChangeSet class methodsFor: 'services' stamp: 'CamilloBruni 5/4/2012 21:29'!
newChangeSet: aName
	"Makes a new change set called aName, add author full name to try to
	ensure a unique change set name."

	| newName |
	newName := aName , '.' , Author fullName.
	^ self basicNewChangeSet: newName! !

!ChangeSet class methodsFor: 'enumerating' stamp: 'ar 7/15/2005 21:13'!
removeChangeSet: aChangeSet
	"Remove the given changeSet.  Caller must assure that it's cool to do this"

	AllChangeSets remove: aChangeSet ifAbsent: [].
	aChangeSet wither
! !

!ChangeSet class methodsFor: 'services' stamp: 'MarcusDenker 8/9/2014 13:32'!
newChangesFromStream: aStream named: aName
	"File in the code from the stream into a new change set whose
	name is derived from aName. Leave the 'current change set'
	unchanged. Return the new change set or nil on failure."

	| oldChanges newName newSet |
	oldChanges := self current.
	newName := aName withoutPeriodSuffix.
	newSet := self basicNewChangeSet: newName.
	[ | newStream |
	      newSet ifNotNil:[
			(aStream respondsTo: #converter:) ifFalse: [
				newStream := MultiByteBinaryOrTextStream with: (aStream contentsOfEntireFile).
				newStream reset.] ifTrue: [newStream := aStream].
			self newChanges: newSet.
			newStream setConverterForCode.
			CodeImporter evaluateReadStream: newStream readStream].
	aStream close] ensure: [self newChanges: oldChanges].
	^ newSet! !

!ChangeSet class methodsFor: 'scanning' stamp: 'MarcusDenker 8/9/2014 13:34'!
scanFile: file from: startPosition to: stopPosition
	| changeList |
	changeList := OrderedCollection new.
	file position: startPosition.
'Scanning ', file localName, '...'
	displayProgressFrom: startPosition to: stopPosition
	during: [:bar | | prevChar itemPosition item |
	[file position < stopPosition] whileTrue:[
		bar current: file position.
		[file atEnd not and: [file peek isSeparator]]
			whileTrue: [prevChar := file next].
		(file peekFor: $!!) ifTrue:[
			(prevChar = Character cr or: [prevChar = Character lf])
				ifTrue: [changeList addAll: (self scanCategory: file)].
		] ifFalse:[
			itemPosition := file position.
			item := file nextChunk.
			file skipStyleChunk.
			item notEmpty ifTrue:[
				changeList add: (ChangeRecord new file: file position: itemPosition type: #doIt).
			].
		].
	]].
	^changeList! !

!ChangeSet class methodsFor: 'services' stamp: 'GuillermoPolito 3/4/2015 16:28'!
fileIntoNewChangeSet: fullName
	"File in all of the contents of the currently selected file, if any, into a new change set." 

	| fn ff |
	fullName ifNil: [^ self ].
	
	fn := (Smalltalk hasClassNamed: #GZipReadStream) 
		ifTrue: [(Smalltalk classNamed:  #GZipReadStream) uncompressedFileName: fullName]
		ifFalse: [fullName].
	[ ff := FileStream readOnlyFileNamed: fn.
	self newChangesFromStream: ff named: (fn  asFileReference basename)]
		ensure: [ff ifNotNil: [ff close]]! !

!ChangeSet class methodsFor: 'current changeset' stamp: 'sd 9/8/2006 21:05'!
resetCurrentToNewUnnamedChangeSet
 
	current := self new.  
	self newChanges: current ! !

!ChangeSet class methodsFor: 'defaults' stamp: 'CamilloBruni 5/7/2012 01:08'!
defaultChangeSetDirectory
	"Answer the directory in which to store ChangeSets. 
	Answer the default directory if the preferred directory doesn't exist."
	| dir directoryName |
	directoryName := self defaultChangeSetDirectoryName.
	dir := directoryName isEmptyOrNil
		ifTrue: [ FileSystem workingDirectory ]
		ifFalse: [ FileSystem workingDirectory / directoryName ].
	dir exists
		ifTrue: [^ dir].
	^ FileSystem workingDirectory! !

!ChangeSet class methodsFor: 'system-events' stamp: 'GuillermoPolito 7/31/2012 11:59'!
registerInterestToSystemAnnouncer
	<systemEventRegistration>
	self newChanges: self current.! !

!ChangeSet class methodsFor: 'filein/out' stamp: 'MarcusDenker 5/8/2013 19:26'!
classesOrder: classes
	"Answer a collection with the classes ordered so they can be filed in."

	| listInOrder |
	"SharedPools need to go first"
	listInOrder := Class superclassOrder: (classes select: [ :each | each inheritsFrom: SharedPool ]).
	listInOrder addAll: (Class superclassOrder: (classes reject: [ :each | each inheritsFrom: SharedPool ])).
	^ listInOrder! !

!ChangeSet class methodsFor: 'defaults' stamp: 'S 6/17/2013 13:26'!
promptForDefaultChangeSetDirectoryIfNecessary
	"Check the Preference (if any), and prompt the
	user to change it if necessary.
	The default if the Preference is unset is the current
	directory. Answer the directory."
	"ChangeSet
	promptForDefaultChangeSetDirectoryIfNecessary"
	| choice directoryPath dir message |
	directoryPath := self defaultChangeSetDirectoryName.
	[dir := directoryPath asFileReference.
	dir exists] 
		whileFalse: [message := 'The preferred change set directory' translated , ' (''{1}'') ' , 'does not exist.' translated , '
' , 'Create it or use the default directory' translated , ' ({2})?' format: {directoryPath. FileSystem workingDirectory fullName}.
			choice := UIManager default
						chooseFrom: (#('Create directory' 'Use default directory and forget preference' 'Choose another directory' )
								collect: [:ea | ea translated])
						message: message.
			choice = 1
				ifTrue: [dir ensureCreateDirectory ].
			choice = 3
				ifTrue: [dir := UIManager default chooseDirectory.
					directoryPath := dir
								ifNil: ['']
								ifNotNil: [dir pathName]]].
	self defaultChangeSetDirectory: directoryPath.
	^ dir! !

!ChangeSet class methodsFor: 'instance creation' stamp: 'MarcusDenker 8/9/2014 13:32'!
new
	"All current changeSets must be registered in the AllChangeSets collection.
	Due to a quirk of history, this is maintained as class variable of ChangeSorter."

	^ self basicNewChangeSet: self defaultName! !

!ChangeSet class methodsFor: 'scanning' stamp: 'MarcusDenker 8/9/2014 13:33'!
scanFile: file category: cat class: class meta: meta stamp: stamp
	| itemPosition method items |
	items := OrderedCollection new.
	[itemPosition := file position.
	method := file nextChunk.
	file skipStyleChunk.
	method notEmpty] whileTrue:[
		items add: (ChangeRecord new file: file position: itemPosition type: #method
							class: class category: cat meta: meta stamp: stamp)].
	^items! !

!ChangeSet class methodsFor: 'services' stamp: 'ar 7/15/2005 21:37'!
countOfChangeSetsWithClass: aClass andSelector: aSelector
	"Answer how many change sets record a change for the given class and selector"

	^ (self allChangeSetsWithClass: aClass selector: aSelector) size! !

!ChangeSet class methodsFor: 'defaults' stamp: 'StephaneDucasse 6/11/2012 17:53'!
defaultChangeSetDirectory: dirOrName 
	"Set the Preference for storing change sets to the given directory or name (possibly relative).
	Rewrite directory names below the default directory as relative names.
	If dirOrName is an empty string, use the default directory."

	"ChangeSet defaultChangeSetDirectory: 'changeSets'"

	| dirName defaultFullName |
	
	dirName := dirOrName isString
				ifTrue: [ dirOrName asFileReference fullName ]
				ifFalse: [dirOrName fullName].
				
	defaultFullName := FileSystem workingDirectory fullName.
	dirName = defaultFullName
		ifTrue: [dirName := '']
		ifFalse: [
			(dirName beginsWith: defaultFullName , FileSystem disk delimiter asString)
				ifTrue: [dirName := dirName copyFrom: defaultFullName size + 2 to: dirName size]].
	self defaultChangeSetDirectoryName: dirName! !

!ChangeSet class methodsFor: 'settings' stamp: 'StephaneDucasse 6/11/2012 18:04'!
defaultChangeSetDirectoryName
	^ DefaultChangeSetDirectoryName ifNil: [DefaultChangeSetDirectoryName := '.']! !

!ChangeSetClassChangesTest commentStamp: 'dtl 2/19/2005 13:21'!
Class category changes are not being properly added to the default changeset in Squeak 3.7. This test case will pass in Squeak 3.6, and fail in Squeak 3.[7-9].
!
!ChangeSetClassChangesTest methodsFor: 'testing' stamp: 'lr 3/14/2010 21:13'!
testChangeClassCategory
	"Changing the class category for a class should result in a change
	record being added to the current change set."

	| saveClassDefinition |
	"Define a class and save its definition"
	Object
		subclass: #JunkClass
		instanceVariableNames: 'zzz'
		classVariableNames: ''
		poolDictionaries: ''
		category: 'DeleteMe-1'.
	saveClassDefinition := (Smalltalk globals classNamed: #JunkClass) definition.
	self assert: saveClassDefinition = (ChangeSet current fatDefForClass: (Smalltalk globals classNamed: #JunkClass)).	"Redefine the class, changing only the class category"
	Object
		subclass: #JunkClass
		instanceVariableNames: 'zzz'
		classVariableNames: ''
		poolDictionaries: ''
		category: 'DeleteMe-2'.	"Assert that the class definition has changed"
	self deny: (self isDefinition: (Smalltalk globals classNamed: #JunkClass) definition equivalentTo: saveClassDefinition).
	self
		deny:
			(self
				isDefinition: saveClassDefinition
				equivalentTo: (ChangeSet current fatDefForClass: (Smalltalk globals classNamed: #JunkClass))).
	self
		assert:
			(self
				isDefinition: (Smalltalk globals classNamed: #JunkClass) definition
				equivalentTo: (ChangeSet current fatDefForClass: (Smalltalk globals classNamed: #JunkClass))).	"Assert that the change has been recorded in the current change set"
	self
		assert:
			(self
				isDefinition: (ChangeSet current changeRecorderFor: (Smalltalk globals classNamed: #JunkClass)) priorDefinition
				equivalentTo:
					'Object subclass: #JunkClass
	instanceVariableNames: ''zzz ''
	classVariableNames: ''''
	poolDictionaries: ''''
	category: ''DeleteMe-2''')! !

!ChangeSetClassChangesTest methodsFor: 'support' stamp: 'dtl 2/19/2005 13:08'!
isDefinition: firstString equivalentTo: secondString 
	"When a class definition is reconstructed with #fatDefForClass, it may 
	contain extra trailing space characters in parts of the definition. This 
	is probably a minor bug, but it should be overlooked for purposes of 
	testing the change set update mechanism. The expedient here is to just 
	remove spaces before comparing the definition strings."

	^ firstString notNil
		and: [(firstString copyReplaceAll: ' ''' with: '''')
				= (secondString copyReplaceAll: ' ''' with: '''')]! !

!ChangeSetClassChangesTest methodsFor: 'running' stamp: 'lr 3/14/2010 21:13'!
tearDown
	(Smalltalk globals classNamed: #JunkClass) ifNotNil: [ :c | c removeFromSystem: true ].
	SystemOrganization removeCategory: #'DeleteMe-1'.
	SystemOrganization removeCategory: #'DeleteMe-2'.
	ChangeSet current removeClassChanges: 'JunkClass'! !

!ChangeSetClassChangesTest methodsFor: 'testing' stamp: 'lr 3/14/2010 21:13'!
testAddInstanceVariable
	"Adding an instance variable to the class should result in a change
	record being added to the current change set."

	| saveClassDefinition |
	"Define a class and save its definition"
	Object
		subclass: #JunkClass
		instanceVariableNames: 'zzz'
		classVariableNames: ''
		poolDictionaries: ''
		category: 'DeleteMe-1'.
	saveClassDefinition := (Smalltalk globals classNamed: #JunkClass) definition.
	self
		assert:
			(self
				isDefinition: saveClassDefinition
				equivalentTo: (ChangeSet current fatDefForClass: (Smalltalk globals classNamed: #JunkClass))).	"Redefine the class, adding one instance variable"
	Object
		subclass: #JunkClass
		instanceVariableNames: 'zzz aaa'
		classVariableNames: ''
		poolDictionaries: ''
		category: 'DeleteMe-1'.	"Assert that the class definition has changed"
	self deny: (self isDefinition: (Smalltalk globals classNamed: #JunkClass) definition equivalentTo: saveClassDefinition).
	self
		deny:
			(self
				isDefinition: saveClassDefinition
				equivalentTo: (ChangeSet current fatDefForClass: (Smalltalk globals classNamed: #JunkClass))).
	self
		assert:
			(self
				isDefinition: (Smalltalk globals classNamed: #JunkClass) definition
				equivalentTo: (ChangeSet current fatDefForClass: (Smalltalk globals classNamed: #JunkClass))).	"Assert that the change has been recorded in the current change set"
	self
		assert:
			(self
				isDefinition: (ChangeSet current changeRecorderFor: (Smalltalk globals classNamed: #JunkClass)) priorDefinition
				equivalentTo: saveClassDefinition)! !

!ChangeSetClassChangesTest methodsFor: 'testing' stamp: 'lr 3/14/2010 21:13'!
testAddInstanceVariableAddsNewChangeRecord
	"Changing the class category for a class should result in a change
	record being updated in the current change set."

	"At the start of this test, JunkClass should not exist, and there should be
	no change records pertaining to it in the change set."

	self deny: (Smalltalk hasClassNamed: 'JunkClass').
	self assert: (ChangeSet current changeRecorderFor: (Smalltalk globals classNamed: #JunkClass)) thisName = 'nil'.	"Remove bogus change records created as side effect of preceding assert"
	ChangeSet current removeClassChanges: 'nil'.	"Define a class and save its definition"
	Object
		subclass: #JunkClass
		instanceVariableNames: 'zzz'
		classVariableNames: ''
		poolDictionaries: ''
		category: 'DeleteMe-1'.	"Forget about JunkClass in the change set"
	ChangeSet current removeClassChanges: 'JunkClass'.	"Redefine the class, adding one instance variable"
	Object
		subclass: #JunkClass
		instanceVariableNames: 'zzz aaa'
		classVariableNames: ''
		poolDictionaries: ''
		category: 'DeleteMe-1'.	"A change record should now exist in the change set"
	self
		assert:
			(self
				isDefinition: (ChangeSet current changeRecorderFor: (Smalltalk globals classNamed: #JunkClass)) priorDefinition
				equivalentTo:
					'Object subclass: #JunkClass
	instanceVariableNames: ''zzz ''
	classVariableNames: ''''
	poolDictionaries: ''''
	category: ''DeleteMe-1''')! !

!ChangeSetClassChangesTest methodsFor: 'testing' stamp: 'lr 3/14/2010 21:13'!
testChangeClassCategoryAddsNewChangeRecord
	"Changing the class category for a class should result in a change
	record being updated in the current change set."

	"At the start of this test, JunkClass should not exist, and there should be
	no change records pertaining to it in the change set."

	self deny: (Smalltalk hasClassNamed: 'JunkClass').
	self assert: (ChangeSet current changeRecorderFor: (Smalltalk globals classNamed: #JunkClass)) thisName = 'nil'.	"Remove bogus change records created as side effect of preceding assert"
	ChangeSet current removeClassChanges: 'nil'.	"Define a class and save its definition"
	Object
		subclass: #JunkClass
		instanceVariableNames: 'zzz'
		classVariableNames: ''
		poolDictionaries: ''
		category: 'DeleteMe-1'.	"Forget about JunkClass in the change set"
	ChangeSet current removeClassChanges: 'JunkClass'.	"Redefine the class, changing only the class category"
	Object
		subclass: #JunkClass
		instanceVariableNames: 'zzz'
		classVariableNames: ''
		poolDictionaries: ''
		category: 'DeleteMe-2'.	"A change record should now exist in the change set"
	self
		assert:
			(self
				isDefinition: (ChangeSet current changeRecorderFor: (Smalltalk globals classNamed: #JunkClass)) priorDefinition
				equivalentTo:
					'Object subclass: #JunkClass
	instanceVariableNames: ''zzz ''
	classVariableNames: ''''
	poolDictionaries: ''''
	category: ''DeleteMe-2''')! !

!ChangeSetClassChangesTest methodsFor: 'testing' stamp: 'wiz 8/13/2006 17:55'!
testInitialChangeSet
	"Run this to assure the initial changeset is named. Checks bug found in 3.9 7052."
	"self new testInitialChangeSet"
	"self run:  #testInitialChangeSet"

	self deny: (ChangeSet current printString = 'a ChangeSet named <no name -- garbage?>') .
	
^true! !

!ChangeSorterApplication commentStamp: '<historical>'!
A ChangeSorterApplication is spec version of the dual sorter.

ChangeSorterApplication 
	new openWithSpec!
!ChangeSorterApplication methodsFor: 'api' stamp: ''!
currentText

	 ^ textModel getText! !

!ChangeSorterApplication methodsFor: 'menu - change set' stamp: ''!
fileOut

	self selectedChangeSet fileOut! !

!ChangeSorterApplication methodsFor: 'api' stamp: 'StephaneDucasse 11/2/2012 16:06'!
updateChangesList

	| sel |
	sel := self selectedChangeSet.
	changesListModel items: self model allChanges.
	changesListModel setSelectedItem: sel.! !

!ChangeSorterApplication methodsFor: 'accessing' stamp: ''!
methodsListModel

	^ methodsListModel! !

!ChangeSorterApplication methodsFor: 'menu - change set' stamp: ''!
removePostscript

	self model removePostscriptFrom: self selectedChangeSet.
	changesListModel setSelectedItem: self selectedChangeSet! !

!ChangeSorterApplication methodsFor: 'menu - message' stamp: 'MarcusDenker 6/28/2014 11:37'!
browseVersions
	"Create and schedule a changelist browser on the versions of the 
	selected message."
	
	self selectedClass ifNotNil: [:class |
		self selectedSelector ifNotNil: [:selector || method |
			method := class compiledMethodAt: selector 
								ifAbsent: [ ^ self inform: 'Sorry, only actual methods have retrievable versions.' ].
			self model browseVersionsFrom: method ]]! !

!ChangeSorterApplication methodsFor: 'api' stamp: ''!
methodsMenu: aBlock

	methodsListModel menu: aBlock! !

!ChangeSorterApplication methodsFor: 'menu' stamp: 'StephaneDucasse 2/14/2014 13:10'!
changeSetMenu2: aMenu shifted: isShifted 
	"Set up aMenu to hold commands for the change-set-list pane.  This could be for a single or double changeSorter"

	aMenu addAllFromPragma: 'changeSorterChangeSetList2Menu' target: self.
	^aMenu
! !

!ChangeSorterApplication methodsFor: 'api' stamp: ''!
selectedClassIndex

	 ^ classesListModel selectedIndex! !

!ChangeSorterApplication methodsFor: 'menu - change set' stamp: ''!
rename

	| set |
	set := self model rename: self selectedChangeSet.
	
	changesListModel 
		updateList;
		setSelectedItem: set! !

!ChangeSorterApplication methodsFor: 'initialization' stamp: 'EstebanLorenzano 9/8/2013 16:06'!
initialize

	prettyPrint := false.
	showDiff := false.
	model := ChangeSorterModel new.
	SystemAnnouncer uniqueInstance weak
		when: CurrentChangeSetChanged send: #updateTitle to: self.
	super initialize.
	self initializeAnnouncements.
	
	
	! !

!ChangeSorterApplication methodsFor: 'initialization' stamp: 'StephaneDucasse 5/17/2012 19:32'!
registerSelectorActions

	methodsListModel whenSelectedItemChanged: [:selector |
		self updateTextContents ]! !

!ChangeSorterApplication methodsFor: 'api-events' stamp: 'StephaneDucasse 5/17/2012 19:31'!
whenChangesListChanges: aBlock

	changesListModel whenListChanged: aBlock! !

!ChangeSorterApplication methodsFor: 'initialization' stamp: 'BernardoContreras 9/27/2014 13:46'!
initializeAnnouncements
	SystemAnnouncer uniqueInstance weak 
		when:
			ClassAdded , ClassCommented , ClassRecategorized , ClassModifiedClassDefinition , ClassRemoved , ClassRenamed
				, ClassReorganized , MethodAdded , MethodModified , MethodRecategorized , MethodRemoved , ProtocolAdded
				, ProtocolRemoved
		send: #updateClassesList
		to: self! !

!ChangeSorterApplication methodsFor: 'accessing' stamp: ''!
textModel

	^ textModel! !

!ChangeSorterApplication methodsFor: 'initialization' stamp: 'StephaneDucasse 11/2/2012 14:44'!
registerChangeActions
	
	changesListModel
		whenSelectedItemChanged: [:change | 
			classesListModel resetSelection.
			self updateTextContents.
			change 
				ifNil: [
					classesListModel items: {}.
					methodsListModel items: {}.
					]
				ifNotNil: [
					classesListModel items: (change changedClasses sort: [:a :b | a name < b name ]).
					 ]].
	! !

!ChangeSorterApplication methodsFor: 'shortcuts' stamp: 'GuillermoPolito 8/10/2014 14:11'!
registerMethodShortcuts: aWidget

	aWidget bindKeyCombination: PharoShortcuts current browseShortcut toAction: [ self selectedSelector ifNotNil:[ self browseMethodFull ]].
	aWidget bindKeyCombination: $d command toAction: [ self selectedSelector ifNotNil:[ self forgetMessage ]].
	aWidget bindKeyCombination: PharoShortcuts current browseImplementorsShortcut toAction: [ self selectedSelector ifNotNil:[ self browseImplementorsOfMessages ]].
	aWidget bindKeyCombination: PharoShortcuts current browseSendersShortcut toAction: [ self selectedSelector ifNotNil:[ self browseSendersOfMessages ]].
	aWidget bindKeyCombination: PharoShortcuts current browseVersionsShortcut toAction: [ self selectedSelector ifNotNil:[ self browseVersions ]].
	aWidget bindKeyCombination: PharoShortcuts current removeShortcut toAction: [ self selectedSelector ifNotNil:[ self removeMessage ]].! !

!ChangeSorterApplication methodsFor: 'menu - change set' stamp: ''!
newSet

	| aSet |
	self okToChange ifFalse: [ ^ self ].
	aSet := self model createNewSet.
	aSet ifNotNil:
		[	self updateChangesList.
			changesListModel setSelectedItem: aSet ]! !

!ChangeSorterApplication methodsFor: 'menu - message' stamp: ''!
browseImplementorsOfMessages

	self model browseMessagesFrom: self selectedSelector! !

!ChangeSorterApplication methodsFor: 'menu' stamp: 'StephaneDucasse 11/11/2014 17:59'!
classMenu: aMenu shifted: shifted
	"Fill aMenu with items appropriate for the class list"

	self selectedClass ifNil: [ ^ nil ].
	aMenu addTitle: 'Class list'.
	aMenu addAllFromPragma: 'changeSorterClassListMenu' target: self.
	^ aMenu! !

!ChangeSorterApplication methodsFor: 'menu - class' stamp: ''!
forgetClass
	"Remove all mention of this class from the changeSet"

	self okToChange ifFalse: [^ self].
	self selectedClass ifNotNil: [:class |
		self model removeClass: class from: self selectedChangeSet.
		self setSelectedChangeSet: self selectedChangeSet ].
! !

!ChangeSorterApplication methodsFor: 'api' stamp: ''!
selectorsMenu: aBlock

	methodsListModel menu: aBlock! !

!ChangeSorterApplication methodsFor: 'shortcuts' stamp: ''!
methodShortcuts: event from: aMorph

	self selectedSelector
		ifNotNil:[
			event keyString = '<Cmd-b>' 		ifTrue: [ ^ self browseMethodFull ].
			event keyString = '<Cmd-d>' 		ifTrue: [ ^ self forgetMessage ].
			event keyString = '<Cmd-m>' 	ifTrue: [ ^ self browseImplementorsOfMessages ].
			event keyString = '<Cmd-n>' 		ifTrue: [ ^ self browseSendersOfMessages ].
			event keyString = '<Cmd-v>' 		ifTrue: [ ^ self browseVersions ].
			event keyString = '<Cmd-x>' 		ifTrue: [ ^ self removeMessage ]].! !

!ChangeSorterApplication methodsFor: 'menu - change set' stamp: ''!
addPreamble

	self model addPreambleTo: self selectedChangeSet.
	changesListModel setSelectedItem: self selectedChangeSet! !

!ChangeSorterApplication methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 5/1/2013 10:33'!
initializeWidgets

	self instantiateModels: #(
		methodsListModel NewListModel
		classesListModel NewListModel
		changesListModel NewListModel
		prettyButton CheckBoxModel
		diffButton CheckBoxModel
		textModel TextModel ).
	 
	self setFocus.
	
	methodsListModel menu: [:menu :shifted | self messageMenu: menu shifted: shifted ].
	changesListModel menu: [:aMenu :shifted | self changeSetMenu: aMenu shifted: shifted  ].
	classesListModel menu: [:aMenu :shifted | self classMenu: aMenu shifted: shifted ].

	changesListModel items: self model allChanges.
	changesListModel displayBlock: [:item | item name ].
	textModel aboutToStyle: true.
	! !

!ChangeSorterApplication methodsFor: 'accessing' stamp: ''!
changesListModel

	^ changesListModel! !

!ChangeSorterApplication methodsFor: 'menu - message' stamp: ''!
fileOutMessage
	"Put a description of the selected message on a file"

	self selectedSelector ifNotNil: [:selector |
		Cursor write showWhile:
			[ self model fileOutSelector: selector from: self selectedClass ]]! !

!ChangeSorterApplication methodsFor: 'menu - change set' stamp: ''!
remove
	"Completely destroy my change set.  Check if it's OK first"

	self okToChange ifFalse: [^ self].
	self model removeChangeSet: self selectedChangeSet prompting: true.
	self updateChangesList.
	changesListModel resetSelection! !

!ChangeSorterApplication methodsFor: 'private' stamp: ''!
forceChangesListRefresh
	| sel |
	
	sel := self selectedChangeSet.
	changesListModel items: self model allChanges.
	changesListModel setSelectedItem: sel.! !

!ChangeSorterApplication methodsFor: 'menu - change set' stamp: ''!
setCurrentChangeSet

	self model setCurrentChangeSet: self selectedChangeSet.! !

!ChangeSorterApplication methodsFor: 'api' stamp: ''!
selectedSelector

	 ^ methodsListModel selectedItem! !

!ChangeSorterApplication methodsFor: 'api' stamp: 'GuillermoPolito 8/5/2013 10:21'!
methodsOn: aShortcut do: aBlock

	methodsListModel bindKeyCombination: aShortcut toAction: aBlock! !

!ChangeSorterApplication methodsFor: 'menu - change set' stamp: 'MarcusDenker 10/26/2012 13:05'!
openChangeSetBrowser
	| cs |
	
	cs := self selectedChangeSet ifNil: [^self].
	^Smalltalk tools browser fullOnEnvironment: (RBBrowserEnvironment new forClasses: cs changedClasses)! !

!ChangeSorterApplication methodsFor: 'menu - message' stamp: ''!
browseSendersOfMessages

	self model browseSendersOfMessagesFrom: self selectedSelector! !

!ChangeSorterApplication methodsFor: 'api' stamp: ''!
selectedChangeSet

	 ^ changesListModel selectedItem! !

!ChangeSorterApplication methodsFor: 'api' stamp: 'StephaneDucasse 11/2/2012 16:30'!
updateClassesList
	
	| sel |
	sel := self selectedClass.
	
	self selectedChangeSet
			ifNil: [ classesListModel items: {} ]
			ifNotNil: [:change |	classesListModel items: (change changedClasses sort: [:a :b | a name < b name ])].
				
	classesListModel setSelectedItem: sel! !

!ChangeSorterApplication methodsFor: 'api' stamp: ''!
updateMessagesList
	| sel |
	sel := methodsListModel selectedItem.
	
	self selectedClass
			ifNil: [ methodsListModel items: {} ]
			ifNotNil: [:class | methodsListModel items: (self selectedChangeSet selectorsInClass: class name) sort].
				
	methodsListModel setSelectedItem: sel! !

!ChangeSorterApplication methodsFor: 'api' stamp: ''!
setSelectedClassIndex: anIndex

	 ^ classesListModel setSelectedIndex: anIndex! !

!ChangeSorterApplication methodsFor: 'api' stamp: ''!
selectedChangeSetIndex

	 ^ changesListModel selectedIndex! !

!ChangeSorterApplication methodsFor: 'menu - message' stamp: ''!
removeMessage
	"Remove the selected message from the system."
	
	self okToChange
		ifFalse: [^ self].
	self selectedSelector
		ifNotNil: [:selector |
				(self model removeMethod: selector inClass: self selectedClass)
					ifTrue: [ self updateMessagesList ]]! !

!ChangeSorterApplication methodsFor: 'private' stamp: ''!
updateTextContents

	| text |
	text :=  (self model 
				setContentsOfChangeSet: self selectedChangeSet
				forClass: self selectedClass
				andSelector: self selectedSelector
				prettyPrint: prettyPrint
				showDiff: showDiff).
	({'Method was added, but cannot be found!!'. 'Added then removed (see versions)'. 'Method has been removed (see versions)'} includes: text)
		ifTrue: [ textModel aboutToStyle: false ]
		ifFalse: [ textModel aboutToStyle: true ] .
	textModel text: text.! !

!ChangeSorterApplication methodsFor: 'shortcuts' stamp: 'GuillermoPolito 8/10/2014 14:11'!
registerChangeSetShortcuts: aWidget

	aWidget bindKeyCombination: PharoShortcuts current browseShortcut toAction: [ self selectedChangeSet ifNotNil:[ self browseChangeSet ]].
	aWidget bindKeyCombination: $b shift command toAction: [ self selectedChangeSet ifNotNil:[ self openChangeSetBrowser ]].
	aWidget bindKeyCombination: $m command toAction: [ self selectedChangeSet ifNotNil:[ self setCurrentChangeSet ]].
	aWidget bindKeyCombination: $n command toAction: [ self selectedChangeSet ifNotNil:[ self newSet ]].
	aWidget bindKeyCombination: $o command toAction: [ self selectedChangeSet ifNotNil:[ self fileOut ]].
	aWidget bindKeyCombination: $r command toAction: [ self selectedChangeSet ifNotNil:[ self rename ]].
	aWidget bindKeyCombination: $p command toAction: [ self selectedChangeSet ifNotNil:[ self addPreamble ]].
	aWidget bindKeyCombination: PharoShortcuts current removeShortcut toAction: [ self selectedChangeSet ifNotNil:[ self remove ]].
	aWidget bindKeyCombination: $f command toAction: [ self findChangeSet ].
		! !

!ChangeSorterApplication methodsFor: 'initialization' stamp: 'StephaneDucasse 5/17/2012 19:32'!
registerClassActions
	
	classesListModel whenSelectedItemChanged: [:class | 
		methodsListModel resetSelection.
		self updateTextContents.
		textModel behavior: class.
		textModel aboutToStyle: false.
		class 
			ifNil: [ methodsListModel items: {} ]
			ifNotNil: [ methodsListModel items: (self selectedChangeSet selectorsInClass: class name) sort ]].! !

!ChangeSorterApplication methodsFor: 'menu - class' stamp: ''!
removeClass
	"Remove the selected class from the system, at interactive user request.  Make certain the user really wants to do this, since it is not reversible.  Answer true if removal actually happened."

	(self model removeClass: self selectedClass)
		ifTrue: [ self setSelectedChangeSet: self selectedChangeSet ]! !

!ChangeSorterApplication methodsFor: 'menu - message' stamp: ''!
browseMethodFull
	"Create and schedule a full Browser and then select the current class and message."

	self selectedClass ifNotNil:
		[:myClass | Smalltalk tools browser fullOnClass: myClass selector: self selectedSelector ]! !

!ChangeSorterApplication methodsFor: 'api' stamp: ''!
setSelectedChangeSet: aChangeSet

	 ^ changesListModel setSelectedItem: aChangeSet! !

!ChangeSorterApplication methodsFor: 'api' stamp: 'StephaneDucasse 11/2/2012 14:44'!
title

	^ super title, ' on: ', self model currentChangeSet name. ! !

!ChangeSorterApplication methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 6/12/2012 18:22'!
initializePresenter

	prettyButton activationAction: [ 
		prettyPrint := true.
		self updateTextContents ].
	prettyButton desactivationAction: [ 
		prettyPrint := false.
		self updateTextContents  ].
	diffButton activationAction: [ 
		showDiff := true.
		self updateTextContents ].
	diffButton desactivationAction: [ 
		showDiff := false.
		self updateTextContents  ].
	self registerChangeActions.
	self registerClassActions.
	self registerSelectorActions.! !

!ChangeSorterApplication methodsFor: 'shortcuts' stamp: 'BenjaminVanRyseghem 2/8/2013 14:09'!
ensureKeyBindingsFor: aWidget

	super ensureKeyBindingsFor: aWidget.
	
	self registerChangeSetShortcuts: changesListModel.
	self registerClassShortcuts: classesListModel.
	self registerMethodShortcuts: methodsListModel.! !

!ChangeSorterApplication methodsFor: 'api' stamp: ''!
changesMenu: aBlock

	changesListModel menu: aBlock! !

!ChangeSorterApplication methodsFor: 'accessing' stamp: ''!
classesListModel

	^ classesListModel! !

!ChangeSorterApplication methodsFor: 'menu - change set' stamp: ''!
removePreamble

	self selectedChangeSet removePreamble.
	changesListModel setSelectedItem: self selectedChangeSet! !

!ChangeSorterApplication methodsFor: 'menu - message' stamp: ''!
forgetMessage

	self okToChange ifFalse: [^ self].
	self selectedSelector ifNotNil: [:selector | 
		self model 
			forgetSelector: selector 
			inClass: self selectedClass 
			fromChangeSet: self selectedChangeSet.
		self updateClassesList.
		self setSelectedClassIndex: self selectedClassIndex ]! !

!ChangeSorterApplication methodsFor: 'shortcuts' stamp: ''!
classShortcuts: event from: aMorph

	self selectedClass
		ifNotNil:[
			event keyString = '<Cmd-b>' 		ifTrue: [ ^ self browseMethodFull ].
			event keyString = '<Cmd-d>' 		ifTrue: [ ^ self forgetClass ].
			event keyString = '<Cmd-x>' 		ifTrue: [ ^ self removeClass ]].! !

!ChangeSorterApplication methodsFor: 'api' stamp: ''!
selectedClass

	 ^ classesListModel selectedItem! !

!ChangeSorterApplication methodsFor: 'menu - change set' stamp: ''!
findChangeSet

	| set |
	set := self model findChangeSetIn: self changeSets.
	changesListModel setSelectedItem: set.! !

!ChangeSorterApplication methodsFor: 'api' stamp: ''!
setSelectedChangeSetIndex: anIndex

	 ^ changesListModel setSelectedIndex: anIndex! !

!ChangeSorterApplication methodsFor: 'api' stamp: ''!
updateClassesListAndMessagesList
	| sel |
	sel := methodsListModel selectedItem.
	
	self updateClassesList.
	methodsListModel setSelectedItem: sel.
	self updateMessagesList.! !

!ChangeSorterApplication methodsFor: 'api' stamp: 'GuillermoPolito 8/5/2013 10:21'!
classesOn: aShortcut do: aBlock

	classesListModel bindKeyCombination: aShortcut toAction: aBlock! !

!ChangeSorterApplication methodsFor: 'shortcuts' stamp: ''!
changeSetShortcuts: event from: aMorph

	self selectedChangeSet
		ifNotNil:[
			event keyString = '<Cmd-b>' 		ifTrue: [ ^ self browseChangeSet ].
			event keyString = '<Cmd-B>' 		ifTrue: [ ^ self openChangeSetBrowser ].
			event keyString = '<Cmd-m>' 	ifTrue: [ ^ self setCurrentChangeSet ].
			event keyString = '<Cmd-n>' 		ifTrue: [ ^ self newSet ].
			event keyString = '<Cmd-o>' 		ifTrue: [ ^ self fileOut ].
			event keyString = '<Cmd-r>' 		ifTrue: [ ^ self rename ].
			event keyString = '<Cmd-p>' 		ifTrue: [ ^ self addPreamble ].
			event keyString = '<Cmd-x>' 		ifTrue: [ ^ self remove ]].
			
	event keyString = '<Cmd-f>' 				ifTrue: [ ^ self findChangeSet ].
		! !

!ChangeSorterApplication methodsFor: 'private' stamp: ''!
defaultTitle
	
	^  'Change Sorter'! !

!ChangeSorterApplication methodsFor: 'api' stamp: 'GuillermoPolito 8/5/2013 10:21'!
changesModelOn: aShortcut do: aBlock

	changesListModel bindKeyCombination: aShortcut toAction: aBlock! !

!ChangeSorterApplication methodsFor: 'shortcuts' stamp: 'GuillermoPolito 8/10/2014 14:11'!
registerClassShortcuts: aWidget

	aWidget bindKeyCombination: PharoShortcuts current browseShortcut toAction: [ self selectedClass ifNotNil:[ self browseMethodFull ]].
	aWidget bindKeyCombination: $d command toAction: [ self selectedClass ifNotNil:[ self forgetClass ]].
	aWidget bindKeyCombination: PharoShortcuts current removeShortcut toAction: [ self selectedClass ifNotNil:[ self removeClass ]].! !

!ChangeSorterApplication methodsFor: 'menu - change set' stamp: ''!
editPostscript
	
	self selectedChangeSet editPostscript! !

!ChangeSorterApplication methodsFor: 'menu' stamp: 'StephaneDucasse 11/11/2014 17:59'!
messageMenu: aMenu shifted: shifted
	"Fill aMenu with items appropriate for the message list; could be for a single or double changeSorter"

	self selectedSelector ifNil: [ ^ nil ].
	aMenu addTitle: 'Message list'.
	aMenu addAllFromPragma: 'changeSorterMessageListMenu' target: self.
	^ aMenu! !

!ChangeSorterApplication methodsFor: 'accessing' stamp: ''!
model

	^ model! !

!ChangeSorterApplication methodsFor: 'menu - change set' stamp: 'MarcusDenker 7/28/2014 21:24'!
browseChangeSet
	"Open a message list browser on methods in the current change set"

	| messages |
	messages := self selectedChangeSet changedMessageList select: [ :each | each isValid].	
	Smalltalk tools messageList
		browse: messages 
		title: 'Methods in Change Set ', self selectedChangeSet name .! !

!ChangeSorterApplication methodsFor: 'menu' stamp: 'StephaneDucasse 11/11/2014 17:59'!
changeSetMenu: aMenu shifted: isShifted
	"Set up aMenu to hold commands for the change-set-list pane.  This could be for a single or double changeSorter"

	aMenu addTitle: 'Change Set'.
	self changeSetMenu1: aMenu shifted: isShifted.
	self changeSetMenu2: aMenu shifted: isShifted.
	^ aMenu! !

!ChangeSorterApplication methodsFor: 'api' stamp: ''!
classesMenu: aBlock

	classesListModel menu: aBlock! !

!ChangeSorterApplication methodsFor: 'api' stamp: 'BenjaminVanRyseghem 12/19/2012 20:39'!
changeSets

	^ self changesListModel listItems! !

!ChangeSorterApplication methodsFor: 'initialization' stamp: ''!
setFocus

	self focusOrder
		add: changesListModel;
		add: classesListModel;
		add: methodsListModel;
		add: textModel.! !

!ChangeSorterApplication methodsFor: 'menu' stamp: 'StephaneDucasse 2/14/2014 13:10'!
changeSetMenu1: aMenu shifted: isShifted 
	"Set up aMenu to hold commands for the change-set-list pane.  This could be for a single or double changeSorter"
	
	aMenu addAllFromPragma: 'changeSorterChangeSetList1Menu' target: self.
! !

!ChangeSorterApplication methodsFor: 'api' stamp: ''!
setSelectedClass: aClass

	 ^ classesListModel setSelectedItem: aClass! !

!ChangeSorterApplication methodsFor: 'menu - class' stamp: ''!
fileOutClass

	self model fileOutClass: self selectedClass from: self selectedChangeSet! !

!ChangeSorterApplication class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 7/31/2012 16:09'!
defaultSpec
	<spec>
	
	^ SpecLayout composed
		newColumn: [:c | 
				c 
					newRow: [:r | r 
									add: #changesListModel;
									addSplitter;
									add: #classesListModel ];
					addSplitter;
					add: #methodsListModel;
					addSplitter;
					add: #textModel ].! !

!ChangeSorterApplication class methodsFor: 'menu' stamp: 'StephaneDucasse 2/14/2014 13:03'!
changeSetMenu2: aBuilder
	<contextMenu>
	<changeSorterChangeSetList2Menu>
	
	| target cs |
	target := aBuilder model.
	cs := target selectedChangeSet.
	cs ifNil: [ ^self ].
	
	cs hasPreamble 
		ifTrue: [
			(aBuilder item: #'Edit preamble')
				keyText: 'p';
				selector: #addPreamble.
			(aBuilder item: #'Remove preamble')
				selector: #removePreamble ]
		ifFalse: [
			(aBuilder item: #'Add preamble')
				keyText: 'p';
				selector: #addPreamble ].

	cs hasPreamble 
		ifTrue: [
			(aBuilder item: #'Edit postscript...')
				selector: #editPostscript.
			(aBuilder item: #'Remove postscript')
				selector: #removePostscript ]
		ifFalse: [
			(aBuilder item: #'Add postscript...')
				selector: #editPostscript ].
			
		aBuilder withSeparatorAfter.
		(aBuilder item: #'Destroy change set')
			keyText: 'x';
			selector: #remove.
		! !

!ChangeSorterApplication class methodsFor: 'menu' stamp: 'StephaneDucasse 2/14/2014 13:11'!
messageListMenu: aBuilder
	<contextMenu>
	<changeSorterMessageListMenu>
	
	| target |
	target := aBuilder model.
	
	(aBuilder item: #'Delete method from changeSet')
		keyText: 'd';
		selector: #forgetMessage.
	(aBuilder item: #'Remove method from system')
		keyText: 'x';
		selector: #removeMessage;
		withSeparatorAfter.
		
	(aBuilder item: #'Browse full')
		keyText: 'b';
		selector: #browseMethodFull;
		withSeparatorAfter.
		
	(aBuilder item: #'FileOut')
		selector: #fileOutMessage.
	(aBuilder item: #'Senders of...')
		keyText: 'n';
		selector: #browseSendersOfMessages.
	(aBuilder item: #'Implementors of...')
		keyText: 'm';
		selector: #browseImplementorsOfMessages.
	(aBuilder item: #'Versions')
		keyText: 'v';
		selector: #browseVersions.
! !

!ChangeSorterApplication class methodsFor: 'menu' stamp: 'StephaneDucasse 2/14/2014 13:03'!
changeSetMenu1: aBuilder
	<contextMenu>
	<changeSorterChangeSetList1Menu>
	
	| target |
	target := aBuilder model.
	
	target selectedChangeSet ifNotNil: [
		(aBuilder item: #'Make changes go to me')
			keyText: 'm';
			selector: #setCurrentChangeSet.
		(aBuilder item: #'New change set...')
			keyText: 'n';
			selector: #newSet ].
	
	(aBuilder item: #'Find...')
		keyText: 'f';
		selector: #findChangeSet.

	target selectedChangeSet ifNotNil: [	
		aBuilder withSeparatorAfter.
		(aBuilder item: #'Rename change set')
			keyText: 'r';
			selector: #rename.
		(aBuilder item: #'File out')
			keyText: 'o';
			selector: #fileOut.
		(aBuilder item: #'Browse methods')
			keyText: 'b';
			selector: #browseChangeSet.
		(aBuilder item: #'Browse change set')
			keyText: 'B';
			selector: #openChangeSetBrowser ].
		! !

!ChangeSorterApplication class methodsFor: 'menu' stamp: 'StephaneDucasse 2/14/2014 13:07'!
classListMenu: aBuilder
	<contextMenu>
	<changeSorterClassListMenu>
	
	| target |
	target := aBuilder model.
	
	(aBuilder item: #'Delete class from change set')
		keyText: 'd';
		selector: #forgetClass.
	(aBuilder item: #'Remove class from system')
		keyText: 'x';
		selector: #removeClass;
		withSeparatorAfter.
		
	(aBuilder item: #'Browse full')
		keyText: 'b';
		selector: #browseMethodFull;
		withSeparatorAfter.
		
	(aBuilder item: #'FileOut')
		selector: #fileOutClass.
! !

!ChangeSorterModel commentStamp: '<historical>'!
A ChangeSorterModel is a model used by Change Sorter UIs for computation!
!ChangeSorterModel methodsFor: 'message' stamp: ''!
forgetSelector: selector inClass: aClass fromChangeSet: aChangeSet

	aChangeSet
			removeSelectorChanges: selector 
			class: aClass! !

!ChangeSorterModel methodsFor: 'change set' stamp: ''!
createNewSet

	^ ChangeSet newChangeSet.! !

!ChangeSorterModel methodsFor: 'change set' stamp: 'AlejandroInfante 11/11/2013 14:59'!
rename: aChangeSet
	"Store a new name string into the selected ChangeSet.  reject duplicate name; allow user to back out"

	| newName |
	newName := UIManager default request: 'New name for this change set'
						initialAnswer: aChangeSet name.
						
	(newName = aChangeSet name or: [newName isEmptyOrNil]) ifTrue:
			[ ^ UIManager default inform: 'Please give a new name' ].

	(ChangeSet named: newName) ifNotNil:
			[ ^ UIManager default inform: 'Sorry that name is already used' ].

	aChangeSet name: newName.
	^ aChangeSet! !

!ChangeSorterModel methodsFor: 'change set' stamp: ''!
addPreambleTo: aChangeSet

	aChangeSet assurePreambleExists! !

!ChangeSorterModel methodsFor: 'change set' stamp: ''!
removeChangeSet: aChangeSet prompting: doPrompt
	"Completely destroy my change set.  Check if it's OK first, and if doPrompt is true, get the user to confirm his intentions first."

	| message aName changeSetNumber msg |
	aName := aChangeSet name.
	aChangeSet okayToRemove ifFalse: [^ self]. "forms current changes for some project"
	(aChangeSet isEmpty or: [doPrompt not]) ifFalse:
		[message := 'Are you certain that you want to 
remove (destroy) the change set
named  "', aName, '" ?'.
		(self confirm: message) ifFalse: [^ self]].

	doPrompt ifTrue:
		[msg := aChangeSet hasPreamble
			ifTrue:
				[aChangeSet hasPostscript
					ifTrue:
						['a preamble and a postscript']
					ifFalse:
						['a preamble']]
			ifFalse:
				[aChangeSet hasPostscript
					ifTrue:
						['a postscript']
					ifFalse:
						['']].
		msg isEmpty ifFalse:
			[(self confirm: 
'Caution!!  This change set has
', msg, ' which will be
lost if you destroy the change set.
Do you really want to go ahead with this?') ifFalse: [^ self]]].

	"Go ahead and remove the change set"
	changeSetNumber := aChangeSet name initialIntegerOrNil.
	changeSetNumber ifNotNil: [SystemVersion current unregisterUpdate: changeSetNumber].
	ChangeSet removeChangeSet: aChangeSet.! !

!ChangeSorterModel methodsFor: 'environment' stamp: ''!
allChanges

	^ ChangeSet allChangeSets reverse! !

!ChangeSorterModel methodsFor: 'text' stamp: ''!
buildChangeSetDescriptionFor: changeSet
		
	^ changeSet
		ifNil: [ '' ] 
		ifNotNil: [ changeSet preambleString ifNil: ['']]! !

!ChangeSorterModel methodsFor: 'change set' stamp: 'AlejandroInfante 11/11/2013 14:56'!
findChangeSetIn: aCollectionOfChangeSets
	"Search for a changeSet by name.  Pop up a menu of all changeSets whose name contains the string entered by the user.  If only one matches, then the pop-up menu is bypassed"
	| index pattern candidates nameList |
	self okToChange ifFalse: [^ self].
	pattern := UIManager default request: 'ChangeSet name or fragment?'.
	pattern isEmptyOrNil ifTrue: [^ self].
	nameList := aCollectionOfChangeSets collect: #name.
	candidates := aCollectionOfChangeSets select:
			[:c | (nameList includes: c name) and: 
				[c name includesSubstring: pattern caseSensitive: false]].
	candidates size = 0 ifTrue: [ ^ self inform: 'No matching change sets.' ].
	candidates size = 1 ifTrue: [ ^ candidates first ].
	index := UIManager default chooseFrom: (candidates collect: [:each | each name]).
	index = 0 ifFalse: [ ^ (candidates at: index) ].! !

!ChangeSorterModel methodsFor: 'change set' stamp: ''!
submerge: source into: destination
	"Copy the contents of the receiver to the other side, then remove the receiver -- all after checking that all is well."
	|   message |
	source == destination
		ifTrue: [ ^ false ].
	source isEmpty
		ifTrue: [ 
			self inform: 'Nothing to copy.  To remove,
simply choose "remove".'.
			^ false ].

	source okayToRemove ifFalse: [^ false].
	message := 'Please confirm:  copy all changes
in "', source name, '" into "', destination name, '"
and then destroy the change set
named "', source name, '"?'.
 
	(self confirm: message) ifFalse: [^ false].

	(source hasPreamble or: [source hasPostscript]) ifTrue:
		[(self confirm: 
'Caution!!  This change set has a preamble or
a postscript or both.  If you submerge it into
the other side, these will be lost.
Do you really want to go ahead with this?') ifFalse: [^ false]].

	self copyAllChangesFrom: source to: destination.
	self removeChangeSet: source prompting: false.
	^ true! !

!ChangeSorterModel methodsFor: 'text' stamp: ''!
buildClassDescriptionFor: changeSet class: class
	| stream |

	stream := (String new: 100) writeStream.
		(changeSet classChangeAt: class name)
			do: [:each | 
				each = #remove
					ifTrue: [ stream nextPutAll: 'Entire class was removed.'; cr ].
				each = #addedThenRemoved
					ifTrue: [ stream nextPutAll: 'Class was added then removed.'; cr ].
				each = #rename
					ifTrue: [ stream nextPutAll: 'Class name was changed.'; cr ].
				each = #add
					ifTrue: [ stream nextPutAll: 'Class definition was added.'; cr ].
				each = #change
					ifTrue: [ stream nextPutAll: 'Class definition was changed.'; cr ].
				each = #reorganize
					ifTrue: [ stream nextPutAll: 'Class organization was changed.'; cr ].
				each = #comment 
					ifTrue: [ stream nextPutAll: 'New class comment.'; cr ]].
		^ stream contents! !

!ChangeSorterModel methodsFor: 'text' stamp: 'NicolaiHess 1/31/2014 12:07'!
buildSelectorDescriptionFor: changeSet class: class selector: selector prettyPrint: prettyPrint showDiff: showDiff

	| changeType code |
	changeType := changeSet atSelector: selector class: class.
	
	changeType == #remove
		ifTrue: [^ 'Method has been removed (see versions)'].
	changeType == #addedThenRemoved
		ifTrue: [^ 'Added then removed (see versions)']. 
	class
		ifNil: [^ 'Method was added, but cannot be found!!'].
	(class includesSelector: selector)
		ifFalse: [^ 'Method was added, but cannot be found!!'].
	code := class sourceCodeAt: selector.
	prettyPrint
		ifTrue: [ code := class compiler format: code].						
	showDiff
		ifTrue: [ code := self diffFromPriorSourceFor: code ].
		
	^ code asText! !

!ChangeSorterModel methodsFor: 'class' stamp: ''!
copyClass: aClass from: source to: destination

	destination absorbClass: aClass name from: source.! !

!ChangeSorterModel methodsFor: 'message' stamp: ''!
copySelector: selector inClass: class from: source to: destination

	destination
		absorbMethod: selector 
		class: class 
		from:source! !

!ChangeSorterModel methodsFor: 'class' stamp: 'StephaneDucasse 11/2/2012 16:03'!
fileOutClass: aClass from: aChangeSet
	"this is a hack!!!! makes a new change set, called the class name, adds author initials to try to make a unique change set name, files it out and removes it. kfr 16 june 2000"
	"Method copied from ChangeSorter"
	
	| aSet |
      aSet := ChangeSet newChangeSet: aClass name.
	aSet ifNil:[ ^self ].
	aSet absorbClass: aClass name from: aChangeSet.
	aSet fileOut.
	ChangeSet removeChangeSet: aSet.! !

!ChangeSorterModel methodsFor: 'message' stamp: ''!
fileOutSelector: selector from: aClass
	
	aClass fileOutMethod: selector! !

!ChangeSorterModel methodsFor: 'class' stamp: ''!
removeClass: class from: changeSet

	changeSet removeClassChanges: class.! !

!ChangeSorterModel methodsFor: 'text' stamp: 'ClementBera 7/26/2013 16:01'!
setContentsOfChangeSet: changeSet forClass: class andSelector: selector prettyPrint: prettyPrint showDiff: showDiff 
	"return the source code that shows in the bottom pane"

	class
		ifNil: [
			"Only the change set is currently selected"
			^ self buildChangeSetDescriptionFor: changeSet ].
	selector 
		ifNil: [ 
			"class is selected but not the selector"
			^ self buildClassDescriptionFor: changeSet class: class ]
		ifNotNil: [
			"a class and a selector are selected"
			^ self buildSelectorDescriptionFor: changeSet class: class selector: selector prettyPrint: prettyPrint showDiff: showDiff ]! !

!ChangeSorterModel methodsFor: 'change set' stamp: 'StephaneDucasse 11/2/2012 16:37'!
setCurrentChangeSet: aChangeSet

	ChangeSet newChanges: aChangeSet.
	! !

!ChangeSorterModel methodsFor: 'change set' stamp: 'MartinDias 10/23/2013 14:42'!
subtractFrom: source to: destination

	source forgetAllChangesFoundIn: destination.! !

!ChangeSorterModel methodsFor: 'change set' stamp: 'StephaneDucasse 11/2/2012 14:17'!
currentChangeSet

	^ ChangeSet current ! !

!ChangeSorterModel methodsFor: 'change set' stamp: ''!
removePostscriptFrom: aChange

	(aChange hasPostscript and: [ aChange postscriptHasDependents ]) ifTrue:
		[^ self inform:
'Cannot remove the postscript right
now because there is at least one
window open on that postscript.
Close that window and try again.'].

	aChange removePostscript.! !

!ChangeSorterModel methodsFor: 'change set' stamp: ''!
copyAllChangesFrom: source to: destination

	destination assimilateAllChangesFoundIn: source! !

!ChangesBrowser commentStamp: '<historical>'!
A ChangesBrowser is a browser used to browse a composite change wich gather all the wanted changes!
!ChangesBrowser methodsFor: 'initialization' stamp: 'GuillermoPolito 8/5/2013 10:21'!
initializeTextArea
	textArea 
		enabled: false;
		"make sure we can cycle over the text field"
		bindKeyCombination: Character tab shift toAction: [ self giveFocusToNextFrom: textArea ];
		bindKeyCombination: Character tab toAction: [ self giveFocusToPreviousFrom: textArea ].! !

!ChangesBrowser methodsFor: 'private' stamp: 'CamilloBruni 11/18/2013 21:00'!
updateChanges
	"Filter the shown changes depending on the selected environment"
	self flag: 'todo'.! !

!ChangesBrowser methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
cancel

	window value delete! !

!ChangesBrowser methodsFor: 'accessing' stamp: ''!
textArea
	^ textArea! !

!ChangesBrowser methodsFor: 'private' stamp: 'CD 11/29/2013 16:19'!
pickedChanges

	^ changesTree selectedItems! !

!ChangesBrowser methodsFor: 'initialization' stamp: 'SeanDeNigris 3/2/2015 11:10'!
initializeWidgets

	changesTree := self newTree.
	textArea := self newText.
	
	self initializeChangesTree.
	self initializeTextArea.
	self setFocus.
	self
		bindKeyCombination: PharoShortcuts current acceptShortcut toAction: [ self accept ];
		bindKeyCombination: Character escape toAction: [ self cancel ]! !

!ChangesBrowser methodsFor: 'initialization' stamp: 'CD 11/29/2013 16:24'!
initializeChangesTree
	changesTree
		beCheckList;
		removeOnlyLastSelected: true;
		autoMultiSelection: true;
		rootNodeHolder: [ :item | 
					TreeNodeModel new
						content: item;
						hasContentToShow: true;
						children: [ changesTree childrenFor: item ] ];
		displayBlock: [ :item | item nameToDisplay ].
	self whenBuiltDo: [ changesTree selectAll ]! !

!ChangesBrowser methodsFor: 'api' stamp: 'CD 11/29/2013 16:18'!
accept

	self okToChange ifFalse: [ ^self ].
	self pickedChanges do: [ :change | RBRefactoryChangeManager instance performChange: change content ].
	window value delete! !

!ChangesBrowser methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 12/5/2013 12:48'!
initializePresenter

	changesTree whenHighlightedItemChanged: [ :item |
			item ifNotNil: [ textArea text: (self buildDiffFor: item content) ] ]! !

!ChangesBrowser methodsFor: 'api' stamp: 'CD 11/29/2013 16:19'!
change: aCompositeChange
	changesTree roots: (aCompositeChange whatToDisplayIn: self)! !

!ChangesBrowser methodsFor: 'api' stamp: ''!
buildDiffFor: aChange

	^ aChange
		ifNil: [ '' ]
		ifNotNil: [
			TextDiffBuilder 
				buildDisplayPatchFrom: aChange oldVersionTextToDisplay 
				to: aChange textToDisplay ].! !

!ChangesBrowser methodsFor: 'accessing' stamp: 'CamilloBruni 11/20/2013 17:02'!
scopeChooser
	^ scopeChooser ifNil: [ 
		scopeChooser := self instantiate: EnvironmentChooser.
		scopeChooser 
			whenEnvironmentChanged: [ self updateChanges ];
			label: 'Scope:'.
		scopeChooser]! !

!ChangesBrowser methodsFor: 'private' stamp: 'CamilloBruni 10/8/2012 22:21'!
changes: aCollection

	| composite |
	composite := RBCompositeRefactoryChange new.
	aCollection do: [:change | composite addChange: change ].
	self change: composite.! !

!ChangesBrowser methodsFor: 'initialization' stamp: 'CD 11/29/2013 16:21'!
setShortcuts
	self changesTree attachKeymapCategory: #ChangesBrowserGlobalShortcuts targetting: self! !

!ChangesBrowser methodsFor: 'initialization' stamp: 'CD 11/29/2013 16:19'!
setFocus

	self focusOrder
		add: changesTree;
		add: textArea;
		add: acceptButton;
		add: cancelButton.! !

!ChangesBrowser methodsFor: 'opening' stamp: 'SeanDeNigris 3/2/2015 11:14'!
open

	^ self openDialogWithSpec
		okAction: [ self accept ];
		cancelAction: [ self cancel ];
		yourself! !

!ChangesBrowser methodsFor: 'accessing' stamp: 'CD 11/29/2013 16:21'!
changesTree
	^ changesTree! !

!ChangesBrowser class methodsFor: 'specs' stamp: 'SeanDeNigris 3/2/2015 11:12'!
defaultSpec
	<spec>
	
	^ SpecLayout composed
		newColumn: [:c |
			c 
				newColumn: [:c2 |
					c2 
						add: #changesTree ];
				addSplitter;
				add: #textArea ]! !

!ChangesBrowser class methodsFor: 'instance creation' stamp: ''!
changes: aCollection

	^ self new
		changes: aCollection;
		yourself! !

!ChangesBrowser class methodsFor: 'shortcuts' stamp: 'GuillermoPolito 8/10/2014 14:12'!
buildShortcutsOn: aBuilder
	<keymap>

	(aBuilder shortcut: #close)
		category: #ChangesBrowserGlobalShortcuts
		default: PharoShortcuts current cancelShortcut
		do: [ :target | target cancel ]
		description: 'Close this dialog'.
		
	(aBuilder shortcut: #accept)
		category: #ChangesBrowserGlobalShortcuts
		default: PharoShortcuts current acceptShortcut
		do: [ :target | target accept ]
		description: 'Accept the proposed changes'.! !

!ChangesBrowser class methodsFor: 'specs' stamp: ''!
title

	^ 'Changes Browser'! !

!ChangesLog commentStamp: '<historical>'!
I represent the changes file and give access to him.  If you want to log a change, look at my #logChange: method.

I have a default instance that is hearing SystemAnnouncements and logging the change logs in there.
But you can have your own instance and log whatever you want.!
!ChangesLog methodsFor: 'logging' stamp: 'MartinDias 11/5/2013 14:44'!
logChange: aStringOrText
	"Write the argument, aString, onto the changes file."

	| aString changesFile |
	(SourceFiles at: 2) ifNil: [ ^ self ].
	self assureStartupStampLogged.
	aString := aStringOrText asString.
	(aString findFirst: [ :char | char isSeparator not ]) = 0
		ifTrue: [ ^ self ].	"null doits confuse replay"
	changesFile := SourceFiles at: 2.
	changesFile isReadOnly
		ifTrue: [ ^ self ].
	changesFile
		setToEnd;
		cr;
		cr.
	changesFile nextChunkPut: aString.	"If want style changes in DoIt, use nextChunkPutWithStyle:, and allow Texts to get here"
	self forceChangesToDisk! !

!ChangesLog methodsFor: 'logging' stamp: 'YuriyTymchuk 12/20/2013 14:27'!
logSnapshot: save andQuit: quit
	"Log into the changes file the fact that the session will be either snapshoted, quit, or both."

	| message |	
	(SourceFiles at: 2) ifNil: [ ^ self ].

	message := String
		streamContents: [ :s | 
			s
				nextPutAll: '----';
				nextPutAll:
						(save
								ifTrue: [ 
									quit
										ifTrue: [ 'QUIT' ]
										ifFalse: [ 'SNAPSHOT' ] ]
								ifFalse: [ 
									quit
										ifTrue: [ 'QUIT/NOSAVE' ]
										ifFalse: [ 'NOP' ] ]);
				nextPutAll: '----';
				print: DateAndTime now;
				space;
				nextPutAll: (Smalltalk imageFile basename);
				nextPutAll: ' priorSource: ';
				print: Smalltalk lastQuitLogPosition ].

	self assureStartupStampLogged.

	save ifTrue: [ 
		Smalltalk lastQuitLogPosition: (
			(SourceFiles at: 2)
				setToEnd;
				position) ].

	self logChange: message! !

!ChangesLog methodsFor: 'accessing' stamp: 'CamilloBruni 11/5/2013 16:55'!
recordStartupStamp
	
	startupStamp := '----STARTUP----', DateAndTime now printString, ' as ', Smalltalk imagePath.
! !

!ChangesLog methodsFor: 'private' stamp: 'MartinDias 11/5/2013 14:45'!
assureStartupStampLogged
	"If there is a startup stamp not yet actually logged to disk, do it now."

	| changesFile |
	startupStamp ifNil: [ ^ self ].
	(changesFile := SourceFiles at: 2) 
		ifNil: [ ^ self ].
	changesFile isReadOnly
		ifTrue: [ ^ self ].
	changesFile
		setToEnd;
		cr;
		cr.
	changesFile
		nextChunkPut: startupStamp asString;
		cr.
	startupStamp := nil.
	self forceChangesToDisk! !

!ChangesLog methodsFor: 'private' stamp: 'MarcusDenker 10/9/2013 17:05'!
forceChangesToDisk
	"Ensure that the changes file has been fully written to disk by closing and re-opening it. This makes the system more robust in the face of a power failure or hard-reboot."

	| changesFile |
	changesFile := SourceFiles at: 2.
	(changesFile isKindOf: FileStream)
		ifFalse: [ ^ self ].
	changesFile flush.
	changesFile close.
	changesFile open: changesFile name forWrite: true.
	changesFile setToEnd! !

!ChangesLog methodsFor: 'event-listening' stamp: 'GuillermoPolito 8/3/2012 14:42'!
logClassRemoved: annoucement
	annoucement classRemoved acceptsLoggingOfCompilation ifTrue: [
		self logChange: 'Smalltalk globals removeClassNamed: #', annoucement classRemoved name	
	].
! !

!ChangesLog methodsFor: 'event-listening' stamp: 'BernardoContreras 11/1/2014 19:12'!
registerToAnnouncements
	SystemAnnouncer uniqueInstance 
		when: ClassRemoved 
			send: #logClassRemoved:
			to: self;
		when: ClassRenamed 
			send: #logClassRenamed:
			to: self;
		when: MethodRemoved
			send: #logMethodRemoved:
			to: self;
		when: ExpressionEvaluated 
			send: #logExpressionEvaluated:
			to: self.! !

!ChangesLog methodsFor: 'event-listening' stamp: 'CamilleTeruel 7/29/2012 19:46'!
logMethodRemoved: announcement
	announcement methodClass acceptsLoggingOfCompilation ifTrue: [
		self logChange: 
			announcement methodClass name, ' removeSelector: #', announcement selector
	]
	! !

!ChangesLog methodsFor: 'event-listening' stamp: 'GuillermoPolito 8/3/2012 14:43'!
logExpressionEvaluated: announcement
	self logChange: announcement expressionEvaluated.! !

!ChangesLog methodsFor: 'event-listening' stamp: 'EstebanLorenzano 2/28/2013 16:49'!
logClassRenamed: annoucement
	annoucement classRenamed acceptsLoggingOfCompilation ifTrue: [
		self logChange: '(Smalltalk globals at: #', annoucement oldName, ') rename: #', annoucement newName.	
	].
! !

!ChangesLog class methodsFor: 'accessing' stamp: 'EstebanLorenzano 8/3/2012 14:07'!
reset
	SystemAnnouncer uniqueInstance unsubscribe: DefaultInstance.
	DefaultInstance := nil.! !

!ChangesLog class methodsFor: 'accessing' stamp: 'CamilleTeruel 7/30/2012 00:45'!
default
	^DefaultInstance ifNil: [ 
		DefaultInstance := self new.
		DefaultInstance registerToAnnouncements
	].! !

!Character commentStamp: 'ar 4/9/2005 22:35'!
I represent a character by storing its associated Unicode. The first 256 characters are created uniquely, so that all instances of latin1 characters ($R, for example) are identical.

	The code point is based on Unicode.  Since Unicode is 21-bit wide character set, we have several bits available for other information.  As the Unicode Standard  states, a Unicode code point doesn't carry the language information.  This is going to be a problem with the languages so called CJK (Chinese, Japanese, Korean.  Or often CJKV including Vietnamese).  Since the characters of those languages are unified and given the same code point, it is impossible to display a bare Unicode code point in an inspector or such tools.  To utilize the extra available bits, we use them for identifying the languages.  Since the old implementation uses the bits to identify the character encoding, the bits are sometimes called "encoding tag" or neutrally "leading char", but the bits rigidly denotes the concept of languages.

	The other languages can have the language tag if you like.  This will help to break the large default font (font set) into separately loadable chunk of fonts.  However, it is open to the each native speakers and writers to decide how to define the character equality, since the same Unicode code point may have different language tag thus simple #= comparison may return false.

I represent a character by storing its associated ASCII code (extended to 256 codes). My instances are created uniquely, so that all instances of a character ($R, for example) are identical.!
!Character methodsFor: '*Keymapping-KeyCombinations' stamp: 'CamilloBruni 9/15/2013 19:49'!
meta
	^ KMModifier meta + self! !

!Character methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2011 12:23'!
isDigit

	^ self characterSet isDigit: self.
! !

!Character methodsFor: 'converting' stamp: 'CamilloBruni 8/31/2011 12:28'!
asUppercase
	"If the receiver is lowercase, answer its matching uppercase Character."
	^ self characterSet toUppercase: self
	
! !

!Character methodsFor: 'comparing' stamp: ''!
< aCharacter 
	"Answer true if the receiver's value < aCharacter's value."

	^self asciiValue < aCharacter asciiValue! !

!Character methodsFor: 'testing' stamp: 'di 4/3/1999 00:38'!
isSpecial
	"Answer whether the receiver is one of the special characters"

	^'+-/\*~<>=@,%|&?!!' includes: self! !

!Character methodsFor: '*Text-Core' stamp: 'tk 9/4/2000 12:05'!
asText
	^ self asString asText! !

!Character methodsFor: '*Multilingual-TextConversion' stamp: 'michael.rueger 2/5/2009 17:02'!
macRomanToUnicode
	"Convert the receiver from MacRoman Unicode."

	^MacRomanTextConverter new unicodeToByte: self! !

!Character methodsFor: '*Keymapping-KeyCombinations' stamp: 'GuillermoPolito 6/28/2013 13:02'!
asShortcut
	^ self asKeyCombination! !

!Character methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2011 12:23'!
isLowercase

	^ self characterSet isLowercase: self.
! !

!Character methodsFor: 'converting' stamp: 'sma 3/11/2000 17:21'!
asString
	^ String with: self! !

!Character methodsFor: 'converting' stamp: 'CamilloBruni 9/5/2011 20:06'!
asCharacter
	"Answer the receiver itself."

	^ self! !

!Character methodsFor: 'converting' stamp: 'CamilloBruni 8/31/2011 12:16'!
uppercase
	^ self asUppercase! !

!Character methodsFor: 'converting' stamp: ''!
to: other
	"Answer with a collection in ascii order -- $a to: $z"
	^ (self asciiValue to: other asciiValue) collect:
				[:ascii | Character value: ascii]! !

!Character methodsFor: '*Monticello-Storing' stamp: 'tk 1/17/2000 11:27'!
comeFullyUpOnReload: smartRefStream
	"Use existing an Character.  Don't use the new copy."

	^ self class value: value! !

!Character methodsFor: '*Multilingual-TextConversion' stamp: 'michael.rueger 2/5/2009 17:01'!
unicodeToMacRoman
	"Convert the receiver from Unicode to MacRoman encoding."

	^MacRomanTextConverter new byteToUnicode: self! !

!Character methodsFor: 'testing' stamp: 'ul 11/23/2010 13:28'!
shouldBePrintedAsLiteral

	^value between: 33 and: 255! !

!Character methodsFor: 'converting' stamp: 'raa 5/26/2001 09:54'!
asSymbol 
	"Answer a Symbol consisting of the receiver as the only element."

	^Symbol internCharacter: self! !

!Character methodsFor: '*Keymapping-KeyCombinations' stamp: 'CamilloBruni 3/18/2011 22:57'!
shift
	^ KMModifier shift + self! !

!Character methodsFor: '*NECompletion' stamp: 'EstebanLorenzano 2/4/2013 18:37'!
isCompletionCharacter
	^ self isAlphaNumeric or: [ self = $: ]! !

!Character methodsFor: '*GT-InspectorExtensions-Core' stamp: 'SvenVanCaekenberghe 10/3/2014 14:59'!
gtInspectorCharacterIn: composite
	<gtInspectorPresentationOrder: 30>
	^ composite table
		title: 'Character';
		display: [
			{'self' -> self.
			'codepoint' -> self codePoint.
			'unicode' -> (String streamContents: [ :stream | 
				stream << 'U+'.
				self codePoint printOn: stream base: 16 nDigits: 4 ])} ];
		column: 'Key' evaluated: #key;
		column: 'Value' evaluated: [ :each | each value printString ];
		send: #value! !

!Character methodsFor: 'converting' stamp: 'CamilloBruni 9/5/2011 20:05'!
asHTMLString
	"substitute the < & > into HTML compliant elements"
	
	#($< '&lt;' $> '&gt;' $& '&amp;') pairsDo: [:k :v |
		self = k ifTrue: [^ v]].
	^ String with: self! !

!Character methodsFor: '*Keymapping-KeyCombinations' stamp: 'CamilloBruni 3/18/2011 22:57'!
ctrl
	^ KMModifier ctrl + self! !

!Character methodsFor: 'testing' stamp: 'yo 8/27/2002 15:18'!
isOctetCharacter

	^ value < 256.
! !

!Character methodsFor: 'accessing' stamp: 'StephaneDucasse 3/28/2010 19:13'!
digitValue2
	"Answer 0-9 if the receiver is $0-$9, 10-35 if it is $A-$Z, and < 0
	otherwise. This is used to parse literal numbers of radix 2-36."

	
	| digitValue |
	(digitValue := ('0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ' indexOf: self) - 1) >= 0
		ifTrue: [ ^digitValue ].
	^ (EncodedCharSet charsetAt: self leadingChar) digitValueOf: self. 
	
	
	! !

!Character methodsFor: 'converting' stamp: 'CamilloBruni 8/31/2011 12:16'!
lowercase
	^ self asLowercase! !

!Character methodsFor: '*Keymapping-KeyCombinations' stamp: 'GuillermoPolito 5/31/2011 18:25'!
command
	^ KMModifier command + self! !

!Character methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2011 12:23'!
canBeGlobalVarInitial

	^ self characterSet canBeGlobalVarInitial: self.
! !

!Character methodsFor: 'printing' stamp: 'StephaneDucasse 7/31/2010 19:45'!
hex
	"return an headecimal representation of the receiver in the form 16rXX.."
	^value hex! !

!Character methodsFor: 'converting' stamp: 'ClementBera 7/26/2013 16:08'!
asUnicode

	| table charset v |
	self leadingChar = 0 
		ifTrue: [^ value].
	
	charset := self characterSet.
	charset isCharset 
		ifFalse: [^ self charCode].
	
	table := charset ucsTable.
	table ifNil: [^ 16rFFFD].

	v := table at: self charCode + 1.
	v = -1 ifTrue: [^ 16rFFFD].

	^ v.
! !

!Character methodsFor: '*Keymapping-KeyCombinations' stamp: 'GuillermoPolito 3/19/2013 20:26'!
control
	^ KMModifier control + self! !

!Character methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2011 12:23'!
canBeNonGlobalVarInitial

	^ self characterSet canBeNonGlobalVarInitial: self.
! !

!Character methodsFor: '*multilingual-encodings' stamp: 'pmm 9/12/2009 20:39'!
asUnicodeChar
	"Answer a copy of the receiver with Unicode as the leadingChar"
	^ Unicode charFromUnicode: self asUnicode! !

!Character methodsFor: '*Keymapping-KeyCombinations' stamp: 'CamilloBruni 3/18/2011 23:13'!
alt
	^ KMModifier alt + self! !

!Character methodsFor: '*Fuel' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper

	^aGeneralMapper visitCharacter: self! !

!Character methodsFor: 'testing' stamp: 'yo 8/28/2002 13:42'!
isCharacter

	^ true.
! !

!Character methodsFor: 'converting' stamp: 'CamilloBruni 9/5/2011 20:06'!
asInteger
	"Answer the value of the receiver."

	^ value! !

!Character methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2011 12:23'!
isUppercase

	^ self characterSet isUppercase: self.
! !

!Character methodsFor: 'accessing' stamp: 'yo 12/29/2002 10:11'!
charCode

	^ (value bitAnd: 16r3FFFFF).
! !

!Character methodsFor: 'printing' stamp: 'CamilloBruni 10/20/2012 23:52'!
printOn: aStream
	| name |
	(value > 32 and: [ value ~= 127])
		ifTrue: [ aStream nextPut: $$; nextPut: self ]
		ifFalse: [
			name := self class constantNameFor: self.
			aStream nextPutAll: self class name.
			name notNil
				ifTrue: [ aStream space; nextPutAll: name ]
				ifFalse: [ aStream nextPutAll: ' value: '; print: value ] ].! !

!Character methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2011 12:23'!
isLetter

	^ self characterSet isLetter: self.
! !

!Character methodsFor: 'copying' stamp: 'tk 1/7/1999 16:50'!
veryDeepCopyWith: deepCopier
	"Return self.  I can't be copied."! !

!Character methodsFor: 'testing' stamp: 'yo 7/29/2005 15:21'!
isSafeForHTTP
	"whether a character is 'safe', or needs to be escaped when used, eg, in a URL"
	"[GG]  See http://www.faqs.org/rfcs/rfc1738.html. ~ is unsafe and has been removed"
	^ self charCode < 128
		and: [self isAlphaNumeric
				or: ['.-_' includes: (Character value: self charCode)]]! !

!Character methodsFor: 'printing' stamp: 'StephaneDucasse 7/31/2010 19:45'!
printStringHex
	"returns the hex digit part of the character value
	$A printStringHex
		 '41' 
	$A hex
		 '16r41' "
	
	^value printStringBase: 16! !

!Character methodsFor: 'accessing' stamp: 'CamilloBruni 8/31/2011 12:41'!
codePoint
	"Just for ANSI Compliance"	
	^value! !

!Character methodsFor: 'converting' stamp: 'yo 8/11/2003 21:18'!
basicSqueakToIso
	| asciiValue |

	value < 128 ifTrue: [^ self].
	value > 255 ifTrue: [^ self].
	asciiValue := #(196 197 199 201 209 214 220 225 224 226 228 227 229 231 233 232 234 235 237 236 238 239 241 243 242 244 246 245 250 249 251 252 134 176 162 163 167 149 182 223 174 169 153 180 168 128 198 216 129 177 138 141 165 181 142 143 144 154 157 170 186 158 230 248 191 161 172 166 131 173 178 171 187 133 160 192 195 213 140 156 150 151 147 148 145 146 247 179 253 159 185 164 139 155 188 189 135 183 130 132 137 194 202 193 203 200 205 206 207 204 211 212 190 210 218 219 217 208 136 152 175 215 221 222 184 240 254 255 256 ) at: self asciiValue - 127.
	^ Character value: asciiValue.
! !

!Character methodsFor: 'converting' stamp: 'CamilloBruni 8/31/2011 12:29'!
asLowercase
	"If the receiver is uppercase, answer its matching lowercase Character."
	^ self characterSet toLowercase: self! !

!Character methodsFor: 'comparing' stamp: ''!
hash
	"Hash is reimplemented because = is implemented."

	^value! !

!Character methodsFor: 'comparing' stamp: ''!
> aCharacter 
	"Answer true if the receiver's value > aCharacter's value."

	^self asciiValue > aCharacter asciiValue! !

!Character methodsFor: 'copying' stamp: 'ul 4/26/2011 02:33'!
deepCopy
	"Characters from 0 to 255 are unique, copy only the rest."
	
	value < 256 ifTrue: [ ^self ].
	^super deepCopy! !

!Character methodsFor: 'testing' stamp: ''!
isLiteral

	^true! !

!Character methodsFor: 'printing' stamp: 'ul 11/23/2010 13:28'!
storeOn: aStream
	"Common character literals are preceded by '$', however special need to be encoded differently: for some this might be done by using one of the shortcut constructor methods for the rest we have to create them by ascii-value."

	| name |
	self shouldBePrintedAsLiteral
		ifTrue: [ aStream nextPut: $$; nextPut: self ]
		ifFalse: [
			name := self class constantNameFor: self.
			name notNil
				ifTrue: [ aStream nextPutAll: self class name; space; nextPutAll: name ]
				ifFalse: [
					aStream 
						nextPut: $(; nextPutAll: self class name; 
						nextPutAll: ' value: '; print: value; nextPut: $) ] ].! !

!Character methodsFor: 'accessing' stamp: ''!
asciiValue
	"Answer the value of the receiver that represents its ascii encoding."

	^value! !

!Character methodsFor: 'copying' stamp: 'ul 4/26/2011 02:33'!
copy
	"Characters from 0 to 255 are unique, copy only the rest."
	
	value < 256 ifTrue: [ ^self ].
	^super copy! !

!Character methodsFor: '*Keymapping-KeyCombinations' stamp: 'GuillermoPolito 3/19/2013 20:28'!
asKeyCombination
	^ KMSingleKeyCombination from: self! !

!Character methodsFor: 'accessing' stamp: 'yo 12/29/2002 10:14'!
leadingChar

	^ (value bitAnd: (16r3FC00000)) bitShift: -22.
! !

!Character methodsFor: 'testing' stamp: 'LukasRenggli 8/22/2010 17:21'!
tokenish
	"Answer whether the receiver is a valid token-character -- letter, digit, underscore, or colon."

	^ self isLetter or: [ self isDigit or: [ self = $_ or: [ self = $: ] ] ]! !

!Character methodsFor: 'copying' stamp: 'ul 4/26/2011 02:35'!
shallowCopy
	"Characters from 0 to 255 are unique, copy only the rest."
		
	value < 256 ifTrue: [ ^self ].
	^super shallowCopy! !

!Character methodsFor: 'printing' stamp: 'pmm 5/22/2010 10:33'!
storeBinaryOn: aStream
	"Store the receiver on a binary (file) stream"
	value < 256 
		ifTrue:[aStream basicNextPut: value]
		ifFalse:[aStream nextInt32Put: value].! !

!Character methodsFor: '*Fuel' stamp: 'MartinDias 12/30/2011 10:51'!
serializeOn: anEncoder

	anEncoder encodeByte: value! !

!Character methodsFor: 'accessing' stamp: 'CamilloBruni 8/31/2011 12:22'!
characterSet
	^ EncodedCharSet charsetAt: self leadingChar! !

!Character methodsFor: 'testing' stamp: ''!
isAlphaNumeric
	"Answer whether the receiver is a letter or a digit."

	^self isLetter or: [self isDigit]! !

!Character methodsFor: 'comparing' stamp: 'ar 4/9/2005 21:48'!
= aCharacter 
	"Primitive. Answer true if the receiver and the argument are the same
	object (have the same object pointer) and false otherwise. Optional. See
	Object documentation whatIsAPrimitive."

	^ self == aCharacter or:[
		aCharacter isCharacter and: [self asciiValue = aCharacter asciiValue]]! !

!Character methodsFor: 'accessing' stamp: 'CamilloBruni 8/31/2011 12:23'!
digitValue
	"Answer 0-9 if the receiver is $0-$9, 10-35 if it is $A-$Z, and < 0
	otherwise. This is used to parse literal numbers of radix 2-36."

	"slow version
	| digitValue |
	(digitValue := ('0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ' indexOf: self) - 1) >= 0
		ifTrue: [ ^digitValue ].
	^ (EncodedCharSet charsetAt: self leadingChar) digitValueOf: self. "
	
	value > 16rFF ifTrue: [^ self characterSet digitValueOf: self].
	^DigitValues at: 1 + value! !

!Character methodsFor: 'testing' stamp: ''!
isVowel
	"Answer whether the receiver is one of the vowels, AEIOU, in upper or 
	lower case."

	^'AEIOU' includes: self asUppercase! !

!Character methodsFor: 'comparing' stamp: 'md 8/2/2005 18:21'!
sameAs: aCharacter 
	"Answer whether the receiver is equal to aCharacter, ignoring case"
	^ (self asLowercase = aCharacter asLowercase)	! !

!Character methodsFor: 'testing' stamp: ''!
isSeparator
	"Answer whether the receiver is one of the separator characters--space, 
	cr, tab, line feed, or form feed."

	value = 32 ifTrue: [^true].	"space"
	value = 13 ifTrue: [^true].	"cr"
	value = 9 ifTrue: [^true].	"tab"
	value = 10 ifTrue: [^true].	"line feed"
	value = 12 ifTrue: [^true].	"form feed"
	^false! !

!Character methodsFor: '*Collections-Abstract-splitjoin' stamp: 'onierstrasz 4/10/2009 22:51'!
join: aSequenceableCollection
	^ self asString join: aSequenceableCollection
! !

!Character methodsFor: 'private' stamp: 'ar 4/9/2005 22:18'!
setValue: newValue
	value ifNotNil:[^self error:'Characters are immutable'].
	value := newValue.! !

!Character methodsFor: 'testing' stamp: 'SeanDeNigris 2/10/2015 13:26'!
isArrow

	^ { Character arrowUp. Character arrowDown. Character arrowLeft. Character arrowRight } includes: self! !

!Character class methodsFor: 'accessing untypeable characters' stamp: ''!
enter
	"Answer the Character representing enter."

	^self value: 3! !

!Character class methodsFor: 'accessing untypeable characters' stamp: 'ls 9/2/1999 08:06'!
escape
	"Answer the ASCII ESC character"

	^self value: 27! !

!Character class methodsFor: '*Fuel' stamp: 'MartinDias 12/30/2011 10:56'!
materializeFrom: aDecoder

	^self value: aDecoder nextEncodedByte! !

!Character class methodsFor: 'accessing untypeable characters' stamp: 'NS 7/11/2000 09:19'!
insert
	^ self value: 5! !

!Character class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:04'!
gtExampleA
	<gtExample>
	^ $A! !

!Character class methodsFor: 'initialization' stamp: 'StephaneDucasse 3/28/2010 19:15'!
initialize
	"Create the table of DigitsValues."
	"self initialize"
	
	CharacterTable ifNil: [
		"Initialize only once to ensure that byte characters are unique"
		CharacterTable := Array new: 256.
		1 to: 256 do: [:i | CharacterTable at: i put: (self basicNew setValue: i - 1)]].
	self initializeDigitValues! !

!Character class methodsFor: 'instance creation' stamp: 'GabrielOmarCotelli 5/29/2009 23:42'!
value: anInteger 
	"Answer the Character whose value is anInteger."
	
	anInteger negative ifTrue:[self error: 'Characters expects a positive value.'].
	anInteger > 255 ifTrue: [^self basicNew setValue: anInteger].
	^ CharacterTable at: anInteger + 1.
! !

!Character class methodsFor: 'accessing untypeable characters' stamp: ''!
linefeed
	"Answer the Character representing a linefeed."

	^self value: 10! !

!Character class methodsFor: 'accessing untypeable characters' stamp: 'NS 7/11/2000 09:21'!
home
	^ self value: 1! !

!Character class methodsFor: 'instance creation' stamp: 'ar 4/9/2005 22:37'!
allCharacters
	"This name is obsolete since only the characters that will fit in a byte can be queried"
	^self allByteCharacters
	
! !

!Character class methodsFor: 'instance creation' stamp: 'ar 10/25/2010 19:00'!
allByteCharacters
	"Answer all the characters that can be encoded in a byte"
	^ (0 to: 255) collect: [:v | Character value: v] as: String
! !

!Character class methodsFor: 'accessing untypeable characters' stamp: 'NS 7/11/2000 09:20'!
pageDown
	^ self value: 12! !

!Character class methodsFor: 'instance creation' stamp: 'ul 4/26/2011 02:29'!
leadingChar: leadChar code: code

	code >= 16r400000 ifTrue: [
		self error: 'code is out of range'.
	].
	leadChar >= 256 ifTrue: [
		self error: 'lead is out of range'.
	].
	code < 256 ifTrue: [ ^self value: code ].
	^self value: (leadChar bitShift: 22) + code.! !

!Character class methodsFor: 'accessing untypeable characters' stamp: 'wiz 4/9/2006 20:30'!
nbsp
	"non-breakable space. Latin1 encoding common usage."

	^ Character value: 160! !

!Character class methodsFor: 'accessing untypeable characters' stamp: 'NS 7/11/2000 09:20'!
arrowRight
	^ self value: 29! !

!Character class methodsFor: 'accessing untypeable characters' stamp: ''!
newPage
	"Answer the Character representing a form feed."

	^self value: 12! !

!Character class methodsFor: 'accessing untypeable characters' stamp: ''!
tab
	"Answer the Character representing a tab."

	^self value: 9! !

!Character class methodsFor: 'instance creation' stamp: 'ar 10/25/2010 18:54'!
separators
	"Answer a collection of the standard ASCII separator characters."

	^ #(32 "space"
		13 "cr"
		9 "tab"
		10 "line feed"
		12 "form feed")
		collect: [:v | Character value: v] as: String! !

!Character class methodsFor: 'accessing untypeable characters' stamp: ''!
cr
	"Answer the Character representing a carriage return."

	^self value: 13! !

!Character class methodsFor: 'accessing untypeable characters' stamp: 'ls 9/8/1998 22:15'!
lf
	"Answer the Character representing a linefeed."

	^self value: 10! !

!Character class methodsFor: 'accessing untypeable characters' stamp: 'StephaneDucasse 4/4/2010 15:12'!
euro
	"The Euro currency sign, that E with two dashes. The code point is a official unicode ISO/IEC-10646-1"

	^ Unicode value: 16r20AC! !

!Character class methodsFor: 'private' stamp: 'CamilloBruni 10/20/2012 23:52'!
constantNames
	"Added the rest of them!!"
	
	^#(backspace cr delete escape lf newPage space tab
		arrowDown arrowLeft arrowRight arrowUp
		enter end home insert nbsp pageDown pageUp null).! !

!Character class methodsFor: 'accessing untypeable characters' stamp: 'NS 7/11/2000 09:20'!
arrowDown
	^ self value: 31! !

!Character class methodsFor: 'constants' stamp: 'rhi 9/8/2000 14:57'!
alphabet
	"($a to: $z) as: String"

	^ 'abcdefghijklmnopqrstuvwxyz' copy! !

!Character class methodsFor: 'accessing untypeable characters' stamp: 'NS 7/11/2000 09:21'!
end
	^ self value: 4! !

!Character class methodsFor: 'accessing untypeable characters' stamp: ''!
space
	"Answer the Character representing a space."

	^self value: 32! !

!Character class methodsFor: 'accessing untypeable characters' stamp: 'NS 7/11/2000 09:21'!
pageUp
	^ self value: 11! !

!Character class methodsFor: '*Spec-Inspector' stamp: 'SvenVanCaekenberghe 2/24/2014 14:35'!
inspectorClass
	^ EyeCharacterInspector! !

!Character class methodsFor: 'constants' stamp: ''!
characterTable
	"Answer the class variable in which unique Characters are stored."

	^CharacterTable! !

!Character class methodsFor: 'accessing untypeable characters' stamp: 'NS 7/11/2000 09:20'!
arrowLeft
	^ self value: 28! !

!Character class methodsFor: 'instance creation' stamp: 'StephaneDucasse 3/28/2010 17:41'!
codePoint: anInteger 
	"Just for ANSI Compliance"	
	^self value: anInteger
	! !

!Character class methodsFor: 'private' stamp: 'lr 11/21/2005 17:24'!
constantNameFor: aCharacter
	^ self constantNames
		detect: [ :each | (self perform: each) = aCharacter ]
		ifNone: [ nil ].! !

!Character class methodsFor: 'instance creation' stamp: ''!
new
	"Creating new characters is not allowed."

	self error: 'cannot create new characters'! !

!Character class methodsFor: 'instance creation' stamp: ''!
digitValue: x 
	"Answer the Character whose digit value is x. For example, answer $9 for 
	x=9, $0 for x=0, $A for x=10, $Z for x=35."

	| index |
	index := x asInteger.
	^CharacterTable at: 
		(index < 10
			ifTrue: [48 + index]
			ifFalse: [55 + index])
		+ 1! !

!Character class methodsFor: 'accessing untypeable characters' stamp: 'NS 7/11/2000 09:20'!
arrowUp
	^ self value: 30! !

!Character class methodsFor: 'accessing untypeable characters' stamp: 'NS 7/11/2000 09:19'!
delete
	^ self value: 127! !

!Character class methodsFor: 'accessing untypeable characters' stamp: 'CamilloBruni 10/20/2012 23:51'!
null
	^ self value: 0! !

!Character class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:04'!
gtExampleSpace
	<gtExample>
	^ self space! !

!Character class methodsFor: 'accessing untypeable characters' stamp: ''!
backspace
	"Answer the Character representing a backspace."

	^self value: 8! !

!Character class methodsFor: 'initialization' stamp: 'StephaneDucasse 3/28/2010 19:06'!
initializeDigitValues
	"Initialize the well known digit value of ascii characters.
	Note that the DigitValues table is 1-based while ascii values are 0-based, thus the offset+1."
	DigitValues := Array new: 256 withAll: -1.
	"the digits"
	0 to: 9 do: [:i | DigitValues at: 48 + i + 1 put: i].
	 "the uppercase letters"
	10 to: 35 do: [:i | DigitValues at: 55 + i + 1 put: i].
	"the lowercase letters"
	10 to: 35 do: [:i | DigitValues at: 87 + i + 1 put: i].! !

!CharacterBlock commentStamp: 'StephaneDucasse 5/18/2010 16:00'!
I describe the location of one character displayed on the screen. My instances are used to return the results of methods:
	Paragraph characterBlockAtPoint: aPoint and
	Paragraph characterBlockForIndex: stringIndex.
Any recomposition or movement of a Paragraph can make the information I store stale.

text (Text): The text where my character is from
stringIndex (Integer): The index of my character in the text, starting from 1
textLine (TextLine): The displayed line my character is on
origin (Point): The top-left corner of the area allocated for displaying my
		character's glyph, in pixels, counting right then down from the
		top-left corner of the text display area, and starting from 0@0
corner (Point): The bottom-right corner of the area allocated for displaying my
		character's glyph, in pixels, counting right then down from the
		top-left corner of the text display area, and starting from 0@0
!
!CharacterBlock methodsFor: 'private' stamp: 'MarcusDenker 9/26/2014 15:03'!
stringIndex: anInteger text: aText topLeft: topLeft extent: extent 
	stringIndex := anInteger.
	text := aText.
	super 
		setPoint: topLeft
		point: topLeft + extent! !

!CharacterBlock methodsFor: 'comparing' stamp: ''!
> aCharacterBlock 
	"Answer whether the string index of the receiver comes after that of 
	aCharacterBlock."

	^aCharacterBlock < self! !

!CharacterBlock methodsFor: 'private' stamp: 'lr 7/4/2009 10:42'!
moveBy: aPoint 
	"Change the corner positions of the receiver so that its area translates by 
	the amount defined by the argument, aPoint."
	origin := origin + aPoint.
	corner := corner + aPoint! !

!CharacterBlock methodsFor: 'comparing' stamp: ''!
>= aCharacterBlock 
	"Answer whether the string index of the receiver does not precede that of 
	aCharacterBlock."

	^(self < aCharacterBlock) not! !

!CharacterBlock methodsFor: 'comparing' stamp: 'th 9/17/2002 11:54'!
min: aCharacterBlock
	aCharacterBlock ifNil:[^self].
	^aCharacterBlock < self
		ifTrue:[ aCharacterBlock]
		ifFalse:[self].! !

!CharacterBlock methodsFor: 'comparing' stamp: ''!
< aCharacterBlock 
	"Answer whether the string index of the receiver precedes that of 
	aCharacterBlock."

	^stringIndex < aCharacterBlock stringIndex! !

!CharacterBlock methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
textLine: aLine 
	textLine := aLine! !

!CharacterBlock methodsFor: 'accessing' stamp: ''!
stringIndex
	"Answer the position of the receiver in the string it indexes."

	^stringIndex! !

!CharacterBlock methodsFor: 'comparing' stamp: 'th 9/17/2002 11:54'!
max: aCharacterBlock
	aCharacterBlock ifNil:[^self].
	^aCharacterBlock > self
		ifTrue:[ aCharacterBlock]
		ifFalse:[self].! !

!CharacterBlock methodsFor: 'accessing' stamp: 'di 12/2/97 14:33'!
textLine
	^ textLine! !

!CharacterBlock methodsFor: 'comparing' stamp: ''!
= aCharacterBlock

	self species = aCharacterBlock species
		ifTrue: [^stringIndex = aCharacterBlock stringIndex]
		ifFalse: [^false]! !

!CharacterBlock methodsFor: 'printing' stamp: 'di 12/2/97 19:15'!
printOn: aStream

	aStream nextPutAll: 'a CharacterBlock with index '.
	stringIndex printOn: aStream.
	(text ~~ nil and: [text size> 0 and: [stringIndex between: 1 and: text size]])
		ifTrue: [aStream nextPutAll: ' and character '.
				(text at: stringIndex) printOn: aStream].
	aStream nextPutAll: ' and rectangle '.
	super printOn: aStream.
	textLine ifNotNil: [aStream cr; nextPutAll: ' in '.
				textLine printOn: aStream].
! !

!CharacterBlock methodsFor: 'comparing' stamp: ''!
<= aCharacterBlock 
	"Answer whether the string index of the receiver does not come after that 
	of aCharacterBlock."

	^(self > aCharacterBlock) not! !

!CharacterBlockScanner commentStamp: 'nice 10/6/2013 22:04'!
A CharacterScanner does scan text to compute the CharacterBlock for a character specified by its index in the text or its proximity to the cursor location. The CharacterBlock stores information both about character layout and character index in the text.

This class is essential for selecting text with the mouse or with arrow keys.

Instance Variables
	characterIndex:		<Integer | nil>
	characterPoint:		<Point>
	lastCharacterWidth:		<Number | nil>
	nextLeftMargin:		<Number>
	specialWidth:		<Number | nil>

characterIndex
	- the index of character for which the layout information is searched, or nil when the layout is searched by cursor location

characterPoint
	- the cursor location for which nearest character index and layout are searched.

lastCharacterWidth
	- a number indicating the width of last character being processed.
	Note that this variable is left to nil during the inner scan loop, and only set on stopConditions.

nextLeftMargin
	- a number specifying the distance between left of composition zone and left of first character for the next line.

specialWidth
	- a number holding the width of an embedded object if any, or nil if none.
!
!CharacterBlockScanner methodsFor: 'stop conditions' stamp: 'ar 1/8/2000 14:32'!
setFont
	specialWidth := nil.
	super setFont! !

!CharacterBlockScanner methodsFor: 'stop conditions' stamp: 'nice 10/1/2013 01:45'!
endOfRun
	"Before arriving at the cursor location, the selection has encountered an 
	end of run. Answer false if the selection continues, true otherwise. Set 
	up indexes for building the appropriate CharacterBlock."

	| runLength lineStop |
	
	(((characterIndex ~~ nil and:
		[runStopIndex < characterIndex and: [runStopIndex < text size]])
			or:	[characterIndex == nil and: [lastIndex < line last]]) or: [
				((lastIndex < line last)
				and: [((text at: lastIndex) leadingChar ~= (text at: lastIndex+1) leadingChar)
					and: [lastIndex ~= characterIndex]])])
		ifTrue:	["We're really at the end of a real run."
				runLength := text runLengthFor: (lastIndex := lastIndex + 1).
				lineStop := characterIndex	"scanning for index"
						ifNil: [line last].		"scanning for point".
				(runStopIndex := lastIndex + (runLength - 1)) > lineStop
					ifTrue: [runStopIndex := lineStop].
				self setStopConditions.
				^false].

	self retrieveLastCharacterWidth.
		
	(characterIndex == nil and: [lastIndex = line last])
		ifTrue: [characterPoint x > (destX + (lastCharacterWidth // 2))
			ifTrue:
				[ "Correct for clicking right half of last character in line
				means selecting AFTER the char"
				lastIndex := lastIndex + 1.
				lastCharacterWidth := 0.
				characterPoint := destX + lastCharacterWidth @ destY.
				^true]].

	characterPoint := destX @ destY.
	characterIndex ~~ nil
		ifTrue:	["If scanning for an index and we've stopped on that index,
				then we back destX off by the width of the character stopped on
				(it will be pointing at the right side of the character) and return"
				runStopIndex = characterIndex
					ifTrue:	[characterPoint := destX - lastCharacterWidth @ destY.
							^true].
				"Otherwise the requested index was greater than the length of the
				string.  Return string size + 1 as index, indicate further that off the
				string by setting character to nil and the extent to 0."
				lastIndex :=  lastIndex + 1.
				lastCharacterWidth := 0.
				^true].

	"Scanning for a point and either off the end of the line or off the end of the string."
	runStopIndex = text size
		ifTrue:	["off end of string"
				lastIndex :=  lastIndex + 1.
				lastCharacterWidth := 0.
				^true].
	"just off end of line without crossing x"
	lastIndex := lastIndex + 1.
	^true! !

!CharacterBlockScanner methodsFor: 'scanning' stamp: 'nice 10/22/2013 20:50'!
characterBlockAtPoint: aPoint index: index in: textLine
	"This method is the Morphic characterBlock finder.  It combines
	MVC's characterBlockAtPoint:, -ForIndex:, and buildCharacterBlockIn:"
	| runLength lineStop stopCondition |
	line := textLine.
	rightMargin := line rightMargin.
	lastIndex := line first.
	self setStopConditions.		"also sets font"
	characterIndex := index.  " == nil means scanning for point"
	characterPoint := aPoint.
	(characterPoint isNil or: [characterPoint y > line bottom])
		ifTrue: [characterPoint := line bottomRight].
	destX := leftMargin := line leftMarginForAlignment: alignment.
	destY := line top.
	(text isEmpty or: [(characterPoint y < destY or: [characterPoint x < destX])
				or: [characterIndex notNil and: [characterIndex < line first]]])
		ifTrue:	[^ (CharacterBlock new stringIndex: line first text: text
					topLeft: destX@destY extent: 0 @ textStyle lineGrid)
					textLine: line].
	runLength := text runLengthFor: line first.
	lineStop := characterIndex	"scanning for index"
		ifNil: [ line last ].			"scanning for point"
	runStopIndex := lastIndex + (runLength - 1) min: lineStop.
	lastCharacterWidth := 0.
	spaceCount := 0.

	[
		stopCondition := self scanCharactersFrom: lastIndex to: runStopIndex
			in: text string rightX: characterPoint x.
		"see setStopConditions for stopping conditions for character block operations."
		self perform: stopCondition
	] whileFalse.
	characterIndex
		ifNil: ["Result for characterBlockAtPoint: "
				^ (CharacterBlock new
					stringIndex: lastIndex
					text: text topLeft: characterPoint + (font descentKern @ 0)
					extent: lastCharacterWidth @ line lineHeight - (font baseKern @ 0))
							textLine: line]
		ifNotNil: ["Result for characterBlockForIndex: "
				^ (CharacterBlock new
					stringIndex: characterIndex
					text: text topLeft: characterPoint + ((font descentKern) - kern @ 0)
					extent: lastCharacterWidth @ line lineHeight)
							textLine: line]! !

!CharacterBlockScanner methodsFor: 'private' stamp: 'nice 10/3/2013 14:57'!
retrieveLastCharacterWidth
	| lastCharacter |
	lastIndex > text size ifTrue: [^lastCharacterWidth := 0].
	specialWidth ifNotNil: [^lastCharacterWidth := specialWidth].
	lastCharacter := text at: lastIndex.
	(lastCharacter charCode >= 256 or: [(stopConditions at: lastCharacter charCode + 1) isNil])
		ifTrue: [lastCharacterWidth := font widthOf: (text at: lastIndex)].
	"if last character was a stop condition, then the width is already set"
	^lastCharacterWidth! !

!CharacterBlockScanner methodsFor: 'stop conditions' stamp: 'nice 10/8/2013 22:40'!
paddedSpace
	"When the line is justified, the spaces will not be the same as the font's 
	space character. A padding of extra space must be considered in trying 
	to find which character the cursor is pointing at. Answer whether the 
	scanning has crossed the cursor."

	| pad |
	spaceCount := spaceCount + 1.
	pad := line justifiedPadFor: spaceCount font: font.
	lastCharacterWidth := spaceWidth + pad.
	(destX + lastCharacterWidth)  >= characterPoint x
		ifTrue:
			[^self crossedX].
	lastIndex := lastIndex + 1.
	destX := destX + lastCharacterWidth + kern.
	pendingKernX := 0.
	^ false
! !

!CharacterBlockScanner methodsFor: 'private' stamp: 'nice 10/6/2013 14:55'!
placeEmbeddedObject: anchoredMorph
	"Workaround: The following should really use #textAnchorType"
	| w |
	anchoredMorph relativeTextAnchorPosition ifNotNil:[^true].
	w := anchoredMorph width.
	specialWidth := w.
	(destX + w > characterPoint x) ifTrue: [^false].
	destX := destX + w + kern.
	^ true! !

!CharacterBlockScanner methodsFor: 'stop conditions' stamp: 'nice 10/2/2013 02:07'!
crossedX
	"Text display has wrapping. The scanner just found a character past the x 
	location of the cursor. We know that the cursor is pointing at a character 
	or before one."

	self retrieveLastCharacterWidth.
	
	characterPoint x <= (destX + (lastCharacterWidth // 2))
		ifTrue:	[characterPoint := destX @ destY.
				^true].
	lastIndex >= line last 
		ifTrue:	[characterPoint := destX @ destY.
				^true].

	"Pointing past middle of a character, return the next character."
	lastIndex := lastIndex + 1.
	characterPoint := destX + lastCharacterWidth + kern @ destY.
	^ true! !

!CharacterBlockScanner methodsFor: 'text attributes' stamp: 'hmm 2/2/2001 15:07'!
indentationLevel: anInteger
	super indentationLevel: anInteger.
	nextLeftMargin := leftMargin.
	indentationLevel timesRepeat: [
		nextLeftMargin := textStyle nextTabXFrom: nextLeftMargin
					leftMargin: leftMargin
					rightMargin: rightMargin]! !

!CharacterBlockScanner methodsFor: 'stop conditions' stamp: 'nice 10/1/2013 01:12'!
cr 
	"Answer a CharacterBlock that specifies the current location of the mouse 
	relative to a carriage return stop condition that has just been 
	encountered. The ParagraphEditor convention is to denote selections by 
	CharacterBlocks, sometimes including the carriage return (cursor is at 
	the end) and sometimes not (cursor is in the middle of the text)."

	((characterIndex ~= nil
		and: [characterIndex > text size])
			or: [(line last = text size)
				and: [(destY + line lineHeight) < characterPoint y]])
		ifTrue:	["When off end of string, give data for next character"
				destY := destY +  line lineHeight.
				characterPoint := (nextLeftMargin ifNil: [leftMargin]) @ destY.
				(lastIndex < text size and: [(text at: lastIndex) = CR and: [(text at: lastIndex+1) = Character lf]])
					ifTrue: [lastIndex := lastIndex + 2]
					ifFalse: [lastIndex := lastIndex + 1].
				lastCharacterWidth := 0.
				^ true].
		characterPoint := destX @ destY.
		lastCharacterWidth := rightMargin - destX.
		^true! !

!CharacterBlockScanner methodsFor: 'stop conditions' stamp: 'nice 10/13/2013 22:13'!
tab
	| nextDestX |
	nextDestX := self plainTab.
	lastCharacterWidth := nextDestX - destX max: 0.
	nextDestX >= characterPoint x
		ifTrue: 
			[^ self crossedX].
	destX := nextDestX.
	lastIndex := lastIndex + 1.
	^false! !

!CharacterScanner commentStamp: 'nice 10/22/2013 20:04'!
A CharacterScanner holds the state associated with scanning text. Subclasses scan characters for specified purposes, such as computing a CharacterBlock or placing characters into Forms.

Instance Variables
	alignment:		<Integer>
	destX:		<Number>
	destY:		<Number>
	emphasisCode:		<Object>
	font:		<AbstractFont>
	indentationLevel:		<Integer>
	kern:		<Number>
	lastIndex:		<Integer>
	leftMargin:		<Number>
	line:		<TextLine>
	map:		<Array>
	pendingKernX:		<Number>
	rightMargin:		<Number>
	runStopIndex:		<Integer>
	spaceCount:		<Integer>
	spaceWidth:		<Number>
	stopConditions:		<Array>
	text:		<Text>
	textStyle:		<TextStyle>
	wantsColumnBreaks:		<Boolean>
	xTable:		<Array>

alignment
	- an Integer encoding the alignment of text

destX
	- horizontal position for next character (distance from left of composition area)

destY
	- vertical position for next character (distance from top of composition area)

emphasisCode
	- an Integer encoding the current text emphasis to use (bold, italic, ...)

font
	- the current font used for measuring/composing/displaying characters

indentationLevel
	- an Integer specifying a number of leading tabs to be inserted at beginning of new lines

kern
	- a Number specifying additional horizontal spacing to place between characters (spacing is reduced when kern is negative)

lastIndex
	- the Integer index of next character to be processed in the text

leftMargin
	- a Number specifying the distance between left of composition zone and left of first character in the line.

line
	- an object holding information about the line currently being displayed (like first and last index in text).
	Note: this is either a TextLine in Morphic, or TextLineInterval for ST80 compatibility

map
	- an array mapping character code to glyph position.
	This is used by primitive 103 only, in case of ByteString.

pendingKernX
	- a Number to be added to horizontal spacing of next char if ever it is in the same font than previous one.
	The inner scan loop is interrupted by a change of text run.
	But some changes won't change the font, so the kerning must be remembered and applied later.

rightMargin
	- a Number specifying the distance between right of composition zone and right of last character in the line.

runStopIndex
	- the Integer index of last character in current text run.

spaceCount
	- the number of spaces encoutered so far in current line. This is useful for adjusting the spacing in cas of Justified alignment.

spaceWidth
	- the width of space character in current font.

stopConditions
	- an Array mapping a table of characters codes for which special actions are to be taken.
	These are typically control characters like carriage return or horizontal tab.

text
	- the text to be measured/composed/displayed

textStyle
	- an object holding a context for the text style (which set of font to use, which margins, etc...)

wantsColumnBreaks
	- a Boolean indicating whether some special handling for multiple columns is requested.
	THIS ONLY MAKES SENSE IN CompositionScanner AND SHOULD BE MOVED TO THE SUBCLASS
	
xTable
	- an array mapping character code to glyph x coordinate in form.
	This is used by primitive 103 only, in case of ByteString.
	
Implementation note: accelerated Character scanning with primitive 103 requires following order for 5 first instance variables, please don't alter:
destX lastIndex xTable map destY
!
!CharacterScanner methodsFor: 'stop conditions' stamp: 'nice 10/6/2013 15:06'!
embeddedObject
	pendingKernX := 0.
	text attributesAt: lastIndex do:[:attr| 
		attr anchoredMorph ifNotNil:[
			"Try to placeEmbeddedObject: - if it answers false, then there's no place left"
			(self placeEmbeddedObject: attr anchoredMorph) ifFalse:[^self crossedX]]].
	"Note: if ever several objects are embedded on same character, only indent lastIndex once"
	lastIndex := lastIndex + 1.
	^false! !

!CharacterScanner methodsFor: 'private' stamp: 'ar 5/17/2000 18:20'!
indentationLevel
	"return the number of tabs that are currently being placed at the beginning of each line"
	^indentationLevel ifNil:[0]! !

!CharacterScanner methodsFor: 'scanning' stamp: 'nice 10/10/2013 02:17'!
scanKernableMultibyteCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX 
"this is a scanning method for
multibyte characters in a WideString
a font that does do character-pair kerning via widthAndKernedWidthOfLeft:right:into:"

	| ascii encoding nextDestX startEncoding floatDestX widthAndKernedWidth nextChar atEndOfRun char |
	lastIndex := startIndex.
	lastIndex > stopIndex ifTrue: [^self handleEndOfRunAt: stopIndex].
	startEncoding := (sourceString at: startIndex) leadingChar.
	floatDestX := destX.
	widthAndKernedWidth := Array new: 2.
	atEndOfRun := false.
	[lastIndex <= stopIndex] whileTrue: [
		char := sourceString at: lastIndex.
		encoding := char leadingChar.
		encoding ~= startEncoding
			ifTrue: [lastIndex := lastIndex - 1. ^#endOfRun].
		ascii := char charCode.
		(ascii < 256 and: [(stopConditions at: ascii + 1) ~~ nil])
			ifTrue: [^ stopConditions at: ascii + 1].
		nextChar := (lastIndex + 1 <= stopIndex) 
			ifTrue:[sourceString at: lastIndex + 1]
			ifFalse:[
				atEndOfRun := true.
				"if there is a next char in sourceString, then get the kern 
				and store it in pendingKernX"
				lastIndex + 1 <= sourceString size
					ifTrue:[sourceString at: lastIndex + 1]
					ifFalse:[	nil]].
		font 
			widthAndKernedWidthOfLeft: char 
			right: nextChar
			into: widthAndKernedWidth.
		nextDestX := floatDestX + (widthAndKernedWidth at: 1).
		nextDestX > rightX ifTrue: [^#crossedX].
		floatDestX := floatDestX + kern + (widthAndKernedWidth at: 2).
		atEndOfRun 
			ifTrue:[
				pendingKernX := (widthAndKernedWidth at: 2) - (widthAndKernedWidth at: 1).
				floatDestX := floatDestX - pendingKernX].
		destX := floatDestX .
		lastIndex := lastIndex + 1.
	].
	^self handleEndOfRunAt: stopIndex! !

!CharacterScanner methodsFor: 'scanning' stamp: 'nice 10/21/2013 22:39'!
primScanCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta
	"Primitive. This is the inner loop of text display--but see 
	scanCharactersFrom: to:rightX: which would get the string, 
	stopConditions and displaying from the instance. March through source 
	String from startIndex to stopIndex. If any character is flagged with a 
	non-nil entry in stops, then return the corresponding value. Determine 
	width of each character from xTable, indexed by map. 
	If dextX would exceed rightX, then return stops at: 258. 
	Advance destX by the width of the character. If stopIndex has been
	reached, then return stops at: 257. Optional. 
	See Object documentation whatIsAPrimitive.
	Historical note: this primitive has been unusable since about Squeak 2.8 when the shape of the CharracterScanner class changed. It is left here as a reminder that the actual primitive still needs supporting in the VM to keep old images such as Scratch1.4 alive - tpr"
	<primitive: 103>
	^self basicScanByteCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX ! !

!CharacterScanner methodsFor: 'scanning' stamp: 'nice 10/21/2013 22:40'!
scanByteCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX 
"this is a scanning method for
single byte characters in a ByteString
a font that does not do character-pair kerning"
	^self primScanCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stopConditions kern: kern
! !

!CharacterScanner methodsFor: 'scanning' stamp: 'nice 10/10/2013 02:16'!
scanMultibyteCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX 
"this is a scanning method for
multibyte characters in a WideString
a font that does not do character-pair kerning"
	| char ascii encoding nextDestX startEncoding |
	lastIndex := startIndex.
	startEncoding := (sourceString at: startIndex) leadingChar.
	[lastIndex <= stopIndex] whileTrue: [
		char := sourceString at: lastIndex.
		encoding := char leadingChar.
		encoding ~= startEncoding
			ifTrue: [lastIndex := lastIndex - 1. ^#endOfRun].
		ascii := char charCode.
		(ascii < 256 and: [(stopConditions at: ascii + 1) ~~ nil])
			ifTrue: [^ stopConditions at: ascii + 1].
		"bump nextDestX by the width of the current character"
		nextDestX := destX + (font widthOf: char).
		nextDestX > rightX ifTrue: [^#crossedX].
		destX := nextDestX + kern .
		lastIndex := lastIndex + 1.
	].
	^self handleEndOfRunAt: stopIndex! !

!CharacterScanner methodsFor: 'text attributes' stamp: 'nice 10/21/2013 22:36'!
setActualFont: aFont
	"Set the basal font to an isolated font reference."

	xTable := aFont xTable.
	map := aFont characterToGlyphMap.
	font := aFont.! !

!CharacterScanner methodsFor: 'text attributes' stamp: 'ar 1/8/2000 14:28'!
textColor: ignored
	"Overridden in DisplayScanner"! !

!CharacterScanner methodsFor: 'initialize' stamp: 'ls 1/14/2002 21:26'!
initialize
	destX := destY := leftMargin := 0.! !

!CharacterScanner methodsFor: 'scanning' stamp: 'nice 10/22/2013 20:49'!
scanCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX 
	^sourceString scanCharactersFrom: startIndex to: stopIndex with: self rightX: rightX font: font! !

!CharacterScanner methodsFor: 'text attributes' stamp: 'ar 12/15/2001 23:31'!
setAlignment: style
	alignment := style.
	! !

!CharacterScanner methodsFor: 'private' stamp: 'nice 10/5/2013 21:03'!
setStopConditions
	"Set the font and the stop conditions for the current run."
	
	self setFont.
	stopConditions := alignment = Justified
		ifTrue: [PaddedSpaceCondition]
		ifFalse: [DefaultStopConditions]! !

!CharacterScanner methodsFor: 'private' stamp: 'ar 1/8/2000 14:23'!
leadingTab
	"return true if only tabs lie to the left"
	line first to: lastIndex do:
		[:i | (text at: i) == Tab ifFalse: [^ false]].
	^ true! !

!CharacterScanner methodsFor: 'scanning' stamp: 'nice 10/22/2013 20:50'!
measureString: aString inFont: aFont from: startIndex to: stopIndex
	"Measure aString width in given font aFont.
	The string shall not include line breaking, tab or other control character."
	destX := destY := lastIndex := 0.
	pendingKernX := 0.
	font := aFont.
	kern := 0 - font baseKern.
	spaceWidth := font widthOf: Space.
	stopConditions := MeasuringStopConditions.
	self scanCharactersFrom: startIndex to: stopIndex in: aString rightX: 999999.
	^destX! !

!CharacterScanner methodsFor: '*Multilingual-OtherLanguages' stamp: 'tpr 10/3/2013 12:25'!
isBreakableAt: index in: sourceString in: encodingClass
"check with the encoding whether the character at index is a breakable character.
Only the JISX0208 & JapaneseEnvironments  ever return true, so only the scanJapaneseCharacters... method calls this"
	^ encodingClass isBreakableAt: index in: sourceString.
! !

!CharacterScanner methodsFor: 'text attributes' stamp: 'ar 1/8/2000 14:23'!
indentationLevel: anInteger
	"set the number of tabs to put at the beginning of each line"
	indentationLevel := anInteger! !

!CharacterScanner methodsFor: 'text attributes' stamp: 'ar 1/8/2000 14:27'!
addKern: kernDelta
	"Set the current kern amount."
	kern := kern + kernDelta! !

!CharacterScanner methodsFor: 'private' stamp: 'nice 10/8/2013 22:49'!
advanceIfFirstCharOfLine
	lastIndex = line first
		ifTrue:
			[destX := destX + pendingKernX + (font widthOf: (text at: line first)).
			lastIndex := lastIndex + 1.
			pendingKernX := 0].! !

!CharacterScanner methodsFor: 'text attributes' stamp: 'ar 1/8/2000 14:28'!
setFont: fontNumber
	"Set the font by number from the textStyle."

	self setActualFont: (textStyle fontAt: fontNumber)! !

!CharacterScanner methodsFor: 'stop conditions' stamp: 'tween 4/6/2007 11:16'!
columnBreak

	pendingKernX := 0.
	^true! !

!CharacterScanner methodsFor: 'stop conditions' stamp: 'nice 10/10/2013 01:49'!
handleEndOfRunAt: stopIndex
	" make sure the lastIndex is set to stopIndex and then return the stopCondition for endOfRun; important for  a couple of outside users"

	lastIndex := stopIndex.
	^#endOfRun! !

!CharacterScanner methodsFor: 'text attributes' stamp: 'ar 1/8/2000 14:27'!
addEmphasis: code
	"Set the bold-ital-under-strike emphasis."
	emphasisCode := emphasisCode bitOr: code! !

!CharacterScanner methodsFor: 'scanning' stamp: 'nice 10/21/2013 22:38'!
basicScanByteCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX 
"this is a scanning method for
single byte characters in a ByteString
a font that does not do character-pair kerning"
	| ascii nextDestX char |
	lastIndex := startIndex.
	[lastIndex <= stopIndex]
		whileTrue: [
			"get the character value"
			char := sourceString at: lastIndex.
			ascii := char asciiValue + 1.
			"if there is an entry in 'stops' for this value, return it"
			(stopConditions at: ascii)
				ifNotNil: [^ stopConditions at: ascii].
			"bump nextDestX by the width of the current character"
			nextDestX := destX + (font widthOf: char).
			"if the next x is past the right edge, return crossedX"
			nextDestX > rightX
				ifTrue: [^#crossedX].
			"update destX and incorporate thr kernDelta"
			destX := nextDestX + kern.
			lastIndex := lastIndex + 1].
	^self handleEndOfRunAt: stopIndex

! !

!CharacterScanner methodsFor: 'scanning' stamp: 'tpr 10/3/2013 12:58'!
scanCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta 
	^sourceString scanCharactersFrom: startIndex to: stopIndex with: self rightX: rightX font: font! !

!CharacterScanner methodsFor: 'private' stamp: 'nice 10/13/2013 22:10'!
handleIndentation
	self indentationLevel timesRepeat: [
		destX := self plainTab]! !

!CharacterScanner methodsFor: '*Multilingual-OtherLanguages' stamp: 'nice 10/10/2013 02:17'!
scanJapaneseCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX 
"this is a scanning method for
multibyte Japanese characters in a WideString - hence the isBreakable:in:in:
a font that does not do character-pair kerning "

	| ascii encoding nextDestX startEncoding char charset |
	lastIndex := startIndex.
	lastIndex > stopIndex ifTrue: [^self handleEndOfRunAt: stopIndex].
	startEncoding := (sourceString at: startIndex) leadingChar.
	charset := EncodedCharSet charsetAt: startEncoding.
	[lastIndex <= stopIndex] whileTrue: [
		char := sourceString at: lastIndex.
		encoding := char leadingChar.
		encoding ~= startEncoding
			ifTrue: [lastIndex := lastIndex - 1. ^#endOfRun].
		ascii := char charCode.
		(encoding = 0 and: [ascii < 256 and:[(stopConditions at: ascii + 1) ~~ nil]]) 
			ifTrue: [^ stopConditions at: ascii + 1].
		(self isBreakableAt: lastIndex in: sourceString in: charset)
			ifTrue: [	self registerBreakableIndex].
		nextDestX := destX + (font widthOf: char).
		nextDestX > rightX
			ifTrue: [^#crossedX].
		destX := nextDestX + kern.
		lastIndex := lastIndex + 1.
	].
	^self handleEndOfRunAt: stopIndex! !

!CharacterScanner methodsFor: 'private' stamp: 'nice 10/6/2013 14:46'!
placeEmbeddedObject: anchoredMorph
	"Place the anchoredMorph or return false if it cannot be placed"
	^ true! !

!CharacterScanner methodsFor: '*Multilingual-OtherLanguages' stamp: 'yo 12/20/2002 16:15'!
registerBreakableIndex

	"Record left x and character index of the line-wrappable point. 
	The default implementation here does nothing."

	^ false.
! !

!CharacterScanner methodsFor: 'private' stamp: 'nice 10/13/2013 22:07'!
plainTab
	"This is the basic method of adjusting destX for a tab.
	Answer the next destX"
	pendingKernX := 0.
	^(alignment = Justified and: [self leadingTab not])
		ifTrue:		"embedded tabs in justified text are weird"
			[destX + (textStyle tabWidth - (line justifiedTabDeltaFor: spaceCount)) max: destX]
		ifFalse: 
			[textStyle nextTabXFrom: destX
				leftMargin: leftMargin
				rightMargin: rightMargin].! !

!CharacterScanner methodsFor: 'private' stamp: 'nice 10/22/2013 20:07'!
setFont
	| priorFont |
	"Set the font and other emphasis."
	priorFont := font.
	text ifNotNil:[
		emphasisCode := 0.
		kern := 0.
		indentationLevel := 0.
		alignment := textStyle alignment.
		font := nil.
		(text attributesAt: lastIndex forStyle: textStyle)
			do: [:att | att emphasizeScanner: self]].
	font ifNil: [self setFont: textStyle defaultFontIndex].
	self setActualFont: (font emphasized: emphasisCode).
	priorFont 
		ifNotNil: [
			font = priorFont 
				ifTrue:[
					"font is the same, perhaps the color has changed?
					We still want kerning between chars of the same
					font, but of different color. So add any pending kern to destX"
					destX := destX + (pendingKernX ifNil:[0])].
			destX := destX + priorFont descentKern].
	pendingKernX := 0. "clear any pending kern so there is no danger of it being added twice"
	destX := destX - font descentKern.
	"NOTE: next statement should be removed when clipping works"
	leftMargin ifNotNil: [destX := destX max: leftMargin].
	kern := kern - font baseKern.

	"Install various parameters from the font."
	spaceWidth := font widthOf: Space.! !

!CharacterScanner methodsFor: 'private' stamp: 'ar 1/8/2000 14:28'!
text: t textStyle: ts
	text := t.
	textStyle := ts! !

!CharacterScanner methodsFor: 'scanning' stamp: 'nice 10/10/2013 02:19'!
scanKernableByteCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX 
"this is a scanning method for
single byte characters in a ByteString
a font that does do character-pair kerning via widthAndKernedWidthOfLeft:right:into:"
	| ascii nextDestX char floatDestX widthAndKernedWidth nextCharOrNil atEndOfRun |
	lastIndex := startIndex.
	floatDestX := destX.
	widthAndKernedWidth := Array new: 2.
	atEndOfRun := false.
	[lastIndex <= stopIndex]
		whileTrue: [
			"get the character value"
			char := sourceString at: lastIndex.
			ascii := char asciiValue + 1.
			"if there is an entry in 'stops' for this value, return it"
			(stopConditions at: ascii)
				ifNotNil: [^ stopConditions at: ascii].
			"get the next character..."
			nextCharOrNil := lastIndex + 1 <= stopIndex
						ifTrue: [sourceString at: lastIndex + 1]
						ifFalse: ["if we're at or past the stopIndex, see if there is anything in the full string"
							atEndOfRun := true.
							lastIndex + 1 <= sourceString size
								ifTrue: [sourceString at: lastIndex + 1]].
			"get the font's kerning info for the pair of current character and next character"
			"for almost all fonts in common use this is a waste of time since they don't support pair kerning and both values are #widthOf: char"
			font
				widthAndKernedWidthOfLeft: char
				right: nextCharOrNil
				into: widthAndKernedWidth.
			"bump nextDestX by the width of the current character"
			nextDestX := floatDestX
						+ (widthAndKernedWidth at: 1).
			"if the next x is past the right edge, return crossedX"
			nextDestX > rightX
				ifTrue: [^ #crossedX].
			"bump floatDestX by the *kerned* width of the current
			character, which is where the *next* char will go"
			floatDestX := floatDestX + kern
						+ (widthAndKernedWidth at: 2).
			"if we are at the end of this run we keep track of the
			character-kern-delta for possible later use and then rather
			insanely remove that character-kern-delta from floatDestX,
			making it equivalent to (old floatDestX) + kernDelta +
			width-of-character - no idea why"
			atEndOfRun
				ifTrue: [pendingKernX := (widthAndKernedWidth at: 2)
								- (widthAndKernedWidth at: 1).
					floatDestX := floatDestX - pendingKernX].
			"save the next x for next time around the loop"
			destX := floatDestX.
			lastIndex := lastIndex + 1].
	^self handleEndOfRunAt: stopIndex
! !

!CharacterScanner class methodsFor: 'class initialization' stamp: 'nice 10/29/2013 02:26'!
initialize
"
	CharacterScanner initialize
"
	| a |
	a := Array new: 258.
	a at: 1 + 1 put: #embeddedObject.
	a at: Tab asciiValue + 1 put: #tab.
	a at: CR asciiValue + 1 put: #cr.
	a at: Character lf asciiValue + 1 put: #cr.
	"Note: following two codes are used only by primitive 103 for accelerated Character scanning"
	a at: 257 put: #endOfRun.
	a at: 258 put: #crossedX.
	
	DefaultStopConditions := a copy.

	CompositionStopConditions := a copy.
	CompositionStopConditions at: Space asciiValue + 1 put: #space.
	ColumnBreakStopConditions := CompositionStopConditions copy.
	ColumnBreakStopConditions at: TextComposer characterForColumnBreak asciiValue + 1 put: #columnBreak.

	PaddedSpaceCondition := a copy.
	PaddedSpaceCondition at: Space asciiValue + 1 put: #paddedSpace.

	MeasuringStopConditions := (Array new: 258)
		at: 257 put: #endOfRun;
		at: 258 put: #crossedX;
		yourself! !

!CharacterSet commentStamp: '<historical>'!
A set of characters.  Lookups for inclusion are very fast.!
!CharacterSet methodsFor: 'removing' stamp: 'klub 9/14/2009 19:07'!
removeAll

	map atAllPut: 0! !

!CharacterSet methodsFor: 'conversion' stamp: 'nice 3/23/2007 02:28'!
byteComplement
	"return a character set containing precisely the single byte characters the receiver does not"
	
	| set |
	set := CharacterSet allCharacters.
	self do: [ :c | set remove: c ].
	^set! !

!CharacterSet methodsFor: 'comparison' stamp: 'ls 8/17/1998 20:46'!
hash
	^self byteArrayMap hash! !

!CharacterSet methodsFor: 'collection ops' stamp: 'nice 5/9/2006 23:02'!
size
	^map sum! !

!CharacterSet methodsFor: 'conversion' stamp: 'nice 11/20/2007 00:19'!
complement
	"return a character set containing precisely the characters the receiver does not"
	
	^CharacterSetComplement of: self copy! !

!CharacterSet methodsFor: 'collection ops' stamp: 'nice 12/10/2009 19:20'!
remove: aCharacter ifAbsent: aBlock
	(self includes: aCharacter) ifFalse: [^aBlock value].
	^self remove: aCharacter! !

!CharacterSet methodsFor: 'collection ops' stamp: 'nice 12/9/2009 15:29'!
findFirstInByteString: aByteString startingAt: startIndex
	"Double dispatching: since we know this is a ByteString, we can use a superfast primitive using a ByteArray map with 0 slots for byte characters not included and 1 for byte characters included in the receiver."
	^ByteString
		findFirstInString: aByteString
		inSet: self byteArrayMap
		startingAt: startIndex! !

!CharacterSet methodsFor: 'private' stamp: 'ls 8/17/1998 20:35'!
byteArrayMap
	"return a ByteArray mapping each ascii value to a 1 if that ascii value is in the set, and a 0 if it isn't.  Intended for use by primitives only"
	^map! !

!CharacterSet methodsFor: 'private' stamp: 'nice 5/9/2006 23:22'!
wideCharacterMap
	"used for comparing with WideCharacterSet"
	
	| wide |
	wide := WideCharacterSet new.
	wide addAll: self.
	^wide wideCharacterMap! !

!CharacterSet methodsFor: 'collection ops' stamp: 'nice 5/9/2006 23:09'!
includes: aCharacter
	aCharacter asciiValue >= 256
		ifTrue: ["Guard against wide characters"
			^false].
	^(map at: aCharacter asciiValue + 1) > 0! !

!CharacterSet methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 09:44'!
initialize
	super initialize.
	map := ByteArray new: 256 withAll: 0.! !

!CharacterSet methodsFor: 'comparison' stamp: 'tk 7/5/2001 21:58'!
= anObject
	^self species == anObject species and: [
		self byteArrayMap = anObject byteArrayMap ]! !

!CharacterSet methodsFor: 'collection ops' stamp: 'ar 4/9/2005 22:37'!
do: aBlock
	"evaluate aBlock with each character in the set"

	Character allByteCharacters do: [ :c |
		(self includes: c) ifTrue: [ aBlock value: c ] ]
! !

!CharacterSet methodsFor: 'collection ops' stamp: 'MarianoMartinezPeck 9/22/2011 17:12'!
add: aCharacter
	"I automatically become a WideCharacterSet if you add a wide character to myself"
	
	aCharacter asciiValue >= 256
		ifTrue: [| wide |
			wide := WideCharacterSet new.
			wide addAll: self.
			wide add: aCharacter.
			self becomeForward: wide.
			^aCharacter].
	map at: aCharacter asciiValue + 1 put: 1.
	^aCharacter! !

!CharacterSet methodsFor: 'collection ops' stamp: 'nice 5/9/2006 23:20'!
remove: aCharacter
	aCharacter asciiValue >= 256
		ifFalse: ["Guard against wide characters"
			map at: aCharacter asciiValue + 1 put: 0].
	^aCharacter! !

!CharacterSet methodsFor: 'testing' stamp: 'nice 5/9/2006 23:23'!
hasWideCharacters
	^false! !

!CharacterSet methodsFor: 'copying' stamp: 'nice 10/5/2009 08:52'!
postCopy
	super postCopy.
	map := map copy! !

!CharacterSet methodsFor: 'conversion' stamp: 'StephaneDucasse 11/4/2011 09:54'!
asString
	"Convert the receiver into a String"

	^String 
		new: self size 
		streamContents: 
			[ :s | self do: [ :ch | s nextPut: ch]].! !

!CharacterSet class methodsFor: 'instance creation' stamp: 'ls 8/18/1998 00:40'!
separators
	"return a set containing just the whitespace characters"

	| set |
	set := self empty.
	set addAll: Character separators.
	^set! !

!CharacterSet class methodsFor: 'instance creation' stamp: 'nk 8/3/2004 06:54'!
empty
 	"return an empty set of characters"
	^self new! !

!CharacterSet class methodsFor: 'instance creation' stamp: 'ls 1/3/1999 12:52'!
newFrom: aCollection
	| newCollection |
	newCollection := self new.
	newCollection addAll: aCollection.
	^newCollection! !

!CharacterSet class methodsFor: 'instance creation' stamp: 'ls 8/17/1998 20:42'!
allCharacters
	"return a set containing all characters"

	| set |
	set := self empty.
	0 to: 255 do: [ :ascii | set add: (Character value: ascii) ].
	^set! !

!CharacterSet class methodsFor: 'accessing' stamp: 'nice 11/16/2009 11:22'!
crlf
	CrLf ifNil: [CrLf := self with: Character cr with: Character lf].
	^CrLf! !

!CharacterSet class methodsFor: 'instance creation' stamp: 'ls 8/18/1998 00:40'!
nonSeparators
	"return a set containing everything but the whitespace characters"

	^self separators complement! !

!CharacterSetComplement commentStamp: 'nice 8/31/2008 14:53'!
CharacterSetComplement is a space efficient implementation of (CharacterSet complement) taking care of WideCharacter (code > 255)

However, it will maintain a byteArrayMap for character <= 255 in a cache keeping 

instance variables:
	absent <CharacterSet> contains character that are not in the set (i.e. my complement)
	byteArrayMapCache <ByteArray | nil> cache this information because it has to be used in tight loops where efficiency matters!
!CharacterSetComplement methodsFor: 'comparing' stamp: 'marcus.denker 8/11/2008 20:45'!
hash
	^absent hash bitXor: self class hash! !

!CharacterSetComplement methodsFor: 'collection ops' stamp: 'nice 3/23/2007 02:10'!
size
	"Is this 2**32-absent size ?"
	
	^self shouldNotImplement! !

!CharacterSetComplement methodsFor: 'printing' stamp: 'nice 11/19/2007 23:55'!
storeOn: aStream
	"Store a description of the elements of the complement rather than self."
	
	aStream nextPut: $(.
	absent storeOn: aStream.
	aStream nextPut: $); space; nextPutAll: #complement.! !

!CharacterSetComplement methodsFor: 'initialization' stamp: 'nice 8/31/2008 14:56'!
complement: aCharacterSet
	"initialize with the complement"
	
	byteArrayMapCache := nil.
	absent := aCharacterSet.
	! !

!CharacterSetComplement methodsFor: 'converting' stamp: 'nice 3/23/2007 02:08'!
complement
	"return a character set containing precisely the characters the receiver does not"
	
	^absent copy! !

!CharacterSetComplement methodsFor: 'collection ops' stamp: 'nice 12/10/2009 19:20'!
remove: aCharacter ifAbsent: aBlock
	(self includes: aCharacter) ifFalse: [^aBlock value].
	^self remove: aCharacter! !

!CharacterSetComplement methodsFor: 'collection ops' stamp: 'nice 3/23/2007 02:15'!
reject: aBlock
	"Implementation note: rejecting present is selecting absent"
	
	^(absent select: aBlock) complement! !

!CharacterSetComplement methodsFor: 'collection ops' stamp: 'nice 12/11/2009 09:03'!
findFirstInByteString: aByteString startingAt: startIndex
	"Double dispatching: since we know this is a ByteString, we can use a superfast primitive using a ByteArray map with 0 slots for byte characters not included and 1 for byte characters included in the receiver."
	^ByteString
		findFirstInString: aByteString
		inSet: self byteArrayMap
		startingAt: startIndex! !

!CharacterSetComplement methodsFor: 'private' stamp: 'nice 8/31/2008 14:28'!
byteArrayMap
	"return a ByteArray mapping each ascii value to a 1 if that ascii value is in the set, and a 0 if it isn't.  Intended for use by primitives only"

	^byteArrayMapCache ifNil: [byteArrayMapCache := absent byteArrayMap collect: [:i | 1 - i]]! !

!CharacterSetComplement methodsFor: 'collection ops' stamp: 'nice 3/23/2007 02:07'!
includes: aCharacter
	^(absent includes: aCharacter) not! !

!CharacterSetComplement methodsFor: 'collection ops' stamp: 'nice 3/23/2007 02:15'!
select: aBlock
	"Implementation note: selecting present is rejecting absent"
	
	^(absent reject: aBlock) complement! !

!CharacterSetComplement methodsFor: 'comparing' stamp: 'nice 3/23/2007 02:19'!
= anObject
	"Implementation note: we do not test if equal to a WideCharacterSet,
	because it is unlikely that WideCharacterSet is as complete as self"
	
	^self class == anObject class and: [
		absent = anObject complement ]! !

!CharacterSetComplement methodsFor: 'collection ops' stamp: 'nice 3/23/2007 02:11'!
do: aBlock
	"evaluate aBlock with each character in the set.
	don't do it, there are too many..."

	self shouldNotImplement! !

!CharacterSetComplement methodsFor: 'collection ops' stamp: 'nice 8/31/2008 14:56'!
add: aCharacter 
	"a character is present if not absent, so adding a character is removing it from the absent"
	
	(absent includes: aCharacter)
		ifTrue:
			[byteArrayMapCache := nil.
			absent remove: aCharacter].
	^ aCharacter! !

!CharacterSetComplement methodsFor: 'testing' stamp: 'nice 3/23/2007 02:12'!
hasWideCharacters
	"This is a guess that absent is not holding each and every possible wideCharacter..."
	
	^true! !

!CharacterSetComplement methodsFor: 'copying' stamp: 'nice 10/5/2009 08:52'!
postCopy
	super postCopy.
	absent := absent copy! !

!CharacterSetComplement methodsFor: 'printing' stamp: 'nice 11/19/2007 23:54'!
printOn: aStream
	"Print a description of the complement rather than self.
	Rationale: self would be too long to print."
	
	aStream nextPut: $(.
	absent printOn: aStream.
	aStream nextPut: $); space; nextPutAll: #complement.! !

!CharacterSetComplement methodsFor: 'collection ops' stamp: 'nice 8/31/2008 14:54'!
remove: aCharacter
	"This means aCharacter is now absent from myself.
	It must be added to my absent."
	
	byteArrayMapCache := nil.
	^absent add: aCharacter! !

!CharacterSetComplement methodsFor: 'collection ops' stamp: 'MarianoMartinezPeck 9/22/2011 17:16'!
removeAll
	self becomeForward: CharacterSet new! !

!CharacterSetComplement class methodsFor: 'instance creation' stamp: 'nice 3/23/2007 02:25'!
of: aCharacterSet
	"answer the complement of aCharacterSet"
	
	^ super new complement: aCharacterSet! !

!CharacterSetTest commentStamp: 'nice 11/20/2007 00:35'!
CharacterSetTest holds tests for CharacterSet!
!CharacterSetTest methodsFor: 'testing' stamp: 'nice 11/20/2007 00:38'!
testCopy
    | theOriginal theCopy |
    theOriginal := CharacterSet newFrom: 'abc'.
    theCopy := theOriginal copy.
    theCopy remove: $a.
    ^self should: [theOriginal includes: $a] description: 'Changing the copy should not change the original'.! !

!CharacterTest commentStamp: '<historical>'!
This is the unit test for the class Character. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see: 
	- http://www.c2.com/cgi/wiki?UnitTest
	- there is a chapter in the PharoByExample book (http://pharobyexample.org/)
	- the sunit class category!
!CharacterTest methodsFor: 'tests - various' stamp: 'CamilloBruni 8/31/2013 20:23'!
testCharacterSeparators
	"Regression test"

	| result |
	result := '/' , Character separators.
	self assert: result size = (Character separators size + 1)! !

!CharacterTest methodsFor: 'tests instance creation' stamp: 'CamilloBruni 8/31/2013 20:23'!
testInstanceCreation
	self should: [ Character value: -1 ] raise: Error.
	Character value: 0.
	Character value: 256! !

!CharacterTest methodsFor: 'tests' stamp: 'MarcusDenker 4/30/2013 11:21'!
testPrintStringAll
	Character allCharacters do: [ :each |
		self assert: (self class compiler
			evaluate: each printString) = each ].! !

!CharacterTest methodsFor: 'tests' stamp: 'CamilloBruni 10/21/2012 00:15'!
testStoreString
	self assert: $a storeString = '$a'.
	self assert: $5 storeString = '$5'.
	self assert: $@ storeString = '$@'.

	self assert: Character cr storeString equals: 'Character cr'.
	self assert: Character lf storeString equals: 'Character lf'.
	self assert: Character space storeString equals: 'Character space'.
	self assert: (Character value: 0) storeString equals: 'Character null'.
	
	self assert: (Character value: 17) storeString equals: '(Character value: 17)'.! !

!CharacterTest methodsFor: 'tests instance creation' stamp: 'sd 6/5/2005 09:25'!
testNew

	self should: [Character new] raise: Error.! !

!CharacterTest methodsFor: 'tests conversion' stamp: 'CamilloBruni 9/28/2012 14:50'!
testAsUppercaseBasicAsciiRange
	| lowercase uppercase |
	lowercase  := 'abcdefghijklmnopqrstuvwxyz123456789'.
	uppercase := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ123456789'.
	lowercase withIndexDo: [ :char :index |
		self assert: char asUppercase equals: (uppercase at: index)]! !

!CharacterTest methodsFor: 'tests' stamp: 'StephaneDucasse 3/30/2010 18:34'!
testCodePoint

	self assert: $A codePoint = 65.
	self assert: (Character codePoint: $a codePoint) = $a.
	self assert: (Character codePoint: 97) codePoint = 97.! !

!CharacterTest methodsFor: 'tests' stamp: 'MarcusDenker 4/30/2013 11:18'!
testStoreStringAll
	Character allCharacters do: [ :each |
		self assert: (self class compiler
			evaluate: each storeString) = each ].! !

!CharacterTest methodsFor: 'tests conversion' stamp: 'CamilloBruni 9/28/2012 14:53'!
testAsLowercaseBasicAsciiRange
	| lowercase uppercase |
	lowercase  := 'abcdefghijklmnopqrstuvwxyz123456789'.
	uppercase := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ123456789'.
	uppercase withIndexDo: [ :char :index |
		self assert: char asLowercase equals: (lowercase at: index)]! !

!CharacterTest methodsFor: 'tests' stamp: 'StephaneDucasse 7/31/2010 19:47'!
testPrintStringHex
	self assert: $a printStringHex = '61'.
	self assert: Character space printStringHex = '20'! !

!CharacterTest methodsFor: 'tests' stamp: 'CamilloBruni 10/21/2012 00:14'!
testPrintString
	self assert: $a printString = '$a'.
	self assert: $5 printString = '$5'.
	self assert: $@ printString = '$@'.

	self assert: Character cr printString = 'Character cr'.
	self assert: Character lf printString = 'Character lf'.
	self assert: Character space printString = 'Character space'.

	self assert: (Character value: 0) printString = 'Character null'.
	self assert: (Character value: 17) printString = 'Character value: 17'.! !

!CharacterTest methodsFor: 'tests' stamp: 'StephaneDucasse 7/31/2010 19:40'!
testHex
	self assert: $a hex = '16r61'.
	self assert: Character space hex = '16r20'! !

!CharacterTest methodsFor: 'tests' stamp: 'StephaneDucasse 3/28/2010 19:19'!
testDigitValue
	"self debug: #testDigitValue"
	
	'0123456789ABCDEF' with: #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)
		do: [:char :value | self assert: char digitValue = value].
	
	'0123456789' with: #(0 1 2 3 4 5 6 7 8 9)
		do: [:char :value | self assert: char digitValue = value].
		
	 ! !

!CheckBoxExample commentStamp: '<historical>'!
A CheckBoxExample is a simple example of how to use CheckBoxes.

CheckBoxExample new openWithSpec!
!CheckBoxExample methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/1/2013 15:00'!
container

	^ container  asSpecAdapter! !

!CheckBoxExample methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/1/2013 14:59'!
button1

	^ button1! !

!CheckBoxExample methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 2/2/2012 01:01'!
setActionsForButton3

	button3 whenActivatedDo: [ container addMorph: morph3 ].
	button3 whenDesactivatedDo: [ container removeMorph: morph3 ]! !

!CheckBoxExample methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 2/2/2012 01:01'!
setActionsForButton2

	button2 whenActivatedDo: [ container addMorph: morph2 ].
	button2 whenDesactivatedDo: [ container removeMorph: morph2 ]! !

!CheckBoxExample methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 2/2/2012 01:01'!
instantiateMorphs

	morph1 := Morph new
					color: Color red;
					width: 60;
					height: 20.
	morph2 := Morph new
					color: Color blue;
					width: 20;
					height: 60.
	morph3 := Morph new
					color: Color green;
					width: 50;
					height: 50.! !

!CheckBoxExample methodsFor: 'initialization' stamp: 'CamilloBruni 9/22/2013 21:35'!
initializeWidgets 

	button1 := self newCheckBox.
	button2 := self newCheckBox.
	button3 := self newCheckBox.
	
	button1 label: 'Button 1'.
	button2 label: 'Button 2'.
	button3 label: 'Button 3'.
	self setFocus.! !

!CheckBoxExample methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 2/2/2012 01:01'!
setGroup

	RadioButtonGroup new 
		addRadioButton: button1;
		addRadioButton: button2;
		addRadioButton: button3;
		default: button1.
	! !

!CheckBoxExample methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/1/2013 14:59'!
button2

	^ button2! !

!CheckBoxExample methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 22:55'!
initialize

	container := PanelMorph new.
	
	container
		changeTableLayout;
		listDirection: #bottomToLeft.
	
	self instantiateMorphs.
	super initialize.! !

!CheckBoxExample methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/2/2012 01:01'!
button3

	^ button3! !

!CheckBoxExample methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 6/12/2012 19:23'!
initializePresenter

	self setActionsForButton1.
	self setActionsForButton2.
	self setActionsForButton3.	! !

!CheckBoxExample methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 2/2/2012 01:01'!
setFocus
	
	self focusOrder
		add: button1;
		add: button2;
		add: button3.
	! !

!CheckBoxExample methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 2/2/2012 01:01'!
setActionsForButton1

	button1 whenActivatedDo: [ container addMorph: morph1 ].
	button1 whenDesactivatedDo: [ container removeMorph: morph1 ]! !

!CheckBoxExample class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/15/2014 17:14'!
defaultSpec

	^ { #ContainerModel.
			#add:.	{ self topSpec. #layout:. 	#(#SpecLayoutFrame
													bottomFraction: 0
													bottomOffset: 20) }.
			#add:.	{{#model . #container } . #layout: . #(#SpecLayoutFrame topOffset: 22) }
	   }! !

!CheckBoxExample class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 2/5/2012 17:17'!
title

	^ 'CheckBox Example'! !

!CheckBoxExample class methodsFor: 'example' stamp: 'HernanMoralesDurand 2/3/2014 00:07'!
example
	"self example"

	CheckBoxExample new openWithSpec.
! !

!CheckBoxExample class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/15/2014 17:14'!
topSpec

	^ { #ContainerModel.
			#add:. {{#model .	#button1 } . #layout:.  #(#SpecLayoutFrame
															rightFraction: 0.33
															bottomFraction: 0
															bottomOffset: 25)}.
			#add:.  {{#model .	#button2 } . #layout:. #(#SpecLayoutFrame
															leftFraction: 0.33
															rightFraction: 0.66
															bottomFraction: 0
															bottomOffset: 25)}.
			#add:.  {{#model .	#button3 } . #layout:. #(#SpecLayoutFrame
															leftFraction: 0.66
															bottomFraction: 0
															bottomOffset: 25)}}! !

!CheckBoxExample class methodsFor: 'specs' stamp: 'bvr 6/4/2012 17:27'!
defaultSpec2

	^ { #Panel.
			#changeTableLayout.
			#listDirection:.		#rightToLeft.
			#addMorph:. {#model.	#button1.}.
			#addMorph:. {#model.	#button2.}.
			#addMorph:. {#model.	#button3.}.
			#hResizing:.	#shrinkWrap.
			#vResizing:.	#shrinkWrap.	}! !

!CheckBoxModel commentStamp: '<historical>'!
A CheckboxModel is a spec model for Checkbox

You can also have a look at CheckBoxExample for a full example of how to use them with a group.
!
!CheckBoxModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:42'!
state: aBoolean
	"Set if the checkbox is activated or not"
	"<api: #boolean getter: #state>"
	stateHolder value: aBoolean! !

!CheckBoxModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:32'!
whenLabelClickableChanged: aBlock
	"A block performed when the label click is activated or descativated"
	
	labelClickableHolder whenChangedDo:  aBlock ! !

!CheckBoxModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:20'!
labelClickable: aBoolean
	"<api: #boolean getter: #labelClickable registration: #whenLabelClickableChanged:>"
	"Set if the label can be clicked to select the checkbox"
	
	labelClickableHolder value: aBoolean! !

!CheckBoxModel methodsFor: 'api-valueHolder' stamp: 'StephaneDucasse 2/27/2015 21:48'!
labelHolder

	^ labelHolder! !

!CheckBoxModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:26'!
whenChangedDo: aBlock
	"This method is used to propagate the event that I have changed"
	
	stateHolder whenChangedDo: aBlock! !

!CheckBoxModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:32'!
whenDesactivationActionChanged: aBlock
	"A block performed when the desactivation action changed"
	actionWhenDesactivatedHolder whenChangedDo:  aBlock ! !

!CheckBoxModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:32'!
whenDesactivatedDo: aBlock
	"This method is used to propagate the event that I have been desactivated"
	
	stateHolder whenChangedDo: [:bool | bool ifFalse: aBlock ]! !

!CheckBoxModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:00'!
labelClickable
"	<api: #inspect>"
	"Return true if the label can be clicked to select the checkbox"

	^ labelClickableHolder value! !

!CheckBoxModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/22/2013 17:33'!
labelOnLeft

	^ self changed: #labelOnLeft with: #()! !

!CheckBoxModel methodsFor: 'initialization' stamp: 'StephaneDucasse 2/27/2015 21:49'!
initialize

	super initialize.
	actionWhenActivatedHolder := [] asValueHolder.
	actionWhenDesactivatedHolder := [] asValueHolder.
	enabledHolder := true asValueHolder.
	stateHolder := false asValueHolder.
	labelClickableHolder := true asValueHolder. 
	labelHolder := '' asValueHolder.
	stateHolder whenChangedDo: [:bool |
		bool
			ifTrue: actionWhenActivatedHolder value
			ifFalse: actionWhenDesactivatedHolder value.
		self changed: #state ].
	
	labelClickableHolder whenChangedDo: [:aBoolean | self changed: { #labelClickable: . aBoolean } ].
	labelHolder whenChangedDo: [:label | self changed: { #label: . label } ].! !

!CheckBoxModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:06'!
state
	"<api: #inspect>"
	"Return the current state of the checkBox"
	
	^ stateHolder value! !

!CheckBoxModel methodsFor: '*Deprecated40' stamp: 'StephaneDucasse 2/27/2015 21:47'!
whenLabelChanged: aBlock
	"Set a block to performed when the text is changed"
	self deprecated: 'Instead of using aModel whenLabelChanged: aBlock, use aModel labelHolder whenChangedDo: aBlock.'.
	
	labelHolder whenChangedDo: aBlock ! !

!CheckBoxModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:17'!
label
	"<api: #inspect>"
	^ labelHolder value! !

!CheckBoxModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/22/2013 17:33'!
labelOnRight

	^ self changed: #labelOnRight with: #()! !

!CheckBoxModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:50'!
desactivationAction: aBlock
	"<api: #block getter: #desactivationAction registration: #whenDesactivationActionChanged:>"
	"This method is used to set the action to perform when I am desactivated"
	
	actionWhenDesactivatedHolder value: aBlock! !

!CheckBoxModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:23'!
activationAction: aBlock
	"<api: #block getter: #activationAction registration: #whenActivationActionChanged:>"
	"This method is used to set the action to perform when I am activated"
	
	actionWhenActivatedHolder value: aBlock! !

!CheckBoxModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:31'!
whenActivationActionChanged: aBlock
	"A block performed when the activation action changed"
	actionWhenActivatedHolder whenChangedDo: aBlock ! !

!CheckBoxModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:11'!
click
	"<api: #do>"
	"Simulate a click on the checkbox
	Used when the checkboc is a list item"

	self toggleState! !

!CheckBoxModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:31'!
whenActivatedDo: aBlock
	"This method is used to propagate the event that I have been activated" 
	
	stateHolder whenChangedDo: [:bool | bool ifTrue: aBlock ]! !

!CheckBoxModel methodsFor: 'api' stamp: 'StephaneDucasse 2/27/2015 21:47'!
label: aString
	"<api: #string getter: #label>"
	"Set the label of the checkbox"

	labelHolder value: aString! !

!CheckBoxModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:16'!
toggleState
	"<api: #do>"
	"Toogle the current state of the checkbox"

	self state: self state not! !

!CheckBoxModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/1/2013 13:38'!
defaultSpec
	<spec>
	
	^ #(CheckBoxAdapter
		adapt: #(model))! !

!CheckBoxModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 7/13/2012 02:00'!
title

	^ 'Checkbox Button'! !

!CheckBoxModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/13/2014 15:20'!
adapterName

	^ #CheckBoxAdapter! !

!CheckboxButtonMorph commentStamp: 'gvc 5/23/2007 12:19'!
Checkbox/radio - button only.!
!CheckboxButtonMorph methodsFor: 'as yet unclassified' stamp: 'DamienCassou 4/27/2012 14:28'!
imageFromName: aSymbol
	^ self images
		at: aSymbol
		ifPresent: [:block | block value]
		ifAbsent: []! !

!CheckboxButtonMorph methodsFor: 'theme' stamp: 'gvc 12/8/2008 19:17'!
themeChanged
	"Update the on image."

	self onImage: (self isRadioButton
		ifTrue: [self theme radioButtonMarkerForm]
		ifFalse: [self theme checkboxMarkerForm]).
	self adoptPaneColor: self paneColor.
	super themeChanged! !

!CheckboxButtonMorph methodsFor: 'accessing' stamp: 'gvc 8/17/2006 16:04'!
enabled
	"Answer the value of enabled"

	^ enabled! !

!CheckboxButtonMorph methodsFor: 'accessing' stamp: 'gvc 5/23/2007 11:38'!
colorToUse
	"Answer the color we should use."

	^self paneColor! !

!CheckboxButtonMorph methodsFor: 'event handling' stamp: 'MarcusDenker 2/15/2013 13:28'!
mouseUp: evt
	"Allow on:send:to: to set the response to events other than actWhen"
	
	self enabled ifFalse: [^self perform: #mouseUp: withArguments: {evt} inSuperclass: Morph].
	actWhen == #buttonUp
		ifFalse: [^self perform: #mouseUp: withArguments: {evt} inSuperclass: Morph].
	(self containsPoint: evt cursorPoint)
		ifTrue: [state == #repressed
					ifTrue: [self state: #off]
					ifFalse: [self state: #on].
				self doButtonAction: evt].
	^self perform: #mouseUp: withArguments: {evt} inSuperclass: Morph! !

!CheckboxButtonMorph methodsFor: 'accessing' stamp: 'gvc 8/17/2006 15:18'!
repressedImage: anObject
	"Set the value of repressedImage. This is shown when
	pressed after being off."

	repressedImage := anObject.
	self invalidRect: self bounds! !

!CheckboxButtonMorph methodsFor: 'as yet unclassified' stamp: ''!
enabledString
	"Answer the string to be shown in a menu to represent the 'enabled' status"
	
	^ (self enabled) -> 'enabled' translated! !

!CheckboxButtonMorph methodsFor: 'menu & halo' stamp: ''!
addToggleItemsToHaloMenu: aCustomMenu 
	"Add toggle-items to the halo menu"
	
	super addToggleItemsToHaloMenu: aCustomMenu.
	aCustomMenu
		addUpdating: #enabledString
		target: self
		selector: #toggleEnabled! !

!CheckboxButtonMorph methodsFor: 'accessing' stamp: 'gvc 12/8/2008 19:17'!
adoptPaneColor: paneColor
	"Pass on to the border too."
	
	super adoptPaneColor: paneColor.
	paneColor ifNil: [^self].
	self fillStyle: self fillStyleToUse.
	self borderStyle: self borderStyleToUse.
	self cornerStyle: (self isRadioButton
		ifTrue: [self theme radioButtonCornerStyleFor: self]
		ifFalse: [self theme checkboxCornerStyleFor: self])! !

!CheckboxButtonMorph methodsFor: 'as yet unclassified' stamp: 'gvc 2/29/2008 22:04'!
checkboxFillStyleToUse
	"Answer the fillStyle that should be used for the receiver when it is a checkbox."
	
	^self selected
		ifTrue: [self enabled
			ifTrue: [self theme checkboxButtonSelectedFillStyleFor: self]
			ifFalse: [self theme checkboxButtonSelectedDisabledFillStyleFor: self]]
		ifFalse: [self enabled
			ifTrue: [self theme checkboxButtonNormalFillStyleFor: self]
			ifFalse: [self theme checkboxButtonDisabledFillStyleFor: self]]! !

!CheckboxButtonMorph methodsFor: 'as yet unclassified' stamp: 'gvc 2/29/2008 22:05'!
checkboxBorderStyleToUse
	"Answer the borderStyle that should be used for the receiver when it is a checkbox."
	
	^self selected
		ifTrue: [self enabled
			ifTrue: [self theme checkboxButtonSelectedBorderStyleFor: self]
			ifFalse: [self theme checkboxButtonSelectedDisabledBorderStyleFor: self]]
		ifFalse: [self enabled
			ifTrue: [self theme checkboxButtonNormalBorderStyleFor: self]
			ifFalse: [self theme checkboxButtonDisabledBorderStyleFor: self]]! !

!CheckboxButtonMorph methodsFor: 'initialization' stamp: 'gvc 10/25/2007 17:36'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		isRadioButton: false;
		enabled: true;
		onImage: self theme checkboxMarkerForm;
		fillStyle: self fillStyleToUse;
		borderStyle: self borderStyleToUse! !

!CheckboxButtonMorph methodsFor: 'accessing' stamp: 'gvc 11/5/2007 15:34'!
borderWidth: bw
	"Use narrowest image dimension."
	
	| newExtent |
	super borderWidth: bw.
	newExtent := 2 * bw + image extent min asPoint.
	bounds extent = newExtent ifFalse: [super extent: newExtent]! !

!CheckboxButtonMorph methodsFor: 'protocol' stamp: 'gvc 8/2/2007 14:16'!
enable
	"Enable the receiver."
	
	self enabled: true! !

!CheckboxButtonMorph methodsFor: 'as yet unclassified' stamp: ''!
toggleEnabled
	"Toggle the enabled state."

	self enabled: self enabled not! !

!CheckboxButtonMorph methodsFor: 'as yet unclassified' stamp: 'gvc 2/29/2008 21:58'!
radioFillStyleToUse
	"Answer the fillStyle that should be used for the receiver when it is a radio button."
	
	^self selected
		ifTrue: [self enabled
			ifTrue: [self theme radioButtonSelectedFillStyleFor: self]
			ifFalse: [self theme radioButtonSelectedDisabledFillStyleFor: self]]
		ifFalse: [self enabled
			ifTrue: [self theme radioButtonNormalFillStyleFor: self]
			ifFalse: [self theme radioButtonDisabledFillStyleFor: self]]! !

!CheckboxButtonMorph methodsFor: 'accessing' stamp: 'gvc 7/30/2009 14:11'!
enabled: anObject
	"Set the value of enabled"

	enabled = anObject ifTrue: [^self].
	enabled := anObject.
	self changed: #enabled.
	self
		adoptPaneColor: self paneColor;
		changed! !

!CheckboxButtonMorph methodsFor: 'event handling' stamp: 'GaryChambers 10/17/2011 16:29'!
mouseMove: evt
	"Check for straying."
	
	self perform: #mouseMove: withArguments: {evt} inSuperclass: Morph.
	self enabled ifFalse: [^self].
	(self containsPoint: evt cursorPoint)
		ifTrue: [state == #on
					ifTrue: [self state: #repressed].
				state == #off
					ifTrue: [self state: #pressed]]
		ifFalse: [state == #repressed
					ifTrue: [self state: #on].
				state == #pressed
					ifTrue: [self state: #off]]! !

!CheckboxButtonMorph methodsFor: 'accessing' stamp: 'gvc 8/27/2009 11:54'!
borderStyle: newStyle
	"Use narrowest image dimension."
	
	| newExtent |
	self borderStyle = newStyle ifTrue: [^self].
	super borderStyle: newStyle.
	newExtent := 2 * newStyle width + image extent min asPoint.
	bounds extent = newExtent ifFalse: [self extent: newExtent]! !

!CheckboxButtonMorph methodsFor: 'accessing' stamp: 'gvc 11/5/2007 15:28'!
image: anImage 
	"Fixed to take account of border width. Use narrowest
	dimanesion of image to allow a little flexibility."
	
	image := anImage depth = 1 
				ifTrue: [ColorForm mappingWhiteToTransparentFrom: anImage]
				ifFalse: [anImage]. 
	self extent: 2 * self borderWidth + image extent min asPoint.
	self changed! !

!CheckboxButtonMorph methodsFor: 'accessing' stamp: 'gvc 2/29/2008 21:53'!
state: newState
	"Change the image and invalidate the rect."

	newState == state ifTrue: [^ self].
	state := newState.
	self
		adoptPaneColor: self paneColor;
		changed! !

!CheckboxButtonMorph methodsFor: 'protocol' stamp: 'gvc 12/8/2008 19:16'!
beRadioButton
	"Change the images and round the border
	to be a radio button."

	self
		isRadioButton: true;
		onImage: self theme radioButtonMarkerForm;
		cornerStyle: (self theme radioButtonCornerStyleFor: self);
		borderStyle: self borderStyleToUse! !

!CheckboxButtonMorph methodsFor: 'accessing' stamp: 'gvc 8/17/2006 18:00'!
selected: aBoolean
	"Set the state taking account of the intermediate states."

	(self state == #pressed or: [self state == #repressed])
		ifTrue: [self state: (aBoolean ifTrue: [#repressed] ifFalse: [#pressed])]
		ifFalse: [self state: (aBoolean ifTrue: [#on] ifFalse: [#off])]! !

!CheckboxButtonMorph methodsFor: 'drawing' stamp: 'GaryChambers 11/16/2011 15:39'!
drawOn: aCanvas
	"Draw the image for the current state."
	
	|img|
	aCanvas fillRectangle: self bounds fillStyle: self fillStyle borderStyle: self borderStyle.
	img := self imageToUse.
	img ifNotNil: [
		aCanvas
			translucentImage: img
			at: self innerBounds center - (img extent // 2)].
	((self state == #pressed or: [self state == #repressed]) and: [image isNil]) ifTrue: [
		aCanvas fillRectangle: self innerBounds fillStyle: (self paneColor alpha: 0.3)].
	(self enabled not and: [self theme fadeCheckboxWhenDisabled]) ifTrue: [
		aCanvas fillRectangle: self innerBounds fillStyle: (self paneColor alpha: 0.4)]! !

!CheckboxButtonMorph methodsFor: 'as yet unclassified' stamp: 'DamienCassou 4/27/2012 14:21'!
imageToUse
	"Answer the image we should use."

	^ self imageFromName: state! !

!CheckboxButtonMorph methodsFor: 'protocol' stamp: 'gvc 8/2/2007 14:16'!
disable
	"Disable the receiver."
	
	self enabled: false! !

!CheckboxButtonMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/15/2015 12:17'!
drawOnAthensCanvas: anAthensCanvas
	"Draw the image for the current state."

	| img |
	anAthensCanvas setPaint: self fillStyle.
	anAthensCanvas drawShape: self bounds.
	anAthensCanvas setPaint: self borderStyle.
	anAthensCanvas drawShape: self bounds.
	img := self imageToUse.
	img
		ifNotNil: [ 
			anAthensCanvas setPaint: img.
			anAthensCanvas drawShape: (self innerBounds center - (img extent // 2) extent: img extent) ].
	((self state == #pressed or: [ self state == #repressed ]) and: [ image isNil ])
		ifTrue: [ 
			anAthensCanvas setPaint: (self paneColor alpha: 0.3).
			anAthensCanvas drawShape: self innerBounds ].
	(self enabled not and: [ self theme fadeCheckboxWhenDisabled ])
		ifTrue: [ 
			anAthensCanvas setPaint: (self paneColor alpha: 0.4).
			anAthensCanvas drawShape: self innerBounds ]! !

!CheckboxButtonMorph methodsFor: 'accessing' stamp: 'gvc 10/25/2007 17:34'!
isRadioButton: anObject
	"Set the value of isRadioButton"

	isRadioButton := anObject! !

!CheckboxButtonMorph methodsFor: 'protocol' stamp: 'gvc 12/8/2008 19:16'!
beCheckbox
	"Change the images and square the border
	to be a checkbox."

	self
		isRadioButton: false;
		onImage: self theme checkboxMarkerForm;
		cornerStyle: (self theme checkboxCornerStyleFor: self);
		borderStyle: self borderStyleToUse! !

!CheckboxButtonMorph methodsFor: 'accessing' stamp: 'gvc 10/25/2006 17:46'!
selected
	"Answer the state taking account of the intermediate states."

	^self state == #repressed or: [self state == #on]! !

!CheckboxButtonMorph methodsFor: 'accessing' stamp: 'gvc 8/17/2006 16:41'!
state
	"Answer the state."

	^state! !

!CheckboxButtonMorph methodsFor: 'accessing' stamp: 'gvc 10/25/2007 17:34'!
isRadioButton
	"Answer the value of isRadioButton"

	^ isRadioButton! !

!CheckboxButtonMorph methodsFor: 'as yet unclassified' stamp: 'gvc 2/29/2008 22:04'!
radioBorderStyleToUse
	"Answer the borderStyle that should be used for the receiver when it is a radio button."
	
	^self selected
		ifTrue: [self enabled
			ifTrue: [self theme radioButtonSelectedBorderStyleFor: self]
			ifFalse: [self theme radioButtonSelectedDisabledBorderStyleFor: self]]
		ifFalse: [self enabled
			ifTrue: [self theme radioButtonNormalBorderStyleFor: self]
			ifFalse: [self theme radioButtonDisabledBorderStyleFor: self]]! !

!CheckboxButtonMorph methodsFor: 'accessing' stamp: 'gvc 2/29/2008 21:56'!
fillStyleToUse
	"Answer the fillStyle that should be used for the receiver."
	
	^self isRadioButton
		ifTrue: [self radioFillStyleToUse]
		ifFalse: [self checkboxFillStyleToUse]! !

!CheckboxButtonMorph methodsFor: 'event handling' stamp: 'GaryChambers 10/17/2011 16:24'!
mouseDown: evt
	"Handle the transitions."
	
	self perform: #mouseDown: withArguments: {evt} inSuperclass: Morph.
	self enabled ifFalse: [^self].
	self isOn
		ifTrue: [self state: #repressed]
		ifFalse: [self state: #pressed].
	actWhen == #buttonDown
		ifTrue:
			[self doButtonAction].
	self mouseStillDown: evt.! !

!CheckboxButtonMorph methodsFor: 'accessing' stamp: 'GuillermoPolito 5/1/2012 12:29'!
images
	^ images ifNil: [images := Dictionary newFromPairs: {
								#off . [self offImage] .
								#pressed . [self pressedImage] . 
								#on . [self onImage] .
								#repressed . [self repressedImage ifNil: [self onImage]] }]! !

!CheckboxButtonMorph methodsFor: 'accessing' stamp: 'gvc 8/17/2006 15:17'!
repressedImage
	"Answer the value of repressedImage"

	^ repressedImage! !

!CheckboxButtonMorph methodsFor: 'accessing' stamp: 'gvc 2/29/2008 22:05'!
borderStyleToUse
	"Answer the borderStyle that should be used for the receiver."
	
	^self isRadioButton
		ifTrue: [self radioBorderStyleToUse]
		ifFalse: [self checkboxBorderStyleToUse]! !

!CheckboxButtonMorph class methodsFor: 'instance creation' stamp: 'gvc 5/22/2007 15:21'!
radioButton
	"Answer a button pre-initialized with radio button images."
	
	^self new
		beRadioButton! !

!CheckboxButtonMorph class methodsFor: 'instance creation' stamp: 'gvc 5/22/2007 15:21'!
checkBox
	"Answer a button pre-initialized with checkbox images."
	
	^self new
		beCheckbox! !

!CheckboxMorph commentStamp: 'gvc 5/18/2007 13:47'!
Checkbox with box button and label with enablement support.!
!CheckboxMorph methodsFor: 'updating' stamp: 'GaryChambers 12/2/2011 10:22'!
updateLabel
	"Update the label."

	self model ifNotNil: [
		self getLabelSelector ifNotNil: [
			self label: (self model perform: self getLabelSelector)]]! !

!CheckboxMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/18/2013 23:10'!
labelMorph: aMorph
	"Set the value of labelMorph"

	labelMorph ifNotNil: [labelMorph delete].
	labelMorph := aMorph.
	labelMorph color: (self theme checkboxButtonLabelNormalFillStyleFor: self label: labelMorph).
	self addMorphBack: aMorph.
	self enabled: self enabled.! !

!CheckboxMorph methodsFor: 'accessing' stamp: 'gvc 8/17/2006 14:49'!
enabled
	"Answer the value of enabled"

	^ enabled! !

!CheckboxMorph methodsFor: 'event handling' stamp: 'gvc 5/22/2007 16:11'!
keyStroke: event 
	"Process keys navigation and space to toggle."
	
	(self navigationKey: event) ifTrue: [^self].
	event keyCharacter = Character space
		ifTrue: [self toggleSelected]! !

!CheckboxMorph methodsFor: 'protocol' stamp: 'gvc 8/17/2006 15:14'!
isSelected
	"Answer whether the receiver is selected."

	self model ifNil: [^false].
	^self model perform: (self getStateSelector ifNil: [^false])! !

!CheckboxMorph methodsFor: 'accessing' stamp: 'gvc 8/17/2006 18:02'!
getStateSelector: anObject
	"Set the value of getStateSelector"

	getStateSelector := anObject.
	self updateSelection! !

!CheckboxMorph methodsFor: 'menu & halo' stamp: ''!
addToggleItemsToHaloMenu: aCustomMenu 
	"Add toggle-items to the halo menu"
	
	super addToggleItemsToHaloMenu: aCustomMenu.
	aCustomMenu
		addUpdating: #enabledString
		target: self
		selector: #toggleEnabled! !

!CheckboxMorph methodsFor: 'private' stamp: 'GaryChambers 10/17/2011 16:30'!
newButtonMorph
	"Answer a new button morph"

	^(CheckboxButtonMorph new
		target: self;
		actionSelector: #toggleSelected;
		vResizing: #shrinkWrap;
		hResizing: #shrinkWrap)
		on: #mouseDown send: #buttonMouseDown: to: self! !

!CheckboxMorph methodsFor: 'accessing' stamp: 'gvc 9/8/2006 14:58'!
font: aFont
	"Set the label font"

	self labelMorph font: aFont! !

!CheckboxMorph methodsFor: 'initialization' stamp: 'NicolaiHess 1/14/2014 08:56'!
initialize
	"Initialize the receiver."

	super initialize.
	
	labelClickable := true.
	
	self
		borderWidth: 2; "space for focus"
		borderColor: Color transparent;
		enabled: true;
		changeTableLayout;
		listDirection: #leftToRight;
		wrapCentering: #center;
		cellInset: 4;
		labelMorph: self newLabelMorph;
		buttonMorph: self newButtonMorph;
		on: #click send: #updateButton: to: self;
		on: #mouseMove send: #updateButton: to: self;
		on: #mouseUp send: #updateButton: to: self! !

!CheckboxMorph methodsFor: 'protocol' stamp: 'gvc 8/2/2007 11:38'!
enable
	"Enable the receiver."
	
	self enabled: true! !

!CheckboxMorph methodsFor: 'accessing' stamp: 'GaryChambers 12/2/2011 10:20'!
getLabelSelector

	^ getLabelSelector! !

!CheckboxMorph methodsFor: 'updating' stamp: 'GaryChambers 10/17/2011 16:37'!
updateButtonDown: evt
	"Check for keyboard focus."

	self wantsKeyboardFocusOnMouseDown ifTrue: [
		self takeKeyboardFocus].
	self updateButton: evt! !

!CheckboxMorph methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 2/21/2013 23:31'!
labelClicked

	labelClickable ifTrue: [ self toggleSelected ].
	
	self announcer announce: (LabelClicked source: self stateChanged: labelClickable).! !

!CheckboxMorph methodsFor: 'accessing' stamp: 'gvc 8/17/2006 15:00'!
setStateSelector: anObject
	"Set the value of setStateSelector"

	setStateSelector := anObject! !

!CheckboxMorph methodsFor: 'as yet unclassified' stamp: ''!
toggleEnabled
	"Toggle the enabled state."

	self enabled: self enabled not! !

!CheckboxMorph methodsFor: 'accessing' stamp: 'GaryChambers 12/2/2011 10:24'!
label: aStringOrMorph
	"Set the label morph or label morph contents."

	self labelMorph: (aStringOrMorph isMorph
		ifTrue: [aStringOrMorph]
		ifFalse: [self labelMorph contents: aStringOrMorph.
				self newLabel])! !

!CheckboxMorph methodsFor: 'protocol' stamp: 'gvc 5/22/2007 15:38'!
beRadioButton
	"Change the button to be a radio button."
	
	self buttonMorph beRadioButton! !

!CheckboxMorph methodsFor: 'event handling' stamp: 'gvc 1/16/2007 15:20'!
handlesKeyboard: evt
	"Yes, we do it here."
	
	^true! !

!CheckboxMorph methodsFor: '*Keymapping-Core' stamp: 'ThierryGoubier 9/15/2012 22:06'!
initializeShortcuts: aKMDispatcher
	super initializeShortcuts: aKMDispatcher.
	aKMDispatcher attachCategory: #MorphFocusNavigation! !

!CheckboxMorph methodsFor: 'focus handling' stamp: 'GaryChambers 10/17/2011 16:05'!
wantsKeyboardFocusOnMouseDown
	"Answer whether the receiver would like keyboard focus
	on a mouse down event. use a property here for apps that want to take keyboard
	focus when the button is pressed (so that other morphs can, e.g. accept on focus change)."

	^self wantsKeyboardFocus and: [self valueOfProperty: #wantsKeyboardFocusOnMouseDown ifAbsent: [false]]! !

!CheckboxMorph methodsFor: 'focus handling' stamp: 'gvc 1/11/2007 12:28'!
takesKeyboardFocus
	"Answer whether the receiver can normally take keyboard focus."

	^true! !

!CheckboxMorph methodsFor: 'protocol' stamp: 'gvc 8/2/2007 11:38'!
disable
	"Disable the receiver."
	
	self enabled: false! !

!CheckboxMorph methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 2/21/2013 23:31'!
labelClickable: aBoolean

	labelClickable := aBoolean.! !

!CheckboxMorph methodsFor: 'updating' stamp: 'gvc 9/8/2009 13:25'!
updateEnabled
	"Update the enablement state."

	self model ifNotNil: [
		self getEnabledSelector ifNotNil: [
			self enabled: (self model perform: self getEnabledSelector)]]! !

!CheckboxMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/20/2012 12:29'!
getLabelSelector: anObject

	getLabelSelector := anObject.
	self updateLabel.! !

!CheckboxMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/20/2012 12:36'!
buttonMorph: aMorph
	"Set the value of buttonMorph"

	buttonMorph ifNotNil: [
		self removeDependent: buttonMorph.
		buttonMorph delete].
	buttonMorph := aMorph.
	self
		addDependent: aMorph;
		addMorphFront: aMorph! !

!CheckboxMorph methodsFor: 'event handling' stamp: 'StephaneDucasse 5/23/2013 18:25'!
keyboardFocusChange: aBoolean
	"The message is sent to a morph when its keyboard focus changes.
	Update for focus feedback."
	
	super keyboardFocusChange: aBoolean.
	self focusChanged! !

!CheckboxMorph methodsFor: 'initialization' stamp: 'gvc 8/17/2006 18:01'!
on: anObject selected: getSelectionSel changeSelected: setSelectionSel
	"Set the receiver to the given model parameterized by the given message selectors."

	self
		model: anObject;
		getStateSelector: getSelectionSel;
		setStateSelector: setSelectionSel;
		updateSelection! !

!CheckboxMorph methodsFor: 'accessing' stamp: 'gvc 9/8/2006 14:58'!
font
	"Answer the label font"

	^self labelMorph font! !

!CheckboxMorph methodsFor: 'event handling' stamp: 'GaryChambers 10/17/2011 16:31'!
buttonMouseDown: evt
	"Sent from the checkbox button to handle focus."

	self wantsKeyboardFocusOnMouseDown ifTrue: [
		self takeKeyboardFocus]! !

!CheckboxMorph methodsFor: 'accessing' stamp: 'gvc 8/17/2006 14:49'!
buttonMorph
	"Answer the value of buttonMorph"

	^ buttonMorph! !

!CheckboxMorph methodsFor: 'accessing' stamp: 'gvc 8/17/2006 14:49'!
getStateSelector
	"Answer the value of getStateSelector"

	^ getStateSelector! !

!CheckboxMorph methodsFor: 'accessing' stamp: 'gvc 8/17/2006 18:01'!
getEnabledSelector: anObject
	"Set the value of getEnabledSelector"

	getEnabledSelector := anObject.
	self updateEnabled! !

!CheckboxMorph methodsFor: 'accessing' stamp: 'gvc 8/17/2006 15:00'!
setStateSelector
	"Answer the value of setStateSelector"

	^ setStateSelector! !

!CheckboxMorph methodsFor: 'drawing' stamp: 'gvc 5/22/2007 16:04'!
drawSubmorphsOn: aCanvas 
	"Display submorphs back to front.
	Draw the focus here since we are using inset bounds
	for the focus rectangle."

	super drawSubmorphsOn: aCanvas.
	self hasKeyboardFocus ifTrue: [self drawKeyboardFocusOn: aCanvas]! !

!CheckboxMorph methodsFor: 'updating' stamp: 'GaryChambers 10/17/2011 16:36'!
updateButton: evt
	"Update the button due to mouse activity in the receiver."

	self enabled ifFalse: [^self].
	evt isMouseDown ifTrue: [
		self buttonMorph state == #on ifTrue: [^self buttonMorph state: #repressed].
		self buttonMorph state == #off ifTrue: [^self buttonMorph state: #pressed]].
	evt isMouseUp ifTrue: [
		self buttonMorph state == #repressed ifTrue: [
			^self buttonMorph state: #off; doButtonAction].
		self buttonMorph state == #pressed ifTrue: [
			^self buttonMorph state: #on; doButtonAction]].
	evt isMove ifTrue: [
		(self containsPoint: evt cursorPoint)
			ifTrue: [self buttonMorph state == #on ifTrue: [^self buttonMorph state: #repressed].
					self buttonMorph state == #off ifTrue: [^self buttonMorph state: #pressed]]
			ifFalse: [self buttonMorph state == #repressed ifTrue: [^self buttonMorph state: #on].
					self buttonMorph state == #pressed ifTrue: [^self buttonMorph state: #off]]]! !

!CheckboxMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/7/2015 21:25'!
drawSubmorphsOnAthensCanvas: anAthensCanvas
	super 	drawSubmorphsOnAthensCanvas: anAthensCanvas.
	self hasKeyboardFocus ifTrue: [self drawKeyboardFocusOnAthensCanvas: anAthensCanvas].! !

!CheckboxMorph methodsFor: 'as yet unclassified' stamp: ''!
enabledString
	"Answer the string to be shown in a menu to represent the 'enabled' status"
	
	^ (self enabled) -> 'enabled' translated! !

!CheckboxMorph methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 2/21/2013 23:25'!
listRenderOn: aCanvas atRow: aRow bounds: drawBounds color: drawColor backgroundColor: backgroundColor from: aMorph

	self color: backgroundColor.
	self bounds: drawBounds.
	self fullDrawOn: aCanvas.
	aMorph addMorph: self! !

!CheckboxMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 2/4/2013 16:32'!
newLabelMorph
	"Answer a new label morph"
	^	(LabelMorph contents: self label)
			on: #mouseDown send: #toggleSelected to: self; yourself! !

!CheckboxMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 5/31/2013 17:47'!
enabled: aBoolean
	"Set the value of enabled"

	enabled := aBoolean.
	self labelMorph ifNotNil: [:m | m enabled: aBoolean].
	self buttonMorph ifNotNil: [:m | m enabled: aBoolean].
	self changed: #enabled! !

!CheckboxMorph methodsFor: 'private' stamp: 'gvc 8/2/2007 16:13'!
newLabel
	"Answer a new label morph"

	^self theme checkboxLabelFor: self! !

!CheckboxMorph methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 7/18/2013 14:16'!
update: aParameter 
	"Refer to the comment in View|update:."

	aParameter == self getStateSelector ifTrue: 
		[self updateSelection.
		^ self].
	aParameter == self getEnabledSelector ifTrue:
		[self updateEnabled.
		^ self].
	aParameter == self getLabelSelector ifTrue:
		[self updateLabel.
		^ self].
	
	aParameter isArray ifFalse: [ ^ self ].
	aParameter size == 2 ifFalse: [ ^ self ].
	
	aParameter first = #labelClickable: ifTrue: [ self labelClickable: aParameter second ].
	aParameter first = #label: ifTrue: [ self label: aParameter second ]! !

!CheckboxMorph methodsFor: 'accessing' stamp: 'gvc 8/17/2006 15:05'!
getEnabledSelector
	"Answer the value of getEnabledSelector"

	^ getEnabledSelector! !

!CheckboxMorph methodsFor: 'updating' stamp: 'MarcusDenker 12/11/2009 07:38'!
updateSelection
	"Update the selection state."

	self buttonMorph ifNotNil: [:m | m selected: self isSelected].
	self changed: #isSelected! !

!CheckboxMorph methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 2/4/2013 16:33'!
toggleSelected
	"Toggle the selection state."

	self takeKeyboardFocus.
	self enabled ifFalse: [^self].
	self model ifNil: [^self].

	(self setStateSelector ifNil: [^self]) numArgs = 0
		ifTrue: [self model perform: self setStateSelector].
	self setStateSelector numArgs = 1
		ifTrue: [	self model perform: self setStateSelector with: self isSelected not].
	self updateSelection.! !

!CheckboxMorph methodsFor: 'accessing' stamp: 'gvc 8/17/2006 14:49'!
labelMorph
	"Answer the value of labelMorph"

	^ labelMorph! !

!CheckboxMorph methodsFor: 'protocol' stamp: 'gvc 5/22/2007 15:38'!
beCheckbox
	"Change the button to be a checkbox."
	
	self buttonMorph beCheckbox! !

!CheckboxMorph methodsFor: 'accessing' stamp: 'gvc 8/2/2007 16:14'!
label
	"Answer the contents of the label morph."

	^(self labelMorph ifNil: [^'']) contents! !

!CheckboxMorph class methodsFor: 'as yet unclassified' stamp: 'gvc 8/17/2006 16:50'!
on: anObject selected: getSelectionSel changeSelected: setSelectionSel
	"Answer a new instance of the receiver on the given model using
	the given selectors as the interface."

	^self new
		on: anObject 
		selected: getSelectionSel
		changeSelected: setSelectionSel! !

!Checksum commentStamp: '<historical>'!
I represent the abstact superclass of all checksum algorithms.!
!ChooseDropListDialogWindow commentStamp: 'gvc 5/18/2007 13:46'!
Message dialog containing a drop list for selection of an item.!
!ChooseDropListDialogWindow methodsFor: 'accessing' stamp: 'gvc 1/12/2007 14:17'!
listMorph
	"Answer the value of listMorph"

	^ listMorph! !

!ChooseDropListDialogWindow methodsFor: 'initialization' stamp: 'gvc 1/12/2007 14:35'!
initialize
	"Initialize the receiver."

	self list: #().
	super initialize! !

!ChooseDropListDialogWindow methodsFor: 'accessing' stamp: 'gvc 1/12/2007 15:21'!
list: anObject
	"Set the value of list"

	list := anObject.
	self
		changed: #list;
		changed: #selectionIndex! !

!ChooseDropListDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 8/29/2007 13:32'!
newContentMorph
	"Answer a new content morph."

	self iconMorph: self newIconMorph.
	self textMorph: self newTextMorph.
	self listMorph: self newListMorph.
	^self newGroupboxForAll: {
		self newRow: {self iconMorph. self textMorph}.
		self listMorph}! !

!ChooseDropListDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 1/12/2007 14:15'!
selectionIndex
	"Answer the initial selection index for the list."

	^self list ifEmpty: [0] ifNotEmpty: [1]! !

!ChooseDropListDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 1/12/2007 14:17'!
newListMorph
	"Answer a new drop-list morph."

	^self
		newDropListFor: self
		list: #list
		getSelected: #selectionIndex
		setSelected: nil
		getEnabled: nil
		help: nil! !

!ChooseDropListDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 1/12/2007 14:22'!
selectedItem
	"Answer the selected list item or nil if cancelled."

	^self cancelled ifFalse: [self listMorph selectedItem]! !

!ChooseDropListDialogWindow methodsFor: 'accessing' stamp: 'gvc 1/12/2007 14:15'!
list
	"Answer the value of list"

	^ list! !

!ChooseDropListDialogWindow methodsFor: 'accessing' stamp: 'gvc 1/12/2007 14:17'!
listMorph: anObject
	"Set the value of listMorph"

	listMorph := anObject! !

!ChooseDropListDialogWindow methodsFor: 'as yet unclassified' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
icon
	"Answer an icon for the receiver."
	
	^ Smalltalk ui icons questionIcon! !

!ChooseDropListDialogWindow class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
taskbarIcon
	"Answer the icon for the receiver in a task bar."

	^ Smalltalk ui icons smallQuestionIcon! !

!ChoseDate commentStamp: '<historical>'!
A ChoseDate is an announcement raised by the CalendarMorph!
!ChoseDate methodsFor: 'private' stamp: 'SeanDeNigris 1/20/2013 21:16'!
calendar: aCalendarChooserMorph 

	calendar := aCalendarChooserMorph.! !

!ChoseDate methodsFor: 'private' stamp: 'SeanDeNigris 1/20/2013 21:14'!
date: aDate 

	date := aDate.! !

!ChoseDate methodsFor: 'accessing' stamp: 'SeanDeNigris 1/20/2013 21:17'!
date

	^ date.! !

!ChoseDate methodsFor: 'accessing' stamp: 'SeanDeNigris 1/20/2013 21:17'!
calendar

	^ calendar.! !

!ChoseDate class methodsFor: 'instance creation' stamp: 'SeanDeNigris 1/20/2013 21:15'!
of: aDate from: aCalendarChooserMorph

	^ self new
		date: aDate;
		calendar: aCalendarChooserMorph.! !

!ChronologyConstants commentStamp: 'brp 3/12/2004 14:34'!
ChronologyConstants is a SharedPool for the constants used by the Kernel-Chronology classes.!
!ChronologyConstants class methodsFor: 'class initialization' stamp: 'SvenVanCaekenberghe 5/3/2013 15:49'!
initialize
	"ChronologyConstants initialize"
	SqueakEpoch := 2415386. 		"Julian day number of 1 Jan 1901" 
	SecondsInDay := 86400.
	MicrosecondsInDay := SecondsInDay * 1e6.
	SecondsInHour := 3600.
	SecondsInMinute := 60.
	NanosInSecond := 10 raisedTo: 9.
	NanosInMillisecond := 10 raisedTo: 6.
	DayNames := #(Sunday Monday Tuesday Wednesday Thursday Friday Saturday).
		
	MonthNames := #(January February March April May June July
 			August September October November December).
	DaysInMonth := #(31 28 31 30 31 30 31 31 30 31 30 31).
! !

!ChunkFileFormatParser commentStamp: '<historical>'!
I represent the chunk file format.  Right now I know how to parse chunks from a readStream, but not how to write them.!
!ChunkFileFormatParser methodsFor: 'parsing' stamp: 'MarcusDenker 10/5/2013 18:22'!
parseMethodDeclarations: methodsPreamble
	| behaviorName isMeta category stamp methodSource |
	"The method preable is an array with the following structure:
	If instance side method:
	
	#(#CodeImportTestCaseTestClass #methodsFor: 'some protocol' #stamp: 'GuillermoPolito 5/2/2012 13:35')
	
	if class side:
	
	#(#CodeImportTestCaseTestClass #class #methodsFor: 'some protocol' #stamp: 'GuillermoPolito 5/2/2012 13:35')
	
	Sometimes there is no timestamp:
	
	#(#CodeImportTestCaseTestClass #methodsFor: 'some protocol')
	
	"
	behaviorName := methodsPreamble first.
	isMeta := methodsPreamble second ~= #methodsFor:.
	category := isMeta
		ifTrue: [ methodsPreamble at: 4 ]
		ifFalse: [ methodsPreamble at: 3 ].
	stamp := ''.
	methodsPreamble size > 4
		ifTrue: [ 
			stamp := isMeta
				ifTrue: [ methodsPreamble at: 6 ]
				ifFalse: [ methodsPreamble at: 5 ] ].
	[ 
	methodSource := self nextChunk.
	methodSource notEmpty ]
		whileTrue: [ 
			self
				addDeclaration:
					(MethodDeclaration
						contents: methodSource
						behaviorName: behaviorName asSymbol
						isMeta: isMeta
						category: category
						stamp: stamp) ]! !

!ChunkFileFormatParser methodsFor: 'parsing' stamp: 'MarcusDenker 10/5/2013 18:22'!
parseCommentDeclaration: commentPreamble
	"The comment preable is an array with the following structure:
	If instance side method:
	#(#CodeImportTestCaseTestClass #commentStamp: '<historical>' #prior: 0)
	
	if class side:
	
	#(#CodeImportTestCaseTestClass #class #commentStamp: '<historical>' #prior: 0)
	allButFirst:
	"

	| behaviorName isMeta stamp |
	behaviorName := commentPreamble first asSymbol.
	isMeta := commentPreamble second ~= #commentStamp:.
	stamp := isMeta
		ifTrue: [ commentPreamble at: 4 ]
		ifFalse: [ commentPreamble at: 3 ].
	self
		addDeclaration:
			(ClassCommentDeclaration
				contents: self nextChunk
				behaviorName: behaviorName
				isMeta: isMeta
				stamp: stamp)! !

!ChunkFileFormatParser methodsFor: 'testing' stamp: 'GuillermoPolito 5/5/2012 22:05'!
next
	"If the char we read previously is a terminator mark, it is scaping the next one, so we skip it"
	nextChar = self terminatorMark 
		ifTrue: [ readStream next ].
	^nextChar! !

!ChunkFileFormatParser methodsFor: 'testing' stamp: 'GuillermoPolito 5/5/2012 17:09'!
isNextStyleChunk
	"Style chunks are between $] and $["
	^readStream peek == $]! !

!ChunkFileFormatParser methodsFor: 'testing' stamp: 'MarcusDenker 10/5/2013 18:22'!
nextChunk
	| out |
	out := (String new: 1000) writeStream.
	readStream skipSeparators.
	[ self isChunkEnd ] whileFalse: [
		out nextPut: self next.
	].
	^out contents! !

!ChunkFileFormatParser methodsFor: 'parsing' stamp: 'MarcusDenker 10/5/2013 18:22'!
parseClassOrganization: classOrganizationPreamble
	"The comment preable is an array with the following structure:
	If instance side method:
	#(#CodeImportTestCaseTestClass #reorganize)
	
	if class side:
	
	#(#CodeImportTestCaseTestClass #class #reorganize)
	"

	| behaviorName isMeta |
	behaviorName := classOrganizationPreamble first.
	isMeta := classOrganizationPreamble second ~= #reorganize.
	self addDeclaration: (ClassOrganizationDeclaration contents: self nextChunk behaviorName: behaviorName isMeta: isMeta)! !

!ChunkFileFormatParser methodsFor: 'initialization' stamp: 'GuillermoPolito 5/5/2012 22:06'!
initialize
	parsedDeclarations := OrderedCollection new.! !

!ChunkFileFormatParser methodsFor: 'testing' stamp: 'GuillermoPolito 5/5/2012 17:09'!
isNextChunkMetaData
	"If the next chunk starts with $!!, it will be an expression that after evaluation returns an object who knows how to read some metadata. 
	I.e. A chunk for comment reading should be something like:
	
	!!SomeClass commentStamp: '<historical>' prior: 0!!
	
	The object returned by the expression of that tag must understand #scanFrom:
	"
	
	^readStream peekFor: $!!! !

!ChunkFileFormatParser methodsFor: 'parsing' stamp: 'GuillermoPolito 5/5/2012 17:08'!
readUpToEndOfStyleChunk
	"Style chunks are between $] and $["
	^readStream upTo: $[! !

!ChunkFileFormatParser methodsFor: 'parsing' stamp: 'GuillermoPolito 5/5/2012 21:32'!
terminatorMark
	^$!!! !

!ChunkFileFormatParser methodsFor: 'accessing' stamp: 'GuillermoPolito 5/5/2012 17:19'!
addDeclaration: aDeclaration
	parsedDeclarations	 add: aDeclaration ! !

!ChunkFileFormatParser methodsFor: 'testing' stamp: 'MarcusDenker 10/5/2013 18:23'!
isChunkEnd
	nextChar := readStream next.
	^ nextChar isNil or: [ nextChar = self terminatorMark and: [ readStream peek ~= self terminatorMark ] ]! !

!ChunkFileFormatParser methodsFor: 'accessing' stamp: 'GuillermoPolito 5/5/2012 17:07'!
readStream: aReadStream
	readStream := aReadStream! !

!ChunkFileFormatParser methodsFor: 'parsing' stamp: 'GuillermoPolito 5/5/2012 17:17'!
parseDeclarations
	[ readStream atEnd ] whileFalse: [
		self parseNextDeclaration.
	].
	^parsedDeclarations! !

!ChunkFileFormatParser methodsFor: 'parsing' stamp: 'MarcusDenker 5/18/2013 15:44'!
parseNextDeclaration
	| isMetadata nextChunk |
	readStream skipSeparators.
	
	(self isNextStyleChunk) ifTrue: [
		self addDeclaration: (StyleDeclaration contents: (self readUpToEndOfStyleChunk)).
		^self
	].

	isMetadata := self isNextChunkMetaData.
	nextChunk := self nextChunk.
	
	isMetadata
		ifFalse: [ 
			self addDeclaration: (DoItDeclaration contents: nextChunk).
		] ifTrue: [
			| substrings |
			substrings := nextChunk parseLiterals.
			
			(substrings includes: 'methodsFor:')
				ifTrue: [ ^self parseMethodDeclarations: substrings ].
			(substrings includes: 'commentStamp:')
				ifTrue: [ ^self parseCommentDeclaration: substrings ].
			(substrings includes: 'reorganize')
				ifTrue: [ ^self parseClassOrganization: substrings ].
		]! !

!ChunkFileFormatParser class methodsFor: 'instance creation' stamp: 'GuillermoPolito 5/5/2012 17:06'!
for: aReadStream
	^self new
		readStream: aReadStream;
		yourself! !

!ChunkImportTestCase methodsFor: 'auxiliar' stamp: 'GuillermoPolito 5/5/2012 17:26'!
importAClass
	^CodeImporter evaluateString: 'Object subclass: #CodeImportTestCaseTestClass
			instanceVariableNames: ''var1 var2 var3''
			classVariableNames: ''''
			poolDictionaries: ''''
			category: ''CodeImporter-Tests-Garbage''!!'.! !

!ChunkImportTestCase methodsFor: 'importing-code' stamp: 'EstebanLorenzano 8/3/2012 15:13'!
testImportAClassCommentWithExclamationMarks
	| class comment commentToWrite |
	comment := 'I''m a nice comment!!, treat me well :).'.
	commentToWrite := 'I''m a nice comment!!!!, treat me well :).' replaceAll: '!!' with: '!!!!'.
	SystemAnnouncer uniqueInstance suspendAllWhile: [[
		class := self importAClass.
		CodeImporter evaluateString: ('!!{1} commentStamp: ''<historical>'' prior: 0!!{2}!!' format: { class name asString . commentToWrite }).
		self assert: comment equals: class comment.
	] ensure: [ class ifNotNil: [ class removeFromSystem ] ] ]! !

!ChunkImportTestCase methodsFor: 'importing-code' stamp: 'CamilloBruni 10/15/2013 01:17'!
testImportAClassCategory
	| class classOrganizationString chunk |
	classOrganizationString := '(#testing testImportAMethod testImportAClass)
(#auxiliar importAClass)'.
	chunk := '!!{1} reorganize!!'.
	SystemAnnouncer uniqueInstance suspendAllWhile: [ [
		class := self importAClass.
		
		"we write the methods we will categorize"
		class compileSilently: 'testImportAClass'.
		class compileSilently: 'testImportAMethod'.
		class compileSilently: 'importAClass'.
		
		CodeImporter evaluateString: (chunk format: { class name asString }), classOrganizationString.
		"we do not care about the order of the output just that all the elements are present"
		self 
			assertCollection: (classOrganizationString trimBoth findTokens: String cr, ' ') sorted
			equals: (class organization stringForFileOut findTokens: String cr, ' ') sorted.
	] ensure: [ class ifNotNil: [ class removeFromSystem ] ] ]! !

!ChunkImportTestCase methodsFor: 'importing-code' stamp: 'EstebanLorenzano 8/3/2012 15:11'!
testImportAClass
	| class |
	SystemAnnouncer uniqueInstance suspendAllWhile: [ [
		class := self importAClass.
		self assert: #CodeImportTestCaseTestClass equals: class name.
		self assert: (class instVarNames includes: 'var1').
		self assert: (class instVarNames includes: 'var2').
		self assert: (class instVarNames includes: 'var3').
		self assert: class category equals: 'CodeImporter-Tests-Garbage'.
		
	] ensure: [ class ifNotNil: [ class removeFromSystem ] ] ]! !

!ChunkImportTestCase methodsFor: 'importing-methods' stamp: 'GuillermoPolito 5/5/2012 17:26'!
testImportFromReadStream
	self assert: 4 equals: (CodeImporter evaluateReadStream: '2+2!!' readStream)! !

!ChunkImportTestCase methodsFor: 'importing-code' stamp: 'VincentBlondeau 3/6/2015 17:45'!
testImportAMethodWithSpacesInItsCategory
	| class |
	SystemAnnouncer uniqueInstance
		suspendAllWhile: [ 
			[ 
			class := self importAClass.
			CodeImporter
				evaluateString:
					('!!{1} methodsFor: ''some protocol'' stamp: ''GuillermoPolito 5/2/2012 13:35''!!someMethod
	^true' format: {(class name asString)}).
			self assert: (class >> #someMethod) category equals: 'some protocol' ]
				ensure: [ class ifNotNil: [ class removeFromSystem ] ] ]! !

!ChunkImportTestCase methodsFor: 'importing-code' stamp: 'VincentBlondeau 3/6/2015 17:45'!
testImportAMethod
	| class |
	SystemAnnouncer uniqueInstance
		suspendAllWhile: [ 
			[ 
			class := self importAClass.
			CodeImporter
				evaluateString:
					('!!{1} methodsFor: ''some protocol'' stamp: ''GuillermoPolito 5/2/2012 13:35''!!someMethod
	^true' format: {(class name asString)}).
			self assert: class new someMethod ]
				ensure: [ class ifNotNil: [ class removeFromSystem ] ] ]! !

!ChunkImportTestCase methodsFor: 'importing-code' stamp: 'VincentBlondeau 3/6/2015 17:45'!
testImportAMethodWithNoTimestamp
	| class |
	SystemAnnouncer uniqueInstance
		suspendAllWhile: [ 
			[ 
			class := self importAClass.
			CodeImporter
				evaluateString:
					('!!{1} methodsFor: ''some protocol''!!someMethod
	^true' format: {(class name asString)}).
			self assert: class new someMethod ]
				ensure: [ class ifNotNil: [ class removeFromSystem ] ] ]! !

!ChunkImportTestCase methodsFor: 'importing-code' stamp: 'EstebanLorenzano 8/3/2012 15:11'!
testImportAClassComment
	| class comment |
	comment := 'I''m a nice comment, treat me well :).'.
	SystemAnnouncer uniqueInstance suspendAllWhile: [[
		class := self importAClass.
		CodeImporter evaluateString: ('!!{1} commentStamp: ''<historical>'' prior: 0!!{2}!!' format: { class name asString . comment }).
		self assert: comment equals: class comment.
	] ensure: [ class ifNotNil: [ class removeFromSystem ] ] ]! !

!ChunkImportTestCase methodsFor: 'importing-methods' stamp: 'GuillermoPolito 5/5/2012 17:26'!
testImportString
	self assert: 4 equals: (CodeImporter evaluateString: '2+2!!')! !

!CircleMorph commentStamp: '<historical>'!
I am a specialization of EllipseMorph that knows enough to remain circular.
!
!CircleMorph methodsFor: 'geometry' stamp: 'AlainPlantec 5/7/2010 22:07'!
extent: aPoint
	| size oldRotationCenter |
	oldRotationCenter := self rotationCenter.
	size := aPoint x min: aPoint y.
	super extent: size @ size.
	self rotationCenter: oldRotationCenter.! !

!CircleMorph methodsFor: 'geometry' stamp: 'nk 7/1/2002 08:49'!
transformedBy: aTransform
	aTransform isIdentity ifTrue:[^self].
	^self center: (aTransform localPointToGlobal: self center).
! !

!CircleMorph methodsFor: 'menus' stamp: 'AlainPlantec 5/7/2010 23:34'!
setRotationCenterFrom: aPoint
	"Called by halo rotation code.
	Circles store their referencePosition."
	self setProperty: #referencePosition toValue: aPoint.
	self setProperty: #originalCenter toValue: self center.
	self setProperty: #originalAngle toValue: self heading.! !

!CircleMorph methodsFor: 'rotate scale and flex' stamp: 'AlainPlantec 5/7/2010 21:25'!
prepareForScaling
	"When scaling from a halo, I can do this without a flex shell"

	^ self
! !

!CircleMorph methodsFor: 'geometry etoy' stamp: 'nk 7/1/2002 13:48'!
rotationCenter: aPointOrNil
	"Set the new rotation center of the receiver. The rotation center defines the relative offset inside the receiver's bounds for locating the reference position."
	| newRef box |
	aPointOrNil isNil
		ifTrue: [self removeProperty: #referencePosition.
			self removeProperty: #originalCenter.
			self removeProperty: #originalAngle. ]
		ifFalse: [ box := self bounds.
				newRef := box origin + (aPointOrNil * box extent).
				self setRotationCenterFrom: newRef ].

! !

!CircleMorph methodsFor: 'geometry' stamp: 'nk 7/1/2002 07:01'!
bounds: aRectangle
	| size |
	size := aRectangle width min: aRectangle height.
	super bounds: (Rectangle origin: aRectangle origin extent: size @ size).! !

!CircleMorph methodsFor: 'rotate scale and flex' stamp: 'nk 7/1/2002 16:29'!
privateMoveBy: delta
	self setProperty: #referencePosition toValue: self referencePosition + delta.
	self setProperty: #originalCenter toValue: (self valueOfProperty: #originalCenter ifAbsent: [ self center ]) + delta.
	super privateMoveBy: delta.
! !

!CircleMorph methodsFor: 'initialization' stamp: 'MarcusDenker 9/13/2013 15:50'!
initialize
	super initialize.
	self extent: 40@40;
		color: Color green lighter! !

!CircleMorph methodsFor: 'geometry etoy' stamp: 'nk 7/1/2002 07:31'!
referencePosition 
	"Return the current reference position of the receiver"
	^ self valueOfProperty: #referencePosition ifAbsent: [ self center ]
! !

!CircleMorph methodsFor: 'rotate scale and flex' stamp: 'AlainPlantec 5/7/2010 21:26'!
prepareForRotating
	"When rotating from a halo, I can do this without a flex shell"

	^ self
! !

!CircleMorph methodsFor: 'rotate scale and flex' stamp: 'AlainPlantec 5/8/2010 00:03'!
rotationDegrees: degrees
	| ref newPos flex origAngle origCenter |
	ref := self referencePosition.
	origAngle := self valueOfProperty: #originalAngle ifAbsentPut: [ self heading ].
	origCenter := self valueOfProperty: #originalCenter ifAbsentPut: [ self center ].
	flex := (MorphicTransform offset: ref negated)
			withAngle: (degrees - origAngle) degreesToRadians.
	newPos := (flex transform: origCenter) - flex offset.
	self position: (self position + newPos - self center) asIntegerPoint.
	self setProperty: #referencePosition toValue: ref.
	self setProperty: #originalAngle toValue: origAngle.
	self setProperty: #originalCenter toValue: origCenter.
	self forwardDirection: degrees.
	self changed.
! !

!CircleMorph methodsFor: 'geometry etoy' stamp: 'nk 7/1/2002 11:16'!
rotationCenter
	"Return the rotation center of the receiver. The rotation center defines the relative offset inside the receiver's bounds for locating the reference position."
	| refPos |
	refPos := self referencePosition.
	^ (refPos - self bounds origin) / self bounds extent asFloatPoint! !

!CircleMorph methodsFor: 'rotate scale and flex' stamp: 'AlainPlantec 5/7/2010 23:54'!
rotationDegrees

	^ self forwardDirection! !

!CircleMorphTest commentStamp: 'tlk 5/21/2006 14:16'!
A CircleMorphTest is a subclass of MorphTest.  It was first implemented when removing some unused and broken functionality.

My fixtures are morph, a CircleMorph and world.
!
!CircleMorphTest methodsFor: 'running' stamp: 'tlk 5/21/2006 14:17'!
setUp
	morph := CircleMorph new! !

!CircularHierarchyError commentStamp: '<historical>'!
I am signaled if a new class introduces a circular class hierarchy.!
!CircularHierarchyError class methodsFor: 'signalling' stamp: 'MartinDias 7/25/2013 14:12'!
signalFor: aClass
	self signal: aClass name asString, ': Trying to build a circular hierarchy'! !

!Class commentStamp: '<historical>'!
I add a number of facilities to those in ClassDescription:
	A set of all my subclasses (defined in ClassDescription, but only used here and below)
	A name by which I can be found in a SystemDictionary
	A classPool for class variables shared between this class and its metaclass
	A list of sharedPools which probably should be supplanted by some better mechanism.

My instances describe the representation and behavior of objects. I add more comprehensive programming support facilities to the basic attributes of Behavior and the descriptive facilities of ClassDescription.

The slot 'subclasses' is a redundant structure.  It is never used during execution, but is used by the development system to simplify or speed certain operations.  !
!Class methodsFor: '*Deprecated40' stamp: ''!
ensureClassPool
	self deprecated: 'just use the accessor for classPool' on: '2 July 2014' in: 'Pharo40'.
	^self classPool.! !

!Class methodsFor: 'testing' stamp: ''!
isObsolete
	"Return true if the receiver is obsolete."
	^self propertyValueAt: #obsolete ifAbsent: false! !

!Class methodsFor: '*Deprecated40' stamp: ''!
classPoolFrom: aClass
	"share the classPool with aClass."
	self deprecated: 'just use the accessor for classPool' on: '2 July 2014' in: 'Pharo40'.
	self classPool: aClass classPool.! !

!Class methodsFor: 'class variables' stamp: ''!
classVariableDefinitionString
	"Answer a string that evaluates to the definition of the class Variables"
	
	^String streamContents: [ :str | | special |
		str nextPutAll: '{ '.
		self classVariables do: [:global |
				str nextPutAll: global definitionString.
				special := global isSpecial]				
			separatedBy: [ 
				str nextPutAll: '. '.  
				special ifTrue: [ str cr;tab;tab;tab;tab ]].
		str nextPutAll: ' }'. ]! !

!Class methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterExamplesFor: aStep
	<spotterOrder: 50>
	aStep listProcessor
			title: 'Examples';
			allCandidates: [ self gtExamples ];
			itemName: [ :example | example title ];
			filter: GTFilterSubstring! !

!Class methodsFor: 'initialize-release' stamp: ''!
name: aString traitComposition: aComposition methodDict: aMethodDict localSelectors: aSet organization: aClassOrganization

	"Used by copy"
	
	self name: aString.
	self localSelectors: aSet.
	self methodDict: aMethodDict.
	self traitComposition: aComposition.
	self organization: aClassOrganization! !

!Class methodsFor: 'viewer' stamp: ''!
externalName
	"Answer a name by which the receiver can be known."

	^ self name! !

!Class methodsFor: 'class variables' stamp: ''!
classVariableNamed: aString
	"Answer the Class Variable"

	^self classPool associationAt: aString asSymbol ifAbsent: [self error: 'no such class var']! !

!Class methodsFor: 'subclass creation - slots' stamp: ''!
subclass: aSubclassSymbol  layout: layoutClass slots: slotDefinition classVariables: classVarDefinition category: aCategorySymbol

	^ PharoClassInstaller make: [ :builder |
		builder name: aSubclassSymbol;
		superclass: self;
		layoutClass: layoutClass;
		slots: slotDefinition;
		sharedVariables: classVarDefinition;
		category: aCategorySymbol ].
! !

!Class methodsFor: '*FuelTests' stamp: ''!
renameSilently: aName
	 [ self rename: aName] fuelValueWithoutNotifications! !

!Class methodsFor: 'organization' stamp: 'di 12/23/1999 11:42'!
environment: anEnvironment

	environment := anEnvironment! !

!Class methodsFor: 'subclass creation' stamp: ''!
weakSubclass: aName uses: aTraitComposition instanceVariableNames: someInstanceVariableNames classVariableNames: someClassVariableNames poolDictionaries: someSharedPoolNames category: aCategory
	"Creates a new class as a subclass of an existing class (the receiver) 
	in which the subclass is to have weak indexable pointer variables."
	
	^ self
		subclass: aName
		uses: aTraitComposition
		with: [ 
			self
				weakSubclass: aName
				instanceVariableNames: someInstanceVariableNames
				classVariableNames: someClassVariableNames
				poolDictionaries: someSharedPoolNames
				category: aCategory ]! !

!Class methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterPreviewCodeIn: aComposite
	<spotterPreview: 10>
	aComposite pharoMethod
		title: [self name];
		display: #definitionForNautilus;
		smalltalkClass: [ nil ];
		entity: self.
		
	self flag: 'move "entity: self" somewhere else, maybe'! !

!Class methodsFor: '*Ring-Core-Kernel' stamp: ''!
asFullRingDefinition
	"A behavior is converted to a ring class including its variables, methods, direct superclass, direct subclasses and the package in which is loaded.
	Active methods are generated and each knows its package as well.
	Note that for its direct superclass and subclasses no full definitions are requested. If you need to traverse hierarchies use #asRingDefinitionWithMethods:withSuperclasses:withSubclasses:withPackages:"
	
	| rgClass rgSuper rgSub rgMethod packageKeys |
	rgClass:= self asRingDefinition.
	rgClass package: (RGContainer packageOfClass: rgClass).
	
	self superclass notNil 
		ifTrue: [ 
			rgSuper := self superclass asRingDefinition.
			rgClass superclass: rgSuper ]
		ifFalse: [  
			self isTrait ifTrue: [ 
				rgSuper := Trait asRingDefinition.
				rgClass superclass: rgSuper. ]
			].

	self subclasses do:[ :each |
		rgSub := each asRingDefinition.
		rgSub superclass: rgClass ].
	
	packageKeys := RGContainer packageKeys.
	self methodsDo:[ :mth|  
			rgMethod := mth asActiveRingDefinition.
			rgClass addMethod: rgMethod.
			rgMethod package: (RGContainer packageOfMethod: rgMethod using: packageKeys) ].
	self theMetaClass methodsDo:[ :mth|  
			rgMethod := mth asActiveRingDefinition.
			rgClass theMetaClass addMethod: rgMethod.
			rgMethod package: (RGContainer packageOfMethod: rgMethod using: packageKeys) ].
	
	^ rgClass! !

!Class methodsFor: 'initialize-release' stamp: ''!
superclass: aClass methodDictionary: mDict format: fmt
	"Basic initialization of the receiver"
	super superclass: aClass methodDictionary: mDict format: fmt.
	self subclasses: nil. ! !

!Class methodsFor: 'accessing' stamp: 'al 3/18/2006 13:23'!
basicCategory
	^category! !

!Class methodsFor: 'subclass creation' stamp: ''!
subclass: t uses: aTraitComposition 
	| cls |
	cls := self
				subclass: t
				instanceVariableNames: ''
				classVariableNames: ''
				poolDictionaries: ''
				category: 'Unclassified'.
	cls setTraitComposition: aTraitComposition asTraitComposition.
	^ cls! !

!Class methodsFor: 'subclass creation' stamp: 'MarcusDenker 2/19/2015 15:11'!
newAnonymousSubclass
	^ AnonymousClassInstaller make: [ :builder |
		builder
			superclass: self ;
			layoutClass: self layout class ].
! !

!Class methodsFor: 'class variables' stamp: ''!
readClassVariableNamed: aString
	"Answer the content of the Class Variable"

	^(self classVariableNamed: aString) read! !

!Class methodsFor: 'initialize-release' stamp: ''!
removeFromSystemUnlogged
	"Forget the receiver from the Smalltalk global dictionary. Any existing instances will refer to an obsolete version of the receiver.  Do not log the removal either to the current change set nor to the system changes log"
	^self removeFromSystem: false! !

!Class methodsFor: 'subclass creation' stamp: ''!
variableByteSubclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s category: cat
	"This is the standard initialization message for creating a new class as a 
	subclass of an existing class (the receiver) in which the subclass is to 
	have indexable byte-sized nonpointer variables."
	^self classBuilder
		superclass: self
		variableByteSubclass: t
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: cat! !

!Class methodsFor: 'initialize-release' stamp: ''!
superclass: sup methodDict: md format: ft name: nm organization: org instVarNames: nilOrArray classPool: pool sharedPools: poolSet 
	"Answer an instance of me, a new class, using the arguments of the 
	message as the needed information.
	Must only be sent to a new instance; else we would need Object flushCache."

	self superclass: sup.
	self methodDict: md.
	self setFormat: ft.
	self setName: nm.
	self instanceVariables: nilOrArray.
	self classPool: pool.
	self sharedPools: poolSet.
	self organization: org.! !

!Class methodsFor: 'instance variables' stamp: 'MarcusDenker 3/3/2015 20:10'!
addInstVarNamed: aString
	"Add the argument, aString, as one of the receiver's instance variables."
	aString substrings do: [ :each|
		self addSlot: (InstanceVariableSlot named: each asSymbol)]
! !

!Class methodsFor: '*Monticello' stamp: 'MarcusDenker 1/13/2015 11:49'!
asClassDefinition
	"we use a very ugly hack to encode complex slots as string with MC... later MC shoudl model Slots directly"
	self usesSpecialVariables ifFalse: [  
	 ^MCClassDefinition
		name: self name
		superclassName: self superclass name
		traitComposition: self traitCompositionString
		classTraitComposition: self class traitCompositionString
		category: self category 
		instVarNames: self instVarNames
		classVarNames: self classVarNames
		poolDictionaryNames: self sharedPoolNames
		classInstVarNames: self class instVarNames
		type: self typeOfClass
		comment: self organization classComment	asString
		commentStamp: self organization commentStamp].
	
	^MCClassDefinition
		name: self name
		superclassName: self superclass name
		traitComposition: self traitCompositionString
		classTraitComposition: self class traitCompositionString
		category: self category 
		instVarNames: (self slots collect: #definitionString)
		classVarNames: (self classVariables collect: #definitionString)
		poolDictionaryNames: self sharedPoolNames
		classInstVarNames: (self class slots collect: #definitionString)
		type: self typeOfClass
		comment: self organization classComment	 asString
		commentStamp: self organization commentStamp.
	



! !

!Class methodsFor: 'class variables' stamp: ''!
writeClassVariableNamed: aString value: anObject
	"Store anObject in the class variable."
	
	(self classVariableNamed: aString) write: anObject! !

!Class methodsFor: 'subclass creation - slots' stamp: ''!
subclass: aSubclassSymbol  layout: layoutClass  slots: slotDefinition classVariables: classVarDefinition poolDictionaries: someSharedPoolNames category: aCategorySymbol

	^ PharoClassInstaller make: [ :builder |
		builder name: aSubclassSymbol;
		superclass: self;
		layoutClass: layoutClass;
		slots: slotDefinition;
		sharedVariables:  classVarDefinition;
		sharedPools: someSharedPoolNames;
		category: aCategorySymbol ].
! !

!Class methodsFor: '*Deprecated40' stamp: 'MarcusDenker 7/6/2014 19:08'!
name: aSymbol
	self deprecated: 'use setName:' on: '6 July 2014'  in: 'Pharo4'.
	name := aSymbol! !

!Class methodsFor: 'subclass creation' stamp: 'SebastianTleye 7/12/2013 14:19'!
subclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat 
	"This is the standard initialization message for creating a new class as a 
	subclass of an existing class (the receiver)."
	| class |
	class := self classBuilder
		superclass: self
		subclass: t
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: cat.
	class ifNotNil:  [ class setTraitComposition: {} asTraitComposition ].
	^ class ! !

!Class methodsFor: 'class variables' stamp: ''!
hasClassVariable: aGlobal
	"Return whether the receiver has a class variables (shared variables among its class and subclasses) named: aString"
	
	^ self classVariables identityIncludes: aGlobal! !

!Class methodsFor: 'subclass creation - slots' stamp: ''!
subclass: aSubclassSymbol uses: aTraitCompositionOrArray  layout: layoutClass slots: slotDefinition classVariables: classVarDefinition poolDictionaries: someSharedPoolNames category: aCategorySymbol
	^ self
		subclass: aSubclassSymbol
		uses: aTraitCompositionOrArray
		with: [ 
			PharoClassInstaller
				make: [ :builder | 
					builder
						name: aSubclassSymbol;
						superclass: self;
						layoutClass: layoutClass;
						slots: slotDefinition;
						sharedVariables: classVarDefinition;
						sharedPools: someSharedPoolNames;
						category: aCategorySymbol ] ]! !

!Class methodsFor: '*Slot' stamp: ''!
removeSlot: aSlot 

	(self layout slots includes: aSlot)
		ifFalse: [self error: aSlot name , ' is not one of my slots'].
		
	^PharoClassInstaller make: [ :builder |
		builder
			superclass:  self superclass;
			name:  self name;
			layoutClass: (OldClassBuilderAdapter new layoutForType: self typeOfClass);
			slots: (self layout slots copyWithout: aSlot);
			sharedVariablesFromString: self classVariablesString;
			sharedPools: self sharedPoolsString;
			category: self category;
			environment: self environment;
			copyTraitCompositionFromExistingClass;
			copyClassSlotsFromExistingClass]
	! !

!Class methodsFor: 'pool variables' stamp: 'ClementBera 9/27/2013 17:44'!
sharedPools
	"Answer an orderedCollection  of the shared pools declared in the receiver."

	^ sharedPools ifNil: [ sharedPools := OrderedCollection new ]! !

!Class methodsFor: 'organization' stamp: ''!
category: aString 
	"Categorize the receiver under the system category, aString, removing it from 
	any previous categorization."

	| oldCategory |
	oldCategory := self basicCategory.
	aString isString
		ifTrue: [
			self basicCategory: aString asSymbol.
			self environment organization classify: self name under: self basicCategory ]
		ifFalse: [self errorCategoryName].
	SystemAnnouncer uniqueInstance
		class: self recategorizedFrom: oldCategory to: self basicCategory! !

!Class methodsFor: 'class variables' stamp: ''!
usesClassVarNamed: aString
	"Return whether the receiver or its superclasses have a class variable named: aString"
	
	^ self allClassVarNames includes: aString! !

!Class methodsFor: 'pool variables' stamp: ''!
removeSharedPool: aDictionary 
	"Remove the pool dictionary, aDictionary, as one of the receiver's pool 
	dictionaries. Create an error notification if the dictionary is not one of 
	the pools.
	: Note that it removes the wrong one if there are two empty Dictionaries in the list."

	| satisfiedSet workingSet aSubclass |
	(self sharedPools includes: aDictionary)
		ifFalse: [^self error: 'the dictionary is not in my pool'].

	"first see if it is declared in a superclass in which case we can remove it."
	(self selectSuperclasses: [:class | class sharedPools includes: aDictionary]) isEmpty
		ifFalse: [self sharedPools remove: aDictionary.
				self sharedPools isEmpty ifTrue: [self sharedPools: nil].
				^self]. 

	"second get all the subclasses that reference aDictionary through me rather than a 
	superclass that is one of my subclasses."

	workingSet := self subclasses asOrderedCollection.
	satisfiedSet := Set new.
	[workingSet isEmpty] whileFalse:
		[aSubclass := workingSet removeFirst.
		(aSubclass sharedPools includes: aDictionary)
			ifFalse: 
				[satisfiedSet add: aSubclass.
				workingSet addAll: aSubclass subclasses]].

	"for each of these, see if they refer to any of the variables in aDictionary because 
	if they do, we can not remove the dictionary."
	satisfiedSet add: self.
	satisfiedSet do: 
		[:sub | 
		aDictionary associationsDo: 
			[:aGlobal | 
			(sub whichSelectorsReferTo: aGlobal) isEmpty 
				ifFalse: [^self error: aGlobal key 
								, ' is still used in code of class '
								, sub name]]].
	self sharedPools remove: aDictionary.
	self sharedPools isEmpty ifTrue: [self sharedPools: nil]! !

!Class methodsFor: 'testing' stamp: ''!
isAnonymous
	^self getName isNil! !

!Class methodsFor: 'testing' stamp: 'MarcusDenker 10/17/2013 12:04'!
isClass
	^ true! !

!Class methodsFor: 'class name' stamp: ''!
rename: aString 
	"The new name of the receiver is the argument, aString."

	| oldName newName |
	(newName := aString asSymbol) = (oldName := self name)
		ifTrue: [^ self].
	(self environment includesKey: newName)
		ifTrue: [^ self error: newName , ' already exists'].
	self setName: newName.
	self environment renameClass: self from: oldName.
	(Undeclared includesKey: newName)
		ifTrue: [self inform: 'There are references to, ' , aString printString , '
from Undeclared. Check them after this change.'].! !

!Class methodsFor: 'fileIn/Out' stamp: ''!
shouldFileOutPool: aPoolName
	"respond with true if the user wants to file out aPoolName"
	^self confirm: ('FileOut the sharedPool ', aPoolName, '?')! !

!Class methodsFor: 'compiling' stamp: ''!
compileAllFrom: oldClass
	"Recompile all the methods in the receiver's method dictionary (not the
	subclasses). Also recompile the methods in the metaclass."

	super compileAllFrom: oldClass.
	self class compileAllFrom: oldClass class! !

!Class methodsFor: 'subclass creation - slots' stamp: ''!
subclass: aSubclassSymbol uses: aTraitCompositionOrArray slots: slotDefinition classVariables: classVarDefinition poolDictionaries: someSharedPoolNames category: aCategorySymbol
	^ self
		subclass: aSubclassSymbol
		uses: aTraitCompositionOrArray
		with: [ 
			PharoClassInstaller
				make: [ :builder | 
					builder
						name: aSubclassSymbol;
						superclass: self;
						slots: slotDefinition;
						sharedVariables: classVarDefinition;
						sharedPools: someSharedPoolNames;
						category: aCategorySymbol ] ]! !

!Class methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterReferenceFor: aStep
	<spotterOrder: 30>
	aStep listProcessor
			title: 'References';
			allCandidates: [ (SystemNavigation default allReferencesTo: self binding) collect: #compiledMethod ];
			itemName: [ :method | method gtDisplayString ];
			filter: GTFilterSubstring! !

!Class methodsFor: 'traits' stamp: ''!
applyChangesOfNewTraitCompositionReplacing: oldComposition

	| changedSelectors |
	changedSelectors := super applyChangesOfNewTraitCompositionReplacing: oldComposition.
	self classSide noteNewBaseTraitCompositionApplied: self traitComposition.
	^ changedSelectors! !

!Class methodsFor: 'testing' stamp: ''!
hasMethods
	"Answer a Boolean according to whether any methods are defined for the 
	receiver (includes whether there are methods defined in the receiver's 
	metaclass)."

	^super hasMethods or: [self class hasMethods]! !

!Class methodsFor: 'pool variables' stamp: 'al 9/3/2004 13:41'!
sharedPools: aCollection
	sharedPools := aCollection! !

!Class methodsFor: 'subclass creation' stamp: ''!
classBuilder
		"Answer the object responsible of creating subclasses of myself in the system."
	
		^ Smalltalk classBuilder! !

!Class methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterActDefault
	^ self browse! !

!Class methodsFor: '*Ring-Core-Kernel' stamp: ''!
asRingDefinitionWithMethods: methodsBoolean withSuperclasses: supersBoolean withSubclasses: subsBoolean withPackages: packsBoolean
	"Retrieves a ring class/trait based on the receiver.
	The data loaded in the class/trait (active methods, superclasses, subclasses and packages) is requested by the users.
	As it may need to traverse hierarchies for retrieving super and subclasses a ring slice is created as the container for every class, method and package.
	To retrieve the slice:  aRGClass environment "
	| rgClass rgSlice  rgPackageKeys |
	
	rgSlice := RGSlice named: #fromImage.
	packsBoolean ifTrue: [ 
		rgPackageKeys := rgSlice loadPackagesFromImage ].
	rgClass := self asRingDefinitionWithMethods: methodsBoolean withSuperclasses: supersBoolean withSubclasses: subsBoolean withPackageKeys: rgPackageKeys in: rgSlice.
	rgSlice cleanEmptyPackages.
	rgSlice loadTraitUsers.
		
	^ rgClass! !

!Class methodsFor: 'compiling' stamp: ''!
compileAll
	super compileAll.
	self classSide compileAll.! !

!Class methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterSuperClassMethodsFor: aStep
	<spotterOrder: 16>
	|superclasses|
	superclasses := self class withAllSuperclasses select: #isMeta.
	aStep listProcessor
			title: 'Super class methods';
			allCandidates: [ self classSide allMethods select: [ :each |(each methodClass = self classSide) not & (superclasses includes: each methodClass) ] ];
			filter: GTFilterSubstring! !

!Class methodsFor: 'subclass creation' stamp: ''!
variableSubclass: className instanceVariableNames: instVarNames classVariableNames: classVarNames category: cat
	"Added to allow for a simplified subclass creation experience. "

	^ self variableSubclass: className
		instanceVariableNames: instVarNames 
		classVariableNames: classVarNames 
		poolDictionaries: ''
		category: cat
! !

!Class methodsFor: 'accessing class hierarchy' stamp: ''!
subclassesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the receiver's immediate subclasses."
	self subclasses size == 0 
		ifFalse:[self subclasses do: aBlock]! !

!Class methodsFor: 'accessing' stamp: 'al 3/25/2006 12:35'!
traitComposition
	traitComposition ifNil: [traitComposition := TraitComposition new].
	^traitComposition! !

!Class methodsFor: 'private' stamp: ''!
setName: aSymbol andRegisterInCategory: categorySymbol environment: aSystemDictionary
	(self isValidTraitName: aSymbol) ifFalse: [TraitException signal: 'Invalid trait name'].
	
	(self environment == aSystemDictionary
		and: [self name = aSymbol
			and: [self category = categorySymbol]]) ifTrue: [^self].
		
	((aSystemDictionary includes: aSymbol) and: [(aSystemDictionary at: aSymbol) ~~ self])
		ifTrue: [TraitException signal: 'The name ''' , aSymbol , ''' is already used'].

	(self environment notNil and: [self name notNil and: [self name ~= aSymbol]]) ifTrue: [
		self environment renameClass: self as: aSymbol].
	
	self name: aSymbol.
	self environment: aSystemDictionary.	
	self environment at: self name put: self.
	self environment organization classify: self name under: categorySymbol.
	^ true! !

!Class methodsFor: 'class variables' stamp: ''!
definesClassVariableNamed: aString
	"Return whether the receiver has a class variables (shared variables among its class and subclasses) named: aString"
	
	^ self classVarNames includes: aString! !

!Class methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterMethodsFor: aStep
	<spotterOrder: 10>
	aStep listProcessor
			title: 'Instance methods';
			allCandidates: [ self methods ];
			itemName: [ :method | method selector ];
			filter: GTFilterSubstring! !

!Class methodsFor: 'subclass creation' stamp: ''!
variableWordSubclass: aName uses: aTraitComposition instanceVariableNames: someInstanceVariableNames classVariableNames: someClassVariableNames poolDictionaries: someSharedPoolNames category: aCategory
	"Creates a new class as a subclass of an existing class (the receiver) 
	in which the subclass is to have indexable word-sized nonpointer variables."
	
	^ self
		subclass: aName
		uses: aTraitComposition
		with: [ 
			self
				variableWordSubclass: aName
				instanceVariableNames: someInstanceVariableNames
				classVariableNames: someClassVariableNames
				poolDictionaries: someSharedPoolNames
				category: aCategory ]! !

!Class methodsFor: 'fileIn/Out' stamp: 'SebastianTleye 7/12/2013 15:20'!
fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex initializing: aBool
	"File a description of the receiver on aFileStream. If the boolean argument,
	moveSource, is true, then set the trailing bytes to the position of aFileStream and
	to fileIndex in order to indicate where to find the source code."

	self crTrace: self name.
	super
		fileOutOn: aFileStream
		moveSource: moveSource
		toFile: fileIndex.
	self class nonTrivial
		ifTrue:
			[aFileStream cr; nextPutAll: '"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!'; cr; cr.
			self class
				fileOutOn: aFileStream
				moveSource: moveSource
				toFile: fileIndex
				initializing: aBool]! !

!Class methodsFor: 'compiling' stamp: ''!
possibleVariablesFor: misspelled continuedFrom: oldResults

	| results |
	results := misspelled correctAgainstDictionary: self classPool continuedFrom: oldResults.
	self sharedPools do: [:pool | 
		results := misspelled correctAgainstDictionary: pool continuedFrom: results ].
	self superclass == nil
		ifTrue: 
			[ ^ misspelled correctAgainstDictionary: self environment continuedFrom: results ]
		ifFalse:
			[ ^ self superclass possibleVariablesFor: misspelled continuedFrom: results ]! !

!Class methodsFor: 'private' stamp: 'CamilloBruni 9/5/2013 09:46'!
setName: aSymbol
	name := aSymbol.! !

!Class methodsFor: 'pool variables' stamp: ''!
allSharedPools
	"Answer an ordered collection of the pools the receiver shares, including those defined  in the superclasses of the receiver."
	| aSet | 
	^self superclass == nil
		ifTrue: [self sharedPools copy]
		ifFalse: [aSet := self superclass allSharedPools.
			aSet addAll: self sharedPools.
			aSet]! !

!Class methodsFor: 'subclass creation' stamp: ''!
variableSubclass: aClassName uses: aTraitCompositionOrArray instanceVariableNames: instVarNames 
	classVariableNames: classVarNames category: cat
	"Added to allow for a simplified subclass creation experience. "
	
	^ self variableSubclass: aClassName 
		uses: aTraitCompositionOrArray
		instanceVariableNames: instVarNames  
		classVariableNames: classVarNames 
		poolDictionaries: ''
		category: cat! !

!Class methodsFor: 'initialize-release' stamp: ''!
replaceClassVariable: newVar 
	"replace an exisiting class var with the same name. used to wrap class vars for MetaLinks"
	
	(self classPool includesKey: newVar key) ifFalse: [ ^self ].
	self classPool removeKey: newVar key.
	self classPool add: newVar.! !

!Class methodsFor: 'subclass creation' stamp: ''!
newSubclass
	| i className |
	i := 1.
	[className := (self name , i printString) asSymbol.
	 self environment includesKey: className]
		whileTrue: [i := i + 1].

	^ self subclass: className
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: 'Unclassified'

"Point newSubclass new"! !

!Class methodsFor: 'instance variables' stamp: 'MarcusDenker 2/8/2015 19:35'!
addSlot: aSlot
	^PharoClassInstaller make: [ :builder |
		builder
			superclass: self superclass;
			name: self name;
			layoutClass: (OldClassBuilderAdapter new layoutForType: self typeOfClass);
			slots: (self slots copyWith: aSlot);
			sharedVariablesFromString: self classVariablesString;
			sharedPools: self sharedPoolsString;
			category: self category;
			environment: self environment;
			copyTraitCompositionFromExistingClass;
			copyClassSlotsFromExistingClass ].! !

!Class methodsFor: 'accessing class hierarchy' stamp: 'ClementBera 9/27/2013 17:44'!
subclasses
	"Answer a Set containing the receiver's subclasses."

	^subclasses 
		ifNil: [ #() ]
		ifNotNil: [ subclasses copy ]! !

!Class methodsFor: '*GT-InspectorExtensions-Core' stamp: ''!
gtInspectorAllReferencesIn: composite
	"This provides a list of all methods provided by the current class"
	<gtInspectorPresentationOrder: 20>
	composite list 
		title: 'All Ref';
		display: [ (SystemNavigation default allReferencesTo: self binding) 
						sorted: [ :x :y | x name < y name ] ];
		format: #name;
		tags: [ :each | { each package name } ]! !

!Class methodsFor: 'copying' stamp: ''!
duplicateClassWithNewName: aSymbol
	| copysName class newDefinition |
	copysName := aSymbol asSymbol.
	copysName = self name
		ifTrue: [ ^ self ].
	(Smalltalk globals includesKey: copysName)
		ifTrue: [ ^ self error: copysName , ' already exists' ].
	newDefinition := self definition copyReplaceAll: '#' , self name asString with: '#' , copysName asString.
	class := self class compiler source: newDefinition; logged: true; evaluate.
	class classSide instanceVariableNames: self classSide instanceVariablesString.
	class copyAllCategoriesFrom: self.
	class class copyAllCategoriesFrom: self class.
	^ class! !

!Class methodsFor: '*GT-InspectorExtensions-Core' stamp: ''!
gtInspectorMethodsIn: composite
	"This provides a list of all methods provided by the current class"
	<gtInspectorPresentationOrder: 20>
	composite list 
		title: 'Methods';
		display: [ (self allMethods collect: #asRingDefinition) 
						sorted: [ :x :y | x selector < y selector ] ];
		format: #selector;
		tags: [ :each | {each methodClass name} ]! !

!Class methodsFor: 'subclass creation' stamp: ''!
variableSubclass: aName uses: aTraitComposition instanceVariableNames: someInstanceVariableNames classVariableNames: someClassVariableNames poolDictionaries: someSharedPoolNames category: aCategory
	"Creates a new class as a subclass of an existing class (the receiver) 
	in which the subclass is to have indexable pointer variables."
	
	^ self
		subclass: aName
		uses: aTraitComposition
		with: [ 
			self
				variableSubclass: aName
				instanceVariableNames: someInstanceVariableNames
				classVariableNames: someClassVariableNames
				poolDictionaries: someSharedPoolNames
				category: aCategory ]! !

!Class methodsFor: 'accessing' stamp: 'al 3/25/2006 12:37'!
traitComposition: aTraitComposition
	traitComposition := aTraitComposition! !

!Class methodsFor: 'subclass creation' stamp: ''!
subclass: aSubclassSymbol instanceVariableNames: instVarNames classVariableNames: classVarNames category: aCategorySymbol
	"Added to allow for a simplified subclass creation experience. "
	^ self
		subclass: aSubclassSymbol
		instanceVariableNames: instVarNames
		classVariableNames: classVarNames
		poolDictionaries: ''
		category: aCategorySymbol! !

!Class methodsFor: 'pool variables' stamp: ''!
usesLocalPoolVarNamed: aString
	"Return whether the receiver uses a pool variable named: aString which is defined locally"
	
	self hasSharedPools
		ifTrue: [ self sharedPools do: [:each | (each usesClassVarNamed: aString) 
												ifTrue: [ ^true ]]]
		ifFalse: [ ^false ].
	^false! !

!Class methodsFor: 'private' stamp: 'CamilloBruni 11/21/2013 19:20'!
getName
	^ name! !

!Class methodsFor: '*Nautilus' stamp: 'MarcusDenker 1/9/2015 14:36'!
definitionForNautilusWithSlots
	"the class definition with a way to specify slots. Shown when the class defines special Slot
	 NOTE: this is just for testing, the final solution will evolve and be cleaner later"
	| aStream poolString|

	poolString := self sharedPoolsString.

	aStream := (String new: 800) writeStream.
	superclass 
		ifNil: [aStream nextPutAll: 'ProtoObject']
		ifNotNil: [aStream nextPutAll: superclass name].
	aStream nextPutAll: ' subclass: ';
			store: self name.
	(self hasTraitComposition) ifTrue: [
		aStream cr; tab; nextPutAll: 'uses: ';
			nextPutAll: self traitCompositionString].		
			
	(self layout isKindOf: FixedLayout) ifFalse: [
		aStream cr; tab; nextPutAll: 'layout: ';
			nextPutAll: self layout class name].
	aStream cr; tab; nextPutAll: 'slots: ';
			nextPutAll: self slotDefinitionString.
	aStream cr; tab; nextPutAll: 'classVariables: ';
			nextPutAll: self classVariableDefinitionString.
	poolString = '' ifFalse: [
		aStream cr; tab; nextPutAll: 'poolDictionaries: ';
			store: poolString].
	aStream cr; tab; nextPutAll: 'category: ';
			store: self category asString.

	superclass ifNil: [ 
		aStream nextPutAll: '.'; cr.
		aStream nextPutAll: self name.
		aStream space; nextPutAll: 'superclass: nil'. ].

	^ aStream contents! !

!Class methodsFor: 'class variables' stamp: ''!
hasClassVarNamed: aString
	"Return whether the receiver has a class variables (shared variables among its class and subclasses) named: aString"
	
	^ self classVarNames includes: aString! !

!Class methodsFor: 'subclass creation' stamp: ''!
weakSubclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s category: cat
	"This is the standard initialization message for creating a new class as a subclass of an existing class (the receiver) in which the subclass is to have weak indexable pointer variables."
	^self classBuilder
		superclass: self
		weakSubclass: t
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: cat! !

!Class methodsFor: 'class variables' stamp: ''!
removeClassVarNamed: aString
	"Remove the class variable whose name is the argument, aString, from 
    the names defined in the receiver, a class. Create an error notification if 
    aString is not a class variable or if it is still being used in the code of 
    the class."

	| aSymbol |
	aSymbol := aString asSymbol.
	(self classPool includesKey: aSymbol)
		ifFalse: [ ^ self error: aString , ' is not a class variable' ].
	self withAllSubclasses
		do: [ :subclass | 
			(Array with: subclass with: subclass class)
				do: [ :classOrMeta | 
					(classOrMeta whichSelectorsReferTo: (self classPool associationAt: aSymbol)) isEmpty
						ifFalse: [ 
							InMidstOfFileinNotification signal
								ifTrue: [ 
									self crTrace: self name , ' (' , aString , ' is Undeclared) '.
									^ Undeclared declare: aSymbol from: self classPool ]
								ifFalse: [ 
									(self
										confirm:
											(aString , ' is still used in code of class ' , classOrMeta name , '.\Is it okay to move it to Undeclared?') withCRs)
										ifTrue: [ ^ Undeclared declare: aSymbol from: self classPool ]
										ifFalse: [ ^ self ] ] ] ] ].
	self classPool removeKey: aSymbol.
	self classPool isEmpty
		ifTrue: [ self classPool: nil ]! !

!Class methodsFor: 'class variables' stamp: ''!
addClassVarNamed: aString 
	"Add the argument, aString, as a class variable of the receiver.
	Signal an error if the first character of aString is not capitalized,
	or if it is already a variable named in the class."
	
	self addClassVariable: (aString asSymbol => ClassVariable)! !

!Class methodsFor: 'class variables' stamp: ''!
allClassVarNames
	"Answer a Set of the names of the receiver's class variables, including those
	defined in the superclasses of the receiver."

	| aSet |
	self superclass == nil
		ifTrue: 
			[^self classVarNames asSet]  "This is the keys so it is a new Set."
		ifFalse: 
			[aSet := self superclass allClassVarNames.
			aSet addAll: self classVarNames.
			^aSet]! !

!Class methodsFor: '*Manifest-Core' stamp: ''!
criticTheNonMetaclassClass

	"Return the class of the receiver for the critic browser. This behavior may be folded later by changing the name of this method or using another one."
	
	^ self ! !

!Class methodsFor: 'compiling' stamp: ''!
bindingOf: varName
	"Answer the binding of some variable resolved in the scope of the receiver, or nil
	if variable with such name is not defined"

	"The lookup recurses up to superclasses looking inside their class and shared pools,
	but not the environment, since two classes, even if they have ancestry relationship,
	could use different environments.
	That's why we doing an environment lookup only as a last step of symbol lookup 
	and taking only the environment of receiver only, not any of it's superclass(es) "
	
	| aSymbol |
	aSymbol := varName asSymbol.

	^ (self innerBindingOf: aSymbol) ifNil: [
		 self environment bindingOf: aSymbol
	]! !

!Class methodsFor: 'subclass creation' stamp: ''!
variableWordSubclass: className instanceVariableNames: instVarNames
	classVariableNames: classVarNames category: cat
	"Added to allow for a simplified subclass creation experience. "
	 
	^ self variableWordSubclass: className
		instanceVariableNames: instVarNames  
		classVariableNames: classVarNames 
		poolDictionaries: ''
		category: cat! !

!Class methodsFor: 'class variables' stamp: ''!
addClassVariable: aGlobal
	"Add the argument, aString, as a class variable of the receiver.
	Signal an error if the first character of aString is not capitalized,
	or if it is already a variable named in the class."
	| symbol oldState |
	oldState := self copy.
	symbol := aGlobal name asSymbol.
	self withAllSubclasses do: 
		[:subclass | 
		(subclass bindingOf: symbol) ifNotNil:[
			^ self error: symbol asString 
				, ' is already used as a variable name in class ' 
				, subclass name]].
	(self classPool includesKey: symbol) ifFalse: 
		["Pick up any refs in Undeclared"
		self classPool declareVariable: aGlobal from: Undeclared.
		SystemAnnouncer uniqueInstance classDefinitionChangedFrom: oldState to: self]! !

!Class methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterClassMethodsFor: aStep
	<spotterOrder: 15>
	aStep listProcessor
			title: 'Class methods';
			allCandidates: [ self classSide methods ];
			itemName: [ :method | method selector ];
			filter: GTFilterSubstring! !

!Class methodsFor: 'subclass creation - slots' stamp: ''!
subclass: aSubclassSymbol slots: slotDefinition classVariables: classVarDefinition poolDictionaries: someSharedPoolNames category: aCategorySymbol

	^ PharoClassInstaller make: [ :builder |
		builder name: aSubclassSymbol;
		superclass: self;
		slots: slotDefinition;
		sharedVariables:  classVarDefinition;
		sharedPools: someSharedPoolNames;
		category: aCategorySymbol ].
! !

!Class methodsFor: 'class variables' stamp: ''!
removeClassVariable: aGlobal
	"Remove the class variable"
	self removeClassVarNamed: aGlobal name

	! !

!Class methodsFor: 'accessing class hierarchy' stamp: 'EstebanLorenzano 4/11/2014 15:52'!
addSubclass: aSubclass 
	"Make the argument, aSubclass, be one of the subclasses of the receiver. 
	Create an error notification if the argument's superclass is not the receiver."
	aSubclass superclass ~~ self 
		ifTrue: [^self error: aSubclass name , ' is not my subclass'].
	subclasses ifNil: [
		self subclasses: (Array with: aSubclass).
		^ self ].
	self subclasses do:[:cl| cl == aSubclass ifTrue:[^self]]. "Already my subclass"
	self subclasses: (subclasses copyWith: aSubclass).! !

!Class methodsFor: 'initialize-release' stamp: ''!
obsolete
	"Change the receiver and all of its subclasses to an obsolete class."
	self == Object 
		ifTrue: [^self error: 'Object is NOT obsolete'].
	self setName: 'AnObsolete' , self name.
	Object class instSize + 1 to: self classSide instSize do:
		[:i | self instVarAt: i put: nil]. "Store nil over class instVars."
	self classPool: nil.
	self sharedPools: nil.
	self hasClassSide ifTrue: [ self theMetaClass obsolete].
	self propertyValueAt: #obsolete put: true.
	super obsolete.! !

!Class methodsFor: '*Nautilus' stamp: 'MarcusDenker 1/13/2015 11:51'!
definitionForNautilus
	"Answer a String that defines the receiver."
	| aStream poolString|

	(self usesSpecialVariables or: [ Slot showSlotClassDefinition ]) ifTrue: [ ^self definitionForNautilusWithSlots ].

	poolString := self sharedPoolsString.

	aStream := (String new: 800) writeStream.
	superclass 
		ifNil: [aStream nextPutAll: 'ProtoObject']
		ifNotNil: [aStream nextPutAll: superclass name].
	aStream nextPutAll: self kindOfSubclass;
			store: self name.
	(self hasTraitComposition) ifTrue: [
		aStream cr; tab; nextPutAll: 'uses: ';
			nextPutAll: self traitCompositionString].
	aStream cr; tab; nextPutAll: 'instanceVariableNames: ';
			store: self instanceVariablesString.
	aStream cr; tab; nextPutAll: 'classVariableNames: ';
			store: self classVariablesString.
	poolString = '' ifFalse: [
		aStream cr; tab; nextPutAll: 'poolDictionaries: ';
			store: poolString].
	aStream cr; tab; nextPutAll: 'category: ';
			store: self category asString.

	superclass ifNil: [ 
		aStream nextPutAll: '.'; cr.
		aStream nextPutAll: self name.
		aStream space; nextPutAll: 'superclass: nil'. ].

	^ aStream contents! !

!Class methodsFor: 'organization' stamp: ''!
category
	"Answer the system organization category for the receiver. First check whether the
	category name stored in the ivar is still correct and only if this fails look it up
	(latter is much more expensive)"

	| result |
	self basicCategory ifNotNil: [ :symbol |
		((self environment organization listAtCategoryNamed: symbol) includes: self name)
			ifTrue: [ ^symbol ] ].
	result := (self environment organization categoryOfElement: self name)
		ifNil: [ #Unclassified ]
		ifNotNil: #yourself.
	self basicCategory: result.
	
	^ result! !

!Class methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/12/2013 14:42'!
classClass
	^self class.! !

!Class methodsFor: 'initialize-release' stamp: ''!
sharing: poolString 
	"Set up sharedPools. Answer whether recompilation is advisable."
	| oldPools |
	oldPools := self sharedPools.
	self sharedPools: OrderedCollection new.
	(poolString substrings: ' ') do: 
		[:poolName | 
		self sharedPools add: (self environment at: poolName asSymbol ifAbsent:[
			(self confirm: 'The pool dictionary ', poolName,' does not exist.',
						'\Do you want it automatically created?' withCRs)
				ifTrue: [ PharoClassInstaller make: [ :builder | 
							builder superclass: SharedPool;
							name: poolName;
							category: self category ]]
				ifFalse:[^self error: poolName,' does not exist']])].
	self sharedPools isEmpty ifTrue: [self sharedPools: nil].
	oldPools do: [:pool |
				| found |
				found := self sharedPools anySatisfy: [:p | p == pool].
				found ifFalse: [^ true "A pool got deleted"]].
	^ false! !

!Class methodsFor: 'initialize-release' stamp: ''!
removeFromSystem
	"Forget the receiver from the Smalltalk global dictionary. Any existing 
	instances will refer to an obsolete version of the receiver."
	self removeFromSystem: true.! !

!Class methodsFor: 'private' stamp: ''!
isValidTraitName: aSymbol
	^(aSymbol isEmptyOrNil
		or: [aSymbol first isLetter not
		or: [aSymbol anySatisfy: [:character | character isAlphaNumeric not]]]) not! !

!Class methodsFor: '*HelpSystem-Core' stamp: ''!
asHelpTopic
	^SystemReference forClass: self! !

!Class methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/12/2013 14:42'!
baseClass
	^ self! !

!Class methodsFor: 'compiling' stamp: ''!
innerBindingOf: aSymbol
	"Answer the binding of some variable resolved in the scope of the receiver, or one of its superclass
	but do not look up binding in receiver's environment.
	Use #bindingOf: for looking up the variable binding in a full scope, including receiver's environment"

	"First look in classVar dictionary."
	(self classPool bindingOf: aSymbol) ifNotNil: [:binding | ^binding].
	"Next look in shared pools."
	self sharedPools do: [:pool | (pool bindingOf: aSymbol) ifNotNil: [:binding | ^binding]].
	self superclass ifNotNil: [:supercl | ^ supercl innerBindingOf: aSymbol].	
	^ nil! !

!Class methodsFor: 'subclass creation' stamp: ''!
weakSubclass: className uses: aTraitCompositionOrArray instanceVariableNames: instVarNames 
	classVariableNames: classVarNames category: cat
	"Added to allow for a simplified subclass creation experience. "
	
	^ self weakSubclass: className
		uses: aTraitCompositionOrArray
		instanceVariableNames: instVarNames 
		classVariableNames: classVarNames 
		poolDictionaries: ''
		category: cat
! !

!Class methodsFor: '*OpalCompiler-Core' stamp: ''!
classSideCompiler
	"Redefine this method if you want to customize the compiler for class-side methods"
	^self classSideCompilerClass new
		environment: self classSide environment;
		class: self classSide! !

!Class methodsFor: 'initialize-release' stamp: ''!
removeFromSystem: logged
	"Forget the receiver from the Smalltalk global dictionary. Any existing 
	instances will refer to an obsolete version of the receiver."
	
	"keep the class name and category for triggering the system change message. If we wait to long, then we get obsolete information which is not what we want."

	"tell class to deactivate and unload itself-- two separate events in the module system"
	self unload.
	self traitUsers do: [ :user | user removeFromComposition: self ].
	self superclass ifNotNil:
		["If we have no superclass there's nothing to be remembered"
		self superclass addObsoleteSubclass: self].
	self environment forgetClass: self logged: logged.
	self obsolete.! !

!Class methodsFor: 'compiling' stamp: ''!
binding
       "Answer a binding for the receiver, sharing if possible"
      | binding |
	binding := self environment associationAt: self name ifAbsent: [nil -> self].
       ^binding value == self ifTrue: [binding] ifFalse: [nil -> self]! !

!Class methodsFor: 'subclass creation' stamp: ''!
subclass: t
	^ self subclass: t instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Unclassified' ! !

!Class methodsFor: 'pool variables' stamp: ''!
usesPoolVarNamed: aString
	"Return whether the receiver has a pool variable named: aString, taking into account superclasses too"
	
	self allSharedPools do: [:each | (each usesClassVarNamed: aString) ifTrue: [^true]].
	^false! !

!Class methodsFor: '*Ring-Core-Kernel' stamp: 'MarcusDenker 7/30/2014 21:35'!
asRingDefinition
	"A behavior is converted to a ring class. Only the receiver and its variables (instance, class, pools) are converted.
	Methods, superclasses, subclasses are not generated"
	
	| ring |
	ring := (RGClassDefinition named: self name)
		category: self category;
		superclassName: self superclass name;  
		traitCompositionSource: self traitCompositionString;
		addInstanceVariables: self instVarNames;
		addClassVariables: self classVarNames;
		addSharedPools: self sharedPoolNames;
		comment: self organization classComment;
		stamp: self organization commentStamp;
		definitionSource: self definition;
		package: self package asRingDefinition;
		withMetaclass.
	ring theMetaClass 
		traitCompositionSource: self theMetaClass traitCompositionString;
		definitionSource: self theMetaClass definition;
		addInstanceVariables: self theMetaClass instVarNames.  
	^ ring! !

!Class methodsFor: 'testing' stamp: ''!
hasAbstractMethods
	"Tells whether the receiver locally defines an abstract method, i.e., a method sending subclassResponsibility"
	^ super hasAbstractMethods or: [self class hasAbstractMethods]
! !

!Class methodsFor: 'subclass creation - private' stamp: ''!
subclass: aName uses: aTraitComposition with: aBlock 
	"Define (or redefine) a subclass by evaluating a block closure. 

	Note (MartinDias): 
		This is a workaround for the subclass creation API when a trait is specified. 
		To fix it well, in Pharo 4, a bit deeper refactoring is required, delegating this responsibility
		to SlotClassBuilder."

	^ self environment 
		at: aName
		ifPresent: [ :old | 
			| copyOfOld newClass |
			copyOfOld := old copy.

			"Modify the class and set the new trait composition"
			newClass := aBlock value. 
			newClass setTraitComposition: aTraitComposition asTraitComposition.

			"Announce that the definition changed when there is a new trait composution. 
			Note: It may be a re-announce if there was other change in the class definition, 
			e.g. an instace variable added."
			(newClass traitComposition syntacticallyEquals: copyOfOld traitComposition) ifFalse: [ 
				SystemAnnouncer uniqueInstance 
					classDefinitionChangedFrom: copyOfOld 
					to: newClass ].

			newClass ]
		ifAbsent: [
			"Create the class and set the trait composition"
			aBlock value
				setTraitComposition: aTraitComposition asTraitComposition;
				yourself ].! !

!Class methodsFor: 'accessing' stamp: 'ClementBera 9/27/2013 17:43'!
name
	"Answer the name of the receiver."

	^ name ifNil: [ super name ]! !

!Class methodsFor: 'accessing' stamp: 'al 9/3/2004 13:37'!
classPool: aDictionary
	classPool := aDictionary! !

!Class methodsFor: 'accessing' stamp: 'al 3/25/2006 13:16'!
basicLocalSelectors: aSetOrNil
	localSelectors := aSetOrNil! !

!Class methodsFor: 'class variables' stamp: ''!
classVariables
	"Answer the meta objects of all class variables"

	^self classPool associations! !

!Class methodsFor: 'fileIn/Out' stamp: ''!
fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex 
	"File a description of the receiver on aFileStream. If the boolean argument,
	moveSource, is true, then set the trailing bytes to the position of aFileStream and
	to fileIndex in order to indicate where to find the source code."
	^self fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex initializing: true! !

!Class methodsFor: 'instance variables' stamp: ''!
removeInstVarNamed: aString 
	"Remove the argument, aString, as one of the receiver's instance variables."

	| newInstVarString |
	(self instVarNames includes: aString)
		ifFalse: [self error: aString , ' is not one of my instance variables'].
	newInstVarString := ''.
	(self instVarNames copyWithout: aString) do: 
		[:varName | newInstVarString := newInstVarString , ' ' , varName].
	^self classBuilder
		name: self name
		inEnvironment: self environment
		subclassOf: self superclass
		type: self typeOfClass
		instanceVariableNames: newInstVarString
		classVariableNames: self classVariablesString
		poolDictionaries: self sharedPoolsString
		category: self category! !

!Class methodsFor: 'accessing class hierarchy' stamp: ''!
removeSubclass: aSubclass 
	"If the argument, aSubclass, is one of the receiver's subclasses, remove it."

	self subclasses == nil ifFalse:
		[self subclasses:  (self subclasses copyWithout: aSubclass).
		self subclasses isEmpty ifTrue: [self subclasses: nil]].! !

!Class methodsFor: 'pool variables' stamp: ''!
sharedPoolOfVarNamed: aString
	"Returns the SharedPool or nil from which the pool variable named aString is coming from."
	
	 ^ self sharedPools 
			detect: [:each | each usesClassVarNamed: aString ]
			ifNone: [
						self superclass == nil
							ifTrue: [nil]
							ifFalse: [self superclass sharedPoolOfVarNamed: aString]
						]! !

!Class methodsFor: 'fileIn/Out' stamp: ''!
fileOutPool: aPool onFileStream: aFileStream 
	| aPoolName |
	(aPool  isKindOf: SharedPool class) ifTrue:[^self notify: 'we do not fileout SharedPool type shared pools for now'].
	aPoolName := self environment keyAtIdentityValue: aPool.
	self crTrace: aPoolName.
	aFileStream nextPutAll: 'Transcript show: ''' , aPoolName , '''; cr!!'; cr.
	aFileStream nextPutAll: 'Smalltalk at: #' , aPoolName , ' put: Dictionary new!!'; cr.
	aPool keys asSortedCollection do: [ :aKey | | aValue |
		aValue := aPool at: aKey.
		aFileStream nextPutAll: aPoolName , ' at: #''' , aKey asString , '''', ' put:  '.
		(aValue isKindOf: Number)
			ifTrue: [aValue printOn: aFileStream]
			ifFalse: [aFileStream nextPutAll: '('.
					aValue printOn: aFileStream.
					aFileStream nextPutAll: ')'].
		aFileStream nextPutAll: '!!'; cr].
	aFileStream cr! !

!Class methodsFor: 'accessing' stamp: 'al 3/18/2006 13:23'!
basicCategory: aSymbol
	category := aSymbol! !

!Class methodsFor: 'subclass creation - slots' stamp: ''!
subclass: aSubclassSymbol uses: aTraitCompositionOrArray  layout: layoutClass slots: slotDefinition classVariables: classVarDefinition category: aCategorySymbol
	^ self
		subclass: aSubclassSymbol
		uses: aTraitCompositionOrArray
		with: [ 
			PharoClassInstaller
				make: [ :builder | 
					builder
						name: aSubclassSymbol;
						superclass: self;
						layoutClass: layoutClass;
						slots: slotDefinition;
						sharedVariables: classVarDefinition;
						category: aCategorySymbol ] ]! !

!Class methodsFor: 'accessing class hierarchy' stamp: 'ST 6/18/2013 16:28'!
subclasses: aCollection
	subclasses := aCollection.! !

!Class methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterSuperMethodsFor: aStep
	<spotterOrder: 11>
	aStep listProcessor
			title: 'Super instance methods';
			allCandidates: [ self allMethods reject: [ :each | each methodClass = self ] ];
			filter: GTFilterSubstring! !

!Class methodsFor: '*Fuel' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper

	^aGeneralMapper visitClass: self! !

!Class methodsFor: 'testing' stamp: ''!
isClassOrTrait
	^true! !

!Class methodsFor: 'organization' stamp: 'ClementBera 9/27/2013 17:42'!
environment

	environment ifNil: [^ super environment].
	^ environment! !

!Class methodsFor: 'fileIn/Out' stamp: ''!
fileOutInitializerOn: aStream
	^self class fileOutInitializerOn: aStream! !

!Class methodsFor: 'fileIn/Out' stamp: ''!
shouldFileOutPools
	"respond with true if the user wants to file out the shared pools"
	^self confirm: 'FileOut selected sharedPools?'! !

!Class methodsFor: 'fileIn/Out' stamp: ''!
removeFromChanges
	"References to the receiver, a class, and its metaclass should no longer be included in the system ChangeSet."

	ChangeSet current removeClassAndMetaClassChanges: self! !

!Class methodsFor: 'class variables' stamp: ''!
classVarNames
	"Answer a collection of the names of the class variables defined in the receiver."

	^self classPool keys sort! !

!Class methodsFor: 'subclass creation' stamp: ''!
variableWordSubclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s category: cat
	"This is the standard initialization message for creating a new class as a 
	subclass of an existing class (the receiver) in which the subclass is to 
	have indexable word-sized nonpointer variables."
	^self classBuilder
		superclass: self
		variableWordSubclass: t
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: cat
! !

!Class methodsFor: 'initialize-release' stamp: ''!
unload
	"Sent when a the class is removed.  Does nothing, but may be overridden by (class-side) subclasses."! !

!Class methodsFor: 'compiling' stamp: ''!
reformatAll 
	"Reformat all methods in this class.
	Leaves old code accessible to version browsing"
	super reformatAll.		"me..."
	self class reformatAll	"...and my metaclass"! !

!Class methodsFor: 'class variables' stamp: ''!
classVarNamed: aString
	"for compatibility"

	^self readClassVariableNamed: aString! !

!Class methodsFor: '*Monticello' stamp: 'avi 3/10/2004 13:32'!
classDefinitions
	^ Array with: self asClassDefinition! !

!Class methodsFor: 'accessing parallel hierarchy' stamp: ''!
hasClassSide
	^self classSide notNil.! !

!Class methodsFor: 'subclass creation' stamp: ''!
subclass: aName uses: aTraitCompositionOrArray instanceVariableNames: someInstanceVariableNames classVariableNames: someClassVariableNames poolDictionaries: someSharedPoolNames category: aCategory

	^ self
		subclass: aName
		uses: aTraitCompositionOrArray
		with: [ 
			self
				subclass: aName
				instanceVariableNames: someInstanceVariableNames
				classVariableNames: someClassVariableNames
				poolDictionaries: someSharedPoolNames
				category: aCategory ]! !

!Class methodsFor: 'subclass creation' stamp: ''!
variableSubclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s category: cat
	"This is the standard initialization message for creating a new class as a 
	subclass of an existing class (the receiver) in which the subclass is to 
	have indexable pointer variables."
	^self classBuilder
		superclass: self
		variableSubclass: t
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: cat
! !

!Class methodsFor: 'fileIn/Out' stamp: ''!
hasSharedPools
	"Returns whether the receiver uses shared pools directly (Does not take into account that it may inherit shared pool uses."
	^ self sharedPools notEmpty! !

!Class methodsFor: 'subclass creation - slots' stamp: ''!
subclass: aSubclassSymbol uses: aTraitCompositionOrArray slots: slotDefinition classVariables: classVarDefinition category: aCategorySymbol
	^ self
		subclass: aSubclassSymbol
		uses: aTraitCompositionOrArray
		with: [ 
			PharoClassInstaller
				make: [ :builder | 
					builder
						name: aSubclassSymbol;
						superclass: self;
						slots: slotDefinition;
						sharedVariables: classVarDefinition;
						category: aCategorySymbol ] ]! !

!Class methodsFor: '*OpalCompiler-Core' stamp: ''!
classSideCompilerClass 
	"Redefine this method if you want to customize the compiler class for class-side methods"
	^ Smalltalk compilerClass! !

!Class methodsFor: 'class variables' stamp: ''!
classVarNamed: aString put: anObject
	"for compatibility"
	
	self writeClassVariableNamed: aString value: anObject! !

!Class methodsFor: 'pool variables' stamp: ''!
addSharedPool: aSharedPool 
	"Add the argument, aSharedPool, as one of the receiver's shared pools. 
	Create an error if the shared pool is already one of the pools.
	This method will work with shared pools that are plain Dictionaries or thenewer SharedPool subclasses"

	(self sharedPools includes: aSharedPool)
		ifTrue: [^self error: 'This is already in my shared pool list'].
	self sharedPools == nil
		ifTrue: [self sharedPools: (OrderedCollection with: aSharedPool)]
		ifFalse: [self sharedPools add: aSharedPool]! !

!Class methodsFor: 'subclass creation' stamp: ''!
weakSubclass: className instanceVariableNames: instVarNames 
	classVariableNames: classVarNames category: cat
	"Added to allow for a simplified subclass creation experience. "
	
	^ self weakSubclass: className 
		instanceVariableNames: instVarNames 
		classVariableNames: classVarNames 
		poolDictionaries: ''
		category: cat! !

!Class methodsFor: 'subclass creation' stamp: ''!
subclass: t instanceVariableNames: ins
	^ self subclass: t instanceVariableNames: ins classVariableNames: '' poolDictionaries: '' category: 'Unclassified' ! !

!Class methodsFor: 'subclass creation' stamp: ''!
variableByteSubclass: aName uses: aTraitComposition instanceVariableNames: someInstanceVariableNames classVariableNames: someClassVariableNames poolDictionaries: someSharedPoolNames category: aCategory
	"Creates a new class as a subclass of an existing class (the receiver) 
	in which the subclass is to have indexable byte-sized nonpointer variables."
	
	^ self
		subclass: aName
		uses: aTraitComposition
		with: [ 
			self
				variableByteSubclass: aName
				instanceVariableNames: someInstanceVariableNames
				classVariableNames: someClassVariableNames
				poolDictionaries: someSharedPoolNames
				category: aCategory ]! !

!Class methodsFor: 'copying' stamp: 'MarcusDenker 9/24/2014 14:17'!
copy 
	"Answer a copy of the receiver without a list of subclasses.
	 This copy is used by the ClassBuilder when mutating classes on redefinition.
	 (SystemNavigation new browseAllCallsOn: #copy localTo: ClassBuilder)"
	| newClass |
	newClass := self class copy new
		superclass: superclass
		methodDict: self methodDict copy
		format: format
		name: name
		organization: self organization copy
		instVarNames: instanceVariables copy
		classPool: classPool copy
		sharedPools: sharedPools copy.
	Class instSize+1 to: self class instSize do:
		[:offset | newClass instVarAt: offset put: (self instVarAt: offset)].
	newClass layout:  (layout copy host: newClass).
	^ newClass! !

!Class methodsFor: 'subclass creation' stamp: ''!
variableByteSubclass: className instanceVariableNames: instvarNames 
	classVariableNames: classVarNames category: cat
	"Added to allow for a simplified subclass creation experience. "
	^self variableByteSubclass: className
		instanceVariableNames: instvarNames
		classVariableNames: classVarNames
		poolDictionaries: ''
		category: cat! !

!Class methodsFor: 'accessing' stamp: 'ClementBera 9/27/2013 17:42'!
classPool
	"Answer the dictionary of class variables."

	classPool ifNil: [ classPool := Dictionary new ].
		
	^ classPool! !

!Class methodsFor: 'initialize-release' stamp: ''!
declareClassVariables: newVars 
	"Declare class variables common to all instances. Answer whether 
	recompilation is advisable."
	|  conflicts |
	
	conflicts := false.	
	(self classVariables reject: [:x | newVars includes: x]) do: [:var | [self removeClassVariable: var] on: InMidstOfFileinNotification do: [:ex | ex resume: true]].
	
	(newVars reject: [:var | self classVariables includes: var]) do: [:var | "adding"
			"check if new vars defined elsewhere"
			(self innerBindingOf: var key) 
				ifNotNil: [(DuplicatedVariableError new) variable: var name;
						signal: var name , ' is defined elsewhere'.
					conflicts := true]].
	newVars notEmpty
		ifTrue: 
			[self classPool: self classPool.
			"in case it was nil"
			newVars do: [:var | self classPool declareVariable: var from: Undeclared]].
	^conflicts! !

!Class methodsFor: 'subclass creation - slots' stamp: ''!
subclass: aSubclassSymbol slots: slotDefinition classVariables: classVarDefinition category: aCategorySymbol

	^ PharoClassInstaller make: [ :builder |
		builder name: aSubclassSymbol;
		superclass: self;
		slots: slotDefinition;
		sharedVariables: classVarDefinition;
		category: aCategorySymbol ].
! !

!Class methodsFor: 'accessing' stamp: 'al 3/25/2006 13:16'!
basicLocalSelectors
	"Direct accessor for the instance variable localSelectors.
	Since localSelectors is lazily initialized, this may 
	return nil, which means that all selectors are local."

	^ localSelectors! !

!Class methodsFor: 'fileIn/Out' stamp: ''!
fileOutSharedPoolsOn: aFileStream
	"file out the shared pools of this class after prompting the user about each pool"
	| poolsToFileOut |
	poolsToFileOut := self sharedPools select: 
		[:aPool | (self shouldFileOutPool: (self environment keyAtIdentityValue: aPool))].
	poolsToFileOut do: [:aPool | self fileOutPool: aPool onFileStream: aFileStream].
	! !

!Class methodsFor: 'subclass creation' stamp: ''!
subclass: aTraitName uses: aTraitCompositionOrArray instanceVariableNames: instVarNames classVariableNames: classVarNames category: cat 

	^ self
		subclass: aTraitName
		uses: aTraitCompositionOrArray
		instanceVariableNames: instVarNames
		classVariableNames: classVarNames
		poolDictionaries: ''
		category: cat ! !

!Class methodsFor: 'subclass creation' stamp: ''!
variableByteSubclass: className uses: aTraitCompositionOrArray instanceVariableNames: instVarNames 
	classVariableNames: classVarNames category: cat
		"Added to allow for a simplified subclass creation experience. "
	
	^ self variableByteSubclass: className
		uses: aTraitCompositionOrArray
		instanceVariableNames: instVarNames
		classVariableNames: classVarNames 
		poolDictionaries: ''
		category: cat! !

!Class methodsFor: 'subclass creation' stamp: ''!
variableWordSubclass: className uses: aTraitCompositionOrArray instanceVariableNames: instVarNames
	classVariableNames: classVarNames category: cat
	"Added to allow for a simplified subclass creation experience. "

	^ self variableWordSubclass: className
		uses: aTraitCompositionOrArray
		instanceVariableNames: instVarNames
		classVariableNames: classVarNames
		poolDictionaries: ''
		category: cat! !

!Class methodsFor: 'class variables' stamp: ''!
definesClassVariable: aGlobal
	"Return whether the receiver has a class variables (shared variables among its class and subclasses) named: aString"
	
	^ self classVariables includes: aGlobal! !

!Class methodsFor: 'self evaluating' stamp: ''!
isSelfEvaluating
	^self isObsolete not! !

!Class methodsFor: '*GT-InspectorExtensions-Core' stamp: ''!
gtInspectorCommentIn: composite
	"This provides an editable comment of the current class"
	<gtInspectorPresentationOrder: 20>
	composite text 
		title: 'Comment';
		display: [ self comment ];
		act: [ :text | 
			self comment: text text stamp: Author changeStamp]
			icon: GLMUIThemeExtraIcons glamorousAccept 
			on: $s
			entitled: 'Accept'! !

!Class methodsFor: 'fileIn/Out' stamp: ''!
fileOut
	"Create a file whose name is the name of the receiver with '.st' as the 
	extension, and file a description of the receiver onto it."
	
	| internalStream |
	internalStream := (String new: 100) writeStream.
	internalStream header; timeStamp.

	self hasSharedPools ifTrue: [
		self shouldFileOutPools
			ifTrue: [self fileOutSharedPoolsOn: internalStream]].
	self fileOutOn: internalStream moveSource: false toFile: 0.
	internalStream trailer.

	FileStream writeSourceCodeFrom: internalStream baseName: self name isSt: true! !

!Class methodsFor: '*GT-InspectorExtensions-Core' stamp: ''!
gtInspectorAllReferencesOutsideIn: composite
	"This provides a list of all methods provided by the current class"
	<gtInspectorPresentationOrder: 20>
	composite list 
		title: 'All Ref Outside';
		display: [ ((SystemNavigation default allReferencesTo: self binding) 
							reject: [ :method | method package name == self package name ])
						sorted: [ :x :y | x name < y name ] ];
		format: #name;
		tags: [ :each | { each package name } ]! !

!Class methodsFor: '*Ring-Core-Kernel' stamp: 'MarcusDenker 9/12/2014 17:14'!
asRingDefinitionWithMethods: methodsBoolean withSuperclasses: supersBoolean withSubclasses: subsBoolean withPackageKeys: packageKeys in: aRGSlice
	| rgClass rgMethod rgSuper rgSub subs |
	rgClass := self asRingDefinition.
	aRGSlice loadClass: rgClass using: packageKeys.
	methodsBoolean
		ifTrue: [ 
			self
				methodsDo: [ :mth | 
					rgMethod := mth asActiveRingDefinition.
					aRGSlice loadMethod: rgMethod inClass: rgClass using: packageKeys ].
			self theMetaClass
				methodsDo: [ :mth | 
					rgMethod := mth asActiveRingDefinition.
					aRGSlice loadMethod: rgMethod inClass: rgClass theMetaClass using: packageKeys ] ].
	supersBoolean
		ifTrue: [ 
			self superclass
				ifNotNil: [ 
					rgSuper := aRGSlice classNamed: self superclass name.
					rgSuper
						ifNil: [ 
							rgSuper := self superclass
								asRingDefinitionWithMethods: methodsBoolean
								withSuperclasses: supersBoolean
								withSubclasses: subsBoolean
								withPackageKeys: packageKeys
								in: aRGSlice ].
					rgClass superclass: rgSuper ] ].
	subsBoolean
		ifTrue: [ 
			subs := self subclasses reject: [ :sub | sub isMeta ].
			rgClass name = #Trait
				ifTrue: [ subs := aRGSlice environment allTraits ].
			subs
				do: [ :each | 
					rgSub := aRGSlice classNamed: each name.
					rgSub
						ifNil: [ 
							rgSub := each
								asRingDefinitionWithMethods: methodsBoolean
								withSuperclasses: supersBoolean
								withSubclasses: subsBoolean
								withPackageKeys: packageKeys
								in: aRGSlice ].
					rgSub superclass: rgClass ] ].
	^ rgClass! !

!Class class methodsFor: 'inquiries' stamp: ''!
rootsOfTheWorld
	"return all classes that have a nil superclass"
	
	^(Smalltalk globals select: [:each | each isBehavior and: [each superclass isNil]]) asOrderedCollection! !

!Class class methodsFor: 'private' stamp: ''!
hasNoDependenciesFor: aClass in: unprocessedClasses cache: cache 
	^ (self hasNoSuperclassesOf: aClass in: unprocessedClasses cache: cache) and: [
		aClass isMeta not or: [
			self hasNoDependenciesForMetaclass: aClass in: unprocessedClasses cache: cache]] ! !

!Class class methodsFor: 'instance creation' stamp: ''!
template: aSystemCategoryName 
	"Answer an expression that can be edited and evaluated in order to define a new class."

	^ self templateForSubclassOf: Object name category: aSystemCategoryName ! !

!Class class methodsFor: 'fileIn/Out' stamp: ''!
doesNotIncludeInstanceOrSuperclassesFor: aClass in: unprocessedClasses cache: cache 
	| soleInstance |
	soleInstance := aClass soleInstance.
	^ (unprocessedClasses includes: soleInstance) not and: [
				self hasNoSuperclassesOf: soleInstance in: unprocessedClasses cache: cache]! !

!Class class methodsFor: 'instance creation' stamp: ''!
templateForSubclassOf: priorClassName category: systemCategoryName 
	"Answer an expression that can be edited and evaluated in order to define a new class, given that the class previously looked at was as given"

	^priorClassName asString, ' subclass: #NameOfSubclass
	instanceVariableNames: ''''
	classVariableNames: ''''
	poolDictionaries: ''''
	category: ''' , systemCategoryName asString , ''''! !

!Class class methodsFor: 'fileIn/Out' stamp: ''!
superclassOrder: classes
	"Arrange the classes in the collection, classes, in superclass order so the 
	classes can be properly filed in. Do it in sets instead of ordered collections."

	| all unprocessedClasses cache |

	unprocessedClasses := classes asSet. 
	cache := Dictionary new.
	all := OrderedCollection new: unprocessedClasses size.
	unprocessedClasses size timesRepeat: [ |nextClass|
		nextClass := unprocessedClasses detect: [:aClass | self hasNoDependenciesFor: aClass in: unprocessedClasses cache: cache].
		all add: nextClass.
		unprocessedClasses remove: nextClass].
	^all! !

!Class class methodsFor: 'fileIn/Out' stamp: ''!
hasNoSuperclassesOf: aClass in: unprocessedClasses cache: cache 
	^ (unprocessedClasses includesAnyOf: (self allSuperclassesFor: aClass cache: cache)) not
	! !

!Class class methodsFor: 'fileIn/Out' stamp: ''!
fileOutPool: aString
	"file out the global pool named aString"
	
	| internalStream |
	internalStream := (String new: 1000) writeStream.
	self new fileOutPool: (self environment at: aString asSymbol) onFileStream: internalStream.

	FileStream writeSourceCodeFrom: internalStream baseName: aString isSt: true.! !

!Class class methodsFor: 'fileIn/Out' stamp: ''!
hasNoDependenciesForMetaclass: aClass in: unprocessedClasses cache: cache 
	| soleInstance |
	soleInstance := aClass soleInstance.
	^ (unprocessedClasses includes: soleInstance) not and: [
				self hasNoSuperclassesOf: soleInstance in: unprocessedClasses cache: cache]! !

!Class class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:04'!
gtExampleClass
	<gtExample>
	^ self! !

!Class class methodsFor: 'fileIn/Out' stamp: ''!
allSuperclassesFor: aClass cache: cache 	
	^ cache at: aClass ifAbsentPut: [aClass allSuperclasses asArray]! !

!ClassAPIHelpBuilder commentStamp: 'tbn 4/30/2010 15:37'!
A builder to build the API Help for a class

Instance Variables
	addMethods:		<Boolean>
	addSubclasses:		<Boolean>
	subclassesAsSeparateTopic:		<Boolean>

addMethods
	- When true the builder will include method help

addSubclasses
	- When true the builder will recursively go through and add subclasses

subclassesAsSeparateTopic
	- xxxxx
!
!ClassAPIHelpBuilder methodsFor: 'initialization' stamp: 'tbn 3/8/2010 16:37'!
initialize
	"Initializes the receiver"
	
	super initialize.
	addSubclasses := false.
	addMethods := true.
	subclassesAsSeparateTopic := true.! !

!ClassAPIHelpBuilder methodsFor: 'accessing' stamp: 'tbn 3/8/2010 16:02'!
addSubclasses
	^ addSubclasses! !

!ClassAPIHelpBuilder methodsFor: 'building' stamp: 'MarcusDenker 11/4/2014 12:03'!
build

	topicToBuild := (HelpTopic named: rootToBuildFrom name).
	topicToBuild icon: (HelpIcons iconNamed: #pageIcon).
	topicToBuild contents: rootToBuildFrom comment.
	
	addMethods ifTrue: [ self buildSubnodesForMethods ].
	addSubclasses	 ifTrue: [ self buildSubnodesForSubclasses ].
	 ! !

!ClassAPIHelpBuilder methodsFor: 'private building' stamp: 'tbn 3/8/2010 16:56'!
buildSubclassTopicFor: aSubclass
	 
	^(self class new) 
			rootToBuildFrom: aSubclass;
			addSubclasses: addSubclasses;
			addMethods: addMethods;
			subclassesAsSeparateTopic: subclassesAsSeparateTopic;
			build;
			topicToBuild 
	 ! !

!ClassAPIHelpBuilder methodsFor: 'accessing' stamp: 'tbn 3/8/2010 16:02'!
addSubclasses: anObject
	addSubclasses := anObject! !

!ClassAPIHelpBuilder methodsFor: 'accessing' stamp: 'tbn 3/8/2010 16:45'!
subclassesAsSeparateTopic: anObject
	subclassesAsSeparateTopic := anObject! !

!ClassAPIHelpBuilder methodsFor: 'private building' stamp: 'MarcusDenker 11/4/2014 12:03'!
buildMethodTopicsOn: topic for: aClass
	|stream methodComment|
	stream := String new writeStream.
	aClass selectors asSortedCollection do:
			[:selector | 		
			  stream 
				 nextPutAll: aClass name;
			    nextPutAll: '>>';
			  	 nextPutAll: selector asString;
				 cr.		

			 (methodComment := (aClass>>selector) comment) ifNil: 
											[methodComment :=  'Method has no comment.' ].
									
			  stream nextPutAll: methodComment;cr;cr.
	].
	topic contents: stream contents.
	
	! !

!ClassAPIHelpBuilder methodsFor: 'accessing' stamp: 'tbn 3/8/2010 16:26'!
addMethods
	^ addMethods! !

!ClassAPIHelpBuilder methodsFor: 'accessing' stamp: 'tbn 3/8/2010 16:26'!
addMethods: anObject
	addMethods := anObject! !

!ClassAPIHelpBuilder methodsFor: 'private building' stamp: 'tbn 3/23/2010 21:40'!
buildSubnodesForSubclasses

	| topic |
	rootToBuildFrom subclasses isEmpty ifTrue: [^self].
	topicToBuild icon: (HelpIcons iconNamed: #bookIcon).
	topic := subclassesAsSeparateTopic 
				ifTrue: [topicToBuild addSubtopic: (HelpTopic named: 'Subclasses')]
				ifFalse: [topicToBuild ].
	rootToBuildFrom subclasses 
		do: [:subclass | topic addSubtopic: (self buildSubclassTopicFor: subclass)].
	topic sortSubtopicsByTitle.

	! !

!ClassAPIHelpBuilder methodsFor: 'private building' stamp: 'tbn 3/23/2010 21:40'!
buildSubnodesForMethods

	| instanceSide classSide |
	instanceSide := HelpTopic named: 'Instance side'.
	classSide := HelpTopic named: 'Class side'.
	topicToBuild icon: (HelpIcons iconNamed: #bookIcon).
	topicToBuild 
		addSubtopic: instanceSide;
		addSubtopic: classSide.
	self buildMethodTopicsOn: instanceSide for: rootToBuildFrom.	
	self buildMethodTopicsOn: classSide for: rootToBuildFrom class.	! !

!ClassAPIHelpBuilder methodsFor: 'accessing' stamp: 'tbn 3/8/2010 16:45'!
subclassesAsSeparateTopic
	^ subclassesAsSeparateTopic! !

!ClassAPIHelpBuilder class methodsFor: 'building' stamp: 'tbn 3/11/2010 23:39'!
buildHierarchicalHelpTopicFrom: aClass withSubclasses: aBoolean withMethods: anotherBoolean
	"Start building from the given class"
	
	^(self new)
		addSubclasses: aBoolean;
		addMethods: anotherBoolean;
		rootToBuildFrom: aClass;
		build;
		topicToBuild ! !

!ClassAPIHelpBuilderTest commentStamp: 'TorstenBergmann 2/4/2014 21:18'!
SUnit tests for ClassAPIHelpBuilder!
!ClassAPIHelpBuilderTest methodsFor: 'testing' stamp: 'tbn 3/8/2010 16:33'!
testDefaultBuilding
	|topic|
	topic := ClassAPIHelpBuilder 
				buildHelpTopicFrom: Integer.				 
	self assert: topic subtopics size = 2.
	self assert: topic subtopics first title = 'Instance side'.
	self assert: topic subtopics last title = 'Class side'
 

 ! !

!ClassAPIHelpBuilderTest methodsFor: 'testing' stamp: 'tbn 3/8/2010 16:32'!
testMethodsButNoSubclasses
	|topic|
	topic := ClassAPIHelpBuilder 
				buildHierarchicalHelpTopicFrom: Integer 
				withSubclasses: false 
				withMethods: true.
	self assert: topic subtopics size = 2.
	self assert: topic subtopics first title = 'Instance side'.
	self assert: topic subtopics last title = 'Class side'
 

 ! !

!ClassAPIHelpBuilderTest methodsFor: 'testing' stamp: 'LaurentLaffont 9/2/2010 15:55'!
testBuildingTraits
	|topic|
	topic := ClassAPIHelpBuilder 
				buildHelpTopicFrom: TSortable .				 
	self assert: topic subtopics size = 2.
	self assert: topic subtopics first title = 'Instance side'.
	self assert: topic subtopics last title = 'Class side'
 

 ! !

!ClassAdded commentStamp: 'cyrilledelaunay 1/18/2011 11:56'!
This announcement will be emitted when a class or a trait is added, using:
	=> Trait >> named: (the notification is done in Trait >> named:uses:category:env:)
	=> Class >> subclass:
	!
!ClassAdded methodsFor: 'accessing' stamp: 'GuillermoPolito 8/1/2012 17:47'!
classAdded: aClass
	classAdded := aClass! !

!ClassAdded methodsFor: 'accessing' stamp: 'GuillermoPolito 8/1/2012 17:51'!
classCategory
	^classCategory! !

!ClassAdded methodsFor: 'accessing' stamp: 'GuillermoPolito 8/1/2012 17:46'!
classAdded
	^classAdded! !

!ClassAdded methodsFor: 'accessing' stamp: 'GuillermoPolito 8/1/2012 17:51'!
classCategory: aClassCategoryName
	classCategory := aClassCategoryName! !

!ClassAdded methodsFor: 'accessing' stamp: 'GuillermoPolito 8/3/2012 13:50'!
classAffected
	^self classAdded! !

!ClassAdded class methodsFor: 'instance creation' stamp: 'GuillermoPolito 8/1/2012 17:52'!
class: aClass category: aClassCategoryName
	^self new
			classAdded: aClass;
			classCategory: aClassCategoryName;
			yourself! !

!ClassAnnouncement commentStamp: 'BenjaminVanRyseghem 1/23/2014 11:53'!
I am an abstract class used to gather all the announcements related to class modifications.!
!ClassCategoryReader commentStamp: '<historical>'!
I represent a mechanism for retrieving class descriptions stored on a file.!
!ClassCategoryReader methodsFor: 'fileIn/Out' stamp: 'al 11/28/2005 22:10'!
scanFrom: aStream 
	"File in methods from the stream, aStream."
	| methodText |
	[methodText := aStream nextChunkText.
	 methodText size > 0]
		whileTrue:
		[class compile: methodText classified: category
			withStamp: changeStamp notifying: nil]! !

!ClassCategoryReader methodsFor: 'private' stamp: '6/5/97 di'!
setClass: aClass category: aCategory changeStamp: aString

	class := aClass.
	category := aCategory.
	changeStamp := aString
! !

!ClassCategoryReader methodsFor: 'private' stamp: '6/5/97 di'!
setClass: aClass category: aCategory
	^ self setClass: aClass category: aCategory changeStamp: String new
! !

!ClassCategoryReader methodsFor: 'private' stamp: 'ajh 1/18/2002 01:14'!
theClass

	^ class! !

!ClassChangeRecord commentStamp: '<historical>'!
A ClassChangeRecorder keeps track of most substantive changes premissible in a project, isolated or not.

Structure:
inForce		a boolean
			Tells whether these changes are in effect.
			true for all changeSets in and above the current project.
			It should be sufficient only to record this for the changeSet
			as a whole, but this redundancy could help in error recovery.
classIsLocal	a boolean
			True if and only if this class is defined in this layer of the
			project structure.
changeTypes an identitySet
			Summarizes which changes have been made in this class.
			Values include #comment, #reorganize, #rename,
			and the four more summarized below.
thisName	a string
			Retains the class name for this layer.
priorName	a string
			Preserves the prior name.
thisComment	a text
			Retains the class comment for this layer.
priorComment	a text
			Preserves the prior comment.
thisOrganization	a classOrganizer
			Retains the class organization for this layer.
priorOrganization	a classOrganizer
			Preserves the prior organization.
thisMD	a methodDictionary
			Used to prepare changes for nearly atomic invocation
			of this layer (see below).
priorMD	a methodDictionary
			Preserves the state of an altered class as it exists in the next
			outer layer of the project structure.
methodChanges		a dictionary of classChangeRecords
			Retains all the method changes for this layer.

Four of the possible changeTypes are maintained in a mutually exclusive set, analogously to MethodChangeRecords.  Here is a simple summary of the relationship between these four changeType symbols and the recording of prior state
			|	prior == nil			|	prior not nil	
	---------	|----------------------------	|--------------------
	add		|	add					|	change
	---------	|----------------------------	|--------------------
	remove	|	addedThenRemoved	|	remove

A classChangeRecorder is notified of changes by the method
		noteMethodChange: <ClassChangeRecord>.
ClassChangeRecorders are designed to invoke a set of changes relative to the definition of a class in an prior layer.  It is important that both invocation and revocation of these changes take place in a nearly atomic fashion so that interdependent changes will be adopted as a whole, and so that only one flush of the method cache should be necessary.  A further reason for revocation to be simple is that it may be requested as an attempt to recover from an error in a project that is failing.!
!ClassChangeRecord methodsFor: 'method changes' stamp: 'di 4/1/2000 23:49'!
methodChanges

	^ methodChanges! !

!ClassChangeRecord methodsFor: 'method changes' stamp: 'di 3/28/2000 10:07'!
changedSelectors
	"Return a set of the changed or removed selectors."

	^ methodChanges keys! !

!ClassChangeRecord methodsFor: 'definition' stamp: 'MarcusDenker 8/9/2014 13:32'!
checkCoherence
	"If I recreate the class then don't remove it"

	(changeTypes includes: #remove)
		ifTrue: [ 
			changeTypes remove: #remove.
			changeTypes add: #change ].
	(changeTypes includes: #addedThenRemoved)
		ifFalse: [ ^ self ].
	changeTypes remove: #addedThenRemoved.
	changeTypes add: #add! !

!ClassChangeRecord methodsFor: 'all changes' stamp: 'nice 1/5/2010 15:59'!
assimilateAllChangesIn: otherRecord

	
	otherRecord isClassRemoval ifTrue: [^ self noteChangeType: #remove].

	otherRecord allChangeTypes do:
		[:chg | self noteChangeType: chg fromClass: self realClass].

	otherRecord methodChanges associationsDo:
		[:assn | | changeType selector changeRecord | selector := assn key. changeRecord := assn value.
		changeType := changeRecord changeType.
		(changeType == #remove or: [changeType == #addedThenRemoved])
			ifTrue:
				[changeType == #addedThenRemoved
					ifTrue: [self atSelector: selector put: #add].
				self noteRemoveSelector: selector priorMethod: nil
						lastMethodInfo: changeRecord methodInfoFromRemoval]
			ifFalse: 
				[self atSelector: selector put: changeType]].
! !

!ClassChangeRecord methodsFor: 'rename' stamp: 'di 3/24/2000 09:38'!
priorName

	^ priorName! !

!ClassChangeRecord methodsFor: 'method changes' stamp: 'ClementBera 7/26/2013 16:09'!
noteNewMethod: newMethod selector: selector priorMethod: methodOrNil
	| methodChange |
	methodChange := self findOrMakeMethodChangeAt: selector priorMethod: methodOrNil.
	methodOrNil 
		ifNil: [ methodChange noteChangeType: #add ]
		ifNotNil: [ methodChange noteChangeType: #change ].! !

!ClassChangeRecord methodsFor: 'initialization' stamp: 'MarcusDenker 12/21/2012 12:01'!
initFor: className

	changeTypes := IdentitySet new.
	methodChanges := IdentityDictionary new.
	priorName := thisName := className.! !

!ClassChangeRecord methodsFor: 'all changes' stamp: 'MarcusDenker 8/25/2010 20:59'!
noteChangeType: changeSymbol fromClass: class

	(changeSymbol = #new or: [changeSymbol = #add]) ifTrue:
		[changeTypes add: #add.
		changeTypes remove: #change ifAbsent: [].
		^ self].
	changeSymbol = #change ifTrue:
		[(changeTypes includes: #add) ifTrue: [^ self].
		^ changeTypes add: changeSymbol].
	changeSymbol == #addedThenRemoved ifTrue:
		[^ self].  "An entire class was added but then removed"
	changeSymbol = #comment ifTrue:
		[^ changeTypes add: changeSymbol].
	changeSymbol = #reorganize ifTrue:
		[^ changeTypes add: changeSymbol].
	changeSymbol = #rename ifTrue:
		[^ changeTypes add: changeSymbol].
	(changeSymbol beginsWith: 'oldName: ') ifTrue:
		["Must only be used when assimilating other changeSets"
		(changeTypes includes: #add) ifTrue: [^ self].
		priorName := changeSymbol copyFrom: 'oldName: ' size + 1 to: changeSymbol size.
		^ changeTypes add: #rename].
	changeSymbol = #remove ifTrue:
		[(changeTypes includes: #add)
			ifTrue: [changeTypes add: #addedThenRemoved]
			ifFalse: [changeTypes add: #remove].
		^ changeTypes removeAllFoundIn: #(add change comment reorganize)].

	self error: 'Unrecognized changeType'! !

!ClassChangeRecord methodsFor: 'method changes' stamp: 'di 3/28/2000 11:01'!
atSelector: selector put: changeType

	(self findOrMakeMethodChangeAt: selector priorMethod: nil)
		noteChangeType: changeType! !

!ClassChangeRecord methodsFor: 'method changes' stamp: 'sw 8/14/2002 11:11'!
removeSelector: selector
	"Remove all memory of changes associated with the argument, selector, in this class."

	selector == #Comment
		ifTrue:
			[changeTypes remove: #comment ifAbsent: []]
		ifFalse:
			[methodChanges removeKey: selector ifAbsent: []]! !

!ClassChangeRecord methodsFor: 'method changes' stamp: 'eem 6/11/2008 16:53'!
methodChangeTypes
	"Return an old-style dictionary of method change types."

	| dict |
	dict := IdentityDictionary new.
	methodChanges associationsDo:
		[:assn | | selector record |
		selector := assn key.
		record := assn value.
		dict at: selector put: record changeType].
	^ dict! !

!ClassChangeRecord methodsFor: 'all changes' stamp: 'MarcusDenker 8/25/2010 21:02'!
allChangeTypes
	| chgs |
	(priorName notNil and: [ changeTypes includes: #rename ])
		ifTrue: [ 
			(chgs := changeTypes copy) add: 'oldName: ' , priorName.
			^ chgs ].
	^ changeTypes! !

!ClassChangeRecord methodsFor: 'method changes' stamp: 'di 3/23/2000 23:00'!
noteRemoveSelector: selector priorMethod: priorMethod lastMethodInfo: infoOrNil

	| methodChange |
	methodChange := self findOrMakeMethodChangeAt: selector priorMethod: priorMethod.
	methodChange changeType == #add
		ifTrue: [methodChange noteChangeType: #addedThenRemoved]
		ifFalse: [methodChange noteChangeType: #remove].

	infoOrNil ifNotNil:
		["Save the source code pointer and category so can still browse old versions"
		methodChange noteMethodInfoFromRemoval: infoOrNil]

! !

!ClassChangeRecord methodsFor: 'all changes' stamp: 'di 3/24/2000 09:36'!
includesChangeType: changeType

	changeType == #new ifTrue: [^ changeTypes includes: #add].  "Backwd compat"
	^ changeTypes includes: changeType! !

!ClassChangeRecord methodsFor: 'rename' stamp: 'di 5/8/2000 20:39'!
noteNewName: newName

	thisName := newName! !

!ClassChangeRecord methodsFor: 'all changes' stamp: 'di 3/28/2000 15:14'!
noteChangeType: changeSymbol

	^ self noteChangeType: changeSymbol fromClass: nil! !

!ClassChangeRecord methodsFor: 'isolation layers' stamp: 'lr 3/14/2010 21:13'!
realClass
	"Return the actual class (or meta), as determined from my name."

	thisName ifNil: [ ^ nil ].
	(thisName endsWith: ' class')
		ifTrue: [ ^ (Smalltalk globals at: (thisName copyFrom: 1 to: thisName size - 6) asSymbol ifAbsent: [ ^ nil ]) class ]
		ifFalse: [ ^ Smalltalk globals at: thisName ifAbsent: [ ^ nil ] ]! !

!ClassChangeRecord methodsFor: 'method changes' stamp: 'di 3/28/2000 10:38'!
atSelector: selector ifAbsent: absentBlock

	^ (methodChanges at: selector ifAbsent: absentBlock)
		changeType! !

!ClassChangeRecord methodsFor: 'method changes' stamp: 'MarcusDenker 8/25/2010 20:54'!
findOrMakeMethodChangeAt: selector priorMethod: priorMethod 
	^methodChanges at: selector
		ifAbsentPut: [MethodChangeRecord new]! !

!ClassChangeRecord methodsFor: 'definition' stamp: 'di 3/27/2000 22:08'!
notePriorDefinition: oldClass

	oldClass ifNil: [^ self].
	priorDefinition ifNil: [priorDefinition := oldClass definition]! !

!ClassChangeRecord methodsFor: 'all changes' stamp: 'di 5/16/2000 08:43'!
trimHistory
	"Drop non-essential history."

	"Forget methods added and later removed"
	methodChanges keysAndValuesRemove:
		[:sel :chgRecord | chgRecord changeType == #addedThenRemoved].

	"Forget renaming and reorganization of newly-added classes."
	(changeTypes includes: #add) ifTrue:
		[changeTypes removeAllFoundIn: #(rename reorganize)].
! !

!ClassChangeRecord methodsFor: 'definition' stamp: 'di 3/28/2000 09:12'!
priorDefinition

	^ priorDefinition! !

!ClassChangeRecord methodsFor: 'removal' stamp: 'MarcusDenker 8/9/2014 13:33'!
forgetChangesIn: otherRecord
	"See forgetAllChangesFoundIn:.  Used in culling changeSets."

	| cls otherMethodChanges |
	(cls := self realClass) ifNil: [ ^ self ].	"We can do better now, though..."
	otherMethodChanges := otherRecord methodChangeTypes.
	otherMethodChanges
		associationsDo: [ :assoc | 
			| selector actionToSubtract |
			selector := assoc key.
			actionToSubtract := assoc value.
			(cls includesSelector: selector)
				ifTrue: [ 
					(#(#add #change) includes: actionToSubtract)
						ifTrue: [ methodChanges removeKey: selector ifAbsent: [  ] ] ]
				ifFalse: [ 
					(#(#remove #addedThenRemoved) includes: actionToSubtract)
						ifTrue: [ methodChanges removeKey: selector ifAbsent: [  ] ] ] ].
	changeTypes isEmpty
		ifTrue: [ ^ self ].
	changeTypes removeAllFoundIn: otherRecord allChangeTypes.
	(changeTypes includes: #rename)
		ifFalse: [ changeTypes removeAllSuchThat: [ :x | x beginsWith: 'oldName: ' ] ]! !

!ClassChangeRecord methodsFor: 'all changes' stamp: 'di 3/28/2000 10:59'!
hasNoChanges

	^ changeTypes isEmpty and: [methodChanges isEmpty]! !

!ClassChangeRecord methodsFor: 'rename' stamp: 'tk 6/8/2001 09:11'!
thisName

	^ thisName! !

!ClassChangeRecord methodsFor: 'removal' stamp: 'di 4/1/2000 23:05'!
isClassRemoval
	"NOTE: there are other removals with changeType #addedThenRemoved,
	but this message is used to write out removals in fileOut, and those
	cases should not be written out."

	^ (changeTypes includes: #remove) or: [changeTypes includes: #removeClass]! !

!ClassCommentDeclaration commentStamp: '<historical>'!
I represent the declaration of a class comment in a file.  My contents are the class comment to import, and the comment reader is the object who knows the class where to put the class comment.

Sending me the message #import makes me install the comment into the class.!
!ClassCommentDeclaration methodsFor: 'importing' stamp: 'GuillermoPolito 5/5/2012 20:41'!
import
	(self existsBehavior)
		ifFalse: [ self error: ('Cannot install comment in unexistent behavior {1}' format: { behaviorName asString } ) ].
	
	^self targetClass theNonMetaClass
						classComment: contents
						stamp: stamp! !

!ClassCommentDeclaration methodsFor: 'accessing' stamp: 'GuillermoPolito 5/5/2012 20:37'!
stamp: classCommentStamp
	stamp := classCommentStamp! !

!ClassCommentDeclaration class methodsFor: 'instance creation' stamp: 'GuillermoPolito 5/5/2012 21:04'!
contents: someContents behaviorName: behaviorName isMeta: aBoolean stamp: stamp
	^self new
			contents: someContents;
			behaviorName: behaviorName;
			isMeta: aBoolean;
			stamp: stamp;
			yourself! !

!ClassCommentReader commentStamp: 'TorstenBergmann 2/4/2014 21:42'!
I represent a mechanism for retrieving class comment stored on a file.!
!ClassCommentReader methodsFor: 'fileIn/Out' stamp: 'sw 7/31/2002 10:40'!
scanFrom: aStream 
	"File in the class comment from aStream.  Not string-i-fied, just a text, exactly as it is in the browser.  Move to changes file."

	class theNonMetaClass classComment: (aStream nextChunkText) stamp: changeStamp
		"Writes it on the disk and saves a RemoteString ref"! !

!ClassCommentReader class methodsFor: 'instance creation' stamp: 'AndrewBlack 9/1/2009 06:42'!
forClass: aClass
	^ self new setClass: aClass category: #Comment ! !

!ClassCommented commentStamp: '<historical>'!
This announcement will be emitted when a class or a trait comment changes!
!ClassCommented methodsFor: 'accessing' stamp: 'GuillermoPolito 8/1/2012 23:55'!
oldComment: andOldComment
	oldComment := andOldComment! !

!ClassCommented methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:13'!
newComment
	^newComment! !

!ClassCommented methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:13'!
classCommented
	^classCommented! !

!ClassCommented methodsFor: 'accessing' stamp: 'GuillermoPolito 8/1/2012 23:55'!
classCommented: aClass
	classCommented := aClass! !

!ClassCommented methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:13'!
newStamp
	^newStamp! !

!ClassCommented methodsFor: 'accessing' stamp: 'GuillermoPolito 8/1/2012 23:55'!
oldStamp: anOldStamp
	oldStamp := anOldStamp! !

!ClassCommented methodsFor: 'accessing' stamp: 'GuillermoPolito 8/1/2012 23:55'!
newComment: aNewComment
	newComment := aNewComment! !

!ClassCommented methodsFor: 'accessing' stamp: 'MartinDias 11/8/2013 12:58'!
oldComment
	^ oldComment! !

!ClassCommented methodsFor: 'accessing' stamp: 'GuillermoPolito 8/3/2012 13:51'!
classAffected
	^self classCommented! !

!ClassCommented methodsFor: 'accessing' stamp: 'GuillermoPolito 8/1/2012 23:54'!
newStamp: aNewStamp
	newStamp := aNewStamp! !

!ClassCommented methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:14'!
oldStamp
	oldStamp! !

!ClassCommented class methodsFor: 'instance creation' stamp: 'GuillermoPolito 8/1/2012 23:51'!
class: aClass oldComment: oldComment newComment: newComment oldStamp: oldStamp newStamp: newStamp
	^self new
			classCommented: aClass;
			oldComment: oldComment;
			oldStamp: oldStamp;
			newComment: newComment;
			newStamp: newStamp;
			yourself! !

!ClassCommented class methodsFor: 'instance creation' stamp: 'GuillermoPolito 8/1/2012 23:53'!
classCommented: aClass
	self flag: #fixMePlease. "nils? no way!! "
	^self class: aClass oldComment: nil newComment: nil oldStamp: nil newStamp: nil! !

!ClassDefinitionAcceptor commentStamp: '<historical>'!
I am an acceptor in the case a class definition has been entered.
My action is then to compile the definition as a class object!
!ClassDefinitionAcceptor methodsFor: 'private' stamp: 'NicolaiHess 11/13/2014 16:26'!
isClassDefinitionExpression: aSource
	[ RBParser parseExpression: aSource ]
		on: Error
		do: [ ^ false ].
	^ true! !

!ClassDefinitionAcceptor methodsFor: 'private' stamp: 'NicolaiHess 11/13/2014 16:34'!
notifyNoClassDefintion
	"if this was not a class definition, the user has tried to
	define a method without selecting a class"

	^ UIManager default alert: 'No class selected'! !

!ClassDefinitionAcceptor methodsFor: 'protocol' stamp: 'MarcusDenker 11/20/2014 10:59'!
accept: aText notifying: aController

	(self isClassDefinitionExpression: aText)
		ifFalse: [ ^ self notifyNoClassDefintion ].
		
	self model compileAClassFrom: aText notifying: aController! !

!ClassDescription commentStamp: '<historical>'!
I add a number of facilities to basic Behaviors:
	Named instance variables
	Category organization for methods
	The notion of a name of this class (implemented as subclass responsibility)
	The maintenance of a ChangeSet, and logging changes on a file
	Most of the mechanism for fileOut.
	
I am an abstract class, in particular, my facilities are intended for inheritance by two subclasses, Class and Metaclass.!
!ClassDescription methodsFor: 'printing' stamp: ''!
instanceVariablesString
	"Answer a string of my instance variable names separated by spaces."

	^String streamContents: [ :stream |
		self instVarNames 
			do: [ :each | stream nextPutAll: each ]
			separatedBy: [ stream space ] ]! !

!ClassDescription methodsFor: 'accessing comment' stamp: ''!
comment: aStringOrText
	"Set the receiver's comment to be the argument, aStringOrText."

	self instanceSide classComment: aStringOrText.! !

!ClassDescription methodsFor: 'organization updating' stamp: ''!
notifyOfRecategorizedSelector: selector from: oldCategory to: newCategory
	"If compiled method is not there, it meens it has been removed, not recategorized... so I skip 
	 the method recategorized announce"
	(self compiledMethodAt: selector ifAbsent: [ nil ]) 
		ifNotNil: [ :method | 
			SystemAnnouncer uniqueInstance 
				methodRecategorized: method
				oldProtocol: oldCategory ].
	SystemAnnouncer uniqueInstance suspendAllWhile: [
		self 
			notifyUsersOfRecategorizedSelector: selector 
			from: oldCategory 
			to: newCategory ]! !

!ClassDescription methodsFor: 'filein/out' stamp: ''!
fileOutCategory: catName 

	| internalStream |
	internalStream := (String new: 1000) writeStream.
	internalStream header; timeStamp.
	self fileOutCategory: catName on: internalStream moveSource: false toFile: 0.
	internalStream trailer.

	^ FileStream writeSourceCodeFrom: internalStream baseName: (self name , '-' , catName) isSt: true.! !

!ClassDescription methodsFor: 'initialize-release' stamp: ''!
updateInstancesFrom: oldClass
	"Recreate any existing instances of the argument, oldClass, as instances of 
	the receiver, which is a newly changed class. Permute variables as 
	necessary. Return the array of old instances (none of which should be
	pointed to legally by anyone but the array)."
	"ar 7/15/1999: The updating below is possibly dangerous. If there are any
	contexts having an old instance as receiver it might crash the system if
	the new receiver in which the context is executed has a different layout.
	See bottom below for a simple example:"
	| oldInstances |
	oldInstances := oldClass allInstances asArray.
	oldInstances := self updateInstances: oldInstances from: oldClass isMeta: self isMeta.
	^oldInstances

"	| crashingBlock class |
	class := Object subclass: #CrashTestDummy
		instanceVariableNames: 'instVar'
		classVariableNames: ''
		poolDictionaries: ''
		category: 'Crash-Test'.
	class compile:'instVar: value instVar := value'.
	class compile:'crashingBlock ^[instVar]'.
	crashingBlock := (class new) instVar: 42; crashingBlock.
	Object subclass: #CrashTestDummy
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: 'Crash-Test'.
	crashingBlock.
	crashingBlock value.
	"
! !

!ClassDescription methodsFor: 'filein/out' stamp: ''!
fileOutCategory: aSymbol on: aFileStream moveSource: moveSource toFile: fileIndex 
	"File a description of the receiver's category, aString, onto aFileStream. If 
	moveSource, is true, then set the method source pointer to the new file position.
	Note when this method is called with moveSource=true, it is condensing the
	.sources file, and should only write one preamble per method category."

	| selectors |
	aFileStream cr.
	selectors := self selectorsToFileOutCategory: aSymbol.

	"Overridden to preserve author stamps in sources file regardless"
	selectors do: [:sel |
		self printMethodChunk: sel 
			withPreamble: true
			on: aFileStream 
			moveSource: moveSource 
			toFile: fileIndex].
	^ self! !

!ClassDescription methodsFor: 'instance variables' stamp: ''!
instVarNames
	"Answer an Array of the receiver's instance variable names."

	self instanceVariables
		ifNil: [^#()]
		ifNotNil: [^self instanceVariables]! !

!ClassDescription methodsFor: '*FuelTests' stamp: ''!
duringTestCompileSilently: code
	^ self 
		duringTestCompileSilently: code 
		storeSource: true! !

!ClassDescription methodsFor: '*rpackage-core' stamp: ''!
packageOrganizer
	"Returns the organizer of this class"
	^ RPackage organizer ! !

!ClassDescription methodsFor: 'accessing' stamp: 'ST 6/18/2013 16:34'!
instanceVariables
	^instanceVariables.! !

!ClassDescription methodsFor: 'filein/out' stamp: ''!
printCategoryChunk: category on: aFileStream withStamp: changeStamp priorMethod: priorMethod 
	"Print a method category preamble.  This must have a category name.
	It may have an author/date stamp, and it may have a prior source link.
	If it has a prior source link, it MUST have a stamp, even if it is empty."

"The current design is that changeStamps and prior source links are preserved in the changes file.  All fileOuts include changeStamps.  Condensing sources, however, eliminates all stamps (and links, natch)."

	aFileStream cr; nextPut: $!!.
	aFileStream nextChunkPut: (String streamContents:
		[:strm |
		strm nextPutAll: self name; nextPutAll: ' methodsFor: '; print: category asString.
		(changeStamp ~~ nil and:
			[changeStamp size > 0 or: [priorMethod ~~ nil]]) ifTrue:
			[strm nextPutAll: ' stamp: '; print: changeStamp].
		priorMethod ~~ nil ifTrue:
			[strm nextPutAll: ' prior: '; print: priorMethod sourcePointer]]).
	! !

!ClassDescription methodsFor: 'testing' stamp: ''!
isTestCase
	^false! !

!ClassDescription methodsFor: 'accessing class hierarchy' stamp: ''!
classesThatImplementAllOf: selectorSet
	"Return an array of any classes that implement all the messages in selectorSet."

	| found remaining |
	found := OrderedCollection new.
	selectorSet do:
		[:sel | (self includesSelector: sel) ifTrue: [found add: sel]].
	found isEmpty
		ifTrue: [^ self subclasses inject: Array new
						into: [:subsThatDo :sub |
							subsThatDo , (sub classesThatImplementAllOf: selectorSet)]]
		ifFalse: [remaining := selectorSet copyWithoutAll: found.
				remaining isEmpty ifTrue: [^ Array with: self].
				^ self subclasses inject: Array new
						into: [:subsThatDo :sub |
							subsThatDo , (sub classesThatImplementAllOf: remaining)]]! !

!ClassDescription methodsFor: 'compiling' stamp: ''!
compileSilently: code classified: category
	"Compile the code and classify the resulting method in the given category, leaving no trail in the system log, nor in any change set, nor in the 'recent submissions' list. This should only be used when you know for sure that the compilation will succeed."

	^ self compileSilently: code classified: category notifying: nil.! !

!ClassDescription methodsFor: '*NautilusRefactoring' stamp: ''!
codeRewritingClass: aBuilder
	| target |
	target := aBuilder model.
	
	(aBuilder item: #'Rewrite Code')
		action: [ target refactor rewriteCode ];
		parent: #'Code Rewriting';
		order: 0.

	(aBuilder item: #'Search Code')
		action: [ target refactor searchCode ];
		parent: #'Code Rewriting';
		order: 100.
		
	(aBuilder item: #'Type class')
		action: [ target refactor typeClass ];
		parent: #'Code Rewriting';
		order: 200;
		withSeparatorAfter.
		
	(aBuilder item: #'Category Regex')
		action: [ target refactor categoryRegex ];
		parent: #'Code Rewriting';
		order: 300.
		
	(aBuilder item: #'Class Regex')
		action: [ target refactor classRegex ];
		parent: #'Code Rewriting';
		order: 400.
		
	(aBuilder item: #'Protocol Regex')
		action: [ target refactor protocolRegex ];
		parent: #'Code Rewriting';
		order: 500.
		
	(aBuilder item: #'Source Regex')
		action: [ target refactor sourceRegex ];
		parent: #'Code Rewriting';
		order: 600;
		withSeparatorAfter.! !

!ClassDescription methodsFor: 'slots' stamp: ''!
definesSlotNamed: aString
	"Return true whether the receiver defines an instance variable named aString."
	
	^ self slotNames includes: aString! !

!ClassDescription methodsFor: 'filein/out' stamp: ''!
fileOutOn: aFileStream 
	"File a description of the receiver on aFileStream."

	self fileOutOn: aFileStream
		moveSource: false
		toFile: 0! !

!ClassDescription methodsFor: '*NautilusRefactoring' stamp: ''!
renameMethodAllItem: aBuilder

	^ (aBuilder item: #'Rename method (all)')
			keyText: 'r, m' if: Nautilus useOldStyleKeys not;
			keyText: 'r' if: Nautilus useOldStyleKeys;
			action: [ | target |
				target := aBuilder model.
				"scroll := target methodWidget vScrollValue."
				target refactor renameMethodFor: target selectedMethod originMethod.
				"target methodWidget vScrollValue: scroll"
				 ].! !

!ClassDescription methodsFor: 'printing' stamp: ''!
slotDefinitionString
	"Answer a string that contains an executable description of my Slots"

	"^self slots ifNotEmpty: [self slots asString] ifEmpty: ['{}']"
	
	^String streamContents: [ :str | | special |
		str nextPutAll: '{ '.
		self slots do: [:slot |
				str nextPutAll: slot definitionString.
				special := slot isSpecial]				
			separatedBy: [ 
				str nextPutAll: '. '.  
				special ifTrue: [ str cr;tab;tab;tab;tab ]].
		str nextPutAll: ' }'. ]
! !

!ClassDescription methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/12/2013 14:45'!
theNonMetaClass
	^self baseClass! !

!ClassDescription methodsFor: 'slots' stamp: 'maxmattone 1/26/2015 11:37'!
slotNamed: aName ifFound: foundBlock ifNone: exceptionBlock
	^self layout resolveSlot: aName asSymbol ifFound: foundBlock ifNone: exceptionBlock! !

!ClassDescription methodsFor: 'initialize-release' stamp: ''!
updateInstances: oldInstances from: oldClass isMeta: isMeta
	"Recreate any existing instances of the argument, oldClass, as instances of the receiver, which is a newly changed class. Permute variables as necessary. Return the array of old instances (none of which should be pointed to legally by anyone but the array)."

	"If there are any contexts having an old instance as receiver it might crash the system because the layout has changed, and the method only knows about the old layout."

	| variable instSize newInstances |
	oldInstances isEmpty
		ifTrue: [ ^ #() ].	"no instances to convert"
	isMeta
		ifTrue: [ 
			oldInstances size = 1
				ifFalse: [ ^ self error: 'Metaclasses can only have one instance' ].
			self soleInstance class == self
				ifTrue: [ ^ self error: 'Metaclasses can only have one instance' ] ].
	variable := self isVariable.
	instSize := self instSize.
	newInstances := Array new: oldInstances size.
	1 to: oldInstances size do: [ :i | newInstances at: i put: (self newInstanceFrom: (oldInstances at: i) variable: variable size: instSize) ].	"Now perform a bulk mutation of old instances into new ones"
	oldInstances elementsExchangeIdentityWith: newInstances.
	^ newInstances	"which are now old"! !

!ClassDescription methodsFor: 'organization' stamp: ''!
zapOrganization
	"Remove the organization of this class by message categories.
	This is typically done to save space in small systems.  Classes and methods
	created or filed in subsequently will, nonetheless, be organized"

	self organization: nil.
	self isClassSide ifFalse: [self classSide zapOrganization]! !

!ClassDescription methodsFor: 'private' stamp: ''!
newInstanceFrom: oldInstance variable: variable size: instSize
	"Create a new instance of the receiver based on the given old instance.
	The supplied map contains a mapping of the old instVar names into
	the receiver's instVars"

	| new  value |
	variable
		ifTrue: [ new := self basicNew: oldInstance basicSize ]
		ifFalse: [ new := self basicNew ].
		
	"Slot migration happens there"		
	self allSlots
		do: [ :newSlot | 
			oldInstance class
				slotNamed: newSlot name
				ifFound: [ :oldSlot | 
					value := oldSlot read: oldInstance.
					newSlot write: value to: new ] ].
	variable
		ifTrue: [ 1 to: oldInstance basicSize do: [ :offset | new basicAt: offset put: (oldInstance basicAt: offset) ] ].
	^ new! !

!ClassDescription methodsFor: 'initialize-release' stamp: ''!
superclass: aClass methodDictionary: mDict format: fmt
	"Basic initialization of the receiver"
	super superclass: aClass methodDictionary: mDict format: fmt.
	self instanceVariables: nil.
	self organization: nil.! !

!ClassDescription methodsFor: 'organization' stamp: ''!
organization
	"Answer the instance of ClassOrganizer that represents the organization 
	of the messages of the receiver."

	self basicOrganization
		ifNil: [ self basicOrganization: (self isTrait
						ifTrue: [ ClassOrganization new ]
						ifFalse: [ ClassOrganization forClass: self ]) ].
	^self basicOrganization setSubject: self.	"Making sure that subject is set correctly. It should not be necessary."
	
	! !

!ClassDescription methodsFor: '*Nautilus' stamp: 'CamilleTeruel 7/29/2014 12:36'!
buildAnalyzeSubMenu: aBuilder

	| target |
	target := aBuilder model.
	
	(aBuilder item: #'Inst var references...')
		action: [target browseInstVarRefs];
		parent: #Analyze;
		order: 0.

	(aBuilder item: #'Inst var assignments...')
		action: [target browseInstVarDefs];
		parent: #Analyze;
		order: 100.
	
	(aBuilder item: #'Create initializer with inst vars...')
		action: [ target createInitializerWithInstVars ];
		parent: #Analyze;
		order: 300;
		enabledBlock: [ target showInstance ].
	
	(aBuilder item: #'Generate initialize method')
		keyText: 'h, i' if: Nautilus useOldStyleKeys not;
		keyText: 'I' if: Nautilus useOldStyleKeys;
		action: [ target generateInitialize ];
		parent: #Analyze;
		order: 350.
		
	(aBuilder item: #'Force the generaton of the initialize method')
		keyText: 'h, k' if: Nautilus useOldStyleKeys not;
		keyText: 'K' if: Nautilus useOldStyleKeys;		
		action: [ target forceGenerateInitialize ];
		parent: #Analyze;
		order: 375;
		enabledBlock: [ target showInstance ];
		withSeparatorAfter.
		
	(aBuilder item: #'Class var refs...')
		action: [target browseClassVarRefs];
		parent: #Analyze;
		order: 400.
		
	(aBuilder item: #'Class refs...')
		keyText: 'b, N' if: Nautilus useOldStyleKeys not;
		keyText: 'N' if: Nautilus useOldStyleKeys;
		action: [target browseClassRefs];
		parent: #Analyze;
		order: 500.

	(target selectedClass inheritsFrom: SharedPool )
		ifTrue: [ 
			(aBuilder item: #'Shared Pool Users')
				action: [ target systemNavigation browseSharedPoolUsersOf: target selectedClass ];
				parent: #Analyze;
				enabledBlock: [ target enableSingleClassSelection ];
				order: 700].
				
	(aBuilder item: #'Unsent methods...')
		action: [target browseUnusedMethods.];
		parent: #Analyze;
		order: 800.
		
	(aBuilder item: #'Unreferenced inst vars...')
		action: [target showUnreferencedInstVars.];
		parent: #Analyze;
		order: 900.
		
	(aBuilder item: #'Unreferenced class vars...')
		action: [target showUnreferencedClassVars.];
		parent: #Analyze;
		order: 1000.
	
	! !

!ClassDescription methodsFor: '*GT-Inspector-Examples' stamp: ''!
gtExamples

	^	self examplesProvider gtExamples! !

!ClassDescription methodsFor: 'accessing method dictionary' stamp: ''!
addSelector: selector withMethod: compiledMethod notifying: requestor
	| priorMethodOrNil oldProtocol |
	priorMethodOrNil := self compiledMethodAt: selector ifAbsent: [nil].
	oldProtocol := priorMethodOrNil ifNotNil: [ priorMethodOrNil protocol ].
	self addSelectorSilently: selector withMethod: compiledMethod.
	priorMethodOrNil 
		ifNil: [SystemAnnouncer uniqueInstance methodAdded: compiledMethod ]
		ifNotNil: [SystemAnnouncer uniqueInstance methodChangedFrom: priorMethodOrNil to: compiledMethod oldProtocol: oldProtocol ].! !

!ClassDescription methodsFor: 'accessing' stamp: 'ST 6/18/2013 16:34'!
instanceVariables: anObject
	instanceVariables := anObject! !

!ClassDescription methodsFor: 'accessing parallel hierarchy' stamp: ''!
isClassSide
	^self == self classSide! !

!ClassDescription methodsFor: 'accessing method dictionary' stamp: ''!
allProtocolsUpTo: mostGenericClass
	"Answer a list of all the method protocols of the receiver and all its superclasses, up through mostGenericClass"

	| otherClassCategories thisClassCategories lowercaseSortBlock  |
		
	otherClassCategories := OrderedCollection new.
	lowercaseSortBlock  := [ :a :b | a asLowercase <= b asLowercase ].
	
	(self allSuperclassesIncluding: mostGenericClass) do: [ :aClass | 
		 otherClassCategories addAll: aClass organization categories ].
	otherClassCategories remove: 'no messages' ifAbsent: [  ].
	thisClassCategories := self organization categories sorted: lowercaseSortBlock.
													
	^ thisClassCategories , ((otherClassCategories asSet removeAllSuchThat: [ :each |
								thisClassCategories includes: each ]) sorted: lowercaseSortBlock)! !

!ClassDescription methodsFor: 'compiling' stamp: ''!
compile: code notifying: requestor 
	"Refer to the comment in Behavior|compile:notifying:." 

	^self compile: code
		 classified: Protocol unclassified
		 notifying: requestor! !

!ClassDescription methodsFor: 'accessing method dictionary' stamp: ''!
noteAddedSelector: aSelector meta: isMeta
	"A hook allowing some classes to react to adding of certain selectors"! !

!ClassDescription methodsFor: '*System-Support' stamp: ''!
allUnreferencedClassVariables
	"Answer a list of the names of all the receiver's unreferenced class vars, including those defined in superclasses"

	^ self systemNavigation allUnreferencedClassVariablesOf: self! !

!ClassDescription methodsFor: 'organization updating' stamp: ''!
updateOrganizationDescription: each oldCategory: newCategoryOrNil newCategory: oldCategoryOrNil changed: changedCategories
	| sel effectiveCategory currentCategory |
	
	sel := each selector.
	(self includesLocalSelector: sel) ifTrue: [ ^ self ].
	
	currentCategory := self organization categoryOfElement: sel.
	effectiveCategory := each 
		effectiveMethodCategoryCurrent: currentCategory 
		new: newCategoryOrNil.
	
	effectiveCategory 
		ifNil: [ 
			currentCategory ifNotNil: [ changedCategories add: currentCategory ].
			self organization removeElement: sel.
			^ self ].
		
	(currentCategory isNil 
		or: [ currentCategory == Protocol ambiguous 
		or: [ currentCategory == oldCategoryOrNil ] ])
	ifFalse: [ ^ self ].
	
	(currentCategory ~~ effectiveCategory)
		ifTrue: [ 
			currentCategory ifNotNil: [ changedCategories add: currentCategory ].
			self organization classify: sel under: effectiveCategory suppressIfDefault: false ]! !

!ClassDescription methodsFor: 'instance variables' stamp: 'StephaneDucasse 8/27/2010 11:04'!
addInstVarNamed: aString 
	"Add the argument, aString, as one of the receiver's instance variables."

	self subclassResponsibility! !

!ClassDescription methodsFor: 'slots' stamp: 'maxmattone 1/26/2015 11:37'!
slotNamed: aName ifFound: foundBlock
	^self slotNamed: aName ifFound: foundBlock ifNone: [ "do nothing" ]! !

!ClassDescription methodsFor: '*Slot' stamp: 'MartinDias 7/11/2013 16:01'!
superclass: aSuperclass withLayoutType: layoutType slots: slotArray
	| superLayout newScope newLayout |
	superLayout := aSuperclass
						ifNil: [ EmptyLayout instance ]
						ifNotNil: [ aSuperclass layout ].
	newScope := superLayout slotScope extend: slotArray.
	newLayout := layoutType extending: superLayout scope: newScope host: self.
	newLayout checkSanity.
	self
		superclass: aSuperclass
		layout: newLayout! !

!ClassDescription methodsFor: 'copying' stamp: ''!
copyCategory: cat from: class 
	"Specify that one of the categories of messages for the receiver is cat, as 
	found in the class, class. Copy each message found in this category."

	self copyCategory: cat
		from: class
		classified: cat! !

!ClassDescription methodsFor: 'accessing comment' stamp: ''!
classCommentBlank

	| existingComment stream |
	existingComment := self theNonMetaClass organization classComment.
	existingComment isEmpty
		ifFalse: [^existingComment].

	stream := (String new: 100) writeStream.
	
	stream nextPutAll: 'Please comment me using the following template inspired by Class Responsibility Collaborator (CRC) design:

For the Class part:  State the name of the class with one line description: For example, I''m xxx the root of the hierarchy of visitor objects.

For the Responsibility part: Three sentences about my main responsibility, what I''m doing, what services do I offer.

For the Collaborators Part: State my main collaborators and one line about how I interact with them. 

Public API and Key Messages

- message one   
- message two 
- what is the way to create instances is a plus.

   One simple example is simply gorgeous.
 
Internal Representation and Key Implementation Points.'.
			
	(self instVarNames size > 0)
		 ifTrue: [stream cr; cr; nextPutAll: '    Instance Variables'.  ].
		
	self instVarNames asSortedCollection do: [:each |
		stream
			cr; tab; nextPutAll: each;
			nextPut: $:;
			tab; tab;
			nextPutAll: '<Object>'].
	stream cr.
stream cr; cr; nextPutAll: '    Implementation Points'.
	^stream contents! !

!ClassDescription methodsFor: '*NautilusRefactoring' stamp: 'MarkRizun 7/20/2014 20:54'!
methodRefactoring: aBuilder
	| target selectedMethod selectedMethods |

	target := aBuilder model.
	selectedMethod := target selectedMethod.
	selectedMethods := target selectedMethods.
	selectedMethod ifNil:[ ^ target ].
	
	(aBuilder item: #'Add a parameter')
		action: [ target refactor addAParameterFor: selectedMethod ];
		order: 50;
		parent: #'Refactoring'.
	
	(aBuilder item: #'Deprecate')
		action: [ target refactor deprecateMethodFor: selectedMethod ];
		order: 75;
		parent: #'Refactoring'.
			
	(aBuilder item: #'Inline parameter')
		action: [ target refactor inlineParameterFor: selectedMethod ];
		order: 100;
		parent: #'Refactoring'.
			
	(aBuilder item: #'Inline target sends')
		action: [ target refactor inlineAllSendersFor: selectedMethod ];
		order: 200;
		parent: #'Refactoring'.
			
	(aBuilder item: #'Move')
		action: [ target refactor moveMethodFor: selectedMethod ];
		order: 300;
		parent: #'Refactoring'.
			
	(aBuilder item: #'Swap')
		action: [ target refactor swapMethodFor: selectedMethods ];
		order: 400;
		label: (target selectedClass isMeta
					ifTrue: [ 'Move to instance side' ]
					ifFalse:[ 'Move to class side']);
		parent: #'Refactoring'.
		
	(aBuilder item: #'Push up')
		action: [ target refactor pullUpMethodsFor: selectedMethods ];
		order: 500;
		parent: #'Refactoring'.
			
	(aBuilder item: #'Push down')
		action: [ target refactor pushDownMethodsFor: selectedMethods ];
		order: 600;
		parent: #'Refactoring'.
			
	(aBuilder item: #'Remove')
		action: [ target refactor removeMethodsFor: selectedMethods ];
		order: 700;
		parent: #'Refactoring'.
		
	(aBuilder item: #'Remove parameter')
		action: [ target refactor removeParameterFor: selectedMethod ];
		order: 800;
		enabledBlock: [ selectedMethods size < 2 ];
		parent: #'Refactoring'.
			
	(self renameMethodAllItem: aBuilder)
		order: 850;
		parent: #'Refactoring';
		withSeparatorAfter.
				
	(aBuilder item: #'Undo')
		order: 900;
		label: target refactor undoLabel;
		action: [ target refactor undoOperation ];
		enabled: target refactor undoEnabled;
		parent: #'Refactoring'.
	
	(aBuilder item: #'Redo')
		order: 1000;
		label: target refactor redoLabel;
		action: [ target refactor redoOperation ];
		enabled: target refactor redoEnabled;
		parent: #'Refactoring';
		withSeparatorAfter.! !

!ClassDescription methodsFor: '*NautilusRefactoring' stamp: 'SebastianTleye 8/13/2013 14:25'!
refactoringMenu: aBuilder
	| target |
	
	target := aBuilder model.
	
	(aBuilder item: #'Refactoring')
			order: -100.
	
	(aBuilder item: #'Rename inst var')
			action: [ target refactor renameInstVarFrom: self ];
			order: -98.
				
	(aBuilder item: #'Rename class var')
			action: [ target refactor renameClassVarFrom: self ];
			order: -97.
		
	(aBuilder item: #'Code Rewriting')
			order: 0;
			parent: #'Refactoring'.
			
	(aBuilder item: #'Class Refactoring')
			order: 100;
			parent: #'Refactoring';
			withSeparatorAfter.
			
	(aBuilder item: #'Class Var Refactoring')
			order: 200;
			parent: #'Refactoring'.
			
	(aBuilder item: #'Inst Var Refactoring')
			order: 300;
			parent: #'Refactoring';
			withSeparatorAfter.
		
	(aBuilder item: #'Undo')
			order: 400;
			label: target refactor undoLabel;
			action: [ target refactor undoOperation ];
			enabled: target refactor undoEnabled;
			parent: #'Refactoring'.
	
	(aBuilder item: #'Redo')
			order: 500;
			label: target refactor redoLabel;
			action: [ target refactor redoOperation ];
			enabled: target refactor redoEnabled;
			parent: #'Refactoring';
			withSeparatorAfter.! !

!ClassDescription methodsFor: '*NautilusRefactoring' stamp: ''!
groupRefactoring: aBuilder
	| target |
	target := aBuilder model.
	
	(aBuilder item: #'Rewrite Code')
		order:  100;
		withSeparatorAfter.
	
	(aBuilder item: #'Rewrite Code')
		action: [ target refactor rewriteCode ];
		parent: #'Rewrite Code';
		order: 0.

	(aBuilder item: #'Search Code')
		action: [ target refactor searchCode ];
		parent: #'Rewrite Code';
		order: 100.! !

!ClassDescription methodsFor: 'organization updating' stamp: ''!
noteMethodChanged: oldMethod to: newMethod
	self flag: #todo. "oldProtocol is not set properly here"
	SystemAnnouncer uniqueInstance methodChangedFrom: oldMethod to: newMethod oldProtocol: Protocol unclassified! !

!ClassDescription methodsFor: 'filein/out' stamp: ''!
methodsFor: categoryName 
	"Answer a ClassCategoryReader for compiling the messages in the category, categoryName, of the receiver."

	^ ClassCategoryReader new setClass: self category: categoryName asSymbol

	"(False methodsFor: 'logical operations') inspect"! !

!ClassDescription methodsFor: 'instance variables' stamp: ''!
classThatDefinesInstanceVariable: instVarName
	(self instVarNames notNil and: [self instVarNames includes: instVarName asString]) ifTrue: [^ self]. 
	^self superclass ifNotNil: [self superclass classThatDefinesInstanceVariable: instVarName]! !

!ClassDescription methodsFor: 'filein/out' stamp: ''!
fileOutChangedMessages: aSet on: aFileStream 
	"File a description of the messages of the receiver that have been 
	changed (i.e., are entered into the argument, aSet) onto aFileStream."

	self fileOutChangedMessages: aSet
		on: aFileStream
		moveSource: false
		toFile: 0! !

!ClassDescription methodsFor: 'accessing comment' stamp: ''!
hasComment
	"return whether this class truly has a comment other than the default"
	| org |
	org := self instanceSide organization.
	^org classComment isEmptyOrNil not! !

!ClassDescription methodsFor: '*NautilusRefactoring' stamp: ''!
sourceCodeRefactoring: aBuilder
	| target |
	target := aBuilder model.
	
	(aBuilder item: #'Create cascade')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor createCascadeBetween: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 0.
			
	(aBuilder item: #'Extract method')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor extractBetween: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 100.
			
	(aBuilder item: #'Extract method to component')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor extractToComponentBetween: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 200.
		
	(aBuilder item: #'Extract to temporary')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor extractToTemporaryBetween: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 300.
			
	(aBuilder item: #'Inline method')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor inlineMethodBetween: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 400.
			
	(aBuilder item: #'Inline method from component')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor inlineMethodFromComponentBetween: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 500.
			
	(aBuilder item: #'Inline temporary')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor inlineTemporaryBetween: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 600.
			
	(aBuilder item: #'Move variable definition')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor moveVariableDefinitionBetween: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 700.
				
	(aBuilder item: #'Rename temporary')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor renameTemporaryNamed: target sourceTextArea selectedContents Between: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 800.	
						
	(aBuilder item: #'Split cascade')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor splitCascadeBetween: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 900.	
					
	(aBuilder item: #'Temporary to instvar')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor temporaryToInstanceVariableNamed: target sourceTextArea selectedContents asString Between: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 1000;
			withSeparatorAfter.
			
		(aBuilder item: #'Undo')
			order: 1100;
			label: target refactor undoLabel;
			action: [ target refactor undoOperation ];
			enabled: target refactor undoEnabled;
			parent: #'Source code refactoring'.
	
	(aBuilder item: #'Redo')
			order: 1200;
			label: target refactor redoLabel;
			action: [ target refactor redoOperation ];
			enabled: target refactor redoEnabled;
			parent: #'Source code refactoring';
			withSeparatorAfter.! !

!ClassDescription methodsFor: 'printing' stamp: ''!
classVariablesString
	"Answer a string of my class variable names separated by spaces."

	^String streamContents: [ :stream | 
		self classVarNames 
			do: [ :each | stream nextPutAll: each ]
			separatedBy: [ stream space ] ]! !

!ClassDescription methodsFor: 'instance variables' stamp: ''!
hasInstVarNamed: aString
	"Return true whether the receiver defines an instance variable named aString."
	
	^ self instVarNames includes: aString! !

!ClassDescription methodsFor: 'accessing method dictionary' stamp: 'CamilleTeruel 9/4/2014 16:50'!
addAndClassifySelector: selector withMethod: compiledMethod inProtocol: category notifying: requestor
	| priorMethodOrNil priorOriginOrNil oldProtocol newProtocol |
	
	priorMethodOrNil := self 
		compiledMethodAt: selector 
		ifAbsent: [ nil ].
	priorMethodOrNil ifNotNil: [ priorOriginOrNil := priorMethodOrNil origin ].
	
	self addSelectorSilently: selector withMethod: compiledMethod.
	
	oldProtocol := self organization categoryOfElement: selector.
	SystemAnnouncer uniqueInstance suspendAllWhile: [ 
		self organization 
			classify: selector 
			under: (category = Protocol unclassified 
				ifTrue: [ oldProtocol ]
				ifFalse: [ category ]) ].
	newProtocol := self organization categoryOfElement: selector.
	
	(priorMethodOrNil isNil or: [ priorOriginOrNil ~= compiledMethod origin ])
		ifTrue: [ SystemAnnouncer uniqueInstance methodAdded: compiledMethod ]
		ifFalse: [ 
			"If protocol changed and someone is from different package, I need to throw a method recategorized"
			self
				notifyRepackage: selector
				method: compiledMethod
				oldProtocol: oldProtocol
				newProtocol: newProtocol.	
					
			SystemAnnouncer uniqueInstance
				methodChangedFrom: priorMethodOrNil
				to: compiledMethod
				oldProtocol: oldProtocol ]! !

!ClassDescription methodsFor: '*rpackage-core' stamp: ''!
isExtended

	^ self extendingPackages isEmpty! !

!ClassDescription methodsFor: 'organization updating' stamp: ''!
applyChangesOfNewTraitCompositionReplacing: oldComposition
	| changedSelectors oldMethodDict |
	oldMethodDict := self methodDict copy.
	changedSelectors := super applyChangesOfNewTraitCompositionReplacing: oldComposition.
	self noteRecategorizedSelectors: changedSelectors oldComposition: oldComposition.
	self noteChangesFrom: oldMethodDict.
	^ changedSelectors.! !

!ClassDescription methodsFor: '*rpackage-core' stamp: ''!
packages
	"the extending packages of a class are the packages that extend it."
	
	^  self extendingPackages asSet copy add: self package; yourself! !

!ClassDescription methodsFor: '*Manifest-Core' stamp: ''!
manifestBuilderForRuleChecker: aRuleChecker
	"Return the manifestsince the rulechecker is keeping a cache, we ask it back"

	^ aRuleChecker manifestBuilderOfClass: self! !

!ClassDescription methodsFor: 'organization' stamp: 'EstebanLorenzano 6/27/2013 17:10'!
basicOrganization: aClassOrg
	organization := aClassOrg! !

!ClassDescription methodsFor: '*NautilusRefactoring' stamp: 'NicolaiHess 8/4/2014 23:57'!
instVarRefactoring: aBuilder
	| target |
	target := aBuilder model.
	
	(aBuilder item: #'Add')
		action: [ target refactor addInstVarFrom: self ];
		parent: #'Inst Var Refactoring';
		order: 0.
		
	(aBuilder item: #'Rename')
		action: [ target refactor renameInstVarFrom: self ];
		parent: #'Inst Var Refactoring';
		order: 100.
	
	(aBuilder item: #'Remove')
		action: [ target refactor removeInstVarFrom: self ];
		parent: #'Inst Var Refactoring';
		icon: (Smalltalk ui icons iconNamed: #removeIcon);
		order: 200;
		withSeparatorAfter.
		
	(aBuilder item: #'Abstract')
		action: [ target refactor abstractInstVarFrom: self ];
		parent: #'Inst Var Refactoring';
		order: 300.
		
	(aBuilder item: #'Accessors')
		action: [ target refactor accessorsInstVarFrom: self ];
		parent: #'Inst Var Refactoring';
		order: 400.
		
	(aBuilder item: #'Move to class')
		action: [ target refactor moveInstVarToClass: self ];
		parent: #'Inst Var Refactoring';
		order: 450.
	
	(aBuilder item: #'Pull up')
		action: [ target refactor pullUpInstVarFrom: self ];
		parent: #'Inst Var Refactoring';
		order: 500.
	
	(aBuilder item: #'Push down')
		action: [ target refactor pushDownInstVarFrom: self ];
		parent: #'Inst Var Refactoring';
		order: 600.! !

!ClassDescription methodsFor: 'slots' stamp: ''!
usesSpecialSlot
	"retirn true if we define something else than InstanceVariableSlots"
	^self slots anySatisfy: [ :each | each isSpecial ]! !

!ClassDescription methodsFor: 'printing' stamp: ''!
printOn: aStream 
	aStream nextPutAll: self name! !

!ClassDescription methodsFor: 'slots' stamp: 'MarcusDenker 7/3/2014 09:55'!
slotNamed: aName
	^self layout resolveSlot: aName asSymbol! !

!ClassDescription methodsFor: 'compiling' stamp: ''!
compileSilently: code classified: category notifying: requestor
	"Compile the code and classify the resulting method in the given category, leaving no trail in the system log, nor in any change set, nor in the 'recent submissions' list. This should only be used when you know for sure that the compilation will succeed."

	^ SystemAnnouncer uniqueInstance 
		suspendAllWhile: [self compile: code classified: category notifying: requestor].! !

!ClassDescription methodsFor: 'organization updating' stamp: ''!
noteRecategorizedSelectors: aCollection oldComposition: aTraitComposition
	
	aCollection do: [:each | | oldCategory newCategory | 
		oldCategory := self organization categoryOfElement: each.
		newCategory := (self traitComposition methodDescriptionForSelector: each) effectiveMethodCategory.
		self noteRecategorizedSelector: each from: oldCategory to: newCategory]! !

!ClassDescription methodsFor: '*rpackage-core' stamp: ''!
definedSelectors
	^ self package definedSelectorsForClass: self! !

!ClassDescription methodsFor: '*GT-Inspector-Examples' stamp: ''!
gtInspectorExamplesIn: composite
	"This provides a list of example objects for the current class"
	<gtInspectorPresentationOrder: 20>
	<gtInspectorTag: #examples>
	|exampleProvider|

	exampleProvider := self examplesProvider.
	(exampleProvider gtDisplayExamplesIn: composite)
			"when: [ self exampleProvider rootExamples notEmpty ];"
			morphicSelectionAct: [ :list | 
					list rawSelection methodReference browse ] 
				icon: GLMUIThemeExtraIcons glamorousBrowse 
				on: $b 
				entitled: 'Browse source'
! !

!ClassDescription methodsFor: 'slots' stamp: ''!
hasSlot: aSlot
	"Return true whether the receivers hierarchy defines an instance variable named aString."
	
	^ self allSlots identityIncludes: aSlot! !

!ClassDescription methodsFor: 'organization updating' stamp: ''!
noteMethodAdded: aMethod
	SystemAnnouncer uniqueInstance
		methodAdded: aMethod! !

!ClassDescription methodsFor: 'accessing class hierarchy' stamp: ''!
subclassesDo: aBlock
	"Evaluate the argument, aBlock, for each of the receiver's immediate subclasses."
	^self subclasses do: aBlock! !

!ClassDescription methodsFor: 'filein/out' stamp: 'ClementBera 9/27/2013 17:45'!
definition
	"Answer a String that defines the receiver."

	| aStream |
	aStream := (String new: 800) writeStream.
	superclass 
		ifNil: [aStream nextPutAll: 'ProtoObject']
		ifNotNil: [aStream nextPutAll: superclass name].
	aStream nextPutAll: self kindOfSubclass;
			store: self name.
	(self hasTraitComposition) ifTrue: [
		aStream cr; tab; nextPutAll: 'uses: ';
			nextPutAll: self traitCompositionString].
	aStream cr; tab; nextPutAll: 'instanceVariableNames: ';
			store: self instanceVariablesString.
	aStream cr; tab; nextPutAll: 'classVariableNames: ';
			store: self classVariablesString.
	aStream cr; tab; nextPutAll: 'poolDictionaries: ';
			store: self sharedPoolsString.
	aStream cr; tab; nextPutAll: 'category: ';
			store: self category asString.

	superclass ifNil: [ 
		aStream nextPutAll: '.'; cr.
		aStream nextPutAll: self name.
		aStream space; nextPutAll: 'superclass: nil'. ].

	^ aStream contents! !

!ClassDescription methodsFor: 'instance variables' stamp: ''!
forceNewFrom: anArray
    "Create a new instance of the class and fill
    its instance variables up with the array."
    | object max |

    object := self new.
    max := self instSize.
    anArray doWithIndex: [:each :index |
        index > max ifFalse:
            [object instVarAt: index put: each]].
    ^ object! !

!ClassDescription methodsFor: 'printing' stamp: ''!
storeOn: aStream
	"Classes and Metaclasses have global names."

	aStream nextPutAll: self name! !

!ClassDescription methodsFor: 'organization updating' stamp: ''!
noteMethodRemoved: oldMethod
	self flag: #todo. "protocol and origin are not set properly here"
	SystemAnnouncer uniqueInstance methodRemoved: oldMethod protocol: oldMethod protocol origin: oldMethod origin! !

!ClassDescription methodsFor: 'instance variables' stamp: ''!
instVarNameForIndex: index
	"Answer the named instance variable with index index or nil if none."

	| superInstSize |
	index > self instSize ifTrue: [^nil].
	superInstSize := self superclass ifNil: [0] ifNotNil: [self superclass instSize].
	index > superInstSize ifTrue:
		[^self instanceVariables at: index - superInstSize].
	self superclass ifNil: [^nil].
	^self superclass instVarNameForIndex: index

	"(Object allSubclasses select:
		[:cls| cls instSize > cls superclass instSize and: [cls subclasses isEmpty and: [cls superclass instSize > 0]]]) collect:
			[:cls| (1 to: cls instSize) collect: [:i| cls instVarNameForIndex: i]]"! !

!ClassDescription methodsFor: 'accessing class hierarchy' stamp: ''!
commentInventory
	"Answer a string with a count of the classes with and without comments 
	for all the classes in the package of which this class is a member."

	"Morph commentInventory"

	^ self environment organization commentInventory: (self category copyUpTo: $-), '*'! !

!ClassDescription methodsFor: 'accessing method dictionary' stamp: ''!
removeProtocol: aString 
	"Remove each of the messages categorized under aString in the method 
	dictionary of the receiver. Then remove the category aString."
	| categoryName |
	categoryName := aString asSymbol.
	(self organization listAtCategoryNamed: categoryName) do:
		[:sel | self removeSelector: sel].
	self organization removeCategory: categoryName! !

!ClassDescription methodsFor: 'compiling' stamp: ''!
compile: text classified: category withStamp: changeStamp notifying: requestor logSource: logSource
 
	| method selector |

	method := self compiler
		source: text;
		requestor: requestor;
		category: category;
		failBlock:  [ ^nil ];
		compile.
	
	selector := method selector.
	logSource ifTrue: [
		self 
			logMethodSource: (requestor ifNotNil: [ :r | r text ] ifNil: [ text ]) "the requestor text might have been changed by the compiler and may be different thant text argument"
			forMethod: method
			inCategory: category 
			withStamp: changeStamp].
		
	self 
		addAndClassifySelector: selector 
		withMethod: method 
		inProtocol: category 
		notifying: requestor.
			
	self instanceSide 
		noteCompilationOf: selector 
		meta: self isClassSide.

	^ selector! !

!ClassDescription methodsFor: '*FuelTests' stamp: ''!
duringTestCompileSilently: code storeSource: storeSource
	^ self
		duringTestCompileSilently: code
		storeSource: storeSource
		classified: ''! !

!ClassDescription methodsFor: 'private' stamp: ''!
newInstanceFrom: oldInstance variable: variable size: instSize map: map
	"Create a new instance of the receiver based on the given old instance.
	The supplied map contains a mapping of the old instVar names into
	the receiver's instVars"
	| new |
	variable
		ifTrue: [new := self basicNew: oldInstance basicSize]
		ifFalse: [new := self basicNew].
	1 to: instSize do: 
		[:offset |  (map at: offset) > 0 ifTrue:
			[new instVarAt: offset
					put: (oldInstance instVarAt: (map at: offset))]].
	variable 
		ifTrue: [1 to: oldInstance basicSize do: 
					[:offset |
					new basicAt: offset put: (oldInstance basicAt: offset)]].
	^new! !

!ClassDescription methodsFor: 'pool variable' stamp: ''!
allSharedPools
	"Answer an ordered collection  of the shared pools the receiver shares, including those defined  in the superclasses of the receiver."
	
	^ OrderedCollection new! !

!ClassDescription methodsFor: 'compiling' stamp: ''!
wantsChangeSetLogging
	"Answer whether code submitted for the receiver should be remembered by the changeSet mechanism."

	^ true! !

!ClassDescription methodsFor: 'filein/out' stamp: ''!
moveChangesTo: newFile 
	"Used in the process of condensing changes, this message requests that 
	the source code of all methods of the receiver that have been changed 
	should be moved to newFile."

	| changes |
	changes := self selectors select: [:sel | (self compiledMethodAt: sel) fileIndex > 1 ].
	self
		fileOutChangedMessages: changes
		on: newFile
		moveSource: true
		toFile: 2! !

!ClassDescription methodsFor: 'private' stamp: ''!
linesOfCode 
	"An approximate measure of lines of code.
	Includes comments, but excludes blank lines."
	| lines |
	lines := self localMethods inject: 0 into: [:sum :each | sum + each linesOfCode]. 
	^ self isMeta 
		ifTrue: [lines]
		ifFalse: [lines + self class linesOfCode]! !

!ClassDescription methodsFor: 'compiling' stamp: ''!
compile: text classified: category notifying: requestor
	| stamp |
	stamp := self acceptsLoggingOfCompilation
		ifTrue: [ Author changeStamp ]
		ifFalse: [ nil ].
	^ self
		compile: text
		classified: category
		withStamp: stamp
		notifying: requestor! !

!ClassDescription methodsFor: 'printing' stamp: ''!
sharedPoolsString
	"Answer a string of my shared pool names separated by spaces."

	^String streamContents: [ :stream |
		self sharedPools 
			do: [ :each |
				stream nextPutAll: (self environment 
					keyAtIdentityValue: each 
					ifAbsent: [ 
						each isObsolete
							ifTrue: [ each name ] "obsolete classes should be visible"
							ifFalse: [ 'private' ] ]) ] "if class is from different environment, mark it as private"
			separatedBy: [ stream space ] ]! !

!ClassDescription methodsFor: 'organization updating' stamp: 'SebastianTleye 7/12/2013 16:46'!
updateOrganizationSelector: aSymbol oldCategory: oldCategoryOrNil newCategory: newCategoryOrNil
	| changedCategories composition |
	changedCategories := IdentitySet new.
	
	composition := self hasTraitComposition
		ifTrue: [ self traitComposition ]
		ifFalse: [ TraitComposition new ].
		
	(composition methodDescriptionsForSelector: aSymbol)
		do: [ :each | 
			self
				updateOrganizationDescription: each
				oldCategory: oldCategoryOrNil
				newCategory: newCategoryOrNil
				changedCategories: changedCategories ].
	^ changedCategories! !

!ClassDescription methodsFor: 'filein/out' stamp: ''!
selectorsToFileOutCategory: aSymbol
	^ self organization listAtCategoryNamed: aSymbol! !

!ClassDescription methodsFor: '*NautilusRefactoring' stamp: 'SebastianTleye 8/13/2013 14:20'!
varRefactoringSubMenu: aBuilder
	| target | 
	target := aBuilder model.
	
	(aBuilder item: #'Add')
		action: [ target refactor addClassVarFrom: self  ];
		parent: #'Class Var Refactoring';
		order: 0.
		
	(aBuilder item: #'Rename')
		action: [ target refactor renameClassVarFrom: self ];
		parent: #'Class Var Refactoring';
		order: 100.
	
	(aBuilder item: #'Remove')
		action: [ target refactor removeClassVarFrom: self ];
		parent: #'Class Var Refactoring';
		icon: (Smalltalk ui icons iconNamed: #removeIcon);
		order: 200;
		withSeparatorAfter.
		
	(aBuilder item: #'Abstract')
		action: [ target refactor abstractClassVarFrom: self ];
		parent: #'Class Var Refactoring';
		order: 300.
	
	(aBuilder item: #'Accessors')
		action: [ target refactor accessorsClassVarFrom: self ];
		parent: #'Class Var Refactoring';
		order: 400.
		
	(aBuilder item: #'Pull up')
		action: [ target refactor pullUpClassVarFrom: self ];
		parent: #'Class Var Refactoring';
		order: 500.
	
	(aBuilder item: #'Push down')
		action: [ target refactor pushDownClassVarFrom: self ];
		parent: #'Class Var Refactoring';
		order: 600.! !

!ClassDescription methodsFor: 'users notification' stamp: ''!
notifyUsersOfRecategorizedSelector: element from: oldCategory to: newCategory
	self traitUsers do: [:each |
		each noteRecategorizedSelector: element from: oldCategory to: newCategory]! !

!ClassDescription methodsFor: 'organization' stamp: ''!
addCategory: newName before: aCategory

	^ self organization addCategory: newName before: aCategory ! !

!ClassDescription methodsFor: '*NautilusRefactoring' stamp: ''!
refactoringMethod: aBuilder

	(aBuilder item: #'Refactoring')
		order: -100.
			
	(self renameMethodAllItem: aBuilder)
		order: -90;
		withSeparatorAfter! !

!ClassDescription methodsFor: '*NautilusRefactoring' stamp: ''!
sourceCodeRefactoringMenu: aBuilder
	| target |
	target := aBuilder model.
	
	(aBuilder item: #'Format')
		order: 1100;
		keyText: 'Shift f';
		action: [ target refactor formatSourceCode ].
		
	(aBuilder item: #'Source code refactoring')
			order: 1101;
			arguments: {};
			withSeparatorAfter.! !

!ClassDescription methodsFor: 'compiling' stamp: ''!
noteCompilationOf: aSelector meta: isMeta
	"A hook allowing some classes to react to recompilation of certain selectors"! !

!ClassDescription methodsFor: '*GT-Inspector-Examples' stamp: ''!
examplesProvider

	^ GTExampleProvider on: self! !

!ClassDescription methodsFor: 'accessing method dictionary' stamp: ''!
allSelectorsInProtocol: aName 
	"Answer a list of all the methods of the receiver and all its 
	superclasses that are in the protocol named aName"
	
	| aColl |
	aColl := OrderedCollection new.
	self withAllSuperclasses do: [:aClass | 
		aColl addAll: (aClass organization listAtCategoryNamed: aName) ].
	^ aColl asSet asArray sort! !

!ClassDescription methodsFor: '*rpackage-core' stamp: ''!
packagesWithoutExtensions
	^ Set new add: self package; yourself.! !

!ClassDescription methodsFor: 'instance variables' stamp: ''!
instVarIndexFor: instVarName ifAbsent: aBlock
	"Answer the index of the named instance variable."

	| index |
	index := self instanceVariables == nil 
			ifTrue: [0]
			ifFalse: [self instanceVariables indexOf: instVarName ifAbsent: [0]].
	index = 0 ifTrue: 
		[^self superclass == nil 
			ifTrue: [aBlock value]
			ifFalse: [self superclass instVarIndexFor: instVarName ifAbsent: aBlock]].
	^self superclass == nil 	
		ifTrue: [index]
		ifFalse: [index + self superclass instSize]! !

!ClassDescription methodsFor: 'copying' stamp: ''!
copyCategory: cat from: aClass classified: newCat 
	"Specify that one of the categories of messages for the receiver is the 
	third argument, newCat. Copy each message found in the category cat in 
	class aClass into this new category."

	self copyAll: (aClass organization listAtCategoryNamed: cat)
		from: aClass
		classified: newCat! !

!ClassDescription methodsFor: 'slots' stamp: 'MarcusDenker 1/26/2015 15:37'!
slots
	^self layout visibleSlots! !

!ClassDescription methodsFor: '*Nautilus' stamp: ''!
definitionForNautilusWithSlots

	^ self definition! !

!ClassDescription methodsFor: 'organization' stamp: ''!
whichCategoryIncludesSelector: aSelector 
	"Answer the category of the argument, aSelector, in the organization of 
	the receiver, or answer nil if the receiver does not inlcude this selector."

	(self includesSelector: aSelector)
		ifTrue: [^ self organization categoryOfElement: aSelector]
		ifFalse: [^nil]! !

!ClassDescription methodsFor: 'accessing comment' stamp: ''!
comment
	"Answer the receiver's comment. (If missing, supply a template) "
	| aString |
	aString := self instanceSide organization classComment.
	aString isEmpty ifFalse: [^ aString].
	^self classCommentBlank! !

!ClassDescription methodsFor: 'pool variable' stamp: ''!
usesLocalPoolVarNamed: aString
	^false.! !

!ClassDescription methodsFor: 'filein/out' stamp: ''!
classComment: aString stamp: aStamp
	"Store the comment, aString or Text or RemoteString, associated with the class we are organizing.  Empty string gets stored only if had a non-empty one before."

	| pointer header file oldCommentRemoteString oldComment oldStamp |
	oldComment := self organization classComment.
	oldStamp := self organization commentStamp.

	(aString isKindOf: RemoteString) ifTrue: [
		SystemAnnouncer uniqueInstance 
			class: self 
			oldComment: oldComment 
			newComment: aString string 
			oldStamp: oldStamp 
			newStamp: aStamp.
		^ self organization classComment: aString stamp: aStamp].

	oldCommentRemoteString := self organization commentRemoteString.
	(aString size = 0) & (oldCommentRemoteString isNil) ifTrue: [^ self organization classComment: nil].
		"never had a class comment, no need to write empty string out"

	pointer := oldCommentRemoteString 
			ifNil: [0] 
			ifNotNil: [oldCommentRemoteString sourcePointer].
	
	(file := SourceFiles at: 2) ifNotNil: [
		file setToEnd; cr; nextPut: $!!.	"directly"
		"Should be saying (file command: 'H3') for HTML, but ignoring it here"
		header := String streamContents: [:strm | strm nextPutAll: self name;
			nextPutAll: ' commentStamp: '.
			aStamp storeOn: strm.
			strm nextPutAll: ' prior: '; nextPutAll: pointer printString].
		file nextChunkPut: header].
	
	self organization 
		classComment: (RemoteString newString: aString onFileNumber: 2) 
		stamp: aStamp.
	
	SystemAnnouncer uniqueInstance 
		class: self 
		oldComment: oldComment 
		newComment: aString 
		oldStamp: oldStamp 
		newStamp: aStamp! !

!ClassDescription methodsFor: '*rpackage-core' stamp: ''!
package
	^ RPackage organizer packageOf: self.	! !

!ClassDescription methodsFor: 'accessing class hierarchy' stamp: ''!
printSubclassesOn: aStream level: level 
	"As part of the algorithm for printing a description of the receiver, print the
	subclass on the file stream, aStream, indenting level times."

	| subclassNames |
	aStream crtab: level.
	aStream nextPutAll: self name.
	aStream space; print: self instVarNames.
	self == Class
		ifTrue: 
			[aStream crtab: level + 1; nextPutAll: '[ ... all the Metaclasses ... ]'.
			^self].
	subclassNames := self subclasses asSortedCollection:[:c1 :c2| c1 name <= c2 name].
	"Print subclasses in alphabetical order"
	subclassNames do:
		[:subclass | subclass printSubclassesOn: aStream level: level + 1]! !

!ClassDescription methodsFor: 'copying' stamp: ''!
copyAll: selArray from: class 
	"Install all the methods found in the method dictionary of the second 
	argument, class, as the receiver's methods. Classify the messages under 
	-As yet not classified-."

	self copyAll: selArray
		from: class
		classified: nil! !

!ClassDescription methodsFor: 'accessing method dictionary' stamp: ''!
uncategorizedSelectors
	^ self selectorsInProtocol: Protocol unclassified! !

!ClassDescription methodsFor: 'compiling' stamp: ''!
compile: code classified: heading 
	"Compile the argument, code, as source code in the context of the 
	receiver and install the result in the receiver's method dictionary under 
	the classification indicated by the second argument, heading. nil is to be 
	notified if an error occurs. The argument code is either a string or an 
	object that converts to a string or a PositionableStream on an object that 
	converts to a string."

	^self
		compile: code
		classified: heading
		notifying: nil! !

!ClassDescription methodsFor: 'compiling' stamp: ''!
instVarNamesAndOffsetsDo: aBinaryBlock
	"This is part of the interface between the compiler and a class's instance or field names.
	 The class should enumerate aBinaryBlock with the instance variable name strings and
	 their integer offsets.  The order is important. Names evaluated later will override the
	 same names occurring earlier."

	| superInstSize |
	(superInstSize := self superclass notNil ifTrue: [self superclass instSize] ifFalse: [0]) > 0 ifTrue:
		[self superclass instVarNamesAndOffsetsDo: aBinaryBlock].
	1 to: self instSize - superInstSize do:
		[:i| aBinaryBlock value: (self instanceVariables at: i) value: i + superInstSize]! !

!ClassDescription methodsFor: 'accessing comment' stamp: ''!
comment: aStringOrText stamp: aStamp
	"Set the receiver's comment to be the argument, aStringOrText."

	self instanceSide classComment: aStringOrText stamp: aStamp.! !

!ClassDescription methodsFor: 'private' stamp: ''!
instVarMappingFrom: oldClass
	"Return the mapping from instVars of oldClass to new class that is used for converting old instances of oldClass."
	| oldInstVarNames |
	oldInstVarNames := oldClass allInstVarNames.
	^self allInstVarNames 
			collect: [:instVarName | oldInstVarNames indexOf: instVarName].! !

!ClassDescription methodsFor: '*NautilusCommon' stamp: ''!
correspondingForTest
	"Return the unit test that correspond to me. If it does not exist, it returns myself. 
	 Return the tested class if sent to a class"
	
	| className |
	className := (self inheritsFrom: TestCase)
		ifTrue: [ self name copyReplaceAll: 'Test' with: '' ]
		ifFalse: [ self name, 'Test' ].
	^ Smalltalk 
		at: className asSymbol 
		ifAbsent: [ self ]
	! !

!ClassDescription methodsFor: 'accessing method dictionary' stamp: ''!
removeSelector: selector 
	"Remove the message whose selector is given from the method 
	dictionary of the receiver, if it is there. Answer nil otherwise."
	
	| priorMethod priorProtocol origin | 
	priorMethod := self compiledMethodAt: selector ifAbsent: [^ nil].
	origin := priorMethod origin.
	priorProtocol := self whichCategoryIncludesSelector: selector.
	super removeSelector: selector.
	SystemAnnouncer uniqueInstance 
		suspendAllWhile: [self updateOrganizationSelector: selector oldCategory: priorProtocol newCategory: nil].
	SystemAnnouncer uniqueInstance methodRemoved: priorMethod protocol: priorProtocol origin: origin! !

!ClassDescription methodsFor: 'initialize-release' stamp: ''!
obsolete
	"Make the receiver obsolete."
	self superclass removeSubclass: self.
	self organization: nil.
	super obsolete.! !

!ClassDescription methodsFor: 'private' stamp: ''!
errorCategoryName
	self error: 'Category name must be a String'! !

!ClassDescription methodsFor: '*NautilusRefactoring' stamp: ''!
packageRefactoringMenu: aBuilder
	| target |
	target := aBuilder model.
	
	(aBuilder item: #'Rewrite Code')
		order:  100;
		withSeparatorAfter.
	
	(aBuilder item: #'Rewrite Code')
		action: [ target refactor rewriteCode ];
		parent: #'Rewrite Code';
		order: 0.

	(aBuilder item: #'Search Code')
		action: [ target refactor searchCode ];
		parent: #'Rewrite Code';
		order: 100.! !

!ClassDescription methodsFor: 'organization updating' stamp: ''!
noteRecategorizedSelector: aSymbol from: oldCategoryOrNil to: newCategoryOrNil
	| changedCategories |
	changedCategories := self updateOrganizationSelector: aSymbol oldCategory: oldCategoryOrNil newCategory: newCategoryOrNil.
	changedCategories do: [:each |
		(self organization isEmptyCategoryNamed: each) ifTrue: [self organization removeCategory: each]]! !

!ClassDescription methodsFor: 'organization' stamp: ''!
organization: aClassOrg
	"Install an instance of ClassOrganizer that represents the organization of the messages of the receiver."

	aClassOrg ifNotNil: [aClassOrg setSubject: self].
	self basicOrganization: aClassOrg.! !

!ClassDescription methodsFor: 'instance variables' stamp: ''!
instVarIndexFor: instVarName
	"Answer the index of the named instance variable."

	^self instVarIndexFor: instVarName ifAbsent: 0! !

!ClassDescription methodsFor: 'accessing parallel hierarchy' stamp: 'MarcusDenker 9/9/2013 09:27'!
baseClass
	^self subclassResponsibility.! !

!ClassDescription methodsFor: '*Manifest-Core' stamp: ''!
criticClass
	"Return the class of the receiver for the critic browser. This behavior may be folded later by changing the name of this method or using another one."
	
	^ self! !

!ClassDescription methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/17/2013 13:16'!
classClass
	^self subclassResponsibility.! !

!ClassDescription methodsFor: '*Nautilus' stamp: ''!
definitionForNautilus

	^ self definition! !

!ClassDescription methodsFor: 'slots' stamp: ''!
allSlotsEverywhere
	"Answer the set of slots used by the receiver, all superclasses, and all subclasses"

	| aList |
	aList := OrderedCollection new.
	(self allSuperclasses , self withAllSubclasses asOrderedCollection) do:
		[:cls | aList addAll: cls slots].
	^ aList asSet! !

!ClassDescription methodsFor: 'accessing method dictionary' stamp: ''!
selectorsInCategory: aName 
	"Answer a list of the selectors of the receiver that are in category named aName"
	
	| aColl |
	aColl := Set withAll: (self organization listAtCategoryNamed: aName).
	^ aColl asArray sort! !

!ClassDescription methodsFor: '*GT-InspectorExtensions-Core' stamp: ''!
gtInspectorUsersIn: composite
	<gtInspectorPresentationOrder: 30>
	composite list 	
		title: 'Users';
		when: [ self isTrait ];
		display: [ 
			self traitUsers asArray
			"Smalltalk allClasses select: [ :class |
			   class traitComposition traits includes: self ]" ]! !

!ClassDescription methodsFor: 'filein/out' stamp: ''!
fileOutMethod: selector on: aStream
	
	(selector == #Comment) ifTrue: [^ self inform: 'Sorry, cannot file out class comment in isolation.'].
	(self includesSelector: selector) ifFalse: [^ self error: 'Selector ', selector asString, ' not found'].
	aStream header; timeStamp.
	self printMethodChunk: selector withPreamble: true
		on: aStream moveSource: false toFile: 0.! !

!ClassDescription methodsFor: '*rpackage-core' stamp: ''!
extensionSelectors
	^ self extendingPackages flatCollect: [ :each | each extensionSelectorsForClass: self ]! !

!ClassDescription methodsFor: '*Manifest-Core' stamp: ''!
mcWorkingCopy
	MCWorkingCopy managersForClass:  self do: [: package | ^ package ]! !

!ClassDescription methodsFor: 'slots' stamp: 'MarcusDenker 2/9/2015 15:04'!
allSlots
	^self layout allVisibleSlots! !

!ClassDescription methodsFor: '*Glamour-Morphic-Brick' stamp: ''!
slotsDictionary
	^ self isTrait 
		ifTrue: [ Dictionary new ]
		ifFalse: [ self layout slotsDictionary ]! !

!ClassDescription methodsFor: 'authors' stamp: ''!
authors
	"Returns a bag representing the author frequency based on the latest version of the methods of the receiver."

	^(self methods, self class methods) collect: [ :each | each author ] as: Bag .
	
	! !

!ClassDescription methodsFor: 'organization' stamp: ''!
reorganize
	"During fileIn, !!Rectangle reorganize!! allows Rectangle to seize control and treat the next chunk as its organization.  See the transfer of control where ReadWriteStream fileIn calls scanFrom:"

	^self organization! !

!ClassDescription methodsFor: 'copying' stamp: ''!
copyAllCategoriesFrom: aClass 
	"Specify that the categories of messages for the receiver include all of 
	those found in the class, aClass. Install each of the messages found in 
	these categories into the method dictionary of the receiver, classified 
	under the appropriate categories."

	aClass organization categories do: [:cat | self copyCategory: cat from: aClass]! !

!ClassDescription methodsFor: 'instance variables' stamp: ''!
allInstVarNamesEverywhere
	"Answer the set of inst var names used by the receiver, all superclasses, and all subclasses"

	| aList |
	aList := OrderedCollection new.
	(self allSuperclasses , self withAllSubclasses asOrderedCollection) do:
		[:cls | aList addAll: cls instVarNames].
	^ aList asSet

	"BorderedMorph allInstVarNamesEverywhere"! !

!ClassDescription methodsFor: 'copying' stamp: ''!
copy: sel from: class 
	"Install the method associated with the first argument, sel, a message 
	selector, found in the method dictionary of the second argument, class, 
	as one of the receiver's methods. Classify the message under -As yet not 
	classified-."

	self copy: sel
		from: class
		classified: nil! !

!ClassDescription methodsFor: 'filein/out' stamp: ''!
commentStamp: changeStamp prior: indexAndOffset
	"Prior source link ignored when filing in."

	^ ClassCommentReader new setClass: self
				category: #Comment
				changeStamp: changeStamp! !

!ClassDescription methodsFor: 'pool variable' stamp: ''!
usesPoolVarNamed: aString
	"Only classes may use a pool variable named: aString"
	
	^ false! !

!ClassDescription methodsFor: 'filein/out' stamp: ''!
fileOutMethod: selector
	"Write source code of a single method on a file.  Make up a name for the file."
	
	| internalStream |
	internalStream := (String new: 1000) writeStream.
	self fileOutMethod: selector on: internalStream.
	FileStream writeSourceCodeFrom: internalStream baseName: (self name , '-' , (selector copyReplaceAll: ':' with: '')) isSt: true.! !

!ClassDescription methodsFor: '*rpackage-core' stamp: ''!
isDefinedInPackage: aPackage
	"returns true if aPackage contains the definitino of this class"
	
	^ aPackage includesClass: self.! !

!ClassDescription methodsFor: 'instance variables' stamp: ''!
classThatDefinesClassVariable: classVarName
	"Answer the class that defines the given class variable"

	(self classPool includesKey: classVarName asSymbol) ifTrue: [^ self]. 
	^self superclass ifNotNil: [self superclass classThatDefinesClassVariable: classVarName]! !

!ClassDescription methodsFor: 'compiling' stamp: ''!
logMethodSource: aText forMethod: aCompiledMethod inCategory: category withStamp: changeStamp
	aCompiledMethod
		putSource: aText
		class: self
		category: category
		withStamp: changeStamp 
		inFile: 2
		priorMethod: (self
					compiledMethodAt: aCompiledMethod selector
					ifAbsent: [])! !

!ClassDescription methodsFor: 'organization' stamp: 'EstebanLorenzano 6/27/2013 17:10'!
basicOrganization
	^ organization ! !

!ClassDescription methodsFor: 'copying' stamp: ''!
copyAll: selArray from: class classified: cat 
	"Install all the methods found in the method dictionary of the second 
	argument, class, as the receiver's methods. Classify the messages under 
	the third argument, cat."

	selArray do: [:s |
		(class includesLocalSelector: s) ifTrue: [
			self copy: s
				from: class
				classified: cat ] ]! !

!ClassDescription methodsFor: 'compiling' stamp: ''!
acceptsLoggingOfCompilation
	"Answer whether the receiver's method submisions and class defintions should be logged to the changes file and to the current change set.  The metaclass follows the rule of the class itself
	Weird name is so that it will come lexically before #compile, so that a clean build can make it through."

	^ true! !

!ClassDescription methodsFor: 'filein/out' stamp: ''!
fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex
	"File a description of the receiver on aFileStream. If the boolean 
	argument, moveSource, is true, then set the trailing bytes to the position 
	of aFileStream and to fileIndex in order to indicate where to find the 
	source code."

	aFileStream nextChunkPut: self definition.

	self organization
		putCommentOnFile: aFileStream
		numbered: fileIndex
		moveSource: moveSource
		forClass: self.
	self organization realCategories do: 
		[:heading |
		self fileOutCategory: heading
			on: aFileStream
			moveSource: moveSource
			toFile: fileIndex]! !

!ClassDescription methodsFor: 'pool variable' stamp: ''!
sharedPoolOfVarNamed: aString
	"Only classes may have shared pools"
	
	^ nil! !

!ClassDescription methodsFor: 'private' stamp: ''!
notifyRepackage: selector method: compiledMethod oldProtocol: oldProtocol newProtocol: newProtocol
	| oldPackage newPackage |
	
	(newProtocol = oldProtocol)
		ifTrue: [ ^ self ].
		
	"This indirection is because we need to abstract RPackage from the kernel"
	#RPackage asClassIfPresent: [ :rPackageClass | 
			newPackage := rPackageClass organizer 
				packageForProtocol: newProtocol 
				inClass: self.
			oldPackage := rPackageClass organizer 
				packageForProtocol: oldProtocol 
				inClass: self.
			
			"Announce recategorization"
			newPackage = oldPackage
				ifFalse: [ 
					SystemAnnouncer uniqueInstance 
						methodRepackaged: compiledMethod 
						from: oldPackage 
						to: newPackage ] ].	
	
	SystemAnnouncer uniqueInstance methodRecategorized: compiledMethod oldProtocol: oldProtocol! !

!ClassDescription methodsFor: 'users notification' stamp: ''!
notifyUsersOfChangedSelectors: aCollection
	self traitUsers do: [:each |
		each noteChangedSelectors: aCollection]! !

!ClassDescription methodsFor: 'filein/out' stamp: ''!
fileOutChangedMessages: aSet on: aFileStream moveSource: moveSource toFile: fileIndex 
	"File a description of the messages of this class that have been 
	changed (i.e., are entered into the argument, aSet) onto aFileStream.  If 
	moveSource, is true, then set the method source pointer to the new file position.
	Note when this method is called with moveSource=true, it is condensing the
	.changes file, and should only write a preamble for every method."
	| org |
	(org := self organization) realCategories do: 
		[:cat | | sels | 
		sels := (org listAtCategoryNamed: cat) select: [:sel | aSet includes: sel].
		sels do:
			[:sel |  self printMethodChunk: sel withPreamble: true on: aFileStream
							moveSource: moveSource toFile: fileIndex]]! !

!ClassDescription methodsFor: 'filein/out' stamp: ''!
classComment: aString
	"Store the comment, aString or Text or RemoteString, associated with the class we are orgainzing.  Empty string gets stored only if had a non-empty one before."
	^ self classComment: aString stamp: '<historical>'! !

!ClassDescription methodsFor: 'instance variables' stamp: ''!
removeInstVarNamed: aString 
	"Remove the argument, aString, as one of the receiver's instance 
	variables. Create an error notification if the argument is not found."

	^self subclassResponsibility! !

!ClassDescription methodsFor: 'copying' stamp: ''!
copy: sel from: class classified: cat 
	"Install the method associated with the first arugment, sel, a message 
	selector, found in the method dictionary of the second argument, class, 
	as one of the receiver's methods. Classify the message under the third 
	argument, cat."

	| code category |
	"Useful when modifying an existing class"
	code := class sourceCodeAt: sel.
	code ifNotNil: 
			[cat
				ifNil: [category := class organization categoryOfElement: sel]
				ifNotNil: [category := cat].
			(self includesLocalSelector: sel)
				ifTrue: [code asString = (self sourceCodeAt: sel) asString 
							ifFalse: [self error: self name 
										, ' ' 
										, sel 
										, ' will be redefined if you proceed.']].
			self compile: code classified: category]! !

!ClassDescription methodsFor: '*rpackage-core' stamp: ''!
compileSilently: code 
	"Compile the code and classify the resulting method in the given category, leaving no trail in the system log, nor in any change set, nor in the 'recent submissions' list. This should only be used when you know for sure that the compilation will succeed."

	^ self compileSilently: code classified: 'not defined category' notifying: nil.! !

!ClassDescription methodsFor: '*NautilusRefactoring' stamp: 'MarkRizun 7/23/2014 17:06'!
refactoringSubmenu: aBuilder
	| target |
	target := aBuilder model.

	(aBuilder item: #'Rename...')
		keyText: 'r, c' if: Nautilus useOldStyleKeys not;
		keyText: 'r' if: Nautilus useOldStyleKeys;		
		action: [ target renameClassWithRefactoringEngine: target selectedClass theNonMetaClass ];
		parent: #'Class Refactoring';
		order: 0.
	
	(aBuilder item: #'Remove...')
		action: [ target removeClassWithRefactoringEngine: target selectedClasses ];
		icon: (Smalltalk ui icons iconNamed: #removeIcon);
		parent: #'Class Refactoring';
		order: 100;
		withSeparatorAfter.
		
	(aBuilder item: #'Generate Accessors')
		keyText: 'h, a' if: Nautilus useOldStyleKeys not;
		action: [ target refactor generateAccessors ];
		parent: #'Class Refactoring';
		order: 200.
		
	(aBuilder item: #'Generate Superclass...')
		action: [ target refactor generateSuperClass ];
		parent: #'Class Refactoring';
		order: 300.
	
	(aBuilder item: #'Insert superclass')
		action: [ target refactor insertSuperclass ];
		parent: #'Class Refactoring';
		order: 325.
		
	(aBuilder item: #'Insert subclass')
		action: [ target refactor insertSubclass ];
		parent: #'Class Refactoring';
		order: 350.
		
	(aBuilder item: #'Generate Subclass...')
		action: [ target refactor generateSubclass ];
		parent: #'Class Refactoring';
		order: 400.
		
	(aBuilder item: #'Realize')
		action: [ target refactor realizeClass ];
		parent: #'Class Refactoring';
		order: 500.
		
	(aBuilder item: #'Split')
		action: [ target refactor splitClass: target selectedClass ];
		parent: #'Class Refactoring';
		order: 600.! !

!ClassDescription methodsFor: '*rpackage-core' stamp: ''!
extendingPackages
	"the extending packages of a class are the packages that extend it."
	^ RPackage organizer extendingPackagesOf: self! !

!ClassDescription methodsFor: '*Manifest-Core' stamp: ''!
criticNameOn: aStream
	"This behavior may be folded later by changing the name of this method or using another one."
	
	aStream 
		<< self name 
		<< ' (' 
		<< self category 
		<< ')' ! !

!ClassDescription methodsFor: 'organization updating' stamp: ''!
updateOrganizationDescription: aTraitMethodDescription oldCategory: oldCategoryOrNil newCategory: newCategoryOrNil changedCategories: changedCategories
	| sel effectiveCategory currentCategory |
	sel := aTraitMethodDescription selector.
	
	(self includesLocalSelector: sel) ifTrue: [ ^ self ].
	 
	currentCategory := self organization categoryOfElement: sel.
	effectiveCategory := aTraitMethodDescription effectiveMethodCategoryCurrent: currentCategory new: newCategoryOrNil.
	
	effectiveCategory ifNil: [ 
		currentCategory ifNotNil: [ changedCategories add: currentCategory ].
		^ self organization removeElement: sel ].
		
	((currentCategory isNil 
		or: [ 
				currentCategory == Protocol ambiguous 
				or: [ currentCategory == oldCategoryOrNil ] ])
		and: [ currentCategory ~~ effectiveCategory ])
		ifTrue: [ 
			currentCategory ifNotNil: [ changedCategories add: currentCategory ].
			self organization classify: sel under: effectiveCategory suppressIfDefault: false ]! !

!ClassDescription methodsFor: '*Fuel' stamp: ''!
instanceVariableNamesDo: anUnaryBlock
	"This is part of the interface between the compiler and a class's instance or field names.
	 The class should enumerate anUnaryBlock with the instance variable name strings.  The order is important. Names evaluated later will override the
	 same names occurring earlier."

	| superInstSize |
	(superInstSize := self superclass notNil ifTrue: [self superclass instSize] ifFalse: [0]) > 0 ifTrue:
		[self superclass instanceVariableNamesDo: anUnaryBlock].
	1 to: self instSize - superInstSize do:
		[:i| anUnaryBlock value: (self instanceVariables at: i)]! !

!ClassDescription methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/12/2013 14:44'!
theMetaClass
	^self classClass! !

!ClassDescription methodsFor: 'accessing method dictionary' stamp: ''!
selectorsInProtocol: aName 
	"Answer a list of the selectors of the receiver that are in category named aName"
	
	| aColl |
	aColl := Set withAll: (self organization listAtCategoryNamed: aName).
	^ aColl asArray sort! !

!ClassDescription methodsFor: 'compiling' stamp: ''!
reformatAll
	"Reformat all methods in this class"
	self methods do: [:method | method reformat]! !

!ClassDescription methodsFor: '*FuelTests' stamp: ''!
duringTestCompileSilently: code classified: aCategory
	^ self 
		duringTestCompileSilently: code
		storeSource: true
		classified: aCategory! !

!ClassDescription methodsFor: 'accessing parallel hierarchy' stamp: ''!
isInstanceSide
	^self isClassSide not! !

!ClassDescription methodsFor: '*FuelTests' stamp: ''!
duringTestCompileSilently: code storeSource: storeSource classified: aCategory
	^ Author 
		useAuthor: 'TestsAuthor'
		during: [ [
			self 
				compile: code
				classified: (aCategory ifNil: [ '' ])
				withStamp: nil 
				notifying: nil 
				logSource: storeSource ] fuelValueWithoutNotifications ]! !

!ClassDescription methodsFor: 'accessing parallel hierarchy' stamp: ''!
hasClassSide
	^self subclassResponsibility.! !

!ClassDescription methodsFor: 'pool variable' stamp: ''!
hasSharedPools
	"Only a class may have shared pools"
	^ false! !

!ClassDescription methodsFor: 'accessing parallel hierarchy' stamp: ''!
instanceSide
	^ self theNonMetaClass! !

!ClassDescription methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterPackageFor: aStep
	<spotterOrder: 50>
	aStep listProcessor
			title: 'Package';
			allCandidates: [ {self package} ];
			itemName: [ :item | item packageName ];
			itemIcon: #systemIcon;
			filter: GTFilterSubstring! !

!ClassDescription methodsFor: 'accessing parallel hierarchy' stamp: ''!
isMeta
	^self isClassSide! !

!ClassDescription methodsFor: '*Slot' stamp: 'MartinDias 9/5/2014 15:10'!
superclass: aSuperclass layout: aLayout
	layout := aLayout. 
	
	self
		superclass: aSuperclass
		methodDictionary: MethodDictionary new
		format: aLayout format.
	
	instanceVariables := layout instanceVariables asArray! !

!ClassDescription methodsFor: 'compiling' stamp: ''!
compile: text classified: category withStamp: changeStamp notifying: requestor
	^ self
		compile: text
		classified: category
		withStamp: changeStamp
		notifying: requestor
		logSource: self acceptsLoggingOfCompilation! !

!ClassDescription methodsFor: 'filein/out' stamp: ''!
commentStamp: changeStamp
	self organization commentStamp: changeStamp.
	^ self commentStamp: changeStamp prior: 0! !

!ClassDescription methodsFor: 'filein/out' stamp: ''!
printMethodChunk: selector withPreamble: doPreamble on: outStream moveSource: moveSource toFile: fileIndex
	"Copy the source code for the method associated with selector onto the fileStream.  If moveSource true, then also set the source code pointer of the method."

	| preamble method oldPos newPos sourceFile |
	doPreamble
		ifTrue: [ preamble := self name , ' methodsFor: ' , (self organization categoryOfElement: selector) asString printString ]
		ifFalse: [ preamble := '' ].
	method := self methodDict
		at: selector
		ifAbsent: [ 
			outStream
				nextPutAll: selector;
				cr.
			outStream
				tab;
				nextPutAll: '** ERROR!!  THIS SCRIPT IS MISSING ** ' translated;
				cr;
				cr.
			outStream nextPutAll: '  '.
			^ outStream ].
	oldPos := method filePosition.
	sourceFile := SourceFiles at: method fileIndex.
	preamble size > 0
		ifTrue: [ 
			"Copy the preamble"
			outStream copyPreamble: preamble from: sourceFile at: oldPos ]
		ifFalse: [ sourceFile position: oldPos ].	"Copy the method chunk"
	newPos := outStream position.
	outStream copyMethodChunkFrom: sourceFile.
	sourceFile skipSeparators.	"The following chunk may have ]style["
	sourceFile peek == $]
		ifTrue: [ 
			outStream
				cr;
				copyMethodChunkFrom: sourceFile ].
	moveSource
		ifTrue: [ 
			"Set the new method source pointer"
			method setSourcePosition: newPos inFile: fileIndex ].
	preamble size > 0
		ifTrue: [ outStream nextChunkPut: ' ' ].
	^ outStream cr! !

!ClassDescription methodsFor: 'copying' stamp: ''!
copyMethodDictionaryFrom: donorClass
	"Copy the method dictionary of the donor class over to the receiver"

	self methodDict: donorClass copyOfMethodDictionary.
	self organization: donorClass organization deepCopy.! !

!ClassDescription methodsFor: '*rpackage-core' stamp: ''!
packageFromOrganizer: anOrganizer
	"returns the package that defines this class"
	^ anOrganizer packageOf: self.! !

!ClassDescription methodsFor: 'organization updating' stamp: 'SebastianTleye 7/12/2013 16:49'!
noteChangesFrom: oldMethodDict
	"create notifications about the changes made to the method dictionary"
	"additions have already been notified in #addTraitSelector:withMethod:"
		
	" deal with removal / updates relative to the old method dictionary"
	oldMethodDict keysAndValuesDo: [ :selector :oldMethod|
		self methodDict 
			at: selector
			ifPresent: [ :currentMethod|
				currentMethod == oldMethod
					ifFalse: [ self noteMethodChanged: oldMethod to: currentMethod]]
			ifAbsent: [ self noteMethodRemoved: oldMethod ]].
	! !

!ClassDescription methodsFor: 'filein/out' stamp: ''!
localMethods
	"returns the methods of classes including the ones of the traits that the class uses" 
	 
	^ self methods select: [:each | self includesLocalSelector: each selector].! !

!ClassDescription methodsFor: 'accessing parallel hierarchy' stamp: ''!
classSide
	^self theMetaClass.! !

!ClassDescription methodsFor: 'accessing method dictionary' stamp: ''!
addSelectorSilently: selector withMethod: compiledMethod
	super addSelectorSilently: selector withMethod: compiledMethod.
	self instanceSide noteAddedSelector: selector meta: self isMeta.! !

!ClassDescription methodsFor: 'slots' stamp: ''!
definesSlot: aSlot
	"Return true whether the receiver defines an instance variable named aString"
	
	^ self slots identityIncludes: aSlot! !

!ClassDescription methodsFor: 'compiling' stamp: ''!
wantsRecompilationProgressReported
	"Answer whether the receiver would like progress of its recompilation reported interactively to the user."

	^ true! !

!ClassDescription methodsFor: 'filein/out' stamp: ''!
fileOutOrganizationOn: aFileStream
	"File a description of the receiver's organization on aFileStream."

	aFileStream cr; nextPut: $!!.
	aFileStream nextChunkPut: self name, ' reorganize'; cr.
	aFileStream nextChunkPut: self organization stringForFileOut ; cr! !

!ClassDescription methodsFor: 'private' stamp: ''!
spaceUsed
	^super spaceUsed + (self hasClassSide
		ifTrue: [self classSide spaceUsed] 
		ifFalse: [0])! !

!ClassDescription methodsFor: 'slots' stamp: ''!
usesSpecialVariables
	"retirn true if we define something else than InstanceVariableSlots"
	^self usesSpecialSlot or: [self classVariables anySatisfy: [ :each | each isSpecial ] ]! !

!ClassDescription methodsFor: 'slots' stamp: ''!
hasSlotNamed: aString
	"Return true whether the receiver defines an instance variable named aString."
	
	^ self allSlots anySatisfy: [:slot | slot name = aString]! !

!ClassDescription methodsFor: 'private' stamp: ''!
numberOfMethods
	"count all methods that are local (not comming from a trait)"
	| num |
	num := self localMethods size.
	^ self isMeta  
		ifTrue: [ num ]
		ifFalse: [ num + self class numberOfMethods ] ! !

!ClassDescription methodsFor: '*rpackage-core' stamp: ''!
isExtendedInPackage: aPackage
	"returns true if aPackage defines an extension to this class"
	^ aPackage extendsClass: self.! !

!ClassDescription methodsFor: 'slots' stamp: ''!
slotNames
	^self slots collect: [ :each | each name ]! !

!ClassDescription class methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
gtExamplePackage
	<gtExample: 'Package'>
	^ TClassDescription! !

!ClassDescription class methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/26/2015 17:17'!
gtExampleRPackage
	<gtExample>
	^ GTSpotter package! !

!ClassDescriptionTest commentStamp: '<historical>'!
This is the unit test for the class ClassDescription. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see: 
	- http://www.c2.com/cgi/wiki?UnitTest
	- there is a chapter in the PharoByExample book (http://pharobyexample.org)
	- the sunit class category!
!ClassDescriptionTest methodsFor: 'tests' stamp: 'EstebanLorenzano 5/28/2013 13:22'!
testOrganization

	| aClassOrganizer |
	aClassOrganizer := ClassDescription organization.
	self assert: (aClassOrganizer isKindOf: ClassOrganization).! !

!ClassDescriptionTest methodsFor: 'tests - slots' stamp: 'MarcusDenker 6/25/2014 13:20'!
testSlots
	self assert: (Context slots size = 4).
	! !

!ClassDescriptionTest methodsFor: 'tests - slots' stamp: 'MarcusDenker 7/13/2014 13:05'!
testDefinesSlotNamed
	self assert: (Point definesSlotNamed: #x).
	self deny: (Point definesSlotNamed: #z).
	
	self assert: (Context definesSlotNamed: #stackp).
	self deny: (Context definesSlotNamed: #sender).
	! !

!ClassDescriptionTest methodsFor: 'tests' stamp: 'Alexandre Bergel 4/27/2010 14:17'!
testNumberOfMethods
	self assert: (Point numberOfMethods = (Point localMethods size + Point class localMethods size)).
! !

!ClassDescriptionTest methodsFor: 'tests - slots' stamp: 'MarcusDenker 6/25/2014 13:21'!
testAllSlots
	self assert: (Context allSlots size = 6).
	! !

!ClassDescriptionTest methodsFor: 'tests - slots' stamp: 'MarcusDenker 6/25/2014 13:29'!
testSlotNamed
	self assert: ((Point slotNamed: #x) name = #x).
! !

!ClassDescriptionTest methodsFor: 'tests' stamp: 'StephaneDucasse 8/29/2013 20:55'!
testAllMethodCategoriesIntegratedThrough
	"If this test fails, it may be because method protocols are sorted in #allMethodCategoriesIntegratedThrough. Take care that if the protocols of the class under test are already sorted, you won't see any problem."
	self assert: ((CompiledMethod selectorsInProtocol: 'testing') includes: #isAbstract).
	CompiledMethod allProtocolsUpTo: Object.
	self assert: ((CompiledMethod selectorsInProtocol: 'testing') includes: #isAbstract)! !

!ClassDescriptionTest methodsFor: 'tests' stamp: 'MartinDias 9/5/2014 15:12'!
testClassDescriptionRespectsPolymorphismWithTraitDescription
	| repeatedMethodsThatDoNotAccessInstanceVariables differentMethodsWithSameSelector |
	"If the method is in ClassDescription and TraitDescription it must access some instance variable, otherwise the method can be implemented in TClassDescription"
	repeatedMethodsThatDoNotAccessInstanceVariables := self
		repeatedMethodsThatDoNotAccessInstanceVariablesBetween: ClassDescription
		and: TraitDescription.
	self assert: repeatedMethodsThatDoNotAccessInstanceVariables size = 0.	
	
	"If the method is in ClassDescription and TraitDescription, and they have different implementations, it must be declared in TClassDescription as an explicitRequirement method"
	differentMethodsWithSameSelector := self
		differentMethodsWithSameSelectorBetween: ClassDescription
		and: TraitDescription.
	differentMethodsWithSameSelector
		do: [ :selector | 
			(TClassDescription >> selector) sourceCode.
			self assert: (TClassDescription >> selector) isRequired ].	
			
	"Only a few methods are allowed to belong to one class and not to the other
	If you want to remove methods for this list, then go ahead. But is NOT good idea add methods to this list
	#superclass:layout: -> it accesses instance variables that are in ClassDescription but not in TraitDescription
	#layout is the getter of the instance variable layout (which is in ClassDescription but not in TraitDescription)
	#baseClass and #classClass have their equivalens in TraitDescription (baseTrait classTrait )"
	self
		assertCollection: (ClassDescription localSelectors difference: TraitDescription localSelectors)
		equals:
			#(#superclass:layout: #baseClass #superclass:withLayoutType:slots: #classClass) asSet.	
	"#isClassTrait, #baseTrait, #isBaseTrait and #classTrait have their equivalents in ClassDescription but with different name,
		the problem comes from the name of the selector, they are not good names
	#copyTraitExpresion and #addExclusionOf: have no equivalent in classes"
	self
		assertCollection: (TraitDescription localSelectors difference: ClassDescription localSelectors)
		equals:
			#(#isClassTrait #addExclusionOf: #copyTraitExpression #baseTrait #-  #isBaseTrait #classTrait syntacticallyEquals:) asSet! !

!ClassDescriptionTest methodsFor: 'tests - slots' stamp: 'MarcusDenker 6/25/2014 13:19'!
testSlotNames
	self assert: (Point slotNames = #(x y)).
	! !

!ClassDescriptionTest methodsFor: 'tests - slots' stamp: 'MarcusDenker 2/8/2015 19:36'!
testHasSlot
	self assert: (Context hasSlot: (Context slotNamed: #sender)).
	self deny: (Context definesSlot: (Context slotNamed: #sender)).! !

!ClassDescriptionTest methodsFor: 'tests' stamp: 'sd 5/10/2008 12:34'!
testMethods
	self assert: Object methods = Object methodDict values.  ! !

!ClassDescriptionTest methodsFor: 'tests - slots' stamp: 'MarcusDenker 3/19/2015 16:21'!
testHasSlotNamed
	self assert: (Context hasSlotNamed: #sender).
	self assert: (Context hasSlotNamed: #method).! !

!ClassDiffBuilder commentStamp: 'HenrikSperreJohansen 5/21/2010 02:06'!
I'm like TextDiffBuilder, but I split the input text by Character >> #separators, instead of new lines. 
I'm probably ment to create diffs of class definitions.!
!ClassDiffBuilder methodsFor: 'private' stamp: 'HenrikSperreJohansen 5/21/2010 02:05'!
print: aString withAttributes: attributes on: stream

	stream
		withAttributes: attributes 
		do: [ stream nextPutAll: aString ]! !

!ClassDiffBuilder methodsFor: 'private' stamp: 'HenrikSperreJohansen 5/21/2010 02:04'!
split: aString
	"I return an array with aString splitted by Character >> #separators."

	^Array streamContents: [ :stream |
		| out |
		out := aString copy writeStream.
		aString do: [ :c |
			out nextPut: c.
			c isSeparator ifTrue:[
				stream nextPut: out contents.
				out reset ] ].
		out position = 0 ifFalse: [ 
			stream nextPut: out contents ] ]! !

!ClassEyeElement commentStamp: '<historical>'!
I am an eye element for the class of an inspected element.!
!ClassEyeElement methodsFor: 'accessing' stamp: 'CamilloBruni 9/21/2013 16:03'!
value
	^ self host class! !

!ClassEyeElement methodsFor: 'accessing' stamp: 'abc 10/18/2013 14:57'!
accessorCode
	^ 'self class'! !

!ClassEyeElement methodsFor: 'accessing' stamp: 'CamilloBruni 9/21/2013 16:02'!
label
	^ 'class'! !

!ClassEyeElement methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/14/2014 10:29'!
shouldShowInTree
	^ false! !

!ClassFactoryForTestCase commentStamp: 'LaurentLaffont 4/15/2011 20:20'!
I'm useful when classes needs to be created during the execution of the test. This avoid polluting your unit tests with dummy and mock classes.
A typical usage of it is:

TestCase subclass: #YourTest
       instanceVariableNames: 'classFactory'

YourTest>>setUp
       classFactory := ClassFactoryForTestCase new

YourTest>>tearDown
       classFactory deleteClasses.

YourTest>>testIsBehavior
       | cls |
       cls := classFactory newClass.
       self assert: cls isBehavior
!
!ClassFactoryForTestCase methodsFor: 'cleaning' stamp: 'Noury 10/26/2008 14:20'!
cleanUpChangeSetForClassNames: classeNames
	| changeSet |
	changeSet := ChangeSet current.
	classeNames do: [:name|
		changeSet 
			removeClassChanges: name;
			removeClassChanges: name, ' class'].	! !

!ClassFactoryForTestCase methodsFor: 'creating' stamp: 'SebastianTleye 8/9/2013 12:47'!
newSubclassOf: aClass using: aTraitComposition
	^self 
		newSubclassOf: aClass
		uses: aTraitComposition 
		instanceVariableNames: '' 
		classVariableNames: ''
		category: self defaultCategoryPostfix.! !

!ClassFactoryForTestCase methodsFor: 'creating' stamp: 'SebastianTleye 8/9/2013 11:46'!
newClassUsing: aTraitComposition
	^self 
		newSubclassOf: self defaultSuperclass 
		uses: aTraitComposition 
		instanceVariableNames: '' 
		classVariableNames: ''
		category: self defaultCategoryPostfix.! !

!ClassFactoryForTestCase methodsFor: 'creating' stamp: 'ChristopheDemarey 11/28/2013 22:13'!
withNotificationsNewClassWithInstanceVariableNames: instanceVariableNames
	^ self
		newSubclassOf: Object
		instanceVariableNames: instanceVariableNames
		classVariableNames: ''
		category: self defaultCategoryPostfix! !

!ClassFactoryForTestCase methodsFor: 'accessing' stamp: 'SebastianTleye 8/9/2013 11:14'!
createdTraits
	^createdTraits! !

!ClassFactoryForTestCase methodsFor: 'creating' stamp: 'ChristopheDemarey 11/28/2013 22:12'!
newTraitInCategory: category
	^ self
		newTraitNamed: self newTraitName
		uses: Array new
		category: category asSymbol.! !

!ClassFactoryForTestCase methodsFor: 'creating' stamp: 'BenComan 10/1/2014 21:19'!
newSubclassOf: aClass uses: aTraitComposition instanceVariableNames: ivNamesString classVariableNames:  classVarsString poolDictionaries: poolNamesString category: category
	| newClass |
	newClass := aClass 
		subclass: self newClassName 
		uses: aTraitComposition
		instanceVariableNames: ivNamesString 
		classVariableNames: classVarsString 
		poolDictionaries: poolNamesString 
		category: (self packageName, '-', category) asSymbol.
	self createdClasses add: newClass.
	^newClass! !

!ClassFactoryForTestCase methodsFor: 'accessing' stamp: 'SebastianTleye 8/9/2013 11:14'!
createdTraitNames
	^self createdTraits collect: [:trait | trait name]! !

!ClassFactoryForTestCase methodsFor: 'initialization' stamp: 'ChristopheDemarey 11/28/2013 22:14'!
initialize
	super initialize.
	createdClasses := IdentitySet new.
	createdTraits := IdentitySet new.
	createdSilently := IdentitySet new.! !

!ClassFactoryForTestCase methodsFor: 'accessing' stamp: 'Noury 10/26/2008 16:37'!
defaultCategory
	^ (self packageName , '-', self defaultCategoryPostfix) asSymbol! !

!ClassFactoryForTestCase methodsFor: 'creating - silently' stamp: 'ChristopheDemarey 11/29/2013 16:51'!
silentlyNewClassInCategory: category
	^ self
		silentlyNewSubclassOf: self defaultSuperclass
		instanceVariableNames: ''
		classVariableNames: ''
		category: category! !

!ClassFactoryForTestCase methodsFor: 'accessing' stamp: 'Noury 10/26/2008 16:20'!
packageName
	^#CategoryForTestToBeDeleted! !

!ClassFactoryForTestCase methodsFor: 'creating' stamp: 'ChristopheDemarey 11/28/2013 22:12'!
newTrait
	^ self
		newTraitNamed: self newTraitName
		uses: Array new
		category: self defaultCategoryPostfix! !

!ClassFactoryForTestCase methodsFor: 'cleaning' stamp: 'Noury 10/26/2008 16:33'!
deletePackage
	| categoriesMatchString |
	categoriesMatchString := self packageName, '-*'.
	SystemOrganization removeCategoriesMatching: categoriesMatchString! !

!ClassFactoryForTestCase methodsFor: 'creating' stamp: 'MarianoMartinezPeck 4/19/2012 19:06'!
withNotificationsNewClass
	^  self withNotificationsNewClassWithInstanceVariableNames: ''! !

!ClassFactoryForTestCase methodsFor: 'creating' stamp: 'SebastianTleye 8/9/2013 11:42'!
newSubclassOf: aClass instanceVariableNames: ivNamesString classVariableNames:  classVarsString 
	^self 
		newSubclassOf: aClass 
		uses: { }
		instanceVariableNames: ivNamesString 
		classVariableNames: classVarsString 
		category: self defaultCategoryPostfix! !

!ClassFactoryForTestCase methodsFor: 'creating' stamp: 'SebastianTleye 8/9/2013 11:50'!
newTraitName
	| postFix |
	postFix := (self createdTraits size + 1) printString.
	^(#TraitForTestToBeDeleted, postFix) asSymbol! !

!ClassFactoryForTestCase methodsFor: 'creating' stamp: 'SebastianTleye 8/9/2013 11:42'!
newSubclassOf: aClass instanceVariableNames: ivNamesString classVariableNames:  classVarsString category: category
	^self 
		newSubclassOf: aClass 
		uses: { } 
		instanceVariableNames: ivNamesString 
		classVariableNames: classVarsString 
		category: category.! !

!ClassFactoryForTestCase methodsFor: 'cleaning' stamp: 'ChristopheDemarey 11/28/2013 22:09'!
delete: aBehavior
	aBehavior isObsolete
		ifTrue: [ ^ self ].
	aBehavior removeFromChanges.
	(createdSilently includes: aBehavior)
		ifTrue: [ aBehavior removeFromSystemUnlogged ]
		ifFalse: [ aBehavior removeFromSystem ].! !

!ClassFactoryForTestCase methodsFor: 'accessing' stamp: 'NouryBouraqadi 12/18/2010 18:46'!
defaultSuperclass 
	^Object! !

!ClassFactoryForTestCase methodsFor: 'creating - silently' stamp: 'ChristopheDemarey 11/29/2013 16:51'!
silentlyNewSubclassOf: aClass instanceVariableNames: ivNamesString classVariableNames: classVarsString
	^ self
		silentlyNewSubclassOf: aClass
		instanceVariableNames: ivNamesString
		classVariableNames: classVarsString
		category: self defaultCategoryPostfix! !

!ClassFactoryForTestCase methodsFor: 'accessing' stamp: 'Noury 10/26/2008 14:21'!
createdClassNames
	^self createdClasses collect: [:class| class name]! !

!ClassFactoryForTestCase methodsFor: 'creating - silently' stamp: 'ChristopheDemarey 11/29/2013 16:53'!
silentlyNewSubclassOf: aClass instanceVariableNames: ivNamesString classVariableNames:  classVarsString package: packageName

	|  newClass |
	SystemAnnouncer uniqueInstance suspendAllWhile: [
		newClass := aClass 
			subclass: self newClassName 
			instanceVariableNames: ivNamesString 
			classVariableNames: classVarsString 
			poolDictionaries: '' 
			category: packageName asSymbol.
	].

	self createdClasses add: newClass.
	createdSilently add: newClass.
	^newClass
	! !

!ClassFactoryForTestCase methodsFor: 'accessing' stamp: 'BenComan 10/1/2014 21:16'!
nextCount
	"Global counter to avoid name clash between test runs, in case of some previous failure."
	^Counter := (Counter ifNil: [ 0 ]) + 1.! !

!ClassFactoryForTestCase methodsFor: 'accessing' stamp: 'Noury 10/26/2008 13:59'!
createdClasses
	^createdClasses! !

!ClassFactoryForTestCase methodsFor: 'creating' stamp: 'ChristopheDemarey 11/28/2013 22:11'!
newClassInCategory: category
	^ self
		newSubclassOf: self defaultSuperclass
		instanceVariableNames: ''
		classVariableNames: ''
		category: category! !

!ClassFactoryForTestCase methodsFor: 'creating - silently' stamp: 'ChristopheDemarey 11/29/2013 16:53'!
silentlyNewSubclassOf: aClass instanceVariableNames: ivNamesString classVariableNames:  classVarsString category: category

	|  newClass |
	SystemAnnouncer uniqueInstance suspendAllWhile: [
		newClass := aClass 
			subclass: self newClassName 
			instanceVariableNames: ivNamesString 
			classVariableNames: classVarsString 
			poolDictionaries: '' 
			category: (self packageName, '-', category) asSymbol.
	].

	self createdClasses add: newClass.
	createdSilently add: newClass.
	^newClass
	! !

!ClassFactoryForTestCase methodsFor: 'cleaning' stamp: 'SebastianTleye 8/9/2013 11:15'!
deleteTraits
	self createdTraits do: [:trait|
		self delete: trait]! !

!ClassFactoryForTestCase methodsFor: 'creating' stamp: 'SebastianTleye 8/9/2013 13:47'!
newTraitNamed: aTraitName uses: aTraitComposition category: aCategory
	| newTrait |
	
	newTrait := Trait 
					named: aTraitName
					uses: aTraitComposition 
					category: (self packageName, '-', aCategory) asSymbol..
		
	self createdTraits add: newTrait.
	
	^newTrait.! !

!ClassFactoryForTestCase methodsFor: 'creating' stamp: 'ChristopheDemarey 11/28/2013 22:11'!
newClass
	^ self 
		newSubclassOf: self defaultSuperclass
		instanceVariableNames: ''
		classVariableNames: ''! !

!ClassFactoryForTestCase methodsFor: 'cleaning' stamp: 'SebastianTleye 8/9/2013 12:06'!
cleanUp
	| createdClassNames createdTraitNames |
	createdClassNames := self createdClassNames.
	createdTraitNames := self createdTraitNames.
	self deleteClasses.
	self deleteTraits.
	self deletePackage.
	self cleanUpChangeSetForClassNames: createdClassNames.
	self cleanUpChangeSetForClassNames: createdTraitNames! !

!ClassFactoryForTestCase methodsFor: 'creating' stamp: 'BenComan 10/1/2014 21:14'!
newClassName
	| postFix |
	postFix := self nextCount printString.
	^(#ClassForTestToBeDeleted, postFix) asSymbol.! !

!ClassFactoryForTestCase methodsFor: 'cleaning' stamp: 'Noury 10/26/2008 12:46'!
deleteClasses
	self createdClasses do: [:class|
		self delete: class]! !

!ClassFactoryForTestCase methodsFor: 'creating' stamp: 'BenComan 10/1/2014 21:22'!
newSubclassOf: aClass uses: aTraitComposition instanceVariableNames: ivNamesString classVariableNames:  classVarsString category: category
	^self
		newSubclassOf: aClass 
		uses: aTraitComposition
		instanceVariableNames: ivNamesString 
		classVariableNames: classVarsString 
		poolDictionaries: '' 
		category: category! !

!ClassFactoryForTestCase methodsFor: 'creating' stamp: 'SebastianTleye 8/9/2013 11:48'!
newTraitUsing: aTraitComposition.
	^self 
		newTraitNamed: self newTraitName 
		uses: aTraitComposition 
		category: self defaultCategoryPostfix.! !

!ClassFactoryForTestCase methodsFor: 'accessing' stamp: 'Noury 10/26/2008 16:23'!
defaultCategoryPostfix
	^ #Default! !

!ClassFactoryForTestCase methodsFor: 'creating' stamp: 'JenkinsCI 11/27/2013 08:48'!
duplicateClass: aClass withNewName: name
	| newClass |
	
	newClass := aClass duplicateClassWithNewName: name.
	self createdClasses add: newClass.
	^newClass
! !

!ClassFactoryForTestCase methodsFor: 'cleaning' stamp: 'BenComan 10/1/2014 22:04'!
deleteClass: aClass
	self createdClasses remove: aClass.
	self delete: aClass.! !

!ClassFactoryForTestCaseTest commentStamp: 'TorstenBergmann 2/12/2014 23:17'!
SUnit tests for ClassFactoryForTestCase !
!ClassFactoryForTestCaseTest methodsFor: 'testing' stamp: 'nice 12/3/2009 23:47'!
testSingleClassCreation
	|class elementsInCategoryForTest |
	class := factory 
		newSubclassOf: Object 
		instanceVariableNames: 'a b c' 
		classVariableNames: 'X Y'.
	self assert: (SystemNavigation new allClasses includes: class).
	elementsInCategoryForTest := SystemOrganization listAtCategoryNamed: factory defaultCategory. 
	self assert: elementsInCategoryForTest = {class name}.
	self assert: class instVarNames = #(a b c).
	self assert: class classPool keys asSet = #(X Y) asSet! !

!ClassFactoryForTestCaseTest methodsFor: 'testing' stamp: 'VincentBlondeau 3/6/2015 17:46'!
testDefaultCategoryCleanUp
	| createdClassNames allClasses allTraits |
	
	3 timesRepeat: [
		factory newClass.
		factory newTrait].
	
	createdClassNames := factory createdClassNames.
	
	factory cleanUp.	
	
	self assert: (factory createdClasses allSatisfy: [:class| class isObsolete]). 
	self assert: (factory createdTraits allSatisfy: [:trait| trait isObsolete]). 
	
	allClasses := SystemNavigation new allClasses.
	allTraits := Smalltalk globals allTraits.
	
	self assert: (factory createdClasses noneSatisfy: [:class| allClasses includes: class]).
	self assert: (factory createdTraits noneSatisfy: [:trait| allTraits includes: trait]).
	self deny: (SystemOrganization categories includes: factory defaultCategory). 
	self deny: (ChangeSet current changedClassNames includesAnyOf: createdClassNames)
! !

!ClassFactoryForTestCaseTest methodsFor: 'testing' stamp: 'Noury 10/26/2008 16:37'!
testSingleClassFastCreation
	|class elementsInCategoryForTest |
	class := factory newClass.
	self assert: (SystemNavigation new allClasses includes: class).
	elementsInCategoryForTest := SystemOrganization listAtCategoryNamed: factory defaultCategory. 
	self assert: elementsInCategoryForTest = {class name}.
	self assert: class instVarNames isEmpty.
	self assert: class classPool isEmpty! !

!ClassFactoryForTestCaseTest methodsFor: 'testing' stamp: 'Noury 10/26/2008 16:38'!
testMultipleClassCreation
	5 timesRepeat: [
		factory newClass].
	self assert: (SystemNavigation new allClasses includesAllOf: factory createdClasses).
	self assert: factory createdClassNames asSet size = 5.
	self assert: (SystemOrganization listAtCategoryNamed: factory defaultCategory) asSet = factory createdClassNames asSet! !

!ClassFactoryForTestCaseTest methodsFor: 'testing' stamp: 'SebastianTleye 8/9/2013 13:43'!
testTraitCreationInDifferentCategories
	| firstThreeTraits lastTwoTraits |
	3 timesRepeat: [
		factory newTraitInCategory: #One].
	firstThreeTraits := factory createdTraits copy.
	2 timesRepeat: [
		factory newTraitInCategory: #Two].
	lastTwoTraits := factory createdTraits copyWithoutAll: firstThreeTraits.
	self assert: (firstThreeTraits allSatisfy: [:trait| trait category = (factory packageName, '-', #One) asSymbol]).
	self assert: (lastTwoTraits allSatisfy: [:trait| trait category = (factory packageName, '-', #Two) asSymbol]).! !

!ClassFactoryForTestCaseTest methodsFor: 'testing' stamp: 'Noury 10/26/2008 16:43'!
testClassCreationInDifferentCategories
	| firstThreeClasses lastTwoClasses |
	3 timesRepeat: [
		factory newSubclassOf: Object instanceVariableNames: '' classVariableNames: '' category: #One].
	firstThreeClasses := factory createdClasses copy.
	2 timesRepeat: [
		factory newSubclassOf: Object instanceVariableNames: '' classVariableNames: '' category: #Two].
	lastTwoClasses := factory createdClasses copyWithoutAll: firstThreeClasses.
	self assert: (firstThreeClasses allSatisfy: [:class| class category = (factory packageName, '-', #One) asSymbol]).
	self assert: (lastTwoClasses allSatisfy: [:class| class category = (factory packageName, '-', #Two) asSymbol]).! !

!ClassFactoryForTestCaseTest methodsFor: 'setUp-tearDown' stamp: 'Noury 10/26/2008 14:53'!
tearDown
	super tearDown.
	factory cleanUp! !

!ClassFactoryForTestCaseTest methodsFor: 'testing' stamp: 'Noury 10/26/2008 16:47'!
testPackageCleanUp
	| createdClassNames allClasses |
	3 timesRepeat: [
		factory newClassInCategory: #One].
	2 timesRepeat: [
		factory newClassInCategory: #Two].
	createdClassNames := factory createdClassNames.
	factory cleanUp.	
	self assert: (factory createdClasses allSatisfy: [:class| class isObsolete]). 
	allClasses := SystemNavigation new allClasses.
	self assert: (factory createdClasses noneSatisfy: [:class| allClasses includes: class]).
	self assert: (SystemOrganization categoriesMatching: factory packageName, '*') isEmpty. 
	self deny: (ChangeSet current changedClassNames includesAnyOf: createdClassNames)
! !

!ClassFactoryForTestCaseTest methodsFor: 'testing' stamp: 'ChristopheDemarey 11/28/2013 22:04'!
testDuplicateClassWithNewName
	| createdClass |
	createdClass := factory duplicateClass: TestCase withNewName: #MyTestClass.
	self assert: (factory createdClasses allSatisfy: [:class| self class environment includesKey: class name ]).
	factory cleanUp.
	self assert: (factory createdClasses allSatisfy: [:class| class isObsolete]).
	self deny: (ChangeSet current changedClassNames includes: createdClass).! !

!ClassFactoryForTestCaseTest methodsFor: 'testing' stamp: 'VincentBlondeau 3/7/2015 14:06'!
testSingleTraitCreation
	| trait |
	trait := factory newTrait.
	self assert: (Smalltalk globals allTraits includes: trait).
	self assert: trait traitUsers size = 0.
	self assert: trait traits size = 0! !

!ClassFactoryForTestCaseTest methodsFor: 'testing' stamp: 'Noury 10/26/2008 16:42'!
testClassFastCreationInDifferentCategories
	| firstThreeClasses lastTwoClasses |
	3 timesRepeat: [
		factory newClassInCategory: #One].
	firstThreeClasses := factory createdClasses copy.
	2 timesRepeat: [
		factory newClassInCategory: #Two].
	lastTwoClasses := factory createdClasses copyWithoutAll: firstThreeClasses.
	self assert: (firstThreeClasses allSatisfy: [:class| class category = (factory packageName, '-', #One) asSymbol]).
	self assert: (lastTwoClasses allSatisfy: [:class| class category = (factory packageName, '-', #Two) asSymbol]).! !

!ClassFactoryForTestCaseTest methodsFor: 'setUp-tearDown' stamp: 'Noury 10/26/2008 12:19'!
setUp
	super setUp.
	factory := ClassFactoryForTestCase new! !

!ClassFactoryForTestCaseTest class methodsFor: 'history' stamp: 'simon.denier 11/22/2008 22:13'!
lastStoredRun
	^ ((Dictionary new) add: (#passed->((Set new) add: #testDefaultCategoryCleanUp; add: #testPackageCleanUp; add: #testSingleClassCreation; add: #testClassCreationInDifferentCategories; add: #testClassFastCreationInDifferentCategories; add: #testMultipleClassCreation; add: #testSingleClassFastCreation; yourself)); add: (#timeStamp->'22 November 2008 10:11:35 pm'); add: (#failures->((Set new))); add: (#errors->((Set new))); yourself)! !

!ClassFactoryWithOrganization commentStamp: 'LaurentLaffont 5/4/2011 21:25'!
I'm a class to create classes with a category. I'm only used by Tests.

I am similar to ClassFactoryForTestCase (i.e., I can be used in place of a ClassFactoryForTestCase), expect that classes may be created on a specific class category.!
!ClassFactoryWithOrganization methodsFor: 'creating' stamp: 'LucFabresse 10/29/2010 08:04'!
newClassNamed: aString subclassOf: aClass instanceVariableNames: ivNamesString classVariableNames:  classVarsString 
	^self 
		newClassNamed: aString
		subclassOf: aClass 
		instanceVariableNames: ivNamesString 
		classVariableNames: classVarsString 
		category:  (self packageName, '-', self defaultCategoryPostfix) asSymbol.! !

!ClassFactoryWithOrganization methodsFor: 'accessing' stamp: 'LucFabresse 10/24/2010 20:31'!
organization: aSystemOrganizer
	organization := aSystemOrganizer! !

!ClassFactoryWithOrganization methodsFor: 'creating' stamp: 'MartinDias 6/24/2013 15:26'!
newClassNamed: aString subclassOf: aClass instanceVariableNames: ivNamesString classVariableNames:  classVarsString category: category
	| newClass |
	newClass := self class classBuilder
		name: aString 
		inEnvironment: self organization environment
		subclassOf: aClass
		type: aClass typeOfClass
		instanceVariableNames: ivNamesString
		classVariableNames: classVarsString
		poolDictionaries: ''
		category: category asSymbol.
	self createdClasses add: newClass.
	^newClass! !

!ClassFactoryWithOrganization methodsFor: 'cleaning' stamp: 'LucFabresse 10/24/2010 22:01'!
deletePackage
	| categoriesMatchString |
	categoriesMatchString := self packageName, '-*'.
	self organization removeCategoriesMatching: categoriesMatchString ; 
		removeEmptyCategories
	! !

!ClassFactoryWithOrganization methodsFor: 'creating' stamp: 'LucFabresse 10/24/2010 21:41'!
newSubclassOf: aClass instanceVariableNames: ivNamesString classVariableNames:  classVarsString 
	^self 
		newSubclassOf: aClass 
		instanceVariableNames: ivNamesString 
		classVariableNames: classVarsString 
		category:  (self packageName, '-', self defaultCategoryPostfix) asSymbol.! !

!ClassFactoryWithOrganization methodsFor: 'accessing' stamp: 'LucFabresse 10/24/2010 20:31'!
organization
	^organization! !

!ClassFactoryWithOrganization methodsFor: 'creating' stamp: 'SebastianTleye 8/9/2013 11:04'!
newSubclassOf: aClass instanceVariableNames: ivNamesString classVariableNames:  classVarsString category: category

	| newClass |
	newClass := self class classBuilder
		name: self newClassName 
		inEnvironment: self organization environment
		subclassOf: aClass
		type: aClass typeOfClass
		instanceVariableNames: ivNamesString
		classVariableNames: classVarsString
		poolDictionaries: ''
		category: category asSymbol.
	self createdClasses add: newClass.
	^newClass! !

!ClassFactoryWithOrganization class methodsFor: 'instance creation' stamp: 'LucFabresse 10/24/2010 20:33'!
newWithOrganization: aSystemOrganizer
	^self new
		organization: aSystemOrganizer;
		yourself! !

!ClassFactoryWithOrganizationTest commentStamp: 'TorstenBergmann 2/12/2014 23:16'!
SUnit tests for ClassFactoryWithOrganization!
!ClassFactoryWithOrganizationTest methodsFor: 'testing' stamp: 'LucFabresse 10/24/2010 19:48'!
assertEnvironmentOf: aBehavior
	self assert: aBehavior environment = self testedEnvironment! !

!ClassFactoryWithOrganizationTest methodsFor: 'testing' stamp: 'LucFabresse 10/24/2010 19:41'!
testDefaultCategoryCleanUp
	| createdClassNames allClasses |
	3 timesRepeat: [
		factory newClass].
	createdClassNames := factory createdClassNames.
	factory cleanUp.	
	self assert: (factory createdClasses allSatisfy: [:class| class isObsolete]). 
	allClasses := self testedEnvironment allClasses.
	self assert: (factory createdClasses noneSatisfy: [:class| allClasses includes: class]).
	self deny: (self testedOrganization categories includes: factory defaultCategory). 
	self deny: (ChangeSet current changedClassNames includesAnyOf: createdClassNames)
! !

!ClassFactoryWithOrganizationTest methodsFor: 'testing' stamp: 'LucFabresse 10/24/2010 19:51'!
testSingleClassCreation
	|class elementsInCategoryForTest |
	class := factory 
		newSubclassOf: Object 
		instanceVariableNames: 'a b c' 
		classVariableNames: 'X Y'.
	self assert: (self testedEnvironment allClasses includes: class).
	factory createdClasses do: [ :aClass |
		self assertEnvironmentOf: aClass ].
	elementsInCategoryForTest := self testedOrganization listAtCategoryNamed: factory defaultCategory. 
	self assert: elementsInCategoryForTest = {class name}.
	self assert: class instVarNames = #(a b c).
	self assert: class classPool keys asSet = #(X Y) asSet! !

!ClassFactoryWithOrganizationTest methodsFor: 'testing' stamp: 'LucFabresse 10/24/2010 19:51'!
testSingleClassFastCreation
	|class elementsInCategoryForTest |
	class := factory newClass.
	self assert: (self testedEnvironment allClasses includes: class).
	elementsInCategoryForTest := self testedOrganization listAtCategoryNamed: factory defaultCategory. 
	factory createdClasses do: [ :aClass |
		self assertEnvironmentOf: aClass ].
	self assert: elementsInCategoryForTest = {class name}.
	self assert: class instVarNames isEmpty.
	self assert: class classPool isEmpty! !

!ClassFactoryWithOrganizationTest methodsFor: 'accessing' stamp: 'LucFabresse 10/24/2010 20:31'!
testedOrganization
	^factory organization! !

!ClassFactoryWithOrganizationTest methodsFor: 'testing' stamp: 'LucFabresse 10/29/2010 09:09'!
testClassCreationInDifferentCategories
	| firstThreeClasses lastTwoClasses |
	3 timesRepeat: [
		factory newSubclassOf: Object instanceVariableNames: '' classVariableNames: '' category: #One].
	firstThreeClasses := factory createdClasses copy.
	2 timesRepeat: [
		factory newSubclassOf: Object instanceVariableNames: '' classVariableNames: '' category: #Two].
	lastTwoClasses := factory createdClasses copyWithoutAll: firstThreeClasses.
	self assert: (firstThreeClasses allSatisfy: [:class| class category = #One]).
	self assert: (lastTwoClasses allSatisfy: [:class| class category = #Two]).
	factory createdClasses do: [ :aClass |
		self assertEnvironmentOf: aClass ]! !

!ClassFactoryWithOrganizationTest methodsFor: 'testing' stamp: 'LucFabresse 10/24/2010 19:50'!
testMultipleClassCreation
	5 timesRepeat: [
		factory newClass].
	self assert: (self testedEnvironment allClasses includesAllOf: factory createdClasses).
	self assert: factory createdClassNames asSet size = 5.
	self assert: (self testedOrganization listAtCategoryNamed: factory defaultCategory) asSet = factory createdClassNames asSet.
	factory createdClasses do: [ :aClass |
		self assertEnvironmentOf: aClass ]! !

!ClassFactoryWithOrganizationTest methodsFor: 'testing' stamp: 'LucFabresse 10/24/2010 19:50'!
testPackageCleanUp
	| createdClassNames allClasses |
	3 timesRepeat: [
		factory newClassInCategory: #One].
	2 timesRepeat: [
		factory newClassInCategory: #Two].
	createdClassNames := factory createdClassNames.
	factory cleanUp.	
	self assert: (factory createdClasses allSatisfy: [:class| class isObsolete]). 
	allClasses := self testedEnvironment allClasses.
	self assert: (factory createdClasses noneSatisfy: [:class| allClasses includes: class]).
	self assert: (self testedOrganization categoriesMatching: factory packageName, '*') isEmpty. 
	self deny: (ChangeSet current changedClassNames includesAnyOf: createdClassNames).
! !

!ClassFactoryWithOrganizationTest methodsFor: 'testing' stamp: 'LucFabresse 10/29/2010 09:14'!
testClassFastCreationInDifferentCategories
	| firstThreeClasses lastTwoClasses |
	3 timesRepeat: [
		factory newClassInCategory: #One].
	firstThreeClasses := factory createdClasses copy.
	2 timesRepeat: [
		factory newClassInCategory: #Two].
	lastTwoClasses := factory createdClasses copyWithoutAll: firstThreeClasses.
	self assert: (firstThreeClasses allSatisfy: [:class| class category =  #One]).
	self assert: (lastTwoClasses allSatisfy: [:class| class category = #Two]).
	factory createdClasses do: [ :aClass |
		self assertEnvironmentOf: aClass ]! !

!ClassFactoryWithOrganizationTest methodsFor: 'setUp-tearDown' stamp: 'LucFabresse 12/19/2010 12:42'!
setUp
	| environment |
	super setUp.
	environment := SystemDictionary withOrganizer: SystemOrganizer new.
	factory := ClassFactoryWithOrganization newWithOrganization: environment organization.
	! !

!ClassFactoryWithOrganizationTest methodsFor: 'accessing' stamp: 'LucFabresse 10/24/2010 19:57'!
testedEnvironment
	^self testedOrganization environment! !

!ClassHierarchyTest commentStamp: 'TorstenBergmann 2/5/2014 08:31'!
SUnit tests for the class hierarchy!
!ClassHierarchyTest methodsFor: 'tests' stamp: 'MarcusDenker 7/12/2012 18:00'!
testSubclassInstVar
	| subclasses |
	SystemNavigation new allClassesDo: [ :cls|
		subclasses := cls subclasses.
		self assert: subclasses isNil not.
		subclasses do: [:subclass|
			self assert: (subclasses occurrencesOf: subclass) = 1.
			self assert: subclass superclass == cls.
			"cls removeSubclass: subclass.
			cls addSubclass: subclass."]]! !

!ClassHierarchyTest methodsFor: 'tests' stamp: 'CamilloBruni 1/30/2013 15:48'!
testSubclasses
	" self class fixSubclasses "
	
	| subclasses |
	
	SystemNavigation new allClassesDo: [ :cls|
		self 
			assert: (cls superclass subclasses includes: cls) 
			description: cls name, ' is not in ', cls superclass name, '''s subclasses' ]! !

!ClassHierarchyTest class methodsFor: 'fixing' stamp: 'MarcusDenker 4/14/2014 16:15'!
fixSubclasses
	"Fix all the missing subclasses"
	"ClassHierarchyTest fixSubclasses "
	SystemNavigation new allClassesDo: [ :cls|
		(cls superclass subclasses includes: cls)
			ifFalse: [ cls superclass addSubclass: cls ]]! !

!ClassHierarchyTest class methodsFor: 'fixing' stamp: 'MarcusDenker 9/26/2014 16:57'!
fixSlotScope
	"postscript for issue 11596"
	
	| ivName all candidates toRebuild |
    ivName := 'anIVNameImPrettySureNobodyUses'.
    all := Smalltalk allClasses flatCollect: [ :e | { e . e class } ].
    candidates := all reject: [ :e | e superclass isNil or: [e layout slotScope isKindOf: LayoutEmptyScope ] ].
    toRebuild := candidates reject: [ :e | e superclass layout slotScope == e layout slotScope parentScope ].
    toRebuild sort: [ :a :b | a allSuperclasses size > b allSuperclasses size ].
    toRebuild do: [ :e | 
    e addInstVarNamed: ivName.
        (e isClassSide
          ifTrue: [ (Smalltalk at: e instanceSide name) classSide ]
          ifFalse: [ Smalltalk at: e name ]) removeInstVarNamed: ivName ]! !

!ClassListExample commentStamp: 'AlainPlantec 1/22/2010 15:10'!
ClassListExample new openOn: Object
!
!ClassListExample methodsFor: 'accessing' stamp: 'AlainPlantec 2/7/2010 22:44'!
rootNodeClassFromItem: anItem
	^ClassListNodeExample! !

!ClassListExample methodsFor: 'user interface' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
treeMorph
	| treeMorph baseColor oddColor evenColor |
	baseColor := Color lightBlue lighter.
	oddColor := (GradientFillStyle ramp: {
		0.0->baseColor whiter. 0.2->baseColor.
		0.8->baseColor darker. 1.0->baseColor blacker}) radial: false.
	baseColor := Color veryLightGray muchLighter.
	evenColor := (GradientFillStyle ramp: {
		0.0->baseColor lighter lighter. 0.2->baseColor lighter.
		0.8->baseColor. 1.0->baseColor blacker}) radial: false.
		
	treeMorph := self treeMorphClass new 
		model: self;
		beMultiple;
		columns: {MorphTreeColumn new startWidth: 100;
						rowMorphGetSelector: #classButton;
						headerButtonLabel: 'Class' 
							font:  nil  
							icon: Smalltalk ui icons smallOpenIcon 
							target: nil 
							actionSelector: nil 
							arguments: #().
					MorphTreeColumn new 
						rowMorphGetSelector: #commentText;
					 	headerButtonLabel: 'Comments' 
							font: nil 
							icon: Smalltalk ui icons smallPrintIcon 
							target: nil 
							actionSelector: nil 
							arguments: #()};
		makeLastColumnUnbounded;
		withHLines: true;
		allowColumnDrop;
		useSquareCorners;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		rowInset: 5;
		columnInset: 5;
		resizerWidth: 2;
		preferedPaneColor: Color white;
		getMenuSelector: #menu:shifted:;
		columnColorForEven: evenColor odd: oddColor.
	^ treeMorph buildContents! !

!ClassListExample methodsFor: 'instance creation' stamp: 'StephaneDucasse 12/19/2012 16:12'!
openOn: aClass
	| window |
	self rootClass: aClass.
	window := StandardWindow new model: self.
	window title: aClass name, ' hierarchy'.
	window 
		addMorph: self treeMorph
		fullFrame: LayoutFrame identity.						
	window themeChanged.
	window openInWorld.
	^ window! !

!ClassListExample methodsFor: 'instance creation' stamp: 'AlainPlantec 1/16/2010 09:50'!
open
	^ self openOn: Object
! !

!ClassListExample methodsFor: 'accessing' stamp: 'AlainPlantec 2/25/2011 17:03'!
keyStroke: anEvent from: aTreeMorph
	self selectedNode
		ifNotNil: [:current | current keyStroke: anEvent from: aTreeMorph]! !

!ClassListExample methodsFor: 'accessing' stamp: 'AlainPlantec 1/16/2010 09:50'!
rootClass: aClass
	 rootClass := aClass! !

!ClassListExample methodsFor: 'accessing' stamp: 'AlainPlantec 1/16/2010 09:50'!
rootClass
	^ rootClass ifNil: [rootClass := Object]! !

!ClassListExample methodsFor: 'accessing' stamp: 'AlainPlantec 1/15/2010 13:56'!
rootItems
	^ self rootClass allSubclasses asArray sort: [:a :b | a name < b name ]! !

!ClassListExample methodsFor: 'accessing' stamp: 'AlainPlantec 1/18/2010 16:43'!
menu: menu shifted: b 
	"Set up the menu to apply to the receiver's, 
	honoring the #shifted boolean"
	super menu: menu shifted: b.
	menu addLine.
	self selectedNode ifNotNil: [:current | current menu: menu shifted: b].
	^ menu! !

!ClassListExample class methodsFor: 'examples' stamp: 'TorstenBergmann 9/30/2014 20:09'!
example

	^self new openOn: self! !

!ClassListNodeExample commentStamp: 'TorstenBergmann 2/3/2014 23:56'!
Example for a class list node!
!ClassListNodeExample methodsFor: 'menu' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
icon
	^ Smalltalk ui icons smallExpertIcon! !

!ClassListNodeExample methodsFor: 'menu' stamp: 'FernandoOlivero 4/12/2011 09:41'!
commentText
	^ ( self theme  newTextIn: World text: self item comment) unlock; wrapFlag: true; yourself! !

!ClassListNodeExample methodsFor: 'accessing' stamp: 'StephaneDucasse 10/15/2011 20:53'!
browseItem
	Smalltalk tools browser fullOnClass: self item selector: nil ! !

!ClassListNodeExample methodsFor: 'accessing' stamp: 'AlainPlantec 1/16/2010 09:50'!
inspectItem
	self inspect! !

!ClassListNodeExample methodsFor: 'accessing' stamp: 'AlainPlantec 2/25/2011 17:04'!
keyStroke: anEvent from: aTreeMorph
	| c |
	c := anEvent keyCharacter.
	c = $b
		ifTrue: [self browseItem. ^ true].
	c = $i
		ifTrue: [self inspectItem. ^ true].
	c = $I
		ifTrue: [self exploreItem. ^ true].
	^ false
! !

!ClassListNodeExample methodsFor: 'menu' stamp: 'FernandoOlivero 4/12/2011 10:10'!
classButton
	^ ( self theme 
				newButtonIn: World
				for: self
				getState: nil
				action: #browseItem
				arguments: {}
				getEnabled: #enabled
				getLabel: nil
				help: 'Open a browser on ' translated , self item name)
				label: (self theme windowLabelForText: (self item name) , '...');
				yourself! !

!ClassListNodeExample methodsFor: 'accessing' stamp: 'AlainPlantec 1/16/2010 09:50'!
exploreItem
	self explore! !

!ClassListNodeExample methodsFor: 'accessing' stamp: 'StephaneDucasse 10/22/2014 21:27'!
menu: menu shifted: b 
	menu
		add: 'Browse (b)' 
		target: self
		selector: #browseItem.
	menu
		add: 'Inspect (i)' 
		target: self
		selector: #inspectItem.
	menu
		add: 'Explore (I)' 
		target: self
		selector: #exploreItem.
! !

!ClassMethodBrowser commentStamp: '<historical>'!
A ClassMethodBrowser is a simple browser using spec and reusing MethodBrowser to browse classes>>methods>>sourceCode.
	| cb |
	cb := ClassMethodBrowser new.
	cb openWithSpec.
	cb classes: Smalltalk allClasses.!
!ClassMethodBrowser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/14/2011 18:03'!
methodModel

	^ methodModel! !

!ClassMethodBrowser methodsFor: 'initialization' stamp: 'CamilloBruni 9/22/2013 21:28'!
initializeWidgets

	listModel := self newList.
	methodModel := self instantiate: MethodBrowser.
	
	self focusOrder
		add: listModel;
		add: methodModel.
	
	methodModel displayBlock: [:method | method selector ].! !

!ClassMethodBrowser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/14/2011 18:03'!
listModel

	^ listModel! !

!ClassMethodBrowser methodsFor: 'initialization' stamp: 'MarcusDenker 5/4/2013 10:15'!
initializePresenter
	
	listModel whenSelectedItemChanged: [:selection |
		selection 
			ifNotNil: [:class | 
				methodModel methods: (class methods sort: [:a :b | a selector < b selector]).
				methodModel listModel resetSelection ]].! !

!ClassMethodBrowser methodsFor: 'api' stamp: 'BenjaminVanRyseghem 6/22/2012 19:16'!
classes: aList

	self listModel items: aList! !

!ClassMethodBrowser class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 6/22/2012 19:19'!
defaultSpec
<spec>
	^ SpecLayout composed
		newRow: [:row | row
						add: #listModel;
						add: #methodModel ];
		yourself! !

!ClassMethodBrowser class methodsFor: 'example' stamp: 'BenjaminVanRyseghem 2/2/2012 13:39'!
example

	"self example"
	| cb |
	cb := ClassMethodBrowser new.
	cb openWithSpec.
	cb classes: Smalltalk allClasses.! !

!ClassMethodBrowser class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 12/14/2011 18:12'!
title

	^ 'Class Method Browser'! !

!ClassMethodBrowser class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 4/3/2013 17:32'!
defaultSpec2
<spec: #default>

	^ SpecLayout composed
		newRow: [:r | 
			r 
				newColumn: #listModel right: 0.5;
				addVSplitter;
				newColumn: #(methodModel listModel) left: 0.5 ] bottom: 0.5;
		addHSplitter;
		newRow: #(methodModel textModel) top: 0.5;
		yourself! !

!ClassModification commentStamp: '<historical>'!
I represent a modification in a class. !
!ClassModification methodsFor: 'accessing' stamp: 'MarcusDenker 7/17/2014 21:10'!
classVariables
	
	^ classVariables! !

!ClassModification methodsFor: 'accessing' stamp: 'ToonVerwaest 3/20/2011 15:49'!
changes
	^ changes! !

!ClassModification methodsFor: 'testing' stamp: 'MartinDias 2/7/2014 16:43'!
modifiesSuperclass

	^ (target superclass == superclass) not! !

!ClassModification methodsFor: 'accessing' stamp: 'ToonVerwaest 3/20/2011 14:30'!
removals: aCollection
	removals := aCollection! !

!ClassModification methodsFor: 'installing' stamp: 'ToonVerwaest 3/28/2011 20:02'!
installSlotRemoval: slot on: aModification
	0 to: slot size - 1 do: [ :idx |
		(RemovedField new
			originalSlot: slot;
			fieldIndex: idx) installOn: aModification ]! !

!ClassModification methodsFor: 'testing' stamp: 'MartinDias 2/7/2014 17:16'!
modifiesSharedPools

	^ (target sharedPoolsString = sharedPools) not! !

!ClassModification methodsFor: 'accessing' stamp: 'ToonVerwaest 4/2/2011 20:54'!
traitComposition: aTraitComposition
	" We copy the trait composition since we might want "
	" to update the slot indices if the composition is partly stateful "
	traitComposition := aTraitComposition copyTraitExpression! !

!ClassModification methodsFor: 'initialization' stamp: 'ToonVerwaest 4/1/2011 03:31'!
initialize
	super initialize.
	changes := IdentityDictionary new.
	copies := IdentityDictionary new.
	removals := {}.
	additions := {}.! !

!ClassModification methodsFor: 'accessing' stamp: 'MartinDias 2/7/2014 16:30'!
sharedPools: anObject
	
	sharedPools := anObject! !

!ClassModification methodsFor: 'accessing' stamp: 'MartinDias 6/24/2013 16:54'!
superLayout
	^ superclass
		ifNil: [ EmptyLayout instance ]
		ifNotNil: [ superclass layout ]! !

!ClassModification methodsFor: 'installing' stamp: 'ToonVerwaest 3/30/2011 13:41'!
installSlotCopiedFrom: oldSlot to: newSlot on: aModification
	0 to: newSlot size - 1 do: [ :idx |
 		(UnmodifiedField new
			slot: newSlot;
			fieldIndex: idx) installOn: aModification ]! !

!ClassModification methodsFor: 'accessing' stamp: 'ToonVerwaest 3/28/2011 17:45'!
copies
	^ copies! !

!ClassModification methodsFor: 'installing' stamp: 'ToonVerwaest 3/28/2011 20:02'!
installSlotChangeFrom: oldSlot to: newSlot on: aModification
	0 to: newSlot size - 1 do: [ :idx |
 		(ModifiedField new
			newSlot: newSlot;
			originalSlot: oldSlot;
			fieldIndex: idx) installOn: aModification ]! !

!ClassModification methodsFor: 'accessing' stamp: 'ToonVerwaest 3/31/2011 19:48'!
traitComposition
	^ traitComposition! !

!ClassModification methodsFor: 'installing' stamp: 'ToonVerwaest 3/28/2011 20:02'!
installSlotAddition: slot on: aModification
	0 to: slot size - 1 do: [ :idx |
		(AddedField new
			newSlot: slot;
			fieldIndex: idx) installOn: aModification  ]! !

!ClassModification methodsFor: 'testing' stamp: 'MartinDias 2/7/2014 16:44'!
isPropagation

	^ false! !

!ClassModification methodsFor: 'private' stamp: 'ToonVerwaest 4/3/2011 11:21'!
computeChange
	super computeChange.
	layout computeChangesFrom: target layout in: self.
	slotShift := layout fieldSize - target layout fieldSize.
	self propagate.! !

!ClassModification methodsFor: 'accessing' stamp: 'ToonVerwaest 3/20/2011 23:32'!
slotShift
	^ slotShift! !

!ClassModification methodsFor: 'accessing' stamp: 'ToonVerwaest 4/1/2011 02:27'!
methodModification
	^ methodModification ifNil: [
		methodModification := MethodModification new: target layout fieldSize.
		self buildModificationMapFor: methodModification ]! !

!ClassModification methodsFor: 'accessing' stamp: 'MarcusDenker 2/6/2015 13:11'!
removals
	^ removals! !

!ClassModification methodsFor: 'accessing' stamp: 'ToonVerwaest 3/20/2011 14:30'!
additions: aCollection
	additions := aCollection! !

!ClassModification methodsFor: 'accessing' stamp: 'ToonVerwaest 4/1/2011 03:03'!
originalScope
	^ target layout slotScope! !

!ClassModification methodsFor: 'testing' stamp: 'MartinDias 2/7/2014 16:43'!
modifiesSlots

	^ (changes isEmpty and: [ removals isEmpty and: [ additions isEmpty ]]) not! !

!ClassModification methodsFor: 'testing' stamp: 'MarcusDenker 10/29/2014 13:28'!
modifiesClassVariables
	"Note: The meta class has the same class variables as it's non-meta class"

	^ target isInstanceSide and: [ target classVariables ~= classVariables ]! !

!ClassModification methodsFor: 'accessing' stamp: 'MarcusDenker 2/6/2015 13:11'!
additions
	^ additions! !

!ClassModification methodsFor: 'accessing' stamp: 'MartinDias 8/7/2013 18:06'!
layoutClass: layoutClass slots: slotArray compactClassIndex: compactClassIndex
	| parentLayout newScope newLayout |
	parentLayout := self superLayout.
	newScope := parentLayout slotScope extend: slotArray.
	newLayout := layoutClass extending: parentLayout scope: newScope host: self target.
	newLayout compactClassIndex: compactClassIndex.
	self layout: newLayout! !

!ClassModification methodsFor: 'testing' stamp: 'MartinDias 2/7/2014 16:44'!
modifiesFormat

	^ (layout format = target layout format) not! !

!ClassModification methodsFor: 'accessing' stamp: 'ToonVerwaest 3/20/2011 19:34'!
superclass
	^ superclass! !

!ClassModification methodsFor: 'accessing' stamp: 'ToonVerwaest 3/20/2011 14:32'!
superclass: aClass
	superclass := aClass! !

!ClassModification methodsFor: 'private' stamp: 'CamilloBruni 3/29/2011 19:00'!
buildModificationMapFor: aModification
	aModification slotShift: (ShiftedField new shift: slotShift).
	
	aModification size = 0 
		ifTrue: [ ^ aModification ].
	
	additions do: [ :slot | 
		self installSlotAddition: slot on: aModification].
	
	changes keysAndValuesDo: [ :newSlot :oldSlot | 
		self installSlotChangeFrom: oldSlot to: newSlot on: aModification ].
	
	removals do: [ :slot | 
		self installSlotRemoval: slot on: aModification].
	
	copies keysAndValuesDo: [ :newSlot :oldSlot | 
		self installSlotCopiedFrom: oldSlot to: newSlot on: aModification ].
	
	^ aModification! !

!ClassModification methodsFor: 'accessing' stamp: 'MarcusDenker 7/17/2014 21:10'!
classVariables: anObject
	
	classVariables := anObject! !

!ClassModification methodsFor: 'accessing' stamp: 'ToonVerwaest 4/1/2011 02:45'!
instanceModification
	| map |
	map := InstanceModification new: layout fieldSize.
	^ self buildModificationMapFor: map! !

!ClassModification methodsFor: 'accessing' stamp: 'ToonVerwaest 4/1/2011 03:04'!
newScope
	^ layout slotScope! !

!ClassModification methodsFor: 'accessing' stamp: 'MartinDias 2/7/2014 16:30'!
sharedPools
	
	^ sharedPools! !

!ClassModification class methodsFor: 'instance creation' stamp: 'MarcusDenker 7/17/2014 21:11'!
modify: aClass extend: aSuperclass withLayoutType: layoutClass slots: someSlots sharedVariables: someClassVariables sharedPools: someSharedPools traitComposition: aTraitComposition compactClassIndex: compactClassIndex
	^ self new
		target: aClass;
		superclass: aSuperclass;
		traitComposition: aTraitComposition;
		classVariables: someClassVariables;
		sharedPools: someSharedPools;
		layoutClass: layoutClass slots: someSlots compactClassIndex: compactClassIndex;
		yourself! !

!ClassModificationPropagation commentStamp: 'MartinDias 1/28/2014 16:22'!
I represent a modification in a class that is produced because of a change in one of its superclasses. This is called a propagation.!
!ClassModificationPropagation methodsFor: 'testing' stamp: 'MartinDias 1/28/2014 16:22'!
isPropagation
	^true! !

!ClassModificationPropagation methodsFor: 'migrating' stamp: 'ToonVerwaest 3/27/2011 21:14'!
methodModification
	^ origin methodModification! !

!ClassModificationPropagation methodsFor: 'accessing' stamp: 'ToonVerwaest 4/1/2011 17:50'!
superclass
	^ origin newClass! !

!ClassModificationPropagation methodsFor: 'public' stamp: 'CamilloBruni 7/17/2013 13:46'!
propagate: aModification to: aTarget
	origin := aModification.
	target := aTarget.
	self layout: (target layout 
		reshapeFrom: origin oldLayout slotScope
		to: origin newLayout).! !

!ClassModificationPropagation class methodsFor: 'instance creation' stamp: 'ToonVerwaest 3/20/2011 14:51'!
propagate: aModification to: aClass
	^ self new
		propagate: aModification
		to: aClass! !

!ClassModifiedClassDefinition commentStamp: 'MartinDias 1/31/2014 16:31'!
This announcement will be emitted when a class or a trait definition changes.

For example, when an instance variable is added or when the trait composition is modified in a class definition.!
!ClassModifiedClassDefinition methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:10'!
oldClassDefinition
	^oldClassDefinition! !

!ClassModifiedClassDefinition methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:10'!
newClassDefinition
	^newClassDefinition! !

!ClassModifiedClassDefinition methodsFor: 'accessing' stamp: 'GuillermoPolito 8/3/2012 13:51'!
classAffected
	^self newClassDefinition! !

!ClassModifiedClassDefinition methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:10'!
oldClassDefinition: aClass
	oldClassDefinition := aClass! !

!ClassModifiedClassDefinition methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:09'!
newClassDefinition: aClass
	newClassDefinition := aClass! !

!ClassModifiedClassDefinition class methodsFor: 'instance creation' stamp: 'GuillermoPolito 8/2/2012 00:09'!
classDefinitionChangedFrom: oldClass to: newClass
	^self new
			oldClassDefinition: oldClass;
			newClassDefinition: newClass;
			yourself! !

!ClassMultiplePoolUser commentStamp: 'StephaneDucasse 12/13/2011 15:59'!
I'm a class using two shared pools. !
!ClassMultiplePoolUser class methodsFor: 'accessing' stamp: 'StephaneDucasse 12/13/2011 15:59'!
author

	^ Author! !

!ClassMultiplePoolUser class methodsFor: 'accessing' stamp: 'StephaneDucasse 12/13/2011 16:00'!
variableInPoolDefiner2

	^ VariableInPoolDefiner2! !

!ClassMultiplePoolUser class methodsFor: 'accessing' stamp: 'StephaneDucasse 12/13/2011 15:59'!
gloups

	^ Gloups! !

!ClassOrMethodDefinitionAcceptor commentStamp: '<historical>'!
I am an acceptor in the "weird" context when the text entered could be a class definition or a method definition.!
!ClassOrMethodDefinitionAcceptor methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/9/2013 09:24'!
acceptInstanceSide: source notifying: aController
	| isClassDefinition |
	
	isClassDefinition := false.
	
	"Try to parse the source. If it succeed, it means the source represents a message send aka a class definition. On error, we switch to method definition mode"
	[ RBParser parseMethod: source ]
		on: Error
		do: [ isClassDefinition := true ].

	isClassDefinition
		ifTrue: [
			self model
				compileAClassFrom: source 
				notifying: aController ]
		ifFalse: [
			self model
				compileAMethodFromCategory: Protocol unclassified
				withSource: source
				notifying: aController ]! !

!ClassOrMethodDefinitionAcceptor methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/9/2013 09:27'!
accept: source notifying: aController

	self model selectedClass isMeta
		ifTrue: [ self acceptClassSide: source notifying: aController ]
		ifFalse: [ self acceptInstanceSide: source notifying: aController ]! !

!ClassOrMethodDefinitionAcceptor methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/9/2013 09:29'!
acceptClassSide: source notifying: aController
	| isClassDefinition |
	
	isClassDefinition := (' ' split: source) first = self model selectedClass theNonMetaClass name.
	
	isClassDefinition
		ifTrue: [
			self model
				compileAClassFrom: source 
				notifying: aController ]
		ifFalse: [
			self model
				compileAMethodFromCategory: Protocol unclassified
				withSource: source
				notifying: aController ]! !

!ClassOrganization commentStamp: '<historical>'!
This object is in charge of system notifications.
It manages the class comment, the class comment stamp and a protocol organizer!
!ClassOrganization methodsFor: 'accessing' stamp: 'MarcusDenker 10/5/2013 21:19'!
comment: aString
	"Store the comment, aString, associated with the object that refers to the 
	receiver."

	comment := (aString isKindOf: RemoteString)
		ifTrue: [ aString ]
		ifFalse: [ 
			aString isEmptyOrNil
				ifTrue: [ nil ]
				ifFalse: [ RemoteString newString: aString onFileNumber: 2 ] ]	"Later add priorSource and date and initials?"! !

!ClassOrganization methodsFor: 'notifications' stamp: 'MarcusDenker 9/18/2012 13:50'!
notifyOfChangedCategoryFrom: oldNameOrNil to: newNameOrNil
	(self hasSubject and: [oldNameOrNil ~= newNameOrNil]) 
		ifTrue: [SystemAnnouncer uniqueInstance classReorganized: self subject].! !

!ClassOrganization methodsFor: 'backward compatibility' stamp: 'BenjaminVanRyseghem 4/12/2012 16:15'!
hasSubject

	^ organizedClass notNil! !

!ClassOrganization methodsFor: 'accessing' stamp: 'EstebanLorenzano 1/11/2014 23:09'!
removeCategory: protocolName
	(self protocolOrganizer hasProtocolNamed: protocolName)
		ifFalse: [ ^ self ].
	
	self removeProtocol: (self protocolNamed: protocolName)! !

!ClassOrganization methodsFor: 'initialization' stamp: 'EstebanLorenzano 5/28/2013 16:35'!
initializeClass: aClass
	self initialize.
	organizedClass := aClass.
	organizedClass selectors do: [ :each | 
		self classify: each under: Protocol unclassified ]! !

!ClassOrganization methodsFor: 'backward compatibility' stamp: 'EstebanLorenzano 6/21/2013 14:42'!
sortCategories
	"Do nothing"! !

!ClassOrganization methodsFor: 'backward compatibility' stamp: 'BenjaminVanRyseghem 4/12/2012 16:18'!
subject

	^organizedClass! !

!ClassOrganization methodsFor: 'backward compatibility - file in/out' stamp: 'MarcusDenker 8/7/2014 11:52'!
changeFromString: aString 
	"Parse the argument, aString, and make this be the receiver's structure."

	| categorySpecs |
	categorySpecs := aString parseLiterals.
	
	"If nothing was scanned and I had no elements before, then default me"
	(categorySpecs isEmpty and: [ self protocolOrganizer protocols isEmpty ])
		ifTrue: [ ^ self protocolOrganizer reset ].

	^ self changeFromCategorySpecs: categorySpecs! !

!ClassOrganization methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/12/2012 18:39'!
comment

	comment ifNil: [^ ''].
	^ comment string ifNil: ['']! !

!ClassOrganization methodsFor: 'initialization' stamp: 'EstebanLorenzano 5/28/2013 16:34'!
initialize 
	super initialize.
	protocolOrganizer := ProtocolOrganizer new.! !

!ClassOrganization methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/12/2012 16:45'!
categoriesSorted

	^ self protocolOrganizer protocolsSorted! !

!ClassOrganization methodsFor: 'backward compatibility' stamp: 'BenjaminVanRyseghem 4/12/2012 18:36'!
classComment: aString stamp: aStamp

	self
		comment: aString;
		commentStamp: aStamp! !

!ClassOrganization methodsFor: 'backward compatibility' stamp: 'BenjaminVanRyseghem 4/12/2012 15:51'!
classify: aSymbol under: aProtocolName

	^ self 
		classify: aSymbol
		under: aProtocolName
		suppressIfDefault: true! !

!ClassOrganization methodsFor: 'backward compatibility' stamp: 'BenjaminVanRyseghem 4/24/2012 14:18'!
listAtCategoryNumber: aSmallInteger 
	
	^ (protocolOrganizer allProtocols at: aSmallInteger ifAbsent: [ ^ {} ]) methods asArray! !

!ClassOrganization methodsFor: 'accessing' stamp: 'EstebanLorenzano 6/27/2013 18:01'!
realCategories
	^ self protocolOrganizer protocolsNames ! !

!ClassOrganization methodsFor: 'backward compatibility - file in/out' stamp: 'NicolaiHess 11/2/2014 22:26'!
putCommentOnFile: aFileStream numbered: sourceIndex moveSource: moveSource forClass: aClass
	"Store the comment about the class onto file, aFileStream."
	| header |
	
	self classComment isEmptyOrNil ifTrue:[ ^ self ].

	aFileStream cr; nextPut: $!!.
	header := String streamContents: [:strm | 
			strm nextPutAll: aClass name;
			nextPutAll: ' commentStamp: '.
			commentStamp ifNil: [commentStamp := '<historical>'].
			commentStamp storeOn: strm.
			strm nextPutAll: ' prior: '; nextPutAll: '0'].
	aFileStream nextChunkPut: header.
	aClass organization fileOutCommentOn: aFileStream
			moveSource: moveSource toFile: sourceIndex.
	aFileStream cr! !

!ClassOrganization methodsFor: 'notifications' stamp: 'EstebanLorenzano 6/26/2013 16:59'!
notifyOfAddedCategory: protocolName
	
	self hasSubject ifFalse: [ ^ self ].
	
	SystemAnnouncer uniqueInstance 
		protocolAdded: protocolName 
		inClass: self subject! !

!ClassOrganization methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/2/2013 16:21'!
protocols 
	^ self protocolOrganizer protocols.! !

!ClassOrganization methodsFor: 'backward compatibility' stamp: 'BenjaminVanRyseghem 4/12/2012 16:15'!
setSubject: anObject
	
	organizedClass := anObject! !

!ClassOrganization methodsFor: 'backward compatibility' stamp: 'EstebanLorenzano 11/29/2013 16:09'!
renameCategory: oldName toBe: newName
	
	self 
		silentlyRenameCategory: oldName 
		toBe: newName.

	self notifyOfChangedCategoryFrom: oldName to: newName.
	"I need to notify also the selector changes, otherwise RPackage will not notice"
	(self protocolOrganizer protocolNamed: newName) methods 
		do: [ :each | self notifyOfChangedSelector: each from: oldName to: newName ]! !

!ClassOrganization methodsFor: 'backward compatibility' stamp: 'CamilleTeruel 8/26/2014 13:14'!
classify: selector under: aProtocolName suppressIfDefault: aBoolean
	| oldProtocol forceNotify |
	forceNotify := (self protocolOrganizer includesSelector: selector) not.
	oldProtocol := self categoryOfElement: selector.
	(forceNotify or: [ oldProtocol ~= aProtocolName or: [ aBoolean not or: [ aProtocolName ~= Protocol unclassified ] ] ])
		ifFalse: [ ^ self ].
	self protocolOrganizer classify: selector inProtocolNamed: aProtocolName suppressIfDefault: aBoolean.
	oldProtocol ifNotNil: [ self notifyOfChangedSelector: selector from: oldProtocol to: aProtocolName ]! !

!ClassOrganization methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/12/2012 15:52'!
organizedClass
	^ organizedClass! !

!ClassOrganization methodsFor: 'accessing' stamp: 'EstebanLorenzano 6/26/2013 16:57'!
addCategory: aString
	| oldCategories |
	
	(self protocolOrganizer hasProtocolNamed: aString)
		ifTrue: [ ^self ].

	oldCategories := self categories copy.
	self protocolOrganizer addProtocolNamed: aString.
	self notifyOfAddedCategory: aString.
	self 
		notifyOfChangedCategoriesFrom: oldCategories 
		to: self categories.! !

!ClassOrganization methodsFor: 'testing' stamp: 'EstebanLorenzano 11/29/2013 16:09'!
isEmptyCategoryNamed: categoryName
	^ (self protocolOrganizer protocolNamed: categoryName) isEmpty! !

!ClassOrganization methodsFor: 'accessing' stamp: 'EstebanLorenzano 6/27/2013 18:01'!
categories

	^ self protocolOrganizer allProtocolsNames! !

!ClassOrganization methodsFor: 'testing' stamp: 'MarcusDenker 7/17/2013 14:29'!
hasComment
	^ self comment isEmptyOrNil not ! !

!ClassOrganization methodsFor: 'importing' stamp: 'BenjaminVanRyseghem 4/12/2012 18:29'!
importFrom: aClassOrganizer 
	
	organizedClass := aClassOrganizer subject.
	self comment: aClassOrganizer classComment.
	self commentStamp: aClassOrganizer commentStamp.
	
	protocolOrganizer := (ProtocolOrganizer importFrom: aClassOrganizer)! !

!ClassOrganization methodsFor: 'private' stamp: 'EstebanLorenzano 5/28/2013 18:05'!
silentlyRenameCategory: oldName toBe: newName

	self protocolOrganizer 
		renameProtocol: oldName
		into: newName.
! !

!ClassOrganization methodsFor: 'backward compatibility' stamp: 'BenjaminVanRyseghem 4/12/2012 15:03'!
classComment: aString

	self comment: aString! !

!ClassOrganization methodsFor: 'backward compatibility - file in/out' stamp: 'BenjaminVanRyseghem 4/12/2012 18:29'!
scanFrom: aStream
	"Reads in the organization from the next chunk on aStream.
	Categories or elements not found in the definition are not affected.
	New elements are ignored."

	self changeFromString: aStream nextChunk.
	aStream skipStyleChunk.! !

!ClassOrganization methodsFor: 'backward compatibility' stamp: 'PavelKrivanek 9/24/2013 14:19'!
ownCategories
        "get all categories that are not obtained from traits. Order is random"

        | traitsCategories |

        traitsCategories := self subject traits
                inject: Set new
                into: [:set :trait |
                        set addAll: (trait organization protocolOrganizer protocols
                                reject: [ :eachProtocol |
                                        self subject methods anySatisfy: [ :eachMethod |
                                                eachMethod origin = self subject
                                                                and: [ eachMethod protocol = eachProtocol name ] ] ]).
                        set ].

        ^ ((self protocolOrganizer protocols collect: #name)
                copyWithoutAll: (traitsCategories collect: #name)) asArray.! !

!ClassOrganization methodsFor: 'backward compatibility - file in/out' stamp: 'BenjaminVanRyseghem 4/13/2012 13:46'!
internalChangeFromString: categorySpecs 
	"Parse the argument, aString, and make this be the receiver's structure."

	protocolOrganizer := ProtocolOrganizer fromSpec: categorySpecs! !

!ClassOrganization methodsFor: 'notifications' stamp: 'EstebanLorenzano 6/21/2013 14:20'!
notifyOfChangedSelector: element from: oldCategory to: newCategory
	(self hasSubject and: [(oldCategory ~= newCategory)]) 
		ifTrue: [
			self subject 
				notifyOfRecategorizedSelector: element 
				from: oldCategory 
				to: newCategory ].! !

!ClassOrganization methodsFor: 'backward compatibility' stamp: 'BenjaminVanRyseghem 4/24/2012 14:38'!
removeEmptyCategories
	| oldCategories |
	
	oldCategories := self protocolOrganizer allProtocolsNames copy.
	self protocolOrganizer removeEmptyProtocols.
	self notifyOfChangedCategoriesFrom: oldCategories to: self protocolOrganizer allProtocolsNames.! !

!ClassOrganization methodsFor: 'backward compatibility' stamp: 'BenjaminVanRyseghem 4/12/2012 15:02'!
classComment

	^ self comment! !

!ClassOrganization methodsFor: 'notifications' stamp: 'EstebanLorenzano 6/26/2013 16:59'!
notifyOfRemovedCategory: protocolName
	
	self hasSubject ifFalse: [ ^ self ].
	
	SystemAnnouncer uniqueInstance 
		protocolRemoved: protocolName 
		inClass: self subject! !

!ClassOrganization methodsFor: 'backward compatibility - file in/out' stamp: 'CamilloBruni 6/29/2013 20:23'!
fileOutCommentOn: aFileStream moveSource: moveSource toFile: fileIndex
	"Copy the class comment to aFileStream.  If moveSource is true (as in compressChanges or compressSources, then update classComment to point to the new file."
	| fileComment |
	self classComment ifNil: [ ^ self ].
	
	aFileStream cr.
	fileComment := RemoteString 
						newString: self classComment string
						onFileNumber: fileIndex 
						toFile: aFileStream.
	moveSource 
		ifTrue: [ self classComment: fileComment ]! !

!ClassOrganization methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/28/2013 14:52'!
listAtCategoryNamed: aName		
	^ (self protocolOrganizer methodsInProtocolNamed: aName) asArray! !

!ClassOrganization methodsFor: 'backward compatibility' stamp: 'BenjaminVanRyseghem 4/24/2012 14:17'!
allMethodSelectors
	
	^ protocolOrganizer allMethods! !

!ClassOrganization methodsFor: 'backward compatibility' stamp: 'EstebanLorenzano 6/21/2013 14:41'!
removeElement: aSymbol
	| oldProtocol |
	
	oldProtocol := self categoryOfElement: aSymbol.
	self protocolOrganizer removeMethod: aSymbol.
	self notifyOfChangedSelector: aSymbol from: oldProtocol to: (self categoryOfElement: aSymbol).! !

!ClassOrganization methodsFor: 'backward compatibility' stamp: 'CT 9/2/2014 12:42'!
categoryOfElement: aSelector

	^ self categoryOfElement: aSelector ifAbsent: [ nil ]! !

!ClassOrganization methodsFor: 'notifications' stamp: 'EstebanLorenzano 6/21/2013 14:35'!
notifyOfChangedCategoriesFrom: oldCollectionOrNil to: newCollectionOrNil
	(self hasSubject and: [ oldCollectionOrNil ~= newCollectionOrNil ]) 
		ifTrue: [ SystemAnnouncer uniqueInstance classReorganized: self subject ].! !

!ClassOrganization methodsFor: 'accessing' stamp: 'EstebanLorenzano 1/11/2014 23:10'!
removeProtocol: aProtocol
	| oldCategories |
	
	oldCategories := self protocolOrganizer allProtocolsNames copy.
	self protocolOrganizer removeProtocol: aProtocol.
	self notifyOfRemovedCategory: aProtocol name.
	self 
		notifyOfChangedCategoriesFrom: oldCategories 
		to: self protocolOrganizer allProtocolsNames.! !

!ClassOrganization methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/12/2012 15:04'!
commentStamp: anObject
	commentStamp := anObject! !

!ClassOrganization methodsFor: 'accessing' stamp: 'EstebanLorenzano 11/29/2013 16:08'!
protocolNamed: aString 
	^ self protocolOrganizer 
		protocolNamed: aString 
		ifAbsent: [ nil ] ! !

!ClassOrganization methodsFor: 'backward compatibility' stamp: 'CamilloBruni 2/21/2014 23:35'!
commentRemoteString

	^ comment! !

!ClassOrganization methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/12/2012 15:04'!
commentStamp
	^ commentStamp! !

!ClassOrganization methodsFor: 'backward compatibility' stamp: 'CT 9/2/2014 12:41'!
categoryOfElement: aSelector ifAbsent: aBlock

	^ (self protocolOrganizer protocolsOfSelector: aSelector)
		ifEmpty: [ 
			(organizedClass includesSelector: aSelector)
				ifTrue: [ Protocol unclassified ]
				ifFalse: aBlock ]
		ifNotEmpty: [:col | col first name ]! !

!ClassOrganization methodsFor: 'backward compatibility - file in/out' stamp: 'BenjaminVanRyseghem 4/12/2012 18:11'!
changeFromCategorySpecs: categorySpecs

	"notification"
	self internalChangeFromString: categorySpecs! !

!ClassOrganization methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/2/2013 16:22'!
extensionProtocols 
	^ self protocolOrganizer extensionProtocols.! !

!ClassOrganization methodsFor: 'backward compatibility' stamp: 'EstebanLorenzano 6/21/2013 14:38'!
addCategory: aProtocolName before: aUselessArgument
	self addCategory: aProtocolName! !

!ClassOrganization methodsFor: 'private' stamp: 'BenjaminVanRyseghem 4/12/2012 15:01'!
protocolOrganizer
	
	^ protocolOrganizer! !

!ClassOrganization methodsFor: 'backward compatibility - file in/out' stamp: 'BenjaminVanRyseghem 4/12/2012 18:10'!
stringForFileOut

	^ self protocolOrganizer stringForFileOut! !

!ClassOrganization methodsFor: 'accessing' stamp: 'ThierryGoubier 1/13/2014 20:50'!
removeProtocolIfEmpty: protocolName
	"The protocol may already have been removed, be non empty or a special protocol which can't be removed, such as 'all'."

	(self protocolNamed: protocolName)
		ifNotNil: [ :protocol | 
			(protocol isEmpty and: [ protocol canBeRemoved ])
				ifTrue: [ self removeProtocol: protocol ] ]! !

!ClassOrganization class methodsFor: 'import' stamp: 'BenjaminVanRyseghem 4/24/2012 14:11'!
importFrom: aClassOrganizer
	
	aClassOrganizer class = self
		ifTrue: [ ^ aClassOrganizer ].
		
	^ self new
		importFrom: aClassOrganizer;
		yourself! !

!ClassOrganization class methodsFor: 'instance creation' stamp: 'EstebanLorenzano 5/28/2013 16:35'!
forClass: aClass
	^ self basicNew
		initializeClass: aClass;
		yourself! !

!ClassOrganizationDeclaration commentStamp: '<historical>'!
I represent the declaration of a class organization in a file.  My contents is the class organization string to import, and the class organizer is the one of the changed class.

Sending me the message #import makes me install the class organization I carry into the class.!
!ClassOrganizationDeclaration methodsFor: 'importing' stamp: 'GuillermoPolito 5/5/2012 20:44'!
import
	(self existsBehavior)
		ifFalse: [ self error: ('Cannot change organization of unexistent behavior {1}' format: { behaviorName asString } ) ]. 
		
	self targetClass organization changeFromString: contents! !

!ClassOrganizationDeclaration class methodsFor: 'instance creation' stamp: 'GuillermoPolito 5/5/2012 16:31'!
contents: someContents organizer: aClassOrganizer 
	^self new
			contents: someContents;
			organizer: aClassOrganizer;
			yourself! !

!ClassOrganizationDeclaration class methodsFor: 'instance creation' stamp: 'GuillermoPolito 5/5/2012 20:48'!
contents: someContents behaviorName: behaviorName isMeta: aBoolean
	^self new
		contents: someContents;
		behaviorName: behaviorName;
		isMeta: aBoolean;
		yourself! !

!ClassOrganizationTest commentStamp: 'TorstenBergmann 2/4/2014 22:00'!
SUnit tests for class organization!
!ClassOrganizationTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:23'!
testRemoveNonExistingProtocol
	self organization removeCategory: 'non-existent'! !

!ClassOrganizationTest methodsFor: 'tests' stamp: 'EstebanLorenzano 6/21/2013 15:06'!
testAddCategory
	
	self organization addCategory: 'test-protocol'.
	
	self assert: (self organization categories includes: 'test-protocol')! !

!ClassOrganizationTest methodsFor: 'running' stamp: 'CT 9/2/2014 12:44'!
tearDown
	class removeFromSystem! !

!ClassOrganizationTest methodsFor: 'running' stamp: 'EstebanLorenzano 6/21/2013 14:47'!
runCase 
	SystemAnnouncer uniqueInstance 
		suspendAllWhile: [ super runCase ]! !

!ClassOrganizationTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:23'!
testRemoveCategory
	self assert: self organization categories size = 3.
	self should: [ self organization removeCategory: 'one' ] raise: Error.
	self organization removeCategory: 'empty'.
	self assert: self organization categories size = 2.
	self assert: self organization categories first = AllProtocol defaultName.
	self assert: self organization categories second = 'one'! !

!ClassOrganizationTest methodsFor: 'tests' stamp: 'EstebanLorenzano 6/21/2013 15:06'!
testCategories
	| categories |
	
	categories := self organization categories.
	self assert: categories notEmpty.! !

!ClassOrganizationTest methodsFor: 'accessing' stamp: 'EstebanLorenzano 6/21/2013 15:06'!
organization 
	^ organization! !

!ClassOrganizationTest methodsFor: 'running' stamp: 'CT 9/2/2014 12:44'!
setUp 
	class := Object subclass: #ClassForTests instanceVariableNames: '' classVariableNames: '' category: 'ClassOrganizer-Tests'.
	organization := ClassOrganization forClass: class.
	organization addCategory: 'empty'.
	organization addCategory: 'one'.
	organization classify: #one under: 'one' suppressIfDefault: true.
	! !

!ClassOrganizationTest methodsFor: 'tests' stamp: 'EstebanLorenzano 6/21/2013 15:06'!
testListAtCategoryNamed
	| methods |

	methods := self organization listAtCategoryNamed: 'empty'.
	self assert: methods isEmpty.
		
	methods := self organization listAtCategoryNamed: 'one'.
	self assert: methods size = 1.
	self assert: methods first = #one.! !

!ClassQueryTest methodsFor: 'tests' stamp: 'CamilleTeruel 12/6/2013 15:19'!
testAllCallsOn
	| calls |
	calls := ClassQueryTest allCallsOn.
	self assert: calls size equals: 1.
	self assert: calls first compiledMethod equals: ClassQueryTest>>#testAllCallsOn! !

!ClassQueryTest methodsFor: 'tests' stamp: 'CamilleTeruel 12/6/2013 14:54'!
testAllCallsOnASymbol

	| set cm |
	set := Object allCallsOn: #shallowCopy.
	cm := (set detect: [ :rgMethod | rgMethod selector == #copy ]) compiledMethod.
	self assert: (cm methodClass == Object).
	self assert:  (cm literals includes: #shallowCopy)! !

!ClassQueryTest methodsFor: 'dependencies' stamp: 'StephaneDucasse 8/4/2013 11:20'!
testReferencedClasses
	"self debug: #testReferencedClasses"
	| refs |
	refs := Metaclass referencedClasses.
	self assert: (refs includes: SystemAnnouncer).
	
	refs := self class referencedClasses.
	self assert: (refs includesAllOf: {SystemAnnouncer . Metaclass})! !

!ClassRecategorized commentStamp: 'cyrilledelaunay 1/18/2011 10:42'!
This announcement will be raised when:
- we set a category to a class (see 'Class >>category:')
- we set a category to a Trait (see Trait>>category:)

It corresponds to the RecategorizedEvent!
!ClassRecategorized methodsFor: 'accessing' stamp: 'GuillermoPolito 8/1/2012 23:59'!
classRecategorized
	^classRecategorized! !

!ClassRecategorized methodsFor: 'accessing' stamp: 'GuillermoPolito 8/1/2012 23:59'!
classRecategorized: aClass
	classRecategorized := aClass! !

!ClassRecategorized methodsFor: 'accessing' stamp: 'GuillermoPolito 8/1/2012 23:58'!
oldCategory: anOldCategory
	oldCategory := anOldCategory! !

!ClassRecategorized methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:25'!
newCategory 
	^newCategory! !

!ClassRecategorized methodsFor: 'accessing' stamp: 'GuillermoPolito 8/1/2012 23:58'!
newCategory: aNewCategory
	newCategory := aNewCategory! !

!ClassRecategorized methodsFor: 'accessing' stamp: 'GuillermoPolito 8/3/2012 13:50'!
classAffected
	^self classRecategorized! !

!ClassRecategorized methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:25'!
oldCategory
	^oldCategory! !

!ClassRecategorized class methodsFor: 'instance creation' stamp: 'GuillermoPolito 8/1/2012 23:58'!
class: aClass recategorizedFrom: oldCategory to: newCategory
	^self new
			classRecategorized: aClass;
			oldCategory: oldCategory;
			newCategory: newCategory;
			yourself! !

!ClassRemoved commentStamp: 'cyrilledelaunay 1/18/2011 11:43'!
the annoucement will be emitted when removing a class or a trait using:  
	=> removeFromSystem!
!ClassRemoved methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:29'!
classRemoved: anObject
	
	classRemoved := anObject! !

!ClassRemoved methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:29'!
categoryName: anObject
	
	categoryName := anObject! !

!ClassRemoved methodsFor: 'accessing' stamp: 'GuillermoPolito 8/3/2012 13:50'!
classAffected
	^self classRemoved! !

!ClassRemoved methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:29'!
categoryName
	
	^ categoryName! !

!ClassRemoved methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:29'!
classRemoved
	
	^ classRemoved! !

!ClassRemoved class methodsFor: 'instance creation' stamp: 'GuillermoPolito 8/2/2012 00:29'!
class: aClass category: aCategoryName
	^self new
			classRemoved: aClass;
			categoryName: aCategoryName;
			yourself.! !

!ClassRenameFixTest methodsFor: 'running' stamp: 'BernardoContreras 11/3/2014 21:15'!
setUp

	previousChangeSet := ChangeSet current.
	testsChangeSet := ChangeSet new.
	ChangeSet newChanges: testsChangeSet.
	SystemAnnouncer uniqueInstance weak
		when: ClassRenamed
		send: #verifyRenameEvent:
		to: self.
	super setUp! !

!ClassRenameFixTest methodsFor: 'private' stamp: 'md 9/6/2005 18:30'!
newUniqueClassName
	"Return a class name that is not used in the system."

	"self new newClassName"

	| baseName newName |
	baseName := 'AutoGeneratedClassForTestingSystemChanges'.
	1 to: 9999
		do: 
			[:number | 
			newName := baseName , number printString.
			(Smalltalk hasClassNamed: newName) ifFalse: [^newName asSymbol]].
	^self 
		error: 'Can no longer find a new and unique class name for the SystemChangeTest !!'! !

!ClassRenameFixTest methodsFor: 'running' stamp: 'CamilleTeruel 7/29/2012 18:45'!
tearDown

	self removeEverythingInSetFromSystem: testsChangeSet.
	ChangeSet newChanges: previousChangeSet.
	ChangeSet removeChangeSet: testsChangeSet.
	previousChangeSet := nil.
	testsChangeSet := nil.
	SystemAnnouncer uniqueInstance unsubscribe: self.
	super tearDown.! !

!ClassRenameFixTest methodsFor: 'private' stamp: 'StephaneDucasse 8/9/2011 17:57'!
removeEverythingInSetFromSystem: aChangeSet 

	aChangeSet changedMessageList
		do: [:methodRef | methodRef actualClass removeSelector: methodRef selector].
	aChangeSet changedClasses
		do: [:each | each isMeta
				ifFalse: [each removeFromSystemUnlogged]]! !

!ClassRenameFixTest methodsFor: 'tests' stamp: 'StephaneDucasse 3/29/2010 17:36'!
renameClassUsing: aBlock
	| createdClass foundClasses |
	originalName := self newUniqueClassName.
	createdClass := Object
		subclass: originalName
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: 'ClassRenameFix-GeneradClass'.
	newClassName := self newUniqueClassName.
	aBlock value: createdClass value: newClassName.
	self assert: (Smalltalk globals classNamed: originalName) isNil.
	self assert: (Smalltalk globals classNamed: newClassName) notNil.
	foundClasses := Smalltalk globals organization listAtCategoryNamed: 'ClassRenameFix-GeneradClass'.
	self assert: foundClasses notEmpty.
	self assert: (foundClasses includes: newClassName).
	self assert: createdClass name = newClassName! !

!ClassRenameFixTest methodsFor: 'tests' stamp: 'md 9/6/2005 18:30'!
testRenameClassUsingClass
	"self run: #testRenameClassUsingClass"

	self renameClassUsing: [:class :newName | class rename: newName].! !

!ClassRenameFixTest methodsFor: 'running' stamp: 'GuillermoPolito 8/3/2012 13:29'!
verifyRenameEvent: aRenamedEvent
	| renamedClass |
	renamedClass := aRenamedEvent classRenamed.
	self assert: (Smalltalk globals classNamed: newClassName) name = newClassName.
	self assert: renamedClass name = newClassName! !

!ClassRenamed commentStamp: 'cyrilledelaunay 1/18/2011 11:44'!
the annoucement will be emitted when renaming a class or a trait using:  
	=> RenameClassRefactoring >> rename:to:
	=> class>>rename:
The corresponding event is raised in: SystemDictionary>>renameClass:from:to:!
!ClassRenamed methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:33'!
newName
	^newName! !

!ClassRenamed methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:33'!
oldName
	^oldName! !

!ClassRenamed methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:33'!
category
	
	^ category! !

!ClassRenamed methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:33'!
classRenamed: anObject
	
	classRenamed := anObject! !

!ClassRenamed methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:33'!
newName: anObject
	
	newName := anObject! !

!ClassRenamed methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:33'!
oldName: anObject
	
	oldName := anObject! !

!ClassRenamed methodsFor: 'accessing' stamp: 'GuillermoPolito 8/3/2012 13:51'!
classAffected
	^self classRenamed! !

!ClassRenamed methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:33'!
classRenamed
	
	^ classRenamed! !

!ClassRenamed methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:33'!
category: anObject
	
	category := anObject! !

!ClassRenamed class methodsFor: 'instance creation' stamp: 'GuillermoPolito 8/2/2012 00:33'!
class: aClass category: aCategoryName oldName: anOldClassName newName: aNewClassName
	^self new
			classRenamed: aClass;
			category: aCategoryName;
			oldName: anOldClassName;
			newName: aNewClassName;
			yourself! !

!ClassReorganized commentStamp: 'cyrilledelaunay 1/18/2011 15:03'!
This announcement corresponds to the ReorganizedEvent, which seems to (by looking at the references of ReorganizedEvent) be raised when:
- we rename a protocol (see 'renameCategory:toBe: '). if The category is not empty, SystemMethodRecategorizedAnnouncement will also be emitted
- we sort (modify the order of) protocols (see 'sortCategories')
- we add a protocol (see 'addCategory:before:')
- we remove a protocol (see 'removeCategory:' 'removeEmptyCategories')!
!ClassReorganized methodsFor: 'accessing' stamp: 'GuillermoPolito 8/3/2012 13:51'!
classAffected
	^self classReorganized! !

!ClassReorganized methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:36'!
classReorganized
	
	^ classReorganized! !

!ClassReorganized methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:36'!
classReorganized: anObject
	
	classReorganized := anObject! !

!ClassReorganized class methodsFor: 'instance creation' stamp: 'GuillermoPolito 8/2/2012 00:36'!
class: aClass
	^self new
			classReorganized: aClass;
			yourself! !

!ClassRepackaged commentStamp: 'TorstenBergmann 2/12/2014 22:56'!
Notify about repackaging of a class!
!ClassRepackaged methodsFor: 'accessing' stamp: 'GuillermoPolito 8/17/2012 17:18'!
classRepackaged: anObject
	
	classRepackaged := anObject! !

!ClassRepackaged methodsFor: 'accessing' stamp: 'GuillermoPolito 8/17/2012 17:18'!
oldPackage: anObject
	
	oldPackage := anObject! !

!ClassRepackaged methodsFor: 'accessing' stamp: 'GuillermoPolito 8/17/2012 17:18'!
oldPackage
	
	^ oldPackage! !

!ClassRepackaged methodsFor: 'accessing' stamp: 'GuillermoPolito 8/17/2012 17:18'!
classRepackaged
	
	^ classRepackaged! !

!ClassRepackaged methodsFor: 'accessing' stamp: 'GuillermoPolito 8/17/2012 17:18'!
newPackage
	
	^ newPackage! !

!ClassRepackaged methodsFor: 'accessing' stamp: 'GuillermoPolito 8/17/2012 17:18'!
newPackage: anObject
	
	newPackage := anObject! !

!ClassRepackaged class methodsFor: 'instance creation' stamp: 'GuillermoPolito 8/17/2012 17:20'!
classRepackaged: aClass oldPackage: oldPackage newPackage: newPackage
	^self new
			classRepackaged: aClass;
			oldPackage: oldPackage;
			newPackage: newPackage;
			yourself.! !

!ClassTest commentStamp: 'TorstenBergmann 2/5/2014 08:31'!
SUnit tests for classes!
!ClassTest methodsFor: 'testing - access' stamp: 'CamilloBruni 8/31/2013 20:23'!
testSharedPools
	"self run: #testSharedPools"

	self assert: Point sharedPools = OrderedCollection new.
	self assert: Date sharedPools first = ChronologyConstants.
	self assert: Date sharedPools size = 1.	"a metaclass does not have shared pools since only classes have shared pools"
	Date class sharedPools.
	self assert: RootClassPoolUser sharedPools size = 1.
	self assert: ClassMultiplePoolUser sharedPools size = 2.	"has shared pools does not take into account the fact that a superclass may use some shared pools"
	self assert: SubclassPoolUser sharedPools isEmpty! !

!ClassTest methodsFor: 'testing - access' stamp: 'StephaneDucasse 12/13/2011 17:42'!
testSharedPoolOfVarNamed
	"self debug: #testSharedPoolOfVarNamed"

	self assert: (Date sharedPoolOfVarNamed: 'DayNames') = ChronologyConstants.
	"a metaclass does not have shared pools since only classes have shared pools"
	self assert: (Date class sharedPoolOfVarNamed: 'DayNames') isNil.
	
	self assert: (RootClassPoolUser sharedPoolOfVarNamed: 'Author') = PoolDefiner.
	self assert: (RootClassPoolUser sharedPoolOfVarNamed: 'Gloups') = PoolDefiner.
	self assert: (SubclassPoolUser sharedPoolOfVarNamed: 'Author') = PoolDefiner.
	
	self assert: (ClassMultiplePoolUser sharedPoolOfVarNamed: 'Author') = PoolDefiner.
	self assert: (ClassMultiplePoolUser sharedPoolOfVarNamed: 'VariableInPoolDefiner2') = PoolDefiner2.
	self assert: (ClassMultiplePoolUser sharedPoolOfVarNamed: 'Gloups') = PoolDefiner.! !

!ClassTest methodsFor: 'testing - class variables' stamp: 'marcus.denker 12/4/2008 11:12'!
testClassVarNames

	self assert: (Object classVarNames includes: #DependentsFields).
	
	"A class and it's meta-class share the class variables"
	self assert: (Object classVarNames = Object class classVarNames).! !

!ClassTest methodsFor: 'testing' stamp: 'lr 3/14/2010 21:13'!
testRenaming
	"self debug: #testRenaming"

	"self run: #testRenaming"

	| oldName newMetaclassName class |
	oldName := className.
	newMetaclassName := (renamedName , #' class') asSymbol.
	class := Smalltalk globals at: oldName.
	class class compile: 'dummyMeth'.
	class rename: renamedName.
	self assert: class name = renamedName.
	self assert: (ChangeSet current changedClassNames includes: renamedName).
	self assert: (ChangeSet current changedClassNames includes: newMetaclassName)! !

!ClassTest methodsFor: 'testing' stamp: 'NicolaiHess 2/9/2015 20:46'!
testClassRespectsPolymorphismWithTrait
	| repeatedMethodsThatDoNotAccessInstanceVariables differentMethodsWithSameSelector |
	"If the method is in Class and Trait it must access some instance variable, otherwise the method can be implemented in TClass"
	repeatedMethodsThatDoNotAccessInstanceVariables := self
		repeatedMethodsThatDoNotAccessInstanceVariablesBetween: Class
		and: Trait.
	self assert: repeatedMethodsThatDoNotAccessInstanceVariables size equals: 0.	
	
	"If the method is in Class and Trait, and they have different implementations, it must be declared in TClass as an explicitRequirement method"
	differentMethodsWithSameSelector := self differentMethodsWithSameSelectorBetween: Class and: Trait.
	differentMethodsWithSameSelector
		do: [ :selector | 
			(TClass >> selector) sourceCode.
			self assert: (TClass >> selector) isRequired ].
		
	"Only a few methods are allowed to belong to one class and not to the other.
	It would be excelent to remove these methods somehow, but is NOT good idea add methods to this list.
	Accessors to instance variables that do not belong to Trait:
		#setName: #getName #traitComposition #traitComposition: #localSelectors #localSelectors: #basicLocalSelectors #basicLocalSelectors
		
	#baseClass and #classClass have their equivalent in Trait, but the problem is the name of the selector, they are bad names.
	#addInstVarNamed: for traits is implemeted in TraitDescription"
	self
		assertCollection: (Class localSelectors difference: Trait localSelectors)
		equals: #(
			#traitComposition: #setName: #getName #baseClass #basicLocalSelectors 
			#classClass isClass
			#basicLocalSelectors: #traitComposition #addInstVarNamed: #newAnonymousSubclass #definitionForNautilus #definitionForNautilusWithSlots #addSlot:
			) asSet.
		
	"#classTrait:, #isClassTrait, #classTrait, #isBaseTrait and #baseTrait have their equivalent for classes but with different name
	#nautilusIcon and #initialize are implemented differently for traits, classes have their implentation in Object"
	self
		assertCollection: (Trait localSelectors difference: Class localSelectors)
		equals: #(
			#classTrait: #isClassTrait #classTrait 
			#systemIcon #isBaseTrait #initialize #baseTrait
			) asSet.! !

!ClassTest methodsFor: 'testing - dependencies' stamp: 'AlexandreBergel 1/4/2014 21:14'!
testDependencies
	self assert: (ClassTest dependentClasses includes: ClassTest superclass).
	self assert: (ClassTest dependentClasses includes: Date)! !

!ClassTest methodsFor: 'testing' stamp: 'CamilleTeruel 1/14/2013 15:12'!
testChangingShapeDoesNotPutNilInMethodsLastLiteralKey
	"Test that when the shape of a class changes, the key of the last literal of the methods is not nil"
	| tutu |
	tutu := Smalltalk globals at: #TUTU.
	tutu compile: 'foo'.
	self deny: (tutu >> #foo) allLiterals last key isNil.
	tutu addInstVarNamed: 'x'.
	self deny: (tutu >> #foo) allLiterals last key isNil.! !

!ClassTest methodsFor: 'testing - file in/out' stamp: 'GuillermoPolito 6/26/2012 15:58'!
testOrdersACollectionOfClassesBySuperclass
	"self debug: #testOrdersACollectionOfClassesBySuperclass"
	| ordered |
	ordered := (Class superclassOrder:  
		(OrderedCollection 
				with: ExampleForTest11 class 
				with: ExampleForTest111 class 
				with: ExampleForTest12 class 
				with: ExampleForTest1 class 
				with: ExampleForTest12 class 
				with: ExampleForTest112 class)).
	
	self assert: (ordered indexOf: ExampleForTest1 class) < (ordered indexOf: ExampleForTest11 class).
	self assert: (ordered indexOf: ExampleForTest11 class) < (ordered indexOf: ExampleForTest111 class).
	self assert: (ordered indexOf: ExampleForTest11 class) < (ordered indexOf: ExampleForTest112 class).
	self assert: (ordered indexOf: ExampleForTest1 class) < (ordered indexOf: ExampleForTest12 class).
	! !

!ClassTest methodsFor: 'testing - access' stamp: 'StephaneDucasse 12/13/2011 16:13'!
testHasSharedPools
	"self run: #testHasSharedPools"

	self deny: Point hasSharedPools.
	self assert: Date hasSharedPools.
	
	"a metaclass does not have shared pools since only classes have shared pools"
	self deny: Date class hasSharedPools.
	
	self assert: RootClassPoolUser hasSharedPools.
	
	"has shared pools does not take into account the fact that a superclass may use some shared pools"
	self deny: SubclassPoolUser hasSharedPools.! !

!ClassTest methodsFor: 'setup' stamp: 'lr 3/14/2010 21:13'!
deleteClass
	| cl |
	cl := Smalltalk globals at: className ifAbsent: [ ^ self ].
	cl
		removeFromChanges;
		removeFromSystemUnlogged! !

!ClassTest methodsFor: 'setup' stamp: 'lr 3/14/2010 21:13'!
deleteRenamedClass
	| cl |
	cl := Smalltalk globals at: renamedName ifAbsent: [ ^ self ].
	cl
		removeFromChanges;
		removeFromSystemUnlogged! !

!ClassTest methodsFor: 'setup' stamp: 'BenComan 3/2/2014 09:38'!
categoryNameForTemporaryClasses
	"Answer the category where to classify temporarily created classes"

	^'Dummy-Tests-Class' ! !

!ClassTest methodsFor: 'testing - access' stamp: 'CamilloBruni 8/31/2013 20:23'!
testAllSharedPools
	"self run: #testAllSharedPools"

	self assert: Point allSharedPools = OrderedCollection new.
	self assert: Date sharedPools first = ChronologyConstants.
	self assert: Date sharedPools size = 1.	"a metaclass does not have shared pools since only classes have shared pools"
	Date class sharedPools.
	self assert: RootClassPoolUser sharedPools size = 1.
	self assert: ClassMultiplePoolUser sharedPools size = 2.	"has shared pools does not take into account the fact that a superclass may use some shared pools"
	self assert: SubclassPoolUser sharedPools isEmpty! !

!ClassTest methodsFor: 'testing - access' stamp: 'MarianoMartinezPeck 12/16/2011 11:55'!
testHasPoolVarNamed
	"self debug: #testHasPoolVarNamed"

	self assert: (Date usesLocalPoolVarNamed: 'DayNames').
	"a metaclass does not have shared pools since only classes have shared pools"
	self deny: (Date class usesLocalPoolVarNamed: 'DayNames').
	
	self assert: (RootClassPoolUser usesLocalPoolVarNamed: 'Author').
	"a subclass does not have the one of its superclass - but it would be good to change that"
	self deny: (SubclassPoolUser usesLocalPoolVarNamed: 'Author').! !

!ClassTest methodsFor: 'testing - file in/out' stamp: 'GuillermoPolito 6/26/2012 15:58'!
testOrdersMetaClassAfterItsClassInstance
	| ordered |
	ordered := (Class superclassOrder:  
		(OrderedCollection 
				with: Boolean class
				with: True
				with: Boolean
				with: True class)).
	
	self assert: (ordered indexOf: Boolean) < (ordered indexOf: Boolean class).
	self assert: (ordered indexOf: True) < (ordered indexOf: True class).
	self assert: (ordered indexOf: Boolean class) < (ordered indexOf: True class).
	self assert: (ordered indexOf: Boolean) < (ordered indexOf: True).
! !

!ClassTest methodsFor: 'setup' stamp: 'BenComan 3/2/2014 20:54'!
tearDown
	self deleteClass.
	self deleteRenamedClass.
	{self unclassifiedCategory. self categoryNameForTemporaryClasses} do: [:category|
			RPackage organizer unregisterPackageNamed: category]! !

!ClassTest methodsFor: 'classcreation' stamp: 'NouryBouraqadi 12/16/2011 15:13'!
testNewSubclass
	| cls |
	cls := Point newSubclass.
	self assert: (cls isBehavior).
	self assert: (cls superclass == Point).
	self assert: (Point allSubclasses includes: cls).
	self assert: (cls instVarNames = #()).
	self assert: (cls category = self unclassifiedCategory).
	self assert: (cls classVarNames = #()).
	
	cls removeFromSystem.! !

!ClassTest methodsFor: 'testing - access' stamp: 'StephaneDucasse 12/13/2011 17:17'!
testUsesPoolVarNamed
	"self debug: #testUsesPoolVarNamed"

	self assert: (Date usesPoolVarNamed: 'DayNames').
	"a metaclass does not have shared pools since only classes have shared pools"
	self deny: (Date class usesPoolVarNamed: 'DayNames').
	
	self assert: (RootClassPoolUser usesPoolVarNamed: 'Author').
	"a subclass  has  the one of its superclass"
	self assert: (SubclassPoolUser usesPoolVarNamed: 'Author').! !

!ClassTest methodsFor: 'testing' stamp: 'StephaneDucasse 12/13/2011 16:03'!
testPoolVariableAccessibleInSubclassOfClassUser
	"This test shows that a Pool Variable is not accessible from a subclass that declare the Pool usage: here SubFlop subclass of Flop and this is a bug. "
	"self debug: #testInSubclassOfClassUser"
	PoolDefiner initialize.
	SubclassPoolUser compileAll.
	
	self assert: SubclassPoolUser gloups = 42.
	self assert: SubclassPoolUser author = 'Ducasse'! !

!ClassTest methodsFor: 'setup' stamp: 'Janniklaval 10/23/2010 13:35'!
setUp
	className := #TUTU.
	renamedName := #RenamedTUTU.
	self deleteClass.
	self deleteRenamedClass.
	Object subclass: className
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: self categoryNameForTemporaryClasses! !

!ClassTest methodsFor: 'classcreation' stamp: 'Alexandre Bergel 6/3/2010 08:35'!
testSubclass
	| cls |
	(Smalltalk globals includesKey: #SubclassExample)
		ifTrue: [ (Smalltalk at: #SubclassExample) removeFromSystem ].
	
	self deny: (Smalltalk globals includesKey: #SubclassExample).
	cls := Object subclass: #SubclassExample.
	self assert: (Smalltalk globals includesKey: #SubclassExample).

	self assert: (Smalltalk at: #SubclassExample) == cls.
	self assert: cls category = #Unclassified.
	self assert: cls instVarNames = #().
	
	cls removeFromSystem! !

!ClassTest methodsFor: 'testing' stamp: 'MarcusDenker 2/8/2015 19:31'!
testAddSlot
	"self run: #testAddInstVarName"

	| tutu |
	tutu := Smalltalk globals at: #TUTU.
	tutu addSlot: #x => InstanceVariableSlot.
	self assert: tutu instVarNames = #('x').
	tutu addSlot: #y => InstanceVariableSlot.
	self assert: tutu instVarNames = #('x' 'y')! !

!ClassTest methodsFor: 'classcreation' stamp: 'NouryBouraqadi 12/16/2011 15:13'!
unclassifiedCategory
	^#Unclassified! !

!ClassTest methodsFor: 'testing' stamp: 'StephaneDucasse 12/13/2011 16:02'!
testPoolVariableAccessibleInClassUser
	"This test shows that a Pool Variable is accessible from the class that declare the Pool usage: here the superclass"
	"self debug: #testInClassUser"
	PoolDefiner initialize.
	RootClassPoolUser compileAll.
	
	self assert: RootClassPoolUser gloups = 42.
	self assert: RootClassPoolUser author = 'Ducasse'! !

!ClassTest methodsFor: 'testing - compiling' stamp: 'CamilloBruni 8/31/2013 20:23'!
testCompileAll
	ClassTest compileAll! !

!ClassTest methodsFor: 'testing' stamp: 'StephaneDucasse 8/27/2010 11:33'!
testAddInstVarName
	"self run: #testAddInstVarName"

	| tutu |
	tutu := Smalltalk globals at: #TUTU.
	tutu addInstVarNamed: 'x'.
	self assert: tutu instVarNames = #('x').
	tutu addInstVarNamed: 'y'.
	self assert: tutu instVarNames = #('x' 'y')! !

!ClassTest methodsFor: 'classcreation' stamp: 'AdrianLienhard 11/27/2010 00:31'!
testSubclassInstanceVariableNames
	| cls |
	(Smalltalk globals includesKey: #SubclassExample)
		ifTrue: [ (Smalltalk at: #SubclassExample) removeFromSystem ].
	
	self deny: (Smalltalk globals includesKey: #SubclassExample).
	cls := Object subclass: #SubclassExample instanceVariableNames: 'x y'.
	self assert: (Smalltalk globals includesKey: #SubclassExample).

	self assert: (Smalltalk at: #SubclassExample) == cls.
	self assert: cls category = #Unclassified.
	self assert: cls instVarNames = #('x' 'y').
	
	cls removeFromSystem! !

!ClassTestCase commentStamp: 'brp 7/26/2003 16:57'!
This class is intended for unit tests of individual classes and their metaclasses.

It provides methods to determine the coverage of the unit tests.

Subclasses are expected to re-implement #classesToBeTested and #selectorsToBeIgnored.

They should also implement to confirm that all methods have been tested.

#testCoverage

	super testCoverage.

!
!ClassTestCase methodsFor: 'coverage' stamp: 'brp 7/26/2003 17:22'!
selectorsToBeIgnored
	^ #(#DoIt #DoItIn:)! !

!ClassTestCase methodsFor: 'utils' stamp: 'SebastianTleye 7/19/2013 15:30'!
repeatedMethodsThatDoNotAccessInstanceVariablesBetween: firstClass and: secondClass
	| repeatedSelectors repeatedMethodsThatDoNotAccessInstanceVariables |
	
	repeatedSelectors := firstClass localSelectors intersection: secondClass localSelectors.
	
	repeatedMethodsThatDoNotAccessInstanceVariables := repeatedSelectors select: [ :selector | | m1 m2| 
										 m1 := firstClass>>selector. 
										 m2 := secondClass>>selector.
										((m1 sourceCode = m2 sourceCode) and: [ m1 hasInstVarRef not ]) and: [ m2 hasInstVarRef not ]].
									
	^repeatedMethodsThatDoNotAccessInstanceVariables.! !

!ClassTestCase methodsFor: 'coverage' stamp: 'brp 7/27/2003 12:40'!
selectorsToBeTested

	^ ( { self classToBeTested. self classToBeTested class } gather: [:c | c selectors]) 
			difference: self selectorsToBeIgnored! !

!ClassTestCase methodsFor: 'private' stamp: 'GuillermoPolito 6/27/2012 12:33'!
targetClass
	[ ^ self classToBeTested ]
		on: Error
		do: [ 
			| className |
			className := self class name asString copyFrom: 1 to: self class name size - 4.
			^ Smalltalk globals at: className asString asSymbol ]! !

!ClassTestCase methodsFor: 'tests' stamp: 'brp 12/14/2003 15:51'!
testCoverage

	| untested | 
	self class mustTestCoverage ifTrue:
		[ untested := self selectorsNotTested.
		self assert: untested isEmpty 
		description: untested size asString, ' selectors are not covered' ]! !

!ClassTestCase methodsFor: 'coverage' stamp: 'brp 7/27/2003 12:39'!
classToBeTested
	
	self subclassResponsibility! !

!ClassTestCase methodsFor: '*Manifest-Core' stamp: 'CamilloBruni 8/22/2013 11:58'!
assertValidLintRule: aLintRule
	| checker |
	checker := SmalllintManifestChecker new 
		rule: aLintRule; 
		environment: self targetClassEnvironment;
		run.
	self 
		assert: aLintRule result isEmpty
		description: [ aLintRule rationale ]! !

!ClassTestCase methodsFor: '*Refactoring-Critics' stamp: 'SebastianTleye 7/19/2013 12:50'!
testTraitExplicitRequirementMethodsMustBeImplementedInTheClassOrInASuperclass

	self assertValidLintRule: RBExplicitRequirementMethodsRule new! !

!ClassTestCase methodsFor: '*Refactoring-Critics' stamp: 'SebastianTleye 7/19/2013 14:30'!
testMethodsOfTheClassShouldNotBeRepeatedInItsSuperclasses
		
	self assertValidLintRule: RBRepeteadMethodsInTheSuperclassRule new! !

!ClassTestCase methodsFor: 'coverage' stamp: 'MarcusDenker 3/5/2010 14:33'!
selectorsTested
	| literals |
	literals := Set new.
	self class
		selectorsAndMethodsDo: [ :s :m | (s beginsWith: 'test')
			ifTrue: [ literals addAll: (m messages)] ].
	^ literals asArray sort! !

!ClassTestCase methodsFor: 'tests' stamp: 'StephaneDucasse 8/29/2013 20:54'!
testUnCategorizedMethods
	| uncategorizedMethods  |
	uncategorizedMethods := self targetClass selectorsInProtocol: Protocol unclassified.
	self 
		assert: uncategorizedMethods isEmpty
		description: uncategorizedMethods asString	! !

!ClassTestCase methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:23'!
testNew
	self targetClass new! !

!ClassTestCase methodsFor: 'coverage' stamp: 'brp 7/26/2003 16:35'!
selectorsNotTested

	^ self selectorsToBeTested difference: self selectorsTested.
! !

!ClassTestCase methodsFor: '*Manifest-Core' stamp: 'SebastianTleye 7/19/2013 11:25'!
targetClassEnvironment
	^RBClassEnvironment class: self targetClass.! !

!ClassTestCase methodsFor: 'tests' stamp: 'CamilloBruni 5/1/2013 18:27'!
testClassComment
	self assert: self targetClass organization hasComment.! !

!ClassTestCase methodsFor: 'utils' stamp: 'SebastianTleye 7/19/2013 15:29'!
differentMethodsWithSameSelectorBetween: firstClass and: secondClass
	| repeatedSelectors differentMethodsWithSameSelector |
	
	repeatedSelectors := firstClass localSelectors intersection: secondClass localSelectors.
	
	differentMethodsWithSameSelector := repeatedSelectors select: [ :selector | | m1 m2| 
										 m1 := firstClass>>selector. 
										 m2 := secondClass>>selector.
										 m1 sourceCode ~= m2 sourceCode].
									
	^differentMethodsWithSameSelector.! !

!ClassTestCase methodsFor: 'private' stamp: 'md 1/28/2004 11:32'!
categoriesForClass: aClass

 ^ aClass organization allMethodSelectors collect: 
			[:each |  aClass organization categoryOfElement: each].
! !

!ClassTestCase class methodsFor: 'testing' stamp: 'brp 12/14/2003 15:50'!
mustTestCoverage

	^ false! !

!ClassTestCase class methodsFor: 'testing' stamp: 'md 2/22/2006 14:21'!
isAbstract
	"Override to true if a TestCase subclass is Abstract and should not have
	TestCase instances built from it"

	^self name = #ClassTestCase
			! !

!ClassTrait commentStamp: '<historical>'!
While every class has an associated metaclass, a trait can have an associated classtrait, an instance of me. To preserve metaclass compatibility, the associated classtrait (if there is one) is automatically applied to the metaclass, whenever a trait is applied to a class. Consequently, a trait with an associated classtrait can only be applied to classes, whereas a trait without a classtrait can be applied to both classes and metaclasses.!
!ClassTrait methodsFor: 'testing' stamp: ''!
isObsolete
	"Return true if the receiver is obsolete"
	^self soleInstance == nil "Either no thisClass"
		or:[self soleInstance classSide ~~ self "or I am not the class of thisClass"
			or:[self soleInstance isObsolete]] "or my instance is obsolete"! !

!ClassTrait methodsFor: 'composition' stamp: ''!
assertConsistantCompositionsForNew: aTraitComposition
	"Applying or modifying a trait composition on the class side
	of a behavior has some restrictions."

	| baseTraits notAddable message |
	baseTraits := aTraitComposition traits select: [:each | each isBaseTrait].
	baseTraits isEmpty ifFalse: [
		notAddable := (baseTraits reject: [:each | each classSide methodDict isEmpty]).
		notAddable isEmpty ifFalse: [
			message := String streamContents: [:stream |
				stream nextPutAll: 'You can not add the base trait(s)'; cr.
				notAddable
					do: [:each | stream nextPutAll: each name]
					separatedBy: [ stream nextPutAll: ', '].
				stream cr; nextPutAll: 'to this composition because it/they define(s) methods on the class side.'].
		^TraitCompositionException signal: message]].
		
	(self instanceSide traitComposition traits asSet =
			(aTraitComposition traits
				select: [:each | each isClassTrait]
				thenCollect: [:each | each baseTrait]) asSet) ifFalse: [
				^TraitCompositionException signal: 'You can not add or remove class side traits on
				the class side of a composition. (But you can specify aliases or exclusions
				for existing traits or add a trait which does not have any methods on the class side.)']! !

!ClassTrait methodsFor: 'accessing' stamp: 'md 3/14/2006 16:37'!
soleInstance
	^baseTrait! !

!ClassTrait methodsFor: '*Monticello' stamp: 'damiencassou 7/30/2009 12:10'!
asMCDefinition
	^MCClassTraitDefinition
		baseTraitName: self baseTrait name
		classTraitComposition: self traitCompositionString
		category: self category
			! !

!ClassTrait methodsFor: 'accessing parallel hierarchy' stamp: 'al 3/16/2004 10:38'!
baseTrait
	^baseTrait! !

!ClassTrait methodsFor: 'initialize-release' stamp: 'SebastianTleye 7/17/2013 13:39'!
adoptInstance: oldInstance from: oldMetaClass 
	^self error: 'Traits cannot adopt instances'.! !

!ClassTrait methodsFor: '*Manifest-Core' stamp: ''!
criticTheNonMetaclassClass

	^self theNonMetaClass ! !

!ClassTrait methodsFor: 'initialize' stamp: ''!
initializeFrom: anotherClassTrait
	self traitComposition: self traitComposition copyTraitExpression.
	self methodDict: self methodDict copy.
	self localSelectors: self localSelectors copy.
	self basicOrganization: self organization copy.! !

!ClassTrait methodsFor: 'initialize' stamp: 'VincentBlondeau 3/6/2015 16:37'!
initializeWithBaseTrait: aTrait
	self baseTrait: aTrait.
	self noteNewBaseTraitCompositionApplied: aTrait traitComposition.
	aTrait traitUsers do: [:each | self addUser: each classSide].
	! !

!ClassTrait methodsFor: '*Ring-Core-Kernel' stamp: ''!
asFullRingDefinition

	^ self theNonMetaClass asFullRingDefinition theMetaClass! !

!ClassTrait methodsFor: 'compiling' stamp: ''!
bindingOf: varName

	^self theNonMetaClass classBindingOf: varName! !

!ClassTrait methodsFor: 'accessing parallel hierarchy' stamp: 'jannik.laval 5/1/2010 16:02'!
baseTrait: aTrait
	[aTrait isBaseTrait] assert.
	baseTrait := aTrait
	
	! !

!ClassTrait methodsFor: 'class hierarchy' stamp: ''!
addSubclass: aClass
	"Do nothing."! !

!ClassTrait methodsFor: 'accessing' stamp: ''!
category
	^ self theNonMetaClass category! !

!ClassTrait methodsFor: '*Tools' stamp: 'SebastianTleye 7/17/2013 14:19'!
canonicalArgumentName

	^ 'aTrait'.! !

!ClassTrait methodsFor: 'composition' stamp: ''!
uses: aTraitCompositionOrArray
	| copyOfOldTrait newComposition |
	copyOfOldTrait := self copy.
	newComposition := aTraitCompositionOrArray asTraitComposition.
	self assertConsistantCompositionsForNew: newComposition.
	self setTraitComposition: newComposition.
	SystemAnnouncer uniqueInstance
		traitDefinitionChangedFrom: copyOfOldTrait to: self.! !

!ClassTrait methodsFor: 'instance variables' stamp: ''!
addInstVarNamed: aString 
	"Add the argument, aString, as one of the receiver's instance variables."

	| fullString |
	fullString := String streamContents: [:strm |
		self instVarNames do: [:aString2 | strm nextPutAll: aString2; space].
		strm nextPutAll: aString].
	self instanceVariableNames: fullString! !

!ClassTrait methodsFor: 'accessing parallel hierarchy' stamp: 'al 3/16/2004 10:38'!
classTrait
	^self! !

!ClassTrait methodsFor: 'compiling' stamp: ''!
binding
	"return an association that can be used as the binding
	 To share it between methods, reuse an existing one if possible"
	^self methodDict 
		ifEmpty: [nil -> self]
		ifNotEmpty: [:dict | dict anyOne classBinding]! !

!ClassTrait methodsFor: 'class hierarchy' stamp: ''!
addObsoleteSubclass: aClass
	"Do nothing."! !

!ClassTrait methodsFor: '*Ring-Core-Kernel' stamp: ''!
asRingDefinition

	^ self theNonMetaClass asRingDefinition theMetaClass! !

!ClassTrait methodsFor: 'initialize-release' stamp: ''!
uses: aTraitCompositionOrArray instanceVariableNames: instVarString 
	| newComposition newMetaClass copyOfOldMetaClass |
	
	copyOfOldMetaClass := self copy.
	newMetaClass := self instanceVariableNames: instVarString.
	
	newComposition := aTraitCompositionOrArray asTraitComposition.
	newMetaClass assertConsistantCompositionsForNew: newComposition.
	newMetaClass setTraitComposition: newComposition.
	
	SystemAnnouncer uniqueInstance
		classDefinitionChangedFrom: copyOfOldMetaClass to: newMetaClass! !

!ClassTrait methodsFor: 'accessing' stamp: 'al 4/21/2004 09:38'!
name
	^self baseTrait name , ' classTrait'! !

!ClassTrait methodsFor: 'pool variables' stamp: ''!
sharedPools
	^OrderedCollection new.! !

!ClassTrait methodsFor: 'testing' stamp: ''!
isAnonymous
	^self soleInstance isAnonymous ! !

!ClassTrait methodsFor: 'instance variables' stamp: ''!
removeInstVarNamed: aString 
	"Remove the argument, aString, as one of the receiver's instance variables."

	| newArray newString |
	(self instVarNames includes: aString)
		ifFalse: [self error: aString , ' is not one of my instance variables'].
	newArray := self instVarNames copyWithout: aString.
	newString := ''.
	newArray do: [:aString2 | newString := aString2 , ' ' , newString].
	self instanceVariableNames: newString! !

!ClassTrait methodsFor: 'class hierarchy' stamp: ''!
removeSubclass: aClass
	"Do nothing."! !

!ClassTrait methodsFor: 'compiling' stamp: ''!
acceptsLoggingOfCompilation
	"Answer whether the receiver's method submisions and class defintions should be logged to the changes file and to the current change set.  The metaclass follows the rule of the class itself."

	^ self theNonMetaClass acceptsLoggingOfCompilation! !

!ClassTrait methodsFor: '*Fuel' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper

	^aGeneralMapper visitClassTrait: self
! !

!ClassTrait methodsFor: 'class hierarchy' stamp: ''!
obsoleteSubclasses
	"Answer the receiver's subclasses."
	self theNonMetaClass == nil ifTrue:[^#()].
	^self theNonMetaClass obsoleteSubclasses 
		select:[:aSubclass| aSubclass isMeta not] 
		thenCollect:[:aSubclass| aSubclass class]

	"Metaclass allInstancesDo:
		[:m | Compiler evaluate: 'subclasses:=nil' for: m logged: false]"! !

!ClassTrait methodsFor: 'fileIn/Out' stamp: ''!
fileOutInitializerOn: aStream
	(self includesSelector: #initialize) ifTrue: 
		[aStream cr.
		aStream nextChunkPut: self soleInstance name , ' initialize'].! !

!ClassTrait methodsFor: 'initialize-release' stamp: 'SebastianTleye 7/12/2013 17:23'!
instanceVariableNames: instVarString
	"Compatibility purposes"! !

!ClassTrait methodsFor: 'accessing parallel hierarchy' stamp: 'al 4/20/2004 09:44'!
classTrait: aClassTrait
	self error: 'Trait is already a class trait!!'
	
	! !

!ClassTrait methodsFor: 'accessing instances and variables' stamp: ''!
classVarNames
	"Answer a set of the names of the class variables defined in the receiver's instance."
	
	self theNonMetaClass ifNil: [ ^ Set new ].
	^self theNonMetaClass classVarNames! !

!ClassTrait methodsFor: '*OpalCompiler-Core' stamp: ''!
compilerClass
	"The compiler class is defined on instance-side to be able to customize it for *one* metaclass"
	^ self instanceSide classSideCompilerClass! !

!ClassTrait methodsFor: 'composition' stamp: ''!
noteNewBaseTraitCompositionApplied: aTraitComposition
	"The argument is the new trait composition of my base trait - add
	the new traits or remove non existing traits on my class side composition.
	(Each class trait in my composition has its base trait on the instance side
	of the composition - manually added traits to the class side are always 
	base traits.)"
	
	| newComposition traitsFromInstanceSide |
	traitsFromInstanceSide := self traitComposition traits
		select: [:each | each isClassTrait]
		thenCollect: [:each | each baseTrait].
		
	newComposition := self traitComposition copyTraitExpression.
	(traitsFromInstanceSide copyWithoutAll: aTraitComposition traits) do: [:each |
		newComposition removeFromComposition: each classTrait].
	(aTraitComposition traits copyWithoutAll: traitsFromInstanceSide) do: [:each |
		newComposition add:  (each classTrait)].

	self setTraitComposition: newComposition! !

!ClassTrait methodsFor: 'accessing hierarchy protocol' stamp: ''!
hasClassSide
	^false! !

!ClassTrait methodsFor: 'class hierarchy' stamp: ''!
subclassesDo: aBlock
	"Evaluate aBlock for each of the receiver's immediate subclasses."
	self theNonMetaClass subclassesDo:[:aSubclass|
		"The following test is for Class class which has to exclude
		the Metaclasses being subclasses of Class."
		aSubclass isMeta ifFalse:[aBlock value: aSubclass class]].! !

!ClassTrait methodsFor: 'fileIn/Out' stamp: 'MarcusDenker 2/14/2010 22:18'!
definition
	^String streamContents: [:stream |
		stream
			nextPutAll: self name;
			crtab;
			nextPutAll: 'uses: ';
			nextPutAll: self traitCompositionString]! !

!ClassTrait methodsFor: 'fileIn/Out' stamp: ''!
nonTrivial 
	"Answer whether the receiver has any methods or instance variables."

	^ self instVarNames notEmpty or: [self hasMethods or: [self hasTraitComposition]]! !

!ClassTrait methodsFor: 'testing' stamp: ''!
isMeta
	^ true! !

!ClassTrait methodsFor: 'copying' stamp: 'dvf 8/30/2005 16:51'!
copy
	"Make a copy of the receiver. Share the 
	reference to the base trait."

	^(self class new)
		baseTrait: self baseTrait;
		initializeFrom: self;
		yourself! !

!ClassTrait methodsFor: 'compiling' stamp: ''!
possibleVariablesFor: misspelled continuedFrom: oldResults

	^ self theNonMetaClass possibleVariablesFor: misspelled continuedFrom: oldResults
! !

!ClassTrait methodsFor: 'accessing parallel hierarchy' stamp: 'al 3/16/2004 10:48'!
isClassTrait
	^true! !

!ClassTrait methodsFor: 'compiling' stamp: 'VincentBlondeau 3/6/2015 16:37'!
compile: text classified: category withStamp: changeStamp notifying: requestor logSource: logSource
	
	| classSideUsersOfBaseTrait message |
	
	classSideUsersOfBaseTrait := self baseTrait traitUsers select: [:each | each isClassSide].
	
	classSideUsersOfBaseTrait isEmpty ifFalse: [
		message := String streamContents: [ :stream |
			stream nextPutAll: 'The instance side of this trait is used on '; cr.
			classSideUsersOfBaseTrait
				do: [:each | stream nextPutAll: each name ]
				separatedBy: [ stream nextPutAll: ', ' ].
			stream cr; nextPutAll: ' You can not add methods to the class side of this trait!!'].
		^ TraitException signal:  message ].
	
	^ super
		compile: text
		classified: category
		withStamp: changeStamp
		notifying: requestor
		logSource: logSource! !

!ClassTrait methodsFor: 'testing' stamp: ''!
canZapMethodDictionary
	"Return true if it is safe to zap the method dictionary on #obsolete"
	self soleInstance == nil
		ifTrue:[^true]
		ifFalse:[^self soleInstance canZapMethodDictionary]! !

!ClassTrait methodsFor: 'pool variables' stamp: ''!
classPool
	"Answer the dictionary of class variables."

	^self theNonMetaClass classPool! !

!ClassTrait methodsFor: 'accessing parallel hierarchy' stamp: 'al 3/16/2004 10:48'!
isBaseTrait
	^false! !

!ClassTrait methodsFor: 'compiling' stamp: ''!
wantsChangeSetLogging
	"Answer whether code submitted for the receiver should be remembered by the changeSet mechanism.The metaclass follows the rule of the class itself."

	^ self theNonMetaClass wantsChangeSetLogging! !

!ClassTrait methodsFor: 'instance creation' stamp: 'SebastianTleye 7/17/2013 14:39'!
new
	self error: 'Traits have no instances'! !

!ClassTrait methodsFor: '*OpalCompiler-Core' stamp: ''!
compiler
	"The compiler is defined on instance-side to be able to customize it for *one* metaclass"
	^ self instanceSide classSideCompiler! !

!ClassTrait methodsFor: 'compiling' stamp: ''!
wantsRecompilationProgressReported
	"The metaclass follows the rule of the class itself."

	^ self theNonMetaClass wantsRecompilationProgressReported! !

!ClassTrait methodsFor: 'initialize-release' stamp: 'MarcusDenker 1/15/2015 16:00'!
slots: slotDefinition 
	"Compatibility purposes"! !

!ClassTrait methodsFor: 'testing' stamp: ''!
isSelfEvaluating
	^self isObsolete not! !

!ClassTrait methodsFor: 'class hierarchy' stamp: ''!
subclasses
	"Answer the receiver's subclasses."
	self theNonMetaClass == nil ifTrue:[^#()].
	^self theNonMetaClass subclasses 
		select:[:aSubclass| aSubclass isMeta not] 
		thenCollect:[:aSubclass| aSubclass class]

	"Metaclass allInstancesDo:
		[:m | Compiler evaluate: 'subclasses:=nil' for: m logged: false]"! !

!ClassTrait class methodsFor: 'instance creation' stamp: 'al 3/23/2004 19:41'!
for: aTrait
	^self new
		initializeWithBaseTrait: aTrait;
		yourself! !

!ClassTraitTest methodsFor: 'testing' stamp: 'SebastianTleye 7/12/2013 16:18'!
testInitialization
	"self run: #testInitialization"
	| classTrait |
	classTrait := self t1 classTrait.
	self assert: self t1 hasClassSide.
	self assert: self t1 classTrait == classTrait.
	self assert: classTrait isClassTrait.
	self assert: classTrait classSide == classTrait.
	self deny: classTrait isBaseTrait.
	self assert: classTrait baseTrait == self t1.

	"assert classtrait methods are propagated to users when setting traitComposition"
	self assert: self t4 hasClassSide.
	self assert: self t5 hasClassSide.
	self assert: (self t2 classSide includesLocalSelector: #m2ClassSide:).
	self assert: (self t4 classSide includesSelector: #m2ClassSide:).
	self assert: (self t5 classSide includesSelector: #m2ClassSide:).
	self assert: (self c2 m2ClassSide: 17) = 17! !

!ClassTraitTest methodsFor: 'testing' stamp: 'VincentBlondeau 3/6/2015 16:37'!
testUsers
	self assert: self t2 classSide traitUsers size = 3.
	self assert: (self t2 classSide traitUsers includesAllOf: {				
		(self t4 classTrait).
		(self t5 classTrait).
		(self t6 classTrait) }).
	self assert: self t5 classSide traitUsers size = 1.
	self assert: self t5 classSide traitUsers anyOne = self c2 class.
	self c2 setTraitCompositionFrom: self t1 + self t5.
	self assert: self t5 classSide traitUsers size = 1.
	self assert: self t5 classSide traitUsers anyOne = self c2 class.
	self c2 setTraitComposition: self t2 asTraitComposition.
	self assert: self t5 classSide traitUsers isEmpty! !

!ClassTraitTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testChanges
	"Test the most important features to ensure that
	general functionality of class traits are working."

	"self run: #testChanges"

	| classTrait |
	classTrait := self t1 classTrait.
	self deny: (self t5 classSide includesSelector: #m1ClassSide).
	classTrait compile: 'm1ClassSide ^17' classified: 'mycategory'.	"local selectors"
	self assert: (classTrait includesLocalSelector: #m1ClassSide).
	self deny: (classTrait includesLocalSelector: #otherSelector).	"propagation"
	self assert: (self t5 classSide methodDict includesKey: #m1ClassSide).
	self assert: (self c2 class methodDict includesKey: #m1ClassSide).
	self c2 m1ClassSide.
	self assert: self c2 m1ClassSide equals: 17.	"category"
	self assert: (self c2 class organization categoryOfElement: #m1ClassSide) equals: 'mycategory'.	"conflicts"
	self t2 classSide compile: 'm1ClassSide' classified: 'mycategory'.
	self assert: (self c2 class methodDict includesKey: #m1ClassSide).
	self deny: (self c2 class includesLocalSelector: #m1ClassSide).
	self should: [ self c2 m1ClassSide ] raise: Error.	"conflict category"
	self assert: (self c2 class organization categoryOfElement: #m1ClassSide) equals: #mycategory! !

!ClassTraitTest methodsFor: 'testing' stamp: 'ST 6/5/2013 17:16'!
testConflictsAliasesAndExclusions
	"conflict"

	self t1 classTrait compile: 'm2ClassSide: x ^99' classified: 'mycategory'.
	self assert: (self t1 classTrait includesLocalSelector: #m2ClassSide:).
	self assert: (self t5 classTrait >> #m2ClassSide:) isConflict.
	self assert: (self c2 class >> #m2ClassSide:) isConflict.

	"exclusion and alias"
	self assert: self t5 classSide traitComposition asString 
				= 'T1 classTrait + T2 classTrait'.
	self t5 classSide 
		setTraitCompositionFrom: (self t1 classTrait @ { (#m2ClassSideAlias1: -> #m2ClassSide:) } 
				+ ((self t2 classTrait) @ { (#m2ClassSideAlias2: -> #m2ClassSide:) } 
				- { #m2ClassSide: })).
	self deny: (self t5 classTrait >> #m2ClassSide:) isConflict.
	self deny: (self c2 class >> #m2ClassSide:) isConflict.
	self assert: (self c2 m2ClassSideAlias1: 13) = 99.
	self assert: (self c2 m2ClassSideAlias2: 13) = 13! !

!ClassTreeExample commentStamp: 'AlainPlantec 1/18/2010 16:20'!
ClassTreeExample new openOn: Object
!
!ClassTreeExample methodsFor: 'accessing' stamp: 'AlainPlantec 2/7/2010 22:44'!
rootNodeClassFromItem: anItem
	^ ClassTreeNodeExample! !

!ClassTreeExample methodsFor: 'user interface' stamp: 'AlainPlantec 10/18/2013 10:38'!
treeMorph
	| treeMorph |
	treeMorph := (MorphTreeMorph on: self)
				beMultiple;
				columns: {
					MorphTreeColumn new startWidth: 300; rowMorphGetSelector: #classButton; headerButtonLabel: 'Class' font:  nil.
					MorphTreeColumn new startWidth: 500; rowMorphGetSelector: #commentText; headerButtonLabel: 'Comment' font:  nil
				};
				rowInset: 4;
				treeLineWidth: 1;
				columnInset: 4;
				getMenuSelector: #menu:shifted:;
				rowColorForEven: Color lightGray muchLighter.
	^ treeMorph buildContents! !

!ClassTreeExample methodsFor: 'instance creation' stamp: 'StephaneDucasse 12/19/2012 16:13'!
openOn: aClass
	| window |
	self rootClass: aClass.
	window := StandardWindow new model: self.
	window title: aClass name, ' hierarchy'.
	window 
		addMorph: self treeMorph
		fullFrame: LayoutFrame identity.						
	window themeChanged.
	window openInWorld.
	^ window! !

!ClassTreeExample methodsFor: 'instance creation' stamp: 'AlainPlantec 1/16/2010 09:50'!
open
	^ self openOn: Object
! !

!ClassTreeExample methodsFor: 'accessing' stamp: 'AlainPlantec 2/25/2011 17:04'!
keyStroke: anEvent from: aTreeMorph 
	self selectedNode
		ifNotNil: [:current | current keyStroke: anEvent from: aTreeMorph]! !

!ClassTreeExample methodsFor: 'accessing' stamp: 'AlainPlantec 1/16/2010 09:50'!
rootClass: aClass
	 rootClass := aClass! !

!ClassTreeExample methodsFor: 'accessing' stamp: 'AlainPlantec 1/16/2010 09:50'!
rootClass
	^ rootClass ifNil: [rootClass := Object]! !

!ClassTreeExample methodsFor: 'accessing' stamp: 'AlainPlantec 1/15/2010 13:53'!
rootItems
	^ OrderedCollection with: self rootClass! !

!ClassTreeExample methodsFor: 'accessing' stamp: 'StephaneDucasse 10/26/2014 11:15'!
menu: menu shifted: b 
	"Set up the menu to apply to the receiver's, 
	honoring the #shifted boolean"
	super menu: menu shifted: b.
	menu addLine.
	self selectedNode ifNotNil: [:current | current menu: menu shifted: b.
		menu addLine.
		menu
			add: 'Expand all from here'
			target: self
			selector: #expandAllFromNode:
			argument: current].
	^ menu! !

!ClassTreeExample class methodsFor: 'examples' stamp: 'TorstenBergmann 9/30/2014 20:07'!
example

	ClassTreeExample new openOn: Object
! !

!ClassTreeNodeExample commentStamp: 'TorstenBergmann 2/3/2014 23:56'!
Example for class tree nodes!
!ClassTreeNodeExample methodsFor: 'menu' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
icon
	^  Smalltalk ui icons smallExpertIcon! !

!ClassTreeNodeExample methodsFor: 'menu' stamp: 'FernandoOlivero 4/12/2011 09:41'!
commentText
	^ ( self theme  newTextIn: World text: self item comment) unlock; wrapFlag: true; yourself! !

!ClassTreeNodeExample methodsFor: 'accessing' stamp: 'StephaneDucasse 10/15/2011 20:54'!
browseItem
	Smalltalk tools browser fullOnClass: self item selector: nil ! !

!ClassTreeNodeExample methodsFor: 'menu' stamp: 'AlainPlantec 1/15/2010 13:44'!
childrenItems
	^ (self item subclasses asArray sort: [:a :b | a name < b name]) asOrderedCollection
! !

!ClassTreeNodeExample methodsFor: 'accessing' stamp: 'AlainPlantec 1/16/2010 09:51'!
inspectItem
	self inspect! !

!ClassTreeNodeExample methodsFor: 'accessing' stamp: 'AlainPlantec 2/25/2011 17:05'!
keyStroke: anEvent from: aTreeMorph 
	| c  |
	c := anEvent keyCharacter.
	c = $b
		ifTrue: [self browseItem. ^ true].
	c = $i
		ifTrue: [self inspectItem. ^ true].
	c = $I
		ifTrue: [self exploreItem. ^ true].
	^ false
! !

!ClassTreeNodeExample methodsFor: 'menu' stamp: 'FernandoOlivero 4/12/2011 10:10'!
classButton
	^ ( self theme 
				newButtonIn: World
				for: self
				getState: nil
				action: #browseItem
				arguments: {}
				getEnabled: #enabled
				getLabel: nil
				help: 'Open a browser on ' translated , self item name)
				label: (self theme  windowLabelForText: (self item name) , '...');
				yourself! !

!ClassTreeNodeExample methodsFor: 'accessing' stamp: 'AlainPlantec 1/16/2010 09:51'!
exploreItem
	self explore! !

!ClassTreeNodeExample methodsFor: 'menu' stamp: 'AlainPlantec 1/15/2010 13:43'!
contents
	^ contents ifNil: [contents := super contents]! !

!ClassTreeNodeExample methodsFor: 'accessing' stamp: 'StephaneDucasse 10/22/2014 21:30'!
menu: menu shifted: b 
	menu
		add: 'Browse (b)'
		target: self
		selector: #browseItem.
	menu
		add: 'Inspect (i)'
		target: self
		selector: #inspectItem.
	menu
		add: 'Explore (I)'
		target: self
		selector: #exploreItem.
! !

!ClassVariable commentStamp: 'MarcusDenker 7/18/2014 10:02'!
I model Class Variables and therefore Pool Variables, too. I am stored as a binding in the classPool of the class defining me.

The compiler forwards bytecode generation to me for accessing the variable.

You can subclass me and implement #read and #write: for creating special kinds of globals that can be used as special class Variables (similar to special Slots).
!
!ClassVariable methodsFor: 'testing' stamp: 'MarcusDenker 1/23/2015 14:29'!
isSpecial
	"I just a class var Note: my subclasses are special"
	^(self class = ClassVariable) not! !

!ClassVariable methodsFor: 'code generation' stamp: 'MarcusDenker 7/13/2014 13:23'!
emitStore: methodBuilder

	methodBuilder storeIntoLiteralVariable: self.

! !

!ClassVariable methodsFor: 'code generation' stamp: 'MarcusDenker 7/13/2014 13:23'!
emitValue: methodBuilder

	methodBuilder pushLiteralVariable: self.! !

!ClassVariable methodsFor: '*reflectivity' stamp: 'MarcusDenker 7/21/2014 16:44'!
link: aMetaLink
	| wrapper class methods |
	class := self definingClass.
	methods := self usingMethods.
	wrapper := self asWrapperFor: aMetaLink.
	class replaceClassVariable: wrapper. "this exchanges self with the wrapper in the Class"
	methods do: #recompile.  "recompile all methods that reference the Global"! !

!ClassVariable methodsFor: 'testing' stamp: 'MarcusDenker 7/18/2014 10:03'!
isClassVariable
	^true! !

!ClassVariable methodsFor: 'printing' stamp: 'MarcusDenker 1/23/2015 14:39'!
definitionString
	"non special globals are defined by the symbol"
	^self isSpecial
		ifTrue: [super definitionString]
		ifFalse: [self name printString]
! !

!ClassVariableTest methodsFor: 'tests' stamp: 'MarcusDenker 3/10/2015 20:23'!
testMigrateClassVar
	"Add class variable using the builder interface and change it to another kind"
	
	| classVar |
	
	classVar := #ClassVar => ExampleClassVariable.
	
	aClass := self make: [ :builder |
		builder 
			sharedVariables: {#ClassVar}
		].
	
	self assert: (aClass hasClassVarNamed: 'ClassVar').
	self assert: (aClass classVariableNamed: #ClassVar) class = ClassVariable.
	
	aClass classVarNamed: 'ClassVar' put: 5.
	
	aClass := self make: [ :builder |
		builder 
			sharedVariables: {classVar}
		].
	
	self assert: (aClass hasClassVarNamed: 'ClassVar').
	self assert: (aClass classVariableNamed: #ClassVar) class = ExampleClassVariable.
	self assert: (aClass classVariableNamed: #ClassVar) read = 5.! !

!ClassVariableTest methodsFor: 'tests' stamp: 'MarcusDenker 3/10/2015 20:14'!
testCreateClassWithTwoClassVariable
	"Add class variable using the builder interface"
	
	| classVar1 classVar2 |
	
	classVar1 := #ClassVar1 => ExampleClassVariable.
	classVar2 := #ClassVar2 => ExampleClassVariable.
	
	aClass := self make: [ :builder |
		builder 
			sharedVariables: {classVar1. classVar2}
		].
	
	self assert: (aClass hasClassVarNamed: 'ClassVar1').
	self assert: (aClass hasClassVarNamed: 'ClassVar2').


! !

!ClassVariableTest methodsFor: 'tests' stamp: 'MarcusDenker 3/10/2015 20:12'!
testCreateClassWithClassVariable
	"Add class variable using the builder interface"
	
	| classVar |
	
	classVar := #ClassVar => ExampleClassVariable.
	
	aClass := self make: [ :builder |
		builder 
			sharedVariables: {classVar}
		].
	
	self assert: (aClass hasClassVarNamed: 'ClassVar').


! !

!ClassWidget commentStamp: 'NicolaiHess 7/26/2014 00:24'!
ClassWidget is the basic implementation of a wiget a list of classes.!
!ClassWidget methodsFor: 'accessing' stamp: 'NicolaiHess 7/29/2014 22:41'!
cachedHierarchy: anObject
	
	cachedHierarchy := anObject! !

!ClassWidget methodsFor: 'private list model' stamp: 'NicolaiHess 7/26/2014 11:19'!
selectedClassIndex
	| item |
	item := self model selectedClass.
	self model showInstance
		ifFalse: [ item ifNotNil: [ item := item theNonMetaClass ] ].
	^ self getClassesList indexOf: item! !

!ClassWidget methodsFor: 'accessing' stamp: 'NicolaiHess 9/7/2014 00:29'!
sortHierarchically
	^ self model sortHierarchically! !

!ClassWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/26/2014 13:58'!
vScrollValue

	^ classesList scrollValue y! !

!ClassWidget methodsFor: 'protocol' stamp: 'NicolaiHess 8/9/2014 21:18'!
resetClassSelection
	self classesSelection removeAll! !

!ClassWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/26/2014 11:17'!
getClassesList

	^ classesListElements ifNil: [ classesListElements := self loadClassesListElements ].! !

!ClassWidget methodsFor: 'private' stamp: 'NicolaiHess 7/30/2014 12:54'!
createClassHierarchyFor: aPackageGroup

	aPackageGroup ifNil: [ ^ {}].
	self cachedHierarchy: (self buildPackageGroupHierarchyFor: aPackageGroup asNautilusSelection).
	^ self cachedHierarchy sortedElements! !

!ClassWidget methodsFor: 'private' stamp: 'NicolaiHess 9/7/2014 00:31'!
loadPackageClassListElements
	^ self sortHierarchically
		ifTrue: [ self createClassHierarchyFor: self model selectedPackageGroup ]
		ifFalse: [ self createClassListFor:self model selectedPackageGroup ]! !

!ClassWidget methodsFor: 'private' stamp: 'NicolaiHess 9/7/2014 12:05'!
createClassListFor: aPackageGroup

	aPackageGroup ifNil: [ ^ {}].
	^ (SortAlphabeticallyClassList buildListFor: aPackageGroup asNautilusSelection in: self model browsedEnvironment) sortedElements! !

!ClassWidget methodsFor: 'private' stamp: 'NicolaiHess 7/26/2014 11:33'!
classesSelection
	
	^ classesSelection! !

!ClassWidget methodsFor: 'initialization' stamp: 'NicolaiHess 7/29/2014 22:53'!
initialize

	super initialize.

	classesList := nil.
	classesListElements := nil.
	classesSelection := Dictionary new.
	cachedHierarchy := SortHierarchically new.
	showHierarchy := false.! !

!ClassWidget methodsFor: 'private' stamp: 'NicolaiHess 9/7/2014 00:26'!
loadClassHierarchyListElements
	^ self cachedHierarchy sortedElements ! !

!ClassWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/29/2014 22:54'!
showHierarchy
	
	^ showHierarchy! !

!ClassWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/26/2014 13:45'!
selectedClasses

	| associations |
	associations := self classesSelection associations select: [:assoc | assoc value ].
	associations := associations collect: [:assoc | assoc key ].
	^ associations select: [:each | each notNil ]! !

!ClassWidget methodsFor: 'private list model' stamp: 'NicolaiHess 7/30/2014 12:59'!
doubleClick
	self model fullBrowse! !

!ClassWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/26/2014 00:54'!
takeKeyboardFocus

	classesList takeKeyboardFocus! !

!ClassWidget methodsFor: 'private list model' stamp: 'NicolaiHess 7/26/2014 11:34'!
classSelectionAt: anIndex put: aBoolean
	| elt |
	aBoolean ifNil: [ ^ self ].
	elt := self getClassesList at: anIndex ifAbsent: [ ^ self ].
	self classesSelection at: elt put: aBoolean.
	self model changed: #hasSelectedSelections! !

!ClassWidget methodsFor: 'private' stamp: 'NicolaiHess 7/29/2014 22:56'!
setCachedHierarchyClass: aClass
    | classesToBuild |
    classesToBuild :=
    model showInstance 
        ifTrue:  [  (aClass withAllSuperclasses, aClass allSubclasses) reject: [ :class | class isClassSide ] ]
        ifFalse: [  (aClass class withAllSuperclasses, aClass class allSubclasses) select: [ :class | class isClassSide ] ].
    self cachedHierarchy: (SortHierarchically buildHierarchyForClasses: classesToBuild).! !

!ClassWidget methodsFor: 'private list model' stamp: 'NicolaiHess 7/26/2014 13:19'!
selectedClassIndex: anInteger
	| selection |
	
	selection := self getClassesList at: anInteger ifAbsent: [nil].
	
	self model showInstance ifFalse: [selection ifNotNil: [selection := selection theMetaClass]].
	self model selectedClassWithoutChangingSelection: selection.
	
	self changed: #selectedClassIndex.
	self model changed: #currentHistoryIndex.! !

!ClassWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/29/2014 23:56'!
selectedClass
	^ self selectedClasses ifEmpty:[ nil]  ifNotEmpty:[: col | col first]! !

!ClassWidget methodsFor: 'private list model' stamp: 'NicolaiHess 7/26/2014 11:34'!
classSelectionAt: anIndex
	
	| elt |
	elt := self getClassesList at: anIndex ifAbsent: [ ^false ].
	^ self classesSelection at: elt ifAbsent: [ false ]! !

!ClassWidget methodsFor: 'private' stamp: 'NicolaiHess 7/30/2014 10:11'!
buildPackageGroupHierarchyFor: aPackageGroup
	^ self cachedHierarchy class buildHierarchyFor: aPackageGroup in: self model browsedEnvironment! !

!ClassWidget methodsFor: 'protocol' stamp: 'NicolaiHess 10/2/2014 00:13'!
showHierarchy: aBoolean

	(showHierarchy := aBoolean)
		ifTrue: [ self selectedClass ifNotNil: [ :class | self setCachedHierarchyClass: class ] ]! !

!ClassWidget methodsFor: 'private list model' stamp: 'NicolaiHess 7/26/2014 01:14'!
classIconFor: anItem
	^ self model classIconFor: anItem! !

!ClassWidget methodsFor: 'private list model' stamp: 'NicolaiHess 7/26/2014 11:18'!
classListSize
	^ self getClassesList size! !

!ClassWidget methodsFor: 'private list model' stamp: 'NicolaiHess 7/26/2014 13:23'!
classesMenu: aMenu shifted: aBoolean
	self model classesMenu: aMenu shifted: aBoolean.
	^ aMenu! !

!ClassWidget methodsFor: 'accessing' stamp: 'NicolaiHess 7/29/2014 22:41'!
cachedHierarchy
	
	^ cachedHierarchy! !

!ClassWidget methodsFor: 'private list model' stamp: 'NicolaiHess 7/26/2014 13:29'!
keyPressedOnList: anEvent shifted: aBoolean
		| aCharacter |

	aCharacter := anEvent keyCharacter.

	(aCharacter == self model class nextFocusKey) ifTrue: [ ^ self model giveFocusTo: self model categoryWidget ].
	(aCharacter == self model class previousFocusKey) ifTrue: [ ^ self model giveFocusToPackage ].! !

!ClassWidget methodsFor: 'private' stamp: 'NicolaiHess 9/7/2014 12:11'!
wrapFlat: anElement
	| result |
	result := anElement name.
	^ self model selectedPackage
		ifNil: [ result ]
		ifNotNil: [ :package | 
			(package includesClass: anElement)
				ifTrue: [ result asStringMorph ]
				ifFalse: [ 
					result asStringMorph
						color: self model extensionColor;
						yourself ] ]! !

!ClassWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/26/2014 13:59'!
vScrollValue: aNumber

	^ classesList vScrollValue: aNumber! !

!ClassWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/26/2014 00:43'!
hasFocus
	
	^ classesList hasKeyboardFocus! !

!ClassWidget methodsFor: 'private list model' stamp: 'NicolaiHess 9/7/2014 12:10'!
classWrapper: anElement
	^ self sortHierarchically
		ifTrue: [ self buildTabbedNameOf: anElement ]
		ifFalse: [  self wrapFlat: anElement  ]! !

!ClassWidget methodsFor: 'private list model' stamp: 'NicolaiHess 7/26/2014 11:19'!
getClassItem: anIndex
	^ self getClassesList at: anIndex! !

!ClassWidget methodsFor: 'private' stamp: 'NicolaiHess 7/29/2014 22:45'!
buildTabbedNameOf: anElement
			
	| tab result size |
	
	tab := '   '.
	size := self cachedHierarchy indentationFor: anElement.
	
	result := String new: (size * (tab size)) streamContents: [ :s|
		1 to: size do: [:i | s nextPutAll: tab ]].

	^ self model selectedPackage 
		ifNil: [result, anElement name]
		ifNotNil: [:package | 
			(package includesClass: anElement)
				ifTrue: [ (result, anElement name) asStringMorph ]
				ifFalse: [ (result , anElement name",' (', anElement package name,')'")asStringMorph color: self model extensionColor;yourself]]! !

!ClassWidget methodsFor: 'protocol' stamp: 'NicolaiHess 8/9/2014 20:52'!
okToChange
	^ model okToChange! !

!ClassWidget methodsFor: 'item creation' stamp: 'NicolaiHess 8/9/2014 21:18'!
buildClassesList
	classesList := PluggableIconListMorph new
				basicWrapSelector: #classWrapper:;
				keystrokeSelector: #keyPressedOnList:shifted:;
				getIconSelector: #classIconFor:;
				getListSizeSelector: #classListSize;
				
				resetListSelector: #resetClassSelection;
				autoDeselect: true;
				dropEnabled: true;
				dropItemSelector: #dropInClass:inARow:;
				doubleClickSelector: #doubleClick;
				dragEnabled: true;
				hResizing: #spaceFill;
				vResizing: #spaceFill;
				
				model: self;
				getIndexSelector: #selectedClassIndex;
				setIndexSelector: #selectedClassIndex:;
				getSelectionListSelector: #classSelectionAt:;
				setSelectionListSelector: #classSelectionAt:put:;
				getMenuSelector: #classesMenu:shifted:;
				beMultipleSelection;
				
				getListElementSelector: #getClassItem:.
						
	^ classesList! !

!ClassWidget methodsFor: 'private list model' stamp: 'NicolaiHess 7/28/2014 22:08'!
dropInClass: aCollection inARow: aRow
	| receiver |
	receiver := self getClassesList at: aRow.
	receiver := 
	self model showInstance not
		ifTrue: [ receiver theMetaClass ]
		ifFalse: [ receiver theNonMetaClass ].
	self model dropInAClass: aCollection into: receiver! !

!ClassWidget methodsFor: 'private' stamp: 'NicolaiHess 9/7/2014 00:27'!
loadClassesListElements
	^ self showHierarchy
		ifTrue: [ self loadClassHierarchyListElements ]
		ifFalse: [ self loadPackageClassListElements ]! !

!ClassWidget methodsFor: 'protocol' stamp: 'NicolaiHess 8/9/2014 21:16'!
resetClassList
	classesListElements := nil.! !

!ClassWidget methodsFor: 'protocol' stamp: 'NicolaiHess 8/9/2014 20:48'!
selectClass: aClass
	self classesSelection at: aClass theNonMetaClass put: true.
! !

!Clipboard commentStamp: 'AlainPlantec 1/15/2010 11:42'!
The Clipboard class is the abstract superclass for the concrete platform specific clipboard. The legacy clipboard support using the VM supplied primitives is implemented by Clipboard/ExternalClipboard.

The Clipboard implements a basic buffering scheme for text. The currently selected text is also exported to the OS so that text can be copied from and to other applications. Commonly only a single instance is used (the default clipboard) but applications are free to use other than the default clipboard if necessary.!
!Clipboard methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 09:47'!
initialize
	super initialize.
	contents := '' asText.
	recent := OrderedCollection new! !

!Clipboard methodsFor: 'accessing' stamp: 'StephaneDucasse 1/29/2010 21:42'!
chooseRecentClipping  
	"Choose by menu from among the recent clippings"
	"Clipboard chooseRecentClipping"
	
	recent ifNil: [^ nil].
	^ UIManager default
		chooseFrom: (recent collect: [:txt | ((txt asString contractTo: 50)
									copyReplaceAll: Character cr asString with: '\')
									copyReplaceAll: Character tab asString with: '|'])
		values: recent! !

!Clipboard methodsFor: 'primitives' stamp: 'michael.rueger 3/25/2009 14:23'!
primitiveClipboardText
	"Get the current clipboard text. Return the empty string if the primitive fails."
	<primitive: 141>
	^ ''! !

!Clipboard methodsFor: '*GT-SpotterExtensions-Core-private' stamp: 'StefanReichhart 3/25/2015 08:40'!
recentItems
	recent isEmptyOrNil ifTrue: [ ^ #() ].
	^ recent allButFirst reject: [ :each | 
		each isEmptyOrNil 
			or: [ each asString trimBoth isEmptyOrNil ] ]! !

!Clipboard methodsFor: 'private' stamp: 'ar 1/15/2001 18:34'!
noteRecentClipping: text
	"Keep most recent clippings in a queue for pasteRecent (paste... command)"
	text isEmpty ifTrue: [^ self].
	text size > 50000 ifTrue: [^ self].
	(recent includes: text) ifTrue: [^ self].
	recent addFirst: text.
	[recent size > 5] whileTrue: [recent removeLast].
! !

!Clipboard methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 1/28/2011 15:19'!
clipboardText: text 

        | string |
        string := text asString.
        self noteRecentClipping: text asText.
        contents := text asText.
        string := string convertToWithConverter: UTF8TextConverter new.
        self primitiveClipboardText: string.! !

!Clipboard methodsFor: 'accessing' stamp: 'michael.rueger 6/10/2009 13:42'!
clipboardText
	"Return the text currently in the clipboard. If the system clipboard is empty, or if it differs from the Smalltalk clipboard text, use the Smalltalk clipboard. This is done since (a) the Mac clipboard gives up on very large chunks of text and (b) since not all platforms support the notion of a clipboard."

	| string decodedString |
	string := self primitiveClipboardText.
	(string isEmpty
			or: [string = contents asString])
		ifTrue: [^ contents].
	decodedString := string convertFromWithConverter: UTF8TextConverter new.
	decodedString := decodedString replaceAll: 10 asCharacter with: 13 asCharacter.
	^ decodedString = contents asString
		ifTrue: [contents]
		ifFalse: [decodedString asText].
! !

!Clipboard methodsFor: 'primitives' stamp: 'michael.rueger 3/25/2009 14:23'!
primitiveClipboardText: aString
	"Set the current clipboard text to the given string."

	<primitive: 141>
	"don't fail if the primitive is not implemented"! !

!Clipboard class methodsFor: 'initialization' stamp: 'michael.rueger 3/2/2009 11:11'!
initialize
	"Clipboard initialize"

	Smalltalk addToStartUpList: self.
	Smalltalk addToShutDownList: self.
	self startUp: true.! !

!Clipboard class methodsFor: 'accessing' stamp: 'ar 1/15/2001 18:45'!
chooseRecentClipping  "Clipboard chooseRecentClipping"
	"Choose by menu from among the recent clippings"
	^self default chooseRecentClipping! !

!Clipboard class methodsFor: 'accessing' stamp: 'cami 7/22/2013 18:26'!
default
	^Default ifNil: [Default := Smalltalk os clipboardClass new].! !

!Clipboard class methodsFor: 'initialization' stamp: 'VeronicaUquillas 6/11/2010 13:53'!
shutDown: quitting
	"Pharo is shutting down. If this platform requires specific shutdown code, this is a great place to put it."
! !

!Clipboard class methodsFor: 'accessing' stamp: 'ar 1/15/2001 18:35'!
clipboardText: aText 
	^self default clipboardText: aText! !

!Clipboard class methodsFor: 'accessing' stamp: 'ar 1/15/2001 18:35'!
clipboardText "Clipboard clipboardText"
	^self default clipboardText.! !

!Clipboard class methodsFor: 'initialization' stamp: 'VeronicaUquillas 6/11/2010 13:53'!
startUp: resuming
	"Pharo is starting up. If this platform requires specific intialization, this is a great place to put it."
	resuming
		ifTrue: [Default := nil]! !

!ClippingCanvas commentStamp: '<historical>'!
A modified canvas which clips all drawing commands.!
!ClippingCanvas methodsFor: 'accessing' stamp: 'StephaneDucasse 2/10/2011 11:02'!
contentsOfArea: aRectangle into: aForm
	self flag: #hack.    "ignore the clipping specification for this command.  This is purely so that CachingCanvas will work properly when clipped.  There *has* to be a clean way to do this...."
	
	^canvas contentsOfArea: aRectangle into: aForm! !

!ClippingCanvas methodsFor: 'accessing' stamp: 'ls 3/20/2000 21:17'!
form
	^canvas form! !

!ClippingCanvas methodsFor: 'testing' stamp: 'ls 3/20/2000 21:17'!
isBalloonCanvas
	^canvas isBalloonCanvas! !

!ClippingCanvas methodsFor: 'testing' stamp: 'ls 3/20/2000 21:18'!
isShadowDrawing
	^canvas isShadowDrawing! !

!ClippingCanvas methodsFor: 'accessing' stamp: 'ls 3/20/2000 21:15'!
shadowColor
	^canvas shadowColor! !

!ClippingCanvas methodsFor: 'private' stamp: 'ls 3/20/2000 20:44'!
apply: aBlock
	"apply the given block to the inner canvas with clipRect as the clipping rectangle"
	canvas clipBy: clipRect during: aBlock! !

!ClippingCanvas methodsFor: 'accessing' stamp: 'ls 3/25/2000 22:56'!
clipRect
	^clipRect! !

!ClippingCanvas methodsFor: 'initialization' stamp: 'ls 3/20/2000 20:44'!
canvas: aCanvas  clipRect: aRectangle
	canvas := aCanvas.
	clipRect := aRectangle.! !

!ClippingCanvas class methodsFor: 'instance creation' stamp: 'ls 3/20/2000 20:45'!
canvas: aCanvas  clipRect: aRectangle
	^self new canvas: aCanvas  clipRect: aRectangle! !

!CodeAnnotationMorph commentStamp: 'LaurentLaffont 2/13/2011 16:46'!
I display code annotations that can be embedded in a browser (basic core image browser) to show useful informations about the current method or class. In order to show me in your browser, the "show annotation pane" setting must be set to true (search for 'annotation' in the setting browser). This setting is set to false by default.

The informations to show are given by CodeHolder>>annotation.
A methods annotation is built according to a list of requests which consists in a list of symbols. These symbols are interpreted by CodeHolder>>#annotationForSelector: ofClass:. See CodeHolder class >>#annotationRequests for more details about this list of requests.
By default, the author, the time stamp, the message category, the senders and implementors count and the list of change sets in which the method is referenced are shown.

Because the building of an annotation can be very time consuming (especially the implementors count),an annotation is built in background. So, I am also a good example of how a process can be used in order to build some data in background.

Instance Variables
   codeHolder: <CodeHolder>
   process: <Process>

codeHolder
   - The CodeHolder (a Browser, a MessageList ..) in which I'm embedded

process
   - The process which is building the annotation in background

COTDC - A.Plantec!
!CodeAnnotationMorph methodsFor: 'initialization' stamp: 'AlainPlantec 11/14/2009 00:03'!
initialize
	super initialize.
	self borderWidth: 0.
	self contents: ''.
! !

!CodeAnnotationMorph methodsFor: 'updating' stamp: 'Igor.Stasenko 10/12/2010 23:29'!
update: anAspect
	super update: anAspect.
	anAspect == #contents ifFalse: [ ^self ].
	self syncContents.
! !

!CodeAnnotationMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/13/2009 23:42'!
codeHolder: aCodeHolder
	codeHolder := aCodeHolder.
	aCodeHolder ifNotNil: [aCodeHolder addDependent: self]! !

!CodeAnnotationMorph methodsFor: 'updating' stamp: 'AlainPlantec 7/9/2013 12:35'!
syncContents
	| ch |
	process ifNotNil: [ process terminate ].
	process := nil.
	
	ch := codeHolder ifNil: [ ^ self contents: '' ].
		
	process := [  | ann |
		ann := ch annotation ifNil: [''].
		self defer: [ self contents: ann ].
	] newProcess.
	process priority: Processor userBackgroundPriority.
	process resume.
	! !

!CodeAnnotationMorph class methodsFor: 'instance creation' stamp: 'AlainPlantec 11/13/2009 23:34'!
on: aCodeHolder
	^ self new codeHolder: aCodeHolder! !

!CodeDeclaration commentStamp: '<historical>'!
I'm the abstract superclass of all the code declarations that should exist in an exported file.!
!CodeDeclaration methodsFor: 'importing' stamp: 'CamilloBruni 7/10/2013 20:58'!
importFor: aRequestor
	self import! !

!CodeDeclaration methodsFor: 'accessing' stamp: 'GuillermoPolito 5/5/2012 16:02'!
contents: anObject
	contents := anObject! !

!CodeDeclaration methodsFor: 'accessing' stamp: 'GuillermoPolito 5/5/2012 16:02'!
contents
	^ contents! !

!CodeDeclaration methodsFor: 'importing' stamp: 'CamilloBruni 7/10/2013 20:58'!
import
	self subclassResponsibility! !

!CodeDeclaration methodsFor: 'printing' stamp: 'GuillermoPolito 5/5/2012 20:21'!
printOn: aStream
	super printOn: aStream.
	aStream nextPut: $(.
	aStream nextPutAll: contents.
	aStream nextPut: $).! !

!CodeDeclaration class methodsFor: 'instance creation' stamp: 'GuillermoPolito 5/5/2012 16:02'!
contents: someContents
	^self new
			contents: someContents;
			yourself! !

!CodeHolder commentStamp: '<historical>'!
An ancestor class for all models which can show code.  Eventually, much of the code that currently resides in StringHolder which only applies to code-holding StringHolders might get moved down here.!
!CodeHolder methodsFor: 'diffs' stamp: 'gvc 6/21/2010 11:51'!
showDiffs: aBoolean
	"Set whether I'm showing diffs as indicated"

	self showingAnyKindOfDiffs
		ifFalse:
			[aBoolean ifTrue:
				[self contentsSymbol: self defaultDiffsSymbol]]
		ifTrue:
			[aBoolean ifFalse:
				[self contentsSymbol: #source]].
	self setContentsToForceRefetch.
	self contentsChanged! !

!CodeHolder methodsFor: 'misc' stamp: 'StephaneDucasse 10/15/2009 18:01'!
getSelectorAndSendQuery: querySelector to: queryPerformer with: queryArgs
	"Obtain a selector relevant to the current context, and then send the querySelector to the queryPerformer with the selector obtained and queryArgs as its arguments.  If no message is currently selected, then obtain a method name from a user type-in"

	| strm array |
	strm := (array := Array new: queryArgs size + 1) writeStream.
	strm nextPut: nil.
	strm nextPutAll: queryArgs.

	self selectedMessageName ifNil: [ | selector |
		selector := UIManager default request: 'Type selector:' initialAnswer: 'flag:'.
		selector ifNil: [selector := String new].
		selector := selector copyWithout: Character space.
		^ selector isEmptyOrNil ifFalse: [
			(Symbol hasInterned: selector
				ifTrue: [ :aSymbol |
					array at: 1 put: aSymbol.
					queryPerformer perform: querySelector withArguments: array])
				ifFalse: [ self inform: 'no such selector']
		]
	].

	self selectMessageAndEvaluate: [:selector |
		array at: 1 put: selector.
		queryPerformer perform: querySelector withArguments: array
	]! !

!CodeHolder methodsFor: 'construction' stamp: 'FernandoOlivero 4/12/2011 09:43'!
codePaneProvenanceButton
	"Answer a button that reports on, and allow the user to modify,
	the code-pane-provenance setting"
	
	^(self theme  builder
		newDropListFor: self
		list: #codePaneProvenanceList
		getSelected: #codePaneProvenanceIndex
		setSelected: #codePaneProvenanceIndex:
		help: 'Select what is shown in the code pane' translated)
			cornerStyle: (self theme buttonCornerStyleIn: nil);
			hResizing: #spaceFill;
			vResizing: #spaceFill;
			minWidth: 88! !

!CodeHolder methodsFor: 'what to show' stamp: 'sw 5/22/2001 16:36'!
prettyPrintString
	"Answer whether the receiver is showing pretty-print"

	^ ((contentsSymbol == #prettyPrint)
		ifTrue:
			['<yes>']
		ifFalse:
			['<no>']), 'prettyPrint'! !

!CodeHolder methodsFor: 'diffs' stamp: 'sw 11/13/2001 07:43'!
showingRegularDiffsString
	"Answer a string representing whether I'm showing regular diffs"

	^ (self showingRegularDiffs
		ifTrue:
			['<yes>']
		ifFalse:
			['<no>']), 'showDiffs'! !

!CodeHolder methodsFor: 'diffs' stamp: 'marcus.denker 9/20/2008 20:31'!
toggleRegularDiffing
	"Toggle whether regular-diffing should be shown in the code pane"

	| wasShowingDiffs |
	self okToChange ifTrue:
		[wasShowingDiffs := self showingRegularDiffs.
		self showRegularDiffs: wasShowingDiffs not.
		self setContentsToForceRefetch.
		self contentsChanged]

! !

!CodeHolder methodsFor: 'commands' stamp: 'sw 2/27/2001 12:15'!
offerUnshiftedClassListMenu
	"Offer the shifted class-list menu."

	^ self offerMenuFrom: #classListMenu:shifted: shifted: false! !

!CodeHolder methodsFor: 'annotation' stamp: 'sw 8/26/2002 10:19'!
annotationForClassDefinitionFor: aClass
	"Provide a line of content for an annotation pane, given that the receiver is pointing at the class definition of the given class."

	^ 'Class definition for ', aClass name! !

!CodeHolder methodsFor: 'annotation' stamp: 'sw 2/22/2001 10:02'!
annotationSeparator
	"Answer the separator to be used between annotations"

	^ ' · '! !

!CodeHolder methodsFor: 'annotation' stamp: 'StephaneDucasse 12/19/2012 16:16'!
addOptionalAnnotationsTo: window at: fractions plus: verticalOffset
	"Add an annotation pane to the window if desired, and return the incoming verticalOffset plus the height of the added pane, if any"

	| aTextMorph delta  |
	self showAnnotationPane ifFalse: [^ verticalOffset].
	aTextMorph := CodeAnnotationMorph on: self.
	delta := StandardFonts defaultFont height+2.
	window 
		addMorph: aTextMorph
		fullFrame: ( fractions asLayoutFrame topOffset: verticalOffset; bottomOffset: (verticalOffset + delta)).
	^ verticalOffset + delta! !

!CodeHolder methodsFor: 'diffs' stamp: 'gvc 6/21/2010 11:52'!
showRegularDiffs: aBoolean
	"Set whether I'm showing regular diffs as indicated"

	self showingRegularDiffs
		ifFalse:
			[aBoolean ifTrue:
				[self contentsSymbol: #showDiffs]]
		ifTrue:
			[aBoolean ifFalse:
				[self contentsSymbol: #source]].
	self setContentsToForceRefetch.
	self contentsChanged! !

!CodeHolder methodsFor: 'controls' stamp: 'tbn 7/6/2010 16:22'!
sourceAndDiffsQuintsOnly
	"Answer a list of quintuplets representing information on the alternative views available in the code pane for the case where the only plausible choices are showing source or either of the two kinds of diffs"

	^ #(
(source			togglePlainSource 		showingPlainSourceString	'Source'			'the textual source code as writen')
(showDiffs		toggleRegularDiffing	showingRegularDiffsString	'ShowDiffs'		'the textual source diffed from its prior version')
(prettyDiffs		togglePrettyDiffing		showingPrettyDiffsString	'PrettyDiffs'		'formatted textual source diffed from formatted form of prior version'))! !

!CodeHolder methodsFor: 'self-updating' stamp: 'sw 10/19/1999 08:37'!
stepIn: aSystemWindow
	self updateListsAndCodeIn: aSystemWindow! !

!CodeHolder methodsFor: 'controls' stamp: 'tbn 7/29/2010 22:18'!
optionalButtonPairs
	"Answer a tuple (formerly pairs) defining buttons, in the format:
			button label
			selector to send
			help message"

	| aList |

	aList := #(
	('Browse'			browseMethodFull			'View this method in a browser')
	('Senders' 			browseSendersOfMessages	'Browse senders of...')
	('Implementors'		browseMessages				'Browse implementors of...')
	('Versions'			browseVersions				'Browse versions')), 

	(self class decorateBrowserButtons
		ifTrue:
			[{#('Inheritance'		methodHierarchy 'Browse method inheritance
green: sends to super
tan: has override(s)
mauve: both of the above
pink: is an override but doesn''t call super
pinkish tan: has override(s), also is an override but doesn''t call super' )}]
		ifFalse:
			[{#('Inheritance'		methodHierarchy			'Browse method inheritance')}]),

	#(
	('Hierarchy'		classHierarchy				'Browse class hierarchy')
	('Inst vars'			browseInstVarRefs			'Inst var refs...')
	('Class vars'			browseClassVarRefs			'Class var refs...')).

	^ aList! !

!CodeHolder methodsFor: 'misc' stamp: 'GabrielOmarCotelli 11/30/2013 16:19'!
refreshAnnotation
	"If the receiver has an annotation pane that does not bear unaccepted edits, refresh it"

	self dependents
		detect: [ :m | (m isKindOf: PluggableTextMorph) and: [ m getTextSelector == #annotation ] ]
		ifFound: [ :aPane | 
			aPane hasUnacceptedEdits
				ifFalse: [ aPane update: #annotation ] ]! !

!CodeHolder methodsFor: 'setting' stamp: 'AlainPlantec 11/24/2009 16:59'!
showAnnotationPane
	^ self class showAnnotationPane! !

!CodeHolder methodsFor: 'contents' stamp: 'gvc 6/21/2010 11:42'!
contentsSymbol: aSymbol
	"Set the contentsSymbol as indicated.  #source means to show source code, #comment means to show the first comment found in the source code"

	contentsSymbol := aSymbol.
	self contentsSymbolChanged! !

!CodeHolder methodsFor: 'construction' stamp: 'EstebanLorenzano 5/3/2014 13:54'!
addLowerPanesTo: window at: nominalFractions with: editString

	| verticalOffset row innerFractions tm |
	tm := self buildMorphicCodePaneWith: editString.


	row := AlignmentMorph newColumn
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		layoutInset: 0;
		borderWidth: 1;
		borderColor: Smalltalk ui theme borderColor;
		layoutPolicy: ProportionalLayout new.

	verticalOffset := 0.
	innerFractions := 0@0 corner: 1@0.
	verticalOffset := self addOptionalAnnotationsTo: row at: innerFractions plus: verticalOffset.
	verticalOffset := self addOptionalButtonsTo: row  at: innerFractions plus: verticalOffset.

	row 
		addMorph: (tm borderWidth: 0)
		fullFrame: ((innerFractions withBottom: 1) asLayoutFrame topOffset: verticalOffset).
	window 
		addMorph: row
		frame: nominalFractions.

	row on: #mouseEnter send: #paneTransition: to: window.
	row on: #mouseLeave send: #paneTransition: to: window.! !

!CodeHolder methodsFor: 'diffs' stamp: 'sd 11/20/2005 21:27'!
diffFromPriorSourceFor: sourceCode 
	"If there is a prior version of source for the selected method, return a diff, else just return the source code"

	| prior |
	^ (prior := self priorSourceOrNil)
		ifNil: [sourceCode]
		ifNotNil: [TextDiffBuilder buildDisplayPatchFrom: prior to: sourceCode inClass: self selectedClass prettyDiffs: self showingPrettyDiffs]! !

!CodeHolder methodsFor: 'controls' stamp: 'gm 2/16/2003 20:37'!
buttonWithSelector: aSelector 
	"If receiver has a control button with the given action selector answer it, else answer nil.  morphic only at this point"

	| aWindow aPane |
	((aWindow := self containingWindow) isSystemWindow) 
		ifFalse: [^nil].
	(aPane := aWindow submorphNamed: 'buttonPane') ifNil: [^nil].
	^aPane submorphThat: 
			[:m | 
			(m isKindOf: PluggableButtonMorph) and: [m actionSelector == aSelector]]
		ifNone: [^nil]! !

!CodeHolder methodsFor: 'message list' stamp: 'sw 8/16/2002 23:23'!
selectedBytecodes
	"Answer text to show in a code pane when in showing-byte-codes mode"

	^ (self selectedClassOrMetaClass compiledMethodAt: self selectedMessageName ifAbsent: [^ '' asText]) symbolic asText! !

!CodeHolder methodsFor: 'what to show' stamp: 'sd 11/20/2005 21:27'!
setContentsToForceRefetch
	"Set the receiver's contents such that on the next update the contents will be formulated afresh.  This is a critical and obscure difference between Browsers on the one hand and MessageSets on the other, and has over the years been the source of much confusion and much difficulty.  By centralizing the different handling here, we don't need so many idiosyncratic overrides in MessageSet any more"

	contents := nil! !

!CodeHolder methodsFor: 'what to show' stamp: 'sw 5/18/2001 18:05'!
showingByteCodes
	"Answer whether the receiver is showing bytecodes"

	^ contentsSymbol == #byteCodes! !

!CodeHolder methodsFor: 'contents' stamp: 'MarcusDenker 4/28/2013 21:32'!
contentsSymbolChanged
	"Inform any dependents of a change in the contents symbol."

	self
		changed: #showingAnyKindOfDiffs;
		changed: #showingBytecodes;
		changed: #showingDiffs;
		changed: #showingPlainSource;
		changed: #showingPrettyDiffs;
		changed: #showingPrettyPrint;
		changed: #showingRegularDiffs! !

!CodeHolder methodsFor: 'categories' stamp: 'sw 9/27/1999 14:11'!
methodCategoryChanged
	self changed: #annotation! !

!CodeHolder methodsFor: 'categories' stamp: 'sd 11/20/2005 21:27'!
letUserReclassify: anElement in: aClass
	"Put up a list of categories and solicit one from the user.  
	Answer true if user indeed made a change, else false"
	

	| currentCat newCat |
	currentCat := aClass organization categoryOfElement: anElement.
	newCat := self 
				categoryFromUserWithPrompt: 'choose category (currently "', currentCat, '")' 
				for: aClass.
	(newCat ~~ nil and: [newCat ~= currentCat])
		ifTrue:
			[aClass organization classify: anElement under: newCat suppressIfDefault: false.
			^ true]
		ifFalse:
			[^ false]! !

!CodeHolder methodsFor: 'diffs' stamp: 'gvc 6/21/2010 11:52'!
showPrettyDiffs: aBoolean
	"Set whether I'm showing pretty diffs as indicated"

	self showingPrettyDiffs
		ifFalse:
			[aBoolean ifTrue:
				[self contentsSymbol: #prettyDiffs]]
		ifTrue:
			[aBoolean ifFalse:
				[self contentsSymbol: #source]].
	self setContentsToForceRefetch.
	self contentsChanged! !

!CodeHolder methodsFor: 'what to show' stamp: 'marcus.denker 9/20/2008 20:32'!
toggleShowingByteCodes
	"Toggle whether the receiver is showing bytecodes"

	self showByteCodes: self showingByteCodes not.
	self setContentsToForceRefetch.
	self contentsChanged! !

!CodeHolder methodsFor: 'misc' stamp: 'MarcusDenker 10/3/2013 23:45'!
useSelector: incomingSelector orGetSelectorAndSendQuery: querySelector to: queryPerformer
	"If incomingSelector is not nil, use it, else obtain a selector from user type-in.   Using the determined selector, send the query to the performer provided."

	
	incomingSelector
		ifNotNil:
			[queryPerformer perform: querySelector with: incomingSelector]
		ifNil:
			[| aSelector |
			aSelector :=UIManager default request: 'Type selector:' initialAnswer: 'flag:'.
			aSelector isEmptyOrNil ifFalse:
				[(Symbol hasInterned: aSelector ifTrue:
					[:aSymbol | queryPerformer perform: querySelector with: aSymbol])
					ifFalse:
						[self inform: 'no such selector']]]! !

!CodeHolder methodsFor: 'annotation' stamp: 'MarcusDenker 6/27/2014 11:26'!
addPriorVersionsCountForSelector: aSelector ofClass: aClass to: aStream
	"add an annotation detailing the prior versions count"
	| versionsCount |

	versionsCount := aClass changeRecordsAt: aSelector.
	aStream nextPutAll: 
				((versionsCount > 1
					ifTrue:
						[versionsCount = 2 ifTrue:
							['1 prior version']
							ifFalse:
								[versionsCount printString, ' prior versions']]
					ifFalse:
						['no prior versions']), self annotationSeparator)! !

!CodeHolder methodsFor: '*Shout-Styling' stamp: ''!
shoutIsModeStyleable
	^ self showingSource
		or: [self showingPrettyPrint]! !

!CodeHolder methodsFor: 'what to show' stamp: 'sw 5/22/2001 09:31'!
showingPlainSourceString
	"Answer a string telling whether the receiver is showing plain source"

	^ (self showingPlainSource
		ifTrue:
			['<yes>']
		ifFalse:
			['<no>']), 'source'! !

!CodeHolder methodsFor: 'misc' stamp: 'MarcusDenker 4/26/2013 15:26'!
okayToAccept
	"Answer whether it is okay to accept the receiver's input"

	self showingAnyKindOfDiffs ifFalse:
		[^ true]. 
	^ self confirm: 
'Caution!!
You are "showing diffs" here, so 
there is a danger that some of the text in the
code pane is contaminated by the "diff" display' translated
! !

!CodeHolder methodsFor: 'diffs' stamp: 'sw 11/13/2001 07:49'!
showDiffs
	"Answer whether the receiver is showing diffs of source code.  The preferred protocol here is #showingRegularDiffs, but this message is still sent by some preexisting buttons so is retained."

	^ contentsSymbol == #showDiffs
! !

!CodeHolder methodsFor: 'diffs' stamp: 'FernandoOlivero 4/12/2011 09:43'!
regularDiffButton
	"Return a checkbox that lets the user decide whether regular diffs should be shown or not"

	^self theme builder
		newCheckboxFor: self
		getSelected: #showingRegularDiffs
		setSelected: #toggleRegularDiffing
		label: 'diffs' translated
		help: 'If checked, then code differences from the previous version, if any, will be shown.' translated
! !

!CodeHolder methodsFor: 'commands' stamp: 'sw 3/6/2001 15:18'!
shiftedYellowButtonActivity
	"Offer the shifted selector-list menu"

	^ self offerMenuFrom: #messageListMenu:shifted: shifted: true! !

!CodeHolder methodsFor: 'annotation' stamp: 'sd 11/20/2005 21:27'!
annotation
	"Provide a line of content for an annotation pane, representing information about the method associated with the selected class and selector in the receiver."

	|  aSelector aClass |

	((aSelector := self selectedMessageName) == nil or: [(aClass := self selectedClassOrMetaClass) == nil])
		ifTrue: [^ '------'].
	^ self annotationForSelector: aSelector ofClass: aClass! !

!CodeHolder methodsFor: 'message list' stamp: 'MarcusDenker 4/28/2013 21:32'!
selectedMessage
	"Answer a copy of the source code for the selected message.  This generic version is probably actually never reached, since every subclass probably reimplements and does not send to super.  In time, ideally, most, or all, reimplementors would vanish and all would defer instead to a universal version right here.  Everything in good time."

	| class selector method |
	contents ifNotNil: [^ contents copy].

	class := self selectedClassOrMetaClass.
	(class isNil or: [(selector := self selectedMessageName) isNil]) ifTrue: [^ ''].
	method := class compiledMethodAt: selector ifAbsent: [^ ''].	"method deleted while in another project"
	currentCompiledMethod := method.
	^ contents := (self sourceStringPrettifiedAndDiffed) copy! !

!CodeHolder methodsFor: 'annotation' stamp: 'MarcusDenker 8/7/2014 16:53'!
annotationForSelector: aSelector ofClass: aClass 
	"Provide a line of content for an annotation pane, representing  
	information about the given selector and class"
	| separator aStream requestList |
	aSelector == #Comment
		ifTrue: [^ self annotationForClassCommentFor: aClass].
	aSelector == #Definition
		ifTrue: [^ self annotationForClassDefinitionFor: aClass].
	aSelector == #Hierarchy
		ifTrue: [^ self annotationForHierarchyFor: aClass].
	aStream := ReadWriteStream on: ''.
	requestList := self annotationRequests.
	separator := requestList size > 1
				ifTrue: [self annotationSeparator]
				ifFalse: [''].
	requestList
		do: [:aRequest | | sendersCount aComment implementorsCount aString aList stamp aCategory | 
			aRequest == #firstComment
				ifTrue: [aComment := aClass firstCommentAt: aSelector.
					aComment isEmptyOrNil
						ifFalse: [aStream nextPutAll: aComment , separator]].
			aRequest == #masterComment
				ifTrue: [aComment := aClass supermostPrecodeCommentFor: aSelector.
					aComment isEmptyOrNil
						ifFalse: [aStream nextPutAll: aComment , separator]].
			aRequest == #documentation
				ifTrue: [aComment := aClass precodeCommentOrInheritedCommentFor: aSelector.
					aComment isEmptyOrNil
						ifFalse: [aStream nextPutAll: aComment , separator]].
			aRequest == #timeStamp
				ifTrue: [stamp := self timeStamp.
					aStream
						nextPutAll: (stamp size > 0
								ifTrue: [stamp , separator]
								ifFalse: ['no timeStamp' , separator])].
			aRequest == #messageCategory
				ifTrue: [aCategory := aClass organization categoryOfElement: aSelector.
					aCategory
						ifNotNil: ["woud be nil for a method no longer present,  
							e.g. in a recent-submissions browser"
							aStream nextPutAll: aCategory , separator]].
			aRequest == #sendersCount
				ifTrue: [sendersCount := (self systemNavigation allCallsOn: aSelector) size.
					sendersCount := sendersCount = 1
								ifTrue: ['1 sender']
								ifFalse: [sendersCount printString , ' senders'].
					aStream nextPutAll: sendersCount , separator].
			aRequest == #implementorsCount
				ifTrue: [implementorsCount := aSelector implementors size.
					implementorsCount := implementorsCount = 1
								ifTrue: ['1 implementor']
								ifFalse: [implementorsCount printString , ' implementors'].
					aStream nextPutAll: implementorsCount , separator].
			aRequest == #priorVersionsCount
				ifTrue: [self
						addPriorVersionsCountForSelector: aSelector
						ofClass: aClass
						to: aStream].
			aRequest == #recentChangeSet
				ifTrue: [aString := ChangeSet mostRecentChangeSetWithChangeForClass: aClass selector: aSelector.
					aString size > 0
						ifTrue: [aStream nextPutAll: aString , separator]].
			aRequest == #allChangeSets
				ifTrue: [aList := ChangeSet allChangeSetsWithClass: aClass selector: aSelector.
					aList size > 0
						ifTrue: [aList size = 1
								ifTrue: [aStream nextPutAll: 'only in change set ']
								ifFalse: [aStream nextPutAll: 'in change sets: '].
							aList
								do: [:aChangeSet | aStream nextPutAll: aChangeSet name , ' ']]
						ifFalse: [aStream nextPutAll: 'in no change set'].
					aStream nextPutAll: separator]].
	^ aStream contents! !

!CodeHolder methodsFor: 'categories' stamp: 'EstebanLorenzano 6/26/2013 17:59'!
categoryFromUserWithPrompt: aPrompt for: aClass
	"self new categoryFromUserWithPrompt: 'testing' for: SystemDictionary"

	| labels myCategories reject lines newName  | 
	labels := OrderedCollection new.
	labels addAll: (myCategories := aClass organization categories asSortedCollection:
		[:a :b | a asLowercase < b asLowercase]).
	reject := myCategories asSet.
	reject
		add: Protocol nullCategory;
		add: Protocol unclassified.
	lines := OrderedCollection with: 1 with: (myCategories size + 1).

	aClass allSuperclasses do:
		[:cls | | cats |
			cats := cls organization categories reject:
				 [:cat | reject includes: cat].
			cats isEmpty ifFalse:
				[lines add: labels size.
				labels addAll: (cats asSortedCollection:
					[:a :b | a asLowercase < b asLowercase]).
				reject addAll: cats]].

	newName := UIManager default chooseOrRequestFrom: labels lines: lines title: aPrompt.
	^ newName ifNotNil: [newName asSymbol]! !

!CodeHolder methodsFor: 'setting' stamp: 'AlainPlantec 11/27/2009 09:24'!
browseWithPrettyPrint
	^ self class browseWithPrettyPrint ! !

!CodeHolder methodsFor: 'commands' stamp: 'MarcusDenker 10/13/2013 07:58'!
browseSenders
	"Create and schedule a message set browser on all senders of the currently selected message selector.  Of there is no message currently selected, offer a type-in"

	self sendQuery: #browseAllSendersOf: to: self systemNavigation! !

!CodeHolder methodsFor: 'controls' stamp: 'gvc 1/20/2009 15:34'!
codePaneProvenanceIndex
	"Answer the selected code provenance index."
	
	^((self contentsSymbolQuints select: [:e | e ~= #-]) collect: [:e |
		e first]) indexOf: self contentsSymbol ifAbsent: [0]! !

!CodeHolder methodsFor: 'contents' stamp: 'AlainPlantec 11/24/2009 17:20'!
contentsSymbol
	"Answer a symbol indicating what kind of content should be shown for the method; for normal showing of source code, this symbol is #source.  A nil value in the contentsSymbol slot will be set to #source by this method"

	^ contentsSymbol ifNil:
		[contentsSymbol := self browseWithPrettyPrint
								ifTrue:
									[#prettyPrint]
								ifFalse:
									[#source]]! !

!CodeHolder methodsFor: 'annotation' stamp: 'sd 11/20/2005 21:27'!
annotationForClassCommentFor: aClass
	"Provide a line of content for an annotation pane, given that the receiver is pointing at the clas comment of the given class."

	| aStamp nonMeta |
	aStamp :=  (nonMeta := aClass theNonMetaClass) organization commentStamp.
	^ aStamp
		ifNil:
			[nonMeta name, ' has no class comment']
		ifNotNil:
			['class comment for ', nonMeta name,
				(aStamp = '<historical>'
					ifFalse:
						[' - ', aStamp]
					ifTrue:
						[''])]! !

!CodeHolder methodsFor: 'message list menu' stamp: 'MarcusDenker 10/13/2013 07:59'!
messageListKey: aChar from: view
	"Respond to a Command key.  I am a model with a code pane, and I also
	have a listView that has a list of methods.  The view knows how to get
	the list and selection."

	| sel class |
	aChar == $D ifTrue: [^ self toggleDiffing].

	sel := self selectedMessageName.
	aChar == $m ifTrue:  "These next two put up a type in if no message selected"
		[^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllImplementorsOf: to: self systemNavigation].
	aChar == $n ifTrue: 
		[^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllSendersOf: to: self systemNavigation].

	"The following require a class selection"
	(class := self selectedClassOrMetaClass) ifNil: [^ self arrowKey: aChar from: view].
	aChar == $b ifTrue: [^ Smalltalk tools browser fullOnClass: class selector: sel].
	aChar == $N ifTrue: [^ self browseClassRefs].
	aChar == $i ifTrue: [^ self methodHierarchy].
	aChar == $h ifTrue: [^ self classHierarchy].

	"The following require a method selection"
	sel ifNotNil: 
		[aChar == $o ifTrue: [^ self fileOutMessage].
		aChar == $c ifTrue: [^ self copySelector].
		aChar == $v ifTrue: [^ self browseVersions].
		aChar == $x ifTrue: [^ self removeMessage].
		aChar == $d ifTrue: [^ self removeMessageFromBrowser].

		(aChar == $C and: [self canShowMultipleMessageCategories])
			ifTrue: [^ self showHomeCategory]].

	^ self arrowKey: aChar from: view! !

!CodeHolder methodsFor: 'misc' stamp: 'md 2/24/2006 15:28'!
isThereAnOverride
	"Answer whether any subclass of my selected class implements my 
	selected selector"
	| aName aClass |
	aName := self selectedMessageName ifNil: [^ false].
	aClass := self selectedClassOrMetaClass ifNil: [^ false].
	aClass allSubclassesDo: [ :cls | (cls includesSelector: aName) ifTrue: [ ^true ]].
	^ false! !

!CodeHolder methodsFor: 'diffs' stamp: 'gvc 6/21/2010 11:52'!
togglePrettyPrint
	"Toggle whether pretty-print is in effectin the code pane"

	self okToChange ifTrue:
		[self showingPrettyPrint
			ifTrue:
				[self contentsSymbol: #source]
			ifFalse:
				[self contentsSymbol: #prettyPrint].
		self setContentsToForceRefetch.
		self contentsChanged]

! !

!CodeHolder methodsFor: 'misc' stamp: 'StephaneDucasse 1/13/2010 14:22'!
initialExtent

	^ 700@500! !

!CodeHolder methodsFor: 'controls' stamp: 'ar 2/12/2005 14:28'!
decorateButtons
	"Change screen feedback for any buttons in the UI of the receiver that may wish it.  Initially, it is only the Inheritance button that is decorated, but one can imagine others."
	self changed: #inheritanceButtonColor.
	self decorateForInheritance ! !

!CodeHolder methodsFor: 'construction' stamp: 'MarcusDenker 7/19/2014 09:17'!
addOptionalButtonsTo: window at: fractions plus: verticalOffset 
	"If the receiver wishes it, add a button pane to the window, and
	answer the verticalOffset plus the height added"
	| delta buttons |
	buttons := self optionalButtonRow color: Color white.
	buttons  layoutInset: (0@0 corner: 0@4).
	buttons := OverflowRowMorph new
		baseMorph: buttons;
		height: buttons minExtent y;
		setNameTo: buttons assureExtension externalName.
	delta := buttons minExtent y.

	window
		addMorph: buttons
		fullFrame: (fractions asLayoutFrame topOffset: verticalOffset; bottomOffset: (verticalOffset + delta)).

	^ verticalOffset + delta! !

!CodeHolder methodsFor: 'diffs' stamp: 'sw 5/22/2001 16:41'!
showingPrettyDiffsString
	"Answer a string representing whether I'm showing pretty diffs"

	^ (self showingPrettyDiffs
		ifTrue:
			['<yes>']
		ifFalse:
			['<no>']), 'prettyDiffs'! !

!CodeHolder methodsFor: 'self-updating' stamp: 'MarcusDenker 7/27/2014 09:03'!
contentsChanged
	self changed: #contents! !

!CodeHolder methodsFor: 'diffs' stamp: 'FernandoOlivero 4/12/2011 09:43'!
prettyDiffButton
	"Return a checkbox that lets the user decide whether prettyDiffs should be shown or not"
		
	^self theme builder
		newCheckboxFor: self
		getSelected: #showingPrettyDiffs
		setSelected: #togglePrettyDiffing
		label: 'prettyDiffs' translated
		help: 'If checked, then pretty-printed code differences from the previous version, if any, will be shown.' translated

! !

!CodeHolder methodsFor: 'toolbuilder' stamp: 'marcus.denker 8/17/2008 21:02'!
color

	| flags aColor |
	flags := 0.
	self isThisAnOverride ifTrue: [ flags := flags bitOr: 4 ].
	currentCompiledMethod sendsToSuper ifTrue: [ flags := flags bitOr: 2 ].
	self isThereAnOverride ifTrue: [ flags := flags bitOr: 1 ].
	aColor := {
		Color transparent.
		Color tan lighter.
		Color green muchLighter.
		Color blue muchLighter.
		Color red muchLighter.	"has super but doesn't call it"
		(Color r: 0.94 g: 0.823 b: 0.673).	"has sub; has super but doesn't call it"
		Color green muchLighter.
		Color blue muchLighter.
	} at: flags + 1.

	^aColor! !

!CodeHolder methodsFor: 'traits' stamp: 'StephaneDucasse 11/7/2011 22:43'!
showUnreferencedInstVars
	"Search for all instance variables known to the selected class, and put up a list of those that have no references anywhere in the system.  The search includes superclasses, so that you don't need to navigate your way to the class that defines each inst variable in order to determine whether it is unreferenced"

	| cls aList aReport |
	((cls := self selectedClassOrMetaClass) isNil or: [cls isTrait]) ifTrue: [^ self].
	aList := cls allUnreferencedInstanceVariables.
	aList size = 0 ifTrue: [^ self inform: 'There are no unreferenced
instance variables in
', cls name].
	aReport := String streamContents:
		[:aStream |
			aStream nextPutAll: 'Unreferenced instance variable(s) in ' translated, cls name; cr.
			aList do: [:el | aStream tab; nextPutAll: el; cr]].
	self crTrace: aReport.
	self inform: aReport! !

!CodeHolder methodsFor: 'self-updating' stamp: 'MarcusDenker 7/5/2014 18:58'!
didCodeChangeElsewhere
	"Determine whether the code for the currently selected method and class has been changed somewhere else."
	| aClass aSelector aCompiledMethod |
	currentCompiledMethod ifNil: [^ false].

	(aClass := self selectedClassOrMetaClass) ifNil: [^ false].

	(aSelector := self selectedMessageName) ifNil: [^ false].

	self classCommentIndicated
		ifTrue: [^ currentCompiledMethod ~~ aClass organization commentRemoteString].

	^ (aCompiledMethod := aClass compiledMethodAt: aSelector ifAbsent: [^ false]) ~~ currentCompiledMethod
		and: [aCompiledMethod last ~= 0 "either not yet installed"
				or: [ currentCompiledMethod last = 0 "or these methods don't have source pointers"]]! !

!CodeHolder methodsFor: 'self-updating' stamp: 'sw 2/14/2001 15:34'!
updateCodePaneIfNeeded
	"If the code for the currently selected method has changed underneath me, then update the contents of my code pane unless it holds unaccepted edits"

	self didCodeChangeElsewhere
		ifTrue:
			[self hasUnacceptedEdits
				ifFalse:
					[self setContentsToForceRefetch.
					self contentsChanged]
				ifTrue:
					[self changed: #codeChangedElsewhere]]! !

!CodeHolder methodsFor: 'construction' stamp: 'GuillermoPolito 11/17/2014 17:27'!
optionalButtonRow
	"Answer a row of control buttons"
	
	| buttons |
	buttons := OrderedCollection new.
	self optionalButtonPairs
		do: [:tuple |
			buttons add: ((PluggableButtonMorph
					on: self
					getState: nil
					action: tuple second)
				hResizing: #spaceFill;
				vResizing: #spaceFill;
				label: tuple first asString;
				setBalloonText: (tuple size > 2 ifTrue: [tuple third]);
				triggerOnMouseDown: (tuple size > 3
					ifTrue: [tuple fourth]
					ifFalse: [false]))].
	buttons add: self codePaneProvenanceButton.
	^(self theme builder newRow:  buttons)
		setNameTo: 'buttonPane';
		cellInset: 2! !

!CodeHolder methodsFor: 'misc' stamp: 'sw 9/27/2001 01:26'!
modelWakeUpIn: aWindow
	"The window has been activated.  Respond to possible changes that may have taken place while it was inactive"

	self updateListsAndCodeIn: aWindow.
	self decorateButtons.
	self refreshAnnotation.

	super modelWakeUpIn: aWindow! !

!CodeHolder methodsFor: 'misc' stamp: 'sd 11/20/2005 21:27'!
priorSourceOrNil
	"If the currently-selected method has a previous version, return its source, else return nil"
	| aClass aSelector  changeRecords |
	(aClass := self selectedClassOrMetaClass) ifNil: [^ nil].
	(aSelector := self selectedMessageName) ifNil: [^ nil].
	changeRecords := aClass changeRecordsAt: aSelector.
	(changeRecords == nil or: [changeRecords size <= 1]) ifTrue: [^ nil].
	^ (changeRecords at: 2) string 
! !

!CodeHolder methodsFor: 'what to show' stamp: 'gvc 6/21/2010 11:52'!
showByteCodes: aBoolean
	"Get into or out of bytecode-showoing mode"

	self okToChange ifFalse: [^ self changed: #flash].
	aBoolean
		ifTrue:
			[self contentsSymbol: #byteCodes]
		ifFalse:
			[contentsSymbol == #byteCodes ifTrue: [self contentsSymbol: #source]].
	self contentsChanged! !

!CodeHolder methodsFor: 'controls' stamp: 'gvc 1/20/2009 15:33'!
codePaneProvenanceIndex: anInteger
	"Set the code provenance to the item with the given index."
	
	self perform: ((self contentsSymbolQuints select: [:e | e ~= #-]) at: anInteger) second! !

!CodeHolder methodsFor: 'categories' stamp: 'sw 3/22/2000 23:04'!
selectedMessageCategoryName
	"Answer the name of the message category of the message of the currently selected context."

	^ self selectedClass organization categoryOfElement: self selectedMessageName! !

!CodeHolder methodsFor: 'tiles' stamp: 'StephaneDucasse 10/22/2014 21:30'!
addModelItemsToWindowMenu: aMenu
	"Add model-related item to the window menu"

	super addModelItemsToWindowMenu: aMenu. 
	aMenu addLine.
	aMenu add: 'What to show...'  target: self selector: #offerWhatToShowMenu! !

!CodeHolder methodsFor: 'traits' stamp: 'MarcusDenker 6/27/2014 17:04'!
spawnHierarchy
	"Create and schedule a new hierarchy browser on the currently selected
	class or meta."

	| aSymbol selectedClassOrMetaClass browser |
	(selectedClassOrMetaClass := self selectedClassOrMetaClass) ifNil: [ ^ self ].
	selectedClassOrMetaClass isTrait
		ifTrue: [ ^ self ].
	browser := ((aSymbol := self selectedMessageName) notNil
		and: [ (#(Comment Definition Hierarchy) includes: aSymbol) not ])
		ifTrue: [ Smalltalk tools browser newOnClass: selectedClassOrMetaClass selector: aSymbol ]
		ifFalse: [ Smalltalk tools browser newOnClass: selectedClassOrMetaClass ].
	browser spawnHierarchy! !

!CodeHolder methodsFor: 'what to show' stamp: 'NicolaiHess 9/8/2014 22:04'!
addContentsTogglesTo: aMenu 
	"Add updating menu toggles governing contents to aMenu."
	self contentsSymbolQuints
		do: [:aQuint | aQuint == #-
				ifTrue: [aMenu addLine]
				ifFalse: [aMenu
						addUpdating: aQuint third
						target: self
						selector: aQuint second.
					aMenu balloonTextForLastItem: aQuint fifth]]! !

!CodeHolder methodsFor: 'accessing' stamp: 'StephaneDucasse 2/23/2012 14:24'!
receiverClass
	^ self selectedClassOrMetaClass! !

!CodeHolder methodsFor: 'diffs' stamp: 'sw 5/19/2001 00:07'!
showingPrettyDiffs
	"Answer whether the receiver is showing pretty diffs of source code"

	^ contentsSymbol == #prettyDiffs
! !

!CodeHolder methodsFor: 'what to show' stamp: 'StephaneDucasse 10/22/2014 21:57'!
offerWhatToShowMenu
	"Offer a menu governing what to show"
	| aMenu |
	aMenu := UIManager default newMenuIn: self for: self.
	aMenu addTitle: 'What to show'.
	aMenu addStayUpItem.
	self addContentsTogglesTo: aMenu.
	aMenu popUpInWorld! !

!CodeHolder methodsFor: 'misc' stamp: 'nk 4/10/2001 07:52'!
getSelectorAndSendQuery: querySelector to: queryPerformer
	"Obtain a selector relevant to the current context, and then send the querySelector to the queryPerformer with the selector obtained as its argument.  If no message is currently selected, then obtain a method name from a user type-in"

	self getSelectorAndSendQuery: querySelector to: queryPerformer with: { }.
! !

!CodeHolder methodsFor: 'what to show' stamp: 'sw 5/18/2001 18:36'!
showingPrettyPrint
	"Answer whether the receiver is showing pretty-print"

	^ contentsSymbol == #prettyPrint! !

!CodeHolder methodsFor: 'what to show' stamp: 'sw 12/5/2000 11:48'!
showingSource
	"Answer whether the receiver is currently showing source code"

	^ self contentsSymbol == #source
! !

!CodeHolder methodsFor: 'controls' stamp: 'MarcusDenker 4/28/2013 21:31'!
contentsSymbolQuints
	"Answer a list of quintuplets representing information on the alternative views available in the code pane
		first element:	the contentsSymbol used
		second element:	the selector to call when this item is chosen.
		third element:	the selector to call to obtain the wording of the menu item.
		fourth element:	the wording to represent this view
		fifth element:	balloon help
	A hypen indicates a need for a seperator line in a menu of such choices"

	^ #(
(source			togglePlainSource 			showingPlainSourceString	'Source'		'The textual source code as writen')
-
(prettyPrint		togglePrettyPrint 			prettyPrintString			'PrettyPrint'			'The method source presented in a standard text format')
-
(showDiffs		toggleRegularDiffing		showingRegularDiffsString	'ShowDiffs'				'The textual source diffed from its prior version')
(prettyDiffs		togglePrettyDiffing			showingPrettyDiffsString	'PrettyDiffs'		'Formatted textual source diffed from formatted form of prior version')
-
(byteCodes		toggleShowingByteCodes		showingByteCodesString		'ByteCodes'			'The bytecodes that comprise the compiled method'))! !

!CodeHolder methodsFor: 'builder' stamp: 'AlainPlantec 8/26/2011 17:51'!
buildTextMorph 

	^( PluggableTextMorph
				on: self
				text: #contents
				accept: #contents:notifying:
				readSelection: #contentsSelection
				menu: #codePaneMenu:shifted:)
			font: StandardFonts codeFont;
			yourself! !

!CodeHolder methodsFor: 'misc' stamp: 'rbb 3/1/2005 10:31'!
sendQuery: querySelector to: queryPerformer
	"Apply a query to the primary selector associated with the current context.  If no such selection exists, obtain one by user type-in. Then send querySelector to queryPerformer with the selector as its argument."

	| aSelector aString |
	aSelector := self selectedMessageName ifNil:
		[aString :=UIManager default request: 'Type selector:' initialAnswer: 'flag:'.
		^ aString isEmptyOrNil ifFalse:
			[(Symbol hasInterned: aString ifTrue:
				[:aSymbol | queryPerformer perform: querySelector with: aSymbol])
				ifFalse:
					[self inform: 'no such selector']]].

	queryPerformer perform: querySelector with: aSelector! !

!CodeHolder methodsFor: 'toolbuilder' stamp: 'AlainPlantec 12/1/2009 22:56'!
inheritanceButtonColor
	"Check to see if the currently-viewed method has a super send or an override, and if so, change screen feedback, unless the #decorateBrowserButtons says not to."

	((currentCompiledMethod isKindOf: CompiledMethod) and: [self class decorateBrowserButtons])
		ifFalse: [^Color transparent].

	"This table duplicates the old logic, but adds two new colors for the cases where there is a superclass definition, but this method doesn't call it."

	^ self color

! !

!CodeHolder methodsFor: 'traits' stamp: 'StephaneDucasse 11/7/2011 22:43'!
showUnreferencedClassVars
	"Search for all class variables known to the selected class, and put up a 
	list of those that have no references anywhere in the system. The 
	search includes superclasses, so that you don't need to navigate your 
	way to the class that defines each class variable in order to determine 
	whether it is unreferenced"
	| cls aList aReport |
	((cls := self selectedClass) isNil or: [cls isTrait]) ifTrue: [^ self].
	aList := self systemNavigation allUnreferencedClassVariablesOf: cls.
	aList size = 0
		ifTrue: [^ self inform: 'There are no unreferenced
class variables in
' , cls name].
	aReport := String
				streamContents: [:aStream | 
					aStream nextPutAll: 'Unreferenced class variable(s) in ' translated, cls name;
						 cr.
					aList
						do: [:el | aStream tab; nextPutAll: el; cr]].
	self crTrace: aReport.
	self inform: aReport! !

!CodeHolder methodsFor: 'what to show' stamp: 'sw 12/5/2000 12:25'!
showDocumentation: aBoolean
	"Set the showDocumentation toggle as indicated"

	self contentsSymbol: (aBoolean ifFalse: [#source] ifTrue: [#documentation])! !

!CodeHolder methodsFor: 'categories' stamp: 'sd 11/20/2005 21:26'!
changeCategory
	"Present a menu of the categories of messages for the current class, 
	and let the user choose a new category for the current message"

	| aClass aSelector |
	(aClass := self selectedClassOrMetaClass) ifNotNil:
		[(aSelector := self selectedMessageName) ifNotNil:
			[(self letUserReclassify: aSelector in: aClass) ifTrue:
				["ChangeSet current reorganizeClass: aClass."
				"Decided on further review that the above, when present, could cause more
                    unexpected harm than good"
				self methodCategoryChanged]]]! !

!CodeHolder methodsFor: 'diffs' stamp: 'sw 11/13/2001 07:07'!
showingRegularDiffs
	"Answer whether the receiver is showing regular diffs of source code"

	^ contentsSymbol == #showDiffs
! !

!CodeHolder methodsFor: 'diffs' stamp: 'sw 11/13/2001 07:24'!
wantsDiffFeedback
	"Answer whether the receiver is showing diffs of source code"

	^ self showingAnyKindOfDiffs! !

!CodeHolder methodsFor: 'message list' stamp: 'MarcusDenker 4/28/2013 11:13'!
validateMessageSource: sourceString forSelector: aSelector
	"Check whether there is evidence that method source is invalid"

	| sourcesName |
	(self selectedClass compiler parseSelector: sourceString asString) = aSelector
		ifFalse: [
			sourcesName := Smalltalk sourcesName asFileReference basename.
			self inform: 'There may be a problem with your sources file!!

The source code for every method should (usually) start with the
method selector but this is not the case with this method!! You may
proceed with caution but it is recommended that you get a new source file.

This can happen if you download the "' , sourcesName  , '" file, 
or the ".changes" file you use, as TEXT. It must be transfered 
in BINARY mode, even if it looks like a text file, 
to preserve the CR line ends.

Mac users: This may have been caused by Stuffit Expander. 
To prevent the files above to be converted to Mac line ends 
when they are expanded, do this: Start the program, then 
from Preferences... in the File menu, choose the Cross 
Platform panel, then select "Never" and press OK. 
Then expand the compressed archive again.

(Occasionally, the source code for a method may legitimately
start with a non-alphabetic character -- for example, Behavior
method #formalHeaderPartsFor:.  In such rare cases, you can
happily disregard this warning.)'].! !

!CodeHolder methodsFor: 'message category functions' stamp: 'sw 10/8/2001 14:19'!
canShowMultipleMessageCategories
	"Answer whether the receiver is capable of showing multiple message categories"

	^ false! !

!CodeHolder methodsFor: 'message list' stamp: 'MarcusDenker 8/28/2013 10:34'!
sourceStringPrettifiedAndDiffed
	"Answer a copy of the source code for the selected message, transformed by diffing and pretty-printing exigencies"

	| class selector sourceString |
	class := self selectedClassOrMetaClass.
	selector := self selectedMessageName.
	(class isNil or: [selector isNil]) ifTrue: [^'missing'].
	sourceString := class ultimateSourceCodeAt: selector ifAbsent: [^'error'].
	self validateMessageSource: sourceString forSelector: selector.
	(#(#prettyPrint #prettyDiffs) 
		includes: contentsSymbol) 
			ifTrue: 
				[sourceString := class compiler format: sourceString].
	self showingAnyKindOfDiffs 
		ifTrue: [sourceString := self diffFromPriorSourceFor: sourceString].
	^sourceString! !

!CodeHolder methodsFor: 'misc' stamp: 'sd 11/20/2005 21:27'!
releaseCachedState
	"Can always be found again.  Don't write on a file."
	currentCompiledMethod := nil.! !

!CodeHolder methodsFor: 'commands' stamp: 'onierstrasz 11/11/2013 12:23'!
removeClass
	"Remove the selected class from the system, at interactive user request.  Make certain the user really wants to do this, since it is not reversible.  Answer true if removal actually happened."

	| message  className classToRemove result |
	self okToChange ifFalse: [^ false].
	classToRemove := self selectedClassOrMetaClass ifNil: [self inform: 'Selected class or metaclass is nil'. ^ false].
	classToRemove := classToRemove theNonMetaClass.
	className := classToRemove name.
	message := 'Are you certain that you
want to REMOVE the class ', className, '
from the system?'.
	(result := self confirm: message)
		ifTrue: 
			[classToRemove subclasses size > 0
				ifTrue: [(self confirm: 'class has subclasses: ' , message)
					ifFalse: [^ false]].
			classToRemove removeFromSystem.
			self changed: #classList.
			true].
	^ result! !

!CodeHolder methodsFor: 'diffs' stamp: 'sw 9/5/2001 13:32'!
showingAnyKindOfDiffs
	"Answer whether the receiver is currently set to show any kind of diffs"

	^ #(showDiffs prettyDiffs) includes: contentsSymbol! !

!CodeHolder methodsFor: 'self-updating' stamp: 'MarcusDenker 7/21/2014 10:38'!
updateListsAndCodeIn: aWindow
	self canDiscardEdits ifFalse: [^ self].
	aWindow updatablePanes do: [:aPane | aPane verifyContents].
	self updateCodePaneIfNeeded! !

!CodeHolder methodsFor: 'diffs' stamp: 'MarcusDenker 6/14/2014 12:23'!
toggleDiffing
	"Toggle whether diffs should be shown in the code pane.  If any kind of diffs were being shown, stop showing diffs.  If no kind of diffs were being shown, start showing whatever kind of diffs are called for by default."

	| wasShowingDiffs |
	self okToChange
		ifFalse: [ ^ self ].
	wasShowingDiffs := self showingAnyKindOfDiffs.
	self showDiffs: wasShowingDiffs not.
	self setContentsToForceRefetch.
	self contentsChanged! !

!CodeHolder methodsFor: 'annotation' stamp: 'AlainPlantec 12/21/2009 22:23'!
annotationRequests
	^ self class annotationRequests! !

!CodeHolder methodsFor: 'what to show' stamp: 'sw 5/22/2001 18:28'!
showingByteCodesString
	"Answer whether the receiver is showing bytecodes"

	^ (self showingByteCodes
		ifTrue:
			['<yes>']
		ifFalse:
			['<no>']), 'byteCodes'! !

!CodeHolder methodsFor: 'diffs' stamp: 'MarcusDenker 6/14/2014 12:23'!
togglePlainSource
	"Toggle whether plain source shown in the code pane"

	| wasShowingPlainSource |
	self okToChange
		ifFalse: [ ^ self ].
	wasShowingPlainSource := self showingPlainSource.
	wasShowingPlainSource
		ifTrue: [ self showDocumentation: true ]
		ifFalse: [ self contentsSymbol: #source ].
	self setContentsToForceRefetch.
	self changed: #contents! !

!CodeHolder methodsFor: 'commands' stamp: 'sd 11/20/2005 21:27'!
browseImplementors
	"Create and schedule a message set browser on all implementors of the currently selected message selector. Do nothing if no message is selected."

	| aMessageName |
	(aMessageName := self selectedMessageName) ifNotNil: 
		[self systemNavigation browseAllImplementorsOf: aMessageName]! !

!CodeHolder methodsFor: 'misc' stamp: 'md 2/24/2006 15:28'!
isThisAnOverride
	"Answer whether any superclass of my selected class implements my selected selector"
	| aName aClass |
	aName := self selectedMessageName ifNil: [^ false].
	aClass := self selectedClassOrMetaClass ifNil: [^ false].
	aClass allSuperclassesDo: [ :cls | (cls includesSelector: aName) ifTrue: [ ^true ]].
	^ false! !

!CodeHolder methodsFor: 'diffs' stamp: 'MarcusDenker 7/23/2014 17:43'!
defaultDiffsSymbol
	"Answer the code symbol to use when generically switching to diffing"

	^TextDiffBuilder diffsWithPrettyPrint 
		ifTrue:
			[#prettyDiffs]
		ifFalse:
			[#showDiffs]! !

!CodeHolder methodsFor: 'commands' stamp: 'sw 2/27/2001 12:14'!
offerShiftedClassListMenu
	"Offer the shifted class-list menu."

	^ self offerMenuFrom: #classListMenu:shifted: shifted: true! !

!CodeHolder methodsFor: 'commands' stamp: 'sw 3/6/2001 15:19'!
unshiftedYellowButtonActivity
	"Offer the unshifted shifted selector-list menu"

	^ self offerMenuFrom: #messageListMenu:shifted: shifted: false! !

!CodeHolder methodsFor: 'annotation' stamp: 'sw 8/26/2002 10:19'!
annotationForHierarchyFor: aClass
	"Provide a line of content for an annotation pane, given that the receiver is pointing at the hierarchy of the given class."

	^ 'Hierarchy for ', aClass name! !

!CodeHolder methodsFor: 'controls' stamp: 'gvc 1/20/2009 15:31'!
codePaneProvenanceList
	"Answer a list of the display strings for code provenance."
	
	^(self contentsSymbolQuints select: [:e | e ~= #-]) collect: [:e |
		e fourth]! !

!CodeHolder methodsFor: 'categories' stamp: 'sd 11/20/2005 21:27'!
categoryOfCurrentMethod
	"Answer the category that owns the current method.  If unable to determine a category, answer nil."

	| aClass aSelector |
	^ (aClass := self selectedClassOrMetaClass) 
		ifNotNil: [(aSelector := self selectedMessageName) 
			            ifNotNil: [aClass whichCategoryIncludesSelector: aSelector]]! !

!CodeHolder methodsFor: 'construction' stamp: 'StephaneDucasse 2/14/2011 12:41'!
buildMorphicCodePaneWith: editString
	"Construct the pane that shows the code.
	Respect StandardFonts codeFont."

	| codePane |
	codePane := self buildTextMorph..
	editString
		ifNotNil: [codePane editString: editString.
			codePane hasUnacceptedEdits: true].
	^ codePane! !

!CodeHolder methodsFor: 'controls' stamp: 'AlainPlantec 12/1/2009 22:56'!
decorateForInheritance
	"Check to see if the currently-viewed method has a super send or an override, and if so, change screen feedback, unless the #decorateBrowserButtons says not to."

	| aButton |
	(aButton := self inheritanceButton) ifNil: [^ self].

	((currentCompiledMethod isKindOf: CompiledMethod) and: [self class decorateBrowserButtons])
		ifFalse: [^aButton offColor: Color transparent].

	"This table duplicates the old logic, but adds two new colors for the cases where there is a superclass definition, but this method doesn't call it."

	aButton offColor: self color! !

!CodeHolder methodsFor: 'controls' stamp: 'sw 1/25/2001 14:44'!
inheritanceButton
	"If receiver has an Inheritance button, answer it, else answer nil.  morphic only at this point"

	^ self buttonWithSelector: #methodHierarchy! !

!CodeHolder methodsFor: 'diffs' stamp: 'marcus.denker 9/20/2008 20:31'!
togglePrettyDiffing
	"Toggle whether pretty-diffing should be shown in the code pane"

	| wasShowingDiffs |
	self okToChange ifTrue:
		[wasShowingDiffs := self showingPrettyDiffs.
		self showPrettyDiffs: wasShowingDiffs not.
		self setContentsToForceRefetch.
		self contentsChanged]

! !

!CodeHolder methodsFor: 'what to show' stamp: 'sw 5/18/2001 19:43'!
showingPlainSource
	"Answer whether the receiver is showing plain source"

	^ contentsSymbol == #source! !

!CodeHolder methodsFor: 'self-updating' stamp: 'MarcusDenker 7/19/2014 09:19'!
wantsStepsIn: aWindow
	^ true! !

!CodeHolder methodsFor: 'contents' stamp: 'MarcusDenker 4/26/2013 15:26'!
contents
	"Answer the source code or documentation for the selected method"

	self showingByteCodes ifTrue:
		[^ self selectedBytecodes].

	^ self selectedMessage! !

!CodeHolder class methodsFor: 'defaults' stamp: 'AlainPlantec 1/7/2010 21:49'!
showAnnotationPane
	"Answer whether the receiver, seen in some browser window, 
	would like to have the so-called  annotationpane included.
	see also annotationRequests comment"

	^ ShowAnnotationPane ifNil: [ShowAnnotationPane := false]! !

!CodeHolder class methodsFor: 'annotationsreq' stamp: 'AlainPlantec 12/21/2009 22:20'!
annotationRequests
	"Answer a list of symbol characterizing all the available kinds of annotations; 
	Each symbol represents the info type:
		#timeStamp	: 
			The time stamp of the last submission of the method.
		#firstComment: 
			The first comment in the method, if any.
		#masterComment: 
			The comment at the beginning of the supermost implementor 
			of the method if any.
		#documentation: 
			Comment at beginning of the method or, if it has none, 
			comment at the beginning of a superclass's implementation of the method.
		#messageCategory: 
			Which method category the method lies in.
		#sendersCount: 
			A report of how many senders there of the message.
		#implementorsCount: 
			A report of how many implementors there are of the message.
		#recentChangeSet	: 
			The most recent change set bearing the method.
		#allChangeSets	: 
			A list of all change sets bearing the method.
		#priorVersionsCount: 
			A report of how many previous versions there are of the method.
		#priorTimeStamp: 
			The time stamp of the penultimate submission of the method, if any.
		"
	 ^ AnnotationRequests ifNil: [AnnotationRequests := self defaultAnnotationInfo]! !

!CodeHolder class methodsFor: 'defaults' stamp: 'AlainPlantec 12/1/2009 22:55'!
decorateBrowserButtons
	^ DecorateBrowserButtons ifNil: [DecorateBrowserButtons := false]! !

!CodeHolder class methodsFor: 'annotationsreq' stamp: 'AlainPlantec 12/21/2009 22:21'!
defaultAnnotationInfo
	"see annotationRequests comment"
	^ #(timeStamp messageCategory sendersCount implementorsCount allChangeSets)! !

!CodeHolder class methodsFor: 'defaults' stamp: 'AlainPlantec 11/24/2009 17:18'!
browseWithPrettyPrint
	^ BrowseWithPrettyPrint ifNil: [BrowseWithPrettyPrint := false]! !

!CodeImporter commentStamp: '<historical>'!
I'm an object in charge of import source files.  I know a format object that knows how to parse the files, and I import the parsed results into the image.

I handle doIts normally, but some special cases like class organization, class comment or methods are handled via a double dispatch (See my method extensions for that).

=-=-=- How to use me -=-=-=

If you want to fileIn the code -aka compile/evaluate it:

CodeImporter evaluateReadStream: '2+2!!' readStream.

or

CodeImporter evaluateString: '2+2!!'

or

CodeImporter evaluateFileNamed: 'something.st'

or

CodeImporter evaluateFileStream: (FileStream readOnlyFileNamed: 'something.st')

Now, you can also generate a model of code declarations inside a file by just creating an instance:

CodeImporter fileStream: (FileStream readOnlyFileNamed: 'something.st').

And then query me sending the message

#codeDeclarations

Instances of me can be created through 
#fromString:
#readStream:
#fileNamed:
#fileStream:!
!CodeImporter methodsFor: 'evaluating' stamp: 'GuillermoPolito 5/5/2012 01:12'!
flushChangesFile
	"Yes, we need to do this in order to flush the file, puaj"
	Smalltalk logChange: '----End fileIn----'.! !

!CodeImporter methodsFor: '*System-CommandLineHandler' stamp: 'CamilloBruni 3/23/2013 11:54'!
shebang
	readStream position: 0.
	(readStream next: 2) = '#!!'
		ifFalse: [ 
			readStream position: 0.
			^ self ].
	"here we found the shebang, so skip the first line"
	^ readStream nextLine.
	! !

!CodeImporter methodsFor: '*System-CommandLineHandler' stamp: 'CamilloBruni 3/23/2013 11:54'!
skipShebang
	"Skip the shebang sequnce #!! at the beginning of a bash file"
	readStream position = 0
		ifFalse: [  ^ self "#!! can only be skipped at the beginning" ].
	self shebang.
	! !

!CodeImporter methodsFor: 'fileHandling' stamp: 'GuillermoPolito 5/5/2012 01:38'!
selectTextConverterForCode
	self flag: #fix.  "This should not be here probably."
	
	"We need to see the first three bytes in order to see the origin of the file"
	readStream binary.
	((readStream next: 3) = #[ 16rEF 16rBB 16rBF ]) ifTrue: [
		readStream converter: UTF8TextConverter new
	] ifFalse: [
		readStream converter: MacRomanTextConverter new.
	].

	"we restore the position to the start of the file again"
	readStream position: 0.
	
	"We put the file in text mode for the file in"
	readStream text.! !

!CodeImporter methodsFor: 'initialization' stamp: 'GuillermoPolito 5/5/2012 17:06'!
initialize
	codeDeclarations := OrderedCollection new.
	parserClass := ChunkFileFormatParser.! !

!CodeImporter methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2013 16:13'!
requestor
	^ requestor! !

!CodeImporter methodsFor: '*System-CommandLineHandler' stamp: 'CamilloBruni 7/10/2013 16:16'!
evaluate
	" stripped down version of evaluateDeclarations"
	| value |
	self codeDeclarations do: [ :declaration |
		requestor ifNotNil: [
			requestor contents: declaration contents ].
		value := declaration importFor: requestor ].
	self flushChangesFile.
	
	^value! !

!CodeImporter methodsFor: 'accessing' stamp: 'GuillermoPolito 5/5/2012 16:12'!
codeDeclarations
	^codeDeclarations! !

!CodeImporter methodsFor: 'accessing' stamp: 'GuillermoPolito 5/5/2012 01:39'!
readStream: aReadStream
	readStream := aReadStream.! !

!CodeImporter methodsFor: 'evaluating' stamp: 'GuillermoPolito 5/5/2012 17:17'!
parseDeclarations
	codeDeclarations := (parserClass for: readStream) parseDeclarations.! !

!CodeImporter methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2013 16:13'!
requestor: anObject
	requestor := anObject! !

!CodeImporter methodsFor: 'evaluating' stamp: 'CamilloBruni 7/10/2013 18:44'!
evaluateDeclarations
	"Evaluates the declarations from the text in the file and answers the last result"

	| value |
	self parseDeclarations.
	self codeDeclarations do: [ :declaration |
		requestor ifNotNil: [
			requestor contents: declaration contents ].
		value := declaration importFor: requestor ].
	self flushChangesFile.
	^value! !

!CodeImporter methodsFor: 'accessing' stamp: 'CamilloBruni 7/17/2013 16:03'!
file: aFileStream
	self readStream: aFileStream.
	self selectTextConverterForCode.
	self requestor: (FileCompilerRequestor fileStream: aFileStream).! !

!CodeImporter class methodsFor: 'instance creation' stamp: 'GuillermoPolito 5/5/2012 17:23'!
fileNamed: aFileName
	^self file: (FileStream readOnlyFileNamed: aFileName).
! !

!CodeImporter class methodsFor: 'evaluating' stamp: 'GuillermoPolito 5/5/2012 17:23'!
evaluateFileStream: aFileStream
	^(self fileStream: aFileStream) evaluateDeclarations! !

!CodeImporter class methodsFor: 'instance creation' stamp: 'GuillermoPolito 5/5/2012 17:23'!
fileStream: aFileStream
	^self new
		file: aFileStream;
		yourself! !

!CodeImporter class methodsFor: 'evaluating' stamp: 'GuillermoPolito 5/5/2012 17:25'!
evaluateString: aString
	^(self fromString: aString) evaluateDeclarations! !

!CodeImporter class methodsFor: 'evaluating' stamp: 'GuillermoPolito 5/5/2012 17:23'!
evaluateFileNamed: aFileName
	^(self fileNamed: aFileName) evaluateDeclarations! !

!CodeImporter class methodsFor: 'instance creation' stamp: 'GuillermoPolito 5/5/2012 17:24'!
readStream: aReadStream
	^self new
		readStream: aReadStream;
		yourself! !

!CodeImporter class methodsFor: 'instance creation' stamp: 'GuillermoPolito 5/5/2012 17:25'!
fromString: aByteString 
	^self readStream: aByteString readStream! !

!CodeImporter class methodsFor: 'evaluating' stamp: 'GuillermoPolito 5/5/2012 17:25'!
evaluateReadStream: aReadStream
	^(self readStream: aReadStream) evaluateDeclarations! !

!CodeRewritingAcceptor commentStamp: '<historical>'!
I am an acceptor in the context of code rewriting using RBTreeRewriting!
!CodeRewritingAcceptor methodsFor: 'protocol' stamp: 'SeanDeNigris 3/2/2015 11:13'!
accept: aText notifying: aController
	| environment tree rule result |

	self model sourceTextArea update: #clearUserEdits.
	
	environment := self model browsedEnvironment.
	tree := self class compiler evaluate: aText.
	
	rule := RBTransformationRule new
		rewriteRule: tree;
		yourself.
	
	result := RBSmalllintChecker runRule: rule onEnvironment: environment.
	(ChangesBrowser changes: result builder changes) open ! !

!CodeSearchingAcceptor commentStamp: 'NicolaiHess 11/30/2014 22:28'!
I am an acceptor in the context of code searching, using RBParseTreeSearcher!
!CodeSearchingAcceptor methodsFor: 'protocol' stamp: 'NicolaiHess 11/30/2014 21:57'!
accept: aText notifying: aController
	| environment tree rule result |

	self model sourceTextArea update: #clearUserEdits.
	
	environment := self model browsedEnvironment.
	tree := self class compiler evaluate: aText.
	
	rule := CodeSearchingRule new
		matcher: tree;
		yourself.
	
	result := RBSmalllintChecker runRule: rule onEnvironment: environment.
	(MethodBrowser new methods: result result methods) openWithSpec ! !

!CodeSearchingRule commentStamp: 'NicolaiHess 11/30/2014 22:27'!
A CodeSearchingRule is rule using a RBParseTreeSearcher
for the search.

use #matcher: for setting the parse tree searcher.
!
!CodeSearchingRule methodsFor: 'accessing' stamp: 'NicolaiHess 11/30/2014 21:30'!
matcher: aRule

	matcher := aRule! !

!CodeSearchingRule methodsFor: 'accessing' stamp: 'NicolaiHess 11/30/2014 21:30'!
name

	^ 'Code Searching'! !

!CodeSimulationTests commentStamp: 'TorstenBergmann 2/5/2014 08:31'!
SUnit tests for code simulation!
!CodeSimulationTests methodsFor: 'tests' stamp: 'ToonVerwaest 6/7/2010 22:30'!
testHaltWithHaltHandler
	self runSimulated: [[self methodWithHalt] on: Halt do: [:err |]]  ! !

!CodeSimulationTests methodsFor: 'tests' stamp: 'dik 5/23/2010 18:00'!
methodWithError
	self error: 'my error'! !

!CodeSimulationTests methodsFor: 'tests' stamp: 'ToonVerwaest 6/7/2010 22:30'!
testTranscriptPrintingWithOpenedTranscriptExists
	self runSimulated: [self methodWithTranscript]  ! !

!CodeSimulationTests methodsFor: 'tests - primitives' stamp: 'ClementBera 5/27/2014 13:49'!
testErrorCodeNotFound
	| ctx result resultSimu |
	
	Smalltalk vm isRunningCog ifFalse: [^self].
	
	result := self veryBasicAt: 1.
		
	ctx := Context 
		sender: nil
		receiver: nil
		method: (Object>>#at: )
		arguments: #(10).
	
	resultSimu := ctx 
		push: nil;
		push: 500;
		doPrimitive: 117  method:  (self class>>#veryBasicAt:) receiver: self args: #(999).
		
	self assert: resultSimu isArray.	
	self assert: Context  primitiveFailToken first == resultSimu first.
	self assert: result = resultSimu second.! !

!CodeSimulationTests methodsFor: 'tests' stamp: 'ToonVerwaest 6/7/2010 22:30'!
testTranscriptPrinting
	self runSimulated: [self methodWithTranscript]  ! !

!CodeSimulationTests methodsFor: 'tests' stamp: 'dik 5/23/2010 17:58'!
methodWithHalt
	self halt! !

!CodeSimulationTests methodsFor: 'tests' stamp: 'ToonVerwaest 6/8/2010 00:35'!
testError
	self should: [ self runSimulated: [self methodWithError] ] raise: Error! !

!CodeSimulationTests methodsFor: 'tests' stamp: 'dik 5/23/2010 18:03'!
methodWithTranscript
	Transcript show: 'something'! !

!CodeSimulationTests methodsFor: 'tests' stamp: 'dik 5/23/2010 17:57'!
runSimulated: aBlock
	thisContext runSimulated: aBlock contextAtEachStep: [ :current |  ]! !

!CodeSimulationTests methodsFor: 'tests' stamp: 'ToonVerwaest 6/8/2010 00:35'!
testHalt
	self should: [ self runSimulated: [self methodWithHalt] ] raise: Halt! !

!CodeSimulationTests methodsFor: 'private' stamp: ''!
indexedBasicAt: index 
	<primitive: 60 error: code >
	^ code

! !

!CodeSimulationTests methodsFor: 'tests' stamp: 'ToonVerwaest 6/7/2010 22:30'!
testGoodSimulation
	self runSimulated: [ 1 + 2 ].! !

!CodeSimulationTests methodsFor: 'tests - primitives' stamp: 'ClementBera 5/27/2014 13:49'!
testErrorToken
	| token1 token2 |
	
	token1 := Context primitiveFailToken.
	token2 := Context primitiveFailTokenFor: 100.

	self assert: token1 first == token2 first.
	self assert: token1 second == nil.
	self assert: token2 second == 100.! !

!CodeSimulationTests methodsFor: 'tests - primitives' stamp: 'ClementBera 5/27/2014 13:49'!
testErrorCodeNotFoundIndexed
	| ctx result resultSimu |
	
	Smalltalk vm isRunningCog ifFalse: [^self].
	
	result := self indexedBasicAt: 100.
		
	ctx := Context 
		sender: nil
		receiver: nil
		method: (Object>>#at: )
		arguments: #(10).
	
	resultSimu := ctx 
		push: nil;
		push: 500;
		doPrimitive: 60  method:  (self class>>#indexedBasicAt:) receiver: self args: #(100).
		
	self assert: resultSimu isArray.	
	self assert: resultSimu size = 2.
	self assert: Context  primitiveFailToken first == resultSimu first.
	self assert: result = resultSimu second.! !

!CodeSimulationTests methodsFor: 'private' stamp: ''!
veryBasicAt: index 
	<primitive: 'dooo' module: 'bar' error: code>
	^ code
! !

!CodeSimulationTests methodsFor: 'tests' stamp: 'ToonVerwaest 6/7/2010 22:30'!
testErrorWithErrorHandler
	self runSimulated: [[self methodWithError] on: Error do: [:err | ]]  ! !

!CodeSimulationTests methodsFor: 'tests' stamp: 'ToonVerwaest 6/8/2010 00:39'!
testDNU

	self should: [ self runSimulated: [self absentMethod] ] raise: MessageNotUnderstood! !

!CollapsedMorph methodsFor: 'resize/collapse' stamp: 'sw 6/5/2001 22:55'!
wantsExpandBox
	"Answer whether I'd like an expand box"

	^ false! !

!CollapsedMorph methodsFor: 'resize/collapse' stamp: 'sw 9/1/2000 11:07'!
collapseOrExpand
	"Toggle the expand/collapsd state of the receiver.  If expanding, copy the window title back to the name of the expanded morph"

	| aWorld |
	isCollapsed
		ifTrue: 
			[uncollapsedMorph setProperty: #collapsedPosition toValue: self position.
			labelString ifNotNil: [uncollapsedMorph setNameTo: labelString].
			mustNotClose := false.	"We're not closing but expanding"
			self delete.
			(aWorld := self currentWorld) addMorphFront: uncollapsedMorph.
			aWorld startSteppingSubmorphsOf: uncollapsedMorph]
		ifFalse:
			[super collapseOrExpand]! !

!CollapsedMorph methodsFor: 'collapse/expand' stamp: 'sw 5/9/2000 00:18'!
beReplacementFor: aMorph

	| itsWorld priorPosition |
	(itsWorld := aMorph world) ifNil: [^self].
	uncollapsedMorph := aMorph.
			
	self setLabel: aMorph externalName.
	aMorph delete.
	itsWorld addMorphFront: self.
	self collapseOrExpand.
	(priorPosition := aMorph valueOfProperty: #collapsedPosition ifAbsent: [nil])
	ifNotNil:
		[self position: priorPosition].
! !

!CollapsedMorph methodsFor: 'menu' stamp: 'StephaneDucasse 10/27/2014 09:34'!
buildWindowMenu
	"Answer the menu to be put up in response to the user's clicking on the window-menu control in the window title.  Specialized for CollapsedMorphs."

	| aMenu |
	aMenu := UIManager default
					newMenuIn: self for: self.
	aMenu add: 'Change name...' selector: #relabel.
	aMenu addLine.
	aMenu add: 'Send to back' selector: #sendToBack.
	aMenu add: 'Make next-to-topmost' selector: #makeSecondTopmost.
	aMenu addLine.
	self mustNotClose
		ifFalse:
			[aMenu add: 'Make unclosable' selector: #makeUnclosable]
		ifTrue:
			[aMenu add: 'Make closable' translated selector: #makeClosable].
	aMenu
		add: (self isSticky ifTrue: ['Make draggable'] ifFalse: ['Make undraggable']) 
		selector: #toggleStickiness.
	^aMenu! !

!CollapsedMorph methodsFor: 'collapse/expand' stamp: 'sw 4/9/2001 14:23'!
uncollapseToHand
	"Hand the uncollapsedMorph to the user, placing it in her hand, after remembering appropriate state for possible future use"

	| nakedMorph |
	nakedMorph := uncollapsedMorph.
	uncollapsedMorph := nil.
	nakedMorph setProperty: #collapsedPosition toValue: self position.
	mustNotClose := false.  "so the delete will succeed"
	self delete.
	ActiveHand attachMorph: nakedMorph! !

!CollectVisitor commentStamp: 'cwp 11/18/2009 12:32'!
I am a visitor that collects objects from the nodes I visit. I take a block similar to those passed to Collection>>collect:. I evaluate the block with DirectoryEntries for the nodes I visit, and collect the objects answered into an array.

I can use any guide, and the objects in the array I produce will reflect the order imposed by the guide.!
!CollectVisitor methodsFor: 'visiting' stamp: 'cwp 11/16/2009 10:38'!
visitReference: anEntry
	out nextPut: (block value: anEntry)! !

!CollectVisitor class methodsFor: 'instance creation' stamp: 'cwp 11/16/2009 10:35'!
preorder: aReference
	^ self preorder: aReference collect: [:entry | entry]! !

!CollectVisitor class methodsFor: 'instance creation' stamp: 'cwp 11/16/2009 10:39'!
collect: aBlock
	^ self basicNew initializeWithBlock: aBlock! !

!CollectVisitor class methodsFor: 'instance creation' stamp: 'cwp 11/16/2009 10:36'!
postorder: aReference
	^ self postorder: aReference collect: [:entry | entry]! !

!CollectVisitor class methodsFor: 'instance creation' stamp: 'cwp 11/16/2009 10:32'!
breadthFirst: aReference collect: aBlock
	^ (self collect: aBlock) breadthFirst: aReference! !

!CollectVisitor class methodsFor: 'instance creation' stamp: 'cwp 11/16/2009 10:36'!
preorder: aReference collect: aBlock
	^ (self collect: aBlock) preorder: aReference! !

!CollectVisitor class methodsFor: 'instance creation' stamp: 'cwp 11/16/2009 10:35'!
postorder: aReference collect: aBlock
	^ (self collect: aBlock) postorder: aReference! !

!CollectVisitor class methodsFor: 'instance creation' stamp: 'cwp 11/16/2009 10:33'!
breadthFirst: aReference
	^ self breadthFirst: aReference collect: [:entry | entry]! !

!CollectVisitorTest commentStamp: 'TorstenBergmann 1/31/2014 11:41'!
SUnit tests for class CollectVisitor!
!CollectVisitorTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:40'!
testPostorder
	| entries |
	entries := CollectVisitor postorder: self root.
	self 
		assertEntries: entries
		are: #(
				'/alpha/beta/delta'
				'/alpha/beta/gamma'
				'/alpha/beta'
				'/alpha/epsilon/zeta'
				'/alpha/epsilon'
				'/alpha'
			)! !

!CollectVisitorTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:40'!
testBreadthFirst
	| entries |
	entries := CollectVisitor breadthFirst: self root.
	self 
		assertEntries: entries
		are: #(
				'/alpha'
				'/alpha/beta'
				'/alpha/epsilon'
				'/alpha/beta/delta'
				'/alpha/beta/gamma'
				'/alpha/epsilon/zeta'
			)! !

!CollectVisitorTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:40'!
testPreorder
	| entries |
	entries := CollectVisitor preorder: self root.
	self 
		assertEntries: entries
		are: #(
				'/alpha'
				'/alpha/beta'
				'/alpha/beta/delta'
				'/alpha/beta/gamma'
				'/alpha/epsilon'
				'/alpha/epsilon/zeta'
			)! !

!Collection commentStamp: '<historical>'!
I am the abstract superclass of all classes that represent a group of elements.!
!Collection methodsFor: '*metacello-core-scripting' stamp: 'dkh 9/5/2012 06:26:03.064'!
execute: projectSpecBlock against: aScriptExecutor
    aScriptExecutor executeCollection: self do: projectSpecBlock! !

!Collection methodsFor: 'enumerating' stamp: 'nice 1/5/2010 15:59'!
detectMin: aBlock
	"Evaluate aBlock with each of the receiver's elements as the argument. 
	Answer the element for which aBlock evaluates to the lowest number.
	If collection empty, return nil."

	| minElement minValue |
	self do: [:each | | val | 
		minValue == nil
			ifFalse: [
				(val := aBlock value: each) < minValue ifTrue: [
					minElement := each.
					minValue := val]]
			ifTrue: ["first element"
				minElement := each.
				minValue := aBlock value: each].
				"Note that there is no way to get the first element that works 
				for all kinds of Collections.  Must test every one."].
	^ minElement! !

!Collection methodsFor: 'enumerating' stamp: 'GabrielOmarCotelli 11/26/2013 17:15'!
detect: aBlock ifNone: exceptionBlock
	"Evaluate aBlock with each of the receiver's elements as the argument.  
	Answer the first element for which aBlock evaluates to true. If none  
	evaluate to true, then evaluate the argument, exceptionBlock."

	^ self detect: aBlock ifFound: [ :element | element ] ifNone: exceptionBlock! !

!Collection methodsFor: 'adding' stamp: 'sma 5/12/2000 17:21'!
add: newObject withOccurrences: anInteger
	"Add newObject anInteger times to the receiver. Answer newObject."

	anInteger timesRepeat: [self add: newObject].
	^ newObject! !

!Collection methodsFor: 'enumerating' stamp: 'CamilloBruni 3/22/2013 22:32'!
reject: aBlock 
	"Evaluate aBlock with each of the receiver's elements as the argument. 
	Collect into a new collection like the receiver only those elements for 
	which aBlock evaluates to false. Answer the new collection."

	^self select: [ :element | (aBlock value: element) == false ]! !

!Collection methodsFor: '*Collections-arithmetic-collectors' stamp: 'raok 10/22/2002 00:20'!
degreeCos
	^self collect: [:each | each degreeCos]! !

!Collection methodsFor: '*Collections-arithmetic' stamp: 'di 11/6/1998 13:54'!
\\ arg

	^ arg adaptToCollection: self andSend: #\\! !

!Collection methodsFor: 'testing' stamp: 'ls 3/27/2000 17:25'!
identityIncludes: anObject 
	"Answer whether anObject is one of the receiver's elements."

	self do: [:each | anObject == each ifTrue: [^true]].
	^false! !

!Collection methodsFor: 'math functions' stamp: 'TAG 11/6/1998 16:00'!
median
	^ self asSortedCollection median! !

!Collection methodsFor: '*Collections-arithmetic' stamp: 'di 11/6/1998 13:54'!
// arg

	^ arg adaptToCollection: self andSend: #//! !

!Collection methodsFor: '*Keymapping-KeyCombinations' stamp: 'GuillermoPolito 6/28/2013 13:02'!
asShortcut
	^ self asKeyCombination! !

!Collection methodsFor: 'private' stamp: ''!
emptyCheck

	self isEmpty ifTrue: [self errorEmptyCollection]! !

!Collection methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
loadRequiredForMetacelloMCVersion: aMetacelloMCVersion

	^aMetacelloMCVersion doLoadRequiredFromArray: self.! !

!Collection methodsFor: 'sorting' stamp: 'StephaneDucasse 3/28/2010 22:42'!
sorted: aSortBlockOrNil
	"Return a new sequenceable collection which contains the same elements as self but its 
elements are sorted by aSortBlockOrNil. The block should take two arguments and return true if 
the first element should preceed the second one. If aSortBlock is nil then <= is used for 
comparison."
	
	^self asArray sort: aSortBlockOrNil! !

!Collection methodsFor: 'testing' stamp: 'MarcusDenker 7/17/2013 13:15'!
isNotEmpty
	"Answer whether the receiver contains any elements."

	^ self isEmpty not! !

!Collection methodsFor: 'converting' stamp: 'sma 5/6/2000 20:22'!
asArray
	"Answer an Array whose elements are the elements of the receiver.
	Implementation note: Cannot use ''Array withAll: self'' as that only
	works for SequenceableCollections which support the replacement 
	primitive."

	| array index |
	array := Array new: self size.
	index := 0.
	self do: [:each | array at: (index := index + 1) put: each].
	^ array! !

!Collection methodsFor: 'enumerating' stamp: 'nice 1/5/2010 15:59'!
detectMax: aBlock
	"Evaluate aBlock with each of the receiver's elements as the argument. 
	Answer the element for which aBlock evaluates to the highest magnitude.
	If collection empty, return nil.  This method might also be called elect:."

	| maxElement maxValue |
	self do: [:each | | val | 
		maxValue == nil
			ifFalse: [
				(val := aBlock value: each) > maxValue ifTrue: [
					maxElement := each.
					maxValue := val]]
			ifTrue: ["first element"
				maxElement := each.
				maxValue := aBlock value: each].
				"Note that there is no way to get the first element that works 
				for all kinds of Collections.  Must test every one."].
	^ maxElement! !

!Collection methodsFor: 'math functions' stamp: 'MarcusDenker 8/15/2010 11:01'!
stdev
	| avg sample sum |
	avg := self average. 
	"see comment in self sum"
	sample := self anyOne.
	sum := self inject: sample into: [:accum :each | accum + (each - avg) squared].
	sum := sum - sample.
	^ (sum / (self size - 1)) sqrt! !

!Collection methodsFor: '*Collections-arithmetic-collectors' stamp: 'raok 10/22/2002 00:21'!
exp
	^self collect: [:each | each exp]! !

!Collection methodsFor: 'enumerating' stamp: 'sma 5/12/2000 11:52'!
count: aBlock 
	"Evaluate aBlock with each of the receiver's elements as the argument.  
	Answer the number of elements that answered true."

	| sum |
	sum := 0.
	self do: [:each | (aBlock value: each) ifTrue: [sum := sum + 1]].
	^ sum! !

!Collection methodsFor: 'enumerating' stamp: 'GabrielOmarCotelli 11/26/2013 16:53'!
detect: aBlock ifFound: foundBlock ifNone: exceptionBlock
	"Evaluate aBlock with each of the receiver's elements as the argument.  
	If some element evaluates aBlock to true, then cull this element into 
	foundBlock and answer the result of this evaluation. 
	If none evaluate to true, then evaluate exceptionBlock."

	self
		do: [ :each | 
			(aBlock value: each)
				ifTrue: [ ^ foundBlock cull: each ] ].
	^ exceptionBlock value	! !

!Collection methodsFor: 'converting' stamp: 'sma 5/6/2000 20:26'!
asCharacterSet
	"Answer a CharacterSet whose elements are the unique elements of the receiver.
	The reciever should only contain characters."

	^ CharacterSet newFrom: self! !

!Collection methodsFor: '*metacello-core' stamp: 'dkh 6/6/2009 10:08'!
setRequiresInMetacelloPackage: aMetacelloPackageSpec

	aMetacelloPackageSpec setRequires: self asArray.! !

!Collection methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 3/25/2015 09:08'!
gtInspectorItemsIn: composite
	<gtInspectorPresentationOrder: 0>  
	^ (composite list)
		title: 'Items';
		display: [ :aCollection | self ];
		beMultiple;
		withSmalltalkSearch;		
		format: [ :each | GTObjectPrinter new asTruncatedTextFrom: each ];
		send: [ :result | (result notNil and: [result size = 1]) 
				ifTrue: [result anyOne] 
				ifFalse: [self species withAll: result]];
		showOnly: 50;
		helpMessage: 'Quick selection field. Given your INPUT, it executes: self select: [:each | INPUT ]'.! !

!Collection methodsFor: 'private' stamp: 'SvenVanCaekenberghe 4/18/2011 14:59'!
errorEmptyCollection
	"Signal a CollectionIsEmpty exception"

	CollectionIsEmpty signalWith: self! !

!Collection methodsFor: 'private' stamp: 'MarcusDenker 9/29/2014 15:11'!
errorSizeMismatch
	"Signal a SizeMismatch exception"

	SizeMismatch signal! !

!Collection methodsFor: 'adapting' stamp: 'di 11/9/1998 12:16'!
adaptToNumber: rcvr andSend: selector
	"If I am involved in arithmetic with a scalar, return a Collection of
	the results of each element combined with the scalar in that expression."

	^ self collect: [:element | rcvr perform: selector with: element]! !

!Collection methodsFor: 'printing' stamp: 'fbs 1/14/2005 10:54'!
printOn: aStream delimiter: delimString last: lastDelimString
	"Print elements on a stream separated
	with a delimiter between all the elements and with
	a special one before the last like: 'a, b and c'

	Note: Feel free to improve the code to detect the last element."

	| n sz |
	n := 1.
	sz := self size.
	self do: [:elem |
		n := n + 1.
		aStream print: elem]
	separatedBy: [
		n = sz
			ifTrue: [aStream print: lastDelimString]
			ifFalse: [aStream print: delimString]]! !

!Collection methodsFor: '*metacello-core' stamp: 'dkh 9/23/2009 08:46'!
setIncludesInMetacelloPackage: aMetacelloPackageSpec

	aMetacelloPackageSpec setIncludes: self asArray.! !

!Collection methodsFor: 'enumerating' stamp: 'StephaneDucasse 5/20/2012 18:50'!
piecesCutWhere: binaryBlock do: pieceBlock
	"Evaluate pieceBlock with substrings of the receiver derived from cutting the receiver at points where binaryBlock answers true for adjacent elements."

	| size lastCut this next |
	(size := self size) <= 1 ifTrue:
		 [size = 1 ifTrue: [pieceBlock value: self].
		^self].
	lastCut := 1.
	this := self at: 1.
	2 to: size do:
		[:i|
		next := self at: i.
		(binaryBlock value: this value: next) ifTrue:
			[pieceBlock value: (self copyFrom: lastCut to: i - 1).
			lastCut := i].
		this := next].
	pieceBlock value: (self copyFrom: lastCut to: size)! !

!Collection methodsFor: 'testing' stamp: 'ar 8/17/1999 19:43'!
isCollection
	"Return true if the receiver is some sort of Collection and responds to basic collection messages such as #size and #do:"
	^true! !

!Collection methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
addToMetacelloRepositories: aMetacelloRepositoriesSpec

	self do: [:each | each addToMetacelloRepositories: aMetacelloRepositoriesSpec ]
! !

!Collection methodsFor: 'printing' stamp: 'gk 1/14/2005 08:20'!
asCommaStringAnd
	"Return collection printed as 'a, b and c' "

	^String streamContents: [:s | self asStringOn: s delimiter: ', ' last: ' and ']
		! !

!Collection methodsFor: 'adapting' stamp: 'di 11/6/1998 13:37'!
adaptToString: rcvr andSend: selector
	"If I am involved in arithmetic with a String, convert it to a Number."
	^ rcvr asNumber perform: selector with: self! !

!Collection methodsFor: '*Collections-arithmetic-collectors' stamp: 'raok 10/22/2002 00:23'!
sign
	^self collect: [:each | each sign]! !

!Collection methodsFor: 'enumerating' stamp: 'SebastianTleye 6/25/2013 18:41'!
flattened
	
	"Flattens a collection of collections (no matter how many levels of collections exist).
	Strings are considered atoms and, as such, won't be flattened
	
	Examples:
	#(1 #(2 3) #(4 (#5))) flattened returns #(1 2 3 4 5) 
	#('string1' #('string2' 'string3')) flattened returns #('string1' 'string2' 'string3')"
	
	^ Array streamContents: [ :stream | self flattenOn: stream].! !

!Collection methodsFor: 'testing' stamp: 'StephaneDucasse 7/3/2010 22:15'!
ifEmpty: aBlock
	"Evaluate the given block with the receiver as argument, answering its value if the receiver is empty, otherwise answer the receiver."
	
	"Note that the fact that this method returns its argument in case the receiver is not empty allows one to write expressions like the following ones: self classifyMethodAs: (myProtocol ifEmpty: ['As yet unclassified'])"

	^ self isEmpty 
		ifTrue: [ ^aBlock value ]
		ifFalse: [ self ]! !

!Collection methodsFor: 'enumerating' stamp: 'nice 12/9/2009 15:37'!
findFirstInByteString: aByteString startingAt: start
	"Find the index of first character starting at start in aByteString that is included in the receiver.
	Default is to use a naive algorithm.
	Subclasses might want to implement a more efficient scheme"

	start to: aByteString size do:
		[:index |
		(self includes: (aByteString at: index)) ifTrue: [^ index]].
	^ 0! !

!Collection methodsFor: '*Collections-arithmetic' stamp: 'di 11/6/1998 13:53'!
+ arg

	^ arg adaptToCollection: self andSend: #+! !

!Collection methodsFor: '*Collections-arithmetic-collectors' stamp: 'raok 10/22/2002 00:22'!
tan
	^self collect: [:each | each tan]! !

!Collection methodsFor: 'enumerating' stamp: 'StephaneDucasse 1/3/2010 20:15'!
groupBy: keyBlock having: selectBlock 
	"This message is deprecated. Please use groupedBy:having:. 
	But we let it right now without warning because we are not sure to 
	remove in the next iteration."

	^ self groupedBy: keyBlock having: selectBlock ! !

!Collection methodsFor: 'enumerating' stamp: 'jannik.laval 8/27/2010 15:54'!
flatCollect: aBlock as: aCollectionClass
	"Evaluate aBlock for each of the receiver's elements and answer the
	list of all resulting values flatten one level. Assumes that aBlock returns some kind
	of collection for each element. Equivalent to the lisp's mapcan"
	
	| col |
	self isEmpty ifTrue: [^self copy ].
	col := aCollectionClass new: self size. 	
	self do: [ :each |
		col addAll: (aBlock value: each) ].
	^col! !

!Collection methodsFor: '*Fuel' stamp: 'MartinDias 5/19/2011 23:41'!
addIfNotPresent: anObject ifPresentDo: aBlock
	"Include anObject as one of the receiver's elements and then value aBlock, but only if there
	is no such element already. Anwser anObject."

	(self includes: anObject) 
		ifFalse: [ self add: anObject ]
		ifTrue: [ aBlock value ].
	^ anObject! !

!Collection methodsFor: '*Collections-arithmetic' stamp: 'TAG 11/6/1998 16:02'!
sum
	"This is implemented using a variant of the normal inject:into: pattern. 
	The reason for this is that it is not known whether we're in the normal 
	number line, i.e. whether 0 is a good initial value for the sum. 
	Consider a collection of measurement objects, 0 would be the unitless 
	value and would not be appropriate to add with the unit-ed objects."
	| sum sample |
	sample := self anyOne.
	sum := self inject: sample into: [:accum :each | accum + each].
	^ sum - sample! !

!Collection methodsFor: 'converting' stamp: 'MarcusDenker 11/28/2009 11:40'!
asDictionary

	^ self as: Dictionary! !

!Collection methodsFor: 'adapting' stamp: 'di 11/6/1998 13:37'!
adaptToPoint: rcvr andSend: selector
	"If I am involved in arithmetic with a scalar, return a Collection of
	the results of each element combined with the scalar in that expression."

	^ self collect: [:element | rcvr perform: selector with: element]! !

!Collection methodsFor: '*Collections-arithmetic-collectors' stamp: 'nk 12/30/2003 15:47'!
roundTo: quantum
	^self collect: [ :ea | ea roundTo: quantum ]! !

!Collection methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 4/8/2015 09:50'!
gtDisplayOn: s
	self printNameOn: s.
	s 
		space;
		nextPut: $[;
		nextPutAll: self size asString;
		nextPutAll: (self size = 1 ifTrue: [' item'] ifFalse: [ ' items' ]);
		nextPut: $];
		space.
	s 
		nextPutAll: 
			((String streamContents: [ :stream | self printElementsOn: stream ]) truncateWithElipsisTo: 42)! !

!Collection methodsFor: 'printing' stamp: 'gk 1/14/2005 08:19'!
asCommaString
	"Return collection printed as 'a, b, c' "

	^String streamContents: [:s | self asStringOn: s delimiter: ', ']
		! !

!Collection methodsFor: 'accessing' stamp: 'sma 5/12/2000 11:34'!
size
	"Answer how many elements the receiver contains."

	| tally |
	tally := 0.
	self do: [:each | tally := tally + 1].
	^ tally! !

!Collection methodsFor: 'private' stamp: 'yo 6/29/2004 13:14'!
errorNotKeyed

	self error: ('Instances of {1} do not respond to keyed accessing messages.' translated format: {self class name})
! !

!Collection methodsFor: '*Collections-arithmetic-collectors' stamp: 'raok 10/22/2002 00:21'!
degreeSin
	^self collect: [:each | each degreeSin]! !

!Collection methodsFor: '*Collections-arithmetic' stamp: 'TAG 11/6/1998 16:00'!
min
	^ self inject: self anyOne into: [:min :each | min min: each]! !

!Collection methodsFor: 'printing' stamp: 'gk 1/14/2005 08:27'!
asStringOn: aStream delimiter: delimString
	"Print elements on a stream separated
	with a delimiter String like: 'a, b, c'
	Uses #asString instead of #print:."

	self do: [:elem | aStream nextPutAll: elem asString]
		separatedBy: [aStream nextPutAll: delimString]! !

!Collection methodsFor: 'testing' stamp: 'sma 5/12/2000 14:07'!
includes: anObject 
	"Answer whether anObject is one of the receiver's elements."

	^ self anySatisfy: [:each | each = anObject]! !

!Collection methodsFor: '*Collections-arithmetic' stamp: 'raok 10/22/2002 00:17'!
raisedTo: arg

	^ arg adaptToCollection: self andSend: #raisedTo:! !

!Collection methodsFor: 'testing' stamp: 'StephaneDucasse 7/3/2010 22:10'!
ifNotEmpty: aBlock
	"Evaluate the given block with the receiver as argument, answering its value
      unless the receiver is empty, in which case answer the receiver

      If the block has an argument, eval with the receiver as its argument,
      but it might be better to use ifNotEmptyDo: to make the code easier to
      understand"
	"Note that the fact that this method returns its argument in case the receiver is empty
	allows one to write expressions like the following ones:
		self classifyMethodAs: (myProtocol ifEmpty: ['As yet unclassified']"
	
    ^self isEmpty
          ifTrue: [self]
          ifFalse: [aBlock cull: self]
! !

!Collection methodsFor: 'private' stamp: 'ul 11/21/2009 01:14'!
fillFrom: aCollection with: aBlock
	"Evaluate aBlock with each of aCollections's elements as the argument.  
	Collect the resulting values into self. Answer self."

	aCollection do: [ :each |
		self add: (aBlock value: each) ]! !

!Collection methodsFor: 'converting' stamp: 'sma 5/6/2000 20:29'!
asSet
	"Answer a Set whose elements are the unique elements of the receiver."

	^ Set withAll: self! !

!Collection methodsFor: '*metacello-core' stamp: 'dkh 9/8/2012 05:30'!
asMetacelloAttributePath
    ^ MetacelloMethodSectionPath withAll: self! !

!Collection methodsFor: 'testing' stamp: 'ClementBera 12/2/2013 12:41'!
includesAllOf: aCollection 

	self flag: 'use includesAll: instead'.
	
	^ self includesAll: aCollection.! !

!Collection methodsFor: 'enumerating' stamp: 'StephaneDucasse 2/1/2011 07:34'!
fold: binaryBlock
	"Evaluate the block with the first two elements of the receiver,
	then with the result of the first evaluation and the next element,
	and so on.  Answer the result of the final evaluation. If the receiver
	is empty, raise an error. If the receiver has a single element, answer
	that element."
	"#('if' 'it' 'is' 'to' 'be' 'it' 'is' 'up' 'to' 'me') fold: [:a :b | a, ' ', b]"

	^self reduce: binaryBlock! !

!Collection methodsFor: 'enumerating' stamp: 'sma 5/12/2000 11:59'!
do: aBlock without: anItem 
	"Enumerate all elements in the receiver. 
	Execute aBlock for those elements that are not equal to the given item"

	^ self do: [:each | anItem = each ifFalse: [aBlock value: each]]! !

!Collection methodsFor: 'converting' stamp: 'StephaneDucasse 3/28/2010 22:41'!
asSortedCollection: aSortBlock 
	"Answer a SortedCollection whose elements are the elements of the receiver. The sort order is defined by the argument, aSortBlock. Note that this is better to use #sorted: if you don't really need a SortedCollection, but a sorted collection!!!!"

	| aSortedCollection |
	aSortedCollection := SortedCollection new: self size.
	aSortedCollection sortBlock: aSortBlock.
	aSortedCollection addAll: self.
	^ aSortedCollection! !

!Collection methodsFor: 'removing' stamp: 'sma 5/12/2000 11:19'!
removeAllSuchThat: aBlock 
	"Evaluate aBlock for each element and remove all that elements from
	the receiver for that aBlock evaluates to true.  Use a copy to enumerate 
	collections whose order changes when an element is removed (i.e. Sets)."

	self copy do: [:each | (aBlock value: each) ifTrue: [self remove: each]]! !

!Collection methodsFor: 'adapting' stamp: 'ClementBera 9/30/2013 10:59'!
adaptToCollection: rcvr andSend: selector
	"If I am involved in arithmetic with another Collection, return a Collection of
	the results of each element combined with the scalar in that expression."

	(rcvr isSequenceable and: [ self isSequenceable ]) ifFalse:
		[self error: 'Only sequenceable collections may be combined arithmetically'].
	^ rcvr with: self collect:
		[:rcvrElement :myElement | rcvrElement perform: selector with: myElement]! !

!Collection methodsFor: '*Collections-arithmetic-collectors' stamp: 'TAG 11/6/1998 15:51'!
ceiling
	^ self collect: [:a | a ceiling]! !

!Collection methodsFor: 'accessing' stamp: 'nice 4/19/2011 00:26'!
atRandom: aGenerator
	"Answer a random element of the receiver. Uses aGenerator which
    should be kept by the user in a variable and used every time. Use
    this instead of #atRandom for better uniformity of random numbers because 
	only you use the generator. Causes an error if self has no elements."
	| rand index |

	self emptyCheck.
	rand := aGenerator nextInt: self size.
	index := 1.
	self do: [:each |
		index = rand ifTrue: [^each].
		index := index + 1].
	^ self errorEmptyCollection
! !

!Collection methodsFor: 'copying' stamp: 'sma 5/12/2000 18:08'!
copyWithoutAll: aCollection
	"Answer a copy of the receiver that does not contain any elements 
	equal to those in aCollection."

	^ self reject: [:each | aCollection includes: each]! !

!Collection methodsFor: '*GT-Spotter' stamp: 'StefanReichhart 3/20/2015 16:15'!
gtIterator
	^ [ :filter | self do: filter ] gtIterator! !

!Collection methodsFor: '*metacello-core' stamp: 'dkh 6/6/2009 11:42'!
removeFromMetacelloPackages: aMetacelloPackagesSpec

	self do: [:each | each removeFromMetacelloPackages: aMetacelloPackagesSpec ]
! !

!Collection methodsFor: 'adding' stamp: 'sma 5/12/2000 17:23'!
addIfNotPresent: anObject
	"Include anObject as one of the receiver's elements, but only if there
	is no such element already. Anwser anObject."

	(self includes: anObject) ifFalse: [self add: anObject].
	^ anObject! !

!Collection methodsFor: '*Collections-arithmetic-collectors' stamp: 'TAG 11/6/1998 15:51'!
abs
	"Absolute value of all elements in the collection"
	^ self collect: [:a | a abs]! !

!Collection methodsFor: 'printing' stamp: 'gk 1/14/2005 08:01'!
printOn: aStream delimiter: delimString
	"Print elements on a stream separated
	with a delimiter String like: 'a, b, c' "

	self do: [:elem | aStream print: elem] separatedBy: [aStream print: delimString]
		! !

!Collection methodsFor: '*Collections-arithmetic-collectors' stamp: 'raok 10/22/2002 00:20'!
arcTan
	^self collect: [:each | each arcTan]! !

!Collection methodsFor: '*Collections-arithmetic-collectors' stamp: 'raok 10/22/2002 00:22'!
sin
	^self collect: [:each | each sin]! !

!Collection methodsFor: 'printing' stamp: 'sma 6/1/2000 09:41'!
printNameOn: aStream
	super printOn: aStream! !

!Collection methodsFor: '*Collections-arithmetic-collectors' stamp: 'TAG 11/6/1998 15:53'!
squared
	^ self collect: [:each | each * each]! !

!Collection methodsFor: 'enumerating' stamp: 'GabrielOmarCotelli 11/26/2013 16:53'!
detect: aBlock ifFound: foundBlock
	"Evaluate aBlock with each of the receiver's elements as the argument.  
	If some element evaluates aBlock to true, then cull this element into 
	foundBlock. 
	If no element matches the criteria then do nothing.
	Always returns self to avoid misuse and a potential isNil check on the sender."

	self
		detect: aBlock
		ifFound: foundBlock
		ifNone: [ 
			"Do nothing on purpose"
			 ]! !

!Collection methodsFor: 'copying' stamp: 'al 12/12/2003 14:31'!
, aCollection
	^self copy addAll: aCollection; yourself! !

!Collection methodsFor: 'enumerating' stamp: 'sma 5/12/2000 11:45'!
collect: aBlock 
	"Evaluate aBlock with each of the receiver's elements as the argument.  
	Collect the resulting values into a collection like the receiver. Answer  
	the new collection."

	| newCollection |
	newCollection := self species new.
	self do: [:each | newCollection add: (aBlock value: each)].
	^ newCollection! !

!Collection methodsFor: 'testing' stamp: 'ul 11/11/2009 16:25'!
ifNotEmptyDo: notEmptyBlock ifEmpty: emptyBlock
	"Evaluate emptyBlock if I'm empty, notEmptyBlock otherwise
	Evaluate the notEmptyBlock with the receiver as its argument"

	self isEmpty ifFalse: [ ^notEmptyBlock value: self ].
	^emptyBlock value! !

!Collection methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
resolvePackageSpecsNamedForMetacelloMCVersion: aMetacelloMCVersion visited: visited ifAbsent: aBlock
    ^ aMetacelloMCVersion
        allPackagesForSpecs: (self collect: [ :ea | aMetacelloMCVersion packageNamed: ea ifAbsent: aBlock ])
        visited: visited! !

!Collection methodsFor: '*Collections-arithmetic' stamp: 'di 11/6/1998 13:53'!
/ arg

	^ arg adaptToCollection: self andSend: #/! !

!Collection methodsFor: 'enumerating' stamp: 'sma 5/12/2000 11:20'!
detect: aBlock 
	"Evaluate aBlock with each of the receiver's elements as the argument. 
	Answer the first element for which aBlock evaluates to true."

	^ self detect: aBlock ifNone: [self errorNotFound: aBlock]! !

!Collection methodsFor: 'filter streaming' stamp: 'sma 5/12/2000 12:07'!
write: anObject 
	^ self add: anObject! !

!Collection methodsFor: 'copying' stamp: 'sma 5/12/2000 14:43'!
copyWithout: oldElement 
	"Answer a copy of the receiver that does not contain any
	elements equal to oldElement."

	^ self reject: [:each | each = oldElement]

"Examples:
	'fred the bear' copyWithout: $e
	#(2 3 4 5 5 6) copyWithout: 5
"! !

!Collection methodsFor: '*Collections-arithmetic-collectors' stamp: 'raok 10/22/2002 00:20'!
arcCos
	^self collect: [:each | each arcCos]! !

!Collection methodsFor: 'enumerating' stamp: 'TudorGirba 3/20/2012 09:06'!
union: aCollection
	"Answer the set theoretic union of two collections."
	
	| set |
	
	set := self asSet addAll: aCollection; yourself.
	
	^ self species withAll: set asArray! !

!Collection methodsFor: '*Collections-arithmetic-collectors' stamp: 'TAG 11/6/1998 15:51'!
floor
	^ self collect: [:a | a floor]! !

!Collection methodsFor: '*Collections-arithmetic' stamp: 'di 11/6/1998 13:53'!
- arg

	^ arg adaptToCollection: self andSend: #-! !

!Collection methodsFor: 'adding' stamp: ''!
add: newObject 
	"Include newObject as one of the receiver's elements. Answer newObject. 
	ArrayedCollections cannot respond to this message."

	self subclassResponsibility! !

!Collection methodsFor: 'removing' stamp: 'nice 1/10/2009 00:01'!
removeAll: aCollection 
	"Remove each element of aCollection from the receiver. If successful for 
	each, answer aCollection. Otherwise create an error notification.
	ArrayedCollections cannot respond to this message."

	aCollection == self ifTrue: [^self removeAll].
	aCollection do: [:each | self remove: each].
	^ aCollection! !

!Collection methodsFor: 'private' stamp: 'SvenVanCaekenberghe 4/18/2011 14:37'!
errorNotFound: anObject
	"Raise a NotFound exception."

	NotFound signalFor: anObject! !

!Collection methodsFor: 'enumerating' stamp: 'sma 4/30/2000 11:17'!
anySatisfy: aBlock
	"Evaluate aBlock with the elements of the receiver.
	If aBlock returns true for any element return true.
	Otherwise return false."

	self do: [:each | (aBlock value: each) ifTrue: [^ true]].
	^ false! !

!Collection methodsFor: '*Morphic-Base-Basic' stamp: 'CamilloBruni 10/21/2012 23:39'!
asDraggableMorph
	^ (String streamContents: [ :s| 
		self 
			do: [ :each | s print: each ]
			separatedBy: [ s space ]]) asStringMorph! !

!Collection methodsFor: 'copying' stamp: 'sma 5/12/2000 14:41'!
copyWith: newElement
	"Answer a new collection with newElement added (as last
	element if sequenceable)."

	^ self copy
		add: newElement;
		yourself! !

!Collection methodsFor: 'printing' stamp: 'gk 1/14/2005 08:27'!
asStringOn: aStream delimiter: delimString last: lastDelimString
	"Print elements on a stream separated
	with a delimiter between all the elements and with
	a special one before the last like: 'a, b and c'.
	Uses #asString instead of #print:

	Note: Feel free to improve the code to detect the last element."

	| n sz |
	n := 1.
	sz := self size.
	self do: [:elem |
		n := n + 1.
		aStream nextPutAll: elem asString]
	separatedBy: [
		aStream nextPutAll: (n = sz ifTrue: [lastDelimString] ifFalse: [delimString])]! !

!Collection methodsFor: 'enumerating' stamp: 'ST 6/23/2013 11:33'!
gather: aBlock
	"This method is kept for compatibility reasons, use flatCollect instead."
	^ self flatCollect: aBlock.! !

!Collection methodsFor: 'enumerating' stamp: 'CamilloBruni 9/7/2011 19:24'!
\ aCollection
	^ self difference: aCollection! !

!Collection methodsFor: '*Collections-arithmetic' stamp: 'TAG 11/6/1998 15:57'!
average
	^ self sum / self size! !

!Collection methodsFor: 'enumerating' stamp: 'AdrianKuhn 12/30/2009 09:36'!
groupedBy: aBlock
	"Answer a dictionary whose keys are the result of evaluating aBlock
	for all my elements, and the value for each key is the selection of 
	my elements that evaluated to that key. Uses species."
	| groups |
	groups := PluggableDictionary integerDictionary.
	self do: [ :each |
		(groups at: (aBlock value: each) ifAbsentPut: [ OrderedCollection new ]) add: each ].
	self species ~~ OrderedCollection ifTrue: [
		groups associationsDo: [ :association |
			association value: (self species withAll: association value) ]].
	^ groups
! !

!Collection methodsFor: 'enumerating' stamp: ''!
do: aBlock 
	"Evaluate aBlock with each of the receiver's elements as the argument."

	self subclassResponsibility! !

!Collection methodsFor: '*metacello-core' stamp: 'dkh 9/7/2012 13:10'!
asMetacelloAttributeList
    ^ self! !

!Collection methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
mergeIntoMetacelloRepositories: aMetacelloRepositoriesSpec

	self do: [:each | each mergeIntoMetacelloRepositories: aMetacelloRepositoriesSpec ]
! !

!Collection methodsFor: 'testing' stamp: 'HenrikSperreJohansen 6/28/2010 12:13'!
ifEmpty: emptyBlock ifNotEmpty: notEmptyBlock
	"Evaluate emptyBlock if I'm empty, notEmptyBlock otherwise"
	" If the notEmptyBlock has an argument, eval with the receiver as its argument"

	self isEmpty ifTrue: [ ^emptyBlock value ].
	^notEmptyBlock cull: self! !

!Collection methodsFor: 'filter streaming' stamp: 'sma 5/12/2000 12:07'!
contents
	^ self! !

!Collection methodsFor: 'converting' stamp: 'sma 5/12/2000 17:43'!
asOrderedCollection
	"Answer an OrderedCollection whose elements are the elements of the
	receiver. The order in which elements are added depends on the order
	in which the receiver enumerates its elements. In the case of unordered
	collections, the ordering is not necessarily the same for multiple 
	requests for the conversion."

	^ self as: OrderedCollection! !

!Collection methodsFor: 'testing' stamp: 'CamilloBruni 9/8/2011 14:18'!
includesAll: aCollection 
	"Answer whether all the elements of aCollection are in the receiver."
	aCollection do: [:elem | (self includes: elem) ifFalse: [^ false]].
	^ true! !

!Collection methodsFor: 'enumerating' stamp: 'StephaneDucasse 3/14/2014 20:54'!
difference: aCollection
	"Answer the set theoretic difference of two collections."

	"#(a b c d e f) difference:  #(a b z k)
	=> #(#f #d #e #c)
	
	#(a b z k) difference: #(a b c d e f) 
	=> #(#k #z) 
	"

	| set |
	set := self asSet.
	aCollection do: [ :each | set remove: each ifAbsent: [  ] ].
	^ self species withAll: set asArray! !

!Collection methodsFor: 'enumerating' stamp: 'CamilloBruni 3/23/2013 10:46'!
reject: rejectBlock thenDo: doBlock 
	"Utility method to improve readability."
	(self reject: rejectBlock) do: doBlock! !

!Collection methodsFor: 'testing' stamp: 'ul 11/11/2009 16:24'!
ifEmpty: emptyBlock ifNotEmptyDo: notEmptyBlock
	"Evaluate emptyBlock if I'm empty, notEmptyBlock otherwise"
	"Evaluate the notEmptyBlock with the receiver as its argument"

	self isEmpty ifTrue: [ ^emptyBlock value ].
	^notEmptyBlock value: self! !

!Collection methodsFor: 'accessing' stamp: 'sma 5/12/2000 11:41'!
capacity
	"Answer the current capacity of the receiver."

	^ self size! !

!Collection methodsFor: 'accessing' stamp: 'sd 11/4/2003 22:05'!
atRandom
	"Answer a random element of the receiver.  Uses a shared random 
	number generator owned by class Collection.  If you use this a lot, 
	define your own instance of Random and use #atRandom:.  Causes 
	an error if self has no elements."

	^ self class mutexForPicking critical: [
		self atRandom: self class randomForPicking ]

"Examples:
	#('one' 'or' 'the' 'other') atRandom
	(1 to: 10) atRandom
	'Just pick one of these letters at random' atRandom
	#(3 7 4 9 21) asSet atRandom		(just to show it also works for Sets)
"! !

!Collection methodsFor: '*Collections-arithmetic-collectors' stamp: 'TAG 11/6/1998 15:52'!
negated
	"Negated value of all elements in the collection"
	^ self collect: [:a | a negated]! !

!Collection methodsFor: 'enumerating' stamp: 'CamilloBruni 3/22/2013 22:09'!
reject: rejectBlock thenCollect: collectBlock
	"Utility method to improve readability."

	^ (self reject: rejectBlock) collect: collectBlock! !

!Collection methodsFor: 'copying' stamp: 'ar 2/11/2001 01:55'!
copyWithDependent: newElement
	"Answer a new collection with newElement added (as last
	element if sequenceable)."
	^self copyWith: newElement! !

!Collection methodsFor: 'converting' stamp: 'ar 9/22/2000 10:12'!
asIdentitySet
	^(IdentitySet new: self size) addAll: self; yourself! !

!Collection methodsFor: 'enumerating' stamp: 'CamilloBruni 3/22/2013 22:30'!
collect: collectBlock thenReject: selectBlock
	"Utility method to improve readability."

	^ (self collect: collectBlock) reject: selectBlock! !

!Collection methodsFor: 'enumerating' stamp: 'TudorGirba 11/3/2013 12:12'!
flatCollect: aBlock 
	"Evaluate aBlock for each of the receiver's elements and answer the
	list of all resulting values flatten one level. Assumes that aBlock returns some kind
	of collection for each element. Equivalent to the lisp's mapcan"
	
	| stream |
	self isEmpty ifTrue: [ ^ self copy ].
	stream := (self species new: 0) writeStream.
	self do: [ :each | stream nextPutAll: (aBlock value: each) ].
	^ stream contents! !

!Collection methodsFor: 'enumerating' stamp: 'AdrianKuhn 12/30/2009 09:37'!
groupedBy: aBlock having: aSelectionBlock
	"Like in SQL operation - Split the recievers contents into collections of 
	elements for which keyBlock returns the same results, and return those 
	collections allowed by selectBlock."
	^ (self groupedBy: aBlock) select: aSelectionBlock
! !

!Collection methodsFor: 'converting' stamp: 'sma 5/6/2000 20:22'!
asByteArray
	"Answer a ByteArray whose elements are the elements of the receiver.
	Implementation note: Cannot use ''ByteArray withAll: self'' as that only
	works for SequenceableCollections which support the replacement 
	primitive."

	| array index |
	array := ByteArray new: self size.
	index := 0.
	self do: [:each | array at: (index := index + 1) put: each].
	^ array! !

!Collection methodsFor: 'testing' stamp: ''!
contains: aBlock
	"VW compatibility"
	^self anySatisfy: aBlock! !

!Collection methodsFor: 'testing' stamp: ''!
occurrencesOf: anObject 
	"Answer how many of the receiver's elements are equal to anObject."

	| tally |
	tally := 0.
	self do: [:each | anObject = each ifTrue: [tally := tally + 1]].
	^tally! !

!Collection methodsFor: '*GT-Inspector' stamp: 'TudorGirba 6/28/2014 22:19'!
gtInspectorInterestingObject
	^ self size = 1
		ifTrue: [ self anyOne ]
		ifFalse: [ self ]! !

!Collection methodsFor: 'printing' stamp: 'sma 6/1/2000 09:41'!
printOn: aStream 
	"Append a sequence of characters that identify the receiver to aStream."

	self printNameOn: aStream.
	self printElementsOn: aStream! !

!Collection methodsFor: 'private' stamp: ''!
toBraceStack: itsSize 
	"Push receiver's elements onto the stack of thisContext sender.  Error if receiver does
	 not have itsSize elements or if receiver is unordered.
	 Do not call directly: this is called by {a. b} := ... constructs."

	self size ~= itsSize ifTrue:
		[self error: 'Trying to store ', self size printString,
					' values into ', itsSize printString, ' variables.'].
	thisContext sender push: itsSize fromIndexable: self! !

!Collection methodsFor: 'enumerating' stamp: 'hfm 2/12/2009 13:38'!
select: selectBlock thenDo: doBlock
    "Utility method to improve readability.
	Do not create the intermediate collection."

    self do: [: each |
        ( selectBlock value: each ) 
			ifTrue: [ doBlock value: each ]
    ].! !

!Collection methodsFor: 'enumerating' stamp: 'CamilloBruni 3/22/2013 22:20'!
piecesCutWhere: binaryBlock
	"Answer substrings of the receiver derived from cutting the receiver at points where binaryBlock answers true for adjacent elements."

	| pieces |
	pieces := OrderedCollection new.
	self 
		piecesCutWhere: binaryBlock
		do: [ :piece | pieces add: piece ].
	^pieces

       "'Now is the time for all good people to come to the aid of the cause of world peace.  It is just fine, even desirable, to love your country, if that means wanting it to play a beneficial role in the course of world events and be the best possible example of a good society.  But if it means wanting dominion over the rest of the world, it is not love but defensiveness or self-glorification, and will lead only to oblivion.'  piecesCutWhere: [:a :b| a = $. and: [b isSeparator]]"! !

!Collection methodsFor: 'enumerating' stamp: 'TudorGirba 11/3/2013 12:12'!
flatCollectAsSet: aBlock
	"Evaluate aBlock for each of the receiver's elements and answer the
	list of all resulting values flatten one level. Assumes that aBlock returns some kind
	of collection for each element. Equivalent to the lisp's mapcan"
	
	^ self flatCollect: aBlock as: Set! !

!Collection methodsFor: 'enumerating' stamp: 'CamilloBruni 9/7/2011 19:24'!
| aCollection
	^ self union: aCollection! !

!Collection methodsFor: '*Collections-arithmetic-collectors' stamp: 'TAG 11/6/1998 15:53'!
sqrt
	^ self collect: [:each | each sqrt]! !

!Collection methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	"Refer to the comment in Object|storeOn:."

	| noneYet |
	aStream nextPutAll: '(('.
	aStream nextPutAll: self class name.
	aStream nextPutAll: ' new)'.
	noneYet := true.
	self do: 
		[:each | 
		noneYet
			ifTrue: [noneYet := false]
			ifFalse: [aStream nextPut: $;].
		aStream nextPutAll: ' add: '.
		aStream store: each].
	noneYet ifFalse: [aStream nextPutAll: '; yourself'].
	aStream nextPut: $)! !

!Collection methodsFor: 'testing' stamp: 'EstebanLorenzano 8/17/2012 16:40'!
includesSubstringAnywhere: testString
	"Answer whether the receiver includes, anywhere in its nested structure, a string that has testString as a substring"
	self do:
		[:element |
			(element isString)
				ifTrue:
					[(element includesSubstring: testString) ifTrue: [^ true]].
			(element isCollection)
				ifTrue:
					[(element includesSubstringAnywhere: testString) ifTrue: [^ true]]].
	^ false

"#(first (second third) ((allSentMessages ('Elvis' includes:)))) includesSubstringAnywhere:  'lvi'"! !

!Collection methodsFor: 'removing' stamp: 'sma 5/12/2000 11:14'!
remove: oldObject ifAbsent: anExceptionBlock 
	"Remove oldObject from the receiver's elements. If several of the 
	elements are equal to oldObject, only one is removed. If no element is 
	equal to oldObject, answer the result of evaluating anExceptionBlock. 
	Otherwise, answer the argument, oldObject. ArrayedCollections cannot 
	respond to this message."

	self subclassResponsibility! !

!Collection methodsFor: 'copying' stamp: 'CamilloBruni 10/20/2012 21:49'!
copyEmpty
	^ self species new! !

!Collection methodsFor: '*Keymapping-KeyCombinations' stamp: 'GuillermoPolito 3/19/2013 19:12'!
asKeyCombination
	| shortcut |
	self size = 1 ifTrue: [ ^self first asKeyCombination ].

	shortcut := KMKeyCombinationSequence new.
	self do: [ :each | shortcut addShortcut: each asKeyCombination ].
	^shortcut.! !

!Collection methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
recordRequiredForMetacelloMCVersion: aMetacelloMCVersion

	^aMetacelloMCVersion doRecordRequiredFromArray: self.! !

!Collection methodsFor: 'enumerating' stamp: 'TudorGirba 3/20/2012 09:07'!
intersection: aCollection
	"Answer the set theoretic intersection of two collections."

	| set outputSet |
	
	set := self asSet.
	outputSet := Set new.
	
	aCollection do: [ :each|
		((set includes: each) and: [(outputSet includes: each) not])
			ifTrue: [ 
				outputSet add: each]].
		
	^ self species withAll: outputSet asArray! !

!Collection methodsFor: '*zinc-resource-meta-core' stamp: 'SvenVanCaekenberghe 3/16/2013 20:24'!
addedToZnUrl: url 
	^ url withPathSegments: self! !

!Collection methodsFor: 'enumerating' stamp: 'sma 4/30/2000 11:17'!
allSatisfy: aBlock
	"Evaluate aBlock with the elements of the receiver.
	If aBlock returns false for any element return false.
	Otherwise return true."

	self do: [:each | (aBlock value: each) ifFalse: [^ false]].
	^ true! !

!Collection methodsFor: 'testing' stamp: 'CamilloBruni 9/8/2011 14:18'!
includesAny: aCollection 
	"Answer whether any element of aCollection is one of the receiver's elements."
	aCollection do: [:elem | (self includes: elem) ifTrue: [^ true]].
	^ false! !

!Collection methodsFor: '*Collections-arithmetic' stamp: 'G.C 10/23/2008 10:12'!
* arg

	^ arg adaptToCollection: self andSend: #*! !

!Collection methodsFor: 'testing' stamp: 'ar 11/21/2009 00:36'!
ifNotEmptyDo: aBlock
	"Evaluate the given block with the receiver as its argument."

	self isEmpty ifFalse: [^ aBlock value: self].
! !

!Collection methodsFor: 'testing' stamp: 'di 11/6/1998 09:16'!
isSequenceable
	^ false! !

!Collection methodsFor: '*metacello-core' stamp: 'dkh 6/8/2009 19:02'!
setLoadsInMetacelloProject: aMetacelloPackageSpec

	aMetacelloPackageSpec setLoads: self asArray.! !

!Collection methodsFor: 'adding' stamp: 'sma 5/12/2000 17:26'!
addAll: aCollection 
	"Include all the elements of aCollection as the receiver's elements. Answer 
	aCollection. Actually, any object responding to #do: can be used as argument."

	aCollection do: [:each | self add: each].
	^ aCollection! !

!Collection methodsFor: '*Collections-arithmetic' stamp: 'TAG 11/6/1998 15:58'!
max
	^ self inject: self anyOne into: [:max :each | max max: each]! !

!Collection methodsFor: '*metacello-core' stamp: 'dkh 9/5/2012 06:26:03.064'!
setForDo: aBlock withInMetacelloConfig: aMetacelloConstructore
    aMetacelloConstructore setFor: self do: aBlock! !

!Collection methodsFor: '*UIManager' stamp: 'StephaneDucasse 2/4/2010 15:34'!
do: aBlock displayingProgress: aStringOrBlock
	"Enumerate aBlock displaying progress information. 
	If the argument is a string, use a static label for the process. 
	If the argument is a block, evaluate it with the element to retrieve the label.
		Smalltalk allClasses 
			do:[:aClass| (Delay forMilliseconds: 1) wait]
			displayingProgress: 'Processing...'.
		Smalltalk allClasses 
			do:[:aClass| (Delay forMilliseconds: 1) wait]
			displayingProgress:[:aClass| 'Processing ', aClass name].
	"
	^self do: aBlock displayingProgress: aStringOrBlock every: 20! !

!Collection methodsFor: 'enumerating' stamp: 'CamilloBruni 3/22/2013 22:18'!
collect: collectBlock thenDo: doBlock 
	"Utility method to improve readability."
	
	^ self do: [ :each|
		doBlock value: (collectBlock value: each)]! !

!Collection methodsFor: 'enumerating' stamp: 'CamilloBruni 9/7/2011 19:23'!
& aCollection
	^ self intersection: aCollection! !

!Collection methodsFor: 'enumerating' stamp: 'ul 11/21/2009 01:16'!
collect: aBlock as: aClass
	"Evaluate aBlock with each of the receiver's elements as the argument.  
	Collect the resulting values into an instance of aClass. Answer the resulting collection."

	^(aClass new: self size) fillFrom: self with: aBlock! !

!Collection methodsFor: 'printing' stamp: 'apb 4/21/2006 09:37'!
printElementsOn: aStream
	"The original code used #skip:, but some streams do not support that,
	 and we don't really need it."

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

!Collection methodsFor: 'testing' stamp: ''!
isEmpty
	"Answer whether the receiver contains any elements."

	^self size = 0! !

!Collection methodsFor: 'testing' stamp: 'CamilloBruni 9/8/2011 14:20'!
includesAnyOf: aCollection 
	
	self flag: 'use includesAny: instead'.
	
	^ self includesAny: aCollection.
	! !

!Collection methodsFor: '*Collections-arithmetic-collectors' stamp: 'TAG 11/6/1998 15:52'!
log
	^ self collect: [:each | each log]! !

!Collection methodsFor: '*Collections-arithmetic-collectors' stamp: 'TAG 11/6/1998 15:53'!
reciprocal
	"Return the reciever full of reciprocated elements"
	^ self collect: [:a | a reciprocal]! !

!Collection methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
removeFromMetacelloRepositories: aMetacelloRepositoriesSpec

	self do: [:each | each removeFromMetacelloRepositories: aMetacelloRepositoriesSpec ]
! !

!Collection methodsFor: 'math functions' stamp: 'JuanVuletich 10/11/2010 20:15'!
sum: aBlock
	"This is implemented using a variant of the normal inject:into: pattern. 
	The reason for this is that it is not known whether we're in the normal 
	number line, i.e. whether 0 is a good initial value for the sum. 
	Consider a collection of measurement objects, 0 would be the unitless 
	value and would not be appropriate to add with the unit-ed objects."
	| sum sample |
	sample := aBlock value: self anyOne.
	sum := self inject: sample into: [ :previousValue :each |  previousValue + (aBlock value: each) ].
	^ sum - sample! !

!Collection methodsFor: '*Collections-arithmetic-collectors' stamp: 'TAG 11/6/1998 15:53'!
rounded
	^ self collect: [:a | a rounded]! !

!Collection methodsFor: 'removing' stamp: 'nice 9/14/2009 20:30'!
removeAll
	"Remove each element from the receiver and leave it empty.
	ArrayedCollections cannot respond to this message.
	There are two good reasons why a subclass should override this message:
	1) the subclass does not support being modified while being iterated
	2) the subclass provides a much faster way than iterating through each element"

	self do: [:each | self remove: each].! !

!Collection methodsFor: 'enumerating' stamp: 'StephaneDucasse 1/2/2012 21:08'!
reduce: aBlock
	"Fold the result of the receiver into aBlock. The argument aBlock must take two or more arguments. It applies the argument, binaryBlock cumulatively to the elements of the receiver. For sequenceable collections the elements will be used in order, for unordered collections the order is unspecified."
	"#(1 2 3) asSet reduce: [ :a :b | a + b ]
		--> 1 + 2 + 3 = 6
	#(1 2 3 4 5) asSet reduce: [ :a :b :c | a + b + c ]
		--> 1 + 2 + 3 + 4 + 5 = 15"
		
	^self asOrderedCollection reduce: aBlock! !

!Collection methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
fetchRequiredForMetacelloMCVersion: aMetacelloMCVersion

	^aMetacelloMCVersion doFetchRequiredFromArray: self.! !

!Collection methodsFor: '*metacello-core' stamp: 'dkh 6/6/2009 11:45'!
addToMetacelloPackages: aMetacelloPackagesSpec

	self do: [:each | each addToMetacelloPackages: aMetacelloPackagesSpec ]
! !

!Collection methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 3/31/2015 10:47'!
spotterItemsFor: aStep
	<spotterOrder: 10>
	| processor |
	self ifEmpty: [ ^ self ].
	processor := aStep previousProcessorFrom: self.
	^ aStep listProcessor
		title: processor title;
		candidatesLimit: 100;
		items: [ self collect: [ :each | each asSpotterCandidateLink value] as: OrderedCollection ];
		itemName: processor itemName;
		itemIcon: processor itemIcon;
		actLogic: processor actLogic;
		itemFilterName: processor itemFilterName;
		filter: processor filter gtListFilter;
		wantsToDisplayOnEmptyQuery: true! !

!Collection methodsFor: 'enumerating' stamp: ''!
detectSum: aBlock
	"Evaluate aBlock with each of the receiver's elements as the argument. 
	Return the sum of the answers."
	| sum |
	sum := 0.
	self do: [:each | 
		sum := (aBlock value: each) + sum].  
	^ sum! !

!Collection methodsFor: 'accessing' stamp: 'sma 5/12/2000 11:33'!
anyOne
	"Answer a representative sample of the receiver. This method can
	be helpful when needing to preinfer the nature of the contents of 
	semi-homogeneous collections."

	self emptyCheck.
	self do: [:each | ^ each]! !

!Collection methodsFor: 'enumerating' stamp: 'ST 6/19/2013 18:29'!
flattenOn: aStream

	self do: [ :each | (each isCollection and: [each isString not]) 
						ifTrue: [each flattenOn: aStream]
						ifFalse: [aStream nextPut: each]].! !

!Collection methodsFor: '*UIManager' stamp: 'BenComan 3/20/2014 00:00'!
do: aBlock displayingProgress: aStringOrBlock every: msecs
       "Enumerate aBlock displaying progress information.
       If the argument is a string, use a static label for the process.
       If the argument is a block, evaluate it with the element to retrieve the label.
       The msecs argument ensures that updates happen at most every msecs.
       Example:
               Smalltalk allClasses
                       do:[:aClass| (Delay forMilliseconds: 1) wait]
                       displayingProgress:[:aClass| 'Processing ', aClass name]
                       every: 0."

	| size labelBlock count oldLabel lastUpdate |
	self isEmpty ifTrue: [ ^ self ].
	oldLabel := nil.
	count := lastUpdate := 0.
	size := self size.
	'' displayProgressFrom: 0 to: size during: [:bar |
		labelBlock := aStringOrBlock isString
			ifTrue: [
				bar label: aStringOrBlock.
				[ :dummyItem | aStringOrBlock]]
			ifFalse: [aStringOrBlock].
		self do: [:each| | newLabel |
				"Special handling for first and last element"
				(count = 0 or: [count+1 = size
					or: [(Time millisecondsSince: lastUpdate) >= msecs]]) 
						ifTrue: [ 
							bar current: count.
							oldLabel = (newLabel := (labelBlock cull: each) ifNil: [oldLabel]) 
								ifFalse: 
								[	bar label: newLabel.	
									ProgressNotification signal: '' extra: (oldLabel := newLabel)
								].
				lastUpdate := Time millisecondClockValue ].
                       aBlock value: each.
                       count := count + 1]]! !

!Collection methodsFor: 'enumerating' stamp: ''!
associationsDo: aBlock
	"Evaluate aBlock for each of the receiver's elements (key/value 
	associations).  If any non-association is within, the error is not caught now,
	but later, when a key or value message is sent to it."

	self do: aBlock! !

!Collection methodsFor: '*Collections-arithmetic-collectors' stamp: 'raok 10/22/2002 00:20'!
cos
	^self collect: [:each | each cos]! !

!Collection methodsFor: 'sorting' stamp: 'LucFabresse 6/28/2013 12:58'!
sorted
	"Return a new sequenceable collection which contains the same elements as self but its 
elements are sorted"
	
	^self asArray sorted! !

!Collection methodsFor: '*Collections-arithmetic-collectors' stamp: 'TAG 11/6/1998 15:54'!
truncated
	^ self collect: [:a | a truncated]! !

!Collection methodsFor: 'converting' stamp: 'StephaneDucasse 3/28/2010 22:39'!
asSortedCollection
	"Answer a SortedCollection whose elements are the elements of the receiver. The sort order is the default less than or equal. Note that you should use #sorted: if you don't really need a SortedCollection, but a sorted collection."

	^ self as: SortedCollection! !

!Collection methodsFor: 'enumerating' stamp: 'sma 5/12/2000 11:51'!
collect: collectBlock thenSelect: selectBlock
	"Utility method to improve readability."

	^ (self collect: collectBlock) select: selectBlock! !

!Collection methodsFor: '*metacello-core' stamp: 'dkh 9/5/2012 06:26:03.064'!
setForVersion: aString withInMetacelloConfig: aMetacelloConstructore
    aMetacelloConstructore setFor: self version: aString! !

!Collection methodsFor: 'enumerating' stamp: 'gh 9/18/2001 15:59'!
noneSatisfy: aBlock
	"Evaluate aBlock with the elements of the receiver.
	If aBlock returns false for all elements return true.
	Otherwise return false"

	self do: [:item | (aBlock value: item) ifTrue: [^ false]].
	^ true! !

!Collection methodsFor: 'enumerating' stamp: 'sma 5/12/2000 11:59'!
select: selectBlock thenCollect: collectBlock
	"Utility method to improve readability."

	^ (self select: selectBlock) collect: collectBlock! !

!Collection methodsFor: 'comparing' stamp: 'SqR 8/3/2000 13:36'!
hash
	"Answer an integer hash value for the receiver such that,
	  -- the hash value of an unchanged object is constant over time, and
	  -- two equal objects have equal hash values"

	| hash |

	hash := self species hash.
	self size <= 10 ifTrue:
		[self do: [:elem | hash := hash bitXor: elem hash]].
	^hash bitXor: self size hash! !

!Collection methodsFor: '*Collections-arithmetic-collectors' stamp: 'raok 10/22/2002 00:21'!
ln
	^self collect: [:each | each ln]! !

!Collection methodsFor: 'math functions' stamp: 'TudorGirba 11/19/2013 21:37'!
sumNumbers: aBlock
	"This is implemented using a variant of the normal inject:into: pattern
	that is specific to handling numbers. aBlock is expected to return a number
	for every element in the collection.
	
	Different from the sum: implementation, the default value is zero. While sum: is 
	more general, sumNumbers: is meant to support the most often encountered use case of
	dealing with numbers."

	^ self 
		inject: 0 
		into: [ :sum :each |  sum + (aBlock value: each) ]! !

!Collection methodsFor: 'testing' stamp: 'HenrikSperreJohansen 6/28/2010 12:14'!
ifNotEmpty: notEmptyBlock ifEmpty: emptyBlock
	"Evaluate emptyBlock if I'm empty, notEmptyBlock otherwise
	 If the notEmptyBlock has an argument, eval with the receiver as its argument"

	self isEmpty ifFalse: [ ^notEmptyBlock cull: self ].
	^emptyBlock value! !

!Collection methodsFor: '*Collections-arithmetic-collectors' stamp: 'raok 10/22/2002 00:20'!
arcSin
	^self collect: [:each | each arcSin]! !

!Collection methodsFor: 'removing' stamp: 'sma 5/12/2000 11:16'!
removeAllFoundIn: aCollection 
	"Remove each element of aCollection which is present in the receiver 
	from the receiver. Answer aCollection. No error is raised if an element
	isn't found. ArrayedCollections cannot respond to this message."

	aCollection do: [:each | self remove: each ifAbsent: []].
	^ aCollection! !

!Collection methodsFor: '*Collections-arithmetic' stamp: 'TAG 11/6/1998 16:00'!
range
	^ self max - self min! !

!Collection methodsFor: 'testing' stamp: 'MarcusDenker 7/17/2013 13:16'!
notEmpty
	"Answer whether the receiver contains any elements."
	"use isNotEmpty for consistency with isEmpty"

	^ self isEmpty not! !

!Collection methodsFor: 'enumerating' stamp: 'CamilloBruni 10/20/2012 21:50'!
select: aBlock 
	"Evaluate aBlock with each of the receiver's elements as the argument. 
	Collect into a new collection like the receiver, only those elements for 
	which aBlock evaluates to true. Answer the new collection."

	| newCollection |
	newCollection := self copyEmpty.
	self do: [ :each | 
		(aBlock value: each) 
			ifTrue: [ newCollection add: each ]].
	^newCollection! !

!Collection methodsFor: 'removing' stamp: 'sma 5/12/2000 11:22'!
remove: oldObject 
	"Remove oldObject from the receiver's elements. Answer oldObject 
	unless no element is equal to oldObject, in which case, raise an error.
	ArrayedCollections cannot respond to this message."

	^ self remove: oldObject ifAbsent: [self errorNotFound: oldObject]! !

!Collection methodsFor: 'enumerating' stamp: ''!
inject: thisValue into: binaryBlock 
	"Accumulate a running value associated with evaluating the argument, 
	binaryBlock, with the current value of the argument, thisValue, and the 
	receiver as block arguments. For instance, to sum the numeric elements 
	of a collection, aCollection inject: 0 into: [:subTotal :next | subTotal + 
	next]."

	| nextValue |
	nextValue := thisValue.
	self do: [:each | nextValue := binaryBlock value: nextValue value: each].
	^nextValue! !

!Collection methodsFor: 'enumerating' stamp: 'ul 11/21/2009 01:16'!
collect: aBlock into: aCollection
	"Evaluate aBlock with each of the receiver's elements as the argument.  
	Collect the resulting values into aCollection. Answer aCollection."

	^aCollection fillFrom: self with: aBlock! !

!Collection methodsFor: 'converting' stamp: 'sma 5/6/2000 20:10'!
asBag
	"Answer a Bag whose elements are the elements of the receiver."

	^ Bag withAll: self! !

!Collection methodsFor: '*metacello-core' stamp: 'dkh 6/6/2009 11:46'!
mergeIntoMetacelloPackages: aMetacelloPackagesSpec

	self do: [:each | each mergeIntoMetacelloPackages: aMetacelloPackagesSpec ]
! !

!Collection methodsFor: 'testing' stamp: 'bf 3/10/2000 09:29'!
isEmptyOrNil
	"Answer whether the receiver contains any elements, or is nil.  Useful in numerous situations where one wishes the same reaction to an empty collection or to nil"

	^ self isEmpty! !

!Collection methodsFor: 'enumerating' stamp: 'sma 5/12/2000 11:57'!
do: elementBlock separatedBy: separatorBlock
	"Evaluate the elementBlock for all elements in the receiver,
	and evaluate the separatorBlock between."

	| beforeFirst | 
	beforeFirst := true.
	self do:
		[:each |
		beforeFirst
			ifTrue: [beforeFirst := false]
			ifFalse: [separatorBlock value].
		elementBlock value: each]! !

!Collection class methodsFor: 'instance creation' stamp: 'sma 5/6/2000 20:06'!
with: firstObject with: secondObject with: thirdObject with: fourthObject 
	"Answer an instance of me, containing the four arguments as the elements."

	^ self new
		add: firstObject;
		add: secondObject;
		add: thirdObject;
		add: fourthObject;
		yourself! !

!Collection class methodsFor: 'instance creation' stamp: 'sma 5/6/2000 20:03'!
with: firstObject with: secondObject with: thirdObject 
	"Answer an instance of me containing the three arguments as elements."

	^ self new
		add: firstObject;
		add: secondObject;
		add: thirdObject;
		yourself! !

!Collection class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:04'!
gtExampleOrderedCollectionWithOneElement
	<gtExample>
	^ #(42) asOrderedCollection! !

!Collection class methodsFor: 'instance creation' stamp: 'sma 5/6/2000 19:58'!
with: anObject 
	"Answer an instance of me containing anObject."

	^ self new
		add: anObject;
		yourself! !

!Collection class methodsFor: '*Tools-Debugger' stamp: 'SeanDeNigris 5/28/2013 17:47'!
canonicalArgumentName

	^ 'aCollection'.! !

!Collection class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:04'!
gtExampleEmptyArray
	<gtExample>
	^ #()! !

!Collection class methodsFor: 'instance creation' stamp: 'sma 5/6/2000 20:06'!
with: firstObject with: secondObject with: thirdObject with: fourthObject with: fifthObject
	"Answer an instance of me, containing the five arguments as the elements."

	^ self new
		add: firstObject;
		add: secondObject;
		add: thirdObject;
		add: fourthObject;
		add: fifthObject;
		yourself! !

!Collection class methodsFor: 'instance creation' stamp: 'sma 5/6/2000 20:06'!
with: firstObject with: secondObject with: thirdObject with: fourthObject with: fifthObject with: sixthObject
	"Answer an instance of me, containing the six arguments as the elements."

	^ self new
		add: firstObject;
		add: secondObject;
		add: thirdObject;
		add: fourthObject;
		add: fifthObject;
		add: sixthObject;
		yourself! !

!Collection class methodsFor: 'private' stamp: 'lr 11/4/2003 12:07'!
initialize
	"Set up a Random number generator to be used by atRandom when the 
	user does not feel like creating his own Random generator."

	RandomForPicking := Random new.
	MutexForPicking := Semaphore forMutualExclusion! !

!Collection class methodsFor: 'private' stamp: 'sma 5/12/2000 12:31'!
randomForPicking
	^ RandomForPicking! !

!Collection class methodsFor: '*Polymorph-Widgets-Themes' stamp: 'YuriyTymchuk 12/20/2013 11:17'!
systemIcon

	^ Smalltalk ui icons iconNamed: #collectionIcon! !

!Collection class methodsFor: 'private' stamp: 'lr 11/4/2003 12:08'!
mutexForPicking
	^ MutexForPicking! !

!Collection class methodsFor: 'instance creation' stamp: 'sma 5/6/2000 20:07'!
withAll: aCollection
	"Create a new collection containing all the elements from aCollection."

	^ (self new: aCollection size)
		addAll: aCollection;
		yourself! !

!Collection class methodsFor: 'instance creation' stamp: 'sma 5/6/2000 20:01'!
with: firstObject with: secondObject 
	"Answer an instance of me containing the two arguments as elements."

	^ self new
		add: firstObject;
		add: secondObject;
		yourself! !

!CollectionCombinator commentStamp: '<historical>'!
For a collection of collections, enumerate all elements of the cartesian product. The code shows how recursion is used to implement variable nesting of loops.
The cartesian product is usually a huge collection, that should not be kept in memory. Therefore the user of the class has to provide a block with one argument that is called each time a tuple is constructed. When possible, that block should not build a collection of all these tuples, but should immediately drop unsuitable tuples. 
To get a first impression, try this with 'inspect it':

     | result |
     result := OrderedCollection new.
    CollectionCombinator new
         forArrays:  (OrderedCollection with: #(#a #b #c)
                                             with: #(1 2 3 4 5)
                                             with: #('v' 'w' 'x' 'y' 'z')
                                             with: #('one' 'two' 'three')
                         )
         processWith: [:item |result addLast: item].
    result
         !
!CollectionCombinator methodsFor: 'operating' stamp: 'BG 12/20/2001 21:32'!
forArrays: anArray processWith: aBlock

 "  anArray is a kind of a sequenceable collection of arrays.
    aBlock is a block with one argument, that is used to process a  tuple immediately after it is constructed. "
  collectionOfArrays := anArray.
  resultProcessingBlock := aBlock.
  buffer := Array new: anArray size.
  self combineFromIdx: 1
   ! !

!CollectionCombinator methodsFor: 'operating' stamp: 'BG 12/20/2001 21:33'!
combineFromIdx: myIdx

   "  this method is recursive. Recursion runs from values 1 to  collectionOfArrays size  of parameter myIdx. Each time it is called, this method has the responsiblity to provide all possible values for one index position of the result tuples. That index position is given by the value of  myIdx."

   (collectionOfArrays at: myIdx) do:
     [:item |
       buffer at: myIdx put: item.
       myIdx = collectionOfArrays size
         ifTrue: [resultProcessingBlock value: buffer shallowCopy]
         ifFalse: [self combineFromIdx: myIdx + 1]
    ].

  " The buffer is a shared object and its contents are later changed. It is therefore necessary to make a copy. "! !

!CollectionIsEmpty commentStamp: 'SvenVanCaekenberghe 4/18/2011 14:53'!
I am CollectionIsEmpty, an exception indicating that an operation was attempted 
on an empty collection where that does not make sense.
I am an Error and thus an Exception.

The collection that is empty is in my inherited signaler instance variable.
!
!CollectionIsEmpty methodsFor: 'private' stamp: 'SvenVanCaekenberghe 4/18/2011 14:49'!
collection
	"Return the collection where something is not found in"
	
	^ self signaler! !

!CollectionIsEmpty methodsFor: 'private' stamp: 'SvenVanCaekenberghe 4/18/2011 14:54'!
standardMessageText
	"Generate a standard textual description"
	
	^ String streamContents: [ :stream |
		stream print: self collection.
		stream << ' is empty' ]! !

!CollectionIsEmpty methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/18/2011 14:49'!
collection: aCollection
	"Set the collection where something is not found in"
	
	self signaler: aCollection! !

!CollectionIsEmpty methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/18/2011 14:49'!
messageText
	"Overwritten to initialiaze the message text to a standard text if it has not yet been set"
	
	^ messageText ifNil: [ messageText := self standardMessageText ]! !

!CollectionIsEmpty class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 4/18/2011 14:53'!
signalWith: aCollection
	^ self new
		collection: aCollection;
		signal! !

!CollectionRootTest commentStamp: 'stephane.ducasse 1/12/2009 17:41'!
I'm the root of the hierarchy of the collection tests.
!
!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testRejectThenDo

	| result index rejectIndex |
	
	index := 0.
	rejectIndex := 0.
	
	result := self collectionWithoutNilElements 
		reject: [ :each | 
			rejectIndex := rejectIndex + 1.
			"reject the first element"
			rejectIndex = 1 ]
		thenDo: [ :each | 
			self assert: each notNil.
			index := index + 1]	.
			
	self assert: result equals: self collectionWithoutNilElements.
	self assert: rejectIndex equals: self collectionWithoutNilElements size.
	self assert: index equals: self collectionWithoutNilElements size - 1.
	 ! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testSelectOnEmpty

	self assert: (self empty select: [:e | self fail]) isEmpty
	! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testCollectOnEmpty
	self assert: (self empty collect: [:e | self fail]) isEmpty! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testSelectThenCollectOnEmpty

	self assert: (self empty select: [:e | self fail ] thenCollect: [ self fail ]) isEmpty! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testReject

	| res element |
	res := self collectionWithoutNilElements reject: [:each | each notNil not].
	self assert: res size = self collectionWithoutNilElements size.
	
	element := self collectionWithoutNilElements anyOne.
	res := self collectionWithoutNilElements  reject: [:each | each = element].
	self assert: res size = (self collectionWithoutNilElements size - 1).
	
	
	! !

!CollectionRootTest methodsFor: 'requirements' stamp: 'MarcusDenker 9/9/2013 09:27'!
sizeCollection
	"Answers a collection not empty"
	^ self subclassResponsibility! !

!CollectionRootTest methodsFor: 'tests - iterate' stamp: 'GabrielOmarCotelli 11/26/2013 17:09'!
testDetectIfFoundWhenSomethingIsFoundIgnoringTheFoundObject
	"The foundBlock can be a zero argument block ignoring the object found"

	| wasFound |
	wasFound := false.
	self collectionWithoutNilElements detect: [ :each | each notNil ] ifFound: [ wasFound := true ].
	self assert: wasFound! !

!CollectionRootTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 10:36'!
empty
	self subclassResponsibility! !

!CollectionRootTest methodsFor: 'tests - empty' stamp: ''!
testIfNotEmpty

	self empty ifNotEmpty: [self assert: false].
	self nonEmpty ifNotEmpty: [self assert: true].
	self assert: (self nonEmpty ifNotEmpty: [:s | s ]) = self nonEmpty
	! !

!CollectionRootTest methodsFor: 'requirements' stamp: 'damienpollet 1/30/2009 17:20'!
doWithoutNumber

	^ 2! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testBasicCollect

	| res index |
	index := 0.
	res := self collectionWithoutNilElements collect: [ :each | 
		index := index + 1.
		each ].
	
	res do: [ :each | 
		self assert: (self collectionWithoutNilElements occurrencesOf: each) = (res occurrencesOf: each)].
	self assert: index equals: self collectionWithoutNilElements size.
	 ! !

!CollectionRootTest methodsFor: 'tests - iterate' stamp: 'GabrielOmarCotelli 11/26/2013 17:11'!
testDetectIfFoundIfNoneWhenSomethingIsFound
	| wasFound foundObject |
	foundObject := nil.
	wasFound := self collectionWithoutNilElements
		detect: [ :each | each notNil ]
		ifFound: [ :element | 
			foundObject := element.
			true ]
		ifNone: [ false ].
	self
		assert: wasFound;
		assert: (self collectionWithoutNilElements includes: foundObject)! !

!CollectionRootTest methodsFor: 'tests - empty' stamp: ''!
testIsEmptyOrNil

	self assert: (self empty isEmptyOrNil).
	self deny: (self nonEmpty isEmptyOrNil).! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testAllSatisfyEmpty

	self assert: ( self empty allSatisfy: [:each | false]).
	! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testInjectInto
	|result|
	result:= self collectionWithoutNilElements 
		inject: 0
		into: [:inj :ele | ele notNil ifTrue: [ inj + 1 ]].
	
	self assert: self collectionWithoutNilElements size = result .! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testBasicCollectEmpty

	| res |
	res := self empty collect: [:each | each class].
	self assert: res isEmpty
	! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testRejectThenCollect

	| result index selectIndex pivot |
	
	index := 0.
	selectIndex := 0.
	pivot := self collectionWithoutNilElements anyOne.
	
	result := self collectionWithoutNilElements 
		reject: [ :each | 
			selectIndex := selectIndex + 1.
			"reject the first element"
			selectIndex = 1 ]
		thenCollect: [ :each | 
			self assert: each notNil.
			index := index + 1.
			pivot ].
			
	self assert: result ~= self collectionWithoutNilElements.
	self assert: selectIndex equals: self collectionWithoutNilElements size.
	self assert: index equals: self collectionWithoutNilElements size - 1.
	
	self assert: (self collectionWithoutNilElements occurrencesOf: pivot) equals: 1.
	"should be > 1 for standard collection and = 1 for those that do not allow exact duplicates"
	self assert: (result occurrencesOf: pivot) >= 1.
	 ! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testRejectEmpty

	| res |
	res := self empty reject: [:each | each odd].
	self assert: res size = self empty size
	! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testCollectThenDoOnEmpty

	self assert: (self empty collect: [:e | self fail] thenDo: [ self fail ]) isEmpty! !

!CollectionRootTest methodsFor: 'tests - size capacity' stamp: ''!
testSize

	| size |
	self assert: self empty size = 0.
	size := 0.
	self sizeCollection do: [ :each | size := size + 1].
	
	self assert: self sizeCollection size = size.! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testRejectThenCollectEmpty

	self assert: (self empty reject: [:e | self fail ] thenCollect: [ :each| self fail ]) isEmpty! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testDoSeparatedBy
	| string expectedString beforeFirst |
	
	string := ''.
	self collectionWithoutNilElements  
		do: [ :each | string := string , each asString ]
		separatedBy: [ string := string , '|' ].
		
	expectedString := ''.
	beforeFirst := true.
	self collectionWithoutNilElements  do: 
		[ :each | 
		beforeFirst = true 
			ifTrue: [ beforeFirst := false ]
			ifFalse: [ expectedString := expectedString , '|' ].
		expectedString := expectedString , each asString ].
	self assert: expectedString = string! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testSelectThenCollect

	| result index selectIndex pivot |
	
	index := 0.
	selectIndex := 0.
	pivot := self collectionWithoutNilElements anyOne.
	
	result := self collectionWithoutNilElements 
		select: [ :each | 
			selectIndex := selectIndex + 1.
			"reject the first element"
			selectIndex > 1 ]
		thenCollect: [ :each | 
			self assert: each notNil.
			index := index + 1.
			pivot ].
			
	self assert: result ~= self collectionWithoutNilElements.
	self assert: selectIndex equals: self collectionWithoutNilElements size.
	self assert: index equals: self collectionWithoutNilElements size - 1.
	
	self assert: (self collectionWithoutNilElements occurrencesOf: pivot) equals: 1.
	"should be > 1 for standard collection and = 1 for those that do not allow exact duplicates"
	self assert: (result occurrencesOf: pivot) >= 1.
	 ! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testRejectThenDoOnEmpty

	self assert: (self empty reject: [:e | self fail ] thenDo: [ self fail ]) isEmpty! !

!CollectionRootTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureEmptyTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testSelectThenDoOnEmpty

	self assert: (self empty select: [:e | self fail ] thenDo: [ self fail ]) isEmpty! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testDoWithout
	"self debug: #testDoWithout"
	
	| res element collection |
	collection := self collectionWithoutNilElements .	
	res := OrderedCollection new.  
	element := self collectionWithoutNilElements anyOne .
	collection  do: [:each | res add: each] without: element  .
	" verifying result :"
	self assert: res size = (collection  size - (collection  occurrencesOf: element)).
	res do: [:each | self assert: (collection occurrencesOf: each) = ( res occurrencesOf: each ) ].
	! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testSelectThenDo

	| result index selectIndex |
	
	index := 0.
	selectIndex := 0.
	
	result := self collectionWithoutNilElements 
		select: [ :each | 
			selectIndex := selectIndex + 1.
			"reject the first element"
			selectIndex > 1 ]
		thenDo: [ :each | 
			self assert: each notNil.
			index := index + 1]	.
			
	self assert: result equals: self collectionWithoutNilElements.
	self assert: selectIndex equals: self collectionWithoutNilElements size.
	self assert: index equals: self collectionWithoutNilElements size - 1.
	 ! !

!CollectionRootTest methodsFor: 'tests - iterate' stamp: 'GabrielOmarCotelli 11/26/2013 16:54'!
testDetectIfFoundWhenNobodyIsFound
	| wasFound |
	wasFound := false.
	self collectionWithoutNilElements detect: [ :each | each isNil ] ifFound: [ wasFound := true ].
	self deny: wasFound! !

!CollectionRootTest methodsFor: 'requirements' stamp: 'damienpollet 1/30/2009 17:14'!
elementTwiceIn
	^ 1 "12332312322"! !

!CollectionRootTest methodsFor: 'requirements' stamp: 'damienpollet 1/30/2009 17:32'!
element
	^ 3! !

!CollectionRootTest methodsFor: 'tests - empty' stamp: ''!
testNotEmpty

	self assert: (self nonEmpty  notEmpty).
	self deny: (self empty notEmpty).! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testSumNumbers
	|result|
	result:= self collectionWithoutNilElements 
		sumNumbers: [ :ele | ele notNil ifTrue: [ 1 ] ifFalse: [ 0 ]].
	
	self assert: self collectionWithoutNilElements size = result! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testAllSatisfy

	| element |
	" when all element  satisfy the condition, should return true : "
	self assert: ( self collectionWithoutNilElements  allSatisfy: [:each | (each notNil) ] ).
	
	" when all element don't satisfy the condition, should return false : "
	self deny: ( self collectionWithoutNilElements  allSatisfy: [:each | (each notNil) not ] ).
	
	" when only one element doesn't satisfy the condition' should return false'"
	element := self collectionWithoutNilElements anyOne.
	self deny: ( self collectionWithoutNilElements  allSatisfy: [:each | (each = element) not] ).! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testSelectNoneThenDo
	| result |
	
	result := self collectionWithoutNilElements 
		select: [ :each | each isNil ] 
		thenDo: [ self fail ].
	
	self assert: result equals: self collectionWithoutNilElements! !

!CollectionRootTest methodsFor: 'tests - empty' stamp: ''!
testIsEmpty

	self assert: (self empty isEmpty).
	self deny: (self nonEmpty isEmpty).! !

!CollectionRootTest methodsFor: 'tests - empty' stamp: ''!
testIfNotEmptyifEmpty

	self assert: (self empty ifNotEmpty: [false] ifEmpty: [true]).
	self assert: (self nonEmpty ifNotEmpty: [true] ifEmpty: [false]).
	! !

!CollectionRootTest methodsFor: 'accessing' stamp: 'CamilloBruni 7/3/2013 13:03'!
collectionClass
" return the class to be used to create instances of the class tested"
	^ self classToBeTested! !

!CollectionRootTest methodsFor: 'tests - iterate' stamp: 'delaunay 5/14/2009 11:08'!
testRejectNoReject
	| res collection |
	collection := self collectionWithoutNilElements .
	res := collection  reject: [ :each | each isNil ].
	self assert: res size = collection  size! !

!CollectionRootTest methodsFor: 'tests - empty' stamp: ''!
testIfEmpty

	self nonEmpty ifEmpty: [ self assert: false] .
	self empty ifEmpty: [ self assert: true] .
	

	! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testDetect

	| res element |
	element := self collectionWithoutNilElements anyOne .
	 
	res := self collectionWithoutNilElements  detect: [:each | each = element].
	self assert: (res  = element).

	
	! !

!CollectionRootTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 10:36'!
collectionWithoutNilElements
" return a collection that doesn't includes a nil element  and that doesn't includes equal elements'"
	self subclassResponsibility! !

!CollectionRootTest methodsFor: 'tests - iterate' stamp: 'GabrielOmarCotelli 11/26/2013 16:54'!
testDetectIfFoundWhenSomethingIsFound
	| wasFound foundObject |
	wasFound := false.
	foundObject := nil.
	self collectionWithoutNilElements
		detect: [ :each | each notNil ]
		ifFound: [ :element | 
			foundObject := element.
			wasFound := true ].
	self
		assert: wasFound;
		assert: (self collectionWithoutNilElements includes: foundObject)
! !

!CollectionRootTest methodsFor: 'tests - fixture' stamp: ''!
test0TSizeTest
	self empty.
	self sizeCollection.
	self assert: self empty isEmpty.
	self deny: self sizeCollection isEmpty! !

!CollectionRootTest methodsFor: 'tests - iterate' stamp: 'GabrielOmarCotelli 11/26/2013 17:10'!
testDetectIfFoundIfNoneWhenSomethingIsFoundIgnoringTheFoundObject
	"The foundBlock can be a zero argument block ignoring the object found"

	| wasFound |
	wasFound := self collectionWithoutNilElements detect: [ :each | each notNil ] ifFound: [ true ] ifNone: [ false ].
	self assert: wasFound! !

!CollectionRootTest methodsFor: 'tests - iterate' stamp: 'GabrielOmarCotelli 11/26/2013 17:11'!
testDetectIfFoundIfNoneWhenNobodyIsFound
	| wasFound |
	wasFound := self collectionWithoutNilElements detect: [ :each | each isNil ] ifFound: [ true ] ifNone: [ false ].
	self deny: wasFound! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testSelectNoneThenCollect
	| result |
	
	result := self collectionWithoutNilElements 
		select: [ :each | each isNil ] 
		thenCollect: [ :each| self fail ].
	
	self assert: result isEmpty! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testAnySastify

	| element |
	" when all elements satisty the condition, should return true :"
	self assert: ( self collectionWithoutNilElements anySatisfy: [:each | each notNil ]).
	
	" when only one element satisfy the condition, should return true :"
	element := self collectionWithoutNilElements anyOne.
	self assert: ( self collectionWithoutNilElements  anySatisfy: [:each | (each = element)  ]   ).
	
	" when all elements don't satisty the condition, should return false :"
	self deny: ( self collectionWithoutNilElements anySatisfy: [:each | (each notNil) not ]).
! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testCollectThenSelectOnEmpty

	self assert: (self empty collect: [:e | self fail] thenSelect: [:e | self fail ]) isEmpty! !

!CollectionRootTest methodsFor: 'requirements' stamp: 'damienpollet 1/21/2009 18:25'!
expectedElementByDetect

	^ -2! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testDo2
	"dc: Bad test, it assumes that a new instance of #speciesClass allows addition with #add:. This is not the case of Interval for which species is Array."
	"res := self speciesClass new.  
	self collection do: [:each | res add: each class].
	self assert: res = self result. "
	| collection cptElementsViewed cptElementsIn |
	collection := self collectionWithoutNilElements.
	cptElementsViewed := 0.
	cptElementsIn := OrderedCollection new.
	collection do: 
		[ :each | 
		cptElementsViewed := cptElementsViewed + 1.
		" #do doesn't iterate with the same objects than those in the collection for FloatArray( I don' t know why ) . That's why I use #includes: and not #identityIncludes:  '"
		(collection includes: each) ifTrue: [
			" the collection used doesn't include equal elements. Therefore each element viewed should not have been viewed before "
			( cptElementsIn includes: each ) ifFalse: [ cptElementsIn add: each ] .
			]. 
		].
	self assert: cptElementsViewed = collection size.
	self assert: cptElementsIn size  = collection size.
	
	! !

!CollectionRootTest methodsFor: 'tests - empty' stamp: ''!
testIfEmptyifNotEmpty

	self assert: (self empty ifEmpty: [true] ifNotEmpty: [false]).
	self assert: (self nonEmpty ifEmpty: [false] ifNotEmpty: [true]).
	! !

!CollectionRootTest methodsFor: 'test - fixture' stamp: ''!
test0FixtureIterateTest
	| res |
	self collectionWithoutNilElements.
	self assert: (self collectionWithoutNilElements occurrencesOf: nil) = 0.
	res := true.
	self collectionWithoutNilElements
		detect: [ :each | (self collectionWithoutNilElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testDetectIfNone

	| res element |
	res := self collectionWithoutNilElements  detect: [:each | each notNil not] ifNone: [100].
	self assert: res  = 100.
	
	element := self collectionWithoutNilElements anyOne.
	res := self collectionWithoutNilElements  detect: [:each | each = element] ifNone: [100].
	self assert: res  = element.

	
	! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testRejectAllThenCollect
	| result |
	
	result := self collectionWithoutNilElements 
		reject: [ :each | each notNil ] 
		thenCollect: [ :each| self fail ].
	
	self assert: result isEmpty! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testRejectAllThenDo
	| result |
	
	result := self collectionWithoutNilElements 
		reject: [ :each | each notNil ] 
		thenDo: [ :each | self fail ].
	
	self assert: result equals: self collectionWithoutNilElements! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testNoneSatisfy

	| element |
	self assert: ( self collectionWithoutNilElements  noneSatisfy: [:each | each notNil not ] ).
	element := self collectionWithoutNilElements anyOne.
	self deny: ( self collectionWithoutNilElements  noneSatisfy: [:each | (each = element)not ] ).! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testNoneSatisfyEmpty

	self assert: ( self empty noneSatisfy: [:each | false]).
	! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testSelect

	| result element |
	result := self collectionWithoutNilElements select: [ :each | each notNil].
	self assert: result size equals: self collectionWithoutNilElements size.
	
	element := self collectionWithoutNilElements anyOne.
	result := self collectionWithoutNilElements select: [ :each | (each = element) not].
	self assert: result size equals: (self collectionWithoutNilElements size - 1).
	! !

!CollectionRootTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 10:35'!
nonEmpty

	self subclassResponsibility! !

!CollectionRootTest methodsFor: 'tests - iterating' stamp: ''!
testBasicCollectThenDo

	| result index |
	index := 0.
	result := self collectionWithoutNilElements 
		collect: [ :each | nil ]
		thenDo: [ :each | 
			self assert: each isNil.
			index := index + 1]	.
			
	self assert: result equals: self collectionWithoutNilElements.
	self assert: index equals: self collectionWithoutNilElements size.
	 ! !

!CollectionRootTest class methodsFor: 'as yet unclassified' stamp: 'damienpollet 1/13/2009 15:28'!
isAbstract

	^ self name = #CollectionRootTest! !

!CollectionValueHolder commentStamp: 'BenjaminVanRyseghem 1/23/2014 15:18'!
I am designed specifically for collections.!
!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
removeAll

	value removeAll.
	self valueChanged! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
addAll: aCollection 
	
	| result |
	result := value addAll: aCollection.
	self valueChanged: aCollection.
	^ result! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
resetTo: index

	value resetTo: index.
	self valueChanged! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
addAllFirstUnlessAlreadyPresent: anOrderedCollection
	
	| result |
	result := value addAllFirstUnlessAlreadyPresent: anOrderedCollection.
	self valueChanged: anOrderedCollection.
	^ result! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
add: newObject beforeIndex: index 
	
	| result |
	result := value add: newObject beforeIndex: index.
	self valueChanged: newObject.
	^ result! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
addLast: newObject 

	| result |
	result := value addLast: newObject .
	self valueChanged: newObject.
	^ result! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
atLast: indexFromEnd put: obj
	
	| result |
	result := value atLast: indexFromEnd put: obj.
	self valueChanged: obj.
	^ result! !

!CollectionValueHolder methodsFor: 'private' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
doesNotUnderstand: aMessage

	^ (value respondsTo: aMessage selector)
		ifTrue: [ value perform: aMessage selector withEnoughArguments: aMessage arguments ]
		ifFalse: [ super doesNotUnderstand: aMessage ]! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
replace: aBlock 

	value replace: aBlock .
	self valueChanged! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
add: newObject after: oldObject 
	
	| result |
	result := value add: newObject after: oldObject.
	self valueChanged: newObject.
	^ result! !

!CollectionValueHolder methodsFor: 'override' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
at: anObject

	^ value at: anObject! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
add: newObject

	| result |
	result := value add: newObject.
	self valueChanged: newObject.
	^ result! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
addAllLast: aCollection 
	
	| result |
	result := value addAllLast: aCollection.
	self valueChanged: aCollection.
	^ result! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
removeAt: index

	| result |
	result := value removeAt: index.
	self valueChanged: result.
	^ result! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
add: newObject before: oldObject
	
	| result |
	result := value add: newObject before: oldObject.
	self valueChanged: newObject.
	^ result! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'CamilloBruni 11/18/2013 18:08'!
atWrap: index put: anObject
	
	| result |
	result := value atWrap: index put: anObject.
	self valueChanged: value.
	^ result! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
atAll: aCollection put: anObject 
	
	| result |
	result := value atAll: aCollection put: anObject .
	self valueChanged: anObject.
	^ result! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
at: index ifAbsentPut: block

	| result |
	result := value at: index ifAbsentPut: block.
	self valueChanged: block value.
	^ result! !

!CollectionValueHolder methodsFor: 'override' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
size 

	^ value size! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
removeFirst

	| result |
	result := value removeFirst.
	self valueChanged: result.
	^ result! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
remove: oldObject ifAbsent: absentBlock

	| result |
	result := value remove: oldObject ifAbsent: absentBlock.
	self valueChanged: oldObject.
	^ result! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
addFirst: newObject 

	| result |
	result := value addFirst: newObject .
	self valueChanged: newObject.
	^ result! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
insert: anObject before: spot

	| result |
	result := value insert: anObject before: spot.
	self valueChanged: anObject.
	^ result! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
replaceAll: oldObject with: newObject 

	value replaceAll: oldObject with: newObject .
	self valueChanged: oldObject! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
removeFirst: n 

	| result |
	result := value removeFirst: n .
	self valueChanged: result.
	^ result! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
addAllFirst: anOrderedCollection
	
	| result |
	result := value addAllFirst: anOrderedCollection.
	self valueChanged: anOrderedCollection.
	^ result! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
reset

	value reset.
	self valueChanged! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
add: newObject afterIndex: index 
	
	| result |
	result := value add: newObject afterIndex: index.
	self valueChanged: newObject.
	^ result! !

!CollectionValueHolder methodsFor: 'override' stamp: 'BenjaminVanRyseghem 10/17/2013 17:11'!
at: key put: anObject

	value at: key put: anObject.
	self valueChanged: value.
	^ anObject! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
atAll: indexArray putAll: valueArray
	
	| result |
	result := value atAll: indexArray putAll: valueArray.
	self valueChanged: valueArray.
	^ result! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
removeLast

	| result |
	result := value removeLast.
	self valueChanged: result.
	^ result! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'PeterUhnak 11/5/2014 09:21'!
remove: oldObject

	| result |
	result := value remove: oldObject.
	self valueChanged: oldObject.
	^ result! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
sort: aSortBlock 

	value sort: aSortBlock .
	self valueChanged! !

!CollectionValueHolder methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 8/21/2014 17:37'!
addAnnouncementFirst: ann

	^ self addFirst: (DateAndTime now -> ann)! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
atAllPut: anObject 
	
	| result |
	result := value atAllPut: anObject.
	self valueChanged: anObject.
	^ result! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
removeLast: n

	| result |
	result := value removeLast: n.
	self valueChanged: result.
	^ result! !

!CollectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
removeIndex: removedIndex

	| result |
	result := value removeIndex: removedIndex.
	self valueChanged: result.
	^ result! !

!CollectionsArithmeticReadme commentStamp: '<historical>'!
This package only makes extensions to existing collection classes by adding the arithmetic protocols. 
Such protocols allow one to perform in particular vector-operations on collection!
!Color commentStamp: '<historical>'!
This class represents abstract color, regardless of the depth of bitmap it will be shown in.  At the very last moment a Color is converted to a pixelValue that depends on the depth of the actual Bitmap inside the Form it will be used with.  The supported depths (in bits) are 1, 2, 4, 8, 16, and 32.  The number of actual colors at these depths are: 2, 4, 16, 256, 32768, and 16 million.  (See comment in BitBlt.)  To change the depth of the Display and set how many colors you can see, execute: (Display newDepth: 8).  (See comment in DisplayMedium)
	Color is represented as the amount of light in red, green, and blue.  White is (1.0, 1.0, 1.0) and black is (0, 0, 0).  Pure red is (1.0, 0, 0).  These colors are "additive".  Think of Color's instance variables as:
	r	amount of red, a Float between 0.0 and 1.0.
	g	amount of green, a Float between 0.0 and 1.0.
	b	amount of blue, a Float between 0.0 and 1.0.
(But, in fact, the three are encoded as values from 0 to 1023 and combined in a single integer, rgb.  The user does not need to know this.)
	Many colors are named.  You find a color by name by sending a message to class Color, for example (Color lightBlue).  Also, (Color red: 0.2 green: 0.6 blue: 1.0) or (Color r: 0.2 g: 0.6 b: 1.0) creates a color. (see below)
	A color is essentially immutable.  Once you set red, green, and blue, you cannot change them.  Instead, create a new Color and use it.
	Applications such as contour maps and bar graphs will want to display one of a set of shades based on a number.  Convert the range of this number to an integer from 1 to N.  Then call (Color green lightShades: N) to get an Array of colors from white to green.  Use the Array messages at:, atPin:, or atWrap: to pull out the correct color from the array.  atPin: gives the first (or last) color if the index is out of range.  atWrap: wraps around to the other end if the index is out of range.
	Here are some fun things to run in when your screen has color:
		Pen new mandala: 30 diameter: Display height-100.
		Pen new web  "Draw with the mouse, opt-click to end"
		Display fillWhite.  Pen new hilberts: 5.
		Form toothpaste: 30  "Draw with mouse, opt-click to end"
You might also want to try the comment in
	Form>class>examples>tinyText...


Messages:
	mixed: proportion with: aColor	Answer this color mixed with the given color additively. The proportion, a number between 0.0 and 1.0, determines what what fraction of the receiver to use in the mix.

	+ 	add two colors
	- 	subtract two colors
	*	multiply the values of r, g, b by a number or an Array of factors.  ((Color named: #white) * 0.3) gives a darkish gray.  (aColor * #(0 0 0.9)) gives a color with slightly less blue.
	/	divide a color by a factor or an array of three factors.

	errorForDepth: d     How close the nearest color at this depth is to this abstract color.  Sum of the squares of the RGB differences, square rooted and normalized to 1.0.  Multiply by 100 to get percent.

	hue			Returns the hue of the color. On a wheel from 0 to 360 with pure red at 0 and again at 360.
	saturation	Returns the saturation of the color.  0.0 to 1.0
	brightness	Returns the brightness of the color.  0.0 to 1.0

	name    Look to see if this Color has a name.
	display	Show a swatch of this color tracking the cursor.

	lightShades: thisMany		An array of thisMany colors from white to the receiver. 
	darkShades: thisMany		An array of thisMany colors from black to the receiver.  Array is of length num.
	mix: color2 shades: thisMany		An array of thisMany colors from the receiver to color2.
	wheel: thisMany			An array of thisMany colors around the color wheel starting and ending at the receiver.

	pixelValueForDepth: d    Returns the bits that appear be in a Bitmap of this depth for this color.  Represents the nearest available color at this depth.  Normal users do not need to know which pixelValue is used for which color. 

Messages to Class Color.
	red: r green: g blue: b		Return a color with the given r, g, and b components.
	r: g: b:		Same as above, for fast typing.

 	hue: h saturation: s brightness: b		Create a color with the given hue, saturation, and brightness.

	pink
 	blue
	red ...	Many colors have messages that return an instance of Color.
	canUnderstand: #brown	  Returns true if #brown is a defined color.
	names		An OrderedCollection of the names of the colors.
	named: #notAllThatGray put: aColor    Add a new color to the list and create an access message and a class variable for it.
	fromUser	Shows the palette of colors available at this display depth.  Click anywhere to return the color you clicked on.

	hotColdShades: thisMany	An array of thisMany colors showing temperature from blue to red to white hot.

    stdColorsForDepth: d        An Array of colors available at this depth.  For 16 bit and 32 bits, returns a ColorGenerator.  It responds to at: with a Color for that index, simulating a very big Array. 

   colorFromPixelValue: value depth: d    Returns a Color whose bit pattern (inside a Bitmap) at this depth is the number specified.  Normal users do not need to use this.

(See also comments in these classes: Form, Bitmap, BitBlt, Pattern, MaskedForm.)!
!Color methodsFor: 'transformations' stamp: 'StephaneDucasse 10/15/2013 22:13'!
twiceLighter
	"Answer a significantly lighter shade of this color."

	^ self adjustSaturation: -0.06 brightness: 0.15! !

!Color methodsFor: 'private' stamp: 'StephaneDucasse 10/15/2013 22:13'!
setRed: r green: g blue: b range: range 
	"Initialize this color's r, g, and b components to the given values in the range [0..r]."
	rgb == nil ifFalse: [ self attemptToMutateError ].
	rgb := ((r * ComponentMask // range bitAnd: ComponentMask) bitShift: RedShift) + ((g * ComponentMask // range bitAnd: ComponentMask) bitShift: GreenShift) + (b * ComponentMask // range bitAnd: ComponentMask).
	cachedDepth := nil.
	cachedBitPattern := nil! !

!Color methodsFor: 'queries' stamp: 'StephaneDucasse 10/15/2013 22:13'!
isBitmapFill
	^false! !

!Color methodsFor: 'transformations' stamp: 'StephaneDucasse 10/16/2013 15:08'!
whiter

	^ self alphaMixed: 0.8333 with: (ColorRegistry at: #white)
! !

!Color methodsFor: 'conversions' stamp: 'StephaneDucasse 10/15/2013 22:42'!
bitPatternForDepth: depth 
	"Return a Bitmap, possibly containing a stipple pattern, that best represents this color at the given depth. BitBlt calls this method to convert colors into Bitmaps. The resulting Bitmap may be multiple words to represent a stipple pattern of several lines.  "
	"See also:	pixelValueAtDepth:	-- value for single pixel
				pixelWordAtDepth:	-- a 32-bit word filled with the pixel value"
	"Details: The pattern for the most recently requested depth is cached."
	"Note for depths > 2, there are stippled and non-stippled versions (generated with #balancedPatternForDepth: and #bitPatternForDepth:, respectively). The stippled versions don't work with the window bit caching of StandardSystemView, so we make sure that for these depths, only unstippled patterns are returned"
	(depth = cachedDepth and: [ depth <= 2 or: [ cachedBitPattern size = 1 ] ]) ifTrue: [ ^ cachedBitPattern ].
	( self isTransparent and: [ cachedBitPattern isNil] )
			 ifTrue: [ cachedBitPattern := Bitmap with: 0 . 
					^ cachedBitPattern ].
	cachedDepth := depth.
	depth > 2 ifTrue: [ ^ cachedBitPattern := Bitmap with: (self pixelWordForDepth: depth) ].
	depth = 1 ifTrue: [ ^ cachedBitPattern := self halfTonePattern1 ].
	depth = 2 ifTrue: [ ^ cachedBitPattern := self halfTonePattern2 ]! !

!Color methodsFor: 'queries' stamp: 'StephaneDucasse 10/15/2013 22:13'!
isTranslucentButNotTransparent
	"Answer true if this any of this morph is translucent but not transparent."
	
	^ self isTranslucent and: [ self isTransparent not ]! !

!Color methodsFor: 'queries' stamp: 'StephaneDucasse 10/16/2013 14:38'!
isGray
	"Return true if the receiver represents a shade of gray"
	^(self privateRed = self privateGreen) and: [self privateRed = self privateBlue]! !

!Color methodsFor: 'other' stamp: 'StephaneDucasse 10/15/2013 22:13'!
rgbTriplet
	"Color fromUser rgbTriplet"

	^ Array
		with: (self red roundTo: 0.01)
		with: (self green roundTo: 0.01)
		with: (self blue roundTo: 0.01)
! !

!Color methodsFor: 'accessing' stamp: 'StephaneDucasse 10/15/2013 22:13'!
green
	"Return the green component of this color, a float in the range [0.0..1.0]."

	^ self privateGreen asFloat / ComponentMax! !

!Color methodsFor: 'queries' stamp: 'StephaneDucasse 10/16/2013 14:41'!
isTransparent

	^ alpha = 0! !

!Color methodsFor: '*System-CommandLineHandler' stamp: 'StephaneDucasse 10/15/2013 22:13'!
closestXTermPixelValue
	| index |
	"Return the nearest approximation to this color for 256 xterm color."

	self saturation < 0.2 ifTrue: [
		"colors 232-255 are a grayscale ramp, intentionally leaving out black and white"
		index := (self green * 25) asInteger.
		index = 0 ifTrue: [ ^ 0 ].
		index = 25 ifTrue: [ ^ 16 ].
		^ index + 232 ].
	
	"compute nearest entry in the 6*6*6 color cube"
	^ 16 + (self red * 6*6*5) asInteger + (self green * 6*5) asInteger + (self blue * 5) asInteger
! !

!Color methodsFor: '*Athens-Core' stamp: 'IgorStasenko 9/3/2013 12:11'!
athensFillPath: aPath on: aCanvas 
	^ aCanvas surface fillPath: aPath withSolidColor:self! !

!Color methodsFor: 'transformations' stamp: 'StephaneDucasse 10/15/2013 22:13'!
negated
	"Return an RGB inverted color"
	^Color
		r: 1.0 - self red
		g: 1.0 - self green
		b: 1.0 - self blue! !

!Color methodsFor: 'private' stamp: 'StephaneDucasse 10/15/2013 22:13'!
privateRed
	"Private!! Return the internal representation of my red component."

	^ (rgb bitShift: 0 - RedShift) bitAnd: ComponentMask! !

!Color methodsFor: 'conversions' stamp: 'StephaneDucasse 10/15/2013 22:13'!
dominantColor
	^ self! !

!Color methodsFor: 'queries' stamp: 'StephaneDucasse 10/15/2013 22:13'!
isOrientedFill
	"Return true if the receiver keeps an orientation (e.g., origin, direction, and normal)"
	^false! !

!Color methodsFor: 'other' stamp: 'StephaneDucasse 10/15/2013 22:13'!
raisedColor
	^ self! !

!Color methodsFor: 'private' stamp: 'StephaneDucasse 10/15/2013 22:13'!
setRed: r green: g blue: b 
	"Initialize this color's r, g, and b components to the given values in the range [0.0..1.0].  Encoded in a single variable as 3 integers in [0..1023]."
	rgb == nil ifFalse: [ self attemptToMutateError ].
	rgb := (((r * ComponentMax) rounded bitAnd: ComponentMask) bitShift: RedShift) + (((g * ComponentMax) rounded bitAnd: ComponentMask) bitShift: GreenShift) + ((b * ComponentMax) rounded bitAnd: ComponentMask).
	cachedDepth := nil.
	cachedBitPattern := nil! !

!Color methodsFor: 'transformations' stamp: 'StephaneDucasse 10/15/2013 22:13'!
slightlyDarker

	^ self adjustBrightness: -0.03
! !

!Color methodsFor: 'private' stamp: 'StephaneDucasse 10/15/2013 22:13'!
flushCache
	"Flush my cached bit pattern."
	cachedDepth := nil.
	cachedBitPattern := nil! !

!Color methodsFor: 'transformations' stamp: 'StephaneDucasse 10/15/2013 22:13'!
atMostAsLuminentAs: aFloat 
	| revisedColor |
	revisedColor := self.
	[ revisedColor luminance > aFloat ] whileTrue: [ revisedColor := revisedColor slightlyDarker ].
	^ revisedColor! !

!Color methodsFor: 'conversions' stamp: 'StephaneDucasse 10/16/2013 14:37'!
initializeRed: r green: g blue: b range: range 
	"Initialize this color's r, g, and b components to the given values in the range [0..r]."
	rgb == nil ifFalse: [ self attemptToMutateError ].
	rgb := ((r * ComponentMask // range bitAnd: ComponentMask) bitShift: RedShift) + ((g * ComponentMask // range bitAnd: ComponentMask) bitShift: GreenShift) + (b * ComponentMask // range bitAnd: ComponentMask).
	cachedDepth := nil.
	cachedBitPattern := nil.
	self setAlpha: 1.0.! !

!Color methodsFor: 'queries' stamp: 'StephaneDucasse 10/15/2013 22:13'!
isGradientFill
	^false! !

!Color methodsFor: 'accessing' stamp: 'StephaneDucasse 10/15/2013 22:13'!
hue
	"Return the hue of this color, an angle in the range [0.0..360.0]."
	| r g b max min span h |
	r := self privateRed.
	g := self privateGreen.
	b := self privateBlue.
	max := (r max: g) max: b.
	min := (r min: g) min: b.
	span := (max - min) asFloat.
	span = 0.0 ifTrue: [ ^ 0.0 ].
	r = max 
		ifTrue: [ h := (g - b) asFloat / span * 60.0 ]
		ifFalse: 
			[ g = max 
				ifTrue: [ h := 120.0 + ((b - r) asFloat / span * 60.0) ]
				ifFalse: [ h := 240.0 + ((r - g) asFloat / span * 60.0) ] ].
	h < 0.0 ifTrue: [ h := 360.0 + h ].
	^ h! !

!Color methodsFor: 'accessing' stamp: 'StephaneDucasse 10/15/2013 22:13'!
red
	"Return the red component of this color, a float in the range [0.0..1.0]."

	^ self privateRed asFloat / ComponentMax! !

!Color methodsFor: 'groups of shades' stamp: 'StephaneDucasse 10/16/2013 15:08'!
wheel: thisMany 
	"An array of thisMany colors around the color wheel starting at self and ending all the way around the hue space just before self.  Array is of length thisMany.  Very useful for displaying color based on a variable in your program.  "
	| sat bri step hue |
	sat := self saturation.
	bri := self brightness.
	hue := self hue.
	step := 360.0 / (thisMany max: 1).
	^ (1 to: thisMany) collect: 
		[ :num | | c | 
		c := self class 
			h: hue
			s: sat
			v: bri.	"hue is taken mod 360"
		hue := hue + step.
		c ]
	"
(Color wheel: 8) withIndexDo: [:c :i | Display fill: (i*10@20 extent: 10@20) fillColor: c]
"! !

!Color methodsFor: 'transformations' stamp: 'StephaneDucasse 10/16/2013 15:00'!
quiteWhiter

	^ self alphaMixed: 0.6 with: (ColorRegistry at: #white)! !

!Color methodsFor: 'accessing' stamp: 'StephaneDucasse 10/15/2013 22:13'!
brightness
	"Return the brightness of this color, a float in the range [0.0..1.0]."

	^ ((self privateRed max:
	    self privateGreen) max:
	    self privateBlue) asFloat / ComponentMax! !

!Color methodsFor: 'transformations' stamp: 'StephaneDucasse 10/15/2013 22:13'!
paler
	"Answer a paler shade of this color."

	^ self adjustSaturation: -0.09 brightness: 0.09
! !

!Color methodsFor: '*Morphic-Base' stamp: 'StephaneDucasse 10/15/2013 22:13'!
iconOrThumbnailOfSize: aNumberOrPoint 
	"Answer an appropiate form to represent the receiver"
	| form |
	form := Form extent: aNumberOrPoint asPoint asPoint depth: 32.
	form fillColor: self.
	^ form! !

!Color methodsFor: 'conversions' stamp: 'StephaneDucasse 10/16/2013 14:55'!
pixelValueForDepth: d 
		 
		"Return the pixel value for this color at the given depth. Translucency only works in RGB; this color will appear either opaque or transparent at all other depths."
	| basicPixelWord |
	( d < 32 and:[ self isTransparent ] ) ifTrue: [ ^ 0 ].
	basicPixelWord := self basicPixelValueForDepth: d.
	^ d < 32 
		ifTrue: [ basicPixelWord ]
		ifFalse: [ (basicPixelWord bitAnd: 16777215) bitOr: (alpha bitShift: 24) ]! !

!Color methodsFor: 'transformations' stamp: 'StephaneDucasse 10/16/2013 14:43'!
muchDarker

	^ self alphaMixed: 0.5 with: (ColorRegistry at: #black)
! !

!Color methodsFor: 'printing' stamp: 'StephaneDucasse 10/16/2013 15:05'!
storeArrayValuesOn: aStream
	self isTransparent ifTrue: [ ^ aStream space. ].

	(self red roundTo: 0.001) storeOn: aStream.
	aStream space.
	(self green roundTo: 0.001) storeOn: aStream.
	aStream space.
	(self blue roundTo: 0.001) storeOn: aStream.
	aStream space.
	(self alpha roundTo: 0.001) storeOn: aStream.

! !

!Color methodsFor: 'conversions' stamp: 'StephaneDucasse 10/16/2013 15:01'!
setAlpha: aFloat
	alpha := ((255.0 * aFloat) asInteger  min: 255) max: 0.
! !

!Color methodsFor: 'conversions' stamp: 'StephaneDucasse 10/15/2013 22:13'!
indexInMap: aColorMap
	"Return the index corresponding to this color in the given color map. RGB colors are truncated to 3-, 4-, or 5-bits per color component when indexing into such a colorMap.  "

	aColorMap size = 2 ifTrue: [^ (self pixelValueForDepth: 1) + 1].
	aColorMap size = 4 ifTrue: [^ (self pixelValueForDepth: 2) + 1].
	aColorMap size = 16 ifTrue: [^ (self pixelValueForDepth: 4) + 1].
	aColorMap size = 256 ifTrue: [^ (self pixelValueForDepth: 8) + 1].
	aColorMap size = 512 ifTrue: [^ (self pixelValueForDepth: 9) + 1].
	aColorMap size = 4096 ifTrue: [^ (self pixelValueForDepth: 12) + 1].
	aColorMap size = 32768 ifTrue: [^ (self pixelValueForDepth: 16) + 1].
	self error: 'unknown pixel depth'.
! !

!Color methodsFor: 'transformations' stamp: 'AliakseiSyrel 3/21/2015 14:15'!
+ aColor
	"Answer this color mixed with the given color in an additive color space.  "

	^ self class basicNew
		setPrivateRed: self privateRed + aColor privateRed
		green: self privateGreen + aColor privateGreen
		blue: self privateBlue + aColor  privateBlue;
		setAlpha: (self alpha + aColor alpha min: 1.0)
! !

!Color methodsFor: '*Morphic-Base' stamp: 'StephaneDucasse 10/26/2014 11:15'!
addFillStyleMenuItems: aMenu hand: aHand from: aMorph
	"Add the items for changing the current fill style of the receiver"
	
	aMenu add: 'change color...' target: self selector: #changeColorIn:event: argument: aMorph! !

!Color methodsFor: 'equality' stamp: 'StephaneDucasse 10/15/2013 22:13'!
diff: theOther
	"Returns a number between 0.0 and 1.0"

	^ ((self privateRed - theOther privateRed) abs
		+ (self privateGreen - theOther privateGreen) abs
		+ (self privateBlue - theOther privateBlue) abs)
		/ 3.0 / ComponentMax! !

!Color methodsFor: 'queries' stamp: 'StephaneDucasse 10/15/2013 22:13'!
isBlack
	"Return true if the receiver represents black"
	^rgb = 0! !

!Color methodsFor: 'private' stamp: 'StephaneDucasse 10/15/2013 22:13'!
privateRGB
	"Private!! Return the internal representation of my RGB components."

	^ rgb
! !

!Color methodsFor: 'printing' stamp: 'MarcusDenker 3/27/2014 11:03'!
printOn: aStream
	| name |
	(name := self name).
	name = #unnamed
		ifFalse: [ 
			^ aStream
				nextPutAll: 'Color ';
				nextPutAll: name ].
	self storeOn: aStream! !

!Color methodsFor: 'private' stamp: 'StephaneDucasse 10/15/2013 22:13'!
setPrivateRed: r green: g blue: b 
	"Initialize this color's r, g, and b components to the given values in the range [0..ComponentMax].  Encoded in a single variable as 3 integers in [0..1023]."
	rgb == nil ifFalse: [ self attemptToMutateError ].
	rgb := ((r 
		min: ComponentMask
		max: 0) bitShift: RedShift) + ((g 
			min: ComponentMask
			max: 0) bitShift: GreenShift) + (b 
			min: ComponentMask
			max: 0).
	cachedDepth := nil.
	cachedBitPattern := nil! !

!Color methodsFor: 'transformations' stamp: 'StephaneDucasse 10/15/2013 22:32'!
alpha: aFloat 
	"Answer a new Color with the given amount of opacity ('alpha')."

	^ self class r: self red g: self green b: self blue alpha: aFloat ! !

!Color methodsFor: 'conversions' stamp: 'StephaneDucasse 10/15/2013 22:33'!
asNontranslucentColor
	^ self alpha: 1.0.! !

!Color methodsFor: '*Athens-Core' stamp: 'IgorStasenko 9/3/2013 12:17'!
asStrokePaintOn: aCanvas 
	^ aCanvas surface createStrokePaintFor: self! !

!Color methodsFor: 'queries' stamp: 'StephaneDucasse 10/16/2013 14:39'!
isOpaque
	^ alpha = 255 ! !

!Color methodsFor: 'accessing' stamp: 'StephaneDucasse 10/15/2013 22:13'!
blue
	"Return the blue component of this color, a float in the range [0.0..1.0]."

	^ self privateBlue asFloat / ComponentMax! !

!Color methodsFor: 'conversions' stamp: 'StephaneDucasse 10/15/2013 22:13'!
closestPixelValue1
	"Return the nearest approximation to this color for a monochrome Form."

	"fast special cases"
	rgb = 0 ifTrue: [^ 1].  "black"
	rgb = 16r3FFFFFFF ifTrue: [^ 0].  "white"

	self luminance > 0.5
		ifTrue: [^ 0]  "white"
		ifFalse: [^ 1].  "black"
! !

!Color methodsFor: 'transformations' stamp: 'StephaneDucasse 10/15/2013 22:13'!
atLeastAsLuminentAs: aFloat 
	| revisedColor |
	revisedColor := self.
	[ revisedColor luminance < aFloat ] whileTrue: [ revisedColor := revisedColor slightlyLighter ].
	^ revisedColor! !

!Color methodsFor: 'printing' stamp: 'StephaneDucasse 10/16/2013 15:05'!
storeOn: aStream
	self isTransparent ifTrue: [^ aStream nextPutAll: '(Color transparent)'].

	aStream
		nextPutAll: '(' , self class name;
		nextPutAll: ' r: '; print: (self red roundTo: 0.001);
		nextPutAll: ' g: '; print: (self green roundTo: 0.001);
		nextPutAll: ' b: '; print: (self blue roundTo: 0.001);
		nextPutAll: ' alpha: '; print: (self alpha roundTo: 0.001);
		nextPutAll: ')'.
! !

!Color methodsFor: 'conversions' stamp: 'StephaneDucasse 10/16/2013 14:37'!
initializeRed: r green: g blue: b alpha: anAlpha 
	"Initialize this color's r, g, and b components to the given values in the range [0.0..1.0].  Encoded in a single variable as 3 integers in [0..1023]."
	rgb == nil ifFalse: [ self attemptToMutateError ].
	rgb := (((r * ComponentMax) rounded bitAnd: ComponentMask) bitShift: RedShift) + (((g * ComponentMax) rounded bitAnd: ComponentMask) bitShift: GreenShift) + ((b * ComponentMax) rounded bitAnd: ComponentMask).
	cachedDepth := nil.
	cachedBitPattern := nil.
	self setAlpha: anAlpha.! !

!Color methodsFor: 'accessing' stamp: 'StephaneDucasse 10/15/2013 22:13'!
luminance
	"Return the luminance of this color, a brightness value weighted by the human eye's color sensitivity."

	^ ((299 * self privateRed) +
	   (587 * self privateGreen) +
	   (114 * self privateBlue)) / (1000 * ComponentMax)
! !

!Color methodsFor: 'conversions' stamp: 'StephaneDucasse 10/15/2013 22:44'!
contrastingColor
	"Answer black or white depending on the luminance."

	self isTransparent ifTrue: [ ^ self class black].
	^self luminance > 0.5
		ifTrue: [self class black]
		ifFalse: [self class white]! !

!Color methodsFor: '*Athens-Cairo' stamp: 'IgorStasenko 9/3/2013 13:31'!
loadOnCairoCanvas: aCairoCanvas
	aCairoCanvas
		setSourceR: self red g: self green b: self blue a: self alpha! !

!Color methodsFor: 'comparing' stamp: 'StephaneDucasse 10/15/2013 22:29'!
= aColor
	"Return true if the receiver equals the given color. This method handles translucent colors, too."

	aColor isColor ifFalse: [^ false].
	^ aColor privateRGB = rgb and:
		[aColor privateAlpha = self privateAlpha]
! !

!Color methodsFor: 'accessing' stamp: 'StephaneDucasse 10/15/2013 22:13'!
saturation
	"Return the saturation of this color, a value between 0.0 and 1.0."
	| r g b max min |
	r := self privateRed.
	g := self privateGreen.
	b := self privateBlue.
	max := min := r.
	g > max ifTrue: [ max := g ].
	b > max ifTrue: [ max := b ].
	g < min ifTrue: [ min := g ].
	b < min ifTrue: [ min := b ].
	max = 0 
		ifTrue: [ ^ 0.0 ]
		ifFalse: [ ^ (max - min) asFloat / max asFloat ]! !

!Color methodsFor: 'conversions' stamp: 'StephaneDucasse 10/15/2013 22:13'!
closestPixelValue4
	"Return the nearest approximation to this color for a 4-bit deep Form."
	"fast special cases"
	| bIndex |
	rgb = 0 ifTrue: [ ^ 1 ].	"black"
	rgb = 1073741823 ifTrue: [ ^ 2 ].	"opaque white"
	rgb = self class red privateRGB ifTrue: [ ^ 4 ].
	rgb = self class green privateRGB ifTrue: [ ^ 5 ].
	rgb = self class blue privateRGB ifTrue: [ ^ 6 ].
	rgb = self class cyan privateRGB ifTrue: [ ^ 7 ].
	rgb = self class yellow privateRGB ifTrue: [ ^ 8 ].
	rgb = self class magenta privateRGB ifTrue: [ ^ 9 ].
	bIndex := (self luminance * 8.0) rounded.	"bIndex in [0..8]"
	^ #(1 10 11 12 3 13 14 15 2 ) at: bIndex + 1	"black"	"1/8 gray"	"2/8 gray"	"3/8 gray"	"4/8 gray"	"5/8 gray"	"6/8 gray"	"7/8 gray"	"opaque white"! !

!Color methodsFor: 'private' stamp: 'StephaneDucasse 10/15/2013 22:13'!
attemptToMutateError
	"A color is immutable. Once a color's red, green, and blue have been initialized, you cannot change them. Instead, create a new Color and use it."

	self error: 'Color objects are immutable once created'
! !

!Color methodsFor: 'conversions' stamp: 'StephaneDucasse 10/16/2013 14:36'!
initializePrivateRed: r green: g blue: b 
	"Initialize this color's r, g, and b components to the given values in the range [0..ComponentMax].  Encoded in a single variable as 3 integers in [0..1023]."
	rgb == nil ifFalse: [ self attemptToMutateError ].
	rgb := ((r 
		min: ComponentMask
		max: 0) bitShift: RedShift) + ((g 
			min: ComponentMask
			max: 0) bitShift: GreenShift) + (b 
			min: ComponentMask
			max: 0).
	cachedDepth := nil.
	cachedBitPattern := nil! !

!Color methodsFor: 'transformations' stamp: 'StephaneDucasse 10/15/2013 22:43'!
blacker
	
	^ self alphaMixed: 0.8333 with: self class black
! !

!Color methodsFor: 'recategorized' stamp: 'StephaneDucasse 10/15/2013 22:13'!
fillRectangle: aRectangle on: aCanvas
	"Fill the given rectangle on the given canvas with the receiver."
	
	aCanvas fillRectangle: aRectangle basicFillStyle: self! !

!Color methodsFor: 'transformations' stamp: 'AliakseiSyrel 3/21/2015 00:05'!
* aNumberOrArray
	"Answer this color with its RGB multiplied by the given number, or
	 multiply this color's RGB values by the corresponding entries in the
	given array."
	"(self brown * 2) display"
	"(self brown * #(1 0 1)) display"
	| multipliers |
	multipliers := aNumberOrArray isCollection
		ifTrue: [aNumberOrArray]
		ifFalse:
			[Array
				with: aNumberOrArray
				with: aNumberOrArray
				with: aNumberOrArray].

	^ self class basicNew
		setPrivateRed: (self privateRed * multipliers first) asInteger
		green: (self privateGreen * multipliers second) asInteger
		blue: (self privateBlue * multipliers third) asInteger;
		setAlpha: self alpha! !

!Color methodsFor: 'transformations' stamp: 'StephaneDucasse 10/16/2013 14:59'!
quiteBlacker

	^ self alphaMixed: 0.8 with: (ColorRegistry at: #black)! !

!Color methodsFor: 'groups of shades' stamp: 'StephaneDucasse 10/15/2013 22:13'!
darkShades: thisMany
	"An array of thisMany colors from black to the receiver.  Array is of length num. Very useful for displaying color based on a variable in your program.  "
	"Color showColors: (Color red darkShades: 12)"

	^ self class black mix: self shades: thisMany
! !

!Color methodsFor: 'private' stamp: 'StephaneDucasse 10/15/2013 22:13'!
privateBlue
	"Private!! Return the internal representation of my blue component."

	^ rgb bitAnd: ComponentMask! !

!Color methodsFor: 'conversions' stamp: 'StephaneDucasse 10/16/2013 14:58'!
pixelWordForDepth: depth 
	"Return to a 32-bit word that concatenates enough copies of the receiver's pixel value to fill the word (i.e., 32/depth copies). Depth should be one of 1, 2, 4, 8, 16, or 32. The pixel value should be an integer in 0..2^depth-1."
	| pixelValue basicPixelWord |
	self isTransparent ifTrue: [ ^ 0 ].
	pixelValue := self pixelValueForDepth: depth.
	basicPixelWord := self pixelWordFor: depth filledWith: pixelValue.
	^ depth < 32 
		ifTrue: [ basicPixelWord ]
		ifFalse: [ (basicPixelWord bitAnd: 16777215) bitOr: (alpha bitShift: 24) ]! !

!Color methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 11/29/2014 17:27'!
asRGBInteger

	^(self red * 255) asInteger + ((self green * 255) asInteger << 8) + ((self blue * 255) asInteger << 16)! !

!Color methodsFor: 'transformations' stamp: 'StephaneDucasse 10/15/2013 22:13'!
darker
	"Answer a darker shade of this color."

	^ self adjustBrightness: -0.08! !

!Color methodsFor: 'conversions' stamp: 'StephaneDucasse 10/15/2013 22:13'!
closestPixelValue8
	"Return the nearest approximation to this color for an 8-bit deep Form."

	"fast special cases"
	rgb = 0 ifTrue: [^ 1].  "black"
	rgb = 16r3FFFFFFF ifTrue: [^ 255].  "white"

	self saturation < 0.2 ifTrue: [
		^ GrayToIndexMap at: (self privateGreen >> 2) + 1.  "nearest gray"
	] ifFalse: [
		"compute nearest entry in the color cube"
		^ 40 +
		  ((((self privateRed * 5) + HalfComponentMask) // ComponentMask) * 36) +
		  ((((self privateBlue * 5) + HalfComponentMask) // ComponentMask) * 6) +
		  (((self privateGreen * 5) + HalfComponentMask) // ComponentMask)].
! !

!Color methodsFor: 'conversions' stamp: 'StephaneDucasse 10/15/2013 22:13'!
closestPixelValue2
	"Return the nearest approximation to this color for a 2-bit deep Form."
	"fast special cases"
	| lum |
	rgb = 0 ifTrue: [ ^ 1 ].	"black"
	rgb = 1073741823 ifTrue: [ ^ 2 ].	"opaque white"
	lum := self luminance.
	lum < 0.2 ifTrue: [ ^ 1 ].	"black"
	lum > 0.6 ifTrue: [ ^ 2 ].	"opaque white"
	^ 3	"50% gray"! !

!Color methodsFor: 'accessing' stamp: 'StephaneDucasse 10/15/2013 22:30'!
alpha
	"Return my alpha value, a number between 0.0 and 1.0 where 0.0 is completely transparent and 1.0 is completely opaque."

	^ alpha asFloat / 255.0! !

!Color methodsFor: 'transformations' stamp: 'StephaneDucasse 10/15/2013 22:30'!
adjustSaturation: saturation brightness: brightness
	"Adjust the relative saturation and brightness of this color. (lowest value is 0.005 so that hue information is not lost)"

	^ self class
		h: self hue
		s: (self saturation + saturation min: 1.0 max: 0.005)
		v: (self brightness + brightness min: 1.0 max: 0.005)
		alpha: self alpha! !

!Color methodsFor: 'conversions' stamp: 'StephaneDucasse 10/16/2013 14:37'!
intializeHue: hue saturation: saturation brightness: brightness alpha: anAlpha 
	"Initialize this color to the given hue, saturation, and brightness. See the comment in the instance creation method for details."
	| s v hf i f p q t |
	
	rgb == nil ifFalse: [ self attemptToMutateError ].
	
	s := (saturation asFloat max: 0.0) min: 1.0.
	v := (brightness asFloat max: 0.0) min: 1.0.

	"zero saturation yields gray with the given brightness"
	s = 0.0 ifTrue: 
		[ ^ self 
			initializeRed: v
			green: v
			blue: v
			alpha: anAlpha ].
		
	hf := hue asFloat.
	(hf < 0.0 or: [ hf >= 360.0 ]) ifTrue: [ hf := hf - ((hf quo: 360.0) asFloat * 360.0) ].
	hf := hf / 60.0.
	i := hf asInteger.	"integer part of hue"
	f := hf fractionPart.	"fractional part of hue"
	p := (1.0 - s) * v.
	q := (1.0 - (s * f)) * v.
	t := (1.0 - (s * (1.0 - f))) * v.
	0 = i ifTrue: 
		[ ^ self 
			initializeRed: v
			green: t
			blue: p
			alpha: anAlpha ].
	
	1 = i ifTrue: 
		[ ^ self 
			initializeRed: q
			green: v
			blue: p
			alpha: anAlpha ].
	2 = i ifTrue: 
		[ ^ self 
			initializeRed: p
			green: v
			blue: t
			alpha: anAlpha ]
		.
	3 = i ifTrue: 
		[ ^ self 
			initializeRed: p
			green: q
			blue: v 
			alpha: anAlpha ].
	4 = i ifTrue: 
		[ ^ self 
			initializeRed: t
			green: p
			blue: v
			alpha: anAlpha ].
	5 = i ifTrue: 
		[ ^ self 
			initializeRed: v
			green: p
			blue: q
			alpha: anAlpha ].
	self error: 'implementation error'! !

!Color methodsFor: 'queries' stamp: 'StephaneDucasse 10/15/2013 22:13'!
isSolidFill
	^true! !

!Color methodsFor: 'transformations' stamp: 'StephaneDucasse 10/15/2013 22:13'!
slightlyLighter

	^ self adjustSaturation: -0.01 brightness: 0.03! !

!Color methodsFor: 'conversions' stamp: 'StephaneDucasse 10/15/2013 22:45'!
contrastingForegroundColor
        "Make a foreground color contrasting with me"
        ^self luminance >= 0.5
                ifTrue: [self class black]
                ifFalse: [self class white]! !

!Color methodsFor: 'printing' stamp: 'MarcusDenker 7/17/2014 09:28'!
shortPrintString
	"Return a short (but less precise) print string for use where space is tight."

	| s |
	s := String new writeStream.
	s
		nextPutAll: '(';
		nextPutAll: self class name;
		nextPutAll: ' r: ';
		nextPutAll: (self red roundTo: 0.01) printString;
		nextPutAll: ' g: ';
		nextPutAll: (self green roundTo: 0.01) printString;
		nextPutAll: ' b: ';
		nextPutAll: (self blue roundTo: 0.01) printString;
		nextPutAll: ')'.
	^ s contents! !

!Color methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 11/18/2013 11:46'!
gtInspectorColorIn: composite
	<gtInspectorPresentationOrder: 30>
	composite morph 
		title: 'Color';
		display: [ BorderedMorph new color: self ]! !

!Color methodsFor: 'transformations' stamp: 'StephaneDucasse 10/15/2013 22:30'!
adjustBrightness: brightness
	"Adjust the relative brightness of this color. (lowest value is 0.005 so that hue information is not lost)"

	^ self class
		h: self hue
		s: self saturation
		v: (self brightness + brightness min: 1.0 max: 0.005)
		alpha: self alpha! !

!Color methodsFor: 'conversions' stamp: 'StephaneDucasse 10/16/2013 15:01'!
scaledPixelValue32
	"Return the alpha scaled pixel value for depth 32"
	| pv32 a b g r |

	pv32 := self pixelWordForDepth: 32 .
	a := (self alpha * 255.0) rounded.
	b := (pv32 bitAnd: 255) * a // 256.
	g := ((pv32 bitShift: -8) bitAnd: 255) * a // 256.
	r := ((pv32 bitShift: -16) bitAnd: 255) * a // 256.
	^ b + (g bitShift: 8) + (r bitShift: 16) + (a bitShift: 24)! !

!Color methodsFor: 'groups of shades' stamp: 'StephaneDucasse 10/15/2013 22:13'!
lightShades: thisMany
	"An array of thisMany colors from white to self. Very useful for displaying color based on a variable in your program.  "
	"Color showColors: (Color red lightShades: 12)"

	^ self class white mix: self shades: thisMany
! !

!Color methodsFor: 'conversions' stamp: 'StephaneDucasse 10/15/2013 22:13'!
pixelWordFor: depth filledWith: pixelValue 
	"Return to a 32-bit word that concatenates enough copies of the given pixel value to fill the word (i.e., 32/depth copies). Depth should be one of 1, 2, 4, 8, 16, or 32. The pixel value should be an integer in 0..2^depth-1."
	| halfword |
	depth = 32 ifTrue: [ ^ pixelValue ].
	depth = 16 
		ifTrue: [ halfword := pixelValue ]
		ifFalse: 
			[ halfword := pixelValue * (#(
					65535
					21845
					#-
					4369
					#-
					#-
					#-
					257
				) at: depth)	"replicates at every bit"	"replicates every 2 bits"	"replicates every 4 bits"	"replicates every 8 bits" ].
	^ halfword bitOr: (halfword bitShift: 16)! !

!Color methodsFor: 'transformations' stamp: 'StephaneDucasse 10/15/2013 22:13'!
twiceDarker
	"Answer a significantly darker shade of this color."

	^ self adjustBrightness: -0.15! !

!Color methodsFor: 'other' stamp: 'StephaneDucasse 10/15/2013 22:13'!
colorForInsets
	^ self! !

!Color methodsFor: 'queries' stamp: 'StephaneDucasse 10/16/2013 14:41'!
isTranslucentColor
	"This means: self isTranslucent, but isTransparent not"
	self flag: #toremove.
	^ false! !

!Color methodsFor: 'private' stamp: 'StephaneDucasse 10/15/2013 22:13'!
setRGB: rgb0 
	rgb == nil ifFalse: [ self attemptToMutateError ].
	rgb := rgb0! !

!Color methodsFor: 'queries' stamp: 'StephaneDucasse 10/15/2013 22:13'!
isColor

	^ true
! !

!Color methodsFor: 'transformations' stamp: 'StephaneDucasse 10/15/2013 22:13'!
orColorUnlike: theOther
	"If this color is a lot like theOther, then return its complement, otherwide, return self"

	^ (self diff: theOther) < 0.3
		ifTrue: [ theOther negated ]
		ifFalse: [ self ]! !

!Color methodsFor: 'groups of shades' stamp: 'StephaneDucasse 10/16/2013 14:42'!
mix: color2 shades: thisMany 
	"Return an array of thisMany colors from self to color2. Very useful for displaying color based on a variable in your program.  "
	"Color showColors: (Color red mix: Color green shades: 12)"
	| redInc greenInc blueInc out rr gg bb |
	thisMany = 1 ifTrue: [ ^ Array with: color2 ].
	redInc := (color2 red - self red) / (thisMany - 1).
	greenInc := (color2 green - self green) / (thisMany - 1).
	blueInc := (color2 blue - self blue) / (thisMany - 1).
	rr := self red.
	gg := self green.
	bb := self blue.
	out := (1 to: thisMany) collect: 
		[ :num | | c | 
		c := self class 
			r: rr
			g: gg
			b: bb.
		rr := rr + redInc.
		gg := gg + greenInc.
		bb := bb + blueInc.
		c ].
	out 
		at: out size
		put: color2.	"hide roundoff errors"
	^ out! !

!Color methodsFor: 'accessing' stamp: 'StephaneDucasse 10/15/2013 22:13'!
name
	^ self class registeredNameOf: self   ! !

!Color methodsFor: 'transformations' stamp: 'AliakseiSyrel 3/21/2015 00:05'!
/ aNumber
	"Answer this color with its RGB divided by the given number. "
	"(Color red / 2) display"

	^ self class basicNew
		setPrivateRed: (self privateRed / aNumber) asInteger
		green: (self privateGreen / aNumber) asInteger
		blue: (self privateBlue / aNumber) asInteger;
		setAlpha: self alpha
! !

!Color methodsFor: 'transformations' stamp: 'StephaneDucasse 10/16/2013 15:06'!
veryMuchLighter

	^ self alphaMixed: 0.1165 with: (ColorRegistry at: #white)
! !

!Color methodsFor: 'conversions' stamp: 'StephaneDucasse 10/15/2013 22:13'!
asColor
	"Convert the receiver into a color"
	^self! !

!Color methodsFor: 'transformations' stamp: 'StephaneDucasse 10/15/2013 22:13'!
muchLighter

	^ self alphaMixed: 0.233 with: Color white
! !

!Color methodsFor: 'transformations' stamp: 'StephaneDucasse 10/15/2013 22:13'!
duller
	"Answer a darker, desaturated color.  If the original color isn't very saturated, desaturate it by less (otherwise will just end up with grey)."
	
	| sat adjust |
	(sat := self saturation) > 0.3
		ifTrue: [adjust := -0.1]
		ifFalse: [adjust := 0.1 - sat max: 0.0].
	^ self adjustSaturation: adjust brightness: -0.1

	"^ self adjustSaturation: -0.03 brightness: -0.2"! !

!Color methodsFor: 'queries' stamp: 'StephaneDucasse 10/16/2013 14:39'!
isTranslucent

	^ alpha < 255 ! !

!Color methodsFor: 'transformations' stamp: 'StephaneDucasse 10/15/2013 22:13'!
lighter
	"Answer a lighter shade of this color."

	^ self adjustSaturation: -0.03 brightness: 0.08! !

!Color methodsFor: 'printing' stamp: 'StephaneDucasse 10/15/2013 22:13'!
storeArrayOn: aStream

	aStream nextPutAll: '#('.
	self storeArrayValuesOn: aStream.
	aStream nextPutAll: ') '
! !

!Color methodsFor: 'transformations' stamp: 'AliakseiSyrel 3/21/2015 14:29'!
- aColor
	"Answer aColor is subtracted from the given color in an additive color space.  "
	"(Color white - Color red) display"

	^ self class basicNew
		setPrivateRed: self privateRed - aColor privateRed
		green: self privateGreen - aColor privateGreen
		blue: self privateBlue - aColor  privateBlue;
		setAlpha: ((self = aColor) ifTrue: [ 0 ] ifFalse: [ self alpha ])
! !

!Color methodsFor: 'transformations' stamp: 'StephaneDucasse 10/15/2013 22:32'!
alphaMixed: proportion with: aColor 
	"Answer this color mixed with the given color. The proportion, a number 
	between 0.0 and 1.0, determines what what fraction of the receiver to  
	use in the mix. For example, 0.9 would yield a color close to the  
	receiver. This method uses RGB interpolation; HSV interpolation can lead 
	to surprises.  Mixes the alphas (for transparency) also."
	| frac1 frac2 |
	frac1 := proportion asFloat 
		min: 1.0
		max: 0.0.
	frac2 := 1.0 - frac1.
	^ self class 
		r: self red * frac1 + (aColor red * frac2)
		g: self green * frac1 + (aColor green * frac2)
		b: self blue * frac1 + (aColor blue * frac2)
		alpha: self alpha * frac1 + (aColor alpha * frac2)! !

!Color methodsFor: 'html' stamp: 'StephaneDucasse 10/15/2013 22:13'!
printHtmlString
	"answer a string whose characters are the html representation  
	of the receiver"
	^ ((self red * 255) asInteger printStringBase: 16 length: 2 padded: true)
	, ((self green * 255) asInteger printStringBase: 16 length: 2 padded: true)
	, ((self blue * 255) asInteger printStringBase: 16 length: 2 padded: true)! !

!Color methodsFor: 'copying' stamp: 'StephaneDucasse 10/15/2013 22:13'!
veryDeepCopyWith: deepCopier
	"Return self.  I am immutable in the Morphic world.  Do not record me."! !

!Color methodsFor: 'private' stamp: 'StephaneDucasse 10/16/2013 14:59'!
privateAlpha
	"Private!! Return the raw alpha value for opaque. Used only for equality testing."

	^ alpha ! !

!Color methodsFor: '*Athens-Core' stamp: 'IgorStasenko 8/30/2013 16:23'!
asAthensPaintOn: anAthensCanvas

	^ self
	
	"^ anAthensCanvas surface createSolidColorPaint: self"! !

!Color methodsFor: 'private' stamp: 'StephaneDucasse 10/15/2013 22:13'!
setHue: hue saturation: saturation brightness: brightness 
	"Initialize this color to the given hue, saturation, and brightness. See the comment in the instance creation method for details."
	| s v hf i f p q t |
	s := (saturation asFloat max: 0.0) min: 1.0.
	v := (brightness asFloat max: 0.0) min: 1.0.

	"zero saturation yields gray with the given brightness"
	s = 0.0 ifTrue: 
		[ ^ self 
			setRed: v
			green: v
			blue: v ].
	hf := hue asFloat.
	(hf < 0.0 or: [ hf >= 360.0 ]) ifTrue: [ hf := hf - ((hf quo: 360.0) asFloat * 360.0) ].
	hf := hf / 60.0.
	i := hf asInteger.	"integer part of hue"
	f := hf fractionPart.	"fractional part of hue"
	p := (1.0 - s) * v.
	q := (1.0 - (s * f)) * v.
	t := (1.0 - (s * (1.0 - f))) * v.
	0 = i ifTrue: 
		[ ^ self 
			setRed: v
			green: t
			blue: p ].
	1 = i ifTrue: 
		[ ^ self 
			setRed: q
			green: v
			blue: p ].
	2 = i ifTrue: 
		[ ^ self 
			setRed: p
			green: v
			blue: t ].
	3 = i ifTrue: 
		[ ^ self 
			setRed: p
			green: q
			blue: v ].
	4 = i ifTrue: 
		[ ^ self 
			setRed: t
			green: p
			blue: v ].
	5 = i ifTrue: 
		[ ^ self 
			setRed: v
			green: p
			blue: q ].
	self error: 'implementation error'! !

!Color methodsFor: 'transformations' stamp: 'StephaneDucasse 10/16/2013 14:42'!
mixed: proportion with: aColor 
	"Mix with another color and do not preserve transpareny.  Only use this for extracting the RGB value and mixing it.  All other callers should use instead: 
	aColor alphaMixed: proportion with: anotherColor
	"
	| frac1 frac2 |
	frac1 := proportion asFloat 
		min: 1.0
		max: 0.0.
	frac2 := 1.0 - frac1.
	^ self class 
		r: self red * frac1 + (aColor red * frac2)
		g: self green * frac1 + (aColor green * frac2)
		b: self blue * frac1 + (aColor blue * frac2)! !

!Color methodsFor: 'comparing' stamp: 'StephaneDucasse 10/15/2013 22:46'!
hash

	^ rgb bitXor: alpha ! !

!Color methodsFor: 'conversions' stamp: 'NicolaiHess 8/6/2014 23:59'!
asColorref
	"Convert the receiver into a colorref"
	^(self red * 255) asInteger + ((self green * 255) asInteger << 8) + ((self blue * 255) asInteger << 16)! !

!Color methodsFor: '*Morphic-Base' stamp: 'StephaneDucasse 10/15/2013 22:13'!
changeColorIn: aMorph event: evt
	"Note: This is just a workaround to make sure we don't use the old color inst var"
	aMorph changeColorTarget: aMorph selector: #fillStyle: originalColor: self hand: evt hand! !

!Color methodsFor: 'conversions' stamp: 'StephaneDucasse 10/15/2013 22:13'!
asHTMLColor
	| s |
	s := '#000000' copy.
	s at: 2 put: (Character digitValue: ((rgb bitShift: -6 - RedShift) bitAnd: 15)).
	s at: 3 put: (Character digitValue: ((rgb bitShift: -2 - RedShift) bitAnd: 15)).
	s at: 4 put: (Character digitValue: ((rgb bitShift: -6 - GreenShift) bitAnd: 15)).
	s at: 5 put: (Character digitValue: ((rgb bitShift: -2 - GreenShift) bitAnd: 15)).
	s at: 6 put: (Character digitValue: ((rgb bitShift: -6 - BlueShift) bitAnd: 15)).
	s at: 7 put: (Character digitValue: ((rgb bitShift: -2 - BlueShift) bitAnd: 15)).
	^ s! !

!Color methodsFor: 'conversions' stamp: 'StephaneDucasse 10/15/2013 22:13'!
halfTonePattern2
	"Return a halftone-pattern to approximate luminance levels on 2-bit deep Forms."
	| lum |
	lum := self luminance.
	lum < 0.125 ifTrue: [ ^ Bitmap with: 1431655765 ].	"black"
	lum < 0.25 ifTrue: 
		[ ^ Bitmap 
			with: 1431655765
			with: 3722304989 ].	"1/8 gray"
	lum < 0.375 ifTrue: 
		[ ^ Bitmap 
			with: 3722304989
			with: 2004318071 ].	"2/8 gray"
	lum < 0.5 ifTrue: 
		[ ^ Bitmap 
			with: 4294967295
			with: 2004318071 ].	"3/8 gray"
	lum < 0.625 ifTrue: [ ^ Bitmap with: 4294967295 ].	"4/8 gray"
	lum < 0.75 ifTrue: 
		[ ^ Bitmap 
			with: 4294967295
			with: 3149642683 ].	"5/8 gray"
	lum < 0.875 ifTrue: 
		[ ^ Bitmap 
			with: 4008636142
			with: 3149642683 ].	"6/8 gray"
	lum < 1.0 ifTrue: 
		[ ^ Bitmap 
			with: 2863311530
			with: 3149642683 ].	"7/8 gray"
	^ Bitmap with: 2863311530	"opaque white"

	"handy expression for computing patterns for 2x2 tiles;
 set p to a string of 4 letters (e.g., 'wggw' for a gray-and-
 white checkerboard) and print the result of evaluating:
| p d w1 w2 |
p := 'wggw'.
d := Dictionary new.
d at: $b put: '01'.
d at: $w put: '10'.
d at: $g put: '11'.
w1 := (d at: (p at: 1)), (d at: (p at: 2)).
w1 := '2r', w1, w1, w1, w1, w1, w1, w1, w1, ' hex'.
w2 := (d at: (p at: 3)), (d at: (p at: 4)).
w2 := '2r', w2, w2, w2, w2, w2, w2, w2, w2, ' hex'.
Array with: (Compiler evaluate: w1) with: (Compiler evaluate: w2) 
"! !

!Color methodsFor: 'conversions' stamp: 'StephaneDucasse 10/16/2013 14:54'!
basicPixelValueForDepth: d 
	"Returns an integer representing the bits that appear in a single pixel of this color in a Form of the given depth. The depth must be one of 1, 2, 4, 8, 16, or 32. Contrast with pixelWordForDepth: and bitPatternForDepth:, which return either a 32-bit word packed with the given pixel value or a multiple-word Bitmap containing a pattern. The inverse is the class message colorFromPixelValue:depth:"
	"Details: For depths of 8 or less, the result is a colorMap index. For depths of 16 and 32, it is a direct color value with 5 or 8 bits per color component."
	"Transparency: The pixel value zero is reserved for transparent. For depths greater than 8, black maps to the darkest possible blue."
	| rgbBlack val |
	d = 8 ifTrue: [ ^ self closestPixelValue8 ].	"common case"
	d < 8 ifTrue: 
		[ d = 4 ifTrue: [ ^ self closestPixelValue4 ].
		d = 2 ifTrue: [ ^ self closestPixelValue2 ].
		d = 1 ifTrue: [ ^ self closestPixelValue1 ] ].
	rgbBlack := 1.	"closest black that is not transparent in RGB"
	d = 16 ifTrue: 
		[ "five bits per component; top bits ignored"
		val := (((rgb bitShift: -15) bitAnd: 31744) bitOr: ((rgb bitShift: -10) bitAnd: 992)) bitOr: ((rgb bitShift: -5) bitAnd: 31).
		^ val = 0 
			ifTrue: [ rgbBlack ]
			ifFalse: [ val ] ].
	d = 32 ifTrue: 
		[ "eight bits per component; top 8 bits set to all ones (opaque alpha)"
		val := LargePositiveInteger new: 4.
		val 
			at: 3
			put: ((rgb bitShift: -22) bitAnd: 255).
		val 
			at: 2
			put: ((rgb bitShift: -12) bitAnd: 255).
		val 
			at: 1
			put: ((rgb bitShift: -2) bitAnd: 255).
		val 
			at: 4
			put: 255.	"opaque alpha"
		^ val ].
	d = 12 ifTrue: 
		[ "for indexing a color map with 4 bits per color component"
		val := (((rgb bitShift: -18) bitAnd: 3840) bitOr: ((rgb bitShift: -12) bitAnd: 240)) bitOr: ((rgb bitShift: -6) bitAnd: 15).
		^ val = 0 
			ifTrue: [ rgbBlack ]
			ifFalse: [ val ] ].
	d = 9 ifTrue: 
		[ "for indexing a color map with 3 bits per color component"
		val := (((rgb bitShift: -21) bitAnd: 448) bitOr: ((rgb bitShift: -14) bitAnd: 56)) bitOr: ((rgb bitShift: -7) bitAnd: 7).
		^ val = 0 
			ifTrue: [ rgbBlack ]
			ifFalse: [ val ] ].
	self error: 'unknown pixel depth: ' , d printString! !

!Color methodsFor: 'private' stamp: 'StephaneDucasse 10/15/2013 22:13'!
privateGreen
	"Private!! Return the internal representation of my green component."

	^ (rgb bitShift: 0 - GreenShift) bitAnd: ComponentMask! !

!Color methodsFor: '*Athens-Core' stamp: 'IgorStasenko 8/30/2013 16:49'!
athensFillRectangle: aRect on: anAthensCanvas

	^ anAthensCanvas surface fillRectangle: aRect withSolidColor:self! !

!Color methodsFor: 'conversions' stamp: 'StephaneDucasse 10/15/2013 22:13'!
halfTonePattern1
	"Return a halftone-pattern to approximate luminance levels on 1-bit deep Forms."
	| lum |
	lum := self luminance.
	lum < 0.1 ifTrue: [ ^ Bitmap with: 4294967295 ].	"black"
	lum < 0.4 ifTrue: 
		[ ^ Bitmap 
			with: 3149642683
			with: 4008636142 ].	"dark gray"
	lum < 0.6 ifTrue: 
		[ ^ Bitmap 
			with: 1431655765
			with: 2863311530 ].	"medium gray"
	lum < 0.9 ifTrue: 
		[ ^ Bitmap 
			with: 1145324612
			with: 286331153 ].	"light gray"
	^ Bitmap with: 0	"1-bit white"! !

!Color methodsFor: 'transformations' stamp: 'StephaneDucasse 10/16/2013 15:04'!
slightlyWhiter

	^ self alphaMixed: 0.85 with: (ColorRegistry at: #white)
! !

!Color methodsFor: 'transformations' stamp: 'StephaneDucasse 10/15/2013 22:46'!
dansDarker
	"Return a darker shade of the same color.
	An attempt to do better than the current darker method.
	(now obsolete, since darker has been changed to do this. -dew)"
	^ self class 
		h: self hue s: self saturation v: (self brightness - 0.16 max: 0.0)! !

!Color methodsFor: '*Athens-Core' stamp: 'NicolaiHess 6/24/2014 22:50'!
strokePath: aPath on: aCanvas strokeWidth: width
	^ (aCanvas surface createSolidColorPaint: self) strokePath: aPath on: aCanvas strokeWidth: width! !

!Color methodsFor: 'self evaluating' stamp: 'StephaneDucasse 10/15/2013 22:13'!
isSelfEvaluating
	^ true! !

!Color methodsFor: '*Athens-Core' stamp: 'NicolaiHess 6/24/2014 22:53'!
strokeRect: aRect on: aCanvas strokeWidth: width
	^ (aCanvas surface createSolidColorPaint: self) strokeRect: aRect on: aCanvas strokeWidth: width! !

!Color class methodsFor: 'other' stamp: 'FernandoOlivero 9/17/2013 21:35'!
indexedColors

	^ IndexedColors! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:35'!
darkGray
	^ ColorRegistry at: #darkGray! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:36'!
lightYellow
	^  ColorRegistry at: #lightYellow! !

!Color class methodsFor: 'accesing' stamp: 'FernandoOlivero 9/17/2013 21:35'!
named: aColorName
	
	^ ColorRegistry  at: aColorName asSymbol ifAbsent: nil ! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:36'!
paleRed
	^  ColorRegistry at: #paleRed! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:35'!
brown
	^ ColorRegistry at: #brown! !

!Color class methodsFor: 'other' stamp: 'FernandoOlivero 9/17/2013 21:35'!
maskingMap: depth 
	"Return a color map that maps all colors except transparent to words of all ones. Used to create a mask for a Form whose transparent pixel value is zero. Cache the most recently used map."
	| sizeNeeded |
	depth <= 8 
		ifTrue: [ sizeNeeded := 1 bitShift: depth ]
		ifFalse: [ sizeNeeded := 4096 ].
	(MaskingMap == nil or: [ MaskingMap size ~= sizeNeeded ]) ifTrue: 
		[ MaskingMap := Bitmap 
			new: sizeNeeded
			withAll: 4294967295.
		MaskingMap 
			at: 1
			put: 0	"transparent" ].
	^ MaskingMap! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:36'!
palePeach
	^  ColorRegistry at: #palePeach ! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:36'!
paleTan
	^  ColorRegistry at: #paleTan! !

!Color class methodsFor: 'initialization' stamp: 'StephaneDucasse 10/16/2013 15:20'!
initialize
	"self initialize
	
	Details: Externally, the red, green, and blue components of color
	are floats in the range [0.0..1.0]. Internally, they are represented
	as integers in the range [0..ComponentMask] packing into a
	small integer to save space and to allow fast hashing and
	equality testing.

	For a general description of color representations for computer
	graphics, including the relationship between the RGB and HSV
	color models used here, see Chapter 17 of Foley and van Dam,
	Fundamentals of Interactive Computer Graphics, Addison-Wesley,
	1982."
	ComponentMask := 1023.
	HalfComponentMask := 512.	"used to round up in integer calculations"
	ComponentMax := 1023.0.	"a Float used to normalize components"
	RedShift := 20.
	GreenShift := 10.
	BlueShift := 0.
	RandomStream := Random new.
	self initializeIndexedColors.
	self initializeColorRegistry.
	self initializeGrayToIndexMap.
	! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:37'!
veryPaleRed
	^  ColorRegistry at: #veryPaleRed! !

!Color class methodsFor: 'instance creation' stamp: 'StephaneDucasse 10/16/2013 15:19'!
gray: brightness
	"Return a gray shade with the given brightness in the range [0.0..1.0]."

	^ self r: brightness g: brightness b: brightness
! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:37'!
veryDarkGray
	^ ColorRegistry at: #veryDarkGray! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:37'!
yellow
	 ^  ColorRegistry at: #yellow! !

!Color class methodsFor: 'instance creation' stamp: 'StephaneDucasse 10/16/2013 15:20'!
h: hue s: saturation v: brightness alpha: alpha
	^ self basicNew
		intializeHue: hue saturation: saturation brightness: brightness alpha: alpha ;
		yourself 
	! !

!Color class methodsFor: 'instance creation' stamp: 'VincentBlondeau 1/30/2015 17:36'!
colorFromPixelValue: p depth: d 
	"Convert a pixel value for the given display depth into a color."
	"Details: For depths of 8 or less, the pixel value is simply looked up in a table. For greater depths, the color components are extracted and converted into a color."
	| r g b alpha |
	d = 8 ifTrue: [ ^ IndexedColors at: (p bitAnd: 255) + 1 ].
	d = 4 ifTrue: [ ^ IndexedColors at: (p bitAnd: 15) + 1 ].
	d = 2 ifTrue: [ ^ IndexedColors at: (p bitAnd: 3) + 1 ].
	d = 1 ifTrue: [ ^ IndexedColors at: (p bitAnd: 1) + 1 ].
	d = 16 | (d = 15) ifTrue: 
		[ "five bits per component"
		r := (p bitShift: -10) bitAnd: 31.
		g := (p bitShift: -5) bitAnd: 31.
		b := p bitAnd: 31.
		(r = 0 and: [ g = 0 ]) ifTrue: 
			[ b = 0 ifTrue: [ ^ self transparent ].
			b = 1 ifTrue: [ ^ self black ] ].
		^ self 
			r: r
			g: g
			b: b
			range: 31 ].
	d = 32 ifTrue: 
		[ "eight bits per component; 8 bits of alpha"
		r := (p bitShift: -16) bitAnd: 255.
		g := (p bitShift: -8) bitAnd: 255.
		b := p bitAnd: 255.
		alpha := p bitShift: -24.
		alpha = 0 ifTrue: [ ^ self transparent ].
		alpha < 255 
			ifTrue: 
				[ ^ (self 
					r: r
					g: g
					b: b
					range: 255) alpha: alpha asFloat / 255.0 ]
			ifFalse: 
				[ ^ self 
					r: r
					g: g
					b: b
					range: 255 ] ].
	d = 12 ifTrue: 
		[ "four bits per component"
		r := (p bitShift: -8) bitAnd: 15.
		g := (p bitShift: -4) bitAnd: 15.
		b := p bitAnd: 15.
		^ self 
			r: r
			g: g
			b: b
			range: 15 ].
	d = 9 ifTrue: 
		[ "three bits per component"
		r := (p bitShift: -6) bitAnd: 7.
		g := (p bitShift: -3) bitAnd: 7.
		b := p bitAnd: 7.
		^ self 
			r: r
			g: g
			b: b
			range: 7 ].
	self error: 'unknown pixel depth: ' , d printString! !

!Color class methodsFor: 'instance creation' stamp: 'StephaneDucasse 10/16/2013 15:18'!
fromArray: colorDef
	colorDef size = 3
			ifTrue: [^self r: (colorDef at: 1) g: (colorDef at: 2) b: (colorDef at: 3)].
	colorDef size = 0
			ifTrue: [^self transparent].
	colorDef size = 4
			ifTrue: [^(self r: (colorDef at: 1) g: (colorDef at: 2) b: (colorDef at: 3)) alpha: (colorDef at: 4)].
	self error: 'Undefined color definition'! !

!Color class methodsFor: 'initialization' stamp: 'StephaneDucasse 10/16/2013 15:21'!
initializeColorRegistry 
	| values|
	ColorRegistry := IdentityDictionary new.
	values := self defaultColors, self defaultColors2, self defaultColors3, self defaultColors4.
	1 to: values size by: #(name r g b) size do:[:index|
		|  colorName red green blue color |
		colorName := values at: index.
		red := values at: index + 1.
		green := values at: index + 2.
		blue := values at: index +3.
		color :=  self  r: red g: green b: blue .
		self registerColor: color named: colorName ].
	self registerColor: (self r: 0 g: 0 b: 0 alpha: 0.0) named: #transparent. ! !

!Color class methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 3/21/2015 20:53'!
brickColorRegistry

	^ ColorRegistry! !

!Color class methodsFor: 'colormaps' stamp: 'FernandoOlivero 9/17/2013 21:35'!
computeColormapFrom: sourceDepth to: destDepth 
	"Compute a colorMap for translating between the given depths. A colormap is a Bitmap whose entries contain the pixel values for the destination depth. Typical clients use cachedColormapFrom:to: instead."
	| map bitsPerColor |
	sourceDepth < 16 
		ifTrue: 
			[ "source is 1-, 2-, 4-, or 8-bit indexed color"
			map := (IndexedColors 
				copyFrom: 1
				to: (1 bitShift: sourceDepth)) collect: [ :c | c pixelValueForDepth: destDepth ].
			map := map as: Bitmap ]
		ifFalse: 
			[ "source is 16-bit or 32-bit RGB"
			destDepth > 8 
				ifTrue: [ bitsPerColor := 5	"retain maximum color resolution" ]
				ifFalse: [ bitsPerColor := 4 ].
			map := self 
				computeRGBColormapFor: destDepth
				bitsPerColor: bitsPerColor ].

	"Note: zero is transparent except when source depth is one-bit deep"
	sourceDepth > 1 ifTrue: 
		[ map 
			at: 1
			put: 0 ].
	^ map! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:35'!
green
	^ ColorRegistry at: #green! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:36'!
paleYellow
	^  ColorRegistry at: #paleYellow.! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:34'!
black
	^ ColorRegistry at: #black! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:36'!
magenta
	^ ColorRegistry at: #magenta! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:37'!
veryVeryLightGray
	^  ColorRegistry at: #veryVeryLightGray! !

!Color class methodsFor: 'examples' stamp: 'StephaneDucasse 10/16/2013 15:27'!
wheel: thisMany saturation: s brightness: v
	"Return a collection of thisMany colors evenly spaced around the color wheel, all of the given saturation and brightness."
	"Color showColors: (Color wheel: 12 saturation: 0.4 brightness: 1.0)"
	"Color showColors: (Color wheel: 12 saturation: 0.8 brightness: 0.5)"

	^ (self h: 0.0 s: s v: v) wheel: thisMany
! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:36'!
paleOrange
	^  ColorRegistry at: #paleOrange! !

!Color class methodsFor: 'accessing' stamp: 'StephaneDucasse 10/16/2013 15:25'!
registeredColorNames
	^ ColorRegistry keys collect: #asString ! !

!Color class methodsFor: 'colormaps' stamp: 'StephaneDucasse 10/16/2013 15:15'!
computeIndexedColorConvertingMap: targetColor from: sourceDepth to: destDepth 
	| map |
	map := (IndexedColors 
		copyFrom: 1
		to: (1 bitShift: sourceDepth)) collect: 
		[ :cc | | f c | 
		f := 1.0 - ((cc red + cc green + cc blue) / 3.0).
		c := targetColor notNil 
			ifTrue: 
				[ destDepth = 32 
					ifTrue: [ targetColor * f alpha: f ]
					ifFalse: 
						[ targetColor 
							alphaMixed: f * 1.5
							with: self white ] ]
			ifFalse: [ cc ].
		destDepth = 32 
			ifTrue: [ c pixelValueForDepth: destDepth ]
			ifFalse: 
				[ f = 0.0 
					ifTrue: [ 0 ]
					ifFalse: [ c pixelValueForDepth: destDepth ] ] ].
	map := map as: Bitmap.
	^ map! !

!Color class methodsFor: 'instance creation' stamp: 'StephaneDucasse 10/16/2013 15:24'!
r: r g: g b: b alpha: alpha
"Return a color with the given r, g, and b components in the range [0.0..1.0]."
	^ self basicNew
		initializeRed: r green: g blue: b alpha: alpha ;
		yourself.! !

!Color class methodsFor: 'colormaps' stamp: 'FernandoOlivero 9/17/2013 21:35'!
computeColorConvertingMap: targetColor from: sourceDepth to: destDepth keepSubPixelAA: keepSubPix

	sourceDepth < 16 ifTrue: [
		"source is 1-, 2-, 4-, or 8-bit indexed color.
		Assumed not to include subpixelAA"
		^ self computeIndexedColorConvertingMap: targetColor from: sourceDepth to: destDepth
	] ifFalse: [
		"source is 16-bit or 32-bit RGB.
		Might include subpixelAA"
		^ self computeRGBColorConvertingMap: targetColor to: destDepth keepSubPixelAA: keepSubPix
	]! !

!Color class methodsFor: 'instance creation' stamp: 'FernandoOlivero 9/17/2013 21:35'!
fromHexString: aColorHex
	| green red blue |
	red := (Integer readFrom: (aColorHex first: 2) base: 16) / 255.
	green := (Integer readFrom: (aColorHex copyFrom: 3 to: 4) base: 16) / 255.
	blue := (Integer readFrom: (aColorHex last: 2) base: 16) / 255.
	^self r: red g: green b: blue! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:35'!
lightCyan
	^  ColorRegistry at: #lightCyan! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:57'!
transparent
  ^   ColorRegistry at: #transparent ! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:36'!
paleMagenta
	^  ColorRegistry at: #paleMagenta! !

!Color class methodsFor: 'instance creation' stamp: 'MarcusDenker 3/27/2014 11:02'!
colorFrom: parm
	"Return an instantiated color from parm.  If parm is already a color, return it, else return the result of my performing it if it's a symbol or, if it is a list, it can either be an array of three numbers, which will be interpreted as RGB values, or a list of symbols, the first of which is sent to me and then the others of which are in turn sent to the prior result, thus allowing entries of the form #(blue darker).  Else just return the thing"

	| aColor firstParm |
	(parm isKindOf: Color) ifTrue: [^ parm].
	(parm isSymbol) ifTrue: [^ self perform: parm].
	(parm isString) ifTrue: [^ self fromString: parm].
	((parm isKindOf: SequenceableCollection) and: [parm size > 0])
		ifTrue:
			[firstParm := parm first.
			(firstParm isKindOf: Number) ifTrue:
				[^ self fromRgbTriplet: parm].
			aColor := self colorFrom: firstParm.
			parm doWithIndex:
				[:sym :ind | ind > 1 ifTrue:
					[aColor := aColor perform: sym]].
			^ aColor].
	^ parm

"
Color colorFrom: #(blue darker)
Color colorFrom: Color blue darker
Color colorFrom: #blue
Color colorFrom: #(0.0 0.0 1.0)
"! !

!Color class methodsFor: 'colormaps' stamp: 'StephaneDucasse 10/18/2013 14:33'!
aaFontsColormapDepth
	"Adjust balance between colored AA text quality (especially if subpixel AA is used) and space / performance.
	5 is optimal quality. Each colorMap takes 128kB of RAM, and takes several seconds to build.
	4 is a reasonable balance. Each colorMap takes 16kB of RAM and builds fast on a fast machine.
	3 is good for slow hardware or memory restrictions. Each colorMap takes 2 kb of RAM."
	^ 4! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:27'!
defaultColors4
	^{
	#paleRed. 1.0. 0.901. 0.901.
	#palePeach. 1.0. 0.929. 0.835.
	#paleOrange. 0.991. 0.929. 0.843.
	#paleMagenta. 1.0. 0.901. 1.0.
	#paleGreen. 0.874. 1.0. 0.835.
	#paleBuff. 0.995. 0.979. 0.921.
	#paleBlue. 0.87. 0.976. 0.995.
		}! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:36'!
lightGreen
	^ ColorRegistry at: #lightGreen! !

!Color class methodsFor: 'other' stamp: 'FernandoOlivero 9/17/2013 21:35'!
pixelScreenForDepth: depth 
	"Return a 50% stipple containing alternating pixels of all-zeros and all-ones to be used as a mask at the given depth."
	| mask bits |
	mask := (1 bitShift: depth) - 1.
	bits := 2 * depth.
	[ bits >= 32 ] whileFalse: 
		[ mask := mask bitOr: (mask bitShift: bits).	"double the length of mask"
		bits := bits + bits ].
	^ Bitmap 
		with: mask
		with: mask bitInvert32! !

!Color class methodsFor: 'instance creation' stamp: 'StephaneDucasse 10/16/2013 15:25'!
random
	"Return a random color that isn't too dark or under-saturated."

	^ self 
		h: (360.0 * RandomStream next)
		s: (0.3 + (RandomStream next * 0.7))
		v: (0.4 + (RandomStream next * 0.6))
		alpha: 1.0! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:36'!
orange
	^ ColorRegistry at: #orange! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:36'!
paleBuff
	^  ColorRegistry at: #paleBuff! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:37'!
red
	^  ColorRegistry at: #red! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:27'!
defaultColors2
	^{	#red. 1.0. 0. 0.
		#yellow. 1.0. 1.0. 0.
		#green. 0. 1.0. 0.
		#cyan. 0. 1.0. 1.0.
		#blue. 0. 0. 1.0.
		#magenta. 1.0. 0. 1.0.
		#brown. 0.6. 0.2. 0.
		#orange. 1.0. 0.6. 0.
		#lightRed. 1.0. 0.8. 0.8.
		
		}
	! !

!Color class methodsFor: 'examples' stamp: 'StephaneDucasse 10/16/2013 15:27'!
wheel: thisMany
	"Return a collection of thisMany colors evenly spaced around the color wheel."
	"Color showColors: (Color wheel: 12)"

	^ self wheel: thisMany saturation: 0.9 brightness: 0.7
! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:27'!
defaultColors3 
	^{
	#lightYellow. 1.0. 1.0. 0.8.
	#lightGreen. 0.8. 1.0. 0.6.
	#lightCyan. 0.4. 1.0. 1.0.
	#lightBlue. 0.8. 1.0. 1.0.
	#lightMagenta. 1.0. 0.8. 1.0.
	#lightBrown. 1.0. 0.6. 0.2.
	#lightOrange. 1.0. 0.8. 0.4.
	#pink. 1.0. 0.752899. 0.796118.
	#purple. 0.4. 0.0. 0.6.
	#tan. 0.8. 0.8. 0.5.
	#veryPaleRed. 1.0. 0.948. 0.948.
	#paleYellow. 1.0. 1.0. 0.85.
	#paleTan. 0.921. 0.878. 0.78.
	}! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:35'!
gray
	^ ColorRegistry at: #gray! !

!Color class methodsFor: 'other' stamp: 'MarcusDenker 3/27/2014 11:04'!
shutDown
	"Color shutDown"
	CachedColormaps := nil.	"Maps to translate between color depths"
	MaskingMap := nil	"Maps all colors except transparent to black for creating a mask"! !

!Color class methodsFor: 'instance creation' stamp: 'StephaneDucasse 10/16/2013 15:24'!
r: r g: g b: b range: range
	"Return a color with the given r, g, and b components specified as integers in the range [0..r]. This avoids the floating point arithmetic in the red:green:blue: message and is thus a bit faster for certain applications (such as computing a sequence of colors for a palette)."

	^ self basicNew
		initializeRed: r green: g blue: b range: range;
		yourself ! !

!Color class methodsFor: 'instance creation' stamp: 'MarcusDenker 3/27/2014 11:04'!
h: hue s: saturation v: brightness
	"Create a color with the given hue, saturation, and brightness. Hue is given as the angle in degrees of the color on the color circle where red is zero degrees. Saturation and brightness are numbers in [0.0..1.0] where larger values are more saturated or brighter colors. For example, (Color h: 0 s: 1 v: 1) is pure red."
	"Note: By convention, brightness is abbreviated 'v' to to avoid confusion with blue."

	^ self h: hue s: saturation v: brightness alpha: 1.0! !

!Color class methodsFor: 'instance creation' stamp: 'StephaneDucasse 10/16/2013 15:18'!
fromRgbTriplet: list
	^ self r: list first g: list second b: list last! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:36'!
lightOrange
	^ ColorRegistry at: #lightOrange! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:37'!
purple
 	^  ColorRegistry at: #purple! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:37'!
white
	^  ColorRegistry at: #white! !

!Color class methodsFor: 'other' stamp: 'FernandoOlivero 9/17/2013 21:35'!
hex: aFloat
	"Return an hexadecimal two-digits string between 00 and FF
	for a float between 0.0 and 1.0"
	| str |
	str := ((aFloat * 255) asInteger printStringHex) asLowercase.
	str size = 1 ifTrue: [^'0',str] ifFalse: [^str]! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:47'!
tan
	^  ColorRegistry at: #tan! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:35'!
lightBrown
	^ ColorRegistry at: #lightBrown! !

!Color class methodsFor: 'colormaps' stamp: 'StephaneDucasse 10/16/2013 15:16'!
computeRGBColormapFor: destDepth bitsPerColor: bitsPerColor 
	"Compute a colorMap for translating from 16-bit or 32-bit RGB color to the given depth, using the given number of of bits per color component."
	| mask map c |
	(#(3 4 5 ) includes: bitsPerColor) ifFalse: 
		[ self error: 'BitBlt only supports 3, 4, or 5 bits per color component' ].
	mask := (1 bitShift: bitsPerColor) - 1.
	map := Bitmap new: (1 bitShift: 3 * bitsPerColor).
	0 
		to: map size - 1
		do: 
			[ :i | 
			c := self 
				r: ((i bitShift: 0 - (2 * bitsPerColor)) bitAnd: mask)
				g: ((i bitShift: 0 - bitsPerColor) bitAnd: mask)
				b: ((i bitShift: 0) bitAnd: mask)
				range: mask.
			map 
				at: i + 1
				put: (c pixelValueForDepth: destDepth) ].
	map 
		at: 1
		put: (self transparent pixelWordForDepth: destDepth).	"zero always transparent"
	^ map! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:37'!
veryLightGray
	^ ColorRegistry at: #veryLightGray! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:35'!
lightGray
	^  ColorRegistry at: #lightGray! !

!Color class methodsFor: '*System-Settings-Browser' stamp: 'StephaneDucasse 10/18/2013 15:04'!
settingInputWidgetForNode: aSettingNode
	^ aSettingNode inputWidgetForColor! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:27'!
defaultColors
	^{ #black. 0. 0. 0.
		#veryVeryDarkGray. 0.125. 0.125. 0.125.
		#veryDarkGray. 0.25. 0.25. 0.25.
		#darkGray. 0.375. 0.375. 0.375.
		#gray. 0.5. 0.5. 0.5.
		#lightGray. 0.625. 0.625. 0.625.
		#veryLightGray. 0.75. 0.75. 0.75.
		#veryVeryLightGray. 0.875. 0.875. 0.875.
		#white. 1.0. 1.0. 1.0.
		}
		! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:36'!
paleGreen
	^  ColorRegistry at: #paleGreen! !

!Color class methodsFor: 'colormaps' stamp: 'MarcusDenker 3/27/2014 11:03'!
cachedColormapFrom: sourceDepth to: destDepth 
	"Return a cached colormap for mapping between the given depths. Always return a real colormap, not nil; this allows the client to get an identity colormap that can then be copied and modified to do color transformations."
	"Note: This method returns a shared, cached colormap to save time and space. Clients that need to modify a colormap returned by this method should make a copy and modify that!!"
	"Note: The colormap cache may be cleared by evaluating 'Color shutDown'."
	| srcIndex map |
	CachedColormaps class == Array ifFalse: [ CachedColormaps := (1 to: 9) collect: [ :i | Array new: 32 ] ].
	srcIndex := sourceDepth.
	sourceDepth > 8 ifTrue: [ srcIndex := 9 ].
	(map := (CachedColormaps at: srcIndex) at: destDepth) ~~ nil ifTrue: [ ^ map ].
	map := self 
		computeColormapFrom: sourceDepth
		to: destDepth.
	(CachedColormaps at: srcIndex) 
		at: destDepth
		put: map.
	^ map! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:36'!
lightRed
	^  ColorRegistry at: #lightRed! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:35'!
blue
	^ ColorRegistry at: #blue! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:37'!
veryVeryDarkGray
	^ ColorRegistry at: #veryVeryDarkGray ! !

!Color class methodsFor: 'initialization' stamp: 'StephaneDucasse 10/18/2013 11:09'!
initializeGrayToIndexMap
	"Build an array of gray values available in the 8-bit colormap. This array is indexed by a gray level between black (1) and white (256) and returns the pixel value for the corresponding gray level."
	"Note: This method must be called after initializeIndexedColors, since it uses IndexedColors."
	"Color initializeGrayToIndexMap"
	"record the level and index of each gray in the 8-bit color table"
	| grayLevels grayIndices c distToClosest dist indexOfClosest |
	grayLevels := OrderedCollection new.
	grayIndices := OrderedCollection new.
	"Note: skip the first entry, which is reserved for transparent"
	2 
		to: IndexedColors size
		do: 
			[ :i | 
			c := IndexedColors at: i.
			c saturation = 0.0 ifTrue: 
				[ "c is a gray"
				grayLevels add: c privateBlue >> 2.	"top 8 bits; R, G, and B are the same"
				grayIndices add: i - 1 ] ].	"pixel values are zero-based"
	grayLevels := grayLevels asArray.
	grayIndices := grayIndices asArray.

	"for each gray level in [0..255], select the closest match"
	GrayToIndexMap := ByteArray new: 256.
	0 
		to: 255
		do: 
			[ :level | 
			distToClosest := 10000.	"greater than distance to any real gray"
			1 
				to: grayLevels size
				do: 
					[ :i | 
					dist := (level - (grayLevels at: i)) abs.
					dist < distToClosest ifTrue: 
						[ distToClosest := dist.
						indexOfClosest := grayIndices at: i ] ].
			GrayToIndexMap 
				at: level + 1
				put: indexOfClosest ]! !

!Color class methodsFor: 'instance creation' stamp: 'StephaneDucasse 10/16/2013 15:24'!
r: r g: g b: b
	"Return a color with the given r, g, and b components in the range [0.0..1.0]."

	^ self r: r g: g b: b alpha: 1.0! !

!Color class methodsFor: 'colormaps' stamp: 'StephaneDucasse 10/16/2013 15:16'!
computeRGBColorConvertingMap: targetColor to: destDepth keepSubPixelAA: keepSubPix 
	"Builds a colormap intended to convert from subpixelAA black values to targetColor values.
	keepSubPix
		ifTrue: [ Answer colors that also include subpixelAA ]
		ifFalse: [ 
			Take fullpixel luminance level. Apply it to targetColor.
			I.e. answer colors with NO subpixelAA ]"
	| mask map c bitsPerColor r g b f v |
	destDepth > 8 
		ifTrue: [ bitsPerColor := 5	"retain maximum color resolution" ]
		ifFalse: [ bitsPerColor := 4 ].
	"Usually a bit less is enough, but make it configurable"
	bitsPerColor := bitsPerColor min: self aaFontsColormapDepth.
	mask := (1 bitShift: bitsPerColor) - 1.
	map := Bitmap new: (1 bitShift: 3 * bitsPerColor).
	0 
		to: map size - 1
		do: 
			[ :i | 
			r := (i bitShift: 0 - (2 * bitsPerColor)) bitAnd: mask.
			g := (i bitShift: 0 - bitsPerColor) bitAnd: mask.
			b := (i bitShift: 0) bitAnd: mask.
			f := 1.0 - ((r + g + b) / 3.0 / mask).
			c := targetColor notNil 
				ifTrue: 
					[ (keepSubPix and: [ destDepth > 8 ]) 
						ifTrue: 
							[ self 
								r: (1.0 - (r / mask)) * targetColor red
								g: (1.0 - (g / mask)) * targetColor green
								b: (1.0 - (b / mask)) * targetColor blue
								alpha: f * targetColor alpha	"alpha will be ignored below, in #pixelValueForDepth: if destDepth ~= 32" ]
						ifFalse: 
							[ destDepth = 32 
								ifTrue: [ targetColor * f alpha: f * targetColor alpha ]
								ifFalse: 
									[ targetColor 
										alphaMixed: f * 1.5
										with: self white ] ] ]
				ifFalse: 
					[ self  
						r: r
						g: g
						b: b
						range: mask ].	"This is currently used only to keep some SubPixelAA on destDepth = 8, using a single pass of rule 25"
			v := destDepth = 32 
				ifTrue: [ c pixelValueForDepth: destDepth ]
				ifFalse: 
					[ f < 0.1 
						ifTrue: [ 0 ]
						ifFalse: [ c pixelValueForDepth: destDepth ] ].
			map 
				at: i + 1
				put: v ].
	^ map! !

!Color class methodsFor: 'color from user' stamp: 'StephaneDucasse 10/16/2013 15:13'!
colorPaletteForDepth: depth extent: chartExtent
	"Display a palette of colors sorted horizontally by hue and vertically by lightness. Useful for eyeballing the color gamut of the display, or for choosing a color interactively."
	"Note: It is slow to build this palette, so it should be cached for quick access."
	"(Color colorPaletteForDepth: 16 extent: 190@60) display"

	| basicHue x y startHue palette transHt vSteps transCaption grayWidth hSteps |
	palette := Form extent: chartExtent depth: depth.
	transCaption := 
		(Form extent: 34@9 depth: 1
			fromArray: #(0 0 256 0 256 0 3808663859 2147483648 2491688266 2147483648 2491688266 0 2491688266 0 2466486578 0 0 0)
			offset: 0@0).
	transHt := transCaption height.
	palette fillWhite: (0@0 extent: palette width@transHt).
	palette fillBlack: (0@transHt extent: palette width@1).
	transCaption displayOn: palette at: palette boundingBox topCenter - ((transCaption width // 2)@0).
	grayWidth := 10.
	startHue := 338.0.
	vSteps := palette height - transHt // 2.
	hSteps := palette width - grayWidth.
	x := 0.
	startHue to: startHue + 360.0 by: 360.0/hSteps do: [ :h |
		basicHue := Color h: h asFloat s: 1.0 v: 1.0.
		y := transHt+1.
		0 to: vSteps do: [ :n | | c |
 			c := basicHue mixed: (n asFloat / vSteps asFloat) with: self white.
			palette fill: (x@y extent: 1@1) fillColor: c.
			y := y + 1].
		1 to: vSteps do: [ :n | | c |
 			c := self black mixed: (n asFloat / vSteps asFloat) with: basicHue.
			palette fill: (x@y extent: 1@1) fillColor: c.
			y := y + 1].
		x := x + 1].
	y := transHt + 1.
	1 to: vSteps * 2 do: [ :n | | c |
 		c := self black mixed: (n asFloat / (vSteps*2) asFloat) with: self white.
		palette fill: (x@y extent: 10@1) fillColor: c.
		y := y + 1].
	^ palette! !

!Color class methodsFor: 'instance creation' stamp: 'StephaneDucasse 10/16/2013 15:23'!
new

	^ self r: 0.0 g: 0.0 b: 0.0! !

!Color class methodsFor: 'accesing' stamp: 'FernandoOlivero 9/17/2013 21:35'!
unregisterColorNamed: aName
	ColorRegistry removeKey: aName ifAbsent: nil! !

!Color class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:03'!
gtExampleColorRed
	<gtExample>
	
	^ Color red! !

!Color class methodsFor: 'initialization' stamp: 'StephaneDucasse 10/16/2013 15:22'!
initializeIndexedColors
	"Build an array of colors corresponding to the fixed colormap used
	 for display depths of 1, 2, 4, or 8 bits."
	"Color initializeIndexedColors"
	| a index grayVal |
	a := Array new: 256.

	"1-bit colors (monochrome)"
	a 
		at: 1
		put: (self 
				r: 1.0
				g: 1.0
				b: 1.0).	"white or transparent"
	a 
		at: 2
		put: (self 
				r: 0.0
				g: 0.0
				b: 0.0).	"black"

	"additional colors for 2-bit color"
	a 
		at: 3
		put: (self 
				r: 1.0
				g: 1.0
				b: 1.0).	"opaque white"
	a 
		at: 4
		put: (self 
				r: 0.5
				g: 0.5
				b: 0.5).	"1/2 gray"

	"additional colors for 4-bit color"
	a 
		at: 5
		put: (self 
				r: 1.0
				g: 0.0
				b: 0.0).	"red"
	a 
		at: 6
		put: (self 
				r: 0.0
				g: 1.0
				b: 0.0).	"green"
	a 
		at: 7
		put: (self 
				r: 0.0
				g: 0.0
				b: 1.0).	"blue"
	a 
		at: 8
		put: (self 
				r: 0.0
				g: 1.0
				b: 1.0).	"cyan"
	a 
		at: 9
		put: (self 
				r: 1.0
				g: 1.0
				b: 0.0).	"yellow"
	a 
		at: 10
		put: (self 
				r: 1.0
				g: 0.0
				b: 1.0).	"magenta"
	a 
		at: 11
		put: (self 
				r: 0.125
				g: 0.125
				b: 0.125).	"1/8 gray"
	a 
		at: 12
		put: (self 
				r: 0.25
				g: 0.25
				b: 0.25).	"2/8 gray"
	a 
		at: 13
		put: (self 
				r: 0.375
				g: 0.375
				b: 0.375).	"3/8 gray"
	a 
		at: 14
		put: (self 
				r: 0.625
				g: 0.625
				b: 0.625).	"5/8 gray"
	a 
		at: 15
		put: (self 
				r: 0.75
				g: 0.75
				b: 0.75).	"6/8 gray"
	a 
		at: 16
		put: (self 
				r: 0.875
				g: 0.875
				b: 0.875).	"7/8 gray"

	"additional colors for 8-bit color"
	"24 more shades of gray (1/32 increments but not repeating 1/8 increments)"
	index := 17.
	1 
		to: 31
		do: 
			[ :v | 
			v \\ 4 = 0 ifFalse: 
				[ grayVal := v / 32.0.
				a 
					at: index
					put: (Color 
							r: grayVal
							g: grayVal
							b: grayVal).
				index := index + 1 ] ].

	"The remainder of color table defines a color cube with six steps
	 for each primary color. Note that the corners of this cube repeat
	 previous colors, but this simplifies the mapping between RGB colors
	 and color map indices. This color cube spans indices 40 through 255
	 (indices 41-256 in this 1-based array)."
	0 
		to: 5
		do: 
			[ :r | 
			0 
				to: 5
				do: 
					[ :g | 
					0 
						to: 5
						do: 
							[ :b | 
							index := 41 + (36 * r + (6 * b) + g).
							index > 256 ifTrue: [ self error: 'index out of range in color table compuation' ].
							a 
								at: index
								put: (self 
										r: r
										g: g
										b: b
										range: 5) ] ] ].
	IndexedColors := a! !

!Color class methodsFor: 'initialization' stamp: 'StephaneDucasse 10/18/2013 11:07'!
registerColor: aColor named: aName
	ColorRegistry at: aName put: aColor.
	! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:35'!
cyan
	^ ColorRegistry at: #cyan! !

!Color class methodsFor: 'colormaps' stamp: 'StephaneDucasse 10/16/2013 15:12'!
colorMapIfNeededFrom: sourceDepth to: destDepth
	"Return a colormap for mapping between the given depths, or nil if no colormap is needed."
	"Note: This method returns a shared, cached colormap to save time and space. Clients that need to modify a colormap returned by this method should make a copy and modify that!!"

	sourceDepth = destDepth ifTrue: [^ nil].  "not needed if depths are the same"

	(sourceDepth >= 16) & (destDepth >= 16) ifTrue: [
		"mapping is done in BitBlt by zero-filling or truncating each color component"
		^ nil].

	^ self cachedColormapFrom: sourceDepth to: destDepth
! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:36'!
lightMagenta
	^  ColorRegistry at: #lightMagenta! !

!Color class methodsFor: 'instance creation' stamp: 'MarcusDenker 3/27/2014 11:04'!
fromString: aString
	"for HTML color spec: #FFCCAA or white/black"

	"Color fromString: '#FFCCAA'.
	 Color fromString: 'orange'"

	| aColorHex |
	aString isEmptyOrNil
		ifTrue: [ ^ self white ].
	aColorHex := aString first = $#
		ifTrue: [ aString allButFirst ]
		ifFalse: [ aString ].	"Try to match aColorHex with known named colors, case insensitive."
	^ self registeredColorNames
		detect: [ :each | each sameAs: aColorHex ]
		ifFound: [ :namedColor | self named: namedColor ]
		ifNone: [ 
			(aColorHex size = 6 and: [ aColorHex allSatisfy: [ :character | '0123456789ABCDEFabcdef' includes: character ] ])
				ifTrue: [ self fromHexString: aColorHex ]
				ifFalse: [ self white ] ]! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:35'!
lightBlue
	^ ColorRegistry at: #lightBlue! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:36'!
paleBlue
	^  ColorRegistry at: #paleBlue ! !

!Color class methodsFor: 'defaults' stamp: 'FernandoOlivero 8/24/2013 19:36'!
pink
 	^  ColorRegistry at: #pink.! !

!Color class methodsFor: 'accessing' stamp: 'StephaneDucasse 10/16/2013 15:26'!
registeredNameOf: aColor 
	| colorName |
	colorName := #unnamed.
	ColorRegistry keysAndValuesDo: [:key :value|  value = aColor ifTrue: [ colorName := key ] ].
	^ colorName ! !

!ColorArray commentStamp: 'TorstenBergmann 2/12/2014 15:40'!
An array of colors!
!ColorArray methodsFor: 'accessing' stamp: 'ar 3/3/2001 20:03'!
at: index
	^(super at: index) asColorOfDepth: 32! !

!ColorArray methodsFor: 'converting' stamp: 'ar 3/3/2001 20:06'!
asColorArray
	^self! !

!ColorArray methodsFor: 'accessing' stamp: 'ar 3/3/2001 20:04'!
at: index put: aColor
	^super at: index put: (aColor pixelWordForDepth: 32).! !

!ColorChanged commentStamp: 'LaurentLaffont 4/15/2011 20:19'!
I'm a Announcement used to indicate a color has changed. 

Example:

(ColorSelectorDialogWindow new
                        title: 'Choose a color';
                        open;
                        announcer) on: ColorChanged  do: [:ann|
                                                                        UIManager inform: 'Selected color: ', ann newColor asString].!
!ColorChanged methodsFor: 'accessing' stamp: 'dik 6/27/2010 16:26'!
newColor
	^ newColor! !

!ColorChanged methodsFor: 'accessing' stamp: 'dik 6/27/2010 16:26'!
newColor: anObject
	newColor := anObject! !

!ColorChanged class methodsFor: 'instance creation' stamp: 'dik 6/27/2010 16:26'!
to: aColor
	^self new 
		newColor: aColor! !

!ColorChooserMorph commentStamp: 'gvc 5/18/2007 13:45'!
ColorPresenter that opens a colour selector when clicked.!
!ColorChooserMorph methodsFor: 'accessing' stamp: 'gvc 10/12/2006 13:46'!
enabled
	"Answer the enabled state of the receiver."
	
	^enabled! !

!ColorChooserMorph methodsFor: 'updating' stamp: 'gvc 10/12/2006 13:51'!
update: aSymbol 
	"Refer to the comment in View|update:."

	super update: aSymbol.
	aSymbol == self getEnabledSelector ifTrue: 
		[self updateEnabled.
		^ self]! !

!ColorChooserMorph methodsFor: 'building' stamp: 'gvc 12/8/2008 19:40'!
newContentMorph
	"Answer a new button morph"

	|b|
	b := (self theme
		newButtonIn: self
		for: self
		getState: nil
		action: #chooseColor
		arguments: #()
		getEnabled: #enabled
		label: (self newHatchMorph layoutInset: 2)
		help: nil)
		hResizing: #spaceFill.
	b contentHolder hResizing: #spaceFill.
	^b! !

!ColorChooserMorph methodsFor: 'updating' stamp: 'gvc 9/8/2009 13:25'!
updateEnabled
	"Update the enablement state."

	self model ifNotNil: [
		self getEnabledSelector ifNotNil: [
			self enabled: (self model perform: self getEnabledSelector)]]! !

!ColorChooserMorph methodsFor: 'as yet unclassified' stamp: ''!
enabledString
	"Answer the string to be shown in a menu to represent the 'enabled' status"
	
	^ (self enabled) -> 'enabled' translated! !

!ColorChooserMorph methodsFor: 'menu & halo' stamp: ''!
addToggleItemsToHaloMenu: aCustomMenu 
	"Add toggle-items to the halo menu"
	
	super addToggleItemsToHaloMenu: aCustomMenu.
	aCustomMenu
		addUpdating: #enabledString
		target: self
		selector: #toggleEnabled! !

!ColorChooserMorph methodsFor: 'accessing' stamp: 'gvc 10/12/2006 13:47'!
getEnabledSelector
	"Answer the value of getEnabledSelector"

	^ getEnabledSelector! !

!ColorChooserMorph methodsFor: 'accessing' stamp: 'gvc 2/14/2009 18:41'!
setColorSelector: anObject
	"Set the value of setColorSelector"

	setColorSelector := anObject! !

!ColorChooserMorph methodsFor: 'initialization' stamp: 'gvc 5/22/2007 11:44'!
initialize
	"Initialize the receiver."

	enabled := true.
	super initialize! !

!ColorChooserMorph methodsFor: 'services' stamp: 'MarcusDenker 6/28/2012 10:18'!
chooseColor
	"Popup the color picker for now."

	|newColor|
	newColor := self theme
		chooseColorIn: ((self ownerThatIsA: SystemWindow) ifNil: [self])
		title: 'Choose Color' translated
		color: self labelMorph color.
	newColor ifNil: [^self].
	self labelMorph color: newColor.
	self solidLabelMorph color: newColor asNontranslucentColor.
	self setColorSelector ifNotNil: [self model perform: self setColorSelector with: newColor]! !

!ColorChooserMorph methodsFor: 'accessing' stamp: 'gvc 2/14/2009 18:41'!
setColorSelector
	"Answer the value of setColorSelector"

	^ setColorSelector! !

!ColorChooserMorph methodsFor: 'as yet unclassified' stamp: ''!
toggleEnabled
	"Toggle the enabled state."

	self enabled: self enabled not! !

!ColorChooserMorph methodsFor: 'accessing' stamp: 'MarcusDenker 12/11/2009 07:38'!
enabled: aBoolean
	"Set the enabled state of the receiver."

	enabled := aBoolean.
	self contentMorph ifNotNil: [:m | m enabled: aBoolean].
	self changed: #enabled! !

!ColorChooserMorph methodsFor: 'instance creation' stamp: 'gvc 9/22/2006 09:46'!
on: anObject color: getColSel changeColor: setColSel
	"Set the receiver to the given model parameterized by the given message selectors."

	self
		on: anObject color: getColSel;
		setColorSelector: setColSel! !

!ColorChooserMorph methodsFor: 'accessing' stamp: 'gvc 10/12/2006 13:51'!
getEnabledSelector: anObject
	"Set the value of getEnabledSelector"

	getEnabledSelector := anObject.
	self updateEnabled! !

!ColorChooserMorph class methodsFor: 'example' stamp: 'StephaneDucasse 7/10/2014 08:10'!
example

	^ (ColorChooserMorph 
		on: (BorderedMorph new) 
		color: #color changeColor: #color:) openInWorld! !

!ColorChooserMorph class methodsFor: 'instance creation' stamp: 'StephaneDucasse 3/3/2010 16:14'!
on: anObject color: getSel changeColor: setSel
	"Answer a new instance of the receiver on the given model using
	the given selectors as the interface."
	"(ColorChooserMorph on: (BorderedMorph new) color: #color changeColor: #color:) openInWorld"
	^self new
		on: anObject 
		color: getSel
		changeColor: setSel! !

!ColorFillStyle commentStamp: 'gvc 12/8/2008 13:05'!
Simple fillstyle that draws a color at the specified origin with option extent.!
!ColorFillStyle methodsFor: 'accessing' stamp: 'gvc 12/8/2008 13:05'!
extent
	"Answer the value of extent"

	^ extent! !

!ColorFillStyle methodsFor: 'as yet unclassified' stamp: 'gvc 12/8/2008 13:14'!
isOrientedFill
	"Answer true if origin is not nil so that morph movement adjusts origin."
	
	^self origin notNil! !

!ColorFillStyle methodsFor: 'accessing' stamp: 'gvc 12/8/2008 13:05'!
extent: anObject
	"Set the value of extent"

	extent := anObject! !

!ColorFillStyle methodsFor: 'accessing' stamp: 'gvc 12/8/2008 13:05'!
origin
	"Answer the value of origin"

	^ origin! !

!ColorFillStyle methodsFor: 'as yet unclassified' stamp: 'gvc 12/8/2008 13:11'!
fillRectangle: aRectangle on: aCanvas
	"Fill the given rectangle on the given canvas with the receiver."
	
	|o c|
	o := self origin ifNil: [aRectangle origin] ifNotNil: [self origin].
	c := self extent ifNil: [aRectangle corner] ifNotNil: [o + self extent].
	aCanvas fillRectangle: (o corner: c) basicFillStyle: self! !

!ColorFillStyle methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/6/2015 18:30'!
asAthensPaintOn: anAthensCanvas
	^ (anAthensCanvas surface createSolidColorPaint: color)
		origin: origin;
		extent: extent;
		yourself! !

!ColorFillStyle methodsFor: 'accessing' stamp: 'gvc 12/8/2008 13:05'!
origin: anObject
	"Set the value of origin"

	origin := anObject! !

!ColorForm commentStamp: '<historical>'!
ColorForm is a normal Form plus a color map of up to 2^depth Colors. Typically, one reserves one entry in the color map for transparent. This allows 1, 3, 15, or 255 non-transparent colors in ColorForms of depths 1, 2, 4, and 8 bits per pixel. ColorForms don't support depths greater than 8 bits because that would require excessively large color maps with little real benefit, since 16-bit and 32-bit depths already support thousands and millions of colors.

ColorForms have several uses:
  1) Precise colors. You can have up to 256 true colors, instead being limited to the 8-bit color palette.
  2) Easy transparency. Just store (Color transparent) at the desired position in the color map.
  3) Cheap color remapping by changing the color map.

A color map is an Array of up to 2^depth Color objects. A Bitmap colorMap is automatically computed and cached for rapid display. Note that if you change the color map, you must resubmit it via the colors: method to flush this cache.

ColorForms can be a bit tricky. Note that:
  a) When you BitBlt from one ColorForm to another, you must remember to copy the color map of the source ColorForm to the destination ColorForm.
  b) A ColorForm's color map is an array of depth-independent Color objects. BitBlt requires a BitMap of actual pixel values, adjusted to the destination depth. These are different things!! ColorForms automatically maintain a cache of the BitBlt-style color map corresponding to the colors array for the last depth on which the ColorForm was displayed, so there should be little need for clients to work with BitBlt-style color maps.
  c) The default map for 8 bit depth has black in the first entry, not transparent.  Say (cform colors at: 1 put: Color transparent).
!
!ColorForm methodsFor: 'accessing' stamp: 'mir 7/21/1999 11:51'!
colorsFromArray: colorArray
	| colorList |
	colorList := colorArray collect: [:colorDef |
		Color fromArray: colorDef].
	self colors: colorList! !

!ColorForm methodsFor: 'color manipulation' stamp: 'jm 4/18/98 20:34'!
colorsUsed
	"Return a list of the colors actually used by this ColorForm."

	| myColor list |
	myColor := self colors.
	list := OrderedCollection new.
	self tallyPixelValues doWithIndex: [:count :i |
		count > 0 ifTrue: [list add: (myColor at: i)]].
	^ list asArray
! !

!ColorForm methodsFor: 'color mapping' stamp: 'ar 5/17/2001 15:44'!
colormapIfNeededFor: destForm
	| newMap color pv |
	(self hasNonStandardPalette or:[destForm hasNonStandardPalette]) ifFalse:[
		^self colormapIfNeededForDepth: destForm depth.
	].
	colors == nil ifTrue: [
		"use the standard colormap"
		^ super colormapIfNeededFor: destForm].

	(destForm depth = cachedDepth and:[cachedColormap isColormap]) 
		ifTrue: [^ cachedColormap].
	newMap := WordArray new: (1 bitShift: self depth).
	1 to: colors size do: [:i |
		color := colors at: i.
		pv := destForm pixelValueFor: color.
		(pv = 0 and:[color isTransparent not]) ifTrue:[pv := 1].
		newMap at: i put: pv].

	cachedDepth := destForm depth.
	^cachedColormap := ColorMap shifts: nil masks: nil colors: newMap.! !

!ColorForm methodsFor: 'pixel accessing' stamp: 'jm 11/14/97 17:25'!
colorAt: aPoint
	"Return the color of the pixel at aPoint."

	^ self colors at: (self pixelValueAt: aPoint) + 1
! !

!ColorForm methodsFor: 'color manipulation' stamp: 'jm 11/16/97 09:08'!
replaceColor: oldColor with: newColor
	"Replace all occurances of the given color with the given new color in my color map."

	self ensureColorArrayExists.
	1 to: colors size do: [:i | 
		(colors at: i) = oldColor ifTrue: [colors at: i put: newColor]].
	self clearColormapCache.
! !

!ColorForm methodsFor: 'testing' stamp: 'ar 2/10/2004 17:18'!
isTranslucent
	"Answer whether this form may be translucent"
	^true! !

!ColorForm methodsFor: 'pixel accessing' stamp: 'jm 11/14/97 17:25'!
colorAt: aPoint put: aColor
	"Store the given color into the pixel at aPoint. The given color must match one of the colors in the receiver's colormap."

	| i |
	i := self colors indexOf: aColor
		ifAbsent: [^ self error: 'trying to use a color that is not in my colormap'].
	self pixelValueAt: aPoint put: i - 1.
! !

!ColorForm methodsFor: 'copying' stamp: 'ar 10/24/2005 22:25'!
blankCopyOf: aRectangle scaledBy: scale
	^Form extent: (aRectangle extent * scale) truncated depth: 32! !

!ColorForm methodsFor: 'private' stamp: 'jm 11/16/97 08:37'!
setExtent: extent depth: bitsPerPixel
	"Create a virtual bit map with the given extent and bitsPerPixel."

	bitsPerPixel > 8 ifTrue: [self error: 'ColorForms only support depths up to 8 bits'].
	super setExtent: extent depth: bitsPerPixel.
! !

!ColorForm methodsFor: 'color manipulation' stamp: 'di 11/11/1998 13:20'!
asGrayScale
	"Return a grayscale ColorForm computed by mapping each color into its grayscale equivalent"
	^ self copy colors:
		(colors collect:
			[:c | c isTransparent ifTrue: [c]
						ifFalse: [Color gray: c luminance]])! !

!ColorForm methodsFor: 'filein/out' stamp: 'ar 3/3/2001 20:07'!
hibernate
	"Make myself take up less space. See comment in Form>hibernate."

	super hibernate.
	self clearColormapCache.
	colors ifNotNil:[colors := colors asColorArray].! !

!ColorForm methodsFor: 'private' stamp: 'ar 5/17/2001 15:44'!
ensureColorArrayExists
	"Return my color palette."

	colors ifNil: [
		self depth > 8 ifTrue: [^ self error: 'ColorForms only support depths up to 8 bits'].
		self colors: (Color indexedColors copyFrom: 1 to: (1 bitShift: self depth))].
! !

!ColorForm methodsFor: 'pixel accessing' stamp: 'StephaneDucasse 10/25/2013 16:16'!
pixelValueAt: aPoint 
	"Return the raw pixel value at the given point. Typical clients use colorAt: to get a Color."
	"Details: To get the raw pixel value, be sure the peeker's colorMap is nil."

	^ (BitBlt bitPeekerFromForm: self) colorMap: nil; pixelAt: aPoint
! !

!ColorForm methodsFor: 'copying' stamp: 'StephaneDucasse 10/25/2013 16:16'!
copy: aRect
 	"Return a new ColorForm containing the portion of the receiver delineated by aRect."

	| newForm |
	newForm := self class extent: aRect extent depth: depth.
	((BitBlt
		destForm: newForm
		sourceForm: self
		fillColor: nil
		combinationRule: Form over
		destOrigin: 0@0
		sourceOrigin: aRect origin
		extent: aRect extent
		clipRect: newForm boundingBox)
		colorMap: nil) copyBits.
	colors ifNotNil: [newForm colors: colors copy].
	^ newForm
! !

!ColorForm methodsFor: 'private' stamp: 'jm 11/16/97 09:12'!
depth: bitsPerPixel

	bitsPerPixel > 8 ifTrue: [self error: 'ColorForms only support depths up to 8 bits'].
	super depth: bitsPerPixel.
! !

!ColorForm methodsFor: 'color manipulation' stamp: 'tk 3/2/98 11:27'!
transparentColor: aColor
	"Make all occurances of the given color transparent.  Note: for colors like black and white, which have two entries in the colorMap, this changes BOTH of them.  Not always what you want."

	self replaceColor: aColor with: Color transparent.
! !

!ColorForm methodsFor: 'testing' stamp: 'ar 5/27/2001 16:34'!
isColorForm
	^true! !

!ColorForm methodsFor: 'accessing' stamp: 'ar 5/17/2001 15:45'!
colors: colorList
	"Set my color palette to the given collection."

	| colorArray colorCount newColors |
	colorList ifNil: [
		colors := cachedDepth := cachedColormap := nil.
		^ self].

	colorArray := colorList asArray.
	colorCount := colorArray size.
	newColors := Array new: (1 bitShift: self depth).
	1 to: newColors size do: [:i |
		i <= colorCount
			ifTrue: [newColors at: i put: (colorArray at: i)]
			ifFalse: [newColors at: i put: Color transparent]].

	colors := newColors.
	cachedDepth := nil.
	cachedColormap := nil.
! !

!ColorForm methodsFor: 'private' stamp: 'jm 2/24/98 18:53'!
unusedColormapEntry
	"Return the index of an unused color map entry, or zero if there isn't one."

	| tallies |
	tallies := self tallyPixelValues.
	1 to: tallies size do: [:i |
		(tallies at: i) = 0 ifTrue: [^ i]].
	^ 0
! !

!ColorForm methodsFor: 'color manipulation' stamp: 'jm 10/19/1998 10:52'!
mapColor: oldColor to: newColor
	"Replace all occurances of the given color with the given new color in my color map."

	self ensureColorArrayExists.
	1 to: colors size do: [:i | 
		(colors at: i) = oldColor ifTrue: [colors at: i put: newColor]].
	self clearColormapCache.
! !

!ColorForm methodsFor: 'color manipulation' stamp: 'di 8/28/1998 15:48'!
indexOfColor: aColor
	"Return the index of aColor in my color array"

	self ensureColorArrayExists.
	^ colors indexOf: aColor ifAbsent: [0]! !

!ColorForm methodsFor: 'testing' stamp: 'JuanVuletich 10/12/2010 12:44'!
mightBeTranslucent
	"Answer whether this form may be translucent"
	^true! !

!ColorForm methodsFor: 'pixel accessing' stamp: 'tk 10/21/97 12:27'!
isTransparentAt: aPoint 
	"Return true if the receiver is transparent at the given point."

	^ (self colorAt: aPoint) isTransparent
! !

!ColorForm methodsFor: 'filein/out' stamp: 'mu 8/17/2003 00:46'!
readAttributesFrom: aBinaryStream
	super readAttributesFrom: aBinaryStream.
	colors := ColorArray new: (2 raisedTo: depth).
	1 to: colors size do: [:idx | 
		colors basicAt: idx put: (aBinaryStream nextLittleEndianNumber: 4).
	]. 
	! !

!ColorForm methodsFor: 'copying' stamp: 'jm 2/27/98 09:38'!
deepCopy

	^ self shallowCopy
		bits: bits copy;
		offset: offset copy;
		colors: colors
! !

!ColorForm methodsFor: 'filein/out' stamp: 'bf 5/25/2000 16:31'!
storeOn: aStream
	aStream nextPut: $(.
	super storeOn: aStream.
	aStream
		cr; tab;
		nextPutAll: 'colorsFromArray: #('.
	self colors do: [:color |
		color storeArrayOn: aStream].
	aStream nextPutAll: ' ))'.! !

!ColorForm methodsFor: 'color manipulation' stamp: 'tk 3/2/98 11:26'!
transparentAllPixelsLike: aPoint
	"Make all occurances of the given pixel value transparent.  Very useful when two entries in the colorMap have the same value.  This only changes ONE."

	self replaceColorAt: aPoint with: Color transparent.
! !

!ColorForm methodsFor: 'scaling, rotation' stamp: 'RAA 8/5/2000 18:12'!
scaledToSize: newExtent

	"super method did not seem to work so well on ColorForms"

	^(self asFormOfDepth: 16) scaledToSize: newExtent! !

!ColorForm methodsFor: 'accessing' stamp: 'jm 11/14/97 17:39'!
colors
	"Return my color palette."

	self ensureColorArrayExists.
	^ colors
! !

!ColorForm methodsFor: 'color manipulation' stamp: 'ar 5/17/2001 15:44'!
colormapIfNeededForDepth: destDepth
	"Return a colormap for displaying the receiver at the given depth, or nil if no colormap is needed."

	| newMap |
	colors == nil ifTrue: [
		"use the standard colormap"
		^ Color colorMapIfNeededFrom: self depth to: destDepth].

	(destDepth = cachedDepth and:[cachedColormap isColormap not]) 
		ifTrue: [^ cachedColormap].
	newMap := Bitmap new: colors size.
	1 to: colors size do: [:i |
		newMap
			at: i
			put: ((colors at: i) pixelValueForDepth: destDepth)].

	cachedDepth := destDepth.
	^ cachedColormap := newMap.
! !

!ColorForm methodsFor: 'color manipulation' stamp: 'di 8/28/1998 15:49'!
replaceColorAtIndex: index with: newColor
	"Replace a color map entry with newColor."

	self ensureColorArrayExists.
	colors at: index put: newColor.
	cachedColormap == nil ifFalse:
		[cachedColormap at: index put: (newColor pixelValueForDepth: cachedDepth)]! !

!ColorForm methodsFor: 'private' stamp: 'jm 4/5/1999 10:11'!
setColors: colorArray cachedColormap: aBitmap depth: anInteger
	"Semi-private. Set the color array, cached colormap, and cached colormap depth to avoid having to recompute the colormap when switching color palettes in animations."

	colors := colorArray.
	cachedDepth := anInteger.
	cachedColormap := aBitmap.
! !

!ColorForm methodsFor: 'scaling, rotation' stamp: 'ar 3/15/1999 14:28'!
flipBy: direction centerAt: aPoint
	| oldColors newForm |
	oldColors := colors.
	self colors: nil.
	newForm := super flipBy: direction centerAt: aPoint.
	self colors: oldColors.
	newForm colors: oldColors.
	^newForm ! !

!ColorForm methodsFor: 'color manipulation' stamp: 'tk 3/2/98 15:42'!
replaceColorAt: aPoint with: newColor
	"Replace a color map entry with newColor.  The entry replaced is the one used by aPoint.  If there are are two entries in the colorMap for the oldColor, just replace ONE!!!!  There are often two whites or two blacks, and this is what you want, when replacing one."

	| oldIndex |
	self ensureColorArrayExists.
	oldIndex := self pixelValueAt: aPoint.
	colors at: oldIndex+1 put: newColor.
	self clearColormapCache.
! !

!ColorForm methodsFor: 'displaying' stamp: 'di 7/17/97 10:04'!
displayOnPort: port at: location

	port copyForm: self to: location rule: Form paint! !

!ColorForm methodsFor: 'copying' stamp: 'MarcusDenker 4/10/2011 09:45'!
asCursorForm

	^ (self asFormOfDepth: 32) offset: offset! !

!ColorForm methodsFor: 'filein/out' stamp: 'ar 3/3/2001 20:07'!
unhibernate
	colors ifNotNil:[colors := colors asArray].
	^super unhibernate.
! !

!ColorForm methodsFor: 'displaying' stamp: 'ar 12/14/2001 18:14'!
maskingMap
	"Return a color map that maps all colors except transparent to words of all ones. Used to create a mask for a Form whose transparent pixel value is zero."
	| maskingMap |
	maskingMap := Bitmap new: (1 bitShift: depth) withAll: 16rFFFFFFFF.
	1 to: colors size do:[:i|
		(colors at: i) isTransparent ifTrue:[maskingMap at: i put: 0].
	].
	colors size+1 to: maskingMap size do:[:i| maskingMap at: i put: 0].
	^maskingMap! !

!ColorForm methodsFor: 'private' stamp: 'jm 11/16/97 09:07'!
clearColormapCache

	cachedDepth := nil.
	cachedColormap := nil.
! !

!ColorForm methodsFor: 'filein/out' stamp: 'mu 8/17/2003 00:42'!
writeAttributesOn: file
	| colorArray |
	super writeAttributesOn: file.
	colorArray := self colors asColorArray.
	1 to: (2 raisedTo: depth) do: [:idx |
		file nextLittleEndianNumber: 4 put: (colorArray basicAt: idx).
	] ! !

!ColorForm class methodsFor: 'as yet unclassified' stamp: 'nk 4/17/2004 19:44'!
mappingWhiteToTransparentFrom: aFormOrCursor
	"Return a ColorForm copied from the given Form or Cursor with white mapped to transparent."

	| f map |
	aFormOrCursor depth <= 8 ifFalse: [
		^ self error: 'argument depth must be 8-bits per pixel or less'].
	(aFormOrCursor isColorForm) ifTrue: [
		f := aFormOrCursor deepCopy.
		map := aFormOrCursor colors.
	] ifFalse: [
		f := ColorForm extent: aFormOrCursor extent depth: aFormOrCursor depth.
		f copyBits: aFormOrCursor boundingBox
			from: aFormOrCursor
			at: 0@0
			clippingBox: aFormOrCursor boundingBox
			rule: Form over
			fillColor: nil.
		map := Color indexedColors copyFrom: 1 to: (1 bitShift: aFormOrCursor depth)].
	map := map collect: [:c |
		c = Color white ifTrue: [Color transparent] ifFalse: [c]].
	f colors: map.
	^ f
! !

!ColorForm class methodsFor: 'instance creation' stamp: 'StephaneDucasse 8/19/2009 23:24'!
extent: extentPoint depth: bitsPerPixel
	"Answer an instance of me with blank bitmap of the given dimensions and depth max 8."
	
	^ bitsPerPixel > 8 
		ifTrue: [ self basicNew setExtent: extentPoint depth: 8]
		ifFalse:  [ self basicNew setExtent: extentPoint depth: bitsPerPixel]
! !

!ColorMap commentStamp: 'LaurentLaffont 5/4/2011 21:28'!
I'm a transformation of pixel values. I apply up to four masks and shits to compute the transformed pixel value.

I'm used when applying a BitBlt transfer, whenever pixels from a source to a destination have diferent depths. For further information refer to BitBlt class comments.

To see me in action evaluate: BitBlt exampleColorMap!
!ColorMap methodsFor: 'pixel mapping' stamp: 'lr 7/4/2009 10:42'!
mappingTo: aColorMap 
	"Compute a new color map through the receiver and aColorMap.
	Both maps are assumed to be mappings into canonical ARGB space"
	| fixedMap |
	self = aColorMap ifTrue: [ ^ nil ].	"No mapping needed"
	aColorMap isIndexed ifTrue: [ ^ nil ].	"We can't compute mappings to an indexed map yet"
	fixedMap := self class 
		mappingFrom: self rgbaBitMasks
		to: aColorMap rgbaBitMasks.
	self isIndexed ifFalse: [ ^ fixedMap ].
	"If the receiver is indexed then we need to map the colors as well"
	self flag: #untested.
	^ ColorMap 
		shifts: fixedMap shifts
		masks: fixedMap masks
		colors: (colors collect: [ :pv | aColorMap pixelMap: pv ])! !

!ColorMap methodsFor: 'private' stamp: 'lr 7/4/2009 10:42'!
setShifts: shiftArray masks: maskArray colors: colorArray 
	shiftArray ifNotNil: [ shifts := shiftArray asIntegerArray ].
	maskArray ifNotNil: [ masks := maskArray asWordArray ].
	colorArray ifNotNil: [ colors := colorArray asWordArray ]! !

!ColorMap methodsFor: 'accessing' stamp: 'ar 1/16/2000 15:36'!
greenShift: value
	shifts at: 2 put: value.! !

!ColorMap methodsFor: 'accessing' stamp: 'ar 1/16/2000 15:39'!
at: index
	^colors at: index! !

!ColorMap methodsFor: 'testing' stamp: 'ar 5/27/2000 19:06'!
isFixed
	"Return true if the receiver does not use a lookup mechanism for pixel mapping"
	^self isIndexed not! !

!ColorMap methodsFor: 'accessing' stamp: 'ar 1/16/2000 15:36'!
redMask
	^masks at: 1! !

!ColorMap methodsFor: 'accessing' stamp: 'ar 1/16/2000 15:37'!
redMask: value
	masks at: 1 put: value! !

!ColorMap methodsFor: 'accessing' stamp: 'ar 1/16/2000 15:31'!
alphaShift
	^shifts at: 4! !

!ColorMap methodsFor: 'accessing' stamp: 'ar 1/16/2000 15:32'!
greenShift
	^shifts at: 2! !

!ColorMap methodsFor: 'testing' stamp: 'ar 5/25/2000 19:41'!
isColormap
	^true! !

!ColorMap methodsFor: 'pixel mapping' stamp: 'lr 7/4/2009 10:42'!
pixelMap: pixelValue 
	"Perform a reverse pixel mapping operation"
	| pv |
	colors == nil 
		ifTrue: [ pv := pixelValue ]
		ifFalse: [ pv := colors at: pixelValue ].
	(shifts == nil and: [ masks == nil ]) ifFalse: 
		[ pv := (((pv bitAnd: self redMask) bitShift: self redShift) bitOr: ((pv bitAnd: self greenMask) bitShift: self greenShift)) bitOr: (((pv bitAnd: self blueMask) bitShift: self blueShift) bitOr: ((pv bitAnd: self alphaMask) bitShift: self alphaShift)) ].
	"Need to check for translucency else Form>>paint goes gaga"
	pv = 0 ifTrue: [ pixelValue = 0 ifFalse: [ pv := 1 ] ].
	^ pv! !

!ColorMap methodsFor: 'accessing' stamp: 'ar 1/16/2000 15:32'!
greenMask: value
	masks at: 2 put: value! !

!ColorMap methodsFor: 'accessing' stamp: 'ar 1/16/2000 15:55'!
alphaMask: value
	masks at: 4 put: value! !

!ColorMap methodsFor: 'accessing' stamp: 'ar 1/16/2000 15:31'!
alphaShift: value
	shifts at: 4 put: value! !

!ColorMap methodsFor: 'comparing' stamp: 'ar 5/27/2000 19:29'!
hash
	"Hash is re-implemented because #= is re-implemented"
	^colors hash bitXor: (shifts hash bitXor: masks hash)! !

!ColorMap methodsFor: 'accessing' stamp: 'PeterHugossonMiller 9/3/2009 00:57'!
inverseMap
	"Return the inverse map of the receiver"
	| newMasks newShifts |
	colors ifNotNil: [ ^ self error: 'Not yet implemented' ].
	newMasks := (Array new: 4) writeStream.
	newShifts := (Array new: 4) writeStream.
	masks 
		with: shifts
		do: 
			[ :mask :shift | 
			newMasks nextPut: (mask bitShift: shift).
			newShifts nextPut: shift negated ].
	^ ColorMap 
		shifts: newShifts contents
		masks: newMasks contents! !

!ColorMap methodsFor: 'accessing' stamp: 'ar 1/16/2000 15:31'!
blueMask
	^masks at: 3! !

!ColorMap methodsFor: 'accessing' stamp: 'ar 2/10/2000 17:12'!
colors
	^colors! !

!ColorMap methodsFor: 'accessing' stamp: 'ar 1/16/2000 15:37'!
redShift
	^shifts at: 1! !

!ColorMap methodsFor: 'accessing' stamp: 'ar 1/16/2000 15:54'!
alphaMask
	^masks at: 4! !

!ColorMap methodsFor: 'pixel mapping' stamp: 'lr 7/4/2009 10:42'!
mapPixel: pixelValue 
	"Perform a forward pixel mapping operation"
	| pv |
	(shifts == nil and: [ masks == nil ]) 
		ifFalse: 
			[ pv := (((pixelValue bitAnd: self redMask) bitShift: self redShift) bitOr: ((pixelValue bitAnd: self greenMask) bitShift: self greenShift)) bitOr: (((pixelValue bitAnd: self blueMask) bitShift: self blueShift) bitOr: ((pixelValue bitAnd: self alphaMask) bitShift: self alphaShift)) ]
		ifTrue: [ pv := pixelValue ].
	colors ifNotNil: [ pv := colors at: pv ].
	"Need to check for translucency else Form>>paint goes gaga"
	pv = 0 ifTrue: [ pixelValue = 0 ifFalse: [ pv := 1 ] ].
	^ pv! !

!ColorMap methodsFor: 'accessing' stamp: 'ar 1/16/2000 15:31'!
blueShift
	^shifts at: 3! !

!ColorMap methodsFor: 'accessing' stamp: 'ar 5/27/2000 19:16'!
masks
	^masks! !

!ColorMap methodsFor: 'accessing' stamp: 'ar 1/16/2000 15:39'!
at: index put: value
	^colors at: index put: value! !

!ColorMap methodsFor: 'accessing' stamp: 'ar 1/16/2000 15:37'!
redShift: value
	shifts at: 1 put: value! !

!ColorMap methodsFor: 'accessing' stamp: 'ar 5/27/2000 19:16'!
shifts
	^shifts! !

!ColorMap methodsFor: 'comparing' stamp: 'tk 7/5/2001 21:59'!
= aColorMap
	"Return true if the receiver is equal to aColorMap"
	self species == aColorMap species ifFalse:[^false].
	self isIndexed == aColorMap isIndexed ifFalse:[^false].
	^self colors = aColorMap colors and:[
		self shifts = aColorMap shifts and:[
			self masks = aColorMap masks]]! !

!ColorMap methodsFor: 'accessing' stamp: 'ar 1/16/2000 15:32'!
blueShift: value
	shifts at: 3 put: value! !

!ColorMap methodsFor: 'accessing' stamp: 'ar 1/16/2000 15:32'!
greenMask
	^masks at: 2! !

!ColorMap methodsFor: 'accessing' stamp: 'ar 1/16/2000 15:31'!
blueMask: value
	masks at: 3 put: value! !

!ColorMap methodsFor: 'accessing' stamp: 'ar 5/27/2000 20:48'!
rgbaBitMasks
	"Return the rgba bit masks for the receiver"
	^masks asArray with: shifts collect:[:m :s| m bitShift: s]! !

!ColorMap methodsFor: 'testing' stamp: 'ar 5/27/2000 19:06'!
isIndexed
	"Return true if the receiver uses a lookup mechanism for pixel mapping"
	^colors notNil! !

!ColorMap class methodsFor: 'instance creation' stamp: 'ar 1/16/2000 16:02'!
shifts: shiftArray masks: maskArray colors: colorArray
	^self new setShifts: shiftArray masks: maskArray colors: colorArray! !

!ColorMap class methodsFor: 'instance creation' stamp: 'ar 1/16/2000 16:02'!
shifts: shiftArray masks: maskArray
	^self shifts: shiftArray masks: maskArray colors: nil.! !

!ColorMap class methodsFor: 'instance creation' stamp: 'lr 7/4/2009 10:42'!
mapBitsFrom: srcBitMask to: dstBitMask 
	"Return an array consisting of the shift and the mask for
	mapping component values out of srcBitMask and into dstBitMask.
	While this computation is somewhat complicated it eases the batch
	conversion of all the pixels in BitBlt."
	| srcBits dstBits srcLow srcHigh dstLow dstHigh bits mask shift |
	(srcBitMask = 0 or: [ dstBitMask = 0 ]) ifTrue: 
		[ ^ #(0 0 ) ].	"Zero mask and shift"
	"Compute low and high bit position for source and dest bit mask"
	srcLow := srcBitMask lowBit - 1.
	srcHigh := srcBitMask highBit.
	dstLow := dstBitMask lowBit - 1.
	dstHigh := dstBitMask highBit.
	"Compute the number of bits in source and dest bit mask"
	srcBits := srcHigh - srcLow.
	dstBits := dstHigh - dstLow.
	"Compute the maximum number of bits we can transfer inbetween"
	bits := srcBits min: dstBits.
	"Compute the (unshifted) transfer mask"
	mask := (1 bitShift: bits) - 1.
	"Shift the transfer mask to the mask the highest n bits of srcBitMask"
	mask := mask bitShift: srcHigh - bits.
	"Compute the delta shift so that the most significant bit of the
	source bit mask falls on the most significant bit of the dest bit mask.
	Note that delta is used for #bitShift: so
		shift > 0 : shift right
		shift < 0 : shift left
	e.g., if dstHigh > srcHigh we need to shift left and if dstHigh < srcHigh
	we need to shift right. This leads to:"
	shift := dstHigh - srcHigh.
	"And that's all we need"
	^ Array 
		with: shift
		with: mask! !

!ColorMap class methodsFor: 'instance creation' stamp: 'ar 2/22/2000 14:08'!
colors: colorArray
	^self new setShifts: nil masks: nil colors: colorArray! !

!ColorMap class methodsFor: 'instance creation' stamp: 'ar 5/4/2001 15:59'!
masks: maskArray shifts: shiftArray
	^self shifts: shiftArray masks: maskArray colors: nil.! !

!ColorMap class methodsFor: 'instance creation' stamp: 'lr 7/4/2009 10:42'!
mappingFrom: srcBitMasks to: dstBitMasks 
	"Return a color map mapping from the array of source bit masks
	to the array of dest bit masks."
	| shifts masks shiftAndMask |
	shifts := IntegerArray new: 4.
	masks := WordArray new: 4.
	1 
		to: 4
		do: 
			[ :i | 
			shiftAndMask := self 
				mapBitsFrom: (srcBitMasks at: i)
				to: (dstBitMasks at: i).
			shifts 
				at: i
				put: (shiftAndMask at: 1).
			masks 
				at: i
				put: (shiftAndMask at: 2) ].
	^ self 
		shifts: shifts
		masks: masks! !

!ColorMap class methodsFor: 'instance creation' stamp: 'ar 5/27/2000 20:08'!
mappingFromARGB: dstBitMasks
	"Return a ColorMap mapping from canonical ARGB space into dstBitMasks"
	^self mappingFrom: #(16rFF0000 16rFF00 16rFF 16rFF000000) to: dstBitMasks! !

!ColorMap class methodsFor: 'instance creation' stamp: 'ar 5/27/2000 20:08'!
mappingToARGB: srcBitMasks
	"Return a ColorMap mapping from srcBitMasks into canonical ARGB space"
	^self mappingFrom: srcBitMasks to: #(16rFF0000 16rFF00 16rFF 16rFF000000)! !

!ColorMappingCanvas commentStamp: 'LaurentLaffont 2/23/2011 20:17'!
I'm an abstract class which introduce a filter between a drawing request and the final output, handled by #mapColor:

For each potential pixel operation like: source -> op -> output
it introducing a color mapping stage: source -> op -> mapping -> output

Then #mapColor: can be redefined in subclasses to implement more specific behavior. For example:
- ShadowDrawingCanvas will replace the rendered color with the color of shadow (if not transparent).
- AlphaBlendingCanvas will add or intensify alpha of rendered color.

For an easy to understand example see  #drawPolygon:color:borderWidth:borderColor:!
!ColorMappingCanvas methodsFor: 'accessing' stamp: 'ar 6/22/1999 17:39'!
depth
	^myCanvas depth! !

!ColorMappingCanvas methodsFor: 'drawing-text' stamp: 'tween 3/10/2009 07:45'!
drawString: s from: firstIndex to: lastIndex in: boundsRect font: fontOrNil color: c underline: underline underlineColor: uc strikethrough: strikethrough strikethroughColor: sc
	"Draw the given string in the given font and color clipped to the given rectangle. If the font is nil, the default font is used."
	myCanvas
		drawString: s 
		from: firstIndex 
		to: lastIndex 
		in: boundsRect 
		font: fontOrNil 
		color: (self mapColor: c) 
		underline: underline 
		underlineColor: (self mapColor: uc) 
		strikethrough: strikethrough 
		strikethroughColor: (self mapColor: sc)! !

!ColorMappingCanvas methodsFor: 'accessing' stamp: 'ar 6/22/1999 17:39'!
origin
	^myCanvas origin! !

!ColorMappingCanvas methodsFor: 'drawing-images' stamp: 'ar 6/24/1999 18:26'!
stencil: aForm at: aPoint color: aColor
	myCanvas
		stencil: aForm
		at: aPoint
		color: (self mapColor: aColor)! !

!ColorMappingCanvas methodsFor: 'drawing' stamp: 'ar 6/22/1999 18:15'!
line: pt1 to: pt2 width: w color: c
	"Draw a line using the given width and color"
	myCanvas
		line: pt1
		to: pt2
		width: w
		color: (self mapColor: c).! !

!ColorMappingCanvas methodsFor: 'drawing-support' stamp: 'ar 6/22/1999 18:22'!
translateTo: newOrigin clippingTo: aRectangle during: aBlock
	"Set a new origin and clipping rectangle only during the execution of aBlock."
	| oldCanvas |
	oldCanvas := myCanvas.
	myCanvas translateTo: newOrigin clippingTo: aRectangle during:[:newCanvas|
		myCanvas := newCanvas.
		aBlock value: self].
	myCanvas := oldCanvas.! !

!ColorMappingCanvas methodsFor: '*Rubric-Editing-Core' stamp: 'AlainPlantec 4/22/2013 01:11'!
rubParagraph: paragraph bounds: bounds color: c
	"Draw the given paragraph"
	myCanvas
		rubParagraph: paragraph
		bounds: bounds
		color: (self mapColor: c)! !

!ColorMappingCanvas methodsFor: 'drawing-support' stamp: 'ar 6/22/1999 18:22'!
translateBy: delta during: aBlock
	"Set a translation only during the execution of aBlock."
	| oldCanvas |
	oldCanvas := myCanvas.
	myCanvas translateBy: delta during:[:newCanvas|
		myCanvas := newCanvas.
		aBlock value: self].
	myCanvas := oldCanvas.! !

!ColorMappingCanvas methodsFor: 'drawing-ovals' stamp: 'ar 6/22/1999 17:59'!
fillOval: r color: c borderWidth: borderWidth borderColor: borderColor
	"Fill the given oval."
	myCanvas
		fillOval: r
		color: (self mapColor: c)
		borderWidth: borderWidth
		borderColor: (self mapColor: borderColor)! !

!ColorMappingCanvas methodsFor: 'drawing-text' stamp: 'ar 12/31/2001 02:28'!
drawString: s from: firstIndex to: lastIndex in: boundsRect font: fontOrNil color: c
	"Draw the given string in the given font and color clipped to the given rectangle. If the font is nil, the default font is used."
	myCanvas
		drawString: s from: firstIndex to: lastIndex 
		in: boundsRect 
		font: fontOrNil 
		color: (self mapColor: c)! !

!ColorMappingCanvas methodsFor: 'private' stamp: 'ar 8/8/2001 14:15'!
image: aForm at: aPoint sourceRect: sourceRect rule: rule
	"Draw the given form. For the 'paint' combination rule use stenciling otherwise simply fill the source rectangle."
	^myCanvas image: aForm at: aPoint sourceRect: sourceRect rule: rule.! !

!ColorMappingCanvas methodsFor: 'drawing-support' stamp: 'di 10/16/1999 16:01'!
transformBy: aDisplayTransform clippingTo: aClipRect during: aBlock	 smoothing: cellSize

	"Transform the receiver by the given display transformation during the execution of aBlock. The given clip rectangle defines the *global* (e.g., outer) rectangle against which the receiver should clip (which would be equivalent to 'self clipRect: aClipRect; transformBy: aDisplayTransform')."
	| oldCanvas |
	oldCanvas := myCanvas.
	myCanvas transformBy: aDisplayTransform
		clippingTo: aClipRect
		during: [:newCanvas |
				myCanvas := newCanvas.
				aBlock value: self]
		smoothing: cellSize.
	myCanvas := oldCanvas.! !

!ColorMappingCanvas methodsFor: 'accessing' stamp: 'ar 6/22/1999 17:40'!
clipRect
	^myCanvas clipRect! !

!ColorMappingCanvas methodsFor: 'drawing-support' stamp: 'nice 12/26/2009 19:22'!
preserveStateDuring: aBlock
	"Preserve the full canvas state during the execution of aBlock"
	| oldCanvas result |
	oldCanvas := myCanvas.
	result := myCanvas preserveStateDuring:[:newCanvas|
		myCanvas := newCanvas.
		aBlock value: self].
	myCanvas := oldCanvas.
	^result! !

!ColorMappingCanvas methodsFor: 'initialization' stamp: 'ar 8/8/2001 14:14'!
on: aCanvas
	myCanvas := aCanvas.! !

!ColorMappingCanvas methodsFor: 'testing' stamp: 'ar 8/8/2001 14:16'!
isShadowDrawing
	^myCanvas isShadowDrawing! !

!ColorMappingCanvas methodsFor: 'accessing' stamp: 'ar 6/24/1999 17:54'!
form
	^myCanvas form! !

!ColorMappingCanvas methodsFor: 'initialization' stamp: 'ar 6/22/1999 18:23'!
reset
	myCanvas reset.! !

!ColorMappingCanvas methodsFor: 'drawing-polygons' stamp: 'mir 9/12/2001 14:24'!
drawPolygon: vertices color: aColor borderWidth: bw borderColor: bc
	"Draw the given polygon."
	^myCanvas
		drawPolygon: vertices
		color: aColor
		borderWidth: bw
		borderColor: (self mapColor: bc)! !

!ColorMappingCanvas methodsFor: 'drawing-images' stamp: 'ar 6/24/1999 18:26'!
stencil: aForm at: aPoint sourceRect: aRect color: aColor
	myCanvas
		stencil: aForm
		at: aPoint
		sourceRect: aRect
		color: (self mapColor: aColor)! !

!ColorMappingCanvas methodsFor: 'private' stamp: 'ar 8/8/2001 14:15'!
mapColor: aColor
	^aColor! !

!ColorMappingCanvas methodsFor: 'accessing' stamp: 'ar 6/22/1999 17:39'!
extent
	^myCanvas extent! !

!ColorMappingCanvas methodsFor: 'drawing-rectangles' stamp: 'ar 6/22/1999 18:01'!
frameAndFillRectangle: r fillColor: fillColor borderWidth: borderWidth topLeftColor: topLeftColor bottomRightColor: bottomRightColor
	"Draw the rectangle using the given attributes"
	myCanvas
		frameAndFillRectangle: r 
		fillColor: (self mapColor: fillColor) 
		borderWidth: borderWidth 
		topLeftColor: (self mapColor: topLeftColor)
		bottomRightColor: (self mapColor: bottomRightColor)! !

!ColorMappingCanvas methodsFor: 'other' stamp: 'ar 6/22/1999 18:21'!
translateBy: delta clippingTo: aRectangle during: aBlock
	"Set a translation and clipping rectangle only during the execution of aBlock."
	| oldCanvas |
	oldCanvas := myCanvas.
	myCanvas translateBy: delta clippingTo: aRectangle during:[:newCanvas|
		myCanvas := newCanvas.
		aBlock value: self].
	myCanvas := oldCanvas.! !

!ColorMappingCanvas methodsFor: 'drawing' stamp: 'ar 6/22/1999 18:16'!
paragraph: paragraph bounds: bounds color: c
	"Draw the given paragraph"
	myCanvas
		paragraph: paragraph
		bounds: bounds
		color: (self mapColor: c)! !

!ColorMappingCanvas methodsFor: 'drawing-rectangles' stamp: 'ar 6/22/1999 17:59'!
frameAndFillRectangle: r fillColor: fillColor borderWidth: borderWidth borderColor: borderColor
	"Draw the rectangle using the given attributes"
	myCanvas
		frameAndFillRectangle: r
		fillColor: (self mapColor: fillColor)
		borderWidth: borderWidth
		borderColor: (self mapColor: borderColor)! !

!ColorMappingCanvas methodsFor: 'initialization' stamp: 'ar 6/22/1999 18:24'!
flush
	myCanvas flush.! !

!ColorMappingCanvas methodsFor: 'drawing-support' stamp: 'ar 6/22/1999 18:19'!
clipBy: aRectangle during: aBlock
	"Set a clipping rectangle active only during the execution of aBlock.
	Note: In the future we may want to have more general clip shapes - not just rectangles"
	| oldCanvas |
	oldCanvas := myCanvas.
	myCanvas clipBy: aRectangle during:[:newCanvas|
		myCanvas := newCanvas.
		aBlock value: self].
	myCanvas := oldCanvas! !

!ColorMappingCanvas class methodsFor: 'instance creation' stamp: 'ar 6/22/1999 18:23'!
on: aCanvas
	^self new on: aCanvas! !

!ColorPresenterMorph commentStamp: 'gvc 5/18/2007 13:38'!
Displays a colour with alpha against a white, hatched and black background.!
!ColorPresenterMorph methodsFor: 'instance creation' stamp: 'gvc 9/22/2006 09:45'!
on: anObject color: getColSel
	"Set the receiver to the given model parameterized by the given message selectors."

	self
		model: anObject;
		getColorSelector: getColSel;
		updateColor! !

!ColorPresenterMorph methodsFor: 'accessing' stamp: 'gvc 9/18/2006 15:48'!
labelMorph: anObject
	"Set the value of labelMorph"

	labelMorph := anObject! !

!ColorPresenterMorph methodsFor: 'private - layout' stamp: 'gvc 7/30/2009 18:36'!
updateColor
	"Update the color state."

	|col|
	self getColorSelector ifNotNil: [
		col := (self model perform: self getColorSelector) ifNil: [Color transparent].
		self setColor: col]! !

!ColorPresenterMorph methodsFor: 'updating' stamp: 'gvc 9/22/2006 09:34'!
update: aSymbol 
	"Refer to the comment in View|update:."

	aSymbol == self getColorSelector ifTrue: 
		[self updateColor.
		^ self]! !

!ColorPresenterMorph methodsFor: 'instance creation' stamp: 'gvc 9/22/2006 09:23'!
newContentMorph
	"Answer a new content morph"

	^Morph new
		color: Color transparent;
		changeTableLayout;
		borderStyle: (BorderStyle inset width: 1);
		vResizing: #spaceFill;
		hResizing: #spaceFill;
		addMorph: self newHatchMorph;
		yourself! !

!ColorPresenterMorph methodsFor: 'accessing' stamp: 'gvc 9/22/2006 09:25'!
contentMorph: anObject
	"Set the value of contentMorph"

	contentMorph := anObject! !

!ColorPresenterMorph methodsFor: 'accessing' stamp: 'gvc 9/22/2006 09:25'!
contentMorph
	"Answer the value of contentMorph"

	^ contentMorph! !

!ColorPresenterMorph methodsFor: 'private' stamp: 'gvc 9/18/2006 16:04'!
hatchForm
	"Answer a form showing a grid hatch pattern."

	^self class hatchForm! !

!ColorPresenterMorph methodsFor: 'instance creation' stamp: 'IgorStasenko 12/19/2012 17:24'!
newHatchMorph
	"Answer a new morph showing a grid hatch pattern."

	^Morph new
		color: Color transparent;
		changeProportionalLayout;
		vResizing: #spaceFill;
		hResizing: #spaceFill;
		minWidth: 48;
		minHeight: 12;
		addMorph: (Morph new color: Color white)
		fullFrame: (0@0 corner: 0.3@1) asLayoutFrame ;
		addMorph: (Morph new fillStyle: (InfiniteForm with: self hatchForm))
		fullFrame: (0.3@0 corner: 0.7@1) asLayoutFrame;
		addMorph: self solidLabelMorph
		fullFrame: (0.7@0 corner: 1@1) asLayoutFrame;
		addMorph: self labelMorph
		fullFrame: (0@0 corner: 1@1) asLayoutFrame ! !

!ColorPresenterMorph methodsFor: 'accessing' stamp: 'gvc 9/18/2006 15:48'!
getColorSelector: anObject
	"Set the value of getColorSelector"

	getColorSelector := anObject! !

!ColorPresenterMorph methodsFor: 'instance creation' stamp: 'gvc 9/18/2006 16:20'!
newLabelMorph
	"Answer a new label morph"

	^Morph new! !

!ColorPresenterMorph methodsFor: 'accessing' stamp: 'gvc 9/18/2006 15:48'!
getColorSelector
	"Answer the value of getColorSelector"

	^ getColorSelector! !

!ColorPresenterMorph methodsFor: 'initialization' stamp: 'gvc 9/22/2006 09:34'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		borderWidth: 0;
		changeTableLayout;
		labelMorph: self newLabelMorph;
		solidLabelMorph: self newLabelMorph;
		contentMorph: self newContentMorph;
		addMorphBack: self contentMorph! !

!ColorPresenterMorph methodsFor: 'accessing' stamp: 'gvc 9/18/2006 15:48'!
labelMorph
	"Answer the value of labelMorph"

	^ labelMorph! !

!ColorPresenterMorph methodsFor: 'accessing' stamp: 'gvc 9/18/2006 16:17'!
solidLabelMorph: anObject
	"Set the value of solidLabelMorph"

	solidLabelMorph := anObject! !

!ColorPresenterMorph methodsFor: 'accessing' stamp: 'gvc 9/18/2006 16:17'!
solidLabelMorph
	"Answer the value of solidLabelMorph"

	^ solidLabelMorph! !

!ColorPresenterMorph methodsFor: 'accessing' stamp: 'gvc 6/3/2009 18:14'!
setColor: aColor
	"Update the colour of the labels."

	self labelMorph color: aColor.
	self solidLabelMorph color: aColor asNontranslucentColor! !

!ColorPresenterMorph class methodsFor: 'instance creation' stamp: 'StephaneDucasse 3/3/2010 16:12'!
on: anObject color: getSel
	"Answer a new instance of the receiver on the given model using
	the given selectors as the interface."
	
	"(ColorPresenterMorph on: (BorderedMorph new) color: #color) openInWorld"
	
	^self new
		on: anObject 
		color: getSel! !

!ColorPresenterMorph class methodsFor: 'example' stamp: 'StephaneDucasse 7/10/2014 08:12'!
example

	^ (ColorPresenterMorph on: (BorderedMorph new) color: #color) openInWorld! !

!ColorPresenterMorph class methodsFor: 'graphics constants' stamp: 'gvc 9/18/2006 16:05'!
hatchForm
	"Answer a form showing a grid hatch pattern."

	^HatchForm ifNil: [HatchForm := self newHatchForm]! !

!ColorPresenterMorph class methodsFor: 'graphics constants' stamp: 'gvc 9/18/2006 16:24'!
newHatchForm
	"Answer a new hatch form."
	
	^(Form
	extent: 8@8
	depth: 1
	fromArray: #( 4026531840 4026531840 4026531840 4026531840 251658240 251658240 251658240 251658240)
	offset: 0@0)! !

!ColorSelectorDialogWindow commentStamp: 'gvc 5/18/2007 13:35'!
Standard dialog for selecting a colour by HSVA colour selector, picking from the screen or editing of values.!
!ColorSelectorDialogWindow methodsFor: 'actions' stamp: 'gvc 9/26/2006 13:11'!
newHSVAColorSelectorMorph
	"Answer a hsva color selector."

	^HSVAColorSelectorMorph new
		extent: (40@28) + 152;
		when: #selectedColor send: #colorSelected: to: self! !

!ColorSelectorDialogWindow methodsFor: 'actions' stamp: 'MarcusDenker 7/9/2014 21:38'!
pickColor
	"Pick a colour from the screen."

	|p c h|

	h := self activeHand.
	h showTemporaryCursor: Smalltalk ui icons eyedropperIcon 
		hotSpotOffset: 6 @ 31.
		
		
	h captureEventsUntil: [:evt |
		evt isMove ifTrue: [
			p := evt position.
				(self hsvaMorph containsPoint: p)
				ifFalse: ["deal with the fact that 32 bit displays may have garbage in the alpha bits"
						c := Display depth = 32 
							ifTrue: [Color
									colorFromPixelValue: ((Display pixelValueAt: p) bitOr: 16rFF000000)
									depth: 32]
							ifFalse: [Display colorAt: p]].
			h position: p.
			self selectedColor ~= c ifTrue: [
				self selectedColor: c]].
"			self world displayWorldSafely. "
		h anyButtonPressed	
	].
	h showTemporaryCursor: nil! !

!ColorSelectorDialogWindow methodsFor: 'actions' stamp: 'HenrikSperreJohansen 5/21/2010 14:17'!
newContentMorph
	"Answer a new content morph."

	self hsvaMorph: self newHSVAColorSelectorMorph.
	^self newRow: {
		self newGroupbox: 'Color' translated forAll: {
			self hsvaMorph.
			(self newRow: {
				(self newLabelGroup: {
					'Selected color' translated -> self newColorPresenterMorph})
					vResizing: #shrinkWrap.
				self newColorPickerButtonMorph})
				cellPositioning: #leftCenter}.
		(self newGroupbox: 'Values' translated for: 
			(self newLabelGroup: {
				'Red' translated -> (self newColorComponentFieldMorph: #red).
				'Green' translated -> (self newColorComponentFieldMorph: #green).
				'Blue' translated -> (self newColorComponentFieldMorph: #blue).
				'Hue' translated -> (self newColorComponentFieldMorph: #hue).
				'Saturation' translated -> (self newColorComponentFieldMorph: #saturation).
				'Brightness' translated -> (self newColorComponentFieldMorph: #brightness).
				'Alpha' translated -> (self newColorComponentFieldMorph: #alpha)}))
			hResizing: #shrinkWrap}! !

!ColorSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 9/22/2006 16:36'!
saturation: anInteger
	"Set the saturation value of the selected color."

	|c|
	c := self selectedColor.
	self selectedColor: ((Color h: c hue s: anInteger / 255 v: c brightness) alpha: c alpha)! !

!ColorSelectorDialogWindow methodsFor: 'initialization' stamp: 'gvc 9/22/2006 10:06'!
initialize
	"Initialize the receiver."

	self
		basicSelectedColor: Color blue.
	super initialize.
	self selectedColor: self selectedColor! !

!ColorSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 9/22/2006 16:30'!
alpha
	"Answer the alpha value of the selected color."

	^(self selectedColor alpha * 255) asInteger! !

!ColorSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 9/22/2006 10:04'!
hsvaMorph
	"Answer the value of hsvaMorph"

	^ hsvaMorph! !

!ColorSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 9/22/2006 09:49'!
selectedColor
	"Answer the value of selectedColor"

	^ selectedColor! !

!ColorSelectorDialogWindow methodsFor: 'coloring' stamp: 'gvc 9/28/2006 12:14'!
green: anInteger
	"Set the green value of the selected color."

	|c|
	c := self selectedColor.
	self selectedColor: ((Color r: c red * 255 g: anInteger b: c blue * 255 range: 255) alpha: c alpha)! !

!ColorSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 9/22/2006 16:21'!
alpha: anInteger
	"Set the alpha value of the selected color."

	|c|
	c := self selectedColor.
	self selectedColor: (c alpha: anInteger / 255)! !

!ColorSelectorDialogWindow methodsFor: 'accessing' stamp: 'dik 6/27/2010 16:56'!
basicSelectedColor: anObject
	"Set the value of selectedColor"

	selectedColor := anObject.
	
	self
		changed: #selectedColor;
		changed: #red;
		changed: #green;
		changed: #blue;
		changed: #hue;
		changed: #saturation;
		changed: #brightness;
		changed: #alpha.
		
	self announcer announce: (ColorChanged to: selectedColor).! !

!ColorSelectorDialogWindow methodsFor: 'actions' stamp: 'gvc 9/28/2006 12:11'!
newColorComponentFieldMorph: aspect
	"Answer a text entry for the specified aspect of the color."

	^(self
		newTextEntryFor: self
		get: aspect
		set: (aspect, ':') asSymbol
		class: Integer
		getEnabled: nil
		help: nil)
		acceptOnFocusChange: true;
		minWidth: 40! !

!ColorSelectorDialogWindow methodsFor: 'actions' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
newColorPickerButtonMorph
	"Answer a button to enable picking of colour."

	^self
		newButtonFor: self
		getState: nil
		action: #pickColor
		arguments: nil
		getEnabled: nil
		labelForm: ((Smalltalk ui icons eyedropperIcon)
						scaledIntoFormOfSize: 16)
		help: 'Pick a color from the screen' translated! !

!ColorSelectorDialogWindow methodsFor: 'constants' stamp: 'gvc 9/22/2006 16:30'!
green
	"Answer the green value of the selected color."

	^(self selectedColor green * 255) asInteger! !

!ColorSelectorDialogWindow methodsFor: 'constants' stamp: 'gvc 9/22/2006 16:30'!
blue
	"Answer the blue value of the selected color."

	^(self selectedColor blue * 255) asInteger! !

!ColorSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 9/22/2006 10:03'!
selectedColor: aColor
	"Set the value of selectedColor. Update the color selectors."

	self basicSelectedColor: aColor.
	self hsvaMorph selectedColor: aColor! !

!ColorSelectorDialogWindow methodsFor: 'coloring' stamp: 'gvc 9/28/2006 12:14'!
blue: anInteger
	"Set the blue value of the selected color."

	|c|
	c := self selectedColor.
	self selectedColor: ((Color r: c red * 255 g: c green * 255 b: anInteger range: 255) alpha: c alpha)! !

!ColorSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 9/22/2006 11:13'!
colorSelected: aColor
	"A color has been selected.."

	self basicSelectedColor: aColor! !

!ColorSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 9/22/2006 16:37'!
brightness: anInteger
	"Set the brightness value of the selected color."

	|c|
	c := self selectedColor.
	self selectedColor: ((Color h: c hue s: c saturation v: anInteger / 255) alpha: c alpha)! !

!ColorSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 9/22/2006 10:04'!
hsvaMorph: anObject
	"Set the value of hsvaMorph"

	hsvaMorph := anObject! !

!ColorSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 9/28/2006 12:16'!
hue: anInteger
	"Set the hue value of the selected color."

	|c|
	c := self selectedColor.
	self selectedColor: ((Color h: (anInteger / 255 * 359) rounded s: c saturation v: c brightness) alpha: c alpha)! !

!ColorSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 9/22/2006 16:38'!
saturation
	"Answer the saturation value of the selected color."

	^(self selectedColor saturation * 255) asInteger! !

!ColorSelectorDialogWindow methodsFor: 'constants' stamp: 'gvc 9/22/2006 16:29'!
red
	"Answer the red value of the selected color."

	^(self selectedColor red * 255) asInteger! !

!ColorSelectorDialogWindow methodsFor: 'actions' stamp: 'HenrikSperreJohansen 5/21/2010 14:11'!
defaultLabel
	"Answer the default label for the receiver."

	^'Color Selector' translated! !

!ColorSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 9/22/2006 16:38'!
hue
	"Answer the hue value of the selected color."

	^(self selectedColor hue / 359 * 255) asInteger! !

!ColorSelectorDialogWindow methodsFor: 'coloring' stamp: 'gvc 9/28/2006 12:14'!
red: anInteger
	"Set the red value of the selected color."

	|c|
	c := self selectedColor.
	self selectedColor: ((Color r: anInteger g: c green * 255 b: c blue * 255 range: 255) alpha: c alpha)! !

!ColorSelectorDialogWindow methodsFor: 'actions' stamp: 'HenrikSperreJohansen 5/21/2010 14:16'!
newColorPresenterMorph
	"Answer a color presenter."

	^self
		newColorPresenterFor: self
		getColor: #selectedColor 
		help: 'Shows the selected color' translated! !

!ColorSelectorDialogWindow methodsFor: 'accessing' stamp: 'gvc 9/22/2006 16:38'!
brightness
	"Answer the brightness value of the selected color."

	^(self selectedColor brightness * 255) asInteger! !

!ColorTest methodsFor: 'testing' stamp: 'HenrikSperreJohansen 5/27/2010 23:37'!
test32BitTranslucentPixelValueKeepsRGB
	"The pixel value of a translucent color at depth32 should keep the RGB component irrespective of alpha.
	At the time of this test, setting an alpha of zero made the entire pixel 0 irrespective of depth..."
	self assert: 16rFFFFFF equals: ((Color white alpha: 0) pixelValueForDepth: 32)! !

!ColorTest methodsFor: 'testing' stamp: 'dg 2/19/2008 13:19'!
testAsHTMLColor

	| table aColorString |
	table := #('0' '1' '2' '3' '4' '5' '6' '7' '8' '9' 'A' 'B' 'C' 'D' 'E' 'F').

	table do: [ :each |
		aColorString := '#', each, each, '0000'.
		self assert: ((Color fromString: aColorString) asHTMLColor sameAs: aColorString)].

	table do: [ :each |
		aColorString := '#', '00', each, each, '00'.
		self assert: ((Color fromString: aColorString) asHTMLColor sameAs: aColorString)].

	table do: [ :each |
		aColorString := '#', '0000', each, each.
		self assert: ((Color fromString: aColorString) asHTMLColor sameAs: aColorString)].

	table do: [ :each |
		aColorString := '#', each, each, each, each, each, each.
		self assert: ((Color fromString: aColorString) asHTMLColor sameAs: aColorString)].! !

!ColorTest methodsFor: 'asserting' stamp: 'NicolaiHess 8/7/2014 00:01'!
assertColorrefFor: aColor equals: anInteger
	| colorref |
	colorref := aColor asColorref.
	self
		assert: colorref = anInteger
		description:
			('(<1p>) asColorref was <2s>; should have been <3s>' expandMacrosWith: aColor with: colorref hex with: anInteger hex)! !

!ColorTest methodsFor: 'testing' stamp: 'fbs 2/3/2005 12:56'!
testMultiplyByNumber
	| newColor oldColor tolerance |
	tolerance := 0.001.

	oldColor := Color r: 0.75 g: 0.5 b: 0.25.
	newColor := oldColor * 2.

	self assert: (1 - newColor red) abs < tolerance.
	self assert: (1 - newColor green) abs < tolerance.
	self assert: (0.5 - newColor blue) abs < tolerance.! !

!ColorTest methodsFor: 'testing' stamp: 'NicolaiHess 8/7/2014 00:02'!
testAsColorrefPrimaryColors
"issue 13784 Color>>#asColorref ignores blue"
	self assertColorrefFor: Color black equals: 16r000000;
	assertColorrefFor: Color red equals: 16r0000FF;
	assertColorrefFor: Color green equals: 16r00FF00;
	assertColorrefFor: Color yellow equals: 16r00FFFF;
	assertColorrefFor: Color blue equals: 16rFF0000;
	assertColorrefFor: Color cyan equals: 16rFFFF00;
	assertColorrefFor: Color magenta  equals: 16rFF00FF;
	assertColorrefFor: Color white equals: 16rFFFFFF! !

!ColorTest methodsFor: 'tests' stamp: 'VincentBlondeau 1/30/2015 17:50'!
test32BlackColorTranformation
	"Solve bug: https://pharo.fogbugz.com/f/cases/14619/Strange-behavior-of-TestRunner-Icon"

	self assert: ((Color black pixelWordForDepth: 32) asColorOfDepth: 32) equals: Color black! !

!ColorTest methodsFor: 'testing' stamp: 'dg 2/19/2008 12:43'!
testColorFrom
	self assert: ((Color colorFrom: #white) asHTMLColor sameAs: '#ffffff').
	self assert: ((Color colorFrom: #(1.0 0.5 0.0)) asHTMLColor sameAs: '#ff8000').
	self assert: ((Color colorFrom: (Color white)) asHTMLColor sameAs: '#ffffff').
	self assert: ((Color colorFrom: '#FF8800') asHTMLColor sameAs: '#ff8800').
	self assert: ((Color colorFrom: '#222222') asHTMLColor sameAs: '#222222').! !

!ColorTest methodsFor: 'testing' stamp: 'nice 2/20/2012 18:46'!
testFromString
	self assert: ((Color fromString: '#FF8800') asHTMLColor sameAs: '#ff8800');
		assert: ((Color fromString: 'FF8800') asHTMLColor sameAs: '#ff8800');
		assert: ((Color fromString: 'white') asHTMLColor sameAs: '#ffffff');
		assert: ((Color fromString: 'black') asHTMLColor sameAs: '#000000');
		assert: ((Color fromString: nil) asHTMLColor sameAs: '#ffffff');
		assert: ((Color fromString: 'inexistent color') asHTMLColor sameAs: '#ffffff'); "should return white"
		assert: ((Color fromString: 'XXXXXX') asHTMLColor sameAs: '#ffffff'); "not alphanumeric"
		assert: ((Color fromString: '00000000') asHTMLColor sameAs: '#ffffff'). "too many digits"
		
	self
		assert: (Color fromString: 'DARKGRAY') = Color darkGray description: 'Color can be specified with a case insensitive color name';
		assert: (Color fromString: '#blue') = Color blue description: 'Color can be specified with a leading literal sharp'.! !

!ColorTest methodsFor: 'testing' stamp: 'fbs 2/3/2005 13:13'!
testMultiplyByArray
	| newColor oldColor tolerance |
	tolerance := 0.001.

	oldColor := Color r: 0.75 g: 0.5 b: 0.25.
	newColor := oldColor * #(0.1 2 3).

	self assert: (0.075 - newColor red) abs < tolerance.
	self assert: (1 - newColor green) abs < tolerance.
	self assert: (0.75 - newColor blue) abs < tolerance.! !

!ColorTest methodsFor: 'testing' stamp: 'HenrikSperreJohansen 5/27/2010 23:36'!
test32BitOpaqueBlackIsTotallyBlack
	"The pixel value of a black at depth32 should really be black..."
	"At the time of this test, it returned 16rFF000001 ...."
	self assert: 16rFF000000 equals: (Color black pixelValueForDepth: 32)! !

!ColorTest methodsFor: 'testing' stamp: 'fbs 2/3/2005 12:57'!
testMultiplyByArrayIdentityTransform
	| newColor oldColor tolerance |
	tolerance := 0.001.

	oldColor := Color r: 0.75 g: 0.5 b: 0.25.
	newColor := oldColor * 2.

	self assert: (1 - newColor red) abs < tolerance.
	self assert: (1 - newColor green) abs < tolerance.
	self assert: (0.5 - newColor blue) abs < tolerance.! !

!ColorTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:23'!
testPrintHtmlString
	"self debug: #testPrintHtmlString"

	Color white printHtmlString.
	self assert: Color white printHtmlString = 'FFFFFF'.
	self assert: Color red printHtmlString = 'FF0000'.
	self assert: Color black printHtmlString = '000000'! !

!CombinedChar commentStamp: 'StephaneDucasse 3/27/2010 21:50'!
Compositions classVar is a:
<Dictionary
       key: firstLetter charCode
       value: (Dictionary
             	  key: diacritical charCode
              	 value: combined charCode)>
	
combined instVar is a <Character>!
!CombinedChar methodsFor: 'accessing' stamp: 'StephaneDucasse 3/27/2010 21:51'!
combined

	^ combined
! !

!CombinedChar methodsFor: 'accessing' stamp: 'StephaneDucasse 3/27/2010 21:51'!
base

	^ codes first
! !

!CombinedChar methodsFor: 'composition' stamp: 'StephaneDucasse 4/4/2010 15:04'!
add: char

	| dict elem |
	codes ifNil: 
			[ codes := Array with: char. 
			combined := char. 
			^ true].
	dict := Compositions at: combined charCode ifAbsent: [^ false].
	elem := dict at: char charCode ifAbsent: [^ false].
	codes := codes copyWith: char.
	combined := Character leadingChar: self base leadingChar code: elem.
	^ true
! !

!CombinedChar methodsFor: 'composition' stamp: 'StephaneDucasse 3/27/2010 21:57'!
combinesWith: char

	| dict |
	codes ifNil: [^false].
	dict := Compositions at: combined charCode ifAbsent: [^false].
	dict at: char charCode ifAbsent: [^false].
	^true
! !

!CombinedChar methodsFor: 'composition' stamp: 'StephaneDucasse 3/27/2010 21:56'!
simpleAdd: char

	| dict elem |
	codes ifNil: 
		[codes := Array with: char. 
		combined := char. 
		^ true].
	dict := Compositions at: combined charCode ifAbsent: [^ false].
	elem := dict at: char charCode ifAbsent: [^ false].
	combined := Character leadingChar: self base leadingChar code: elem.
	codes at: 1 put: combined.
	^ true
! !

!CombinedChar class methodsFor: '*Unicode-Initialization' stamp: 'PavelKrivanek 3/9/2012 09:33'!
parseCompositionMappingFrom: stream
"
	self halt.
	self parseCompositionMapping
"

	| line fieldEnd point fieldStart compositions toNumber diacritical result |

	toNumber := [:quad | ('16r', quad) asNumber].

	Compositions := IdentityDictionary new: 2048.
	Decompositions := IdentityDictionary new: 2048.
	Diacriticals := IdentitySet new: 2048.

	[(line := stream nextLine) notNil] whileTrue: [
		fieldEnd := line indexOf: $; startingAt: 1.
		point := ('16r', (line copyFrom: 1 to: fieldEnd - 1)) asNumber.
		2 to: 6 do: [:i |
			fieldStart := fieldEnd + 1.
			fieldEnd := line indexOf: $; startingAt: fieldStart.
		].
		compositions := line copyFrom: fieldStart to: fieldEnd - 1.
		(compositions size > 0 and: [compositions first ~= $<]) ifTrue: [
			compositions := compositions substrings collect: toNumber.
			compositions size > 1 ifTrue: [
				diacritical := compositions first.
				Diacriticals add: diacritical.
				result := compositions second.
				(Decompositions includesKey: point) ifTrue: [
					self error: 'should not happen'.
				] ifFalse: [
					Decompositions at: point put: (Array with: diacritical with: result).
				].
				(Compositions includesKey: diacritical) ifTrue: [
					(Compositions at: diacritical) at: result put: point.
				] ifFalse: [
					Compositions at: diacritical
						put: (IdentityDictionary new at: result put: point; yourself).
				].
			].
		].
	].
! !

!CombinedChar class methodsFor: '*Unicode-Initialization' stamp: 'SvenVanCaekenberghe 1/15/2013 15:02'!
loadCompositionMapping
	| url |
	url := 'http://unicode.org/Public/UNIDATA/UnicodeData.txt' asZnUrl.
	self parseCompositionMappingFrom: url retrieveContents readStream! !

!CombinedChar class methodsFor: 'testing' stamp: 'michael.rueger 3/2/2009 10:13'!
isCompositionCharacter: charCode
	^Compositions includesKey: charCode! !

!CombinedChar class methodsFor: 'testing' stamp: 'yo 12/31/2002 19:21'!
isDiacriticals: unicode

	^ Diacriticals includes: unicode.
! !

!CommandLineArguments commentStamp: '<historical>'!
The CommandLineArguments represents the arguments passed to the image.
In the following case,

	$PHARO_VM myImage.image --foo bar
	
`CommandLineArguments default` contains {'--foo'. 'bar'}.!
!CommandLineArguments methodsFor: 'accessing' stamp: 'CamilloBruni 12/4/2012 19:48'!
optionAt: aString
	^ self optionAt: aString ifAbsent: [
		Error signal: 'Could not find option ', aString ]! !

!CommandLineArguments methodsFor: 'accessing' stamp: 'DamienCassou 12/11/2013 15:46'!
optionAt: aString ifPresent: presentBlock ifAbsent: absentBlock
	| option |
	option := self optionAt: aString ifAbsent: [ ^ absentBlock value ].
	^ presentBlock value: option! !

!CommandLineArguments methodsFor: 'copying' stamp: 'CamilloBruni 5/1/2012 20:07'!
copySubcommand
	"return a new copy of this CommandLine without the first arguments"
	^ self class withArguments: arguments allButFirst! !

!CommandLineArguments methodsFor: 'testing' stamp: 'CamilloBruni 5/2/2012 14:07'!
includesSubCommand: aName
	self withFirstArgument: [ :arg|
		arg = aName ifTrue: [ ^ true ]].
	^ false! !

!CommandLineArguments methodsFor: 'accessing' stamp: 'CamilloBruni 5/1/2012 19:57'!
argumentAt: index
	^ arguments at: index ! !

!CommandLineArguments methodsFor: 'testing' stamp: 'CamilloBruni 12/4/2012 20:25'!
shortOptionAt: aString ifAbsent: absentBlock
	| index |
	index := (arguments indexOf: '-', aString) + 1.
	^ (index <= 1 or: [ index > arguments size ])
		ifFalse: [ arguments at: index ]
		ifTrue: absentBlock! !

!CommandLineArguments methodsFor: 'testing' stamp: 'CamilloBruni 4/28/2012 19:54'!
withFirstArgument: aBlock
	self arguments ifEmpty: [ ^ self ].
	^ aBlock value: self arguments first! !

!CommandLineArguments methodsFor: 'initialization' stamp: 'CamilloBruni 5/13/2012 19:47'!
initialize
	
	| documentPath  |
	
	arguments := OrderedCollection withAll: Smalltalk arguments.
	documentPath := Smalltalk vm documentPath.
	documentPath isEmptyOrNil
		ifFalse: [ arguments addFirst: documentPath ].! !

!CommandLineArguments methodsFor: 'testing' stamp: 'CamilloBruni 5/1/2012 20:50'!
hasArguments
	^ arguments size > 0! !

!CommandLineArguments methodsFor: 'testing' stamp: 'CamilloBruni 10/13/2012 15:13'!
hasOption: aString
	| option |
	option := (aString size = 1
					ifTrue: [ '-']
					ifFalse: [ '--']), aString.
	(self arguments includes: option) ifTrue: [ ^ true ].
	option := option,'='.
	^ self arguments anySatisfy: [ :arg| arg beginsWith: option ].! !

!CommandLineArguments methodsFor: 'testing' stamp: 'CamilloBruni 5/13/2012 19:47'!
commandLineArguments
	"self commandLineArguments"
	
	| documentPath args |
	
	args := OrderedCollection withAll: Smalltalk arguments.
	documentPath := Smalltalk vm documentPath.
	documentPath isEmptyOrNil
		ifFalse: [ args addFirst: documentPath ].
 	^ args.! !

!CommandLineArguments methodsFor: 'testing' stamp: 'CamilloBruni 12/4/2012 19:49'!
shortOptionAt: aString
	^ self shortOptionAt: aString ifAbsent: [
		Error signal: 'Could not find short-form option: ', aString  ]! !

!CommandLineArguments methodsFor: 'testing' stamp: 'CamilloBruni 5/2/2012 12:55'!
hasFileWithExtension: aFileExtension
	"return true if the first argument has the given file extension"
	^ self arguments anySatisfy: [ :arg| 
		arg endsWith: aFileExtension].! !

!CommandLineArguments methodsFor: 'accessing' stamp: 'CamilloBruni 12/4/2012 19:47'!
optionAt: aString ifAbsent: absentBlock
	^ (aString size = 1)
		ifTrue: [ self shortOptionAt: aString ifAbsent: absentBlock ]
		ifFalse: [ self longOptionAt: aString ifAbsent: absentBlock ]! !

!CommandLineArguments methodsFor: 'testing' stamp: 'CamilloBruni 12/4/2012 19:49'!
longOptionAt: aString
	^ self longOptionAt: aString ifAbsent: [
		Error signal: 'Could not find long-form option: ', aString  ]! !

!CommandLineArguments methodsFor: 'accessing' stamp: 'CamilloBruni 4/28/2012 19:42'!
arguments
	^ arguments! !

!CommandLineArguments methodsFor: 'accessing' stamp: 'CamilloBruni 5/2/2012 12:33'!
allFilesWithExtension: anExtension
	^ self arguments select: [ :arg|
		arg endsWith: anExtension ]! !

!CommandLineArguments methodsFor: 'testing' stamp: 'GabrielOmarCotelli 12/3/2013 17:13'!
longOptionAt: aString ifAbsent: absentBlock
	| optionStart |
	optionStart := '--' , aString , '='.
	^ self arguments
		detect: [ :arg | arg beginsWith: optionStart ]
		ifFound: [ :option | (option splitOn: '=') second ]
		ifNone: absentBlock! !

!CommandLineArguments methodsFor: 'initialize-release' stamp: 'CamilloBruni 5/1/2012 20:01'!
initializeWithArguments: aCollection
	super initialize.
	arguments := aCollection.! !

!CommandLineArguments methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/22/2013 18:56'!
optionAt: aString ifPresent: presentBlock
	| option |
	
	option := self optionAt: aString ifAbsent: [ ^ self ].
	^ presentBlock value: option! !

!CommandLineArguments class methodsFor: 'instance creation' stamp: 'CamilloBruni 5/1/2012 20:00'!
withArguments: aCollection
	^ self basicNew 
		initializeWithArguments: aCollection;
		yourself! !

!CommandLineArguments class methodsFor: 'instance creation' stamp: 'CamilloBruni 5/2/2012 11:41'!
default
	^ singleton ifNil: [singleton := self new initialize]! !

!CommandLineArgumentsTest commentStamp: 'AdrienBarreau 2/12/2011 15:55'!
That class tests the API given by AbstractUserInput. Since that class is obviously abstract, it can't be instantiated, the tests are running on CommandLine (which inherits from AbstractUserInput)!
!CommandLineArgumentsTest methodsFor: 'accessing' stamp: 'CamilloBruni 5/1/2012 14:10'!
commandLine
	^ commandLine! !

!CommandLineArgumentsTest methodsFor: 'tests' stamp: 'CamilloBruni 5/2/2012 12:50'!
testHasFilesTyped
	self assert: (self commandLine hasFileWithExtension: #txt).
	self deny: (self commandLine hasFileWithExtension: #foo).! !

!CommandLineArgumentsTest methodsFor: 'tests' stamp: 'CamilloBruni 10/13/2012 15:17'!
testHasOption
	self assert: (self commandLine hasOption: #option1).
	self assert: (self commandLine hasOption: #option4).
	self assert: (self commandLine hasOption: #option5).
	self assert: (self commandLine hasOption: #o).
	self deny: (self commandLine hasOption: #foo).
	self deny: (self commandLine hasOption: #option5Value).! !

!CommandLineArgumentsTest methodsFor: 'accessing' stamp: 'CamilloBruni 10/13/2012 15:17'!
parameters
	^ #('noOpt1' 'noOpt2.txt' 'noOpt3.avi' '--option1' 'opt11' 'opt12.txt' 'opt13.avi' '--option2' '--option3' 'opt31.st' 'opt32' '--option4' '--option5=option5Value' '-o' 'oValue')! !

!CommandLineArgumentsTest methodsFor: 'tests' stamp: 'CamilloBruni 10/13/2012 15:18'!
tesOptionAt
	self assert: (self commandLine optionAt: #option1) equals: nil.
	self assert: (self commandLine optionAt: #option4) equals: nil.
	self assert: (self commandLine optionAt: #option5) equals: 'option5Value'.
	self assert: (self commandLine optionAt: #foo) equals: nil.
	self assert: (self commandLine optionAt: #o) equals: 'oValue'.! !

!CommandLineArgumentsTest methodsFor: 'tests' stamp: 'CamilloBruni 10/15/2013 01:19'!
testAllParameters
	self assertCollection: self commandLine arguments equals: self parameters! !

!CommandLineArgumentsTest methodsFor: 'tests' stamp: 'CamilloBruni 5/2/2012 12:50'!
testParameterAt
	self assert: (self commandLine argumentAt: 1) = 'noOpt1'.
	self assert: (self commandLine argumentAt: 4) = '--option1'.
	self deny: (self commandLine argumentAt: 5) = 'foo'.
	self deny: (self commandLine argumentAt: 1) isNil.! !

!CommandLineArgumentsTest methodsFor: 'tests' stamp: 'CamilloBruni 12/4/2012 20:24'!
testOptionAt
	self should: [ self commandLine optionAt: #option1 ] raise: Error.
	self should: [ self commandLine optionAt: #option4 ] raise: Error.
	
	self assert: (self commandLine optionAt: #option5) equals: 'option5Value'.
	self should: [ self commandLine optionAt: #foo ] raise: Error.
	
	self assert: (self commandLine optionAt: #o) equals: 'oValue'.
	self should: [ self commandLine optionAt: #x ] raise: Error.! !

!CommandLineArgumentsTest methodsFor: 'tests' stamp: 'CamilloBruni 12/4/2012 20:24'!
testOptionAtifAbsent
	self assert: (self commandLine optionAt: #option1 ifAbsent: [ nil ]) equals: nil.
	self assert: (self commandLine optionAt: #option4 ifAbsent: [ nil ]) equals: nil.
	self assert: (self commandLine optionAt: #option5) equals: 'option5Value'.
	self assert: (self commandLine optionAt: #foo ifAbsent: [ nil ]) equals: nil.
	self assert: (self commandLine optionAt: #o) equals: 'oValue'.
	self assert: (self commandLine optionAt: #x ifAbsent: [ nil ]) equals: nil.! !

!CommandLineArgumentsTest methodsFor: 'tests' stamp: 'CamilloBruni 5/2/2012 12:34'!
testAllFileTyped
	self assert: (self commandLine allFilesWithExtension: #txt) = #('noOpt2.txt' 'opt12.txt').
	self assert: (self commandLine allFilesWithExtension: #foo) isEmpty.! !

!CommandLineArgumentsTest methodsFor: 'tests' stamp: 'CamilloBruni 5/1/2012 20:50'!
testHasParameters
	self assert: (self commandLine hasArguments)! !

!CommandLineArgumentsTest methodsFor: 'running' stamp: 'CamilloBruni 5/2/2012 12:31'!
setUp
	commandLine := CommandLineArguments withArguments: self parameters.! !

!CommandLineHandler commentStamp: '<historical>'!
A CommandLineHandler is activated by the CommandLine. 

The responsible handler with the highest priority is selected and its instance-side method #activate is invoked.

By default the handlers are selected by their class name. In the following shell invocation the FooHandler is chosen:

	pharo Pharo.image FooHandler

A handler may provide a short name with the class-side #commandName method. If the FooHandler defined #commandName returning 'foo' it would be activated with the following shell invocation:
	
	pharo Pharo.image foo
	
For more sophisticated handler selection the CommandLineHandler should implement the #isResponsibleFor: class-side method. An instance of the current command line options is passed to this method which should then return a boolean.

Between all the responsible handlers the one with the highes #priority is chosen. To change the priority overwrite the class-side accessor.
!
!CommandLineHandler methodsFor: 'accessing' stamp: 'CamilloBruni 5/1/2012 13:52'!
description
	^ self class description! !

!CommandLineHandler methodsFor: 'utility' stamp: 'CamilloBruni 5/9/2013 19:58'!
exitFailure
	 ^ self exitFailure: 'Command line handler failed'! !

!CommandLineHandler methodsFor: 'accessing arguments' stamp: 'CamilloBruni 10/13/2012 13:13'!
argumentAt: anInteger
	^ self commandLine argumentAt: anInteger! !

!CommandLineHandler methodsFor: 'utility' stamp: 'CamilloBruni 4/29/2012 16:33'!
<< aString
	^ self stdout 
		nextPutAll: aString;
		yourself! !

!CommandLineHandler methodsFor: 'initialization' stamp: 'CamilloBruni 5/9/2013 19:44'!
initialize
	super initialize.
	session := Smalltalk session.
	self 
		initializeStdout;
		initializeStderr.
	! !

!CommandLineHandler methodsFor: 'utility' stamp: 'CamilloBruni 5/9/2013 20:18'!
quit
	self exitSuccess! !

!CommandLineHandler methodsFor: 'accessing' stamp: 'CamilloBruni 4/28/2012 19:28'!
commandLine: aCommandLine 
	commandLine := aCommandLine! !

!CommandLineHandler methodsFor: 'testing' stamp: 'CamilloBruni 10/13/2012 15:39'!
hasArguments
	^ self commandLine hasArguments! !

!CommandLineHandler methodsFor: 'accessing arguments' stamp: 'CamilloBruni 10/13/2012 13:13'!
hasOption: aString
	^ self commandLine hasOption: aString! !

!CommandLineHandler methodsFor: 'printing' stamp: 'CamilloBruni 12/5/2012 21:24'!
printHelp
	self stderr
		nextPutAll: self class comment; lf! !

!CommandLineHandler methodsFor: 'accessing' stamp: 'CamilloBruni 5/1/2012 13:42'!
commandName
	^ self class commandName! !

!CommandLineHandler methodsFor: 'activation' stamp: 'CamilloBruni 4/28/2012 19:46'!
activate
	 self subclassResponsibility! !

!CommandLineHandler methodsFor: 'utility' stamp: 'CamilloBruni 5/9/2013 19:53'!
exitSuccess
	self hasSessionChanged
		ifTrue: [ ^ self ].
	Exit signalSuccess ! !

!CommandLineHandler methodsFor: 'accessing' stamp: 'CamilloBruni 5/1/2012 13:43'!
allHandlers 
	^ CommandLineHandler allHandlers ! !

!CommandLineHandler methodsFor: 'testing' stamp: 'MarcusDenker 9/30/2013 22:47'!
hasSessionChanged
	"check whether the session has changed since the commandline handler as been created"

	^ session ~~ Smalltalk session! !

!CommandLineHandler methodsFor: 'accessing arguments' stamp: 'CamilloBruni 10/13/2012 14:07'!
optionAt: aString
	^ self commandLine optionAt: aString! !

!CommandLineHandler methodsFor: 'accessing arguments' stamp: 'DamienCassou 12/11/2013 15:46'!
optionAt: aString ifPresent: presentBlock ifAbsent: absentBlock
	^ self commandLine 
		optionAt: aString ifPresent: presentBlock ifAbsent: absentBlock! !

!CommandLineHandler methodsFor: 'initialize-release' stamp: 'CamilloBruni 2/6/2013 18:08'!
initializeStderr
	"install the line end conversion and initialize the converter"
	FileStream stderr wantsLineEndConversion: true; converter.
	stderr := VTermOutputDriver stderr.! !

!CommandLineHandler methodsFor: 'accessing' stamp: 'CamilloBruni 4/28/2012 19:28'!
commandLine
	^ commandLine! !

!CommandLineHandler methodsFor: 'activation' stamp: 'CamilloBruni 3/22/2013 21:42'!
activateHelpWithoutArguments
	"Default help implementation, running #help if the there is no argument or a single one which is --help "
	((self hasOption: 'help') or: [ self arguments isEmpty ])
		ifTrue: [ 
			self help.
			^ true ].
	^ false! !

!CommandLineHandler methodsFor: 'utility' stamp: 'CamilloBruni 5/9/2013 19:52'!
exitFailure: aMessage 
	self hasSessionChanged
		ifTrue: [ ^ self ].
	Exit signalFailure: aMessage ! !

!CommandLineHandler methodsFor: 'actions' stamp: 'CamilloBruni 3/22/2013 21:46'!
help
	"This is a crude default help implementation."
	self printHelp.
	Smalltalk isInteractive 
		ifFalse: [ self exitSuccess ]! !

!CommandLineHandler methodsFor: 'accessing arguments' stamp: 'CamilloBruni 12/4/2012 19:52'!
optionAt: aString ifAbsent: absentBlock
	^ self commandLine 
		optionAt: aString ifAbsent: absentBlock! !

!CommandLineHandler methodsFor: 'accessing arguments' stamp: 'CamilloBruni 10/13/2012 13:13'!
arguments
	^ self commandLine arguments! !

!CommandLineHandler methodsFor: 'initialize-release' stamp: 'CamilloBruni 2/3/2013 16:35'!
initializeStdout
	"install the line end conversion and initialize the converter"
	FileStream stdout wantsLineEndConversion: true; converter.
	stdout := VTermOutputDriver stdout.! !

!CommandLineHandler methodsFor: 'activation' stamp: 'CamilloBruni 1/12/2013 20:08'!
activateHelp
	"Default help implementation, running #help if the only argument is --help "
	((self hasOption: 'help') and: [ self arguments size = 1 ])
		ifTrue: [ 
			self help.
			^ true ].
	^ false! !

!CommandLineHandler methodsFor: 'accessing' stamp: 'CamilloBruni 10/13/2012 13:31'!
stderr
	^ stderr! !

!CommandLineHandler methodsFor: 'accessing arguments' stamp: 'BenjaminVanRyseghem 3/22/2013 18:55'!
optionAt: aString ifPresent: absentBlock
	^ self commandLine 
		optionAt: aString ifPresent: absentBlock! !

!CommandLineHandler methodsFor: 'accessing' stamp: 'CamilloBruni 4/28/2012 19:47'!
stdout
	^ stdout! !

!CommandLineHandler class methodsFor: 'private' stamp: 'CamilloBruni 5/2/2012 11:28'!
prepareSubcommand: commandLineArguments

	"strip the subcommand name from the arguments"
	commandLineArguments withFirstArgument: [ :arg|
		arg = self commandName 
			ifTrue: [ ^ commandLineArguments copySubcommand ]].
	
	"not a subcommand hence we keep the same args"
	^ commandLineArguments! !

!CommandLineHandler class methodsFor: 'accessing' stamp: 'CamilloBruni 5/1/2012 13:53'!
description
	"This method should return a short one-line description of the command"
	^ nil! !

!CommandLineHandler class methodsFor: 'instance creation' stamp: 'CamilloBruni 10/13/2012 13:18'!
commandLine: aCommandLine 
	
	^ self new 
		commandLine: aCommandLine;
		yourself! !

!CommandLineHandler class methodsFor: 'accessing' stamp: 'CamilloBruni 4/29/2012 17:38'!
allHandlers
	^ self allSubclasses reject: [ :handler| handler isAbstract ]! !

!CommandLineHandler class methodsFor: 'accessing' stamp: 'CamilloBruni 4/29/2012 17:39'!
isAbstract
	^ self = CommandLineHandler! !

!CommandLineHandler class methodsFor: 'accessing' stamp: 'CamilloBruni 5/1/2012 13:56'!
commandName
	" Overwrite this method to provide a short name for this command handler.
	You may pass the commandName as first argument to the image to select this handler"
	^ self name! !

!CommandLineHandler class methodsFor: 'handler selection' stamp: 'CamilloBruni 5/2/2012 14:06'!
isResponsibleFor: aCommandLineArguments
	^ aCommandLineArguments includesSubCommand: self commandName! !

!CommandLineHandler class methodsFor: 'instance creation' stamp: 'CamilloBruni 5/2/2012 11:25'!
activateWith: aCommandLine 
	
	^ self new 
		commandLine: (self prepareSubcommand: aCommandLine);
		activate! !

!CommandLineHandler class methodsFor: 'handler selection' stamp: 'CamilloBruni 5/2/2012 11:30'!
selectHandlersFor: aCommandLine

	^ self allHandlers select: [ :handlerClass|
		handlerClass isResponsibleFor: aCommandLine ]! !

!CommandLineHandler class methodsFor: 'handler selection' stamp: 'CamilloBruni 4/28/2012 01:51'!
priority
	^ 0! !

!CommandLineHandlerTest methodsFor: 'tests' stamp: 'CamilloBruni 7/3/2013 15:45'!
testSelectHandlersCodeLoader
	| args handlers |
	args := self argumentsWith: #('/foo/bar/myScript.st').
	handlers := CommandLineHandler selectHandlersFor: args.
	self assert: handlers first = STCommandLineHandler.
	
	args := self argumentsWith: #('/foo/bar/myScript.st' '--verbose').
	handlers := CommandLineHandler selectHandlersFor: args.
	self assert: handlers first = STCommandLineHandler.! !

!CommandLineHandlerTest methodsFor: 'tests' stamp: 'CamilloBruni 7/3/2013 15:45'!
testResponsibilityEval
	| args |
	args := self argumentsWith: #('eval' '1+2').
	self assert: (PharoCommandLineHandler isResponsibleFor: args).
	self deny: (STCommandLineHandler isResponsibleFor: args).
	self assert: (EvaluateCommandLineHandler isResponsibleFor: args).
	
	args := self argumentsWith: #('-e' '1+2').
	self assert: (PharoCommandLineHandler isResponsibleFor: args).
	self deny: (STCommandLineHandler isResponsibleFor: args).
	self assert: (EvaluateCommandLineHandler isResponsibleFor: args).
	
	args := self argumentsWith: #('--evaluate' '1+2').
	self assert: (PharoCommandLineHandler isResponsibleFor: args).
	self deny: (STCommandLineHandler isResponsibleFor: args).
	self assert: (EvaluateCommandLineHandler isResponsibleFor: args).! !

!CommandLineHandlerTest methodsFor: 'tests' stamp: 'CamilloBruni 7/3/2013 15:45'!
testResponsibilitySt
	| args |
	args := self argumentsWith: #('/foo/bar/myScript.st').
	self assert: (PharoCommandLineHandler isResponsibleFor: args).
	self assert: (STCommandLineHandler isResponsibleFor: args).
	self deny: (EvaluateCommandLineHandler isResponsibleFor: args).
	
	args := self argumentsWith: #('st' '/foo/bar/myScript.st').
	self assert: (PharoCommandLineHandler isResponsibleFor: args).
	self assert: (STCommandLineHandler isResponsibleFor: args).
	self deny: (EvaluateCommandLineHandler isResponsibleFor: args).! !

!CommandLineHandlerTest methodsFor: 'utility' stamp: 'CamilloBruni 5/2/2012 14:01'!
argumentsWith: aCollection
	^ CommandLineArguments withArguments: aCollection! !

!CommandLineHandlerTest methodsFor: 'tests' stamp: 'CamilloBruni 7/3/2013 15:45'!
testResponsibilityDefault
	| args |
	args := self argumentsWith: #('--help').
	self assert: (PharoCommandLineHandler isResponsibleFor: args).
	self deny: (STCommandLineHandler isResponsibleFor: args).
	self deny: (EvaluateCommandLineHandler isResponsibleFor: args).! !

!CommandLineHandlerTest methodsFor: 'tests' stamp: 'CamilloBruni 5/26/2013 13:58'!
testBasicCommandlineHandler
	
	| args |
	args := self argumentsWith: #().
	"BasicCommandLineHandler gets activated by default on image startup, so there is no need to activate it in a nother case"
	self deny: (BasicCommandLineHandler isResponsibleFor: args).
	"The BasicCommandLineHandler should always delegate to the PharoCommandLineHandler if it is present"
	self 
		assert: BasicCommandLineHandler new selectedHandler
		equals: PharoCommandLineHandler! !

!CommandLineTestRunner commentStamp: '<historical>'!
I am command line test runner. I run a TestSuite and outpout the progress in a terminal friendly way.!
!CommandLineTestRunner methodsFor: 'accessing' stamp: 'abc 10/20/2012 13:03'!
shouldSerializeError
	^ shouldSerializeError! !

!CommandLineTestRunner methodsFor: 'running' stamp: 'abc 10/19/2012 15:45'!
done
	! !

!CommandLineTestRunner methodsFor: 'printing' stamp: 'CamilloBruni 2/10/2013 14:49'!
printProgress
	| string |
	string := '[',currentTest asString, '/', maxTest asString,']'.
	self stderr 
		startOfLine; right: (80 - string size); nextPutAll: string.! !

!CommandLineTestRunner methodsFor: 'running' stamp: 'abc 10/19/2012 15:36'!
tearDown
	self printReport! !

!CommandLineTestRunner methodsFor: 'helper' stamp: 'CamilloBruni 2/10/2013 14:48'!
printFailure: anError of: aTestCase 
	self stderr red.
	self
		print: anError printString 
		short: ' [FAIL]' 
		of: aTestCase ! !

!CommandLineTestRunner methodsFor: 'accessing' stamp: 'abc 10/20/2012 13:03'!
shouldSerializeError: aBoolean
	shouldSerializeError := aBoolean.! !

!CommandLineTestRunner methodsFor: 'running' stamp: 'abc 10/19/2012 15:20'!
setUp
	
	currentTest := 0.
	maxTest := suite tests size.! !

!CommandLineTestRunner methodsFor: 'initialization' stamp: 'CamilloBruni 2/10/2013 14:48'!
initialize
	super initialize.
	shouldSerializeError := false.! !

!CommandLineTestRunner methodsFor: 'helper' stamp: 'abc 10/20/2012 13:02'!
handleFailure: anError of: aTestCase 
	self printFailure: anError of: aTestCase.
	self shouldSerializeError 
		ifTrue: [ self serializeError: anError of: aTestCase ]! !

!CommandLineTestRunner methodsFor: 'running' stamp: 'CamilloBruni 10/20/2012 22:31'!
runCase: aTestCase
	self increaseTestCount.
	self printTestCase: aTestCase.
	
	[[ aTestCase runCase ] 
		on: Halt , Error, TestFailure
		do: [ :err | self handleFailure: err of: aTestCase ]]
		on: TestSkip do: [ :skip| self handleSkip: skip of: aTestCase ]! !

!CommandLineTestRunner methodsFor: 'printing' stamp: 'CamilloBruni 2/10/2013 14:49'!
printTestCase: aTestCase 
	self stderr 
		startOfLine; clearToEnd; green; 
		print: aTestCase; clear.
	self printProgress.! !

!CommandLineTestRunner methodsFor: 'printing' stamp: 'CamilloBruni 2/10/2013 14:49'!
printReport
	self stderr lf; 
		nextPutAll: 'Finished running '; print: maxTest; 
		nextPutAll: ' Test'; nextPutAll: (maxTest = 1 ifTrue: [''] ifFalse: ['s']); lf! !

!CommandLineTestRunner methodsFor: 'helper' stamp: 'CamilloBruni 10/20/2012 22:40'!
handleSkip: aTestSkip of: aTestCase 

	self
		print: aTestSkip printString 
		short: ' [SKIPPED]' 
		of: aTestCase! !

!CommandLineTestRunner methodsFor: 'helper' stamp: 'abc 10/19/2012 15:17'!
increaseTestCount
	currentTest := currentTest + 1.! !

!CommandLineTestRunner methodsFor: 'helper' stamp: 'CamilloBruni 2/10/2013 14:49'!
print: anLongErrorMesssage short: aShortString of: aTestCase 
	| testCaseString offset |
	testCaseString := aTestCase printString.
	
	self stdout 
		startOfLine; clearToEnd; nextPutAll: testCaseString.
	
	"Let's see if we have enough space to print the error"
	offset := 80 - testCaseString size - anLongErrorMesssage size.
	offset < 1
		ifTrue: [ 
			self stdout startOfLine; right: (80 - aShortString size); 
				nextPutAll: aShortString ]
		ifFalse: [ 
			self stdout right: offset;
				nextPutAll: anLongErrorMesssage ].
		
	self stdout
		clear; lf.! !

!CommandLineTestRunner methodsFor: 'accessing' stamp: 'CamilloBruni 5/30/2013 22:55'!
stderr
	(stderr isNil or: [ stderr closed ])
		ifTrue: [ stderr := VTermOutputDriver stderr ].
	^ stderr ! !

!CommandLineTestRunner methodsFor: 'accessing' stamp: 'CamilloBruni 5/30/2013 22:55'!
stdout
	(stdout isNil or: [ stdout closed ])
		ifTrue: [ stdout := VTermOutputDriver stdout ].
		
	^ stdout! !

!CommandLineUIManager commentStamp: '<historical>'!
I am UI manager for a headless setup.
I block all UI manager API that uses Morphs and will trow an error instead.!
!CommandLineUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 2/14/2012 09:51'!
confirm: queryString trueChoice: trueLabel falseChoice: falseLabel
	^self
		confirm: queryString
		trueChoice: trueLabel
		falseChoice: falseLabel
		cancelChoice: nil
		default: nil
		! !

!CommandLineUIManager methodsFor: 'private' stamp: 'CamilloBruni 2/9/2012 12:02'!
replacing: aUIManager

	" save the aUIManager to restore it later, when we become interactive again "
	
	uiManager := aUIManager.
	
	self beDefault.! !

!CommandLineUIManager methodsFor: 'ui TEasilyThemed' stamp: 'ChristopheDemarey 1/3/2013 11:43'!
questionWithoutCancel: aStringOrText
	"Open a question dialog."! !

!CommandLineUIManager methodsFor: 'ui requests' stamp: 'SeanDeNigris 1/23/2014 14:41'!
merge: merger informing: aString! !

!CommandLineUIManager methodsFor: 'accessing' stamp: 'CamilloBruni 2/13/2012 18:37'!
stdout
	
	"install the line end conversion and initialize the converter"
	 FileStream stdout wantsLineEndConversion: true; converter.
	
	^ FileStream stdout! !

!CommandLineUIManager methodsFor: 'ui TEasilyThemed' stamp: 'ChristopheDemarey 1/3/2013 11:42'!
deny: aStringOrText
	"Open a denial dialog."! !

!CommandLineUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 7/10/2013 15:41'!
syntaxErrorNotificationDefaultAction: aSyntaxErrorNotification
	"log the syntax notificaiton and print a nicely formatted and colored syntax error on stderr"
	Smalltalk logDuring: [ :logger |
		logger print: aSyntaxErrorNotification; cr.
		aSyntaxErrorNotification signalerContext errorReportOn: logger ].
	
	STCommandLineHandler printCompilerWarning: aSyntaxErrorNotification.
			
	"in noninteractive mode simply quit"
	^ self exitFailure! !

!CommandLineUIManager methodsFor: 'default actions' stamp: 'CamilloBruni 2/13/2012 19:12'!
unhandledErrorDefaultAction: anException

	self quitFrom: anException signalerContext  withMessage: anException description.
	
	UIManager default == self ifFalse: [
		^ UIManager default unhandledErrorDefaultAction: anException
		]! !

!CommandLineUIManager methodsFor: 'initialization' stamp: 'CamilloBruni 2/9/2012 00:22'!
initialize
	doNotQuitOnRestart := false.! !

!CommandLineUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 2/14/2012 09:59'!
confirm: queryString trueChoice: trueLabel falseChoice: falseLabel cancelChoice: cancelLabel default: trueFalseNil
	| questions |
	questions := Dictionary new.
	trueLabel ifNotNil: [ questions at: 'y' put: trueLabel ].
	falseLabel ifNotNil: [ questions at: 'n' put: falseLabel ].
	cancelLabel ifNotNil: [ questions at: 'c' put: cancelLabel ].
	^ self choose: questions title: queryString
! !

!CommandLineUIManager methodsFor: 'utils' stamp: 'CamilloBruni 2/9/2012 12:55'!
logGreenDuring: aBlock
	
	^ self logColored: '32' during: aBlock! !

!CommandLineUIManager methodsFor: 'ui TEasilyThemed' stamp: 'ChristopheDemarey 1/3/2013 11:43'!
textEntry: aStringOrText title: aString entryText: defaultEntryText
	"Open a text entry dialog."
! !

!CommandLineUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 8/30/2012 16:19'!
informUserDuring: aBlock
	self
		displayProgress: ''
		from: 1 to: 100
		during: aBlock! !

!CommandLineUIManager methodsFor: 'ui TEasilyThemed' stamp: 'SeanDeNigris 1/29/2013 15:40'!
alert: aStringOrText

	self abort: aStringOrText title: 'Alert'.! !

!CommandLineUIManager methodsFor: 'ui TEasilyThemed' stamp: 'SeanDeNigris 1/29/2013 15:48'!
alert: aStringOrText title: aString

	self logTitle: aString andDescription: aStringOrText to: self stdout.! !

!CommandLineUIManager methodsFor: 'ui TEasilyThemed' stamp: 'ChristopheDemarey 1/3/2013 11:43'!
proceed: aStringOrText title: aString
	"Open a proceed dialog and answer true if not cancelled, false otherwise."! !

!CommandLineUIManager methodsFor: 'private' stamp: 'CamilloBruni 9/14/2013 10:51'!
activate
	NonInteractiveTranscript stderr install! !

!CommandLineUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 5/26/2012 13:07'!
chooseFrom: aList lines: linesArray title: aString
	| maxPad |
	maxPad := aList size asString size.
	self stdout 
		nextPutAll: aString; nextPut: $:; cr.
	aList withIndexDo: [ :item :index |
		self stdout 
			nextPutAll: '    ['; nextPutAll: (index asString padLeftTo: maxPad); nextPutAll: '] ';
			print: item; cr].
	self stdout nextPutAll: '> '.	
	^ aList at: (self stdin upToAnyOf: String crlf do: [ :chr| ]) asInteger.! !

!CommandLineUIManager methodsFor: 'accessing' stamp: 'CamilloBruni 2/13/2012 18:40'!
stdin
	
	^ FileStream stdin! !

!CommandLineUIManager methodsFor: 'utils' stamp: 'IgorStasenko 3/12/2012 17:49'!
logDuring: aBlock
	
	Smalltalk logStdErrorDuring: [ :stderr | aBlock value: stderr ]

! !

!CommandLineUIManager methodsFor: 'utils' stamp: 'CamilloBruni 2/21/2012 02:05'!
quitFrom: aContext withMessage: aString

	" log error and quit "
	[ Smalltalk 
		logError: aString
		inContext: aContext.
		
	" Print stacks of all current processes "

	Smalltalk logDuring: [:logger | 
		logger nextPutAll: 'Processes and their stacks: ';cr.
		
		Process allInstances do: [:each | | ctx |
			logger nextPutAll: 'Process: '; print: each; cr; nextPutAll: '  stack:'; cr; cr.
		
			ctx := each isActiveProcess ifTrue: [ thisContext sender ] ifFalse: [ each suspendedContext ].
			ctx ifNotNil: [
				(ctx stackOfSize: 20) do: [:s | logger print: s; cr ]].
			logger nextPutAll: '------------------------------'; cr; cr.	
		]].
	] ensure: [ self exitFailure ]! !

!CommandLineUIManager methodsFor: 'ui TEasilyThemed' stamp: 'SeanDeNigris 1/29/2013 15:40'!
abort: aStringOrText
	
	self abort: aStringOrText title: 'Error'.! !

!CommandLineUIManager methodsFor: 'accessing' stamp: 'CamilloBruni 2/13/2012 21:23'!
headlessManager
	self class == CommandLineUIManager 
		ifFalse: [ ^ self ].
		
	^ CommandLineUIManager replacing: uiManager! !

!CommandLineUIManager methodsFor: 'private' stamp: 'SeanDeNigris 1/29/2013 15:51'!
logTitle: aString andDescription: aStringOrText to: aStream
	
	aStream
		nextPutAll: aString;
		nextPutAll: ': ';
		nextPutAll: aStringOrText asString;
		cr.! !

!CommandLineUIManager methodsFor: 'accessing' stamp: 'CamilloBruni 2/13/2012 17:06'!
stderr
	
	"install the line end conversion and initialize the converter"
	 FileStream stderr wantsLineEndConversion: true; converter.
	
	^ FileStream stderr! !

!CommandLineUIManager methodsFor: 'non-interactive' stamp: 'CamilloBruni 2/13/2012 19:14'!
nonInteractiveManager
	" Answer an instance of non-interactive manager, which will be used when image runs headless.
	  We put it here, so subclasses can override it. "
	^ NonInteractiveUIManager replacing: uiManager! !

!CommandLineUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 2/13/2012 19:12'!
uiProcess
	" receiver don't have a ui process, associated with it,
	client should check explicitly if #uiProcess answers nil or not"
	^ nil! !

!CommandLineUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 2/14/2012 09:59'!
choose: questionsAnswerDict title: queryString
! !

!CommandLineUIManager methodsFor: 'ui TEasilyThemed' stamp: 'ChristopheDemarey 1/3/2013 11:43'!
question: aStringOrText title: aString
	"Open a question dialog and answer true if yes,
	false if no and nil if cancelled."! !

!CommandLineUIManager methodsFor: 'events' stamp: 'FernandoOlivero 3/16/2012 16:24'!
onSnapshot: resuming
	"The resuming argument is true when image boots from disk,
	and false, if user just did an image snapshot."
	
	resuming ifTrue: [
		Smalltalk isInteractive ifFalse: [
			^ self nonInteractiveManager onSnapshot: resuming ].
		Smalltalk isHeadless ifFalse: [
			uiManager beDefault.   "restore old, or nil, so it will be set in #default "
			UIManager default onSnapshot: resuming]. 
		^ self].
	
	
	" this flag set to true only if we are saving a snapshot before quitting "
	doNotQuitOnRestart ifTrue: [
		Smalltalk snapshot: false andQuit: true].! !

!CommandLineUIManager methodsFor: 'utils' stamp: 'CamilloBruni 2/21/2012 02:05'!
exitFailure
	[
		self class snapshotErrorImage ifTrue: [
			doNotQuitOnRestart := true.
			"make a new image version snapshot before leaving"
			Smalltalk saveAsNewVersion  ].
	] ensure: [ 
		doNotQuitOnRestart ifFalse: [ Smalltalk exitFailure ].
		doNotQuitOnRestart := false.	
	].
	
	! !

!CommandLineUIManager methodsFor: 'utils' stamp: 'IgorStasenko 3/12/2012 17:49'!
logColored: anAnsiiColorCode during: aBlock
	
	Smalltalk logStdErrorDuring: [:stderr |
		stderr
			nextPut: Character escape; 
			nextPut: $[; nextPutAll: anAnsiiColorCode; nextPut: $m.
		
		aBlock value: stderr.
		
		stderr nextPut: Character escape; nextPutAll: '[0m'
	]! !

!CommandLineUIManager methodsFor: 'ui TEasilyThemed' stamp: 'ChristopheDemarey 1/3/2013 11:43'!
textEntry: aStringOrText title: aString
	"Open a text entry dialog."! !

!CommandLineUIManager methodsFor: 'display' stamp: 'CamilloBruni 2/9/2012 00:21'!
checkForNewDisplaySize
	"do nothing"! !

!CommandLineUIManager methodsFor: 'ui TEasilyThemed' stamp: 'ChristopheDemarey 1/3/2013 11:43'!
question: aStringOrText
	"Open a question dialog."! !

!CommandLineUIManager methodsFor: 'display' stamp: 'CamilloBruni 2/9/2012 00:21'!
newDisplayDepthNoRestore: pixelSize	
	"do nothing"
	
! !

!CommandLineUIManager methodsFor: 'utils' stamp: 'CamilloBruni 2/9/2012 12:53'!
logRedDuring: aBlock
	
	^ self logColored: '31' during: aBlock! !

!CommandLineUIManager methodsFor: 'ui TEasilyThemed' stamp: 'ChristopheDemarey 1/3/2013 11:43'!
textEntry: aStringOrText
	"Open a text entry dialog."! !

!CommandLineUIManager methodsFor: 'ui TEasilyThemed' stamp: 'ChristopheDemarey 1/3/2013 11:43'!
questionWithoutCancel: aStringOrText title: aString
	"Open a question dialog and answer true if yes,
	false if no and nil if cancelled."! !

!CommandLineUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 2/13/2012 19:09'!
warningDefaultAction: aWarning
	| logBlock |
	"Pass all warnings, but log them"
	
	logBlock := [:logger |
		logger 
			cr;
			nextPutAll: '*** Warning: ';
			nextPutAll: aWarning description;
			cr ].
	
	Smalltalk logDuring: logBlock.
	self logYellowDuring: logBlock.
	
	aWarning resume.

	! !

!CommandLineUIManager methodsFor: 'utils' stamp: 'CamilloBruni 2/9/2012 12:55'!
logYellowDuring: aBlock
	
	^ self logColored: '33' during: aBlock! !

!CommandLineUIManager methodsFor: 'events' stamp: 'CamilloBruni 2/13/2012 19:11'!
onPrimitiveError: aString	

	" log error and quit "
	^ self quitFrom: thisContext sender withMessage: aString! !

!CommandLineUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 2/22/2014 20:50'!
inform: aString

	| logBlock |

	"Just log notifications"
	(ProvideAnswerNotification signal: aString) ifNotNil: [:answer | ^true].
	
	logBlock := [:logger |
		logger cr;
			nextPutAll: (String new: 79 withAll: $= ); cr;
			nextPutAll: 'Notice: ';
			nextPutAll: aString; cr;
			nextPutAll: (String new: 79 withAll: $= ); cr].

	Smalltalk logDuring: logBlock.		
	aString logCr.! !

!CommandLineUIManager methodsFor: 'ui TEasilyThemed' stamp: 'ChristopheDemarey 1/3/2013 11:43'!
proceed: aStringOrText
	"Open a proceed dialog."! !

!CommandLineUIManager methodsFor: 'ui TEasilyThemed' stamp: 'ChristopheDemarey 1/3/2013 11:42'!
deny: aStringOrText title: aString
	"Open a denial dialog."! !

!CommandLineUIManager methodsFor: 'ui TEasilyThemed' stamp: 'SeanDeNigris 1/29/2013 15:44'!
alert: aStringOrText title: aString configure: aBlock
	"Ignore the block, because we don't create a dialog, so there is nothing to configure."

	self alert: aStringOrText title: aString.! !

!CommandLineUIManager methodsFor: 'display' stamp: 'CamilloBruni 2/9/2012 00:21'!
restoreDisplay	
	"do nothing"! !

!CommandLineUIManager methodsFor: 'display' stamp: 'CamilloBruni 2/9/2012 00:21'!
restoreDisplayAfter: aBlock	
	"do nothing"! !

!CommandLineUIManager methodsFor: 'ui TEasilyThemed' stamp: 'SeanDeNigris 1/29/2013 15:48'!
abort: aStringOrText title: aString
	
	self logTitle: aString andDescription: aStringOrText to: self stderr.! !

!CommandLineUIManager class methodsFor: 'settings' stamp: 'CamilloBruni 2/13/2012 21:27'!
uiSettingsOn: aBuilder
	<systemsettings>
	(aBuilder group: #nonInteractive)
		label: 'Headless mode';
		with: [
			(aBuilder setting: #snapshotErrorImage)
				label: 'Make a snapshot of new version before quit' translated;
				target: CommandLineUIManager;
				description: 'On unhandled exception, save a new version of image before quit' translated]! !

!CommandLineUIManager class methodsFor: 'instance creation' stamp: 'CamilloBruni 2/9/2012 12:02'!
replacing: aUIManager

	"Replace the current UI manager with instance of myself. 
	Keep a backup reference to old manager, and then restore it, when image will be interactive again. "
	
	^ self new replacing: aUIManager! !

!CommandLineUIManager class methodsFor: 'accessing' stamp: 'CamilloBruni 2/13/2012 21:25'!
snapshotErrorImage: aBoolean
	SnapshotErrorImage := aBoolean! !

!CommandLineUIManager class methodsFor: 'accessing' stamp: 'CamilloBruni 2/13/2012 21:25'!
snapshotErrorImage
	^ SnapshotErrorImage == true! !

!CompilationContext commentStamp: '<historical>'!
The compilationContext holds all information that is needed in the whole compiler chain.

!
!CompilationContext methodsFor: 'options' stamp: 'MarcusDenker 7/22/2013 16:13'!
optionInlineCase
	^ options includes: #optionInlineCase
! !

!CompilationContext methodsFor: 'options' stamp: 'MarcusDenker 9/30/2013 14:43'!
optionInlineTimesRepeat
	^ options includes: #optionInlineTimesRepeat
! !

!CompilationContext methodsFor: 'accessing' stamp: 'ClementBera 6/7/2013 09:57'!
compiledMethodTrailer: anObject
	compiledMethodTrailer := anObject! !

!CompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/27/2013 11:28'!
astTranslatorClass
	^ astTranslatorClass ifNil: [ astTranslatorClass := OCASTTranslator ]! !

!CompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/12/2013 11:04'!
logged
	^logged ifNil: [ false ].! !

!CompilationContext methodsFor: 'options' stamp: 'MarcusDenker 7/22/2013 16:13'!
optionInlineWhile
	^ options includes: #optionInlineWhile
! !

!CompilationContext methodsFor: 'options' stamp: 'MarcusDenker 7/22/2013 16:13'!
optionLongIvarAccessBytecodes
	^ options includes: #optionLongIvarAccessBytecodes
! !

!CompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/7/2013 08:50'!
logged: anObject
	logged := anObject! !

!CompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/13/2013 14:12'!
environment
	^ environment! !

!CompilationContext methodsFor: 'options' stamp: 'MarcusDenker 5/10/2013 10:54'!
doesNotUnderstand: message

	(message selector isUnary and: [ message selector beginsWith: 'opt'] )
		ifTrue: [ ^ options includes: message selector ].
		
	^ super doesNotUnderstand: message! !

!CompilationContext methodsFor: 'initialization' stamp: 'MarcusDenker 2/28/2015 15:21'!
initialize
	options := Set new.
	astTransformPlugins := OrderedCollection new.! !

!CompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/7/2013 08:50'!
requestor
	^ requestor! !

!CompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/13/2013 14:12'!
environment: anObject
	environment := anObject! !

!CompilationContext methodsFor: 'accessing' stamp: 'ClementBera 6/7/2013 10:00'!
compiledMethodTrailer
	^ compiledMethodTrailer ifNil: [ compiledMethodTrailer := CompiledMethodTrailer empty ]! !

!CompilationContext methodsFor: 'accessing' stamp: 'ClementBera 1/27/2015 16:33'!
encoderClass
	^ encoderClass ifNil: [ encoderClass := BytecodeBackend ]! !

!CompilationContext methodsFor: 'options' stamp: 'MarcusDenker 7/22/2013 16:12'!
optionInlineAndOr
	^ options includes: #optionInlineAndOr
! !

!CompilationContext methodsFor: 'options' stamp: 'MarcusDenker 7/22/2013 16:13'!
optionInlineToDo
	^ options includes: #optionInlineToDo
! !

!CompilationContext methodsFor: 'options' stamp: 'MarcusDenker 7/22/2013 16:13'!
optionInlineIfNil
	^ options includes: #optionInlineIfNil
! !

!CompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/7/2013 08:50'!
requestor: anObject
	requestor := anObject! !

!CompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/23/2013 08:07'!
scope
	| newScope |

	newScope := OCClassScope for: class.
	requestor ifNotNil: [
		"the requestor is allowed to manage variables, the workspace is using it to auto-define vars"  
		newScope := (OCRequestorScope new requestor: requestor) outerScope: newScope].
	^newScope
	! !

!CompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/27/2013 11:27'!
bytecodeGeneratorClass: anObject
	bytecodeGeneratorClass := anObject! !

!CompilationContext methodsFor: 'options' stamp: 'MarcusDenker 5/14/2013 13:52'!
compilerOptions: anArray
	self parseOptions: anArray! !

!CompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 6/14/2013 15:49'!
parserClass
	^ parserClass ifNil: [ parserClass := RBExplicitVariableParser ]! !

!CompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/7/2013 08:50'!
failBlock: anObject
	failBlock := anObject! !

!CompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/27/2013 11:27'!
parserClass: anObject
	parserClass := anObject! !

!CompilationContext methodsFor: 'plugins' stamp: 'MarcusDenker 2/28/2015 15:27'!
astTransformPlugins
	^astTransformPlugins! !

!CompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/7/2013 08:50'!
category
	^ category! !

!CompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/27/2013 11:27'!
semanticAnalyzerClass: anObject
	semanticAnalyzerClass := anObject! !

!CompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/7/2013 08:50'!
noPattern: anObject
	noPattern := anObject! !

!CompilationContext methodsFor: 'accessing' stamp: 'ClementBera 1/27/2015 13:09'!
bytecodeGeneratorClass
	^ bytecodeGeneratorClass ifNil: [ bytecodeGeneratorClass := IRBytecodeGenerator ]! !

!CompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/27/2013 11:27'!
astTranslatorClass: anObject
	astTranslatorClass := anObject! !

!CompilationContext methodsFor: 'options' stamp: 'MarcusDenker 7/22/2013 16:13'!
optionInlineIf
	^ options includes: #optionInlineIf
! !

!CompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/7/2013 10:01'!
interactive: anObject
	interactive := anObject! !

!CompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/12/2013 11:25'!
getClass
	^ class! !

!CompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/27/2013 11:30'!
semanticAnalyzerClass
	^ semanticAnalyzerClass ifNil: [ semanticAnalyzerClass := OCASTSemanticAnalyzer  ]! !

!CompilationContext methodsFor: 'options' stamp: 'MarcusDenker 7/22/2013 16:13'!
optionOptimizeIR
	^ options includes: #optionOptimizeIR
! !

!CompilationContext methodsFor: 'plugins' stamp: 'MarcusDenker 2/28/2015 15:21'!
addASTTransformationPlugin: aPlugin
	astTransformPlugins add: aPlugin! !

!CompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/7/2013 08:50'!
class: anObject
	class := anObject! !

!CompilationContext methodsFor: 'accessing' stamp: 'ClementBera 1/27/2015 16:33'!
encoderClass: anObject
	encoderClass := anObject! !

!CompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/13/2013 14:54'!
interactive
	^ interactive ifNil: [ false ]! !

!CompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/7/2013 08:50'!
failBlock
	^ failBlock! !

!CompilationContext methodsFor: 'options' stamp: 'MarcusDenker 5/10/2013 10:49'!
parseOptions: optionsArray

	"parse an array, which is a sequence of options in a form of: 
	
	#( + option1 option2 - option3 ... )
	
	each time the #+ is seen, the options which follow it will be subject for inclusion
	and, correspondingly, if #- seen, then they will be excluded	.

	By default, (if none of #+ or #- specified initially), all options are subject for inclusion.
	"
	| include |
	
	include := true.
	
	optionsArray do: [:option |
		option == #+ 
			ifTrue: [ include := true ]
			ifFalse: [
				option == #- 
					ifTrue: [ include := false ]
					ifFalse: [ 
						include ifTrue: [ options add: option ] 
						ifFalse: [ options remove: option ifAbsent:[] ]]]
		].! !

!CompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/12/2013 11:00'!
noPattern
	^noPattern ifNil: [ false ].! !

!CompilationContext methodsFor: 'options' stamp: 'ClementBera 10/27/2014 11:25'!
optionInlineNone
	^ options includes: #optionInlineNone
! !

!CompilationContext methodsFor: 'accessing' stamp: 'ClementBera 11/26/2013 13:30'!
warningAllowed
	^ self class warningAllowed! !

!CompilationContext methodsFor: 'accessing' stamp: 'MarcusDenker 5/7/2013 08:50'!
category: anObject
	category := anObject! !

!CompilationContext class methodsFor: 'initialize' stamp: 'ClementBera 1/27/2015 16:32'!
initialize
	super initialize.
	BytecodeBackend := EncoderForV3PlusClosures  ! !

!CompilationContext class methodsFor: 'instance creation' stamp: 'MarcusDenker 5/13/2013 14:33'!
default 
	^ self new parseOptions: OpalCompiler defaultOptions! !

!CompilationContext class methodsFor: 'compiler' stamp: 'MarcusDenker 5/26/2013 09:52'!
compiler
	^self compilerClass new
		compilationContextClass: CCompilationContext;
		environment: self environment;
		class: self! !

!CompilationContext class methodsFor: 'accessing' stamp: 'ClementBera 11/26/2013 13:30'!
warningAllowed: aBoolean
	WarningAllowed := aBoolean! !

!CompilationContext class methodsFor: 'accessing' stamp: 'ClementBera 7/7/2014 10:55'!
bytecodeBackend: bytecodeSet
	BytecodeBackend := bytecodeSet! !

!CompilationContext class methodsFor: 'accessing' stamp: 'ClementBera 11/26/2013 13:30'!
warningAllowed
	^ WarningAllowed ifNil: [ WarningAllowed := true ]! !

!CompilationContext class methodsFor: 'accessing' stamp: 'ClementBera 7/7/2014 10:55'!
bytecodeBackend
	^ BytecodeBackend ifNil: [ self initialize ]! !

!CompiledMethod commentStamp: 'ls 7/5/2003 13:48'!
My instances are methods suitable for interpretation by the virtual machine.  This is the only class in the system whose instances intermix both indexable pointer fields and indexable integer fields.

	
The current format of a CompiledMethod is as follows:

	header (4 bytes)
	literals (4 bytes each)
	bytecodes  (variable)
	trailer (variable)

The header is a 30-bit integer with the following format:

(index 0)	9 bits:	main part of primitive number   (#primitive)
(index 9)	8 bits:	number of literals (#numLiterals)
(index 17)	1 bit:	whether a large frame size is needed (#frameSize)
(index 18)	6 bits:	number of temporary variables (#numTemps)
(index 24)	4 bits:	number of arguments to the method (#numArgs)
(index 28)	1 bit:	high-bit of primitive number (#primitive)
(index 29)	1 bit:	flag bit, ignored by the VM  (#flag)


The trailer has two variant formats.  In the first variant, the last byte is at least 252 and the last four bytes represent a source pointer into one of the sources files (see #sourcePointer).  In the second variant, the last byte is less than 252, and the last several bytes are a compressed version of the names of the method's temporary variables.  The number of bytes used for this purpose is the value of the last byte in the method.
!
!CompiledMethod methodsFor: 'comparing' stamp: 'MaxLeske 10/15/2014 22:17'!
sameLiteralsAs: method
	"Compare my literals to those of method. This is needed to compare compiled methods."

	| numLits literal1 literal2 |
	(numLits := self numLiterals) ~= method numLiterals
		ifTrue: [ ^ false ].
	"The last literal requires special checking instead of using #literalEqual:"
	1 to: numLits - 1 do: [ :index | 
		literal1 := self literalAt: index.
		literal2 := method literalAt: index.
		(literal1 == literal2 or: [ literal1 literalEqual: literal2 ])
			ifFalse: [ 
				(index = 1 and: [ self isNamedPrimitive | self isExternalCallPrimitive ])
					ifTrue: [ 
						literal1 isArray
							ifTrue: [ 
								(literal2 isArray and: [ literal1 allButLast = literal2 allButLast ])
									ifFalse: [ ^ false ] ]
							ifFalse: [ 
								"ExternalLibraryFunction"
								(literal1 analogousCodeTo: literal2)
									ifFalse: [ ^ false ] ] ]
					ifFalse: [ 
						index = (numLits - 1)
							ifTrue: [ 
								"properties"
								"don't create properties if they don't exist"
								(literal1 isSymbol and: [ literal2 isSymbol ]) ifFalse: [
									(self properties analogousCodeTo: method properties) ifFalse: [ ^false ] ] ]
							ifFalse: [ ^ false ] ] ] ].
	"Class side methods have non unique (nil -> a Metaclass) as literal and cannot be compared equal"
	literal1 := self literalAt: numLits.
	literal2 := method literalAt: numLits.
	^literal1 class == literal2 class
	     and: [literal1 isVariableBinding
	                ifTrue: [literal1 key = literal2 key and: [literal1 value = literal2 value]]
	                ifFalse: [literal1 = literal2]]! !

!CompiledMethod methodsFor: '*Fuel' stamp: 'MarianoMartinezPeck 12/3/2011 19:39'!
abstractBytecodeMessagesFrom: startpc to: endpc
	"Answer an OrderedCollection of the abstract bytecodes sent in the receiver."
	| scanner abstractBytecodes |
	scanner := InstructionStream new method: self pc: startpc.
	"now collect all the bytecode messages in the block."
	abstractBytecodes := OrderedCollection new.
	[scanner pc <= endpc] whileTrue:
		[[scanner interpretNextInstructionFor: nil]
			on: MessageNotUnderstood
			do: [:ex| abstractBytecodes add: ex message]].
	^abstractBytecodes

	"| m | (m := CompiledMethod >> #abstractBytecodeMessagesFrom:to:) abstractBytecodeMessagesFrom: m initialPC to: m endPC"! !

!CompiledMethod methodsFor: 'accessing' stamp: 'Igor.Stasenko 12/20/2009 19:02'!
trailer
	"Answer the receiver's trailer"
	^ CompiledMethodTrailer new method: self
! !

!CompiledMethod methodsFor: 'testing' stamp: 'ar 6/2/1998 16:11'!
isReturnField
	"Answer whether the receiver is a quick return of an instance variable."
	^ self primitive between: 264 and: 519! !

!CompiledMethod methodsFor: '*NautilusCommon' stamp: 'CamilloBruni 9/14/2012 00:41'!
isOverride
	| selector |
	selector := self selector.
	self methodClass allSuperclassesDo: [:each | 
		(each includesSelector: selector)
			ifTrue: [ ^ true ]].
	^ false! !

!CompiledMethod methodsFor: 'testing' stamp: 'NS 3/22/2005 16:32'!
isExplicitlyRequired: marker
	^ marker == self class explicitRequirementMarker! !

!CompiledMethod methodsFor: 'accessing' stamp: 'eem 11/29/2008 17:23'!
properties: aMethodProperties
	"Set the method-properties of the receiver to aMethodProperties."
	self literalAt: self numLiterals - 1
		put: (aMethodProperties isEmpty
				ifTrue: [aMethodProperties selector]
				ifFalse: [aMethodProperties
							setMethod: self;
							yourself])! !

!CompiledMethod methodsFor: 'accessing' stamp: 'MarcusDenker 5/16/2013 13:46'!
classBinding: aBinding
       "sets the association to the class that I am installed in"
       ^self literalAt: self numLiterals put: aBinding.! !

!CompiledMethod methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 3/13/2015 18:19'!
spotterPreviewCodeIn: aComposite
	<spotterPreview: 10>
	aComposite pharoMethod
		title: [ self gtDisplayString ];
		display: [:compiledMethod | 
			' ', compiledMethod getSource];
		smalltalkClass: [self methodClass];
		entity: self.
		
	self flag: 'move "entity: self" somewhere else, maybe'! !

!CompiledMethod methodsFor: 'source code management' stamp: 'MarcusDenker 4/29/2012 13:44'!
embeddSourceInTrailer
	"When receiver is deinstalled from its class, its not managed anymore by development tools
	and it's hard to predict, how long a method could stay in the image, because if it contains blocks,
	they could still reference it. 
	Therefore we trying to preserve as much as we can , actually by embedding the method's source code into its trailer
	"
	self trailer hasSourcePointer ifTrue: [
		^self becomeForward: (self copyWithSource: self sourceCode)]
! !

!CompiledMethod methodsFor: 'printing' stamp: 'CamilloBruni 2/28/2012 14:06'!
timeStamp
	"Answer the authoring time-stamp for the given method, retrieved from the sources or changes file. Answer the empty string if no time stamp is available."

	"(CompiledMethod compiledMethodAt: #timeStamp) timeStamp"
	| stamp file |
	file := self sourceFileStreamIfAbsent: [ ^ String new ].
	stamp := self timeStampFromFile: file.
	file close.
	^ stamp! !

!CompiledMethod methodsFor: 'debugger support' stamp: 'MarcusDenker 11/16/2012 13:45'!
debuggerMap
	^self compilerClass debuggerMethodMapForMethod: self.! !

!CompiledMethod methodsFor: 'printing' stamp: 'MarcusDenker 6/11/2013 14:38'!
timeStampFromFile: file
	"return the timestamp of this method for a given source filestream"
	| preamble stamp tokens tokenCount|
	preamble := self getPreambleFrom: file at: (0 max: self filePosition - 3).
	stamp := String new.
	tokens := (preamble includesSubstring: 'methodsFor:')
		ifTrue: [preamble parseLiterals]
		ifFalse: [Array new  "ie cant be back ref"].
	(((tokenCount := tokens size) between: 7 and: 8) and: [(tokens at: tokenCount - 5) == #methodsFor:])
		ifTrue:
			[(tokens at: tokenCount - 3) == #stamp:
				ifTrue: ["New format gives change stamp and unified prior pointer"
						stamp := tokens at: tokenCount - 2]].
	((tokenCount between: 5 and: 6) and: [(tokens at: tokenCount - 3) == #methodsFor:])
		ifTrue:
			[(tokens at: tokenCount  - 1) == #stamp:
				ifTrue: ["New format gives change stamp and unified prior pointer"
					stamp := tokens at: tokenCount]].
	^ stamp
! !

!CompiledMethod methodsFor: 'printing' stamp: 'MarcusDenker 10/13/2014 15:52'!
symbolicBytecodes
	"Answer Collection that contains of all the byte codes in a method as an instance of SymbolicInstruction"

	^SymbolicBytecodeBuilder decode: self! !

!CompiledMethod methodsFor: 'accessing' stamp: 'eem 9/15/2011 17:04'!
properties
	"Answer the method properties of the receiver."
	| propertiesOrSelector |
	^(propertiesOrSelector := self penultimateLiteral) isMethodProperties
		ifTrue: [propertiesOrSelector]
		ifFalse: [self class methodPropertiesClass forMethod: self selector: propertiesOrSelector]! !

!CompiledMethod methodsFor: '*AST-Core' stamp: 'CamilloBruni 12/9/2011 13:59'!
ast
	^ ASTCache at: self! !

!CompiledMethod methodsFor: '*Reflectivity' stamp: 'MarcusDenker 2/26/2015 13:12'!
invalidate
	self reflectiveMethod ifNil: [^self "do nothing"].
	self methodClass basicAddSelector: self selector withMethod: self reflectiveMethod.! !

!CompiledMethod methodsFor: '*Ring-Core-Kernel' stamp: 'MarcusDenker 8/1/2014 14:15'!
asPassiveRingDefinition
	"Retrieves a passive RGMethodDefinition object based on the data of the receiver.
	Source, protocol and stamp are retrieved from value assigned in creation"
	
	^RGMethodDefinition new 
		 	name: self selector;
			parentName: self methodClass name;
			isMetaSide: self methodClass isMeta;
			protocol: self category;
			sourceCode: self sourceCode;
			stamp: self timeStamp;
			asPassive.! !

!CompiledMethod methodsFor: 'testing' stamp: 'di 12/26/1998 21:31'!
isQuick
	"Answer whether the receiver is a quick return (of self or of an instance 
	variable)."
	^ self primitive between: 256 and: 519! !

!CompiledMethod methodsFor: 'accessing' stamp: 'eem 11/28/2008 12:58'!
selector: aSelector
	"Set a method's selector.  This is either the penultimate literal,
	 or, if the method has any properties or pragmas, the selector of
	 the MethodProperties stored in the penultimate literal."
	| penultimateLiteral nl | 
	(penultimateLiteral := self penultimateLiteral) isMethodProperties
		ifTrue: [penultimateLiteral selector: aSelector]
		ifFalse: [(nl := self numLiterals) < 2 ifTrue:
					[self error: 'insufficient literals to hold selector'].
				self literalAt: nl - 1 put: aSelector]! !

!CompiledMethod methodsFor: 'testing' stamp: 'GuillermoPolito 4/26/2012 10:54'!
isPrimitive
	^self primitive > 0! !

!CompiledMethod methodsFor: 'literals' stamp: 'nice 7/20/2011 18:01'!
refersToLiteral: aLiteral 
	"Answer true if any literal in this method is literal, even if embedded in array structure or within its pragmas."
	"only iterate to numLiterals - 1, as the last has the classBinding and the last-but-one needs special treatment"
	2 
		to: self numLiterals - 1
		do: 
			[ :index | 
			| literal |
			literal := self objectAt: index.
			(aLiteral literalEqual: literal) ifTrue: [ ^ true ]. 
			(literal refersToLiteral: aLiteral) ifTrue: [ ^ true ] ].
	"last-but-one has the additional method state -or- the method's own selector!!"
	^ (self objectAt: self numLiterals) refersToLiteral: aLiteral.
! !

!CompiledMethod methodsFor: 'source code management' stamp: ''!
stamp

	^ self timeStamp! !

!CompiledMethod methodsFor: '*NautilusCommon' stamp: 'MarcusDenker 11/22/2014 16:02'!
correspondingTestMethod
	self isTestMethod
		ifTrue: [ ^ self ]
		ifFalse: [ 
			| sel testClass |
			sel := (self selector endsWith: ':')
				ifTrue: [ (self selector copyReplaceAll: ':' with: '') asLowercase ]
				ifFalse: [ self selector asLowercase ].
			(sel beginsWith: 'test')
				ifFalse: [ sel := 'test' , sel ].
			^ (testClass := self methodClass correspondingForTest) = self methodClass
				ifTrue: [ nil ]
				ifFalse: [ testClass methods detect: [ :each | each selector asLowercase = sel ] ifNone: [ nil ] ] ]! !

!CompiledMethod methodsFor: '*GT-InspectorExtensions-Core' stamp: 'SvenVanCaekenberghe 10/15/2014 09:42'!
gtInspectorItemsIn: composite
	"It makes no sense to view me as a collection of items"! !

!CompiledMethod methodsFor: 'literals' stamp: 'eem 11/29/2008 11:38'!
indexOfLiteral: literal
	"Answer the literal index of the argument, literal, or zero if none."
	2 to: self numLiterals - 1 "exclude superclass + selector/properties"
	   do:
		[:index |
		literal == (self objectAt: index) ifTrue: [^index - 1]].
	^0! !

!CompiledMethod methodsFor: '*opalcompiler-core' stamp: 'MarcusDenker 11/6/2014 15:22'!
ir
	"We as the AST for the IR... for decompiling ir from bytecode, look at IRBytecodeDecompiler"
	^ self ast ir! !

!CompiledMethod methodsFor: '*Reflectivity' stamp: 'MarcusDenker 2/26/2015 13:17'!
createTwin
	self reflectiveMethod: (ReflectiveMethod on: self)! !

!CompiledMethod methodsFor: 'source code management' stamp: 'MartinDias 11/5/2013 14:44'!
putSource: sourceStr inFile: fileIndex withPreamble: preambleBlock
	"Store the source code for the receiver on an external file.
	If no sources are available, i.e., SourceFile is nil, then store
	temp names for decompilation at the end of the method.
	If the fileIndex is 1, print on *.sources;  if it is 2, print on *.changes,
	in each case, storing a 4-byte source code pointer at the method end."

	| file remoteString |
	(file := SourceFiles at: fileIndex) 
		ifNil: [ ^ self becomeForward: (self copyWithSource: sourceStr) ].

	Smalltalk assureStartupStampLogged.
	file setToEnd.

	preambleBlock value: file.  "Write the preamble"
	remoteString := RemoteString newString: sourceStr onFileNumber: fileIndex toFile: file.
	file nextChunkPut: ' '.
	InMidstOfFileinNotification signal ifFalse: [ file flush ].
	self setSourcePosition: remoteString position inFile: fileIndex! !

!CompiledMethod methodsFor: 'literals' stamp: 'AlexandreBergel 1/4/2014 20:13'!
literalStrings
	"Return a list of strings or symbols corresponding to the class references and message sent.
	The result also contains the name of the class"
	
	| litStrs |
	litStrs := OrderedCollection new: self numLiterals.
	self literalsDo:
		[:lit | 
		(lit isVariableBinding)
			ifTrue: [litStrs addLast: lit key]
			ifFalse: [(lit isSymbol)
				ifTrue: [litStrs addAll: lit keywords]
				ifFalse: [litStrs addLast: lit printString]]].
	^ litStrs! !

!CompiledMethod methodsFor: 'testing' stamp: 'MarcusDenker 4/29/2011 00:40'!
isDeprecated
	^ (self sendsSelector: #deprecated:) or: [self sendsSelector: #deprecated:on:in:]! !

!CompiledMethod methodsFor: 'literals' stamp: 'eem 5/6/2008 11:28'!
allLiterals
	^self literals! !

!CompiledMethod methodsFor: 'accessing' stamp: 'eem 5/7/2012 11:26'!
referredInstVars
	| allInstVarNames instVarNames |
	allInstVarNames := self methodClass allInstVarNames.
	self isReturnField ifTrue:
		[^Set with: (allInstVarNames at: self returnField + 1)].
	instVarNames := Set new.
	self abstractBytecodeMessagesDo:
		[:msg|
		(#(#popIntoReceiverVariable:
		    #pushReceiverVariable:
		    #storeIntoReceiverVariable:) includes: msg selector) ifTrue:
			[instVarNames add: (allInstVarNames at: msg argument + 1)]].
	^instVarNames

	"Dictionary fromPairs: (Point selectors collect: [:s| { s. (Point >> s) referredInstVars}])".! !

!CompiledMethod methodsFor: '*Tool-Base' stamp: 'CamilloBruni 1/30/2013 21:26'!
senders
	
	^ SystemNavigation default allSendersOf: self selector! !

!CompiledMethod methodsFor: 'accessing' stamp: 'ClementBera 2/24/2015 15:47'!
setSignFlag
	"Set the sign flag bit.  The sign flag bit may be
	 used by the VM to select an alternate bytecode set."

	self signFlag ifFalse:
		[self objectAt: 1 put: self header + SmallInteger minVal]! !

!CompiledMethod methodsFor: '*Refactoring-Critics' stamp: 'YuriyTymchuk 9/4/2014 15:10'!
selfMessages

	|  selfMessages searcher |
	selfMessages := Set new.
	searcher := RBParseTreeSearcher new.
	searcher
		matches: 'self `@message: ``@args'
			do: [:aNode :answer | selfMessages add: aNode selector].

	searcher executeTree: self parseTree initialAnswer: nil.
	
	^ selfMessages! !

!CompiledMethod methodsFor: 'accessing-pragmas & properties' stamp: 'eem 9/15/2011 17:04'!
propertyValueAt: propName put: propValue
	"Set or add the property with key propName and value propValue.
	 If the receiver does not yet have a method properties create one and replace
	 the selector with it.  Otherwise, either relace propValue in the method properties
	 or replace method properties with one containing the new property."
	| propertiesOrSelector |
	(propertiesOrSelector := self penultimateLiteral) isMethodProperties ifFalse:
		[self penultimateLiteral: ((self class methodPropertiesClass
									selector: propertiesOrSelector
									with: (Association
											key: propName asSymbol
											value: propValue))
									setMethod: self;
									yourself).
		^propValue].
	(propertiesOrSelector includesProperty: propName) ifTrue:
		[^propertiesOrSelector at: propName put: propValue].
	self penultimateLiteral: (propertiesOrSelector
								copyWith: (Association
												key: propName asSymbol
												value: propValue)).
	^propValue! !

!CompiledMethod methodsFor: '*NativeBoost-Core' stamp: 'Igor.Stasenko 5/18/2010 08:19'!
trailerKind
	"a shortcut accessor to check the trailer kind, without instantiating the trailer"
	| flagByte index |
	flagByte := self at: self size.
	index := flagByte >> 2 + 1.
	^ CompiledMethodTrailer trailerKinds at: index.
! !

!CompiledMethod methodsFor: 'accessing' stamp: 'MarcusDenker 10/11/2013 10:29'!
sourceCode

	"Retrieve or reconstruct the source code for this method."
	| trailer source |
	trailer := self trailer.
	trailer sourceCode ifNotNil: [:code | ^ code ].
	trailer hasSourcePointer ifFalse: [^ self codeForNoSource].

	"Situation normal;  read the sourceCode from the file"
	source := [self getSourceFromFile]
				on: Error
				do: [ :ex | ex return: nil].
	source isEmptyOrNil ifTrue: [^ self codeForNoSource].			
	^source! !

!CompiledMethod methodsFor: '*opalcompiler-core' stamp: 'MarcusDenker 4/19/2013 08:33'!
sourceNode
	^self ast! !

!CompiledMethod methodsFor: 'testing' stamp: 'NS 3/22/2005 16:32'!
isImplicitlyRequired: marker
	^ marker == self class implicitRequirementMarker! !

!CompiledMethod methodsFor: 'accessing-pragmas & properties' stamp: 'eem 11/29/2008 11:45'!
propertyValueAt: propName
	| propertiesOrSelector |
	^(propertiesOrSelector := self penultimateLiteral) isMethodProperties
		ifTrue: [propertiesOrSelector propertyValueAt: propName ifAbsent: [nil]]
		ifFalse: [nil]! !

!CompiledMethod methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 3/25/2015 09:48'!
gtDisplayOn: aStream
	aStream print: self methodClass; nextPutAll: '>>'; store: self selector.! !

!CompiledMethod methodsFor: 'testing' stamp: ''!
isReturnSelf
	"Answer whether the receiver is a quick return of self."

	^ self primitive = 256! !

!CompiledMethod methodsFor: 'accessing-pragmas & properties' stamp: 'eem 11/29/2008 17:33'!
propertyKeysAndValuesDo: aBlock
	"Enumerate the receiver with all the keys and values."

	| propertiesOrSelector |
	(propertiesOrSelector := self penultimateLiteral) isMethodProperties ifTrue:
		[propertiesOrSelector propertyKeysAndValuesDo: aBlock]! !

!CompiledMethod methodsFor: 'scanning' stamp: ''!
sendsToSuper
	"Answer whether the receiver sends any message to super."
	| scanner |
	scanner := InstructionStream on: self.
	^ scanner scanFor: 
		[:instr |  instr = 16r85 or: [instr = 16r84
						and: [scanner followingByte between: 16r20 and: 16r3F]]]! !

!CompiledMethod methodsFor: 'testing' stamp: 'al 1/23/2004 13:12'!
isConflict
	^ self markerOrNil == self class conflictMarker! !

!CompiledMethod methodsFor: 'testing' stamp: 'NS 3/22/2005 16:38'!
isRequired
	^ self isRequired: self markerOrNil! !

!CompiledMethod methodsFor: '*opalcompiler-core' stamp: 'MarcusDenker 4/19/2013 08:34'!
sourceNodeForPC: aPC
	^self sourceNode sourceNodeForPC: aPC! !

!CompiledMethod methodsFor: 'source code management' stamp: 'MarcusDenker 4/29/2012 10:33'!
linesOfCode
	"An approximate measure of lines of code.
	Includes comments, but excludes empty lines."
	| lines |
	lines := 0.
	self sourceCode lineIndicesDo: [:start :endWithoutDelimiters :end |
		endWithoutDelimiters > start ifTrue: [lines := lines+1]].
	^lines! !

!CompiledMethod methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 12/19/2013 16:33'!
gtInspectorIrIn: composite
	<gtInspectorPresentationOrder: 35> 
	composite text 
		title: 'Ir';
		display: [ :anObject || string |
				string := anObject ir longPrintString.
				string copyFrom: 2 to: string size ]! !

!CompiledMethod methodsFor: '*NautilusCommon' stamp: 'BenjaminVanRyseghem 4/7/2011 18:11'!
hasPassedTest

	^ self methodClass methodPassed: (self selector)! !

!CompiledMethod methodsFor: 'source code management' stamp: 'MarcusDenker 4/21/2013 18:04'!
tempNames
	^self methodNode tempNames.! !

!CompiledMethod methodsFor: 'literals' stamp: 'nice 7/20/2011 09:10'!
hasLiteralThorough: literal
	"Answer true if any literal in this method is literal,
	even if embedded in array structure."

	(self penultimateLiteral isMethodProperties
	 and: [self penultimateLiteral hasLiteralThorough: literal]) ifTrue:[^true].
	2 to: self numLiterals - 1 "exclude superclass + selector/properties"
	   do:[:index | | lit |
		(((lit := self objectAt: index) literalEqual: literal)
		 or: [(lit isVariableBinding and: [lit key == literal])
		 or: [lit isArray and: [lit hasLiteral: literal]]]) ifTrue:
			[^ true]].
	^ false ! !

!CompiledMethod methodsFor: 'accessing' stamp: 'StephaneDucasse 3/17/2010 20:53'!
initialPC
	"Answer the program counter for the receiver's first bytecode."

	^ (self numLiterals + 1) * Smalltalk wordSize + 1! !

!CompiledMethod methodsFor: 'accessing' stamp: 'Igor.Stasenko 12/20/2009 19:04'!
endPC
	"Answer the index of the last bytecode."
	^ self trailer endPC
! !

!CompiledMethod methodsFor: 'source code management' stamp: 'hmm 4/26/2000 20:44'!
fileIndex
	^SourceFiles fileIndexFromSourcePointer: self sourcePointer! !

!CompiledMethod methodsFor: 'accessing' stamp: 'StephaneDucasse 3/6/2010 09:27'!
comment
	"Return the first comment of the receiver"
	"(self>>#comment) comment"
	
	^ self methodClass firstPrecodeCommentFor: self selector! !

!CompiledMethod methodsFor: '*GT-InspectorExtensions-Core' stamp: 'SvenVanCaekenberghe 10/15/2014 09:41'!
gtInspectorBytesIn: composite
	<gtInspectorPresentationOrder: 30>
	"It makes no sense to view me as a collection of bytes"! !

!CompiledMethod methodsFor: '*opalcompiler-core' stamp: 'MarcusDenker 8/28/2013 10:45'!
methodNode
	"Return the parse tree that represents self"
	| aClass source methodNode |
	
	aClass := self methodClass.
	source := self sourceCode.
	methodNode := aClass compiler parse: source.
	methodNode source: source.
	^methodNode.
			! !

!CompiledMethod methodsFor: 'scanning' stamp: 'MarcusDenker 7/19/2014 14:22'!
readsSlot: aSlot
	| nodes |
	nodes := self ast allChildren.
	nodes := nodes select: #isVariable.
	nodes := nodes select: #isInstance.
	nodes := nodes reject: [: node | 
			node parent isAssignment and: [(node parent variable = node)]].
	nodes do: [:node | (node binding slot ==  aSlot) ifTrue: [^true]].
	^false! !

!CompiledMethod methodsFor: 'printing' stamp: 'MarcusDenker 10/13/2014 17:26'!
longPrintOn: aStream
	"List of all the byte codes in a method with a short description of each" 

	self isQuick ifTrue: 
		[self isReturnSpecial ifTrue:
			[^ aStream nextPutAll: 'Quick return ' , 
				(#('self' 'true' 'false' 'nil' '-1' '0' '1' '2') at: self primitive - 255)].
		^ aStream nextPutAll: 'Quick return field ' , self returnField printString , ' (0-based)'].

	self isPrimitive ifTrue: [
		self printPrimitiveOn: aStream.
	].
	self symbolicBytecodes do: [ :each | each printOn: aStream ] separatedBy: [ aStream cr ]
! !

!CompiledMethod methodsFor: '*Fuel' stamp: 'MartinDias 2/18/2013 19:54'!
fuelPrepare
	"Prepare for Fuel serialization."
	
	self isNamedPrimitive ifTrue: [self literals first at: 4 put: 0].
	
	"When the method is a named primitive, the first literal is an array that works as an argument for the VM. The first and second elements represent the module and the name of the primivite. The third element of the array is ignored, it used to be a session ID. The forth element is the primitive index in a externalPrimitiveTable and it is IMPORTANT to put it in zero, otherwise there can be errors. Putting a zero means that the VM will not try to directly execute the primitive from the table and it will always try to load the module. It is the safer thing to do. For more details, read the method #primitiveExternalCall in VMMaker."! !

!CompiledMethod methodsFor: 'testing' stamp: 'GuillermoPolito 4/26/2012 10:54'!
isNamedPrimitive
	^self primitive = 117! !

!CompiledMethod methodsFor: 'testing' stamp: 'NS 3/22/2005 16:32'!
isDisabled: marker
	^ marker == self class disabledMarker! !

!CompiledMethod methodsFor: '*Reflectivity' stamp: 'MarcusDenker 2/25/2015 18:28'!
reflectiveMethod: aReflectiveMethod
	self propertyValueAt: #reflectiveMethod put: aReflectiveMethod! !

!CompiledMethod methodsFor: 'testing' stamp: 'NS 3/22/2005 16:40'!
isProvided
	^ self isProvided: self markerOrNil! !

!CompiledMethod methodsFor: '*opalcompiler-core' stamp: 'CamilloBruni 2/17/2012 14:33'!
recompile
	^ self methodClass recompile: self selector! !

!CompiledMethod methodsFor: 'accessing' stamp: 'MarcusDenker 7/18/2013 17:10'!
bytecode
	"Answer an ByteArray of the btyecode of the method."

	| start stop bytecode |

	start := self initialPC.
	stop := self endPC.
	
	bytecode := ByteArray new: (stop - start + 1).
	start to: stop do: [:index |
		bytecode byteAt: index - start + 1 put: (self byteAt: index)].
	^bytecode! !

!CompiledMethod methodsFor: 'literals' stamp: ''!
literalAt: index put: value 
	"Replace the literal indexed by the first argument with the second 
	argument. Answer the second argument."

	^self objectAt: index + 1 put: value! !

!CompiledMethod methodsFor: '*Manifest-Core' stamp: 'StephaneDucasse 3/21/2013 12:38'!
criticClass
	"Return the class of the receiver for the critic browser. This behavior may be folded later by changing the name of this method or using another one."
	
	^ self methodClass! !

!CompiledMethod methodsFor: 'scanning' stamp: 'ClementBera 12/29/2014 12:10'!
writesRef: literalAssociation 
	"Answer whether the receiver stores into the argument."
	| litIndex scanner |
	(litIndex := self indexOfLiteral: literalAssociation) = 0 ifTrue:
		[^false].
	litIndex := litIndex - 1.
	^(scanner := InstructionStream on: self) scanFor: (self encoderClass bindingWriteScanBlockFor: litIndex using: scanner)! !

!CompiledMethod methodsFor: '*Keymapping-Core' stamp: 'MarcusDenker 9/11/2013 13:20'!
isShortcutDeclaration

	^self pragmas anySatisfy: [ :p | p keyword = #shortcut ]! !

!CompiledMethod methodsFor: '*NautilusCommon' stamp: 'vincentBlondeau 12/12/2014 14:20'!
correspondingMethods
	" retrieve methods that could be the corresponding method "

	self isTestMethod
		ifTrue: [ 
			self methodClass isTestCase
				ifTrue: [ 
					| classSymbol correspondingClass correspondingSel className selector |
					selector := self selector.
					className := self methodClass name.
					(selector beginsWith: 'test') ifFalse: [ ^ #() ].
					classSymbol := (className endsWith: 'Test')
						ifTrue: [ className allButLast: 4]
						ifFalse: [ className ]. 
					correspondingClass := self class environment at: classSymbol asSymbol ifAbsent: [ ^ #() ].
					correspondingSel := (selector allButFirst: 4) transformSelectorForComparison.
					^ correspondingClass selectors
						select: [ :each | each asLowercase = correspondingSel asLowercase or: [ each asLowercase = (correspondingSel , ':') asLowercase ] ]
						thenCollect: [ :each | correspondingClass >> each ] ]
				ifFalse: [ ^ #() ] ]
		ifFalse: [ ^ {self} ]! !

!CompiledMethod methodsFor: '*NautilusCommon' stamp: 'vincentBlondeau 12/12/2014 14:00'!
isTestMethod

    ^ self methodClass isTestCase and: [ 
		((self selector beginsWith: 'test') 
			or: [ (self selector beginsWith: 'should')]) and: [ self numArgs isZero ] ]! !

!CompiledMethod methodsFor: '*Manifest-Core' stamp: 'SimonAllier 3/21/2013 15:18'!
mcWorkingCopy
	 MCWorkingCopy managersForClass: self methodClass selector: self selector do: [ :package | ^ package ]! !

!CompiledMethod methodsFor: 'copying' stamp: 'MarianoMartinezPeck 7/24/2012 09:39'!
postCopy
	| penultimateLiteral |
	(penultimateLiteral := self penultimateLiteral) isMethodProperties ifTrue:
		[self penultimateLiteral: (penultimateLiteral copy
									setMethod: self;
									yourself).
		 self penultimateLiteral pragmas do:
			[:p| p setMethod: self]]
! !

!CompiledMethod methodsFor: '*rpackage-core' stamp: 'tg 3/13/2010 15:13'!
isDefinedInPackage: anRPackage
	^ anRPackage includesDefinedSelector: self selector ofClass: self methodClass! !

!CompiledMethod methodsFor: 'accessing' stamp: 'md 1/20/2006 16:09'!
scanner

	^ InstructionStream on: self! !

!CompiledMethod methodsFor: 'cleaning' stamp: 'MarianoMartinezPeck 4/27/2012 19:59'!
voidCogVMState
	"Tell the VM to remove all references to any machine code form of the method.
	 This primitive must be called whenever a method is in use and modified.  This is
	 more aggressive (and *much* more costly) than flushCache since it must search
	 through all context objects, making sure that none have a (hidden) machine code pc
	 in the receiver.  Since modifying a method will likely change the generated machine code,
	 modifying a method (rather than redefining it) requires this more aggressive flush."

	<primitive: 215>
	^self flushCache! !

!CompiledMethod methodsFor: 'accessing' stamp: 'MarcusDenker 9/20/2014 09:37'!
origin
	self properties 
		at: #traitSource 
		ifPresent: [ :traitMethod| ^ traitMethod origin].
	^ self methodClass traitOrClassOfSelector: self selector! !

!CompiledMethod methodsFor: 'testing' stamp: 'md 11/21/2003 12:15'!
isCompiledMethod

	^ true! !

!CompiledMethod methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 7/14/2014 10:52'!
gtInspectorASTIn: composite
	<gtInspectorPresentationOrder: 35> 
	(GTSimpleRBTreeBrowser new treeIn: composite)
		title: 'AST';
		display: [ :anObject | {anObject ast} ]
		! !

!CompiledMethod methodsFor: 'literals' stamp: 'AlexandreBergel 1/4/2014 20:16'!
sendsSelector: aSymbol 	
	"
	Answer whether the method sends a particular selector

	(CompiledMethod >> #sendsSelector:) sendsSelector: #includes:
	=> true

	(CompiledMethod >> #sendsSelector:) sendsSelector: #doBreakfastForMe
	=> false
	"
	^ self messages includes: aSymbol! !

!CompiledMethod methodsFor: 'accessing-pragmas & properties' stamp: 'eem 11/29/2008 16:36'!
pragmas
	| selectorOrProperties |
	^(selectorOrProperties := self penultimateLiteral) isMethodProperties
		ifTrue: [selectorOrProperties pragmas]
		ifFalse: [#()]! !

!CompiledMethod methodsFor: '*Fuel' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper

	^aGeneralMapper visitCompiledMethod: self! !

!CompiledMethod methodsFor: '*NautilusCommon' stamp: 'CamilloBruni 10/21/2012 23:56'!
dragAndDropPrint

	^ self printString! !

!CompiledMethod methodsFor: '*Ring-Core-Kernel' stamp: 'MarcusDenker 8/1/2014 14:13'!
asHistoricalRingDefinition

	"Retrieves a historical RGMethodDefinition object based on the data of the receiver.
	Source, protocol and stamp are retrieved from the source file method"
	| ring |
	ring := (RGMethodDefinition named: self selector)
				parentName: self methodClass name;
				isMetaSide: self methodClass isMeta.

	self sourcePointer isZero
		ifTrue: [ "this should not happen but sometimes the system looks corrupted"
			ring protocol: self category;
				sourceCode: self sourceCode;
				stamp: self timeStamp ]
		ifFalse: [ 
			ring sourcePointer: self sourcePointer ].
	ring asHistorical.	
	
	^ ring! !

!CompiledMethod methodsFor: 'source code management' stamp: 'EstebanLorenzano 3/8/2013 15:04'!
setSourcePointer: srcPointer
	"We can't change the trailer of existing method, since it could have completely different format. 	
	Therefore we need to generate a copy with new trailer, containing scrPointer, and then become it."

	| trailer copy |
	trailer := CompiledMethodTrailer new sourcePointer: srcPointer.
	copy := self copyWithTrailerBytes: trailer.
	"If possible do a replace in place as an optimization"
	(self trailer class == trailer class and: [ self size = copy size ])
		ifTrue: [ 
			| start |
			start := self endPC + 1.
			self replaceFrom: start to: self size with: copy startingAt: start ]
		ifFalse: [ self becomeForward: copy ].
	^ self
! !

!CompiledMethod methodsFor: 'source code management' stamp: 'MartinDias 10/28/2013 15:11'!
getPreambleFrom: aFileStream at: position
	^ SourceFiles getPreambleFrom: aFileStream at: position! !

!CompiledMethod methodsFor: 'copying' stamp: 'tk 8/19/1998 16:20'!
veryDeepCopyWith: deepCopier
	"Return self.  I am always shared.  Do not record me.  Only use this for blocks.  Normally methodDictionaries should not be copied this way."! !

!CompiledMethod methodsFor: 'accessing-pragmas & properties' stamp: 'CamilloBruni 2/20/2012 15:34'!
hasPragmaNamed: aSymbol
	^ self pragmas anySatisfy: [ :pragma | pragma keyword = aSymbol ]! !

!CompiledMethod methodsFor: 'accessing' stamp: 'AdrianKuhn 12/22/2009 07:26'!
methodClass: aClass
	"set the class binding in the last literal to aClass"
	^self numLiterals > 0
		ifTrue: [ self literalAt: self numLiterals put: aClass binding ]	! !

!CompiledMethod methodsFor: 'accessing' stamp: 'CamilloBruni 1/30/2013 21:09'!
protocol: aString
	^ self methodClass organization classify: self selector under: aString! !

!CompiledMethod methodsFor: 'accessing-pragmas & properties' stamp: 'eem 12/1/2008 11:02'!
removeProperty: propName ifAbsent: aBlock
	"Remove the property propName if it exists.
	 Answer the evaluation of aBlock if the property is missing."
	| value |
	value := self propertyValueAt: propName ifAbsent: [^aBlock value].
	self penultimateLiteral: (self penultimateLiteral copyWithout:
									(Association
										key: propName
										value: value)).
	^value! !

!CompiledMethod methodsFor: 'printing' stamp: 'GuillermoPolito 4/26/2012 11:07'!
primitiveErrorVariableName
	"Answer the primitive error code temp name, or nil if none."
	self isPrimitive ifTrue:
		[self pragmas do:
			[:pragma| | kwds ecIndex |
			((kwds := pragma keyword keywords) first = 'primitive:'
			and: [(ecIndex := kwds indexOf: 'error:') > 0]) ifTrue:
				[^pragma argumentAt: ecIndex]]].
	^nil! !

!CompiledMethod methodsFor: 'source code management' stamp: 'CamilloBruni 5/21/2012 15:25'!
sourceFileStream 
	"Answer the sources file stream with position set at the beginning of my source string"

	| pos |
	(pos := self filePosition) = 0 ifTrue: [^ nil].
	^ (RemoteString newFileNumber: self fileIndex position: pos) fileStream! !

!CompiledMethod methodsFor: '*opalcompiler-core' stamp: 'MarcusDenker 4/27/2013 00:11'!
reformat
	self methodClass compile: self ast formattedCode classified:  self category.! !

!CompiledMethod methodsFor: 'accessing' stamp: 'CamilloBruni 2/22/2014 15:40'!
hasSourceCode

	"Retrieve or reconstruct the source code for this method."
	| trailer source |
	trailer := self trailer.
	trailer sourceCode ifNotNil: [:code | ^ true ].
	trailer hasSourcePointer ifFalse: [^ false].

	"Situation normal;  read the sourceCode from the file"
	source := [self getSourceFromFile]
				on: Error
				do: [ :ex | ex return: nil].
	source isEmptyOrNil ifTrue: [^ false].			
	^ true! !

!CompiledMethod methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 11/9/2012 04:13'!
forceJIT
	<primitive: 'primitiveForceJIT' module: '' error: errorCode >
	^ self primitiveFailed! !

!CompiledMethod methodsFor: '*GT-InspectorExtensions-Core' stamp: 'MarcusDenker 3/11/2015 17:13'!
gtInspectorHeaderIn: composite
	<gtInspectorPresentationOrder: 40> 
	composite text 
		title: 'Header';
		display: [ self headerDescription ]! !

!CompiledMethod methodsFor: '*rpackage-core' stamp: 'CamilloBruni 10/17/2012 11:22'!
packageFromOrganizer: anRPackageOrganizer
	"This method returns the package this method belongs to.  
	It takes into account classes and traits.  
	If the method is in no package, returns nil by now"
	self flag: 'TODO: use anRPackageOrganizer, or better delegate to anRPackageOrganizer'.
	^self origin packages 
		detect: [ :each | 
			(each includesSelector: self selector ofClassName: self origin theNonMetaClass originalName) 
			or: [ each includesSelector: self selector ofMetaclassName: self origin theNonMetaClass originalName]] 
		ifNone: [ nil ]! !

!CompiledMethod methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/24/2015 14:44'!
spotterForImplementorsFor: aStep
	<spotterOrder: 10>
	aStep listProcessor
			title: 'Implementors';
			allCandidates: [ self implementors collect: #compiledMethod ];
			filter: GTFilterSubstring! !

!CompiledMethod methodsFor: '*NautilusCommon' stamp: 'BenjaminVanRyseghem 4/7/2011 18:51'!
containsFlag

	^ self literals includesAnyOf: #( flag flag: ).! !

!CompiledMethod methodsFor: 'accessing' stamp: 'ClementBera 2/24/2015 15:43'!
numArgs
	"Answer the number of arguments the receiver takes."

	^ (self header bitShift: -24) bitAnd: 16r0F! !

!CompiledMethod methodsFor: 'accessing' stamp: 'MarcusDenker 5/16/2013 13:46'!
classBinding
	"answer the association to the class that I am installed in, or nil if none."
	^self literalAt: self numLiterals! !

!CompiledMethod methodsFor: 'initialize-release' stamp: 'eem 9/14/2011 17:33'!
copyWithTrailerBytes: trailer
"Testing:
	(CompiledMethod compiledMethodAt: #copyWithTrailerBytes:)
		tempNamesPut: 'copy end '
"
	| copy end start penultimateLiteral |
	start := self initialPC.
	end := self endPC.
	copy := trailer createMethod: end - start + 1 class: self class header: self header.
	1 to: self numLiterals do: [:i | copy literalAt: i put: (self literalAt: i)].
	(penultimateLiteral := self penultimateLiteral) isMethodProperties ifTrue:
		[copy penultimateLiteral: (penultimateLiteral copy
									setMethod: copy;
									yourself)].
	start to: end do: [:i | copy at: i put: (self at: i)].
	^copy! !

!CompiledMethod methodsFor: 'scanning' stamp: 'md 4/27/2006 15:12'!
hasInstVarRef
	"Answer whether the method references an instance variable."

	| scanner end printer |

	scanner := InstructionStream on: self.
	printer := InstVarRefLocator new.
	end := self endPC.

	[scanner pc <= end] whileTrue: [
		(printer interpretNextInstructionUsing: scanner) ifTrue: [^true].
	].
	^false! !

!CompiledMethod methodsFor: 'accessing' stamp: 'ClementBera 2/24/2015 15:40'!
clearFlag
	"Clear the user-level flag bit"

	self objectAt: 1 put: (self header bitAnd: (1 << 29) bitInvert)! !

!CompiledMethod methodsFor: 'source code management' stamp: 'MarcusDenker 4/21/2013 17:48'!
argumentNames
	^self ast argumentNames! !

!CompiledMethod methodsFor: 'source code management' stamp: 'MarcusDenker 12/21/2012 12:15'!
getSourceFromFile
	"PLEASE Note: clients should always call #sourceCode"
	
	"Read the source code from file, determining source file index and
	file position from the last 3 bytes of this method."
	| position |
	(position := self filePosition) = 0 ifTrue: [^ nil].
	^ (RemoteString newFileNumber: self fileIndex position: position) string! !

!CompiledMethod methodsFor: 'private' stamp: 'eem 11/29/2008 11:10'!
penultimateLiteral
	"Answer the penultimate literal of the receiver, which holds either
	 the receiver's selector or its properties (which will hold the selector)."
	| pIndex |
	^(pIndex := self numLiterals - 1) > 0 
		ifTrue: [self literalAt: pIndex]
		ifFalse: [nil]! !

!CompiledMethod methodsFor: 'testing' stamp: 'CamilloBruni 9/13/2012 14:16'!
isOverridden
	| selector| 
	selector := self selector.
	self methodClass allSubclassesDo: [:each | 
		(each includesSelector: selector)
			ifTrue: [ ^ true ]].
	^ false
	! !

!CompiledMethod methodsFor: 'debugger support' stamp: 'MarcusDenker 5/9/2013 11:28'!
pcPreviousTo: pc
	| scanner client prevPc |
	pc > self endPC ifTrue: [^self endPC].
	scanner := InstructionStream on: self.
	client := InstructionClient new.
	[scanner pc < pc] whileTrue:
		[prevPc := scanner pc.
		 scanner interpretNextInstructionFor: client].
	^prevPc! !

!CompiledMethod methodsFor: 'literals' stamp: 'ClementBEra 4/2/2015 09:44'!
headerDescription
	"Answer a description containing the information about the form of the 
	receiver and the form of the context needed to run the receiver."

	| s |
	s := '' writeStream.
	self header printOn: s.
	s cr; nextPutAll: '"signFlag: '.
	self signFlag printOn: s.
	s nextPutAll: ' ('.
	self encoderClass name printOn: s.
	s nextPut: $).
	s cr; nextPutAll: 'primitive: '.
	self primitive printOn: s.
	s cr; nextPutAll: ' numArgs: '.
	self numArgs printOn: s.
	s cr; nextPutAll: ' numTemps: '.
	self numTemps printOn: s.
	s cr; nextPutAll: ' numLiterals: '.
	self numLiterals printOn: s.
	s cr; nextPutAll: ' frameSize: '.
	self frameSize printOn: s.
	s nextPut: $"; cr.
	^ s contents! !

!CompiledMethod methodsFor: '*opalcompiler-core' stamp: 'NicolaiHess 11/6/2014 20:35'!
decompileIR
	
	^ IRBytecodeDecompiler new decompile: self! !

!CompiledMethod methodsFor: 'source code management' stamp: 'Igor.Stasenko 12/20/2009 19:12'!
sourcePointer
	"Answer the integer which can be used to find the source file and position for this method.
	The actual interpretation of this number is up to the SourceFileArray stored in the global variable SourceFiles."

	^ self trailer sourcePointer
! !

!CompiledMethod methodsFor: 'accessing-pragmas & properties' stamp: 'jannik.laval 1/8/2010 20:04'!
removeProperty: propName
	"Remove the property propName if it exists.
	 Do _not_ raise an error if the property is missing."
	| value |
	value := self propertyValueAt: propName ifAbsent: [^nil].
	self penultimateLiteral: (self penultimateLiteral copyWithout:
									(Association
										key: propName
										value: value)).
	^value! !

!CompiledMethod methodsFor: 'testing' stamp: 'NS 3/22/2005 16:38'!
isRequired: marker
	marker ifNil: [^ false].
	(self isImplicitlyRequired: marker) ifTrue: [^ true].
	(self isExplicitlyRequired: marker) ifTrue: [^ true]. 
	(self isSubclassResponsibility: marker) ifTrue: [^ true]. 
	^ false! !

!CompiledMethod methodsFor: 'source code management' stamp: 'hmm 4/26/2000 20:45'!
filePosition
	^SourceFiles filePositionFromSourcePointer: self sourcePointer! !

!CompiledMethod methodsFor: 'accessing' stamp: 'ClementBera 2/24/2015 15:42'!
frameSize
	"Answer the size of temporary frame needed to run the receiver."
	"NOTE:  Versions 2.7 and later use two sizes of contexts."

	(self header noMask: 16r20000)
		ifTrue: [^ SmallFrame]
		ifFalse: [^ LargeFrame]
! !

!CompiledMethod methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 12/30/2013 22:15'!
gtInspectorSourceIn: composite
	<gtInspectorPresentationOrder: 30> 
	^ composite smalltalkCode 
		title: 'Source';
		smalltalkClass: [ self methodClass ];
		display: [ self getSource ];
		act: [ self browse ] icon: GLMUIThemeExtraIcons glamorousBrowse entitled: 'Browse'! !

!CompiledMethod methodsFor: 'testing' stamp: 'MarcusDenker 10/3/2014 14:52'!
hasProperties
	^ self penultimateLiteral isMethodProperties! !

!CompiledMethod methodsFor: 'literals' stamp: ''!
objectAt: index 
	"Primitive. Answer the method header (if index=1) or a literal (if index 
	>1) from the receiver. Essential. See Object documentation 
	whatIsAPrimitive."

	<primitive: 68>
	self primitiveFailed! !

!CompiledMethod methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 1/23/2015 22:13'!
phlowValue: anObject withEnoughArguments: aCollection

	^ anObject withArgs: aCollection executeMethod: self! !

!CompiledMethod methodsFor: '*Reflectivity' stamp: 'MarcusDenker 3/1/2015 09:33'!
installLink
	self reflectiveMethod ifNil: [ self createTwin ].
	self reflectiveMethod increaseLinkCount.
	self invalidate.! !

!CompiledMethod methodsFor: '*Reflectivity' stamp: 'MarcusDenker 3/8/2015 09:09'!
removeLink

	self reflectiveMethod ifNotNil: [:rm | rm removeLink].! !

!CompiledMethod methodsFor: '*Ring-Core-Kernel' stamp: 'NicolaiHess 1/17/2014 15:03'!
asFullRingDefinition

	"Retrieves an active RGMethodDefinition which knows its parent <class>.
	Note that the full conversion does not happen at the level of the class. If you need that request asFullRingDefinition to the class"
	| rgClass rgMethod |
	rgClass := self realClass asRingDefinition.
	rgMethod := self asActiveRingDefinition.
	rgClass addMethod: rgMethod.
	rgMethod package: (RGContainer packageOfMethod: rgMethod).
	^ rgMethod! !

!CompiledMethod methodsFor: 'private' stamp: 'al 2/13/2006 17:44'!
markerOrNil
	"If I am a marker method, answer the symbol used to mark me.  Otherwise
	answer nil.

	What is a marker method?  It is method with body like 
		'self subclassResponsibility' or '^ self subclassResponsibility' 
	used to indicate ('mark') a special property.

	Marker methods compile to bytecode like:

		9 <70> self
		10 <D0> send: <literal 1>
		11 <87> pop
		12 <78> returnSelf

	for the first form, or 

		9 <70> self
		10 <D0> send: <literal 1>
		11 <7C> returnTop

	for the second form."

	| e |
	((e := self endPC) = 19 or: [e = 20]) ifFalse: [^ nil].
	(self numLiterals = 3) ifFalse:[^ nil].
	(self at: 17) =  16r70 ifFalse:[^ nil].		"push self"
	(self at: 18) = 16rD0 ifFalse:[^ nil].		"send <literal 1>"
	"If we reach this point, we have a marker method that sends self <literal 1>"
	^ self literalAt: 1
! !

!CompiledMethod methodsFor: 'scanning' stamp: 'eem 12/6/2011 13:35'!
abstractBytecodeMessagesDo: aBlock
	"Evaluate aBlock with the sequence of abstract bytecodes in the receiver"
	self abstractBytecodeMessagesFrom: self initialPC
		to: self endPC
		do: aBlock

	"| msgs |
	 msgs := OrderedCollection new.
	 CompiledMethod >> #abstractBytecodeMessagesFrom:to: abstractBytecodeMessagesDo:
		[:msg| msgs add: msg selector].
	 msgs"! !

!CompiledMethod methodsFor: 'accessing' stamp: 'ClementBera 2/24/2015 15:42'!
flag
	"Answer the user-level flag bit"

	^((self header bitShift: -29) bitAnd: 1) = 1! !

!CompiledMethod methodsFor: 'literals' stamp: 'eem 10/28/2008 10:47'!
literalsDo: aBlock
	"Evaluate aBlock for each of the literals referenced by the receiver."
	1 to: self numLiterals do:
		[:index |
		aBlock value: (self objectAt: index + 1)]! !

!CompiledMethod methodsFor: '*Refactoring-Critics' stamp: 'YuriyTymchuk 9/4/2014 11:46'!
superMessages

	|  superMessages searcher |
	superMessages := Set new.
	searcher := RBParseTreeSearcher new.
	searcher
		matches: 'super `@message: ``@args'
			do: [:aNode :answer | superMessages add: aNode selector].

	searcher executeTree: self parseTree initialAnswer: nil.
	
	^ superMessages! !

!CompiledMethod methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/23/2015 00:56'!
spotterSelectFor: aStep
	" ignore :) "! !

!CompiledMethod methodsFor: 'testing' stamp: 'MarcusDenker 4/29/2012 14:59'!
isDoIt
	^self selector isDoIt.! !

!CompiledMethod methodsFor: '*Reflectivity' stamp: 'MarcusDenker 3/8/2015 09:08'!
compiledMethod
	^self! !

!CompiledMethod methodsFor: 'accessing' stamp: 'ClementBera 12/28/2014 18:19'!
defaultSelector 
	"Invent and answer an appropriate message selector (a Symbol) for me, 
	that is, one that will parse with the correct number of arguments."

	^ #DoIt numArgs: self numArgs! !

!CompiledMethod methodsFor: 'testing' stamp: 'CamilloBruni 2/23/2014 21:52'!
hasSourcePointer
	^ self trailer hasSourcePointer! !

!CompiledMethod methodsFor: 'accessing' stamp: 'MarcusDenker 2/29/2012 11:18'!
flushCache
	"Tell the interpreter to remove all references to this method from its method lookup cache, if it has one. This primitive must be called whenever a method is redefined or removed.
	NOTE:  Only one of two selective flush methods (Symbol or CompiledMethod) needs to be used."

	<primitive: 116>
! !

!CompiledMethod methodsFor: 'source code management' stamp: 'CamilloBruni 2/28/2012 14:06'!
sourceFileStreamIfAbsent: aBlock
	^ self sourceFileStream ifNil: aBlock! !

!CompiledMethod methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 1/29/2014 17:56'!
gtInspectorPragmasIn: composite
	<gtInspectorPresentationOrder: 30> 
	composite tabulator 
		title: 'Pragmas';
		when: [ :x | x pragmas notEmpty ];
		with: [ :t |  
			t row: #pragmas; row: #methods.
			t transmit to: #pragmas; andShow: [:a | 
				a list
					title: 'Pragmas';
					display: [ :method | method pragmas ];
					when: [ :x | x pragmas notEmpty ] ].
			t transmit from: #pragmas; to: #methods; andShow: [:a | 
				a list 
					title: 'Methods';
					display: [ :pragma | 
						| methods | 
						methods := OrderedCollection new.
						Object withAllSubclassesDo: [ :each | 
							methods addAll: ((Pragma allNamed: pragma keyword in: each) collect: #method) ].
						methods ];
					format: #selector ].
			t transmit
				toOutsidePort: #selection;
				from: #methods port: #selection
		];
		startOn: self! !

!CompiledMethod methodsFor: 'printing' stamp: 'MarcusDenker 10/13/2014 17:27'!
symbolic
	"Answer a String that contains a list of all the byte codes in a method with a short description of each."

	^self longPrintString.! !

!CompiledMethod methodsFor: 'testing' stamp: 'NS 3/22/2005 16:32'!
isExplicitlyRequired
	^ self isExplicitlyRequired: self markerOrNil! !

!CompiledMethod methodsFor: '*Fuel' stamp: 'MaxLeske 7/8/2013 21:17'!
bytecodesHash
	"Answer a 16-bit checksum of the bytecodes."

	^ CRC crc16FromCollection: (ByteArray 
		new: self size 
		streamContents: [ :stream | self 
			from: self initialPC 
			to: self endPC 
			do: [ :byte | stream nextPut: byte ] ])! !

!CompiledMethod methodsFor: 'testing' stamp: 'mada 5/5/2012 11:29'!
isBinarySelector
	^self selector
		allSatisfy: [:each | each isSpecial]! !

!CompiledMethod methodsFor: '*NautilusCommon' stamp: 'NicolaiHess 4/10/2015 00:12'!
isExampleMethod
	
    ^ (self methodClass isMeta) and: [ 
		(self selector beginsWith: 'example')
			 and: [ self numArgs isZero ] ]! !

!CompiledMethod methodsFor: '*GT-InspectorExtensions-Core' stamp: 'MarcusDenker 3/11/2015 17:15'!
gtInspectorVariableValuePairs
	| literalIndex values |
	literalIndex := 0.
	values := OrderedCollection new.
	values addAll: (self literals collect: [ :aLiteral | 'literal', ( literalIndex := literalIndex + 1 ) asString -> aLiteral ]).
	self initialPC to: self size do: [ :index |
		values add:  ('bc ', index asString) ->  (self at: index)].
	^values.
	
! !

!CompiledMethod methodsFor: 'literals' stamp: 'nice 7/20/2011 09:05'!
hasLiteral: literal
	"Answer whether the receiver references the argument, literal."
	2 to: self numLiterals - 1 do: "exclude superclass + selector/properties"
		[:index |
		((self objectAt: index) literalEqual: literal) ifTrue: [^true]].
	^false! !

!CompiledMethod methodsFor: '*Ring-Core-Kernel' stamp: 'StephaneDucasse 8/21/2011 17:49'!
methodReference

	| class selector |
	class := self methodClass ifNil: [^nil].
	selector := self selector ifNil: [^nil].
	^RGMethodDefinition realClass: class selector: selector.
	! !

!CompiledMethod methodsFor: 'accessing' stamp: 'MarcusDenker 5/16/2013 09:12'!
methodClass
	"answer the class that I am installed in"
	^self classBinding value! !

!CompiledMethod methodsFor: 'accessing-pragmas & properties' stamp: 'eem 12/1/2008 16:58'!
pragmaAt: aKey
	"Answer the pragma with selector aKey, or nil if none."
	| propertiesOrSelector |
	^(propertiesOrSelector := self penultimateLiteral) isMethodProperties
		ifTrue: [propertiesOrSelector at: aKey ifAbsent: [nil]]
		ifFalse: [nil]! !

!CompiledMethod methodsFor: '*Manifest-Core' stamp: 'StephaneDucasse 3/21/2013 13:25'!
manifestBuilderForRuleChecker: aRuleChecker
	"Return the manifestsince the rulechecker is keeping a cache, we ask it back"

	^ aRuleChecker manifestBuilderOfMethod: self! !

!CompiledMethod methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 11/18/2014 23:22'!
spotterActDefault
	^ self browse! !

!CompiledMethod methodsFor: 'printing' stamp: 'CamilloBruni 10/21/2012 23:36'!
printOn: aStream 
	"Overrides method inherited from the byte arrayed collection."

	aStream print: self methodClass; nextPutAll: '>>'; store: self selector.! !

!CompiledMethod methodsFor: '*opalcompiler-core' stamp: 'MarcusDenker 2/4/2013 16:01'!
compilerClass
	^self methodClass 
		ifNil: [Smalltalk compilerClass] 
		ifNotNil: [:class | class compilerClass].! !

!CompiledMethod methodsFor: 'accessing' stamp: 'ClementBera 2/24/2015 15:40'!
encoderClass
	^ self signFlag 
		ifTrue: [ SecondaryBytecodeSetEncoderClass ]
		ifFalse: [ PrimaryBytecodeSetEncoderClass ]! !

!CompiledMethod methodsFor: 'testing' stamp: 'NS 3/22/2005 16:38'!
isSubclassResponsibility: marker
	^ marker == self class subclassResponsibilityMarker! !

!CompiledMethod methodsFor: '*NautilusCommon' stamp: 'BenjaminVanRyseghem 4/7/2011 18:10'!
hasErrorTest

	^ self methodClass methodRaisedError: (self selector)! !

!CompiledMethod methodsFor: 'testing' stamp: ''!
isReturnSpecial
	"Answer whether the receiver is a quick return of self or constant."

	^ self primitive between: 256 and: 263! !

!CompiledMethod methodsFor: '*rpackage-core' stamp: 'tg 3/13/2010 13:50'!
isExtensionInPackage: anRPackage
	^ anRPackage includesExtensionSelector: self selector ofClass: self methodClass! !

!CompiledMethod methodsFor: 'testing' stamp: 'CamilloBruni 9/22/2012 21:12'!
isFromTrait
	"Return true for methods that have been included from Traits"
	^ self origin isTrait and: [ self origin ~= self methodClass ]! !

!CompiledMethod methodsFor: '*Deprecated40' stamp: 'MarcusDenker 7/2/2014 09:18'!
messagesDo: aBlock 
	self deprecated: 'just use messages do:' on: '2 July 2014' in: 'Pharo4'.
	^ self messages do:aBlock.! !

!CompiledMethod methodsFor: 'source code management' stamp: 'MarcusDenker 4/29/2012 10:33'!
definition
	"Polymorphic to class definition"
	
	^ self sourceCode! !

!CompiledMethod methodsFor: 'source code management' stamp: 'PabloHerrero 1/4/2015 13:11'!
getSourceReplacingSelectorWith: newSelector
	| oldKeywords newKeywords source newSource oldSelector start |
	source := self sourceCode.
	oldSelector := self selector.
	oldSelector = newSelector ifTrue: [ ^ source ].
	
	oldKeywords := oldSelector keywords.
	newKeywords := (newSelector ifNil: [self defaultSelector]) keywords.
	[oldKeywords size = newKeywords size] assert.
	
	newSource := source.
	start := 1.
	oldKeywords with: newKeywords do: [:oldKey :newKey| |pos|
		pos := newSource findString: oldKey startingAt: start .
		newSource := newSource copyReplaceFrom: pos to: (pos + oldKey size -1) with: newKey.
		start := pos + newKey size ].

	^newSource! !

!CompiledMethod methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/12/2011 11:28'!
protocol
	" start to migrate to RING API "

	^ self category! !

!CompiledMethod methodsFor: 'initialize-release' stamp: 'ClementBera 12/30/2014 13:01'!
needsFrameSize: newFrameSize
	"Set the largeFrameBit to accomodate the newFrameSize"
	(self numTemps + newFrameSize) > LargeFrame ifTrue:
		[^ self error: 'Cannot compile -- stack including temps is too deep'].
	self setFrameBit: ((self numTemps + newFrameSize) > SmallFrame 
		or: [ self primitive = 84 "perform:withArguments:"])! !

!CompiledMethod methodsFor: 'printing' stamp: ''!
storeOn: aStream
	| noneYet |
	aStream nextPutAll: '(('.
	aStream nextPutAll: self class name.
	aStream nextPutAll: ' newMethod: '.
	aStream store: self size - self initialPC + 1.
	aStream nextPutAll: ' header: '.
	aStream store: self header.
	aStream nextPut: $).
	noneYet := self storeElementsFrom: self initialPC to: self endPC on: aStream.
	1 to: self numLiterals do:
		[:index |
		noneYet
			ifTrue: [noneYet := false]
			ifFalse: [aStream nextPut: $;].
		aStream nextPutAll: ' literalAt: '.
		aStream store: index.
		aStream nextPutAll: ' put: '.
		aStream store: (self literalAt: index)].
	noneYet ifFalse: [aStream nextPutAll: '; yourself'].
	aStream nextPut: $)! !

!CompiledMethod methodsFor: 'testing' stamp: 'AlexandreBergel 9/14/2011 08:31'!
isAbstract
	"Answer true if I am abstract"
	
	^ self markerOrNil == self class abstractMarker! !

!CompiledMethod methodsFor: 'source code management' stamp: 'MarcusDenker 12/22/2012 17:45'!
getSource
	"use #sourceCode instead"
	^self sourceCode.! !

!CompiledMethod methodsFor: '*FuelTests' stamp: 'MarianoMartinezPeck 4/20/2012 21:18'!
isEqualRegardlessTrailerTo: aCompiledMethod
	^ (self copyWithTrailerBytes: CompiledMethodTrailer empty) = (aCompiledMethod copyWithTrailerBytes: CompiledMethodTrailer empty)! !

!CompiledMethod methodsFor: '*Ring-Core-Kernel' stamp: 'MarianoMartinezPeck 6/26/2012 10:41'!
realClass
	"answer the class that I am installed in"
	
	^ self methodClass! !

!CompiledMethod methodsFor: 'scanning' stamp: 'ClementBera 12/29/2014 12:12'!
writesField: varIndex
	"Answer whether the receiver stores into the instance variable indexed by the argument."

	| varIndexCode scanner |
	self isQuick ifTrue: [^false].
	varIndexCode := varIndex - 1.
	^(scanner := InstructionStream on: self) scanFor: (self encoderClass instVarWriteScanBlockFor: varIndexCode using: scanner)! !

!CompiledMethod methodsFor: '*Reflectivity' stamp: 'MarcusDenker 2/26/2015 11:14'!
reflectiveMethod
	^self propertyValueAt: #reflectiveMethod! !

!CompiledMethod methodsFor: 'accessing' stamp: 'MarcusDenker 10/10/2013 16:35'!
originMethod
	| selector |
	
	self properties 
		at: #traitSource 
		ifPresent: [ :traitMethod | ^ traitMethod ].
	
	"Use the method dictionary because traits do not have method for accesing methods by selector"
	
	selector := self methodClass traitComposition originSelectorOf: self selector.
	^ (self methodClass traitOrClassOfSelector: selector)>>selector. ! !

!CompiledMethod methodsFor: 'testing' stamp: 'MarcusDenker 8/23/2014 11:16'!
hasReportableSlip
	"Answer whether the receiver contains anything that should be brought 
	to the attention of the author when filing out. Customize the lists here 
	to suit your preferences. If slips do not get reported in spite of your 
	best efforts here, make certain that the Preference 'checkForSlips' is set 
	to true."

	self containsHalt ifTrue: [ ^true ].
	#(#doOnlyOnce: #printDirectlyToDisplay #toRemove #urgent) do: [ :aLit | 
			(self hasLiteral: aLit)
				ifTrue: [ ^ true ] ].
	#(#Transcript) do: [ :aSymbol | 
			(Smalltalk globals associationAt: aSymbol ifAbsent: [  ])
				ifNotNil: [ :assoc | 
					(self hasLiteral: assoc)
						ifTrue: [ ^ true ] ] ].
	^ false! !

!CompiledMethod methodsFor: 'comparing' stamp: 'MarcusDenker 7/23/2014 22:28'!
= aCompiledMethod
	"Answer whether the receiver implements the same code as aCompiledMethod."

	self == aCompiledMethod
		ifTrue: [ ^ true ].
	self class = aCompiledMethod class
		ifFalse: [ ^ false ].
	self size = aCompiledMethod size
		ifFalse: [ ^ false ].
	self header = aCompiledMethod header
		ifFalse: [ ^ false ].
	self initialPC to: self endPC do: [ :i | 
		(self at: i) = (aCompiledMethod at: i)
			ifFalse: [ ^ false ] ].
	(self sameLiteralsAs: aCompiledMethod)
		ifFalse: [ ^ false ].
	^ true! !

!CompiledMethod methodsFor: '*NativeBoost-Core' stamp: 'Igor.Stasenko 5/18/2010 08:20'!
hasNativeCode
	^ self trailerKind == #NativeCodeTrailer! !

!CompiledMethod methodsFor: '*opalcompiler-core' stamp: 'MarcusDenker 5/12/2013 11:46'!
compiler
	^self methodClass 
		ifNil: [Smalltalk compiler] 
		ifNotNil: [:class | class compiler].! !

!CompiledMethod methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 7/12/2013 16:29'!
nbArgumentNames
	"Answer the method's argument names. We using a separate method, 
	to get arg names not from source code directly, but from method properties, collected at
	compile time. Useful, when there is no source code available (for some reason)"
	
	^ self propertyValueAt: #nbArgumentNames ifAbsent: [ 
		self  propertyValueAt: #nbArgumentNames put: self argumentNames
	 ]
! !

!CompiledMethod methodsFor: 'scanning' stamp: 'ClementBera 12/29/2014 12:12'!
readsRef: literalAssociation 
	"Answer whether the receiver loads the argument."
	| litIndex scanner |
	(litIndex := self indexOfLiteral: literalAssociation) = 0 ifTrue:
		[^false].
	litIndex := litIndex - 1.
	^(scanner := InstructionStream on: self) scanFor: (self encoderClass bindingReadScanBlockFor: litIndex using: scanner)! !

!CompiledMethod methodsFor: 'testing' stamp: 'NS 3/22/2005 16:32'!
isImplicitlyRequired
	^ self isImplicitlyRequired: self markerOrNil! !

!CompiledMethod methodsFor: 'scanning' stamp: 'MarcusDenker 7/14/2014 12:26'!
accessesSlot: aSlot
	self ast nodesDo: [ :node | 
		node isVariable and: [
			node isInstance and: [ 
				(node binding slot ==  aSlot)
					 ifTrue: [^true]]]]. 
	^false
	! !

!CompiledMethod methodsFor: '*Tool-Base' stamp: 'CamilloBruni 1/30/2013 21:26'!
implementors
	
	^ SystemNavigation default allImplementorsOf: self selector! !

!CompiledMethod methodsFor: '*AST-Core' stamp: 'MarcusDenker 5/17/2013 15:39'!
parseTree
	^(RBExplicitVariableParser 
		parseMethod: self sourceCode 
		onError: [ :msg :pos | ^ nil ]) methodClass: self methodClass.
	! !

!CompiledMethod methodsFor: 'scanning' stamp: 'ClementBera 12/29/2014 12:13'!
readsField: varIndex 
	"Answer whether the receiver loads the instance variable indexed by the argument."
	| varIndexCode scanner |
	varIndexCode := varIndex - 1.
	self isReturnField ifTrue: [^self returnField = varIndexCode].
	^(scanner := InstructionStream on: self) scanFor: (self encoderClass instVarReadScanBlockFor: varIndexCode using: scanner)! !

!CompiledMethod methodsFor: 'scanning' stamp: 'MarcusDenker 7/19/2014 14:07'!
writesSlot: aSlot
	self ast nodesDo: [ :node | 
		node isVariable and: [
			node parent isAssignment and: [  
				(node parent variable = node) and: [  
					node isInstance and: [
						(node binding slot ==  aSlot)
					 		ifTrue: [^true]]]]]]. 
	^false! !

!CompiledMethod methodsFor: 'testing' stamp: 'MarcusDenker 10/10/2013 16:35'!
isInstalled
	self methodClass ifNotNil:
		[:class|
		self selector ifNotNil:
			[:selector|
			^self == (class compiledMethodAt: selector ifAbsent: [])]].
	^false! !

!CompiledMethod methodsFor: 'accessing' stamp: 'ClementBera 2/24/2015 15:39'!
clearSignFlag
	"Clear the sign flag bit.  The sign flag bit may be
	 used by the VM to select an alternate bytecode set."

	self signFlag ifTrue:
		[self objectAt: 1 put: self header - SmallInteger minVal]! !

!CompiledMethod methodsFor: 'testing' stamp: 'NS 3/22/2005 16:38'!
isSubclassResponsibility
	^ self isSubclassResponsibility: self markerOrNil! !

!CompiledMethod methodsFor: '*Tool-Base' stamp: 'BenjaminVanRyseghem 1/23/2012 19:57'!
browse

	^ Smalltalk tools browser fullOnClass: self methodClass selector: self selector! !

!CompiledMethod methodsFor: 'scanning' stamp: 'eem 12/6/2011 13:47'!
abstractBytecodeMessageAt: pc
	"Answer the abstract bytecode message at pc in the receiver."
	^[(InstructionStream new method: self pc: pc) interpretNextInstructionFor: nil]
		on: MessageNotUnderstood
		do: [:ex| ex message]! !

!CompiledMethod methodsFor: '*rpackage-core' stamp: 'CamilloBruni 4/27/2012 17:07'!
package
	^ self packageFromOrganizer: RPackage organizer! !

!CompiledMethod methodsFor: '*Manifest-Core' stamp: 'StephaneDucasse 3/21/2013 12:55'!
criticTheNonMetaclassClass
	"Return the class of the receiver for the critic browser. This behavior may be folded later by changing the name of this method or using another one."
	
	^ self methodClass theNonMetaClass! !

!CompiledMethod methodsFor: '*NautilusCommon' stamp: 'TorstenBergmann 2/26/2015 00:27'!
isScriptMethodWithScript
	"Return true if the method is tagged with <script: '...'> pragma for evaluating code"
	
    ^self pragmas anySatisfy: [:each | each keyword = #script: ]! !

!CompiledMethod methodsFor: 'debugger support' stamp: 'GuillermoPolito 2/27/2015 16:47'!
prepareForSimulationWith: numArgs
	"This method changes the argument count of a CompiledMethod header to numArgs, its temporary count to numArgs + 1 and change the code handling primitive error to store the error code in the unique temporary of the method"
			
	| newHeader xpc |
	newHeader := (((self header bitAnd: 2r01110000000000111111111111111111) 
			bitOr: (numArgs bitShift: 24))
			bitOr: (numArgs + 1 bitShift: 18)).
	newHeader := newHeader + (self class headerFlagForEncoder: self encoderClass).
	self objectAt: 1 put: newHeader.
	
	xpc := self initialPC.
	"long store temp"
	(self at: xpc) = 129 
		ifTrue: [
			self at: xpc + 1 put: (16r40 + numArgs).
			self at: xpc + 3 put: (16r10 + numArgs)]! !

!CompiledMethod methodsFor: 'literals' stamp: ''!
literalAt: index 
	"Answer the literal indexed by the argument."

	^self objectAt: index + 1! !

!CompiledMethod methodsFor: 'comparing' stamp: 'MarcusDenker 5/2/2013 10:33'!
equivalentTo: aCompiledMethod
	^self = aCompiledMethod
	or: [self class == aCompiledMethod class
		and: [self numArgs = aCompiledMethod numArgs
		and: [self numLiterals = aCompiledMethod numLiterals
		and: [self methodNode = aCompiledMethod methodNode ]]]]! !

!CompiledMethod methodsFor: '*GT-InspectorExtensions-Core' stamp: 'MarcusDenker 3/11/2015 17:16'!
gtInspectorBytecodeIn: composite
	<gtInspectorPresentationOrder: 30> 
	^ (GTBytecodeBrowser new treeIn: composite)
		title: 'Bytecode'! !

!CompiledMethod methodsFor: 'printing' stamp: 'MarcusDenker 4/29/2012 10:33'!
asString

	  ^self sourceCode! !

!CompiledMethod methodsFor: 'accessing' stamp: 'MarcusDenker 9/29/2014 15:07'!
codeForNoSource
	"if everything fails, decompile the bytecode"
	 ^(self compiler decompileMethod: self) formattedCode! !

!CompiledMethod methodsFor: 'testing' stamp: 'GuillermoPolito 4/26/2012 11:11'!
isExternalCallPrimitive
	^self primitive = 120! !

!CompiledMethod methodsFor: 'source code management' stamp: 'hmm 4/26/2000 21:02'!
setSourcePosition: position inFile: fileIndex 
	self setSourcePointer: (SourceFiles sourcePointerFromFileIndex: fileIndex andPosition: position)! !

!CompiledMethod methodsFor: 'accessing' stamp: 'MarcusDenker 10/16/2013 21:59'!
category

	^self methodClass organization categoryOfElement: self selector! !

!CompiledMethod methodsFor: '*NautilusCommon' stamp: 'CAMILLETERUEL 3/29/2013 11:52'!
containsHalt

	^ self literals includesAnyOf: #( halt halt: halt:onCount: haltIf: haltIfNil haltIfShiftPressed haltOnCount: haltOnce).! !

!CompiledMethod methodsFor: 'initialize-release' stamp: 'CamilloBruni 8/31/2013 20:55'!
removeFromSystem
	^ self methodClass removeSelector: self selector! !

!CompiledMethod methodsFor: 'testing' stamp: 'NS 3/22/2005 16:32'!
isDisabled
	^ self isDisabled: self markerOrNil! !

!CompiledMethod methodsFor: 'testing' stamp: 'NS 3/22/2005 16:40'!
isProvided: marker
	marker ifNil: [^ true].
	^ (self isRequired: marker) not and: [(self isDisabled: marker) not]! !

!CompiledMethod methodsFor: 'accessing' stamp: 'ClementBera 2/24/2015 15:47'!
primitive
	"Answer the primitive index associated with the receiver.
	Zero indicates that this is not a primitive method.
	We currently allow 10 bits of primitive index, but they are in two places
	for  backward compatibility.  The time to unpack is negligible,
	since the reconstituted full index is stored in the method cache."
	| primBits initialPC |
	Smalltalk vm isSpur ifTrue: [
		(self header anyMask: 65536) ifFalse: [ ^ 0 ].
		^ (self at: (initialPC := self initialPC) + 1) + ((self at: initialPC + 2) bitShift: 8) ]. 
	primBits := self header bitAnd: 16r100001FF.
	^ (primBits bitAnd: 16r1FF) + (primBits bitShift: -19)
! !

!CompiledMethod methodsFor: 'source code management' stamp: 'MarcusDenker 4/24/2013 16:15'!
putSource: sourceStr class: class category: catName
	withStamp: changeStamp inFile: fileIndex priorMethod: priorMethod

	^ self putSource: sourceStr inFile: fileIndex withPreamble:
			[:file |
			class printCategoryChunk: catName on: file
				withStamp: changeStamp priorMethod: priorMethod.
			file cr]! !

!CompiledMethod methodsFor: '*Ring-Core-Kernel' stamp: 'VeronicaUquillas 9/19/2011 16:09'!
asRingDefinition
	"Retrieves an active RGMethodDefinition object based on the receiver.
	Note that its class is not converted."
	
	^ self asActiveRingDefinition! !

!CompiledMethod methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 2/17/2015 12:34'!
brickValue: anObject withEnoughArguments: aCollection

	^ anObject withArgs: aCollection executeMethod: self! !

!CompiledMethod methodsFor: 'private' stamp: 'eem 11/29/2008 11:52'!
penultimateLiteral: anObject
	"Answer the penultimate literal of the receiver, which holds either
	 the receiver's selector or its properties (which will hold the selector)."
	| pIndex |
	(pIndex := self numLiterals - 1) > 0 
		ifTrue: [self literalAt: pIndex put: anObject]
		ifFalse: [self error: 'insufficient literals']! !

!CompiledMethod methodsFor: 'scanning' stamp: 'eem 12/6/2011 13:23'!
abstractBytecodeMessagesFrom: startpc to: endpc do: aBlock
	"Evaluate aBlock with the sequence of abstract bytecodes from startpc through endpc in the receiver"
	| scanner |
	scanner := InstructionStream new method: self pc: startpc.
	[scanner pc <= endpc] whileTrue:
		[[scanner interpretNextInstructionFor: nil]
			on: MessageNotUnderstood
			do: [:ex| aBlock value: ex message]]

	"| m msgs |
	 msgs := OrderedCollection new.
	 (m := CompiledMethod >> #abstractBytecodeMessagesFrom:to:)
		abstractBytecodeMessagesFrom: m initialPC
		to: m endPC
		do: [:msg| msgs add: msg selector].
	 msgs"! !

!CompiledMethod methodsFor: 'literals' stamp: 'marcus.denker 9/29/2008 08:44'!
literals
	"Answer an Array of the literals referenced by the receiver."
	| literals numberLiterals |
	literals := Array new: (numberLiterals := self numLiterals).
	1 to: numberLiterals do: [:index |
		literals at: index put: (self objectAt: index + 1)].
	^literals! !

!CompiledMethod methodsFor: 'accessing-pragmas & properties' stamp: 'eem 11/29/2008 11:50'!
propertyValueAt: propName ifAbsent: aBlock
	| propertiesOrSelector |
	^(propertiesOrSelector := self penultimateLiteral) isMethodProperties
		ifTrue: [propertiesOrSelector propertyValueAt: propName ifAbsent: aBlock]
		ifFalse: [aBlock value]! !

!CompiledMethod methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/24/2015 15:16'!
spotterForSendersFor: aStep
	<spotterOrder: 10>
	aStep listProcessor
			title: 'Senders';
			allCandidates: [ self senders collect: #compiledMethod ];
			filter: GTFilterSubstring! !

!CompiledMethod methodsFor: 'accessing' stamp: 'eem 11/28/2008 12:54'!
selector
	"Answer a method's selector.  This is either the penultimate literal,
	 or, if the method has any properties or pragmas, the selector of
	 the MethodProperties stored in the penultimate literal."
	| penultimateLiteral | 
	^(penultimateLiteral := self penultimateLiteral) isMethodProperties
		ifTrue: [penultimateLiteral selector]
		ifFalse: [penultimateLiteral]! !

!CompiledMethod methodsFor: 'source code management' stamp: 'mf 4/29/2012 13:11'!
copyWithSource: aString
	^self copyWithTrailerBytes: (CompiledMethodTrailer new sourceCode: aString) ! !

!CompiledMethod methodsFor: '*NautilusCommon' stamp: 'TorstenBergmann 1/16/2015 19:56'!
isScriptMethod
	"Return true if the method is tagged with <script> pragma"
	
    ^ (self methodClass isMeta) and: [ 
			self numArgs isZero and: [ self pragmas anySatisfy: [:each | each keyword = #script ]]]! !

!CompiledMethod methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 11/20/2014 23:13'!
spotterItemsFor: aStep
	"do nothing for compiled method"! !

!CompiledMethod methodsFor: '*Ring-Core-Kernel' stamp: 'MarcusDenker 8/1/2014 14:13'!
asActiveRingDefinition
	"Retrieves an active RGMethodDefinition object based on the data of the receiver.
	Source, protocol and stamp are retrieved from the compiled method"
	
	^ RGMethodDefinition new 
			name: self selector;
			parentName: self methodClass name;
			isMetaSide: self methodClass isMeta;
			asActive.
! !

!CompiledMethod methodsFor: 'literals' stamp: ''!
header
	"Answer the word containing the information about the form of the 
	receiver and the form of the context needed to run the receiver."

	^self objectAt: 1! !

!CompiledMethod methodsFor: 'accessing' stamp: 'ClementBera 12/28/2014 18:11'!
signFlag
	"Answer the sign flag bit.  The sign flag bit may be
	 used by the VM to select an alternate bytecode set."

	^ self header < 0! !

!CompiledMethod methodsFor: 'scanning' stamp: ''!
scanFor: byte 
	"Answer whether the receiver contains the argument as a bytecode."

	^ (InstructionStream on: self) scanFor: [:instr | instr = byte]
"
Smalltalk browseAllSelect: [:m | m scanFor: 134]
"! !

!CompiledMethod methodsFor: '*Ring-Core-Kernel' stamp: 'CamilloBruni 5/21/2012 15:29'!
getSourceFromFile: file
	"Read the source code from file, determining source file index and
	file position from the last 3 bytes of this method."
	| position |
	(position := self filePosition) = 0 ifTrue: [^ nil].
	"assime this is a valid file"
	file position: position.
	^ file nextChunk! !

!CompiledMethod methodsFor: '*Manifest-Core' stamp: 'StephaneDucasse 3/21/2013 12:44'!
criticNameOn: aStream
	"This behavior may be folded later by changing the name of this method or using another one."
	
	aStream 
		<< self methodClass name 
		<< '>>#' 
		<< self selector  
		<< ' (' 
		<< self methodClass theNonMetaClass category 
		<< ')'! !

!CompiledMethod methodsFor: '*OpalDecompiler' stamp: 'MarcusDenker 9/30/2014 16:20'!
gtInspectorDecompilerIn: composite
	<gtInspectorPresentationOrder: 40> 
	^ composite smalltalkCode 
		title: 'Decompiled';
		smalltalkClass: [ self methodClass ];
		display: [ self codeForNoSource ].! !

!CompiledMethod methodsFor: 'scanning' stamp: 'marcus.denker 9/29/2008 08:50'!
messages
	"Answer a Set of all the message selectors sent by this method."

	| scanner aSet |
	aSet := Set new.
	scanner := InstructionStream on: self.
	scanner	scanFor: [:x | 
			scanner addSelectorTo: aSet.
			false	"keep scanning"].
	^aSet! !

!CompiledMethod methodsFor: 'accessing' stamp: 'ClementBera 2/24/2015 15:43'!
numLiterals
    "Answer the number of literals used by the receiver."
    
    Smalltalk vm isSpur ifTrue: [ ^ self header bitAnd: 16r7FFF ]. 
    ^ (self header bitShift: -9) bitAnd: 16rFF! !

!CompiledMethod methodsFor: 'initialize-release' stamp: 'ClementBEra 4/2/2015 09:44'!
setFrameBit: boolean 
	"true for large frame, else false"
	| largeFrameBit newHeader |
	largeFrameBit := 16r20000.
	newHeader := self header bitAnd: largeFrameBit bitInvert.
	boolean ifTrue: [ newHeader := newHeader + largeFrameBit ].
	self objectAt: 1 put: newHeader.! !

!CompiledMethod methodsFor: 'source code management' stamp: 'CamilloBruni 2/23/2014 20:26'!
hasSourceCodeInChangesFile
	^ self fileIndex == 2! !

!CompiledMethod methodsFor: 'comparing' stamp: 'MarianoMartinezPeck 7/24/2012 09:42'!
hash
	"CompiledMethod>>#= compares code, i.e. same literals and same bytecode.
	 So we look at the header, methodClass and some bytes between initialPC and endPC,
	 but /not/ the selector because the equal method does not compare selectors.
	 Note that we must override ByteArray>hash which looks at all bytes of the receiver.
	 Using bytes from the pointer part of a COmpiledmethod can lead to a variable hash
	 if and when when the GC moves literals in the receiver."
	| initialPC endPC hash |
	initialPC := self initialPC.
	endPC := self endPC.
	hash := self species hash + self header + initialPC + endPC + self methodClass hash bitAnd: 16rFFFFFFF.
	"sample approximately 20 bytes"
	initialPC to: endPC by: (endPC - initialPC // 20 max: 1) do:
		[:i| hash := hash + (self at: i)].
	^hash

	"(CompiledMethod>>#hash) hash"
! !

!CompiledMethod methodsFor: 'accessing' stamp: 'md 1/20/2006 16:09'!
method
	"polymorphic with closure"

	^ self! !

!CompiledMethod methodsFor: '*NautilusCommon' stamp: 'BenjaminVanRyseghem 4/7/2011 18:11'!
hasFailedTest

	^ self methodClass methodFailed: (self selector)! !

!CompiledMethod methodsFor: 'accessing' stamp: ''!
returnField
	"Answer the index of the instance variable returned by a quick return 
	method."
	| prim |
	prim := self primitive.
	prim < 264
		ifTrue: [self error: 'only meaningful for quick-return']
		ifFalse: [^ prim - 264]! !

!CompiledMethod methodsFor: '*FuelTests' stamp: 'MarianoMartinezPeck 4/20/2012 21:23'!
sizeWithoutTrailer
	^ self trailer endPC! !

!CompiledMethod methodsFor: 'literals' stamp: ''!
objectAt: index put: value 
	"Primitive. Store the value argument into a literal in the receiver. An 
	index of 2 corresponds to the first literal. Fails if the index is less than 2 
	or greater than the number of literals. Answer the value as the result. 
	Normally only the compiler sends this message, because only the 
	compiler stores values in CompiledMethods. Essential. See Object 
	documentation whatIsAPrimitive."

	<primitive: 69>
	self primitiveFailed! !

!CompiledMethod methodsFor: '*opalcompiler-core' stamp: 'MarcusDenker 5/14/2013 17:06'!
irPrimitive

	| primNode n |
	primNode := IRPrimitive new num: (n := self primitive).
	(n = 117 or: [n = 120]) ifTrue: [
		primNode spec: (self literalAt: 1)].
	^ primNode! !

!CompiledMethod methodsFor: 'evaluating' stamp: 'StephaneDucasse 6/24/2011 18:09'!
valueWithReceiver: aReceiver arguments: anArray 
	"This should be changed when all the VM will support passign of extra arguments
		^self receiver: aReceiver withArguments: anArray executeMethod: self"
	
	^ aReceiver withArgs: anArray executeMethod: self! !

!CompiledMethod methodsFor: 'source code management' stamp: 'MarcusDenker 8/22/2012 16:24'!
author
	"Answer the author of the current version of the receiver. retrieved from the sources or changes file. Answer the empty string if no time stamp is available."

	"(CompiledMethod compiledMethodAt: #author) author"

	self timeStamp ifNotEmpty: [:s | 
		|subS|
		subS := s substrings first. 
		subS first isLetter ifTrue:[^subS]].
	^''! !

!CompiledMethod methodsFor: '*Reflectivity' stamp: 'MarcusDenker 2/26/2015 13:38'!
destroyTwin
	self reflectiveMethod: nil! !

!CompiledMethod methodsFor: 'accessing' stamp: 'ClementBera 2/24/2015 15:43'!
numTemps
	"Answer the number of temporary variables used by the receiver."
	
	^ (self header bitShift: -18) bitAnd: 16r3F! !

!CompiledMethod methodsFor: '*NautilusCommon' stamp: 'TorstenBergmann 8/23/2014 00:06'!
isClassInitializeMethod

    ^ (self methodClass isMeta) and: [ 
		self selector = #initialize ]! !

!CompiledMethod methodsFor: 'printing' stamp: 'nice 11/1/2009 22:09'!
isSelfEvaluating

	^self methodClass notNil and: [(#(#DoIt #DoItIn: nil) includes: self selector) not]! !

!CompiledMethod methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 7/12/2013 16:39'!
hasNativeCallPrimitive
	"Answer true if receiver has following primitive:
	
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin [error:....]>
	"
	^ ((self primitive = 117) and: [  | lit |  lit := self literalAt: 1. 
			lit first = #NativeBoostPlugin and: [ lit second == #primitiveNativeCall]])! !

!CompiledMethod methodsFor: 'printing' stamp: 'MarcusDenker 6/5/2012 14:09'!
printPrimitiveOn: aStream
	"Print the primitive on aStream"
	| primDecl |
	self isPrimitive ifFalse: [ ^self ].

	self isExternalCallPrimitive ifTrue:
		[^aStream print: (self literalAt: 1); cr].
	aStream nextPutAll: '<primitive: '.
	self isNamedPrimitive
		ifTrue:
			[primDecl := self literalAt: 1.
			 (primDecl at: 2) asString printOn: aStream.
			 (primDecl at: 1) ifNotNil:
				[:moduleName|
				aStream nextPutAll:' module: '.
				moduleName asString printOn: aStream]]
		ifFalse:
			[aStream print: self primitive].
	self primitiveErrorVariableName ifNotNil:
		[:primitiveErrorVariableName|
		 aStream nextPutAll: ' error: '; nextPutAll: primitiveErrorVariableName].
	aStream nextPut: $>; cr! !

!CompiledMethod methodsFor: 'literals' stamp: 'eem 11/29/2008 17:01'!
hasLiteralSuchThat: litBlock
	"Answer true if litBlock returns true for any literal in this method, even if embedded in array structure."
	(self penultimateLiteral isMethodProperties
	 and: [self penultimateLiteral hasLiteralSuchThat: litBlock]) ifTrue:
		[^true].
	2 to: self numLiterals + 1 do:
		[:index | | lit |
		lit := self objectAt: index.
		((litBlock value: lit)
		or: [lit isArray and: [lit hasLiteralSuchThat: litBlock]]) ifTrue:
			[^true]].
	^false! !

!CompiledMethod class methodsFor: 'accessing class hierarchy' stamp: 'eem 9/16/2011 11:12'!
methodPropertiesClass
	"Answer the class to use to create a method's properties, which can be a poor man's way
	 to add instance variables to subclassses of CompiledMethod.  Subclasses of CompiledMethod
	 should define a corresponding subclass of AdditionalMethodState that adds any instance variables
	 required, and override this method to answer that class."
	^AdditionalMethodState! !

!CompiledMethod class methodsFor: 'constants' stamp: 'al 1/23/2004 13:11'!
explicitRequirementMarker
	^ #explicitRequirement! !

!CompiledMethod class methodsFor: 'instance creation' stamp: 'MarcusDenker 3/13/2011 20:23'!
basicNew

	self error: 'CompiledMethods may only be created with newMethod:header:' ! !

!CompiledMethod class methodsFor: 'constants' stamp: 'al 1/23/2004 13:11'!
subclassResponsibilityMarker
	^ #subclassResponsibility! !

!CompiledMethod class methodsFor: 'instance creation' stamp: 'StephaneDucasse 12/18/2009 11:59'!
newMethod: numberOfBytes header: headerWord 
	"Primitive. Answer an instance of me. The number of literals (and other 
	information) is specified the headerWord. The first argument specifies 
	the number of fields for bytecodes in the method. Fail if either 
	argument is not a SmallInteger, or if numberOfBytes is negative. Once 
	the header of a method is set by this primitive, it cannot be changed in 
	any way. Essential. See Object documentation whatIsAPrimitive."

	<primitive: 79>
	(numberOfBytes isInteger and:
	 [headerWord isInteger and:
	 [numberOfBytes >= 0]]) ifTrue: [
		"args okay; space must be low"
		OutOfMemory signal.
		"retry if user proceeds"
		^ self newMethod: numberOfBytes header: headerWord
	].
	^self primitiveFailed! !

!CompiledMethod class methodsFor: 'class initialization' stamp: 'ClementBera 2/24/2015 15:40'!
initialize    "CompiledMethod initialize"
	"Initialize class variables specifying the size of the temporary frame
	needed to run instances of me."

	SmallFrame := 16.	"Context range for temps+stack"
	LargeFrame := 56.
	PrimaryBytecodeSetEncoderClass := EncoderForV3PlusClosures.
	SecondaryBytecodeSetEncoderClass := EncoderForSistaV1.! !

!CompiledMethod class methodsFor: 'instance creation' stamp: 'Igor.Stasenko 12/20/2009 04:32'!
toReturnSelf
	"Answer an instance of me that is a quick return of the instance (^self)."

	^ self toReturnSelfTrailerBytes: CompiledMethodTrailer empty! !

!CompiledMethod class methodsFor: 'instance creation' stamp: 'NS 12/12/2003 15:03'!
newFrom: aCompiledMethod
	| inst |
	inst := super basicNew: aCompiledMethod size.
	1 to: aCompiledMethod size do: [:index |
		inst at: index put: (aCompiledMethod at: index)].
	^ inst.! !

!CompiledMethod class methodsFor: 'instance creation' stamp: 'tk 9/9/2000 20:36'!
basicNew: size

	self error: 'CompiledMethods may only be created with newMethod:header:' ! !

!CompiledMethod class methodsFor: 'constants' stamp: 'al 1/23/2004 13:11'!
disabledMarker
	^ #shouldNotImplement! !

!CompiledMethod class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 3/26/2015 00:04'!
gtExampleSimple
	<gtExample>
	^ self class>>#gtExampleSimple! !

!CompiledMethod class methodsFor: 'constants' stamp: 'AlexandreBergel 9/14/2011 08:30'!
abstractMarker
	^ #subclassResponsibility! !

!CompiledMethod class methodsFor: 'instance creation' stamp: 'eem 9/13/2011 15:16'!
newBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex
	"Answer an instance of me. The header is specified by the message 
	arguments. The remaining parts are not as yet determined."
	| largeBit primBits |
	nTemps > 63 ifTrue:
		[^ self error: 'Cannot compile -- too many temporary variables'].	
	nLits > 255 ifTrue:
		[^ self error: 'Cannot compile -- too many literals variables'].	
	largeBit := (nTemps + stackSize) > SmallFrame ifTrue: [1] ifFalse: [0].
	primBits := primitiveIndex <= 16r1FF
		ifTrue: [primitiveIndex]
		ifFalse: ["For now the high bit of primitive no. is in the 29th bit of header"
				primitiveIndex > 16r3FF ifTrue: [self error: 'prim num too large'].
				(primitiveIndex bitAnd: 16r1FF) + ((primitiveIndex bitAnd: 16r200) bitShift: 19)].

	^trailer
		createMethod: numberOfBytes
		class: self
		header: (nArgs bitShift: 24) +
				(nTemps bitShift: 18) +
				(largeBit bitShift: 17) +
				(nLits bitShift: 9) +
				primBits! !

!CompiledMethod class methodsFor: 'instance creation' stamp: 'md 8/5/2005 17:06'!
toReturnConstant: index trailerBytes: trailer
	"Answer an instance of me that is a quick return of the constant
	indexed in (true false nil -1 0 1 2)."

	^ self newBytes: 0 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256 + index
! !

!CompiledMethod class methodsFor: 'instance creation' stamp: 'md 8/5/2005 17:05'!
toReturnSelfTrailerBytes: trailer
	"Answer an instance of me that is a quick return of the instance (^self)."

	^ self newBytes: 0 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256
! !

!CompiledMethod class methodsFor: '*Spec-Inspector' stamp: 'CamilloBruni 9/21/2013 19:59'!
additionalInspectorClasses
	^ super additionalInspectorClasses, { EyeMethodEditor }! !

!CompiledMethod class methodsFor: 'instance creation' stamp: 'eem 9/13/2011 15:18'!
newBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex flag: flag
	"Answer an instance of me. The header is specified by the message 
	arguments. The remaining parts are not as yet determined."
	| largeBit primBits flagBit |
	nTemps > 63 ifTrue:
		[^ self error: 'Cannot compile -- too many temporary variables'].	
	nLits > 255 ifTrue:
		[^ self error: 'Cannot compile -- too many literals variables'].	
	largeBit := (nTemps + stackSize) > SmallFrame ifTrue: [1] ifFalse: [0].

	"For now the high bit of the primitive no. is in a high bit of the header"
	primBits := (primitiveIndex bitAnd: 16r1FF) + ((primitiveIndex bitAnd: 16r200) bitShift: 19).

	flagBit := flag ifTrue: [ 1 ] ifFalse: [ 0 ].

	"Copy the source code trailer to the end"
	^trailer
		createMethod: numberOfBytes
		class: self
		header: (nArgs bitShift: 24) +
				(nTemps bitShift: 18) +
				(largeBit bitShift: 17) +
				(nLits bitShift: 9) +
				primBits +
				(flagBit bitShift: 29)! !

!CompiledMethod class methodsFor: '*Spec-Inspector' stamp: 'cb 6/25/2013 13:43'!
inspectorClass
	^ EyeCompiledMethodInspector! !

!CompiledMethod class methodsFor: 'class initialization' stamp: 'ajh 7/18/2001 02:04'!
smallFrameSize

	^ SmallFrame! !

!CompiledMethod class methodsFor: 'instance creation' stamp: 'GuillermoPolito 2/27/2015 17:45'!
headerFlagForEncoder: anEncoderClass
	anEncoderClass == PrimaryBytecodeSetEncoderClass ifTrue: [ ^ 0 ].
	anEncoderClass == SecondaryBytecodeSetEncoderClass ifTrue: [ ^ SmallInteger minVal ].
	self error: 'The encoder is not one of the two installed bytecode sets'! !

!CompiledMethod class methodsFor: 'constants' stamp: 'al 1/23/2004 13:11'!
conflictMarker
	^ #traitConflict! !

!CompiledMethod class methodsFor: 'instance creation' stamp: 'MarcusDenker 6/27/2013 15:46'!
cleanUp

	self allInstances do: [:e | e isInstalled ifFalse: [e embeddSourceInTrailer]].  
	"pay attention since embeddSourceInTrailer creates a new compiled method. So iterating while
	changing it is a bad idea. This is why we use allInstances do and not allInstancesDo:"! !

!CompiledMethod class methodsFor: 'instance creation' stamp: 'NS 12/12/2003 15:08'!
newInstanceFrom: oldInstance variable: variable size: instSize map: map
	"Create a new instance of the receiver based on the given old instance.
	The supplied map contains a mapping of the old instVar names into
	the receiver's instVars"
	| new |
	new := self newFrom: oldInstance.
	1 to: instSize do: 
		[:offset |  (map at: offset) > 0 ifTrue:
			[new instVarAt: offset
					put: (oldInstance instVarAt: (map at: offset))]].
	^new! !

!CompiledMethod class methodsFor: 'class initialization' stamp: 'di 1/11/1999 22:13'!
fullFrameSize  "CompiledMethod fullFrameSize"
	^ LargeFrame! !

!CompiledMethod class methodsFor: 'instance creation' stamp: 'eem 9/14/2011 10:53'!
new
	"This will not make a meaningful method, but it could be used
	to invoke some otherwise useful method in this class."
	^self newMethod: 2 header: 1024! !

!CompiledMethod class methodsFor: 'instance creation' stamp: 'MarcusDenker 6/19/2012 10:10'!
primitive: primNum numArgs: numArgs numTemps: numTemps stackSize: stackSize literals: literals bytecodes: bytecodes trailer: trailerBytes
	"Create method with given attributes.  numTemps includes numArgs.  stackSize does not include numTemps."

	| compiledMethod |
	compiledMethod := self
		newBytes: bytecodes size
		trailerBytes: trailerBytes 
		nArgs: numArgs
		nTemps: numTemps
		nStack: 0
		nLits: literals size
		primitive: primNum.
	(WriteStream with: compiledMethod)
		position: compiledMethod initialPC - 1;
		nextPutAll: bytecodes.
	literals withIndexDo: [:obj :i | compiledMethod literalAt: i put: obj].
	compiledMethod needsFrameSize: stackSize.
	^ compiledMethod! !

!CompiledMethod class methodsFor: 'instance creation' stamp: 'md 8/5/2005 17:06'!
toReturnField: field trailerBytes: trailer
	"Answer an instance of me that is a quick return of the instance variable 
	indexed by the argument, field."

	^ self newBytes: 0 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 264 + field
! !

!CompiledMethod class methodsFor: '*Collections-Abstract' stamp: 'CamilloBruni 2/22/2013 22:46'!
sortBlock
	"Return a sort block that orders methods by class name and then by selector"
	^  [ :a :b| 
			a methodClass = b methodClass
				ifTrue: [ a selector <= b selector ]
				ifFalse: [ a methodClass name <= b methodClass name ]]! !

!CompiledMethod class methodsFor: 'constants' stamp: 'al 1/23/2004 13:11'!
implicitRequirementMarker
	^ #requirement! !

!CompiledMethodLayout commentStamp: '<historical>'!
I am a special layout version for CompiledMethods. 
Unlike default Object layouts, CompiledMethods define a custom format integer since they mix bytes and pointer types.

See CompiledMethod for more details.!
!CompiledMethodLayout methodsFor: 'format' stamp: 'MartinDias 7/4/2013 12:52'!
format
	^ 1538 bitOr: (compactClassIndex bitShift: 11)! !

!CompiledMethodLayout class methodsFor: 'instance creation' stamp: 'MartinDias 7/11/2013 16:01'!
extending: superLayout scope: aScope host: aClass
	^ superLayout extendCompiledMethod
		host: aClass;
		yourself! !

!CompiledMethodTest commentStamp: '<historical>'!
This is the unit test for the class CompiledMethod. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see: 
	- http://www.c2.com/cgi/wiki?UnitTest
	- there is a chapter in the PharoByExample book (http://pharobyexample.org)
	- the sunit class category!
!CompiledMethodTest methodsFor: 'examples' stamp: 'Alexandre Bergel 5/6/2010 12:17'!
deprecatedMethod
	self deprecated: 'example of a deprecated method'! !

!CompiledMethodTest methodsFor: 'tests - slots' stamp: 'MarcusDenker 7/19/2014 14:25'!
testReadsSlot

	self assert: ((Point>>#x) readsSlot: (Point slotNamed: #x)).
	self deny: ((Point>>#x) readsSlot: (Point slotNamed: #y)).
	self deny: ((Point>>#setX:setY:) readsSlot: (Point slotNamed: #y)).
	
	! !

!CompiledMethodTest methodsFor: 'tests - testing' stamp: 'BenComan 3/2/2014 02:40'!
testIsInstalled
|  method cls |

	method := (self class)>>#returnTrue.
	self assert: method isInstalled.

	"now make an orphaned method by just deleting the class."

	Smalltalk removeClassNamed: #TUTU.

	cls := Object subclass: #TUTU
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: self categoryNameForTemporaryClasses.
	cls compile: 'foo ^ 10'.
	method := cls >> #foo.
	Smalltalk removeClassNamed: #TUTU.

	self deny: method isInstalled. ! !

!CompiledMethodTest methodsFor: 'examples' stamp: 'sd 4/6/2009 21:27'!
readX
	| tmp |
	tmp := x.
	^ tmp! !

!CompiledMethodTest methodsFor: 'examples' stamp: 'sd 4/6/2009 21:23'!
writeX
	
	x := 33
	! !

!CompiledMethodTest methodsFor: 'tests - instance variable' stamp: 'MarcusDenker 8/2/2011 17:34'!
testReadsField
	"self debug: #testReadsField"
	
	| method |
	method := self class compiledMethodAt: #readX.
	self assert: (method readsField: 3).
	
	method := self class compiledMethodAt: #readXandY.
	self assert: (method readsField: 4).
	
	
	"read is not write"
	method := self class compiledMethodAt: #writeX.
	self deny: (method readsField: 3).
	
	method := self class compiledMethodAt: #writeXandY.
	self deny: (method readsField: 3).
	
	method := self class compiledMethodAt: #writeXandY.
	self deny: (method readsField: 4)! !

!CompiledMethodTest methodsFor: 'coverage' stamp: 'nice 4/8/2011 08:55'!
classToBeTested
	
	^CompiledMethod! !

!CompiledMethodTest methodsFor: 'tests - accessing' stamp: 'EstebanLorenzano 1/15/2013 18:37'!
testOrigin
	| regularMethod methodFromTrait aliasedMethod |

	"Regular method"
	regularMethod := Behavior>>#name.
	
	"Method from a trait without alias "
	methodFromTrait := Behavior>>#addToComposition:.

	"Method from a trait with an alias"
	aliasedMethod := MOPTestClassD >>#c3.

	self assert: regularMethod origin == regularMethod originMethod methodClass.
	self assert: methodFromTrait origin == methodFromTrait originMethod methodClass.
	self assert: aliasedMethod origin == aliasedMethod originMethod methodClass.! !

!CompiledMethodTest methodsFor: 'tests - evaluating' stamp: 'md 4/16/2003 15:30'!
testValueWithReceiverArguments
	
	| method value |

	method := self class compiledMethodAt: #returnTrue.

	value := method valueWithReceiver: nil arguments: #().
	self assert: (value = true).

	method := self class compiledMethodAt: #returnPlusOne:.
	value := method valueWithReceiver: nil arguments: #(1).
	self assert: (value = 2).	! !

!CompiledMethodTest methodsFor: 'tests - slots' stamp: 'MarcusDenker 7/19/2014 14:26'!
testAccessesSlot

	self assert: ((Point>>#x) accessesSlot: (Point slotNamed: #x)).
	self deny: ((Point>>#x) accessesSlot: (Point slotNamed: #y)).
	self assert: ((Point>>#setX:setY:) accessesSlot: (Point slotNamed: #y)).
	
	! !

!CompiledMethodTest methodsFor: 'tests - accessing' stamp: 'CamilloBruni 10/15/2013 01:20'!
testBytecode
	self assertCollection: (Object>>#halt) bytecode equals:  #[64 209 135 120]! !

!CompiledMethodTest methodsFor: 'tests - testing' stamp: 'MarcusDenker 4/29/2011 00:41'!
testIsDeprecated
	|  method cls |

	method := (self class)>>#deprecatedMethod.
	self assert: method isDeprecated.
	
	method := (self class)>>#deprecatedMethod2.
	self assert: method isDeprecated.


	method := (self class)>>#testIsDeprecated.
	self deny: method isDeprecated.
! !

!CompiledMethodTest methodsFor: 'tests - accessing' stamp: 'BenComan 3/2/2014 02:36'!
testSelector
	|  method cls |

	method := (self class)>>#returnTrue.
	self assert: (method selector = #returnTrue).

	"now make an orphaned method. new semantics: return corrent name"	
	
	Smalltalk removeClassNamed: #TUTU.

	cls := Object subclass: #TUTU
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: self categoryNameForTemporaryClasses.
	cls compile: 'foo ^ 10'.
	method := cls >> #foo.
	Smalltalk removeClassNamed: #TUTU.

	self assert: method selector = #foo. 
! !

!CompiledMethodTest methodsFor: 'examples' stamp: 'md 2/18/2006 20:09'!
returnTrue
	^true  ! !

!CompiledMethodTest methodsFor: 'tests - instance variable' stamp: 'sd 4/6/2009 21:30'!
testHasInstVarRef
	"self debug: #testHasInstVarRef"
	
	| method  |
	method := self class compiledMethodAt: #readX.
	self assert: (method hasInstVarRef).

	method := self class compiledMethodAt: #readXandY.
	self assert: (method hasInstVarRef).
	
	method := self class compiledMethodAt: #writeX.
	self assert: (method hasInstVarRef).
	
	method := self class compiledMethodAt: #writeXandY.
	self assert: (method hasInstVarRef).
	! !

!CompiledMethodTest methodsFor: 'examples' stamp: 'md 2/18/2006 20:09'!
returnPlusOne: anInteger
	^anInteger + 1. ! !

!CompiledMethodTest methodsFor: 'tests - accessing' stamp: 'LukasRenggli 5/8/2010 19:47'!
testComparison
	| method1 method2 |
	method1 := Float class >> #nan.
	method2 := thisContext method.
	
	self assert: method1 = method1.
	self assert: method2 = method2.
	self deny: method1 = method2.
	self deny: method2 = method1.
	
	Object methods do: [ :each |
		self deny: method1 = each.
		self deny: each = method1.
		self deny: method2 = each.
		self deny: each = method2 ]! !

!CompiledMethodTest methodsFor: 'running' stamp: 'BenComan 3/2/2014 02:38'!
categoryNameForTemporaryClasses
	"Answer the category where to classify temporarily created classes"

	^'Dummy-Tests-Class'! !

!CompiledMethodTest methodsFor: 'examples' stamp: 'AlexandreBergel 9/14/2011 08:27'!
abstractMethod
	"I am an abstract method"
	
	^ self subclassResponsibility! !

!CompiledMethodTest methodsFor: 'tests - performing' stamp: 'StephaneDucasse 12/20/2010 16:01'!
testPerformInSuperclassCanExecutelongMethodWithTemps
	"self debug: #testPerformInSuperclassCanExecutelongMethodWithTemps"
	"the perform: primitive reuses the context of the method calling it. The primitive adds performed selector arguments to the context variables list. So this means that you can execute some methods but not performed them if the calling methods defined too many temps "
	
	| temp1 temp2 temp3 |
	temp1 := 33.
	temp2 := 666.
	temp3 := 42. 
	self assert: (self perform: #a1:a2:a3:a4:a5:a6:a7:a8:a9:a10:a11:a12:a13:a14:a15: withArguments: #(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15) inSuperclass: self class) = 1! !

!CompiledMethodTest methodsFor: 'tests - testing' stamp: 'md 4/16/2003 15:32'!
testIsQuick
	| method  |

	method := self class compiledMethodAt: #returnTrue.
	self assert: (method isQuick).

	method := self class compiledMethodAt: #returnPlusOne:.
	self deny: (method isQuick).

	! !

!CompiledMethodTest methodsFor: 'tests - accessing' stamp: 'BenComan 3/2/2014 02:39'!
testMethodClass
	| method cls |
	method := self class >> #returnTrue.
	self assert: method selector = #returnTrue.
	"now make an orphaned method by just deleting the class.
	old: #unknown
	new semantics: return Absolete class"
	Smalltalk removeClassNamed: #TUTU.
	cls := Object
				subclass: #TUTU
				instanceVariableNames: ''
				classVariableNames: ''
				poolDictionaries: ''
				category: self categoryNameForTemporaryClasses.
	cls compile: 'foo ^ 10'.
	method := cls >> #foo.
	Smalltalk removeClassNamed: #TUTU.
	self assert: method methodClass = cls! !

!CompiledMethodTest methodsFor: 'tests - conversion' stamp: 'CamilloBruni 8/31/2013 20:23'!
testCompiledMethodAsString
	"self debug: #testCompiledMethodAsString"

	thisContext method asString! !

!CompiledMethodTest methodsFor: 'tests - performing' stamp: 'StephaneDucasse 12/20/2010 16:07'!
a1: a1 a2: a2 a3: a3 a4: a4 a5: a5 a6: a6 a7: a7 a8: a8 a9: a9 a10: a10 a11: a11 a12: a12 a13: a13 a14: a14 a15: a15
	"I'm a method with the maximum size of arguments that can be executed via normal send but crash on perform :)"
	
	^ a1 + a2 - a2! !

!CompiledMethodTest methodsFor: 'examples' stamp: 'MarcusDenker 4/29/2011 00:41'!
deprecatedMethod2
	self deprecated: 'example of a deprecated method' on: 'date' in: 'someversion'.! !

!CompiledMethodTest methodsFor: 'examples' stamp: 'AlexandreBergel 9/14/2011 08:27'!
nonAbstractMethod
	"I am not an abstract method"
	
	^ 4 + 5! !

!CompiledMethodTest methodsFor: 'tests - abstract' stamp: 'AlexandreBergel 9/14/2011 08:28'!
testIsAbstract

	self assert: (self class >> #abstractMethod) isAbstract..
	self deny: (self class >> #nonAbstractMethod) isAbstract..
	self deny: (self class >> #shouldNotImplementMethod) isAbstract..! !

!CompiledMethodTest methodsFor: 'tests - performing' stamp: 'StephaneDucasse 12/20/2010 16:10'!
testPerformCanExecutelongMethodWithTemps
	"self debug: #testPerformCanExecutelongMethodWithTemps"
	"the perform: primitive reuses the context of the method calling it. The primitive adds performed selector arguments to the context variables list. So this means that you can execute some methods but not performed them if the calling methods defined too many temps "
	
	| temp1 temp2 temp3 |
	temp1 := 33.
	temp2 := 666.
	temp3 := 42. 
	self assert: (self perform: #a1:a2:a3:a4:a5:a6:a7:a8:a9:a10:a11:a12:a13:a14:a15: withArguments: #(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)) = 1.
	self assert: (self class>>#testPerformCanExecutelongMethodWithTemps) frameSize = CompiledMethod smallFrameSize.
	self assert: (self class>>#a1:a2:a3:a4:a5:a6:a7:a8:a9:a10:a11:a12:a13:a14:a15:) frameSize = CompiledMethod fullFrameSize.! !

!CompiledMethodTest methodsFor: 'tests - comparing' stamp: 'MarcusDenker 9/5/2013 15:37'!
testEqualityInstanceSideMethod
   	| method1 method2 |

	method1 :=  TestCase compiler compile: 'aMethod'.
	method2 :=  TestCase compiler compile: 'aMethod'.

	self assert: (method1 literalAt: method1 numLiterals) ==  (method2 literalAt: method2 numLiterals).
 	self assert: method1 = method2.

! !

!CompiledMethodTest methodsFor: 'running' stamp: 'BenComan 3/2/2014 20:37'!
tearDown
	RPackage organizer unregisterPackageNamed: self categoryNameForTemporaryClasses.! !

!CompiledMethodTest methodsFor: 'tests - slots' stamp: 'MarcusDenker 7/19/2014 14:27'!
testWritesSlot

	self deny: ((Point>>#x) writesSlot: (Point slotNamed: #x)).
	self deny: ((Point>>#x) writesSlot: (Point slotNamed: #y)).
	
	self assert: ((Point>>#setX:setY:) writesSlot: (Point slotNamed: #y)).
	self assert: ((Point>>#setX:setY:) writesSlot: (Point slotNamed: #x)).
	! !

!CompiledMethodTest methodsFor: 'examples' stamp: 'sd 4/6/2009 21:23'!
readXandY
	
	^ x + y
	! !

!CompiledMethodTest methodsFor: 'tests - comparing' stamp: 'MarianoMartinezPeck 7/25/2012 14:25'!
testCopy
	<pragma: #pragma>
	| method copy |
	method := thisContext method.
	self assert: method pragmas notEmpty.
	copy := method copy.
	self assert: (method equivalentTo: copy).
	self assert: method header = copy header.
	self assert: method = copy.
	self assert: method ~~ copy.
	self assert: copy penultimateLiteral method == copy.
	self assert: method penultimateLiteral method == method.
	method pragmas do:
		[:p|
		self assert: p method == method].
	copy pragmas do:
		[:p|
		self assert: p method == copy]
! !

!CompiledMethodTest methodsFor: 'tests - comparing' stamp: 'MarcusDenker 9/5/2013 15:34'!
testEqualityClassSideMethod
   	| method1 method2 |

	method1 := TestCase class compiler
			compile: 'aMethod'.
		
	method2 := TestCase class compiler
			compile: 'aMethod'.
			

 	self assert: method1 = method2.

! !

!CompiledMethodTest methodsFor: 'tests - instance variable' stamp: 'MarcusDenker 8/2/2011 17:35'!
testWritesField
	"self debug: #testWritesField"

	| method |
	method := self class compiledMethodAt: #writeX.
	self assert: (method writesField: 3).
	
	method := self class compiledMethodAt: #writeXandY.
	self assert: (method writesField: 3).
	
	method := self class compiledMethodAt: #writeXandY.
	self assert: (method writesField: 4).
	
	"write is not read"
	
	method := self class compiledMethodAt: #readX.
	self deny: (method writesField: 3).
	
	method := self class compiledMethodAt: #readXandY.
	self deny: (method writesField: 3).
	
	method := self class compiledMethodAt: #readXandY.
	self deny: (method writesField: 4).! !

!CompiledMethodTest methodsFor: 'examples' stamp: 'sd 4/6/2009 21:23'!
writeXandY
	
	x := 33.
	y := 66
	! !

!CompiledMethodTest methodsFor: 'examples' stamp: 'AlexandreBergel 9/14/2011 08:28'!
shouldNotImplementMethod
	"I am not an abstract method"
	
	^ self shouldNotImplement! !

!CompiledMethodTest methodsFor: 'tests - comparing' stamp: 'MarcusDenker 5/2/2013 12:59'!
testCopyWithTrailerBytes
	<pragma: #pragma>
	| method copy |
	method := thisContext method.
	self assert: method pragmas notEmpty.
	copy := method copyWithTrailerBytes: method trailer.
	self assert: (method equivalentTo: copy).
	self deny: method == copy.
	self assert: method symbolic = copy symbolic. "but their bytecode should be the same"
	self assert: method ~~ copy.
	self assert: copy penultimateLiteral method == copy.
	self assert: method penultimateLiteral method == method.
	method pragmas do:
		[:p|
		self assert: p method == method].
	copy pragmas do:
		[:p|
		self assert: p method == copy]
! !

!CompiledMethodTrailer commentStamp: '<historical>'!
I am responsible for encoding and decoding various kinds of compiled method trailer data.
I should not expose any binary data outside of myself, so all tools which working with compiled methods
should ask me to encode the meta-data, they want to be added to the compiled method trailer, as well as retrieve it.

To add a new kind of trailer, you should give it a proper name and define it in the #trailerKinds method at my class side.
Then you need to implement a corresponding #encode<your name> and #decode<your name> methods at instance side. Then add any public accessor methods, which will use a newly introduced trailer kind for communicating with outer layer(s).

An encodeXXX methods should store result (byte array) into encodedData instance variable.

A decodeXXX methods should read the data from compiled method instance, held by 'method' ivar,
and always set 'size' ivar (denoting a total length of trailer in compiled method) and optionally 'data' ivar which should keep a decoded data, ready to be used by outer layer(s) using accessor method(s) you providing.

The kind of compiled method trailer is determined by the last byte of compiled method.

The byte format used is following: 
	"2rkkkkkkdd"

where 'k' bits stands for 'kind' , allowing totally 64 different kinds of method trailer
and 'd' bits is data.

Following is the list of currently defined trailer kinds:

NoTrailer , k = 000000, dd unused
method has no trailer, and total trailer size bytes is always 1

ClearedTrailer, k = 000001, 
method has cleared trailer (it was set to something else, but then cleared) 
dd+1  determines the number of bytes for size field, and size is a total length of trailer bytes
So a total length of trailer is: 1 + (dd + 1) + size

TempsNamesQCompress, k = 000010
the trailer contains a list of method temp names,  compressed using qCompress: method. 
dd+1  determines the number of bytes for size field, and size is a number of bytes of compressed buffer.
So a total length of trailer is:  1 + (dd + 1) + size

TempsNamesZip, k = 000011
the trailer contains a list of method temp names,  compressed using GZIP compression method. 
dd+1  determines the number of bytes for size field, and size is a number of bytes of compressed buffer
So a total length of trailer is: 1 + (dd + 1) + size

SourceBySelector, k = 000100
the trailer indicates , that method source is determined by a class + selector where it is installed to. 
Trailer size = 1.

SourceByStringIdentifier, k = 000101
the trailer indicates , that method source is determined by a class + some ByteString identifier. 
dd+1  determines the number of bytes for size of ByteString identifier, and size is number of bytes of string.
A total length of trailer is:  1 + (dd + 1) + size

EmbeddedSourceQCompress, k = 000110
the trailer contains an utf-8 encoded method source code, compressed using qCompress method
dd+1  determines the number of bytes for size field, and size is a number of bytes of compressed source code
A total length of trailer is:  1 + (dd + 1) + size

EmbeddedSourceZip, k = 000111
the trailer contains an utf-8 encoded method source code, comressed using GZIP 
dd+1  determines the number of bytes for size field, and size is a number of bytes of compressed buffer
A total length of trailer is:  1 + (dd + 1) + size

VarLengthSourcePointer, k = 001000
the trailer is variable-length encoded source pointer. 
dd bits is unused.

ExtendedKind, k = 001001
the next byte of trailer (one that prepends the last byte of compiled method)
denotes an extended kind of trailer, allowing to use additional 256 kinds of encoding method's trailer in future. 

SourcePointer, k = 111111 
the trailer is encoded source pointer. Total trailer size is 4-bytes 
(this kind of encoding is backwards compatible with most of existing compiled methods)

!
!CompiledMethodTrailer methodsFor: 'decoding' stamp: 'Igor.Stasenko 12/20/2009 21:36'!
decodeSourceByStringIdentifier

	"A method source is determined by a class + string identifier"
	| len |
	
	len := self decodeLengthField.

	data := (ReadStream on: method from: method size - size+1 to: method size - size + len) contents asString convertFromEncoding: 'utf8'! !

!CompiledMethodTrailer methodsFor: 'private' stamp: 'jannik.laval 5/1/2010 17:00'!
encodeLengthField: integer
	| bytes value |
	[integer > 0] assert.
	value := integer.
	bytes := ByteArray streamContents: [:str |
		[ value > 0 ] whileTrue: [
			str nextPut: (value bitAnd: 255).
			value := value >> 8 ]].
	"no more than 4 bytes for length field"
	[bytes size <=4] assert.
	^ bytes! !

!CompiledMethodTrailer methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/9/2010 00:28'!
sourcePointer

	kind == #NativeCodeTrailer ifTrue: [ ^ data at: 3].
	^ (kind == #SourcePointer or: [ kind == #VarLengthSourcePointer ] )
		ifTrue: [ data ]
		ifFalse: [ 0 ]
! !

!CompiledMethodTrailer methodsFor: '*Compression-Streams' stamp: 'StephaneDucasse 2/3/2010 22:11'!
decodeZip
	"data := <trailer> unzip utf8ToSqueak"
	
	| len bytes |
	len := self decodeLengthField.
	bytes := ByteArray new: len.
	1 to: len do: [ :i |
		bytes at: i put: (method at: method size - size + i) ].
	data := (ZipReadStream on: bytes) contents asString convertFromEncoding: 'utf8'! !

!CompiledMethodTrailer methodsFor: 'accessing' stamp: 'Igor.Stasenko 12/13/2009 15:50'!
endPC
	"Answer the index of the last bytecode."
	
	method ifNil: [ self error: 'Cannot determine the endPC without compiled method' ].
	
	"if method set, then size should be set as well"
	^ method size - size! !

!CompiledMethodTrailer methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/5/2010 13:49'!
platformId
	kind = #NativeCodeTrailer ifFalse: [ ^ nil ].
	^ data at: 1
! !

!CompiledMethodTrailer methodsFor: 'initialization' stamp: 'Igor.Stasenko 12/13/2009 11:51'!
initialize
	self clear! !

!CompiledMethodTrailer methodsFor: 'decoding' stamp: 'Igor.Stasenko 12/13/2009 11:25'!
decodeSourcePointer

	"Trailer is a source pointer"
	| msz |
	
	size := 4.
	msz := method size.
	data := (method at: msz) - 251 << 8 + (method at: msz-1) << 8
	 + (method at: msz-2) << 8 + (method at: msz-3).
	
! !

!CompiledMethodTrailer methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/9/2010 00:29'!
nativeCode: aByteArray platformId: aPlatformCode sourcePointer: srcPtr
	"Embed the native code into compiled method trailer.
	The resulting trailer format is following:
	<native code
	....
	>
	<code offset - 2 bytes (also equals to trailer size)>
	<platform id code - 2 bytes>
	<trailer byte>	
	"
	self clear.
	kind := #NativeCodeTrailer.
	data := Array with: aPlatformCode with: aByteArray with: srcPtr.
	self encode.
! !

!CompiledMethodTrailer methodsFor: 'accessing' stamp: 'Igor.Stasenko 12/13/2009 19:15'!
kind
	"Answer a symbolic name of trailer kind.
	See #trailerKinds on class side and class comment for details"
	
	^ kind! !

!CompiledMethodTrailer methodsFor: '*Compression-Streams' stamp: 'jannik.laval 5/1/2010 16:05'!
encodeUsingZip

	"data is string, encode it using gzip compression"
	| utf8str stream length encodedLength |

	[data isString] assert.
	utf8str := data convertToEncoding: 'utf8'.
	
	stream := ((ZipWriteStream on: (ByteArray new: utf8str size))
		nextPutAll: utf8str asByteArray;
		close;
		encodedStream).
		
	length := stream position.
	encodedLength := self encodeLengthField: length.

	stream nextPutAll: encodedLength.
	"trailing byte"
	stream nextPut: (self kindAsByte + encodedLength size - 1).
	
	encodedData := stream contents
	! !

!CompiledMethodTrailer methodsFor: 'accessing' stamp: 'Igor.Stasenko 12/13/2009 21:03'!
sourceIdentifier
	"Trailer is used to indicate that method's source code can be retrieved by 
	sending #getSourceCodeByIdentifier: message to method's class" 

	^ (kind == #SourceByStringIdentifier) ifTrue: [ data ] ifFalse: [ nil ].

! !

!CompiledMethodTrailer methodsFor: 'testing' stamp: 'Igor.Stasenko 12/13/2009 16:54'!
isEmpty
	^ kind == #NoTrailer or: [ kind == #ClearedTrailer ]! !

!CompiledMethodTrailer methodsFor: 'decoding' stamp: 'Igor.Stasenko 12/13/2009 15:31'!
decodeClearedTrailer
	"Size is set in #decodeLengthField"

	self decodeLengthField.
! !

!CompiledMethodTrailer methodsFor: 'decoding' stamp: 'MarcusDenker 10/18/2014 09:35'!
decodeNoTrailer
	"Not much to decode here"
	size := 4. ! !

!CompiledMethodTrailer methodsFor: 'encoding' stamp: 'StephaneDucasse 2/3/2010 22:12'!
encodeSourcePointer

	encodedData := ByteArray new: 4.
	encodedData at: 4 put: (data >> 24) + 251.
	1 to: 3 do: [:i |
		encodedData at: 4-i put: ((data bitShift: (i-3)*8) bitAnd: 16rFF)]! !

!CompiledMethodTrailer methodsFor: 'encoding' stamp: 'Igor.Stasenko 12/13/2009 15:16'!
encodeClearedTrailer

	"A cleared trailer is replaced by #NoTrailer, when used for encoding"
	self clear.
	kind := #NoTrailer.
	
	^ self encode! !

!CompiledMethodTrailer methodsFor: 'private' stamp: 'jannik.laval 5/1/2010 16:07'!
kindAsByte
	| index |
	index := self class trailerKinds indexOf: kind.
	[index ~~ 0] assert.

	^ (index - 1) << 2! !

!CompiledMethodTrailer methodsFor: 'testing' stamp: 'Igor.Stasenko 4/11/2010 13:15'!
hasSourcePointer
	^  kind == #SourcePointer or: [ kind == #VarLengthSourcePointer or: [ kind == #NativeCodeTrailer ] ] ! !

!CompiledMethodTrailer methodsFor: 'decoding' stamp: 'Igor.Stasenko 12/13/2009 15:57'!
decodeEmbeddedSourceQCompress

	"data is string with method's source code, encoded using qCompress method"
	self qDecompress.! !

!CompiledMethodTrailer methodsFor: 'encoding' stamp: 'Igor.Stasenko 12/13/2009 14:38'!
encodeUndefined

	self error: 'use of an undefined kind of trailer encoding'! !

!CompiledMethodTrailer methodsFor: 'accessing' stamp: 'Igor.Stasenko 12/13/2009 21:03'!
sourceIdentifier: aString

	"Trailer is used to indicate that method's source code can be retrieved by 
	sending #getSourceCodeByIdentifier: message to method's class" 
	
	self clear.
	data := aString.
	kind := #SourceByStringIdentifier.
	self encode.
! !

!CompiledMethodTrailer methodsFor: '*Compression-Streams' stamp: 'Igor.Stasenko 12/13/2009 16:33'!
decodeEmbeddedSourceZip

	"data is string with method's source code, compressed using zip compression"
	self decodeZip.! !

!CompiledMethodTrailer methodsFor: 'initialization' stamp: 'MarcusDenker 10/20/2014 17:15'!
method: aMethod

	| flagByte |

	data := size := nil.
	method := aMethod.
	flagByte := method at: (method size).

	"trailer kind encoded in 6 high bits of last byte"
	kind := self class trailerKinds at: 1+(flagByte>>2).

	"decode the trailer bytes, inline some common types to speed up decoding"
	kind == #SourcePointer
		ifTrue: [ self decodeSourcePointer ]
	ifFalse: [ kind == #VarLengthSourcePointer
		ifTrue: [ self decodeVarLengthSourcePointer ]
	ifFalse: [ kind == #NoTrailer
			ifTrue: [ self decodeNoTrailer ]
	ifFalse: [ 
		"slow but general decoding using perform"
		self perform: ('decode' , kind) asSymbol ]]].
! !

!CompiledMethodTrailer methodsFor: 'encoding' stamp: 'MarcusDenker 10/20/2014 17:08'!
encodeSourceBySelector
	"A method source is determined by a class + selector where it is installed to"
	encodedData := ByteArray with: self kindAsByte.
	size := 1.! !

!CompiledMethodTrailer methodsFor: '*Compression-Streams' stamp: 'Igor.Stasenko 12/13/2009 14:29'!
encodeEmbeddedSourceZip

	"data is string with method's source code, encode it using Zip compression method"
	self encodeUsingZip
! !

!CompiledMethodTrailer methodsFor: 'decoding' stamp: 'Igor.Stasenko 12/20/2009 21:33'!
qDecompress 
	"Trailer is compressed string using qCompress method + length field + 1 byte
	
	Decompress strings compressed by qCompress:.
	Most common 11 chars get values 0-10 packed in one 4-bit nibble;
	next most common 52 get values 12-15 (2 bits) * 16 plus next nibble;
	escaped chars get three nibbles"
	| len str input |
	
	len := self decodeLengthField.
 	input := (ReadStream on: method from: method size - size+1 to: method size - size + len).
	
	str := String streamContents:
		[:strm | | nextNibble nibble peek charTable |
		charTable :=  "Character encoding table must match qCompress:"
		'ear tonsilcmbdfghjkpquvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ012345[]()'.
		peek := true.
		nextNibble := [peek
						ifTrue: [peek := false. input peek ifNil: [0] ifNotNil: [:b| b // 16]]
						ifFalse: [peek := true. input next ifNil: [0] ifNotNil: [:b| b \\ 16]]].
		[input atEnd] whileFalse:
			[(nibble := nextNibble value) = 0
				ifTrue: [input atEnd ifFalse:
						[strm nextPut: (Character value: nextNibble value * 16 + nextNibble value)]]
				ifFalse:
					[nibble <= 11
						ifTrue:
							[strm nextPut: (charTable at: nibble)]
						ifFalse:
							[strm nextPut: (charTable at: nibble-12 * 16 + nextNibble value)]]]].
			
	data := str convertFromEncoding: 'utf8'! !

!CompiledMethodTrailer methodsFor: 'creating a method' stamp: 'IgorStasenko 5/24/2010 21:35'!
createMethod: numberOfBytesForAllButTrailer header: headerWord methodClass: aCompiledMethodClass
	| meth |
	encodedData ifNil: [ self encode ].
	meth := aCompiledMethodClass newMethod: numberOfBytesForAllButTrailer + size header: headerWord.
	"copy the encoded trailer data"
	1 to: size do:
		[:i | meth at: meth size - size + i put: (encodedData at: i)].
	^ meth! !

!CompiledMethodTrailer methodsFor: 'testing' stamp: 'MarcusDenker 4/29/2012 09:51'!
hasSource
	^ kind == #EmbeddedSourceQCompress or: [ kind == #EmbeddedSourceZip ]! !

!CompiledMethodTrailer methodsFor: 'decoding' stamp: 'Igor.Stasenko 4/9/2010 00:27'!
decodeNativeCodeTrailer
	| bytes platformId msz pos shift srcPtr |
	
	msz := method size.
	platformId := (method at: msz - 1) + ((method at: msz - 2)<<8).
	size := 	(method at: msz - 3) + ((method at: msz - 4)<<8).
		
	pos := method size-5.
	shift := srcPtr := 0.
	
	[ | value | 
		value := method at: pos.
		srcPtr := (value bitAnd: 16r7F) << shift + srcPtr.
		pos := pos - 1.
		shift := shift + 7.
		value > 127 ] whileTrue.

	bytes := ByteArray new: size - (msz - pos).
	
	1 to: bytes size do: [:i | bytes at: i put: (method at: msz-size+i) ].
	
	data := Array with: platformId with: bytes with: srcPtr.
	! !

!CompiledMethodTrailer methodsFor: 'encoding' stamp: 'jannik.laval 5/1/2010 16:05'!
encodeSourceByStringIdentifier
	"A method source is determined by a class + string identifier"
	
	[data isString] assert.
	encodedData := ByteArray streamContents: [:str | | utf8str len |
		utf8str := (data convertToEncoding: 'utf8') asByteArray.
		str nextPutAll: utf8str.
		len := self encodeLengthField: utf8str size.
		str nextPutAll: len.
		str nextPut: self kindAsByte + (len size -1)]! !

!CompiledMethodTrailer methodsFor: 'encoding' stamp: 'IgorStasenko 5/10/2011 13:21'!
encodeVarLengthSourcePointer

	"source pointer must be >=0"
	[data >= 0] assert.
	
	encodedData := 
		data = 0 ifTrue: [ #[0] ] 
		ifFalse: [ ByteArray streamContents: [:str |
		| value |
		value := data.
		[value > 0] whileTrue: [
			value > 127 ifTrue: [ str nextPut: 128 + (value bitAnd: 16r7F) ]
				ifFalse: [ str nextPut: value. ].
			value := value >> 7.
			].
		]].
	encodedData := encodedData reversed copyWith: (self kindAsByte)! !

!CompiledMethodTrailer methodsFor: 'encoding' stamp: 'Igor.Stasenko 12/13/2009 14:29'!
encodeEmbeddedSourceQCompress

	"data is string with method's source code, encode it using qCompress method"
	self encodeUsingQCompress
! !

!CompiledMethodTrailer methodsFor: 'decoding' stamp: 'Igor.Stasenko 12/13/2009 16:35'!
decodeSourceBySelector

	"no data, size = 1"
	
	size := 1.! !

!CompiledMethodTrailer methodsFor: 'decoding' stamp: 'Igor.Stasenko 12/13/2009 16:34'!
decodeUndefined
	self error: 'undefined method encoding'! !

!CompiledMethodTrailer methodsFor: 'accessing' stamp: 'Igor.Stasenko 12/13/2009 21:47'!
sourceCode
	"Answer the source code of compiled method.
	Note: it does not attempts to read from source files using sourcePointer,
	nor reconstruct the source code using temp names"
	
	(kind == #EmbeddedSourceQCompress or: [ kind == #EmbeddedSourceZip ]) ifTrue: [
		^ data ].
	
	kind == #SourceBySelector ifTrue: [
		^ method methodClass getSourceCodeBySelector: method selector ].
	
	kind == #SourceByStringIdentifier ifTrue: [
		^ method methodClass getSourceCodeByIdentifier: data ].

	^ nil! !

!CompiledMethodTrailer methodsFor: 'encoding' stamp: 'jannik.laval 5/1/2010 16:05'!
encodeUsingQCompress

	"data is string, encode it using qCompress method"
	| str length encodedLength |

	[data isString] assert.
	str := self qCompress: data.
	length := str position.
	encodedLength := self encodeLengthField: length.

	str nextPutAll: encodedLength.
	"trailing byte"
	str nextPut: (self kindAsByte + encodedLength size - 1).
	
	encodedData := str contents
	! !

!CompiledMethodTrailer methodsFor: 'initialization' stamp: 'MarcusDenker 10/20/2014 17:10'!
clear
	kind := #NoTrailer.
	size := 4.
	data := encodedData := method := nil! !

!CompiledMethodTrailer methodsFor: 'accessing' stamp: 'Igor.Stasenko 12/13/2009 16:45'!
size
	"Answer the size of method's trailer , in bytes"
	^ size! !

!CompiledMethodTrailer methodsFor: 'encoding' stamp: 'jannik.laval 5/1/2010 16:04'!
encode

	encodedData := nil.
	
	"encode the trailer into byte array"
	self perform: ('encode' , kind) asSymbol.

	[encodedData notNil and: [encodedData size > 0 ]] assert.
	
	"set the size"
	size := encodedData size.! !

!CompiledMethodTrailer methodsFor: 'encoding' stamp: 'Igor.Stasenko 12/13/2009 15:02'!
encodeExtendedKind

	"reserved for future use"
	self error: 'Not yet implemented'.
! !

!CompiledMethodTrailer methodsFor: 'accessing' stamp: 'Igor.Stasenko 12/22/2009 22:23'!
sourceCode: aString
	"Embed the source code into compiled method trailer, 
	pick best compression method"
	| temp |
	self clear.
	kind := #EmbeddedSourceQCompress.
	data := aString asString. "add Text support in future?"
	
	self encode.
	temp := encodedData.

	kind := #EmbeddedSourceZip.
	self encode.
	encodedData size > temp size ifTrue: [
		encodedData := temp.
		kind := #EmbeddedSourceQCompress.
		size := encodedData size.
		]! !

!CompiledMethodTrailer methodsFor: 'encoding' stamp: 'Igor.Stasenko 4/9/2010 00:22'!
encodeNativeCodeTrailer
" encode trailer in a form:
 <native code>
<variable length source pointer>
<trailer size>
<platform id>
<kind byte>
"
	| bytes platformId sourcePointer ptrBytes |
	platformId := data at: 1.
	bytes := data at: 2.
	sourcePointer := data at: 3.
	
	ptrBytes := ByteArray streamContents: [:str |
		| value |
		value := sourcePointer.
		[value > 0] whileTrue: [
			value > 127 ifTrue: [ str nextPut: 128 + (value bitAnd: 16r7F) ]
				ifFalse: [ str nextPut: value. ].
			value := value >> 7.
			].
		].
	ptrBytes := ptrBytes reversed.
	
	size := bytes size + ptrBytes size + 2 + 2 + 1.
	self assert: (size < 65536).
	self assert: (platformId < 65536).
	
	encodedData := ByteArray streamContents: [:str |
		str nextPutAll: bytes;
		nextPutAll: ptrBytes;
		nextPut: (size >> 8);
		nextPut: (size bitAnd: 255);
		nextPut: (platformId >> 8);
		nextPut: (platformId bitAnd: 255);
		nextPut: self kindAsByte ].
	
! !

!CompiledMethodTrailer methodsFor: 'private' stamp: 'nice 1/5/2010 15:59'!
qCompress: string
	"A very simple text compression routine designed for method temp names.
	 Most common 11 chars get values 1-11 packed in one 4-bit nibble;
	 the next most common get values 12-15 (2 bits) * 16 plus next nibble;
	 unusual ones get three nibbles, the first being the escape nibble 0.

	Answer the write stream with compressed data inside"

	| utf8str stream oddNibble |

	string isEmpty ifTrue:
		[^self qCompress: ' '].
	utf8str := string convertToEncoding: 'utf8'.

	stream := WriteStream on: (ByteArray new: utf8str size).
	oddNibble := nil.

	utf8str do:	[:char | | ix |
		ix := 'ear tonsilcmbdfghjkpquvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ012345[]()'
			indexOf: char ifAbsent: 0.
		(ix = 0
			ifTrue:
				[{ 0. char asInteger // 16. char asInteger \\ 16 }]
			ifFalse:
				[ix <= 11
					ifTrue: [{ ix }]
					ifFalse: [{ ix//16+12. ix\\16 }]])
				do: [:nibble |
					oddNibble
						ifNotNil: [stream nextPut: oddNibble*16 + nibble. oddNibble := nil]
						ifNil: [oddNibble := nibble]]].
	oddNibble ifNotNil: "4 = 'ear tonsil' indexOf: Character space"
		[stream nextPut: oddNibble * 16 + 4].
	^ stream
! !

!CompiledMethodTrailer methodsFor: 'accessing' stamp: 'MarcusDenker 10/20/2014 17:15'!
setSourceBySelector

	"Trailer is used to indicate that method's source code can be retrieved by 
	sending #getSourceCodeBySelector: message to method's class" 
	
	self clear.
	kind := #SourceBySelector.
	self encode.! !

!CompiledMethodTrailer methodsFor: 'accessing' stamp: 'Igor.Stasenko 12/13/2009 11:39'!
sourcePointer: ptr

	self clear.
	data := ptr.
	"see if we can encode pointer using 4-byte trailer"
	kind := (ptr between: 16r1000000 and: 16r4FFFFFF) 
		ifTrue: [ #SourcePointer ] ifFalse: [ #VarLengthSourcePointer ].
	! !

!CompiledMethodTrailer methodsFor: 'encoding' stamp: 'MarcusDenker 10/20/2014 17:05'!
encodeNoTrailer

	"When creating methods with no trailer, male them, 4 bytes long so that we can update them to sourcePointers 
	without having to use #become:"

	size := 4.
	encodedData := #[0 0 0 0].! !

!CompiledMethodTrailer methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/5/2010 13:48'!
nativeCode
	kind = #NativeCodeTrailer ifFalse: [ ^ nil ].
	^ data at: 2
! !

!CompiledMethodTrailer methodsFor: 'testing' stamp: 'Igor.Stasenko 12/13/2009 20:12'!
testEncoding

	"Since we are using basic protocol (#at:, #at:put: , #size) for accessing compiled method data,
	we can pass the ByteArray instance into #method: accessor and check if encoding/decoding 
	operations	is symmetrical.
	Use this method only for unit-testing purposes"
	
	encodedData ifNil: [ self encode ].
	^ CompiledMethodTrailer new method: encodedData! !

!CompiledMethodTrailer methodsFor: 'decoding' stamp: 'Igor.Stasenko 12/13/2009 19:34'!
decodeVarLengthSourcePointer

	| pos shift |
	
	pos := method size-1.
	shift := data := 0.
	
	[ | value | 
		value := method at: pos.
		data := (value bitAnd: 16r7F) << shift + data.
		pos := pos - 1.
		shift := shift + 7.
		value > 127 ] whileTrue.

	size := method size - pos.! !

!CompiledMethodTrailer methodsFor: 'creating a method' stamp: 'eem 9/13/2011 15:14'!
createMethod: numberOfBytesForAllButTrailer class: aCompiledMethodClass header: headerWord 
	| meth |
	encodedData ifNil: [self encode].
	
	meth := aCompiledMethodClass newMethod: numberOfBytesForAllButTrailer + size header: headerWord.
	"copy the encoded trailer data"
	1 to: size do:
		[:i | meth at: meth size - size + i put: (encodedData at: i)].

	^meth! !

!CompiledMethodTrailer methodsFor: 'private' stamp: 'Igor.Stasenko 12/13/2009 15:29'!
decodeLengthField

	"used in various encodings, where length field is preceeding the last trailer byte.
	Two least significant bits in last byte denoting the number of bytes for length field"
	
	| numBytes pos length |

	pos := method size.
	numBytes := ((method at: pos) bitAnd: 3) + 1.
	
	length := 0.
	1 to: numBytes do: [:i |
		length := length << 8 + (method at: pos - i ).
		].
	size := 1 + numBytes + length.
	
	^ length! !

!CompiledMethodTrailer methodsFor: 'encoding' stamp: 'Igor.Stasenko 12/13/2009 14:30'!
decodeExtendedKind

	"reserved for future use"
	self shouldBeImplemented.
! !

!CompiledMethodTrailer class methodsFor: 'kinds' stamp: 'Igor.Stasenko 4/5/2010 13:15'!
trailerKinds
	" see class comment for description. If you change this method, evaluate this:
	self generateTrailerKindDecoders"
	
	^#(
"000000" #NoTrailer
"000001" #ClearedTrailer
"000010" #TempsNamesQCompress
"000011" #TempsNamesZip
"000100" #SourceBySelector
"000101" #SourceByStringIdentifier
"000110" #EmbeddedSourceQCompress
"000111" #EmbeddedSourceZip
"001000" #VarLengthSourcePointer
"001001" #ExtendedKind
"001010" #NativeCodeTrailer  "this number is hardcoded in VM"
"001011" #Undefined
"001100" #Undefined
"001101" #Undefined
"001110" #Undefined
"001111" #Undefined
"010000" #Undefined
"010001" #Undefined
"010010" #Undefined
"010011" #Undefined
"010100" #Undefined
"010101" #Undefined
"010110" #Undefined
"010111" #Undefined
"011000" #Undefined
"011001" #Undefined
"011010" #Undefined
"011011" #Undefined
"011100" #Undefined
"011101" #Undefined
"011110" #Undefined
"011111" #Undefined
"100000" #Undefined
"100001" #Undefined
"100010" #Undefined
"100011" #Undefined
"100100" #Undefined
"100101" #Undefined
"100110" #Undefined
"100111" #Undefined
"101000" #Undefined
"101001" #Undefined
"101010" #Undefined
"101011" #Undefined
"101100" #Undefined
"101101" #Undefined
"101110" #Undefined
"101111" #Undefined
"110000" #Undefined
"110001" #Undefined
"110010" #Undefined
"110011" #Undefined
"110100" #Undefined
"110101" #Undefined
"110110" #Undefined
"110111" #Undefined
"111000" #Undefined
"111001" #Undefined
"111010" #Undefined
"111011" #Undefined
"111100" #Undefined
"111101" #Undefined
"111110" #Undefined
"111111" #SourcePointer
	)! !

!CompiledMethodTrailer class methodsFor: 'kinds' stamp: 'Igor.Stasenko 12/14/2009 10:08'!
empty
	"answer the empty trailer"
	^ self new! !

!CompiledMethodTrailer class methodsFor: 'generated' stamp: 'Igor.Stasenko 4/5/2010 13:15'!
trailerKindDecoders

	^#(#decodeNoTrailer #decodeClearedTrailer #decodeTempsNamesQCompress #decodeTempsNamesZip #decodeSourceBySelector #decodeSourceByStringIdentifier #decodeEmbeddedSourceQCompress #decodeEmbeddedSourceZip #decodeVarLengthSourcePointer #decodeExtendedKind #decodeNativeCodeTrailer #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeSourcePointer)! !

!CompiledMethodTrailerTest commentStamp: 'TorstenBergmann 2/5/2014 08:32'!
SUnit tests for CompiledMethodTrailer!
!CompiledMethodTrailerTest methodsFor: 'tests' stamp: 'Igor.Stasenko 12/13/2009 21:13'!
testEmbeddingSourceCode

	| trailer newTrailer code |
	
	trailer := CompiledMethodTrailer new.
	
	code := 'foo'.
	trailer sourceCode: code.
	newTrailer := trailer testEncoding.
	
	self assert: (trailer kind == #EmbeddedSourceQCompress ).
	self assert: (newTrailer sourceCode = code).

	"the last bytecode index must be at 0"
	self assert: (newTrailer endPC = 0).

	code := 'testEmbeddingSourceCode

	| trailer newTrailer code |
	
	trailer := CompiledMethodTrailer new.
	
	trailer sourceCode: code.
	newTrailer := trailer testEncoding.
	
	self assert: (newTrailer sourceCode = code).'.

	trailer sourceCode: code.
	self assert: (trailer kind == #EmbeddedSourceZip ).
	newTrailer := trailer testEncoding.
	
	self assert: (newTrailer sourceCode = code).
	"the last bytecode index must be at 0"
	self assert: (newTrailer endPC = 0).
! !

!CompiledMethodTrailerTest methodsFor: 'tests' stamp: 'MarcusDenker 10/20/2014 17:09'!
testEncodingNoTrailer

	| trailer |
	
	trailer := CompiledMethodTrailer new.
	
	"by default it should be a no-trailer, 4 byte wide so it can be used to store a sourcePointer"	
	self assert: (trailer kind == #NoTrailer ).
	self assert: (trailer size = 4).
	
	trailer := trailer testEncoding.
	
	self assert: (trailer kind == #NoTrailer ).
	self assert: (trailer size = 4).
	"the last bytecode index must be at 0"
	self assert: (trailer endPC = 0).
! !

!CompiledMethodTrailerTest methodsFor: 'tests' stamp: 'Igor.Stasenko 12/13/2009 21:49'!
testSourceBySelectorEncoding

	| trailer |
	
	trailer := CompiledMethodTrailer new.
	
	trailer setSourceBySelector.
	
	self assert: (trailer kind == #SourceBySelector ).
	self assert: (trailer size = 1).
	
	trailer := trailer testEncoding.
	
	self assert: (trailer kind == #SourceBySelector ).
	self assert: (trailer size = 1).
	"the last bytecode index must be at 0"
	self assert: (trailer endPC = 0).
! !

!CompiledMethodTrailerTest methodsFor: 'tests' stamp: 'Igor.Stasenko 12/13/2009 21:14'!
testEncodingSourcePointer

	| trailer |
	
	trailer := CompiledMethodTrailer new.
	
	CompiledMethod allInstancesDo: [:method | | ptr |
		trailer method: method.
		self assert: ( (ptr := method sourcePointer) == trailer sourcePointer).
		"the last bytecode index must be at 0"
		ptr ~= 0 ifTrue: [
			self assert: (method endPC = trailer endPC) ].
	 ].! !

!CompiledMethodTrailerTest methodsFor: 'tests' stamp: 'IgorStasenko 5/10/2011 13:33'!
testEncodingZeroSourcePointer

	| trailer |
	
	trailer := CompiledMethodTrailer new.

	self assert: 
		(trailer sourcePointer: 0) testEncoding sourcePointer = 0
	! !

!CompiledMethodTrailerTest methodsFor: 'tests' stamp: 'PavelKrivanek 11/24/2011 11:30'!
testSourceByIdentifierEncoding

	| trailer id |
	
	trailer := CompiledMethodTrailer new.
	
	id := 'e51b3b55-d5aa-48fa-a008-e674dbdd4abe'.
	trailer sourceIdentifier: id.
	
	self assert: (trailer kind == #SourceByStringIdentifier ).
	
	trailer := trailer testEncoding.
	
	self assert: (trailer kind == #SourceByStringIdentifier ).
	self assert: (trailer sourceIdentifier = id).
	"the last bytecode index must be at 0"
	self assert: (trailer endPC = 0).
! !

!CompiledMethodTrailerTest methodsFor: 'tests' stamp: 'Igor.Stasenko 12/13/2009 21:15'!
testEncodingVarLengthSourcePointer

	| trailer newTrailer |
	
	trailer := CompiledMethodTrailer new.
	
	trailer sourcePointer: 1.
	newTrailer := trailer testEncoding.
	
	self assert: (newTrailer sourcePointer = 1).
	
	trailer sourcePointer: 16r100000000000000.
	newTrailer := trailer testEncoding.
	self assert: (newTrailer sourcePointer = 16r100000000000000).
	"the last bytecode index must be at 0"
	self assert: (newTrailer endPC = 0).
! !

!Compiler commentStamp: '<historical>'!
The compiler accepts Smalltalk source code and compiles it with respect to a given class. The user of the compiler supplies a context so that temporary variables are accessible during compilation. If there is an error, a requestor (usually a kind of StringHolderController) is sent the message notify:at:in: so that the error message can be displayed. If there is no error, then the result of compilation is a MethodNode, which is the root of a parse tree whose nodes are kinds of ParseNodes. The parse tree can be sent messages to (1) generate code for a CompiledMethod (this is done for compiling methods or evaluating expressions); (2) pretty-print the code (for formatting); or (3) produce a map from object code back to source code (used by debugger program-counter selection). See also Parser, Encoder, ParseNode.!
!Compiler methodsFor: 'public - old' stamp: 'CamilloBruni 8/1/2012 16:05'!
evaluate: aString in: aContext to: aReceiver
	"evaluate aString in the given context, and return the result."
	| result |
	result := self
				evaluate: aString
				in: aContext
				to: aReceiver
				notifying: nil
				ifFail: [^ #failedDoit].
	^ result! !

!Compiler methodsFor: 'public access' stamp: 'ClementBera 6/7/2013 10:24'!
translate
	"once we will have change all the sender of MethodNode>>#generate: to use compile, we can remove the methodNode encoder requestor: requestor."
	| methodNode |
	methodNode := self parser
		parse: sourceStream
		class: class
		category: category
		noPattern: self compilationContext noPattern
		context: context
		notifying: requestor
		ifFail: [^ self compilationContext failBlock value].
	methodNode encoder requestor: requestor.
	^ methodNode! !

!Compiler methodsFor: 'public - opal compatibility' stamp: 'ClementBera 6/7/2013 09:58'!
compiledMethodTrailer: bytes
	self compilationContext compiledMethodTrailer: bytes! !

!Compiler methodsFor: 'public - decompiler' stamp: 'MarcusDenker 9/29/2014 14:23'!
decompileMethod: aCompiledMethod
	^Decompiler decompile: aCompiledMethod
! !

!Compiler methodsFor: 'public - opal compatibility' stamp: 'ClementBera 6/7/2013 10:15'!
logged: aBoolean
	self compilationContext logged:  aBoolean.! !

!Compiler methodsFor: 'public - old' stamp: 'vb 8/13/2001 23:11'!
compileNoPattern: textOrStream in: aClass context: aContext notifying: aRequestor ifFail: failBlock
	"Similar to #compile:in:notifying:ifFail:, but the compiled code is
	expected to be a do-it expression, with no message pattern."

	self from: textOrStream
		class: aClass
		context: aContext
		notifying: aRequestor.
	^self
		translate: sourceStream
		noPattern: true
		ifFail: failBlock! !

!Compiler methodsFor: 'error handling' stamp: 'CamilloBruni 2/9/2012 12:07'!
notify: aString at: location
	"Refer to the comment in Object|notify:."

	^requestor == nil
		ifTrue: [SyntaxErrorNotification
					inClass: class
					category: category
					withCode: sourceStream contents
					doitFlag: false
					errorMessage: aString
					location: location]
		ifFalse: [requestor
					notify: aString
					at: location
					in: sourceStream]! !

!Compiler methodsFor: 'public - old' stamp: 'MarcusDenker 5/10/2013 12:53'!
format: textOrStream in: aClass notifying: aRequestor
	"Compile a parse tree from the argument, textOrStream. Answer a string containing the original code, formatted nicely.  If aBoolean is true, then decorate the resulting text with color and hypertext actions"
	| aNode |
	self from: textOrStream
		class: aClass
		context: nil
		notifying: aRequestor.
	aNode := self format: sourceStream noPattern: false ifFail: [^ nil].
	^ aNode formattedCode.! !

!Compiler methodsFor: 'public access' stamp: 'ClementBera 6/7/2013 10:56'!
compile
	| methodNode |
	methodNode := self compile: sourceStream in: class classified: category notifying: requestor ifFail: self compilationContext failBlock.
	^ methodNode generate: self compilationContext compiledMethodTrailer  ! !

!Compiler methodsFor: 'public - old' stamp: 'MarcusDenker 4/30/2013 10:36'!
evaluate: textOrString logged: logFlag 
	"See Compiler|evaluate:for:notifying:logged:. If a compilation error occurs, 
	a Syntax Error view is created rather than notifying any requestor. 
	Compilation is carried out with respect to nil, i.e., no object."

	^self evaluate: textOrString for: nil logged: logFlag! !

!Compiler methodsFor: 'public - old' stamp: 'MarcusDenker 4/30/2013 10:37'!
evaluate: textOrString notifying: aController logged: logFlag 
	"See Compiler|evaluate:for:notifying:logged:. Compilation is carried out 
	with respect to nil, i.e., no object."

	^self evaluate: textOrString for: nil notifying: aController logged: logFlag! !

!Compiler methodsFor: 'private' stamp: 'marcus.denker 8/17/2008 21:14'!
from: textOrStream class: aClass classified: aCategory context: aContext notifying: req

	self from: textOrStream class: aClass context: aContext notifying: req.
	category  := aCategory
! !

!Compiler methodsFor: 'public - old' stamp: 'MarcusDenker 4/28/2013 21:50'!
parse: aString class: aClass

	^self parser
		parse: aString class: aClass! !

!Compiler methodsFor: 'public access' stamp: 'ClementBera 5/22/2013 16:04'!
options: anArray
	"This is used for compatibility with Opal"
	self compilationContext compilerOptions: anArray! !

!Compiler methodsFor: 'public access' stamp: 'ClementBera 6/7/2013 11:11'!
evaluate: textOrString 
	"See Compiler|evaluate:for:notifying:logged:. If a compilation error occurs, 
	a Syntax Error view is created rather than notifying any requestor. 
	Compilation is carried out with respect to nil, i.e., no object, and the 
	invocation is not logged."

	^self evaluate: textOrString in: context to: receiver notifying: requestor ifFail: self compilationContext failBlock logged: self compilationContext logged! !

!Compiler methodsFor: 'public - opal compatibility' stamp: 'ClementBera 5/22/2013 16:04'!
environment: anEnvironment
	"This is used for compatibility with Opal"
	self compilationContext environment: anEnvironment! !

!Compiler methodsFor: 'public - old' stamp: 'ClementBera 6/28/2013 10:32'!
evaluate: textOrStream in: aContext to: aReceiver notifying: aRequestor ifFail: failBlock
	^ self evaluate: textOrStream in: aContext to: aReceiver notifying: aRequestor ifFail: failBlock logged: false.! !

!Compiler methodsFor: 'private' stamp: 'eem 5/15/2008 15:11'!
translate: aStream noPattern: noPattern ifFail: failBlock
	^self parser
		parse: aStream
		class: class
		category: category
		noPattern: noPattern
		context: context
		notifying: requestor
		ifFail: [^failBlock value]! !

!Compiler methodsFor: 'public - opal compatibility' stamp: 'ClementBera 6/7/2013 10:04'!
requestor: aRequestor
	requestor := aRequestor.
	self compilationContext requestor: aRequestor.
	self compilationContext interactive: (UIManager default interactiveParserFor: self compilationContext requestor).! !

!Compiler methodsFor: 'private' stamp: 'ClementBera 6/7/2013 10:54'!
parser
	^ parser ifNil: [parser := Parser new]! !

!Compiler methodsFor: 'public - opal compatibility' stamp: 'ClementBera 6/7/2013 10:05'!
failBlock: aBlock
	self compilationContext failBlock: aBlock.! !

!Compiler methodsFor: 'public - opal compatibility' stamp: 'MarcusDenker 5/26/2013 09:42'!
compilationContextClass: aClass
	compilationContextClass := aClass! !

!Compiler methodsFor: 'private' stamp: 'MarcusDenker 4/27/2013 08:48'!
from: textOrStream class: aClass context: aContext notifying: req
	sourceStream := textOrStream readStream.
	class := aClass.
	context := aContext.
	requestor := req! !

!Compiler methodsFor: 'public - old' stamp: 'md 2/28/2006 10:45'!
compile: textOrStream in: aClass notifying: aRequestor ifFail: failBlock 
	^self compile: textOrStream in: aClass classified: nil notifying: aRequestor ifFail: failBlock ! !

!Compiler methodsFor: 'public access' stamp: 'ClementBera 6/7/2013 10:50'!
parse
	^self parse: sourceStream class: class! !

!Compiler methodsFor: 'public - old' stamp: 'eem 5/15/2008 15:11'!
parse: textOrStream in: aClass notifying: req
	"Compile the argument, textOrStream, with respect to the class, aClass, and
	 answer the MethodNode that is the root of the resulting parse tree.  Notify the
	 argument, req, if an error occurs. The failBlock is defaulted to an empty block."

	self from: textOrStream class: aClass context: nil notifying: req.
	^self parser
		parse: sourceStream
		class: class
		noPattern: false
		context: context
		notifying: requestor
		ifFail: []! !

!Compiler methodsFor: 'public - old' stamp: 'MarcusDenker 4/28/2013 21:50'!
parse: aString class: aClass noPattern: noPattern context: ctxt notifying: req ifFail: aBlock 

	^self parser
		parse: aString class: aClass noPattern: noPattern context: ctxt notifying: req ifFail: aBlock ! !

!Compiler methodsFor: 'public - opal compatibility' stamp: 'ClementBera 6/7/2013 10:15'!
context: aContext
	context  := aContext! !

!Compiler methodsFor: 'public - opal compatibility' stamp: 'ClementBera 6/7/2013 10:14'!
noPattern: aBoolean
	self compilationContext noPattern: aBoolean.
	! !

!Compiler methodsFor: 'public access' stamp: 'MarcusDenker 5/17/2013 10:44'!
parseLiterals: aString
	^ Scanner new scanTokens: aString! !

!Compiler methodsFor: 'public - old' stamp: 'ClementBera 6/28/2013 10:32'!
evaluate: textOrStream in: aContext to: aReceiver notifying: aRequestor ifFail: failBlock logged: logFlag
	"Compiles the sourceStream into a parse tree, then generates code into
	 a method. If aContext is not nil, the text can refer to temporaries in that
	 context (the Debugger uses this). If aRequestor is not nil, then it will receive
	 a notify:at: message before the attempt to evaluate is aborted. Finally, the 
	 compiled method is invoked from here via withArgs:executeMethod:, hence
	 the system no longer creates Doit method litter on errors."

	| methodNode method value toLog itsSelection itsSelectionString |
	class := aContext == nil ifTrue: [aReceiver class ] ifFalse: [aContext method methodClass].
	self from: textOrStream class: class context: aContext notifying: aRequestor.
	methodNode := self translate: sourceStream noPattern: true ifFail: [^failBlock value].

	method := self interactive
				ifTrue: [methodNode generateWithSource]
				ifFalse: [methodNode generate].

	value := aReceiver
				withArgs: (context ifNil: [#()] ifNotNil: [{context}])
				executeMethod: method.

	logFlag ifTrue:
		[toLog := ((requestor respondsTo: #selection)  
			and:[(itsSelection := requestor selection) notNil
			and:[(itsSelectionString := itsSelection asString) isEmptyOrNil not]])
				ifTrue:[itsSelectionString]
				ifFalse:[sourceStream contents].
		SystemAnnouncer uniqueInstance evaluated: toLog context: aContext].
	^ value! !

!Compiler methodsFor: 'error handling' stamp: ''!
notify: aString 
	"Refer to the comment in Object|notify:."

	^self notify: aString at: sourceStream position + 1! !

!Compiler methodsFor: 'public - opal compatibility' stamp: 'ClementBera 6/7/2013 10:16'!
receiver: anObject
	receiver := anObject! !

!Compiler methodsFor: 'public - opal compatibility' stamp: 'MarcusDenker 5/26/2013 09:37'!
compilationContext
	^ compilationContext ifNil: [  
		compilationContext := self compilationContextClass default
			requestor: requestor;
			class: class;
			category: category ]
			! !

!Compiler methodsFor: 'public access' stamp: 'MarcusDenker 8/28/2013 15:31'!
format: aString
	^ self format: aString in: class notifying: requestor! !

!Compiler methodsFor: 'public access' stamp: 'MarcusDenker 8/28/2013 15:31'!
parse: aString
	^self parse: aString class: class! !

!Compiler methodsFor: 'public - old' stamp: 'MarcusDenker 4/30/2013 10:35'!
evaluate: textOrString for: anObject notifying: aController logged: logFlag
	"Compile and execute the argument, textOrString with respect to the class 
	of anObject. If a compilation error occurs, notify aController. If both 
	compilation and execution are successful then, if logFlag is true, log 
	(write) the text onto a system changes file so that it can be replayed if 
	necessary."

	^ self		evaluate: textOrString
				in: nil
				to: anObject
				notifying: aController
				ifFail: [^nil]
				logged: logFlag.! !

!Compiler methodsFor: 'error handling' stamp: 'pavel.krivanek 11/21/2008 16:50'!
interactive
	
	^ UIManager default interactiveParserFor: requestor! !

!Compiler methodsFor: 'public - opal compatibility' stamp: 'ClementBera 5/22/2013 16:04'!
class: aClass
	"This is used for compatibility with Opal"
	class := aClass.
	self compilationContext class: aClass! !

!Compiler methodsFor: 'public - opal compatibility' stamp: 'MarcusDenker 5/26/2013 09:36'!
compilationContextClass
	^ compilationContextClass ifNil: [ CCompilationContext  ]! !

!Compiler methodsFor: 'private' stamp: 'eem 8/30/2010 17:57'!
format: aStream noPattern: noPattern ifFail: failBlock
	^(self parser
		parse: aStream
		class: class
		noPattern: noPattern
		context: context
		notifying: requestor
		ifFail: [^failBlock value]) preen! !

!Compiler methodsFor: 'public - old' stamp: 'md 2/28/2006 10:04'!
compile: textOrStream in: aClass classified: aCategory notifying: aRequestor ifFail: failBlock 
	"Answer a MethodNode for the argument, textOrStream. If the 
	MethodNode can not be created, notify the argument, aRequestor; if 
	aRequestor is nil, evaluate failBlock instead. The MethodNode is the root 
	of a parse tree. It can be told to generate a CompiledMethod to be 
	installed in the method dictionary of the argument, aClass."
	
	| methodNode |
	self from: textOrStream
		class: aClass
		classified: aCategory 
		context: nil
		notifying: aRequestor.
	methodNode := self translate: sourceStream noPattern: false ifFail: failBlock.
	methodNode encoder requestor: requestor.
	^methodNode.
! !

!Compiler methodsFor: 'public access' stamp: 'ClementBera 6/7/2013 10:25'!
format
	^ self format: sourceStream in: class notifying: requestor! !

!Compiler methodsFor: 'public access' stamp: 'ClementBera 6/7/2013 10:26'!
evaluate
	"See Compiler|evaluate:for:notifying:logged:. If a compilation error occurs, 
	a Syntax Error view is created rather than notifying any requestor. 
	Compilation is carried out with respect to nil, i.e., no object, and the 
	invocation is not logged."

	^self evaluate: sourceStream! !

!Compiler methodsFor: 'public - old' stamp: 'MarcusDenker 4/30/2013 10:36'!
evaluate: textOrString for: anObject logged: logFlag 
	"See Compiler|evaluate:for:notifying:logged:. If a compilation error occurs, 
	a Syntax Error view is created rather than notifying any requestor."

	^self evaluate: textOrString for: anObject notifying: nil logged: logFlag! !

!Compiler methodsFor: 'public - opal compatibility' stamp: 'ClementBera 6/7/2013 10:03'!
source: aString
	sourceStream := aString readStream.! !

!Compiler methodsFor: 'public access' stamp: 'MarcusDenker 4/28/2013 11:04'!
parseSelector: aString 
	"Answer the message selector for the argument, aString, which should 
	 parse successfully up to the temporary declaration or the end of the 
	 method header."
	^self parser parseSelector: aString! !

!Compiler methodsFor: 'public - opal compatibility' stamp: 'ClementBera 6/7/2013 10:04'!
category: aCategory
	category := aCategory.
	self compilationContext category: aCategory.! !

!Compiler class methodsFor: 'evaluating' stamp: ''!
evaluate: textOrString logged: logFlag 
	"See Compiler|evaluate:for:notifying:logged:. If a compilation error occurs, 
	a Syntax Error view is created rather than notifying any requestor. 
	Compilation is carried out with respect to nil, i.e., no object."

	^self evaluate: textOrString for: nil logged: logFlag! !

!Compiler class methodsFor: 'evaluating' stamp: ''!
evaluate: textOrString notifying: aController logged: logFlag 
	"See Compiler|evaluate:for:notifying:logged:. Compilation is carried out 
	with respect to nil, i.e., no object."

	^self evaluate: textOrString for: nil notifying: aController logged: logFlag! !

!Compiler class methodsFor: 'evaluating' stamp: 'NS 1/19/2004 09:50'!
evaluate: textOrString for: anObject notifying: aController logged: logFlag
	"Compile and execute the argument, textOrString with respect to the class 
	of anObject. If a compilation error occurs, notify aController. If both 
	compilation and execution are successful then, if logFlag is true, log 
	(write) the text onto a system changes file so that it can be replayed if 
	necessary."

	^ self new
				evaluate: textOrString
				in: nil
				to: anObject
				notifying: aController
				ifFail: [^nil]
				logged: logFlag.! !

!Compiler class methodsFor: 'utilities' stamp: 'MarcusDenker 10/1/2013 14:20'!
recompileAll
	"Recompile all classes and traits in the system."

	Smalltalk image recompile


! !

!Compiler class methodsFor: 'accessing' stamp: 'MarcusDenker 11/16/2012 13:46'!
debuggerMethodMapForMethod: aMethod
	^ DebuggerMethodMap forMethod: aMethod! !

!Compiler class methodsFor: 'evaluating' stamp: 'NS 1/19/2004 10:07'!
evaluate: textOrString 
	"See Compiler|evaluate:for:notifying:logged:. If a compilation error occurs, 
	a Syntax Error view is created rather than notifying any requestor. 
	Compilation is carried out with respect to nil, i.e., no object, and the 
	invocation is not logged."

	^self evaluate: textOrString for: nil logged: false! !

!Compiler class methodsFor: 'utilities' stamp: 'MarcusDenker 5/1/2013 12:06'!
decompileMethod: aCompiledMethod
	^Decompiler new decompileMethod: aCompiledMethod
! !

!Compiler class methodsFor: 'evaluating' stamp: ''!
evaluate: textOrString for: anObject logged: logFlag 
	"See Compiler|evaluate:for:notifying:logged:. If a compilation error occurs, 
	a Syntax Error view is created rather than notifying any requestor."

	^self evaluate: textOrString for: anObject notifying: nil logged: logFlag! !

!Compiler class methodsFor: 'evaluating' stamp: 'alain.plantec 5/18/2009 15:53'!
format: textOrStream in: aClass notifying: aRequestor
	^self new format: textOrStream in: aClass notifying: aRequestor! !

!ComplexBorder commentStamp: 'MarcusDenker 2/14/2010 22:32'!
see BorderedMorph.

poly := polygon250 

baseColor := Color blue twiceLighter.
border := (ComplexBorder framed: 10) baseColor: poly color.
border frameRectangle: ((100@100 extent: 200@200) insetBy: -5) on: Display getCanvas.
baseColor := Color red twiceLighter.
border := (ComplexBorder framed: 10) baseColor: baseColor.
border drawPolygon: {100@100. 300@100. 300@300. 100@300} on: Display getCanvas.

border drawPolyPatchFrom: 100@200 via: 100@100 via: 200@100 to: 200@200 on: Display getCanvas.
border drawPolyPatchFrom: 100@100 via: 200@100 via: 200@200 to: 100@200 on: Display getCanvas.
border drawPolyPatchFrom: 200@100 via: 200@200 via: 100@200 to: 100@100 on: Display getCanvas.
border drawPolyPatchFrom: 200@200 via: 100@200 via: 100@100 to: 200@100 on: Display getCanvas.

border := (ComplexBorder raised: 10) baseColor: poly color.
border drawPolygon: poly getVertices on: Display getCanvas

360 / 16.0 22.5
points := (0 to: 15) collect:[:i| (Point r: 100 degrees: i*22.5) + 200].
Display getCanvas fillOval: (100@100 extent: 200@200) color: baseColor.
border drawPolygon: points on: Display getCanvas.

-1 to: points size + 1 do:[:i|
	border drawPolyPatchFrom: (points atWrap: i) via: (points atWrap: i+1) via: (points atWrap: i+2) to: (points atWrap: i+3) on: Display getCanvas.
].

Display getCanvas fillOval: (100@100 extent: 200@200) color: baseColor.
0 to: 36 do:[:i|
	border drawLineFrom: (Point r: 100 degrees: i*10) + 200 to: (Point r: 100 degrees: i+1*10) + 200
		on: Display getCanvas.
].
drawPolygon:
Point r: 1.0 degrees: 10
MessageTally spyOn:[
Display deferUpdates: true.
t1 := [1 to: 1000 do:[:i|
	border drawLineFrom: (100@100) to: (300@100) on: Display getCanvas.
	border drawLineFrom: (300@100) to: (300@300) on: Display getCanvas.
	border drawLineFrom: (300@300) to: (100@300) on: Display getCanvas.
	border drawLineFrom: (100@300) to: (100@100) on: Display getCanvas]] timeToRun.
Display deferUpdates: false.
].

MessageTally spyOn:[
Display deferUpdates: true.
t2 := [1 to: 1000 do:[:i|
	border drawLine2From: (100@100) to: (300@100) on: Display getCanvas.
	border drawLine2From: (300@100) to: (300@300) on: Display getCanvas.
	border drawLine2From: (300@300) to: (100@300) on: Display getCanvas.
	border drawLine2From: (100@300) to: (100@100) on: Display getCanvas]] timeToRun.
Display deferUpdates: false.
].

!
!ComplexBorder methodsFor: 'accessing' stamp: 'ar 8/25/2001 16:14'!
widthForRounding
	^0! !

!ComplexBorder methodsFor: 'private' stamp: 'ar 9/4/2001 19:51'!
fillStyleForDirection: direction
	"Fill the given form describing the receiver's look at a particular direction"
	| index fill dir |
	index := direction degrees truncated // 10 + 1.
	lineStyles ifNotNil:[
		fill := lineStyles at: index.
		fill ifNotNil:[^fill].
	].
	dir := Point r: 1.0 degrees: index - 1 * 10 + 5.
	fill := GradientFillStyle colors: (self colorsForDirection: dir).
	fill direction: 0 @ width asPoint y; radial: false.
	fill origin: ((width asPoint x // 2) @ (width asPoint y // 2)) negated.
	fill pixelRamp: (fill computePixelRampOfSize: 16).
	fill isTranslucent. "precompute"
	lineStyles ifNil:[lineStyles := Array new: 37].
	lineStyles at: index put: fill.
	^fill! !

!ComplexBorder methodsFor: 'private' stamp: 'ar 8/25/2001 16:16'!
computeAltFramedColors
	| base light dark w hw colorArray param |
	base := self color asColor.
	light := Color white.
	dark := Color black.
	w := self width isPoint ifTrue:[self width x max: self width y] ifFalse:[self width].
	w := w asInteger.
	w = 1 ifTrue:[^{base mixed: 0.5 with: light. base mixed: 0.5 with: dark}].
	colorArray := Array new: w.
	hw := w // 2.
	"brighten"
	0 to: hw-1 do:[:i|
		param := 0.5 + (i asFloat / hw * 0.5).
		colorArray at: i+1 put: (base mixed: param with: dark). "brighten"
		colorArray at: w-i put: (base mixed: param with: light). "darken"
	].
	w odd ifTrue:[colorArray at: hw+1 put: base].
	^colorArray, colorArray! !

!ComplexBorder methodsFor: 'drawing' stamp: 'aoy 2/17/2003 01:08'!
drawLineFrom: startPoint to: stopPoint on: aCanvas 
	"Here we're using the balloon engine since this is much faster than BitBlt w/ brushes."

	| delta length dir cos sin tfm w h w1 w2 h1 h2 fill |
	width isPoint 
		ifTrue: 
			[w := width x.
			h := width y]
		ifFalse: [w := h := width].
	w1 := w // 2.
	w2 := w - w1.
	h1 := h // 2.
	h2 := h - h1.
	"Compute the rotational transform from (0@0) -> (1@0) to startPoint -> stopPoint"
	delta := stopPoint - startPoint.
	length := delta r.
	dir := length > 1.0e-10 ifTrue: [delta / length] ifFalse: [ 1 @ 0].
	cos := dir dotProduct: 1 @ 0.
	sin := dir crossProduct: 1 @ 0.
	tfm := (MatrixTransform2x3 new)
				a11: cos;
				a12: sin;
				a21: sin negated;
				a22: cos.
	"Install the start point offset"
	tfm offset: startPoint.
	"Now get the fill style appropriate for the given direction"
	fill := self fillStyleForDirection: dir.
	"And draw..."
	aCanvas asBalloonCanvas transformBy: tfm
		during: 
			[:cc | 
			cc drawPolygon: { 
						(0 - w1) @ (0 - h1).	"top left"
						(length + w2) @ (0 - h1).	"top right"
						(length + w2) @ h2.	"bottom right"
						(0 - w1) @ h2	"bottom left"}
				fillStyle: fill]! !

!ComplexBorder methodsFor: 'private' stamp: 'aoy 2/17/2003 01:03'!
computeAltInsetColors
	| base light dark w colorArray param hw |
	base := self color asColor.
	light := Color white.
	dark := Color black.
	w := self width isPoint 
				ifTrue: [self width x max: self width y]
				ifFalse: [self width].
	w := w asInteger.
	colorArray := Array new: w * 2.
	hw := 0.5 / w.
	0 to: w - 1
		do: 
			[:i | 
			param := false 
						ifTrue: 
							["whats this ???!! false ifTrue:[]"

							0.5 + (hw * i)]
						ifFalse: [0.5 + (hw * (w - i))].
			colorArray at: i + 1 put: (base mixed: param with: dark).	"darken"
			colorArray at: colorArray size - i put: (base mixed: param with: light)	"brighten"].
	^colorArray! !

!ComplexBorder methodsFor: 'private' stamp: 'aoy 2/17/2003 01:05'!
computeAltRaisedColors
	| base light dark w colorArray param hw |
	base := self color asColor.
	light := Color white.
	dark := Color black.
	w := self width isPoint 
				ifTrue: [self width x max: self width y]
				ifFalse: [self width].
	w := w asInteger.
	colorArray := Array new: w * 2.
	hw := 0.5 / w.
	0 to: w - 1
		do: 
			[:i | "again !! false ifTrue:[] ?!!"
			param := false ifTrue: [0.5 + (hw * i)] ifFalse: [0.5 + (hw * (w - i))].
			colorArray at: i + 1 put: (base mixed: param with: light).	"brighten"
			colorArray at: colorArray size - i put: (base mixed: param with: dark)	"darken"].
	^colorArray! !

!ComplexBorder methodsFor: 'drawing' stamp: 'ar 8/26/2001 19:01'!
frameRectangle: aRectangle on: aCanvas
	"Note: This uses BitBlt since it's roughly a factor of two faster for rectangles"
	| w h r |
	self colors ifNil:[^super frameRectangle: aRectangle on: aCanvas].
	w := self width.
	w isPoint ifTrue:[h := w y. w := w x] ifFalse:[h := w].
	1 to: h do:[:i| "top/bottom"
		r := (aRectangle topLeft + (i-1)) extent: (aRectangle width - (i-1*2))@1. "top"
		aCanvas fillRectangle: r color: (colors at: i).
		r := (aRectangle bottomLeft + (i @ (0-i))) extent: (aRectangle width - (i-1*2) - 1)@1. "bottom"
		aCanvas fillRectangle: r color: (colors at: colors size - i + 1).
	].
	1 to: w do:[:i| "left/right"
		r := (aRectangle topLeft + (i-1)) extent: 1@(aRectangle height - (i-1*2)). "left"
		aCanvas fillRectangle: r color: (colors at: i).
		r := aRectangle topRight + ((0-i)@i) extent: 1@(aRectangle height - (i-1*2) - 1). "right"
		aCanvas fillRectangle: r color: (colors at: colors size - i + 1).
	].! !

!ComplexBorder methodsFor: 'accessing' stamp: 'ar 8/25/2001 16:13'!
colors
	^colors ifNil:[colors := self computeColors].! !

!ComplexBorder methodsFor: 'initialize' stamp: 'ar 11/26/2001 14:43'!
releaseCachedState
	colors := nil.
	lineStyles := nil.! !

!ComplexBorder methodsFor: 'private' stamp: 'ar 11/26/2001 15:00'!
computeColors
	width = 0 ifTrue:[^colors := #()].
	style == #complexFramed ifTrue:[^self computeFramedColors].
	style == #complexAltFramed ifTrue:[^self computeAltFramedColors].
	style == #complexRaised ifTrue:[^self computeRaisedColors].
	style == #complexAltRaised ifTrue:[^self computeAltRaisedColors].
	style == #complexInset ifTrue:[^self computeInsetColors].
	style == #complexAltInset ifTrue:[^self computeAltInsetColors].
	self error:'Unknown border style: ', style printString.! !

!ComplexBorder methodsFor: 'drawing' stamp: 'ar 9/4/2001 19:50'!
framePolygon: vertices on: aCanvas
	| dir1 dir2 dir3 nrm1 nrm2 nrm3 point1 point2 point3 
	 cross1 cross2 pointA pointB pointC pointD w p1 p2 p3 p4 balloon ends pointE pointF |
	balloon := aCanvas asBalloonCanvas.
	balloon == aCanvas ifFalse:[balloon deferred: true].
	ends := Array new: 6.
	w := width * 0.5.
	pointA := nil.
	1 to: vertices size do:[:i|
		p1 := vertices atWrap: i.
		p2 := vertices atWrap: i+1.
		p3 := vertices atWrap: i+2.
		p4 := vertices atWrap: i+3.

		dir1 := p2 - p1.
		dir2 := p3 - p2.
		dir3 := p4 - p3.

		(i = 1 | true) ifTrue:[
			"Compute the merge points of p1->p2 with p2->p3"
			cross1 := dir2 crossProduct: dir1.
			nrm1 := dir1 normalized. nrm1 := (nrm1 y * w) @ (0 - nrm1 x * w).
			nrm2 := dir2 normalized. nrm2 := (nrm2 y * w) @ (0 - nrm2 x * w).
			cross1 < 0 ifTrue:[nrm1 := nrm1 negated. nrm2 := nrm2 negated].
			point1 := (p1 x + nrm1 x) @ (p1 y + nrm1 y).
			point2 := (p2 x + nrm2 x) @ (p2 y + nrm2 y).
			pointA := self intersectFrom: point1 with: dir1 to: point2 with: dir2.
			point1 := (p1 x - nrm1 x) @ (p1 y - nrm1 y).
			point2 := (p2 x - nrm2 x) @ (p2 y - nrm2 y).
			pointB := point1 + dir1 + point2 * 0.5.
			pointB := p2 + ((pointB - p2) normalized * w).
			pointC := point2.
		].

		"Compute the merge points of p2->p3 with p3->p4"
		cross2 := dir3 crossProduct: dir2.
		nrm2 := dir2 normalized. nrm2 := (nrm2 y * w) @ (0 - nrm2 x * w).
		nrm3 := dir3 normalized. nrm3 := (nrm3 y * w) @ (0 - nrm3 x * w).
		cross2 < 0 ifTrue:[nrm2 := nrm2 negated. nrm3 := nrm3 negated].
		point2 := (p2 x + nrm2 x) @ (p2 y + nrm2 y).
		point3 := (p3 x + nrm3 x) @ (p3 y + nrm3 y).
		pointD := self intersectFrom: point2 with: dir2 to: point3 with: dir3.
		point2 := (p2 x - nrm2 x) @ (p2 y - nrm2 y).
		point3 := (p3 x - nrm3 x) @ (p3 y - nrm3 y).
		pointF := point2 + dir2.
		pointE := pointF + point3 * 0.5.
		pointE := p3 + ((pointE - p3) normalized * w).
		cross1 * cross2 < 0.0 ifTrue:[
			ends
				at: 1 put: pointA;
				at: 2 put: pointB;
				at: 3 put: pointC;
				at: 4 put: pointD;
				at: 5 put: pointE;
				at: 6 put: pointF.
		] ifFalse:[
			ends 
				at: 1 put: pointA; 
				at: 2 put: pointB;
				at: 3 put: pointC; 
				at: 4 put: pointF; 
				at: 5 put: pointE;
				at: 6 put: pointD.
		].
		self drawPolyPatchFrom: p2 to: p3 on: balloon usingEnds: ends.
		pointA := pointD.
		pointB := pointE.
		pointC := pointF.
		cross1 := cross2.
	].
	balloon == aCanvas ifFalse:[balloon flush].! !

!ComplexBorder methodsFor: 'accessing' stamp: 'ar 8/25/2001 16:22'!
style
	^style! !

!ComplexBorder methodsFor: 'private' stamp: 'ar 8/25/2001 16:35'!
computeFramedColors
	| base light dark w hw colorArray param |
	base := self color asColor.
	light := Color white.
	dark := Color black.
	w := self width isPoint ifTrue:[self width x max: self width y] ifFalse:[self width].
	w := w asInteger.
	w = 1 ifTrue:[^{base mixed: 0.5 with: light. base mixed: 0.5 with: dark}].
	colorArray := Array new: w.
	hw := w // 2.
	"brighten"
	0 to: hw-1 do:[:i|
		param := 0.5 + (i asFloat / hw * 0.5).
		colorArray at: i+1 put: (base mixed: param with: light). "brighten"
		colorArray at: w-i put: (base mixed: param with: dark). "darken"
	].
	w odd ifTrue:[colorArray at: hw+1 put: base].
	^colorArray, colorArray! !

!ComplexBorder methodsFor: 'private' stamp: 'aoy 2/17/2003 01:02'!
colorsForDirection: direction 
	"Return an array of colors describing the receiver in the given direction"

	| colorArray dT cc |
	cc := self colors.
	direction x * direction y <= 0 
		ifTrue: 
			["within up->right or down->left transition; no color blend needed"

			colorArray := (direction x > 0 or: [direction y < 0]) 
						ifTrue: 
							["up->right"
							cc copyFrom: 1 to: width]
						ifFalse: 
							["down->left"
							"colors are stored in reverse direction when following a line"
							(cc copyFrom: width + 1 to: cc size) reversed]]
		ifFalse: 
			["right->down or left->up transition; need color blend"

			colorArray := Array new: width.
			dT := direction x asFloat / (direction x + direction y).
			(direction x > 0 or: [direction y >= 0]) 
				ifTrue: 
					["top-right"

					1 to: width
						do: 
							[:i | 
							colorArray at: i put: ((cc at: i) mixed: dT with: (cc at: cc size - i + 1))]]
				ifFalse: 
					["bottom-left"

					1 to: width
						do: 
							[:i | 
							colorArray at: i put: ((cc at: cc size - i + 1) mixed: dT with: (cc at: i))]]].
	^colorArray! !

!ComplexBorder methodsFor: 'accessing' stamp: 'ar 8/25/2001 16:22'!
style: newStyle
	style == newStyle ifTrue:[^self].
	style := newStyle.
	self releaseCachedState.! !

!ComplexBorder methodsFor: 'drawing' stamp: 'pmm 3/13/2010 11:21'!
drawPolyPatchFrom: startPoint to: stopPoint on: aCanvas usingEnds: endsArray

	| cos sin tfm fill dir fsOrigin fsDirection points x y |
	dir := (stopPoint - startPoint) normalized.
	"Compute the rotational transform from (0@0) -> (1@0) to startPoint -> stopPoint"
	cos := dir dotProduct: (1@0).
	sin := dir crossProduct: (1@0).
	"Now get the fill style appropriate for the given direction"
	fill := self fillStyleForDirection: dir.
false ifTrue:[
	"Transform the fill appropriately"
	fill := fill shallowCopy.
	"Note: Code below is inlined from tfm transformPoint:/transformDirection:"
	x := fill origin x. y := fill origin y.
	fsOrigin := ((x * cos) + (y * sin) + startPoint x) @
					((y * cos) - (x * sin) + startPoint y).
	x := fill direction x. y := fill direction y.
	fsDirection := ((x * cos) + (y * sin)) @ ((y * cos) - (x * sin)).
	fill origin: fsOrigin; 
		direction: fsDirection rounded; "NOTE: This is a bug in the balloon engine!!!!!!"
		normal: nil.
	aCanvas asBalloonCanvas drawPolygon: endsArray fillStyle: fill.
] ifFalse:[
	"Transform the points rather than the fills"
	tfm := (MatrixTransform2x3 new) a11: cos; a12: sin; a21: sin negated; a22: cos.
	"Install the start point offset"
	tfm offset: startPoint.
	points := endsArray collect:[:pt| tfm invertPoint: pt].
	aCanvas asBalloonCanvas transformBy: tfm during:[:cc|
		cc drawPolygon: points fillStyle: fill.
	].
].! !

!ComplexBorder methodsFor: 'testing' stamp: 'ar 8/26/2001 19:30'!
isComplex
	^true! !

!ComplexBorder methodsFor: 'color tracking' stamp: 'ar 8/25/2001 18:17'!
trackColorFrom: aMorph
	baseColor ifNil:[self color: aMorph raisedColor].! !

!ComplexBorder methodsFor: 'private' stamp: 'aoy 2/17/2003 01:06'!
computeInsetColors
	| base light dark w colorArray param hw |
	base := self color asColor.
	light := Color white.
	dark := Color black.
	w := self width isPoint 
				ifTrue: [self width x max: self width y]
				ifFalse: [self width].
	w := w asInteger.
	colorArray := Array new: w * 2.
	hw := 0.5 / w.
	0 to: w - 1
		do: 
			[:i | 
			param := true 
				ifTrue: [ 0.5 + (hw * i)]
				ifFalse: [0.5 + (hw * (w - i))].
			colorArray at: i + 1 put: (base mixed: param with: dark).	"darken"
			colorArray at: colorArray size - i put: (base mixed: param with: light)	"brighten"].
	^colorArray! !

!ComplexBorder methodsFor: 'private' stamp: 'ar 8/26/2001 23:39'!
intersectFrom: startPt with: startDir to: endPt with: endDir
	"Compute the intersection of two lines. Return nil if either
		* the intersection does not exist, or
		* the intersection is 'before' startPt, or
		* the intersection is 'after' endPt
	"
	| det deltaPt alpha beta |
	det := (startDir x * endDir y) - (startDir y * endDir x).
	det = 0.0 ifTrue:[^nil]. "There's no solution for it"
	deltaPt := endPt - startPt.
	alpha := (deltaPt x * endDir y) - (deltaPt y * endDir x).
	beta := (deltaPt x * startDir y) - (deltaPt y * startDir x).
	alpha := alpha / det.
	beta := beta / det.
	alpha < 0 ifTrue:[^nil].
	beta > 1.0 ifTrue:[^nil].
	"And compute intersection"
	^(startPt x + (alpha * startDir x)) @ (startPt y + (alpha * startDir y))! !

!ComplexBorder methodsFor: 'private' stamp: 'aoy 2/17/2003 01:07'!
computeRaisedColors
	| base light dark w colorArray param hw |
	base := self color asColor.
	light := Color white.
	dark := Color black.
	w := self width isPoint 
				ifTrue: [self width x max: self width y]
				ifFalse: [self width].
	w := w asInteger.
	colorArray := Array new: w * 2.
	hw := 0.5 / w.
	0 to: w - 1
		do: 
			[:i | 
			param := true ifTrue: [0.5 + (hw * i)] ifFalse: [0.5 + (hw  * (w - i))].
			colorArray at: i + 1 put: (base mixed: param with: light).	"brighten"
			colorArray at: colorArray size - i put: (base mixed: param with: dark)	"darken"].
	^colorArray! !

!ComplexBorder class methodsFor: 'instance creation' stamp: 'ar 8/25/2001 16:22'!
style: aSymbol
	^self new style: aSymbol! !

!ComposableModel commentStamp: '<historical>'!
ComposableModel is an abstract class which represent a applicative model made to be composed with other ComposableModel!
!ComposableModel methodsFor: 'api-focus' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
eventKeyStrokesForPreviousFocus
	"String describing the keystroke to perform to jump to the previous widget"

	^ keyStrokesForPreviousFocusHolder value! !

!ComposableModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
window

	^ window value
		ifNil: [
			owner
				ifNil: [ nil ]
				ifNotNil: [:o | o window ]]! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
askOkToClose

	^ askOkToClose value! !

!ComposableModel methodsFor: 'private-focus' stamp: 'BenjaminVanRyseghem 10/4/2013 15:27'!
registerKeyStrokesForPreviousFor: aWidget

	aWidget ifNil: [ ^ self ].
	
	self eventKeyStrokesForPreviousFocus do: [:each |
		aWidget bindKeyCombination: each toAction: [ self giveFocusToPreviousFrom: self ] ]! !

!ComposableModel methodsFor: 'api-focus' stamp: 'BenjaminVanRyseghem 10/17/2013 16:07'!
keyStrokesForNextFocus: aCollection

	keyStrokesForNextFocusHolder value: aCollection! !

!ComposableModel methodsFor: 'widgets' stamp: 'CamilloBruni 9/22/2013 21:32'!
newMultiColumnList
	^ self instantiate: MultiColumnListModel! !

!ComposableModel methodsFor: 'api' stamp: 'johanfabry 3/11/2015 13:10'!
aboutText

	^ aboutText value ifNil: [ aboutText value: 'The about text for this window has not been set.']! !

!ComposableModel methodsFor: 'widgets' stamp: 'CamilloBruni 9/22/2013 21:31'!
newTextInput
	^ self instantiate: TextInputFieldModel! !

!ComposableModel methodsFor: 'api' stamp: 'StephaneDucasse 2/27/2015 20:55'!
setExtentAndBindingTo: widget

	self ensureExtentFor: widget.
	self ensureKeyBindingsFor: widget.
	self announce: (WidgetBuilt model: self widget: widget).
	! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 2/22/2013 00:18'!
announce: anAnnouncement

	self announcer announce: anAnnouncement! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 6/12/2012 14:57'!
openWithSpec
	"Build the widget using the default spec and display it into a window"

	^ self openWithSpec: self defaultSpecSelector.! !

!ComposableModel methodsFor: 'initialization' stamp: 'StephaneDucasse 2/26/2015 16:27'!
initialize

	super initialize.
	extentHolder := nil asValueHolder.
	needRebuild := true asValueHolder.
	keyStrokesForNextFocusHolder := { KMNoShortcut new } asValueHolder.
	keyStrokesForPreviousFocusHolder := { KMNoShortcut new } asValueHolder.
	additionalKeyBindings := Dictionary new.
	announcer := Announcer new asValueHolder.
	aboutText := nil asValueHolder.
	windowIcon := nil asValueHolder.
	window := nil asValueHolder.
	askOkToClose := false asValueHolder.
	titleHolder := self class title asValueHolder.
	
	self initializeWidgets.
	self initializePresenter.
	
	keyStrokesForNextFocusHolder whenChangedDo: [ self registerKeyStrokesForNextFor: self widget ].
	keyStrokesForPreviousFocusHolder whenChangedDo: [ self registerKeyStrokesForPreviousFor: self widget ].
	titleHolder whenChangedDo: [ self updateTitle ]! !

!ComposableModel methodsFor: 'testing' stamp: 'ClementBera 9/26/2013 17:36'!
hasWindow
	"Answers true if there is an open window using this model."

	self owner ifNil: [ ^ self window ifNotNil: [ :w | w isClosed not ] ifNil: [ false ] ].
	 ^ self owner hasWindow! !

!ComposableModel methodsFor: '*Spec-MorphicAdapters' stamp: 'BenjaminVanRyseghem 1/10/2014 12:29'!
detectMorphicAdapterDo: aBlock

	^ self dependents 
		detect: [:e | e isMorphicAdapter ]
		ifFound: aBlock! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:07'!
title: aString

	titleHolder value: aString! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 5/19/2013 16:16'!
openDialogWithSpec: aSpec
	"Build the widget using the spec name provided as argument and display it into a window"

	^ self openDialogWithSpecLayout: (self retrieveSpec: aSpec)! !

!ComposableModel methodsFor: 'api-shortcuts' stamp: 'BenjaminVanRyseghem 11/12/2013 09:40'!
bindKeyCombination: aShortcut toAction: aBlock

	additionalKeyBindings at: aShortcut put: aBlock.
	
	self changed: #bindKeyCombination:toAction: with: {aShortcut . aBlock}! !

!ComposableModel methodsFor: 'private-focus' stamp: 'BenjaminVanRyseghem 1/12/2014 16:41'!
takeKeyboardFocus

	self focusOrder ifNotEmpty:[:focus | ^ focus first takeKeyboardFocus ].
	^ self changed: #takeKeyboardFocus with: #()! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
windowIcon

	^ windowIcon value! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:07'!
aboutText: aString

	aboutText value: aString! !

!ComposableModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:07'!
needRebuild: aBoolean

	needRebuild value: aBoolean! !

!ComposableModel methodsFor: '*Spec-MorphicAdapters' stamp: 'BenjaminVanRyseghem 10/10/2013 12:22'!
heightToDisplayInTree: aTree
	"Return the width of my representation as a list item"
	
	^ self ensureMorphicAdapterDo: [ :adapter | adapter heightToDisplayInTree: aTree ]! !

!ComposableModel methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 7/10/2012 23:21'!
initializeWidgets
	
	self subclassResponsibility! !

!ComposableModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/7/2012 12:25'!
widget

	^ spec
		ifNil: [ nil ]
		ifNotNil: [:s | s instance ]! !

!ComposableModel methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 7/10/2012 14:58'!
initializeDialogWindow: aWindow
	"used to initialize the model in the case of the use into a dialog window"! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 12/1/2013 01:10'!
setModal: aWindow 
	
	self changed: #setModal: with: { aWindow }! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
extent

	^  extentHolder value! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:07'!
openDialogWithSpecLayout: aSpec
	"Build the widget using the spec name provided as argument and display it into a window"

	(window value notNil and: [ self needRebuild not ])
		ifTrue: [
			window value rebuildWithSpec: aSpec ]
		ifFalse: [
			window value: (DialogWindowModel new model: self).
			window value openWithSpecLayout: aSpec.
			self initializeDialogWindow: window value.
			window value updateTitle.
			self takeKeyboardFocus ].
		
	^ window value! !

!ComposableModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/21/2013 10:19'!
delete

	window value
		ifNil: [ self changed: #delete with: #() ]
		ifNotNil: [ :w | w delete ]! !

!ComposableModel methodsFor: 'api-shortcuts' stamp: 'BenjaminVanRyseghem 11/12/2013 10:48'!
bindMenuKeyCombination: aShortcut toAction: aBlock

	additionalKeyBindings at: aShortcut put: aBlock.
	
	self changed: #bindMenuKeyCombination:toAction: with: {aShortcut . aBlock}! !

!ComposableModel methodsFor: 'widgets' stamp: 'BenjaminVanRyseghem 10/1/2013 13:50'!
newTabManager
	^ self instantiate: TabManagerModel! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 5/20/2013 12:04'!
openWithSpec: aSpec
	"Build the widget using the spec name provided as argument and display it into a window"

	^ self openWithSpecLayout: (self retrieveSpec: aSpec)! !

!ComposableModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/6/2012 18:25'!
spec

	^ spec! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:07'!
askOkToClose: aBoolean

	askOkToClose value: aBoolean! !

!ComposableModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/12/2012 15:41'!
private_buildWithSpec
	"Build the widget using the default spec"
	
	^ self private_buildWithSpec: self defaultSpecSelector! !

!ComposableModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:29'!
whenShortcutsChanged: aBlock
	"Set a block to value when the shortcuts block has changed"
	additionalKeyBindings whenChangedDo: aBlock! !

!ComposableModel methodsFor: '*Spec-MorphicAdapters' stamp: 'BenjaminVanRyseghem 6/5/2013 22:38'!
openWorldWithSpec: aSpec
	"Build the widget using the spec name provided as argument and display it into the world"

	^ self openWorldWithSpecLayout: (self retrieveSpec: aSpec)! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 6/12/2012 14:58'!
specSelectors
	"Return all the spec names"
	
	^ self class specSelectors! !

!ComposableModel methodsFor: 'api-events' stamp: 'BernardoContreras 9/27/2014 09:29'!
whenBuiltDo: aBlock

	self announcer 
		when: WidgetBuilt
		do: aBlock! !

!ComposableModel methodsFor: 'api-shortcuts' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
additionalKeyBindings

	^ additionalKeyBindings value! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 6/12/2012 17:43'!
isDisplayed
	"Return true if the widget is currently displayed on screen"
	
	^ self window notNil and: [ self window isDisplayed ]! !

!ComposableModel methodsFor: 'private-focus' stamp: 'BenjaminVanRyseghem 10/4/2013 15:11'!
giveFocusToPreviousFrom: aModel 
	| focus |
	
	focus := self focusOrder.

	(focus includes: aModel)
		ifTrue: [
			| index previous |
			index := (focus indexOf: aModel) - 1.
			(index > 0)
				ifTrue: [
					previous := focus at: index.
					previous takeLastKeyboardFocus.
					^ true ]].

	^ owner 
		ifNil: [ " I loop "
			| next |
			next := focus at: focus size ifAbsent: [ ^ false ].
			next takeLastKeyboardFocus.
			true]
		ifNotNil: [ 
			owner giveFocusToPreviousFrom: self.
			true ]! !

!ComposableModel methodsFor: 'api-focus' stamp: 'BenjaminVanRyseghem 10/17/2013 16:07'!
keyStrokeForNextFocus: aKMShortcut

	keyStrokesForNextFocusHolder value: { aKMShortcut }! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 7/10/2012 15:07'!
initialExtent

	^ nil! !

!ComposableModel methodsFor: 'widgets' stamp: 'CamilloBruni 9/22/2013 21:30'!
newLabel
	^ self instantiate: LabelModel! !

!ComposableModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
announcer

	^ announcer value! !

!ComposableModel methodsFor: '*Spec-MorphicAdapters' stamp: 'BenjaminVanRyseghem 10/10/2013 12:22'!
widthToDisplayInList: aList
	"Return the width of my representation as a list item"
	
	^ self ensureMorphicAdapterDo: [ :adapter | adapter widthToDisplayInList: aList ]! !

!ComposableModel methodsFor: 'widgets' stamp: 'BenjaminVanRyseghem 1/11/2014 22:18'!
newImage
	^ self instantiate: ImageModel! !

!ComposableModel methodsFor: 'api-shortcuts' stamp: 'GuillermoPolito 8/5/2013 10:22'!
on: aShortcut do: aBlock

	self bindKeyCombination: aShortcut toAction: aBlock! !

!ComposableModel methodsFor: 'api-shortcuts' stamp: 'BenjaminVanRyseghem 11/12/2013 10:49'!
removeMenuKeyCombination: aShortcut

	additionalKeyBindings 
		removeKey: aShortcut 
		ifAbsent: [ ^ self ].
	
	self changed: #removeMenuKeyCombination: with: { aShortcut }! !

!ComposableModel methodsFor: 'api-events' stamp: 'BenjaminVanRyseghem 5/14/2013 19:25'!
whenWindowChanged: aBlock

	window whenChangedDo: aBlock! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 5/19/2013 16:15'!
buildWithSpec: aSpec
	"Build the widget using the spec name provided as argument"
	
	^ self buildWithSpecLayout: (self retrieveSpec: aSpec)! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/28/2013 17:12'!
centeredRelativeTo: aModel

	window value ifNotNil: [ :w | w centeredRelativeTo: aModel ]! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 6/12/2012 14:56'!
buildWithSpec
	"Build the widget using the default spec"
	
	^ self buildWithSpec: self defaultSpecSelector! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/28/2013 17:07'!
cancelled

	^ self window
		ifNil: [ false ]
		ifNotNil: [ :w | w cancelled ]! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 7/11/2012 16:14'!
apiSelectors

	^ self class apiSelectors! !

!ComposableModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/28/2012 11:07'!
okToChange

	^ owner 
		ifNil: [
			self canDiscardEdits ifTrue: [^ true].
			self changed: #wantToChange.  "Solicit cancel from view"
			^ self canDiscardEdits]
		ifNotNil: [ owner okToChange ]! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:07'!
windowIcon: aForm

	windowIcon value: aForm! !

!ComposableModel methodsFor: 'api' stamp: 'StephaneDucasse 2/27/2015 21:19'!
adapterFrom: aSpecLayout model: aModel
	^ SpecInterpreter interpretASpec: aSpecLayout model: aModel! !

!ComposableModel methodsFor: 'accessing' stamp: 'StephaneDucasse 3/7/2014 10:50'!
defaultWindowModelClass 
	^ WindowModel! !

!ComposableModel methodsFor: 'api-shortcuts' stamp: 'BenjaminVanRyseghem 11/12/2013 10:45'!
removeKeyCombination: aShortcut

	additionalKeyBindings 
		removeKey: aShortcut 
		ifAbsent: [ ^ self ].
	
	self changed: #removeKeyCombination: with: { aShortcut }! !

!ComposableModel methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 10/5/2014 11:59'!
gtInspectorPreviewIn: composite
	<gtInspectorPresentationOrder: 30>
	
	(self widget notNil and: [ self widget widget notNil ]) ifTrue: [ 
		 self widget widget gtInspectorMorphIn: composite ].! !

!ComposableModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/6/2012 18:26'!
spec: aSpec

	spec := aSpec! !

!ComposableModel methodsFor: 'api' stamp: 'StephaneDucasse 3/7/2014 11:10'!
openWithSpecLayout: aSpec
	"Build the widget using the spec name provided as argument and display it into a window"

	(window value notNil and: [ self needRebuild not ])
		ifTrue: [
			window value rebuildWithSpecLayout: aSpec ]
		ifFalse: [ 
			window value: (self defaultWindowModelClass new model: self).
			window value openWithSpecLayout: aSpec.
			self takeKeyboardFocus ].
		
	^ window value! !

!ComposableModel methodsFor: 'private-focus' stamp: 'BenjaminVanRyseghem 10/4/2013 15:17'!
registerKeyStrokesForNextFor: aWidget

	aWidget ifNil: [ ^ self ].
	
	self eventKeyStrokesForNextFocus do: [:each |
		aWidget bindKeyCombination: each toAction: [ self giveFocusToNextFrom: self ] ]! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 7/10/2012 15:35'!
updateTitle
	"Update the window title"

	self window ifNotNil: [:w | w updateTitle ]! !

!ComposableModel methodsFor: 'widgets' stamp: 'CamilloBruni 9/22/2013 21:30'!
newRadioButton
	^ self instantiate: RadioButtonModel! !

!ComposableModel methodsFor: 'specs' stamp: 'bvr 6/1/2012 17:12'!
defaultSpec

	^ self class perform: self defaultSpecSelector! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 1/13/2014 09:17'!
ensureExtentFor: widget

	self extent
		ifNil: [ self initialExtent
			ifNotNil: [ :ex | 
				(widget respondsTo: #extent:)
					ifTrue: [ widget extent: ex ] ] ]
		ifNotNil: [ :ex | 
			(widget respondsTo: #extent:)
				ifTrue: [ widget extent: ex ] ].
	! !

!ComposableModel methodsFor: 'private' stamp: 'StephaneDucasse 2/27/2015 21:30'!
privateAdapterFromModel: aModel withSpec: aSpec
	"apparently when looking at the implementation, it does not return a widget but an adapter so it should be called adapter :)"
	^ SpecInterpreter private_buildWidgetFor: self withSpec: aSpec.! !

!ComposableModel methodsFor: 'private-focus' stamp: ''!
handlesKeyboard: evt

	^ true! !

!ComposableModel methodsFor: '*Spec-MorphicAdapters' stamp: 'BenjaminVanRyseghem 10/10/2013 12:22'!
treeRenderOn: aCanvas bounds: drawBounds color: drawColor font: aFont from: aMorph
	"Specify how this object as a list item should be drawn"

	^ self ensureMorphicAdapterDo: [ :adapter | adapter 
		treeRenderOn: aCanvas 
		bounds: drawBounds 
		color: drawColor 
		font: aFont 
		from: aMorph ]! !

!ComposableModel methodsFor: '*Spec-MorphicAdapters' stamp: 'BenjaminVanRyseghem 10/10/2013 12:22'!
ensureMorphicAdapterDo: aBlock

	^ aBlock value: self ensureMorphicAdapter! !

!ComposableModel methodsFor: '*Spec-MorphicAdapters' stamp: 'BenjaminVanRyseghem 10/17/2013 16:07'!
openWorldWithSpecLayout: aSpec
	"Build the widget using the spec name provided as argument and display it into the world"

	(window value notNil and: [ self needRebuild not ])
		ifTrue: [
			window value rebuildWithSpecLayout: aSpec ]
		ifFalse: [ 
			window value: (WorldModel new model: self).
			window value openWithSpecLayout: aSpec.
			self takeKeyboardFocus ].
		
	^ window value! !

!ComposableModel methodsFor: 'private' stamp: 'CamilloBruni 5/1/2013 23:30'!
defaultSpecSelector

	self class class withAllSuperclassesDo: [ :class |
		(((SpecPragmaCollector behavior: class)
			filter: [ :pragma | 
				pragma keyword = 'spec:' and: [ pragma arguments includes: #default ]])
			reset;
			collected)
				ifNotEmpty: [ :pragmas | ^ pragmas first method selector ]].

	self specSelectors
		ifNotEmpty: [:col | col size = 1 ifTrue: [ ^ col first ]].
		
	"should use pragmas"
	^ #defaultSpec
	
! !

!ComposableModel methodsFor: 'api-announcements' stamp: 'BernardoContreras 9/27/2014 09:30'!
on: anAnnouncement send: aSelector to: aTarget

	self announcer
		when: anAnnouncement 
		send: aSelector 
		to: aTarget! !

!ComposableModel methodsFor: 'widgets' stamp: 'CamilloBruni 9/22/2013 21:30'!
newCheckBox
	^ self instantiate: CheckBoxModel! !

!ComposableModel methodsFor: 'widgets' stamp: 'BenjaminVanRyseghem 10/1/2013 13:50'!
newTab
	^ self instantiate: TabModel! !

!ComposableModel methodsFor: 'widgets' stamp: 'CamilloBruni 9/22/2013 21:31'!
newSlider
	^ self instantiate: SliderModel! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/28/2013 17:17'!
centerWidget: aWindow

	self changed: #centerWidget: with: { aWindow }! !

!ComposableModel methodsFor: 'api-focus' stamp: 'BenjaminVanRyseghem 10/17/2013 16:07'!
keyStrokeForPreviousFocus: aKMShortcut

	keyStrokesForPreviousFocusHolder value: { aKMShortcut }! !

!ComposableModel methodsFor: '*Spec-MorphicAdapters' stamp: 'BenjaminVanRyseghem 10/10/2013 12:22'!
widthToDisplayInTree: aTree
	"Return the width of my representation as a list item"
	
	^ self ensureMorphicAdapterDo: [ :adapter | adapter widthToDisplayInTree: aTree ]! !

!ComposableModel methodsFor: 'widgets' stamp: 'BenjaminVanRyseghem 10/1/2013 15:01'!
newDropList
	^ self instantiate: DropListModel! !

!ComposableModel methodsFor: 'widgets' stamp: 'CamilloBruni 9/22/2013 21:31'!
newText
	^ self instantiate: TextModel! !

!ComposableModel methodsFor: 'api-focus' stamp: 'BenjaminVanRyseghem 10/17/2013 16:07'!
keyStrokesForPreviousFocus: aCollection

	keyStrokesForPreviousFocusHolder value: aCollection ! !

!ComposableModel methodsFor: 'widgets' stamp: 'BenjaminVanRyseghem 10/1/2013 13:49'!
newList
	^ self instantiate: ListModel! !

!ComposableModel methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 6/11/2012 10:00'!
resolveSymbol: aSymbol

	^ Smalltalk at: aSymbol! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 6/26/2012 02:09'!
openDialogWithSpec
	"Build the widget using the default spec and display it into a window"

	^ self openDialogWithSpec: self defaultSpecSelector.! !

!ComposableModel methodsFor: 'widgets' stamp: 'CamilloBruni 9/22/2013 21:31'!
newTree
	^ self instantiate: TreeModel! !

!ComposableModel methodsFor: '*Spec-MorphicAdapters' stamp: 'BenjaminVanRyseghem 10/10/2013 12:22'!
listRenderOn: aCanvas atRow: aRow bounds: drawBounds color: drawColor backgroundColor: backgroundColor from: aMorph
	"Specify how this object as a list item should be drawn"

	^ self ensureMorphicAdapterDo: [ :adapter | adapter
		listRenderOn: aCanvas
		atRow: aRow
		bounds: drawBounds
		color: drawColor
		backgroundColor: backgroundColor
		from: aMorph ]! !

!ComposableModel methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 7/10/2012 14:59'!
createInstanceFor: aClassSymbol
	"Retrieve the class corresponding to aClassSymbol using the bindings, then create a new instance of theis class"
	| class |
	
	class := self resolveSymbol: aClassSymbol.
	^ self instantiate: class.! !

!ComposableModel methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 7/10/2012 15:00'!
instantiate: aComposableModelClass
	"Instantiate a ComposableModel subclass and set its instance owner"
	^ aComposableModelClass owner: self! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 5/19/2013 16:17'!
retrieveSpec: aSelector
	| layout |
	
	layout := self class perform: aSelector.
	layout isSpecLayout ifTrue: [ layout selector: aSelector ].
	^ layout! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
title
	"Return the window's title"

	^ titleHolder value! !

!ComposableModel methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 6/26/2012 00:19'!
initializePresenter
	"Used to specify the subwidgets, and/or to bind them together"
	"By default, do not do anything"
	
	extentHolder whenChangedDo: [:ex | 
		self widget ifNotNil: [:widget |
			(widget respondsTo: #extent:)
				ifTrue: [ widget extent: ex ]]].! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 6/26/2012 00:47'!
show

	self widget ifNotNil: [:widget |
		(widget respondsTo: #show) ifTrue: [ widget show ]].! !

!ComposableModel methodsFor: 'instance creation' stamp: 'PavelKrivanek 8/21/2012 11:05'!
instantiateModels: aCollectionOfPairs
	"Used to instantiate multiple sub widget at once. Take aCollectionOfPairs where each odd element is an inst var name and each even element is a class name, create an instance from the class name and store it into the inst var"
	
	(aCollectionOfPairs anySatisfy: [:e | e isKindOf: Association ])
		ifTrue: [ 
			aCollectionOfPairs do: [ :a || k v |
				k := a key.
				v := a value.
				self instVarNamed: k asString put: (self createInstanceFor: v) ]]
		ifFalse: [
			aCollectionOfPairs pairsDo: [ :k :v |
				self instVarNamed: k asString put: (self createInstanceFor: v) ]]! !

!ComposableModel methodsFor: 'window menu' stamp: 'BenjaminVanRyseghem 10/19/2013 15:18'!
addMenuItemsToWindowMenu: aMenu
	"Do nothing"! !

!ComposableModel methodsFor: 'private-focus' stamp: 'GuillermoPolito 8/5/2013 10:21'!
ensureKeyBindingsFor: aWidget

	self registerKeyStrokesForNextFor: aWidget.
	self registerKeyStrokesForPreviousFor: aWidget.
	
	additionalKeyBindings associationsDo: [:association | aWidget bindKeyCombination: association key toAction: association value ]! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/12/2013 10:49'!
neglectMenuModel: aMenuModel

	aMenuModel menuGroups do: [ :group |
		group menuItems do: [ :item |
			item shortcut ifNotNil: [ :shortcut | self removeMenuKeyCombination: shortcut ].
			item subMenu ifNotNil: [ :subMenu | subMenu neglect: self	] ] ]! !

!ComposableModel methodsFor: 'api-focus' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
eventKeyStrokesForNextFocus
	"String describing the keystroke to perform to jump to the next widget"

	^ keyStrokesForNextFocusHolder value! !

!ComposableModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
needRebuild

	^ needRebuild value! !

!ComposableModel methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 4/2/2013 16:38'!
gtInspectorModelNestingIn: composite
	<gtInspectorPresentationOrder: 20>
	composite tree 
		title: 'Nesting';
		display: [ :root | { 'root' -> self } ];
		children: [ :each | 
			each value class allInstVarNames 
				collect: [ :iv | iv->(each value instVarNamed: iv) ]
				thenSelect: [ :association | 
					(association value isKindOf: ComposableModel) 
						and: [ (#('owner' 'window') includes: association key) not ] ] ];
		format: [ :association | association key , ': ' , association value asString ];
		send: #value! !

!ComposableModel methodsFor: 'private' stamp: ''!
addAll: aWindow withSpec: aSpec

	aWindow
		addMorph: (self buildWithSpec: aSpec)
		frame: (0@0 corner: 1@1).! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 7/11/2012 16:13'!
apiMethods

	^ self class apiMethods! !

!ComposableModel methodsFor: 'private' stamp: ''!
update: aParameter

	self changed: aParameter! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:07'!
extent: aPoint

	^  extentHolder value: aPoint! !

!ComposableModel methodsFor: 'api' stamp: 'StephaneDucasse 2/27/2015 21:20'!
buildWithSpecLayout: aSpecLayout
	"Build the widget using the spec name provided as argument"
	| widget adapter|
	adapter := self adapterFrom: aSpecLayout model: self.
	widget := adapter asWidget.
	self setExtentAndBindingTo: widget.
	^ widget! !

!ComposableModel methodsFor: '*Spec-MorphicAdapters' stamp: 'BenjaminVanRyseghem 5/14/2013 16:29'!
openWorldWithSpec
	"Build the widget using the default spec and display it into the world"

	^ self openWorldWithSpec: self defaultSpecSelector.! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/12/2013 10:49'!
applyMenuModel: aMenuModel

	aMenuModel menuGroups do: [ :group |
		group menuItems do: [ :item |
			item shortcut ifNotNil: [ :shortcut | self bindMenuKeyCombination: shortcut toAction: [ item performMenuActionWith: {} ] ].
			item subMenu ifNotNil: [ :subMenu | subMenu applyTo: self	] ] ]! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 6/26/2012 00:47'!
hide

	self widget ifNotNil: [:widget |
		(widget respondsTo: #hide) ifTrue: [ widget hide ]].! !

!ComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/28/2013 17:08'!
centered

	window value ifNotNil: [ :w | w centered ]! !

!ComposableModel methodsFor: 'widgets' stamp: 'CamilloBruni 9/22/2013 21:30'!
newButton
	^ self instantiate: ButtonModel! !

!ComposableModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/2/2013 14:27'!
owner

	^ owner! !

!ComposableModel methodsFor: 'accessing' stamp: ''!
focusOrder

	^ focusOrder ifNil: [ focusOrder := OrderedCollection new ].! !

!ComposableModel methodsFor: '*Spec-MorphicAdapters' stamp: 'BenjaminVanRyseghem 10/10/2013 12:22'!
beginsWith: aString fromList: aMorph
	"This method is used bu the list for the search of elements when you are typing directly in the list"
	
	^ self ensureMorphicAdapterDo: [ :adapter | adapter beginsWith: aString fromList: aMorph ]! !

!ComposableModel methodsFor: 'widgets' stamp: 'CamilloBruni 9/22/2013 21:32'!
newIconList
	^ self instantiate: IconListModel! !

!ComposableModel methodsFor: 'private' stamp: 'StephaneDucasse 2/27/2015 21:31'!
private_buildWithSpec: aSpec
	"Build the widget using the spec name provided as argument"
	| adapter |
	adapter := self privateAdapterFromModel: self withSpec: aSpec.
	self setExtentAndBindingTo: adapter.	
	self flag: #PotentialBug. "here the adpater is passed and not the widget as in all the otheraSpec cases. So either this is left over of the logic to build widget based on a spec interpretation or this is simply a bug when the adpater concept was introduced."
	
	^ adapter! !

!ComposableModel methodsFor: '*Spec-MorphicAdapters' stamp: 'BenjaminVanRyseghem 10/10/2013 12:22'!
heightToDisplayInList: aList
	"Return the width of my representation as a list item"
	
	^ self ensureMorphicAdapterDo: [ :adapter | adapter heightToDisplayInList: aList ]! !

!ComposableModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/4/2014 17:18:07'!
owner: anObject

	owner := anObject.! !

!ComposableModel methodsFor: 'private-focus' stamp: 'BenjaminVanRyseghem 10/4/2013 15:21'!
giveFocusToNextFrom: aModel
	| focus |
	
	focus := self focusOrder.

	(focus includes: aModel)
		ifTrue: [
			| index next |
			index := (focus indexOf: aModel) + 1.
			(index <= focus size)
				ifTrue: [
					next := focus at: index.
					next takeKeyboardFocus.
					^ true ]].

	^ owner 
		ifNil: [ " I loop "
			| next |
			next := focus at: 1 ifAbsent: [ ^ false ].
			next takeKeyboardFocus.
			true ]
		ifNotNil: [ 
			owner giveFocusToNextFrom: self.
			true ]! !

!ComposableModel methodsFor: 'private-focus' stamp: ''!
takeLastKeyboardFocus

	self focusOrder
		ifEmpty: [ self takeKeyboardFocus ]
		ifNotEmpty: [:focus | focus last takeKeyboardFocus ].! !

!ComposableModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 7/9/2012 16:13'!
addAll: aWindow withSpecLayout: aSpec

	aWindow
		addMorph: (self buildWithSpecLayout: aSpec)
		frame: (0@0 corner: 1@1).! !

!ComposableModel methodsFor: '*Spec-MorphicAdapters' stamp: 'BenjaminVanRyseghem 10/10/2013 12:22'!
ensureMorphicAdapter

	^ self dependents 
		detect: [:e | e isMorphicAdapter ]
		ifNone: [ self buildWithSpec ]! !

!ComposableModel methodsFor: '*Spec-MorphicAdapters' stamp: 'BenjaminVanRyseghem 1/10/2014 12:29'!
detectMorphicAdapterDo: doBlock ifNone: aBlock

	^ self dependents 
		detect: [:e | e isMorphicAdapter ]
		ifFound: doBlock
		ifNone: aBlock! !

!ComposableModel class methodsFor: 'specs' stamp: 'bvr 6/4/2012 14:35'!
defaultSpec

	^ self subclassResponsibility! !

!ComposableModel class methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/13/2012 02:54'!
apiMethods
	| methods class |
	methods := OrderedCollection new.
	class := self.
	[ class = ComposableModel ]
		whileFalse: [| newMethods | 
			newMethods := ((SpecPragmaCollector behavior: class)
									filter: [:prg | prg keyword beginsWith: 'api:' ];
									reset;
									collected) collect: [:e | e method ].
			newMethods do: [:m | (methods noneSatisfy: [:m2 | m2 selector = m selector ])
										ifTrue: [ methods add: m ]].
			class := class superclass ].
		
	^ methods! !

!ComposableModel class methodsFor: 'defaults' stamp: 'BenjaminVanRyseghem 2/7/2014 17:30'!
buttonHeight

	^ StandardFonts defaultFont height + 12! !

!ComposableModel class methodsFor: 'specs' stamp: ''!
title
	
	^ 'Untitled window'! !

!ComposableModel class methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/11/2012 16:13'!
apiSelectors

	^ self apiMethods collect: #selector! !

!ComposableModel class methodsFor: 'defaults' stamp: 'BenjaminVanRyseghem 2/7/2014 17:31'!
buttonWidth

	^ (StandardFonts defaultFont widthOfString: 'eilwp') + 44! !

!ComposableModel class methodsFor: 'instance creation' stamp: ''!
owner: owner

	^ self new
		owner: owner;
		yourself! !

!ComposableModel class methodsFor: 'defaults' stamp: 'BenjaminVanRyseghem 2/7/2014 17:31'!
toolbarHeight

	^ StandardFonts defaultFont height + 12! !

!ComposableModel class methodsFor: 'protocol' stamp: 'CamilloBruni 5/1/2013 23:34'!
specSelectors
	
	^  self class withAllSuperclasses gather: [ :class |
		(((SpecPragmaCollector behavior: class)
			filter: [ :pragma | pragma keyword = #spec])
			reset;
			collected)
			collect: [ :pragmas | pragmas method selector ]]! !

!ComposableModel class methodsFor: 'defaults' stamp: 'BenjaminVanRyseghem 2/7/2014 17:30'!
inputTextHeight

	^ StandardFonts defaultFont height + 12! !

!ComposableMorph commentStamp: 'gvc 5/18/2007 13:32'!
Morph with an inset border by default and theme access.!
!ComposableMorph methodsFor: 'services' stamp: ''!
questionWithoutCancel: aStringOrText
	"Open a question dialog."

	^self questionWithoutCancel: aStringOrText title: 'Question' translated! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newWindowFor: aModel title: titleString
	"Answer a new window morph."
	
	^self theme
		newWindowIn: self
		for: aModel
		title: titleString! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newColorChooserFor: aModel getColor: getSel setColor: setSel help: helpText
	"Answer a color chooser with the given selectors."

	^self theme
		newColorChooserIn: self
		for: aModel
		getColor: getSel
		setColor: setSel
		getEnabled: nil
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newGroupbox
	"Answer a plain groupbox."

	^self theme
		newGroupboxIn: self! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newColorChooserFor: aModel getColor: getSel setColor: setSel getEnabled: enabledSel help: helpText
	"Answer a color chooser with the given selectors."

	^self theme
		newColorChooserIn: self
		for: aModel
		getColor: getSel
		setColor: setSel
		getEnabled: enabledSel
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newIncrementalSliderFor: aModel getValue: getSel setValue: setSel min: min max: max quantum: quantum getEnabled: enabledSel help: helpText
	"Answer an inremental slider with the given selectors."

	^self theme
		newIncrementalSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: min
		max: max
		quantum: quantum
		getEnabled: enabledSel
		help: helpText! !

!ComposableMorph methodsFor: 'services' stamp: ''!
deny: aStringOrText
	"Open a denial dialog."

	^self deny: aStringOrText title: 'Access Denied' translated! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newLabelGroup: labelsAndControls font: aFont labelColor: aColor
	"Answer a morph laid out with a column of labels and a column of associated controls.
	Controls having a vResizing value of #spaceFill will
	cause their row to use #spaceFill also, otherwise #shrinkWrap."

	^self theme
		newLabelGroupIn: self
		for: labelsAndControls
		font: aFont
		labelColor: aColor
! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newCloseButton
	"Answer a new close button."

	^self newCloseButtonFor: self ! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newGroupbox: aString
	"Answer a groupbox with the given label."

	^self theme
		newGroupboxIn: self
		label: aString! !

!ComposableMorph methodsFor: 'theme' stamp: ''!
theme
	"Answer the ui theme that provides controls."

	^ Smalltalk ui theme! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newSliderFor: aModel getValue: getSel setValue: setSel getEnabled: enabledSel help: helpText
	"Answer a slider with the given selectors."

	^self theme
		newSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: 0
		max: 1
		quantum: nil
		getEnabled: enabledSel
		help: helpText! !

!ComposableMorph methodsFor: 'services' stamp: ''!
fileOpen: title extensions: exts path: path
	"Answer the result of a file open dialog with the given title, extensions to show and path."

	^self 
		fileOpen: title
		extensions: exts
		path: path
		preview: nil! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newButtonFor: aModel getState: stateSel action: actionSel arguments: args getEnabled: enabledSel labelForm: aForm help: helpText
	"Answer a new button."

	^self theme
		newButtonIn: self for: aModel
		getState: stateSel
		action: actionSel
		arguments: args
		getEnabled: enabledSel 
		label: (AlphaImageMorph new image: aForm)
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newPanel
	"Answer a new panel."

	^self theme
		newPanelIn: self! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newPluggableDialogWindow: title
	"Answer a new pluggable dialog with the given content."

	^self
		newPluggableDialogWindow: title
		for: nil! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newSVSelector: aColor help: helpText
	"Answer a saturation-volume selector with the given color."

	^self theme
		newSVSelectorIn: self
		color: aColor
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newListFor: aModel list: listSelector selected: getSelector changeSelected: setSelector help: helpText
	"Answer a list for the given model."

	^self
		newListFor: aModel
		list: listSelector
		selected: getSelector
		changeSelected: setSelector
		getEnabled: nil
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newMenu
	"Answer a new menu."

	^self theme
		newMenuIn: self
		for: self! !

!ComposableMorph methodsFor: 'services' stamp: ''!
centeredAlert: aStringOrText title: aString configure: aBlock
	"Open an alert dialog.
	Configure the dialog with the 1 argument block
	before opening modally."

	^self theme
		centeredAlertIn: self
		text: aStringOrText
		title: aString
		configure: aBlock! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newMenuFor: aModel
	"Answer a new menu."

	^self theme
		newMenuIn: self
		for: aModel! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newBasicTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel menu: menuSelector
	"Answer a text editor for the given model."

	^self theme
		newBasicTextEditorIn: self
		for: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel
		menu: menuSelector! !

!ComposableMorph methodsFor: 'initialization' stamp: 'gvc 10/30/2006 09:39'!
defaultBorderWidth
	"Answer the default border width for the receiver."
	
	^ 1! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newMorphDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel getEnabled: enabledSel useIndex: useIndex help: helpText
	"Answer a morph drop list for the given model."

	^self theme
		newMorphDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		useIndex: useIndex
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newStack: controls
	"Answer a morph laid out with a stack of controls."

	^self theme
		newStackIn: self
		for: controls! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newRadioButtonFor: aModel getSelected: getSel setSelected: setSel getEnabled: enabledSel label: stringOrText help: helpText
	"Answer a checkbox (radio button appearance) with the given label."

	^self theme
		newRadioButtonIn: self
		for: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		label: stringOrText
		help: helpText! !

!ComposableMorph methodsFor: 'services' stamp: ''!
chooseFont
	"Answer the result of a font selector dialog."

	^self chooseFont: nil! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newAlphaImage: aForm help: helpText
	"Answer an alpha image morph."

	^self theme
		newAlphaImageIn: self
		image: aForm
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newButtonFor: aModel action: actionSel getEnabled: enabledSel label: stringOrText help: helpText
	"Answer a new button."

	^self
		newButtonFor: aModel
		getState: nil
		action: actionSel
		arguments: nil
		getEnabled: enabledSel 
		label: stringOrText
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newBalloonHelp: aTextStringOrMorph for: aMorph corner: cornerSymbol
	"Answer a new balloon help with the given contents for aMorph
	at a given corner."

	^self theme
		newBalloonHelpIn: self
		contents: aTextStringOrMorph
		for: aMorph
		corner: cornerSymbol! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newAlphaSelector: aModel getAlpha: getSel setAlpha: setSel help: helpText
	"Answer an alpha channel selector with the given selectors."

	^self theme
		newAlphaSelectorIn: self
		for: aModel
		getAlpha: getSel
		setAlpha: setSel
		help: helpText! !

!ComposableMorph methodsFor: 'services' stamp: ''!
message: aStringOrText
	"Open a message dialog."

	^self message: aStringOrText title: 'Information' translated! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel menu: menuSelector
	"Answer a text editor for the given model."

	^self theme
		newTextEditorIn: self
		for: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel
		menu: menuSelector! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newBasicTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel
	"Answer a text editor for the given model."

	^self
		newBasicTextEditorFor: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel
		menu: nil! !

!ComposableMorph methodsFor: 'services' stamp: ''!
chooseDirectory: title path: path
	"Answer the result of a file dialog with the given title, answer a directory."

	^self theme
		chooseDirectoryIn: self
		title: title
		path: path! !

!ComposableMorph methodsFor: 'services' stamp: ''!
longMessage: aStringOrText title: aString
	"Open a (long) message dialog."

	^self theme
		longMessageIn: self
		text: aStringOrText
		title: aString! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newCheckboxFor: aModel getSelected: getSel setSelected: setSel getEnabled: enabledSel label: stringOrText help: helpText
	"Answer a checkbox with the given label."

	^self theme
		newCheckboxIn: self
		for: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		label: stringOrText
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel font: aFont help: helpText
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel
		font: aFont
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newDialogPanel
	"Answer a new main dialog panel."

	^self theme
		newDialogPanelIn: self! !

!ComposableMorph methodsFor: 'services' stamp: ''!
chooseColor: aColor title: title
	"Answer the result of a color selector dialog with the given title and initial colour."

	^self theme
		chooseColorIn: self
		title: title
		color: aColor! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newCheckboxFor: aModel getSelected: getSel setSelected: setSel label: stringOrText help: helpText
	"Answer a checkbox with the given label."

	^self theme
		newCheckboxIn: self
		for: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: nil
		label: stringOrText
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newCancelButtonFor: aModel
	"Answer a new cancel button."

	^self theme
		newCancelButtonIn: self
		for: aModel! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newButtonFor: aModel getState: stateSel action: actionSel arguments: args getEnabled: enabledSel label: stringOrText help: helpText
	"Answer a new button."

	^self theme
		newButtonIn: self for: aModel
		getState: stateSel
		action: actionSel
		arguments: args
		getEnabled: enabledSel 
		label: stringOrText
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newPluggableDialogWindow: title for: contentMorph
	"Answer a new pluggable dialog with the given content."

	^self theme
		newPluggableDialogWindowIn: self
		title: title
		for: contentMorph! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newOKButton
	"Answer a new OK button."

	^self newOKButtonFor: self! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newGroupbox: aString for: control
	"Answer a groupbox with the given label and control."

	^self theme
		newGroupboxIn: self
		label: aString
		for: control! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newFuzzyLabelFor: aModel label: aString getEnabled: enabledSel
	"Answer a new fuzzy label."

	^self theme
		newFuzzyLabelIn: self
		for: aModel
		label: aString
		offset: 1
		alpha: 0.5
		getEnabled: enabledSel! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel help: helpText entryCompletion: anEntryCompletion
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel
		help: helpText
		entryCompletion: anEntryCompletion! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newYesButton
	"Answer a new Yes button."

	^self newYesButtonFor: self! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel 
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newEditableDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel addToList: addSel class: aClass default: defaultValue ghostText: ghostText getEnabled: enabledSel useIndex: useIndex help: helpText
	"Answer an editable drop list for the given model."

	^self theme
		newEditableDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		addToList: addSel
		class: aClass
		default: defaultValue
		ghostText: ghostText
		getEnabled: enabledSel
		useIndex: useIndex
		help: helpText! !

!ComposableMorph methodsFor: 'services' stamp: ''!
chooseColor
	"Answer the result of a color selector dialog ."

	^self chooseColor: Color black! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newMorphDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel help: helpText
	"Answer a morph drop list for the given model."

	^self 
		newMorphDropListFor: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: nil
		useIndex: true
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newListFor: aModel list: listSelector selected: getSelector changeSelected: setSelector icon: iconSelector getEnabled: enabledSel help: helpText
	"Answer a list for the given model."

	^self theme
		newListIn: self
		for: aModel
		list: listSelector
		selected: getSelector
		changeSelected: setSelector
		icon: iconSelector
		getEnabled: enabledSel
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newString: aStringOrText font: aFont style: aStyle
	"Answer a new embossed string."

	^self theme
		newStringIn: self
		label: aStringOrText
		font: aFont
		style: aStyle! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newCheckboxFor: aModel getSelected: getSel setSelected: setSel getEnabled: enabledSel getLabel: labelSel help: helpText
	"Answer a checkbox with the given label."

	^self theme
		newCheckboxIn: self
		for: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		getLabel: labelSel
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newMorphDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel getEnabled: enabledSel help: helpText
	"Answer a morph drop list for the given model."

	^self 
		newMorphDropListFor: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		useIndex: true
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel getEnabled: enabledSel useIndex: useIndex help: helpText
	"Answer a drop list for the given model."

	^self theme
		newDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		useIndex: useIndex
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel 
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newToolbar
	"Answer a toolbar."

	^self theme
		newToolbarIn: self! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel help: helpText
	"Answer a drop list for the given model."

	^self
		newDropListFor: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: nil
		useIndex: true
		help: helpText! !

!ComposableMorph methodsFor: 'services' stamp: ''!
chooseFont: aFont 
	"Answer the result of a font selector dialog with the given initial font."

	^self theme
		chooseFontIn: self
		title: 'Font Selector' translated
		font: aFont! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newCloseButtonFor: aModel
	"Answer a new close button."

	^self theme
		newCloseButtonIn: self
		for: aModel! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newVerticalSeparator
	"Answer a vertical separator."

	^self theme
		newVerticalSeparatorIn: self! !

!ComposableMorph methodsFor: 'services' stamp: ''!
proceed: aStringOrText
	"Open a proceed dialog."

	^self proceed: aStringOrText title: 'Proceed' translated! !

!ComposableMorph methodsFor: 'accessing' stamp: 'gvc 10/29/2006 18:25'!
defaultTitle
	"Answer the default title label for the receiver."

	^'Composite' translated! !

!ComposableMorph methodsFor: 'services' stamp: ''!
fileSave: title path: path
	"Answer the result of a file save open dialog with the given title."

	^self
		fileSave: title
		extensions: nil
		path: path! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newHSVASelector: aColor help: helpText
	"Answer a hue-saturation-volume selector with the given color."

	^self theme
		newHSVASelectorIn: self
		color: aColor
		help: helpText! !

!ComposableMorph methodsFor: 'services' stamp: ''!
deny: aStringOrText title: aString
	"Open a denial dialog."

	^self theme
		denyIn: self
		text: aStringOrText
		title: aString! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newScrollPaneFor: aMorph
	"Answer a new scroll pane morph to scroll the given morph."
	
	^self theme
		newScrollPaneIn: self
		for: aMorph! !

!ComposableMorph methodsFor: 'services' stamp: ''!
chooseColor: aColor 
	"Answer the result of a color selector dialog with the given color."

	^self theme
		chooseColorIn: self
		title: 'Colour Selector' translated
		color: aColor! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newPluggableDialogWindow
	"Answer a new pluggable dialog."

	^self
		newPluggableDialogWindow: 'Dialog'! !

!ComposableMorph methodsFor: 'services' stamp: ''!
alert: aStringOrText title: aString configure: aBlock
	"Open an alert dialog.
	Configure the dialog with the 1 argument block
	before opening modally."

	^self theme
		alertIn: self
		text: aStringOrText
		title: aString
		configure: aBlock! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newButtonLabelFor: aModel label: aString getEnabled: enabledSel
	"Answer a new button text label."

	^self theme
		newButtonLabelIn: self
		for: aModel
		label: aString
		getEnabled: enabledSel! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newOKButtonFor: aModel
	"Answer a new OK button."

	^self
		newOKButtonFor: aModel
		getEnabled: nil! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newCancelButton
	"Answer a new cancel button."

	^self newCancelButtonFor: self! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newString: aStringOrText style: aStyle
	"Answer a new embossed string."

	^self theme
		newStringIn: self
		label: aStringOrText
		font: self theme labelFont
		style: aStyle! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newHueSelector: aModel getHue: getSel setHue: setSel help: helpText
	"Answer a hue selector with the given selectors."

	^self theme
		newHueSelectorIn: self
		for: aModel
		getHue: getSel
		setHue: setSel
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newEditableDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel addToList: addSel ghostText: ghostText getEnabled: enabledSel help: helpText
	"Answer an editable drop list for the given model."

	^self theme
		newEditableDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		addToList: addSel
		class: String
		default: ''
		ghostText: ghostText
		getEnabled: enabledSel
		useIndex: false
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newGroupboxFor: control
	"Answer a plain groupbox with the given control."

	^self theme
		newGroupboxIn: self
		for: control! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newOverflowRowForAll: aCollectionOfMorphs
	"Answer a new overflow row morph that provides a drop down for
	the given contents that are unable to fit the bounds."
	
	^self theme
		newOverflowRowIn: self
		forAll: aCollectionOfMorphs! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newEmbeddedMenu
	"Answer a new menu."

	^self theme
		newEmbeddedMenuIn: self
		for: self! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newSliderFor: aModel getValue: getSel setValue: setSel help: helpText
	"Answer a slider with the given selectors."

	^self theme
		newSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: 0
		max: 1
		quantum: nil
		getEnabled: nil
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newButtonFor: aModel getState: stateSel action: actionSel arguments: args getEnabled: enabledSel getLabel: labelSel help: helpText
	"Answer a new button."

	^self theme
		newButtonIn: self for: aModel
		getState: stateSel
		action: actionSel
		arguments: args
		getEnabled: enabledSel 
		getLabel: labelSel
		help: helpText! !

!ComposableMorph methodsFor: 'services' stamp: ''!
fileOpen: title
	"Answer the result of a file open dialog with the given title."

	^self
		fileOpen: title
		extensions: nil! !

!ComposableMorph methodsFor: 'services' stamp: ''!
message: aStringOrText title: aString
	"Open a message dialog."

	^self theme
		messageIn: self
		text: aStringOrText
		title: aString! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newTabGroup: labelsAndPages
	"Answer a tab group with the given tab labels associated with pages."

	^self theme
		newTabGroupIn: self
		for: labelsAndPages! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newMorphListFor: aModel list: listSelector getSelected: getSelector setSelected: setSelector getEnabled: enabledSel help: helpText
	"Answer a morph list for the given model."

	^self theme
		newMorphListIn: self
		for: aModel
		list: listSelector
		getSelected: getSelector
		setSelected: setSelector
		getEnabled: enabledSel
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newNoButtonFor: aModel
	"Answer a new No button."

	^self theme
		newNoButtonIn: self
		for: aModel! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel font: aFont help: helpText entryCompletion: anEntryCompletion
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel
		font: aFont
		help: helpText
		entryCompletion: anEntryCompletion
! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newBasicTextEditorFor: aModel getText: getSel setText: setSel
	"Answer a text editor for the given model."

	^self
		newBasicTextEditorFor: aModel
		getText: getSel
		setText: setSel
		getEnabled: nil! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newImage: aForm size: aPoint
	"Answer a new image."

	^self theme
		newImageIn: self
		form: aForm
		size: aPoint! !

!ComposableMorph methodsFor: 'services' stamp: ''!
textEntry: aStringOrText title: aString entryText: defaultEntryText
	"Open a text entry dialog."

	^self theme
		textEntryIn: self
		text: aStringOrText
		title: aString
		entryText: defaultEntryText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newImage: aForm
	"Answer a new image."

	^self theme
		newImageIn: self
		form: aForm! !

!ComposableMorph methodsFor: 'services' stamp: ''!
chooseDropList: aStringOrText list: aList
	"Open a drop list chooser dialog."

	^self
		chooseDropList: aStringOrText
		title: 'Choose' translated
		list: aList! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newImageFor: aModel get: getSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newImageIn: self
		for: aModel
		get: getSel
		help: helpText! !

!ComposableMorph methodsFor: 'services' stamp: ''!
alert: aStringOrText title: aString
	"Open an alert dialog."

	^self
		alert: aStringOrText
		title: aString
		configure: [:d | ]! !

!ComposableMorph methodsFor: 'services' stamp: ''!
alert: aStringOrText
	"Open an alert dialog."

	^self alert: aStringOrText title: 'Alert' translated! !

!ComposableMorph methodsFor: 'instance creation' stamp: 'IgorStasenko 12/19/2012 17:25'!
newWindow
	"Answer a new window with the receiver as model,
	except when the receiver is a morph."

	|w|
	w := StandardWindow new
		model: (self isMorph ifFalse: [self]);
		title: self defaultTitle;
		addMorph: self
		fullFrame: LayoutFrame identity;
		yourself.
	self borderWidth: 0.
	^w! !

!ComposableMorph methodsFor: 'services' stamp: ''!
proceed: aStringOrText title: aString
	"Open a proceed dialog and answer true if not cancelled, false otherwise."

	^self theme
		proceedIn: self
		text: aStringOrText
		title: aString! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel
	"Answer a text editor for the given model."

	^self theme
		newAutoAcceptTextEditorIn: self
		for: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newBalloonHelp: aTextStringOrMorph for: aMorph
	"Answer a new balloon help with the given contents for aMorph
	at a given corner."

	^self theme
		newBalloonHelpIn: self
		contents: aTextStringOrMorph
		for: aMorph
		corner: #bottomLeft! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newTreeFor: aModel list: listSelector selected: getSelector changeSelected: setSelector
	"Answer a new tree morph."
	
	^self theme
		newTreeIn: self
		for: aModel
		list: listSelector
		selected: getSelector
		changeSelected: setSelector! !

!ComposableMorph methodsFor: 'services' stamp: ''!
abort: aStringOrText
	"Open an error dialog."

	^self abort: aStringOrText title: 'Error' translated! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newColorPresenterFor: aModel getColor: getSel help: helpText
	"Answer a color presenter with the given selectors."

	^self theme
		newColorPresenterIn: self
		for: aModel
		getColor: getSel
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newBracketSliderFor: aModel getValue: getSel setValue: setSel min: minValue max: maxValue quantum: quantum getEnabled: enabledSel help: helpText
	"Answer a bracket slider with the given selectors."

	^self theme
		newBracketSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: minValue
		max: maxValue
		quantum: quantum
		getEnabled: enabledSel
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newButtonFor: aModel action: actionSel label: stringOrText help: helpText
	"Answer a new button."

	^self
		newButtonFor: aModel
		getState: nil
		action: actionSel
		arguments: nil
		getEnabled: nil 
		label: stringOrText
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newOKButtonFor: aModel getEnabled: enabledSel
	"Answer a new OK button."

	^self theme
		newOKButtonIn: self
		for: aModel
		getEnabled: enabledSel! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newMorphListFor: aModel list: listSelector getSelected: getSelector setSelected: setSelector help: helpText
	"Answer a morph list for the given model."

	^self
		newMorphListFor: aModel
		list: listSelector
		getSelected: getSelector
		setSelected: setSelector
		getEnabled: nil
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newText: aStringOrText
	"Answer a new text."

	^self theme
		newTextIn: self
		text: aStringOrText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel font: aFont help: helpText
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel
		font: aFont
		help: helpText
! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel help: helpText entryCompletion: anEntryCompletion

	"Answer a text entry for the given model."

	^self theme
		newTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel 
		help: helpText
		entryCompletion: anEntryCompletion! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel getEnabled: enabledSel help: helpText
	"Answer a drop list for the given model."

	^self theme
		newDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		useIndex: true
		help: helpText! !

!ComposableMorph methodsFor: 'services' stamp: ''!
fileSave: title extensions: exts path: path
	"Answer the result of a file save dialog with the given title, extensions to show and path."

	^self theme
		fileSaveIn: self
		title: title
		extensions: exts
		path: path! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newLabelFor: aModel label: aString getEnabled: enabledSel
	"Answer a new text label."

	^self theme
		newLabelIn: self
		for: aModel
		label: aString
		getEnabled: enabledSel! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel help: helpText entryCompletion: anEntryCompletion
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel
		help: helpText
		entryCompletion: anEntryCompletion! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newNoButton
	"Answer a new No button."

	^self newNoButtonFor: self! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newLabel: aString
	"Answer a new text label."

	^self
		newLabelFor: nil
		label: aString
		getEnabled: nil! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newHSVSelector: aColor help: helpText
	"Answer a hue-saturation-volume selector with the given color."

	^self theme
		newHSVSelectorIn: self
		color: aColor
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newLabelGroup: labelsAndControls
	"Answer a morph laid out with a column of labels and a column of associated controls.
	Controls having a vResizing value of #spaceFill will
	cause their row to use #spaceFill also, otherwise #shrinkWrap."

	^self theme
		newLabelGroupIn: self
		for: labelsAndControls! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newRow: controls
	"Answer a morph laid out with a row of controls."

	^self theme
		newRowIn: self
		for: controls! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newTextEditorFor: aModel getText: getSel setText: setSel
	"Answer a text editor for the given model."

	^self
		newTextEditorFor: aModel
		getText: getSel
		setText: setSel
		getEnabled: nil! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newTitle: aString for: control
	"Answer a morph laid out with a column with a title."

	^self theme
		newTitleIn: self
		label: aString
		for: control! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newExpander: aString for: aControl
	"Answer an expander with the given label and control."

	^self theme
		newExpanderIn: self
		label: aString
		forAll: {aControl}! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newMultistateButton
	"Answer a new multistate button morph.
	To be usable it needs to have fill styles assigned to various states along
	with mouse-up/down actions."
	
	^self theme
		newMultistateButtonIn: self! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newColumn: controls
	"Answer a morph laid out with a column of controls."

	^self theme
		newColumnIn: self
		for: controls! !

!ComposableMorph methodsFor: 'services' stamp: ''!
question: aStringOrText title: aString
	"Open a question dialog and answer true if yes,
	false if no and nil if cancelled."

	^self theme
		questionIn: self
		text: aStringOrText
		title: aString! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newGroupboxForAll: controls
	"Answer a plain groupbox with the given controls."

	^self theme
		newGroupboxIn: self
		forAll: controls! !

!ComposableMorph methodsFor: 'services' stamp: ''!
fileOpen: title extensions: exts path: path preview: preview
	"Answer the result of a file open dialog with the given title, extensions to show, path and preview type."

	^self theme
		fileOpenIn: self
		title: title
		extensions: exts
		path: path
		preview: preview! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newBracketSliderFor: aModel getValue: getSel setValue: setSel min: minValue max: maxValue quantum: quantum help: helpText
	"Answer a bracket slider with the given selectors."

	^self
		newBracketSliderFor: aModel
		getValue: getSel
		setValue: setSel
		min: minValue
		max: maxValue
		quantum: quantum 
		getEnabled: nil
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newToolDockingBar
	"Answer a tool docking bar."

	^self theme
		newToolDockingBarIn: self! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel font: aFont help: helpText entryCompletion: anEntryCompletion
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel
		font: aFont
		help: helpText
		entryCompletion: anEntryCompletion! !

!ComposableMorph methodsFor: 'services' stamp: ''!
textEntry: aStringOrText title: aString
	"Open a text entry dialog."

	^self
		textEntry: aStringOrText
		title: aString
		entryText: ''! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel 
	"Answer a text editor for the given model."

	^self 
		newTextEditorFor: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel
		menu: nil! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newTextEntryFor: aModel getText: getSel setText: setSel help: helpText
	"Answer a text entry for the given model."

	^self
		newTextEntryFor: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: nil 
		help: helpText! !

!ComposableMorph methodsFor: 'services' stamp: ''!
chooseDirectory: title 
	"Answer the result of a file dialog with the given title, answer a directory."

	^self
		chooseDirectory: title
		path: nil! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newLabelFor: aModel getLabel: labelSel getEnabled: enabledSel
	"Answer a new text label."

	^self theme
		newLabelIn: self
		for: aModel
		getLabel: labelSel
		getEnabled: enabledSel! !

!ComposableMorph methodsFor: 'services' stamp: ''!
fileSave: title extensions: exts
	"Answer the result of a file save dialog with the given title."

	^self
		fileSave: title
		extensions: exts
		path: nil! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newSeparator
	"Answer an horizontal separator."

	^self theme
		newSeparatorIn: self! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newExpander: aString
	"Answer an expander with the given label."

	^self theme
		newExpanderIn: self
		label: aString
		forAll: #()! !

!ComposableMorph methodsFor: 'services' stamp: ''!
fileSave: title
	"Answer the result of a file save dialog with the given title."

	^self
		fileSave: title
		extensions: nil
		path: nil! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newCloseControlFor: aModel action: aValuable help: helpText
	"Answer a new cancel button."

	^self theme
		newCloseControlIn: self
		for: aModel
		action: aValuable
		help: helpText! !

!ComposableMorph methodsFor: 'services' stamp: ''!
chooseDropList: aStringOrText title: aString list: aList
	"Open a drop list chooser dialog."

	^self theme
		chooseDropListIn: self
		text: aStringOrText
		title: aString
		list: aList! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newSliderFor: aModel getValue: getSel setValue: setSel min: min max: max quantum: quantum getEnabled: enabledSel help: helpText
	"Answer a slider with the given selectors."

	^self theme
		newSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: min
		max: max
		quantum: quantum
		getEnabled: enabledSel
		help: helpText! !

!ComposableMorph methodsFor: 'services' stamp: ''!
question: aStringOrText
	"Open a question dialog."

	^self question: aStringOrText title: 'Question' translated! !

!ComposableMorph methodsFor: 'services' stamp: ''!
textEntry: aStringOrText
	"Open a text entry dialog."

	^self textEntry: aStringOrText title: 'Entry' translated! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newListFor: aModel list: listSelector selected: getSelector changeSelected: setSelector getEnabled: enabledSel help: helpText
	"Answer a list for the given model."

	^self theme
		newListIn: self
		for: aModel
		list: listSelector
		selected: getSelector
		changeSelected: setSelector
		getEnabled: enabledSel
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newGroupbox: aString forAll: controls
	"Answer a groupbox with the given label and controls."

	^self theme
		newGroupboxIn: self
		label: aString
		forAll: controls! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newString: aStringOrText
	"Answer a new embossed string."

	^self theme
		newStringIn: self
		label: aStringOrText
		font: self theme labelFont
		style: #plain! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newExpander: aString forAll: controls
	"Answer an expander with the given label and controls."

	^self theme
		newExpanderIn: self
		label: aString
		forAll: controls! !

!ComposableMorph methodsFor: 'services' stamp: ''!
questionWithoutCancel: aStringOrText title: aString
	"Open a question dialog and answer true if yes,
	false if no and nil if cancelled."

	^self theme
		questionWithoutCancelIn: self
		text: aStringOrText
		title: aString! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newButtonLabel: aString
	"Answer a new button text label."

	^self
		newButtonLabelFor: nil
		label: aString
		getEnabled: nil! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newToolbar: controls
	"Answer a toolbar with the given controls."

	^self theme
		newToolbarIn: self
		for: controls! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newToolSpacer
	"Answer a tool spacer."

	^self theme
		newToolSpacerIn: self! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newFuzzyLabel: aString
	"Answer a new fuzzy label."

	^self theme
		newFuzzyLabelIn: self
		for: nil
		label: aString
		offset: 1
		alpha: 0.5
		getEnabled: nil! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newRow
	"Answer a morph laid out as a row."

	^self theme
		newRowIn: self
		for: #()! !

!ComposableMorph methodsFor: 'services' stamp: ''!
fileOpen: title extensions: exts
	"Answer the result of a file open dialog with the given title and extensions to show."

	^self
		fileOpen: title
		extensions: exts
		path: nil! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newStack
	"Answer a morph laid out as a stack."

	^self theme
		newStackIn: self
		for: #()! !

!ComposableMorph methodsFor: 'initialization' stamp: 'gvc 10/30/2006 09:39'!
defaultBorderColor
	"Answer the default border color/fill style for the receiver"
	
	^#inset! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newFuzzyLabelFor: aModel label: aString offset: offset alpha: alpha getEnabled: enabledSel
	"Answer a new fuzzy label."

	^self theme
		newFuzzyLabelIn: self
		for: aModel
		label: aString
		offset: offset
		alpha: alpha
		getEnabled: enabledSel! !

!ComposableMorph methodsFor: 'services' stamp: ''!
chooseFileName: title extensions: exts path: path preview: preview
	"Answer the result of a file name chooser dialog with the given title, extensions
	to show, path and preview type."

	^self theme
		chooseFileNameIn: self
		title: title
		extensions: exts
		path: path
		preview: preview! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newRadioButtonFor: aModel getSelected: getSel setSelected: setSel label: stringOrText help: helpText
	"Answer a checkbox (radio button appearance) with the given label."

	^self
		newRadioButtonFor: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: nil
		label: stringOrText
		help: helpText! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newYesButtonFor: aModel
	"Answer a new yes button."

	^self theme
		newYesButtonIn: self
		for: aModel! !

!ComposableMorph methodsFor: 'controls' stamp: ''!
newToolbarHandle
	"Answer a toolbar handle."

	^self theme
		newToolbarHandleIn: self! !

!ComposableMorph methodsFor: 'services' stamp: ''!
abort: aStringOrText title: aString
	"Open an error dialog."

	^self theme
		abortIn: self
		text: aStringOrText
		title: aString! !

!CompositeBorder commentStamp: 'gvc 5/18/2007 13:28'!
Border supporting multiple "sub-borders".!
!CompositeBorder methodsFor: 'comparing' stamp: 'gvc 5/18/2007 13:29'!
hash
	"Since #= is overridden."
	
	^super hash bitXor: self borders hash! !

!CompositeBorder methodsFor: 'comparing' stamp: 'gvc 3/29/2007 17:32'!
= aBorderStyle
	"Check the sub-borders too"
	
	^super = aBorderStyle and: [
		self borders = aBorderStyle borders]! !

!CompositeBorder methodsFor: 'accessing' stamp: 'gvc 3/12/2007 11:15'!
borders
	"Answer the value of borders"

	^ borders! !

!CompositeBorder methodsFor: 'testing' stamp: 'gvc 3/14/2007 10:32'!
isComposite
	"Answer true."

	^true! !

!CompositeBorder methodsFor: 'accessing' stamp: 'gvc 3/12/2007 11:15'!
borders: anObject
	"Set the value of borders"

	borders := anObject! !

!CompositeBorder methodsFor: 'drawing' stamp: 'gvc 3/14/2007 10:47'!
frameRectangle: aRectangle on: aCanvas
	"Draw each border in turn."
	
	|r|
	r := aRectangle.
	self borders do: [:b |
		b frameRectangle: r on: aCanvas.
		r := r insetBy: b width]! !

!CompositeBorder methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/6/2015 18:33'!
asAthensPaintOn: anAthensCanvas
	^ AthensCompositeStrokePaint new fromBorderStyles: borders on: anAthensCanvas! !

!CompositeBorder methodsFor: 'accessing' stamp: 'gvc 3/12/2007 12:13'!
colorsAtCorners
	"Return the colors of the first border."
	
	^self borders first colorsAtCorners! !

!CompositeFillStyle commentStamp: 'gvc 9/23/2008 12:05'!
Fillstyle supporting compositing of multiple sub-fillstyles.!
!CompositeFillStyle methodsFor: 'testing' stamp: 'gvc 3/20/2008 23:07'!
isTransparent
	"Answer whether all of the composited fill styles are transparent."

	^self fillStyles allSatisfy: [:fs | fs isTransparent]! !

!CompositeFillStyle methodsFor: 'converting' stamp: 'gvc 5/27/2008 21:02'!
asColor
	"Answer a colour that is a best match to the receiver.
	Simple approach for the moment."
	
	^self fillStyles
		ifEmpty: [Color transparent]
		ifNotEmpty: [self fillStyles last asColor]! !

!CompositeFillStyle methodsFor: 'accessing' stamp: 'gvc 5/27/2008 21:01'!
direction
	"Answer an effective direction of any oriented fill styles.
	Answer the bottom-right maxima."

	|dir|
	dir := nil.
	self fillStyles reverseDo: [:fs |
		fs isOrientedFill ifTrue: [
			dir := dir
				ifNil: [fs direction]
				ifNotNil: [dir max: fs direction]]].
	^dir ifNil: [0@0] "just in case"! !

!CompositeFillStyle methodsFor: 'action' stamp: 'gvc 3/21/2008 17:25'!
changeOriginIn: aMorph event: evt
	"Interactively change the origin of the receiver"
	| handle |
	handle := HandleMorph new forEachPointDo:[:pt|
		self origin: pt.
		aMorph changed].
	evt hand attachMorph: handle.
	handle startStepping.! !

!CompositeFillStyle methodsFor: 'accessing' stamp: 'gvc 5/27/2008 21:01'!
direction: aPoint
	"Change the effective direction of any oriented fill styles."

	|delta|
	delta := aPoint - self direction.
	self fillStyles reverseDo: [:fs |
		fs isOrientedFill ifTrue: [
			fs direction: fs direction + delta]]! !

!CompositeFillStyle methodsFor: 'accessing' stamp: 'gvc 5/27/2008 21:01'!
origin
	"Answer an effective origin of any oriented fill styles.
	Answer the top-left minima."

	|origin|
	origin := nil.
	self fillStyles reverseDo: [:fs |
		fs isOrientedFill ifTrue: [
			origin := origin
				ifNil: [fs origin]
				ifNotNil: [origin min: fs origin]]].
	^origin ifNil: [0@0] "just in case"! !

!CompositeFillStyle methodsFor: 'testing' stamp: 'gvc 3/20/2008 23:07'!
isTranslucent
	"Answer whether all of the composited fill styles are transparent."

	^self fillStyles allSatisfy: [:fs | fs isTranslucent]! !

!CompositeFillStyle methodsFor: 'accessing' stamp: 'gvc 5/27/2008 21:00'!
normal
	"Answer an effective normal of any oriented fill styles.
	Answer the top-left minima (probably not an accurate assumption)."

	|normal|
	normal := nil.
	self fillStyles reverseDo: [:fs |
		fs isOrientedFill ifTrue: [
			normal := normal
				ifNil: [fs normal]
				ifNotNil: [normal min: fs normal]]].
	^normal ifNil: [0@0] "just in case"! !

!CompositeFillStyle methodsFor: 'accessing' stamp: 'gvc 5/27/2008 21:01'!
normal: aPoint
	"Change the effective normal of any oriented fill styles."

	|delta|
	aPoint ifNil: [
		self fillStyles reverseDo: [:fs |
		fs isOrientedFill ifTrue: [
			fs normal: nil]].
		^self].
	delta := aPoint - self normal.
	self fillStyles reverseDo: [:fs |
		fs isOrientedFill ifTrue: [
			fs normal: fs normal + delta]]! !

!CompositeFillStyle methodsFor: 'accessing' stamp: 'gvc 5/27/2008 21:01'!
origin: aPoint
	"Change the effective origin of any oriented fill styles."

	|delta|
	delta := aPoint - self origin.
	self fillStyles reverseDo: [:fs |
		fs isOrientedFill ifTrue: [
			fs origin: fs origin + delta]]
	! !

!CompositeFillStyle methodsFor: 'adding' stamp: 'StephaneDucasse 10/26/2014 11:15'!
addFillStyleMenuItems: aMenu hand: aHand from: aMorph
	"Add the items for changing the current fill style of the receiver"
	aMenu add: 'change origin' target: self selector: #changeOriginIn:event: argument: aMorph.
	aMenu add: 'change orientation' target: self selector: #changeOrientationIn:event: argument: aMorph.! !

!CompositeFillStyle methodsFor: 'accessing' stamp: 'gvc 3/20/2008 23:05'!
fillStyles
	"Answer the value of fillStyles. The first item in the collection is considered
	to be topmost when rendered."

	^ fillStyles! !

!CompositeFillStyle methodsFor: 'initialization' stamp: 'gvc 3/20/2008 23:02'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		fillStyles: OrderedCollection new! !

!CompositeFillStyle methodsFor: 'testing' stamp: 'gvc 3/20/2008 23:04'!
isCompositeFill
	"Answer whether the receiver is a composite fill.
	True for kinds of the receiver's class."

	^true! !

!CompositeFillStyle methodsFor: 'testing' stamp: 'gvc 5/27/2008 20:38'!
isOrientedFill
	"Answer whether any of the composited fill styles are oriented."

	self fillStyles reverseDo: [:fs |
		fs isOrientedFill ifTrue: [^true]].
	^false! !

!CompositeFillStyle methodsFor: 'action' stamp: 'gvc 3/21/2008 17:25'!
changeOrientationIn: aMorph event: evt
	"Interactively change the origin of the receiver"
	| handle |
	handle := HandleMorph new forEachPointDo:[:pt|
		self direction: pt - self origin.
		self normal: nil.
		aMorph changed].
	evt hand attachMorph: handle.
	handle startStepping.! !

!CompositeFillStyle methodsFor: 'accessing' stamp: 'gvc 3/21/2008 16:24'!
fillStyles: aCollection
	"Set the value of fillStyles. The first item in the collection is considered
	to be topmost when rendering."

	fillStyles := aCollection! !

!CompositeFillStyle methodsFor: 'testing' stamp: 'gvc 5/27/2008 20:37'!
isGradientFill
	"Answer whether any of the composited fill styles are gradients."

	self fillStyles reverseDo: [:fs |
		fs isGradientFill ifTrue: [^true]].
	^false! !

!CompositeFillStyle methodsFor: 'action' stamp: 'gvc 5/27/2008 20:32'!
fillRectangle: aRectangle on: aCanvas
	"Fill the given rectangle on the given canvas with the receiver.
	Render from bottom to top."
	
	self fillStyles do: [:fs |
		fs fillRectangle: aRectangle on: aCanvas]! !

!CompositeFillStyle methodsFor: '*Athens-Morphic' stamp: 'IgorStasenko 10/9/2012 19:10'!
asAthensPaintOn: aCanvas 
	^ AthensCompositePaint new fromFillStyles: fillStyles on: aCanvas! !

!CompositeFillStyle class methodsFor: 'build' stamp: 'gvc 3/21/2008 16:49'!
fillStyles: aCollection
	"Answer a new instance of the receiver with the specfied fill styles."

	^self new fillStyles: aCollection! !

!CompositeTransform commentStamp: '<historical>'!
A composite transform provides the effect of several levels of coordinate transformations.!
!CompositeTransform methodsFor: 'testing' stamp: 'di 3/4/98 19:18'!
isIdentity
	^ globalTransform isIdentity and: [localTransform isIdentity]! !

!CompositeTransform methodsFor: 'converting' stamp: 'ar 11/2/1998 20:00'!
asCompositeTransform
	^self! !

!CompositeTransform methodsFor: 'accessing' stamp: 'di 10/26/1999 17:06'!
angle
	^ localTransform angle + globalTransform angle! !

!CompositeTransform methodsFor: 'accessing' stamp: 'di 10/26/1999 15:40'!
offset
	^ (self localPointToGlobal: 0@0) negated! !

!CompositeTransform methodsFor: 'transforming points' stamp: 'ar 11/2/1998 16:39'!
localPointToGlobal: aPoint
	"Transform aPoint from global coordinates into local coordinates"
	^globalTransform localPointToGlobal:
		(localTransform localPointToGlobal: aPoint)! !

!CompositeTransform methodsFor: 'initialization' stamp: 'di 10/26/1999 17:08'!
composedWith: aTransform
	"Return a new transform that has the effect of transforming points first by the receiver and then by the argument."

	self isIdentity ifTrue: [^ aTransform].
	aTransform isIdentity ifTrue: [^ self].
	^ CompositeTransform new globalTransform: self
							localTransform: aTransform! !

!CompositeTransform methodsFor: 'initialization' stamp: 'lr 7/4/2009 10:42'!
globalTransform: gt localTransform: lt 
	globalTransform := gt.
	localTransform := lt! !

!CompositeTransform methodsFor: 'testing' stamp: 'di 3/4/98 19:18'!
isPureTranslation
	^ globalTransform isPureTranslation and: [localTransform isPureTranslation]! !

!CompositeTransform methodsFor: 'transformations' stamp: 'di 10/1/1998 13:51'!
invert: aPoint
	^ globalTransform invert: (localTransform invert: aPoint)! !

!CompositeTransform methodsFor: 'converting' stamp: 'di 10/26/1999 17:03'!
asMorphicTransform
	"Squash a composite transform down to a simple one"
	^ MorphicTransform offset: self offset angle: self angle scale: self scale! !

!CompositeTransform methodsFor: 'testing' stamp: 'ar 11/2/1998 20:00'!
isCompositeTransform
	^true! !

!CompositeTransform methodsFor: 'accessing' stamp: 'di 10/26/1999 15:39'!
scale
	^ localTransform scale * globalTransform scale! !

!CompositeTransform methodsFor: 'transformations' stamp: 'di 3/4/98 19:20'!
transform: aPoint
	^ localTransform transform: (globalTransform transform: aPoint)! !

!CompositeTransform methodsFor: 'accessing' stamp: 'ar 11/2/1998 19:45'!
inverseTransformation
	"Return the inverse transformation of the receiver"
	^self species new
		globalTransform: localTransform inverseTransformation
		localTransform: globalTransform inverseTransformation! !

!CompositeTransform methodsFor: 'transforming points' stamp: 'ar 11/2/1998 16:39'!
globalPointToLocal: aPoint
	"Transform aPoint from global coordinates into local coordinates"
	^localTransform globalPointToLocal:
		(globalTransform globalPointToLocal: aPoint)! !

!CompositeTransform methodsFor: 'converting' stamp: 'ar 11/2/1998 19:56'!
asMatrixTransform2x3
	^globalTransform asMatrixTransform2x3
		composedWithLocal: localTransform asMatrixTransform2x3! !

!CompositeTransform class methodsFor: 'instance creation' stamp: 'ls 3/19/2000 16:44'!
globalTransform: gt localTransform: lt
	^self new globalTransform: gt localTransform: lt! !

!CompositionScanner commentStamp: 'nice 10/6/2013 23:24'!
A CompositionScanner measures text and determines where line breaks.
Given a rectangular zone on input, it is used to split text in horizontal lines, and produce information about those lines on output (at which index a line starts/stops, which vertical space does the line require, which horizontal space if left for adjusting inter-word spacing, etc...)

Instance Variables
	baseline:		<Number>
	baselineAtSpace:		<Number>
	lastBreakIsNotASpace:		<Boolean>
	lineHeight:		<Number>
	lineHeightAtSpace:		<Number>
	nextIndexAfterLineBreak:		<Integer>
	spaceIndex:		<Integer>
	spaceX:		<Number>

baseline
	- the distance between top of line and the base line (that is the bottom of latin characters abcdehiklmnorstuvwx in most fonts)

baselineAtSpace
	- memorize the baseline at last encountered space or other breakable character.
	This is necessary because the CompositionScanner wants to break line at a breakable character.
	If a word layout overflows the right margin, the scanner has to roll back and restore the line state to last encountered breakable character.

lastBreakIsNotASpace
	- indicates that the last breakable character was not a space.
	This is necessary because handling a line break at a space differs from non space.
	If line break occurs on space, the space won't be displayed in next line.
	If it's another breakable character, it has to be displayed on next line.

lineHeight
	- the total line height from top to bottom, including inter-line spacing.

lineHeightAtSpace
	- the line height at last encountered space or other breakable character.
	See baselineAtSpace for explanation.

nextIndexAfterLineBreak
	- the index of character after the last line break that was encountered.

spaceIndex
	- the index of last space or other breakable character that was encountered

spaceX
	- the distance from left of composition zone to left of last encountered space or other breakable character 
	See baselineAtSpace for explanation.

Note: if a line breaks on a space, a linefeed or a carriage return, then the space, linefeed or carriage return is integrated in the line.
If there is a carriage return - linefeed pair, the pair is integrated to the line as if it were a single line break for compatibility with legacy software.!
!CompositionScanner methodsFor: 'testing' stamp: 'cmm 6/13/2010 20:50'!
canComputeDefaultLineHeight
	^ rightMargin notNil! !

!CompositionScanner methodsFor: 'stop conditions' stamp: 'tween 4/6/2007 11:15'!
tab
	"Advance destination x according to tab settings in the paragraph's 
	textStyle. Answer whether the character has crossed the right edge of 
	the composition rectangle of the paragraph."

	pendingKernX := 0.
	destX := textStyle
				nextTabXFrom: destX leftMargin: leftMargin rightMargin: rightMargin.
	destX > rightMargin ifTrue:	[^self crossedX].
	lastIndex := lastIndex + 1.
	^false
! !

!CompositionScanner methodsFor: 'stop conditions' stamp: 'nice 10/8/2013 22:32'!
wrapAtLastBreakable
	"Wrap the line before last encountered breakable character."
	pendingKernX := 0.
	nextIndexAfterLineBreak := spaceIndex.
	line stop: spaceIndex - 1.
	lineHeight := lineHeightAtSpace.
	baseline := baselineAtSpace.
	line paddingWidth: rightMargin - spaceX.
	line internalSpaces: spaceCount.
	^true! !

!CompositionScanner methodsFor: 'stop conditions' stamp: 'nice 9/29/2013 16:12'!
columnBreak

	"Answer true. Set up values for the text line interval currently being 
	composed."

	pendingKernX := 0.
	line stop: lastIndex.
	spaceX := destX.
	lastBreakIsNotASpace := false.
	line paddingWidth: rightMargin - spaceX.
	^true! !

!CompositionScanner methodsFor: 'stop conditions' stamp: 'nice 10/6/2013 21:20'!
space
	"Record left x and character index of the space character just encountered. 
	Used for wrap-around. Answer whether the character has crossed the 
	right edge of the composition rectangle of the paragraph."

	spaceX := destX.
	spaceIndex := lastIndex.
	lineHeightAtSpace := lineHeight.
	baselineAtSpace := baseline.
	spaceCount := spaceCount + 1.
	lastBreakIsNotASpace := false.
	destX + spaceWidth > rightMargin ifTrue:[^self crossedX].
	destX := spaceX + spaceWidth + kern.
	lastIndex := lastIndex + 1.
	^false
! !

!CompositionScanner methodsFor: 'scanning' stamp: 'nice 10/22/2013 20:50'!
composeFrom: startIndex inRectangle: lineRectangle
	firstLine: firstLine leftSide: leftSide rightSide: rightSide
	"Answer an instance of TextLineInterval that represents the next line in the paragraph."
	| runLength stopCondition |
	"Set up margins"
	leftMargin := lineRectangle left.
	leftSide ifTrue: [leftMargin := leftMargin +
						(firstLine ifTrue: [textStyle firstIndent]
								ifFalse: [textStyle restIndent])].
	destX := spaceX := leftMargin.
	rightMargin := lineRectangle right.
	rightSide ifTrue: [rightMargin := rightMargin - textStyle rightIndent].
	lastIndex := startIndex.	"scanning sets last index"
	destY := lineRectangle top.
	lineHeight := baseline := 0.  "Will be increased by setFont"
	line := (TextLine start: lastIndex stop: 0 internalSpaces: 0 paddingWidth: 0)
				rectangle: lineRectangle.
	self setStopConditions.	"also sets font"
	runLength := text runLengthFor: startIndex.
	runStopIndex := (lastIndex := startIndex) + (runLength - 1).
	nextIndexAfterLineBreak := spaceCount := 0.
	lastBreakIsNotASpace := false.
	self handleIndentation.
	leftMargin := destX.
	line leftMargin: leftMargin.

	[stopCondition := self scanCharactersFrom: lastIndex to: runStopIndex
		in: text string rightX: rightMargin.
	"See setStopConditions for stopping conditions for composing."
	self perform: stopCondition] whileFalse.

	^ line
		lineHeight: lineHeight + textStyle leading
		baseline: baseline + textStyle leading! !

!CompositionScanner methodsFor: 'scanning' stamp: 'tpr 9/25/2013 13:41'!
computeDefaultLineHeight
	"Compute the default line height for a potentially empty text"
	rightMargin notNil
		ifTrue: [lastIndex := 1.
			self setFont.
			^ lineHeight + textStyle leading]
		ifFalse: [^textStyle lineGrid]! !

!CompositionScanner methodsFor: 'accessing' stamp: 'nice 10/2/2013 02:23'!
doesTheLineBreaksAfterLastChar
	^nextIndexAfterLineBreak > text size! !

!CompositionScanner methodsFor: 'initialize' stamp: 'nice 10/6/2013 21:41'!
initialize
	wantsColumnBreaks := false.
	super initialize! !

!CompositionScanner methodsFor: 'accessing' stamp: 'ar 1/8/2000 14:35'!
rightX
	"Meaningful only when a line has just been composed -- refers to the 
	line most recently composed. This is a subtrefuge to allow for easy 
	resizing of a composition rectangle to the width of the maximum line. 
	Useful only when there is only one line in the form or when each line 
	is terminated by a carriage return. Handy for sizing menus and lists."

	^spaceX! !

!CompositionScanner methodsFor: 'text attributes' stamp: 'ar 1/8/2000 14:36'!
setActualFont: aFont
	"Keep track of max height and ascent for auto lineheight"
	| descent |
	super setActualFont: aFont.
	lineHeight == nil
		ifTrue: [descent := font descent.
				baseline := font ascent.
				lineHeight := baseline + descent]
		ifFalse: [descent := lineHeight - baseline max: font descent.
				baseline := baseline max: font ascent.
				lineHeight := lineHeight max: baseline + descent]! !

!CompositionScanner methodsFor: 'stop conditions' stamp: 'ar 1/9/2000 13:54'!
endOfRun
	"Answer true if scanning has reached the end of the paragraph. 
	Otherwise step conditions (mostly install potential new font) and answer 
	false."

	| runLength |
	lastIndex = text size
	ifTrue:	[line stop: lastIndex.
			spaceX := destX.
			line paddingWidth: rightMargin - destX.
			^true]
	ifFalse:	[runLength := (text runLengthFor: (lastIndex := lastIndex + 1)).
			runStopIndex := lastIndex + (runLength - 1).
			self setStopConditions.
			^false]
! !

!CompositionScanner methodsFor: 'private' stamp: 'nice 10/5/2013 21:02'!
setStopConditions
	"Set the font and the stop conditions for the current run."
	
	self setFont.
	stopConditions := wantsColumnBreaks == true
		ifTrue: [ColumnBreakStopConditions]
		ifFalse: [CompositionStopConditions]! !

!CompositionScanner methodsFor: 'stop conditions' stamp: 'nice 10/8/2013 22:32'!
wrapAtLastSpace
	"Wrap the line before last encountered space"
	
	pendingKernX := 0.
	nextIndexAfterLineBreak := spaceIndex + 1.
	alignment = Justified ifTrue: [
		"gobble all subsequent spaces"
		[nextIndexAfterLineBreak <= text size and: [(text at: nextIndexAfterLineBreak) == Space]]
			whileTrue: [nextIndexAfterLineBreak := nextIndexAfterLineBreak + 1]].
	
	line stop: nextIndexAfterLineBreak - 1.
	lineHeight := lineHeightAtSpace.
	baseline := baselineAtSpace.

	["remove the space at which we break..."
	spaceCount := spaceCount - 1.
	spaceIndex := spaceIndex - 1.

	"...and every other spaces preceding the one at which we wrap.
		Double space after punctuation, most likely."
	spaceCount >= 1 and: [(text at: spaceIndex) = Space]]
		whileTrue:
			["Account for backing over a run which might
				change width of space."
			font := text fontAt: spaceIndex withStyle: textStyle.
			spaceX := spaceX - (font widthOf: Space)].
	line paddingWidth: rightMargin - spaceX.
	line internalSpaces: spaceCount.
	^true! !

!CompositionScanner methodsFor: 'private' stamp: 'nice 10/21/2013 23:22'!
placeEmbeddedObject: anchoredMorph
	| w descent |
	"Workaround: The following should really use #textAnchorType"
	anchoredMorph relativeTextAnchorPosition ifNotNil:[^true].
	w := anchoredMorph width.
	(destX + w > rightMargin and: [(leftMargin + w) <= rightMargin or: [lastIndex > line first]])
		ifTrue: ["Won't fit, but would on next line"
				^ false].
	destX := destX + w + kern.
	descent := lineHeight - baseline.
	baseline := baseline max: anchoredMorph height.
	lineHeight := baseline + descent.
	^ true! !

!CompositionScanner methodsFor: '*Multilingual-OtherLanguages' stamp: 'nice 9/29/2013 16:12'!
registerBreakableIndex
	"Record left x and character index of the line-wrappable point. 
	Used for wrap-around in eastern Asian languages."

	spaceX := destX.
	lineHeightAtSpace := lineHeight.
	baselineAtSpace := baseline.
	spaceIndex := lastIndex.
	lastBreakIsNotASpace := true.! !

!CompositionScanner methodsFor: 'initialize' stamp: 'RAA 5/7/2001 10:11'!
wantsColumnBreaks: aBoolean

	wantsColumnBreaks := aBoolean! !

!CompositionScanner methodsFor: 'stop conditions' stamp: 'nice 10/8/2013 22:42'!
crossedX
	"There is a word that has fallen across the right edge of the composition 
	rectangle. This signals the need for wrapping which is done to the last 
	space that was encountered, as recorded by the space stop condition,
	or any other breakable character if the language permits so."

	pendingKernX := 0.
	
	lastBreakIsNotASpace ifTrue:
		["In some languages line break is possible before a non space."
		^self wrapAtLastBreakable].
	 
	spaceCount >= 1 ifTrue:
		["The common case. there is a space on the line."
		^self wrapAtLastSpace].
	
	"Neither internal nor trailing spaces -- almost never happens."
	self advanceIfFirstCharOfLine.
	^self wrapHere! !

!CompositionScanner methodsFor: 'stop conditions' stamp: 'nice 10/8/2013 22:43'!
wrapHere
	"Wrap the line before current character."
	pendingKernX := 0.
	nextIndexAfterLineBreak := lastIndex.
	lastIndex := lastIndex - 1.
	spaceX := destX.
	line paddingWidth: rightMargin - destX.
	line stop: (lastIndex max: line first).
	^true! !

!CompositionScanner methodsFor: 'stop conditions' stamp: 'nice 10/2/2013 02:21'!
cr
	"Answer true. Set up values for the text line interval currently being 
	composed."

	pendingKernX := 0.
	(lastIndex < text size and: [(text at: lastIndex) = CR and: [(text at: lastIndex+1) = Character lf]]) ifTrue: [lastIndex := lastIndex + 1].
	line stop: lastIndex.
	nextIndexAfterLineBreak := lastIndex + 1.
	spaceX := destX.
	lastBreakIsNotASpace := false.
	line paddingWidth: rightMargin - spaceX.
	^true! !

!CompoundTextConverterState commentStamp: '<historical>'!
This represents the state of CompoundTextConverter.!
!CompoundTextConverterState methodsFor: 'accessing' stamp: 'yo 8/23/2002 21:29'!
g1Size

	^ g1Size
! !

!CompoundTextConverterState methodsFor: 'accessing' stamp: 'yo 8/23/2002 21:30'!
g1Leading

	^ g1Leading
! !

!CompoundTextConverterState methodsFor: 'accessing' stamp: 'yo 8/23/2002 14:37'!
g0Size: g0 g1Size: g1 g0Leading: g0l g1Leading: g1l charSize: cSize streamPosition: pos

	g0Size := g0.
	g1Size := g1.
	g0Leading := g0l.
	g1Leading := g1l.
	charSize := cSize.
	streamPosition := pos.
! !

!CompoundTextConverterState methodsFor: 'accessing' stamp: 'yo 8/23/2002 21:30'!
charSize

	^ charSize
! !

!CompoundTextConverterState methodsFor: 'accessing' stamp: 'yo 9/16/2002 20:40'!
streamPosition: pos

	streamPosition := pos.
! !

!CompoundTextConverterState methodsFor: 'accessing' stamp: 'yo 9/16/2002 20:41'!
g0Leading: l

	g0Leading := l.
! !

!CompoundTextConverterState methodsFor: 'accessing' stamp: 'yo 9/16/2002 20:41'!
charSize: s

	charSize := s.
! !

!CompoundTextConverterState methodsFor: 'accessing' stamp: 'yo 8/23/2002 21:29'!
g0Size

	^ g0Size
! !

!CompoundTextConverterState methodsFor: 'accessing' stamp: 'yo 9/16/2002 20:41'!
g0Size: s

	g0Size := s.
! !

!CompoundTextConverterState methodsFor: 'accessing' stamp: 'yo 9/16/2002 20:41'!
g1Size: s

	g1Size := s.
! !

!CompoundTextConverterState methodsFor: 'accessing' stamp: 'yo 8/23/2002 21:29'!
g0Leading

	^ g0Leading
! !

!CompoundTextConverterState methodsFor: 'printing' stamp: 'yo 11/4/2002 12:31'!
printOn: aStream

	aStream nextPut: $(;
		nextPutAll: g0Size printString; space;
		nextPutAll: g1Size printString; space;
		nextPutAll: g0Leading printString; space;
		nextPutAll: g1Leading printString; space;
		nextPutAll: charSize printString; space;
		nextPutAll: streamPosition printString.
	aStream nextPut: $).
! !

!CompoundTextConverterState methodsFor: 'accessing' stamp: 'yo 8/23/2002 21:30'!
streamPosition

	^ streamPosition
! !

!CompoundTextConverterState methodsFor: 'accessing' stamp: 'yo 9/16/2002 20:41'!
g1Leading: l

	g1Leading := l.
! !

!CompoundTextConverterState class methodsFor: 'instance creation' stamp: 'yo 8/19/2002 17:04'!
g0Size: g0 g1Size: g1 g0Leading: g0l g1Leading: g1l charSize: cSize streamPosition: pos

	^ (self new)
		g0Size: g0
		g1Size: g1
		g0Leading: g0l
		g1Leading: g1l
		charSize: cSize
		streamPosition: pos
	; yourself.
! !

!CompressedBoundaryShape commentStamp: '<historical>'!
This class represents a very compact representation of a boundary shape. It consists of a number of compressed arrays that can be handled by the balloon engine directly. Due to this, there are certain restrictions (see below). Boundaries are always represented by three subsequent points that define a quadratic bezier segment. It is recommended that for straight line segments the control point is set either to the previous or the next point.

Instance variables:
	points		<PointArray | ShortPointArray>	Point storage area
	leftFills		<ShortRunArray>	Containing the "left" fill index of each segment
	rightFills	<ShortRunArray>	Containing the "right" fill index of each segment
	lineWidths	<ShortRunArray>	Containing the line width of each segment
	lineFills		<ShortRunArray>	Containing the line fill (e.g., line color) of each segment
	fillStyles	<Collections>			Contains the actual fill styles referenced by the indexes

RESTRICTIONS:
None of the ShortRunArrays may contain a run of length Zero.
Also, due to the use of ShortRunArrays 
	a) you cannot have more than 32768 different fill styles
	b) you cannot have a line width that exceeds 32768
In case you have trouble with a), try to merge some of the fills into one. You might do so by converting colors to 32bit pixel values. In case you have trouble with b) you might change the general resolution of the compressed shape to have less accuracy.
!
!CompressedBoundaryShape methodsFor: 'accessing' stamp: 'ar 11/3/1998 21:55'!
leftFills
	^leftFills! !

!CompressedBoundaryShape methodsFor: 'accessing' stamp: 'ls 10/10/1999
13:52'!
bounds
	| min max width |
	points isEmpty ifTrue:[^0@0 corner: 1@1].
	min := max := points first.
	points do:[:pt|
		min := min min: pt.
		max := max max: pt
	].
	width := 0.
	lineWidths valuesDo:[:w| width := width max: w].
	^(min corner: max) insetBy: (width negated asPoint)! !

!CompressedBoundaryShape methodsFor: 'enumerating' stamp: 'ar 11/9/1998 14:10'!
segmentsDo: aBlock
	"Enumerate all segments in the receiver and execute aBlock"
	| p1 p2 p3 |
	1 to: points size by: 3 do:[:i|
		p1 := points at: i.
		p2 := points at: i+1.
		p3 := points at: i+2.
		(p1 = p2 or:[p2 = p3]) ifTrue:[
			aBlock value: (LineSegment from: p1 to: p3).
		] ifFalse:[
			aBlock value: (Bezier2Segment from: p1 via: p2 to: p3).
		].
	].! !

!CompressedBoundaryShape methodsFor: 'accessing' stamp: 'ar 11/3/1998 21:55'!
fillStyles
	^fillStyles! !

!CompressedBoundaryShape methodsFor: 'editing' stamp: 'ar 11/12/1998 21:12'!
collectFills: aBlock
	fillStyles := fillStyles collect: aBlock.! !

!CompressedBoundaryShape methodsFor: 'editing' stamp: 'ar 11/12/1998 21:11'!
copyAndCollectFills: aBlock
	^self copy collectFills: aBlock! !

!CompressedBoundaryShape methodsFor: 'accessing' stamp: 'PeterHugossonMiller 9/3/2009 01:01'!
segments
	"Return all the segments in the receiver"
	| out |
	out := Array new writeStream.
	self segmentsDo:[:seg| out nextPut: seg].
	^out contents! !

!CompressedBoundaryShape methodsFor: 'accessing' stamp: 'ar 11/4/1998 13:50'!
numSegments
	^points size // 3! !

!CompressedBoundaryShape methodsFor: 'accessing' stamp: 'ar 11/3/1998 21:55'!
lineFills
	^lineFills! !

!CompressedBoundaryShape methodsFor: 'accessing' stamp: 'ar 11/3/1998 21:55'!
lineWidths
	^lineWidths! !

!CompressedBoundaryShape methodsFor: 'private' stamp: 'ar 11/3/1998 18:03'!
setPoints: pointList leftFills: leftFillList rightFills: rightFillList fillStyles: fillStyleList lineWidths: lineWidthList lineFills: lineFillList
	points := pointList.
	leftFills := leftFillList.
	rightFills := rightFillList.
	lineWidths := lineWidthList.
	lineFills := lineFillList.
	fillStyles := fillStyleList.! !

!CompressedBoundaryShape methodsFor: 'accessing' stamp: 'ar 11/3/1998 21:55'!
rightFills
	^rightFills! !

!CompressedBoundaryShape methodsFor: 'morphing' stamp: 'ar 9/3/1999 17:19'!
morphFrom: srcShape to: dstShape at: ratio
	| scale unscale srcPoints dstPoints pt1 pt2 x y |
	scale := (ratio * 1024) asInteger.
	scale < 0 ifTrue:[scale := 0].
	scale > 1024 ifTrue:[scale := 1024].
	unscale := 1024 - scale.
	srcPoints := srcShape points.
	dstPoints := dstShape points.
	1 to: points size do:[:i|
		pt1 := srcPoints at: i.
		pt2 := dstPoints at: i.
		x := ((pt1 x * unscale) + (pt2 x * scale)) bitShift: -10.
		y := ((pt1 y * unscale) + (pt2 y * scale)) bitShift: -10.
		points at: i put: x@y].! !

!CompressedBoundaryShape methodsFor: 'accessing' stamp: 'ar 11/3/1998 20:42'!
points
	^points! !

!CompressedBoundaryShape class methodsFor: 'instance creation' stamp: 'ar 11/3/1998 18:02'!
points: pointList leftFills: leftFillList rightFills: rightFillList fillStyles: fillStyleList lineWidths: lineWidthList lineFills: lineFillList
	^self new setPoints: pointList leftFills: leftFillList rightFills: rightFillList fillStyles: fillStyleList lineWidths: lineWidthList lineFills: lineFillList! !

!ConfigurationCommandLineHandler commentStamp: 'TorstenBergmann 2/6/2014 08:17'!
Command line handler for dealing with Metacello configurations from the command line

Usage: config [--help] <repository url> [<configuration>] [--install[=<version>]] [--group=<group>] [--username=<username>] [--password=<password>]
	--help              show this help message
	<repository url>    A Monticello repository name 
	<configuration>     A valid Metacello Configuration name
	<version>           A valid version for the given configuration
	<group>             A valid Metacello group name
	<username>          An optional username to access the configuration's repository
	<password>          An optional password to access the configuration's repository
	
Examples:
	# display this help message
	pharo Pharo.image config
	
	# list all configurations of a repository
	pharo Pharo.image config $MC_REPOS_URL
	
	# list all the available versions of a confgurtation
	pharo Pharo.image config $MC_REPOS_URL ConfigurationOfFoo
	
	# install the stable version
	pharo Pharo.image config $MC_REPOS_URL ConfigurationOfFoo --install
	
	#install a specific version '1.5'
	pharo Pharo.image config $MC_REPOS_URL ConfigurationOfFoo --install=1.5
	
	#install a specific version '1.5' and only a specific group 'Tests'
	pharo Pharo.image config $MC_REPOS_URL ConfigurationOfFoo --install=1.5 --group=Tests
!
!ConfigurationCommandLineHandler methodsFor: 'printing' stamp: 'CamilloBruni 4/6/2013 23:22'!
printMetacelloProjectDetails: metacelloProject
	| versions |
	self inform: 'Available versions for ', self configurationName.
	
	versions := metacelloProject symbolicVersionMap keys asSet.
	versions addAll: metacelloProject map keys.
	versions add: #last.
	
	"print the found version sorted alphabetically"
	versions asArray sorted do:[ :key|
		self stdout nextPutAll: key; lf ]! !

!ConfigurationCommandLineHandler methodsFor: 'accessing' stamp: 'CamilloBruni 4/6/2013 22:48'!
configurationVersion
	^ (self hasOption: 'install')
		ifFalse: [ #stable ]
		ifTrue: [ self optionAt: 'install' ]! !

!ConfigurationCommandLineHandler methodsFor: 'actions' stamp: 'DamienCassou 10/2/2013 15:29'!
installVersion: aVersionName
	| metacelloVersion |
	self inform: 'Installing ', self configurationName, ' ', aVersionName.
	
	metacelloVersion := (self metacelloVersion: aVersionName).
	
	self handleMergeConflictDuring: [
		(self hasOption: 'group')
			ifTrue: [ metacelloVersion load: self groups ]
			ifFalse: [ metacelloVersion load ]].
	
	Smalltalk snapshot: true andQuit: true.! !

!ConfigurationCommandLineHandler methodsFor: 'accessing' stamp: 'CamilloBruni 4/6/2013 23:25'!
repositoryUrl
	^ repositoryURL ifNil: [ 
		self hasRepositoryUrl 
			ifFalse: [ ^ self defaultRepositoryUrl ].
		repositoryURL := self loadRepositoryUrl ]! !

!ConfigurationCommandLineHandler methodsFor: 'testing' stamp: 'CamilloBruni 11/13/2013 17:01'!
hasRepositoryUrl
	^ self arguments size > 0 and: [ 
		| possibleUrl |
		possibleUrl := self arguments first.
		"check if the first argument is some sort of a URL"
		(possibleUrl includesSubstring: '://') or: [ possibleUrl first = $. ]]! !

!ConfigurationCommandLineHandler methodsFor: 'accessing' stamp: 'CamilloBruni 4/6/2013 22:56'!
configuration
	| gofer |
	gofer := self gofer.
	self hasConfiguration 
		ifTrue: [ gofer package: self configurationName ]
		ifFalse: [ gofer configuration ].
	gofer load.
	^ Smalltalk globals at: self configurationName asSymbol! !

!ConfigurationCommandLineHandler methodsFor: 'actions' stamp: 'CamilloBruni 10/13/2012 15:46'!
errorNoConfigurationsFound

	self exitFailure: 'No Configurations found in ', repositoryURL asString! !

!ConfigurationCommandLineHandler methodsFor: 'accessing' stamp: 'CamilloBruni 9/4/2013 16:16'!
defaultRepositoryUrl
	^ MetacelloConfigurationBrowserPane pharoDistributionRepository! !

!ConfigurationCommandLineHandler methodsFor: 'accessing' stamp: 'CamilloBruni 10/13/2012 14:02'!
project
	^ self configuration project! !

!ConfigurationCommandLineHandler methodsFor: 'actions' stamp: 'CamilloBruni 4/6/2013 22:47'!
installConfiguration
	self installVersion: self configurationVersion! !

!ConfigurationCommandLineHandler methodsFor: 'testing' stamp: 'CamilloBruni 10/13/2012 13:20'!
hasConfiguration
	self flag: 'TODO: should use proper cli parser Coral??'.
	^ (self arguments size > 1) and: [
		((self argumentAt: 2) beginsWith: '-') not ]! !

!ConfigurationCommandLineHandler methodsFor: 'actions' stamp: 'CamilloBruni 4/6/2013 23:25'!
listConfigurations
	"List possible configurations of the given repository"
	
	| configurations |
	
	self inform: 'All Configurations found in ', self repositoryUrl.
	
	configurations := self loadConfigurationNames.
	configurations ifEmpty: [ ^ self errorNoConfigurationsFound ].
	self printConfigurations: configurations.
	
	^ self exitSuccess! !

!ConfigurationCommandLineHandler methodsFor: 'actions' stamp: 'CamilloBruni 10/25/2012 19:24'!
metacelloVersion: aVersionName
	| project |
	project := self project.
	^ [ project version: aVersionName ] 
		on: MetacelloVersionDoesNotExistError do: [ :error |
			aVersionName = 'last'
				ifTrue: [
					"manual fallback since there is no symbolic name for lastVersion"
					project lastVersion ]
				ifFalse: [ 
					"symbols and strings are not equal in Meteacello..."
					project version: aVersionName asSymbol ]].! !

!ConfigurationCommandLineHandler methodsFor: 'accessing' stamp: 'CamilloBruni 11/13/2013 17:04'!
loadRepositoryUrl
	| possibleUrl |
	possibleUrl := self argumentAt: 1.
	(possibleUrl includesSubstring: '://')
		ifTrue: [ ^ possibleUrl asUrl ].
	^ possibleUrl asFileReference! !

!ConfigurationCommandLineHandler methodsFor: 'accessing' stamp: 'CamilloBruni 4/6/2013 23:25'!
gofer
	| username password |
	username := (self hasOption: 'username')
		ifTrue: [ self optionAt: 'username' ]
		ifFalse: [ String new ].
	password := (self hasOption: 'password')
		ifTrue: [ self optionAt: 'password' ]
		ifFalse: [ String new ].
	^ Gofer new
		url: self repositoryUrl username: username password: password;
		yourself! !

!ConfigurationCommandLineHandler methodsFor: 'printing' stamp: 'CamilloBruni 11/2/2012 15:26'!
printConfigurations: configurations

	self inform: (String streamContents:  [ :s|
		s
			nextPutAll: 'Found ';
			print: configurations size;
			nextPutAll: ' Configuration';
			nextPutAll: (configurations size = 1 ifTrue: ':' ifFalse: 's:') ]).
	
	configurations do: [ :name | 
			self << name. 
			self stdout lf ].
	! !

!ConfigurationCommandLineHandler methodsFor: 'actions' stamp: 'CamilloBruni 9/15/2013 17:54'!
handleMergeConflictDuring: aLoadBlock
	[aLoadBlock 
	on: MCMergeOrLoadWarning do: [ :mergeConflict | mergeConflict merge ]]
	on: MCMergeResolutionRequest do: [ :request |  request autoMerge ].! !

!ConfigurationCommandLineHandler methodsFor: 'actions' stamp: 'CamilloBruni 10/13/2012 14:02'!
listConfigurationDetails
	"List possible configurations of the given repository"
	
	self printMetacelloProjectDetails: self project.
	
	^ self exitSuccess! !

!ConfigurationCommandLineHandler methodsFor: 'accessing' stamp: 'CamilloBruni 4/6/2013 23:19'!
configurationName
	^ configurationName ifNil: [
			self hasConfiguration 
				ifFalse: [ "Demeters favourite line :("
					^ self gofer configuration references last name ].
		 configurationName := self argumentAt: 2 ]! !

!ConfigurationCommandLineHandler methodsFor: 'actions' stamp: 'CamilloBruni 4/6/2013 22:52'!
list
	(self hasConfiguration or: [ self hasRepositoryUrl ])
		ifTrue: [ self listConfigurationDetails ]
		ifFalse: [ self listConfigurations ]! !

!ConfigurationCommandLineHandler methodsFor: 'actions' stamp: 'CamilloBruni 10/13/2012 13:53'!
loadConfigurationNames
	| references configurations |
	
	references := self gofer allResolved.
		
	references := references 
			collect: #packageName 
			thenSelect: [ :name| name beginsWith: 'ConfigurationOf' ].
	
	^ references asSet asSortedCollection ! !

!ConfigurationCommandLineHandler methodsFor: 'activation' stamp: 'CamilloBruni 4/6/2013 23:13'!
activate
	self activateHelpWithoutArguments
		ifTrue: [ ^ self ].
	
	(self hasOption: 'install')
		ifFalse: [ ^ self list ].
		
	self installConfiguration.
		! !

!ConfigurationCommandLineHandler methodsFor: 'accessing' stamp: 'BernardoContreras 3/7/2015 13:03'!
groups
	^ (self optionAt: 'group') substrings: {$,}! !

!ConfigurationCommandLineHandler class methodsFor: 'accessing' stamp: 'CamilloBruni 10/13/2012 12:51'!
description
	^ 'Install and inspect Metacello Configurations from the command line'! !

!ConfigurationCommandLineHandler class methodsFor: 'accessing' stamp: 'CamilloBruni 10/13/2012 12:51'!
commandName
	^ 'config'! !

!ConfigurationCommandLineHandlerTest commentStamp: 'TorstenBergmann 2/6/2014 08:16'!
SUnit tests for class ConfigurationCommandLineHandler!
!ConfigurationCommandLineHandlerTest methodsFor: 'tests' stamp: 'CamilloBruni 10/13/2012 13:21'!
testHasConfiguration
	| cli |
	cli := self command: #('http://ss3.gemstone.com/ss/MetaRepoForPharo20').
	self deny: cli hasConfiguration.
	
	cli := self command: #('http://ss3.gemstone.com/ss/MetaRepoForPharo20' '--install').
	self deny: cli hasConfiguration.
	
	cli := self command: #('http://ss3.gemstone.com/ss/MetaRepoForPharo20' 'ConfigurationOfFoo').
	self assert: cli hasConfiguration.! !

!ConfigurationCommandLineHandlerTest methodsFor: 'convenience' stamp: 'CamilloBruni 10/13/2012 13:03'!
argumentsWith: aCollection
	^ CommandLineArguments withArguments: aCollection! !

!ConfigurationCommandLineHandlerTest methodsFor: 'tests' stamp: 'CamilloBruni 10/13/2012 13:04'!
testResponsibility
	| args |
	args := self argumentsWith: #('config').
	self assert: (ConfigurationCommandLineHandler isResponsibleFor: args).! !

!ConfigurationCommandLineHandlerTest methodsFor: 'tests' stamp: 'CamilloBruni 10/15/2013 01:20'!
testGroups
	| cli |
	cli := self command: #('http://ss3.gemstone.com/ss/MetaRepoForPharo20' '--group=foo').
	self assertCollection: cli groups equals: {'foo'}.
	
	cli := self command: #('http://ss3.gemstone.com/ss/MetaRepoForPharo20' '--group=foo,boo').
	self assertCollection: cli groups equals: {'foo' . 'boo'}.! !

!ConfigurationCommandLineHandlerTest methodsFor: 'convenience' stamp: 'CamilloBruni 10/13/2012 13:17'!
command: arguments
	^ ConfigurationCommandLineHandler commandLine: (self argumentsWith: arguments)! !

!ConfigurationCommandLineHandlerTest methodsFor: 'tests' stamp: 'CamilloBruni 10/16/2012 12:23'!
testListConfigurations
	self skip: 'Currently quits the image when in non-interactive mode'.
	self activate: #('config' 'http://ss3.gemstone.com/ss/MetaRepoForPharo20').! !

!ConfigurationCommandLineHandlerTest methodsFor: 'convenience' stamp: 'EstebanLorenzano 5/23/2013 14:37'!
activate: arguments
	^ PharoCommandLineHandler activateWith: (self argumentsWith: arguments)! !

!ConfigurationGenerator commentStamp: '<historical>'!
Probably to be removed to use metacello toolbox!
!ConfigurationGenerator methodsFor: 'metacello' stamp: 'StephaneDucasse 4/19/2012 18:01'!
createDevelopmentVersion
	self hasAnyBaseline 
		ifFalse: [ UIManager default inform: 'Please, define a baseline first'. ^ self ].
	^ self createVersionForBlessing: #development! !

!ConfigurationGenerator methodsFor: 'metacello' stamp: 'StephaneDucasse 4/19/2012 18:01'!
baseLines 
	| existingBaselines |
	existingBaselines := self configurationClass methods select: [:cm | cm selector beginsWith: 'baseline'].
	existingBaselines := (existingBaselines collect: [:m | m pragmas first argumentAt: 1]) asSortedCollection.
	^ existingBaselines! !

!ConfigurationGenerator methodsFor: 'metacello' stamp: 'StephaneDucasse 4/19/2012 18:01'!
createReleaseVersion
	self hasAnyBaseline 
		ifFalse: [ UIManager default inform: 'Please, define a baseline first'. ^ self ].
		
	^ self createVersionForBlessing: #release! !

!ConfigurationGenerator methodsFor: 'metacello' stamp: 'StephaneDucasse 4/19/2012 18:01'!
configurationClass
	^ Smalltalk globals at: workingCopy package name asSymbol ! !

!ConfigurationGenerator methodsFor: 'metacello' stamp: 'MarcusDenker 11/3/2014 15:26'!
createVersionForBlessing: blessingSelector
	"blessingSelector = #release or #development"

	| existingVersions msg initialAnswer newVersionNumber selectorName stream mcWorkingCopy |
	existingVersions := self configurationClass methods select: [ :cm | cm selector beginsWith: 'version' ].
	existingVersions := (existingVersions collect: [ :m | m pragmas first argumentAt: 1 ]) asSortedCollection.
	msg := ''.
	existingVersions size > 4
		ifTrue: [ 
			msg := 'Last 4 versions: '
				, (existingVersions copyFrom: existingVersions size - 4 to: existingVersions size) asArray printString , String cr ].
	initialAnswer := existingVersions size > 0
		ifTrue: [ existingVersions last , '.1' ]
		ifFalse: [ '1.0' ].
	newVersionNumber := UIManager default request: msg initialAnswer: initialAnswer.
	newVersionNumber ifNil: [ ^ self ].
	selectorName := newVersionNumber copyWithoutAll: '.-'.
	stream := WriteStream on: String new.
	stream nextPutAll: 'version'.
	stream nextPutAll: selectorName.
	stream
		nextPutAll:
			': spec 
        <version: '''.
	stream nextPutAll: newVersionNumber.
	stream
		nextPutAll:
			''' imports: #(''' , self lastBaseLine
				,
					''')>

        spec for: #common do: [
                spec blessing: ' , blessingSelector printString
				,
					'.
'.
	self dependentPackages
		do: [ :pName | 
			stream nextPutAll: '			spec package: ''' , pName , ''' with: '''.
			mcWorkingCopy := (MCPackage named: pName) workingCopy.
			mcWorkingCopy needsSaving
				ifTrue: [ 
					self
						inform:
							'The configuration you want to save depends on the package ' , pName
								, '. You first need to save this package in order to create the version'.
					^ self ].
			stream nextPutAll: mcWorkingCopy ancestry ancestors first name.
			stream nextPutAll: '''.' , String cr ].
	stream nextPutAll: '                ].'.
	self configurationClass compile: stream contents classified: 'versions'! !

!ConfigurationGenerator methodsFor: 'metacello' stamp: 'StephaneDucasse 4/19/2012 18:01'!
hasAnyBaseline 
	^ self baseLines notEmpty! !

!ConfigurationGenerator methodsFor: 'metacello' stamp: 'MarcusDenker 11/3/2014 15:27'!
dependentPackages
	"Return the list of dependent packages for the last baseline"

	"This method must be rewritten. It is a shame..."
	
	| lastBaseLineName packageNames |
	lastBaseLineName := self lastBaseLine.

	packageNames := OrderedCollection new.
	(self configurationClass project version: lastBaseLineName)
		record loadDirective packageDirectivesDo: [:directive |
			packageNames add: directive file ].
		
	^ packageNames collect: [:p | 
		(p includes: $.)
			ifTrue: [ (p includes: $-)
						ifTrue: [ (p copyUpToLast: $-) ]
						ifFalse: [ (p copyUpTo: $.) ] ]
			ifFalse: [ p ]
		]

"	lastBaseLineMethod := (self configurationClass methods 
							select: [:cm | cm selector beginsWith: 'baseline'])
								select: [:cm | cm pragmas first arguments first = lastBaseLineName].
	lastBaseLineMethod := lastBaseLineMethod first.
"	
	"This does not work!! No idea why!!"
"	versionConstructor := (Smalltalk at: #MetacelloVersionConstructor) new.
	self configurationClass new perform: lastBaseLineMethod selector with: versionConstructor.
	versionSpec := (Smalltalk at: #MetacelloVersionSpec) new.
	versionConstructor root: versionSpec
"
	"This is probably the ugliest piece of code I ever wrote. There is really nothing to be proud of."
"	possiblePackageNames := 
		((lastBaseLineMethod literals select: [ :l | l class == ByteString ])
			reject: [:l | l beginsWith: 'http']).
	packageInfos := PackageInfo allPackages select: [ :pi | possiblePackageNames includes: pi packageName ].
"
	"packageInfos now contains the package that the lastest baseline depends on"
	"^ packageInfos collect: #packageName"

	! !

!ConfigurationGenerator methodsFor: 'metacello' stamp: 'MarcusDenker 11/3/2014 15:26'!
addMetacelloBaseline
	| baselineNumber existingBaselines msg selectorName addedPackages package stream packagePattern |
	"0 -- must have a repository selected"
	repository isNil
		ifTrue: [ 
			UIManager default inform: 'Please select a repository and try again'.
			^ self ].	"1 -- Selecting baseline name"
	existingBaselines := self baseLines.
	msg := existingBaselines size > 0
		ifTrue: [ 
			'Current baselines:' , String cr , (existingBaselines inject: '' into: [ :sum :el | sum , el , String cr ])
				, 'Enter a new baseline number' ]
		ifFalse: [ 'Enter a new baseline number ("-baseline" will be automatically added)' ].
	baselineNumber := UIManager default request: msg initialAnswer: '1.0'.
	baselineNumber ifNil: [ ^ self ].	"2 -- add package names"
	addedPackages := OrderedCollection new.
	packagePattern := UIManager default request: 'Please enter a pattern to filter package names' initialAnswer: '*'.
	[ 
	| packageNames workingCopies |
	packageNames := OrderedCollection new.
	workingCopies := OrderedCollection new.
	self workingCopies
		do: [ :pkg | 
			((packagePattern match: pkg package name) and: [ (addedPackages includes: pkg package name) not ])
				ifTrue: [ 
					packageNames add: pkg package name.
					workingCopies add: pkg ] ].
	package := UIManager default
		chooseFrom: packageNames
		values: workingCopies
		title: 'Add dependent package (cancel to stop)'.
	package ifNotNil: [ addedPackages add: package package name ] ] doWhileTrue: [ package notNil ].	"3 -- Creating baseline"
	selectorName := baselineNumber copyWithoutAll: '.-'.
	stream := WriteStream on: String new.
	stream nextPutAll: 'baseline'.
	stream nextPutAll: selectorName.
	stream
		nextPutAll:
			': spec 
        <version: '''.
	stream nextPutAll: baselineNumber.
	stream
		nextPutAll:
			'-baseline''>
        
        spec for: #common do: [
                spec blessing: #baseline.
                spec repository: '''.
	stream nextPutAll: repository description.
	stream
		nextPutAll:
			'''.    
                "spec 
                        package: ''Example-Core'';
                        package: ''Example-Tests'' with: [ spec requires: ''Example-Core'' ]"
'.
	addedPackages do: [ :pName | stream nextPutAll: '			spec package: ''' , pName , '''.' , String cr ].
	stream nextPutAll: '                ].'.
	self configurationClass compile: stream contents classified: 'baselines'! !

!ConfigurationGenerator methodsFor: 'metacello' stamp: 'StephaneDucasse 4/19/2012 18:01'!
lastBaseLine
	^ self baseLines last! !

!ConfigurationGenerator methodsFor: 'metacello' stamp: 'StephaneDucasse 4/19/2012 18:01'!
browseConfiguration
	self configurationClass browse! !

!ConfigurationNotFound commentStamp: 'ChristopheDemarey 2/24/2014 16:36'!
Error raised when a configuration class for a project is not loaded and / or cannot be found!!!
!ConfigurationOf commentStamp: 'dkh 5/30/2012 16:31'!
You must use a *configuration* when your project is stored in a
repository using `.mcz` files.

If you are using a source code manager (SCM) like [git][1] and have
created a *baseline* (see the [**BaselineOf** class comment][3] for more info)
you may use a *configuration* to associate a specific
git commit (SHA, branch name, tag name) with a [Metacello version][2].

To create a new Metacello configuration:

1. Create a subclass of the **ConfigurationOf** class. The configuration
   class for your project should be names by appending the name of
   your project to the string `ConfigurationOf`. The name of the
   category and package should be the same as the name of the class:

    ```Smalltalk
    ConfigurationOf subclass: #ConfigurationOfExample
      instanceVariableNames: ''
      classVariableNames: ''
      poolDictionaries: ''
      category: 'ConfigurationOfExample'
    ```

2. Create a **baselineXXXX:** method where you specify the structure of your project:

    ```Smalltalk
    baseline0100: spec
      <baseline: '1.0-baseline'>

      spec for: #common do: [
        spec repository: 'http://ss3.gemstone.com/ss/Example'.
        spec
          package: 'Example-Core';
          package: 'Example-Tests' with: [
            spec requires: 'Example-Core' ]].
    ```

3. Create a **versionXXXX:** method where you specify the specific
   versions of the packages to be loaded for this version:

    ```Smalltalk
    version01000: spec
      <version: '1.0' imports: #('1.0-baseline')>

      spec for: #common do: [
        spec blessing: #release.
        spec
          package: 'Example-Core' with: 'Example-Core';
          package: 'Example-Tests' with: 'Example-Tests' ].
    ```

4. Create a Monticello package for your **ConfigurationOf** class and save it in the repository where your packages are stored. 

[1]: http://git-scm.com/
[2]: https://github.com/dalehenrich/metacello-work/blob/master/docs/MetacelloScriptingAPI.md#metacello-version-numbers
[3]: https://github.com/dalehenrich/metacello-work/blob/master/repository/Metacello-Base.package/BaselineOf.class/README.md
!
!ConfigurationOf methodsFor: 'accessing' stamp: 'dkh 5/31/2012 17:57:13'!
customProjectAttributes
    "Edit to return a collection of any custom attributes e.g. for conditional loading: Array with: #'Condition1' with: #'Condition2.
	For more information see: http://code.google.com/p/metacello/wiki/CustomProjectAttrributes "

    ^ #()! !

!ConfigurationOf methodsFor: 'accessing' stamp: 'dkh 5/31/2012 17:57:13'!
project: aProject

	project ifNil: [ self class ensureMetacello ].
	project := aProject! !

!ConfigurationOf methodsFor: 'private' stamp: 'dkh 5/31/2012 17:57:13'!
versionDoesNotExistError: versionStringOrSymbol

	((Smalltalk at: #MetacelloSymbolicVersionDoesNotExistError) project: self project versionString: versionStringOrSymbol) signal! !

!ConfigurationOf methodsFor: 'accessing' stamp: 'dkh 5/31/2012 17:57:13'!
projectClass
    ^ MetacelloMCProject! !

!ConfigurationOf methodsFor: 'accessing' stamp: 'dkh 6/22/2012 12:09'!
versionNumberClass
    ^ MetacelloSemanticVersionNumber! !

!ConfigurationOf methodsFor: 'accessing' stamp: 'dkh 6/22/2012 14:31'!
project
    ^ project
        ifNil: [ 
            "Bootstrap Metacello if it is not already loaded"
            self class ensureMetacello.
            project := self projectClass new projectAttributes: self customProjectAttributes.	"Create the Metacello project"
            project versionNumberClass: self versionNumberClass.
            project class versionConstructorClass on: self project: project.	"Construct the project"
            project loadType: #'linear'.	"change to #atomic if desired"
            project ]! !

!ConfigurationOf methodsFor: 'defaults' stamp: 'dkh 5/31/2012 17:57:13'!
bleedingEdge 
	"override if different behavior desired.
	 Use:
		self versionDoesNotExistError: #bleedingEdge
	 if #bleedingEdge version is disallowed."

	<defaultSymbolicVersion: #bleedingEdge>
	
	^self defaultBleedingEdgeVersion! !

!ConfigurationOf methodsFor: 'defaults' stamp: 'dkh 5/31/2012 17:57:13'!
defaultBleedingEdgeVersion
	| bleedingEdgeVersion |
	bleedingEdgeVersion := (self project map values select: [ :version | version blessing == #baseline ])
		detectMax: [ :version | version ].
	bleedingEdgeVersion ifNil: [ ^#'notDefined' ].
	^ bleedingEdgeVersion versionString! !

!ConfigurationOf class methodsFor: 'private' stamp: 'dkh 6/10/2012 22:01'!
ensureGoferVersion: goferVersion repositoryUrl: repositoryUrl
    "load the p=file goferVersion if Gofer isn't loaded or an earlier version of Gofer is currently loaded"

    | goferVersionNumber wc pName |
    (Smalltalk at: #'Gofer' ifAbsent: [  ]) == nil
        ifTrue: [ ^ self bootstrapPackage: goferVersion from: repositoryUrl ].
    goferVersionNumber := (goferVersion copyAfterLast: $.) asNumber.
    wc := [ ((Smalltalk at: #'GoferPackageReference') name: 'Gofer') workingCopy ]
        on: Error
        do: [ :ex | ex return: ((Smalltalk at: #'GoferPackageReference') name: 'Gofer-Core') workingCopy ].
    pName := wc ancestry ancestors first name.
    (pName copyAfterLast: $.) asNumber <= goferVersionNumber
        ifTrue: [ self bootstrapPackage: goferVersion from: repositoryUrl ]! !

!ConfigurationOf class methodsFor: 'private' stamp: 'dkh 9/4/2012 20:50'!
retry: aBlock retryCount: retryCount
    | count |
    count := 1.
    [ true ]
        whileTrue: [ 
            [ 
            aBlock value.
            ^ self ]
                on: Error
                do: [ :ex | 
                    count < retryCount
                        ifTrue: [ 
                            Transcript
                                cr;
                                show: 'RETRYING AFTER:';
                                cr;
                                show: ex description printString.
                            (Delay forSeconds: 5) wait ]
                        ifFalse: [ 
                            Transcript
                                cr;
                                show: 'FAILED RETRYING:';
                                cr;
                                show: ex description printString.
                            ex pass ] ].
            count := count + 1 ]! !

!ConfigurationOf class methodsFor: 'private' stamp: 'dkh 05/08/2013 11:39'!
bootstrapMetacelloFrom: repositoryUrl
  "Corresponds to version 1.0.0-beta.32.6"

  "KEEP MetacelloConfigTemplate class>>ensureMetacelloBaseConfiguration in synch!!"

  | platformPkg |
  self ensureGoferVersion: 'Gofer-Core-lr.115' repositoryUrl: repositoryUrl.
  #('Metacello-Core-dkh.678' 'Metacello-MC-dkh.674')
    do: [ :pkg | self bootstrapPackage: pkg from: repositoryUrl ].
  platformPkg := Smalltalk
    at: #'SystemVersion'
    ifPresent: [ :cl | 
      | versionString |
      versionString := cl current version.
      (versionString beginsWith: 'Squeak')
        ifTrue: [ 
          (versionString beginsWith: 'Squeak3')
            ifTrue: [ 'Metacello-Platform.squeak-dkh.5' ]
            ifFalse: [ 'Metacello-Platform.squeak-dkh.22' ] ]
        ifFalse: [ 
          (versionString beginsWith: 'Pharo')
            ifTrue: [ 
              self bootstrapPackage: 'Metacello-PharoCommonPlatform-dkh.2' from: repositoryUrl.
              (versionString beginsWith: 'Pharo2')
                ifTrue: [ 'Metacello-Platform.pharo20-dkh.33' ]
                ifFalse: [ 'Metacello-Platform.pharo-dkh.34' ] ] ] ].
  self bootstrapPackage: platformPkg from: repositoryUrl! !

!ConfigurationOf class methodsFor: 'accessing' stamp: 'dkh 5/31/2012 17:57:13'!
validate
	"Check the configuration for Errors, Critical Warnings, and Warnings (see class comment for MetacelloMCVersionValidator for more information). 
	Errors identify specification issues that will result in unexpected behaviour when you load the configuration. 
	Critical Warnings identify specification issues that may result in unexpected behavior when you load the configuration.
	Warnings identify specification issues that are technically correct, but are worth take a look at."

	"self validate"

	<apiDocumentation>
	self ensureMetacello.
	^ ((Smalltalk at: #MetacelloToolBox) validateConfiguration: self debug: #() recurse: false) explore! !

!ConfigurationOf class methodsFor: 'private' stamp: 'dkh 06/28/2013 16:07'!
ensureMetacello: loadList
  "Bootstrap Metacello, retry using alternate repository, if primary repository is not accessible"

  Smalltalk
    at: #'MetacelloProject'
    ifAbsent: [ 
      | version error gofer |
      (Array
        with: 'http://smalltalkhub.com/mc/dkh/metacello/main'
        with: 'http://seaside.gemtalksystems.com/ss/metacello')
        do: [ :repositoryUrl | 
          "bootstrap Metacello"
          [ 
          self bootstrapMetacelloFrom: repositoryUrl.
          Smalltalk
            at: #'ConfigurationOfMetacello'
            ifAbsent: [ 
              self
                retry: [ 
                  gofer := (Smalltalk at: #'Gofer') new.
                  gofer
                    perform: #'url:' with: repositoryUrl;
                    perform: #'package:' with: 'ConfigurationOfMetacello';
                    perform: #'load' ] ].
          version := (Smalltalk at: #'ConfigurationOfMetacello') project
            version: #'previewBootstrap'.
          version load: loadList.
          self
            retry: [ 
              gofer := (Smalltalk at: #'Gofer') new.
              Smalltalk
                at: #'ConfigurationOfMetacelloPreview'
                ifAbsent: [ 
                  gofer
                    perform: #'url:' with: repositoryUrl;
                    perform: #'package:'
                      with: 'ConfigurationOfMetacelloPreview';
                    perform: #'load' ] ].
          version := (Smalltalk at: #'ConfigurationOfMetacelloPreview') project
            version: #'stable'.	"load latest from GitHub"
          version load: loadList.
          ^ self ]
            on: Error
            do: [ :ex | 
              error := ex.
              Transcript
                cr;
                show: 'failed ensureMetacello using ';
                show: repositoryUrl printString;
                show: ' : ';
                show: ex description printString;
                show: '...retrying'.	"try again"
              ex return: nil ] ].	"shouldn't get here unless the load failed ... throw an error"
      self
        error:
          'retry with alternate repository failed: ' , error description printString ]! !

!ConfigurationOf class methodsFor: 'private' stamp: 'dkh 9/4/2012 17:09'!
retry: aBlock
    self retry: aBlock retryCount: 3! !

!ConfigurationOf class methodsFor: 'accessing' stamp: 'dkh 5/31/2012 17:57:13'!
project

	^self new project! !

!ConfigurationOf class methodsFor: 'private' stamp: 'dkh 6/11/2012 11:05'!
ensureMetacello
    "Bootstrap Metacello and load the 'botstrap' group"

    self ensureMetacello: #('batch')! !

!ConfigurationOf class methodsFor: 'private' stamp: 'dkh 9/4/2012 17:09'!
bootstrapPackage: aString from: aPath
    | repository version |
    repository := (MCCacheRepository default includesVersionNamed: aString)
        ifTrue: [ MCCacheRepository default ]
        ifFalse: [ MCHttpRepository location: aPath user: '' password: '' ].
    self
        retry: [ 
            repository
                versionReaderForFileNamed: aString , '.mcz'
                do: [ :reader | 
                    version := reader version.
                    version load.
                    version workingCopy repositoryGroup addRepository: repository ] ]! !

!ConfigurationOf class methodsFor: 'unloading Metacello' stamp: 'dkh 5/31/2012 17:57:13'!
unloadMetacello
	"Unload the classes that implement Metacello. Metacello is not needed once a project has been loaded, so it can safely be unloaded."

	"self unloadMetacello"

	<apiDocumentation>
	| gofer |
	gofer := (Smalltalk at: #Gofer) new.
	MCWorkingCopy allManagers do: [:wc |
		((wc packageName beginsWith: 'Metacello') or: [ wc packageName beginsWith: 'OB-Metacello' ])
			ifTrue: [ gofer package: wc packageName ]].
	gofer unload.! !

!ConfigurationOfAthens commentStamp: '<historical>'!
"Load latest stable version "
self loadStable.

"Load latest development version"

self loadDevelopment 


Extras:

Tutorial
self project lastVersion load: 'Tutorial'

"SVG importer"
(note before doing this you need to load XMLParser,
which you can find in Configurations browser)

self project lastVersion load: 'SVG'

!
!ConfigurationOfAthens methodsFor: 'versions' stamp: 'IgorStasenko 9/3/2012 04:00'!
version14: spec 
        <version: '1.4' imports: #('1.1-baseline')>

        spec for: #common do: [
                spec blessing: #development.
			spec project: 'ConfigurationOfNativeBoost default'  with: '1.4'.

			spec package: 'Athens-Core' with: 'Athens-Core-IgorStasenko.20'.
			spec package: 'Athens-Text' with: 'Athens-Text-IgorStasenko.5'.
			spec package: 'Athens-Balloon' with: 'Athens-Balloon-IgorStasenko.7'.
			spec package: 'Athens-Morphic' with: 'Athens-Morphic-IgorStasenko.5'.
			spec package: 'Athens-CairoPools' with: 'Athens-CairoPools-IgorStasenko.5'.
			spec package: 'Athens-Cairo' with: 'Athens-Cairo-IgorStasenko.28'.
			spec package: 'Athens-PangoCairo' with: 'Athens-PangoCairo-FernandoOlivero.9'.
			spec package: 'Athens-Examples' with: 'Athens-Examples-IgorStasenko.17'.
                ].! !

!ConfigurationOfAthens methodsFor: 'versions' stamp: 'IgorStasenko 4/8/2014 16:17'!
version26: spec 
        <version: '2.6' imports: #('2.3-baseline')>

       spec for: #common do: [
 	 	  spec description: 'Update 8 Apr 2014'.
               spec blessing: #development.

			spec package: 'Athens-Core' with: 'Athens-Core-JochenRick.40'.
			spec package: 'Athens-Text' with: 'Athens-Text-IgorStasenko.9'.
			spec package: 'Athens-Balloon' with: 'Athens-Balloon-IgorStasenko.15'.
			spec package: 'Athens-Morphic' with: 'Athens-Morphic-JochenRick.28'.

			spec package: 'Athens-CairoPools' with: 'Athens-CairoPools-IgorStasenko.10'.

			spec package: 'Athens-Cairo' with: 'Athens-Cairo-IgorStasenko.70'.
			spec package: 'Athens-Examples' with: 'Athens-Examples-IgorStasenko.30'.
			spec package: 'Athens-Tutorial' with: 'Athens-Tutorial-IgorStasenko.6'.
			spec package: 'Athens-SVG' with: 'Athens-SVG-JochenRick.8'
			
                ].! !

!ConfigurationOfAthens methodsFor: 'symbolic versions' stamp: 'TudorGirba 3/24/2015 15:05'!
stable: spec
	<symbolicVersion: #stable>

	spec for: #'pharo2.x' version: '2.1'.
	"after some modification in NB made it incompatible with 3.0"
	spec for: #'pharo3.x' version: '2.3'. 
	spec for: #'pharo4.x' version: '3.2'.! !

!ConfigurationOfAthens methodsFor: 'symbolic versions' stamp: 'StephaneDucasse 9/30/2013 22:04'!
development: spec
	<symbolicVersion: #development>
	
	spec for: #common version: '2.5'! !

!ConfigurationOfAthens methodsFor: 'versions' stamp: 'StephaneDucasse 9/30/2013 21:35'!
version24: spec 
        <version: '2.4' imports: #('2.3-baseline')>

       spec for: #common do: [
 	 	  spec description: 'Just added a dependency to XMLParser for SVG on top of
		removing pango cairo from the version, since it was only used for Shapes'.
               spec blessing: #development.

			spec package: 'Athens-Core' with: 'Athens-Core-IgorStasenko.35'.
			spec package: 'Athens-Text' with: 'Athens-Text-IgorStasenko.6'.
			spec package: 'Athens-Balloon' with: 'Athens-Balloon-IgorStasenko.10'.
			spec package: 'Athens-Morphic' with: 'Athens-Morphic-IgorStasenko.20'.
			spec package: 'Athens-CairoPools' with: 'Athens-CairoPools-IgorStasenko.8'.
			spec package: 'Athens-Cairo' with: 'Athens-Cairo-IgorStasenko.48'.
			spec package: 'Athens-Examples' with: 'Athens-Examples-IgorStasenko.25'.
			spec package: 'Athens-Tutorial' with: 'Athens-Tutorial-IgorStasenko.6'.
			spec package: 'Athens-SVG' with: 'Athens-SVG-IgorStasenko.7'
			
                ].! !

!ConfigurationOfAthens methodsFor: 'versions' stamp: 'IgorStasenko 8/14/2013 16:34'!
version22: spec 
        <version: '2.2' imports: #('2.1-baseline')>

       spec for: #common do: [
 	 	  spec description: 'update after nativeboost NBExternalStructure refactoring ConfigurationOfNativeBoost 2.2'.
               spec blessing: #development.

			spec package: 'Athens-Core' with: 'Athens-Core-IgorStasenko.35'.
			spec package: 'Athens-Text' with: 'Athens-Text-IgorStasenko.6'.
			spec package: 'Athens-Balloon' with: 'Athens-Balloon-IgorStasenko.10'.
			spec package: 'Athens-Morphic' with: 'Athens-Morphic-IgorStasenko.20'.
			spec package: 'Athens-CairoPools' with: 'Athens-CairoPools-IgorStasenko.8'.
			spec package: 'Athens-Cairo' with: 'Athens-Cairo-IgorStasenko.48'.
			spec package: 'Athens-PangoCairo' with: 'Athens-PangoCairo-FernandoOlivero.11'.
			spec package: 'Athens-Examples' with: 'Athens-Examples-IgorStasenko.25'.
			
			spec package: 'Athens-Tutorial' with: 'Athens-Tutorial-IgorStasenko.6'.
			spec package: 'Athens-SVG' with: 'Athens-SVG-IgorStasenko.7'
			
                ].! !

!ConfigurationOfAthens methodsFor: 'versions' stamp: 'IgorStasenko 3/30/2012 15:36'!
version014: spec 
        <version: '0.1.4' imports: #('1.0-baseline')>

        spec for: #common do: [
               spec blessing: #development.

			spec project: 'ConfigurationOfNativeBoost default'  with: '1.1.0'.

			spec package: 'NativeBoost-Installer' with: 'NativeBoost-Installer-IgorStasenko.24'.
			spec package: 'Athens-Core' with: 'Athens-Core-FernandoOlivero.8'.
			spec package: 'Athens-Text' with: 'Athens-Text-IgorStasenko.2'.
			spec package: 'Athens-Balloon' with: 'Athens-Balloon-IgorStasenko.4'.
			spec package: 'Athens-Morphic' with: 'Athens-Morphic-IgorStasenko.2'.
			spec package: 'Athens-CairoPools' with: 'Athens-CairoPools-IgorStasenko.2'.
			spec package: 'Athens-Cairo' with: 'Athens-Cairo-FernandoOlivero.9'.
			spec package: 'Athens-PangoCairo' with: 'Athens-PangoCairo-FernandoOlivero.5'.
			spec package: 'Athens-Examples' with: 'Athens-Examples-FernandoOlivero.5'.
	].! !

!ConfigurationOfAthens methodsFor: 'accessing' stamp: 'IgorStasenko 2/6/2012 16:29'!
project

	^ project ifNil: [ | constructor |
		"Bootstrap Metacello if it is not already loaded"
		(self class baseConfigurationClassIfAbsent: []) ensureMetacello.
		"Construct Metacello project"
		constructor := (Smalltalk at: #MetacelloVersionConstructor) on: self.
		project := constructor project.
		project loadType: #linear. "change to #atomic if desired"
		project ]! !

!ConfigurationOfAthens methodsFor: 'versions' stamp: 'IgorStasenko 3/20/2012 15:48'!
version013: spec 
        <version: '0.1.3' imports: #('1.0-baseline')>

        spec for: #common do: [
               spec blessing: #development.

			spec project: 'ConfigurationOfNativeBoost default'  with: '1.0.9'.

			spec package: 'NativeBoost-Installer' with: 'NativeBoost-Installer-IgorStasenko.24'.
			spec package: 'Athens-Core' with: 'Athens-Core-FernandoOlivero.8'.
			spec package: 'Athens-Text' with: 'Athens-Text-IgorStasenko.2'.
			spec package: 'Athens-Balloon' with: 'Athens-Balloon-IgorStasenko.4'.
			spec package: 'Athens-Morphic' with: 'Athens-Morphic-IgorStasenko.2'.
			spec package: 'Athens-CairoPools' with: 'Athens-CairoPools-IgorStasenko.2'.
			spec package: 'Athens-Cairo' with: 'Athens-Cairo-FernandoOlivero.9'.
			spec package: 'Athens-PangoCairo' with: 'Athens-PangoCairo-FernandoOlivero.5'.
			spec package: 'Athens-Examples' with: 'Athens-Examples-FernandoOlivero.5'.
	].! !

!ConfigurationOfAthens methodsFor: 'baselines' stamp: 'IgorStasenko 4/30/2013 01:10'!
baseline21: spec 
        <version: '2.1-baseline'>
        
        spec for: #common do: [
		spec blessing: #baseline.
		spec repository: 'http://www.smalltalkhub.com/mc/Pharo/Athens/main'. 

		spec package: 'Athens-Core' .
	
		spec package: 'Athens-Text'  with: [
			spec requires: #('Athens-Core') ].
			
		spec package: 'Athens-Balloon'  with: [
			spec requires: #('Athens-Text') ].
		
		spec package: 'Athens-Morphic'  with: [
			spec requires: #('Athens-Balloon') ].

		spec package: 'Athens-CairoPools'.
	
		spec package: 'Athens-Cairo'  with: [
			spec requires: #( 'Athens-Core' 'Athens-CairoPools' ) ].
	
		spec package: 'Athens-PangoCairo'  with: [
			spec requires: #( 'Athens-Cairo' ) ].
		
		spec package: 'Athens-Examples' with: [
			spec requires: #('Athens-Morphic')].
			
		spec package: 'Athens-Tutorial' with: [
			spec requires: #('Athens-Morphic') ].
			
		spec package: 'Athens-SVG' with: [
			spec requires: #('Athens-Morphic') ].

			
		spec
			group: 'Core' with: #('Athens-Core' );
			group: 'default' with: #('Athens-Morphic' 'Athens-PangoCairo' 'Athens-Examples');
			group: 'Tutorial' with: #('Athens-Tutorial');
			group: 'SVG' with: #('Athens-SVG')
			
		].

! !

!ConfigurationOfAthens methodsFor: 'versions' stamp: 'IgorStasenko 1/31/2014 16:38'!
version25: spec 
        <version: '2.5' imports: #('2.3-baseline')>

       spec for: #common do: [
 	 	  spec description: 'Update 31 Jan 2014'.
               spec blessing: #development.

			spec package: 'Athens-Core' with: 'Athens-Core-JochenRick.40'.
			spec package: 'Athens-Text' with: 'Athens-Text-IgorStasenko.9'.
			spec package: 'Athens-Balloon' with: 'Athens-Balloon-IgorStasenko.15'.
			spec package: 'Athens-Morphic' with: 'Athens-Morphic-JochenRick.28'.

			spec package: 'Athens-CairoPools' with: 'Athens-CairoPools-IgorStasenko.10'.

			spec package: 'Athens-Cairo' with: 'Athens-Cairo-IgorStasenko.61'.
			spec package: 'Athens-Examples' with: 'Athens-Examples-IgorStasenko.26'.
			spec package: 'Athens-Tutorial' with: 'Athens-Tutorial-IgorStasenko.6'.
			spec package: 'Athens-SVG' with: 'Athens-SVG-JochenRick.8'
			
                ].! !

!ConfigurationOfAthens methodsFor: 'baselines' stamp: 'FernandoOlivero 8/25/2013 11:02'!
baseline22: spec 
        <version: '2.2-baseline'>
        
        spec for: #common do: [
		spec blessing: #baseline.
		spec repository: 'http://www.smalltalkhub.com/mc/Pharo/Athens/main'. 

		spec package: 'Athens-Core' .
	
		spec package: 'Athens-Text'  with: [
			spec requires: #('Athens-Core') ].
			
		spec package: 'Athens-Balloon'  with: [
			spec requires: #('Athens-Text') ].
		
		spec package: 'Athens-Morphic'  with: [
			spec requires: #('Athens-Balloon') ].

		spec package: 'Athens-CairoPools'.
	
		spec package: 'Athens-Cairo'  with: [
			spec requires: #( 'Athens-Core' 'Athens-CairoPools' ) ].
		
		spec package: 'Athens-Examples' with: [
			spec requires: #('Athens-Morphic')].
			
		spec package: 'Athens-Tutorial' with: [
			spec requires: #('Athens-Morphic') ].
			
		spec package: 'Athens-SVG' with: [
			spec requires: #('Athens-Morphic') ].

			
		spec
			group: 'Core' with: #('Athens-Core' );
			group: 'default' with: #('Athens-Morphic' 'Athens-Examples');
			group: 'Tutorial' with: #('Athens-Tutorial');
			group: 'SVG' with: #('Athens-SVG')
			
		].

! !

!ConfigurationOfAthens methodsFor: 'baselines' stamp: 'JurajKubelka 2/8/2015 11:03'!
baseline10: spec 
        <version: '1.0-baseline'>
        
        spec for: #common do: [
		spec blessing: #baseline.
		spec repository: 'http://www.squeaksource.com/Athens'. 

		spec project: 'ConfigurationOfNativeBoost default' with: [
			spec
				className: 'ConfigurationOfNativeBoost';
				versionString: #'stable';
				loads: #('default' ); "this is optional"
				file: 'NativeBoost-Installer';
				repository: 'http://www.squeaksource.com/NativeBoost' ].

		spec package: 'Athens-Core' .
	
		spec package: 'Athens-Text'  with: [
			spec requires: #('Athens-Core') ].
			
		spec package: 'Athens-Balloon'  with: [
			spec requires: #('Athens-Text') ].
		
		spec package: 'Athens-Morphic'  with: [
			spec requires: #('Athens-Balloon') ].

		spec package: 'Athens-CairoPools'.
	
		spec package: 'Athens-Cairo'  with: [
			spec requires: #( 'ConfigurationOfNativeBoost default' 'Athens-Core' 'Athens-CairoPools' ) ].
	
		spec package: 'Athens-PangoCairo'  with: [
			spec requires: #( 'Athens-Cairo' ) ].
		
		spec package: 'Athens-Examples' with: [
			spec requires: #('Athens-Morphic')].
			
		spec
			group: 'Core' with: #('Athens-Core' );
			group: 'default' with: #('Athens-Morphic' 'Athens-PangoCairo' 'Athens-Examples')
	].

! !

!ConfigurationOfAthens methodsFor: 'versions' stamp: 'JurajKubelka 2/8/2015 10:59'!
version01: spec 
        <version: '0.1' imports: #('1.0-baseline')>

        spec for: #common do: [
                spec blessing: #development.
			spec 
				project: 'ConfigurationOfNativeBoost default'  with: '1.0.6';
				package: 'NativeBoost-Installer' with: 'NativeBoost-Installer-IgorStasenko.21'.
	
			spec package: 'Athens-Core' with: 'Athens-Core-FernandoOlivero.4'.
			spec package: 'Athens-Text' with: 'Athens-Text-IgorStasenko.1'.
			spec package: 'Athens-Balloon' with: 'Athens-Balloon-IgorStasenko.2'.
			spec package: 'Athens-Morphic' with: 'Athens-Morphic-IgorStasenko.1'.
	
			spec package: 'Athens-CairoPools' with: 'Athens-CairoPools-IgorStasenko.1'.
			spec package: 'Athens-Cairo' with: 'Athens-Cairo-IgorStasenko.7'.
			spec package: 'Athens-PangoCairo' with: 'Athens-PangoCairo-FernandoOlivero.3'.
			spec package: 'Athens-Examples' with: 'Athens-Examples-IgorStasenko.1'.
                ].! !

!ConfigurationOfAthens methodsFor: 'baselines' stamp: 'IgorStasenko 3/28/2013 15:37'!
baseline20: spec 
        <version: '2.0-baseline'>
        
        spec for: #common do: [
		spec blessing: #baseline.
		spec repository: 'http://www.smalltalkhub.com/mc/Pharo/Athens/main'. 

		spec package: 'Athens-Core' .
	
		spec package: 'Athens-Text'  with: [
			spec requires: #('Athens-Core') ].
			
		spec package: 'Athens-Balloon'  with: [
			spec requires: #('Athens-Text') ].
		
		spec package: 'Athens-Morphic'  with: [
			spec requires: #('Athens-Balloon') ].

		spec package: 'Athens-CairoPools'.
	
		spec package: 'Athens-Cairo'  with: [
			spec requires: #( 'Athens-Core' 'Athens-CairoPools' ) ].
	
		spec package: 'Athens-PangoCairo'  with: [
			spec requires: #( 'Athens-Cairo' ) ].
		
		spec package: 'Athens-Examples' with: [
			spec requires: #('Athens-Morphic')].
			
		spec
			group: 'Core' with: #('Athens-Core' );
			group: 'default' with: #('Athens-Morphic' 'Athens-PangoCairo' 'Athens-Examples')
	].

! !

!ConfigurationOfAthens methodsFor: 'versions' stamp: 'NicolaiHess 2/17/2015 23:26'!
version29: spec 
        <version: '2.9' imports: #('2.3-baseline')>

       spec for: #common do: [
			spec description: '2015-02-17T23:22:38.219799+01:00'.
			spec blessing: #development.

			spec package: 'Athens-Core' with: 'Athens-Core-NicolaiHess.46'.
			spec package: 'Athens-Text' with: 'Athens-Text-NicolaiHess.16'.
			spec package: 'Athens-Balloon' with: 'Athens-Balloon-NicolaiHess.19'.
			spec package: 'Athens-Morphic' with: 'Athens-Morphic-NicolaiHess.43'.
			spec package: 'Athens-CairoPools' with: 'Athens-CairoPools-NicolaiHess.14'.
			spec package: 'Athens-Cairo' with: 'Athens-Cairo-NicolaiHess.84'.
			spec package: 'Athens-Examples' with: 'Athens-Examples-NicolaiHess.41'.
			spec package: 'Athens-Tutorial' with: 'Athens-Tutorial-StephaneDucasse.10'.
			spec package: 'Athens-SVG' with: 'Athens-SVG-StephaneDucasse.12' ]! !

!ConfigurationOfAthens methodsFor: 'baselines' stamp: 'StephaneDucasse 9/30/2013 21:33'!
baseline23: spec 
        <version: '2.3-baseline'>
        
        spec for: #common do: [
		spec blessing: #baseline.
		spec repository: 'http://www.smalltalkhub.com/mc/Pharo/Athens/main'. 

		spec 
			project: 'XMLParser' 
				with: [ spec
						className: 'ConfigurationOfXMLParser';
						versionString: #stable;
						repository: 'http://www.smalltalkhub.com/mc/PharoExtras/XMLParser/main' ].


		spec package: 'Athens-Core' .
	
		spec package: 'Athens-Text'  with: [
			spec requires: #('Athens-Core') ].
			
		spec package: 'Athens-Balloon'  with: [
			spec requires: #('Athens-Text') ].
		
		spec package: 'Athens-Morphic'  with: [
			spec requires: #('Athens-Balloon') ].

		spec package: 'Athens-CairoPools'.
	
		spec package: 'Athens-Cairo'  with: [
			spec requires: #( 'Athens-Core' 'Athens-CairoPools' ) ].
		
		spec package: 'Athens-Examples' with: [
			spec requires: #('Athens-Morphic')].
			
		spec package: 'Athens-Tutorial' with: [
			spec requires: #('Athens-Morphic') ].
			
		spec package: 'Athens-SVG' with: [
			spec requires: #('Athens-Morphic' 'XMLParser') ].

			
		spec
			group: 'Core' with: #('Athens-Core' );
			group: 'default' with: #('Athens-Morphic' 'Athens-Examples');
			group: 'Tutorial' with: #('Athens-Tutorial');
			group: 'SVG' with: #('Athens-SVG')
			
		].

! !

!ConfigurationOfAthens methodsFor: 'versions' stamp: 'DamienPollet 12/22/2012 01:47'!
version16: spec 
        <version: '1.6' imports: #('1.1-baseline')>

        spec for: #common do: [
                spec blessing: #development.
			spec project: 'ConfigurationOfNativeBoost default'  with: '1.8'.

			spec package: 'Athens-Core' with: 'Athens-Core-IgorStasenko.25'.
			spec package: 'Athens-Text' with: 'Athens-Text-IgorStasenko.5'.
			spec package: 'Athens-Balloon' with: 'Athens-Balloon-IgorStasenko.7'.
			spec package: 'Athens-Morphic' with: 'Athens-Morphic-IgorStasenko.9'.
			spec package: 'Athens-CairoPools' with: 'Athens-CairoPools-IgorStasenko.5'.
			spec package: 'Athens-Cairo' with: 'Athens-Cairo-IgorStasenko.34'.
			spec package: 'Athens-PangoCairo' with: 'Athens-PangoCairo-FernandoOlivero.11'.
			spec package: 'Athens-Examples' with: 'Athens-Examples-DamienPollet.20'.
                ].! !

!ConfigurationOfAthens methodsFor: 'versions' stamp: 'TudorGirba 3/24/2015 15:05'!
version32: spec 
        <version: '3.2' imports: #('2.3-baseline')>

       spec for: #common do: [
			spec description: '2015-03-24T15:04:20.991359+01:00'.
			spec blessing: #development.

			spec package: 'Athens-Core' with: 'Athens-Core-MarcusDenker.50'.
			spec package: 'Athens-Text' with: 'Athens-Text-NicolaiHess.16'.
			spec package: 'Athens-Balloon' with: 'Athens-Balloon-MarcusDenker.20'.
			spec package: 'Athens-Morphic' with: 'Athens-Morphic-NicolaiHess.44'.
			spec package: 'Athens-CairoPools' with: 'Athens-CairoPools-NicolaiHess.14'.
			spec package: 'Athens-Cairo' with: 'Athens-Cairo-MarcusDenker.85'.
			spec package: 'Athens-Examples' with: 'Athens-Examples-TudorGirba.43'.
			spec package: 'Athens-Tutorial' with: 'Athens-Tutorial-StephaneDucasse.10'.
			spec package: 'Athens-SVG' with: 'Athens-SVG-StephaneDucasse.12' ]! !

!ConfigurationOfAthens methodsFor: 'versions' stamp: 'IgorStasenko 8/23/2012 17:52'!
version13: spec 
        <version: '1.3' imports: #('1.1-baseline')>

        spec for: #common do: [
                spec blessing: #development.
			spec project: 'ConfigurationOfNativeBoost default'  with: '1.3'.
			spec package: 'Athens-Core' with: 'Athens-Core-IgorStasenko.19'.
			spec package: 'Athens-Text' with: 'Athens-Text-IgorStasenko.3'.
			spec package: 'Athens-Balloon' with: 'Athens-Balloon-IgorStasenko.6'.
			spec package: 'Athens-Morphic' with: 'Athens-Morphic-IgorStasenko.3'.
			spec package: 'Athens-CairoPools' with: 'Athens-CairoPools-FernandoOlivero.4'.
			spec package: 'Athens-Cairo' with: 'Athens-Cairo-IgorStasenko.26'.
			spec package: 'Athens-PangoCairo' with: 'Athens-PangoCairo-FernandoOlivero.9'.
			spec package: 'Athens-Examples' with: 'Athens-Examples-IgorStasenko.15'.
                ].! !

!ConfigurationOfAthens methodsFor: 'versions' stamp: 'IgorStasenko 12/7/2012 16:23'!
version15: spec 
        <version: '1.5' imports: #('1.1-baseline')>

        spec for: #common do: [
                spec blessing: #development.
			spec project: 'ConfigurationOfNativeBoost default'  with: '1.8'.

			spec package: 'Athens-Core' with: 'Athens-Core-IgorStasenko.25'.
			spec package: 'Athens-Text' with: 'Athens-Text-IgorStasenko.5'.
			spec package: 'Athens-Balloon' with: 'Athens-Balloon-IgorStasenko.7'.
			spec package: 'Athens-Morphic' with: 'Athens-Morphic-IgorStasenko.9'.
			spec package: 'Athens-CairoPools' with: 'Athens-CairoPools-IgorStasenko.5'.
			spec package: 'Athens-Cairo' with: 'Athens-Cairo-IgorStasenko.31'.
			spec package: 'Athens-PangoCairo' with: 'Athens-PangoCairo-FernandoOlivero.11'.
			spec package: 'Athens-Examples' with: 'Athens-Examples-IgorStasenko.19'.
                ].! !

!ConfigurationOfAthens methodsFor: 'versions' stamp: 'NicolaiHess 2/26/2015 22:34'!
version30: spec 
        <version: '3.0' imports: #('2.3-baseline')>

       spec for: #common do: [
			spec description: '2015-02-26T22:34:12.141132+01:00'.
			spec blessing: #development.

			spec package: 'Athens-Core' with: 'Athens-Core-NicolaiHess.46'.
			spec package: 'Athens-Text' with: 'Athens-Text-NicolaiHess.16'.
			spec package: 'Athens-Balloon' with: 'Athens-Balloon-NicolaiHess.19'.
			spec package: 'Athens-Morphic' with: 'Athens-Morphic-NicolaiHess.44'.
			spec package: 'Athens-CairoPools' with: 'Athens-CairoPools-NicolaiHess.14'.
			spec package: 'Athens-Cairo' with: 'Athens-Cairo-NicolaiHess.84'.
			spec package: 'Athens-Examples' with: 'Athens-Examples-NicolaiHess.41'.
			spec package: 'Athens-Tutorial' with: 'Athens-Tutorial-StephaneDucasse.10'.
			spec package: 'Athens-SVG' with: 'Athens-SVG-StephaneDucasse.12' ]! !

!ConfigurationOfAthens methodsFor: 'versions' stamp: 'IgorStasenko 3/8/2012 17:53'!
version012: spec 
        <version: '0.1.2' imports: #('1.0-baseline')>

        spec for: #common do: [
               spec blessing: #development.
			spec project: 'ConfigurationOfNativeBoost default'  with: '1.0.8'.

			spec package: 'NativeBoost-Installer' with: 'NativeBoost-Installer-IgorStasenko.23'.
			spec package: 'Athens-Core' with: 'Athens-Core-IgorStasenko.6'.
			spec package: 'Athens-Text' with: 'Athens-Text-IgorStasenko.2'.
			spec package: 'Athens-Balloon' with: 'Athens-Balloon-IgorStasenko.4'.
			spec package: 'Athens-Morphic' with: 'Athens-Morphic-IgorStasenko.2'.
			spec package: 'Athens-CairoPools' with: 'Athens-CairoPools-IgorStasenko.2'.
			spec package: 'Athens-Cairo' with: 'Athens-Cairo-IgorStasenko.8'.
			spec package: 'Athens-PangoCairo' with: 'Athens-PangoCairo-FernandoOlivero.3'.
			spec package: 'Athens-Examples' with: 'Athens-Examples-IgorStasenko.3'.
                ].! !

!ConfigurationOfAthens methodsFor: 'versions' stamp: 'JurajKubelka 2/8/2015 11:30'!
version28: spec 
        <version: '2.8' imports: #('2.3-baseline')>

       spec for: #common do: [
			spec description: '2015-02-08T11:28:56.487797-03:00'.
			spec blessing: #development.

			spec package: 'Athens-Core' with: 'Athens-Core-NicolaiHess.45'.
			spec package: 'Athens-Text' with: 'Athens-Text-NicolaiHess.16'.
			spec package: 'Athens-Balloon' with: 'Athens-Balloon-NicolaiHess.19'.
			spec package: 'Athens-Morphic' with: 'Athens-Morphic-NicolaiHess.38'.
			spec package: 'Athens-CairoPools' with: 'Athens-CairoPools-NicolaiHess.14'.
			spec package: 'Athens-Cairo' with: 'Athens-Cairo-NicolaiHess.82'.
			spec package: 'Athens-Examples' with: 'Athens-Examples-NicolaiHess.41'.
			spec package: 'Athens-Tutorial' with: 'Athens-Tutorial-StephaneDucasse.10'.
			spec package: 'Athens-SVG' with: 'Athens-SVG-StephaneDucasse.12' ]! !

!ConfigurationOfAthens methodsFor: 'baselines' stamp: 'JurajKubelka 2/8/2015 11:02'!
baseline11: spec 
        <version: '1.1-baseline'>
        
        spec for: #common do: [
		spec blessing: #baseline.
		spec repository: 'http://www.squeaksource.com/Athens'. 

		spec project: 'ConfigurationOfNativeBoost default' with: [
			spec
				className: 'ConfigurationOfNativeBoost';
				versionString: #'stable';
				loads: #('default' ); "this is optional"
				file: 'ConfigurationOfNativeBoost';
				repository: 'http://www.squeaksource.com/NativeBoost' ].
			
		spec package: 'Athens-Core' .
	
		spec package: 'Athens-Text'  with: [
			spec requires: #('Athens-Core') ].
			
		spec package: 'Athens-Balloon'  with: [
			spec requires: #('Athens-Text') ].
		
		spec package: 'Athens-Morphic'  with: [
			spec requires: #('Athens-Balloon') ].

		spec package: 'Athens-CairoPools'.
	
		spec package: 'Athens-Cairo'  with: [
			spec requires: #( 'ConfigurationOfNativeBoost default' 'Athens-Core' 'Athens-CairoPools' ) ].
	
		spec package: 'Athens-PangoCairo'  with: [
			spec requires: #( 'Athens-Cairo' ) ].
		
		spec package: 'Athens-Examples' with: [
			spec requires: #('Athens-Morphic')].
			
		spec
			group: 'Core' with: #('Athens-Core' );
			group: 'default' with: #('Athens-Morphic' 'Athens-PangoCairo' 'Athens-Examples')
	].

! !

!ConfigurationOfAthens methodsFor: 'versions' stamp: 'EstebanLorenzano 12/8/2014 16:42'!
version27: spec 
        <version: '2.7' imports: #('2.3-baseline')>

       spec for: #common do: [
			spec description: '2014-12-08 16:40'.
			spec blessing: #development.

			spec package: 'Athens-Core' with: 'Athens-Core-NicolaiHess.45'.
			spec package: 'Athens-Text' with: 'Athens-Text-NicolaiHess.15'.
			spec package: 'Athens-Balloon' with: 'Athens-Balloon-NicolaiHess.19'.
			spec package: 'Athens-Morphic' with: 'Athens-Morphic-NicolaiHess.38'.
			spec package: 'Athens-CairoPools' with: 'Athens-CairoPools-NicolaiHess.14'.
			spec package: 'Athens-Cairo' with: 'Athens-Cairo-NicolaiHess.78'.
			spec package: 'Athens-Examples' with: 'Athens-Examples-NicolaiHess.41'.
			spec package: 'Athens-Tutorial' with: 'Athens-Tutorial-StephaneDucasse.10'.
			spec package: 'Athens-SVG' with: 'Athens-SVG-StephaneDucasse.12' ]! !

!ConfigurationOfAthens methodsFor: 'versions' stamp: 'IgorStasenko 4/27/2012 15:35'!
version11: spec 
        <version: '1.1' imports: #('1.1-baseline')>

        spec for: #common do: [
               spec blessing: #development.

			spec project: 'ConfigurationOfNativeBoost default'  with: '1.1.2'.
			spec package: 'Athens-Core' with: 'Athens-Core-IgorStasenko.17'.
			spec package: 'Athens-Text' with: 'Athens-Text-IgorStasenko.2'.
			spec package: 'Athens-Balloon' with: 'Athens-Balloon-IgorStasenko.6'.
			spec package: 'Athens-Morphic' with: 'Athens-Morphic-IgorStasenko.2'.
			spec package: 'Athens-CairoPools' with: 'Athens-CairoPools-FernandoOlivero.3'.
			spec package: 'Athens-Cairo' with: 'Athens-Cairo-IgorStasenko.23'.
			spec package: 'Athens-PangoCairo' with: 'Athens-PangoCairo-FernandoOlivero.6'.
			spec package: 'Athens-Examples' with: 'Athens-Examples-IgorStasenko.13'.
	].! !

!ConfigurationOfAthens methodsFor: 'versions' stamp: 'IgorStasenko 7/5/2012 08:53'!
version121: spec 
        <version: '1.2.1' imports: #('1.1-baseline')>

        spec for: #common do: [
                spec blessing: #development.
			spec project: 'ConfigurationOfNativeBoost default'  with: '1.2.1'.
			spec package: 'Athens-Core' with: 'Athens-Core-IgorStasenko.19'.
			spec package: 'Athens-Text' with: 'Athens-Text-IgorStasenko.3'.
			spec package: 'Athens-Balloon' with: 'Athens-Balloon-IgorStasenko.6'.
			spec package: 'Athens-Morphic' with: 'Athens-Morphic-IgorStasenko.2'.
			spec package: 'Athens-CairoPools' with: 'Athens-CairoPools-FernandoOlivero.4'.
			spec package: 'Athens-Cairo' with: 'Athens-Cairo-IgorStasenko.26'.
			spec package: 'Athens-PangoCairo' with: 'Athens-PangoCairo-FernandoOlivero.6'.
			spec package: 'Athens-Examples' with: 'Athens-Examples-IgorStasenko.15'.
                ].! !

!ConfigurationOfAthens methodsFor: 'versions' stamp: 'IgorStasenko 4/3/2013 06:30'!
version20: spec 
        <version: '2.0' imports: #('2.0-baseline')>

        spec for: #common do: [
                spec blessing: #development.

			spec package: 'Athens-Core' with: 'Athens-Core-IgorStasenko.25'.
			spec package: 'Athens-Text' with: 'Athens-Text-IgorStasenko.5'.
			spec package: 'Athens-Balloon' with: 'Athens-Balloon-IgorStasenko.7'.
			spec package: 'Athens-Morphic' with: 'Athens-Morphic-IgorStasenko.9'.
			spec package: 'Athens-CairoPools' with: 'Athens-CairoPools-IgorStasenko.5'.
			spec package: 'Athens-Cairo' with: 'Athens-Cairo-IgorStasenko.36'.
			spec package: 'Athens-PangoCairo' with: 'Athens-PangoCairo-FernandoOlivero.11'.
			spec package: 'Athens-Examples' with: 'Athens-Examples-DamienPollet.20'.
                ].! !

!ConfigurationOfAthens methodsFor: 'versions' stamp: 'IgorStasenko 4/20/2012 14:52'!
version10: spec 
        <version: '1.0' imports: #('1.1-baseline')>

        spec for: #common do: [
               spec blessing: #development.

			spec project: 'ConfigurationOfNativeBoost default'  with: '1.1.2'.
			spec package: 'Athens-Core' with: 'Athens-Core-FernandoOlivero.14'.
			spec package: 'Athens-Text' with: 'Athens-Text-IgorStasenko.2'.
			spec package: 'Athens-Balloon' with: 'Athens-Balloon-IgorStasenko.5'.
			spec package: 'Athens-Morphic' with: 'Athens-Morphic-IgorStasenko.2'.
			spec package: 'Athens-CairoPools' with: 'Athens-CairoPools-FernandoOlivero.3'.
			spec package: 'Athens-Cairo' with: 'Athens-Cairo-IgorStasenko.19'.
			spec package: 'Athens-PangoCairo' with: 'Athens-PangoCairo-FernandoOlivero.6'.
			spec package: 'Athens-Examples' with: 'Athens-Examples-IgorStasenko.11'.
	].! !

!ConfigurationOfAthens methodsFor: 'versions' stamp: 'NicolaiHess 3/22/2015 19:48'!
version31: spec 
        <version: '3.1' imports: #('2.3-baseline')>

       spec for: #common do: [
			spec description: '2015-03-22T19:46:20.991359+01:00'.
			spec blessing: #development.

			spec package: 'Athens-Core' with: 'Athens-Core-MarcusDenker.50'.
			spec package: 'Athens-Text' with: 'Athens-Text-NicolaiHess.16'.
			spec package: 'Athens-Balloon' with: 'Athens-Balloon-MarcusDenker.20'.
			spec package: 'Athens-Morphic' with: 'Athens-Morphic-NicolaiHess.44'.
			spec package: 'Athens-CairoPools' with: 'Athens-CairoPools-NicolaiHess.14'.
			spec package: 'Athens-Cairo' with: 'Athens-Cairo-MarcusDenker.85'.
			spec package: 'Athens-Examples' with: 'Athens-Examples-MarcusDenker.42'.
			spec package: 'Athens-Tutorial' with: 'Athens-Tutorial-StephaneDucasse.10'.
			spec package: 'Athens-SVG' with: 'Athens-SVG-StephaneDucasse.12' ]! !

!ConfigurationOfAthens methodsFor: 'versions' stamp: 'IgorStasenko 7/3/2013 16:56'!
version21: spec 
        <version: '2.1' imports: #('2.1-baseline')>

        spec for: #common do: [
                spec blessing: #development.

			spec package: 'Athens-Core' with: 'Athens-Core-IgorStasenko.32'.
			spec package: 'Athens-Text' with: 'Athens-Text-IgorStasenko.5'.
			spec package: 'Athens-Balloon' with: 'Athens-Balloon-IgorStasenko.10'.
			spec package: 'Athens-Morphic' with: 'Athens-Morphic-IgorStasenko.18'.
			spec package: 'Athens-CairoPools' with: 'Athens-CairoPools-IgorStasenko.6'.
			spec package: 'Athens-Cairo' with: 'Athens-Cairo-IgorStasenko.43'.
			spec package: 'Athens-PangoCairo' with: 'Athens-PangoCairo-FernandoOlivero.11'.
			spec package: 'Athens-Examples' with: 'Athens-Examples-IgorStasenko.22'.
			
			spec package: 'Athens-Tutorial' with: 'Athens-Tutorial-IgorStasenko.4'.
			spec package: 'Athens-SVG' with: 'Athens-SVG-IgorStasenko.7'
			
                ].! !

!ConfigurationOfAthens methodsFor: 'versions' stamp: 'IgorStasenko 5/31/2012 02:28'!
version12: spec 
        <version: '1.2' imports: #('1.1-baseline')>

        spec for: #common do: [
                spec blessing: #development.
			spec project: 'ConfigurationOfNativeBoost default'  with: '1.2'.
			spec package: 'Athens-Core' with: 'Athens-Core-IgorStasenko.18'.
			spec package: 'Athens-Text' with: 'Athens-Text-IgorStasenko.2'.
			spec package: 'Athens-Balloon' with: 'Athens-Balloon-IgorStasenko.6'.
			spec package: 'Athens-Morphic' with: 'Athens-Morphic-IgorStasenko.2'.
			spec package: 'Athens-CairoPools' with: 'Athens-CairoPools-FernandoOlivero.4'.
			spec package: 'Athens-Cairo' with: 'Athens-Cairo-IgorStasenko.25'.
			spec package: 'Athens-PangoCairo' with: 'Athens-PangoCairo-FernandoOlivero.6'.
			spec package: 'Athens-Examples' with: 'Athens-Examples-IgorStasenko.14'.
                ].! !

!ConfigurationOfAthens methodsFor: 'versions' stamp: 'FernandoOlivero 8/25/2013 11:03'!
version23: spec 
        <version: '2.3' imports: #('2.2-baseline')>

       spec for: #common do: [
 	 	  spec description: 'removing pango cairo from the version, since it was only used for Shapes'.
               spec blessing: #development.

			spec package: 'Athens-Core' with: 'Athens-Core-IgorStasenko.35'.
			spec package: 'Athens-Text' with: 'Athens-Text-IgorStasenko.6'.
			spec package: 'Athens-Balloon' with: 'Athens-Balloon-IgorStasenko.10'.
			spec package: 'Athens-Morphic' with: 'Athens-Morphic-IgorStasenko.20'.
			spec package: 'Athens-CairoPools' with: 'Athens-CairoPools-IgorStasenko.8'.
			spec package: 'Athens-Cairo' with: 'Athens-Cairo-IgorStasenko.48'.
			spec package: 'Athens-Examples' with: 'Athens-Examples-IgorStasenko.25'.
			spec package: 'Athens-Tutorial' with: 'Athens-Tutorial-IgorStasenko.6'.
			spec package: 'Athens-SVG' with: 'Athens-SVG-IgorStasenko.7'
			
                ].! !

!ConfigurationOfAthens methodsFor: 'versions' stamp: 'sig 2/29/2012 22:25'!
version011: spec 
        <version: '0.1.1' imports: #('1.0-baseline')>

        spec for: #common do: [
                spec blessing: #development.
			spec 
				project: 'ConfigurationOfNativeBoost default'  with: '1.0.6';
				package: 'NativeBoost-Installer' with: 'NativeBoost-Installer-IgorStasenko.21'.
	
			spec package: 'Athens-Core' with: 'Athens-Core-sig.5'.
			spec package: 'Athens-Text' with: 'Athens-Text-IgorStasenko.1'.
			spec package: 'Athens-Balloon' with: 'Athens-Balloon-sig.3'.
			spec package: 'Athens-Morphic' with: 'Athens-Morphic-IgorStasenko.1'.
			spec package: 'Athens-CairoPools' with: 'Athens-CairoPools-IgorStasenko.2'.
			spec package: 'Athens-Cairo' with: 'Athens-Cairo-IgorStasenko.7'.
			spec package: 'Athens-PangoCairo' with: 'Athens-PangoCairo-FernandoOlivero.3'.
			spec package: 'Athens-Examples' with: 'Athens-Examples-sig.2'.
                ].! !

!ConfigurationOfAthens class methodsFor: 'private' stamp: 'IgorStasenko 2/6/2012 16:29'!
baseConfigurationClassIfAbsent: aBlock

	^Smalltalk
		at: #MetacelloBaseConfiguration
		ifAbsent: [ 
			self ensureMetacelloBaseConfiguration.
			Smalltalk at: #MetacelloBaseConfiguration ifAbsent: aBlock ].
! !

!ConfigurationOfAthens class methodsFor: 'development support' stamp: 'IgorStasenko 2/6/2012 16:29'!
validate
	"Check the configuration for Errors, Critical Warnings, and Warnings (see class comment for MetacelloMCVersionValidator for more information). 
	Errors identify specification issues that will result in unexpected behaviour when you load the configuration. 
	Critical Warnings identify specification issues that may result in unexpected behavior when you load the configuration.
	Warnings identify specification issues that are technically correct, but are worth take a look at."

	"self validate"

	<apiDocumentation>
	self ensureMetacello.
	^ ((Smalltalk at: #MetacelloToolBox) validateConfiguration: self debug: #() recurse: false) explore! !

!ConfigurationOfAthens class methodsFor: 'metacello tool support' stamp: 'IgorStasenko 2/6/2012 16:29'!
isMetacelloConfig
	"Answer true and the Metacello tools will operate on you"
	
	^true! !

!ConfigurationOfAthens class methodsFor: 'loading' stamp: 'IgorStasenko 2/6/2012 16:29'!
loadBleedingEdge
	"Load the latest versions of the mcz files defined for this project. It is not likely that the #bleedingEdge has been tested."

	"self loadBleedingEdge"

	<apiDocumentation>
	^(self project version: #bleedingEdge) load! !

!ConfigurationOfAthens class methodsFor: 'loading' stamp: 'IgorStasenko 12/22/2012 01:01'!
loadStable
	"Load the #stable version defined for this platform. The #development version will change over time and is not expected to be stable."

	"self loadStable"

	<apiDocumentation>
	^(self project latestVersion: #stable) load! !

!ConfigurationOfAthens class methodsFor: 'private' stamp: 'IgorStasenko 2/6/2012 16:29'!
ensureMetacelloBaseConfiguration

	Smalltalk
		at: #MetacelloBaseConfiguration
		ifAbsent: [ 
			| repository version |
			repository := MCHttpRepository location: 'http://seaside.gemstone.com/ss/metacello' user: '' password: ''.
			repository
				versionReaderForFileNamed: 'Metacello-Base-DaleHenrichs.2.mcz'
				do: [ :reader | 
					version := reader version.
					version load.
					version workingCopy repositoryGroup addRepository: repository ] ]! !

!ConfigurationOfAthens class methodsFor: 'loading' stamp: 'IgorStasenko 2/6/2012 16:29'!
load
	"Load the #stable version defined for this platform. The #stable version is the version that is recommended to be used on this platform."

	"self load"

	<apiDocumentation>
	^(self project version: #stable) load! !

!ConfigurationOfAthens class methodsFor: 'development support' stamp: 'IgorStasenko 2/6/2012 16:29'!
DevelopmentSupport

"See the methods in the 'development support' category on the class-side of MetacelloBaseConfiguration. Decide what development support methods you would like to use and copy them the the class-side of your configuration."
	<apiDocumentation>
! !

!ConfigurationOfAthens class methodsFor: 'accessing' stamp: 'IgorStasenko 2/6/2012 16:29'!
project

	^self new project! !

!ConfigurationOfAthens class methodsFor: 'private' stamp: 'IgorStasenko 2/6/2012 16:29'!
ensureMetacello

	(self baseConfigurationClassIfAbsent: []) ensureMetacello! !

!ConfigurationOfAthens class methodsFor: 'loading' stamp: 'IgorStasenko 12/22/2012 01:01'!
loadDevelopment
	"Load the #development version defined for this platform. The #development version will change over time and is not expected to be stable."

	"self loadDevelopment"

	<apiDocumentation>
	^(self project latestVersion: #development) load! !

!ConfigurationOfAthens class methodsFor: 'loading' stamp: 'IgorStasenko 7/5/2012 08:56'!
loadVersion: aVersion
	"Load the specified version "

	^(self project version: aVersion) load! !

!ConfigurationOfGTInspectorCore commentStamp: 'AndreiChis 10/29/2014 12:02'!
Core configuration of GTInspector for integrating with Pharo.

self loadDevelopment!
!ConfigurationOfGTInspectorCore methodsFor: 'versions' stamp: 'AndreiChis 4/9/2015 23:50'!
version2011: spec
	<version: '2.0.11' imports: #('2.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.0.11'.
		spec author: 'AndreiChis'.
		spec timestamp: '04/06/2015 22:04'.
		spec project: 'GlamourCore' with: '3.1.0'.
		spec 
			package: 'GT-Inspector' with: 'GT-Inspector-TudorGirba.305';
			package: 'GT-InspectorExtensions-Core' with: 'GT-InspectorExtensions-Core-TudorGirba.144';
			package: 'GT-Tests-Inspector' with: 'GT-Tests-Inspector-StefanReichhart.33'. ].
! !

!ConfigurationOfGTInspectorCore methodsFor: 'versions' stamp: 'AndreiChis 12/10/2014 13:59'!
version205: spec
	<version: '2.0.5' imports: #('2.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.0.5'.
		spec author: 'AndreiChis'.
		spec timestamp: '12/10/2014 13:38'.
		
		spec 
			package: 'GT-Inspector' with: 'GT-Inspector-TudorGirba.275';
			package: 'GT-InspectorExtensions-Core' with: 'GT-InspectorExtensions-Core-TudorGirba.87';
			package: 'GT-Tests-Inspector' with: 'GT-Tests-Inspector-AndreiChis.24'. 
		spec 
			project: 'GlamourCore' with: '3.0.5'. ].
! !

!ConfigurationOfGTInspectorCore methodsFor: 'versions' stamp: 'AndreiChis 12/9/2014 12:12'!
version204: spec
	<version: '2.0.4' imports: #('2.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.0.4'.
		spec author: 'AndreiChis'.
		spec timestamp: '12/09/2014 12:08'.
		
		spec 
			package: 'GT-Inspector' with: 'GT-Inspector-EstebanLorenzano.271';
			package: 'GT-InspectorExtensions-Core' with: 'GT-InspectorExtensions-Core-TudorGirba.86';
			package: 'GT-Tests-Inspector' with: 'GT-Tests-Inspector-AndreiChis.24'. 
		spec 
			project: 'GlamourCore' with: '3.0.4'. ].
! !

!ConfigurationOfGTInspectorCore methodsFor: 'versions' stamp: 'AndreiChis 11/13/2014 13:57'!
version201: spec
	<version: '2.0.1' imports: #('2.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.0.1'.
		spec author: 'AndreiChis'.
		spec timestamp: '11/13/2014 13:54'.
		
		spec 
			package: #'GT-Inspector' with: 'GT-Inspector-BernardoContreras.267';
			package: 'GT-InspectorExtensions-Core' with: 'GT-InspectorExtensions-Core-TudorGirba.76';
			package: 'GT-Tests-Inspector' with: 'GT-Tests-Inspector-AndreiChis.24'. 
		spec 
			project: 'GlamourCore' with: '3.0.1'. ].
! !

!ConfigurationOfGTInspectorCore methodsFor: 'accessing' stamp: 'AndreiChis 10/29/2014 11:14'!
customProjectAttributes
	 "Edit to return a collection of any custom attributes e.g. for conditional loading: Array with: #'Condition1' with: #'Condition2.
	For more information see: http://code.google.com/p/metacello/wiki/CustomProjectAttrributes"

	^ #().! !

!ConfigurationOfGTInspectorCore methodsFor: 'symbolic versions' stamp: 'AndreiChis 4/11/2015 17:02'!
stable: spec
	<symbolicVersion: #'stable'>

	spec for: #'common' version: '2.0.12'.
	spec for: #'pharo3.x' version: '2.0.6'.


! !

!ConfigurationOfGTInspectorCore methodsFor: 'symbolic versions' stamp: 'AndreiChis 10/29/2014 12:00'!
development: spec
	<symbolicVersion: #'development'>

	spec for: #'common' version: '2.0-baseline'.
! !

!ConfigurationOfGTInspectorCore methodsFor: 'versions' stamp: 'AndreiChis 1/4/2015 10:09'!
version207: spec
	<version: '2.0.7' imports: #('2.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.0.7'.
		spec author: 'AndreiChis'.
		spec timestamp: '01/04/2015 14:07'.
		spec project: 'GlamourCore' with: '3.0.7'.
		spec 
			package: 'GT-Inspector' with: 'GT-Inspector-AndreiChis.276';
			package: 'GT-InspectorExtensions-Core' with: 'GT-InspectorExtensions-Core-TudorGirba.88';
			package: 'GT-Tests-Inspector' with: 'GT-Tests-Inspector-AndreiChis.24'. ].
! !

!ConfigurationOfGTInspectorCore methodsFor: 'versions' stamp: 'AndreiChis 1/8/2015 21:42'!
version209: spec
	<version: '2.0.9' imports: #('2.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.0.9'.
		spec author: 'AndreiChis'.
		spec timestamp: '01/08/2015 21:41'.
		spec project: 'GlamourCore' with: '3.0.9'.
		spec 
			package: 'GT-Inspector' with: 'GT-Inspector-TudorGirba.279';
			package: 'GT-InspectorExtensions-Core' with: 'GT-InspectorExtensions-Core-AndreiChis.92';
			package: 'GT-Tests-Inspector' with: 'GT-Tests-Inspector-AndreiChis.24'. ].
! !

!ConfigurationOfGTInspectorCore methodsFor: 'accessing' stamp: 'AndreiChis 10/29/2014 11:14'!
project

	^ project ifNil: [ 
		"Bootstrap Metacello if it is not already loaded"
		(self class baseConfigurationClassIfAbsent: []) ensureMetacello.
		"Construct Metacello project"
		project := MetacelloMCProject new projectAttributes: self customProjectAttributes. 
		(Smalltalk at: #MetacelloVersionConstructor) on: self project: project.
		project loadType: #linear. "change to #atomic if desired"
		project ]! !

!ConfigurationOfGTInspectorCore methodsFor: 'baselines' stamp: 'AndreiChis 10/29/2014 12:00'!
baseline20: spec
	<version: '2.0-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec description: 'GTInspector Core'.
		spec author: 'AndreiChis'.
		spec timestamp: '2014-10-29'.
		spec repository: 'http://smalltalkhub.com/mc/Moose/GToolkit/main/'.
		
		spec 
			package: 'GT-Inspector' with: [
				spec requires: #('GlamourCore' ). ];
			package: 'GT-InspectorExtensions-Core' with: [
				spec requires: #('GT-Inspector' 'GlamourCore' ). ];
			package: 'GT-Tests-Inspector' with: [
				spec requires: #('GT-Inspector' 'GT-InspectorExtensions-Core' ). ].
		
		spec 
			project: 'GlamourCore' with: [
				spec
					className: #ConfigurationOfGlamourCore;
					versionString: #'development';
					repository: 'http://smalltalkhub.com/mc/Moose/Glamour/main/' ].
		
		spec 
			group: 'Core' with: #('GT-Inspector' 'GT-InspectorExtensions-Core' );
			group: 'Tests' with: #('GT-Tests-Inspector' );
			group: 'default' with: #('GT-Inspector' 'GT-InspectorExtensions-Core' 'GT-Tests-Inspector' ) ]
! !

!ConfigurationOfGTInspectorCore methodsFor: 'versions' stamp: 'AndreiChis 1/7/2015 17:31'!
version208: spec
	<version: '2.0.8' imports: #('2.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.0.8'.
		spec author: 'AndreiChis'.
		spec timestamp: '01/07/2015 17:28'.
		spec project: 'GlamourCore' with: '3.0.8'.
		spec 
			package: 'GT-Inspector' with: 'GT-Inspector-TudorGirba.278';
			package: 'GT-InspectorExtensions-Core' with: 'GT-InspectorExtensions-Core-AndreiChis.91';
			package: 'GT-Tests-Inspector' with: 'GT-Tests-Inspector-AndreiChis.24'. ].
! !

!ConfigurationOfGTInspectorCore methodsFor: 'versions' stamp: 'AndreiChis 12/7/2014 14:03'!
version203: spec
	<version: '2.0.3' imports: #('2.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.0.3'.
		spec author: 'AndreiChis'.
		spec timestamp: '12/07/2014 13:58'.
		
		spec 
			package: 'GT-Inspector' with: 'GT-Inspector-EstebanLorenzano.271';
			package: 'GT-InspectorExtensions-Core' with: 'GT-InspectorExtensions-Core-TudorGirba.86';
			package: 'GT-Tests-Inspector' with: 'GT-Tests-Inspector-AndreiChis.24'. 
		spec 
			project: 'GlamourCore' with: '3.0.3'. ].
! !

!ConfigurationOfGTInspectorCore methodsFor: 'versions' stamp: 'AndreiChis 11/14/2014 11:51'!
version202: spec
	<version: '2.0.2' imports: #('2.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.0.2'.
		spec author: 'AndreiChis'.
		spec timestamp: '11/14/2014 11:48'.
		
		spec 
			package: #'GT-Inspector' with: 'GT-Inspector-BernardoContreras.267';
			package: 'GT-InspectorExtensions-Core' with: 'GT-InspectorExtensions-Core-TudorGirba.76';
			package: 'GT-Tests-Inspector' with: 'GT-Tests-Inspector-AndreiChis.24'. 
		spec 
			project: 'GlamourCore' with: '3.0.2'. ].
! !

!ConfigurationOfGTInspectorCore methodsFor: 'versions' stamp: 'TudorGirba 12/23/2014 21:25'!
version206: spec
	<version: '2.0.6' imports: #('2.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.0.6'.
		spec author: 'TudorGirba'.
		spec timestamp: '12/23/2014 14:07'.
		spec project: 'GlamourCore' with: '3.0.6'.
		spec 
			package: 'GT-Inspector' with: 'GT-Inspector-AndreiChis.276';
			package: 'GT-InspectorExtensions-Core' with: 'GT-InspectorExtensions-Core-TudorGirba.88';
			package: 'GT-Tests-Inspector' with: 'GT-Tests-Inspector-AndreiChis.24'. ].
! !

!ConfigurationOfGTInspectorCore methodsFor: 'versions' stamp: 'AndreiChis 4/11/2015 17:02'!
version2012: spec
	<version: '2.0.12' imports: #('2.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.0.12'.
		spec author: 'AndreiChis'.
		spec timestamp: '04/11/2015 18:02'.
		spec project: 'GlamourCore' with: '3.1.1'.
		spec 
			package: 'GT-Inspector' with: 'GT-Inspector-TudorGirba.305';
			package: 'GT-InspectorExtensions-Core' with: 'GT-InspectorExtensions-Core-TudorGirba.144';
			package: 'GT-Tests-Inspector' with: 'GT-Tests-Inspector-StefanReichhart.33'. ].
! !

!ConfigurationOfGTInspectorCore methodsFor: 'versions' stamp: 'AndreiChis 1/16/2015 19:10'!
version2010: spec
	<version: '2.0.10' imports: #('2.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.0.10'.
		spec author: 'AndreiChis'.
		spec timestamp: '01/16/2015 19:10'.
		spec project: 'GlamourCore' with: '3.0.10'.
		spec 
			package: 'GT-Inspector' with: 'GT-Inspector-TudorGirba.284';
			package: 'GT-InspectorExtensions-Core' with: 'GT-InspectorExtensions-Core-TudorGirba.93';
			package: 'GT-Tests-Inspector' with: 'GT-Tests-Inspector-AndreiChis.24'. ].
! !

!ConfigurationOfGTInspectorCore methodsFor: 'versions' stamp: 'AndreiChis 11/5/2014 19:23'!
version200: spec
	<version: '2.0.0' imports: #('2.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.0.0'.
		spec author: 'AndreiChis'.
		spec timestamp: '10/29/2014 17:01'.
		
		spec 
			package: #'GT-Inspector' with: 'GT-Inspector-TudorGirba.266';
			package: 'GT-InspectorExtensions-Core' with: 'GT-InspectorExtensions-Core-TudorGirba.74';
			package: 'GT-Tests-Inspector' with: 'GT-Tests-Inspector-AndreiChis.24'. 
		spec 
			project: 'GlamourCore' with: '3.0.0'. ].
! !

!ConfigurationOfGTInspectorCore class methodsFor: 'private' stamp: 'AndreiChis 10/29/2014 11:14'!
baseConfigurationClassIfAbsent: aBlock

	^Smalltalk
		at: #MetacelloBaseConfiguration
		ifAbsent: [ 
			self ensureMetacelloBaseConfiguration.
			Smalltalk at: #MetacelloBaseConfiguration ifAbsent: aBlock ].
! !

!ConfigurationOfGTInspectorCore class methodsFor: 'development support' stamp: 'AndreiChis 10/29/2014 11:14'!
validate
	"Check the configuration for Errors, Critical Warnings, and Warnings (see class comment for MetacelloMCVersionValidator for more information). 
	Errors identify specification issues that will result in unexpected behaviour when you load the configuration. 
	Critical Warnings identify specification issues that may result in unexpected behavior when you load the configuration.
	Warnings identify specification issues that are technically correct, but are worth take a look at."

	"self validate"

	<apiDocumentation>
	self ensureMetacello.
	^ ((Smalltalk at: #MetacelloToolBox) validateConfiguration: self debug: #() recurse: false) explore! !

!ConfigurationOfGTInspectorCore class methodsFor: 'metacello tool support' stamp: 'AndreiChis 10/29/2014 11:14'!
isMetacelloConfig
	"Answer true and the Metacello tools will operate on you"
	
	^true! !

!ConfigurationOfGTInspectorCore class methodsFor: 'loading' stamp: 'AndreiChis 10/29/2014 11:14'!
loadBleedingEdge
	"Load the latest versions of the mcz files defined for this project. It is not likely that the #bleedingEdge has been tested."

	"self loadBleedingEdge"

	<apiDocumentation>
	^(self project version: #bleedingEdge) load! !

!ConfigurationOfGTInspectorCore class methodsFor: 'private' stamp: 'AndreiChis 10/29/2014 11:14'!
ensureMetacelloBaseConfiguration

	Smalltalk
		at: #MetacelloBaseConfiguration
		ifAbsent: [ 
			| repository version |
			repository := MCHttpRepository location: 'http://seaside.gemstone.com/ss/metacello' user: '' password: ''.
			repository
				versionReaderForFileNamed: 'Metacello-Base-DaleHenrichs.2.mcz'
				do: [ :reader | 
					version := reader version.
					version load.
					version workingCopy repositoryGroup addRepository: repository ] ]! !

!ConfigurationOfGTInspectorCore class methodsFor: 'loading' stamp: 'AndreiChis 10/29/2014 11:14'!
load
	"Load the #stable version defined for this platform. The #stable version is the version that is recommended to be used on this platform."

	"self load"

	<apiDocumentation>
	^(self project version: #stable) load! !

!ConfigurationOfGTInspectorCore class methodsFor: 'development support' stamp: 'AndreiChis 10/29/2014 11:14'!
DevelopmentSupport

"See the methods in the 'development support' category on the class-side of MetacelloBaseConfiguration. Decide what development support methods you would like to use and copy them the the class-side of your configuration."
	<apiDocumentation>
! !

!ConfigurationOfGTInspectorCore class methodsFor: 'accessing' stamp: 'AndreiChis 10/29/2014 11:14'!
project

	^self new project! !

!ConfigurationOfGTInspectorCore class methodsFor: 'private' stamp: 'AndreiChis 10/29/2014 11:14'!
ensureMetacello

	(self baseConfigurationClassIfAbsent: []) ensureMetacello! !

!ConfigurationOfGTInspectorCore class methodsFor: 'loading' stamp: 'AndreiChis 10/29/2014 11:14'!
loadDevelopment
	"Load the #development version defined for this platform. The #development version will change over time and is not expected to be stable."

	"self loadDevelopment"

	<apiDocumentation>
	^(self project version: #development) load! !

!ConfigurationOfGTPlaygroundCore commentStamp: 'AndreiChis 10/29/2014 12:02'!
Core configuration of GTPlayground for integrating with Pharo.

self loadDevelopment!
!ConfigurationOfGTPlaygroundCore methodsFor: 'versions' stamp: 'AndreiChis 12/10/2014 14:02'!
version205: spec
	<version: '2.0.5' imports: #('2.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.0.5'.
		spec author: 'AndreiChis'.
		spec timestamp: '12/10/2014 13:38'.
		
		spec package: 'GT-Playground' with: 'GT-Playground-AndreiChis.53'.
		spec project: 'GTInspectorCore' with: '2.0.5'. ]
! !

!ConfigurationOfGTPlaygroundCore methodsFor: 'versions' stamp: 'AndreiChis 12/9/2014 12:11'!
version204: spec
	<version: '2.0.4' imports: #('2.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.0.4'.
		spec author: 'AndreiChis'.
		spec timestamp: '12/09/2014 12:08'.
		
		spec package: 'GT-Playground' with: 'GT-Playground-AndreiChis.52'.
		spec project: 'GTInspectorCore' with: '2.0.4'. ]
! !

!ConfigurationOfGTPlaygroundCore methodsFor: 'versions' stamp: 'AndreiChis 11/13/2014 13:55'!
version201: spec
	<version: '2.0.1' imports: #('2.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.0.1'.
		spec author: 'AndreiChis'.
		spec timestamp: '11/13/2014 13:54'.
		
		spec package: 'GT-Playground' with: 'GT-Playground-TudorGirba.49'.
		spec project: 'GTInspectorCore' with: '2.0.1'. ]
! !

!ConfigurationOfGTPlaygroundCore methodsFor: 'accessing' stamp: 'AndreiChis 10/29/2014 11:42'!
customProjectAttributes
	 "Edit to return a collection of any custom attributes e.g. for conditional loading: Array with: #'Condition1' with: #'Condition2.
	For more information see: http://code.google.com/p/metacello/wiki/CustomProjectAttrributes"

	^ #().! !

!ConfigurationOfGTPlaygroundCore methodsFor: 'symbolic versions' stamp: 'AndreiChis 4/11/2015 17:04'!
stable: spec
	<symbolicVersion: #'stable'>

	spec for: #'common' version: '2.1.1'.
	spec for: #'pharo3.x' version: '2.0.5'.
! !

!ConfigurationOfGTPlaygroundCore methodsFor: 'symbolic versions' stamp: 'AndreiChis 1/30/2015 17:27'!
development: spec
	<symbolicVersion: #'development'>

	spec for: #'common' version: '2.1-baseline'.
! !

!ConfigurationOfGTPlaygroundCore methodsFor: 'versions' stamp: 'AndreiChis 1/7/2015 17:26'!
version207: spec
	<version: '2.0.7' imports: #('2.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.0.7'.
		spec author: 'AndreiChis'.
		spec timestamp: '01/07/2015 17:25'.
		
		spec package: 'GT-Playground' with: 'GT-Playground-TudorGirba.54'.
		spec project: 'GTInspectorCore' with: '2.0.8'. ]
! !

!ConfigurationOfGTPlaygroundCore methodsFor: 'versions' stamp: 'AndreiChis 4/11/2015 17:04'!
version211: spec
	<version: '2.1.1' imports: #('2.1-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.1.1'.
		spec author: 'AndreiChis'.
		spec timestamp: '04/11/2015 18:03'.
		
		spec package: 'GT-Playground' with: 'GT-Playground-TudorGirba.110'.
		spec package: 'GT-Tests-Playground' with: 'GT-Tests-Playground-StefanReichhart.4'.
		spec project: 'GTInspectorCore' with: '2.0.12'. ]
	
! !

!ConfigurationOfGTPlaygroundCore methodsFor: 'versions' stamp: 'AndreiChis 1/16/2015 19:13'!
version209: spec
	<version: '2.0.9' imports: #('2.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.0.9'.
		spec author: 'AndreiChis'.
		spec timestamp: '01/16/2015 19:12'.
		
		spec package: 'GT-Playground' with: 'GT-Playground-AndreiChis.59'.
		spec project: 'GTInspectorCore' with: '2.0.10'. ]
! !

!ConfigurationOfGTPlaygroundCore methodsFor: 'accessing' stamp: 'AndreiChis 10/29/2014 11:42'!
project

	^ project ifNil: [ 
		"Bootstrap Metacello if it is not already loaded"
		(self class baseConfigurationClassIfAbsent: []) ensureMetacello.
		"Construct Metacello project"
		project := MetacelloMCProject new projectAttributes: self customProjectAttributes. 
		(Smalltalk at: #MetacelloVersionConstructor) on: self project: project.
		project loadType: #linear. "change to #atomic if desired"
		project ]! !

!ConfigurationOfGTPlaygroundCore methodsFor: 'baselines' stamp: 'AndreiChis 1/30/2015 17:26'!
baseline21: spec
	<version: '2.1-baseline'>

	spec for: #'common' do: [
	spec blessing: #'baseline'.
	spec repository: 'http://smalltalkhub.com/mc/Moose/GToolkit/main/'.
	
	spec package: 'GT-Playground' with: [
			spec requires: #('GTInspectorCore')].
	spec package: 'GT-Tests-Playground' with: [
			spec requires: #('GT-Playground')].
		
	spec project: 'GTInspectorCore' with: [
			spec
				className: #ConfigurationOfGTInspectorCore;
				versionString: #'development';
				repository: 'http://smalltalkhub.com/mc/Moose/GToolkit/main/' ].
	
	spec group: 'default' with: #('GT-Playground' 'GT-Tests-Playground') ].! !

!ConfigurationOfGTPlaygroundCore methodsFor: 'baselines' stamp: 'AndreiChis 10/29/2014 11:57'!
baseline20: spec
	<version: '2.0-baseline'>

	spec for: #'common' do: [
	spec blessing: #'baseline'.
	spec repository: 'http://smalltalkhub.com/mc/Moose/GToolkit/main/'.
	
	spec package: 'GT-Playground' with: [
			spec requires: #('GTInspectorCore' ). ].
		
	spec project: 'GTInspectorCore' with: [
			spec
				className: #ConfigurationOfGTInspectorCore;
				versionString: #'development';
				repository: 'http://smalltalkhub.com/mc/Moose/GToolkit/main/' ].
	
	spec group: 'default' with: #('GT-Playground' ) ].! !

!ConfigurationOfGTPlaygroundCore methodsFor: 'versions' stamp: 'AndreiChis 1/8/2015 21:43'!
version208: spec
	<version: '2.0.8' imports: #('2.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.0.8'.
		spec author: 'AndreiChis'.
		spec timestamp: '01/08/2015 21:43'.
		
		spec package: 'GT-Playground' with: 'GT-Playground-AndreiChis.56'.
		spec project: 'GTInspectorCore' with: '2.0.9'. ]
! !

!ConfigurationOfGTPlaygroundCore methodsFor: 'versions' stamp: 'AndreiChis 12/7/2014 14:00'!
version203: spec
	<version: '2.0.3' imports: #('2.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.0.3'.
		spec author: 'AndreiChis'.
		spec timestamp: '12/07/2014 13:48'.
		
		spec package: 'GT-Playground' with: 'GT-Playground-AndreiChis.52'.
		spec project: 'GTInspectorCore' with: '2.0.3'. ]
! !

!ConfigurationOfGTPlaygroundCore methodsFor: 'versions' stamp: 'AndreiChis 11/14/2014 11:48'!
version202: spec
	<version: '2.0.2' imports: #('2.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.0.2'.
		spec author: 'AndreiChis'.
		spec timestamp: '11/14/2014 11:48'.
		
		spec package: 'GT-Playground' with: 'GT-Playground-TudorGirba.49'.
		spec project: 'GTInspectorCore' with: '2.0.2'. ]
! !

!ConfigurationOfGTPlaygroundCore methodsFor: 'versions' stamp: 'AndreiChis 12/24/2014 10:52'!
version206: spec
	<version: '2.0.6' imports: #('2.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.0.6'.
		spec author: 'AndreiChis'.
		spec timestamp: '12/24/2014 10:50'.
		
		spec package: 'GT-Playground' with: 'GT-Playground-AndreiChis.53'.
		spec project: 'GTInspectorCore' with: '2.0.6'. ]
! !

!ConfigurationOfGTPlaygroundCore methodsFor: 'versions' stamp: 'AndreiChis 4/10/2015 13:19'!
version210: spec
	<version: '2.1.0' imports: #('2.1-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.1.0'.
		spec author: 'AndreiChis'.
		spec timestamp: '04/08/2015 22:11'.
		
		spec package: 'GT-Playground' with: 'GT-Playground-TudorGirba.109'.
		spec package: 'GT-Tests-Playground' with: 'GT-Tests-Playground-StefanReichhart.4'.
		spec project: 'GTInspectorCore' with: '2.0.11'. ]
	
! !

!ConfigurationOfGTPlaygroundCore methodsFor: 'versions' stamp: 'AndreiChis 11/5/2014 19:22'!
version200: spec
	<version: '2.0.0' imports: #('2.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.0.0'.
		spec author: 'AndreiChis'.
		spec timestamp: '10/29/2014 16:54'.
		
		spec package: 'GT-Playground' with: 'GT-Playground-AndreiChis.48'.
		spec project: 'GTInspectorCore' with: '2.0.0'. ]
! !

!ConfigurationOfGTPlaygroundCore class methodsFor: 'private' stamp: 'AndreiChis 10/29/2014 11:42'!
baseConfigurationClassIfAbsent: aBlock

	^Smalltalk
		at: #MetacelloBaseConfiguration
		ifAbsent: [ 
			self ensureMetacelloBaseConfiguration.
			Smalltalk at: #MetacelloBaseConfiguration ifAbsent: aBlock ].
! !

!ConfigurationOfGTPlaygroundCore class methodsFor: 'development support' stamp: 'AndreiChis 10/29/2014 11:42'!
validate
	"Check the configuration for Errors, Critical Warnings, and Warnings (see class comment for MetacelloMCVersionValidator for more information). 
	Errors identify specification issues that will result in unexpected behaviour when you load the configuration. 
	Critical Warnings identify specification issues that may result in unexpected behavior when you load the configuration.
	Warnings identify specification issues that are technically correct, but are worth take a look at."

	"self validate"

	<apiDocumentation>
	self ensureMetacello.
	^ ((Smalltalk at: #MetacelloToolBox) validateConfiguration: self debug: #() recurse: false) explore! !

!ConfigurationOfGTPlaygroundCore class methodsFor: 'metacello tool support' stamp: 'AndreiChis 10/29/2014 11:42'!
isMetacelloConfig
	"Answer true and the Metacello tools will operate on you"
	
	^true! !

!ConfigurationOfGTPlaygroundCore class methodsFor: 'loading' stamp: 'AndreiChis 10/29/2014 11:42'!
loadBleedingEdge
	"Load the latest versions of the mcz files defined for this project. It is not likely that the #bleedingEdge has been tested."

	"self loadBleedingEdge"

	<apiDocumentation>
	^(self project version: #bleedingEdge) load! !

!ConfigurationOfGTPlaygroundCore class methodsFor: 'private' stamp: 'AndreiChis 10/29/2014 11:42'!
ensureMetacelloBaseConfiguration

	Smalltalk
		at: #MetacelloBaseConfiguration
		ifAbsent: [ 
			| repository version |
			repository := MCHttpRepository location: 'http://seaside.gemstone.com/ss/metacello' user: '' password: ''.
			repository
				versionReaderForFileNamed: 'Metacello-Base-DaleHenrichs.2.mcz'
				do: [ :reader | 
					version := reader version.
					version load.
					version workingCopy repositoryGroup addRepository: repository ] ]! !

!ConfigurationOfGTPlaygroundCore class methodsFor: 'loading' stamp: 'AndreiChis 10/29/2014 11:42'!
load
	"Load the #stable version defined for this platform. The #stable version is the version that is recommended to be used on this platform."

	"self load"

	<apiDocumentation>
	^(self project version: #stable) load! !

!ConfigurationOfGTPlaygroundCore class methodsFor: 'development support' stamp: 'AndreiChis 10/29/2014 11:42'!
DevelopmentSupport

"See the methods in the 'development support' category on the class-side of MetacelloBaseConfiguration. Decide what development support methods you would like to use and copy them the the class-side of your configuration."
	<apiDocumentation>
! !

!ConfigurationOfGTPlaygroundCore class methodsFor: 'accessing' stamp: 'AndreiChis 10/29/2014 11:42'!
project

	^self new project! !

!ConfigurationOfGTPlaygroundCore class methodsFor: 'private' stamp: 'AndreiChis 10/29/2014 11:42'!
ensureMetacello

	(self baseConfigurationClassIfAbsent: []) ensureMetacello! !

!ConfigurationOfGTPlaygroundCore class methodsFor: 'loading' stamp: 'AndreiChis 10/29/2014 11:42'!
loadDevelopment
	"Load the #development version defined for this platform. The #development version will change over time and is not expected to be stable."

	"self loadDevelopment"

	<apiDocumentation>
	^(self project version: #development) load! !

!ConfigurationOfGTSpotter commentStamp: 'AndreiChis 12/7/2014 14:50'!
ConfigurationOfGTSpotter loadDevelopment!
!ConfigurationOfGTSpotter methodsFor: 'versions' stamp: 'TudorGirba 12/23/2014 21:25'!
version102: spec
	<version: '1.0.2' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: 'version 1.0.2'.
		spec author: 'TudorGirba'.
		spec timestamp: '12/23/2014 14:10'.
		spec project: 'GlamourCore' with: '3.0.6'.
		spec 
			package: 'GT-Spotter' with: 'GT-Spotter-TudorGirba.70';
			package: 'GT-SpotterExtensions-Core' with: 'GT-SpotterExtensions-Core-AliakseiSyrel.30'. ].
! !

!ConfigurationOfGTSpotter methodsFor: 'accessing' stamp: 'TudorGirba 11/27/2014 07:18'!
customProjectAttributes
	 "Edit to return a collection of any custom attributes e.g. for conditional loading: Array with: #'Condition1' with: #'Condition2.
	For more information see: http://code.google.com/p/metacello/wiki/CustomProjectAttrributes"

	^ #().! !

!ConfigurationOfGTSpotter methodsFor: 'symbolic versions' stamp: 'AndreiChis 4/11/2015 16:57'!
stable: spec
	<symbolicVersion: #'stable'>

	spec for: #'pharo4.x' version: '1.2.1'.
	spec for: #'pharo3.x' version: '1.0.4'.
! !

!ConfigurationOfGTSpotter methodsFor: 'symbolic versions' stamp: 'AndreiChis 3/20/2015 19:53'!
development: spec
	<symbolicVersion: #'development'>

	spec for: #'common' version: '1.2-baseline'.
	spec for: #'pharo3.x' version: '1.0.4'
! !

!ConfigurationOfGTSpotter methodsFor: 'versions' stamp: 'AndreiChis 12/9/2014 12:40'!
version100: spec
	<version: '1.0.0' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 1.0.0'.
		spec author: 'AndreiChis'.
		spec timestamp: '12/07/2014 14:48'.
		
		spec 
			package: 'GT-Spotter' with: 'GT-Spotter-AliakseiSyrel.61';
			package: 'GT-SpotterExtensions-Core' with: 'GT-SpotterExtensions-Core-AndreiChis.21'.
		spec 
			project: 'GlamourCore' with: '3.0.4'. ].
! !

!ConfigurationOfGTSpotter methodsFor: 'versions' stamp: 'TudorGirba 12/28/2014 00:56'!
version103: spec
	<version: '1.0.3' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 1.0.3'.
		spec author: 'TudorGirba'.
		spec timestamp: '12/28/2014 14:10'.
		spec project: 'GlamourCore' with: '3.0.6'.
		spec 
			package: 'GT-Spotter' with: 'GT-Spotter-AliakseiSyrel.75';
			package: 'GT-SpotterExtensions-Core' with: 'GT-SpotterExtensions-Core-AliakseiSyrel.30'. ].
! !

!ConfigurationOfGTSpotter methodsFor: 'baselines' stamp: 'AndreiChis 2/28/2015 20:20'!
baseline11: spec
	<version: '1.1-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec description: 'GT-Spotter-EventRecorder'.
		spec author: 'AndreiChis'.
		spec timestamp: '2015-02-28'.
		spec repository: 'http://smalltalkhub.com/mc/Moose/GToolkit/main/'.
		
		spec 
			package: 'GT-Spotter' with: [
				spec requires: #('GlamourCore' ). ];
			package: 'GT-Spotter-EventRecorder' with: [
				spec requires: #('GT-Spotter' ). ];
			package: 'GT-SpotterExtensions-Core' with: [
				spec requires: #('GT-Spotter' 'GlamourCore' ). ].
		
		spec 
			project: 'GlamourCore' with: [
				spec
					className: #ConfigurationOfGlamourCore;
					versionString: #'development';
					repository: 'http://smalltalkhub.com/mc/Moose/Glamour/main/' ].
		
		spec 
			group: 'Core' with: #('GT-Spotter' 'GT-SpotterExtensions-Core' );
			group: 'Tests' with: #('GT-Spotter' );
			group: 'default' with: #('Core' 'GT-Spotter-EventRecorder') ]! !

!ConfigurationOfGTSpotter methodsFor: 'accessing' stamp: 'TudorGirba 11/27/2014 07:18'!
project

	^ project ifNil: [ 
		"Bootstrap Metacello if it is not already loaded"
		(self class baseConfigurationClassIfAbsent: []) ensureMetacello.
		"Construct Metacello project"
		project := MetacelloMCProject new projectAttributes: self customProjectAttributes. 
		(Smalltalk at: #MetacelloVersionConstructor) on: self project: project.
		project loadType: #linear. "change to #atomic if desired"
		project ]! !

!ConfigurationOfGTSpotter methodsFor: 'versions' stamp: 'AndreiChis 1/16/2015 19:15'!
version107: spec
	<version: '1.0.7' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec author: 'AndreiChis'.
		spec timestamp: '01/16/2015 19:13'.
		spec project: 'GlamourCore' with: '3.0.10'.
		spec 
			package: 'GT-Spotter' with: 'GT-Spotter-TudorGirba.86';
			package: 'GT-SpotterExtensions-Core' with: 'GT-SpotterExtensions-Core-AndreiChis.37' ].
! !

!ConfigurationOfGTSpotter methodsFor: 'versions' stamp: 'AndreiChis 4/13/2015 00:03'!
version121: spec
	<version: '1.2.1' imports: #('1.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec author: 'AndreiChis'.
		spec timestamp: '04/11/2015 16:55'.
		spec project: 'GlamourCore' with: '3.1.1'.
		spec 
			package: 'GT-Spotter' with: 'GT-Spotter-StefanReichhart.307';
			package: 'GT-Spotter-EventRecorder' with: 'GT-Spotter-EventRecorder-JurajKubelka.89';
			package: 'GT-SpotterExtensions-Core' with: 'GT-SpotterExtensions-Core-TudorGirba.141';
			package: 'GT-Tests-Spotter' with: 'GT-Tests-Spotter-TudorGirba.8' ].! !

!ConfigurationOfGTSpotter methodsFor: 'baselines' stamp: 'TudorGirba 11/27/2014 07:32'!
baseline10: spec
	<version: '1.0-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec description: 'first shot'.
		spec author: 'TudorGirba'.
		spec timestamp: '2014-11-27'.
		spec repository: 'http://smalltalkhub.com/mc/Moose/GToolkit/main/'.
		
		spec 
			package: 'GT-Spotter' with: [
				spec requires: #('GlamourCore' ). ];
			package: 'GT-SpotterExtensions-Core' with: [
				spec requires: #('GT-Spotter' 'GlamourCore' ). ].
		
		spec 
			project: 'GlamourCore' with: [
				spec
					className: #ConfigurationOfGlamourCore;
					versionString: #'development';
					repository: 'http://smalltalkhub.com/mc/Moose/Glamour/main/' ].
		
		spec 
			group: 'Core' with: #('GT-Spotter' 'GT-SpotterExtensions-Core' );
			group: 'Tests' with: #('GT-Spotter' );
			group: 'default' with: #('Core') ]! !

!ConfigurationOfGTSpotter methodsFor: 'versions' stamp: 'TudorGirba 1/4/2015 10:01'!
version104: spec
	<version: '1.0.4' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 1.0.4 for Pharo 3.0'.
		spec author: 'TudorGirba'.
		spec timestamp: '1/04/2014 11:10'.
		spec project: 'GlamourCore' with: '3.0.7'.
		spec 
			package: 'GT-Spotter' with: 'GT-Spotter-AliakseiSyrel.75';
			package: 'GT-SpotterExtensions-Core' with: 'GT-SpotterExtensions-Core-AliakseiSyrel.30'. ].
! !

!ConfigurationOfGTSpotter methodsFor: 'baselines' stamp: 'AndreiChis 3/20/2015 19:53'!
baseline12: spec
	<version: '1.2-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec description: 'GT-Tests-Spotter'.
		spec author: 'AndreiChis'.
		spec timestamp: '2015-03-20'.
		spec repository: 'http://smalltalkhub.com/mc/Moose/GToolkit/main/'.
		
		spec 
			package: 'GT-Spotter' with: [
				spec requires: #('GlamourCore' ). ];
			package: 'GT-Spotter-EventRecorder' with: [
				spec requires: #('GT-Spotter' ). ];
			package: 'GT-SpotterExtensions-Core' with: [
				spec requires: #('GT-Spotter' 'GlamourCore' ) ];
			package: 'GT-Tests-Spotter' with: [
				spec requires: #('GT-Spotter' 'GT-SpotterExtensions-Core' ) ].
		
		spec 
			project: 'GlamourCore' with: [
				spec
					className: #ConfigurationOfGlamourCore;
					versionString: #'development';
					repository: 'http://smalltalkhub.com/mc/Moose/Glamour/main/' ].
		
		spec 
			group: 'Core' with: #('GT-Spotter' 'GT-SpotterExtensions-Core' );
			group: 'Tests' with: #('GT-Spotter' 'GT-Tests-Spotter');
			group: 'default' with: #('Core' 'Tests' 'GT-Spotter-EventRecorder') ]! !

!ConfigurationOfGTSpotter methodsFor: 'versions' stamp: 'AndreiChis 12/10/2014 14:04'!
version101: spec
	<version: '1.0.1' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 1.0.1'.
		spec author: 'AndreiChis'.
		spec timestamp: '12/10/2014 13:38'.
		
		spec 
			package: 'GT-Spotter' with: 'GT-Spotter-AliakseiSyrel.64';
			package: 'GT-SpotterExtensions-Core' with: 'GT-SpotterExtensions-Core-TudorGirba.22'.
		spec 
			project: 'GlamourCore' with: '3.0.5'. ].
! !

!ConfigurationOfGTSpotter methodsFor: 'versions' stamp: 'AndreiChis 1/7/2015 17:49'!
version105: spec
	<version: '1.0.5' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec author: 'AndreiChis'.
		spec timestamp: '1/07/2014 17:49'.
		spec project: 'GlamourCore' with: '3.0.8'.
		spec 
			package: 'GT-Spotter' with: 'GT-Spotter-AliakseiSyrel.76';
			package: 'GT-SpotterExtensions-Core' with: 'GT-SpotterExtensions-Core-AliakseiSyrel.30'. ].
! !

!ConfigurationOfGTSpotter methodsFor: 'versions' stamp: 'AndreiChis 4/10/2015 13:19'!
version120: spec
	<version: '1.2.0' imports: #('1.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec author: 'AndreiChis'.
		spec timestamp: '04/08/2015 21:57'.
		spec project: 'GlamourCore' with: '3.1.0'.
		spec 
			package: 'GT-Spotter' with: 'GT-Spotter-TudorGirba.305';
			package: 'GT-Spotter-EventRecorder' with: 'GT-Spotter-EventRecorder-JurajKubelka.85';
			package: 'GT-SpotterExtensions-Core' with: 'GT-SpotterExtensions-Core-AndreiChis.138';
			package: 'GT-Tests-Spotter' with: 'GT-Tests-Spotter-StefanReichhart.7' ].! !

!ConfigurationOfGTSpotter methodsFor: 'versions' stamp: 'AndreiChis 1/8/2015 21:46'!
version106: spec
	<version: '1.0.6' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec author: 'AndreiChis'.
		spec timestamp: '1/08/2014 21:45'.
		spec project: 'GlamourCore' with: '3.0.9'.
		spec 
			package: 'GT-Spotter' with: 'GT-Spotter-AliakseiSyrel.77';
			package: 'GT-SpotterExtensions-Core' with: 'GT-SpotterExtensions-Core-AndreiChis.34'. ].
! !

!ConfigurationOfGTSpotter class methodsFor: 'private' stamp: 'TudorGirba 11/27/2014 07:18'!
baseConfigurationClassIfAbsent: aBlock

	^Smalltalk
		at: #MetacelloBaseConfiguration
		ifAbsent: [ 
			self ensureMetacelloBaseConfiguration.
			Smalltalk at: #MetacelloBaseConfiguration ifAbsent: aBlock ].
! !

!ConfigurationOfGTSpotter class methodsFor: 'development support' stamp: 'TudorGirba 11/27/2014 07:18'!
validate
	"Check the configuration for Errors, Critical Warnings, and Warnings (see class comment for MetacelloMCVersionValidator for more information). 
	Errors identify specification issues that will result in unexpected behaviour when you load the configuration. 
	Critical Warnings identify specification issues that may result in unexpected behavior when you load the configuration.
	Warnings identify specification issues that are technically correct, but are worth take a look at."

	"self validate"

	<apiDocumentation>
	self ensureMetacello.
	^ ((Smalltalk at: #MetacelloToolBox) validateConfiguration: self debug: #() recurse: false) explore! !

!ConfigurationOfGTSpotter class methodsFor: 'metacello tool support' stamp: 'TudorGirba 11/27/2014 07:18'!
isMetacelloConfig
	"Answer true and the Metacello tools will operate on you"
	
	^true! !

!ConfigurationOfGTSpotter class methodsFor: 'loading' stamp: 'TudorGirba 11/27/2014 07:18'!
loadBleedingEdge
	"Load the latest versions of the mcz files defined for this project. It is not likely that the #bleedingEdge has been tested."

	"self loadBleedingEdge"

	<apiDocumentation>
	^(self project version: #bleedingEdge) load! !

!ConfigurationOfGTSpotter class methodsFor: 'private' stamp: 'TudorGirba 11/27/2014 07:18'!
ensureMetacelloBaseConfiguration

	Smalltalk
		at: #MetacelloBaseConfiguration
		ifAbsent: [ 
			| repository version |
			repository := MCHttpRepository location: 'http://seaside.gemstone.com/ss/metacello' user: '' password: ''.
			repository
				versionReaderForFileNamed: 'Metacello-Base-DaleHenrichs.2.mcz'
				do: [ :reader | 
					version := reader version.
					version load.
					version workingCopy repositoryGroup addRepository: repository ] ]! !

!ConfigurationOfGTSpotter class methodsFor: 'loading' stamp: 'TudorGirba 11/27/2014 07:18'!
load
	"Load the #stable version defined for this platform. The #stable version is the version that is recommended to be used on this platform."

	"self load"

	<apiDocumentation>
	^(self project version: #stable) load! !

!ConfigurationOfGTSpotter class methodsFor: 'development support' stamp: 'TudorGirba 11/27/2014 07:18'!
DevelopmentSupport

"See the methods in the 'development support' category on the class-side of MetacelloBaseConfiguration. Decide what development support methods you would like to use and copy them the the class-side of your configuration."
	<apiDocumentation>
! !

!ConfigurationOfGTSpotter class methodsFor: 'accessing' stamp: 'TudorGirba 11/27/2014 07:18'!
project

	^self new project! !

!ConfigurationOfGTSpotter class methodsFor: 'private' stamp: 'TudorGirba 11/27/2014 07:18'!
ensureMetacello

	(self baseConfigurationClassIfAbsent: []) ensureMetacello! !

!ConfigurationOfGTSpotter class methodsFor: 'loading' stamp: 'TudorGirba 11/27/2014 07:18'!
loadDevelopment
	"Load the #development version defined for this platform. The #development version will change over time and is not expected to be stable."

	"self loadDevelopment"

	<apiDocumentation>
	^(self project version: #development) load! !

!ConfigurationOfGToolkitCore commentStamp: 'AndreiChis 2/1/2015 14:39'!
ConfigurationOfGToolkitCore loadDevelopment

Instance Variables
	project:		<Object>

project
	- xxxxx
!
!ConfigurationOfGToolkitCore methodsFor: 'versions' stamp: 'AndreiChis 4/8/2015 22:15'!
version300: spec
	<version: '3.0.0' imports: #('3.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 3.0.0'.
		spec author: 'AndreiChis'.
		spec timestamp: '04/08/2015 22:11'.
		
		spec project: 'GTPlaygroundCore' with: '2.1.0'. 
		spec project: 'GTInspectorCore' with: '2.0.11'.
		spec project: 'GTSpotter' with: '1.2.0'. ]
	
! !

!ConfigurationOfGToolkitCore methodsFor: 'versions' stamp: 'AndreiChis 4/11/2015 17:05'!
version301: spec
	<version: '3.0.1' imports: #('3.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 3.0.1'.
		spec author: 'AndreiChis'.
		spec timestamp: '04/11/2015 18:05'.
		
		spec project: 'GTPlaygroundCore' with: '2.1.1'. 
		spec project: 'GTInspectorCore' with: '2.0.12'.
		spec project: 'GTSpotter' with: '1.2.1'. ]
	
! !

!ConfigurationOfGToolkitCore methodsFor: 'accessing' stamp: 'AndreiChis 2/1/2015 14:39'!
customProjectAttributes
	 "Edit to return a collection of any custom attributes e.g. for conditional loading: Array with: #'Condition1' with: #'Condition2.
	For more information see: http://code.google.com/p/metacello/wiki/CustomProjectAttrributes"

	^ #().! !

!ConfigurationOfGToolkitCore methodsFor: 'symbolic versions' stamp: 'AndreiChis 4/11/2015 17:05'!
stable: spec
	<symbolicVersion: #'stable'>

	spec for: #'common' version: '3.0.1'.
! !

!ConfigurationOfGToolkitCore methodsFor: 'symbolic versions' stamp: 'AndreiChis 4/1/2015 00:19'!
development: spec
	<symbolicVersion: #'development'>

	spec for: #'pharo3.x' version: '3.0-baseline'.
	spec for: #'pharo4.x' version: '3.0-baseline'.
! !

!ConfigurationOfGToolkitCore methodsFor: 'baselines' stamp: 'AndreiChis 3/3/2015 18:10'!
baseline30: spec
	<version: '3.0-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec repository: 'http://smalltalkhub.com/mc/Moose/GToolkit/main/'.
		
		spec project: 'GTPlaygroundCore' with: [
				spec
					className: #ConfigurationOfGTPlaygroundCore;
					versionString: #'development';
					repository: 'http://smalltalkhub.com/mc/Moose/GToolkit/main/' ].
		
		spec project: 'GTInspectorCore' with: [
				spec
					className: #ConfigurationOfGTInspectorCore;
					versionString: #'development';
					repository: 'http://smalltalkhub.com/mc/Moose/GToolkit/main/' ].
			
		spec project: 'GTSpotter' with: [
				spec
					className: #ConfigurationOfGTSpotter;
					versionString: #'development';
					repository: 'http://smalltalkhub.com/mc/Moose/GToolkit/main/' ].
		
		spec group: 'default' with: #('GTPlaygroundCore' 'GTInspectorCore' 'GTSpotter' ). ].
! !

!ConfigurationOfGToolkitCore methodsFor: 'accessing' stamp: 'AndreiChis 2/1/2015 14:39'!
project

	^ project ifNil: [ 
		"Bootstrap Metacello if it is not already loaded"
		(self class baseConfigurationClassIfAbsent: []) ensureMetacello.
		"Construct Metacello project"
		project := MetacelloMCProject new projectAttributes: self customProjectAttributes. 
		(Smalltalk at: #MetacelloVersionConstructor) on: self project: project.
		project loadType: #linear. "change to #atomic if desired"
		project ]! !

!ConfigurationOfGToolkitCore class methodsFor: 'private' stamp: 'AndreiChis 2/1/2015 14:39'!
baseConfigurationClassIfAbsent: aBlock

	^Smalltalk
		at: #MetacelloBaseConfiguration
		ifAbsent: [ 
			self ensureMetacelloBaseConfiguration.
			Smalltalk at: #MetacelloBaseConfiguration ifAbsent: aBlock ].
! !

!ConfigurationOfGToolkitCore class methodsFor: 'development support' stamp: 'AndreiChis 2/1/2015 14:39'!
validate
	"Check the configuration for Errors, Critical Warnings, and Warnings (see class comment for MetacelloMCVersionValidator for more information). 
	Errors identify specification issues that will result in unexpected behaviour when you load the configuration. 
	Critical Warnings identify specification issues that may result in unexpected behavior when you load the configuration.
	Warnings identify specification issues that are technically correct, but are worth take a look at."

	"self validate"

	<apiDocumentation>
	self ensureMetacello.
	^ ((Smalltalk at: #MetacelloToolBox) validateConfiguration: self debug: #() recurse: false) explore! !

!ConfigurationOfGToolkitCore class methodsFor: 'metacello tool support' stamp: 'AndreiChis 2/1/2015 14:39'!
isMetacelloConfig
	"Answer true and the Metacello tools will operate on you"
	
	^true! !

!ConfigurationOfGToolkitCore class methodsFor: 'loading' stamp: 'AndreiChis 2/1/2015 14:39'!
loadBleedingEdge
	"Load the latest versions of the mcz files defined for this project. It is not likely that the #bleedingEdge has been tested."

	"self loadBleedingEdge"

	<apiDocumentation>
	^(self project version: #bleedingEdge) load! !

!ConfigurationOfGToolkitCore class methodsFor: 'private' stamp: 'AndreiChis 2/1/2015 14:39'!
ensureMetacelloBaseConfiguration

	Smalltalk
		at: #MetacelloBaseConfiguration
		ifAbsent: [ 
			| repository version |
			repository := MCHttpRepository location: 'http://seaside.gemstone.com/ss/metacello' user: '' password: ''.
			repository
				versionReaderForFileNamed: 'Metacello-Base-DaleHenrichs.2.mcz'
				do: [ :reader | 
					version := reader version.
					version load.
					version workingCopy repositoryGroup addRepository: repository ] ]! !

!ConfigurationOfGToolkitCore class methodsFor: 'loading' stamp: 'AndreiChis 2/1/2015 14:39'!
load
	"Load the #stable version defined for this platform. The #stable version is the version that is recommended to be used on this platform."

	"self load"

	<apiDocumentation>
	^(self project version: #stable) load! !

!ConfigurationOfGToolkitCore class methodsFor: 'development support' stamp: 'AndreiChis 2/1/2015 14:39'!
DevelopmentSupport

"See the methods in the 'development support' category on the class-side of MetacelloBaseConfiguration. Decide what development support methods you would like to use and copy them the the class-side of your configuration."
	<apiDocumentation>
! !

!ConfigurationOfGToolkitCore class methodsFor: 'accessing' stamp: 'AndreiChis 2/1/2015 14:39'!
project

	^self new project! !

!ConfigurationOfGToolkitCore class methodsFor: 'private' stamp: 'AndreiChis 2/1/2015 14:39'!
ensureMetacello

	(self baseConfigurationClassIfAbsent: []) ensureMetacello! !

!ConfigurationOfGToolkitCore class methodsFor: 'loading' stamp: 'AndreiChis 2/1/2015 14:39'!
loadDevelopment
	"Load the #development version defined for this platform. The #development version will change over time and is not expected to be stable."

	"self loadDevelopment"

	<apiDocumentation>
	^(self project version: #development) load! !

!ConfigurationOfGlamourCore commentStamp: 'AndreiChis 10/29/2014 12:06'!
Core configuration of Glamour for integrating with Pharo.

self loadDevelopment!
!ConfigurationOfGlamourCore methodsFor: 'versions' stamp: 'AndreiChis 11/13/2014 14:04'!
version301: spec
	<version: '3.0.1' imports: #('3.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 3.0.1'.
		spec author: 'AndreiChis'.
		spec timestamp: '11/13/2014 13:54'.
		spec 
			package: 'Glamour-Announcements' with: 'Glamour-Announcements-AndreiChis.8';
			package: 'Glamour-Helpers' with: 'Glamour-Helpers-AndreiChis.36';
			package: 'Glamour-Core' with: 'Glamour-Core-BernardoContreras.286';
			package: 'Glamour-Presentations' with: 'Glamour-Presentations-AndreiChis.166';
			package: 'Glamour-Browsers' with: 'Glamour-Browsers-AndreiChis.106';
			package: 'Glamour-Tests-Core' with: 'Glamour-Tests-Core-AndreiChis.99';
			package: 'Glamour-Morphic-Widgets' with: 'Glamour-Morphic-Widgets-AliakseiSyrel.150';
			package: 'Glamour-Morphic-Renderer' with: [
				spec file: 'Glamour-Morphic-Renderer-AndreiChis.298'.
				spec repository: 'http://www.smalltalkhub.com/mc/PharoExtras/GTToolsIntegration/main' ];
			package: 'Glamour-Morphic-Brick' with: 'Glamour-Morphic-Brick-AndreiChis.17';
			package: 'Glamour-Morphic-Pager' with: 'Glamour-Morphic-Pager-MarcusDenker.72';
			package: 'Glamour-Morphic-Theme' with: 'Glamour-Morphic-Theme-TudorGirba.186';
			package: 'Glamour-Tests-Morphic' with: 'Glamour-Tests-Morphic-AndreiChis.118';
			package: 'Glamour-Examples' with: 'Glamour-Examples-MarcusDenker.289';
			package: 'Glamour-Rubric-Presentations' with: 'Glamour-Rubric-Presentations-TudorGirba.33';
			package: 'Glamour-Tests-Rubric' with: 'Glamour-Tests-Rubric-AndreiChis.14';
			package: 'Glamour-Tests-Resources' with: 'Glamour-Tests-Resources-AndreiChis.3'. 
		
		spec 
			project: 'Rubric' with: '1.2.3' ].

! !

!ConfigurationOfGlamourCore methodsFor: 'accessing' stamp: 'AndreiChis 10/28/2014 21:10'!
customProjectAttributes
	 "Edit to return a collection of any custom attributes e.g. for conditional loading: Array with: #'Condition1' with: #'Condition2.
	For more information see: http://code.google.com/p/metacello/wiki/CustomProjectAttrributes"

	^ #().! !

!ConfigurationOfGlamourCore methodsFor: 'symbolic versions' stamp: 'AndreiChis 4/11/2015 16:54'!
stable: spec
	<symbolicVersion: #'stable'>

	spec for: #'common' version: '3.1.1'.
	spec for: #'pharo3.x' version: '3.0.7'.
! !

!ConfigurationOfGlamourCore methodsFor: 'symbolic versions' stamp: 'AndreiChis 2/16/2015 16:26'!
development: spec
	<symbolicVersion: #'development'>

	spec for: #'common' version: '3.1-baseline'.
! !

!ConfigurationOfGlamourCore methodsFor: 'versions' stamp: 'AndreiChis 11/14/2014 12:13'!
version302: spec
	<version: '3.0.2' imports: #('3.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 3.0.2'.
		spec author: 'AndreiChis'.
		spec timestamp: '11/14/2014 11:48'.
		spec 
			package: 'Glamour-Announcements' with: 'Glamour-Announcements-AndreiChis.8';
			package: 'Glamour-Helpers' with: 'Glamour-Helpers-AndreiChis.36';
			package: 'Glamour-Core' with: 'Glamour-Core-BernardoContreras.286';
			package: 'Glamour-Presentations' with: 'Glamour-Presentations-AndreiChis.166';
			package: 'Glamour-Browsers' with: 'Glamour-Browsers-AndreiChis.106';
			package: 'Glamour-Tests-Core' with: 'Glamour-Tests-Core-AndreiChis.99';
			package: 'Glamour-Morphic-Widgets' with: 'Glamour-Morphic-Widgets-AndreiChis.151';
			package: 'Glamour-Morphic-Renderer' with: [
				spec file: 'Glamour-Morphic-Renderer-AndreiChis.301'.
				spec repository: 'http://www.smalltalkhub.com/mc/PharoExtras/GTToolsIntegration/main' ];
			package: 'Glamour-Morphic-Brick' with: 'Glamour-Morphic-Brick-AndreiChis.17';
			package: 'Glamour-Morphic-Pager' with: 'Glamour-Morphic-Pager-MarcusDenker.72';
			package: 'Glamour-Morphic-Theme' with: 'Glamour-Morphic-Theme-TudorGirba.186';
			package: 'Glamour-Tests-Morphic' with: 'Glamour-Tests-Morphic-AndreiChis.118';
			package: 'Glamour-Examples' with: 'Glamour-Examples-MarcusDenker.289';
			package: 'Glamour-Rubric-Presentations' with: 'Glamour-Rubric-Presentations-TudorGirba.33';
			package: 'Glamour-Tests-Rubric' with: 'Glamour-Tests-Rubric-AndreiChis.14';
			package: 'Glamour-Tests-Resources' with: 'Glamour-Tests-Resources-AndreiChis.3'. 
		
		spec 
			project: 'Rubric' with: '1.2.4' ].

! !

!ConfigurationOfGlamourCore methodsFor: 'versions' stamp: 'AndreiChis 12/9/2014 12:08'!
version304: spec
	<version: '3.0.4' imports: #('3.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 3.0.4'.
		spec author: 'AndreiChis'.
		spec timestamp: '12/09/2014 12:08'.
		spec 
			package: 'Glamour-Announcements' with: 'Glamour-Announcements-AndreiChis.8';
			package: 'Glamour-Helpers' with: 'Glamour-Helpers-AndreiChis.36';
			package: 'Glamour-Core' with: 'Glamour-Core-BernardoContreras.286';
			package: 'Glamour-Presentations' with: 'Glamour-Presentations-AndreiChis.166';
			package: 'Glamour-Browsers' with: 'Glamour-Browsers-BernardoContreras.107';
			package: 'Glamour-Tests-Core' with: 'Glamour-Tests-Core-AndreiChis.99';
			package: 'Glamour-Morphic-Widgets' with: 'Glamour-Morphic-Widgets-AndreiChis.153';
			package: 'Glamour-Morphic-Renderer' with: [
				spec file: 'Glamour-Morphic-Renderer-AndreiChis.301'.
				spec repository: 'http://www.smalltalkhub.com/mc/PharoExtras/GTToolsIntegration/main' ];
			package: 'Glamour-Morphic-Brick' with: 'Glamour-Morphic-Brick-AliakseiSyrel.82';
			package: 'Glamour-Morphic-Pager' with: 'Glamour-Morphic-Pager-AliakseiSyrel.78';
			package: 'Glamour-Morphic-Theme' with: 'Glamour-Morphic-Theme-TudorGirba.194';
			package: 'Glamour-Tests-Morphic' with: 'Glamour-Tests-Morphic-AndreiChis.118';
			package: 'Glamour-Examples' with: 'Glamour-Examples-TudorGirba.290';
			package: 'Glamour-Rubric-Presentations' with: 'Glamour-Rubric-Presentations-TudorGirba.33';
			package: 'Glamour-Tests-Rubric' with: 'Glamour-Tests-Rubric-AndreiChis.14';
			package: 'Glamour-Tests-Resources' with: 'Glamour-Tests-Resources-AndreiChis.3'. 
		
		spec 
			project: 'Rubric' with: '1.2.5' ].

! !

!ConfigurationOfGlamourCore methodsFor: 'accessing' stamp: 'AndreiChis 10/28/2014 21:10'!
project

	^ project ifNil: [ 
		"Bootstrap Metacello if it is not already loaded"
		(self class baseConfigurationClassIfAbsent: []) ensureMetacello.
		"Construct Metacello project"
		project := MetacelloMCProject new projectAttributes: self customProjectAttributes. 
		(Smalltalk at: #MetacelloVersionConstructor) on: self project: project.
		project loadType: #linear. "change to #atomic if desired"
		project ]! !

!ConfigurationOfGlamourCore methodsFor: 'versions' stamp: 'AndreiChis 12/10/2014 13:50'!
version305: spec
	<version: '3.0.5' imports: #('3.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 3.0.5'.
		spec author: 'AndreiChis'.
		spec timestamp: '12/10/2014 13:38'.
		spec 
			package: 'Glamour-Announcements' with: 'Glamour-Announcements-AndreiChis.8';
			package: 'Glamour-Helpers' with: 'Glamour-Helpers-AndreiChis.36';
			package: 'Glamour-Core' with: 'Glamour-Core-BernardoContreras.286';
			package: 'Glamour-Presentations' with: 'Glamour-Presentations-AndreiChis.166';
			package: 'Glamour-Browsers' with: 'Glamour-Browsers-BernardoContreras.107';
			package: 'Glamour-Tests-Core' with: 'Glamour-Tests-Core-AndreiChis.99';
			package: 'Glamour-Morphic-Widgets' with: 'Glamour-Morphic-Widgets-AndreiChis.153';
			package: 'Glamour-Morphic-Renderer' with: [
				spec file: 'Glamour-Morphic-Renderer-AndreiChis.305'.
				spec repository: 'http://www.smalltalkhub.com/mc/PharoExtras/GTToolsIntegration/main' ];
			package: 'Glamour-Morphic-Brick' with: 'Glamour-Morphic-Brick-AliakseiSyrel.86';
			package: 'Glamour-Morphic-Pager' with: 'Glamour-Morphic-Pager-AliakseiSyrel.80';
			package: 'Glamour-Morphic-Theme' with: 'Glamour-Morphic-Theme-TudorGirba.194';
			package: 'Glamour-Tests-Morphic' with: 'Glamour-Tests-Morphic-AndreiChis.118';
			package: 'Glamour-Examples' with: 'Glamour-Examples-TudorGirba.290';
			package: 'Glamour-Rubric-Presentations' with: 'Glamour-Rubric-Presentations-TudorGirba.33';
			package: 'Glamour-Tests-Rubric' with: 'Glamour-Tests-Rubric-AndreiChis.14';
			package: 'Glamour-Tests-Resources' with: 'Glamour-Tests-Resources-AndreiChis.3'. 
		
		spec 
			project: 'Rubric' with: '1.2.5' ].

! !

!ConfigurationOfGlamourCore methodsFor: 'versions' stamp: 'TudorGirba 12/23/2014 22:24'!
version306: spec
	<version: '3.0.6' imports: #('3.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 3.0.6'.
		spec author: 'TudorGirba'.
		spec timestamp: '12/22/2014 21:38'.
		spec 
			package: 'Glamour-Announcements' with: 'Glamour-Announcements-AndreiChis.8';
			package: 'Glamour-Helpers' with: 'Glamour-Helpers-AndreiChis.36';
			package: 'Glamour-Core' with: 'Glamour-Core-EstebanLorenzano.287';
			package: 'Glamour-Presentations' with: 'Glamour-Presentations-AndreiChis.166';
			package: 'Glamour-Browsers' with: 'Glamour-Browsers-BernardoContreras.107';
			package: 'Glamour-Tests-Core' with: 'Glamour-Tests-Core-EstebanLorenzano.100';
			package: 'Glamour-Morphic-Widgets' with: 'Glamour-Morphic-Widgets-AndreiChis.153';
			package: 'Glamour-Morphic-Renderer' with: [
				spec file: 'Glamour-Morphic-Renderer-AndreiChis.305'.
				spec repository: 'http://www.smalltalkhub.com/mc/PharoExtras/GTToolsIntegration/main' ];
			package: 'Glamour-Morphic-Brick' with: 'Glamour-Morphic-Brick-AliakseiSyrel.88';
			package: 'Glamour-Morphic-Pager' with: 'Glamour-Morphic-Pager-AliakseiSyrel.82';
			package: 'Glamour-Morphic-Theme' with: 'Glamour-Morphic-Theme-TudorGirba.194';
			package: 'Glamour-Tests-Morphic' with: 'Glamour-Tests-Morphic-AndreiChis.118';
			package: 'Glamour-Examples' with: 'Glamour-Examples-TudorGirba.290';
			package: 'Glamour-Rubric-Presentations' with: 'Glamour-Rubric-Presentations-TudorGirba.33';
			package: 'Glamour-Tests-Rubric' with: 'Glamour-Tests-Rubric-AndreiChis.14';
			package: 'Glamour-Tests-Resources' with: 'Glamour-Tests-Resources-AndreiChis.3'. 
		
		spec 
			project: 'Rubric' with: '1.2.6' ].

! !

!ConfigurationOfGlamourCore methodsFor: 'versions' stamp: 'AndreiChis 12/27/2014 13:42'!
version307: spec
	<version: '3.0.7' imports: #('3.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 3.0.7'.
		spec author: 'AndreiChis'.
		spec timestamp: '12/27/2014 13:41'.
		spec 
			package: 'Glamour-Announcements' with: 'Glamour-Announcements-AndreiChis.8';
			package: 'Glamour-Helpers' with: 'Glamour-Helpers-AndreiChis.36';
			package: 'Glamour-Core' with: 'Glamour-Core-EstebanLorenzano.287';
			package: 'Glamour-Presentations' with: 'Glamour-Presentations-AndreiChis.166';
			package: 'Glamour-Browsers' with: 'Glamour-Browsers-BernardoContreras.107';
			package: 'Glamour-Tests-Core' with: 'Glamour-Tests-Core-EstebanLorenzano.100';
			package: 'Glamour-Morphic-Widgets' with: 'Glamour-Morphic-Widgets-AndreiChis.153';
			package: 'Glamour-Morphic-Renderer' with:'Glamour-Morphic-Renderer-AndreiChis.303';
			package: 'Glamour-Morphic-Brick' with: 'Glamour-Morphic-Brick-AliakseiSyrel.88';
			package: 'Glamour-Morphic-Pager' with: 'Glamour-Morphic-Pager-AliakseiSyrel.82';
			package: 'Glamour-Morphic-Theme' with: 'Glamour-Morphic-Theme-TudorGirba.194';
			package: 'Glamour-Tests-Morphic' with: 'Glamour-Tests-Morphic-AndreiChis.118';
			package: 'Glamour-Examples' with: 'Glamour-Examples-TudorGirba.290';
			package: 'Glamour-Rubric-Presentations' with: 'Glamour-Rubric-Presentations-TudorGirba.33';
			package: 'Glamour-Tests-Rubric' with: 'Glamour-Tests-Rubric-AndreiChis.14';
			package: 'Glamour-Tests-Resources' with: 'Glamour-Tests-Resources-AndreiChis.3'. 
		
		spec 
			project: 'Rubric' with: '1.2.6' ].

! !

!ConfigurationOfGlamourCore methodsFor: 'versions' stamp: 'AndreiChis 1/7/2015 17:42'!
version308: spec
	<version: '3.0.8' imports: #('3.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 3.0.8'.
		spec author: 'AndreiChis'.
		spec timestamp: '01/07/2015 17:33'.
		spec 
			package: 'Glamour-Announcements' with: 'Glamour-Announcements-AndreiChis.8';
			package: 'Glamour-Browsers' with: 'Glamour-Browsers-BernardoContreras.107';
			package: 'Glamour-Core' with: 'Glamour-Core-EstebanLorenzano.287';
			package: 'Glamour-Examples' with: 'Glamour-Examples-TudorGirba.290';
			package: 'Glamour-Helpers' with: 'Glamour-Helpers-AndreiChis.36';
			package: 'Glamour-Morphic-Brick' with: 'Glamour-Morphic-Brick-AliakseiSyrel.92';
			package: 'Glamour-Morphic-Pager' with: 'Glamour-Morphic-Pager-AliakseiSyrel.82';
			package: 'Glamour-Morphic-Renderer' with:'Glamour-Morphic-Renderer-AndreiChis.304';
			package: 'Glamour-Morphic-Theme' with: 'Glamour-Morphic-Theme-TudorGirba.195';
			package: 'Glamour-Morphic-Widgets' with: 'Glamour-Morphic-Widgets-AndreiChis.154';
			package: 'Glamour-Presentations' with: 'Glamour-Presentations-AndreiChis.166';
			package: 'Glamour-Rubric-Presentations' with: 'Glamour-Rubric-Presentations-AndreiChis.35';
			package: 'Glamour-Tests-Core' with: 'Glamour-Tests-Core-EstebanLorenzano.100';
			package: 'Glamour-Tests-Morphic' with: 'Glamour-Tests-Morphic-AndreiChis.119';
			package: 'Glamour-Tests-Resources' with: 'Glamour-Tests-Resources-AndreiChis.3';
			package: 'Glamour-Tests-Rubric' with: 'Glamour-Tests-Rubric-AndreiChis.14'. 
		
		spec 
			project: 'Rubric' with: '1.2.7' ].

! !

!ConfigurationOfGlamourCore methodsFor: 'versions' stamp: 'AndreiChis 1/8/2015 21:40'!
version309: spec
	<version: '3.0.9' imports: #('3.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 3.0.9'.
		spec author: 'AndreiChis'.
		spec timestamp: '01/08/2015 21:33'.
		spec 
			package: 'Glamour-Announcements' with: 'Glamour-Announcements-AndreiChis.8';
			package: 'Glamour-Browsers' with: 'Glamour-Browsers-BernardoContreras.107';
			package: 'Glamour-Core' with: 'Glamour-Core-EstebanLorenzano.287';
			package: 'Glamour-Examples' with: 'Glamour-Examples-TudorGirba.290';
			package: 'Glamour-Helpers' with: 'Glamour-Helpers-AndreiChis.36';
			package: 'Glamour-Morphic-Brick' with: 'Glamour-Morphic-Brick-AliakseiSyrel.96';
			package: 'Glamour-Morphic-Pager' with: 'Glamour-Morphic-Pager-AndreiChis.83';
			package: 'Glamour-Morphic-Renderer' with:'Glamour-Morphic-Renderer-AndreiChis.304';
			package: 'Glamour-Morphic-Theme' with: 'Glamour-Morphic-Theme-TudorGirba.195';
			package: 'Glamour-Morphic-Widgets' with: 'Glamour-Morphic-Widgets-AndreiChis.154';
			package: 'Glamour-Presentations' with: 'Glamour-Presentations-AndreiChis.166';
			package: 'Glamour-Rubric-Presentations' with: 'Glamour-Rubric-Presentations-AndreiChis.35';
			package: 'Glamour-Tests-Core' with: 'Glamour-Tests-Core-AndreiChis.101';
			package: 'Glamour-Tests-Morphic' with: 'Glamour-Tests-Morphic-AndreiChis.120';
			package: 'Glamour-Tests-Resources' with: 'Glamour-Tests-Resources-AndreiChis.3';
			package: 'Glamour-Tests-Rubric' with: 'Glamour-Tests-Rubric-AndreiChis.14'. 
		
		spec 
			project: 'Rubric' with: '1.2.7' ].

! !

!ConfigurationOfGlamourCore methodsFor: 'versions' stamp: 'AndreiChis 11/6/2014 14:52'!
version300: spec
	<version: '3.0.0' imports: #('3.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 3.0.0'.
		spec author: 'AndreiChis'.
		spec timestamp: '10/28/2014 14:17'.
		spec 
			package: 'Glamour-Announcements' with: 'Glamour-Announcements-AndreiChis.8';
			package: 'Glamour-Helpers' with: 'Glamour-Helpers-AndreiChis.36';
			package: 'Glamour-Core' with: 'Glamour-Core-TudorGirba.285';
			package: 'Glamour-Presentations' with: 'Glamour-Presentations-AndreiChis.166';
			package: 'Glamour-Browsers' with: 'Glamour-Browsers-AndreiChis.106';
			package: 'Glamour-Tests-Core' with: 'Glamour-Tests-Core-AndreiChis.99';
			package: 'Glamour-Morphic-Widgets' with: 'Glamour-Morphic-Widgets-AliakseiSyrel.150';
			package: 'Glamour-Morphic-Renderer' with: [
				spec file: 'Glamour-Morphic-Renderer-AndreiChis.298'.
				spec repository: 'http://www.smalltalkhub.com/mc/PharoExtras/GTToolsIntegration/main' ];
			package: 'Glamour-Morphic-Brick' with: 'Glamour-Morphic-Brick-AliakseiSyrel.15';
			package: 'Glamour-Morphic-Pager' with: 'Glamour-Morphic-Pager-AndreiChis.71';
			package: 'Glamour-Morphic-Theme' with: 'Glamour-Morphic-Theme-TudorGirba.186';
			package: 'Glamour-Tests-Morphic' with: 'Glamour-Tests-Morphic-AndreiChis.118';
			package: 'Glamour-Examples' with: 'Glamour-Examples-TudorGirba.288';
			package: 'Glamour-Rubric-Presentations' with: 'Glamour-Rubric-Presentations-TudorGirba.33';
			package: 'Glamour-Tests-Rubric' with: 'Glamour-Tests-Rubric-AndreiChis.14';
			package: 'Glamour-Tests-Resources' with: 'Glamour-Tests-Resources-AndreiChis.3'. 
		
		spec 
			project: 'Rubric' with: '1.2.2' ].

! !

!ConfigurationOfGlamourCore methodsFor: 'baselines' stamp: 'AndreiChis 3/3/2015 19:12'!
baseline31: spec
	<version: '3.1-baseline'>
	
	spec for: #common do: [
		spec blessing: #baseline.
		spec description: 'Brick Tests'.
		spec repository: 'http://www.smalltalkhub.com/mc/Moose/Glamour/main'.
		spec 
			package: 'Glamour-Announcements' ;
			package: 'Glamour-Helpers';
			package: 'Glamour-Core' with: [spec requires: #('Glamour-Helpers' 'Glamour-Announcements')];
			package: 'Glamour-Presentations' with: [spec requires: #('Glamour-Core')];
			package: 'Glamour-Rubric-Presentations' with: [spec requires: #('Rubric' 'Glamour-Presentations')];
			package: 'Glamour-Browsers' with: [spec requires: #('Glamour-Core')];
			package: 'Glamour-Examples' with: [spec requires: #('Glamour-Core')];
			package: 'Glamour-Morphic-Brick' with: [spec requires: #('Glamour-Core')];
			package: 'Glamour-Morphic-Brick-Tests' with: [spec requires: #('Glamour-Morphic-Brick')];
			package: 'Glamour-Morphic-Widgets' with: [spec requires: #('Rubric' 'Glamour-Morphic-Brick')];
			package: 'Glamour-Morphic-Renderer' with: [spec requires: #('Glamour-Morphic-Widgets' 'Glamour-Core')];
			package: 'Glamour-Morphic-Pager' with: [spec requires: #('Glamour-Morphic-Renderer' 'Glamour-Morphic-Brick')];
			package: 'Glamour-Morphic-Theme' with: [spec requires: 'Rubric'];
			package: 'Glamour-Tests-Core';
			package: 'Glamour-Tests-Morphic' with: [spec requires: #('Glamour-Morphic-Renderer' 'Glamour-Morphic-Brick' 'Glamour-Morphic-Pager')];
			package: 'Glamour-Tests-Rubric' with: [spec requires: #('Glamour-Tests-Morphic' 'Glamour-Rubric-Presentations')];
			package: 'Glamour-Tests-Resources'.
			
		spec group: 'Core' with: #(
						'Glamour-Announcements'
						'Glamour-Helpers'
						'Glamour-Core'
						'Glamour-Presentations'
						'Glamour-Browsers'
						'Glamour-Examples'
						'Glamour-Rubric-Presentations').
		spec group: 'Morphic' with: #(
						'Glamour-Morphic-Brick'
						'Glamour-Morphic-Widgets'
						'Glamour-Morphic-Renderer'
						'Glamour-Morphic-Theme'
						'Glamour-Morphic-Pager').		
		spec group: 'Tests' with: #(
						'Glamour-Tests-Core'
						'Glamour-Tests-Morphic'
						'Glamour-Tests-Rubric'
						'Glamour-Tests-Resources'
						'Glamour-Morphic-Brick-Tests'). 
						
		spec project: 'Rubric' with: [ 
			spec 
					className: #ConfigurationOfRubric;
					versionString: #'development';
					repository: 'http://www.smalltalkhub.com/mc/AlainPlantec/Rubric/main' ] .
				
		spec group: 'default' with: #(
						'Core'
						'Morphic'
						'Tests' ) ].! !

!ConfigurationOfGlamourCore methodsFor: 'versions' stamp: 'AndreiChis 4/13/2015 00:05'!
version311: spec
	<version: '3.1.1' imports: #('3.1-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 3.1.1 - Pharo 4 release'.
		spec author: 'AndreiChis'.
		spec timestamp: '04/11/2015 17:54'.
		spec 
			package: 'Glamour-Announcements' with: 'Glamour-Announcements-AndreiChis.8';
			package: 'Glamour-Browsers' with: 'Glamour-Browsers-TorstenBergmann.109';
			package: 'Glamour-Core' with: 'Glamour-Core-StefanReichhart.299';
			package: 'Glamour-Examples' with: 'Glamour-Examples-TorstenBergmann.291';
			package: 'Glamour-Helpers' with: 'Glamour-Helpers-AndreiChis.39';
			package: 'Glamour-Morphic-Brick' with: 'Glamour-Morphic-Brick-StefanReichhart.398';
			package: 'Glamour-Morphic-Brick-Tests' with: 'Glamour-Morphic-Brick-Tests-AliakseiSyrel.13';
			package: 'Glamour-Morphic-Pager' with: 'Glamour-Morphic-Pager-AndreiChis.103';
			package: 'Glamour-Morphic-Renderer' with:'Glamour-Morphic-Renderer-AndreiChis.320';
			package: 'Glamour-Morphic-Theme' with: 'Glamour-Morphic-Theme-StefanReichhart.212';
			package: 'Glamour-Morphic-Widgets' with: 'Glamour-Morphic-Widgets-AndreiChis.177';
			package: 'Glamour-Presentations' with: 'Glamour-Presentations-AndreiChis.176';
			package: 'Glamour-Rubric-Presentations' with: 'Glamour-Rubric-Presentations-AndreiChis.41';
			package: 'Glamour-Tests-Core' with: 'Glamour-Tests-Core-AliakseiSyrel.104';
			package: 'Glamour-Tests-Morphic' with: 'Glamour-Tests-Morphic-AndreiChis.124';
			package: 'Glamour-Tests-Resources' with: 'Glamour-Tests-Resources-AndreiChis.3';
			package: 'Glamour-Tests-Rubric' with: 'Glamour-Tests-Rubric-AndreiChis.14'. 
		
		spec 
			project: 'Rubric' with: '1.2.10' ].

! !

!ConfigurationOfGlamourCore methodsFor: 'baselines' stamp: 'AndreiChis 2/10/2015 10:36'!
baseline30: spec
	<version: '3.0-baseline'>
	
	spec for: #common do: [
		spec blessing: #baseline.
		spec description: 'Core version of Glamour that can directly be integrated in Pharo 4'.
		spec repository: 'http://www.smalltalkhub.com/mc/Moose/Glamour/main'.
		spec 
			package: 'Glamour-Announcements' ;
			package: 'Glamour-Helpers';
			package: 'Glamour-Core' with: [spec requires: #('Glamour-Helpers' 'Glamour-Announcements')];
			package: 'Glamour-Presentations' with: [spec requires: #('Glamour-Core')];
			package: 'Glamour-Rubric-Presentations' with: [spec requires: #('Rubric' 'Glamour-Presentations')];
			package: 'Glamour-Browsers' with: [spec requires: #('Glamour-Core')];
			package: 'Glamour-Examples' with: [spec requires: #('Glamour-Core')];
			package: 'Glamour-Morphic-Brick' with: [spec requires: #('Glamour-Core')];
			package: 'Glamour-Morphic-Widgets' with: [spec requires: #('Rubric' 'Glamour-Morphic-Brick')];
			package: 'Glamour-Morphic-Renderer' with: [spec requires: #('Glamour-Morphic-Widgets' 'Glamour-Core')];
			package: 'Glamour-Morphic-Pager' with: [spec requires: #('Glamour-Morphic-Renderer' 'Glamour-Morphic-Brick')];
			package: 'Glamour-Morphic-Theme' with: [spec requires: 'Rubric'];
			package: 'Glamour-Tests-Core';
			package: 'Glamour-Tests-Morphic' with: [spec requires: #('Glamour-Morphic-Renderer' 'Glamour-Morphic-Brick' 'Glamour-Morphic-Pager')];
			package: 'Glamour-Tests-Rubric' with: [spec requires: #('Glamour-Tests-Morphic' 'Glamour-Rubric-Presentations')];
			package: 'Glamour-Tests-Resources'.
			
		spec group: 'Core' with: #(
						'Glamour-Announcements'
						'Glamour-Helpers'
						'Glamour-Core'
						'Glamour-Presentations'
						'Glamour-Browsers'
						'Glamour-Examples'
						'Glamour-Rubric-Presentations').
		spec group: 'Morphic' with: #(
						'Glamour-Morphic-Brick'
						'Glamour-Morphic-Widgets'
						'Glamour-Morphic-Renderer'
						'Glamour-Morphic-Theme'
						'Glamour-Morphic-Pager').		
		spec group: 'Tests' with: #(
						'Glamour-Tests-Core'
						'Glamour-Tests-Morphic'
						'Glamour-Tests-Rubric'
						'Glamour-Tests-Resources'). 
						
		spec group: 'default' with: #(
						'Core'
						'Morphic'
						'Tests').		
		spec project: 'Rubric' with: [ 
			spec 
					className: 'ConfigurationOfRubric';
					file: 'ConfigurationOfRubric';
					version: #development;
					repository: 'http://www.smalltalkhub.com/mc/AlainPlantec/Rubric/main' ] ].! !

!ConfigurationOfGlamourCore methodsFor: 'versions' stamp: 'AndreiChis 4/9/2015 22:56'!
version310: spec
	<version: '3.1.0' imports: #('3.1-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 3.1.0 - Pharo 4 release'.
		spec author: 'AndreiChis'.
		spec timestamp: '04/08/2015 19:07'.
		spec 
			package: 'Glamour-Announcements' with: 'Glamour-Announcements-AndreiChis.8';
			package: 'Glamour-Browsers' with: 'Glamour-Browsers-TorstenBergmann.109';
			package: 'Glamour-Core' with: 'Glamour-Core-StefanReichhart.299';
			package: 'Glamour-Examples' with: 'Glamour-Examples-TorstenBergmann.291';
			package: 'Glamour-Helpers' with: 'Glamour-Helpers-AndreiChis.39';
			package: 'Glamour-Morphic-Brick' with: 'Glamour-Morphic-Brick-StefanReichhart.398';
			package: 'Glamour-Morphic-Brick-Tests' with: 'Glamour-Morphic-Brick-Tests-AliakseiSyrel.13';
			package: 'Glamour-Morphic-Pager' with: 'Glamour-Morphic-Pager-AndreiChis.103';
			package: 'Glamour-Morphic-Renderer' with:'Glamour-Morphic-Renderer-AndreiChis.319';
			package: 'Glamour-Morphic-Theme' with: 'Glamour-Morphic-Theme-StefanReichhart.212';
			package: 'Glamour-Morphic-Widgets' with: 'Glamour-Morphic-Widgets-AndreiChis.177';
			package: 'Glamour-Presentations' with: 'Glamour-Presentations-AndreiChis.175';
			package: 'Glamour-Rubric-Presentations' with: 'Glamour-Rubric-Presentations-AndreiChis.41';
			package: 'Glamour-Tests-Core' with: 'Glamour-Tests-Core-AliakseiSyrel.104';
			package: 'Glamour-Tests-Morphic' with: 'Glamour-Tests-Morphic-AndreiChis.124';
			package: 'Glamour-Tests-Resources' with: 'Glamour-Tests-Resources-AndreiChis.3';
			package: 'Glamour-Tests-Rubric' with: 'Glamour-Tests-Rubric-AndreiChis.14'. 
		
		spec 
			project: 'Rubric' with: '1.2.10' ].

! !

!ConfigurationOfGlamourCore methodsFor: 'versions' stamp: 'AndreiChis 12/9/2014 10:00'!
version303: spec
	<version: '3.0.3' imports: #('3.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 3.0.3'.
		spec author: 'AndreiChis'.
		spec timestamp: '12/07/2014 13:58'.
		spec 
			package: 'Glamour-Announcements' with: 'Glamour-Announcements-AndreiChis.8';
			package: 'Glamour-Helpers' with: 'Glamour-Helpers-AndreiChis.36';
			package: 'Glamour-Core' with: 'Glamour-Core-BernardoContreras.286';
			package: 'Glamour-Presentations' with: 'Glamour-Presentations-AndreiChis.166';
			package: 'Glamour-Browsers' with: 'Glamour-Browsers-BernardoContreras.107';
			package: 'Glamour-Tests-Core' with: 'Glamour-Tests-Core-AndreiChis.99';
			package: 'Glamour-Morphic-Widgets' with: 'Glamour-Morphic-Widgets-AndreiChis.153';
			package: 'Glamour-Morphic-Renderer' with: [
				spec file: 'Glamour-Morphic-Renderer-AndreiChis.301'.
				spec repository: 'http://www.smalltalkhub.com/mc/PharoExtras/GTToolsIntegration/main' ];
			package: 'Glamour-Morphic-Brick' with: 'Glamour-Morphic-Brick-AliakseiSyrel.82';
			package: 'Glamour-Morphic-Pager' with: 'Glamour-Morphic-Pager-AliakseiSyrel.78';
			package: 'Glamour-Morphic-Theme' with: 'Glamour-Morphic-Theme-TudorGirba.194';
			package: 'Glamour-Tests-Morphic' with: 'Glamour-Tests-Morphic-AndreiChis.118';
			package: 'Glamour-Examples' with: 'Glamour-Examples-TudorGirba.290';
			package: 'Glamour-Rubric-Presentations' with: 'Glamour-Rubric-Presentations-TudorGirba.33';
			package: 'Glamour-Tests-Rubric' with: 'Glamour-Tests-Rubric-AndreiChis.14';
			package: 'Glamour-Tests-Resources' with: 'Glamour-Tests-Resources-AndreiChis.3'. 
		
		spec 
			project: 'Rubric' with: '1.2.5' ].

! !

!ConfigurationOfGlamourCore methodsFor: 'versions' stamp: 'AndreiChis 1/16/2015 19:37'!
version3010: spec
	<version: '3.0.10' imports: #('3.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 3.0.10'.
		spec author: 'AndreiChis'.
		spec timestamp: '01/16/2015 19:07'.
		spec 
			package: 'Glamour-Announcements' with: 'Glamour-Announcements-AndreiChis.8';
			package: 'Glamour-Browsers' with: 'Glamour-Browsers-BernardoContreras.107';
			package: 'Glamour-Core' with: 'Glamour-Core-AndreiChis.288';
			package: 'Glamour-Examples' with: 'Glamour-Examples-TudorGirba.290';
			package: 'Glamour-Helpers' with: 'Glamour-Helpers-AndreiChis.36';
			package: 'Glamour-Morphic-Brick' with: 'Glamour-Morphic-Brick-AliakseiSyrel.118';
			package: 'Glamour-Morphic-Pager' with: 'Glamour-Morphic-Pager-AndreiChis.83';
			package: 'Glamour-Morphic-Renderer' with:'Glamour-Morphic-Renderer-AndreiChis.306';
			package: 'Glamour-Morphic-Theme' with: 'Glamour-Morphic-Theme-TudorGirba.196';
			package: 'Glamour-Morphic-Widgets' with: 'Glamour-Morphic-Widgets-AndreiChis.160';
			package: 'Glamour-Presentations' with: 'Glamour-Presentations-AndreiChis.169';
			package: 'Glamour-Rubric-Presentations' with: 'Glamour-Rubric-Presentations-AndreiChis.37';
			package: 'Glamour-Tests-Core' with: 'Glamour-Tests-Core-AndreiChis.101';
			package: 'Glamour-Tests-Morphic' with: 'Glamour-Tests-Morphic-AndreiChis.120';
			package: 'Glamour-Tests-Resources' with: 'Glamour-Tests-Resources-AndreiChis.3';
			package: 'Glamour-Tests-Rubric' with: 'Glamour-Tests-Rubric-AndreiChis.14'. 
		
		spec 
			project: 'Rubric' with: '1.2.8' ].

! !

!ConfigurationOfGlamourCore class methodsFor: 'private' stamp: 'AndreiChis 10/28/2014 21:10'!
baseConfigurationClassIfAbsent: aBlock

	^Smalltalk
		at: #MetacelloBaseConfiguration
		ifAbsent: [ 
			self ensureMetacelloBaseConfiguration.
			Smalltalk at: #MetacelloBaseConfiguration ifAbsent: aBlock ].
! !

!ConfigurationOfGlamourCore class methodsFor: 'development support' stamp: 'AndreiChis 10/28/2014 21:10'!
validate
	"Check the configuration for Errors, Critical Warnings, and Warnings (see class comment for MetacelloMCVersionValidator for more information). 
	Errors identify specification issues that will result in unexpected behaviour when you load the configuration. 
	Critical Warnings identify specification issues that may result in unexpected behavior when you load the configuration.
	Warnings identify specification issues that are technically correct, but are worth take a look at."

	"self validate"

	<apiDocumentation>
	self ensureMetacello.
	^ ((Smalltalk at: #MetacelloToolBox) validateConfiguration: self debug: #() recurse: false) explore! !

!ConfigurationOfGlamourCore class methodsFor: 'metacello tool support' stamp: 'AndreiChis 10/28/2014 21:10'!
isMetacelloConfig
	"Answer true and the Metacello tools will operate on you"
	
	^true! !

!ConfigurationOfGlamourCore class methodsFor: 'loading' stamp: 'AndreiChis 10/28/2014 21:10'!
loadBleedingEdge
	"Load the latest versions of the mcz files defined for this project. It is not likely that the #bleedingEdge has been tested."

	"self loadBleedingEdge"

	<apiDocumentation>
	^(self project version: #bleedingEdge) load! !

!ConfigurationOfGlamourCore class methodsFor: 'private' stamp: 'AndreiChis 10/28/2014 21:10'!
ensureMetacelloBaseConfiguration

	Smalltalk
		at: #MetacelloBaseConfiguration
		ifAbsent: [ 
			| repository version |
			repository := MCHttpRepository location: 'http://seaside.gemstone.com/ss/metacello' user: '' password: ''.
			repository
				versionReaderForFileNamed: 'Metacello-Base-DaleHenrichs.2.mcz'
				do: [ :reader | 
					version := reader version.
					version load.
					version workingCopy repositoryGroup addRepository: repository ] ]! !

!ConfigurationOfGlamourCore class methodsFor: 'loading' stamp: 'AndreiChis 10/28/2014 21:10'!
load
	"Load the #stable version defined for this platform. The #stable version is the version that is recommended to be used on this platform."

	"self load"

	<apiDocumentation>
	^(self project version: #stable) load! !

!ConfigurationOfGlamourCore class methodsFor: 'development support' stamp: 'AndreiChis 10/28/2014 21:10'!
DevelopmentSupport

"See the methods in the 'development support' category on the class-side of MetacelloBaseConfiguration. Decide what development support methods you would like to use and copy them the the class-side of your configuration."
	<apiDocumentation>
! !

!ConfigurationOfGlamourCore class methodsFor: 'accessing' stamp: 'AndreiChis 10/28/2014 21:10'!
project

	^self new project! !

!ConfigurationOfGlamourCore class methodsFor: 'private' stamp: 'AndreiChis 10/28/2014 21:10'!
ensureMetacello

	(self baseConfigurationClassIfAbsent: []) ensureMetacello! !

!ConfigurationOfGlamourCore class methodsFor: 'loading' stamp: 'AndreiChis 10/28/2014 21:10'!
loadDevelopment
	"Load the #development version defined for this platform. The #development version will change over time and is not expected to be stable."

	"self loadDevelopment"

	<apiDocumentation>
	^(self project version: #development) load! !

!ConfigurationOfOSWindow methodsFor: 'versions' stamp: 'EstebanLorenzano 8/19/2014 13:52'!
version111: spec
	<version: '1.1.1' imports: #('0.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'release'.
		spec description: 'version 1.1.1'.
		spec author: 'EstebanLorenzano'.
		spec timestamp: '2014-08-19 13:51'.
		spec 
			package: 'OSWindow-Core' with: 'OSWindow-Core-EstebanLorenzano.17';
			package: 'OSWindow-SDL2' with: 'OSWindow-SDL2-EstebanLorenzano.19';
			package: 'OSWindow-VM' with: 'OSWindow-VM-IgorStasenko.2';
			package: 'NBXLib-Core' with: 'NBXLib-Core-RonieSalgado.13';
			package: 'OSWindow-X11' with: 'OSWindow-X11-IgorStasenko.5'. ].
! !

!ConfigurationOfOSWindow methodsFor: 'baselines' stamp: 'IgorStasenko 7/30/2014 18:54'!
baseline01: spec
	<version: '0.1-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec repository: 'http://smalltalkhub.com/mc/Pharo/OSWindow/main/'.
		spec 
			package: 'OSWindow-Core';
			package: 'OSWindow-SDL2' with: [
				spec requires: #('OSWindow-Core' ). ];
			package: 'OSWindow-VM' with: [
				spec requires: #('OSWindow-Core' ). ];
			package: 'OSWindow-X11' with: [
				spec requires: #('OSWindow-Core' 'NBXLib-Core' ). ];
			package: 'NBXLib-Core'. ].
! !

!ConfigurationOfOSWindow methodsFor: 'baselines' stamp: 'IgorStasenko 7/30/2014 18:57'!
baseline02: spec
	<version: '0.2-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec repository: 'http://smalltalkhub.com/mc/Pharo/OSWindow/main/'.
		spec 
			package: 'OSWindow-Core';
			package: 'OSWindow-SDL2' with: [
				spec requires: #('OSWindow-Core' ). ];
			package: 'OSWindow-VM' with: [
				spec requires: #('OSWindow-Core' ). ];
			package: 'NBXLib-Core';
			package: 'OSWindow-X11' with: [
				spec requires: #('OSWindow-Core' 'NBXLib-Core' ). ].
		spec 
			group: 'SDL2' with: #('OSWindow-SDL2' );
			group: 'Legacy' with: #('OSWindow-VM' );
			group: 'X11' with: #('OSWindow-X11' );
			group: 'default' with: #('Legacy' 'SDL2' ). ].
! !

!ConfigurationOfOSWindow methodsFor: 'accessing' stamp: 'IgorStasenko 7/30/2014 18:51'!
customProjectAttributes
	 "Edit to return a collection of any custom attributes e.g. for conditional loading: Array with: #'Condition1' with: #'Condition2.
	For more information see: http://code.google.com/p/metacello/wiki/CustomProjectAttrributes"

	^ #().! !

!ConfigurationOfOSWindow methodsFor: 'symbolic versions' stamp: 'EstebanLorenzano 8/19/2014 13:51'!
stable: spec
	<symbolicVersion: #'stable'>

	spec for: #'common' version: '1.1.1'.
! !

!ConfigurationOfOSWindow methodsFor: 'symbolic versions' stamp: 'IgorStasenko 7/30/2014 18:58'!
development: spec
	<symbolicVersion: #'development'>

	spec for: #'common' version: '0.2-baseline'.
! !

!ConfigurationOfOSWindow methodsFor: 'versions' stamp: 'IgorStasenko 7/30/2014 18:58'!
version11: spec
	<version: '1.1' imports: #('0.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 1.1'.
		spec author: 'IgorStasenko'.
		spec timestamp: '7/30/2014 18:58'.
		spec 
			package: 'OSWindow-Core' with: 'OSWindow-Core-IgorStasenko.16';
			package: 'OSWindow-SDL2' with: 'OSWindow-SDL2-IgorStasenko.18';
			package: 'OSWindow-VM' with: 'OSWindow-VM-IgorStasenko.2';
			package: 'NBXLib-Core' with: 'NBXLib-Core-RonieSalgado.13';
			package: 'OSWindow-X11' with: 'OSWindow-X11-IgorStasenko.5'. ].
! !

!ConfigurationOfOSWindow methodsFor: 'accessing' stamp: 'IgorStasenko 7/30/2014 18:51'!
project

	^ project ifNil: [ 
		"Bootstrap Metacello if it is not already loaded"
		(self class baseConfigurationClassIfAbsent: []) ensureMetacello.
		"Construct Metacello project"
		project := MetacelloMCProject new projectAttributes: self customProjectAttributes. 
		(Smalltalk at: #MetacelloVersionConstructor) on: self project: project.
		project loadType: #linear. "change to #atomic if desired"
		project ]! !

!ConfigurationOfOSWindow methodsFor: 'versions' stamp: 'IgorStasenko 7/30/2014 18:54'!
version10: spec
	<version: '1.0' imports: #('0.1-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 1.0'.
		spec author: 'IgorStasenko'.
		spec timestamp: '7/30/2014 18:54'.
		spec 
			package: 'OSWindow-Core' with: 'OSWindow-Core-IgorStasenko.16';
			package: 'OSWindow-SDL2' with: 'OSWindow-SDL2-IgorStasenko.18';
			package: 'OSWindow-VM' with: 'OSWindow-VM-IgorStasenko.2';
			package: 'OSWindow-X11' with: 'OSWindow-X11-IgorStasenko.5';
			package: 'NBXLib-Core' with: 'NBXLib-Core-RonieSalgado.13'. ].
! !

!ConfigurationOfOSWindow class methodsFor: 'private' stamp: 'IgorStasenko 7/30/2014 18:51'!
baseConfigurationClassIfAbsent: aBlock

	^Smalltalk
		at: #MetacelloBaseConfiguration
		ifAbsent: [ 
			self ensureMetacelloBaseConfiguration.
			Smalltalk at: #MetacelloBaseConfiguration ifAbsent: aBlock ].
! !

!ConfigurationOfOSWindow class methodsFor: 'development support' stamp: 'IgorStasenko 7/30/2014 18:51'!
validate
	"Check the configuration for Errors, Critical Warnings, and Warnings (see class comment for MetacelloMCVersionValidator for more information). 
	Errors identify specification issues that will result in unexpected behaviour when you load the configuration. 
	Critical Warnings identify specification issues that may result in unexpected behavior when you load the configuration.
	Warnings identify specification issues that are technically correct, but are worth take a look at."

	"self validate"

	<apiDocumentation>
	self ensureMetacello.
	^ ((Smalltalk at: #MetacelloToolBox) validateConfiguration: self debug: #() recurse: false) explore! !

!ConfigurationOfOSWindow class methodsFor: 'metacello tool support' stamp: 'IgorStasenko 7/30/2014 18:51'!
isMetacelloConfig
	"Answer true and the Metacello tools will operate on you"
	
	^true! !

!ConfigurationOfOSWindow class methodsFor: 'loading' stamp: 'IgorStasenko 7/30/2014 18:51'!
loadBleedingEdge
	"Load the latest versions of the mcz files defined for this project. It is not likely that the #bleedingEdge has been tested."

	"self loadBleedingEdge"

	<apiDocumentation>
	^(self project version: #bleedingEdge) load! !

!ConfigurationOfOSWindow class methodsFor: 'private' stamp: 'IgorStasenko 7/30/2014 18:51'!
ensureMetacelloBaseConfiguration

	Smalltalk
		at: #MetacelloBaseConfiguration
		ifAbsent: [ 
			| repository version |
			repository := MCHttpRepository location: 'http://seaside.gemstone.com/ss/metacello' user: '' password: ''.
			repository
				versionReaderForFileNamed: 'Metacello-Base-DaleHenrichs.2.mcz'
				do: [ :reader | 
					version := reader version.
					version load.
					version workingCopy repositoryGroup addRepository: repository ] ]! !

!ConfigurationOfOSWindow class methodsFor: 'loading' stamp: 'IgorStasenko 7/30/2014 18:51'!
load
	"Load the #stable version defined for this platform. The #stable version is the version that is recommended to be used on this platform."

	"self load"

	<apiDocumentation>
	^(self project version: #stable) load! !

!ConfigurationOfOSWindow class methodsFor: 'development support' stamp: 'IgorStasenko 7/30/2014 18:51'!
DevelopmentSupport

"See the methods in the 'development support' category on the class-side of MetacelloBaseConfiguration. Decide what development support methods you would like to use and copy them the the class-side of your configuration."
	<apiDocumentation>
! !

!ConfigurationOfOSWindow class methodsFor: 'accessing' stamp: 'IgorStasenko 7/30/2014 18:51'!
project

	^self new project! !

!ConfigurationOfOSWindow class methodsFor: 'private' stamp: 'IgorStasenko 7/30/2014 18:51'!
ensureMetacello

	(self baseConfigurationClassIfAbsent: []) ensureMetacello! !

!ConfigurationOfOSWindow class methodsFor: 'loading' stamp: 'IgorStasenko 7/30/2014 18:51'!
loadDevelopment
	"Load the #development version defined for this platform. The #development version will change over time and is not expected to be stable."

	"self loadDevelopment"

	<apiDocumentation>
	^(self project version: #development) load! !

!ConfigurationOfRubric commentStamp: 'AndreiChis 9/24/2014 10:22'!
ConfigurationOfRubric loadDevelopment.
!
!ConfigurationOfRubric methodsFor: 'baselines' stamp: 'usmanbhatti 4/26/2013 18:07'!
baseline01: spec
	<version: '0.1-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec description: 'First shoot!!'.
		spec repository: 'http://www.smalltalkhub.com/mc/AlainPlantec/Rubric/main'.
		spec 
			package: 'Rubric'
		 ].! !

!ConfigurationOfRubric methodsFor: 'baselines' stamp: 'StephaneDucasse 6/28/2014 11:37'!
baseline02: spec
	<version: '0.2-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec description: 'All packages of rubric.'.
		spec repository: 'http://www.smalltalkhub.com/mc/AlainPlantec/Rubric/main'.
		spec package: 'Rubric'			
		 ].
! !

!ConfigurationOfRubric methodsFor: 'symbolic versions' stamp: 'AndreiChis 4/8/2015 21:38'!
stable: spec
	<symbolicVersion: #'stable'>

	spec for: #'common' version: '1.2.10'.
	
	spec for: #'pharo3.x' version: '1.2.8'.
! !

!ConfigurationOfRubric methodsFor: 'symbolic versions' stamp: 'AndreiChis 3/4/2015 11:23'!
development: spec
	<symbolicVersion: #'development'>

	spec for: #'common' version: '2.0-baseline'.
! !

!ConfigurationOfRubric methodsFor: 'versions' stamp: 'AndreiChis 9/24/2014 10:21'!
version11: spec
	<version: '1.1' imports: #('0.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 1.1 - for Pharo 3'.
		spec author: 'AndreiChis'.
		spec timestamp: '9/22/2014 14:16'.
		spec package: 'Rubric' with: 'Rubric-AndreiChis.134'. ].
! !

!ConfigurationOfRubric methodsFor: 'versions' stamp: 'AndreiChis 10/1/2014 14:29'!
version121: spec
	<version: '1.2.1' imports: #('0.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 1.2.1'.
		spec author: 'AndreiChis'.
		spec timestamp: '10/01/2014 14:27'.
		spec package: 'Rubric' with: 'Rubric-AndreiChis.136'. ].
! !

!ConfigurationOfRubric methodsFor: 'versions' stamp: 'AndreiChis 10/3/2014 17:06'!
version122: spec
	<version: '1.2.2' imports: #('0.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 1.2.2'.
		spec author: 'AndreiChis'.
		spec timestamp: '10/03/2014 17:06'.
		spec package: 'Rubric' with: 'Rubric-AlainPlantec.137'. ].
! !

!ConfigurationOfRubric methodsFor: 'accessing' stamp: 'StephaneDucasse 8/21/2013 16:56'!
project

	^ project ifNil: [ | constructor |
		"Bootstrap Metacello if it is not already loaded"
		self class ensureMetacello.
		"Construct Metacello project"
		constructor := (Smalltalk globals at: #MetacelloVersionConstructor) on: self.
		project := constructor project.
		project]! !

!ConfigurationOfRubric methodsFor: 'versions' stamp: 'AndreiChis 11/13/2014 14:11'!
version123: spec
	<version: '1.2.3' imports: #('0.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 1.2.3'.
		spec author: 'AndreiChis'.
		spec timestamp: '11/13/2014 13:54'.
		spec package: 'Rubric' with: 'Rubric-AndreiChis.149'. ].
! !

!ConfigurationOfRubric methodsFor: 'versions' stamp: 'StephaneDucasse 6/28/2014 11:40'!
version10: spec
	<version: '1.0' imports: #('0.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 1.0'.
		spec author: 'StephaneDucasse'.
		spec timestamp: '6/28/2014 11:40'.
		spec package: 'Rubric' with: 'Rubric-TudorGirba.122'. ].
! !

!ConfigurationOfRubric methodsFor: 'versions' stamp: 'AndreiChis 1/16/2015 18:56'!
version128: spec
	<version: '1.2.8' imports: #('0.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 1.2.8'.
		spec author: 'AndreiChis'.
		spec timestamp: '01/16/2015 18:54'.
		spec package: 'Rubric' with: 'Rubric-AndreiChis.172'. ].
! !

!ConfigurationOfRubric methodsFor: 'versions' stamp: 'AndreiChis 1/7/2015 17:41'!
version127: spec
	<version: '1.2.7' imports: #('0.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 1.2.7'.
		spec author: 'AndreiChis'.
		spec timestamp: '01/07/2015 17:31'.
		spec package: 'Rubric' with: 'Rubric-AndreiChis.156'. ].
! !

!ConfigurationOfRubric methodsFor: 'baselines' stamp: 'AndreiChis 3/4/2015 11:22'!
baseline10: spec
	<version: '1.0-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec description: 'All packages of rubric.'.
		spec repository: 'http://www.smalltalkhub.com/mc/AlainPlantec/Rubric/main'.
		spec package: 'Rubric' ].
! !

!ConfigurationOfRubric methodsFor: 'versions' stamp: 'AndreiChis 11/14/2014 15:09'!
version124: spec
	<version: '1.2.4' imports: #('0.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 1.2.4'.
		spec author: 'AndreiChis'.
		spec timestamp: '11/14/2014 11:48'.
		spec package: 'Rubric' with: 'Rubric-AndreiChis.152'. ].
! !

!ConfigurationOfRubric methodsFor: 'versions' stamp: 'TudorGirba 12/23/2014 22:21'!
version126: spec
	<version: '1.2.6' imports: #('0.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 1.2.6'.
		spec author: 'TudorGirba'.
		spec timestamp: '12/23/2014 18:58'.
		spec package: 'Rubric' with: 'Rubric-AlainPlantec.155'. ].
! !

!ConfigurationOfRubric methodsFor: 'baselines' stamp: 'AndreiChis 3/4/2015 11:23'!
baseline20: spec
	<version: '2.0-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec description: 'All packages of rubric.'.
		spec repository: 'http://www.smalltalkhub.com/mc/AlainPlantec/Rubric/main'.
		spec package: 'Rubric' ].
! !

!ConfigurationOfRubric methodsFor: 'versions' stamp: 'AndreiChis 12/7/2014 14:12'!
version125: spec
	<version: '1.2.5' imports: #('0.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 1.2.5'.
		spec author: 'AndreiChis'.
		spec timestamp: '12/07/2014 13:58'.
		spec package: 'Rubric' with: 'Rubric-AlainPlantec.154'. ].
! !

!ConfigurationOfRubric methodsFor: 'versions' stamp: 'AndreiChis 4/8/2015 21:38'!
version1210: spec
	<version: '1.2.10' imports: #('0.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 1.2.10'.
		spec author: 'AndreiChis'.
		spec timestamp: '04/08/2015 21:39'.
		spec package: 'Rubric' with: 'Rubric-AndreiChis.187'. ].
! !

!ConfigurationOfRubric methodsFor: 'versions' stamp: 'AndreiChis 9/24/2014 10:40'!
version12: spec
	<version: '1.2' imports: #('0.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 1.2 - for Pharo 4'.
		spec author: 'AndreiChis'.
		spec timestamp: '9/24/2014 10:20'.
		spec package: 'Rubric' with: 'Rubric-AndreiChis.135'. ].
! !

!ConfigurationOfRubric methodsFor: 'versions' stamp: 'AlainPlantec 3/16/2015 20:30'!
version129: spec
	<version: '1.2.9' imports: #('0.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 1.2.9'.
		spec author: 'AlainPlantec'.
		spec timestamp: '03/16/2015 20:30'.
		spec package: 'Rubric' with: 'Rubric-AlainPlantec.179'. ].
! !

!ConfigurationOfRubric class methodsFor: 'loading' stamp: 'usmanbhatti 4/26/2013 10:18'!
loadDevelopment
	(self project version: #development) load! !

!ConfigurationOfRubric class methodsFor: 'accessing' stamp: 'usmanbhatti 4/26/2013 10:18'!
project

	^self new project! !

!ConfigurationOfRubric class methodsFor: 'private' stamp: 'usmanbhatti 4/26/2013 10:18'!
ensureMetacello
	Smalltalk at: #MetacelloProject ifAbsent: [
		Gofer new
				url: 'http://seaside.gemstone.com/ss/metacello';
				package: 'ConfigurationOfMetacello';
				load.
		(Smalltalk at: #ConfigurationOfMetacello) loadLatestVersion ]! !

!ConfigurationOfRubric class methodsFor: 'metacello tool support' stamp: 'usmanbhatti 4/26/2013 10:18'!
isMetacelloConfig
	"Answer true and the Metacello tools will operate on you"
	
	^true! !

!ConfigurationOfRubric class methodsFor: 'loading' stamp: 'usmanbhatti 4/26/2013 10:18'!
loadDefault
	self loadDevelopment! !

!ConfigurationOfShoreLineReporter commentStamp: '<historical>'!
Copy me to create a new configuration or edit and evaluate the following doits.

        "Create configuration class and initial baseline method"

        MetacelloToolBox 
                createBaseline: '1.0-baseline'
                for: 'MyProject'
                repository: 'http://www.example.com/MyProjectRepository'
                requiredProjects: #('Gofer')
                packages: #('MyProject-Core' 'MyProject-Tests')
                dependencies:
                        {('MyProject-Core' -> #('Gofer')).
                         ('MyProject-Tests' -> #('MyProject-Core'))}
                groups:
                        {('default' -> #('Core')).
                        ('Core' -> #('MyProject-Core')).
                        ('Tests' -> #('MyProject-Tests'))}.

	   "create initial development method from the baseline"

         MetacelloToolBox
               createDevelopment: '1.0'
               for: 'MyProject'
                importFromBaseline: '1.0-baseline'
                description: 'initial version'.
!
!ConfigurationOfShoreLineReporter methodsFor: 'versions' stamp: 'TommasoDalSasso 12/15/2014 14:37'!
version011: spec
	<version: '0.1.1' imports: #('0.1.0-baseline')>

	spec for: #common do: [ 
		spec
			package: 'ShoreLine-Report-Core' with: 'ShoreLine-Report-Core-TommasoDalSasso.6';
			package: 'ShoreLine-Report-UI' with: 'ShoreLine-Report-UI-TommasoDalSasso.10';
			package: 'ShoreLine-Report-Settings' with: 'ShoreLine-Report-Settings-TommasoDalSasso.2' ]! !

!ConfigurationOfShoreLineReporter methodsFor: 'versions' stamp: 'TommasoDalSasso 11/30/2014 13:33'!
bleedingEdge: spec
	<symbolicVersion: #bleedingEdge>

	spec for: #common version: '0.1.0-baseline'! !

!ConfigurationOfShoreLineReporter methodsFor: 'versions' stamp: 'TommasoDalSasso 2/24/2015 22:59'!
version012: spec
	<version: '0.1.2' imports: #('0.1.0-baseline')>

	spec for: #common do: [ 
		spec
			package: 'ShoreLine-Report-Core' with: 'ShoreLine-Report-Core-TommasoDalSasso.9';
			package: 'ShoreLine-Report-UI' with: 'ShoreLine-Report-UI-TommasoDalSasso.12';
			package: 'ShoreLine-Report-Settings' with: 'ShoreLine-Report-Settings-TommasoDalSasso.2' ]! !

!ConfigurationOfShoreLineReporter methodsFor: 'versions' stamp: 'TommasoDalSasso 12/2/2014 17:21'!
version010: spec
	<version: '0.1.0' imports: #('0.1.0-baseline')>

	spec for: #common do: [ 
		spec
			package: 'ShoreLine-Report-Core' with: 'ShoreLine-Report-Core-TommasoDalSasso.6';
			package: 'ShoreLine-Report-UI' with: 'ShoreLine-Report-UI-TommasoDalSasso.7';
			package: 'ShoreLine-Report-Settings' with: 'ShoreLine-Report-Settings-TommasoDalSasso.2' ]! !

!ConfigurationOfShoreLineReporter methodsFor: 'accessing' stamp: 'TommasoDalSasso 4/9/2014 09:53'!
customProjectAttributes
	 "Edit to return a collection of any custom attributes e.g. for conditional loading: Array with: #'Condition1' with: #'Condition2.
	For more information see: http://code.google.com/p/metacello/wiki/CustomProjectAttrributes"

	^ #().! !

!ConfigurationOfShoreLineReporter methodsFor: 'versions' stamp: 'TommasoDalSasso 2/24/2015 22:59'!
stable: spec
	<symbolicVersion: #stable>

	spec for: #common version: '0.1.2'! !

!ConfigurationOfShoreLineReporter methodsFor: 'versions' stamp: 'TommasoDalSasso 11/30/2014 13:33'!
development: spec
	<symbolicVersion: #development>

	spec for: #common version: '0.1.0'! !

!ConfigurationOfShoreLineReporter methodsFor: 'accessing' stamp: 'TommasoDalSasso 4/9/2014 09:53'!
project

	^ project ifNil: [ 
		"Bootstrap Metacello if it is not already loaded"
		(self class baseConfigurationClassIfAbsent: []) ensureMetacello.
		"Construct Metacello project"
		project := MetacelloMCProject new projectAttributes: self customProjectAttributes. 
		(Smalltalk at: #MetacelloVersionConstructor) on: self project: project.
		project loadType: #linear. "change to #atomic if desired"
		project ]! !

!ConfigurationOfShoreLineReporter methodsFor: 'baselines' stamp: 'TommasoDalSasso 11/30/2014 13:33'!
baseline010: spec
	<version: '0.1.0-baseline'>

	spec for: #common do: [
		spec blessing: #baseline.
		spec repository: (MCSmalltalkhubRepository owner: 'dalsat' project: 'ShoreLine-Reporter') location.
		
		spec
			package: 'ShoreLine-Report-Core';
			package: 'ShoreLine-Report-UI' with: [ spec requires: 'ShoreLine-Report-Core' ];
			package: 'ShoreLine-Report-Settings' with: [ spec requires: 'ShoreLine-Report-Core' ];
			package: 'ShoreLine-Report-Staging' with: [ spec requires: 'ShoreLine-Report-Core' ].
	
		spec
			group: 'default' with: #('UI' 'Settings');
			group: 'Core' with: #('ShoreLine-Report-Core');
			group: 'UI' with: #('Core' 'ShoreLine-Report-UI');
			group: 'Settings' with: #('Core' 'ShoreLine-Report-Settings');
			group: 'Staging' with: #('Core' 'ShoreLine-Report-Staging') ].! !

!ConfigurationOfShoreLineReporter class methodsFor: 'private' stamp: 'TommasoDalSasso 4/9/2014 09:53'!
baseConfigurationClassIfAbsent: aBlock

	^Smalltalk
		at: #MetacelloBaseConfiguration
		ifAbsent: [ 
			self ensureMetacelloBaseConfiguration.
			Smalltalk at: #MetacelloBaseConfiguration ifAbsent: aBlock ].
! !

!ConfigurationOfShoreLineReporter class methodsFor: 'development support' stamp: 'TommasoDalSasso 4/9/2014 09:53'!
validate
	"Check the configuration for Errors, Critical Warnings, and Warnings (see class comment for MetacelloMCVersionValidator for more information). 
	Errors identify specification issues that will result in unexpected behaviour when you load the configuration. 
	Critical Warnings identify specification issues that may result in unexpected behavior when you load the configuration.
	Warnings identify specification issues that are technically correct, but are worth take a look at."

	"self validate"

	<apiDocumentation>
	self ensureMetacello.
	^ ((Smalltalk at: #MetacelloToolBox) validateConfiguration: self debug: #() recurse: false) explore! !

!ConfigurationOfShoreLineReporter class methodsFor: 'metacello tool support' stamp: 'TommasoDalSasso 4/9/2014 09:53'!
isMetacelloConfig
	"Answer true and the Metacello tools will operate on you"
	
	^true! !

!ConfigurationOfShoreLineReporter class methodsFor: 'loading' stamp: 'TommasoDalSasso 4/9/2014 09:53'!
loadBleedingEdge
	"Load the latest versions of the mcz files defined for this project. It is not likely that the #bleedingEdge has been tested."

	"self loadBleedingEdge"

	<apiDocumentation>
	^(self project version: #bleedingEdge) load! !

!ConfigurationOfShoreLineReporter class methodsFor: 'private' stamp: 'TommasoDalSasso 4/9/2014 09:53'!
ensureMetacelloBaseConfiguration

	Smalltalk
		at: #MetacelloBaseConfiguration
		ifAbsent: [ 
			| repository version |
			repository := MCHttpRepository location: 'http://seaside.gemstone.com/ss/metacello' user: '' password: ''.
			repository
				versionReaderForFileNamed: 'Metacello-Base-DaleHenrichs.2.mcz'
				do: [ :reader | 
					version := reader version.
					version load.
					version workingCopy repositoryGroup addRepository: repository ] ]! !

!ConfigurationOfShoreLineReporter class methodsFor: 'loading' stamp: 'TommasoDalSasso 4/9/2014 09:53'!
load
	"Load the #stable version defined for this platform. The #stable version is the version that is recommended to be used on this platform."

	"self load"

	<apiDocumentation>
	^(self project version: #stable) load! !

!ConfigurationOfShoreLineReporter class methodsFor: 'development support' stamp: 'TommasoDalSasso 4/9/2014 09:53'!
DevelopmentSupport

"See the methods in the 'development support' category on the class-side of MetacelloBaseConfiguration. Decide what development support methods you would like to use and copy them the the class-side of your configuration."
	<apiDocumentation>
! !

!ConfigurationOfShoreLineReporter class methodsFor: 'accessing' stamp: 'TommasoDalSasso 4/9/2014 09:53'!
project

	^self new project! !

!ConfigurationOfShoreLineReporter class methodsFor: 'private' stamp: 'TommasoDalSasso 4/9/2014 09:53'!
ensureMetacello

	(self baseConfigurationClassIfAbsent: []) ensureMetacello! !

!ConfigurationOfShoreLineReporter class methodsFor: 'loading' stamp: 'TommasoDalSasso 4/9/2014 09:53'!
loadDevelopment
	"Load the #development version defined for this platform. The #development version will change over time and is not expected to be stable."

	"self loadDevelopment"

	<apiDocumentation>
	^(self project version: #development) load! !

!ConfigurationOfTxText commentStamp: 'StephaneDucasse 12/6/2014 11:32'!
(ConfigurationOfTxText project version: '2.6') load: 'Tests'

ConfigurationOfTxText loadDevelopment

"last without Tool-TxWorkspace"
(ConfigurationOfTxText project version: '2.7') load.

"with Tool-TxWorkspace"
(ConfigurationOfTxText project version: '2.8') load.!
!ConfigurationOfTxText methodsFor: 'versions' stamp: 'DenisKudryashov 1/20/2013 19:05'!
version02: spec
	<version: '0.2' imports: #('0.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: 'TxText is new text model system. It is possible replacement of old text editors stuff'.
		spec 
			package: 'TxText-Model' with: 'TxText-Model-DenisKudryashov.2';
			package: 'TxText-Layout' with: 'TxText-Layout-DenisKudryashov.2';
			package: 'TxText-UI' with: 'TxText-UI-DenisKudryashov.2';
			package: 'TxTextTests-Model' with: 'TxTextTests-Model-DenisKudryashov.2';
			package: 'TxTextTests-Layout' with: 'TxTextTests-Layout-DenisKudryashov.2';
			project: 'Mocketry default' with: '2.1';
			project: 'Mocketry Tests' with: '2.1'
	].
! !

!ConfigurationOfTxText methodsFor: 'versions' stamp: 'IgorStasenko 10/21/2014 17:39'!
version26: spec
	<version: '2.6' imports: #('0.9-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: 'New baseline without mocketry'.
		spec 
			package: 'TxText-Model' with: 'TxText-Model-IgorStasenko.46';
			package: 'TxTextTests-Model' with: 'TxTextTests-Model-IgorStasenko.24';
			package: 'TxText-Athens' with: 'TxText-Athens-IgorStasenko.34';
			package: 'TxText-AthensTests' with: 'TxText-AthensTests-IgorStasenko.9';
		 	package: 'TxText-Styler' with: 'TxText-Styler-IgorStasenko.2';
			
			project: 'Athens' with: '2.5'
	].
! !

!ConfigurationOfTxText methodsFor: 'versions' stamp: 'IgorStasenko 9/24/2014 16:50'!
version24: spec
	<version: '2.4' imports: #('0.7-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: 'Removed unused stuff'.
		spec 
			package: 'TxText-Model' with: 'TxText-Model-IgorStasenko.45';
			package: 'TxTextTests-Model' with: 'TxTextTests-Model-IgorStasenko.21';
		 
			package: 'TxText-Athens' with: 'TxText-Athens-IgorStasenko.33';
			package: 'TxText-AthensTests' with: 'TxText-AthensTests-IgorStasenko.8';
			
			project: 'Athens' with: '2.5';
			project: 'Mocketry default' with: '2.3';
			project: 'Mocketry Tests' with: '2.3'
	].
! !

!ConfigurationOfTxText methodsFor: 'versions' stamp: 'IgorStasenko 12/20/2013 15:56'!
version22: spec
	<version: '2.2' imports: #('0.6-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: 'TxTextMorph with more recent workings'.
		spec 
			package: 'TxText-Model' with: 'TxText-Model-IgorStasenko.38';
		 
			package: 'TxText-OldUI' with: 'TxText-OldUI-IgorStasenko.1';
			package: 'TxTextTests-Model' with: 'TxTextTests-Model-IgorStasenko.20';


		 
 			package: 'StructuredEditor' with: 'StructuredEditor-CamilleTeruel.11';
			package: 'TxText-Athens' with: 'TxText-Athens-IgorStasenko.18';
			package: 'TxText-AthensTests' with: 'TxText-AthensTests-IgorStasenko.3';
			
			project: 'Athens' with: '2.5';
			project: 'Mocketry default' with: '2.2';
			project: 'Mocketry Tests' with: '2.2'
	].
! !

!ConfigurationOfTxText methodsFor: 'versions' stamp: 'NicolaiHess 2/15/2015 12:45'!
version282: spec
	<version: '2.8.2' imports: #('1.0.1-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec timestamp: '2015-02-15 12:52'.
		spec 
			package: 'TxText-Model' with: 'TxText-Model-NicolaiHess.50';
			package: 'TxTextTests-Model' with: 'TxTextTests-Model-IgorStasenko.26';
			package: 'TxText-Athens' with: 'TxText-Athens-NicolaiHess.40';
			package: 'TxText-AthensTests' with: 'TxText-AthensTests-IgorStasenko.9';
		 	package: 'TxText-Styler' with: 'TxText-Styler-IgorStasenko.3';
			package: 'Tool-TxWorkspace' with: 'Tool-TxWorkspace-IgorStasenko.3' ]! !

!ConfigurationOfTxText methodsFor: 'accessing' stamp: 'dik 1/18/2013 23:12'!
project

	^ project ifNil: [ | constructor |
		"Bootstrap Metacello if it is not already loaded"
		(self class baseConfigurationClassIfAbsent: []) ensureMetacello.
		"Construct Metacello project"
		constructor := (Smalltalk at: #MetacelloVersionConstructor) on: self.
		project := constructor project.
		project loadType: #linear. "change to #atomic if desired"
		project ]! !

!ConfigurationOfTxText methodsFor: 'versions' stamp: 'DenisKudrayshov 4/27/2013 00:23'!
version06: spec
	<version: '0.6' imports: #('0.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: 'edit and selection behaviour done. TxTextMorph live'.
		spec 
			package: 'TxText-Model' with: 'TxText-Model-DenisKudrayshov.19';
			package: 'TxText-Layout' with: 'TxText-Layout-DenisKudrayshov.27';
			package: 'TxText-UI' with: 'TxText-UI-DenisKudrayshov.21';
			package: 'TxTextTests-Model' with: 'TxTextTests-Model-DenisKudrayshov.9';
			package: 'TxTextTests-Layout' with: 'TxTextTests-Layout-DenisKudrayshov.19';
			project: 'Mocketry default' with: '2.2';
			project: 'Mocketry Tests' with: '2.2'
	].
! !

!ConfigurationOfTxText methodsFor: 'versions' stamp: 'DenisKudryashov 3/28/2013 23:33'!
version04: spec
	<version: '0.4' imports: #('0.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: 'merge with Tristan work and layout cursor positioning'.
		spec 
			package: 'TxText-Model' with: 'TxText-Model-DenisKudryashov.6';
			package: 'TxText-Layout' with: 'TxText-Layout-DenisKudryashov.14';
			package: 'TxText-UI' with: 'TxText-UI-DenisKudryashov.8';
			package: 'TxTextTests-Model' with: 'TxTextTests-Model-DenisKudryashov.4';
			package: 'TxTextTests-Layout' with: 'TxTextTests-Layout-DenisKudryashov.13';
			project: 'Mocketry default' with: '2.2';
			project: 'Mocketry Tests' with: '2.2'
	].
! !

!ConfigurationOfTxText methodsFor: 'versions' stamp: 'DenisKudrayshov 5/19/2013 23:31'!
version08: spec
	<version: '0.8' imports: #('0.3-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: 'Edit decorators done'.
		spec 
			package: 'TxText-Model' with: 'TxText-Model-DenisKudrayshov.26';
			package: 'TxText-Layout' with: 'TxText-Layout-DenisKudrayshov.33';
			package: 'TxText-Editor' with: 'TxText-Editor-DenisKudrayshov.12';
			package: 'TxText-UI' with: 'TxText-UI-DenisKudrayshov.29';
			package: 'TxTextTests-Model' with: 'TxTextTests-Model-DenisKudrayshov.13';
			package: 'TxTextTests-Layout' with: 'TxTextTests-Layout-DenisKudrayshov.22';
			package: 'TxTextTests-Editor' with: 'TxTextTests-Editor-DenisKudrayshov.10';
			project: 'Mocketry default' with: '2.2';
			project: 'Mocketry Tests' with: '2.2'
	].
! !

!ConfigurationOfTxText methodsFor: 'versions' stamp: 'IgorStasenko 12/20/2013 15:56'!
bleedingVersion: spec
	<version: 'bleeding' imports: #('0.6-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'bleedingEdge'.
		spec description: 'Bleeding edge of everything'.
		 
		spec
			project: 'Athens' with: '2.5';
			project: 'Mocketry default' with: '2.2';
			project: 'Mocketry Tests' with: '2.2'
	].
! !

!ConfigurationOfTxText methodsFor: 'versions' stamp: 'IgorStasenko 10/21/2014 17:01'!
version25: spec
	<version: '2.5' imports: #('0.8-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: 'New text styler'.
		spec 
			package: 'TxText-Model' with: 'TxText-Model-IgorStasenko.46';
			package: 'TxTextTests-Model' with: 'TxTextTests-Model-IgorStasenko.22';
			package: 'TxText-Athens' with: 'TxText-Athens-IgorStasenko.34';
			package: 'TxText-AthensTests' with: 'TxText-AthensTests-IgorStasenko.8';
		 	package: 'TxText-Styler' with: 'TxText-Styler-IgorStasenko.2';
			
			project: 'Athens' with: '2.5';
			project: 'Mocketry default' with: '2.3';
			project: 'Mocketry Tests' with: '2.3'
	].
! !

!ConfigurationOfTxText methodsFor: 'baselines' stamp: 'EstebanLorenzano 12/8/2014 16:10'!
baseline10: spec
	<version: '1.0-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec repository: 'http://www.smalltalkhub.com/mc/Pharo/TxText/main'.
		spec description: 'Adding Tool-TxWorkspace'.
		spec 
			project: 'Athens' with: [
			    spec 
				className: 'ConfigurationOfAthens';
				loads: 'default';
				repository: 'http://www.smalltalkhub.com/mc/Pharo/Athens/main'];  

			package: 'TxText-Model';
			package: 'TxTextTests-Model' 
				with: [ spec requires: #('TxText-Model')];
			package: 'TxText-Athens' 
				with: [ spec requires: #('TxText-Model') ];
			package: 'TxText-AthensTests' 
				with: [ spec requires: #('TxText-Athens') ];
			package: 'TxText-Styler' 
				with: [ spec requires: #('TxText-Athens') ];
			package: 'Tool-TxWorkspace' 
				with: [ spec requires: #('TxText-Athens' 'TxText-Styler') ].
		spec
			group: 'default' with: #('Core' 'Tests' 'Tools');
			group: 'Core' with: #('TxText-Model' 'TxText-Athens' 'TxText-Styler' );
			group: 'Tests' with: #('Core' 'TxTextTests-Model' 'TxText-AthensTests');
			group: 'Tools' with: #('Core' 'Tool-TxWorkspace'). 
	].
! !

!ConfigurationOfTxText methodsFor: 'versions' stamp: 'DenisKudryashov 1/18/2013 23:31'!
version01: spec
	<version: '0.1' imports: #('0.1-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: 'TxText is new text model system. It is possible replacement of old text editors stuff'.
		spec 
			package: 'TxText-Model' with: 'TxText-Model-DenisKudryashov.1';
			package: 'TxText-Layout' with: 'TxText-Layout-DenisKudryashov.1';
			package: 'TxText-UI' with: 'TxText-UI-DenisKudryashov.1';
			package: 'TxTextTests-Model' with: 'TxTextTests-Model-DenisKudryashov.1';
			package: 'TxTextTests-Layout' with: 'TxTextTests-Layout-DenisKudryashov.1'
	].
! !

!ConfigurationOfTxText methodsFor: 'versions' stamp: 'EstebanLorenzano 12/8/2014 16:52'!
version281: spec
	<version: '2.8.1' imports: #('1.0.1-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec timestamp: '2014-12-08 16:52'.
		spec 
			package: 'TxText-Model' with: 'TxText-Model-IgorStasenko.48';
			package: 'TxTextTests-Model' with: 'TxTextTests-Model-IgorStasenko.26';
			package: 'TxText-Athens' with: 'TxText-Athens-IgorStasenko.35';
			package: 'TxText-AthensTests' with: 'TxText-AthensTests-IgorStasenko.9';
		 	package: 'TxText-Styler' with: 'TxText-Styler-IgorStasenko.3';
			package: 'Tool-TxWorkspace' with: 'Tool-TxWorkspace-IgorStasenko.3' ]! !

!ConfigurationOfTxText methodsFor: 'baselines' stamp: 'IgorStasenko 11/20/2013 13:48'!
baseline05: spec
	<version: '0.5-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec repository: 'http://www.smalltalkhub.com/mc/sig/TxText/main'.
		spec 
			project: 'Mocketry default' with: [
		     		spec 
					className: 'ConfigurationOfMocketry';
					loads: 'default';
					repository: 'http://www.smalltalkhub.com/mc/dionisiy/Mocketry/main'];  

			project: 'Mocketry Tests' with: [
		     		spec 
					className: 'ConfigurationOfMocketry';
					loads: 'Tests';					
					repository: 'http://www.smalltalkhub.com/mc/dionisiy/Mocketry/main'];  
				
			package: 'StructuredEditor' with: [
				spec repository: 'http://www.smalltalkhub.com/mc/CamilleTeruel/StructuredEditor/main'
			]; 
				
				
			package: 'TxText-Model';
			package: 'TxText-OldLayout' with: [
				spec requires: 'TxText-Model']; 
			package: 'TxText-OldEditor' with: [
				spec requires: 'TxText-OldLayout']; 
			package: 'TxText-OldUI' with: [
				spec requires: 'TxText-OldEditor'];
			package: 'TxTextTests-Model' with: [ 
				spec requires: #('TxText-Model' 'Mocketry default' )];
			package: 'TxTextTests-OldLayout' with: [ 
				spec requires: #('TxText-OldLayout' 'Mocketry default')];
			package: 'TxTextTests-OldEditor' with: [ 
				spec requires: #('TxText-OldEditor' 'Mocketry default')];
			
			package: 'TxText-Athens' with: [ spec requires: #('StructuredEditor') ];
			package: 'TxText-AthensTests' with: [ spec requires: #('TxText-Athens') ]
			
			.
			
		spec
			group: 'default' with: #('Core' 'Tests');
			group: 'Core' with: #('TxText-Model' 'TxText-OldLayout' 'TxText-OldUI' 'TxText-Athens' );
			group: 'Tests' with: #('Core' 'TxTextTests-Model' 'TxTextTests-OldLayout' 'TxTextTests-OldEditor' 'Mocketry Tests' 'TxText-AthensTests'). 
			
	].
! !

!ConfigurationOfTxText methodsFor: 'baselines' stamp: 'IgorStasenko 10/21/2014 17:31'!
baseline09: spec
	<version: '0.9-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec repository: 'http://www.smalltalkhub.com/mc/sig/TxText/main'.
		spec 
			project: 'Athens' with: [
			    spec 
				className: 'ConfigurationOfAthens';
				loads: 'default';
				repository: 'http://www.smalltalkhub.com/mc/Pharo/Athens/main'];  

			package: 'TxText-Model';
			package: 'TxTextTests-Model' with: [ 
				spec requires: #('TxText-Model')];
			
			
			package: 'TxText-Athens' with: [ spec requires: #('TxText-Model') ];
			package: 'TxText-AthensTests' with: [ spec requires: #('TxText-Athens') ];
			package: 'TxText-Styler' with: [ spec requires: #('TxText-Athens') ].

			
		spec
			group: 'default' with: #('Core' 'Tests');
			group: 'Core' with: #('TxText-Model' 'TxText-Athens' 'TxText-Styler' );
			group: 'Tests' with: #('Core' 'TxTextTests-Model' 'TxText-AthensTests'). 
			
	].
! !

!ConfigurationOfTxText methodsFor: 'baselines' stamp: 'DenisKudrayshov 5/19/2013 23:30'!
baseline03: spec
	<version: '0.3-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec repository: 'http://www.smalltalkhub.com/mc/sig/TxText/main'.
		spec 
			project: 'Mocketry default' with: [
		     		spec 
					className: 'ConfigurationOfMocketry';
					loads: 'default';
					repository: 'http://www.smalltalkhub.com/mc/dionisiy/Mocketry/main'];  
			project: 'Mocketry Tests' with: [
		     		spec 
					className: 'ConfigurationOfMocketry';
					loads: 'Tests';					
					repository: 'http://www.smalltalkhub.com/mc/dionisiy/Mocketry/main'];  
			package: 'TxText-Model';
			package: 'TxText-Layout' with: [
				spec requires: 'TxText-Model']; 
			package: 'TxText-Editor' with: [
				spec requires: 'TxText-Layout']; 
			package: 'TxText-UI' with: [
				spec requires: 'TxText-Editor'];
			package: 'TxTextTests-Model' with: [ 
				spec requires: #('TxText-Model' 'Mocketry default' )];
			package: 'TxTextTests-Layout' with: [ 
				spec requires: #('TxText-Layout' 'Mocketry default')];
			package: 'TxTextTests-Editor' with: [ 
				spec requires: #('TxText-Editor' 'Mocketry default')].
		spec
			group: 'default' with: #('Core');
			group: 'Core' with: #('TxText-Model' 'TxText-Layout' 'TxText-UI');
			group: 'Tests' with: #('Core' 'TxTextTests-Model' 'TxTextTests-Layout' 'TxTextTests-Editor' 'Mocketry Tests'). 
			
	].
! !

!ConfigurationOfTxText methodsFor: 'baselines' stamp: 'EstebanLorenzano 12/8/2014 16:51'!
baseline101: spec
	<version: '1.0.1-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec repository: 'http://www.smalltalkhub.com/mc/Pharo/TxText/main'.
		spec description: 'Adding Tool-TxWorkspace'.
		spec 
			package: 'TxText-Model';
			package: 'TxTextTests-Model' 
				with: [ spec requires: #('TxText-Model')];
			package: 'TxText-Athens' 
				with: [ spec requires: #('TxText-Model') ];
			package: 'TxText-AthensTests' 
				with: [ spec requires: #('TxText-Athens') ];
			package: 'TxText-Styler' 
				with: [ spec requires: #('TxText-Athens') ];
			package: 'Tool-TxWorkspace' 
				with: [ spec requires: #('TxText-Athens' 'TxText-Styler') ].
		spec
			group: 'default' with: #('Core' 'Tests' 'Tools');
			group: 'Core' with: #('TxText-Model' 'TxText-Athens' 'TxText-Styler' );
			group: 'Tests' with: #('Core' 'TxTextTests-Model' 'TxText-AthensTests');
			group: 'Tools' with: #('Core' 'Tool-TxWorkspace') ].
! !

!ConfigurationOfTxText methodsFor: 'baselines' stamp: 'DenisKudryashov 1/18/2013 23:32'!
baseline01: spec
	<version: '0.1-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec repository: 'http://www.smalltalkhub.com/mc/sig/TxText/main'.
		spec 
			package: 'TxText-Model';
			package: 'TxText-Layout' with: [
				spec requires: 'TxText-Model']; 
			package: 'TxText-UI' with: [
				spec requires: 'TxText-Layout'];
			package: 'TxTextTests-Model' with: [ 
				spec requires: 'TxText-Model' ];
			package: 'TxTextTests-Layout' with: [ 
				spec requires: 'TxText-Layout' ]
	].
! !

!ConfigurationOfTxText methodsFor: 'baselines' stamp: 'DenisKudryashov 1/20/2013 19:40'!
baseline02: spec
	<version: '0.2-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec repository: 'http://www.smalltalkhub.com/mc/sig/TxText/main'.
		spec 
			project: 'Mocketry default' with: [
		     		spec 
					className: 'ConfigurationOfMocketry';
					loads: 'default';
					repository: 'http://www.smalltalkhub.com/mc/dionisiy/Mocketry/main'];  
			project: 'Mocketry Tests' with: [
		     		spec 
					className: 'ConfigurationOfMocketry';
					loads: 'Tests';					
					repository: 'http://www.smalltalkhub.com/mc/dionisiy/Mocketry/main'];  
			package: 'TxText-Model';
			package: 'TxText-Layout' with: [
				spec requires: 'TxText-Model']; 
			package: 'TxText-UI' with: [
				spec requires: 'TxText-Layout'];
			package: 'TxTextTests-Model' with: [ 
				spec requires: #('TxText-Model' 'Mocketry default' )];
			package: 'TxTextTests-Layout' with: [ 
				spec requires: #('TxText-Layout' 'Mocketry default')].
		spec
			group: 'default' with: #('Core');
			group: 'Core' with: #('TxText-Model' 'TxText-Layout' 'TxText-UI');
			group: 'Tests' with: #('TxTextTests-Model' 'TxTextTests-Layout' 'Mocketry Tests'). 
			
	].
! !

!ConfigurationOfTxText methodsFor: 'versions' stamp: 'StephaneDucasse 12/6/2014 11:32'!
version28: spec
	<version: '2.8' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: 'Add TxWorkspace.'.
		spec 
			package: 'TxText-Model' with: 'TxText-Model-IgorStasenko.48';
			package: 'TxTextTests-Model' with: 'TxTextTests-Model-IgorStasenko.26';
			package: 'TxText-Athens' with: 'TxText-Athens-IgorStasenko.35';
			package: 'TxText-AthensTests' with: 'TxText-AthensTests-IgorStasenko.9';
		 	package: 'TxText-Styler' with: 'TxText-Styler-IgorStasenko.3';
			package: 'Tool-TxWorkspace' with: 'Tool-TxWorkspace-IgorStasenko.3';
			
			project: 'Athens' with: '2.5'
	].
! !

!ConfigurationOfTxText methodsFor: 'versions' stamp: 'StephaneDucasse 12/6/2014 11:21'!
version27: spec
	<version: '2.7' imports: #('0.9-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: 'Update to fix character stream issues.'.
		spec 
			package: 'TxText-Model' with: 'TxText-Model-IgorStasenko.48';
			package: 'TxTextTests-Model' with: 'TxTextTests-Model-IgorStasenko.26';
			package: 'TxText-Athens' with: 'TxText-Athens-IgorStasenko.35';
			package: 'TxText-AthensTests' with: 'TxText-AthensTests-IgorStasenko.9';
		 	package: 'TxText-Styler' with: 'TxText-Styler-IgorStasenko.3';
			
			
			project: 'Athens' with: '2.5'
	].
! !

!ConfigurationOfTxText methodsFor: 'versions' stamp: 'DenisKudrayshov 5/29/2013 00:07'!
version11: spec
	<version: '1.1' imports: #('0.3-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: 'TxTextMorph with halo menu items and correct transparent drawing'.
		spec 
			package: 'TxText-Model' with: 'TxText-Model-DenisKudrayshov.28';
			package: 'TxText-Layout' with: 'TxText-Layout-DenisKudrayshov.34';
			package: 'TxText-Editor' with: 'TxText-Editor-DenisKudrayshov.17';
			package: 'TxText-UI' with: 'TxText-UI-DenisKudrayshov.37';
			package: 'TxTextTests-Model' with: 'TxTextTests-Model-DenisKudrayshov.15';
			package: 'TxTextTests-Layout' with: 'TxTextTests-Layout-DenisKudrayshov.22';
			package: 'TxTextTests-Editor' with: 'TxTextTests-Editor-DenisKudrayshov.15';
			project: 'Mocketry default' with: '2.2';
			project: 'Mocketry Tests' with: '2.2'
	].
! !

!ConfigurationOfTxText methodsFor: 'baselines' stamp: 'IgorStasenko 10/7/2013 11:59'!
baseline04: spec
	<version: '0.4-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec repository: 'http://www.smalltalkhub.com/mc/sig/TxText/main'.
		spec 
			project: 'Mocketry default' with: [
		     		spec 
					className: 'ConfigurationOfMocketry';
					loads: 'default';
					repository: 'http://www.smalltalkhub.com/mc/dionisiy/Mocketry/main'];  

			project: 'Mocketry Tests' with: [
		     		spec 
					className: 'ConfigurationOfMocketry';
					loads: 'Tests';					
					repository: 'http://www.smalltalkhub.com/mc/dionisiy/Mocketry/main'];  
				
			package: 'StructuredEditor' with: [
				spec repository: 'http://www.smalltalkhub.com/mc/CamilleTeruel/StructuredEditor/main'
			]; 
				
				
			package: 'TxText-Model';
			package: 'TxText-Layout' with: [
				spec requires: 'TxText-Model']; 
			package: 'TxText-Editor' with: [
				spec requires: 'TxText-Layout']; 
			package: 'TxText-UI' with: [
				spec requires: 'TxText-Editor'];
			package: 'TxTextTests-Model' with: [ 
				spec requires: #('TxText-Model' 'Mocketry default' )];
			package: 'TxTextTests-Layout' with: [ 
				spec requires: #('TxText-Layout' 'Mocketry default')];
			package: 'TxTextTests-Editor' with: [ 
				spec requires: #('TxText-Editor' 'Mocketry default')];
			
			package: 'TxText-Athens' with: [ spec requires: #('StructuredEditor') ];
			package: 'TxText-AthensTests' with: [ spec requires: #('TxText-Athens') ]
			
			.
			
		spec
			group: 'default' with: #('Core' 'Tests');
			group: 'Core' with: #('TxText-Model' 'TxText-Layout' 'TxText-UI' 'TxText-Athens' );
			group: 'Tests' with: #('Core' 'TxTextTests-Model' 'TxTextTests-Layout' 'TxTextTests-Editor' 'Mocketry Tests' 'TxText-AthensTests'). 
			
	].
! !

!ConfigurationOfTxText methodsFor: 'versions' stamp: 'DenisKudrayshov 5/22/2013 00:08'!
version09: spec
	<version: '0.9' imports: #('0.3-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: 'Edit decorators renamings and new TxSecretEditDecorator'.
		spec 
			package: 'TxText-Model' with: 'TxText-Model-DenisKudrayshov.26';
			package: 'TxText-Layout' with: 'TxText-Layout-DenisKudrayshov.33';
			package: 'TxText-Editor' with: 'TxText-Editor-DenisKudrayshov.14';
			package: 'TxText-UI' with: 'TxText-UI-DenisKudrayshov.30';
			package: 'TxTextTests-Model' with: 'TxTextTests-Model-DenisKudrayshov.13';
			package: 'TxTextTests-Layout' with: 'TxTextTests-Layout-DenisKudrayshov.22';
			package: 'TxTextTests-Editor' with: 'TxTextTests-Editor-DenisKudrayshov.12';
			project: 'Mocketry default' with: '2.2';
			project: 'Mocketry Tests' with: '2.2'
	].
! !

!ConfigurationOfTxText methodsFor: 'versions' stamp: 'IgorStasenko 11/20/2013 13:03'!
version20: spec
	<version: '2.0' imports: #('0.4-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: 'TxTextMorph with more recent workings'.
		spec 
			package: 'TxText-Model' with: 'TxText-Model-IgorStasenko.37';
		 
			package: 'TxText-UI' with: 'TxText-UI-IgorStasenko.39';
			package: 'TxTextTests-Model' with: 'TxTextTests-Model-IgorStasenko.20';


		 
 			package: 'StructuredEditor' with: 'StructuredEditor-CamilleTeruel.11';
			package: 'TxText-Athens' with: 'TxText-Athens-IgorStasenko.17';
			package: 'TxText-AthensTests' with: 'TxText-AthensTests-IgorStasenko.3';
			
			
			project: 'Mocketry default' with: '2.2';
			project: 'Mocketry Tests' with: '2.2'
	].
! !

!ConfigurationOfTxText methodsFor: 'versions' stamp: 'DenisKudrayshov 4/7/2013 01:44'!
version05: spec
	<version: '0.5' imports: #('0.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: 'Cursor navigation refactored and improved'.
		spec 
			package: 'TxText-Model' with: 'TxText-Model-DenisKudrayshov.9';
			package: 'TxText-Layout' with: 'TxText-Layout-DenisKudrayshov.18';
			package: 'TxText-UI' with: 'TxText-UI-DenisKudrayshov.11';
			package: 'TxTextTests-Model' with: 'TxTextTests-Model-DenisKudrayshov.5';
			package: 'TxTextTests-Layout' with: 'TxTextTests-Layout-DenisKudrayshov.16';
			project: 'Mocketry default' with: '2.2';
			project: 'Mocketry Tests' with: '2.2'
	].
! !

!ConfigurationOfTxText methodsFor: 'versions' stamp: 'DenisKudrayshov 5/27/2013 00:51'!
version10: spec
	<version: '1.0' imports: #('0.3-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: 'Edit validation logic with text specs'.
		spec 
			package: 'TxText-Model' with: 'TxText-Model-DenisKudrayshov.27';
			package: 'TxText-Layout' with: 'TxText-Layout-DenisKudrayshov.33';
			package: 'TxText-Editor' with: 'TxText-Editor-DenisKudrayshov.17';
			package: 'TxText-UI' with: 'TxText-UI-DenisKudrayshov.33';
			package: 'TxTextTests-Model' with: 'TxTextTests-Model-DenisKudrayshov.14';
			package: 'TxTextTests-Layout' with: 'TxTextTests-Layout-DenisKudrayshov.22';
			package: 'TxTextTests-Editor' with: 'TxTextTests-Editor-DenisKudrayshov.15';
			project: 'Mocketry default' with: '2.2';
			project: 'Mocketry Tests' with: '2.2'
	].
! !

!ConfigurationOfTxText methodsFor: 'versions' stamp: 'NicolaiHess 2/22/2015 13:45'!
version283: spec
	<version: '2.8.3' imports: #('1.0.1-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec timestamp: '2015-02-18T00:08:11.856022+01:00'.
		spec 
			package: 'TxText-Model' with: 'TxText-Model-NicolaiHess.50';
			package: 'TxTextTests-Model' with: 'TxTextTests-Model-IgorStasenko.26';
			package: 'TxText-Athens' with: 'TxText-Athens-NicolaiHess.42';
			package: 'TxText-AthensTests' with: 'TxText-AthensTests-IgorStasenko.9';
		 	package: 'TxText-Styler' with: 'TxText-Styler-IgorStasenko.3';
			package: 'Tool-TxWorkspace' with: 'Tool-TxWorkspace-MarcusDenker.4' ]! !

!ConfigurationOfTxText methodsFor: 'baselines' stamp: 'IgorStasenko 12/20/2013 15:55'!
baseline06: spec
	<version: '0.6-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec repository: 'http://www.smalltalkhub.com/mc/sig/TxText/main'.
		spec 
			project: 'Mocketry default' with: [
		     		spec 
					className: 'ConfigurationOfMocketry';
					loads: 'default';
					repository: 'http://www.smalltalkhub.com/mc/dionisiy/Mocketry/main'];  
	
			project: 'Athens' with: [
			    spec 
				className: 'ConfigurationOfAthens';
				loads: 'default';
				repository: 'http://www.smalltalkhub.com/mc/Pharo/Athens/main'];  

			project: 'Mocketry Tests' with: [
		     		spec 
					className: 'ConfigurationOfMocketry';
					loads: 'Tests';					
					repository: 'http://www.smalltalkhub.com/mc/dionisiy/Mocketry/main'];  
				
			package: 'StructuredEditor' with: [
				spec repository: 'http://www.smalltalkhub.com/mc/CamilleTeruel/StructuredEditor/main'
			]; 
				
				
			package: 'TxText-Model';
			package: 'TxText-OldLayout' with: [
				spec requires: 'TxText-Model']; 
			package: 'TxText-OldEditor' with: [
				spec requires: 'TxText-OldLayout']; 
			package: 'TxText-OldUI' with: [
				spec requires: 'TxText-OldEditor'];
			package: 'TxTextTests-Model' with: [ 
				spec requires: #('TxText-Model' 'Mocketry default' )];
			package: 'TxTextTests-OldLayout' with: [ 
				spec requires: #('TxText-OldLayout' 'Mocketry default')];
			package: 'TxTextTests-OldEditor' with: [ 
				spec requires: #('TxText-OldEditor' 'Mocketry default')];
			
			package: 'TxText-Athens' with: [ spec requires: #('StructuredEditor') ];
			package: 'TxText-AthensTests' with: [ spec requires: #('TxText-Athens') ]
			
			.
			
		spec
			group: 'default' with: #('Core' 'Tests');
			group: 'Core' with: #('TxText-Model' 'TxText-OldLayout' 'TxText-OldUI' 'TxText-Athens' );
			group: 'Tests' with: #('Core' 'TxTextTests-Model' 'TxTextTests-OldLayout' 'TxTextTests-OldEditor' 'Mocketry Tests' 'TxText-AthensTests'). 
			
	].
! !

!ConfigurationOfTxText methodsFor: 'versions' stamp: 'IgorStasenko 11/20/2013 13:49'!
version21: spec
	<version: '2.1' imports: #('0.5-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: 'TxTextMorph with more recent workings'.
		spec 
			package: 'TxText-Model' with: 'TxText-Model-IgorStasenko.37';
		 
			package: 'TxText-OldUI' with: 'TxText-OldUI-IgorStasenko.1';
			package: 'TxTextTests-Model' with: 'TxTextTests-Model-IgorStasenko.20';


		 
 			package: 'StructuredEditor' with: 'StructuredEditor-CamilleTeruel.11';
			package: 'TxText-Athens' with: 'TxText-Athens-IgorStasenko.17';
			package: 'TxText-AthensTests' with: 'TxText-AthensTests-IgorStasenko.3';
			
			
			project: 'Mocketry default' with: '2.2';
			project: 'Mocketry Tests' with: '2.2'
	].
! !

!ConfigurationOfTxText methodsFor: 'baselines' stamp: 'IgorStasenko 10/21/2014 17:09'!
baseline08: spec
	<version: '0.8-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec repository: 'http://www.smalltalkhub.com/mc/sig/TxText/main'.
		spec 
			project: 'Mocketry default' with: [
		     		spec 
					className: 'ConfigurationOfMocketry';
					loads: 'default';
					repository: 'http://www.smalltalkhub.com/mc/dionisiy/Mocketry/main'];  
	
			project: 'Athens' with: [
			    spec 
				className: 'ConfigurationOfAthens';
				loads: 'default';
				repository: 'http://www.smalltalkhub.com/mc/Pharo/Athens/main'];  

			project: 'Mocketry Tests' with: [
		     		spec 
					className: 'ConfigurationOfMocketry';
					loads: 'Tests';					
					repository: 'http://www.smalltalkhub.com/mc/dionisiy/Mocketry/main'];  
			
				
			package: 'TxText-Model';
			package: 'TxTextTests-Model' with: [ 
				spec requires: #('TxText-Model' 'Mocketry default' )];
			
			
			package: 'TxText-Athens' with: [ spec requires: #('TxText-Model') ];
			package: 'TxText-AthensTests' with: [ spec requires: #('TxText-Athens') ];
			package: 'TxText-Styler' with: [ spec requires: #('TxText-Athens') ].

			
		spec
			group: 'default' with: #('Core' 'Tests');
			group: 'Core' with: #('TxText-Model' 'TxText-Athens' 'TxText-Styler' );
			group: 'Tests' with: #('Core' 'TxTextTests-Model' 'Mocketry Tests' 'TxText-AthensTests'). 
			
	].
! !

!ConfigurationOfTxText methodsFor: 'baselines' stamp: 'IgorStasenko 7/16/2014 12:18'!
baseline07: spec
	<version: '0.7-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec repository: 'http://www.smalltalkhub.com/mc/sig/TxText/main'.
		spec 
			project: 'Mocketry default' with: [
		     		spec 
					className: 'ConfigurationOfMocketry';
					loads: 'default';
					repository: 'http://www.smalltalkhub.com/mc/dionisiy/Mocketry/main'];  
	
			project: 'Athens' with: [
			    spec 
				className: 'ConfigurationOfAthens';
				loads: 'default';
				repository: 'http://www.smalltalkhub.com/mc/Pharo/Athens/main'];  

			project: 'Mocketry Tests' with: [
		     		spec 
					className: 'ConfigurationOfMocketry';
					loads: 'Tests';					
					repository: 'http://www.smalltalkhub.com/mc/dionisiy/Mocketry/main'];  
			
				
			package: 'TxText-Model';
			package: 'TxTextTests-Model' with: [ 
				spec requires: #('TxText-Model' 'Mocketry default' )];
			
			
			package: 'TxText-Athens' with: [ spec requires: #('TxText-Model') ];
			package: 'TxText-AthensTests' with: [ spec requires: #('TxText-Athens') ].
			
		spec
			group: 'default' with: #('Core' 'Tests');
			group: 'Core' with: #('TxText-Model' 'TxText-Athens' );
			group: 'Tests' with: #('Core' 'TxTextTests-Model' 'Mocketry Tests' 'TxText-AthensTests'). 
			
	].
! !

!ConfigurationOfTxText methodsFor: 'versions' stamp: 'IgorStasenko 2/6/2013 14:33'!
version03: spec
	<version: '0.3' imports: #('0.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: 'merge with Tristan work'.
		spec 
			package: 'TxText-Model' with: 'TxText-Model-TristanBourgois.3';
			package: 'TxText-Layout' with: 'TxText-Layout-DenisKudryashov.3';
			package: 'TxText-UI' with: 'TxText-UI-DenisKudryashov.3';
			package: 'TxTextTests-Model' with: 'TxTextTests-Model-TristanBourgois.3';
			package: 'TxTextTests-Layout' with: 'TxTextTests-Layout-DenisKudryashov.3';
			project: 'Mocketry default' with: '2.1';
			project: 'Mocketry Tests' with: '2.1'
	].
! !

!ConfigurationOfTxText methodsFor: 'versions' stamp: 'StephaneDucasse 8/2/2014 19:04'!
version23: spec
	<version: '2.3' imports: #('0.7-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: 'Removed unused stuff'.
		spec 
			package: 'TxText-Model' with: 'TxText-Model-IgorStasenko.41';
			package: 'TxTextTests-Model' with: 'TxTextTests-Model-IgorStasenko.20';
		 
 			package: 'StructuredEditor' with: 'StructuredEditor-CamilleTeruel.11';
			package: 'TxText-Athens' with: 'TxText-Athens-StephaneDucasse.31';
			package: 'TxText-AthensTests' with: 'TxText-AthensTests-SeanDeNigris.7';
			
			project: 'Athens' with: '2.5';
			project: 'Mocketry default' with: '2.2';
			project: 'Mocketry Tests' with: '2.2'
	].
! !

!ConfigurationOfTxText methodsFor: 'versions' stamp: 'DenisKudrayshov 4/28/2013 21:23'!
version07: spec
	<version: '0.7' imports: #('0.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: 'Standart shortcuts for navigation and editing done.'.
		spec 
			package: 'TxText-Model' with: 'TxText-Model-DenisKudrayshov.22';
			package: 'TxText-Layout' with: 'TxText-Layout-DenisKudrayshov.31';
			package: 'TxText-UI' with: 'TxText-UI-DenisKudrayshov.25';
			package: 'TxTextTests-Model' with: 'TxTextTests-Model-DenisKudrayshov.12';
			package: 'TxTextTests-Layout' with: 'TxTextTests-Layout-DenisKudrayshov.21';
			project: 'Mocketry default' with: '2.2';
			project: 'Mocketry Tests' with: '2.2'
	].
! !

!ConfigurationOfTxText class methodsFor: 'private' stamp: 'dik 1/18/2013 23:12'!
baseConfigurationClassIfAbsent: aBlock

	^Smalltalk
		at: #MetacelloBaseConfiguration
		ifAbsent: [ 
			self ensureMetacelloBaseConfiguration.
			Smalltalk at: #MetacelloBaseConfiguration ifAbsent: aBlock ].
! !

!ConfigurationOfTxText class methodsFor: 'development support' stamp: 'dik 1/18/2013 23:12'!
validate
	"Check the configuration for Errors, Critical Warnings, and Warnings (see class comment for MetacelloMCVersionValidator for more information). 
	Errors identify specification issues that will result in unexpected behaviour when you load the configuration. 
	Critical Warnings identify specification issues that may result in unexpected behavior when you load the configuration.
	Warnings identify specification issues that are technically correct, but are worth take a look at."

	"self validate"

	<apiDocumentation>
	self ensureMetacello.
	^ ((Smalltalk at: #MetacelloToolBox) validateConfiguration: self debug: #() recurse: false) explore! !

!ConfigurationOfTxText class methodsFor: 'metacello tool support' stamp: 'dik 1/18/2013 23:12'!
isMetacelloConfig
	"Answer true and the Metacello tools will operate on you"
	
	^true! !

!ConfigurationOfTxText class methodsFor: 'loading' stamp: 'dik 1/18/2013 23:12'!
loadBleedingEdge
	"Load the latest versions of the mcz files defined for this project. It is not likely that the #bleedingEdge has been tested."

	"self loadBleedingEdge"

	<apiDocumentation>
	^(self project version: #bleedingEdge) load! !

!ConfigurationOfTxText class methodsFor: 'private' stamp: 'dik 1/18/2013 23:12'!
ensureMetacelloBaseConfiguration

	Smalltalk
		at: #MetacelloBaseConfiguration
		ifAbsent: [ 
			| repository version |
			repository := MCHttpRepository location: 'http://seaside.gemstone.com/ss/metacello' user: '' password: ''.
			repository
				versionReaderForFileNamed: 'Metacello-Base-DaleHenrichs.2.mcz'
				do: [ :reader | 
					version := reader version.
					version load.
					version workingCopy repositoryGroup addRepository: repository ] ]! !

!ConfigurationOfTxText class methodsFor: 'loading' stamp: 'dik 1/18/2013 23:12'!
load
	"Load the #stable version defined for this platform. The #stable version is the version that is recommended to be used on this platform."

	"self load"

	<apiDocumentation>
	^(self project version: #stable) load! !

!ConfigurationOfTxText class methodsFor: 'development support' stamp: 'dik 1/18/2013 23:12'!
DevelopmentSupport

"See the methods in the 'development support' category on the class-side of MetacelloBaseConfiguration. Decide what development support methods you would like to use and copy them the the class-side of your configuration."
	<apiDocumentation>
! !

!ConfigurationOfTxText class methodsFor: 'accessing' stamp: 'dik 1/18/2013 23:12'!
project

	^self new project! !

!ConfigurationOfTxText class methodsFor: 'private' stamp: 'dik 1/18/2013 23:12'!
ensureMetacello

	(self baseConfigurationClassIfAbsent: []) ensureMetacello! !

!ConfigurationOfTxText class methodsFor: 'loading' stamp: 'IgorStasenko 10/7/2013 12:07'!
loadDevelopment
	"Load the #development version defined for this platform. The #development version will change over time and is not expected to be stable."

	"self loadDevelopment"

	<apiDocumentation>
	^(self project latestVersion: #development ) load! !

!ConfigurationOfVersionner commentStamp: '<historical>'!
Configuration class for Versionner.
!
!ConfigurationOfVersionner methodsFor: 'baselines' stamp: 'ChristopheDemarey 2/28/2014 18:33'!
baseline26: spec
	<version: '2.6-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec repository: 'http://smalltalkhub.com/mc/demarey/Versionner/main'.
		spec 
			package: 'Versionner-Core-Model';
			package: 'Versionner-Core-Commands' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Core-Announcements' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Core-DependenciesModel' with: [
				spec requires: #('Versionner-Core-Model' 'Versionner-Core-Announcements' ). ];
			package: 'Versionner-Spec-Browser';
			package: 'Versionner-Tests-Resources';
			package: 'Versionner-Tests-Core-Model' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Tests-Core-Commands' with: [
				spec requires: #('Versionner-Core-Model' 'Versionner-Core-Commands' ). ];
			package: 'Versionner-Tests-Core-DependenciesModel' with: [
				spec requires: #('Versionner-Core-DependenciesModel' ). ].
		spec group: 'Core' with: #('Versionner-Core-Model' 'Versionner-Core-DependenciesModel' 'Versionner-Core-Commands' 'Versionner-Core-Announcements' ). ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovala 8/18/2012 19:22'!
version133: spec
	<version: '1.33' imports: #('1.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.32 : adding comment
1.33 :

Fixing issue 1 committing a config commits twice.

Now when a configuration an initial version (1.0) is created. And the configuration is saved in the repository automatically.'.
		spec author: 'JuanPabloSandovalAlcocer'.
		spec timestamp: '8/2/2012 15:36'.
		spec 
			project: 'Metacello ToolBox' with: #'stable';
			project: 'Glamour for Versionner' with: #'stable';
			project: 'Spec for Versionner' with: #'stable'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JuanPabloSandovalAlcocer.13';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.16';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalAlcocer.13';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-JuanPabloSandovalA.12';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JuanPabloSandovalAlcocer.18';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'ChristopheDemarey 3/24/2014 10:17'!
version26: spec
	<version: '2.6' imports: #('2.6-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.6'.
		spec author: 'ChristopheDemarey'.
		spec timestamp: '3/24/2014 10:17'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-ChristopheDemarey.37';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-ChristopheDemarey.45';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-ChristopheDemarey.6';
			package: 'Versionner-Core-DependenciesModel' with: 'Versionner-Core-DependenciesModel-ChristopheDemarey.83';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-ChristopheDemarey.134';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-ChristopheDemarey.10';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-ChristopheDemarey.23';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-ChristopheDemarey.10';
			package: 'Versionner-Tests-Core-DependenciesModel' with: 'Versionner-Tests-Core-DependenciesModel-ChristopheDemarey.38'. ].
! !

!ConfigurationOfVersionner methodsFor: 'baselines' stamp: 'JuanPabloSandovalA 8/15/2012 12:39'!
baseline13: spec
	<version: '1.3-baseline'>

	spec for: #common do: [
		spec blessing: #baseline.
		spec repository: 'http://ss3.gemstone.com/ss/Versionner'.	
		spec project: 'Metacello ToolBox' with: [
				spec
					className: 'ConfigurationOfMetacello';
					version: #'stable';
					loads: #('Metacello-ToolBox');
					repository: 'http://seaside.gemstone.com/ss/metacello';
					repository: 'http://www.squeaksource.com/metacello'.].
		spec
			project: 'Spec for Versionner' with: [
				spec
					className: 'ConfigurationOfSpec';
					file: 'ConfigurationOfSpec';
					version:#stable;
					repository: 'http://ss3.gemstone.com/ss/Spec' ].
		spec 
			package: 'Versionner-Core-Model' with: [ spec requires: 'Metacello ToolBox' ];
			package: 'Versionner-Core-Commands' with:[ spec requires: #('Versionner-Core-Model')];
			package: 'Versionner-Core-Announcements' with:[ spec requires: #('Versionner-Core-Model')];
			package: 'Versionner-Tests-Core-Model' with:[ spec requires: #('Versionner-Core-Model')];
			package: 'Versionner-Tests-Core-Commands' with:[ spec requires: #('Versionner-Core-Model' 'Versionner-Core-Commands')];
			package: 'Versionner-Help';	
			package: 'Versionner-Cache' with:[ spec requires: #('Versionner-Core-Model' 'Versionner-Core-Commands')];
			package: 'Versionner-Spec-Browser' with:[ spec requires: 'Spec for Versionner'];
			package: 'Versionner-Tests-Resources'.

		spec group: 'Core' with: #('Versionner-Core-Model' 'Versionner-Core-Commands' 'Versionner-Core-Announcements' 'Versionner-Cache').
		spec group: 'Spec' with: #('Versionner-Spec-Browser').
		
	spec].! !

!ConfigurationOfVersionner methodsFor: 'symbolic versions' stamp: 'ChristopheDemarey 3/20/2015 11:23'!
stable: spec
	<symbolicVersion: #'stable'>

	spec for: #'common' version: '2.9'.

	spec for: #'pharo1.4.x' version: '1.33'.

	spec for: #'pharo2.0.x' version: '1.37'.
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalA 5/20/2012 23:38'!
version112: spec
	<version: '1.12' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.11 : adding dependenci order to caching mechanism
1.12 : updating cache project'.
		spec author: 'JuanPabloSandovalA'.
		spec timestamp: '5/20/2012 23:38'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JPSA.11';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-OB-UI' with: 'Versionner-OB-UI-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-OB-UI-Commands' with: 'Versionner-OB-UI-Commands-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Commands' with: 'Versionner-Morphic-UI-Commands-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Morphic-UI-Widgets' with: 'Versionner-Morphic-UI-Widgets-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Browser' with: 'Versionner-Morphic-UI-Browser-JPSA.10';
			package: 'Versionner-Morphic-Tests' with: 'Versionner-Morphic-Tests-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-OB-Tests' with: 'Versionner-OB-Tests-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalA.10';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalAlcocer 6/30/2012 21:12'!
version130: spec
	<version: '1.30' imports: #('1.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.29 : Fixing minor issue: commit should be unabled when a configuration is not selected.
1.30 : Fixing minor issue: window should be updated when the user commit a project.'.
		spec author: 'JuanPabloSandovalAlcocer'.
		spec timestamp: '6/30/2012 21:12'.
		spec 
			project: 'Metacello ToolBox' with: #'stable';
			project: 'Glamour for Versionner' with: #'stable';
			project: 'Spec for Versionner' with: #'stable'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JuanPabloSandovalAlcocer.13';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.15';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalAlcocer.13';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JuanPabloSandovalAlcocer.18';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'baselines' stamp: 'ChristopheDemarey 8/26/2013 11:47'!
baseline14: spec
	<version: '1.4-baseline'>

	spec for: #common do: [
		spec blessing: #baseline.
		spec repository: 'http://ss3.gemstone.com/ss/Versionner'.	
		spec project: 'Metacello ToolBox' with: [
				spec
					className: 'ConfigurationOfMetacello';
					version: #'stable';
					loads: #('Metacello-ToolBox');
					repository: 'http://seaside.gemstone.com/ss/metacello';
					repository: 'http://www.squeaksource.com/metacello'.].
		spec
			project: 'Spec for Versionner' with: [
				spec
					className: 'ConfigurationOfSpec';
					file: 'ConfigurationOfSpec';
					version:#stable;
					repository: 'http://ss3.gemstone.com/ss/Spec' ].
		spec 
			package: 'Versionner-Core-Model';
			package: 'Versionner-Core-Commands' with:[ spec requires: #('Versionner-Core-Model')];
			package: 'Versionner-Core-Announcements' with:[ spec requires: #('Versionner-Core-Model')];
			package: 'Versionner-Tests-Core-Model' with:[ spec requires: #('Versionner-Core-Model')];
			package: 'Versionner-Tests-Core-Commands' with:[ spec requires: #('Versionner-Core-Model' 'Versionner-Core-Commands')];
			package: 'Versionner-Help';	
			package: 'Versionner-Cache' with:[ spec requires: #('Versionner-Core-Model' 'Versionner-Core-Commands')];
			package: 'Versionner-Spec-Browser' with:[ spec requires: 'Spec for Versionner'];
			package: 'Versionner-Tests-Resources'.

		spec group: 'Core' with: #('Versionner-Core-Model' 'Versionner-Core-Commands' 'Versionner-Core-Announcements' 'Versionner-Cache').
		spec group: 'Spec' with: #('Versionner-Spec-Browser').
		
	spec].! !

!ConfigurationOfVersionner methodsFor: 'accessing' stamp: 'JuanPabloSandovalAlcocer 3/27/2012 11:49'!
project

	^ project ifNil: [ | constructor |
		"Bootstrap Metacello if it is not already loaded"
		(self class baseConfigurationClassIfAbsent: []) ensureMetacello.
		"Construct Metacello project"
		constructor := (Smalltalk at: #MetacelloVersionConstructor) on: self.
		project := constructor project.
		project loadType: #linear. "change to #atomic if desired"
		project ]! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'ChristopheDemarey 2/14/2014 18:15'!
version22: spec
	<version: '2.2' imports: #('2.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.2'.
		spec author: 'ChristopheDemarey'.
		spec timestamp: '2/11/2014 16:24'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-ChristopheDemarey.35';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-ChristopheDemarey.39';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-ChristopheDemarey.5';
			package: 'Versionner-Core-DependenciesModel' with: 'Versionner-Core-DependenciesModel-ChristopheDemarey.67';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-ChristopheDemarey.108';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-ChristopheDemarey.8';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-ChristopheDemarey.13';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-ChristopheDemarey.8';
			package: 'Versionner-Tests-Core-DependenciesModel' with: 'Versionner-Tests-Core-DependenciesModel-ChristopheDemarey.29';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'ChristopheDemarey 8/26/2013 11:45'!
version140: spec
	<version: '1.40' imports: #('1.5-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: ''.
		spec author: 'ChristopheDemarey'.
		spec timestamp: '03/25/2013 16:15'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-ChristopheDemarey.23';
			package: 'Versionner-Core-DependenciesModel' with: 'Versionner-Core-DependenciesModel-ChristopheDemarey.7';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-ChristopheDemarey.19';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-ChristopheDemarey.24';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-ChristopheDemarey.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-ChristopheDemarey.7';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Tests-Core-DependenciesModel' with: 'Versionner-Tests-Core-DependenciesModel-ChristopheDemarey.1';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3'.  ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalA 5/21/2012 00:28'!
version115: spec
	<version: '1.15' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.14 : fixing cache again
1.15 : fixing cache'.
		spec author: 'JuanPabloSandovalA'.
		spec timestamp: '5/21/2012 00:28'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JPSA.11';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-OB-UI' with: 'Versionner-OB-UI-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-OB-UI-Commands' with: 'Versionner-OB-UI-Commands-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Commands' with: 'Versionner-Morphic-UI-Commands-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Morphic-UI-Widgets' with: 'Versionner-Morphic-UI-Widgets-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Browser' with: 'Versionner-Morphic-UI-Browser-JPSA.10';
			package: 'Versionner-Morphic-Tests' with: 'Versionner-Morphic-Tests-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-OB-Tests' with: 'Versionner-OB-Tests-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalA.11';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'baselines' stamp: 'ChristopheDemarey 2/7/2014 14:58'!
baseline22: spec
	<version: '2.2-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec repository: 'http://smalltalkhub.com/mc/demarey/Versionner/main'.
		spec 
			package: 'Versionner-Core-Model';
			package: 'Versionner-Core-Commands' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Core-Announcements' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Core-DependenciesModel' with: [
				spec requires: #('Versionner-Core-Model' 'Versionner-Core-Announcements' ). ];
			package: 'Versionner-Spec-Browser';
			package: 'Versionner-Tests-Resources';
			package: 'Versionner-Tests-Core-Model' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Tests-Core-Commands' with: [
				spec requires: #('Versionner-Core-Model' 'Versionner-Core-Commands' ). ];
			package: 'Versionner-Tests-Core-DependenciesModel' with: [
				spec requires: #('Versionner-Core-DependenciesModel' ). ];
			package: 'Versionner-Help'.
		spec group: 'Core' with: #('Versionner-Core-Model' 'Versionner-Core-DependenciesModel' 'Versionner-Core-Commands' 'Versionner-Core-Announcements' ). ].
! !

!ConfigurationOfVersionner methodsFor: 'baselines' stamp: 'ChristopheDemarey 12/13/2013 13:51'!
baseline20: spec
	<version: '2.0-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec repository: 'http://smalltalkhub.com/mc/demarey/Versionner/main'.
		spec 
			package: 'Versionner-Core-Model';
			package: 'Versionner-Core-Commands' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Core-Announcements' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Core-DependenciesModel' with: [
				spec requires: #('Versionner-Core-Model' 'Versionner-Core-Announcements' ). ];
			package: 'Versionner-Spec-Browser';
			package: 'Versionner-Tests-Resources';
			package: 'Versionner-Tests-Core-Model' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Tests-Core-Commands' with: [
				spec requires: #('Versionner-Core-Model' 'Versionner-Core-Commands' ). ];
			package: 'Versionner-Tests-Core-DependenciesModel' with: [
				spec requires: #('Versionner-Core-DependenciesModel' ). ];
			package: 'Versionner-Help'.
		spec group: 'Core' with: #('Versionner-Core-Model' 'Versionner-Core-DependenciesModel' 'Versionner-Core-Commands' 'Versionner-Core-Announcements' ). ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalA 6/23/2012 01:06'!
version124: spec
	<version: '1.24' imports: #('1.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.24 : adding glamour configuration
1.24 : Configuring Versionner with glamour and spec
1.24 : Configuring stable version'.
		spec author: 'JuanPabloSandovalA'.
		spec timestamp: '6/23/2012 01:06'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JPSA.11';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalA.12';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-JuanPabloSandovalA.4';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JuanPabloSandovalAlcocer.14';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalAlcocer 4/27/2012 20:45'!
version17: spec
	<version: '1.7' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.6 :fixing problem in create configuration

1.7 :  Fixing Issue 15:	Does not show the loaded version'.
		spec author: 'JuanPabloSandovalAlcocer'.
		spec timestamp: '4/27/2012 20:45'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JPSA.11';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-OB-UI' with: 'Versionner-OB-UI-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-OB-UI-Commands' with: 'Versionner-OB-UI-Commands-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Commands' with: 'Versionner-Morphic-UI-Commands-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Morphic-UI-Widgets' with: 'Versionner-Morphic-UI-Widgets-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Browser' with: 'Versionner-Morphic-UI-Browser-JPSA.10';
			package: 'Versionner-Morphic-Tests' with: 'Versionner-Morphic-Tests-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-OB-Tests' with: 'Versionner-OB-Tests-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalAlcocer.7';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'baselines' stamp: 'JuanPabloSandovalAlcocer 6/30/2012 13:18'!
baseline12: spec
	<version: '1.2-baseline'>

	spec for: #common do: [
		spec blessing: #baseline.
		spec repository: 'http://ss3.gemstone.com/ss/Versionner'.	
		spec project: 'Metacello ToolBox' with: [
				spec
					className: 'ConfigurationOfMetacello';
					version: #'stable';
					loads: #('Metacello-ToolBox');
					repository: 'http://seaside.gemstone.com/ss/metacello';
					repository: 'http://www.squeaksource.com/metacello'.].
		spec
			project: 'Glamour for Versionner' with: [
				spec
					className: 'ConfigurationOfGlamour';
					file: 'ConfigurationOfGlamour';
					versionString: #'stable';
					loads: #('Core' 'Morphic');
					repository: 'http://www.squeaksource.com/Glamour'].
		spec
			project: 'Spec for Versionner' with: [
				spec
					className: 'ConfigurationOfSpec';
					file: 'ConfigurationOfSpec';
					version:#stable;
					repository: 'http://ss3.gemstone.com/ss/Spec' ].
		spec 
			package: 'Versionner-Core-Model' with: [ spec requires: 'Metacello ToolBox' ];
			package: 'Versionner-Core-Commands' with:[ spec requires: #('Versionner-Core-Model')];
			package: 'Versionner-Core-Announcements' with:[ spec requires: #('Versionner-Core-Model')];
			package: 'Versionner-Tests-Core-Model' with:[ spec requires: #('Versionner-Core-Model')];
			package: 'Versionner-Tests-Core-Commands' with:[ spec requires: #('Versionner-Core-Model' 'Versionner-Core-Commands')];
			package: 'Versionner-Help';	
			package: 'Versionner-Cache' with:[ spec requires: #('Versionner-Core-Model' 'Versionner-Core-Commands')];
			package: 'Versionner-Spec-Browser' with:[ spec requires: 'Spec for Versionner'];
			package: 'Versionner-GLM-Browser' with:[ spec requires: 'Glamour for Versionner'];
			package: 'Versionner-Tests-Resources'.

		spec group: 'Core' with: #('Versionner-Core-Model' 'Versionner-Core-Commands' 'Versionner-Core-Announcements' 'Versionner-Cache').
		spec group: 'GLM' with: #('Versionner-GLM-Browser').
		spec group: 'Spec' with: #('Versionner-Spec-Browser').
		
	spec].! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JPSA 4/20/2012 21:23'!
version16: spec
	<version: '1.6' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.5 : Fixing configuration commands
1.6 :fixing problem in create configuration
'.
		spec author: 'JPSA'.
		spec timestamp: '4/20/2012 21:23'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JPSA.11';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-OB-UI' with: 'Versionner-OB-UI-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-OB-UI-Commands' with: 'Versionner-OB-UI-Commands-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Commands' with: 'Versionner-Morphic-UI-Commands-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Morphic-UI-Widgets' with: 'Versionner-Morphic-UI-Widgets-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Browser' with: 'Versionner-Morphic-UI-Browser-JPSA.10';
			package: 'Versionner-Morphic-Tests' with: 'Versionner-Morphic-Tests-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-OB-Tests' with: 'Versionner-OB-Tests-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalAlcocer.7';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JPSA.11';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'ChristopheDemarey 3/20/2015 11:45'!
version29: spec
	<version: '2.9' imports: #('2.7-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.9'.
		spec author: 'ChristopheDemarey'.
		spec timestamp: '3/20/2015 11:45'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-ChristopheDemarey.49';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-ChristopheDemarey.53';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-MarcusDenker.11';
			package: 'Versionner-Core-DependenciesModel' with: 'Versionner-Core-DependenciesModel-TheIntegrator.95';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-ChristopheDemarey.173';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-MarcusDenker.14';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-ChristopheDemarey.33';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-TheIntegrator.17';
			package: 'Versionner-Tests-Core-DependenciesModel' with: 'Versionner-Tests-Core-DependenciesModel-MarcusDenker.40'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalA 8/15/2012 17:01'!
version136: spec
	<version: '1.36' imports: #('1.3-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.36 : Fixing refresh and update(button) issues.
1.36 : Fixing refresh and update(button) issues.'.
		spec author: 'JuanPabloSandovalA'.
		spec timestamp: '8/15/2012 17:01'.
		spec 
			project: 'Metacello ToolBox' with: #'stable';
			project: 'Spec for Versionner' with: #'stable'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JuanPabloSandovalA.17';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.16';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalA.6';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalA.3';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalAlcocer.13';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-JuanPabloSandovalA.12';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'ChristopheDemarey 11/27/2013 13:24'!
version15: spec
	<version: '1.5' imports: #('1.5-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: 'version 1.5'.
		spec author: 'ChristopheDemarey'.
		spec timestamp: '11/27/2013 13:24'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-ChristopheDemarey.31';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-ChristopheDemarey.32';
			package: 'Versionner-Core-DependenciesModel' with: 'Versionner-Core-DependenciesModel-ChristopheDemarey.48';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-ChristopheDemarey.5';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-ChristopheDemarey.86';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-ChristopheDemarey.8';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-ChristopheDemarey.10';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-ChristopheDemarey.7';
			package: 'Versionner-Tests-Core-DependenciesModel' with: 'Versionner-Tests-Core-DependenciesModel-ChristopheDemarey.24';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3'. ].
! !

!ConfigurationOfVersionner methodsFor: 'catalog' stamp: 'ChristopheDemarey 2/17/2014 15:17'!
catalogKeywords
	"Returns an array of symbols"
	^ #(project dependencies configuration metacello version) ! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalA 5/18/2012 22:41'!
version110: spec
	<version: '1.10' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.9 : adding magic load in configuration
1.10 : adding a magicLoad :)'.
		spec author: 'JuanPabloSandovalA'.
		spec timestamp: '5/18/2012 22:41'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JPSA.11';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-OB-UI' with: 'Versionner-OB-UI-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-OB-UI-Commands' with: 'Versionner-OB-UI-Commands-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Commands' with: 'Versionner-Morphic-UI-Commands-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Morphic-UI-Widgets' with: 'Versionner-Morphic-UI-Widgets-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Browser' with: 'Versionner-Morphic-UI-Browser-JPSA.10';
			package: 'Versionner-Morphic-Tests' with: 'Versionner-Morphic-Tests-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-OB-Tests' with: 'Versionner-OB-Tests-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalA.9';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalA 5/20/2012 23:31'!
version111: spec
	<version: '1.11' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.10 : adding a magicLoad :)
1.11 : adding dependenci order to caching mechanism'.
		spec author: 'JuanPabloSandovalA'.
		spec timestamp: '5/20/2012 23:31'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JPSA.11';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-OB-UI' with: 'Versionner-OB-UI-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-OB-UI-Commands' with: 'Versionner-OB-UI-Commands-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Commands' with: 'Versionner-Morphic-UI-Commands-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Morphic-UI-Widgets' with: 'Versionner-Morphic-UI-Widgets-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Browser' with: 'Versionner-Morphic-UI-Browser-JPSA.10';
			package: 'Versionner-Morphic-Tests' with: 'Versionner-Morphic-Tests-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-OB-Tests' with: 'Versionner-OB-Tests-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalA.10';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'baselines' stamp: 'JuanPabloSandovalA 6/22/2012 22:31'!
baseline11: spec
	<version: '1.1-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec repository: 'http://ss3.gemstone.com/ss/Versionner'.
		spec 
			package: 'Versionner-Core-Model';
			package: 'Versionner-Core-Commands';
			package: 'Versionner-Core-Announcements';
			package: 'Versionner-Tests-Core-Model';
			package: 'Versionner-OB-UI';
			package: 'Versionner-OB-UI-Commands';
			package: 'Versionner-Tests-Core-Commands';
			package: 'Versionner-Help';
			package: 'Versionner-Morphic-UI-Commands';
			package: 'Versionner-Morphic-UI-Widgets';
			package: 'Versionner-Morphic-UI-Browser';
			package: 'Versionner-Morphic-Tests';
			package: 'Versionner-OB-Tests';			
			package: 'Versionner-Cache';
			package: 'Versionner-Spec-Browser';
			package: 'Versionner-Tests-Resources'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalA 6/13/2012 16:19'!
version122: spec
	<version: '1.22' imports: #('1.1-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.21 : commit spec changes.
1.22 : minor fixes in Versionnner'.
		spec author: 'JuanPabloSandovalA'.
		spec timestamp: '6/13/2012 16:19'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JPSA.11';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-OB-UI' with: 'Versionner-OB-UI-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-OB-UI-Commands' with: 'Versionner-OB-UI-Commands-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Commands' with: 'Versionner-Morphic-UI-Commands-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Morphic-UI-Widgets' with: 'Versionner-Morphic-UI-Widgets-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Browser' with: 'Versionner-Morphic-UI-Browser-JPSA.10';
			package: 'Versionner-Morphic-Tests' with: 'Versionner-Morphic-Tests-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-OB-Tests' with: 'Versionner-OB-Tests-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalA.12';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-JuanPabloSandovalA.3';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalAlcocer 6/30/2012 23:12'!
version132: spec
	<version: '1.32' imports: #('1.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.31 : fixing bug: Update list of configuration and versions after commit,update,load, new.
1.32 : adding comment'.
		spec author: 'JuanPabloSandovalAlcocer'.
		spec timestamp: '6/30/2012 23:12'.
		spec 
			project: 'Metacello ToolBox' with: #'stable';
			project: 'Glamour for Versionner' with: #'stable';
			project: 'Spec for Versionner' with: #'stable'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JuanPabloSandovalAlcocer.14';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.15';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalAlcocer.13';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-JuanPabloSandovalAlcocer.11';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JuanPabloSandovalAlcocer.18';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'catalog' stamp: 'ChristopheDemarey 2/17/2014 15:10'!
catalogChangeLog
	"Returns a paragraph describing the most important changes in the configuration class."
	^ '- 2.3 - current version into the Pharo 3.0 image'! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JPSA 4/18/2012 16:48'!
version10: spec
	<version: '1.0' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.1 :'.
		spec author: 'JPSA'.
		spec timestamp: '4/18/2012 16:48'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-OB-UI' with: 'Versionner-OB-UI-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-OB-UI-Commands' with: 'Versionner-OB-UI-Commands-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalAlcocer.7';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JPSA.5';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Browser' with: 'Versionner-Morphic-UI-Browser-JuanPabloSandovalAlcocer.9';
			package: 'Versionner-Morphic-UI-Commands' with: 'Versionner-Morphic-UI-Commands-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Morphic-UI-Widgets' with: 'Versionner-Morphic-UI-Widgets-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-OB-Tests' with: 'Versionner-OB-Tests-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Morphic-Tests' with: 'Versionner-Morphic-Tests-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalAlcocer 6/30/2012 20:52'!
version127: spec
	<version: '1.27' imports: #('1.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.26 : Fixing spec version issues
1.27 : Fixing update issues, and unregister problem
1.27 : stable version
1.27 : Fixing configuration issues'.
		spec author: 'JuanPabloSandovalAlcocer'.
		spec timestamp: '6/30/2012 20:52'.
		spec 
			project: 'Metacello ToolBox' with: #'stable';
			project: 'Glamour for Versionner' with: #'stable';
			project: 'Spec for Versionner' with: #'stable'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JuanPabloSandovalAlcocer.13';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.15';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalAlcocer.13';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-JuanPabloSandovalAlcocer.7';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JuanPabloSandovalAlcocer.18';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'ChristopheDemarey 2/7/2014 14:58'!
version21: spec
	<version: '2.1' imports: #('2.1-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.1'.
		spec author: 'ChristopheDemarey'.
		spec timestamp: '2/7/2014 14:58'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-ChristopheDemarey.34';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-ChristopheDemarey.38';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-ChristopheDemarey.5';
			package: 'Versionner-Core-DependenciesModel' with: 'Versionner-Core-DependenciesModel-ChristopheDemarey.67';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-ChristopheDemarey.107';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-ChristopheDemarey.8';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-ChristopheDemarey.11';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-ChristopheDemarey.7';
			package: 'Versionner-Tests-Core-DependenciesModel' with: 'Versionner-Tests-Core-DependenciesModel-ChristopheDemarey.29';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalA 5/21/2012 01:11'!
version119: spec
	<version: '1.19' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.18 : adding external load command
1.19 : updating cache'.
		spec author: 'JuanPabloSandovalA'.
		spec timestamp: '5/21/2012 01:11'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JPSA.11';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-OB-UI' with: 'Versionner-OB-UI-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-OB-UI-Commands' with: 'Versionner-OB-UI-Commands-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Commands' with: 'Versionner-Morphic-UI-Commands-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Morphic-UI-Widgets' with: 'Versionner-Morphic-UI-Widgets-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Browser' with: 'Versionner-Morphic-UI-Browser-JPSA.10';
			package: 'Versionner-Morphic-Tests' with: 'Versionner-Morphic-Tests-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-OB-Tests' with: 'Versionner-OB-Tests-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalA.12';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalAlcocer 6/23/2012 01:25'!
version125: spec
	<version: '1.25' imports: #('1.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.24 : Configuring stable version
1.25 : Deleting missing icon it does not exists in Pharo 1.4 :('.
		spec author: 'JuanPabloSandovalAlcocer'.
		spec timestamp: '6/23/2012 01:25'.
		spec 
			project: 'Glamour for Versionner' with: #'stable';
			project: 'Spec for Versionner' with: #'stable'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JPSA.11';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalAlcocer.13';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-JuanPabloSandovalA.4';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JuanPabloSandovalAlcocer.15';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'catalog' stamp: 'ChristopheDemarey 2/17/2014 15:10'!
catalogDescription
	"Returns a paragraph describing the project"
	^ 'Versionner is a tool to manage software dependencies into Pharo.
Versionner can be seen as a GUI on top of Metacello to hide the complexity of ConfigurationOf objetcs.'! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JPSA 4/20/2012 11:07'!
version12: spec
	<version: '1.2' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.1 :
1.2 : Adding a new icon for Load'.
		spec author: 'JPSA'.
		spec timestamp: '4/20/2012 11:07'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-OB-UI' with: 'Versionner-OB-UI-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-OB-UI-Commands' with: 'Versionner-OB-UI-Commands-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Commands' with: 'Versionner-Morphic-UI-Commands-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Morphic-UI-Widgets' with: 'Versionner-Morphic-UI-Widgets-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Browser' with: 'Versionner-Morphic-UI-Browser-JuanPabloSandovalAlcocer.9';
			package: 'Versionner-Morphic-Tests' with: 'Versionner-Morphic-Tests-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-OB-Tests' with: 'Versionner-OB-Tests-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalAlcocer.7';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JPSA.7';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalA 8/15/2012 15:36'!
version135: spec
	<version: '1.35' imports: #('1.3-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.35 : Remove glamour support. Port to Pharo 2.0.
1.35 :
Fixing issues in Pharo 2.0; current test estatus:

62 run, 45 passes, 0 expected failures, 14 failures, 3 errors, 0 unexpected passes
1.35 :
Fixing issues in Pharo 2.0; current test estatus:

62 run, 45 passes, 0 expected failures, 14 failures, 3 errors, 0 unexpected passes'.
		spec author: 'JuanPabloSandovalA'.
		spec timestamp: '8/15/2012 15:36'.
		spec 
			project: 'Metacello ToolBox' with: #'stable';
			project: 'Spec for Versionner' with: #'bleedingEdge'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JuanPabloSandovalA.17';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.16';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalA.6';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalA.3';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalAlcocer.13';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-JuanPabloSandovalAlcocer.11';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JPSA 4/20/2012 11:27'!
version14: spec
	<version: '1.4' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.3 : Changing trigger in the world menu
1.4 : Fixing load option'.
		spec author: 'JPSA'.
		spec timestamp: '4/20/2012 11:27'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-OB-UI' with: 'Versionner-OB-UI-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-OB-UI-Commands' with: 'Versionner-OB-UI-Commands-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Commands' with: 'Versionner-Morphic-UI-Commands-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Morphic-UI-Widgets' with: 'Versionner-Morphic-UI-Widgets-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Browser' with: 'Versionner-Morphic-UI-Browser-JPSA.10';
			package: 'Versionner-Morphic-Tests' with: 'Versionner-Morphic-Tests-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-OB-Tests' with: 'Versionner-OB-Tests-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalAlcocer.7';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JPSA.9';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'symbolic versions' stamp: 'ChristopheDemarey 7/3/2014 10:35'!
development: spec
	<symbolicVersion: #'development'>

	spec for: #'common' version: '2.7-baseline'.
! !

!ConfigurationOfVersionner methodsFor: 'baselines' stamp: 'ChristopheDemarey 2/21/2014 18:33'!
baseline25: spec
	<version: '2.5-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec repository: 'http://smalltalkhub.com/mc/demarey/Versionner/main'.
		spec 
			package: 'Versionner-Core-Model';
			package: 'Versionner-Core-Commands' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Core-Announcements' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Core-DependenciesModel' with: [
				spec requires: #('Versionner-Core-Model' 'Versionner-Core-Announcements' ). ];
			package: 'Versionner-Spec-Browser';
			package: 'Versionner-Tests-Resources';
			package: 'Versionner-Tests-Core-Model' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Tests-Core-Commands' with: [
				spec requires: #('Versionner-Core-Model' 'Versionner-Core-Commands' ). ];
			package: 'Versionner-Tests-Core-DependenciesModel' with: [
				spec requires: #('Versionner-Core-DependenciesModel' ). ].
		spec group: 'Core' with: #('Versionner-Core-Model' 'Versionner-Core-DependenciesModel' 'Versionner-Core-Commands' 'Versionner-Core-Announcements' ). ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalA 8/15/2012 17:01'!
version137: spec
	<version: '1.37' imports: #('1.3-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: ''.
		spec author: 'JuanPabloSandovalA'.
		spec timestamp: '8/15/2012 17:01'.
		spec 
			project: 'Metacello ToolBox' with: #'stable';
			project: 'Spec for Versionner' with: #'stable'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JuanPabloSandovalA.17';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.16';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalA.6';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalA.3';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalAlcocer.13';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-JuanPabloSandovalA.12';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'ChristopheDemarey 2/21/2014 18:33'!
version24: spec
	<version: '2.4' imports: #('2.4-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.4'.
		spec author: 'ChristopheDemarey'.
		spec timestamp: '2/21/2014 18:33'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-ChristopheDemarey.37';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-ChristopheDemarey.43';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-ChristopheDemarey.6';
			package: 'Versionner-Core-DependenciesModel' with: 'Versionner-Core-DependenciesModel-ChristopheDemarey.71';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-ChristopheDemarey.120';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-ChristopheDemarey.9';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-ChristopheDemarey.14';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-ChristopheDemarey.9';
			package: 'Versionner-Tests-Core-DependenciesModel' with: 'Versionner-Tests-Core-DependenciesModel-ChristopheDemarey.30'. ].
! !

!ConfigurationOfVersionner methodsFor: 'baselines' stamp: 'ChristopheDemarey 12/13/2013 14:02'!
baseline21: spec
	<version: '2.1-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec repository: 'http://smalltalkhub.com/mc/demarey/Versionner/main'.
		spec 
			package: 'Versionner-Core-Model';
			package: 'Versionner-Core-Commands' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Core-Announcements' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Core-DependenciesModel' with: [
				spec requires: #('Versionner-Core-Model' 'Versionner-Core-Announcements' ). ];
			package: 'Versionner-Spec-Browser';
			package: 'Versionner-Tests-Resources';
			package: 'Versionner-Tests-Core-Model' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Tests-Core-Commands' with: [
				spec requires: #('Versionner-Core-Model' 'Versionner-Core-Commands' ). ];
			package: 'Versionner-Tests-Core-DependenciesModel' with: [
				spec requires: #('Versionner-Core-DependenciesModel' ). ];
			package: 'Versionner-Help'.
		spec group: 'Core' with: #('Versionner-Core-Model' 'Versionner-Core-DependenciesModel' 'Versionner-Core-Commands' 'Versionner-Core-Announcements' ). ].
! !

!ConfigurationOfVersionner methodsFor: 'baselines' stamp: 'ChristopheDemarey 10/25/2013 19:05'!
baseline15: spec
	<version: '1.5-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec description: 'Implements commit configuration and commit all actions.
Fix the browse version command.
Update ''Save Configuration'' command.
Fix pb in Save config command.
Add a convertor constructor method on MTProject.
Rename the parameter constructor.
Update commands that can be used on a configuration.
Clean up in Version commands.
Commands cleanup #2'.
		spec author: 'ChristopheDemarey'.
		spec timestamp: '10/25/2013 19:05'.
		spec repository: 'http://smalltalkhub.com/mc/demarey/Versionner/main'.
		spec 
			package: 'Versionner-Core-Model';
			package: 'Versionner-Core-Commands' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Core-DependenciesModel' with: [
				spec requires: #('Versionner-Core-Model' 'Versionner-Core-Announcements' ). ];
			package: 'Versionner-Core-Announcements' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Spec-Browser';
			package: 'Versionner-Tests-Resources';
			package: 'Versionner-Tests-Core-Model' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Tests-Core-Commands' with: [
				spec requires: #('Versionner-Core-Model' 'Versionner-Core-Commands' ). ];
			package: 'Versionner-Tests-Core-DependenciesModel' with: [
				spec requires: #('Versionner-Core-DependenciesModel' ). ];
			package: 'Versionner-Help'.
		spec group: 'Core' with: #('Versionner-Core-Model' 'Versionner-Core-DependenciesModel' 'Versionner-Core-Commands' 'Versionner-Core-Announcements' ). ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalA 5/21/2012 01:07'!
version118: spec
	<version: '1.18' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.17 : closing un used inspect.
1.18 : adding external load command'.
		spec author: 'JuanPabloSandovalA'.
		spec timestamp: '5/21/2012 01:07'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JPSA.11';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-OB-UI' with: 'Versionner-OB-UI-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-OB-UI-Commands' with: 'Versionner-OB-UI-Commands-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Commands' with: 'Versionner-Morphic-UI-Commands-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Morphic-UI-Widgets' with: 'Versionner-Morphic-UI-Widgets-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Browser' with: 'Versionner-Morphic-UI-Browser-JPSA.10';
			package: 'Versionner-Morphic-Tests' with: 'Versionner-Morphic-Tests-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-OB-Tests' with: 'Versionner-OB-Tests-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalA.12';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalA 6/22/2012 22:34'!
version123: spec
	<version: '1.23' imports: #('1.1-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.22 : minor fixes in Versionnner'.
		spec author: 'JuanPabloSandovalA'.
		spec timestamp: '6/13/2012 16:20'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JPSA.11';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-OB-UI' with: 'Versionner-OB-UI-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-OB-UI-Commands' with: 'Versionner-OB-UI-Commands-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Commands' with: 'Versionner-Morphic-UI-Commands-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Morphic-UI-Widgets' with: 'Versionner-Morphic-UI-Widgets-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Browser' with: 'Versionner-Morphic-UI-Browser-JPSA.10';
			package: 'Versionner-Morphic-Tests' with: 'Versionner-Morphic-Tests-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-OB-Tests' with: 'Versionner-OB-Tests-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalA.12';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-JuanPabloSandovalA.3';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'baselines' stamp: 'JuanPabloSandovalA 6/22/2012 22:27'!
baseline10: spec
	<version: '1.0-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec repository: 'http://ss3.gemstone.com/ss/Versionner'.
		spec project: 'Glamour' with: [
			spec
					className: 'ConfigurationOfGlamour';
					versionString: #'stable';
					loads: #('Core' 'Morphic');
					repository: 'http://www.squeaksource.com/Glamour'].
		spec
			package: 'Versionner-Core-Model';
			package: 'Versionner-Core-Commands';
			package: 'Versionner-Core-Announcements';
			package: 'Versionner-Tests-Core-Model';
			package: 'Versionner-OB-UI';
			package: 'Versionner-OB-UI-Commands';
			package: 'Versionner-Tests-Core-Commands';
			package: 'Versionner-Help';
			package: 'Versionner-Morphic-UI-Commands';
			package: 'Versionner-Morphic-UI-Widgets';
			package: 'Versionner-Morphic-UI-Browser';
			package: 'Versionner-Morphic-Tests';
			package: 'Versionner-OB-Tests';			
			package: 'Versionner-Cache';
			package: 'Versionner-GLM-Browser';
			package: 'Versionner-Tests-Resources' ].! !

!ConfigurationOfVersionner methodsFor: 'catalog' stamp: 'ChristopheDemarey 2/17/2014 15:17'!
catalogKeyClassesAndExample
	"Returns a paragraph or more describing the key classes of your project. You can use Pillar/Pier syntax to layout out the text i.e., ==Code== and - for bullet."
	^ 'Versionner entry point is the ==VersionnerSpecBrowser== class. Other UI related classes can be found in the Versionner-Spec-Browser package.
Versionner-Core-Commands contains classes implementing the command design pattern and used by the UI.
To ease the navigation into dependencies description, there is a simple depenedency model available in Versionner-Core-DependenciesModel. Versionner-Core-Model contains the legacy model but is still used by some commands.'! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalA 5/18/2012 16:40'!
version18: spec
	<version: '1.8' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.7 :  Fixing Issue 15:	Does not show the loaded version
1.8 : Fixing caching mechanism'.
		spec author: 'JuanPabloSandovalA'.
		spec timestamp: '5/18/2012 16:40'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JPSA.11';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-OB-UI' with: 'Versionner-OB-UI-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-OB-UI-Commands' with: 'Versionner-OB-UI-Commands-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Commands' with: 'Versionner-Morphic-UI-Commands-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Morphic-UI-Widgets' with: 'Versionner-Morphic-UI-Widgets-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Browser' with: 'Versionner-Morphic-UI-Browser-JPSA.10';
			package: 'Versionner-Morphic-Tests' with: 'Versionner-Morphic-Tests-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-OB-Tests' with: 'Versionner-OB-Tests-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalA.8';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'ChristopheDemarey 2/28/2014 18:33'!
version25: spec
	<version: '2.5' imports: #('2.5-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.5'.
		spec author: 'ChristopheDemarey'.
		spec timestamp: '2/28/2014 18:33'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-ChristopheDemarey.37';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-ChristopheDemarey.43';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-ChristopheDemarey.6';
			package: 'Versionner-Core-DependenciesModel' with: 'Versionner-Core-DependenciesModel-ChristopheDemarey.76';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-ChristopheDemarey.129';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-ChristopheDemarey.10';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-ChristopheDemarey.23';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-ChristopheDemarey.9';
			package: 'Versionner-Tests-Core-DependenciesModel' with: 'Versionner-Tests-Core-DependenciesModel-ChristopheDemarey.32'. ].
! !

!ConfigurationOfVersionner methodsFor: 'baselines' stamp: 'ChristopheDemarey 2/11/2014 16:30'!
baseline23: spec
	<version: '2.3-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec repository: 'http://smalltalkhub.com/mc/demarey/Versionner/main'.
		spec 
			package: 'Versionner-Core-Model';
			package: 'Versionner-Core-Commands' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Core-Announcements' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Core-DependenciesModel' with: [
				spec requires: #('Versionner-Core-Model' 'Versionner-Core-Announcements' ). ];
			package: 'Versionner-Spec-Browser';
			package: 'Versionner-Tests-Resources';
			package: 'Versionner-Tests-Core-Model' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Tests-Core-Commands' with: [
				spec requires: #('Versionner-Core-Model' 'Versionner-Core-Commands' ). ];
			package: 'Versionner-Tests-Core-DependenciesModel' with: [
				spec requires: #('Versionner-Core-DependenciesModel' ). ].
		spec group: 'Core' with: #('Versionner-Core-Model' 'Versionner-Core-DependenciesModel' 'Versionner-Core-Commands' 'Versionner-Core-Announcements' ). ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalA 5/21/2012 01:11'!
version120: spec
	<version: '1.20' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.19 : updating cache'.
		spec author: 'JuanPabloSandovalA'.
		spec timestamp: '5/21/2012 01:11'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JPSA.11';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-OB-UI' with: 'Versionner-OB-UI-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-OB-UI-Commands' with: 'Versionner-OB-UI-Commands-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Commands' with: 'Versionner-Morphic-UI-Commands-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Morphic-UI-Widgets' with: 'Versionner-Morphic-UI-Widgets-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Browser' with: 'Versionner-Morphic-UI-Browser-JPSA.10';
			package: 'Versionner-Morphic-Tests' with: 'Versionner-Morphic-Tests-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-OB-Tests' with: 'Versionner-OB-Tests-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalA.12';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JPSA 4/20/2012 11:13'!
version13: spec
	<version: '1.3' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.2 : Adding a new icon for Load
1.3 : Changing trigger in the world menu'.
		spec author: 'JPSA'.
		spec timestamp: '4/20/2012 11:13'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-OB-UI' with: 'Versionner-OB-UI-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-OB-UI-Commands' with: 'Versionner-OB-UI-Commands-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Commands' with: 'Versionner-Morphic-UI-Commands-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Morphic-UI-Widgets' with: 'Versionner-Morphic-UI-Widgets-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Browser' with: 'Versionner-Morphic-UI-Browser-JPSA.10';
			package: 'Versionner-Morphic-Tests' with: 'Versionner-Morphic-Tests-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-OB-Tests' with: 'Versionner-OB-Tests-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalAlcocer.7';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JPSA.8';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalA 5/21/2012 00:46'!
version117: spec
	<version: '1.17' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.16 : last cache fix :P
1.17 : closing un used inspect.'.
		spec author: 'JuanPabloSandovalA'.
		spec timestamp: '5/21/2012 00:46'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JPSA.11';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-OB-UI' with: 'Versionner-OB-UI-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-OB-UI-Commands' with: 'Versionner-OB-UI-Commands-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Commands' with: 'Versionner-Morphic-UI-Commands-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Morphic-UI-Widgets' with: 'Versionner-Morphic-UI-Widgets-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Browser' with: 'Versionner-Morphic-UI-Browser-JPSA.10';
			package: 'Versionner-Morphic-Tests' with: 'Versionner-Morphic-Tests-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-OB-Tests' with: 'Versionner-OB-Tests-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalA.11';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalA 5/20/2012 23:54'!
version114: spec
	<version: '1.14' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.13 : fixing cache of versionner
1.14 : fixing cache again'.
		spec author: 'JuanPabloSandovalA'.
		spec timestamp: '5/20/2012 23:54'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JPSA.11';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-OB-UI' with: 'Versionner-OB-UI-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-OB-UI-Commands' with: 'Versionner-OB-UI-Commands-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Commands' with: 'Versionner-Morphic-UI-Commands-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Morphic-UI-Widgets' with: 'Versionner-Morphic-UI-Widgets-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Browser' with: 'Versionner-Morphic-UI-Browser-JPSA.10';
			package: 'Versionner-Morphic-Tests' with: 'Versionner-Morphic-Tests-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-OB-Tests' with: 'Versionner-OB-Tests-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalA.10';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'ChristopheDemarey 3/19/2015 22:33'!
version28: spec
	<version: '2.8' imports: #('2.7-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.8'.
		spec author: 'ChristopheDemarey'.
		spec timestamp: '3/19/2015 22:33'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-ChristopheDemarey.49';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-ChristopheDemarey.53';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-MarcusDenker.11';
			package: 'Versionner-Core-DependenciesModel' with: 'Versionner-Core-DependenciesModel-TheIntegrator.95';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-ChristopheDemarey.171';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-MarcusDenker.14';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-ChristopheDemarey.33';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-TheIntegrator.17';
			package: 'Versionner-Tests-Core-DependenciesModel' with: 'Versionner-Tests-Core-DependenciesModel-MarcusDenker.40'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalAlcocer 8/2/2012 15:36'!
version134: spec
	<version: '1.34' imports: #('1.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.33 :

Fixing issue 1 committing a config commits twice.

Now when a configuration an initial version (1.0) is created. And the configuration is saved in the repository automatically.'.
		spec author: 'JuanPabloSandovalAlcocer'.
		spec timestamp: '8/2/2012 15:36'.
		spec 
			project: 'Metacello ToolBox' with: #'stable';
			project: 'Glamour for Versionner' with: #'stable';
			project: 'Spec for Versionner' with: #'stable'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JuanPabloSandovalAlcocer.13';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.16';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalAlcocer.13';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-JuanPabloSandovalAlcocer.11';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JuanPabloSandovalAlcocer.18';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'ChristopheDemarey 3/19/2015 15:32'!
version27: spec
	<version: '2.7' imports: #('2.7-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.7'.
		spec author: 'ChristopheDemarey'.
		spec timestamp: '3/19/2015 15:32'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-ChristopheDemarey.49';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-MarcusDenker.49';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-MarcusDenker.11';
			package: 'Versionner-Core-DependenciesModel' with: 'Versionner-Core-DependenciesModel-TheIntegrator.95';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-ChristopheDemarey.169';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-MarcusDenker.14';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-ChristopheDemarey.31';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-TheIntegrator.17';
			package: 'Versionner-Tests-Core-DependenciesModel' with: 'Versionner-Tests-Core-DependenciesModel-MarcusDenker.40'. ].
! !

!ConfigurationOfVersionner methodsFor: 'baselines' stamp: 'ChristopheDemarey 11/27/2013 13:24'!
baseline16: spec
	<version: '1.6-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec repository: 'http://smalltalkhub.com/mc/demarey/Versionner/main'.
		spec 
			package: 'Versionner-Core-Model';
			package: 'Versionner-Core-Commands' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Core-Announcements' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Core-DependenciesModel' with: [
				spec requires: #('Versionner-Core-Model' 'Versionner-Core-Announcements' ). ];
			package: 'Versionner-Spec-Browser';
			package: 'Versionner-Tests-Resources';
			package: 'Versionner-Tests-Core-Model' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Tests-Core-Commands' with: [
				spec requires: #('Versionner-Core-Model' 'Versionner-Core-Commands' ). ];
			package: 'Versionner-Tests-Core-DependenciesModel' with: [
				spec requires: #('Versionner-Core-DependenciesModel' ). ];
			package: 'Versionner-Help'.
		spec group: 'Core' with: #('Versionner-Core-Model' 'Versionner-Core-DependenciesModel' 'Versionner-Core-Commands' 'Versionner-Core-Announcements' ). ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JPSA 4/18/2012 18:03'!
version11: spec
	<version: '1.1' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.1 :
1.1 :'.
		spec author: 'JPSA'.
		spec timestamp: '4/18/2012 18:03'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-OB-UI' with: 'Versionner-OB-UI-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-OB-UI-Commands' with: 'Versionner-OB-UI-Commands-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Commands' with: 'Versionner-Morphic-UI-Commands-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Morphic-UI-Widgets' with: 'Versionner-Morphic-UI-Widgets-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Browser' with: 'Versionner-Morphic-UI-Browser-JuanPabloSandovalAlcocer.9';
			package: 'Versionner-Morphic-Tests' with: 'Versionner-Morphic-Tests-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-OB-Tests' with: 'Versionner-OB-Tests-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalAlcocer.7';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JPSA.6';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'baselines' stamp: 'ChristopheDemarey 2/14/2014 18:12'!
baseline24: spec
	<version: '2.4-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec repository: 'http://smalltalkhub.com/mc/demarey/Versionner/main'.
		spec 
			package: 'Versionner-Core-Model';
			package: 'Versionner-Core-Commands' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Core-Announcements' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Core-DependenciesModel' with: [
				spec requires: #('Versionner-Core-Model' 'Versionner-Core-Announcements' ). ];
			package: 'Versionner-Spec-Browser';
			package: 'Versionner-Tests-Resources';
			package: 'Versionner-Tests-Core-Model' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Tests-Core-Commands' with: [
				spec requires: #('Versionner-Core-Model' 'Versionner-Core-Commands' ). ];
			package: 'Versionner-Tests-Core-DependenciesModel' with: [
				spec requires: #('Versionner-Core-DependenciesModel' ). ].
		spec group: 'Core' with: #('Versionner-Core-Model' 'Versionner-Core-DependenciesModel' 'Versionner-Core-Commands' 'Versionner-Core-Announcements' ). ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalA 6/9/2012 14:48'!
version121: spec
	<version: '1.21' imports: #('1.1-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.20 : adding spec browser
1.21 : commit spec changes.'.
		spec author: 'JuanPabloSandovalA'.
		spec timestamp: '6/9/2012 14:48'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JPSA.11';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-OB-UI' with: 'Versionner-OB-UI-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-OB-UI-Commands' with: 'Versionner-OB-UI-Commands-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Commands' with: 'Versionner-Morphic-UI-Commands-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Morphic-UI-Widgets' with: 'Versionner-Morphic-UI-Widgets-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Browser' with: 'Versionner-Morphic-UI-Browser-JPSA.10';
			package: 'Versionner-Morphic-Tests' with: 'Versionner-Morphic-Tests-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-OB-Tests' with: 'Versionner-OB-Tests-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalA.12';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-JuanPabloSandovalA.2';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalAlcocer 6/30/2012 21:23'!
version131: spec
	<version: '1.31' imports: #('1.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.30 : Fixing minor issue: window should be updated when the user commit a project.
1.31 : fixing bug: Update list of configuration and versions after commit,update,load, new.'.
		spec author: 'JuanPabloSandovalAlcocer'.
		spec timestamp: '6/30/2012 21:23'.
		spec 
			project: 'Metacello ToolBox' with: #'stable';
			project: 'Glamour for Versionner' with: #'stable';
			project: 'Spec for Versionner' with: #'stable'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JuanPabloSandovalAlcocer.13';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.15';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalAlcocer.13';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-JuanPabloSandovalAlcocer.11';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JuanPabloSandovalAlcocer.18';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalA 5/18/2012 22:37'!
version19: spec
	<version: '1.9' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.8 : Fixing caching mechanism
1.9 : adding magic load in configuration'.
		spec author: 'JuanPabloSandovalA'.
		spec timestamp: '5/18/2012 22:37'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JPSA.11';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-OB-UI' with: 'Versionner-OB-UI-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-OB-UI-Commands' with: 'Versionner-OB-UI-Commands-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Commands' with: 'Versionner-Morphic-UI-Commands-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Morphic-UI-Widgets' with: 'Versionner-Morphic-UI-Widgets-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Browser' with: 'Versionner-Morphic-UI-Browser-JPSA.10';
			package: 'Versionner-Morphic-Tests' with: 'Versionner-Morphic-Tests-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-OB-Tests' with: 'Versionner-OB-Tests-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalA.9';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'ChristopheDemarey 12/13/2013 14:02'!
version20: spec
	<version: '2.0' imports: #('2.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: 'version 2.0'.
		spec author: 'ChristopheDemarey'.
		spec timestamp: '12/13/2013 14:02'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-ChristopheDemarey.33';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-ChristopheDemarey.32';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-ChristopheDemarey.5';
			package: 'Versionner-Core-DependenciesModel' with: 'Versionner-Core-DependenciesModel-ChristopheDemarey.63';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-ChristopheDemarey.95';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-ChristopheDemarey.8';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-ChristopheDemarey.10';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-ChristopheDemarey.7';
			package: 'Versionner-Tests-Core-DependenciesModel' with: 'Versionner-Tests-Core-DependenciesModel-ChristopheDemarey.28';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3'. ].
! !

!ConfigurationOfVersionner methodsFor: 'baselines' stamp: 'ChristopheDemarey 7/3/2014 10:35'!
baseline27: spec
	<version: '2.7-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec repository: 'http://smalltalkhub.com/mc/demarey/Versionner/main'.
		spec 
			package: 'Versionner-Core-Model';
			package: 'Versionner-Core-Commands' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Core-Announcements' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Core-DependenciesModel' with: [
				spec requires: #('Versionner-Core-Model' 'Versionner-Core-Announcements' ). ];
			package: 'Versionner-Spec-Browser' with: [
				spec requires: #('Versionner-Core-DependenciesModel' 'Versionner-Core-Commands' 'Versionner-Core-Announcements' ). ];
			package: 'Versionner-Tests-Resources';
			package: 'Versionner-Tests-Core-Model' with: [
				spec requires: #('Versionner-Core-Model' ). ];
			package: 'Versionner-Tests-Core-Commands' with: [
				spec requires: #('Versionner-Core-Model' 'Versionner-Core-Commands' ). ];
			package: 'Versionner-Tests-Core-DependenciesModel' with: [
				spec requires: #('Versionner-Core-DependenciesModel' ). ].
		spec group: 'Core' with: #('Versionner-Core-Model' 'Versionner-Core-DependenciesModel' 'Versionner-Core-Commands' 'Versionner-Core-Announcements' ). ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalAlcocer 6/30/2012 21:00'!
version128: spec
	<version: '1.28' imports: #('1.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.27 : Fixing configuration issues
1.28 : fixing minor bug'.
		spec author: 'JuanPabloSandovalAlcocer'.
		spec timestamp: '6/30/2012 21:00'.
		spec 
			project: 'Metacello ToolBox' with: #'stable';
			project: 'Glamour for Versionner' with: #'stable';
			project: 'Spec for Versionner' with: #'stable'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JuanPabloSandovalAlcocer.13';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.15';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalAlcocer.13';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-JuanPabloSandovalAlcocer.8';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JuanPabloSandovalAlcocer.18';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalA 5/21/2012 00:44'!
version116: spec
	<version: '1.16' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.15 : fixing cache
1.16 : last cache fix :P'.
		spec author: 'JuanPabloSandovalA'.
		spec timestamp: '5/21/2012 00:44'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JPSA.11';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-OB-UI' with: 'Versionner-OB-UI-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-OB-UI-Commands' with: 'Versionner-OB-UI-Commands-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Commands' with: 'Versionner-Morphic-UI-Commands-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Morphic-UI-Widgets' with: 'Versionner-Morphic-UI-Widgets-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Browser' with: 'Versionner-Morphic-UI-Browser-JPSA.10';
			package: 'Versionner-Morphic-Tests' with: 'Versionner-Morphic-Tests-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-OB-Tests' with: 'Versionner-OB-Tests-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalA.11';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'ChristopheDemarey 3/25/2013 16:24'!
version138: spec
	<version: '1.38' imports: #('1.4-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: ''.
		spec author: 'ChristopheDemarey'.
		spec timestamp: '10/28/2012 16:15'.
		spec 
			project: 'Metacello ToolBox' with: #'stable';
			project: 'Spec for Versionner' with: #'stable'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-ChristopheDemarey.20';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-ChristopheDemarey.18';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-ChristopheDemarey.7';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalAlcocer.13';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-ChristopheDemarey.13';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalAlcocer 6/30/2012 20:04'!
version126: spec
	<version: '1.26' imports: #('1.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.25 : Deleting missing icon it does not exists in Pharo 1.4 :(
1.26 : Fixing spec version issues'.
		spec author: 'JuanPabloSandovalAlcocer'.
		spec timestamp: '6/30/2012 20:04'.
		spec 
			project: 'Glamour for Versionner' with: #'stable';
			project: 'Spec for Versionner' with: #'stable'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JuanPabloSandovalAlcocer.13';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.14';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalAlcocer.13';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-JuanPabloSandovalAlcocer.6';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JuanPabloSandovalAlcocer.17';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].

	spec for: #'pharo2.x' do: [
		spec project: 'Glamour for Versionner' with: #'development'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalA 5/20/2012 23:50'!
version113: spec
	<version: '1.13' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.12 : updating cache project
1.13 : fixing cache of versionner'.
		spec author: 'JuanPabloSandovalA'.
		spec timestamp: '5/20/2012 23:50'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JPSA.11';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-OB-UI' with: 'Versionner-OB-UI-JuanPabloSandovalAlcocer.10';
			package: 'Versionner-OB-UI-Commands' with: 'Versionner-OB-UI-Commands-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Commands' with: 'Versionner-Morphic-UI-Commands-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Morphic-UI-Widgets' with: 'Versionner-Morphic-UI-Widgets-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Morphic-UI-Browser' with: 'Versionner-Morphic-UI-Browser-JPSA.10';
			package: 'Versionner-Morphic-Tests' with: 'Versionner-Morphic-Tests-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-OB-Tests' with: 'Versionner-OB-Tests-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalA.10';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JuanPabloSandovalAlcocer.12';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner methodsFor: 'catalog' stamp: 'ChristopheDemarey 2/17/2014 15:08'!
catalogContactInfo
	"Returns a paragraph describing contact information such as email, mailing lists and website."
	^ 'You can find documentation on Versionner here: 
To report a bug, ask for an enhancement, it''s on https://pharo.fogbugz.com. Don"t forget to specify Versionner in the project drop list.'! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'ChristopheDemarey 2/14/2014 18:12'!
version23: spec
	<version: '2.3' imports: #('2.3-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'stable'.
		spec description: 'version 2.3'.
		spec author: 'ChristopheDemarey'.
		spec timestamp: '2/14/2014 18:12'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-ChristopheDemarey.36';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-ChristopheDemarey.40';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-ChristopheDemarey.5';
			package: 'Versionner-Core-DependenciesModel' with: 'Versionner-Core-DependenciesModel-ChristopheDemarey.67';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-ChristopheDemarey.116';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-ChristopheDemarey.8';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-ChristopheDemarey.13';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-ChristopheDemarey.8';
			package: 'Versionner-Tests-Core-DependenciesModel' with: 'Versionner-Tests-Core-DependenciesModel-ChristopheDemarey.29'. ].
! !

!ConfigurationOfVersionner methodsFor: 'versions' stamp: 'JuanPabloSandovalAlcocer 6/30/2012 21:09'!
version129: spec
	<version: '1.29' imports: #('1.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '1.28 : fixing minor bug
1.29 : Fixing minor issue: commit should be unabled when a configuration is not selected.'.
		spec author: 'JuanPabloSandovalAlcocer'.
		spec timestamp: '6/30/2012 21:09'.
		spec 
			project: 'Metacello ToolBox' with: #'stable';
			project: 'Glamour for Versionner' with: #'stable';
			project: 'Spec for Versionner' with: #'stable'.
		spec 
			package: 'Versionner-Core-Model' with: 'Versionner-Core-Model-JuanPabloSandovalAlcocer.13';
			package: 'Versionner-Core-Commands' with: 'Versionner-Core-Commands-JuanPabloSandovalAlcocer.15';
			package: 'Versionner-Core-Announcements' with: 'Versionner-Core-Announcements-JuanPabloSandovalAlcocer.4';
			package: 'Versionner-Tests-Core-Model' with: 'Versionner-Tests-Core-Model-JuanPabloSandovalAlcocer.5';
			package: 'Versionner-Tests-Core-Commands' with: 'Versionner-Tests-Core-Commands-JuanPabloSandovalAlcocer.2';
			package: 'Versionner-Help' with: 'Versionner-Help-JuanPabloSandovalAlcocer.3';
			package: 'Versionner-Cache' with: 'Versionner-Cache-JuanPabloSandovalAlcocer.13';
			package: 'Versionner-Spec-Browser' with: 'Versionner-Spec-Browser-JuanPabloSandovalAlcocer.9';
			package: 'Versionner-GLM-Browser' with: 'Versionner-GLM-Browser-JuanPabloSandovalAlcocer.18';
			package: 'Versionner-Tests-Resources' with: 'Versionner-Tests-Resources-JuanPabloSandovalAlcocer.2'. ].
! !

!ConfigurationOfVersionner class methodsFor: 'loading' stamp: 'JuanPabloSandovalAlcocer 6/30/2012 20:53'!
loadWithSpec
	"Load the #stable version defined for this platform. The #stable version is the version that is recommended to be used on this platform."

	"self load"

	<apiDocumentation>
	^self project stableVersion load:#('Core' 'Spec').! !

!ConfigurationOfVersionner class methodsFor: 'private' stamp: 'JuanPabloSandovalAlcocer 3/27/2012 11:49'!
baseConfigurationClassIfAbsent: aBlock

	^Smalltalk
		at: #MetacelloBaseConfiguration
		ifAbsent: [ 
			self ensureMetacelloBaseConfiguration.
			Smalltalk at: #MetacelloBaseConfiguration ifAbsent: aBlock ].
! !

!ConfigurationOfVersionner class methodsFor: 'development support' stamp: 'JuanPabloSandovalAlcocer 3/27/2012 11:49'!
validate
	"Check the configuration for Errors, Critical Warnings, and Warnings (see class comment for MetacelloMCVersionValidator for more information). 
	Errors identify specification issues that will result in unexpected behaviour when you load the configuration. 
	Critical Warnings identify specification issues that may result in unexpected behavior when you load the configuration.
	Warnings identify specification issues that are technically correct, but are worth take a look at."

	"self validate"

	<apiDocumentation>
	self ensureMetacello.
	^ ((Smalltalk at: #MetacelloToolBox) validateConfiguration: self debug: #() recurse: false) explore! !

!ConfigurationOfVersionner class methodsFor: 'metacello tool support' stamp: 'JuanPabloSandovalAlcocer 3/27/2012 11:49'!
isMetacelloConfig
	"Answer true and the Metacello tools will operate on you"
	
	^true! !

!ConfigurationOfVersionner class methodsFor: 'loading' stamp: 'JuanPabloSandovalAlcocer 3/27/2012 11:49'!
loadBleedingEdge
	"Load the latest versions of the mcz files defined for this project. It is not likely that the #bleedingEdge has been tested."

	"self loadBleedingEdge"

	<apiDocumentation>
	^(self project version: #bleedingEdge) load! !

!ConfigurationOfVersionner class methodsFor: 'private' stamp: 'JuanPabloSandovalAlcocer 3/27/2012 11:49'!
ensureMetacelloBaseConfiguration

	Smalltalk
		at: #MetacelloBaseConfiguration
		ifAbsent: [ 
			| repository version |
			repository := MCHttpRepository location: 'http://seaside.gemstone.com/ss/metacello' user: '' password: ''.
			repository
				versionReaderForFileNamed: 'Metacello-Base-DaleHenrichs.2.mcz'
				do: [ :reader | 
					version := reader version.
					version load.
					version workingCopy repositoryGroup addRepository: repository ] ]! !

!ConfigurationOfVersionner class methodsFor: 'loading' stamp: 'JuanPabloSandovalAlcocer 6/30/2012 23:20'!
load
	"Load the #stable version defined for this platform. The #stable version is the version that is recommended to be used on this platform."

	"self load"

	<apiDocumentation>
	"^(self project version: #stable) load"
	^ self loadWithSpec.! !

!ConfigurationOfVersionner class methodsFor: 'development support' stamp: 'JuanPabloSandovalAlcocer 3/27/2012 11:49'!
DevelopmentSupport

"See the methods in the 'development support' category on the class-side of MetacelloBaseConfiguration. Decide what development support methods you would like to use and copy them the the class-side of your configuration."
	<apiDocumentation>
! !

!ConfigurationOfVersionner class methodsFor: 'accessing' stamp: 'JuanPabloSandovalAlcocer 3/27/2012 11:49'!
project

	^self new project! !

!ConfigurationOfVersionner class methodsFor: 'private' stamp: 'JuanPabloSandovalAlcocer 3/27/2012 11:49'!
ensureMetacello

	(self baseConfigurationClassIfAbsent: []) ensureMetacello! !

!ConfigurationOfVersionner class methodsFor: 'loading' stamp: 'JuanPabloSandovalAlcocer 3/27/2012 11:49'!
loadDevelopment
	"Load the #development version defined for this platform. The #development version will change over time and is not expected to be stable."

	"self loadDevelopment"

	<apiDocumentation>
	^(self project version: #development) load! !

!ConfigurationOfVersionnerTestBitmapCharacterSet commentStamp: '<historical>'!
Simple Configuration class used to test Versionner behavior.
This class is a rename of ConfigurationOfVersionnerTestBitmapCharacterSet-StephaneDucasse.2.

!
!ConfigurationOfVersionnerTestBitmapCharacterSet methodsFor: 'baselines' stamp: 'ChristopheDemarey 6/7/2013 14:19'!
baseline100: spec 
	<version: '1.0-baseline'>
	
	spec for: #common do: [
		spec blessing: #baseline.
		spec repository: 'http://smalltalkhub.com/mc/PharoExtras/BitmapCharacterSet/main'.	
		spec description: 'Imported from SqueakSource'.
		spec package: 'Collections-BitmapCharacterSet'.
		spec 
			package: 'Collections-Tests-BitmapCharacterSet' 
			with: [spec requires: 'Collections-BitmapCharacterSet'].
			
		spec
			group: 'default' with: #('Core');
			group: 'Core' with: #('Collections-BitmapCharacterSet');
			group: 'Tests' with: #('Collections-Tests-BitmapCharacterSet'). ].! !

!ConfigurationOfVersionnerTestBitmapCharacterSet methodsFor: 'accessing' stamp: 'ChristopheDemarey 5/24/2013 10:29'!
project

	^ project ifNil: [ | constructor |
		"Bootstrap Metacello if it is not already loaded"
		self class ensureMetacello.
		"Construct Metacello project"
		constructor := (Smalltalk at: #MetacelloVersionConstructor) on: self.
		project := constructor project.
		project loadType: #linear. "change to #atomic if desired"
		project ]! !

!ConfigurationOfVersionnerTestBitmapCharacterSet methodsFor: 'symbolic versions' stamp: 'ChristopheDemarey 5/24/2013 10:29'!
stable: spec
	<symbolicVersion: #'stable'>

	spec for: #'common' version: '1.0'.
	! !

!ConfigurationOfVersionnerTestBitmapCharacterSet methodsFor: 'symbolic versions' stamp: 'ChristopheDemarey 5/24/2013 10:28'!
development: spec
	<symbolicVersion: #'development'>

	spec for: #'common' version: '1.0'
! !

!ConfigurationOfVersionnerTestBitmapCharacterSet methodsFor: 'versions' stamp: 'ChristopheDemarey 6/7/2013 14:39'!
version100: spec 
	<version: '1.0' imports: #('1.0-baseline') >
	
	spec for: #common do: [
		spec blessing: #release.
		spec description: 'Latest versions from Squeaksource'.
		
		spec package: 'Collections-BitmapCharacterSet' with: ' Collections-BitmapCharacterSet-JAA.5'.
		spec package: 'Collections-Tests-BitmapCharacterSet' with: 'Collections-Tests-BitmapCharacterSet-JAA.5'
		]
	

! !

!ConfigurationOfVersionnerTestBitmapCharacterSet class methodsFor: 'unloading Metacello' stamp: 'ChristopheDemarey 3/27/2013 16:55'!
unloadMetacello

	Smalltalk at: #ConfigurationOfMetacello ifPresent: [:cls | cls unloadMetacello ]! !

!ConfigurationOfVersionnerTestBitmapCharacterSet class methodsFor: 'metacello tool support' stamp: 'ChristopheDemarey 3/27/2013 16:55'!
isMetacelloConfig
	"Answer true and the Metacello tools will operate on you"
	
	^true! !

!ConfigurationOfVersionnerTestBitmapCharacterSet class methodsFor: 'metacello tool support' stamp: 'ChristopheDemarey 3/27/2013 16:55'!
metacelloVersion: versionString loads: anArrayOrString
	"Stash the last version loaded and the list of packages loaded for that version. The list
	 of packages will be used by the tools when doing 'Load Package Version'"

	LastVersionLoad := versionString -> anArrayOrString! !

!ConfigurationOfVersionnerTestBitmapCharacterSet class methodsFor: 'metacello tool support' stamp: 'ChristopheDemarey 3/27/2013 16:55'!
lastMetacelloVersionLoad
	"Answer the last version loaded and the list of packages loaded for that version."

	LastVersionLoad == nil ifTrue: [ LastVersionLoad := nil -> 'default' ].
	^LastVersionLoad! !

!ConfigurationOfVersionnerTestBitmapCharacterSet class methodsFor: 'loading' stamp: 'ChristopheDemarey 3/27/2013 16:55'!
loadMostRecentCoreWithTests
	^self project lastVersion load: #('Core' 'Tests')! !

!ConfigurationOfVersionnerTestBitmapCharacterSet class methodsFor: 'loading' stamp: 'ChristopheDemarey 3/27/2013 16:55'!
load
	"self load"

	^self project latestVersion load! !

!ConfigurationOfVersionnerTestBitmapCharacterSet class methodsFor: 'accessing' stamp: 'ChristopheDemarey 3/27/2013 16:55'!
project

	^self new project! !

!ConfigurationOfVersionnerTestBitmapCharacterSet class methodsFor: 'private' stamp: 'ChristopheDemarey 3/27/2013 16:55'!
ensureMetacello
	"Bootstrap Gofer (if necessary), bootstrap ConfigurationOfMetacello (using old Gofer API), then load the latest 
	version of Metacello itself."

	Smalltalk at: #MetacelloProject ifAbsent: [
		Smalltalk at: #Gofer ifAbsent: [
			"Current version of Gofer from which to bootstrap - as of 1.0-beta.21"
			self bootstrapPackage: 'Gofer-Core-lr.115' from: 'http://seaside.gemstone.com/ss/metacello' ].
		Smalltalk at: #Gofer ifPresent: [:goferClass | | gofer |
			gofer := goferClass new
				url: 'http://seaside.gemstone.com/ss/metacello';
				yourself.
			[ gofer addPackage: 'ConfigurationOfMetacello' ] on: Warning do: [:ex | ex resume ].
			gofer load ].
		"load 'default' group of Metacello"
		(Smalltalk at: #ConfigurationOfMetacello) perform: #load ]! !

!ConfigurationOfVersionnerTestBitmapCharacterSet class methodsFor: 'private' stamp: 'ChristopheDemarey 3/27/2013 16:55'!
bootstrapPackage: aString from: aPath 
	| repository version |
	repository := MCHttpRepository
				location: aPath
				user: ''
				password: ''.
	repository
		versionReaderForFileNamed: aString , '.mcz'
		do: [:reader | 
			version := reader version.
			version load.
			version workingCopy repositoryGroup addRepository: repository]! !

!ConfigurationOfVersionnerTestBitmapCharacterSet class methodsFor: 'loading' stamp: 'ChristopheDemarey 3/27/2013 16:55'!
loadDefault
	"self loadDefault"

	^ self loadMostRecentCoreWithTests! !

!ConfigurationOfVersionnerTestXMLParserTemplate commentStamp: '<historical>'!
Simple Configuration class used to test Versionner behavior.
This class is a rename of ConfigurationOfXMLParser-StephaneDucasse.11.
!
!ConfigurationOfVersionnerTestXMLParserTemplate methodsFor: 'baselines' stamp: 'ChristopheDemarey 6/7/2013 13:57'!
baseline10: spec
	<version: '1.0-baseline'>
	spec
		for: #common
		do: [ 
			spec
				blessing: #baseline;
				description: 'Copy of ConfigurationOfXMLParser used with Versionner tests.';
				author: 'ChristopheDemarey';
				timestamp: '27/03/2013';
				repository: 'http://www.smalltalkhub.com/mc/PharoExtras/XMLParser/main'.

			spec project: 'XMLWriter'
					with: [ spec 
								className: 'ConfigurationOfVersionnerTestXMLWriter';
								versionString: #stable;
								file: 'Versionner-Tests-Resources';
								repository: 'http://www.smalltalkhub.com/mc/demarey/Versionner/main'.].

			spec project: 'BitmapCharacterSet'
					with: [ spec 
								className: 'ConfigurationOfVersionnerTestBitmapCharacterSet';
								versionString: #stable;
								file: 'Versionner-Tests-Resources';
								repository: 'http://www.smalltalkhub.com/mc/demarey/Versionner/main'.].
			
			spec 
				package: 'VersionnerTestXML-Parser' 
				with: [spec 
						requires: #('BitmapCharacterSet' 'XMLWriter')].	
			spec package: 'VersionnerTestXML-Tests-Parser'
					with: [ spec requires: 'VersionnerTestXML-Parser' ].
			
			spec
				group: 'default' with: #('Core' 'Tests');
				"default by default is equivalent to loading 'ALL' the packages still we added explicitly Tests to be loaded"
				group: 'Core' with: #('VersionnerTestXML-Parser');
				group: 'Tests' with: #('VersionnerTestXML-Tests-Parser') ].
! !

!ConfigurationOfVersionnerTestXMLParserTemplate methodsFor: 'baselines' stamp: 'ChristopheDemarey 2/25/2014 15:20'!
baseline20: spec
	<version: '2.0-baseline'>
	spec
		for: #common
		do: [ 
			spec
				blessing: #baseline;
				description: 'New baseline to test use of baselines in numbered versions';
				author: 'ChristopheDemarey';
				timestamp: '25/02/2014';
				repository: 'http://www.smalltalkhub.com/mc/PharoExtras/XMLParser/main'.

			spec project: 'XMLWriter'
					with: [ spec 
								className: 'ConfigurationOfVersionnerTestXMLWriter';
								versionString: #stable;
								file: 'Versionner-Tests-Resources';
								repository: 'http://www.smalltalkhub.com/mc/demarey/Versionner/main'.].

			spec project: 'BitmapCharacterSet'
					with: [ spec 
								className: 'ConfigurationOfVersionnerTestBitmapCharacterSet';
								versionString: #stable;
								file: 'Versionner-Tests-Resources';
								repository: 'http://www.smalltalkhub.com/mc/demarey/Versionner/main'.].
			
			spec 
				package: 'VersionnerTestXML-Parser' 
				with: [spec 
						requires: #('BitmapCharacterSet' 'XMLWriter')].	
			spec package: 'VersionnerTestXML-Tests-Parser'
					with: [ spec requires: 'VersionnerTestXML-Parser' ].
			
			spec
				group: 'default' with: #('Core' 'Tests');
				"default by default is equivalent to loading 'ALL' the packages still we added explicitly Tests to be loaded"
				group: 'Core' with: #('VersionnerTestXML-Parser');
				group: 'Tests' with: #('VersionnerTestXML-Tests-Parser') ].
! !

!ConfigurationOfVersionnerTestXMLParserTemplate methodsFor: 'symbolic versions' stamp: 'ChristopheDemarey 3/27/2013 16:28'!
stable: spec
	<symbolicVersion: #'stable'>

	spec for: #'common' version: '1.1'.
	! !

!ConfigurationOfVersionnerTestXMLParserTemplate methodsFor: 'versions' stamp: 'ChristopheDemarey 6/7/2013 14:03'!
version101: spec
	<version: '1.1' imports: #('1.0-baseline')>
	spec
		for: #common
		do: [ 
			spec blessing: #release.
			spec
				package: 'VersionnerTestXML-Parser' with: 'VersionnerTestXML-Parser-StephaneDucasse.142';
				package: 'VersionnerTestXML-Tests-Parser' with: 'VersionnerTestXML-Tests-Parser-StephaneDucasse.15'. ].
	
	! !

!ConfigurationOfVersionnerTestXMLParserTemplate methodsFor: 'versions' stamp: 'ChristopheDemarey 6/6/2013 12:58'!
version100: spec
	<version: '1.0' imports: #('1.0-baseline')>
	spec
		for: #common
		do: [ 
			spec blessing: #release.
			spec
				package: 'VersionnerTestXML-Parser' with: 'XML-Parser-NorbertHartl.141';
				package: 'VersionnerTestXML-Tests-Parser' with: 'XML-Tests-Parser-JAA.14' 
				].
	
	! !

!ConfigurationOfVersionnerTestXMLParserTemplate methodsFor: 'symbolic versions' stamp: 'ChristopheDemarey 3/27/2013 16:28'!
development: spec
	<symbolicVersion: #'development'>

	spec for: #'common' version: '1.1'.
	! !

!ConfigurationOfVersionnerTestXMLParserTemplate methodsFor: 'accessing' stamp: 'ChristopheDemarey 3/27/2013 16:28'!
project

	^ project ifNil: [ | constructor |
		"Bootstrap Metacello if it is not already loaded"
		self class ensureMetacello.
		"Construct Metacello project"
		constructor := (Smalltalk at: #MetacelloVersionConstructor) on: self.
		project := constructor project.
		project loadType: #linear. "change to #atomic if desired"
		project ]! !

!ConfigurationOfVersionnerTestXMLParserTemplate class methodsFor: 'unloading Metacello' stamp: 'ChristopheDemarey 5/24/2013 10:32'!
unloadMetacello

	Smalltalk at: #ConfigurationOfMetacello ifPresent: [:cls | cls unloadMetacello ]! !

!ConfigurationOfVersionnerTestXMLParserTemplate class methodsFor: 'testing' stamp: 'ChristopheDemarey 5/24/2013 10:31'!
isMetacelloConfig
	"Answer true and the Metacello tools will operate on you"
	
	^true! !

!ConfigurationOfVersionnerTestXMLParserTemplate class methodsFor: 'metacello tool support' stamp: 'ChristopheDemarey 5/24/2013 10:32'!
metacelloVersion: versionString loads: anArrayOrString
	"Stash the last version loaded and the list of packages loaded for that version. The list
	 of packages will be used by the tools when doing 'Load Package Version'"

	LastVersionLoad := versionString -> anArrayOrString! !

!ConfigurationOfVersionnerTestXMLParserTemplate class methodsFor: 'metacello tool support' stamp: 'ChristopheDemarey 5/24/2013 10:31'!
lastMetacelloVersionLoad
	"Answer the last version loaded and the list of packages loaded for that version."

	LastVersionLoad == nil ifTrue: [ LastVersionLoad := nil -> 'default' ].
	^LastVersionLoad! !

!ConfigurationOfVersionnerTestXMLParserTemplate class methodsFor: 'loading' stamp: 'ChristopheDemarey 5/24/2013 10:31'!
loadMostRecentCoreWithTests
	^self project lastVersion load: #('Core' 'Tests')! !

!ConfigurationOfVersionnerTestXMLParserTemplate class methodsFor: 'loading' stamp: 'ChristopheDemarey 5/24/2013 10:31'!
load
	"self load"

	^self project latestVersion load! !

!ConfigurationOfVersionnerTestXMLParserTemplate class methodsFor: 'accessing' stamp: 'ChristopheDemarey 5/24/2013 10:32'!
project

	^self new project! !

!ConfigurationOfVersionnerTestXMLParserTemplate class methodsFor: 'private' stamp: 'ChristopheDemarey 5/24/2013 10:31'!
ensureMetacello
	"Bootstrap Gofer (if necessary), bootstrap ConfigurationOfMetacello (using old Gofer API), then load the latest 
	version of Metacello itself."

	Smalltalk at: #MetacelloProject ifAbsent: [
		Smalltalk at: #Gofer ifAbsent: [
			"Current version of Gofer from which to bootstrap - as of 1.0-beta.21"
			self bootstrapPackage: 'Gofer-Core-lr.115' from: 'http://seaside.gemstone.com/ss/metacello' ].
		Smalltalk at: #Gofer ifPresent: [:goferClass | | gofer |
			gofer := goferClass new
				url: 'http://seaside.gemstone.com/ss/metacello';
				yourself.
			[ gofer addPackage: 'ConfigurationOfMetacello' ] on: Warning do: [:ex | ex resume ].
			gofer load ].
		"load 'default' group of Metacello"
		(Smalltalk at: #ConfigurationOfMetacello) perform: #load ]! !

!ConfigurationOfVersionnerTestXMLParserTemplate class methodsFor: 'private' stamp: 'ChristopheDemarey 5/24/2013 10:31'!
bootstrapPackage: aString from: aPath 
	| repository version |
	repository := MCHttpRepository
				location: aPath
				user: ''
				password: ''.
	repository
		versionReaderForFileNamed: aString , '.mcz'
		do: [:reader | 
			version := reader version.
			version load.
			version workingCopy repositoryGroup addRepository: repository]! !

!ConfigurationOfVersionnerTestXMLParserTemplate class methodsFor: 'loading' stamp: 'ChristopheDemarey 5/24/2013 10:31'!
loadDefault
	"self loadDefault"

	^ self loadMostRecentCoreWithTests! !

!ConfigurationOfVersionnerTestXMLWriter commentStamp: '<historical>'!
Simple Configuration class used to test Versionner behavior.
This class is a rename of ConfigurationOfXMLWriter-StephaneDucasse.29.
!
!ConfigurationOfVersionnerTestXMLWriter methodsFor: 'baselines' stamp: 'ChristopheDemarey 3/27/2013 16:51'!
baseline101: spec 
	<version: '1.0.1-baseline'>
	
	spec for: #common do: [
		spec
			blessing: #baseline;
			repository: 'http://www.squeaksource.com/XMLWriter'.

		spec
			package: 'Collections-OrderPreservingDictionary' with: [
				spec repository: 'http://www.squeaksource.com/OrderPreservingDict'];
			package: 'Collections-CharacterMap' with: [
				spec repository: 'http://www.squeaksource.com/CharacterMap'];
			package: 'XML-Writer' with: [
				spec requires: #('Collections-OrderPreservingDictionary' 'Collections-CharacterMap')].

		spec
			group: 'default' with: #('Core');
			group: 'Core' with: #('XML-Writer')].! !

!ConfigurationOfVersionnerTestXMLWriter methodsFor: 'baselines' stamp: 'ChristopheDemarey 3/27/2013 16:51'!
baseline200: spec
	<version: '2.0.0-baseline'>

	spec for: #common do: [ 
		spec
			blessing: #baseline;
			description: 'Migrated to SmalltalkHub and taking into account new configurations of subcomponents';
			repository: 'http://smalltalkhub.com/mc/Pharo/XMLWriter/main'.
				
		"Does not work without a className: specification
		
		spec project: 'OrderPreservingDictionary' with: [
			spec 
				versionString: #stable; 
				loads: #('Core'); 
				repository: 'http://smalltalkhub.com/mc/Pharo/OrderPreservingDictionary/main'].
		spec package: 'XML-Writer' with: [ spec requires: #('OrderPreservingDictionary') ]."
			
		spec project: 'OrderPreservingDictionary' with: [
			spec 
				className: 'ConfigurationOfOrderPreservingDictionary';
				versionString: #stable; 
				loads: #('Core'); 
				repository: 'http://smalltalkhub.com/mc/Pharo/OrderPreservingDictionary/main'].	
				
		spec package: 'XML-Writer' with: [spec requires: 'OrderPreservingDictionary']. 
			
		spec
			group: 'default' with: #('Core');
			group: 'Core' with: #('XML-Writer');
			group: 'Tests' with: #() ].
	
	
	
	"I removed it because it loads an old version of the pckage and this is a nonsense"	
	spec for: #squeakCommon do: [ 
		spec package: 'Collections-Support' with: [ 
			spec repository: 'http://ss3.gemstone.com/ss/Pharo20' ] ].
	
	
	
	
	spec for: #gemstone do: [ 
		spec
			package: 'Collections-Support' with: [ 
				spec
					file: 'Collections-Support.g';
					repository: 'http://seaside.gemstone.com/ss/XMLSupport' ];
			package: 'Collections-Tests-Support' with: [ 
				spec
					file: 'Collections-Tests-Support.g';
					requires: 'Collections-Support';
					repository: 'http://seaside.gemstone.com/ss/XMLSupport' ].
		spec
			group: 'Tests' with: #('Collections-Tests-Support') ]! !

!ConfigurationOfVersionnerTestXMLWriter methodsFor: 'symbolic' stamp: 'ChristopheDemarey 3/27/2013 16:51'!
stable: spec
	<symbolicVersion: #'stable'>
	
	spec for: #'pharo' version: '2.1.0'.
! !

!ConfigurationOfVersionnerTestXMLWriter methodsFor: 'versions' stamp: 'ChristopheDemarey 3/27/2013 16:51'!
version102: spec 
	<version: '1.0.2' imports: #('1.0.1-baseline') >
	
	spec for: #common do: [
		spec blessing: #release.

		spec
			package: 'Collections-OrderPreservingDictionary'
			with: 'Collections-OrderPreservingDictionary-JAAyer.1';
			package: 'Collections-CharacterMap' with: 'Collections-CharacterMap-JAAyer.1';
			package: 'XML-Writer' with: 'XML-Writer-JAAyer.3'].! !

!ConfigurationOfVersionnerTestXMLWriter methodsFor: 'baselines' stamp: 'ChristopheDemarey 3/27/2013 16:51'!
baseline104: spec 
	<version: '1.0.4-baseline'>
	
	spec for: #common do: [
		spec
			blessing: #baseline;
			repository: 'http://www.squeaksource.com/XMLWriter'.

		spec
			package: 'Collections-OrderPreservingDictionary' with: [
				spec repository: 'http://www.squeaksource.com/OrderPreservingDict'];
			package: 'XML-Writer' with: [
				spec requires: #('Collections-OrderPreservingDictionary')].

		spec
			group: 'default' with: #('Core');
			group: 'Core' with: #('XML-Writer')].
		
	spec for: #gemstone do: [
		spec
			package: 'Collections-CharacterSet'.
		spec 
			package: 'XML-Writer' with:[spec requires: #('Collections-CharacterSet')]]! !

!ConfigurationOfVersionnerTestXMLWriter methodsFor: 'symbolic' stamp: 'ChristopheDemarey 3/27/2013 16:51'!
development: spec
	<symbolicVersion: #'development'>
	
	spec for: #'pharo' version: '2.1.0'.
! !

!ConfigurationOfVersionnerTestXMLWriter methodsFor: 'versions' stamp: 'ChristopheDemarey 3/27/2013 16:51'!
version100: spec 
	<version: '1.0' imports: #('1.0-baseline') >
	
	spec for: #common do: [
		spec blessing: #release.

		spec
			package: 'Collections-CharacterMap' with: 'Collections-CharacterMap-JAAyer.1';
			package: 'XML-Writer' with: 'XML-Writer-JAAyer.1'].! !

!ConfigurationOfVersionnerTestXMLWriter methodsFor: 'versions' stamp: 'ChristopheDemarey 3/27/2013 16:51'!
version103: spec 
	<version: '1.0.3' imports: #('1.0.1-baseline') >
	
	spec for: #common do: [
		spec blessing: #release.

		spec
			package: 'Collections-OrderPreservingDictionary'
			with: 'Collections-OrderPreservingDictionary-JAAyer.5';
			package: 'Collections-CharacterMap' with: 'Collections-CharacterMap-JAAyer.1';
			package: 'XML-Writer' with: 'XML-Writer-JAAyer.4'].! !

!ConfigurationOfVersionnerTestXMLWriter methodsFor: 'baselines' stamp: 'ChristopheDemarey 3/27/2013 16:51'!
baseline100: spec 
	<version: '1.0-baseline'>
	
	spec for: #common do: [
		spec
			blessing: #baseline;
			repository: 'http://www.squeaksource.com/XMLWriter'.

		spec 
			package: 'Collections-CharacterMap' with: [
				spec repository: 'http://www.squeaksource.com/CharacterMap'];
			package: 'XML-Writer' with: [spec requires: 'Collections-CharacterMap'].

		spec
			group: 'default' with: #('Core');
			group: 'Core' with: #('XML-Writer');
			group: 'Tests' with: #()].! !

!ConfigurationOfVersionnerTestXMLWriter methodsFor: 'accessing' stamp: 'ChristopheDemarey 3/27/2013 16:51'!
project

	^ project ifNil: [ | constructor |
		"Bootstrap Metacello if it is not already loaded"
		self class ensureMetacello.
		"Construct Metacello project"
		constructor := (Smalltalk at: #MetacelloVersionConstructor) on: self.
		project := constructor project.
		project loadType: #linear. "change to #atomic if desired"
		project ]! !

!ConfigurationOfVersionnerTestXMLWriter methodsFor: 'versions' stamp: 'ChristopheDemarey 3/27/2013 16:51'!
version104: spec 
	<version: '1.0.4' imports: #('1.0.4-baseline') >
	
	spec for: #common do: [
		spec blessing: #release.

		spec
			package: 'Collections-OrderPreservingDictionary'
			with: 'Collections-OrderPreservingDictionary-JAAyer.6';
			package: 'XML-Writer' with: 'XML-Writer-JAAyer.5'].

	spec for: #gemstone do: [
		spec 
			package: 'Collections-CharacterSet' with: 'Collections-CharacterSet-JohanBrichau.1']! !

!ConfigurationOfVersionnerTestXMLWriter methodsFor: 'versions' stamp: 'ChristopheDemarey 3/27/2013 16:51'!
version101: spec 
	<version: '1.0.1' imports: #('1.0.1-baseline') >
	
	spec for: #common do: [
		spec blessing: #release.

		spec
			package: 'Collections-OrderPreservingDictionary'
			with: 'Collections-OrderPreservingDictionary-JAAyer.1';
			package: 'Collections-CharacterMap' with: 'Collections-CharacterMap-JAAyer.1';
			package: 'XML-Writer' with: 'XML-Writer-JAAyer.2'].! !

!ConfigurationOfVersionnerTestXMLWriter methodsFor: 'baselines' stamp: 'ChristopheDemarey 3/27/2013 16:51'!
baseline210: spec
	<version: '2.1.0-baseline'>

	spec for: #common do: [ 
		spec
			blessing: #baseline;
			description: 'Adding a test package';
			repository: 'http://smalltalkhub.com/mc/Pharo/XMLWriter/main'.
				
		spec project: 'OrderPreservingDictionary' with: [
			spec 
				className: 'ConfigurationOfOrderPreservingDictionary';
				versionString: #stable; 
				loads: #('Core'); 
				repository: 'http://smalltalkhub.com/mc/Pharo/OrderPreservingDictionary/main'].	
				
		spec package: 'XML-Writer-Core' with: [spec requires: 'OrderPreservingDictionary']. 
		spec package: 'XML-Writer-Tests' with: [spec requires: 'XML-Writer-Core']. 
		
		spec
			group: 'default' with: #('Core');
			group: 'Core' with: #('XML-Writer-Core');
			group: 'Tests' with: #('XML-Writer-Tests')].
	
	
	"Can only work for Pharo1.4 and 2.0.
	To be changed when pharo will be managed on SmalltalkHub"
		
	spec for: #squeakCommon do: [ 
		spec package: 'Collections-Support' with: [ 
			spec repository: 'http://ss3.gemstone.com/ss/Pharo20' ] ].
	
	
	"I did not touch this part because Ido not know it. On Pharo XMLWriter has its own repository"
	spec for: #gemstone do: [ 
		spec
			package: 'Collections-Support' with: [ 
				spec
					file: 'Collections-Support.g';
					repository: 'http://seaside.gemstone.com/ss/XMLSupport' ];
			package: 'Collections-Tests-Support' with: [ 
				spec
					file: 'Collections-Tests-Support.g';
					requires: 'Collections-Support';
					repository: 'http://seaside.gemstone.com/ss/XMLSupport' ].
		spec
			group: 'Tests' with: #('Collections-Tests-Support') ]! !

!ConfigurationOfVersionnerTestXMLWriter methodsFor: 'versions' stamp: 'ChristopheDemarey 3/27/2013 16:51'!
version105: spec
	<version: '1.0.5' imports: #('1.0.5-baseline')>
	spec
		for: #common
			do: [ 
					spec
						blessing: #release;
						package: 'Collections-OrderPreservingDictionary' with: 'Collections-OrderPreservingDictionary-JAAyer.6';
						package: 'XML-Writer' with: 'XML-Writer-JAAyer.5' ];
		for: #squeakCommon do: [ spec package: 'Collections-Support' with: 'Collections-Support-StephaneDucasse.35' ];
		for: #gemstone
			do: [ 
					spec
						package: 'Collections-Support' with: 'Collections-Support.g-OttoBehrens.45';
						package: 'Collections-Tests-Support' with: 'Collections-Tests-Support.g-OttoBehrens.3' ]! !

!ConfigurationOfVersionnerTestXMLWriter methodsFor: 'baselines' stamp: 'ChristopheDemarey 3/27/2013 16:51'!
baseline105: spec
	<version: '1.0.5-baseline'>
	spec for: #common do: [ 
		spec
			blessing: #baseline;
			repository: 'http://www.squeaksource.com/XMLWriter'.
		spec
			package: 'Collections-OrderPreservingDictionary' with: [ 
				spec repository: 'http://www.squeaksource.com/OrderPreservingDict' ];
			package: 'Collections-Support';
			package: 'XML-Writer' with: [ 
				spec requires: #('Collections-Support' 'Collections-OrderPreservingDictionary') ].
		spec
			group: 'default' with: #('Core');
			group: 'Core' with: #('XML-Writer');
			group: 'Tests' with: #() ].
		
	spec for: #squeakCommon do: [ 
		spec package: 'Collections-Support' with: [ 
			spec repository: 'http://www.squeaksource.com/Pharo' ] ].
	
	spec for: #gemstone do: [ 
		spec
			package: 'Collections-Support' with: [ 
				spec
					file: 'Collections-Support.g';
					repository: 'http://seaside.gemstone.com/ss/XMLSupport' ];
			package: 'Collections-Tests-Support' with: [ 
				spec
					file: 'Collections-Tests-Support.g';
					requires: 'Collections-Support';
					repository: 'http://seaside.gemstone.com/ss/XMLSupport' ].
		spec
			group: 'Tests' with: #('Collections-Tests-Support') ]! !

!ConfigurationOfVersionnerTestXMLWriter methodsFor: 'versions' stamp: 'ChristopheDemarey 3/27/2013 16:51'!
version210: spec
	<version: '2.1.0' imports: #('2.1.0-baseline')>
	spec
		for: #common
			do: [ spec
					blessing: #release;
					package: 'XML-Writer-Core' with: 'XML-Writer-Core-StephaneDucasse.1' ;
					package: 'XML-Writer-Tests' with: 'XML-Writer-Tests-StephaneDucasse.1' ];
		
		" I do not understand the following line because it means that we would load an older version than the one currently in Pharo. Clearly the best way to introduce bugs and losing hours trying to understand why.
		for: #squeakCommon do: [ spec package: 'Collections-Support' with: 'Collections-Support-StephaneDucasse.35' ];"
		for: #gemstone
			do: [ 
					spec
						package: 'Collections-Support' with: 'Collections-Support.g-OttoBehrens.45';
						package: 'Collections-Tests-Support' with: 'Collections-Tests-Support.g-OttoBehrens.3' ]! !

!ConfigurationOfVersionnerTestXMLWriter methodsFor: 'versions' stamp: 'ChristopheDemarey 3/27/2013 16:51'!
version200: spec
	<version: '2.0.0' imports: #('2.0.0-baseline')>
	spec
		for: #common
			do: [ spec
					blessing: #release;
					package: 'XML-Writer' with: 'XML-Writer-JAAyer.5' ];
		
		" I do not understand the following line because it means that we would load an older version than the one currently in Pharo. Clearly the best way to introduce bugs and losing hours trying to understand why.
		for: #squeakCommon do: [ spec package: 'Collections-Support' with: 'Collections-Support-StephaneDucasse.35' ];"
		for: #gemstone
			do: [ 
					spec
						package: 'Collections-Support' with: 'Collections-Support.g-OttoBehrens.45';
						package: 'Collections-Tests-Support' with: 'Collections-Tests-Support.g-OttoBehrens.3' ]! !

!ConfigurationOfVersionnerTestXMLWriter class methodsFor: 'testing' stamp: 'ChristopheDemarey 5/24/2013 10:34'!
isMetacelloConfig
	"Answer true and the Metacello tools will operate on you"
	
	^true! !

!ConfigurationOfVersionnerTestXMLWriter class methodsFor: 'metacello tool support' stamp: 'ChristopheDemarey 5/24/2013 10:34'!
metacelloVersion: versionString loads: anArrayOrString
	"Stash the last version loaded and the list of packages loaded for that version. The list
	 of packages will be used by the tools when doing 'Load Package Version'"

	LastVersionLoad := versionString -> anArrayOrString! !

!ConfigurationOfVersionnerTestXMLWriter class methodsFor: 'metacello tool support' stamp: 'ChristopheDemarey 5/24/2013 10:34'!
lastMetacelloVersionLoad
	"Answer the last version loaded and the list of packages loaded for that version."

	LastVersionLoad == nil ifTrue: [ LastVersionLoad := nil -> 'default' ].
	^LastVersionLoad! !

!ConfigurationOfVersionnerTestXMLWriter class methodsFor: 'loading' stamp: 'ChristopheDemarey 5/24/2013 10:34'!
load
	"self load"

	^self project latestVersion load! !

!ConfigurationOfVersionnerTestXMLWriter class methodsFor: 'accessing' stamp: 'ChristopheDemarey 5/24/2013 10:34'!
project

	^self new project! !

!ConfigurationOfVersionnerTestXMLWriter class methodsFor: 'private' stamp: 'ChristopheDemarey 5/24/2013 10:34'!
ensureMetacello
	"Bootstrap Gofer (if necessary), load latest mcz file for ConfigurationOfMetacello (using old 
	 Gofer API), then load the latest version of Metacello itself."

	Smalltalk at: #MetacelloProject ifAbsent: [ | error |
		"list of repositories to try, in case primary repository is not accessible"
		(Array 
			with: 'http://www.squeaksource.com/MetacelloRepository' 
			with: 'http://seaside.gemstone.com/ss/metacello') do: [:repositoryUrl |
				([
					Smalltalk at: #Gofer ifAbsent: [
					"Current version of Gofer from which to bootstrap - as of 1.0-beta.21"
						self bootstrapPackage: 'Gofer-Core-lr.115' from: repositoryUrl ].
					Smalltalk at: #Gofer ifPresent: [:goferClass | | gofer |
						gofer := goferClass new
							url: repositoryUrl;
							yourself.
						[ gofer addPackage: 'ConfigurationOfMetacello' ] on: Warning do: [:ex | ex resume ].
						gofer load ]]
							on: Error
							do: [ :ex |
								error := ex.
								Transcript 
									cr; 
									show: 'failed ensureMetacello: ';
									show: ex description printString;
									show: '...retrying'.
								"try again"
								ex return: nil ]) ~~ nil
					ifTrue: [
						"load 'default' group of Metacello"
						(Smalltalk at: #ConfigurationOfMetacello) perform: #load.
						^self ]].
		"shouldn't get here unless the load failed ... throw an error"
		self error: 'retry with alternate repository failed: ', error description printString ]! !

!ConfigurationOfVersionnerTestXMLWriter class methodsFor: 'private' stamp: 'ChristopheDemarey 5/24/2013 10:34'!
bootstrapPackage: aString from: aPath 
	| repository version |
	repository := MCHttpRepository
				location: aPath
				user: ''
				password: ''.
	repository
		versionReaderForFileNamed: aString , '.mcz'
		do: [:reader | 
			version := reader version.
			version load.
			version workingCopy repositoryGroup addRepository: repository]! !

!ConfigurationOfVersionnerTestXMLWriter class methodsFor: 'unloading Metacello' stamp: 'ChristopheDemarey 5/24/2013 10:35'!
unloadMetacello

	Smalltalk at: #ConfigurationOfMetacello ifPresent: [:cls | cls unloadMetacello ]! !

!ConfigurationOfZincHTTPComponents commentStamp: '<historical>'!
I am ConfigurationOfZincHTTPComponents, the Metacello configuration of Zinc HTTP Components, an open-source Smalltalk framework to deal with the HTTP networking protocol.

For more information, see http://zn.stfx.eu

Here are some ways to load this project:

	ConfigurationOfZincHTTPComponents load.
	ConfigurationOfZincHTTPComponents project latestVersion load.
	ConfigurationOfZincHTTPComponents project latestVersion load: 'Tests'.
	ConfigurationOfZincHTTPComponents project bleedingEdge load.

Here is a list of available groups:

	default - Core
	Tests
	Character-Encoding
	Resource-Meta
	Zodiac
	
	AWS
	REST
	Seaside
	WebSocket
	SSO - SSO-OAuth1 - SSO-OAuth2 - SSO-OpenID - SSO-Demo
	
	WebDAV
	WWS
	Patch-HTTPSocket
	
This is open-source software licensed under the MIT License.!
!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SvenVanCaekenberghe 2/26/2015 09:51'!
version262: spec
	<version: '2.6.2' imports: #('2.6-baseline')>
	spec for: #pharo do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.37';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.22';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.47';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.32';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.422';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.221';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.17';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.16';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.28';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-SSO-OAuth1-Core' with: 'Zinc-SSO-OAuth1-Core-SvenVanCaekenberghe.13';
			package: 'Zinc-SSO-OAuth2-Core' with: 'Zinc-SSO-OAuth2-Core-JanVanDeSandt.17';
			package: 'Zinc-SSO-OpenID-Core' with: 'Zinc-SSO-OpenID-Core-JanVanDeSandt.6';
			package: 'Zinc-SSO-Demo' with: 'Zinc-SSO-Demo-SvenVanCaekenberghe.5';
			package: 'Zinc-SSO-OAuth1-Tests' with: 'Zinc-SSO-OAuth1-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-SSO-OpenID-Tests' with: 'Zinc-SSO-OpenID-Tests-JanVanDeSandt.3';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-PhilippeBack.3';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.10';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.34';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.35';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.12';
			package: 'Zinc-Seaside' with: 'Zinc-Seaside-JohanBrichau.43' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.5';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.10';
			package: 'Zinc-pharo2-forward-compatibility' with: 'Zinc-pharo2-forward-compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo3.x' do: [ 
		spec 
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.10';
			package: 'Zinc-Resouce-Meta-FileSystem' with: 'Zinc-Resouce-Meta-FileSystem-SvenVanCaekenberghe.7' ]! !

!ConfigurationOfZincHTTPComponents methodsFor: 'baselines' stamp: 'SvenVanCaekenberghe 3/16/2015 10:16'!
baseline26: spec
	<version: '2.6-baseline'>
	spec for: #pharo do: [ 
		spec
			blessing: #baseline;
			description: 'Baseline for Zinc HTTP Components, a framework to deal with HTTP networking';
			author: 'SvenVanCaekenberghe'.
		spec project: 'XML Support' with: [
			spec
				className: 'ConfigurationOfXMLSupport';
				versionString: #'stable';
				repository: 'http://www.squeaksource.com/MetacelloRepository' ].
		spec project: 'Neo JSON' with: [
			spec
				className: 'ConfigurationOfNeoJSON';
				versionString: #'stable';
				repository: 'http://mc.stfx.eu/Neo' ].
		spec package: 'Zodiac-Core' with: [ spec repository: 'http://mc.stfx.eu/Zodiac' ].
		spec package: 'Zodiac-Tests' with: [ spec repository: 'http://mc.stfx.eu/Zodiac' ].
		spec
			package: 'Zinc-Character-Encoding-Core';
			package: 'Zinc-Character-Encoding-Tests' with: [ spec requires: 'Zinc-Character-Encoding-Core' ];
			package: 'Zinc-Resource-Meta-Core' with: [ spec requires: 'Zinc-Character-Encoding-Core' ];
			package: 'Zinc-Resource-Meta-Tests' with: [ spec requires: 'Zinc-Resource-Meta-Core' ];
			package: 'Zinc-HTTP' with: [ spec requires: #( 'Zinc-Character-Encoding-Core' 'Zinc-Resource-Meta-Core' ) ];
			package: 'Zinc-Patch-HTTPSocket' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-AWS' with: [ spec requires: #( 'Zinc-HTTP' 'XML Support' ) ];
			package: 'Zinc-REST' with: [ spec requires: #( 'Zinc-HTTP' 'Neo JSON' ) ];
			package: 'Zinc-Zodiac' with: [ spec requires: #( 'Zinc-HTTP' 'Zodiac-Core' 'Zodiac-Tests' ) ];
			package: 'Zinc-WebSocket-Core' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-WebSocket-Tests' with: [ spec requires: 'Zinc-WebSocket-Core' ];
			package: 'Zinc-SSO-OAuth1-Core' with: [ spec requires: #( 'Zinc-HTTP' 'Neo JSON' ) ];
			package: 'Zinc-SSO-OAuth2-Core' with: [ spec requires: #( 'Zinc-HTTP' 'Neo JSON' ) ];
			package: 'Zinc-SSO-OpenID-Core' with: [ spec requires: #( 'Zinc-HTTP' 'XML Support' ) ];
			package: 'Zinc-SSO-Demo' with: [ spec requires: #( 'Zinc-SSO-OAuth1-Core' 'Zinc-SSO-OAuth2-Core' 'Zinc-SSO-OpenID-Core' ) ];
			package: 'Zinc-SSO-OAuth1-Tests' with: [ spec requires: #( 'Zinc-SSO-OAuth1-Core' ) ];
			package: 'Zinc-SSO-OpenID-Tests' with: [ spec requires: #( 'Zinc-SSO-OpenID-Core' ) ];
			package: 'Zinc-WebDAV' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-WWS-Server' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-WWS-Client' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-Tests' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-Seaside'. "For now, no dependence on Seaside itself"
		spec
			group: 'default' with: #('Core');
			group: 'Core' with: #('Zinc-HTTP');
			group: 'Tests' with: #('Zinc-Tests' 'Zinc-Character-Encoding-Tests' 'Zinc-Resource-Meta-Tests');
			group: 'Character-Encoding' with: #('Zinc-Character-Encoding-Core' 'Zinc-Character-Encoding-Tests');
			group: 'Resource-Meta' with: #('Zinc-Resource-Meta-Core' 'Zinc-Resource-Meta-Tests');
			group: 'Zodiac' with: #('Zinc-Zodiac');
			group: 'AWS' with: #('Zinc-AWS');
			group: 'WebDAV' with: #('Zinc-WebDAV');
			group: 'WebSocket' with: #('Zinc-WebSocket-Core' 'Zinc-WebSocket-Tests');
			group: 'SSO-OAuth1' with: #('Zinc-SSO-OAuth1-Core' 'Zinc-SSO-OAuth1-Tests');
			group: 'SSO-OAuth2' with: #('Zinc-SSO-OAuth2-Core');
			group: 'SSO-OpenID' with: #('Zinc-SSO-OpenID-Core' 'Zinc-SSO-OpenID-Tests');
			group: 'SSO-Demo' with: #('Zinc-SSO-OAuth1-Core' 'Zinc-SSO-OAuth2-Core' 'Zinc-SSO-OpenID-Core');
			group: 'SSO' with: #('SSO-OAuth1' 'SSO-OAuth2' 'SSO-OpenID' 'SSO-Demo' 'Zinc-SSO-Demo');
			group: 'WWS' with: #('Zinc-WWS-Server' 'Zinc-WWS-Client');
			group: 'REST' with: #('Zinc-REST');
			group: 'Patch-HTTPSocket' with: #('Zinc-Patch-HTTPSocket');
			group: 'Seaside' with: #('Zinc-Seaside') ].
	spec for: #squeakCommon do:[ spec repository: 'http://mc.stfx.eu/ZincHTTPComponents' ].
	spec for: #'pharo1.x' do: [ 
		spec
			package: 'Zinc-FileSystem-Legacy';
			package: 'Zinc-Pharo-Forward-Compatibility';
			package: 'Zinc-HTTP' with: [ spec requires: #('Zinc-FileSystem-Legacy' 'Zinc-Pharo-Forward-Compatibility') ] ].
	spec for: #'pharo2.x' do: [
		spec
			package: 'Zinc-FileSystem';
			package: 'Zinc-pharo2-forward-compatibility';
			package: 'Zinc-HTTP' with: [ spec requires: #('Zinc-FileSystem' 'Zinc-pharo2-forward-compatibility')];
			package: 'Zinc-Resource-Meta-FileSystem' with: [ spec requires: 'Zinc-HTTP' ] ].
	spec for: #'pharo3.x' do: [
		spec
			package: 'Zinc-FileSystem';
			package: 'Zinc-HTTP' with: [ spec requires: 'Zinc-FileSystem' ];
			package: 'Zinc-Resource-Meta-FileSystem' with: [ spec requires: 'Zinc-HTTP' ] ]
! !

!ConfigurationOfZincHTTPComponents methodsFor: 'baselines' stamp: 'PaulDeBruicker 10/25/2011 17:17'!
baseline13: spec 
	<version: '1.3-baseline'>
	
	spec for: #common do: [
		spec 
			blessing: #baseline;
			description: 'Baseline for Zinc HTTP Components, a framework to deal with the HTTP networking:
  move Seaside support to ConfigurationOfSeaside30.';
			author: 'SvenVanCaekenberghe';
			repository: 'http://www.squeaksource.com/ZincHTTPComponents'.	
		spec package: 'Zodiac' with: [spec repository: 'http://www.squeaksource.com/Zodiac'].
		spec 
			package: 'Zinc-HTTP';
			package: 'Zinc-Patch-HTTPSocket' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-AWS' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-REST' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-Zodiac' with: [ spec requires:#( 'Zinc-HTTP' 'Zodiac') ];
			package: 'Zinc-Tests' with: [ spec requires: 'Zinc-HTTP' ].
		spec
			group: 'default' with: #('Core');
			group: 'Core' with: #('Zinc-HTTP');
			group: 'Tests' with: #('Zinc-Tests');
			group: 'Patch-HTTPSocket' with: #('Zinc-Patch-HTTPSocket') ].
		
	spec for: #gemstone do:[
		spec repository: 'http://seaside.gemstone.com/ss/ZincHTTPComponents'.  
		spec
			package:'Zinc-HTTP' with:[spec includes: #('Zinc-Gemstone')  ];
			package:'SocketStream' with:[spec repository: 'http://seaside.gemstone.com/ss/PharoCompat' ];
			package:'Zinc-GemstonePreliminary' with:[spec requires: #('SocketStream')  ];
			package:'Zinc-HTTP' with:[spec requires: #('Zinc-GemstonePreliminary')  ];
			package:'Zinc-Gemstone' with:[spec requires: #('Zinc-HTTP')  ];
			package: 'Zinc-Tests' with: [ spec requires: 'Zinc-Gemstone' ].
		]! !

!ConfigurationOfZincHTTPComponents methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 3/16/2015 10:37'!
stable: spec
	<symbolicVersion: #stable>
	spec for: #pharo version: '2.6.2'.
	spec for: #'pharo2.x' version: '2.6.3'.
	spec for: #'pharo3.x' version: '2.6.3'.
	spec for: #'pharo4.x' version: '2.6.3'.
	spec for: #gemstone version: '2.4.3'! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SvenVanCaekenberghe 1/8/2013 15:32'!
version22: spec
	<version: '2.2' imports: #('2.2-baseline')>
	spec for: #common do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.2';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.5';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.4';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.335';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.174';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.16';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.9';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.24';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-SSO-OAuth1-Core' with: 'Zinc-SSO-OAuth1-Core-JanVanDeSandt.8';
			package: 'Zinc-SSO-OAuth2-Core' with: 'Zinc-SSO-OAuth2-Core-JanVanDeSandt.13';
			package: 'Zinc-SSO-OpenID-Core' with: 'Zinc-SSO-OpenID-Core-JanVanDeSandt.5';
			package: 'Zinc-SSO-Demo' with: 'Zinc-SSO-Demo-JanVanDeSandt.1';
			package: 'Zinc-SSO-OAuth1-Tests' with: 'Zinc-SSO-OAuth1-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-SSO-OpenID-Tests' with: 'Zinc-SSO-OpenID-Tests-JanVanDeSandt.2';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.8';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.24';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.27';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.10' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.3';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.7' ].
	spec for: #gemstone do: [ 
		spec blessing: #release.
		spec
			package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
			package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.14';
			package: 'SocketStream' with: 'SocketStream-PaulDeBruicker.12' ]
! !

!ConfigurationOfZincHTTPComponents methodsFor: 'baselines' stamp: 'FrancoisStephany 12/12/2011 12:02'!
baseline14: spec 
	<version: '1.4-baseline'>
	
	spec for: #common do: [
		spec 
			blessing: #baseline;
			description: 'Baseline for Zinc HTTP Components, a framework to deal with the HTTP networking';
			author: 'SvenVanCaekenberghe';
			repository: 'http://www.squeaksource.com/ZincHTTPComponents'.	
		spec package: 'Zodiac' with: [spec repository: 'http://www.squeaksource.com/Zodiac'].
		spec 
			package: 'Zinc-HTTP';
			package: 'Zinc-Patch-HTTPSocket' with: [
				spec
					repository: 'http://ss3.gemstone.com/ss/pharo';
					requires: 'Zinc-HTTP' ];
			package: 'Zinc-AWS' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-REST' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-Zodiac' with: [ spec requires:#( 'Zinc-HTTP' 'Zodiac') ];
			package: 'Zinc-Tests' with: [ spec requires: 'Zinc-HTTP' ].
		spec
			group: 'default' with: #('Core');
			group: 'Core' with: #('Zinc-HTTP');
			group: 'Tests' with: #('Zinc-Tests');
			group: 'Patch-HTTPSocket' with: #('Zinc-Patch-HTTPSocket') ].
		
	spec for: #gemstone do:[
		spec repository: 'http://seaside.gemstone.com/ss/ZincHTTPComponents'.  
		spec
			package:'Zinc-HTTP' with:[spec includes: #('Zinc-Gemstone')  ];
			package:'SocketStream' with:[spec repository: 'http://seaside.gemstone.com/ss/PharoCompat' ];
			package:'Zinc-GemstonePreliminary' with:[spec requires: #('SocketStream')  ];
			package:'Zinc-HTTP' with:[spec requires: #('Zinc-GemstonePreliminary')  ];
			package:'Zinc-Gemstone' with:[spec requires: #('Zinc-HTTP')  ];
			package: 'Zinc-Tests' with: [ spec requires: 'Zinc-Gemstone' ].
		]! !

!ConfigurationOfZincHTTPComponents methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/15/2011 17:31'!
project

	^ project ifNil: [ | constructor |
		"Bootstrap Metacello if it is not already loaded"
		self class ensureMetacello.
		"Construct Metacello project"
		constructor := (Smalltalk at: #MetacelloVersionConstructor) on: self.
		project := constructor project.
		project loadType: #linear. "change to #atomic if desired"
		project ]! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SvenVanCaekenberghe 3/16/2015 10:30'!
version263: spec
	<version: '2.6.3' imports: #('2.6-baseline')>
	spec for: #pharo do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.37';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.22';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.48';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.33';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.423';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.223';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.17';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.16';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.28';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-SSO-OAuth1-Core' with: 'Zinc-SSO-OAuth1-Core-SvenVanCaekenberghe.13';
			package: 'Zinc-SSO-OAuth2-Core' with: 'Zinc-SSO-OAuth2-Core-JanVanDeSandt.17';
			package: 'Zinc-SSO-OpenID-Core' with: 'Zinc-SSO-OpenID-Core-JanVanDeSandt.6';
			package: 'Zinc-SSO-Demo' with: 'Zinc-SSO-Demo-SvenVanCaekenberghe.5';
			package: 'Zinc-SSO-OAuth1-Tests' with: 'Zinc-SSO-OAuth1-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-SSO-OpenID-Tests' with: 'Zinc-SSO-OpenID-Tests-JanVanDeSandt.3';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-PhilippeBack.3';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.10';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.34';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.38';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.12';
			package: 'Zinc-Seaside' with: 'Zinc-Seaside-JohanBrichau.43' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.5';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.10';
			package: 'Zinc-pharo2-forward-compatibility' with: 'Zinc-pharo2-forward-compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo3.x' do: [ 
		spec 
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.10';
			package: 'Zinc-Resource-Meta-FileSystem' with: 'Zinc-Resource-Meta-FileSystem-SvenVanCaekenberghe.7' ]! !

!ConfigurationOfZincHTTPComponents methodsFor: 'baselines' stamp: 'SvenVanCaekenberghe 10/7/2014 13:33'!
baseline22: spec
	<version: '2.2-baseline'>
	spec for: #common do: [ 
		spec
			blessing: #baseline;
			description: 'Baseline for Zinc HTTP Components, a framework to deal with HTTP networking';
			author: 'SvenVanCaekenberghe';
			repository: 'http://mc.stfx.eu/ZincHTTPComponents'.
		spec project: 'XML Support' with: [
			spec
				className: 'ConfigurationOfXMLSupport';
				versionString: #'stable';
				repository: 'http://www.squeaksource.com/MetacelloRepository' ].
		spec project: 'Neo JSON' with: [
			spec
				className: 'ConfigurationOfNeoJSON';
				versionString: #'stable';
				repository: 'http://mc.stfx.eu/Neo' ].
		spec package: 'Zodiac-Core' with: [ spec repository: 'http://mc.stfx.eu/Zodiac' ].
		spec package: 'Zodiac-Tests' with: [ spec repository: 'http://mc.stfx.eu/Zodiac' ].
		spec
			package: 'Zinc-Character-Encoding-Core';
			package: 'Zinc-Character-Encoding-Tests' with: [ spec requires: 'Zinc-Character-Encoding-Core' ];
			package: 'Zinc-Resource-Meta-Core' with: [ spec requires: 'Zinc-Character-Encoding-Core' ];
			package: 'Zinc-Resource-Meta-Tests' with: [ spec requires: 'Zinc-Resource-Meta-Core' ];
			package: 'Zinc-HTTP' with: [ spec requires: #( 'Zinc-Character-Encoding-Core' 'Zinc-Resource-Meta-Core' ) ];
			package: 'Zinc-Patch-HTTPSocket' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-AWS' with: [ spec requires: #( 'Zinc-HTTP' 'XML Support' ) ];
			package: 'Zinc-REST' with: [ spec requires: #( 'Zinc-HTTP' 'Neo JSON' ) ];
			package: 'Zinc-Zodiac' with: [ spec requires: #( 'Zinc-HTTP' 'Zodiac-Core' 'Zodiac-Tests' ) ];
			package: 'Zinc-WebSocket-Core' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-WebSocket-Tests' with: [ spec requires: 'Zinc-WebSocket-Core' ];
			package: 'Zinc-SSO-OAuth1-Core' with: [ spec requires: #( 'Zinc-HTTP' 'Neo JSON' ) ];
			package: 'Zinc-SSO-OAuth2-Core' with: [ spec requires: #( 'Zinc-HTTP' 'Neo JSON' ) ];
			package: 'Zinc-SSO-OpenID-Core' with: [ spec requires: #( 'Zinc-HTTP' 'XML Support' ) ];
			package: 'Zinc-SSO-Demo' with: [ spec requires: #( 'Zinc-SSO-OAuth1-Core' 'Zinc-SSO-OAuth2-Core' 'Zinc-SSO-OpenID-Core' ) ];
			package: 'Zinc-SSO-OAuth1-Tests' with: [ spec requires: #( 'Zinc-SSO-OAuth1-Core' ) ];
			package: 'Zinc-SSO-OpenID-Tests' with: [ spec requires: #( 'Zinc-SSO-OpenID-Core' ) ];
			package: 'Zinc-WebDAV' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-WWS-Server' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-WWS-Client' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-Tests' with: [ spec requires: 'Zinc-HTTP' ].
		spec
			group: 'default' with: #('Core');
			group: 'Core' with: #('Zinc-HTTP');
			group: 'Tests' with: #('Zinc-Tests');
			group: 'Character-Encoding' with: #('Zinc-Character-Encoding-Core' 'Zinc-Character-Encoding-Tests');
			group: 'Resource-Meta' with: #('Zinc-Resource-Meta-Core' 'Zinc-Resource-Meta-Tests');
			group: 'Zodiac' with: #('Zinc-Zodiac');
			group: 'AWS' with: #('Zinc-AWS');
			group: 'WebDAV' with: #('Zinc-WebDAV');
			group: 'WebSocket' with: #('Zinc-WebSocket-Core' 'Zinc-WebSocket-Tests');
			group: 'SSO-OAuth1' with: #('Zinc-SSO-OAuth1-Core' 'Zinc-SSO-OAuth1-Tests');
			group: 'SSO-OAuth2' with: #('Zinc-SSO-OAuth2-Core');
			group: 'SSO-OpenID' with: #('Zinc-SSO-OpenID-Core' 'Zinc-SSO-OpenID-Tests');
			group: 'SSO-Demo' with: #('Zinc-SSO-OAuth1-Core' 'Zinc-SSO-OAuth2-Core' 'Zinc-SSO-OpenID-Core');
			group: 'SSO' with: #('SSO-OAuth1' 'SSO-OAuth2' 'SSO-OpenID' 'SSO-Demo' 'Zinc-SSO-Demo');
			group: 'WWS' with: #('Zinc-WWS-Server' 'Zinc-WWS-Client');
			group: 'REST' with: #('Zinc-REST');
			group: 'Patch-HTTPSocket' with: #('Zinc-Patch-HTTPSocket') ].
	spec for: #'pharo1.x' do: [ 
		spec
			package: 'Zinc-FileSystem-Legacy';
			package: 'Zinc-Pharo-Forward-Compatibility';
			package: 'Zinc-HTTP' with: [ spec requires: #('Zinc-FileSystem-Legacy' 'Zinc-Pharo-Forward-Compatibility') ] ].
	spec for: #'pharo2.x' do: [
		spec
			package: 'Zinc-FileSystem';
			package: 'Zinc-HTTP' with: [ spec requires: 'Zinc-FileSystem' ] ].
	spec for: #gemstone do: [ 
		spec
			repository: 'http://seaside.gemstone.com/ss/ZincHTTPComponents';
			package: 'Zinc-HTTP' with: [ spec includes: #('Zinc-Gemstone') ];
			package: 'SocketStream' with: [ spec repository: 'http://seaside.gemstone.com/ss/PharoCompat' ];
			package: 'Zinc-GemstonePreliminary' with: [ spec requires: #('SocketStream') ];
			package: 'Zinc-HTTP' with: [ spec requires: #('Zinc-GemstonePreliminary') ];
			package: 'Zinc-Gemstone' with: [ spec requires: #('Zinc-HTTP') ];
			package: 'Zinc-Tests' with: [ spec requires: 'Zinc-Gemstone' ] ]! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'JohanBrichau 7/9/2014 20:54'!
version247: spec
	<version: '2.4.7' imports: #('2.4-baseline')>
	spec for: #pharo do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.28';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.15';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.30';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.18';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.388';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.200';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.17';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.13';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.25';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-SSO-OAuth1-Core' with: 'Zinc-SSO-OAuth1-Core-SvenVanCaekenberghe.13';
			package: 'Zinc-SSO-OAuth2-Core' with: 'Zinc-SSO-OAuth2-Core-JanVanDeSandt.16';
			package: 'Zinc-SSO-OpenID-Core' with: 'Zinc-SSO-OpenID-Core-JanVanDeSandt.6';
			package: 'Zinc-SSO-Demo' with: 'Zinc-SSO-Demo-SvenVanCaekenberghe.5';
			package: 'Zinc-SSO-OAuth1-Tests' with: 'Zinc-SSO-OAuth1-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-SSO-OpenID-Tests' with: 'Zinc-SSO-OpenID-Tests-JanVanDeSandt.3';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.10';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.29';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.30';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.12';
			package: 'Zinc-Seaside' with: 'Zinc-Seaside-SvenVanCaekenberghe.40' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.5';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.10' ].! !

!ConfigurationOfZincHTTPComponents methodsFor: 'baselines' stamp: 'SvenVanCaekenberghe 10/7/2014 13:32'!
baseline20: spec
	<version: '2.0-baseline'>
	spec for: #common do: [ 
		spec
			blessing: #baseline;
			description: 'Baseline for Zinc HTTP Components, a framework to deal with HTTP networking';
			author: 'SvenVanCaekenberghe';
			repository: 'http://mc.stfx.eu/ZincHTTPComponents'.
		spec project: 'XML Support' with: [
			spec
				className: 'ConfigurationOfXMLSupport';
				versionString: #'stable';
				repository: 'http://www.squeaksource.com/MetacelloRepository' ].
		spec project: 'Neo JSON' with: [
			spec
				className: 'ConfigurationOfNeoJSON';
				versionString: #'stable';
				repository: 'http://mc.stfx.eu/Neo' ].
		spec package: 'Zodiac-Core' with: [ 
			spec repository: 'http://mc.stfx.eu/Zodiac' ].
		spec
			package: 'Zinc-Resource-Meta-Core';
			package: 'Zinc-Resource-Meta-Tests' with: [ spec requires: 'Zinc-Resource-Meta-Core' ];
			package: 'Zinc-HTTP' with: [ spec requires: 'Zinc-Resource-Meta-Core' ];
			package: 'Zinc-Patch-HTTPSocket' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-AWS' with: [ spec requires: #('Zinc-HTTP' 'XML Support') ];
			package: 'Zinc-REST' with: [ spec requires: #('Zinc-HTTP' 'Neo JSON') ];
			package: 'Zinc-Zodiac' with: [ spec requires: #('Zinc-HTTP' 'Zodiac-Core' 'Zodiac-Tests') ];
			package: 'Zinc-WebSocket-Core' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-WebSocket-Tests' with: [ spec requires: 'Zinc-WebSocket-Core' ];
			package: 'Zinc-WebDAV' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-WWS-Server' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-WWS-Client' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-Tests' with: [ spec requires: 'Zinc-HTTP' ].
		spec
			group: 'default' with: #('Core');
			group: 'Core' with: #('Zinc-HTTP');
			group: 'Tests' with: #('Zinc-Tests');
			group: 'Zodiac' with: #('Zinc-Zodiac');
			group: 'AWS' with: #('Zinc-AWS');
			group: 'WebDAV' with: #('Zinc-WebDAV');
			group: 'WebSocket' with: #('Zinc-WebSocket-Core' 'Zinc-WebSocket-Tests');
			group: 'WWS' with: #('Zinc-WWS-Server' 'Zinc-WWS-Client');
			group: 'REST' with: #('Zinc-REST');
			group: 'Patch-HTTPSocket' with: #('Zinc-Patch-HTTPSocket') ].
	spec for: #'pharo1.x' do: [ 
		spec
			package: 'Zinc-FileSystem-Legacy';
			package: 'Zinc-Pharo-Forward-Compatibility';
			package: 'Zinc-HTTP' with: [ spec requires: #('Zinc-FileSystem-Legacy' 'Zinc-Pharo-Forward-Compatibility') ] ].
	spec for: #'pharo2.x' do: [
		spec
			package: 'Zinc-FileSystem';
			package: 'Zinc-HTTP' with: [ spec requires: 'Zinc-FileSystem' ] ].
	spec for: #gemstone do: [ 
		spec
			repository: 'http://seaside.gemstone.com/ss/ZincHTTPComponents';
			package: 'Zinc-HTTP' with: [ spec includes: #('Zinc-Gemstone') ];
			package: 'SocketStream' with: [ spec repository: 'http://seaside.gemstone.com/ss/PharoCompat' ];
			package: 'Zinc-GemstonePreliminary' with: [ spec requires: #('SocketStream') ];
			package: 'Zinc-HTTP' with: [ spec requires: #('Zinc-GemstonePreliminary') ];
			package: 'Zinc-Gemstone' with: [ spec requires: #('Zinc-HTTP') ];
			package: 'Zinc-Tests' with: [ spec requires: 'Zinc-Gemstone' ] ]! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SeanDeNigris 7/5/2012 01:34'!
version17: spec
	<version: '1.7' imports: #('1.7-baseline')>
	spec
		for: #common
		do: [ 
			spec blessing: #release.
			spec description: '
- update to latest package versions
- add  FileSystem-Legacy to Pharo 1.x and FileSystem to Pharo 2.x'.
			spec author: 'SeanDeNigris'.
			spec timestamp: '7/4/2012 12:12-4:00'.
			spec
				package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.282';
				package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.147';
				package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.15';
				package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.5';
				package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
				package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
				package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.7';
				package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.14';
				package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-StephaneDucasse.2';
				package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.18' ].
	spec for: #'pharo1.x' do: [ spec package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ spec package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SeanDeNigris.2' ].
	spec
		for: #gemstone
		do: [ 
			spec blessing: #release.
			spec
				package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
				package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.14';
				package: 'SocketStream' with: 'SocketStream-PaulDeBruicker.12' ]! !

!ConfigurationOfZincHTTPComponents methodsFor: 'baselines' stamp: 'dkh 9/1/2011 17:13'!
baseline12: spec 
	<version: '1.2-baseline'>
	
	spec for: #common do: [
		spec 
			blessing: #baseline;
			description: 'Baseline for Zinc HTTP Components, a framework to deal with the HTTP networking:
  move Seaside support to ConfigurationOfSeaside30.';
			author: 'SvenVanCaekenberghe';
			repository: 'http://www.squeaksource.com/ZincHTTPComponents'.	
		spec package: 'Zodiac' with: [spec repository: 'http://www.squeaksource.com/Zodiac'].
		spec 
			package: 'Zinc-HTTP';
			package: 'Zinc-Patch-HTTPSocket' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-AWS' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-Zodiac' with: [ spec requires:#( 'Zinc-HTTP' 'Zodiac') ];
			package: 'Zinc-Tests' with: [ spec requires: 'Zinc-HTTP' ].
		spec
			group: 'default' with: #('Core');
			group: 'Core' with: #('Zinc-HTTP');
			group: 'Tests' with: #('Zinc-Tests');
			group: 'Patch-HTTPSocket' with: #('Zinc-Patch-HTTPSocket') ].
		
	spec for: #gemstone do:[
		spec repository: 'http://seaside.gemstone.com/ss/ZincHTTPComponents'.  
		spec
			package:'Zinc-HTTP' with:[spec includes: #('Zinc-Gemstone')  ];
			package:'SocketStream' with:[spec repository: 'http://seaside.gemstone.com/ss/PharoCompat' ];
			package:'Zinc-GemstonePreliminary' with:[spec requires: #('SocketStream')  ];
			package:'Zinc-HTTP' with:[spec requires: #('Zinc-GemstonePreliminary')  ];
			package:'Zinc-Gemstone' with:[spec requires: #('Zinc-HTTP')  ];
			package: 'Zinc-Tests' with: [ spec requires: 'Zinc-Gemstone' ].
		]! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'PaulDeBruicker 6/7/2012 07:40'!
version16: spec
	<version: '1.6' imports: #('1.5-baseline')>
	spec
		for: #common
		do: [ 
			spec blessing: #release.
			spec description: 'update to latest set of packages.'.
			spec author: 'PaulDeBruicker'.
			spec timestamp: '6/6/2012 13:12-7:00'.
			spec
				package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.280';
				package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.144';
				package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.15';
				package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.5';
				package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
				package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
				package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.7';
				package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.12';
				package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-StephaneDucasse.2';
				package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.17' ].
	spec
		for: #gemstone
		do: [ 
			spec blessing: #release.
			spec
				package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
				package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.14';
				package: 'SocketStream' with: 'SocketStream-PaulDeBruicker.12' ]! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SvenVanCaekenberghe 10/13/2012 20:56'!
version193: spec
	<version: '1.9.3' imports: #('1.9-baseline')>
	spec for: #common do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.310';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.157';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.16';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.5';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.23';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.8';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.21';
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.27' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.3';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.7' ].
	spec for: #gemstone do: [ 
		spec blessing: #release.
		spec
			package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
			package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.14';
			package: 'SocketStream' with: 'SocketStream-PaulDeBruicker.12' ]
! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SeanDeNigris 6/7/2012 00:18'!
version15: spec
	<version: '1.5' imports: #('1.5-baseline')>
	spec
		for: #common
		do: [ 
			spec blessing: #release.
			spec description: 'update to latest set of packages.'.
			spec author: 'PaulDeBruicker'.
			spec timestamp: '4/4/2012 09:12'.
			spec
				package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.254';
				package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.130';
				package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.15';
				package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.5';
				package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
				package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
				package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.7';
				package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.12';
				package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-StephaneDucasse.2';
				package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.17' ].
	spec
		for: #gemstone
		do: [ 
			spec blessing: #release.
			spec
				package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
				package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.14';
				package: 'SocketStream' with: 'SocketStream-PaulDeBruicker.12' ]! !

!ConfigurationOfZincHTTPComponents methodsFor: 'baselines' stamp: 'dkh 9/1/2011 17:10'!
baseline11: spec 
	<version: '1.1-baseline'>
	
	spec for: #common do: [
		spec 
			blessing: #baseline;
			description: 'Baseline for Zinc HTTP Components, a framework to deal with the HTTP networking';
			author: 'SvenVanCaekenberghe';
			repository: 'http://www.squeaksource.com/ZincHTTPComponents'.	
		spec project: 'Seaside30' with: [
				spec
					className: 'ConfigurationOfSeaside30';
					repository: 'http://www.squeaksource.com/MetacelloRepository' ].
		spec package: 'Zodiac' with: [spec repository: 'http://www.squeaksource.com/Zodiac'].
		spec 
			package: 'Zinc-HTTP';
			package: 'Zinc-Patch-HTTPSocket' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-AWS' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-Zodiac' with: [ spec requires:#( 'Zinc-HTTP' 'Zodiac') ];
			package: 'Zinc-Tests' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-Seaside' with: [ spec requires: #('Zinc-HTTP' 'Seaside30') ].
		spec
			group: 'default' with: #('Core');
			group: 'Core' with: #('Zinc-HTTP');
			group: 'Tests' with: #('Zinc-Tests');
			group: 'Seaside' with: #('Zinc-Seaside');
			group: 'Patch-HTTPSocket' with: #('Zinc-Patch-HTTPSocket') ].
		
	spec for: #gemstone do:[
		spec repository: 'http://seaside.gemstone.com/ss/ZincHTTPComponents'.  
		spec
			package:'SocketStream' with:[spec repository: 'http://seaside.gemstone.com/ss/PharoCompat' ];
			package:'Seaside-GemStone-Adaptors-Zinc' with:[spec requires: #('Zinc-Gemstone' 'Zinc-Seaside')] ;
			package:'Zinc-GemstonePreliminary' with:[spec requires: #('SocketStream')  ];
			package:'Zinc-HTTP' with:[spec requires: #('Zinc-GemstonePreliminary')  ];
			package:'Zinc-Gemstone' with:[spec requires: #('Zinc-HTTP')  ];
			package: 'Zinc-Tests' with: [ spec requires: 'Zinc-Gemstone' ].
		spec
			group: 'default' with: #('Core');
			group: 'Core' with: #('Zinc-Gemstone');
			group: 'Tests' with: #('Zinc-Tests');
			group: 'Seaside' with: #('Seaside-GemStone-Adaptors-Zinc').
		
		]! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'JohanBrichau 7/9/2014 20:55'!
version252: spec
	<version: '2.5.2' imports: #('2.4-baseline')>
	spec for: #pharo do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.32';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.19';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-KrisGybels.37';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.25';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.405';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.215';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.17';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.14';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.27';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-SSO-OAuth1-Core' with: 'Zinc-SSO-OAuth1-Core-SvenVanCaekenberghe.13';
			package: 'Zinc-SSO-OAuth2-Core' with: 'Zinc-SSO-OAuth2-Core-JanVanDeSandt.16';
			package: 'Zinc-SSO-OpenID-Core' with: 'Zinc-SSO-OpenID-Core-JanVanDeSandt.6';
			package: 'Zinc-SSO-Demo' with: 'Zinc-SSO-Demo-SvenVanCaekenberghe.5';
			package: 'Zinc-SSO-OAuth1-Tests' with: 'Zinc-SSO-OAuth1-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-SSO-OpenID-Tests' with: 'Zinc-SSO-OpenID-Tests-JanVanDeSandt.3';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.10';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.34';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.30';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.12';
			package: 'Zinc-Seaside' with: 'Zinc-Seaside-SvenVanCaekenberghe.41' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.5';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.10' ].! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SvenVanCaekenberghe 12/24/2012 14:53'!
version211: spec
	<version: '2.1.1' imports: #('2.1-baseline')>
	spec for: #common do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.2';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.3';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.3';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.331';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.170';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.16';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.8';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.23';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.8';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.23';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.27';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.10' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.3';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.7' ].
	spec for: #gemstone do: [ 
		spec blessing: #release.
		spec
			package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
			package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.14';
			package: 'SocketStream' with: 'SocketStream-PaulDeBruicker.12' ]
! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'JohanBrichau 7/9/2014 20:55'!
version250: spec
	<version: '2.5.0' imports: #('2.4-baseline')>
	spec for: #pharo do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.31';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.18';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.34';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.21';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.395';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.204';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.17';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.13';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.26';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-SSO-OAuth1-Core' with: 'Zinc-SSO-OAuth1-Core-SvenVanCaekenberghe.13';
			package: 'Zinc-SSO-OAuth2-Core' with: 'Zinc-SSO-OAuth2-Core-JanVanDeSandt.16';
			package: 'Zinc-SSO-OpenID-Core' with: 'Zinc-SSO-OpenID-Core-JanVanDeSandt.6';
			package: 'Zinc-SSO-Demo' with: 'Zinc-SSO-Demo-SvenVanCaekenberghe.5';
			package: 'Zinc-SSO-OAuth1-Tests' with: 'Zinc-SSO-OAuth1-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-SSO-OpenID-Tests' with: 'Zinc-SSO-OpenID-Tests-JanVanDeSandt.3';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.10';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.29';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.30';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.12';
			package: 'Zinc-Seaside' with: 'Zinc-Seaside-SvenVanCaekenberghe.41' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.5';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.10' ].! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SvenVanCaekenberghe 6/3/2013 20:20'!
version241: spec
	<version: '2.4.1' imports: #('2.3-baseline')>
	spec for: #common do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.17';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.8';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.14';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.9';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.365';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.187';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.17';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.10';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.25';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-SSO-OAuth1-Core' with: 'Zinc-SSO-OAuth1-Core-SvenVanCaekenberghe.12';
			package: 'Zinc-SSO-OAuth2-Core' with: 'Zinc-SSO-OAuth2-Core-JanVanDeSandt.13';
			package: 'Zinc-SSO-OpenID-Core' with: 'Zinc-SSO-OpenID-Core-JanVanDeSandt.6';
			package: 'Zinc-SSO-Demo' with: 'Zinc-SSO-Demo-SvenVanCaekenberghe.4';
			package: 'Zinc-SSO-OAuth1-Tests' with: 'Zinc-SSO-OAuth1-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-SSO-OpenID-Tests' with: 'Zinc-SSO-OpenID-Tests-JanVanDeSandt.3';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.9';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.27';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.30';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.12' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.5';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.9' ].
	spec for: #gemstone do: [ 
		spec blessing: #release.
		spec
			package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
			package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.14';
			package: 'SocketStream' with: 'SocketStream-PaulDeBruicker.12' ]
! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'PaulDeBruicker 6/1/2011 23:13'!
version10: spec 
	<version: '1.0' imports: #('1.0-baseline') >
	
	spec for: #common do: [
		spec blessing: #release.
		spec 
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-PaulDeBruicker.140';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.75';
			package: 'Zinc-AWS' with:'Zinc-AWS-SvenVanCaekenberghe.7';
			package: 'Zinc-Patch-HTTPSocket' with:'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-Seaside' with:'Zinc-Seaside-PaulDeBruicker.13';
			project:'Seaside30' with: '3.0.4' ].
		
	spec for: #gemstone do:[
		spec blessing: #release.
		spec 
			package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
			package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.8';
			package:'SocketStream' with:'SocketStream-PaulDeBruicker.12';
			package:'Seaside-GemStone-Adaptors-Zinc' with: 'Seaside-GemStone-Adaptors-Zinc-PaulDeBruicker.3'   		
		]! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SvenVanCaekenberghe 1/8/2013 13:54'!
version213: spec
	<version: '2.1.3' imports: #('2.1-baseline')>
	spec for: #common do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.2';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.5';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.4';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.335';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.174';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.16';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.8';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.24';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.8';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.24';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.27';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.10' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.3';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.7' ].
	spec for: #gemstone do: [ 
		spec blessing: #release.
		spec
			package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
			package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.14';
			package: 'SocketStream' with: 'SocketStream-PaulDeBruicker.12' ]
! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SvenVanCaekenberghe 12/17/2012 22:04'!
version21: spec
	<version: '2.1' imports: #('2.1-baseline')>
	spec for: #common do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.2';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.3';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.3';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.328';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.169';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.16';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.8';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.23';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.8';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.23';
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.27';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.10' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.3';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.7' ].
	spec for: #gemstone do: [ 
		spec blessing: #release.
		spec
			package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
			package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.14';
			package: 'SocketStream' with: 'SocketStream-PaulDeBruicker.12' ]
! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'dkh 9/1/2011 17:12'!
version12: spec
	<version: '1.2' imports: #('1.2-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'development'.
		spec description: '- Move Seaside support into ConfigurationOfSeaside30
- update to latest set of packages.'.
		spec author: 'dkh'.
		spec timestamp: '9/1/2011 16:33'.
		spec 
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.188';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.98';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.7';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.4';
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-StephaneDucasse.2';
			package: 'Zodiac' with: 'Zodiac-Core-SvenVanCaekenberghe.8'. ].

	spec for: #'gemstone' do: [
		spec blessing: #'release'.
		spec 
			package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
			package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.14';
			package: 'SocketStream' with: 'SocketStream-PaulDeBruicker.12'. ].
! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'JohanBrichau 7/9/2014 20:54'!
version244: spec
	<version: '2.4.4' imports: #('2.4-baseline')>
	spec for: #pharo do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.21';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.12';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.17';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.11';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.375';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.194';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.17';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.12';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.25';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-SSO-OAuth1-Core' with: 'Zinc-SSO-OAuth1-Core-SvenVanCaekenberghe.13';
			package: 'Zinc-SSO-OAuth2-Core' with: 'Zinc-SSO-OAuth2-Core-JanVanDeSandt.16';
			package: 'Zinc-SSO-OpenID-Core' with: 'Zinc-SSO-OpenID-Core-JanVanDeSandt.6';
			package: 'Zinc-SSO-Demo' with: 'Zinc-SSO-Demo-SvenVanCaekenberghe.5';
			package: 'Zinc-SSO-OAuth1-Tests' with: 'Zinc-SSO-OAuth1-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-SSO-OpenID-Tests' with: 'Zinc-SSO-OpenID-Tests-JanVanDeSandt.3';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.9';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.27';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.30';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.12';
			package: 'Zinc-Seaside' with: 'Zinc-Seaside-SvenVanCaekenberghe.40' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.5';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.9' ]! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'FrancoisStephany 12/12/2011 12:02'!
version14: spec
	<version: '1.4' imports: #('1.4-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'release'.
		spec description: 'update to latest set of packages.'.
		spec author: 'FrancoisStephany'.
		spec timestamp: '12/12/2011 11:52'.
		spec 
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.227';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.118';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.15';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.5';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.10';
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-StephaneDucasse.2';
			package: 'Zodiac' with: 'Zodiac-Core-SvenVanCaekenberghe.16'. ].

	spec for: #'gemstone' do: [
		spec blessing: #'release'.
		spec 
			package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
			package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.14';
			package: 'SocketStream' with: 'SocketStream-PaulDeBruicker.12'. ].
! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SvenVanCaekenberghe 5/28/2013 20:45'!
version24: spec
	<version: '2.4' imports: #('2.3-baseline')>
	spec for: #common do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.16';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.14';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.9';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.365';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.187';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.17';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.10';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.25';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-SSO-OAuth1-Core' with: 'Zinc-SSO-OAuth1-Core-SvenVanCaekenberghe.12';
			package: 'Zinc-SSO-OAuth2-Core' with: 'Zinc-SSO-OAuth2-Core-JanVanDeSandt.13';
			package: 'Zinc-SSO-OpenID-Core' with: 'Zinc-SSO-OpenID-Core-JanVanDeSandt.6';
			package: 'Zinc-SSO-Demo' with: 'Zinc-SSO-Demo-SvenVanCaekenberghe.4';
			package: 'Zinc-SSO-OAuth1-Tests' with: 'Zinc-SSO-OAuth1-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-SSO-OpenID-Tests' with: 'Zinc-SSO-OpenID-Tests-JanVanDeSandt.3';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.9';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.27';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.29';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.12' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.5';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.9' ].
	spec for: #gemstone do: [ 
		spec blessing: #release.
		spec
			package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
			package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.14';
			package: 'SocketStream' with: 'SocketStream-PaulDeBruicker.12' ]
! !

!ConfigurationOfZincHTTPComponents methodsFor: 'baselines' stamp: 'SvenVanCaekenberghe 10/24/2014 09:34'!
baseline25: spec
	<version: '2.5-baseline'>
	spec for: #pharo do: [ 
		spec
			blessing: #baseline;
			description: 'Baseline for Zinc HTTP Components, a framework to deal with HTTP networking';
			author: 'SvenVanCaekenberghe'.
		spec project: 'XML Support' with: [
			spec
				className: 'ConfigurationOfXMLSupport';
				versionString: #'stable';
				repository: 'http://www.squeaksource.com/MetacelloRepository' ].
		spec project: 'Neo JSON' with: [
			spec
				className: 'ConfigurationOfNeoJSON';
				versionString: #'stable';
				repository: 'http://mc.stfx.eu/Neo' ].
		spec package: 'Zodiac-Core' with: [ spec repository: 'http://mc.stfx.eu/Zodiac' ].
		spec package: 'Zodiac-Tests' with: [ spec repository: 'http://mc.stfx.eu/Zodiac' ].
		spec
			package: 'Zinc-Character-Encoding-Core';
			package: 'Zinc-Character-Encoding-Tests' with: [ spec requires: 'Zinc-Character-Encoding-Core' ];
			package: 'Zinc-Resource-Meta-Core' with: [ spec requires: 'Zinc-Character-Encoding-Core' ];
			package: 'Zinc-Resource-Meta-Tests' with: [ spec requires: 'Zinc-Resource-Meta-Core' ];
			package: 'Zinc-HTTP' with: [ spec requires: #( 'Zinc-Character-Encoding-Core' 'Zinc-Resource-Meta-Core' ) ];
			package: 'Zinc-Patch-HTTPSocket' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-AWS' with: [ spec requires: #( 'Zinc-HTTP' 'XML Support' ) ];
			package: 'Zinc-REST' with: [ spec requires: #( 'Zinc-HTTP' 'Neo JSON' ) ];
			package: 'Zinc-Zodiac' with: [ spec requires: #( 'Zinc-HTTP' 'Zodiac-Core' 'Zodiac-Tests' ) ];
			package: 'Zinc-WebSocket-Core' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-WebSocket-Tests' with: [ spec requires: 'Zinc-WebSocket-Core' ];
			package: 'Zinc-SSO-OAuth1-Core' with: [ spec requires: #( 'Zinc-HTTP' 'Neo JSON' ) ];
			package: 'Zinc-SSO-OAuth2-Core' with: [ spec requires: #( 'Zinc-HTTP' 'Neo JSON' ) ];
			package: 'Zinc-SSO-OpenID-Core' with: [ spec requires: #( 'Zinc-HTTP' 'XML Support' ) ];
			package: 'Zinc-SSO-Demo' with: [ spec requires: #( 'Zinc-SSO-OAuth1-Core' 'Zinc-SSO-OAuth2-Core' 'Zinc-SSO-OpenID-Core' ) ];
			package: 'Zinc-SSO-OAuth1-Tests' with: [ spec requires: #( 'Zinc-SSO-OAuth1-Core' ) ];
			package: 'Zinc-SSO-OpenID-Tests' with: [ spec requires: #( 'Zinc-SSO-OpenID-Core' ) ];
			package: 'Zinc-WebDAV' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-WWS-Server' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-WWS-Client' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-Tests' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-Seaside'. "For now, no dependence on Seaside itself"
		spec
			group: 'default' with: #('Core');
			group: 'Core' with: #('Zinc-HTTP');
			group: 'Tests' with: #('Zinc-Tests' 'Zinc-Character-Encoding-Tests' 'Zinc-Resource-Meta-Tests');
			group: 'Character-Encoding' with: #('Zinc-Character-Encoding-Core' 'Zinc-Character-Encoding-Tests');
			group: 'Resource-Meta' with: #('Zinc-Resource-Meta-Core' 'Zinc-Resource-Meta-Tests');
			group: 'Zodiac' with: #('Zinc-Zodiac');
			group: 'AWS' with: #('Zinc-AWS');
			group: 'WebDAV' with: #('Zinc-WebDAV');
			group: 'WebSocket' with: #('Zinc-WebSocket-Core' 'Zinc-WebSocket-Tests');
			group: 'SSO-OAuth1' with: #('Zinc-SSO-OAuth1-Core' 'Zinc-SSO-OAuth1-Tests');
			group: 'SSO-OAuth2' with: #('Zinc-SSO-OAuth2-Core');
			group: 'SSO-OpenID' with: #('Zinc-SSO-OpenID-Core' 'Zinc-SSO-OpenID-Tests');
			group: 'SSO-Demo' with: #('Zinc-SSO-OAuth1-Core' 'Zinc-SSO-OAuth2-Core' 'Zinc-SSO-OpenID-Core');
			group: 'SSO' with: #('SSO-OAuth1' 'SSO-OAuth2' 'SSO-OpenID' 'SSO-Demo' 'Zinc-SSO-Demo');
			group: 'WWS' with: #('Zinc-WWS-Server' 'Zinc-WWS-Client');
			group: 'REST' with: #('Zinc-REST');
			group: 'Patch-HTTPSocket' with: #('Zinc-Patch-HTTPSocket');
			group: 'Seaside' with: #('Zinc-Seaside') ].
		spec for: #squeakCommon do:[spec repository: 'http://mc.stfx.eu/ZincHTTPComponents'].
	spec for: #'pharo1.x' do: [ 
		spec
			package: 'Zinc-FileSystem-Legacy';
			package: 'Zinc-Pharo-Forward-Compatibility';
			package: 'Zinc-HTTP' with: [ spec requires: #('Zinc-FileSystem-Legacy' 'Zinc-Pharo-Forward-Compatibility') ] ].
	spec for: #'pharo2.x' do: [
		spec
			package: 'Zinc-FileSystem';
			package: 'Zinc-HTTP' with: [ spec requires: 'Zinc-FileSystem' ];
			package: 'Zinc-Resource-Meta-FileSystem' with: [ spec requires: 'Zinc-HTTP' ] ]
! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SvenVanCaekenberghe 2/24/2015 23:49'!
version261: spec
	<version: '2.6.1' imports: #('2.6-baseline')>
	spec for: #pharo do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.37';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.22';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.47';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.32';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.422';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.221';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.17';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.16';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.28';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-SSO-OAuth1-Core' with: 'Zinc-SSO-OAuth1-Core-SvenVanCaekenberghe.13';
			package: 'Zinc-SSO-OAuth2-Core' with: 'Zinc-SSO-OAuth2-Core-JanVanDeSandt.17';
			package: 'Zinc-SSO-OpenID-Core' with: 'Zinc-SSO-OpenID-Core-JanVanDeSandt.6';
			package: 'Zinc-SSO-Demo' with: 'Zinc-SSO-Demo-SvenVanCaekenberghe.5';
			package: 'Zinc-SSO-OAuth1-Tests' with: 'Zinc-SSO-OAuth1-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-SSO-OpenID-Tests' with: 'Zinc-SSO-OpenID-Tests-JanVanDeSandt.3';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-PhilippeBack.3';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.10';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.34';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.35';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.12';
			package: 'Zinc-Seaside' with: 'Zinc-Seaside-JohanBrichau.43' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.5';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.10';
			package: 'Zinc-pharo2-forward-compatibility' with: 'Zinc-pharo2-forward-compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo3.x' do: [ 
		spec 
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.10' ]! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SvenVanCaekenberghe 9/12/2012 15:42'!
version182: spec
	<version: '1.8.2' imports: #('1.8-baseline')>
	spec for: #common do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.300';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.155';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.15';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.5';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.19';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.8';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.18';
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.26' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.3';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.6' ].
	spec for: #gemstone do: [ 
		spec blessing: #release.
		spec
			package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
			package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.14';
			package: 'SocketStream' with: 'SocketStream-PaulDeBruicker.12' ]
! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SvenVanCaekenberghe 2/1/2013 20:06'!
version232: spec
	<version: '2.3.2' imports: #('2.3-baseline')>
	spec for: #common do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.5';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.3';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.9';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.6';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.343';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.176';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.16';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.10';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.25';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-SSO-OAuth1-Core' with: 'Zinc-SSO-OAuth1-Core-SvenVanCaekenberghe.12';
			package: 'Zinc-SSO-OAuth2-Core' with: 'Zinc-SSO-OAuth2-Core-JanVanDeSandt.13';
			package: 'Zinc-SSO-OpenID-Core' with: 'Zinc-SSO-OpenID-Core-JanVanDeSandt.6';
			package: 'Zinc-SSO-Demo' with: 'Zinc-SSO-Demo-SvenVanCaekenberghe.4';
			package: 'Zinc-SSO-OAuth1-Tests' with: 'Zinc-SSO-OAuth1-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-SSO-OpenID-Tests' with: 'Zinc-SSO-OpenID-Tests-JanVanDeSandt.3';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.8';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.24';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.27';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.10' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.5';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.9' ].
	spec for: #gemstone do: [ 
		spec blessing: #release.
		spec
			package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
			package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.14';
			package: 'SocketStream' with: 'SocketStream-PaulDeBruicker.12' ]
! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SvenVanCaekenberghe 2/23/2015 16:15'!
version256: spec
	<version: '2.5.6' imports: #('2.5-baseline')>
	spec for: #pharo do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.37';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.22';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.47';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.32';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.422';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.221';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.17';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.16';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.28';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-SSO-OAuth1-Core' with: 'Zinc-SSO-OAuth1-Core-SvenVanCaekenberghe.13';
			package: 'Zinc-SSO-OAuth2-Core' with: 'Zinc-SSO-OAuth2-Core-JanVanDeSandt.17';
			package: 'Zinc-SSO-OpenID-Core' with: 'Zinc-SSO-OpenID-Core-JanVanDeSandt.6';
			package: 'Zinc-SSO-Demo' with: 'Zinc-SSO-Demo-SvenVanCaekenberghe.5';
			package: 'Zinc-SSO-OAuth1-Tests' with: 'Zinc-SSO-OAuth1-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-SSO-OpenID-Tests' with: 'Zinc-SSO-OpenID-Tests-JanVanDeSandt.3';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-PhilippeBack.3';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.10';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.34';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.35';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.12';
			package: 'Zinc-Seaside' with: 'Zinc-Seaside-JohanBrichau.43' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.5';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.10' ].! !

!ConfigurationOfZincHTTPComponents methodsFor: 'baselines' stamp: 'SvenVanCaekenberghe 10/7/2014 13:33'!
baseline21: spec
	<version: '2.1-baseline'>
	spec for: #common do: [ 
		spec
			blessing: #baseline;
			description: 'Baseline for Zinc HTTP Components, a framework to deal with HTTP networking';
			author: 'SvenVanCaekenberghe';
			repository: 'http://mc.stfx.eu/ZincHTTPComponents'.
		spec project: 'XML Support' with: [
			spec
				className: 'ConfigurationOfXMLSupport';
				versionString: #'stable';
				repository: 'http://www.squeaksource.com/MetacelloRepository' ].
		spec project: 'Neo JSON' with: [
			spec
				className: 'ConfigurationOfNeoJSON';
				versionString: #'stable';
				repository: 'http://mc.stfx.eu/Neo' ].
		spec package: 'Zodiac-Core' with: [ spec repository: 'http://mc.stfx.eu/Zodiac' ].
		spec package: 'Zodiac-Tests' with: [ spec repository: 'http://mc.stfx.eu/Zodiac' ].
		spec
			package: 'Zinc-Character-Encoding-Core';
			package: 'Zinc-Character-Encoding-Tests' with: [ spec requires: 'Zinc-Character-Encoding-Core' ];
			package: 'Zinc-Resource-Meta-Core' with: [ spec requires: 'Zinc-Character-Encoding-Core' ];
			package: 'Zinc-Resource-Meta-Tests' with: [ spec requires: 'Zinc-Resource-Meta-Core' ];
			package: 'Zinc-HTTP' with: [ spec requires: #( 'Zinc-Character-Encoding-Core' 'Zinc-Resource-Meta-Core' ) ];
			package: 'Zinc-Patch-HTTPSocket' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-AWS' with: [ spec requires: #('Zinc-HTTP' 'XML Support') ];
			package: 'Zinc-REST' with: [ spec requires: #('Zinc-HTTP' 'Neo JSON') ];
			package: 'Zinc-Zodiac' with: [ spec requires: #('Zinc-HTTP' 'Zodiac-Core' 'Zodiac-Tests') ];
			package: 'Zinc-WebSocket-Core' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-WebSocket-Tests' with: [ spec requires: 'Zinc-WebSocket-Core' ];
			package: 'Zinc-WebDAV' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-WWS-Server' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-WWS-Client' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-Tests' with: [ spec requires: 'Zinc-HTTP' ].
		spec
			group: 'default' with: #('Core');
			group: 'Core' with: #('Zinc-HTTP');
			group: 'Tests' with: #('Zinc-Tests');
			group: 'Character-Encoding' with: #('Zinc-Character-Encoding-Core' 'Zinc-Character-Encoding-Tests');
			group: 'Resource-Meta' with: #('Zinc-Resource-Meta-Core' 'Zinc-Resource-Meta-Tests');
			group: 'Zodiac' with: #('Zinc-Zodiac');
			group: 'AWS' with: #('Zinc-AWS');
			group: 'WebDAV' with: #('Zinc-WebDAV');
			group: 'WebSocket' with: #('Zinc-WebSocket-Core' 'Zinc-WebSocket-Tests');
			group: 'WWS' with: #('Zinc-WWS-Server' 'Zinc-WWS-Client');
			group: 'REST' with: #('Zinc-REST');
			group: 'Patch-HTTPSocket' with: #('Zinc-Patch-HTTPSocket') ].
	spec for: #'pharo1.x' do: [ 
		spec
			package: 'Zinc-FileSystem-Legacy';
			package: 'Zinc-Pharo-Forward-Compatibility';
			package: 'Zinc-HTTP' with: [ spec requires: #('Zinc-FileSystem-Legacy' 'Zinc-Pharo-Forward-Compatibility') ] ].
	spec for: #'pharo2.x' do: [
		spec
			package: 'Zinc-FileSystem';
			package: 'Zinc-HTTP' with: [ spec requires: 'Zinc-FileSystem' ] ].
	spec for: #gemstone do: [ 
		spec
			repository: 'http://seaside.gemstone.com/ss/ZincHTTPComponents';
			package: 'Zinc-HTTP' with: [ spec includes: #('Zinc-Gemstone') ];
			package: 'SocketStream' with: [ spec repository: 'http://seaside.gemstone.com/ss/PharoCompat' ];
			package: 'Zinc-GemstonePreliminary' with: [ spec requires: #('SocketStream') ];
			package: 'Zinc-HTTP' with: [ spec requires: #('Zinc-GemstonePreliminary') ];
			package: 'Zinc-Gemstone' with: [ spec requires: #('Zinc-HTTP') ];
			package: 'Zinc-Tests' with: [ spec requires: 'Zinc-Gemstone' ] ]! !

!ConfigurationOfZincHTTPComponents methodsFor: 'baselines' stamp: 'SeanDeNigris 6/7/2012 00:20'!
baseline15: spec
	<version: '1.5-baseline'>
	spec
		for: #common
		do: [ 
			spec
				blessing: #baseline;
				description: 'Baseline for Zinc HTTP Components, a framework to deal with the HTTP networking';
				author: 'PaulDeBruicker';
				timestamp: '4/4/2012 09:12';
				repository: 'http://www.squeaksource.com/ZincHTTPComponents'.
			spec package: 'Zodiac-Core' with: [ spec repository: 'http://www.squeaksource.com/Zodiac' ].
			spec
				package: 'Zinc-HTTP';
				package: 'Zinc-Patch-HTTPSocket'
					with: [ 
							spec
								repository: 'http://ss3.gemstone.com/ss/pharo';
								requires: 'Zinc-HTTP' ];
				package: 'Zinc-AWS' with: [ spec requires: 'Zinc-HTTP' ];
				package: 'Zinc-REST' with: [ spec requires: 'Zinc-HTTP' ];
				package: 'Zinc-Zodiac' with: [ spec requires: #('Zinc-HTTP' 'Zodiac-Core') ];
				package: 'Zinc-WebDAV' with: [ spec requires: 'Zinc-HTTP' ];
				package: 'Zinc-WWS-Server' with: [ spec requires: 'Zinc-HTTP' ];
				package: 'Zinc-WWS-Client' with: [ spec requires: 'Zinc-HTTP' ];
				package: 'Zinc-Tests' with: [ spec requires: 'Zinc-HTTP' ].
			spec
				group: 'default' with: #('Core');
				group: 'Core' with: #('Zinc-HTTP');
				group: 'Tests' with: #('Zinc-Tests');
				group: 'AWS' with: #('Zinc-AWS');
				group: 'WebDAV' with: #('Zinc-WebDAV');
				group: 'WWS' with: #('Zinc-WWS-Server' 'Zinc-WWS-Client');
				group: 'REST' with: #('Zinc-REST');
				group: 'Patch-HTTPSocket' with: #('Zinc-Patch-HTTPSocket') ].
	spec
		for: #gemstone
		do: [ 
			spec repository: 'http://seaside.gemstone.com/ss/ZincHTTPComponents'.
			spec
				package: 'Zinc-HTTP' with: [ spec includes: #('Zinc-Gemstone') ];
				package: 'SocketStream' with: [ spec repository: 'http://seaside.gemstone.com/ss/PharoCompat' ];
				package: 'Zinc-GemstonePreliminary' with: [ spec requires: #('SocketStream') ];
				package: 'Zinc-HTTP' with: [ spec requires: #('Zinc-GemstonePreliminary') ];
				package: 'Zinc-Gemstone' with: [ spec requires: #('Zinc-HTTP') ];
				package: 'Zinc-Tests' with: [ spec requires: 'Zinc-Gemstone' ] ]! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SvenVanCaekenberghe 9/4/2012 09:51'!
version18: spec
	<version: '1.8' imports: #('1.8-baseline')>
	spec for: #common do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.297';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.153';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.15';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.5';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.11';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.5';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.7';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.18';
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.25' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.3';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.6' ].
	spec for: #gemstone do: [ 
		spec blessing: #release.
		spec
			package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
			package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.14';
			package: 'SocketStream' with: 'SocketStream-PaulDeBruicker.12' ]
! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SvenVanCaekenberghe 12/31/2012 17:58'!
version212: spec
	<version: '2.1.2' imports: #('2.1-baseline')>
	spec for: #common do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.2';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.3';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.3';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.333';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.172';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.16';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.8';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.23';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.8';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.23';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.27';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.10' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.3';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.7' ].
	spec for: #gemstone do: [ 
		spec blessing: #release.
		spec
			package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
			package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.14';
			package: 'SocketStream' with: 'SocketStream-PaulDeBruicker.12' ]
! !

!ConfigurationOfZincHTTPComponents methodsFor: 'baselines' stamp: 'dkh 9/1/2011 17:11'!
baseline10: spec 
	<version: '1.0-baseline'>
	
	spec for: #common do: [
		spec 
			blessing: #baseline;
			description: 'Baseline for Zinc HTTP Components, a framework to deal with the HTTP networking';
			author: 'SvenVanCaekenberghe';
			repository: 'http://www.squeaksource.com/ZincHTTPComponents'.	
		spec project: 'Seaside30' with: [
				spec
					className: 'ConfigurationOfSeaside30';
					repository: 'http://www.squeaksource.com/MetacelloRepository' ].
		spec 
			package: 'Zinc-HTTP';
			package: 'Zinc-Patch-HTTPSocket' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-AWS' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-Tests' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-Seaside' with: [ spec requires: #('Zinc-HTTP' 'Seaside30') ].
		spec
			group: 'default' with: #('Core');
			group: 'Core' with: #('Zinc-HTTP');
			group: 'Tests' with: #('Zinc-Tests');
			group: 'Seaside' with: #('Zinc-Seaside');
			group: 'Patch-HTTPSocket' with: #('Zinc-Patch-HTTPSocket') ].
		
	spec for: #gemstone do:[
		spec repository: 'http://seaside.gemstone.com/ss/ZincHTTPComponents'.  
		spec
			package:'SocketStream' with:[spec repository: 'http://seaside.gemstone.com/ss/PharoCompat' ];
			package:'Seaside-GemStone-Adaptors-Zinc' with:[spec requires: #('Zinc-Gemstone' 'Zinc-Seaside')] ;
			package:'Zinc-GemstonePreliminary' with:[spec requires: #('SocketStream')  ];
			package:'Zinc-HTTP' with:[spec requires: #('Zinc-GemstonePreliminary')  ];
			package:'Zinc-Gemstone' with:[spec requires: #('Zinc-HTTP')  ];
			package: 'Zinc-Tests' with: [ spec requires: 'Zinc-Gemstone' ].
		spec
			group: 'default' with: #('Core');
			group: 'Core' with: #('Zinc-Gemstone');
			group: 'Tests' with: #('Zinc-Tests');
			group: 'Seaside' with: #('Seaside-GemStone-Adaptors-Zinc').
		
		]! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SvenVanCaekenberghe 1/31/2013 22:24'!
version231: spec
	<version: '2.3.1' imports: #('2.3-baseline')>
	spec for: #common do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.5';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.3';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.9';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.6';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.342';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.176';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.16';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.10';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.25';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-SSO-OAuth1-Core' with: 'Zinc-SSO-OAuth1-Core-SvenVanCaekenberghe.12';
			package: 'Zinc-SSO-OAuth2-Core' with: 'Zinc-SSO-OAuth2-Core-JanVanDeSandt.13';
			package: 'Zinc-SSO-OpenID-Core' with: 'Zinc-SSO-OpenID-Core-JanVanDeSandt.6';
			package: 'Zinc-SSO-Demo' with: 'Zinc-SSO-Demo-SvenVanCaekenberghe.4';
			package: 'Zinc-SSO-OAuth1-Tests' with: 'Zinc-SSO-OAuth1-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-SSO-OpenID-Tests' with: 'Zinc-SSO-OpenID-Tests-JanVanDeSandt.3';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.8';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.24';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.27';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.10' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.5';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.9' ].
	spec for: #gemstone do: [ 
		spec blessing: #release.
		spec
			package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
			package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.14';
			package: 'SocketStream' with: 'SocketStream-PaulDeBruicker.12' ]
! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'JohanBrichau 7/9/2014 20:55'!
version249: spec
	<version: '2.4.9' imports: #('2.4-baseline')>
	spec for: #pharo do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.30';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.17';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.32';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.20';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.392';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.204';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.17';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.13';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.26';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-SSO-OAuth1-Core' with: 'Zinc-SSO-OAuth1-Core-SvenVanCaekenberghe.13';
			package: 'Zinc-SSO-OAuth2-Core' with: 'Zinc-SSO-OAuth2-Core-JanVanDeSandt.16';
			package: 'Zinc-SSO-OpenID-Core' with: 'Zinc-SSO-OpenID-Core-JanVanDeSandt.6';
			package: 'Zinc-SSO-Demo' with: 'Zinc-SSO-Demo-SvenVanCaekenberghe.5';
			package: 'Zinc-SSO-OAuth1-Tests' with: 'Zinc-SSO-OAuth1-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-SSO-OpenID-Tests' with: 'Zinc-SSO-OpenID-Tests-JanVanDeSandt.3';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.10';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.29';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.30';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.12';
			package: 'Zinc-Seaside' with: 'Zinc-Seaside-SvenVanCaekenberghe.41' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.5';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.10' ].! !

!ConfigurationOfZincHTTPComponents methodsFor: 'baselines' stamp: 'SvenVanCaekenberghe 10/7/2014 13:33'!
baseline23: spec
	<version: '2.3-baseline'>
	spec for: #common do: [ 
		spec
			blessing: #baseline;
			description: 'Baseline for Zinc HTTP Components, a framework to deal with HTTP networking';
			author: 'SvenVanCaekenberghe';
			repository: 'http://mc.stfx.eu/ZincHTTPComponents'.
		spec project: 'XML Support' with: [
			spec
				className: 'ConfigurationOfXMLSupport';
				versionString: #'stable';
				repository: 'http://www.squeaksource.com/MetacelloRepository' ].
		spec project: 'Neo JSON' with: [
			spec
				className: 'ConfigurationOfNeoJSON';
				versionString: #'stable';
				repository: 'http://mc.stfx.eu/Neo' ].
		spec package: 'Zodiac-Core' with: [ spec repository: 'http://mc.stfx.eu/Zodiac' ].
		spec package: 'Zodiac-Tests' with: [ spec repository: 'http://mc.stfx.eu/Zodiac' ].
		spec
			package: 'Zinc-Character-Encoding-Core';
			package: 'Zinc-Character-Encoding-Tests' with: [ spec requires: 'Zinc-Character-Encoding-Core' ];
			package: 'Zinc-Resource-Meta-Core' with: [ spec requires: 'Zinc-Character-Encoding-Core' ];
			package: 'Zinc-Resource-Meta-Tests' with: [ spec requires: 'Zinc-Resource-Meta-Core' ];
			package: 'Zinc-HTTP' with: [ spec requires: #( 'Zinc-Character-Encoding-Core' 'Zinc-Resource-Meta-Core' ) ];
			package: 'Zinc-Patch-HTTPSocket' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-AWS' with: [ spec requires: #( 'Zinc-HTTP' 'XML Support' ) ];
			package: 'Zinc-REST' with: [ spec requires: #( 'Zinc-HTTP' 'Neo JSON' ) ];
			package: 'Zinc-Zodiac' with: [ spec requires: #( 'Zinc-HTTP' 'Zodiac-Core' 'Zodiac-Tests' ) ];
			package: 'Zinc-WebSocket-Core' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-WebSocket-Tests' with: [ spec requires: 'Zinc-WebSocket-Core' ];
			package: 'Zinc-SSO-OAuth1-Core' with: [ spec requires: #( 'Zinc-HTTP' 'Neo JSON' ) ];
			package: 'Zinc-SSO-OAuth2-Core' with: [ spec requires: #( 'Zinc-HTTP' 'Neo JSON' ) ];
			package: 'Zinc-SSO-OpenID-Core' with: [ spec requires: #( 'Zinc-HTTP' 'XML Support' ) ];
			package: 'Zinc-SSO-Demo' with: [ spec requires: #( 'Zinc-SSO-OAuth1-Core' 'Zinc-SSO-OAuth2-Core' 'Zinc-SSO-OpenID-Core' ) ];
			package: 'Zinc-SSO-OAuth1-Tests' with: [ spec requires: #( 'Zinc-SSO-OAuth1-Core' ) ];
			package: 'Zinc-SSO-OpenID-Tests' with: [ spec requires: #( 'Zinc-SSO-OpenID-Core' ) ];
			package: 'Zinc-WebDAV' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-WWS-Server' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-WWS-Client' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-Tests' with: [ spec requires: 'Zinc-HTTP' ].
		spec
			group: 'default' with: #('Core');
			group: 'Core' with: #('Zinc-HTTP');
			group: 'Tests' with: #('Zinc-Tests' 'Zinc-Character-Encoding-Tests' 'Zinc-Resource-Meta-Tests');
			group: 'Character-Encoding' with: #('Zinc-Character-Encoding-Core' 'Zinc-Character-Encoding-Tests');
			group: 'Resource-Meta' with: #('Zinc-Resource-Meta-Core' 'Zinc-Resource-Meta-Tests');
			group: 'Zodiac' with: #('Zinc-Zodiac');
			group: 'AWS' with: #('Zinc-AWS');
			group: 'WebDAV' with: #('Zinc-WebDAV');
			group: 'WebSocket' with: #('Zinc-WebSocket-Core' 'Zinc-WebSocket-Tests');
			group: 'SSO-OAuth1' with: #('Zinc-SSO-OAuth1-Core' 'Zinc-SSO-OAuth1-Tests');
			group: 'SSO-OAuth2' with: #('Zinc-SSO-OAuth2-Core');
			group: 'SSO-OpenID' with: #('Zinc-SSO-OpenID-Core' 'Zinc-SSO-OpenID-Tests');
			group: 'SSO-Demo' with: #('Zinc-SSO-OAuth1-Core' 'Zinc-SSO-OAuth2-Core' 'Zinc-SSO-OpenID-Core');
			group: 'SSO' with: #('SSO-OAuth1' 'SSO-OAuth2' 'SSO-OpenID' 'SSO-Demo' 'Zinc-SSO-Demo');
			group: 'WWS' with: #('Zinc-WWS-Server' 'Zinc-WWS-Client');
			group: 'REST' with: #('Zinc-REST');
			group: 'Patch-HTTPSocket' with: #('Zinc-Patch-HTTPSocket') ].
	spec for: #'pharo1.x' do: [ 
		spec
			package: 'Zinc-FileSystem-Legacy';
			package: 'Zinc-Pharo-Forward-Compatibility';
			package: 'Zinc-HTTP' with: [ spec requires: #('Zinc-FileSystem-Legacy' 'Zinc-Pharo-Forward-Compatibility') ] ].
	spec for: #'pharo2.x' do: [
		spec
			package: 'Zinc-FileSystem';
			package: 'Zinc-HTTP' with: [ spec requires: 'Zinc-FileSystem' ] ].
	spec for: #gemstone do: [ 
		spec
			repository: 'http://seaside.gemstone.com/ss/ZincHTTPComponents';
			package: 'Zinc-HTTP' with: [ spec includes: #('Zinc-Gemstone') ];
			package: 'SocketStream' with: [ spec repository: 'http://seaside.gemstone.com/ss/PharoCompat' ];
			package: 'Zinc-GemstonePreliminary' with: [ spec requires: #('SocketStream') ];
			package: 'Zinc-HTTP' with: [ spec requires: #('Zinc-GemstonePreliminary') ];
			package: 'Zinc-Gemstone' with: [ spec requires: #('Zinc-HTTP') ];
			package: 'Zinc-Tests' with: [ spec requires: 'Zinc-Gemstone' ] ]! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SvenVanCaekenberghe 10/7/2014 14:22'!
version255: spec
	<version: '2.5.5' imports: #('2.4-baseline')>
	spec for: #pharo do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.36';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.21';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.39';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.27';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.411';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.218';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.17';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.16';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.28';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-SSO-OAuth1-Core' with: 'Zinc-SSO-OAuth1-Core-SvenVanCaekenberghe.13';
			package: 'Zinc-SSO-OAuth2-Core' with: 'Zinc-SSO-OAuth2-Core-JanVanDeSandt.17';
			package: 'Zinc-SSO-OpenID-Core' with: 'Zinc-SSO-OpenID-Core-JanVanDeSandt.6';
			package: 'Zinc-SSO-Demo' with: 'Zinc-SSO-Demo-SvenVanCaekenberghe.5';
			package: 'Zinc-SSO-OAuth1-Tests' with: 'Zinc-SSO-OAuth1-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-SSO-OpenID-Tests' with: 'Zinc-SSO-OpenID-Tests-JanVanDeSandt.3';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-PhilippeBack.3';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.10';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.34';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.30';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.12';
			package: 'Zinc-Seaside' with: 'Zinc-Seaside-pmm.42' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.5';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.10' ].! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SvenVanCaekenberghe 9/4/2012 16:51'!
version181: spec
	<version: '1.8.1' imports: #('1.8-baseline')>
	spec for: #common do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.297';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.153';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.15';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.5';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.11';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.5';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.8';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.18';
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.25' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.3';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.6' ].
	spec for: #gemstone do: [ 
		spec blessing: #release.
		spec
			package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
			package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.14';
			package: 'SocketStream' with: 'SocketStream-PaulDeBruicker.12' ]
! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'PaulDeBruicker 10/25/2011 17:17'!
version13: spec
	<version: '1.3' imports: #('1.3-baseline' )>

	spec for: #'common' do: [
		spec blessing: #'release'.
		spec description: '-added Zinc-REST - update to latest set of packages.'.
		spec author: 'PaulDeBruicker'.
		spec timestamp: '10/26/2011 17:15'.
		spec 
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.214';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.110';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.9';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.5';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.8';
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-StephaneDucasse.2';
			package: 'Zodiac' with: 'Zodiac-Core-SvenVanCaekenberghe.11'. ].

	spec for: #'gemstone' do: [
		spec blessing: #'release'.
		spec 
			package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
			package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.14';
			package: 'SocketStream' with: 'SocketStream-PaulDeBruicker.12'. ].
! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SvenVanCaekenberghe 9/22/2014 10:05'!
version253: spec
	<version: '2.5.3' imports: #('2.4-baseline')>
	spec for: #pharo do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.35';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.21';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.38';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.25';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.410';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.217';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.17';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.16';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.28';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-SSO-OAuth1-Core' with: 'Zinc-SSO-OAuth1-Core-SvenVanCaekenberghe.13';
			package: 'Zinc-SSO-OAuth2-Core' with: 'Zinc-SSO-OAuth2-Core-JanVanDeSandt.17';
			package: 'Zinc-SSO-OpenID-Core' with: 'Zinc-SSO-OpenID-Core-JanVanDeSandt.6';
			package: 'Zinc-SSO-Demo' with: 'Zinc-SSO-Demo-SvenVanCaekenberghe.5';
			package: 'Zinc-SSO-OAuth1-Tests' with: 'Zinc-SSO-OAuth1-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-SSO-OpenID-Tests' with: 'Zinc-SSO-OpenID-Tests-JanVanDeSandt.3';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-PhilippeBack.3';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.10';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.34';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.30';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.12';
			package: 'Zinc-Seaside' with: 'Zinc-Seaside-pmm.42' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.5';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.10' ].! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'JohanBrichau 7/9/2014 20:55'!
version251: spec
	<version: '2.5.1' imports: #('2.4-baseline')>
	spec for: #pharo do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.32';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.19';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.36';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.24';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.397';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.209';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.17';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.13';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.26';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-SSO-OAuth1-Core' with: 'Zinc-SSO-OAuth1-Core-SvenVanCaekenberghe.13';
			package: 'Zinc-SSO-OAuth2-Core' with: 'Zinc-SSO-OAuth2-Core-JanVanDeSandt.16';
			package: 'Zinc-SSO-OpenID-Core' with: 'Zinc-SSO-OpenID-Core-JanVanDeSandt.6';
			package: 'Zinc-SSO-Demo' with: 'Zinc-SSO-Demo-SvenVanCaekenberghe.5';
			package: 'Zinc-SSO-OAuth1-Tests' with: 'Zinc-SSO-OAuth1-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-SSO-OpenID-Tests' with: 'Zinc-SSO-OpenID-Tests-JanVanDeSandt.3';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.10';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.33';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.30';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.12';
			package: 'Zinc-Seaside' with: 'Zinc-Seaside-SvenVanCaekenberghe.41' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.5';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.10' ].! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SvenVanCaekenberghe 10/13/2012 17:54'!
version192: spec
	<version: '1.9.2' imports: #('1.9-baseline')>
	spec for: #common do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.310';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.157';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.16';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.5';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.22';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.8';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.21';
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.27' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.3';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.7' ].
	spec for: #gemstone do: [ 
		spec blessing: #release.
		spec
			package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
			package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.14';
			package: 'SocketStream' with: 'SocketStream-PaulDeBruicker.12' ]
! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'JohanBrichau 7/9/2014 20:54'!
version248: spec
	<version: '2.4.8' imports: #('2.4-baseline')>
	spec for: #pharo do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.28';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.15';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.30';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.18';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.388';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.201';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.17';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.13';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.25';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-SSO-OAuth1-Core' with: 'Zinc-SSO-OAuth1-Core-SvenVanCaekenberghe.13';
			package: 'Zinc-SSO-OAuth2-Core' with: 'Zinc-SSO-OAuth2-Core-JanVanDeSandt.16';
			package: 'Zinc-SSO-OpenID-Core' with: 'Zinc-SSO-OpenID-Core-JanVanDeSandt.6';
			package: 'Zinc-SSO-Demo' with: 'Zinc-SSO-Demo-SvenVanCaekenberghe.5';
			package: 'Zinc-SSO-OAuth1-Tests' with: 'Zinc-SSO-OAuth1-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-SSO-OpenID-Tests' with: 'Zinc-SSO-OpenID-Tests-JanVanDeSandt.3';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.10';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.29';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.30';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.12';
			package: 'Zinc-Seaside' with: 'Zinc-Seaside-SvenVanCaekenberghe.40' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.5';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.10' ].! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SvenVanCaekenberghe 10/7/2014 13:44'!
version254: spec
	<version: '2.5.4' imports: #('2.4-baseline')>
	spec for: #pharo do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.36';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.21';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.39';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.27';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.411';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.217';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.17';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.16';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.28';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-SSO-OAuth1-Core' with: 'Zinc-SSO-OAuth1-Core-SvenVanCaekenberghe.13';
			package: 'Zinc-SSO-OAuth2-Core' with: 'Zinc-SSO-OAuth2-Core-JanVanDeSandt.17';
			package: 'Zinc-SSO-OpenID-Core' with: 'Zinc-SSO-OpenID-Core-JanVanDeSandt.6';
			package: 'Zinc-SSO-Demo' with: 'Zinc-SSO-Demo-SvenVanCaekenberghe.5';
			package: 'Zinc-SSO-OAuth1-Tests' with: 'Zinc-SSO-OAuth1-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-SSO-OpenID-Tests' with: 'Zinc-SSO-OpenID-Tests-JanVanDeSandt.3';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-PhilippeBack.3';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.10';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.34';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.30';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.12';
			package: 'Zinc-Seaside' with: 'Zinc-Seaside-pmm.42' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.5';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.10' ].! !

!ConfigurationOfZincHTTPComponents methodsFor: 'baselines' stamp: 'SvenVanCaekenberghe 9/4/2012 09:35'!
baseline18: spec
	<version: '1.8-baseline'>
	spec for: #common do: [ 
		spec
			blessing: #baseline;
			description: 'Baseline for Zinc HTTP Components, a framework to deal with the HTTP networking';
			author: 'SvenVanCaekenberghe';
			repository: 'http://www.squeaksource.com/ZincHTTPComponents'.
		spec project: 'XML Support' with: [
			spec
				className: 'ConfigurationOfXMLSupport';
				versionString: #'stable';
				repository: 'http://www.squeaksource.com/MetacelloRepository' ].
		spec package: 'Zodiac-Core' with: [ 
			spec repository: 'http://www.squeaksource.com/Zodiac' ].
		spec
			package: 'Zinc-HTTP';
			package: 'Zinc-Patch-HTTPSocket' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-AWS' with: [ spec requires: #('Zinc-HTTP' 'XML Support') ];
			package: 'Zinc-REST' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-Zodiac' with: [ spec requires: #('Zinc-HTTP' 'Zodiac-Core') ];
			package: 'Zinc-WebSocket-Core' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-WebSocket-Tests' with: [ spec requires: 'Zinc-WebSocket-Core' ];
			package: 'Zinc-WebDAV' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-WWS-Server' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-WWS-Client' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-Tests' with: [ spec requires: 'Zinc-HTTP' ].
		spec
			group: 'default' with: #('Core');
			group: 'Core' with: #('Zinc-HTTP');
			group: 'Tests' with: #('Zinc-Tests');
			group: 'AWS' with: #('Zinc-AWS');
			group: 'WebDAV' with: #('Zinc-WebDAV');
			group: 'WebSocket' with: #('Zinc-WebSocket-Core' 'Zinc-WebSocket-Tests');
			group: 'WWS' with: #('Zinc-WWS-Server' 'Zinc-WWS-Client');
			group: 'REST' with: #('Zinc-REST');
			group: 'Patch-HTTPSocket' with: #('Zinc-Patch-HTTPSocket') ].
	spec for: #'pharo1.x' do: [ 
		spec
			package: 'Zinc-FileSystem-Legacy';
			package: 'Zinc-Pharo-Forward-Compatibility';
			package: 'Zinc-HTTP' with: [ spec requires: #('Zinc-FileSystem-Legacy' 'Zinc-Pharo-Forward-Compatibility') ] ].
	spec for: #'pharo2.x' do: [
		spec
			package: 'Zinc-FileSystem';
			package: 'Zinc-HTTP' with: [ spec requires: 'Zinc-FileSystem' ] ].
	spec for: #gemstone do: [ 
		spec
			repository: 'http://seaside.gemstone.com/ss/ZincHTTPComponents';
			package: 'Zinc-HTTP' with: [ spec includes: #('Zinc-Gemstone') ];
			package: 'SocketStream' with: [ spec repository: 'http://seaside.gemstone.com/ss/PharoCompat' ];
			package: 'Zinc-GemstonePreliminary' with: [ spec requires: #('SocketStream') ];
			package: 'Zinc-HTTP' with: [ spec requires: #('Zinc-GemstonePreliminary') ];
			package: 'Zinc-Gemstone' with: [ spec requires: #('Zinc-HTTP') ];
			package: 'Zinc-Tests' with: [ spec requires: 'Zinc-Gemstone' ] ]
! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'dkh 9/1/2011 17:12'!
version11: spec 
	<version: '1.1' imports: #('1.1-baseline') >
	
	spec for: #common do: [
		spec blessing: #release.
		spec 
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.162';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.84';
			package: 'Zinc-AWS' with:'Zinc-AWS-SvenVanCaekenberghe.7';
			package: 'Zinc-Zodiac' with:'Zinc-Zodiac-SvenVanCaekenberghe.4';
			package: 'Zinc-Patch-HTTPSocket' with:'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-Seaside' with:'Zinc-Seaside-SvenVanCaekenberghe.16';
			package: 'Zodiac' with: 'Zodiac-Core-SvenVanCaekenberghe.8' ;
			project:'Seaside30' with: '3.0.5'
			].
		
	spec for: #gemstone do:[
		spec blessing: #release.
		spec 
			package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
			package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.14';
			package:'SocketStream' with:'SocketStream-PaulDeBruicker.12';
			package:'Seaside-GemStone-Adaptors-Zinc' with: 'Seaside-GemStone-Adaptors-Zinc-PaulDeBruicker.3'   		
		]! !

!ConfigurationOfZincHTTPComponents methodsFor: 'baselines' stamp: 'SvenVanCaekenberghe 10/7/2014 13:33'!
baseline24: spec
	<version: '2.4-baseline'>
	spec for: #pharo do: [ 
		spec
			blessing: #baseline;
			description: 'Baseline for Zinc HTTP Components, a framework to deal with HTTP networking';
			author: 'SvenVanCaekenberghe'.
		spec project: 'XML Support' with: [
			spec
				className: 'ConfigurationOfXMLSupport';
				versionString: #'stable';
				repository: 'http://www.squeaksource.com/MetacelloRepository' ].
		spec project: 'Neo JSON' with: [
			spec
				className: 'ConfigurationOfNeoJSON';
				versionString: #'stable';
				repository: 'http://mc.stfx.eu/Neo' ].
		spec package: 'Zodiac-Core' with: [ spec repository: 'http://mc.stfx.eu/Zodiac' ].
		spec package: 'Zodiac-Tests' with: [ spec repository: 'http://mc.stfx.eu/Zodiac' ].
		spec
			package: 'Zinc-Character-Encoding-Core';
			package: 'Zinc-Character-Encoding-Tests' with: [ spec requires: 'Zinc-Character-Encoding-Core' ];
			package: 'Zinc-Resource-Meta-Core' with: [ spec requires: 'Zinc-Character-Encoding-Core' ];
			package: 'Zinc-Resource-Meta-Tests' with: [ spec requires: 'Zinc-Resource-Meta-Core' ];
			package: 'Zinc-HTTP' with: [ spec requires: #( 'Zinc-Character-Encoding-Core' 'Zinc-Resource-Meta-Core' ) ];
			package: 'Zinc-Patch-HTTPSocket' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-AWS' with: [ spec requires: #( 'Zinc-HTTP' 'XML Support' ) ];
			package: 'Zinc-REST' with: [ spec requires: #( 'Zinc-HTTP' 'Neo JSON' ) ];
			package: 'Zinc-Zodiac' with: [ spec requires: #( 'Zinc-HTTP' 'Zodiac-Core' 'Zodiac-Tests' ) ];
			package: 'Zinc-WebSocket-Core' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-WebSocket-Tests' with: [ spec requires: 'Zinc-WebSocket-Core' ];
			package: 'Zinc-SSO-OAuth1-Core' with: [ spec requires: #( 'Zinc-HTTP' 'Neo JSON' ) ];
			package: 'Zinc-SSO-OAuth2-Core' with: [ spec requires: #( 'Zinc-HTTP' 'Neo JSON' ) ];
			package: 'Zinc-SSO-OpenID-Core' with: [ spec requires: #( 'Zinc-HTTP' 'XML Support' ) ];
			package: 'Zinc-SSO-Demo' with: [ spec requires: #( 'Zinc-SSO-OAuth1-Core' 'Zinc-SSO-OAuth2-Core' 'Zinc-SSO-OpenID-Core' ) ];
			package: 'Zinc-SSO-OAuth1-Tests' with: [ spec requires: #( 'Zinc-SSO-OAuth1-Core' ) ];
			package: 'Zinc-SSO-OpenID-Tests' with: [ spec requires: #( 'Zinc-SSO-OpenID-Core' ) ];
			package: 'Zinc-WebDAV' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-WWS-Server' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-WWS-Client' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-Tests' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-Seaside'. "For now, no dependence on Seaside itself"
		spec
			group: 'default' with: #('Core');
			group: 'Core' with: #('Zinc-HTTP');
			group: 'Tests' with: #('Zinc-Tests' 'Zinc-Character-Encoding-Tests' 'Zinc-Resource-Meta-Tests');
			group: 'Character-Encoding' with: #('Zinc-Character-Encoding-Core' 'Zinc-Character-Encoding-Tests');
			group: 'Resource-Meta' with: #('Zinc-Resource-Meta-Core' 'Zinc-Resource-Meta-Tests');
			group: 'Zodiac' with: #('Zinc-Zodiac');
			group: 'AWS' with: #('Zinc-AWS');
			group: 'WebDAV' with: #('Zinc-WebDAV');
			group: 'WebSocket' with: #('Zinc-WebSocket-Core' 'Zinc-WebSocket-Tests');
			group: 'SSO-OAuth1' with: #('Zinc-SSO-OAuth1-Core' 'Zinc-SSO-OAuth1-Tests');
			group: 'SSO-OAuth2' with: #('Zinc-SSO-OAuth2-Core');
			group: 'SSO-OpenID' with: #('Zinc-SSO-OpenID-Core' 'Zinc-SSO-OpenID-Tests');
			group: 'SSO-Demo' with: #('Zinc-SSO-OAuth1-Core' 'Zinc-SSO-OAuth2-Core' 'Zinc-SSO-OpenID-Core');
			group: 'SSO' with: #('SSO-OAuth1' 'SSO-OAuth2' 'SSO-OpenID' 'SSO-Demo' 'Zinc-SSO-Demo');
			group: 'WWS' with: #('Zinc-WWS-Server' 'Zinc-WWS-Client');
			group: 'REST' with: #('Zinc-REST');
			group: 'Patch-HTTPSocket' with: #('Zinc-Patch-HTTPSocket');
			group: 'Seaside' with: #('Zinc-Seaside') ].
		spec for: #squeakCommon do:[spec repository: 'http://mc.stfx.eu/ZincHTTPComponents'].
	spec for: #'pharo1.x' do: [ 
		spec
			package: 'Zinc-FileSystem-Legacy';
			package: 'Zinc-Pharo-Forward-Compatibility';
			package: 'Zinc-HTTP' with: [ spec requires: #('Zinc-FileSystem-Legacy' 'Zinc-Pharo-Forward-Compatibility') ] ].
	spec for: #'pharo2.x' do: [
		spec
			package: 'Zinc-FileSystem';
			package: 'Zinc-HTTP' with: [ spec requires: 'Zinc-FileSystem' ] ].
! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SvenVanCaekenberghe 10/12/2012 13:29'!
version191: spec
	<version: '1.9.1' imports: #('1.9-baseline')>
	spec for: #common do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.310';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.157';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.16';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.5';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.21';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.8';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.21';
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.27' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.3';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.7' ].
	spec for: #gemstone do: [ 
		spec blessing: #release.
		spec
			package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
			package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.14';
			package: 'SocketStream' with: 'SocketStream-PaulDeBruicker.12' ]
! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SvenVanCaekenberghe 9/28/2012 14:29'!
version19: spec
	<version: '1.9' imports: #('1.9-baseline')>
	spec for: #common do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.306';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.157';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.16';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.5';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.21';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.8';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.18';
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.27' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.3';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.7' ].
	spec for: #gemstone do: [ 
		spec blessing: #release.
		spec
			package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
			package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.14';
			package: 'SocketStream' with: 'SocketStream-PaulDeBruicker.12' ]
! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SvenVanCaekenberghe 12/12/2012 20:35'!
version20: spec
	<version: '2.0' imports: #('2.0-baseline')>
	spec for: #common do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.2';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.319';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.163';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.16';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.8';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.23';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.8';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.21';
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.27';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.10' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.3';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.7' ].
	spec for: #gemstone do: [ 
		spec blessing: #release.
		spec
			package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
			package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.14';
			package: 'SocketStream' with: 'SocketStream-PaulDeBruicker.12' ]
! !

!ConfigurationOfZincHTTPComponents methodsFor: 'baselines' stamp: 'SeanDeNigris 7/5/2012 01:35'!
baseline17: spec
	<version: '1.7-baseline'>
	spec
		for: #common
		do: [ 
			spec
				blessing: #baseline;
				description: '
- add XMLSupport project
- update Zinc-AWS to require above
- add  FileSystem-Legacy to Pharo 1.x and FileSystem to Pharo 2.x';
				author: 'SeanDeNigris';
				timestamp: '7/4/2012 12:12-04:00';
				repository: 'http://www.squeaksource.com/ZincHTTPComponents'.
			spec project: 'XML Support' with: [
				spec
					className: 'ConfigurationOfXMLSupport';
					versionString: #'stable';
					repository: 'http://www.squeaksource.com/MetacelloRepository' ].
			spec package: 'Zodiac-Core' with: [ spec repository: 'http://www.squeaksource.com/Zodiac' ].
			spec
				package: 'Zinc-HTTP';
				package: 'Zinc-Patch-HTTPSocket'
					with: [ 
							spec
								repository: 'http://ss3.gemstone.com/ss/pharo';
								requires: 'Zinc-HTTP' ];
				package: 'Zinc-AWS' with: [ spec requires: #('Zinc-HTTP' 'XML Support') ];
				package: 'Zinc-REST' with: [ spec requires: 'Zinc-HTTP' ];
				package: 'Zinc-Zodiac' with: [ spec requires: #('Zinc-HTTP' 'Zodiac-Core') ];
				package: 'Zinc-WebDAV' with: [ spec requires: 'Zinc-HTTP' ];
				package: 'Zinc-WWS-Server' with: [ spec requires: 'Zinc-HTTP' ];
				package: 'Zinc-WWS-Client' with: [ spec requires: 'Zinc-HTTP' ];
				package: 'Zinc-Tests' with: [ spec requires: 'Zinc-HTTP' ].
			spec
				group: 'default' with: #('Core');
				group: 'Core' with: #('Zinc-HTTP');
				group: 'Tests' with: #('Zinc-Tests');
				group: 'AWS' with: #('Zinc-AWS');
				group: 'WebDAV' with: #('Zinc-WebDAV');
				group: 'WWS' with: #('Zinc-WWS-Server' 'Zinc-WWS-Client');
				group: 'REST' with: #('Zinc-REST');
				group: 'Patch-HTTPSocket' with: #('Zinc-Patch-HTTPSocket') ].
	spec for: #'pharo1.x' do: [ 
		spec
			package: 'Zinc-FileSystem-Legacy';
			package: 'Zinc-HTTP' with: [ spec requires: 'Zinc-FileSystem-Legacy' ] ].
	spec for: #'pharo2.x' do: [
		spec
			package: 'Zinc-FileSystem';
			package: 'Zinc-HTTP' with: [ spec requires: 'Zinc-FileSystem' ] ].
	spec
		for: #gemstone
		do: [ 
			spec repository: 'http://seaside.gemstone.com/ss/ZincHTTPComponents'.
			spec
				package: 'Zinc-HTTP' with: [ spec includes: #('Zinc-Gemstone') ];
				package: 'SocketStream' with: [ spec repository: 'http://seaside.gemstone.com/ss/PharoCompat' ];
				package: 'Zinc-GemstonePreliminary' with: [ spec requires: #('SocketStream') ];
				package: 'Zinc-HTTP' with: [ spec requires: #('Zinc-GemstonePreliminary') ];
				package: 'Zinc-Gemstone' with: [ spec requires: #('Zinc-HTTP') ];
				package: 'Zinc-Tests' with: [ spec requires: 'Zinc-Gemstone' ] ]! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SvenVanCaekenberghe 3/14/2013 19:03'!
version234: spec
	<version: '2.3.4' imports: #('2.3-baseline')>
	spec for: #common do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.6';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.4';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.10';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.346';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.177';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.17';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.10';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.25';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-SSO-OAuth1-Core' with: 'Zinc-SSO-OAuth1-Core-SvenVanCaekenberghe.12';
			package: 'Zinc-SSO-OAuth2-Core' with: 'Zinc-SSO-OAuth2-Core-JanVanDeSandt.13';
			package: 'Zinc-SSO-OpenID-Core' with: 'Zinc-SSO-OpenID-Core-JanVanDeSandt.6';
			package: 'Zinc-SSO-Demo' with: 'Zinc-SSO-Demo-SvenVanCaekenberghe.4';
			package: 'Zinc-SSO-OAuth1-Tests' with: 'Zinc-SSO-OAuth1-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-SSO-OpenID-Tests' with: 'Zinc-SSO-OpenID-Tests-JanVanDeSandt.3';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.9';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.25';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.27';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.10' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.5';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.9' ].
	spec for: #gemstone do: [ 
		spec blessing: #release.
		spec
			package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
			package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.14';
			package: 'SocketStream' with: 'SocketStream-PaulDeBruicker.12' ]
! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SvenVanCaekenberghe 6/7/2013 13:49'!
version242: spec
	<version: '2.4.2' imports: #('2.4-baseline')>
	spec for: #common do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.18';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.9';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.16';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.10';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.367';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.188';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.17';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.10';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.25';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-SSO-OAuth1-Core' with: 'Zinc-SSO-OAuth1-Core-SvenVanCaekenberghe.13';
			package: 'Zinc-SSO-OAuth2-Core' with: 'Zinc-SSO-OAuth2-Core-JanVanDeSandt.15';
			package: 'Zinc-SSO-OpenID-Core' with: 'Zinc-SSO-OpenID-Core-JanVanDeSandt.6';
			package: 'Zinc-SSO-Demo' with: 'Zinc-SSO-Demo-SvenVanCaekenberghe.5';
			package: 'Zinc-SSO-OAuth1-Tests' with: 'Zinc-SSO-OAuth1-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-SSO-OpenID-Tests' with: 'Zinc-SSO-OpenID-Tests-JanVanDeSandt.3';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.9';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.27';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.30';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.12';
			package: 'Zinc-Seaside' with: 'Zinc-Seaside-SvenVanCaekenberghe.40' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.5';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.9' ].
	spec for: #gemstone do: [ 
		spec blessing: #release.
		spec
			package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
			package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.14';
			package: 'SocketStream' with: 'SocketStream-PaulDeBruicker.12' ]
! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SeanDeNigris 6/7/2012 00:30'!
version151: spec
	<version: '1.5.1' imports: #('1.5-baseline' )>

	spec for: #'common' do: [
		spec blessing: #release.
		spec description: 'fixed Zodiac-Core package name; updated to latest packages; all tests pass on Pharo 1.4'.
		spec author: 'SeanDeNigris'.
		spec timestamp: '6/7/2012 00:23'.
		spec 
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.17';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.280';
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-StephaneDucasse.2';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.15';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.5';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.12';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.7';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.144'. ].! !

!ConfigurationOfZincHTTPComponents methodsFor: 'baselines' stamp: 'SvenVanCaekenberghe 9/28/2012 14:25'!
baseline19: spec
	<version: '1.9-baseline'>
	spec for: #common do: [ 
		spec
			blessing: #baseline;
			description: 'Baseline for Zinc HTTP Components, a framework to deal with the HTTP networking';
			author: 'SvenVanCaekenberghe';
			repository: 'http://mc.stfx.eu/ZincHTTPComponents'.
		spec project: 'XML Support' with: [
			spec
				className: 'ConfigurationOfXMLSupport';
				versionString: #'stable';
				repository: 'http://www.squeaksource.com/MetacelloRepository' ].
		spec package: 'Zodiac-Core' with: [ 
			spec repository: 'http://mc.stfx.eu/Zodiac' ].
		spec
			package: 'Zinc-HTTP';
			package: 'Zinc-Patch-HTTPSocket' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-AWS' with: [ spec requires: #('Zinc-HTTP' 'XML Support') ];
			package: 'Zinc-REST' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-Zodiac' with: [ spec requires: #('Zinc-HTTP' 'Zodiac-Core') ];
			package: 'Zinc-WebSocket-Core' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-WebSocket-Tests' with: [ spec requires: 'Zinc-WebSocket-Core' ];
			package: 'Zinc-WebDAV' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-WWS-Server' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-WWS-Client' with: [ spec requires: 'Zinc-HTTP' ];
			package: 'Zinc-Tests' with: [ spec requires: 'Zinc-HTTP' ].
		spec
			group: 'default' with: #('Core');
			group: 'Core' with: #('Zinc-HTTP');
			group: 'Tests' with: #('Zinc-Tests');
			group: 'AWS' with: #('Zinc-AWS');
			group: 'WebDAV' with: #('Zinc-WebDAV');
			group: 'WebSocket' with: #('Zinc-WebSocket-Core' 'Zinc-WebSocket-Tests');
			group: 'WWS' with: #('Zinc-WWS-Server' 'Zinc-WWS-Client');
			group: 'REST' with: #('Zinc-REST');
			group: 'Patch-HTTPSocket' with: #('Zinc-Patch-HTTPSocket') ].
	spec for: #'pharo1.x' do: [ 
		spec
			package: 'Zinc-FileSystem-Legacy';
			package: 'Zinc-Pharo-Forward-Compatibility';
			package: 'Zinc-HTTP' with: [ spec requires: #('Zinc-FileSystem-Legacy' 'Zinc-Pharo-Forward-Compatibility') ] ].
	spec for: #'pharo2.x' do: [
		spec
			package: 'Zinc-FileSystem';
			package: 'Zinc-HTTP' with: [ spec requires: 'Zinc-FileSystem' ] ].
	spec for: #gemstone do: [ 
		spec
			repository: 'http://seaside.gemstone.com/ss/ZincHTTPComponents';
			package: 'Zinc-HTTP' with: [ spec includes: #('Zinc-Gemstone') ];
			package: 'SocketStream' with: [ spec repository: 'http://seaside.gemstone.com/ss/PharoCompat' ];
			package: 'Zinc-GemstonePreliminary' with: [ spec requires: #('SocketStream') ];
			package: 'Zinc-HTTP' with: [ spec requires: #('Zinc-GemstonePreliminary') ];
			package: 'Zinc-Gemstone' with: [ spec requires: #('Zinc-HTTP') ];
			package: 'Zinc-Tests' with: [ spec requires: 'Zinc-Gemstone' ] ]! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SvenVanCaekenberghe 2/22/2013 15:36'!
version233: spec
	<version: '2.3.3' imports: #('2.3-baseline')>
	spec for: #common do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.5';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.3';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.10';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.345';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.176';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.16';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.10';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.25';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-SSO-OAuth1-Core' with: 'Zinc-SSO-OAuth1-Core-SvenVanCaekenberghe.12';
			package: 'Zinc-SSO-OAuth2-Core' with: 'Zinc-SSO-OAuth2-Core-JanVanDeSandt.13';
			package: 'Zinc-SSO-OpenID-Core' with: 'Zinc-SSO-OpenID-Core-JanVanDeSandt.6';
			package: 'Zinc-SSO-Demo' with: 'Zinc-SSO-Demo-SvenVanCaekenberghe.4';
			package: 'Zinc-SSO-OAuth1-Tests' with: 'Zinc-SSO-OAuth1-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-SSO-OpenID-Tests' with: 'Zinc-SSO-OpenID-Tests-JanVanDeSandt.3';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.8';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.25';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.27';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.10' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.5';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.9' ].
	spec for: #gemstone do: [ 
		spec blessing: #release.
		spec
			package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
			package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.14';
			package: 'SocketStream' with: 'SocketStream-PaulDeBruicker.12' ]
! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'SvenVanCaekenberghe 1/21/2013 17:00'!
version23: spec
	<version: '2.3' imports: #('2.3-baseline')>
	spec for: #common do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.5';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.3';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.8';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.5';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.337';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.174';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.16';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.10';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.25';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-SSO-OAuth1-Core' with: 'Zinc-SSO-OAuth1-Core-JanVanDeSandt.9';
			package: 'Zinc-SSO-OAuth2-Core' with: 'Zinc-SSO-OAuth2-Core-JanVanDeSandt.13';
			package: 'Zinc-SSO-OpenID-Core' with: 'Zinc-SSO-OpenID-Core-JanVanDeSandt.6';
			package: 'Zinc-SSO-Demo' with: 'Zinc-SSO-Demo-JanVanDeSandt.1';
			package: 'Zinc-SSO-OAuth1-Tests' with: 'Zinc-SSO-OAuth1-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-SSO-OpenID-Tests' with: 'Zinc-SSO-OpenID-Tests-JanVanDeSandt.3';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.8';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.24';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.27';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.10' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.3';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.8' ].
	spec for: #gemstone do: [ 
		spec blessing: #release.
		spec
			package: 'Zinc-GemstonePreliminary' with: 'Zinc-GemstonePreliminary-PaulDeBruicker.2';
			package: 'Zinc-Gemstone' with: 'Zinc-Gemstone-PaulDeBruicker.14';
			package: 'SocketStream' with: 'SocketStream-PaulDeBruicker.12' ]
! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'JohanBrichau 7/9/2014 20:54'!
version245: spec
	<version: '2.4.5' imports: #('2.4-baseline')>
	spec for: #pharo do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.21';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.12';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.17';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.11';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.376';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.194';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.17';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.13';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.25';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-SSO-OAuth1-Core' with: 'Zinc-SSO-OAuth1-Core-SvenVanCaekenberghe.13';
			package: 'Zinc-SSO-OAuth2-Core' with: 'Zinc-SSO-OAuth2-Core-JanVanDeSandt.16';
			package: 'Zinc-SSO-OpenID-Core' with: 'Zinc-SSO-OpenID-Core-JanVanDeSandt.6';
			package: 'Zinc-SSO-Demo' with: 'Zinc-SSO-Demo-SvenVanCaekenberghe.5';
			package: 'Zinc-SSO-OAuth1-Tests' with: 'Zinc-SSO-OAuth1-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-SSO-OpenID-Tests' with: 'Zinc-SSO-OpenID-Tests-JanVanDeSandt.3';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.9';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.27';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.30';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.12';
			package: 'Zinc-Seaside' with: 'Zinc-Seaside-SvenVanCaekenberghe.40' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.5';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.9' ].! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'JohanBrichau 7/9/2014 20:54'!
version246: spec
	<version: '2.4.6' imports: #('2.4-baseline')>
	spec for: #pharo do: [ 
		spec 
			blessing: #release;
			description: 'Update to latest package versions';
			author: 'SvenVanCaekenberghe';
			package: 'Zinc-Character-Encoding-Core' with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.28';
			package: 'Zinc-Character-Encoding-Tests' with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.15';
			package: 'Zinc-Resource-Meta-Core' with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.28';
			package: 'Zinc-Resource-Meta-Tests' with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.16';
			package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.383';
			package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.199';
			package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.17';
			package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.13';
			package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
			package: 'Zinc-WebSocket-Core' with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.25';
			package: 'Zinc-WebSocket-Tests' with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
			package: 'Zinc-SSO-OAuth1-Core' with: 'Zinc-SSO-OAuth1-Core-SvenVanCaekenberghe.13';
			package: 'Zinc-SSO-OAuth2-Core' with: 'Zinc-SSO-OAuth2-Core-JanVanDeSandt.16';
			package: 'Zinc-SSO-OpenID-Core' with: 'Zinc-SSO-OpenID-Core-JanVanDeSandt.6';
			package: 'Zinc-SSO-Demo' with: 'Zinc-SSO-Demo-SvenVanCaekenberghe.5';
			package: 'Zinc-SSO-OAuth1-Tests' with: 'Zinc-SSO-OAuth1-Tests-SvenVanCaekenberghe.2';
			package: 'Zinc-SSO-OpenID-Tests' with: 'Zinc-SSO-OpenID-Tests-JanVanDeSandt.3';
			package: 'Zinc-WWS-Client' with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
			package: 'Zinc-WWS-Server' with: 'Zinc-WWS-Server-SvenVanCaekenberghe.9';
			package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.27';
			package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.30';
			package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.12';
			package: 'Zinc-Seaside' with: 'Zinc-Seaside-SvenVanCaekenberghe.40' ].
	spec for: #'pharo1.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
			package: 'Zinc-FileSystem-Legacy' with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.5';
			package: 'Zinc-Pharo-Forward-Compatibility' with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
	spec for: #'pharo2.x' do: [ 
		spec 
			package: 'Zinc-Patch-HTTPSocket' with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
			package: 'Zinc-FileSystem' with: 'Zinc-FileSystem-SvenVanCaekenberghe.10' ].! !

!ConfigurationOfZincHTTPComponents methodsFor: 'versions' stamp: 'dkh 07/10/2014 15:58'!
version243: spec
  <version: '2.4.3' imports: #('2.4-baseline')>
  spec
    for: #'pharo'
    do: [ 
      spec
        blessing: #'release';
        description: 'Update to latest package versions';
        author: 'SvenVanCaekenberghe';
        package: 'Zinc-Character-Encoding-Core'
          with: 'Zinc-Character-Encoding-Core-SvenVanCaekenberghe.21';
        package: 'Zinc-Character-Encoding-Tests'
          with: 'Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.12';
        package: 'Zinc-Resource-Meta-Core'
          with: 'Zinc-Resource-Meta-Core-SvenVanCaekenberghe.17';
        package: 'Zinc-Resource-Meta-Tests'
          with: 'Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.10';
        package: 'Zinc-HTTP' with: 'Zinc-HTTP-SvenVanCaekenberghe.371';
        package: 'Zinc-Tests' with: 'Zinc-Tests-SvenVanCaekenberghe.190';
        package: 'Zinc-AWS' with: 'Zinc-AWS-SvenVanCaekenberghe.17';
        package: 'Zinc-REST' with: 'Zinc-REST-SvenVanCaekenberghe.11';
        package: 'Zinc-WebDAV' with: 'Zinc-WebDAV-SvenVanCaekenberghe.3';
        package: 'Zinc-WebSocket-Core'
          with: 'Zinc-WebSocket-Core-SvenVanCaekenberghe.25';
        package: 'Zinc-WebSocket-Tests'
          with: 'Zinc-WebSocket-Tests-SvenVanCaekenberghe.7';
        package: 'Zinc-SSO-OAuth1-Core'
          with: 'Zinc-SSO-OAuth1-Core-SvenVanCaekenberghe.13';
        package: 'Zinc-SSO-OAuth2-Core'
          with: 'Zinc-SSO-OAuth2-Core-JanVanDeSandt.15';
        package: 'Zinc-SSO-OpenID-Core'
          with: 'Zinc-SSO-OpenID-Core-JanVanDeSandt.6';
        package: 'Zinc-SSO-Demo' with: 'Zinc-SSO-Demo-SvenVanCaekenberghe.5';
        package: 'Zinc-SSO-OAuth1-Tests'
          with: 'Zinc-SSO-OAuth1-Tests-SvenVanCaekenberghe.2';
        package: 'Zinc-SSO-OpenID-Tests'
          with: 'Zinc-SSO-OpenID-Tests-JanVanDeSandt.3';
        package: 'Zinc-WWS-Client'
          with: 'Zinc-WWS-Client-SvenVanCaekenberghe.2';
        package: 'Zinc-WWS-Server'
          with: 'Zinc-WWS-Server-SvenVanCaekenberghe.9';
        package: 'Zinc-Zodiac' with: 'Zinc-Zodiac-SvenVanCaekenberghe.27';
        package: 'Zodiac-Core' with: 'Zodiac-Core-SvenVanCaekenberghe.30';
        package: 'Zodiac-Tests' with: 'Zodiac-Tests-SvenVanCaekenberghe.12';
        package: 'Zinc-Seaside' with: 'Zinc-Seaside-SvenVanCaekenberghe.40' ].
  spec
    for: #'pharo1.x'
    do: [ 
      spec
        package: 'Zinc-Patch-HTTPSocket'
          with: 'Zinc-Patch-HTTPSocket-SvenVanCaekenberghe.1';
        package: 'Zinc-FileSystem-Legacy'
          with: 'Zinc-FileSystem-Legacy-SvenVanCaekenberghe.5';
        package: 'Zinc-Pharo-Forward-Compatibility'
          with: 'Zinc-Pharo-Forward-Compatibility-SvenVanCaekenberghe.1' ].
  spec
    for: #'pharo2.x'
    do: [ 
      spec
        package: 'Zinc-Patch-HTTPSocket'
          with: 'Zinc-Patch-HTTPSocket-MarcusDenker.4';
        package: 'Zinc-FileSystem'
          with: 'Zinc-FileSystem-SvenVanCaekenberghe.9' ].
  spec
    for: #(#'gs2.4.x' #'gs3.1.x' #'gs3.2.x')
    do: [ 
      spec
        baseline: 'ZincHTTPComponents'
          with: [ spec repository: 'github://GsDevKit/zinc:2.4.3/repository' ];
        import: 'ZincHTTPComponents' ]! !

!ConfigurationOfZincHTTPComponents class methodsFor: 'catalog' stamp: 'SvenVanCaekenberghe 6/10/2014 22:21'!
catalogKeywords
	"Returns an array of symbols"
	^ #(#networking #internet #http #client #server #request #response #url #'mime-type' #'character-encoding')! !

!ConfigurationOfZincHTTPComponents class methodsFor: 'metacello tool support' stamp: 'SvenVanCaekenberghe 1/15/2011 17:31'!
isMetacelloConfig
	"Answer true and the Metacello tools will operate on you"
	
	^true! !

!ConfigurationOfZincHTTPComponents class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/15/2011 17:31'!
project

	^self new project! !

!ConfigurationOfZincHTTPComponents class methodsFor: 'private' stamp: 'SvenVanCaekenberghe 1/15/2011 17:31'!
ensureMetacello
	"Bootstrap Gofer (if necessary), load latest mcz file for ConfigurationOfMetacello (using old 
	 Gofer API), then load the latest version of Metacello itself."

	Smalltalk at: #MetacelloProject ifAbsent: [ | error |
		"list of repositories to try, in case primary repository is not accessible"
		(Array 
			with: 'http://www.squeaksource.com/MetacelloRepository' 
			with: 'http://seaside.gemstone.com/ss/metacello') do: [:repositoryUrl |
				([
					Smalltalk at: #Gofer ifAbsent: [
					"Current version of Gofer from which to bootstrap - as of 1.0-beta.21"
						self bootstrapPackage: 'Gofer-Core-lr.115' from: repositoryUrl ].
					Smalltalk at: #Gofer ifPresent: [:goferClass | | gofer |
						gofer := goferClass new
							url: repositoryUrl;
							yourself.
						[ gofer addPackage: 'ConfigurationOfMetacello' ] on: Warning do: [:ex | ex resume ].
						gofer load ]]
							on: Error
							do: [ :ex |
								error := ex.
								Transcript 
									cr; 
									show: 'failed ensureMetacello: ';
									show: ex description printString;
									show: '...retrying'.
								"try again"
								ex return: nil ]) ~~ nil
					ifTrue: [
						"load 'default' group of Metacello"
						(Smalltalk at: #ConfigurationOfMetacello) perform: #load.
						^self ]].
		"shouldn't get here unless the load failed ... throw an error"
		self error: 'retry with alternate repository failed: ', error description printString ]! !

!ConfigurationOfZincHTTPComponents class methodsFor: 'catalog' stamp: 'SvenVanCaekenberghe 6/10/2014 11:18'!
catalogChangeLog
	"Returns a paragraph describing the most important changes in the configuration class."
	^ 'Started and in production use since 2010, Zinc HTTP Components is a standard part of Pharo 1.4, 2.0, 3.0 and 4.0'! !

!ConfigurationOfZincHTTPComponents class methodsFor: 'unloading Metacello' stamp: 'SvenVanCaekenberghe 1/15/2011 17:31'!
unloadMetacello

	Smalltalk at: #ConfigurationOfMetacello ifPresent: [:cls | cls unloadMetacello ]! !

!ConfigurationOfZincHTTPComponents class methodsFor: 'catalog' stamp: 'SvenVanCaekenberghe 6/10/2014 11:21'!
catalogKeyClassesAndExample
	"Returns a paragraph or more describing the key classes of your project. You can use Pillar/Pier syntax to layout out the text i.e., ==Code== and - for bullet."
	^ 'The core classes are ZnClient and ZnServer. At a lower level, there are ZnRequest and ZnResponse, ZnEntity, ZnRequestLine, ZnStatusLine and ZnHeaders. This project also maintains ZnUrl, ZnMimeType and ZnCharacterEncoding.'! !

!ConfigurationOfZincHTTPComponents class methodsFor: 'metacello tool support' stamp: 'SvenVanCaekenberghe 1/15/2011 17:31'!
metacelloVersion: versionString loads: anArrayOrString
	"Stash the last version loaded and the list of packages loaded for that version. The list
	 of packages will be used by the tools when doing 'Load Package Version'"

	LastVersionLoad := versionString -> anArrayOrString! !

!ConfigurationOfZincHTTPComponents class methodsFor: 'metacello tool support' stamp: 'SvenVanCaekenberghe 1/15/2011 17:31'!
lastMetacelloVersionLoad
	"Answer the last version loaded and the list of packages loaded for that version."

	LastVersionLoad == nil ifTrue: [ LastVersionLoad := nil -> 'default' ].
	^LastVersionLoad! !

!ConfigurationOfZincHTTPComponents class methodsFor: 'loading' stamp: 'SvenVanCaekenberghe 1/15/2011 17:31'!
load
	"self load"

	^self project stableVersion load! !

!ConfigurationOfZincHTTPComponents class methodsFor: 'catalog' stamp: 'SvenVanCaekenberghe 6/10/2014 11:23'!
catalogDescription
	"Returns a paragraph describing the project"
	^ 'Zinc HTTP Components is an open source Smalltalk framework to deal with HTTP. It models most concepts of HTTP and its related standards and offers both client and server functionality. One of its key goals is to offer understandability (Smalltalk’s design principle number one). Anyone with a basic understanding of Smalltalk and the HTTP principles should be able to understand what is going on and learn, by looking at the implementation. '! !

!ConfigurationOfZincHTTPComponents class methodsFor: 'catalog' stamp: 'SvenVanCaekenberghe 6/10/2014 11:16'!
catalogContactInfo
	"Returns a paragraph describing contact information such as email, mailing lists and website."
	^ 'Written and maintained by Sven Van Caekenberghe (http://stfx.eu) and the community. Discussions on the Pharo mailing lists. Documentation can be found at http://zn.stfx.eu'! !

!ConfigurationOfZincHTTPComponents class methodsFor: 'private' stamp: 'SvenVanCaekenberghe 1/15/2011 17:31'!
bootstrapPackage: aString from: aPath 
	| repository version |
	repository := MCHttpRepository
				location: aPath
				user: ''
				password: ''.
	repository
		versionReaderForFileNamed: aString , '.mcz'
		do: [:reader | 
			version := reader version.
			version load.
			version workingCopy repositoryGroup addRepository: repository]! !

!ConnectionClosed commentStamp: 'mir 5/12/2003 18:12'!
Signals a prematurely closed connection.
!
!ConnectionQueue commentStamp: '<historical>'!
A ConnectionQueue listens on a given port number and collects a queue of client connections. In order to handle state changes quickly, a ConnectionQueue has its own process that: (a) tries to keep a socket listening on the port whenever the queue isn't already full of connections and (b) prunes stale connections out of the queue to make room for fresh ones.
!
!ConnectionQueue methodsFor: 'private' stamp: 'SvenVanCaekenberghe 1/16/2012 11:41'!
listenLoop
	"Private!! This loop is run in a separate process. It will establish up to maxQueueLength connections on the given port."
	"Details: When out of sockets or queue is full, retry more frequently, since a socket may become available, space may open in the queue, or a previously queued connection may be aborted by the client, making it available for a fresh connection."
	"Note: If the machine is disconnected from the network while the server is running, the currently waiting socket will go from 'isWaitingForConnection' to 'unconnected', and attempts to create new sockets will fail. When this happens, delete the broken socket and keep trying to create a socket in case the network connection is re-established. Connecting and disconnecting was tested under PPP on Mac system 8.1. It is not if this will work on other platforms.
	
	Fixed to not accept the connection if the queue is full (gvc)."


	| newConnection |

	socket := Socket newTCP.
	"We'll accept four simultanous connections at the same time"
	socket listenOn: portNumber backlogSize: 4.
	"If the listener is not valid then the we cannot use the
	BSD style accept() mechanism."
	socket isValid ifFalse: [^self oldStyleListenLoop].
	[true] whileTrue: [
		socket isValid ifFalse: [
			"socket has stopped listening for some reason"
			socket destroy.
			(Delay forMilliseconds: 10) wait.
			^self listenLoop ].
		[newConnection := socket waitForAcceptFor: 10]
			on: ConnectionTimedOut
			do: [:ex | newConnection := nil].
		(newConnection notNil and: [newConnection isConnected])
			ifTrue: [(accessSema critical: [connections size < maxQueueLength])
						ifFalse: [newConnection close. newConnection := nil]]
			ifFalse: [newConnection := nil].
		(newConnection notNil and: [newConnection isConnected]) ifTrue: [
			accessSema critical: [connections addLast: newConnection].
			newConnection := nil.
			self changed].
		self pruneStaleConnections]. ! !

!ConnectionQueue methodsFor: 'private' stamp: 'jm 3/10/98 11:07'!
initPortNumber: anInteger queueLength: queueLength
	"Private!! Initialize the receiver to listen on the given port number. Up to queueLength connections will be queued."

	portNumber := anInteger.
	maxQueueLength := queueLength.
	connections := OrderedCollection new.
	accessSema := Semaphore forMutualExclusion.
	socket := nil.
	process := [self listenLoop] newProcess.
	process priority: Processor highIOPriority.
	process resume.
! !

!ConnectionQueue methodsFor: 'public' stamp: 'nice 12/26/2009 01:23'!
connectionCount
	"Return an estimate of the number of currently queued connections. This is only an estimate since a new connection could be made, or an existing one aborted, at any moment."

	self pruneStaleConnections.
	^accessSema critical: [connections size]! !

!ConnectionQueue methodsFor: 'public' stamp: 'jm 3/9/98 14:34'!
destroy
	"Terminate the listener process and destroy all sockets in my possesion."

	process ifNotNil: [
		process terminate.
		process := nil].
	socket ifNotNil: [
		socket destroy.
		socket := nil].
	connections do: [:s | s destroy].
	connections := OrderedCollection new.
! !

!ConnectionQueue methodsFor: 'public' stamp: 'nice 12/26/2009 01:24'!
getConnectionOrNil
	"Return a connected socket, or nil if no connection has been established."

	^accessSema critical: [
		| result |
		connections isEmpty
			ifTrue: [result := nil]
			ifFalse: [
				result := connections removeFirst.
				((result isValid) and: [result isConnected]) ifFalse: [  "stale connection"
					result destroy.
					result := nil]].
		result]! !

!ConnectionQueue methodsFor: 'public' stamp: 'ls 9/26/1999 15:34'!
isValid
	^process notNil! !

!ConnectionQueue methodsFor: 'private' stamp: 'nice 12/26/2009 01:25'!
pruneStaleConnections
	"Private!! The client may establish a connection and then disconnect while it is still in the connection queue. This method is called periodically to prune such sockets out of the connection queue and make room for fresh connections."

	accessSema critical: [
		| foundStaleConnection |
		foundStaleConnection := false.
		connections do: [:s |
			s isUnconnected ifTrue: [
				s destroy.
				foundStaleConnection := true]].
		foundStaleConnection ifTrue: [
			connections := connections select: [:s | s isValid]]].
! !

!ConnectionQueue methodsFor: 'public' stamp: 'nice 12/26/2009 01:25'!
getConnectionOrNilLenient
	"Return a connected socket, or nil if no connection has been established."

	^accessSema critical: [
		| result |
		connections isEmpty ifTrue: [
			result := nil
		] ifFalse: [
			result := connections removeFirst.
			(result isValid and: [result isConnected or: [result isOtherEndClosed]]) ifFalse: [
				"stale connection"
				result destroy.
				result := nil
			]
		].
		result
	].
! !

!ConnectionQueue methodsFor: 'private' stamp: 'mir 5/15/2003 18:28'!
oldStyleListenLoop
	"Private!! This loop is run in a separate process. It will establish up to maxQueueLength connections on the given port."
	"Details: When out of sockets or queue is full, retry more frequently, since a socket may become available, space may open in the queue, or a previously queued connection may be aborted by the client, making it available for a fresh connection."
	"Note: If the machine is disconnected from the network while the server is running, the currently waiting socket will go from 'isWaitingForConnection' to 'unconnected', and attempts to create new sockets will fail. When this happens, delete the broken socket and keep trying to create a socket in case the network connection is re-established. Connecting and disconnecting was tested under PPP on Mac system 8.1. It is not if this will work on other platforms."

	[true] whileTrue: [
		((socket == nil) and: [connections size < maxQueueLength]) ifTrue: [
			"try to create a new socket for listening"
			socket := Socket createIfFail: [nil]].

		socket == nil
			ifTrue: [(Delay forMilliseconds: 100) wait]
			ifFalse: [
				socket isUnconnected ifTrue: [socket listenOn: portNumber].
				[socket waitForConnectionFor: 10]
					on: ConnectionTimedOut
					do: [:ex |
						socket isConnected
							ifTrue: [  "connection established"
								accessSema critical: [connections addLast: socket].
								socket := nil]
							ifFalse: [
								socket isWaitingForConnection
									ifFalse: [socket destroy. socket := nil]]]].  "broken socket; start over"
		self pruneStaleConnections].
! !

!ConnectionQueue class methodsFor: 'instance creation' stamp: 'jm 3/9/98 14:09'!
portNumber: anInteger queueLength: queueLength

	^ self new initPortNumber: anInteger queueLength: queueLength
! !

!ConnectionRefused commentStamp: 'mir 5/12/2003 18:14'!
Signals that a connection to the specified host and port was refused.

	host		host which refused the connection
	port		prot to which the connection was refused
!
!ConnectionRefused methodsFor: 'accessing' stamp: 'len 12/14/2002 11:58'!
port
	^ port! !

!ConnectionRefused methodsFor: 'accessing' stamp: 'len 12/14/2002 11:39'!
host: addressOrHostName port: portNumber
	host := addressOrHostName.
	port := portNumber! !

!ConnectionRefused methodsFor: 'accessing' stamp: 'len 12/14/2002 11:58'!
host
	^ host! !

!ConnectionRefused class methodsFor: 'instance creation' stamp: 'len 12/14/2002 11:39'!
host: addressOrHostName port: portNumber
	^ self new host: addressOrHostName port: portNumber! !

!ConnectionTimedOut commentStamp: 'mir 5/12/2003 18:14'!
Signals that a connection attempt timed out.
!
!ContainerModel commentStamp: '<historical>'!
I am a model for a container. My purpose is to hold multiple subwidgets to glue them together.


I should not be used directly!
!ContainerModel methodsFor: 'api-focus' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
eventKeyStrokesForPreviousFocus
	"String describing the keystroke to perform to jump to the previous widget"

	^ keyStrokesForPreviousFocusHolder value! !

!ContainerModel methodsFor: 'api' stamp: 'StephaneDucasse 2/27/2015 20:55'!
buildAdapterWithSpec
	"Build the widget using the spec name provided as argument"
	| adapter widget aSpecLayout |	
	aSpecLayout := (self retrieveSpec: self defaultSpecSelector).
	adapter := SpecInterpreter 
		private_interpretASpec: aSpecLayout
		model: self
		selector: self defaultSpecSelector.
	widget := adapter widget.
	self setExtentAndBindingTo: widget. 
	^ adapter! !

!ContainerModel methodsFor: 'api-focus' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
eventKeyStrokesForNextFocus
	"String describing the keystroke to perform to jump to the next widget"

	^ keyStrokesForNextFocusHolder value! !

!ContainerModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/1/2013 13:38'!
defaultSpec
	<spec>
	
	^ #(ContainerAdapter
		adapt: #(model))! !

!ContainerModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/13/2014 15:20'!
adapterName

	^ #ContainerAdapter! !

!Context commentStamp: '<historical>'!
Instance variables:
	receiver: <Object> (self)
	closureOrNil: <BlockClosure|nil> 
		nil if I'm a method context
		the blockClosure being executed if I'm a block context
	method <CompiledMethod> 
		method being executed if I'm a method context
		method holding the block if I'm a block context
	variable fields: <Object> temporary variables (including arguments)

My instances hold all the dynamic state associated with the execution of either a method activation resulting from a message send or a block activation resulting from a block evaluation.
	
MethodContexts, though normal in their variable size, are actually only used in two sizes, small and large, which are determined by the temporary space required by the method being executed.

MethodContexts must only be created using the method newForMethod:.  Note that it is impossible to determine the real object size of a MethodContext except by asking for the frameSize of its method.  Any fields above the stack pointer (stackp) are truly invisible -- even (and especially!!) to the garbage collector.  Any store into stackp other than by the primitive method stackp: is potentially fatal.!
!Context methodsFor: 'accessing' stamp: ''!
removeSelf
	"Nil the receiver pointer and answer its former value."

	| tempSelf |
	tempSelf := receiver.
	receiver := nil.
	^tempSelf! !

!Context methodsFor: 'mirror primitives' stamp: 'ClementBera 5/27/2014 13:49'!
objectSize: anObject
	"Answer the number of indexable variables in the argument anObject without sending
	it a message. This mimics the action of the VM when it fetches an object's variable size.
	Used to simulate the execution machinery by, for example, the debugger.
	Primitive.  See Object documentation whatIsAPrimitive."

	<primitive: 62>
	"The number of indexable fields of fixed-length objects is 0"
	^ 0! !

!Context methodsFor: 'debugger access' stamp: 'ClementBera 5/27/2014 13:49'!
tempsAndValues
	"Return a string of the temporary variabls and their current values"
	
	^ String streamContents: [ :aStream |
		self tempNames doWithIndex: [ :title :index |
			 aStream nextPutAll: title; nextPut: $:; space; tab.
			 self print: (self namedTempAt: index) on: aStream.
			 aStream cr ]].! !

!Context methodsFor: 'closure support' stamp: 'ar 6/28/2003 00:15'!
contextTag
	"Context tags may be used for referring to contexts instead of contexts themselves as they can be copied and will continue to work in other processes (continuations). By default, we use the context itself to as its tag."
	^self! !

!Context methodsFor: 'special context access' stamp: 'ClementBera 5/27/2014 13:49'!
unwindBlock
	"unwindContext only. access temporaries from BlockClosure>>#ensure: and BlockClosure>>#ifCurtailed:"
	^self tempAt: 1
! !

!Context methodsFor: 'private-exceptions' stamp: 'MartinMcClure 8/18/2014 14:01'!
evaluateSignal: exception
	"The following primitive is just a marker used to find the evaluation context. 
	See MethodContext>>#isHandlerOrSignalingContext. "

	<primitive: 199>
	| value |
	exception privHandlerContext: self contextTag.
	value := self exceptionHandlerBlock cull: exception.	
	"return from self if not otherwise directed in handle block"
	self return: value! !

!Context methodsFor: 'system simulation' stamp: 'ClementBera 5/27/2014 13:49'!
quickStep
	"If the next instruction is a send, just perform it.
	Otherwise, do a normal step."

	self willSend ifTrue: [ QuickStep := self ].
	^self step! !

!Context methodsFor: 'accessing' stamp: 'md 4/27/2006 15:12'!
hasInstVarRef
	"Answer whether the receiver references an instance variable."

	^self method hasInstVarRef.! !

!Context methodsFor: 'accessing' stamp: 'eem 4/25/2009 09:50'!
hasMethodReturn
	^closureOrNil hasMethodReturn! !

!Context methodsFor: 'debugger access' stamp: 'ClementBera 5/27/2014 13:49'!
contextStack 
	"Answer an Array of the contexts on the receiver's sender chain."

	^self stackOfSize: 100000! !

!Context methodsFor: 'debugger access' stamp: 'ClementBera 5/27/2014 13:49'!
namedTempAt: index
	"Answer the value of the temp at index in the receiver's sequence of tempNames."
	^self debuggerMap namedTempAt: index in: self! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 9/19/2013 15:37'!
respondsToUnknownBytecode
	"This method is triggerred by the VM when the interpreter tries to execute an unknown bytecode"
	
	| unknownBytecode |
	unknownBytecode := self method at: self pc.
	self error: 'VM cannot run unknown bytecode ', unknownBytecode printString
	
! !

!Context methodsFor: 'controlling' stamp: 'NicolaiHess 8/21/2014 20:51'!
runUntilErrorOrReturnFrom: aSender 
	"ASSUMES aSender is a sender of self.  Execute self's stack until aSender returns or an unhandled exception is raised.  Return a pair containing the new top context and a possibly nil exception.  The exception is not nil if it was raised before aSender returned and it was not handled.  The exception is returned rather than openning the debugger, giving the caller the choice of how to handle it."
	"Self is run by jumping directly to it (the active process abandons thisContext and executes self).  However, before jumping to self we insert an ensure block under aSender that jumps back to thisContext when evaluated.  We also insert an exception handler under aSender that jumps back to thisContext when an unhandled exception is raised.  In either case, the inserted ensure and exception handler are removed once control jumps back to thisContext."

	| error context here topContext |
	here := thisContext.

	"Insert ensure and exception handler contexts under aSender"
	error := nil.
	context := aSender insertSender: (Context
		contextOn: UnhandledError, Halt do: [:ex |
			error ifNil: [
				"this is ugly but it fixes the side-effects of not sending an Unhandled error on Halt"
				error := (ex isKindOf: Halt) ifTrue: [ ex ] ifFalse: [ ex exception ].
				topContext := thisContext.
				ex resumeUnchecked: here jump ]
			ifNotNil: [ ex pass ]]).
	context := context insertSender: (Context
		contextEnsure: [error ifNil: [
				topContext := thisContext.
				here jump]
		]).
	self jump.  "Control jumps to self"

	"Control resumes here once above ensure block or exception handler is executed"
	^ error ifNil: [
		"No error was raised, remove ensure context by stepping until popped"
		[context isDead] whileFalse: [topContext := topContext stepToCallee].
		{topContext. nil}

	] ifNotNil: [
		"Error was raised, remove inserted above contexts then return signaler context"
		aSender terminateTo: context sender.  "remove above ensure and handler contexts"
		{topContext. error}
	].
! !

!Context methodsFor: '*OpalCompiler-Core' stamp: 'CamilleTeruel 2/14/2014 15:21'!
isPushLiteralNil: aPC
	^ (self method at: aPC) = 115! !

!Context methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 1/6/2015 14:26'!
gtInspectorSourceIn: composite
	<gtInspectorPresentationOrder: 30> 
	self method gtInspectorSourceIn: composite! !

!Context methodsFor: 'query' stamp: 'ClementBera 5/27/2014 13:49'!
isContext
	^true! !

!Context methodsFor: 'printing' stamp: 'ClementBera 5/27/2014 13:49'!
debugStackOn: aStream
	"print the top ten contexts on my sender chain."

	^ self debugStack: 100 on: aStream! !

!Context methodsFor: 'system simulation' stamp: 'ClementBera 5/27/2014 13:49'!
stepToSendOrReturn
	"Simulate the execution of bytecodes until either sending a message or 
	returning a value to the receiver (that is, until switching contexts)."

	| context |
	[ self willSend or: [  self willReturn or: [ self willStore or: [self willCreateBlock ] ] ] ]
		whileFalse: [
			context := self step.
			context == self ifFalse: [
				"Caused by mustBeBoolean handling"
				^context ]]! !

!Context methodsFor: 'printing' stamp: 'ClementBera 5/27/2014 13:49'!
shortDebugStackOn: aStream
	"print the top 30 contexts on my sender chain."

	^ self debugStack: 30 on: aStream! !

!Context methodsFor: 'accessing' stamp: 'eem 7/22/2008 11:57'!
home 
	"Answer the context in which the receiver was defined."

	closureOrNil == nil ifTrue:
		[^self].
	^closureOrNil outerContext home! !

!Context methodsFor: 'private' stamp: 'ClementBera 5/27/2014 13:49'!
cannotReturn: result to: homeContext
	"The receiver tried to return result to homeContext that no longer exists."

	^ BlockCannotReturn new
		result: result;
		deadHome: homeContext;
		signal! !

!Context methodsFor: 'private-exceptions' stamp: 'MartinMcClure 8/18/2014 09:10'!
isHandlerContext
	"is this context for #on:do:?"
	^self isHandlerOrSignalingContext and: [ self selector == #on:do: ]! !

!Context methodsFor: 'testing' stamp: 'MarcusDenker 5/10/2013 21:37'!
isExecutingBlock
	"for compatibility"
	^self isBlockContext ! !

!Context methodsFor: 'controlling' stamp: 'ClementBera 5/27/2014 13:49'!
resume: value
	"Unwind thisContext to self and resume with value as result of last send.  Execute unwind blocks when unwinding.  ASSUMES self is a sender of thisContext"
	
	self resume: value through: (thisContext findNextUnwindContextUpTo: self)
	! !

!Context methodsFor: 'controlling' stamp: 'ClementBera 5/27/2014 13:49'!
return
	"Unwind until my sender is on top"

	self return: self receiver! !

!Context methodsFor: 'initialize-release' stamp: 'HenrikSperreJohansen 6/11/2010 21:03'!
privRefresh
	"Reinitialize the receiver so that it is in the state it was at its creation."
	 closureOrNil
		ifNotNil:
			[pc := closureOrNil startpc.
			self stackp: closureOrNil numArgs + closureOrNil numCopiedValues.
			1 to: closureOrNil numCopiedValues do:
				[:i | self tempAt: closureOrNil numArgs + i put: (closureOrNil at: i)]]
		ifNil:
			[pc := method initialPC.
			self stackp: method numTemps.
			method numArgs+1 to: method numTemps do:
				[:i | self tempAt: i put: nil]]! !

!Context methodsFor: 'accessing' stamp: 'ClementBera 5/27/2014 13:49'!
basicAt: index put: value
	"Primitive. Assumes receiver is indexable. Answer the value of an
	 indexable element in the receiver. Fail if the argument index is not
	 an Integer or is out of bounds. Essential. See Object documentation
	 whatIsAPrimitive.  Override the default primitive to give latitude to
	 the VM in context management."

	<primitive: 211>
	index isInteger ifTrue:
		[self errorSubscriptBounds: index].
	index isNumber
		ifTrue: [^self at: index asInteger put: value]
		ifFalse: [self errorNonIntegerIndex]! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 5/27/2014 13:49'!
pushNewArrayOfSize: arraySize 
	self push: (Array new: arraySize)! !

!Context methodsFor: 'accessing' stamp: 'IgorStasenko 12/29/2010 19:10'!
contextClass
"The context class of a message send should be the one of the method to be evaluated, because if that method has some super sends, the method lookup won't work as expected'"

	^self method methodClass! !

!Context methodsFor: 'testing' stamp: 'MarcusDenker 5/10/2013 21:35'!
isBlockContext
	"Is this executing a block versus a method?  In the new closure
	 implemetation this is true if closureOrNil is not nil, in which case
	 it should be holding a BlockClosure."

	^closureOrNil isClosure! !

!Context methodsFor: 'query' stamp: 'ClementBera 7/23/2014 14:27'!
findSimilarSender
	"Return the closest sender with the same method, return nil if none found"

	^ self sender findContextSuchThat: [ :context | 
		context method == method ]! !

!Context methodsFor: 'special context access' stamp: 'ClementBera 5/27/2014 13:49'!
unwindComplete
	"unwindContext only. access temporaries from BlockClosure>>#ensure: and BlockClosure>>#ifCurtailed:"
	^self tempAt: 2
! !

!Context methodsFor: 'debugger access' stamp: 'ClementBera 5/27/2014 13:49'!
release
	"Remove information from the receiver and all of the contexts on its 
	sender chain in order to break circularities."

	self releaseTo: nil! !

!Context methodsFor: 'private' stamp: 'ClementBera 5/27/2014 13:49'!
push: numObjects fromIndexable: anIndexableCollection
	"Push the elements of anIndexableCollection onto the receiver's stack.
	 Do not call directly.  Called indirectly by {1. 2. 3} constructs."

	1 to: numObjects do: [ :i |
		self push: (anIndexableCollection at: i)]! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 5/27/2014 13:49'!
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
	"Simulate the action of bytecode that removes the top of the stack and  stores
	 it into an offset in one of my local variables being used as a remote temp vector."

	(self at: tempVectorIndex + 1) at: remoteTempIndex + 1 put: self pop! !

!Context methodsFor: 'private' stamp: 'ClementBera 5/27/2014 13:49'!
isFailToken: anObject
	^ anObject class == Array and: [ anObject size = 2 and: [(anObject at: 1) == PrimitiveFailToken]]! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 5/27/2014 13:49'!
popIntoReceiverVariable: offset 
	"Simulate the action of bytecode that removes the top of the stack and 
	stores it into an instance variable of my receiver."

	self receiver instVarAt: offset + 1 put: self pop! !

!Context methodsFor: 'controlling' stamp: 'ClementBera 5/27/2014 13:49'!
top
	"Answer the top of the receiver's stack."

	^self at: stackp! !

!Context methodsFor: 'system simulation' stamp: 'ClementBera 5/27/2014 13:49'!
step
	"Simulate the execution of the receiver's next bytecode. Answer the 
	context that would be the active context after this bytecode."

	^self interpretNextInstructionFor: self! !

!Context methodsFor: 'debugger access' stamp: 'ClementBera 5/27/2014 13:49'!
releaseTo: caller 
	"Remove information from the receiver and the contexts on its sender 
	chain up to caller in order to break circularities."

	| contex senderContext |
	contex := self.
	[ contex == nil or: [ contex == caller ]]
		whileFalse: [
			senderContext := contex sender.
			contex singleRelease.
			contex := senderContext ]! !

!Context methodsFor: 'private' stamp: 'ClementBera 5/27/2014 13:49'!
privSender: aContext 

	sender := aContext! !

!Context methodsFor: 'private-exceptions' stamp: 'MartinMcClureWithAndresValloud 8/17/2014 07:35'!
handleSignal: exception
	"Sent to handler (on:do:) contexts only.  If my exception class (first arg) handles exception then execute my handle block (second arg), otherwise forward this message to the next handler context.  If none left, execute exception's defaultAction (see nil>>handleSignal:)."

	(self exceptionClass handles: exception)
		ifFalse: [ ^ self nextHandlerContext handleSignal: exception ].
	self evaluateSignal: exception! !

!Context methodsFor: 'accessing' stamp: 'ClementBera 5/27/2014 13:49'!
client
	"Answer the client, that is, the object that sent the message that created this context."

	^sender receiver! !

!Context methodsFor: '*Fuel' stamp: 'MartinDias 3/26/2012 19:17'!
cleanCopy 

	^ self class 
		sender: nil 
		receiver: receiver 
		method: method
		arguments: #()! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 5/27/2014 13:49'!
pushReceiver
	"Simulate the action of bytecode that pushes the active context's receiver 
	on the top of the stack."

	self push: self receiver! !

!Context methodsFor: 'special context access' stamp: 'ClementBera 5/27/2014 13:49'!
exceptionClass
	"handlercontext only. access temporaries from BlockClosure>>#on:do:"
	^self tempAt: 1
! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 5/27/2014 13:49'!
storeIntoReceiverVariable: offset 
	"Simulate the action of bytecode that stores the top of the stack into an 
	instance variable of my receiver."

	self receiver instVarAt: offset + 1 put: self top! !

!Context methodsFor: 'debugger access' stamp: 'ClementBera 5/27/2014 13:49'!
shortStack
	"Answer a String showing the top ten contexts on my sender chain."

	^ String streamContents: [ :stream |
		(self stackOfSize: 10) do: [ :item |
			stream print: item; cr]]! !

!Context methodsFor: 'private-exceptions' stamp: 'ClementBera 5/27/2014 13:49'!
unwindTo: aContext

	| context unwindBlock |
	context := self.
	[ (context := context findNextUnwindContextUpTo: aContext) isNil ] whileFalse: [
		(context unwindComplete) ifNil: [
			context unwindComplete: true.
			unwindBlock := context unwindBlock.
			unwindBlock value ]].
! !

!Context methodsFor: 'accessing' stamp: 'eem 8/20/2008 09:28'!
tempAt: index 
	"Answer the value of the temporary variable whose index is the 
	 argument, index.  Primitive. Assumes receiver is indexable. Answer the
	 value of an indexable element in the receiver. Fail if the argument index
	 is not an Integer or is out of bounds. Essential. See Object documentation
	 whatIsAPrimitive.  Override the default at: primitive to give latitude to the
	 VM in context management."

	<primitive: 210>
	^self at: index! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 5/27/2014 13:49'!
popIntoTemporaryVariable: offset 
	"Simulate the action of bytecode that removes the top of the stack and 
	stores it into one of my temporary variables."

	self at: offset + 1 put: self pop! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 12/29/2014 11:45'!
pushActiveProcess
	"Simulate the action of bytecode that pushes the the active Process on the 
	top of its own stack."

	self push: Processor activeProcess! !

!Context methodsFor: 'accessing' stamp: 'ClementBera 5/27/2014 13:49'!
basicSize
	"Primitive. Answer the number of indexable variables in the receiver. 
	This value is the same as the largest legal subscript. Essential. Do not 
	override in any subclass. See Object documentation whatIsAPrimitive.  Override the default primitive to give latitude to
	 the VM in context management."

	<primitive: 212>
	"The number of indexable fields of fixed-length objects is 0"
	^self primitiveFail! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 12/28/2014 17:58'!
pushClosureTemps: numTemps
	numTemps timesRepeat: [ self push: nil ]! !

!Context methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TommasoDalSasso 1/30/2015 16:58'!
gtInspectorVariableValuePairs
	"We override the variables with context specific ones"
	| superVariableValuePairs tempVariableValuePairs tempIndex |
	tempIndex := 0. 
	superVariableValuePairs := super gtInspectorVariableValuePairs.
	tempVariableValuePairs := (self tempNames
						collect: [ :tempName ||value|
							tempIndex := tempIndex + 1.
							value := [self debuggerMap namedTempAt: tempIndex in: self] 
								on: Error 
								do: [value := (Text string: 'error obtaining field value' attribute: TextColor red) asString ].
							('[' , tempName , ']') -> value ]) sort asOrderedCollection.
		^ tempVariableValuePairs addAll: superVariableValuePairs; yourself! !

!Context methodsFor: 'controlling' stamp: 'ClementBera 7/23/2014 14:31'!
quickSend: selector to: aReceiver with: arguments super: superFlag
	"Send the given selector with arguments in an environment which closely resembles the non-simulating environment, with an interjected unwind-protected block to catch nonlocal returns.
	Attention: don't get lost!!"
	| lookupClass contextToReturnTo result |
	contextToReturnTo := self.
	lookupClass := superFlag
					ifTrue: [(self method literalAt: self method numLiterals) value superclass]
					ifFalse: [aReceiver class].
	[ | oldSender |
	oldSender := thisContext sender swapSender: self.
	result := aReceiver perform: selector withArguments: arguments inSuperclass: lookupClass.
	thisContext sender swapSender: oldSender] ifCurtailed: [
		contextToReturnTo := thisContext sender receiver.	"The block context returning nonlocally"
		contextToReturnTo jump: -1.	"skip to front of return bytecode causing this unwind"
		contextToReturnTo nextByte = 16r7C ifTrue: [
			"If it was a returnTop, push the value to be returned.
			Otherwise the value is implicit in the bytecode"
			contextToReturnTo push: (thisContext sender tempAt: 1)].
		thisContext swapSender: thisContext home sender.	"Make this block return to the method's sender"
		contextToReturnTo].
	contextToReturnTo push: result.
	^contextToReturnTo! !

!Context methodsFor: 'private-exceptions' stamp: 'MartinMcClure 8/18/2014 09:01'!
nextHandlerContext

	^ self sender findNextHandlerContext! !

!Context methodsFor: 'private-exceptions' stamp: 'ar 6/28/2003 00:10'!
restartWithNewReceiver: obj

	self
		swapReceiver: obj;
		restart! !

!Context methodsFor: 'accessing' stamp: 'eem 7/22/2008 11:57'!
closure
	^closureOrNil! !

!Context methodsFor: 'debugger access' stamp: 'ClementBera 5/27/2014 13:49'!
methodClass 
	"Answer the class in which the receiver's method was found."
	
	^self method methodClass ifNil:[self receiver class].! !

!Context methodsFor: 'special context access' stamp: 'ClementBera 5/27/2014 13:49'!
unwindComplete: aBoolean
	"unwindContext only. access temporaries from BlockClosure>>#ensure: and BlockClosure>>#ifCurtailed:"
	self tempAt: 2 put: aBoolean
! !

!Context methodsFor: 'system simulation' stamp: 'ClementBera 5/27/2014 13:49'!
stepToCallee
	"Step to callee or sender"

	| context |
	context := self.
	[ (context := context step) == self ] whileTrue.
	^ context! !

!Context methodsFor: 'printing' stamp: 'ClementBera 5/27/2014 13:49'!
printOn: aStream
    self outerContext
        ifNil: [    
            | selector class mclass |
            self method == nil ifTrue: [^ super printOn: aStream].
            class := self receiver class.
            mclass := self methodClass.
            selector := self selector ifNil:[self method defaultSelector].
            aStream nextPutAll: class name.
            mclass == class 
                ifFalse: 
                    [aStream nextPut: $(.
                    aStream nextPutAll: mclass name.
                    aStream nextPut: $)].
            aStream nextPutAll: '>>'.
            aStream nextPutAll: selector.
            selector = #doesNotUnderstand: ifTrue: [
                aStream space.
                (self tempAt: 1) selector printOn: aStream ] ]
        ifNotNil: [ :outerContext |
             aStream nextPutAll: closureOrNil printString,' in '.
             outerContext printOn: aStream ]! !

!Context methodsFor: 'printing' stamp: 'ClementBera 5/27/2014 13:49'!
debugStack: stackSize on: aStream
	"print a condensed version of the stack up to stackSize on aStream"
	(self stackOfSize: stackSize) do: [:item | 
		item printDebugOn: aStream.
		aStream cr]! !

!Context methodsFor: 'special context access' stamp: 'ClementBera 5/27/2014 13:49'!
exceptionHandlerBlock
	"handlercontext only. access temporaries from BlockClosure>>#on:do:"
	^self tempAt: 2
! !

!Context methodsFor: 'private-exceptions' stamp: 'ClementBera 5/27/2014 13:49'!
findNextUnwindContextUpTo: aContext
	"Return the next unwind marked above the receiver, returning nil if there is none.  Search proceeds up to but not including aContext."

	| context |
	<primitive: 195>
	context := self.
	[
		(context := context sender) == nil
		or: [ context == aContext ]
	] whileFalse: [
		context isUnwindContext
			ifTrue: [ ^context ]].
	^nil! !

!Context methodsFor: 'controlling' stamp: 'ClementBera 5/27/2014 13:49'!
return: value
	"Unwind thisContext to self and return value to self's sender.  Execute any unwind blocks while unwinding.  ASSUMES self is a sender of thisContext"

	sender ifNil: [^self cannotReturn: value to: sender].
	sender resume: value! !

!Context methodsFor: 'private-exceptions' stamp: 'MartinMcClureWithAndresValloud 8/17/2014 07:36'!
canHandleSignal: exception
	"Sent to handler (on:do:) contexts only.  If my exception class (first arg) handles exception then return true, otherwise forward this message to the next handler context.  If none left, return false (see nil>>canHandleSignal:)"

	^ (self exceptionClass handles: exception)
		or: [ self nextHandlerContext canHandleSignal: exception ].
! !

!Context methodsFor: 'debugger access' stamp: 'ClementBera 5/27/2014 13:49'!
sourceCode
	^self method sourceCode.! !

!Context methodsFor: '*OpalCompiler-Core' stamp: 'CamilleTeruel 2/14/2014 16:15'!
sourceNode
	"Return the source node of the method or the block corresponding to the receiver"
	^ (method sourceNodeForPC: self neighborPCWithCorrectMapping) enclosingMethodOrBlockNode
	"Uncomment the following once the pc->AST mapping is fixed"
	"^ (method sourceNodeForPC: (pc ifNil: [ self startpc ])) enclosingMethodOrBlockNode"! !

!Context methodsFor: 'private-exceptions' stamp: 'MartinMcClure 8/18/2014 09:17'!
findNextHandlerOrSignalingContext
	"Return the next handler/signaling marked context, answering nil if there is none. 
	Search starts with self and proceeds up to nil."

	<primitive: 197>
	| context |
	context := self.
	[ 
	context isHandlerOrSignalingContext
		ifTrue: [ ^ context ].
	(context := context sender) == nil ] whileFalse.
	^ nil! !

!Context methodsFor: '*OpalCompiler-Core' stamp: 'CamilleTeruel 2/14/2014 15:16'!
isBlockReturn: aPC
	^ (self method at: aPC) = 125! !

!Context methodsFor: 'debugger access' stamp: 'ClementBera 5/27/2014 13:49'!
longStack
	"Answer a String showing the top 100 contexts on my sender chain."

	^ String streamContents: [ :stream |
		(self stackOfSize: 100) do: [ :item | 
			stream print: item; cr ]]! !

!Context methodsFor: 'accessing' stamp: 'ClementBera 5/27/2014 13:49'!
basicAt: index
	"Primitive. Assumes receiver is indexable. Answer the value of an
	 indexable element in the receiver. Fail if the argument index is not an
	 Integer or is out of bounds. Essential. See Object documentation
	 whatIsAPrimitive.  Override the default primitive to give latitude to
	 the VM in context management."

	<primitive: 210>
	index isInteger ifTrue:
		[self errorSubscriptBounds: index].
	index isNumber
		ifTrue: [^self at: index asInteger]
		ifFalse: [self errorNonIntegerIndex]! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 5/27/2014 13:49'!
pushTemporaryVariable: offset 
	"Simulate the action of bytecode that pushes the contents of the 
	temporary variable whose index is the argument, index, on the top of 
	the stack."

	self push: (self at: offset + 1)! !

!Context methodsFor: 'accessing' stamp: 'ClementBera 5/27/2014 13:49'!
size
	"Primitive. Answer the number of indexable variables in the receiver. 
	This value is the same as the largest legal subscript. Essential. See Object 
	documentation whatIsAPrimitive.  Override the default primitive to give latitude to
	 the VM in context management."

	<primitive: 212>
	"The number of indexable fields of fixed-length objects is 0"
	^self primitiveFail! !

!Context methodsFor: 'private' stamp: 'ClementBera 7/23/2014 14:29'!
simulatePrimitive: primitiveIndex in: aMethod receiver: aReceiver arguments: arguments
	| key simulator |
	
	key := primitiveIndex = 117 
		ifTrue: [ | literal |
			literal := aMethod literalAt: 1.
			"primitive name, module name"
			{literal second. literal first}] 
		ifFalse: [ primitiveIndex ].
	
	simulator := self class specialPrimitiveSimulators at: key ifAbsent: [
		 "named primitives"
		^  primitiveIndex = 117
				ifTrue: [
					self withoutPrimitiveTryNamedPrimitiveIn: aMethod for: aReceiver withArgs: arguments.
					"this uses primitive 218, which doesn't works as expected... 
					self tryNamedPrimitiveIn: method for: receiver withArgs: arguments " ]
				ifFalse: [ aReceiver tryPrimitive: primitiveIndex withArgs: arguments ]]. 
	
	^ simulator 
		simulatePrimitiveFor: aMethod
		receiver: aReceiver
		arguments: arguments
		context: self! !

!Context methodsFor: 'printing' stamp: 'CamilloBruni 7/17/2013 21:58'!
printDetails: stream
	"Put my class>>selector and instance variables and arguments and temporaries on the stream.  Protect against errors during printing."

	| errorMessage string position |
	self printOn: stream.
	stream cr.
	stream tab; nextPutAll: 'Receiver: '.
	errorMessage := '<<error during printing>>'.
	stream nextPutAll: ([receiver printStringLimitedTo: 90] ifError: [errorMessage]).

	stream cr; tab; nextPutAll: 'Arguments and temporary variables: '; cr.
	string := [(self tempsAndValuesLimitedTo: 80 indent: 2) 
				padRightTo:1 with: $x] ifError: [errorMessage].
	stream nextPutAll: (string allButLast).

	stream cr; tab; nextPutAll: 'Receiver''s instance variables: '; cr.
	position := stream position.
	[receiver longPrintOn: stream limitedTo: 80 indent: 2] ifError: [ 
				stream nextPutAll: errorMessage].
	position = stream position ifTrue: ["normal printString for an Array (it has no inst vars)"
		stream nextPutAll: ([receiver printStringLimitedTo: 90] ifError: [errorMessage])].
	stream peekLast == Character cr ifFalse: [stream cr].! !

!Context methodsFor: 'initialize-release' stamp: 'jannik.laval 5/1/2010 16:19'!
privRefreshWith: aCompiledMethod 
	"Reinitialize the receiver as though it had been for a different method. 
	 Used by a Debugger when one of the methods to which it refers is 
	 recompiled."

	aCompiledMethod isCompiledMethod ifFalse:
		[self error: 'method can only be set to aCompiledMethod'].
	method := aCompiledMethod.
	[closureOrNil == nil] assert.
	"was: receiverMap := nil."
	self privRefresh! !

!Context methodsFor: 'controlling' stamp: 'ClementBera 5/27/2014 13:49'!
resume
	"Roll back thisContext to self and resume.  Execute unwind blocks when rolling back.  ASSUMES self is a sender of thisContext"

	self resume: nil! !

!Context methodsFor: 'private' stamp: 'eem 4/25/2012 10:48'!
aboutToReturn: result through: firstUnwindContext 
	"Called from VM when an unwindBlock is found between self and its home.
	 Return to home's sender, executing unwind blocks on the way."

	self methodReturnContext return: result through: firstUnwindContext! !

!Context methodsFor: '*OpalCompiler-Core' stamp: 'CamilleTeruel 2/14/2014 16:04'!
neighborPCWithCorrectMapping
	"Answer a pc inside the enclosing block or mathod that is correctly mapped to an AST node"
	"This is an ugly and temporary fix for Pharo 3. 
	Must be removed as soon as mappings are fixed"
	| neighborPC |
	neighborPC := self isDead 
		ifTrue: [ self startpc ]
		ifFalse: [ pc ].
	"There is a pushLiteral: nil bytecode for each temps in a block. 
	There is a 'pushTemp:' bytecode for each copied value of a block.
	These bytecodes are not mapped to any IR.
	We skip both"
	[ self isPushLiteralNil: neighborPC ] whileTrue: [ neighborPC := neighborPC + 1 ].
	[ self isPushTemp: neighborPC ] whileTrue: [ neighborPC := neighborPC + 1 ].
	"The block return ir instruction is mapped to the block instead of the sequence AST node. So we go just before it"
	(self isBlockReturn: neighborPC) ifTrue: [ neighborPC := neighborPC - 1 ].
	^ neighborPC! !

!Context methodsFor: 'system simulation' stamp: 'ClementBera 5/27/2014 13:49'!
runSimulated: aBlock contextAtEachStep: block2
	"Simulate the execution of the argument, aBlock, until it ends. aBlock 
	MUST NOT contain an '^'. Evaluate block2 with the current context 
	prior to each instruction executed. Answer the simulated value of aBlock."
	| current returnContext exception |
	
	aBlock hasMethodReturn
		ifTrue: [ self error: 'simulation of blocks with ^ can run loose' ].
		
	current := [ aBlock
					on: Exception
					do: [ :ex | SimulationExceptionWrapper signalForException: ex  ] ] asContext.
	
	returnContext := Context
			sender: nil
			receiver: self home receiver
			method: self home method
			arguments: self home arguments.
	
	current pushArgs: Array new from: returnContext.
	
	[current == returnContext]
		whileFalse: [ 
			block2 value: current.
			current := current step ].
	
	exception := returnContext pop.
	exception class == SimulationExceptionWrapper
		ifTrue: [ ^ exception exception signal ].
	^ exception
	! !

!Context methodsFor: 'accessing' stamp: 'MarcusDenker 5/10/2013 21:36'!
activeHome
	"If executing closure, search senders for the activation of the original
	 (outermost) method that (indirectly) created my closure (the closureHome).
	 If the closureHome is not found on the sender chain answer nil."

	| methodReturnContext |
	self isBlockContext ifFalse: [^self].
	self sender ifNil: [^nil].
	methodReturnContext := self methodReturnContext.
	^self sender findContextSuchThat: [:ctxt | ctxt = methodReturnContext]! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 5/27/2014 13:49'!
methodReturnConstant: value
	"Simulate the action of a 'return constant' bytecode whose value is the
	 argument, value. This corresponds to a source expression like '^0'."

	^self return: value from: self methodReturnContext! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 5/27/2014 13:49'!
jump: distance 
	"Simulate the action of a 'unconditional jump' bytecode whose offset is 
	the argument, distance."

	pc := pc + distance! !

!Context methodsFor: 'accessing' stamp: 'MarcusDenker 6/9/2014 16:40'!
receiver 

	^receiver! !

!Context methodsFor: 'controlling' stamp: 'ClementBera 5/27/2014 13:49'!
resume: value through: firstUnwindContext
	"Unwind thisContext to self and resume with value as result of last send.
	 Execute any unwind blocks while unwinding.
	 ASSUMES self is a sender of thisContext."

	| context unwindBlock |
	self isDead 
		ifTrue: [ self cannotReturn: value to: self ].
	context := firstUnwindContext.
	[ context isNil ] whileFalse: [	
		context unwindComplete ifNil:[
			context unwindComplete: true.
			unwindBlock := context unwindBlock.
			thisContext terminateTo: context.
			unwindBlock value].
		context := context findNextUnwindContextUpTo: self].
	thisContext terminateTo: self.
	^value
! !

!Context methodsFor: 'query' stamp: 'ClementBera 5/27/2014 13:49'!
isBottomContext
	"Answer if this is the last context (the first context invoked) in my sender chain"

	^sender isNil! !

!Context methodsFor: '*FuelTests' stamp: 'MarianoMartinezPeck 4/20/2012 21:40'!
assertWellMaterializedInto: aMethodContext in: aTestCase

	aTestCase assert: self ~~ aMethodContext. 
	aTestCase assert: (self class == aMethodContext class).
	aTestCase assert: self tempNames = aMethodContext  tempNames.
	aTestCase assert: pc = aMethodContext pc.
	aTestCase assert: stackp = aMethodContext stackPtr.
	closureOrNil isNil 
		ifTrue: [ aTestCase assert: aMethodContext closure isNil ]
		ifFalse: [ closureOrNil assertWellMaterializedInto: aMethodContext closure in: aTestCase ].
	aTestCase assert: receiver = aMethodContext receiver.
	aTestCase assert: (method isEqualRegardlessTrailerTo: aMethodContext method).
	sender isNil 
		ifTrue: [ aTestCase assert: aMethodContext sender isNil ]
		ifFalse: [ sender assertWellMaterializedInto: aMethodContext sender in: aTestCase ]! !

!Context methodsFor: 'debugger access' stamp: 'ClementBera 5/27/2014 13:49'!
print: anObject on: aStream
	"Safely print anObject in the face of direct ProtoObject subclasses"
	| title |
	(anObject class canUnderstand: #printOn:)
		ifTrue: [ ^ anObject printOn: aStream ].
	title := anObject class name.
	aStream
		nextPutAll: (title first isVowel ifTrue: ['an '] ifFalse: ['a ']);
		nextPutAll: title! !

!Context methodsFor: 'accessing' stamp: 'eem 7/22/2008 11:58'!
methodReturnContext
	"Answer the context from which an ^-return should return from."

	closureOrNil == nil ifTrue:
		[^self].
	^closureOrNil outerContext methodReturnContext! !

!Context methodsFor: 'accessing' stamp: 'ClementBera 5/27/2014 13:49'!
arguments
	"returns the arguments of a message invocation"
	
	| arguments numargs |
	numargs :=  self method numArgs.
	arguments := Array new: numargs.
	1 to: numargs do: [ :i | arguments at: i put: (self tempAt: i) ].
	^ arguments! !

!Context methodsFor: 'query' stamp: 'ClementBera 5/27/2014 13:49'!
findSecondToOldestSimilarSender
	"Search the stack for the second-to-oldest occurance of self's method.  Very useful for an infinite recursion.  Gets back to the second call so you can see one complete recursion cycle, and how it was called at the beginning."

	| secondContext context lastContext |
	secondContext := self.
	context := self.
	[	lastContext := context findSimilarSender.
		lastContext isNil
	] whileFalse: [
		secondContext := context.
		context := lastContext.
	].
	^ secondContext
! !

!Context methodsFor: 'debugger access' stamp: 'ClementBera 5/27/2014 13:49'!
tempNames
	"Answer a SequenceableCollection of the names of the receiver's temporary 
	 variables, which are strings."

	^ self debuggerMap tempNamesForContext: self! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 11/17/2014 16:54'!
callPrimitive: primNumber
	| res |
	res := receiver tryPrimitive: primNumber withArgs: self arguments.
	primNumber >= (1 << 15) ifTrue: [ "inlined primitive, cannot fail" ^ self push: res ].  
	"regular primitive. Always at the beginning of methods."
	(self isFailToken: res) ifTrue: [ "keeps interpreting the method" ^ self ].
	self push: res.
	self methodReturnTop! !

!Context methodsFor: 'debugging' stamp: 'ClementBera 5/27/2014 13:49'!
debug
	^ Smalltalk tools debugger
		openContext: self 
		label: self printString 
		contents: nil
		! !

!Context methodsFor: 'private' stamp: 'ClementBera 5/27/2014 13:49'!
activateReturn: aContext value: value
	"Activate 'aContext return: value' in place of self, so execution will return to aContext's sender"

	^ self
		activateMethod: Context theReturnMethod
		withArgs: {value}
		receiver: aContext
		class: aContext class! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 5/27/2014 13:49'!
pushConstant: value 
	"Simulate the action of bytecode that pushes the constant, value, on the 
	top of the stack."

	self push: value! !

!Context methodsFor: 'controlling' stamp: 'ClementBera 5/27/2014 13:49'!
terminateTo: previousContext
	"Terminate all the Contexts between me and previousContext, if previousContext is on my Context stack. Make previousContext my sender."

	| currentContext sendingContext |
	<primitive: 196>
	(self hasSender: previousContext) ifTrue: [
		currentContext := sender.
		[currentContext == previousContext] whileFalse: [
			sendingContext := currentContext sender.
			currentContext terminate.
			currentContext := sendingContext ]].
	sender := previousContext! !

!Context methodsFor: 'private' stamp: 'ClementBera 5/27/2014 13:49'!
setNamedPrimitiveInformationFrom: fromMethod toMethod: toMethod
	"For named primitives, the first literal contains a special object that has information of the primitive. Example:
(StandardFileStream >> #primOpen:writable:) literalAt: 1 ----->>>>   #(#FilePlugin #primitiveFileOpen 0 147).
In this method we cope such information from one to another one."
	| spec |	
	spec := toMethod literalAt: 1.	
	spec replaceFrom: 1 to: spec size with: (fromMethod literalAt: 1) startingAt: 1.
	
! !

!Context methodsFor: 'query' stamp: 'ClementBera 5/27/2014 13:49'!
copyStack

	^ self copyTo: nil! !

!Context methodsFor: 'query' stamp: 'ClementBera 5/27/2014 13:49'!
hasContext: aContext 
	"Answer whether aContext is me or one of my senders"

	^ (self findContextSuchThat: [ :context | context == aContext ]) notNil! !

!Context methodsFor: 'private-exceptions' stamp: 'BernardoContreras 1/22/2012 16:55'!
cannotReturn: result

	closureOrNil notNil ifTrue:
		[^self cannotReturn: result to: self home sender].
	Smalltalk tools debugger
						openContext: thisContext
						label: 'computation has been terminated'
						contents: nil! !

!Context methodsFor: 'debugger access' stamp: 'ClementBera 5/27/2014 13:49'!
tempsAndValuesLimitedTo: sizeLimit indent: indent
	"Return a string of the temporary variabls and their current values"

	^ String streamContents: [ :aStream |
		self tempNames doWithIndex: [ :title :index |
			indent timesRepeat: [ aStream tab ].
			aStream nextPutAll: title; nextPut: $:; space; tab.
			aStream nextPutAll: 
				((self namedTempAt: index) printStringLimitedTo: (sizeLimit -3 -title size max: 1)).
			aStream cr ]].! !

!Context methodsFor: 'controlling' stamp: 'ClementBera 5/27/2014 13:49'!
jump
	"Abandon thisContext and resume self instead (using the same current process).  You may want to save thisContext's sender before calling this so you can jump back to it.
	Self MUST BE a top context (ie. a suspended context or a abandoned context that was jumped out of).  A top context already has its return value on its stack (see Interpreter>>primitiveSuspend and other suspending primitives).
	thisContext's sender is converted to a top context (by pushing a nil return value on its stack) so it can be jump back to."

	| top |
	"Make abandoned context a top context (has return value (nil)) so it can be jumped back to"
	thisContext sender push: nil.

	"Pop self return value then return it to self (since we jump to self by returning to it)"
	stackp = 0 ifTrue: [self stepToSendOrReturn].
	stackp = 0 ifTrue: [self push: nil].  "must be quick return self/constant"
	top := self pop.
	thisContext privSender: self.
	^ top! !

!Context methodsFor: 'private' stamp: 'ClementBera 5/27/2014 13:49'!
insertSender: aContext
	"Insert aContext and its sender chain between me and my sender.  Return new callee of my original sender."

	| context |
	context := aContext bottomContext.
	context privSender: self sender.
	self privSender: aContext.
	^ context! !

!Context methodsFor: 'closure support' stamp: 'md 1/20/2006 17:17'!
asContext

	^ self! !

!Context methodsFor: 'private' stamp: 'eem 4/26/2012 10:17'!
endPC
	^closureOrNil
		ifNil:	[self method endPC]
		ifNotNil: [closureOrNil endPC]! !

!Context methodsFor: 'debugger access' stamp: 'ClementBera 5/27/2014 13:49'!
swapSender: coroutine 
	"Replace the receiver's sender with coroutine and answer the receiver's 
	previous sender. For use in coroutining."

	| oldSender |
	oldSender := sender.
	sender := coroutine.
	^oldSender! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 7/23/2014 14:28'!
send: selector super: superFlag numArgs: numArgs
	"Simulate the action of bytecodes that send a message with selector, 
	selector. The argument, superFlag, tells whether the receiver of the 
	message was specified with 'super' in the source method. The arguments 
	of the message are found in the top numArgs locations on the stack and 
	the receiver just below them."

	| currentReceiver arguments  |
	arguments := Array new: numArgs.
	numArgs to: 1 by: -1 do: [ :i | 
		arguments at: i put: self pop ].
	currentReceiver := self pop.
"	selector == #doPrimitive:method:receiver:args:
		ifTrue: [answer := receiver 
					doPrimitive: (arguments at: 1)
					method: (arguments at: 2)
					receiver: (arguments at: 3)
					args: (arguments at: 4).
				self push: answer.
				^self]. "
	QuickStep == self ifTrue: [
		QuickStep := nil.
		^ self quickSend: selector to: currentReceiver with: arguments super: superFlag].
	^ self send: selector to: currentReceiver with: arguments super: superFlag! !

!Context methodsFor: 'accessing' stamp: 'ClementBera 5/27/2014 13:49'!
methodNode
	^ self method methodNode.! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 5/27/2014 13:49'!
jump: distance if: condition 
	"Simulate the action of a 'conditional jump' bytecode whose offset is the 
	argument, distance, and whose condition is the argument, condition."

	| bool |
	bool := self pop.
	(bool == true or: [bool == false]) ifFalse: [
		^self
			send: #mustBeBooleanIn:
			to: bool
			with: {self}
			super: false].
	(bool eqv: condition) ifTrue: [self jump: distance]! !

!Context methodsFor: 'controlling' stamp: 'ClementBera 5/27/2014 13:49'!
pop
	"Answer the top of the receiver's stack and remove the top of the stack."
	| value |
	value := self at: stackp.
	self stackp: stackp - 1.
	^ value! !

!Context methodsFor: 'query' stamp: 'ClementBera 5/27/2014 13:49'!
findContextSuchThat: testBlock
	"Search self and my sender chain for first one that satisfies testBlock.  Return nil if none satisfy"

	| context |
	context := self.
	[ context isNil ] whileFalse: [
		(testBlock value: context) 
			ifTrue: [ ^ context ].
		context := context sender ].
	^ nil! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 5/27/2014 13:49'!
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
	"Simulate the action of a 'closure copy' bytecode whose result is the
	 new BlockClosure for the following code"
	| copiedValues |
	numCopied > 0
		ifTrue: [
			copiedValues := Array new: numCopied.
			numCopied to: 1 by: -1 do: [ :i |
				copiedValues at: i put: self pop ]]
		ifFalse: [ copiedValues := nil ].
	self push: (BlockClosure
				outerContext: self
				startpc: pc
				numArgs: numArgs
				copiedValues: copiedValues).
	self jump: blockSize! !

!Context methodsFor: 'private' stamp: 'ClementBera 12/30/2014 17:10'!
withoutPrimitiveTryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments
"When using the debugger we want to run a method step by step. What what happens when we do a step into a CompiledMethod which has a primitive? If such a method is executed form outside the Debugger (normal scenario) the VM knows that such CompiledMethod has a primitive declaration and hence executes it. If it fails then it continues executing all the bytecode of the method. Otherwise, it just returns. 

Now, what is the problem with the Debugger? The problem is that if the primitive fail, we don't want that the VM directly executes all the remaining bytecodes of the method. Instead, we would like to go step by step witht he Debugger, just as happens with normal methods. 

To solve the mentioned problem, we use the following trick: We have the orignal compiled method (the one that has a primitive invokation), the receiver and the arguments. So the idea is to use a template compiled method that ONLY contains the primitive delcaration (it doesn't include all the smalltalk code after the primitive). #tryNamedPrimitiveTemplateMethod answers such a template method which looks like:

tryNamedPrimitive
	<primitive:'' module:''>
	^ Context primitiveFailToken'

 Since this method does not change its bytecodes for every invokation, we can reuse it for all methods with primitives. There are only 2 things we have to change in the template: the number of arguments and the primitive declaration (to use the correct primitive name and module name).

Then what we do is to run that compiled method with the receiver and arguments we have. The result is that we will be invoking almost the same original method but a slighly different version that does not have the smalltalk part after the primitive and that in contrast is sends #primitiveFailToken. If this method invokation does not fail, then the Debugger continues debugging the sender of the primitive method. In this case, the step in is the same as step over. If the primitive fails, then the debugger continues executing the smalltalk part after the primitive method. In this case, step in is a real step in.  "	
	| theMethod  |
	arguments size > 8 
		ifTrue: [ ^ self class primitiveFailToken ].
	theMethod := self class tryNamedPrimitiveTemplateMethod.
	theMethod prepareForSimulationWith: arguments size.
	theMethod == nil 
		ifTrue: [ ^ self class primitiveFailToken ].
	self setNamedPrimitiveInformationFrom: aCompiledMethod toMethod: theMethod.
	theMethod flushCache.
	
	^ theMethod valueWithReceiver: aReceiver arguments: arguments! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 5/27/2014 13:49'!
storeIntoLiteralVariable: value 
	"Simulate the action of bytecode that stores the top of the stack into a 
	literal variable of my method."

	value value: self top! !

!Context methodsFor: 'system simulation' stamp: 'MarcusDenker 6/9/2014 16:40'!
pushArgs: arguments from: senderContext
	"Helps simulate action of the value primitive for closures.
	 This is used by Context>>runSimulated:contextAtEachStep:"

	closureOrNil
		ifNil: [self error: 'context needs a closure!!']
		ifNotNil: [
			"See BlockClosure>>asContextWithSender:"
			 stackp ~= (closureOrNil numArgs + closureOrNil numCopiedValues) 
				ifTrue: [ self error: 'stack pointer is incorrect!!' ]].

	1 to: closureOrNil numArgs do: [:i |
		self at: i put: (arguments at: i)].
	sender := senderContext! !

!Context methodsFor: 'private' stamp: 'ClementBera 5/27/2014 13:49'!
cut: aContext
	"Cut aContext and its senders from my sender chain"

	| context callee |
	context := self.
	[ context == aContext ] whileFalse: [
		callee := context.
		context := context sender.
		context ifNil: [
			aContext ifNotNil: [
				self error: 'aContext not a sender' ]]].
	callee privSender: nil.
! !

!Context methodsFor: 'private' stamp: 'ClementBera 5/27/2014 13:49'!
stackp: newStackp
	"Storing into the stack pointer is a potentially dangerous thing.
	This primitive stores nil into any cells that become accessible as a result,
	and it performs the entire operation atomically."
	"Once this primitive is implemented, failure code should cause an error"

	<primitive: 76>
	self error: 'stackp store failure'.
"
	stackp == nil ifTrue: [stackp := 0].
	newStackp > stackp  'effectively checks that it is a number'
		ifTrue: [oldStackp := stackp.
				stackp := newStackp.
				'Nil any newly accessible cells'
				oldStackp + 1 to: stackp do: [:i | self at: i put: nil]]
		ifFalse: [stackp := newStackp]
"! !

!Context methodsFor: 'query' stamp: 'ClementBera 5/27/2014 13:49'!
copyTo: aContext
	"Copy self and my sender chain down to, but not including, aContext.  End of copied chain will have nil sender.  BlockContexts whose home is also copied will point to the copy.  However, blockContexts that are not on the stack but may be later will not have their home pointing in the new copied thread.  So an error will be raised if one of these tries to return directly to its home.  It is best to use BlockClosures instead.  They only hold a ContextTag, which will work for all copies of the original home context."

	^ self copyTo: aContext blocks: IdentityDictionary new! !

!Context methodsFor: 'query' stamp: 'ClementBera 5/27/2014 13:49'!
isDead
	"Has self finished"

	^ pc isNil! !

!Context methodsFor: 'debugger access' stamp: 'ClementBera 5/27/2014 13:49'!
sender
	"Answer the context that sent the message that created the receiver."

	^sender! !

!Context methodsFor: 'printing' stamp: 'ClementBera 5/28/2014 13:31'!
printDebugOn: aStream	
	"print a condensed for of the stack.
		For methods simply print Class >> selector
		For blocks only print the first line"
	| blockSource blockSourceSize |
	
	self printOn: aStream.
	self outerContext ifNil: [ ^ self ].
	"print the block..."
	aStream 
		nextPutAll: ' in Block: '.
	
	blockSource := closureOrNil printStringLimitedTo: 50.
	blockSourceSize := blockSource size.
	blockSource := blockSource copyUpTo: Character cr.
	
	aStream nextPutAll: blockSource.
	blockSource size < blockSourceSize
		ifTrue: [ aStream nextPutAll: '...' ].! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 5/27/2014 13:49'!
methodReturnTop
	"Simulate the action of a 'return top of stack' bytecode. This corresponds
	 to source expressions like '^something'."

	^self return: self pop from: self methodReturnContext! !

!Context methodsFor: 'accessing' stamp: 'ClementBera 5/27/2014 13:49'!
methodSelector
	^ self method selector! !

!Context methodsFor: 'private-exceptions' stamp: 'CamilloBruni 7/17/2013 22:00'!
receiver: anObject

	receiver := anObject! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 5/27/2014 13:49'!
pushActiveContext
	"Simulate the action of bytecode that pushes the the active context on the 
	top of its own stack."

	self push: self! !

!Context methodsFor: 'private' stamp: 'ClementBera 7/23/2014 14:31'!
doPrimitive: primitiveIndex method: aMethod receiver: aReceiver args: arguments
	"Simulate a primitive method whose index is primitiveIndex. The simulated receiver and arguments are given as arguments to this message. Any primitive which provikes execution needs to be intercepted and simulated to avoid execution running away."

	| value |
	<primitive: 19> "Simulation guard"
	"If successful, push result and return resuming context,
		else ^ PrimitiveFailToken"
"	(primitiveIndex = 19) ifTrue:
		[Smalltalk tools debugger
			openContext: self
			label:'Code simulation error'
			contents: nil].
"
	primitiveIndex = 83 "Object>>perform:[with:...]"
		ifTrue: [^self send: arguments first to: aReceiver
					with: arguments allButFirst
					super: false].
	primitiveIndex = 84 "Object>>perform:withArguments:"
		ifTrue: [^self send: arguments first to: aReceiver
					with: (arguments at: 2)
					super: false].
	primitiveIndex = 188 ifTrue: [
		arguments size = 2 ifTrue: [ "Object>>withArgs:executeMethod:"
			^Context
				sender: self
				receiver: aReceiver
				method: (arguments at: 2)
				arguments: (arguments at: 1) ].
		arguments size = 3 ifTrue: [ "CompiledMethod class >> #receiver:withArguments:executeMethod:"
			^Context
				sender: self
				receiver: (arguments at: 1)
				method: (arguments at: 3)
				arguments: (arguments at: 2) ] ].
	primitiveIndex = 189 ifTrue: [ "Object >> (#with:)*executeMethod"
		^Context
			sender: self
			receiver: aReceiver
			method: arguments last
			arguments: arguments allButLast ].

	"Closure primitives"
	(primitiveIndex = 200 and: [aReceiver == self]) ifTrue:
		"ContextPart>>closureCopy:copiedValues:; simulated to get startpc right"
		[^self push: (BlockClosure
						outerContext: aReceiver
						startpc: pc + 2
						numArgs: arguments first
						copiedValues: arguments last)].

	((primitiveIndex between: 201 and: 205)                  "BlockClosure>>value[:value:...]"
	or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]"
		[^aReceiver simulateValueWithArguments: arguments caller: self].

	primitiveIndex = 206 ifTrue:                                            "BlockClosure>>valueWithArguments:"
		[^aReceiver simulateValueWithArguments: arguments first caller: self].

	primitiveIndex = 120 ifTrue:[  "FFI method"
		value := aMethod literals first tryInvokeWithArguments: arguments. ] 
	ifFalse:[
		value := self simulatePrimitive: primitiveIndex in: aMethod receiver: aReceiver  arguments: arguments ].
	
	^ (self isFailToken:  value)
		ifTrue: [value]
		ifFalse: [self push: value]
		! !

!Context methodsFor: 'private-exceptions' stamp: 'MartinMcClure 8/18/2014 13:55'!
findNextHandlerContext
	"Return the next handler marked context, returning nil if there is none.  Search starts with self and proceeds up to nil."

	| context |
	context := self findNextHandlerOrSignalingContext.
	context isNil
		ifTrue: [ ^ nil ].
	context isHandlerContext
		ifTrue: [ ^ context ].	"If it isn't a handler context, it must be a signaling context.
	When we reach a signaling context we must skip over any handlers
	that might be on the stack between the signaling context and the handler
	context for that signal."
	^ context exception privHandlerContext nextHandlerContext! !

!Context methodsFor: 'query' stamp: 'ClementBera 5/27/2014 13:49'!
secondFromBottom
	"Return the second from bottom of my sender chain"

	self sender ifNil: [ ^ nil ].
	^ self findContextSuchThat: [ :context |
		context sender sender isNil]! !

!Context methodsFor: 'accessing' stamp: 'ClementBera 5/27/2014 13:49'!
at: index put: value
	"Primitive. Assumes receiver is indexable. Answer the value of an
	 indexable element in the receiver. Fail if the argument index is not
	 an Integer or is out of bounds. Essential. See Object documentation
	 whatIsAPrimitive.  Override the default primitive to give latitude to
	 the VM in context management."

	<primitive: 211>
	index isInteger ifTrue:
		[self errorSubscriptBounds: index].
	index isNumber
		ifTrue: [^self at: index asInteger put: value]
		ifFalse: [self errorNonIntegerIndex]! !

!Context methodsFor: 'controlling' stamp: 'ClementBera 5/27/2014 13:49'!
closureCopy: numArgs copiedValues: anArray
	"Distinguish a block of code from its enclosing method by 
	creating a BlockClosure for that block. The compiler inserts into all 
	methods that contain blocks the bytecodes to send the message 
	closureCopy:copiedValues:. Do not use closureCopy:copiedValues: in code that you write!! Only the 
	compiler can decide to send the message closureCopy:copiedValues:. Fail if numArgs is 
	not a SmallInteger. Optional. No Lookup. See Object documentation 
	whatIsAPrimitive."

	<primitive: 200>
	^BlockClosure 
		outerContext: self
		startpc: pc + 2
		numArgs: numArgs
		copiedValues: anArray! !

!Context methodsFor: 'controlling' stamp: 'ClementBera 5/27/2014 13:49'!
return: value through: firstUnwindContext
	"Unwind thisContext to self and return value to self's sender.
	 Execute any unwind blocks while unwinding.
	 ASSUMES self is a sender of thisContext."

	sender ifNil: [self cannotReturn: value to: sender].
	sender resume: value through: firstUnwindContext! !

!Context methodsFor: 'private-exceptions' stamp: 'MartinMcClure 8/18/2014 09:12'!
isHandlerOrSignalingContext
	"Both BlockClosure>>on:do: (handler) and Context>>evaluateSignal: (signaling) 
	are marked with primitive 199."
	^method primitive = 199! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 5/27/2014 13:49'!
pushReceiverVariable: offset 
	"Simulate the action of bytecode that pushes the contents of the receiver's 
	instance variable whose index is the argument, index, on the top of the 
	stack."

	self push: (self receiver instVarAt: offset + 1)! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 5/27/2014 13:49'!
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
	"Simulate the action of bytecode that pushes the value at remoteTempIndex
	 in one of my local variables being used as a remote temp vector."
	self push: ((self at: tempVectorIndex + 1) at: remoteTempIndex + 1)! !

!Context methodsFor: 'accessing' stamp: 'eem 8/20/2008 09:29'!
tempAt: index put: value 
	"Store the argument, value, as the temporary variable whose index is the 
	 argument, index.  Primitive. Assumes receiver is indexable. Answer the
	 value of an indexable element in the receiver. Fail if the argument index
	 is not an Integer or is out of bounds. Essential. See Object documentation
	 whatIsAPrimitive.  Override the default at:put: primitive to give latitude to
	 the VM in context management."

	<primitive: 211>
	^self at: index put: value! !

!Context methodsFor: 'accessing' stamp: 'GuillermoPolito 4/9/2015 13:22'!
tempNamed: aName
	"Returns the value of the temporaries, aName."

	"Implementation notes: temporary initialization in blocks simply uses pushNil to allocate and initialize each temp.  So if one inspects [|a|a:=2] and sends it self method symbolic you get:

	13 <8F 00 00 05> closureNumCopied: 0 numArgs: 0 bytes 17 to 21
	17 	<73> pushConstant: nil
	18 	<77> pushConstant: 2
	19 	<81 40> storeIntoTemp: 0
	21 	<7D> blockReturn
	22 <7C> returnTop

	And when we check self asContext pc we get 17, which is *before* the nil is pushed. Therefore we should pay attention when querying a temporary if the temporary allocation was executed."

	| index |
	index := self tempNames indexOf: aName.
	^ self namedTempAt: index! !

!Context methodsFor: 'debugger access' stamp: 'ClementBera 5/27/2014 13:49'!
stack 
	"Answer an Array of the contexts on the receiver's sender chain."

	^self stackOfSize: 9999! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 5/27/2014 13:49'!
storeIntoTemporaryVariable: offset 
	"Simulate the action of bytecode that stores the top of the stack into one 
	of my temporary variables."

	self at: offset + 1 put: self top! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 5/27/2014 13:49'!
methodReturnReceiver
	"Simulate the action of a 'return receiver' bytecode. This corresponds to
	 the source expression '^self'."

	^self return: self receiver from: self methodReturnContext! !

!Context methodsFor: 'instruction decoding' stamp: 'jannik.laval 5/1/2010 16:19'!
blockReturnTop
	"Simulate the interpreter's action when a ReturnTopOfStackToCaller bytecode is 
	 encountered in the receiver.  This should only happen in a closure activation."
	[closureOrNil isClosure] assert.
	^self return: self pop from: self! !

!Context methodsFor: 'debugger access' stamp: 'ClementBera 5/27/2014 13:49'!
depthBelow: aContext
	"Answer how many calls there are between this and aContext."

	| context depth |
	context := self.
	depth := 0.
	[ context == aContext or: [ context == nil ]]
		whileFalse: [
			context := context sender.
			depth := depth + 1 ].
	^ depth! !

!Context methodsFor: '*FuelTests' stamp: 'MarianoMartinezPeck 5/22/2011 23:07'!
initializeWith: aPc stackPtr: aStackPtr method: aMethod receiver: aReceiver sender: aSender
	pc := aPc.
	stackp := aStackPtr.
	method := aMethod.
	receiver := aReceiver.
	sender := aSender.
	! !

!Context methodsFor: 'private' stamp: 'ClementBera 5/27/2014 13:49'!
stackPtr  
	"For use only by the SystemTracer and the Debugger, Inspectors etc"
	^ stackp! !

!Context methodsFor: 'special context access' stamp: 'MartinMcClure 8/18/2014 09:20'!
exception
	"signaling context (Context>>evaluateSignal:) only. Access the exception argument."
	^self tempAt: 1
! !

!Context methodsFor: 'controlling' stamp: 'ClementBera 5/27/2014 13:49'!
restart
	"Unwind thisContext to self and resume from beginning.  Execute unwind blocks when unwinding.  ASSUMES self is a sender of thisContext"

	| context unwindBlock |
	self isDead ifTrue: [self cannotReturn: nil to: self].
	self privRefresh.
	context := thisContext.
	[	context := context findNextUnwindContextUpTo: self.
		context isNil 
	] whileFalse: [
		context unwindComplete ifNil:[
			context unwindComplete: true.
			unwindBlock := context unwindBlock.
			thisContext terminateTo: context.
			unwindBlock value ]].
	
	thisContext terminateTo: self.
	self jump.
! !

!Context methodsFor: 'query' stamp: 'ClementBera 5/27/2014 13:49'!
bottomContext
	"Return the last context (the first context invoked) in my sender chain"

	^ self findContextSuchThat: [ :context | context sender isNil]! !

!Context methodsFor: 'debugger access' stamp: 'ClementBera 5/27/2014 13:49'!
stackOfSize: limit 
	"Answer an OrderedCollection of the top 'limit' contexts
	 on the receiver's sender chain."

	| stack context |
	stack := OrderedCollection new.
	stack addLast: (context := self).
	[(context := context sender) ~~ nil
	 and: [stack size < limit]] whileTrue: [
		stack addLast: context ].
	^ stack! !

!Context methodsFor: 'debugger access' stamp: 'ClementBera 5/27/2014 13:49'!
selector
	"Answer the selector of the method that created the receiver."

	^self method selector ifNil: [self method defaultSelector].! !

!Context methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 5/2/2012 22:15'!
tempNamed: aName put: anObject
	^self namedTempAt: (self tempNames indexOf: aName) put: anObject! !

!Context methodsFor: 'private' stamp: 'CamilloBruni 7/17/2013 21:57'!
instVarAt: index put: value
	index = 3 
		ifTrue: [
			self stackp: value. 
			^ value].
	^ super instVarAt: index put: value! !

!Context methodsFor: '*Fuel' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper

	^aGeneralMapper visitMethodContext: self! !

!Context methodsFor: 'controlling' stamp: 'ClementBera 5/27/2014 13:49'!
terminate
	"Make myself unresumable."

	sender := nil.
	pc := nil.
! !

!Context methodsFor: 'private' stamp: 'ClementBera 5/27/2014 13:49'!
copyTo: aContext blocks: dict
	"Copy self and my sender chain down to, but not including, aContext.  End of copied chain will have nil sender.  BlockContexts whose home is also copied will point to the copy.  However, blockContexts that are not on the stack but may be later will not have their home pointing in the new copied thread.  So an error will be raised if one of these tries to return directly to its home."

	| copy |
	self == aContext ifTrue: [^ nil].
	copy := self copy.
	dict at: self ifPresent: [ :blocks | 
		blocks do: [ :block | 
			block privHome: copy ]].
	self sender ifNotNil: [
		copy privSender: (self sender copyTo: aContext blocks: dict)].
	^ copy! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 5/27/2014 13:49'!
popIntoLiteralVariable: value 
	"Simulate the action of bytecode that removes the top of the stack and 
	stores it into a literal variable of my method."

	value value: self pop! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 5/27/2014 13:49'!
return: value from: aSender 
	"For simulation.  Roll back self to aSender and return value from it.  Execute any unwind blocks on the way.  ASSUMES aSender is a sender of self"

	| newTop context |
	aSender isDead ifTrue: [
		^ self send: #cannotReturn: to: self with: {value} super: false ].
	newTop := aSender sender.
	context := self findNextUnwindContextUpTo: newTop.
	context ifNotNil: [
		^ self send: #aboutToReturn:through: to: self with: {value. context} super: false] .
	self releaseTo: newTop.
	newTop ifNotNil: [ newTop push: value ].
	^ newTop
! !

!Context methodsFor: 'controlling' stamp: 'MarcusDenker 6/9/2014 16:40'!
activateMethod: newMethod withArgs: args receiver: rcvr class: class 
	"Answer a Context initialized with the arguments."

	^Context 
		sender: self
		receiver: rcvr
		method: newMethod
		arguments: args! !

!Context methodsFor: 'accessing' stamp: 'MarcusDenker 5/10/2013 21:36'!
activeOuterContext
	"If executing closure, search senders for the activation in which the receiver's
	 closure was created (the receiver's outerContext).  If the outerContext is not
	 found on the sender chain answer nil."

	| outerContext |
	self isBlockContext ifFalse: [^self].
	self sender ifNil: [^nil].
	outerContext := self outerContext.
	^self sender findContextSuchThat: [:ctxt | ctxt = outerContext]! !

!Context methodsFor: 'accessing' stamp: 'ClementBera 5/27/2014 13:49'!
at: index
	"Primitive. Assumes receiver is indexable. Answer the value of an
	 indexable element in the receiver. Fail if the argument index is not an
	 Integer or is out of bounds. Essential. See Object documentation
	 whatIsAPrimitive.  Override the default primitive to give latitude to
	 the VM in context management."

	<primitive: 210>
	index isInteger ifTrue:
		[self errorSubscriptBounds: index].
	index isNumber
		ifTrue: [^self at: index asInteger]
		ifFalse: [self errorNonIntegerIndex]! !

!Context methodsFor: 'debugger access' stamp: 'ClementBera 5/27/2014 13:49'!
namedTempAt: index put: aValue
	"Set the value of the temp at index in the receiver's sequence of tempNames.
	 (Note that if the value is a copied value it is also set out along the lexical chain,
	  but alas not in along the lexical chain.)."
	^self debuggerMap namedTempAt: index put: aValue in: self! !

!Context methodsFor: 'controlling' stamp: 'ClementBera 5/27/2014 13:49'!
push: value 
	"Push value on the receiver's stack."

	self stackp: stackp + 1.
	self at: stackp put: value! !

!Context methodsFor: 'accessing' stamp: 'ClementBera 9/27/2013 17:56'!
outerContext
	"Answer the context within which the receiver is nested."

	^closureOrNil ifNotNil:
		[closureOrNil outerContext]! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 5/27/2014 13:49'!
doPop
	"Simulate the action of a 'remove top of stack' bytecode."

	self pop! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 12/28/2014 17:36'!
blockReturnConstant: value 
	"Simulate the interpreter's action when a ReturnConstantToCaller
	bytecode is 
	encountered in the receiver. This should only happen in a closure
	activation. "
	self assert: closureOrNil isClosure.
	^ self return: value from: self
! !

!Context methodsFor: 'private-exceptions' stamp: 'CamilloBruni 7/17/2013 22:01'!
swapReceiver: newReceiver

	receiver := newReceiver! !

!Context methodsFor: 'private' stamp: 'eem 7/22/2008 12:00'!
startpc
	^closureOrNil
		ifNil:	[self method initialPC]
		ifNotNil: [closureOrNil startpc]! !

!Context methodsFor: 'debugger access' stamp: 'MarcusDenker 6/9/2014 16:40'!
errorReportOn: stream
	"Write a detailed error report on the stack (above me) on a  
	stream.  For both the error file, and emailing a bug report.   
	Suppress any errors while getting printStrings.  Limit the length."
	
	| stackDepth aContext startPos |
	stream print: Date today; space; print: Time now; cr.
	stream cr.
	stream nextPutAll: 'VM: ';
		nextPutAll: Smalltalk os name asString;
		nextPutAll: ' - ';	
		nextPutAll: Smalltalk os subtype asString;
		nextPutAll: ' - ';
		nextPutAll: Smalltalk os version asString;
		nextPutAll: ' - ';
		nextPutAll: Smalltalk vm version asString;
		cr.	
	stream nextPutAll: 'Image: ';
		nextPutAll:  SystemVersion current version asString;
		nextPutAll: ' [';
		nextPutAll: Smalltalk lastUpdateString asString;
		nextPutAll: ']';
		cr.
	stream cr.
	"Note: The following is an open-coded version of  Context>>stackOfSize: since this method may be called during a  low space condition and we might run out of space for allocating the  full stack."	
	stackDepth := 0.  
	startPos := stream position.
	aContext := self.
	[ aContext notNil and: [ (stackDepth := stackDepth + 1) < 40 ]] 
		whileTrue: [
			"variable values"
			aContext printDetails: stream.
			stream cr.
			aContext := aContext sender ].
	stream cr; nextPutAll: '--- The full stack ---'; cr.
	aContext := self.	
	stackDepth := 0.
	[ aContext == nil ] whileFalse:	[
		stackDepth := stackDepth + 1.	
		stackDepth = 40 ifTrue: [ stream nextPutAll: ' - - - - - - - - - - - - - - -  
			- - - - - - - - - - - - - - - - - -'; cr ].
		"just class>>selector"	
		stream print: aContext; cr. 		
		stream position > (startPos+150000) 
			ifTrue: [
				stream nextPutAll:  '...etc...'.	
			 	"exit early"		
				^ self].	
		stackDepth > 200 ifTrue: [
			stream nextPutAll: '-- and more not shown --'.
			^  self ].
		aContext := aContext sender ].! !

!Context methodsFor: 'private' stamp: 'ClementBera 7/23/2014 14:31'!
tryPrimitiveFor: aMethod receiver: aReceiver args: arguments 
	"If this method has a primitive index, then run the primitive and return its result.
	Otherwise (and also if the primitive fails) return PrimitiveFailToken,
	as an indication that the method should be activated and run as bytecodes."
	| primIndex |
	(primIndex := aMethod primitive) = 0 
		ifTrue: [ ^ self class primitiveFailToken ].
	^ self doPrimitive: primIndex method: aMethod receiver: aReceiver args: arguments! !

!Context methodsFor: 'testing' stamp: 'SeanDeNigris 5/24/2013 11:07'!
callChainAnySatisfy: aBlock

	(aBlock value: self) ifTrue: [ ^ true ].
	self sender ifNil: [ ^ false ].
	^ self sender callChainAnySatisfy: aBlock.! !

!Context methodsFor: 'private' stamp: 'CamilloBruni 7/17/2013 22:01'!
setSender: newSender receiver: newReceiver method: newMethod arguments: arguments 
	"Create the receiver's initial state."

	sender := newSender.
	receiver := newReceiver.
	method := newMethod.
	closureOrNil := nil.
	pc := method initialPC.
	self stackp: method numTemps.
	1 to: arguments size do: [ :i | 
		self at: i put: (arguments at: i)]! !

!Context methodsFor: 'system simulation' stamp: 'ClementBera 5/27/2014 13:49'!
completeCallee: aContext
	"Simulate the execution of bytecodes until a return to the receiver."
	| context current nextContext |
	context := aContext.
	[ context == current or: [ context hasSender: self ] ]
		whileTrue: [
			current := context.
			nextContext := context quickStep.
			nextContext ifNil: [ self halt ].
			context := nextContext ].
	^ self stepToSendOrReturn! !

!Context methodsFor: 'instruction decoding' stamp: 'CamilloBruni 7/17/2013 22:00'!
pushConsArrayWithElements: numElements 
	| array |
	array := Array new: numElements.
	numElements to: 1 by: -1 do: [ :i |
		array at: i put: self pop ].
	self push: array! !

!Context methodsFor: 'controlling' stamp: 'ClementBera 7/23/2014 14:30'!
send: selector to: aReceiver with: arguments super: superFlag 
	"Simulate the action of sending a message with selector, selector, and 
	arguments, args, to receiver. The argument, superFlag, tells whether the 
	receiver of the message was specified with 'super' in the source method."

	| class aMethod value context |
	class := superFlag
			ifTrue: [(self method literalAt: self method numLiterals) value superclass]
			ifFalse: [aReceiver class].
	aMethod := class lookupSelector: selector.
	aMethod == nil ifTrue: [ 
		^ self 
			send: #doesNotUnderstand:
			to: aReceiver
			with: (Array with: (Message selector: selector arguments: arguments))
			super: superFlag ].
	
	value := self tryPrimitiveFor: aMethod receiver: aReceiver args: arguments.

	"primitive runs without failure?"
	(self isFailToken: value) ifFalse: [^ value].
	
	(selector == #doesNotUnderstand: and: [ (class canUnderstand: #doesNotUnderstand: ) not ]) 
		ifTrue: [
			^self error: 'Simulated message ', (arguments at: 1) selector, ' not understood'].
	
	"failure.. lets activate the method"
	context := self activateMethod: aMethod withArgs: arguments receiver: aReceiver class: class.
	
	"check if activated method handles the error code (a first bytecode will be store into temp)"
	"long store temp" 
	 (context method at: context pc ) = 129 
		ifTrue: [ context at: context stackPtr put: value last ].
	^ context! !

!Context methodsFor: 'accessing' stamp: ''!
method

	^method! !

!Context methodsFor: 'controlling' stamp: 'ClementBera 5/27/2014 13:49'!
return: value to: aSender
	"Simulate the return of value to aSender."

	self releaseTo: aSender.
	aSender ifNil: [^ nil].
	^ aSender push: value! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 5/27/2014 13:49'!
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
	"Simulate the action of bytecode that stores the top of the stack at
	 an offset in one of my local variables being used as a remote temp vector."

	(self at: tempVectorIndex + 1) at: remoteTempIndex + 1 put: self top! !

!Context methodsFor: 'private' stamp: 'ClementBera 5/27/2014 13:49'!
tryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments
	<primitive: 218 error: errorCode>
	errorCode ifNotNil: [
		"If errorCode is an integer other than -1 there was a problem with primitive 218,
		 not with the external primitive itself.  -1 indicates a generic failure (where
		 errorCode should be nil) but errorCode = nil means primitive 218 is not implemented.  So
		 interpret -1 to mean the external primitive failed with a nil error code."
		errorCode isInteger 
			ifTrue: [
				errorCode = -1
					ifTrue: [ errorCode := nil ]
					ifFalse: [ self primitiveFailed ]].
				^  self class primitiveFailTokenFor: errorCode ].
	"Assume a nil error code implies the primitive is not implemented and fall back on the old code."
	
	"The primitive doesn't exist or there was an error. Hence, we follow another solution without the primitive"
	^ self 
		withoutPrimitiveTryNamedPrimitiveIn: aCompiledMethod
		for: aReceiver
		withArgs: arguments
! !

!Context methodsFor: 'debugger access' stamp: 'ClementBera 5/27/2014 13:49'!
singleRelease
	"Remove information from the receiver in order to break circularities."

	stackp ifNotNil: [
		1 to: stackp do: [ :i |
			self at: i put: nil ]].
	sender := nil.
	pc := nil.
! !

!Context methodsFor: 'accessing' stamp: 'eem 4/26/2012 10:51'!
numArgs
	"Answer the number of arguments for this activation."
	^closureOrNil
		ifNil: [method numArgs]
		ifNotNil: [closureOrNil numArgs]! !

!Context methodsFor: 'controlling' stamp: 'ClementBera 5/27/2014 13:49'!
hasSender: context 
	"Answer whether the receiver is strictly above context on the stack."

	| senderContext |
	self == context 
		ifTrue: [^false].
	senderContext := sender.
	[senderContext == nil]
		whileFalse: [
			senderContext == context
				ifTrue: [^true].
			senderContext := senderContext sender].
	^false! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 5/27/2014 13:49'!
pushLiteralVariable: value 
	"Simulate the action of bytecode that pushes the contents of the literal 
	variable whose index is the argument, index, on the top of the stack."

	self push: value value! !

!Context methodsFor: 'accessing' stamp: 'eem 4/26/2012 10:58'!
numTemps
	"Answer the number of temporaries for this activation; this includes
	 the number of arguments, and for blocks, the number of copied values."
	^closureOrNil
		ifNil: [method numTemps]
		ifNotNil: [closureOrNil numTemps]! !

!Context methodsFor: 'private' stamp: 'CamilloBruni 7/17/2013 22:01'!
setSender: newSender receiver: newReceiver method: newMethod closure: newClosure startpc: startpc
	"Create the receiver's initial state."

	sender := newSender.
	receiver := newReceiver.
	method := newMethod.
	closureOrNil := newClosure.
	pc := startpc.
	stackp := 0! !

!Context methodsFor: 'controlling' stamp: 'ClementBera 5/27/2014 13:49'!
shortDebugStack
	"Answer a String showing the top ten contexts on my sender chain."

	^ String streamContents: [:stream |
		self debugStack: 10 on: stream]! !

!Context methodsFor: 'private-exceptions' stamp: 'CamilloBruni 7/17/2013 21:58'!
isUnwindContext
	"is this context for  method that is marked?"
	^method primitive = 198! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 5/27/2014 13:49'!
doDup
	"Simulate the action of a 'duplicate top of stack' bytecode."

	self push: self top! !

!Context methodsFor: '*OpalCompiler-Core' stamp: 'CamilleTeruel 2/14/2014 15:42'!
isPushTemp: aPC
	^ (self method at: aPC) between: 16 and: 31! !

!Context methodsFor: 'instruction decoding' stamp: 'ClementBera 2/25/2015 14:56'!
unusedBytecode
	^ self respondsToUnknownBytecode ! !

!Context class methodsFor: 'instance creation' stamp: 'ClementBera 5/27/2014 13:49'!
new: size

	self error: 'Contexts must only be created with newForMethod:'! !

!Context class methodsFor: 'instance creation' stamp: 'ClementBera 5/27/2014 13:49'!
newForMethod: aMethod
	"This is the only method for creating new contexts, other than primitive cloning.
	Any other attempts, such as inherited methods like shallowCopy, should be
	avoided or must at least be rewritten to determine the proper size from the
	method being activated.  This is because asking a context its size (even basicSize!!)
	will not return the real object size but only the number of fields currently
	accessible, as determined by stackp."

	^ super basicNew: aMethod frameSize! !

!Context class methodsFor: 'examples' stamp: 'MarcusDenker 6/9/2014 16:41'!
tallyInstructions: aBlock
	"This method uses the simulator to count the number of occurrences of
	each of the Smalltalk instructions executed during evaluation of aBlock.
	Results appear in order of the byteCode set."
	| tallies |
	tallies := Bag new.
	thisContext sender
		runSimulated: aBlock
		contextAtEachStep:
			[:current | tallies add: current nextByte].
	^tallies sortedElements

	"Context tallyInstructions: [3.14159 printString]"! !

!Context class methodsFor: 'accessing' stamp: 'ClementBera 5/27/2014 13:49'!
specialPrimitiveSimulators
	SpecialPrimitiveSimulators ifNil: [ self initializePrimitiveSimulators ].
	^ SpecialPrimitiveSimulators! !

!Context class methodsFor: 'simulation' stamp: 'MarcusDenker 6/9/2014 16:41'!
runSimulated: aBlock
	"Simulate the execution of the argument, current. Answer the result it 
	returns."

	^ thisContext sender
		runSimulated: aBlock
		contextAtEachStep: [:ignored]

	"Context runSimulated: [Pen new defaultNib: 5; go: 100]"! !

!Context class methodsFor: 'testing' stamp: 'ClementBera 5/27/2014 13:49'!
isContextClass
	^true! !

!Context class methodsFor: 'instance creation' stamp: 'di 10/23/1999 17:06'!
sender: s receiver: r method: m arguments: args 
	"Answer an instance of me with attributes set to the arguments."

	^(self newForMethod: m) setSender: s receiver: r method: m arguments: args! !

!Context class methodsFor: 'examples' stamp: 'MarcusDenker 6/9/2014 16:41'!
tallyMethods: aBlock
	"This method uses the simulator to count the number of calls on each method
	invoked in evaluating aBlock. Results are given in order of decreasing counts."
	| prev tallies |
	tallies := Bag new.
	prev := aBlock.
	thisContext sender
		runSimulated: aBlock
		contextAtEachStep:
			[:current |
			current == prev ifFalse: "call or return"
				[prev sender ifNotNil: "call only"
					[tallies add: current printString].
				prev := current]].
	^ tallies sortedCounts

	"Contex tallyMethods: [3.14159 printString]"! !

!Context class methodsFor: 'simulation' stamp: 'ClementBera 5/27/2014 13:49'!
initialize

	"A unique object to be returned when a primitive fails during simulation"
	PrimitiveFailToken := Object new.
	self initializeTryNamedPrimitiveTemplateMethod.
	SpecialPrimitiveSimulators := nil.
	QuickStep := nil.! !

!Context class methodsFor: '*Fuel' stamp: 'ClementBera 5/27/2014 13:49'!
newFromFrameSize: aFrameSize
	
	^ super basicNew: aFrameSize! !

!Context class methodsFor: 'special context creation' stamp: 'ClementBera 5/27/2014 13:49'!
contextEnsure: block
	"Create an #ensure: context that is ready to return from executing its receiver"

	| ctxt chain |
	ctxt := thisContext.
	[chain := thisContext sender cut: ctxt. ctxt jump] ensure: block.
	"jump above will resume here without unwinding chain"
	^ chain! !

!Context class methodsFor: 'instance creation' stamp: 'ClementBera 5/27/2014 13:49'!
basicNew: size

    self error: 'Contexts must only be created with newForMethod:'! !

!Context class methodsFor: 'special context creation' stamp: 'ClementBera 5/27/2014 13:49'!
theReturnMethod

	| meth |
	meth := self lookupSelector: #return:.
	meth isPrimitive ifTrue: [^ self error: 'expected #return: to not be a primitive'].
	^ meth! !

!Context class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:16'!
gtExampleTthisContext
	<gtExample: 'thisContext'>
	^ thisContext! !

!Context class methodsFor: 'hacks' stamp: 'ar 9/17/2008 16:24'!
allInstancesDo: aBlock
	"Only count until thisContext"
	| inst next |
	inst := self someInstance.
	[inst == thisContext] whileFalse:[
		next := inst nextInstance.
		aBlock value: inst.
		inst := next]! !

!Context class methodsFor: 'private' stamp: 'ClementBera 5/27/2014 13:49'!
carefullyPrint: anObject on: aStream
	aStream nextPutAll: ([anObject printString]
		on: Error
		do: ['unprintable ' , anObject class name])! !

!Context class methodsFor: 'special context creation' stamp: 'ClementBera 5/27/2014 13:49'!
contextOn: exceptionClass do: block
	"Create an #on:do: context that is ready to return from executing its receiver"

	| ctxt chain |
	ctxt := thisContext.
	[chain := thisContext sender cut: ctxt. ctxt jump] on: exceptionClass do: block.
	"jump above will resume here without unwinding chain"
	^ chain! !

!Context class methodsFor: '*Spec-Inspector' stamp: 'TorstenBergmann 2/4/2014 21:31'!
inspectorClass
	^ EyeMethodContextInspector! !

!Context class methodsFor: 'registering simulated primitives' stamp: 'ClementBera 5/27/2014 13:49'!
simulatePrimitive: primName module: moduleName with: simulator
	^ self specialPrimitiveSimulators at: {primName. moduleName} put: simulator! !

!Context class methodsFor: 'simulation' stamp: 'ClementBera 5/27/2014 13:49'!
primitiveFailTokenFor: errorCode

	^ { PrimitiveFailToken. errorCode }
! !

!Context class methodsFor: 'simulation' stamp: 'ClementBera 5/27/2014 13:49'!
primitiveFailToken

	^ self primitiveFailTokenFor: nil! !

!Context class methodsFor: 'examples' stamp: 'MarcusDenker 6/9/2014 16:42'!
trace: aBlock onFileNamed: fileName
	"This method uses the simulator to print calls to a file."

	| aStream |
	^ [aStream := FileStream fileNamed: fileName.
		self trace: aBlock on: aStream] ensure: [aStream close]! !

!Context class methodsFor: 'instance creation' stamp: 'ClementBera 5/27/2014 13:49'!
new

	self error: 'Contexts must only be created with newForMethod:'! !

!Context class methodsFor: 'accessing' stamp: 'ClementBera 5/27/2014 13:49'!
tryNamedPrimitiveTemplateMethod
	^ TryNamedPrimitiveTemplateMethod! !

!Context class methodsFor: 'simulation' stamp: 'ClementBera 5/27/2014 13:49'!
initializePrimitiveSimulators
	"extra primitive simulators can be registered by implementing
	#registerPrimitiveSimulators method in class side of your class.
	 "
	SpecialPrimitiveSimulators := Dictionary new.

	Class allSubclassesDo: [:metaclass |
		(metaclass includesSelector: #registerPrimitiveSimulators) ifTrue: [
			metaclass theNonMetaClass registerPrimitiveSimulators.
			]
		].! !

!Context class methodsFor: 'examples' stamp: 'MarcusDenker 6/9/2014 16:42'!
trace: aBlock on: aStream
	"This method uses the simulator to print calls to a file."
	| prev |
	prev := aBlock.
	^ thisContext sender
		runSimulated: aBlock
		contextAtEachStep:
			[:current |
			Sensor anyButtonPressed ifTrue: [^ nil].
			current == prev
				ifFalse:
					[prev sender ifNil:
						[
						"Following does not work anymore due to closures?"
						"
						aStream space; nextPut: $^.
						self carefullyPrint: current top on: aStream
						"].
					aStream cr.
					(current depthBelow: aBlock) timesRepeat: [aStream space].
					self carefullyPrint: current receiver on: aStream.
					aStream space; nextPutAll: current selector; flush.
					prev := current]]! !

!Context class methodsFor: 'registering simulated primitives' stamp: 'ClementBera 5/27/2014 13:49'!
simulatePrimitiveNumber: num with: simulator
	^ self specialPrimitiveSimulators at: num put: simulator! !

!Context class methodsFor: 'simulation' stamp: 'MarcusDenker 6/9/2014 16:39'!
initializeTryNamedPrimitiveTemplateMethod
	| source method |
	source := 'tryNamedPrimitive
	"This method is a template that the Smalltalk simulator uses to 
	execute primitives. See Object documentation whatIsAPrimitive."
	<primitive:'' module:'' error: errorCode>
	^ Context primitiveFailTokenFor: errorCode'.
	method := Smalltalk compiler
				class: UndefinedObject;
				source: source;
				compile.
	TryNamedPrimitiveTemplateMethod := method copyWithSource: source.



	! !

!Context class methodsFor: 'examples' stamp: 'MarcusDenker 6/9/2014 16:41'!
trace: aBlock		
	"This method uses the simulator to print calls and returned values in the Transcript."

	Transcript clear.
	^ self trace: aBlock on: Transcript
	
	"Context trace: [3 factorial]"! !

!ContextTempEyeElement commentStamp: '<historical>'!
I am an eye element for temporaries in context!
!ContextTempEyeElement methodsFor: 'accessing' stamp: 'ClementBera 8/5/2013 10:45'!
tempIndex: anObject
	tempIndex := anObject! !

!ContextTempEyeElement methodsFor: 'accessing' stamp: 'ClementBera 8/5/2013 10:46'!
save: aValue
	self host namedTempAt: self tempIndex put: aValue! !

!ContextTempEyeElement methodsFor: 'accessing' stamp: 'ClementBera 4/30/2013 14:36'!
tempName
	^ tempName! !

!ContextTempEyeElement methodsFor: 'accessing' stamp: 'NicolaiHess 9/25/2014 19:57'!
value
	^ self host tempNamed: self tempName! !

!ContextTempEyeElement methodsFor: 'accessing' stamp: 'ClementBera 8/5/2013 10:45'!
accessorCode
	^ '(self namedTempAt: ', self tempIndex printString, ')'! !

!ContextTempEyeElement methodsFor: 'accessing' stamp: 'ClementBera 4/30/2013 14:36'!
label
	^ self tempName! !

!ContextTempEyeElement methodsFor: 'accessing' stamp: 'ClementBera 8/5/2013 10:45'!
tempIndex
	^ tempIndex! !

!ContextTempEyeElement methodsFor: 'accessing' stamp: 'ClementBera 4/30/2013 14:36'!
tempName: anObject
	tempName := anObject! !

!ContextTempEyeElement class methodsFor: 'as yet unclassified' stamp: 'ClementBera 8/5/2013 10:45'!
host: anObject tempName: aString tempIndex: int
	^ (self host: anObject) 
		tempName: aString;
		tempIndex: int;
		yourself! !

!Continuation commentStamp: '<historical>'!
I permit to save the execution flow and to restart it later. I was originally used in seaside.

Example :

You have an object with the instance variable executionFlow.

You save the current execution flow with :
Continuation currentDo: [ :cc | executionFlow := cc]

You restart the execution flow with :
executionFlow value: true


!
!Continuation methodsFor: 'evaluating' stamp: 'lr 10/28/2007 14:42'!
valueWithArguments: anArray
	anArray size = 1
		ifFalse: [ ^ self error: 'continuations can only be resumed with one argument' ].
	self value: anArray first! !

!Continuation methodsFor: 'private' stamp: 'CamilleTeruel 4/4/2013 11:58'!
initializeFromContext: aContext
	| valueStream context |
	valueStream := WriteStream on: (Array new: 20).
	context := aContext.
	[context notNil] whileTrue:
		[valueStream nextPut: context.
		1 to: context class instSize do: [:i | valueStream nextPut: (context instVarAt: i)].
		1 to: context size do: [:i | valueStream nextPut: (context at: i)].
		context := context sender].
	values := valueStream contents! !

!Continuation methodsFor: 'evaluating' stamp: 'ab 6/15/2003 19:13'!
value
	self value: nil! !

!Continuation methodsFor: 'evaluating' stamp: 'lr 10/28/2007 14:42'!
value: anObject
	"Invoke the continuation and answer anObject as return value."

	self terminate: thisContext.
	self restoreValues.
	thisContext swapSender: values first.
	^ anObject! !

!Continuation methodsFor: 'accessing' stamp: 'ab 6/15/2003 19:18'!
numArgs
	^ 1! !

!Continuation methodsFor: 'private' stamp: 'ClementBera 4/3/2013 10:16'!
terminate: aContext
	| context |
	context := aContext.
	[context notNil] whileTrue: [context := context swapSender: nil]! !

!Continuation methodsFor: 'private' stamp: 'CamilleTeruel 4/4/2013 11:59'!
restoreValues
	| valueStream context |
	valueStream := values readStream.
	[valueStream atEnd] whileFalse:
		[context := valueStream next.
		1 to: context class instSize do: [:i | context instVarAt: i put: valueStream next].
		1 to: context size do: [:i | context at: i put: valueStream next]]! !

!Continuation class methodsFor: 'instance creation' stamp: 'ab 6/15/2003 19:13'!
fromContext: aStack
	^self new initializeFromContext: aStack! !

!Continuation class methodsFor: 'instance creation' stamp: 'ab 6/15/2003 19:13'!
currentDo: aBlock
	^ aBlock value: (self fromContext: thisContext sender)! !

!Continuation class methodsFor: 'instance creation' stamp: 'ab 6/15/2003 19:13'!
current
	^ self fromContext: thisContext sender! !

!ContinuationTest commentStamp: '<historical>'!
I represent intentend to provide complete coverage for the Continuation class.!
!ContinuationTest methodsFor: 'tests' stamp: 'lr 1/5/2007 17:28'!
testSimpleCallCC
	| x continuation |
	x := self callcc: [ :cc | continuation := cc. false ].
	x ifFalse: [ continuation value: true ].
	self assert: x! !

!ContinuationTest methodsFor: 'tests' stamp: 'lr 1/5/2007 17:26'!
testBlockEscape
	| x |
	tmp := 0.
	x := [ tmp := tmp + 1. tmp2 value ].
	self callcc: [ :cc | tmp2 := cc. x value ].
	tmp2 := [ ].
	x value.
	self assert: tmp = 2! !

!ContinuationTest methodsFor: 'utilities' stamp: 'ab 6/15/2003 19:23'!
callcc: aBlock
	^ Continuation currentDo: aBlock! !

!ContinuationTest methodsFor: 'tests' stamp: 'dkh 7/5/2007 12:27'!
testBlockTemps
	| y |
	#(1 2 3) do: [ :i |
		| x |
		x := i.
		tmp ifNil: [ tmp2 := (self callcc: [ :cc | tmp := cc. [ :q | ] ]) ].
		tmp2 value: x.
		x := 17 ].
	y := (self callcc: [ :cc | tmp value: cc. 42 ]).
	self assert: y = 1! !

!ContinuationTest methodsFor: 'tests' stamp: 'lr 10/28/2007 14:42'!
testBlockVars
	| continuation |
	tmp := 0.
	tmp := (self callcc: [ :cc | continuation := cc. 0 ]) + tmp.
	tmp2
		ifNotNil: [ tmp2 value ]
		ifNil: [
			#(1 2 3) do: [ :i |
				self callcc: [ :cc | tmp2 := cc. continuation value: i ] ] ].
	self assert: tmp = 6! !

!ContinuationTest methodsFor: 'tests' stamp: 'lr 1/5/2007 18:22'!
testReentrant
	| assoc |
	assoc := self callcc: [ :cc | cc -> 0 ].
	assoc value: assoc value + 1.
	self assert: assoc value ~= 5.
	assoc value = 4
		ifFalse: [ assoc key value: assoc ]! !

!ContinuationTest methodsFor: 'tests' stamp: 'lr 1/5/2007 17:28'!
testSimplestCallCC
	| x |
	x := self callcc: [ :cc | cc value: true ].
	self assert: x! !

!ContinuationTest methodsFor: 'tests' stamp: 'lr 1/5/2007 17:27'!
testMethodTemps
	| i continuation |
	i := 0.
	i := i + (self callcc: [:cc | continuation := cc. 1]).
	self assert: i ~= 3.
	i = 2 ifFalse: [ continuation value: 2 ]! !

!ControlButtonMorph commentStamp: 'gvc 9/23/2008 12:04'!
Specially themed "control" button. Used for drop-lists, expanders etc.!
!ControlButtonMorph methodsFor: 'style' stamp: 'gvc 11/13/2007 11:24'!
selectedMouseOverBorderStyle
	"Return the selected mouse over borderStyle of the receiver."
	
	^self theme controlButtonSelectedMouseOverBorderStyleFor: self! !

!ControlButtonMorph methodsFor: 'style' stamp: 'gvc 12/9/2008 13:04'!
selectedFillStyle
	"Return the selected fillStyle of the receiver."
	
	^self theme controlButtonSelectedFillStyleFor: self! !

!ControlButtonMorph methodsFor: 'style' stamp: 'gvc 11/13/2007 11:23'!
normalBorderStyle
	"Return the normal borderStyle of the receiver."
	
	^self theme controlButtonNormalBorderStyleFor: self! !

!ControlButtonMorph methodsFor: 'accessing' stamp: 'gvc 11/13/2007 11:23'!
disabledBorderStyle
	"Return the disabled borderStyle of the receiver."
	
	^self theme controlButtonDisabledBorderStyleFor: self! !

!ControlButtonMorph methodsFor: 'style' stamp: 'gvc 11/13/2007 11:58'!
pressedBorderStyle
	"Return the pressed borderStyle of the receiver."
	
	^self theme controlButtonPressedBorderStyleFor: self! !

!ControlButtonMorph methodsFor: 'style' stamp: 'gvc 11/13/2007 11:23'!
mouseOverFillStyle
	"Return the mouse over fillStyle of the receiver."
	
	^self theme controlButtonMouseOverFillStyleFor: self! !

!ControlButtonMorph methodsFor: 'style' stamp: 'gvc 10/28/2007 16:52'!
normalFillStyle
	"Return the normal fillStyle of the receiver."
	
	^self theme controlButtonNormalFillStyleFor: self! !

!ControlButtonMorph methodsFor: 'style' stamp: 'gvc 11/13/2007 11:24'!
selectedPressedBorderStyle
	"Return the selected pressed borderStyle of the receiver."
	
	^self theme controlButtonSelectedPressedBorderStyleFor: self! !

!ControlButtonMorph methodsFor: 'style' stamp: 'gvc 11/13/2007 11:24'!
selectedMouseOverFillStyle
	"Return the selected mouse over fillStyle of the receiver."
	
	^self theme controlButtonSelectedMouseOverFillStyleFor: self! !

!ControlButtonMorph methodsFor: 'style' stamp: 'gvc 11/13/2007 11:59'!
pressedFillStyle
	"Return the pressed fillStyle of the receiver."
	
	^self theme controlButtonPressedFillStyleFor: self! !

!ControlButtonMorph methodsFor: 'initialization' stamp: 'gvc 12/5/2008 14:58'!
initialize
	"Initialize the receiver."

	super initialize.
	self layoutInset: (self theme controlButtonLabelInsetFor: self)! !

!ControlButtonMorph methodsFor: 'style' stamp: 'gvc 11/13/2007 11:25'!
selectedDisabledFillStyle
	"Return the selected disabled fillStyle of the receiver."
	
	^self theme controlButtonSelectedDisabledFillStyleFor: self! !

!ControlButtonMorph methodsFor: 'style' stamp: 'gvc 11/13/2007 11:23'!
mouseOverBorderStyle
	"Return the mouse over borderStyle of the receiver."
	
	^self theme controlButtonMouseOverBorderStyleFor: self! !

!ControlButtonMorph methodsFor: 'accessing' stamp: 'gvc 11/13/2007 11:25'!
selectedDisabledBorderStyle
	"Return the selected disabled borderStyle of the receiver."
	
	^self theme controlButtonSelectedDisabledBorderStyleFor: self! !

!ControlButtonMorph methodsFor: 'accessing' stamp: 'gvc 1/28/2009 17:12'!
minWidth
	"Consult the theme also."

	^self perform: #minWidth withArguments: #() inSuperclass: Morph! !

!ControlButtonMorph methodsFor: 'style' stamp: 'gvc 11/13/2007 11:25'!
selectedPressedFillStyle
	"Return the selected pressed fillStyle of the receiver."
	
	^self theme controlButtonSelectedPressedFillStyleFor: self! !

!ControlButtonMorph methodsFor: 'accessing' stamp: 'gvc 11/13/2007 11:24'!
disabledFillStyle
	"Return the disabled fillStyle of the receiver."
	
	^self theme controlButtonDisabledFillStyleFor: self! !

!CopyToClipboardDebugAction commentStamp: '<historical>'!
A CopyToClipboardDebugAction copies a short debugging stack to the clipboard.
!
!CopyToClipboardDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/24/2013 16:49'!
id

	^ #copyToClipboard! !

!CopyToClipboardDebugAction methodsFor: 'actions' stamp: 'AndreiChis 9/24/2013 16:48'!
executeAction

	Clipboard clipboardText: (String streamContents: [ :s| 
		self debugger interruptedContext shortDebugStackOn: s ])! !

!CopyToClipboardDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/24/2013 16:47'!
defaultLabel

	^ 'Copy to clipboard'! !

!CopyToClipboardDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/24/2013 16:48'!
defaultOrder

	^ 120! !

!CopyToClipboardDebugAction class methodsFor: 'registration' stamp: 'AndreiChis 9/24/2013 16:47'!
actionType
	<contextMenuDebuggingAction>! !

!CopyVisitor commentStamp: 'cwp 11/18/2009 12:30'!
I create a copy of the directory tree that I visit. I use the PreorderGuide so that I can create directories before creating their contents. !
!CopyVisitor methodsFor: 'visiting' stamp: 'cwp 11/16/2009 10:52'!
visitFile: anEntry
	| reference |
	reference := anEntry reference.
	reference = source
		ifTrue: [source copyTo: dest]
		ifFalse: [self copyFile: reference]! !

!CopyVisitor methodsFor: 'initialize-release' stamp: 'cwp 10/30/2009 13:42'!
initializeWithSource: srcReference dest: dstReference
	self initialize.
	source := srcReference.
	dest := dstReference! !

!CopyVisitor methodsFor: 'visiting' stamp: 'S 6/17/2013 13:26'!
visitDirectory: anEntry
	| reference |
	reference := anEntry reference.
	reference = source
		ifTrue: [dest ensureCreateDirectory]
		ifFalse: [self copyDirectory: reference]! !

!CopyVisitor methodsFor: 'visiting' stamp: 'cwp 11/17/2009 21:06'!
copyDirectory: aReference
	| directory |
	directory := dest resolve: (aReference relativeTo: source).
	directory createDirectory! !

!CopyVisitor methodsFor: 'visiting' stamp: 'EstebanLorenzano 4/2/2012 11:38'!
visit
	(PreorderGuide for: self) 
		show: source! !

!CopyVisitor methodsFor: 'visiting' stamp: 'cwp 11/15/2009 00:31'!
copyFile: aReference
	| copy |
	copy := dest resolve: (aReference relativeTo: source).
	aReference copyTo: copy! !

!CopyVisitor class methodsFor: 'instance creation' stamp: 'cwp 10/30/2009 13:44'!
copy: source to: dest
	(self from: source to: dest) visit! !

!CopyVisitor class methodsFor: 'instance creation' stamp: 'cwp 10/30/2009 13:41'!
from: srcReference to: dstReference
	^ self basicNew
		initializeWithSource: srcReference 
		dest: dstReference! !

!CopyVisitorTest commentStamp: 'TorstenBergmann 1/31/2014 11:39'!
SUnit tests for CopyVisitor!
!CopyVisitorTest methodsFor: 'running' stamp: 'cwp 2/18/2011 16:40'!
createFile: aString 
	source store createFile: (source store pathFromString: aString)! !

!CopyVisitorTest methodsFor: 'running' stamp: 'cwp 2/18/2011 16:40'!
createDirectory: aString 
	source createDirectory: (source store pathFromString: aString)! !

!CopyVisitorTest methodsFor: 'running' stamp: 'EstebanLorenzano 4/2/2012 11:43'!
setUp
	source := FileSystem memory.
	dest := FileSystem memory.
	
	! !

!CopyVisitorTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:40'!
testAll
	self setUpGreek.
	CopyVisitor 
		copy: (source / 'alpha') 
		to: (dest / 'alpha').
	self assert: (dest isDirectory: '/alpha').
	self assert: (dest isFile: '/alpha/beta/gamma').! !

!CornerGripMorph commentStamp: 'jmv 1/29/2006 17:15'!
I am the superclass of a hierarchy of morph specialized in allowing the user to resize windows.!
!CornerGripMorph methodsFor: 'accessing' stamp: 'jmv 2/2/2006 14:24'!
defaultHeight
	^ 22! !

!CornerGripMorph methodsFor: 'initialization' stamp: 'gvc 4/26/2007 12:08'!
initialize
	super initialize.
	self extent: self defaultWidth @ self defaultHeight.
	self layoutFrame: self gripLayoutFrame! !

!CornerGripMorph methodsFor: 'accessing' stamp: 'jmv 2/2/2006 14:24'!
defaultWidth
	^ 22! !

!CornerGripMorph methodsFor: 'accessing' stamp: 'gvc 2/12/2007 16:36'!
targetPoint
	"Answer the reference point of the target."

	^self target bounds pointAtSideOrCorner: self ptName! !

!CornerGripMorph methodsFor: 'event' stamp: 'gvc 7/30/2009 14:06'!
mouseDown: anEvent
	"Remember the receiver and target offsets too."
	
	|cp|
	cp := anEvent cursorPoint.
	lastMouse := {cp. cp - self position. cp - self targetPoint}! !

!CornerGripMorph methodsFor: 'accessing' stamp: 'gvc 7/30/2009 14:07'!
targetPoint: aPoint
	"Set the reference point of the target."

	|minExt rect|
	rect := self target bounds withSideOrCorner: self ptName setToPoint: aPoint.
	minExt := self target minimumExtent.
	rect width <= minExt x ifTrue: [
		(self ptName = #topLeft or: [self ptName = #bottomLeft])
			ifTrue: [rect := rect withSideOrCorner: #left setToPoint: self target bounds bottomRight - minExt]
			ifFalse: [rect := rect withSideOrCorner: #right setToPoint: self target bounds topLeft + minExt]].
	rect height <= minExt y ifTrue: [
		(self ptName = #topLeft or: [self ptName = #topRight])
			ifTrue: [rect := rect withSideOrCorner: #top setToPoint: self target bounds bottomRight - minExt]
			ifFalse: [rect := rect withSideOrCorner: #bottom setToPoint: self target bounds topLeft + minExt]].
	self target bounds: rect! !

!CornerGripMorph methodsFor: 'event' stamp: 'gvc 2/12/2007 16:36'!
mouseMove: anEvent
	"Track the mouse for resizing."
	
	target ifNil: [^ self].
	target fastFramingOn 
		ifTrue: [target doFastWindowReframe: self ptName] 
		ifFalse: [
			lastMouse at: 1 put: anEvent cursorPoint.
			self targetPoint: lastMouse first - lastMouse last.
			self position: (lastMouse first - lastMouse second)].! !

!CornerGripMorph methodsFor: 'accessing' stamp: 'gvc 2/12/2007 16:28'!
target
	"Answer the target."

	^target! !

!CornerGripMorph methodsFor: 'accessing' stamp: 'gvc 3/27/2008 21:50'!
target: aMorph

	target := aMorph.
	aMorph ifNotNil: [
		self fillStyle: (aMorph theme resizerGripNormalFillStyleFor: self)]! !

!CornerRounder commentStamp: '<historical>'!
This class is a quick hack to support rounded corners in morphic.

Rather than produce rounded rectangles, it tweaks the display of corners.
Rather than work for any radius, it only supports a radius of 6.
Rather than work for any border width, it only supports widths 0, 1 and 2.
The corners, while apparently transparent, still behave opaquely to mouse clicks.

Worse than this, the approach relies on the ability to extract underlying bits from the canvas prior to display.  This ran afoul of top-down display, it seems, in SystemWindow spawnReframeHandle: (qv).  It will also make a postscript printer very unhappy.

But, hey, it's cute.!
!CornerRounder methodsFor: 'all' stamp: 'IgorStasenko 7/18/2011 18:11'!
tweakCornersOf: aMorph on: aCanvas in: bounds borderWidth: w corners: cornerList
	"This variant has a cornerList argument, to allow some corners to be rounded and others not"
	| fourColors mask corners |

	w > 0 ifTrue:[ fourColors := aMorph borderStyle colorsAtCorners ].
	mask := Form extent: cornerMasks first extent depth: aCanvas depth.
	corners := bounds corners.
	cornerList do:[:i|
		| offset corner saveBits outBits |
		corner := corners at: i.
		saveBits := underBits at: i.
		saveBits ifNotNil:[
			i = 1 ifTrue: [offset := 0@0].
			i = 2 ifTrue: [offset := 0@saveBits height negated].
			i = 3 ifTrue: [offset := saveBits extent negated].
			i = 4 ifTrue: [offset := saveBits width negated@0].

			"Mask out corner area (painting saveBits won't clear if transparent)."
			mask copyBits: mask boundingBox from: (cornerMasks at: i) at: 0@0 clippingBox: mask boundingBox rule: Form over fillColor: nil map: (Bitmap with: 0 with: 16rFFFFFFFF).
			outBits := aCanvas contentsOfArea: (corner + offset extent: mask extent).
			mask displayOn: outBits at: 0@0 rule: Form and.
			"Paint back corner bits."
			saveBits displayOn: outBits at: 0@0 rule: Form paint.
			"Paint back corner bits."
			aCanvas drawImage: outBits at: corner + offset.

			w > 0 ifTrue:[
				
				aCanvas stencil: (cornerOverlays at: i) at: corner + offset
						color: (fourColors at: i)]]].
! !

!CornerRounder methodsFor: 'all' stamp: 'di 6/24/1999 09:35'!
masterMask: maskForm masterOverlay: overlayForm

	cornerMasks := #(none left pi right) collect:
		[:dir | (maskForm rotateBy: dir centerAt: 0@0) offset: 0@0].
	cornerOverlays := #(none left pi right) collect:
		[:dir | (overlayForm rotateBy: dir centerAt: 0@0) offset: 0@0].
! !

!CornerRounder methodsFor: 'all' stamp: 'nice 12/26/2009 01:26'!
saveBitsUnderCornersOf: aMorph on: aCanvas in: bounds corners: cornerList

	| corners |
	underBits := Array new: 4.
	corners := bounds corners.
	cornerList do:[:i|
		| offset corner mask form rect |
		mask := cornerMasks at: i.
		corner := corners at: i.
		i = 1 ifTrue: [offset := 0@0].
		i = 2 ifTrue: [offset := 0@mask height negated].
		i = 3 ifTrue: [offset := mask extent negated].
		i = 4 ifTrue: [offset := mask width negated@0].
		rect := corner + offset extent: mask extent.
		(aCanvas isVisible: rect) ifTrue:[
			form := aCanvas contentsOfArea: rect.
			form copyBits: form boundingBox from: mask at: 0@0 clippingBox: form boundingBox rule: Form and fillColor: nil map: (Bitmap with: 16rFFFFFFFF with: 0).
			underBits at: i put: form]].
! !

!CornerRounder methodsFor: 'all' stamp: 'GaryChambers 9/8/2011 14:46'!
tweakShadowCornersOf: aMorph on: aCanvas in: bounds borderWidth: w corners: cornerList
	"This variant has a cornerList argument, to allow some corners to be rounded and others not"
	| fourColors mask corners |

	w > 0 ifTrue: [fourColors := Array new: 4 withAll: Color transparent].
	mask := Form extent: cornerMasks first extent depth: aCanvas depth.
	corners := bounds corners.
	cornerList do:[:i|
		| offset corner saveBits outBits |
		corner := corners at: i.
		saveBits := underBits at: i.
		saveBits ifNotNil:[
			i = 1 ifTrue: [offset := 0@0].
			i = 2 ifTrue: [offset := 0@saveBits height negated].
			i = 3 ifTrue: [offset := saveBits extent negated].
			i = 4 ifTrue: [offset := saveBits width negated@0].

			"Mask out corner area (painting saveBits won't clear if transparent)."
			mask copyBits: mask boundingBox from: (cornerMasks at: i) at: 0@0 clippingBox: mask boundingBox rule: Form over fillColor: nil map: (Bitmap with: 0 with: 16rFFFFFFFF).
			outBits := aCanvas contentsOfArea: (corner + offset extent: mask extent).
			mask displayOn: outBits at: 0@0 rule: Form and.
			"Paint back corner bits."
			saveBits displayOn: outBits at: 0@0 rule: Form paint.
			"Paint back corner bits."
			aCanvas drawImage: outBits at: corner + offset.

			w > 0 ifTrue:[
				
				aCanvas stencil: (cornerOverlays at: i) at: corner + offset
						color: (fourColors at: i)]]].
! !

!CornerRounder class methodsFor: 'all' stamp: 'di 6/28/1999 15:51'!
initialize  "CornerRounder initialize"

	CR0 := CR1 := self new
		masterMask:
			(Form extent: 6@6
				fromArray: #(2r1e26 2r111e26 2r1111e26 2r11111e26 2r11111e26 2r111111e26)
				offset: 0@0)
		masterOverlay:
			(Form extent: 6@6
				fromArray: #(2r1e26 2r110e26 2r1000e26 2r10000e26 2r10000e26 2r100000e26)
				offset: 0@0).
	CR2 := self new
		masterMask:
			(Form extent: 6@6
				fromArray: #(2r1e26 2r111e26 2r1111e26 2r11111e26 2r11111e26 2r111111e26)
				offset: 0@0)
		masterOverlay:
			(Form extent: 6@6
				fromArray: #(2r1e26 2r111e26 2r1111e26 2r11100e26 2r11000e26 2r111000e26)
				offset: 0@0).

! !

!CornerRounder class methodsFor: 'all' stamp: 'di 3/25/2000 11:12'!
rectWithinCornersOf: aRectangle
	"Return a single sub-rectangle that lies entirely inside corners
	that are made by me.
	Used to identify large regions of window that do not need to be redrawn."

	^ aRectangle insetBy: 0@6! !

!CornerRounder class methodsFor: 'all' stamp: 'GaryChambers 9/8/2011 14:46'!
roundShadowCornersOf: aMorph on: aCanvas in: bounds displayBlock: displayBlock borderWidth: w corners: aList

	| rounder |
	rounder := CR0.
	w = 1 ifTrue: [rounder := CR1].
	w = 2 ifTrue: [rounder := CR2].
	rounder := rounder copy.
	rounder saveBitsUnderCornersOf: aMorph on: aCanvas in: bounds corners: aList.
	displayBlock value.
	rounder tweakShadowCornersOf: aMorph on: aCanvas in: bounds borderWidth: w corners: aList! !

!CornerRounder class methodsFor: 'all' stamp: 'ar 1/5/2002 17:24'!
roundCornersOf: aMorph on: aCanvas in: bounds displayBlock: displayBlock borderWidth: w corners: aList

	| rounder |
	rounder := CR0.
	w = 1 ifTrue: [rounder := CR1].
	w = 2 ifTrue: [rounder := CR2].
	rounder := rounder copy.
	rounder saveBitsUnderCornersOf: aMorph on: aCanvas in: bounds corners: aList.
	displayBlock value.
	rounder tweakCornersOf: aMorph on: aCanvas in: bounds borderWidth: w corners: aList! !

!CountingKeyPressedPlugin commentStamp: 'StephaneDucasse 10/30/2014 07:33'!
I'm a simple plugin which displays the number of keystrokes at the bottom of Nautilus. I'm mainly an example.!
!CountingKeyPressedPlugin methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/4/2011 14:56'!
stringMorph: anObject
	
		stringMorph := anObject! !

!CountingKeyPressedPlugin methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 5/10/2011 17:55'!
initialize

	super initialize.
	counter := 0.
	self stringMorph
		contents: 'Keys pressed: ', counter printString;
		openInWorld.
	! !

!CountingKeyPressedPlugin methodsFor: 'announcement' stamp: 'MarcusDenker 9/27/2013 18:02'!
keyPressed: anAnnouncement

	counter := counter +1.
	self stringMorph contents: 'Keys pressed: ', counter printString! !

!CountingKeyPressedPlugin methodsFor: 'accessing' stamp: 'StephaneDucasse 10/30/2014 07:31'!
stringMorph

	^ stringMorph ifNil: [ stringMorph := LabelMorph new
												enabled:false; 
												vResizing: #shrinkWrap;
												hResizing: #spaceFill;
												yourself]! !

!CountingKeyPressedPlugin methodsFor: 'display' stamp: 'BenjaminVanRyseghem 5/10/2011 16:43'!
display

	^ stringMorph! !

!CountingKeyPressedPlugin class methodsFor: 'information' stamp: 'BenjaminVanRyseghem 2/17/2012 16:50'!
description

	^ 'Display the number of key pressed'! !

!CountingKeyPressedPlugin class methodsFor: 'position' stamp: 'BenjaminVanRyseghem 8/25/2011 10:01'!
defaultPosition

	^ #bottom! !

!CredentialEditor commentStamp: '<historical>'!
I am a simple UI used to set the credentials of a remote!
!CredentialEditor methodsFor: 'api' stamp: 'BenjaminVanRyseghem 12/4/2013 13:04'!
getPassword

	^ password text! !

!CredentialEditor methodsFor: 'api' stamp: 'BenjaminVanRyseghem 12/4/2013 13:03'!
getUsername
	
	^ username text! !

!CredentialEditor methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/4/2013 12:41'!
usernameLabel
	^ usernameLabel! !

!CredentialEditor methodsFor: 'api' stamp: 'BenjaminVanRyseghem 12/4/2013 12:51'!
setUsername: aName

	username text: aName! !

!CredentialEditor methodsFor: 'api' stamp: 'BenjaminVanRyseghem 12/4/2013 12:51'!
setPassword: aPassword

	password text: aPassword! !

!CredentialEditor methodsFor: 'initialize-release' stamp: 'PeterUhnak 4/12/2015 18:28'!
initializeWidgets

	username := self newTextInput.
	usernameLabel := self newLabel.
	
	password := self newTextInput.
	passwordLabel := self newLabel.
	
	showPassword := self newCheckBox.
	
	usernameLabel label: 'Username'.
	passwordLabel label: 'Password'.
	
	password
		ghostText: '*****';
		autoAccept: true;
		beEncrypted.
		
	username 
		ghostText: 'John Doe';
		autoAccept: true.
		
	showPassword	
		label: 'Show password'.
		
	self focusOrder
		add: username;
		add: password;
		add: showPassword.! !

!CredentialEditor methodsFor: 'initialize-release' stamp: 'BenjaminVanRyseghem 12/4/2013 13:24'!
initializeDialogWindow: aWindow

	self 
		bindKeyCombination: $m control 
		toAction: [ aWindow triggerOkAction ]! !

!CredentialEditor methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/4/2013 12:41'!
password
	^ password! !

!CredentialEditor methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/4/2013 12:41'!
username
	^ username! !

!CredentialEditor methodsFor: 'initialize-release' stamp: 'BenjaminVanRyseghem 12/4/2013 14:34'!
initializePresenter

	showPassword 
		whenActivatedDo: [ password beDecrypted ];
		whenDesactivatedDo: [ password beEncrypted ]! !

!CredentialEditor methodsFor: 'api' stamp: 'BenjaminVanRyseghem 12/4/2013 12:47'!
title

	^ 'Edit credentials'! !

!CredentialEditor methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/4/2013 14:31'!
showPasswordWidget
	^ showPassword! !

!CredentialEditor methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/4/2013 12:41'!
passwordLabel
	^ passwordLabel! !

!CredentialEditor methodsFor: 'api' stamp: 'BenjaminVanRyseghem 12/4/2013 14:31'!
initialExtent

	^ 400@160! !

!CredentialEditor class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 12/4/2013 14:33'!
defaultSpec
	<sepc: #default>
	
	^ SpecLayout composed
		newColumn: [ :col |
			col 
				newRow: [ :r | r add: #usernameLabel width: 80; add: #username ] height: self inputTextHeight;
				newRow: [ :r | r add: #passwordLabel width: 80; add: #password ] height: self inputTextHeight + 4;
				newRow: [ :r | r add: #showPasswordWidget width: 120; newColumn: [ :c | ] ] height: self inputTextHeight + 4;
				newRow: [ :r | ]
		];
	yourself! !

!CriticBrowser commentStamp: '<historical>'!
I display code critics, the results obtained when running a lint rule.

Example: 


| rule env |
rule :=  RBExcessiveArgumentsRule new.
env := (RBPackageEnvironment packageName: 'Manifest-Core').

(CriticBrowser openOnRule: rule onEnvironment: env).!
!CriticBrowser methodsFor: 'api' stamp: 'StephaneDucasse 10/26/2014 18:06'!
onWindowClosed

	cache cacheChange 
		ifTrue: [	
			(UIManager default confirm: 'Do you want log all wrong violations in the Manifests
before closing the Critics Browser ?')
				ifTrue: [ cache logInManifest ]].
	
! !

!CriticBrowser methodsFor: 'private' stamp: 'StephaneDucasse 3/20/2013 22:33'!
addRuleToFalsePositive
	rulesModel selectedItem ifNotNil: [ :rule |
		rule leaves do: [ :r |
			rbEnvironment packages do: [ :package |
				cache addFalsePositiveRule: r forPackage: package ]]].
	! !

!CriticBrowser methodsFor: 'private' stamp: 'StephaneDucasse 9/13/2013 20:07'!
stringMorphForRule: rule
	| unclassified falsePositives toDos text total |
	falsePositives := (cache falsePositiveOf: rule) size.
	toDos := (cache toDosOf: rule) size.
	total := (cache criticsOf: rule) size.
	unclassified := total - falsePositives - toDos.
	text := String
		streamContents: [ :s | 
			s
				<< rule name;
				<< ' (To sort: ';
				print: unclassified;
				<< ', ToDo: ';
				print: toDos;
				<< ', Wrong: ';
				print: falsePositives;
				<< ')' ].
	^ text asMorph
		color: (self colorForRule: rule);
		yourself
		! !

!CriticBrowser methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/7/2013 10:45'!
reapplyThisRule

	| rule |
	rulesModel selectedItem ifNil: [ ^ self ].
	rule := rulesModel selectedItem content. 
	rule leaves do: [ :each | self reapplyRule: each ]. 
! !

!CriticBrowser methodsFor: 'initialization' stamp: 'StephaneDucasse 10/26/2014 18:06'!
setActionLogButtom
	
	^ [(UIManager default confirm:  'Do you want to save all false positive and toDo in the Manifests ?
(this action may generate new manifest classes and make dirty your package)')
			ifTrue: [ cache logInManifest] ]! !

!CriticBrowser methodsFor: 'initialization' stamp: 'SimonAllier 2/8/2013 15:32'!
setLogButton

	logButton 
		state: false;
		label: 'Save Critics';
		action: self setActionLogButtom ! !

!CriticBrowser methodsFor: 'private' stamp: 'NicolaiHess 12/18/2013 21:53'!
browseRule

	rulesModel selectedItem ifNotNil: [ :item | item content browse ]! !

!CriticBrowser methodsFor: 'system annoucements' stamp: 'CamilleTeruel 9/4/2014 16:37'!
methodRemoved: anAnnouncement

	| classes |
	classes := rbEnvironment packages flatCollect: [ :package | package classes].
	(classes anySatisfy: [ :cl | anAnnouncement methodClass = cl ]) 
				ifFalse: [ ^ self ].
	cache itemRemoved: anAnnouncement method! !

!CriticBrowser methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 22:55'!
initialize
	
	super initialize.
	cache := CriticsCache new.
	checker := SmalllintManifestChecker new.
	cache checker: checker.
	cache browser: self. 
	criticModel cache: cache.	
		



! !

!CriticBrowser methodsFor: 'private' stamp: 'CamilleTeruel 11/14/2013 14:13'!
reapplyRule: aRule

	|  oldCritics |
	oldCritics := aRule critics.
	aRule resetResult.
	rbEnvironment packages do: [ :package | 
		checker runRules: aRule onPackage: package withoutTestCase: removeTestCase ]. 	
	(oldCritics \ (aRule critics)) do: [ :each |
		cache removeCritic: each forRule: aRule.
		cache removeFalsePositive: each forRule: aRule.
		cache removeToDo: each forRule: aRule ].
	checker rule: aRule. ! !

!CriticBrowser methodsFor: 'user interface' stamp: 'StephaneDucasse 10/22/2014 21:31'!
addModelItemsToWindowMenu: aMenu
	"Add model-related items to the window menu"

	aMenu
		addLine;
		add: 'Clean all manifest' target: checker selector: #cleanAllManifest;
		add: 'Reapply all  rules' target: self selector: #reapplyAllRules! !

!CriticBrowser methodsFor: 'initialization' stamp: 'CamilleTeruel 9/18/2013 14:58'!
initializePresenter

	rulesModel whenSelectedItemChanged: [ :rule |
		(rule isNil or: [ rule isComposite ]) 
			ifFalse: [ criticModel resetSelection.
	 				criticModel rule: rule. 	
					criticModel setTextModelForNil].
			self setTitle: rule name]

! !

!CriticBrowser methodsFor: 'api' stamp: 'SimonAllier 7/27/2012 11:08'!
title
	^ title! !

!CriticBrowser methodsFor: 'accessing' stamp: 'StephaneDucasse 12/22/2012 19:41'!
environment: aEnv
	rbEnvironment := aEnv
! !

!CriticBrowser methodsFor: 'accessing' stamp: ''!
criticModel
	^ criticModel! !

!CriticBrowser methodsFor: 'accessing' stamp: 'SimonAllier 5/22/2012 16:00'!
rules: aCompositeRule

	self rulesModel roots: {aCompositeRule}
	
	
! !

!CriticBrowser methodsFor: 'thread' stamp: 'CamilleTeruel 9/18/2013 15:03'!
updateTree
	criticModel updateList. 
	rulesModel updateTree! !

!CriticBrowser methodsFor: 'accessing' stamp: 'SimonAllier 1/24/2013 12:55'!
environment
	^ rbEnvironment
! !

!CriticBrowser methodsFor: 'accessing' stamp: 'SimonAllier 1/29/2013 15:27'!
logButton
	^ logButton ! !

!CriticBrowser methodsFor: 'system annoucements' stamp: 'CamilleTeruel 9/18/2013 14:58'!
methodAdded: anAnnouncement

	anAnnouncement methodClass isManifest
		ifFalse: [ ^ self ].
	self updateCountOf: rulesModel selectedItem.! !

!CriticBrowser methodsFor: 'private' stamp: 'CamilleTeruel 11/13/2013 07:42'!
applyRules

	|  packageCount nbPackage process rules |	
	rules := rulesModel roots first. 
	rules resetResult.
	nbPackage := rbEnvironment packages size.
	packageCount := 0.
	self updateTree.
	process := [  
		rbEnvironment packages do: [ :package |
			|  windowTitle |
			packageCount := packageCount + 1.
			windowTitle := String streamContents: [ :s | 
				s 
					<< 'run rules on '
					<< package packageName
					<< ' ('
					<< packageCount asString
					<< '/'
					<< nbPackage asString
					<< ')' ].				
			self setTitle: windowTitle.
			checker runRules: rules onPackage: package withoutTestCase: removeTestCase ].
			checker rule: rules.
			self setTitle: 'Critics Browser'.
			cache packages: rbEnvironment.
			cache initCache. 
			self updateTree.
			self registerToAnnouncements ] newProcess.
	
	process name: 'SmallLint'.
	process resume.
! !

!CriticBrowser methodsFor: 'private' stamp: 'SimonAllier 1/25/2013 16:23'!
logInManifest
	cache logInManifest! !

!CriticBrowser methodsFor: 'menu' stamp: 'BenjaminVanRyseghem 12/7/2013 10:45'!
menu: aMenu shifted: aBoolean

	aMenu
		addGroup:[ :g | 
			g addItem: [ :i |
				i 
					name: 'Browse rule' translated;
					action: [ self browseRule ]].
			g addItem: [ :i |
				i 
					name: 'Reapply this rule' translated;
					action: [ self reapplyThisRule ] ] ];
		addGroup:[ :g | 
			g addItem: [ :i |
				i 
					name: 'Ban from selected packages' translated;
					action: [ self addRuleToFalsePositive ]].
			g addItem: [ :i |
				i 
					name: 'Unban from selected packages' translated;
					action: [ self removeRuleToFalsePositive ] ] ].
		
	 ^ aMenu! !

!CriticBrowser methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/24/2012 17:18'!
initialExtent

	^   760@370! !

!CriticBrowser methodsFor: 'api' stamp: 'Sd 11/30/2012 17:32'!
setTitle: aTitle
	title := aTitle.
	self window updateTitle 
	! !

!CriticBrowser methodsFor: 'private' stamp: 'StephaneDucasse 3/20/2013 22:34'!
removeRuleToFalsePositive

	rulesModel selectedItem ifNotNil: [ :rule |
		rule leaves do: [ :r |
			rbEnvironment packages do: [ :package |
				 cache removeFalsePositiveRule: r forPackage: package ]]].

	
	! !

!CriticBrowser methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/24/2012 17:29'!
taskbarIcon

	^ self class icon! !

!CriticBrowser methodsFor: 'accessing' stamp: 'SimonAllier 1/21/2013 17:03'!
removeTestCase: aBoolean
	removeTestCase :=  aBoolean! !

!CriticBrowser methodsFor: 'initialization' stamp: 'StephaneDucasse 10/26/2014 18:06'!
setActionResetButtom
	
	^ [(UIManager default confirm: 'Do you want to delete the current configuration
 and create a new configuration ?')
		ifTrue: [ self  delete. 
				SelectPackageBrowser open.] ]! !

!CriticBrowser methodsFor: 'initialization' stamp: 'SimonAllier 2/8/2013 15:31'!
setResetButton

	resetButton 
		state: false;
		label: 'Run new configuration';
		action: self setActionResetButtom.! !

!CriticBrowser methodsFor: 'private' stamp: 'CamilleTeruel 8/28/2013 15:18'!
colorForRule: aRule
	| total |
	^ (total := cache criticsOf: aRule)
		ifEmpty: [ Color black ]
		ifNotEmpty: [ 
			(cache falsePositiveOf: aRule) = total
				ifTrue: [ criticModel falsePositiveColor ]
				ifFalse: [ criticModel defaultColor ] ]! !

!CriticBrowser methodsFor: 'initialization' stamp: 'CamilloBruni 2/25/2014 19:40'!
initializeWidgets
	
	title := 'Critic Browser'.

	self instantiateModels: #(
		rulesModel TreeModel
		resetButton  ButtonModel 
		logButton ButtonModel ).
	
	self setLogButton.
	self setResetButton.
	 
	criticModel := SingleCodeCriticResultList new.
	rulesModel childrenBlock: [ :rule | 
		rule isComposite 
			ifTrue: [ rule rules ]
			ifFalse: [ #() ]]. 

	rulesModel displayBlock: [ :rule | self stringMorphForRule: rule ].
	
	rulesModel menu: [ :aMenu :shifted | self menu: aMenu shifted: shifted ].	
	
	self focusOrder
		add: rulesModel;
		add: criticModel! !

!CriticBrowser methodsFor: 'system annoucements' stamp: 'StephaneDucasse 3/20/2013 22:36'!
methodModified: anAnnouncement
	"checks if a modification of a method fixes a warning. if true,  the true positives in the browser are update"
	"checks  if  a method of a manifest class is modified and update false positive in the browser"
		
	(criticModel criticsModelContains: anAnnouncement oldMethod)
		ifFalse: [ ^ self ].
	cache replaceAll: anAnnouncement oldMethod by: anAnnouncement newMethod.
	self reapplyThisRule	
! !

!CriticBrowser methodsFor: 'accessing' stamp: 'SimonAllier 1/29/2013 15:27'!
resetButton
	^ resetButton ! !

!CriticBrowser methodsFor: 'display' stamp: 'BenjaminVanRyseghem 5/14/2013 18:56'!
open

	^ self openWithSpec! !

!CriticBrowser methodsFor: 'system annoucements' stamp: 'BernardoContreras 10/9/2014 20:45'!
registerToAnnouncements
	
	SystemAnnouncer uniqueInstance weak
		when: ClassModifiedClassDefinition send: #classModified: to: self;
		when: MethodModified send: #methodModified: to: self;
		when: MethodRemoved send: #methodRemoved: to: self.
	self window window announcer when: WindowClosed send: #onWindowClosed to: self.	! !

!CriticBrowser methodsFor: 'private' stamp: 'CamilleTeruel 9/18/2013 14:58'!
reapplyAllRules
	
	|  ruleCount total  rule |
	ruleCount := 0.
	rule := rulesModel roots first.
	total := rule leaves size.

	 rule leaves do: [ :r |
		ruleCount := ruleCount + 1.
		self setTitle: (String streamContents: [:s | s << 'run rules: ' << r name << ' (' << ruleCount asString << '/' << total asString <<')']).
		self reapplyRule: r ]. 	
	self setTitle: 'Critics Browser'.! !

!CriticBrowser methodsFor: 'system annoucements' stamp: 'StephaneDucasse 3/20/2013 22:35'!
classModified: anAnnouncement
	"checks if a modification of a class fixes a warning. if true,  the true/false positives in the browser are update"
	
	|  class  |
	class := anAnnouncement class.
	class isManifest ifTrue: [ ^ self ].	
	(criticModel criticsModelContains: anAnnouncement classAffected) ifFalse: [^ self].
	self reapplyThisRule	! !

!CriticBrowser methodsFor: 'accessing' stamp: ''!
rulesModel

	^ rulesModel! !

!CriticBrowser class methodsFor: 'specs' stamp: 'SimonAllier 2/8/2013 16:11'!
defaultSpec
	<spec>
	
	^ SpecLayout composed 
		newColumn: [:c |
			c 
				newRow: [:r |
					r 
						newColumn: [:c1 |
							c1 add: #rulesModel.
							c1 newRow: [:c2 |
								c2 add: #resetButton.
								c2 add: #logButton
							] height: 25
						];
						newColumn: [:c1 |
							c1 
								add: #(criticModel textInputFieldModel) height: 20;
								add: #(criticModel criticsModel);
								add: #(criticModel toolbarModel) height: 25 ]];
				addSplitter;
				add: #(criticModel textModel) ]! !

!CriticBrowser class methodsFor: 'instance creation' stamp: 'CamilleTeruel 11/14/2013 14:38'!
packagesMenu: aBuilder
	<nautilusGlobalPackageMenu>
	(aBuilder item: #'Critic Browser')
		action: [
			self  
				openOnRule: (RBCompositeLintRule allGoodRules) 
				onEnvironment: 
					(RBPackageEnvironment new 
						packages: aBuilder model selectedPackages;
						yourself) ];
		help: 'Running critics rules on this package'! !

!CriticBrowser class methodsFor: 'instance creation' stamp: 'CamilleTeruel 11/12/2013 19:36'!
openOnWorkingConfiguration: aWorkingConfiguration

	| cbr |
	cbr :=  self new 
		rules: aWorkingConfiguration rule;
		environment: aWorkingConfiguration environment;
		removeTestCase: aWorkingConfiguration removeTestCase;
		yourself.

	cbr openWithSpec.
	cbr applyRules. 
	cbr rulesModel  changed:  #listElementAt:.! !

!CriticBrowser class methodsFor: 'menu' stamp: 'SimonAllier 2/1/2013 15:31'!
openOnCurrentWorkingConfiguration

	CriticWorkingConfiguration exists
		ifTrue: [  ResetWindow new openWithSpec  ]
		ifFalse: [ SelectPackageBrowser open]! !

!CriticBrowser class methodsFor: 'instance creation' stamp: 'CamilleTeruel 11/12/2013 19:31'!
open

	| env rules  |
	rules :=  RBCompositeLintRule allGoodRules rules.
	env := RBBrowserEnvironment default.
	self openOnRule: rules onEnvironment:  env! !

!CriticBrowser class methodsFor: 'instance creation' stamp: 'SimonAllier 1/30/2013 10:43'!
openOnRule: aRule onEnvironment: aEnv

	| cbr |
	cbr :=  self new rules: aRule;
		environment: aEnv;
		removeTestCase: false;
		yourself.

	cbr openWithSpec.
	cbr applyRules. 
	cbr rulesModel  changed:  #listElementAt:.! !

!CriticBrowser class methodsFor: 'menu' stamp: 'TorstenBergmann 2/12/2014 09:25'!
criticsBrowserMenuOn: aBuilder 
	"I build a menu"
	<worldMenu>
	(aBuilder item: 'Critic Browser')
		action: [ self openOnCurrentWorkingConfiguration];
		order: 0.41;
		parent: #Tools;
		help: 'To manage rule checks';
		icon: self icon! !

!CriticBrowser class methodsFor: 'menu' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
theme
	^ Smalltalk ui theme ! !

!CriticBrowser class methodsFor: 'menu' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
icon
	"Answer an icon for the receiver."
	
	^ Smalltalk ui icons smallWarningIcon! !

!CriticToolbar commentStamp: '<historical>'!
I am the toolbar for a selected SmallLint Critic in the critic browser.


Instance Variables
	browseModel:		<Object>
	criticHolder:		<Object>
	falsepositiveModel:		<Object>
	ruleHolder:		<Object>
	transformModel:		<Object>

browseModel
	- xxxxx

criticHolder
	- xxxxx

falsepositiveModel
	- xxxxx

ruleHolder
	- xxxxx

transformModel
	- xxxxx
!
!CriticToolbar methodsFor: 'initialization' stamp: 'StephaneDucasse 3/21/2013 09:21'!
registerForChanges

	criticHolder whenChangedDo: [ :contents |
		| boolean |
		boolean := contents notNil.
		browseModel state: (boolean and: [ browseModel enabled ]).
		transformModel state: (boolean and: [ transformModel enabled ]).
		falsepositiveModel state: (boolean and: [ falsepositiveModel enabled ]) 
		]
! !

!CriticToolbar methodsFor: 'initialization' stamp: ''!
setFocusOrder

	self focusOrder
		add: browseModel;
		add: transformModel;
		add: falsepositiveModel.
		! !

!CriticToolbar methodsFor: 'initialization' stamp: 'SimonAllier 7/24/2012 14:07'!
initializeWidgets! !

!CriticToolbar methodsFor: 'accessing' stamp: ''!
browseModel

	^ browseModel! !

!CriticToolbar methodsFor: 'initialization' stamp: 'CamilleTeruel 9/18/2013 11:25'!
setFalsepositiveModel
	
	falsepositiveModel
		state: false;
		label: 'Mark as wrong';
		action: [  ].
	
! !

!CriticToolbar methodsFor: 'initialization' stamp: ''!
setTransformModel
	
	transformModel
		state: false;
		label: 'Transform';
		action: [ self transformCritic ].
	
! !

!CriticToolbar methodsFor: 'initialization' stamp: ''!
whenFalsePositiveClickedDo: aBlock

	self falsepositiveModel whenActionPerformedDo: aBlock! !

!CriticToolbar methodsFor: 'accessing' stamp: ''!
falsepositiveModel

	^ falsepositiveModel! !

!CriticToolbar methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 1/24/2014 16:07'!
initialize

	super initialize.
	criticHolder := nil asValueHolder.
	ruleHolder := nil asValueHolder.
	browseModel := self instantiate: ButtonModel.
	transformModel := self instantiate: ButtonModel.
	falsepositiveModel := self instantiate: ButtonModel.
	self setFocusOrder.	
	self setBrowseModel.
	self setTransformModel.
	self setFalsepositiveModel.
	self registerForChanges.! !

!CriticToolbar methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
rule: aRule
	
	ruleHolder value: aRule.
	 transformModel enabled: aRule isTransformationRule 
	
! !

!CriticToolbar methodsFor: 'private' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
transformCritic
	 criticHolder value
		ifNotNil: [:critic | ruleHolder value transform: critic ]
	
! !

!CriticToolbar methodsFor: 'private' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
browseCritic

	criticHolder value ifNotNil: [ :elem | elem browse ] ! !

!CriticToolbar methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
critic: aCritic

	criticHolder value: aCritic! !

!CriticToolbar methodsFor: 'initialization' stamp: ''!
setBrowseModel
	
	browseModel
		state: false;
		label: 'Browse';
		action: [ self browseCritic ].
	
! !

!CriticToolbar methodsFor: 'accessing' stamp: ''!
transformModel

	^ transformModel! !

!CriticToolbar class methodsFor: 'specs' stamp: 'SimonAllier 9/28/2012 13:55'!
defaultSpec
<spec>

	^SpecLayout composed
		newRow: [:r |
			r 
				add: #browseModel;
				add: #transformModel;
				add: #falsepositiveModel
			]  height: 25! !

!CriticWorkingConfiguration commentStamp: '<historical>'!
A CriticWorkspace holds the current worspace for the CriticBrowser.

It's composed of the set of rules to check (as a composite rule) and the environment to work in.!
!CriticWorkingConfiguration methodsFor: 'accessing' stamp: 'StephaneDucasse 3/21/2013 09:24'!
removeTestCase: aBoolean
	removeTestCase := aBoolean! !

!CriticWorkingConfiguration methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/24/2012 18:04'!
rule: anObject
	rule := anObject! !

!CriticWorkingConfiguration methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/24/2012 18:04'!
environment: anObject
	environment := anObject! !

!CriticWorkingConfiguration methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/24/2012 18:04'!
rule
	^ rule! !

!CriticWorkingConfiguration methodsFor: 'accessing' stamp: 'StephaneDucasse 3/21/2013 09:24'!
logInManifest
	^ logInManifest! !

!CriticWorkingConfiguration methodsFor: 'accessing' stamp: 'StephaneDucasse 3/21/2013 09:24'!
logInManifest: anObject
	logInManifest := anObject! !

!CriticWorkingConfiguration methodsFor: 'accessing' stamp: 'StephaneDucasse 3/21/2013 09:24'!
removeTestCase
	^ removeTestCase! !

!CriticWorkingConfiguration methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/24/2012 18:04'!
environment
	^ environment! !

!CriticWorkingConfiguration class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 11/24/2012 18:05'!
reset

	Current := nil! !

!CriticWorkingConfiguration class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 11/24/2012 18:05'!
new

	^ self shouldNotImplement! !

!CriticWorkingConfiguration class methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 11/24/2012 18:11'!
exists

	^ Current notNil! !

!CriticWorkingConfiguration class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 11/24/2012 18:05'!
current

	^ Current ifNil: [ Current  := self basicNew initialize ].! !

!CriticsCache commentStamp: '<historical>'!
I am a cache for the critics and false positives critics

Instance Variables
	browser:		<Object>
	checker:		<Object>
	critics:		<Object>
	falsePositiveClasses:		<Object>
	falsePositiveRules:		<Object>
	falsePositives:		<Object>
	packages:		<Object>
	toDos:		<Object>

browser
	- xxxxx

checker
	- xxxxx

critics
	- xxxxx

falsePositiveClasses
	- xxxxx

falsePositiveRules
	- xxxxx

falsePositives
	- xxxxx

packages
	- xxxxx

toDos
	- xxxxx
!
!CriticsCache methodsFor: 'add/remove' stamp: 'StephaneDucasse 3/20/2013 22:40'!
addToDo: aCritic forRule: aRule

	(toDos includesKey: aRule) 
		ifFalse: [ toDos at:aRule put: IdentitySet new ].
	(toDos at:aRule) add: aCritic. 
	self updateBrowser! !

!CriticsCache methodsFor: 'testing' stamp: 'SimonAllier 1/23/2013 11:27'!
isFalsePositive: aCritic forRule: aRule
	^ (self falsePositiveOf: aRule) includes: aCritic! !

!CriticsCache methodsFor: 'testing' stamp: 'SimonAllier 1/23/2013 11:50'!
isToDo: aCritic forRule: aRule
	^ (self toDosOf: aRule) includes: aCritic! !

!CriticsCache methodsFor: 'protocol' stamp: 'StephaneDucasse 3/21/2013 09:19'!
toDosOf: aRule

	aRule ifNil: [ ^ {}].
	^ aRule isComposite
		ifTrue: [ aRule leaves gather: [:rule | self toDosOf: rule]]
		ifFalse: [toDos at: aRule ifAbsent: [{}]]! !

!CriticsCache methodsFor: 'add/remove' stamp: 'CamilleTeruel 9/18/2013 14:59'!
addFalsePositiveRule: aRule forPackage: aPackage
	
	| fp |
	(falsePositiveRules includesKey: aPackage) 
		ifFalse: [ falsePositiveRules at: aPackage put: Set new ].
	(falsePositiveRules at: aPackage) add: (aRule class uniqueIdentifierName). 
	fp := (critics at: aRule ifAbsent: [^ self])
				select: [ :c |  (self packageOf: c) package name = aPackage packageName ].	
	fp do: [ :c | self addFalsePositive: c forRule: aRule ]! !

!CriticsCache methodsFor: 'private' stamp: 'StephaneDucasse 3/20/2013 22:37'!
addAllCriticToToDo: aCollectionOfCritic forRule: aRule on: aManifestBuilder

	| ruleId versionId  |
	ruleId := aRule class uniqueIdentifierName.
	versionId := aRule class identifierMinorVersionNumber.
	(aManifestBuilder hasToDoOf: ruleId version: versionId) 
		ifFalse: [ aManifestBuilder installToDoOf: ruleId version: versionId ].		
	 aManifestBuilder addAllToDo: aCollectionOfCritic of: ruleId version: versionId.

	! !

!CriticsCache methodsFor: 'add/remove' stamp: 'StephaneDucasse 3/20/2013 22:38'!
addFalsePositive: aCritic forRule: aRule

	(falsePositives includesKey: aRule) 
		ifFalse: [ falsePositives at: aRule put: IdentitySet new ].
	(falsePositives at:aRule) add: aCritic. 
	self updateBrowser 	! !

!CriticsCache methodsFor: 'add/remove' stamp: 'StephaneDucasse 3/20/2013 22:38'!
addCritic: aCritic forRule: aRule

	(critics includesKey: aRule) 
		ifFalse: [ critics at:aRule put: IdentitySet new ].
	(critics at:aRule) add: aCritic. 
	self updateBrowser! !

!CriticsCache methodsFor: 'private' stamp: 'SimonAllier 2/5/2013 11:11'!
cacheNotChanged 
	change := false! !

!CriticsCache methodsFor: 'initialize-release' stamp: 'StephaneDucasse 3/20/2013 22:41'!
initCache

	checker rule leaves do: [ :rule | 
		falsePositives at: rule put: (IdentitySet newFrom: (checker falsePositiveOf: rule)).
		toDos at: rule put: (IdentitySet newFrom: (checker toDoOf: rule)).
		critics at: rule put: (IdentitySet newFrom: rule critics) 
	].
	packages do: [ :package |	
		falsePositiveRules at: package put: (checker rejectRulesOf: package) asSet.
		falsePositiveClasses addAll: (checker rejectClassesOf: package) asIdentitySet.
	]! !

!CriticsCache methodsFor: 'private' stamp: 'StephaneDucasse 3/21/2013 13:13'!
logFalsePositiveClassInManifest
	| manifestBuilder |
	packages
		do: [ :package | 
			manifestBuilder := self builderManifestClass ofPackageNamed: package packageName.
			manifestBuilder rejectClasses \ falsePositiveClasses do: [ :cl | manifestBuilder removeRejectClass: cl ].
			falsePositiveClasses \ manifestBuilder rejectClasses do: [ :cl | manifestBuilder addRejectClass: cl ] ]! !

!CriticsCache methodsFor: 'protocol' stamp: 'ClementBera 7/26/2013 16:36'!
criticsOf: aRule

	aRule ifNil: [ ^ {} ].	
	^ aRule isComposite
		ifTrue: [ aRule leaves gather: [ :rule | self criticsOf: rule ]]
		ifFalse: [ critics at: aRule ifAbsent: [{}]]! !

!CriticsCache methodsFor: 'initialization' stamp: 'StephaneDucasse 3/20/2013 22:41'!
initialize
	
	super initialize.
	falsePositives := Dictionary new.
	toDos := Dictionary new.	
	critics := Dictionary new.	
	falsePositiveRules := Dictionary new.
	falsePositiveClasses := IdentitySet new.
	change := false	
! !

!CriticsCache methodsFor: 'private' stamp: 'StephaneDucasse 3/20/2013 22:46'!
removeAllCriticToToDo: aCollectionOfCritic forRule: aRule on: aManifestBuilder

	| ruleId versionId |
	ruleId := aRule class uniqueIdentifierName.
	versionId := aRule class identifierMinorVersionNumber.
	(aManifestBuilder hasToDoOf: ruleId version: versionId) 
		ifTrue: [ aManifestBuilder removeAllToDo: aCollectionOfCritic of: ruleId version: versionId].		
	

	! !

!CriticsCache methodsFor: 'add/remove' stamp: 'StephaneDucasse 3/21/2013 13:01'!
removeFalsePositive: aCritic forRule: aRule

	(falsePositives includesKey: aRule) 
		ifFalse: [^ self].
	(falsePositiveClasses includes: aCritic criticTheNonMetaclassClass) 
			ifTrue: [^ self].
	(falsePositives at: aRule) remove: aCritic ifAbsent: [^ self].
	self updateBrowser
! !

!CriticsCache methodsFor: 'add/remove' stamp: 'SimonAllier 2/5/2013 11:16'!
removeToDo: aCritic forRule: aRule

	(toDos includesKey: aRule) 
		ifFalse: [^ self].
			
	(toDos at:aRule) remove: aCritic ifAbsent: [^ self].
	self updateBrowser
	! !

!CriticsCache methodsFor: 'protocol' stamp: 'StephaneDucasse 3/20/2013 22:44'!
logInManifest

	self cacheChange 
		ifFalse: [^ self].
	self logFalsePositiveRulesInManifest.
	self logFalsePositiveClassInManifest.
	self logFalsePositiveInManifest.
	self logToDosInManifest.
	self cacheNotChanged. 		
	self initCache
	! !

!CriticsCache methodsFor: 'add/remove' stamp: 'CamilleTeruel 9/18/2013 14:59'!
removeFalsePositiveClass: aClass
	
	| fp |
	falsePositiveClasses remove: aClass ifAbsent: [^ self]. 
	critics keysAndValuesDo: [ :rule :criticss |
		fp := criticss select: [ :critic | aClass = critic criticTheNonMetaclassClass].
		fp do: [ :each | self removeFalsePositive: each forRule: rule ]].! !

!CriticsCache methodsFor: 'private' stamp: 'MarcusDenker 10/3/2013 22:32'!
logFalsePositiveInManifest
	| removeFp addFp |
	falsePositives
		keysAndValuesDo: [ :rule :criticss | 
			removeFp := (checker falsePositiveOf: rule) \ criticss.
			addFp := criticss \ (checker falsePositiveOf: rule).
			(removeFp groupedBy: [ :each | self builderManifestClass of: each ])
				keysAndValuesDo: [ :manifestBuilder :value | self removeAllCriticToFalsePositive: value forRule: rule on: manifestBuilder ].
			(addFp groupedBy: [ :each | self builderManifestClass of: each ])
				keysAndValuesDo: [ :manifestBuilder :value | 
					(manifestBuilder rejectRules includes: rule class uniqueIdentifierName)
						ifFalse: [ self addAllCriticToFalsePositive: value forRule: rule on: manifestBuilder ] ] ]! !

!CriticsCache methodsFor: 'protocol' stamp: 'MarcusDenker 10/2/2013 20:13'!
replaceAll: oldMethod by: newMethod

	critics valuesDo: [:each |  
		(each includes: oldMethod)
			ifTrue: [
				each remove: oldMethod.
				each add: newMethod ]].
		
	falsePositives valuesDo: [:each |  
		(each includes: oldMethod)
			ifTrue: [
				each remove: oldMethod.
				each add: newMethod ]].

	toDos valuesDo: [:each |  
		(each includes: oldMethod)
			ifTrue: [
				each remove: oldMethod.
				each add: newMethod ]]
	! !

!CriticsCache methodsFor: 'accessing' stamp: 'SimonAllier 1/23/2013 13:48'!
browser: aCodeCritiicBrowser
	browser := aCodeCritiicBrowser ! !

!CriticsCache methodsFor: 'private' stamp: 'SimonAllier 2/5/2013 11:11'!
cacheChanged 
	change := true! !

!CriticsCache methodsFor: 'protocol' stamp: 'StephaneDucasse 3/20/2013 22:40'!
falsePositiveOf: aRule
	
	aRule ifNil: [ ^ {}].
	^ aRule isComposite
		ifTrue: [ aRule leaves gather: [ :rule | self falsePositiveOf: rule ]]
		ifFalse: [falsePositives at: aRule ifAbsent: [{}]]
	
	! !

!CriticsCache methodsFor: 'add/remove' stamp: 'StephaneDucasse 3/21/2013 12:59'!
addFalsePositiveClass: aClass 
	
	| fp |
	falsePositiveClasses add: aClass theNonMetaClass. 
	critics keysAndValuesDo: [ :rule :criticss |
		fp := criticss select: [ :critic | aClass = critic criticTheNonMetaclassClass ].
		fp do: [ :each | self addFalsePositive: each forRule: rule] ].
	self updateBrowser	
! !

!CriticsCache methodsFor: 'private' stamp: 'StephaneDucasse 3/21/2013 12:59'!
addAllCriticToFalsePositive: aCollectionOfCritic forRule: aRule on: aManifestBuilder

	| ruleId versionId  criticss |
	criticss := aCollectionOfCritic reject: [ :c | falsePositiveClasses includes: c criticTheNonMetaclassClass ].
	ruleId := aRule class uniqueIdentifierName.
	versionId := aRule class identifierMinorVersionNumber.
	(aManifestBuilder hasFalsePositiveOf: ruleId version: versionId) 
		ifFalse: [ aManifestBuilder installFalsePositiveOf: ruleId version: versionId ].		
	 aManifestBuilder addAllFalsePositive: criticss of: ruleId version: versionId.

	! !

!CriticsCache methodsFor: 'private' stamp: 'StephaneDucasse 3/21/2013 13:13'!
logFalsePositiveRulesInManifest
	| manifestBuilder |
	falsePositiveRules
		keysAndValuesDo: [ :package :rules | 
			manifestBuilder := self builderManifestClass ofPackageNamed: package packageName.
			manifestBuilder rejectRules \ rules do: [ :rule | manifestBuilder removeRejectRule: rule ].
			rules \ manifestBuilder rejectRules do: [ :rule | manifestBuilder addRejectRule: rule ] ]! !

!CriticsCache methodsFor: 'accessing' stamp: 'SimonAllier 1/31/2013 13:50'!
packages: aPackageEnv
	
	packages := aPackageEnv packages! !

!CriticsCache methodsFor: 'private' stamp: 'StephaneDucasse 3/20/2013 22:46'!
removeAllCriticToFalsePositive: aCollectionOfCritic forRule: aRule on: aManifestBuilder

	| ruleId versionId |
	ruleId := aRule class uniqueIdentifierName.
	versionId := aRule class identifierMinorVersionNumber.
	(aManifestBuilder hasFalsePositiveOf: ruleId version: versionId) 
		ifTrue: [ aManifestBuilder removeAllFalsePositive: aCollectionOfCritic of: ruleId version: versionId ].		
	 

	! !

!CriticsCache methodsFor: 'add/remove' stamp: 'StephaneDucasse 3/20/2013 22:46'!
removeCritic: aCritic forRule: aRule

	(critics includesKey: aRule) 
		ifFalse: [^ self].
	(critics at: aRule) remove: aCritic ifAbsent: [^ self].
	self updateBrowser
	! !

!CriticsCache methodsFor: 'private' stamp: 'StephaneDucasse 1/6/2014 20:51'!
builderManifestClass
	^ TheManifestBuilder! !

!CriticsCache methodsFor: 'add/remove' stamp: 'StephaneDucasse 3/21/2013 13:03'!
removeFalsePositiveRule: aRule forPackage: aPackage
	| fp |
	
	(falsePositiveRules includesKey: aPackage) 
		ifFalse: [^ self].
	
	(falsePositiveRules at:aPackage) remove: (aRule class uniqueIdentifierName) ifAbsent: [^ self]. 

	fp := (critics at: aRule ifAbsent: [^ self])
		select: [:c | ((self packageOf: c) package name) = (aPackage packageName) and: [
						(falsePositiveClasses includes: c criticTheNonMetaclassClass) not]].			
	fp do: [:c | self removeFalsePositive: c forRule: aRule]. 
	
	self updateBrowser ! !

!CriticsCache methodsFor: 'add/remove' stamp: 'MarcusDenker 10/2/2013 20:12'!
itemRemoved: aItem

	critics valuesDo: [ :each | each remove: aItem ifAbsent: []].
	toDos valuesDo: [ :each | each remove: aItem ifAbsent: []].
	falsePositives valuesDo: [ :each | each remove: aItem ifAbsent: []].	
	self updateBrowser  ! !

!CriticsCache methodsFor: 'private' stamp: 'MarcusDenker 10/3/2013 22:31'!
logToDosInManifest
	| removeFp addFp |
	toDos
		keysAndValuesDo: [ :rule :criticss | 
			removeFp := (checker toDoOf: rule) \ criticss.
			addFp := criticss \ (checker toDoOf: rule).
			(removeFp groupedBy: [ :each | self builderManifestClass of: each ])
				keysAndValuesDo: [ :manifestBuilder :value | self removeAllCriticToToDo: value forRule: rule on: manifestBuilder ].
			(addFp groupedBy: [ :each | self builderManifestClass of: each ])
				keysAndValuesDo: [ :manifestBuilder :value | 
					(manifestBuilder rejectRules includes: rule class uniqueIdentifierName)
						ifFalse: [ self addAllCriticToToDo: value forRule: rule on: manifestBuilder ] ] ]! !

!CriticsCache methodsFor: 'private' stamp: 'SimonAllier 2/5/2013 11:19'!
updateBrowser

	self cacheChanged.
	browser updateTree ! !

!CriticsCache methodsFor: 'accessing' stamp: 'SimonAllier 1/23/2013 10:28'!
checker: aSmallLintChercker
	checker := aSmallLintChercker! !

!CriticsCache methodsFor: 'private' stamp: 'SimonAllier 3/21/2013 15:18'!
packageOf: aCritc
	^ aCritc mcWorkingCopy 
	"aCritc isCompiledMethod 
		ifTrue: [MCWorkingCopy managersForClass: aCritc methodClass selector: aCritc selector do: [ :package | ^ package ]]	
		ifFalse: [MCWorkingCopy managersForClass: aCritc do: [: package | ^ package ]]	"! !

!CriticsCache methodsFor: 'accessing' stamp: 'SimonAllier 2/5/2013 11:11'!
cacheChange
	^ change! !

!CubeHelix commentStamp: 'DamienPollet 12/23/2014 17:17'!
My instances represent a color gradient in the CubeHelix family.

	CubeHelix new at: someValueBetweenZeroAndOne

CubeHelix is a formula for color gradients which ensure a continuous increase in perceived intensity from black to white, with hue variations that increase  by following a tapered spiral around the diagonal of the RGB color cube. Converting the gradient back to grayscale produces a linear gradient.

See http://www.mrao.cam.ac.uk/~dag/CUBEHELIX/
!
!CubeHelix methodsFor: 'initialization' stamp: 'DamienPollet 8/31/2014 23:47'!
initialize
	"values from the default gradient in the paper"
	hueShift := 0.5. "darkest color is a purple"
	rotations := -1.5. "progress towards blues rather than reds"
	saturation := 1.2.
	gamma := 1.0! !

!CubeHelix methodsFor: 'accessing' stamp: 'DamienPollet 8/31/2014 23:54'!
at: gradientParameter
	| gradientGamma phi alpha |
	gradientGamma := gradientParameter raisedTo: gamma.
	phi := 2.0 * Float pi * (hueShift / 3.0 + (rotations * gradientParameter)).
	alpha := saturation * gradientGamma * (1.0 - gradientGamma) / 2.0.

	^ Color fromRgbTriplet: (
		gradientGamma + (alpha * Coefficients +* (Array with: phi cos with: phi sin))
			collect: [ :c | c min: 1 max: 0 ])! !

!CubeHelix methodsFor: 'conversion - athens' stamp: 'DamienPollet 9/1/2014 17:28'!
asColorStops: stopsNumber on: aGradientPaint
	0.0 to: 1.0 by: (stopsNumber - 1) reciprocal do: [ :offset |
		aGradientPaint
			atStop: offset
			put: (self at: offset) ].
	^ aGradientPaint! !

!CubeHelix methodsFor: 'accessing' stamp: 'DamienPollet 9/1/2014 00:10'!
gamma: aNumber
	"Defines the luminance bias of the gradient.
	<1 : compressed dark tones
	=1 : linear progression
	>1 : compressed light tones"
	gamma := aNumber! !

!CubeHelix methodsFor: 'accessing' stamp: 'DamienPollet 9/1/2014 00:03'!
hueShift: hue
	"Defines the starting point (the hue of the darkest color) on the chroma wheel.
	The value is modulo 3: 1=red, 2=green, 3=0=blue"
	hueShift := hue! !

!CubeHelix methodsFor: 'accessing' stamp: 'DamienPollet 9/1/2014 00:08'!
saturation: saturationCoefficient
	"Defines the deviation away from gray levels (saturation 0).
	Values higher than 1 can produce saturated colors."
	saturation := saturationCoefficient! !

!CubeHelix methodsFor: 'accessing' stamp: 'DamienPollet 9/1/2014 17:15'!
rotations
	^ rotations! !

!CubeHelix methodsFor: 'accessing' stamp: 'DamienPollet 9/1/2014 00:07'!
rotations: nbRotations
	"Defines the angular spread and direction of the gradient over the chromatic wheel.
	From dark to light, positive values will follow the RGB order (and negative values in the other direction)"
	rotations := nbRotations! !

!CubeHelix class methodsFor: 'class initialization' stamp: 'DamienPollet 8/31/2014 22:49'!
initialize
	" self initialize "
	Coefficients := Matrix rows: 3 columns: 2 contents: #(
		-0.14861	1.78277
		-0.29227	-0.90649
		1.97924	0
	)! !

!CubeHelix class methodsFor: 'instance creation' stamp: 'DamienPollet 8/31/2014 23:42'!
hueShift: hueShift rotations: rotations saturation: saturation
	^ self new
		hueShift: hueShift;
		rotations: rotations;
		saturation: saturation;
		yourself! !

!Cubic commentStamp: 'wiz 6/17/2004 20:31'!
I am a segment between to points. In the form of a cubic polynomial that can be evaluated between 0..1 to obtain the end points and intermediate values.
!
!Cubic methodsFor: 'cubic support' stamp: 'StephaneDucasse 6/5/2011 16:13'!
bestSegments
	"Return the smallest integer number of segments that give the best curve."
	
	^ self honeIn: self calcEnoughSegments! !

!Cubic methodsFor: 'cubic support' stamp: 'StephaneDucasse 6/5/2011 16:14'!
leeway
	"How close can measure be"
	
	^ 0.1! !

!Cubic methodsFor: 'cubic support' stamp: 'StephaneDucasse 6/5/2011 16:14'!
honeIn: centerN step: step measure: measure withIn: closeEnough 
	"Pick the best n by binary search."
	
	| nTry |
	step < 1
		ifTrue: [^ centerN].
	nTry := centerN - step.
	^ measure > (closeEnough + (self measureFor: nTry))
		ifTrue: [self
				honeIn: centerN
				step: step // 2
				measure: measure
				withIn: closeEnough]
		ifFalse: [self
				honeIn: nTry
				step: step // 2
				measure: measure
				withIn: closeEnough]! !

!Cubic methodsFor: 'cubic support' stamp: 'StephaneDucasse 6/5/2011 16:15'!
measureFor: n 
	"Return a distance measure for cubic curve with n segments. 
	For convienence and accuracy we use the sum of the distances. "
	"The first point is poly of 0."
	| p1 measure |
	p1 := self first.
	measure := 0.
	1 to: n do: [:i | | p2 | 
			p2 := self polynomialEval: i / n asFloat.
			measure := measure + (p2 dist: p1).
			p1 := p2].
	^ measure! !

!Cubic methodsFor: 'cubic support' stamp: 'StephaneDucasse 6/5/2011 16:14'!
calcEnoughSegments
	"Find the power of two that represents a sufficient number of  segments for this cubic.  
	The measure is the sum of distances for the segments.  
	We want this to be close enough not affect the straightness of  
	the drawn lines. Which means within one pixel."
	
	^ self
		enough: 4
		withMeasure: (self measureFor: 2)
		withIn: self leeway! !

!Cubic methodsFor: 'cubic support' stamp: 'StephaneDucasse 6/5/2011 16:14'!
enough: nTry withMeasure: lastMeasure withIn: closeEnough
	"See comment in calcEnoughSegments for which I am a helper"
	
	| measure |
	measure := self measureFor: nTry.
	measure > (lastMeasure + closeEnough)
		ifFalse: [^ nTry // 2].
	^ self
		enough: 2 * nTry
		withMeasure: measure
		withIn: closeEnough! !

!Cubic methodsFor: 'cubic support' stamp: 'StephaneDucasse 6/5/2011 16:14'!
honeIn: enough 
	"Find if there is a smaller n than enough that give the same  
	measure for n."
	
	[enough isPowerOfTwo]  assert.
	enough < 2 ifTrue: [^ enough].
	^ self
		honeIn: enough
		step: enough // 2
		measure: (self measureFor: enough)
		withIn: self leeway! !

!Cubic class methodsFor: 'instance creation' stamp: 'stephane.ducasse 12/21/2008 11:00'!
with: pt1 with: pt2  with: pt3 with: pt4
	"a cubic object is composed of 4 points"
	
	^ self withAll: {pt1 . pt2 . pt3 . pt4}! !

!CurrentChangeSetChanged commentStamp: 'TorstenBergmann 1/31/2014 10:28'!
Announce that the current change set has changed!
!CurrentChangeSetChanged methodsFor: 'accessing' stamp: 'StephaneDucasse 11/2/2012 14:22'!
new: anObject
	new := anObject! !

!CurrentChangeSetChanged methodsFor: 'accessing' stamp: 'StephaneDucasse 11/2/2012 16:37'!
old: anObject
	old := anObject  ! !

!CurrentChangeSetChanged methodsFor: 'accessing' stamp: 'StephaneDucasse 11/2/2012 14:23'!
old
	^ old! !

!CurrentChangeSetChanged methodsFor: 'accessing' stamp: 'StephaneDucasse 11/2/2012 14:22'!
new
	^ new! !

!Cursor commentStamp: '<historical>'!
I am a Form that is a possible appearance for a mouse cursor.  My size is always 16x16, ever since the original implementation on the Alto.

There are many examples available in the "current cursor" category of class methods.  For example, "Cursor normal" and "Cursor wait".  For example:

	Cursor wait show

!
!Cursor methodsFor: 'converting' stamp: 'bf 2/2/1999 19:32'!
withMask
	^CursorWithMask derivedFrom: self! !

!Cursor methodsFor: 'testing' stamp: 'bf 2/2/1999 19:34'!
hasMask
	^false! !

!Cursor methodsFor: 'testing' stamp: 'FernandoOlivero 3/6/2011 22:05'!
isCurrent
	^ self class currentCursor == self ! !

!Cursor methodsFor: 'primitives' stamp: ''!
beCursor
	"Primitive. Tell the interpreter to use the receiver as the current cursor 
	image. Fail if the receiver does not match the size expected by the 
	hardware. Essential. See Object documentation whatIsAPrimitive."

	<primitive: 101>
	self primitiveFailed! !

!Cursor methodsFor: 'printing' stamp: ''!
printOn: aStream

	self storeOn: aStream base: 2! !

!Cursor methodsFor: 'displaying' stamp: 'StephaneDucasse 3/3/2011 17:44'!
show
	"Make the hardware's mouse cursor look like the receiver"

	self class currentCursor: self! !

!Cursor methodsFor: 'primitives' stamp: 'jm 9/22/1998 23:33'!
beCursorWithMask: maskForm
	"Primitive. Tell the interpreter to use the receiver as the current cursor image with the given mask Form. Both the receiver and the mask should have extent 16@16 and a depth of one. The mask and cursor bits are combined as follow:
			mask	cursor	effect
			 0		  0		transparent (underlying pixel shows through)
			 1		  1		opaque black
			 1		  0		opaque white
			 0		  1		invert the underlying pixel"
"Essential. See Object documentation whatIsAPrimitive."

	<primitive: 101>
	self primitiveFailed
! !

!Cursor methodsFor: 'updating' stamp: 'ls 6/17/2002 12:00'!
changed: aParameter
	"overriden to reinstall the cursor if it is the active cursor, in case the appearance has changed.  (Is this used anywhere?  Do cursors really change in place these days?)"
	self == CurrentCursor ifTrue: [self beCursor].
	super changed: aParameter! !

!Cursor methodsFor: 'displaying' stamp: 'MarcusDenker 12/2/2011 16:22'!
showWhile: aBlock 
	"While evaluating the argument, aBlock, make the receiver be the cursor shape."
	| oldcursor |
	oldcursor := self class currentCursor.
	self show.
	^aBlock ensure: [oldcursor show]
! !

!Cursor methodsFor: 'converting' stamp: 'MarcusDenker 4/10/2011 09:45'!
asCursorForm
	| form |
	form := Form extent: self extent depth: 8.
	form fillShape: self fillColor: Color black at: offset negated.
	^ form offset: offset! !

!Cursor class methodsFor: 'constants' stamp: 'ar 9/26/2001 22:37'!
webLink
	"Return a cursor that can be used for emphasizing web links"
	"Cursor webLink showWhile: [Sensor waitButton]"
	^WebLinkCursor ifNil:[
		WebLinkCursor :=  (CursorWithMask extent: 16@16
			fromArray: #(3072 4608 4608 4608 4608 5046 4681 29257 37449 37449 32769 32769 49155 16386 24582 16380 )
			offset: -5@0) setMaskForm:
		(Form extent: 16@16 
			fromArray: (#(3072 7680 7680 7680 7680 8118 8191 32767 65535 65535 65535 65535 65535 32766 32766 16380 )  collect: [:bits | bits bitShift: 16])
			offset: 0@0)].! !

!Cursor class methodsFor: 'constants' stamp: 'JMM 10/21/2003 18:58'!
resizeLeft
	"Cursor resizeLeft showWhile: [Sensor waitButton]"
	^ResizeLeftCursor! !

!Cursor class methodsFor: 'initialization' stamp: 'nice 3/5/2010 22:21'!
initBottomRight

	BottomRightCursor := 
		(Cursor extent: 16 @ 16
			fromArray: #(
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r1111111111111111
		2r1111111111111111)
			offset: -16 @ -16).
! !

!Cursor class methodsFor: 'initialization' stamp: 'nice 3/5/2010 22:21'!
initResizeLeft

       ResizeLeftCursor :=
               (Cursor extent: 16 @ 16 fromArray: #(
               2r0000000000000000
               2r0000000000000000
               2r0000000000000000
               2r0000000000000000
               2r0000100000010000
               2r0001100000011000
               2r0011100000011100
               2r0111111111111110
               2r0011100000011100
               2r0001100000011000
               2r0000100000010000
               2r0000000000000000
               2r0000000000000000
               2r0000000000000000
               2r0000000000000000
               2r0000000000000000 )
       offset: -7 @ -7 ) withMask! !

!Cursor class methodsFor: 'initialization' stamp: ''!
initDown

	DownCursor  :=
		     (Cursor
	extent: 16@16
	fromArray: #(
		2r11000000000000
		2r11000000000000
		2r11000000000000
		2r11000000000000
		2r11000000000000
		2r11000000000000
		2r11000000000000
		2r1111110000000000
		2r111100000000000
		2r11000000000000
		2r0
		2r0
		2r0
		2r0
		2r0
		2r0)
	offset: 0@0).
! !

!Cursor class methodsFor: 'constants' stamp: 'ar 8/16/2001 14:48'!
resizeBottom
	"Cursor resizeBottom showWhile: [Sensor waitButton]"
	^self resizeTop! !

!Cursor class methodsFor: 'constants' stamp: 'ar 8/16/2001 14:45'!
resizeBottomRight
	"Cursor resizeBottomRight showWhile: [Sensor waitButton]"
	^self resizeTopLeft! !

!Cursor class methodsFor: 'initialization' stamp: 'JMM 10/21/2003 19:02'!
initTopRight
	TopRightCursor := 
		(Cursor extent: 16@16
			fromArray: #(
		2r1111111111111111
		2r1111111111111111
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011)
			offset: -16@0).
! !

!Cursor class methodsFor: 'constants' stamp: ''!
normal
	"Answer the instance of me that is the shape of an arrow slanted left."

	^NormalCursor! !

!Cursor class methodsFor: 'initialization' stamp: ''!
initRightArrow 

	RightArrowCursor  :=
		      (Cursor
	extent: 16@16
	fromArray: #(
		2r100000000000
		2r111000000000
		2r1111111110000000
		2r111000000000
		2r100000000000
		2r0
		2r0
		2r0
		2r0
		2r0
		2r0
		2r0
		2r0
		2r0
		2r0
		2r0)
	offset: 0@0).
	
	"Cursor initRightArrow"! !

!Cursor class methodsFor: 'initialization' stamp: 'kfr 7/12/2003 22:52'!
initWrite

	WriteCursor := (Cursor
	extent: 16@16
	fromArray: #(
		2r0000000000011000
		2r0000000000111100
		2r0000000001001000
		2r0000000010010000
		2r0000000100100000
		2r0000001001000100
		2r0000010010000100
		2r0000100100001100
		2r0001001000010000
		2r0010010000010000
		2r0111100000001000
		2r0101000011111000
		2r1110000110000000
		2r0111111100000000
		2r0
		2r0)
	offset: 0@0).
! !

!Cursor class methodsFor: 'initialization' stamp: 'nice 3/5/2010 22:22'!
initNormalWithMask    "Cursor initNormalWithMask.  Cursor normal show"
	"Next two lines work simply for any cursor..."
	self initNormal.
	NormalCursor := CursorWithMask derivedFrom: NormalCursor.

	"But for a good looking cursor, you have to tweak things..."
	NormalCursor := (CursorWithMask extent: 16 @ 16 depth: 1
			fromArray: #( 0 1073741824 1610612736 1879048192
				2013265920 2080374784 2113929216 2130706432
				2080374784 2080374784 1275068416 100663296
				100663296 50331648 50331648 0)
			offset: -1 @ -1)
		setMaskForm: (Form extent: 16@16 depth: 1
			fromArray: #( 3221225472 3758096384 4026531840 4160749568
				4227858432 4261412864 4278190080 4286578688
				4278190080 4261412864 4261412864 3472883712
				251658240 125829120 125829120 50331648)
			offset: 0 @ 0).! !

!Cursor class methodsFor: 'initialization' stamp: 'AlainPlantec 2/1/2011 14:31'!
initialize
	"Create all the standard cursors..." 
		self initOrigin.
		self initRightArrow.
		self initMenu.
		self initCorner.
		self initRead.
		self initWrite.
		self initWait.
		BlankCursor := Cursor new.
		self initXeq.
		self initSquare.
		self initNormalWithMask.
		self initCrossHair.
		self initMarker.
		self initUp.
		self initDown.
		self initMove.
		self initBottomLeft.
		self initBottomRight.
		self initResizeLeft.
		self initResizeTop.
		self initResizeTopLeft.
		self initResizeTopRight.
		self initTopLeft.
		self initTopRight.
		self initTarget.
		self initOverEditableText.
		self makeCursorsWithMask.

		"Cursor initialize"
! !

!Cursor class methodsFor: 'initialization' stamp: ''!
startUp
	self currentCursor: self currentCursor! !

!Cursor class methodsFor: 'constants' stamp: 'ar 8/16/2001 14:46'!
resizeBottomLeft
	"Cursor resizeBottomLeft showWhile: [Sensor waitButton]"
	^self resizeTopRight! !

!Cursor class methodsFor: 'constants' stamp: ''!
write
	"Answer the instance of me that is the shape of a pen writing."

	^WriteCursor! !

!Cursor class methodsFor: 'initialization' stamp: 'AlainPlantec 12/27/2010 13:07'!
initOverEditableText
	OverEditableText := (Cursor extent: 16@16 fromArray: #(
				2r0
	               2r000111011100000
	               2r000000100000000
	               2r000000100000000
	               2r000000100000000
	               2r000000100000000
	               2r000000100000000
	               2r000000100000000
	               2r000000100000000
	               2r000000100000000
	               2r000000100000000
	               2r000000100000000
	               2r000000100000000
	               2r000000100000000
	               2r000111011100000
				2r0)
	       offset: (-7@ -8)) 

! !

!Cursor class methodsFor: 'initialization' stamp: ''!
initMarker

	MarkerCursor := 
		Cursor
			extent: 16@16
			fromArray: #(
		2r0111000000000000
		2r1111100000000000
		2r1111100000000000
		2r0111000000000000
		2r0
		2r0
		2r0
		2r0
		2r0
		2r0
		2r0
		2r0
		2r0
		2r0
		2r0
		2r0)
			offset: 0@0.
! !

!Cursor class methodsFor: 'constants' stamp: 'JMM 10/21/2003 19:19'!
resizeTop
	"Cursor resizeTop showWhile: [Sensor waitButton]"
	^ResizeTopCursor! !

!Cursor class methodsFor: 'initialization' stamp: 'JMM 10/21/2003 19:01'!
initTopLeft
	TopLeftCursor := 
		(Cursor extent: 16@16
			fromArray: #(
		2r1111111111111111
		2r1111111111111111
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000)
			offset: 0@0).
! !

!Cursor class methodsFor: 'initialization' stamp: 'nice 3/5/2010 22:22'!
initResizeTopLeft

       ResizeTopLeftCursor :=
               (Cursor extent: 16 @ 16 fromArray: #(
               2r0000000000000000
               2r0111110000000000
               2r0111100000000000
               2r0111000000000000
               2r0110100000000000
               2r0100010000000000
               2r0000001000000000
               2r0000000100000000
               2r0000000010000000
               2r0000000001000100
               2r0000000000101100
               2r0000000000011100
               2r0000000000111100
               2r0000000001111100
               2r0000000000000000
               2r0000000000000000)
       offset: -7 @ -7) withMask! !

!Cursor class methodsFor: 'constants' stamp: ''!
crossHair
	"Answer the instance of me that is the shape of a cross."

	^CrossHairCursor! !

!Cursor class methodsFor: 'current cursor' stamp: 'md 5/26/2011 14:33'!
currentCursor: aCursor 
	"Make the instance of cursor, aCursor, be the current cursor. Display it."

	CurrentCursor := aCursor.
	aCursor beCursor! !

!Cursor class methodsFor: 'constants' stamp: ''!
square
	"Answer the instance of me that is the shape of a square."

	^SquareCursor! !

!Cursor class methodsFor: 'constants' stamp: ''!
down
	"Answer the instance of me that is the shape of an arrow facing 
	downward."

	^DownCursor! !

!Cursor class methodsFor: 'initialization' stamp: ''!
initOrigin

	OriginCursor :=   
		(Cursor
			extent: 16@16
			fromArray: #(
		2r1111111111111111
		2r1111111111111111
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000)
			offset: 0@0).
! !

!Cursor class methodsFor: 'initialization' stamp: 'nice 3/5/2010 22:22'!
initCorner

	CornerCursor := 
		(Cursor 
			extent: 16 @ 16
			fromArray: #(
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r1111111111111111
		2r1111111111111111)
			offset: -16 @ -16).
! !

!Cursor class methodsFor: 'initialization' stamp: ''!
initUp

	UpCursor := 
		    (Cursor
	extent: 16@16
	fromArray: #(
		2r11000000000000
		2r111100000000000
		2r1111110000000000
		2r11000000000000
		2r11000000000000
		2r11000000000000
		2r11000000000000
		2r11000000000000
		2r11000000000000
		2r11000000000000
		2r0
		2r0
		2r0
		2r0
		2r0
		2r0)
	offset: 0@0).
! !

!Cursor class methodsFor: 'initialization' stamp: 'nice 3/5/2010 22:22'!
initCrossHair

	CrossHairCursor :=   
		(Cursor
			extent: 16 @ 16
			fromArray: #(
		2r0000000000000000
		2r0000000100000000
		2r0000000100000000
		2r0000000100000000
		2r0000000100000000
		2r0000000100000000
		2r0000000100000000
		2r0111111111111100
		2r0000000100000000
		2r0000000100000000
		2r0000000100000000
		2r0000000100000000
		2r0000000100000000
		2r0000000100000000
		2r0000000000000000
		2r0)
			offset: -7 @ -7).
	
	! !

!Cursor class methodsFor: 'initialization' stamp: ''!
initXeq

	XeqCursor := 
		(Cursor
			extent: 16@16
			fromArray: #(
		2r1000000000010000
		2r1100000000010000
		2r1110000000111000
		2r1111000111111111
		2r1111100011000110
		2r1111110001000100
		2r1111111001111100
		2r1111000001101100
		2r1101100011000110
		2r1001100010000010
		2r0000110000000000
		2r0000110000000000
		2r0000011000000000
		2r0000011000000000
		2r0000001100000000
		2r0000001100000000)
	offset: 0@0).
! !

!Cursor class methodsFor: 'constants' stamp: 'JMM 10/21/2003 19:00'!
resizeTopRight
	"Cursor resizeTopRight showWhile: [Sensor waitButton]"
	^ResizeTopRightCursor! !

!Cursor class methodsFor: 'constants' stamp: 'AlainPlantec 12/22/2010 18:15'!
overEditableText
	^ OverEditableText ! !

!Cursor class methodsFor: 'constants' stamp: ''!
origin
	"Answer the instance of me that is the shape of the top left corner of a 
	rectangle."

	^OriginCursor! !

!Cursor class methodsFor: 'constants' stamp: ''!
blank
	"Answer the instance of me that is all white."

	^BlankCursor! !

!Cursor class methodsFor: 'initialization' stamp: 'bf 2/2/1999 19:33'!
makeCursorsWithMask
	"Cursor initialize;makeCursorsWithMask"

	self classPool associationsDo: [:var |
		var value hasMask
			ifFalse: [var value: var value withMask]] ! !

!Cursor class methodsFor: 'initialization' stamp: 'di 7/30/2001 10:32'!
initMenu 

	MenuCursor  :=
		        (Cursor
	extent: 16@16
	fromArray: #(
		2r1111111111100000
		2r1000000000100000
		2r1010011000100000
		2r1000000000100000
		2r1101001101100000
		2r1111111111100000
		2r1000000000100000
		2r1011001010100000
		2r1000000000100000
		2r1010110010100000
		2r1000000000100000
		2r1010010100100000
		2r1000000000100000
		2r1111111111100000
		0)
	offset: 0@0).
! !

!Cursor class methodsFor: 'constants' stamp: ''!
move
	"Answer the instance of me that is the shape of a cross inside a square."

	^MoveCursor! !

!Cursor class methodsFor: 'constants' stamp: ''!
read
	"Answer the instance of me that is the shape of eyeglasses."

	^ReadCursor! !

!Cursor class methodsFor: 'constants' stamp: 'JMM 10/21/2003 19:00'!
resizeTopLeft
	"Cursor resizeTopLeft showWhile: [Sensor waitButton]"
	^ ResizeTopLeftCursor! !

!Cursor class methodsFor: 'instance creation' stamp: 'ar 8/16/2001 15:52'!
resizeForEdge: aSymbol
	"Cursor resizeForEdge: #top"
	"Cursor resizeForEdge: #bottomLeft"
	^self perform: ('resize', aSymbol first asString asUppercase, (aSymbol copyFrom: 2 to: aSymbol size)) asSymbol.! !

!Cursor class methodsFor: 'initialization' stamp: ''!
initNormal

	NormalCursor :=   
		(Cursor
			extent: 16@16
			fromArray: #(
		2r1000000000000000
		2r1100000000000000
		2r1110000000000000
		2r1111000000000000
		2r1111100000000000
		2r1111110000000000
		2r1111111000000000
		2r1111100000000000
		2r1111100000000000
		2r1001100000000000
		2r0000110000000000
		2r0000110000000000
		2r0000011000000000
		2r0000011000000000
		2r0000001100000000
		2r0000001100000000)
	offset: 0@0).

	
	! !

!Cursor class methodsFor: 'constants' stamp: 'JMM 10/21/2003 19:13'!
bottomRight
	"Cursor bottomRight showWhile: [Sensor waitButton]"
	^BottomRightCursor
! !

!Cursor class methodsFor: 'initialization' stamp: 'kfr 7/12/2003 21:10'!
initMove

	MoveCursor := 
		Cursor 
			extent: 16@16
			fromArray: #(
		2r1111111111111100
		2r1111111111111100
		2r1100001100001100
		2r1100001100001100
		2r1100001100001100
		2r1100001100001100
		2r1111111111111100
		2r1111111111111100
		2r1100001100001100
		2r1100001100001100
		2r1100001100001100
		2r1100001100001100
		2r1111111111111100
		2r1111111111111100
          0)
			offset: 0@0.
! !

!Cursor class methodsFor: 'constants' stamp: ''!
menu 
	"Answer the instance of me that is the shape of a menu."

	^MenuCursor! !

!Cursor class methodsFor: 'constants' stamp: ''!
rightArrow 
	"Answer the instance of me that is the shape of an arrow pointing to the right."

	^RightArrowCursor! !

!Cursor class methodsFor: 'constants' stamp: ''!
corner
	"Answer the instance of me that is the shape of the bottom right corner 
	of a rectangle."

	^CornerCursor! !

!Cursor class methodsFor: 'constants' stamp: 'ar 8/16/2001 14:45'!
resizeRight
	"Cursor resizeRight showWhile: [Sensor waitButton]"
	^self resizeLeft! !

!Cursor class methodsFor: 'constants' stamp: ''!
up
	"Answer the instance of me that is the shape of an arrow facing upward."

	^UpCursor! !

!Cursor class methodsFor: 'initialization' stamp: 'nice 3/5/2010 22:22'!
initSquare

	SquareCursor := 
		(Cursor
			extent: 16 @ 16
			fromArray: #(
		2r0
		2r0
		2r0
		2r0
		2r0
		2r0000001111000000
		2r0000001111000000
		2r0000001111000000
		2r0000001111000000
		2r0
		2r0
		2r0
		2r0
		2r0
		2r0
		2r0)
	offset: -8 @ -8).

	! !

!Cursor class methodsFor: 'constants' stamp: 'JMM 10/21/2003 19:01'!
topLeft
	"Cursor topLeft showWhile: [Sensor waitButton]"
	^ TopLeftCursor! !

!Cursor class methodsFor: 'initialization' stamp: 'ar 3/1/2006 22:42'!
initTarget
	^TargetCursor := Cursor
				extent: 16 @ 16
				fromArray:  #(1984 6448 8456 16644 17284 33026 35106 65278 35106 33026 17284 16644 8456 6448 1984 0)
				offset: -7 @ -7! !

!Cursor class methodsFor: 'initialization' stamp: 'kfr 7/12/2003 22:55'!
initRead

	ReadCursor :=  
		(Cursor
			extent: 16@16
			fromArray: #(
		2r0000000000000000
		2r0000000000000000
		2r0001000000001000
		2r0010100000010100
		2r0100000000100000
		2r1111101111100000
		2r1000010000100000
		2r1000010000100000
		2r1011010110100000
		2r0111101111000000
		2r0
		2r0
		2r0
		2r0
		2r0
		2r0)
	offset: 0@0).
! !

!Cursor class methodsFor: 'constants' stamp: 'JMM 10/21/2003 19:13'!
bottomLeft
	"Cursor bottomLeft showWhile: [Sensor waitButton]"
	^BottomLeftCursor
! !

!Cursor class methodsFor: 'constants' stamp: 'JMM 10/21/2003 19:02'!
topRight
	"Cursor topRight showWhile: [Sensor waitButton]"
	^ TopRightCursor! !

!Cursor class methodsFor: 'constants' stamp: ''!
marker
	"Answer the instance of me that is the shape of a small ball."

	^MarkerCursor! !

!Cursor class methodsFor: 'initialization' stamp: 'nice 3/5/2010 22:23'!
initResizeTop
    "Cursor initResizeTop"
       ResizeTopCursor :=
               (Cursor extent: 16 @ 16 fromArray: #(
               2r000000100000000
               2r000001110000000
               2r000011111000000
               2r000111111100000
               2r000000100000000
               2r000000100000000
               2r000000100000000
               2r000000100000000
               2r000000100000000
               2r000000100000000
               2r000111111100000
               2r000011111000000
               2r000001110000000
               2r000000100000000
               2r000000000000000)
       offset: -7 @ -7) withMask! !

!Cursor class methodsFor: 'instance creation' stamp: 'di 10/6/1998 13:53'!
new

	^ self extent: 16 @ 16
		fromArray: (Array new: 16 withAll: 0)
		offset: 0 @ 0

	"Cursor new bitEdit show"! !

!Cursor class methodsFor: 'initialization' stamp: 'kfr 7/12/2003 21:27'!
initWait

	WaitCursor := 
		  (Cursor
			extent: 16@16
			fromArray: #(
		2r1111111111111100
		2r1000000000000100
		2r0100000000001000
		2r0010000000010000
		2r0001110011100000
		2r0000111111000000
		2r0000011110000000
		2r0000011110000000
		2r0000100101000000
		2r0001000100100000
		2r0010000110010000
		2r0100001111001000
		2r1000111111110100
		2r1111111111111100
		0)
			offset: 0@0).
! !

!Cursor class methodsFor: 'constants' stamp: ''!
execute
	"Answer the instance of me that is the shape of an arrow slanted left 
	with a star next to it."

	^XeqCursor! !

!Cursor class methodsFor: 'initialization' stamp: 'nice 3/5/2010 22:30'!
initResizeTopRight

       ResizeTopRightCursor :=
               (Cursor extent: 16 @ 16 fromArray: #(
               2r0000000000000000
               2r0000000001111100
               2r0000000000111100
               2r0000000000011100
               2r0000000000101100
               2r0000000001000100
               2r0000000010000000
               2r0000000100000000
               2r0000001000000000
               2r0100010000000000
               2r0110100000000000
               2r0111000000000000
               2r0111100000000000
               2r0111110000000000
               2r0000000000000000
               2r0000000000000000)
       offset: -7 @ -7) withMask! !

!Cursor class methodsFor: 'constants' stamp: 'sw 8/15/97 13:28'!
wait
	"Answer the instance of me that is the shape of an Hourglass (was in the 
	shape of three small balls)."

	^WaitCursor! !

!Cursor class methodsFor: 'instance creation' stamp: ''!
extent: extentPoint fromArray: anArray offset: offsetPoint 
	"Answer a new instance of me with width and height specified by
	extentPoint, offset by offsetPoint, and bits from anArray.
	NOTE: This has been kluged to take an array of 16-bit constants,
	and shift them over so they are left-justified in a 32-bit bitmap"

	extentPoint = (16 @ 16)
		ifTrue: 
			[^ super
				extent: extentPoint
				fromArray: (anArray collect: [:bits | bits bitShift: 16])
				offset: offsetPoint]
		ifFalse: [self error: 'cursors must be 16@16']! !

!Cursor class methodsFor: 'class initialization' stamp: 'nice 3/5/2010 22:31'!
initBottomLeft

	BottomLeftCursor := 
		(Cursor extent: 16 @ 16
			fromArray: #(
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1111111111111111
		2r1111111111111111)
			offset: 0 @ -16).
! !

!Cursor class methodsFor: 'constants' stamp: 'ar 3/1/2006 22:42'!
target
	"Answer the instance of me that is the shape of a gunsight."
	"Cursor target show"
	^TargetCursor ifNil:[self initTarget]! !

!Cursor class methodsFor: 'current cursor' stamp: ''!
currentCursor
	"Answer the instance of Cursor that is the one currently displayed."

	^CurrentCursor! !

!CursorWithAlpha commentStamp: '<historical>'!
A 32-bit ARGB Cursor of arbitrary extent (some platforms may limit the size). Compositing assumes alpha is pre-multiplied.!
!CursorWithAlpha methodsFor: 'accessing' stamp: 'bf 3/30/2007 18:58'!
fallback: aCursor
	fallback := aCursor! !

!CursorWithAlpha methodsFor: 'primitives' stamp: 'yo 5/11/2007 16:20'!
primBeCursor
	<primitive: 101>
	self fallback primBeCursor! !

!CursorWithAlpha methodsFor: 'converting' stamp: 'MarcusDenker 4/10/2011 10:14'!
asCursorForm

	^ Form newFrom: self! !

!CursorWithAlpha methodsFor: 'accessing' stamp: 'bf 3/30/2007 18:57'!
fallback
	^fallback ifNil: [NormalCursor]! !

!CursorWithMask commentStamp: '<historical>'!
A Cursor which additionally has a 16x16 transparency bitmap called a "mask".  See the comment of beCursorWithMask: for details on how the mask is treated.!
!CursorWithMask methodsFor: 'mask' stamp: 'bf 2/2/1999 19:31'!
withMask
	^self! !

!CursorWithMask methodsFor: 'mask' stamp: 'bf 2/2/1999 19:34'!
hasMask
	^true! !

!CursorWithMask methodsFor: 'primitives' stamp: 'di 10/6/1998 15:16'!
beCursor
	maskForm unhibernate.
	^ self beCursorWithMask: maskForm! !

!CursorWithMask methodsFor: 'mask' stamp: 'di 10/8/1998 16:46'!
maskForm
	^ maskForm! !

!CursorWithMask methodsFor: 'converting' stamp: 'MarcusDenker 4/10/2011 09:46'!
asCursorForm
	| form |
	form := Form extent: self extent depth: 8.
	form fillShape: maskForm fillColor: Color white.
	form fillShape: self fillColor: Color black at: offset negated.
	^ form offset: offset! !

!CursorWithMask methodsFor: 'mask' stamp: 'di 10/8/1998 16:46'!
setMaskForm: aForm
	maskForm := aForm! !

!CursorWithMask methodsFor: 'mask' stamp: 'bf 2/2/1999 19:30'!
storeOn: aStream base: anInteger

	aStream nextPut: $(.
	super storeOn: aStream base: anInteger.
	aStream nextPutAll: ' setMaskForm: '.
	maskForm storeOn: aStream base: anInteger.
	aStream nextPut: $)! !

!CursorWithMask class methodsFor: 'as yet unclassified' stamp: 'di 2/18/1999 08:56'!
derivedFrom: aForm      "Cursor initNormalWithMask.  Cursor normal show"
	"aForm is presumably a cursor"
	| cursor mask ext |
	ext := aForm extent.
	cursor := self extent: ext.
	cursor copy: (1@1 extent: ext) from: 0@0 in: aForm rule: Form over.
	mask := Form extent: ext.
	(1@1) eightNeighbors do:
		[:p | mask copy: (p extent: ext) from: 0@0 in: aForm rule: Form under].
	cursor setMaskForm: mask.
	cursor offset: ((aForm offset - (1@1)) max: ext negated).
	^ cursor! !

!CurveWorkshop commentStamp: 'TorstenBergmann 2/12/2014 22:19'!
An example from a workshop!
!CurveWorkshop methodsFor: 'colors' stamp: 'IgorStasenko 4/18/2013 12:35'!
triangleColor
	^ Color green! !

!CurveWorkshop methodsFor: 'colors' stamp: 'IgorStasenko 4/18/2013 12:35'!
middleRayColor
	^ Color blue! !

!CurveWorkshop methodsFor: 'colors' stamp: 'IgorStasenko 4/18/2013 12:35'!
curveColor
	^ Color red! !

!CurveWorkshop methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 4/18/2013 12:36'!
drawOn: canvas

	

	self drawQuadFrom: 10@200 via: 50@50 to: 200@200 on: canvas! !

!CurveWorkshop methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 4/18/2013 06:08'!
draw

	! !

!CurveWorkshop methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 4/18/2013 17:48'!
drawQuadFrom: pt1 via: pt2 to: pt3 on: canvas
	| curve triangle middleRay curveBlock |

	curveBlock := [ :builder | 
		builder 
			absolute;
			moveTo: pt1;
			curveVia: pt2 to: pt3
		 ].

	curve := canvas createPath: curveBlock.

	canvas setStrokePaint: self curveColor.
	canvas drawShape: curve.
	
	triangle :=  canvas createPath: [ :builder | 
		builder 
			absolute;
			moveTo: pt1;
			lineTo: pt2;
			lineTo: pt3;
			lineTo: pt1.
	].
	canvas setStrokePaint: self triangleColor.
	canvas drawShape: triangle.

	middleRay :=  canvas createPath: [ :builder | 
		builder 
			absolute;
			moveTo: pt2;
			lineTo: (pt1 + pt3)/2
	].

	canvas setStrokePaint: self middleRayColor.
	canvas drawShape: middleRay.

	triangle := AthensSimplePathBuilder createPath: curveBlock.
	
	triangle := canvas surface createPath: [ :builder | 
		AthensCurveFlattener new
			dest: builder;
		flattenPath: triangle transform: (canvas pathTransform).
	].
	
	canvas 
		setStrokePaint: Color yellow;
		drawShape: triangle.
	
! !

!CustomHelp commentStamp: 'tbn 3/29/2010 13:23'!
This is a common superclass for custom help. Subclasses of this class are automatically included into the system help.

By default the informations provided on the receiver class are converted into help topics by a specific builder 
- here the CustomHelpHelpBuilder. Note that you can provide an own custom builder by overriding the #builder method

!
!CustomHelp class methodsFor: 'editing' stamp: 'TorstenBergmann 1/27/2015 15:50'!
accept: aSelector title: title contents: text
	"Accept edited text. Compile it into a HelpTopic"

	| code |
	code := String streamContents:[:s|
		s nextPutAll: aSelector.
		s crtab; nextPutAll: '"This method was automatically generated."'.
		s crtab; nextPutAll: '<script: ''self edit: ', aSelector storeString,'''>'.
		s crtab; nextPutAll: '^HelpTopic'.
		s crtab: 2; nextPutAll: 'title: ', title storeString.
		s crtab: 2; nextPutAll: 'contents: '.
		s cr; nextPutAll: (String streamContents:[:c| c nextChunkPut: text]) storeString.
		s nextPutAll:' readStream nextChunkText'.
	].

	self class 
		compile: code
		classified: ((self class organization categoryOfElement: aSelector) ifNil:['pages']).
! !

!CustomHelp class methodsFor: 'accessing' stamp: 'tbn 3/29/2010 13:20'!
bookName
	"Returns the name of the custom help book"
	
	^'Help'! !

!CustomHelp class methodsFor: 'defaults' stamp: 'tbn 3/29/2010 13:24'!
builder
	"Returns the builder that is used to build the given help book from the receiver. You can override this method
	 in a subclass to provide an own builder".
	
	^CustomHelpHelpBuilder! !

!CustomHelp class methodsFor: 'editing' stamp: 'TorstenBergmann 1/27/2015 15:36'!
edit: aSelector
	"Open a Workspace on the text in the given selector.
	When accepted, compile the result as a help topic."

	| topic |
	topic := (self respondsTo: aSelector) 
			ifTrue:[self perform: aSelector]
			ifFalse:[HelpTopic title: 'Untitled' contents: 'Please edit this topic. 
To change the topic title, edit the window label.'].
	UIManager default
		edit: topic contents
		label: topic title
		accept: [:text| 
			|newTitle|
			newTitle := UIManager default request: 'Save with title ' initialAnswer: topic title.		 
			newTitle ifNotNil: [ self accept: aSelector title: newTitle contents: text ]].
! !

!CustomHelp class methodsFor: 'accessing' stamp: 'tbn 3/29/2010 13:20'!
pages 
	"Returns a collection of method selectors to return the pages of the custom help book"
		
	^#()! !

!CustomHelp class methodsFor: 'converting' stamp: 'tbn 1/7/2011 13:03'!
asHelpTopic
	"Convert the receiver to a help topic"
	<systemHelp>
	
	^self builder buildHelpTopicFrom: self! !

!CustomHelp class methodsFor: 'accessing' stamp: 'tbn 3/29/2010 13:18'!
key
	"Returns a unique key identifying the receiver in the help system"
	
	^''! !

!CustomHelp class methodsFor: 'accessing' stamp: 'tbn 3/29/2010 13:20'!
icon
	"Returns an icon used for displaying the custom help book"
	
	^HelpIcons iconNamed: #bookIcon! !

!CustomHelpHelpBuilder commentStamp: 'tbn 3/29/2010 13:30'!
This builder builds help topics from a help topic description (which is typically stored
in a class). 

The help topic description object has to understand the following messages:

  #bookName - should return the name of the help book
  #icon - should return the icon of the help book
  #key - should return a unique key to identify the book
  #pages - should return an array of method selectors to call to get the books pages
!
!CustomHelpHelpBuilder methodsFor: 'building' stamp: 'tbn 3/6/2010 00:28'!
build
	"Start building a help topic from a code description"
	
	topicToBuild := self createTopicFrom: rootToBuildFrom 
! !

!CustomHelpHelpBuilder methodsFor: 'private' stamp: 'tbn 9/30/2010 23:31'!
createTopicFrom: aDescription
	"Create a topic from a description stored on a class.
	aDescription can specify (via #pages) the name of a class and not
	only a selector. This allows for hierarchies with 'subtrees in the middle'"
	
	|topic page   pageClasses |
	topic := HelpTopic named: aDescription bookName.
	topic key: aDescription key.
	topic icon: aDescription icon.
	pageClasses := Set new.
	aDescription pages do: [:pageSelectorOrClass|
		page:= (Smalltalk hasClassNamed: pageSelectorOrClass asString)
					ifFalse: [aDescription perform: pageSelectorOrClass]
					ifTrue: [pageClasses add: (Smalltalk classNamed: pageSelectorOrClass asString).
							 (Smalltalk classNamed: pageSelectorOrClass asString) asHelpTopic].
		topic addSubtopic: page.
	].	
	((aDescription subclasses asSet)
		removeAllFoundIn: pageClasses;
		yourself) do: [:subclass | topic subtopics add: subclass asHelpTopic ].
	^topic! !

!CustomHelpTest commentStamp: 'TorstenBergmann 2/4/2014 21:18'!
SUnit tests for class CustomHelp
!
!CustomHelpTest methodsFor: 'testing' stamp: 'MarcusDenker 8/20/2014 09:59'!
testOpenBrowserOnThisHelpType
	| browser |
	browser := HelpBrowser openOn: CustomHelp.
	World doOneCycleNow.
	browser close! !

!CustomQuestionDialogWindow commentStamp: 'gvc 9/23/2008 11:59'!
QuestionDialog supporting custom text/buttons for yes/no choices.!
!CustomQuestionDialogWindow methodsFor: 'accessing' stamp: 'gvc 1/10/2008 11:30'!
yesButton
	"Answer the value of yesButton"

	^ yesButton! !

!CustomQuestionDialogWindow methodsFor: 'as yet unclassified' stamp: 'GaryChambers 8/23/2010 11:50'!
noText: aStringOrText help: helpString
	"Set the no button label.
	if the text is nil, remove the button."

	aStringOrText
		ifNil: [self noButton delete]
		ifNotNil: [self noButton
					hResizing: #shrinkWrap;
					label: aStringOrText;
					setBalloonText: helpString]! !

!CustomQuestionDialogWindow methodsFor: 'accessing' stamp: 'gvc 1/10/2008 11:30'!
yesButton: anObject
	"Set the value of yesButton"

	yesButton := anObject! !

!CustomQuestionDialogWindow methodsFor: 'as yet unclassified' stamp: 'GaryChambers 8/23/2010 12:16'!
defaultCancelButton
	"Answer a default cancel button."

	^self newCancelButton! !

!CustomQuestionDialogWindow methodsFor: 'accessing' stamp: 'gvc 1/10/2008 11:30'!
noButton: anObject
	"Set the value of noButton"

	noButton := anObject! !

!CustomQuestionDialogWindow methodsFor: 'as yet unclassified' stamp: 'GaryChambers 8/23/2010 12:16'!
default: defaultOption
	"Set the default button."

	defaultOption
		ifNil: [self cancelButton isDefault: true]
		ifNotNil: [defaultOption
					ifTrue: [self yesButton isDefault: true]
					ifFalse: [self noButton isDefault: true]]! !

!CustomQuestionDialogWindow methodsFor: 'initialization' stamp: 'GaryChambers 8/23/2010 11:36'!
initialize
	"Initialize the receiver."

	self
		yesButton: self defaultYesButton;
		noButton: self defaultNoButton;
		cancelButton: self defaultCancelButton.
	super initialize! !

!CustomQuestionDialogWindow methodsFor: 'accessing' stamp: 'gvc 1/10/2008 11:30'!
noButton
	"Answer the value of noButton"

	^ noButton! !

!CustomQuestionDialogWindow methodsFor: 'accessing' stamp: 'GaryChambers 8/23/2010 11:36'!
cancelButton

	^ cancelButton! !

!CustomQuestionDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 1/10/2008 11:31'!
defaultNoButton
	"Answer a default no button."

	^self newNoButton! !

!CustomQuestionDialogWindow methodsFor: 'as yet unclassified' stamp: 'GaryChambers 8/23/2010 12:05'!
defaultYesButton
	"Answer a default yes button."

	^self newYesButton! !

!CustomQuestionDialogWindow methodsFor: 'as yet unclassified' stamp: 'GaryChambers 8/23/2010 12:05'!
newButtons
	"Answer new buttons as appropriate."

	^{self yesButton. self noButton. self cancelButton}! !

!CustomQuestionDialogWindow methodsFor: 'as yet unclassified' stamp: 'GaryChambers 8/23/2010 11:50'!
yesText: aStringOrText help: helpString
	"Set the yes button label.
	if the text is nil, remove the button."

	aStringOrText
		ifNil: [self cancelButton delete]
		ifNotNil: [self yesButton
					hResizing: #shrinkWrap;
					label: aStringOrText;
					setBalloonText: helpString]! !

!CustomQuestionDialogWindow methodsFor: 'accessing' stamp: 'GaryChambers 8/23/2010 11:36'!
cancelButton: anObject

	cancelButton := anObject! !

!CustomQuestionDialogWindow methodsFor: 'as yet unclassified' stamp: 'GaryChambers 8/23/2010 11:50'!
cancelText: aStringOrText help: helpString
	"Set the cancel button label.
	if the text is nil, remove the button."

	aStringOrText
		ifNil: [self cancelButton delete]
		ifNotNil: [self cancelButton
					hResizing: #shrinkWrap;
					label: aStringOrText;
					setBalloonText: helpString]! !

!DamageRecorder commentStamp: 'TorstenBergmann 2/20/2014 18:27'!
Recording damages to repair by repainting!
!DamageRecorder methodsFor: 'recording' stamp: 'MarcusDenker 9/26/2014 15:02'!
recordInvalidRect: newRect
	"Record the given rectangle in my damage list, a list of rectangular areas of the display that should be redraw on the next display cycle."
	"Details: Damaged rectangles are often identical or overlap significantly. In these cases, we merge them to reduce the number of damage rectangles that must be processed when the display is updated. Moreover, above a certain threshold, we ignore the individual rectangles completely, and simply do a complete repaint on the next cycle."

	| mergeRect zeroRect |
	totalRepaint ifTrue: [^ self].  "planning full repaint; don't bother collecting damage"
	zeroRect := 0@0 corner: 0@0. 
	invalidRects do:
		[:rect | | a |
		((a := (rect intersect: newRect ifNone: [ zeroRect ]) area) > 40
			and: ["Avoid combining a vertical and horizontal rects.
				  Can make a big diff and we only test when likely."
				  a > (newRect area // 4) or: [a > (rect area // 4)]])
			ifTrue:
			["merge rectangle in place (see note below) if there is significant overlap"
			rect setPoint: (rect origin min: newRect origin) truncated
				point: (rect corner max: newRect corner) truncated.
			^ self]].


	invalidRects size >= 50 ifTrue:
		["if there are too many separate areas, merge them all"
		mergeRect := Rectangle merging: invalidRects.
		self reset.
		invalidRects addLast: mergeRect].

	"add the given rectangle to the damage list"
	"Note: We make a deep copy of all rectangles added to the damage list,
		since rectangles in this list may be extended in place."
	newRect hasPositiveExtent ifTrue: [ 
		invalidRects addLast:
			(newRect topLeft truncated corner: newRect bottomRight truncated).
	].! !

!DamageRecorder methodsFor: 'recording' stamp: ''!
doFullRepaint
	"Record that a full redisplay is needed. No further damage rectangles will be recorded until after the next reset."

	^ totalRepaint := true.
! !

!DamageRecorder methodsFor: 'initialization' stamp: 'sma 6/5/2000 11:55'!
reset
	"Clear the damage list."

	invalidRects := OrderedCollection new: 15.
	totalRepaint := false
! !

!DamageRecorder methodsFor: 'testing' stamp: 'dgd 2/22/2003 14:43'!
updateIsNeeded
	"Return true if the display needs to be updated."

	^totalRepaint or: [invalidRects notEmpty]! !

!DamageRecorder methodsFor: 'recording' stamp: 'StephaneDucasse 2/7/2011 22:25'!
invalidRectsFullBounds: aRectangle
	"Return a collection of damaged rectangles for the given canvas. If a total repaint has been requested, return the given rectangle."

	^ totalRepaint
		ifTrue: [ Array with: aRectangle]
		ifFalse: [ invalidRects copy].

! !

!DamageRecorder class methodsFor: 'instance creation' stamp: ''!
new

	^ super new reset
! !

!DangerousClassNotifier commentStamp: 'BenComan 2/18/2014 01:44'!
Some classes have special importance to the core system.  DangerousClassNotifier notifies users which class defiitions should not be modified. 

This class is refactored from the following Pharo2 methods:

* Behaviour>>shouldNotBeRedefined

* ClassBuilder>>tooDangerousClasses

* ClassBuilder>>name:  inEnvironment:  subclassOf:  type:  instanceVariableNames:  classVariableNames:  poolDictionaries:  category:  unsafe: 

Instance Variables
	enabled:		<Boolean>
	restoreState:		<Boolean>

enabled
	- Specifies whether this checking is performed. Some system tests that check "dangerous" behaviour need this turned off. 

restoreState
	- After disabling for testing, need to restore the previous state. 
!
!DangerousClassNotifier class methodsFor: 'accessing' stamp: 'BenComan 2/18/2014 01:19'!
initialize
	enabled := true.! !

!DangerousClassNotifier class methodsFor: 'accessing' stamp: 'BenComan 2/19/2014 01:36'!
enabled
	^enabled ifNil: [  enabled := false ]
! !

!DangerousClassNotifier class methodsFor: 'accessing' stamp: 'BenComan 2/15/2014 22:02'!
shouldNotBeRedefined: classSymbol
	Smalltalk at: classSymbol ifPresent: 
	[ 	:class |
		^(Smalltalk compactClassesArray includes: class) 
			or: [ (Smalltalk specialObjectsArray includes: class) 
				or: [class isKindOf: class] ]	
	].
	^false.
! !

!DangerousClassNotifier class methodsFor: 'accessing' stamp: 'MarcusDenker 3/14/2015 08:39'!
disableDuring: aBlock
	"execute a block with me disabled. Works even nested and restores the old state"
	| oldState |
	oldState := enabled.
	enabled := false.
	aBlock value.
	enabled := oldState.! !

!DangerousClassNotifier class methodsFor: 'accessing' stamp: 'ClementBera 5/27/2014 13:49'!
tooDangerousClasses
	"Return a list of class names which will not be modified in the public interface"
	^#(
		"Object will break immediately"
		#ProtoObject #Object
		"Contexts and their superclasses"
		#InstructionStream #Context #Context #BlockClosure
		"Superclasses of basic collections"
		#Collection #SequenceableCollection #ArrayedCollection
		"Collections known to the VM"
		#Array #Bitmap #String #Symbol #ByteArray #CompiledMethod
		"Basic Numbers and logic"
		#Magnitude #Number #SmallInteger #Float #Boolean #True #False
		"Misc other"
		#LookupKey #Association #Link #Point #Rectangle #Behavior #PositionableStream #UndefinedObject
	)! !

!DangerousClassNotifier class methodsFor: 'accessing' stamp: 'BenComan 2/15/2014 22:01'!
disable
	enabled := false.
	
	! !

!DangerousClassNotifier class methodsFor: 'accessing' stamp: 'BenComan 2/15/2014 22:01'!
enable
	enabled := true.
	
	! !

!DangerousClassNotifier class methodsFor: 'validation' stamp: 'MarcusDenker 3/14/2015 08:42'!
check: classSymbol

	self enabled ifTrue: 
	[ 	
		(self tooDangerousClasses includes: classSymbol)
			ifTrue: [ self error: classSymbol name , ' cannot be changed using the classbuilder. Use the reflective APi (e.g #addClassVariable:). If you know what you are doing, you can use #disableDuring: of DangerousClassNotifier' ].	"Check if the receiver should not be redefined"

		(self shouldNotBeRedefined: classSymbol)		
			ifTrue: [ self notify: classSymbol asText allBold , ' should not be redefined. \Proceed to store over it.' withCRs ].
	].
	^true "Just to keep some tests happy"! !

!DashedBorder commentStamp: 'gvc 5/18/2007 13:28'!
Border style supporting dashed lines of configurable patterns and colours.!
!DashedBorder methodsFor: 'accessing' stamp: 'gvc 8/8/2007 17:21'!
style
	"Answer #dashed."
	
	^#dashed! !

!DashedBorder methodsFor: 'accessing' stamp: 'gvc 4/24/2007 15:48'!
dashColors
	"Answer the value of dashColors"

	^ dashColors! !

!DashedBorder methodsFor: 'initialization' stamp: 'gvc 4/24/2007 15:50'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		dashColors: {Color black. Color white};
		dashLengths: #(1 1)! !

!DashedBorder methodsFor: 'accessing' stamp: 'gvc 4/24/2007 15:48'!
dashLengths
	"Answer the value of dashLengths"

	^ dashLengths! !

!DashedBorder methodsFor: 'accessing' stamp: 'gvc 4/24/2007 15:48'!
dashLengths: anObject
	"Set the value of dashLengths"

	dashLengths := anObject! !

!DashedBorder methodsFor: 'drawing' stamp: 'gvc 4/24/2007 15:51'!
frameRectangle: aRectangle on: aCanvas
	"Frame the given rectangle on aCanvas"
	
	(aRectangle width < self width or: [aRectangle height < self width])
		ifTrue: [^self]." don't do if too small"
	aCanvas
		frameRectangle: aRectangle
		width: self width
		colors: self dashColors
		dashes: self dashLengths! !

!DashedBorder methodsFor: 'accessing' stamp: 'gvc 4/24/2007 15:48'!
dashColors: anObject
	"Set the value of dashColors"

	dashColors := anObject! !

!DashedBorder methodsFor: 'accessing' stamp: 'gvc 4/24/2007 15:59'!
dashColors: cols dashLengths: lens
	"Set the colours and lengths."

	cols size = lens size ifFalse: [self error: 'Colors and Lengths must have the same size'].
	self
		dashColors: cols;
		dashLengths: lens! !

!DashedBorder methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/15/2015 10:44'!
asAthensPaintOn: anAthensCanvas
	^ AthensCompositeStrokePaint new fromDashedBorderStyle: self on: anAthensCanvas! !

!DashedBorder class methodsFor: 'as yet unclassified' stamp: 'gvc 8/8/2007 16:39'!
width: width dashColors: cols dashLengths: lens
	"Answer a new instance of the receiver with the given
	width, colours and lengths."
	
	^self new
		width: width;
		dashColors: cols dashLengths: lens! !

!DataRetriever commentStamp: '<historical>'!
I am a simple object used when a UI blocking query is needed but: 

	- you do not want to block the UI thread
	- you want to cache the result
	- you want to block the access to the data until the end of the query.
	
Even if Imay be reused to retrieve multiple times data, it is safer to dispose me and use a new sibling of me.

In case I am released before Ican fetch the data, a `nullObject` will be returned.!
!DataRetriever methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/9/2013 18:48'!
signalDataIsReady
	"Since mupltiple clients may have tried to access my data (and be trapped in a wait waiting for the end of the query), I need to signal as long as I have a client waiting"
	
	[ semaphore isSignaled ] whileFalse: [ semaphore signal ].
	semaphore consumeAllSignals.! !

!DataRetriever methodsFor: 'initialize' stamp: 'BenjaminVanRyseghem 12/9/2013 18:38'!
initialize

	super initialize.

	block := [].
	
	semaphore := Semaphore new.
	semaphoreIsValid := true.
	nullObject := nil.! !

!DataRetriever methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/9/2013 18:35'!
nullObject: anObject
	nullObject := anObject! !

!DataRetriever methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/9/2013 18:48'!
data
	"If data is nil, it means the query is not yet done. Then the client is frozen until the end of the query (or until I am released).
	Then if it is release, `nullObject` is returned instead of the query result"
	
	data ifNil: [ semaphore wait ].
	semaphoreIsValid ifFalse: [ ^ nullObject ].
	
	^ data! !

!DataRetriever methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/9/2013 18:31'!
retrieveData
	
	fork ifNotNil: [ fork terminate ].
	
	fork := [ 
		data := nil.
		semaphore consumeAllSignals.
		data := block value.
		self signalDataIsReady 
	] forkAt: Processor userBackgroundPriority + 5! !

!DataRetriever methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/9/2013 18:48'!
block: aBlock
	"The query starts as soon as the retrieval block is set"
	
	block := aBlock.
	self retrieveData! !

!DataRetriever methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 12/9/2013 18:48'!
release
	"If I am released while some clients are waiting, I need to free them.
	In the getter, the value of semaphoreIsValid is checked to know if it was a release or the end of the query"

	| oldSemaphoreIsValid |	
	
	oldSemaphoreIsValid := semaphoreIsValid.
	semaphoreIsValid := false.
	self signalDataIsReady.
	semaphoreIsValid := oldSemaphoreIsValid.! !

!DataRetriever class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 12/9/2013 18:37'!
for: aBlock

	^ self new
		block: aBlock;
		yourself! !

!Date commentStamp: '<historical>'!
Instances of Date are Timespans with duration of 1 day.
Their default creation assumes a start of midnight in the local time zone.!
!Date methodsFor: 'printing' stamp: 'StephaneDucasse 12/25/2011 22:50'!
ddmmyyyy
	"Print the receiver  in standard French format dd/mm/yyyy."

	^ self printFormat: #(1 2 3 $/ 1 1)
! !

!Date methodsFor: '*Fuel' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper

	^ aGeneralMapper visitHookPrimitive: self
! !

!Date methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 12/20/2011 22:21'!
yyyymmdd
 	"Format the date in ISO 8601 standard like '2002-10-22'
	The result is of fixed size 10 characters long.."
 
 	^ String new: 10 streamContents: [ :aStream |
		self printOn: aStream format: #(3 2 1 $- 1 1 2) ]! !

!Date methodsFor: 'utils' stamp: 'CamilloBruni 8/22/2013 19:48'!
addMonths: monthCount 
	|year month maxDaysInMonth day |
	year := self year + (monthCount + self monthIndex - 1 // 12).
	month := self monthIndex + monthCount - 1 \\ 12 + 1.
	maxDaysInMonth := Month daysInMonth: month forYear: year.
	day := self dayOfMonth > maxDaysInMonth
				ifTrue: [maxDaysInMonth]
				ifFalse: [self dayOfMonth].
	^ Date year: year month: month day: day! !

!Date methodsFor: 'accessing' stamp: 'brp 1/16/2004 14:30'!
previous: dayName 
	"Answer the previous date whose weekday name is dayName."

	| days |
	days := 7 + self weekdayIndex - (self class dayOfWeek: dayName) \\ 7.
	days = 0 ifTrue: [ days := 7 ].
	^ self subtractDays: days
! !

!Date methodsFor: '*GT-InspectorExtensions-Core' stamp: 'SvenVanCaekenberghe 10/4/2014 19:58'!
gtInspectorPreviewIn: composite
	<gtInspectorPresentationOrder: 30>
	composite morph
		title: 'Calendar';
		morph: [ CalendarMorph on: self ]! !

!Date methodsFor: 'adding' stamp: 'brp 8/23/2003 22:09'!
addDays: dayCount 

	^ (self asDateAndTime + (dayCount days)) asDate! !

!Date methodsFor: 'accessing' stamp: 'sd 3/16/2008 14:43'!
asDate

	^ self! !

!Date methodsFor: 'printing' stamp: 'BP 3/23/2001 12:27'!
printOn: aStream
 
 	self printOn: aStream format: #(1 2 3 $  3 1 )! !

!Date methodsFor: '*Deprecated40' stamp: 'MarcusDenker 2/16/2015 15:21'!
leap
	self deprecated: 'use #isLeapYear' on: '16 February 2015' in: 'Pharo4'.

	^ start isLeapYear! !

!Date methodsFor: 'accessing' stamp: 'brp 8/24/2003 12:04'!
weekday
	"Answer the name of the day of the week on which the receiver falls."

	^ self dayOfWeekName! !

!Date methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 10/26/2012 15:44'!
printOn: aStream format: formatArray 
	"Print a description of the receiver on aStream using the format 
	denoted the argument, formatArray: 
	
		#(item item item sep monthfmt yearfmt twoDigits) 
	
		items: 1=day 2=month 3=year will appear in the order given, 
	
		separated by sep which is eaither an ascii code or character. 
	
		monthFmt: 1=09 2=Sep 3=September 
	
		yearFmt: 1=1996 2=96 
	
		digits: (missing or)1=9 2=09. 
	
	See the examples in printOn: and mmddyy"
	| day month year twoDigits element monthFormat |
	self dayMonthYearDo: [ :d :m :y | day := d. month := m. year := y ].
	twoDigits := formatArray size > 6 and: [ (formatArray at: 7) > 1 ].
	1 to: 3 do:  [ :i | 
		element := formatArray at: i.
		element = 1
			ifTrue: [
				twoDigits
					ifTrue: [ day printOn: aStream base: 10 length: 2 padded: true ]
					ifFalse: [ day printOn: aStream ] ].
		element = 2
			ifTrue: [
				monthFormat := formatArray at: 5.
				monthFormat = 1
					ifTrue: [
						twoDigits
							ifTrue: [ month printOn: aStream base: 10 length: 2 padded: true ]
							ifFalse: [ month printOn: aStream]].
				monthFormat = 2
					ifTrue: [ (Month nameOfMonth: month) from: 1 to: 3 do: [ :each | aStream nextPut: each ] ].
				monthFormat = 3
					ifTrue: [ aStream nextPutAll: (Month nameOfMonth: month) ] ].
		element = 3
			ifTrue: [
				(formatArray at: 6) = 1
					ifTrue: [ year printOn: aStream base: 10 length: 4 padded: true ]
					ifFalse: [ (year \\ 100) printOn: aStream base: 10 length: 2 padded: true ] ].
		i < 3
			ifTrue: [
				(formatArray at: 4) ~= 0
					ifTrue: [ aStream nextPut: (formatArray at: 4) asCharacter ] ] ]! !

!Date methodsFor: 'accessing' stamp: 'avi 2/21/2004 18:12'!
month
	^ self asMonth! !

!Date methodsFor: 'printing' stamp: 'BP 3/23/2001 12:27'!
storeOn: aStream
 
 	aStream print: self printString; nextPutAll: ' asDate'! !

!Date methodsFor: 'adding' stamp: 'brp 8/23/2003 22:05'!
subtractDays: dayCount 

	^ (self asDateAndTime - (dayCount days)) asDate! !

!Date methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 12/20/2011 22:18'!
printFormat: formatArray 
	"Answer a String describing the receiver using the argument formatArray."

	^ String new: 16 streamContents: [ :aStream |
		self printOn: aStream format: formatArray ]! !

!Date methodsFor: 'printing' stamp: 'StephaneDucasse 12/25/2011 22:51'!
mmddyyyy
	"Print the receiver in standard U.S.A format mm/dd/yyyy.
	Note that the name here is slightly misleading -- the month and day numbers don't show leading zeros, 
	so that for example February 1 1996 is 2/1/96"

	^ self printFormat: #(2 1 3 $/ 1 1)! !

!Date methodsFor: 'accessing' stamp: 'brp 8/24/2003 12:04'!
weekdayIndex
	"Sunday=1, ... , Saturday=7"

	^ self dayOfWeek! !

!Date methodsFor: 'utils' stamp: 'spfa 3/8/2004 13:52'!
onNextMonth

	^ self addMonths: 1
! !

!Date methodsFor: '*Fuel' stamp: 'MaxLeske 2/18/2013 22:36'!
serializeOn: anEncoder
	start serializeOn: anEncoder! !

!Date methodsFor: 'accessing' stamp: 'avi 2/29/2004 13:10'!
monthIndex
	^ super month! !

!Date methodsFor: '*GT-InspectorExtensions-Core' stamp: 'SvenVanCaekenberghe 10/4/2014 20:04'!
gtInspectorDetailsIn: composite
	<gtInspectorPresentationOrder: 30>
	^ composite table
		title: [ 'Details' ];
		display: [ 
					{'year' -> self year.
					'month' -> self monthIndex.
					'month name' -> self monthName.
					'day of month' -> self dayOfMonth.
					'day of week' -> self dayOfWeekName.
					'day of year' -> self dayOfYear.
					'iso' -> self yyyymmdd } ];
		column: 'Key' evaluated: #key;
		column: 'Value' evaluated: #value;
		send: #value! !

!Date methodsFor: 'enumerating' stamp: 'brp 7/27/2003 16:10'!
dayMonthYearDo: aBlock 
	"Supply integers for day, month and year to aBlock and return the result"

	^ start dayMonthYearDo: aBlock! !

!Date methodsFor: 'adding' stamp: 'brp 7/27/2003 16:09'!
subtractDate: aDate 
	"Answer the number of days between self and aDate"

	^ (self start - aDate asDateAndTime) days! !

!Date methodsFor: 'utils' stamp: 'spfa 3/8/2004 13:52'!
onPreviousMonth

	^ self addMonths: -1
! !

!Date class methodsFor: 'instance creation' stamp: 'brp 7/27/2003 18:25'!
julianDayNumber: aJulianDayNumber

	^ self starting: (DateAndTime julianDayNumber: aJulianDayNumber)! !

!Date class methodsFor: 'accessing' stamp: 'brp 7/1/2003 13:35'!
dayOfWeek: dayName 

	^ Week indexOfDay: dayName! !

!Date class methodsFor: 'importing' stamp: 'HernanWilkinson 11/7/2013 11:09'!
readFrom: aStream 
	"Read a Date from the stream in any of the forms:  
		<day> <month> <year>		(15 April 1982; 15-APR-82; 15.4.82; 15APR82)  
		<month> <day> <year>		(April 15, 1982; 4/15/82)
		<year>-<month>-<day>			(1982-04-15) (ISO8601)"
	| day month year parsedNumber prefix |
	aStream peek = $-
		ifTrue: [prefix := -1]
		ifFalse: [prefix := 1].
	[aStream peek isAlphaNumeric]
		whileFalse: [aStream skip: 1].
	aStream peek isDigit
		ifTrue: [
			parsedNumber := (Integer readFrom: aStream) * prefix.
			(parsedNumber < 0 or: [parsedNumber > 31])
				ifTrue: [year := parsedNumber]].
	[aStream peek isAlphaNumeric]
		whileFalse: [aStream skip: 1].
	aStream peek isLetter
		ifTrue: ["MM-DD-YY or DD-MM-YY or YY-MM-DD"
			month := (String new: 10) writeStream.
			[aStream peek isLetter]
				whileTrue: [month nextPut: aStream next].
			month := month contents.
			[aStream peek isAlphaNumeric]
				whileFalse: [aStream skip: 1].
			parsedNumber 
				ifNil: ["MM DD YY"
					day := Integer readFrom: aStream]
				ifNotNil: [
					year 
						ifNil: ["DD MM YY"
							day := parsedNumber]]]
		ifFalse: ["MM-DD-YY or DD-MM-YY or YY-MM-DD"
			year 
				ifNil: ["MM-DD-YY or DD-MM-YY"
					parsedNumber > 12
						ifTrue: ["DD-MM-YY"
							Error signal: 'Month out of bounds: ', parsedNumber asString, '.'.
							day := parsedNumber.
							month := Month nameOfMonth: (Integer readFrom: aStream) ]
						ifFalse: ["MM-DD-YY"
							month := Month nameOfMonth: parsedNumber.
							day := Integer readFrom: aStream]]
				ifNotNil: ["YY-MM-DD"
					month := Month nameOfMonth: (Integer readFrom: aStream)]].
	[aStream peek isAlphaNumeric]
		whileFalse: [aStream skip: 1].
	year 
		ifNil: [year := Integer readFrom: aStream]
		ifNotNil: [day := Integer readFrom: aStream].
	(year < 100 and: [year >= 0]) 
		ifTrue: [
			year < 69 
				ifTrue: [year := 2000 + year]
				ifFalse: [year := 1900 + year]].

	^ self
		year: year
		month: month
		day: day
! !

!Date class methodsFor: 'instance creation' stamp: 'sd 3/16/2008 14:57'!
newDay: day month: month year: year 

	^ self year: year month: month day: day! !

!Date class methodsFor: '*Fuel' stamp: 'MaxLeske 2/18/2013 22:36'!
materializeFrom: aDecoder
	^ self 
		starting: (DateAndTime materializeFrom: aDecoder) midnight 
		duration: (Duration days: 1)! !

!Date class methodsFor: 'instance creation' stamp: 'sd 3/16/2008 14:58'!
starting: aDateAndTime

	^ super starting: (aDateAndTime midnight) duration: (Duration days: 1)
! !

!Date class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:16'!
gtExampleToday
	<gtExample: 'Today'>
	^ self today! !

!Date class methodsFor: 'accessing' stamp: 'brp 7/1/2003 13:40'!
nameOfMonth: anIndex 

	^ Month nameOfMonth: anIndex.
! !

!Date class methodsFor: 'instance creation' stamp: 'brp 7/1/2003 18:09'!
tomorrow

	^ self today next! !

!Date class methodsFor: 'instance creation' stamp: 'brp 7/27/2003 16:01'!
newDay: dayCount year: yearInteger

	^ self year: yearInteger day: dayCount! !

!Date class methodsFor: 'instance creation' stamp: 'brp 7/27/2003 22:03'!
year: year day: dayOfYear

	^ self starting: (DateAndTime year: year day: dayOfYear)
! !

!Date class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/17/2012 17:10'!
fromDays: dayCount 
	"Days since 1 January 1901"

	^ self julianDayNumber: SqueakEpoch + dayCount! !

!Date class methodsFor: 'instance creation' stamp: 'brp 7/1/2003 18:09'!
yesterday

	^ self today previous! !

!Date class methodsFor: 'accessing' stamp: 'brp 7/1/2003 13:53'!
daysInYear: yearInteger 

	^ Year daysInYear: yearInteger.! !

!Date class methodsFor: 'instance creation' stamp: 'sd 3/16/2008 14:58'!
year: year month: month day: day

	^ self starting: (DateAndTime year: year month: month day: day)
! !

!Date class methodsFor: 'accessing' stamp: 'CamilloBruni 8/22/2013 19:47'!
firstWeekdayOfMonth: month year: year
	"Answer the weekday index of the first day in <month> in the <year>."

	^ (self year: year month: month day: 1) weekdayIndex
! !

!Date class methodsFor: 'instance creation' stamp: 'sd 3/16/2008 14:57'!
today

	^ self current! !

!Date class methodsFor: 'accessing' stamp: 'brp 7/1/2003 13:59'!
daysInMonth: monthName forYear: yearInteger 

	^ Month daysInMonth: monthName forYear: yearInteger.
! !

!Date class methodsFor: 'accessing' stamp: 'brp 7/1/2003 13:37'!
nameOfDay: dayIndex 

	^ Week nameOfDay: dayIndex ! !

!Date class methodsFor: 'specific inquiries' stamp: 'CamilloBruni 8/22/2013 19:47'!
orthodoxEasterDateFor: year

 "  compute the easter date according to the rules of the orthodox calendar.
    source: 
    http://www.smart.net/~mmontes/ortheast.html 
  "
     | r1 r2 r3 r4 ra rb r5 rc date |

    r1 := year \\ 19.
    r2 := year \\ 4.
    r3 := year \\ 7.
    ra := 19*r1 + 16.
    r4 := ra \\ 30.
    rb := r2 + r2 + (4*r3) + (6*r4).
    r5 := rb \\ 7.
    rc := r4 + r5.
    date := Date year: year month: 4 day: 3.
    ^date addDays: rc.! !

!Date class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/17/2012 17:13'!
julianDayNumber: aJulianDayNumber offset: aTimeZoneOffset

	^ self starting: (DateAndTime julianDayNumber: aJulianDayNumber offset: aTimeZoneOffset)! !

!Date class methodsFor: 'importing' stamp: 'CamilleTeruel 11/29/2013 16:32'!
readFrom: aStringOrStream pattern: pattern
	"See 
	DateParser comment"

	^ (DateParser readingFrom: aStringOrStream readStream pattern: pattern) parse
! !

!Date class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/22/2013 19:32'!
year: year week: week day: dayOfWeek

	^ self starting: (Week year: year week: week) start + (dayOfWeek - 1) days! !

!Date class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/22/2013 19:32'!
week: week day: dayOfWeek

	^ self starting: (Week week: week) start + (dayOfWeek - 1) days! !

!Date class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/13/2012 21:16'!
fromSeconds: seconds
	"Answer an instance of me which is 'seconds' seconds after January 1, 1901."

	^ self starting: (DateAndTime fromSeconds: seconds)! !

!Date class methodsFor: 'importing' stamp: 'TorstenBergmann 8/20/2014 13:19'!
fromString: aString
	"Answer an instance of created from a string with format mm.dd.yyyy or mm-dd-yyyy or mm/dd/yyyy"

	^ self readFrom: aString readStream.! !

!Date class methodsFor: 'accessing' stamp: 'brp 7/1/2003 13:39'!
indexOfMonth: aMonthName 

	^ Month indexOfMonth: aMonthName.
! !

!Date class methodsFor: 'specific inquiries' stamp: 'CamilloBruni 8/22/2013 19:48'!
easterDateFor: year

 "  compute the easter date.
    source: Physikalisch-Technische Bundesanstalt Braunschweig.
    Lichtenberg, H.: Zur Interpretation der Gaussschen Osterformel
                     und ihrer Ausnahmeregeln,
                     Historia Mathematica 24 (1997), pp. 441-444
  
    http://www.ptb.de/de/org/4/44/441/oste.htm
  "

  | k m s a d r og sz oe day |

  k := year // 100.
  m := 15 + (3*k + 3//4) - (8*k + 13//25).
   s := 2 - (3*k + 3// 4).
  a := year \\ 19.
  d := 19*a + m \\ 30.
  r := d//29 + ((d//28) - (d//29)* (a// 11)).

  og := 21 + d - r.
  sz := 7 - (year//4 + year + s\\7).
  oe := 7 - (og - sz\\7).
  day := og + oe.
  ^day <= 31
    ifTrue: [ Date year: year month: 3 day: day ]
    ifFalse: [ Date year: year month: 4 day: day - 31 ].! !

!DateAndTime commentStamp: 'SvenVanCaekenberghe 1/10/2014 11:04'!
I am DateAndTime.
I represent a point in time or timestamp as defined by ISO 8601. 
I am a Magnitude. 
I have nanosecond precision.
I am TimeZone aware. 
I have zero duration.

  DateAndTime now.
  DateAndTime now asUTC rounded.
  DateAndTime fromString: '1969-07-20T20:17:40.123+02:00'.
  DateAndTime fromString: '1969-07-20T20:17:40Z'.

My implementation uses three SmallIntegers and a Duration:
  julianDayNumber - julian day number (starting at midnight UTC rather than noon GMT).
  seconds - number of seconds since midnight UTC. Always positive, between 0 and 86399.
  nanos	 - the number of nanoseconds since the second. Always positive, between 0 and 999999999.
  offset	- duration from UTC.

The offset is used to print the date and time in a local time zone, but the date and time are handled in UTC internally.
The nanosecond attribute is often zero but it defined for full ISO compliance and is suitable for timestamping.
!
!DateAndTime methodsFor: 'converting' stamp: 'CamilloBruni 7/13/2012 17:15'!
asSeconds
 	"Return the number of seconds since the Squeak epoch"
 
 	^ (self - (self class epoch)) asSeconds! !

!DateAndTime methodsFor: 'accessing' stamp: 'sd 3/16/2008 15:04'!
hour

	^ self hour24
! !

!DateAndTime methodsFor: 'accessing' stamp: 'CamilloBruni 7/13/2012 16:44'!
timeZone
	^ TimeZone offset: self offset! !

!DateAndTime methodsFor: 'accessing' stamp: 'sd 3/16/2008 15:02'!
nanoSecond

	^ nanos
! !

!DateAndTime methodsFor: 'enumerating' stamp: 'sd 3/16/2008 15:03'!
to: anEnd by: aDuration do: aBlock
	"Answer a Timespan. anEnd conforms to protocol DateAndTime or protocol Timespan"

	^ (self to: anEnd by: aDuration) scheduleDo: aBlock
! !

!DateAndTime methodsFor: 'converting' stamp: 'nice 4/27/2013 23:41'!
asDuration
	"Answer the duration since midnight."

	^ Duration seconds: self secondsSinceMidnightLocalTime nanoSeconds: nanos
! !

!DateAndTime methodsFor: 'accessing' stamp: 'CamilloBruni 7/12/2012 18:52'!
julianDayNumber
	
	^ julianDayNumber + self julianDayOffset! !

!DateAndTime methodsFor: 'arithmetic' stamp: 'SvenVanCaekenberghe 3/27/2014 22:26'!
< comparand
	"comparand conforms to protocol DateAndTime,
	or can be converted into something that conforms."

	| other |
	other := comparand asDateAndTime.
	^ julianDayNumber = other julianDayNumberUTC
		ifTrue: [ 
			seconds = other secondsSinceMidnightUTC
				ifTrue: [ nanos < other nanoSecond ]
				ifFalse: [ seconds < other secondsSinceMidnightUTC ] ]
		ifFalse: [ julianDayNumber < other julianDayNumberUTC ]! !

!DateAndTime methodsFor: 'converting' stamp: 'CamilloBruni 6/7/2013 23:37'!
asTimeUTC

	^ Time seconds: self secondsSinceMidnightUTC nanoSeconds: nanos! !

!DateAndTime methodsFor: 'enumerating' stamp: 'sd 3/16/2008 15:03'!
to: anEnd by: aDuration
	"Answer a Timespan. anEnd conforms to protocol DateAndTime or protocol Timespan"

	^ (Schedule starting: self ending: (anEnd asDateAndTime))
		schedule: (Array with: aDuration asDuration);
		yourself.
! !

!DateAndTime methodsFor: 'accessing' stamp: 'brp 7/27/2003 15:44'!
daysLeftInYear
 	"Answer the number of days in the year after the date of the receiver."
 
 	^ self daysInYear - self dayOfYear
 ! !

!DateAndTime methodsFor: 'private' stamp: 'nice 4/27/2013 22:19'!
ticks: ticks offset: utcOffset
	"ticks is {julianDayNumber. secondCount. nanoSeconds}"

	self setJdn: (ticks at: 1) seconds: (ticks at: 2) nano: (ticks at: 3) offset: utcOffset! !

!DateAndTime methodsFor: '*Fuel' stamp: 'nice 4/27/2013 22:18'!
fuelSet: julianDay nanoSecond: nanoSeconds seconds: numberOfSeconds offset: anOffset
	self setJdn: julianDay seconds: numberOfSeconds nano: nanoSeconds offset: anOffset! !

!DateAndTime methodsFor: 'converting' stamp: 'NickAger 7/6/2010 11:22'!
asUnixTime
	"answer number of seconds since unix epoch (midnight Jan 1, 1970, UTC)"
	^((self offset: Duration zero) - self class unixEpoch) asSeconds! !

!DateAndTime methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 12/20/2011 22:26'!
printMSOn: aStream
	"Print just mm:ss"
	
	self minute printOn: aStream base: 10 length: 2 padded: true.
	aStream nextPut: $:.
	self second printOn: aStream base: 10 length: 2 padded: true! !

!DateAndTime methodsFor: 'accessing' stamp: 'AndyKellens 4/3/2013 18:09'!
dayOfWeek
	"Sunday=1, ... , Saturday=7"

	^ (self julianDayNumber + 1 rem: 7) + 1! !

!DateAndTime methodsFor: 'accessing' stamp: 'nice 4/27/2013 23:43'!
second
	"Answer a number that represents the number of complete seconds in the receiver's time part, 
	after the number of complete minutes has been removed."
 
 	^ self localSeconds \\ 60! !

!DateAndTime methodsFor: 'accessing' stamp: 'brp 7/1/2003 18:30'!
hours
 
 	^ self hour! !

!DateAndTime methodsFor: 'accessing' stamp: 'sd 3/16/2008 15:05'!
month

	^ self dayMonthYearDo: [ :d :m :y | m ].! !

!DateAndTime methodsFor: 'private' stamp: 'nice 4/27/2013 22:09'!
hasEqualTicks: aDateAndTime
	
	^ (self julianDayNumberUTC = aDateAndTime julianDayNumberUTC)
		and: [ (seconds = aDateAndTime secondsSinceMidnightUTC)
			and: [ nanos = aDateAndTime nanoSecond ] ]

! !

!DateAndTime methodsFor: 'accessing' stamp: 'CamilloBruni 7/13/2012 16:43'!
timeZoneAbbreviation

	^ self timeZone abbreviation
! !

!DateAndTime methodsFor: 'enumerating' stamp: 'sd 3/16/2008 15:03'!
to: anEnd
	"Answer a Timespan. anEnd conforms to protocol DateAndTime or protocol Timespan"

	^ Timespan starting: self ending: (anEnd asDateAndTime).
! !

!DateAndTime methodsFor: 'accessing' stamp: 'brp 5/13/2003 07:48'!
daysInYear
 
 	"Answer the number of days in the year represented by the receiver."
 
 	^ self asYear daysInYear
 ! !

!DateAndTime methodsFor: '*Network-Mail' stamp: 'SeanDeNigris 12/8/2011 15:09'!
asEmailString
	"Format per RFC5322  e.g.  'Thu, 18 Feb 1999 20:38:51 -0500'"

	| timeString |
	timeString := (self asTime print24 first: 8).
	^ '{1}, {2} {3} {4} {5} {6}' format: { 
			self dayOfWeekAbbreviation.
			self dayOfMonth asString.
			self monthAbbreviation.
			self year asString.
			timeString.
			self offset asEmailTimeOffsetString }.! !

!DateAndTime methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setTimestampInMetacelloVersion: aMetacelloVersionSpec

	aMetacelloVersionSpec setTimestamp: 
		(aMetacelloVersionSpec project valueHolderSpec
			value: self printString;
			yourself)! !

!DateAndTime methodsFor: 'converting' stamp: 'CamilloBruni 7/13/2012 19:57'!
asUTC

	^ offset isZero
		ifTrue: [ self ]
		ifFalse: [ self offset: 0 ]
! !

!DateAndTime methodsFor: 'converting' stamp: 'sd 3/16/2008 15:01'!
asYear

	^ Year starting: self! !

!DateAndTime methodsFor: 'accessing' stamp: 'brp 7/27/2003 15:44'!
firstDayOfMonth
 
 	^ self asMonth start day! !

!DateAndTime methodsFor: 'accessing' stamp: 'CamilloBruni 7/17/2012 08:31'!
noon
	"Answer a DateAndTime starting at noon"

	^ self dayMonthYearDo: 
		[ :d :m :y | self class year: y month: m day: d hour: 12 minute: 0 second: 0 offset: offset]! !

!DateAndTime methodsFor: 'accessing' stamp: 'CamilloBruni 7/17/2012 18:27'!
julianDayNumberUTC
	
	^ julianDayNumber! !

!DateAndTime methodsFor: 'accessing' stamp: 'brp 7/1/2003 17:53'!
day
 
 	^ self dayOfYear! !

!DateAndTime methodsFor: 'converting' stamp: 'sd 3/16/2008 15:00'!
asDateAndTime

	^ self
! !

!DateAndTime methodsFor: 'accessing' stamp: 'sd 3/16/2008 15:05'!
hour12
	"Answer an <integer> between 1 and 12, inclusive, representing the hour 
	of the day in the 12-hour clock of the local time of the receiver."
	
	^ self hour24 - 1 \\ 12 + 1! !

!DateAndTime methodsFor: 'enumerating' stamp: 'CamilloBruni 7/13/2012 18:32'!
dayMonthYearDo: aBlock
	"Return the value of executing block with the Gregorian Calender day, month and year as arguments,
	as computed from my Julian Day Number, julianDayNumber.
	See http://en.wikipedia.org/wiki/Julian_date#Gregorian_calendar_from_Julian_day_number
    
    A short Description for the Constants used below:
    - 400 years span 146097 days in gregorian calendar.
    - 100 years span 36524 days, except every 400 years.
    - 4 years span 1461 days, except every 100 years.
    - 1 year spans 365 days, except every four years
    "

	| l n i j monthDay month fullYear |
	l := self julianDayNumber + 68569.
	n := 4 * l // 146097.
	l := l - (146097 * n + 3 // 4).
	i := 4000 * (l + 1) // 1461001.
	l := l - (1461 * i // 4) + 31.
	j := 80 * l // 2447.
	monthDay := l - (2447 * j // 80).
	l := j // 11.
	month := j + 2 - (12 * l).
	fullYear := 100 * (n - 49) + i + l.

	^ aBlock
		value: monthDay
		value: month
		value: fullYear.! !

!DateAndTime methodsFor: 'maintime' stamp: 'sd 3/16/2008 15:02'!
middleOf: aDuration
	"Return a Timespan where the receiver is the middle of the Duration"

	| duration |
	duration := aDuration asDuration.
	^ Timespan starting: (self - (duration / 2)) duration: duration.
		! !

!DateAndTime methodsFor: '*Deprecated40' stamp: 'MarcusDenker 7/18/2014 16:57'!
asTimeStamp
	self deprecated: 'use #asDateAndTime' on: '18 July 2014'  in: 'Pharo4'.
	^ self as: TimeStamp! !

!DateAndTime methodsFor: 'truncation' stamp: 'nice 4/27/2013 22:16'!
rounded
	"Answer a date and time to the nearest whole second"

	^ self species basicNew
		ticks:
			{ julianDayNumber.
			nanos *2 >= NanosInSecond
				ifTrue: [seconds + 1]
				ifFalse: [seconds].
			0 }
		offset: offset! !

!DateAndTime methodsFor: 'private' stamp: 'nice 4/27/2013 23:24'!
secondsSinceMidnightLocalTime
	^ self localSeconds \\ SecondsInDay! !

!DateAndTime methodsFor: 'accessing' stamp: 'brp 1/7/2004 15:45'!
minutes
 
 	^ self minute! !

!DateAndTime methodsFor: 'converting' stamp: 'sd 3/16/2008 15:01'!
asMonth

	^ Month starting: self
! !

!DateAndTime methodsFor: 'accessing' stamp: 'brp 7/1/2003 18:31'!
seconds
 
 	^ self second! !

!DateAndTime methodsFor: 'accessing' stamp: 'CamilloBruni 7/13/2012 18:58'!
julianDayOffset
	"Return the offset in julian days possibly introduced by the timezone offset"
	
	^ ((seconds + self offset asSeconds) / SecondsInDay) floor! !

!DateAndTime methodsFor: 'private' stamp: 'nice 4/28/2013 01:17'!
normalizeSecondsAndNanos
	(NanosInSecond <= nanos or: [ nanos < 0 ])
		ifTrue: [
			seconds := seconds + (nanos // NanosInSecond).
			nanos := nanos \\ NanosInSecond].
	(SecondsInDay <= seconds or: [ seconds < 0 ])
		ifTrue: [
			julianDayNumber := julianDayNumber + (seconds // SecondsInDay).
			seconds := seconds \\ SecondsInDay].
! !

!DateAndTime methodsFor: 'offset' stamp: 'CamilloBruni 6/8/2013 00:10'!
translateTo: anOffset
	"Keep myself's representation and move it to another timezone offset.
	Note that unlike #offset: this WILL change the absolute time in UTC
	
	|t|
	t := DateAndTime now.
	t = (t offset: 2 hours).
	t = (t translateTo: 2 hours).
	" 
	self dayMonthYearDo: [ :day :month :year|
		^ self class
			year: year
			month: month
			day: day
			hour: self hour
			minute: self minute
			second: self second
			nanoSecond: self  nanoSecond
			offset: anOffset asDuration ]! !

!DateAndTime methodsFor: 'accessing' stamp: 'sd 3/16/2008 15:05'!
meridianAbbreviation

	^ self asTime meridianAbbreviation! !

!DateAndTime methodsFor: 'accessing' stamp: 'sd 3/16/2008 15:06'!
offset

	^ offset
! !

!DateAndTime methodsFor: 'converting' stamp: 'SeanDeNigris 5/21/2012 17:34'!
asDosTimestamp

	^ (DosTimestamp fromDateAndTime: self) value.
! !

!DateAndTime methodsFor: '*Fuel' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper

	^ aGeneralMapper visitHookPrimitive: self
! !

!DateAndTime methodsFor: 'accessing' stamp: 'sd 3/16/2008 15:04'!
dayOfMonth
	"Answer which day of the month is represented by the receiver."

	^ self dayMonthYearDo: [ :d :m :y | d ]! !

!DateAndTime methodsFor: 'accessing' stamp: 'sd 3/16/2008 15:05'!
monthAbbreviation

	^ self monthName copyFrom: 1 to: 3
! !

!DateAndTime methodsFor: 'converting' stamp: 'sd 3/16/2008 15:01'!
asWeek

	^ Week starting: self 
! !

!DateAndTime methodsFor: 'arithmetic' stamp: 'SvenVanCaekenberghe 3/27/2014 22:25'!
+ operand
	"operand conforms to protocol Duration"

	| durationTicks |
	durationTicks := operand asDuration ticks.
	^ self class basicNew
		setJdn: julianDayNumber + durationTicks first
			seconds: seconds + durationTicks second
			nano: nanos + durationTicks third
			offset: self offset;
		yourself! !

!DateAndTime methodsFor: 'arithmetic' stamp: 'SvenVanCaekenberghe 3/27/2014 22:26'!
- operand
	"operand conforms to protocol DateAndTime or protocol Duration"

	^ (operand respondsTo: #asDateAndTime)
		ifTrue: [ 
			| other |
			other := operand asDateAndTime.
			Duration
				seconds: (SecondsInDay * (julianDayNumber - other julianDayNumberUTC))
							+ (seconds - other secondsSinceMidnightUTC)
				nanoSeconds: nanos - other nanoSecond ]
		ifFalse: [ self + operand negated ]! !

!DateAndTime methodsFor: 'accessing' stamp: 'sd 3/16/2008 15:05'!
monthName

	^ Month nameOfMonth: self month
! !

!DateAndTime methodsFor: 'accessing' stamp: 'nice 1/5/2010 15:59'!
dayOfYear
	"This code was contributed by Dan Ingalls. It is equivalent to the terser
		^ jdn - (Year year: self year) start julianDayNumber + 1 but much quicker."

	
	^ self dayMonthYearDo:
		[ :d :m :y | | monthStart |
			monthStart := #(1 32 60 91 121 152 182 213 244 274 305 335) at: m.
			(m > 2 and: [ Year isLeapYear: y ])
				ifTrue: [ monthStart + d ]
				ifFalse: [ monthStart + d - 1 ]]! !

!DateAndTime methodsFor: 'accessing' stamp: 'CamilloBruni 7/13/2012 16:43'!
timeZoneName

	^ self timeZone name
! !

!DateAndTime methodsFor: 'converting' stamp: 'sd 3/16/2008 15:00'!
asDate

	^ Date starting: self! !

!DateAndTime methodsFor: 'accessing' stamp: 'sd 3/16/2008 15:04'!
dayOfWeekAbbreviation

	^ self dayOfWeekName copyFrom: 1 to: 3! !

!DateAndTime methodsFor: 'printing' stamp: 'StephaneDucasse 4/24/2010 16:26'!
printOn: aStream
	"Print as per ISO 8601 sections 5.3.3 and 5.4.1.
	Prints either:
		'YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z' (for positive years) or '-YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z' (for negative years)"

	^self printOn: aStream withLeadingSpace: false
! !

!DateAndTime methodsFor: 'accessing' stamp: 'sd 3/16/2008 15:05'!
isLeapYear

	^ Year isLeapYear: self year.
! !

!DateAndTime methodsFor: 'accessing' stamp: 'brp 5/13/2003 07:48'!
daysInMonth
	"Answer the number of days in the month represented by the receiver."


	^ self asMonth daysInMonth! !

!DateAndTime methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 12/20/2011 22:34'!
printYMDOn: aStream withLeadingSpace: printLeadingSpaceToo
	"Print just the year, month, and day on aStream.

	If printLeadingSpaceToo is true, then print as:
		' YYYY-MM-DD' (if the year is positive) or '-YYYY-MM-DD' (if the year is negative)
	otherwise print as:
		'YYYY-MM-DD' or '-YYYY-MM-DD' "

	| year month day |
	self dayMonthYearDo: [ :d :m :y | year := y. month := m. day := d ].
	year negative
		ifTrue: [ aStream nextPut: $- ]
		ifFalse: [ printLeadingSpaceToo ifTrue: [ aStream space ] ].
	year abs printOn: aStream base: 10 length: 4 padded: true.
	aStream nextPut: $-.
	month printOn: aStream base: 10 length: 2 padded: true.
	aStream nextPut: $-.
	day printOn: aStream base: 10 length: 2 padded: true! !

!DateAndTime methodsFor: 'accessing' stamp: 'nice 4/27/2013 23:43'!
hour24
	"Answer a number that represents the number of complete hours in the receiver's time part,
	 after the number of complete days has been removed."
 
 	^ self localSeconds // SecondsInHour \\ 24! !

!DateAndTime methodsFor: 'accessing' stamp: 'nice 4/27/2013 23:44'!
minute
	"Answer a number that represents the number of complete minutes in the receiver' time part, 
	after the number of complete hours has been removed."
	
 	^ self localSeconds // SecondsInMinute \\ 60! !

!DateAndTime methodsFor: 'truncation' stamp: 'nice 4/27/2013 22:13'!
truncated
	"Answer a date and time to the nearest preceding whole second"
	
	^ self species basicNew ticks: { julianDayNumber. seconds. 0 } offset: offset! !

!DateAndTime methodsFor: 'accessing' stamp: 'CamilloBruni 7/13/2012 19:01'!
localSeconds
	" Return the seconds since the epoch in local time."
	^ seconds + self offset asSeconds! !

!DateAndTime methodsFor: 'private' stamp: 'nice 4/27/2013 22:09'!
secondsSinceMidnightUTC

	^ seconds! !

!DateAndTime methodsFor: 'offset' stamp: 'CamilloBruni 11/4/2013 08:21'!
translateToUTC
	" Move this represenation to UTC"
	^ self translateTo: 0 asDuration ! !

!DateAndTime methodsFor: 'private' stamp: 'nice 4/28/2013 01:17'!
setJdn: julDays seconds: secs nano: nanoSecs offset: anOffset
	julianDayNumber := julDays.
	seconds := secs.
	nanos := nanoSecs.
	offset := anOffset.
	self normalizeSecondsAndNanos! !

!DateAndTime methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 11/18/2013 16:18'!
printSeparateDateAndTimeOn: stream
	"Print the receiver as separate Date and Time to stream.
	See also #readSeparateDateAndTimeFrom:"

	stream
		print: self asDate;
		space;
		print: self asTime! !

!DateAndTime methodsFor: 'private' stamp: 'nice 4/27/2013 22:08'!
hash
	^ (julianDayNumber hashMultiply bitXor: seconds) bitXor: nanos! !

!DateAndTime methodsFor: 'converting' stamp: 'nice 4/27/2013 23:41'!
asTime

	^ Time seconds: self secondsSinceMidnightLocalTime nanoSeconds: nanos! !

!DateAndTime methodsFor: 'converting' stamp: 'CamilloBruni 7/13/2012 16:35'!
asLocal
	
	^ (self offset = self class localOffset)
		ifTrue: [self]
		ifFalse: [self offset: self class localOffset]
! !

!DateAndTime methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 12/20/2011 22:54'!
printOn: aStream withLeadingSpace: printLeadingSpaceToo
	"Print as per ISO 8601 sections 5.3.3 and 5.4.1.
	If printLeadingSpaceToo is false, prints either:
		'YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z' (for positive years) or '-YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z' (for negative years)
	If printLeadingSpaceToo is true, prints either:
		' YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z' (for positive years) or '-YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z' (for negative years)
	"

	self printYMDOn: aStream withLeadingSpace: printLeadingSpaceToo.
	aStream nextPut: $T.
	self printHMSOn: aStream.
	nanos ~= 0 
		ifTrue: [ | n len |
			n := nanos. len := 9.
			[ n \\ 10 = 0 ] whileTrue: [ n := n / 10. len := len - 1 ].
			aStream nextPut: $..
			n printOn: aStream base: 10 length: len padded: true ].
	aStream nextPut: (offset positive ifTrue: [ $+ ] ifFalse: [ $- ]).
	offset hours abs printOn: aStream base: 10 length: 2 padded: true.
	aStream nextPut: $:.
	offset minutes abs printOn: aStream base: 10 length: 2 padded: true.
	offset seconds = 0 
		ifFalse:[ 
			aStream nextPut: $:; print: offset seconds abs truncated ]! !

!DateAndTime methodsFor: 'accessing' stamp: 'sd 3/16/2008 15:04'!
dayOfWeekName

	^ Week nameOfDay: self dayOfWeek
! !

!DateAndTime methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setTimestampInMetacelloConfig: aMetacelloConfig
    aMetacelloConfig setTimestampWithString: self printString! !

!DateAndTime methodsFor: '*Fuel' stamp: 'nice 4/27/2013 22:10'!
serializeOn: anEncoder

	anEncoder 
		encodeUint32: self julianDayNumberUTC;
		encodeUint32: self nanoSecond;
		encodeInt24: self secondsSinceMidnightUTC;
		encodeInt24: self offset asSeconds;
		encodeInt32: self offset nanoSeconds.! !

!DateAndTime methodsFor: 'accessing' stamp: 'brp 5/13/2003 07:50'!
monthIndex
 
 
 	^ self month
 ! !

!DateAndTime methodsFor: 'arithmetic' stamp: 'nice 4/27/2013 22:06'!
= other 
	self == other ifTrue: [ ^ true ].
	(self species = other species) ifFalse: [ ^ false ].
	^ self hasEqualTicks: other! !

!DateAndTime methodsFor: '*GT-InspectorExtensions-Core' stamp: 'SvenVanCaekenberghe 10/4/2014 20:19'!
gtInspectorDetailsIn: composite
	<gtInspectorPresentationOrder: 30>
	^ composite table
		title: [ 'Details' ];
		display: [ 
					{'year' -> self year.
					'month' -> self monthIndex.
					'month name' -> self monthName.
					'day of month' -> self dayOfMonth.
					'day of week' -> self dayOfWeekName.
					'day of year' -> self dayOfYear.
					'hours' -> self hours.
					'minutes' -> self minutes.
					'seconds' -> self seconds.
					'nanoseconds' -> self nanoSecond.
					'meridian' -> self meridianAbbreviation.
					'offset' -> self offset.
					'date' -> self asDate.
					'time' -> self asTime.
					'iso' -> self printString.
					'utc' -> self asUTC } ];
		column: 'Key' evaluated: #key;
		column: 'Value' evaluated: #value;
		send: #value! !

!DateAndTime methodsFor: 'accessing' stamp: 'CamilloBruni 6/8/2013 00:10'!
offset: anOffset
	"Answer a <DateAndTime> equivalent to the receiver but with its local time 
	being offset from UTC by offset.
	Unlike #translateTo: this will NOT change the absolute in UTC "

	^ self class basicNew 
		ticks: self ticks offset: anOffset asDuration;
		yourself
		! !

!DateAndTime methodsFor: 'converting' stamp: 'sd 3/16/2008 15:01'!
asNanoSeconds
	"Answer the number of nanoseconds since midnight"

	^ self asDuration asNanoSeconds
! !

!DateAndTime methodsFor: 'accessing' stamp: 'sd 3/16/2008 15:06'!
year
	^ self dayMonthYearDo: [:d :m :y | y ]! !

!DateAndTime methodsFor: 'maintime' stamp: 'CamilloBruni 11/4/2013 08:14'!
midnight
	"Answer a DateAndTime starting at midnight (towards the end of the day) local time"
	self dayMonthYearDo: [ :day :month :year|
		^self class 
			year: year
			month: month
			day: day 
			offset: offset ].! !

!DateAndTime methodsFor: 'private' stamp: 'CamilloBruni 3/30/2032 18:26'!
ticks
	"Private - answer an array with our instance variables. Assumed to be UTC "

	^ Array with: julianDayNumber with: seconds with: nanos.! !

!DateAndTime methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 12/20/2011 22:30'!
printYMDOn: aStream
	"Print just YYYY-MM-DD part.
	If the year is negative, prints out '-YYYY-MM-DD'."

	^ self printYMDOn: aStream withLeadingSpace: false.
! !

!DateAndTime methodsFor: 'accessing' stamp: 'sd 3/16/2008 15:01'!
duration

	^ Duration zero! !

!DateAndTime methodsFor: 'offset' stamp: 'CamilloBruni 7/13/2012 16:37'!
withoutOffset

	^ self offset: 0 ! !

!DateAndTime methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 12/20/2011 22:26'!
printHMSOn: aStream
	"Print just hh:mm:ss"
	
	self hour printOn: aStream base: 10 length: 2 padded: true.
	aStream nextPut: $:.
	self minute printOn: aStream base: 10 length: 2 padded: true.
	aStream nextPut: $:.
	self second printOn: aStream base: 10 length: 2 padded: true! !

!DateAndTime class methodsFor: 'instance creation' stamp: 'CamilleTeruel 11/29/2013 16:53'!
year: year month: month day: day hour: hour minute: minute second: second nanoSecond: nanoCount offset: utcOffset
	"Return a DateAndTime with the values in the given TimeZone (UTCOffset)"

	| monthIndex daysInMonth p q r s julianDayNumber localSeconds utcSeconds|

	monthIndex := month isInteger ifTrue: [ month ] ifFalse: [ Month indexOfMonth: month ].
	(monthIndex between: 1 and: 12) ifFalse: [ DateError signal: 'There is no ', monthIndex printString, 'th month' ].
	daysInMonth := Month
		daysInMonth: monthIndex
		forYear: year.
	day < 1 ifTrue: [ DateError signal: 'day may not be zero or negative' ].
	day > daysInMonth ifTrue: [ DateError signal: 'day is after month ends' ].

	p := (monthIndex - 14) quo: 12.
	q := year + 4800 + p.
	r := monthIndex - 2 - (12 * p).
	s := (year + 4900 + p) quo: 100.

	julianDayNumber :=
		((1461 * q) quo: 4) +
			((367 * r) quo: 12) -
			((3 * s) quo: 4) +
			(day - 32075).
			
	localSeconds :=  hour * 60 + minute * 60 + second.
	utcSeconds := localSeconds - utcOffset asSeconds.
	
	^self basicNew
		setJdn: julianDayNumber
		seconds: utcSeconds
		nano: nanoCount
		offset: utcOffset;
		yourself! !

!DateAndTime class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/17/2012 17:08'!
julianDayNumber: aJulianDayNumber

	^ self basicNew
		ticks: aJulianDayNumber days ticks offset: Duration new;
		yourself! !

!DateAndTime class methodsFor: 'time zones' stamp: 'brp 9/4/2003 06:39'!
localTimeZone
	"Answer the local time zone"

	^ LocalTimeZone ifNil: [ LocalTimeZone := TimeZone default ]

! !

!DateAndTime class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/17/2012 17:02'!
fromUnixTime: anInteger
	^ self fromSeconds: anInteger + 2177452800 "unix epoch constant"! !

!DateAndTime class methodsFor: 'input' stamp: 'SvenVanCaekenberghe 2/19/2014 19:37'!
readFrom: aStream
	"Parse and return a new DateAndTime instance from stream, 
	as a Date, an optional Time and an optional TimeZone offset.
	The time defaults to midnight, the timezone to the local offset"
	"self readFrom: '2013-03-04T23:47:52.876+01:00' readStream"

	| date time offset |
	date := Date readFrom: aStream.
	[ aStream atEnd or: [ '0123456789Z+-' includes: aStream peek ] ] 
		whileFalse: [ aStream next ].
  	('0123456789' includes: aStream peek)
		ifTrue: [ time := Time readFrom: aStream ]
		ifFalse: [ time := Time midnight ].
	aStream skipSeparators.
	offset := self readTimezoneOffsetFrom: aStream.
	^ self
		year: date year
		month: date monthIndex
		day: date dayOfMonth
		hour: time hour
		minute: time minute
		second: time second
		nanoSecond: time nanoSecond
		offset: offset! !

!DateAndTime class methodsFor: 'primitives' stamp: 'kph 12/11/2006 21:13'!
millisecondClockValue

	^ self clock millisecondClockValue! !

!DateAndTime class methodsFor: 'system queries' stamp: 'gk 8/31/2006 00:49'!
clockPrecision
	"One nanosecond precision"

	^ Duration seconds: 0 nanoSeconds: 1
! !

!DateAndTime class methodsFor: 'clock provider' stamp: 'kph 12/11/2006 20:14'!
clock 
	 "the provider of real time seconds/milliseconds."

	^ ClockProvider ! !

!DateAndTime class methodsFor: 'input' stamp: 'SvenVanCaekenberghe 3/6/2013 16:34'!
readTwoDigitIntegerFrom: stream
	"Parse and return a decimal number of 2 digits from stream.
	Fail if that is not possible"

	| integer |
	integer := 0.
	2 timesRepeat: [ | char |
		char := stream next.
		('0123456789' includes: char) ifFalse: [ self error: 'Decimal digit expected' ].
		integer := (integer * 10) + char digitValue ].
	^ integer! !

!DateAndTime class methodsFor: 'instance creation' stamp: 'SeanDeNigris 11/29/2013 14:30'!
date: aDate time: aTime

	^ self 
		year: aDate year
		month: aDate monthName
		day: aDate dayOfMonth 
		hour: aTime hour 
		minute: aTime minute 
		second: aTime second
		nanoSecond: aTime nanoSecond
		offset: self localOffset.! !

!DateAndTime class methodsFor: 'time zones' stamp: 'nk 3/30/2004 09:53'!
localTimeZone: aTimeZone
	"Set the local time zone"

	"
	DateAndTime localTimeZone: (TimeZone offset:  0 hours name: 'Universal Time' abbreviation: 'UTC').
	DateAndTime localTimeZone: (TimeZone offset: -8 hours name: 'Pacific Standard Time' abbreviation: 'PST').
	"

	LocalTimeZone := aTimeZone


! !

!DateAndTime class methodsFor: 'input' stamp: 'StephaneDucasse 4/24/2010 11:46'!
fuzzyReadFrom: aStream
	| bc year month day hour minute second nanos offset buffer ch |


	aStream peek = $- ifTrue: [ aStream next. bc := -1] ifFalse: [bc := 1].
	year := (aStream upTo: $-) asInteger * bc.
	month := (aStream upTo: $-) asInteger ifNil: [1].
	day := (aStream upTo: $T) asInteger ifNil: [1].
	hour := (aStream upTo: $:) asInteger ifNil: [0].
 	buffer := '00:' copy. ch := nil.
	minute := buffer writeStream.
	[ aStream atEnd | (ch = $:) | (ch = $+) | (ch = $-) ]
		whileFalse: [ ch := minute nextPut: aStream next. ].
	(ch isNil or: [ch isDigit]) ifTrue: [ ch := $: ].
	minute := (buffer readStream upTo: ch) asInteger.
	buffer := '00.' copy.
	second := buffer writeStream.
	[ aStream atEnd | (ch = $.) | (ch = $+) | (ch = $-) ]
		whileFalse: [ ch := second nextPut: aStream next. ].
	(ch isNil or: [ch isDigit]) ifTrue: [ ch := $. ].
	second := (buffer readStream upTo: ch) asInteger.
	buffer := '000000000' copy.
	(ch = $.) ifTrue: [ 
		nanos := buffer writeStream.
		[ aStream atEnd | ((ch := aStream next) = $+) | (ch = $-) ]
			whileFalse: [ nanos nextPut: ch. ].
		(ch isNil or: [ch isDigit]) ifTrue: [ ch := $+ ].
	].

	nanos := buffer asInteger.
	aStream atEnd
		ifTrue: [ offset := Duration zero ]
		ifFalse: [ch := aStream next.
                       ch = $+ ifTrue: [ch := Character space].
                       offset := Duration fromString: ch asString, '0:', aStream upToEnd, ':0'].
	^ self
		year: year
		month: month
		day: day
		hour: hour
		minute: minute

		second: second
		nanoSecond:  nanos

		offset: offset.
! !

!DateAndTime class methodsFor: 'instance creation' stamp: 'sd 3/16/2008 15:00'!
year: year month: month day: day hour: hour minute: minute second: second offset: offset

	^ self
		year: year
		month: month
		day: day
		hour: hour
		minute: minute
		second: second
		nanoSecond: 0
		offset: offset
! !

!DateAndTime class methodsFor: 'system queries' stamp: 'sd 3/16/2008 15:07'!
localOffset
	"Answer the duration we are offset from UTC"

	^ self localTimeZone offset
! !

!DateAndTime class methodsFor: 'instance creation queries' stamp: 'GabrielBarbuto 9/27/2010 10:10'!
dosEpoch
	"Answer a DateAndTime representing the DOS epoch (1 January 1980, midnight UTC)"

	^ self basicNew
		ticks: #(2444240 0 0) offset: Duration zero;
		yourself.! !

!DateAndTime class methodsFor: '*Fuel' stamp: 'MaxLeske 2/18/2013 22:36'!
materializeFrom: aDecoder

	^ self basicNew
		fuelSet: aDecoder nextEncodedUint32
		nanoSecond: aDecoder nextEncodedUint32
		seconds: aDecoder nextEncodedInt24
		offset: (Duration 
			seconds: aDecoder nextEncodedInt24 
			nanoSeconds: aDecoder nextEncodedInt32);
		yourself.! !

!DateAndTime class methodsFor: 'instance creation' stamp: 'sd 3/16/2008 14:59'!
year: year day: dayOfYear hour: hour minute: minute second: second offset: offset 
	"Return a DataAndTime"

	| y d |
	y := self
		year: year
		month: 1
		day: 1
		hour: hour
		minute: minute
		second: second
		nanoSecond: 0
		offset: offset.
	d := Duration days: (dayOfYear - 1).
	^ y + d! !

!DateAndTime class methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/3/2013 15:24'!
initialize
	ClockProvider := Time! !

!DateAndTime class methodsFor: 'input' stamp: 'SvenVanCaekenberghe 3/6/2013 16:33'!
readTimezoneOffsetFrom: stream
	"Read and return an optional timezone offset in the form of 
	[+|-]hh[[separator]mm[[separator]ss]] or Z from stream as a duration.
	If there is no offset, return the local offset."

	| sign hour minute second |
	(stream peekFor: $Z) ifTrue: [ ^ Duration zero ].
	hour := minute := second := 0.
	^ ('+-' includes: stream peek)
		ifTrue: [
			sign := stream next = $- ifTrue: [ -1 ] ifFalse: [ 1 ].
			hour := self readTwoDigitIntegerFrom: stream.
			(self readOptionalSeparatorFrom: stream)
				ifNotNil: [ 
					minute := self readTwoDigitIntegerFrom: stream.
					(self readOptionalSeparatorFrom: stream)
						ifNotNil: [ 
							second := Integer readFrom: stream ] ].
			Duration seconds: sign * ((hour * 3600) + (minute * 60) + second) ]
		ifFalse: [ self localOffset ]! !

!DateAndTime class methodsFor: 'instance creation queries' stamp: 'sd 3/16/2008 15:08'!
tomorrow

	^ self today asDate next asDateAndTime! !

!DateAndTime class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 5/3/2013 15:38'!
now 
	"Answer the current date and time expressed in local time.
	[ 10000 timesRepeat: [ self now. ] ] timeToRun / 10000.0 . "

	| nanoTicks |
	nanoTicks := self clock microsecondClockValue * 1e3.
	^ self basicNew
		setJdn: SqueakEpoch 
		seconds: 0
		nano: nanoTicks
		offset: self localOffset! !

!DateAndTime class methodsFor: 'instance creation' stamp: 'sd 3/16/2008 15:08'!
year: year day: dayOfYear
	"Return a DateAndTime"

	^ self
		year: year
		day: dayOfYear
		hour: 0
		minute: 0
		second: 0! !

!DateAndTime class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 12/22/2013 16:29'!
fromMethodTimeStamp: aString
	| stream |
	stream := aString readStream.
	stream
		skipSeparators;
		skipTo: Character space.
	^ self readSeparateDateAndTimeFrom: stream! !

!DateAndTime class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/13/2012 20:42'!
year: year month: month day: day offset: anOffset
	"Return a DateAndTime, midnight in the timezone with the given offset"
	^ self
		year: year
		month: month
		day: day
		hour: 0
		minute: 0
		offset: anOffset ! !

!DateAndTime class methodsFor: 'instance creation queries' stamp: 'sd 3/16/2008 15:09'!
yesterday

	^ self today asDate previous asDateAndTime
! !

!DateAndTime class methodsFor: 'instance creation queries' stamp: 'MarcusDenker 7/1/2010 14:30'!
unixEpoch
	"Answer a DateAndTime representing the Unix epoch (1 January 1970, midnight UTC)"
	^ self basicNew
		ticks: #(2440588 0 0) offset: Duration zero;
		yourself.! !

!DateAndTime class methodsFor: 'instance creation' stamp: 'HenrikSperreJohansen 10/15/2009 14:44'!
year: year month: month day: day
	"Return a DateAndTime, midnight local time"
	^ self
		year: year
		month: month
		day: day
		hour: 0
		minute: 0! !

!DateAndTime class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:17'!
gtExampleNow
	<gtExample: 'Now'>
	^ self now! !

!DateAndTime class methodsFor: 'instance creation' stamp: 'HenrikSperreJohansen 10/15/2009 14:44'!
year: year month: month day: day hour: hour minute: minute
	"Return a DateAndTime" 
	
	^ self
 		year: year
 		month: month
 		day: day
 		hour: hour
		minute: minute
		second: 0! !

!DateAndTime class methodsFor: 'instance creation queries' stamp: 'sd 3/16/2008 15:08'!
today

	^ self midnight
! !

!DateAndTime class methodsFor: 'instance creation queries' stamp: 'CamilloBruni 7/17/2012 17:04'!
epoch
  "Answer a DateAndTime representing the Squeak epoch: 1 January 1901"

  ^ (self julianDayNumber: SqueakEpoch) offset: 0.
  ! !

!DateAndTime class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/13/2012 20:43'!
year: year month: month day: day hour: hour minute: minute offset: anOffset
	"Return a DateAndTime" 
	
	^ self
 		year: year
 		month: month
 		day: day
 		hour: hour
		minute: minute
		second: 0
		offset: anOffset! !

!DateAndTime class methodsFor: 'instance creation' stamp: 'sd 3/16/2008 14:59'!
year: year month: month day: day hour: hour minute: minute second: second
	"Return a DateAndTime"

	^ self
		year: year
		month: month
		day: day
		hour: hour
		minute: minute
		second: second
		offset: self localOffset
! !

!DateAndTime class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/17/2012 17:16'!
julianDayNumber: aJulianDayNumber offset: aTimeZoneOffset
	"Return a DateAndTime at midnight local time at the given julian day"
	| ticks |
	"create a ticks representation in UTC, take the given julian day in local time"
	ticks := aJulianDayNumber days ticks.
	ticks at: 2 put: aTimeZoneOffset asSeconds negated.

	^ self basicNew
		ticks: ticks offset: aTimeZoneOffset;
		yourself! !

!DateAndTime class methodsFor: '*Spec-Inspector' stamp: 'SvenVanCaekenberghe 12/21/2013 21:31'!
inspectorClass
	^ EyeDateAndTimeInspector! !

!DateAndTime class methodsFor: 'instance creation queries' stamp: 'sd 3/16/2008 15:08'!
noon

	^ self now noon! !

!DateAndTime class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/16/2012 19:24'!
new
	"Answer a DateAndTime representing the Squeak epoch: 1 January 1901"

	^ self epoch offset: self localOffset 
	! !

!DateAndTime class methodsFor: 'instance creation' stamp: 'sd 3/16/2008 14:59'!
year: year day: dayOfYear hour: hour minute: minute second: second

	^ self
		year: year
		day: dayOfYear
		hour: hour
		minute: minute
		second: second
		offset: self localOffset.
! !

!DateAndTime class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/17/2012 16:59'!
fromSeconds: secondsSinceEpochUTC
	"Answer a DateAndTime since the Squeak epoch: 1 January 1901 for the seconds in UTC time"
	^ self fromSeconds: secondsSinceEpochUTC offset: self localOffset! !

!DateAndTime class methodsFor: 'instance creation queries' stamp: 'sd 3/16/2008 15:07'!
midnight

	^ self now midnight
! !

!DateAndTime class methodsFor: 'system queries' stamp: 'SvenVanCaekenberghe 5/3/2013 15:39'!
totalSeconds
	"Answer the total seconds ellapsed since the Squeak epoch: 1 January 1901"

	^ self clock totalSeconds! !

!DateAndTime class methodsFor: 'input' stamp: 'SvenVanCaekenberghe 11/18/2013 16:19'!
readSeparateDateAndTimeFrom: stream
	"Read a separate Date and Time from stream to instanciate the receiver.
	See also #printSeparateDateAndTimeOn:"
	
	| date time |
	stream skipSeparators.
	date := Date readFrom: stream.
	stream skipSeparators.
	time := Time readFrom: stream.
	^ self 
		date: date
		time: time! !

!DateAndTime class methodsFor: 'input' stamp: 'damiencassou 5/30/2008 10:56'!
fromString: aString 
	^ self readFrom: aString readStream! !

!DateAndTime class methodsFor: 'instance creation' stamp: 'SeanDeNigris 5/21/2012 17:00'!
fromDosTimestamp: anInteger

	^ (DosTimestamp on: anInteger) asDateAndTime.! !

!DateAndTime class methodsFor: 'instance creation queries' stamp: 'sd 3/16/2008 15:07'!
current

	^ self now
! !

!DateAndTime class methodsFor: 'instance creation' stamp: 'MarcusDenker 7/23/2014 22:36'!
fromSeconds: utcSecondsSinceEpoch offset: aUTCOffset
	"Answer a DateAndTime since the Squeak epoch: 1 January 1901 for the given timeZone"

	| integerSeconds nanos |
	integerSeconds := utcSecondsSinceEpoch truncated.
	nanos := integerSeconds = utcSecondsSinceEpoch
		ifTrue: [ 0 ]
		ifFalse: [ ((utcSecondsSinceEpoch - integerSeconds) * NanosInSecond) asInteger ].
	^ self basicNew ticks: {SqueakEpoch . integerSeconds . nanos} offset: aUTCOffset asDuration! !

!DateAndTime class methodsFor: 'input' stamp: 'SvenVanCaekenberghe 3/6/2013 16:22'!
readOptionalSeparatorFrom: stream
	"Read an optional separator (non decimal digit) from stream and return it.
	Return nil if nothing was read"

	^ (stream atEnd or: [ '0123456789' includes: stream peek])
		ifTrue: [ nil ]
		ifFalse: [ stream next ]! !

!DateAndTimeDosEpochTest commentStamp: 'TorstenBergmann 2/5/2014 08:32'!
SUnit test for dos epoch (see DateAndTime)!
!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testAsUTC
	self assert: aDateAndTime asUTC =  aDateAndTime
          ! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:35'!
testMiddleOf
	self assert: (aDateAndTime middleOf: '2:00:00:00' asDuration) = 
	 (Timespan starting: '12-31-1979' asDate duration: 2 days).
	
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:34'!
testHash
	self assert: aDateAndTime hash = (DateAndTime year: 1980 month: 1 day: 1) hash! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testMinute
	self assert: aDateAndTime minute =  0

! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testToByDo
	"self assert: (aDateAndTime to: aDateAndTime + 10 days by: 5 days do: []) =  "
	"MessageNotUnderstood: UndefinedObject>>starting:ending:  where UndefinedObject is Timespan "! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testDaysInMonth
	self assert: aDateAndTime daysInMonth  = 31.

! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:33'!
testDateTime
	self assert: aDateAndTime =  (DateAndTime date: '01-01-1980' asDate time: '00:00:00' asTime)
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:34'!
testFromSeconds
	self assert: aDateAndTime =  (DateAndTime fromSeconds: 2492985600).
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testAsDateAndTime
	self assert: aDateAndTime asDateAndTime =  aDateAndTime
	
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:32'!
testAsSeconds
	self assert: aDateAndTime asSeconds = 2492985600
	
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testDay
	self assert: aDateAndTime day =   DateAndTime new day
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:33'!
testAsYear
	self assert: aDateAndTime asYear =   (Year starting: '01-01-1980' asDate). 
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:38'!
testYearDay
	self assert: aDateAndTime =  (DateAndTime year: 1980 day: 1).
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testToday
	self deny: aDateAndTime =  (DateAndTime today).
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testSeconds
	self assert: aDateAndTime seconds =  0

! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:33'!
testDayMonthYearDo
	|iterations|
	iterations := 0.
	self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear |  iterations := iterations + 1])  = 1.
	self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear |  eachYear])  = 1980.
	self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear |  eachMonth]) = 1.
	self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear |  eachDay]) = 1.
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testCurrent
	self deny: aDateAndTime =  (DateAndTime current).
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:32'!
testAsWeek
	self assert: aDateAndTime asWeek = (Week starting: '12-31-1979' asDate). 

! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testMonth
	self assert: aDateAndTime month  = 1.
	self assert: aDateAndTime monthAbbreviation = 'Jan'.
	self assert: aDateAndTime monthName = 'January'.
	self assert: aDateAndTime monthIndex = 1.! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:37'!
testTo
	self assert: (aDateAndTime to: aDateAndTime) = ((DateAndTime year: 1980 month: 1 day: 1) to: (DateAndTime year: 1980 month: 1 day: 1)) 
	"MessageNotUnderstood: UndefinedObject>>starting:ending:  where UndefinedObject is Timespan "! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:36'!
testPrintOn
	| cs rw |
	cs := '1980-01-01T00:00:00+00:00' readStream.
	rw := ReadWriteStream on: ''.
	aDateAndTime printOn: rw.
	self assert: rw contents = cs contents.
	cs := 'a TimeZone(DTZ)' readStream.
	rw := ReadWriteStream on: ''.
	aTimeZone printOn: rw.
	self assert: rw contents = cs contents! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testDayOfYear
	self assert: aDateAndTime dayOfYear  = 1.

! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testNanoSecond
	self assert: aDateAndTime nanoSecond =  0

! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:36'!
testPlus
	self assert: aDateAndTime + '0:00:00:00' = aDateAndTime.
	self assert: aDateAndTime + 0 = aDateAndTime.
	self assert: aDateAndTime + aDuration = (DateAndTime year: 1980 month: 1 day: 2 hour: 2 minute: 3 second: 4 nanoSecond: 5 offset: 0 hours )
	" I believe this is a bug in the nanosecond part of (DateAndTime >> year:month:day:hour:minute:second:nanoSecond:offset:)"
	
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:37'!
testYear
	self assert: aDateAndTime year = 1980.

	! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:38'!
testYearMonthDayHourMinuteSecond
	self assert: aDateAndTime =  (DateAndTime year: 1980 month: 1 day: 1 hour: 0 minute: 0 second: 0).
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testTommorrow
	self assert: (DateAndTime today + 24 hours) =  (DateAndTime tomorrow).
	self deny: aDateAndTime =  (DateAndTime tomorrow).
     "MessageNotUnderstood: Date class>>starting:"! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testHour12
	self assert: aDateAndTime hour12  = DateAndTime new hour12.
	self assert: aDateAndTime hour12  = 12
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:37'!
testToBy
	self assert: (aDateAndTime to: aDateAndTime + 10 days by: 5 days) = 
				((DateAndTime year: 1980 month: 1 day: 1) to:
				 (DateAndTime year: 1980 month: 1 day: 1) + 10 days by: 5 days ) 
	"MessageNotUnderstood: UndefinedObject>>starting:ending:  where UndefinedObject is Timespan "! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testMinutes
	self assert: aDateAndTime minutes = 0
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testMeridianAbbreviation
	self assert: aDateAndTime meridianAbbreviation = 'AM'.

	! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:36'!
testMinus
	self assert: aDateAndTime - aDateAndTime =  '0:00:00:00' asDuration.
	self assert: aDateAndTime - '0:00:00:00' asDuration = aDateAndTime.
	self assert: aDateAndTime - aDuration =  (DateAndTime year: 1979 month: 12 day: 30 hour: 21 minute: 56 second: 55 nanoSecond: 999999995 offset: 0 hours ).
	" I believe this Failure is a bug in the nanosecond part of (DateAndTime >> year:month:day:hour:minute:second:nanoSecond:offset:)" ! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 19:15'!
testUtcOffset
     self assert: (aDateAndTime offset: '0:12:00:00')  equals: '1980-01-01T12:00:00+12:00' asDateAndTime! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:38'!
testTicks
	self assert: aDateAndTime ticks =  (DateAndTime julianDayNumber: 2444240) ticks.
	self assert: aDateAndTime ticks = #(2444240 0 0)! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testFirstDayOfMonth
	self assert: aDateAndTime firstDayOfMonth =   1
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testHour
	self assert: aDateAndTime hour =    aDateAndTime hour24.
	self assert: aDateAndTime hour =    0.
	self assert: aDateAndTime hour =    aDateAndTime hours
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testDuration
	self assert: aDateAndTime duration  = 0 asDuration.

! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testSecond
	self assert: aDateAndTime second =  0

! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testAsNanoSeconds
	self assert: aDateAndTime asNanoSeconds =  0 asDuration asNanoSeconds
	
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testMidnight
	self assert: aDateAndTime midnight =  aDateAndTime
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testAsDate
	self assert: aDateAndTime asDate =   'January 1, 1980' asDate.

! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:33'!
testDaysInYear
	self assert: aDateAndTime daysInYear  = 366.

! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:35'!
testIsLeapYear
	self assert: aDateAndTime isLeapYear
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:35'!
testJulianDayNumber
	self assert: aDateAndTime =  (DateAndTime julianDayNumber: 2444240).
	self assert: aDateAndTime julianDayNumber = 2444240.! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:37'!
testTicksOffset
	self assert: aDateAndTime =  (aDateAndTime ticks:  #(2444240 0 0) offset: DateAndTime localOffset).
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 19:19'!
testOffset

	self assert: aDateAndTime offset =  '0:00:00:00' asDuration.
	self assert: (aDateAndTime offset: '-0:12:00:00') equals:  '1979-12-31T12:00:00-12:00' asDateAndTime.
	self assert: (aDateAndTime offset: '0:12:00:00') equals:  '1980-01-01T12:00:00+12:00' asDateAndTime! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testYesterday
	self deny: aDateAndTime =  (DateAndTime yesterday).
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 16:53'!
testTimeZone
	self assert: aDateAndTime timeZoneName	= 'Universal Time'.
	self assert: aDateAndTime timeZoneAbbreviation	=  'UTC'

! !

!DateAndTimeDosEpochTest methodsFor: 'running' stamp: 'CamilloBruni 7/13/2012 19:12'!
tearDown
     "wish I could remove the time zones I added earlier, but there is no method for that"

     DateAndTime localTimeZone: localTimeZoneToRestore.
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:38'!
testYearMonthDayHourMinuteSecondNanosSecondOffset
	self assert: aDateAndTime =  (DateAndTime year: 1980 month: 1 day: 1 hour: 0 minute: 0 second: 0 nanoSecond: 0 offset:0 hours ).
	self assert: ((DateAndTime year: 1 month: 1 day: 1 hour: 0 minute: 0 second: 0 nanoSecond: 0 offset: 0 hours ) +
				(Duration days: 1 hours: 2 minutes: 3 seconds: 4  nanoSeconds: 5) ) =  	
				(DateAndTime year: 1 month: 1 day: 2 hour: 2 minute: 3 second: 4 nanoSecond: 5 offset: 0 hours ) 
	" I believe this is a bug in the nanosecond part of (DateAndTime >> year:month:day:hour:minute:second:nanoSecond:offset:)"" I believe this is a bug in the nanosecond part of (DateAndTime >> year:month:day:hour:minute:second:nanoSecond:offset:)"   
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'CamilloBruni 8/22/2013 19:44'!
testAsMonth
	self
		assert: aDateAndTime asMonth 
		equals: (Month year: 1980 month: 'January'). 
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:33'!
testDayOfWeek
	self assert: aDateAndTime dayOfWeek  = 3.
	self assert: aDateAndTime dayOfWeekAbbreviation = 'Tue'.
	self assert: aDateAndTime dayOfWeekName = 'Tuesday'.
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testAsDuration
	self assert: aDateAndTime asDuration =  0 asDuration
	
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 16:36'!
testAsLocal
	self assert: aDateAndTime asLocal =  aDateAndTime.
	self assert: aDateAndTime asLocal = (aDateAndTime offset: aDateAndTime class localOffset)
	
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testAsTime
	self assert: aDateAndTime asTime =  Time midnight.
! !

!DateAndTimeDosEpochTest methodsFor: 'running' stamp: 'CamilloBruni 7/13/2012 19:11'!
setUp
	localTimeZoneToRestore := DateAndTime localTimeZone.
	aDateAndTime :=  DateAndTime localTimeZone: TimeZone default; dosEpoch.
	aTimeZone := TimeZone offset: (Duration minutes: 135) name: 'DOS Epoch Test Time Zone' abbreviation: 'DTZ'.
	aDuration := Duration days: 1 hours: 2 minutes: 3 seconds: 4 nanoSeconds: 5 ! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testDayOfMonth
	self assert: aDateAndTime dayOfMonth  = 1.
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:34'!
testFromString
	self assert: aDateAndTime =  (DateAndTime fromString: ' 1980-01-01T00:00:00+00:00').
	self assert: aDateAndTime =  (DateAndTime fromString: ' 1980-01-01T00:00:00').
	self assert: aDateAndTime =  (DateAndTime fromString: ' 1980-01-01T00:00').
	self assert: aDateAndTime =  (DateAndTime fromString: ' 1980-01-01T00:00:00+00:00').
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:38'!
testYearDayHourMinuteSecond
	self assert: aDateAndTime =  (DateAndTime year: 1980 day: 1 hour: 0 minute: 0 second: 0).
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testNow
	self deny: aDateAndTime =  (DateAndTime now).
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:34'!
testEpoch
	self assert: aDateAndTime =  '1980-01-01T00:00:00+00:00' asDateAndTime
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testLessThan
	self assert: aDateAndTime  < (aDateAndTime + '1:00:00:00').
	self assert: aDateAndTime + -1 < aDateAndTime.
	! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:36'!
testNoon
	self assert: aDateAndTime noon = '1980-01-01T12:00:00+00:00' asDateAndTime! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:38'!
testYearMonthDay
	self assert: aDateAndTime =  (DateAndTime year: 1980 month: 1 day: 1).
! !

!DateAndTimeDosEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:34'!
testDaysLeftInYear
	self assert: aDateAndTime daysLeftInYear  = 365.

! !

!DateAndTimeEpochTest commentStamp: 'tlk 1/6/2004 18:27'!
I represent one of several Sunit test Cases intentended to provide complete coverage  for the Chronology set of classes as part of the external testing. The other Chronology sunit test cases are:
 DateTestCase
 DateAndTimeLeapTestCase,
 DurationTestCase,
 ScheduleTestCase
 TimeStampTestCase
 TimespanDoTestCase, 
 TimespanDoSpanAYearTestCase, 
 TimespanTestCase, 
 YearMonthWeekTestCase.  
These tests attempt to exercise all public and private methods.  Except, they do not explicitly depreciated methods. tlk
My fixtures are:
aDateAndTime = January 01, 1901 midnight (the start of the Squeak epoch) with localTimeZone = Grenwhich Meridian (local offset = 0 hours)
aDuration = 1 day, 2 hours, 3, minutes, 4 seconds and 5 nano seconds.
aTimeZone =  'Epoch Test Time Zone', 'ETZ' , offset: 12 hours, 15 minutes. !
!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/2/2004 11:07'!
testAsUTC
	self assert: aDateAndTime asUTC =  aDateAndTime
          ! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 12:37'!
testMiddleOf
	self assert: (aDateAndTime middleOf: '2:00:00:00' asDuration) = 
	 (Timespan starting: '12-31-1900' asDate duration: 2 days).
	
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'al 6/12/2008 21:56'!
testHash
	self assert: aDateAndTime hash = DateAndTime new hash! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 19:35'!
testMinute
	self assert: aDateAndTime minute =  0

! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 20:53'!
testToByDo
	"self assert: (aDateAndTime to: aDateAndTime + 10 days by: 5 days do: []) =  "
	"MessageNotUnderstood: UndefinedObject>>starting:ending:  where UndefinedObject is Timespan "! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 14:02'!
testDaysInMonth
	self assert: aDateAndTime daysInMonth  = 31.

! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 09:46'!
testDateTime
	self assert: aDateAndTime =  (DateAndTime date: '01-01-1901' asDate time: '00:00:00' asTime)
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 12:25'!
testFromSeconds
	self assert: aDateAndTime =  (DateAndTime fromSeconds: 0).
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 13:31'!
testAsDateAndTime
	self assert: aDateAndTime asDateAndTime =  aDateAndTime
	
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 14:01'!
testAsSeconds
	self assert: aDateAndTime asSeconds =  0 asDuration asSeconds
	
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 14:01'!
testDay
	self assert: aDateAndTime day =   DateAndTime new day
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 09:43'!
testAsYear
	self assert: aDateAndTime asYear =   (Year starting: '01-01-1901' asDate). 
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 12:30'!
testYearDay
	self assert: aDateAndTime =  (DateAndTime year: 1901 day: 1).
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 17:35'!
testToday
	self deny: aDateAndTime =  (DateAndTime today).
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 20:22'!
testSeconds
	self assert: aDateAndTime seconds =  0

! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/2/2004 11:08'!
testDayMonthYearDo
	|iterations|
	iterations := 0.
	self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear |  iterations := iterations + 1])  = 1.
	self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear |  eachYear])  = 1901.
	self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear |  eachMonth]) = 1.
	self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear |  eachDay]) = 1.
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 12:28'!
testCurrent
	self deny: aDateAndTime =  (DateAndTime current).
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'brp 1/16/2004 13:43'!
testAsWeek
	self assert: aDateAndTime asWeek = (Week starting: '12-31-1900' asDate). 

! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 19:46'!
testMonth
	self assert: aDateAndTime month  = 1.
	self assert: aDateAndTime monthAbbreviation = 'Jan'.
	self assert: aDateAndTime monthName = 'January'.
	self assert: aDateAndTime monthIndex = 1.! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/3/2004 11:42'!
testTo
	self assert: (aDateAndTime to: aDateAndTime) = (DateAndTime new to: DateAndTime new) 
	"MessageNotUnderstood: UndefinedObject>>starting:ending:  where UndefinedObject is Timespan "! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'damiencassou 5/30/2008 11:09'!
testPrintOn
	| cs rw |
	cs := '1901-01-01T00:00:00+00:00' readStream.
	rw := ReadWriteStream on: ''.
	aDateAndTime printOn: rw.
	self assert: rw contents = cs contents.
	cs := 'a TimeZone(ETZ)' readStream.
	rw := ReadWriteStream on: ''.
	aTimeZone printOn: rw.
	self assert: rw contents = cs contents! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 14:01'!
testDayOfYear
	self assert: aDateAndTime dayOfYear  = 1.

! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 19:47'!
testNanoSecond
	self assert: aDateAndTime nanoSecond =  0

! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 11:03'!
testPlus
	self assert: aDateAndTime + '0:00:00:00' = aDateAndTime.
	self assert: aDateAndTime + 0 = aDateAndTime.
	self assert: aDateAndTime + aDuration = (DateAndTime year: 1901 month: 1 day: 2 hour: 2 minute: 3 second: 4 nanoSecond: 5 offset: 0 hours )
	" I believe this is a bug in the nanosecond part of (DateAndTime >> year:month:day:hour:minute:second:nanoSecond:offset:)"
	
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 21:00'!
testYear
	self assert: aDateAndTime year = 1901.

	! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 12:31'!
testYearMonthDayHourMinuteSecond
	self assert: aDateAndTime =  (DateAndTime year: 1901 month: 1 day: 1 hour: 0 minute: 0 second: 0).
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/3/2004 11:45'!
testTommorrow
	self assert: (DateAndTime today + 24 hours) =  (DateAndTime tomorrow).
	self deny: aDateAndTime =  (DateAndTime tomorrow).
     "MessageNotUnderstood: Date class>>starting:"! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'brp 3/12/2004 15:21'!
testHour12
	self assert: aDateAndTime hour12  = DateAndTime new hour12.
	self assert: aDateAndTime hour12  = 12
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/3/2004 11:43'!
testToBy
	self assert: (aDateAndTime to: aDateAndTime + 10 days by: 5 days) = 
				(DateAndTime new to: DateAndTime new + 10 days by: 5 days ) 
	"MessageNotUnderstood: UndefinedObject>>starting:ending:  where UndefinedObject is Timespan "! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'brp 1/16/2004 13:41'!
testMinutes
	self assert: aDateAndTime minutes = 0
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 10:40'!
testMeridianAbbreviation
	self assert: aDateAndTime meridianAbbreviation = 'AM'.

	! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 14:03'!
testMinus
	self assert: aDateAndTime - aDateAndTime =  '0:00:00:00' asDuration.
	self assert: aDateAndTime - '0:00:00:00' asDuration = aDateAndTime.
	self assert: aDateAndTime - aDuration =  (DateAndTime year: 1900 month: 12 day: 30 hour: 21 minute: 56 second: 55 nanoSecond: 999999995 offset: 0 hours ).
	" I believe this Failure is a bug in the nanosecond part of (DateAndTime >> year:month:day:hour:minute:second:nanoSecond:offset:)" ! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 16:36'!
testUtcOffset
     self assert: (aDateAndTime offset: '0:12:00:00') =  '1901-01-01T12:00:00+12:00' asDateAndTime! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 20:25'!
testTicks
	self assert: aDateAndTime ticks =  (DateAndTime julianDayNumber: 2415386) ticks.
	self assert: aDateAndTime ticks = #(2415386 0 0)! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 10:44'!
testFirstDayOfMonth
	self assert: aDateAndTime firstDayOfMonth =   1
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 16:59'!
testHour
	self assert: aDateAndTime hour =    aDateAndTime hour24.
	self assert: aDateAndTime hour =    0.
	self assert: aDateAndTime hour =    aDateAndTime hours
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 16:24'!
testDuration
	self assert: aDateAndTime duration  = 0 asDuration.

! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 20:22'!
testSecond
	self assert: aDateAndTime second =  0

! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 13:59'!
testAsNanoSeconds
	self assert: aDateAndTime asNanoSeconds =  0 asDuration asNanoSeconds
	
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 17:39'!
testMidnight
	self assert: aDateAndTime midnight =  aDateAndTime
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 14:01'!
testAsDate
	self assert: aDateAndTime asDate =   'January 1, 1901' asDate.

! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 14:02'!
testDaysInYear
	self assert: aDateAndTime daysInYear  = 365.

! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 14:02'!
testIsLeapYear
	self deny: aDateAndTime isLeapYear
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 17:18'!
testJulianDayNumber
	self assert: aDateAndTime =  (DateAndTime julianDayNumber: 2415386).
	self assert: aDateAndTime julianDayNumber = 2415386.! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 20:31'!
testTicksOffset
	self assert: aDateAndTime =  (aDateAndTime ticks:  #(2415386 0 0) offset: DateAndTime localOffset).
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 19:21'!
testOffset

	self assert: aDateAndTime offset =  '0:00:00:00' asDuration.
	self assert: (aDateAndTime offset: '-0:12:00:00') equals:  '1900-12-31T12:00:00-12:00' asDateAndTime.
	self assert: (aDateAndTime offset: '0:12:00:00') equals:  '1901-01-01T12:00:00+12:00' asDateAndTime! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 09:47'!
testYesterday
	self deny: aDateAndTime =  (DateAndTime yesterday).
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 16:52'!
testTimeZone
	self assert: aDateAndTime timeZoneName	= 'Universal Time'.
	self assert: aDateAndTime timeZoneAbbreviation	=  'UTC'

! !

!DateAndTimeEpochTest methodsFor: 'running' stamp: 'tlk 1/2/2004 11:04'!
tearDown
     DateAndTime localTimeZone: localTimeZoneToRestore.
     "wish I could remove the time zones I added earlier, tut there is no method for that"
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 12:23'!
testYearMonthDayHourMinuteSecondNanosSecondOffset
	self assert: aDateAndTime =  (DateAndTime year: 1901 month: 1 day: 1 hour: 0 minute: 0 second: 0 nanoSecond: 0 offset:0 hours ).
	self assert: ((DateAndTime year: 1 month: 1 day: 1 hour: 0 minute: 0 second: 0 nanoSecond: 0 offset: 0 hours ) +
				(Duration days: 1 hours: 2 minutes: 3 seconds: 4  nanoSeconds: 5) ) =  	
				(DateAndTime year: 1 month: 1 day: 2 hour: 2 minute: 3 second: 4 nanoSecond: 5 offset: 0 hours ) 
	" I believe this is a bug in the nanosecond part of (DateAndTime >> year:month:day:hour:minute:second:nanoSecond:offset:)"" I believe this is a bug in the nanosecond part of (DateAndTime >> year:month:day:hour:minute:second:nanoSecond:offset:)"   
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'CamilloBruni 8/22/2013 19:44'!
testAsMonth
	self 
		assert: aDateAndTime asMonth
		equals: (Month year: 1901 month: 'January'). 
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 10:47'!
testDayOfWeek
	self assert: aDateAndTime dayOfWeek  = 3.
	self assert: aDateAndTime dayOfWeekAbbreviation = 'Tue'.
	self assert: aDateAndTime dayOfWeekName = 'Tuesday'.
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 13:34'!
testAsDuration
	self assert: aDateAndTime asDuration =  0 asDuration
	
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 16:36'!
testAsLocal
	self assert: aDateAndTime asLocal =  aDateAndTime.
	self assert: aDateAndTime asLocal = (aDateAndTime offset: aDateAndTime class localOffset)
	
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 09:32'!
testAsTime
	self assert: aDateAndTime asTime =  Time midnight.
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 15:45'!
testDayOfMonth
	self assert: aDateAndTime dayOfMonth  = 1.
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 12:26'!
testFromString
	self assert: aDateAndTime =  (DateAndTime fromString: ' 1901-01-01T00:00:00+00:00').
	self assert: aDateAndTime =  (DateAndTime fromString: ' 1901-01-01T00:00:00').
	self assert: aDateAndTime =  (DateAndTime fromString: ' 1901-01-01T00:00').
	self assert: aDateAndTime =  (DateAndTime fromString: ' 1901-01-01T00:00:00+00:00').
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 12:27'!
testNew
	self assert: aDateAndTime =  (DateAndTime new).
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 12:31'!
testYearDayHourMinuteSecond
	self assert: aDateAndTime =  (DateAndTime year: 1901 day: 1 hour: 0 minute: 0 second: 0).
! !

!DateAndTimeEpochTest methodsFor: 'running' stamp: 'tlk 1/2/2004 10:58'!
setUp
     localTimeZoneToRestore := DateAndTime localTimeZone.
	aDateAndTime :=  DateAndTime localTimeZone: TimeZone default; epoch.
	aTimeZone := TimeZone offset: (Duration minutes: 135) name: 'Epoch Test Time Zone' abbreviation: 'ETZ'.
	aDuration := Duration days: 1 hours: 2 minutes: 3 seconds: 4 nanoSeconds: 5 ! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 12:28'!
testNow
	self deny: aDateAndTime =  (DateAndTime now).
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'cmm 6/14/2010 17:19'!
testEpoch
	self assert: aDateAndTime =  '1901-01-01T00:00:00+00:00' asDateAndTime
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 13:20'!
testLessThan
	self assert: aDateAndTime  < (aDateAndTime + '1:00:00:00').
	self assert: aDateAndTime + -1 < aDateAndTime.
	! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'cmm 6/14/2010 17:19'!
testNoon
	self assert: aDateAndTime noon = '1901-01-01T12:00:00+00:00' asDateAndTime! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/1/2004 12:31'!
testYearMonthDay
	self assert: aDateAndTime =  (DateAndTime year: 1901 month: 1 day: 1).
! !

!DateAndTimeEpochTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 14:02'!
testDaysLeftInYear
	self assert: aDateAndTime daysLeftInYear  = 364.

! !

!DateAndTimeLeapTest commentStamp: 'tlk 1/6/2004 17:54'!
I represent one of several Sunit test Cases intentended to provide complete coverage for the Chronology set of classes as part of the external testing. tlk.
My fixtures are:
aDateAndTime = February 29, 2004 1:33 PM with offset: 2 hours
aDuration = 15 days, 14 hours, 13 minutes, 12 seconds and 11 nano seconds.
aTimeZone =  Grenwhich Meridian (local offset = 0 hours) !
!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 13:59'!
testAsUTC
	self assert: aDateAndTime asUTC =  aDateAndTime

          ! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 16:36'!
testUtcOffset
     self assert: (aDateAndTime offset: '0:02:00:00') =  '2004-02-29T13:33:00+02:00' asDateAndTime! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 13:12'!
testMiddleOf
	self assert: (aDateAndTime middleOf: aDuration)  = 
	 (Timespan starting: (DateAndTime year: 2004 month: 2 day: 29 hour: 6 minute: 46 second: 30 offset: 2 hours)
	duration: (Duration days: 0 hours: 13 minutes: 33 seconds: 0 nanoSeconds: 0 ))
	! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'tlk 1/3/2004 11:00'!
testMinute
	self assert: aDateAndTime minute =  33

! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 13:58'!
testDaysInMonth
	self assert: aDateAndTime daysInMonth  = 29.

! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'CamilloBruni 7/17/2012 17:05'!
testTicks
	self 
		assert: aDateAndTime ticks  
		equals: ((DateAndTime julianDayNumber: 2453065) + 41580 seconds) ticks.
	self 
		assert: aDateAndTime ticks 
		equals:  #(2453065 41580 0)! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'CamilloBruni 7/17/2012 17:09'!
testAsSeconds
	self assert: aDuration asSeconds =  48780.
	self assert: aDateAndTime asSeconds = 3255507180.
	
! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 13:23'!
testDay
	self assert: aDateAndTime day =   60. 
	self deny: aDateAndTime day =   29 ! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 13:38'!
testFirstDayOfMonth
	self deny: aDateAndTime firstDayOfMonth =  1.
	self assert: aDateAndTime firstDayOfMonth = 32
! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'CamilloBruni 8/22/2013 20:05'!
testAsYear
	"A year always starts at January 1"
	self 
		assert: aDateAndTime asYear
		equals: ((Year starting: '02-29-2004' asDate) translateTo: 2 hours ).  
	self
		assert: aDateAndTime asYear
		equals: ((Year starting: '01-01-2004' asDate) translateTo: 2 hours)  
! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 16:53'!
testHour
	self assert: aDateAndTime hour equals: aDateAndTime hour24.
	self assert: aDateAndTime hour equals: 13.
	self assert: aDateAndTime hour equals: aDateAndTime hours
! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'tlk 1/2/2004 21:30'!
testSecond
	self assert: aDateAndTime second =  0

! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'tlk 1/2/2004 21:59'!
testAsNanoSeconds
	self assert: aDateAndTime asNanoSeconds =  aDuration asNanoSeconds.
	self assert: aDateAndTime asNanoSeconds = 48780000000000
	
! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 13:52'!
testTicksOffset
	self assert: aDateAndTime =  (aDateAndTime ticks:  #(2453065 48780 0) offset: DateAndTime localOffset).

! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 20:56'!
testMidnight
	self assert: aDateAndTime midnight equals: '2004-02-29T00:00:00+02:00' asDateAndTime.
! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 13:58'!
testDaysInYear
	self assert: aDateAndTime daysInYear  = 366.

! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 13:35'!
testIsLeapYear
	self assert: aDateAndTime isLeapYear
! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 21:08'!
testAsDate
	self assert: aDateAndTime asDate equals:  ('February 29, 2004' asDate translateTo: 2 hours).! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'tlk 1/2/2004 21:30'!
testSeconds
	self assert: aDateAndTime seconds =  0

! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 19:24'!
testOffset

	self assert: aDateAndTime offset =  '0:02:00:00' asDuration.
	self assert: (aDateAndTime offset: '-0:12:00:00') equals: '2004-02-28T23:33:00-12:00' asDateAndTime.
	self assert: (aDateAndTime offset: '0:12:00:00') equals:  '2004-02-29T23:33:00+12:00' asDateAndTime! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 20:59'!
testTimeZone
	aDateAndTime := '2004-02-29T13:33:00+00:00' asDateAndTime.
	self assert: aDateAndTime timeZone name equals: 'Universal Time'.
	self assert: aDateAndTime timeZone abbreviation 	equals: 'UTC'

! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'tlk 1/2/2004 22:16'!
testDayMonthYearDo
	self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear |  eachYear])  = 2004.
	self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear |  eachMonth]) = 2.
	self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear |  eachDay]) = 29.
! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'CamilloBruni 8/22/2013 19:44'!
testAsMonth
	self
		assert: aDateAndTime asMonth
		equals: (Month year: 2004 month: 'February').
! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 21:09'!
testAsWeek
	self assert: aDateAndTime asWeek equals: ((Week starting: '02-29-2004' asDate) translateTo: 2 hours).
! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 19:25'!
testAsDuration
	self assert: aDateAndTime asDuration equals: aDuration
	
! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 16:36'!
testAsLocal
	self assert: aDateAndTime asLocal =  aDateAndTime.
	self assert: aDateAndTime asLocal = (aDateAndTime offset: aDateAndTime class localOffset)

	
! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 19:26'!
testAsTime
	self assert: aDateAndTime asTime equals: (Time hour: 13 minute: 33 second: 0)
! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'tlk 1/2/2004 22:17'!
testDayOfMonth
	self assert: aDateAndTime dayOfMonth  = 29.
! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 13:34'!
testDayOfWeek
	self assert: aDateAndTime dayOfWeek  = 1.
	self assert: aDateAndTime dayOfWeekAbbreviation = 'Sun'.
	self assert: aDateAndTime dayOfWeekName = 'Sunday'.
! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'tlk 1/3/2004 10:43'!
testFromString
	self assert: aDateAndTime =  (DateAndTime fromString: ' 2004-02-29T13:33:00+02:00').

! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 13:59'!
testDayOfYear
	self assert: aDateAndTime dayOfYear  = 60.

! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'tlk 1/3/2004 11:02'!
testMonth
	self assert: aDateAndTime month  = 2.
	self assert: aDateAndTime monthAbbreviation = 'Feb'.
	self assert: aDateAndTime monthName = 'February'.
	self assert: aDateAndTime monthIndex = 2.! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'damiencassou 5/30/2008 11:09'!
testPrintOn
	| cs rw |
	cs := '2004-02-29T13:33:00+02:00' readStream.
	rw := ReadWriteStream on: ''.
	aDateAndTime printOn: rw.
	self assert: rw contents = cs contents.
	cs := 'a TimeZone(UTC)' readStream.
	rw := ReadWriteStream on: ''.
	aTimeZone printOn: rw.
	self assert: rw contents = cs contents! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'tlk 1/2/2004 21:30'!
testNanoSecond
	self assert: aDateAndTime nanoSecond =  0

! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 19:36'!
testYearDayHourMinuteSecond
	self assert: aDateAndTime equals:  (DateAndTime year: 2004 day: 60 hour: 13 minute: 33 second: 0 offset: 2 hours).
! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'tlk 1/3/2004 11:17'!
testYear
	self assert: aDateAndTime year = 2004.

	! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'tlk 1/2/2004 21:30'!
testLessThan
	self assert: aDateAndTime  < (aDateAndTime + '1:00:00:00').
	self assert: aDateAndTime + -1 < aDateAndTime.
	! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 19:36'!
testYearMonthDayHourMinuteSecond
	self assert: aDateAndTime equals:  (DateAndTime year: 2004 month: 2 day: 29 hour: 13 minute: 33 second: 0 offset: 2 hours).
! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'brp 3/12/2004 15:19'!
testHour12
	self assert: aDateAndTime hour12  =   1.
! !

!DateAndTimeLeapTest methodsFor: 'running' stamp: 'CamilloBruni 7/17/2012 17:05'!
setUp
	aDateAndTime := (DateAndTime 
		year: 2004 month: 2 day: 29 
		hour: 13 minute: 33 second: 0 
		offset: 2 hours).
	aTimeZone := TimeZone default.
	aDuration := Duration days: 0 hours: 13 minutes: 33 seconds: 0 nanoSeconds: 0
! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'CamilloBruni 7/16/2012 19:22'!
testNoon
	self assert: aDateAndTime noon equals:  '2004-02-29T12:00:00+02:00' asDateAndTime! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'brp 1/16/2004 13:44'!
testMinutes
	self assert: aDateAndTime minutes = 33
! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 10:42'!
testMeridianAbbreviation
	self assert: aDateAndTime meridianAbbreviation = 'PM'.

	! !

!DateAndTimeLeapTest methodsFor: 'tests' stamp: 'tlk 1/4/2004 13:58'!
testDaysLeftInYear
	self assert: aDateAndTime daysLeftInYear  = 306.

! !

!DateAndTimeTest commentStamp: 'TorstenBergmann 2/5/2014 08:33'!
SUnit tests for date and time!
!DateAndTimeTest methodsFor: 'tests' stamp: 'BG 11/7/2004 12:18'!
testTimeZoneEquivalence
  "DateAndTimeTest new testTimeZoneEquivalence"
	"When the clock on the wall in Detroit says 9:00am, the clock on the wall
	in London says 2:00pm. The Duration difference between the corresponding
	DateAndTime values should be zero."
	
	 " Detroit is 5 hours behind UTC, this offset to UTC is therefore written with a minus sign. This example tests both the correct interpretation of the DateAndTime denotation and correct DateAndTime arithmetics. "

	| twoPmInLondon nineAmInDetroit durationDifference |
	twoPmInLondon := '2004-11-02T14:00:00+00:00' asDateAndTime.
	nineAmInDetroit  := '2004-11-02T09:00:00-05:00' asDateAndTime.
	durationDifference := twoPmInLondon - nineAmInDetroit.
	self assert: durationDifference asSeconds = 0.
	self assert: twoPmInLondon = nineAmInDetroit
! !

!DateAndTimeTest methodsFor: 'tests - instance' stamp: 'brp 1/7/2004 15:37'!
testInstanceCreation

	| t |
	t := DateAndTime 
			year: 1 month: 1 day: 2 
			hour: 2 minute: 3 second: 4 nanoSecond: 5 
			offset: 6 hours.
	self 
		assert: (t julianDayNumber = 1721427);
		assert: (t offset = 6 hours);
		assert: (t hour = 2);
		assert: (t minute = 3);
		assert: (t second = 4);
		assert: (t nanoSecond = 5).
		
! !

!DateAndTimeTest methodsFor: 'tests - arithmetic' stamp: 'StephaneDucasse 4/23/2010 21:07'!
testArithmeticAcrossDateBoundary

	| t1 t2 |
	t1 := '2004-01-07T11:55:00+00:00' asDateAndTime. 
	t2 := t1 - ( (42900+1) seconds).  
	self assert: t2 = ('2004-01-06T23:59:59+00:00' asDateAndTime)
		
! !

!DateAndTimeTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 17:24'!
testCreationWithOffsets
	| dt1 dt2 |
	dt1 := (DateAndTime year: 2222 month: 1 day: 22 hour: 1 minute: 22 second: 33 offset: 0 hours).
	dt2 := (DateAndTime year: 2222 month: 1 day: 22 hour: 1 minute: 22 second: 33 offset: 2 hours).
	
	"The timepoints are diffferent, AKA their UTC times don't correspond"
	self deny: dt1 = dt2.
	
	"The relative components however are equal"
	self assert: dt1 year equals: dt2 year.
	self assert: dt1 month equals: dt2 month.
	self assert: dt1 day equals: dt2 day.
	
	self assert: dt1 hours equals: dt2 hours.
	self assert: dt1 minutes equals: dt2 minutes.
	self assert: dt1 seconds equals: dt2 seconds.! !

!DateAndTimeTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 16:36'!
testDateTimeDenotation1
 	"DateAndTimeTest new testDateTimeDenotation1"
	
	"Detroit is 5 hours behind UTC, this offset to UTC is therefore written with a minus sign. This example tests the correct interpretation of the DateAndTime denotation. "

	| twoPmInLondon twoPmUTCInLocalTimeOfDetroit nineAmInDetroit |
	twoPmInLondon := DateAndTime
				year: 2004
				month: 11
				day: 2
				hour: 14
				minute: 0
				second: 0
				offset: 0 hours.
	twoPmUTCInLocalTimeOfDetroit := twoPmInLondon offset: -5 hours.
	nineAmInDetroit  := '2004-11-02T09:00:00-05:00' asDateAndTime.
	self assert:  twoPmUTCInLocalTimeOfDetroit = nineAmInDetroit.
	
! !

!DateAndTimeTest methodsFor: 'tests - under design' stamp: 'StephaneDucasse 4/23/2010 22:08'!
testSymmetric

	| t1 t2 |
	t1 := DateAndTime 
			year: 1 month: 1 day: 2 
			hour: 2 minute: 3 second: 4 nanoSecond: 5 
			offset: 6 hours.
	t2 := DateAndTime 
			year: 1 month: 1 day: 2 
			hour: 2 minute: 3 second: 4 nanoSecond: 5 
			offset: 6 hours.
	self assert: (t2 = t1) = (t1 = t2).
	
	
! !

!DateAndTimeTest methodsFor: 'tests - epoch' stamp: 'SeanDeNigris 6/20/2012 00:50'!
testSecondsAcrossTimeZones

	| dateTime seconds dateTime2 utc |
	dateTime := '1/15/2012 0000+00:00' asDateAndTime.
	utc := TimeZone abbreviated: 'UTC'.

	self useTimeZone: 'PDT' during: [ :pdt |
		"Store a DateAndTime as seconds from the epoch"
		seconds := dateTime asSeconds.

		"Now move to Greenwich" 
		DateAndTime localTimeZone: utc. 
		dateTime2 := DateAndTime fromSeconds: seconds.
		
		self assert: dateTime equals: dateTime2 ].! !

!DateAndTimeTest methodsFor: 'tests - epoch' stamp: 'PavelKrivanek 7/8/2012 19:46'!
testDosEpoch

  self useNonUtcTimeZoneDuring: [ | localEpoch |
    localEpoch := '1 January 1980 00:00' asDateAndTime.
    self deny: (DateAndTime dosEpoch = localEpoch) ].
  
  self useTimeZone: 'UTC' during: [ | localEpoch |
    localEpoch := '1 January 1980 00:00' asDateAndTime.
    self assert: DateAndTime dosEpoch equals: localEpoch ].
  
  self assert: DateAndTime dosEpoch equals: '1980-01-01T00:00:00+00:00' asDateAndTime.! !

!DateAndTimeTest methodsFor: 'tests' stamp: 'StephaneDucasse 4/23/2010 21:46'!
testMonotonicity

	| t1 t2 t3 t4 |
	t1 := DateAndTime now.
	t2 := DateAndTime now.
	(Delay forMilliseconds: 1000) wait.
	t3 := DateAndTime now.
	t4 := DateAndTime now.

	self
		assert: (t1 <= t2);
		assert: (t2 < t3);
		assert: (t3 <= t4).
! !

!DateAndTimeTest methodsFor: 'coverage' stamp: 'brp 9/25/2003 09:25'!
classToBeTested

	^ DateAndTime

! !

!DateAndTimeTest methodsFor: 'tests - under design' stamp: 'CamilloBruni 7/13/2012 20:02'!
testReadFromSecond
	"self debug: #testReadFromSecond"
	
	self assert: ('-1199-01-05T20:33:14.321-05:00' asDateAndTime printString = '-1199-01-05T20:33:14.321-05:00').
	self assert: ('2002-05-16T17:20:45.1+01:01' asDateAndTime printString = '2002-05-16T17:20:45.1+01:01').
	self assert: (' 2002-05-16T17:20:45.02+01:01' asDateAndTime printString = '2002-05-16T17:20:45.02+01:01').  
	self assert: ('2002-05-16T17:20:45.000000009+01:01' asDateAndTime printString =  '2002-05-16T17:20:45.000000009+01:01').
	self assert: (' 2002-05-16T17:20' asDateAndTime translateToUTC printString = '2002-05-16T17:20:00+00:00').
	self assert: ('2002-05-16T17:20:45' asDateAndTime translateToUTC printString = '2002-05-16T17:20:45+00:00' ).
	self assert: (' 2002-05-16T17:20:45+01:57' asDateAndTime printString = '2002-05-16T17:20:45+01:57').
	self assert: (' 2002-05-16T17:20:45-02:34' asDateAndTime printString = '2002-05-16T17:20:45-02:34').
	self assert: ('2002-05-16T17:20:45+00:00' asDateAndTime printString = '2002-05-16T17:20:45+00:00').
	self assert: ('1997-04-26T01:02:03+01:02:3' asDateAndTime printString = '1997-04-26T01:02:03+01:02:3'). ! !

!DateAndTimeTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 19:56'!
testReadFrom

	self 
		assert: '-1199-01-05T20:33:14.321-05:00' asDateAndTime printString
		equals: '-1199-01-05T20:33:14.321-05:00'.
	self 
		assert: '2002-05-16T17:20:45.1+01:01' asDateAndTime printString
		equals:  '2002-05-16T17:20:45.1+01:01'.
	self 
		assert:	' 2002-05-16T17:20:45.02+01:01' asDateAndTime printString
		equals:  '2002-05-16T17:20:45.02+01:01'.  
	self 
		assert:	'2002-05-16T17:20:45.000000009+01:01' asDateAndTime printString
		equals:   '2002-05-16T17:20:45.000000009+01:01'.
	self 
		assert: ' 2002-05-16T17:20' asDateAndTime translateToUTC printString
		equals:  '2002-05-16T17:20:00+00:00'.
	self 
		assert: '2002-05-16T17:20:45' asDateAndTime translateToUTC printString
		equals:  '2002-05-16T17:20:45+00:00' .
	self 
		assert: ' 2002-05-16T17:20:45+01:57' asDateAndTime printString
		equals:  '2002-05-16T17:20:45+01:57'.
	self 
		assert: ' 2002-05-16T17:20:45-02:34' asDateAndTime
		equals:  '2002-05-16T17:20:45-02:34' asDateAndTime.
	self 
		assert: '2002-05-16T17:20:45+00:00' asDateAndTime
		equals:  '2002-05-16T17:20:45+00:00' asDateAndTime.
	self 
		assert: '1997-04-26T01:02:03+01:02:3' asDateAndTime
		equals:  '1997-04-26T01:02:03+01:02:3' asDateAndTime! !

!DateAndTimeTest methodsFor: 'helpers' stamp: ''!
restoreLocalTimeZoneAfter: aBlock

	| realTimeZone |
	realTimeZone := DateAndTime localTimeZone.
	aBlock ensure: [ DateAndTime localTimeZone: realTimeZone ].! !

!DateAndTimeTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 16:33'!
testSecondsRoundTrip
	| now now2 |
	now := DateAndTime fromSeconds: 0.
	now2 := DateAndTime fromSeconds: now asSeconds.
	self assert: now equals: now2.! !

!DateAndTimeTest methodsFor: 'tests - under design' stamp: 'SvenVanCaekenberghe 3/5/2013 09:27'!
testAsDateAndTime
	"self debug: #testAsDateAndTime"
	
		#('-1199-01-05T20:33:14.321-05:00' 
		' 2002-05-16T17:20:45.1+01:01' 

		' 2002-05-16T17:20:45.02+01:01' 

		' 2002-05-16T17:20:45.003+01:01' 

		' 2002-05-16T17:20:45.0004+01:01' 
  		' 2002-05-16T17:20:45.00005' 
		' 2002-05-16T17:20:45.000006+01:01' 

		' 2002-05-16T17:20:45.0000007+01:01' 
		' 2002-05-16T17:20:45.00000008-01:01'    
		' 2002-05-16T17:20:45.000000009+01:01'   
		' 2002-05-16T17:20:45.0000000001+01:01'   

 		' 2002-05-16T17:20' 
		' 2002-05-16T17:20:45' 
		' 2002-05-16T17:20:45+01:57' 
 		' 2002-05-16T17:20:45-02:34' 
 		' 2002-05-16T17:20:45+00:00' 
		' 1997-04-26T01:02:03+01:02:3' ) 
		
		do: [:each | each asDateAndTime printString = each]! !

!DateAndTimeTest methodsFor: 'tests - under design' stamp: 'StephaneDucasse 4/24/2010 12:05'!
testReadFromOffset
	"self debug: #testReadFromOffset"
	
	self assert: (DateAndTime readFrom: '-1199-01-05T20:33:14.321-05:00' readStream) offset printString =  '-0:05:00:00'.
! !

!DateAndTimeTest methodsFor: 'tests - under design' stamp: 'StephaneDucasse 4/23/2010 22:09'!
testTransitive
	"self debug: #testTransitive"
	| t1 t2 t3 |
	t1 := DateAndTime 
			year: 1 month: 1 day: 2 
			hour: 2 minute: 3 second: 4 nanoSecond: 5 
			offset: 6 hours.
	t2 := DateAndTime 
			year: 1 month: 1 day: 2 
			hour: 2 minute: 3 second: 4 nanoSecond: 5 
			offset: 6 hours.
	t3 := DateAndTime 
			year: 1 month: 1 day: 2 
			hour: 2 minute: 3 second: 4 nanoSecond: 5 
			offset: 6 hours.
	self assert: ((t1 = t2) & (t2 = t3) ==> (t1 = t3)).
	
	
! !

!DateAndTimeTest methodsFor: 'tests' stamp: 'SeanDeNigris 5/21/2012 16:11'!
testAsDos
	
	| remoteDatetime |
	self assert: '21 May 2012 3:02:44 pm' asDateAndTime asDosTimestamp equals: 16r40B57856.

	"DOS times are in local time per http://blogs.msdn.com/b/oldnewthing/archive/2003/09/05/54806.aspx"
	remoteDatetime := DateAndTime current offset: DateAndTime localOffset + 2 hours.
	self assert: remoteDatetime asDosTimestamp equals: remoteDatetime asLocal asDosTimestamp.! !

!DateAndTimeTest methodsFor: 'tests - under design' stamp: 'CamilloBruni 12/13/2013 05:34'!
testNotSymmetricWithString
	"self debug: #testNotSymmetricWithString"
	
	| t1 t2 |
	t1 := DateAndTime 
			year: 1 month: 1 day: 2 
			hour: 2 minute: 3 second: 4 nanoSecond: 5 
			offset: 6 hours.
	t2 :=  '0001-01-02T02:03:04.000000005+06:00'.
	self deny: t1 = t2.
	self deny: t2 = t1.
	
	
! !

!DateAndTimeTest methodsFor: 'tests' stamp: 'NickAger 7/6/2010 11:25'!
testAsUnixTimeIndependentOfTimezone
	| datetimeWithOffset datetimeWithoutOffset |
	datetimeWithoutOffset := DateAndTime current offset: Duration zero.
	datetimeWithOffset := datetimeWithoutOffset offset: (Duration hours: 1).
	
	self assert: datetimeWithOffset asUnixTime equals: datetimeWithoutOffset asUnixTime! !

!DateAndTimeTest methodsFor: 'tests' stamp: 'SeanDeNigris 5/21/2012 16:12'!
testFromDos
	
	| aDateAndTime |
	aDateAndTime := DateAndTime fromDosTimestamp: 16r40B57856.
	self assert: aDateAndTime equals:  '21 May 2012 3:02:44 pm' asDateAndTime.
	
	"DOS times are in local time per http://blogs.msdn.com/b/oldnewthing/archive/2003/09/05/54806.aspx"
	self assert: aDateAndTime offset equals: DateAndTime localOffset! !

!DateAndTimeTest methodsFor: 'tests - bogus date' stamp: 'CamilloBruni 8/31/2013 20:23'!
testErrorWhenDayIsAfterMonthEnd
	self should: [ DateAndTime year: 2004 month: 2 day: 30 ] raise: Error.
	DateAndTime year: 2004 month: 2 day: 29! !

!DateAndTimeTest methodsFor: 'tests - under design' stamp: 'GuillermoPolito 4/30/2012 11:50'!
testPrintStringNoOffset
	
	| localOffsetHours localOffsetMinutes signString |
	signString := DateAndTime localOffset hours positive ifTrue: [ '+' ] ifFalse: [ '-' ].
	localOffsetHours := DateAndTime localOffset hours abs printStringPadded: 2.
	localOffsetMinutes := DateAndTime localOffset minutes printStringPadded: 2.
	self assert: ('2002-05-16T17:20' asDateAndTime printString
						 = ('2002-05-16T17:20:00{1}{2}:{3}' format: { signString . localOffsetHours. localOffsetMinutes})).
	self assert: ('2002-05-16T17:20:45' asDateAndTime printString
						= ('2002-05-16T17:20:45{1}{2}:{3}' format: { signString . localOffsetHours. localOffsetMinutes})).! !

!DateAndTimeTest methodsFor: 'tests' stamp: 'StephaneDucasse 9/18/2010 21:40'!
testPrintString
	"self debug: #testPrintString"

	| dt dtNoOffset |
	dt :=DateAndTime
		year: 2004
		month: 11
		day: 2
		hour: 14
		minute: 3
		second: 5
		nanoSecond: 12345
		offset: (Duration seconds: (5 * 3600)).
	self assert: dt printString = '2004-11-02T14:03:05.000012345+05:00'.
	self assert: ('2002-05-16T17:20:45.1+01:01' asDateAndTime printString = '2002-05-16T17:20:45.1+01:01').
	self assert: (' 2002-05-16T17:20:45.02+01:01' asDateAndTime printString = '2002-05-16T17:20:45.02+01:01').
 	self assert: ('2002-05-16T17:20:45.000000009+01:01' asDateAndTime printString =  '2002-05-16T17:20:45.000000009+01:01').
	self assert: ('2002-05-16T17:20:45+00:00' asDateAndTime printString = '2002-05-16T17:20:45+00:00' ).
	self assert: (' 2002-05-16T17:20:45+01:57' asDateAndTime printString = '2002-05-16T17:20:45+01:57').
	self assert: (' 2002-05-16T17:20:45-02:34' asDateAndTime printString = '2002-05-16T17:20:45-02:34').
	self assert: ('2002-05-16T17:20:45+00:00' asDateAndTime printString = '2002-05-16T17:20:45+00:00').
	self assert: ('1997-04-26T01:02:03+01:02:3' asDateAndTime printString = '1997-04-26T01:02:03+01:02:3').
	"When no offset is provided, the local one is used"
	dtNoOffset := '2002-05-16T17:20' asDateAndTime.
	self assert: (('2002-05-16T17:20:00*' match: dtNoOffset printString) and: [dtNoOffset offset = DateAndTime localOffset]).


! !

!DateAndTimeTest methodsFor: 'tests - instance' stamp: 'SeanDeNigris 11/29/2013 14:29'!
testInstanceCreationFromADateAndATime

	| date time instance |
	date := Date today.
	time := Time now.
	instance := DateAndTime date: date time: time.
	self assert: instance asDate equals: date.
	self assert: instance asTime equals: time.! !

!DateAndTimeTest methodsFor: 'tests - epoch' stamp: 'SeanDeNigris 6/20/2012 00:53'!
testUnixEpoch

	self assert: DateAndTime unixEpoch equals: '1 January 1970 00:00+00:00' asDateAndTime.	! !

!DateAndTimeTest methodsFor: 'tests' stamp: 'CamilloBruni 6/7/2013 23:55'!
testOffset
	| dateAndTime1 dateAndTime2 |
	
	dateAndTime1 :=  DateAndTime year: 1000 day: 100 hour: 1 minute: 2 second: 3 offset: 1 hours.
	dateAndTime2 := dateAndTime1 offset: 1 hour.
	self assert: dateAndTime1 equals: dateAndTime2.
	self assert: dateAndTime1 localSeconds equals: dateAndTime2 localSeconds.
	
	dateAndTime2 := dateAndTime1 offset: -1 hour.
	self assert: dateAndTime1 equals: dateAndTime2.
	self deny: dateAndTime1 localSeconds == dateAndTime2 localSeconds.
	
	dateAndTime2 := dateAndTime1 offset: -2 hour.
	self assert: dateAndTime1 equals: dateAndTime2.
	self deny: dateAndTime1 localSeconds == dateAndTime2 localSeconds.! !

!DateAndTimeTest methodsFor: 'tests - under design' stamp: 'pavel.krivanek 9/9/2010 18:05'!
testPrintStringSecond
	"self debug: #testPrintStringSecond"
	
	self assert: ('-1199-01-05T20:33:14.321-05:00' asDateAndTime printString = '-1199-01-05T20:33:14.321-05:00').
	self assert: ('2002-05-16T17:20:45.1+01:01' asDateAndTime printString = '2002-05-16T17:20:45.1+01:01').
	self assert:	(' 2002-05-16T17:20:45.02+01:01' asDateAndTime printString = '2002-05-16T17:20:45.02+01:01').  
	self assert:	('2002-05-16T17:20:45.000000009+01:01' asDateAndTime printString =  '2002-05-16T17:20:45.000000009+01:01').
	self assert: (' 2002-05-16T17:20:45+01:57' asDateAndTime printString = '2002-05-16T17:20:45+01:57').
	self assert: (' 2002-05-16T17:20:45-02:34' asDateAndTime printString = '2002-05-16T17:20:45-02:34').
	self assert: ('2002-05-16T17:20:45+00:00' asDateAndTime printString = '2002-05-16T17:20:45+00:00').
	self assert: ('1997-04-26T01:02:03+01:02:3' asDateAndTime printString = '1997-04-26T01:02:03+01:02:3'). ! !

!DateAndTimeTest methodsFor: 'coverage' stamp: 'StephaneDucasse 4/23/2010 21:08'!
selectorsToBeIgnored

	| private | 
	private := #( #printOn: ).
	^ super selectorsToBeIgnored, private
! !

!DateAndTimeTest methodsFor: 'tests' stamp: 'StephaneDucasse 4/24/2010 11:58'!
testReadFromFoolProofExtension
	"Convenient extension without a time, only a date"
	"self debug: #testReadFromFoolProofExtension"
	
	self assert: (DateAndTime fuzzyReadFrom: '2008' readStream) printString = '2008-01-01T00:00:00+00:00'.
	self assert: (DateAndTime fuzzyReadFrom: '2008-08' readStream)   printString = '2008-08-01T00:00:00+00:00'.
	self assert: (DateAndTime fuzzyReadFrom: '2006-08-28' readStream)  printString = '2006-08-28T00:00:00+00:00'.
	"Regular nanoseconds"
	self assert: (DateAndTime fuzzyReadFrom: '2006-08-28T00:00:00.123456789' readStream)  printString = '2006-08-28T00:00:00.123456789+00:00'.
	"Extra picoseconds precision should not spoil the DateAndTime"
	self assert: (DateAndTime fuzzyReadFrom: '2006-08-28T00:00:00.123456789000' readStream)  printString = '2006-08-28T00:00:00.123456789+00:00'.! !

!DateAndTimeTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 16:36'!
testDateTimeDenotation2
 	"DateAndTimeTest new testDateTimeDenotation2"
	"Moscow is 3 hours ahead UTC, this offset to UTC is therefore positive. This example tests the correct interpretation of the DateAndTime denotation."

	| lateEveningInLondon lateEveningInLocalTimeOfMoscow
	localMoscowTimeFromDenotation |
	lateEveningInLondon := DateAndTime
				year: 2004
				month: 11
				day: 30
				hour: 23
				minute: 30
				second: 0
				offset: 0 hours.
	lateEveningInLocalTimeOfMoscow := lateEveningInLondon offset: 3 hours.
	localMoscowTimeFromDenotation  := '2004-12-01T02:30:00+03:00' asDateAndTime.
	self assert:  lateEveningInLocalTimeOfMoscow = localMoscowTimeFromDenotation.! !

!DateAndTimeTest methodsFor: 'helpers' stamp: ''!
useTimeZone: abbreviation during: aBlock

  | timeZone |
  timeZone := TimeZone abbreviated: abbreviation.
  self restoreLocalTimeZoneAfter: [ 
    DateAndTime localTimeZone: timeZone. 
    aBlock cull: timeZone ].! !

!DateAndTimeTest methodsFor: 'helpers' stamp: ''!
useNonUtcTimeZoneDuring: aBlock

	self useTimeZone: 'EDT' during: aBlock.! !

!DateAndTimeTest methodsFor: 'tests - under design' stamp: 'SeanDeNigris 8/5/2010 15:50'!
testReadFromNoOffset
	"self debug: #testReadFromNoOffset"
	
	self assert: (DateAndTime readFrom: '2010-01-05T20:33:14.321' readStream) offset = DateAndTime localOffset..
! !

!DateAndTimeTest methodsFor: 'tests' stamp: 'SeanDeNigris 8/5/2010 16:09'!
testFromString

	| fromString fromStringNoOffset |
	fromString := DateAndTime fromString: '-1199-01-05T20:33:14.321-05:00'.
	self assert: (fromString printString = '-1199-01-05T20:33:14.321-05:00').
	
	"if no offset is provided, the local offset should be used"
	fromStringNoOffset := DateAndTime fromString: '-1199-01-05T20:33:14.321'.
	self assert: (fromStringNoOffset offset = DateAndTime localOffset).! !

!DateAndTimeTest methodsFor: 'tests - instance' stamp: 'StephaneDucasse 4/23/2010 21:47'!
testSimpleAccessors

	| t |
	t := DateAndTime 
			year: 1 month: 1 day: 2 
			hour: 2 minute: 3 second: 4 nanoSecond: 5 
			offset: 6 hours.
	self 
		assert: (t hours = t hours);
		assert: (t minutes = t minute);
		assert: (t seconds = t second).
! !

!DateAndTimeTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 16:36'!
testTimeZoneEquivalence2
  "DateAndTimeTest new testTimeZoneEquivalence2"
	"This example demonstates the fact that
        2004-05-24T22:40:00  UTC  is
        2004-05-25T01:40:00  in Moscow
     (Moscow is 3 hours ahead of UTC)  "

	| thisMoment thisMomentInMoscow |
    thisMoment := DateAndTime year: 2004 month: 5 day: 24 hour: 22 minute: 40.
    thisMomentInMoscow := thisMoment offset: 3 hours.
	self assert: (thisMoment - thisMomentInMoscow) asSeconds = 0.
	self assert: thisMoment = thisMomentInMoscow
! !

!DateAndTimeTest methodsFor: 'tests - bogus date' stamp: 'CamilloBruni 8/31/2013 20:23'!
testErrorWhenDayIsBeforeMonthStart
	self should: [ DateAndTime year: 2004 month: 2 day: -1 ] raise: Error.
	self should: [ DateAndTime year: 2004 month: 2 day: 0 ] raise: Error.
	DateAndTime year: 2004 month: 2 day: 1! !

!DateAndTimeTest methodsFor: 'tests - under design' stamp: 'SvenVanCaekenberghe 3/6/2013 16:48'!
testReadFromUTCOffset	
	self assert: (DateAndTime readFrom: '2010-01-05T20:33:14.321Z' readStream) offset isZero.
	self assert: (DateAndTime readFrom: '2010-01-05T20:33:14.321+00' readStream) offset isZero.
	self assert: (DateAndTime readFrom: '2010-01-05T20:33:14.321+0000' readStream) offset isZero.
	self assert: (DateAndTime readFrom: '2010-01-05T20:33:14.321+00:00' readStream) offset isZero.

! !

!DateAndTimeTest methodsFor: 'tests - under design' stamp: 'SvenVanCaekenberghe 3/6/2013 16:41'!
testReadFromSpaceBeforeOffset
	self assert: '2012-07-26 16:38:48 +0200' asDateAndTime offset equals: 2 hour.
	self assert: '2012-07-26 16:38:48 +02' asDateAndTime offset equals: 2 hour.

! !

!DateAndTimeTest methodsFor: 'tests' stamp: 'CamilloBruni 6/7/2013 23:40'!
testAsTime
	| dateAndTime |
	
	dateAndTime := DateAndTime year: 1000 day: 100 hour: 1 minute: 2 second: 3 offset: 0 asDuration.
	self assert: dateAndTime asTime equals: (Time hour: 1 minute: 2 second: 3).
	
	dateAndTime := DateAndTime year: 1000 day: 100 hour: 1 minute: 2 second: 3 offset: 5 hours.
	self assert: dateAndTime asTime equals: (Time hour: 1 minute: 2 second: 3).
	
	dateAndTime := DateAndTime year: 1000 day: 100 hour: 1 minute: 2 second: 3 offset: -5 hours.
	self assert: dateAndTime asTime equals: (Time hour: 1 minute: 2 second: 3).! !

!DateAndTimeTest methodsFor: 'tests' stamp: 'CamilloBruni 6/8/2013 00:26'!
testSecondsSinceMidnightLocalTimeNormalization
	| dateAndTime|
	
	"Check offset: changes from times defined in UTC"
	dateAndTime := DateAndTime year: 1001 day: 101 hour: 0 minute: 1 second: 56 offset: 0 hours.
	dateAndTime := dateAndTime offset: 1 hours.
	self assert: dateAndTime secondsSinceMidnightLocalTime equals: (1*3600) + (1*60) + 56.
	"-1 hours will switch to the previous day"
	dateAndTime := dateAndTime offset: -1 hours.
	self assert: dateAndTime secondsSinceMidnightLocalTime equals: (23*3600) + (1*60) + 56.
	
	dateAndTime := DateAndTime year: 1001 day: 101 hour: 23 minute: 1 second: 56 offset: 0 hours.
	dateAndTime := dateAndTime offset: 1 hours.
	self assert: dateAndTime secondsSinceMidnightLocalTime equals: (0*3600) + (1*60) + 56.
	"-1 hours will switch to the next day"
	dateAndTime := dateAndTime offset: -1 hours.
	self assert: dateAndTime secondsSinceMidnightLocalTime equals: 22*3600 + (1*60) + 56.	
		
		
	
	"Check offset: changes from times defined in +1"
	dateAndTime := DateAndTime year: 1001 day: 101 hour: 0 minute: 1 second: 56 offset: 1 hours.
	dateAndTime := dateAndTime offset: 2 hours.
	self assert: dateAndTime secondsSinceMidnightLocalTime equals: (1*3600) + (1*60) + 56.
	"0 hours will switch to the previous day"
	dateAndTime := dateAndTime offset: 0 hours.
	self assert: dateAndTime secondsSinceMidnightLocalTime equals: (23*3600) + (1*60) + 56.
	dateAndTime := dateAndTime offset: -1 hours.
	self assert: dateAndTime secondsSinceMidnightLocalTime equals: (22*3600) + (1*60) + 56.
	
	
	dateAndTime := DateAndTime year: 1001 day: 101 hour: 23 minute: 1 second: 56 offset: 1 hours.
	"+2 hours will switch to the next day"
	dateAndTime := dateAndTime offset: 2 hours.
	self assert: dateAndTime secondsSinceMidnightLocalTime equals: (0*3600) + (1*60) + 56.
	dateAndTime := dateAndTime offset: 0 hours.
	self assert: dateAndTime secondsSinceMidnightLocalTime equals: (22*3600) + (1*60) + 56.
	dateAndTime := dateAndTime offset: -1 hours.
	self assert: dateAndTime secondsSinceMidnightLocalTime equals: (21*3600) + (1*60) + 56.
! !

!DateAndTimeTest methodsFor: 'tests' stamp: 'SvenVanCaekenberghe 2/19/2014 19:40'!
testReadFromDateOnly
	self 
		assert: '2014-02-19' asDateAndTime translateToUTC printString
		equals: '2014-02-19T00:00:00+00:00'.
	self 
		assert: '2014-02-19Z' asDateAndTime printString
		equals: '2014-02-19T00:00:00+00:00'.
	self 
		assert: '2014-02-19T+07:00' asDateAndTime printString
		equals:  '2014-02-19T00:00:00+07:00'.
	self 
		assert: '2014-02-19 -05:00' asDateAndTime printString
		equals:  '2014-02-19T00:00:00-05:00'.
! !

!DateAndTimeTest methodsFor: 'tests - epoch' stamp: 'PavelKrivanek 7/8/2012 20:01'!
testSqueakEpoch

  self useNonUtcTimeZoneDuring: [ | localEpoch |
    localEpoch := '1901-01-01T00:00:00' asDateAndTime.
    self deny: (DateAndTime epoch = localEpoch).
    self deny: (((DateAndTime fromSeconds: 0) offset: 0) = localEpoch) ].
    
  self useTimeZone: 'UTC' during: [ | localEpoch |
    localEpoch := '1901-01-01T00:00:00' asDateAndTime.
    self assert: DateAndTime epoch equals: localEpoch.
    self assert: ((DateAndTime fromSeconds: 0) offset: 0) equals: localEpoch ].
  
  self assert: DateAndTime epoch equals: '1901-01-01T00:00:00+00:00' asDateAndTime. 
  self assert: ((DateAndTime fromSeconds: 0) offset: 0) equals: '1901-01-01T00:00:00+00:00' asDateAndTime.! !

!DateAndTimeTest methodsFor: 'tests' stamp: 'CamilloBruni 6/8/2013 00:16'!
testSecondsSinceMidnightLocalTime
	| dateAndTime |
	
	dateAndTime := DateAndTime year: 1000 day: 100 hour: 0 minute: 0 second: 56 offset: 0 hours.
	self assert: dateAndTime secondsSinceMidnightLocalTime equals: 56.
	
	dateAndTime := DateAndTime year: 1000 day: 100 hour: 0 minute: 1 second: 56 offset: 0 hours.
	self assert: dateAndTime secondsSinceMidnightLocalTime equals: 60+56.
	
	dateAndTime := DateAndTime year: 1000 day: 100 hour: 1 minute: 0 second: 56 offset: 0 hours.
	self assert: dateAndTime secondsSinceMidnightLocalTime equals: 3600+56.
	
	"1 hour offset"
	dateAndTime := DateAndTime year: 1000 day: 100 hour: 0 minute: 0 second: 56 offset: 1 hours.
	self assert: dateAndTime secondsSinceMidnightLocalTime equals: 56.
	
	dateAndTime := DateAndTime year: 1000 day: 100 hour: 0 minute: 1 second: 56 offset: 1 hours.
	self assert: dateAndTime secondsSinceMidnightLocalTime equals: 60+56.
	
	dateAndTime := DateAndTime year: 1000 day: 100 hour: 1 minute: 0 second: 56 offset: 1 hours.
	self assert: dateAndTime secondsSinceMidnightLocalTime equals: 3600+56.
	
	"-1 hour offset"
	dateAndTime := DateAndTime year: 1000 day: 100 hour: 0 minute: 0 second: 56 offset: -1 hours.
	self assert: dateAndTime secondsSinceMidnightLocalTime equals: 56.
	
	dateAndTime := DateAndTime year: 1001 day: 101 hour: 0 minute: 1 second: 56 offset: -1 hours.
	self assert: dateAndTime secondsSinceMidnightLocalTime equals: 60+56.
	
	dateAndTime := DateAndTime year: 1002 day: 102 hour: 1 minute: 0 second: 56 offset: -1 hours.
	self assert: dateAndTime secondsSinceMidnightLocalTime equals: 3600+56.! !

!DateAndTimeTest methodsFor: 'tests - under design' stamp: 'StephaneDucasse 4/23/2010 22:07'!
testReflexive

	| t |
	t := DateAndTime 
			year: 1 month: 1 day: 2 
			hour: 2 minute: 3 second: 4 nanoSecond: 5 
			offset: 6 hours.
	self assert: t = t.
	
! !

!DateAndTimeTest methodsFor: 'tests' stamp: 'AndyKellens 4/4/2013 09:33'!
testDayOfWeekWithUTC
	| date |
	"Calculating the day of week should take into account the UTC offset"
	date := DateAndTime julianDayNumber: 2456385 offset:(Duration hours:2).
	"Internally, this date gets represented as the julian day 2456384 with seconds 79200 and offset 2 hours"
	"When asking for the day of week, the offset should be taken into account to return the correct day of week"
	self assert: (date dayOfWeek = 3).
	! !

!DateAndTimeTest methodsFor: 'tests' stamp: 'CamilloBruni 6/7/2013 23:40'!
testAsTimeUTC
	| dateAndTime |
	
	dateAndTime := DateAndTime year: 1000 day: 100 hour: 1 minute: 2 second: 3 offset: 0 asDuration.
	self assert: dateAndTime asTimeUTC equals: (Time hour: 1 minute: 2 second: 3).
	
	dateAndTime := DateAndTime year: 1000 day: 100 hour: 1 minute: 2 second: 3 offset: -5 hours.
	self assert: dateAndTime asTimeUTC equals: (Time hour: 6 minute: 2 second: 3).
	
	dateAndTime := DateAndTime year: 1000 day: 100 hour: 1 minute: 2 second: 3 offset: 5 hours.
	self assert: dateAndTime asTimeUTC equals: (Time hour: 24+1-5 minute: 2 second: 3).! !

!DateAndTimeUnixEpochTest commentStamp: 'TorstenBergmann 2/5/2014 08:33'!
Tests for unix epoch of DateAndTime!
!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testAsUTC
	self assert: aDateAndTime asUTC =  aDateAndTime
          ! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:22'!
testMiddleOf
	self assert: (aDateAndTime middleOf: '2:00:00:00' asDuration) = 
	 (Timespan starting: '12-31-1969' asDate duration: 2 days).
	
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:20'!
testHash
	self assert: aDateAndTime hash = (DateAndTime year: 1970 month: 1 day: 1) hash! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testMinute
	self assert: aDateAndTime minute =  0

! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testToByDo
	"self assert: (aDateAndTime to: aDateAndTime + 10 days by: 5 days do: []) =  "
	"MessageNotUnderstood: UndefinedObject>>starting:ending:  where UndefinedObject is Timespan "! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testDaysInMonth
	self assert: aDateAndTime daysInMonth  = 31.

! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:17'!
testDateTime
	self assert: aDateAndTime =  (DateAndTime date: '01-01-1970' asDate time: '00:00:00' asTime)
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:19'!
testFromSeconds
	self assert: aDateAndTime =  (DateAndTime fromSeconds: 2177452800).
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testAsDateAndTime
	self assert: aDateAndTime asDateAndTime =  aDateAndTime
	
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:29'!
testAsSeconds
	self assert: aDateAndTime asSeconds = 2177452800
	
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testDay
	self assert: aDateAndTime day =   DateAndTime new day
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:17'!
testAsYear
	self assert: aDateAndTime asYear =   (Year starting: '01-01-1970' asDate). 
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:28'!
testYearDay
	self assert: aDateAndTime =  (DateAndTime year: 1970 day: 1).
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testToday
	self deny: aDateAndTime =  (DateAndTime today).
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testSeconds
	self assert: aDateAndTime seconds =  0

! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:18'!
testDayMonthYearDo
	|iterations|
	iterations := 0.
	self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear |  iterations := iterations + 1])  = 1.
	self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear |  eachYear])  = 1970.
	self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear |  eachMonth]) = 1.
	self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear |  eachDay]) = 1.
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testCurrent
	self deny: aDateAndTime =  (DateAndTime current).
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:17'!
testAsWeek
	self assert: aDateAndTime asWeek = (Week starting: '12-31-1969' asDate). 

! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testMonth
	self assert: aDateAndTime month  = 1.
	self assert: aDateAndTime monthAbbreviation = 'Jan'.
	self assert: aDateAndTime monthName = 'January'.
	self assert: aDateAndTime monthIndex = 1.! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:31'!
testTo
	self assert: (aDateAndTime to: aDateAndTime) = ((DateAndTime year: 1970 month: 1 day: 1) to: (DateAndTime year: 1970 month: 1 day: 1)) 
	"MessageNotUnderstood: UndefinedObject>>starting:ending:  where UndefinedObject is Timespan "! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:23'!
testPrintOn
	| cs rw |
	cs := '1970-01-01T00:00:00+00:00' readStream.
	rw := ReadWriteStream on: ''.
	aDateAndTime printOn: rw.
	self assert: rw contents = cs contents.
	cs := 'a TimeZone(UTZ)' readStream.
	rw := ReadWriteStream on: ''.
	aTimeZone printOn: rw.
	self assert: rw contents = cs contents! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testDayOfYear
	self assert: aDateAndTime dayOfYear  = 1.

! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testNanoSecond
	self assert: aDateAndTime nanoSecond =  0

! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:23'!
testPlus
	self assert: aDateAndTime + '0:00:00:00' = aDateAndTime.
	self assert: aDateAndTime + 0 = aDateAndTime.
	self assert: aDateAndTime + aDuration = (DateAndTime year: 1970 month: 1 day: 2 hour: 2 minute: 3 second: 4 nanoSecond: 5 offset: 0 hours )
	" I believe this is a bug in the nanosecond part of (DateAndTime >> year:month:day:hour:minute:second:nanoSecond:offset:)"
	
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:28'!
testYear
	self assert: aDateAndTime year = 1970.

	! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:28'!
testYearMonthDayHourMinuteSecond
	self assert: aDateAndTime =  (DateAndTime year: 1970 month: 1 day: 1 hour: 0 minute: 0 second: 0).
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testTommorrow
	self assert: (DateAndTime today + 24 hours) =  (DateAndTime tomorrow).
	self deny: aDateAndTime =  (DateAndTime tomorrow).
     "MessageNotUnderstood: Date class>>starting:"! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testHour12
	self assert: aDateAndTime hour12  = DateAndTime new hour12.
	self assert: aDateAndTime hour12  = 12
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:27'!
testToBy
	self assert: (aDateAndTime to: aDateAndTime + 10 days by: 5 days) = 
				((DateAndTime year: 1970 month: 1 day: 1) to:
				 (DateAndTime year: 1970 month: 1 day: 1) + 10 days by: 5 days ) 
	"MessageNotUnderstood: UndefinedObject>>starting:ending:  where UndefinedObject is Timespan "! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testMinutes
	self assert: aDateAndTime minutes = 0
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testMeridianAbbreviation
	self assert: aDateAndTime meridianAbbreviation = 'AM'.

	! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:30'!
testMinus
	self assert: aDateAndTime - aDateAndTime =  '0:00:00:00' asDuration.
	self assert: aDateAndTime - '0:00:00:00' asDuration = aDateAndTime.
	self assert: aDateAndTime - aDuration =  (DateAndTime year: 1969 month: 12 day: 30 hour: 21 minute: 56 second: 55 nanoSecond: 999999995 offset: 0 hours ).
	" I believe this Failure is a bug in the nanosecond part of (DateAndTime >> year:month:day:hour:minute:second:nanoSecond:offset:)" ! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 16:36'!
testUtcOffset
     self assert: (aDateAndTime offset: '0:12:00:00') =  '1970-01-01T12:00:00+12:00' asDateAndTime! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:24'!
testTicks
	self assert: aDateAndTime ticks =  (DateAndTime julianDayNumber: 2440588) ticks.
	self assert: aDateAndTime ticks = #(2440588 0 0)! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testFirstDayOfMonth
	self assert: aDateAndTime firstDayOfMonth =   1
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testHour
	self assert: aDateAndTime hour =    aDateAndTime hour24.
	self assert: aDateAndTime hour =    0.
	self assert: aDateAndTime hour =    aDateAndTime hours
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testDuration
	self assert: aDateAndTime duration  = 0 asDuration.

! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testSecond
	self assert: aDateAndTime second =  0

! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testAsNanoSeconds
	self assert: aDateAndTime asNanoSeconds =  0 asDuration asNanoSeconds
	
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testMidnight
	self assert: aDateAndTime midnight =  aDateAndTime
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:14'!
testAsDate
	self assert: aDateAndTime asDate =   'January 1, 1970' asDate.

! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testDaysInYear
	self assert: aDateAndTime daysInYear  = 365.

! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testIsLeapYear
	self deny: aDateAndTime isLeapYear
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:21'!
testJulianDayNumber
	self assert: aDateAndTime =  (DateAndTime julianDayNumber: 2440588).
	self assert: aDateAndTime julianDayNumber = 2440588.! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testTicksOffset
	self assert: aDateAndTime =  (aDateAndTime ticks:  #(2415386 0 0) offset: DateAndTime localOffset).
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 20:30'!
testOffset
	self assert: aDateAndTime offset =  '0:00:00:00' asDuration.
     self assert: (aDateAndTime offset: '0:12:00:00') equals:  '1970-01-01T12:00:00+12:00' asDateAndTime! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testYesterday
	self deny: aDateAndTime =  (DateAndTime yesterday).
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 16:51'!
testTimeZone
	self assert: aDateAndTime timeZoneName	= 'Universal Time'.
	self assert: aDateAndTime timeZoneAbbreviation	=  'UTC'

! !

!DateAndTimeUnixEpochTest methodsFor: 'running' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
tearDown
     DateAndTime localTimeZone: localTimeZoneToRestore.
     "wish I could remove the time zones I added earlier, tut there is no method for that"
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:28'!
testYearMonthDayHourMinuteSecondNanosSecondOffset
	self assert: aDateAndTime =  (DateAndTime year: 1970 month: 1 day: 1 hour: 0 minute: 0 second: 0 nanoSecond: 0 offset:0 hours ).
	self assert: ((DateAndTime year: 1 month: 1 day: 1 hour: 0 minute: 0 second: 0 nanoSecond: 0 offset: 0 hours ) +
				(Duration days: 1 hours: 2 minutes: 3 seconds: 4  nanoSeconds: 5) ) =  	
				(DateAndTime year: 1 month: 1 day: 2 hour: 2 minute: 3 second: 4 nanoSecond: 5 offset: 0 hours ) 
	" I believe this is a bug in the nanosecond part of (DateAndTime >> year:month:day:hour:minute:second:nanoSecond:offset:)"" I believe this is a bug in the nanosecond part of (DateAndTime >> year:month:day:hour:minute:second:nanoSecond:offset:)"   
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'CamilloBruni 8/22/2013 19:43'!
testAsMonth
	self 
		assert: aDateAndTime asMonth
		equals: (Month year: 1970 month: 'January'). 
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:18'!
testDayOfWeek
	self assert: aDateAndTime dayOfWeek  = 5.
	self assert: aDateAndTime dayOfWeekAbbreviation = 'Thu'.
	self assert: aDateAndTime dayOfWeekName = 'Thursday'.
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testAsDuration
	self assert: aDateAndTime asDuration =  0 asDuration
	
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 16:36'!
testAsLocal
	self assert: aDateAndTime asLocal =  aDateAndTime.
	self assert: aDateAndTime asLocal = (aDateAndTime offset: aDateAndTime class localOffset)
	
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testAsTime
	self assert: aDateAndTime asTime =  Time midnight.
! !

!DateAndTimeUnixEpochTest methodsFor: 'running' stamp: 'GabrielBarbuto 9/27/2010 10:14'!
setUp
     localTimeZoneToRestore := DateAndTime localTimeZone.
	aDateAndTime :=  DateAndTime localTimeZone: TimeZone default; unixEpoch.
	aTimeZone := TimeZone offset: (Duration minutes: 135) name: 'Unix Epoch Test Time Zone' abbreviation: 'UTZ'.
	aDuration := Duration days: 1 hours: 2 minutes: 3 seconds: 4 nanoSeconds: 5 ! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testDayOfMonth
	self assert: aDateAndTime dayOfMonth  = 1.
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:19'!
testFromString
	self assert: aDateAndTime =  (DateAndTime fromString: ' 1970-01-01T00:00:00+00:00').
	self assert: aDateAndTime =  (DateAndTime fromString: ' 1970-01-01T00:00:00').
	self assert: aDateAndTime =  (DateAndTime fromString: ' 1970-01-01T00:00').
	self assert: aDateAndTime =  (DateAndTime fromString: ' 1970-01-01T00:00:00+00:00').
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:28'!
testYearDayHourMinuteSecond
	self assert: aDateAndTime =  (DateAndTime year: 1970 day: 1 hour: 0 minute: 0 second: 0).
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testNow
	self deny: aDateAndTime =  (DateAndTime now).
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:18'!
testEpoch
	self assert: aDateAndTime =  '1970-01-01T00:00:00+00:00' asDateAndTime
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testLessThan
	self assert: aDateAndTime  < (aDateAndTime + '1:00:00:00').
	self assert: aDateAndTime + -1 < aDateAndTime.
	! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:23'!
testNoon
	self assert: aDateAndTime noon = '1970-01-01T12:00:00+00:00' asDateAndTime! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:28'!
testYearMonthDay
	self assert: aDateAndTime =  (DateAndTime year: 1970 month: 1 day: 1).
! !

!DateAndTimeUnixEpochTest methodsFor: 'tests' stamp: 'GabrielBarbuto 9/27/2010 10:13'!
testDaysLeftInYear
	self assert: aDateAndTime daysLeftInYear  = 364.

! !

!DateError commentStamp: '<historical>'!
A generic error raised when try to instantiate dates.!
!DateModel commentStamp: '<historical>'!
A DateModel is a widget for choosing dates. It consists of:
- A text box, into which you can type any string which can be converted into a Smalltalk date
- A button, which displays a calendar, from which you can select a date

Usage:
- the simplest way is to add a DateModel in your UI, and send #date when you want its value.
- or, register to be notified when the date changes:
	DateModel new
		date: self date;
		whenDateChanged: [ :newDate | self date: newDate ].

As it is Spec-based, it can be easily adapted and composed into a larger UI.!
!DateModel methodsFor: 'private' stamp: 'SeanDeNigris 1/28/2013 14:20'!
onDateChosen: aChoseDate

	aChoseDate calendar delete.
	dateModel text: aChoseDate date asString.! !

!DateModel methodsFor: 'accessing-widgets' stamp: 'SeanDeNigris 1/28/2013 14:17'!
dateModel

	^ dateModel.! !

!DateModel methodsFor: 'private' stamp: 'SeanDeNigris 2/6/2013 15:46'!
chooseDate

	| calendar |
	calendar := CalendarMorph openOn: Date today.
	calendar
		center: calendar cursorPoint;
		fitInWorld;
		onChoiceSend: #onDateChosen: to: self.! !

!DateModel methodsFor: 'initialization' stamp: 'TorstenBergmann 3/4/2015 21:58'!
initializeWidgets

	self instantiateModels: #(
		dateLabel LabelModel
		dateModel TextInputFieldModel
		chooseDateButton ButtonModel).
	
	dateLabel
		label: 'Date'.
		
	dateModel
		text: Date today asString;
		isCodeCompletionAllowed: false.
	
	chooseDateButton
		icon: self iconMorph;
		action: [ self chooseDate ];
		extent: self iconMorph extent.! !

!DateModel methodsFor: 'accessing' stamp: 'SeanDeNigris 6/12/2013 08:51'!
date: aDate

	^ self dateModel text: aDate asString.! !

!DateModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:48'!
displayBlock: aBlock
	"<api: #block getter:#displayBlock registration: #whenDisplayBlockChanged:>"
	"Set the one argument block used to transfrom your date into a string"
	
	displayBlockHolder value: aBlock! !

!DateModel methodsFor: 'initialization' stamp: 'DucasseStephane 9/10/2014 09:59'!
initialize

	displayBlockHolder := [ :object | object asStringOrText ] asValueHolder.
	displayBlockHolder whenChangedDo: [ self date: self date ].
	super initialize. "do this last so default will be set after displayBlock"! !

!DateModel methodsFor: 'private' stamp: 'StephaneDucasse 5/23/2013 18:34'!
iconMorph

	^ ImageMorph new form: Smalltalk ui icons calendarIcon.! !

!DateModel methodsFor: 'accessing' stamp: 'SeanDeNigris 1/28/2013 14:28'!
date

	^ self dateModel getText asDate.! !

!DateModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:13'!
displayBlock
	"<api: #inspect>"
	"Return the one argument block used to wrap your domain specific items.
	The block should return something that can be displayed in a list - like a String or a Text"
	
	^ displayBlockHolder value! !

!DateModel methodsFor: 'accessing-widgets' stamp: 'SeanDeNigris 1/28/2013 14:17'!
chooseDateButton

	^ chooseDateButton.! !

!DateModel methodsFor: 'accessing-widgets' stamp: 'SeanDeNigris 1/28/2013 14:17'!
dateLabel

	^ dateLabel.! !

!DateModel methodsFor: 'api-events' stamp: 'ClementBera 6/28/2013 10:33'!
whenDateChanged: aBlock

	dateModel whenTextChanged: [:newText :oldText :announcement :anAnnouncer || newDate oldDate |
		newDate := Date readFrom: newText readStream.
		oldDate := Date readFrom: oldText readStream.
		aBlock cull: newDate cull: oldDate cull: announcement cull: anAnnouncer ]! !

!DateModel class methodsFor: 'example' stamp: 'TorstenBergmann 3/4/2015 22:03'!
example
	"self example inspect"

	| widget |	
	widget := self new.
	(widget openDialogWithSpec: #spec) modalRelativeTo: self currentWorld.
	^ widget value! !

!DateModel class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/29/2013 16:08'!
spec
	<spec: #default>

	^ SpecLayout composed
			newRow: [ :row | 
				row 
					add: #dateLabel width: 60; 
					"This is to address a not yet fixed Spec issue"
					newRow: [:ugly | 
						ugly
							add: #dateModel;  
							add: #chooseDateButton width: 50 ]] height: 25
			yourself.! !

!DateParser commentStamp: '<historical>'!
Read a Date from the stream based on the pattern which can include the tokens:
	
		y = A year with 1 to n digits (after 2000)
		yy = A year with 2 digits (after 2000)
		yyyy = A year with 4 digits
		m = A month with 1 or 2 digits
		mm = A month with 2 digits
		d = A day with 1 or 2 digits
		dd = A day with 2 digits
		
	...and any other Strings inbetween. Representing $y, $m and $d is done using
	\y, \m and \d and slash itself with \\. Simple example patterns:

		'yyyy-mm-dd'
		'yyyymmdd'
		'yy.mm.dd'
		'y-m-d'!
!DateParser methodsFor: 'parsing - private' stamp: 'HernanWilkinson 11/7/2013 13:25'!
createDate

	^ Date year: year month: month day: day! !

!DateParser methodsFor: 'parsing month - private' stamp: 'HernanWilkinson 11/7/2013 13:11'!
parseMonth

	self isTwoDigitMonthPattern ifTrue: [ ^self parseTwoDigitMonth ].
	self parseVariableDigitMonth ! !

!DateParser methodsFor: 'parsing month - private' stamp: 'CamilleTeruel 11/29/2013 17:17'!
parseVariableDigitMonth

	month := self parse: 'month'! !

!DateParser methodsFor: 'initialization' stamp: 'HernanWilkinson 11/7/2013 13:23'!
initializeReadingFrom: anInputStream pattern: aPattern

	inputStream := anInputStream.
	pattern := aPattern.
	! !

!DateParser methodsFor: 'parsing - private' stamp: 'HernanWilkinson 11/7/2013 13:25'!
isEscape

	^ char = $\! !

!DateParser methodsFor: 'parsing year - private' stamp: 'HernanWilkinson 11/7/2013 13:26'!
isTwoDigitYearPattern

	^ patternStream peekFor: $y! !

!DateParser methodsFor: 'parsing' stamp: 'CamilleTeruel 11/29/2013 17:26'!
parseIfError: aBlock
	"Parse the date according to the given pattern"
	self initializeParsing.
	
	[ self isDoneParsing ] whileFalse: [ self parseNextPattern ].

	self isInvalidPattern ifTrue: aBlock.
	self convertTwoDigitsYear.
	
	(inputStream atEnd and: [ patternStream atEnd ]) ifFalse: [ DateError signal: 'Input doesn''t match given pattern.' ].
	
	^ self createDate! !

!DateParser methodsFor: 'parsing - private' stamp: 'CamilleTeruel 11/29/2013 17:34'!
parse: timeUnitName expectedSize: anInteger
	| extractedString result |
	extractedString := inputStream next: anInteger.
	result := extractedString asInteger.
	(result isNil or: [ extractedString size ~= anInteger ]) 
		ifTrue: [ DateError signal: ' Expect a two digit ', timeUnitName, ', got ', extractedString ].
	^ result! !

!DateParser methodsFor: 'parsing - private' stamp: 'HernanWilkinson 11/7/2013 13:02'!
parseNextPattern

	self readNextChar.

	self isEscape ifTrue: [ ^ self parseEscapePattern ].
	self isYearPattern ifTrue: [ ^ self parseYear ].
	self isMonthPattern ifTrue: [ ^ self parseMonth ].
	self isDayPattern ifTrue: [ ^ self parseDay ].
	
	self parseSameChar! !

!DateParser methodsFor: 'parsing year - private' stamp: 'CamilleTeruel 11/29/2013 17:17'!
parseVariableDigitYear

	year := self parse: 'year'! !

!DateParser methodsFor: 'parsing - private' stamp: 'HernanWilkinson 11/7/2013 13:24'!
initializeParsing

	invalidPattern := false.
	patternStream := pattern readStream! !

!DateParser methodsFor: 'parsing day - private' stamp: 'HernanWilkinson 11/7/2013 13:25'!
isDayPattern

	^ char = $d! !

!DateParser methodsFor: 'parsing year - private' stamp: 'CamilleTeruel 11/29/2013 17:17'!
parseFourDigitYear

	year := self parse: 'year' expectedSize: 4! !

!DateParser methodsFor: 'parsing month - private' stamp: 'CamilleTeruel 11/29/2013 17:17'!
parseTwoDigitMonth

	month := self parse: 'month' expectedSize: 2! !

!DateParser methodsFor: 'parsing - private' stamp: 'HernanWilkinson 11/7/2013 12:29'!
isDoneParsing

	^ patternStream atEnd or: [ inputStream atEnd or: [  invalidPattern  ]]! !

!DateParser methodsFor: 'parsing year - private' stamp: 'HernanWilkinson 11/7/2013 13:07'!
parseYear

	self isFourDigitYearPattern ifTrue: [ ^ self parseFourDigitYear ].
	self isTwoDigitYearPattern ifTrue: [ ^ self parseTwoDigitYear ].
	self parseVariableDigitYear! !

!DateParser methodsFor: 'parsing day - private' stamp: 'HernanWilkinson 11/7/2013 13:25'!
isTwoDigitDayPattern

	^ patternStream peekFor: $d! !

!DateParser methodsFor: 'parsing' stamp: 'CamilleTeruel 11/29/2013 16:52'!
parse
	^ self parseIfError: [ DateError signal ]! !

!DateParser methodsFor: 'parsing - private' stamp: 'HernanWilkinson 11/7/2013 12:32'!
isInvalidPattern

	^ year isNil or: [ month isNil or: [ day isNil or: [ invalidPattern ]]]! !

!DateParser methodsFor: 'parsing year - private' stamp: 'CamilleTeruel 11/29/2013 17:17'!
parseTwoDigitYear

	year := self parse: 'year' expectedSize: 2! !

!DateParser methodsFor: 'parsing day - private' stamp: 'CamilleTeruel 11/29/2013 17:17'!
parseVariableDigitDay

	day := self parse: 'day'! !

!DateParser methodsFor: 'parsing - private' stamp: 'ChristopheDemarey 11/12/2013 14:49'!
convertTwoDigitsYear

	(year between: 0 and: 99) ifTrue: [ year := self currentMillenium + year ]! !

!DateParser methodsFor: 'parsing - private' stamp: 'ChristopheDemarey 11/12/2013 14:48'!
currentMillenium
	^ (Date current year / 100) asInteger * 100! !

!DateParser methodsFor: 'parsing - private' stamp: 'HernanWilkinson 11/7/2013 13:25'!
parseSameChar

	inputStream next = char ifFalse: [ invalidPattern := true ]! !

!DateParser methodsFor: 'parsing year - private' stamp: 'HernanWilkinson 11/7/2013 13:26'!
isFourDigitYearPattern

	^ patternStream nextMatchAll: 'yyy'! !

!DateParser methodsFor: 'parsing - private' stamp: 'HernanWilkinson 11/7/2013 13:25'!
readNextChar

	char := patternStream next! !

!DateParser methodsFor: 'parsing - private' stamp: 'CamilleTeruel 11/29/2013 17:17'!
parse: aTimeUnitName
	^ Integer readFrom: inputStream ifFail: [ DateError signal: 'Expecting a ',aTimeUnitName ]! !

!DateParser methodsFor: 'parsing month - private' stamp: 'HernanWilkinson 11/7/2013 13:25'!
isTwoDigitMonthPattern

	^ patternStream peekFor: $m! !

!DateParser methodsFor: 'parsing - private' stamp: 'HernanWilkinson 11/7/2013 13:02'!
parseEscapePattern

	inputStream next = patternStream next ifFalse: [ invalidPattern := true ]! !

!DateParser methodsFor: 'parsing day - private' stamp: 'HernanWilkinson 11/7/2013 14:26'!
parseDay

	self isTwoDigitDayPattern ifTrue: [ ^ self parseTwoDigitDay ].
	self parseVariableDigitDay! !

!DateParser methodsFor: 'parsing month - private' stamp: 'HernanWilkinson 11/7/2013 13:25'!
isMonthPattern

	^ char = $m! !

!DateParser methodsFor: 'parsing day - private' stamp: 'CamilleTeruel 11/29/2013 17:17'!
parseTwoDigitDay
	day := self parse: 'day' expectedSize: 2! !

!DateParser methodsFor: 'parsing year - private' stamp: 'HernanWilkinson 11/7/2013 13:26'!
isYearPattern

	^ char = $y! !

!DateParser class methodsFor: 'instance creation' stamp: 'HernanWilkinson 11/7/2013 14:23'!
readingFrom: anInputStream pattern: aPattern

	"See class comment for pattern description
	self comment"
	
	^self new initializeReadingFrom: anInputStream pattern: aPattern

! !

!DateParsingTests methodsFor: 'tests - dd pattern' stamp: 'CamilleTeruel 11/29/2013 16:52'!
testParsingDDPatternWithSingleDigitFails
	self assertReading: '4.02.2345' as: 'dd.mm.yyyy' raise: DateError! !

!DateParsingTests methodsFor: 'tests - yyyy pattern' stamp: 'CamilleTeruel 11/29/2013 16:52'!
testParsingYYYYPatternWithWrongNumberOrDigitsShouldFails
	self assertReading: '02.11.3' as: 'dd.mm.yyyy' raise: DateError.
	self assertReading: '02.11.13' as: 'dd.mm.yyyy' raise: DateError.
	self assertReading: '02.11.113' as: 'dd.mm.yyyy' raise: DateError.
	self assertReading: '02.11.10113' as: 'dd.mm.yyyy' raise: DateError! !

!DateParsingTests methodsFor: 'tests - dd pattern' stamp: 'CamilleTeruel 11/29/2013 16:52'!
testParsingDDPatternWithIncorrectDaysFails 
	self assertReading: '02.00.2013' as: 'dd.mm.yyyy' raise: DateError.
	self assertReading: '02.13.2013' as: 'dd.mm.yyyy' raise: DateError.
	! !

!DateParsingTests methodsFor: 'tests - d pattern' stamp: 'CamilleTeruel 11/29/2013 16:20'!
testParsingDPatternWithSingleDigitSucceeds
	self assertReading: '2.11.2013' as: 'd.mm.yyyy' equals: (Date year: 2013 month: 11 day: 2)! !

!DateParsingTests methodsFor: 'tests' stamp: 'CamilleTeruel 11/29/2013 16:52'!
testParsingPatternWithTrailingCharacterFails

	self assertReading: '04.02.2013trailing' as: 'd.m.y' raise: DateError! !

!DateParsingTests methodsFor: 'tests' stamp: 'CamilleTeruel 11/29/2013 15:47'!
testCanEscapeSpecialCharacters
	"Checks that reserved pattern characters $d $m and $y can be escaped in patterns"
	self assertReading: '4d\2m\2345y' as: 'd\d\\m\m\\y\y' equals: (Date year: 2345 month: 2 day: 4)
		
	! !

!DateParsingTests methodsFor: 'asserting' stamp: 'BenjaminVanRyseghem 11/30/2013 15:06'!
reading: aPattern pattern: aString
	^ (self dateParserClass readingFrom: aString readStream pattern: aPattern) parse! !

!DateParsingTests methodsFor: 'tests - y pattern' stamp: 'CamilleTeruel 11/29/2013 16:25'!
testParsingYPatternWithSingleDigitReturnsASecondMillenaryYear
	self assertReading: '2.11.3' as: 'd.mm.y' equals: (Date year: 2003 month: 11 day: 2)! !

!DateParsingTests methodsFor: 'tests - y pattern' stamp: 'CamilleTeruel 11/29/2013 16:36'!
testParsingYPatternWithFiveDigits
	self assertReading: '2.11.10000' as: 'd.mm.y' equals: (Date year: 10000 month: 11 day: 2)! !

!DateParsingTests methodsFor: 'asserting' stamp: 'CamilleTeruel 11/29/2013 15:49'!
assertReading: aString as: aPattern equals: aDate
	self assert: (self reading: aPattern pattern: aString) equals: aDate! !

!DateParsingTests methodsFor: 'tests - d pattern' stamp: 'CamilleTeruel 11/29/2013 16:21'!
testParsingDPatternWithTwoDigitSucceeds 
	self assertReading: '29.11.2013' as: 'd.mm.yyyy' equals: (Date year: 2013 month: 11 day: 29).! !

!DateParsingTests methodsFor: 'asserting' stamp: 'CamilleTeruel 11/29/2013 15:49'!
assertReading: aString as: aPattern raise: anErrorClass

	self
		should: [ self reading: aPattern pattern: aString ]
		raise: anErrorClass
	! !

!DateParsingTests methodsFor: 'accessing' stamp: 'CamilleTeruel 11/29/2013 15:48'!
dateParserClass
	^ DateParser! !

!DateParsingTests methodsFor: 'tests - m pattern' stamp: 'CamilleTeruel 11/29/2013 16:52'!
testParsingMPatternWithIncorrectMonthFails 
	self assertReading: '1.0.2013' as: 'dd.m.yyyy' raise: DateError.
	self assertReading: '22.13.2013' as: 'dd.m.yyyy' raise: DateError.! !

!DateParsingTests methodsFor: 'tests - yy pattern' stamp: 'CamilleTeruel 11/29/2013 16:26'!
testParsingYYPatternReturnsASecondMillenaryYear
	self assertReading: '2.11.13' as: 'd.mm.yy' equals: (Date year: 2013 month: 11 day: 2)! !

!DateParsingTests methodsFor: 'tests - yy pattern' stamp: 'CamilleTeruel 11/29/2013 17:19'!
testParsingYYPatternWithWrongNumberOrDigitsShouldFails
	self assertReading: '02.11.3' as: 'dd.mm.yy' raise: DateError.
	self assertReading: '02.11.113' as: 'dd.mm.yy' raise: DateError! !

!DateParsingTests methodsFor: 'tests - mm pattern' stamp: 'CamilleTeruel 11/29/2013 16:52'!
testParsingMMPatternWithIncorrectMonthFails 
	self assertReading: '02.00.2013' as: 'dd.mm.yyyy' raise: DateError.
	self assertReading: '02.13.2013' as: 'dd.mm.yyyy' raise: DateError! !

!DateParsingTests methodsFor: 'tests - m pattern' stamp: 'CamilleTeruel 11/29/2013 16:54'!
testParsingMPatternWithSingleDigitSucceeds 
	| date |
	date := Date year: 2013 month: 2 day: 11.
	self assertReading: '11.2.2013' as: 'dd.m.yyyy' equals: date.
	self assertReading: '2.2013.11' as: 'm.yyyy.dd' equals: date.
	self assertReading: '11.2013.2' as: 'dd.yyyy.m' equals: date! !

!DateParsingTests methodsFor: 'tests' stamp: 'CamilleTeruel 11/29/2013 16:52'!
testParsingPatternWithExtraCharacter

	self assertReading: 'a4.2.2345' as: 'ad.m.y' equals: (Date year: 2345 month: 2 day: 4). 
	self assertReading: '4.2.2345' as: 'ad.m.y' raise: DateError.
	self assertReading: 'a4.2.2345' as: 'd.m.y' raise: DateError.! !

!DateParsingTests methodsFor: 'tests - y pattern' stamp: 'CamilleTeruel 11/29/2013 16:26'!
testParsingYPatternWithTwoDigitsReturnsASecondMillenaryYear
	self assertReading: '2.11.13' as: 'd.mm.y' equals: (Date year: 2013 month: 11 day: 2)! !

!DateParsingTests methodsFor: 'tests' stamp: 'CamilleTeruel 11/29/2013 16:48'!
testDefaultParsingSucceeds 
	| date |
	date := Date year: 2013 month: 11 day: 29.
	self assertReading: '29.11.2013' as: 'dd.mm.yyyy' equals: date.
	self assertReading: '29.11.2013' as: 'd.m.y' equals: date.
	self assertReading: '29.11.13' as: 'd.m.y' equals: date! !

!DateParsingTests methodsFor: 'tests - mm pattern' stamp: 'CamilleTeruel 11/29/2013 16:52'!
testParsingMMPatternWithSingleDigitFails
	self assertReading: '04.2.2345' as: 'dd.mm.yyyy' raise: DateError! !

!DateParsingTests methodsFor: 'tests - m pattern' stamp: 'CamilleTeruel 11/29/2013 16:12'!
testParsingMPatternWithTwoDigitSucceeds 
	| date |
	date := Date year: 2013 month: 11 day: 29.
	self assertReading: '29.11.2013' as: 'dd.m.yyyy' equals: date.
	self assertReading: '11.2013.29' as: 'm.yyyy.dd' equals: date.
	self assertReading: '29.2013.11' as: 'dd.yyyy.m' equals: date.! !

!DateParsingTests methodsFor: 'tests - d pattern' stamp: 'CamilleTeruel 11/29/2013 16:52'!
testParsingDPatternWithIncorrectDayFails 
	self assertReading: '0.11.2013' as: 'd.mm.yyyy' raise: DateError.
	self assertReading: '32.2013.29' as: 'd.mm.yyyy' raise: DateError.! !

!DatePrintFormatTester commentStamp: '<historical>'!
I am a helper object used for validating formatted Date strings.

!
!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
shouldnt: aBlock
	self deny: aBlock value
			! !

!DatePrintFormatTester methodsFor: 'extensions' stamp: ''!
skip: aComment
	"Don't run this test, and don't mark it as failure"
	TestSkip signal: aComment! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
shouldnt: aBlock raise: anExceptionalEvent description: aString  
 
	^self
		assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) not
		description: aString
			! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
deny: aBooleanOrBlock

	self assert: aBooleanOrBlock value not
			! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
assert: aBooleanOrBlock description: aString resumable: resumableBoolean 
	| exception |
	aBooleanOrBlock value
		ifFalse: 
			[self classForTestResult failure new
				isResumable: resumableBoolean;
				signal: aString]
			! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
deny: aBooleanOrBlock description: aString
	self assert: aBooleanOrBlock value not description: aString
			! !

!DatePrintFormatTester methodsFor: 'private' stamp: ''!
comparingStringBetween: actual and: expected

	^ String streamContents: [:stream |
			stream
				nextPutAll: 'Got ';
				nextPutAll: actual fullPrintString;
				nextPutAll: ' instead of ';
				nextPutAll: expected fullPrintString;
				nextPutAll: '.']! !

!DatePrintFormatTester methodsFor: 'accessing' stamp: 'SeanDeNigris 6/20/2012 03:19'!
date: aDate 

	date := aDate.! !

!DatePrintFormatTester methodsFor: 'printing' stamp: 'SeanDeNigris 6/20/2012 03:33'!
printFormat

	^ date printFormat: { dayPosition. monthPosition. yearPosition. delimiter. monthType. yearType }.! !

!DatePrintFormatTester methodsFor: 'accessing' stamp: 'SeanDeNigris 6/20/2012 03:25'!
delimiter: aCharacter 

	delimiter := aCharacter.! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: 'SeanDeNigris 6/20/2012 03:51'!
yearType: aNumber shouldPrintAs: aString 

	| actual tokens isMonthMissing yearTokenIndex |
	yearType := aNumber.
	tokens := self tokens.
	isMonthMissing := tokens size = 2.
	yearTokenIndex := isMonthMissing
		ifTrue: [ 2 ]
		ifFalse: [ 3 ].
	actual := tokens at: yearTokenIndex.
	
	self assert: actual equals: aString.! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
executeShould: aBlock inScopeOf: anExceptionalEvent 
	^[aBlock value.
 	false] on: anExceptionalEvent
		do: [:ex | ex return: true]
			! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: 'SeanDeNigris 6/20/2012 03:43'!
monthType: aNumber shouldPrintAs: aString 

	| actual |
	monthType := aNumber.
	actual := self tokens at: monthPosition.
	self assert: actual equals: aString.! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
assert: aBooleanOrBlock description: aStringOrBlock
	aBooleanOrBlock value ifFalse: [
		| message |
		message := aStringOrBlock value.
		self classForTestResult failure signal: message]
			! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
should: aBlock raise: anExceptionalEvent whoseDescriptionDoesNotInclude: subString description: aString 
	^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionNotContaining: subString)
		description: aString
! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
should: aBlock
	self assert: aBlock value
			! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
should: aBlock raise: anException withExceptionDo: anotherBlock 

	^self assert: (self executeShould: aBlock inScopeOf: anException withExceptionDo: anotherBlock)! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
shouldnt: aBlock raise: anExceptionalEvent whoseDescriptionDoesNotInclude: subString description: aString 
	 
	^self
		assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionNotContaining: subString) not
		description: aString
! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
shouldnt: aBlock raise: anExceptionalEvent whoseDescriptionIncludes: subString description: aString  
	 
	^self 
		assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionContaining: subString) not
		description: aString
! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
should: aBlock raise: anExceptionalEvent 
	^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent)
			! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
signalFailure: aString
	self classForTestResult failure signal: aString! !

!DatePrintFormatTester methodsFor: 'accessing' stamp: 'SeanDeNigris 6/20/2012 03:31'!
monthType: anInteger 

	monthType := anInteger.! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: 'SeanDeNigris 6/20/2012 03:33'!
shouldEqual: expectedOutputString 

	self assert: self printFormat equals: expectedOutputString.
! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
assert: aBoolean

	aBoolean ifFalse: [self signalFailure: 'Assertion failed']
			! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
should: aBlock raise: anExceptionalEvent description: aString 
	^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent)
		description: aString
			! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionNotContaining: aString
	^[aBlock value.
 	false] on: anExceptionalEvent
		do: [:ex | ex return: (ex description includesSubstring: aString) not ]
			! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
shouldFix: aBlock 
	"Run the block expecting an Exception. Throw an assertion failure if the block does NOT throw an exception."
	^self should: aBlock raise: Exception! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
should: aBlock description: aString
	self assert: aBlock value description: aString
			! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
shouldnt: aBlock description: aString
	self deny: aBlock value description: aString
			! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
skip
	"Don't run this test, and don't mark it as failure"
	TestSkip signal! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
shouldnt: aBlock raise: anExceptionalEvent  
	 
	^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) not
			! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
assert: actual equals: expected
	^ self
		assert: expected = actual
		description: [self comparingStringBetween: actual and: expected]! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
executeShould: aBlock inScopeOf: anException withExceptionDo: anotherBlock

	^[aBlock value.
 	false] 
		on: anException
		do: [:exception | 
			anotherBlock value: exception.
			exception return: true]! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
classForTestResult
	"Returns the class of the test result"
	^ TestResult! !

!DatePrintFormatTester methodsFor: 'private' stamp: ''!
comparingCollectionBetween: left and: right
	| additionalLeft additionalRight sortBlock|
	
	"use a very slow sort block"
	sortBlock := [ :a :b | a asString <= b asString ].
	additionalLeft := (left difference: right) sorted: sortBlock.
	additionalRight := (right difference: left) sorted: sortBlock. 
	
	^ String streamContents: [:stream |
		stream
			nextPutAll: 'Given Collections do not match. Got '; lf;
			tab; nextPutAll: 'left := '; print: left; nextPut: $.; lf;
			nextPutAll: ' instead of ';
			tab; nextPutAll: ' right :='; print: left; nextPut: $.; lf.
		left size = right size
			ifFalse: [ 
				stream 
					nextPutAll: 'Collection size does not match: left='; 
					print: left size;
					nextPutAll: ' vs. right=';
					print: right size; lf ].
		additionalLeft isEmpty
			ifFalse: [ 
				stream 
					nextPutAll: 'Got ';
					print: additionalLeft size;
					nextPutAll: ' additional element(s) in the left collection: ';
					tab; print: additionalLeft  ].
		additionalRight isEmpty
			ifFalse: [ 
				stream 
					nextPutAll: 'Got ';
					print: additionalRight size;
					nextPutAll: ' additional element(s) in the right collection: ';
					tab; print: additionalRight  ]]! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
should: aBlock notTakeMoreThan: aDuration
    "Evaluate aBlock and if it takes more than given duration
    to run we report a test failure. "

	^ aBlock valueWithin: aDuration onTimeout: [
		self 
			assert: false 
			description: ['Block evaluation took more than the expected <1p>' expandMacrosWith: aDuration]
	]
	
! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
deny: aBooleanOrBlock description: aString resumable: resumableBoolean 
	self
		assert: aBooleanOrBlock value not
		description: aString
		resumable: resumableBoolean
			! !

!DatePrintFormatTester methodsFor: 'private' stamp: 'SeanDeNigris 6/20/2012 03:20'!
dayPosition: dayPos monthPosition: moPos yearPosition: yrPos delimiter: aCharacter monthType: moType yearType: yrType 

	dayPosition := dayPos.
	monthPosition := moPos.
	yearPosition := yrPos.
	delimiter := aCharacter.
	monthType := moType.
	yearType := yrType.
	^ self.! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionContaining: aString
	^[aBlock value.
 	false] on: anExceptionalEvent
		do: [:ex | ex return: (ex description includesSubstring: aString) ]
			! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
assertCollection: actual equals: expected
	"Specialized test method that generates a proper error message for collection"
	^ self
		assert: expected = actual
		description: [ self comparingCollectionBetween: actual and: expected ]! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
assertCollection: actual hasSameElements: expected
	"Assert that a collection contains the same elements as the given collection. Order is not checked, only the presence/absence of elements."
	| missingElements additionalElements |
	
	additionalElements := actual difference: expected.
	missingElements := expected difference: (actual intersection: expected).
	self 
		assert: (additionalElements isEmpty and: [ missingElements isEmpty ])
		description: (String streamContents: 
			[:stream |
			stream
				nextPutAll: 'Given Collections do not match!!'; lf;
				tab; nextPutAll: 'additions : '; print: additionalElements asArray; lf;
				tab; nextPutAll: 'missing: '; print: missingElements asArray; lf ])! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
should: aBlock raise: anExceptionalEvent whoseDescriptionIncludes: subString description: aString 
	^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionContaining: subString)
		description: aString
! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: 'SeanDeNigris 6/20/2012 03:42'!
tokens

	^ self printFormat findTokens: { delimiter }.! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
fail

	^self assert: false! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
skipUnless: aBooleanOrBlock
	" If the assumption in aBooleanOrBlock is not true, abandon the running test
	and mark it as passed. "
	aBooleanOrBlock value ifFalse:
			[ TestSkip signal: 'Assumption in #skipUnless: failed' ]! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
should: aBlock notTakeMoreThanMilliseconds: anInteger
    "For compatibility with other Smalltalks"

   self should: aBlock notTakeMoreThan: (Duration milliSeconds: anInteger).! !

!DatePrintFormatTester methodsFor: 'asserting' stamp: ''!
fail: aDescriptionString

	^self assert: false description: aDescriptionString! !

!DatePrintFormatTester class methodsFor: 'instance creation' stamp: 'SeanDeNigris 6/20/2012 03:17'!
on: aDate

	^ self new date: aDate.! !

!DateTest commentStamp: 'brp 7/26/2003 16:58'!
This is the unit test for the class Date. !
!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 02:40'!
testInquiries

	self	
		assert: june2nd1973 dayOfMonth equals: 2;
		assert: june2nd1973 dayOfYear equals: 153;
		assert: june2nd1973 daysInMonth equals: 30;
		assert: june2nd1973 daysInYear equals: 365;
		assert: june2nd1973 daysLeftInYear equals: (365 - 153);
		assert: june2nd1973 firstDayOfMonth equals: 152.
! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 01:49'!
testDaysInMonthForYear

	self assert: (Date daysInMonth: #February forYear: 2008) equals: 29.	
	self assert: (Date daysInMonth: #February forYear: 2000) equals: 29.	
	self assert: (Date daysInMonth: #February forYear: 2100) equals: 28.	
	self assert: (Date daysInMonth: #July forYear: 2100) equals: 31.	! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 03:55'!
testPrintOnFormat

	| expected stream |
	expected := '04*Jan*23'.
	stream := ReadWriteStream on: ''.
	january23rd2004 
		printOn: stream
		format: #(3 2 1 $* 2 2).
	self assert: stream contents equals: expected.! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 02:14'!
testAddMonths

	self assert: (january23rd2004 addMonths: 0) equals: '2004-01-23' asDate.
	self assert: (january23rd2004 addMonths: 1) equals: '2004-02-23' asDate.
	self assert: (january23rd2004 addMonths: 12) equals: '2005-01-23' asDate.! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 02:46'!
testNext

	| nextDay |
	nextDay := june2nd1973 next.
	self assert: nextDay equals: '3 June, 1973' asDate.! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 04:07'!
testSubtractDays

	self assert: (january23rd2004 subtractDays: 0) equals: '2004-01-23' asDate.	
	self assert: (january23rd2004 subtractDays: 30) equals: '2003-12-24' asDate.! !

!DateTest methodsFor: 'helpers' stamp: ''!
restoreLocalTimeZoneAfter: aBlock

	| realTimeZone |
	realTimeZone := DateAndTime localTimeZone.
	aBlock ensure: [ DateAndTime localTimeZone: realTimeZone ].! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 02:47'!
testPrevious

	| previousDay |
	previousDay := june2nd1973 previous.
	self assert: previousDay equals: '1 June, 1973' asDate.! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 01:46'!
testComparing

	| sameDate laterDate earlierDate |
	sameDate := june2nd1973 asString asDate.
	laterDate := june2nd1973 + 1 day.
	earlierDate := june2nd1973 - 1 day.

	self
		assert: june2nd1973 equals: sameDate;
		assert: june2nd1973 equals: june2nd1973 copy;
		assert: june2nd1973 hash equals: sameDate hash.
	self 
		assert: june2nd1973 < laterDate;
		assert: june2nd1973 > earlierDate.
! !

!DateTest methodsFor: 'tests' stamp: 'CamilloBruni 7/17/2012 08:32'!
testFromSeconds

	| d |
	d := self dateClass fromSeconds: june2nd1973 asSeconds. 
	self assert: d equals: june2nd1973.
! !

!DateTest methodsFor: 'private' stamp: 'brp 8/24/2003 00:10'!
dateClass

	^ Date! !

!DateTest methodsFor: 'tests' stamp: 'CamilloBruni 7/13/2012 21:14'!
testAsSeconds

	| secondsSinceEpoch dateUTC dateEDT datePST |
	self useTimeZone: 'UTC' during: [
		dateUTC := Date readFrom: '01-23-2004' readStream.
		secondsSinceEpoch := (dateUTC start - DateAndTime epoch) asSeconds.
		self assert: dateUTC asSeconds equals: secondsSinceEpoch.
		self assert: (Date fromSeconds: dateUTC asSeconds) equals: dateUTC ].
	
	self useTimeZone: 'EDT' during: [
		dateEDT := Date readFrom: '01-23-2004' readStream.
		secondsSinceEpoch := (dateEDT start - DateAndTime epoch) asSeconds.
		self assert: dateEDT asSeconds equals: secondsSinceEpoch.
		self assert: (Date fromSeconds: dateEDT asSeconds) equals: dateEDT ].
	
	self useTimeZone: 'PST' during: [
		datePST := Date readFrom: '01-23-2004' readStream.
		secondsSinceEpoch := (datePST start - DateAndTime epoch) asSeconds.
		self assert: datePST asSeconds equals: secondsSinceEpoch.
		self assert: (Date fromSeconds: datePST asSeconds) equals: datePST ].
	
	self assert: dateUTC asSeconds  equals: dateEDT asSeconds - (4*3600).
	self assert: dateUTC asSeconds  equals: datePST asSeconds - (8*3600).	! !

!DateTest methodsFor: 'tests' stamp: 'MarcusDenker 2/16/2015 15:19'!
testAccessing

	self	
		assert: june2nd1973 day equals: 153;
		assert: june2nd1973 julianDayNumber equals: 2441836;
		assert: june2nd1973 monthIndex equals: 6;
		assert: june2nd1973 monthName equals: #June;
		assert: june2nd1973 weekday equals: #Saturday;
		assert: june2nd1973 weekdayIndex equals: 7;
		assert: june2nd1973 year equals: 1973.
! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 04:00'!
testStarting

	| aDateAndTime anyTime |
	anyTime := '13:12' asTime.
	aDateAndTime := DateAndTime date: january23rd2004 time: anyTime.
	self assert: (Date starting: aDateAndTime) equals: january23rd2004.  ! !

!DateTest methodsFor: 'tests' stamp: 'MarcusDenker 4/25/2013 15:08'!
testStoring

	| expected actual |
	expected := '''2 June 1973'' asDate'.
	actual := june2nd1973 storeString.
	self	
		assert: actual equals: expected;
		assert: (Smalltalk evaluate: expected) equals: june2nd1973. "Evaluating expected to avoid surprises when evaluating"
! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 04:06'!
testSubtractDate

	self assert: (january23rd2004 subtractDate: january23rd2004 previous) equals: 1.	
	self assert: (january23rd2004 subtractDate: january23rd2004) equals: 0.	
	self assert: (january23rd2004 subtractDate: january23rd2004 next) equals: -1.	
! !

!DateTest methodsFor: 'helpers' stamp: 'CamilloBruni 11/4/2013 08:42'!
epoch

	^ Date year: 1901 month: 1 day: 1! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 01:43'!
testDayMonthYearDo
	
	january23rd2004 dayMonthYearDo: [ :day :month :year | 
		self assert: day equals: 23.
		self assert: month equals: 1.
		self assert: year equals: 2004 ].! !

!DateTest methodsFor: 'helpers' stamp: ''!
useNonUtcTimeZoneDuring: aBlock

	self useTimeZone: 'EDT' during: aBlock.! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 03:54'!
testPrintOn

	| expected stream |
	expected := '23 January 2004'.
	stream := ReadWriteStream on: ''.
	january23rd2004 printOn: stream.
	self assert: stream contents equals: expected.! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 04:10'!
testYyyymmdd

	self assert: january23rd2004 yyyymmdd equals: '2004-01-23'! !

!DateTest methodsFor: 'tests' stamp: 'PavelKrivanek 12/19/2012 12:56'!
testPrintFormat

	| format monthTypes |
	format := DatePrintFormatTester on: january23rd2004.
	format dayPosition: 1 monthPosition: 2 yearPosition: 3 delimiter: $/ monthType: 1 yearType: 1.
	format shouldEqual: '23/1/2004'.
	
	format delimiter: $-.
	format shouldEqual: '23-1-2004'.
	
	format	monthType: 1 shouldPrintAs: 1 asString "index".
	format monthType: 2 shouldPrintAs: 'Jan'.
	format monthType: 3 shouldPrintAs: 'January'.
	
	"Out of range month types leave month blank"
	format monthType: 4.
	format shouldEqual: '23--2004' "no month".

	format	yearType: 1 shouldPrintAs: '2004'.
	format yearType: 2 shouldPrintAs: '04'.
	
	"Out of range year types -> short year"
	format yearType: 3 shouldPrintAs: '04'.
	
	"Usage examples"
	self 
		assert: june2nd1973 mmddyyyy = '6/2/1973';
		assert: june2nd1973 yyyymmdd = '1973-06-02';
		assert: (june2nd1973 printFormat: #(3 1 2 $!! 2 1 1)) = '1973!!2!!Jun';
		assert: (june2nd1973 printFormat: #(1 2 3 0 1 1 2)) = '02061973';		
		assert: (june2nd1973 printFormat: #(2 1 3 0 1 1 2)) = '06021973';		
		assert: (june2nd1973 printFormat: #(3 2 1 0 1 1 2)) = '19730602';
		assert: (june2nd1973 printFormat: #(1 2 3 0 1 1 1)) = '261973'.! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 02:45'!
testPreviousByName

	self assert: (january23rd2004 previous: #Friday) equals: '2004-01-16' asDate.

! !

!DateTest methodsFor: 'tests' stamp: 'CamilloBruni 7/17/2012 17:22'!
testFromDays

	| march18th1627 epochFromDays june2nd1973FromDays march18th1627FromDays january23rd2004FromDays |

	epochFromDays := self dateClass fromDays: 0.
	self assert: epochFromDays equals: (self epoch translateTo: 0).

	june2nd1973FromDays := self dateClass fromDays: (june2nd1973 - self epoch) asDays.
	self assert: june2nd1973FromDays equals: (june2nd1973 translateTo: 0).

	march18th1627 := '18 March 1627' asDate.
	march18th1627FromDays := self dateClass fromDays: (march18th1627 - self epoch) asDays.
	self assert: march18th1627FromDays equals: (march18th1627 translateTo: 0).
	
	january23rd2004FromDays := self dateClass fromDays: 103*365 "years" + 22 "days since Jan 1" + 25 "leap days".
	self assert: january23rd2004FromDays equals: (january23rd2004 translateTo: 0).	! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 02:29'!
testNameOfDay

	| dayNames firstDayName |
	
	firstDayName := self dateClass nameOfDay: 1.
	self assert: firstDayName equals: #Sunday.
	
	dayNames := #(#Sunday #Monday #Tuesday #Wednesday #Thursday #Friday #Saturday).
	(1 to: 7) do: [ :i | | dayName |
		dayName := self dateClass nameOfDay: i.
		self assert: dayName equals: (dayNames at: i) ].! !

!DateTest methodsFor: 'coverage' stamp: 'brp 7/27/2003 13:01'!
classToBeTested

	^ self dateClass! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 01:51'!
testEqual

	self assert: january23rd2004 = 'January 23, 2004' asDate.! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 04:09'!
testTomorrow

	"Not a great test: could falsely fail if midnight come in between the two executions"
	self assert: Date tomorrow equals: Date today + 1 day.! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 03:58'!
testReadFrom

	| s1 s2 s3 s4 s5 | 
	s1 := '2 June 1973' readStream.
	s2 := '2-JUN-73' readStream.
	s3 := 'June 2, 1973' readStream.
	s4 := '6/2/73' readStream.
	s5 := '2JUN73' readStream.

	self	
		assert: (self dateClass readFrom: s1) equals: june2nd1973;
		assert: (self dateClass readFrom: s2) equals: june2nd1973;
		assert: (self dateClass readFrom: s3) equals: june2nd1973;
		assert: (self dateClass readFrom: s4) equals: june2nd1973.! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 02:42'!
testMmddyyyy
	self assert: january23rd2004 mmddyyyy equals: '1/23/2004'! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 01:50'!
testDuration

	self assert: january23rd2004 duration equals: 24 hours.! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 01:46'!
testAsDate

	self assert: january23rd2004 asDate equals: january23rd2004.! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 01:49'!
testDaysInYear

	self assert: (Date daysInYear: 2000) equals: 366.	
	self assert: (Date daysInYear: 2008) equals: 366.	
	self assert: (Date daysInYear: 2100) equals: 365	
! !

!DateTest methodsFor: 'tests' stamp: 'CamilloBruni 7/17/2012 17:18'!
testJulianDayNumber

	self assert: (january23rd2004 translateTo: 0) equals: (Date julianDayNumber: ((4713+2004)*365 +1323) offset: 0 hour).! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 04:09'!
testYesterday

	"Not a great test: could falsely fail if midnight come in between the two executions"
	self assert: Date yesterday equals: Date today - 1 day.
! !

!DateTest methodsFor: 'tests' stamp: 'MarcusDenker 2/16/2015 15:20'!
testIsLeapYear 

	| dateInLeapYear dateInNonLeapYear |
	dateInLeapYear := january23rd2004.
	dateInNonLeapYear := dateInLeapYear + 365 days.
	self assert: dateInLeapYear isLeapYear equals: true.
	self assert: dateInNonLeapYear isLeapYear equals: false.


! !

!DateTest methodsFor: 'coverage' stamp: 'brp 1/30/2005 09:03'!
selectorsToBeIgnored

	 | deprecated private special |
	deprecated := #().
	private := #().
	special := #( #< #= #new #next #previous #printOn: #printOn:format: #storeOn: #fromString: ).

	^ super selectorsToBeIgnored, deprecated, private, special! !

!DateTest methodsFor: 'tests' stamp: 'CamilloBruni 8/22/2013 19:46'!
testNewDayMonthYear

	self assert: (Date year: 2004 month: 1 day: 23) equals: january23rd2004.	
! !

!DateTest methodsFor: 'helpers' stamp: ''!
useTimeZone: abbreviation during: aBlock

  | timeZone |
  timeZone := TimeZone abbreviated: abbreviation.
  self restoreLocalTimeZoneAfter: [ 
    DateAndTime localTimeZone: timeZone. 
    aBlock cull: timeZone ].! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 02:27'!
testDayOfWeek

	| dayNames sundayIndex |
	
	sundayIndex := self dateClass dayOfWeek: #Sunday.
	self assert: sundayIndex equals: 1.
	
	dayNames := #(#Sunday #Monday #Tuesday #Wednesday #Thursday #Friday #Saturday).
	dayNames doWithIndex: [ :e :i | | dayIndex |
		dayIndex := self dateClass dayOfWeek: e.
		self assert: dayIndex equals: i ].! !

!DateTest methodsFor: 'tests' stamp: 'TorstenBergmann 8/20/2014 13:15'!
testFromString
 	"The fromString method requires month, day and year delemited by a valid date delimiter"
	
	| d |
	d := self dateClass fromString: '06.02.1973'. 
	self assert: d equals: june2nd1973.
 
	d := self dateClass fromString: '06-02-1973'. 
	self assert: d equals: june2nd1973.

	d := self dateClass fromString: '06/02/1973'. 
	self assert: d equals: june2nd1973.	! !

!DateTest methodsFor: 'tests' stamp: 'CamilloBruni 11/4/2013 08:41'!
testNew
	| instance epoch |
	instance := self dateClass new.
	epoch := self epoch.
	"We have to be careful, since #new creates a Date for midnight in the local timezone, whereas #epoch is based on a fixed time in UTC"
	instance offset negative 
		ifTrue: [ epoch := epoch - 1 day ]. 
	self
		assert: instance
		equals: epoch.! !

!DateTest methodsFor: 'running' stamp: 'CamilloBruni 8/22/2013 19:49'!
setUp

	june2nd1973 := self dateClass year: 1973 day: 153.
	january23rd2004 := Date readFrom: '01-23-2004' readStream.
	aTime := Time readFrom: '12:34:56 pm' readStream! !

!DateTest methodsFor: 'tests' stamp: 'CamilloBruni 8/22/2013 19:49'!
testNewDayYear

	self assert: (Date year: 2004 day: 23) equals: january23rd2004	
! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 01:46'!
testArithmetic

	| laterDate |
	laterDate := june2nd1973 addDays: 32.

	self 
		assert: (laterDate subtractDate: june2nd1973) equals: 32;
		assert: (june2nd1973 subtractDate: laterDate) equals: -32;
		assert: (laterDate subtractDays: 32) equals: june2nd1973.
! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 01:45'!
testAddDays

	self assert: (january23rd2004 addDays: 0) equals: '2004-01-23' asDate.	
	self assert: (january23rd2004 addDays: 31) equals: '2004-02-23' asDate.
	self assert: (january23rd2004 addDays: 366) equals: '2005-01-23' asDate.! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 01:51'!
testFirstWeekdayOfMonthYear

	self assert: (Date firstWeekdayOfMonth: 'January' year: 2004) equals: 5.	
! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 02:22'!
testIndexOfMonth

	self assert: (Date indexOfMonth: #January) equals: 1.	
	self assert: (Date indexOfMonth: #December) equals: 12.
	
	self should: [ Date indexOfMonth: #NonExistantMonth ] raise: Error.! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 04:09'!
testWeekday

	self assert: january23rd2004 weekday equals: #Friday.	
	self assert: january23rd2004 weekdayIndex equals: 6.! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 02:20'!
testNameOfMonth

	self assert: (Date nameOfMonth: 1) equals: #January.	
	self assert: (Date nameOfMonth: 12) equals: #December.

	self should: [ Date nameOfMonth: 0 ] raise: SubscriptOutOfBounds.
	self should: [ Date nameOfMonth: 13 ] raise: SubscriptOutOfBounds.
! !

!DateTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/20/2012 04:01'!
testStoreOn

	| expected stream |
	expected := '''23 January 2004'' asDate'.
	stream := ReadWriteStream on: ''.
	january23rd2004 storeOn: stream.
	self assert: stream contents equals: expected.! !

!DebugAction commentStamp: '<historical>'!
A DebugAction is the entry point for creating debugging actions.

A new debugging action is created by subclassing it and implementing, by default, the method executeAction (This can be configured by using the method actionSelector).  An id must also be provided uniquely identifying the action among all the others.

The initialize method should only set default values or initialize attributes that are independent of the debugger or session. The others must be initilized in the method forDebugger:.

A debugging action has the following lifecycle: 
	- the action is created using #new and #initialized is called
	- #appliesToDebugger:, and for contextual actions #appliesToContext: are called
	- if the actions applies to the current situation #forDebugger: is used to set the debugger
	- #execute is called when the user triggers the action.
	- when the debugger updates its action this process is repeated.!
!DebugAction methodsFor: 'accessing' stamp: 'AndreiChis 7/3/2013 17:31'!
category: anObject

	category := anObject! !

!DebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/20/2013 15:58'!
enabled

	^ true! !

!DebugAction methodsFor: 'accessing-context' stamp: 'AndreiChis 9/18/2013 10:53'!
currentContext

	^ self debugger currentContext! !

!DebugAction methodsFor: '*spec-debugger' stamp: 'AndreiChis 9/25/2013 17:16'!
specId

	^ (self id, 'SpecId') asSymbol! !

!DebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/18/2013 18:59'!
needsUpdate

	^ needsUpdate ifNil: [ true ]! !

!DebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/17/2013 19:20'!
defaultIcon

	^ self class defaultIcon! !

!DebugAction methodsFor: 'accessing' stamp: 'AndreiChis 6/17/2013 16:16'!
debugger: anObject

	debugger := anObject! !

!DebugAction methodsFor: 'testing' stamp: 'AndreiChis 9/18/2013 17:25'!
appliesToCurrentContext

	^ self appliesToContext: self currentContext ! !

!DebugAction methodsFor: 'accessing' stamp: 'AndreiChis 7/3/2013 17:31'!
needsUpdate: aBoolean

	needsUpdate := aBoolean! !

!DebugAction methodsFor: 'testing' stamp: 'AndreiChis 9/20/2013 17:12'!
appliesToDebugger: aDebugger

	^ true! !

!DebugAction methodsFor: 'testing' stamp: 'AndreiChis 6/10/2013 18:44'!
appliesToContext: aContext

	^ true! !

!DebugAction methodsFor: 'accessing' stamp: 'AndreiChis 8/7/2013 19:08'!
defaultCategory

	^ nil! !

!DebugAction methodsFor: 'accessing' stamp: 'AndreiChis 6/10/2013 18:34'!
debugger

	^ debugger! !

!DebugAction methodsFor: 'actions' stamp: 'AndreiChis 8/26/2013 12:02'!
defaultActionSelector

	^ #executeAction! !

!DebugAction methodsFor: 'accessing' stamp: 'AndreiChis 7/17/2013 22:59'!
defaultOrder

	^ 0! !

!DebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/21/2013 21:16'!
keyText

	^ keyText ifNil: [ self defaultKeyText ]! !

!DebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/24/2013 16:31'!
needsSeparatorAfter: aBoolean

	needsSeparatorAfter := aBoolean! !

!DebugAction methodsFor: 'accessing' stamp: 'AndreiChis 6/10/2013 18:35'!
needsValidation: anObject

	needsValidation := anObject! !

!DebugAction methodsFor: 'accessing-context' stamp: 'AndreiChis 6/20/2013 14:41'!
interruptedContext
	
	^ self debugger interruptedContext
	! !

!DebugAction methodsFor: 'accessing' stamp: 'AndreiChis 6/10/2013 18:40'!
label: aString

	label := aString! !

!DebugAction methodsFor: 'accessing-context' stamp: 'AndreiChis 6/17/2013 15:51'!
selectedContext
	
	^ self debugger selectedContext
	! !

!DebugAction methodsFor: '*spec-debugger' stamp: 'AndreiChis 9/25/2013 17:03'!
specModel

	^ #SpecDebugActionButton! !

!DebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/24/2013 15:57'!
asDebugAction

	^ self! !

!DebugAction methodsFor: 'initialization' stamp: 'AndreiChis 9/18/2013 11:45'!
forDebugger: aDebugger

	self debugger: aDebugger! !

!DebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/21/2013 21:12'!
keyText: aString

	keyText := aString! !

!DebugAction methodsFor: '*spec-debugger' stamp: 'AndreiChis 12/20/2013 20:52'!
shortcutCommand
	self flag: 'hacky solution to still be compatible with the GTDebugger (for the moment)'.
	^ self keyText ifNotNil: [:aString |
		aString first isUppercase
			ifTrue: [ aString first command shift ]
			ifFalse: [ aString first command ]  ]! !

!DebugAction methodsFor: 'accessing' stamp: 'AndreiChis 8/7/2013 19:07'!
category

	^ category ifNil: [ self defaultCategory ]! !

!DebugAction methodsFor: 'accessing' stamp: 'AndreiChis 6/5/2013 15:03'!
session

	^ self debugger session! !

!DebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/24/2013 16:21'!
needsSeparatorAfter

	^ needsSeparatorAfter ifNil: [ false ]! !

!DebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/19/2013 17:20'!
order

	^ order ifNil: [ self defaultOrder ]! !

!DebugAction methodsFor: 'actions' stamp: 'AndreiChis 9/24/2013 17:00'!
precondition

	^ self needsValidation not or: [ self debugger okToChange ]! !

!DebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/24/2013 15:37'!
id

	^ nil! !

!DebugAction methodsFor: 'actions' stamp: 'AndreiChis 8/26/2013 12:04'!
executeAction
	"By default do nothing."
	! !

!DebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/21/2013 21:16'!
defaultKeyText

	^ nil
	! !

!DebugAction methodsFor: 'accessing' stamp: 'AndreiChis 6/17/2013 11:07'!
icon: anObject

	icon := anObject! !

!DebugAction methodsFor: 'accessing' stamp: 'AndreiChis 7/12/2013 16:38'!
label

	^ label ifNil: [ self defaultLabel ]! !

!DebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/18/2013 19:00'!
needsValidation

	^ needsValidation ifNil: [ true ]! !

!DebugAction methodsFor: '*spec-debugger' stamp: 'AndreiChis 12/20/2013 14:59'!
asMenuRegistrationIn: aBuilder
	| item |
	
	item := (aBuilder item: self specId)
		label: self label, (self keyText ifNil: [ '' ] ifNotNil: [ '  (', self keyText, ')' ] );
		icon: self icon;
		enabled: self enabled;
		order: self order asFloat;
		target: self; 
		selector: #execute;
		arguments: #().
	self needsSeparatorAfter 
		ifTrue: [ item withSeparatorAfter ].
	^ item
! !

!DebugAction methodsFor: 'actions' stamp: 'AndreiChis 8/26/2013 12:03'!
actionSelector

	^ actionSelector ifNil: [ self defaultActionSelector ]! !

!DebugAction methodsFor: 'accessing' stamp: 'AndreiChis 7/12/2013 16:38'!
defaultLabel

	^ ''! !

!DebugAction methodsFor: 'actions' stamp: 'AndreiChis 9/24/2013 17:01'!
execute

	self precondition ifTrue: [ 
		self perform: self actionSelector.
		self postAction ] ! !

!DebugAction methodsFor: 'actions' stamp: 'AndreiChis 9/24/2013 17:16'!
notifyDebugger
	
	self needsUpdate ifTrue: [ 
		self debugger announce: (DebugActionExecuted forDebuggingAction: self) ]! !

!DebugAction methodsFor: 'accessing' stamp: 'AndreiChis 6/10/2013 18:40'!
order: anInteger

	order := anInteger! !

!DebugAction methodsFor: 'actions' stamp: 'AndreiChis 9/24/2013 16:57'!
postAction

	self notifyDebugger! !

!DebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/24/2013 16:31'!
withSeparatorAfter

	self needsSeparatorAfter: true! !

!DebugAction methodsFor: 'accessing' stamp: 'AndreiChis 8/8/2013 12:01'!
icon

	^ icon ifNil: [ self defaultIcon ]! !

!DebugAction class methodsFor: 'accessing' stamp: 'AndreiChis 9/24/2013 15:57'!
asDebugAction

	^ self new! !

!DebugAction class methodsFor: 'instance creation' stamp: 'AndreiChis 6/26/2013 23:06'!
forDebugger: aDebugger

	^ self new forDebugger: aDebugger! !

!DebugAction class methodsFor: 'accessing' stamp: 'AndreiChis 9/17/2013 19:20'!
defaultIcon

	^ nil! !

!DebugActionExecuted commentStamp: '<historical>'!
A DebugActionExecuted is an event send to the debugger after a debugging actions that has the flag #needsUpdate set to true is executed.

Instance Variables
	actionId:		<Object>

actionId
	- xxxxx
!
!DebugActionExecuted methodsFor: 'as yet unclassified' stamp: 'AndreiChis 9/24/2013 17:15'!
actionId: aSymbol

	actionId := aSymbol! !

!DebugActionExecuted class methodsFor: 'as yet unclassified' stamp: 'AndreiChis 9/24/2013 17:15'!
forDebuggingAction: anAction

	^ self new
		actionId: anAction id! !

!DebugContext commentStamp: '<historical>'!
A DebugContext is a helper that complements DebugSession. It is meant to be created dynamically on a context when the session wants to access the provided services.

To create instances first call forContext: to set the current context, and then if
the interrupted is different use topContext:

Not sure if it is still a good idea to have this class. 

Instance Variables
	context:		<Object>
	method:		<Object>
	methodNode:		<Object>
	ranges:		<Object>
	topContext:		<Object>

context
	- xxxxx

method
	- xxxxx

methodNode
	- xxxxx

ranges
	- xxxxx

topContext
	- xxxxx
!
!DebugContext methodsFor: 'accessing' stamp: 'AndreiChis 1/7/2013 10:29'!
selectedClass
	"Answer the class in which the current context's method was found."

	^ context methodClass! !

!DebugContext methodsFor: 'private' stamp: 'BenComan 3/15/2014 00:51'!
blockNotFoundDialog: aMethod with: aText

	| browser message result |
	
	message := 'Method for block not found on stack, can''t edit and continue'.
	
	"shouldn't edit doits"
	aMethod selector isDoIt
		ifTrue: [ 	^ self inform: message ].
			
	result := UIManager default
						confirm: message
						trueChoice: 'Browse' translated
						falseChoice: 'Cancel' translated.
						
	"possible return values are true | false | nil"
	result == true ifFalse: [ ^ self ].
		
	"let's browse the given method with the edited contents"
	browser := aMethod browse.
	browser 
		contents: aText; 
		changed: #contents.
	browser codeTextMorph 
		hasUnacceptedEdits: true! !

!DebugContext methodsFor: 'initialization' stamp: 'AndreiChis 2/6/2013 14:41'!
forContext: aContext 
	context := aContext.
	topContext := aContext.! !

!DebugContext methodsFor: 'accessing' stamp: 'AndreiChis 1/7/2013 10:29'!
receiver
	^ context receiver! !

!DebugContext methodsFor: 'accessing' stamp: 'MarcusDenker 7/19/2014 18:44'!
selectedMessageName
	"Answer the message selector of the current context.
	 If the method is unbound we can still usefully answer its old selector."

	^ context methodSelector! !

!DebugContext methodsFor: 'accessing' stamp: 'AndreiChis 1/7/2013 10:29'!
selectedMessageCategoryName
	"Answer the name of the message category of the message of the current context."

	^ self selectedClass organization categoryOfElement: self selectedMessageName! !

!DebugContext methodsFor: 'accessing' stamp: 'AndreiChis 6/10/2013 15:54'!
locateClosureHomeWithContent: aText
	"In case the current context is a BlockContext locate the closureHome and ask the
	user to validate the new context. If closureHome is not found or the user does not 
	validate the new context, return nil. aText is the new content of the current context.
	If the current context is not a BlockContext return it."
	| closureHome |
	
	context isBlockContext ifTrue: [
		closureHome := context activeHome.
		closureHome ifNil: [
			self blockNotFoundDialog: context method with: aText.
		 	^ nil ].
		 (self confirm: 'I will have to revert to the method from\which this block originated.  Is that OK?' withCRs) 
			ifFalse: [ ^ nil ].
		^ closureHome].
	
	^ context! !

!DebugContext methodsFor: 'private' stamp: 'AndreiChis 2/6/2013 14:42'!
source
	"Answer the source code of the currently selected context."
	^ context sourceCode! !

!DebugContext methodsFor: 'initialization' stamp: 'AndreiChis 1/7/2013 10:29'!
topContext: aContext
	topContext  := aContext ! !

!DebugContext methodsFor: 'evaluating actions' stamp: 'MarcusDenker 9/5/2013 12:50'!
evaluate: expression
	^ Smalltalk compiler
		source: expression;
		context: context;
		receiver: context receiver;
		evaluate! !

!DebugContext methodsFor: 'evaluating actions' stamp: 'ClementBera 7/26/2013 16:37'!
recompileCurrentMethodTo: aText notifying: aNotifyer
	| classOfMethod selector |
	
	classOfMethod := self selectedClass.
	selector := classOfMethod compiler parseSelector: aText.
	(selector == self selectedMessageName or: [(self selectedMessageName isDoIt)
		and: [selector numArgs = self selectedMessageName numArgs]]) ifFalse: [
			self inform: 'can''t change selector'. ^ nil].
		
	selector := classOfMethod 
		compile: aText 
		classified: self selectedMessageCategoryName 
		notifying: aNotifyer.
	^ selector 
		ifNotNil: [ classOfMethod compiledMethodAt: selector ]
		! !

!DebugContext methodsFor: 'accessing' stamp: 'AndreiChis 1/7/2013 10:29'!
receiverClass
	"Answer the class of the receiver. 
	It may differ from 'self selectedClass' "
	
	^ context receiver class! !

!DebugContext methodsFor: 'accessing' stamp: 'AndreiChis 1/11/2013 17:51'!
context
	^ context! !

!DebugContext class methodsFor: 'instance creation' stamp: 'AndreiChis 1/7/2013 10:29'!
forContext: aContext 
	^ self new forContext: aContext ! !

!DebugSession commentStamp: '<historical>'!
A DebugSession models a debuggeing session. It contains the interrupted context and process. Its main goal is to handle debugger actions such as restart or stepInto, as well as recomplilation of methods. It is the model used as an input to a ui.

As it is just a model it does now contain any information related to the ui. For example, it does not know what a selection in the ui is. It is the job on the ui to maintain the selection and call this session with the propper context.

To create sessions use the mehod 'process: aProcess context: aContext'. aContext must be a context belonging to aProcess, and aProcess must be an interrupted process.

Instance Variables
	context:		<Object>
	errorWasInUIProcess:		<Object>
	process:		<Object>

context
	- xxxxx

errorWasInUIProcess
	- xxxxx

process
	- xxxxx
!
!DebugSession methodsFor: 'evaluating' stamp: 'AndreiChis 1/15/2015 16:47'!
rewindContextToMethod: aMethod fromContext: aContext
	"this method is typically to be used after a hot compilation of a method from the stack.
	in order to return to the context containg the compiled method."
	| ctxt |
	ctxt :=  interruptedProcess popTo: aContext.
	
	ctxt == aContext
		ifFalse: [
			self inform: 'Method saved, but current context unchanged\because of unwind error. Click OK to see error' withCRs ]
		ifTrue: [
			aMethod isQuick ifFalse: [
				interruptedProcess restartTopWith: aMethod.
				self stepToFirstInterestingBytecodeIn: interruptedProcess ] ].
	self updateContextTo:  ctxt.
	
	"Issue 3015 - Hernan"
	self isInterruptedContextATest ifTrue: [ self prepareTestToRunAgain ].! !

!DebugSession methodsFor: 'initialization' stamp: 'ClementBera 7/26/2013 16:37'!
process: aProcess context: aContext

	"aProcess stepToSendOrReturn ."
	"aProcess isSuspended ifTrue: [ aProcess stepToSendOrReturn ]."
	interruptedProcess := aProcess.
	interruptedContext := self filterTopContext: aContext.
	interruptedContext ifNil: [interruptedContext := aContext].
	
! !

!DebugSession methodsFor: 'debugging actions' stamp: 'AndreiChis 1/15/2015 16:47'!
stepOver: aContext
	"Send the selected message in selectedContext, and regain control 
	after the invoked method returns."
	
	| newContext |
	
	(self isContextPostMortem: aContext) ifTrue: [^ self].
	
	newContext := interruptedProcess completeStep: aContext.
	self updateContextTo:  
		(newContext == aContext
			ifTrue: [ (self stepToFirstInterestingBytecodeIn: interruptedProcess) ]
			ifFalse: [ newContext ]).

	self triggerEvent: #stepOver ! !

!DebugSession methodsFor: 'debugging actions' stamp: 'AndreiChis 7/22/2013 14:28'!
runToSelection: selectionInterval inContext: aContext 
	"Attempt to step over instructions in selectedContext until the 
	execution reaches the selected instruction. This happens when the
	program counter passes the begining of selectionInterval.
	
	A not nill and valid interval is expected." 
	
	(self pcRangeForContext: aContext) first >= selectionInterval first 
		ifTrue: [ ^self ].
	self stepOver: aContext.
	[ aContext == self interruptedContext and: [ (self pcRangeForContext: aContext) first < selectionInterval first ] ] 
		whileTrue: [ self stepOver: aContext ]! !

!DebugSession methodsFor: 'debugging actions' stamp: 'AndreiChis 7/19/2013 17:56'!
stepInto

	self stepInto: interruptedContext! !

!DebugSession methodsFor: 'accessing' stamp: 'AndreiChis 4/2/2013 14:46'!
errorWasInUIProcess
	
	^ errorWasInUIProcess! !

!DebugSession methodsFor: 'context' stamp: 'AndreiChis 2/6/2013 14:15'!
downInContext: aContext
	"move down the context stack to the previous (enclosing) context"

	self flag: 'This does not take into account (bypasses) filtering'.
	^ aContext sender. ! !

!DebugSession methodsFor: 'accessing' stamp: 'AndreiChis 7/22/2013 14:14'!
interruptedContext

	^ interruptedContext! !

!DebugSession methodsFor: 'debugging actions' stamp: 'AndreiChis 9/24/2013 13:30'!
returnValue: anObject from: aContext
	"Force a return of a given value to the previous context!!"

	| previous |
	self flag: 'should be called only on the selected context. WHY?'.	
	(self isContextPostMortem: aContext) ifTrue: [^ self].

	previous := aContext sender.
"	self resetContext: previous."
	interruptedProcess popTo: previous value: anObject.
	self updateContextTo: previous.
	self contextChanged ! !

!DebugSession methodsFor: 'testing' stamp: 'AndreiChis 1/7/2013 11:17'!
isTestObject: anObject

	"I'm not sure this is the best way to doit because it creates a coupling with TestCase, but due that SUnit is part of the core I think it is not bad after all - Hernan'"
	^ anObject isKindOf: TestCase! !

!DebugSession methodsFor: 'context' stamp: 'AndreiChis 6/4/2013 16:16'!
contextChanged

	self triggerEvent: #contextChanged! !

!DebugSession methodsFor: 'context' stamp: 'AndreiChis 1/13/2013 19:19'!
pcRangeForContext: aContext
	"Answer the indices in the source code for the method corresponding to 
	aContext's program counter value."

	aContext isDead ifTrue:
		[^1 to: 0].
	^aContext debuggerMap
		rangeForPC: aContext pc
		contextIsActiveContext: (self isLatestContext: aContext)! !

!DebugSession methodsFor: 'private' stamp: 'AndreiChis 7/19/2013 17:56'!
resumeProcess
	"Make sure the interrupted process is restored properly and restart the low space handler"
	
	interruptedProcess isTerminated
		ifFalse: [errorWasInUIProcess
				ifTrue: [UIManager default resumeUIProcess: interruptedProcess]
				ifFalse: [interruptedProcess resume]].

	Smalltalk installLowSpaceWatcher.	"restart low space handler".
		
	! !

!DebugSession methodsFor: 'context' stamp: 'AndreiChis 7/19/2013 17:58'!
isLatestContext: aContext

	^ interruptedProcess suspendedContext == aContext! !

!DebugSession methodsFor: 'private' stamp: 'AndreiChis 6/4/2013 15:24'!
installAlarm: aSelector 
	
	self installAlarm: aSelector withArgument: #()! !

!DebugSession methodsFor: 'context' stamp: 'AndreiChis 1/7/2013 10:29'!
shouldDisplayOnTopContext: aContext
	
	^ aContext method selector ~= #halt! !

!DebugSession methodsFor: 'debugging actions' stamp: 'AndreiChis 1/15/2015 16:47'!
stepThrough: aContext
	"Send messages until you return to selectedContext.
	 Used to step into a block in the method."
	
	(self isContextPostMortem: aContext) ifTrue: [^ self].
	
	interruptedProcess stepToHome: aContext.
	self updateContextTo: (self stepToFirstInterestingBytecodeIn: interruptedProcess).
			
	self triggerEvent: #stepThrough ! !

!DebugSession methodsFor: 'testing' stamp: 'AndreiChis 7/22/2013 14:28'!
isInterruptedContextDoesNotUnderstand	
	
	^ self interruptedContext selector == #doesNotUnderstand:! !

!DebugSession methodsFor: 'context' stamp: 'AndreiChis 7/19/2013 17:57'!
updateContextTo: aContext

	interruptedContext := aContext! !

!DebugSession methodsFor: 'private' stamp: 'AndreiChis 7/22/2013 14:28'!
prepareTestToRunAgain

	self interruptedContext receiver prepareToRunAgain! !

!DebugSession methodsFor: 'context' stamp: 'AndreiChis 1/7/2013 10:29'!
previousPC: aContext
	^ (aContext method pcPreviousTo: aContext pc)
		ifNil: [ aContext pc ]! !

!DebugSession methodsFor: 'accessing' stamp: 'AndreiChis 9/29/2013 16:10'!
stackOfSize: limit usingFilters: stackFilters
	"Answer an OrderedCollection of the top 'limit' contexts on the receiver's sender chain, according to the given filters.
	
	Consider the following stack:   
		a <-- top of the stack
		b
		a
		c
		a
		b
		d
		e
		a <-- bottom of the stack
		
	If the given filters do not match context 'a' and 'b' the following stack will be returned:
		a <-- top of the stack
		b
		a
		c
		d
		e <-- bottom of the stack
		
	First all consecutive contexts starting from the top of the stack for which a filter does not match are 
	added to the result (a b a in the example). Then from the remaining stack only the context for which all
	filters match are added to the  result.
	"

	| stack context |
	stack := OrderedCollection new.
	context := interruptedContext.
	
	"Starting from the top of the stack add all consecutive contexts that should not be displayed."
	[ context ~~ nil
	 	and: [(stack size < limit)
			and: [ (self shouldDisplayContext: context basedOnFilters:  stackFilters) not ] ] ]  whileTrue: [
				stack addLast: context.
				context := context sender ].

	"Add all contexts that should be displayed. (the current context is checked again)"
	[context ~~ nil
		and: [stack size < limit ] ] whileTrue: [
			(self shouldDisplayContext: context basedOnFilters: stackFilters) 
				ifTrue: [ stack addLast: context ].
			context := context sender ].
	^ stack! !

!DebugSession methodsFor: 'debugging actions' stamp: 'AndreiChis 7/19/2013 17:48'!
restart: aContext
	"Proceed from the initial state of selectedContext." 
	"Closing now depends on a setting (RestartAlsoProceeds class variable) --> not supported in this version"

	(self isContextPostMortem: aContext) ifTrue: [^ self].
	self unwindAndRestartToContext: aContext.
	
	"Issue 3015 - Hernan"
	self isInterruptedContextATest ifTrue: [ self prepareTestToRunAgain ].
	
	self triggerEvent: #restart		
	! !

!DebugSession methodsFor: 'accessing' stamp: 'AndreiChis 7/19/2013 17:56'!
stack

	^ interruptedContext stack! !

!DebugSession methodsFor: 'accessing' stamp: 'AndreiChis 7/19/2013 17:53'!
context

	^ interruptedContext! !

!DebugSession methodsFor: 'accessing' stamp: 'AndreiChis 7/19/2013 17:56'!
stackOfSize: size

	^ interruptedContext stackOfSize: size! !

!DebugSession methodsFor: 'accessing' stamp: 'AndreiChis 7/19/2013 17:53'!
createModelForContext: aContext

	^ (DebugContext forContext: aContext) topContext: interruptedContext! !

!DebugSession methodsFor: 'debugging actions' stamp: 'ClementBera 7/26/2013 16:37'!
terminate
	"Action that needs to be executed after the window containing this debug session is closed, 
	in order to terminate the right process."
	
	self interruptedProcess 
		ifNotNil: [ 
			"Assume the user closed the debugger. Simply kill the interrupted process."
			self interruptedProcess terminate.
			self clear.
			Smalltalk installLowSpaceWatcher.  "restart low space handler" ]
		ifNil: [ 
			"Assume the interrupted process was resumed."
			"Kill the active process if the error was in the UI as there should be only one UI process."
			errorWasInUIProcess == false
				ifFalse: [Processor terminateActive] ]
	! !

!DebugSession methodsFor: 'debugging actions' stamp: 'AndreiChis 7/19/2013 17:57'!
stepOver

	self stepOver: interruptedContext! !

!DebugSession methodsFor: 'debugging actions' stamp: 'AndreiChis 7/19/2013 17:48'!
recompileMethodTo: text inContext: aContext notifying: aNotifyer
	"The retrieved information has changed and its source must now be updated.
	 In this case, the retrieved information is the method of the given context."
	| newMethod recompilationContext |				
				
	(recompilationContext := (self createModelForContext: aContext) locateClosureHomeWithContent: text) 
		ifNil: [ ^ false ]. 
				
	newMethod := (self createModelForContext: recompilationContext) recompileCurrentMethodTo: text notifying: aNotifyer.
	newMethod ifNil: [ ^ false ].
	newMethod isQuick ifTrue: [
		recompilationContext := self downInContext: recompilationContext.
		recompilationContext jump: (recompilationContext previousPc - recompilationContext pc) ].
		
	self rewindContextToMethod: newMethod fromContext: recompilationContext. 
	
	"Use an alarm instead of triggering the notification directly, as the content of
	the editor can still be unaccepted. "
	self installAlarm: #contextChanged.
	^ true! !

!DebugSession methodsFor: 'evaluating' stamp: 'AndreiChis 9/20/2013 19:05'!
implement: aMessage classified: aSymbol inClass: aClass forContext: aContext
	
	aClass
		compile: (DynamicMessageImplementor for: aMessage in: aClass) value
		classified: aSymbol.

	aContext privRefreshWith: (aClass lookupSelector: aMessage selector).
	aContext method numArgs > 0 ifTrue:
		[aMessage arguments withIndexDo:
			[:arg :index|
				aContext tempAt: index put: arg]].
		
	self updateContextTo: aContext.
	self contextChanged! !

!DebugSession methodsFor: 'testing' stamp: 'AndreiChis 1/7/2013 11:17'!
isTestMethod: aCompiledMethod of: aTestCase

	^ aCompiledMethod selector = aTestCase selector! !

!DebugSession methodsFor: 'testing' stamp: 'ClaraAllende 10/31/2013 16:34'!
shouldDisplayContext: aContext basedOnFilters: stackFilters
	"Return true if all filters match the given context, or false otherwise.
	True is returned if there are no filters."
		
	^stackFilters allSatisfy: [ :aFilter | aFilter shouldDisplay: aContext ].
	! !

!DebugSession methodsFor: 'debugging actions' stamp: 'AndreiChis 1/15/2015 16:47'!
stepInto: aContext
	"Send the selected message in selectedContext, and take control in 
	the method invoked to allow further step or send."

	(self isContextPostMortem: aContext) ifTrue: [^ self].

	interruptedProcess step: aContext.
	self updateContextTo: (self stepToFirstInterestingBytecodeIn: interruptedProcess).
	
	self triggerEvent: #stepInto! !

!DebugSession methodsFor: 'evaluating' stamp: 'AndreiChis 1/15/2015 16:47'!
unwindAndRestartToContext: aContext
	|ctx|

	ctx := interruptedProcess popTo: aContext.
	ctx == aContext ifTrue: [ 
		"Only restart the process if the stack was unwind"
		interruptedProcess restartTop.
		self stepToFirstInterestingBytecodeIn: interruptedProcess ].
	self flag: 'Should a warning be displayed if the the unwind failed?'.
	self updateContextTo:  aContext! !

!DebugSession methodsFor: 'private' stamp: 'AndreiChis 1/15/2015 16:54'!
stepToFirstInterestingBytecodeIn: aProcess
	"After a restart of a method activation step to the first 
	bytecode instruction that is of interest for the debugger.
	
	In this case step until a bytecode that causes a context switch,
	as otherwise one will have to press may time step into without 
	seeing any visible results."
	
	^ aProcess stepToSendOrReturn! !

!DebugSession methodsFor: 'testing' stamp: 'AndreiChis 7/22/2013 14:28'!
isInterruptedContextATest

	^ (self isTestObject: self interruptedContext receiver) and: [ self isTestMethod: self interruptedContext method of: self interruptedContext receiver ]! !

!DebugSession methodsFor: 'debugging actions' stamp: 'AndreiChis 7/19/2013 17:57'!
stepThrough

	self stepThrough: interruptedContext! !

!DebugSession methodsFor: 'context' stamp: 'AndreiChis 9/30/2013 19:00'!
activePC: aContext 
	^ (self isLatestContext: aContext)
		ifTrue: [ interruptedContext pc ]
		ifFalse: [ self previousPC: aContext ].! !

!DebugSession methodsFor: 'debugging actions' stamp: 'AndreiChis 7/19/2013 17:54'!
clear
	"If after resuming the process the user does plan to reuse this session with
	the same process, it should call this method."
	interruptedProcess := nil.
	self updateContextTo: nil! !

!DebugSession methodsFor: 'updating' stamp: 'AndreiChis 7/19/2013 17:57'!
updateWithContext: newContext fromProcess: aProcess

	self process: aProcess context: newContext! !

!DebugSession methodsFor: 'debugging actions' stamp: 'MarcusDenker 8/10/2014 08:07'!
resume
	"Proceed execution of the receiver's model, starting after the expression at 
	which an interruption occurred."

	"If the user of this session does not plan to reuse it, it should call 'self clean' "

	Smalltalk okayToProceedEvenIfSpaceIsLow
		ifFalse: [ ^ self ].
	(self isContextPostMortem: self interruptedContext)
		ifTrue: [ ^ self ].
	self resumeProcess.
	self triggerEvent: #resume! !

!DebugSession methodsFor: 'private' stamp: 'AndreiChis 6/4/2013 14:38'!
installAlarm: aSelector withArgument: args
	
	World
		addAlarm: aSelector
		withArguments: args
		for: self
		at: Time millisecondClockValue + 200! !

!DebugSession methodsFor: 'debugging actions' stamp: 'AndreiChis 7/19/2013 17:55'!
peelToFirstLike: aContext
	"Peel the stack back to the second occurance of the currently selected message.  Very useful for an infinite recursion.  Gets back to the second call so you can see one complete recursion cycle, and how it was called at the beginning.  Also frees a lot of space!!"

	| ctxt |
	self flag: 'should be called only on the selected context'.	
	(self isContextPostMortem: aContext) ifTrue: [^ self].

	ctxt := interruptedProcess popTo: aContext findSecondToOldestSimilarSender.
	self updateContextTo: ctxt.
	self contextChanged 

	! !

!DebugSession methodsFor: 'testing' stamp: 'AndreiChis 9/20/2013 17:13'!
isInterruptedContextPostMortem
	
	^ self isContextPostMortem: self interruptedContext ! !

!DebugSession methodsFor: 'debugging actions' stamp: 'AndreiChis 9/24/2013 13:30'!
returnValueFrom: aContext
	"Force a return of a given value to the previous context!!"

	| previous expression value |
	self flag: 'should be called only on the selected context'.	
	self flag: 'remove me'.
	(self isContextPostMortem: aContext) ifTrue: [^ self].
	
	expression := UIManager default request: 'Enter expression for return value:'.
	value := self class compiler
					source: expression;
			context: aContext;
			receiver: aContext receiver;
			evaluate.
				
	previous := aContext sender.
"	self resetContext: previous."
	interruptedProcess popTo: previous value: value.
	self updateContextTo: previous.
	self contextChanged ! !

!DebugSession methodsFor: 'accessing' stamp: 'AndreiChis 7/22/2013 14:14'!
interruptedProcess

	^ interruptedProcess! !

!DebugSession methodsFor: 'testing' stamp: 'AndreiChis 7/19/2013 17:54'!
isContextPostMortem: selectedContext
	"return whether we're inspecting a frozen exception without a process attached"
	| suspendedContext |
	suspendedContext := interruptedProcess suspendedContext.
	suspendedContext ifNil: [ ^ false ].
	(suspendedContext == selectedContext)
		ifTrue: [ ^ false ].
	^ (suspendedContext findContextSuchThat: [:c | c sender == selectedContext]) isNil! !

!DebugSession methodsFor: 'accessing' stamp: 'AndreiChis 2/6/2013 14:33'!
selectedCodeRangeForContext: selectedContext

	^ self pcRangeForContext: selectedContext! !

!DebugSession methodsFor: 'initialization' stamp: 'AndreiChis 7/19/2013 17:53'!
errorWasInUIProcess: aBoolean

	errorWasInUIProcess := aBoolean! !

!DebugSession methodsFor: 'accessing' stamp: 'AndreiChis 7/19/2013 17:55'!
process
	^ interruptedProcess! !

!DebugSession methodsFor: 'context' stamp: 'AndreiChis 1/7/2013 10:29'!
filterTopContext: aContext
	|ctx|
	 
	ctx := aContext.
	(self shouldDisplayOnTopContext: ctx) ifTrue: [^ ctx].
	[(ctx := ctx sender) ~~ nil] whileTrue:
		[(self shouldDisplayOnTopContext: ctx) ifTrue: [^ ctx]].
	^ nil! !

!DebugSession class methodsFor: 'actions registration' stamp: 'MarcusDenker 8/9/2014 13:42'!
debuggingActionsForPragma: aSymbol for: aDebugger
	^ (DebugAction allSubclasses reject: [ :each | each hasAbstractMethods ])
		inject: OrderedCollection new
		into: [ :currentActions :aClass | 
			currentActions
				addAll: (self debuggingActionsFromClass: aClass forPragma: aSymbol forDebugger: aDebugger);
				yourself ]! !

!DebugSession class methodsFor: 'instance creation' stamp: 'AndreiChis 1/7/2013 10:29'!
process: aProcess context: aContext
	^ self new
		process: aProcess context: aContext! !

!DebugSession class methodsFor: 'actions registration' stamp: 'AndreiChis 9/24/2013 15:57'!
debuggingActionsFromClass: aClass forPragma: aSymbol forDebugger: aDebugger
	| pragmas actions |
	pragmas := Pragma 
				allNamed: aSymbol
				from: aClass class
				to: aClass class.
	
	actions := OrderedCollection new.
	pragmas do: [ :aPragma |
		actions addAll: 
			((aPragma methodClass soleInstance
				perform: aPragma selector withEnoughArguments: {aDebugger}) asOrderedCollection 
					collect: [ :each | each asDebugAction ]) ].
	^ actions ! !

!DebugSession class methodsFor: 'actions registration' stamp: 'AndreiChis 9/21/2013 18:51'!
debuggingActionsForPragmas: aSymbolsCollection for: aDebugger
	self flag: 'split me'.
	^ (((aSymbolsCollection 
		inject: OrderedCollection new
		into: [ :currentActions :aSymbol | 
			currentActions 
				addAll: (self debuggingActionsForPragma: aSymbol for: aDebugger);
				yourself ]) 
					select: [ :aDebugAction | 
						aDebugAction appliesToDebugger: aDebugger ]) 
					collect: [ :aDebugAction | 
						aDebugAction
							forDebugger: aDebugger;
							yourself ]) 
					sort: [ :action1 :action2 | 
						action1 order < action2 order ]! !

!DebugSystemSettings commentStamp: 'TorstenBergmann 2/12/2014 23:30'!
Settings for debugging!
!DebugSystemSettings class methodsFor: 'private - settings' stamp: 'StephaneDucasse 11/12/2014 14:01'!
addDebugFilterSessingsOn: aBuilder
	| stackWidgetClass |
	
	stackWidgetClass := Smalltalk tools debugger stackWidgetClass.
	(aBuilder group: #BasicFilters)
				label: 'Basic Filters';
				description: 'default filtering configurations';
				target: Smalltalk tools debugger;
				with: [
					(aBuilder setting: #filterCommonMessageSends)
				label: 'Filter out common message sends';
				target: Smalltalk tools debugger;
				description: 'When true, filter out uninteresting message sends in the Debugger view while debugging';
				with: [ 
					(aBuilder setting: #filterDoItSelectors)
					label: 'Filter out doIt sends';
					target: stackWidgetClass.
					
					(aBuilder setting: #filterNilSelectors)
					label: 'Filter out nil message sends';
					target: stackWidgetClass.
					
					(aBuilder setting: #filterKernelClasses)
					label: 'Filter out kernel classes message sends';
					target: stackWidgetClass.
					 ]
				].! !

!DebugSystemSettings class methodsFor: 'settings' stamp: 'StephaneDucasse 11/12/2014 14:02'!
debugSettingsOn: aBuilder
	<systemsettings>
	(aBuilder group: #debugging)
		label: 'Debugging';
		with: [
			(aBuilder group: #deprecationHandling)
				label: 'Deprecation handling';
				description: 'How deprecation are handled' ;
				target: Deprecation;
				with: [
					(aBuilder setting: #raiseWarning)
						label: 'Raise a blocking dialog' ;
						description: 'If true, then a dialog is popup for each deprecated method invocation' .
					(aBuilder setting: #showWarning)
						label: 'Transcript message';
						description: 'If true, then a message is send to the Transcript for each deprecated method invocation'].
			
			(aBuilder setting: #cmdDotEnabled)
				label: 'Enable cmd-dot interrupt key';
				target: UserInterruptHandler;
				description: 'If true, it allows the user to stop currently running process by opening-up a debugger'.
			
			(aBuilder setting: #cpuWatcherEnabled)
				label: 'Process browser monitors CPU usage';
				target: CPUWatcher;
				description: 'If true, Pharo processes will be monitored for CPU usage. If they take too much CPU, you will get a notification menu that will allow you to debug, resume, or terminate the process' .
			
			(aBuilder setting: #debugShowDamage)
				label: 'Flash damaged morphic region';
				target: WorldState;
				description: 'If true, every changed region of the morphic display will be flashed black before updating.' .
			
			(aBuilder setting: #logDebuggerStackToFile)
				label: 'Write message to debug log file when fall into debugger';
				target: Smalltalk tools debugger;
				description: 'If true, whenever you fall into a debugger a summary of its stack will be written to a file named'.
			
			"(aBuilder setting: #restartAlsoProceeds)
				label: 'Restart also proceeds' ;
				target: Debugger;
				description: 'If this preference is set, the debugger''s restart button and menu item will also proceed. If the preference is not set, the selected context will just be reset to its initial condition, so you may step through it again.' ."
				
			(aBuilder setting: #alwaysOpenFullDebugger)
				label: 'Directly open the full Debugger';
				target: Smalltalk tools debugger;
				description: 'When true, always directly open the full Debugger view when debugging instead of showing only a small popup' .
			
			self addDebugFilterSessingsOn: aBuilder.
				
			(aBuilder setting: #logFileName)
				label: 'Log file name' ;
				target: Smalltalk;
				description: 'A name of the file, which will be used for logging all errors and notifications' 
		]! !

!DebuggerMethodMap commentStamp: '<historical>'!
I am a place-holder for information needed by the Debugger to inspect method activations.  I insulate the debugger from details of code generation such as exact bytecode offsets and temporary variable locations. 

My function is to abstract the source map away from actual bytecode pcs to abstract bytecode pcs.

To reduce compilation time I try and defer as much computation to access time as possible as instances of me will be created after each compilation.

I maintain a WeakIdentityDictionary of method to DebuggerMethodMap to cache maps.  I refer to my method through a WeakArray to keep the map cache functional. If the reference from a DebuggerMethodMap to its method were strong then the method would never be dropped from the cache because the reference from its map would keep it alive.!
!DebuggerMethodMap methodsFor: 'private' stamp: 'MarcusDenker 5/9/2013 12:40'!
startpcsToBlockExtents: aCompiledMethod
	"Answer a Dictionary of startpc to Interval of blockExtent, using the
	 identical numbering scheme described in and orchestrated by
	 BlockNode>>analyseArguments:temporaries:rootNode:.  This is
	 used in part to find the temp names for any block in a method, as
	 needed by the debugger.  The other half is to recompile the method,
	 obtaining the temp names for each block extent.  By indirecting through
	 the blockExtent instead of using the startpc directly we decouple the
	 debugger's access to temp names from the exact bytecode; insulating
	 debugging from minor changes in the compiler (e.g. changes in literal
	 pooling, adding prefix bytecodes, adding inst vars to CompiledMethod
	 in literals towards the end of the literal frame, etc).  If the recompilation
	 doesn't produce exactly the same bytecode at exactly the same offset
	 no matter; the blockExtents will be the same."
	| index |
	index := 0.
	^self
		blockExtentsInto: Dictionary new
		from: aCompiledMethod initialPC
		to: aCompiledMethod endPC
		scanner: (InstructionStream on: aCompiledMethod)
		numberer: [| value | value := index. index := index + 2. value] ! !

!DebuggerMethodMap methodsFor: 'private' stamp: 'MarcusDenker 12/7/2011 15:16'!
privateTempAt: index in: aContext put: aValue startpcsToBlockExtents: theContextsStartpcsToBlockExtents
	| nameRefPair |
	nameRefPair := (self privateTempRefsForContext: aContext
						 startpcsToBlockExtents: theContextsStartpcsToBlockExtents)
						at: index
						ifAbsent: [aContext errorSubscriptBounds: index].
	^self privateDereference: nameRefPair last in: aContext put: aValue! !

!DebuggerMethodMap methodsFor: 'private' stamp: 'MarcusDenker 12/7/2011 15:16'!
privateDereference: tempReference in: aContext put: aValue
	"Assign the temporary with reference tempReference in aContext.
	 tempReference can be
		integer - direct temp reference
		#( indirectionVectorIndex tempIndex ) - remote temp in indirectionVector at index
		#( outer. temp reference ) - a temp reference in an outer context."
	^tempReference isInteger
		ifTrue: [aContext tempAt: tempReference put: aValue]
		ifFalse:
			[tempReference first == #outer
				ifTrue: [self privateDereference: tempReference last
							in: aContext outerContext
							put: aValue]
				ifFalse: [(aContext tempAt: tempReference first)
							at: tempReference second
							put: aValue]]! !

!DebuggerMethodMap methodsFor: 'accessing' stamp: 'MarcusDenker 5/9/2013 11:24'!
tempNamesForContext: aContext
	"Answer an Array of all the temp names in scope in aContext starting with
	 the home's first local (the first argument or first temporary if no arguments)."
	^(self
		privateTempRefsForContext: aContext
		startpcsToBlockExtents: (self startpcsToBlockExtents: aContext method)) collect:
			[:pair| pair first]! !

!DebuggerMethodMap methodsFor: 'initialize-release' stamp: 'MarcusDenker 10/9/2012 18:06'!
forMethod: aMethod 
	^self forMethod: aMethod methodNode: aMethod methodNode.! !

!DebuggerMethodMap methodsFor: 'accessing' stamp: 'eem 6/5/2008 09:21'!
method
	^methodReference at: 1! !

!DebuggerMethodMap methodsFor: 'private' stamp: 'MarcusDenker 4/29/2012 13:49'!
privateTempRefsForContext: aContext startpcsToBlockExtents: theContextsStartpcsToBlockExtents
	"Answer the sequence of temps in scope in aContext in the natural order,
	 outermost arguments and temporaries first, innermost last.  Each temp is
	 a pair of the temp's name followed by a reference.  The reference can be
		integer - index of temp in aContext
		#( indirectionVectorIndex tempIndex ) - remote temp in indirectionVector at index in aContext
		#( outer. temp reference ) - a temp reference in an outer context."
	blockExtentsToTempRefs ifNil:
		[blockExtentsToTempRefs := methodNode blockExtentsToTempsMap.
		 startpcsToTempRefs := Dictionary new].
	^startpcsToTempRefs
		at: aContext startpc
		ifAbsentPut:
			[| localRefs |
			 localRefs := blockExtentsToTempRefs at: (theContextsStartpcsToBlockExtents at: aContext startpc).
			 aContext outerContext
				ifNil: [localRefs]
				ifNotNil:
					[:outer| | outerTemps |
					"Present temps in the order outermost to innermost left-to-right, but replace
					 copied outermost temps with their innermost copies"
					 outerTemps := (self
										privateTempRefsForContext: outer
										startpcsToBlockExtents: theContextsStartpcsToBlockExtents) collect:
						[:outerPair|
						localRefs
							detect: [:localPair| outerPair first = localPair first]
							ifNone: [{ outerPair first. { #outer. outerPair last } }]].
					outerTemps,
					 (localRefs reject: [:localPair| outerTemps anySatisfy: [:outerPair| localPair first = outerPair first]])]]! !

!DebuggerMethodMap methodsFor: 'private' stamp: 'MarcusDenker 5/9/2013 11:18'!
blockExtentsInto: aDictionary from: initialPC to: endPC scanner: scanner numberer: numbererBlock
	"Support routine for startpcsToBlockExtents"
	| extentStart blockSizeOrLocator |
	extentStart := numbererBlock value.
	[scanner pc <= endPC] whileTrue:
		[blockSizeOrLocator := scanner interpretNextInstructionFor: BlockStartLocator new.
		 blockSizeOrLocator isInteger ifTrue:
			[self
				blockExtentsInto: aDictionary
				from: scanner pc
				to: scanner pc + blockSizeOrLocator - 1
				scanner: scanner
				numberer: numbererBlock]].
	aDictionary at: initialPC put: (extentStart to: numbererBlock value).
	^aDictionary! !

!DebuggerMethodMap methodsFor: 'private' stamp: 'MarcusDenker 12/7/2011 15:16'!
privateIsOuter: anObject 
	^anObject last isArray and: [anObject last first == #outer]! !

!DebuggerMethodMap methodsFor: 'source mapping' stamp: 'HenrikSperreJohansen 9/8/2011 20:42'!
sortedSourceMap
	"Answer a sorted collection of associations, pcRangeStart -> pcRangeInterval "
	^ sortedSourceMap
		ifNil: [sortedSourceMap := self abstractSourceMap associations sorted]! !

!DebuggerMethodMap methodsFor: 'source mapping' stamp: 'eem 7/29/2008 17:12'!
abstractSourceMap
	"Answer with a Dictionary of abstractPC <Integer> to sourceRange <Interval>."
	| theMethodToScan rawSourceRanges concreteSourceRanges abstractPC scanner client |
	abstractSourceRanges ifNotNil:
		[^abstractSourceRanges].
	"If the methodNode hasn't had a method generated it doesn't have pcs set in its
	 nodes so we must generate a new method and might as well use it for scanning."
	methodNode rawSourceRangesAndMethodDo:
		[:ranges :method|
		 rawSourceRanges := ranges.
		 theMethodToScan := method].
	concreteSourceRanges := Dictionary new.
	rawSourceRanges keysAndValuesDo:
		[:node :range|
		node pc ~= 0 ifTrue:
			[concreteSourceRanges at: node pc put: range]].
	abstractPC := 1.
	abstractSourceRanges := Dictionary new.
	scanner := InstructionStream on: theMethodToScan.
	client := InstructionClient new.
	[(concreteSourceRanges includesKey: scanner pc) ifTrue:
		[abstractSourceRanges at: abstractPC put: (concreteSourceRanges at: scanner pc)].
	 abstractPC := abstractPC + 1.
	 scanner interpretNextInstructionFor: client.
	 scanner atEnd] whileFalse.
	^abstractSourceRanges! !

!DebuggerMethodMap methodsFor: 'initialize-release' stamp: 'MarcusDenker 10/9/2012 17:48'!
forMethod: aMethod "<CompiledMethod>" methodNode: theMethodNode "<MethodNode>"
	methodReference := WeakArray with: aMethod.
	methodNode := theMethodNode.! !

!DebuggerMethodMap methodsFor: 'private' stamp: 'MarcusDenker 12/7/2011 15:16'!
privateTempAt: index in: aContext startpcsToBlockExtents: theContextsStartpcsToBlockExtents
	| nameRefPair |
	nameRefPair := (self privateTempRefsForContext: aContext
						 startpcsToBlockExtents: theContextsStartpcsToBlockExtents)
						at: index
						ifAbsent: [aContext errorSubscriptBounds: index].
	^self privateDereference: nameRefPair last in: aContext! !

!DebuggerMethodMap methodsFor: 'accessing' stamp: 'MarcusDenker 5/9/2013 11:24'!
namedTempAt: index put: aValue in: aContext
	"Assign the value of the temp at index in aContext where index is relative
	 to the array of temp names answered by tempNamesForContext:.
	 If the value is a copied value we also need to set it along the lexical chain."
	^self
		privateTempAt: index
		in: aContext
		put: aValue
		startpcsToBlockExtents: (self startpcsToBlockExtents: aContext method)! !

!DebuggerMethodMap methodsFor: 'source mapping' stamp: 'MarcusDenker 5/9/2013 23:51'!
abstractPCFor: concretePC when: contextIsActive
	"If the context is the actve context (is at the hot end of the stack)
	 then its pc is the current pc.  But if the context isn't, because it is
	suspended sending a message, then its current pc is the previous pc"
	^self  abstractPCForConcretePC:
		(contextIsActive 
			ifTrue: [concretePC]
			ifFalse: [(self method pcPreviousTo: concretePC) ifNil: [concretePC]]) method: self method! !

!DebuggerMethodMap methodsFor: 'private' stamp: 'MarcusDenker 12/7/2011 15:16'!
privateDereference: tempReference in: aContext
	"Fetch the temporary with reference tempReference in aContext.
	 tempReference can be
		integer - direct temp reference
		#( indirectionVectorIndex tempIndex ) - remote temp in indirectionVector at index
		#( outer. temp reference ) - a temp reference in an outer context."
	^tempReference isInteger
		ifTrue: [aContext tempAt: tempReference]
		ifFalse:
			[tempReference first == #outer
				ifTrue: [self privateDereference: tempReference last
							in: aContext outerContext]
				ifFalse: [(aContext tempAt: tempReference first)
							at: tempReference second]]! !

!DebuggerMethodMap methodsFor: 'private' stamp: 'MarcusDenker 5/9/2013 11:19'!
mapFromBlockKeys: keys toSchematicTemps: schematicTempNamesString method: aCompiledMethod
	"Decode a schematicTempNamesString that encodes the layout of temp names
	 in a method and any closures/blocks within it, matching keys in keys to
	 vectors of temp names."
	| map tempNames |
	map := Dictionary new.
	tempNames := schematicTempNamesString readStream.
	keys do:
		[:key| | tempSequence tempIndex |
		tempSequence := OrderedCollection new.
		tempIndex := 0.
		[(tempNames skipSeparators; peek) ifNil: [true] ifNotNil: [:ch| '[]' includes: ch]] whileFalse:
			[tempNames peek = $(
				ifTrue: [tempSequence addAllLast: ((self tempsSubSequenceFrom: (tempNames next; yourself)) withIndexCollect:
														[:temp :index|
														{ temp. { tempIndex + 1. index } }]).
						tempNames peek ~= $) ifTrue: [self error: 'parse error'].
						tempIndex := tempIndex + 1.
						tempNames next]
				ifFalse: [tempSequence addAllLast: ((self tempsSubSequenceFrom: tempNames) withIndexCollect:
														[:temp :index|
														{ temp. tempIndex := tempIndex + 1 }])]].
		map at: key put: tempSequence asArray.
		[tempNames peek = $]] whileTrue: [tempNames next].
		tempNames peek = $[ ifTrue:
			[tempNames next]].
	^map! !

!DebuggerMethodMap methodsFor: 'private' stamp: 'MarcusDenker 5/9/2013 11:21'!
tempsSubSequenceFrom: tempNamesStream
	^Array streamContents:
		[:tsss|
		[tempNamesStream skipSeparators.
		 tempNamesStream atEnd
		 or: ['[]()' includes: tempNamesStream peek]] whileFalse:
			[tsss nextPut: (String streamContents:
							[:s|
							[s nextPut: tempNamesStream next.
							 tempNamesStream peek
								ifNil: [true]
								ifNotNil: [:peek| ' []()' includes: peek]] whileFalse])]]

	"thisContext method tempsSubSequenceFrom: 'les temps perdu(sont n''est pas la)' readStream"
	"thisContext method tempsSubSequenceFrom: ('les temps perdu(sont n''est pas la)' readStream skipTo: $(; yourself)"! !

!DebuggerMethodMap methodsFor: 'source mapping' stamp: 'EstebanLorenzano 11/15/2012 16:14'!
rangeForPC: concretePC contextIsActiveContext: contextIsActive
  	"Answer the indices in the source code for the supplied pc."
	
	| pc |
	
	self sortedSourceMap 
		ifEmpty: [ ^(1 to: 0) ].

	pc := self abstractPCFor: concretePC when: contextIsActive.

	(self sortedSourceMap first key > pc)
		ifTrue: [ ^self sortedSourceMap first value ].
	
	^self abstractSourceMap 
		at: pc 
		ifAbsent: [
			(self sortedSourceMap 
				findBinary: [:assoc | pc - assoc key ] 
				ifNone: [ | end |
					end := self sortedSourceMap last value last.
					nil -> (end +1 to: end)]) value ]! !

!DebuggerMethodMap methodsFor: 'source mapping' stamp: 'MarcusDenker 5/9/2013 23:50'!
abstractPCForConcretePC: concretePC method: aMethod
	"Answer the abstractPC matching concretePC."

	| abstractPC scanner client |
	abstractPC := 1.
	scanner := InstructionStream on: aMethod.
	client := InstructionClient new.
	[(scanner atEnd
	  or: [scanner pc >= concretePC]) ifTrue:
		[^abstractPC].
	 abstractPC := abstractPC + 1.
	 scanner interpretNextInstructionFor: client.
	 true] whileTrue! !

!DebuggerMethodMap methodsFor: 'accessing' stamp: 'MarcusDenker 5/9/2013 11:24'!
namedTempAt: index in: aContext
	"Answer the value of the temp at index in aContext where index is relative
	 to the array of temp names answered by tempNamesForContext:"
	^self
		privateTempAt: index
		in: aContext
		startpcsToBlockExtents: (self startpcsToBlockExtents: aContext method)! !

!DebuggerMethodMap class methodsFor: 'instance creation' stamp: 'MarcusDenker 10/9/2012 18:02'!
forMethod: aMethod "<CompiledMethod>"
	"Answer a DebuggerMethodMap suitable for debugging activations of aMethod"
	^self new forMethod: aMethod
	
				! !

!DebuggerMethodMapOpal commentStamp: '<historical>'!
I provide helper methods deadling with

-> pc to text mapping
-> temporary variables for contexts
-> reading and setting tempary variables

All methods here should be moved to MethodContext.!
!DebuggerMethodMapOpal methodsFor: 'public' stamp: 'MarcusDenker 12/17/2012 17:21'!
namedTempAt: index put: aValue in: aContext
	"Assign the value of the temp at index in aContext where index is relative
	 to the array of temp names answered by tempNamesForContext:.
	 If the value is a copied value we also need to set it along the lexical chain."
	
	| name |	
	name := (self tempNamesForContext: aContext) at: index.
	^self tempNamed: name in: aContext put: aValue.! !

!DebuggerMethodMapOpal methodsFor: 'initialize-release' stamp: 'MarcusDenker 5/13/2013 13:21'!
forMethod: aCompiledMethod 
	methodNode := aCompiledMethod ast! !

!DebuggerMethodMapOpal methodsFor: 'public' stamp: 'MarcusDenker 4/17/2013 22:48'!
tempNamed: name in: aContext put: aValue
	"Assign the value of the temp with name in aContext
	 If the value is a copied value we also need to set it along the lexical chain."

	| scope var |
	scope := aContext sourceNode scope.
	var := scope lookupVar: name.
	^var writeFromContext: aContext scope: scope value: aValue.
	
	
	! !

!DebuggerMethodMapOpal methodsFor: 'public' stamp: 'MarcusDenker 4/17/2013 22:49'!
tempNamesForContext: aContext
	"Answer an Array of all the temp names in scope in aContext starting with
	 the home's first local (the first argument or first temporary if no arguments)."
	
	^ aContext sourceNode scope allTempNames.! !

!DebuggerMethodMapOpal methodsFor: 'public' stamp: 'MarcusDenker 1/24/2013 14:12'!
rangeForPC: aPC
	"return the debug highlight for aPC"
	
	^self rangeForPC: aPC contextIsActiveContext: false
	! !

!DebuggerMethodMapOpal methodsFor: 'public' stamp: 'MarcusDenker 4/19/2013 08:32'!
rangeForPC: aPC contextIsActiveContext: contextIsActive
	"return the debug highlight for aPC"
	| pc |
	
	"When on the top of the stack the pc is pointing to right instruction, but deeper in the stack
	the pc was already advanced one bytecode, so we need to go back this one bytecode, which
	can consist of multiple bytes. But on IR, we record the *last* bytecode offset as the offset of the
	IR instruction, which means we can just go back one"

	pc := contextIsActive ifTrue: [aPC] ifFalse: [aPC - 1].
	^(methodNode sourceNodeForPC:  pc) debugHighlightRange
	! !

!DebuggerMethodMapOpal methodsFor: 'public' stamp: 'GuillermoPolito 4/9/2015 17:36'!
tempNamed: name in: aContext
	"Answer the value of the temp with name in aContext"
	
	| scope var |
	scope := aContext sourceNode scope.
	var := scope lookupVar: name.
	^var searchFromContext: aContext scope: scope.
		! !

!DebuggerMethodMapOpal methodsFor: 'public' stamp: 'MarcusDenker 12/17/2012 17:20'!
namedTempAt: index in: aContext
	"Answer the value of the temp at index in aContext where index is relative
	 to the array of temp names answered by tempNamesForContext:"

	| name |	
	name := (self tempNamesForContext: aContext) at: index.
	^self tempNamed: name in: aContext.! !

!DebuggerMethodMapOpal class methodsFor: 'instance creation' stamp: 'MarcusDenker 11/16/2012 12:11'!
forMethod: aMethod "<CompiledMethod>"
	"Answer a DebuggerMethodMap suitable for debugging activations of aMethod"
	^self new forMethod: aMethod
	
				! !

!DebuggerModelTest commentStamp: 'TorstenBergmann 2/20/2014 15:44'!
SUnit tests for the debugger model!
!DebuggerModelTest methodsFor: 'tests' stamp: 'AndreiChis 9/25/2013 18:13'!
testCorrectlyCreateDebugSession

	session := DebugSession process: process context: context.

	self assert: session isNotNil.	
	self assert: process isSuspended.
	self assert: session interruptedContext equals: context.
	self assert: session interruptedContext printString equals: '[ Set new ] in DebuggerModelTest>>setUp'.! !

!DebuggerModelTest methodsFor: 'tests' stamp: 'AndreiChis 9/30/2013 18:39'!
testStepInto

	session:= DebugSession process: process context: context.

	self deny: (session isContextPostMortem: context).
	self assert: session interruptedContext equals: context.
	self assert: session interruptedContext printString equals: '[ Set new ] in DebuggerModelTest>>setUp' .

	session 
		stepInto;
		stepInto.

	self assert: session interruptedContext printString equals: 'Set class>>new'.
! !

!DebuggerModelTest methodsFor: 'running' stamp: 'AndreiChis 9/30/2013 18:35'!
setUp

	context := [ Set new ] asContext.
	process := Process 
		forContext: context 
		priority: Processor userInterruptPriority! !

!DebuggerModelTest methodsFor: 'tests' stamp: 'AndreiChis 9/25/2013 18:14'!
testStepOver

	session:= DebugSession process: process context: context.

	self assert: session interruptedContext equals: context.
	self assert: session interruptedContext printString equals: '[ Set new ] in DebuggerModelTest>>setUp' .

	session stepOver.

	self assert: session interruptedContext printString equals: '[ Set new ] in DebuggerModelTest>>setUp'.! !

!DebuggerTest commentStamp: 'TorstenBergmann 2/4/2014 20:45'!
SUnit tests for Debugger!
!DebuggerTest methodsFor: 'testing' stamp: 'CamilleTeruel 4/4/2014 12:48'!
testBasic
	| context process debugger printedString |
	context := [ 20 factorial ] asContext.

	process := Process 
		forContext: context
		priority: Processor userInterruptPriority.

	debugger := Smalltalk tools debugger new
						process: process
						controller: nil
						context: context.
	debugger stack expand.

	self assert: debugger stack selectedIndex = 1.
	printedString := OpalCompiler isActive 
		ifTrue: [	'[ 20 factorial ] in DebuggerTest>>testBasic']
		ifFalse: [  '[...] in DebuggerTest>>testBasic' ]. 
	self assert: debugger stack selectedItem printString = printedString.
	
	debugger send.
	debugger send.
	self assert: debugger code getText = (Integer>>#factorial) sourceCode.
	self assert: debugger stack selectedItem printString =  'SmallInteger(Integer)>>factorial'.
	process terminate.! !

!Decompiler commentStamp: 'nice 2/3/2011 22:54'!
I decompile a method in three phases:
	Reverser: postfix byte codes -> prefix symbolic codes (nodes and atoms)
	Parser: prefix symbolic codes -> node tree (same as the compiler)
	Printer: node tree -> text (done by the nodes)
	

instance vars:

	constructor <DecompilerConstructor> an auxiliary knowing how to generate Abstract Syntax Tree (node tree)
	method <CompiledMethod> the method being decompiled
	instVars <Array of: String> the instance variables of the class implementing method
	tempVars <String | (OrderedCollection of: String)> hold the names of temporary variables (if known)
		NOTE: POLYMORPHISM WILL BE RESOLVED IN #initSymbols:
	constTable <Collection of: ParseNode> parse node associated with byte encoded constants (nil true false 0 1 -1 etc...)
	stack <OrderedCollection of: (ParseNode | String | Integer) > multipurpose...
	statements <OrderedCollection of: ParseNode> the statements of the method being decompiled 
	lastPc <Integer>
	exit <Integer>
	caseExits <OrderedCollection of: Integer> - stack of exit addresses that have been seen in the branches of caseOf:'s
	lastJumpPc <Integer>
	lastReturnPc <Integer>
	limit <Integer>
	hasValue <Boolean>
	blockStackBase <Integer>
	numLocaltemps <Integer | Symbol> - number of temps local to a block; also a flag indicating decompiling a block
	blockStartsToTempVars <Dictionary key: Integer value: (OrderedCollection of: String)>
	tempVarCount <Integer> number of temp vars used by the method
	lastJumpIfPcStack <OrderedCollection of: Integer> the value of program counter just before the last encountered conditional jumps!
!Decompiler methodsFor: 'private' stamp: 'eem 9/6/2008 09:27'!
scanBlockScopeFor: refpc from: startpc to: endpc with: scan scanner: scanner
	| bsl maybeBlockSize |
	bsl := BlockStartLocator new.
	scanner pc: startpc.
	[scanner pc <= endpc] whileTrue:
		[refpc = scanner pc ifTrue:
			[scanner pc: startpc.
			 [scanner pc <= endpc] whileTrue:
				[(scan value: scanner firstByte) ifTrue:
					[^endpc].
				 (maybeBlockSize := scanner interpretNextInstructionFor: bsl) isInteger ifTrue:
					[scanner pc: scanner pc + maybeBlockSize]].
			   ^self].
		 (maybeBlockSize := scanner interpretNextInstructionFor: bsl) isInteger ifTrue:
			[refpc <= (scanner pc + maybeBlockSize)
				ifTrue: [^self scanBlockScopeFor: refpc from: scanner pc to: scanner pc + maybeBlockSize with: scan scanner: scanner]
				ifFalse: [scanner pc: scanner pc + maybeBlockSize]]]! !

!Decompiler methodsFor: 'instruction decoding' stamp: 'marcusDenker 2/26/2012 20:09'!
send: selector super: superFlag numArgs: numArgs

	| args rcvr selNode msgNode messages |
	args := Array new: numArgs.
	(numArgs to: 1 by: -1) do:
		[:i | args at: i put: stack removeLast].
	rcvr := stack removeLast.
	superFlag ifTrue: [rcvr := constructor codeSuper].
	((#(closureCopy:copiedValues:) includes: selector)
	  and: [self checkForBlock: rcvr selector: selector arguments: args]) ifFalse:
		[selNode := constructor codeAnySelector: selector.
		rcvr == CascadeFlag
			ifTrue:
				["May actually be a cascade or an ifNil: for value."
				self willJumpIfFalse
					ifTrue: "= generated by a case macro"
						[selector == #= ifTrue:
							[" = signals a case statement..."
							statements addLast: args first.
							stack addLast: rcvr. "restore CascadeFlag"
							^ self].
						selector == #== ifTrue:
							[" == signals an ifNil: for value..."
							stack removeLast; removeLast.
							rcvr := stack removeLast.
							stack addLast: IfNilFlag;
								addLast: (constructor
									codeMessage: rcvr
									selector: selNode
									arguments: args).
							^ self]]
					ifFalse:
						[(self willJumpIfTrue and: [selector == #==]) ifTrue:
							[" == signals an ifNotNil: for value..."
							stack removeLast; removeLast.
							rcvr := stack removeLast.
							stack addLast: IfNilFlag;
								addLast: (constructor
									codeMessage: rcvr
									selector: selNode
									arguments: args).
							^ self]].
				msgNode := constructor
								codeCascadedMessage: selNode
								arguments: args.
				stack last == CascadeFlag ifFalse:
					["Last message of a cascade"
					statements addLast: msgNode.
					messages := self popTo: stack removeLast.  "Depth saved by first dup"
					msgNode := constructor
									codeCascade: stack removeLast
									messages: messages]]
			ifFalse:
				[msgNode := constructor
							codeMessage: rcvr
							selector: selNode
							arguments: args].
		stack addLast: msgNode]! !

!Decompiler methodsFor: 'instruction decoding' stamp: 'nice 2/3/2011 22:57'!
jump: dist if: condition

	| savePc sign elsePc elseStart end cond ifExpr thenBlock elseBlock
	  thenJump elseJump condHasValue isIfNil saveStack blockBody |
	lastJumpIfPcStack addLast: lastPc.
	stack last == CascadeFlag ifTrue: [^ [self case: dist] ensure: [lastJumpIfPcStack removeLast]].
	elsePc := lastPc.
	elseStart := pc + dist.
	end := limit.
	"Check for bfp-jmp to invert condition.
	Don't be fooled by a loop with a null body."
	sign := condition.
	savePc := pc.
	self interpretJump ifNotNil:
		[:elseDist|
		 (elseDist >= 0 and: [elseStart = pc]) ifTrue:
			 [sign := sign not.  elseStart := pc + elseDist]].
	pc := savePc.
	ifExpr := stack removeLast.
	(isIfNil := stack size > 0 and: [stack last == IfNilFlag]) ifTrue:
		[stack removeLast].
	saveStack := stack.
	stack := OrderedCollection new.
	thenBlock := self blockTo: elseStart.
	condHasValue := hasValue or: [isIfNil].
	"ensure jump is within block (in case thenExpr returns)"
	thenJump := exit <= end ifTrue: [exit] ifFalse: [elseStart].
	"if jump goes back, then it's a loop"
	thenJump < elseStart
		ifTrue:
			["Must be a while loop...
			  thenJump will jump to the beginning of the while expr.  In the case of while's
			  with a block in the condition, the while expr should include more than just
			  the last expression: find all the statements needed by re-decompiling."
			stack := saveStack.
			pc := thenJump.
			blockBody := self statementsTo: elsePc.
			"discard unwanted statements from block"
			blockBody size - 1 timesRepeat: [statements removeLast].
			statements addLast:
				(constructor
					codeMessage: (constructor codeBlock: blockBody returns: false)
					selector: (constructor
								codeSelector: (sign
												ifTrue: [#whileFalse:]
												ifFalse: [#whileTrue:])
								code: #macro)
					arguments: { thenBlock }).
			pc := elseStart.
			self convertToDoLoop]
		ifFalse:
			["Must be a conditional..."
			elseBlock := self blockTo: thenJump.
			elseJump := exit.
			"if elseJump is backwards, it is not part of the elseExpr"
			elseJump < elsePc ifTrue:
				[pc := lastPc].
			cond := isIfNil
						ifTrue:
							[constructor
								codeMessage: ifExpr ifNilReceiver
								selector: (constructor
											codeSelector: (sign ifTrue: [#ifNotNil:] ifFalse: [#ifNil:])
											code: #macro)
								arguments: (Array with: thenBlock)]
						ifFalse:
							[constructor
								codeMessage: ifExpr
								selector: (constructor codeSelector: #ifTrue:ifFalse: code: #macro)
								arguments:	(sign
												ifTrue: [{elseBlock. thenBlock}]
												ifFalse: [{thenBlock. elseBlock}])].
			stack := saveStack.
			condHasValue
				ifTrue: [stack addLast: cond]
				ifFalse: [statements addLast: cond]].
	lastJumpIfPcStack removeLast.! !

!Decompiler methodsFor: 'private' stamp: 'MarcusDenker 5/9/2013 11:08'!
decompile: aSelector in: aClass method: aMethod

	^self
		decompile: aSelector
		in: aClass
		method: aMethod
		using: (self constructorForMethod: aMethod)! !

!Decompiler methodsFor: 'private' stamp: 'di 12/26/1998 21:29'!
quickMethod
	| |
	method isReturnSpecial
		ifTrue: [^ constructor codeBlock:
				(Array with: (constTable at: method primitive - 255)) returns: true].
	method isReturnField
		ifTrue: [^ constructor codeBlock:
				(Array with: (constructor codeInst: method returnField)) returns: true].
	self error: 'improper short method'! !

!Decompiler methodsFor: 'instruction decoding' stamp: 'eem 8/12/2010 13:51'!
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
	| copiedValues |
	self sawClosureBytecode.
	copiedValues := ((1 to: numCopied) collect: [:ign| stack removeLast]) reversed.
	self doClosureCopyCopiedValues: copiedValues numArgs: numArgs blockSize: blockSize! !

!Decompiler methodsFor: 'instruction decoding' stamp: ''!
storeIntoLiteralVariable: assoc

	self pushLiteralVariable: assoc; doStore: stack! !

!Decompiler methodsFor: 'initialize-release' stamp: 'MarcusDenker 5/9/2013 11:27'!
mapFromBlockStartsIn: aMethod toTempVarsFrom: schematicTempNamesString constructor: aDecompilerConstructor
	| map |
	map := aMethod debuggerMap
				mapFromBlockKeys: (aMethod debuggerMap startpcsToBlockExtents: aMethod) keys asArray sort
				toSchematicTemps: schematicTempNamesString
				method: aMethod.
	map keysAndValuesDo:
		[:startpc :tempNameTupleVector|
		tempNameTupleVector isEmpty ifFalse:
			[| subMap numTemps tempVector |
			subMap := Dictionary new.
			"Find how many temp slots there are (direct & indirect temp vectors)
			 and for each indirect temp vector find how big it is."
			tempNameTupleVector do:
				[:tuple|
				tuple last isArray
					ifTrue:
						[subMap at: tuple last first put: tuple last last.
						 numTemps := tuple last first]
					ifFalse:
						[numTemps := tuple last]].
			"create the temp vector for this scope level."
			tempVector := Array new: numTemps.
			"fill it in with any indirect temp vectors"
			subMap keysAndValuesDo:
				[:index :size|
				tempVector at: index put: (Array new: size)].
			"fill it in with temp nodes."
			tempNameTupleVector do:
				[:tuple| | itv |
				tuple last isArray
					ifTrue:
						[itv := tempVector at: tuple last first.
						 itv at: tuple last last
							put: (aDecompilerConstructor
									codeTemp: tuple last last - 1
									named: tuple first)]
					ifFalse:
						[tempVector
							at: tuple last
							put: (aDecompilerConstructor
									codeTemp: tuple last - 1
									named: tuple first)]].
			"replace any indirect temp vectors with proper RemoteTempVectorNodes"
			subMap keysAndValuesDo:
				[:index :size|
				tempVector
					at: index
					put: (aDecompilerConstructor
							codeRemoteTemp: index
							remoteTemps: (tempVector at: index))].
			"and update the entry in the map"
			map at: startpc put: tempVector]].
	^map! !

!Decompiler methodsFor: 'instruction decoding' stamp: 'eem 6/4/2008 14:45'!
pushNewArrayOfSize: size
	self sawClosureBytecode.
	stack addLast: #pushNewArray -> (Array new: size)! !

!Decompiler methodsFor: 'private' stamp: 'eem 9/5/2008 18:41'!
convertToDoLoop
	"If statements contains the pattern
		var := startExpr.
		[var <= limit] whileTrue: [...statements... var := var + incConst]
	then replace this by
		startExpr to: limit by: incConst do: [:var | ...statements...]"
	| initStmt toDoStmt limitStmt |
	statements size < 2 ifTrue: [^ self].
	initStmt := statements at: statements size-1.
	(toDoStmt := statements last toDoFromWhileWithInit: initStmt)
		== nil ifTrue: [^ self].
	initStmt variable scope: -1.  "Flag arg as block temp"
	statements removeLast; removeLast; addLast: toDoStmt.

	"Attempt further conversion of the pattern
		limitVar := limitExpr.
		startExpr to: limitVar by: incConst do: [:var | ...statements...]
	to
		startExpr to: limitExpr by: incConst do: [:var | ...statements...]"
	statements size < 2 ifTrue: [^ self].
	limitStmt := statements at: statements size-1.
	((limitStmt isMemberOf: AssignmentNode)
		and: [limitStmt variable isTemp
		and: [limitStmt variable == toDoStmt arguments first
		and: [self blockScopeRefersOnlyOnceToTemp: limitStmt variable fieldOffset]]])
		ifFalse: [^ self].
	toDoStmt arguments at: 1 put: limitStmt value.
	limitStmt variable scope: -2.  "Flag limit var so it won't print"
	statements removeLast; removeLast; addLast: toDoStmt.

! !

!Decompiler methodsFor: 'private' stamp: 'eem 9/6/2008 08:45'!
blockScopeRefersOnlyOnceToTemp: offset
	| nRefs byteCode extension scanner scan |
	scanner := InstructionStream on: method.
	nRefs := 0.
	scan := offset <= 15
				ifTrue:
					[byteCode := 16 + offset.
					 [:instr |
					  instr = byteCode ifTrue:
						[nRefs := nRefs + 1].
					  nRefs > 1]]
				ifFalse:
					[extension := 64 + offset.
					 [:instr |
					  (instr = 128 and: [scanner followingByte = extension]) ifTrue:
						[nRefs := nRefs + 1].
					   nRefs > 1]].
	self scanBlockScopeFor: pc from: method initialPC to: method endPC with: scan scanner: scanner.
	^nRefs = 1! !

!Decompiler methodsFor: 'control' stamp: ''!
statementsTo: end
	"Decompile the method from pc up to end and return an array of
	expressions. If at run time this block will leave a value on the stack,
	set hasValue to true. If the block ends with a jump or return, set exit
	to the destination of the jump, or the end of the method; otherwise, set
	exit = end. Leave pc = end."

	| blockPos stackPos t |
	blockPos := statements size.
	stackPos := stack size.
	[pc < end]
		whileTrue:
			[lastPc := pc.  limit := end.  "for performs"
			self interpretNextInstructionFor: self].
	"If there is an additional item on the stack, it will be the value
	of this block."
	(hasValue := stack size > stackPos)
		ifTrue:
			[statements addLast: stack removeLast].
	lastJumpPc = lastPc ifFalse: [exit := pc].
	^self popTo: blockPos! !

!Decompiler methodsFor: 'instruction decoding' stamp: ''!
popIntoReceiverVariable: offset

	self pushReceiverVariable: offset; doStore: statements! !

!Decompiler methodsFor: 'instruction decoding' stamp: 'eem 9/26/2008 15:43'!
methodReturnTop
	| last |
	last := stack removeLast "test test" asReturnNode.
	stack size > blockStackBase  "get effect of elided pop before return"
		ifTrue: [statements addLast: stack removeLast].
	exit := pc.
	lastJumpPc := lastReturnPc := lastPc.
	statements addLast: last! !

!Decompiler methodsFor: 'instruction decoding' stamp: 'eem 6/4/2008 14:44'!
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
	self sawClosureBytecode.
	self pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex; doStore: statements! !

!Decompiler methodsFor: 'initialize-release' stamp: 'eem 7/1/2009 14:45'!
initSymbols: aClass
	constructor method: method class: aClass literals: method literals.
	constTable := constructor codeConstants.
	instVars := Array new: aClass instSize.
	tempVarCount := method numTemps.
	"(tempVars isNil
	 and: [method holdsTempNames]) ifTrue:
		[tempVars := method tempNamesString]."
	tempVars isString
		ifTrue:
			[blockStartsToTempVars := self mapFromBlockStartsIn: method
											toTempVarsFrom: tempVars
											constructor: constructor.
			 tempVars := blockStartsToTempVars at: method initialPC]
		ifFalse:
			[| namedTemps |
			namedTemps := tempVars ifNil: [(1 to: tempVarCount) collect: [:i| 't', i printString]].
			tempVars := (1 to: tempVarCount) collect:
							[:i | i <= namedTemps size
								ifTrue: [constructor codeTemp: i - 1 named: (namedTemps at: i)]
								ifFalse: [constructor codeTemp: i - 1]]].
	1 to: method numArgs do:
		[:i|
		(tempVars at: i) beMethodArg]! !

!Decompiler methodsFor: 'instruction decoding' stamp: ''!
pushActiveContext

	stack addLast: constructor codeThisContext! !

!Decompiler methodsFor: 'private' stamp: 'GuillermoPolito 4/26/2012 11:20'!
decompile: aSelector in: aClass method: aMethod using: aConstructor

	| block node |
	constructor := aConstructor.
	method := aMethod.
	self initSymbols: aClass.  "create symbol tables"
	method isQuick
		ifTrue: [block := self quickMethod]
		ifFalse: 
			[stack := OrderedCollection new: method frameSize.
			lastJumpIfPcStack := OrderedCollection new.
			caseExits := OrderedCollection new.
			statements := OrderedCollection new: 20.
			numLocalTemps := 0.
			super method: method pc: method initialPC.
			"skip primitive error code store if necessary"
			(method isPrimitive and: [self willStore]) ifTrue:
				[pc := pc + 2.
				 tempVars := tempVars asOrderedCollection].
			block := self blockTo: method endPC + 1.
			stack isEmpty ifFalse: [self error: 'stack not empty']].
	node := constructor
				codeMethod: aSelector
				block: block
				tempVars: tempVars
				primitive: method primitive
				class: aClass.
	method isPrimitive ifTrue:
		[node removeAndRenameLastTempIfErrorCode].
	^node preen! !

!Decompiler methodsFor: 'private' stamp: 'MarcusDenker 2/26/2012 10:46'!
constructorForMethod: aMethod
	^DecompilerConstructorForClosures new! !

!Decompiler methodsFor: 'instruction decoding' stamp: 'nk 2/20/2004 11:56'!
pushReceiverVariable: offset

	| var |
	(var := instVars at: offset + 1 ifAbsent: []) == nil
		ifTrue:
			["Not set up yet"
			var := constructor codeInst: offset.
			instVars size < (offset + 1) ifTrue: [
				instVars := (Array new: offset + 1)
					replaceFrom: 1 to: instVars size with: instVars; yourself ].
			instVars at: offset + 1 put: var].
	stack addLast: var! !

!Decompiler methodsFor: 'control' stamp: 'ls 1/28/2004 13:29'!
statementsForCaseTo: end
	"Decompile the method from pc up to end and return an array of
	expressions. If at run time this block will leave a value on the stack,
	set hasValue to true. If the block ends with a jump or return, set exit
	to the destination of the jump, or the end of the method; otherwise, set
	exit = end. Leave pc = end.
	Note that stack initially contains a CaseFlag which will be removed by
	a subsequent Pop instruction, so adjust the StackPos accordingly."

	| blockPos stackPos |
	blockPos := statements size.
	stackPos := stack size - 1. "Adjust for CaseFlag"
	[pc < end]
		whileTrue:
			[lastPc := pc.  limit := end.  "for performs"
			self interpretNextInstructionFor: self].
	"If there is an additional item on the stack, it will be the value
	of this block."
	(hasValue := stack size > stackPos)
		ifTrue:
			[stack last == CaseFlag
				ifFalse: [ statements addLast: stack removeLast] ].
	lastJumpPc = lastPc ifFalse: [exit := pc].
	caseExits add: exit.
	^self popTo: blockPos! !

!Decompiler methodsFor: 'instruction decoding' stamp: 'eem 9/25/2008 09:48'!
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
	self sawClosureBytecode.
	stack addLast: ((tempVars at: tempVectorIndex + 1) remoteTemps at: remoteTempIndex + 1)! !

!Decompiler methodsFor: 'instruction decoding' stamp: ''!
storeIntoTemporaryVariable: offset

	self pushTemporaryVariable: offset; doStore: stack! !

!Decompiler methodsFor: 'instruction decoding' stamp: ''!
pushReceiver

	stack addLast: (constTable at: 1)! !

!Decompiler methodsFor: 'instruction decoding' stamp: ''!
methodReturnReceiver

	self pushReceiver; methodReturnTop! !

!Decompiler methodsFor: 'instruction decoding' stamp: 'jannik.laval 5/1/2010 16:10'!
popIntoTemporaryVariable: offset
	| maybeTVTag tempVector start |
	maybeTVTag := stack last.
	((maybeTVTag isMemberOf: Association)
	 and: [maybeTVTag key == #pushNewArray]) ifTrue:
		[blockStartsToTempVars notNil "implies we were intialized with temp names."
			ifTrue: "Use the provided temps"
				[[(tempVector := tempVars at: offset + 1 ifAbsent: [ParseNode basicNew]) isTemp
							 and: [tempVector isIndirectTempVector
							 and: [tempVector remoteTemps size = maybeTVTag value size]]] assert]
			ifFalse: "Synthesize some remote temps"
				[tempVector := maybeTVTag value.
				 offset + 1 <= tempVars size
					ifTrue:
						[start := 2.
						 tempVector at: 1 put: (tempVars at: offset + 1)]
					ifFalse:
						[tempVars := (Array new: offset + 1)
										replaceFrom: 1
										to: tempVars size
										with: tempVars.
						start := 1].
				 start to: tempVector size do:
					[:i|
					tempVector
						at: i
						put: (constructor
								codeTemp: numLocalTemps + offset + i - 1
								named: 't', (tempVarCount + i) printString)].
				tempVars at: offset + 1 put: (constructor codeRemoteTemp: offset + 1 remoteTemps: tempVector)].
		 tempVarCount := tempVarCount + maybeTVTag value size.
		 stack removeLast.
		 ^self].
	self pushTemporaryVariable: offset; doStore: statements! !

!Decompiler methodsFor: 'instruction decoding' stamp: ''!
blockReturnTop
	"No action needed"! !

!Decompiler methodsFor: 'public access' stamp: ''!
tempAt: offset
	"Needed by BraceConstructor<PopIntoTemporaryVariable"

	^tempVars at: offset + 1! !

!Decompiler methodsFor: 'instruction decoding' stamp: ''!
storeIntoReceiverVariable: offset

	self pushReceiverVariable: offset; doStore: stack! !

!Decompiler methodsFor: 'instruction decoding' stamp: ''!
doStore: stackOrBlock
	"Only called internally, not from InstructionStream. StackOrBlock is stack
	for store, statements for storePop."

	| var expr |
	var := stack removeLast.
	expr := stack removeLast.
	stackOrBlock addLast: (expr == ArgumentFlag
		ifTrue: [var]
		ifFalse: [constructor codeAssignTo: var value: expr])! !

!Decompiler methodsFor: 'public access' stamp: 'MarcusDenker 5/1/2013 12:04'!
decompileMethod: aMethod

	^self
		decompile: aMethod selector
		in: aMethod methodClass
		method: aMethod! !

!Decompiler methodsFor: 'instruction decoding' stamp: ''!
popIntoLiteralVariable: value

	self pushLiteralVariable: value; doStore: statements! !

!Decompiler methodsFor: 'private' stamp: 'eem 6/4/2008 14:43'!
sawClosureBytecode
	constructor isForClosures ifFalse:
		[constructor primitiveChangeClassTo: DecompilerConstructorForClosures new]! !

!Decompiler methodsFor: 'control' stamp: 'tao 8/20/97 22:51'!
blockForCaseTo: end
	"Decompile a range of code as in statementsForCaseTo:, but return a block node."
	| exprs block oldBase |
	oldBase := blockStackBase.
	blockStackBase := stack size.
	exprs := self statementsForCaseTo: end.
	block := constructor codeBlock: exprs returns: lastReturnPc = lastPc.
	blockStackBase := oldBase.
	lastReturnPc := -1.  "So as not to mislead outer calls"
	^block! !

!Decompiler methodsFor: 'control' stamp: 'ClementBera 12/29/2014 12:00'!
doClosureCopyCopiedValues: blockCopiedValues numArgs: numArgs blockSize: blockSize
	| startpc savedTemps savedTempVarCount savedNumLocalTemps
	  jump blockArgs blockTemps blockTempsOffset block |
	savedTemps := tempVars.
	savedTempVarCount := tempVarCount.
	savedNumLocalTemps := numLocalTemps.
	jump := blockSize + (startpc := pc).
	numLocalTemps := method encoderClass numLocalTempsForBlockAt: startpc in: method.
	blockTempsOffset := numArgs + blockCopiedValues size.
	(blockStartsToTempVars notNil "implies we were intialized with temp names."
	 and: [blockStartsToTempVars includesKey: pc])
		ifTrue:
			[tempVars := blockStartsToTempVars at: pc]
		ifFalse:
			[blockArgs := (1 to: numArgs) collect:
							[:i| (constructor
									codeTemp: i - 1
									named: 't', (tempVarCount + i) printString)
								  beBlockArg].
			blockTemps := (1 to: numLocalTemps) collect:
							[:i| constructor
									codeTemp: i + blockTempsOffset - 1
									named: 't', (tempVarCount + i + numArgs) printString].
			tempVars := blockArgs, blockCopiedValues, blockTemps].
	numLocalTemps timesRepeat:
		[self interpretNextInstructionFor: self.
		 stack removeLast].
	tempVarCount := tempVarCount + numArgs + numLocalTemps.
	block := self blockTo: jump.
	stack addLast: ((constructor
						codeArguments: (tempVars copyFrom: 1 to: numArgs)
						temps: (tempVars copyFrom: blockTempsOffset + 1 to: blockTempsOffset + numLocalTemps)
						block: block)
							pc: startpc;
							yourself).
	tempVars := savedTemps.
	tempVarCount := savedTempVarCount.
	numLocalTemps := savedNumLocalTemps! !

!Decompiler methodsFor: 'control' stamp: ''!
blockTo: end
	"Decompile a range of code as in statementsTo:, but return a block node."
	| exprs block oldBase |
	oldBase := blockStackBase.
	blockStackBase := stack size.
	exprs := self statementsTo: end.
	block := constructor codeBlock: exprs returns: lastReturnPc = lastPc.
	blockStackBase := oldBase.
	lastReturnPc := -1.  "So as not to mislead outer calls"
	^block! !

!Decompiler methodsFor: 'instruction decoding' stamp: 'di 2/5/2000 09:34'!
doPop

	stack isEmpty ifTrue:
		["Ignore pop in first leg of ifNil for value"
		^ self].
	stack last == CaseFlag
		ifTrue: [stack removeLast]
		ifFalse: [statements addLast: stack removeLast].! !

!Decompiler methodsFor: 'instruction decoding' stamp: ''!
pushTemporaryVariable: offset

	stack addLast: (tempVars at: offset + 1)! !

!Decompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 12/28/2014 17:31'!
blockReturnConstant: value 
	self pushConstant: value;
		 blockReturnTop
! !

!Decompiler methodsFor: 'instruction decoding' stamp: 'eem 6/4/2008 14:44'!
pushConsArrayWithElements: numElements 
	| array |
	self sawClosureBytecode.
	array := Array new: numElements.
	numElements to: 1 by: -1 do:
		[:i|
		array at: i put: stack removeLast].
	stack addLast: (constructor codeBrace: array)! !

!Decompiler methodsFor: 'instruction decoding' stamp: 'nice 2/3/2011 22:56'!
jump: dist
	| blockBody destPc nextPC |
	destPc := pc + dist.
	(lastJumpIfPcStack isEmpty or: [dist < 0 and: [destPc > lastJumpIfPcStack last]])
		ifTrue:
			["Rule: aBackward jump not crossing a Bfp/Btp must be a repeat"
			nextPC := pc.
			pc := destPc.
			blockBody := self statementsTo: lastPc.
			blockBody size timesRepeat: [statements removeLast].
			pc := nextPC.
			statements addLast:
				(constructor
					codeMessage: (constructor codeBlock: blockBody returns: false)
					selector: (constructor
								codeSelector: #repeat
								code: #macro)
					arguments: #()).
			]
		ifFalse:
			[exit := destPc.
			lastJumpPc := lastPc]! !

!Decompiler methodsFor: 'instruction decoding' stamp: ''!
methodReturnConstant: value

	self pushConstant: value; methodReturnTop! !

!Decompiler methodsFor: 'private' stamp: ''!
popTo: oldPos

	| t |
	t := Array new: statements size - oldPos.
	(t size to: 1 by: -1) do:
		[:i | t at: i put: statements removeLast].
	^t! !

!Decompiler methodsFor: 'control' stamp: 'eem 5/29/2008 17:02'!
checkForClosureCopy: receiver arguments: arguments
	"We just saw a closureCopy:copiedValues: message. Check for and construct a following block."

	| savePc jump |
	receiver == constructor codeThisContext ifFalse: [^false].
	savePc := pc.
	(jump := self interpretJump) notNil ifFalse:
		[pc := savePc.
		 ^nil].
	"Definitely a block"
	self doClosureCopyCopiedValues: arguments last "<BraceNode>" elements
		numArgs: arguments first key
		blockSize: jump.
	^true! !

!Decompiler methodsFor: 'instruction decoding' stamp: 'eem 6/4/2008 14:45'!
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
	self sawClosureBytecode.
	self pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex; doStore: stack! !

!Decompiler methodsFor: 'instruction decoding' stamp: 'PeterHugossonMiller 9/2/2009 16:08'!
case: dist
	"statements = keyStmts CascadeFlag keyValueBlock ... keyStmts"

	| nextCase thenJump stmtStream elements b node cases otherBlock myExits |
	nextCase := pc + dist.

	"Now add CascadeFlag & keyValueBlock to statements"
	statements addLast: stack removeLast.
	stack addLast: CaseFlag. "set for next pop"
	statements addLast: (self blockForCaseTo: nextCase).

	stack last == CaseFlag
		ifTrue: "Last case"
			["ensure jump is within block (in case thenExpr returns wierdly I guess)"
			stack removeLast. "get rid of CaseFlag"
			stmtStream := (self popTo: stack removeLast) readStream.
			
			elements := OrderedCollection new.
			b := OrderedCollection new.
			[stmtStream atEnd] whileFalse:
				[(node := stmtStream next) == CascadeFlag
					ifTrue:
						[elements addLast: (constructor
							codeMessage: (constructor codeBlock: b returns: false)
							selector: (constructor codeSelector: #-> code: #macro)
							arguments: (Array with: stmtStream next)).
						 b := OrderedCollection new]
					ifFalse: [b addLast: node]].
			b size > 0 ifTrue: [self error: 'Bad cases'].
			cases := constructor codeBrace: elements.
			
			"try find the end of the case"
			myExits := caseExits removeLast: elements size.
			myExits := myExits reject: [ :e | e isNil or: [ e < 0 or: [ e > method endPC ] ] ].
			thenJump := myExits isEmpty
							ifTrue: [ nextCase ]
							ifFalse: [ myExits max ].
			
			otherBlock := self blockTo: thenJump.
			stack addLast:
				(constructor
					codeMessage: stack removeLast
					selector: (constructor codeSelector: #caseOf:otherwise: code: #macro)
					arguments: (Array with: cases with: otherBlock))].! !

!Decompiler methodsFor: 'control' stamp: 'marcusDenker 2/26/2012 20:08'!
checkForBlock: receiver selector: selector arguments: arguments
	[selector == #closureCopy:copiedValues:] assert.
	^self checkForClosureCopy: receiver arguments: arguments! !

!Decompiler methodsFor: 'instruction decoding' stamp: ''!
pushLiteralVariable: assoc

	stack addLast: (constructor codeAnyLitInd: assoc)! !

!Decompiler methodsFor: 'instruction decoding' stamp: ''!
doDup

	stack last == CascadeFlag
		ifFalse:
			["Save position and mark cascade"
			stack addLast: statements size.
			stack addLast: CascadeFlag].
	stack addLast: CascadeFlag! !

!Decompiler methodsFor: 'instruction decoding' stamp: ''!
pushConstant: value

	| node |
	node := value == true ifTrue: [constTable at: 2]
		ifFalse: [value == false ifTrue: [constTable at: 3]
		ifFalse: [value == nil ifTrue: [constTable at: 4]
		ifFalse: [constructor codeAnyLiteral: value]]].
	stack addLast: node! !

!Decompiler class methodsFor: 'initialization' stamp: 'di 1/28/2000 22:21'!
initialize

	CascadeFlag := 'cascade'.  "A unique object"
	CaseFlag := 'case'. "Ditto"
	ArgumentFlag := 'argument'.  "Ditto"
	IfNilFlag := 'ifNil'.  "Ditto"

	"Decompiler initialize"! !

!Decompiler class methodsFor: 'public' stamp: 'MarcusDenker 9/29/2014 14:23'!
decompile: aCompiledMethod
	"Answers a decompiled AST for the compiled method"
	^ self new decompileMethod: aCompiledMethod! !

!DecompilerConstructor commentStamp: '<historical>'!
I construct the node tree for a Decompiler.!
!DecompilerConstructor methodsFor: 'constructor' stamp: 'sma 3/3/2000 13:35'!
codeEmptyBlock
	^ BlockNode withJust: NodeNil! !

!DecompilerConstructor methodsFor: 'constructor' stamp: 'sma 3/3/2000 13:34'!
codeBlock: statements returns: returns
	^ BlockNode statements: statements returns: returns! !

!DecompilerConstructor methodsFor: 'constructor' stamp: ''!
codeTemp: index

	^ TempVariableNode new
		name: 't' , (index + 1) printString
		index: index
		type: LdTempType
		scope: 0! !

!DecompilerConstructor methodsFor: 'constructor' stamp: ''!
codeThisContext

	^NodeThisContext! !

!DecompilerConstructor methodsFor: 'constructor' stamp: 'eem 5/21/2008 13:28'!
codeArguments: args temps: temps block: block 
	block
		arguments: args;
		temporaries: temps.
	^block! !

!DecompilerConstructor methodsFor: 'constructor' stamp: ''!
codeAssignTo: variable value: expression

	^AssignmentNode new variable: variable value: expression! !

!DecompilerConstructor methodsFor: 'constructor' stamp: 'jmv 3/3/2011 09:17'!
decodeIfNilWithReceiver: receiver selector: selector arguments: arguments
	receiver ifNil: [ ^nil ].		"For instance, when cascading"
	selector == #ifTrue:ifFalse:
		ifFalse: [^ nil].
	(receiver isMessage: #==
				receiver: nil
				arguments: [:argNode | argNode == NodeNil])
		ifFalse: [^ nil].
	^ (MessageNode new
			receiver: receiver
			selector: (SelectorNode new key: #ifTrue:ifFalse: code: #macro)
			arguments: arguments
			precedence: 3)
		noteSpecialSelector: #ifNil:ifNotNil:! !

!DecompilerConstructor methodsFor: 'constructor' stamp: ''!
codeArguments: args block: block

	^block arguments: args! !

!DecompilerConstructor methodsFor: 'constructor' stamp: ''!
codeSuper

	^NodeSuper! !

!DecompilerConstructor methodsFor: 'constructor' stamp: ''!
codeCascadedMessage: selector arguments: arguments

	^self
		codeMessage: nil
		selector: selector
		arguments: arguments! !

!DecompilerConstructor methodsFor: 'constructor' stamp: ''!
codeConstants
	"Answer with an array of the objects representing self, true, false, nil,
	-1, 0, 1, 2."

	^(Array with: NodeSelf with: NodeTrue with: NodeFalse with: NodeNil)
		, ((-1 to: 2) collect: [:i | LiteralNode new key: i code: LdMinus1 + i + 1])! !

!DecompilerConstructor methodsFor: 'constructor' stamp: ''!
codeAnySelector: selector

	^SelectorNode new
		key: selector
		index: 0
		type: SendType! !

!DecompilerConstructor methodsFor: 'constructor' stamp: 'di 11/19/1999 11:06'!
codeCascade: receiver messages: messages

	^ (BraceNode new matchBraceStreamReceiver: receiver messages: messages)
		ifNil: [CascadeNode new receiver: receiver messages: messages]! !

!DecompilerConstructor methodsFor: 'constructor' stamp: ''!
codeAnyLitInd: association

	^VariableNode new
		name: association key
		key: association
		index: 0
		type: LdLitIndType! !

!DecompilerConstructor methodsFor: 'constructor' stamp: ''!
codeAnyLiteral: value

	^LiteralNode new
		key: value
		index: 0
		type: LdLitType! !

!DecompilerConstructor methodsFor: 'constructor' stamp: 'eem 8/21/2008 14:02'!
codeInst: index

	^InstanceVariableNode new
		name: (instVars at: index + 1 ifAbsent: ['unknown', index asString])
		index: index + 1! !

!DecompilerConstructor methodsFor: 'constructor' stamp: 'eem 9/23/2008 22:06'!
codeMethod: selector block: block tempVars: vars primitive: primitive class: class

	| node methodTemps arguments temporaries |
	node := self codeSelector: selector code: nil.
	tempVars := vars.
	methodTemps := tempVars select: [:t | t scope >= 0].
	arguments := methodTemps copyFrom: 1 to: nArgs.
	temporaries := methodTemps copyFrom: nArgs + 1 to: methodTemps size.
	block
		arguments: arguments;
		temporaries: temporaries.
	^MethodNode new
		selector: node
		arguments: arguments
		precedence: selector precedence
		temporaries: temporaries
		block: block
		encoder: (Encoder new initScopeAndLiteralTables
					temps: tempVars
					literals: literalValues
					class: class)
		primitive: primitive! !

!DecompilerConstructor methodsFor: 'constructor' stamp: ''!
codeBrace: elements

	^BraceNode new elements: elements! !

!DecompilerConstructor methodsFor: 'visiting' stamp: 'eem 5/30/2008 09:44'!
accept: aVisitor
	"I am not really a ParseNode.  Only here to access constants defined in parseNode."
	self shouldNotImplement! !

!DecompilerConstructor methodsFor: 'testing' stamp: 'eem 6/4/2008 14:41'!
isForClosures
	^false! !

!DecompilerConstructor methodsFor: 'constructor' stamp: 'sma 2/5/2000 12:37'!
codeMessage: receiver selector: selector arguments: arguments
	| symbol node |
	symbol := selector key.
	(node := BraceNode new
			matchBraceWithReceiver: receiver
			selector: symbol
			arguments: arguments) ifNotNil: [^ node].
	(node := self decodeIfNilWithReceiver: receiver
			selector: symbol
			arguments: arguments) ifNotNil: [^ node].
	^ MessageNode new
			receiver: receiver selector: selector
			arguments: arguments
			precedence: symbol precedence! !

!DecompilerConstructor methodsFor: 'constructor' stamp: ''!
codeSelector: sel code: code

	^SelectorNode new key: sel code: code! !

!DecompilerConstructor methodsFor: 'constructor' stamp: ''!
codeTemp: index named: tempName

	^ TempVariableNode new
		name: tempName
		index: index
		type: LdTempType
		scope: 0! !

!DecompilerConstructor methodsFor: 'initialize-release' stamp: ''!
method: aMethod class: aClass literals: literals

	method := aMethod.
	instVars := aClass allInstVarNames.
	nArgs := method numArgs.
	literalValues := literals! !

!DecompilerConstructorForClosures commentStamp: 'TorstenBergmann 1/31/2014 11:21'!
Similar to superclass but for closures!
!DecompilerConstructorForClosures methodsFor: 'constructor' stamp: 'eem 10/20/2008 13:01'!
codeRemoteTemp: index remoteTemps: tempVector

	^(RemoteTempVectorNode new
		name: '_r', index printString
		index: index
		type: LdTempType
		scope: 0)
			remoteTemps: tempVector;
			yourself! !

!DecompilerConstructorForClosures methodsFor: 'testing' stamp: 'eem 6/4/2008 14:41'!
isForClosures
	^true! !

!DecompilerConstructorForClosures methodsFor: 'constructor' stamp: 'eem 8/15/2010 16:56'!
codeMethod: selector block: block tempVars: vars primitive: primitive class: class

	| blockNode selectorNode visibleTemps invisibleTemps arguments temporaries |
	selectorNode := self codeSelector: selector code: nil.
	tempVars := vars.
	visibleTemps := OrderedCollection new.
	invisibleTemps := OrderedCollection new.
	tempVars do: [:t|
				   ((t isIndirectTempVector or: [t scope >= 0])
						ifTrue: [visibleTemps]
						ifFalse: [invisibleTemps]) addLast: t].
	arguments := visibleTemps copyFrom: 1 to: nArgs.
	temporaries := visibleTemps copyFrom: nArgs + 1 to: visibleTemps size.
	block
		arguments: arguments;
		temporaries: temporaries.
	blockNode := MethodNode new
		selector: selectorNode
		arguments: arguments
		precedence: selector precedence
		temporaries: temporaries
		block: block
		encoder: (EncoderForV3PlusClosures new initScopeAndLiteralTables
					temps: visibleTemps, invisibleTemps
					literals: literalValues
					class: class)
		primitive: primitive
		properties: method properties copy.
	blockNode properties method: blockNode.
	^blockNode! !

!DeepCopier commentStamp: 'stephane.ducasse 9/25/2008 17:47'!
DeepCopier does a veryDeepCopy.  

It is a complete tree copy using a dictionary.  Any object that is in the tree twice is only copied once.  All references to the object in the copy of the tree will point to the new copy.  See Object|veryDeepCopy which calls (self veryDeepCopyWith: aDeepCopier).

When a tree of morphs points at a morph outside of itself, that morph should not be copied.  Use our own kind of weak pointers for the 'potentially outside' morphs.   Default is that any new class will have all of its fields deeply copied.  If a field needs to be weakly copied, define veryDeepInner: and veryDeepFixupWith:.
     veryDeepInner: has the loop that actually copies the fields.  If a class defines its own copy of veryDeepInner: (to leave some fields out), then veryDeepFixupWith: will be called on that object at the end.  veryDeepInner: can compute an alternate object to put in a field.  (Object veryDeepCopyWith: discovers which superclasses did not define veryDeepInner:, and very deeply copies the variables defined in those classes).
	To decide if a class needs veryDeepInner: and veryDeepFixupWith:, ask this about an instance:  If I duplicate this object, does that mean that I also want to make duplicates of the things it holds onto?  If yes, (i.e. a Paragraph does want a new copy of its Text) then do nothing.  If no, (i.e. an undo command does not want to copy the objects it acts upon), then define veryDeepInner: and veryDeepFixupWith:.
	
Here is an analysis for the specific case of a morph being held by another morph.  
Does field X contain a morph (or a Player whose costume is a morph)?  If not, no action needed.
Is the morph in field X already a submorph of the object?  Is it down lower in the submorph tree?
	If so, no action needed.
Could the morph in field X every appear on the screen (be a submorph of some other morph)?
	If not, no action needed.
	If it could, you must write the methods veryDeepFixupWith:   and   veryDeepInner:, and in them, refrain from sending veryDeepCopyWith: to the contents of field X.


----- Things Ted is still considering -----
Rule:  If a morph stores a uniClass class (Player 57) as an object in a field, the new uniClass will not be stored there.   Each uniClass instance does have a new class created for it.  (fix this by putting the old class in references and allow lookup?  Wrong if encounter it before seeing an instance?)

Rule: If object A has object C in a field, and A says (^ C) for the copy, but object B has A in a normal field and it gets deepCopied, and A in encountered first, then there will be two copies of C.  (just be aware of it)

Dependents are now fixed up.  Suppose a model has a dependent view.  In the DependentFields dictionary, model -> (view ...).  
	If only the model is copied, no dependents are created (no one knows about the new model).  
	If only the view is copied, it is inserted into DependentFields on the right side.  model -> (view  copiedView ...).  
	If both are copied, the new model has the new view as its dependent.
	If additional things depend on a model that is copied, the caller must add them to its dependents.
!
!DeepCopier methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 09:50'!
initialize

	super initialize.
	self initialize: 4096.
! !

!DeepCopier methodsFor: 'like fullCopy' stamp: 'MartinDias 10/25/2013 13:36'!
warnInstanceVariableNotCopiedIn: aClass selector: aSelector
	"Warn the user to update veryDeepCopyWith: or veryDeepInner:"

	self inform: ('An instance variable was added to to class ', aClass name, ',\and it is not copied in the method ', aSelector, '.\Please rewrite it to handle all instance variables.\See DeepCopier class comment.') withCRs.
	
	(Smalltalk respondsTo: #tools) ifTrue: [ 
		Smalltalk tools browser
			fullOnClass: aClass 
			selector: aSelector ]! !

!DeepCopier methodsFor: 'like fullCopy' stamp: 'eem 6/11/2008 17:22'!
fixDependents
	"They are not used much, but need to be right"

	DependentsFields associationsDo:
		[:pair |
		pair value do:
			[:dep |
			(references at: dep ifAbsent: [nil]) ifNotNil:
				[:newDep| | newModel |
				newModel := references at: pair key ifAbsent: [pair key].
				newModel addDependent: newDep]]].
! !

!DeepCopier methodsFor: 'like fullCopy' stamp: 'tk 8/20/1998 22:13'!
references
	^ references! !

!DeepCopier methodsFor: 'like fullCopy' stamp: 'MartinDias 10/25/2013 13:35'!
checkVariables
	"Check that no indexes of instance vars have changed in certain classes.  If you get an error in this method, an implementation of veryDeepCopyWith: needs to be updated.  The idea is to catch a change while it is still in the system of the programmer who made it.  
	DeepCopier new checkVariables	"

	self checkBasicClasses.

	"Every class that implements veryDeepInner: must copy all its inst vars.  Danger is that a user will add a new instance variable and forget to copy it.  So check that the last one is mentioned in the copy method."
	(self systemNavigation allClassesImplementing: #veryDeepInner:) do: 
			[:aClass | 
			((aClass compiledMethodAt: #veryDeepInner:) writesField: aClass instSize) 
				ifFalse: 
					[aClass instSize > 0 
						ifTrue: [self warnInstanceVariableNotCopiedIn: aClass selector: #veryDeepInner:]]].
	(self systemNavigation allClassesImplementing: #veryDeepCopyWith:) do: 
			[:aClass | | meth |
			meth := aClass compiledMethodAt: #veryDeepCopyWith:.
			meth size > 20 & (meth literals includes: #veryDeepCopyWith:) not 
				ifTrue: 
					[(meth writesField: aClass instSize) 
						ifFalse: [self warnInstanceVariableNotCopiedIn: aClass selector: #veryDeepCopyWith:]]]! !

!DeepCopier methodsFor: 'like fullCopy' stamp: 'PavelKrivanek 11/15/2012 09:19'!
checkBasicClasses
	"Check that no indexes of instance vars have changed in certain classes.  If you get an error in this method, an implementation of veryDeepCopyWith: needs to be updated.  The idea is to catch a change while it is still in the system of the programmer who made it.  
	DeepCopier new checkVariables	"

	| str objCls morphCls |
	str := '|veryDeepCopyWith: or veryDeepInner: is out of date.'.
	Object instSize = 0 ifFalse: [self error: 
			'Many implementers of veryDeepCopyWith: are out of date'].


! !

!DeepCopier methodsFor: 'initialization' stamp: 'stephane.ducasse 9/25/2008 17:46'!
initialize: size

	references := IdentityDictionary new: size.
	! !

!DeepCopier methodsFor: 'like fullCopy' stamp: 'eem 6/11/2008 17:21'!
checkDeep
	"Write exceptions in the Transcript.  Every class that implements veryDeepInner: must copy all its inst vars.  Danger is that a user will add a new instance variable and forget to copy it.  This check is only run by hand once in a while to make sure nothing was forgotten.  
(Please do not remove this method.)
	DeepCopier new checkDeep 	"

	Transcript
		cr;
		show: 'Instance variables shared with the original object when it is copied'.
	(self systemNavigation allClassesImplementing: #veryDeepInner:) do: 
		[:aClass | | mm |
		(mm := aClass instVarNames size) > 0 ifTrue:
			[aClass instSize - mm + 1 to: aClass instSize do: 
				[:index | 
				((aClass compiledMethodAt: #veryDeepInner:) writesField: index) ifFalse: 
					[Transcript
						cr;
						show: aClass name;
						space;
						show: (aClass allInstVarNames at: index)]]]]! !

!DeepCopier methodsFor: 'like fullCopy' stamp: 'MartinDias 10/25/2013 13:35'!
checkClass: aClass
	| meth |
	"Check that no indexes of instance vars have changed in certain classes.  If you get an error in this method, an implementation of veryDeepCopyWith: needs to be updated.  The idea is to catch a change while it is still in the system of the programmer who made it."

	self checkBasicClasses.	"Unlikely, but important to catch when it does happen."

	"Every class that implements veryDeepInner: must copy all its inst vars.  Danger is that a user will add a new instance variable and forget to copy it.  So check that the last one is mentioned in the copy method."
	(aClass includesSelector: #veryDeepInner:) ifTrue: [ 
		((aClass compiledMethodAt: #veryDeepInner:) writesField: aClass instSize) ifFalse: [
			aClass instSize > 0 ifTrue: [
				self warnInstanceVariableNotCopiedIn: aClass selector: #veryDeepInner:]]].
	(aClass includesSelector: #veryDeepCopyWith:) ifTrue: [
		meth := aClass compiledMethodAt: #veryDeepCopyWith:.
		(meth size > 20) & (meth literals includes: #veryDeepCopyWith:) not ifTrue: [
			(meth writesField: aClass instSize) ifFalse: [
				self warnInstanceVariableNotCopiedIn: aClass selector: #veryDeepCopyWith:]]].
! !

!DefaultExternalDropHandler commentStamp: 'dgd 4/5/2004 19:07'!
An alternative default handler that uses the file-list services to process files.
!
!DefaultExternalDropHandler methodsFor: '*Morphic-Base' stamp: 'MarcusDenker 12/20/2010 15:36'!
handle: dropStream in: pasteUp dropEvent: anEvent 
	"the file was just droped, let's do our job"
	| fileName services theOne |
	fileName := dropStream name.
	services := self servicesForFileNamed: fileName.

	"no service, default behavior"
	services isEmpty ifTrue: [
			dropStream edit.
			^ self].
	theOne := self chooseServiceFrom: services.
	theOne ifNotNil: [theOne performServiceFor: dropStream]! !

!DefaultExternalDropHandler methodsFor: 'private' stamp: ''!
servicesForFileNamed: aString 
	"private - answer a collection of file-services for the file named  
	aString"
	| allServices |
	allServices := FileServices itemsForFile: aString.
	^ allServices
		reject: [:svc | self unwantedSelectors includes: svc selector]! !

!DefaultExternalDropHandler methodsFor: 'private' stamp: ''!
chooseServiceFrom: aCollection
	"private - choose a service from aCollection asking the user if  
	needed"
	aCollection size = 1
		ifTrue: [^ aCollection anyOne].
	^ UIManager default chooseFrom: (aCollection collect: [:each | each label]) values: aCollection.
! !

!DefaultExternalDropHandler methodsFor: 'private' stamp: ''!
unwantedSelectors
	"private - answer a collection well known unwanted selectors "
	^ #(#removeLineFeeds: #addFileToNewZip: #compressFile: #putUpdate: )! !

!DefaultExternalDropHandler class methodsFor: 'initialization' stamp: ''!
initialize
	"initialize the receiver"
	ExternalDropHandler defaultHandler: self new! !

!DefaultExternalDropHandler class methodsFor: 'initialization' stamp: ''!
unload
	"initialize the receiver"
	ExternalDropHandler defaultHandler: nil! !

!DeflateStream commentStamp: 'LaurentLaffont 6/8/2011 22:23'!
I'm the base class for "stream compressor". For example, my subclass GZipWriteStream can compress a stream contents using gzip algorithm.

Try:

gzData := String streamContents: [:aStream|
         (GZipWriteStream on: aStream)
                nextPutAll: 'Some data to be gzipped';
                close. ].
Transcript 
        show: gzData; 
        cr;
        show: (GZipReadStream on: gzData) upToEnd;
        cr.

See InflateStream!
!DeflateStream methodsFor: 'deflating' stamp: 'ar 12/29/1999 17:47'!
updateHashAt: here
	"Update the hash value at position here (one based)"
	^self updateHash: (collection byteAt: here)! !

!DeflateStream methodsFor: 'deflating' stamp: 'ar 12/29/1999 17:46'!
insertStringAt: here
	"Insert the string at the given start position into the hash table.
	Note: The hash value is updated starting at MinMatch-1 since
	all strings before have already been inserted into the hash table
	(and the hash value is updated as well)."
	| prevEntry |
	hashValue := self updateHashAt: (here + MinMatch).
	prevEntry := hashHead at: hashValue+1.
	hashHead at: hashValue+1 put: here.
	hashTail at: (here bitAnd: WindowMask)+1 put: prevEntry.! !

!DeflateStream methodsFor: 'accessing' stamp: 'ar 12/29/1999 20:00'!
goodMatchLength
	"Return the length that is considered to be a 'good' match.
	Higher values will result in better compression but take more time."
	^MaxMatch "Best compression"! !

!DeflateStream methodsFor: 'deflating' stamp: 'jannik.laval 5/1/2010 16:10'!
deflateBlock: lastIndex chainLength: chainLength goodMatch: goodMatch
	"Continue deflating the receiver's collection from blockPosition to lastIndex.
	Note that lastIndex must be at least MaxMatch away from the end of collection"
	| here matchResult flushNeeded hereMatch hereLength newMatch newLength hasMatch |
	blockPosition > lastIndex ifTrue:[^false]. "Nothing to deflate"
	hasMatch := false.
	here := blockPosition.
	[here <= lastIndex] whileTrue:[
		hasMatch ifFalse:[
			"Find the first match"
			matchResult := self findMatch: here
								lastLength: MinMatch-1
								lastMatch: here
								chainLength: chainLength
								goodMatch: goodMatch.
			self insertStringAt: here. "update hash table"
			hereMatch := matchResult bitAnd: 16rFFFF.
			hereLength := matchResult bitShift: -16].

		"Look ahead if there is a better match at the next position"
		matchResult := self findMatch: here+1
							lastLength: hereLength
							lastMatch: hereMatch
							chainLength: chainLength
							goodMatch: goodMatch.
		newMatch := matchResult bitAnd: 16rFFFF.
		newLength := matchResult bitShift: -16.

		"Now check if the next match is better than the current one.
		If not, output the current match (provided that the current match
		is at least MinMatch long)"
		(hereLength >= newLength and:[hereLength >= MinMatch]) ifTrue:[
			[self validateMatchAt: here
							from: hereMatch to: hereMatch + hereLength - 1] assert.
			"Encode the current match"
			flushNeeded := self
				encodeMatch: hereLength
				distance: here - hereMatch.
			"Insert all strings up to the end of the current match.
			Note: The first string has already been inserted."
			1 to: hereLength-1 do:[:i| self insertStringAt: (here := here + 1)].
			hasMatch := false.
			here := here + 1.
		] ifFalse:[
			"Either the next match is better than the current one or we didn't
			have a good match after all (e.g., current match length < MinMatch).
			Output a single literal."
			flushNeeded := self encodeLiteral: (collection byteAt: (here + 1)).
			here := here + 1.
			(here <= lastIndex and:[flushNeeded not]) ifTrue:[
				"Cache the results for the next round"
				self insertStringAt: here.
				hasMatch := true.
				hereMatch := newMatch.
				hereLength := newLength].
		].
		flushNeeded ifTrue:[blockPosition := here. ^true].
	].
	blockPosition := here.
	^false! !

!DeflateStream methodsFor: 'encoding' stamp: 'ar 12/29/1999 18:04'!
encodeLiteral: literal
	"Encode the given literal.
	Return true if the current block needs to be flushed."
	^false! !

!DeflateStream methodsFor: 'deflating' stamp: 'ar 12/29/1999 20:24'!
compare: here with: matchPos min: minLength
	"Compare the two strings and return the length of matching characters.
	minLength is a lower bound for match lengths that will be accepted.
	Note: here and matchPos are zero based."
	| length |
	"First test if we can actually get longer than minLength"
	(collection at: here+minLength+1) = (collection at: matchPos+minLength+1)
		ifFalse:[^0].
	(collection at: here+minLength) = (collection at: matchPos+minLength)
		ifFalse:[^0].
	"Then test if we have an initial match at all"
	(collection at: here+1) = (collection at: matchPos+1)
		ifFalse:[^0].
	(collection at: here+2) = (collection at: matchPos+2)
		ifFalse:[^1].
	"Finally do the real comparison"
	length := 3.
	[length <= MaxMatch and:[
		(collection at: here+length) = (collection at: matchPos+length)]]
			whileTrue:[length := length + 1].
	^length - 1! !

!DeflateStream methodsFor: 'private' stamp: 'ar 12/29/1999 17:50'!
moveContentsToFront
	"Move the contents of the receiver to the front"
	| delta |
	delta := (blockPosition - WindowSize).
	delta <= 0 ifTrue:[^self].
	"Move collection"
	collection 
		replaceFrom: 1 
		to: collection size - delta 
		with: collection 
		startingAt: delta+1.
	position := position - delta.
	"Move hash table entries"
	blockPosition := blockPosition - delta.
	blockStart := blockStart - delta.
	self updateHashTable: hashHead delta: delta.
	self updateHashTable: hashTail delta: delta.! !

!DeflateStream methodsFor: 'initialization' stamp: 'ar 12/29/1999 17:32'!
initializeHashTables
	hashHead := WordArray new: 1 << HashBits.
	hashTail := WordArray new: WindowSize.
! !

!DeflateStream methodsFor: 'deflating' stamp: 'ar 12/31/1999 18:00'!
deflateBlock
	"Deflate the current contents of the stream"
	| flushNeeded lastIndex |
	(blockStart == nil) ifTrue:[
		"One time initialization for the first block"
		1 to: MinMatch-1 do:[:i| self updateHashAt: i].
		blockStart := 0].

	[blockPosition < position] whileTrue:[
		(position + MaxMatch > writeLimit)
			ifTrue:[lastIndex := writeLimit - MaxMatch]
			ifFalse:[lastIndex := position].
		flushNeeded := self deflateBlock: lastIndex-1
							chainLength: self hashChainLength
							goodMatch: self goodMatchLength.
		flushNeeded ifTrue:[
			self flushBlock.
			blockStart := blockPosition].
		"Make room for more data"
		self moveContentsToFront].
! !

!DeflateStream methodsFor: 'deflating' stamp: 'ar 12/29/1999 17:48'!
updateHash: nextValue
	"Update the running hash value based on the next input byte.
	Return the new updated hash value."
	^((hashValue bitShift: HashShift) bitXor: nextValue) bitAnd: HashMask.! !

!DeflateStream methodsFor: 'private' stamp: 'ar 2/2/2001 15:47'!
updateHashTable: table delta: delta
	| pos |
	<primitive: 'primitiveDeflateUpdateHashTable' module: 'ZipPlugin'>
	1 to: table size do:[:i|
		"Discard entries that are out of range"
		(pos := table at: i) >= delta
			ifTrue:[table at: i put: pos - delta]
			ifFalse:[table at: i put: 0]].! !

!DeflateStream methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 09:51'!
initialize
	super initialize.
	blockStart := nil.
	blockPosition := 0.
	hashValue := 0.
	self initializeHashTables.! !

!DeflateStream methodsFor: 'initialization' stamp: 'ar 12/28/1999 17:34'!
on: aCollection from: firstIndex to: lastIndex
	"Not for DeflateStreams please"
	^self shouldNotImplement! !

!DeflateStream methodsFor: 'deflating' stamp: 'ar 12/29/1999 17:45'!
findMatch: here lastLength: lastLength lastMatch: lastMatch chainLength: maxChainLength goodMatch: goodMatch
	"Find the longest match for the string starting at here.
	If there is no match longer than lastLength return lastMatch/lastLength.
	Traverse at most maxChainLength entries in the hash table.
	Stop if a match of at least goodMatch size has been found."
	| matchResult matchPos distance chainLength limit bestLength length |
	"Compute the default match result"
	matchResult := (lastLength bitShift: 16) bitOr: lastMatch.

	"There is no way to find a better match than MaxMatch"
	lastLength >= MaxMatch ifTrue:[^matchResult].

	"Start position for searches"
	matchPos := hashHead at: (self updateHashAt: here + MinMatch) + 1.

	"Compute the distance to the (possible) match"
	distance := here - matchPos.

	"Note: It is required that 0 < distance < MaxDistance"
	(distance > 0 and:[distance < MaxDistance]) ifFalse:[^matchResult].

	chainLength := maxChainLength.	"Max. nr of match chain to search"
	here > MaxDistance	"Limit for matches that are too old"
		ifTrue:[limit := here - MaxDistance]
		ifFalse:[limit := 0].

	"Best match length so far (current match must be larger to take effect)"
	bestLength := lastLength.

	["Compare the current string with the string at match position"
	length := self compare: here with: matchPos min: bestLength.
	"Truncate accidental matches beyound stream position"
	(here + length > position) ifTrue:[length := position - here].
	"Ignore very small matches if they are too far away"
	(length = MinMatch and:[(here - matchPos) > (MaxDistance // 4)])
		ifTrue:[length := MinMatch - 1].
	length > bestLength ifTrue:["We have a new (better) match than before"
		"Compute the new match result"
		matchResult := (length bitShift: 16) bitOr: matchPos.
		bestLength := length.
		"There is no way to find a better match than MaxMatch"
		bestLength >= MaxMatch ifTrue:[^matchResult].
		"But we may have a good, fast match"
		bestLength > goodMatch ifTrue:[^matchResult].
	].
	(chainLength := chainLength - 1) > 0] whileTrue:[
		"Compare with previous entry in hash chain"
		matchPos := hashTail at: (matchPos bitAnd: WindowMask) + 1.
		matchPos <= limit ifTrue:[^matchResult]. "Match position is too old"
	].
	^matchResult! !

!DeflateStream methodsFor: 'encoding' stamp: 'ar 12/29/1999 18:04'!
encodeMatch: matchLength distance: matchDistance
	"Encode a match of the given length and distance.
	Return true if the current block should be flushed."
	^false! !

!DeflateStream methodsFor: 'initialization' stamp: 'ar 12/29/1999 17:30'!
flush
	"Force compression"
	self deflateBlock.! !

!DeflateStream methodsFor: 'accessing' stamp: 'CamilleTeruel 11/2/2012 11:52'!
nextPutAll: aCollection
	^ self next: aCollection size putAll: aCollection startingAt: 1! !

!DeflateStream methodsFor: 'initialization' stamp: 'ar 12/29/1999 17:33'!
on: aCollection
	self initialize.
	super on: (aCollection species new: WindowSize * 2).! !

!DeflateStream methodsFor: 'accessing' stamp: 'ar 12/29/1999 20:00'!
hashChainLength
	"Return the max. number of hash chains to traverse.
	Higher values will result in better compression but take more time."
	^4096 "Best compression"! !

!DeflateStream methodsFor: 'deflating' stamp: 'ar 12/28/1999 17:37'!
flushBlock
	"Flush a deflated block"! !

!DeflateStream methodsFor: 'accessing' stamp: 'ar 12/28/1999 17:35'!
pastEndPut: anObject
	self deflateBlock.
	^self nextPut: anObject! !

!DeflateStream methodsFor: 'deflating' stamp: 'ar 12/28/1999 17:43'!
validateMatchAt: pos from: startPos to: endPos
	| here |
	here := pos.
	startPos+1 to: endPos+1 do:[:i|
		(collection at: i) = (collection at: (here := here + 1))
			ifFalse:[^self error:'Not a match']].
	^true! !

!DeflateStream methodsFor: 'accessing' stamp: 'CamilleTeruel 11/2/2012 11:51'!
next: bytesCount putAll: aCollection startingAt: startIndex
	| start count max |
	aCollection species = collection species
		ifFalse:[
			aCollection do:[:ch| self nextPut: ch].
			^ aCollection].
	start := startIndex.
	count := bytesCount.
	[count = 0] whileFalse:[
		position = writeLimit ifTrue:[self deflateBlock].
		max := writeLimit - position.
		max > count ifTrue:[max := count].
		collection replaceFrom: position+1
			to: position+max
			with: aCollection
			startingAt: start.
		start := start + max.
		count := count - max.
		position := position + max].
	^ aCollection! !

!Delay commentStamp: 'BenComan 3/19/2015 23:00'!
I am the main way that a process may pause for some amount of time.  The simplest usage is like this:

	(Delay forSeconds: 5) wait.   "or..."
	5 seconds asDelay wait.

An instance of Delay responds to the message 'wait' by suspending the caller's process for a certain amount of time. The duration of the pause is specified when the Delay is created with the message forMilliseconds: or forSeconds:. A Delay can be used again when the current wait has finished. For example, a clock process might repeatedly wait on a one-second Delay.  Delays work across  clock roll-overs.

The maximum possible delay depends on which DelayScheduler is used:
  * DelayMillisecondScheduler uses a 32-bit value that rolls over about every six days, or SmallInteger maxVal // 2 milliseconds.
  * DelayMicrosecondScheduler is 64-bit and rolls over every 50,000 years. 

A delay in progress when an image snapshot is saved and resumed when the snapshot is re-started. 
!
!Delay methodsFor: 'private - scheduler' stamp: 'BenComan 3/1/2015 10:40'!
schedulerBeingWaitedOn
	"Answer whether this delay is currently scheduled, e.g., being waited on"
	^beingWaitedOn! !

!Delay methodsFor: 'public' stamp: 'brp 10/21/2004 16:05'!
delaySemaphore

	^ delaySemaphore! !

!Delay methodsFor: 'private - scheduler' stamp: 'BenComan 3/3/2015 21:12'!
schedulerSignalWaitingProcess
	"The delay time has elapsed; signal the waiting process."

	beingWaitedOn := false.
	delaySemaphore signal.

	"Important!! Must only be called from the single timing priority process e.g...
		DelayScheduler>>handleEventTimer."! !

!Delay methodsFor: 'delaying' stamp: 'BenComan 2/8/2015 22:21'!
waitOtherwise: anErrorBlock
	"	
	Schedule this Delay, then wait on its semaphore. The current process will be suspended 
	for the duration specified when this Delay was created.

   If the delay was not scheduled (e.g. if the high priority timer event loop is not running),
 	then delaySemaphore will never be signalled, so don't wait on it. The event loop may need 
	to be restarted thus... Delay restartTimerEventLoop.
   "

	self schedule 
		ifTrue: [ [delaySemaphore wait] ifCurtailed:[self unschedule] ]
		ifFalse: anErrorBlock.
	! !

!Delay methodsFor: 'private - scheduler' stamp: 'BenComan 3/3/2015 23:19'!
scheduler: aDelayScheduler resumptionTime: milliOrMicroResumptionTime
	"The milli/micro semantics of schedulerResumptionTime varies depending on which 
	scheduler is running, so we record it such that later printOn: can interpret it
	using #millisecondsToGo"
	scheduler := aDelayScheduler.
	schedulerResumptionTime := milliOrMicroResumptionTime.! !

!Delay methodsFor: 'private' stamp: 'BenComan 2/16/2015 23:25'!
schedule
	"Schedule this delay."
	
	^Scheduler schedule: self.
! !

!Delay methodsFor: 'private' stamp: 'BenComan 3/1/2015 10:30'!
setDelay: milliseconds forSemaphore: aSemaphore
	"Private!! Initialize this delay to signal the given semaphore after the given number of milliseconds."

	millisecondDelayDuration := milliseconds asInteger.
	millisecondDelayDuration < 0 ifTrue: [self error: 'delay times cannot be negative'].
	delaySemaphore := aSemaphore.
	beingWaitedOn := false.! !

!Delay methodsFor: 'private - scheduler' stamp: 'BenComan 3/19/2015 22:02'!
schedulerResumptionTime
	"Answer the value of the system clock at which the receiver's suspended Process will resume.
	The semantics of whether this is a millisecond or microsecond value depends on which scheduler is in use."
	
	^ schedulerResumptionTime 
! !

!Delay methodsFor: 'printing' stamp: 'BenComan 3/2/2015 08:21'!
millisecondsToGo
	"The milli/micro second semantics of /schedulerResumptionTime/ vary with which 
	scheduler set the value, so ask it to interpret."
	^ scheduler millisecondsUntilResumptionTime: schedulerResumptionTime! !

!Delay methodsFor: 'printing' stamp: 'BenComan 3/3/2015 23:18'!
printOn: aStream
	super printOn: aStream.
	aStream
		nextPutAll: '(';
		print: millisecondDelayDuration;
		nextPutAll: ' msecs'.
	beingWaitedOn
		ifTrue: [ 
			aStream
				nextPutAll: '; ';
				print: self millisecondsToGo;
				nextPutAll: ' msecs remaining' ].
	aStream nextPutAll: ')'.! !

!Delay methodsFor: 'private' stamp: 'BenComan 2/16/2015 23:25'!
unschedule
	Scheduler unschedule: self.
! !

!Delay methodsFor: 'private' stamp: 'BenComan 3/1/2015 10:30'!
setDelay: milliseconds
	"Private!! Initialize this delay to signal the given semaphore after the given number of milliseconds."

	millisecondDelayDuration := milliseconds asInteger! !

!Delay methodsFor: 'public' stamp: 'BenComan 3/1/2015 20:59'!
millisecondDelayDuration
	^millisecondDelayDuration! !

!Delay methodsFor: 'private - scheduler' stamp: 'BenComan 3/3/2015 21:18'!
schedulerBeingWaitedOn: aBoolean
	"Indicate whether this delay is currently scheduled, i.e. being waited on"
	
	beingWaitedOn := aBoolean

	"Important!! Must only be called from the single timing priority process, e.g...
		DelayScheduler>>scheduleDelay: 
		DelayScheduler>>unscheduleDelay: "
! !

!Delay methodsFor: 'delaying' stamp: 'ar 8/30/2007 19:32'!
wait
	"Schedule this Delay, then wait on its semaphore. The current process will be suspended for the amount of time specified when this Delay was created."

	self schedule.
	[delaySemaphore wait] ifCurtailed:[self unschedule].
! !

!Delay methodsFor: 'delaying' stamp: 'nk 3/14/2001 08:52'!
isExpired

	^delaySemaphore isSignaled.
! !

!Delay methodsFor: 'private - scheduler' stamp: 'BenComan 3/1/2015 10:24'!
schedulerResumptionTime: anInteger
	"Private!! Should only be called by a subclass of DelayScheduler.
	Set the value of the system's clock at which the receiver's suspended Process will resumed.  The clock semantics depends on the scheduler used e.g. millisecond/microsecond."
	
	schedulerResumptionTime := anInteger
	
! !

!Delay class methodsFor: 'instance creation' stamp: 'CamilloBruni 6/23/2013 13:44'!
forSeconds: aNumber
	"Return a new Delay for the given number of Seconds"
	^ self forMilliseconds: aNumber * 1000
! !

!Delay class methodsFor: 'snapshotting' stamp: 'BenComan 2/16/2015 23:31'!
shutDown

	Scheduler shutDown.
! !

!Delay class methodsFor: 'instance creation' stamp: 'laza 1/30/2005 22:10'!
forMilliseconds: aNumber
	"Return a new Delay for the given number of milliseconds. Sending 'wait' to this Delay will cause the sender's process to be suspended for approximately that length of time."

	^ self new setDelay: aNumber forSemaphore: Semaphore new
! !

!Delay class methodsFor: 'settings' stamp: 'BenComan 3/21/2015 01:05'!
systemSettingOn: aBuilder
	<systemsettings>
	
	(aBuilder pickOne: #delaySchedulerClass)
		parent: #pharoSystem ;
		target: self;
		label: 'Delay Scheduler' ;
		domainValues: DelayScheduler allSubclasses ;
		description: 'Choose the class to use for Delay scheduling.' , 
			String crlf, 'You can observe which is running from Tools > Process Browser.'
	! !

!Delay class methodsFor: 'instance creation' stamp: 'CamilloBruni 6/23/2013 13:44'!
forDuration: aDuration
 	"Return a new Delay for the given duration."
 	^ self forMilliseconds: aDuration asMilliSeconds
 ! !

!Delay class methodsFor: '*KernelTests' stamp: 'BenComan 2/16/2015 23:33'!
testCaseSupportTimingSemaphore

	^ Scheduler testCaseSupportTimingSemaphore.
! !

!Delay class methodsFor: 'timer process' stamp: 'BenComan 2/16/2015 23:35'!
schedulingProcess

	^ Scheduler schedulingProcess.
! !

!Delay class methodsFor: 'instance creation' stamp: 'JurajKubelka 2/25/2015 12:39'!
timeoutSemaphore: aSemaphore afterMSecs: anInteger
	"Create and schedule a Delay to signal the given semaphore when the given number of milliseconds has elapsed. Return the scheduled Delay. The timeout can be cancelled by sending 'unschedule' to this Delay."
	"Details: This mechanism is used to provide a timeout when waiting for an external event, such as arrival of data over a network connection, to signal a semaphore. The timeout ensures that the semaphore will be signalled within a reasonable period of time even if the event fails to occur. Typically, the waiting process cancels the timeout request when awoken, then determines if the awaited event has actually occurred."

	^ (self new setDelay: anInteger forSemaphore: aSemaphore) schedule; yourself
! !

!Delay class methodsFor: 'timer process' stamp: 'BenComan 11/3/2014 21:08'!
restartTimerEventLoop
	self stopTimerEventLoop.
	self startTimerEventLoop.! !

!Delay class methodsFor: 'settings' stamp: 'BenComan 3/1/2015 20:23'!
delaySchedulerClass: aSchedulerClass 
	| newScheduler |
	self delaySchedulerClass = aSchedulerClass ifTrue:[ ^self inform: 'No change' ].
	newScheduler := aSchedulerClass new.
	(newScheduler respondsTo: #startTimerEventLoop) ifFalse: [ self error: 'New delay scheduler must respond to #startTimerEventLoop' ].
	Scheduler stopTimerEventLoop.
	Scheduler := newScheduler.
	Scheduler startTimerEventLoop.
	self inform: 'Delay scheduler set to ' , aSchedulerClass printString.
	
	! !

!Delay class methodsFor: 'class initialization' stamp: 'BenComan 3/16/2015 23:51'!
initialize
	"Delay initialize"
	Scheduler ifNotNil: [ Scheduler stopTimerEventLoop ].
	Scheduler := DelayMicrosecondScheduler new.
	Scheduler startTimerEventLoop. 
	Smalltalk addToStartUpList: self.
! !

!Delay class methodsFor: 'timer process' stamp: 'BenComan 2/16/2015 23:35'!
startTimerEventLoop

	Scheduler startTimerEventLoop.
! !

!Delay class methodsFor: 'snapshotting' stamp: 'BenComan 2/16/2015 23:29'!
startUp
	"Restart active delay, if any, when resuming a snapshot."

	Scheduler startUp.

! !

!Delay class methodsFor: 'timer process' stamp: 'BenComan 2/16/2015 23:33'!
stopTimerEventLoop

	^ Scheduler stopTimerEventLoop.
! !

!Delay class methodsFor: 'testing' stamp: 'BenComan 2/16/2015 23:28'!
nextWakeUpTime

	^ Scheduler nextWakeUpTime.


! !

!Delay class methodsFor: 'testing' stamp: 'BenComan 2/16/2015 23:28'!
anyActive
	"Return true if there is any delay currently active"
		^Scheduler anyActive
! !

!Delay class methodsFor: 'settings' stamp: 'BenComan 3/1/2015 19:57'!
delaySchedulerClass
	^Scheduler class! !

!DelayBenchmark commentStamp: 'BenComan 10/26/2014 11:54'!
The delay scheduling loop is THE highest priority code which is run in Pharo, in other words it is time-critical. The speed of this code is critical for accurate responses, it is critical for network services, it affects every last part of the system.

DelayBenchmark provides a means for evaluating modifications.  This is fairly basic, providing only Transcript output of results.

Over a number of trials the amount of concurrent delays is increased.  The durations are randomly pre-generated into an array to avoid that overhead in the trials.  A fixed seed is used to try and improve comparisons between runs. Uncomment the additional seeds to provide better averaging of results.!
!DelayBenchmark methodsFor: 'support' stamp: 'BenComan 10/26/2014 23:33'!
generateDelayProcesses: numberConcurrent priority: priority maxDuration: maxDuration fromSeed: seed 
	| randomGenerator sampleDurations sampleIndex | 
	"Pre-generate a series of random durations to remove such time for such generation from trial" 
	"Seed to help reproducability between trials."
	randomGenerator := Random seed: seed.
	sampleDurations := Array new: 1000.  
	1 to: sampleDurations size do:
	[  	:index | 
		sampleDurations at: index put: (randomGenerator nextInt: maxDuration).
	].
	sampleIndex := 0.

	"Avoid instantiating new Delay objects inside the inner whileTrue loop, to eliminate such time from trial. 
	Reuse Delay object with modified duration each loop."
    ^ (1 to: numberConcurrent) collect: 
			[ 	:each | 
				[	| delay | 
					delay := Delay forMilliseconds: 0.
					[	sampleIndex := (sampleIndex rem: sampleDurations size) + 1.
						delay setDelay: (sampleDurations at: sampleIndex).
						EnterCount := EnterCount + 1. 	
						delay wait.
						ExitCount := ExitCount + 1.
						Running.  "Repeat until not running." 
					] whileTrue.
 				] newProcess priority: priority
			]


! !

!DelayBenchmark methodsFor: 'benchmarks' stamp: 'BenComan 3/24/2015 22:05'!
bench: aDelaySchedulerClass
	| schedulerClassToRestore |
	
	self assert: (aDelaySchedulerClass inheritsFrom: DelayScheduler).
	schedulerClassToRestore := Delay delaySchedulerClass.
	
	[	Delay delaySchedulerClass: aDelaySchedulerClass.
		self bench.
	] ensure: [ Delay delaySchedulerClass: schedulerClassToRestore].! !

!DelayBenchmark methodsFor: 'benchmarks' stamp: 'BenComan 3/24/2015 22:17'!
bench
	"DelayBenchmark runAll."
	"DelayBenchmark run."
	| sampleSetSeeds trialOfNumberConcurrent completed |
	sampleSetSeeds := #( 42 "5975 13746 22634 44022" ). "uncomment items to get a better average"
	trialOfNumberConcurrent := #( 1000 2000 3000 4000 5000 6000 7000 8000 9000 10000 ).
	completed := Semaphore new.

Transcript cr; crShow: 'Benchmarking ' , Delay delaySchedulerClass printString.
[ 	trialOfNumberConcurrent do: [ :numberConcurrent |   
		Transcript crShow:  '#ConcurrentDelays: ' , numberConcurrent printString ; space.
		EnterCount := ExitCount := 0.
		sampleSetSeeds do: [ :seed |  
			Transcript show: '.'.
			self 
				trialConcurrent: numberConcurrent 
				priority: Processor userSchedulingPriority + 1
				maxDuration: 50 
				fromSeed: seed.
			].
		Transcript space ;
			show: 'EnterCount: ' , (EnterCount // (sampleSetSeeds size)) printString ; space ;
			show: 'ExitCount: ' , (ExitCount // (sampleSetSeeds size)) printString .
		World doOneCycle. "since we are a higher priority would prevent transcript showing"
		]. 
		completed signal.
] forkAt: Processor userSchedulingPriority + 2. "To avoid UI loop influencing result"

completed wait.


 
		! !

!DelayBenchmark methodsFor: 'support' stamp: 'BenComan 10/26/2014 00:27'!
trialConcurrent: numberConcurrentDelays priority: priority maxDuration: maxDuration fromSeed: seed 

	| delayProcesses |
	delayProcesses := self 
		generateDelayProcesses: numberConcurrentDelays 
		priority: priority 
		maxDuration: maxDuration 
		fromSeed: seed.
	
	Running := false.			
	
	[	Running := true. 
		delayProcesses do: [  :process | process resume ]. "Start counting delays"
		(Delay forSeconds: 1) wait. "Count the number of delays in one second"
	] ensure: [ Running := false ].  "All processes should exit cleanly here."
	(Delay forSeconds: 1) wait.	 "but give some time for clean exit"	
	delayProcesses do: [  :process | process terminate ]. "and cleanup any deadlocks."
	
	Smalltalk garbageCollect. Smalltalk garbageCollect. Smalltalk garbageCollect. 
! !

!DelayBenchmark class methodsFor: 'action' stamp: 'BenComan 3/24/2015 21:46'!
run
	"DelayBenchmark run"
	self new bench.! !

!DelayBenchmark class methodsFor: 'action' stamp: 'BenComan 3/24/2015 22:07'!
runAll
	"DelayBenchmark runAll"
	Transcript clear.
	DelayScheduler allSubclasses do: [ :delayScheudlerClass | self new bench: delayScheudlerClass ].! !

!DelayExperimentalCourageousScheduler commentStamp: 'BenComan 3/25/2015 22:16'!
DelayExperimentalCourageousScheduler addresses a "Delay scheduling deadlock" problem of Case 14344 [1] seemingly due to multi-thread suspend/resume operations interacting badly with background morphs, causing the Image to lock up.  See the class comment of DelaySchedulerBackgroundWorkerMorph.

My #schedule: and #unschedule: methods pass Delays from the user priority threads to the high priority #handleTimerEvent thread via  instance variables /scheduledDelay/ and /finishedDelay/.   The original implementation used mutexes to protect these in a shared-memory paradigm.   However immediately after assigning those variables, #signal invokes the highest priority thread to consume the set value, so we speculate that even without interthread synchronisation, the variables cannot be overwritten by another thread."	
	
This is quite speculative and due to limited time to test prior to Pharo 4 Release, I am very "experimental."  Use at own risk. 

I can be selected via "World > System > Settings > Setting > Delay scheduler".

To compare the different delay schedulers...
   1.   "World > Tools > Process Browser", and set to auto-update.
   2.   Transcript open.
   3.   DelayBenchmark runAll.!
!DelayExperimentalCourageousScheduler methodsFor: 'low priority processes' stamp: 'BenComan 3/24/2015 23:40'!
schedule: aDelay

	"Depends on... semantics of bytecode inlining and cooperative multitasking  
	 such that interuption cannot occur between the assignment and the signal.
	 The #signal invokes the highest priority thread to consume scheduledDelay, 
	 so no other thread has a chance to overwrite our value."
	
	scheduledDelay := aDelay. 
	timingSemaphore signal.
	^true.
! !

!DelayExperimentalCourageousScheduler methodsFor: 'low priority processes' stamp: 'BenComan 3/25/2015 22:18'!
unschedule: aDelay

	"Depends on... semantics of bytecode inlining and cooperative multitasking  
	 such that interuption cannot occur between the assignment and the signal.
	 The #signal invokes the highest priority thread to consume finishedDelay, 
	 so no other thread has a chance to overwrite our value."	

	finishedDelay := aDelay. 
	timingSemaphore signal.

! !

!DelayExperimentalSemaphoreScheduler commentStamp: 'BenComan 3/25/2015 22:17'!
DelayExperimentalSemaphoreScheduler addresses a "Delay scheduling deadlock" problem of Case 14344 [1] seemingly due to multi-thread suspend/resume operations interacting badly with background morphs, causing the Image to lock up.  See the class comment of DelaySchedulerBackgroundWorkerMorph.

My #schedule: and #unschedule: methods pass Delays from the user priority threads to the high priority #handleTimerEvent thread via  instance variables /scheduledDelay/ and /finishedDelay/.   The original implementation used mutexes to protect these in a shared-memory paradigm.   However it can also be considered a producer-consumer paradigm, so I throw away the mutexes and use semaphores. 

I have been demostrated to work without error,  however but am "experimental" due to limited time to test prior to Pharo 4 Release, and also no tests are included.

I can be selected via "World > System > Settings > Setting > Delay scheduler".

To compare the different delay schedulers...
   1.   "World > Tools > Process Browser", and set to auto-update.
   2.   Transcript open.
   3.   DelayBenchmark runAll.!
!DelayExperimentalSemaphoreScheduler methodsFor: 'low priority processes' stamp: 'BenComan 3/24/2015 20:59'!
schedule: aDelay

	scheduledDelay == nil ifFalse: [ scheduledDelayIsNil wait ].  

	"It is assumed that bytecode inlining and the system's co-operative multitasking 
	 prevents interruption before the assignment in the next line."	
		
	scheduledDelay := aDelay. 
	
	"The high priority process this wakes does scheduledDelay:=nil 
	 and signals scheduledDelayNilledSemaphore."
	
	timingSemaphore signal. 

	^true
	
! !

!DelayExperimentalSemaphoreScheduler methodsFor: 'low priority processes' stamp: 'BenComan 3/25/2015 22:14'!
unschedule: aDelay
	finishedDelay == nil ifFalse: [ finishedDelayIsNil wait ].  

	"It is assumed that bytecode inlining and the system's co-operative multitasking 
	 prevents interruption before the assignment in the next line."	
		
	finishedDelay := aDelay. 
	
	"The high priority process this wakes does scheduledDelay:=nil 
	 and signals scheduledDelayNilledSemaphore."
	
	timingSemaphore signal. 

	
! !

!DelayExperimentalSemaphoreScheduler methodsFor: 'initialization' stamp: 'BenComan 3/24/2015 21:26'!
initialize
	super initialize.
	scheduledDelayIsNil := Semaphore new.
	finishedDelayIsNil := Semaphore new.! !

!DelayExperimentalSemaphoreScheduler methodsFor: 'timer process' stamp: 'BenComan 3/24/2015 20:56'!
handleTimerEvent: microsecondNowTick
	"Handle a timer event; which can be either:
		- a schedule request (ScheduledDelay notNil)
		- an unschedule request (FinishedDelay notNil)
		- a timer signal (not explicitly specified)
	We check for timer expiry every time we get a signal."
	| microsecondNextTick |

	"Process any schedule requests"
	scheduledDelay ifNotNil: [
		"Schedule the given delay."
		scheduledDelay scheduler: self resumptionTime: microsecondNowTick + (1000 * scheduledDelay millisecondDelayDuration).
		self scheduleDelay: scheduledDelay.
		scheduledDelay := nil.
		scheduledDelayIsNil consumeAllSignals. 
		scheduledDelayIsNil signal ].

	"Process any unschedule requests"
	finishedDelay ifNotNil: [
		self unscheduleDelay: finishedDelay.
		finishedDelay := nil.
		finishedDelayIsNil consumeAllSignals.
		finishedDelayIsNil signal ].

	"Signal any expired delays"
	[ activeDelay notNil and:[ microsecondNowTick >= activeDelay schedulerResumptionTime ]] whileTrue: [
		activeDelay schedulerSignalWaitingProcess.
		activeDelay := suspendedDelays removeFirstOrNil.
		].

	"And signal when the next request is due. We sleep at most 1sec here
	as a soft busy-loop so that we don't accidentally miss signals."
	microsecondNextTick := microsecondNowTick + (1"sec" * 1000"msecs" * 1000"usecs").
	activeDelay ifNotNil: [
		microsecondNextTick := microsecondNextTick min: activeDelay schedulerResumptionTime ].
	^microsecondNextTick.
! !

!DelayExperimentalSpinScheduler commentStamp: 'BenComan 3/25/2015 22:17'!
DelayExperimentalSpinScheduler addresses a "Delay scheduling deadlock" problem of Case 14344 [1] seemingly due to multi-thread suspend/resume operations interacting badly with background morphs, causing the Image to lock up.  See the class comment of DelaySchedulerBackgroundWorkerMorph.

My #schedule: and #unschedule: methods pass Delays from the user priority threads to the high priority #handleTimerEvent thread via  instance variables /scheduledDelay/ and /finishedDelay/.   The original implementation used mutexes to protect these in a shared-memory paradigm.   However it can also be considered a producer-consumer paradigm, so I throw away the mutexes and use a spinlock.  Interestingly it was found due to the semanatics of the cooperative multitasking, it seems the loop never spins and it exits after the first pass. 

I have been demonstrated to work without error,  however but I remain "experimental" due to limited time to test prior to Pharo 4 Release, and also no tests are included.

I can be selected via "World > System > Settings > Setting > Delay scheduler".

To compare the different delay schedulers...
   1.   "World > Tools > Process Browser", and set to auto-update to observe as the delay schedulers change.
   2.   Transcript open.
   3.   DelayBenchmark runAll.!
!DelayExperimentalSpinScheduler methodsFor: 'low priority processes' stamp: 'BenComan 3/24/2015 21:41'!
schedule: aDelay

	"Depends on the bytecode inlining and cooperative multitasking semantics 
	 such that interuption can occur between the test and the assignment."
	
	[ 	scheduledDelay == nil ifTrue: [ 
				scheduledDelay := aDelay. 
				timingSemaphore signal.
				^true.
				].
		Transcript show: 'S'.
		true.
	] whileTrue.	
! !

!DelayExperimentalSpinScheduler methodsFor: 'low priority processes' stamp: 'BenComan 3/24/2015 21:41'!
unschedule: aDelay
	
	[	finishedDelay == nil ifTrue: [ 
				finishedDelay := aDelay. "...and this assignment" 
				timingSemaphore signal.
				^true.
				].
		Transcript show: 'U'.
		true.
	] whileTrue.	
! !

!DelayMicrosecondScheduler commentStamp: 'BenComan 3/3/2015 23:33'!
This concrete subclass uses the microsecond primitive & clock, which are based on a 64-bit LargePositiveInteger that rolls over roughly every 50,000 years.

There are some code duplications with simbling classes for performance reasons.

See parent class comment for more info.!
!DelayMicrosecondScheduler methodsFor: 'timer process' stamp: 'BenComan 3/2/2015 08:07'!
runTimerEventLoop
	| microsecondNowTick microsecondNextTick   |
	"Run the timer event loop."
	[ runTimerEventLoop ] whileTrue: [ 
		timingSemaphore wait.		
		microsecondNowTick := Time microsecondClockValue.
		microsecondNextTick := self handleTimerEvent: microsecondNowTick.

		"Since we have processed all outstanding requests, reset the timing semaphore so
		that only new work will wake us up again. Do this RIGHT BEFORE setting the next
		wakeup call from the VM because it is only signaled once so we mustn't miss it."
		timingSemaphore consumeAllSignals.
		self primSignal: timingSemaphore atUTCMicroseconds: microsecondNextTick.
		].
! !

!DelayMicrosecondScheduler methodsFor: 'snapshotting' stamp: 'BenComan 3/12/2015 22:33'!
shutDown
	"Suspend the active delay, if any, before snapshotting. It will be reactived when the snapshot is resumed."
	"Details: This prevents a timer interrupt from waking up the active delay in the midst snapshoting, since the active delay will be restarted when resuming the snapshot and we don't want to process the delay twice."
	accessProtect consumeAllSignals.
	self primSignal: nil atUTCMicroseconds: 0.
	self saveResumptionTimes.
	delaySuspended := true.
! !

!DelayMicrosecondScheduler methodsFor: 'timer process' stamp: 'BenComan 3/5/2015 21:53'!
scheduleDelay: aDelay
	"Private. Schedule this Delay."
	
	aDelay schedulerBeingWaitedOn: true.
	activeDelay 
		ifNil: [ activeDelay := aDelay ]
		ifNotNil: [
			aDelay schedulerResumptionTime < activeDelay schedulerResumptionTime
				ifTrue: [
					suspendedDelays add: activeDelay.
					activeDelay := aDelay ]
				ifFalse: [ suspendedDelays add: aDelay ]]
! !

!DelayMicrosecondScheduler methodsFor: 'snapshotting' stamp: 'BenComan 3/3/2015 23:24'!
saveResumptionTimes
	"Private!! Record the resumption times of all Delays relative to a base time of zero. This is done prior to snapshotting. This method should be called only while the AccessProtect semaphore is held."

	| oldBaseTime |
	oldBaseTime := Time microsecondClockValue. 
	activeDelay == nil
		ifFalse: [
			self adjust: activeDelay resumptionTimeOldBase: oldBaseTime newBase: 0 ].
		
	suspendedDelays do: [ :delay |
		self adjust: delay resumptionTimeOldBase: oldBaseTime newBase: 0 ].
! !

!DelayMicrosecondScheduler methodsFor: 'primitives' stamp: 'BenComan 3/2/2015 08:24'!
primSignal: aSemaphore atUTCMicroseconds: aLargePositiveInteger
	"Signal the semaphore when the microsecondsecond clock reaches the value of the second argument. Fail if the first argument is neither a Semaphore nor nil. Essential. See Object documentation whatIsAPrimitive."
	<primitive: 242>
	^ self primitiveFailed! !

!DelayMicrosecondScheduler methodsFor: 'snapshotting' stamp: 'BenComan 3/2/2015 08:09'!
restoreResumptionTimes
	"Private!! Restore the resumption times of all scheduled Delays after a snapshot or clock roll-over. This method should be called only while the AccessProtect semaphore is held."

	| newBaseTime |
	newBaseTime := Time microsecondClockValue.
	suspendedDelays do: [ :delay | 
		self adjust: delay resumptionTimeOldBase: 0 newBase: newBaseTime ].
	activeDelay == nil ifFalse: [
		self adjust: activeDelay resumptionTimeOldBase: 0 newBase: newBaseTime ].
! !

!DelayMicrosecondScheduler methodsFor: 'low priority processes' stamp: 'BenComan 3/5/2015 21:51'!
schedule: aDelay
	| scheduled |
	scheduled := false.
	aDelay schedulerBeingWaitedOn ifTrue: [^self error: 'This Delay has already been scheduled.'].
	accessProtect critical: [
		scheduledDelay := aDelay.
		timingSemaphore signal. "#handleTimerEvent: sets scheduledDelay:=nil"
		scheduled := (scheduledDelay == nil).
		].
	^scheduled.
	
! !

!DelayMicrosecondScheduler methodsFor: 'timer process' stamp: 'BenComan 3/2/2015 08:08'!
startTimerEventLoop
	"Start the timer event loop"
	"Delay restartTimerEventLoop"
	
	timerEventLoop ifNotNil: [ self error: 'Timer event loop has already been started.' ].
	
	suspendedDelays := Heap 
			sortBlock: [ :delay1 :delay2 | delay1 schedulerResumptionTime <= delay2 schedulerResumptionTime ].
	timingSemaphore := Semaphore new.
	runTimerEventLoop := true.
	
	timerEventLoop := [ self runTimerEventLoop ] newProcess.
	timerEventLoop 
		name: 'Delay Scheduling Process';
		priority: Processor timingPriority.
	timerEventLoop resume.
	
	timingSemaphore signal. "get going"
! !

!DelayMicrosecondScheduler methodsFor: 'snapshotting' stamp: 'BenComan 3/2/2015 08:08'!
startUp
	"Restart active delay, if any, when resuming a snapshot."

	"Compare to false since it can be nil"
	(delaySuspended = false) 
		ifTrue:[ ^self error: 'Trying to activate Delay twice' ].
	delaySuspended := false.
	
	self restoreResumptionTimes.
	accessProtect signal.
! !

!DelayMicrosecondScheduler methodsFor: 'timer process' stamp: 'BenComan 3/1/2015 21:02'!
stopTimerEventLoop
	"Stop the timer event loop"
	|  suspendedDelayToClear |
	
	runTimerEventLoop := false.
	timingSemaphore signal. 
	
	"The signalled higher priority process should have exited the timer event loop 
	before the next line, but maybe not if that process was suspended, so force termination." 
	timerEventLoop ifNotNil: [ timerEventLoop terminate ]. 
	timerEventLoop := nil.

	"Expire any remaining delays."
	activeDelay ifNotNil: [ activeDelay schedulerSignalWaitingProcess ].
	[ suspendedDelayToClear := suspendedDelays removeFirstOrNil ]
		whileNotNil: [ suspendedDelayToClear schedulerSignalWaitingProcess ].
! !

!DelayMicrosecondScheduler methodsFor: 'snapshotting' stamp: 'BenComan 3/13/2015 00:51'!
adjust: aDelay resumptionTimeOldBase: oldBaseTime newBase: newBaseTime
	"Used to adjust resumption times after a snapshot."

	aDelay schedulerResumptionTime: newBaseTime + ( aDelay schedulerResumptionTime - oldBaseTime).

	"Important!! Must only be called from the single timing priority process, e.g...
		DelayScheduler>>saveResumptionTimes 
		DelayScheduler>>restoreResumptionTimes "! !

!DelayMicrosecondScheduler methodsFor: 'timer process' stamp: 'BenComan 3/3/2015 20:59'!
handleTimerEvent: microsecondNowTick
	"Handle a timer event; which can be either:
		- a schedule request (ScheduledDelay notNil)
		- an unschedule request (FinishedDelay notNil)
		- a timer signal (not explicitly specified)
	We check for timer expiry every time we get a signal."
	| microsecondNextTick |

	"Process any schedule requests"
	scheduledDelay ifNotNil: [
		"Schedule the given delay."
		scheduledDelay scheduler: self resumptionTime: microsecondNowTick + (1000 * scheduledDelay millisecondDelayDuration).
		self scheduleDelay: scheduledDelay.
		scheduledDelay := nil ].

	"Process any unschedule requests"
	finishedDelay ifNotNil: [
		self unscheduleDelay: finishedDelay.
		finishedDelay := nil ].

	"Signal any expired delays"
	[ activeDelay notNil and:[ microsecondNowTick >= activeDelay schedulerResumptionTime ]] whileTrue: [
		activeDelay schedulerSignalWaitingProcess.
		activeDelay := suspendedDelays removeFirstOrNil.
		].

	"And signal when the next request is due. We sleep at most 1sec here
	as a soft busy-loop so that we don't accidentally miss signals."
	microsecondNextTick := microsecondNowTick + (1"sec" * 1000"msecs" * 1000"usecs").
	activeDelay ifNotNil: [
		microsecondNextTick := microsecondNextTick min: activeDelay schedulerResumptionTime ].
	^microsecondNextTick.
! !

!DelayMicrosecondScheduler methodsFor: 'printing' stamp: 'BenComan 3/2/2015 08:13'!
millisecondsUntilResumptionTime: microsecondResumptionTime
	^ (microsecondResumptionTime - Time microsecondClockValue) // 1000! !

!DelayMicrosecondScheduler methodsFor: 'timer process' stamp: 'BenComan 3/5/2015 21:55'!
unscheduleDelay: aDelay
	"Private. Unschedule this Delay."
	aDelay schedulerBeingWaitedOn 
		ifFalse:[ ^self ].
	
	activeDelay == aDelay 
		ifTrue: [
			suspendedDelays isEmpty 
				ifTrue: [ activeDelay := nil ] 
				ifFalse: [ activeDelay := suspendedDelays removeFirst ]] 
		ifFalse:[
			suspendedDelays remove: aDelay ifAbsent: []].
	
	aDelay schedulerBeingWaitedOn: false.! !

!DelayMicrosecondSchedulerTest methodsFor: 'tests' stamp: 'BenComan 3/2/2015 09:39'!
testTestInterferenceWithSystemTimingSemaphore
	| scheduler delay higherPriorityProcess delayExpired |
	
	"Just clarifying how the primitive works.  If our test case methods schedule any delays, 
	the consenquent call to #primSignal:atMilliseconds: replaces the system timingSemaphore, 
	preventing it being triggered to expire normal system delays, which would lead totestScheduler 
	system lockup.  This test indicates that timingSemaphore must be triggered to reset in #tearDown."
	
	scheduler := DelayMicrosecondScheduler new.
	
	"FIRST SHOW HOW IT WORKS PROPERLY"
	delay := Delay forMilliseconds: 100.
	higherPriorityProcess := 
		[	delayExpired := false. 
			delay wait.
			delayExpired := true.
			] newProcess
				priority: Processor activeProcess priority + 1 ;
				name: 'DelaySchedulerTest'.		
	higherPriorityProcess resume. "The higher priority process sets delayExpired to false, then waits."
	self deny: delayExpired.		
	self busyWaitMilliseconds: 200.  
	self assert: delayExpired.		"After the wait, delayExpired was set to true"
	
	"THEN SHOW HOW IT BREAKS"			
	[	
		delay := Delay forMilliseconds: 100.
		higherPriorityProcess := 
			[	delayExpired := false. 
				delay wait.
				delayExpired := true.
				] newProcess
					priority: Processor activeProcess priority + 1 ;
					name: 'DelaySchedulerTest'.		
		higherPriorityProcess resume. "The higher priority process sets delayExpired to false, then waits."
		self deny: delayExpired.	
		scheduler primSignal: Semaphore new atUTCMicroseconds: 1. "But the timingSemaphore is replaced."		
		self busyWaitMilliseconds: 200.  
		self deny: delayExpired.		"So the system timer event loop is never signalled to expire the delay"
	] 
	ensure: 
	[	"Clean up and trigger original system timingSemaphore"
		Delay testCaseSupportTimingSemaphore signal. "restart system timer event loop to expire the delay."
		self assert: delayExpired. 
		higherPriorityProcess terminate.
	].

! !

!DelayMicrosecondSchedulerTest methodsFor: 'tests' stamp: 'BenComan 3/3/2015 23:36'!
testDurationMoreThanMaxTicks
	"In #handleTimerEvent the maximum tick is hardcoded as 1000 milliseconds.
	 Test when delay duration is less than this.
		- duration is in milliseconds.
		- ticks are in microseconds"
	| duration maxTicks  nowTick nextTick expectedTick scheduler |
	duration := 1234 milliSeconds. "simply more than maxTicks"
	maxTicks := 1000 milliSeconds. 
	nowTick := 100 milliSeconds.
	expectedTick := nowTick + maxTicks.

	scheduler := DelayMicrosecondScheduler new.
	scheduler schedule: duration asDelay. 
	nextTick := scheduler handleTimerEvent: nowTick asMicroseconds.

	self assert: nextTick 
			equals: expectedTick asMicroseconds.		
	self assert: scheduler testCaseSupportActiveDelay millisecondDelayDuration 
			equals: duration asMilliSeconds.
	! !

!DelayMicrosecondSchedulerTest methodsFor: 'support' stamp: 'BenComan 3/2/2015 08:30'!
busyWaitMilliseconds: milliseconds
	| waitUntil |
	waitUntil := Time millisecondClockValue + milliseconds.
	[ Time millisecondClockValue < waitUntil ] whileTrue.
! !

!DelayMicrosecondSchedulerTest methodsFor: 'running' stamp: 'BenComan 3/1/2015 21:19'!
tearDown 	
	"Trigger system timingSempaphore, in case it was replaced"
	Delay testCaseSupportTimingSemaphore signal! !

!DelayMicrosecondSchedulerTest methodsFor: 'tests' stamp: 'BenComan 3/2/2015 08:49'!
testForSeconds
	| scheduler delay preTick postTick actualDuration |
	scheduler := DelayMicrosecondScheduler new.
	delay := Delay forSeconds: 1.
	scheduler schedule: delay.
	
	preTick := Time millisecondClockValue.
	[ 	scheduler handleTimerEvent: Time microsecondClockValue.
		Processor yield.
		delay delaySemaphore isSignaled
	] whileFalse.
	postTick := Time millisecondClockValue.
	
	actualDuration := postTick - preTick.
	self assert: actualDuration >= 995.
	self assert: actualDuration <= 1005.! !

!DelayMicrosecondSchedulerTest methodsFor: 'tests' stamp: 'BenComan 3/2/2015 22:22'!
testMillisecondsToGo
	| delay scheduler millisecondsToGo |
	scheduler := DelayMicrosecondScheduler new.
	delay := Delay forMilliseconds: 100.
	scheduler schedule: delay.
	scheduler handleTimerEvent: Time microsecondClockValue.
	self busyWaitMilliseconds: 50.
	millisecondsToGo := delay millisecondsToGo.
	self assert: millisecondsToGo >= 40.
	self assert: millisecondsToGo <= 60.! !

!DelayMicrosecondSchedulerTest methodsFor: 'tests' stamp: 'BenComan 3/3/2015 23:36'!
testDurationLessThanMaxTicks
	"In #handleTimerEvent the maximum tick is hardcoded as 1000 milliseconds.
	 Test when delay duration is less than this.
		- duration is in milliseconds.
		- ticks are in microseconds"
	| duration nowTick nextTick expectedTick scheduler |
	duration := 789 milliSeconds.  "simply less than maxTicks"
	nowTick := 100 milliSeconds. 
	expectedTick := nowTick + duration.

	scheduler := DelayMicrosecondScheduler new.
	scheduler schedule: duration asDelay. 
	nextTick := scheduler handleTimerEvent: nowTick asMicroseconds.

	self assert: nextTick 
			equals: expectedTick asMicroseconds.		
	self assert: scheduler testCaseSupportActiveDelay millisecondDelayDuration 
			equals: duration asMilliSeconds.
	! !

!DelayMicrosecondSchedulerTest methodsFor: 'tests' stamp: 'BenComan 3/2/2015 08:49'!
testForMilliseconds
	| scheduler delay preTick postTick actualDuration |
	scheduler := DelayMicrosecondScheduler new.
	delay := Delay forMilliseconds: 100.
	scheduler schedule: delay.
	
	preTick := Time millisecondClockValue.
	[ 	scheduler handleTimerEvent: Time microsecondClockValue.
		Processor yield.
		delay delaySemaphore isSignaled
	] whileFalse.
	postTick := Time millisecondClockValue.
	
	actualDuration := postTick - preTick.
	self assert: actualDuration >= 95.
	self assert: actualDuration <= 105.! !

!DelayMillisecondScheduler commentStamp: 'BenComan 3/3/2015 23:34'!
This concrete subclass uses the millisecond primitive & clock, which are based on a 32-bit Integer, rolling over roughly every 6 days.  Special handling for clock rollover is scatter through the implementation.

There are some code duplications with simbling classes for performance reasons.

See parent class comment for more info.!
!DelayMillisecondScheduler methodsFor: 'primitives' stamp: 'BenComan 3/1/2015 11:03'!
primSignal: aSemaphore atMilliseconds: aSmallInteger
	"Signal the semaphore when the millisecond clock reaches the value of the second argument. Fail if the first argument is neither a Semaphore nor nil. Essential. See Object documentation whatIsAPrimitive."
	<primitive: 136>
	^self primitiveFailed! !

!DelayMillisecondScheduler methodsFor: 'timer process' stamp: 'BenComan 3/2/2015 00:48'!
runTimerEventLoop
	| millisecondNowTick millisecondNextTick   |
	"Run the timer event loop."
	[ runTimerEventLoop ] whileTrue: [ 
		timingSemaphore wait.		
		millisecondNowTick := Time millisecondClockValue.
		millisecondNextTick := self handleTimerEvent: millisecondNowTick.

		"Since we have processed all outstanding requests, reset the timing semaphore so
		that only new work will wake us up again. Do this RIGHT BEFORE setting the next
		wakeup call from the VM because it is only signaled once so we mustn't miss it."
		timingSemaphore consumeAllSignals.
		self primSignal: timingSemaphore atMilliseconds: millisecondNextTick.

		"This last test is necessary for the obscure case that the msecs clock rolls over
		after nowTick has been computed (unlikely but not impossible). In this case we'd
		wait for MillisecondClockMask msecs (roughly six days) or until another delay gets
		scheduled (which may not be any time soon). In any case, since handling the
		condition is easy, let's just deal with it"
		Time millisecondClockValue < millisecondNowTick
			ifTrue:[ timingSemaphore signal ]. "retry"
		
		].
! !

!DelayMillisecondScheduler methodsFor: 'snapshotting' stamp: 'BenComan 3/12/2015 22:33'!
shutDown
	"Suspend the active delay, if any, before snapshotting. It will be reactived when the snapshot is resumed."
	"Details: This prevents a timer interrupt from waking up the active delay in the midst snapshoting, since the active delay will be restarted when resuming the snapshot and we don't want to process the delay twice."
	accessProtect consumeAllSignals.
	self primSignal: nil atMilliseconds: 0.
	self saveResumptionTimes.
	delaySuspended := true.
! !

!DelayMillisecondScheduler methodsFor: 'timer process' stamp: 'BenComan 3/5/2015 21:53'!
scheduleDelay: aDelay
	"Private. Schedule this Delay."
	
	aDelay schedulerBeingWaitedOn: true.
	activeDelay 
		ifNil: [ activeDelay := aDelay ]
		ifNotNil: [
			aDelay schedulerResumptionTime < activeDelay schedulerResumptionTime
				ifTrue: [
					suspendedDelays add: activeDelay.
					activeDelay := aDelay ]
				ifFalse: [ suspendedDelays add: aDelay ]]
! !

!DelayMillisecondScheduler methodsFor: 'snapshotting' stamp: 'BenComan 3/1/2015 11:59'!
saveResumptionTimes
	"Private!! Record the resumption times of all Delays relative to a base time of zero. This is done prior to snapshotting or adjusting the resumption times after a clock roll-over. This method should be called only while the AccessProtect semaphore is held."

	| oldBaseTime |
	oldBaseTime := Time millisecondClockValue. 
	activeDelay == nil
		ifFalse: [
			oldBaseTime < activeDelayStartTime
				ifTrue: [ oldBaseTime := activeDelayStartTime ].  "clock rolled over"
			self adjust: activeDelay resumptionTimeOldBase: oldBaseTime newBase: 0 ].
		
	suspendedDelays do: [ :delay |
		self adjust: delay resumptionTimeOldBase: oldBaseTime newBase: 0 ].
! !

!DelayMillisecondScheduler methodsFor: 'snapshotting' stamp: 'BenComan 3/1/2015 11:59'!
restoreResumptionTimes
	"Private!! Restore the resumption times of all scheduled Delays after a snapshot or clock roll-over. This method should be called only while the AccessProtect semaphore is held."

	| newBaseTime |
	newBaseTime := Time millisecondClockValue.
	suspendedDelays do: [ :delay | 
		self adjust: delay resumptionTimeOldBase: 0 newBase: newBaseTime ].
	activeDelay == nil ifFalse: [
		self adjust: activeDelay resumptionTimeOldBase: 0 newBase: newBaseTime ].
! !

!DelayMillisecondScheduler methodsFor: 'low priority processes' stamp: 'BenComan 3/5/2015 21:52'!
schedule: aDelay
	| scheduled |
	scheduled := false.
	aDelay schedulerBeingWaitedOn ifTrue: [^self error: 'This Delay has already been scheduled.'].
	accessProtect critical: [
		scheduledDelay := aDelay.
		timingSemaphore signal. "#handleTimerEvent: sets scheduledDelay:=nil"
		scheduled := (scheduledDelay == nil).
		].
	^scheduled.
	! !

!DelayMillisecondScheduler methodsFor: 'timer process' stamp: 'BenComan 3/1/2015 12:00'!
startTimerEventLoop
	"Start the timer event loop"
	"Delay restartTimerEventLoop"
	
	timerEventLoop ifNotNil: [ self error: 'Timer event loop has already been started.' ].
	
	activeDelayStartTime := Time millisecondClockValue.
	suspendedDelays := Heap 
			sortBlock: [ :delay1 :delay2 | delay1 schedulerResumptionTime <= delay2 schedulerResumptionTime ].
	timingSemaphore := Semaphore new.
	runTimerEventLoop := true.
	
	timerEventLoop := [ self runTimerEventLoop ] newProcess.
	timerEventLoop 
		name: 'Delay Scheduling Process';
		priority: Processor timingPriority.
	timerEventLoop resume.
	
	timingSemaphore signal. "get going"
! !

!DelayMillisecondScheduler methodsFor: 'timer process' stamp: 'BenComan 3/1/2015 21:01'!
stopTimerEventLoop
	"Stop the timer event loop"
	|  suspendedDelayToClear |
	
	runTimerEventLoop := false.
	timingSemaphore signal. 
	
	"The signalled higher priority process should have exited the timer event loop 
	before the next line, but maybe not if that process was suspended, so force termination." 
	timerEventLoop ifNotNil: [ timerEventLoop terminate ]. 
	timerEventLoop := nil.

	"Expire any remaining delays."
	activeDelay ifNotNil: [ activeDelay schedulerSignalWaitingProcess ].
	[ suspendedDelayToClear := suspendedDelays removeFirstOrNil ]
		whileNotNil: [ suspendedDelayToClear schedulerSignalWaitingProcess ].
! !

!DelayMillisecondScheduler methodsFor: 'snapshotting' stamp: 'BenComan 3/13/2015 00:52'!
adjust: aDelay resumptionTimeOldBase: oldBaseTime newBase: newBaseTime
	"Used to adjust resumption times after a snapshot or clock roll-over."

	aDelay schedulerResumptionTime: newBaseTime + ( aDelay schedulerResumptionTime - oldBaseTime).

	"Important!! Must only be called from the single timing priority process, e.g...
		DelayScheduler>>saveResumptionTimes 
		DelayScheduler>>restoreResumptionTimes "

	
	! !

!DelayMillisecondScheduler methodsFor: 'timer process' stamp: 'BenComan 3/2/2015 08:12'!
handleTimerEvent: millisecondNowTick
	"Handle a timer event; which can be either:
		- a schedule request (ScheduledDelay notNil)
		- an unschedule request (FinishedDelay notNil)
		- a timer signal (not explicitly specified)
	We check for timer expiry every time we get a signal."
	| millisecondNextTick |

	"Process any schedule requests"
	scheduledDelay ifNotNil: [
		"Schedule the given delay."
		scheduledDelay scheduler: self resumptionTime: millisecondNowTick + scheduledDelay millisecondDelayDuration.
		self scheduleDelay: scheduledDelay.
		scheduledDelay := nil ].

	"Process any unschedule requests"
	finishedDelay ifNotNil: [
		self unscheduleDelay: finishedDelay.
		finishedDelay := nil ].

	"Check for clock wrap-around."
	millisecondNowTick < activeDelayStartTime ifTrue: [
		"clock wrapped"
		self saveResumptionTimes.
		self restoreResumptionTimes ].
	activeDelayStartTime := millisecondNowTick.

	"Signal any expired delays"
	[ activeDelay notNil and:[ millisecondNowTick >= activeDelay schedulerResumptionTime ]] whileTrue: [
		activeDelay schedulerSignalWaitingProcess.
		activeDelay := suspendedDelays removeFirstOrNil.
		].

	"And signal when the next request is due. We sleep at most 1sec here
	as a soft busy-loop so that we don't accidentally miss signals."
	millisecondNextTick := millisecondNowTick + 1000"msecs".
	activeDelay ifNotNil: [
		millisecondNextTick := millisecondNextTick min: activeDelay schedulerResumptionTime ].
	millisecondNextTick := millisecondNextTick min: SmallInteger maxVal.
	^millisecondNextTick.
! !

!DelayMillisecondScheduler methodsFor: 'printing' stamp: 'BenComan 3/2/2015 08:13'!
millisecondsUntilResumptionTime: millisecondResumptionTime
	^ millisecondResumptionTime - Time millisecondClockValue! !

!DelayMillisecondScheduler methodsFor: 'timer process' stamp: 'BenComan 3/5/2015 21:55'!
unscheduleDelay: aDelay
	"Private. Unschedule this Delay."
	aDelay schedulerBeingWaitedOn 
		ifFalse:[ ^self ].
	
	activeDelay == aDelay 
		ifTrue: [
			suspendedDelays isEmpty 
				ifTrue: [ activeDelay := nil ] 
				ifFalse: [ activeDelay := suspendedDelays removeFirst ]] 
		ifFalse:[
			suspendedDelays remove: aDelay ifAbsent: []].
	
	aDelay schedulerBeingWaitedOn: false.! !

!DelayMillisecondSchedulerTest commentStamp: 'BenComan 10/26/2014 11:48'!
Provide tests for DelayScheduler!
!DelayMillisecondSchedulerTest methodsFor: 'tests' stamp: 'BenComan 3/2/2015 09:40'!
testTestInterferenceWithSystemTimingSemaphore
	| scheduler delay higherPriorityProcess delayExpired |
	
	"Just clarifying how the primitive works.  If our test case methods schedule any delays, 
	the consenquent call to #primSignal:atMilliseconds: replaces the system timingSemaphore, 
	preventing it being triggered to expire normal system delays, which would lead totestScheduler 
	system lockup.  This test indicates that timingSemaphore must be triggered to reset in #tearDown."
	
	scheduler := DelayMillisecondScheduler new.
	
	"FIRST SHOW HOW IT WORKS PROPERLY"
	delay := Delay forMilliseconds: 100.
	higherPriorityProcess := 
		[	delayExpired := false. 
			delay wait.
			delayExpired := true.
			] newProcess
				priority: Processor activeProcess priority + 1 ;
				name: 'DelaySchedulerTest'.		
	higherPriorityProcess resume. "The higher priority process sets delayExpired to false, then waits."
	self deny: delayExpired.		
	self busyWaitMilliseconds: 200.  
	self assert: delayExpired.		"After the wait, delayExpired was set to true"
	
	"THEN SHOW HOW IT BREAKS"
	[	
		delay := Delay forMilliseconds: 100.
		higherPriorityProcess := 
			[	delayExpired := false. 
				delay wait.
				delayExpired := true.
				] newProcess
					priority: Processor activeProcess priority + 1 ;
					name: 'DelaySchedulerTest'.		
		higherPriorityProcess resume. "The higher priority process sets delayExpired to false, then waits."
		self deny: delayExpired.		
		scheduler primSignal: Semaphore new atMilliseconds: 1. 	"But the timingSemaphore is replaced."	
		self busyWaitMilliseconds: 200.  
		self deny: delayExpired.		"So the system timer event loop is never signalled to expire the delay"
	] 
	ensure: 
	[	"Clean up and trigger original system timingSemaphore"
		Delay testCaseSupportTimingSemaphore signal. "restart system timer event loop to expire the delay."
		self assert: delayExpired. 
		higherPriorityProcess terminate.
	].

! !

!DelayMillisecondSchedulerTest methodsFor: 'tests' stamp: 'BenComan 3/3/2015 23:37'!
testDurationMoreThanMaxTicks
	"In #handleTimerEvent the maximum tick is hardcoded as 1000 milliseconds.
	 Test when delay duration is less than this.
		- duration is in milliseconds.
		- ticks are in milliseconds"
	| duration maxTicks  nowTick nextTick expectedTick scheduler |
	duration := 1234 milliSeconds. "simply more than maxTicks"
	maxTicks := 1000 milliSeconds. 
	nowTick := 100 milliSeconds.
	expectedTick := nowTick + maxTicks.

	scheduler := DelayMillisecondScheduler new.
	scheduler testCaseSupportSetActiveDelayStartTime: 0.
	scheduler schedule: duration asDelay. 
	nextTick := scheduler handleTimerEvent: nowTick asMilliSeconds.

	self assert: nextTick 
			equals: expectedTick asMilliSeconds.		
	self assert: scheduler testCaseSupportActiveDelay millisecondDelayDuration 
			equals: duration asMilliSeconds.
	! !

!DelayMillisecondSchedulerTest methodsFor: 'support' stamp: 'BenComan 3/2/2015 08:31'!
busyWaitMilliseconds: milliseconds
	| waitUntil |
	waitUntil := Time millisecondClockValue + milliseconds.
	[ Time millisecondClockValue < waitUntil ] whileTrue.
! !

!DelayMillisecondSchedulerTest methodsFor: 'running' stamp: 'BenComan 10/29/2014 22:31'!
tearDown 	
	"Trigger system timingSempaphore, in case it was replaced"
	Delay testCaseSupportTimingSemaphore signal! !

!DelayMillisecondSchedulerTest methodsFor: 'tests' stamp: 'BenComan 3/2/2015 08:48'!
testForSeconds
	| scheduler delay preTick postTick actualDuration |
	scheduler := DelayMillisecondScheduler new.
	scheduler testCaseSupportSetActiveDelayStartTime: Time millisecondClockValue.
	delay := Delay forSeconds: 1.
	scheduler schedule: delay.
	
	preTick := Time millisecondClockValue.
	[ 	scheduler handleTimerEvent: Time millisecondClockValue.
		Processor yield.
		delay delaySemaphore isSignaled
	] whileFalse.
	postTick := Time millisecondClockValue.
	
	actualDuration := postTick - preTick.
	self assert: actualDuration >= 995.
	self assert: actualDuration <= 1005.! !

!DelayMillisecondSchedulerTest methodsFor: 'tests' stamp: 'BenComan 3/2/2015 22:22'!
testMillisecondsToGo
	| delay scheduler millisecondsToGo |
	scheduler := DelayMicrosecondScheduler new.
	delay := Delay forMilliseconds: 100.
	scheduler schedule: delay.
	scheduler handleTimerEvent: Time microsecondClockValue.
	self busyWaitMilliseconds: 50.
	millisecondsToGo := delay millisecondsToGo.
	self assert: millisecondsToGo >= 40.
	self assert: millisecondsToGo <= 60.! !

!DelayMillisecondSchedulerTest methodsFor: 'tests' stamp: 'BenComan 3/3/2015 23:36'!
testDurationLessThanMaxTicks
	"In #handleTimerEvent the maximum tick is hardcoded as 1000 milliseconds.
	 Test when delay duration is less than this.
		- duration is in milliseconds.
		- ticks are in milliseconds"
	| duration nowTick nextTick expectedTick scheduler |
	duration := 789 milliSeconds.  "simply less than maxTicks"
	nowTick := 100 milliSeconds. 
	expectedTick := nowTick + duration.

	scheduler := DelayMillisecondScheduler new.
	scheduler testCaseSupportSetActiveDelayStartTime: 0.
	scheduler schedule: duration asDelay. 
	nextTick := scheduler handleTimerEvent: nowTick asMilliSeconds.

	self assert: nextTick 
			equals: expectedTick asMilliSeconds.		
	self assert: scheduler testCaseSupportActiveDelay millisecondDelayDuration 
			equals: duration asMilliSeconds.
	! !

!DelayMillisecondSchedulerTest methodsFor: 'tests' stamp: 'BenComan 3/2/2015 08:48'!
testForMilliseconds
	| scheduler delay preTick postTick actualDuration |
	scheduler := DelayMillisecondScheduler new.
	scheduler testCaseSupportSetActiveDelayStartTime: Time millisecondClockValue.
	delay := Delay forMilliseconds: 100.
	scheduler schedule: delay.
	
	preTick := Time millisecondClockValue.
	[ 	scheduler handleTimerEvent: Time millisecondClockValue.
		Processor yield.
		delay delaySemaphore isSignaled
	] whileFalse.
	postTick := Time millisecondClockValue.
	
	actualDuration := postTick - preTick.
	self assert: actualDuration >= 95.
	self assert: actualDuration <= 105.! !

!DelayNullScheduler commentStamp: 'BenComan 3/20/2015 17:05'!
This concrete subclass of DelayScheduler immediately signals the delaySemaphore, effectively eliminating the delay.  This can be useful to facilitate modifications to the DelayScheduler code hierarchy.

The delay scehduler is in continual use every 20 - 50 milliseconds due to the UI loop, so it can be difficult to modify (particularly via a continuous integration validation service).  DelayNullScheduler is provided as a substitute to allow the UI loop to continue while the delay scheduler system is taken offline for modifications. If that proves insufficient, try temporarily bypassing the call to #interCyclePause from WorldState>>doOneCycleNow.

Select either from "System > Settings > System > Delay Scheduler" 
or do... "Delay delaySchedulerClass: DelayNullScheduler"


!
!DelayNullScheduler methodsFor: 'low priority processes' stamp: 'BenComan 3/9/2015 00:10'!
schedule: aDelay
	aDelay delaySemaphore signal.
	^true
	
! !

!DelayNullScheduler methodsFor: 'low priority processes' stamp: 'BenComan 3/9/2015 00:10'!
unschedule: aDelay
	"Nothing to do"
		
! !

!DelayNullScheduler methodsFor: 'timer process' stamp: 'BenComan 3/20/2015 17:02'!
startTimerEventLoop
	"Start a fake timer event loop that does nothing - just suspends via a wait that is never signalled"
	"Delay restartTimerEventLoop"
		
	timerEventLoop ifNotNil: [ self error: 'Timer event loop has already been started.' ].
		
	timerEventLoop := [ Processor activeProcess suspend. ] newProcess.
	timerEventLoop 
		name: 'WARNING!! Delay Scheduling Process NOT RUNNING!!';
		priority: Processor timingPriority.
	timerEventLoop resume.
! !

!DelayNullScheduler methodsFor: 'snapshotting' stamp: 'BenComan 3/20/2015 17:30'!
startUp
	self error: 'Delay scheduler is NOT RUNNING!!'.
	"The running delay scheduler seems to be DelayNullScheduler.
	 This is probably not what you want. See Tools > Process Browser.
	 
	 If all is well, the following should result in a value 1 second...
	    [1 second asDelay wait] timeToRun

	 To get delays working again, go to System > Settings > System > Delay scheduler.	
	 "
 ! !

!DelayNullScheduler methodsFor: 'snapshotting' stamp: 'BenComan 3/20/2015 17:31'!
shutDown
	"do nothing"! !

!DelayNullScheduler methodsFor: 'timer process' stamp: 'BenComan 3/9/2015 22:38'!
stopTimerEventLoop
	"Stop the timer event loop"

	timerEventLoop ifNotNil: [ timerEventLoop terminate ]. 
	timerEventLoop := nil.

! !

!DelayNullScheduler methodsFor: 'timer process' stamp: 'BenComan 3/9/2015 22:29'!
schedulingProcess
	^ timerEventLoop ! !

!DelayNullSchedulerTest methodsFor: 'tests' stamp: 'BenComan 3/20/2015 20:27'!
testNullDelay
	| scheduler delay preTick postTick actualDuration |
	scheduler := DelayNullScheduler new.
	delay := Delay forMilliseconds: 1000.
	
	preTick := Time millisecondClockValue.
	scheduler schedule: delay.  "The null #schedule: immediately signals the delaySemaphore..."
	delay delaySemaphore wait. "...so there is no wait"
	postTick := Time millisecondClockValue.	
		
	actualDuration := postTick - preTick.
	self assert: actualDuration <= 1 "this would have been near 1000 for a working delay".! !

!DelayScheduler commentStamp: 'BenComan 3/19/2015 22:55'!
I provide the high priority process that interacts with the VM via /timingSempahore/ to manage scheduling of Delays.  

The original pre-2014 code on the class-side of Delay was refactored to a singleton pattern in DelayScheduler, then further refactored into two subclasses...
 * DelayMillisecondScheduler (pre-2014, 6 day clock rollover)
 * DelayMicrosecondScheduler (new, 50,000 year rollover)
A fair amount of code is duplicated in the subclasses for both performance and helping with the live transition to the new code (some cleanup required after the new code has been in use for a while)

You can switch between different DelayScheduler implementations using Settings Browser > System. 
You can observe which delay scheduler is running using Tools > Process Browser.

Original word of advice:
DelayScheduler is THE highest priority code which is run in Pharo.  In other words it is time-critical. The speed of this code is critical for accurate responses, it is critical for network services, it affects every last part of the system. Don't fix it if it ain't broken!! This code isn't supposed to be beautiful, it's supposed to be fast!! The reason for duplicating code is to make it fast. The reason for not using ifNil:[]ifNotNil:[] is that the compiler might not inline those. Since the effect of changes are VERY hard to predict it is best to leave things as they are for now unless there is an actual need to change anything.

Revised word of advice:
Now you can swap between different schedulers on the fly, have a go. Create your own subclass of  DelayScheduler and use DelayBenchmark to compare the alternatives.  

Tip: If while experimenting you have trouble with the UI locking (which prevents debugging), in WorldState>>doOneCycleFor: comment out the call to #interCyclePause: .

!
!DelayScheduler methodsFor: 'printing' stamp: 'BenComan 3/16/2015 23:47'!
millisecondsUntilResumptionTime: millisecondResumptionTime
	self subclassResponsibility ! !

!DelayScheduler methodsFor: 'low priority processes' stamp: 'BenComan 10/26/2014 10:43'!
unschedule: aDelay
	accessProtect critical: [
		finishedDelay := aDelay.
		timingSemaphore signal.
		].

! !

!DelayScheduler methodsFor: 'timer process' stamp: 'BenComan 3/16/2015 23:48'!
runTimerEventLoop
	self subclassResponsibility ! !

!DelayScheduler methodsFor: 'snapshotting' stamp: 'BenComan 3/16/2015 23:49'!
shutDown
	self subclassResponsibility ! !

!DelayScheduler methodsFor: 'timer process' stamp: 'BenComan 3/16/2015 23:49'!
scheduleDelay: aDelay
	self subclassResponsibility ! !

!DelayScheduler methodsFor: '*KernelTests' stamp: 'BenComan 10/26/2014 12:19'!
testCaseSupportActiveDelay
	^activeDelay! !

!DelayScheduler methodsFor: 'snapshotting' stamp: 'BenComan 3/16/2015 23:48'!
saveResumptionTimes
	self subclassResponsibility ! !

!DelayScheduler methodsFor: 'timer process' stamp: 'BenComan 10/26/2014 10:42'!
schedulingProcess
	^ timerEventLoop ! !

!DelayScheduler methodsFor: 'timer process' stamp: 'BenComan 11/3/2014 20:31'!
restartTimerEventLoop
	"Start the timer event loop"
	"Delay restartTimerEventLoop"
	self stopTimerEventLoop.
	self startTimerEventLoop.

! !

!DelayScheduler methodsFor: '*KernelTests' stamp: 'BenComan 10/27/2014 23:33'!
testCaseSupportTimingSemaphore
	"Tests might alter which sempahore the VM signals, so call this from test tearDown"
	^ timingSemaphore.! !

!DelayScheduler methodsFor: 'snapshotting' stamp: 'BenComan 3/16/2015 23:48'!
restoreResumptionTimes
	self subclassResponsibility ! !

!DelayScheduler methodsFor: 'low priority processes' stamp: 'BenComan 3/16/2015 23:49'!
schedule: aDelay
	self subclassResponsibility ! !

!DelayScheduler methodsFor: 'class initialization' stamp: 'BenComan 3/5/2015 21:50'!
initialize
	"Delay initialize"
	timingSemaphore := (Smalltalk specialObjectsArray at: 30) ifNil: [ Semaphore new ].
	delaySuspended := true.
	accessProtect := Semaphore forMutualExclusion.

	"Case 14353 - The following is moving here from #startTimerEventLoop to help with tests. 
	Its also left in its original location for now, to be cleaned up later."
	suspendedDelays := Heap 
			sortBlock: [ :delay1 :delay2 | delay1 schedulerResumptionTime <= delay2 schedulerResumptionTime ].
! !

!DelayScheduler methodsFor: 'timer process' stamp: 'BenComan 3/16/2015 23:50'!
startTimerEventLoop
	self subclassResponsibility ! !

!DelayScheduler methodsFor: 'snapshotting' stamp: 'BenComan 10/26/2014 10:42'!
startUp
	"Restart active delay, if any, when resuming a snapshot."

	"Compare to false since it can be nil"
	(delaySuspended = false) 
		ifTrue:[ ^self error: 'Trying to activate Delay twice' ].
	delaySuspended := false.
	
	activeDelayStartTime := Time millisecondClockValue.
	self restoreResumptionTimes.
	accessProtect signal.
! !

!DelayScheduler methodsFor: '*KernelTests' stamp: 'BenComan 10/26/2014 12:22'!
testCaseSupportSetActiveDelayStartTime: time
	activeDelayStartTime := time.! !

!DelayScheduler methodsFor: 'timer process' stamp: 'BenComan 3/16/2015 23:50'!
stopTimerEventLoop
	self subclassResponsibility ! !

!DelayScheduler methodsFor: 'testing' stamp: 'BenComan 3/1/2015 10:18'!
nextWakeUpTime
	^ accessProtect
		critical: [ activeDelay 
				ifNil: [ 0 ]
				ifNotNil: [ activeDelay schedulerResumptionTime ]]! !

!DelayScheduler methodsFor: '*KernelTests' stamp: 'BenComan 10/27/2014 23:30'!
testCaseSupportSystemTimingSemaphore
	^ timingSemaphore! !

!DelayScheduler methodsFor: 'snapshotting' stamp: 'BenComan 3/16/2015 23:45'!
adjust: aDelay resumptionTimeOldBase: oldBaseTime newBase: newBaseTime
	self subclassResponsibility ! !

!DelayScheduler methodsFor: 'timer process' stamp: 'BenComan 3/16/2015 23:47'!
handleTimerEvent: nowTick
	self subclassResponsibility ! !

!DelayScheduler methodsFor: 'testing' stamp: 'BenComan 10/26/2014 10:39'!
anyActive
	"Return true if there is any delay currently active"
	^activeDelay notNil! !

!DelayScheduler methodsFor: 'timer process' stamp: 'BenComan 3/16/2015 23:50'!
unscheduleDelay: aDelay
	self subclassResponsibility ! !

!DelaySchedulerBackgroundWorkerMorph commentStamp: 'BenComan 3/25/2015 22:07'!
I provide the support to test Pharo Case 13755. Not quite sure how to plug this into the testing framewok.  Currently just run this test manually like this...
    DelaySchedulerBackgroundWorkerMorph new openInWorld

which will FREEZE THE UI when using the following...
  * DelayMillisecondScheduler
  * DelayMicrosecondScheduler

but won't freeze when using  the following...
  * DelayExperimentalSemaphoreScheduler
  * DelayExperimentalSpinScheduler
  * DelayExperimentalCourageousScheduler

Close my instance morphs via halos, or evaluate the following...
    DelaySchedulerBackgroundWorkerMorph allInstances do: #delete.

!
!DelaySchedulerBackgroundWorkerMorph methodsFor: 'stepping' stamp: 'BenComan 3/25/2015 21:41'!
step
    stringMorph contents: work printString ! !

!DelaySchedulerBackgroundWorkerMorph methodsFor: 'initialization' stamp: 'BenComan 3/25/2015 21:57'!
initialize
    "DelaySchedulerBackgroundWorkerMorph new openInWorld"
    | workerProcess controllerProcess |
    super initialize.
    self extent: (300@50).
    self color: Color red.
    self addMorphBack:  (stringMorph := StringMorph new).
    morphDeleted := false.      "see #delete"

    workerProcess :=  
    [     work := 0.
        [    10 milliSeconds asDelay wait.
            work := work + 1.
            morphDeleted.
        ] whileFalse.
    ] newProcess name: 'Background worker'.

    controllerProcess :=
    [     [    workerProcess resume. self color: Color green.
            10 milliSeconds asDelay wait.
            workerProcess suspend. self color: Color red.
            10 milliSeconds asDelay wait.
            morphDeleted.
        ] whileFalse.
    ] newProcess name: 'Controller'.

    controllerProcess resume.! !

!DelaySchedulerBackgroundWorkerMorph methodsFor: 'stepping' stamp: 'BenComan 3/25/2015 21:41'!
stepTime
    ^ 50! !

!DelaySchedulerBackgroundWorkerMorph methodsFor: 'action' stamp: 'BenComan 3/25/2015 21:41'!
delete
    morphDeleted := true.
    super delete.! !

!DelayTest methodsFor: 'testing' stamp: 'BenComan 2/27/2015 00:01'!
testSemaphoreTimeout
	"When we provide our own semaphore for a Delay, it should be used"
	"See http://bugs.squeak.org/view.php?id=6834"

	"self run: #testSemaphoreTimeout"
	
	| sem |
	sem := Semaphore new.
	[ | process |
		process := [Delay timeoutSemaphore: sem afterMSecs: 0. sem wait] newProcess.
		process priority: Processor highIOPriority.
		process resume.
		self assert: process isTerminated.
	] ensure: [sem signal]! !

!DelayTest methodsFor: 'testing' stamp: 'BenComan 2/27/2015 00:01'!
testSemaphoreNoTimeout
	| sem process |
	sem := Semaphore new.
	[ | delay |
		process := [ delay := Delay timeoutSemaphore: sem afterMSecs: 1000. sem wait] newProcess.
		process priority: Processor highIOPriority.
		process resume.
		delay unschedule.
		self deny: process isTerminated.
	] ensure: [sem signal].
	self assert: process isTerminated.
! !

!DelayTest methodsFor: 'testing-limits' stamp: 'ar 9/21/2009 22:12'!
testMultiSchedule
	"Ensure that scheduling the same delay twice raises an error"
	| delay |
	delay := Delay forSeconds: 1.
	delay schedule.
	self should:[delay schedule] raise: Error.
! !

!DelayTest methodsFor: 'testing-limits' stamp: 'ar 9/21/2009 22:14'!
testMultiProcessWaitOnSameDelay
	"Ensure that waiting on the same delay from multiple processes raises an error"
	| delay p1 p2 wasRun |
	delay := Delay forSeconds: 1.
	wasRun := false.
	p1 := [delay wait] forkAt: Processor activePriority+1.
	p2 := [
		self should:[delay wait] raise: Error.
		wasRun := true.
	] forkAt: Processor activePriority+1.
	p1 terminate.
	p2 terminate.
	self assert: wasRun.

! !

!DelayTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testBounds
	"self run: #testBounds"

	self should: [ Delay forMilliseconds: -1 ] raise: Error.
	Delay forMilliseconds: SmallInteger maxVal // 2 + 1.
	Delay forMilliseconds: SmallInteger maxVal + 1.
	(Delay forMilliseconds: Float pi) wait	"Wait 3ms"! !

!DelayWaitTimeout commentStamp: '<historical>'!
DelayWaitTimeout is a special kind of Delay used in waitTimeoutMSecs: to avoid signaling the underlying semaphore when the wait times out.!
!DelayWaitTimeout methodsFor: 'waiting' stamp: 'ar 3/27/2009 22:26'!
wait
	"Wait until either the semaphore is signaled or the delay times out"
	[self schedule.
	"It is critical that the following has no suspension point so that
	the test and the wait primitive are atomic. In addition, if the delay
	is no longer being waited on while entering the way we know that it 
	is expired because the delay has already fired."
	beingWaitedOn 
		ifTrue:[delaySemaphore wait]
		ifFalse:[expired := true]] ensure:[self unschedule].
	^self isExpired
! !

!DelayWaitTimeout methodsFor: 'testing' stamp: 'ar 3/23/2009 16:37'!
isExpired
	"Did this timeout fire before the associated semaphore was signaled?"
	^expired! !

!DelayWaitTimeout methodsFor: 'signaling' stamp: 'BenComan 3/1/2015 10:45'!
schedulerSignalWaitingProcess
	"Release the given process from the semaphore it is waiting on.
	This method relies on running at highest priority so that it cannot be preempted
	by the process being released."
	beingWaitedOn := false.
	"Release the process but only if it is still waiting on its original list"
	process suspendingList == delaySemaphore ifTrue:[
		expired := true.
		process suspend; resume.
		].
! !

!DelayWaitTimeout methodsFor: 'private' stamp: 'ar 3/23/2009 16:38'!
setDelay: anInteger forSemaphore: aSemaphore
	super setDelay: anInteger forSemaphore: aSemaphore.
	process := Processor activeProcess.
	expired := false.! !

!DeleteVisitor commentStamp: 'cwp 11/18/2009 12:30'!
I delete the directory tree that I visit. I use the PostorderGuide so that I can delete files before deleting their containing directories.!
!DeleteVisitor methodsFor: 'visiting' stamp: 'CamilloBruni 4/10/2013 12:19'!
visit: aReference
	PostorderGuide 
		show: aReference 
		to: self 
		selecting: [ :entry | entry isSymlink not ]! !

!DeleteVisitor methodsFor: 'visiting' stamp: 'cwp 11/16/2009 10:53'!
visitReference: anEntry
	anEntry reference delete! !

!DeleteVisitor class methodsFor: 'instance creation' stamp: 'cwp 11/17/2009 13:02'!
delete: aReference
	^ self new visit: aReference! !

!DeleteVisitorTest commentStamp: 'TorstenBergmann 1/31/2014 11:42'!
SUnit tests for class DeleteVisitor!
!DeleteVisitorTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:40'!
testBeta
	self setUpGreek.
	DeleteVisitor delete: (filesystem / 'alpha' / 'beta').
	self assert: (filesystem isDirectory: '/alpha').
	self assert: (filesystem isDirectory: '/alpha/epsilon').
	self deny: (filesystem exists: '/alpha/beta').
	! !

!DenyDialogWindow commentStamp: 'gvc 5/18/2007 13:27'!
Dialog window displaying a message with a single OK button. Escape/return will close. Icon is a themed lock icon.!
!DenyDialogWindow methodsFor: 'visual properties' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
icon
	"Answer an icon for the receiver."
	
	^ Smalltalk ui icons lockIcon! !

!DenyDialogWindow class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
taskbarIcon
	"Answer the icon for the receiver in a task bar."

	^ Smalltalk ui icons smallLockIcon! !

!DependentsArray commentStamp: 'nice 11/11/2009 20:30'!
Act as an array of (weak) dependents of some object.

When dependents are reclaimed, they are replaced by an UndefinedObject in the DependentsArray.
This is why instances of this class will take care to iterate only on non nil elements.
These nil also cause loops written as (1 to: self size do: [:i | (self at: i) doSomething]) to be inefficient.
This is because #size and #at: both require scanning for nils.
For this reason, DependentsArray though sequenceable, is not a subclass of SequenceableCollection.!
!DependentsArray methodsFor: 'copying' stamp: 'nice 11/11/2009 16:56'!
copyWith: newElement 
	"Re-implemented to not copy any niled out dependents."
	| copy i |
	copy := self class new: self size + 1.
	i := 0.
	self do: [:item | copy basicAt: (i:=i+1) put: item].
	copy basicAt: (i:=i+1) put: newElement.
	^copy! !

!DependentsArray methodsFor: 'accessing' stamp: 'nice 11/11/2009 17:19'!
last
	self reverseDo: [:dep | ^dep].
	self error: 'this collection is empty'! !

!DependentsArray methodsFor: 'accessing' stamp: 'nice 11/11/2009 19:20'!
size
	"count each non nil elements in self.
	Note: count: will use do: which will already have filtered out nil elements"
	
	^self count: [:each | true]! !

!DependentsArray methodsFor: 'enumerating' stamp: 'MarcusDenker 8/16/2010 12:51'!
select: aBlock 
	"Refer to the comment in Collection|select:."
	| basicSize newSelf size selection |
	basicSize := self basicSize.
	newSelf := self species new: basicSize.
	size := 0.
      1 to: basicSize do: [ :i |
               (self basicAt: i) ifNotNil: [ :dep |
                       (aBlock value: dep) ifTrue: [
                               newSelf basicAt: (size := size+1) put: dep ] ] ].
	selection := self species new: size.
	selection basicReplaceFrom: 1 to: size with: newSelf startingAt: 1.
	^selection! !

!DependentsArray methodsFor: 'accessing' stamp: 'nice 11/11/2009 20:15'!
at: anIndex put: anObject
	| basicSize counter |
	anIndex > 0 ifTrue: [
		basicSize := self basicSize.
		anIndex <= basicSize ifTrue: [
			counter := 0.
			1 to: basicSize do: [:i |
				(self basicAt: i) == nil
					ifFalse: [(counter := counter + 1) = anIndex ifTrue: [^self basicAt: i put: anObject]]]]].
	self error: 'access with an index out of bounds'! !

!DependentsArray methodsFor: 'private' stamp: 'nice 11/11/2009 17:08'!
basicReplaceFrom: start to: stop with: replacement startingAt: repStart 
	"Primitive. This destructively replaces elements from start to stop in the receiver starting at index, repStart, in the collection, replacement. Answer the receiver. Range checks are performed in the primitive only. Optional. See Object documentation whatIsAPrimitive."
	<primitive: 105>
	start to: stop do: [:i |
		self basicAt: i put: (replacement basicAt: repStart - start + i)]! !

!DependentsArray methodsFor: 'accessing' stamp: 'nice 11/11/2009 17:19'!
first
	self do: [:dep | ^dep].
	self error: 'this collection is empty'! !

!DependentsArray methodsFor: 'enumerating' stamp: 'nice 11/11/2009 20:36'!
do: aBlock
	"Evaluate a Block on non nil elements of the receiver"
	| dep |
	1 to: self basicSize do:[:i|
		(dep := self basicAt: i) ifNotNil:[aBlock value: dep]].! !

!DependentsArray methodsFor: 'accessing' stamp: 'nice 11/11/2009 17:19'!
at: anIndex
	| basicSize counter dep |
	anIndex > 0 ifTrue: [
		basicSize := self basicSize.
		anIndex <= basicSize ifTrue: [
			counter := 0.
			1 to: basicSize do: [:i |
				(dep := self basicAt: i) == nil
					ifFalse: [(counter := counter + 1) = anIndex ifTrue: [^dep]]]]].
	self error: 'access with an index out of bounds'! !

!DependentsArray methodsFor: 'enumerating' stamp: 'nice 11/11/2009 20:33'!
collect: aBlock 
	"Refer to the comment in Collection|select:."
	| basicSize newSelf size dep selection |
	basicSize := self basicSize.
	newSelf := self species new: basicSize.
	size := 0.
	1 to: basicSize do: [:i |
		(dep := self basicAt: i) notNil ifTrue: [newSelf basicAt: (size := size+1) put: (aBlock value: dep)]].
	selection := self species new: size.
	selection basicReplaceFrom: 1 to: size with: newSelf startingAt: 1.
	^selection! !

!DependentsArray methodsFor: 'enumerating' stamp: 'nice 11/11/2009 17:18'!
reverseDo: aBlock
	"Refer to the comment in Collection|do:."
	| dep |
	self basicSize to: 1 by: -1 do: [:i |
		(dep := self basicAt: i) ifNotNil: [aBlock value: dep]]! !

!DependentsArray methodsFor: 'converting' stamp: 'nice 12/18/2009 11:05'!
writeStream
	^ WriteStream on: self! !

!DependentsArray class methodsFor: 'instance creation' stamp: 'nice 11/11/2009 17:30'!
with: firstObject with: secondObject with: thirdObject with: fourthObject with: fifthObject with: sixthObject
	^(self basicNew: 6)
		basicAt: 1 put: firstObject;
		basicAt: 2 put: secondObject;
		basicAt: 3 put: thirdObject;
		basicAt: 4 put: fourthObject;
		basicAt: 5 put: fifthObject;
		basicAt: 6 put: sixthObject;
		yourself! !

!DependentsArray class methodsFor: 'instance creation' stamp: 'nice 11/11/2009 17:29'!
with: firstObject with: secondObject with: thirdObject with: fourthObject 
	^(self basicNew: 4)
		basicAt: 1 put: firstObject;
		basicAt: 2 put: secondObject;
		basicAt: 3 put: thirdObject;
		basicAt: 4 put: fourthObject;
		yourself! !

!DependentsArray class methodsFor: 'instance creation' stamp: 'nice 11/11/2009 17:29'!
with: firstObject with: secondObject with: thirdObject 
	^(self basicNew: 3)
		basicAt: 1 put: firstObject;
		basicAt: 2 put: secondObject;
		basicAt: 3 put: thirdObject;
		yourself! !

!DependentsArray class methodsFor: 'instance creation' stamp: 'nice 11/11/2009 17:24'!
with: anObject
	^(self basicNew: 1) basicAt: 1 put: anObject; yourself! !

!DependentsArray class methodsFor: 'instance creation' stamp: 'nice 11/11/2009 17:29'!
withAll: aCollection
	| newInstance |
	newInstance := self basicNew: aCollection size.
	1 to: aCollection size do: [:i |
		newInstance basicAt: i put: (aCollection at: i)].
	^newInstance! !

!DependentsArray class methodsFor: 'instance creation' stamp: 'nice 11/11/2009 17:29'!
with: firstObject with: secondObject with: thirdObject with: fourthObject with: fifthObject
	^(self basicNew: 5)
		basicAt: 1 put: firstObject;
		basicAt: 2 put: secondObject;
		basicAt: 3 put: thirdObject;
		basicAt: 4 put: fourthObject;
		basicAt: 5 put: fifthObject;
		yourself! !

!DependentsArray class methodsFor: 'instance creation' stamp: 'nice 11/11/2009 17:29'!
with: firstObject with: secondObject 
	^(self basicNew: 2)
		basicAt: 1 put: firstObject;
		basicAt: 2 put: secondObject;
		yourself! !

!DependentsArrayTest methodsFor: 'test' stamp: 'GabrielOmarCotelli 5/25/2009 16:16'!
testSize

	self 
		assert: (DependentsArray with: nil) size = 0;
		assert: (DependentsArray with: nil with: 1 with: nil) size = 1;
		assert: (DependentsArray with: 1 with: 3) size = 2;
		assert: (DependentsArray with: nil with: nil with: nil) size = 0! !

!Deprecation commentStamp: 'dew 5/21/2003 17:46'!
This Warning is signalled by methods which are deprecated.

The use of Object>>#deprecatedExplanation: aString and Object>>#deprecated: aBlock explanation: aString is recommended.

Idiom: Imagine I want to deprecate the message #foo.

foo
	^ 'foo'

I can replace it with:

foo
	self deprecatedExplanation: 'The method #foo was not good. Use Bar>>newFoo instead.'
	^ 'foo'

Or, for certain cases such as when #foo implements a primitive, #foo can be renamed to #fooDeprecated.

fooDeprecated
	^ <primitive>

foo
	^ self deprecated: [self fooDeprecated] explanation: 'The method #foo was not good. Use Bar>>newFoo instead.'
!
!Deprecation methodsFor: 'accessing' stamp: 'eem 7/3/2009 19:07'!
explanationString
	"Answer the value of explanationString"

	^ explanationString! !

!Deprecation methodsFor: 'comparing' stamp: 'eem 7/3/2009 19:08'!
hash
	^(methodReference ifNil: [explanationString]) hash! !

!Deprecation methodsFor: 'settings' stamp: 'AlainPlantec 12/11/2009 10:08'!
showWarning
	^ self class showWarning! !

!Deprecation methodsFor: 'accessing' stamp: 'eem 7/3/2009 19:07'!
versionString
	"Answer the value of versionString"

	^ versionString! !

!Deprecation methodsFor: 'comparing' stamp: 'eem 7/3/2009 19:10'!
= anObject
	^self class == anObject class
	  and: [methodReference = anObject methodReference
	  and: [methodReference
			ifNil: [explanationString = anObject explanationString]
			ifNotNil: [true]]]! !

!Deprecation methodsFor: 'handling' stamp: 'AlainPlantec 12/11/2009 10:09'!
defaultAction
	Log 
		ifNotNil: [:log | log add: self].
	self showWarning 
		ifTrue: [Transcript nextPutAll: self messageText; cr; flush].
	self raiseWarning 
		ifTrue: [super defaultAction]! !

!Deprecation methodsFor: 'settings' stamp: 'AlainPlantec 12/11/2009 10:08'!
raiseWarning
	^ self class raiseWarning! !

!Deprecation methodsFor: 'initialize-release' stamp: 'eem 7/3/2009 18:57'!
method: aCompiledMethod explanation: anExplanationString on: dateString in: aVersionString
	methodReference := aCompiledMethod methodReference.
	explanationString := anExplanationString.
	deprecationDate := dateString.
	versionString := aVersionString ! !

!Deprecation methodsFor: 'accessing' stamp: 'VeronicaUquillas 8/31/2011 15:26'!
messageText
	"Return an exception's message text."

	^ 'The method ', methodReference fullName, ' has been deprecated.
', explanationString! !

!Deprecation methodsFor: 'accessing' stamp: 'eem 7/3/2009 19:07'!
methodReference
	"Answer the value of methodReference"

	^ methodReference! !

!Deprecation methodsFor: 'accessing' stamp: 'eem 7/3/2009 19:07'!
deprecationDate
	"Answer the value of deprecationDate"

	^ deprecationDate! !

!Deprecation methodsFor: '*SUnit-Core' stamp: 'DamienCassou 12/4/2013 09:42'!
sunitAnnounce: aTestCase toResult: aTestResult
	self resume! !

!Deprecation class methodsFor: 'class initialization' stamp: 'GuillermoPolito 5/21/2012 01:57'!
initialize
	Log  := nil! !

!Deprecation class methodsFor: 'settings' stamp: 'AlainPlantec 12/11/2009 10:07'!
showWarning
	^ ShowWarning ifNil: [ShowWarning := true]! !

!Deprecation class methodsFor: 'settings' stamp: 'AlainPlantec 12/11/2009 10:06'!
raiseWarning
	^ RaiseWarning ifNil: [RaiseWarning := true]! !

!Deprecation class methodsFor: 'settings' stamp: 'AlainPlantec 12/11/2009 10:06'!
raiseWarning: aBoolean
	RaiseWarning := aBoolean! !

!Deprecation class methodsFor: 'settings' stamp: 'AlainPlantec 12/11/2009 10:07'!
showWarning: aBoolean
	ShowWarning := aBoolean! !

!Deprecation class methodsFor: 'instance creation' stamp: 'eem 7/3/2009 19:15'!
method: aCompiledMethod explanation: anExplanationString on: dateString in: aVersionString
	^self new method: aCompiledMethod explanation: anExplanationString on: dateString in: aVersionString! !

!Deprecation class methodsFor: 'logging' stamp: 'eem 7/3/2009 19:13'!
deprecationsWhile: aBlock
	| oldLog result |
	oldLog := Log.
	Log := Set new.
	aBlock value.
	result := Log.
	oldLog ifNotNil: [oldLog addAll: result].
	Log := oldLog.
	^result! !

!DialogGroupAdder commentStamp: 'TorstenBergmann 2/4/2014 21:13'!
Adder for dialog groups!
!DialogGroupAdder methodsFor: 'display' stamp: 'BenjaminVanRyseghem 3/29/2011 11:14'!
uiClass

	^ DialogGroupAdderUI! !

!DialogGroupAdder methodsFor: 'private' stamp: 'BenjaminVanRyseghem 3/2/2012 17:39'!
add: aCollection into: aGroup

	(elementsToAdd allSatisfy: [:e | e isBehavior ])
		ifTrue: [ self groups addClasses: aCollection into: aGroup ]
		ifFalse: [ self groups add: aCollection into: aGroup ]! !

!DialogGroupAdder methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/28/2011 14:02'!
elementsToAdd: anObject

	elementsToAdd := anObject! !

!DialogGroupAdder methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/28/2011 14:01'!
elementsToAdd

	^ elementsToAdd! !

!DialogGroupAdderUI commentStamp: 'TorstenBergmann 2/4/2014 21:12'!
Dialog UI for the group adder!
!DialogGroupAdderUI methodsFor: 'display' stamp: 'BenjaminVanRyseghem 3/15/2011 15:46'!
elementBox

	^ GroupboxMorph new 
		addContentMorph: self buildTextMorph;
		label: 'Item to add:';
		hResizing: #spaceFill;
		vResizing: #shrinkWrap! !

!DialogGroupAdderUI methodsFor: 'display' stamp: 'BenjaminVanRyseghem 3/15/2011 15:45'!
newContentMorph

	^(self newColumn: {
			self elementBox.
			self treeBox}) hResizing: #spaceFill! !

!DialogGroupAdderUI methodsFor: 'build items' stamp: 'BenjaminVanRyseghem 3/28/2011 14:02'!
elementsToAdd

	^ self groupManager elementsToAdd! !

!DialogGroupAdderUI methodsFor: 'build items' stamp: 'BenjaminVanRyseghem 4/14/2012 12:13'!
buildTextMorph

	^ (PluggableTextMorph
			on: self 
			text: #text 
			accept: nil)
			disable;
			hResizing: #spaceFill;
			yourself! !

!DialogGroupAdderUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 4/14/2012 12:15'!
valid

	self selectedGroup
		ifNotNil: [:group | self groupManager add: self elementsToAdd into: group ]! !

!DialogGroupAdderUI methodsFor: 'build items' stamp: 'MarcusDenker 10/2/2014 10:17'!
text

	^ (self groupManager elementsToAdd collect: [:elt | elt printString ]) asArray sort joinUsing: Character cr! !

!DialogGroupAdderUI methodsFor: 'tree' stamp: 'ClementBera 9/30/2013 11:00'!
groups

	^ self groupManager groups groups select: [:group | group isFillable and: [ group isReadOnly not ] ]! !

!DialogGroupManager commentStamp: 'TorstenBergmann 2/4/2014 21:12'!
Dialog group manager for groups in Nautilus!
!DialogGroupManager methodsFor: 'display' stamp: 'BenjaminVanRyseghem 3/29/2011 11:14'!
uiClass

	^ DialogGroupManagerUI! !

!DialogGroupManager methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/15/2011 13:34'!
groups: anObject

	groups := anObject! !

!DialogGroupManager methodsFor: 'display' stamp: 'MarcusDenker 7/25/2014 20:44'!
open
	(self uiClass on: self)
		title: 'Group Manager' translated;
		openInWorld! !

!DialogGroupManager methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/15/2011 13:34'!
groups

	^ groups! !

!DialogGroupManagerUI commentStamp: 'TorstenBergmann 2/4/2014 21:12'!
Dialog UI for the group manager!
!DialogGroupManagerUI methodsFor: 'display' stamp: 'BenjaminVanRyseghem 3/15/2011 15:45'!
newContentMorph

	^(self newColumn: {self treeBox}) hResizing: #spaceFill! !

!DialogGroupManagerUI methodsFor: 'private' stamp: 'MarcusDenker 7/25/2014 20:46'!
removeAGroup

	self groupManager groups removeAGroup: self selectedGroup.
	tree updateList.
	treeModel selection: nil.
	treeModel changed: #selection.! !

!DialogGroupManagerUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 9/15/2011 15:48'!
removeAction
	
	self removeAGroup! !

!DialogGroupManagerUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 3/15/2011 14:33'!
addAction

	self addAGroup! !

!DialogGroupManagerUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/19/2011 16:35'!
renameGroup

	self groupManager groups renameAGroup: self selectedGroup.	
	tree updateList.! !

!DialogGroupManagerUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 3/15/2011 14:08'!
removeState

	^ self selectedGroup notNil! !

!DialogGroupManagerUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 3/15/2011 15:48'!
valid! !

!DialogGroupManagerUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/15/2011 16:53'!
addAGroup

	| group |
	group := self groupManager groups createAnEmptyStaticGroup.
	tree updateList.
	treeModel hardlySelectItem: group.! !

!DialogGroupManagerUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 3/15/2011 14:21'!
addLabel
	
	^ 'Create'! !

!DialogGroupManagerUI methodsFor: 'display' stamp: 'BenjaminVanRyseghem 3/15/2011 15:32'!
initialExtent

	^  300@400! !

!DialogGroupManagerUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 3/15/2011 14:19'!
selectedGroup
	
	^ self selectedNode 
		ifNil: [ nil ]
		ifNotNil: [:node |
			node isGroup
				ifTrue: [ node item ]
				ifFalse: [ node parentNode item ]]! !

!DialogGroupManagerUI methodsFor: 'display' stamp: 'BenjaminVanRyseghem 3/15/2011 15:34'!
buildRenameButton

	^ (PluggableButtonMorph
			on: self 
			getState: #renameState 
			action: #renameAction 
			label: #renameLabel)
			hResizing: #spaceFill;
			yourself! !

!DialogGroupManagerUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 3/15/2011 14:08'!
addState

	^ true! !

!DialogGroupManagerUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 3/15/2011 15:34'!
renameLabel

	^ 'Rename'! !

!DialogGroupManagerUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/15/2011 13:36'!
groupManager

	^ groupManager! !

!DialogGroupManagerUI methodsFor: 'display' stamp: 'BenjaminVanRyseghem 3/15/2011 15:25'!
isResizeable
	^true! !

!DialogGroupManagerUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 3/15/2011 15:34'!
renameState

	^ self selectedGroup notNil! !

!DialogGroupManagerUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 3/15/2011 14:14'!
updateSelectedNode

	self changed: #removeState! !

!DialogGroupManagerUI methodsFor: 'tree' stamp: 'BenjaminVanRyseghem 3/15/2011 14:19'!
treeModel
	
	^ treeModel ifNil: [treeModel := self treeModelClass new model: self]! !

!DialogGroupManagerUI methodsFor: 'display' stamp: 'BenjaminVanRyseghem 3/15/2011 14:11'!
buildAddButton

	^ (PluggableButtonMorph
			on: self 
			getState: #addState 
			action: #addAction 
			label: #addLabel)
			hResizing: #spaceFill;
			yourself! !

!DialogGroupManagerUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 3/15/2011 14:19'!
selectedNode

	^ self treeModel selectedNode! !

!DialogGroupManagerUI methodsFor: 'tree' stamp: 'BenjaminVanRyseghem 10/31/2011 03:34'!
setSelectedNodeItem: anItem

	| node |
	node :=  tree listManager nodeMorphsWithAllNodeItems: { anItem }.
	tree listManager selectedItems: node.
	^ node! !

!DialogGroupManagerUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 3/15/2011 13:16'!
treeModelClass

	^ GroupCreatorTreeModel! !

!DialogGroupManagerUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/17/2011 15:11'!
groupManager: aModel

	groupManager := aModel! !

!DialogGroupManagerUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 3/15/2011 14:08'!
removeLabel
	
	^ 'Remove'! !

!DialogGroupManagerUI methodsFor: 'tree' stamp: 'MarcusDenker 7/20/2014 11:09'!
buildGroupsTree

	tree := (MorphTreeMorph on: self treeModel)
		beSingle;
		autoDeselection: true;
		rowInset: 4;
		columnInset: 4;
		getMenuSelector: #menu:shifted:;
		vResizing: #spaceFill;
		hResizing: #spaceFill.
		
	^tree buildContents.! !

!DialogGroupManagerUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 3/15/2011 15:33'!
renameAction

	self renameGroup! !

!DialogGroupManagerUI methodsFor: 'display' stamp: 'BenjaminVanRyseghem 3/15/2011 15:35'!
treeBox

	^ GroupboxMorph new 
		addContentMorph: self buildGroupsTree;
		addContentMorph: (self newRow: {self buildAddButton. self buildRenameButton. self buildRemoveButton});
		label: 'Choose a group:';
		hResizing: #spaceFill;
		vResizing: #spaceFill! !

!DialogGroupManagerUI methodsFor: 'display' stamp: 'BenjaminVanRyseghem 3/15/2011 14:11'!
buildRemoveButton

	^ (PluggableButtonMorph
			on: self 
			getState: #removeState 
			action: #removeAction 
			label: #removeLabel)
			hResizing: #spaceFill;
			yourself
! !

!DialogGroupManagerUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 3/17/2011 15:11'!
applyChanges

	self valid! !

!DialogGroupManagerUI methodsFor: 'tree' stamp: 'BenjaminVanRyseghem 3/22/2011 17:11'!
groups

	^ self groupManager groups groups! !

!DialogGroupManagerUI class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 3/29/2011 15:33'!
on: aModel

	^ self basicNew 
		groupManager: aModel;
		initialize.! !

!DialogItemsChooser commentStamp: 'TorstenBergmann 2/4/2014 20:44'!
Dialog for choosing from a list of items!
!DialogItemsChooser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2010 02:27'!
unselectedItems

	^ unselectedItems! !

!DialogItemsChooser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 17:04'!
selectedLabel
	^selectedLabel! !

!DialogItemsChooser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2010 02:14'!
selectedItemsSetterSelector: aSelector
	selectedItemsSetterSelector := aSelector! !

!DialogItemsChooser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2010 02:27'!
unselectedItems: anObject

	unselectedItems := anObject! !

!DialogItemsChooser methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 9/16/2010 00:26'!
initialize
	super initialize.
	selection := OrderedCollection new.! !

!DialogItemsChooser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2010 02:12'!
selection
	^selection! !

!DialogItemsChooser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 17:04'!
selectedLabel: anObject

	selectedLabel := anObject! !

!DialogItemsChooser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/16/2010 22:04'!
title
		^title! !

!DialogItemsChooser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/16/2010 22:04'!
title: aFinderUI
	title := aFinderUI! !

!DialogItemsChooser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2010 02:27'!
choicesList: anObject

	choicesList := anObject! !

!DialogItemsChooser methodsFor: 'accessing' stamp: 'ClementBera 7/26/2013 16:37'!
choicesList
	^ choicesList ifNil: [ choicesList := OrderedCollection new ]! !

!DialogItemsChooser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 17:04'!
unselectedLabel
	^unselectedLabel! !

!DialogItemsChooser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2010 02:27'!
methodNameUI: anObject

	methodNameUI := anObject! !

!DialogItemsChooser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 17:04'!
unselectedLabel: anObject

	unselectedLabel := anObject! !

!DialogItemsChooser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/16/2010 21:03'!
resultList: aList
	resultList := aList! !

!DialogItemsChooser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2010 02:27'!
selectedItems

	^ selectedItems! !

!DialogItemsChooser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2010 02:27'!
selectedItems: anObject

	selectedItems := anObject! !

!DialogItemsChooser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2010 02:02'!
model
	^model! !

!DialogItemsChooser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2010 02:31'!
sendSelection
	self model perform: self selectedItemsSetterSelector with: self selectedItems! !

!DialogItemsChooser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2010 02:13'!
selectedItemsSetterSelector
	^selectedItemsSetterSelector! !

!DialogItemsChooser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 16:59'!
uiClass
	^DialogItemsChooserUI! !

!DialogItemsChooser methodsFor: 'display' stamp: 'BenjaminVanRyseghem 11/1/2011 07:35'!
open

	(self uiClass on: self)
			title: self title;
			openInWorld! !

!DialogItemsChooser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/16/2010 21:02'!
resultList
	^ resultList! !

!DialogItemsChooser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2010 02:27'!
methodNameUI

	^ methodNameUI! !

!DialogItemsChooser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2010 02:02'!
model: aModel
	model := aModel! !

!DialogItemsChooser class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 9/18/2010 17:15'!
on: aModel unselectedItems: unselectedItems selectedItems: selectedItems selectedItemsSetterSelector: anotherSelector title: aString unselectedItemsLabel: unselectedLabel selectedItemsLabel: selectedLabel
	| instance |
	instance := self new 
					model: aModel;
					unselectedItems: unselectedItems;
					selectedItems: selectedItems;
					selectedItemsSetterSelector: anotherSelector;
					title: aString;
					unselectedLabel: unselectedLabel;
					selectedLabel: selectedLabel.
	^instance.! !

!DialogItemsChooserUI commentStamp: 'BenjaminVanRyseghem 9/17/2010 00:20'!
unselectedItems is the original list to search in

selectItems is the list of the selected items!
!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 17:16'!
dialogItemsChooser: aDialogItemsChooser
	dialogItemsChooser := aDialogItemsChooser! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 15:35'!
unselectedItemsTextArea: anObject

	unselectedItemsTextArea := anObject! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 15:51'!
alreadySearchedUnselectedItemsList
	^AlreadySearchedUnselectedItemsList ifNil: [AlreadySearchedUnselectedItemsList := OrderedCollection new]! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2010 00:43'!
unselectedItems
	^unselectedItems! !

!DialogItemsChooserUI methodsFor: 'build items' stamp: 'GaryChambers 2/11/2011 14:04'!
buildAddAllButton
	"Answer a new button for removing all items
	form the unslected list and adding to the selected list."
	
	^(self
		newButtonFor: self
		getState: #addAllButtonState
		action: #addAllButtonAction 
		arguments: nil
		getEnabled: #hasUnselectedItems
		getLabel: #addAllButtonLabel
		help: nil)
		hResizing: #spaceFill! !

!DialogItemsChooserUI methodsFor: 'private' stamp: 'EstebanLorenzano 1/31/2013 19:24'!
msgPaneMenu: aMenu shifted: shifted
	| donorMenu |
	
	donorMenu := shifted
		ifTrue: [SmalltalkEditor shiftedYellowButtonMenu]
		ifFalse: [SmalltalkEditor yellowButtonMenu].
	^ aMenu addAllFrom: donorMenu! !

!DialogItemsChooserUI methodsFor: 'build items' stamp: 'CamilloBruni 9/12/2011 14:49'!
buildUnselectedItemsList

	^(PluggableListMorph
		on: self 
		list: #unselectedItemsProbablyRestricted 
		primarySelection: #unselectedSelectionIndex
		changePrimarySelection: #unselectedSelectionIndex:
		listSelection: #unselectedSelectionAt:
		changeListSelection: #unselectedSelectionAt:put:
		menu: nil)
			hResizing: #spaceFill;
			vResizing: #spaceFill.! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 16:43'!
addToAlreadySearchedUnselectedItemsList: aString
	self alreadySearchedUnselectedItemsList size = self alreadySearchedUnselectedItemsListMaxSize
		ifTrue: [self alreadySearchedUnselectedItemsList removeLast ].
	self alreadySearchedUnselectedItemsList addFirst: aString! !

!DialogItemsChooserUI methodsFor: 'selectedList' stamp: 'BenjaminVanRyseghem 12/2/2010 17:34'!
selectedSelectionIndex
	selectedSelectionIndex ifNil: [selectedSelectionIndex := 0].
	^selectedSelectionIndex! !

!DialogItemsChooserUI methodsFor: 'unselectedList' stamp: 'BenjaminVanRyseghem 12/2/2010 17:52'!
unselectedSelectionAt: index Put: anObject
	unselectedSelectionList at: index put: anObject! !

!DialogItemsChooserUI methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 12/2/2010 18:14'!
initialize

	unselectedItemsSearchingString := String new.
	selectedItemsSearchingString := String new.
	selectedSelectionList := Dictionary new.
	unselectedSelectionList := Dictionary new.
	
	super initialize.
	
	self vResizing: #shrinkWrap.
	self hResizing: #shrinkWrap.! !

!DialogItemsChooserUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 12/2/2010 18:20'!
selectedSelectionItems

	| result |
	result := OrderedCollection new.
	self selectedItemsProbablyRestricted doWithIndex: [:item :index |
		(self selectedSelectionAt: index)
			ifTrue: [result add: item]].
	^result! !

!DialogItemsChooserUI methodsFor: 'buttons behavior' stamp: 'GaryChambers 2/11/2011 14:08'!
addAllItems

	| selection |
	selection := self unselectedItemsProbablyRestricted.
	selection ifEmpty: [^self].
	self unselectedItems removeAll: selection.
	self selectedItems addAll: selection.
	unselectedSelectionList removeAll.
	self unselectedSelectionIndex: 0.
	self
		changed: #selectedItemsProbablyRestricted;
		changed: #hasSelectedItems;
		changed: #unselectedItemsProbablyRestricted;
		changed: #hasUnselectedItems;
		changed: #hasUnselectedSelections! !

!DialogItemsChooserUI methodsFor: 'buttons creations' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
addButtonAction
	self addSelectedItems.! !

!DialogItemsChooserUI methodsFor: 'buttons creations' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
okButtonLabel
	^'Ok'! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 16:46'!
selectedItemsTextArea: anObject

	selectedItemsTextArea := anObject! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 17:20'!
unselectedLabel
	^self dialogItemsChooser isNil
		ifTrue: ['Unselected Items' translated]
		ifFalse: [self dialogItemsChooser unselectedLabel]! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/16/2010 23:49'!
selectedItemsModel: anObject

	selectedItemsModel := anObject! !

!DialogItemsChooserUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/1/2010 15:16'!
unselectedItemsProbablyRestricted

	| matcher string |
	string := self unselectedItemsSearchingString.
	matcher := string
					ifEmpty: ['*']
					ifNotEmpty: [
						(string last = $*) 
							ifTrue: [string]
							ifFalse:[string, '*']].
	^self unselectedItems select: [:each | matcher match: each].! !

!DialogItemsChooserUI methodsFor: 'buttons creations' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
removeAllButtonState
	^false! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 16:46'!
selectedItemsTextArea

	^ selectedItemsTextArea! !

!DialogItemsChooserUI methodsFor: 'buttons creations' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
removeButtonAction
	self removeSelectedItems.! !

!DialogItemsChooserUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/18/2010 16:49'!
roots: aTree
	aTree == unselectedItemsModel
		ifTrue: [ ^ self unselectedItemsProbablyRestricted].
	aTree == selectedItemsModel
		ifTrue:[ ^ self selectedItemsProbablyRestricted].! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 14:16'!
unselectedItemsModel: anObject

	unselectedItemsModel := anObject! !

!DialogItemsChooserUI methodsFor: 'buttons creations' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
searchButtonLabel
	^'Search'! !

!DialogItemsChooserUI methodsFor: 'display' stamp: 'BenjaminVanRyseghem 11/1/2011 07:42'!
openInWorld

	super openInWorld.
	self width: 500.
	self height: 400.
	self centering
! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 14:10'!
selectedItems
	^ selectedItems! !

!DialogItemsChooserUI methodsFor: 'buttons creations' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
addButtonState
	^false! !

!DialogItemsChooserUI methodsFor: 'selectedList' stamp: 'BenjaminVanRyseghem 12/2/2010 17:34'!
selectedSelectionIndex: anObject

	selectedSelectionIndex := anObject.
	self changed: #selectedSelectionIndex! !

!DialogItemsChooserUI methodsFor: 'build items' stamp: 'GaryChambers 2/11/2011 14:04'!
buildAddButton
	"Answer a new button for removing selected items
	from the unselected list and adding to the selected list."
	
	^(self
		newButtonFor: self
		getState: #addButtonState
		action: #addButtonAction 
		arguments: nil
		getEnabled: #hasUnselectedSelections
		getLabel: #addButtonLabel
		help: nil)
		hResizing: #spaceFill! !

!DialogItemsChooserUI methodsFor: 'unselectedList' stamp: 'BenjaminVanRyseghem 12/2/2010 17:52'!
unselectedSelectionIndex: anObject

	unselectedSelectionIndex := anObject.
	self changed: #unselectedSelectionIndex! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2010 00:53'!
selectedItems: aList
	selectedItems := aList.! !

!DialogItemsChooserUI methodsFor: 'buttons behavior' stamp: 'GaryChambers 2/11/2011 14:09'!
removeAllItems

	| selection |
	selection := self selectedItemsProbablyRestricted.
	selection ifEmpty: [^self].
	self selectedItems removeAll: selection.
	self unselectedItems addAll: selection.
	selectedSelectionList removeAll.
	self selectedSelectionIndex: 0.
	self
		changed: #selectedItemsProbablyRestricted;
		changed: #hasSelectedItems;
		changed: #hasSelectedSelections;
		changed: #unselectedItemsProbablyRestricted;
		changed: #hasUnselectedItems! !

!DialogItemsChooserUI methodsFor: 'buttons creations' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
addAllButtonState
	^false! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 16:43'!
addToAlreadySearchedSelectedItemsList: aString
	self alreadySearchedSelectedItemsList size = self alreadySearchedSelectedItemsListMaxSize
		ifTrue: [self alreadySearchedSelectedItemsList removeLast ].
	self alreadySearchedSelectedItemsList addFirst: aString! !

!DialogItemsChooserUI methodsFor: 'selectedList' stamp: 'BenjaminVanRyseghem 12/2/2010 17:50'!
selectedSelectionAt: index

	^selectedSelectionList at: index ifAbsent: [false]! !

!DialogItemsChooserUI methodsFor: 'unselectedList' stamp: 'GaryChambers 2/11/2011 13:58'!
hasUnselectedSelections
	"Answer whether the unselected list has selected items."

	^unselectedSelectionList anySatisfy: [:selected | selected]! !

!DialogItemsChooserUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 12/2/2010 18:20'!
unselectedSelectionItems

	| result |
	result := OrderedCollection new.
	self unselectedItemsProbablyRestricted doWithIndex: [:item :index |
		(self unselectedSelectionAt: index)
			ifTrue: [result add: item]].
	^result! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 16:42'!
alreadySearchedUnselectedItemsListMaxSize: anInteger

	[self alreadySearchedUnselectedItemsList size > anInteger]
		whileTrue: [self alreadySearchedUnselectedItemsList removeLast]! !

!DialogItemsChooserUI methodsFor: 'build items' stamp: 'GaryChambers 2/11/2011 14:04'!
buildRemoveButton
	"Answer a new button for removing selected items
	from the selected list and adding to the unselected list."
	
	^(self
		newButtonFor: self
		getState: #removeButtonState
		action: #removeButtonAction 
		arguments: nil
		getEnabled: #hasSelectedSelections
		getLabel: #removeButtonLabel
		help: nil)
		hResizing: #spaceFill! !

!DialogItemsChooserUI methodsFor: 'buttons behavior' stamp: 'GaryChambers 2/11/2011 14:09'!
addSelectedItems

	| selection |
	selection := self unselectedSelectionItems.
	selection ifEmpty: [^self].
	self unselectedItems removeAll: selection.
	self selectedItems addAll: selection.
	unselectedSelectionList removeAll.
	self unselectedSelectionIndex: 0.
	self
		changed: #selectedItemsProbablyRestricted;
		changed: #hasSelectedItems;
		changed: #unselectedItemsProbablyRestricted;
		changed: #hasUnselectedItems;
		changed: #hasUnselectedSelections! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 15:36'!
unselectedItemsTextArea
	^unselectedItemsTextArea! !

!DialogItemsChooserUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/16/2010 20:51'!
applyChanges
	self valid! !

!DialogItemsChooserUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/1/2010 15:25'!
selectedItemsProbablyRestricted

	| matcher string |
	string := self selectedItemsSearchingString.
	matcher := string
					ifEmpty: ['*']
					ifNotEmpty: [
						(string last = $*) 
							ifTrue: [string]
							ifFalse:[string, '*']].
	^self selectedItems select: [:each | matcher match: each].! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/1/2010 15:52'!
unselectedSelection
	unselectedSelection ifNil: [unselectedSelection := 0].
	^unselectedSelection! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'GaryChambers 2/11/2011 14:12'!
selectedItemsSearchingString: anObject

	selectedItemsSearchingString := anObject.
	selectedSelectionList removeAll.
	self selectedSelectionIndex: 0.
	self
		changed: #selectedItemsProbablyRestricted;
		changed: #selectedSelectionAt:;
		changed: #selectedSelectionIndex;
		changed: #hasSelectedSelections! !

!DialogItemsChooserUI methodsFor: 'selectedList' stamp: 'GaryChambers 2/11/2011 13:58'!
hasSelectedSelections
	"Answer whether the selected list has selected items."

	^selectedSelectionList anySatisfy: [:selected | selected]! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 16:21'!
alreadySearchedSelectedItemsList
	^AlreadySearchedSelectedItemsList ifNil: [AlreadySearchedSelectedItemsList := OrderedCollection new]! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 16:44'!
selectedItemsSearchingString

	^ selectedItemsSearchingString! !

!DialogItemsChooserUI methodsFor: 'buttons creations' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
addAllButtonAction
	self addAllItems.! !

!DialogItemsChooserUI methodsFor: 'display' stamp: 'GaryChambers 7/5/2011 09:29'!
centering
	self left: ((World width / 2) - (self width /2)) rounded.
	self top: ((World height / 2) - (self height /2)) rounded! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 14:16'!
unselectedItemsModel

	^ unselectedItemsModel! !

!DialogItemsChooserUI methodsFor: 'buttons creations' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
removeAllButtonAction
	self removeAllItems.! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 17:22'!
selectedLabel
	^self dialogItemsChooser isNil
		ifTrue: ['Selected Items' translated]
		ifFalse: [self dialogItemsChooser selectedLabel]! !

!DialogItemsChooserUI methodsFor: 'buttons creations' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
cancelButtonState
	^false! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 16:41'!
alreadySearchedSelectedItemsListMaxSize: anInteger

	[self alreadySearchedSelectedItemsList size > anInteger]
		whileTrue: [self alreadySearchedSelectedItemsList removeLast]! !

!DialogItemsChooserUI methodsFor: 'build items' stamp: 'GaryChambers 2/11/2011 14:05'!
buildRemoveAllButton
	"Answer a new button for removing all items from the
	selected list and adding to the unselected list."
	
	^(self
		newButtonFor: self
		getState: #removeAllButtonState
		action: #removeAllButtonAction
		arguments: nil
		getEnabled: #hasSelectedItems
		getLabel: #removeAllButtonLabel
		help: nil)
		hResizing: #spaceFill! !

!DialogItemsChooserUI methodsFor: 'unselectedList' stamp: 'BenjaminVanRyseghem 12/2/2010 17:52'!
unselectedSelectionAt: index

	^unselectedSelectionList at: index ifAbsent: [false]! !

!DialogItemsChooserUI methodsFor: 'buttons behavior' stamp: 'GaryChambers 2/11/2011 14:09'!
removeSelectedItems

	| selection |
	selection := self selectedSelectionItems.
	selection ifEmpty: [^self].
	self selectedItems removeAll: selection.
	self unselectedItems addAll: selection.
	selectedSelectionList removeAll.
	self selectedSelectionIndex: 0.
	self
		changed: #selectedItemsProbablyRestricted;
		changed: #hasSelectedItems;
		changed: #hasSelectedSelections;
		changed: #unselectedItemsProbablyRestricted;
		changed: #hasUnselectedItems! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 16:42'!
alreadySearchedUnselectedItemsListMaxSize
	^self class alreadySearchedUnselectedItemsListMaxSize! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2010 00:52'!
unselectedItems: anOrderedCollection 
	
	unselectedItems := anOrderedCollection.! !

!DialogItemsChooserUI methodsFor: 'display' stamp: 'GaryChambers 2/11/2011 13:52'!
newContentMorph
	| trees unselectedItemsCol selectedItemsCol buttons |
	buttons := (self newGroupboxFor: (
		(self newColumn: {
			self buildAddAllButton.
			self buildAddButton.
			self buildRemoveButton.
			self buildRemoveAllButton})
			vResizing: #shrinkWrap))
		vResizing: #shrinkWrap.
	
	unselectedItemsCol := self newGroupbox: self unselectedLabel for: (self newColumn: {
							self buildUnselectedItemsSearchingTextArea: self.
							self buildUnselectedItemsList.}).
	selectedItemsCol := self newGroupbox: self selectedLabel for: (self newColumn: {
							self buildSelectedItemsSearchingTextArea: self.
							self buildSelectedItemsList.}).
	trees := self newRow: {
					unselectedItemsCol.
					"self newGroupboxFor: self buildUnselectedItemsTree."
					buttons hResizing: #shrinkWrap.
					selectedItemsCol}.
	^trees vResizing: #spaceFill.
! !

!DialogItemsChooserUI methodsFor: 'buttons creations' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
removeAllButtonLabel
	^'<<'! !

!DialogItemsChooserUI methodsFor: 'buttons creations' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
okButtonState
	^false! !

!DialogItemsChooserUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/18/2010 17:17'!
valid
	self dialogItemsChooser sendSelection! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/16/2010 23:49'!
selectedItemsModel

	^ selectedItemsModel! !

!DialogItemsChooserUI methodsFor: 'buttons creations' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
searchButtonState
	^false! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/1/2010 15:44'!
unselectedSelection: anObject

	unselectedSelection := anObject! !

!DialogItemsChooserUI methodsFor: 'build items' stamp: 'BenjaminVanRyseghem 12/3/2010 10:06'!
buildSelectedItemsSearchingTextArea: aWindow

	^aWindow
		newAutoAcceptTextEntryFor: self
		get: #selectedItemsSearchingString
		set: #selectedItemsSearchingString:
		class: String
		getEnabled: nil
		help: 'Enter the name of a package' translated! !

!DialogItemsChooserUI methodsFor: 'buttons creations' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
addButtonLabel
	^'>'! !

!DialogItemsChooserUI methodsFor: 'buttons creations' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
okButtonAction
	self valid.! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 14:31'!
unselectedItemsSearchingString

	^ unselectedItemsSearchingString! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'GaryChambers 2/11/2011 14:11'!
unselectedItemsSearchingString: anObject

	unselectedItemsSearchingString := anObject.
	unselectedSelectionList removeAll.
	self unselectedSelectionIndex: 0.
	self
		changed: #unselectedItemsProbablyRestricted;
		changed: #unselectedSelectionAt:;
		changed: #unselectedSelectionIndex;
		changed: #hasUnselectedSelections! !

!DialogItemsChooserUI methodsFor: 'build items' stamp: 'BenjaminVanRyseghem 12/3/2010 10:05'!
buildUnselectedItemsSearchingTextArea: aWindow

	^aWindow
		newAutoAcceptTextEntryFor: self
		get: #unselectedItemsSearchingString
		set: #unselectedItemsSearchingString:
		class: String
		getEnabled: nil
		help: 'Enter the name of a package' translated! !

!DialogItemsChooserUI methodsFor: 'display' stamp: 'bvr 9/19/2010 19:32'!
isResizeable
	^true! !

!DialogItemsChooserUI methodsFor: 'buttons creations' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
addAllButtonLabel
	^'>>'! !

!DialogItemsChooserUI methodsFor: 'buttons creations' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
removeButtonLabel
	^'<'! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 17:16'!
dialogItemsChooser
	^ dialogItemsChooser! !

!DialogItemsChooserUI methodsFor: 'unselectedList' stamp: 'BenjaminVanRyseghem 12/2/2010 17:52'!
unselectedSelectionIndex
	unselectedSelectionIndex ifNil: [unselectedSelectionIndex := 0].
	^unselectedSelectionIndex! !

!DialogItemsChooserUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 16:24'!
alreadySearchedSelectedItemsListMaxSize
	^self class alreadySearchedSelectedItemsListMaxSize! !

!DialogItemsChooserUI methodsFor: 'buttons creations' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
cancelButtonLabel
	^'Cancel'! !

!DialogItemsChooserUI methodsFor: 'buttons creations' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
removeButtonState
	^false! !

!DialogItemsChooserUI methodsFor: 'build items' stamp: 'MarcusDenker 6/14/2014 12:21'!
buildSelectedItemsList

	^(PluggableListMorph
		on: self 
		list: #selectedItemsProbablyRestricted 
		primarySelection: #selectedSelectionIndex
		changePrimarySelection: #selectedSelectionIndex:
		listSelection: #selectedSelectionAt:
		changeListSelection: #selectedSelectionAt:put:
		menu: nil)
			hResizing: #spaceFill;
			vResizing: #spaceFill.! !

!DialogItemsChooserUI methodsFor: 'unselectedList' stamp: 'GaryChambers 2/11/2011 13:47'!
hasUnselectedItems
	"Answer whether the unselected list has items."

	^self unselectedItems notEmpty! !

!DialogItemsChooserUI methodsFor: 'selectedList' stamp: 'GaryChambers 2/11/2011 13:54'!
hasSelectedItems
	"Answer whether the selected list has items."

	^self selectedItems notEmpty! !

!DialogItemsChooserUI methodsFor: 'selectedList' stamp: 'GaryChambers 2/11/2011 14:00'!
selectedSelectionAt: index put: aBoolean
	"Mark the item as selected or not."
	
	selectedSelectionList at: index put: aBoolean.
	self changed: #hasSelectedSelections! !

!DialogItemsChooserUI methodsFor: 'unselectedList' stamp: 'GaryChambers 2/11/2011 14:00'!
unselectedSelectionAt: index put: aBoolean
	"Mark the item as selected or not."
	
	unselectedSelectionList at: index put: aBoolean.
	self changed: #hasUnselectedSelections! !

!DialogItemsChooserUI class methodsFor: 'accessing' stamp: 'bvr 9/19/2010 19:16'!
alreadySearchedUnselectedItemsListMaxSize: anObject
	anObject ifNil: [^self].
	alreadySearchedUnselectedItemsListMaxSize := anObject.
	self allInstancesDo: [:each | each alreadySearchedUnselectedItemsListMaxSize: anObject]! !

!DialogItemsChooserUI class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 16:25'!
alreadySearchedSelectedItemsListMaxSize

	^ alreadySearchedSelectedItemsListMaxSize! !

!DialogItemsChooserUI class methodsFor: 'initialize-release' stamp: 'bvr 9/19/2010 19:23'!
initialize
	super initialize.
	alreadySearchedUnselectedItemsListMaxSize := 15.
	alreadySearchedSelectedItemsListMaxSize := 15! !

!DialogItemsChooserUI class methodsFor: 'settings' stamp: 'StephaneDucasse 11/11/2014 18:40'!
dialogItemsChooserSettingsOn: aBuilder
	<systemsettings>
		(aBuilder group: #dialogItemsChooser)
		target: self;
		label: 'Items Chooser Dialog Window';
		parent: #morphic;
		description: 'Settings related to the Items Chooser Dialog Window' ;
			with: [
				(aBuilder setting: #alreadySearchedUnselectedItemsListMaxSize)
					label: 'Size of the Unselected Items History'.
				(aBuilder setting: #alreadySearchedSelectedItemsListMaxSize)
					label: 'Size of the Selected Items History'.]! !

!DialogItemsChooserUI class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 9/18/2010 17:21'!
on: aDialogItemsChooser
	^self basicNew 
		unselectedItems: aDialogItemsChooser unselectedItems;
		selectedItems: aDialogItemsChooser selectedItems;
		dialogItemsChooser: aDialogItemsChooser;
		initialize.! !

!DialogItemsChooserUI class methodsFor: 'accessing' stamp: 'bvr 9/19/2010 19:16'!
alreadySearchedSelectedItemsListMaxSize: anObject
	anObject ifNil: [^self].
	alreadySearchedSelectedItemsListMaxSize := anObject.
	self allInstancesDo: [:each | each alreadySearchedSelectedItemsListMaxSize: anObject]! !

!DialogItemsChooserUI class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 16:25'!
alreadySearchedUnselectedItemsListMaxSize

	^ alreadySearchedUnselectedItemsListMaxSize! !

!DialogWindow commentStamp: 'gvc 5/18/2007 13:26'!
Dialog style window with no window controls (expand, collapse etc). Usually opened modally (the morph that is used to modally open determines the modal scope, use of World implies "system modal").
Designed to be subclassed with content.
Supports Escape key for cancel and Enter key for default button.!
!DialogWindow methodsFor: 'actions' stamp: 'gvc 8/14/2006 14:12'!
ok
	"Apply the changes and close."

	self
		cancelled: false;
		applyChanges;
		delete! !

!DialogWindow methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 12/10/2013 22:21'!
defaultIsResizeable

	^ false! !

!DialogWindow methodsFor: 'theme' stamp: 'gvc 6/2/2009 10:26'!
preferredCornerStyle
	"Answer the preferred corner style."

	^self theme dialogWindowPreferredCornerStyleFor: self! !

!DialogWindow methodsFor: 'actions' stamp: 'gvc 8/25/2006 10:10'!
close
	"Close the window."

	self delete! !

!DialogWindow methodsFor: 'actions' stamp: 'gvc 8/25/2006 10:10'!
cancel
	"Cancel and close."

	self close! !

!DialogWindow methodsFor: 'event handling' stamp: 'gvc 7/30/2009 12:32'!
keyStroke: evt
	"Check for return and escape keys."

	super keyStroke: evt.
	(self defaultButton notNil and: [evt keyCharacter = Character cr]) ifTrue: [self returnPressed. ^true].
	evt keyCharacter = Character escape ifTrue: [self escapePressed. ^true].
	^false! !

!DialogWindow methodsFor: 'actions' stamp: 'gvc 8/14/2006 11:58'!
newContentMorph
	"Answer a new content morph."

	^Morph new
		color: Color transparent;
		hResizing: #spaceFill;
		vResizing: #spaceFill! !

!DialogWindow methodsFor: 'testing' stamp: 'gvc 9/22/2009 11:16'!
canBeMaximized
	"Answer whether we are not we can be maximised."

	^self isResizeable
		ifTrue: [super canBeMaximized]
		ifFalse: [false]! !

!DialogWindow methodsFor: 'actions' stamp: 'gvc 1/10/2007 13:42'!
escapePressed
	"Default is to cancel."

	self cancel! !

!DialogWindow methodsFor: 'actions' stamp: 'gvc 8/25/2006 10:25'!
addInitialPanel
	"Add the panel."

	self addMainPanel! !

!DialogWindow methodsFor: 'initialization' stamp: 'gvc 4/3/2008 11:52'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		cancelled: true;
		addInitialPanel! !

!DialogWindow methodsFor: 'actions' stamp: 'gvc 2/2/2009 13:15'!
mainPanel
	"Anwer the main panel morph or nil if not yet present."

	^self paneMorphs isEmpty
		ifFalse: [self paneMorphs first]! !

!DialogWindow methodsFor: 'theme' stamp: 'gvc 5/24/2007 11:35'!
activeFillStyle
	"Return the active fillStyle for the receiver."
	
	^self theme dialogWindowActiveFillStyleFor: self! !

!DialogWindow methodsFor: 'controls' stamp: 'AlainPlantec 10/7/2011 11:22'!
title: aString
	"Set the window title."
	
	super title: aString.
	label fitContents.
	self minimumExtent: (((label width + 20 min: (Display width // 2)) max: self minimumExtent x)@ self minimumExtent y)! !

!DialogWindow methodsFor: 'actions' stamp: 'gvc 1/10/2007 13:23'!
defaultButton
	"Answer the default button."

	^self
		findDeepSubmorphThat: [:m |
			(m isKindOf: PluggableButtonMorph) and: [m isDefault]]
		ifAbsent: [] ! !

!DialogWindow methodsFor: 'actions' stamp: 'gvc 5/15/2007 17:40'!
newMainPanel
	"Answer a new main panel."

	^self newDialogPanel
		addMorphBack: self newContentMorph;
		addMorphBack: self newButtonRow;
		yourself! !

!DialogWindow methodsFor: 'actions' stamp: 'gvc 1/10/2007 13:50'!
newButtons
	"Answer new buttons as appropriate."

	^{self newOKButton isDefault: true. self newCancelButton}! !

!DialogWindow methodsFor: 'accessing' stamp: 'gvc 8/14/2006 14:12'!
cancelled: anObject
	"Set the value of cancelled"

	cancelled := anObject! !

!DialogWindow methodsFor: 'initialization' stamp: 'AlainPlantec 12/3/2010 09:00'!
initializeLabelArea
	"Initialize the label area (titlebar) for the window."
	
	super initializeLabelArea.
	self removeBoxes.
	self replaceBoxes! !

!DialogWindow methodsFor: 'actions' stamp: 'gvc 8/12/2009 18:14'!
buttons
	"Answer the buttons in the button row"

	^self paneMorphs last lastSubmorph submorphs! !

!DialogWindow methodsFor: 'open/close' stamp: 'MarcusDenker 12/11/2009 09:34'!
initialExtent
	"Answer the default extent for the receiver."

	|rl paneExt ext|
	rl := self getRawLabel.
	paneExt := self mainPanel
		ifNil: [0@0]
		ifNotNil: [:pane | pane minExtent].
	ext := paneExt + (2@ self labelHeight) + (2 * self class borderWidth)
		max: rl extent + 20.
	self isResizeable ifTrue: [
		self title: self title "adjust minimumExtent".
		self minimumExtent: (ext x max: self minimumExtent x)@(ext y max: self minimumExtent y)].
	^ext! !

!DialogWindow methodsFor: 'top window' stamp: 'MarcusDenker 12/11/2009 07:38'!
activate
	"Set the default focus for now, will want to
	remember it at some point."
	
	super activate.
	self world ifNil: [^self].
	self rememberedKeyboardFocus
		ifNil: [self defaultFocusMorph ifNotNil: [:m |
				m takeKeyboardFocus]]! !

!DialogWindow methodsFor: 'actions' stamp: 'gvc 12/3/2008 17:35'!
newButtonRow
	"Answer a new ok/cancel button row."

	|answer buttons e|
	buttons := self newButtons.
	e := 0@0.
	buttons do: [:b | e := e max: b minExtent].
	buttons do: [:b | b extent: e].
	answer := Morph new
		color: Color transparent;
		changeTableLayout;
		cellInset: 8;
		listDirection: #leftToRight;
		listCentering: #bottomRight;
		hResizing: #spaceFill;
		vResizing: #shrinkWrap.
	buttons do: [:b | answer addMorphBack: b].
	^answer! !

!DialogWindow methodsFor: 'event handling' stamp: 'gvc 7/30/2009 12:21'!
handlesKeyboard: evt
	"Return true if the receiver wishes to handle the given keyboard event"
	
	(super handlesKeyboard: evt) ifTrue: [^true].
	^evt keyCharacter = Character escape or: [
		(self defaultButton notNil and: [
			evt keyCharacter = Character cr])]
	! !

!DialogWindow methodsFor: 'actions' stamp: 'gvc 8/9/2007 16:52'!
addMainPanel
	"Add the main panel."

	self addMorph: self newMainPanel frame: (0@0 corner: 1@1)! !

!DialogWindow methodsFor: 'actions' stamp: 'gvc 10/26/2007 21:31'!
setLabelWidgetAllowance
	"Set the extra space required, in general, apart from the label.
	No extra needed for dialogs."
	
	^labelWidgetAllowance :=  0! !

!DialogWindow methodsFor: 'actions' stamp: 'gvc 1/10/2007 13:48'!
returnPressed
	"Default is to do the default button."

	(self defaultButton ifNil: [^self]) performAction! !

!DialogWindow methodsFor: 'actions' stamp: 'nice 1/5/2010 15:59'!
setButtonFont: aFont
	"Set the font for the buttons."

	| buttons e|
	buttons := self buttons.
	e := 0@0.
	buttons do: [:b | | hRes vRes |
		hRes := b hResizing.
		vRes := b vResizing.
		b
			hResizing: #shrinkWrap;
			vResizing: #shrinkWrap.
		b label: b label font: aFont.
		e := e max: b minExtent.
		b
			hResizing: hRes;
			vResizing: vRes].
	buttons do: [:b | b extent: e]! !

!DialogWindow methodsFor: 'initialization' stamp: 'gvc 6/1/2009 12:21'!
setFramesForLabelArea
	"Delegate to theme."
	
	self theme configureDialogWindowLabelAreaFrameFor: self! !

!DialogWindow methodsFor: 'accessing' stamp: 'gvc 8/14/2006 14:12'!
cancelled
	"Answer the value of cancelled"

	^ cancelled! !

!DialogWindow methodsFor: 'event handling' stamp: 'GuillermoPolito 5/23/2012 11:39'!
keyboardFocusChange: aBoolean
	"Set the focus to the default button."
	super keyboardFocusChange: aBoolean.
	aBoolean ifTrue: [
		self defaultFocusMorph ifNotNil: [:b |
			b takeKeyboardFocus]]! !

!DialogWindow methodsFor: 'actions' stamp: 'gvc 8/14/2006 12:40'!
defaultLabel
	"Answer the default label for the receiver."

	^'Dialog' translated! !

!DialogWindow methodsFor: 'theme' stamp: 'gvc 4/24/2007 16:19'!
animateClose
	"Animate closing."! !

!DialogWindow methodsFor: 'focus handling' stamp: 'MarcusDenker 12/11/2009 09:34'!
defaultFocusMorph
	"Answer the morph that should have the keyboard
	focus by default when the dialog is opened."
	
	^self defaultButton
		ifNil: [(self respondsTo: #nextMorphWantingFocus)
					ifTrue: [	self nextMorphWantingFocus]]
		ifNotNil: [:b | b enabled ifTrue: [b]]! !

!DialogWindow methodsFor: 'actions' stamp: 'gvc 8/27/2006 11:15'!
acceptTextMorphs
	"Accept any text morphs except for those that have no edits."

	self allMorphs do: [:p |
		((p respondsTo: #accept) and: [
			(p respondsTo: #hasUnacceptedEdits) and: [
				p hasUnacceptedEdits]]) ifTrue: [p accept]]! !

!DialogWindow methodsFor: 'event handling' stamp: 'gvc 9/22/2009 11:17'!
doubleClick: event
	"Handle a double click. Maximize/restore the window.
	Not for dialogs if not resizeable..."
	
	self isResizeable ifTrue: [super doubleClick: event]! !

!DialogWindow methodsFor: 'actions' stamp: 'gvc 8/27/2006 11:11'!
applyChanges
	"Apply the changes."

	self acceptTextMorphs! !

!DialogWindow methodsFor: 'theme' stamp: 'gvc 6/2/2009 10:36'!
wantsRoundedCorners
	"Answer whether rounded corners are wanted."
	
	^(self theme dialogWindowPreferredCornerStyleFor: self) == #rounded! !

!DialogWindow methodsFor: 'theme' stamp: 'gvc 5/24/2007 11:36'!
inactiveFillStyle
	"Return the active fillStyle for the receiver."
	
	^self theme dialogWindowInactiveFillStyleFor: self! !

!DialogWindowModel commentStamp: '<historical>'!
A DialogWindowModel is a model used to describe a DialogWindow!
!DialogWindowModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 9/28/2013 23:47'!
triggerOkAction

	self changed: #triggerOkAction with: #()! !

!DialogWindowModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/24/2013 15:03'!
toolbar

	^ toolbar value! !

!DialogWindowModel methodsFor: 'private' stamp: 'StephaneDucasse 2/27/2015 21:31'!
buildWithSpecLayout: aSpec
	"Build the widget using the spec name provided as argument"
	| widget |
	
	(self spec notNil and: [ self needRebuild not ])
		ifTrue: [ widget := self spec instance ]
		ifFalse: [ 
			contents := self model buildWithSpecLayout: aSpec.
			widget := self privateAdapterFromModel: self withSpec: self defaultSpecSelector.
			contents := nil ].

	self extent ifNotNil: [:ex | 
		(widget respondsTo: #extent:)
			ifTrue: [ widget extent: ex ]].
		
	^ widget! !

!DialogWindowModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/27/2013 15:05'!
triggerCancelAction

	self changed: #triggerCancelAction with: #()! !

!DialogWindowModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 9/28/2013 23:49'!
cancelAction: aBlock

	^ self changed: #cancelAction: with: { aBlock }! !

!DialogWindowModel methodsFor: 'initialization' stamp: 'DucasseStephane 9/10/2014 09:59'!
initialize

	super initialize.

	toolbar := OkCancelToolbar new asValueHolder.
	toolbar whenChangedDo: [ :t | self changed: #toolbar: with: { t } ]! !

!DialogWindowModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/26/2013 22:06'!
cancelled

	^ self toolbar cancelled! !

!DialogWindowModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/24/2013 15:03'!
toolbar: aBar

	toolbar value: aBar! !

!DialogWindowModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 9/28/2013 23:48'!
okAction: aBlock

	^ self changed: #okAction: with: { aBlock }! !

!DialogWindowModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 9/28/2013 23:46'!
okButtonEnabled: aBoolean

	self changed: #okButtonEnabled: with: { aBoolean }! !

!DialogWindowModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/28/2013 23:50'!
contents

	^ contents! !

!DialogWindowModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/1/2013 13:39'!
defaultSpec
	<spec>
	
	^ #(DialogWindowAdapter
		adapt: #(model))! !

!DialogWindowModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/13/2014 15:30'!
adapterName

	^ #DialogWindowAdapter! !

!Dictionary commentStamp: '<historical>'!
I represent a set of elements that can be viewed from one of two perspectives: a set of associations, or a container of values that are externally named where the name can be any object that responds to =. The external name is referred to as the key.  I inherit many operations from Set.!
!Dictionary methodsFor: '*Fuel' stamp: 'MartinDias 2/25/2013 14:33'!
fuelAfterMaterialization
	| class |
	"Since for Set and IdentitySet we are recreating the collection with #add: we do not need to rehash."
	class := self class.
	^ (((class == Dictionary) or: [ class == IdentityDictionary ]) ) 
		ifFalse: [ self rehash ] 
		ifTrue: [ self ]! !

!Dictionary methodsFor: 'adding' stamp: 'raok 12/17/2003 16:01'!
addAll: aKeyedCollection
	aKeyedCollection == self ifFalse: [
		aKeyedCollection keysAndValuesDo: [:key :value |
			self at: key put: value]].
	^aKeyedCollection! !

!Dictionary methodsFor: 'testing' stamp: 'sw 2/14/2000 14:34'!
includesIdentity: anObject
	"Answer whether anObject is one of the values of the receiver.  Contrast #includes: in which there is only an equality check, here there is an identity check"

	self do: [:each | anObject == each ifTrue: [^ true]].
	^ false! !

!Dictionary methodsFor: 'enumerating' stamp: 'ar 5/18/2003 20:33'!
bindingsDo: aBlock
	^self associationsDo: aBlock! !

!Dictionary methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/19/2011 20:31'!
keyAtIdentityValue: value 
	"Answer the key that is the external name for the argument, value. If 
	there is none, answer nil.
	Note: There can be multiple keys with the same value. Only one is returned."

	^self keyAtIdentityValue: value ifAbsent: [self errorValueNotFound: value]! !

!Dictionary methodsFor: 'private' stamp: ''!
valueAtNewKey: aKey put: anObject atIndex: index declareFrom: aDictionary 
	"Support for coordinating class variable and global declarations
	with variables that have been put in Undeclared so as to
	redirect all references to the undeclared variable."

	(aDictionary includesKey: aKey)
		ifTrue: 
			[self atNewIndex: index 
				put: ((aDictionary associationAt: aKey) value: anObject).
			aDictionary removeKey: aKey]
		ifFalse: 
			[self atNewIndex: index put: (Association key: aKey value: anObject)]! !

!Dictionary methodsFor: 'testing' stamp: 'sw 3/23/2000 01:12'!
keyForIdentity: anObject
	"If anObject is one of the values of the receive, return its key, else return nil.  Contrast #keyAtValue: in which there is only an equality check, here there is an identity check"

	self associationsDo: [:assoc | assoc value == anObject ifTrue: [^ assoc key]].
	^ nil! !

!Dictionary methodsFor: 'removing' stamp: ''!
removeKey: key ifAbsent: aBlock 
	"Remove key (and its associated value) from the receiver. If key is not in 
	the receiver, answer the result of evaluating aBlock. Otherwise, answer 
	the value externally named by key."

	| index assoc |
	index := self findElementOrNil: key.
	assoc := array at: index.
	assoc == nil ifTrue: [ ^ aBlock value ].
	array at: index put: nil.
	tally := tally - 1.
	self fixCollisionsFrom: index.
	^ assoc value! !

!Dictionary methodsFor: 'accessing' stamp: 'nice 5/1/2011 18:29'!
at: key ifPresent: aBlock
	"Lookup the given key in the receiver. If it is present, answer the value of evaluating the given block with the value associated with the key. Otherwise, answer nil."

	^(array at: (self findElementOrNil: key))
		ifNotNil: [:assoc | aBlock cull: assoc value]! !

!Dictionary methodsFor: 'enumerating' stamp: 'SqR 11/7/2013 12:12'!
valuesDo: aBlock 
	"Evaluate aBlock for each of the receiver's values.  Implemented with == checks
	merely for the sake of maximum efficiency"

	tally = 0 ifTrue: [ ^self ].
	1 to: array size do:
		[ :eachIndex | 
			| eachAssociation |
			eachAssociation := array at: eachIndex.
			nil == eachAssociation ifFalse: [ aBlock value: eachAssociation value ]
		]! !

!Dictionary methodsFor: 'enumerating' stamp: 'dtl 2/17/2003 09:40'!
associationsSelect: aBlock 
	"Evaluate aBlock with each of my associations as the argument. Collect
	into a new dictionary, only those associations for which aBlock evaluates
	to true."

	| newCollection |
	newCollection := self species new.
	self associationsDo: 
		[:each | 
		(aBlock value: each) ifTrue: [newCollection add: each]].
	^newCollection! !

!Dictionary methodsFor: 'accessing' stamp: 'ar 5/17/2003 14:07'!
bindingOf: varName
	^self associationAt: varName ifAbsent:[nil]! !

!Dictionary methodsFor: 'printing' stamp: 'apb 7/14/2004 12:48'!
printElementsOn: aStream 
	aStream nextPut: $(.
	self size > 100
		ifTrue: [aStream nextPutAll: 'size '.
			self size printOn: aStream]
		ifFalse: [self keysSortedSafely
				do: [:key | aStream print: key;
						 nextPutAll: '->';				
						 print: (self at: key);
						 space]].
	aStream nextPut: $)! !

!Dictionary methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 10/26/2013 12:24'!
includesKey: key 
	"Answer whether the receiver has a key equal to the argument, key."
	
	^ (array at: (self scanFor: key)) ~~ nil 
	"We could use #notNil here, but ProtoObject doesn't understand it."! !

!Dictionary methodsFor: 'removing' stamp: ''!
removeUnreferencedKeys   "Undeclared removeUnreferencedKeys"

	^ self unreferencedKeys do: [:key | self removeKey: key].! !

!Dictionary methodsFor: 'accessing' stamp: 'PeterHugossonMiller 9/3/2009 01:13'!
values
	"Answer a Collection containing the receiver's values."
	| out |
	out := (Array new: self size) writeStream.
	self valuesDo: [:value | out nextPut: value].
	^ out contents! !

!Dictionary methodsFor: 'accessing' stamp: 'sma 5/12/2000 15:01'!
at: key ifAbsentPut: aBlock 
	"Return the value at the given key. 
	If key is not included in the receiver store the result 
	of evaluating aBlock as new value."

	^ self at: key ifAbsent: [self at: key put: aBlock value]! !

!Dictionary methodsFor: 'enumerating' stamp: 'CamilloBruni 9/9/2011 16:50'!
difference: aCollection
	"Answer the set theoretic difference of two collections. This is a specialized version for Dictionaries keeping the keys of the objects. At a slightly higher price of an additional Set to track duplicates."

	| other result duplicates |
	
	other := aCollection asSet.
	duplicates := Set new.
	result := self class new: self size.
	
	self keysAndValuesDo: [ :key :value|
		((other includes: value) not and: [ (duplicates includes: value) not ])
			ifTrue: [ 
				duplicates add: value.
				result at: key put: value]].
	
	^ result! !

!Dictionary methodsFor: 'testing' stamp: 'ab 9/17/2004 00:39'!
includesAssociation: anAssociation
  ^ (self   
      associationAt: anAssociation key
      ifAbsent: [ ^ false ]) value = anAssociation value
! !

!Dictionary methodsFor: 'private' stamp: ''!
rehash
	"Smalltalk rehash."
	| newSelf |
	newSelf := self species new: self size.
	self associationsDo: [:each | newSelf noCheckAdd: each].
	array := newSelf array! !

!Dictionary methodsFor: 'accessing' stamp: 'MarcusDenker 7/11/2014 18:34'!
associationAt: key ifPresent: aBlock 
	"Answer the association with the given key.
	If key is not found, return the result of evaluating aBlock."

	^(array at: (self findElementOrNil: key))
		ifNotNil: [:assoc | aBlock cull: assoc]! !

!Dictionary methodsFor: '*NewValueHolder' stamp: 'BenjaminVanRyseghem 1/24/2014 16:07'!
asValueHolder

	^ DictionaryValueHolder value: self! !

!Dictionary methodsFor: 'removing' stamp: 'CamilloBruni 4/11/2011 13:30'!
removeKey: key 
	"Remove key from the receiver.
	If key is not in the receiver, notify an error."

	^ self removeKey: key ifAbsent: [self errorKeyNotFound: key]! !

!Dictionary methodsFor: '*Slot' stamp: 'MarcusDenker 7/29/2014 16:08'!
declareVariable: newGlobal from: aDictionary 
	"Add aGlobal to the receiver. If key already exists, do nothing. If aDictionary 
	includes key, then remove it from aDictionary and use its association as 
	the element of the receiver."

	| globalName |
	globalName :=  newGlobal key.
	self associationAt: globalName ifPresent:  [:existingGlobal |
		"need to take care to migrate existing variables to new global if class if different"
		(existingGlobal class == newGlobal class) 
			ifTrue: [^self].
		newGlobal value: existingGlobal value.
		self removeKey: globalName.
		self add: newGlobal.
		].
	(aDictionary includesKey: globalName)
		ifTrue:  [
			self add: ((aDictionary associationAt: globalName) primitiveChangeClassTo: ClassVariable new).
			aDictionary removeKey: globalName]
		ifFalse: [
			self add: newGlobal]! !

!Dictionary methodsFor: 'accessing' stamp: 'sma 5/12/2000 15:00'!
at: key put: anObject 
	"Set the value at key to be anObject.  If key is not found, create a
	new entry for key and set is value to anObject. Answer anObject."

	| index assoc |
	index := self findElementOrNil: key.
	assoc := array at: index.
	assoc
		ifNil: [self atNewIndex: index put: (Association key: key value: anObject)]
		ifNotNil: [assoc value: anObject].
	^ anObject! !

!Dictionary methodsFor: 'enumerating' stamp: 'ar 6/13/2008 00:16'!
collect: aBlock 
	"Evaluate aBlock with each of my values as the argument.  Collect the
	resulting values into a collection that is like me. Answer with the new
	collection."
	| newCollection |
	newCollection := self species new.
	self associationsDo:[:each |
		newCollection at: each key put: (aBlock value: each value).
	].
	^newCollection! !

!Dictionary methodsFor: 'accessing' stamp: 'StephaneDucasse 12/25/2009 12:15'!
keysSortedSafely
	"Answer an Array containing the receiver's keys."
 	"Suggested by l. Uzonyi"
	
 	| sortedKeys |
 	sortedKeys := Array 
						new: self size 
						streamContents: [ :stream |
 								self keysDo: [ :each | stream nextPut: each ] ].
 	sortedKeys sort: [ :x :y |
 		"Should really be use <obj, string, num> compareSafely..."
 		((x isString and: [ y isString ])
 			or: [ x isNumber and: [ y isNumber ] ])
 			ifTrue: [ x < y ]
 			ifFalse: [ x class == y class
 				ifTrue: [ x printString < y printString ]
 				ifFalse: [ x class name < y class name ] ] ].
 	^sortedKeys! !

!Dictionary methodsFor: 'copying' stamp: 'ul 9/22/2009 04:51'!
postCopy
	"Must copy the associations, or later store will affect both the
original and the copy"

	array := array collect: [ :association |
		association ifNotNil: [ association copy ] ]! !

!Dictionary methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 3/25/2015 09:09'!
gtInspectorItemsIn: composite
	^ (composite table)
		title: 'Items';
		display: [ self associations ];
		children: [ :each | 
			(each value isDictionary) 
				ifTrue: [ each value associations ] 
				ifFalse: [ (each value isArray and: [ each value allSatisfy: #isDictionary ])
						ifTrue: [ each value collectWithIndex: [:x :i | i -> x ] ]
						ifFalse: [ #() ] ] ];
		column: 'Key' 
			evaluated: [:each | GTObjectPrinter new asTruncatedTextFrom: each key ];
		column: 'Value' 
			evaluated: [:each | GTObjectPrinter new asTruncatedTextFrom: each value ];
		selectionAct: [ :table |
			table rawSelection do: [ :assoc | self removeKey: assoc key ].
			table update ]
			entitled: 'Remove item(s)';
		selectionPopulate: #selection 
			entitled: 'Open key'
			with: [ :table | (table rawSelection collect: #key) gtInspectorInterestingObject ];
		beMultiple;
		withSmalltalkSearch;
		send: [ :selection | 
			(selection notNil and: [ selection size = 1 ]) 
				ifTrue: [ selection anyOne value ] 
				ifFalse: [ selection collect: #value ] ];
		showOnly: 50;
		helpMessage: 'Quick selection field. Given your INPUT, it executes: self select: [:each | INPUT ]'! !

!Dictionary methodsFor: 'accessing' stamp: 'StephaneDucasse 12/25/2009 12:12'!
associations
	"Answer a Collection containing the receiver's associations."
	"Suggested by l. Uzonyi"
	
	^Array new: self size streamContents: [ :stream |
		self associationsDo: [ :each | stream nextPut: each ] ]! !

!Dictionary methodsFor: 'kernel' stamp: ''!
declare: key from: aDictionary 
	"Add key to the receiver. If key already exists, do nothing. If aDictionary 
	includes key, then remove it from aDictionary and use its association as 
	the element of the receiver."

	(self includesKey: key) ifTrue: [^ self].
	(aDictionary includesKey: key)
		ifTrue: 
			[self add: (aDictionary associationAt: key).
			aDictionary removeKey: key]
		ifFalse: 
			[self add: key -> nil]! !

!Dictionary methodsFor: 'accessing' stamp: 'ar 2/13/1999 21:16'!
keyAtIdentityValue: value ifAbsent: exceptionBlock
	"Answer the key that is the external name for the argument, value. If 
	there is none, answer the result of evaluating exceptionBlock.
	Note: There can be multiple keys with the same value. Only one is returned."
 
	self associationsDo: 
		[:association | value == association value ifTrue: [^association key]].
	^exceptionBlock value! !

!Dictionary methodsFor: 'private' stamp: 'HenrikSperreJohansen 9/1/2010 23:17'!
noCheckNoGrowFillFrom: anArray
	"Add the elements of anArray except nils to me assuming that I don't contain any of them, they are unique and I have more free space than they require."

	1 to: anArray size do: [ :index |
		(anArray at: index) ifNotNil: [ :association |
			array
				at: (self scanForEmptySlotFor: association key)
				put: association ] ]! !

!Dictionary methodsFor: 'testing' stamp: 'StephaneDucasse 5/28/2011 14:01'!
isHealthy
	"Test that object hashes match their positions stored in set's array,
	answer true if everything ok, false otherwise
	
	Dictionary allInstances select: [:dict |
		dict isHealthy not ]
	Dictionary allSubInstances select: [:dict |
		dict isHealthy not ]
	"
	array withIndexDo: [:elem :i |
		elem ifNotNil: [
			(self scanFor: elem key) == i ifFalse: [ ^ false ]
			]
	].
	^ true! !

!Dictionary methodsFor: 'removing' stamp: 'di 4/4/2000 11:47'!
keysAndValuesRemove: keyValueBlock
	"Removes all entries for which keyValueBlock returns true."
	"When removing many items, you must not do it while iterating over the dictionary, since it may be changing.  This method takes care of tallying the removals in a first pass, and then performing all the deletions afterward.  Many places in the sytem could be simplified by using this method."

	| removals |
	removals := OrderedCollection new.
	self associationsDo:
		[:assoc | (keyValueBlock value: assoc key value: assoc value)
			ifTrue: [removals add: assoc key]].
 	removals do:
		[:aKey | self removeKey: aKey]! !

!Dictionary methodsFor: 'accessing' stamp: 'StephaneDucasse 5/13/2010 11:37'!
at: key ifPresent: oneArgBlock ifAbsent: absentBlock
	"Lookup the given key in the receiver. If it is present, answer the value of evaluating the oneArgBlock with the value associated with the key, otherwise answer the value of absentBlock."
	
	self at: key ifPresent: [ :v | ^oneArgBlock value: v ].
	^absentBlock value! !

!Dictionary methodsFor: '*Fuel' stamp: 'MarianoMartinezPeck 7/30/2012 23:16'!
fuelAccept: aGeneralMapper
	| class |
	"Since we have subclasses of Dictionary that behave differently, we cannot use the visitDictionary: for all of them.	 We could also use MethodDictionary for this case, but its materialization is much slower with this cluster than with the default action."
	class := self class.
	^ (((class == Dictionary) or: [class == IdentityDictionary ])) 
		ifTrue: [ aGeneralMapper visitDictionary: self ]
		ifFalse: [ super fuelAccept: aGeneralMapper ] 
	! !

!Dictionary methodsFor: 'private' stamp: 'md 10/5/2005 15:42'!
scanFor: anObject
	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
	| element start finish |
	finish := array size.
	start := (anObject hash \\ finish) + 1.

	"Search from (hash mod size) to the end."
	start to: finish do:
		[:index | ((element := array at: index) == nil or: [element key = anObject])
			ifTrue: [^ index ]].

	"Search from 1 to where we started."
	1 to: start-1 do:
		[:index | ((element := array at: index) == nil or: [element key = anObject])
			ifTrue: [^ index ]].

	^ 0  "No match AND no empty slot"! !

!Dictionary methodsFor: 'enumerating' stamp: 'TristanBourgois 5/10/2010 10:41'!
associationsDo: aBlock 
	"Evaluate aBlock for each of the receiver's elements (key/value 
	associations)."

	tally = 0 ifTrue: [^ self].
	array do:
		[:each |
		each ifNotNil: [aBlock value: each]]! !

!Dictionary methodsFor: 'accessing' stamp: ''!
associationAt: key ifAbsent: aBlock 
	"Answer the association with the given key.
	If key is not found, return the result of evaluating aBlock."

	| index assoc |
	index := self findElementOrNil: key.
	assoc := array at: index.
	nil == assoc ifTrue: [ ^ aBlock value ].
	^ assoc! !

!Dictionary methodsFor: 'accessing' stamp: 'CamilloBruni 4/11/2011 13:30'!
at: key 
	"Answer the value associated with the key."

	^ self at: key ifAbsent: [self errorKeyNotFound: key]! !

!Dictionary methodsFor: 'adding' stamp: ''!
add: anAssociation
	| index element |
	index := self findElementOrNil: anAssociation key.
	element := array at: index.
	element == nil
		ifTrue: [self atNewIndex: index put: anAssociation]
		ifFalse: [element value: anAssociation value].
	^ anAssociation! !

!Dictionary methodsFor: 'accessing' stamp: 'MarcusDenker 8/18/2010 19:17'!
at: key ifAbsent: aBlock 
	"Answer the value associated with the key or, if key isn't found,
	answer the result of evaluating aBlock."

	^((array at: (self findElementOrNil: key)) 
			ifNil: [aBlock] 
			ifNotNil: [:assoc | assoc]) value.! !

!Dictionary methodsFor: '*monticellofiletree-core' stamp: 'dkh 4/6/2012 15:56:14'!
writeCypressJsonForHtmlOn: aStream
    self writeCypressJsonOn: aStream forHtml: true indent: 0! !

!Dictionary methodsFor: 'private' stamp: 'SvenVanCaekenberghe 4/19/2011 20:30'!
errorValueNotFound: value

	ValueNotFound signalFor: value! !

!Dictionary methodsFor: '*monticellofiletree-core' stamp: 'dkh 4/6/2012 15:56:14'!
writeCypressJsonOn: aStream forHtml: forHtml indent: startIndent
    "by default ignore <forHtml> ... <forHtml> is used for Dictionary and Array, i.e., container objects and String which actually encodes itself differently for HTML"

    | indent keys |
    indent := startIndent.
    aStream
        nextPutAll: '{';
        lf.
    indent := indent + 1.
    keys := self keys sort: [ :a :b | a <= b ].
    1 to: keys size do: [ :index | 
        | key value |
        key := keys at: index.
        value := self at: key.
        aStream tab: indent.
        key writeCypressJsonOn: aStream forHtml: forHtml indent: indent.
        aStream nextPutAll: ' : '.
        value writeCypressJsonOn: aStream forHtml: forHtml indent: indent.
        index < self size
            ifTrue: [ 
                aStream
                    nextPutAll: ',';
                    lf ] ].
    self size = 0
        ifTrue: [ aStream tab: indent ].
    aStream nextPutAll: ' }'! !

!Dictionary methodsFor: 'private' stamp: 'nice 11/14/2009 16:33'!
fixCollisionsFrom: start
	"The element at start has been removed and replaced by nil.
	This method moves forward from there, relocating any entries
	that had been placed below due to collisions with this one."
	| element index |
	index := start.
	[ (element := array at: (index := index \\ array size + 1)) == nil ] whileFalse: [
		| newIndex |
		(newIndex := self findElementOrNil: element key) = index ifFalse: [
			array swap: index with: newIndex ] ]! !

!Dictionary methodsFor: 'testing' stamp: 'tween 9/13/2004 10:11'!
hasBindingThatBeginsWith: aString
	"Answer true if the receiver has a key that begins with aString, false otherwise"
	
	self keysDo:[:each | 
		(each beginsWith: aString)
			ifTrue:[^true]].
	^false! !

!Dictionary methodsFor: 'printing' stamp: ''!
storeOn: aStream
	| noneYet |
	aStream nextPutAll: '(('.
	aStream nextPutAll: self class name.
	aStream nextPutAll: ' new)'.
	noneYet := true.
	self associationsDo: 
			[:each | 
			noneYet
				ifTrue: [noneYet := false]
				ifFalse: [aStream nextPut: $;].
			aStream nextPutAll: ' add: '.
			aStream store: each].
	noneYet ifFalse: [aStream nextPutAll: '; yourself'].
	aStream nextPut: $)! !

!Dictionary methodsFor: 'accessing' stamp: 'nice 10/20/2009 23:20'!
keys
	"Answer an Array containing the receiver's keys."
	
	^Array new: self size streamContents: [:s| self keysDo: [:key| s nextPut: key]]! !

!Dictionary methodsFor: 'removing' stamp: ''!
remove: anObject ifAbsent: exceptionBlock

	self shouldNotImplement! !

!Dictionary methodsFor: 'accessing' stamp: 'tk 2/18/97'!
keyAtValue: value ifAbsent: exceptionBlock
	"Answer the key that is the external name for the argument, value. If 
	there is none, answer the result of evaluating exceptionBlock.
	: Use =, not ==, so stings like 'this' can be found.  Note that MethodDictionary continues to use == so it will be fast."
 
	self associationsDo: 
		[:association | value = association value ifTrue: [^association key]].
	^exceptionBlock value! !

!Dictionary methodsFor: 'testing' stamp: ''!
includes: anObject

	self do: [:each | anObject = each ifTrue: [^true]].
	^false! !

!Dictionary methodsFor: 'enumerating' stamp: ''!
keysDo: aBlock 
	"Evaluate aBlock for each of the receiver's keys."

	self associationsDo: [:association | aBlock value: association key]! !

!Dictionary methodsFor: 'private' stamp: 'ul 11/21/2009 01:15'!
fillFrom: aCollection with: aBlock
	"Evaluate aBlock with each of aCollections's elements as the argument.  
	Collect the resulting values into self. Answer self."

	aCollection keysAndValuesDo: [ :key :value |
		self at: key put: (aBlock value: value) ]! !

!Dictionary methodsFor: 'enumerating' stamp: 'nice 10/5/2009 10:16'!
select: aBlock 
	"Evaluate aBlock with each of my values as the argument. Collect into a new dictionary, only those associations for which aBlock evaluates to true."

	| newCollection |
	newCollection := self copyEmpty.
	self associationsDo: [ :each |
		(aBlock value: each value) ifTrue: [
			newCollection add: each copy ] ].
	^newCollection! !

!Dictionary methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/19/2011 20:31'!
keyAtValue: value 
	"Answer the key that is the external name for the argument, value. If 
	there is none, signal an error."

	^self keyAtValue: value ifAbsent: [self errorValueNotFound: value]! !

!Dictionary methodsFor: 'enumerating' stamp: 'MarcusDenker 7/2/2010 13:02'!
do: aBlock

	^self valuesDo: aBlock! !

!Dictionary methodsFor: 'comparing' stamp: 'cyrille.delaunay 7/17/2009 15:45'!
= aDictionary
	"Two dictionaries are equal if
	 (a) they are the same 'kind' of thing.
	 (b) they have the same set of keys.
	 (c) for each (common) key, they have the same value"

	self == aDictionary ifTrue: [ ^ true ].
	(aDictionary isDictionary) ifFalse: [^false].
	self size = aDictionary size ifFalse: [^false].
	self associationsDo: [:assoc|
		(aDictionary at: assoc key ifAbsent: [^false]) = assoc value
			ifFalse: [^false]].
	^true

! !

!Dictionary methodsFor: 'removing' stamp: ''!
remove: anObject

	self shouldNotImplement! !

!Dictionary methodsFor: '*monticellofiletree-core' stamp: 'dkh 4/6/2012 15:56:14'!
writeCypressJsonOn: aStream
    self writeCypressJsonOn: aStream forHtml: false indent: 0.
    aStream lf! !

!Dictionary methodsFor: 'testing' stamp: 'md 8/11/2005 16:49'!
isDictionary
	^true! !

!Dictionary methodsFor: 'private' stamp: 'SvenVanCaekenberghe 4/19/2011 19:41'!
errorKeyNotFound: aKey

	KeyNotFound signalFor: aKey! !

!Dictionary methodsFor: 'accessing' stamp: 'CamilloBruni 4/11/2011 13:30'!
associationAt: key 
	^ self associationAt: key ifAbsent: [self errorKeyNotFound: key]! !

!Dictionary methodsFor: 'enumerating' stamp: 'MarianoMartinezPeck 8/24/2012 15:26'!
keysAndValuesDo: aBlock
	^self associationsDo:[:assoc|
		aBlock value: assoc key value: assoc value].! !

!Dictionary methodsFor: 'removing' stamp: 'MarcusDenker 10/9/2013 11:29'!
unreferencedKeys
	"| uk | (Time millisecondsToRun: [uk := TextConstants unreferencedKeys]) -> uk"

	^'Scanning for references . . .' 
		displayProgressFrom: 0
		to: Smalltalk globals classNames size * 2
		during: 
			[:bar | | currentClass n associations referencedAssociations |
			currentClass := nil.
			n := 0.
			associations := self associations asIdentitySet.
			referencedAssociations := IdentitySet new: associations size.
			self systemNavigation allMethodsSelect:
				[:m|
				m methodClass ~~ currentClass ifTrue:
					[currentClass := m methodClass.
					 bar current: (n := n + 1)].
				m literalsDo:
					[:l|
					(l isVariableBinding and: [associations includes: l]) ifTrue:
						[referencedAssociations add: l]].
				false].
			((associations reject: [:assoc | referencedAssociations includes: assoc]) collect: [:assoc| assoc key]) asSet]! !

!Dictionary methodsFor: 'private' stamp: 'CamilloBruni 8/1/2012 16:12'!
noCheckAdd: anObject
	"Must be defined separately for Dictionary because (self findElementOrNil:) expects a key, not an association."

	array at: (self findElementOrNil: anObject key) put: anObject.
	tally := tally + 1! !

!Dictionary class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 3/26/2015 00:15'!
gtExampleOneElementDictionaryFrom: anEmptyDictionary
	<gtExample: 'One element dictionary'>
	<gtExampleFrom: #gtExampleEmptyDictionary>
	
	anEmptyDictionary at: 4 put: 2.
	^ anEmptyDictionary! !

!Dictionary class methodsFor: 'instance creation' stamp: ''!
newFrom: aDict 
	"Answer an instance of me containing the same associations as aDict.
	 Error if any key appears twice."
	| newDictionary |
	newDictionary := self new: aDict size.
	aDict associationsDo:
		[:x |
		(newDictionary includesKey: x key)
			ifTrue: [self error: 'Duplicate key: ', x key printString]
			ifFalse: [newDictionary add: x]].
	^ newDictionary

"	NewDictionary newFrom: {1->#a. 2->#b. 3->#c}
	{1->#a. 2->#b. 3->#c} as: NewDictionary
	NewDictionary newFrom: {1->#a. 2->#b. 1->#c}
	{1->#a. 2->#b. 1->#c} as: NewDictionary
"! !

!Dictionary class methodsFor: 'instance creation' stamp: 'bgf 10/25/2006 17:08'!
newFromPairs: anArray 

	"Answer an instance of me associating (anArray at:i) to (anArray at: i+i)
	 for each odd i.  anArray must have an even number of entries."

	| newDictionary |

	newDictionary := self new: (anArray size/2).
	1 to: (anArray size-1) by: 2 do: [ :i|
		newDictionary at: (anArray at: i) put: (anArray at: i+1).
	].
	^ newDictionary

	"  Dictionary newFromPairs: {'Red' . Color red . 'Blue' . Color blue . 'Green' . Color green}. "! !

!Dictionary class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 3/26/2015 00:15'!
gtExampleRemoveElementFrom: anEmptyDictionary
	<gtExample: 'Remove element'>
	<gtExampleFrom: #gtExampleOneElementDictionaryFrom:>
	
	anEmptyDictionary removeKey: 4.
	^ anEmptyDictionary! !

!Dictionary class methodsFor: '*Spec-Inspector' stamp: 'cb 6/25/2013 13:43'!
inspectorClass
	^ EyeDictionaryInspector! !

!Dictionary class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 3/26/2015 00:11'!
gtExampleEmptyDictionary
	<gtExample: 'Empty dictionary'>

	^ Dictionary new! !

!Dictionary class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 3/26/2015 00:15'!
gtExampleTwoElementsDictionaryFrom: aDictionary
	<gtExample: 'Two elements dictionary'>
	<gtExampleFrom: #gtExampleOneElementDictionaryFrom:>
	
	aDictionary at: #fourty put: 'two'.
	^ aDictionary! !

!DictionaryTest commentStamp: 'TorstenBergmann 2/20/2014 15:20'!
SUnit tests for dictionaries!
!DictionaryTest methodsFor: 'requirement' stamp: 'AlexandreBergel 1/6/2009 15:06'!
nonEmptyDict
	^ nonEmptyDict ! !

!DictionaryTest methodsFor: 'test - copying' stamp: ''!
testDictionaryConcatenationWithCommonKeysDifferentValues

	| dictionary1 dictionary2 result value |
	
	dictionary1 := self nonEmptyDict.
	value := self nonEmptyDifferentFromNonEmptyDict   values anyOne.
	dictionary2 := dictionary1 copy.
	dictionary2 keys do: [ :key | dictionary2 at: key put: value ].
	
	
	result := dictionary1 , dictionary2.
	self assert: result size = ( dictionary2 size).
	
	dictionary2 associationsDo: [ :assoc | self assert: (result at: assoc key) = assoc value ]! !

!DictionaryTest methodsFor: 'tests - set arithmetic' stamp: ''!
numberOfSimilarElementsInIntersection
	^ self collection occurrencesOf: self anotherElementOrAssociationIn! !

!DictionaryTest methodsFor: 'tests - occurrencesOf for multipliness' stamp: ''!
testOccurrencesOfForMultipliness

| collection elem |
collection := self collectionWithEqualElements .
elem := self elementTwiceInForOccurrences .

self assert: (collection occurrencesOf: elem ) = 2.  ! !

!DictionaryTest methodsFor: 'tests - dictionary including' stamp: ''!
testIncludesIdentitySpecificComportement

| valueIn collection |
collection := self nonEmptyWithCopyNonIdentical  .
valueIn := collection  values anyOne.

self assert: (collection includesIdentity: valueIn ) .
self deny: (collection includesIdentity: valueIn copy ) .
! !

!DictionaryTest methodsFor: 'tests - dictionnary enumerating' stamp: ''!
testValuesDo
	| collection values |
	collection := self nonEmptyDict .
	values := OrderedCollection new.
	collection valuesDo: [ :value  | 
		values add: value.
		].
	
	collection values do: [ :value | self assert: (collection values occurrencesOf: value) = (values occurrencesOf: value)]! !

!DictionaryTest methodsFor: 'tests - dictionnary enumerating' stamp: ''!
testReject
	"Ensure that Dictionary>>reject: answers a dictionary not something else"
	
	| collection result |
	collection := self nonEmptyDict .
	result := collection reject: [ :each | false].
	
	self assert: result = collection. ! !

!DictionaryTest methodsFor: 'tests - converting' stamp: ''!
assertNonDuplicatedContents: aCollection whenConvertedTo: aClass 
	| result |
	result := aCollection perform: ('as' , aClass name) asSymbol.
	self assert: (result class includesBehavior: aClass).
	result do: 
		[ :each | 
		self assert: (aCollection occurrencesOf: each) = (result occurrencesOf: each) ].
	^ result! !

!DictionaryTest methodsFor: 'tests - dictionnary enumerating' stamp: ''!
testAssociationsDo

	| collection keys |
	collection := self nonEmptyDict .

	keys := OrderedCollection new.
	
	collection associationsDo: [ :assoc | 
		keys add: assoc key.
		self assert: ( collection at: assoc key ) = assoc value.		
		].
	
	collection keys do: [:key | self assert: ( keys occurrencesOf: key ) = (collection keys occurrencesOf: key)].! !

!DictionaryTest methodsFor: 'tests - Dictionary keys values associations access' stamp: ''!
testKeysSortedSafely
	| collection result |
	collection := self nonEmpty.
	result := collection keysSortedSafely.
	result do: [ :key | collection at: key ].
	self assert: result size = collection size.
	self should: [ result detect: [ :each | (result occurrencesOf: each) > 1 ] ] raise: Error.
	self assert: result asArray isSorted! !

!DictionaryTest methodsFor: 'tests - converting' stamp: ''!
testAsIdentitySet
	"test with a collection without equal elements :"
	self 
		assertSameContents: self collectionWithoutEqualElements
		whenConvertedTo: IdentitySet.
! !

!DictionaryTest methodsFor: 'tests - converting' stamp: ''!
testAsByteArray
	| res |
	self integerCollectionWithoutEqualElements.
	self integerCollectionWithoutEqualElements do: [ :each | self assert: each class = SmallInteger ].
	res := true.
	self integerCollectionWithoutEqualElements
		detect: [ :each | (self integerCollectionWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false.
	self assertSameContents: self integerCollectionWithoutEqualElements whenConvertedTo: ByteArray! !

!DictionaryTest methodsFor: 'tests - fixture' stamp: ''!
test0TStructuralEqualityTest
	self empty.
	self nonEmpty.
	self assert: self empty isEmpty.
	self deny: self nonEmpty isEmpty! !

!DictionaryTest methodsFor: 'tests' stamp: 'nice 10/6/2009 14:21'!
testAsSet
	"Non regression test for http://bugs.squeak.org/view.php?id=7258"
	
	| aDictionary aSet assoc0 assoc1 |
	
	"Create a dictionary"
	aDictionary := Dictionary new.
	
	"Convert it to a Set"
	aSet := aDictionary asSet.

	"Add two associations to it"	
	assoc0 := #first -> 0.
	assoc1 := #first -> 1.
	aSet add: assoc0 copy; add: assoc1.
	
	"Check if the two associations were added (that should happen if they are different)"
	self
		assert: (assoc0 copy ~= assoc1) ==> (aSet size > 1)
		description:
  			'When adding two different elements, the set size should be greater than one'! !

!DictionaryTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureDictionaryIncludesIdentity
	self nonEmptyWithCopyNonIdentical.
	self deny: self nonEmptyWithCopyNonIdentical isEmpty.
	self nonEmptyWithCopyNonIdentical do: [ :each | self deny: each == each copy ]! !

!DictionaryTest methodsFor: 'requirements' stamp: 'delaunay 5/5/2009 15:21'!
keyNotInNonEmptyDict
" return a key not included in nonEmptyDict"
	^ keyNotIn ! !

!DictionaryTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionTwoSimilarElementsInIntersection
	"self debug: #testIntersectionBasic"
	| inter |
	inter := self collection intersection: (self collectionClass with: self anotherElementOrAssociationIn).
	self assert: (self collection occurrencesOf: self anotherElementOrAssociationIn) = self numberOfSimilarElementsInIntersection.
	self assert: (inter includes: self anotherElementOrAssociationIn value)! !

!DictionaryTest methodsFor: 'test - removing' stamp: ''!
testRemoveKeyIfAbsent
	
	| collection oldSize keyIn value result |
	collection := self nonEmptyDict .
	oldSize := collection size.
	keyIn := collection  keys anyOne.
	value := collection at: keyIn .
	
	result := collection removeKey: keyIn ifAbsent: [888].
	
	self assert: result = value.
	self assert: (collection  size = (oldSize - 1)).
	self should: [ (collection  at: keyIn )] raise: Error.
	
	self assert: (collection removeKey: self keyNotInNonEmptyDict ifAbsent: [888] ) = 888.! !

!DictionaryTest methodsFor: 'requirement' stamp: 'AlexandreBergel 1/6/2009 15:09'!
newEmptyDict
	^ self emptyDict copy! !

!DictionaryTest methodsFor: 'test - removing' stamp: ''!
testRemoveKey
	"self debug: #testRemoveKey"

	| collection oldSize keyIn |
	collection := self nonEmptyDict .
	oldSize := collection size.
	keyIn := collection  keys anyOne.
	
	collection removeKey: keyIn .
	self assert: (collection  size = (oldSize - 1)).
	self should: [ (collection  at: keyIn )] raise: Error.
	
	self should: [collection removeKey: self keyNotInNonEmptyDict ] raise: Error! !

!DictionaryTest methodsFor: 'tests - DictionaryIndexAccessing' stamp: ''!
testAtPutDict
	"self run: #testAtPutDict"
	"self debug: #testAtPutDict"
	
	| adictionary keyIn |
	adictionary := self nonEmpty .
	keyIn := adictionary keys anyOne.
	
	adictionary at: keyIn put: 'new'.
	self assert: (adictionary at: keyIn ) = 'new'.
	
	adictionary at: keyIn  put: 'newnew'.
	self assert: (adictionary at: keyIn ) = 'newnew'.
	
	adictionary at: self keyNotIn  put: 666.
	self assert: (adictionary at: self keyNotIn  ) = 666.! !

!DictionaryTest methodsFor: 'tests - dictionary including' stamp: ''!
testIncludesKey

	| collection keyIn nonExistantKey |

	collection := self nonEmpty .
	keyIn := collection keys anyOne.
	nonExistantKey := self keyNotInNonEmpty. 

	self assert: ( collection includesKey: keyIn ).
	self deny: ( collection includesKey: nonExistantKey ).! !

!DictionaryTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAnyNoneThere
	"self debug: #testIncludesAnyOfNoneThere'"
	
	self deny: (self nonEmpty includesAny: self empty).
	self deny: (self nonEmpty includesAny: { self elementNotIn. self anotherElementNotIn })! !

!DictionaryTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedArray
	| result collection |
	collection := self collectionWithSortableElements .
	result := collection  asArray sort.
	self assert: (result class includesBehavior: Array).
	self assert: result isSorted.
	self assert: result size = collection size! !

!DictionaryTest methodsFor: 'tests - dictionary including' stamp: ''!
testIncludesAssociation

	|  nonExistantAssociation associationIn keyIn valueIn |

	keyIn := self nonEmpty keys anyOne.
	valueIn := self nonEmpty values anyOne. 
	nonExistantAssociation := self keyNotInNonEmpty -> self valueNotInNonEmpty .
	associationIn := self nonEmpty associations anyOne.	

	self assert:  (self nonEmpty includesAssociation: associationIn ).
	self deny:  (self nonEmpty includesAssociation: nonExistantAssociation ).
	" testing the case where key is included but not with the same value :"
	self deny: (self nonEmpty includesAssociation: (keyIn-> self valueNotInNonEmpty )).
	" testing the case where value is included but not corresponding key :"
	self deny: (self nonEmpty includesAssociation: (self keyNotInNonEmpty -> valueIn  )).



! !

!DictionaryTest methodsFor: 'test - adding' stamp: 'delaunay 5/5/2009 12:08'!
testAdd
	"| dict |
	dict := self emptyDict.
	dict add: #a -> 1.
	dict add: #b -> 2.
	self assert: (dict at: #a) = 1.
	self assert: (dict at: #b) = 2"
	| dictionary result |
	dictionary := self nonEmptyDict.
	result := dictionary add: self associationWithKeyNotInToAdd.
	self assert: result = self associationWithKeyNotInToAdd! !

!DictionaryTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 15:52'!
collectionWithoutEqualElements
" return a collection without equal elements"
	^ nonEmpty5ElementsNoDuplicates ! !

!DictionaryTest methodsFor: 'tests - converting' stamp: ''!
testAsArray
	"self debug: #testAsArray3"
	self 
		assertSameContents: self collectionWithoutEqualElements
		whenConvertedTo: Array! !

!DictionaryTest methodsFor: 'tests - dictionary assocition access' stamp: ''!
testAssociationAtError

	| collection nonExistantKey |
	collection := self nonEmpty.
	nonExistantKey := self keyNotIn .

	self should: [collection associationAt: nonExistantKey] raise: Error. 

! !

!DictionaryTest methodsFor: 'tests - includes' stamp: ''!
testIncludesElementIsThere
	"self debug: #testIncludesElementIsThere"
	
	self assert: (self nonEmpty includes: self nonEmpty anyOne).! !

!DictionaryTest methodsFor: 'test - testing' stamp: 'damienpollet 1/30/2009 17:57'!
testKeyForIdentity
	self assert: (nonEmptyDict keyForIdentity: 30) = #b.

	"The value 20 is associated to two different associations"
	self assert: (#(a c) includes: (nonEmptyDict keyForIdentity: self elementTwiceIn))! !

!DictionaryTest methodsFor: 'tests - set arithmetic' stamp: ''!
testUnionOfEmpties
	"self debug: #testUnionOfEmpties"
	
	self assert:  (self empty union: self empty) isEmpty.
	
	! !

!DictionaryTest methodsFor: 'tests - copy' stamp: ''!
testCopyNotSame
	"self debug: #testCopySameClass"
	"A copy of a collection should always be of the same class as the instance it copies"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: copy  == self nonEmpty.! !

!DictionaryTest methodsFor: 'tests' stamp: 'CamilloBruni 3/23/2013 12:18'!
testNilHashCollision
	"Ensures that fixCollisionsFrom: does the right thing in the presence of a nil key"
	| dict key |
	self supportsNilKey
		ifFalse: [ ^ self ].
	dict := self collectionClass new.
	key := nil hash. "any key with same hash as nil"
	dict at: key hash put: 1.
	dict at: nil put: 2.
	self assert: (dict includesKey: nil).
	dict removeKey: key.
	self assert: (dict includesKey: nil).
! !

!DictionaryTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifferenceWithSeparateCollection
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifferenceWithSeparateCollection"
	| res separateCol |
	
	separateCol := self collectionClass with: self anotherElementOrAssociationNotIn.
	res := self collectionWithoutEqualElements difference: separateCol.
	
	self deny: (res includes: self anotherElementOrAssociationNotIn).
	self assert: res size equals: self collectionWithoutEqualElements size.
	
	self collectionWithoutEqualElements do: [ :each|
		self assert: (res includes: each)].
	
	res := separateCol difference: self collection.
	self deny: (res includes: self collection anyOne).
	self assert: res equals: separateCol! !

!DictionaryTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCloneTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!DictionaryTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 16:05'!
collectionWithElement
	"Returns a collection that already includes what is returned by #element."
	^ nonEmpty5ElementsNoDuplicates add: self element ;yourself.! !

!DictionaryTest methodsFor: 'tests - printing' stamp: ''!
testPrintOn
	| aStream result allElementsAsString tmp |
	result:=''.
	aStream:= ReadWriteStream on: result.
	tmp:= OrderedCollection new.
	self nonEmpty do: [:each | tmp add: each asString].
	
	self nonEmpty printOn: aStream .
	allElementsAsString:=(result findBetweenSubStrs: ' ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i=1
			ifTrue:[
			self accessCollection class name first isVowel 
				ifTrue:[self assert: (allElementsAsString at:i)='an' ]
				ifFalse:[self assert: (allElementsAsString at:i)='a'].].
		i=2
			ifTrue:[self assert: (allElementsAsString at:i)=self accessCollection class name].
		i>2
			ifTrue:[self assert: (tmp occurrencesOf:(allElementsAsString at:i))=(allElementsAsString  occurrencesOf:(allElementsAsString at:i)).].	
			].! !

!DictionaryTest methodsFor: 'tests - printing' stamp: ''!
testPrintElementsOn

	| aStream result allElementsAsString tmp |
	result:=''.
	aStream:= ReadWriteStream on: result.
	tmp:= OrderedCollection new.
	self nonEmpty do: [:each | tmp add: each asString].
	
	self nonEmpty printElementsOn: aStream .
	allElementsAsString:=(result findBetweenSubStrs: ' ' ).
	1 to: allElementsAsString size do:
		[:i | 
		self assert: (tmp occurrencesOf:(allElementsAsString at:i))=(allElementsAsString  occurrencesOf:(allElementsAsString at:i)).
			].! !

!DictionaryTest methodsFor: 'tests - at put' stamp: ''!
testAtPutTwoValues
	"self debug: #testAtPutTwoValues"
	
	self nonEmpty at: self anIndex put: self aValue.
	self nonEmpty at: self anIndex put: self anotherValue.
	self assert: (self nonEmpty at: self anIndex) = self anotherValue.! !

!DictionaryTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureDictionaryKeysValuesAssociationsAccess
	self nonEmpty.
	self deny: self nonEmpty isEmpty! !

!DictionaryTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureDictionaryElementAccess
	| in |
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self keyNotIn.
	in := true.
	self nonEmpty keys detect: [ :key | key = self keyNotIn ] ifNone: [ in := false ].
	self assert: in = false! !

!DictionaryTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureDictionaryRemovingTest
	self nonEmptyDict.
	self deny: self nonEmptyDict isEmpty.
	self keyNotInNonEmptyDict.
	self deny: (self nonEmptyDict keys includes: self keyNotInNonEmptyDict)! !

!DictionaryTest methodsFor: 'requirement' stamp: 'stephane.ducasse 11/21/2008 15:05'!
anotherElementNotIn
	^ 42! !

!DictionaryTest methodsFor: 'tests - dictionary key access' stamp: ''!
testKeyAtValue
	"self run: #testKeyAtValue"
	"self debug: #testKeyAtValue"
	
	| dict value result |
	dict := self nonEmpty .
	value := dict values anyOne.
	
	result := dict keyAtValue: value.
	self assert: (dict at: result) = value.
		
	self should: [dict keyAtValue: self valueNotIn ] raise: Error
	
	! !

!DictionaryTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 11:09'!
collectionWithElementsToRemove
" return a collection of elements included in 'nonEmpty'  "
	^ collectionIncluded  ! !

!DictionaryTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsStringOnDelimiterLastMore

	| delim multiItemStream result last allElementsAsString tmp |
	
	delim := ', '.
	last := 'and'.
	result:=''.
	tmp := self nonEmpty collect: [:each | each asString].
	multiItemStream := ReadWriteStream on:result.
	self nonEmpty  asStringOn: multiItemStream delimiter: ', ' last: last.
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 ) | i= allElementsAsString size
			ifTrue: [self assert: (tmp occurrencesOf:(allElementsAsString at:i))=(allElementsAsString 			occurrencesOf:(allElementsAsString at:i))].
		i=(allElementsAsString size-1)
			ifTrue:[ self assert: (allElementsAsString at:i)=('and')].
			].
! !

!DictionaryTest methodsFor: 'test - integrity' stamp: 'CamilloBruni 3/23/2013 12:08'!
testAllDictionariesAreHealthy
	"only makes sense on Dictionary"
	self classToBeTested = Dictionary 
		ifFalse: [  ^ self ].
	self assert: (Dictionary allSubInstances select: [:dict | dict isHealthy not ]) isEmpty.! !

!DictionaryTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsStringOnDelimiterLastEmpty

	| delim emptyStream |
	delim := ', '.
	emptyStream := ReadWriteStream on: ''.
	self empty asStringOn: emptyStream delimiter: delim last:'and'.
	self assert: emptyStream contents = ''.
! !

!DictionaryTest methodsFor: 'test - testing' stamp: 'AlexandreBergel 1/6/2009 13:48'!
testIsDictionary
	self deny: Object new isDictionary.
	self assert: nonEmptyDict isDictionary.
	self assert: emptyDict isDictionary.! !

!DictionaryTest methodsFor: 'test - adding' stamp: ''!
testDeclareFrom
	| newDict v dictionary keyIn associationKeyNotIn |
	dictionary := self nonEmptyDict.
	keyIn := dictionary keys anyOne.
	associationKeyNotIn := self associationWithKeyNotInToAdd .
	newDict := self collectionClass new add: associationKeyNotIn; yourself.
	
	
	
	"if the key already exist, nothing changes"
	v := dictionary  at: keyIn.
	dictionary  declare: keyIn  from: newDict.
	self assert: (dictionary  at: keyIn ) = v.
	
	"if the key does not exist, then it gets removed from newDict and is added to the receiver"
	self nonEmptyDict declare: associationKeyNotIn key from: newDict.
	self assert: (dictionary  at: associationKeyNotIn key) = associationKeyNotIn value.
	self assert: (newDict size = 0)! !

!DictionaryTest methodsFor: 'requirement' stamp: 'damienpollet 1/30/2009 17:44'!
expectedSizeAfterReject
	self flag: 'what should this return?'! !

!DictionaryTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIncludeTest
	| anElementIn |
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self elementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self elementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self anotherElementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self anotherElementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self empty.
	self assert: self empty isEmpty! !

!DictionaryTest methodsFor: 'setup' stamp: 'AlexandreBergel 1/14/2009 15:14'!
classToBeTested 

	^ Dictionary! !

!DictionaryTest methodsFor: 'tests - dictionary including' stamp: ''!
testIncludesIdentityBasicComportement

| valueIn collection |
collection := self nonEmpty .
valueIn := collection  values anyOne.

self assert: (collection includesIdentity: valueIn ) .
self deny: (collection includesIdentity: self valueNotInNonEmpty ).! !

!DictionaryTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOfEmpty
	| result |
	result := self empty occurrencesOf: (self collectionWithoutEqualElements anyOne).
	self assert: result = 0! !

!DictionaryTest methodsFor: 'tests - includes' stamp: 'delaunay 4/2/2009 11:53'!
testIncludesElementIsNotThere
	"self debug: #testIncludesElementIsNotThere"
	self deny: (self nonEmpty includes: self elementNotInForOccurrences).
	self assert: (self nonEmpty includes: self nonEmpty anyOne).
	self deny: (self empty includes: self elementNotInForOccurrences)! !

!DictionaryTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyEmpty
	"self debug: #testCopyEmpty"
	
	| copy | 
	copy := self empty copy.
	self assert: copy isEmpty.! !

!DictionaryTest methodsFor: 'requirements' stamp: 'delaunay 5/4/2009 16:05'!
keyNotIn
" return a key not included in nonEmpty"
^ keyNotIn ! !

!DictionaryTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsStringOnDelimiterLastOne

	| delim oneItemStream result |
	
	delim := ', '.
	result:=''.
	oneItemStream := ReadWriteStream on: result.
	self nonEmpty1Element  asStringOn: oneItemStream delimiter: delim last: 'and'.
	oneItemStream  do:
		[:each1 |
		self nonEmpty1Element do: [:each2 |self assert: each1 = (each2 asString) ]
		 ].
	

! !

!DictionaryTest methodsFor: 'tests - dictionary assocition access' stamp: ''!
testAssociationAtIfAbsent

	| collection keyIn result |
	collection := self nonEmpty.
	keyIn := collection keys anyOne.

	result := collection associationAt: keyIn ifAbsent: [888]. 

	self assert: (result key) = keyIn.
	self assert: (result value ) = (collection at: keyIn ).

	self assert: (collection associationAt: self keyNotIn  ifAbsent: [888] ) = 888! !

!DictionaryTest methodsFor: 'tests - printing' stamp: ''!
testPrintOnDelimiter
	| aStream result allElementsAsString tmp |
	result:=''.
	aStream:= ReadWriteStream on: result.
	tmp:= OrderedCollection new.
	self nonEmpty do: [:each | tmp add: each asString].
	
	
	
	self nonEmpty printOn: aStream delimiter: ', ' .
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		self assert: (tmp occurrencesOf:(allElementsAsString at:i))=(allElementsAsString  occurrencesOf:(allElementsAsString at:i))
			].! !

!DictionaryTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSetAritmeticTest
	self collection.
	self deny: self collection isEmpty.
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self anotherElementOrAssociationNotIn.
	self collection isDictionary
		ifTrue: [ self deny: (self collection associations includes: self anotherElementOrAssociationNotIn key) ]
		ifFalse: [ self deny: (self collection includes: self anotherElementOrAssociationNotIn) ].
	self collectionClass! !

!DictionaryTest methodsFor: 'tests - fixture' stamp: ''!
test0FixturePutTest
	self aValue.
	self anotherValue.
	
	self anIndex.
	self nonEmpty isDictionary 
		ifFalse:[self assert: (self anIndex >=1 & self anIndex <= self nonEmpty size).].
	
	self empty.
	self assert: self empty isEmpty .
	
	self nonEmpty.
	self deny: self nonEmpty  isEmpty.! !

!DictionaryTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 15:19'!
collectionWithoutNilElements
" return a collection that doesn't includes a nil element  and that doesn't includes equal elements'"
	^nonEmpty5ElementsNoDuplicates ! !

!DictionaryTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 15:52'!
integerCollectionWithoutEqualElements
" return a collection of integer without equal elements"
	^ nonEmpty5ElementsNoDuplicates ! !

!DictionaryTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureTConvertTest
	"a collection of number without equal elements:"

	| res |
	self collectionWithoutEqualElements.
	res := true.
	self collectionWithoutEqualElements
		detect: [ :each | (self collectionWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false! !

!DictionaryTest methodsFor: 'test - comparing' stamp: ''!
testEquality
	| nonEmptyDict2 |
	nonEmptyDict2 := self nonEmpty class new.
	self nonEmpty keysAndValuesDo:  [ :key :value | nonEmptyDict2 at: key put: value  ].
	
	self assert: (self nonEmptyDict = nonEmptyDict2)! !

!DictionaryTest methodsFor: 'test - integrity' stamp: 'CamilloBruni 3/23/2013 12:15'!
testHealthyWorks
	"we use associations as keys on purpose, because they changing
	hash depending on the key"
	| a1 a2 dict |
	self classToBeTested = Dictionary
		ifFalse: [  ^ self "only works on Dictionary" ].
	dict := Dictionary new.
	[a1 := 1 -> 2.
	a2 := 2 -> 2.
	dict 
		at: a1 put: 2;
		at: a2 put: 3.
	self assert: dict isHealthy.
	a1 key: 0.
	a2 key: 0.
	self assert: dict isHealthy not]
		ensure: [dict removeAll]! !

!DictionaryTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureDictionaryAddingTest
	self nonEmptyDict.
	self deny: self nonEmptyDict isEmpty.
	self associationWithKeyNotInToAdd.
	self deny: (self nonEmptyDict keys includes: self associationWithKeyNotInToAdd key).
	self associationWithKeyAlreadyInToAdd.
	self assert: (self nonEmptyDict keys includes: self associationWithKeyAlreadyInToAdd key)! !

!DictionaryTest methodsFor: 'tests - copy' stamp: ''!
testCopyEquals
	"self debug: #testCopySameClass"
	"A copy should be equivalent to the things it's a copy of"
	
	| copy | 
	copy := self nonEmpty copy.
	self assert: copy  = self nonEmpty.! !

!DictionaryTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsStringOnDelimiterMore

	| delim multiItemStream result allElementsAsString tmp |
	
	
	delim := ', '.
	result:=''.
	tmp:= self nonEmpty collect:[:each | each asString].
	multiItemStream := ReadWriteStream on:result.
	self nonEmpty  asStringOn: multiItemStream delimiter: ', '.
	
	allElementsAsString := (result findBetweenSubStrs: ', ' ).
	allElementsAsString do:
		[:each |
		self assert: (tmp occurrencesOf: each)=(allElementsAsString occurrencesOf: each).
		].! !

!DictionaryTest methodsFor: 'test - adding' stamp: 'delaunay 5/5/2009 12:08'!
testAddWithKeyAlreadyIn
	| dictionary result association |
	dictionary := self nonEmptyDict.
	association := self associationWithKeyNotInToAdd.
	result := dictionary add: association.
	self assert: result = association.
	self assert: (dictionary at: association key) = association value! !

!DictionaryTest methodsFor: 'test - testing' stamp: 'CamilloBruni 3/23/2013 12:12'!
testIncludesAssociationWithValue

	| association dictionary |
	
	association := Association key: #key value: 1.
	dictionary := self collectionClass new.
	dictionary add: association.
	
	self assert: (dictionary at: #key) = 1

	
	
	! !

!DictionaryTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWithoutAll
	"self debug: #testCopyEmptyWithoutAll"
	| res |
	res := self empty copyWithoutAll: self collectionWithElementsToRemove.
	self assert: res size = self empty size.
	self collectionWithElementsToRemove do: [ :each | self deny: (res includes: each) ]! !

!DictionaryTest methodsFor: 'helpers' stamp: 'stephane.ducasse 1/12/2009 17:25'!
anIndex

	^ #GG! !

!DictionaryTest methodsFor: 'tests - includes' stamp: ''!
testIdentityIncludesNonSpecificComportement
	" test the same comportement than 'includes: '  "
	| collection |	
	collection := self nonEmpty  .
	
	self deny: (collection identityIncludes: self elementNotIn ).
	self assert:(collection identityIncludes: collection anyOne)
! !

!DictionaryTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutAll
	"self debug: #testCopyNonEmptyWithoutAll"
	| res |
	res := self nonEmpty copyWithoutAll: self collectionWithElementsToRemove.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self collectionWithElementsToRemove do: [ :each | self deny: (res includes: (each)) ].
	self nonEmpty do: 
		[ :each | 
		(self collectionWithElementsToRemove includes: each) ifFalse: [ self assert: (res includes: each) ] ]! !

!DictionaryTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureDictionaryIncludes
	| in |
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self valueNotInNonEmpty.
	in := false.
	self nonEmpty
		valuesDo: [ :assoc | 
			assoc = self valueNotInNonEmpty
				ifTrue: [ in := true ] ].
	self assert: in = false.
	self keyNotInNonEmpty.
	in := false.
	self nonEmpty
		keysDo: [ :assoc | 
			assoc = self keyNotInNonEmpty
				ifTrue: [ in := true ] ].
	self assert: in = false! !

!DictionaryTest methodsFor: 'test - new' stamp: 'delaunay 5/4/2009 14:24'!
testNew
	| d |
	d := self classToBeTested new: 10.
	self assert: d size = 0.
	
	"Why 14? Mysterious"
	"self assert: d capacity = 14"! !

!DictionaryTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureDictionaryCopyingTest
	| duplicateKey |
	self nonEmptyDict.
	self deny: self nonEmptyDict isEmpty.
	self nonEmptyDifferentFromNonEmptyDict.
	self deny: self nonEmptyDifferentFromNonEmptyDict isEmpty.
	duplicateKey := true.
	self nonEmptyDict keys
		detect: [ :key | self nonEmptyDifferentFromNonEmptyDict includes: key ]
		ifNone: [ duplicateKey := false ].
	self assert: duplicateKey = false! !

!DictionaryTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureAsStringCommaAndDelimiterTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty.
	self nonEmpty1Element.
	self assert: self nonEmpty1Element size = 1! !

!DictionaryTest methodsFor: 'test - removing' stamp: ''!
testRemove

	self should: [self nonEmptyDict remove: nil] raise: Error.
	self should: [self nonEmptyDict remove: nil ifAbsent: ['What ever here']] raise: Error.! !

!DictionaryTest methodsFor: 'tests - dictionnary enumerating' stamp: ''!
testCollect
	| collection values result |
	collection := self nonEmptyDict .
	values := OrderedCollection new.
	result := collection collect: [ :value  | 
		values add: value.
		].
	
	collection values do: [ :value | self assert: (collection values occurrencesOf: value) = (values occurrencesOf: value)].
	self assert: result = collection.! !

!DictionaryTest methodsFor: 'tests - converting' stamp: ''!
assertNoDuplicates: aCollection whenConvertedTo: aClass 
	| result |
	result := self collectionWithEqualElements asIdentitySet.
	self assert: (result class includesBehavior: IdentitySet).
	self collectionWithEqualElements do: [ :initial | self assert: (result occurrencesOf: initial) = 1 ]! !

!DictionaryTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAnyAllThere
	"self debug: #testIncludesAnyOfAllThere'"
	self deny: (self nonEmpty includesAny: self empty).
	self assert: (self nonEmpty includesAny: { self nonEmpty anyOne }).
	self assert: (self nonEmpty includesAny: self nonEmpty).! !

!DictionaryTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureOccurrencesForMultiplinessTest
	| cpt anElement collection |
	self collectionWithEqualElements.
	self collectionWithEqualElements.
	self elementTwiceInForOccurrences.
	anElement := self elementTwiceInForOccurrences.
	collection := self collectionWithEqualElements.
	cpt := 0.	" testing with identity check ( == ) so that identy collections can use this trait : "
	self collectionWithEqualElements
		do: [ :each | 
			each == self elementTwiceInForOccurrences
				ifTrue: [ cpt := cpt + 1 ] ].
	self assert: cpt = 2! !

!DictionaryTest methodsFor: 'tests - dictionnary enumerating' stamp: ''!
testSelect
	| collection values result |
	collection := self nonEmptyDict .
	values := OrderedCollection new.
	result := collection select: [ :value  | 
		values add: value.
		true].
	
	collection values do: [ :value| self assert: (collection values occurrencesOf: value) = (values occurrencesOf: value)].
	self assert: result = collection.! !

!DictionaryTest methodsFor: 'requirements' stamp: 'delaunay 5/6/2009 10:09'!
nonEmptyDifferentFromNonEmptyDict
" return a dictionary for which all keys are not included in nonEmptyDict"
^ dictionaryNotIncluded ! !

!DictionaryTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsCommaStringEmpty

	self assert: self empty asCommaString = ''.
	self assert: self empty asCommaStringAnd = ''.
	
! !

!DictionaryTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 10:17'!
elementToAdd
" return an element of type 'nonEmpy' elements'type'"
	^ #u->5.! !

!DictionaryTest methodsFor: 'test - copying' stamp: ''!
testDictionaryConcatenationWithoutCommonKeys

	| dictionary1 dictionary2 result |
	dictionary1 := self nonEmptyDict.
	dictionary2 := self nonEmptyDifferentFromNonEmptyDict.
	result := dictionary1 , dictionary2.
	self assert: result size = (dictionary1 size + dictionary2 size).
	dictionary1 associationsDo: [ :assoc | self assert: (result at: assoc key) = assoc value ].
	dictionary2 associationsDo: [ :assoc | self assert: (result at: assoc key) = assoc value ]! !

!DictionaryTest methodsFor: 'requirements' stamp: 'stephane.ducasse 11/21/2008 15:04'!
nonEmpty
	^ nonEmptyDict! !

!DictionaryTest methodsFor: 'tests - at put' stamp: ''!
testAtPut
	"self debug: #testAtPut"
	
	self nonEmpty at: self anIndex put: self aValue.
	self assert: (self nonEmpty at: self anIndex) = self aValue.
	! !

!DictionaryTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyNonEmpty
	"self debug: #testCopyNonEmpty"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: copy isEmpty.
	self assert: copy size = self nonEmpty size.
	self nonEmpty do: 
		[:each | copy includes: each]! !

!DictionaryTest methodsFor: 'requirement' stamp: 'AlexandreBergel 1/6/2009 15:06'!
emptyDict
	^ emptyDict! !

!DictionaryTest methodsFor: 'test - removing' stamp: ''!
testKeysAndValuesRemove
	| oldSize collection keyIn |
	
	collection := self nonEmptyDict .
	oldSize := collection  size.
	keyIn := collection keys anyOne.
	
	collection  keysAndValuesRemove: [:key :value | key == self keyNotInNonEmptyDict ].
	self assert: (collection  size = (oldSize )).
	
	collection  keysAndValuesRemove: [:key :value | key == keyIn ].
	self assert: (collection  size = (oldSize - 1)).
	self should: [ collection at: keyIn  ] raise: Error.! !

!DictionaryTest methodsFor: 'tests - printing' stamp: ''!
testPrintNameOn

	| aStream result |
	result:=''.
	aStream:= ReadWriteStream on: result.
	self nonEmpty printNameOn: aStream.
	self nonEmpty class name first isVowel
		ifTrue:[ self assert: aStream contents =('an ',self nonEmpty class name ) ]
		ifFalse:[self assert: aStream contents =('a ',self nonEmpty class name)].! !

!DictionaryTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureDictionaryEnumeratingTest
	self nonEmptyDict.
	self deny: self nonEmptyDict isEmpty! !

!DictionaryTest methodsFor: 'test - equality' stamp: ''!
testEqualSignIsTrueForNonIdenticalButEqualCollections
	"self debug: #testEqualSignIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty = self empty copy). 
	self assert: (self empty copy = self empty).
	self assert: (self empty copy = self empty copy).
		
	self assert: (self nonEmpty = self nonEmpty copy). 
	self assert: (self nonEmpty copy = self nonEmpty).
	self assert: (self nonEmpty copy = self nonEmpty copy).! !

!DictionaryTest methodsFor: 'tests - DictionaryIndexAccessing' stamp: ''!
testAtIfAbsentPut
	| collection association |
	collection := self nonEmpty .
	association := collection associations anyOne.
	
	collection at: association key ifAbsentPut: [ 888 ].
	self assert: (collection at: association key) = association value.
	
	collection at: self keyNotIn  ifAbsentPut: [ 888 ].
	self assert: ( collection at: self keyNotIn ) = 888.! !

!DictionaryTest methodsFor: 'test - testing' stamp: 'CamilloBruni 3/23/2013 12:11'!
testIncludes
	| o1 o2 newDict |
	self assert: (nonEmptyDict includes: self element).
	
	o1 := 2 @ 3.
	o2 := 2 @ 3.
	self deny: (o1 == o2).
	self assert: (o1 = o2).
	newDict := self collectionClass new.
	newDict at: #a put: o1.
	
	self assert: (newDict includes: o2).
! !

!DictionaryTest methodsFor: 'requirement' stamp: 'damienpollet 1/13/2009 16:55'!
sizeCollection
	^ nonEmptyDict! !

!DictionaryTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsCommaStringMore

	| result resultAnd index allElementsAsString tmp |
	result:= self nonEmpty asCommaString .
	resultAnd:= self nonEmpty asCommaStringAnd .
	tmp :=OrderedCollection new. 
	self nonEmpty do: [ :each | tmp add: each asString].

	"verifying result  :"
	index := 1.
	allElementsAsString := (result findBetweenSubStrs: ', ' ).
	allElementsAsString do:
		[:each |
		self assert: (tmp occurrencesOf: each)=(allElementsAsString occurrencesOf: each).
		].
	
	"verifying esultAnd :"
	allElementsAsString:=(resultAnd findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 ) | i= allElementsAsString size
			ifTrue: [self assert: (tmp occurrencesOf:(allElementsAsString at:i))=(allElementsAsString  occurrencesOf:(allElementsAsString at:i))].
		i=(allElementsAsString size-1)
			ifTrue:[ self assert: (allElementsAsString at:i)=('and')].
			].! !

!DictionaryTest methodsFor: 'requirement' stamp: 'delaunay 5/5/2009 14:15'!
associationWithKeyNotInToAdd
	" return an association that will be used to add to nonEmptyDict"
	^ associationNotIn ! !

!DictionaryTest methodsFor: 'helpers' stamp: 'stephane.ducasse 1/12/2009 17:24'!
aValue

	^ 33! !

!DictionaryTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureDictionaryKeyAccess
	| collection equals |
	self nonEmptyWithoutEqualsValues.
	self deny: self nonEmptyWithoutEqualsValues isEmpty.
	equals := true.
	collection := self nonEmptyWithoutEqualsValues values.
	collection detect: [ :each | (collection occurrencesOf: each) > 1 ] ifNone: [ equals := false ].
	self assert: equals = false.
	self valueNotIn.
	self deny: (self nonEmptyWithoutEqualsValues values includes: self valueNotIn)! !

!DictionaryTest methodsFor: 'requirement' stamp: 'stephane.ducasse 11/21/2008 15:04'!
empty
	^ emptyDict! !

!DictionaryTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWith
	"self debug: #testCopyNonEmptyWith"
	| res anElement |
	anElement := self elementToAdd .
	res := self nonEmpty copyWith: anElement.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self assert: (res includes: (anElement value)).
	self nonEmpty do: [ :each | res includes: each ]! !

!DictionaryTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsStringOnDelimiterEmpty

	| delim emptyStream |
	delim := ', '.
	emptyStream := ReadWriteStream on: ''.
	self empty asStringOn: emptyStream delimiter: delim.
	self assert: emptyStream contents = ''.
! !

!DictionaryTest methodsFor: 'tests - dictionary assocition access' stamp: ''!
testAssociationAt

	| collection keyIn result |
	collection := self nonEmpty.
	keyIn := collection keys anyOne.

	result := collection associationAt: keyIn. 

	self assert: (result key) = keyIn.
	self assert: (result value ) = (collection at: keyIn ).! !

!DictionaryTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutAllNotIncluded
	"self debug: #testCopyNonEmptyWithoutAllNotIncluded"
	| res |
	res := self nonEmpty copyWithoutAll: self collectionNotIncluded.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self nonEmpty do: [ :each | self assert: (res includes: each) ]! !

!DictionaryTest methodsFor: 'tests - dictionary including' stamp: ''!
testIncludesComportementForDictionnary
	| valueIn collection keyIn |
	collection := self nonEmpty.
	valueIn := collection values anyOne.
	keyIn := collection keys anyOne.
	self assert: (collection includes: valueIn).
	self deny: (collection includes: self valueNotInNonEmpty).
	" testing that includes take only care of values :"
	self deny: (collection includes: keyIn)! !

!DictionaryTest methodsFor: 'tests' stamp: 'CamilloBruni 3/23/2013 12:13'!
testRemoveAll
	"Allows one to remove all elements of a collection" 
	
	| dict1 dict2 s2 |
	dict1 := self collectionClass new.
	dict1 
		at: #a put:1 ; 
		at: #b put: 2. 
		
	dict2 := dict1 copy.
	s2 := dict2 size.
	
	dict1 removeAll.
	
	self assert: dict1 size = 0.
	self assert: dict2 size = s2 description: 'the copy has not been modified'.! !

!DictionaryTest methodsFor: 'requirement' stamp: 'damienpollet 1/13/2009 16:15'!
collection
	^ self nonEmptyDict! !

!DictionaryTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 11:56'!
anotherElementOrAssociationIn
	" return an element (or an association for Dictionary ) present  in 'collection' "
	^ self collection associations anyOne.! !

!DictionaryTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionEmpty
	"self debug: #testIntersectionEmpty"
	
	| inter |
	inter := self empty intersection: self empty.
	self assert: inter isEmpty. 
	inter := self empty intersection: self collection .
	self assert: inter =  self empty.
	! !

!DictionaryTest methodsFor: 'requirements' stamp: 'delaunay 5/13/2009 15:54'!
collectionWithEqualElements
" return a collecition including atLeast two elements equal"

^ dictionaryWithDuplicateValues ! !

!DictionaryTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 10:45'!
collectionWithSortableElements
" return a collection elements that can be sorte ( understanding message ' < '  or ' > ')"
	^ nonEmpty5ElementsNoDuplicates ! !

!DictionaryTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedCollectionWithSortBlock
	| result tmp |
	result := self collectionWithSortableElements  asSortedCollection: [:a :b | a > b].
	self assert: (result class includesBehavior: SortedCollection).
	result do: 
		[ :each | 
		self assert: (self collectionWithSortableElements   occurrencesOf: each) = (result occurrencesOf: each) ].
	self assert: result size = self collectionWithSortableElements  size.
	tmp:=result at: 1.
	result do: [:each| self assert: tmp>=each. tmp:=each].
	! !

!DictionaryTest methodsFor: 'test - testing' stamp: 'CamilloBruni 3/23/2013 12:11'!
testHasBindingThatBeginsWith
	| newDict |
	newDict := self collectionClass new 
		at: #abc put: 10; 
		at: #abcd put: 100; 
		at: #def put: 20; 
		yourself.
	self assert: (newDict hasBindingThatBeginsWith: 'ab').
	self assert: (newDict hasBindingThatBeginsWith: 'def').
	self deny: (newDict hasBindingThatBeginsWith: 'defg').! !

!DictionaryTest methodsFor: 'tests - Dictionary keys values associations access' stamp: ''!
testAssociations

	| collection result  |
	collection := self nonEmpty .
	result := collection associations.
	
	self assert: result size = collection size.
	result do: [:assoc | self assert: (assoc value) = (collection at: assoc key) ].
	"keys do: [ :key | self assert: ( result at: key ) = ( collection at: key )] ."
	! !

!DictionaryTest methodsFor: 'tests - converting' stamp: ''!
assertSameContents: aCollection whenConvertedTo: aClass 
	| result |
	result := self assertNonDuplicatedContents: aCollection whenConvertedTo: aClass.
	self assert: result size = aCollection size! !

!DictionaryTest methodsFor: 'tests - Dictionary keys values associations access' stamp: ''!
testValues
	
	| collection result |
	collection := self nonEmpty .
	result := collection values.
	
	self assert: result size = collection size.
	result do: [:each | self assert: (collection occurrencesOf:each ) = (result occurrencesOf: each) ].
	! !

!DictionaryTest methodsFor: 'tests - DictionaryIndexAccessing' stamp: ''!
testAtIfPresent
	"self run: #testAtIfAbsent"
	
	| t collection association nonExistantKey |
	collection := self nonEmpty .
	association := collection associations anyOne.
	nonExistantKey := self keyNotIn . 
	
	t := false.
	self nonEmptyDict at: association key ifPresent: [:x | t := (x = association value)].
	self assert: t.
	
	self assert: (self nonEmptyDict at: association key ifPresent: [:x | 'ABCDEF']) =  'ABCDEF'.

	self assert: (self nonEmptyDict at: nonExistantKey  ifPresent: [:x | Error signal]) isNil
! !

!DictionaryTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 15:00'!
valueNotInNonEmpty
	" return a value not included in nonEmpty"
	^ valueNotIn ! !

!DictionaryTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOfNotIn
	| result |
	result := self collectionWithoutEqualElements occurrencesOf: self elementNotInForOccurrences.
	self assert: result = 0! !

!DictionaryTest methodsFor: 'requirements' stamp: 'CamilloBruni 3/23/2013 12:16'!
supportsNilKey
	^ true! !

!DictionaryTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifferenceWithNonNullIntersection
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifferenceWithNonNullIntersection"
	"	#(1 2 3) difference: #(2 4) 
	->  #(1 3)"
	| res overlapping |
	overlapping := self collectionClass 
		with: self anotherElementOrAssociationNotIn
		with: self anotherElementOrAssociationIn.
	res := self collection difference: overlapping.
	self deny: (res includes: self anotherElementOrAssociationIn).
	overlapping do: [ :each | self deny: (res includes: each) ]! !

!DictionaryTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureOccurrencesTest
	| tmp |
	self empty.
	self assert: self empty isEmpty.
	self collectionWithoutEqualElements.
	self deny: self collectionWithoutEqualElements isEmpty.
	tmp := OrderedCollection new.
	self collectionWithoutEqualElements
		do: [ :each | 
			self deny: (tmp includes: each).
			tmp add: each ].
	self elementNotInForOccurrences.
	self deny: (self collectionWithoutEqualElements includes: self elementNotInForOccurrences)! !

!DictionaryTest methodsFor: 'tests - DictionaryIndexAccessing' stamp: ''!
testAtIfAbsent
	| collection association |
	collection := self nonEmpty .
	association := collection associations anyOne.
	
	self assert: (collection at: association key ifAbsent: [ 888 ]) = association value.
	self assert: (collection at: self keyNotIn  ifAbsent: [ 888 ]) = 888.! !

!DictionaryTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 10:16'!
collectionNotIncluded
" return a collection for wich each element is not included in 'nonEmpty' "
	^collectionNotIncluded ! !

!DictionaryTest methodsFor: 'requirement' stamp: 'delaunay 4/2/2009 11:53'!
elementNotInForOccurrences
	^ 666! !

!DictionaryTest methodsFor: 'test - equality' stamp: ''!
testEqualSignOfIdenticalCollectionObjects
	"self debug: #testEqualSignOfIdenticalCollectionObjects"
	
	self assert: (self empty = self empty). 
	self assert: (self nonEmpty = self nonEmpty). 
	! !

!DictionaryTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyCreatesNewObject
	"self debug: #testCopyCreatesNewObject"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: self nonEmpty == copy.
	! !

!DictionaryTest methodsFor: 'requirement' stamp: 'delaunay 5/5/2009 14:16'!
associationWithKeyAlreadyInToAdd
	" return an association that will be used to add to nonEmptyDict (the key of this association is already included in nonEmptyDict)"
	^ (self nonEmptyDict keys anyOne)->valueNotIn .! !

!DictionaryTest methodsFor: 'tests' stamp: 'CamilloBruni 3/23/2013 12:13'!
testSelectIsNotShallowCopy
	"self debug: #testSelectIsNotShallowCopy"
	
	| original even |
	original := self collectionClass new.
	original at: #one put: 1.
	original at: #two put: 2.

	even := original select: [:value |value even].
	even at: #two put: 'deux'.

	self assert: (original at: #two) = 2
 	   description: 'modifying a selection should not modify the original'! !

!DictionaryTest methodsFor: 'tests - Dictionary keys values associations access' stamp: ''!
testKeys
	| collection result |
	collection := self nonEmpty.
	result := collection keys.
	result do: [ :key | collection at: key ].
	self assert: result size = collection size.
	self should: [ result detect: [ :each | (result occurrencesOf: each) > 1 ] ] raise: Error! !

!DictionaryTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 11:56'!
anotherElementOrAssociationNotIn
	" return an element (or an association for Dictionary )not present  in 'collection' "
	^ associationNotIn ! !

!DictionaryTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 15:00'!
keyNotInNonEmpty
	" return a key not included in nonEmpty"
	^ keyNotIn ! !

!DictionaryTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionBasic
	"self debug: #testIntersectionBasic"
	| inter |
	inter := self collection intersection: (self collectionClass with: self anotherElementOrAssociationIn).
	self deny: inter isEmpty.
	self assert: (inter includes: self anotherElementOrAssociationIn value)! !

!DictionaryTest methodsFor: 'helpers' stamp: 'stephane.ducasse 1/12/2009 17:25'!
anotherValue

	^ 66! !

!DictionaryTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifference
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifference"
	
	| difference |
	self assert: (self collectionWithoutEqualElements difference: self collectionWithoutEqualElements) isEmpty.
	self assert: (self empty difference: self collectionWithoutEqualElements) isEmpty.
	difference := (self collectionWithoutEqualElements difference: self empty).
	self assert: difference size = self collectionWithoutEqualElements	 size.
	self collectionWithoutEqualElements do: [ :each |
		self assert: (difference includes: each)].
! !

!DictionaryTest methodsFor: 'test - testing' stamp: 'CamilloBruni 3/23/2013 12:17'!
testOccurrencesOf
	"self run:#testOccurrencesOf" 
	
	| dict |
	dict := self collectionClass new.
	dict at: #a put: 1.
	dict at: #b put: 2.
	dict at: #c put: 1.
	dict at: #d put: 3.
	dict at: nil put: nil.
	dict at: #z put: nil.
	
	
	self assert: (dict occurrencesOf: 1 ) equals: 2.
	self supportsNilKey 
		ifTrue: [ 	self assert: (dict occurrencesOf: nil ) equals: 2 ]
		ifFalse: [ 	self assert: (dict occurrencesOf: nil ) equals: 1 ].	
	
	
	! !

!DictionaryTest methodsFor: 'tests - dictionnary enumerating' stamp: ''!
testKeysAndValuesDo

	
	| collection keys |
	collection := self nonEmptyDict .
	keys := OrderedCollection new.
	collection keysAndValuesDo: [ :key :value | 
		keys add: key.
		self assert: (collection at: key) = value ].
	
	collection keys do: [ :key | self assert: (collection keys occurrencesOf: key) = (keys occurrencesOf: key)]! !

!DictionaryTest methodsFor: 'tests - converting' stamp: ''!
testAsOrderedCollection
	
	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: OrderedCollection! !

!DictionaryTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionItself
	"self debug: #testIntersectionItself"
	
	| result |
	result :=  (self collectionWithoutEqualElements intersection: self collectionWithoutEqualElements).
	self assert: result size  = self collectionWithoutEqualElements size.
	self collectionWithoutEqualElements do: [ :each|
		self assert: (result includes: each) ].
	! !

!DictionaryTest methodsFor: 'requirements' stamp: 'delaunay 5/13/2009 15:54'!
elementTwiceInForOccurrences
" return an element included exactly two time in # collectionWithEqualElements"
^ duplicateValue ! !

!DictionaryTest methodsFor: 'tests - fixture' stamp: ''!
test0CopyTest
	self empty.
	self assert: self empty size = 0.
	self nonEmpty.
	self assert: (self nonEmpty size = 0) not.
	self collectionWithElementsToRemove.
	self assert: (self collectionWithElementsToRemove size = 0) not.
	self collectionWithElementsToRemove do: [ :each | self assert: (self nonEmpty includes: each) ].
	self elementToAdd.
	self deny: (self nonEmpty includes: self elementToAdd).
	self collectionNotIncluded.
	self collectionNotIncluded do: [ :each | self deny: (self nonEmpty includes: each) ]! !

!DictionaryTest methodsFor: 'test - testing' stamp: 'damienpollet 1/30/2009 17:55'!
testIncludeAssociation
	self assert: (nonEmptyDict includesAssociation: #a -> self elementTwiceIn).
	self assert: (nonEmptyDict includesAssociation: (nonEmptyDict associations first)).
! !

!DictionaryTest methodsFor: 'test - adding' stamp: ''!
testAddAll
	
	| collectionToAdd collection result oldSize |
	collection := self nonEmptyDict .
	oldSize := collection size.
	collectionToAdd := self collectionClass new 
		add: self associationWithKeyAlreadyInToAdd ; 
		add: self associationWithKeyNotInToAdd ; 
		yourself.
	
	result := collection addAll: collectionToAdd .
	
	self assert: result = collectionToAdd .
	"  the association with the key already in should have replaced the oldest :"
	self assert: collection  size = (oldSize + 1).
	
	result associationsDo: [:assoc | self assert: (collection at:  (assoc key) ) = assoc value].! !

!DictionaryTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 16:08'!
element
	^ 30! !

!DictionaryTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 16:04'!
otherCollection
	"Returns a collection that does not include what is returned by #element."
	^ nonEmpty5ElementsNoDuplicates ! !

!DictionaryTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 10:12'!
indexInNonEmpty
" return an index between bounds of 'nonEmpty' "

	^ #a! !

!DictionaryTest methodsFor: 'tests - DictionaryIndexAccessing' stamp: ''!
testAtPutNil
	"self run: #testAtPut"
	"self debug: #testAtPut"
	
	| aDictionary keyIn |
	aDictionary := self nonEmpty .
	keyIn := aDictionary keys anyOne.
	
	aDictionary at: nil put: 'new'.
	self assert: (aDictionary at: nil) = 'new'.
	
	aDictionary at: keyIn  put: nil.
	self assert: (aDictionary at: keyIn ) isNil.
	
	aDictionary at: self keyNotIn put: nil.
	self assert: ( aDictionary at: self keyNotIn ) isNil.
	
	aDictionary at: nil put: nil.
	self assert: (aDictionary at: nil) isNil.! !

!DictionaryTest methodsFor: 'requirement' stamp: 'CamilloBruni 3/23/2013 12:06'!
result
	^ self collectionClass newFromPairs: {
		#a . SmallInteger .
		#b . SmallInteger .
		#c . SmallInteger .
		#d . SmallInteger }! !

!DictionaryTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedCollection

	| aCollection result |
	aCollection := self collectionWithSortableElements .
	result := aCollection asSortedCollection.
	
	self assert: (result class includesBehavior: SortedCollection).
	result do: 
		[ :each | 
		self assert: (aCollection occurrencesOf: each) = (result occurrencesOf: each) ].
	
	self assert: result size = aCollection size.! !

!DictionaryTest methodsFor: 'test - equality' stamp: ''!
testEqualSign
	"self debug: #testEqualSign"

	self deny: (self empty = self nonEmpty).! !

!DictionaryTest methodsFor: 'tests - dictionnary enumerating' stamp: ''!
testAssociationsSelect
	| collection keys result |
	collection := self nonEmptyDict .
	keys := OrderedCollection new.
	result := collection associationsSelect: [ :assoc  | 
		keys add: assoc key.
		true].
	
	collection keys do: [ :key | self assert: (collection keys occurrencesOf: key) = (keys occurrencesOf: key)].
	self assert: result = collection.! !

!DictionaryTest methodsFor: 'requirements' stamp: ''!
collectionClass
" return the class to be used to create instances of the class tested"
	^ self explicitRequirement! !

!DictionaryTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 15:24'!
nonEmpty1Element
" return a collection of size 1 including one element"
	^ nonEmpty1Element ! !

!DictionaryTest methodsFor: 'requirements' stamp: 'delaunay 5/5/2009 10:41'!
valueNotIn
" return a value not included in nonEmpty "
^valueNotIn ! !

!DictionaryTest methodsFor: 'tests - set arithmetic' stamp: ''!
testUnion
	"self debug: #testUnionOfEmpties"
	
	| union |
	union := self empty union: self nonEmpty.
	self containsAll: union of: self empty andOf: self nonEmpty.
	union := self nonEmpty union: self empty.
	self containsAll: union of: self empty andOf: self nonEmpty.
	union := self collection union: self nonEmpty.
	self containsAll: union of: self collection andOf: self nonEmpty.! !

!DictionaryTest methodsFor: 'tests' stamp: 'CamilloBruni 3/23/2013 12:10'!
testAtIfPresentIfAbsent
	"Test at:ifPresent:ifAbsent:"
	
	"to move to the corresponding trait"
	| dict present absent |
	dict := self collectionClass new.
	present := absent := false.
	dict at: #foo ifPresent: [:v| present := true] ifAbsent: [absent := true].
	self deny: present.
	self assert: absent.

	dict at: #foo put: #bar.
	present := absent := false.
	dict at: #foo ifPresent: [:v| present := true] ifAbsent: [absent := true].
	self assert: present.
	self deny: absent.

	present := absent := false.
	dict at: #foo ifPresent: [:v| present := true. nil] ifAbsent: [absent := true].
	self assert: present.
	self deny: absent.
! !

!DictionaryTest methodsFor: 'tests - dictionnary enumerating' stamp: ''!
testDo
	| t collection |
	collection := self nonEmptyDict .
	t := OrderedCollection new.
	collection do: [:
		value | t add: value
		].
	
	t do: [ :each | self assert: (t occurrencesOf: each ) = ( collection values occurrencesOf: each) ].! !

!DictionaryTest methodsFor: 'requirements' stamp: 'delaunay 5/12/2009 11:07'!
nonEmptyWithCopyNonIdentical.
" return a collection including elements for wich copy is not identical to the initial element ( this is not the cas of Integer )"
^nonEmptyWithFloat ! !

!DictionaryTest methodsFor: 'test - testing' stamp: 'CamilloBruni 3/23/2013 12:12'!
testIncludesAssociationNoValue

	| association dictionary |
	
	association := Association key: #key.
	
	self assert: association value isNil.
	
	dictionary := self collectionClass new.
	
	dictionary add: association.
	
	self assert: (dictionary at: #key) isNil

	
	
	! !

!DictionaryTest methodsFor: 'tests - copy' stamp: ''!
testCopySameClass
	"self debug: #testCopySameClass"
	"A copy of a collection should always be of the same class as the instance it copies"
	
	| copy | 
	copy := self empty copy.
	self assert: copy class == self empty class.! !

!DictionaryTest methodsFor: 'tests - dictionary key access' stamp: 'GabrielOmarCotelli 5/25/2010 21:22'!
testKeyAtIdentityValueIfAbsent
	"self run: #testKeyAtValue"

	"self debug: #testKeyAtValue"

	| dict value result |
	dict := self nonEmpty.
	value := dict values anyOne.
	result := dict keyAtIdentityValue: value ifAbsent: [ nil ].
	self assert: (dict at: result) = value.
	self assert: (dict keyAtIdentityValue: self valueNotIn ifAbsent: [ nil ]) isNil! !

!DictionaryTest methodsFor: 'requirement' stamp: 'damienpollet 1/21/2009 18:04'!
speciesClass
	^ Dictionary! !

!DictionaryTest methodsFor: 'tests - set arithmetic' stamp: ''!
containsAll: union of: one andOf: another
			
	self assert: (one allSatisfy: [:each | union includes: each]).
	self assert: (another allSatisfy: [:each | union includes: each])! !

!DictionaryTest methodsFor: 'tests - dictionary key access' stamp: 'GabrielOmarCotelli 5/25/2010 21:22'!
testKeyAtValueIfAbsent
	"self run: #testKeyAtValue"

	"self debug: #testKeyAtValue"

	| dict value result |
	dict := self nonEmpty.
	value := dict values anyOne.
	result := dict keyAtValue: value ifAbsent: [ nil ].
	self assert: (dict at: result) = value.
	self assert: (dict keyAtValue: self valueNotIn ifAbsent: [ nil ]) isNil! !

!DictionaryTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureDictionaryAssocitionAccess
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self keyNotIn.
	self deny: (self nonEmpty keys includes: self keyNotIn)! !

!DictionaryTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsCommaStringOne
	
	self nonEmpty1Element do: 
		[:each | 
		self assert: each asString =self nonEmpty1Element  asCommaString.
		self assert: each asString=self nonEmpty1Element  asCommaStringAnd.].

	! !

!DictionaryTest methodsFor: 'tests - fixture' stamp: ''!
test0FixturePrintTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty! !

!DictionaryTest methodsFor: 'requirement' stamp: 'damienpollet 1/21/2009 18:22'!
expectedElementByDetect
	^ 30! !

!DictionaryTest methodsFor: 'tests - dictionnary enumerating' stamp: ''!
testKeysDo
	| collection keys |
	collection := self nonEmptyDict .
	keys := OrderedCollection new.
	collection keysDo: [ :key  | 
		keys add: key.
		].
	
	collection keys do: [ :key | self assert: (collection keys occurrencesOf: key) = (keys occurrencesOf: key)]! !

!DictionaryTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAllNoneThere
	"self debug: #testIncludesAllOfNoneThere'"
	self deny: (self empty includesAll: self nonEmpty ).
	self deny: (self nonEmpty includesAll: { self elementNotIn. self anotherElementNotIn })! !

!DictionaryTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 14:51'!
elementNotIn
	"return an element not included in 'nonEmpty' "
	^ valueNotIn! !

!DictionaryTest methodsFor: 'setup' stamp: 'delaunay 5/13/2009 15:54'!
setUp
	emptyDict := self classToBeTested new.
	nonEmptyDict := self classToBeTested new.
	nonEmptyDict
		at: #a
			put: self elementTwiceIn;
		at: #b
			put: 30;
		at: #c
			put: self elementTwiceIn;
		at: #d
			put: -2.
	nonEmpty5ElementsNoDuplicates := self classToBeTested new
		at: #a
			put: 5;
		at: #b
			put: 4;
		at: #c
			put: 7;
		at: #d
			put: 6;
		at: #e
			put: 9;
		yourself.
	valueNotIn := 666.
	keyNotIn := #z .
	associationNotIn := keyNotIn->valueNotIn.
	dictionaryNotIncluded := Dictionary new add: associationNotIn ;yourself.
	collectionNotIncluded := {  valueNotIn. valueNotIn  }.
	collectionIncluded := {  (self elementTwiceIn)  }.
	indexArray := #(2 3 1 ).
	valueArray := #(5 5 5 ).
	nonEmpty1Element := self classToBeTested new
		at: #a
			put: 5;
		yourself.
	nonEmptyWithFloat := Dictionary new add: #A->2.5; add: #b->3.5 ; yourself.
	duplicateValue := 2.5.
	dictionaryWithDuplicateValues := 	Dictionary new add: #A->duplicateValue ; add: #b->3.5 ; add: #C->duplicateValue  ; yourself.

! !

!DictionaryTest methodsFor: 'tests - DictionaryIndexAccessing' stamp: ''!
testAtError
	"self run: #testAtError"

	| dict nonExistantKey keyIn |
	dict := self nonEmpty.
	nonExistantKey := self keyNotIn.
	keyIn := dict keys anyOne.
	dict at: keyIn.
	self should: [ dict at: nonExistantKey ] raise: Error! !

!DictionaryTest methodsFor: 'tests - DictionaryIndexAccessing' stamp: ''!
testAt
	| collection association |
	collection := self nonEmpty .
	association := collection associations anyOne.
	
	self assert: (collection at: association key) = association value.! !

!DictionaryTest methodsFor: 'test - adding' stamp: 'delaunay 5/5/2009 12:08'!
testAddWithKeyNotIn
	| dictionary result association |
	dictionary := self nonEmptyDict.
	association := self associationWithKeyNotInToAdd.
	result := dictionary add: association.
	self assert: result = association.
	self assert: (dictionary at: association key) = association value! !

!DictionaryTest methodsFor: 'tests - printing' stamp: ''!
testPrintOnDelimiterLast

	| aStream result allElementsAsString tmp |
	result:=''.
	aStream:= ReadWriteStream on: result.
	tmp:= OrderedCollection new.
	self nonEmpty do: [:each | tmp add: each asString].
	
	self nonEmpty printOn: aStream delimiter: ', ' last: 'and'.
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 )
			ifTrue: [self assert: (tmp occurrencesOf: (allElementsAsString at:i))=(allElementsAsString  occurrencesOf: (allElementsAsString at:i))].
		i=(allElementsAsString size-1)
			ifTrue:[ self deny: (allElementsAsString at:i)=('and')asString].
		i=(allElementsAsString size)
			ifTrue: [self assert: (tmp occurrencesOf: (allElementsAsString at:i))=(allElementsAsString  occurrencesOf: (allElementsAsString at:i))].
			].! !

!DictionaryTest methodsFor: 'tests - converting' stamp: ''!
testAsBag

	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: Bag! !

!DictionaryTest methodsFor: 'test - copying' stamp: ''!
testDictionaryConcatenationWithCommonKeys

	| dictionary1 dictionary2 result |
	dictionary1 := self nonEmptyDict.
	dictionary2 := self nonEmptyDict.
	result := dictionary1 , dictionary2.
	self assert: result size = ( dictionary2 size).
	
	dictionary2 associationsDo: [ :assoc | self assert: (result at: assoc key) = assoc value ]! !

!DictionaryTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsStringOnDelimiterOne

	| delim oneItemStream result |

	delim := ', '.
	result:=''.
	oneItemStream := ReadWriteStream on: result.
	self nonEmpty1Element  asStringOn: oneItemStream delimiter: delim.
	oneItemStream  do:
		[:each1 |
		self nonEmpty1Element do: [:each2 |self assert: each1 = (each2 asString) ]
		 ].
	
! !

!DictionaryTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWith
	"self debug: #testCopyWith"
	| res anElement |
	anElement := self elementToAdd.
	res := self empty copyWith: anElement.
	self assert: res size = (self empty size + 1).
	self assert: (res includes: (anElement value))! !

!DictionaryTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureConverAsSortedTest
	self collectionWithSortableElements.
	self deny: self collectionWithSortableElements isEmpty! !

!DictionaryTest methodsFor: 'requirements' stamp: 'delaunay 5/5/2009 10:41'!
nonEmptyWithoutEqualsValues
" return a dictionary that doesn't include equal values'"
^nonEmpty5ElementsNoDuplicates ! !

!DictionaryTest methodsFor: 'tests - dictionary key access' stamp: ''!
testKeyAtIdentityValue
	
	
	| dict value result |
	dict := self nonEmpty .
	value := dict values anyOne.
	
	result := dict keyAtIdentityValue: value.
	self assert: (dict at: result) = value.
		
	self should: [dict keyAtIdentityValue: self valueNotIn ] raise: Error
	
	! !

!DictionaryTest methodsFor: 'tests - printing' stamp: ''!
testStoreOn
" for the moment work only for collection that include simple elements such that Integer"

"| string str result cuttedResult index elementsAsStringExpected elementsAsStringObtained tmp |
string := ''.
str := ReadWriteStream  on: string.
elementsAsStringExpected := OrderedCollection new.
elementsAsStringObtained := OrderedCollection new.
self nonEmpty do: [ :each | elementsAsStringExpected  add: each asString].

self nonEmpty storeOn: str.
result := str contents .
cuttedResult := ( result findBetweenSubStrs: ';' ).

index := 1.

cuttedResult do:
	[ :each |
	index = 1 
		ifTrue: [ self assert: (each beginsWith: ( tmp := '((' , self nonEmpty class asString , ' new) add: '           )).
				tmp := each copyFrom: ( tmp size + 1) to: ( each size ).
				elementsAsStringObtained add: tmp.
				index := index + 1. ]
		ifFalse:  [ 
		 index < cuttedResult size
			ifTrue:[self assert: (each beginsWith: ( tmp:=  ' add: '   )).
				tmp := each copyFrom: ( tmp size + 1) to: ( each size ).
				elementsAsStringObtained add: tmp.
					index := index + 1.]
			ifFalse: [self assert: ( each = ' yourself)' ) ].
			]
	
	].


	elementsAsStringExpected do: [ :each | self assert: (elementsAsStringExpected occurrencesOf: each ) = ( elementsAsStringObtained occurrencesOf: each) ]"

! !

!DictionaryValueHolder commentStamp: 'BenjaminVanRyseghem 1/23/2014 15:18'!
I am designed specifically for dictionaries.!
!DictionaryValueHolder methodsFor: 'protocol' stamp: 'ClementBera 8/4/2014 09:36'!
at: key ifAbsentPut: aBlock 

	^ value at: key ifAbsent: [self at: key put: aBlock value]! !

!DictionaryValueHolder methodsFor: 'override' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
size 

	^ value size! !

!DictionaryValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
atNewIndex: index put: anObject
	
	value atNewIndex: index put: anObject.
	self valueChanged: anObject.! !

!DictionaryValueHolder methodsFor: 'protocol' stamp: ''!
removeKey: key 
	"Remove key from the receiver.
	If key is not in the receiver, notify an error."
	
	^ self removeKey: key ifAbsent: [self errorKeyNotFound: key].! !

!DictionaryValueHolder methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
initialize: n
	
	value initialize: n.
	self valueChanged.! !

!DictionaryValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
valueAtNewKey: aKey put: anObject atIndex: index declareFrom: aDictionary 
	
	value valueAtNewKey: aKey put: anObject atIndex: index declareFrom: aDictionary.
	self valueChanged.! !

!DictionaryValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
doesNotUnderstand: aMessage

	^ (value respondsTo: aMessage selector)
		ifTrue: [ value perform: aMessage selector withEnoughArguments: aMessage arguments ]
		ifFalse: [ super doesNotUnderstand: aMessage ]! !

!DictionaryValueHolder methodsFor: 'protocol' stamp: 'CamilloBruni 11/18/2013 18:11'!
fillFrom: aCollection with: aBlock
	"Evaluate aBlock with each of aCollections's elements as the argument.  
	Collect the resulting values into self. Answer self."

	aCollection keysAndValuesDo: [ :key :aValue |
		self at: key put: (aBlock value: aValue) ]! !

!DictionaryValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:57'!
at: key put: anObject

	value at: key put: anObject.
	self valueChanged: anObject.
	^ anObject! !

!DictionaryValueHolder methodsFor: 'override' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
at: anObject

	^ value at: anObject! !

!DictionaryValueHolder methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 10/17/2013 16:26'!
initialize

	super initialize.
	
	self value: Dictionary new.! !

!DictionaryValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
removeKey: key ifAbsent: aBlock 
	| result |
	
	result := value removeKey: key ifAbsent: aBlock.
	self valueChanged.
	^ result! !

!DictionaryValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
removeAll
	
	value removeAll.
	self valueChanged.! !

!DiffChangeMorph methodsFor: 'initialization' stamp: 'gvc 2/9/2010 13:12'!
initialColorInSystemWindow: aSystemWindow
	"Answer the colour the receiver should be when added to a SystemWindow."

	^Color transparent! !

!DiffChangeMorph methodsFor: 'hooks' stamp: 'gvc 2/9/2010 13:12'!
diffMorphClass
	"Answer a the class to use for a new diff morph."

	^DiffMorph! !

!DiffChangeMorph methodsFor: 'accessing' stamp: 'gvc 2/9/2010 13:12'!
defaultTitle
	"Answer the default title label for the receiver."

	^'Change Diff' translated! !

!DiffChangeMorph methodsFor: 'actions' stamp: 'gvc 2/9/2010 13:07'!
adoptPaneColor: paneColor
	"Change the fill styles on the descriptions."
	
	super adoptPaneColor: paneColor.
	paneColor ifNil: [^self].
	self descriptionMorph borderStyle: (self theme listNormalBorderStyleFor: self).
	self updateDescriptionFillStyle: paneColor
	! !

!DiffChangeMorph methodsFor: 'accessing' stamp: 'gvc 2/9/2010 13:07'!
diffMorph: anObject
	"Set the value of diffMorph"

	diffMorph := anObject! !

!DiffChangeMorph methodsFor: 'accessing' stamp: 'gvc 2/9/2010 13:07'!
diffMorph
	"Answer the value of diffMorph"

	^ diffMorph! !

!DiffChangeMorph methodsFor: 'actions' stamp: 'gvc 2/9/2010 13:12'!
fromDescription: aString
	"Set the description for the left-hand side of the patch,
	typically 'currently in image'."

	self fromDescriptionMorph contents: aString! !

!DiffChangeMorph methodsFor: 'actions' stamp: 'EstebanLorenzano 5/14/2014 17:25'!
newDescriptionMorph
	"Answer a new morph for the descriptions of the source and destination."

	^(self newColumn: {
		(self newRow: {self newLabel: 'Original'}) layoutInset: 1.
		(self newRow: {self newLabel: 'Changed'})
			layoutInset: 1;
			listCentering: #bottomRight})
		layoutInset: 0;
		cellInset: 2;
		"fillStyle: Color white;"
		borderStyle: (self theme listNormalBorderStyleFor: self)
		! !

!DiffChangeMorph methodsFor: 'initialization' stamp: 'IgorStasenko 12/19/2012 17:26'!
initialize
	"Initialize the receiver."

	|descriptionHeight|
	super initialize.
	self
		diffMorph: self newDiffMorph;
		descriptionMorph: self newDescriptionMorph.
	descriptionHeight := self descriptionMorph minExtent y.
	self
		changeProportionalLayout;
		addMorph: self descriptionMorph
		fullFrame: ((0@0 corner: 1@0) asLayoutFrame bottomOffset: descriptionHeight);
		addMorph: self diffMorph
		fullFrame: (LayoutFrame identity topOffset: descriptionHeight).
	self
		extent: self initialExtent;
		updateDescriptionFillStyle: self paneColor! !

!DiffChangeMorph methodsFor: 'actions' stamp: 'gvc 2/9/2010 13:12'!
fromDescriptionMorph
	"Answer the morph for the source description."

	^self descriptionMorph firstSubmorph firstSubmorph! !

!DiffChangeMorph methodsFor: 'actions' stamp: 'gvc 2/9/2010 13:13'!
toDescription: aString
	"Set the description for the right-hand side of the patch,
	typically 'incoming' or 'changed'."

	self toDescriptionMorph contents: aString! !

!DiffChangeMorph methodsFor: 'actions' stamp: 'gvc 2/9/2010 13:13'!
toDescriptionMorph
	"Answer the morph for the destination description."

	^self descriptionMorph lastSubmorph firstSubmorph! !

!DiffChangeMorph methodsFor: 'actions' stamp: 'gvc 2/9/2010 13:12'!
newDiffMorph
	"Answer a new morph for the source difference."

	^self diffMorphClass new
		borderStyle: (BorderStyle inset width: 1);
		font: self theme statusFont;
		addDependent: self;
		yourself! !

!DiffChangeMorph methodsFor: 'actions' stamp: 'EstebanLorenzano 5/14/2014 17:26'!
updateDescriptionFillStyle: aColor
	"Change the colours on the descriptions."
	
	self descriptionMorph fillStyle: aColor.
	self fromDescriptionMorph owner color: (aColor alpha: 0.5).
	self toDescriptionMorph owner color: (aColor alpha: 0.3).! !

!DiffChangeMorph methodsFor: 'accessing' stamp: 'gvc 2/9/2010 13:07'!
descriptionMorph: anObject
	"Set the value of descriptionMorph"

	descriptionMorph := anObject! !

!DiffChangeMorph methodsFor: 'actions' stamp: 'gvc 2/9/2010 13:10'!
from: old to: new contextClass: aClass
	"Set the old (src) and new (dst) text."

	self diffMorph
		from: old
		to: new
		contextClass: aClass! !

!DiffChangeMorph methodsFor: 'accessing' stamp: 'gvc 2/9/2010 13:07'!
descriptionMorph
	"Answer the value of descriptionMorph"

	^ descriptionMorph! !

!DiffChangeMorph methodsFor: 'user interface' stamp: 'gvc 3/5/2010 12:43'!
initialExtent
	"Answer the initial extent for the receiver."

	^RealEstateAgent standardWindowExtent! !

!DiffChangeMorph class methodsFor: 'instance creation' stamp: 'gvc 2/9/2010 13:10'!
from: old label: oldLabel to: new label: newLabel contextClass: aClass
	"Answer a new instance of the receiver with the given
	old and new text and descriptions."

	^self new
		from: old
		to: new
		contextClass: aClass;
		fromDescription: oldLabel;
		toDescription: newLabel! !

!DiffChangeRecordConverter commentStamp: '<historical>'!
A DiffChangeRecordConverter is a converter used to show the diff between two methodreferences!
!DiffChangeRecordConverter methodsFor: 'private' stamp: 'MarcusDenker 11/3/2014 15:30'!
priorVersionOfAMethod: aChangeRecord
	| index mylist |
	
	mylist := referencesList sorted: [:a :b | a timeStamp > b timeStamp ].
	index := mylist indexOf: aChangeRecord .
	^ mylist at: index+1 ifAbsent: [ aChangeRecord ]! !

!DiffChangeRecordConverter methodsFor: 'private' stamp: 'MarcusDenker 8/8/2014 14:41'!
internalGetText	

	^TextDiffBuilder
		 buildDisplayPatchFrom: ((self priorVersionOfAMethod: method) sourceCode) 
		to: (method sourceCode) 
		inClass: (method className)! !

!DiffElement commentStamp: 'HenrikSperreJohansen 5/21/2010 01:41'!
My instances are container objects used by TextDiffBuilder for comparison. They hold a string and the precomputed hash of the string to speed up #=. They may reference another DiffElement object which is their pair in the diff.

Instance Variables
	hash:		<Integer>
	match:		<DiffElement>
	string:		<String>

hash
	- the hash of string, stored for fast access

match
	- another DiffElement object which has the same string and turned out to be my pair in the longest common subsequence found by a TextDiffBuilder, or nil if I don't a matching DiffElement

string
	- a part of a longer text, typically a line
!
!DiffElement methodsFor: 'comparing' stamp: 'HenrikSperreJohansen 5/21/2010 01:50'!
hash

	^hash! !

!DiffElement methodsFor: 'comparing' stamp: 'HenrikSperreJohansen 5/21/2010 01:50'!
= anObject

	^anObject class == self class and: [
		anObject hash = hash and: [
			anObject string = string ] ]! !

!DiffElement methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 5/21/2010 01:51'!
match

	^match! !

!DiffElement methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 5/21/2010 01:50'!
string: aString

	string := aString.
	string isOctetString ifTrue: [ "Make sure that #hash will return the same value if the strings are equal."
		string := string asOctetString ].
	hash := string hash! !

!DiffElement methodsFor: 'testing' stamp: 'HenrikSperreJohansen 5/21/2010 01:51'!
hasMatch

	^match notNil! !

!DiffElement methodsFor: 'printing' stamp: 'HenrikSperreJohansen 5/21/2010 01:51'!
printOn: aStream

	super printOn: aStream.
	aStream
		nextPut: $(;
		print: hash;
		nextPutAll: ', ';
		print: string;
		nextPutAll: ', ';
		print: (match class == self class);
		nextPut: $)! !

!DiffElement methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 5/21/2010 01:51'!
string

	^string! !

!DiffElement methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 5/21/2010 01:51'!
matches: aDiffMatch

	match := aDiffMatch.
	aDiffMatch match: self! !

!DiffElement methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 5/21/2010 01:51'!
match: aDiffMatch

	match := aDiffMatch
	! !

!DiffElement class methodsFor: 'instance creation' stamp: 'HenrikSperreJohansen 5/21/2010 01:49'!
string: aString

	^self new
		string: aString;
		yourself! !

!DiffJoinMorph methodsFor: 'initialize' stamp: 'gvc 10/20/2006 14:21'!
defaultColor
	"Answer the default color for the receiver."

	^Color transparent! !

!DiffJoinMorph methodsFor: 'geometry' stamp: 'gvc 10/31/2006 13:18'!
extent: aPoint
	"Update the shapes of the joins."
	
	super extent: aPoint.
	self updateMappings! !

!DiffJoinMorph methodsFor: 'drawing' stamp: 'gvc 10/31/2006 12:08'!
drawOn: aCanvas
	"Draw the indicators for the mappings."
	
	super drawOn: aCanvas.
	aCanvas translateBy: self topLeft clippingTo: self clippingBounds during: [:c |
		self mappings do: [:j | j drawOn: c]]! !

!DiffJoinMorph methodsFor: 'accessing' stamp: 'gvc 10/31/2006 11:33'!
dstOffset: anInteger
	"Set the dstOffset."

	dstOffset := anInteger.
	self mappings do: [:j |
		j dstOffset: anInteger]! !

!DiffJoinMorph methodsFor: 'accessing' stamp: 'gvc 10/31/2006 11:33'!
srcOffset: anInteger
	"Set the srcOffset."

	srcOffset := anInteger.
	self mappings do: [:j |
		j srcOffset: anInteger]! !

!DiffJoinMorph methodsFor: 'accessing' stamp: 'gvc 10/24/2006 16:02'!
dstOffset
	"Answer the value of dstOffset"

	^ dstOffset! !

!DiffJoinMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/31/2006 13:18'!
updateMappings
	"Update the shapes of the joins."
	
	self mappings do: [:j |
		j width: self width]! !

!DiffJoinMorph methodsFor: 'initialization' stamp: 'gvc 10/31/2006 11:44'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		mappings: OrderedCollection new;
		srcOffset: 0@0;
		dstOffset: 0@0! !

!DiffJoinMorph methodsFor: 'accessing' stamp: 'gvc 10/20/2006 11:50'!
mappings
	"Answer the value of mappings"

	^ mappings! !

!DiffJoinMorph methodsFor: 'layout' stamp: 'gvc 10/31/2006 13:18'!
layoutBounds: aRectangle
	"Set the bounds for laying out children of the receiver."
	
	super layoutBounds: aRectangle.
	self updateMappings! !

!DiffJoinMorph methodsFor: 'accessing' stamp: 'gvc 10/31/2006 13:19'!
mappings: anObject
	"Set the value of mappings"

	mappings := anObject.
	self updateMappings.
	self changed! !

!DiffJoinMorph methodsFor: 'accessing' stamp: 'gvc 10/24/2006 16:02'!
srcOffset
	"Answer the value of srcOffset"

	^ srcOffset! !

!DiffJoinMorph methodsFor: 'event handling' stamp: 'GabrielOmarCotelli 11/30/2013 16:23'!
mouseDown: evt
	"Check for a click."

	self mappings
		detect: [ :j | j containsPoint: evt position - self topLeft ]
		ifFound: [ :cj | 
			cj clicked.
			self triggerEvent: #joinClicked ].
	super mouseDown: evt! !

!DiffJoinMorph methodsFor: 'as yet unclassified' stamp: 'gvc 7/30/2009 13:43'!
compositeText
	"Answer the composite text based on the selection state
	of the joins."

	|t|
	t := Text new.
	self mappings do: [:j |
		j appendToCompositeText: t].
	^t! !

!DiffJoinMorph class methodsFor: 'as yet unclassified' stamp: 'gvc 2/3/2010 16:20'!
splitterWidth
	"Answer the width of splitter to use for dif joins."
	
	^30! !

!DiffMapMorph methodsFor: 'initialization' stamp: 'gvc 10/26/2006 14:08'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		mappings: #()! !

!DiffMapMorph methodsFor: 'accessing' stamp: 'gvc 10/26/2006 14:10'!
defaultColor
	"Answer the default color for the receiver."

	^Color white! !

!DiffMapMorph methodsFor: 'accessing' stamp: 'gvc 3/21/2008 17:14'!
extent: newExtent
	"Update the gradient."
	
	super extent: newExtent.
	(self fillStyle notNil and: [self fillStyle isOrientedFill])
		ifTrue: [self fillStyle direction: 0@self height]! !

!DiffMapMorph methodsFor: 'nil' stamp: 'gvc 10/26/2006 15:05'!
drawOn: aCanvas
	"Draw the indicators for the mappings."
	
	|b f|
	b := self innerBounds insetBy: 2.
	super drawOn: aCanvas.
	b height < 1 ifTrue: [^self].
	f := self mappingsHeight.
	f < 1 ifTrue: [^self].
	f := b height / f.
	aCanvas clipBy: self clippingBounds during: [:c |
		self mappings do: [:j |
			j drawMapOn: c in: b scale: f]]! !

!DiffMapMorph methodsFor: 'accessing' stamp: 'gvc 10/26/2006 13:57'!
mappings
	"Answer the value of mappings"

	^ mappings! !

!DiffMapMorph methodsFor: 'as yet unclassified' stamp: 'gvc 11/1/2006 10:51'!
mappingsHeight
	"Answer the maximum y of all the mappings."
	
	self mappings ifEmpty: [^0].
	^self mappings last dst range last ! !

!DiffMapMorph methodsFor: 'accessing' stamp: 'gvc 10/26/2006 14:15'!
mappings: anObject
	"Set the value of mappings"

	mappings := anObject.
	self changed! !

!DiffMapMorph methodsFor: 'as yet unclassified' stamp: 'gvc 2/10/2010 13:28'!
mouseDown: event
	"Trigger a 0..1 range based on location."
	
	|b|
	b := self innerBounds insetBy: 2.
	self
		triggerEvent: #mapClicked
		with: (((event cursorPoint y asFloat - b top / b height) 
				min: 1) max: 0)! !

!DiffMapMorph methodsFor: 'accessing' stamp: 'gvc 10/26/2006 15:12'!
gradientRampForColor: c
	"Answer the background gradient ramp to use."
	
	^{0.0->c darker duller. 0.1-> c lighter.
		0.9->c twiceLighter. 1.0->c darker}! !

!DiffMapMorph methodsFor: 'as yet unclassified' stamp: 'gvc 2/10/2010 13:30'!
handlesMouseDown: anEvent
	"Answer true to report mouse down activity."
	
	^true! !

!DiffMapMorph methodsFor: 'accessing' stamp: 'gvc 10/26/2006 15:11'!
adoptPaneColor: paneColor
	"Change our border color too."
	
	|c|
	super adoptPaneColor: paneColor.
	paneColor ifNil: [^self].
	c := paneColor alphaMixed: 0.1 with: Color white.
	self fillStyle: ((GradientFillStyle
			ramp: (self gradientRampForColor: c))
		origin: self bounds topLeft;
		direction: 0@ self height).
	self borderStyle baseColor: paneColor! !

!DiffModel commentStamp: '<historical>'!
I am a Spec widget useful for visualising differences between two strings.

When a classContext: is setted, the strings are highlighted using such contextual information.

Examples:

self exampleWithoutOptions.
self exampleWithOptions.!
!DiffModel methodsFor: '*Spec-Tools-VersionBrowser' stamp: 'BenjaminVanRyseghem 10/18/2013 14:48'!
behavior
	^ self contextClass! !

!DiffModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/21/2013 22:29'!
showBoth

	showOnlySource rawValue: false.
	showOnlyDestination rawValue: false.
	self changed: #showBoth with: { }! !

!DiffModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/21/2013 22:33'!
showOnlyDestination: aBoolean

	showOnlyDestination rawValue: false.
	showOnlyDestination value: aBoolean.! !

!DiffModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
rightText: anObject

	rightTextHolder value: anObject ! !

!DiffModel methodsFor: '*Spec-Tools-VersionBrowser' stamp: 'BenjaminVanRyseghem 10/18/2013 14:21'!
getText

	^ self rightText! !

!DiffModel methodsFor: '*Spec-Tools-VersionBrowser' stamp: 'BenjaminVanRyseghem 10/18/2013 14:24'!
doItReceiver: aReceiver! !

!DiffModel methodsFor: '*Spec-Tools-VersionBrowser' stamp: 'BenjaminVanRyseghem 10/18/2013 14:23'!
aboutToStyle: aBoolean! !

!DiffModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
showOptions: aBoolean

	showOptions value: aBoolean! !

!DiffModel methodsFor: '*Spec-Tools-VersionBrowser' stamp: 'BenjaminVanRyseghem 10/18/2013 14:27'!
text: aPairOfString

	(aPairOfString isText or: [aPairOfString isString])
		ifTrue: [
			self leftText: ''.
			self rightText: aPairOfString
			 ]
		ifFalse: [
			self leftText: aPairOfString first.
			self rightText: aPairOfString second ]! !

!DiffModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
leftText

	^ leftTextHolder value! !

!DiffModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
rightText

	^ rightTextHolder value! !

!DiffModel methodsFor: 'initialization' stamp: 'DucasseStephane 9/10/2014 09:59'!
initialize

	super initialize.
	
	leftTextHolder := '' asValueHolder.
	rightTextHolder := '' asValueHolder.
	contextClassHolder := nil asValueHolder.
	showOptions := true asValueHolder.
	showOnlyDestination := false asValueHolder.
	showOnlySource := false asValueHolder.	
		
	leftTextHolder whenChangedDo: [ :newText | self changed: #leftText: with: { newText } ].
	rightTextHolder whenChangedDo: [ :newText | self changed: #rightText: with: { newText } ].
	contextClassHolder whenChangedDo: [ :newClass | self changed: #contextClass: with: { newClass } ].	
	showOptions whenChangedDo: [ :aBoolean | self changed: #showOptions: with: { aBoolean }].	
	showOnlyDestination whenChangedDo: [:aBoolean | self changed: #showOnlyDestination: with: { aBoolean } ].
	showOnlySource whenChangedDo: [:aBoolean | self changed: #showOnlySource: with: { aBoolean } ]! !

!DiffModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
contextClass: anObject

	contextClassHolder value: anObject ! !

!DiffModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/21/2013 17:15'!
showOnlyDestination

	^ showOnlyDestination value! !

!DiffModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/21/2013 22:11'!
showOnlySource

	^ showOnlySource value! !

!DiffModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/21/2013 22:32'!
showOnlySource: aBoolean

	showOnlyDestination rawValue: false.
	showOnlySource value: aBoolean! !

!DiffModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
leftText: anObject

	leftTextHolder value: anObject ! !

!DiffModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
contextClass

	^ contextClassHolder value! !

!DiffModel methodsFor: '*Spec-Tools-VersionBrowser' stamp: 'BenjaminVanRyseghem 10/18/2013 14:23'!
behavior: aClass

	self contextClass: aClass! !

!DiffModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
showOptions

	^ showOptions value! !

!DiffModel class methodsFor: 'example' stamp: 'MartinDias 9/12/2013 17:38'!
exampleWithOptions
	"
	self exampleWithOptions
	"

	^ self new
		showOptions: true;
		leftText: (True >> #and:) sourceCode;
		rightText: (True >> #or:) sourceCode;
		contextClass: True;
		openWithSpec! !

!DiffModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 11/21/2013 18:17'!
defaultSpec
	<spec>
	
	^ #(MorphicDiffAdapter
		adapt: #(model))! !

!DiffModel class methodsFor: 'example' stamp: 'MartinDias 9/10/2013 22:59'!
exampleWithoutOptions
	"
	self exampleWithoutOptions
	"

	^ self new
		showOptions: false;
		leftText: 'Old text';
		rightText: 'New text';
		openWithSpec
! !

!DiffModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/13/2014 15:20'!
adapterName

	^ #DiffAdapter! !

!DiffMorph commentStamp: '<historical>'!
I am a morph useful for visualising differences between two strings.

When a classContext: is setted, the strings are highlighted using such contextual information.!
!DiffMorph methodsFor: 'initialization' stamp: 'MartinDias 9/12/2013 17:20'!
addMorphsWithOptions

	self 
		addMainMorphsWith: optionsPanel height.

	self
		addMorph: optionsPanel 
		fullFrame: (LayoutFrame identity
			bottomFraction: 0;
			bottomOffset: optionsPanel height)! !

!DiffMorph methodsFor: 'updating' stamp: 'gvc 12/1/2008 12:27'!
themeChanged
	"Update the scrollbar width/frame."

	|offset|
	super themeChanged.
	self scrollbarMorph width: self theme scrollbarThickness.
	offset := self scrollbarMorph width negated - self mapMorph width.
	self scrollbarMorph layoutFrame leftOffset: offset.
	self dstMorph layoutFrame rightOffset: offset! !

!DiffMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 22:29'!
showBoth

	showOnlyDestination ifTrue: [ showOnlyDestination := false ].
	showOnlySource ifTrue: [ showOnlySource := false ].
	
	self updateMorphs! !

!DiffMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 22:34'!
showOnlyDestination: aBoolean

	showOnlyDestination = aBoolean ifTrue: [ ^ self ].
	self showOnlySource: false.
	showOnlyDestination := aBoolean.
	self updateMorphs! !

!DiffMorph methodsFor: 'instance-creation' stamp: 'gvc 11/1/2006 11:07'!
newMatchJoinSectionFrom: srcRange to: dstRange
	"Answer a new match join section."

	|spl dpl sy1 sy2 dy1 dy2 c|
	spl := self srcMorph textMorph paragraph lines.
	dpl := self dstMorph textMorph paragraph lines.
	sy1 := (spl at: srcRange first) top truncated.
	sy2 := (spl at: srcRange last) bottom truncated.
	dy1 := (dpl at: dstRange first) top truncated.
	dy2 := (dpl at: dstRange last) bottom truncated.
	c := self colorForType: #match.
	^self newJoinSection
		type: #match;
		borderWidth: 0;
		srcColor: c;
		dstColor: c;
		srcLineRange: srcRange;
		dstLineRange: dstRange;
		srcRange: (sy1 to: sy2);
		dstRange: (dy1 to: dy2);
		createHighlightsFrom: self srcMorph textMorph paragraph
		to: self dstMorph textMorph paragraph! !

!DiffMorph methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 11/21/2013 22:25'!
addMainMorphsWith: topOffset 
	| halfWidth leftFraction leftOffset rightFraction rightOffset |
	
	halfWidth := self joinMorph width / 2.
	leftFraction := showOnlyDestination
		ifTrue: [ 0 ]
		ifFalse: [ 0.5 ].
		
	leftOffset := showOnlyDestination
		ifTrue: [ 0 ]
		ifFalse: [ halfWidth ].
		
	rightFraction := showOnlySource
		ifTrue: [ 1 ]
		ifFalse: [ 0.5 ].
		
	rightOffset := showOnlySource
		ifTrue: [ 0 ]
		ifFalse: [ halfWidth negated ].
		 
	showOnlyDestination ifFalse: [
		self
			addMorph: self srcMorph
			fullFrame: (LayoutFrame identity
				rightFraction: rightFraction;
				topOffset: topOffset;
				rightOffset: rightOffset).
	showOnlySource ifFalse: [
		self		
			addMorph: self joinMorph
			fullFrame: (LayoutFrame identity
				leftFraction: 0.5;
				rightFraction: 0.5;
				leftOffset: halfWidth negated;
				rightOffset: halfWidth;
				topOffset: topOffset).
		] ].
	showOnlySource ifFalse: [
		self
			addMorph: self dstMorph
			fullFrame: (LayoutFrame identity
				leftFraction: leftFraction;
				topOffset: topOffset;
				leftOffset: leftOffset;
				rightOffset: (self scrollbarMorph width + self mapMorph width) negated) ].
				
	self				
		addMorph: self scrollbarMorph
		fullFrame: (LayoutFrame identity
			leftFraction: 1;
			leftOffset: self scrollbarMorph width negated - self mapMorph width;
			rightOffset: self mapMorph width negated;
			topOffset: topOffset).
			
	self					
		addMorph: self mapMorph
		fullFrame: (LayoutFrame identity
			leftFraction: 1;
			leftOffset: self mapMorph width negated;
			topOffset: topOffset).! !

!DiffMorph methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 5/14/2014 17:20'!
removalColor
	"Answer the color used to show removals."
	^ Color paleRed alpha: 0.5! !

!DiffMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/24/2006 16:09'!
updateJoinOffsets
	"Update the src and dst offsets in the join morph
	to match the src and dst tex scroll offsets."

	self joinMorph
		srcOffset: 0 @ self srcMorph scroller offset y negated;
		dstOffset: 0 @ self dstMorph scroller offset y negated;
		changed! !

!DiffMorph methodsFor: 'instance-creation' stamp: 'gvc 2/10/2010 13:31'!
newMapMorph
	"Answer a new map morph."

	^(DiffMapMorph new
		hResizing: #shrinkWrap;
		vResizing: #spaceFill;
		extent: 20@4;
		minWidth: 20;
		borderStyle: (BorderStyle inset width: 1))
			when: #mapClicked
			send: #mapClicked:
			to: self! !

!DiffMorph methodsFor: 'accessing' stamp: 'gvc 10/23/2006 15:47'!
scrollbarMorph: anObject
	"Set the value of scrollbarMorph"

	scrollbarMorph := anObject! !

!DiffMorph methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/21/2013 17:04'!
removeOptionsPanel

	showOptions := false.
	self removeAllMorphs.
	self addMorphsWithoutOptions! !

!DiffMorph methodsFor: 'accessing' stamp: 'gvc 10/31/2006 13:23'!
font: aFont
	"Set the font on the src and dst morphs."

	self srcMorph font: aFont.
	self dstMorph font: aFont! !

!DiffMorph methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 5/14/2014 17:57'!
colorForType: type
	"Anwser the color to use for the given change type."

	^ {self matchColor. self additionColor. self removalColor. self modificationColor}
		at: (#(match addition removal modification) indexOf: type)! !

!DiffMorph methodsFor: 'initialization' stamp: 'MarcusDenker 7/23/2014 17:43'!
initialize
	"Initialize the receiver."
	| exv exh ppCheckbox |
	
	super initialize.
	showOnlyDestination := false.
	showOnlySource := false.
	showOptions := true.
	
	self prettyPrint: TextDiffBuilder diffsWithPrettyPrint.
	ppCheckbox := self newPrettyPrintCheckboxMorph.
	optionsPanel := self newPanel 
		addMorph: ((self newRow: {ppCheckbox}) 
		listCentering: #bottomRight);
		color: self defaultColor.
	optionsPanel vResizing: #shrinkWrap.
	optionsPanel extent: optionsPanel minExtent.
	self
		srcMorph: self newSrcMorph;
		joinMorph: self newJoinMorph;
		dstMorph: self newDstMorph;
		scrollbarMorph: self newScrollbarMorph;
		mapMorph: self newMapMorph;
		changeProportionalLayout.
	self addMorphsWithOptions.
	exv := ExclusiveWeakMessageSend newSharedState.
	exh := ExclusiveWeakMessageSend newSharedState.
	self srcMorph
		when: #vScroll
			send: #srcScroll:
			to: self
			exclusive: exv;
		when: #hScroll
			send: #hScrollValue:
			to: self dstMorph
			exclusive: exh.
	self dstMorph
		when: #vScroll
			send: #dstScroll:
			to: self
			exclusive: exv;
		when: #hScroll
			send: #hScrollValue:
			to: self srcMorph
			exclusive: exh.
	self
		linkSubmorphsToSplitters;
		extent: self initialExtent.! !

!DiffMorph methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 11/22/2013 10:32'!
update: aSymbol with: aValue

	aSymbol == #showOnlyDestination
		ifTrue: [ ^ self showOnlyDestination: aValue ].
	aSymbol == #showOptions	
		ifTrue: [ ^ self showOptions: aValue ].
		
	^ super update: aSymbol with: aValue! !

!DiffMorph methodsFor: 'as yet unclassified' stamp: 'gvc 11/1/2006 10:52'!
applyHighlights
	"Apply the relevant highlights to src and dst."

	self srcMorph highlights: (self joinMappings gather: [:j | j src highlights]).
	self dstMorph highlights: (self joinMappings gather: [:j | j dst highlights])! !

!DiffMorph methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/21/2013 17:06'!
updateMorphs

	self removeAllMorphs.
	
	showOptions
		ifTrue: [ self addMorphsWithOptions ]
		ifFalse: [ self addMorphsWithoutOptions ]! !

!DiffMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/20/2006 11:26'!
oldText
	"Answer the old (src) text."

	^self srcMorph text! !

!DiffMorph methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 5/14/2014 17:56'!
textSelectionColor
	"Answer the color used for thew text selection."
	^ self theme selectionColor alpha: 0.5! !

!DiffMorph methodsFor: 'instance-creation' stamp: 'gvc 9/2/2008 15:56'!
newPrettyPrintCheckboxMorph
	"Answer a new checkbox for specifying whether to use
	pretty printing for the diff texts."

	^self
		newCheckboxFor: self
		getSelected: #prettyPrint
		setSelected: #prettyPrint:
		getEnabled: nil
		label: 'Pretty print' translated
		help: 'If selected, pretty print will be applied to any displayed method source (eliminates trivial formatting changes)' translated! !

!DiffMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 22:35'!
showOnlySource: aBoolean

	showOnlySource = aBoolean ifTrue: [ ^ self ].
	self showOnlyDestination: false.
	showOnlySource := aBoolean.
	self updateMorphs! !

!DiffMorph methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/21/2013 17:01'!
on: aModel

	aModel addDependent: self! !

!DiffMorph methodsFor: 'initialization' stamp: 'MartinDias 9/12/2013 17:20'!
addMorphsWithoutOptions
	self addMainMorphsWith: 0! !

!DiffMorph methodsFor: 'accessing' stamp: 'gvc 9/2/2008 15:38'!
contextClass
	"Answer the value of contextClass"

	^ contextClass! !

!DiffMorph methodsFor: '*Shout-Styling' stamp: 'AlainPlantec 8/28/2011 13:44'!
shoutAboutToStyle: aPluggableShoutMorphOrView
	aPluggableShoutMorphOrView classOrMetaClass: self contextClass.
	^ self contextClass notNil ! !

!DiffMorph methodsFor: 'accessing' stamp: 'gvc 10/20/2006 10:46'!
dstMorph: anObject
	"Set the value of dstMorph"

	dstMorph := anObject! !

!DiffMorph methodsFor: 'actions' stamp: 'gvc 11/1/2006 14:12'!
joinSectionClass
	"Answer the class to use for a new join section."

	^JoinSection! !

!DiffMorph methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/21/2013 17:04'!
addOptionsPanel

	showOptions := true.
	self removeAllMorphs.
	self addMorphsWithOptions! !

!DiffMorph methodsFor: 'instance-creation' stamp: 'AlainPlantec 8/28/2011 12:42'!
newSrcMorph
	"Answer a new src text morph."

	^(self newTextEditorFor: self
		getText: nil
		setText: nil
		getEnabled: nil)
		hideVScrollBarIndefinitely: true;
		borderWidth: 0;
		enabled: false;
		wrapFlag: false;
		selectionColor: self textSelectionColor;
		setText: ''! !

!DiffMorph methodsFor: 'accessing' stamp: 'gvc 10/20/2006 11:27'!
difference: anObject
	"Set the value of difference"

	difference := anObject! !

!DiffMorph methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 5/14/2014 17:57'!
matchColor
	"Answer the color used to show matches."
	^ Color transparent! !

!DiffMorph methodsFor: 'accessing' stamp: 'gvc 9/2/2008 15:21'!
dstText
	"Answer the value of dstText"

	^ dstText! !

!DiffMorph methodsFor: 'accessing' stamp: 'gvc 10/20/2006 10:46'!
srcMorph
	"Answer the value of srcMorph"

	^ srcMorph! !

!DiffMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/26/2006 14:11'!
applyMap
	"Apply the join mappings to the map morph."

	self mapMorph mappings: self joinMappings! !

!DiffMorph methodsFor: 'private' stamp: 'MartinDias 9/9/2013 15:09'!
setOptionsPanel: aBoolean
	"This is a private method. The implementation is based on the fact the options are set by default"
	
	aBoolean ifFalse: [ self removeOptionsPanel ]! !

!DiffMorph methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 5/14/2014 17:12'!
edgeColor
	"Answer the color used to show the border of the changes."
	^ Color gray alpha: 0.5! !

!DiffMorph methodsFor: 'accessing' stamp: 'gvc 9/2/2008 15:38'!
contextClass: anObject
	"Set the value of contextClass"

	contextClass := anObject! !

!DiffMorph methodsFor: 'accessing' stamp: 'gvc 10/24/2006 15:55'!
joinMappings
	"Answer the join parameters between src and dst."

	^joinMappings ifNil: [self calculateJoinMappings]! !

!DiffMorph methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 8/28/2013 10:31'!
setText
	"Set the src and dst text in the morphs applying
	prettyPrint if required."

	|src dst ctx|
	src := self srcText.
	dst := self dstText.
	ctx := self contextClass.
	(self prettyPrint and: [ctx notNil])
		ifTrue: [src isEmpty ifFalse: [
					src := ctx compiler
						source: src;
						class: ctx;
						format].
				dst isEmpty ifFalse: [
					dst := ctx compiler
						source: dst;
						class: ctx;
						format]].	
	self srcMorph setText: src; font: self theme textFont.
	self dstMorph setText: dst; font: self theme textFont! !

!DiffMorph methodsFor: 'accessing' stamp: 'gvc 10/20/2006 10:46'!
mapMorph: anObject
	"Set the value of mapMorph"

	mapMorph := anObject! !

!DiffMorph methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 5/14/2014 17:56'!
additionColor
	"Answer the color used to show additions."
	^ Color paleGreen alpha: 0.5! !

!DiffMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/20/2006 13:11'!
calculateDifference
	"Calculate the difference of the src and dst."

	self difference: ((TextDiffBuilder
		from: self oldText asString to: self newText asString)
			buildPatchSequence)! !

!DiffMorph methodsFor: 'instance-creation' stamp: 'gvc 10/20/2006 11:26'!
newText
	"Answer the new (dst) text."

	^self dstMorph text! !

!DiffMorph methodsFor: 'accessing' stamp: 'gvc 9/2/2008 15:21'!
srcText
	"Answer the value of srcText"

	^ srcText! !

!DiffMorph methodsFor: 'instance-creation' stamp: 'BenjaminVanRyseghem 11/25/2012 04:07'!
newHighlight
	"Anewser a new highlight."

	^TextHighlightByBounds new
		color: self modificationColor;
		borderWidth: 1;
		borderColor: self edgeColor! !

!DiffMorph methodsFor: 'accessing' stamp: 'gvc 10/20/2006 10:46'!
dstMorph
	"Answer the value of dstMorph"

	^ dstMorph! !

!DiffMorph methodsFor: 'accessing' stamp: 'gvc 10/23/2006 15:47'!
scrollbarMorph
	"Answer the value of scrollbarMorph"

	^ scrollbarMorph! !

!DiffMorph methodsFor: 'instance-creation' stamp: 'gvc 10/31/2006 14:08'!
newJoinSectionFrom: srcRange to: dstRange
	"Answer a new join section."

	|spl dpl sy1 sy2 dy1 dy2 t c|
	spl := self srcMorph textMorph paragraph lines.
	dpl := self dstMorph textMorph paragraph lines.
	t := #modification.
	sy1 := srcRange first > spl size
		ifTrue: [t := #addition.
				spl last bottom truncated - 1]
		ifFalse: [(spl at: srcRange first) top truncated - 1].
	sy2 := srcRange size < 1
		ifTrue: [t := #addition.
				 sy1 + 3]
		ifFalse: [srcRange last > spl size
				ifTrue: [spl last bottom truncated + 3]
				ifFalse: [(spl at: srcRange last) bottom truncated - 1]].
	dy1 := dstRange first > dpl size
		ifTrue: [t := #removal.
				dpl last bottom truncated - 1]
		ifFalse: [(dpl at: dstRange first) top truncated - 1].
	dy2 := dstRange size < 1
		ifTrue: [t := #removal.
				dy1 + 3]
		ifFalse: [dstRange last > dpl size
				ifTrue: [dpl last bottom truncated + 3]
				ifFalse: [(dpl at: dstRange last) bottom truncated - 1]].
	c := self colorForType: t.
	^self newJoinSection
		type: t;
		srcColor: c;
		dstColor: c;
		srcLineRange: srcRange;
		dstLineRange: dstRange;
		srcRange: (sy1 to: sy2);
		dstRange: (dy1 to: dy2);
		createHighlightsFrom: self srcMorph textMorph paragraph
		to: self dstMorph textMorph paragraph! !

!DiffMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/24/2006 15:56'!
calculateJoinMappings
	"Calculate the join parameters between src and dst
	and store in joinMappings."

	self joinMappings: self calculatedJoinMappings! !

!DiffMorph methodsFor: 'instance creation' stamp: 'gvc 9/2/2008 15:24'!
from: old to: new
	"Set the old (src) and new (dst) text."

	self
		srcText: old;
		dstText: new.
	self
		setText;
		calculateDifference;
		calculateJoinMappings;
		calibrateScrollbar;
		applyHighlights;
		applyJoin;
		applyMap! !

!DiffMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/23/2006 16:12'!
hideOrShowScrollBar
	"Do nothing"
	! !

!DiffMorph methodsFor: 'accessing' stamp: 'gvc 10/20/2006 10:46'!
joinMorph
	"Answer the value of joinMorph"

	^ joinMorph! !

!DiffMorph methodsFor: 'accessing' stamp: 'gvc 10/29/2006 18:23'!
adoptPaneColor: paneColor
	"Change our border color too."
	
	super adoptPaneColor: paneColor.
	paneColor ifNil: [^self].
	self borderStyle baseColor: paneColor! !

!DiffMorph methodsFor: 'accessing' stamp: 'gvc 10/20/2006 10:46'!
mapMorph
	"Answer the value of mapMorph"

	^ mapMorph! !

!DiffMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/25/2006 18:22'!
dstScroll: scrollValue
	"Called from dst when scrolled by keyboard etc."

	self scrollbarMorph value: scrollValue.
	self srcMorph vScrollBarValue: scrollValue.
	self updateJoinOffsets! !

!DiffMorph methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 5/14/2014 18:01'!
modificationColor
	"Answer the color used to show changes."
	^ Color paleYellow alpha: 0.3! !

!DiffMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 22:18'!
showOnlySource

	^ showOnlySource! !

!DiffMorph methodsFor: 'instance-creation' stamp: 'gvc 11/1/2006 14:11'!
newJoinSection
	"Answer a new join section."

	^self joinSectionClass new
		srcColor: self modificationColor;
		dstColor: self modificationColor;
		borderWidth: 1;
		borderColor: self edgeColor;
		addDependent: self;
		yourself! !

!DiffMorph methodsFor: 'instance-creation' stamp: 'BenjaminVanRyseghem 11/25/2012 04:09'!
newHighlight: type
	"Anewser a new highlight."

	^TextHighlightByBounds new
		color: (self colorForType: type);
		borderWidth: 1;
		borderColor: self edgeColor;
		fillWidth: true! !

!DiffMorph methodsFor: 'actions' stamp: 'gvc 9/2/2008 15:45'!
from: old to: new contextClass: aClass
	"Set the old (src) and new (dst) text."

	self
		contextClass: aClass;
		srcText: old;
		dstText: new.
	self
		setText;
		calculateDifference;
		calculateJoinMappings;
		calibrateScrollbar;
		applyHighlights;
		applyJoin;
		applyMap! !

!DiffMorph methodsFor: 'accessing' stamp: 'gvc 9/2/2008 15:21'!
prettyPrint
	"Answer the value of prettyPrint"

	^ prettyPrint! !

!DiffMorph methodsFor: 'user interface' stamp: 'gvc 3/5/2010 12:43'!
initialExtent
	"Answer the initial extent for the receiver."

	^RealEstateAgent standardWindowExtent! !

!DiffMorph methodsFor: 'instance-creation' stamp: 'gvc 12/1/2008 11:48'!
newScrollbarMorph
	"Answer a new scrollbar morph."

	^ScrollBar new
		model: self;
		setValueSelector: #vScroll:;
		vResizing: #spaceFill;
		width: self theme scrollbarThickness! !

!DiffMorph methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 5/14/2014 17:13'!
joinColor
	"Answer the color used for the join bar."
	^ Color paleBlue duller! !

!DiffMorph methodsFor: 'accessing' stamp: 'gvc 9/2/2008 15:21'!
dstText: anObject
	"Set the value of dstText"

	dstText := anObject! !

!DiffMorph methodsFor: 'geometry' stamp: 'gvc 10/23/2006 16:27'!
extent: newExtent
	"Update the scrollbar."

	super extent: newExtent.
	self calibrateScrollbar! !

!DiffMorph methodsFor: 'instance-creation' stamp: 'gvc 2/3/2010 16:22'!
newJoinMorph
	"Answer a new join morph."

	|w|
	w := DiffJoinMorph splitterWidth.
	^DiffJoinMorph new
		hResizing: #shrinkWrap;
		vResizing: #spaceFill;
		extent: w@4;
		minWidth: w;
		color: self joinColor! !

!DiffMorph methodsFor: 'accessing' stamp: 'gvc 7/30/2009 13:42'!
joinMappings: aCollection
	"Set the join parameters between src and dst."

	joinMappings := aCollection! !

!DiffMorph methodsFor: 'updating' stamp: 'MartinDias 9/9/2013 15:07'!
update: aSymbol

	aSymbol == #addOptions
		ifTrue: [ ^ self addOptionsPanel ].
	aSymbol == #removeOptions	
		ifTrue: [ ^ self removeOptionsPanel ].
		
	^ super update: aSymbol! !

!DiffMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/25/2006 17:55'!
join: aJoin selected: aBoolean
	"Set the selection for the given join and update the
		src dst and join morphs."

	aJoin selected: aBoolean.
	self srcMorph changed.
	self joinMorph changed.
	self dstMorph changed! !

!DiffMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/24/2006 11:11'!
applyJoin
	"Apply the join mappings to the join morph."

	self joinMorph mappings: self joinMappings! !

!DiffMorph methodsFor: 'accessing' stamp: 'gvc 10/20/2006 11:27'!
difference
	"Answer the value of difference"

	^ difference! !

!DiffMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/25/2006 18:22'!
srcScroll: scrollValue
	"Called from src when scrolled by keyboard etc.."

	self scrollbarMorph value: scrollValue.
	self dstMorph vScrollBarValue: scrollValue.
	self updateJoinOffsets! !

!DiffMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 17:10'!
showOptions: aBoolean

	showOptions = aBoolean ifTrue: [ ^ self ].
	showOptions := aBoolean.
	aBoolean
		ifTrue: [ self addOptionsPanel ]
		ifFalse: [ self removeOptionsPanel ]! !

!DiffMorph methodsFor: 'as yet unclassified' stamp: 'gvc 11/1/2006 11:04'!
defaultTitle
	"Answer the default title label for the receiver."

	^'Diff' translated! !

!DiffMorph methodsFor: 'instance-creation' stamp: 'gvc 10/26/2006 13:52'!
newDstMorph
	"Answer a new dst text morph."

	^self newSrcMorph! !

!DiffMorph methodsFor: 'accessing' stamp: 'gvc 10/20/2006 10:46'!
srcMorph: anObject
	"Set the value of srcMorph"

	srcMorph := anObject! !

!DiffMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 17:10'!
showOptions

	^ showOptions! !

!DiffMorph methodsFor: 'update' stamp: 'gvc 9/2/2008 15:23'!
updateText
	"Reset the text if we have some."

	(self srcText notNil and: [self dstText notNil]) ifTrue: [
		self from: self srcText to: self dstText]! !

!DiffMorph methodsFor: 'accessing' stamp: 'gvc 9/2/2008 15:21'!
srcText: anObject
	"Set the value of srcText"

	srcText := anObject! !

!DiffMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 17:02'!
showOnlyDestination

	^ showOnlyDestination! !

!DiffMorph methodsFor: 'as yet unclassified' stamp: 'gvc 2/10/2010 13:33'!
mapClicked: aFloat
	"Update the scrollbar value to match a click in the map."

	self scrollbarMorph
		setValue: aFloat! !

!DiffMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/25/2006 18:22'!
vScroll: scrollValue
	"Called from standalone scroolbar.
	Scroll the srcMorph and redo the join."

	self srcMorph vScrollBarValue: scrollValue.
	self dstMorph vScrollBarValue: scrollValue.
	self updateJoinOffsets! !

!DiffMorph methodsFor: 'accessing' stamp: 'gvc 9/2/2008 15:22'!
prettyPrint: aBoolean
	"Set the value of prettyPrint"

	prettyPrint == aBoolean ifTrue: [^self].
	prettyPrint := aBoolean.
	self updateText
	! !

!DiffMorph methodsFor: 'actions' stamp: 'gvc 10/31/2006 11:51'!
calculatedJoinMappings
	"Calculate the join parameters between src and dst
	and answer.
	sl = src line, dl = dst line, j = joins, ds = dst run start, ss = src run start
	de = dst run end, se = dst run end, mds = match dst start, mss = match src start"

	|sl dl j ds ss de se mds mss|
	sl := dl := 0.
	j := OrderedCollection new.
	ds := de:=  ss := se := mss := mds := 0.
	self difference do: [:p |
		p key = #match ifTrue: [
			sl := sl + 1.
			dl := dl + 1.
			mss = 0 ifTrue: [mss := sl. mds := dl].
			(ds > 0 or: [ss > 0]) ifTrue: [
				ss = 0 ifTrue: [ss := sl].
				ds = 0 ifTrue: [ds := dl].
				se = 0 ifTrue: [se := ss - 1].
				de = 0 ifTrue: [de := ds - 1].
				j add: (self newJoinSectionFrom: (ss to: se) to: (ds to: de)).
				ds := de := ss := se := 0]].
		p key = #remove ifTrue: [
			mss > 0 ifTrue: [
				j add: (self newMatchJoinSectionFrom: (mss to: sl) to: (mds to: dl)).
				mss := mds := 0].
			sl := sl + 1.
			ss = 0 ifTrue: [ss := sl].
			se := sl].
		p key = #insert ifTrue: [
			mss > 0 ifTrue: [
				j add: (self newMatchJoinSectionFrom: (mss to: sl) to: (mds to: dl)).
				mss := mds := 0].
			dl := dl + 1.
			ss > 0 ifTrue: [
				se = 0 ifTrue: [se := ss].
				de = 0 ifTrue: [de := ds].
				j add: (self newJoinSectionFrom: (ss to: se) to: (ds to: de)).
				ds := de := ss := se := 0].
			ds = 0 ifTrue: [ds := dl].
			de := dl]].
	sl := sl + 1.
	dl := dl + 1.
	(ds > 0 or: [ss > 0]) ifTrue: [
		ss = 0 ifTrue: [ss := sl ].	
		ds = 0 ifTrue: [ds := dl].
		se = 0 ifTrue: [se := ss - 1].
		de = 0 ifTrue: [de := ds - 1].
		j add: (self newJoinSectionFrom: (ss to: se) to: (ds to: de))].
	mss > 0 ifTrue: [
		j add: (self newMatchJoinSectionFrom: (mss to: sl - 1) to: (mds to: dl - 1))].
	^j! !

!DiffMorph methodsFor: 'accessing' stamp: 'gvc 10/20/2006 10:46'!
joinMorph: anObject
	"Set the value of joinMorph"

	joinMorph := anObject! !

!DiffMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/23/2006 16:29'!
calibrateScrollbar
	"Set the scrollbar parameters to match the texts."

	|maxY range delta innerH|
	self fullBounds.
	maxY := self srcMorph textExtent y max: self dstMorph textExtent y.
	innerH := self dstMorph innerBounds height.
	delta := self dstMorph textMorph defaultLineHeight.
	range := maxY - innerH max: 0.
	range = 0 ifTrue: [^self scrollbarMorph scrollDelta: 0.02 pageDelta: 0.2; interval: 1.0; setValue: 0.0].
	self scrollbarMorph
		scrollDelta: (delta / range) asFloat 
		pageDelta: ((innerH - delta) / range) asFloat;
		interval: (innerH / maxY) asFloat;
		setValue: ((self srcMorph scroller offset y max: self dstMorph scroller offset y)
					 / range min: 1.0) asFloat! !

!DiffMorph class methodsFor: 'as yet unclassified' stamp: 'gvc 10/20/2006 11:26'!
from: old to: new
	"Answer a new instance of the receiver with the given
	old and new text."

	^self new
		from: old
		to: new! !

!DiffMorph class methodsFor: 'as yet unclassified' stamp: 'gvc 9/2/2008 15:46'!
from: old to: new contextClass: aClass
	"Answer a new instance of the receiver with the given
	old and new text."

	^self new
		from: old
		to: new
		contextClass: aClass! !

!DiffMorphChangeRecordConverter commentStamp: 'NicolaiHess 1/19/2014 23:41'!
A DiffMorphChangeRecordConverter is a converter used to show the diff between two methodreferences with a side by side view.!
!DiffMorphChangeRecordConverter methodsFor: 'private' stamp: 'NicolaiHess 1/21/2014 09:29'!
priorVersionOfAMethod: aChangeRecord
	| index |
	index := referencesList identityIndexOf: aChangeRecord .
	^ referencesList at: index+1 ifAbsent: [ nil ]! !

!DiffMorphChangeRecordConverter methodsFor: 'private' stamp: 'NicolaiHess 1/21/2014 09:30'!
internalGetText
	| priorSource |
	priorSource := (self priorVersionOfAMethod: method) ifNotNil: [ :m | m sourceCode ] ifNil: [ '' ].
	^ Array with: priorSource with: method sourceCode! !

!DigitalSignatureAlgorithm commentStamp: '<historical>'!
This class implements the Digital Signature Algorithm (DSA) of the U.S. government's "Digital Signature Standard" (DSS). The DSA algorithm was proposed in 1991 and became a standard in May 1994. The official description is available as a Federal Information Processing Standards Publication (FIPS PUB 186, May 19, 1994). A companion standard, the Secure Hash Standard, or SHS (FIPS PUB 180-1, April 17, 1995), describes a 160-bit message digest algorithm known as the Secure Hash Algorithm (SHA). This message digest is used to compute the document signature.

Here's how to use it:

  1. The "signer" creates a pair of keys. One of these must be kept private. The other may be freely distributed. For example, it could be built into the signature checking code of an application.

  2. When the signer wishes to sign a packet of data (a "message") , he uses the secure hash algorithm to create a 160-bit message digest (hash) which is used as the input to DSA. The result of this is a pair of large numbers called a "signature" that is attached to the original message.

  3. When someone receives a signed message purported to have come from the signer, they compute the 160-bit hash of the message and pass that, along with the message signature and the signer's public key, to the signature verification algorithm. If the signature checks, then it is virtually guaranteed that the message originated from someone who had the signer's private key. That is, the message is not a forgery and has not been modified since it was signed. For example, if the message contains a program, and the recipient trusts the signer, then the recipient can run the program with the assurance that it won't do anything harmful. (At least, not intentionally. A digital signature is no guarantee against bugs!! :->)

The signer must keep the private key secure, since anyone who has the private key can forge the signer's signature on any message they like. As long as the secret key is not stolen, cryptographers believe it to be virtually impossible either to forge a signature, to find a message that matches an existing sigature, or to discover the signer's private key by analyzing message signatures. Knowing the public key (which, for example, could be recovered from an application that had it built in), does not weaken the security at all.

An excellent reference work on digital signatures and cryptography in general is:

  Schneier, Bruce
  "Applied Cryptography: Protocols, Algorithms, and Source Code in C"
  John Wiley and Sons, 1996.

I used this book as a guide to implementing many of the numerical algorithms required by DSA.

Patents and Export Restrictions:

Many digital signature technologies are patented. DSA is also patented, but the patent is owned by the U.S. government which has made DSA available royalty-free. There is a claim that the government patent infringes on an earlier patent by Schnorr, but the government is requiring the use of DSA, so they apparently believe this claim is not strong enough to be a serious threat to their own patent.

Most cryptography technology, including digital signature technology, requires an export license for it to be distributed outside the U.S. Recent legislation may have relaxed the export license requirements, but it would be prudent to check the current regulations before exporting this code.!
!DigitalSignatureAlgorithm methodsFor: 'public' stamp: 'nice 9/2/2010 21:48'!
computeSignatureForMessageHash: hash privateKey: privateKey
	"Answer the digital signature of the given message hash using the given private key. A signature is a pair of large integers. The private key is an array of four large integers: (p, q, g, x)."

	| p q g x r s k tmp |
	p := privateKey first.
	q := privateKey second.
	g := privateKey third.
	x := privateKey fourth.

	r := s := 0.
	[r = 0 or: [s = 0]] whileTrue: [
		k := self nextRandom160 \\ q.
		r := (g raisedTo: k modulo: p) \\ q.
		tmp := (hash + (x * r)) \\ q.
		s := ((k reciprocalModulo: q) * tmp) \\ q].

	^ Array with: r with: s
! !

!DigitalSignatureAlgorithm methodsFor: 'large integer arithmetic' stamp: 'GabrielOmarCotelli 12/3/2013 17:14'!
isProbablyPrime: p
	"Answer true if p is prime with very high probability. Such a number is sometimes called an 'industrial grade prime'--a large number that is so extremely likely to be prime that it can assumed that it actually is prime for all practical purposes. This implementation uses the Rabin-Miller algorithm (Schneier, p. 159)."

	| iterations pMinusOne b m r a j z couldBePrime |
	iterations := 50.	"Note: The DSA spec requires >50 iterations; Schneier says 5 are enough (p. 260)"	"quick elimination: check for p divisible by a small prime"
	SmallPrimes
		ifNil: [ 
			"generate list of small primes > 2"
			SmallPrimes := Integer primesUpTo: 2000.
			SmallPrimes := SmallPrimes copyFrom: 2 to: SmallPrimes size ].
	SmallPrimes detect: [ :f | p \\ f = 0 ] ifFound: [ :factor | ^ p = factor ].
	pMinusOne := p - 1.
	b := self logOfLargestPowerOfTwoDividing: pMinusOne.
	m := pMinusOne bitShift: b negated.	"Assert: pMinusOne = m * (2 raisedTo: b) and m is odd"
	Transcript show: '      Prime test pass '.
	r := Random new.
	1 to: iterations do: [ :i | 
		Transcript
			show: i printString;
			space.
		a := (r next * 16rFFFFFF) truncated.
		j := 0.
		z := (a raisedTo: m modulo: p) normalize.
		couldBePrime := z = 1.
		[ couldBePrime ]
			whileFalse: [ 
				z = 1
					ifTrue: [ 
						Transcript
							show: 'failed!!';
							cr.
						^ false ].	"not prime"
				z = pMinusOne
					ifTrue: [ couldBePrime := true ]
					ifFalse: [ 
						(j := j + 1) < b
							ifTrue: [ z := z * z \\ p ]
							ifFalse: [ 
								Transcript
									show: 'failed!!';
									cr.
								^ false ] ] ] ].	"not prime"
	Transcript
		show: 'passed!!';
		cr.
	^ true	"passed all tests; probably prime"! !

!DigitalSignatureAlgorithm methodsFor: 'initialization' stamp: 'jm 1/11/2000 00:25'!
initRandom: randomInteger
	"Initialize the the secure random number generator with the given value. The argument should be a positive integer of up to 512 bits chosen randomly to avoid someone being able to predict the sequence of random values generated."
	"Note: The random generator must be initialized before generating a key set or signature. Signature verification does not require initialization of the random generator."

	randSeed := 16rEFCDAB8998BADCFE10325476C3D2E1F067452301.  "initial seed"
	randKey := randomInteger.
	Transcript show: 'Random seed: ', randomInteger printString; cr.
! !

!DigitalSignatureAlgorithm methodsFor: 'public' stamp: 'adrian-lienhard 5/18/2009 21:08'!
generateKeySet
	"Generate and answer a key set for DSA. The result is a pair (<private key><public key>). Each key is an array of four large integers. The private key is (p, q, g, x); the public one is (p, q, g, y). The signer must be sure to record (p, q, g, x), and must keep x secret to prevent someone from forging their signature."
	"Note: Key generation can take some time. Open a transcript so you can see what's happening and take a coffee break!!"

	| qAndPandS q p exp g h x y |
	qAndPandS := self generateQandP.
	Transcript show: 'Computing g...'.
	q := qAndPandS first.
	p := qAndPandS second.
	exp := (p - 1) / q.
	h := 2.
	[g := h raisedTo: exp modulo: p. g = 1] whileTrue: [h := h + 1].
	Transcript show: 'done.'; cr.
	Transcript show: 'Computing x and y...'.
	x := self nextRandom160.
	y := g raisedTo: x modulo: p.
	Transcript show: 'done.'; cr.
	Transcript show: 'Key generation complete!!'; cr.
	^ Array
		with: (Array with: p with: q with: g with: x)
		with: (Array with: p with: q with: g with: y).
! !

!DigitalSignatureAlgorithm methodsFor: 'public' stamp: 'PeterHugossonMiller 9/3/2009 01:13'!
signatureToString: aSignature
	"Answer a string representation of the given signature. This string can be parsed using the stringToSignature: method."

	| s |
	s := (String new: 2000) writeStream.
	s nextPutAll: '[DSA digital signature '.
	s nextPutAll: aSignature first printStringHex.
	s space.
	s nextPutAll: aSignature second printStringHex.
	s nextPutAll: ']'.
	^ s contents
! !

!DigitalSignatureAlgorithm methodsFor: 'public' stamp: 'nice 9/2/2010 21:48'!
verifySignature: aSignature ofMessageHash: hash publicKey: publicKey
	"Answer true if the given signature is the authentic signature of the given message hash. That is, if the signature must have been computed using the private key set corresponding to the given public key. The public key is an array of four large integers: (p, q, g, y)."

	| p q g y r s w u1 u2 v0 v |
	p := publicKey first.
	q := publicKey second.
	g := publicKey third.
	y := publicKey fourth.
	r := aSignature first.
	s := aSignature last.
	((r > 0) and: [r < q]) ifFalse: [^ false].  "reject"
	((s > 0) and: [s < q]) ifFalse: [^ false].  "reject"

	w := s reciprocalModulo: q.
	u1 := (hash * w) \\ q.
	u2 := (r * w) \\ q.
	v0 := (g raisedTo: u1 modulo: p) * (y raisedTo: u2 modulo: p).
	v := ( v0 \\ p) \\ q.
	^ v = r
! !

!DigitalSignatureAlgorithm methodsFor: 'initialization' stamp: 'ClementBera 7/26/2013 16:38'!
initRandomFromUser
	"Ask the user to type a long random string and use the result to seed the secure random number generator."

	| s |
	s := UIManager default request: 'Enter a long random string to seed the random generator.'.
	s ifNil: [s := '']. 
	^self initRandomFromString: s! !

!DigitalSignatureAlgorithm methodsFor: 'large integer arithmetic' stamp: 'nice 8/28/2010 21:16'!
inverseOf: x mod: n
	"Answer the inverse of x modulus n. That is, the integer y such that (x * y) \\ n is 1. Both x and n must be positive, and it is assumed that x < n and that x and n are integers."
	"Details: Use the extended Euclidean algorithm, Schneier, p. 247."

	| v u u1 u2 u3 t1 t2 t3 tmp |
	((x <= 0) or: [n <= 0]) ifTrue: [self error: 'x and n must be greater than zero'].
	x >= n ifTrue: [self error: 'x must be < n'].

	v := x.
	u := n.
	(x even and: [n even]) ifTrue: [self error: 'no inverse'].

	u1 := 1. u2 := 0. u3 := u.
	t1 := v. t2 := u - 1. t3 := v.
	[	[u3 even ifTrue: [
			((u1 odd) or: [u2 odd]) ifTrue: [
				u1 := u1 + v.
				u2 := u2 + u].
			u1 := u1 bitShift: -1.
			u2 := u2 bitShift: -1.
			u3 := u3 bitShift: -1].
		((t3 even) or: [u3 < t3]) ifTrue: [
			tmp := u1. u1 := t1. t1 := tmp.
			tmp := u2. u2 := t2. t2 := tmp.
			tmp := u3. u3 := t3. t3 := tmp].
		u3 even and: [u3 > 0]] whileTrue: ["loop while u3 is even"].

		[((u1 < t1) or: [u2 < t2]) and: [u1 > 0]] whileTrue: [
			u1 := u1 + v.
			u2 := u2 + u].
	
		u1 := u1 - t1.
		u2 := u2 - t2.
		u3 := u3 - t3.
		t3 > 0] whileTrue: ["loop while t3 > 0"].

	[u1 >= v and: [u2 >= u]] whileTrue: [
		u1 := u1 - v.
		u2 := u2 - u].

	u3 = 1 ifFalse: [self error: 'no inverse'].
	^ u - u2
! !

!DigitalSignatureAlgorithm methodsFor: 'private' stamp: 'raa 5/30/2000 15:47'!
generateQandP
	"Generate the two industrial-grade primes, q (160-bits) and p (512-bit) needed to build a key set. Answer the array (q, p, s), where s is the seed that from which q and p were created. This seed is normally discarded, but can be used to verify the key generation process if desired."

	| pBits halfTwoToTheP chunkCount sAndq q twoQ n c w x p s |
	pBits := 512.  "desired size of p in bits"
	halfTwoToTheP := 2 raisedTo: (pBits - 1).
	chunkCount := pBits // 160.

	Transcript show: 'Searching for primes q and p...'; cr.
	[true] whileTrue: [
		sAndq := self generateSandQ.
		Transcript show: '  Found a candidate q.'; cr.
		s := sAndq first.
		q := sAndq last.
		twoQ := q bitShift: 1.
		n := 2.
		c := 0.
		[c < 4096] whileTrue: [
			w := self generateRandomLength: pBits s: s n: n.
			x := w + halfTwoToTheP.
			p := (x - ( x \\ twoQ)) + 1.
			p highBit = pBits ifTrue: [
				Transcript show: '    Testing potential p ', (c + 1) printString, '...'; cr.
				(self isProbablyPrime: p) ifTrue: [
					Transcript show: '  Found p!!'; cr.
					^ Array with: q with: p with: s]].
			n := n + chunkCount + 1.
			c := c + 1]].
! !

!DigitalSignatureAlgorithm methodsFor: 'initialization' stamp: 'PavelKrivanek 7/15/2014 20:40'!
initRandomNonInteractively

 	self initRandomFromString: 
 		Time millisecondClockValue printString, 
 		Date today printString, 
 		Smalltalk os platformName printString! !

!DigitalSignatureAlgorithm methodsFor: 'private' stamp: 'MaxLeske 7/28/2013 17:26'!
generateSandQ
	"Generate a 160-bit random seed s and an industrial grade prime q."

	| hasher s sPlusOne u q |
	hasher := SHA1 new.
	[true] whileTrue: [
		s := self nextRandom160.
		sPlusOne := s + 1.
		sPlusOne highBit > 160 ifTrue: [sPlusOne := sPlusOne \\ (2 raisedTo: 160)].
		u := (hasher hashInteger: s) bitXor: (hasher hashInteger: sPlusOne).
		q := u bitOr: ((1 bitShift: 159) bitOr: 1).
		(self isProbablyPrime: q) ifTrue: [^ Array with: s with: q]].
! !

!DigitalSignatureAlgorithm methodsFor: 'private' stamp: 'nice 8/28/2010 21:04'!
logOfLargestPowerOfTwoDividing: aPositiveInteger
	"Answer the base-2 log of the largest power of two that divides the given integer. For example, the largest power of two that divides 24 is 8, whose log base-2 is 3. Do this efficiently even when the given number is a large integer. Assume that the given integer is > 0."
	"DigitalSignatureAlgorithm new logOfLargestPowerOfTwoDividing: (32 * 3)"

	^aPositiveInteger lowBit - 1! !

!DigitalSignatureAlgorithm methodsFor: 'private' stamp: 'MaxLeske 7/28/2013 17:26'!
nextRandom160
	"Answer a newly generated 160-bit random number in the range [1..(2^160 - 1)]."
	"Details: Try again in the extremely unlikely chance that zero is encountered."

	| result |
	result := 0.
	[result = 0] whileTrue: [
		result := SHA1 new hashInteger: randKey seed: randSeed.
		randKey := randKey + result + 1].
	^ result
! !

!DigitalSignatureAlgorithm methodsFor: 'private' stamp: 'MaxLeske 7/28/2013 17:26'!
generateRandomLength: bitLength s: s n: n
	"Answer a random number of bitLength bits generated using the secure hash algorithm."

	| sha out count extraBits v |
	sha := SHA1 new.
	out := 0.
	count := (bitLength // 160).
	extraBits := bitLength - (count * 160).
	0 to: count do: [:k |
		v := sha hashInteger: (s + n + k).
		k = count ifTrue: [
			v := v - ((v >> extraBits) << extraBits)].
		out := out bitOr: (v bitShift: (160 * k))].
	^ out
! !

!DigitalSignatureAlgorithm methodsFor: 'initialization' stamp: 'nice 12/14/2010 15:10'!
initRandomFromString: aString
	"Ask the user to type a long random string and use the result to seed the secure random number generator."

	| s k srcIndex |
	s := aString.
	k := LargePositiveInteger new: (s size min: 64).
	srcIndex := 0.
	k digitLength to: 1 by: -1 do: [:i |
		k digitAt: i put: (s at: (srcIndex := srcIndex + 1)) asciiValue].
	k := k normalize + (Random new next * 16r7FFFFFFF) asInteger.  "a few additional bits randomness"
	k highBit > 512 ifTrue: [k := k bitShift: k highBit - 512].
	self initRandom: k.
! !

!DigitalSignatureAlgorithm methodsFor: 'public' stamp: 'dc 5/30/2008 10:17'!
stringToSignature: aString 
	"Answer the signature stored in the given string. A signature string has the format:

		 '[DSA digital signature <r> <s>]'

	where <r> and <s> are large positive integers represented by strings of hexidecimal digits."
	| prefix stream r s |
	prefix := '[DSA digital signature '.
	(aString beginsWith: prefix) ifFalse: [ self error: 'bad signature prefix' ].
	stream := aString readStream.
	stream position: prefix size.
	r := Integer 
		readFrom: stream
		base: 16.
	stream next.
	s := Integer 
		readFrom: stream
		base: 16.
	^ Array 
		with: r
		with: s! !

!DigitalSignatureAlgorithm class methodsFor: 'public' stamp: 'MaxLeske 7/28/2013 17:26'!
verify: signatureString isSignatureOf: aStringOrStream publicKey: publicKey 
	"Answer true if the given signature string signs the given message (a stream or string)."
	"Note: Random numbers are not needed for signature verification; thus, there is no need to call initRandomFromUser before verifying a signature."
	| dsa hasher h sig |
	dsa := self new.
	hasher := SHA1 new.
	h := aStringOrStream class isBytes 
		ifTrue: [ hasher hashMessage: aStringOrStream ]
		ifFalse: [ hasher hashStream: aStringOrStream ].
	sig := dsa stringToSignature: signatureString.
	^ dsa 
		verifySignature: sig
		ofMessageHash: h
		publicKey: publicKey! !

!DigitalSignatureAlgorithm class methodsFor: 'examples' stamp: 'MarcusDenker 5/2/2013 11:25'!
testExamplesFromDisk
	"verify messages from file on disk"
	"Note: Secure random numbers are needed for key generation and message signing, but not for signature verification. There is no need to call initRandomFromUser if you are merely checking a signature."
	"DigitalSignatureAlgorithm testExamplesFromDisk"

	FileStream 
		readOnlyFileNamed: 'dsa.test.out' 
		do: [ :file |
			| msg sig publicKey |
			[file atEnd] whileFalse: [
				sig := file nextChunk.
				msg := file nextChunk.
				publicKey := self class compiler evaluate: file nextChunk.
				(self verify: sig isSignatureOf: msg publicKey: publicKey) 
					ifTrue: [Transcript show: 'SUCCESS: ',msg; cr.]
					ifFalse: [self error: 'ERROR!! Signature verification failed']]]! !

!DigitalSignatureAlgorithm class methodsFor: 'initialization' stamp: 'NorbertHartl 6/13/2008 11:38'!
initialize
	"DigitalSignatureAlgorithm initialize"

	"SmallPrimes is a list of small primes greater than two."
	SmallPrimes := Integer primesUpTo: 2000.
	SmallPrimes := SmallPrimes copyFrom: 2 to: SmallPrimes size.

	"HighBitOfByte maps a byte to the index of its top non-zero bit."
	HighBitOfByte := (0 to: 255) collect: [:byte | byte highBit].
! !

!DigitalSignatureAlgorithm class methodsFor: 'examples' stamp: 'jm 12/22/1999 11:23'!
example
	"Example of signing a message and verifying its signature."
	"Note: Secure random numbers are needed for key generation and message signing, but not for signature verification. There is no need to call initRandomFromUser if you are merely checking a signature."
	"DigitalSignatureAlgorithm example"

	| msg keys sig |
	msg := 'This is a test...'.
	keys := self testKeySet.
	sig := self sign: msg privateKey: keys first.
	self inform: 'Signature created'.
	(self verify: sig isSignatureOf: msg publicKey: keys last)
		ifTrue: [self inform: 'Signature verified.']
		ifFalse: [self error: 'ERROR!! Signature verification failed'].
! !

!DigitalSignatureAlgorithm class methodsFor: 'examples' stamp: 'md 3/26/2011 19:16'!
timeDecode: count
	"Example of signing a message and verifying its signature."
	"Note: Secure random numbers are needed for key generation and message signing, but not for signature verification. There is no need to call initRandomFromUser if you are merely checking a signature."
	"DigitalSignatureAlgorithm timeDecode: 20"

	| dsa |

	dsa := self new.
	dsa initRandomFromUser.

	#(1 10 100 1000 10000 100000) do: [ :extraLen | | s msg keys sig |
		s := String new: extraLen.
		1 to: s size do: [ :i | s at: i put: (Character value: 200 atRandom)].
		msg := 'This is a test...',s.
		keys := self testKeySet.
		sig := self sign: msg privateKey: keys first dsa: dsa.
		"self inform: 'Signature created'."
		self timeDirect: [
			count timesRepeat: [
				(self verify: sig isSignatureOf: msg publicKey: keys last)
					ifFalse: [self error: 'ERROR!! Signature verification failed'].
			].
		] as: 'verify msgLen = ',msg size printString count: count
	].
! !

!DigitalSignatureAlgorithm class methodsFor: 'public' stamp: 'PavelKrivanek 7/15/2014 20:41'!
generateKeySet
 	"Generate and answer a key set for code signing. The result is a pair (<private key><public key>). Each key is an array of four large integers. The signer must be sure to record this keys set and must keep the private key secret to prevent someone from forging their signature."
 	"Note: Key generation can take some time. Open a transcript so you can see what's happening and take a coffee break!!"
 	"Note: Unguessable random numbers are needed for key generation. The user will be prompted to type a really long random string (two or three lines) to initialize the random number generator before generating a key set. A different random string should be typed for every session; it is not a password and we wish to produce different random number streams."
 	"DigitalSignatureAlgorithm generateKeySet"
 
 	| dsa |
 	dsa := self new.
 	(self confirm: 'Shall I seed the random generator from the current time?')
 		ifTrue: [dsa initRandomNonInteractively]
 		ifFalse: [dsa initRandomFromUser].
 	^ dsa generateKeySet
 ! !

!DigitalSignatureAlgorithm class methodsFor: 'public' stamp: 'MaxLeske 7/28/2013 17:26'!
sign: aStringOrStream privateKey: privateKey dsa: dsa 
	"Sign the given message (a stream or string) and answer a signature string."
	"Note: Unguessable random numbers are needed for message signing. The user will be prompted to type a really long random string (two or three lines) to initialize the random number generator before signing a message. A different random string should be typed for every session; it is not a password and we wish to produce different random number streams."
	| hasher h sig |
	hasher := SHA1 new.
	h := aStringOrStream class isBytes 
		ifTrue: [ hasher hashMessage: aStringOrStream ]
		ifFalse: [ hasher hashStream: aStringOrStream ].
	sig := dsa 
		computeSignatureForMessageHash: h
		privateKey: privateKey.
	^ dsa signatureToString: sig! !

!DigitalSignatureAlgorithm class methodsFor: 'examples' stamp: 'jm 12/22/1999 11:28'!
testKeySet
	"Answer a pair of keys for testing. The first key is the private key, the second one is the public key."
	"WARNING: This test key set is public should be used only for testing!! In a real application, the user would create a set of keys using generateKeySet and would keep the private key secret."

	^ #(
		(8343811888543852523216773185009428259187948644369498021763210776677854991854533186365944349987509452133156416880596803846631577352387751880552969116768071 1197175832754339660404549606408619548226315875117 1433467472198821951822151391684734233265646022897503720591270330985699984763922266163182803556189497900262038518780931942996381297743579119123094520048965 957348690772296812)
		(8343811888543852523216773185009428259187948644369498021763210776677854991854533186365944349987509452133156416880596803846631577352387751880552969116768071 1197175832754339660404549606408619548226315875117 1433467472198821951822151391684734233265646022897503720591270330985699984763922266163182803556189497900262038518780931942996381297743579119123094520048965 4645213122572190617807944614677917601101008235397095646475699959851618402406173485853587185431290863173614335452934961425661774118334228449202337038283799))
! !

!DigitalSignatureAlgorithm class methodsFor: 'public' stamp: 'MaxLeske 7/28/2013 17:26'!
sign: aStringOrStream privateKey: privateKey 
	"Sign the given message (a stream or string) and answer a signature string."
	"Note: Unguessable random numbers are needed for message signing. The user will be prompted to type a really long random string (two or three lines) to initialize the random number generator before signing a message. A different random string should be typed for every session; it is not a password and we wish to produce different random number streams."
	| dsa hasher h sig |
	dsa := self new.
	dsa initRandomFromUser.
	hasher := SHA1 new.
	h := aStringOrStream class isBytes 
		ifTrue: [ hasher hashMessage: aStringOrStream ]
		ifFalse: [ hasher hashStream: aStringOrStream ].
	sig := dsa 
		computeSignatureForMessageHash: h
		privateKey: privateKey.
	^ dsa signatureToString: sig! !

!DigitalSignatureAlgorithm class methodsFor: 'examples' stamp: 'md 3/26/2011 19:16'!
writeExamplesToDisk
	"Example of signing a message and verifying its signature. Used to create samples from one implementation that could later be tested with a different implementation"
	"Note: Secure random numbers are needed for key generation and message signing, but not for signature verification. There is no need to call initRandomFromUser if you are merely checking a signature."
	"DigitalSignatureAlgorithm writeExamplesToDisk"

	| file keyList dsa msgList |

	dsa := self new.
	dsa initRandomFromUser.
	self inform: 'About to generate 5 key sets. Will take a while'.
	keyList := {self testKeySet},((1 to: 5) collect: [ :ignore | self generateKeySet]).
	msgList := {'This is a test...'. 'This is the second test period.'. 'And finally, a third message'}.
	file := FileStream newFileNamed: 'dsa.test.out'.
	[
		msgList do: [ :msg |
			keyList do: [ :keys | | sig |
				sig := self sign: msg privateKey: keys first dsa: dsa.
				(self verify: sig isSignatureOf: msg publicKey: keys last) ifTrue: [
					file
						nextChunkPut: sig;
						nextChunkPut: msg;
						nextChunkPut: keys last storeString.
				] ifFalse: [
					self error: 'ERROR!! Signature verification failed'
				].
			].
		].
	] ensure: [file close]
! !

!DigitalSignatureAlgorithm class methodsFor: 'testing' stamp: 'RAA 5/31/2000 08:21'!
time: aBlock as: aString count: anInteger

	^{anInteger. aString. (Time millisecondsToRun: aBlock)}! !

!DigitalSignatureAlgorithm class methodsFor: 'testing' stamp: 'RAA 5/31/2000 08:40'!
timeDirect: aBlock as: aString count: anInteger

	Transcript show: anInteger asStringWithCommas,'  ',
		aString ,' took ',
		(Time millisecondsToRun: aBlock) asStringWithCommas,' ms'; cr
! !

!DirectoryDoesNotExist commentStamp: 'cwp 11/18/2009 12:33'!
I am raised when I an operation is attempted inside a directory that does not exist. !
!DirectoryEntryTest commentStamp: 'TorstenBergmann 1/31/2014 11:38'!
SUnit tests for FileSystemDirectoryEntry!
!DirectoryEntryTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testIsDirectory
	| ref entry |
	ref := FileLocator imageDirectory resolve.
	entry := ref entry.
	self assert: entry isDirectory! !

!DirectoryEntryTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/27/2011 22:26'!
testCreationTimeIsADateAndTimeInstance
	"While creation is the message sent to a directory entry, creation returns a DateAndTime object"

	| creation |
	creation := self entry creation.
	self assert: creation class = DateAndTime.
	! !

!DirectoryEntryTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/27/2011 22:27'!
testModificationTimeIsADateAndTimeInstance
	"While modification is the message sent to a directory entry, modification returns a DateAndTime object"

	| modification |
	modification := self entry modification.
	self assert: modification class = DateAndTime.
	! !

!DirectoryEntryTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testReference
	| ref entry |
	ref := FileLocator image resolve.
	entry := ref entry.
	self assert: entry reference = ref! !

!DirectoryEntryTest methodsFor: 'tests' stamp: 'cwp 11/15/2009 22:10'!
testIsNotDirectory
	self deny: self entry isDirectory! !

!DirectoryEntryTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/27/2011 22:26'!
testIsFile
	self assert: self entry isFile.
	self deny: self entry isDirectory! !

!DirectoryEntryTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testIsNotFile
	| ref |
	ref := FileLocator imageDirectory resolve.
	self deny: ref entry isFile! !

!DirectoryEntryTest methodsFor: 'tests' stamp: 'cwp 11/15/2009 22:05'!
testSize
	self assert: self entry size isInteger! !

!DirectoryEntryTest methodsFor: 'accessing' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
entry
	^ FileLocator image resolve entry! !

!DirectoryExists commentStamp: 'cwp 11/18/2009 12:35'!
I am raised on an attempt to create a directory that already exists.!
!DiskFileSystemTest commentStamp: 'TorstenBergmann 1/31/2014 11:44'!
SUnit tests for the disk filesystem!
!DiskFileSystemTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testIsDirectory
	self assert: (filesystem isDirectory: FileLocator imageDirectory resolve path)! !

!DiskFileSystemTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/3/2012 11:42'!
testEqual
	| other |
	other := self createFileSystem.
	self assert: filesystem = other! !

!DiskFileSystemTest methodsFor: 'tests' stamp: 'VincentBlondeau 1/30/2015 15:01'!
testIsDiskFileSystem
	self assert: filesystem isDiskFileSystem.
	! !

!DiskFileSystemTest methodsFor: 'initialize-release' stamp: 'EstebanLorenzano 4/3/2012 13:17'!
createFileSystem
	^ FileSystem store: (DiskStore activeClass createDefault)! !

!DiskFileSystemTest methodsFor: 'tests' stamp: 'tbn 2/13/2013 09:36'!
testDefaultWorkingDirectory
	| ref |
	ref := filesystem workingDirectory.
	self assert: (('File @ ', Smalltalk vm imagePath) beginsWith: ref asString)! !

!DiskStore commentStamp: '<historical>'!
I am an abstract superclass for disk store implementations. My subclasses provide access to the actual data storage of a particular kind of filesystem. 
!
!DiskStore methodsFor: 'public' stamp: 'CamilloBruni 5/13/2012 19:17'!
maxFileNameLength
	^ maxFileNameLength! !

!DiskStore methodsFor: 'public' stamp: 'MarcusDenker 12/2/2013 14:06'!
isWritable: aPath
	(self exists: aPath) ifFalse: [ ^ false ].
	self flag: 'TODO: we need a decent primitive for this...'.
	(self basicOpen: aPath writable: true) 
		ifNotNil: [ :id|
			Primitives close: id.
			^ true].
	^ false! !

!DiskStore methodsFor: 'private' stamp: 'NicolaiHess 12/1/2013 01:53'!
basicEntry: directoryEntry path: aPath nodesDo: aBlock
	| encodedPathString index entry pathString |
		
	index := 1.
	pathString := self stringFromPath: aPath.
	encodedPathString := Primitives encode: pathString.
	entry := Primitives lookupEntryIn: encodedPathString index: index.
	entry = #badDirectoryPath ifTrue: [ self signalDirectoryDoesNotExist: aPath ].
	
	[ entry isNil ]
		whileFalse: [ 
			entry at: 1 put: (Primitives decode: entry first).
			aBlock value: entry.
			index := index + 1.
			entry := Primitives lookupEntryIn: encodedPathString index: index ].! !

!DiskStore methodsFor: 'public' stamp: 'cwp 2/28/2011 12:35'!
basicOpen: aPath writable: aBoolean
	| string encoded |
	string := self stringFromPath: aPath.
	encoded := Primitives encode: string.
	^ Primitives open: encoded writable: aBoolean! !

!DiskStore methodsFor: 'public' stamp: 'cwp 4/3/2011 22:17'!
createDirectory: path
	"Create a directory for the argument path. 
	If the path refers to an existing file, raise FileExists.
	If the path refers to an existing directory, raise DirectoryExists.
	If the parent directory of the path does not exist, raise DirectoryDoesNotExist"

	| parent encodedPathString pathString result |
	pathString := self stringFromPath: path.
	encodedPathString := Primitives encode: pathString.
	result := Primitives createDirectory: encodedPathString.
	result
		ifNil: [ 
			parent := path parent.
			(self exists: path)
				ifTrue: [ 
					(self isFile: path)
						ifTrue: [ self signalFileExists: path ]
						ifFalse: [ self signalDirectoryExists: path ] ].
			(self isDirectory: parent)
				ifFalse: [ ^ self signalDirectoryDoesNotExist: parent ].
			self primitiveFailed ].
	^ self! !

!DiskStore methodsFor: 'public' stamp: 'CamilloBruni 1/23/2012 15:52'!
rename: sourcePath to: destinationPath

	| sourcePathString encodedSourcePathString targetPathString encodedTargetPathString result |
	sourcePathString := self stringFromPath: sourcePath.
	encodedSourcePathString := Primitives encode: sourcePathString.
	targetPathString := self stringFromPath: destinationPath.
	encodedTargetPathString := Primitives encode: targetPathString.
	^ Primitives rename: encodedSourcePathString to: encodedTargetPathString.! !

!DiskStore methodsFor: 'accessing' stamp: 'cwp 2/27/2011 10:03'!
defaultWorkingDirectory
	| pathString |
	pathString := Primitives decode: Primitives imageFile.
	^ (self pathFromString: pathString) parent! !

!DiskStore methodsFor: 'initialization' stamp: 'CamilloBruni 5/13/2012 19:18'!
initialize
	super initialize.
	maxFileNameLength := Smalltalk vm maxFilenameLength ifNil: [ 255 ].! !

!DiskStore methodsFor: 'private' stamp: 'EstebanLorenzano 8/2/2012 15:38'!
basicPosixPermissions: anEntry
	^ (anEntry size >= 6)
		ifTrue: [ anEntry at: 6 ]
		ifFalse: [ nil ].! !

!DiskStore methodsFor: 'public' stamp: 'CamilloBruni 2/20/2012 21:41'!
openFileStream: path writable: writable
	| fullPath |
	fullPath := self stringFromPath: path.
	"redirect over the default implementation"
	^ writable 
		ifFalse: [ FileStream readOnlyFileNamed: fullPath ]
		ifTrue: [ FileStream fileNamed: fullPath ]! !

!DiskStore methodsFor: 'private' stamp: 'EstebanLorenzano 8/2/2012 16:51'!
basicIsSymlink: anEntry
	^(anEntry size >= 7)
		ifTrue: [ anEntry at: 7 ]
		ifFalse: [ false ]! !

!DiskStore methodsFor: 'private' stamp: 'NicolaiHess 12/14/2013 13:46'!
rootNode
	^ #('' 0 0 true 0 8r555)! !

!DiskStore methodsFor: 'testing' stamp: 'VincentBlondeau 1/30/2015 14:55'!
isDiskFileSystem
	^ true! !

!DiskStore methodsFor: 'private' stamp: 'cwp 2/18/2011 11:32'!
basicIsDirectory: anEntry
	^ anEntry at: 4! !

!DiskStore methodsFor: 'printing' stamp: 'SeanDeNigris 2/9/2013 09:12'!
forReferencePrintOn: aStream
	aStream nextPutAll: 'File @ '! !

!DiskStore methodsFor: 'public' stamp: 'CamilloBruni 6/17/2013 11:07'!
delete: path
	| pathString encodedPathString |
	
	(self exists: path)
		ifFalse: [ ^ FileDoesNotExist signalWith: path ].
		
	pathString := self stringFromPath: path.
	encodedPathString := Primitives encode: pathString.
	
	(self isDirectory: path)
		ifTrue: [ Primitives deleteDirectory: encodedPathString ]
		ifFalse: [ 
			StandardFileStream
				retryWithGC: [ Primitives deleteFile: encodedPathString ]
				until: [ :result | result notNil ]
				forFileNamed: pathString ]! !

!DiskStore methodsFor: 'private' stamp: 'cwp 2/18/2011 11:33'!
basicIsFile: anEntry
	^ (anEntry at: 4) not! !

!DiskStore methodsFor: 'comparing' stamp: 'cwp 2/27/2011 09:51'!
hash
	^ self species hash! !

!DiskStore methodsFor: 'private' stamp: 'CamilloBruni 6/1/2012 14:44'!
nodeAt: aPath ifPresent: presentBlock ifAbsent: absentBlock
	
	| entry |
	
	aPath isRoot ifTrue: [ ^ presentBlock value: self rootNode ].
	
	entry := self basicEntryAt: aPath.
	
	^ entry == #badDirectoryPath 
		ifTrue: absentBlock
		ifFalse: [
			entry at: 1 put: aPath basename.
			presentBlock value: entry ].! !

!DiskStore methodsFor: 'public' stamp: 'MarcusDenker 12/2/2013 14:06'!
isReadable: aPath
	(self exists: aPath) ifFalse: [ ^ false ].
	self flag: 'TODO: we need a decent primitive for this...'.
	(self basicOpen: aPath writable: false) 
		ifNotNil: [ :id|
			Primitives close: id.
			^ true].
	^ false! !

!DiskStore methodsFor: 'private' stamp: 'CamilloBruni 7/10/2012 21:13'!
basicSize: anEntry
	^ (anEntry at: 5)! !

!DiskStore methodsFor: 'private' stamp: 'cwp 2/18/2011 13:27'!
basenameFromEntry: entry
	^ entry at: 1! !

!DiskStore methodsFor: 'comparing' stamp: 'cwp 2/27/2011 09:50'!
= other
	^ self species = other species! !

!DiskStore methodsFor: 'accessing' stamp: 'EstebanLorenzano 4/2/2012 11:46'!
handleClass
	^ FileHandle! !

!DiskStore methodsFor: 'public' stamp: 'EstebanLorenzano 6/20/2012 12:27'!
basicEntryAt: aPath
	| encodedPath encodedBasename |
	
	encodedPath := Primitives encode: (self stringFromPath: aPath parent).
	encodedBasename := Primitives encode: aPath basename.
	
	^ (Primitives lookupDirectory: encodedPath filename: encodedBasename)
		ifNil: [ #badDirectoryPath ].
	! !

!DiskStore methodsFor: 'private' stamp: 'CamilloBruni 7/17/2012 18:17'!
basicCreationTime: anEntry
	" the entry contains the seconds since the squeak epoch in local time"
	^  (DateAndTime fromSeconds: (anEntry at: 2) offset: 0) translateTo: DateAndTime localOffset! !

!DiskStore methodsFor: 'public' stamp: 'CamilloBruni 5/13/2012 19:17'!
checkName: aFileName fixErrors: fixErrors
	"Check a string aFileName for validity as a file name. Answer the original file name if it is valid. If the name is not valid (e.g., it is too long or contains illegal characters) and fixing is false, raise an error. If fixing is true, fix the name (usually by truncating and/or tranforming characters), and answer the corrected name. The default behavior is just to truncate the name to the maximum length for this platform. Subclasses can do any kind of checking and correction appropriate for their platform."
	
	| maxLength |
	aFileName size = 0 ifTrue: [self error: 'zero length file name'].
	maxLength := self maxFileNameLength.
	aFileName size > maxLength ifTrue: [
		fixErrors
			ifTrue: [^ aFileName contractTo: maxLength]
			ifFalse: [self error: 'file name is too long']].
	^ aFileName! !

!DiskStore methodsFor: 'public' stamp: 'CamilloBruni 6/1/2012 14:46'!
isDirectory: aPath
	| entry |
	
	aPath isRoot ifTrue: [ ^ true ].
	
	entry := self  basicEntryAt: aPath.
	
	^ entry == #badDirectoryPath 
		ifTrue: [  false ]
		ifFalse: [ self basicIsDirectory: entry ].
	! !

!DiskStore methodsFor: 'public' stamp: 'EstebanLorenzano 8/2/2012 15:43'!
isSymlink: aPath
	| entry |
	
	aPath isRoot ifTrue: [ ^false ].
	
	entry := self  basicEntryAt: aPath.
	
	^ entry == #badDirectoryPath 
		ifTrue: [  false ]
		ifFalse: [ self basicIsSymlink: entry ].
	! !

!DiskStore methodsFor: 'public' stamp: 'CamilloBruni 6/17/2012 17:22'!
isFile: aPath
	| entry |
	
	aPath isRoot ifTrue: [ ^ false ].
	
	entry := self  basicEntryAt: aPath.
	
	^ entry == #badDirectoryPath 
		ifTrue: [  false ]
		ifFalse: [ self basicIsFile: entry ].
	! !

!DiskStore methodsFor: 'private' stamp: 'CamilloBruni 7/17/2012 18:17'!
basicModificationTime: anEntry
	" the entry contains the seconds since the squeak epoch in local time"
	^ (DateAndTime fromSeconds: (anEntry at: 3) offset: 0) translateTo: DateAndTime localOffset! !

!DiskStore class methodsFor: 'public' stamp: 'CamilloBruni 5/10/2012 16:03'!
maxFileNameLength
	self subclassResponsibility ! !

!DiskStore class methodsFor: 'current' stamp: 'CamilloBruni 5/13/2012 19:17'!
currentFileSystem
	^ CurrentFS ifNil: [
		CurrentFS := FileSystem store: self activeClass createDefault]! !

!DiskStore class methodsFor: 'class initialization' stamp: 'MarcusDenker 5/7/2013 12:07'!
checkVMVersion
	"Display a warning if the VM is too old"
	| displayError |
	displayError := [ ^ self inform: 'Your VM is too old for this image. Please download the latest VM.' ].
	[(Smalltalk vm interpreterSourceDate > '2012-07-08+2:00' asDate)
		ifFalse: displayError
	] on: Error do: [ :e| displayError value ].! !

!DiskStore class methodsFor: 'current' stamp: 'cwp 4/4/2011 19:04'!
reset
	CurrentFS := nil! !

!DiskStore class methodsFor: 'class initialization' stamp: 'EstebanLorenzano 4/2/2012 11:46'!
useFilePlugin
	Primitives := FilePluginPrims new! !

!DiskStore class methodsFor: 'current' stamp: 'cwp 2/27/2011 10:02'!
createDefault
	^ self new! !

!DiskStore class methodsFor: 'current' stamp: 'CamilloBruni 5/10/2012 15:41'!
activeClass
	self allSubclassesDo: [:ea | 
		ea isActiveClass ifTrue: [^ ea]].
	^ self! !

!DiskStore class methodsFor: 'class initialization' stamp: 'EstebanLorenzano 6/21/2012 12:53'!
initialize
	self useFilePlugin.
	Smalltalk 
		removeFromStartUpList: self;
		removeFromShutDownList: self;
		addToStartUpList: self after: OSPlatform;
		addToShutDownList: self! !

!DiskStore class methodsFor: 'current' stamp: 'cwp 2/18/2011 17:20'!
isActiveClass
	^ self delimiter = Primitives delimiter! !

!DiskStore class methodsFor: 'class initialization' stamp: 'EstebanLorenzano 6/21/2012 12:52'!
shutDown: quitting
	"Force to detect filesystem after image restart"
	self reset! !

!DiskStore class methodsFor: 'public' stamp: 'Cami 7/9/2012 11:12'!
delimiter
	^ self current delimiter! !

!DiskStore class methodsFor: 'current' stamp: 'EstebanLorenzano 4/3/2012 11:30'!
current
	^ self currentFileSystem store! !

!DiskStore class methodsFor: 'class initialization' stamp: 'CamilloBruni 7/18/2012 12:22'!
startUp: resuming
	self checkVMVersion.
	resuming 
		ifTrue: [ self reset ]! !

!DisplayMedium commentStamp: '<historical>'!
I am a display object which can both paint myself on a medium (displayOn: messages), and can act as a medium myself. My chief subclass is Form.!
!DisplayMedium methodsFor: 'coloring' stamp: ''!
fillGray: aRectangle
	"Set all bits in the receiver's area defined by aRectangle to the gray mask."

	self fill: aRectangle rule: Form over fillColor: Color gray! !

!DisplayMedium methodsFor: 'displaying' stamp: 'hmm 9/16/2000 21:27'!
deferUpdatesIn: aRectangle while: aBlock
	"DisplayScreen overrides with something more involved..."
	^aBlock value! !

!DisplayMedium methodsFor: 'bordering' stamp: ''!
border: aRectangle width: borderWidth fillColor: aHalfTone 
	"Paint a border whose rectangular area is defined by aRectangle. The 
	width of the border of each side is borderWidth. Uses aHalfTone for 
	drawing the border."

	self border: aRectangle
		widthRectangle: 
			(Rectangle
				left: borderWidth
				right: borderWidth
				top: borderWidth
				bottom: borderWidth)
		rule: Form over
		fillColor: aHalfTone! !

!DisplayMedium methodsFor: 'coloring' stamp: ''!
fillWithColor: aColor
	"Fill the receiver's bounding box with the given color."

	self fill: self boundingBox fillColor: aColor.
! !

!DisplayMedium methodsFor: 'displaying' stamp: ''!
copyBits: sourceRect from: sourceForm at: destOrigin clippingBox: clipRect rule: rule fillColor: aForm 
	"Make up a BitBlt table and copy the bits."

	self subclassResponsibility! !

!DisplayMedium methodsFor: 'coloring' stamp: ''!
fillBlack
	"Set all bits in the receiver to black (ones)."

	self fill: self boundingBox fillColor: Color black! !

!DisplayMedium methodsFor: 'private' stamp: 'FernandoOlivero 9/9/2013 11:57'!
quickHighLight: aDepth
	^ self highLightBitmaps at: aDepth! !

!DisplayMedium methodsFor: 'private' stamp: 'MarcusDenker 12/8/2013 10:05'!
initializeHighLights 
	
	"Create a set of Bitmaps for quickly reversing areas of the screen without converting colors. "
	
	HighLightBitmaps := Array new: 32.
	^HighLightBitmaps
		at: 1 put: (Bitmap with: 4294967295);
		at: 2 put: (Bitmap with: 4294967295);
		at: 4 put: (Bitmap with: 1431655765);
		at: 8 put: (Bitmap with: 117901063);
		at: 16 put: (Bitmap with: 4294967295);
		at: 32 put: (Bitmap with: 4294967295);
		yourself.
! !

!DisplayMedium methodsFor: 'coloring' stamp: ''!
fill: aRectangle fillColor: aForm 
	"Replace a rectangular area of the receiver with the pattern described by 
	aForm according to the rule over."

	self fill: aRectangle rule: Form over fillColor: aForm! !

!DisplayMedium methodsFor: 'coloring' stamp: ''!
reverse: aRectangle fillColor: aMask	
	"Change all the bits in the receiver's area that intersects with aRectangle 
	according to the mask. Black does not necessarily turn to white, rather it 
	changes with respect to the rule and the bit in a corresponding mask 
	location. Bound to give a surprise."

	self fill: aRectangle rule: Form reverse fillColor: aMask! !

!DisplayMedium methodsFor: 'bordering' stamp: ''!
border: aRectangle widthRectangle: insets rule: combinationRule fillColor: aHalfTone
	"Paint a border whose rectangular area is defined by aRectangle. The 
	width of each edge of the border is determined by the four coordinates 
	of insets. Uses aHalfTone and combinationRule for drawing the border."

	(aRectangle areasOutside: (aRectangle insetBy: insets)) do:
		[:edgeStrip | self fill: edgeStrip rule: combinationRule fillColor: aHalfTone]! !

!DisplayMedium methodsFor: 'coloring' stamp: 'FernandoOlivero 9/9/2013 11:57'!
reverse
	"Change all the bits in the receiver that are white to black, and the ones 
	that are black to white."

"
Display reverse: (10@10 extent: 100@100)
"

	self fill: self boundingBox rule: Form reverse fillColor: (self quickHighLight: self depth)! !

!DisplayMedium methodsFor: 'coloring' stamp: 'StephaneDucasse 10/25/2013 16:07'!
fillShape: aShapeForm fillColor: aColor at: location
	"Fill a region corresponding to 1 bits in aShapeForm with aColor"

	((BitBlt destForm: self sourceForm: aShapeForm fillColor: aColor
		combinationRule: Form paint
		destOrigin: location + aShapeForm offset sourceOrigin: 0@0
		extent: self extent clipRect: self boundingBox)
		colorMap: (Bitmap with: 0 with: 16rFFFFFFFF))
		copyBits! !

!DisplayMedium methodsFor: 'coloring' stamp: 'FernandoOlivero 9/9/2013 11:57'!
reverse: aRectangle
	"Change all the bits in the receiver's area that intersects with aRectangle 
	that are white to black, and the ones that are black to white."

	self fill: aRectangle rule: Form reverse fillColor: (self quickHighLight: self depth)! !

!DisplayMedium methodsFor: 'coloring' stamp: ''!
fillBlack: aRectangle 
	"Set all bits in the receiver's area defined by aRectangle to black (ones)."

	self fill: aRectangle rule: Form over fillColor: Color black! !

!DisplayMedium methodsFor: 'bordering' stamp: 'EstebanLorenzano 5/3/2014 13:55'!
border: aRectangle width: borderWidth 
	"Paint a border whose rectangular area is defined by aRectangle. The 
	width of the border of each side is borderWidth. Uses theme borderColor for 
	drawing the border."

	self 
		border: aRectangle 
		width: borderWidth 
		fillColor: Smalltalk ui theme borderColor.
! !

!DisplayMedium methodsFor: 'coloring' stamp: ''!
fill: aRectangle rule: anInteger fillColor: aForm 
	"Replace a rectangular area of the receiver with the pattern described by 
	aForm according to the rule anInteger."

	self subclassResponsibility! !

!DisplayMedium methodsFor: 'coloring' stamp: ''!
fillColor: aColor
	"Set all pixels in the receiver to the color.  Must be a correct color for this depth of medium.  TK 1 Jun 96"

	self fill: self boundingBox fillColor: aColor! !

!DisplayMedium methodsFor: 'coloring' stamp: ''!
fillShape: aShapeForm fillColor: aColor
	"Fill a region corresponding to 1 bits in aShapeForm with aColor"

	^ self fillShape: aShapeForm fillColor: aColor at: 0@0! !

!DisplayMedium methodsFor: 'coloring' stamp: ''!
fillWhite
	"Set all bits in the form to white."

	self fill: self boundingBox fillColor: Color white.
! !

!DisplayMedium methodsFor: 'coloring' stamp: ''!
fillGray
	"Set all bits in the receiver to gray."

	self fill: self boundingBox fillColor: Color gray! !

!DisplayMedium methodsFor: 'private' stamp: 'MarcusDenker 12/8/2013 10:07'!
highLightBitmaps
	"Quickly return a Bitblt-ready raw colorValue for highlighting areas."
	^HighLightBitmaps ifNil: [self initializeHighLights ].
! !

!DisplayMedium methodsFor: 'displaying' stamp: ''!
drawLine: sourceForm from: beginPoint to: endPoint clippingBox: clipRect rule: anInteger fillColor: aForm 
	"Draw line by copying the argument, sourceForm, starting at location 
	beginPoint and ending at endPoint, clipped by the rectangle, clipRect. 
	The rule and mask for copying are the arguments anInteger and aForm."

	self subclassResponsibility! !

!DisplayMedium methodsFor: 'coloring' stamp: ''!
fillWhite: aRectangle
	"Set all bits in the receiver's area defined by aRectangle to white."

	self fill: aRectangle rule: Form over fillColor: Color white.
! !

!DisplayMedium methodsFor: 'bordering' stamp: ''!
border: aRectangle width: borderWidth rule: combinationRule fillColor: aHalfTone 
	"Paint a border whose rectangular area is defined by aRectangle. The 
	width of the border of each side is borderWidth. Uses aHalfTone for 
	drawing the border."

	self border: aRectangle
		widthRectangle: 
			(Rectangle
				left: borderWidth
				right: borderWidth
				top: borderWidth
				bottom: borderWidth)
		rule: combinationRule
		fillColor: aHalfTone! !

!DisplayObject commentStamp: '<historical>'!
The abstract protocol for most display primitives that are used by Views for presenting information on the screen.!
!DisplayObject methodsFor: 'displaying-generic' stamp: 'jm 10/21/97 16:56'!
displayOnPort: port at: location rule: rule

	port copyForm: self to: location rule: rule.
! !

!DisplayObject methodsFor: 'displaying-generic' stamp: ''!
displayOn: aDisplayMedium at: aDisplayPoint 
	"Display the receiver located at aDisplayPoint with default settings for 
	rule and halftone."

	self displayOn: aDisplayMedium
		at: aDisplayPoint
		clippingBox: aDisplayMedium boundingBox
		rule: Form over
		fillColor: nil! !

!DisplayObject methodsFor: 'accessing' stamp: ''!
offset
	"Answer the amount by which the receiver should be offset when it is 
	displayed or its position is tested."

	self subclassResponsibility! !

!DisplayObject methodsFor: 'displaying-generic' stamp: ''!
displayOn: aDisplayMedium
	"Simple default display in order to see the receiver in the upper left 
	corner of screen."

	self displayOn: aDisplayMedium at: 0 @ 0! !

!DisplayObject methodsFor: 'accessing' stamp: ''!
height
	"Answer the number that represents the height of the receiver's 
	bounding box."

	^self boundingBox height! !

!DisplayObject methodsFor: 'displaying-display' stamp: ''!
display 
	"Display the receiver on the Display at location 0,0."

	self displayOn: Display! !

!DisplayObject methodsFor: 'displaying-generic' stamp: ''!
displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger fillColor: aForm
	"This is the basic display primitive for graphic display objects. Display 
	the receiver located at aDisplayPoint with rule, ruleInteger, and mask, 
	aForm. Information to be displayed must be confined to the area that 
	intersects with clipRectangle."

	self subclassResponsibility! !

!DisplayObject methodsFor: 'displaying-display' stamp: 'CamilloBruni 10/21/2012 23:43'!
slideWithFirstFrom: startPoint to: stopPoint nSteps: nSteps delay: milliSecs 
	"Slide this object across the display over the given number of steps, 
	pausing for the given number of milliseconds after each step."
	"Note: Does display at the first point and at the last."
	| i p delta |
	i := 0.
	delta := stopPoint - startPoint / nSteps asFloat.
	p := startPoint - delta.
	^ self 
		follow: [(p := p + delta) truncated]
		while: 
			[(Delay forMilliseconds: milliSecs) wait.
			(i := i + 1) <= nSteps]! !

!DisplayObject methodsFor: 'display box access' stamp: ''!
computeBoundingBox
	"Answer the rectangular area that represents the boundaries of the 
	receiver's area for displaying information. This is the primitive for 
	computing the area if it is not already known."

	self subclassResponsibility! !

!DisplayObject methodsFor: 'displaying-display' stamp: 'CamilloBruni 5/9/2013 18:56'!
follow: locationBlock while: durationBlock
   "Move an image around on the Display. Restore the background
   continuously without causing flashing. The argument, locationBlock,
   supplies each new location, and the argument, durationBlock, supplies
   true to continue, and then false to stop."
 
   | bitsBehind loc |
	loc := locationBlock value.
   bitsBehind := Form fromDisplay: (loc extent: self extent).
   ^ self follow: locationBlock while: durationBlock bitsBehind: bitsBehind startingLoc: loc! !

!DisplayObject methodsFor: 'displaying-generic' stamp: ''!
displayOn: aDisplayMedium at: aDisplayPoint rule: ruleInteger
	"Display the receiver located at aPoint with default setting for the 
	halftone and clippingBox."

	self displayOn: aDisplayMedium
		at: aDisplayPoint
		clippingBox: aDisplayMedium boundingBox
		rule: ruleInteger
		fillColor: nil! !

!DisplayObject methodsFor: 'display box access' stamp: ''!
initialExtent
	"Included here for when a FormView is being opened
	as a window.  (4@4) covers border widths."

	^ self extent + (4@4) ! !

!DisplayObject methodsFor: 'transforming' stamp: ''!
align: alignmentPoint with: relativePoint 
	"Translate the receiver's offset such that alignmentPoint aligns with 
	relativePoint."

	self offset: (self offset translateBy: relativePoint - alignmentPoint)! !

!DisplayObject methodsFor: 'displaying-display' stamp: 'di 9/12/97 11:09'!
isTransparent
	^ false! !

!DisplayObject methodsFor: 'displaying-display' stamp: 'CamilloBruni 5/9/2013 18:53'!
slideFrom: startPoint to: stopPoint nSteps: nSteps delay: milliSecs
	"Slide this object across the display over the given number of steps, pausing for the given number of milliseconds after each step."
	"Note: Does not display at the first point, but does at the last."

	| i p delta |
	i := 0.
	p := startPoint.
	delta := (stopPoint - startPoint) / nSteps asFloat.
	^ self
		follow: [
			p := p + delta.
			p truncated]
		while: [
			(Delay forMilliseconds: milliSecs) wait.
			(i := i + 1) < nSteps]
! !

!DisplayObject methodsFor: 'accessing' stamp: ''!
width
	"Answer the number that represents the width of the receiver's bounding 
	box."

	^self boundingBox width! !

!DisplayObject methodsFor: 'displaying-generic' stamp: ''!
displayAt: aDisplayPoint 
	"Display the receiver located at aDisplayPoint with default settings for 
	the displayMedium, rule and halftone."

	self displayOn: Display
		at: aDisplayPoint
		clippingBox: Display boundingBox
		rule: Form over
		fillColor: nil! !

!DisplayObject methodsFor: 'display box access' stamp: ''!
center

	^ self boundingBox center! !

!DisplayObject methodsFor: 'transforming' stamp: ''!
translateBy: aPoint 
	"Translate the receiver's offset."

	self offset: (self offset translateBy: aPoint)! !

!DisplayObject methodsFor: 'displaying-generic' stamp: ''!
displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle 
	"Display the receiver located at aDisplayPoint with default settings for 
	rule and halftone. Information to be displayed must be confined to the 
	area that intersects with clipRectangle."

	self displayOn: aDisplayMedium
		at: aDisplayPoint
		clippingBox: clipRectangle
		rule: Form over
		fillColor: nil! !

!DisplayObject methodsFor: 'accessing' stamp: ''!
extent
	"Answer the point that represents the width and height of the receiver's 
	bounding box."

	^self boundingBox extent! !

!DisplayObject methodsFor: 'accessing' stamp: ''!
relativeRectangle
	"Answer a Rectangle whose top left corner is the receiver's offset position 
	and whose width and height are the same as the receiver."

	^Rectangle origin: self offset extent: self extent! !

!DisplayObject methodsFor: 'transforming' stamp: ''!
scaleBy: aPoint 
	"Scale the receiver's offset by aPoint."

	self offset: (self offset scaleBy: aPoint)! !

!DisplayObject methodsFor: 'accessing' stamp: ''!
offset: aPoint 
	"Set the amount by which the receiver's position is offset."

	^self! !

!DisplayObject methodsFor: 'display box access' stamp: ''!
boundingBox
	"Answer the rectangular area that represents the boundaries of the 
	receiver's space of information."

	^self computeBoundingBox! !

!DisplayObject methodsFor: 'truncation and round off' stamp: ''!
rounded
	"Convert the offset of the receiver to integer coordinates."

	self offset: self offset rounded! !

!DisplayObject methodsFor: 'displaying-display' stamp: 'StephaneDucasse 10/25/2013 16:07'!
follow: locationBlock while: durationBlock bitsBehind: initialBitsBehind startingLoc: loc
   "Move an image around on the Display. Restore the background continuously without causing flashing. The argument, locationBlock, supplies each new location, and the argument, durationBlock, supplies true to continue or false to stop. This variant takes the bitsBehind as an input argument, and returns the final saved saved bits as method value."

   | location rect1 save1 save1Blt buffer bufferBlt newLoc rect2 bothRects |
   location := loc.
   rect1 := location extent: self extent.
   save1 := initialBitsBehind.
   save1Blt := BitBlt toForm: save1.
   buffer := Form extent: self extent*2 depth: Display depth.  "Holds overlapping region"
   bufferBlt := BitBlt toForm: buffer.

   Display deferUpdates: true.
   self displayOn: Display at: location rule: Form paint.
   Display deferUpdates: false; forceToScreen: (location extent: self extent).

   [durationBlock value] whileTrue: [
		newLoc := locationBlock value.
		newLoc ~= location ifTrue: [
			rect2 := newLoc extent: self extent.
			bothRects := rect1 merge: rect2.
			(rect1 intersects: rect2)
				ifTrue: [  "when overlap, buffer background for both rectangles"
					bufferBlt copyFrom: bothRects in: Display to: 0@0.
					bufferBlt copyFrom: save1 boundingBox in: save1 to: rect1 origin - bothRects origin.
					"now buffer is clean background; get new bits for save1"
					save1Blt copy: (0@0 extent: self extent) from: rect2 origin - bothRects origin in: buffer.
					self displayOnPort: bufferBlt at: rect2 origin - bothRects origin rule: Form paint.
					Display deferUpdates: true.
					Display copy: bothRects from: 0@0 in: buffer rule: Form over.
					Display deferUpdates: false; forceToScreen: bothRects]
				ifFalse: [  "when no overlap, do the simple thing (both rects might be too big)"
					Display deferUpdates: true.
					Display copy: (location extent: save1 extent) from: 0@0 in: save1 rule: Form over.
					save1Blt copyFrom: rect2 in: Display to: 0@0.
					self displayOn: Display at: newLoc rule: Form paint.
					Display deferUpdates: false; 
						forceToScreen: (location extent: save1 extent); 
						forceToScreen: (newLoc extent: self extent)].
			location := newLoc.
			rect1 := rect2]].

	^ save1 displayOn: Display at: location
! !

!DisplayScanner commentStamp: 'nice 10/11/2013 23:45'!
A DisplayScanner is an abstract class for displaying characters.
It is splitting text into elementary chunks of displayable String/Font pairs (see scanning protocol).
Subclasses responsibility is to handle the effective rendering of these chunks on various backends.

Instance Variables
	backgroundColor:		<Color>
	defaultTextColor:		<Color>
	foregroundColor:		<Color>
	ignoreColorChanges:		<Boolean>
	lastDisplayableIndex:		<Integer>
	lineY:		<Number>
	morphicOffset:		<Point>
	stopConditionsMustBeReset:		<Boolean>

backgroundColor
	- the background color for displaying next chunk of text.
	Note that this can be set to Color transparent, in which case no background is displayed.

defaultTextColor
	- the default foreground color for displaying text in absence of other text attributes specification 

foregroundColor
	- the foreground color for displaying next chunk of text

ignoreColorChanges
	- indicates that any change of color specified in text attributes shall be ignored.
	This is used for displaying text in a shadow mode, when dragging text for example.

lastDisplayableIndex
	- the index of last character to be displayed.
	A different index than lastIndex is required in order to avoid display of control characters.
	This variable must be updated by the stop condition at each inner scan loop.

lineY
	- the distance between destination form top and current line top

morphicOffset
	- an offset for positionning the embedded morphs.
	THE EXACT SPECIFICATION YET REMAINS TO BE WRITTEN

stopConditionsMustBeReset
	- indicates that it's necessary to call setStopConditions in next scan loop.

Notes:
In order to correctly set the lastDisplayableIndex, the display scanner performs the stopCondition BEFORE displaying the string being scanned.
This explains why the stopCondition must not reset the font immediately, but differ this reset AFTER the display, thanks to stopConditionsMustBeReset.
!
!DisplayScanner methodsFor: 'scanning' stamp: 'nice 10/22/2013 20:51'!
displayLine: textLine offset: offset leftInRun: leftInRun
	"The call on the primitive (scanCharactersFrom:to:in:rightX:) will be interrupted according to an array of stop conditions passed to the scanner at which time the code to handle the stop condition is run and the call on the primitive continued until a stop condition returns true (which means the line has terminated).  leftInRun is the # of characters left to scan in the current run; when 0, it is time to call setStopConditions."
	| stopCondition nowLeftInRun startIndex string lastPos lineHeight stop |
	line := textLine.
	morphicOffset := offset.
	lineY := line top + offset y.
	lineHeight := line lineHeight.
	rightMargin := line rightMargin + offset x.
	lastIndex := line first.
	leftInRun <= 0 ifTrue: [self setStopConditions].
	leftMargin := (line leftMarginForAlignment: alignment) + offset x.
	destX := leftMargin.
	self fillTextBackground.
	lastDisplayableIndex := lastIndex := line first.
	leftInRun <= 0
		ifTrue: [nowLeftInRun := text runLengthFor: lastIndex]
		ifFalse: [nowLeftInRun := leftInRun].
	destY := lineY + line baseline - font ascent.
	runStopIndex := lastIndex + (nowLeftInRun - 1) min: line last.
	spaceCount := 0.
	string := text string.
	[
		"reset the stopping conditions of this displaying loop, and also the font."
		stopConditionsMustBeReset
			ifTrue:[self setStopConditions].
		
		"remember where this portion of the line starts"
		startIndex := lastIndex.
		lastPos := destX@destY.
		
		"find the end of this portion of the line"
		stopCondition := self scanCharactersFrom: lastIndex to: runStopIndex
						in: string rightX: rightMargin.
		"handle the stop condition - this will also set lastDisplayableIndex"
		stop := self perform: stopCondition.
		
		"display that portion of the line"
		lastDisplayableIndex >= startIndex ifTrue:[
			self displayString: string
				from: startIndex 
				to: lastDisplayableIndex 
				at: lastPos].
		
		"if the stop condition were true, stop the loop"
		stop
	] whileFalse.
	^ runStopIndex - lastIndex   "Number of characters remaining in the current run"! !

!DisplayScanner methodsFor: 'displaying' stamp: 'nice 10/19/2013 13:13'!
displayEmbeddedForm: aForm
	self subclassResponsibility! !

!DisplayScanner methodsFor: 'private' stamp: 'EstebanLorenzano 5/3/2014 13:58'!
defaultTextColor
	defaultTextColor ifNil:[ defaultTextColor := Smalltalk ui theme textColor ].
	^defaultTextColor! !

!DisplayScanner methodsFor: 'text attributes' stamp: 'ar 1/8/2000 14:51'!
textColor: textColor
	ignoreColorChanges ifTrue: [^ self].
	foregroundColor := textColor! !

!DisplayScanner methodsFor: 'private' stamp: 'nice 10/11/2013 23:46'!
defaultTextColor: color
	defaultTextColor := color.! !

!DisplayScanner methodsFor: 'displaying' stamp: 'nice 10/12/2013 03:39'!
initialize
	super initialize.
	ignoreColorChanges := false.! !

!DisplayScanner methodsFor: 'stop conditions' stamp: 'nice 10/10/2013 00:13'!
endOfRun
	"The end of a run in the display case either means that there is actually 
	a change in the style (run code) to be associated with the string or the 
	end of this line has been reached."
	| runLength |
	lastDisplayableIndex := lastIndex.
	lastIndex = line last ifTrue: [^true].
	runLength := text runLengthFor: (lastIndex := lastIndex + 1).
	runStopIndex := lastIndex + (runLength - 1) min: line last.
	"differ reset of stopConditions and font AFTER the dispaly of last scanned string"
	stopConditionsMustBeReset := true.
	^ false! !

!DisplayScanner methodsFor: 'private' stamp: 'nice 10/9/2013 23:39'!
setStopConditions
	super setStopConditions.
	stopConditionsMustBeReset := false! !

!DisplayScanner methodsFor: 'displaying' stamp: 'nice 10/12/2013 01:05'!
displayString: string from: startIndex  to: stopIndex at: aPoint
	self subclassResponsibility! !

!DisplayScanner methodsFor: 'displaying' stamp: 'nice 10/12/2013 00:53'!
fillTextBackground
	self subclassResponsibility! !

!DisplayScanner methodsFor: 'stop conditions' stamp: 'nice 10/8/2013 23:36'!
paddedSpace
	"Each space is a stop condition when the alignment is right justified. 
	Padding must be added to the base width of the space according to 
	which space in the line this space is and according to the amount of 
	space that remained at the end of the line when it was composed."

	lastDisplayableIndex := lastIndex - 1.
	spaceCount := spaceCount + 1.
	destX := destX + spaceWidth + kern + (line justifiedPadFor: spaceCount font: font).
	lastIndex := lastIndex + 1.
	pendingKernX := 0.
	^ false! !

!DisplayScanner methodsFor: 'private' stamp: 'SeanDeNigris 1/7/2014 20:59'!
placeEmbeddedObject: anchoredMorphOrForm

	anchoredMorphOrForm relativeTextAnchorPosition ifNotNil:[:relativeTextAnchorPosition |
		anchoredMorphOrForm position: 
			relativeTextAnchorPosition +
			(anchoredMorphOrForm owner textBounds origin x @ (lineY - morphicOffset y)).
		^true
	].
	anchoredMorphOrForm isMorph ifTrue: [
		anchoredMorphOrForm position: (destX@(lineY + line baseline - anchoredMorphOrForm height)) - morphicOffset
	] ifFalse: [
		self displayEmbeddedForm: anchoredMorphOrForm
	].
	destX := destX + anchoredMorphOrForm width + kern.
	^ true! !

!DisplayScanner methodsFor: 'private' stamp: 'nice 10/12/2013 01:33'!
text: t textStyle: ts foreground: foreColor background: backColor fillBlt: blt ignoreColorChanges: shadowMode
	text := t.
	textStyle := ts. 
	foregroundColor := defaultTextColor := foreColor.
	backgroundColor := backColor.
	ignoreColorChanges := shadowMode! !

!DisplayScanner methodsFor: 'stop conditions' stamp: 'nice 10/8/2013 23:37'!
crossedX
	"This condition will sometimes be reached 'legally' during display, when, 
	for instance the space that caused the line to wrap actually extends over 
	the right boundary. This character is allowed to display, even though it 
	is technically outside or straddling the clipping rectangle since it is in 
	the normal case not visible and is in any case appropriately clipped by 
	the scanner."

	self advanceIfFirstCharOfLine.
	lastDisplayableIndex := lastIndex - 1.
	^ true ! !

!DisplayScanner methodsFor: 'private' stamp: 'nice 10/11/2013 23:47'!
setFont 
	foregroundColor := self defaultTextColor.
	super setFont.  "Sets font and emphasis bits, and maybe foregroundColor"
	text ifNotNil:[destY := lineY + line baseline - font ascent]! !

!DisplayScanner methodsFor: 'stop conditions' stamp: 'nice 10/8/2013 23:35'!
cr
	"When a carriage return is encountered, simply increment the pointer 
	into the paragraph."

	pendingKernX := 0.
	lastDisplayableIndex := lastIndex - 1.
	(lastIndex < text size and: [(text at: lastIndex) = CR and: [(text at: lastIndex+1) = Character lf]])
		ifTrue: [lastIndex := lastIndex + 2]
		ifFalse: [lastIndex := lastIndex + 1].
	^false! !

!DisplayScanner methodsFor: 'stop conditions' stamp: 'nice 10/13/2013 22:10'!
tab
	lastDisplayableIndex := lastIndex - 1.
	destX := self plainTab.
	lastIndex := lastIndex + 1.
	^ false! !

!DisplayScanner class methodsFor: 'instance creation' stamp: 'nice 10/12/2013 03:36'!
new
	"Use default concrete class"
	^(self == DisplayScanner
		ifTrue: [BitBltDisplayScanner]
		ifFalse: [self]) basicNew initialize! !

!DisplayScanner class methodsFor: 'queries' stamp: 'ar 5/17/2000 17:39'!
defaultFont
	^ TextStyle defaultFont! !

!DisplayScreen commentStamp: '<historical>'!
There is only one instance of me, Display. It is a global and is used to handle general user requests to deal with the whole display screen. 
	Although I offer no protocol, my name provides a way to distinguish this special instance from all other Forms. This is useful, for example, in dealing with saving and restoring the system.
	To change the depth of your Display...
		Display newDepth: 16.
		Display newDepth: 8.
		Display newDepth: 1.
Valid display depths are 1, 2, 4, 8, 16 and 32.  It is suggested that you run with your monitors setting the same, for better speed and color fidelity.  Note that this can add up to 4Mb for the Display form.  Finally, note that newDepth: ends by executing a 'ControlManager restore' which currently terminates the active process, so nothing that follows in the doit will get executed.

Depths 1, 2, 4 and 8 bits go through a color map to put color on the screen, but 16 and 32-bit color use the pixel values directly for RGB color (5 and 8 bits per, respectivlely).  The color choice an be observed by executing Color fromUser in whatever depth you are using.
!
!DisplayScreen methodsFor: 'initialization' stamp: 'ar 5/28/2000 11:25'!
shutDown 
	"Minimize Display memory saved in image"
	self setExtent: 240@120 depth: depth! !

!DisplayScreen methodsFor: 'other' stamp: 'jm 5/21/1998 23:48'!
forceDisplayUpdate
	"On platforms that buffer screen updates, force the screen to be updated immediately. On other platforms, or if the primitive is not implemented, do nothing."

	<primitive: 231>
	"do nothing if primitive fails"! !

!DisplayScreen methodsFor: 'deferring' stamp: 'MarianoMartinezPeck 5/23/2012 13:38'!
deferUpdatesIn: aRectangle while: aBlock
	| result |
	(self class deferUpdates: true) ifTrue: [^aBlock value].
	result := aBlock value.
	self class deferUpdates: false.
	self forceToScreen: aRectangle.
	^result! !

!DisplayScreen methodsFor: 'private' stamp: 'IgorStasenko 1/21/2011 19:05'!
findAnyDisplayDepth
	"Return any display depth that is supported on this system."
	^self findAnyDisplayDepthIfNone:[
		"Ugh .... now this is a biggie - a system that does not support
		any of the display depths at all."
		Smalltalk
			logError:'Fatal error: This system has no support for any display depth at all.'
			inContext: thisContext.
		Smalltalk quitPrimitive. "There is no way to continue from here"
	].! !

!DisplayScreen methodsFor: 'displaying' stamp: 'sw 1/1/2005 01:31'!
flashAll: rectangleList andWait: msecs
	"Flash the areas of the screen defined by the given rectangles."

	rectangleList do: [:aRectangle | self reverse: aRectangle].
	self forceDisplayUpdate.
	(Delay forMilliseconds: msecs) wait.
	rectangleList do: [:aRectangle | self reverse: aRectangle].
	self forceDisplayUpdate.
	(Delay forMilliseconds: msecs) wait.
! !

!DisplayScreen methodsFor: 'screen managing' stamp: 'SeanDeNigris 11/28/2011 21:53'!
fullscreenOff

	self fullscreen: false! !

!DisplayScreen methodsFor: 'other' stamp: 'CamilloBruni 8/1/2012 16:18'!
usableArea
	"Answer the usable area of the receiver."

	^ self boundingBox deepCopy! !

!DisplayScreen methodsFor: 'private' stamp: 'pavel.krivanek 11/20/2007 09:28'!
newDepthNoRestore: pixelSize
	
	UIManager default newDisplayDepthNoRestore: pixelSize! !

!DisplayScreen methodsFor: 'other' stamp: ''!
height
	^ self boundingBox height! !

!DisplayScreen methodsFor: 'displaying' stamp: 'StephaneDucasse 10/25/2013 16:16'!
copyBits: rect from: sf at: destOrigin clippingBox: clipRect rule: cr fillColor: hf 
	(BitBlt
		destForm: self
		sourceForm: sf
		fillColor: hf
		combinationRule: cr
		destOrigin: destOrigin
		sourceOrigin: rect origin
		extent: rect extent
		clipRect: (clipRect intersect: clippingBox ifNone: [ ^ self ])) copyBits! !

!DisplayScreen methodsFor: 'other' stamp: 'pavel.krivanek 11/20/2007 09:28'!
restore
	
	UIManager default restoreDisplay! !

!DisplayScreen methodsFor: 'other' stamp: 'SeanDeNigris 11/30/2011 14:48'!
fullscreen
	"Display fullscreen"

	ScreenSave notNil ifTrue: [Display := ScreenSave].
	clippingBox := super boundingBox! !

!DisplayScreen methodsFor: 'other' stamp: 'jm 5/19/1998 17:50'!
forceToScreen: aRectangle
	"Force the given rectangular section of the Display to be copied to the screen. The primitive call does nothing if the primitive is not implemented. Typically used when the deferUpdates flag in the virtual machine is on; see deferUpdates:."

	self primShowRectLeft: aRectangle left
		right: aRectangle right
		top: aRectangle top
		bottom: aRectangle bottom.
! !

!DisplayScreen methodsFor: 'private' stamp: 'bf 5/16/2006 11:35'!
setExtent: aPoint depth: bitsPerPixel  "DisplayScreen startUp"
	"This method is critical.  If the setExtent fails, there will be no
	proper display on which to show the error condition..."
	"ar 5/1/1999: ... and that is exactly why we check for the available display depths first."

	"RAA 27 Nov 99 - if depth and extent are the same and acceptable, why go through this.
	also - record when we change so worlds can tell if it is time to repaint"

	(depth == bitsPerPixel and: [aPoint = self extent and: 
					[self supportsDisplayDepth: bitsPerPixel]]) ifFalse: [
		bits := nil.  "Free up old bitmap in case space is low"
		DisplayChangeSignature := (DisplayChangeSignature ifNil: [0]) + 1.
		(self supportsDisplayDepth: bitsPerPixel)
			ifTrue:[super setExtent: aPoint depth: bitsPerPixel]
			ifFalse:[(self supportsDisplayDepth: bitsPerPixel negated)
				ifTrue:[super setExtent: aPoint depth: bitsPerPixel negated]
				ifFalse:["Search for a suitable depth"
					super setExtent: aPoint depth: self findAnyDisplayDepth]].
	].
	clippingBox := super boundingBox! !

!DisplayScreen methodsFor: 'other' stamp: ''!
fullBoundingBox
	^ super boundingBox! !

!DisplayScreen methodsFor: 'other' stamp: 'alain.plantec 5/30/2008 12:43'!
newDepth: pixelSize 
	"
	Display newDepth: 8.
	Display newDepth: 1
	"
	(self supportsDisplayDepth: pixelSize)
		ifFalse: [^ self inform: 'Display depth ' , pixelSize printString , ' is not supported on this system'].
	self newDepthNoRestore: pixelSize.
	self restore! !

!DisplayScreen methodsFor: 'deferring' stamp: 'GuillermoPolito 5/1/2012 14:31'!
deferUpdates: aBoolean
	^self class deferUpdates: aBoolean! !

!DisplayScreen methodsFor: 'other' stamp: 'RAA 11/27/1999 15:48'!
displayChangeSignature

	^DisplayChangeSignature! !

!DisplayScreen methodsFor: 'screen managing' stamp: 'PavelKrivanek 11/17/2012 23:14'!
fullscreen: aBoolean

	Display fullscreenMode: (LastScreenModeSelected := aBoolean).
	DisplayScreen checkForNewScreenSize.
	! !

!DisplayScreen methodsFor: 'other' stamp: 'alain.plantec 6/10/2008 22:29'!
clippingTo: aRect do: aBlock 
	"Display clippingTo: Rectangle fromUser do:"
	| saveClip |
	saveClip := clippingBox.
	clippingBox := aRect.
	aBlock value.
	clippingBox := saveClip! !

!DisplayScreen methodsFor: 'private' stamp: 'jm 6/3/1998 13:00'!
primRetryShowRectLeft: l right: r top: t bottom: b
	"Copy the given rectangular section of the Display to to the screen. This primitive is not implemented on all platforms. Do nothing if it fails. "

	<primitive: 127>
	"do nothing if primitive fails"
! !

!DisplayScreen methodsFor: 'displaying' stamp: 'jm 5/22/1998 01:23'!
flash: aRectangle 
	"Flash the area of the screen defined by the given rectangle."

	self reverse: aRectangle.
	self forceDisplayUpdate.
	(Delay forMilliseconds: 100) wait.
	self reverse: aRectangle.
	self forceDisplayUpdate.
! !

!DisplayScreen methodsFor: 'other' stamp: ''!
replacedBy: aForm do: aBlock
	"Permits normal display to draw on aForm instead of the display."

	ScreenSave := self.
	Display := aForm.
	aBlock value.
	Display := self.
	ScreenSave := nil.! !

!DisplayScreen methodsFor: 'displaying' stamp: 'RAA 6/2/2000 12:09'!
flash: aRectangle andWait: msecs
	"Flash the area of the screen defined by the given rectangle."

	self reverse: aRectangle.
	self forceDisplayUpdate.
	(Delay forMilliseconds: msecs) wait.
	self reverse: aRectangle.
	self forceDisplayUpdate.
	(Delay forMilliseconds: msecs) wait.
! !

!DisplayScreen methodsFor: 'displaying' stamp: 'StephaneDucasse 10/25/2013 16:16'!
copyBits: rect from: sf at: destOrigin clippingBox: clipRect rule: cr fillColor: hf map: map
	((BitBlt
		destForm: self
		sourceForm: sf
		fillColor: hf
		combinationRule: cr
		destOrigin: destOrigin
		sourceOrigin: rect origin
		extent: rect extent
		clipRect: (clipRect intersect: clippingBox ifNone: [ ^ self ] )) colorMap: map) copyBits! !

!DisplayScreen methodsFor: 'other' stamp: 'ar 5/17/2001 21:02'!
supportedDisplayDepths
	"Return all pixel depths supported on the current host platform."
	^#(1 2 4 8 16 32 -1 -2 -4 -8 -16 -32) select: [:d | self supportsDisplayDepth: d]! !

!DisplayScreen methodsFor: 'other' stamp: ''!
width
	^ self boundingBox width! !

!DisplayScreen methodsFor: 'other' stamp: 'pavel.krivanek11/20/2007 09:28'!
restoreAfter: aBlock
	"Evaluate the block, wait for a mouse click, and then restore the screen."

	UIManager default restoreDisplayAfter: aBlock! !

!DisplayScreen methodsFor: 'testing' stamp: 'ar 5/25/2000 23:34'!
isDisplayScreen
	^true! !

!DisplayScreen methodsFor: 'screen managing' stamp: 'SeanDeNigris 11/28/2011 21:53'!
toggleFullscreen
	self fullscreen: self isFullscreen not! !

!DisplayScreen methodsFor: 'private' stamp: 'jm 6/3/1998 13:02'!
primShowRectLeft: l right: r top: t bottom: b
	"Copy the given rectangular section of the Display to to the screen. This primitive is not implemented on all platforms. If this fails, retry integer coordinates."

	<primitive: 127>
	"if this fails, coerce coordinates to integers and try again"
	self primRetryShowRectLeft: l truncated
		right: r rounded
		top: t truncated
		bottom: b rounded.
! !

!DisplayScreen methodsFor: 'screen managing' stamp: 'SeanDeNigris 11/28/2011 21:53'!
fullscreenOn

	self fullscreen: true! !

!DisplayScreen methodsFor: 'private' stamp: 'di 3/3/1999 10:00'!
copyFrom: aForm
	"Take on all state of aForm, with complete sharing"

	super copyFrom: aForm.
	clippingBox := super boundingBox! !

!DisplayScreen methodsFor: 'displaying' stamp: 'nice 1/5/2010 15:59'!
forceDamageToScreen: allDamage
	"Force all the damage rects to the screen."
	| regions rectList |
	rectList := allDamage.
	"Note: Reset extra regions at the beginning to prevent repeated errors"
	regions := extraRegions.
	extraRegions := nil.
	regions ifNotNil:[
		"exclude extra regions"
		regions do:[:drawerAndRect| | excluded remaining |
			excluded := drawerAndRect at: 2.
			remaining := Array new writeStream.
			rectList do:[:r|
				remaining nextPutAll:(r areasOutside: excluded)].
			rectList := remaining contents].
	].
	rectList do:[:r| self forceToScreen: r].
	regions ifNotNil:[
		"Have the drawers paint what is needed"
		regions do:[:drawerAndRect| (drawerAndRect at: 1) forceToScreen].
	].! !

!DisplayScreen methodsFor: 'screen managing' stamp: 'SeanDeNigris 11/28/2011 21:53'!
isFullscreen
	^ self lastScreenModeSelected.! !

!DisplayScreen methodsFor: 'screen managing' stamp: 'RobRothwell 2/23/2009 22:22'!
lastScreenModeSelected
	^ LastScreenModeSelected
		ifNil: [LastScreenModeSelected := false]! !

!DisplayScreen methodsFor: 'other' stamp: 'ar 2/11/1999 18:14'!
forceToScreen
	"Force the entire display area to the screen"
	^self forceToScreen: self boundingBox! !

!DisplayScreen methodsFor: 'private' stamp: ''!
beDisplay
	"Primitive. Tell the interpreter to use the receiver as the current display 
	image. Fail if the form is too wide to fit on the physical display. 
	Essential. See Object documentation whatIsAPrimitive."

	<primitive: 102>
	self primitiveFailed! !

!DisplayScreen methodsFor: 'other' stamp: 'hmm 6/18/2000 19:14'!
primitiveDeferUpdates: aBoolean
	"Set the deferUpdates flag in the virtual machine. When this flag is true, BitBlt operations on the Display are not automatically propagated to the screen. If this underlying platform does not support deferred updates, this primitive will fail. Answer the receiver if the primitive succeeds, nil if it fails."

	<primitive: 126>
	^ nil  "answer nil if primitive fails"
! !

!DisplayScreen methodsFor: 'displaying' stamp: 'ar 4/19/2001 05:44'!
addExtraRegion: aRectangle for: regionDrawer
	"Register the given rectangle as a region which is drawn by the specified region drawer. The region will be excluded from any updates when #forceDamageToScreen: is called. Note that the rectangle is only valid for a single update cycle; once #forceDamageToScreen: has been called, the region drawer and its region are being removed from the list"
	extraRegions ifNil:[extraRegions := #()].
	extraRegions := extraRegions copyWith: (Array with: regionDrawer with: aRectangle).
! !

!DisplayScreen methodsFor: 'other' stamp: 'SeanDeNigris 11/30/2011 14:29'!
fullscreenMode: aBoolean
	"On platforms that support it, set fullscreen mode to the value of the argument. (Note: you'll need to restore the Display after calling this primitive."
	"Display fullscreenMode: true. Display newDepth: Display depth"

	<primitive: 233>
	self primitiveFailed
! !

!DisplayScreen methodsFor: 'other' stamp: ''!
boundingBox
	clippingBox == nil
		ifTrue: [clippingBox := super boundingBox].
	^ clippingBox! !

!DisplayScreen methodsFor: 'private' stamp: 'ar 5/17/2001 21:03'!
findAnyDisplayDepthIfNone: aBlock
	"Return any display depth that is supported on this system.
	If there is none, evaluate aBlock."
	#(1 2 4 8 16 32 -1 -2 -4 -8 -16 -32) do:[:bpp|
		(self supportsDisplayDepth: bpp) ifTrue:[^bpp].
	].
	^aBlock value! !

!DisplayScreen methodsFor: 'other' stamp: 'ar 5/5/1999 23:45'!
supportsDisplayDepth: pixelDepth
	"Return true if this pixel depth is supported on the current host platform.
	Primitive. Optional."
	<primitive: 91>
	^#(1 2 4 8 16 32) includes: pixelDepth! !

!DisplayScreen class methodsFor: 'snapshots' stamp: 'ar 5/28/2000 11:26'!
shutDown 
	"Minimize Display memory saved in image"
	Display shutDown.! !

!DisplayScreen class methodsFor: 'settings' stamp: 'StephaneDucasse 11/11/2014 18:40'!
displaySettingsOn: aBuilder 
	<systemsettings>
	(aBuilder setting: #displayFullscreen)
		label: 'Fullscreen mode';
		parent: #desktopSettings;
		target: #Display;
		getSelector: #isFullscreen;
		setSelector: #fullscreen:;
		description: 'On platforms that support it, set fullscreen mode';
		default: false.
! !

!DisplayScreen class methodsFor: 'host window access' stamp: 'bf 8/22/2009 01:27'!
hostWindowSize: aPoint 
	self primitiveWindowSize: self hostWindowIndex width: aPoint x heigth: aPoint y
! !

!DisplayScreen class methodsFor: 'snapshots' stamp: 'CamilloBruni 5/24/2012 11:07'!
actualScreenDepth
	<primitive: 'primitiveScreenDepth'>
	^ Display depth! !

!DisplayScreen class methodsFor: 'host window access' stamp: 'EstebanLorenzano 1/10/2012 11:36'!
hostWindowTitle: aString 
	self 
		primitiveWindowTitle: self hostWindowIndex 
		string: (UTF8TextConverter default convertFromSystemString: aString)! !

!DisplayScreen class methodsFor: 'deferring' stamp: 'GuillermoPolito 5/1/2012 14:30'!
deferUpdates: aBoolean
	| wasDeferred |
	"Set the deferUpdates flag in the virtual machine. When this flag is true, BitBlt operations on the Display are not automatically propagated to the screen. If this underlying platform does not support deferred updates, this primitive will fail. Answer whether updates were deferred before if the primitive succeeds, nil if it fails."

	wasDeferred := DeferringUpdates == true.
	DeferringUpdates := aBoolean.
	^(self primitiveDeferUpdates: aBoolean) ifNotNil: [wasDeferred]! !

!DisplayScreen class methodsFor: 'class initialization' stamp: 'GuillermoPolito 5/1/2012 14:34'!
initialize
	self deferUpdates: false.! !

!DisplayScreen class methodsFor: 'snapshots' stamp: 'ar 5/17/2001 15:50'!
startUp  "DisplayScreen startUp"
	Display setExtent: self actualScreenSize depth: Display nativeDepth.
	Display beDisplay! !

!DisplayScreen class methodsFor: 'host window access' stamp: 'bf 4/29/2009 21:50'!
primitiveWindowTitle: id string: titleString 
	<primitive: 'primitiveHostWindowTitle' module:'HostWindowPlugin'>
	"ignore failure"! !

!DisplayScreen class methodsFor: 'deferring' stamp: 'GuillermoPolito 5/1/2012 14:29'!
primitiveDeferUpdates: aBoolean
	"Set the deferUpdates flag in the virtual machine. When this flag is true, BitBlt operations on the Display are not automatically propagated to the screen. If this underlying platform does not support deferred updates, this primitive will fail. Answer the receiver if the primitive succeeds, nil if it fails."

	<primitive: 126>
	^ nil  "answer nil if primitive fails"! !

!DisplayScreen class methodsFor: 'host window access' stamp: 'bf 8/22/2009 01:26'!
primitiveWindowSize: id width: width heigth: height 
	<primitive: 'primitiveHostWindowSizeSet' module: 'HostWindowPlugin'>
	"ignore failure"! !

!DisplayScreen class methodsFor: 'display box access' stamp: 'VeronicaUquillas 6/11/2010 13:57'!
depth: depthInteger width: widthInteger height: heightInteger fullscreen: aBoolean
	"Force Pharo's window (if there's one) into a new size and depth."
	"DisplayScreen depth: 8 width: 1024 height: 768 fullscreen: false"

	<primitive: 92>
	self primitiveFailed ! !

!DisplayScreen class methodsFor: 'display box access' stamp: ''!
boundingBox
	"Answer the bounding box for the form representing the current display 
	screen."

	^Display boundingBox! !

!DisplayScreen class methodsFor: 'snapshots' stamp: 'RonieSalgado 5/10/2014 01:50'!
actualScreenSize
	<primitive: 106>
	^ World osWindow extent! !

!DisplayScreen class methodsFor: 'display box access' stamp: 'pavel.krivanek 11/20/2007 10:57'!
checkForNewScreenSize
	"Check whether the screen size has changed and if so take appropriate actions"

	UIManager default checkForNewDisplaySize! !

!DisplayScreen class methodsFor: 'host window access' stamp: ''!
hostWindowIndex
	^ 1! !

!DisplayTransform commentStamp: '<historical>'!
This class represents a base for generic transformations of 2D points between different coordinate systems (including scaling and rotation). The transformations map objects between one coordinate system and another where it is assumed that a nested hierarchy of transformations can be defined.

It is assumed that transformations deal with Integer points. All transformations should return Integer coordinates (even though float points may be passed in as argument).

Compositions of transformations MUST work in the following order. A 'global' transformation (the argument in #composedWithGlobal:) is defined as a transformation that takes place between the receiver (the 'local') transformation and any 'global' point computations, whereas a 'local' transformation (e.g., the argument in #composedWithLocal:) takes place between the receiver ('global') and any 'local' points. For the transformation methods this means that combining a global and a local transformation will result in the following order:

		globalPointToLocal: globalPoint
			"globalPoint -> globalTransform -> localTransform -> locaPoint"
			^localTransform globalPointToLocal:
				(globalTransform globalPointToLocal: globalPoint)

		localPointToGlobal: localPoint
			"localPoint -> localTransform -> globalTransform -> globalPoint"
			^globalTransform localPointToGlobal:
				(localTransform localPointToGlobal: localPoint)

!
!DisplayTransform methodsFor: 'transforming rects' stamp: 'ar 11/2/1998 16:19'!
localBoundsToGlobal: aRectangle
	"Transform aRectangle from local coordinates into global coordinates"
	^Rectangle encompassing: (self localPointsToGlobal: aRectangle corners)! !

!DisplayTransform methodsFor: 'testing' stamp: 'ar 11/2/1998 16:17'!
isIdentity
	"Return true if the receiver is the identity transform; that is, if applying to a point returns the point itself."
	^self subclassResponsibility! !

!DisplayTransform methodsFor: 'converting' stamp: 'ar 11/2/1998 19:59'!
asCompositeTransform
	"Represent the receiver as a composite transformation"
	^CompositeTransform new
		globalTransform: self
		localTransform: self species identity! !

!DisplayTransform methodsFor: 'transforming points' stamp: 'ar 11/2/1998 16:18'!
localPointToGlobal: aPoint
	"Transform aPoint from local coordinates into global coordinates"
	^self subclassResponsibility! !

!DisplayTransform methodsFor: 'transforming rects' stamp: 'di 10/25/1999 12:49'!
sourceQuadFor: aRectangle
	^ aRectangle innerCorners collect: 
		[:p | self globalPointToLocal: p]! !

!DisplayTransform methodsFor: 'initialize' stamp: 'ar 11/2/1998 23:18'!
setIdentity
	"Initialize the receiver to the identity transformation (e.g., not affecting points)"
	^self subclassResponsibility! !

!DisplayTransform methodsFor: 'transforming points' stamp: 'ar 11/9/1998 14:35'!
localPointsToGlobal: inArray
	"Transform all the points of inArray from local into global coordinates"
	^inArray collect:[:pt| self localPointToGlobal: pt]! !

!DisplayTransform methodsFor: 'testing' stamp: 'ar 11/2/1998 22:48'!
isMorphicTransform
	"Return true if the receiver is a MorphicTransform, that is specifies the transformation values explicitly."
	^false! !

!DisplayTransform methodsFor: 'testing' stamp: 'ar 11/2/1998 16:16'!
isPureTranslation
	"Return true if the receiver specifies no rotation or scaling."
	^self subclassResponsibility! !

!DisplayTransform methodsFor: 'composing' stamp: 'ar 11/2/1998 16:41'!
composedWithLocal: aTransformation
	"Return the composition of the receiver and the local transformation passed in.
	A 'local' transformation is defined as a transformation that takes place
	between the receiver (the 'global') transformation and any 'local' point
	computations, e.g., for the methods

		globalPointToLocal: globalPoint
			globalPoint -> globalTransform -> localTransform -> locaPoint

		localPointToGlobal: localPoint
			localPoint -> localTransform -> globalTransform -> globalPoint

		"
	self isIdentity ifTrue:[^ aTransformation].
	aTransformation isIdentity ifTrue:[^ self].
	^ CompositeTransform new globalTransform: self
							localTransform: aTransformation! !

!DisplayTransform methodsFor: 'testing' stamp: 'ar 11/2/1998 22:47'!
isCompositeTransform
	"Return true if the receiver is a composite transformation.
	Composite transformations may have impact on the accuracy."
	^false! !

!DisplayTransform methodsFor: 'testing' stamp: 'ar 11/2/1998 22:48'!
isMatrixTransform2x3
	"Return true if the receiver is 2x3 matrix transformation"
	^false! !

!DisplayTransform methodsFor: 'transforming points' stamp: 'ar 11/9/1998 14:35'!
globalPointsToLocal: inArray
	"Transform all the points of inArray from global into local coordinates"
	^inArray collect:[:pt| self globalPointToLocal: pt]! !

!DisplayTransform methodsFor: 'transforming points' stamp: 'gh 10/22/2001 13:24'!
invertBoundsRect: aRectangle
	"Return a rectangle whose coordinates have been transformed
	from local back to global coordinates."

	^self subclassResponsibility! !

!DisplayTransform methodsFor: 'accessing' stamp: 'ar 11/2/1998 19:43'!
inverseTransformation
	"Return the inverse transformation of the receiver"
	^self subclassResponsibility! !

!DisplayTransform methodsFor: 'composing' stamp: 'ar 11/2/1998 16:15'!
composedWithGlobal: aTransformation
	"Return the composition of the receiver and the global transformation passed in.
	A 'global' transformation is defined as a transformation that takes place
	between the receiver (the 'local') transformation and any 'global' point
	computations, e.g., for the methods

		globalPointToLocal: globalPoint
			globalPoint -> globalTransform -> localTransform -> locaPoint

		localPointToGlobal: localPoint
			localPoint -> localTransform -> globalTransform -> globalPoint

		"
	^aTransformation composedWithLocal: self! !

!DisplayTransform methodsFor: 'transforming rects' stamp: 'ar 11/2/1998 16:19'!
globalBoundsToLocal: aRectangle
	"Transform aRectangle from global coordinates into local coordinates"
	^Rectangle encompassing: (self globalPointsToLocal: aRectangle corners)! !

!DisplayTransform methodsFor: 'transforming points' stamp: 'ar 11/2/1998 16:17'!
globalPointToLocal: aPoint
	"Transform aPoint from global coordinates into local coordinates"
	^self subclassResponsibility! !

!DisplayTransform methodsFor: 'converting' stamp: 'ar 11/2/1998 20:01'!
asMatrixTransform2x3
	"Represent the receiver as a 2x3 matrix transformation"
	^self subclassResponsibility! !

!DisplayTransform class methodsFor: 'instance creation' stamp: 'ar 11/2/1998 20:55'!
identity
	^self new setIdentity! !

!DoItDeclaration commentStamp: '<historical>'!
I represent the declaration of some code to evaluate.  My contents are the code to evaluate.

Sending me the message #import makes me evaluate the code and return the result of the computation.

Be careful, my #import method also handles ChangeSet interaction so far, handling Changeset preambles and Postscripts.!
!DoItDeclaration methodsFor: 'importing' stamp: 'MartinDias 2/7/2014 16:11'!
importFor: requestor
	self flag: #fixme. "Ugly hack to parse preamble and postcript as a do it."
	((contents beginsWith: '"Change Set:') and: [ ChangeSet current preambleString isNil ])
		ifTrue: [ ChangeSet current preambleString: contents ].
	((contents beginsWith: '"Postscript:') and: [ ChangeSet current postscriptString isNil ])
		ifTrue: [ ChangeSet current postscriptString: contents ].

	^Smalltalk compiler class new
		source: contents;
		requestor: requestor;
		logged: true;
		evaluate.! !

!DoItDeclaration methodsFor: 'importing' stamp: 'CamilloBruni 7/10/2013 16:00'!
import
	^ self importFor: nil! !

!DockingBarMenuItemMorph commentStamp: 'StephaneDucasse 9/28/2014 15:18'!
A DockingBarMenuItemMorph is a specialized version of its superclass for DockingBar behavior.
!
!DockingBarMenuItemMorph methodsFor: 'events' stamp: 'StephaneDucasse 9/28/2014 16:05'!
deselectTimeOut: evt
	"Deselect timout. Now really deselect"

	owner selectedItem == self
		ifTrue: [ 
			evt hand releaseMouseFocus: owner.
			owner selectItem: nil event: evt ]! !

!DockingBarMenuItemMorph methodsFor: 'private' stamp: 'StephaneDucasse 9/28/2014 15:36'!
updateLayoutInDockingBar

	owner isVertical
		ifTrue: [
			self hResizing: #spaceFill.
			self vResizing: #shrinkWrap]
		ifFalse: [
			self hResizing: #shrinkWrap.
			self vResizing: #spaceFill].
	self extent: self minWidth @ self minHeight! !

!DockingBarMenuItemMorph methodsFor: 'events' stamp: 'StephaneDucasse 9/28/2014 15:55'!
mouseEnter: evt
	"The mouse entered the receiver"

	owner ifNotNil: [owner stayUp ifFalse: [self mouseEnterDragging: evt]].
	(owner selectedItem notNil
				and: [owner selectedItem ~~ self])
			ifTrue: [owner selectItem: self event: evt.].

! !

!DockingBarMenuItemMorph methodsFor: 'drawing' stamp: 'StephaneDucasse 9/28/2014 15:52'!
drawOn: aCanvas 
	| stringColor stringBounds |
	(isSelected and: [ isEnabled ])
		ifTrue: [aCanvas fillRectangle: self bounds fillStyle: self selectionFillStyle.
			stringColor := color negated]
		ifFalse: [stringColor := color].
	stringBounds := bounds.
	stringBounds := stringBounds left: stringBounds left + 4.
	self hasIcon
		ifTrue: [| iconForm | 
			iconForm := self iconForm.
			aCanvas translucentImage: iconForm at: stringBounds left @ (self top + (self height - iconForm height // 2)).
			stringBounds := stringBounds left: stringBounds left + iconForm width + 2].
	self hasMarker
		ifTrue: [stringBounds := stringBounds left: stringBounds left + self submorphBounds width + 8].
	stringBounds := stringBounds top: stringBounds top + stringBounds bottom - self fontToUse height // 2.
	aCanvas
		drawString: self contents
		in: stringBounds
		font: self fontToUse
		color: stringColor.
	self hasSubMenu
		ifTrue: [| subMenuMarker subMenuMarkerPosition | 
			subMenuMarker := self subMenuMarker.
			subMenuMarkerPosition := self right - subMenuMarker width @ (self top + self bottom - subMenuMarker height // 2).
			subMenuMarkerPosition := subMenuMarkerPosition - (4 @ -1).
			aCanvas paintImage: subMenuMarker at: subMenuMarkerPosition]! !

!DockingBarMenuItemMorph methodsFor: 'events' stamp: 'StephaneDucasse 9/28/2014 15:56'!
mouseUp: evt
	"Handle a mouse up event. Menu items get activated when the mouse is over them. Do nothing if we're not in a 'valid menu transition', meaning that the current hand focus must be aimed at the owning menu."
	evt hand mouseFocus == owner ifFalse: [^self].
	
	self contentString ifNotNil:[
		self contents: self contentString withMarkers: true inverse: true.
		self refreshWorld.
		(Delay forMilliseconds: 200) wait].
	owner rootMenu selectItem: nil event: evt.
	self invokeWithEvent: evt.		
! !

!DockingBarMenuItemMorph methodsFor: 'private' stamp: 'StephaneDucasse 9/28/2014 15:53'!
subMenuMarker
	"private - answer the form to be used as submenu marker"

	owner isFloating
		ifTrue: [ ^ self bottomArrow ].
	owner isAdheringToTop
		ifTrue: [ ^ self bottomArrow ].
	owner isAdheringToBottom
		ifTrue: [ ^ self upArrow ].
	owner isAdheringToLeft
		ifTrue: [ ^ self rightArrow ].
	owner isAdheringToRight
		ifTrue: [ ^ self leftArrow ].
	^ self rightArrow! !

!DockingBarMenuItemMorph methodsFor: 'selecting' stamp: 'StephaneDucasse 9/28/2014 15:22'!
adjacentTo
	owner isFloating
		ifTrue: [^ {self bounds bottomLeft + (5 @ 5)}].
	owner isAdheringToTop
		ifTrue: [^ {self bounds bottomLeft + (5 @ 5)}].
	owner isAdheringToLeft
		ifTrue: [^ {self bounds topRight + (5 @ 5)}].
	owner isAdheringToBottom
		ifTrue: [^ {self bounds topLeft + (5 @ 5)}].
	owner isAdheringToRight
		ifTrue: [^ {self bounds topLeft + (5 @ -5)}].
	^ {self bounds bottomLeft + (3 @ 5)}! !

!DockingBarMenuItemMorph methodsFor: 'events' stamp: 'StephaneDucasse 9/28/2014 16:01'!
mouseDown: evt
	"Handle a mouse down event. Menu items get activated when the mouse is over them."

	evt shiftPressed ifTrue: [^ super mouseDown: evt].  "enable label editing"
	isSelected
		ifTrue: [
			evt hand newMouseFocus: nil.
			owner selectItem: nil event: evt. ]
		ifFalse: [
			evt hand newMouseFocus: owner. "Redirect to menu for valid transitions"
			owner selectItem: self event: evt. ]
! !

!DockingBarMenuItemMorph methodsFor: 'rounding' stamp: 'StephaneDucasse 9/28/2014 15:47'!
wantsRoundedCorners
	^  true
		! !

!DockingBarMenuItemMorph methodsFor: 'change reporting' stamp: 'StephaneDucasse 9/28/2014 15:37'!
ownerChanged
	"The receiver's owner, some kind of a pasteup, has changed its 
	layout."
	super ownerChanged.
	self updateLayoutInDockingBar! !

!DockingBarMenuItemMorph methodsFor: 'submorphs-accessing' stamp: 'StephaneDucasse 9/28/2014 15:35'!
noteNewOwner: aMorph 
	"I have just been added as a submorph of aMorph"
	super noteNewOwner: aMorph.

	self updateLayoutInDockingBar! !

!DockingBarMenuItemMorph methodsFor: 'submorphs-accessing' stamp: 'StephaneDucasse 9/28/2014 15:49'!
roundedCorners
	"Return a list of those corners to round"
	owner isFloating
		ifTrue: [^ #(1 4 )].
	owner isAdheringToTop
		ifTrue: [^ #(1 4 )].
	owner isAdheringToBottom
		ifTrue: [^ #(2 3 )].
	owner isAdheringToLeft
		ifTrue: [^ #(1 2 )].
	owner isAdheringToRight
		ifTrue: [^ #(3 4 )].
	^ #(1 2 3 4 )! !

!DockingBarMenuLineMorph commentStamp: 'StephaneDucasse 9/28/2014 15:16'!
A DockingBarMenuLineMorph is specialized version of its superclass for DockingBar behavior.
!
!DockingBarMenuLineMorph methodsFor: 'private' stamp: 'StephaneDucasse 9/28/2014 15:27'!
updateLayoutInDockingBar

	owner isVertical
		ifFalse: [
			self hResizing: #shrinkWrap.
			self vResizing: #spaceFill]
		ifTrue: [
			self hResizing: #spaceFill.
			self vResizing: #shrinkWrap].
	self extent: self minWidth @ self minHeight! !

!DockingBarMenuLineMorph methodsFor: 'submorphs-accessing' stamp: 'StephaneDucasse 9/28/2014 15:35'!
noteNewOwner: aMorph 
	"I have just been added as a submorph of aMorph"
	super noteNewOwner: aMorph.
	self updateLayoutInDockingBar! !

!DockingBarMenuLineMorph methodsFor: 'change reporting' stamp: 'StephaneDucasse 9/28/2014 15:28'!
ownerChanged
	"The receiver's owner, some kind of a pasteup, has changed its layout."
	super ownerChanged.
	self updateLayoutInDockingBar! !

!DockingBarMenuLineMorph methodsFor: 'layout' stamp: 'StephaneDucasse 9/28/2014 15:26'!
minHeight
	"Answer the receiver's minHeight"
	
	^owner isVertical
				ifTrue: [ self theme menuBorderWidth ]
				ifFalse: [10]
	! !

!DockingBarMenuLineMorph methodsFor: 'layout' stamp: 'StephaneDucasse 9/28/2014 15:26'!
minWidth
	"Answer the receiver's minWidth"

	^ owner isVertical
		ifTrue: [ 10 ]
		ifFalse: [ self theme menuBorderWidth ]! !

!DockingBarMenuMorph methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 9/30/2014 12:18'!
veryDeepInner: deepCopier
	"Copy all of my instance variables.  Some need to be not copied at all, but shared.  	Warning!!!!  Every instance variable defined in this class must be handled.  We must also implement veryDeepFixupWith:.  See DeepCopier class comment."

	super veryDeepInner: deepCopier.
	activatorDockingBar := activatorDockingBar.  "Weakly copied"

! !

!DockingBarMenuMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 9/30/2014 12:03'!
wasActivatedFromDockingBar
	"answer true if the receiver was activated from a docking bar"
	^ activatorDockingBar notNil! !

!DockingBarMenuMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 9/30/2014 12:43'!
activatedFromDockingBar: aDockingBar 
	activatorDockingBar := aDockingBar! !

!DockingBarMenuMorph methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 9/30/2014 12:01'!
activeSubmenu: aSubmenu 
	super activeSubmenu: aSubmenu.
	aSubmenu
		ifNotNil: [activeSubMenu activatedFromDockingBar: nil]! !

!DockingBarMenuMorph methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 9/30/2014 12:03'!
roundedCorners
	"Return a list of those corners to round"
	self wasActivatedFromDockingBar
		ifTrue: [
			activatorDockingBar isFloating
				ifTrue: [^ #(2 3 )].
			activatorDockingBar isAdheringToTop
				ifTrue: [^ #(2 3 )].
			activatorDockingBar isAdheringToBottom
				ifTrue: [^ #(1 4 )].
			activatorDockingBar isAdheringToLeft
				ifTrue: [^ #(3 4 )].
			activatorDockingBar isAdheringToRight
				ifTrue: [^ #(1 2 )]].
	^ super roundedCorners! !

!DockingBarMorph commentStamp: 'LaurentLaffont 3/4/2011 22:42'!
I'm a kind of container which adhere to one edge of the screen. See me in action with: 

DockingBarMorph new 
	addMorph: (SimpleButtonMorph new
                                           label: 'Say hello';
                                           target: [UIManager inform: 'Hello'];
                                           actionSelector: #value);
	addMorph: (SimpleButtonMorph new
                                           label: 'Say bonjour';
                                           target: [UIManager inform: 'Bonjour'];
                                           actionSelector: #value);
	addMorph: (SimpleButtonMorph new
                                           label: 'Close';
                                           target: [DockingBarMorph allInstances last delete];
                                           actionSelector: #value);
	adhereToBottom;
	openInWorld.!
!DockingBarMorph methodsFor: 'accessing' stamp: 'dgd 8/31/2004 13:57'!
fillsOwner: aBoolean 
	"Instruct the receiver to fill the owner or not"
	fillsOwner := aBoolean.
self updateLayoutProperties! !

!DockingBarMorph methodsFor: 'accessing' stamp: 'dgd 8/31/2004 14:28'!
autoGradient: aBoolean 
	"Instruct the receiver to fill the owner or not"
	autoGradient := aBoolean.
	self updateColor! !

!DockingBarMorph methodsFor: 'menu' stamp: 'StephaneDucasse 4/22/2012 16:48'!
avoidVisibleBordersAtEdgeString
	"Answer the string to be shown in a menu to represent the visible status"
	^ (self avoidVisibleBordersAtEdge) ->  'avoid visible borders at edge' translated! !

!DockingBarMorph methodsFor: 'construction' stamp: 'NicolaiHess 3/5/2015 09:30'!
add: wordingString icon: aForm subMenu: aMenuMorph 
	"Append the given submenu with the given label."

	^ self add: wordingString icon: aForm help: nil subMenu: aMenuMorph ! !

!DockingBarMorph methodsFor: 'testing' stamp: 'dgd 8/31/2004 11:57'!
isAdheringToLeft
	"Answer true if the receiver is adhering to left"
	^ self edgeToAdhereTo == #left! !

!DockingBarMorph methodsFor: 'private - accessing' stamp: 'MarcusDenker 10/12/2013 11:41'!
usedWidthByPredominantDockingBarsOfChastes: predominantChastes 
	"Private - convenience"
	^(self predominantDockingBarsOfChastes: predominantChastes)
		ifEmpty: [0]
		ifNotEmpty: [:predominants | (predominants collect: [:each | each width]) sum]! !

!DockingBarMorph methodsFor: 'construction' stamp: 'NicolaiHess 3/5/2015 09:30'!
add: wordingString icon: aForm help: helpString subMenu: aMenuMorph 
	"Append the given submenu with the given label."
	| item |
	item := DockingBarMenuItemMorph new.
	item contents: wordingString.
	item subMenu: aMenuMorph.
	item icon: aForm.
	helpString ifNotNil: [item setBalloonText: helpString].
	self addMorphBack: item! !

!DockingBarMorph methodsFor: 'menu' stamp: 'dgd 9/29/2004 20:26'!
toggleAvoidVisibleBordersAtEdge
	self avoidVisibleBordersAtEdge: self avoidVisibleBordersAtEdge not! !

!DockingBarMorph methodsFor: 'accessing' stamp: 'MarcusDenker 12/11/2009 23:58'!
color: aColor 
	"Set the receiver's color."
	super color: aColor.
	originalColor := aColor asColor.
	self updateColor! !

!DockingBarMorph methodsFor: 'private - layout' stamp: 'dgd 9/1/2004 15:29'!
updateBounds
	"private - update the receiver's bounds"
	self updateExtent.
	self isFloating
		ifFalse: [self updatePosition]! !

!DockingBarMorph methodsFor: 'accessing' stamp: 'dgd 9/9/2004 19:45'!
rootMenu
	^ self! !

!DockingBarMorph methodsFor: 'initialization' stamp: 'FernandoOlivero 4/12/2011 09:44'!
initialize
	"initialize the receiver"
	super initialize.
	""
	selectedItem := nil.
	activeSubMenu := nil.
	fillsOwner := true.
	avoidVisibleBordersAtEdge := true.
	autoGradient := self theme preferGradientFill.
	""
	self setDefaultParameters.
	""
	self beFloating.
	""
	self layoutInset: 0.
	! !

!DockingBarMorph methodsFor: 'testing' stamp: 'dgd 8/31/2004 11:58'!
isVertical
	"Answer true if the receiver has a vertical layout"
	^ self isAdheringToLeft
		or: [self isAdheringToRight]
! !

!DockingBarMorph methodsFor: 'accessing' stamp: 'dgd 8/31/2004 14:28'!
autoGradient
	"Answer if the receiver is in autoGradient mode"
	^ autoGradient! !

!DockingBarMorph methodsFor: 'accessing' stamp: 'dgd 8/31/2004 12:01'!
adhereToRight
	"Instract the receiver to adhere to right"
	self adhereTo: #right! !

!DockingBarMorph methodsFor: 'testing' stamp: 'dgd 8/31/2004 11:58'!
isHorizontal
	"Answer true if the receiver has a horizontal layout"
	^ self isAdheringToTop
		or: [self isAdheringToBottom]! !

!DockingBarMorph methodsFor: 'construction' stamp: 'dgd 8/31/2004 11:34'!
addSpacer
	"Add a new spacer to the receiver. 
	 
	Spacer are objects that try to use as much space as they can"
	self
		addMorphBack: (AlignmentMorph newSpacer: Color transparent)! !

!DockingBarMorph methodsFor: 'submorphs-accessing' stamp: 'dgd 9/1/2004 18:41'!
noteNewOwner: aMorph 
	"I have just been added as a submorph of aMorph"
	super noteNewOwner: aMorph.

	self submorphs
		do: [:each | each adjustLayoutBounds].
! !

!DockingBarMorph methodsFor: 'private - layout' stamp: 'MarcusDenker 12/12/2009 00:06'!
updateLayoutProperties
	"private - update the layout properties based on adhering,  
	fillsOwner and avoidVisibleBordersAtEdge preferencs"

	(self isHorizontal or: [self isFloating])
		ifTrue: [self listDirection: #leftToRight]
		ifFalse: [self listDirection: #topToBottom].

	self hResizing: #shrinkWrap.
	self vResizing: #shrinkWrap.
	self fillsOwner ifTrue: [
			self isHorizontal ifTrue: [self hResizing: #spaceFill].
			self isVertical ifTrue: [self vResizing: #spaceFill]].
	! !

!DockingBarMorph methodsFor: 'construction' stamp: 'StephaneDucasse 9/28/2014 15:19'!
addLine
	"Append a divider line to this menu. Suppress duplicate lines."

	submorphs isEmpty ifTrue: [^ self].
	(self lastSubmorph isKindOf: DockingBarMenuLineMorph)
		ifFalse: [self addMorphBack: DockingBarMenuLineMorph new].
! !

!DockingBarMorph methodsFor: 'accessing' stamp: 'dgd 9/13/2004 19:59'!
addBlankIconsIfNecessary: anIcon 
	"If any of my items have an icon, ensure that all do by using 
	anIcon for those that don't"
	self items
		reject: [:each | each hasIconOrMarker]
		thenDo: [:each | each icon: anIcon]! !

!DockingBarMorph methodsFor: 'testing' stamp: 'dgd 8/31/2004 11:57'!
isAdheringToTop
	"Answer true if the receiver is adhering to top"
	^ self edgeToAdhereTo == #top! !

!DockingBarMorph methodsFor: 'menu' stamp: 'StephaneDucasse 9/28/2014 15:18'!
add: wordingString font: aFont icon: aForm help: helpString subMenu: aMenuMorph 
	"Append the given submenu with the given label."
	
	| item |
	item := DockingBarToggleMenuItemMorph new.
	item
		font: aFont;
		contents: wordingString;
		subMenu: aMenuMorph;
		icon: aForm.
	helpString isNil
		ifFalse: [item setBalloonText: helpString].
	self addMorphBack: item! !

!DockingBarMorph methodsFor: 'accessing' stamp: 'gvc 4/26/2007 15:27'!
originalColor
	"Answer the original color."
	
	^originalColor! !

!DockingBarMorph methodsFor: 'accessing' stamp: 'dgd 8/31/2004 12:01'!
adhereToBottom
	"Instract the receiver to adhere to bottom"
	 self adhereTo:#bottom! !

!DockingBarMorph methodsFor: 'menu' stamp: 'dgd 9/29/2004 20:27'!
toggleAutoGradient
	self autoGradient: self autoGradient not! !

!DockingBarMorph methodsFor: 'testing' stamp: 'dgd 8/31/2004 15:00'!
isDockingBar
	"Return true if the receiver is a docking bar"
	^ true! !

!DockingBarMorph methodsFor: 'menu' stamp: 'StephaneDucasse 4/22/2012 16:47'!
autoGradientString
	"Answer the string to be shown in a menu to represent the  'resistsRemoval' status"
	
	^ (self autoGradient) ->  'auto gradient' translated! !

!DockingBarMorph methodsFor: 'submorphs-add/remove' stamp: 'dgd 9/1/2004 19:26'!
delete
	activeSubMenu
		ifNotNil: [activeSubMenu delete].
	^ super delete! !

!DockingBarMorph methodsFor: 'dropping/grabbing' stamp: 'AlainPlantec 10/17/2009 17:03'!
aboutToBeGrabbedBy: aHand 
	"The morph is about to be grabbed, make it float"
	self beFloating.
	self updateBounds.
	self updateColor.
	(self bounds containsPoint: aHand position)
		ifFalse: [self center: aHand position].
! !

!DockingBarMorph methodsFor: 'control' stamp: 'dgd 9/1/2004 16:48'!
deleteIfPopUp: evt 
	evt
		ifNotNil: [evt hand releaseMouseFocus: self]! !

!DockingBarMorph methodsFor: 'testing' stamp: 'dgd 8/31/2004 11:57'!
isAdheringToRight
	"Answer true if the receiver is adhering to right"
	^ self edgeToAdhereTo == #right! !

!DockingBarMorph methodsFor: 'menu' stamp: 'AlainPlantec 12/18/2009 22:32'!
wantsYellowButtonMenu
	"Answer true if the receiver wants a yellow button menu.
	Fixed for when defaultYellowButtonMenuEnabled setting is off"
	
	^ self defaultYellowButtonMenuEnabled! !

!DockingBarMorph methodsFor: 'accessing' stamp: 'dgd 8/31/2004 13:35'!
fillsOwner
	"Answer if the receiver is in fillOwner mode"
	^ fillsOwner! !

!DockingBarMorph methodsFor: 'testing' stamp: 'dgd 9/1/2004 16:39'!
stayUp
	^ false! !

!DockingBarMorph methodsFor: 'private - layout' stamp: 'MarcusDenker 12/11/2009 23:58'!
gradientRamp: colorRamp 
	gradientRamp := colorRamp.
	self updateColor! !

!DockingBarMorph methodsFor: 'testing' stamp: 'dgd 8/31/2004 16:33'!
wantsToBeTopmost
	"Answer if the receiver want to be one of the topmost objects in 
	its owner"
	^ true! !

!DockingBarMorph methodsFor: 'construction' stamp: 'dgd 9/1/2004 19:08'!
add: aString subMenu: aMenuMorph 
	"Append the given submenu with the given label."
	self add: aString icon: nil subMenu: aMenuMorph ! !

!DockingBarMorph methodsFor: 'accessing' stamp: 'gvc 9/25/2006 13:37'!
adoptPaneColor: paneColor
	"Change our color too."
	
	super adoptPaneColor: paneColor.
	paneColor ifNil: [^self].
	originalColor :=  paneColor.
	self borderStyle baseColor: paneColor.
	self updateColor! !

!DockingBarMorph methodsFor: 'change reporting' stamp: 'dgd 9/1/2004 15:29'!
ownerChanged
"The receiver's owner has changed its layout. "
	self updateBounds.
	^ super ownerChanged! !

!DockingBarMorph methodsFor: 'private - accessing' stamp: 'MarcusDenker 10/12/2013 11:40'!
usedHeightByPredominantDockingBarsOfChastes: predominantChastes 
	"Private - convenience"
	^(self predominantDockingBarsOfChastes: predominantChastes)
		ifEmpty: [0]
		ifNotEmpty: [:predominants | (predominants collect: [:each | each height]) sum] ! !

!DockingBarMorph methodsFor: 'events-processing' stamp: 'dgd 9/9/2004 21:43'!
handleFocusEvent: evt
	"Handle focus events. Valid menu transitions are determined based on the menu currently holding the focus after the mouse went down on one of its children."

	(evt isMouse and:[ evt isMouseUp ]) ifTrue:[^ self].

	self processEvent: evt.

	"Need to handle keyboard input if we have the focus."
	evt isKeyboard ifTrue: [^ self handleEvent: evt].

	"We need to handle button clicks outside and transitions to local popUps so throw away everything else"
	(evt isMouseOver or:[evt isMouse not]) ifTrue:[^self].
	"What remains are mouse buttons and moves"
	evt isMove ifFalse:[^self handleEvent: evt]. "handle clicks outside by regular means"
	"Now it's getting tricky. On #mouseMove we might transfer control to *either* the currently active submenu or the pop up owner, if any. Since the active sub menu is always displayed upfront check it first."
	selectedItem ifNotNil:[(selectedItem activateSubmenu: evt) ifTrue:[^self]].
! !

!DockingBarMorph methodsFor: 'construction' stamp: 'MarcusDenker 10/26/2011 14:55'!
addSpace: sizePointOrNumber 
	"Add a new space of the given size to the receiver."
	| space |
	space := Morph new.
	space extent: sizePointOrNumber asPoint.
	space color: Color transparent.
	space borderWidth: 0.
	self addMorphBack: space! !

!DockingBarMorph methodsFor: 'testing' stamp: 'dgd 8/30/2004 23:13'!
isFloating
	"Answer true if the receiver has a float layout"
	^ self isHorizontal not
		and: [self isVertical not]! !

!DockingBarMorph methodsFor: 'construction' stamp: 'StephaneDucasse 6/22/2014 22:19'!
snapToEdgeIfAppropriate
	(self owner isNil
			or: [self owner isHandMorph])
		ifTrue: [^ self].
	self updateBounds! !

!DockingBarMorph methodsFor: 'initialization' stamp: 'EstebanLorenzano 5/15/2014 19:04'!
setDefaultParameters
	"private - set the default parameter using the current theme settings as the inspiration source"
	self
		color: self theme settings derivedMenuColor;
		borderWidth: self theme menuBorderWidth;
		borderColor: self theme menuBorderColor! !

!DockingBarMorph methodsFor: 'menu' stamp: 'dgd 9/29/2004 20:24'!
toggleFillsOwner
	self fillsOwner: self fillsOwner not! !

!DockingBarMorph methodsFor: 'private' stamp: 'dgd 9/9/2004 21:24'!
selectedItem
	selectedItem isNil
		ifTrue: [^ nil].
	^ selectedItem isSelected
		ifTrue: [ selectedItem]
		ifFalse: [ nil]! !

!DockingBarMorph methodsFor: 'accessing' stamp: 'dgd 8/31/2004 13:38'!
avoidVisibleBordersAtEdge
"Answer if the receiver is in avoidVisibleBordersAtEdge mode"
	^ avoidVisibleBordersAtEdge! !

!DockingBarMorph methodsFor: 'rounding' stamp: 'dgd 8/31/2004 14:16'!
roundedCorners
	"Return a list of those corners to round"
	self isAdheringToTop
		ifTrue: [^ #(2 3 )].
	self isAdheringToBottom
		ifTrue: [^ #(1 4 )].
	self isAdheringToLeft 
		ifTrue: [^ #(3 4 )].
	self isAdheringToRight
		ifTrue: [^ #(1 2 )].
	^ #(1 2 3 4 )! !

!DockingBarMorph methodsFor: 'private - layout' stamp: 'dgd 11/2/2004 11:55'!
updateColor
	"private - update the receiver's color"
	| fill |
	self autoGradient
		ifFalse: [^ self].
	""
	fill := GradientFillStyle ramp: self gradientRamp.
	""
	fill origin: self topLeft.
	self isVertical
		ifTrue: [fill direction: self width @ 0]
		ifFalse: [fill direction: 0 @ self height].
	""
	self fillStyle: fill! !

!DockingBarMorph methodsFor: 'accessing' stamp: 'gvc 7/30/2007 14:24'!
extent: aPoint 
	"Change the receiver's extent.
	optimized to not keep updating the (gradient) color!!"
	
	|old|
	old := self extent.
	super extent: aPoint.
	self extent = old ifTrue: [^self].
	self updateColor! !

!DockingBarMorph methodsFor: 'menu' stamp: 'StephaneDucasse 10/27/2014 20:19'!
addCustomMenuItems: aMenu hand: aHandMorph 
	"Populate aMenu with appropriate menu items for a  
	yellow-button (context menu) click."
	super addCustomMenuItems: aMenu hand: aHandMorph.

	aMenu addLine.
	aMenu addUpdating: #autoGradientString selector: #toggleAutoGradient.
	self isFloating
		ifFalse: [
			aMenu addUpdating: #fillsOwnerString selector: #toggleFillsOwner.
			aMenu addUpdating: #avoidVisibleBordersAtEdgeString selector: #toggleAvoidVisibleBordersAtEdge]! !

!DockingBarMorph methodsFor: 'testing' stamp: 'dgd 8/31/2004 11:57'!
isAdheringToBottom
	"Answer true if the receiver is adhering to bottom"
	^ self edgeToAdhereTo == #bottom! !

!DockingBarMorph methodsFor: 'private - layout' stamp: 'MarcusDenker 10/12/2013 11:38'!
updateExtent
	"private - update the receiver's extent"
	| margin usedHeight |
	self fullBounds.
	self fillsOwner
		ifFalse: [^ self].
	margin := self avoidVisibleBordersAtEdge
				ifTrue: [self borderWidth * 2]
				ifFalse: [0].
	self isHorizontal
		ifTrue: [self width: self owner width + margin].
	self isVertical
		ifTrue: [
			usedHeight := self usedHeightByPredominantDockingBarsOfChastes: #(#top #bottom ).
			self height: self owner height + margin - usedHeight]! !

!DockingBarMorph methodsFor: 'accessing' stamp: 'dgd 8/31/2004 13:57'!
avoidVisibleBordersAtEdge: aBoolean 
	"Instruct the receiver to avoid showing the borders at edge"
	avoidVisibleBordersAtEdge := aBoolean.
self updateLayoutProperties.! !

!DockingBarMorph methodsFor: 'events-processing' stamp: 'dgd 9/1/2004 19:29'!
activate: evt 
	"Receiver should be activated; e.g., so that control passes  
	correctly."
	evt hand newMouseFocus: self! !

!DockingBarMorph methodsFor: 'private - accessing' stamp: 'MarcusDenker 12/11/2009 23:58'!
adhereTo: edgeSymbol 
	"Private - Instruct the receiver to adhere to the given edge.  
	 
	Options: #left #top #right #bottom or #none"
	(#(#left #top #right #bottom #none ) includes: edgeSymbol)
		ifFalse: [^ self error: 'invalid option'].
	self setToAdhereToEdge: edgeSymbol.
	self updateLayoutProperties.
	self updateColor! !

!DockingBarMorph methodsFor: 'private - accessing' stamp: 'MarcusDenker 12/12/2009 00:00'!
predominantDockingBarsOfChastes: predominantChastes 
	"Private - Answer a collection of the docking bar of my owner  
	that are predominant to the receiver.  
	 
	By 'predominant' we mean docking bar that have the right to  
	get a position before the receiver.  
	 
	The predominance of individual living in the same chaste is  
	determinated by the arrival order. "

	| allDockingBars byChaste byArrival |
	(self owner isNil or: [self owner isHandMorph]) ifTrue: [^ #()].

	allDockingBars := self owner dockingBars.

	byChaste := allDockingBars select: [:each | predominantChastes includes: each edgeToAdhereTo].
	(predominantChastes includes: self edgeToAdhereTo) ifFalse: [^ byChaste].
	byChaste := byChaste reject: [:each | each edgeToAdhereTo = self edgeToAdhereTo].	
	byArrival := allDockingBars select: [:each | each edgeToAdhereTo = self edgeToAdhereTo].
	byArrival := byArrival copyAfter: self.
	^ byChaste , byArrival! !

!DockingBarMorph methodsFor: 'private - layout' stamp: 'dgd 11/2/2004 11:59'!
gradientRamp
	^ gradientRamp ifNil:[{0.0 -> originalColor muchLighter. 1.0 -> originalColor twiceDarker}]! !

!DockingBarMorph methodsFor: 'menu' stamp: 'StephaneDucasse 4/22/2012 16:48'!
fillsOwnerString
	"Answer the string to be shown in a menu to represent the fills owner status"
	^ (self fillsOwner) -> 'fills owner' translated
! !

!DockingBarMorph methodsFor: 'private - layout' stamp: 'gvc 11/14/2006 15:37'!
updatePosition
	"private - update the receiver's position.
	Fixed so as not to keep changing position!!
	(called twice if adhereing)"
	
	| edgeSymbol margin |
	edgeSymbol := self edgeToAdhereTo.
	edgeSymbol == #none
		ifTrue: [self
				perform: (edgeSymbol , ':') asSymbol
				with: (self owner perform: edgeSymbol)].
	""
	margin := self avoidVisibleBordersAtEdge
				ifTrue: [self borderWidth asPoint]
				ifFalse: [0 asPoint].
	""
	self isAdheringToTop
		ifTrue: [| usedHeight | 
			usedHeight := self usedHeightByPredominantDockingBarsOfChastes: #(#top ).
			self topLeft: self owner topLeft - margin + (0 @ usedHeight)].
	self isAdheringToBottom
		ifTrue: [| usedHeight | 
			usedHeight := self usedHeightByPredominantDockingBarsOfChastes: #(#bottom ).
			self bottomLeft: self owner bottomLeft + (-1 @ 1 * margin) - (0 @ usedHeight)].
	""
	self isAdheringToLeft
		ifTrue: [| usedHeight usedWidth | 
			usedHeight := self usedHeightByPredominantDockingBarsOfChastes: #(#top ).
			usedWidth := self usedWidthByPredominantDockingBarsOfChastes: #(#left ).
			self topLeft: self owner topLeft - margin + (usedWidth @ usedHeight)].
	self isAdheringToRight
		ifTrue: [| usedHeight usedWidth | 
			usedHeight := self usedHeightByPredominantDockingBarsOfChastes: #(#top ).
			usedWidth := self usedWidthByPredominantDockingBarsOfChastes: #(#right ).
			self topRight: self owner topRight + (1 @ -1 * margin) + (usedWidth negated @ usedHeight)]! !

!DockingBarMorph methodsFor: 'accessing' stamp: 'dgd 8/31/2004 12:02'!
beFloating
	"Instract the receiver to be floating"
	self adhereTo: #none! !

!DockingBarMorph methodsFor: 'accessing' stamp: 'dgd 8/31/2004 12:01'!
adhereToLeft
	"Instract the receiver to adhere to left"
	self adhereTo: #left! !

!DockingBarMorph methodsFor: 'private - accessing' stamp: 'dgd 8/31/2004 13:56'!
edgeToAdhereTo
	"private - answer the edge where the receiver is adhering to"
	^ self
		valueOfProperty: #edgeToAdhereTo
		ifAbsent: [#none]! !

!DockingBarMorph methodsFor: 'events-processing' stamp: 'gvc 2/26/2010 11:19'!
mouseDown: anEvent
	"Release the mouse focus if clicked outside the receiver."

	(self fullContainsPoint: anEvent position)
		ifFalse: [anEvent hand releaseMouseFocus: self].
	^super mouseDown: anEvent! !

!DockingBarMorph methodsFor: 'control' stamp: 'johanfabry 3/11/2015 16:16'!
activeSubmenu: aSubmenu 
	activeSubMenu ifNotNil: [activeSubMenu delete].
	activeSubMenu := aSubmenu.
	aSubmenu isNil ifTrue: [^ self].
	activeSubMenu selectItem: nil event: nil.
	activeSubMenu borderColor: self borderColor.
	activeSubMenu beSticky.
	activeSubMenu resistsRemoval: true.
	activeSubMenu removeMatchString.! !

!DockingBarMorph methodsFor: 'dropping/grabbing' stamp: 'MarcusDenker 12/11/2009 23:59'!
justDroppedInto: aMorph event: anEvent 
	| ownerBounds leftRegion droppedPosition rightRegion topRegion bottomRegion |
	super justDroppedInto: aMorph event: anEvent.
	
	self owner isNil ifTrue: [^ self].
	ownerBounds := aMorph bounds.
	topRegion := ownerBounds bottom: ownerBounds top + (ownerBounds height // 5).
	bottomRegion := ownerBounds top: ownerBounds bottom - (ownerBounds height // 5).

	leftRegion := ownerBounds right: ownerBounds left + (ownerBounds width // 5).
	leftRegion := leftRegion top: topRegion bottom.
	leftRegion := leftRegion bottom: bottomRegion top.
	rightRegion := ownerBounds left: ownerBounds right - (ownerBounds width // 5).
	rightRegion := rightRegion top: topRegion bottom.
	rightRegion := rightRegion bottom: bottomRegion top.

	droppedPosition := anEvent position.
	(topRegion containsPoint: droppedPosition) ifTrue: [
			^ self adhereToTop].
	(bottomRegion containsPoint: droppedPosition) ifTrue: [
			^ self adhereToBottom].
	(leftRegion containsPoint: droppedPosition) ifTrue: [
			^ self adhereToLeft].
	(rightRegion containsPoint: droppedPosition) ifTrue: [
			^ self adhereToRight].
	self beFloating! !

!DockingBarMorph methodsFor: 'wiw support' stamp: 'dgd 9/7/2004 19:25'!
morphicLayerNumber
	"helpful for insuring some morphs always appear in front of or 
	behind others. smaller numbers are in front"
	^ 11! !

!DockingBarMorph methodsFor: 'control' stamp: 'dgd 9/1/2004 16:40'!
selectItem: aMenuItem event: anEvent 
	selectedItem
		ifNotNil: [selectedItem deselect: anEvent].
	selectedItem := aMenuItem.
	selectedItem
		ifNotNil: [selectedItem select: anEvent]! !

!DockingBarMorph methodsFor: 'accessing' stamp: 'dgd 8/31/2004 12:01'!
adhereToTop
	"Instract the receiver to adhere to top"
	self adhereTo: #top! !

!DockingBarMorph class methodsFor: 'example' stamp: 'StephaneDucasse 10/5/2014 14:22'!
example
	"self example"
	<exampleWidget>
	
	DockingBarMorph new 
		addMorph: (SimpleButtonMorph new
                                           label: 'Say hello';
                                           target: [UIManager inform: 'Hello'];
                                           actionSelector: #value);
		addMorph: (SimpleButtonMorph new
                                           label: 'Say bonjour';
                                           target: [UIManager inform: 'Bonjour'];
                                           actionSelector: #value);
		addMorph: (SimpleButtonMorph new
                                           label: 'Close';
                                           target: [DockingBarMorph allInstances last delete];
                                           actionSelector: #value);
	adhereToBottom;
	openInWorld.! !

!DockingBarMorph class methodsFor: 'example' stamp: 'StephaneDucasse 10/5/2014 14:22'!
exampleWithMenu
	"self exampleWithMenu"
	<exampleWidget>
	
	DockingBarMorph new 
		add: 'Foo' 
		font:  StandardFonts defaultFont 
		icon: MenuMorph pushPinImage
		help: 'No idea' subMenu: nil;
		add: 'Bar' 
		font:  StandardFonts defaultFont 
		icon: MenuMorph pushPinImage
		help: 'No idea' subMenu: nil;
	adhereToTop;
	openInWorld.! !

!DockingBarToggleMenuItemMorph commentStamp: 'StephaneDucasse 9/28/2014 16:49'!
A DockingBarToggleMenuItemMorph is a specialized version of its superclass for DockingBar behavior.

There is a bit of duplication between 
DockingBarToggleMenuItemMorph and DockingBarMenuItemMorph because iof single inheritance limit: 

DockingBarToggleMenuItemMorph inherits from ToggleMenuItemMorph (and also from DockingBarMenuItemMorph).

One of the problem is that in addition, the use of toggleMenuItem or simple menuItem looks random.

DockingBarMenuItemMorph is created by
	add: wordingString icon: aForm help: helpString subMenu: aMenuMorph 
	
and DockingBarToggleMenuItemMorph is created by
	add: wordingString font: aFont icon: aForm help: helpString subMenu: aMenuMorph 
!
!DockingBarToggleMenuItemMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 9/28/2014 16:40'!
deselectTimeOut: evt
	"Deselect timout. Now really deselect"

	owner selectedItem == self
		ifTrue: [ 
			evt hand releaseMouseFocus: owner.
			owner selectItem: nil event: evt ]! !

!DockingBarToggleMenuItemMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 9/28/2014 16:42'!
updateLayoutInDockingBar

	owner isVertical
		ifTrue: [
			self hResizing: #spaceFill.
			self vResizing: #shrinkWrap]
		ifFalse: [
			self hResizing: #shrinkWrap.
			self vResizing: #spaceFill].
	self extent: self minWidth @ self minHeight! !

!DockingBarToggleMenuItemMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 9/28/2014 16:41'!
roundedCorners
	"Return a list of those corners to round"
	owner isFloating
		ifTrue: [^ #(1 4 )].
	owner isAdheringToTop
		ifTrue: [^ #(1 4 )].
	owner isAdheringToBottom
		ifTrue: [^ #(2 3 )].
	owner isAdheringToLeft
		ifTrue: [^ #(1 2 )].
	owner isAdheringToRight
		ifTrue: [^ #(3 4 )].
	^ #(1 2 3 4 )! !

!DockingBarToggleMenuItemMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 9/28/2014 16:40'!
drawOn: aCanvas 
	| stringColor stringBounds |
	(isSelected and: [ isEnabled ])
		ifTrue: [aCanvas fillRectangle: self bounds fillStyle: self selectionFillStyle.
			stringColor := color negated]
		ifFalse: [stringColor := color].
	stringBounds := bounds.
	stringBounds := stringBounds left: stringBounds left + 4.
	self hasIcon
		ifTrue: [| iconForm | 
			iconForm := self iconForm.
			aCanvas translucentImage: iconForm at: stringBounds left @ (self top + (self height - iconForm height // 2)).
			stringBounds := stringBounds left: stringBounds left + iconForm width + 2].
	self hasMarker
		ifTrue: [stringBounds := stringBounds left: stringBounds left + self submorphBounds width + 8].
	stringBounds := stringBounds top: stringBounds top + stringBounds bottom - self fontToUse height // 2.
	aCanvas
		drawString: self contents
		in: stringBounds
		font: self fontToUse
		color: stringColor.
	self hasSubMenu
		ifTrue: [| subMenuMarker subMenuMarkerPosition | 
			subMenuMarker := self subMenuMarker.
			subMenuMarkerPosition := self right - subMenuMarker width @ (self top + self bottom - subMenuMarker height // 2).
			subMenuMarkerPosition := subMenuMarkerPosition - (4 @ -1).
			aCanvas paintImage: subMenuMarker at: subMenuMarkerPosition]! !

!DockingBarToggleMenuItemMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 9/28/2014 16:41'!
mouseUp: evt
	"Handle a mouse up event. Menu items get activated when the mouse is over them. Do nothing if we're not in a 'valid menu transition', meaning that the current hand focus must be aimed at the owning menu."
	evt hand mouseFocus == owner ifFalse: [^self].
	
	self contentString ifNotNil:[
		self contents: self contentString withMarkers: true inverse: true.
		self refreshWorld.
		(Delay forMilliseconds: 200) wait].
	owner rootMenu selectItem: nil event: evt.
	self invokeWithEvent: evt.		
! !

!DockingBarToggleMenuItemMorph methodsFor: 'drawing-private' stamp: 'StephaneDucasse 9/28/2014 16:08'!
drawSubMenuMarker: aForm on: aCanvas in: aRectangle
	"Draw the submenu marker on the canvas within the given bounds."
	
	|markerRect| 
	markerRect := aRectangle topRight + (aForm width negated @ (aRectangle height - aForm height // 2)) extent: aForm extent.
	markerRect translateBy: -4@1.
	self drawIcon: aForm on: aCanvas in: markerRect! !

!DockingBarToggleMenuItemMorph methodsFor: 'selecting' stamp: 'StephaneDucasse 9/28/2014 16:09'!
adjacentTo
	"Adjusted to line up more nicely."
	self owner isFloating
		ifTrue: [^ {self bounds bottomLeft + (3 @ 3).  self bounds bottomRight + (5 @ 3)}].
	self owner isAdheringToTop
		ifTrue: [^ {self bounds bottomLeft + (5 @ 5)}].
	self owner isAdheringToLeft
		ifTrue: [^ {self bounds topRight + (5 @ 5)}].
	self owner isAdheringToBottom
		ifTrue: [^ {self bounds topLeft + (5 @ 5)}].
	self owner isAdheringToRight
		ifTrue: [^ {self bounds topLeft + (5 @ -5)}].
	^ {self bounds bottomLeft + (3 @ 5)}! !

!DockingBarToggleMenuItemMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 9/28/2014 16:08'!
selectionBorderStyle
	"Answer the border style to use with the receiver is the selected element."
	
	^ self theme menuItemInDockingBarSelectedBorderStyleFor: self
	! !

!DockingBarToggleMenuItemMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 9/28/2014 16:41'!
ownerChanged
	"The receiver's owner, some kind of a pasteup, has changed its 
	layout."
	super ownerChanged.
	self updateLayoutInDockingBar! !

!DockingBarToggleMenuItemMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 9/28/2014 16:07'!
stringBoundsToUse
	"Answer the bounds to use when drawing the item text."
	
	^self bounds left: self left + 4! !

!DockingBarToggleMenuItemMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 9/28/2014 16:41'!
mouseEnter: evt
	"The mouse entered the receiver"

	owner ifNotNil: [owner stayUp ifFalse: [self mouseEnterDragging: evt]].
	(owner selectedItem notNil
				and: [owner selectedItem ~~ self])
			ifTrue: [owner selectItem: self event: evt.].

! !

!DockingBarToggleMenuItemMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 9/28/2014 16:42'!
subMenuMarker
	"private - answer the form to be used as submenu marker"

	owner isFloating
		ifTrue: [ ^ self bottomArrow ].
	owner isAdheringToTop
		ifTrue: [ ^ self bottomArrow ].
	owner isAdheringToBottom
		ifTrue: [ ^ self upArrow ].
	owner isAdheringToLeft
		ifTrue: [ ^ self rightArrow ].
	owner isAdheringToRight
		ifTrue: [ ^ self leftArrow ].
	^ self rightArrow! !

!DockingBarToggleMenuItemMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 9/28/2014 16:41'!
mouseDown: evt
	"Handle a mouse down event. Menu items get activated when the mouse is over them."

	evt shiftPressed ifTrue: [^ super mouseDown: evt].  "enable label editing"
	isSelected
		ifTrue: [
			evt hand newMouseFocus: nil.
			owner selectItem: nil event: evt. ]
		ifFalse: [
			evt hand newMouseFocus: owner. "Redirect to menu for valid transitions"
			owner selectItem: self event: evt. ]
! !

!DockingBarToggleMenuItemMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 9/28/2014 16:42'!
wantsRoundedCorners
	^  true
		! !

!DockingBarToggleMenuItemMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 9/28/2014 16:41'!
noteNewOwner: aMorph 
	"I have just been added as a submorph of aMorph"
	super noteNewOwner: aMorph.

	self updateLayoutInDockingBar! !

!DockingBarToggleMenuItemMorph methodsFor: 'private' stamp: 'StephaneDucasse 9/28/2014 16:07'!
selectionFillStyle
	"Answer the fill style to use with the receiver is the selected element."
	
	^self theme menuItemInDockingBarSelectedFillStyleFor: self
		! !

!DoesNotUnderstandDebugAction commentStamp: '<historical>'!
A DoesNotUnderstandDebugAction is a debugging action that can create a method if the debugger was opened as a result of a #doesNotUnderstand mesage send.
!
!DoesNotUnderstandDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/20/2013 19:17'!
id

	^ #doesNotUnderstand! !

!DoesNotUnderstandDebugAction methodsFor: 'actions' stamp: 'CamilleTeruel 3/7/2014 12:04'!
executeAction
	"Should only be called when the debugger was created in response to a
	MessageNotUnderstood exception. Create a stub for the method that was
	missing and proceed into it."
	
	| msg msgCategory chosenClass |

	msg := self interruptedContext tempAt: 1.
	chosenClass := self 
		askForSuperclassOf: self interruptedContext receiver class
		toImplement: msg selector
		ifCancel: [^self].
	msgCategory := (self askForCategoryIn: chosenClass default: 'as yet unclassified').
	self  session
		implement: msg 
		classified: msgCategory 
		inClass: chosenClass 
		forContext: self interruptedContext.
	self debugger selectTopContext! !

!DoesNotUnderstandDebugAction methodsFor: 'testing' stamp: 'AndreiChis 9/20/2013 17:43'!
appliesToDebugger: aDebugger

	^ aDebugger session isInterruptedContextDoesNotUnderstand ! !

!DoesNotUnderstandDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/20/2013 19:17'!
defaultLabel

	^  'Create'! !

!DoesNotUnderstandDebugAction methodsFor: 'private' stamp: 'AndreiChis 10/5/2013 21:54'!
askForSuperclassOf: aClass toImplement: aSelector ifCancel: cancelBlock
	| classes chosenClassIndex |
	classes := aClass withAllSuperclasses addAll: (aClass traits sort: [ :t1 :t2 | t1 asString < t2 asString ]); yourself.
	chosenClassIndex := UIManager default 
		chooseFrom: (classes collect: [:c | c name])
		title: 'Define #', aSelector, ' in which class?'.
	chosenClassIndex = 0 ifTrue: [^ cancelBlock value].
	^ classes at: chosenClassIndex! !

!DoesNotUnderstandDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/20/2013 16:07'!
defaultOrder

	^ 45! !

!DoesNotUnderstandDebugAction methodsFor: 'private' stamp: 'AndreiChis 10/5/2013 21:49'!
askForCategoryIn: aClass default: aString
	| categoryName |
	categoryName := AbstractTool requestProtocolNameFor: aClass initialAnswer: aString.
	categoryName ifNil: [^aString].
	^ categoryName isEmptyOrNil 
		ifTrue: [^ aString] 
		ifFalse: [ categoryName ]! !

!DoesNotUnderstandDebugAction class methodsFor: 'as yet unclassified' stamp: 'AndreiChis 9/20/2013 15:52'!
actionType
	<debuggingAction>! !

!DomainError commentStamp: '<historical>'!
I am DomainError, an ArithmeticException indicating that some argument falls outside an expected domain, [from, to]

When my valid interval is left- or right-open, use signal: creation protocol to provide a custom messageText rather than the default [from, to] notation.!
!DomainError methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/15/2011 16:33'!
to
	^ to! !

!DomainError methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/15/2011 16:33'!
from: start
	from := start! !

!DomainError methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/15/2011 16:33'!
to: end
	to := end! !

!DomainError methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/15/2011 16:33'!
from
	^ from! !

!DomainError class methodsFor: 'signaling' stamp: 'nice 7/15/2011 13:55'!
signal: signallerText from: start
	^ self signal: signallerText from: start to: Float infinity! !

!DomainError class methodsFor: 'signaling' stamp: 'HenrikSperreJohansen 1/19/2012 16:26'!
signalFrom: start to: end
	| msgStart msgEnd |
	msgStart := (start isFloat and: [start isFinite not]) ifTrue: ['(-infinity'] ifFalse: ['[', start printString].
	msgEnd := (end isFloat and: [end isFinite not]) ifTrue: ['infinity)'] ifFalse: [end printString, ']'].
	^ self signal: 'Value outside ', msgStart, ' , ' , msgEnd
		from: start;
		to: end! !

!DomainError class methodsFor: 'signaling' stamp: 'nice 7/15/2011 13:56'!
signalTo: end
	^ self signalFrom: Float infinity negated to: end! !

!DomainError class methodsFor: 'signaling' stamp: 'nice 7/15/2011 13:56'!
signal: signallerText to: end
	^ self signal: signallerText from: Float infinity negated to: end! !

!DomainError class methodsFor: 'signaling' stamp: 'nice 7/15/2011 13:54'!
signal: signallerText from: start to: end
	^ self new
		from: start;
		to: end;
		signal: signallerText! !

!DomainError class methodsFor: 'signaling' stamp: 'SvenVanCaekenberghe 4/15/2011 16:35'!
signalFrom: start
	^ self signalFrom: start to: Float infinity! !

!DosTimestamp commentStamp: '<historical>'!
DOS stores timestamps, in local time, as 32 bit integers with the following format:
	32 bits (low to high):
		Low 16 bits:
			Bits 0-4: seconds / 2
	 		Bits 5-10: minutes 0-59
			Bits 11-15: hours 0-23
		High 16 bits:
			16-20: day of month 1-31
	 		21-24: month 1-12
			25-31: year offset from 1980 (e.g. 1981 -> 1)

References (with visual aids): http://blogs.msdn.com/b/oldnewthing/archive/2003/09/05/54806.aspx & http://mindprod.com/jgloss/zip.html!
!DosTimestamp methodsFor: 'comparing' stamp: 'SeanDeNigris 5/21/2012 16:54'!
hash

	^ self value hash.! !

!DosTimestamp methodsFor: 'private' stamp: 'SeanDeNigris 5/21/2012 16:43'!
low16Bits
	
	^ value & 2r1111111111111111.! !

!DosTimestamp methodsFor: 'private' stamp: 'SeanDeNigris 5/21/2012 17:16'!
epoch

	^ self class epoch.! !

!DosTimestamp methodsFor: 'accessing' stamp: 'SeanDeNigris 5/21/2012 16:36'!
value

	^ value.! !

!DosTimestamp methodsFor: 'comparing' stamp: 'SeanDeNigris 5/21/2012 16:54'!
= rhs

	^ self value = rhs value.! !

!DosTimestamp methodsFor: 'printing' stamp: 'SeanDeNigris 5/21/2012 16:57'!
printOn: aStream

	aStream
		nextPutAll: self asDateAndTime printString;
		nextPutAll: ' (';
		nextPutAll: self value asString;
		nextPut: $).! !

!DosTimestamp methodsFor: 'private' stamp: 'SeanDeNigris 5/21/2012 16:49'!
date
	"See class comment for format details"

	| encodedDate yearsSinceDosEpoch month day year |
	encodedDate := self high16Bits.
	yearsSinceDosEpoch := encodedDate >> 9. "High 7 bits"
	month := encodedDate >> 5 & 2r1111. "Middle 4 bits"
	day := encodedDate & 2r11111. "Low 5 bits"
	year := self epoch year + yearsSinceDosEpoch.
	^ Date year: year month: month day: day. ! !

!DosTimestamp methodsFor: 'converting' stamp: 'SeanDeNigris 5/21/2012 16:42'!
asDateAndTime

	^ DateAndTime date: self date time: self time.! !

!DosTimestamp methodsFor: 'private' stamp: 'SeanDeNigris 5/21/2012 16:43'!
time
	"See class comment for format details"
	
	| encodedTime hours minutes secondsHalved seconds |
	encodedTime := self low16Bits.
	hours := encodedTime >> 11. "High 5 bits"
	minutes := encodedTime >> 5 & 2r111111. "Middle 6 bits"
	secondsHalved := encodedTime & 2r11111. "Low 5 bits"
	seconds := (secondsHalved * 2) floor.
	^ Time hour: hours minute: minutes second: seconds.! !

!DosTimestamp methodsFor: 'private' stamp: 'SeanDeNigris 5/21/2012 16:43'!
high16Bits

	^ value >> 16.! !

!DosTimestamp methodsFor: 'private' stamp: 'SeanDeNigris 5/21/2012 16:29'!
initializeValue: anInteger 

	value := anInteger.
	^ self.! !

!DosTimestamp class methodsFor: 'private' stamp: 'SeanDeNigris 5/21/2012 17:13'!
timeValueFrom: aTime

	| dosHours dosMinutes dosSeconds |
	dosHours := aTime hour << 11.
	dosMinutes := aTime minute << 5.
	dosSeconds := (aTime second / 2) floor.
	^ dosHours + dosMinutes + dosSeconds.! !

!DosTimestamp class methodsFor: 'instance creation' stamp: 'SeanDeNigris 5/21/2012 16:22'!
on: anInteger

	^ self new initializeValue: anInteger.! !

!DosTimestamp class methodsFor: 'accessing' stamp: 'CamilloBruni 8/22/2013 22:22'!
epoch

	^ DateAndTime dosEpoch! !

!DosTimestamp class methodsFor: 'private' stamp: 'SeanDeNigris 5/21/2012 17:13'!
dateValueFrom: aDate

	| dosYear dosMonth dosDay |
	dosYear := aDate year - DateAndTime dosEpoch year << 9.
	dosMonth := aDate monthIndex << 5.
	dosDay := aDate dayOfMonth.
	^ dosYear + dosMonth + dosDay.! !

!DosTimestamp class methodsFor: 'instance creation' stamp: 'SeanDeNigris 5/21/2012 17:15'!
fromDateAndTime: aDateAndTime 

	| dateValue timeValue local |
	local := aDateAndTime asLocal.
	dateValue := self dateValueFrom: local asDate.
	timeValue := self timeValueFrom: local asTime.
	^ self on: (dateValue << 16) + timeValue.! !

!DosTimestampTest methodsFor: 'tests' stamp: 'SeanDeNigris 5/21/2012 16:32'!
testFromDateAndTime

	| aDateAndTime timestamp |
	timestamp := DosTimestamp fromDateAndTime: '21 May 2012 3:02:44 pm' asDateAndTime.
	
	self assert: timestamp value equals: 16r40B57856.! !

!DosTimestampTest methodsFor: 'tests' stamp: 'SeanDeNigris 5/21/2012 16:53'!
testTimesAreLocal

	| remoteDateAndTime remoteTimestamp localTimestamp |
	remoteDateAndTime := DateAndTime current offset: DateAndTime localOffset + 2 hours.
	remoteTimestamp := DosTimestamp fromDateAndTime: remoteDateAndTime.
	localTimestamp := DosTimestamp fromDateAndTime: remoteDateAndTime asLocal.
	self assert: remoteTimestamp equals: localTimestamp.! !

!DosTimestampTest methodsFor: 'tests' stamp: 'SeanDeNigris 5/21/2012 16:49'!
testAsDateAndTime
	
	| remoteDatetime timestamp |
	timestamp := DosTimestamp on: 16r40B57856.
	self assert: timestamp asDateAndTime equals: '21 May 2012 3:02:44 pm' asDateAndTime.! !

!DoubleLink commentStamp: 'SvenVanCaekenberghe 1/12/2014 14:15'!
I am DoubleLink, the elementary part of a DoubleLinkedList.

I hold a value, as well as a link to my successor (nextLink) and to my predecessor (previousLink) - both can be nil.!
!DoubleLink methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:40'!
nextLink: anObject
	nextLink := anObject! !

!DoubleLink methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:41'!
value
	^ value! !

!DoubleLink methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:40'!
value: anObject
	value := anObject! !

!DoubleLink methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:43'!
hasPredecessor
	^ previousLink notNil! !

!DoubleLink methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 12/5/2013 16:53'!
clearLinks
	nextLink := previousLink := nil! !

!DoubleLink methodsFor: '*GT-Spotter' stamp: 'TudorGirba 11/26/2014 14:35'!
asSpotterDoubleLink
	
	^ GTSpotterCandidateLink value: self value! !

!DoubleLink methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:40'!
previousLink
	^ previousLink! !

!DoubleLink methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:43'!
hasSuccessor
	^ nextLink notNil! !

!DoubleLink methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:40'!
nextLink
	^ nextLink! !

!DoubleLink methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 12/16/2013 20:12'!
asDoubleLink
	^ self! !

!DoubleLink methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:40'!
previousLink: anObject
	previousLink := anObject! !

!DoubleLink class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 12/2/2013 16:41'!
value: anObject
	^ self new
		value: anObject;
		yourself! !

!DoubleLinkedList commentStamp: '<historical>'!
I am DoubleLinkedList, an ordered list data structure consisting of objects, most likely DoubleLinks or something compatible, connected to each other by forward and backwards links.!
!DoubleLinkedList methodsFor: 'adding' stamp: 'SvenVanCaekenberghe 12/16/2013 20:12'!
add: anObjectOrLink beforeLink: otherLink
	| link otherLinkPredeccessor |
	otherLink = head
		ifTrue: [ ^ self addFirst: anObjectOrLink ].
	link := anObjectOrLink asDoubleLink.
	otherLinkPredeccessor := otherLink previousLink.
	otherLink previousLink: link.
	link nextLink: otherLink.
	link previousLink: otherLinkPredeccessor.
	otherLinkPredeccessor nextLink: link.
	^ link! !

!DoubleLinkedList methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/5/2013 16:54'!
last
	self isEmpty 
		ifTrue: [ CollectionIsEmpty signalWith: self ].
	^ tail value! !

!DoubleLinkedList methodsFor: 'adding' stamp: 'SvenVanCaekenberghe 12/9/2013 15:18'!
addAll: collection
	collection do: [ :each | self add: each ]! !

!DoubleLinkedList methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 12/2/2013 23:40'!
asArray
	^ Array streamContents: [ :out |
		self do: [ :each | out nextPut: each ] ]! !

!DoubleLinkedList methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/5/2013 16:53'!
first
	self isEmpty 
		ifTrue: [ CollectionIsEmpty signalWith: self ].
	^ head value! !

!DoubleLinkedList methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/2/2013 19:08'!
isEmpty
	^ head isNil and: [ tail isNil ]! !

!DoubleLinkedList methodsFor: 'removing' stamp: 'SvenVanCaekenberghe 12/5/2013 16:54'!
removeFirst
	| link |
	self isEmpty 
		ifTrue: [ CollectionIsEmpty signalWith: self ].
	link := head.
	head := head nextLink.
	head 
		ifNil: [ tail := nil ]
		ifNotNil: [ head previousLink: nil ].
	link clearLinks.
	^ link! !

!DoubleLinkedList methodsFor: 'adding' stamp: 'SvenVanCaekenberghe 12/16/2013 20:12'!
addFirst: anObjectOrLink
	| link |
	link := anObjectOrLink asDoubleLink.
	link nextLink: head.
	head ifNotNil: [ head previousLink: link ].
	tail ifNil: [ tail := link ].
	head := link.
	^ link! !

!DoubleLinkedList methodsFor: 'removing' stamp: 'SvenVanCaekenberghe 12/5/2013 16:54'!
removeLink: link
	| predecessor successor |
	predecessor := link previousLink.
	successor := link nextLink.
	predecessor
		ifNil: [ head := successor ]
		ifNotNil: [ predecessor nextLink: successor ].
	successor
		ifNil: [ tail := predecessor ]
		ifNotNil: [ successor previousLink: predecessor ].
	link clearLinks.
	^ link! !

!DoubleLinkedList methodsFor: 'adding' stamp: 'SvenVanCaekenberghe 12/16/2013 20:12'!
addLast: anObjectOrLink
	| link |
	link := anObjectOrLink asDoubleLink.
	link previousLink: tail.
	tail ifNotNil: [ tail nextLink: link ].
	head ifNil: [ head := link ].
	tail := link.
	^ link! !

!DoubleLinkedList methodsFor: 'enumerating' stamp: 'SvenVanCaekenberghe 12/9/2013 15:12'!
reject: block
	| result |
	result := self class new.
	self do: [ :each |
		(block value: each)
			ifFalse: [ result add: each ] ].
	^ result! !

!DoubleLinkedList methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/9/2013 15:44'!
includes: object
	self do: [ :each |
		each = object ifTrue: [ ^ true ] ].
	^ false! !

!DoubleLinkedList methodsFor: 'enumerating' stamp: 'SvenVanCaekenberghe 12/9/2013 15:11'!
select: block
	| result |
	result := self class new.
	self do: [ :each |
		(block value: each)
			ifTrue: [ result add: each ] ].
	^ result! !

!DoubleLinkedList methodsFor: 'enumerating' stamp: 'SvenVanCaekenberghe 12/9/2013 15:10'!
collect: block
	| result |
	result := self class new.
	self do: [ :each |
		result add: (block value: each) ].
	^ result! !

!DoubleLinkedList methodsFor: 'adding' stamp: 'SvenVanCaekenberghe 12/2/2013 21:08'!
add: anObjectOrLink
	^ self addLast: anObjectOrLink! !

!DoubleLinkedList methodsFor: 'enumerating' stamp: 'SvenVanCaekenberghe 12/2/2013 19:09'!
do: block
	| current |
	current := head.
	[ current isNil ] 
		whileFalse: [ 
	 		block value: current value.
			current := current nextLink ]! !

!DoubleLinkedList methodsFor: 'adding' stamp: 'SvenVanCaekenberghe 12/16/2013 20:12'!
add: anObjectOrLink afterLink: otherLink
	| link otherLinkSuccessor |
	otherLink = tail
		ifTrue: [ ^ self addLast: anObjectOrLink ].
	link := anObjectOrLink asDoubleLink.
	otherLinkSuccessor := otherLink nextLink.
	otherLink nextLink: link.
	link previousLink: otherLink.
	link nextLink: otherLinkSuccessor.
	otherLinkSuccessor previousLink: link.
	^ link! !

!DoubleLinkedList methodsFor: 'removing' stamp: 'SvenVanCaekenberghe 12/5/2013 16:54'!
removeLast
	| link |
	self isEmpty 
		ifTrue: [ CollectionIsEmpty signalWith: self ].
	link := tail.
	tail := tail previousLink.
	tail 
		ifNil: [ head := nil ]
		ifNotNil: [ tail nextLink: nil ].
	link clearLinks.
	^ link! !

!DoubleLinkedList methodsFor: 'enumerating' stamp: 'SvenVanCaekenberghe 12/9/2013 15:09'!
reverseDo: block
	| current |
	current := tail.
	[ current isNil ] 
		whileFalse: [ 
	 		block value: current value.
			current := current previousLink ]! !

!DoubleLinkedList methodsFor: 'removing' stamp: 'SvenVanCaekenberghe 12/5/2013 17:07'!
removeAll
	head := tail := nil! !

!DoubleLinkedListTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/16/2013 20:10'!
testAddFirst
	| list |
	list := DoubleLinkedList new.
	1 to: 3 do: [ :each | list add: each ].
	list addFirst: 0.
	self deny: list isEmpty.
	self assert: list first equals: 0.
	self assert: list last equals: 3.
	self assert: list asArray equals: #( 0 1 2 3 )! !

!DoubleLinkedListTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/16/2013 20:10'!
testOneRemoveFirst
	| list |
	list := DoubleLinkedList new.
	list add: #one.
	list removeFirst.
	self assert: list isEmpty.
	list add: #one.
	list removeLast.
	self assert: list isEmpty! !

!DoubleLinkedListTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/16/2013 20:10'!
testOne
	| list |
	list := DoubleLinkedList new.
	list add: #one.
	self deny: list isEmpty.
	self assert: list first equals: #one.
	self assert: list last equals: #one.
	self assert: list asArray equals: #( one )! !

!DoubleLinkedListTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/16/2013 20:10'!
testAddLast
	| list |
	list := DoubleLinkedList new.
	1 to: 3 do: [ :each | list add: each ].
	list addLast: 0.
	self deny: list isEmpty.
	self assert: list first equals: 1.
	self assert: list last equals: 0.
	self assert: list asArray equals: #( 1 2 3 0 )! !

!DoubleLinkedListTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/16/2013 20:10'!
testOneRemoveLast
	| list |
	list := DoubleLinkedList new.
	list add: #one.
	list removeLast.
	self assert: list isEmpty.
	list add: #one.
	list removeLast.
	self assert: list isEmpty! !

!DoubleLinkedListTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/16/2013 20:10'!
testThreeRemoveLink
	| list link |
	list := DoubleLinkedList new.
	list add: 1.
	link := list add: 2.
	list add: 3.
	list removeLink: link.
	self assert: list first equals: 1.
	self assert: list last equals: 3.
	self assert: list asArray equals: #( 1 3 )! !

!DoubleLinkedListTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/16/2013 20:10'!
testAddBeforeLink
	| list link |
	list := DoubleLinkedList new.
	list add: 1.
	link := list add: 2.
	list add: 3.
	list add: 0 beforeLink: link.
	self assert: list asArray equals: #( 1 0 2 3 )! !

!DoubleLinkedListTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/16/2013 20:10'!
testThree
	| list |
	list := DoubleLinkedList new.
	1 to: 3 do: [ :each | list add: each ].
	self deny: list isEmpty.
	self assert: list first equals: 1.
	self assert: list last equals: 3.
	self assert: list asArray equals: #( 1 2 3 )! !

!DoubleLinkedListTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/16/2013 20:10'!
testIncludes
	| list |
	list := DoubleLinkedList new.
	list addAll: (1 to: 10).
	self assert: (list includes: 5).
	self deny: (list includes: 0)! !

!DoubleLinkedListTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/16/2013 20:10'!
testReject
	| list even |
	list := DoubleLinkedList new.
	list addAll: (1 to: 10).
	even := list reject: [ :each | each odd ].
	self assert: even asArray equals: #(2 4 6 8 10)! !

!DoubleLinkedListTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/16/2013 20:10'!
testThreeRemoveLast
	| list link |
	list := DoubleLinkedList new.
	1 to: 3 do: [ :each | list add: each ].
	link := list removeLast.
	self assert: link value equals: 3.
	self assert: list first equals: 1.
	self assert: list last equals: 2.
	self assert: list asArray equals: #( 1 2 )! !

!DoubleLinkedListTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/16/2013 20:10'!
testEmpty
	| list |
	list := DoubleLinkedList new.
	self assert: list isEmpty.
	self should: [ list first ] raise: CollectionIsEmpty.
	self should: [ list last ] raise: CollectionIsEmpty.
	list do: [ :each | self fail ]
	! !

!DoubleLinkedListTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/16/2013 20:10'!
testCollect
	| list doubles |
	list := DoubleLinkedList new.
	list addAll: #(1 2 3).
	doubles := list collect: [ :each | each * 2 ].
	self assert: doubles asArray equals: #(2 4 6)! !

!DoubleLinkedListTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/16/2013 20:10'!
testDo
	| list value |
	list := DoubleLinkedList new.
	list addAll: (1 to: 10).
	value := 1.
	list do: [ :each |
		self assert: each equals: value.
		value := value + 1 ]! !

!DoubleLinkedListTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/16/2013 20:10'!
testAddAfterLink
	| list link |
	list := DoubleLinkedList new.
	list add: 1.
	link := list add: 2.
	list add: 3.
	list add: 0 afterLink: link.
	self assert: list asArray equals: #( 1 2 0 3 )! !

!DoubleLinkedListTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/16/2013 20:10'!
testReverseDo
	| list value |
	list := DoubleLinkedList new.
	list addAll: (1 to: 10).
	value := 10.
	list reverseDo: [ :each |
		self assert: each equals: value.
		value := value - 1 ]! !

!DoubleLinkedListTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/16/2013 20:10'!
testSelect
	| list even |
	list := DoubleLinkedList new.
	list addAll: (1 to: 10).
	even := list select: [ :each | each even ].
	self assert: even asArray equals: #(2 4 6 8 10)! !

!DoubleLinkedListTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/16/2013 20:10'!
testThreeRemoveFirst
	| list link |
	list := DoubleLinkedList new.
	1 to: 3 do: [ :each | list add: each ].
	link := list removeFirst.
	self assert: link value equals: 1.
	self assert: list first equals: 2.
	self assert: list last equals: 3.
	self assert: list asArray equals: #( 2 3 )! !

!DropEvent commentStamp: 'LaurentLaffont 3/15/2011 20:47'!
I model the event produced when a hand drops a (grabbed) morph into another morph.
I know the position of the drop, the dropped morph and the hand that produced me.

To handle this event a morph should override one of these methods:
#acceptDroppingMorph:event:
#justDroppedInto:event:

Additionaly, a morph can specify if it wants to accept a dropped morph by overriding #wantsDroppedMorph:event:. 
Symmetrically, the morph being dropped can specify if it wants to be dropped in another morph by overriding #wantsToBeDroppedInto:. 

Note that for a successful drop operation both parties need to agree.

See HandMorph>>dropMorph:event: for an example of usage.
!
!DropEvent methodsFor: 'transforming' stamp: 'ar 10/7/2000 18:28'!
transformedBy: aMorphicTransform
	"Return the receiver transformed by the given transform into a local coordinate system."
	^self shallowCopy transformBy: aMorphicTransform! !

!DropEvent methodsFor: 'dispatching' stamp: 'ar 1/10/2001 21:24'!
sentTo: anObject
	"Dispatch the receiver into anObject"
	self type == #dropEvent ifTrue:[^anObject handleDropMorph: self].! !

!DropEvent methodsFor: 'accessing' stamp: 'ar 9/13/2000 18:44'!
wasHandled: aBool
	wasHandled := aBool.! !

!DropEvent methodsFor: 'initialize' stamp: 'ar 10/10/2000 01:18'!
resetHandlerFields
	"Reset anything that is used to cross-communicate between two eventual handlers during event dispatch"
	wasHandled := false.! !

!DropEvent methodsFor: 'transforming' stamp: 'ar 10/7/2000 18:28'!
transformBy: aMorphicTransform
	"Transform the receiver into a local coordinate system."
	position :=  aMorphicTransform globalPointToLocal: position.! !

!DropEvent methodsFor: 'accessing' stamp: 'ar 9/13/2000 18:44'!
wasHandled
	^wasHandled! !

!DropEvent methodsFor: 'testing' stamp: 'ar 9/13/2000 18:33'!
isDropEvent
	^true! !

!DropEvent methodsFor: 'printing' stamp: 'JMM 9/29/2004 13:24'!
printOn: aStream

	aStream nextPut: $[.
	aStream nextPutAll: self position printString; space.
	aStream nextPutAll: self type; space.
	aStream	 nextPutAll: self windowIndex printString.
	aStream nextPut: $].! !

!DropEvent methodsFor: 'accessing' stamp: 'ar 9/13/2000 18:33'!
position
	^position! !

!DropEvent methodsFor: 'accessing' stamp: 'ar 9/13/2000 19:21'!
cursorPoint
	"For compatibility with mouse events"
	^position! !

!DropEvent methodsFor: 'accessing' stamp: 'ar 9/13/2000 18:33'!
type
	^#dropEvent! !

!DropEvent methodsFor: 'private' stamp: 'ar 9/13/2000 19:23'!
setPosition: pos contents: aMorph hand: aHand
	position := pos.
	contents := aMorph.
	source := aHand.
	wasHandled := false.! !

!DropEvent methodsFor: 'accessing' stamp: 'ar 9/13/2000 18:33'!
contents
	^contents! !

!DropEvent methodsFor: 'initialize' stamp: 'ar 10/10/2000 01:19'!
copyHandlerState: anEvent
	"Copy the handler state from anEvent. Used for quickly transferring handler information between transformed events."
	wasHandled := anEvent wasHandled.! !

!DropFilesEvent methodsFor: 'accessing' stamp: 'ar 1/10/2001 21:35'!
type
	^#dropFilesEvent! !

!DropFilesEvent methodsFor: 'dispatching' stamp: 'ar 1/10/2001 21:35'!
sentTo: anObject
	"Dispatch the receiver into anObject"
	self type == #dropFilesEvent ifTrue:[^anObject handleDropFiles: self].! !

!DropListExample commentStamp: '<historical>'!
A DropListExample is a simple example of how to use drop lists.

DropListExample new openWithSpec!
!DropListExample methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/1/2013 15:03'!
container

	^ container asSpecAdapter! !

!DropListExample methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 22:55'!
initialize

	container := PanelMorph new.
	self instantiateMorphs.
	
	container
		changeTableLayout;
		listDirection: #bottomToLeft.
	
	super initialize.! !

!DropListExample methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 2/2/2012 15:20'!
instantiateMorphs

	morph1 := Morph new
					color: Color red;
					width: 60;
					height: 20.
	morph2 := Morph new
					color: Color blue;
					width: 20;
					height: 60.
	morph3 := Morph new
					color: Color green;
					width: 50;
					height: 50.! !

!DropListExample methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 11/23/2013 13:11'!
initializeWidgets 

	uniformDropList := self newDropList.
	heterogeneousDropList  := self newDropList.

	uniformDropList
		items: {morph1. morph2. morph3};
		displayBlock: [ :m | m color name capitalized, ' morph' ];
		iconHolder: [:e| Smalltalk ui icons testGreenIcon ];
		whenSelectedItemChanged: [ :m |
			container removeAllMorphs.
			container addMorph: m ].
	
	heterogeneousDropList
		addItemLabeled: 'Open workspace' do: [ Workspace open ] icon: Smalltalk ui icons smallOkIcon;
		addItemLabeled: 'Inspect current morph' do: [ uniformDropList selectedItem inspect ] icon: Smalltalk ui icons testRedIcon.
	
	"If this is uncommented, it will fire the action of the first item, which is not what we want:
	heterogeneousDropList setSelectedIndex: 1.
	same for:
	heterogeneousDropList setIndex: 1"
	uniformDropList setIndex: 1.
	
	self setFocus.! !

!DropListExample methodsFor: 'accessing' stamp: 'SeanDeNigris 4/17/2013 22:24'!
uniformDropList

	^ uniformDropList! !

!DropListExample methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 5/24/2013 19:24'!
setFocus
	
	self focusOrder
		add: uniformDropList;
		add: heterogeneousDropList.
	! !

!DropListExample methodsFor: 'accessing' stamp: 'SeanDeNigris 4/17/2013 22:15'!
heterogeneousDropList

	^ heterogeneousDropList.! !

!DropListExample class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/15/2014 17:14'!
defaultSpec

	^ { #ContainerModel.
			#add:.	{ self topSpec . #layout: . #(#SpecLayoutFrame
													bottomFraction: 0
													bottomOffset: 30) }.
			#add:.	{{#model . #container } . #layout: .  #(#SpecLayoutFrame
													topOffset: 42). }}! !

!DropListExample class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 2/5/2012 17:17'!
title

	^ 'Drop list'! !

!DropListExample class methodsFor: 'example' stamp: 'HernanMoralesDurand 2/3/2014 00:08'!
example
	"self example"

	DropListExample new openWithSpec.
! !

!DropListExample class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/1/2013 15:05'!
topSpec

	^ SpecLayout composed
		newRow: [ :r |
			r 
				add: #uniformDropList;
				add: #heterogeneousDropList ];
		yourself! !

!DropListItem commentStamp: '<historical>'!
A DropListItem is an item (wrapper) designed to fit into a DropList!
!DropListItem methodsFor: 'accessing' stamp: ''!
actionHolder
	
	^ actionHolder! !

!DropListItem methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 1/24/2014 16:07'!
initialize

	super initialize.

	actionHolder := [] asValueHolder.
	displayBlock := [ :e | e printString ].
	icon := nil! !

!DropListItem methodsFor: 'accessing' stamp: 'SeanDeNigris 4/15/2013 21:05'!
model

	^ model.! !

!DropListItem methodsFor: 'protocol' stamp: 'SeanDeNigris 4/15/2013 20:44'!
display: aBlock
	"aBlock - 1 optional argument, which is the underlying item; returns the string to be displayed"

	displayBlock := aBlock.! !

!DropListItem methodsFor: 'accessing' stamp: 'SeanDeNigris 4/15/2013 20:44'!
label
	
	^ displayBlock cull: model.! !

!DropListItem methodsFor: 'execution' stamp: 'BenjaminVanRyseghem 10/17/2013 16:36'!
value
	"This way, I am polymorphic with nil"

	actionHolder value cull: self label cull: self! !

!DropListItem methodsFor: 'accessing' stamp: ''!
= another

	self species = another species ifFalse: [ ^ false ].
	^ self label = another label and: [ self actionHolder = another actionHolder ]! !

!DropListItem methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/22/2013 18:26'!
icon: anObject
	icon := anObject! !

!DropListItem methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:36'!
action: aBlock

	actionHolder value: aBlock! !

!DropListItem methodsFor: 'accessing' stamp: 'SeanDeNigris 4/15/2013 20:44'!
label: anObject
	"For compatibility with old raw-string usage. Send #display: instead"
	
	displayBlock := [ anObject ].! !

!DropListItem methodsFor: 'private' stamp: 'SeanDeNigris 4/15/2013 20:40'!
model: anObject

	model := anObject.! !

!DropListItem methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/22/2013 18:26'!
icon
	^ icon! !

!DropListItem class methodsFor: 'instance creation' stamp: 'SeanDeNigris 4/15/2013 20:36'!
on: anObject do: aBlock

	^ self new
		action: aBlock;
		model: anObject;
		yourself! !

!DropListItem class methodsFor: 'instance creation' stamp: 'SeanDeNigris 4/17/2013 22:21'!
named: label do: aBlock

	^ self new
		action: aBlock;
		model: label;
		display: [ :e | e ];
		yourself! !

!DropListModel commentStamp: '<historical>'!
A DropListModel is a Spec model for drop lists.

I am assume there is a little problem on an empty list, but frankly, who creates an empty drop list ?

See DropListExample for an example!
!DropListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:05'!
resetSelection
	"<api: #do>"
	"Reset the current selection state"

	selectionHolder reset! !

!DropListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
emptyList
	
	listHolder value: OrderedCollection new! !

!DropListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:53'!
setSelectedIndex: anIndex
	"<api: #integer min:1 max:#listSize getter: #selectedIndex>"
	"Force the selection of the item at index anIndex"
	| selection |

	selection := listHolder value at: anIndex ifAbsent: [ ^ self ].
	selection value.
	selectionHolder index value: anIndex.
	selectionHolder selection value: selection! !

!DropListModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:32'!
whenSelectionChanged: aBlock
	"Set a block to perform when the selection is changed"
	
	"The method should be used only if you are interested in the fact that there was a change, without caring about what has changed
	If you are interested in the items, use whenSelectedItemChanged:
	If you are interested in the index, use whenSelectionIndexChanged:"

	selectionHolder whenChangedDo: aBlock.! !

!DropListModel methodsFor: 'initialization' stamp: 'DucasseStephane 9/10/2014 09:59'!
initialize

	super initialize.

	listHolder := OrderedCollection new asValueHolder.
	selectionHolder := Object selectionReactiveVariable.
	
	listHolder whenChangedDo: [ 
					self changed: #getList.
					self changed: #getIconFor:.
					self internalResetSelection.].
				
	selectionHolder whenChangedDo: [ self changed: #getIndex ].
	displayBlock := [ :model :item | item label ] asValueHolder.
	iconHolder := [ :model :item | item icon ] asValueHolder.
	
	self whenSelectedItemChanged: [:item | item value ]! !

!DropListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/22/2013 18:26'!
iconHolder: aBlock
	
	iconHolder value: aBlock! !

!DropListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:17'!
selectedItem
	"<api: #inspect>"

	^ self selectedItemHolder value model! !

!DropListModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:32'!
whenSelectedItemChanged: aBlock
	"Set a block to perform when the selected item is changed"

	selectionHolder selection whenChangedDo: [ :new :old :announcement :ann | 
		aBlock cull: (new ifNotNil: [ :item | item model ]) cull: old cull: announcement cull: ann ]! !

!DropListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/18/2013 13:02'!
getList

	^ listHolder value! !

!DropListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:03'!
selectedIndex
	"<api: #inspect>"
	"Useless method but it provides a better and more consistent API"

	^ self getIndex! !

!DropListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 5/19/2013 12:29'!
addItemLabeled: aString do: aBlock

	| item |
	item := DropListItem named: aString do: aBlock.
	
	"If you add directly in the contents, the update is not triggered from the value holder"
	listHolder add: item.! !

!DropListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/22/2013 18:27'!
getIconFor: anItem

	^ self iconHolder cull: anItem! !

!DropListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/18/2013 12:57'!
displayBlock: aBlock
	
	displayBlock value: aBlock 
	"listHolder replace: [ :e | e display: aBlock; yourself  ]."! !

!DropListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:56'!
listItems
	"<api: #inspect>"
	"Return the list used to populate the drop list"
	
	^ listHolder value collect: [ :e | e model ].! !

!DropListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/22/2013 18:26'!
iconHolder

	^ iconHolder value! !

!DropListModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/22/2013 18:33'!
internalResetSelection

	selectionHolder reset.
	self getList ifNotEmpty: [ self silentlySetSelectedIndex: 1 ]! !

!DropListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/22/2013 18:08'!
displayForItem: anItem
	"The order of the arguments may looks weird, but then it seemsm ore natural while using the widget"
	
	^ self displayBlock cull: anItem model cull: anItem! !

!DropListModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/22/2013 18:37'!
silentlySetSelectedIndex: anIndex
	"Force the selection of the item at index anIndex"
	| selection |

	selection := listHolder value at: anIndex ifAbsent: [ ^ self ].
	selectionHolder index value: anIndex.
	selectionHolder selection value: selection.! !

!DropListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
getIndex

	^ selectionHolder index value! !

!DropListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/23/2013 12:58'!
addItemLabeled: aString do: aBlock icon: anIcon

	| item |
	item := DropListItem named: aString do: aBlock.
	item icon: anIcon.
	"If you add directly in the contents, the update is not triggered from the value holder"
	listHolder add: item.! !

!DropListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
setIndex: anIndex
	| item |

	selectionHolder index value: anIndex.
	item := (listHolder value at: anIndex ifAbsent: [ nil ]).
	item value.
	selectionHolder selection value: item.
	self changed: #getIndex! !

!DropListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:02'!
listSize
	"<api: #inspect>"
	"Return the size of the list of choices"

	^ self listItems size! !

!DropListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:44'!
setSelectedItem: anItem
	"Force the selection of the item anItem"
	"<api: #st getter: #selectedItem>"
	| index realItem |
	index := self listItems indexOf: anItem ifAbsent: [ ^ self ].
	realItem := listHolder at: index.
	selectionHolder index value: index.
	selectionHolder selection value: realItem.! !

!DropListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/18/2013 12:57'!
displayBlock
	
	^ displayBlock value! !

!DropListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:41'!
items: aList
	"Populate the drop list with a list of ui specific items"
	"aList is a list of domain specific objects. If you want to specify more precisely the item actions, see #addItemLabeled:do:"
	"<api: #st getter: #listItems>"
	
	| dropListItems |
	dropListItems := aList collect: [ :e | DropListItem on: e do: [] ].
	listHolder value: dropListItems! !

!DropListModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:32'!
whenSelectionIndexChanged: aBlock
	"Set a block to perform when the selected index is changed"

	selectionHolder index whenChangedDo: aBlock! !

!DropListModel methodsFor: 'private' stamp: 'StephaneDucasse 5/17/2012 18:04'!
selectedItemHolder

	^ selectionHolder selection! !

!DropListModel methodsFor: 'private' stamp: 'StephaneDucasse 5/17/2012 18:04'!
selectedIndexHolder

	^ selectionHolder index! !

!DropListModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/1/2013 13:38'!
defaultSpec
	<spec>
	
	^ #(DropListAdapter
		adapt: #(model))! !

!DropListModel class methodsFor: 'specs' stamp: ''!
title

	^ 'Drop List'! !

!DropListModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/13/2014 15:21'!
adapterName

	^ #DropListAdapter! !

!DropListMorph commentStamp: 'gvc 5/23/2007 14:12'!
Displays a selected item and a drop button. When pressed will popup a list to enable changing of the selection. Supports enablement.!
!DropListMorph methodsFor: 'private' stamp: 'gvc 6/17/2006 12:26'!
listVisible
	"Answer whether the list is visible."

	^self listMorph owner notNil! !

!DropListMorph methodsFor: 'updating' stamp: 'GaryChambers 11/17/2011 11:57'!
themeChanged
	"Update the selection colour."

	self selectionColor ifNotNil: [
		self selectionColor: self theme selectionColor].
	self layoutInset: self layoutInsetToUse.
	self buttonMorph extent: self buttonExtent.
	super themeChanged.
	self buttonMorph cornerStyle: self cornerStyle.
	self listMorph theme: self theme! !

!DropListMorph methodsFor: 'accessing' stamp: 'gvc 8/14/2006 13:18'!
enabled
	"Answer the value of enabled"

	^ enabled! !

!DropListMorph methodsFor: 'initialization' stamp: 'EstebanLorenzano 5/15/2014 17:48'!
defaultColor
	"Answer the default color of the receiver."

	^ self theme backgroundColor! !

!DropListMorph methodsFor: 'updating' stamp: 'EstebanLorenzano 5/1/2014 01:05'!
updateContentColor: paneColor
	"Change the content text color."
	
	self enabled
		ifTrue: [self contentMorph textColor: self theme textColor ]
		ifFalse: [self contentMorph textColor: self theme disabledColor ]! !

!DropListMorph methodsFor: 'initialize' stamp: 'gvc 7/8/2006 10:13'!
outOfWorld: aWorld
	"Get rid of the list if visible."

	self hideList.
	^super outOfWorld: aWorld! !

!DropListMorph methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 5/24/2013 19:26'!
keyStroke: event
	"Pass on to the list."
	| indexToSelect |
	
	event keyCharacter = Character escape ifTrue: [ self hideList ].
	(self navigationKey: event) ifTrue: [^self].
	
	event keyCharacter == Character cr
		ifTrue: [ ^ self listSelectionIndex: self listSelectionIndex ].
		
	indexToSelect := self listMorph keyStroke: event.
	
	"If the returned value is not an integer, do not handle it"
	indexToSelect isInteger ifFalse: [ ^ self ].
	
	"If nothing found, do nothing"
	indexToSelect == 0 ifTrue: [ ^ self ].
	
	self listSelectionIndex: indexToSelect! !

!DropListMorph methodsFor: 'private' stamp: 'AlainPlantec 12/17/2009 14:34'!
buttonWidth
	"Answer based on scrollbar size."
	
	^ (self theme scrollbarThickness + 3)
		max: self theme dropListControlButtonWidth! !

!DropListMorph methodsFor: 'private' stamp: ''!
updateContentMorphWith: aString

	self contentMorph contents: aString! !

!DropListMorph methodsFor: 'menu & halo' stamp: ''!
addToggleItemsToHaloMenu: aCustomMenu 
	"Add toggle-items to the halo menu"
	
	super addToggleItemsToHaloMenu: aCustomMenu.
	aCustomMenu
		addUpdating: #enabledString
		target: self
		selector: #toggleEnabled! !

!DropListMorph methodsFor: 'protocol' stamp: 'GaryChambers 11/17/2011 17:39'!
getCurrentSelection
	"Answer the current selection from the model."

	^(self model notNil and: [self getIndexSelector notNil])
		ifTrue: [|mySelection|
			mySelection := self model perform: self getIndexSelector.
			(self list includes: mySelection)
				ifTrue: [mySelection]]! !

!DropListMorph methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 3/14/2012 08:26'!
newButtonMorph
	"Answer a new button morph"

	^(ControlButtonMorph
		on: self
		getState: nil
		action: #popList
		label: #buttonLabel)
			roundedCorners: #(3 4);
			getEnabledSelector: #enabled;
			label: self buttonLabel; 
			vResizing: #spaceFill;
			hResizing: #rigid;
			extent: self buttonExtent;
			setProperty: #wantsKeyboardFocusNavigation toValue: false;
			cornerStyle: self cornerStyle.! !

!DropListMorph methodsFor: 'accessing' stamp: 'gvc 7/17/2006 12:26'!
getListSelector: anObject
	"Set the value of getListSelector"

	getListSelector := anObject! !

!DropListMorph methodsFor: 'accessing' stamp: 'GaryChambers 11/16/2011 13:41'!
font: aFont
	"Set the content font"

	self contentMorph beAllFont: aFont! !

!DropListMorph methodsFor: 'accessing' stamp: 'gvc 7/17/2006 12:26'!
getIndexSelector: anObject
	"Set the value of getIndexSelector"

	getIndexSelector := anObject! !

!DropListMorph methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 3/14/2012 08:04'!
initialize
	"Initialize the receiver."

	super initialize.
	listSelectionIndex := 0.
	enabled := true.
	list := #().
	"needs something to keep font"
	defaultContents := ' '.
	self
		useSelectionIndex: true;
		clipSubmorphs: true;
		layoutPolicy: RowLayout new;
		layoutInset: self layoutInsetToUse;
		cellPositioning: #center;
		listMorph: self newListMorph;
		contentMorph: self newContentMorph;
		buttonMorph: self newButtonMorph;
		fillStyle: self fillStyleToUse;
		borderStyle: self borderStyleToUse;
		addMorphBack: self contentMorph;
		addMorphBack: (self addDependent: self buttonMorph);
		on: #mouseDown send: #popList to: self;
		vResizing: #rigid;
		hResizing: #spaceFill;
		height: self font height + 10.
	self listMorph fillStyle: (self theme dropListNormalListFillStyleFor: self)! !

!DropListMorph methodsFor: 'wrapping' stamp: 'BenjaminVanRyseghem 3/20/2012 13:11'!
wrapItem: anItem index: index

	^ wrapSelector
		ifNil: [ anItem asString ]
		ifNotNil: [ 
			wrapSelector numArgs = 0
				ifTrue: [ anItem perform: wrapSelector ]
				ifFalse: [ self model 
								perform: wrapSelector 
								withEnoughArguments: {anItem. index. self.} ]]! !

!DropListMorph methodsFor: 'protocol' stamp: 'gvc 8/2/2007 12:18'!
enable
	"Enable the receiver."
	
	self enabled: true! !

!DropListMorph methodsFor: 'drawing' stamp: 'EstebanLorenzano 4/30/2014 20:11'!
newListMorph
	"Answer a new list morph"

	|m|
	m := (self listMorphClass
		on: self
		list: #list
		selected: #listSelectionIndex
		changeSelected: #listSelectionIndex:
		menu: nil
		keystroke: nil)
			autoDeselect: false;
			wrapSelector: #wrapItem:index:;
			roundedCorners: #(2 3);
			setProperty: #morphicLayerNumber toValue: 5;
			"color: self color;"
			borderStyle: (self theme dropListNormalListBorderStyleFor: self);
			on: #mouseDown send: #listMouseDown: to: self.
	^m! !

!DropListMorph methodsFor: 'private' stamp: ''!
defaultContents
	
	^ defaultContents! !

!DropListMorph methodsFor: 'private' stamp: 'GaryChambers 3/2/2012 12:27'!
positionList
	"Position the list morph to fit on the display."

	|height topSpace bottomSpace pos|
	height := self listHeight.
	topSpace := self boundsInWorld top - self world top.
	bottomSpace := self world bottom - self boundsInWorld bottom.
	pos := height <= bottomSpace
		ifTrue: [#below]
		ifFalse: [height <= topSpace
			ifTrue: [#above]
			ifFalse: [bottomSpace >= topSpace
				ifTrue: [height := bottomSpace. #below]
				ifFalse: [height := topSpace. #above]]].
	pos = #above
		ifTrue: [self buttonMorph roundedCorners: (self roundedCorners copyWithoutAll: #(1 4)).
				self roundedCorners: (self roundedCorners copyWithoutAll: #(1 4)).
				self listMorph
					bounds: (self boundsInWorld topLeft - (0 @ height) extent: self width @ height)]
		ifFalse: [self buttonMorph roundedCorners: (self roundedCorners copyWithoutAll: #(1 2 3)).
				self roundedCorners: (self roundedCorners copyWithoutAll: #(2 3)).
				self listMorph
					bounds: (self boundsInWorld bottomLeft extent: self width @ height)]! !

!DropListMorph methodsFor: 'protocol' stamp: 'gvc 8/8/2007 15:53'!
useSelection
	"Use the model as returning the selected item rather than index."

	self useSelectionIndex: false! !

!DropListMorph methodsFor: 'testing' stamp: 'gvc 9/6/2006 12:48'!
stepTime
	"Answer the desired time between steps in milliseconds."

	^100! !

!DropListMorph methodsFor: 'accessing' stamp: 'GaryChambers 2/9/2012 12:13'!
allowKeyboardFocus: aBoolean
	"Set whether or not keyboard focus will be allowed."

	self setProperty: #allowKeyboardFocus toValue: aBoolean! !

!DropListMorph methodsFor: 'accessing' stamp: 'CamilloBruni 8/4/2011 12:27'!
list
	"Answer the list contents."
	^list! !

!DropListMorph methodsFor: 'as yet unclassified' stamp: ''!
toggleEnabled
	"Toggle the enabled state."

	self enabled: self enabled not! !

!DropListMorph methodsFor: 'protocol' stamp: 'gvc 8/8/2007 15:53'!
useIndex
	"Use the model as returning the selected index rather than item."

	self useSelectionIndex: true! !

!DropListMorph methodsFor: 'event handling' stamp: 'gvc 9/8/2006 11:30'!
handlesKeyboard: evt
	"Return true if the receiver wishes to handle the given keyboard event."
	
	^true! !

!DropListMorph methodsFor: 'accessing' stamp: ''!
defaultContents: anObject
	"Set the value of defaultContents"

	defaultContents := anObject! !

!DropListMorph methodsFor: 'accessing' stamp: 'gvc 1/20/2009 16:38'!
focusBounds
	"Answer the bounds for drawing the focus indication."

	^self theme dropListFocusBoundsFor: self! !

!DropListMorph methodsFor: '*Keymapping-Core' stamp: 'ThierryGoubier 9/15/2012 22:28'!
initializeShortcuts: aKMDispatcher
	super initializeShortcuts: aKMDispatcher.
	aKMDispatcher attachCategory: #MorphFocusNavigation! !

!DropListMorph methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 5/19/2013 12:42'!
listMouseDown: evt
	"Click outside the list."

	(self listMorph fullContainsPoint: evt position)
		ifTrue: [ 
			self listMorph selectionIndex: (self listMorph rowAtLocation: evt position) ].
	self hideList! !

!DropListMorph methodsFor: 'accessing' stamp: 'gvc 6/17/2006 11:45'!
contentMorph
	"Answer the value of contentMorph"

	^ contentMorph! !

!DropListMorph methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 3/13/2012 18:02'!
updateContents
	"Update the contents."

	self updateContentMorphWith:
		(self listSelectionIndex > 0
			ifTrue: [self listMorph wrapItem: (self list at: self listSelectionIndex) index: self listSelectionIndex ]
			ifFalse: [ self defaultContents ]) ! !

!DropListMorph methodsFor: 'accessing' stamp: 'gvc 10/12/2006 13:58'!
selectionColor: aColor
	"Set the selection color for the receiver."

	self listMorph selectionColor: aColor! !

!DropListMorph methodsFor: 'protocol' stamp: 'gvc 1/11/2007 12:30'!
takesKeyboardFocus
	"Answer whether the receiver can normally take keyboard focus."

	^true! !

!DropListMorph methodsFor: 'updating' stamp: 'gvc 9/8/2009 13:25'!
updateEnabled
	"Update the enablement state."

	self model ifNotNil: [
		self getEnabledSelector ifNotNil: [
			self enabled: (self model perform: self getEnabledSelector)]]! !

!DropListMorph methodsFor: 'accessing' stamp: 'GaryChambers 2/9/2012 12:14'!
allowKeyboardFocus
	"Answer whether or not keyboard focus will be allowed."

	^self valueOfProperty: #allowKeyboardFocus ifAbsent: [true]! !

!DropListMorph methodsFor: 'protocol' stamp: 'gvc 8/22/2006 15:00'!
popList
	"Hide / show the list."

	self enabled ifFalse: [^self].
	self listMorph owner isNil
		ifTrue: [self showList]
		ifFalse: [self hideList]! !

!DropListMorph methodsFor: 'testing' stamp: 'GaryChambers 2/9/2012 12:12'!
wantsKeyboardFocus
	"Answer whether the receiver would like keyboard focus
	in the general case (mouse action normally)."

	^super wantsKeyboardFocus and: [
		self allowKeyboardFocus]! !

!DropListMorph methodsFor: 'stepping and presenter' stamp: 'gvc 9/21/2007 14:37'!
step
	"Reset mouse focus to the list if it is showing."

	self listVisible ifTrue: [
		self activeHand mouseFocus ifNil: [
			 self listMorph wantsKeyboardFocus ifTrue: [
				self listMorph takeKeyboardFocus].
			self activeHand newMouseFocus: self listMorph]]! !

!DropListMorph methodsFor: 'protocol' stamp: 'gvc 8/2/2007 12:18'!
disable
	"Disable the receiver."
	
	self enabled: false! !

!DropListMorph methodsFor: 'accessing' stamp: 'gvc 8/22/2006 13:25'!
buttonMorph: anObject
	"Set the value of buttonMorph"

	buttonMorph := anObject! !

!DropListMorph methodsFor: 'event handling' stamp: 'GuillermoPolito 5/23/2012 11:39'!
keyboardFocusChange: aBoolean
	"The message is sent to a morph when its keyboard focus changes.
	Update for focus feedback."
	super keyboardFocusChange: aBoolean.
	self focusChanged! !

!DropListMorph methodsFor: 'private' stamp: 'gvc 8/7/2007 11:03'!
fillStyleToUse
	"Answer the fillStyle that should be used for the receiver."
	
	^self enabled
		ifTrue: [self theme dropListNormalFillStyleFor: self]
		ifFalse: [self theme dropListDisabledFillStyleFor: self]! !

!DropListMorph methodsFor: 'accessing' stamp: 'gvc 7/17/2006 12:26'!
getIndexSelector
	"Answer the value of getIndexSelector"

	^ getIndexSelector! !

!DropListMorph methodsFor: 'accessing' stamp: 'GaryChambers 4/24/2012 15:04'!
font
	"Answer the content font"

	^self contentMorph font! !

!DropListMorph methodsFor: 'protocol' stamp: 'GaryChambers 11/17/2011 11:57'!
showList
	"Show the list."

	self listMorph owner isNil
		ifTrue: [self positionList.
				self
					fillStyle: self fillStyleToUse;
					listPaneColor: self paneColor.
				self listMorph theme: self theme.
				self world addMorphInLayer: self listMorph.
				self listMorph wantsKeyboardFocus ifTrue: [
					self listMorph takeKeyboardFocus].
				self activeHand
					newMouseFocus: self listMorph]! !

!DropListMorph methodsFor: 'protocol' stamp: 'gvc 8/8/2007 15:58'!
on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel
	"Set the receiver to the given model parameterized by the given message selectors."

	getListSel isSymbol
		ifTrue: [self  getListSelector: getListSel]
		ifFalse: [self list: getListSel]. "allow direct list"
	self
		model: anObject;
		getIndexSelector: getSelectionSel;
		setIndexSelector: setSelectionSel;
		updateList;
		updateListSelectionIndex;
		updateContents! !

!DropListMorph methodsFor: 'accessing' stamp: 'gvc 8/22/2006 13:25'!
buttonMorph
	"Answer the value of buttonMorph"

	^ buttonMorph! !

!DropListMorph methodsFor: 'protocol' stamp: 'gvc 7/17/2006 12:30'!
getCurrentSelectionIndex
	"Answer the index of the current selection."

	self getIndexSelector ifNil: [^0].
	^self model perform: self getIndexSelector! !

!DropListMorph methodsFor: 'accessing' stamp: 'gvc 8/8/2007 15:53'!
useSelectionIndex
	"Answer the value of useSelectionIndex"

	^ useSelectionIndex! !

!DropListMorph methodsFor: 'accessing' stamp: 'gvc 8/14/2006 13:30'!
getEnabledSelector: anObject
	"Set the value of getEnabledSelector"

	getEnabledSelector := anObject.
	self updateEnabled! !

!DropListMorph methodsFor: 'protocol' stamp: 'EstebanLorenzano 5/1/2014 00:25'!
ghostText: aStringOrText
	| text |
	
	text := aStringOrText asText asMorph.
	text textColor: self theme disabledColor.
	
	self contentMorph contents = self defaultContents
		ifTrue: [ self contentMorph contents: text ].
	
	self defaultContents: text.! !

!DropListMorph methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/19/2013 12:41'!
hideList
	"Hide the list."

	self listMorph ifNil: [^self].
	self listVisible ifFalse: [^self].
	self listMorph delete.
	self listMorph changeModelSelection: self listMorph selectionIndex.
	self roundedCorners: #(1 2 3 4).
	(self buttonMorph ifNil: [^self]) roundedCorners: (self roundedCorners copyWithoutAll: #(1 2)).
	self fillStyle: self fillStyleToUse.
	self wantsKeyboardFocus
		ifTrue: [self takeKeyboardFocus]! !

!DropListMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/14/2012 08:26'!
listMorph: anObject
	"Set the value of listMorph"

	listMorph := anObject.
	anObject 
			on: #keyStroke 
			send: #keyStroke: 
			to: self.! !

!DropListMorph methodsFor: 'drawing' stamp: 'gvc 5/31/2007 15:16'!
drawSubmorphsOn: aCanvas 
	"Display submorphs back to front.
	Draw the focus here since we are using inset bounds
	for the focus rectangle."

	super drawSubmorphsOn: aCanvas.
	self hasKeyboardFocus ifTrue: [
		self drawKeyboardFocusOn: aCanvas]! !

!DropListMorph methodsFor: 'private' stamp: 'gvc 1/23/2009 13:12'!
buttonHeight
	"Answer based on theme."
	
	^self theme buttonMinHeight! !

!DropListMorph methodsFor: 'accessing' stamp: 'gvc 6/17/2006 11:45'!
contentMorph: anObject
	"Set the value of contentMorph"

	contentMorph := anObject! !

!DropListMorph methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 3/14/2012 08:26'!
newContentMorph
	"Answer a new content morph"

	^TextMorphForFieldView new
		contents: self defaultContents;
		margins: (2@0 corner: 2@1);
		borderStyle: (BorderStyle simple width: 0);
		vResizing: #shrinkWrap;
		hResizing: #spaceFill;
		autoFit: false;
		lock.! !

!DropListMorph methodsFor: 'accessing' stamp: 'MarcusDenker 12/11/2009 07:38'!
roundedCorners: anArray
	"Set the corners to round."

	super roundedCorners: anArray.
	self buttonMorph ifNotNil: [:b |
		b roundedCorners: (anArray copyWithoutAll: #(1 2))]! !

!DropListMorph methodsFor: 'updating' stamp: 'gvc 8/8/2007 15:57'!
updateList
	"Refresh the list."

	self getListSelector isSymbol ifTrue: [
		self list: (self model perform: self getListSelector).
		listSelectionIndex := 0]! !

!DropListMorph methodsFor: 'as yet unclassified' stamp: ''!
enabledString
	"Answer the string to be shown in a menu to represent the 'enabled' status"
	
	^ (self enabled) -> 'enabled' translated! !

!DropListMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/7/2015 21:25'!
drawSubmorphsOnAthensCanvas: anAthensCanvas
	super 	drawSubmorphsOnAthensCanvas: anAthensCanvas.
	self hasKeyboardFocus ifTrue: [self drawKeyboardFocusOnAthensCanvas: anAthensCanvas].! !

!DropListMorph methodsFor: 'accessing' stamp: 'gvc 1/22/2009 15:35'!
adoptPaneColor: paneColor
	"Pass on to the list morph and border too."
	
	super adoptPaneColor: paneColor.
	paneColor ifNil: [^self].
	self fillStyle: self fillStyleToUse.
	self borderWidth > 0 ifTrue: [
		self borderStyle: self borderStyleToUse].
	self buttonMorph cornerStyle: self cornerStyle.
	self updateContentColor: paneColor.
	self listPaneColor: paneColor.
	self changed: #buttonLabel! !

!DropListMorph methodsFor: 'updating' stamp: 'nice 4/19/2011 00:36'!
updateListSelectionIndex
	"Update the list selection."

	|i|
	self useSelectionIndex
		ifTrue: [i := self getCurrentSelectionIndex.
				listSelectionIndex = i ifTrue: [^self].
				listSelectionIndex := i]
		ifFalse: [i := self getCurrentSelection.
				listSelectionIndex := i isNil
					ifTrue: [0]
					ifFalse: [self list indexOf: i]].
	self
		changed: #listSelectionIndex;
		updateContents;
		triggerEvent: #selectionIndex with: i! !

!DropListMorph methodsFor: 'accessing' stamp: 'gvc 10/12/2006 13:58'!
selectionColor
	"Answer the selection color for the receiver."

	^self listMorph selectionColor! !

!DropListMorph methodsFor: 'accessing' stamp: 'gvc 8/8/2007 15:53'!
useSelectionIndex: anObject
	"Set the value of useSelectionIndex"

	useSelectionIndex := anObject! !

!DropListMorph methodsFor: 'accessing' stamp: 'gvc 7/17/2006 12:26'!
setIndexSelector: anObject
	"Set the value of setIndexSelector"

	setIndexSelector := anObject! !

!DropListMorph methodsFor: 'wrapping' stamp: 'BenjaminVanRyseghem 4/25/2012 12:56'!
wrapSelector: aSymbol
	
	wrapSelector := aSymbol.

	self updateList.
	self updateContents! !

!DropListMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/19/2013 12:36'!
listSelectionIndex: anInteger
	"Set the list selection."

	self hideList.
	anInteger = 0 ifTrue: [^self].
	listSelectionIndex := anInteger.
	self
		changed: #listSelectionIndex;
		updateContents;
		triggerEvent: #selectionIndex with: anInteger.
	self model ifNotNil: [:m | 
		self setIndexSelector ifNotNil: [:s |
			self useSelectionIndex
				ifTrue: [m perform: s with: anInteger]
				ifFalse: [m perform: s with: self selectedItem]]]! !

!DropListMorph methodsFor: 'private' stamp: 'GaryChambers 3/2/2012 12:10'!
listHeight
	"Answer the height for the list."

	^(self listMorph listMorph height + 6 max: 38) min: (15 * self listFont height)! !

!DropListMorph methodsFor: 'private' stamp: 'GaryChambers 8/18/2010 17:33'!
layoutInsetToUse
	"Answer the layout inset that should be used."

	^self theme dropListInsetFor: self! !

!DropListMorph methodsFor: 'protocol' stamp: 'gvc 1/12/2007 14:12'!
selectedItem
	"Answer the selected list item."

	^(self listSelectionIndex between: 1 and: self list size) ifTrue: [
		self list at: self listSelectionIndex]! !

!DropListMorph methodsFor: 'accessing' stamp: 'gvc 9/1/2006 15:57'!
enabled: anObject
	"Set the value of enabled"

	enabled = anObject ifTrue: [^self].
	enabled := anObject.
	anObject ifFalse: [self hideList].
	self changed: #enabled.
	self
		adoptPaneColor: self paneColor;
		changed! !

!DropListMorph methodsFor: 'private' stamp: 'gvc 6/1/2009 11:40'!
buttonLabel
	"Answer the label for the button."

	^self theme dropListButtonLabelFor: self! !

!DropListMorph methodsFor: 'private' stamp: 'gvc 1/23/2009 13:12'!
buttonExtent
	"Answer based on theme and preferences."
	
	^self buttonWidth @ self buttonHeight! !

!DropListMorph methodsFor: 'geometry' stamp: 'gvc 8/7/2007 11:04'!
extent: newExtent
	"Update the gradient."
	
	super extent: newExtent.
	(self fillStyle notNil and: [self fillStyle isSolidFill not])
		ifTrue: [self fillStyle: self fillStyleToUse]! !

!DropListMorph methodsFor: 'updating' stamp: 'gvc 8/14/2006 13:18'!
update: aSymbol 
	"Refer to the comment in View|update:."

	aSymbol == getListSelector ifTrue: 
		[self updateList.
		^ self].
	aSymbol == getIndexSelector ifTrue:
		[self updateListSelectionIndex.
		^ self].
	aSymbol == getEnabledSelector ifTrue:
		[self updateEnabled.
		^ self].
! !

!DropListMorph methodsFor: 'accessing' stamp: 'gvc 8/14/2006 13:16'!
getEnabledSelector
	"Answer the value of getEnabledSelector"

	^ getEnabledSelector! !

!DropListMorph methodsFor: 'accessing' stamp: 'gvc 7/17/2006 12:26'!
getListSelector
	"Answer the value of getListSelector"

	^ getListSelector! !

!DropListMorph methodsFor: 'private' stamp: 'gvc 6/17/2006 11:42'!
listMorphClass
	"Answer the class for a new list morph"

	^PluggableListMorph! !

!DropListMorph methodsFor: 'wrapping' stamp: 'BenjaminVanRyseghem 3/13/2012 04:17'!
wrapSelector
	
	^ wrapSelector! !

!DropListMorph methodsFor: 'accessing' stamp: 'gvc 6/17/2006 11:07'!
listMorph
	"Answer the value of listMorph"

	^ listMorph! !

!DropListMorph methodsFor: 'rounding' stamp: 'GaryChambers 8/18/2010 17:34'!
cornerStyle: aSymbol
	"Update the layout inset too."

	super cornerStyle: aSymbol.
	self layoutInset: self layoutInsetToUse.
	self buttonMorph cornerStyle: self cornerStyle.
	self fillStyle: self fillStyleToUse! !

!DropListMorph methodsFor: 'accessing' stamp: 'CamilloBruni 8/4/2011 12:28'!
list: aCollection
	"Set the list contents."

	list := aCollection.
	self changed: #list! !

!DropListMorph methodsFor: 'font creation' stamp: 'GaryChambers 11/16/2011 13:41'!
listFont: aFont
	"Set the list font"

	self listMorph font: aFont! !

!DropListMorph methodsFor: 'drawing' stamp: 'gvc 1/13/2009 14:01'!
listPaneColor: paneColor
	"Set the pane color for the list."
	
	self listMorph ifNil: [^self].
	self listMorph
		adoptPaneColor: paneColor;
		fillStyle: (self theme dropListNormalListFillStyleFor: self);
		borderStyle: (self theme dropListNormalListBorderStyleFor: self)! !

!DropListMorph methodsFor: 'font accessing' stamp: 'GaryChambers 11/17/2011 13:44'!
listFont
	"Answer the list font"

	^self listMorph font! !

!DropListMorph methodsFor: 'accessing' stamp: 'gvc 1/20/2009 16:40'!
focusIndicatorCornerRadius
	"Answer the corner radius preferred for the focus indicator
	for the receiver for themes that support this."

	^self theme dropListFocusIndicatorCornerRadiusFor: self ! !

!DropListMorph methodsFor: 'accessing' stamp: 'gvc 7/17/2006 12:26'!
setIndexSelector
	"Answer the value of setIndexSelector"

	^ setIndexSelector! !

!DropListMorph methodsFor: 'wiw support' stamp: 'gvc 6/17/2006 12:27'!
morphicLayerNumber
	"Answer the layer number."

	^self listVisible ifTrue: [10] ifFalse: [super morphicLayerNumber]! !

!DropListMorph methodsFor: 'accessing' stamp: 'gvc 6/17/2006 11:28'!
listSelectionIndex
	"Answer the list selection."

	^listSelectionIndex! !

!DropListMorph methodsFor: 'private' stamp: 'gvc 8/7/2007 11:04'!
borderStyleToUse
	"Answer the borderStyle that should be used for the receiver."
	
	^self enabled
		ifTrue: [self theme dropListNormalBorderStyleFor: self]
		ifFalse: [self theme dropListDisabledBorderStyleFor: self]! !

!DropListMorph class methodsFor: 'as yet unclassified' stamp: 'gvc 8/8/2007 16:05'!
on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel useIndex: useIndex
	"Answer a new instance of the receiver on the given model using
	the given selectors as the interface."

	^self new
		useSelectionIndex: useIndex;
		on: anObject 
		list: getListSel
		selected: getSelectionSel
		changeSelected: setSelectionSel! !

!DropListMorph class methodsFor: 'as yet unclassified' stamp: 'gvc 7/17/2006 12:25'!
on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel
	"Answer a new instance of the receiver on the given model using
	the given selectors as the interface."

	^self new
		on: anObject 
		list: getListSel
		selected: getSelectionSel
		changeSelected: setSelectionSel! !

!DualChangeSorterApplication commentStamp: '<historical>'!
A DualChangeSorterApplication is a dual change sorter based on spec.

DualChangeSorter shares the model between its two subcomponents (ChangeSorterApplication).
ChangeSorterModel defines the application logic.
!
!DualChangeSorterApplication methodsFor: 'accessing' stamp: ''!
changeSorterRight

	^ changeSorterRight! !

!DualChangeSorterApplication methodsFor: 'menu - class' stamp: 'MarcusDenker 11/3/2014 15:28'!
moveClassFrom: src to: dest

	self checkThatSidesDiffer: [^ self].
	(self okToChange and: [ src selectedClass notNil]) ifFalse: [ ^ self ].

	self copyClassFrom: src to: dest.
	src forgetClass! !

!DualChangeSorterApplication methodsFor: 'initialization' stamp: ''!
setFocusOrder

	self focusOrder
		add: changeSorterLeft;
		add: changeSorterRight.! !

!DualChangeSorterApplication methodsFor: 'initialization' stamp: 'BernardoContreras 9/27/2014 13:47'!
initialize

	super initialize.
	model := ChangeSorterModel new.
	isRefreshing := false.
	SystemAnnouncer uniqueInstance weak 
		when: CurrentChangeSetChanged 
		send: #updateTitle 
		to: self ! !

!DualChangeSorterApplication methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 6/13/2012 12:30'!
menusRegistration

	self menusRegistrationFrom: changeSorterLeft to: changeSorterRight.
	self menusRegistrationFrom: changeSorterRight to: changeSorterLeft! !

!DualChangeSorterApplication methodsFor: 'menu' stamp: 'StephaneDucasse 11/11/2014 17:59'!
changesMenu: menu shifted: shifted from: sourcePanel to: destinationPanel
	| menuDest |
	menu addTitle: 'Change Set'.
	sourcePanel changeSetMenu1: menu shifted: shifted.
	menuDest := MenuModel new
		fromSpec:
			(PragmaMenuBuilder
				pragmaKeyword: 'dualChangeSorteChangesListMenu'
				model:
					{self.
					sourcePanel.
					destinationPanel}) menuSpec.
	menuDest menuGroups do: [ :each | menu addMenuGroup: each ].
	sourcePanel changeSetMenu2: menu shifted: shifted.
	^ menu! !

!DualChangeSorterApplication methodsFor: 'menu - class' stamp: 'AlejandroInfante 11/11/2013 14:53'!
copyClassFrom: src to: dest
	"Place these changes in the other changeSet also"

	| otherChangeSet |
	self checkThatSidesDiffer: [ ^ self ].
	self okToChange ifFalse: [ ^ self inform: 'Can''t discard edits.' ].
	src selectedClass ifNil: [ ^ self inform: 'Selected class is nil.' ].
	otherChangeSet := dest selectedChangeSet.
	
	self model copyClass: src selectedClass from: src selectedChangeSet to: otherChangeSet.
	
	dest setSelectedChangeSet: otherChangeSet.! !

!DualChangeSorterApplication methodsFor: 'initialization' stamp: 'StephaneDucasse 11/2/2012 14:02'!
initializePresenter

	changeSorterLeft 	whenChangesListChanges: [ self refeshedChangeSet: changeSorterRight ].
	changeSorterRight	whenChangesListChanges: [ self refeshedChangeSet: changeSorterLeft ].

! !

!DualChangeSorterApplication methodsFor: 'menu - change set' stamp: 'MartinDias 10/23/2013 14:42'!
subtractFrom: src to: dest
	"Subtract the changes found on the other side from the requesting side."
	| source destination |
	source := src selectedChangeSet.
	destination := dest selectedChangeSet.
	
	self checkThatSidesDiffer: [^ self].
	
	self model subtractFrom: source to: destination.
	
	changeSorterRight setSelectedChangeSet: source.! !

!DualChangeSorterApplication methodsFor: 'event' stamp: 'StephaneDucasse 11/2/2012 14:40'!
title

	^ super title, ' on: ', self model currentChangeSet name. ! !

!DualChangeSorterApplication methodsFor: 'menu' stamp: 'BenjaminVanRyseghem 6/13/2012 12:29'!
menusRegistrationFrom: src to: dest
	
	src changesMenu: [:menu :shifted | self changesMenu: menu shifted: shifted from: src to: dest ].
	src classesMenu: [:menu :shifted | self classMenu: menu shifted: shifted from: src to: dest ].
	src methodsMenu: [:menu :shifted | self messageMenu: menu shifted: shifted from: src to: dest ].! !

!DualChangeSorterApplication methodsFor: 'menu - method' stamp: 'BenjaminVanRyseghem 6/13/2012 12:19'!
moveMethodFrom: src to: dest

	self copyMethodFrom: src to: dest.
	src forgetMessage.
	src updateClassesListAndMessagesList.! !

!DualChangeSorterApplication methodsFor: 'event' stamp: 'MarcusDenker 11/3/2014 15:36'!
refeshedChangeSet: changeSet
	isRefreshing
		ifTrue: [ ^ self ].
	isRefreshing := true.
	changeSet updateChangesList.
	isRefreshing := false! !

!DualChangeSorterApplication methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 7/31/2012 16:17'!
initialExtent

	^  900@530! !

!DualChangeSorterApplication methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 2/8/2013 14:12'!
shortcutsRegistrationFrom: src to: dest
	
	src changesModelOn: $c command do: [ self copyAllFrom: src to: dest ].
	src changesModelOn: $- command do: [ self subtractFrom: src to: dest ]. ! !

!DualChangeSorterApplication methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 6/13/2012 12:05'!
shortcutsRegistration

	self shortcutsRegistrationFrom: changeSorterLeft to: changeSorterRight.
	self shortcutsRegistrationFrom: changeSorterRight to: changeSorterLeft.! !

!DualChangeSorterApplication methodsFor: 'menu - method' stamp: 'BenjaminVanRyseghem 6/13/2012 12:18'!
copyMethodFrom: src to: dest
	"Place this change in the other changeSet also"	
	| other |
	
	self checkThatSidesDiffer: [^ self].
	other := dest selectedChangeSet.
	
	src selectedSelector ifNotNil: [:selector || class |
		class := src selectedClass.
		
		self model 
			copySelector: selector 
			inClass: class 
			from: src selectedChangeSet 
			to: other.
			
		dest updateClassesListAndMessagesList ].! !

!DualChangeSorterApplication methodsFor: 'menu' stamp: 'StephaneDucasse 2/14/2014 13:49'!
classMenu: menu shifted: shifted from: sourcePanel to: destinationPanel
	"Fill aMenu with items appropriate for the class list"

	| menuDest |
	
	sourcePanel selectedClass ifNil: [ ^ nil ].
	sourcePanel classMenu: menu shifted: shifted.
	menuDest := MenuModel new fromSpec: (PragmaMenuBuilder
		pragmaKeyword: 'dualChangeSorterClassListMenu'
		model: {self. sourcePanel. destinationPanel}) 
		menuSpec.
	menuDest menuGroups do: [ :each | menu addMenuGroup: each ].
	^ menu! !

!DualChangeSorterApplication methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 22:55'!
initializeWidgets

	self instantiateModels: #(
		changeSorterLeft  ChangeSorterApplication
		changeSorterRight  ChangeSorterApplication ).
		
	self menusRegistration.
	self shortcutsRegistration.
	self setFocusOrder! !

!DualChangeSorterApplication methodsFor: 'menu - change set' stamp: 'BenjaminVanRyseghem 6/13/2012 11:58'!
copyAllFrom: src to: dest

	self checkThatSidesDiffer: [ ^ self ].
	self model copyAllChangesFrom: (src selectedChangeSet) to: (dest selectedChangeSet).
	dest updateClassesList.! !

!DualChangeSorterApplication methodsFor: 'menu - change set' stamp: 'BenjaminVanRyseghem 6/13/2012 12:10'!
submergeFrom: src into: dest
	"Copy the contents of the receiver to the other side, then remove the receiver -- all after checking that all is well."
	| source destination index |

	source := src selectedChangeSet.
	destination := dest selectedChangeSet.
	index := src selectedChangeSetIndex.

	(self model submerge: source into: destination) ifFalse: [ ^ self ].
	
	src updateChangesList.
	src setSelectedChangeSetIndex: index.! !

!DualChangeSorterApplication methodsFor: 'accessing' stamp: ''!
model

	^ model! !

!DualChangeSorterApplication methodsFor: 'menu' stamp: 'StephaneDucasse 2/14/2014 13:48'!
messageMenu: menu shifted: shifted from: sourcePanel to: destinationPanel
	"Fill aMenu with items appropriate for the message list; could be for a single or double changeSorter"
	
	| menuDual |
	
	sourcePanel selectedSelector ifNil: [ ^ nil ].
	sourcePanel messageMenu: menu shifted: shifted.
	menuDual := MenuModel new fromSpec: (PragmaMenuBuilder 
		pragmaKeyword: 'dualChangeSorterMessageListMenu'
		model: { self. sourcePanel. destinationPanel }) 
		menuSpec.
	menuDual menuGroups do: [ :each | menu addMenuGroup: each ].
	^menu	! !

!DualChangeSorterApplication methodsFor: 'menu - change set' stamp: 'MarcusDenker 11/3/2014 15:36'!
checkThatSidesDiffer: escapeBlock
	"If the change sets on both sides of the dual sorter are the same, put up an error message and escape via escapeBlock, else proceed happily"

	changeSorterLeft selectedChangeSet == changeSorterRight selectedChangeSet
		ifFalse: [ ^ self ].
	self
		inform:
			'This command requires that the
change sets selected on the two
sides of the change sorter *not*
be the same.'.
	^ escapeBlock value! !

!DualChangeSorterApplication methodsFor: 'accessing' stamp: ''!
changeSorterLeft

	^ changeSorterLeft! !

!DualChangeSorterApplication class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 7/31/2012 16:16'!
defaultSpec
	<spec>
	
	^ SpecLayout composed
			newRow: [:r |
					r 
						add: #changeSorterLeft;
						addSplitter;
						add: #changeSorterRight ]! !

!DualChangeSorterApplication class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/14/2013 12:05'!
taskbarIcon
	^ Smalltalk ui icons changeSorterIcon! !

!DualChangeSorterApplication class methodsFor: 'menu' stamp: 'EstebanLorenzano 1/31/2013 18:34'!
messageListMenu: aBuilder
	<contextMenu>
	<dualChangeSorterMessageListMenu>
	
	| target src dest |
	
	self flag: #todo. "I do not like how I'm getting the parameters (an Array), but looks the faster way now :(
	And I need src and dest parameters because it is called in two sides of change sorter"
	target := aBuilder model first.
	src := aBuilder model second.
	dest := aBuilder model third. 
	
	(aBuilder item: #'Copy method to the other change set')
		action: [ target copyMethodFrom: src to: dest ].
	(aBuilder item: #'Move method to the other change set')
		action: [ target moveMethodFrom: src to: dest ];
		withSeparatorAfter.
! !

!DualChangeSorterApplication class methodsFor: 'menu' stamp: 'TorstenBergmann 2/12/2014 09:31'!
menuCommandOn: aBuilder 
	<worldMenu> 
	(aBuilder group: #SystemChanges)
		parent: #Tools;  
		order: 0.51;
		with: [
			(aBuilder item: #'Change Sorter')
				action:[self open]; 
				icon: self taskbarIcon.				
			(aBuilder item: #'Recover lost changes...') 
				icon: Smalltalk ui icons recoverLostChangesIcon;
				action: [Smalltalk tools changeList browseRecentLog].].			
	aBuilder withSeparatorAfter.		! !

!DualChangeSorterApplication class methodsFor: 'specs' stamp: 'StephaneDucasse 11/2/2012 13:59'!
title

	^'Dual Change Sorter'! !

!DualChangeSorterApplication class methodsFor: 'tools-registry' stamp: 'MarcusDenker 9/29/2013 15:28'!
registerToolsOn: registry

	"Add ourselves to registry. See [Smalltalk tools]" 
	registry register: self as: #changeSorter! !

!DualChangeSorterApplication class methodsFor: 'menu' stamp: 'EstebanLorenzano 1/31/2013 18:33'!
classListMenu: aBuilder
	<contextMenu>
	<dualChangeSorterClassListMenu>
	
	| target src dest |
	
	self flag: #todo. "I do not like how I'm getting the parameters (an Array), but looks the faster way now :(
	And I need src and dest parameters because it is called in two sides of change sorter"
	target := aBuilder model first.
	src := aBuilder model second.
	dest := aBuilder model third. 
	
	(aBuilder item: #'Copy class to the other change set')
		keyText: 'c';
		action: [ target copyClassFrom: src to: dest ].
	(aBuilder item: #'Move class to the other change set')
		action: [ target moveClassFrom: src to: dest ].
! !

!DualChangeSorterApplication class methodsFor: 'specs' stamp: 'MarcusDenker 9/29/2013 15:29'!
open
	self new openWithSpec! !

!DualChangeSorterApplication class methodsFor: 'menu' stamp: 'StephaneDucasse 2/14/2014 13:36'!
changesListMenu: aBuilder
	<contextMenu>
	<dualChangeSorteChangesListMenu>
	
	| target src dest |

	self flag: #todo. "I do not like how I'm getting the parameters (an Array), but looks the faster way now :(
	And I need src and dest parameters because it is called in two sides of change sorter"
	target := aBuilder model first.
	src := aBuilder model second.
	dest := aBuilder model third. 
	
	src selectedChangeSet ifNil:[ ^self ].
	
	(aBuilder item: #'Copy all to the other change set')
		keyText: 'c';
		action: [ target copyAllFrom: src to: dest ].
	(aBuilder item: #'Submerge into the other change set')
		action: [ target submerge: src into: dest ].
	(aBuilder item: #'Subtract the other change set')
		keyText: '-';
		action: [ target subtractFrom: src to: dest ];
		withSeparatorAfter.! !

!DummyEcryptor commentStamp: '<historical>'!
A DummyEcryptor is an encryptor that just do _NOT_ encrypt at all :)!
!DummyEcryptor methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/6/2012 22:08'!
encrypt: aString

	^ aString! !

!DummyEcryptorDecryptor commentStamp: '<historical>'!
A DummyEcryptorDecryptor is  an encryptor that just do _NOT_ encrypt/decrypt at all :)!
!DummyEcryptorDecryptor methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/6/2012 22:07'!
decrypt: aString base: aBase

	^ aString! !

!DummyEcryptorDecryptor methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/6/2012 22:07'!
encrypt: aString base: aBase

	^ aString! !

!DummyPackageSelectedPlugin commentStamp: 'StephaneDucasse 10/30/2014 08:21'!
A DummyPackageSelectedPlugin is a dummy plugin which displays the selected package!
!DummyPackageSelectedPlugin methodsFor: 'announcement' stamp: 'BenjaminVanRyseghem 5/11/2011 11:07'!
packageSelected: anAnnouncement
	
	| package name |
	package := anAnnouncement package.
	name := package name asString.
	package ifNil: [ name := ''].
	morph ifNotNil: [ morph contents: name]! !

!DummyPackageSelectedPlugin methodsFor: 'display' stamp: 'BenjaminVanRyseghem 5/10/2011 17:54'!
display

	morph :=  LabelMorph new 
					contents: '';
					enabled: false;
					vResizing: #shrinkWrap;
					hResizing: #spaceFill;
					yourself.
	^ morph! !

!DummyPackageSelectedPlugin class methodsFor: 'position' stamp: 'BenjaminVanRyseghem 8/25/2011 10:01'!
defaultPosition

	^ #middle! !

!DummySoundSystem commentStamp: '<historical>'!
A BeepingSoundSystem is a simple sound system just doing beep and niling everything else. !
!DummySoundSystem methodsFor: 'query' stamp: 'StephaneDucasse 8/3/2013 22:22'!
soundNamed: soundName
	"There are no sounds to look up."

	^ nil! !

!DummySoundSystem methodsFor: 'misc' stamp: 'StephaneDucasse 8/4/2013 11:21'!
randomBitsFromSoundInput: bitCount
 	"I'm not sure what the right thing to do here is."

 	self error: 'Can not provide random data.'
	"in the future we should propose a simple random generator to be 
	for the DummySoundSystem."! !

!DummySoundSystem methodsFor: 'playing' stamp: 'StephaneDucasse 8/3/2013 22:22'!
playSoundNamed: soundName ifAbsentReadFrom: aifFileName
	"Do nothing."! !

!DummySoundSystem methodsFor: 'playing' stamp: 'StephaneDucasse 8/3/2013 22:22'!
playSampledSound: samples rate: rate
	"Do nothing."
	! !

!DummySoundSystem methodsFor: 'beep' stamp: 'StephaneDucasse 8/3/2013 22:48'!
beep
	"Make a primitive beep if possible."

	self soundEnabled 
		ifTrue: [ self beepPrimitive ]! !

!DummySoundSystem methodsFor: 'playing' stamp: 'StephaneDucasse 8/3/2013 22:22'!
playSoundNamedOrBeep: soundName 
	"There is no sound support, so we make the beep."

	self beep! !

!DummySoundSystem methodsFor: 'playing' stamp: 'StephaneDucasse 8/3/2013 22:22'!
playSoundNamed: soundName
	"Do nothing."! !

!DummySoundSystem methodsFor: 'misc' stamp: 'StephaneDucasse 8/3/2013 22:22'!
sampledSoundChoices
	"No choices other than this."

	^ #('silence')! !

!DummySoundSystem methodsFor: 'private' stamp: 'StephaneDucasse 8/3/2013 22:22'!
beepPrimitive
	"Make a primitive beep. Not to be called directly.
	It is much better to use SoundSystem current beep
	since this method does not if sound is enabled"

	<primitive: 140>
	self primitiveFailed! !

!DummySystemProgressItem commentStamp: 'TorstenBergmann 1/31/2014 11:56'!
A dummy for a system progress item!
!DummySystemProgressItem methodsFor: 'reflective operations' stamp: 'SeanDeNigris 6/11/2012 11:17'!
doesNotUnderstand: aMessage! !

!DummyUIManager commentStamp: 'LaurentLaffont 2/23/2011 20:16'!
I'm an alternative UIManager used to run an the image without GUI.  I redefine methods which requires user input as these requests are irrelevant in a headless environment. !
!DummyUIManager methodsFor: 'ui requests' stamp: 'pavel.krivanek 5/31/2007 08:20'!
chooseFrom: labelList values: valueList lines: linesArray title: aString

	^ valueList first! !

!DummyUIManager methodsFor: 'ui requests' stamp: 'PavelKrivanek 11/19/2012 13:12'!
request: queryString initialAnswer: defaultAnswer 

	^ self request: queryString initialAnswer: defaultAnswer title: 'Provide the following information' entryCompletion: nil
! !

!DummyUIManager methodsFor: 'accessing' stamp: 'PavelKrivanek 11/1/2010 20:15'!
progressBarEnabled: aBoolean

  ProgressBarEnabled := aBoolean! !

!DummyUIManager methodsFor: 'ui requests' stamp: 'StephaneDucasse 9/7/2011 21:21'!
multiLineRequest: queryString initialAnswer: defaultAnswer answerHeight: answerHeight! !

!DummyUIManager methodsFor: 'default actions' stamp: 'pavel.krivanek 5/31/2007 08:20'!
fileExistsDefaultAction: anException
! !

!DummyUIManager methodsFor: 'ui requests' stamp: 'SeanDeNigris 1/23/2014 14:41'!
merge: merger informing: aString! !

!DummyUIManager methodsFor: 'default actions' stamp: 'pavel.krivanek 5/31/2007 08:20'!
syntaxErrorNotificationDefaultAction: anException

	Transcript show: '*** SYNTAX ERROR ***'; cr.
	Transcript show: anException; cr.
	Transcript show: (thisContext stack first: (20 min: thisContext stack size)); cr.
	anException return.! !

!DummyUIManager methodsFor: 'default actions' stamp: 'pavel.krivanek5/31/2007 08:20'!
unhandledErrorDefaultAction: anException

	Transcript show: '*** EXCEPTION ***'; cr.
	Transcript show: anException; cr.
	Transcript show: (thisContext stack first: (20 min: thisContext stack size)); cr.
	anException isResumable ifTrue: [ anException resume ]
! !

!DummyUIManager methodsFor: 'ui requests' stamp: 'MarcusDenker 4/29/2011 00:33'!
confirm: aString orCancel: cancelBlock

	(ProvideAnswerNotification signal: aString) ifNotNil: [:answer |
		^answer == #cancel ifTrue: [cancelBlock value] ifFalse: [answer]].

	self error: 'No user response possible'! !

!DummyUIManager methodsFor: 'ui requests' stamp: 'pavel.krivanek 5/31/2007 08:23'!
fontFromUser: priorFont

	self error: 'No user response possible'! !

!DummyUIManager methodsFor: 'ui requests' stamp: 'PavelKrivanek 11/19/2012 13:13'!
request: aStringOrText initialAnswer: defaultAnswer title: aTitle entryCompletion: anEntryCompletion

	(ProvideAnswerNotification signal: aStringOrText) ifNotNil: [:answer |
		^ answer == #default ifTrue: [defaultAnswer] ifFalse: [answer]].
	
	self error: 'No user response possible'! !

!DummyUIManager methodsFor: 'accessing' stamp: 'PavelKrivanek 11/1/2010 20:18'!
progressBarEnabled

  ^ ProgressBarEnabled ifNil: [ ProgressBarEnabled := true ].! !

!DummyUIManager methodsFor: 'ui requests' stamp: 'MarcusDenker 4/29/2011 00:33'!
confirm: queryString

	(ProvideAnswerNotification signal: queryString) ifNotNil: [:answer |
		^answer].

	self error: 'No user response possible'! !

!DummyUIManager methodsFor: 'display' stamp: 'pavel.krivanek 5/31/2007 08:20'!
checkForNewDisplaySize

	Display extent = DisplayScreen actualScreenSize ifTrue: [^ self].
	DisplayScreen startUp.
! !

!DummyUIManager methodsFor: 'ui requests' stamp: 'SeanDeNigris 6/20/2012 23:32'!
informUserDuring: aBlock

	aBlock value: DummySystemProgressItem new.! !

!DummyUIManager methodsFor: 'display' stamp: 'pavel.krivanek 5/31/2007 08:20'!
newDisplayDepthNoRestore: pixelSize

	"Change depths.  Check if there is enough space!!  , di"
	| area need |
	pixelSize = Display depth ifTrue: [^ self  "no change"].
	pixelSize abs < Display depth ifFalse:
		["Make sure there is enough space"
		area := Display boundingBox area. "pixels"

		need := (area * (pixelSize abs - Display depth) // 8)  "new bytes needed"
				+ Smalltalk lowSpaceThreshold.
		(Smalltalk garbageCollectMost <= need
			and: [Smalltalk garbageCollect <= need])
			ifTrue: [self error: 'Insufficient free space']].
	Display setExtent: Display extent depth: pixelSize.

	DisplayScreen startUp! !

!DummyUIManager methodsFor: 'ui requests' stamp: 'pavel.krivanek 5/31/2007 08:20'!
edit: aText label: labelString accept: anAction

	^ nil! !

!DummyUIManager methodsFor: 'ui requests' stamp: 'pavel.krivanek 5/31/2007 08:20'!
chooseFrom: aList lines: linesArray title: aString

	^ aList first! !

!DummyUIManager methodsFor: 'default actions' stamp: 'pavel.krivanek 5/31/2007 08:20'!
lowSpaceWatcherDefaultAction

	Transcript show: '*** LOW SPACE ***'; cr.
! !

!DummyUIManager methodsFor: 'ui requests' stamp: 'pavel.krivanek 5/31/2007 08:20'!
requestPassword: queryString
	
	^ self request: queryString initialAnswer: ''! !

!DummyUIManager methodsFor: 'default actions' stamp: 'pavel.krivanek 5/11/2008 17:44'!
warningDefaultAction: anException

	^ self unhandledErrorDefaultAction: anException! !

!DummyUIManager methodsFor: 'default actions' stamp: 'pavel.krivanek 5/31/2007 08:20'!
fileDoesNotExistsDefaultAction: anException
! !

!DummyUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 9/22/2012 20:17'!
inform: aString
	"Nothing to be done here"! !

!DummyUIManager methodsFor: 'ui requests' stamp: 'PavelKrivanek 11/19/2012 13:10'!
request: aStringOrText initialAnswer: defaultAnswer entryCompletion: anEntryCompletion
	
	^ self request: aStringOrText initialAnswer: defaultAnswer title: 'Information Required' translated entryCompletion: anEntryCompletion
! !

!DummyUIManager methodsFor: 'ui requests' stamp: 'pavel.krivanek 5/31/2007 08:20'!
chooseDirectory: label from: dir

	^ nil! !

!DummyUIManager methodsFor: 'display' stamp: 'pavel.krivanek 5/31/2007 08:20'!
restoreDisplay! !

!DummyUIManager methodsFor: 'display' stamp: 'pavel.krivanek 5/31/2007 08:20'!
restoreDisplayAfter: aBlock

	aBlock value.
	Sensor waitButton.! !

!DuplicatedSlotName commentStamp: '<historical>'!
I am signaled when trying to build a class with a duplicated slot.!
!DuplicatedSlotName methodsFor: 'accessing' stamp: 'ToonVerwaest 3/21/2011 01:10'!
oldSlot: anObject
	oldSlot := anObject! !

!DuplicatedSlotName methodsFor: 'accessing' stamp: 'ToonVerwaest 3/21/2011 01:10'!
oldSlot
	^ oldSlot! !

!DuplicatedSlotName methodsFor: 'accessing' stamp: 'ToonVerwaest 3/21/2011 01:15'!
host: anObject
	host := anObject! !

!DuplicatedSlotName methodsFor: 'accessing' stamp: 'ToonVerwaest 3/21/2011 01:17'!
messageText
	^ 'Slot #''', oldSlot name, ''' appeared twice in ', host name! !

!DuplicatedSlotName methodsFor: 'accessing' stamp: 'ToonVerwaest 3/21/2011 01:10'!
newSlot
	^ newSlot! !

!DuplicatedSlotName methodsFor: 'accessing' stamp: 'ToonVerwaest 3/21/2011 01:10'!
newSlot: anObject
	newSlot := anObject! !

!DuplicatedSlotName methodsFor: 'accessing' stamp: 'ToonVerwaest 3/21/2011 01:15'!
host
	^ host! !

!DuplicatedVariableError commentStamp: '<historical>'!
I am an error signalled when a variable is redeclared. For instance when a method is created wich has a temporary or argument with the same name as an instance variable.!
!DuplicatedVariableError methodsFor: 'accessing' stamp: 'Janniklaval 10/23/2010 13:07'!
variable: aVariable
        "Name of the duplicate variable"
        variable := aVariable! !

!DuplicatedVariableError methodsFor: 'testing' stamp: 'Janniklaval 10/23/2010 13:06'!
isResumable
        ^true! !

!DuplicatedVariableError methodsFor: 'accessing' stamp: 'Janniklaval 10/23/2010 13:06'!
variable
        "Name of the duplicate variable"
        ^variable! !

!DuplicatedVariableError methodsFor: 'accessing' stamp: 'Janniklaval 10/23/2010 13:06'!
superclass
        "The superclass in which the variable is defined"
        ^superclass! !

!DuplicatedVariableError methodsFor: 'accessing' stamp: 'Janniklaval 10/23/2010 13:06'!
superclass: aSuperclass
        "The superclass in which the variable is defined"
        superclass := aSuperclass! !

!Duration commentStamp: 'marcus.denker 6/5/2009 11:27'!
I represent a duration of time. I have nanosecond precision!
!Duration methodsFor: 'accessing' stamp: 'GuillermoPolito 8/24/2010 11:22'!
minutes
  	"Answer a number that represents the number of complete minutes in the receiver, after the number of complete hours has been removed."
 	^ (seconds rem: SecondsInHour) quo: SecondsInMinute
 ! !

!Duration methodsFor: 'converting' stamp: 'GuillermoPolito 8/24/2010 11:14'!
asSeconds
 	"Answer the number of seconds in the receiver."
 	^ seconds
 ! !

!Duration methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/19/2015 13:20'!
seconds
 	"Answer a number that represents the number of complete seconds in the receiver, after the number of complete minutes has been removed."
	
	"1002003004 nanoSeconds seconds"
 
 	^ (seconds rem: SecondsInMinute)! !

!Duration methodsFor: 'converting' stamp: 'CamilloBruni 12/13/2011 17:30'!
asDays
 	"Answer the number of days in the receiver."
 	^ self asHours / 24! !

!Duration methodsFor: 'converting' stamp: 'CamilloBruni 12/13/2011 17:30'!
asHours
 	"Answer the number of hours in the receiver."
 	^ self asMinutes / 60.0! !

!Duration methodsFor: 'converting' stamp: 'BenComan 3/3/2015 21:42'!
asMicroseconds
 
 
 	^ ((seconds * NanosInSecond) + nanos) // (10 raisedToInteger: 3)
 ! !

!Duration methodsFor: 'testing' stamp: 'brp 4/13/2006 10:20'!
isZero

	^ seconds = 0 and: [ nanos = 0 ]
! !

!Duration methodsFor: 'converting' stamp: 'brp 5/13/2003 08:01'!
asDuration
 
 	^ self
 ! !

!Duration methodsFor: '*Network-Mail' stamp: 'SeanDeNigris 12/3/2011 14:04'!
asEmailTimeOffsetString
	"Format per RFC5322  e.g.  '-0500'"

	^ String streamContents: [ :str | 
			str
				nextPut: (self positive ifTrue: [ $+ ] ifFalse: [ $- ]);
				nextPutAll: self hours abs asTwoCharacterString;
				nextPutAll: self minutes asTwoCharacterString ].! !

!Duration methodsFor: 'arithmetic' stamp: 'brp 5/13/2003 08:00'!
< comparand
 
 	^ self asNanoSeconds < comparand asNanoSeconds
 ! !

!Duration methodsFor: 'arithmetic' stamp: 'GuillermoPolito 8/24/2010 11:15'!
+ operand
  	"operand is a Duration"
	^ self class nanoSeconds: (self asNanoSeconds + operand asNanoSeconds)
 ! !

!Duration methodsFor: 'arithmetic' stamp: 'GuillermoPolito 8/24/2010 11:15'!
- operand
	"operand is a Duration"
	^ self + operand negated
 ! !

!Duration methodsFor: 'operations' stamp: 'brp 9/25/2003 15:07'!
\\ operand
 
 	"modulo. Remainder defined in terms of //. Answer a Duration with the 
 	same sign as aDuration. operand is a Duration or a Number."
 
 	^ operand isNumber
 		ifTrue: [ self class nanoSeconds: (self asNanoSeconds \\ operand) ]
 		ifFalse: [ self - (operand * (self // operand)) ]
 ! !

!Duration methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 09:51'!
initialize
	super initialize.
	self seconds: 0 nanoSeconds: 0.
! !

!Duration methodsFor: 'printing' stamp: 'CamilloBruni 5/26/2012 13:09'!
printOn: aStream
	"Format as per ANSI 5.8.2.16: [-]D:HH:MM:SS[.S]" 	| d h m s n |
	d := self days abs.
	h := self hours abs.
	m := self minutes abs.
 	s := self seconds abs truncated.
	n := self nanoSeconds abs. 	
	self negative ifTrue: [ aStream nextPut: $- ].
	d printOn: aStream. aStream nextPut: $:.
	h < 10 ifTrue: [ aStream nextPut: $0. ].
	h printOn: aStream. aStream nextPut: $:.
	m < 10 ifTrue: [ aStream nextPut: $0. ].
	m printOn: aStream. aStream nextPut: $:.
	s < 10 ifTrue: [ aStream nextPut: $0. ].
	s printOn: aStream.
	n = 0 ifFalse:
		[ | z ps |
		aStream nextPut: $..
		ps := n printString padLeftTo: 9 with: $0. 
		z := ps findLast: [ :c | c asciiValue > $0 asciiValue ].
		ps from: 1 to: z do: [ :c | aStream nextPut: c ] ].
! !

!Duration methodsFor: 'operations' stamp: 'brp 9/25/2003 14:29'!
// operand
 
 	"operand is a Duration or a Number"
 
 
 	^ operand isNumber
 		ifTrue: [ self class nanoSeconds: (self asNanoSeconds // operand) asInteger ]
 		ifFalse: [ self asNanoSeconds // operand asDuration asNanoSeconds ]
 ! !

!Duration methodsFor: 'accessing' stamp: 'brp 5/13/2003 08:01'!
abs
 
 	^ self class seconds: seconds abs nanoSeconds: nanos abs
 ! !

!Duration methodsFor: 'accessing' stamp: 'GuillermoPolito 8/24/2010 11:21'!
hours
 	"Answer a number that represents the number of complete hours in the receiver, after the number of complete days has been removed."
 
 	^ (seconds rem: SecondsInDay) quo: SecondsInHour
 ! !

!Duration methodsFor: 'converting' stamp: 'UdoSchneider 1/30/2015 15:32'!
asMinutes
 	"Answer the number of minutes in the receiver."
 	^ self asNanoSeconds  / 60000000000.0! !

!Duration methodsFor: 'accessing' stamp: 'GuillermoPolito 8/24/2010 11:22'!
days
 	"Answer a number that represents the number of complete days in the receiver"
	^ seconds quo: SecondsInDay
! !

!Duration methodsFor: 'operations' stamp: 'brp 9/25/2003 15:42'!
roundTo: aDuration
 	"e.g. if the receiver is 5 minutes, 37 seconds, and aDuration is 2 minutes, answer 6 minutes."
 
 	^ self class nanoSeconds: (self asNanoSeconds roundTo: aDuration asNanoSeconds)
 
 ! !

!Duration methodsFor: 'operations' stamp: 'brp 9/25/2003 15:38'!
truncateTo: aDuration
 	"e.g. if the receiver is 5 minutes, 37 seconds, and aDuration is 2 minutes, answer 4 minutes."
 
 	^ self class
 		nanoSeconds: (self asNanoSeconds truncateTo: aDuration asNanoSeconds)
 
 ! !

!Duration methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 2/19/2015 13:28'!
humanReadablePrintString
	"Return a String with a human readable representation of me"

	"99999 atRandom seconds humanReadablePrintString"
	"99999999 atRandom milliSeconds humanReadablePrintString"	
	"99999999999999 atRandom nanoSeconds humanReadablePrintString"
	
	^ String streamContents: [ :out | 
		self printHumanReadableOn: out ]! !

!Duration methodsFor: 'accessing' stamp: 'GuillermoPolito 8/24/2010 11:14'!
hash
	^seconds bitXor: nanos
 ! !

!Duration methodsFor: 'converting' stamp: 'brp 5/13/2003 08:03'!
asMilliSeconds
 
 
 	^ ((seconds * NanosInSecond) + nanos) // (10 raisedToInteger: 6)
 ! !

!Duration methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/19/2015 13:20'!
wholeMicroseconds
	"Answer the number of whole microseconds in me after whole seconds and milliseconds are removed"
	
	"1002003004 nanoSeconds wholeMicroseconds"

	^ (nanos rem: 1e6) quo: 1e3! !

!Duration methodsFor: 'private' stamp: 'brp 9/25/2003 14:42'!
storeOn: aStream
 
 	aStream
 		nextPut: $(;
 		nextPutAll: self className;
 		nextPutAll: ' seconds: ';
 		print: seconds;
 		nextPutAll: ' nanoSeconds: ';
 		print: nanos;
 		nextPut: $).
 ! !

!Duration methodsFor: '*GT-Playground' stamp: 'TudorGirba 3/16/2015 07:42'!
gtPlaygroundHumanReadableString
	self < 1 minute ifTrue: [ ^ 'just now' ].
	self < 2 minutes ifTrue: [ ^ '1 minute ago' ].
	self < 1 hour ifTrue: [ ^ self minutes asString , ' minutes ago' ].
	self < 1 day ifTrue: [ ^ self hours asString , ' hours ago' ].
	self < 1 year ifTrue: [ ^ self days asString , ' days ago' ].
	^ self printString! !

!Duration methodsFor: 'accessing' stamp: 'brp 5/13/2003 08:02'!
negated
 
 	^ self class seconds: seconds negated nanoSeconds: nanos negated
 ! !

!Duration methodsFor: 'accessing' stamp: 'brp 5/13/2003 08:02'!
negative
 
 
 	^ self positive not
 ! !

!Duration methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/19/2015 13:21'!
wholeNanoseconds
	"Answer the number of whole nanoseconds in me after whole seconds, milli & microseconds are removed"

	"1002003004 nanoSeconds wholeNanoseconds"

	^ nanos rem: 1e3! !

!Duration methodsFor: 'accessing' stamp: 'brp 5/13/2003 08:02'!
positive
 
 
 	^ seconds = 0 ifTrue: [ nanos positive ] ifFalse: [ seconds positive ]
 ! !

!Duration methodsFor: 'private' stamp: 'StephaneDucasse 9/1/2010 14:32'!
seconds: secondCount nanoSeconds: nanoCount 
	"Private - only used by Duration class"

	seconds := secondCount.
	nanos := nanoCount rounded.
	"normalize if signs do not match"
	[ nanos < 0 and: [ seconds > 0 ] ]
		whileTrue: [ seconds := seconds - 1.
			nanos := nanos + NanosInSecond ].
	[ seconds < 0 and: [ nanos > 0 ] ]
		whileTrue: [ seconds := seconds + 1.
			nanos := nanos - NanosInSecond ]
! !

!Duration methodsFor: 'arithmetic' stamp: 'brp 1/9/2004 06:25'!
= comparand 
 	"Answer whether the argument is a <Duration> representing the same 
 	period of time as the receiver."
 
 	^ self == comparand
 		ifTrue: [true]
 		ifFalse: 
 			[self species = comparand species 
 				ifTrue: [self asNanoSeconds = comparand asNanoSeconds]
 				ifFalse: [false] ]! !

!Duration methodsFor: 'converting' stamp: 'brp 5/13/2003 08:03'!
nanoSeconds
 
 
 	^ nanos
 ! !

!Duration methodsFor: '*GT-InspectorExtensions-Core' stamp: 'SvenVanCaekenberghe 10/4/2014 20:35'!
gtInspectorDetailsIn: composite
	<gtInspectorPresentationOrder: 30>
	^ composite table
		title: [ 'Details' ];
		display: [ 
					{'days' -> self days.
					'hours' -> self hours.
					'minutes' -> self minutes.
					'seconds' -> self seconds .
					'nanoseconds' -> self nanoSeconds } ];
		column: 'Key' evaluated: #key;
		column: 'Value' evaluated: #value;
		send: #value! !

!Duration methodsFor: 'converting' stamp: 'brp 5/13/2003 08:03'!
asNanoSeconds
 
 	^ (seconds * NanosInSecond) + nanos
 ! !

!Duration methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 2/19/2015 13:22'!
printHumanReadableOn: stream
	| outputWritten count |
	outputWritten := false.
	self negative 
		ifTrue: [ 
			stream << '- '. 
			^ self abs printHumanReadableOn: stream ].
	#( (days 'day') 
		(hours 'hour') 
		(minutes 'minute') 
		(seconds 'second') 
		(wholeMilliseconds 'millisecond') 
		(wholeMicroseconds 'microsecond') 
		(wholeNanoseconds 'nanosecond')) do: [ :each |
		count := self perform: each first.
		count > 0 
			ifTrue: [
				outputWritten ifTrue: [ stream space ].				
				count printWithCommasOn: stream.
				stream space; << (each second asPluralBasedOn: count).
				outputWritten := true ] ].
	outputWritten ifFalse: [ stream << '0 seconds' ]! !

!Duration methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/19/2015 13:20'!
totalSeconds
	"Return the total number of seconds in me.
	If I have zero nano seconds, the result is equivalent to #seconds. 
	If I have nanoseconds, the result will contain fractional seconds."
	
	"1500 milliSeconds totalSeconds"

	^ nanos = 0
		ifTrue: [ seconds ]
		ifFalse: [ self asNanoSeconds / 1e9 ]! !

!Duration methodsFor: 'private' stamp: 'adrian_lienhard 1/7/2009 18:21'!
ticks
	"Answer an array {days. seconds. nanoSeconds}. Used by DateAndTime and Time."

	| days |
	days := self days.
	^ Array 
		with: days
		with: seconds - (days * SecondsInDay)
		with: nanos! !

!Duration methodsFor: 'converting' stamp: 'brp 9/25/2003 13:42'!
asDelay
 
 	^ Delay forDuration: self! !

!Duration methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/19/2015 13:21'!
wholeMilliseconds
	"Answer the number of whole milliseconds in me after whole seconds are removed"

	"1002003004 nanoSeconds wholeMilliseconds"
	
	^ nanos quo: 1e6! !

!Duration methodsFor: 'arithmetic' stamp: 'GuillermoPolito 8/24/2010 11:15'!
* operand
	"operand is a Number"
	^ self class nanoSeconds: ( (self asNanoSeconds * operand) asInteger)
! !

!Duration methodsFor: 'operations' stamp: 'BenjaminVanRyseghem 3/14/2013 15:04'!
wait

	self asDelay wait! !

!Duration methodsFor: 'arithmetic' stamp: 'sd 3/16/2008 15:36'!
/ operand
 	"operand is a Duration or a Number"
 
 	^ operand isNumber
 		ifTrue: [ self class nanoSeconds: (self asNanoSeconds / operand) asInteger ]
 		ifFalse: [ self asNanoSeconds / operand asDuration asNanoSeconds ]
 
 ! !

!Duration class methodsFor: 'instance creation' stamp: 'StephaneDucasse 5/1/2010 16:13'!
readFrom: aStream
	"Formatted as per ANSI 5.8.2.16: [-]D:HH:MM:SS[.S]"

	| sign days hours minutes seconds nanos nanosBuffer |
	sign := (aStream peekFor: $-) ifTrue: [-1] ifFalse: [1].
	days := (aStream upTo: $:) asInteger sign: sign.
	hours := (aStream upTo: $:) asInteger sign: sign.
	minutes := (aStream upTo: $:) asInteger sign: sign.
	seconds := (aStream upTo: $.) asInteger sign: sign.
	nanosBuffer := '000000000' copy.
	nanos := nanosBuffer writeStream.
	[aStream atEnd not and: [aStream peek isDigit]]
		whileTrue: [nanos nextPut: aStream next].
		
	^ self 
		days: days 
		hours: hours 
		minutes: minutes 
		seconds: seconds 
		nanoSeconds: (nanosBuffer asInteger sign: sign)! !

!Duration class methodsFor: 'instance creation simple' stamp: 'gk 8/31/2006 01:27'!
minutes: aNumber

	^ self seconds: aNumber * SecondsInMinute nanoSeconds: 0! !

!Duration class methodsFor: 'instance creation simple' stamp: 'CamilloBruni 9/22/2012 10:49'!
years: aNumber

	^ self days: (aNumber * 365) seconds: 0
! !

!Duration class methodsFor: 'instance creation' stamp: 'gk 8/31/2006 01:09'!
days: days hours: hours minutes: minutes seconds: seconds

	^ self days: days hours: hours minutes: minutes seconds: seconds nanoSeconds: 0! !

!Duration class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:03'!
gtExampleOneDay
	<gtExample>
	^ self days: 1! !

!Duration class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:03'!
gtExampleOneHour
	<gtExample>
	^ self hours: 1! !

!Duration class methodsFor: 'instance creation' stamp: 'adrian_lienhard 1/7/2009 18:19'!
seconds: seconds nanoSeconds: nanos
	^ self basicNew
		seconds: seconds truncated
		nanoSeconds: seconds fractionPart * NanosInSecond + nanos! !

!Duration class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:03'!
gtExampleOneMinute
	<gtExample>
	^ self minutes: 1! !

!Duration class methodsFor: 'instance creation' stamp: 'gk 8/30/2006 23:18'!
days: days seconds: seconds

	^ self basicNew seconds: days * SecondsInDay + seconds nanoSeconds: 0
! !

!Duration class methodsFor: 'instance creation simple' stamp: 'gk 8/31/2006 01:34'!
seconds: seconds

	^ self seconds: seconds nanoSeconds: 0
! !

!Duration class methodsFor: 'instance creation simple' stamp: 'CamilloBruni 8/22/2013 19:43'!
month: aMonth
	"aMonth is an Integer or a String"
	
	^ (Month month: aMonth) duration
! !

!Duration class methodsFor: 'instance creation simple' stamp: 'adrian_lienhard 1/7/2009 18:22'!
nanoSeconds: nanos
	"This method is slow. If you have nanos less than 10^6 you should use #seconds:nanoSeconds: instead."

	| quo |
	quo := nanos quo: NanosInSecond.
	^ self basicNew
		seconds: quo
		nanoSeconds: nanos - (quo * NanosInSecond)! !

!Duration class methodsFor: 'instance creation simple' stamp: 'gk 8/30/2006 23:20'!
weeks: aNumber

	^ self days: (aNumber * 7) seconds: 0
! !

!Duration class methodsFor: 'instance creation' stamp: 'gk 8/31/2006 01:26'!
days: days hours: hours minutes: minutes seconds: seconds nanoSeconds: nanos	

 	^ self seconds: ((days * SecondsInDay) 
						+ (hours * SecondsInHour)
							+ (minutes * SecondsInMinute) 
								+ seconds)
		nanoSeconds: nanos
! !

!Duration class methodsFor: 'instance creation simple' stamp: 'StephaneDucasse 5/5/2010 22:01'!
milliSeconds: milliCount
     
	^ self
		seconds: (milliCount quo: 1000)
		nanoSeconds: (milliCount rem: 1000) * NanosInMillisecond! !

!Duration class methodsFor: 'instance creation simple' stamp: 'gk 8/31/2006 00:09'!
zero

	^ self basicNew seconds: 0 nanoSeconds: 0
! !

!Duration class methodsFor: 'instance creation simple' stamp: 'gk 8/31/2006 01:26'!
hours: aNumber

	^ self seconds: aNumber * SecondsInHour nanoSeconds: 0! !

!Duration class methodsFor: 'instance creation' stamp: 'PeterHugossonMiller 9/2/2009 16:18'!
fromString: aString

	^ self readFrom: aString readStream
! !

!Duration class methodsFor: 'instance creation simple' stamp: 'gk 8/31/2006 01:25'!
days: aNumber

	^ self seconds: aNumber * SecondsInDay nanoSeconds: 0! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:38'!
testNegative
	self deny: aDuration negative.
	self assert: aDuration negated negative
! !

!DurationTest methodsFor: 'tests' stamp: 'brp 9/25/2003 14:57'!
testQuotient

	| d1 d2 q |
	d1 := 11.5 seconds.
	d2 := d1 // 3.
	self assert: d2 = (Duration seconds: 3 nanoSeconds: 833333333).

	q := d1 // (3 seconds).
	self assert: q = 3.

! !

!DurationTest methodsFor: 'tests' stamp: 'SvenVanCaekenberghe 2/19/2015 13:24'!
testHumanReadablePrintString
	self assert: 0 seconds humanReadablePrintString equals: '0 seconds'.
	self assert: 1 second humanReadablePrintString equals: '1 second'.
	self assert: 1 second negated humanReadablePrintString equals: '- 1 second'.
	self 
		assert: 1002003004 nanoSeconds humanReadablePrintString 
		equals: '1 second 2 milliseconds 3 microseconds 4 nanoseconds'.
	self 
		assert: (Duration days: 1 hours: 1 minutes: 1 seconds: 1) humanReadablePrintString 
		equals: '1 day 1 hour 1 minute 1 second'.
	self 
		assert: (Duration days: 2 hours: 4 minutes: 8 seconds: 16) humanReadablePrintString 
		equals: '2 days 4 hours 8 minutes 16 seconds'! !

!DurationTest methodsFor: 'tests' stamp: 'StephaneDucasse 4/28/2010 22:16'!
testAsMilliSeconds
	"self debug:#testAsMilliSeconds"
	
	self assert: (Duration nanoSeconds: 1000000)  asMilliSeconds = 1.
	self assert: (Duration seconds: 1)  asMilliSeconds = 1000.	
	self assert: (Duration nanoSeconds: 1000000)  asMilliSeconds = 1.
	self assert: (Duration nanoSeconds: 1000000)  asMilliSeconds = 1.
	self assert: aDuration   asMilliSeconds = 93784000.
	self assert: (Duration milliSeconds: 3775) asSeconds = 3.
	self assert: (Duration milliSeconds: 3775) nanoSeconds = 775000000.
	self assert: (Duration milliSeconds: -3775) asSeconds = -3.
	self assert: (Duration milliSeconds: -3775) nanoSeconds = -775000000! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:38'!
testWeeks
	self assert: (Duration  weeks: 1) days= 7.	! !

!DurationTest methodsFor: 'tests' stamp: 'al 6/12/2008 21:57'!
testHash
	self assert: aDuration hash = (Duration days: 1 hours: 2 minutes: 3 seconds: 4 nanoSeconds: 5) hash! !

!DurationTest methodsFor: 'tests' stamp: 'tbn 10/29/2012 15:16'!
testAsWeeks
	|full half quarter|
	full := (Duration days: 7).	 
	half := (Duration weeks: 0.5).			
	quarter := (Duration weeks: 0.25).			
	self 
		assert: 1 weeks = full;
		assert: 1.0 weeks = full;
		assert: 0.5 weeks = half; 
		assert: (1/2) weeks = half;
		assert: (1/4) weeks = quarter.
	self assert: 1.4 weeks + 1.6 weeks = 3 weeks	! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:38'!
testIntegerDivision
	self assert: aDuration // aDuration = 1. 
	self assert: aDuration // 2 =  (aDuration / 2). 
	"is there ever a case where this is not true, since precision is always to the nano second?"! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/9/2004 06:32'!
testComparing

	| d1 d2 d3 |
	d1 := Duration seconds: 10 nanoSeconds: 1.
	d2 := Duration seconds: 10 nanoSeconds: 1.
	d3 := Duration seconds: 10 nanoSeconds: 2.
	
	self
		assert: (d1 = d1);
		assert: (d1 = d2);
		deny: (d1 = d3);
		assert: (d1 < d3)
! !

!DurationTest methodsFor: 'tests' stamp: 'CamilloBruni 6/22/2012 21:47'!
testAsSeconds
	self assert: (Duration nanoSeconds: 1000000000)  asSeconds = 1.
	self assert: (Duration seconds: 1)  asSeconds = 1.	
	self assert: aDuration asSeconds = 93784.
	self assert: 1 asSeconds equals: (Duration seconds: 1).
	self assert: (1/2) asSeconds equals: (Duration milliSeconds: 500).! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:37'!
testTruncateTo

	self assert: ((5 minutes + 37 seconds) truncateTo: (2 minutes)) = (4 minutes).
	self assert:  (aDuration truncateTo: (Duration days: 1)) =
	               (Duration days: 1 hours: 0 minutes: 0 seconds: 0 nanoSeconds: 0).
	self assert:  (aDuration truncateTo: (Duration hours: 1)) =
	               (Duration days: 1 hours: 2 minutes: 0 seconds: 0 nanoSeconds: 0).	
	self assert:  (aDuration truncateTo: (Duration minutes: 1)) =
	               (Duration days: 1 hours: 2 minutes: 3 seconds: 0 nanoSeconds: 0).! !

!DurationTest methodsFor: 'tests' stamp: 'tbn 10/29/2012 16:19'!
testAsYear

	self 
		assert: 1 year days = 365;
		assert: 0.5 year asHours = ((364 / 2) * 24 + 12)! !

!DurationTest methodsFor: 'tests' stamp: 'SvenVanCaekenberghe 2/19/2015 13:25'!
testWholeMilliseconds
	self assert: 0 seconds wholeMilliseconds equals: 0.
	self assert: 1 second wholeMilliseconds equals: 0.
	self assert: 1002003004 nanoSeconds wholeMilliseconds equals: 2! !

!DurationTest methodsFor: 'tests' stamp: 'StephaneDucasse 4/24/2010 19:50'!
testSeconds
	self assert: aDuration seconds = 4.
	self assert: (Duration  nanoSeconds: 2) seconds = 0.	
	self assert: (Duration  seconds: 2) seconds = 2.	
	self assert: (Duration  days: 1 hours: 2 minutes: 3 seconds:4) seconds = (4).
	self deny: (Duration  days: 1 hours: 2 minutes: 3 seconds:4) seconds = (1*24*60*60+(2*60*60)+(3*60)+4).	! !

!DurationTest methodsFor: 'tests' stamp: 'tbn 10/29/2012 16:07'!
testAsMinute

	|full half quarter|
	full := (Duration seconds: 60).
	half := (Duration seconds: 30).
	quarter := (Duration seconds: 15).	
	self 
		assert: 1 minute = full;
		assert: 1.0 minute = full;
		assert: 0.5 minute = half; 
		assert: (1/2) minute = half;
		assert: (1/4) minute = quarter.
	self assert: 0.4 minute + 0.6 minute = 1 minute	! !

!DurationTest methodsFor: 'tests' stamp: 'tbn 10/29/2012 15:15'!
testAsWeek
	|full half quarter|
	full := (Duration days: 7).	 
	half := (Duration weeks: 0.5).			
	quarter := (Duration weeks: 0.25).			
	self 
		assert: 1 week = full;
		assert: 1.0 week = full;
		assert: 0.5 week = half; 
		assert: (1/2) week = half;
		assert: (1/4) week = quarter.
	self assert: 0.4 week + 0.6 week = 1 week	! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/9/2004 06:28'!
testNumberConvenienceMethods

	self
		assert: 1 week = (Duration days: 7);
		assert: -1 week = (Duration days: -7);
		assert: 1 day = (Duration days: 1);
		assert: -1 day = (Duration days: -1);
		assert: 1 hours = (Duration hours: 1);
		assert: -1 hour = (Duration hours: -1);
		assert: 1 minute = (Duration seconds: 60);
		assert: -1 minute = (Duration seconds: -60);
		assert: 1 second = (Duration seconds: 1);
		assert: -1 second = (Duration seconds: -1);
		assert: 1 milliSecond = (Duration milliSeconds: 1);
		assert: -1 milliSecond = (Duration milliSeconds: -1);
		assert: 1 nanoSecond = (Duration nanoSeconds: 1);
		assert: -1 nanoSecond = (Duration nanoSeconds: -1)
		! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:38'!
testMultiply
	self assert: aDuration * 2 = (Duration days: 2 hours: 4 minutes: 6 seconds: 8 nanoSeconds: 10). ! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:38'!
testZero
	self assert: (Duration zero) = (Duration seconds: 0).	! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/16/2004 14:17'!
testMonthDurations

	| jan feb dec |
	jan := Duration month: #January.
	feb := Duration month: #February.
	dec := Duration month: #December.
	
	self 
		assert: jan = (Year current months first duration);
		assert: feb = (Year current months second duration);
		assert: dec = (Year current months last duration)

		
! !

!DurationTest methodsFor: 'tests' stamp: 'damiencassou 5/30/2008 11:09'!
testPrintOn
	| cs rw |
	cs := '1:02:03:04.000000005' readStream.
	rw := ReadWriteStream on: ''.
	aDuration printOn: rw.
	self assert: rw contents = cs contents! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:38'!
testAsDelay
	self deny: aDuration asDelay =   aDuration.
	"want to come up with a more meaningful test"
! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:38'!
testPositive
	self assert: (Duration nanoSeconds: 0) positive.
	self assert: aDuration positive.
	self deny: aDuration negated positive
! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:38'!
testPlus
	self assert: (aDuration + 0 hours) = aDuration.
	self assert: (aDuration + aDuration) = (Duration days: 2 hours: 4 minutes: 6 seconds: 8 nanoSeconds: 10). ! !

!DurationTest methodsFor: 'tests' stamp: 'tbn 10/29/2012 16:34'!
testNanoSecond	 
	self 
		assert: (Duration nanoSeconds: 5) = 5 nanoSecond;	
		assert: 0.5 nanoSecond = (Duration nanoSeconds: 0.5);	
		assert: (1/2) nanoSecond = (Duration nanoSeconds: 0.5).	
				! !

!DurationTest methodsFor: 'tests' stamp: 'SvenVanCaekenberghe 2/19/2015 13:25'!
testWholeNanoseconds
	self assert: 0 seconds wholeNanoseconds equals: 0.
	self assert: 1 second wholeNanoseconds equals: 0.
	self assert: 1002003004 nanoSeconds wholeNanoseconds equals: 4! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:38'!
testRoundTo

	self assert: ((5 minutes + 37 seconds) roundTo: (2 minutes)) = (6 minutes).
	
	self assert:  (aDuration roundTo: (Duration days: 1)) =
	               (Duration days: 1 hours: 0 minutes: 0 seconds: 0 nanoSeconds: 0).
	self assert:  (aDuration roundTo: (Duration hours: 1)) =
	               (Duration days: 1 hours: 2 minutes: 0 seconds: 0 nanoSeconds: 0).	
	self assert:  (aDuration roundTo: (Duration minutes: 1)) =
	               (Duration days: 1 hours: 2 minutes: 3 seconds: 0 nanoSeconds: 0).! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:38'!
testMinutes
	self assert: aDuration   minutes = 3.
	self assert: (Duration minutes: 3) minutes = 3.	! !

!DurationTest methodsFor: 'tests' stamp: 'tbn 10/29/2012 15:12'!
testAsSecond 
	|full half quarter|
	full := (Duration seconds: 1).
	half := (Duration seconds: 0.5).
	quarter := (Duration seconds: 0.25).	
	self 
		assert: 1 second = full;
		assert: 1.0 second = full;
		assert: 0.5 second = half; 
		assert: (1/2) second = half;
		assert: (1/4) second = quarter.
	self assert: 0.4 second + 0.6 second = 1 second	! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:38'!
testSecondsNanoSeconds 
	self assert: (Duration   seconds: 0 nanoSeconds: 5)  = (Duration  nanoSeconds: 5).	
	"not sure I should include in sunit since its Private "
	self assert: (aDuration seconds: 0 nanoSeconds: 1) = (Duration nanoSeconds: 1). 
! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:36'!
testModulo

	| d1 d2 d3 |
	d1 := 11.5 seconds.
	d2 := d1 \\ 3.
	self assert: d2 = (Duration nanoSeconds: 1).

	d3 := d1 \\ (3 seconds).
	self assert: d3 =  (Duration seconds: 2 nanoSeconds: 500000000).

	self assert: aDuration \\ aDuration = 
		(Duration days: 0 hours: 0 minutes: 0 seconds: 0 nanoSeconds: 0). 
	self assert: aDuration \\ 2 = 
		(Duration days: 0 hours: 0 minutes: 0 seconds: 0 nanoSeconds: 1).
	

! !

!DurationTest methodsFor: 'tests' stamp: 'tbn 10/24/2012 15:31'!
testAsHour
	|full half quarter|
	full := (Duration minutes: 60).
	half := (Duration minutes: 30).
	quarter := (Duration minutes: 15).	
	self 
		assert: 1 hour = full;
		assert: 1.0 hour = full;
		assert: 0.5 hour = half; 
		assert: (1/2) hour = half;
		assert: (1/4) hour = quarter! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:38'!
testMinus
	self assert: aDuration - aDuration = (Duration seconds: 0).
	self assert: aDuration - (Duration days: -1 hours: -2 minutes: -3 seconds: -4 nanoSeconds: -5) = 
						    (Duration days: 2  hours: 4  minutes: 6  seconds: 8  nanoSeconds: 10). 
	self assert: aDuration - (Duration days: 0  hours: 1  minutes: 2  seconds: 3  nanoSeconds: 4) = 
						    (Duration days: 1  hours: 1  minutes: 1  seconds: 1  nanoSeconds: 1). 
	self assert: aDuration - (Duration days: 0  hours: 3   minutes: 0  seconds: 5  nanoSeconds: 0) = 
						    (Duration days: 0  hours: 23  minutes: 2  seconds: 59  nanoSeconds: 5). ! !

!DurationTest methodsFor: 'tests' stamp: 'tbn 10/29/2012 16:11'!
testAsMilliSecond 
	  
 	self 
		assert: 1 milliSecond = (1/1000) second;
		assert: (1/2) milliSecond = (1/2000) second;
		assert: 0.5 milliSecond = (1/2000) second;
		assert: 500 milliSecond = (1/2) second! !

!DurationTest methodsFor: 'tests' stamp: 'SvenVanCaekenberghe 2/19/2015 13:25'!
testTotalSeconds
	self assert: 0 seconds totalSeconds equals: 0.
	self assert: 1 second totalSeconds equals: 1.
	self assert: 100 second totalSeconds equals: 100.
	self assert: 500 milliSeconds totalSeconds equals: 1/2.
	self assert: 1500 milliSeconds totalSeconds equals: 3/2.
	self assert: 2500 milliSeconds totalSeconds equals: 5/2.
	self assert: 1 second negated totalSeconds equals: -1! !

!DurationTest methodsFor: 'coverage' stamp: 'brp 9/25/2003 14:30'!
classToBeTested

	^ Duration


! !

!DurationTest methodsFor: 'tests' stamp: 'StephaneDucasse 4/23/2010 21:55'!
testReadFromMillisecond

	self assert: (Duration readFrom: '0:00:00:00.001 ' readStream) nanoSeconds = 1000000! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:38'!
testNegated
	self assert: aDuration + aDuration negated = (Duration seconds: 0). 
! !

!DurationTest methodsFor: 'tests' stamp: 'damiencassou 5/30/2008 11:09'!
testReadFrom
	self assert: aDuration = (Duration readFrom: '1:02:03:04.000000005' readStream)! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:38'!
testTicks
	self assert: aDuration ticks =  #(1 7384 5)! !

!DurationTest methodsFor: 'tests' stamp: 'StephaneDucasse 4/24/2010 10:52'!
testReadFromBogus

	self should: [Duration readFrom: '+0:01:02' readStream] raise: Error.
	"Seconds should be supplied as per ANSI 5.8.2.16: [-]D:HH:MM:SS[.S]"! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:38'!
testHours
	self assert: aDuration   hours = 2.
	self assert: (Duration   hours: 2) hours = 2.	! !

!DurationTest methodsFor: 'tests' stamp: 'tbn 10/29/2012 16:19'!
testAsYears

	self 
		assert: 2 years days = 730;
		assert:	0.5 year asHours = ((364 / 2) * 24 + 12)! !

!DurationTest methodsFor: 'tests' stamp: 'SvenVanCaekenberghe 2/19/2015 13:26'!
testIsZero
	self assert: Duration zero isZero.
	self assert: (Duration seconds: 0) isZero	! !

!DurationTest methodsFor: 'tests' stamp: 'UdoSchneider 1/30/2015 15:32'!
testAsMinutes
	self assert: (Duration seconds: 60) asMinutes = 1.
	self assert: (Duration hours: 1) asMinutes = 60.	
	self assert: (aDuration asMinutes closeTo:  1563.0666).
	self assert: ((Duration milliSeconds: 100) asMinutes closeTo: (1/600))! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:38'!
testDivide
	self assert: aDuration / aDuration = 1. 
	self assert: aDuration / 2 = (Duration days: 0 hours: 13 minutes: 1 seconds: 32 nanoSeconds: 2). 
	self assert: aDuration / (1/2) = (Duration days: 2 hours: 4 minutes: 6 seconds: 8 nanoSeconds: 10).
! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:38'!
testAsNanoSeconds
	self assert: (Duration nanoSeconds: 1)  asNanoSeconds = 1.
	self assert: (Duration seconds: 1)  asNanoSeconds = 1000000000.	
	self assert: aDuration   asNanoSeconds = 93784000000005.! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:38'!
testAbs
	self assert: aDuration abs = aDuration. 
	self assert: (Duration nanoSeconds: -5)  abs =  (Duration nanoSeconds: 5). 
! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:38'!
testNanoSeconds
	self assert: aDuration nanoSeconds = 5.
	self assert: (Duration nanoSeconds: 5) nanoSeconds = 5.	! !

!DurationTest methodsFor: 'tests' stamp: 'tbn 10/29/2012 15:55'!
testAsDay
	|full half quarter|
	full := (Duration minutes: 60*24).
	half := (Duration minutes: 60*12).
	quarter := (Duration minutes: 60*6).	
	self 
		assert: 1 day  = full;
		assert: 1.0 day  = full;
		assert: 0.5 day  = half; 
		assert: (1/2) day = half;
		assert: (1/4) day = quarter.
	self assert: 0.4 day + 0.6 day = 1 day	! !

!DurationTest methodsFor: 'tests' stamp: 'CamilloBruni 12/13/2011 17:36'!
testAsDays
	self assert: (Duration days: 2) asDays = 2.
	self assert: (Duration weeks: 1) asDays = 7.	
	self assert: (aDuration asDays closeTo: 1.08546).! !

!DurationTest methodsFor: 'tests' stamp: 'StephaneDucasse 4/24/2010 10:53'!
testReadFromNoException
	"self debug: #testReadFromNoException"

	#(	'0:00:00:00' 
		'0:00:00:00.000000001' 
		'0:00:00:00.999999999' 
		'0:00:00:00.100000000' 
		'0:00:00:00.10' 
		'0:00:00:00.1' 
		'0:00:00:01' 
		'0:12:45:45' 
		'1:00:00:00' 
		'365:00:00:00' 
		'-7:09:12:06.10' 
		'+0:01:02:55' 
		'+0:01:02:3') do: [:each | each asDuration printString = each]! !

!DurationTest methodsFor: 'coverage' stamp: 'brp 9/25/2003 14:30'!
selectorsToBeIgnored

	| private | 
	private := #( #printOn: ).

	^ super selectorsToBeIgnored, private
! !

!DurationTest methodsFor: 'tests' stamp: 'CamilloBruni 12/13/2011 17:35'!
testAsHours
	self assert: (Duration hours: 2) asHours = 2.
	self assert: (Duration days: 1) asHours = 24.	
	self assert: (aDuration asHours closeTo: 26.0511).! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:38'!
testAsDuration
	self assert: aDuration asDuration =  aDuration
	
! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:38'!
testFromString
	self assert: aDuration = (Duration fromString: '1:02:03:04.000000005').
! !

!DurationTest methodsFor: 'tests' stamp: 'SvenVanCaekenberghe 2/19/2015 13:25'!
testWholeMicroseconds
	self assert: 0 seconds wholeMicroseconds equals: 0.
	self assert: 1 second wholeMicroseconds equals: 0.
	self assert: 1002003004 nanoSeconds wholeMicroseconds equals: 3! !

!DurationTest methodsFor: 'running' stamp: 'brp 1/21/2004 18:36'!
setUp
	aDuration := Duration days: 1 hours: 2 minutes: 3 seconds: 4 nanoSeconds: 5 ! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:38'!
testNew
	"self assert: Duration new =  (Duration seconds: 0)."
    "new is not valid as a creation method: MessageNotUnderstood: UndefinedObject>>quo:, where Duration seconds is nil"! !

!DurationTest methodsFor: 'tests' stamp: 'StephaneDucasse 9/1/2010 14:30'!
testNormalizeNanoSeconds
	"Subtraction of two DateAndTime values may result in a request to
	create a Duration with negative nanoseconds and positive seconds.
	The resulting Duration should be normalized, otherwise its printString
	will be invalid."

	| d t1 t2 |
	t1 := '2004-01-07T11:55:01+00:00' asDateAndTime. 
	t2 := '2004-01-07T11:55:00.9+00:00' asDateAndTime.
	d := t1 - t2. "100 millisecond difference"
	self assert: d nanoSeconds > 0.
	self assert: d seconds = 0.
	self assert: d nanoSeconds = 100000000.
	self assert: d asString = '0:00:00:00.1'.
	"Verify that other combinations produces reasonable printString values"
	self assert: (Duration seconds: 1 nanoSeconds: 100000000) printString = '0:00:00:01.1'.
	self assert: (Duration seconds: -1 nanoSeconds: -100000000) printString = '-0:00:00:01.1'.
	self assert: (Duration seconds: 1 nanoSeconds: -100000000) printString = '0:00:00:00.9'.
	self assert: (Duration seconds: -1 nanoSeconds: 100000000) printString = '-0:00:00:00.9'
! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:38'!
testDays
	self assert: aDuration   days = 1.
	self assert: (Duration   days: 1) days= 1.	! !

!DurationTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:38'!
testLessThan
	self assert: aDuration  < (aDuration + 1 day ).
	self deny: aDuration < aDuration.
	! !

!DurationTest methodsFor: 'tests' stamp: 'SvenVanCaekenberghe 2/19/2015 13:25'!
testPrintHumanReadableOn
	self testHumanReadablePrintString! !

!DurationTest methodsFor: 'tests' stamp: 'StephaneDucasse 5/5/2010 22:06'!
testMilliSeconds
	#(
	"argument (milliseconds)        seconds nanoseconds"
	(5                                                      0                       5000000)
	(1005                                           1                       5000000)
	(-5                                                     0                       -5000000)
	(-1005                                          -1                      -5000000)
	(1234567                                        1234            567000000)
	(-1234567                                       -1234           -567000000))
		do: [ :each |
			| duration |
			duration := Duration milliSeconds: each first.
			self assert: duration asSeconds = each second.
			self assert: duration nanoSeconds = each third ]! !

!DurationTest methodsFor: 'tests' stamp: 'PeterHugossonMiller 9/3/2009 16:02'!
testStoreOn
	| stream |
	aDuration storeOn: (stream := (String new: 20) writeStream).
	self assert: stream contents = '(Duration seconds: 93784 nanoSeconds: 5)'.

! !

!DynamicClassGroup commentStamp: '<historical>'!
A DynamicClassGroup is a group automatically updated whose default granularity is class.!
!DynamicClassGroup methodsFor: 'announcements' stamp: 'BenjaminVanRyseghem 4/14/2012 13:31'!
methodModified: anAnnouncement
	"Do not care"! !

!DynamicClassGroup methodsFor: 'queries' stamp: 'BenjaminVanRyseghem 2/25/2012 15:41'!
protocolsFor: aClass

	^ aClass protocols sort! !

!DynamicClassGroup methodsFor: 'queries' stamp: 'MarcusDenker 5/6/2013 17:12'!
methods

	^ self classes gather: [:e | e methods ]! !

!DynamicClassGroup methodsFor: 'queries' stamp: 'BenjaminVanRyseghem 2/25/2012 16:57'!
methodsFor: aClass categorised: aSymbol

	aSymbol ifNil: [ "all" 
		^ self methodsFor: aClass ].

	^ (aClass methodsInProtocol: aSymbol) sort: [:a :b | a selector < b selector ]! !

!DynamicClassGroup methodsFor: 'announcements' stamp: 'GuillermoPolito 8/3/2012 14:42'!
classRemoved: anAnnouncement
	| class |
	
	class := anAnnouncement classRemoved.
	
	blocks copy do: [:b | 
		(b value anySatisfy: [:c | c = class ])
			ifTrue: [ | col |
				col := OrderedCollection new.
				b value do: [:c | c = class
									ifFalse: [ col add: c ]].
				blocks 
					remove: b;
					add: [ col ]]]! !

!DynamicClassGroup methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 3/2/2012 17:31'!
addClasses: aCollection 
	
	self addBlock: [ aCollection ]! !

!DynamicClassGroup methodsFor: 'queries' stamp: 'MarcusDenker 5/6/2013 17:12'!
methodsFor: aClass

	^ aClass methods sort: [:a :b | a selector < b selector ]! !

!DynamicClassGroup methodsFor: 'queries' stamp: 'BenjaminVanRyseghem 2/25/2012 16:53'!
classes

	^ (self elements collect: [:e | e theNonMetaClass]) asSet asArray sort: [:a :b | a name < b name ]! !

!DynamicClassGroup methodsFor: 'announcements' stamp: 'BenjaminVanRyseghem 4/14/2012 13:31'!
methodRemoved: anAnnouncement
	"Do not care"! !

!DynamicComposableModel commentStamp: 'StephaneDucasse 2/27/2015 20:38'!
I'm a compsable model with a dynamic behavior for managing subwidgets and the value holder communicates with them.

The idea is that instead of having a fix set of valueHolders controlling various aspects of the model. I have a dioctionary to hold such elements.

I'm specializing doesNotUnderstand: so that the programmer can simply use accessors to access my dynamic elements.  !
!DynamicComposableModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/11/2012 03:30'!
widgets

	^ widgets! !

!DynamicComposableModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/10/2012 21:51'!
widgetsDo: aBlock

	self widgets do: aBlock ! !

!DynamicComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 7/10/2012 21:51'!
needFullRebuild: aBoolean

	self needRebuild: aBoolean.
	self widgetsDo: [:e | e needRebuild: aBoolean ]! !

!DynamicComposableModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/21/2014 09:53'!
layout: aLayout

	layout value: aLayout! !

!DynamicComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 1/21/2014 09:55'!
retrieveSpec: aSelector

	self layout ifNil: [ ^ super retrieveSpec: aSelector ].

	^ self layout
		selector: aSelector;
		yourself! !

!DynamicComposableModel methodsFor: 'initialization' stamp: 'DucasseStephane 9/10/2014 09:59'!
initialize

	widgets := OrderedIdentityDictionary new asValueHolder.
	layout := nil asValueHolder.
	super initialize.	! !

!DynamicComposableModel methodsFor: 'error handling' stamp: 'StephaneDucasse 2/27/2015 20:36'!
doesNotUnderstand: aMessage
	"To make sure that we can use accessors to access the dynamically managed subcomponents."
	
	^ widgets 
			at: aMessage selector 
			ifAbsent: [ super doesNotUnderstand: aMessage ]! !

!DynamicComposableModel methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 1/21/2014 09:48'!
assign: aModel to: anInstVarName

	widgets 
		at: anInstVarName
		put: aModel.
		
	aModel owner: self! !

!DynamicComposableModel methodsFor: 'instance creation' stamp: 'ClementBera 3/7/2014 11:54'!
instantiateModels: aCollectionOfPairs
 
	aCollectionOfPairs pairsDo: [ :k :v |
		widgets at: k asSymbol put: (self createInstanceFor: v) ]! !

!DynamicComposableModel methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 7/10/2012 23:21'!
initializeWidgets! !

!DynamicComposableModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/21/2014 09:53'!
layout

	^ layout value! !

!DynamicComposableModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 1/21/2014 09:54'!
openWithSpec

	self layout ifNil: [ ^ super openWithSpec ].
	^ self openWithSpecLayout: self layout! !

!DynamicEyeElement commentStamp: '<historical>'!
I am a dynamic eye element, if you are too lazy to create your own subclass of AbstractEyeElement, use it...!
!DynamicEyeElement methodsFor: 'accessing' stamp: 'ClementBera 5/2/2013 10:27'!
value
	^ valueBlock value! !

!DynamicEyeElement methodsFor: 'accessing' stamp: 'ClementBera 5/2/2013 10:51'!
description
	"For big value to print, overwrite description block"
	descriptionBlock ifNil: [ ^ self value asString ].
	^ descriptionBlock cull: self value! !

!DynamicEyeElement methodsFor: 'accessing' stamp: 'ClementBera 5/2/2013 10:38'!
accessorCode
	^ self description! !

!DynamicEyeElement methodsFor: 'accessing' stamp: 'ClementBera 5/2/2013 10:27'!
label
	^ labelBlock value! !

!DynamicEyeElement methodsFor: 'accessing' stamp: 'ClementBera 5/2/2013 10:28'!
description: aBlock
	descriptionBlock := aBlock! !

!DynamicEyeElement methodsFor: 'accessing' stamp: 'ClementBera 5/2/2013 10:27'!
value: anObject
	valueBlock := anObject! !

!DynamicEyeElement methodsFor: 'accessing' stamp: 'ClementBera 7/2/2013 15:28'!
save: aValue
	saveBlock value: aValue! !

!DynamicEyeElement methodsFor: 'accessing' stamp: 'ClementBera 7/2/2013 15:29'!
saveBlock: anObject
	saveBlock := anObject! !

!DynamicEyeElement methodsFor: 'accessing' stamp: 'ClementBera 5/2/2013 10:27'!
label: anObject
	labelBlock := anObject! !

!DynamicEyeElement class methodsFor: 'instance creation' stamp: 'ClementBera 4/30/2013 16:55'!
host: anObject label: aLabel value: aValue
	^ (self host: anObject)
		label: aLabel;
		value: aValue;
		yourself! !

!DynamicEyeElement class methodsFor: 'instance creation' stamp: 'CamilloBruni 9/21/2013 16:14'!
host: anObject value: aValue
	^ (self host: anObject)
		value: aValue;
		yourself! !

!DynamicEyeElement class methodsFor: 'instance creation' stamp: 'ClementBera 5/2/2013 10:32'!
host: anObject label: aLabel description: aBlock value: aValue 
	^ (self host: anObject label: aLabel value: aValue)
		description: aBlock;
		yourself! !

!DynamicGroup commentStamp: '<historical>'!
A DynamicGroup is a group automatically updated whose default granularity is method.!
!DynamicGroup methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/28/2011 13:14'!
blocks

	^ blocks! !

!DynamicGroup methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 4/14/2012 12:25'!
addAll: aCollection

	aCollection do: [:e | self addBlock: [{ e }]]! !

!DynamicGroup methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/2/2012 16:59'!
addBlock: aBlock

	blocks add: aBlock! !

!DynamicGroup methodsFor: 'protocol' stamp: 'MarcusDenker 5/6/2013 17:12'!
addClasses: aCollection

	aCollection do: [:e |
		self addBlock: [ e theNonMetaClass methods ].
		self addBlock: [ e theMetaClass methods ]]! !

!DynamicGroup methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/14/2012 13:06'!
block: aBlock

	blocks := OrderedCollection with: aBlock! !

!DynamicGroup methodsFor: 'queries' stamp: 'BenjaminVanRyseghem 2/25/2012 16:52'!
classes

	^ (self methods collect: [:e | e methodClass theNonMetaClass]) asSet asArray sort: [:a :b | a name < b name ]! !

!DynamicGroup methodsFor: 'accessing' stamp: 'DamienPollet 3/6/2012 19:20'!
blocks: aCollection

	blocks := aCollection! !

!DynamicGroup methodsFor: 'announcements' stamp: 'CamilleTeruel 9/4/2014 16:30'!
methodRemoved: anAnnouncement
	| method |
	
	method := anAnnouncement method.
	blocks copy do:[: b |
			(b value anySatisfy: [:e | e == method ])
				ifTrue: [ 
					| col |
					col := OrderedCollection new.
					b value do: [:e | 
						e == method
							ifFalse: [ col add: e ]].
					blocks 
							remove: b;
							add: [ col ]]]! !

!DynamicGroup methodsFor: 'initialization' stamp: 'MarcusDenker 7/25/2014 20:48'!
initialize

	super initialize.
	blocks := OrderedCollection with: [{}].! !

!DynamicGroup methodsFor: 'announcements' stamp: 'GuillermoPolito 8/3/2012 13:29'!
methodModified: anAnnouncement
	| method new |
	
	method := anAnnouncement oldMethod.
	new := anAnnouncement newMethod.

	blocks copy do:[: b |
			(b value anySatisfy: [:e | e == method ])
				ifTrue: [ 
					| col |
					col := OrderedCollection new.
					b value do: [:e | 
						e == method
							ifTrue: [ col add: new ]
							ifFalse: [ col add: e ]].
					blocks 
							remove: b;
							add: [ col ]]]! !

!DynamicGroup methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/9/2011 16:05'!
elements

	^ (self blocks gather: [:block | block value]) copy asOrderedCollection removeDuplicates! !

!DynamicGroup methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/28/2011 13:48'!
or: aGroup

	| instance |
	instance :=  self class
					named: (self name, ' + ', aGroup name)
					blocks: (self blocks union: aGroup blocks).
	( self isReadOnly or: [ aGroup isReadOnly ]) ifTrue: [ instance beReadOnly ].
	instance removable: ( self removable or: [ aGroup removable ]).
	^ instance! !

!DynamicGroup methodsFor: '*Nautilus' stamp: 'NicolaiHess 7/30/2014 13:41'!
withClassesIn: anEnvironment createHierarchySorter: aHierarchyClass 
	| coll1 |
	self ifNil: [ ^ aHierarchyClass new ].
	coll1 := anEnvironment isSystem
		ifTrue: [ self classes ]
		ifFalse: [ self classes intersection: anEnvironment classes ].
	^ aHierarchyClass buildHierarchyForClasses: coll1! !

!DynamicGroup methodsFor: 'protocol' stamp: 'EstebanLorenzano 2/14/2014 15:38'!
addClass: aClass 
	self addClasses: { aClass }! !

!DynamicGroup methodsFor: 'announcements' stamp: 'GuillermoPolito 8/3/2012 14:42'!
classRemoved: anAnnouncement
	| class |
	
	class := anAnnouncement classRemoved theNonMetaClass.
	blocks copy do: [:b | (b value anySatisfy: [:e | e methodClass theNonMetaClass = class])
								ifTrue: [ | col |
									col := OrderedCollection new.
									b value do: [:e |
										e methodClass theNonMetaClass = class
											ifFalse: [ col add: e ]].
									blocks 
										remove: b;
										add: [ col ]]].! !

!DynamicGroup methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 3/2/2012 17:49'!
removeClass: aClass 

	self blocks copy do: [:b |
		(b value allSatisfy: [:m | m methodClass = aClass theNonMetaClass or: [ m methodClass = aClass theMetaClass ]])
			ifTrue: [ blocks remove: b ]]! !

!DynamicGroup class methodsFor: 'instance creation' stamp: 'NicolaiHess 7/27/2014 19:43'!
named: aString block: aBlock

	| instance |
	instance := self new
					name: aString;
					block: aBlock;
					yourself.
	GroupAnnouncer uniqueInstance announce: (AGroupHasBeenCreated group: instance).
	^ instance! !

!DynamicGroup class methodsFor: 'instance creation' stamp: 'NicolaiHess 7/27/2014 19:43'!
named: aString blocks: aCollection

	| instance |
	instance := self new
					name: aString;
					blocks: aCollection;
					yourself.
	GroupAnnouncer uniqueInstance announce: (AGroupHasBeenCreated group: instance).
	^ instance! !

!DynamicMessageImplementor commentStamp: '<historical>'!
Called in the debugger to generate methods when you click on the create button!
!DynamicMessageImplementor methodsFor: 'evaluating-private' stamp: 'HernanWilkinson 10/12/2010 17:14'!
writeArgumentNameIfNecessaryOf: aKeyword at: anIndex

	(self hasParameter: aKeyword) ifTrue: [ self writeArgumentNameAt: anIndex ]! !

!DynamicMessageImplementor methodsFor: 'evaluating-private' stamp: 'HernanWilkinson 10/12/2010 17:16'!
writeArgumentNameAt: anIndex

	| argumentName |
	
	argumentName := self argumentNameAt: anIndex.
	stream
		nextPutAll: ' ';
		nextPutAll: argumentName;
		space! !

!DynamicMessageImplementor methodsFor: 'evaluating-private' stamp: 'ClementBera 6/28/2013 14:27'!
writeSourceCode

	self writeMethodName.
	self writeShouldBeImplementedIfNecessary.
	self writeGetterSourceCodeIfNecessary.
	self writeSetterSourceCodeIfNecessary! !

!DynamicMessageImplementor methodsFor: 'testing' stamp: 'HernanWilkinson 10/12/2010 16:38'!
isMessageAGetter
	
	^ message numArgs = 0 and: [ class instVarNames includes: message selector ]! !

!DynamicMessageImplementor methodsFor: 'evaluating-private' stamp: 'HernanWilkinson 10/12/2010 17:14'!
write: aKeyword of: anIndex

	stream nextPutAll: aKeyword.
	self writeArgumentNameIfNecessaryOf: aKeyword at: anIndex! !

!DynamicMessageImplementor methodsFor: 'evaluating-private' stamp: 'HernanWilkinson 10/12/2010 17:08'!
writeGetterSourceCodeIfNecessary

	self isMessageAGetter ifTrue: [ self writeGetterSourceCode ]! !

!DynamicMessageImplementor methodsFor: 'evaluating-private' stamp: 'ClementBera 6/28/2013 14:28'!
writeShouldBeImplementedIfNecessary

	self messageShouldBeImplemented ifTrue: [ self writeShouldBeImplemented ]! !

!DynamicMessageImplementor methodsFor: 'evaluating-private' stamp: 'HernanWilkinson 10/12/2010 17:08'!
writeSetterSourceCode

	stream 
		cr;
		tab;
		nextPutAll: message selector allButLast;
		nextPutAll: ' := ';
		nextPutAll: argumentNames anyOne ! !

!DynamicMessageImplementor methodsFor: 'testing' stamp: 'HernanWilkinson 10/12/2010 17:11'!
hasParameter: aKeyword

	^ aKeyword last = $: or: [ message selector isInfix ]! !

!DynamicMessageImplementor methodsFor: 'evaluating-private' stamp: 'HernanWilkinson 10/12/2010 17:04'!
writeShouldBeImplemented

	stream
		cr;
		tab;
		nextPutAll: 'self ';
		nextPutAll: #shouldBeImplemented;
		nextPut: $.! !

!DynamicMessageImplementor methodsFor: 'initialization' stamp: 'HernanWilkinson 10/12/2010 16:32'!
initializeFor: aMessage in: aClass

	message := aMessage.
	class := aClass! !

!DynamicMessageImplementor methodsFor: 'evaluating' stamp: 'HernanWilkinson 10/12/2010 17:02'!
value

	argumentNames := Set new.
	stream := WriteStream on: String new.
	self writeSourceCode.
	
	^ stream contents! !

!DynamicMessageImplementor methodsFor: 'evaluating-private' stamp: 'SeanDeNigris 5/28/2013 18:09'!
argumentNameAt: anIndex

	| argumentName argument |
	
	argument := message arguments at: anIndex.
	argumentName := argument class canonicalArgumentName.
	
	[ argumentNames includes: argumentName ] whileTrue: [ argumentName := argumentName , anIndex asString ].
	argumentNames add: argumentName.

	^ argumentName! !

!DynamicMessageImplementor methodsFor: 'testing' stamp: 'HernanWilkinson 10/12/2010 16:52'!
isMessageASetter
	
	^ message numArgs = 1 and: [ class instVarNames includes: message selector allButLast ]! !

!DynamicMessageImplementor methodsFor: 'testing' stamp: 'ClementBera 6/28/2013 14:29'!
messageShouldBeImplemented
	
	^ (self isMessageAGetter | self isMessageASetter) not! !

!DynamicMessageImplementor methodsFor: 'evaluating-private' stamp: 'HernanWilkinson 10/12/2010 17:08'!
writeGetterSourceCode

	stream 
		cr;
		tab;
		nextPutAll: '^ ';
		nextPutAll: message selector ! !

!DynamicMessageImplementor methodsFor: 'evaluating-private' stamp: 'HernanWilkinson 10/12/2010 17:09'!
writeMethodName

	message selector keywords doWithIndex: [ :aKeyword :anIndex | self write: aKeyword of: anIndex ]! !

!DynamicMessageImplementor methodsFor: 'evaluating-private' stamp: 'HernanWilkinson 10/12/2010 17:08'!
writeSetterSourceCodeIfNecessary

	self isMessageASetter ifTrue: [ self writeSetterSourceCode ]! !

!DynamicMessageImplementor class methodsFor: 'instance creation' stamp: 'HernanWilkinson 10/12/2010 16:31'!
for: aMessage in: aClass

	^ self new initializeFor: aMessage in: aClass! !

!DynamicMessageImplementorTest commentStamp: 'TorstenBergmann 2/4/2014 20:46'!
SUnit tests for class DynamicMessageImplementor!
!DynamicMessageImplementorTest methodsFor: 'testing' stamp: 'CamilloBruni 7/3/2013 16:01'!
testGenerateGetter

	| messageImplementor sourceCode |		
	
	messageImplementor := DynamicMessageImplementor 
		for: (Message selector: #instVar) 
		in: self class.	
	sourceCode := messageImplementor value.	
	self 
		assert: sourceCode withSeparatorsCompacted 
		equals: 'instVar	^ instVar' withSeparatorsCompacted! !

!DynamicMessageImplementorTest methodsFor: 'testing' stamp: 'SeanDeNigris 5/28/2013 18:33'!
testNonConflictingArgumentNames

	| messageImplementor sourceCode |		
	
	messageImplementor := DynamicMessageImplementor for: (Message selector: #m1:m2:m3: arguments: #(1 $a 'string')) in: self class.	
	sourceCode := messageImplementor value.	
	self assert: sourceCode withSeparatorsCompacted equals: 'm1: anInteger m2: aCharacter m3: aString self shouldBeImplemented.' withSeparatorsCompacted! !

!DynamicMessageImplementorTest methodsFor: 'testing' stamp: 'SeanDeNigris 5/28/2013 18:42'!
testOneArgumentNotMatchingAnInstanceVariable

	| messageImplementor sourceCode |		
	
	messageImplementor := DynamicMessageImplementor for: (Message selector: #m1: argument: 1) in: self class.	
	sourceCode := messageImplementor value.	
	self assert: sourceCode withSeparatorsCompacted equals: 'm1: anInteger self shouldBeImplemented.' withSeparatorsCompacted! !

!DynamicMessageImplementorTest methodsFor: 'testing' stamp: 'CamilloBruni 7/3/2013 16:02'!
testGenerateSetter

	| messageImplementor sourceCode |		
	
	messageImplementor := DynamicMessageImplementor
		for: (Message selector: #instVar: argument: 1)
		in: self class.	
	sourceCode := messageImplementor value.	
	self
		assert: sourceCode withSeparatorsCompacted
		equals: 'instVar: anInteger instVar := anInteger' withSeparatorsCompacted! !

!DynamicMessageImplementorTest methodsFor: 'testing' stamp: 'SeanDeNigris 5/28/2013 18:16'!
testBinaryMessage

	| messageImplementor sourceCode |		
	
	messageImplementor := DynamicMessageImplementor for: (Message selector: #+ argument: 1) in: self class.	
	sourceCode := messageImplementor value.	
	self assert: sourceCode withSeparatorsCompacted equals: '+ anInteger self shouldBeImplemented.' withSeparatorsCompacted! !

!DynamicMessageImplementorTest methodsFor: 'testing' stamp: 'SeanDeNigris 5/28/2013 18:41'!
testUnaryMessageNotMatchingAnInstanceVariable

	| messageImplementor sourceCode |		
	
	messageImplementor := DynamicMessageImplementor for: (Message selector: #m1) in: self class.	
	sourceCode := messageImplementor value.	
	self assert: sourceCode withSeparatorsCompacted equals: 'm1 self shouldBeImplemented.' withSeparatorsCompacted! !

!DynamicMessageImplementorTest methodsFor: 'testing' stamp: 'SeanDeNigris 5/28/2013 18:31'!
testConflictingArgumentNames

	| messageImplementor sourceCode |		
	
	messageImplementor := DynamicMessageImplementor for: (Message selector: #m1:m2:m3: arguments: #(1 2 3)) in: self class.	
	sourceCode := messageImplementor value.	
	self assert: sourceCode withSeparatorsCompacted equals: 'm1: anInteger m2: anInteger2 m3: anInteger3 self shouldBeImplemented.' withSeparatorsCompacted! !

!DynamicSpecExample commentStamp: '<historical>'!
I am an example of how to fully dynamically create a UI, and also how to dynamically redrawn a widget.

==========================

(DynamicSpecExample object: nil) open.
(DynamicSpecExample object: 4) open.
(DynamicSpecExample object: 'Hello World') open.!
!DynamicSpecExample methodsFor: 'accessing' stamp: 'PavelKrivanek 12/13/2013 11:18'!
object: anObject
	
	object value: anObject! !

!DynamicSpecExample methodsFor: 'initialization' stamp: 'TorstenBergmann 3/4/2015 21:39'!
initialize

	super initialize.
	object := nil asValueHolder.! !

!DynamicSpecExample methodsFor: 'accessing' stamp: 'PavelKrivanek 12/13/2013 11:19'!
object

	^ object value! !

!DynamicSpecExample methodsFor: 'protocol' stamp: 'TorstenBergmann 3/4/2015 21:37'!
openOnNil
	<script: '(DynamicSpecExample object: nil) open'>
	| ui layout |	
	ui := DynamicComposableModel new.
	ui title: self title.
	ui instantiateModels: #( text TextInputFieldModel ).
	ui text 
		text: 'Object is nil';
		enabled: false.
	
	layout := SpecLayout composed
				newRow: #text height: 25;
				yourself.
				
	ui openWithSpecLayout: layout.! !

!DynamicSpecExample methodsFor: 'protocol' stamp: 'TorstenBergmann 3/4/2015 21:38'!
openOnString
	<script: '(DynamicSpecExample object: ''Pharo'') open'>
	
	| ui layout bottomLayout temp |	
	ui := DynamicComposableModel new.
	ui title: self title.
	ui instantiateModels: #( 
		label LabelModel
		check CheckBoxModel
		text TextInputFieldModel
		button ButtonModel ).
		
	ui label label: object value.

			
	object whenChangedDo: [ :o | ui label label: o asString ].
		
	ui text 
		text: object value;
		enabled: true;
		acceptBlock: [ :string | self object: string ].
	
	temp := object value.
	
	ui button
		label: 'reset';
		state: false;
		action: [ 
			ui text text: temp.
			self object: temp ].
		
	layout := SpecLayout composed
				newColumn: [ :c |
					c 
						newRow: [ :r | r add: #label; add: #check width: 100 ] height: 25;
						newRow: [ :r | r add: #text; add: #button ] height: 25 ];
				yourself.
				
	bottomLayout := SpecLayout composed
				newColumn: [ :c |
					c 
						newRow: [ :r | r add: #text; add: #button ] height: 25;
						newRow: [ :r | r add: #label; add: #check width: 100 ] height: 25 ];
				yourself.
	
	ui check
		label: 'Label on top';
		state: true;
		whenActivatedDo: [ 
			ui needFullRebuild: false.
			ui buildWithSpecLayout: layout ];
		whenDesactivatedDo: [ 
			ui needFullRebuild: false.
			ui buildWithSpecLayout: bottomLayout ].
				
	ui openWithSpecLayout: layout.! !

!DynamicSpecExample methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/30/2013 16:17'!
title

	^ 'Dynamic Examples'! !

!DynamicSpecExample methodsFor: 'protocol' stamp: 'TorstenBergmann 3/4/2015 21:37'!
openOnInteger
	<script: '(DynamicSpecExample object: 42) open'>
	
	| ui layout |
	
	ui := DynamicComposableModel new.
	ui title: self title.
	ui instantiateModels: #( 
		text LabelModel
		plus ButtonModel
		minus ButtonModel ).
		
	ui text label: object value asString.
	ui minus 
		label: '-';
		state: false;
		action: 	[ 
			object value: object value -1.
			ui text label: object value asString ].

	ui plus 
		label: '+';
		state: false;
		action: 	[ 
			object value: object value +1.
			ui text label: object value asString ].
	
	layout := SpecLayout composed
		newColumn: [ :c |
			c
				add: #text height: 25;
				newRow: [ :r | r add: #minus ; addSplitter; add: #plus ] height: 25 ];
		yourself.
				
	ui openWithSpecLayout: layout.! !

!DynamicSpecExample methodsFor: 'protocol' stamp: 'PavelKrivanek 12/13/2013 11:20'!
open

	object value ifNil: [ ^ self openOnNil ].
	object value isInteger ifTrue: [ ^ self openOnInteger ].
	object value isString ifTrue: [ ^ self openOnString ]! !

!DynamicSpecExample class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 4/2/2013 15:36'!
object: object

	^ self new
		object: object;
		yourself! !

!DynamicVariable commentStamp: 'mvl 3/13/2007 13:55'!
My subclasses are dynamic variables: each subclass represents a variable
whose value persists inside the block passed to #value:during:. There is
no way to change the value inside such a block, but it is possible to
temporarirly rebind it in a nested manner.!
!DynamicVariable methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/3/2012 21:53'!
value: anObject during: aBlock
	| p oldValue |
	p := Processor activeProcess.
	oldValue := (p psValueAt: index) ifNil: [ self default ].
	^ [ 
		p psValueAt: index put: anObject.
		aBlock value ] ensure: [ p psValueAt: index put: oldValue ]! !

!DynamicVariable class methodsFor: 'accessing' stamp: 'IgorStasenko 11/2/2011 18:40'!
value: anObject during: aBlock

	^ self soleInstance value: anObject during: aBlock! !

!DynamicWidgetChange commentStamp: '<historical>'!
I am a dummy proto to see how easy it is to replace a subwidget with another one dynamically.

DynamicWidgetChange new openWithSpec!
!DynamicWidgetChange methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 22:55'!
initialize

	super initialize.

	boolean := true! !

!DynamicWidgetChange methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/30/2013 16:04'!
button
	^ button! !

!DynamicWidgetChange methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/25/2013 18:24'!
changeToList

	self instantiateModels: 
		#( bottom #ListModel ).
		
	bottom items: (1 to: 100) asOrderedCollection.! !

!DynamicWidgetChange methodsFor: 'private' stamp: 'BenjaminVanRyseghem 4/30/2013 16:08'!
changeToButton

	self instantiateModels: 
		#( bottom ButtonModel ).
		
	bottom label: 'I am useless'.! !

!DynamicWidgetChange methodsFor: 'initialization' stamp: 'CamilloBruni 9/22/2013 21:33'!
initializeWidgets

	button := self newButton.
	bottom := self newList.
		
	button 
		label: 'Change';
		action: [ self change ];
		state: false.
		
	bottom 
		items: (1 to: 10) asOrderedCollection.! !

!DynamicWidgetChange methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/30/2013 16:05'!
bottom
	^ bottom! !

!DynamicWidgetChange methodsFor: 'private' stamp: 'BenjaminVanRyseghem 4/30/2013 16:09'!
change

	boolean := boolean not.

	boolean
		 ifTrue: [ self changeToList ]
		 ifFalse: [ self changeToButton ].
		
	self needRebuild: false.
	button needRebuild: false.
	
	self openWithSpec! !

!DynamicWidgetChange class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 4/30/2013 16:05'!
defaultSpec
	<spec>
	
	^ SpecLayout composed
		newRow: #button height: 25;
		newRow: #bottom top: 25;
		yourself! !

!EUCJPTextConverter commentStamp: '<historical>'!
Text converter for Japanese variation of EUC.!
!EUCJPTextConverter methodsFor: 'private' stamp: 'yo 10/23/2002 10:09'!
leadingChar

	^ JISX0208 leadingChar
! !

!EUCJPTextConverter methodsFor: 'private' stamp: 'yo 3/17/2004 00:41'!
languageEnvironment

	^ JapaneseEnvironment.
! !

!EUCJPTextConverter class methodsFor: 'utilities' stamp: 'yo 12/19/2003 22:00'!
encodingNames 

	^ #('euc-jp' 'eucjp') copy
! !

!EUCKRTextConverter commentStamp: '<historical>'!
Text converter for Korean variation of EUC.!
!EUCKRTextConverter methodsFor: 'private' stamp: 'yo 10/23/2002 15:19'!
leadingChar

	^ KSX1001 leadingChar
! !

!EUCKRTextConverter methodsFor: 'private' stamp: 'yo 3/17/2004 00:41'!
languageEnvironment

	^ KoreanEnvironment.
! !

!EUCKRTextConverter class methodsFor: 'utilities' stamp: 'yo 2/17/2004 18:45'!
encodingNames 

	^ #('euc-kr' 'ks-c-5601-1987' 'euckr') copy
! !

!EUCTextConverter commentStamp: '<historical>'!
Text converter for Extended Unix Character.  This is an abstract class.  The CJK variations are implemented as subclasses.!
!EUCTextConverter methodsFor: 'private' stamp: 'yo 10/4/2003 15:48'!
nonUnicodeClass

	^ (EncodedCharSet charsetAt: self leadingChar).
! !

!EUCTextConverter methodsFor: 'private' stamp: 'yo 3/17/2004 00:40'!
languageEnvironment

	self subclassResponsibility
! !

!EUCTextConverter methodsFor: 'private' stamp: 'yo 10/23/2002 10:09'!
leadingChar

	^ self subclassResponsibility
! !

!EUCTextConverter methodsFor: 'conversion' stamp: 'MarcusDenker 3/28/2011 22:15'!
nextPut: aCharacter toStream: aStream 
	| value leadingChar nonUnicodeChar value1 value2 |
	aStream isBinary ifTrue: [^aCharacter storeBinaryOn: aStream].
	value := aCharacter charCode.
	leadingChar := aCharacter leadingChar.
	(leadingChar = 0 and: [value < 128]) ifTrue: [
		aStream basicNextPut: (Character value: value).
		^ aStream
	].

	(128 <= value and: [value < 256]) ifTrue: [^ aStream].
	nonUnicodeChar := self nonUnicodeClass charFromUnicode: value.
	nonUnicodeChar ifNotNil: [
		value := nonUnicodeChar charCode.
		value1 := value // 94 + 161.
		value2 := value \\ 94 + 161.
		aStream basicNextPut: (Character value: value1).
		aStream basicNextPut: (Character value: value2).
		^ aStream
	]
! !

!EUCTextConverter methodsFor: 'conversion' stamp: 'SvenVanCaekenberghe 2/27/2013 20:57'!
nextFromStream: aStream

	| character1 character2 offset value1 value2 nonUnicodeChar |
	aStream isBinary ifTrue: [^ aStream basicNext].
	(character1 := aStream basicNext) ifNil: [^ nil].
	character1 asciiValue <= 127 ifTrue: [^ character1].
	(character2 := aStream basicNext) ifNil: [^ nil].
	offset := 16rA1.
	value1 := character1 asciiValue - offset.
	value2 := character2 asciiValue - offset.
	(value1 < 0 or: [value1 > 93]) ifTrue: [^ nil].
	(value2 < 0 or: [value2 > 93]) ifTrue: [^ nil].

	nonUnicodeChar := Character leadingChar: self leadingChar code: value1 * 94 + value2.
	^ Character codePoint: nonUnicodeChar asUnicode.
! !

!EUCTextConverterTest commentStamp: 'TorstenBergmann 2/5/2014 09:58'!
SUnit tests for EUC-JP encoding!
!EUCTextConverterTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/27/2013 20:57'!
testEUCJP

	| encodingName halfwidthKatakanaLetterKa cjkUnifiedIdeograph6CB4 cjkUnifiedIdeograph50BA
	  encodedHalfwidthKatakanaLetterKa encodedCJKUnifiedIdeograph6CB4 encodedCJKUnifiedIdeograph50BA
	  japaneseInJapanese |

	encodingName := 'euc-jp'.

	"Example characters taken from: http://www.sljfaq.org/afaq/encodings.html#encodings-EUC-JP"
	halfwidthKatakanaLetterKa := Character codePoint: 16rFF76.
	cjkUnifiedIdeograph6CB4 := Character codePoint: 16r6CB3.
	cjkUnifiedIdeograph50BA := Character codePoint: 16r50BA.
	
	encodedHalfwidthKatakanaLetterKa := #[16r8E 16rB6].
	encodedCJKUnifiedIdeograph6CB4 := #[16rB2 16rCF].
	encodedCJKUnifiedIdeograph50BA := #[16r8F 16rB2 16rB0].

	self assert: ((String with: cjkUnifiedIdeograph6CB4) convertToEncoding: encodingName) asByteArray = encodedCJKUnifiedIdeograph6CB4.
	"EUCJPTextConverter does not currently support encoding the characters defined in the JIS-X-0201 and JIS-X-0212 standards:"
	self assert: ((String with: halfwidthKatakanaLetterKa) convertToEncoding: encodingName) asByteArray = #[].
	self assert: ((String with: cjkUnifiedIdeograph50BA) convertToEncoding: encodingName) asByteArray = #[].

	self assert: (encodedCJKUnifiedIdeograph6CB4 asString convertFromEncoding: encodingName) = (String with: cjkUnifiedIdeograph6CB4).
	"EUCJPTextConverter does not currently support decoding the representations that start with the 8E and 8F markers:"
	self assert: (encodedHalfwidthKatakanaLetterKa asString convertFromEncoding: encodingName) = (String new).
	self assert: (encodedCJKUnifiedIdeograph50BA asString convertFromEncoding: encodingName) = (String new).


	japaneseInJapanese := #(16r65E5 16r672C 16r8A9E) collect: [ :codePoint | Character codePoint: codePoint ] as: String.
	((japaneseInJapanese convertToEncoding: encodingName) convertFromEncoding: encodingName) = japaneseInJapanese.! !

!EclipseUIThemeIcons commentStamp: '<historical>'!
An icon set pack taken from eclipse.!
!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:49'!
glamorousInto
	^ self icons
			at: #'glamorousInto'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousIntoIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:49'!
glamorousOpenFromUrl
	^ self icons
			at: #'glamorousOpenFromUrl'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousOpenFromUrlIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
protocolPublic2IconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQALMAABCGTTSYaEShdH29n5HIrh6JUnGxdYm4gf///////wAAAAAAAAAAAAAA
AAAAAAAAACH5BAEAAAkALAAAAAAQABAAAAQpMMlJq704680xEQKxEcFxBGIWGAhiBBpwtAeg
DXI9bEMB7J2gcEjURAAAOw=='! !

!EclipseUIThemeIcons methodsFor: '*MonticelloGUI' stamp: 'EstebanLorenzano 3/10/2015 16:55'!
newerPackagesAvailableIcon 
	^ icons
			at: #'newerPackagesAvailableIcon'
			ifAbsentPut:[ 
				(self packageIcon asFormOfDepth: 32)
					mergeWith: (Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self overlayAddIconContents readStream)) ].! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:22'!
imageIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAPcAAMBSU8FTVLFRU+N8fdWPkdWTl6NiaLpjbMGOldzV3P/+/+Lg5fv6//n4
/fj3/1FRU/z8/vr6/G5zkPr7//n6/vj5/Wl0lO3x/NTX4Gp1kfDz+mZ1kmh3lGd2k2h2k2h2
kcnU6vr7/W97kWx3i1BuoFRwn1VwnWd3kWh4km96jOXt+vf6/1KG0VFxoFV0omx5jFF2qn+n
25CYo1mQ01OAt16Qy1F8r5O55rfU9qS1yXR+itjl9fP4/vD1+1GHw1qSz1qQzFWIwV2RylSC
toy1477FzViTz1OIvluTzG12f8XV5eny++Xu91GFtLbG1XR+h3ORqVxufJequHZ/hoKLkubv
9vf7/lySuLbEzdDt/c/s/HeAhdLs+c3u/c7u/c/s+tDt+2h1e3B9g3uIjrzc6c7u+9Ds+M/t
+M3t+MPLzc/X2fr+/3iChOj2+X2IiuH6/oCKi36EhP7///H9+19lYWRqZn+FgXqAfJacmLK5
soSHfpicjoOGe4qLeYqLe3p5ZY+OeZGPdpWSc6SdZ6WeapuWcJqUcJeScqabZaidZ6ecZqac
Z6acaaCXbKeaZaibZqebZ6icaKebaaWabKSZa9mqWL6kg3txZf/69ItwU5iPhv/+/WxeU7i0
sbOEaNjT0NJqUeCNf/y/urd8eM1VVMBSUdt5eJBTUpNWVbywsP///////wAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAKsALAAAAAAQABAAAAj4AFcJHEiwoEBC
kCAtGpTIUSRGkh5JUoRIIKUyYMyU0VKGy5kuXr5omSSwERojNZD8EELCRIkWLlQ0EmgIDAgl
ey7hgGGDRpMhTAoJPATmTRROlj7FYHHER5AqggQG+oIp04M/oA5AuTIDyBJAAvt8IVXJU6g5
nTRJIXLjgh+BesAgwHMK1Q45bYo4yaGBj8A4WWSQMSBglBwMY6gk6WFH4JYscLAQAFBK1Bo2
YcTwmCLwiRYFC/IUCDBAgRo6bhzoEJhCC4RNCVKZSqNKVZ07FEQIfPHFSgUGKyhMiFChQQgr
IwRKONGhwwkUFjJ04PDBw4cNBrMTDAgAOw=='! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:49'!
glamorousExample
	^ self icons
			at: #'glamorousExample'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousExampleIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme-contents' stamp: 'EstebanLorenzano 12/6/2014 15:48'!
glamorousOpenFromUrlIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAD8/nz9fn1FtnlFsnVRvoVBtnVNwoVFtnVh0pFh0o1h1o1l1o1x4p198
q2B9q2N/rWR/rWaCr4WhzYahzZ2z1l99q199qmOArYWizYaizYaizJCq0qe72qe82q/B3TNw
pDNwo0B3pw1cmv///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAACMALAAA
AAAQABAAAAZkwJFwSCwaj8YAEglYHpXOYjNKFAlDxog2MhSFPsKt1uPhXj/WUYQcuXgujytI
lH48PJAGx+G0dCoMFAxOgQwLGwkICgmMjY2IBhkZGBkTlBgYGhkSkwQHBQUCn5+gB6YDplRE
QQA7'! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme-contents' stamp: 'EstebanLorenzano 12/6/2014 15:05'!
glamorousUpIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAP797/765P321f765f311P755f3wwv3ww/zww/711P711fvgjvvhjvzl
nfvknfvlnf3qr/zqr/3qsPzqsPvdg/zgjr2EFryDFrR6E7F4E7Z8FLZ9FLR6FLR7FLyCFrl/
Fbh/FbuBFrqBFqluEKtwEapwEaluEa91Eq1yEq91E6dsEKZrEP///wAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAACwALAAA
AAAQABAAAAZgQJZwSCwahRbL0WgBAJRLoadQCAwuUVFCIFAQCKEj6EBGGAzkT3EzkUQk7QlE
riFyMBiOw/Fo5DscRxkVDAsVGVEsKRSMFCeJKI0UKIklkiSJJpIjiSqSKoksK6MroaFBADs='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:21'!
helpIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAAP78/f7+//Lz9/Hy9vv8/46Zr/z9/4+arpKdr7W9yvf6/9zj7cvT3tzk
79vj7rO9ybS+ytrk8Cphl1N/rJaxzKO706K60o2esLO9x9vl79rk7tnj7dzl7tvk7fn8//3+
/yZimClimShhlilil0Z1oU9/rVGAqlB/qVJ/qFOAqV6KsW2Tt3icvpSz0JSyzpWzz6G71Nvl
7trk7SZilidjlyhkmCdjlShilCljlU2Aq0+Aq1CBrE+AqFCAqFyJsGmUt5SyzJWzzZezy5ay
yiZjkk2BqU+Bpl2NsZSyytvk69rj6ufw9/b7/62xtPj8//f7/u7y9ZOzypSzyNnm79jl7tvm
7Obv9Kuws/f8//n9//j9//b9//X9//T8/ury9Pr+//n9/vj8/fb+//T+//L8/fj+/vf9/ezy
8vz//6iysfv//vj8+6izr/3//v///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAG4ALAAAAAAQABAAAAfLgG6Cg4SFhR1DOSMSOkML
hm4QOkIdAgMyQjsJhQ8ISQFaY1pcAA0XGINVJxpoGyQhIjYOAR0mj25AFG1PRzYrQDc4WGpS
LYI9VAYEFSxaWCYzWB9KE4IjZ1oeWV9aKiIqBltQN4I2Xk5lYlg+Nz8EYmtnNYImEQpOXGBE
IFphZh4MSgiKQgHLEy1ZYFjoIoYLliBIBGXgMYUJEyzBulikYiTGoCYFOjDUIoYJGQ4HrhRi
U8RFgyVWOLzIkQaSBiApaNBAMcQjpJ+EAgEAOw=='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:22'!
jumpIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAMQAAAOASByKVCmPWi2UXkGZZ0qgbj+XYF+oej+YX0qbZVancGywgmywg2mr
f3CxhV+qdGKqcHGxdnGxdYS/hIK9goS+hIK1f4i5gYi4gYm4gZjGkJe9iKvPmavPmLTSnf//
/yH5BAEAAB8ALAAAAAAQABAAAAU/4CeOZGmeaKqupAMMzlo8nvYUKaNwfKcsKAClQpxQAKgA
JBKRRCAB1AFxwWQuhkOKkNhYEoRVAyBosM7otDoEADs='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:24'!
smallOpenIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAMQAAPjomPjwyPjosOjQiPDYkPjgmPjgoPjYiPjQeODAePjYkPjQgNiwcLyF
MsOLNrR/MqVsJK1yK7x/MsOFNq1sJJ5mJ61yL55fHZ5fII9SGf///////wAAAAAAAAAAAAAA
ACH5BAEAABsALAAAAAAQABAAAAVV4CaOZGmeaGo6rKNulCZrVDoBADEkzOT7pEZgSCw2SBKB
csnEkB6GqMFCrVo3EYXWUuh6uwPLBnI4WMpodFh0QVgW8Dh8LcpYEPg8nj6q+P+AL4KDIQA7'! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:16'!
glamorousRedo
	^ self smallRedoIcon! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:49'!
glamorousSpawn
	^ self icons
			at: #'glamorousSpawn'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousSpawnIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/7/2014 09:40'!
glamorousClose
	^ self icons
			at: #'glamorousClose'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousCloseIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:24'!
smallPaintIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAPcAAMBSU8FTVLFRU+N8fdWPkdWTl6NiaLpjbMGOldzV3P/+/+Lg5fv6//n4
/fj3/1FRU/z8/vr6/G5zkPr7//n6/vj5/Wl0lO3x/NTX4Gp1kfDz+mZ1kmh3lGd2k2h2k2h2
kcnU6vr7/W97kWx3i1BuoFRwn1VwnWd3kWh4km96jOXt+vf6/1KG0VFxoFV0omx5jFF2qn+n
25CYo1mQ01OAt16Qy1F8r5O55rfU9qS1yXR+itjl9fP4/vD1+1GHw1qSz1qQzFWIwV2RylSC
toy1477FzViTz1OIvluTzG12f8XV5eny++Xu91GFtLbG1XR+h3ORqVxufJequHZ/hoKLkubv
9vf7/lySuLbEzdDt/c/s/HeAhdLs+c3u/c7u/c/s+tDt+2h1e3B9g3uIjrzc6c7u+9Ds+M/t
+M3t+MPLzc/X2fr+/3iChOj2+X2IiuH6/oCKi36EhP7///H9+19lYWRqZn+FgXqAfJacmLK5
soSHfpicjoOGe4qLeYqLe3p5ZY+OeZGPdpWSc6SdZ6WeapuWcJqUcJeScqabZaidZ6ecZqac
Z6acaaCXbKeaZaibZqebZ6icaKebaaWabKSZa9mqWL6kg3txZf/69ItwU5iPhv/+/WxeU7i0
sbOEaNjT0NJqUeCNf/y/urd8eM1VVMBSUdt5eJBTUpNWVbywsP///////wAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAKsALAAAAAAQABAAAAj4AFcJHEiwoEBC
kCAtGpTIUSRGkh5JUoRIIKUyYMyU0VKGy5kuXr5omSSwERojNZD8EELCRIkWLlQ0EmgIDAgl
ey7hgGGDRpMhTAoJPATmTRROlj7FYHHER5AqggQG+oIp04M/oA5AuTIDyBJAAvt8IVXJU6g5
nTRJIXLjgh+BesAgwHMK1Q45bYo4yaGBj8A4WWSQMSBglBwMY6gk6WFH4JYscLAQAFBK1Bo2
YcTwmCLwiRYFC/IUCDBAgRo6bhzoEJhCC4RNCVKZSqNKVZ07FEQIfPHFSgUGKyhMiFChQQgr
IwRKONGhwwkUFjJ04PDBw4cNBrMTDAgAOw=='! !

!EclipseUIThemeIcons methodsFor: 'nautilus' stamp: 'EstebanLorenzano 5/10/2013 12:44'!
nautilusIcon
	^ self smallSystemBrowserIcon! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
referencesIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAPcAAAYlOhBrrbXe/87v/+f3/////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAUALAAAAAAQABAAAAhjAAsIHEiw4MAA
CBEeTBjgIIGHAQRIDPCQQEOBAQZoDACgY8aNByUKuFgg4sSFCQUUGMmQoAAAAgG8NDhw5kqZ
NAXOnInTIEOSPx1CFGrxoMYBQI8CFbn0JMaWTxPmnErVYEAAADs='! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:49'!
glamorousUp
	^ self icons
			at: #'glamorousUp'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousUpIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:24'!
smallJumpIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAMQAAAOASByKVCmPWi2UXkGZZ0qgbj+XYF+oej+YX0qbZVancGywgmywg2mr
f3CxhV+qdGKqcHGxdnGxdYS/hIK9goS+hIK1f4i5gYi4gYm4gZjGkJe9iKvPmavPmLTSnf//
/yH5BAEAAB8ALAAAAAAQABAAAAU/4CeOZGmeaKqupAMMzlo8nvYUKaNwfKcsKAClQpxQAKgA
JBKRRCAB1AFxwWQuhkOKkNhYEoRVAyBosM7otDoEADs='! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
recoverLostChanges2IconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAImEhUhvwFJmj0xfhVVqlFhtmFVqk1twmkxhiE9ki1Jnj11znUhllnV/
j0tvonGq5ZLC76PL8arZ+n654On4//H6/tHy/8fp8/z4nPz4nfntWfz1m/blZPblZ/blafbl
avblbffiavfia/TaT5OOc+3HL/vYTfLNTum9KvHDL/HDMMWaGfjBI8SXHO6+LsGSIKaUbL6E
Fb6NJrqIK7mHK9+PD7aDMbaCMbN9NrJ+NrF9Ov///wAAAAAAAAAAAAAAACH5BAEAADsALAAA
AAAQABAAAAZ+wJ1wSCwajavk6rhjCFemjSe1FAYCDoZ213KNULXYMDB07l4iDCf1GjqMMlGm
k5IJteYhLf1JzcpGNyEYICo2TEI4JxolLDk7AwgJCgYFBwtCOpo6Vg8TEBESF5hHkQkCBJak
RjAWrq8wTCQWFLW1JEwAFhW8vABMDcHCwUdBADs='! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:15'!
glamorousUndo 
	^ self smallUndoIcon! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
overlayDirtyIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIBAMAAAA2IaO4AAAAMFBMVEX6+s4dFAchFwopHQ0i
FwoqHQ00JBE+LBYzJBJJNBo/LBZROR1JMxpUODD///8AAACF0F/3AAAAD3RSTlP/////////
/////////wDU3JihAAAAAWJLR0QPGLoA2QAAAAlwSFlzAAAASAAAAEgARslrPgAAADBJREFU
CNdjeAcEDK93797N8OYu702GV7y87AwvLjBcY3jMy8vK8Ogu7xWGh4KCggCnUxHTmTvaYgAA
AABJRU5ErkJggg=='! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
testGreenIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAMQAAAOASByKVCmPWi2UXkGZZ0qgbj+XYF+oej+YX0qbZVancGywgmywg2mr
f3CxhV+qdGKqcHGxdnGxdYS/hIK9goS+hIK1f4i5gYi4gYm4gZjGkJe9iKvPmavPmLTSnf//
/yH5BAEAAB8ALAAAAAAQABAAAAU/4CeOZGmeaKqupAMMzlo8nvYUKaNwfKcsKAClQpxQAKgA
JBKRRCAB1AFxwWQuhkOKkNhYEoRVAyBosM7otDoEADs='! !

!EclipseUIThemeIcons methodsFor: 'nautilus' stamp: 'EstebanLorenzano 5/14/2013 16:27'!
testRedIcon 
	^ icons
			at: #'testRedIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self testRedIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:49'!
glamorousZoomOut
	^ self icons
			at: #'glamorousZoomOut'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousZoomOutIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/14/2013 14:49'!
referencesIcon
	^ icons
			at: #'referencesIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self referencesIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
protocolPrivate2IconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAKIAANhCT+N3gOeIkP///////wAAAAAAAAAAACH5BAEAAAQALAAAAAAQABAA
AAMcSLrc/jDKSesEGN8wArhD+EkAJ4xRplls675MAgA7'! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
protocolPrivateIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAMQAAOdgYcgpMMgwNMgpMcgdLPJNXPFNXPV2gMgZKueTi8lDPMlHPsk+OvaS
judgYPV8fO2Dg////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
ACH5BAEAABEALAAAAAAQABAAAAU0YCSOZGmeaKqu7Lm88JIqTV0rKdM8fMOkgoOhYDgIUgOI
AwCABFKEhFRKSCGuWERry+2qQgA7'! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
bundle_exporterIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAMQAAAAAAP///z8/X6CgpACAAD+/Pz+fPz9fP8DcwL+/f9/fv//ff/+/P9+f
P79/P39fP18/P////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
ACH5BAEAAAEALAAAAAAQABAAAAVoYCCOZGmK0FkqziM8jqImT8NAS/MkpvIsDB1jCJGRHLbg
Y9hwOErLRjPqTI0gAshj+0IgIACr6Ddk/AgEA6KEZC4JhUJ6LfIFhfC43DBKQKoNeXEEByQs
YBB5hAMqKWgHjCojA5GSliEAOw=='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:24'!
smallNewIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAAPP1+/j5/GN6p+7y+vL1+/n6/Pj5+152o2Z+qGqCrG2ErXGIsXOJsnyS
uH6Tuoygw4GXvISav4mewZGlx97o+N3n99/o9+Ts+efu+e3y+vP2+9zn99/p+N7o9+Hq+OLr
+Orw+ebu+fD1+/L2++jw+fX4+/f5+9DSy5iYkZmYipSTh/7978jGtJKQgJeVhZORg93axqSf
g6GdhamigZ+agZuXhKOcfv30z52ZiMazbsOwb7ysdbiqd7Oneq2ieK6kfaiffNTInv3zz7WR
I7WSI7qXJrmVKMOsZMCuc/zno555FqaBGqaCGqWCGq6KH7iUKPvdg5l0E6B7Gf///wAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAFMALAAAAAAQABAAAAedgFOCg4SFhodFhkeLjEEw
RitPhTkFlZUfQ0QrRESEOiYBBqBONzdCQjdOg0glExAKByRNTUlMS4Q7BBojGgAaJUpQUoU8
IhMPEQ0MCSVRJ4U9GRkD0tUlLIU/IMfJywIgPoUzIRjl5uRAhTEX3MoJAhc2hTIe9fb2NIU4
HBMSDgsILHSgUKNQig0bKiRMqNBFIRQQIapoQfGFCkGBAAA7'! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:49'!
glamorousHelp
	^ self icons
			at: #'glamorousHelp'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousHelpIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:49'!
glamorousDown
	^ self icons
			at: #'glamorousDown'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousDownIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:23'!
smallErrorIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAPJ0dulqbuttcfm4uvm6vPvO0N9PV95PV+5YYuJUW+FUXO9fZvvJzM4o
N84pON1ATdZMWOtVYPFea+OGjc4lNc4uPs4wQO/Jz+artc9uXNeKfduWislHPs9aUuRmYfN8
fOt8fOPExOvU1P///////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAACQALAAA
AAAQABAAAAZqQJJwSCwaj0iSaJPpZDQiZIjjAVk9nJBRxAF8vl8AJ0qcGADoNOAwKUIChIJc
ThBAihXJaM8fSSpuEQMMhIQDEXdlDwiMjQgPbUQXFAgLlpYIDhdGGA0JAaAKDhhIFxMQFhAT
m0mtrq9JQQA7'! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 16:32'!
glamorousGo
	^ self smallDoItIcon! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
monticelloPackageIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAAPPz9f//eurqw+npy/z4pP36v/780vnqefvwofz1vefhtP7hNPLYSPnh
Tsu0Q/nspvz0zPrdWvznjP3ur8+rI9KkD86jFsKhPsGeQMOTIL+dQ76bRfru0cKRIr6PI+S0
Q++/WbuYSLiWS+rMjOfPmuHNnriwn8SHDMKEDL6LJriJKfC1PuCvSLeTTuaXDb6BDr+BD/ao
HbaFK9qpTrSQUfnhtuCPELx8Ebt8Ebh4E7h5E7OBLrB/MfC6XrOOU7ioje/hyfuaCbR1FbN1
FbBxF9SiVdeFFK1tGqxtGtCOMq16Ncx7GalpHax4Nubh26ZmH////wAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAFAALAAAAAAQABAAAAepgFBQDheFFw6CiYqEEwYJ
D4eKihgjHywzRSslFBmdGRSCGiNAAAMKJBYZEgUIEJ9QG6MAFSe1JxU9PUkxHVAhI060EQQH
DLcCDTEeUCLAKCAuNkZLLifIMSlQLcAwIDUcAQtBL9cqUDTAON7g4jfXMoM+Tjnr4UE61zuC
DiZC9eJDrvFQRORfECLIlIBKdMQgkh9NFiaqwORbOCYVJCmq8KTjk4waQ4YMBAA7'! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme-contents' stamp: 'EstebanLorenzano 12/6/2014 15:48'!
glamorousRestartIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAMAAAAoLQ9TAAADAFBMVEUldVAtfFg2gl5BnmNY
q3FYqnFNp2ZNp2VNpmVhr2FhsGBttV9ttV6TxYeTxYZ4ul6iy4ujy4qsz474+Oj48LD46Ji4
mCj44Ijw4Ki+nCjQuGi4kCD42ICogBigeBiwiCDAoGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACu
YUApAAAAInRSTlP///////////////////////////////////////////8ADdDDcQAAAAFi
S0dEIcRsDRYAAAAJcEhZcwAAAEgAAABIAEbJaz4AAAB6SURBVBjTnc/NDoIwEATgacXWghS0
y49gC/v+L+mWoAdPhDl+yc5kwX/BGZhefT+x1j+YQwgz6+dOAkQk0LaPjcALdbSw9t7Xtbpk
GN+jQJFzLdQXlDHG2pvNQIOcwDlXlsgnUUojo6ruwFYaZVagAfbZNaW0MnD4lw/7fxlPz+3/
uAAAAABJRU5ErkJggg=='! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
smallProfileIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAABhHhRlEgBpFgR1JhCNVmCZYmiBKgiNNhDlnpD9spxZFgCRXmCJSjyNU
kCdamiRSijxqpTBdkRZUkRdSjxdSjhhQi3KgzHSjzXOizHelznyo0QJWlwNXlwVXl3SfuXii
u87k8H+pv9bs99fs993x+9vv+d7x+9Xs99ru997x+o62xoy1xarM2LLR3eb4/5C5x67O2Mrh
59Tp7tDm6tLn6+v8/+z8/9js78jf4tDl583i4uHx8fD///H//8Xc29zt7PH9/P///wAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAEEALAAAAAAQABAAAAd0gEGCg4SFhoeIgi8NAg0v
iT4EFjtAPxgEPocLOj08njwwHYYhGTWmBqY2ECGFDTkusAOwLjcUhQEzJboHuiUoCoUMOCDE
D8QgMRWFHhcnIs8RIiMJH4YOLSTZJCYsHIc+BRoyKTQIG5mIKxIAEyqJ7/Dx8IEAOw=='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:22'!
publishIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAL/F3UhgoExin1Fmm1hqmF5ulGV9sGRykXGEqmh1j292hHV8inmRu3WH
qH6VuYSYtam/4LDI5bHI5YSQn2V9lLnS6c7g8LjT6bnT6VyFpU6PvVSLs8Hd7sDd7cHd7dTn
8sbk8Nfs9U1aXfrpnvrvwPbflv/xwv/11P301//rs//xyuzRi//lpP/tv//aif/flv/Rdf/V
fePBfdmycffjy/vs4MnAwP///////wAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAADgALAAA
AAAQABAAAAaIQJwQN1kYh0jk5Faj0RZJoXEyIpVWsplxYeviBhAUykQuk08agDCRarvfqs3w
wKrb7y25sPB6Ff6ABQ0PGw8NOAQuigQgjY4hGyEIXzExAx4dHZgcHh8bDkICMAIXpRcYFakW
ejgBARGwsRKwDBlIrri5BjgUUb5CCr9JCsTEwkMiCiLHSMs4QQA7'! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:16'!
glamorousOpen
	^ self smallOpenIcon! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme-contents' stamp: 'EstebanLorenzano 12/6/2014 15:48'!
glamorousRightSideIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAAIWTroiTpoqXrI2ZqoyZqn2Gko+aqJOcppKcppaeo2xzd+r4/5efo+n4
/+v4/u34/dXz/+r5/+r4/u35/uz5/ur5/u35/e/6/e/5/PH6/PP6+5uhofX6+l5kY5uhoPX7
+vf7+vf7+fj7+fn7+fn7+KCjnqCknfr8+Pr7+dbtq9jurtjur9rvs9rus93wud3wuuTzyO/4
3tjtruHxwOz21/D43/r7+On00PD43vP55fb76vj87/P55Pb66/j78Pb66vj77/v8+MbibqSn
mvv896Smmqmql6mpl/z89/z8+Pv79/v7+K2slPz6266slP7977KvkJOMXraxjrKukb21ifvy
ubmyjLmzjKigdfvusL+2iL20ibiwhf389/z79/vll/z7+L2EFrmBFbqBFbV7FLR7FKpvEalv
Ea90EqZrEKpuEf///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAGsALAAAAAAQABAAAAfOgGuCg4SFa1qIiYqLWlRC
j0JcEJOUlFtWQimakg2dnp1XUkIrKjJYEAthYRILFRELUlNCLC0tURAOYU9hDg4UDlBMQi8u
qsZPuw8WE05HQjNiTdLT0mMXGEZDQjBlVd7f3llkGUUlQjdoX+rr6mgaGiYeQjQ0amZn9+pm
HB8cGwxCauCI0QGCiDRf0oAIwTABAiE5cvBQAAFFmjQjSNjIeMCAkB46fhSAQOSEjSVBiCg5
YWCAEB87gASA4KULGC9JkIBBQkCAT58Afgr9GQgAOw=='! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme-contents' stamp: 'EstebanLorenzano 12/6/2014 15:48'!
glamorousExampleIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAMQAAICQqFh4mEhgeLC4wGiAkHCoyDCYWDiYWEigYMDgyFioaGCoaHCweIC4
gJjAiKjImLjQoNjouNjosNzqtN3qtOPsuOPsueruv/Hyxfjzyvj0y/z1zv///////wAAAAAA
ACH5BAEAAB0ALAAAAAAQABAAAAVeYCeKXGmOKJkYrJFwqXpItHS8MYdEtRQhsBRnQaNMaIog
isOQTCyVI0M54jQmlcsl2qCqHBcM5uLA5RIPTeZhjnU4kM0G4hUGAARBfVngDPRuVXd5e0sC
gIFLhYkxIQA7'! !

!EclipseUIThemeIcons methodsFor: '*Komitter-UI' stamp: 'EstebanLorenzano 12/13/2013 14:44'!
historyIconContents
	^ #(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4286673726 4286673726 4286673726 4286673726 4286673726 0 0 0 4278217148 4278217148 4278217148 4278217148 4286673726 4286673726 0 0 4288516712 4294967295 4294967295 4294967295 4294967295 4286673726 4286673726 4278217148 4286104319 4286104319 4286104319 4278217148 4294967295 4288516712 4284839308 0 4288516712 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4278217148 4286104319 4286104319 4286104319 4278217148 4294967295 4288516712 4284839308 0 4288253803 4294967295 4291942109 4291482074 4294967295 4294967295 4294967295 4278217148 4286104319 4286104319 4286104319 4278217148 4294967295 4288253803 4284839308 0 4287925358 4294967295 4294967295 4294967295 4290759126 4290759126 4294967295 4278217148 4286038527 4286038527 4286039039 4278217148 4294967295 4287925358 4284707465 0 4287465586 4294705151 4291942109 4291482074 4294705151 4294705151 4294705151 4278216120 4285971967 4285971967 4285971967 4278216633 4294705151 4287465586 4284444294 0 4287005814 4294376959 4294376959 4294376959 4290759126 4290759126 4294376959 4278215349 4285840127 4285840127 4285840127 4278215862 4294376959 4287005814 4284115330 0 4286480763 4294114047 4291942109 4291482074 4294114047 4294114047 4294114047 4278214064 4285708287 4285643519 4285708799 4278214319 4294114047 4286480763 4283786365 0 4286086271 4293785343 4293785343 4293785343 4290759126 4290759126 4293785343 4278213034 4285641983 4285641983 4285641983 4278213034 4293785343 4286086271 4283391608 0 4285626499 4293522687 4293522687 4293522687 4293522687 4293522687 4293522687 4278211492 4285444351 4285378815 4285378815 4278212003 4293457151 4285626499 4283062642 0 4285298055 4285298055 4285298055 4285298055 4285298055 4293325311 4293325311 4278210466 4285116671 4285116671 4285181951 4278210465 4285298055 4285298055 4282733421 0 0 4282207077 4282207077 4282207077 4285035401 4285035401 4285035401 4278209949 4284918783 4284786943 4284787455 4278209949 4282141286 4282207077 4282207078 0 0 0 0 0 4282141542 4282009699 4282009699 4278209949 4284721919 4278209949 4284525311 4278209949 0 0 0 0 0 0 0 0 0 0 0 4278209949 4278209949 0 4278209949 4278209949 0 0 0 0 0 0 0 0 0 0 0 0 4278209949 0 0 4278209949 0 0 0)! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
smallOkIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAPcAAAAAAAAAMwAAZgAAmQAAzAAA/zMAADMAMzMAZjMAmTMAzDMA/2YAAGYA
M2YAZmYAmWYAzGYA/5kAAJkAM5kAZpkAmZkAzJkA/8wAAMwAM8wAZswAmcwAzMwA//8AAP8A
M/8AZv8Amf8AzP8A/wAzAAAzMwAzZgAzmQAzzAAz/zMzADMzMzMzZjMzmTMzzDMz/2YzAGYz
M2YzZmYzmWYzzGYz/5kzAJkzM5kzZpkzmZkzzJkz/8wzAMwzM8wzZswzmcwzzMwz//8zAP8z
M/8zZv8zmf8zzP8z/wBmAABmMwBmZgBmmQBmzABm/zNmADNmMzNmZjNmmTNmzDNm/2ZmAGZm
M2ZmZmZmmWZmzGZm/5lmAJlmM5lmZplmmZlmzJlm/8xmAMxmM8xmZsxmmcxmzMxm//9mAP9m
M/9mZv9mmf9mzP9m/wCZAACZMwCZZgCZmQCZzACZ/zOZADOZMzOZZjOZmTOZzDOZ/2aZAGaZ
M2aZZmaZmWaZzGaZ/5mZAJmZM5mZZpmZmZmZzJmZ/8yZAMyZM8yZZsyZmcyZzMyZ//+ZAP+Z
M/+ZZv+Zmf+ZzP+Z/wDMAADMMwDMZgDMmQDMzADM/zPMADPMMzPMZjPMmTPMzDPM/2bMAGbM
M2bMZmbMmWbMzGbM/5nMAJnMM5nMZpnMmZnMzJnM/8zMAMzMM8zMZszMmczMzMzM///MAP/M
M//MZv/Mmf/MzP/M/wD/AAD/MwD/ZgD/mQD/zAD//zP/ADP/MzP/ZjP/mTP/zDP//2b/AGb/
M2b/Zmb/mWb/zGb//5n/AJn/M5n/Zpn/mZn/zJn//8z/AMz/M8z/Zsz/mcz/zMz/////AP//
M///Zv//mf//zP///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAANcALAAAAAAQABAAQAg0AK8JHEiw4MBL
CAUiTGiwocKFBhk6nEix4MJLES9irMixo0eJEy9aJCjSokaQGVF6XGkwIAA7'! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
protocolExtensionIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAACXBIWXMAAAsTAAALEwEAmpwY
AAABmElEQVQ4jc2TwUtUURTGf2/m3VcwZBFGE640JmFACUShQaFN61aDazduRXdR7lon/gPm
skWIiLRsMQsjok1JEMMoUjlPHZ03M83w5s2977Tq8d5YFLjxwLf4uN/57v0O51oiwkUqdaHu
fxkszWSlXt2bBuzj8u6jt69eFuD7zbjGikcoPR1P5PlUbjKeG0iYDt5fvpYvFn/+5nb/rZML
L+gcnXBS9ch0SozNzaKcNKffahy8WSFfvKX/GkEboXN8ig56EIYAdL0m3XoLJEQbod3O34v3
JF5ggpCa6yHa0Kq3KO+7TB01UI7C7/iYIMTyu1fI/GEGSzNZGblzlczQAwDK+24kyg1nAWj/
eEflwGflvWtFhyISYXN+VLy9Lal+WJfd7VV58vihHH5+LbWvG1Iprcnm/KjE9SKSjBD0DEql
0Y5COQ654SyOncKxNI5KEfRM/8yTBtoInnuGDnoEvg9As9ZA2RZdP0Cb81ub2IOd5xNS+eJF
vKEN1+10xO/mb1B49tFKOPRnimNx+va5zP2wLvdn+p/6BQSj81S4jLsYAAAAAElFTkSuQmCC'! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/15/2013 21:09'!
modifiedIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAA
CXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH3QQGEA05RBIJeAAAAlBJREFUOMulk0tPU2EQ
ht+vh1OgxXohJFAQLzQR8QZeEiHRQKKRoHHTuBC5/IL2z7B2wSUQF8QFKCaAGHAjC8MGNMRC
aaFATJEWOLTnfDPjwliQxpDoLCfzPvNmLkpE8D9RcDQRD4drhLhdg7rEdsoZDBG9QeA+Fhq8
8nIocrheHXawGgoHNVOP73KgwltfD3XKB2QycDYT2JqYwI+t5DoJhRr6Xg/nAVZD4SAR9Z55
0Oz13rgOWloANuOAbUOVnIaqrkZy9C3i0W97TLr7ztDYcA4QC4UuCvFM6f1Gv+d2A2hqBNZ+
BoocFLpNKBaInQHqbuL7u3GsbsYSLPpe06v3Sy4AEOIOj7/UX3ytDjQ9Bsrug7MWTCsN3k6C
0lvgjAVnZhxlLS0ozmT9xNQBAC4AYEWd3qu14C9zx05dL0dQUd8EFt2Z2wIJVRZ4PMDiIrLR
JViJbQCAc1TtcsFMOSi6dRc8pytzDsR2wOk0eCcFSmVhnjDzOpMISAxozYAArDRyABJa21+J
Qrw+GCcL4ezk9YahFAxFcJ89h9TyMtjRawcA1v3J2VmIP3CsA/N8ALH5KbDo/oMhih7Y9RYl
kh+mYLY+BmddUIbxSwgFIgG4AL7WJ1iZfINd20qQkoE/Dunzi6dBFt1bVlLqLWt5CDsagR2J
gG1G4aUA3FUXEJ8cQTS5uMeKu9tGF4bzTvnT80dBJt3jJruiqrYR7nI/AMBKxBCZn4ZFmXVW
HPotzgMAwMdnzTWinXZtcJcwlYvtQBu8IUx9rPVg29jXvz/Tv8RP+TtdwOVsP3gAAAAASUVO
RK5CYII='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:25'!
smallRemoteOpenIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAPcAAAAAADRhqzpnsENwuE56v1R6tleCx12Iy36cyo9SGZ5fHZ5mJ6VsJK1s
JK1yK61yL612NrR/Mrx/MqyFH7CKIbyFMrqXJsOFNsOLNvjQeJmv1K/B3OjQiPjQgPjYiPvf
ifjYkPXfoPjgmPjomPjgoPzqr/josMDN5PXqxvjwyPP08P///wAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAP8ALAAAAAAQABAAAAiLAP8JHEiwoMGD
CBMq/HdAIYaHGA4gOGDhYIMVGCVqMFDCQsWBF0aMKFDghEkCKlJSoCCwQooUAQJsmDkAhc2V
AiWY2GkiAAINAj5MmEAwQggSSCE8WMqU6T8HIKI+EEG1KlUOD/4x8ODhAdevX7EKVJDhQYez
aM+KFZjgQYa3cN+uHbigrt27CxMGBAA7'! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme-contents' stamp: 'EstebanLorenzano 12/6/2014 15:05'!
glamorousOverIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAMAAAAoLQ9TAAAAQlBMVEX///9nfJVWibRPWV/S
unf845/YxIrZxY/85afq2Kf+9dv++u/86LP97MDt4L798M+zgBu+ji7FlzqreBmibRU6Q19f
4ZNEAAAAAXRSTlMAQObYZgAAAGJJREFUeNqdj1kOgCAMRFmsCCIWKPe/qmUx6J9xkibzuqSt
EL9kElYlc3MMe1WIy2BnW4d1ca0JZG4VzjSDJ47Z4fKROyIeHOyo1zN47yE/thNsQK97aLKS
Us1hli5Ff37sAmH9BCU7deY1AAAAAElFTkSuQmCC'! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:21'!
homeIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAACM+gCdBhNre6BM0fC5NjxI0fCE/fV17r9ne505upU9uo1Z1qld3qlh3
qlt6rlt6rVt6rF59sF58r2KCtWOCtdje5yJHeSBHednh69fe59be5+30/PL4/+bx++f0/+Xx
+8zX4Ov2//H5//j8/+Dw+yRTciVUct/y/uT0/ef2//X6/eL1/+v3/eb3/+b4//T8/y1kbClh
Zv7//zt/ZDZ6XTyFYD2GXzmEW2JmYWdtZWzBOmhtZW9za7reHWVmX+3rAvPzBWhoXJOTg66r
cpOPW66qc//7zpOSg396TWhmW//1v5SRgZSQgP/yv//qqv/srXJtXJiTgm5pWp2Te5mRfv/e
lv/fmJ6VgP/Pc6KVfP/PdP/Ug6WVeaSVeqGTeaaWe54/NaBCN59FOv///////wAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAGQALAAAAAAQABAAAAewgGSCg4SFhWJFgl+GhUNg
ZF1GXIyDYURZSlBNXpRkSFdPUhhSTlOUUVZBFWMVSVVUhktbPgJjtgI+W0yER1g4CGM3NTdj
CDhaQoM8Oxm2Nj82tho5PIQFIDJjNDM0YzIgA4UEYyojtmMjKmMEhQovGyIxMDEcGy8JhRMs
HyEmQCUhOrCgUCgCChIeLPS4kIIECgmFIKw40cKADgMuTqxwUOgBgwUHAAQAcGBBAwiCAgEA
Ow=='! !

!EclipseUIThemeIcons methodsFor: 'nautilus' stamp: 'EstebanLorenzano 5/10/2013 14:38'!
emptyPackageIcon
	^ icons
			at: #'emptyPackageIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self emptyPackageIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'nautilus' stamp: 'EstebanLorenzano 5/13/2013 17:14'!
protocolExtensionIcon
	^ icons
			at: #'protocolExtensionIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self protocolExtensionIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 10/4/2013 15:57'!
groupIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAALC91117rl99sF99r2OBs2OBsmeFtmeFtWuJuW+NvW+NvHORwGuKunOR
v3WTwbzF0uPr8t7o8N7o79fk7M/f6Mba487f573V37fR277V3rfR2p27tWmdi2eaiWygjmyg
jWmciqnNwG+kkHKpk3Opk3aulnmymXy1nHy2nHmymH64nbXMlb3Rl8bWmMfWmdDcm9nhneHm
nuDlnubpoLeTJLmWJbuYJtC7eq6HH7GLIbSPIreSJPzejfzejvzhmf3mqPzmqP3qt/zqt/7v
xv3uxf7y0v7z0v712qmBHKmAHauDHquEHq6HIP///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAE0ALAAAAAAQABAAAAeZgE2Cg4SFhoeIiYQhKioh
TTc2NjdNDw4OD4InMzMoTTZHRzZNDhAQDoImMTIpTTVGRTVNCxESDYIlMDAlTTtEQzRNChMT
CYIjLy8kTTpCQTpNDBYUCIIiLS4iTTlAPzlNBhUVB4IfLCweTTg+PkxNBBcZBYIgKyscTUs9
PEpNAxgaBAja0KHDBkhIklACECAAAEUQI0qcWCgQADs='! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/14/2013 14:52'!
migrate16IconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAJBSURBVHjaxFNLTBNRFD1v5s2n
ndLOYEdIC0U0IbYYwWATY0JC7ML4C0tBN7hw5dKNC/duWLjR+FkoidGFIXHBQle4MGKQiKL1
ExsjCgH6s9YZpu18nkUjATVx0YUnuS95ue+de/LOeYQxhkbAoUHQ1M2hf08hLud57FHFsW/J
gu/yXxVogjPaLPPPNZnO+jj7wsZDHuM9kYo9AUm5VLLKXX8QhERuuUWLnh3YubcnFU/2duix
c4rALWzWwd6fSqagB7R01iitk3BhCY/370i0nD88gmR7Gzo1EUN9fTjSnYz6BdEKiGLOLwi5
mKZ3JiIRjA6epJHglvSK8VMJOTg27F0dPkNEpxmLpY+49+o2Fr4uId6SgB6MYenbCgSOQvXL
KBg56EoQIUXHtalpp2CtnqC25xEQP5r4MHycAZ+oYldUAwGPorkInlXhugz5MoPtuniXncc2
tYx9MZ0+/LB0kUo8z6xakUx+mkHeLGK73got0ApFkJHJZ/HFMuoucGgPaZAoj4BEkcktY+rN
nGnY1aNUFbyJOzOTx9pUHtOfn2Kgqx8dzRGMz07hyXymQAgp1C0kTbKkjST7w5ZNcHcuba6Y
hrpVaXLIgRvHEZZp2iN8gpIKJMEHo8ZQs2svTIf1/nptgcOzQ/Hde+6/TZuL5aKqKyHnR5DW
lnzF6dYl+7QDfrBiW57j2uOrnji2yUSQ+MTrl6xUMdYvrxOsIVcl1+uRqRep78Tf8u5yrsce
VG3nSlBSnI098t8/U8ME3wUYAEK92uxZ9EygAAAAAElFTkSuQmCC'! !

!EclipseUIThemeIcons methodsFor: 'nautilus' stamp: 'EstebanLorenzano 5/13/2013 16:43'!
monticelloPackageIcon
	^ icons
			at: #'monticelloPackageIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self monticelloPackageIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme-contents' stamp: 'EstebanLorenzano 12/6/2014 15:05'!
glamorousRightIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAAP//0v//4P//5///6P//7v//7///8P//8v//9v//+f///P/8wf/7zP/1
mv/2uv/61//85v/wnP/wnf/0tv/1uf/63v/74f/wqP/ytP/ztf/1w/720P/41P/sof/uo//w
sf/zwf3zyv/2z//20P7sq//ur/3uuv/xvf7wvf3vvP7zzP70zf/1z//srf7uuv/vvLp/DbuB
EbN0ALFyAK9wALR2AbJ0AbZ2ArJ0AqZqArN1A7J2B7V4CLF1CLh6Ca1sAKRkAKJjAKFjAKNk
AaNlAaNmA69wBKlrBqVpBqdpB59gAaBiBJ9hBKJlCaJmC6RoDZ5cAP///////wAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAFIALAAAAAAQABAAAAd6gFKCg4SFhoeIhDEwiYU+
UTeNgzVRUTKGPDo4ODYzPwkIUTOEOwoHBQYEBAMWFRAHNINGARwiGyMsKyohKw8CPYI5DCAn
KMYvJi4pGgBHgkkLFBMZGRgfLSQlDkCESEVERENBUB4dF0KSSxIRSpJSTQ1M7lJPTvP3koEA
Ow=='! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:19'!
glamorousFolder
	^ self smallOpenIcon! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:49'!
glamorousSaveToUrl
	^ self icons
			at: #'glamorousSaveToUrl'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousSaveToUrlIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'nautilus' stamp: 'EstebanLorenzano 5/11/2013 13:11'!
traitIcon
	^ icons
			at: #'traitIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self traitIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'private - notused' stamp: 'EstebanLorenzano 5/10/2013 12:22'!
projectIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAJWBiJWBiYl7jXJxk19knWBknmBknWBlnWNnmV9lnVZfnlFco1JdokVV
qEVWqEpapYWRyDlPrTlQrD9UqihGsy5JsC9KsS9KsDVOrZK17JK27JK165K2653F8p3G8p7F
8p7G8qnW+anV+KnW+LHh/frpnvbflv/xwv/rs+zRi//lpP/aif/flv/Rdf/VfePBfdmycdCs
eNGtedCsef///////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAADUALAAA
AAAQABAAAAZ8wJpwSCwaj0iZUoYczmhQWuwYCABKJVPqBQN4vYGaAHIqm88niEA4QLnfcNRg
iFDZ73gVYqhgsRIGBQaDBAcEBoA1DyuMDCSPkJALNRMuLg4jIiEjIZ2bDUIYLREfHx4gHyAd
ICASQxUWGRkcGxobHLMXRRS8vb5NwMFGQQA7'! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:26'!
smallWarningIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAP7bc//egf/ij/7ijv/jl/7kl//mnv7lnv/uwf7CTP7DTf7DT/7IW//N
a/7Na//NbP7QdP/dmbltAIJNAF03AMSAJMSCLKqASa2DS6uBSquCSrGHTq6ETbCHT7WKUrKI
UcCVXL+UXMOYX8GWXsSZYMiib6+ETbOIUcOXX86uhd3Muf///wAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAACsALAAA
AAAQABAAAAZowJVwSCwaj0ihikRSJYcoBEL0XKlGkcjImQQhJBREKFnyICoThKeE/AAW6AXg
dPyUAgrLJBEo0YsbAQyDhAEdRRwDDw8OaA4NDQImRBgFEJdglxAEGEQZKQcHBqOkKRpFF6mq
q1WtrUEAOw=='! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:13'!
glamorousSave 
	^ self smallSaveIcon! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
emptyPackageIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAMAAAAoLQ9TAAAAYFBMVEWen39fXz9/f1+CgmKF
hWWIiGiMjG2RkXKlpYWyspK5uZnDw6PS0rKbmnqjooO+vZ3x7sL///8AAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKdzybAAAAEnRSTlP/////////////////
/////wDiv78SAAAAAWJLR0QfBQ0QvQAAAAlwSFlzAAAASAAAAEgARslrPgAAAGVJREFUGNN1
j1sOgDAIBAH7oi/1/pe1W4xRk+7HkEzKhtL5Cy0Fv4SmEQHURNpLUQGSiV6OmgXoJqhUiAEy
0TRnZaBNwTLCbGO+iOhjINpKeEqDCf+UehMOfQK4+7BtRIC0+MsnF+ymDJF0K83MAAAAAElF
TkSuQmCC'! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme-contents' stamp: 'EstebanLorenzano 12/6/2014 15:05'!
glamorousMoreIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQALMAAKnKl464dZG6eZ7CiKXGkarKmEtzEWuMO3OSRnSTR0ZvCmCDLGaINP//
/wAAAAAAACH5BAEAAA0ALAAAAAAQABAAAAQpsMlJq7046827z4EiSANDSEBSTIpiSAtzSEiS
TOHYlGeTrp+gcEjcRAAAOw=='! !

!EclipseUIThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 9/19/2013 13:04'!
changeAddIcon 
	^ self smallOkIcon! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:24'!
smallInspectItIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQALMAAKmyxouWqxcyXVVsh665xjJObuTo7NXz/+v6//z//////wAAAAAAAAAA
AAAAAAAAACH5BAEAAAoALAAAAAAQABAAAARLUMlJax0DWFv0qEAxBFJXUqH0ZVtahkUXwwU5
FQeCdGG+UwVEIlEoCYlAQ8JVULokNBtNs6laBQpsVqC1EAQECWFcxWq5Xat6LYkAADs='! !

!EclipseUIThemeIcons methodsFor: '*Komitter-UI' stamp: 'EstebanLorenzano 12/13/2013 14:41'!
komitterIcon
	^ icons
			at: #'komitterIcon'
			ifAbsentPut:[ Pharo3UIThemeIcons form16x16FromContents: self komitterIconContents ].! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:49'!
glamorousRemove
	^ self icons
			at: #'glamorousRemove'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousRemoveIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme-contents' stamp: 'EstebanLorenzano 12/6/2014 15:05'!
glamorousThroughIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAMQAADpDX2d8lVaJtE9ZX9bAfdK6d/zhlvzlp/znrf712/745/767/zos/3s
wP3wz/7z1/724f746bJ/GrB+GrOAG698Gq56Gap2GKx4Gat4GaJtFf///wAAAAAAAAAAAAAA
ACH5BAEAABsALAAAAAAQABAAAAVa4CaOZGmaFHWeEiKNaUxNNB0h00YtfM9DQKChopMRFAWL
8mGwnCgK1QZjwKwoCenlstI5pN1YI9bNGBhoQ6a70RgOBg1b5JabBIGAYGQX4fUDAAADK4GD
cyUhADs='! !

!EclipseUIThemeIcons methodsFor: 'private - notused' stamp: 'EstebanLorenzano 5/10/2013 12:23'!
smallHiararchyBrowserIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAMQAAG92hCaASDmHUkyTY0OSW1WbalWba1aYalueb1OXZ16gcVGVWlSWW2Kk
Y3GucHSwcWupZ2ypaHqoa6HGhv7977qXJsSlQ6+IIK6IIK+IIf///wAAAAAAAAAAAAAAAAAA
ACH5BAEAABoALAAAAAAQABAAAAVEoCaOZClaqKlWVKWaGXaNCKG8wGg8k1OogCAgAGlEAq/R
gCFZDJKjhOAAJeWqo6sGZUkKASwXbhSbjbEiLdcrDKPLmhAAOw=='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:25'!
smallPublishIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAL/F3UhgoExin1Fmm1hqmF5ulGV9sGRykXGEqmh1j292hHV8inmRu3WH
qH6VuYSYtam/4LDI5bHI5YSQn2V9lLnS6c7g8LjT6bnT6VyFpU6PvVSLs8Hd7sDd7cHd7dTn
8sbk8Nfs9U1aXfrpnvrvwPbflv/xwv/11P301//rs//xyuzRi//lpP/tv//aif/flv/Rdf/V
fePBfdmycffjy/vs4MnAwP///////wAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAADgALAAA
AAAQABAAAAaIQJwQN1kYh0jk5Faj0RZJoXEyIpVWsplxYeviBhAUykQuk08agDCRarvfqs3w
wKrb7y25sPB6Ff6ABQ0PGw8NOAQuigQgjY4hGyEIXzExAx4dHZgcHh8bDkICMAIXpRcYFakW
ejgBARGwsRKwDBlIrri5BjgUUb5CCr9JCsTEwkMiCiLHSMs4QQA7'! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/14/2013 16:32'!
protocolPublicIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQALMAABCGTTSYaEShdH29n5HIrh6JUnGxdYm4gf///////wAAAAAAAAAAAAAA
AAAAAAAAACH5BAEAAAkALAAAAAAQABAAAAQpMMlJq704680xEQKxEcFxBGIWGAhiBBpwtAeg
DXI9bEMB7J2gcEjURAAAOw=='! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
recentMessagesIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAK291u7z+0tuok9xpVR2qXuWwO/0+4qdtPn7/QU0YM/t++z4/fL8//b9
//nONNbQvJuFSox9ULGPPrORQKqLQfKqC7SQPeiNB6VkFaVlFaRhF4xZJ6BVGptLH5tKH5pH
IP///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAACAALAAA
AAAQABAAAAZeQBCIICwaj0OkUkg0fjocDebYFAg3l4ojQxUWrB9PlGsEEAaC9ETBtiy/oLXB
IFla45Q8ZVmEKOYQfEIPCwgBEUgHCUWKBw+ISItCCQySSpYJDZaRRZmbR4uLjYKkQQA7'! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:23'!
smallHelpIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAMQAAP7+//Hy9fLz9czU3tvk7v3+/yhilkR2pF2JsV+KsWqSt2yUuHmdvpWy
zKK701CAqvX7//r9/+jw9fT7//f8/+3y9fb8/+zy9fn9//z+//X8//j9//f9//v+//b9////
/yH5BAEAAB8ALAAAAAAQABAAAAWA4CeOZGk+j2Ggppg2hBAQzVo+cMHtHEA/JAOhQDiohETD
CJfhJAyLmoGTaQA/D0Kk42DsUpwO4Wq4YDCRHcKAiEQqyk95Q+esFRj6JZ6lUHYqO38DVzh+
fw4OFh4WFFYjQhoaHCoaFhoEcS4wEDwQEz83BjASEjQ2LSgqLC2tJSEAOw=='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:25'!
smallPushpinIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAMAAAAoLQ9TAAADAFBMVEWIla4XMl2RmqmQmqgw
dLpEdqpGd6tGeKs+hcQ+hMNdm86qyuSryuTF3/RdnM6EtNqEtdrN5PZanMxvtuKz2PBYtuhz
xOyZ1PG64fa94vXZ7vny+//r+f/u+v/x+//1/P/4/f/r+v/u+//v+//x/P/y/P/1/f/4/v/3
/v+doaCdoqAAcjYAYS4AUicAlT41m1hytkl9tVGjyoGfp26qqperqZe3sY6/toj///8AAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABs
3AP9AAAAB3RJTUUH1gUREQgiKKvoswAAAJNJREFUeJx9z9kOgjAQheGi4F73XQsULVUr7UgV
fP8nsxljgsT451x9F5MMedYif0Gb/BsU3PIqaFBgHAQtvzMc9a2yFq7awXS2WK42W2XAKjwa
tP1ubzyAzGQlQkkxDzL7Ab7n3OOuNxQ0YUnC5owdCoQ73YljKMK1EA+EC02jNHKbRGeEJpUn
GcvYrYFAKv349gU7qSnr237mhQAAAABJRU5ErkJggg=='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:24'!
smallObjectsIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAMsuOdleZt5vd+SCiT1spgpEhBlSkCdemhBLiB5XkZq41GOph3i3mCSA
TzCJWwpsNxRwPFibXVibXGqranCkZ6uEGqeBGqeAGp50Fpx0FphtFJNoFJhtFf7SfZNnE/6/
U////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAACAALAAA
AAAQABAAAAZ1QJBwSCwKAcjkkOFwMIaAgXQAEDIaFErjCQIIvoIqqDEpSxrHgDogfkTekccR
HBYuHtnH4phEDhcQekaDhIWDCgpGFRVGBgZFFx0dFkQKCAiJQhkfnB8YQwgHBwhDm52fIAoJ
BAQJmSAckhpDBbW2RB4bhoVBADs='! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:49'!
glamorousRefresh
	^ self icons
			at: #'glamorousRefresh'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousRefreshIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'nautilus' stamp: 'EstebanLorenzano 5/10/2013 17:06'!
classIcon
	^ icons
			at: #'classIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self classIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'nautilus' stamp: 'EstebanLorenzano 10/4/2013 15:55'!
groupIcon
	^ icons
			at: #'groupIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self groupIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:23'!
smallFindIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAALClrLu1ubOpsKqdp6eapKufqMTAw7attLSrsrGnr62jq8C7v765vaeb
pb22vLmyuMbCxsnGycfEx8G+wcrIysTBxUltof//yf///v70jergpPvws+nWc/npqvrpqvrp
q/raffffnvXVkfTVkvXUkd+9f+SiOemvV+uyXa2OX7mYZqeIXKuNX/ClO7KQYqiIXJ59Vp19
VpFvTo9uTZBvTpNyUJNyUf///////wAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAADgALAAA
AAAQABAAAAZ4QJxwSCwajS2aS1U6DlunzcagcuKgG4sn5HJiLZ2QiHbEbj6hEapVTKVYr3OI
tG5TIhVGLF0npigUEAsPAjV9Q24pEhMBCAoybEUmGRcrDgcAAzNGkxcYNzAJBQSbRJ0YqBc2
DaVEHJ6pGTStRBqfGBcZILRWvThBADs='! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:49'!
glamorousLeftSide
	^ self icons
			at: #'glamorousLeftSide'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousLeftSideIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:26'!
smallUpdateIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAABVlg1dmQ1dmB9nnSBonR9onTR0okqBplyMql2NqnOas1yNqmmUrXig
tI+xwH6mtn6mtYStt53Cw53Cwp7CwqzSxqzTxbjhybjhyLnhyMHryv797/vwtPnolPvpnvnd
evHag7eUJPHTc/vehfnNX72EFrB2Erh+FLN6E7uBFbqBFbd+FbuBFqluEKhuEKxxEahuEbB1
Eq91EqxxEqtxEq91E////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAADYALAAA
AAAQABAAAAZtQJtQWCoNj0jixpg8slKpzUbVFJ5AnCyns2qGRJ5w+INq1kYkmQkdq85ILxuN
NKvaXDAhrCVkMPp2Ngwaf4N/TQkZGAgLGRcITQcRFpQVFREHTQYQExQSEg8GdgQNDgMFBYE2
AgoBqkMAAK92QQA7'! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:24'!
smallInfoIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAMQaAPb9/wJGjA5ipFWQv7bQ5MfU0PT7/5a2xff8//j9//r9//f9//z+//X8
//3+//n9/+zy9fb8/whUmPv+/wxcn/Lz9e3y9f7+/wtdn/Hy9f///wAAAAAAAAAAAAAAAAAA
ACH5BAEAABoALAAAAAAQABAAAAWIoCaOZFkWgxAEwlCY2hEMRJURQ3CUh0A4AIEAcCEIdqJC
4AcIDgEOQuClGQwYTQC2yWBYRT5FU/icTIyiAOTxEAubCoUlkIYk7gAKBvC4Q+gaPggICwAS
EgsLhGhVA4MIACsNABEIXxpKBA0NKysRDVJUMT4GpaZGSCMyNKU4OjAoKiwuMLUlIQA7'! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:15'!
glamorousTrash
	^ self smallDeleteIcon! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/15/2013 21:09'!
widgetIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAB+UlEQVQ4jaWTy2oUURRF17m3
qvqRdHce3ZqHMYLgRIJm4sCR0whx6CQ+JhkK+iuSoYJgvkDwA/wDcZpojGny7rTRdKU6Vffh
oE3FJqAB9+ge2HuzDocL/ykBWH754ZVSsqgDdaGQMc5j/dKjF/eeBwBKyeLY1WFvTSYiCq31
b2MGIgQ6AMBai/cOrQO2Ng6fAb0C5w1ZLOJciLGGpNtGqYgoLCIipOkRxmcMFIfQKsRpEcQJ
QM5srGNuYYb5x7PEnZSTJOPB01nmn9zm+Dgl6WTcf3iLuYUZTGbzdRRAGEYkSYf4uwMBZx3l
apibyoMhWWpQBfjZMiQnMVpp+ggQy/rqDgD18SqNsSrd2IKDxniNkUsVAL6ubAMmjwWnD68c
3z7vcfPOBFeuNajUyuxutimUIsYmh4kKPWtzrQXanx7wjKBeHyE+SsDD5HSDyxPDbDUP2G62
GJ+qMzndAANJnDA6OnKeoFdnaa4eMnVjCIDdzTbFUsTs3etUagXWV9qIdv2RPwfRno21vXw+
2Dtif/tH7mx+2cfLXwrKgxGtnc4ZXhDg/ZmlvR9TqZX7CvpWKBXLuDTl/dtPOGcpDUSIwLs3
H9FaoUMoRIXzBcY4771HRGSgGuVwFYboV4/GOe+ddS4v6HaT11sbflHri30ma5xP0+7Shcz/
0i8hyMm9wAyCcQAAAABJRU5ErkJggg=='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:23'!
smallDebugIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAALGusR1ieR1jeR1jeB9leR9keCBleSJmeiFneSRoeidqeydreiptfCpt
eytufCxvey1wfDhWUzFOSiA5Mi1ORThWTjFWSihBOTFORShIPShFOS1IPSM+MiNBMi1OPS5q
Ijp8K1ONPJLBf3OnWJbDeZXCeZ/HgabJh67Oka/OkbXSmdvrzLbSmbjSnLjSncbcrtXnwtvq
zOfz28fcr8bbrsfbr8vftNXmwsfbrv///wAAAAAAAAAAAAAAAAAAAAAAACH5BAEAADkALAAA
AAAQABAAAAZ5wJxQWBkaj0PJMII0AjYAIaZpkVAyEAhAE23mABBZLQvJTS5Nx+yzur0eAIDH
IowwAY2YbGVzMbpGGBoKMCsiNCwnC00cCS82OCMpJgkTHkdcCC0qKCEkB1FKQxQABAYnJiUg
BUh0QhMBAwIBXkMdcbVGGblGrry/QQA7'! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:25'!
smallPrintItIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAAEOTXkiUXzKESUOUW0mRXbPSvC2ERD+VVoe9laXPsE2XX3S0g4C4jqPO
rb7axcbcy8bay9fk2jyTTkOXVUGSUk2WXWCncFaSY3Kwf4G4jXOxf0GNTk6YWlKYXjyNSEqT
VFGaW12kaNnm2y98OE2XVlukYyp9MjWEPUWNTFSgXMDVwi9/NT6PRESQSTp3PrbSuDeMOzZ2
OkiYTDqIPUSTRmykbbDOsbjTua3Lra3KrbfQt/X49bjSt12dWFSPT1qSVHS2bHGmZ0qIO2yj
X2+kYGyjWcvcxXKmXmWjSIa0boe0bpa6gZK5eLrYpoG0WJ3VYIXOLp7VX5i/ba7ecq7cdvv/
9vn+8P7/+Pj46P797/jwsPjomPDYgPjgiPDgqPjQYPjYePjYgLCDGbB8FKFuD5poD6l1FP//
/////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAGgALAAAAAAQABAAAAergGhoBUA0BBUZDoKLiwgk
UFNSS0EdCYyCEB9KTVZRTkxJHBGXFj1HKmdVT0hEQxqXGz8+OmdnV1RFNQqXAi4xObVnRkIX
AJcGKyY4tTcnIyADlxgeLTZnLygsDxQMlyISMjw3MzAPYg/mYowNEyElKeZZYjtiWOqLDwsH
AeZYWmL1vNy7hEZMFy0IEXIZQ1CQGTBbIm4BY6ahIDIYw3whY5FRmS9lOnoMKSgQADs='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:22'!
smallCancelIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAMczNfRxdPRzdPNydPNzddgqL+AsNN8sM8cpMOY2PuU2PsUgK+UwOfJV
YPRja/NjavNja/Nka8UYJ8YZKMUZJ8YgLPJUYMUTJfE/UvA/UfJIWPFIWNRldN+cqMpdSc5u
XspXRspYRslYRtWIfMlQQ9ymoMlHPslHP8hHP8c9OeBhW/WBfcc9OuNST/WAfvSAfuPExP//
/wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAADEALAAA
AAAQABAAAAZ8wJhwSCwaj0eYZ1QceWBEWKgVYgpHohYIKiyRXCvSp/QhvcIl4ghFEKhMqkHg
ZCVyWBHIw/FIcZAACg0NFgkASDEIDBsaGgwISBwVGJSUC39FHBOUBRIFGBkUmEIdF6AXHB0c
phkXHUMwFwaoQ6sHF1xCsaNCq7mIwMExQQA7'! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme-contents' stamp: 'YuriyTymchuk 2/16/2015 09:45'!
glamorousZoomInIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAAO3r8Ovo8cfF0/X19yw9ry09rC4+rSk9rSs/ryw+rCs9qSw+qrCxtfT1
+ejp7aq51vT19/P09qm61qm50+Xo7am61Km706i81aa60+Hp666ys+To6ePp6fT29ers6dze
2d/i2e3v4oiJe+nq3IeHfcHBtaenn+Tk2vj49rm2k4qIeYmHeKupmuHf0O3r3ImHe4qIfNXS
wdfUw7+9sOro2+jm2ru1lYuIeYqHeMC9ruDdzvDt3uzp2uvo2XNybXFwa6OXZaKWZruyi3Jx
bff28qSWZ6WXaL2xi4uHe4qGeoqGe6yonYmGfYiFfMC8sMO/tN7azt/b0O7q3+Pf1KSJRIVY
MYJWMYZUL6qlofr28/b29vX19f///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAFwALAAAAAAQABAAAAeMgFyCg4SFhilAVEBChoMx
RjM9OyNORTKNQTREKBhZDTxAhkdOA1sTCxJaHTk2hU0nEBISCQ8PETUwhSIhFQoIBwsEFlI4
hS9TABUPBhgSHi1MhSxPHBwXBRUOGwxLhkofGQEWHBQ6N40CKyVQIFEaJC5JjVxYSC84Jlwq
Vj7zhkNXfvgrNKTKwIMIAwEAOw=='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:23'!
smallDeleteIconContents
	"Private - Method generated"
	^ 'R0lGODlhDgAQAOYAANDY6GiYyGiQuHCYwEiAsFCIuGCQuGiYwHCgyAhYmChwqDh4qECAsEiI
uJC42LDQ6BBgmDB4qDiAsFCIsFiQuGiYuHioyAhgmEiIsBhomDiAqGCYuIiwyJC40JjA2Hio
wICwyJi4yChwkCBwkIiwwKDI2BhwkDB4kHiouCh4kJi4wDiAkJjAyKDI0LDY4Dh4gECIkDiI
kEiQkJjAwKDIyKjIyLjY2MDY2EiQiICooKDAuLDIwMDY0IiwoJi4qKjIuLDQwLjQwMDYyJCw
mKjIsLDQuLjYwKjAqMjgyLDIqLjQsMDYuMjgwMjguMDQsNDgwNDguNDgsNjosP///wAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAFMALAAAAAAOABAAAAergFOCggSFBIODAAMGBQwR
CgoLBAYAggcPLjdIT1BIPDYPB4IADQ0UAhUbFBgSDZWCMTk9MT4+MT05MYg4SU44UVI4R0Mv
u0RKOFBROEpEMogwP0UwnDBFRDCIKzo7K0xNKzs6K4gnKjUnQksnNDMniCIkLSk8RiIhLCmI
Jh8lIzZBRnDoMAJRhgMeMtgAksGCgwyINBBAAAEEigsTAmhANEVDgo8gN3IcyTEQADs='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:23'!
smallHierarchyBrowserIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAMQAAG92hCaASDmHUkyTY0OSW1WbalWba1aYalueb1OXZ16gcVGVWlSWW2Kk
Y3GucHSwcWupZ2ypaHqoa6HGhv///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
ACH5BAEAABQALAAAAAAQABAAAAVFICVSCKGMaGo8k1OkcAA1UQCnAyMtw50mgoMPBhiVTr4i
ZdV63QBQGc32FOV2vaoIKEwOiUbTUMl0JaOzmpdy5a0pXFQIADs='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:25'!
smallPasteIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAAPb3+vP1+oeUroeUrfL1+/j5+152o22ErV9zlmBzlnGCoIeVrt/o+OLq
+O/z+u7y+YGXvICUtIGUtJGlx4KRqoeVrZenwJinwI6bsI2Yqq+6zN7o+Obt+PP2+4yYqq66
zN7o9+Hq+OLr+Orw+d/p9+Lr9+Xt+PP2+pKbpt7p95KcpvL2+qvB1PX4+pqfoZmgoaGknKio
l6+tkru0irawjrCskuDIj9q9fPLGcfHGcfLJefHIefLMg/LNg/LQjvLRjvTVmfPVmvTZpfTd
sPXhuvXkwvHFcfLIefPMg/PQjvTUmfPUmvXYpfTYpfXdsPbhuvbjwvbkwvbmyNiubMyoddCs
eNSwe86secWaYcOaZM6pdseicsqldNOuesGbbMSeb76Ya62BUq+EVrGJXLONY7yWarWQZ+TW
xtTBr////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAGkALAAAAAAQABAAAAe6gGmCg4SFhmkYLCwYh4QU
Hx8aHxSHZ1hYChcWFhcKYVhnhFZSCRISEaYSCFJXolKvsLFUhF1RUEVRM7q7WYRVRERPRDMF
xQU3NIRaQ07MNC0TBgA2yINcTE1CQjUdBCsnJwEyg1tBS0BKMQ4TEAcGDzGDXz8+SUkwI/n6
MINePD1IkLzgwM6dCReDwOzQcUSHihAlGogI0QDFoDJTjODI4WEDCQYpUoDIMAiNGTJjxAhY
UGHAgJYD0gQCADs='! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:11'!
glamorousBrowse 
	^ self glamorousEdit! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
recoverLostChangesIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAJJ+itPL0MfG1MPE1VxlnVxlnLi92k1boz5Tqj9UqjFLrzFMr7K73WZy
jAsaOGx8mZC27AY3d9Pi9xpJgxpJgiJQh4GPoGKk7bC+zmeq75zG8m2y8sPf+XK59Ha+9qnW
+LHh/eDz/uf3//H5/eP2/+f4/+76//T8//zTrfu5f/jAmPvXvfmbePvDs////wAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAC4ALAAA
AAAQABAAAAZtQJdwSCwaAUjjUZVqBZRCpMfDQQICz2IixAWsUCwAQymQdjaZi7U4SIDe8Hei
WJAQPo28Pk88GA4aDSSDhA1GCBANIg4lD4yGRQsKDSYWIxgWJpAVExERQg0noqOQLpyfLnt7
RBUUUEoVr7JQQQA7'! !

!EclipseUIThemeIcons methodsFor: 'nautilus' stamp: 'EstebanLorenzano 5/14/2013 16:27'!
testNotRunIcon 
	^ icons
			at: #'testNotRunIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self testNotRunIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:24'!
smallLeftFlushIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAJEAADk7iUNKh////wAAACH5BAEAAAIALAAAAAAQABAAAAIelI+py53gngi0
MhgPrNzq/HXBBRqb6JmlcHLkCoMFADs='! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme-contents' stamp: 'EstebanLorenzano 3/30/2015 13:32'!
glamorousTableIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAAKiwwF9vjGBwjGp5lHB/mbjB0b3F1FtsiV1ui11uil9wjGBxjWN0kGN0
j2d3kmt7lW9/mW9/mHOCm3SDnHeGnnuKon6NpbjB0LzF1MfP3Gd4kml6lGt8lneHn3aGnnuK
oX2Mo4GQpoOSqIiWq7jC0bfB0LbAz73G1MLL2MbP3G+AmH6OpIeXrIOSp4uarqSwwKaywq24
x7rE0rjC0LzG1MHL2L/J1r7I1bzG08jR3cfQ3MbP28XO2qm1xLC8y7XAzrfC0MPO28LM2MbQ
3MHM2MbQ25CgsP///////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAEgALAAAAAAQABAAAAeegEiCg4SFhoeFBwcIAg0O
DxASHRUrISKCRkNDQQA3Mj8+MT0wL5dIigkLDRocERMUHxaWgi5Htjm2ubkugiw6OjtDGSlF
QzoZOkMjgi25PLq6LYIgKEQoKDUoQtfZNSCCHrk20LkUggQ0NAYnNDgYGCcGNBgqggO5MuS2
G4IMQCVAgFyYUWLGhQIkgDQQFCCXCX1HFAhSRLGiRUQYAwEAOw=='! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
jmeth_objIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAAGiUxXSdyYKn0Ims04uu1Nfj8d7o8+Ts9UV9tE2DuEt/s06DuE2AtFGG
u06BtVKGulOHu1OGuV2Ov2CRwl+PwGKSw2GRwmSTw2aUxGaUw26byG6ax3ahzHukzn6mzn2l
zYKoz4is0pGz1pO015a215e215q52qjB26nC26vE3bHI4LzR5tzm8OXt9U6CtE+DtVKIulWK
vFWJu1aKvFeLu1uOvl2PvmKUw1+QvmGSwKrD27DI37LK4N/p8qbE3sfa6v///////wAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAEEALAAAAAAQABAAAAefgEGCg4SFhj8DFRMWAz+G
giQTGgKUGhMkhiQ0ICY+niYgNJiDBQ0dLR2pqS0eDQWDAxsrQAcctgdAKwEigxc1KkBAPRQ9
wTs2F4MQDCdADixALA5AJwoPvTAoQC8vLNzULsmCIjMpQBHo6EA6MiWDBgg5PTn09Dw3CK+D
IwkAH///cMQYYWjEAgwZEmJYQPDRjxASYEgg4OiRxYsYgwQCADs='! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme-contents' stamp: 'EstebanLorenzano 12/6/2014 15:05'!
glamorousDownIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAP776P366P753v343/310/766fztuf3xxv3xx/zxx/300/vfivzik/vi
k/vilPzln/zmn/vln/vmn/zpq/zprP700/vdg/zfivvhk/zilL2EFrl/FLh+FLd8FLR6E7J4
E7F3E7F4E7uBFbqBFbZ9FLR6FLyCFqhuEKxzEatwEa91Eq1yEqtwErJ3E691E6dsEKZrEP//
/wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAADEALAAA
AAAQABAAAAZpwJhwSCwaY5qk5kjUAACBwpIZMz2jJmpMNBgIBiPthqAgVDhaUuKAQHS0HoPc
UDqCPq0PZcIPgfJELhGDDw8QDxIPESpFKAwZGBkODQ0ZK0cpC5oXCxcsVCcWohYnWjEvoi+m
QjAwq6ZBADs='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:25'!
smallRedoIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAPz62f385vz52f797/375v352f775vvws/vwtPvxtPvpnvvpn/vjke7Y
i/vllvvll/vontzKi/von+rftPvehfvfifvgifvhjfvijc24dfvjkt7VudS2X8KpZtK/htfH
mLaWSceubcOrcs68k7yDFb2EFryDFrB2Erd9FLN5E7J4E7uBFbV8FLyCFrl/FbmAFbuCFrqB
FqxxEapvEapwEaluEahuEa90Eq50Eq1xEqxyErB2E6dsEP///wAAAAAAACH5BAEAAD0ALAAA
AAAQABAAAAaBwJ5wSCwKPaWNcVmadIil0rI1MBFJVWNsMFkNV4MBrCiaBCIvV+ZlMBBeRFFE
UAA0GoWCYI8afkIICAcJB4IJgQgsQykNEgsQkAsLCo4QKkIfJw6bmw+eDg87RB84HAynDBoa
DDdLIyA6MhcXGDlLRDQWFTO3RDYUNb1EPDzCxj1BADs='! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:49'!
glamorousRestart
	^ self icons
			at: #'glamorousRestart'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousRestartIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 14:54'!
glamorousCancel
	^ self smallCancelIcon! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:21'!
backIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAP797/375v332f765vzyyv732f732v322f322vzpqPztuf3yyf3yyv72
2fvgjPzkmfvkmfzoqPzoqf3tufvdg/zgjPzjmb2EFq51Erd9FLd+FLV7FLV8FLyCFrmAFbuC
FqtwEatxEaluEa90Eq1yEqdsEKZrEP///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAACcALAAA
AAAQABAAAAZkwJNwSCwaj0jh5ZIkdgCdpvADAHyknkFg4Ol6PcSMACEoCAwHRKHR0Ag5DMZi
IY8T6IyNcDRRKPp9fhODGEMkEhEJiBGMEo4kRCEWEA8gIZYhmUYiDhUiUkIlFCWgQiYmpaml
QQA7'! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
protocolProtected2IconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQALMAAL6cKLuYJ7uZJ66HH7ONIrKNIqd+HKqBHaqCHq6HIP7elv7PbP//////
/wAAAAAAACH5BAEAAA0ALAAAAAAQABAAAAQksMlJq70468016A2gfFugMIqgFQvjLoSWtMvA
HQsCGmDv/5kIADs='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:22'!
smallBackIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAP797/375v332f765vzyyv732f732v322f322vzpqPztuf3yyf3yyv72
2fvgjPzkmfvkmfzoqPzoqf3tufvdg/zgjPzjmb2EFq51Erd9FLd+FLV7FLV8FLyCFrmAFbuC
FqtwEatxEaluEa90Eq1yEqdsEKZrEP///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAACcALAAA
AAAQABAAAAZkwJNwSCwaj0jh5ZIkdgCdpvADAHyknkFg4Ol6PcSMACEoCAwHRKHR0Ag5DMZi
IY8T6IyNcDRRKPp9fhODGEMkEhEJiBGMEo4kRCEWEA8gIZYhmUYiDhUiUkIlFCWgQiYmpaml
QQA7'! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:21'!
confirmIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAMQaAPb9/wJGjA5ipFWQv7bQ5MfU0PT7/5a2xff8//j9//r9//f9//z+//X8
//3+//n9/+zy9fb8/whUmPv+/wxcn/Lz9e3y9f7+/wtdn/Hy9f///wAAAAAAAAAAAAAAAAAA
ACH5BAEAABoALAAAAAAQABAAAAWIoCaOZFkWgxAEwlCY2hEMRJURQ3CUh0A4AIEAcCEIdqJC
4AcIDgEOQuClGQwYTQC2yWBYRT5FU/icTIyiAOTxEAubCoUlkIYk7gAKBvC4Q+gaPggICwAS
EgsLhGhVA4MIACsNABEIXxpKBA0NKysRDVJUMT4GpaZGSCMyNKU4OjAoKiwuMLUlIQA7'! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
changeSorterIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQALMAAI5GlKZ5qm92hGV9lFyFpU6PvVSLs01aXRuGe0WTiHipov///wAAAAAA
AAAAAAAAACH5BAEAAAsALAAAAAAQABAAAARGcMlJq10KoaRumUi3XYY1WiWWbGeVrlJLvQgm
T6mysgl6/YQLYEiUDISARWAoEVwCSqZgOrUsoZKD4GBlKrNISQD7Gy6HEQA7'! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:22'!
paintIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAPcAAMBSU8FTVLFRU+N8fdWPkdWTl6NiaLpjbMGOldzV3P/+/+Lg5fv6//n4
/fj3/1FRU/z8/vr6/G5zkPr7//n6/vj5/Wl0lO3x/NTX4Gp1kfDz+mZ1kmh3lGd2k2h2k2h2
kcnU6vr7/W97kWx3i1BuoFRwn1VwnWd3kWh4km96jOXt+vf6/1KG0VFxoFV0omx5jFF2qn+n
25CYo1mQ01OAt16Qy1F8r5O55rfU9qS1yXR+itjl9fP4/vD1+1GHw1qSz1qQzFWIwV2RylSC
toy1477FzViTz1OIvluTzG12f8XV5eny++Xu91GFtLbG1XR+h3ORqVxufJequHZ/hoKLkubv
9vf7/lySuLbEzdDt/c/s/HeAhdLs+c3u/c7u/c/s+tDt+2h1e3B9g3uIjrzc6c7u+9Ds+M/t
+M3t+MPLzc/X2fr+/3iChOj2+X2IiuH6/oCKi36EhP7///H9+19lYWRqZn+FgXqAfJacmLK5
soSHfpicjoOGe4qLeYqLe3p5ZY+OeZGPdpWSc6SdZ6WeapuWcJqUcJeScqabZaidZ6ecZqac
Z6acaaCXbKeaZaibZqebZ6icaKebaaWabKSZa9mqWL6kg3txZf/69ItwU5iPhv/+/WxeU7i0
sbOEaNjT0NJqUeCNf/y/urd8eM1VVMBSUdt5eJBTUpNWVbywsP///////wAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAKsALAAAAAAQABAAAAj4AFcJHEiwoEBC
kCAtGpTIUSRGkh5JUoRIIKUyYMyU0VKGy5kuXr5omSSwERojNZD8EELCRIkWLlQ0EmgIDAgl
ey7hgGGDRpMhTAoJPATmTRROlj7FYHHER5AqggQG+oIp04M/oA5AuTIDyBJAAvt8IVXJU6g5
nTRJIXLjgh+BesAgwHMK1Q45bYo4yaGBj8A4WWSQMSBglBwMY6gk6WFH4JYscLAQAFBK1Bo2
YcTwmCLwiRYFC/IUCDBAgRo6bhzoEJhCC4RNCVKZSqNKVZ07FEQIfPHFSgUGKyhMiFChQQgr
IwRKONGhwwkUFjJ04PDBw4cNBrMTDAgAOw=='! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme-contents' stamp: 'EstebanLorenzano 12/6/2014 15:48'!
glamorousAlarmIconContents
	"Private - Method generated"
	^ 'R0lGODlhFAAUAOYAAIigxA9RhBBShRBThRJThS9qljVvmjpwmj52n0d6oUh6oVWHrF6KrG+Y
uHWbuHSat42sxLrN29/o70F5oUR6oUZ7oGqYuHiiwHijwHumw32nxICpxYSqxYisxImsxIqt
xYutxdfl74CqxYOrxYesxJ6/07TM28zi8Ofy+TRvj6vK28zi79Xq9tbq9tXp9djs99bq9dvv
+uL0/uP0/ufy+KbG16XF1qjI2dfs99Xq9d7y/OL1/9/y/OL0/eP0/d7s89/s8+/5/u33/Oz2
++Tu867N3LHP3dvw+t/z/OL1/ur1+rTR3d7z/Nvw+eL1/ef4/97z++b4/+34/Ob5//X7/fT6
/LbU3fT7/ev7//X9//H7/fL7/fn+/+r8/+v8//f+/+7//+////L///X//////wAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAGQALAAAAAAUABQAAAf1gGSCg4SFhoeIiWQRDwcE
BAcPEYoSDgogRFVVRB8VDhKHEgweVGOmplxXHQyghQ4AX2KyKbKyXyQOhREJW2EjYWEEVsBg
I1oUk4MPHFleWF1eBEtYz15eIw+EB0BP3U9TBEZPUeNRQAaEBENJPj09TgRFMk5OMjNDAuko
OSM5LDAEbLRoAcPFCBoBtIU4wfDEihIEVjRcEaIAoQcXcGh8obEGAY0aMWQbFAGBkiZHRhxp
EuNGihgxlChINqhBhiBQmOhAwgOJCh5BIOQqJGGBBiFJkozYkVQIBFahLEwQ8UOKlB8bFHxS
ZMKCgQEDDEhSRLas2UAAOw=='! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme-contents' stamp: 'EstebanLorenzano 12/6/2014 16:30'!
glamorousPlayIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAAA1jQg9mQxBmQxJoRBJoRRNoRhRpRhxxThNoRBZrRxhsRxlsSCF2USJ3
UhxwShxtSB5ySyF1TyJ3USR6UyN2UCJ0TyR5Uyh9Vil9Vit/WSx/WS1/WSZ7Uyd6UyZ3UTCC
WlSqcVWrcVSpcVWqcUmmZUqnZkmlZVqvdFqvdVirckqnZE6raF6zd0yoZU+pZmO3eVGuZ2Wy
YWSxYWi1Y4jAhGi2YYjAgoa+gYe/govBhWy5Yo7EhY/Eh5TJiXS7YXa8YZfIiHm/YXi+YZjI
iJ7Ni5rJiZ7MjKPQjojHYozIYazRj67SkLHUkbTWkcLdl8Dblv///wAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAFAALAAAAAAQABAAAAdtgFCCg4SFhoeIiYUfGxmK
gxpOTxMYjxdMSktNEh2JFkRDQEVGRwwchw07Njc4NDk8PRUehREnISIiICMpKCwvFIQHKyUm
JCotLjAOEIULMzIyMTU6Cg+HBkI+P0EFCYkDSUgABI8IAgGP6eqHgQA7'! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:14'!
glamorousSearch
	^ self smallFindIcon! !

!EclipseUIThemeIcons methodsFor: 'nautilus' stamp: 'EstebanLorenzano 5/10/2013 14:38'!
packageIcon
	^ icons
			at: #'packageIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self packageIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme-contents' stamp: 'EstebanLorenzano 12/6/2014 15:05'!
glamorousRemoveIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQALMAADV2VEGIX0KHYFOfb1OfcF+we6XDWaXCWabCWabDWqXCWqbCWuDlZv//
/////wAAACH5BAEAAA4ALAAAAAAQABAAAAQl0MlJq7046807LmAoFhXBnCg6VEJiLAqMHEhQ
AXiuA17v/0BgBAA7'! !

!EclipseUIThemeIcons methodsFor: 'private - notused' stamp: 'EstebanLorenzano 5/10/2013 12:25'!
smallProjectIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAJWBiJWBiYl7jXJxk19knWBknmBknWBlnWNnmV9lnVZfnlFco1JdokVV
qEVWqEpapYWRyDlPrTlQrD9UqihGsy5JsC9KsS9KsDVOrZK17JK27JK165K2653F8p3G8p7F
8p7G8qnW+anV+KnW+LHh/frpnvbflv/xwv/rs+zRi//lpP/aif/flv/Rdf/VfePBfdmycdCs
eNGtedCsef///////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAADUALAAA
AAAQABAAAAZ8wJpwSCwaj0iZUoYczmhQWuwYCABKJVPqBQN4vYGaAHIqm88niEA4QLnfcNRg
iFDZ73gVYqhgsRIGBQaDBAcEBoA1DyuMDCSPkJALNRMuLg4jIiEjIZ2bDUIYLREfHx4gHyAd
ICASQxUWGRkcGxobHLMXRRS8vb5NwMFGQQA7'! !

!EclipseUIThemeIcons methodsFor: 'nautilus' stamp: 'EstebanLorenzano 5/14/2013 16:27'!
testYellowIcon 
	^ icons
			at: #'testYellowIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self testYellowIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:24'!
smallLanguageIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOZfAP79772EFqa72PzuuI6o0ODp66ZrEP30zpiw0yRonFeDqsjW47mcZfzp
pJiw1Pvll9bh57fJ3v364kF4pC1tnv354ihqnurr2nqVrfvopP354a6QYqhtEbJ3E9nZwrV8
FOTr6rC7p+Hn4MLPya+hc7vBnu3nxdjd1lOBqc7Y3mGPu2iMqJWzyrqymIWpxSdqna6Ycdbh
6EmAs/30zS5tns62gdHQuMy0gLbJ3rfI3qhtEN3AgnSSrChqna50E5yeopCwyZqKWufgtcvS
zb2me8avftGpVOTr66rBzKtwEanB0cjV47mcY1yFpdvj5enu6FyGpTNwoEh7pqCzp6a5srOe
eLl/Ff764buBFuLize/y5sfSxr6+qr/M1kyBtP///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAF8ALAAAAAAQABAAAAeagF+Cg4SFhoeIgwwBjAEM
hhgKCiRcAJYAOwGECkAFNUcsSpeWWIIoBQU3BSBPWkgVVxoSElY8LhAxRRBOIhcjWwfBMx9S
CwtLRAspJ1kmVAPQAx0TOBEROVVdQx5CUw0NGT5fKyoC5gIwLTYhJQ8PSYNRDgjzCD9MQRw6
RhuENAQACXihMMiAwUFNZLyw0ANKogQQE0mcSFFQIAA7'! !

!EclipseUIThemeIcons methodsFor: 'nautilus' stamp: 'EstebanLorenzano 5/13/2013 17:15'!
protocolPublicIcon
	^ icons
			at: #'protocolPublicIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self protocolPublicIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 14:54'!
glamorousBug 
	^ self smallDebugIcon ! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:49'!
glamorousMore
	^ self icons
			at: #'glamorousMore'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousMoreIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:26'!
windowIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAAGh2km95jm56jS1XjzBakTRdkzdgljxkmUBnnEBonERrn0Vsn0hvoklv
oktxpUxypE50p091plF2qCtWjS1YjjBbkTlnnTdhlnh/iDlonj9wpXd/iD5wpUR2qkyBtU2B
tVqTxVqUxWCbzWGbzY++5K3O6bnV7MHZ7k6c1Veg12Kn2m6t3XCu3YC24J/H59Xy//L7/+v5
/+76//H7/+n5/+36//T8/+Hp7Ov6//v+//X9//j+//v//4GGgYKFgI2NeY6MeZiTcqCZbKec
aKCYbdnZ2f///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAEYALAAAAAAQABAAAAeXgEaCg4SFhoeGExMDFQUX
BwgLDA8QEoMdKCgpKiwtJC4lJieWgooUBAUGBwkKDQ4RpEZDL7S1ti9Dg7MrvCs0vb65gkIv
I0VFIjErxys4RINBLx7HHzIgNzchNUGDPy8Z2BYwHBrlM0CDPS8TNDQTOjo28To+gxvrihM7
+foYgwIvcuTgMZAHwYEBBgFYyLAhQ0QQIxoKBAA7'! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:23'!
smallFontsIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAKIAADdSlm2LsqK1zitXj4egwEF0qMDR4v///yH5BAEAAAcALAAAAAAQABAA
AAM1eLrc/jBKI5kZVV2cC+HHNhRWIXBGYVyUNrxcgRUAM1BfeB9DsOw8EgtGks1eFBkrw2w6
KwkAOw=='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:22'!
objectsIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAMsuOdleZt5vd+SCiT1spgpEhBlSkCdemhBLiB5XkZq41GOph3i3mCSA
TzCJWwpsNxRwPFibXVibXGqranCkZ6uEGqeBGqeAGp50Fpx0FphtFJNoFJhtFf7SfZNnE/6/
U////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAACAALAAA
AAAQABAAAAZ1QJBwSCwKAcjkkOFwMIaAgXQAEDIaFErjCQIIvoIqqDEpSxrHgDogfkTekccR
HBYuHtnH4phEDhcQekaDhIWDCgpGFRVGBgZFFx0dFkQKCAiJQhkfnB8YQwgHBwhDm52fIAoJ
BAQJmSAckhpDBbW2RB4bhoVBADs='! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
protocolExtension3IconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAACXBIWXMAAAsTAAALEwEAmpwY
AAABDklEQVQ4jWP8//8/AyWAiSLdNDegyF6eoP8Y0cPgYKXhf2Y2bgYGBgaG81efMRhqS8Hl
bBqPMBJ0ATMbN4N5RT2DqkckAxMrB5xNtBf+/PnH8O7CLYZXT98w3H32Fc7+8+cfYS8U2cv/
VxRlZmBi5WC4++wrw/+/vxgYmdkYlKW4Gf79/sFw//Vfhr6DD1G98f//fxS8Jdfk/69vu/6/
ODblf6GdHJy9JdfkP7ra////Y3rh568/cGcrS3HD2T9//WG4PydKHF09C7rA719/GQ7MnsnA
wMDA8O/3DzibgYHhlyJ/4BuMQMDmLBgutJP7////f4brCwOF////z/j//34WdDUY6YBUMMjz
AjEAAFJot416CC4JAAAAAElFTkSuQmCC'! !

!EclipseUIThemeIcons methodsFor: 'private - notused' stamp: 'EstebanLorenzano 5/10/2013 12:24'!
smallObjectCatalogIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAMsuOdleZt5vd+SCiT1spgpEhBlSkCdemhBLiB5XkZq41GOph3i3mCSA
TzCJWwpsNxRwPFibXVibXGqranCkZ6uEGqeBGqeAGp50Fpx0FphtFJNoFJhtFf7SfZNnE/6/
U////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAACAALAAA
AAAQABAAAAZ1QJBwSCwKAcjkkOFwMIaAgXQAEDIaFErjCQIIvoIqqDEpSxrHgDogfkTekccR
HBYuHtnH4phEDhcQekaDhIWDCgpGFRVGBgZFFx0dFkQKCAiJQhkfnB8YQwgHBwhDm52fIAoJ
BAQJmSAckhpDBbW2RB4bhoVBADs='! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
testNotRunIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAyElEQVQ4je1ROw6DMBRzSh9i
jbLwEUs4BAMSI4dmhgTOErGQgc9AOrUqUNQDtJYsPdmWZekBf7Aro+971zQNsixDFEXI8/xj
9qNY17ULggBxHGNZFgzDgHmeUVXVKX87ClprR0QIwxDbtuF5ExG01u5rgVIKnHNM07Qj5xxK
qdPa+1EQQsBaC9/3d/q6rhBCnApOC6SUsNaCiHYcxxFSyu8FZVkyADDGwPM8OOdgjAFj7OW9
4/KNbdu6ruuQpimSJEFRFJfZX8cDTFpNEGq15bYAAAAASUVORK5CYII='! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
testRedIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAA7ElEQVQ4je2RMU7DQBBF3+5G
srSW1mA5Tp3KVEnhK8AF0iQVXAOfAM5CSwOCPmnTAXVSRCSWXGAJYjEUpCAsFhfIl6b58+fP
Hw0c0Ioyz6WwVm4jJ2WeS5tO/UU+xbF0Q0twfsHnasX2/o7Xt5qTsvT02ts8HEisFcFkAh/v
6OMjgvGYWCvK4cBL4jkW1srl2SkY80OloGm4fnjkqq73Zjq/DfpG08znqCTZ42W9pm+8wP4J
IxfxUlXotIfupt+V9niuKkYu+t8gWS6VARazKSoModmymE3p7HqeQxs2WSaFtXLjnGyyrPWN
B8AX1+RFw2bQv8AAAAAASUVORK5CYII='! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:49'!
glamorousBookmark
	^ self icons
			at: #'glamorousBookmark'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousBookmarkIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme-contents' stamp: 'EstebanLorenzano 12/6/2014 15:05'!
glamorousHelpIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAAP78/f7+//Lz9/Hy9vv8/46Zr/z9/4+arpKdr7W9yvf6/9zj7cvT3tzk
79vj7rO9ybS+ytrk8Cphl1N/rJaxzKO706K60o2esLO9x9vl79rk7tnj7dzl7tvk7fn8//3+
/yZimClimShhlilil0Z1oU9/rVGAqlB/qVJ/qFOAqV6KsW2Tt3icvpSz0JSyzpWzz6G71Nvl
7trk7SZilidjlyhkmCdjlShilCljlU2Aq0+Aq1CBrE+AqFCAqFyJsGmUt5SyzJWzzZezy5ay
yiZjkk2BqU+Bpl2NsZSyytvk69rj6ufw9/b7/62xtPj8//f7/u7y9ZOzypSzyNnm79jl7tvm
7Obv9Kuws/f8//n9//j9//b9//X9//T8/ury9Pr+//n9/vj8/fb+//T+//L8/fj+/vf9/ezy
8vz//6iysfv//vj8+6izr/3//v///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAG4ALAAAAAAQABAAAAfLgG6Cg4SFhR1DOSMSOkML
hm4QOkIdAgMyQjsJhQ8ISQFaY1pcAA0XGINVJxpoGyQhIjYOAR0mj25AFG1PRzYrQDc4WGpS
LYI9VAYEFSxaWCYzWB9KE4IjZ1oeWV9aKiIqBltQN4I2Xk5lYlg+Nz8EYmtnNYImEQpOXGBE
IFphZh4MSgiKQgHLEy1ZYFjoIoYLliBIBGXgMYUJEyzBulikYiTGoCYFOjDUIoYJGQ4HrhRi
U8RFgyVWOLzIkQaSBiApaNBAMcQjpJ+EAgEAOw=='! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 3/30/2015 13:33'!
glamorousTable
	^ self icons
			at: #'glamorousTable'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousTableIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:24'!
smallLockIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAAPz8/v39/mh2kqSwyPj6/l54qGN8qGqAqGqAp36TuZipx6260rrH3+Hp
+OHp92J8qHKGp3uMp3yMp6Sxx97o+ODp+N/o9+fu+vT3/EtuonKHp3uNp3yNp/L2/Pj6/YST
p2x2g4STpouXpuTt+Obu+Orx+vH2/PD1+/P3/PL2+4uYpujw+e3z+pCbpvX5/ff6/fb5/Pn7
/XqBhc/t++H0/fv9/f3+/sPEu7m3qKCYbJuVcKyoj6ecaKSaapWQdf3zy/Tmtv3vvf3wwv3y
x/3yyf3zzraSJPXaiPzhj/zkmvzmnvzmn/zmoOXgz7GLIbSPI8GeOKaJOMekRbiZRNi9bfDX
jtnEh+XRldzPrHhbE6d+HK6GH6uDH8WwfdLAlNHBm8Kqc8m2idbLstnQvPPt4f///////wAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAGYALAAAAAAQABAAAAfPgGaCg4SFgzyIiYqKgj0z
j5CPPJA8gjkzI5maIz4zGQw+gjozJKWmJDIzHSkygjszK7GyKwK1tYI4NCa7JiW+IAMTEyCC
N2FQUF8YGCwsLQ4NFS2CYFJkZFJeLi4nKhYWFCJmYkZYZWVjRk0vKCEzFxcfZl1aYV1dYVpd
MTAbERIcIph5gqSIFSA/ljypEUMDJAhmnAwREmVKECZOAgA44IkBAjNbiFzJkuWKki02bDyY
4YGAATNcqiShQiXJES4LFCQowLPAPC1Ag3YxZCYQADs='! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme-contents' stamp: 'EstebanLorenzano 12/6/2014 15:48'!
glamorousSaveToUrlIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAD8/nz9fn0xnl1FtnlFsnVRvoVBtnVNwoVFtnVJunVh0pFh0o1h1o1l1
o1x4p198q2B9q197qGN/rWR/rWaCr4WhzYahzZ2z1l99q199qmOArYWizYaizYaizJCq0qe7
2qe82q/B3TNwpDNwo0B3pw1cmv///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAACYALAAA
AAAQABAAAAZmQJNwSCwaj0gjaVQqJYkkkfMpLEWppimJCjBGKGBiYAguh0KUYZd8pmhCGolw
TJRIQpPHB/LMgDAOFw5PgQ4NHgkKDAuMjY0eCwccHBscFpUbGx0cFZQFAgYGAwgGpKEIqASo
WERBADs='! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:49'!
glamorousZoomIn
	^ self icons
			at: #'glamorousZoomIn'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousZoomInIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
traitIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAACXBIWXMAAAsTAAALEwEAmpwY
AAACI0lEQVQ4ja2TS0uUURjHf+e9zatzaS6m42VCiFJBElG7I1hQixZ9g2jVImjTF+gjFARt
2kS0j2hTFmlRiZUWZKljg2maw2jNODPOxfdyWoQ6by2C6r98OP/fec55/o+QUlKribFl+frZ
InMzq7iuRAjY39XIwOAe+o60Cn6RqAXcvjEh344vEQyZRBvqt+vf10oU8hV6D7Vx7mKfB6LV
mp+PpOjqjtPUHKIuoG8famoJkUnneTGaApC1EA0gNfNNjg7P0dkb58Llw/iDhqdN23aZmvzK
3MwKo8NJjp1ol3s7YwJAAXh0L0lbIoxlu0y/X+HDuxXKG5tYlkMmXeDLfBbdVEFKfKbg8f2k
9wmfZlcpVSyM9TI3r72k3q9z5eoZNEPj7p1JPqdyBHeZlEoWqqaQ/JjxArLZEpvVKkIIbMeh
kK9g+jQURRCJBZh8tczSQg4hBNWKjWPv/KMCEInUoxkGCBBCIITArNNRVUE4FsB2JFvTUlRB
NOr3AroOxNE1BV3X0HQFRRVYlgNAecPGth10Q0XVBabpo2eg1Qs4dbaDXLZMMFRHvDlM78EE
0v15o2VvousqkQY/PsPHeq7C0aH234N06/ob+eTBLK1tYaKNOyEqFioszq9hmDpWVTJ4ch/n
L/V7cwBsFeXIw1kc1wV2EtqwO0wmnWfodIfH7OlgSxNjy3L86QLTU2mKxSqBgI/unhb6jyf+
vAt/I+Wf3P8D8AOoI9lGL3q6bwAAAABJRU5ErkJggg=='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:23'!
smallForwardIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAP797/375v332f765vzyyv732f732v322f322vzpqPztuf3yyf3yyv72
2fvgjPzkmfvkmfzoqPzoqf3tufvdg/zgjPzjmb2EFq51Erd9FLd+FLV7FLV8FLyCFrmAFbuC
FqtwEatxEaluEa90Eq1yEqdsEKZrEP///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAACcALAAA
AAAQABAAAAZkwJNwSCwaj0ji5ZIsdgCd5vADAHyMnqzWMwgMPERNo1FAHAyCggAhyAw3DMaC
EF/I7QyOEDPpK/4TCoGCI0IkEogRihESCYwkRCGSISCUDxAWIVIiFQ4iUiclFCWgJyYmpalS
QQA7'! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:25'!
smallSaveAsIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAAPj4/IOt8F17q157q117ql57qlVvmkBTc2F9qmJ9qcnb+rvL5OTp8WWB
qWSAqMjc+snc+cDP5sHQ5sbU6MfU6M3Z6mWBqGuEp7LD27vM5MDQ5s7a6tXf7dXf7GqFp3CI
pc3a6t3l78/T2Oru82+IpbnF0+Tq8XWMpHWMo/D1+u/y9Vh1kXqQo3uQot7r9u/1+t/s9vD1
+X+Tod7s9t/s9YOWoPD2+fP19oSXn+/2+YiZn4iZnrfDxnGDhoqbnrG9v6Wzrv79+uTPnf//
/wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAEMALAAAAAAQABAAAAekgEOCg4SFgiI+Pj0/jD89
iSKEPjc8QZaXPDc+hDoqPi8xKTY5KT4qO4Q4Iz4wLjAwMzQ+IzWEMgw+Qrq7PiYyhC0hGInE
PhghLIQnHRwdzhzN0CiEJBsgIA7ZDhUbFR+EFxQTDgDlQg4TFB6EFhEaDg8QCkAOERINhAgZ
Cw66K+cZMiQgVKIAgQICBhRYKGChoYcQDRkIMGRiRYoPDxgYopGjgUAAOw=='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:25'!
smallQuitIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAG2LuVx8qf797/342v332vvpoPzwvPzwvfvjkPvkkPvjkfvkkfzooPzp
oPzoofvooPvoofzvvPvehfvfhvvgifvhifvdg72EFrF4E7qBFbZ8FbZ9FbqBFqluEKhuEKhu
Ea1yErJ3E6ZrEP///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAACMALAAA
AAAQABAAAAZgwJFwSCwaj8UAAGlUFi+Xo3N4EUSbS+GFMIB6r1OOYWyIHMiZkVPzYDgahUcD
Qt+olyEFArFYJP57GHdCIBQVh4aGFSCDQh0SEx8eHR+VQlNCIhYiUllDIpxYTKOkpUNBADs='! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
smallSystemBrowserIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAKIAAFx6qmB+rWaDsZGlx2yKt3KQunaUvv///yH5BAEAAAcALAAAAAAQABAA
AAMqeLrc/jA6QOUCAxzDCxFBQ2mWQpYHOUojpn2haFbRWao01GYHXOeoICQBADs='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:22'!
smallCenteredIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAIAAAENKh////yH5BAEAAAEALAAAAAAQABAAAAIXjI+py+1/gJwAPoqldblu
1lEfmI3mGRQAOw=='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:22'!
scriptManagerIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAAEpZfHaEnHmGmomPj4mQj0pUM0pTKtXet9XdsdzjtdzjttXcp9zhqtzh
rNzhrebqvtfbk9fblNjcltjcmObpvufpttzdidzei9zejefotdXTUdXUWvDww5eXhubjd+He
fuHff+HfgeHfg/DvvfDvvs3ITc3ITs3IT83IU+zlaOzlaufidebgdPj1w/DlX/DmYPDmYuzj
bOzjbaKffvjqXvjqZaKaUYp7NYp9PYp9P5GFTrKoda6ld6ujeYp7OIp/Uf///wAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAEAALAAAAAAQABAAAAdwgECCg4I7O4SIhDscDzyJ
iDstFAqOj4UtJAkOlY+RIxUNP5ZAOzk4GQw3EwKWOgcIPjcSGCKsjz0LNhEXIR4ytokzEBYg
KzEwwIkdHywqLycBo0AEKS4mANIDBSgl2KMENTQG3qMAGxoD0oMA6erugQA7'! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
userIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOZsAN7p7OTq7K7G4cvb6ICcxff5+vL193CVze7y89bk6+Hp6+zx89bk6mmK
ydDc5Vd2rKKyzHuTwd3l6Yum1EJmqEFqtW6Tzoibv73R5Y2iw4yhxOXr7/j6+lZwobjJ3eXq
77jI4Dpjr+Lo8sPR4aq+2MfY516HxoWbv9/m8ZSs0J+63pCv21V6wNrj7H6Wu9Pg6b3M2///
/9Pd6r/M3+ft8XyQttDa42qPy9fg556109Hb5KC63dnf6W+IuC1WqWKJydri55iszZ+63T5m
sr3R5PP2+L/L4NXj6p611FVyqURin1FvpomewXeNtd3l6MzZ5HmZ0H2h1fL1+Kq+2X6d0sva
6Pb4+ZiqycbX5tzk6LjF2rzQ5dje55SnxjZfrVx/wWaMyYGYvU1rpOju8WmEt+3x9lJ/w3WP
t9rj6Iam2Orv9ZGw2v///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAGwALAAAAAAQABAAAAe4gGyCEDUXgoeIhxABQBmG
iYlXWToZTYdBPRGJXTYwWlxsMUYKOASaiBozPBNfDSI0TwRkqAgcEwAvBw1SMgQdh0wBtVRH
JQcsKCAPhycBwlZQWAIHFAULCstsYc5OGwYWURXWCmgOvy4BEh/fAO3iYw4jHklnEt437QAM
AxRFLR5TlhwCky/BgC0ChpQhkUPMoR/t9hERoCKEGiQplBwyASBBFQwChKzxAomNGYMgd6xI
46Oky0SBAAA7'! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 14:54'!
glamorousInspect 
	^ self smallInspectItIcon! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:26'!
transcriptIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAAPP1+/f4+zpOgUFWiENYi0pgklBmmFZtnmB3qF11pmZ/r1Rkg1dnhvb4
/FtriV9vjGR0kOHp+OHp91priGl6lWl5lG5+mHODnOXs+Onv+e3y+m5/mHeHn3eHnuHq+OHq
9+Ts+Pb4+ytcnCtalytYkytXkEZzrVp/r3KDm3aHn3eIn3aHnuDq9+Xt+O7z+vP2+ilvxClu
wilsvilruipquilotSpotSlmsCpmsSpjrCpkqyphpithpipfoStfoStcmypalypblytblypY
kypZkypXkCtYkCtXj3aIn/L2++3z+vb5/Pb5+8/t+////wAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAE4ALAAAAAAQABAAAAejgE6Cg4SFgycwiYqLMCeD
MQuRkpMLMYMyDE2am5sMMoMzE01MIQEhSw0hDQ40gzYPTQoJBgQCL0kADzWDNxBNLi5KwMAa
EDiDORSxCggHBQMCGRU6gzsbTRggIBjZGC0WPIM9KE0sER8eERIRHhc+gz8pKR0pHCopK0jy
IoMmQkJB/gUBImQEQBOGnJggMYQIwoQmjByReKREkRIlHibcyHFjIAA7'! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:49'!
glamorousOver
	^ self icons
			at: #'glamorousOver'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousOverIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:22'!
lockIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAAPz8/v39/mh2kqSwyPj6/l54qGN8qGqAqGqAp36TuZipx6260rrH3+Hp
+OHp92J8qHKGp3uMp3yMp6Sxx97o+ODp+N/o9+fu+vT3/EtuonKHp3uNp3yNp/L2/Pj6/YST
p2x2g4STpouXpuTt+Obu+Orx+vH2/PD1+/P3/PL2+4uYpujw+e3z+pCbpvX5/ff6/fb5/Pn7
/XqBhc/t++H0/fv9/f3+/sPEu7m3qKCYbJuVcKyoj6ecaKSaapWQdf3zy/Tmtv3vvf3wwv3y
x/3yyf3zzraSJPXaiPzhj/zkmvzmnvzmn/zmoOXgz7GLIbSPI8GeOKaJOMekRbiZRNi9bfDX
jtnEh+XRldzPrHhbE6d+HK6GH6uDH8WwfdLAlNHBm8Kqc8m2idbLstnQvPPt4f///////wAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAGYALAAAAAAQABAAAAfPgGaCg4SFgzyIiYqKgj0z
j5CPPJA8gjkzI5maIz4zGQw+gjozJKWmJDIzHSkygjszK7GyKwK1tYI4NCa7JiW+IAMTEyCC
N2FQUF8YGCwsLQ4NFS2CYFJkZFJeLi4nKhYWFCJmYkZYZWVjRk0vKCEzFxcfZl1aYV1dYVpd
MTAbERIcIph5gqSIFSA/ljypEUMDJAhmnAwREmVKECZOAgA44IkBAjNbiFzJkuWKki02bDyY
4YGAATNcqiShQiXJES4LFCQowLPAPC1Ag3YxZCYQADs='! !

!EclipseUIThemeIcons methodsFor: 'nautilus' stamp: 'EstebanLorenzano 5/10/2013 16:20'!
uncommentedClassIcon
	^ icons
			at: #'uncommentedClassIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self uncommentedClassIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
testYellowIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAA7klEQVQ4je2RMUtCURTHf+/e
q2AUD7SHYE4K4uDu0ODcd7At/BxOzm75QYqmxoRAdGgIiXg4PBqKGkSre8HTEIR6e/UF/MNZ
fud/DufPgZ1S5SY16Xa0XJ8bcZOapPmC32BylZEov4cqnoF9YvV2yfPrkqMT5/nVNrDjihRC
UNEprD7B5FFRm0L43ft3QW8wQ4ct5ONhrR7RYYveYOZda7ZBtQyyGBNkDje4uBeqZT+ul8ne
Hsg0fqfeOAbkx3Z/d0O9kiPbnG/MeBGyzXmgFSTxEPQ+iCOJhxiNN/yn7Kgk3Y6Wi74ROyql
vnEn+AKLwVPWIMle+gAAAABJRU5ErkJggg=='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:26'!
versionControlIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAAIOKlPr8/2iOvGyRvm+Tv1J/sFaCs1aDs1qFtVuFtV+It1+Jt2OMuWSM
uWiPvGuSvW+Uv019r018rlGAsdPl9Mzi86vS7bfY78Pe8fr9/4TA5pDG6J7M6vn9/9Xz/+n5
//D7//794v794/z4o/z4pPv1pP360P771cK0Osi5VvnqdPnqd/nqefnqe/nqf/z1x/PXP/LY
R/LYSPLYSvfjYpmWg5mWhPPWPPLYTPrgYX91QsOnK8aqNfrdWoV4QKGafcCcHcOiJMOjJ8up
L+/LQI58Pqugdea2GfrJLpiCO+WxGfG6JvG6J/rGK6yMNaOHOOO0PbKPNPfkuuvfxLd/C8KO
JcGNJuOGCbF9OujYxOV5B////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAFsALAAAAAAQABAAAAejgFuCg4SFhoMpQTtCQCmH
gihNOSMsMksojzxIPSSVS1SPU1IvJTdHV1aCERMGCAoMAgMQIioxTKlbGhscFhcYFRQEIiuW
VYISBQcJCw0ODwQhLTNLxltRHh5G2NhRIS441IJOHh9GH+cfTiYwSlpYgk81NgA/9T9PJzRE
WEOCSR4gAIAYCCJJFixYoAwq4iEAgA4QMxQ55EOHxYs6fDzayLFjIAA7'! !

!EclipseUIThemeIcons methodsFor: 'nautilus' stamp: 'EstebanLorenzano 5/13/2013 16:44'!
dirtyMonticelloPackageIcon 
	^ icons
			at: #'dirtyMonticelloPackageIcon'
			ifAbsentPut:[ 
				(self monticelloPackageIcon asFormOfDepth: 32)
					mergeBottomRightWith: (Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self overlayDirtyIconContents readStream)) ].! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
classIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAAGyogTOCTTaDT0CJWEKLWkaPXlSYalqbcFyccX6zkIG1ks3i1CR2Pi58
RjOBSzmGUFicbV2ecWOid6LJri18RC59RS99RjB+RjOBSUuSYEqQXneuh9jp3TKARzaESjuH
Tz+JUo69mj6ITz6IUD6HUEaOV0ePWFKWYmuneo++msPdyeLv5VKWYFaaZFaZZF2caqvPs7zY
wlSXYVeZZFiZZF6catrq3ebx6FKWXvH38mCgaXyyhHmugYW4jIy8k/D38VmZYWikb2GgZ2Ce
Zp7Godzq3Weiam2mcHeueICzgHuxenmud4e4hYGzfeHv4JG+jLPSsLzZub7au5/HmqDHm7vY
t8Lcv8bew7DQq////////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAFoALAAAAAAQABAAAAengFqCWgsRGQ8aEQuDjFoK
D0FIkkEBCo2OHU1YVldWVEkMloMLD0tSWaioUUoBi4IHQlOoVU9QWU5MQhKDBThEWUVDwkdG
RkAFgwEXKVkqFRQUFRgeIg68HxtZKyAkJBMwECbIghIjNTlZMSghWT8vLACDHAwyPDapNz40
DK6CCQ0ldOzosUPHDAEJLiWwcKKFixYnLCS8RMjAAAIDEPSjyLGjx4+NAgEAOw=='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:23'!
smallDebugItIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAALittxMTQ9fX5iAic4+QuSIpedPU4Dc/g1FapOPk7lBapFVfp1liqVli
qG53s3J6tMzP40RQm0NPl0tXn09boFdip1lkqVllqWBrrmNurmRur2Vwr2Zwr2t1sjJCjTpI
kENRl2Rwr255s3WAtX+Ju+bo8iU4hDxNlNjc6YyawIqZv5ypx7nD16O0y6O3y67Dz67Fz7LI
0LbL07jN08rg28ri3Mri29Lm4B+ETsLez8fg0z2WZESaaVameHOzj1erclircVircliqcU2n
ZU2mZWGwYIO+gYO9gZPFh/Hx7f///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAEoALAAAAAAQABAAAAeegEqCgg6DhoeDGoMiiIYA
CwCCGY0dGhcKHx8AE5GNSgARSTQgEhFKHhKNCDQINTczFAAADRuCIowADDZJojANnYYYExY3
SQY3Misehjg4ORAjMzQ3Dy4qJx4VgjhIOD06KC8xLQckJpEhSjhHR0Y4PAksKSQBBcxAQj8/
QTgCBAMDDuEYQmQIDh8lgAksgmOHDiUKPKlzJoiDxIuIAgEAOw=='! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
protocolExtension2IconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQBAMAAADt3eJSAAAAMFBMVEVBd69ThroQXJwZY6Am
a6cscKhIg7Owyd////////8AAAAAAAAAAAAAAAAAAAAAAAAAHByLAAAACnRSTlP/////////
//8AsswszwAAAAFiS0dEDxi6ANkAAAAJcEhZcwAAAEgAAABIAEbJaz4AAAAtSURBVAjXY5gJ
BQzEMjyhjGliUEZpayWEYdFhCWZMD2gIBzMmKSkpkWAyCAAAf19Ib5Xf/x4AAAAASUVORK5C
YII='! !

!EclipseUIThemeIcons methodsFor: '*Komitter-UI' stamp: 'EstebanLorenzano 12/13/2013 14:40'!
komitterIconContents
	^ #(0 4291344726 4291011108 4291012395 4291011367 4290812957 4290613780 4291344726 0 0 0 0 0 0 0 0 4290950202 4294761036 4294698101 4294834877 4294767789 4294568578 4294303329 4294363448 4290950202 0 0 0 0 0 0 0 4291209781 4294761294 4294697579 4294834877 4294767789 4294568578 4294303329 4294363448 4290215691 0 0 0 0 0 0 0 4290483257 4293638436 4294435416 4294702476 4294568309 4294170434 4293640485 4293762572 4290874662 0 0 0 0 0 0 0 4290417209 4294302048 4294701206 4294834877 4294767789 4294568578 4294303329 4294363448 4290874662 0 0 0 0 0 0 0 4290483000 4294302048 4294701206 4294834877 4294767788 4294568577 4294303329 4294363448 4290940453 0 0 0 0 0 0 0 4290548791 4294302048 4294700950 4294834878 4294768043 4294568576 4294303330 4294363449 4290940453 0 0 0 0 0 0 0 4290614582 4291148953 4291148953 4291148953 4291148953 4291148953 4291148953 4291148953 4291148953 4291148953 4291148953 4291148953 4291148953 4291148953 4291148953 0 4290680630 4290427290 4294441212 4294441212 4294441212 4294441212 4294441212 4294441212 4294441212 4294441212 4294441212 4294441212 4294441212 4294441212 4290427290 0 4290680374 4290427290 4294441212 4287603139 4294309882 4287603139 4294309882 4294309882 4287603139 4287603139 4294441212 4287603139 4287603139 4294309882 4290427290 0 4290680376 4289835439 4294309882 4287011519 4294048510 4287011519 4294048510 4287011519 4294309882 4294309882 4294309882 4287011519 4294048510 4294309882 4289835439 0 4290680378 4289375144 4294048510 4286549936 4294048510 4286549936 4294048510 4286549936 4294048510 4294048510 4294048510 4294048510 4286549936 4294048510 4289375144 0 0 4288522415 4293523711 4293523711 4285957539 4293523711 4293523711 4293523711 4285957539 4285957539 4293523711 4285957539 4285957539 4293523711 4288522415 0 0 4288522415 4293523711 4293523711 4293523711 4293523711 4293523711 4293523711 4293523711 4293523711 4293523711 4293523711 4293523711 4293523711 4288522415 0 0 4287996342 4287996342 4287996342 4287996342 4287996342 4287996342 4287996342 4287996342 4287996342 4287996342 4287996342 4287996342 4287996342 4287996342 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:49'!
glamorousThrough
	^ self icons
			at: #'glamorousThrough'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousThroughIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:23'!
smallDoItIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAACCAQSaAQSaIQUGRV16abzqITzOISGatdy2IQUiRV0iaVzqRSEGRT2at
bzqIQTN3OkGISEiRT0+aV1ekXi2AMzOIOkGaSEiaTzqIOkGRQVekV0iASGakZnetd63LrbrS
utXg1V6aV4i3gG+kXoCtb4i3d5rBiIi3b5G3d5G3b6TBiIDMJsLpeP///////wAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAC4ALAAA
AAAQABAAAAaYQJdwSCwWQYdCIFA4gIyug2G1MqlEnGbxkCitWqtUCoVKHIYgA+n0aYFP8JPh
GZWMRm336n4/uwwhgXl6gR0GQgYbih5ujSwbHQFCAA+VjI0flQQAQgEUn5ctHp8QE5JRDBER
lx6qFxIDfiAIEhmMHg4OGRcTCHRRCxMeHhUYFhoTC35DBwgKEw0NEwoIy0RIAksCTlDdRUEA
Ow=='! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme-contents' stamp: 'YuriyTymchuk 2/16/2015 09:45'!
glamorousZoomOutIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAAPf1+Pb098rE0ufm7PX19/T09uvr7S08rys9qy0/rSpAryo/rKu616q5
1vLz9ebn6aq61Km50qi506m61Km706i81Ke7066ytfD09+Xp7OTo6+Ln6vL29+To6ePn6PL2
9ePp53F0bff48+rt3L/BttjazXFybOrr5dzd14iJeYeIeoiIfHJyauTk2MDAtu/v49nZz+7u
5uvr6auqmOrp1KCZY8C+r+Hf0Lu1k4mHeoqIe9LPvImHe+zp1qyqnefl2NzazqKYZ7u1lYqH
eMC9ruDdzuzp2uvo2XJxbKemoff28aOXZ/n49KSWZc7JtrywiLyvjIuHe4qGe4qHfomGfcC8
sKSJRIqGfYuHfsK8sN3c2qmmofr38oZWMoRWMoZUM+zs7P///wAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAGEALAAAAAAQABAAAAeMgGGCg4SFhkJBVktPhoNO
TTZHLyNZNTuNSzRKXCIiTEZLhlBVHwUEAAQBHEQ4hTktGAwRFhUSDj9YhTwxEAgKBwsJECcp
hUM3YBMTDQ0UMkVUhTMuGwMdGhoZBhc+hiooDx4dGyAwUY0CKyQlWkAXPD1TjWFbPDpXSWFS
XSHzhkhfWPgrZMLLwIMIAwEAOw=='! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme-contents' stamp: 'EstebanLorenzano 12/7/2014 09:40'!
glamorousCloseIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAJEAAD9fPwAAAP///wAAACH5BAEAAAIALAAAAAAQABAAAAIalI+py+0PFQho
NivwDdr1/UlUNi5dGKXqihQAOw=='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:22'!
processBrowserIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAAPP1+1Rkg1dnhvb4/Pn6/FtriV9vjGR0kIiTqKy0wuHp+OHp92l5lG5+
mHODnLa+y+Xs+Onv+e3y+neHn3eHnpqmt+Hq+OHq9+Ts+Pb4+ytcnCtalytYkytXkEZzrVp/
r3KDm3aHn3eIn3aHnuDq9+Xt+O7z+vP2+ilvxCluwilsvipquilotSpmsSpkqythpipfoStf
oStcmypalypblytblypYkypZkypXkCtYkCtXj2qa1mqRwZe44pez13aIn/P3/PL2++3z+vb5
/M/t+93y/P//n//fX7+fP//78P+/P5qNc9+fP25NJZxoVlQ4MP///wAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAFAALAAAAAAQABAAAAe7gFCCTk9OgoeIgk1NT0ZP
i4mITUhHlUhNkYNPR0tPS0eFPTsopCgfT0pKT0moqgkIAbEBKYRKnUuqTkVEvEQCKlCTTMOX
BBlDAxkDBSvBjEyPTSfTJ0EABiyHhE5AJkIm4CYSBy2HPg9FEerr6gwuhzwVRBAYGBD0ECUN
L4cwIEQkFFywoGCBAgsOYhySESIEhRATRIQY8aOhhkMeatSgoZHGjBobNnrI5IGDjRsjSebQ
sVJHBxwdOowMBAA7'! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme-contents' stamp: 'EstebanLorenzano 12/6/2014 15:05'!
glamorousAddIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAADV2VDh6Vzh5Vzt+Wjx+WkCFXkSLYkWMY0WLYkWLY0WMYkqTZ0qTaE+a
bFCabFShcVWhcVShcFindVWicVyseV+we12seY20U420VJa5VZa5VqDAWKHAWKzHWqzHW63H
Wq3GWq3HW8XWYMbWYMXVYMbVYMXVYdDbY9riZdrhZeDlZv///wAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAACsALAAA
AAAQABAAAAZbwJVwSCwaj0hhZVlJDisqVdO5oqRQFupKcpUgJxHI40Q+Pc4PokMkMpHapRG7
QWSEQqAOKOT5+BdEBgkKChscGxsKCAcHSAUZGgVaBBgXA1oBlQJaAJ0AWqCgQQA7'! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:26'!
smallWindowIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAAGh2km95jm56jS1XjzBakTRdkzdgljxkmUBnnEBonERrn0Vsn0hvoklv
oktxpUxypE50p091plF2qCtWjS1YjjBbkTlnnTdhlnh/iDlonj9wpXd/iD5wpUR2qkyBtU2B
tVqTxVqUxWCbzWGbzY++5K3O6bnV7MHZ7k6c1Veg12Kn2m6t3XCu3YC24J/H59Xy//L7/+v5
/+76//H7/+n5/+36//T8/+Hp7Ov6//v+//X9//j+//v//4GGgYKFgI2NeY6MeZiTcqCZbKec
aKCYbdnZ2f///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAEYALAAAAAAQABAAAAeXgEaCg4SFhoeGExMDFQUX
BwgLDA8QEoMdKCgpKiwtJC4lJieWgooUBAUGBwkKDQ4RpEZDL7S1ti9Dg7MrvCs0vb65gkIv
I0VFIjErxys4RINBLx7HHzIgNzchNUGDPy8Z2BYwHBrlM0CDPS8TNDQTOjo28To+gxvrihM7
+foYgwIvcuTgMZAHwYEBBgFYyLAhQ0QQIxoKBAA7'! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:23'!
smallCopyIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAPP1+/j5/GN6p+7y+vL1+/n6/Pj5+152o2Z+qGqCrG2ErXGIsXOJsnyS
uH6Tuoygw/D0+4GXvISav4mewZGlx97o+N3n99/o9+Ts+efu+e3y+vP2+9zn99/p+N7o9+Hq
+Orw+fb4++bu+fD1+/L2+/X4+/f5+5qaj6Cdi52bjq+ngaukhKiihqOfirese7Sqfse1ccWz
csOydL+wdryueeDIj9SyaNSyadq9fNWyaf///wAAAAAAAAAAAAAAAAAAACH5BAEAADoALAAA
AAAQABAAAAaaQJ1wSCwKYchk0qiLFZ5KJVFmChicz+wNNpyVKBGqtRrA5bg6GmFD8oIVh1AN
Z5vpXCPKQ83eADaAGzQ6LxoaA3h6Eg0MCQIQLjoqIHqFh4aYGi86KyIZGZOKjI4gKjosGHqd
n6wZnis6LR+zqKKNAhgsOigdFBOys8HBLTopHBwWvL4OCwgXHhUoOifUJ8bI2BYWHClF1d/f
QQA7'! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:22'!
openIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAMQAAPjomPjwyPjosOjQiPDYkPjgmPjgoPjYiPjQeODAePjYkPjQgNiwcLyF
MsOLNrR/MqVsJK1yK7x/MsOFNq1sJJ5mJ61yL55fHZ5fII9SGf///////wAAAAAAAAAAAAAA
ACH5BAEAABsALAAAAAAQABAAAAVV4CaOZGmeaGo6rKNulCZrVDoBADEkzOT7pEZgSCw2SBKB
csnEkB6GqMFCrVo3EYXWUuh6uwPLBnI4WMpodFh0QVgW8Dh8LcpYEPg8nj6q+P+AL4KDIQA7'! !

!EclipseUIThemeIcons methodsFor: 'nautilus' stamp: 'EstebanLorenzano 5/13/2013 19:10'!
smallProfileIcon 
	^ icons
			at: #'smallProfileIcon '
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallProfileIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:25'!
smallSaveIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAAPj4/Fp5q1t5q1t6q1t5ql57qmF9qdzj7+zv9Ft6qmB+qWR/qGSAqGiC
p5ey2bXO8rfJ47rL5L7O5cTS58nW6c7a68/a68/a6vDy9WyFprrM5LLD27vM5LLD2r7P5r/P
5cPS58PS5sjW6cnW6M/b687a6tXf7dXf7Nvj7uLo8GeDp2uFpnCIpcjW6M/b6ufs8s/T2LnF
09vk7uHo8Obs83OLpHeNo+zw9Fh1kXeOo3yQouLt93uQouHt9+zz+dvo8uHt9n+Todzp8uzz
+PDz9dvp8uvz+IKVoIOWoPP19oWXn4aYn4iZn4iZnrfDxnGDhoqbnrG9v4qbnPb5+ff5+aWz
rv79+uTPnf///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAFgALAAAAAAQABAAAAfcgFiCg4SFgjBQiU9RjIxP
iVAwWE1JSU5WmJlWTpVMWEoYRFBUpFRTpFChS1hINwhQPrFDRrFQNzdHWEE0L1A9vz07QEBQ
Ly9BWDwpM1BFP0VCP0JFUDMzOlg2MjJQV97fV1AHKDlYNSYnHZDrGycmNVgsLhYWLhcl9PQV
JCUsWBkjKARkQJDgiBYiRqzA0mBCCBAMAEgEcIUBiIsqsCyQIOEDAwcgpUhh8MGDBAZYDESI
oIHBg5dVqjBYyUEBlgIQcjL4hqNiTggFsMQYQCCBAAEEAghIkIDAUgKBAAA7'! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:49'!
glamorousLeft
	^ self icons
			at: #'glamorousLeft'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousLeftIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'nautilus' stamp: 'EstebanLorenzano 5/14/2013 16:26'!
testGreenIcon 
	^ icons
			at: #'testGreenIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self testGreenIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:24'!
smallLoadProjectIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAJWBiJWBiYl7jXJxk19knWBknmBknWBlnWNnmV9lnVZfnlFco1JdokVV
qEVWqEpapYWRyDlPrTlQrD9UqihGsy5JsC9KsS9KsDVOrZK17JK27JK165K2653F8p3G8p7F
8p7G8qnW+anV+KnW+LHh/frpnvbflv/xwv/rs+zRi//lpP/aif/flv/Rdf/VfePBfdmycdCs
eNGtedCsef///////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAADUALAAA
AAAQABAAAAZ8wJpwSCwaj0iZUoYczmhQWuwYCABKJVPqBQN4vYGaAHIqm88niEA4QLnfcNRg
iFDZ73gVYqhgsRIGBQaDBAcEBoA1DyuMDCSPkJALNRMuLg4jIiEjIZ2bDUIYLREfHx4gHyAd
ICASQxUWGRkcGxobHLMXRRS8vb5NwMFGQQA7'! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:25'!
smallQuestionIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAMQAAP7+//Hy9fLz9czU3tvk7v3+/yhilkR2pF2JsV+KsWqSt2yUuHmdvpWy
zKK701CAqvX7//r9/+jw9fT7//f8/+3y9fb8/+zy9fn9//z+//X8//j9//f9//v+//b9////
/yH5BAEAAB8ALAAAAAAQABAAAAWA4CeOZGk+j2Ggppg2hBAQzVo+cMHtHEA/JAOhQDiohETD
CJfhJAyLmoGTaQA/D0Kk42DsUpwO4Wq4YDCRHcKAiEQqyk95Q+esFRj6JZ6lUHYqO38DVzh+
fw4OFh4WFFYjQhoaHCoaFhoEcS4wEDwQEz83BjASEjQ2LSgqLC2tJSEAOw=='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:26'!
warningIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAP7bc//egf/ij/7ijv/jl/7kl//mnv7lnv/uwf7CTP7DTf7DT/7IW//N
a/7Na//NbP7QdP/dmbltAIJNAF03AMSAJMSCLKqASa2DS6uBSquCSrGHTq6ETbCHT7WKUrKI
UcCVXL+UXMOYX8GWXsSZYMiib6+ETbOIUcOXX86uhd3Muf///wAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAACsALAAA
AAAQABAAAAZowJVwSCwaj0ihikRSJYcoBEL0XKlGkcjImQQhJBREKFnyICoThKeE/AAW6AXg
dPyUAgrLJBEo0YsbAQyDhAEdRRwDDw8OaA4NDQImRBgFEJdglxAEGEQZKQcHBqOkKRpFF6mq
q1WtrUEAOw=='! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme-contents' stamp: 'EstebanLorenzano 12/6/2014 15:48'!
glamorousLeftSideIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAAIWTroiTpoqXrI2ZqoyZqn2Gko+aqJOcppKcppaeo2xzd+r4/5efo+n4
/+v4/tXz/+35/u/5/PH6/PP6+5uhofX6+l5kY5uhoPf7+fn7+KCjnqCknfr8+Nbtq9jur9rv
s93wuuTzyOHxwOz21/D43+n00PP55fb66/j78MbibqSnmqSmmqmql6mpl/z8962slPz6266s
lP7977KvkJOMXraxjrKukb21ifvyubmyjLmzjKigdfvusL+2iL20ibiwhfvll7qCFb2EFrqC
Frh+FLN6E7uBFbR6FLd+FbuBFruCFqxxEatxEa91EqxxEqltEKZrEKhtEf///wAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAFIALAAAAAAQABAAAAe8gFKCg4SFUj2IiYqLPT4P
j5CQPymUKTc6Dw2am5qTHZ85NQ8LpKRCQgs7KR6sNTMPDrEOQjJCDjQpH7o2MQ8Qv0EyMkNJ
SkZKICAvLA8REUQw0dLRSCItKw8SRzw43d7dRSEqGw8TE01A6erpTSUaFA8V8kzpS072SyMj
FwkPGP8YogB5gsFCChIIGRx4kKFhQyhQMihIYaIiAgMPOGjcqLFAihMgDRB44KKkyZIBUqBY
OUCAy5cwAcAUEAgAOw=='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:26'!
smallScreenshotIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAJnSURBVHjapFNdSFNhGH6+s6lF
ZDcpONcWJv1M66buCvrBoi5WGAh5E7SIIiIoLxoliVLgipF00U00MoKgWLoGgWFlWIxAwuzP
ag5duUZzbuds7sfOOV/n+04eSgKDXnh5v/c9z/u8z3nP+aCqKhZyWbpD5fwbKn8sp3Lqoh5/
5QL+xUrqgehmuDrbAOWbHrUcthcgbMJ86wsO0Md9/Ube6W2G6/gj+NztIMtkUNHMSXzXdukE
p4+dpcnsInTfPk9Yc8MeB4iSANWmESWm+SRowsPJhNopqOHlOnPFGZCuSz4a/jwGouU/ZKI/
0MLO3TsMBfucFVzB9bYrMBUlKGXlONJ+iisAIxALquH+u09oaHjccE2hvrDpDnrwkFdf4NQJ
jmV1YSYn8ynRaAL9DwbQsHcbHGttiH2KYPDhM+w/cFOT9hZY3KhPZAJNVVhC38HjCUGYFmfx
fjSKzEzekMyIQqNhfJeLuNddD3dXBoFgAkJZHQKve0GFargO+8F6zYl0EaKUAfuesXgKS0uB
sfAXrLRV42jzRgy+SsFutfBaZlbHwGTR0ONgveZkugBJyvLNRSIxQ4VjTQ3SxUqsr6vk+VA8
ySPHmLbyM+s15/MKUmKGF75OpviUVbUrYLVWaXWJ1/lZq81hbtyPIy8LYL3m0hIFopgFVSkK
s4S/Alsk2wOTzYwRWlbX8HNOGyBqA3NFgPWSpqYOum6THex/ZHt4/nQCPb2tHMzIXo5Ejdc6
576FLdvtRv5haALEHximl68G8fulmCNbyFpOOv9+F3qCI/SCN/hHrbXFiUbnBjIfSyil+B/7
KcAAqaNmtdvCPngAAAAASUVORK5CYII='! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
packageIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAMAAAAoLQ9TAAAAYFBMVEX58bvt0ablyaG/gjHF
gzLbv57Bei3XuZi/dSrBdyvXuJe3bSi7cSrOq4upYCOTVR+uYyWlXCKgWSGiWSLHoIJxPBee
cFh5T0D///8AAAAAAAAAAAAAAAAAAAAAAAAAAAAL0p7aAAAAGXRSTlP/////////////////
//////////////8AATQKtwAAAAFiS0dEHwUNEL0AAAAJcEhZcwAAAEgAAABIAEbJaz4AAABt
SURBVBjTdY9JDoAgEARZVFxAVGTG/79UmkmMmtCHOlSGSlDXb6op8kvYoSwCVsTUGxMImESM
RumZgFGEN1o7AryIJczuZGCpIkciYubCmOvFhh4DmzxZn+gqYn+iu4iEHgFJRHeURaBr/OWz
G0x4EXacxCpnAAAAAElFTkSuQmCC'! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:49'!
glamorousAlarm
	^ self icons
			at: #'glamorousAlarm'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousAlarmIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme-contents' stamp: 'EstebanLorenzano 12/6/2014 15:05'!
glamorousLeftIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAAP//0v//4P//5///6P//7v//7///8P//8v//9v//+f///P/8wf/7zP/1
mv/2uv/61//85v/wnP/wnf/0tv/1uf/63v/74f/wqP/ytP/ztf/1w/720P/41P/sof/uo//w
sf/zwf3zyv/2z//20P7sq//ur/3uuv/xvf7wvf3vvP7zzP70zf/1z//srf7uuv/vvLp/DbuB
EbN0ALFyAK9wALR2AbJ0AbZ2ArJ0AqZqArN1A7J2B7V4CLF1CLh6Ca1sAKRkAKJjAKFjAKNk
AaNlAaNmA69wBKlrBqVpBqdpB59gAaBiBJ9hBKJlCaJmC6RoDZ5cAP///////wAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAFIALAAAAAAQABAAAAd6gFKCg4SFhoeIgjAxiYQ3
UT6NgjJRUTWSM1EICT8zNjg4OjyENAcQFRYDBAQGBQcKO4I9Ag8rISorLCMbIhwBRoJHABop
LiYvKMknIAw5g0AOJSQtHxgZGRMUC0mEQhcdHlBBQ0RERUiGShESS5KCTA1N7oJOT/P384EA
Ow=='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:26'!
workspaceIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAAMzFxqeantvb3v7+//39/t7f4vL1+aG41aS61iJDZ2ePupey0Km/2ER2
qkZ3q0l5rEl6rE19r1SCsu7y9v3+/9/o8Pr9/2iz4W214m+24ni65ITA5rrb8Pf8//X6/fL4
+/n9//j8/vv9/u/6/9Xz/9bz/+j4/+r5/+76//H7//j9//b7/en5/+z6/+36//T8//P7/vf9
//X7/fv+//b9//r+//n9/vf8/fz9/fv+/dvTobu0in91Qol6P4N3QZF+PYl6QJmCO5iCO66N
NaiKN6GGOaCGOcu0drKPNLmcUPDYqOnEfvbmyJN8V5R/XZWBYJN4UY9pOI5pOI9sPpBwQ5Bw
RJJ0So9pOamUj/W5rKmamLZ2b8CEfcikov////7+/v39/f///wAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAGEALAAAAAAQABAAAAfBgGGCg4SFhodhW1tdiIRP
W1lbjYJOBQBckg0Omg8REgsVTUwCWliCFxgXGRobHB9QTEoBUAiCmg0QCgwTVrFLVgYHgkgk
JCUmFFQ6SktVXjlHgkMkLCghXlM7O1EDXzJJgkQkJzAiCVdSUV5gMi1EgkYkKCMhCQleXgQe
KC5GgkIkUqSwgM8LjhUCUwgR9IPEixc0VKiwoeLhwx+CepCI0aGDChAgVMQYGQOIIB8kLFio
MaOly5Y+BPGYSbNmzTCBAAA7'! !

!EclipseUIThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/14/2013 14:27'!
recoverLostChangesIcon
	^ icons
			at: #'recoverLostChangesIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self recoverLostChangesIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:25'!
smallPrintIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAPcAAIyZuI2auYmYuIyauau52K+82rC92hY6gxc6g0NekoqauoqZuIybuZGd
tEBdlFZ0qFRvn1hxn2Z/rWmCrnaNt3qQuH+WvoOZv4ubuVFyp1FxplV1qlV2qlV0qVV1qVV0
qFV1qFV1p1Z1qFZ1p118r2KCtWB/sWWFuGWEt2iIu2iIuoKf0IGezoKfzufw/1N1qVR2qlZ3
qld4q1x9sF+As2uNv2qLvYGgzoKgzoKhzpGftL3O58jW6snW6tDc7ejx/9rj8Nni7+ny/97m
8r3P6LzO573P57/Q6MnX6sjW6dDd7tnj8Nji7/H3//j7/7zP577Q58LU6snY6snX6ebx/+fy
/9nj7+nz/97n8uXx/9nk8Njj756mr+r0//D3/52mr+32//f7//f5+/L5/+3y9vj8/+jv9PX7
//r9//L6//f8//b8/+3z9vf5+vX8//r+//n+//r///v///z//6uwra2wrvv9+vz9+ri4qb68
pry5oMfCoLe1p8jBmsS/o8vClMvClczDmM7FmsG7nMzCls7FnMvDody/befNk9GjQ82gQv//
/////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAIwALAAAAAAQABAAAAjmABkJHEiwYEFB
hP4AClTIIME+iyIuUrTHkENGg944cfIG0aFEfhzqKRPGCRo5cebkcchnjQUKEiA4gIOHIIEa
B+g08ZLmjBo3Y+ogqEGAkY2IX7pcqDAhQgIwXCLaYKTCTpsGVLL8EHKligsdYu6kYISCjJkF
CgAwCDAAAwYBZticYFRiSBArS7ToBQJEyxYmWEowoqFECo8pSBL36JGEhxQfJhiRiHLkieUi
O4g8MQLlSJQZjGTEgOGhQwcPHja8MM0hhgxGBTKwwJGjRY4VtnHfyFBAoAEND0CIGD5CRIgP
GgwwCggAOw=='! !

!EclipseUIThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 9/19/2013 13:04'!
changeRemoveIcon 
	^ self smallCancelIcon! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:23'!
smallCutIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAMQAANjb5r7DzZ2nuba+zBcyXXmHnU1ge2KLs3OVuK7F3WGLsytto0d9q0h9
qxFemxJfnBJfm////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
ACH5BAEAABEALAAAAAAQABAAAAVRYCSOZGmWQnCagDGsZVDAZTGL79oK0VAYI4RwJDAUCwOA
SJGIJA6RAsHgKjFEiYbNqCwtEuDFoJgzPSAOHJA2GggR7AjTCaVdnQ32Nxw/p0khADs='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:25'!
smallRightFlushIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAJEAADk7iUNKh////wAAACH5BAEAAAIALAAAAAAQABAAAAIglI+pyw0cohSv
pWqkntiajmwB5SGdqJHlB23qCq7yfBQAOw=='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:21'!
configurationIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAJKAiruyu4t8jYR5j4B2kXZxlXGFrH2RuX6RuYaawmJ3nWN3nHGFq4uW
q1Vrj1Zrj/v9//j8//r9//H6//T7//f8/+35//D6//P7//b8//n9//z+/+z5/+/6//L7/9Xz
/+v5/+76//H7//X8//j9/+z6//T8/+77//P8//f9//v+//b9//r+//n+/////////wAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAC8ALAAA
AAAQABAAAAaOwFdjSCwahZ+kcqlsIEGAKGhKnTobH0DAFQBwOKXSt3T9CFxogSWBYCweoTJh
GyB0Oqf7vTwp+EWAExciFxdlHogYGB4oih6KZSZRACMjJiMUlyZlWlwAKxkrFSkVGWVnAy4C
JAkHBgoOEXJ0BC0sEhq3EmUQfgUQECrCwhBlG8fIycdXRs1EL9DR0tMvQQA7'! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:23'!
smallExportIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAD8/nz9fn0xnl1FtnlFsnVRvoVBtnVNwoVFtnVJunVh0pFh0o1h1o1l1
o1x4p198q2B9q197qGN/rWR/rWaCr4WhzYahzZ2z1l99q199qmOArYWizYaizYaizJCq0qe7
2qe82q/B3TNwpDNwo0B3pw1cmv///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAACYALAAA
AAAQABAAAAZmQJNwSCwaj0gjaVQqJYkkkfMpLEWppimJCjBGKGBiYAguh0KUYZd8pmhCGolw
TJRIQpPHB/LMgDAOFw5PgQ4NHgkKDAuMjY0eCwccHBscFpUbGx0cFZQFAgYGAwgGpKEIqASo
WERBADs='! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'TudorGirba 12/6/2014 22:09'!
glamorousPlay
	^ self icons
			at: #'glamorousPlay'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousPlayIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme-contents' stamp: 'EstebanLorenzano 12/6/2014 15:05'!
glamorousBookmarkIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAADpIYzxKZj1LZmhziWx1hzxLZj1LZUVTbU9eeEpZclVkfVppgl9uhnF4
g2V1jGNyib/J1tHW3WOq/2So/2Sq/2ar/22w/26w/+bx/8rR2mCq/2mw/2qv/3G0/wBTpABP
ogBPoQBNnXK3/3K5/3S6/+n0/+32/wBdsABZqgBVo3G6/3a9/+j0/wBluABktgBitQBer3fB
/3jC/wBpvABnuXfD/3h8f/L6//b9//v//36Be4aEdo2IcoFzPp2SaJmPa5SMbv///////wAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAEIALAAAAAAQABAAAAewgEI9g4NChjOIM4VCPkGO
QYMzMpMzQT4OjI+PkpSWmD9BERmbkzKVP5hAjxAQQTMxMTWVQA9CPDmiObotK700OTwMQjs4
xaw4LyTKLjg7C0I6N6I31CciKiMwNzoKQjYm4KwmKB3lKCY2CEINJe3uHhcWFiksDQlCBPn5
GBgfGxscQOQ7YMiAwQEIQ1SYQCFEAAMCDEksAABACAkhNISQyJFjiI0fO4oUspHkyJMcAwEA
Ow=='! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
testRunnerIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAKIAAAAAgD9fvwCAgICAAICAgAAAAP///wAAACH5BAEAAAYALAAAAAAQABAA
AAM0aLrc/pANECIDpdhFANhZtnzPh2kFAREZ0QnWqW4nAD8CIXyT5rAnRefhYww3QswNyXwk
AAA7'! !

!EclipseUIThemeIcons methodsFor: 'nautilus' stamp: 'EstebanLorenzano 5/13/2013 16:24'!
dirtyPackageIcon 
	^ icons
			at: #'dirtyPackageIcon'
			ifAbsentPut:[ 
				(self packageIcon asFormOfDepth: 32)
					mergeBottomRightWith: (Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self overlayDirtyIconContents readStream)) ].! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:49'!
glamorousAdd
	^ self icons
			at: #'glamorousAdd'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousAddIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:23'!
smallConfigurationIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAJKAiruyu4t8jYR5j4B2kXZxlXGFrH2RuX6RuYaawmJ3nWN3nHGFq4uW
q1Vrj1Zrj/v9//j8//r9//H6//T7//f8/+35//D6//P7//b8//n9//z+/+z5/+/6//L7/9Xz
/+v5/+76//H7//X8//j9/+z6//T8/+77//P8//f9//v+//b9//r+//n+/////////wAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAC8ALAAA
AAAQABAAAAaOwFdjSCwahZ+kcqlsIEGAKGhKnTobH0DAFQBwOKXSt3T9CFxogSWBYCweoTJh
GyB0Oqf7vTwp+EWAExciFxdlHogYGB4oih6KZSZRACMjJiMUlyZlWlwAKxkrFSkVGWVnAy4C
JAkHBgoOEXJ0BC0sEhq3EmUQfgUQECrCwhBlG8fIycdXRs1EL9DR0tMvQQA7'! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
variable_viewIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQBAMAAADt3eJSAAAAD1BMVEX///+LmKqdprJlfJkz
TG9+bST8AAAAAXRSTlMAQObYZgAAADZJREFUeNpjYMANGB0YGBxBDBEBCGYwYREQYTEAMpwZ
nRyZHVxcGJyBEswOyCJwNXBdcHOIAAD04waDcvfrWwAAAABJRU5ErkJggg=='! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:49'!
glamorousEdit
	^ self icons
			at: #'glamorousEdit'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousEditIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
uncommentedClassIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAMQAAPR4e8gnL/Rmb/Nnb/NYY/JXY+mkqsgZKvLFyvTQ1PT3+8lHPvaSjsk6
OPaIhvaHh////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
ACH5BAEAABAALAAAAAAQABAAAAVHICSOSqmMKKogy4KcqbowzALHorI8jo2TDQCgccMpAoJB
oBhTHAqEAzOlMLQMU+pB+ut6IYlW4qtz9LKkg5nbXW1fZNP3GwIAOw=='! !

!EclipseUIThemeIcons methodsFor: '*Komitter-UI' stamp: 'EstebanLorenzano 12/13/2013 14:44'!
historyIcon
	^ icons
			at: #'historyIcon'
			ifAbsentPut:[ Pharo3UIThemeIcons form16x16FromContents: self historyIconContents ].! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:24'!
smallHomeIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAOYAACM+gCdBhNre6BM0fC5NjxI0fCE/fV17r9ne505upU9uo1Z1qld3qlh3
qlt6rlt6rVt6rF59sF58r2KCtWOCtdje5yJHeSBHednh69fe59be5+30/PL4/+bx++f0/+Xx
+8zX4Ov2//H5//j8/+Dw+yRTciVUct/y/uT0/ef2//X6/eL1/+v3/eb3/+b4//T8/y1kbClh
Zv7//zt/ZDZ6XTyFYD2GXzmEW2JmYWdtZWzBOmhtZW9za7reHWVmX+3rAvPzBWhoXJOTg66r
cpOPW66qc//7zpOSg396TWhmW//1v5SRgZSQgP/yv//qqv/srXJtXJiTgm5pWp2Te5mRfv/e
lv/fmJ6VgP/Pc6KVfP/PdP/Ug6WVeaSVeqGTeaaWe54/NaBCN59FOv///////wAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAGQALAAAAAAQABAAAAewgGSCg4SFhWJFgl+GhUNg
ZF1GXIyDYURZSlBNXpRkSFdPUhhSTlOUUVZBFWMVSVVUhktbPgJjtgI+W0yER1g4CGM3NTdj
CDhaQoM8Oxm2Nj82tho5PIQFIDJjNDM0YzIgA4UEYyojtmMjKmMEhQovGyIxMDEcGy8JhRMs
HyEmQCUhOrCgUCgCChIeLPS4kIIECgmFIKw40cKADgMuTqxwUOgBgwUHAAQAcGBBAwiCAgEA
Ow=='! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:49'!
glamorousRightSide
	^ self icons
			at: #'glamorousRightSide'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousRightSideIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 9/19/2013 13:04'!
changeUpdateIcon 
	^ self smallForwardIcon! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
logical_package_objIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAPbpu/PhsvXjtfDesu7br+zZrsGYRPLaquzXrubTrPDo2Pjw4Pjy5uzR
pezSpuzTqOjMoefLoOzQpefLoeXLo+DDnOHFnuPHoODEnt7Dn93CnvPr4MWDMty/mti7mPPq
38F6Lb13LNS0kde3lNm6l9e5lrpxKtOyj9Gwj9S0kte3lfDo4Ojg2KZeI5NVH6phJLBmJ8qm
h6JZInE8F3A2F55wWHlPQMCooP///wAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAADgALAAA
AAAQABAAAAaEQJxwSCwai7MjEcQEuZqgIwjgKNUIAUzUaHhARrWJpBI6zjYf1k1BQpmG0Gfz
Vqu5krhp9ZoFMQoaMEMhXmBiZAsHFy9DJh4qMTYpbSYrFx0tQjMudTaedS40BjIcQzADESI2
CYCCRi8CDSQ1CIqMRi0UFic1GZeZRhwywy7DpEpDeEdBADs='! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 15:49'!
glamorousRight
	^ self icons
			at: #'glamorousRight'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousRightIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: 'nautilus' stamp: 'EstebanLorenzano 5/13/2013 17:15'!
protocolProtectedIcon
	^ icons
			at: #'protocolProtectedIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self protocolProtectedIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme-contents' stamp: 'EstebanLorenzano 12/6/2014 15:05'!
glamorousRefreshIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAPj46P797/jwsPvwtPnolPjomPvpnvndevDYgPHag/jgiPDgqPHTc/ve
hcOWHcKZIPjQYPjYePjYgPnNX72EFrF4E7uBFbqBFbZ8FLZ9FLZ9FbqBFqhuEK1yEaluEahu
Ea1yEq1zEqxyEqxzEqZrEP///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAACUALAAA
AAAQABAAAAZlwJJwOKRQiEgiJXBMIi2BwGWzcQoxhIF2kNBYKweDWMx4WEGTBgjdGFlLnomn
9JlwikKjkETaF5klFABNToICRgALhEgUCgKPjwgOVhkRBZcFERhvISAiEhAdb0MkEH2je6eo
q0EAOw=='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:21'!
forwardIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAP797/375v332f765vzyyv732f732v322f322vzpqPztuf3yyf3yyv72
2fvgjPzkmfvkmfzoqPzoqf3tufvdg/zgjPzjmb2EFq51Erd9FLd+FLV7FLV8FLyCFrmAFbuC
FqtwEatxEaluEa90Eq1yEqdsEKZrEP///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAACcALAAA
AAAQABAAAAZkwJNwSCwaj0ji5ZIsdgCd5vADAHyMnqzWMwgMPERNo1FAHAyCggAhyAw3DMaC
EF/I7QyOEDPpK/4TCoGCI0IkEogRihESCYwkRCGSISCUDxAWIVIiFQ4iUiclFCWgJyYmpalS
QQA7'! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme-contents' stamp: 'EstebanLorenzano 12/6/2014 15:05'!
glamorousIntoIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAMQAADpDX2d8lVaJtE9ZX9bAfdK6d/zjn9nFj/zlp/712/745/767/zos/3s
wP3wz7OAG6t4GaJtFf///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
ACH5BAEAABIALAAAAAAQABAAAAVCoCSOZGmeaFo+bHugzyLPTwG3D6E86vgkvJ7k4QimWo1W
CsJoNiGqCGIaEUYMVZMgEBCMspJtVzIAAAan8lnIPoUAADs='! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:26'!
toolsIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUyALJ5KP38+v313PjQgPjgoLCLIceLN8ymcKttJfjYkPjgmMabX6ttIrqX
JqtnHbp/KO7z+OHr9/jomP3y141PFPrcmujQiP3v0ZxbF/zpv/jTh9e6lvDYkKh4SKNnHd7K
s7eBNdiwcPzwzv3v1L2Wavrgqvrosrp5KODAePrlsPjYiNHf7sF/K/jQeJxhH/josPjwyIGY
sv///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAADIALAAA
AAAQABAAAAZ/QJlwSCwSDUiDseggNpcylkTCsaBCrGyW+IB5v+AH8fQqm88dIoDAJgDeoMVh
fljIGIk8Q8E3iQSAAhsyHioqCIaGKRMFjQVCGC0IA5QDGiUjMQ0NMUIUCC2hoRUZFzEBAZ1C
LqytJB8xEagRqlAxKxAQK7VLtyu/vL0xw1DFQQA7'! !

!EclipseUIThemeIcons methodsFor: 'private' stamp: 'EstebanLorenzano 5/10/2013 12:26'!
smallUndoIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQANUAAPz62f385vz52f797/375v352f775vvws/vwtPvxtPvpnvvpn/vjke7Y
i/vllvvll/vontzKi/von+rftPvehfvfifvgifvhjfvijc24dfvjkt7VudS2X8KpZtK/htfH
mLaWScOrcs68k7yDFb2EFryDFrN5E7qAFbqBFbV8FLyCFrh+FatxEaluEa1zEqtxErB2E6Zr
EKhtEadsEf///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAADQALAAA
AAAQABAAAAaAQJpwSCwaj7QNyXMkkYidybNIGkyF1atwNBiUhqPJQEVEEQwGVOaEigQmoeFK
QC8UGg1AQRCJ01IIgQkHCAeDgSEfNCYQCxIKCwsQk44NJkMwDw4PnA6enjCKQy4MGhoMqAwc
LqJELBgXFy8vICJINC0VFi23RDMUMr1EMTHCxkEAOw=='! !

!EclipseUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/23/2013 10:52'!
protocolProtectedIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQAMQAAP/ysP/pkf/qkbeTJb6cKLuYJ7uZJ//mmK6HH7ONIrKNIriTJP/efad+
HKqBHaqCHq6HIP7bjP7elv7PbP///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
ACH5BAEAABQALAAAAAAQABAAAAUzICWOZGmeaKquJUGwFAEAr1oIeGCky8H8jMMApYhMjpNI
IgWROCWIlcP5gDUasKx2CwsBADs='! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme-contents' stamp: 'EstebanLorenzano 12/6/2014 15:48'!
glamorousSpawnIconContents
	"Private - Method generated"
	^ 'R0lGODlhEAAQALMAACd2UjSAXDOEXDSEXDKDWVircU2nZmGvYYO9gG21Xnm6XaPLiqzPjv//
/wAAAAAAACH5BAEAAA0ALAAAAAAQABAAAARIsMlJq2SB2R1QoIPAYSBDWJk3DQwDVN1iBHSw
3O/EGEjv/zlJoEAsGgtBjGHJbAYbmIN0Kn3qANiE1moBKBTcLnjTDZPPaEoEADs='! !

!EclipseUIThemeIcons methodsFor: 'nautilus' stamp: 'EstebanLorenzano 5/10/2013 14:16'!
removeIcon
	^ self smallDeleteIcon! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/6/2014 14:54'!
glamorousAccept 
	^ self smallOkIcon! !

!EclipseUIThemeIcons methodsFor: 'nautilus' stamp: 'EstebanLorenzano 5/13/2013 17:14'!
protocolPrivateIcon
	^ icons
			at: #'protocolPrivateIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self protocolPrivateIconContents readStream) ].! !

!EclipseUIThemeIcons methodsFor: '*Glamour-Morphic-Theme-contents' stamp: 'EstebanLorenzano 12/6/2014 15:05'!
glamorousEditIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAMAAAAoLQ9TAAABgFBMVEXz9fv4+fxjeqfu8vry
9fv5+vz4+ftedqNmfqhqgqxthK1xiLFzibJ8krh+k7qMoMPw9PuBl7yEmr+JnsGRpcfe6Pjd
5/ff6Pfk7Pnn7vnt8vrz9vvc5/ff6fje6Pfh6vjq8Pn2+Pvm7vnw9fvy9vv1+Pv3+ft8cD56
bj56bz55bj56bz+FdTx9bz56bj+KdzuBcT2QejmLdzulhDSlhTSggjWbfzabfzeWfDjgyI+y
ijCuiDGqhjPUsmjUsmnavXzVsmn///8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACDaxknAAAA
QnRSTlP/////////////////////////////////////////////////////////////////
/////////////////////wBEFhAAAAAAAWJLR0R/SL9x5QAAAAlwSFlzAAAASAAAAEgARslr
PgAAAJRJREFUGNNdyusWgUAUhuEZ5/NxpMNQQkwlhciIuP+bktnTsnj32n+e9aHXXyh/LvtC
VfTgBdwcXHMwzp5cQromw1Z9cc3uKcCxYqwMZOSdAOIl6Y+6nWZpEAOcdb2siy4AiSUXVgIQ
2ZrI1iKAvSoX6gHAN4t8gHBGxr12YzqfhAAbSpXPKXQHEHjM9RhzWbAF+OkNnyItNqJnYTsA
AAAASUVORK5CYII='! !

!EclipseUIThemeIcons class methodsFor: 'testing' stamp: 'EstebanLorenzano 10/17/2013 13:34'!
isAbstract 
	^ self ~= EclipseUIThemeIcons! !

!EclipseUIThemeIcons class methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/17/2013 13:33'!
iconSetName 
	^ 'Eclipse'! !

!EclipseUIThemeIcons class methodsFor: 'license' stamp: 'EstebanLorenzano 6/21/2013 11:18'!
LICENSE
	^ '
The icon pack itself is distributed under MIT license. 
The eclipse icons, however, have their own open source license terms, the EPL, who can be found here: 

http://www.eclipse.org/legal/epl-v10.html
'! !

!EdgeGripMorph commentStamp: 'gvc 9/23/2008 11:58'!
Similar to a ProportionalSplitterMorph but designed to attach to an edge of a single morph only.!
!EdgeGripMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/9/2007 14:26'!
themeChanged
	"Update the fill style."

	self fillStyle: self normalFillStyle.
	super themeChanged! !

!EdgeGripMorph methodsFor: 'as yet unclassified' stamp: 'GaryChambers 1/25/2011 13:10'!
defaultHeight
	"Answer the default height for the receiver."
	
	^ProportionalSplitterMorph splitterWidth! !

!EdgeGripMorph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 12/19/2012 17:50'!
bottomLayoutFrame
	"Answer the layout frame for a bottom edge."
	
	^ (0 @ 1 corner: 1 @ 1) asLayoutFrame 
		topLeftOffset: 22 @ SystemWindow borderWidth negated ;
		rightOffset: -22! !

!EdgeGripMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/1/2007 14:33'!
mouseUp: anEvent
	"Change the cursor back to normal if necessary and change the color back to normal."
	
	(self bounds containsPoint: anEvent cursorPoint)
		ifFalse: [anEvent hand showTemporaryCursor: nil].
	self adoptPaneColor: self paneColor! !

!EdgeGripMorph methodsFor: 'accessing' stamp: 'GaryChambers 1/25/2011 13:05'!
fitTargetOwner

	^ fitTargetOwner! !

!EdgeGripMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/1/2007 13:05'!
positionPoint: aPoint
	"Reposition based on ptName."
	
	(#(top bottom) includes: self edgeName)
		ifTrue: [^self position: self left @ aPoint y].
	(#(left right) includes: self edgeName)
		ifTrue: [^self position: aPoint x @ self top].
	^self position: aPoint! !

!EdgeGripMorph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 12/19/2012 17:57'!
rightLayoutFrame
	"Answer the layout frame for a right edge."
	
	^ (1 @ 0 corner: 1 @ 1) asLayoutFrame 
		topLeftOffset: SystemWindow borderWidth negated @ -7 ;
		bottomOffset: SystemWindow borderWidth - 26! !

!EdgeGripMorph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 12/19/2012 17:58'!
topLayoutFrame
	"Answer the layout frame for a top edge."
	
	^ (0 @ 0 corner: 1 @ 0) asLayoutFrame 
		topLeftOffset: 22 @ -29 ;
		bottomRightOffset:  -22 @ (SystemWindow borderWidth - 29)! !

!EdgeGripMorph methodsFor: 'as yet unclassified' stamp: 'GaryChambers 1/25/2011 15:13'!
setTargetBounds: aRect
	"Set the target bounds, taking owner into account if required."

	self target bounds: aRect.
	self fitTargetOwner ifTrue: [
		self fitTargetBoundsInOwner: aRect]! !

!EdgeGripMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/1/2007 14:23'!
normalFillStyle
	"Return the normal fillStyle of the receiver."
	
	^self theme splitterNormalFillStyleFor: self! !

!EdgeGripMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/1/2007 14:26'!
adoptPaneColor: paneColor
	"Change our color too."
	
	super adoptPaneColor: paneColor.
	self fillStyle: self normalFillStyle! !

!EdgeGripMorph methodsFor: 'initialization' stamp: 'GaryChambers 1/25/2011 13:12'!
initialize
	"Initialize the receiver."
	
	super initialize.
	self
		fitTargetOwner: false;
		edgeName: #right;
		extent: self defaultWidth @ self defaultHeight;
		hResizing: #spaceFill;
		vResizing: #spaceFill! !

!EdgeGripMorph methodsFor: 'as yet unclassified' stamp: 'GaryChambers 1/25/2011 13:20'!
setLayoutSizingFor: aSymbol
	"Adjust the sizing for use within table layouts."

	(aSymbol = #left or: [aSymbol = #right])
		ifTrue: [self hResizing: #rigid; vResizing: #spaceFill].
	(aSymbol = #top or: [aSymbol = #bottom])
		ifTrue: [self hResizing: #spaceFill; vResizing: #rigid]! !

!EdgeGripMorph methodsFor: 'accessing' stamp: 'GaryChambers 1/25/2011 13:17'!
edgeName: aSymbol
	"Set the value of edgeName. This is the edge of the target
	that will be manipulated by the grip."

	edgeName := aSymbol.
	self
		setLayoutSizingFor: aSymbol;
		layoutFrame: self gripLayoutFrame;
		layoutChanged! !

!EdgeGripMorph methodsFor: 'accessing' stamp: 'GaryChambers 1/25/2011 13:05'!
fitTargetOwner: anObject

	fitTargetOwner := anObject! !

!EdgeGripMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/1/2007 13:05'!
targetPoint
	"Answer the reference point of the target."

	^self target bounds pointAtSideOrCorner: self edgeName! !

!EdgeGripMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/1/2007 14:20'!
isHorizontal
	"Answer true if the receiver has a horizontal layout."
	
	^self edgeName == #top
		or: [self edgeName == #bottom]! !

!EdgeGripMorph methodsFor: 'event handling' stamp: 'GaryChambers 1/20/2011 11:23'!
mouseMove: anEvent
	"Track the mouse for resizing."
	
	target ifNil: [^self].
	self theme settings fastDragging
		ifTrue: [target doFastReframe: self edgeName] 
		ifFalse: [
			lastMouse at: 1 put: anEvent cursorPoint.
			self targetPoint: lastMouse first - lastMouse last.
			self positionPoint: (lastMouse first - lastMouse second)].! !

!EdgeGripMorph methodsFor: 'accessing' stamp: 'gvc 7/30/2009 13:58'!
target: aMorph
	"Set the value of target"

	target := aMorph! !

!EdgeGripMorph methodsFor: 'geometry' stamp: 'gvc 10/19/2007 21:25'!
extent: aPoint
	"If our minor extent changes then adopt the pane colour to
	reflect any size based gradient in the theme.
	Assumes fillStyle will not change on the major extent for
	performance reasons."

	|ext|
	ext := self extent.
	super extent: aPoint.
	self isHorizontal
		ifTrue: [self extent y ~= ext y ifTrue: [
					self adoptPaneColor: self paneColor]]
		ifFalse: [self extent x ~= ext x ifTrue: [
					self adoptPaneColor: self paneColor]]
	! !

!EdgeGripMorph methodsFor: 'as yet unclassified' stamp: 'gvc 12/3/2007 15:11'!
splitsTopAndBottom
	"Answer true if the receiver has a horizontal layout."
	
	^self isHorizontal! !

!EdgeGripMorph methodsFor: 'actions' stamp: 'gvc 10/1/2007 13:05'!
resizeCursor

	^ Cursor resizeForEdge: self edgeName! !

!EdgeGripMorph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 12/19/2012 17:56'!
leftLayoutFrame
	"Answer the layout frame for a left edge."
	
	^ (0 @ 0 corner: 0 @ 1) asLayoutFrame 
		topOffset: -7; 
		bottomRightOffset: SystemWindow borderWidth @ (SystemWindow borderWidth - 26)! !

!EdgeGripMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/1/2007 14:23'!
pressedFillStyle
	"Return the pressed fillStyle of the receiver."
	
	^self theme splitterPressedFillStyleFor: self! !

!EdgeGripMorph methodsFor: 'as yet unclassified' stamp: 'GaryChambers 1/25/2011 13:13'!
fitTargetBoundsInOwner: aRect
	"Reset the target bounds if required to
	ensure that the owner's submorphs fit within the owner's
	exisiting bounds when layed out."

	|ownerMinExt targetOwner|
	targetOwner := self target owner ifNil: [^self].
	ownerMinExt :=  targetOwner minExtent.
	ownerMinExt x > self target owner width
		ifTrue: [self edgeName = #left
				ifTrue: [self target bounds: (aRect left + (ownerMinExt x - targetOwner width) @ aRect top extent: (aRect width - (ownerMinExt x - targetOwner width)) @ aRect height)]
				ifFalse: [self target bounds: (aRect origin extent: (aRect width - (ownerMinExt x - targetOwner width)) @ aRect height)]].
	ownerMinExt y > self target owner height
		ifTrue: [self edgeName = #top
				ifTrue: [self target bounds: (aRect left @ (aRect top + (ownerMinExt y - targetOwner height)) extent: aRect width @ (aRect height - (ownerMinExt y - targetOwner height)))]
				ifFalse: [self target bounds: (aRect origin extent: aRect width @ (aRect height - (ownerMinExt y - targetOwner height)))]]
		
	! !

!EdgeGripMorph methodsFor: 'as yet unclassified' stamp: 'GaryChambers 1/25/2011 13:10'!
defaultWidth
	"Answer the default width for the receiver."
	
	^ProportionalSplitterMorph splitterWidth! !

!EdgeGripMorph methodsFor: 'event handling' stamp: 'GaryChambers 1/24/2011 13:11'!
mouseDown: anEvent
	"Remember the receiver and target offsets too."
	
	|cp|
	(self bounds containsPoint: anEvent cursorPoint)
		ifTrue: [self fillStyle: self pressedFillStyle].
	cp := anEvent cursorPoint.
	lastMouse := {cp. cp - self position. cp - self targetPoint}.
	self eventHandler
		ifNotNil: [self eventHandler mouseDown: anEvent fromMorph: self]
! !

!EdgeGripMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/1/2007 14:03'!
gripLayoutFrame
	"Answer the layout frame dependinbg on our edge."
	
	self edgeName == #top ifTrue: [^self topLayoutFrame].
	self edgeName == #bottom ifTrue: [^self bottomLayoutFrame].
	self edgeName == #left ifTrue: [^self leftLayoutFrame].
	^self rightLayoutFrame! !

!EdgeGripMorph methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 7/9/2014 21:39'!
targetPoint: aPoint
	"Set the reference point of the target."

	|minExt rect |
	rect := self target bounds withSideOrCorner: self edgeName setToPoint: aPoint.
	minExt := (self target layoutPolicy notNil and: [self target layoutPolicy isTableLayout])
		ifTrue: [self target layoutPolicy minExtentOf: self target in: self target layoutBounds]
		ifFalse: [self target minimumExtent].
	rect width <= minExt x ifTrue: [
		rect := self edgeName = #left
			ifTrue: [rect withSideOrCorner: #left setToPoint: self target bounds bottomRight - minExt]
			ifFalse: [rect withSideOrCorner: #right setToPoint: self target bounds topLeft + minExt]].
	rect height <= minExt y ifTrue: [
		rect := self edgeName = #top
			ifTrue: [rect withSideOrCorner: #top setToPoint: self target bounds bottomRight - minExt]
			ifFalse: [rect withSideOrCorner: #bottom setToPoint: self target bounds topLeft + minExt]].
	self setTargetBounds: rect! !

!EdgeGripMorph methodsFor: 'accessing' stamp: 'gvc 2/12/2007 16:43'!
target
	"Answer the value of target"

	^ target! !

!EdgeGripMorph methodsFor: 'accessing' stamp: 'gvc 10/1/2007 13:03'!
edgeName
	"Answer the value of edgeName"

	^ edgeName! !

!EditableDropListMorph commentStamp: 'LaurentLaffont 3/31/2011 21:04'!
I'm a DropListMorph which content can be modified.

Try:

(EditableDropListMorph
        on: [#(one two three)]
        list: #value
        selected: nil
        changeSelected: nil) openInWindow extent: 400@20.!
!EditableDropListMorph methodsFor: 'protocol' stamp: 'alain.plantec 4/8/2009 10:41'!
ghostText: aText
	self contentMorph ghostText: aText
! !

!EditableDropListMorph methodsFor: 'private' stamp: 'alain.plantec 10/20/2009 12:41'!
addToListSel: aSelector
	addToListSel := aSelector! !

!EditableDropListMorph methodsFor: 'private' stamp: 'JurajKubelka 12/27/2013 11:26'!
updateContentMorphWith: aString

	content := aString.
	self contentMorph setText: aString! !

!EditableDropListMorph methodsFor: 'drawing' stamp: 'EstebanLorenzano 5/15/2014 17:48'!
newContentMorph
	"Answer a new content morph"
	
	| pt |
	pt := PluggableTextFieldMorph new
		convertTo: String;
		alwaysAccept: true;
		on: self
		text: #content
		accept: #content:
		readSelection: nil
		menu: nil;
		acceptOnCR: true;
		getEnabledSelector: nil;
		font: self theme textFont;
		cornerStyle: (self theme textEntryCornerStyleIn: self);
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		borderStyle: (BorderStyle simple width: 0);
		hideScrollBarsIndefinitely;
		setBalloonText: nil.
		
	pt textMorph autoFit: true;
		wrapFlag: false;
		margins: self theme editableDropListMargins.
		
	^ pt! !

!EditableDropListMorph methodsFor: 'accessing' stamp: 'alain.plantec 4/9/2009 10:11'!
converter
	^ self contentMorph converter! !

!EditableDropListMorph methodsFor: 'private' stamp: 'alain.plantec 4/9/2009 10:12'!
objectAsString: anObject
	^ self converter objectAsString: anObject! !

!EditableDropListMorph methodsFor: 'accessing' stamp: 'GaryChambers 8/17/2010 16:57'!
adoptPaneColor: paneColor
	"Clear the fill style of the text."
	
	super adoptPaneColor: paneColor.
	self contentMorph fillStyle: Color transparent ! !

!EditableDropListMorph methodsFor: 'private' stamp: 'alain.plantec 4/9/2009 11:03'!
default: anObject 
	self contentMorph default: anObject! !

!EditableDropListMorph methodsFor: 'accessing' stamp: 'AlainPlantec 12/3/2009 06:33'!
font: aFont
	"Set the list and content font"

	self listMorph font: aFont.
	self contentMorph font: aFont! !

!EditableDropListMorph methodsFor: 'protocol' stamp: 'AlainPlantec 12/3/2009 09:10'!
wantsFrameAdornments: aBoolean
	self contentMorph wantsFrameAdornments: aBoolean! !

!EditableDropListMorph methodsFor: 'accessing' stamp: 'alain.plantec 3/13/2009 15:26'!
content
	^ content
! !

!EditableDropListMorph methodsFor: 'layout' stamp: 'FernandoOlivero 4/12/2011 09:45'!
minHeight
	"Answer the minimum height for the drop list."
	
	^self theme textFont height + 7! !

!EditableDropListMorph methodsFor: 'private' stamp: 'alain.plantec 3/13/2009 18:21'!
listHeight
	"Answer the height for the list."
	^(self listMorph listMorph height + 12) min: 200! !

!EditableDropListMorph methodsFor: 'private' stamp: ''!
defaultContents
	"needs nothing to activate the ghostText"
	^ ''! !

!EditableDropListMorph methodsFor: 'private' stamp: 'alain.plantec 3/13/2009 16:30'!
convertTo: aClass 
	self contentMorph convertTo: aClass ! !

!EditableDropListMorph methodsFor: 'accessing' stamp: 'GaryChambers 8/17/2010 17:08'!
enabled: aBoolean
	"Set the value of enabled"
	
	super enabled: aBoolean.
	self
		contentMorph enabled: aBoolean;
		fillStyle: Color transparent ! !

!EditableDropListMorph methodsFor: 'private' stamp: 'StephaneDucasse 9/7/2013 12:37'!
layoutInsetToUse
	"Answer the layout inset that should be used."

	^ 0! !

!EditableDropListMorph methodsFor: 'accessing' stamp: 'CamilloBruni 8/3/2011 19:06'!
content: anObject 
	content := anObject.
	self model perform: addToListSel with: content.
	self listSelectionIndex: (self list indexOf: content).
	self updateList! !

!EditableDropListMorph class methodsFor: 'as yet unclassified' stamp: 'alain.plantec 4/9/2009 09:56'!
on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel useIndex: useIndex addToList: addToListSel class: aClass getEnabled: getEnabledSel 
	^ self
		on: anObject
		list: getListSel
		selected: getSelectionSel
		changeSelected: setSelectionSel
		useIndex: useIndex
		addToList: addToListSel
		class: aClass
		getEnabled: getEnabledSel
		default: '' ! !

!EditableDropListMorph class methodsFor: 'as yet unclassified' stamp: 'alain.plantec 10/20/2009 12:41'!
on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel useIndex: useIndex addToList: addToListSel class: aClass getEnabled: getEnabledSel default: aDefaultValue
	^ (super
		on: anObject
		list: getListSel
		selected: getSelectionSel
		changeSelected: setSelectionSel
		useIndex: useIndex) convertTo: aClass;
		 getEnabledSelector: getEnabledSel;
		 addToListSel: addToListSel;
		 default: aDefaultValue;
		 yourself! !

!EditableList commentStamp: '<historical>'!
This widget allows you to edit a list of items :
- add / remove an item to/from the list 
- order the list by moving elements up/down/top/bottom.

The default behavior is to do a copy of the list. The widget works with its internal copy. It allows the user to accept / reject changes (for example by opening the widget in a DialogWindow) before affecting the original list. It is your responsability to copy EditableList items back to the original list.

The addItemBlock is used to provide a way to give the item to add (e.g. a UIManager default chooseFrom: values:).

Example:
self example!
!EditableList methodsFor: 'api' stamp: 'ChristopheDemarey 7/3/2013 18:16'!
addItemBlock: aBlock
	addItemBlock := aBlock.! !

!EditableList methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/3/2013 18:06'!
downButton
	^ downButton! !

!EditableList methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/3/2013 18:06'!
upButton
	^ upButton! !

!EditableList methodsFor: 'accessing' stamp: 'ChristopheDemarey 6/27/2013 16:54'!
removeButton
	^ removeButton! !

!EditableList methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/26/2013 13:41'!
topButton
	^ topButton! !

!EditableList methodsFor: 'initialization' stamp: 'ChristopheDemarey 9/11/2013 09:59'!
initializeWidgets
	self instantiateModels: #(
		list NewListModel
		addButton ButtonModel
		removeButton ButtonModel
		upButton ButtonModel 
		downButton ButtonModel
		topButton ButtonModel
		bottomButton ButtonModel ).

	addButton
		icon: (Smalltalk ui icons iconNamed: #addIcon);
		help: 'Add a new item to the list'.
	
	removeButton 
		icon: (Smalltalk ui icons iconNamed: #deleteIcon);
		help: 'Remove a item from the list'.
		
	upButton
		icon: (Smalltalk ui icons iconNamed: #upIcon);
		help: 'Move this item up from one element'.
		
	downButton
		icon: (Smalltalk ui icons iconNamed: #downIcon);
		help: 'Move this item down from one element'.
		
	topButton
		icon: (Smalltalk ui icons iconNamed: #topIcon);
		help: 'Move this item on the first position of the list'.

	bottomButton
		icon: (Smalltalk ui icons iconNamed: #bottomIcon);
		help: 'Move this item on the last position of the list'.! !

!EditableList methodsFor: 'initialization' stamp: 'ChristopheDemarey 10/18/2013 13:16'!
initializeDialogWindow: aWindow
	super initializeDialogWindow: aWindow.
	aWindow okAction: [ self performOkAction ]! !

!EditableList methodsFor: 'private' stamp: 'ChristopheDemarey 10/18/2013 13:17'!
performOkAction

	okBlock value! !

!EditableList methodsFor: 'private' stamp: 'ChristopheDemarey 9/10/2013 13:37'!
moveElementAt: index to: newIndex
	| elementToMove orderedList |
	
	(newIndex < 1 or: [ newIndex > list getItems size ]) ifTrue: [ ^self ].
	
	elementToMove := list getItems at: index.	
	orderedList := list getItems asOrderedCollection
		removeAt: index;
		add: elementToMove beforeIndex: newIndex;
		yourself.
	self list: orderedList.
	self list setSelectedIndex: newIndex.! !

!EditableList methodsFor: 'initialization' stamp: 'DucasseStephane 9/10/2014 09:59'!
initialize
	"Initialization code for EditableList"

	title := 'Title' asValueHolder.
	
	super initialize.
	okBlock := [ ].! !

!EditableList methodsFor: 'private' stamp: 'ChristopheDemarey 9/10/2013 10:16'!
list: aList
	list items: aList.! !

!EditableList methodsFor: 'initialization' stamp: 'ChristopheDemarey 9/10/2013 17:18'!
initializePresenter
	super initializePresenter
	
	addButton action: [ | requirement | 
						requirement := addItemBlock value.
						requirement ifNotNil: [ 
							self list: (self list getItems copyWith: requirement) ] ].

	removeButton
		action: [ self list: (list getItems copyWithoutIndex: list selectedIndex) ].
		
	topButton
		action: [ self moveElementAt: list selectedIndex to: 1 ].
	bottomButton
		action: [ self moveElementAt: list selectedIndex to: list getItems size ].
	upButton
		action: [ self moveElementAt: list selectedIndex to: list selectedIndex - 1].
	downButton
		action: [ self moveElementAt: list selectedIndex to: list selectedIndex + 1].
! !

!EditableList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
title
	^ title value! !

!EditableList methodsFor: 'accessing' stamp: 'ChristopheDemarey 6/27/2013 16:48'!
title: aTitle
	title := aTitle ! !

!EditableList methodsFor: 'api' stamp: 'ChristopheDemarey 10/18/2013 13:19'!
okAction: aBlock

	okBlock := aBlock! !

!EditableList methodsFor: 'accessing' stamp: 'ChristopheDemarey 6/27/2013 16:54'!
list
	^ list! !

!EditableList methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/26/2013 13:41'!
bottomButton
	^ bottomButton! !

!EditableList methodsFor: 'accessing' stamp: 'ChristopheDemarey 6/27/2013 16:54'!
addButton
	^ addButton! !

!EditableList class methodsFor: 'instance creation' stamp: 'ChristopheDemarey 9/10/2013 10:25'!
new: aCollection
	^ self new list: aCollection copy.
		! !

!EditableList class methodsFor: 'example' stamp: 'ChristopheDemarey 7/15/2013 17:07'!
example
	| widget |
	
	widget := self new.
	widget
		title: 'Selectors list';
		list: self selectors.

	widget openWithSpec.! !

!EditableList class methodsFor: 'spec' stamp: 'ChristopheDemarey 7/26/2013 13:47'!
spec
	<spec: #default>
	^ SpecLayout composed
		newColumn:
			[ :column | 
			column
				newRow: [ :menuRow | 
							menuRow
								add: #addButton;
								add: #removeButton ]
					height: 25;
				newRow: [ :listRow | 
							listRow
								newColumn: [ :c1 | c1 add: #list ];
								newColumn: [ :c2 | 
											c2
												add: #topButton;
												add: #upButton;
												add: #downButton;
												add: #bottomButton ]
									width: 24 ] ] 
		yourself! !

!EditingState commentStamp: 'StephaneDucasse 2/6/2011 09:56'!
I store the current state of an editing session. An instance of mine is shared by all TextEditor instances that are created during an editing session managed by a TextMorph (see below for more explanations about editing session). The state data are basically made of an undo/redo manager and of all data needed in order to manage text editing undo and redo (mainly all informations for the current and previous selection intervals).
I'm created by a TextEditor at the beginning of an editing session (see TextEditor>>editingStateClass and TextEditor>>editingState). Specializations can be introduced to fit a particular TextEditor subclass need.

Editing session:
An  editing session starts when a TextMorph is created (precisely, when a TextEditor instance is first assigned to a TextMorph editor instance variable). An editing session ends when a TextMorph is deleted. During an editing session, a TextMorph can make use of a lot of TextEditor instances, one at a time. As an example, each time a TextMorph is resized, its editor is released and a new one that fit the TextMorph physical properties  is created. Another example, when a TextMorph loses the keyboard focus, then its editor could be fully released; it is created again when the TextMorph retrieves the focus.
When an editor is created by a TextMorph, the state of the previous TextEditor, stored in its associated EditingState instance, is got and passed to the newly created editor. Thus the editing session remains stable (see TextEditor >> #stateArray and TextMorph >> #installEditorToReplace:). So TextEditor instances are extremely volatile whereas its associated EditingState instance remains during the whole editing session.

Instance Variables:
   emphasisHere <Array of TextAttribute>
   pointBlock <CharacterBlock>
   markBlock <CharacterBlock>
   startOfTyping <Integer>
   previousInterval <Interval>
   previousSelection <Text>
   undoManager <HistoryIterator>
   lastParenLocation <Integer>
   mouseDownInterval <Interval>
   secondarySelectionToken  ** obsolete ** should be removed **

- emphasisHere:
   The TextAttributes that are used for the newly entered text

- pointBlock:
   The CharacterBlock where a selection begins (where the mouse has first pointed)

- markBlock:
   The CharacterBlock where a selection ends

- startOfTyping:
   The index of the first character which has been entered during the currently undoable/redoable portion of text (see TextEditor>>#openTypeIn and TextEditor>>#doneTyping)

- previousInterval:
   Previous interval used for undo/redo actions

- previousSelection:
   The previously selected text for undo/redo actions

- undoManager:
   The undo/redo manager

- lastParenLocation:
   Keep the position of the open parenthesis which corresponds to the last entered close parenthesis

- mouseDownInterval:
   The position of the first mouse down in the editor
!
!EditingState methodsFor: 'accessing' stamp: 'AlainPlantec 2/11/2011 15:51'!
emphasisHere: aListOfTextAttribute 
	emphasisHere := aListOfTextAttribute
				ifNotNil: [:l | l reject: [:a | TextSelectionColor = a class]]! !

!EditingState methodsFor: 'accessing' stamp: 'AlainPlantec 11/9/2010 15:04'!
lastParenLocation
	^ lastParenLocation! !

!EditingState methodsFor: 'accessing' stamp: 'AlainPlantec 11/9/2010 15:04'!
markBlock: aCharacterBlock
	markBlock := aCharacterBlock! !

!EditingState methodsFor: 'accessing' stamp: 'AlainPlantec 11/9/2010 15:04'!
pointBlock: aCharacterBlock
	pointBlock := aCharacterBlock.
! !

!EditingState methodsFor: 'undo-redo' stamp: 'AlainPlantec 11/9/2010 15:04'!
addUndoRecord: anUndoRecord
	self undoManager isPlugged 
		ifTrue: [self undoManager clearRedoHistory.
			self undoManager addRecord: anUndoRecord]

! !

!EditingState methodsFor: 'accessing' stamp: 'AlainPlantec 11/9/2010 15:04'!
startOfTyping
	^ startOfTyping! !

!EditingState methodsFor: 'accessing' stamp: 'AlainPlantec 11/9/2010 15:04'!
emphasisHere
	^ emphasisHere! !

!EditingState methodsFor: 'events' stamp: 'AlainPlantec 11/19/2010 10:45'!
focused: aBoolean from: aTextMorph
	(aBoolean and: [aTextMorph sharesFindReplace])
		ifTrue: [[(EditorFindReplaceDialogWindow on: aTextMorph) comeToFront] on: Error do: []].! !

!EditingState methodsFor: 'undo-redo' stamp: 'AlainPlantec 11/9/2010 15:04'!
redo
	^ self undoManager redo ! !

!EditingState methodsFor: 'events' stamp: 'AlainPlantec 11/15/2010 09:54'!
handlesKeyboard: evt from: aTextMorph
	^ false! !

!EditingState methodsFor: 'accessing' stamp: 'AlainPlantec 11/8/2010 15:03'!
secondarySelectionToken
	^ secondarySelectionToken ! !

!EditingState methodsFor: 'events' stamp: 'AlainPlantec 11/19/2010 10:46'!
mouseDown: anEvent from: aTextMorph
	self mouseDownInterval: aTextMorph editor selectionInterval.
	self focused: true from: aTextMorph
! !

!EditingState methodsFor: 'undo-redo' stamp: 'AlainPlantec 12/13/2010 22:48'!
clearUndoManager: aKeyboardEvent
	self undoManager reset.
	^ true! !

!EditingState methodsFor: 'accessing' stamp: 'AlainPlantec 11/9/2010 15:04'!
mouseDownInterval: anInterval
	mouseDownInterval := anInterval! !

!EditingState methodsFor: 'accessing' stamp: 'AlainPlantec 11/9/2010 15:04'!
startOfTyping: anIntegerIndex
	startOfTyping := anIntegerIndex! !

!EditingState methodsFor: 'accessing' stamp: 'AlainPlantec 11/9/2010 15:04'!
markBlock
	^ markBlock! !

!EditingState methodsFor: 'accessing' stamp: 'AlainPlantec 12/14/2010 13:09'!
undoManager

	^ undoManager ifNil: [ undoManager := HistoryIterator new].
! !

!EditingState methodsFor: 'accessing' stamp: 'AlainPlantec 11/9/2010 15:04'!
mouseDownInterval
	^ mouseDownInterval! !

!EditingState methodsFor: 'accessing' stamp: 'AlainPlantec 11/9/2010 14:45'!
secondarySelectionToken: aTextOrStringOrRegex
	secondarySelectionToken := (aTextOrStringOrRegex isText ifTrue: [aTextOrStringOrRegex asString] ifFalse: [aTextOrStringOrRegex])! !

!EditingState methodsFor: 'undo-redo' stamp: 'AlainPlantec 11/9/2010 15:04'!
undo
	^ self undoManager undo ! !

!EditingState methodsFor: 'accessing' stamp: 'AlainPlantec 11/9/2010 15:04'!
lastParenLocation: anIntegerIndex
	lastParenLocation := anIntegerIndex! !

!EditingState methodsFor: 'accessing' stamp: 'AlainPlantec 11/9/2010 15:04'!
previousInterval

	^ previousInterval ifNil: [previousInterval := 1 to: 0]! !

!EditingState methodsFor: 'private-debugging' stamp: 'AlainPlantec 11/9/2010 15:04'!
exploreUndoManager: aKeyboardEvent
	self undoManager explore.
	^ true! !

!EditingState methodsFor: 'accessing' stamp: 'AlainPlantec 11/9/2010 15:04'!
previousSelection

	^ previousSelection ifNil: [previousSelection := '' asText]! !

!EditingState methodsFor: 'accessing' stamp: 'AlainPlantec 11/9/2010 15:04'!
previousInterval: anInterval selection: aSelection

	previousInterval := anInterval.
	previousSelection := aSelection.
! !

!EditingState methodsFor: 'accessing' stamp: 'AlainPlantec 11/9/2010 15:04'!
pointBlock
	^ pointBlock! !

!EditingState methodsFor: 'accessing' stamp: 'AlainPlantec 11/9/2010 15:04'!
unselect
	self markBlock: self pointBlock copy! !

!EditingState methodsFor: 'events' stamp: 'AlainPlantec 11/22/2010 12:03'!
keystroke: aKeyboardEvent from: aTextMorph
! !

!EditingState methodsFor: 'undo-redo' stamp: 'AlainPlantec 12/14/2010 14:42'!
redoArray: doArray undoArray: undoArray
	self undoManager isPlugged 
		ifTrue: [self undoManager redoArray: doArray undoArray: undoArray]! !

!Editor commentStamp: 'AlainPlantec 11/2/2010 18:23'!
New text editors.
TextEditor provides most of the functionality that used to be in TextMorphEditor. This class is no longer a Controller!!
SmalltalkEditor has Smalltalk code specific features.
SimpleEditor provides basic functionality for single line text editing. It does not handle fonts and styles, aligning and Smalltalk utilities. It handles one single line.
!
!Editor methodsFor: 'nonediting/nontyping keys' stamp: 'AlainPlantec 11/8/2010 22:08'!
escape: aKeyboardEvent
	self morph escapePressed.
	^ false  ! !

!Editor methodsFor: 'accessing' stamp: 'FernandoOlivero 6/9/2011 16:07'!
markBlock: aCharacterBlock 
	self editingState markBlock:  aCharacterBlock! !

!Editor methodsFor: 'nonediting/nontyping keys' stamp: 'AlainPlantec 11/8/2010 22:08'!
escape 
	self morph escapePressed .
	! !

!Editor methodsFor: 'new selection' stamp: 'AlainPlantec 2/7/2011 09:12'!
selectInvisiblyAt: characterIndex 
	"Place the caret before the character at characterIndex.
	 Be sure it is in view but vithout any further action."
	
	self selectInvisiblyFrom: characterIndex to:  characterIndex - 1
! !

!Editor methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
theme
	^ Smalltalk ui theme ! !

!Editor methodsFor: 'new selection' stamp: 'AlainPlantec 11/8/2010 22:08'!
selectMark: mark point: point
	"Select the specified characters inclusive.
	 Be sure the selection is in view."

	(mark =  self markIndex and: [point + 1 = self pointIndex]) ifFalse:
		[self deselect.
		self selectInvisiblyMark: mark point: point]! !

!Editor methodsFor: 'accessing' stamp: 'AlainPlantec 11/8/2010 22:08'!
morph
	^ morph! !

!Editor methodsFor: 'testing' stamp: 'AlainPlantec 11/8/2010 22:08'!
isTextEditor
	^ false ! !

!Editor methodsFor: 'new selection' stamp: 'AlainPlantec 11/8/2010 22:08'!
selectInvisiblyFrom: start to: stop
	"Select the designated characters, inclusive.  Make no visual changes."

	self markIndex: start; pointIndex: stop + 1! !

!Editor methodsFor: 'accessing' stamp: 'AlainPlantec 11/8/2010 22:08'!
currentAttributes
	"Redefined by subclasses that handle TextAttributes"
	^nil! !

!Editor methodsFor: 'menu messages' stamp: 'AlainPlantec 11/8/2010 22:08'!
lineSelectAndEmptyCheck: returnBlock
	"If the current selection is an insertion point, expand it to be the entire current line; if after that's done the selection is still empty, then evaluate the returnBlock, which will typically consist of '[^ self]' in the caller -- check senders of this method to understand this."

	self selectLine.  "if current selection is an insertion point, then first select the entire line in which occurs before proceeding"
	self hasSelection ifFalse: [morph flash.  ^ returnBlock value]! !

!Editor methodsFor: 'editing keys' stamp: 'AlainPlantec 11/8/2010 22:08'!
noop: aKeyboardEvent 
	"Unimplemented keyboard command; just ignore it."

	^ true! !

!Editor methodsFor: 'typing/selecting keys' stamp: 'CamilloBruni 8/1/2012 16:16'!
selectAll: aKeyboardEvent 
	"select everything"

	self closeTypeIn.
	self selectFrom: 1 to: self string size.
	^ true! !

!Editor methodsFor: 'editing keys' stamp: 'AlainPlantec 11/8/2010 22:08'!
cut: aKeyboardEvent 
	"Cut out the current text selection."

	self cut.
	^true! !

!Editor methodsFor: 'new selection' stamp: 'AlainPlantec 11/8/2010 22:08'!
selectInvisiblyMark: mark point: point
	"Select the designated characters, inclusive.  Make no visual changes."

	self markIndex: mark; pointIndex: point + 1! !

!Editor methodsFor: 'editing keys' stamp: 'AlainPlantec 11/8/2010 22:08'!
copySelection: aKeyboardEvent
	"Copy the current text selection."

	self copySelection.
	^true! !

!Editor methodsFor: 'testing' stamp: 'AlainPlantec 11/8/2010 22:08'!
isSimpleEditor 
	^ false ! !

!Editor methodsFor: 'private' stamp: 'CamilloBruni 6/21/2012 18:27'!
moveCursor: directionBlock forward: forward specialBlock: specialBlock event: aKeyboardEvent
	"Private - Move cursor.
	directionBlock is a one argument Block that computes the new Position from a given one.
	specialBlock is a one argumentBlock that computes the new position from a given one under the alternate semantics.
	Note that directionBlock always is evaluated first."
	| shift indices newPosition |
	self morph manageCursor.
	shift := aKeyboardEvent shiftPressed.
	indices := self setIndices: shift forward: forward.
	newPosition := directionBlock value: (indices at: #moving).
	(aKeyboardEvent commandKeyPressed or: [ aKeyboardEvent controlKeyPressed ])
		ifTrue: [newPosition := specialBlock value: newPosition].
	shift
		ifTrue: [self selectMark: (indices at: #fixed) point: newPosition - 1]
		ifFalse: [self selectAt: newPosition]! !

!Editor methodsFor: 'nonediting/nontyping keys' stamp: 'IgorStasenko 10/7/2013 11:31'!
cursorLeft: aKeyboardEvent 
	"Private - Move cursor left one character if nothing selected, otherwise 
	move cursor to beginning of selection. If the shift key is down, start 
	selecting or extending current selection. Don't allow cursor past 
	beginning of text"

	self closeTypeIn.
	self      
		moveCursor:[:position | 
			self class skipOverMultipleSpaces 
				ifTrue: [ self previousNonBlank: position ]
				ifFalse: [ position - 1 max: 1 ]
			 ]
		forward: false
		specialBlock:[:position | self previousWord: position]
		event: aKeyboardEvent.
	^ true! !

!Editor methodsFor: 'settings' stamp: 'AlainPlantec 11/8/2010 22:08'!
cmdKeysInText
	^ self class cmdKeysInText! !

!Editor methodsFor: 'testing' stamp: 'AlainPlantec 11/8/2010 22:08'!
isSmalltalkEditor
	^ false ! !

!Editor methodsFor: 'private' stamp: 'AlainPlantec 11/8/2010 22:08'!
setIndices: shiftPressed forward: forward
	"Little helper method that sets the moving and fixed indices according to some flags."
	| indices |
	indices := Dictionary new.
	self flag: 'to be reviewed'.
	(shiftPressed)
		ifTrue: [
			indices at: #moving put: self pointIndex.
			indices at: #fixed put: self markIndex
		] ifFalse: [
			forward
				ifTrue:[
					indices at: #moving put: self stopIndex.
					indices at: #fixed put: self startIndex.
				] ifFalse: [
					indices at: #moving put: self startIndex.
					indices at: #fixed put: self stopIndex.
				]
		].
	^indices! !

!Editor methodsFor: 'nonediting/nontyping keys' stamp: 'IgorStasenko 10/7/2013 11:30'!
cursorRight: aKeyboardEvent 
	"Private - Move cursor right one character if nothing selected, 
	otherwise move cursor to end of selection. If the shift key is down, 
	start selecting characters or extending already selected characters. 
	Don't allow cursor past end of text"

	self closeTypeIn.
	self
		moveCursor: [:position |
			self class skipOverMultipleSpaces 
				ifTrue: [ self nextNonBlank: position ] 
				ifFalse: [ position + 1 ]
			]
		forward: true
		specialBlock:[:position | self nextWord: position]
		event: aKeyboardEvent.
	^ true! !

!Editor methodsFor: 'accessing-selection' stamp: 'jmv 11/4/2008 14:02'!
unselect
	self markIndex: self pointIndex! !

!Editor methodsFor: 'new selection' stamp: 'AlainPlantec 11/8/2010 22:08'!
selectInterval: anInterval
	"Select the specified characters inclusive.
	 Be sure the selection is in view."

	self selectFrom: anInterval first to: anInterval last! !

!Editor methodsFor: 'nonediting/nontyping keys' stamp: 'AlainPlantec 11/8/2010 22:08'!
cursorDown: aKeyboardEvent 

	"Private - Move cursor from position in current line to same position in
	next line. If next line too short, put at end. If shift key down,
	select."

	self closeTypeIn.
	self 
		moveCursor:[:position | self
				sameColumn: position
				newLine:[:line | line + 1]
				forward: true]
		forward: true
		specialBlock:[:dummy | dummy]
		event: aKeyboardEvent.
	^true! !

!Editor methodsFor: 'new selection' stamp: 'AlainPlantec 11/8/2010 22:08'!
selectWord
	"Select delimited text or word--the result of double-clicking."

	| openDelimiter closeDelimiter direction match level leftDelimiters rightDelimiters
	string here hereChar start stop |
	string := self string.
	here := self pointIndex.
	(here between: 2 and: string size)
		ifFalse: ["if at beginning or end, select entire string"
			^self selectFrom: 1 to: string size].
	leftDelimiters := '([{<''"
'.
	rightDelimiters := ')]}>''"
'.
	openDelimiter := string at: here - 1.
	match := leftDelimiters indexOf: openDelimiter.
	match > 0
		ifTrue: 
			["delimiter is on left -- match to the right"
			start := here.
			direction := 1.
			here := here - 1.
			closeDelimiter := rightDelimiters at: match]
		ifFalse: 
			[openDelimiter := string at: here.
			match := rightDelimiters indexOf: openDelimiter.
			match > 0
				ifTrue: 
					["delimiter is on right -- match to the left"
					stop := here - 1.
					direction := -1.
					closeDelimiter := leftDelimiters at: match]
				ifFalse: ["no delimiters -- select a token"
					direction := -1]].
	level := 1.
	[level > 0 and: [direction > 0
			ifTrue: [here < string size]
			ifFalse: [here > 1]]]
		whileTrue: 
			[hereChar := string at: (here := here + direction).
			match = 0
				ifTrue: ["token scan goes left, then right"
					hereChar tokenish
						ifTrue: [here = 1
								ifTrue: 
									[start := 1.
									"go right if hit string start"
									direction := 1]]
						ifFalse: [direction < 0
								ifTrue: 
									[start := here + 1.
									"go right if hit non-token"
									direction := 1]
								ifFalse: [level := 0]]]
				ifFalse: ["bracket match just counts nesting level"
					hereChar = closeDelimiter
						ifTrue: [level := level - 1"leaving nest"]
						ifFalse: [hereChar = openDelimiter 
									ifTrue: [level := level + 1"entering deeper nest"]]]].

	level > 0 ifTrue: ["in case ran off string end"	here := here + direction].
	direction > 0
		ifTrue: [self selectFrom: start to: here - 1]
		ifFalse: [self selectFrom: here + 1 to: stop]! !

!Editor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 11/8/2010 22:08'!
selectAll

	self selectFrom: 1 to: self string size! !

!Editor methodsFor: 'private' stamp: 'IgorStasenko 10/7/2013 11:31'!
previousNonBlank: position
	"decrement position up until any non-blank character found, or end of line"
	| string index |
	position <= 1 ifTrue: [ ^ 1 ].
	
	string := self string.
	index := position.
	index := index -1.
	(string at: index) isSeparator ifFalse: [ ^ index ]. 

	[ index > 1 and: [(string at: index-1) isSeparator and: [(string at:index-1) ~= Character cr]]]
		whileTrue: [index := index - 1].
	^ index! !

!Editor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 11/8/2010 22:08'!
lf: aKeyboardEvent 
	"Append a line feed character to the stream of characters."

	self addString: Character lf asString.
	^false! !

!Editor methodsFor: 'private' stamp: 'AlainPlantec 11/8/2010 22:08'!
lines
	"Compute lines based on logical line breaks, not optical (which may change due to line wrapping of the editor).
	Subclasses using kinds of Paragraphs can instead use the service provided by it.
	"
	| lines string index lineIndex stringSize |
	string := self string.
	"Empty strings have no lines at all. Think of something."
	string isEmpty ifTrue:[^{#(1 0 0)}].
	stringSize := string size.
	lines := OrderedCollection new: (string size // 15).
	index := 0.
	lineIndex := 0.
	string linesDo:[:line |
		lines addLast: (Array
			with: (index := index + 1)
			with: (lineIndex := lineIndex + 1)
			with: (index := index + line size min: stringSize))].
	"Special workaround for last line empty."
	string last == Character cr
	"lines last last < stringSize" ifTrue:[lines addLast:{stringSize +1. lineIndex+1. stringSize}].
	^lines! !

!Editor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 11/8/2010 22:08'!
backWord: aKeyboardEvent
	"If the selection is not a caret, delete it and leave it in the backspace buffer.
	 Else, delete the word before the caret."

	| startIndex |
	self hasCaret ifTrue: [ "a caret, delete at least one character"
		startIndex := 1 max: self markIndex - 1.
		[startIndex > 1 and:
			[(self string at: startIndex - 1) tokenish]]
				whileTrue: [
					startIndex := startIndex - 1]]
	ifFalse: [ "a non-caret, just delete it"
		startIndex := self markIndex].
	self backTo: startIndex.
	^false! !

!Editor methodsFor: 'private' stamp: 'AlainPlantec 11/8/2010 22:08'!
nextWord: position
	| string index |
	string := self string.
	index := position.
	[(index between: 1 and: string size) and: [(string at: index) isAlphaNumeric]]
		whileTrue: [index := index + 1].
	[(index between: 1 and: string size) and: [(string at: index) isAlphaNumeric not]]
		whileTrue: [index := index + 1].
	^ index! !

!Editor methodsFor: 'accessing' stamp: 'AlainPlantec 11/8/2010 22:08'!
userHasEdited
	"Note that my text is free of user edits."
	morph notNil ifTrue:[ morph hasUnacceptedEdits: true ]! !

!Editor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 11/8/2010 22:08'!
normalCharacter: aKeyboardEvent 
	"A nonspecial character is to be added to the stream of characters."

	self addString: aKeyboardEvent keyCharacter asString.
	^false! !

!Editor methodsFor: 'menu messages' stamp: 'AlainPlantec 11/8/2010 22:08'!
clipboardText

	^ Clipboard clipboardText! !

!Editor methodsFor: 'nonediting/nontyping keys' stamp: 'AlainPlantec 11/8/2010 22:08'!
cursorPageUp: aKeyboardEvent 

	self closeTypeIn.
	self 
		moveCursor: [:position |
			self
				sameColumn: position
				newLine: [:lineNo | lineNo - self pageHeight]
				forward: false]
		forward: false
		specialBlock:[:dummy | dummy]
		event: aKeyboardEvent.
	^true! !

!Editor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 11/8/2010 22:08'!
cursorTopHome: aKeyboardEvent
	"Put cursor at beginning of text -- invoked from cmd-H shortcut, useful for keyboards that have no home key."

	self selectAt: 1.
	^ true! !

!Editor methodsFor: 'private' stamp: 'IgorStasenko 3/10/2012 23:57'!
nextNonBlank: position

"if current position is not separator, advance by 1, otherwise advance up until non-separator char found or new line"
	
	| string index |
	string := self string.
	index := position.
	index >= string size ifTrue: [ ^ string size+1 ].
	
	(string at: index) isSeparator ifFalse: [ ^ index + 1 ].
	index := index + 1.
	[ index <= string size and: [(string at: index) isSeparator and: [(string at:index) ~= Character cr]]]
		whileTrue: [index := index + 1].
	^ index! !

!Editor methodsFor: 'accessing' stamp: 'AlainPlantec 11/8/2010 22:08'!
morph: aMorph
	"Install a link back to the morph being edited (esp for text links)"
	morph := aMorph ! !

!Editor methodsFor: 'private' stamp: 'AlainPlantec 11/8/2010 22:08'!
previousWord: position
	| string index |
	string := self string.
	index := position.
	[(index between: 1 and: string size) and: [(string at: index) isAlphaNumeric not]]
		whileTrue: [index := index - 1].
	[(index between: 1 and: string size) and: [(string at: index) isAlphaNumeric]]
		whileTrue: [index := index - 1].
	^ index + 1! !

!Editor methodsFor: 'nonediting/nontyping keys' stamp: 'AlainPlantec 11/8/2010 22:08'!
selectWord: aKeyboardEvent

	self closeTypeIn.
	self selectWord.
	^ true! !

!Editor methodsFor: 'current selection' stamp: 'AlainPlantec 11/8/2010 22:08'!
deselect
	"If the text selection is visible on the screen, reverse its highlight."
	" ***** screw this logic ***** selectionShowing ifTrue: [self reverseSelection] "! !

!Editor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 11/8/2010 22:08'!
selectionInterval
	"Answer the interval that is currently selected."

	^self startIndex to: self stopIndex - 1 ! !

!Editor methodsFor: 'editing keys' stamp: 'AlainPlantec 11/8/2010 22:08'!
paste: aKeyboardEvent 
	"Replace the current text selection by the text in the shared buffer."

	self closeTypeIn.
	self paste.
	^true! !

!Editor methodsFor: 'nonediting/nontyping keys' stamp: 'AlainPlantec 11/8/2010 22:08'!
cursorPageDown: aKeyboardEvent 

	self closeTypeIn.
	self 
		moveCursor: [:position |
			self
				sameColumn: position
				newLine: [:lineNo | lineNo + self pageHeight]
				forward: true]
		forward: true
		specialBlock:[:dummy | dummy]
		event: aKeyboardEvent.
	^true! !

!Editor methodsFor: 'menu messages' stamp: 'AlainPlantec 11/8/2010 22:08'!
clipboardTextPut: text

	^ Clipboard clipboardText: text! !

!Editor methodsFor: 'nonediting/nontyping keys' stamp: 'AlainPlantec 11/8/2010 22:08'!
cursorUp: aKeyboardEvent 
"Private - Move cursor from position in current line to same position in
prior line. If prior line too short, put at end"

	self closeTypeIn.
	self
		moveCursor: [:position | self
				sameColumn: position
				newLine:[:line | line - 1]
				forward: false]
		forward: false
		specialBlock:[:dummy | dummy]
		event: aKeyboardEvent.
	^true! !

!Editor methodsFor: 'menu messages' stamp: 'AlainPlantec 11/8/2010 22:08'!
paste
	"Paste the text from the shared buffer over the current selection and 
	redisplay if necessary.  Undoer & Redoer: undoAndReselect."

	self replace: self selectionInterval with: self clipboardText and:
		[self selectAt: self pointIndex]! !

!Editor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 11/8/2010 22:08'!
hasSelection
	^self hasCaret not! !

!Editor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 11/12/2010 22:05'!
backspace: aKeyboardEvent
	"Backspace over the last character."

	| startIndex |
	aKeyboardEvent shiftPressed ifTrue: [^ self backWord: aKeyboardEvent keyCharacter].
	self hasSelection
		ifTrue: [self replaceSelectionWith: self nullText]
		ifFalse: [startIndex := self markIndex + (self hasCaret ifTrue: [0] ifFalse: [1]).
			startIndex := 1 max: startIndex - 1.
			self backTo: startIndex].
	^false! !

!Editor methodsFor: 'new selection' stamp: 'AlainPlantec 11/8/2010 22:08'!
selectAt: characterIndex 
	"Place the caret before the character at characterIndex.
	 Be sure it is in view."

	self selectFrom: characterIndex to: characterIndex - 1! !

!Editor methodsFor: 'current selection' stamp: 'AlainPlantec 11/8/2010 22:08'!
select
	"If the text selection is visible on the screen, reverse its highlight."
	^'Not doing anything'
	"screw this logic
	selectionShowing ifFalse: [self reverseSelection]"! !

!Editor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 11/8/2010 22:08'!
crlf: aKeyboardEvent
	"Append a line feed character to the stream of characters."

	self addString: String crlf.
	^false! !

!Editor methodsFor: 'testing' stamp: 'AlainPlantec 11/8/2010 22:08'!
hasError
	^ false ! !

!Editor class methodsFor: 'settings' stamp: 'AlainPlantec 11/8/2010 22:08'!
blinkingCursor	
	^ BlinkingCursor ifNil: [ BlinkingCursor := true ]! !

!Editor class methodsFor: 'settings' stamp: 'AlainPlantec 11/8/2010 22:08'!
blinkingCursor: aBoolean	
	BlinkingCursor := aBoolean! !

!Editor class methodsFor: 'private accessing' stamp: 'AlainPlantec 11/8/2010 22:08'!
specialShiftCmdKeys

"Private - return array of key codes that represent single keys acting
as if shift-command were also being pressed"

^#(
	1	"home"
	3	"enter"
	4	"end"
	8	"backspace"
	11	"page up"
	12	"page down"
	27	"escape"
	28	"left arrow"
	29	"right arrow"
	30	"up arrow"
	31	"down arrow"
	127	"delete"
	)! !

!Editor class methodsFor: 'settings' stamp: 'AlainPlantec 11/8/2010 22:08'!
dumbbellCursor: aBoolean
	DumbbellCursor := aBoolean! !

!Editor class methodsFor: 'settings' stamp: 'AlainPlantec 11/8/2010 22:08'!
dumbbellCursor
	^ DumbbellCursor ifNil: [ DumbbellCursor := false ]! !

!Editor class methodsFor: 'settings' stamp: 'IgorStasenko 10/7/2013 11:22'!
skipOverMultipleSpaces
	^ SkipOverMultipleSpaces  ifNil: [ SkipOverMultipleSpaces := false ]! !

!Editor class methodsFor: 'settings' stamp: 'IgorStasenko 10/7/2013 11:22'!
skipOverMultipleSpaces: aBoolean
	SkipOverMultipleSpaces := aBoolean! !

!Editor class methodsFor: 'settings' stamp: 'AlainPlantec 11/8/2010 22:08'!
cmdKeysInText: aBoolean
	CmdKeysInText := aBoolean! !

!Editor class methodsFor: 'settings' stamp: 'AlainPlantec 11/8/2010 22:08'!
cmdKeysInText
	^ CmdKeysInText ifNil: [CmdKeysInText := true]! !

!Editor class methodsFor: 'settings' stamp: 'StephaneDucasse 11/11/2014 18:41'!
editingSettingsOn: aBuilder 
	<systemsettings> 
	(aBuilder group: #codeEditing) 
		label: 'Editing';
		noOrdering;
		description: 'All settings concerned with text editing' ;
		with: [	
			(aBuilder setting: #selectionColor)
				target: UITheme;
				targetSelector: #currentSettings;
				label: 'Selection color'.
			(aBuilder setting: #unfocusedSelectionColor)
				target: UITheme;
				targetSelector: #currentSettings;
				description: 'The color of the selection for unfocused windows' ;
				label: 'Unfocused selection color'.
			(aBuilder setting: #selectionTextColor)
				target: UITheme;
				targetSelector: #currentSettings;
				label: 'Selection text color';
				description: 'The color of the selection text'.
			(aBuilder setting: #useSelectionBar)
				target: TextEditor;
				label: 'Show the colored bar on the current line' translated;
				with: [
					(aBuilder setting: #selectionBarColor)
						target: UITheme;
						targetSelector: #currentSettings;
						label: 'Selection bar color'].
			(aBuilder setting: #useSecondarySelection)
				target: TextEditor;
				label: 'Use the secondary selection';
				with: [
					(aBuilder setting: #secondarySelectionColor)
						target: UITheme;
						targetSelector: #currentSettings;
						label: 'Secondary selection color'.
					(aBuilder setting: #secondarySelectionTextColor)
						target: UITheme;
						targetSelector: #currentSettings;
						label: 'Secondary selection text color'].
			(aBuilder setting: #useFindReplaceSelection)
				target: TextEditor;
				label: 'Use the find and replace selection';
				with: [
					(aBuilder setting: #findReplaceSelectionColor)
						target: UITheme;
						targetSelector: #currentSettings;
						label: 'Find replace selection color'.
					(aBuilder setting: #findReplaceSelectionTextColor)
						target: UITheme;
						targetSelector: #currentSettings;
						label: 'Find replace selection text color'].
			(aBuilder setting: #caseSensitiveFinds) 
				label: 'Case sensitive search';
				target: TextEditor;
		 		description: 'If true, then the "find" command in text will always make its searches in a case-sensitive fashion' translated.
			(aBuilder setting: #blinkingCursor) 
				label: 'Blinking text cursor';
				target: Editor;
		 		description: 'When true, the text cursor will blink.'.
			(aBuilder setting: #dumbbellCursor) 
				label: 'Dumbbell-shaped text cursor';
				target: Editor;
		 		description: 'When true, the text cursor assumes the shape of a dumbbell, otherwise a vertical bar.' translated.
			(aBuilder setting: #skipOverMultipleSpaces) 
				label: 'Skip over white space';
				target: Editor;
		 		description: 'When true, the text cursor treats multiple white-space characters as a single space for navigating (moving left/right).'.
			(aBuilder setting: #walkAlongDisplayedLine) 
				label: 'Walk along displayed line';
				target: TextEditor;
		 		description: 'If set to true cursor movement will move along displayed lines rather than logical lines'.
		]
! !

!EditorFindReplaceDialogWindow commentStamp: 'TorstenBergmann 1/31/2014 12:21'!
A find/replace dialog window for editors!
!EditorFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 11/17/2010 15:57'!
findString
	^ self state findString! !

!EditorFindReplaceDialogWindow methodsFor: 'action' stamp: 'AlainPlantec 12/3/2010 09:42'!
cancel
	self state findText: ''.
	super cancel! !

!EditorFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 11/27/2010 23:35'!
maxPreviousListSize
	^ self class maxPreviousListSize! !

!EditorFindReplaceDialogWindow methodsFor: '*Polymorph-Widgets' stamp: 'AlainPlantec 12/3/2010 09:46'!
aboutText
	^ 'This dialog can be opened with <cmd-f> in an editable text area or from the text area contextual menu. 
Previous find and replace tokens are kept so that you can directly retrieve them from the find and the replace input fields.
While you enter a find token in the find field, in the currently edited text, all matching text portions are dynamically enlighted with the find selection color (orange color by default).
The find token is shared by all text editing areas. You can also set it with the keyboard by using the <cmd-h> shortcut after having selected the portion of text you want to find. Then, you can find the next matching portion of text by using the <cmd-g> shortcut. 
In order to get rid of the current find token, just enter <cmd-h> with nothing selected or just cancel this dialog.
The colorization is manageable with the settings browser from where you can completely disallow it or change the selection color'! !

!EditorFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 11/10/2010 23:56'!
replaceAllEnabled
	^ self model notNil
		and: [self findText notEmpty]! !

!EditorFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 11/10/2010 16:19'!
replaceText
	^ self state replaceText! !

!EditorFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 11/27/2010 23:36'!
prevReplacements
	^ self class replacements! !

!EditorFindReplaceDialogWindow methodsFor: '*Polymorph-Widgets' stamp: 'GaryChambers 8/23/2011 13:26'!
initialize
	"Set the initial position based on usable screen area."

	super initialize.
	self position: RealEstateAgent maximumUsableArea topLeft! !

!EditorFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 11/10/2010 16:18'!
findText
	^ self state findText! !

!EditorFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 11/9/2010 17:24'!
newButtons
	"Answer new buttons as appropriate."

	^{self newFindButton isDefault: true. self newReplaceButton. self newReplaceAllButton. self newCancelButton}! !

!EditorFindReplaceDialogWindow methodsFor: 'updating' stamp: 'AlainPlantec 11/12/2010 12:10'!
on: aTextView
	(model isNil or: [model  ~= aTextView])
		ifTrue: [self findText: self findText.
			self model: aTextView.
			self changed: #findText.
			self changed: #caseSensitive.
			self changed: #replaceEnabled.
			self owner ifNotNil: [self findText: self findText]].
! !

!EditorFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 11/12/2010 21:25'!
caseSensitive: aBoolean
	self state caseSensitive: aBoolean.
! !

!EditorFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 11/16/2010 09:51'!
taskbarButtonFor: aTaskBar
	"No taskbar button because always on top"
	^nil! !

!EditorFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 11/10/2010 16:20'!
caseSensitive
	^ self state caseSensitive! !

!EditorFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 11/10/2010 22:13'!
newReplaceAllButton
	^ (self theme
		newButtonIn: self
		for: self
		getState: nil
		action: #replaceAll
		arguments: nil
		getEnabled: #replaceAllEnabled
		label: 'Replace all' translated
		help: 'Replace all occurences' translated) hResizing: #rigid;
		 vResizing: #rigid! !

!EditorFindReplaceDialogWindow methodsFor: 'action' stamp: 'AlainPlantec 12/3/2010 09:49'!
open
	self openAsIsIn: World.
	self extent: self extent.
	self activate
! !

!EditorFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 12/3/2010 09:38'!
findText: aStringOrText
	self state findText: aStringOrText.
	^ true
! !

!EditorFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 11/17/2010 16:26'!
findTextFieldMorph
	^self
		findDeepSubmorphThat: [:m |
			(m isKindOf: PluggableTextFieldMorph) and: [m getTextSelector = #findText]]
		ifAbsent: [] ! !

!EditorFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 11/10/2010 16:21'!
entireWordsOnly
	^ self state entireWordsOnly! !

!EditorFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 11/8/2010 22:33'!
newReplaceButton
	^ (self theme
		newButtonIn: self
		for: self
		getState: nil
		action: #replace 
		arguments: nil
		getEnabled: #replaceEnabled
		label: 'Replace' translated
		help: 'Replace the next occurence' translated) hResizing: #rigid;
		 vResizing: #rigid! !

!EditorFindReplaceDialogWindow methodsFor: 'updating' stamp: 'AlainPlantec 11/26/2010 18:11'!
findPolicyChanged
	self changed: #findText.
	self findTextFieldMorph textColor: Color  black.
	self changed: #caseSensitive.
	self changed: #isRegex.
	self changed: #entireWordsOnly.
	self changed: #findEnabled.
	self changed: #replaceText.
	self changed: #replaceEnabled.
	self changed: #replaceAllEnabled.
	self model ifNotNil: [self model selectionChanged].
! !

!EditorFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 11/10/2010 16:21'!
isRegex
	^ self state isRegex! !

!EditorFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 11/27/2010 13:41'!
newContentMorph
	^(self newColumn: {	
			(self newGroupbox: nil for: 
				(self newColumn: {
					self newFindTextEntryMorph.
					(self newRow: {
						(self newColumn: {
							(self newCheckboxFor: self getSelected: #isRegex setSelected: #isRegex: getEnabled: nil label: 'Regular expression' translated help: nil).
							(self newCheckboxFor: self getSelected: #caseSensitive setSelected: #caseSensitive: getEnabled: nil label: 'Case sensitive' translated help: nil).
							(self newCheckboxFor: self getSelected: #entireWordsOnly setSelected: #entireWordsOnly: getEnabled: nil label: 'Entire words only'  translated help: nil) }
						).
						(self newColumn: {
							(self newCheckboxFor: self getSelected: #searchBackwards setSelected: #searchBackwards: getEnabled: nil label: 'Search backwards'  translated help: nil).
							(self newCheckboxFor: self getSelected: #wrapAround setSelected: #wrapAround: getEnabled: nil label: 'Wrap around'  translated help: nil) }
						) }	
					) }
				)
			).
			(self newLabelGroup: {'Replace with: ' translated -> self newReplaceTextEntryMorph}) vResizing: #shrinkWrap}
		) 

! !

!EditorFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 4/27/2011 15:19'!
replaceEnabled
	^ self model notNil
		and: [self findText notEmpty]! !

!EditorFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 11/23/2010 15:20'!
replaceText: aStringOrText
	self state replaceText: aStringOrText asString.
	^ true

! !

!EditorFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 11/12/2010 21:25'!
isRegex: aBoolean
	self state isRegex: aBoolean.
! !

!EditorFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 11/10/2010 22:19'!
wrapAround: aBoolean
	self state wrapAround: aBoolean.
! !

!EditorFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 11/27/2010 23:36'!
prevFinds
	^ self class finds! !

!EditorFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 11/8/2010 22:33'!
newFindButton
	^(self theme
			newButtonIn: self
			for: self
			getState: nil
			action: #find
			arguments: nil
			getEnabled: #findEnabled
			label: 'Find' translated
			help: 'Find the next occurence' translated)
		hResizing: #rigid;
		vResizing: #rigid! !

!EditorFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 11/11/2010 22:58'!
title
	^ 'Find & Replace' translated.
! !

!EditorFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 11/23/2010 14:40'!
defaultButton
	"Answer the default button."
	^self
		findDeepSubmorphThat: [:m |
			(m isKindOf: PluggableButtonMorph) and: [m actionSelector = #find]]
		ifAbsent: [] ! !

!EditorFindReplaceDialogWindow methodsFor: 'action' stamp: 'AlainPlantec 4/27/2011 13:35'!
replace
	self newReplacement.
	self state replaceInTextMorph: self model.
	self find! !

!EditorFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'StephaneDucasse 10/27/2014 09:34'!
buildWindowMenu
	"Build and answer the window menu."
	
	| aMenu |
	aMenu := self theme newMenuIn: self for: self.
	aMenu addToggle: 'Close' 
		translated target: self
		selector: #closeBoxHit 
		getStateSelector: nil
		enablementSelector: #allowedToClose.
	aMenu lastItem icon: self theme windowCloseForm.
	aMenu addLine.
	aMenu add: 'About' selector: #showAbout.
	aMenu lastItem icon: Smalltalk ui icons smallHelpIcon.
	^aMenu! !

!EditorFindReplaceDialogWindow methodsFor: 'action' stamp: 'AlainPlantec 11/21/2010 22:00'!
replaceAll
	self model takeKeyboardFocus.
	self state replaceAllInTextMorph: self model! !

!EditorFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 11/10/2010 22:19'!
searchBackwards: aBoolean
	self searchBackwards = aBoolean
		ifFalse: [self state searchBackwards: aBoolean.
			self state updateFindStartIndexForTextMorph: self model]! !

!EditorFindReplaceDialogWindow methodsFor: '*Polymorph-Widgets' stamp: 'AlainPlantec 12/3/2010 09:02'!
removeBoxes
	"Remove all label area boxes."

	expandBox ifNotNil: [expandBox delete. expandBox := nil].
	collapseBox ifNotNil: [collapseBox delete. collapseBox := nil]! !

!EditorFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 11/27/2010 13:42'!
initialExtent 
	^ 400 @ super initialExtent y! !

!EditorFindReplaceDialogWindow methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
taskbarIcon
	^ Smalltalk ui icons smallFindIcon! !

!EditorFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 11/12/2010 21:14'!
state: aFindReplaceService
	state ifNotNil: [state removeDependent: self].
	state := aFindReplaceService.
	state ifNotNil: [state addDependent: self].
! !

!EditorFindReplaceDialogWindow methodsFor: 'updating' stamp: 'AlainPlantec 11/26/2010 18:12'!
update: aSymbol
	| si |
	model ifNotNil: [
		aSymbol = #regexError
				ifTrue: [self findTextFieldMorph textColor: Color  red].
		aSymbol = #newFinding
				ifTrue: [^ self newFinding].
		aSymbol = #findPolicy
			ifTrue: [self findPolicyChanged].
		aSymbol = #findReplaceSelection 
			ifTrue: [self changed: #replaceEnabled.
				self state updateFindStartIndexForTextMorph: self model]].
	super update: aSymbol! !

!EditorFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 11/8/2010 22:33'!
extent: anExtent
	^ super extent: anExtent x @ self initialExtent y! !

!EditorFindReplaceDialogWindow methodsFor: 'updating' stamp: 'AlainPlantec 11/27/2010 23:38'!
newReplacement
	| t |
	(t := self replaceText asString) ifEmpty: [^ self ].
	(self prevReplacements includes: t)
		ifFalse: [self prevReplacements addFirst: t].
	self prevReplacements size > self maxPreviousListSize
		ifTrue: [self prevReplacements removeLast]! !

!EditorFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 11/10/2010 17:28'!
wrapAround
	^ self state wrapAround ! !

!EditorFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 11/8/2010 22:33'!
isResizeable
	"Answer whether we are not we can be resized."

	^true! !

!EditorFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'EstebanLorenzano 8/17/2012 16:41'!
newFindTextEntryMorph
	| entryCompletion pt |
	entryCompletion := EntryCompletion new
				dataSourceBlock: [:currText | self prevFinds ];
				filterBlock: [:currApplicant :currText | currText size = 0
						or: [currApplicant asUppercase includesSubstring: currText asString asUppercase]].
	pt := (self newAutoAcceptTextEntryFor: self
			get: #findText
			set: #findText:
			class: String 
			getEnabled: nil
			help: 'Enter the text to find' translated
			entryCompletion: entryCompletion) 
		acceptOnCR: false;
		ghostText: 'Text to find';
		withDropListButton;
		crAction: [:t | self find];
		yourself.
	pt textMorph
		autoFit: true;
		wrapFlag: false;
		margins: (2@1 corner: 2@1).
	^ pt
! !

!EditorFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 11/12/2010 21:25'!
entireWordsOnly: aBoolean
	self state entireWordsOnly: aBoolean.
! !

!EditorFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 11/17/2010 15:57'!
findEnabled
	^ self findString isEmptyOrNil not ! !

!EditorFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 11/12/2010 21:16'!
state
	^ state ifNil: [self state: FindReplaceService new]! !

!EditorFindReplaceDialogWindow methodsFor: '*Polymorph-Widgets' stamp: 'AlainPlantec 12/3/2010 09:05'!
aboutTitle
	^ 'Find & replace dialog'! !

!EditorFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 11/27/2010 16:46'!
defaultFocusMorph
	^ self findTextFieldMorph textMorph! !

!EditorFindReplaceDialogWindow methodsFor: 'action' stamp: 'AlainPlantec 11/28/2010 09:41'!
find
	self newFinding.
	^ self state findInTextMorph: self model! !

!EditorFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 11/10/2010 16:22'!
searchBackwards
	^ self state searchBackwards! !

!EditorFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'EstebanLorenzano 8/17/2012 16:40'!
newReplaceTextEntryMorph
	| entryCompletion pt |
	entryCompletion := EntryCompletion new
				dataSourceBlock: [:currText | self prevReplacements ];
				filterBlock: [:currApplicant :currText | currText size = 0
						or: [currApplicant asUppercase includesSubstring: currText asString asUppercase]].

	pt := (self
		newAutoAcceptTextEntryFor: self
		get: #replaceText
		set: #replaceText:
		class: String
		getEnabled: nil
		help: 'Enter the replacement text' translated
		entryCompletion: entryCompletion)
			acceptOnCR: true;
			crAction: [:t | self replace];
			withDropListButton;
			yourself.
	pt textMorph
		autoFit: true;
		wrapFlag: false;
		margins: (2@1 corner: 2@1).
	^ pt
! !

!EditorFindReplaceDialogWindow methodsFor: 'updating' stamp: 'AlainPlantec 11/27/2010 23:38'!
newFinding
	| t |
	(t := self findText asString) ifEmpty: [^ self ].
	(self prevFinds includes: t)
		ifFalse: [self prevFinds addFirst: t].
	self prevFinds size > self maxPreviousListSize
		ifTrue: [self prevFinds removeLast]! !

!EditorFindReplaceDialogWindow class methodsFor: 'accessing' stamp: 'AlainPlantec 11/27/2010 23:35'!
finds
	^ Finds ifNil: [Finds := OrderedCollection new]! !

!EditorFindReplaceDialogWindow class methodsFor: 'initializing' stamp: 'MarcusDenker 10/15/2013 10:36'!
initialize
	"EditorFindReplaceDialogWindow initialize"
	Singleton := nil.! !

!EditorFindReplaceDialogWindow class methodsFor: 'accessing' stamp: 'AlainPlantec 11/27/2010 23:35'!
replacements
	^ Replacements ifNil: [Replacements := OrderedCollection new]! !

!EditorFindReplaceDialogWindow class methodsFor: 'instance creation' stamp: 'AlainPlantec 11/11/2010 19:26'!
singleton 
	^ Singleton ifNil: [Singleton := self new].
! !

!EditorFindReplaceDialogWindow class methodsFor: 'accessing' stamp: 'AlainPlantec 11/27/2010 23:35'!
maxPreviousListSize
	^ 15! !

!EditorFindReplaceDialogWindow class methodsFor: 'instance creation' stamp: 'AlainPlantec 11/11/2010 21:46'!
on: aTextView
	^ self singleton on: aTextView! !

!EditorFindReplaceDialogWindow class methodsFor: 'initializing' stamp: 'MarcusDenker 10/15/2013 10:35'!
cleanUp
	Singleton ifNotNil: [ 
			Singleton close.
			Singleton := nil ]! !

!EllipseMidpointTracer commentStamp: 'TorstenBergmann 2/20/2014 18:32'!
Utility class for calculating!
!EllipseMidpointTracer methodsFor: 'computing' stamp: 'ar 6/28/1999 15:35'!
stepInY
	"Step to the next y value"
	inFirstRegion ifTrue:[
		"In the upper region we must step until we reach the next y value"
		[(aSquared * (y-0.5)) > (bSquared * (x+1))] whileTrue:[
			d1 < 0.0
				ifTrue:[d1 := d1 + (bSquared * (2*x+3)).
						x := x + 1]
				ifFalse:[d1 := d1 + (bSquared * (2*x+3)) + (aSquared * (-2*y+2)).
						y := y - 1.
						^x := x + 1]].
		"Stepping into second region"
		d2 := (bSquared * (x + 0.5) squared) + (aSquared * (y-1) squared) - (aSquared * bSquared).
		inFirstRegion := false.
	].
	"In the lower region each step is a y-step"
	d2 < 0.0
		ifTrue:[d2 := d2 + (bSquared * (2*x+2)) + (aSquared * (-2*y+3)).
				x := x + 1]
		ifFalse:[d2 := d2 + (aSquared * (-2*y+3))].
	y := y - 1.
	^x! !

!EllipseMidpointTracer methodsFor: 'initialize' stamp: 'MarcusDenker 7/17/2014 09:25'!
on: aRectangle
	a := aRectangle width // 2.
	b := aRectangle height // 2.
	x := 0.
	y := b.
	aSquared := a * a.
	bSquared := b * b.
	d1 := bSquared - (aSquared * b) + (0.25 * aSquared).
	d2 := nil.
	inFirstRegion := true.! !

!EllipseMorph commentStamp: 'kfr 10/27/2003 10:32'!
A round BorderedMorph. Supports borderWidth and borderColor. 
Only simple borderStyle is implemented.

EllipseMorph new borderWidth:10; borderColor: Color green; openInWorld.
EllipseMorph new borderStyle:(SimpleBorder width: 5 color: Color blue); openInWorld.!
!EllipseMorph methodsFor: 'initialization' stamp: 'dgd 2/14/2003 22:26'!
defaultColor
	"answer the default color/fill style for the receiver"
	^ Color yellow! !

!EllipseMorph methodsFor: 't-rotating' stamp: ''!
forwardDirection: newDirection
	"Set the receiver's forward direction (in eToy terms)"
	self setProperty: #forwardDirection toValue: newDirection.! !

!EllipseMorph methodsFor: 'geometry' stamp: 'nk 2/15/2001 16:08'!
closestPointTo: aPoint
	^self intersectionWithLineSegmentFromCenterTo: aPoint! !

!EllipseMorph methodsFor: 't-rotating' stamp: ''!
forwardDirection
	"Return the receiver's forward direction (in eToy terms)"
	^self valueOfProperty: #forwardDirection ifAbsent:[0.0]! !

!EllipseMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 7/1/2014 22:39'!
asAthensShapeOn: anAthensCanvas
	| radius width |
	self bounds area > 0
		ifFalse: [ ^ self ].
	width := self bounds width.
	radius := width / 2.
	^ anAthensCanvas
		createPath: [ :builder | 
			builder
				absolute;
				moveTo: width @ radius;
				cwArcTo: 0 @ radius angle: Float pi;
				cwArcTo: width @ radius angle: Float pi ]! !

!EllipseMorph methodsFor: 'geometry' stamp: 'nk 8/31/2004 14:26'!
topRightCorner
	^self intersectionWithLineSegmentFromCenterTo: bounds topRight
! !

!EllipseMorph methodsFor: 't-rotating' stamp: ''!
prepareForRotating
	"If I require a flex shell to rotate,
	then wrap it in one and return it.
	Polygons, eg, may override to do nothing."

	^ self addFlexShell! !

!EllipseMorph methodsFor: 't-rotating' stamp: ''!
setDirectionFrom: aPoint
	| delta degrees |
	delta := (self transformFromWorld globalPointToLocal: aPoint) - self referencePosition.
	degrees := delta degrees + 90.0.
	self forwardDirection: (degrees \\ 360) rounded.
! !

!EllipseMorph methodsFor: 'geometry' stamp: 'nk 8/31/2004 14:23'!
topLeftCorner
	^self intersectionWithLineSegmentFromCenterTo: bounds topLeft 
! !

!EllipseMorph methodsFor: 't-rotating' stamp: ''!
rotationDegrees: degrees	
	"redefined in all morphs which are using myself"! !

!EllipseMorph methodsFor: 'geometry' stamp: 'nk 8/31/2004 14:23'!
bottomRightCorner
	^self intersectionWithLineSegmentFromCenterTo: bounds bottomRight 
! !

!EllipseMorph methodsFor: 'geometry testing' stamp: 'di 11/14/97 13:50'!
containsPoint: aPoint

	| radius other delta xOverY |
	(bounds containsPoint: aPoint) ifFalse: [^ false].  "quick elimination"
	(bounds width = 1 or: [bounds height = 1])
		ifTrue: [^ true].  "Degenerate case -- code below fails by a bit"

	radius := bounds height asFloat / 2.
	other := bounds width asFloat / 2.
	delta := aPoint - bounds topLeft - (other@radius).
	xOverY := bounds width asFloat / bounds height asFloat.
	^ (delta x asFloat / xOverY) squared + delta y squared <= radius squared! !

!EllipseMorph methodsFor: 'initialization' stamp: 'dgd 2/14/2003 22:37'!
defaultBorderWidth
	"answer the default border width for the receiver"
	^ 1! !

!EllipseMorph methodsFor: 'drawing' stamp: 'CamilloBruni 8/30/2012 18:51'!
drawOn: aCanvas 
	
	aCanvas 
		fillOval: bounds 
		fillStyle: self fillStyle 
		borderWidth: borderWidth  
		borderColor: borderColor.
! !

!EllipseMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 7/1/2014 22:39'!
drawOnAthensCanvas: anAthensCanvas
	| border ellipse |
	self bounds area > 0
		ifFalse: [ ^ self ].
	border := self borderStyle.
	ellipse := self asAthensShapeOn: anAthensCanvas.
	anAthensCanvas setPaint: self fillStyle.
	anAthensCanvas setShape: ellipse.
	anAthensCanvas pathTransform
		restoreAfter: [ 
			| t |
			t := anAthensCanvas pathTransform.
			t translateBy: self bounds origin.
			t scaleBy: 1 @ (self bounds height / self bounds width).
			anAthensCanvas setShape: ellipse.
			anAthensCanvas draw.
			(anAthensCanvas setStrokePaint: border color) width: border width.
			anAthensCanvas draw ]! !

!EllipseMorph methodsFor: 'accessing' stamp: 'sw 11/24/1999 14:59'!
couldHaveRoundedCorners
	^ false! !

!EllipseMorph methodsFor: 'rounding' stamp: 'MarcusDenker 4/13/2012 08:49'!
cornerStyle: aSymbol
	"Set the receiver's corner style.  But, in this case, do *not*"

	(extension isNil or: [self cornerStyle == aSymbol]) ifTrue: [^self].
	extension cornerStyle: nil.
	self changed! !

!EllipseMorph methodsFor: 'accessing' stamp: 'di 6/20/97 11:29'!
doesBevels
	^ false! !

!EllipseMorph methodsFor: 'drawing' stamp: 'di 6/24/1998 14:27'!
areasRemainingToFill: aRectangle
	"Could be improved by quick check of inner rectangle"

	^ Array with: aRectangle! !

!EllipseMorph methodsFor: 'geometry' stamp: 'nk 2/13/2001 18:16'!
intersectionWithLineSegmentFromCenterTo: aPoint 
	| dx aSquared bSquared m mSquared xSquared x y dy |
	(self containsPoint: aPoint)
		ifTrue: [ ^aPoint ].
	dx := aPoint x - self center x.
	dy := aPoint y - self center y.
	dx = 0
		ifTrue: [ ^self bounds pointNearestTo: aPoint ].
	m := dy / dx.
	mSquared := m squared.
	aSquared := (self bounds width / 2) squared.
	bSquared := (self bounds height / 2) squared.
	xSquared := 1 / ((1 / aSquared) + (mSquared / bSquared)).
	x := xSquared sqrt.
	dx < 0 ifTrue: [ x := x negated ].
	y := m * x.
	^ self center + (x @ y) asIntegerPoint.
! !

!EllipseMorph methodsFor: 'drawing' stamp: 'IgorStasenko 8/8/2011 17:21'!
drawDropShadowOn: aCanvas 

	aCanvas fillOval: bounds fillStyle: self shadowColor borderWidth: 0 borderColor: nil! !

!EllipseMorph methodsFor: 't-rotating' stamp: ''!
heading
	"Return the receiver's heading"
	^ self owner 
		ifNil: [self forwardDirection]
		ifNotNil: [self forwardDirection + self owner degreesOfFlex]! !

!EllipseMorph methodsFor: 'testing' stamp: 'ar 8/25/2001 19:08'!
canDrawBorder: aBorderStyle
	^aBorderStyle style == #simple! !

!EllipseMorph methodsFor: 'geometry' stamp: 'nk 8/31/2004 14:25'!
bottomLeftCorner
	^self intersectionWithLineSegmentFromCenterTo: bounds bottomLeft 
! !

!EllipseMorph methodsFor: 't-rotating' stamp: ''!
rotationDegrees
	"Default implementation."

	^ 0.0
! !

!EmbeddedFreeTypeFontFontDescription commentStamp: 'IgorStasenko 4/8/2014 17:19'!
Common superclass handling fonts that are not found on the disc but embedded in the image.

Subclasses should redefine fontContents and originalFileName class methods. 



To do in the future:
	- a proper way to load font file and install them to avoid bloating the image with text that represent binary font data in addition to font themselves!!!!!
!EmbeddedFreeTypeFontFontDescription class methodsFor: 'accessing' stamp: 'EstebanLorenzano 12/1/2014 14:56'!
fontContents
	self subclassResponsibility
! !

!EmbeddedFreeTypeFontFontDescription class methodsFor: 'accessing' stamp: 'EstebanLorenzano 12/1/2014 14:56'!
installAllFontsIn: provider
	self allSubclasses do: [ :each |  each installFontsIn: provider ]! !

!EmbeddedFreeTypeFontFontDescription class methodsFor: 'accessing' stamp: 'EstebanLorenzano 12/1/2014 14:56'!
originalFileName
	self subclassResponsibility
! !

!EmbeddedFreeTypeFontFontDescription class methodsFor: 'accessing' stamp: 'EstebanLorenzano 12/1/2014 14:56'!
installFontsIn: provider
	provider
		addFromFileContents: self fontContents 
		baseName: self originalFileName ! !

!EmbeddedFreeTypeFontInstaller commentStamp: 'JurajKubelka 8/23/2014 15:01'!
An EmbeddedFreeTypeFontInstaller installs embedded free type fonts in a provider.
It registers itself as a font installer to FreeTypeFontProvider. And when someone asks to update fonts from system, EmbeddedFreeTypeFontInstaller installs corresponding fonts.

Instance Variables
	embeddedFileInfoCache:		<Dictionary>
	provider:		<FreeTypeFontProvider>

embeddedFileInfoCache
	- internal cache

provider
	- a provider which asks for installing the embedded fonts.!
!EmbeddedFreeTypeFontInstaller methodsFor: 'accessing' stamp: 'JurajKubelka 8/23/2014 14:35'!
installAllFontsIn: aProvider
	self provider: aProvider.
	EmbeddedFreeTypeFontFontDescription installAllFontsIn: self.	
	embeddedFileInfoCache valuesDo: [ :eachSet | eachSet do: [ :each | provider addFileInfo: each ] ]! !

!EmbeddedFreeTypeFontInstaller methodsFor: 'initialization' stamp: 'JurajKubelka 8/23/2014 14:13'!
initialize
	super initialize.
	embeddedFileInfoCache := Dictionary new: 10. "keyed by file size" 	! !

!EmbeddedFreeTypeFontInstaller methodsFor: 'accessing' stamp: 'JurajKubelka 8/23/2014 14:35'!
provider: aProvider
	provider := aProvider! !

!EmbeddedFreeTypeFontInstaller methodsFor: 'accessing' stamp: 'JurajKubelka 8/23/2014 14:30'!
validEmbeddedCachedInfoFor: bytes index: i
	"answer info from cache if the bytes are the same as the cached info, otherwise answer nil"
	| cacheEntry fileSize |

	fileSize := bytes size.
	cacheEntry := (embeddedFileInfoCache at: {fileSize. i} ifAbsentPut:[Set new])
		detect:[:each | each fileContents = bytes]
		ifNone:[].
	^cacheEntry! !

!EmbeddedFreeTypeFontInstaller methodsFor: 'adding' stamp: 'JurajKubelka 8/23/2014 14:31'!
addFirstFileInfo: aFreeTypeEmbeddedFileInfo index: anInteger 
	provider addFirstFileInfo: aFreeTypeEmbeddedFileInfo index: anInteger ! !

!EmbeddedFreeTypeFontInstaller methodsFor: 'accessing' stamp: 'JurajKubelka 8/23/2014 14:32'!
cacheEmbeddedFileInfo: aFreeTypeEmbeddedFileInfo index: i

	(embeddedFileInfoCache at:{aFreeTypeEmbeddedFileInfo fileSize. i} ifAbsentPut:[ Set new ])
		add: aFreeTypeEmbeddedFileInfo! !

!EmbeddedFreeTypeFontInstaller methodsFor: 'accessing' stamp: 'JurajKubelka 8/23/2014 14:28'!
addFromFileContents: bytes baseName:  originalFileBaseName
	| i face numFaces info externalMem cachedInfo cachedNumFaces |

	i:= 0.
	[(cachedInfo := self validEmbeddedCachedInfoFor: bytes index: i) notNil]
		whileTrue:[
			i = 0 ifTrue:[cachedNumFaces := cachedInfo numFaces].
			self addFirstFileInfo: cachedInfo index: i.
			i := i + 1.].
	(cachedNumFaces notNil and:[i >= cachedNumFaces]) ifTrue:[^self].
	[externalMem := FreeTypeExternalMemory bytes: bytes.
	externalMem validate.
	face := FreeTypeFace basicNew fileContentsExternalMemory: externalMem .
	[ "we use the primNewFaceFromFile:index: method because we want to do this as fast as possible and we don't need the face registered because it will be explicitly destroyed later"
	face primNewFaceFromExternalMemory: externalMem size: bytes size index: i.
	face loadFields] 
		on: FT2Error 
		do:[:e | 
			self failedToOpen:face index: i.
			^externalMem destroyHandle.].
	(face height notNil  and:[face hasFamilyName and:[face hasStyleName and:[face isValid]]])
		ifFalse:[
			self failedToOpen:face index: i.
			^ externalMem destroyHandle.]
		ifTrue:[ 
			numFaces ifNil: [numFaces := face numFaces].
			info := FreeTypeEmbeddedFileInfo new
				baseName: originalFileBaseName;
				fileContents: bytes;
				index: i;
				familyName: face familyName;
				styleName: face styleName;
				postscriptName: face postscriptName;
				bold: face isBold;
				italic: face isItalic;
				fixedWidth: face isFixedWidth;
				numFaces: numFaces;
				extractAttributesFromNames;
				yourself.
			self addFirstFileInfo: info index: i.
			self cacheEmbeddedFileInfo: info index: i.
			"Transcript show: 'from file : ', info asString."
			face destroyHandle.
			externalMem destroyHandle].
	i := i + 1.
	i < numFaces "note, we use < rather than <= , because i is zero based"] whileTrue:[].! !

!EmbeddedFreeTypeFontInstaller methodsFor: 'accessing' stamp: 'JurajKubelka 8/23/2014 14:34'!
embedFilesInDirectory: aDirectory
	"embed all the files in aDirectory
	EmbeddedFreeTypeFontInstaller new 
		provider: FreeTypeFontProvider current;
		embedFilesInDirectory: (FileSystem disk workingDirectory / 'Fonts')
	"
	
	aDirectory files do:[:file |
		file readStreamDo: [ :fileStream|.
			fileStream binary.
			self 
				addFromFileContents: fileStream contents 
				baseName: file basename]].
	
	"update so that missing text styles are created."
	self updateFromSystem.
	
	"clear all the logicalFonts realFonts so that embedded fonts take precedence over external ones"
	LogicalFont allInstances do:[:logFont | logFont clearRealFont]! !

!EmbeddedFreeTypeFontInstaller class methodsFor: 'extra fonts registration' stamp: 'EstebanLorenzano 12/1/2014 15:49'!
registerFont: aClassWithFont
	"Do nothing if freetype is disabled currently"
	FreeTypeSystemSettings loadFt2Library 
		ifTrue: [  aClassWithFont installFontsIn: self current ]! !

!EmbeddedFreeTypeFontInstaller class methodsFor: 'class initialization' stamp: 'JurajKubelka 9/17/2014 11:22'!
initialize
	super initialize.
	self resetCurrent.
	self current.! !

!EmbeddedFreeTypeFontInstaller class methodsFor: 'accessing' stamp: 'EstebanLorenzano 12/1/2014 15:58'!
current
	current ifNil: [ 
		current := self new 
			provider: FreeTypeFontProvider current; 
			yourself.
		FreeTypeFontProvider current addFontInstaller: self current ].
	^ current.! !

!EmbeddedFreeTypeFontInstaller class methodsFor: 'accessing' stamp: 'JurajKubelka 8/23/2014 15:55'!
resetCurrent
	| tmpCurrent |
	current ifNil: [ ^ self ].
	tmpCurrent := current.
	current := nil.
	FreeTypeFontProvider current removeFontInstaller: tmpCurrent.! !

!EmbeddedFreeTypeFontInstallerTest commentStamp: '<historical>'!
An EmbeddedFreeTypeFontInstallerTest is a test class for testing the behavior of EmbeddedFreeTypeFontInstaller!
!EmbeddedFreeTypeFontInstallerTest methodsFor: 'accessing' stamp: 'JurajKubelka 9/17/2014 11:17'!
currentProviderOrError
	| provider |
	provider := FreeTypeFontProvider readSlotNamed: #current.
	self assert: provider notNil.
	^ provider! !

!EmbeddedFreeTypeFontInstallerTest methodsFor: 'accessing' stamp: 'JurajKubelka 9/17/2014 11:16'!
currentInstallerOrError
	| installer |
	installer := EmbeddedFreeTypeFontInstaller readSlotNamed: #current.
	self assert: installer notNil.
	^ installer! !

!EmbeddedFreeTypeFontInstallerTest methodsFor: 'tests' stamp: 'EstebanLorenzano 12/2/2014 14:22'!
testinstallAllFontsIn

	| provider fileInfos families |
	provider := self currentProviderOrError 
		updateEmbeddedFreeTypeFonts;
		yourself.
	fileInfos := provider fileInfosByFamilyAndGroup.
	self assert: fileInfos keys size > 1.
	self assert: (fileInfos includesKey: 'Source Sans Pro').
	self assert: (fileInfos includesKey: 'Source Code Pro').
	families := provider families.
	self assert: (families includesKey: 'Source Sans Pro').
	self assert: (families includesKey: 'Source Code Pro').
! !

!EmbeddedFreeTypeFontInstallerTest methodsFor: 'tests' stamp: 'JurajKubelka 9/17/2014 11:17'!
testIsRegistred
	| installer provider |
	installer := self currentInstallerOrError.
	provider := self currentProviderOrError.
	self assert: (provider includesInstaller: installer)! !

!EmbeddedMenuMorph commentStamp: 'gvc 5/18/2007 13:18'!
Menu designed to be embedded in another morph rather than popped up directly.!
!EmbeddedMenuMorph methodsFor: 'keyboard control' stamp: 'gvc 1/16/2007 14:22'!
handlesKeyboard: evt
	"Answer whether the receiver handles the keystroke represented by the event"

	^true! !

!EmbeddedMenuMorph methodsFor: 'drawing' stamp: 'gvc 1/16/2007 14:17'!
drawOn: aCanvas
	"Draw the receiver on the canvas."

	self perform: #drawOn: withArguments: {aCanvas} inSuperclass: Morph.
	self hasKeyboardFocus ifTrue: [self drawKeyboardFocusOn: aCanvas]! !

!EmbeddedMenuMorph methodsFor: 'events' stamp: 'gvc 9/21/2007 14:37'!
keyStroke: evt
	"Handle tabbing and arrows and cr/space."
	
	|char selectable|
	(self navigationKey: evt) ifTrue: [^self].
	char := evt keyCharacter.
	char = Character space 
		ifTrue: 
			[selectedItem ifNotNil: 
					[selectedItem hasSubMenu 
						ifTrue: 
							[evt hand newMouseFocus: selectedItem subMenu.
							^selectedItem subMenu takeKeyboardFocus]
						ifFalse: 
							[^selectedItem invokeWithEvent: evt]].
			(selectable := self items) size = 1 
				ifTrue: [^selectable first invokeWithEvent: evt].
			^self].
	(char = Character arrowLeft or: [char = Character arrowRight]) ifTrue: [
		(selectedItem notNil and: [selectedItem hasSubMenu]) ifTrue: [
			evt hand newMouseFocus: selectedItem subMenu.
			selectedItem subMenu moveSelectionDown: 1 event: evt.
			^evt hand newKeyboardFocus: selectedItem subMenu]].
	char = Character arrowUp ifTrue: [^self moveSelectionDown: -1 event: evt].	"up arrow key"
	char = Character arrowDown ifTrue: [^self moveSelectionDown: 1 event: evt].	"down arrow key"
	char = Character pageUp ifTrue: [^self moveSelectionDown: -5 event: evt].	"page up key"
	char = Character pageDown ifTrue: [^self moveSelectionDown: 5 event: evt].	"page down key"
! !

!EmbeddedMenuMorph methodsFor: 'accessing' stamp: 'gvc 3/17/2008 17:04'!
allEnabledSiblingItems
	"Answer the receiver's submorphs followed by the (wrapping) owner's
	submorph items. Answer only enabled items."

	^self allSiblingItems select: [:item | item isEnabled]! !

!EmbeddedMenuMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/11/2015 13:51'!
drawOnAthensCanvas: anAthensCanvas
	"Draw the receiver on the canvas."

	self perform: #drawOnAthensCanvas: withArguments: {anAthensCanvas} inSuperclass: Morph.
	self hasKeyboardFocus ifTrue: [self drawKeyboardFocusOnAthensCanvas: anAthensCanvas]! !

!EmbeddedMenuMorph methodsFor: 'selecting' stamp: 'nice 1/5/2010 15:59'!
selectPrefix: aString
	"Answer the first subitem that has text that matches the given prefix.
	Answer nil if none.
	Disable non-matching items and enable matching items."

	| firstMatch|
	self items do: [:item | | match |
		match := aString isEmpty or: [item contents asString asLowercase beginsWith: aString].
		item isEnabled: match.
		(match and: [firstMatch isNil]) ifTrue: [firstMatch := item]].
	^firstMatch! !

!EmbeddedMenuMorph methodsFor: 'accessing' stamp: 'gvc 3/20/2008 21:18'!
allSiblingItems
	"Answer the receiver's submorphs followed by the (wrapping) owner's
	submorph items. Nasty."

	|menus str index|
	str := (Array new: 40) writeStream.
	menus := self owner submorphs select: [:m | m isKindOf: self class].
	menus := (menus copyFrom: (index := menus indexOf: self) to: menus size), (menus copyFrom: 1 to: index - 1).
	menus do: [:menu |
		str nextPutAll: menu items].
	^str contents! !

!EmbeddedMenuMorph methodsFor: 'keyboard control' stamp: 'nice 1/5/2010 15:59'!
moveSelectionDown: anInteger event: anEvent
	"Move the selection down or up (negative number) by (at least)
	the specified amount. If the item is not enabled, scan one at a time
	in that direction. If we move off the top/bottom then switch focus to any
	sibling menu and start scanning at the relevant end."

	| allEnabledSiblingItems index|
	allEnabledSiblingItems := self allEnabledSiblingItems.
	index := (allEnabledSiblingItems indexOf: selectedItem ifAbsent: [0 + (anInteger negative ifTrue: [1] ifFalse: [0])]) + anInteger.
	allEnabledSiblingItems do: "Ensure finite"
		[:unused | | m | m := allEnabledSiblingItems atWrap: index.
		((m isKindOf: MenuItemMorph) and: [m isEnabled]) ifTrue:
			[m owner = self owner ifFalse: [
				anEvent hand newKeyboardFocus: m owner].
				^m owner selectItem: m event: anEvent].
		"Keep looking for an enabled item"
		index := index + anInteger sign].
	^self selectItem: nil event: anEvent! !

!EmbeddedMenuMorph methodsFor: 'keyboard control' stamp: 'MarcusDenker 12/11/2009 07:38'!
keyboardFocusChange: aBoolean
	"Nasty hack for scrolling upon keyboard focus."

	super keyboardFocusChange: aBoolean.
	aBoolean
		ifTrue: [(self ownerThatIsA: GeneralScrollPane) ifNotNil: [:sp |
					sp scrollToShow: self bounds]]
		ifFalse: [self selectItem: nil event: nil]! !

!EmbeddedMenuMorph methodsFor: 'selecting' stamp: 'EstebanLorenzano 8/17/2012 16:41'!
selectMatch: aString
	"Answer the first subitem that has text that includes the given substring.
	Answer nil if none.
	Disable non-matching items and enable matching items."

	|firstMatch|
	self items do: [:item | | match |
		match := aString isEmpty or: [item contents asString asLowercase includesSubstring: aString].
		item isEnabled: match.
		(match and: [firstMatch isNil]) ifTrue: [firstMatch := item]].
	^firstMatch! !

!EmbeddedMenuMorph methodsFor: 'selecting' stamp: 'EstebanLorenzano 8/17/2012 16:40'!
selectLastMatch: aString
	"Answer the last subitem that has text that includes the given substring.
	Answer nil if none.
	Disable non-matching items and enable matching items."

	|lastMatch|
	self items reverseDo: [:item | | match |
		match := aString isEmpty or: [item contents asString asLowercase includesSubstring: aString].
		item isEnabled: match.
		(match and: [lastMatch isNil]) ifTrue: [lastMatch := item]].
	^lastMatch! !

!EmbeddedMenuMorph methodsFor: 'control' stamp: 'gvc 5/6/2008 14:56'!
selectItem: aMenuItem event: anEvent
	"Deselect any sibling menus."
	
	|menus|
	menus := self owner submorphs select: [:m | (m isKindOf: self class) and: [m ~~ self]].
	menus do: [:menu |
		menu perform: #selectItem:event: withArguments: {nil. anEvent} inSuperclass: self class superclass].
	^super selectItem: aMenuItem event: anEvent! !

!EmbeddedMenuMorph methodsFor: 'selecting' stamp: 'GaryChambers 7/5/2010 15:47'!
selectLastPrefix: aString
	"Answer the last subitem that has text that matches the given prefix.
	Answer nil if none.
	Disable non-matching items and enable matching items."

	|lastMatch|
	self items reverseDo: [:item | | match |
		match := aString isEmpty or: [item contents asString asLowercase beginsWith: aString].
		item isEnabled: match.
		(match and: [lastMatch isNil]) ifTrue: [lastMatch := item]].
	^lastMatch! !

!EmbossedStringMorph commentStamp: 'gvc 5/18/2007 13:15'!
A label that underdraws to the top-left and/or bottom-right with a lighter and/or darker colour to the receiver.!
!EmbossedStringMorph methodsFor: 'accessing' stamp: 'gvc 4/27/2006 12:09'!
style
	"Answer the value of style"

	^ style! !

!EmbossedStringMorph methodsFor: 'initialization' stamp: 'gvc 8/9/2007 11:52'!
initialize
	"Initialize the receiver."
	
	super initialize.
	self
		style: #inset;
		trackPaneColor: true! !

!EmbossedStringMorph methodsFor: 'initialization' stamp: 'gvc 8/9/2007 11:55'!
initWithContents: aString font: aFont emphasis: emphasisCode
	"Grrr, why do they do basicNew?"
	
	super initWithContents: aString font: aFont emphasis: emphasisCode.
	self
		style: #inset;
		trackPaneColor: true.! !

!EmbossedStringMorph methodsFor: 'drawing' stamp: 'gvc 8/9/2007 17:03'!
drawOn: aCanvas
	"Draw the hi/lowlights too."

	|box|
	self style == #plain
		ifTrue: [^super drawOn: aCanvas].
	box := self bounds.
	(self style == #inset or: [self style == #insetNoHighlight])
		ifTrue: [self style == #insetNoHighlight
					ifFalse: [aCanvas drawString: self contents in: (box translateBy: 1)
								font: self fontToUse color: self color veryMuchLighter].
				aCanvas
					drawString: self contents in: (box translateBy: -1)
					font: self fontToUse color: self color muchDarker;
					drawString: self contents in: box
					font: self fontToUse color: self color]
		ifFalse: [self style == #raisedNoHighlight
					ifFalse: [aCanvas drawString: self contents in: (box translateBy: -1)
								font: self fontToUse color: self color veryMuchLighter].
				aCanvas
					drawString: self contents in: (box translateBy: 1)
					font: self fontToUse color: self color muchDarker;
					drawString: self contents in: box
					font: self fontToUse color: self color]! !

!EmbossedStringMorph methodsFor: 'accessing' stamp: 'gvc 8/9/2007 11:52'!
trackPaneColor
	"Answer the value of trackPaneColor"

	^ trackPaneColor! !

!EmbossedStringMorph methodsFor: 'accessing' stamp: 'gvc 5/10/2006 15:26'!
style: anObject
	"Set the value of style"

	style := anObject.
	self changed! !

!EmbossedStringMorph methodsFor: 'accessing' stamp: 'gvc 5/18/2007 13:16'!
measureContents
	"Measure the contents for fitting. Add 2@2 for hi/lowlights."

	^super measureContents + 2! !

!EmbossedStringMorph methodsFor: 'accessing' stamp: 'gvc 8/9/2007 11:52'!
trackPaneColor: anObject
	"Set the value of trackPaneColor"

	trackPaneColor := anObject! !

!EmbossedStringMorph methodsFor: 'accessing' stamp: 'gvc 8/9/2007 11:53'!
adoptPaneColor: paneColor
	"Set the color."
	
	(paneColor notNil and: [self trackPaneColor])
		ifTrue: [self color: paneColor].
	super adoptPaneColor: paneColor! !

!EmbossedStringMorph methodsFor: 'accessing' stamp: 'gvc 8/9/2007 11:35'!
styleSymbols
	"Answer the valid styles."

	^#(plain inset insetNoHighlight raised raisedNoHighlight)! !

!EmptyLayout commentStamp: '<historical>'!
Empty top-level layout used to delimit the layout chains.!
!EmptyLayout methodsFor: 'extending' stamp: 'ToonVerwaest 4/1/2011 13:56'!
extendWord
	^ WordLayout new! !

!EmptyLayout methodsFor: 'extending' stamp: 'MartinDias 12/9/2013 11:38'!
extend: someSlots
	^ FixedLayout new
		slotScope: (LayoutEmptyScope instance extend: someSlots)! !

!EmptyLayout methodsFor: 'extending' stamp: 'ToonVerwaest 4/1/2011 13:56'!
extendByte
	^ ByteLayout new! !

!EmptyLayout methodsFor: 'extending' stamp: 'ToonVerwaest 4/1/2011 13:57'!
extendWeak
	^ WeakLayout new! !

!EmptyLayout methodsFor: 'extending' stamp: 'ToonVerwaest 4/2/2011 14:26'!
extendVariable: someSlots
	^ VariableLayout new
		slotScope: (LayoutEmptyScope extend: someSlots)! !

!EmptyLayout class methodsFor: 'instance creation' stamp: 'ToonVerwaest 3/20/2011 15:29'!
instance
	^ instance ifNil: [ instance := self new ]! !

!EncodedCharSet commentStamp: 'yo 10/19/2004 19:08'!
An abstract superclasss of the classes that represent encoded character sets.  In the old implementation, the charsets had more important role.  However, in the current implementation, the subclasses are used only for keeping the backward compatibility.

	The other confusion comes from the name of "Latin1" class.  It used to mean the Latin-1 (ISO-8859-1) character set, but now it primarily means that the "Western European languages that are covered by the characters in Latin-1 character set.
!
!EncodedCharSet class methodsFor: 'character classification' stamp: 'yo 8/5/2003 16:55'!
canBeGlobalVarInitial: char

	| leadingChar |
	leadingChar := char leadingChar.

	leadingChar = 0 ifTrue: [^ self isUppercase: char].
	^ self isLetter: char.
! !

!EncodedCharSet class methodsFor: 'class methods' stamp: 'yo 12/2/2004 16:13'!
isCharset

	^ true.
! !

!EncodedCharSet class methodsFor: 'character classification' stamp: 'yo 8/5/2003 16:44'!
isUppercase: char
	"Answer whether the receiver is an uppercase letter.
	(The old implementation answered whether the receiver is not a lowercase letter.)"

	| value |
	value := char asciiValue.
	^ 8r101 <= value and: [value <= 8r132].
! !

!EncodedCharSet class methodsFor: 'accessing - displaying' stamp: 'yo 12/18/2002 12:34'!
isBreakableAt: index in: text

	self subclassResponsibility.
! !

!EncodedCharSet class methodsFor: 'character classification' stamp: 'yo 8/5/2003 16:44'!
isDigit: char
	"Answer whether the receiver is a digit."

	| value |
	value := char asciiValue.
	^ value >= 48 and: [value <= 57].
! !

!EncodedCharSet class methodsFor: 'accessing - displaying' stamp: 'yo 9/4/2002 22:51'!
printingDirection

	self subclassResponsibility.
! !

!EncodedCharSet class methodsFor: 'class methods' stamp: 'yo 9/4/2002 22:57'!
charsetAt: encoding

	^ EncodedCharSets at: encoding + 1 ifAbsent: [EncodedCharSets at: 1].
! !

!EncodedCharSet class methodsFor: 'class methods' stamp: 'yo 9/2/2002 16:32'!
leadingChar

	self subclassResponsibility.
! !

!EncodedCharSet class methodsFor: 'class methods' stamp: 'yo 11/4/2002 14:43'!
nextPutValue: ascii toStream: aStream withShiftSequenceIfNeededForTextConverterState: state

	self subclassResponsibility.
! !

!EncodedCharSet class methodsFor: 'initialize' stamp: 'StephaneDucasse 8/22/2013 14:24'!
declareEncodedCharSet: anEncodedCharSetOrLanguageEnvironmentClass atIndex: aNumber
	
	EncodedCharSets at: aNumber put: anEncodedCharSetOrLanguageEnvironmentClass
	
	"this method is used to modularize the old initialize method: 
	EncodedCharSets at: 0+1 put: Unicode.
	EncodedCharSets at: 1+1 put: JISX0208.
	EncodedCharSets at: 2+1 put: GB2312.
	EncodedCharSets at: 3+1 put: KSX1001.
	EncodedCharSets at: 4+1 put: JISX0208.
	EncodedCharSets at: 5+1 put: JapaneseEnvironment.
	EncodedCharSets at: 6+1 put: SimplifiedChineseEnvironment.
	EncodedCharSets at: 7+1 put: KoreanEnvironment.
	EncodedCharSets at: 8+1 put: GB2312.
	EncodedCharSets at: 12+1 put: KSX1001.
	EncodedCharSets at: 13+1 put: GreekEnvironment.
	EncodedCharSets at: 14+1 put: Latin2Environment.
	EncodedCharSets at: 15+1 put: RussianEnvironment.
	EncodedCharSets at: 17+1 put: Latin9Environment.
	EncodedCharSets at: 256 put: Unicode.

	"
	
	! !

!EncodedCharSet class methodsFor: 'language methods' stamp: 'tpr 10/3/2013 12:43'!
scanMultibyteCharactersFrom: startIndex to: stopIndex in: aWideString with: aCharacterScanner rightX: rightX font: aFont
	"the default for scanning multibyte characters- other more specific encodings may do something else"
	^aFont scanMultibyteCharactersFrom: startIndex to: stopIndex in: aWideString with: aCharacterScanner rightX: rightX! !

!EncodedCharSet class methodsFor: 'character classification' stamp: 'yo 8/5/2003 16:40'!
isLowercase: char
	"Answer whether the receiver is a lowercase letter.
	(The old implementation answered whether the receiver is not an uppercase letter.)"

	| value |
	value := char asciiValue.
	^ 8r141 <= value and: [value <= 8r172].
! !

!EncodedCharSet class methodsFor: 'initialize' stamp: 'StephaneDucasse 8/22/2013 14:34'!
initialize
	"self initialize"
	
	EncodedCharSets := Array new: 256.
	self allSubclassesDo: [:each | each initialize].
	LanguageEnvironment allSubclassesDo:  [:each | each initialize].


	"EncodedCharSets at: 0+1 put: Unicode.
	EncodedCharSets at: 1+1 put: JISX0208.
	EncodedCharSets at: 2+1 put: GB2312.
	EncodedCharSets at: 3+1 put: KSX1001.
	EncodedCharSets at: 4+1 put: JISX0208.
	EncodedCharSets at: 5+1 put: JapaneseEnvironment.
	EncodedCharSets at: 6+1 put: SimplifiedChineseEnvironment.
	EncodedCharSets at: 7+1 put: KoreanEnvironment.
	EncodedCharSets at: 8+1 put: GB2312.
	EncodedCharSets at: 12+1 put: KSX1001.
	EncodedCharSets at: 13+1 put: GreekEnvironment.
	EncodedCharSets at: 14+1 put: Latin2Environment.
	EncodedCharSets at: 15+1 put: RussianEnvironment.
	EncodedCharSets at: 17+1 put: Latin9Environment.
	EncodedCharSets at: 256 put: Unicode."
! !

!EncodedCharSet class methodsFor: 'class methods' stamp: 'yo 10/14/2003 10:19'!
ucsTable

	^ UCSTable latin1Table.
! !

!EncodedCharSet class methodsFor: 'class methods' stamp: 'StephaneDucasse 2/13/2010 16:02'!
digitValueOf: char
	"Answer 0-9 if the receiver is $0-$9, 10-35 if it is $A-$Z, and < 0 
	otherwise. This is used to parse literal numbers of radix 2-36."

	| value |
	value := char charCode.
	value <= $9 asciiValue 
		ifTrue: [^value - $0 asciiValue].
	value >= $A asciiValue 
		ifTrue: [ value <= $Z asciiValue ifTrue: [^value - $A asciiValue + 10].
				(value >= $a asciiValue and: [value <= $z asciiValue])
					 ifTrue: [^value - $a asciiValue + 10]].
	^ -1
! !

!EncodedCharSet class methodsFor: 'accessing - displaying' stamp: 'sn 7/31/2009 15:01'!
scanSelector
	^ #scanMultiCharactersFrom:to:in:rightX:stopConditions:kern:! !

!EncodedCharSet class methodsFor: 'class methods' stamp: 'tak 11/5/2005 18:14'!
charFromUnicode: unicode

	| table index |
	unicode < 128 ifTrue: [^ Character value: unicode].

	table := self ucsTable.
	index := table indexOf: unicode.
	index = 0 ifTrue: [
		^ nil.
	].

	^ Character leadingChar: self leadingChar code: index - 1.

! !

!EncodedCharSet class methodsFor: 'character classification' stamp: 'yo 8/5/2003 16:40'!
isLetter: char
	"Answer whether the receiver is a letter."

	| value |
	value := char asciiValue.
	^ (8r141 <= value and: [value <= 8r172]) or: [8r101 <= value and: [value <= 8r132]].
! !

!EncodedCharSet class methodsFor: 'character classification' stamp: 'yo 8/5/2003 17:18'!
canBeNonGlobalVarInitial: char

	| leadingChar |
	leadingChar := char leadingChar.

	leadingChar = 0 ifTrue: [^ self isLowercase: char].
	^ self isLetter: char.
! !

!Encoder commentStamp: '<historical>'!
I encode names and literals into tree nodes with byte codes for the compiler. Byte codes for literals are not assigned until the tree-sizing pass of the compiler, because only then is it known which literals are actually needed. I also keep track of sourceCode ranges during parsing and code generation so I can provide an inverse map for the debugger.!
!Encoder methodsFor: 'initialize-release' stamp: 'PeterHugossonMiller 9/2/2009 16:18'!
fillDict: dict with: nodeClass mapping: keys to: codeArray
	| codeStream |
	codeStream := codeArray readStream.
	keys do: 
		[:key | dict 
				at: key
				put:  (nodeClass new name: key key: key code: codeStream next)]! !

!Encoder methodsFor: 'results' stamp: 'eem 6/24/2008 14:24'!
unusedTempNames 
	| unused |
	unused := OrderedCollection new.
	scopeTable associationsDo:
		[:assn | | name |
		(assn value isUnusedTemp) ifTrue:
			[name := assn value key.
			 name ~= self doItInContextName ifTrue: [unused add: name]]].
	^ unused! !

!Encoder methodsFor: 'temps' stamp: 'crl 2/26/1999 12:18'!
bindBlockTemp: name 
	"Declare a temporary block variable; complain if it's not a field or class variable."

	| node |

	node := scopeTable at: name ifAbsent: [^self reallyBind: name].
	node isTemp
		ifTrue: [
			node scope >= 0 ifTrue: [^ self notify: 'Name already used in this method'].
			node scope: 0]
		ifFalse: [^self notify: 'Name already used in this class'].
	^node
! !

!Encoder methodsFor: 'error handling' stamp: ''!
notify: string at: location

	| req |
	requestor == nil
		ifFalse: 
			[req := requestor.
			self release.
			req notify: string at: location].
	^false! !

!Encoder methodsFor: 'private' stamp: 'eem 9/10/2008 14:03'!
lookupInPools: varName ifFound: assocBlock

	^Symbol
		hasInterned: varName
		ifTrue:
			[:sym|
			(class bindingOf: sym)
				ifNil: [^false]
				ifNotNil: [:assoc| assocBlock value: assoc]]! !

!Encoder methodsFor: 'temps' stamp: 'eem 5/30/2008 12:05'!
bindBlockArg: name within: aBlockNode
	"With standard Smalltalk-80 (BlueBook) blocks it used to be legal to use a
	 method temp as a block argument.  This shouldn't be the case with the
	 current compiler, which checks for temp names already being used as
	 block arguments.  But it is easily fooled by local block temps in optimized
	 blocks, e.g.
		false
			ifTrue: [| temp |]
			ifFalse:[[:temp|]]
	Rather than fix this we keep the semantics and fix it in the closure compiler."
	^self autoBind: name! !

!Encoder methodsFor: 'temps' stamp: 'jm 9/18/97 21:06'!
bindArg: name 
	"Declare an argument."
	| node |
	nTemps >= 15
		ifTrue: [^self notify: 'Too many arguments'].
	node := self bindTemp: name.
	^ node nowHasDef nowHasRef! !

!Encoder methodsFor: 'private' stamp: 'yo 11/11/2002 10:23'!
possibleVariablesFor: proposedVariable

	| results |
	results := proposedVariable correctAgainstDictionary: scopeTable
								continuedFrom: nil.
	proposedVariable first canBeGlobalVarInitial ifTrue:
		[ results := class possibleVariablesFor: proposedVariable
						continuedFrom: results ].
	^ proposedVariable correctAgainst: nil continuedFrom: results.
! !

!Encoder methodsFor: 'visiting' stamp: 'eem 5/30/2008 09:44'!
accept: aVisitor
	"I am not really a ParseNode.  Only here to access constants defined in parseNode."
	self shouldNotImplement! !

!Encoder methodsFor: 'temps' stamp: 'eem 12/1/2008 12:07'!
fixTemp: name
	| node |
	node := scopeTable at: name ifAbsent: [].
	node class ~~ TempVariableNode ifTrue:
		[self error: 'can only fix a floating temp var'].
	node index: nTemps.
	nTemps := nTemps + 1.
	^node! !

!Encoder methodsFor: 'error handling' stamp: ''!
requestor: req
	"Often the requestor is a BrowserCodeController"
	requestor := req! !

!Encoder methodsFor: 'initialize-release' stamp: 'nice 4/1/2011 19:26'!
initScopeAndLiteralTables

	scopeTable := StdVariables copy.
	litSet := StdLiterals copy.
	"comments can be left hanging on nodes from previous compilations.
	 probably better than this hack fix is to create the nodes afresh on each compilation."
	scopeTable do:
		[:varNode| varNode comment: nil].
	litSet do:
		[:varNode| varNode comment: nil].
	selectorSet := StdSelectors copy.
	litIndSet := Dictionary new: 16.
	literalStream := (Array new: 32) writeStream.
	addedSelectorAndMethodClassLiterals := false.
	optimizedSelectors := Set new! !

!Encoder methodsFor: 'initialize-release' stamp: 'MarcusDenker 3/23/2010 18:43'!
init: aClass context: aContext notifying: req
	requestor := req.
	class := aClass.
	nTemps := 0.
	supered := false.
	self initScopeAndLiteralTables.
	class variablesAndOffsetsDo:
		[:variable "<String>" :offset "<Integer>" |
			scopeTable
						at: variable
						put: (offset >= 0
								ifTrue: [InstanceVariableNode new
											name: variable index: offset]
								ifFalse: [MaybeContextInstanceVariableNode new
											name: variable index: offset negated])].
	aContext ~~ nil ifTrue:
		[| homeNode |
		 homeNode := self bindTemp: self doItInContextName.
		 "0th temp = aContext passed as arg"
		 aContext tempNames withIndexDo:
			[:variable :index|
			scopeTable
				at: variable
				put: (MessageAsTempNode new
						receiver: homeNode
						selector: #namedTempAt:
						arguments: (Array with: (self encodeLiteral: index))
						precedence: 3
						from: self)]].
	sourceRanges := Dictionary new: 32.
	globalSourceRanges := OrderedCollection new: 32! !

!Encoder methodsFor: 'initialize-release' stamp: ''!
release

	requestor := nil! !

!Encoder methodsFor: 'encoding' stamp: 'MarcusDenker 6/24/2013 11:12'!
encodeSelector: aSelector

	^self
		name: aSelector
		key: aSelector
		class: SelectorNode
		type: SendType
		set: selectorSet! !

!Encoder methodsFor: 'temps' stamp: ''!
newTemp: name

	nTemps := nTemps + 1.
	^ TempVariableNode new
		name: name
		index: nTemps - 1
		type: LdTempType
		scope: 0! !

!Encoder methodsFor: 'temps' stamp: 'eem 7/13/2007 14:13'!
floatTemp: node
	(node ~~ (scopeTable at: node name ifAbsent: [])
	or: [node class ~~ TempVariableNode
	or: [node code ~= (node code: nTemps - 1 type: LdTempType)]]) ifTrue:
		[self error: 'can only float the last allocated temp var'].
	nTemps := nTemps - 1! !

!Encoder methodsFor: 'error handling' stamp: 'eem 12/22/2009 11:57'!
notify: string
	"Put a separate notifier on top of the requestor's window"
	| req |
	requestor == nil
		ifTrue:
			[super notify: string]
		ifFalse: 
			[req := requestor.
			self release.
			req notify: string].
	^false! !

!Encoder methodsFor: 'accessing' stamp: 'ar 9/9/2006 12:06'!
selector: aSymbol
	selector := aSymbol! !

!Encoder methodsFor: 'encoding' stamp: 'MarcusDenker 5/16/2013 11:11'!
encodeVariable: name sourceRange: range ifUnknown: action
	| varNode |
	varNode := scopeTable at: name
			ifAbsent: 
				[(self lookupInPools: name 
					ifFound: [:assoc | varNode := self global: assoc name: name])
					ifTrue: [varNode]
					ifFalse: [^action value]].
	range ifNotNil: [
		name first canBeGlobalVarInitial ifTrue:
			[globalSourceRanges addLast: { name. range. false }]. ].

	(varNode isTemp and: [varNode scope < 0]) ifTrue: [
		"every client just does resume: true"
		action value.
		
	"	OutOfScopeNotification signal 
			ifTrue: [action value]
			ifFalse: [ ^self notify: 'out of scope']."
	].
	^ varNode! !

!Encoder methodsFor: 'results' stamp: 'eem 5/27/2009 09:25'!
associationForClass
	| assoc |
	assoc := self environment associationAt: class name ifAbsent: [nil].
	^assoc value == class
		ifTrue: [assoc]
		ifFalse: [Association new value: class]! !

!Encoder methodsFor: 'private' stamp: 'Lukas Renggli 11/2/2009 00:29'!
name: name key: key class: leafNodeClass type: type set: dict 
	^dict at: key
		ifAbsentPut: 
			[leafNodeClass new 
				name: name
				key: key
				index: nil
				type: type]! !

!Encoder methodsFor: 'source mapping' stamp: 'RAA 8/21/1999 06:52'!
rawSourceRanges

	^ sourceRanges ! !

!Encoder methodsFor: 'temps' stamp: 'ar 9/9/2006 12:05'!
autoBind: name 
	"Declare a block argument as a temp if not already declared."
	| node |
	node := scopeTable 
			at: name
			ifAbsent: 
				[(self lookupInPools: name ifFound: [:assoc | assoc])
					ifTrue: [self warnAboutShadowed: name].
				^ (self reallyBind: name) nowHasDef nowHasRef scope: 1].
	node isTemp
		ifTrue: [node scope >= 0 ifTrue:
					[^ self notify: 'Name already used in this method'].
				node nowHasDef nowHasRef scope: 1]
		ifFalse: [^ self notify: 'Name already used in this class'].
	^node! !

!Encoder methodsFor: 'results' stamp: ''!
literals
	"Should only be used for decompiling primitives"
	^ literalStream contents! !

!Encoder methodsFor: 'accessing' stamp: 'ar 9/9/2006 12:06'!
selector
	^selector! !

!Encoder methodsFor: 'encoding' stamp: 'eem 9/5/2009 20:04'!
doItInContextName
	^'ThisContext'! !

!Encoder methodsFor: 'temps' stamp: 'eem 5/30/2008 14:14'!
bindBlockTemp: name within: aBlockNode
	"The BlockContext compiler (the Smalltalk-80 BlueBook compiler)
	 does provide support for ANSI block syntax, but not for ANSI block
	 semantics.  Here all temps live at the same level, the method level.
	 The approach taken to two block-local temps in different blocks is to
	 merge them into a single temp.  e.g.
		expr
			ifTrue: [|temp| self statementOne]
			ifFalse: [|temp| self statementTwo]
	 is effectvely transformed into
		| temp |
		expr
			ifTrue: [self statementOne]
			ifFalse: [self statementTwo]
	 and
		expr do: [:each| | temp | ...].
		expr do: [:each| | temp | ...].
	 is also effectively transformed into
		| temp |
		expr do: [:each|  ...].
		expr do: [:each| ...].

	 The closure compiler treats the former similarly, but not the latter.
	 The indirection through #bindBlockTemp:within: allows the closure encoder to do this."
	^self bindBlockTemp: name! !

!Encoder methodsFor: 'results' stamp: 'nice 3/31/2011 00:35'!
allLiterals
	addedSelectorAndMethodClassLiterals ifFalse:
		[addedSelectorAndMethodClassLiterals := true.
		"Put the optimized selectors in literals so as to browse senders more easily"
		optimizedSelectors := optimizedSelectors reject: [:e| literalStream originalContents hasLiteral: e].
		optimizedSelectors isEmpty ifFalse: [
			"Use one entry per literal if enough room, else make anArray"
			literalStream position + optimizedSelectors size + 2 > 255
				ifTrue: [self litIndex: optimizedSelectors asArray]
				ifFalse: [optimizedSelectors do: [:e | self litIndex: e]]].
		"Add a slot for selector or MethodProperties"
		self litIndex: nil.
		self litIndex: self associationForClass].
	^literalStream contents! !

!Encoder methodsFor: 'encoding' stamp: 'nice 3/30/2011 23:26'!
noteOptimizedSelector: aSymbol
	"Register a selector as being optimized.
	These optimized selectors will later be registered into the literals so that tools can easily browse senders."
	optimizedSelectors add: aSymbol! !

!Encoder methodsFor: 'encoding' stamp: 'StephaneDucasse 3/20/2010 17:23'!
environment
	"Answer the environment of the current compilation context,
	 be it in a class or global (e.g. a workspace)"
	^class == nil
		ifTrue: [Smalltalk globals]
		ifFalse: [class environment]! !

!Encoder methodsFor: 'temps' stamp: 'di 10/12/1999 16:53'!
bindAndJuggle: name

	| node nodes first thisCode |
	node := self reallyBind: name.

	"Declared temps must precede block temps for decompiler and debugger to work right"
	nodes := self tempNodes.
	(first := nodes findFirst: [:n | n scope > 0]) > 0 ifTrue:
		[node == nodes last ifFalse: [self error: 'logic error'].
		thisCode := (nodes at: first) code.
		first to: nodes size - 1 do:
			[:i | (nodes at: i) key: (nodes at: i) key
							code: (nodes at: i+1) code].
		nodes last key: nodes last key code: thisCode].
	
	^ node! !

!Encoder methodsFor: 'temps' stamp: 'JorgeRessia 6/5/2010 11:31'!
evaluateShadowingInteractivelyOf: aNode 
	self isAnalyzedMethodDefinedByATrait ifTrue: [^false].
	aNode isTemp
				ifTrue: [ (aNode scope >= 0) ifTrue: [ ^self notify:'Name is already defined']  ]
				ifFalse: [ ^self notify:'Name is already defined' ].
! !

!Encoder methodsFor: 'encoding' stamp: 'di 12/4/1999 20:09'!
encodeVariable: name
	^ self encodeVariable: name sourceRange: nil ifUnknown: [ self undeclared: name ]! !

!Encoder methodsFor: 'encoding' stamp: 'eem 5/16/2008 18:30'!
sharableLitIndex: literal
	"Special access prevents multiple entries for post-allocated super send special selectors"
	1 to: literalStream position do:
		[:index|
		(litSet literalEquality: literal and: (literalStream originalContents at: index)) ifTrue:
			[^index - 1]].
	^self litIndex: literal! !

!Encoder methodsFor: 'encoding' stamp: 'pavel.krivanek 3/2/2010 21:25'!
undeclared: name
	| sym |
	requestor interactive ifTrue:
		[requestor == #error: ifTrue:
			[requestor error: 'Undeclared'].
		 ^self notify: 'Undeclared'].
	"Allow knowlegeable clients to squash the undeclared warning if they want (e.g.
	 Diffing pretty printers that are simply formatting text).  As this breaks
	 compilation it should only be used by clients that want to discard the result
	 of the compilation.  To squash the warning use e.g.
		[Compiler format: code in: class notifying: nil decorated: false]
			on: UndeclaredVariableWarning
			do: [:ex| ex resume: false]"
	sym := name asSymbol.
	^(UndeclaredVariableWarning new name: name selector: selector class: class) signal
		ifTrue:
			[Undeclared at: sym put: nil.
			self global: (Undeclared associationAt: sym) name: sym]
		ifFalse:
			[self global: (Association key: sym) name: sym]! !

!Encoder methodsFor: 'results' stamp: 'eem 5/27/2008 12:07'!
tempNodes 
	| tempNodes |
	tempNodes := SortedCollection sortBlock: [:n1 :n2 | n1 code <= n2 code].
	scopeTable associationsDo:
		[:assn |
		assn value isArray
			ifTrue: [assn value do: [:temp| tempNodes add: temp]]
			ifFalse: [assn value isTemp ifTrue: [tempNodes add: assn value]]].
	^tempNodes! !

!Encoder methodsFor: 'temps' stamp: 'JorgeRessia 6/5/2010 11:32'!
isAnalyzedMethodDefinedByATrait
	^( class traitOrClassOfSelector: #testReplaceFromToWithStartingAt ) isTrait! !

!Encoder methodsFor: 'temps' stamp: ''!
maxTemp

	^nTemps! !

!Encoder methodsFor: 'temps' stamp: 'JorgeRessia 6/5/2010 11:32'!
evaluateShadowingNotInteractivelyOf: aNode 
	self isAnalyzedMethodDefinedByATrait ifTrue: [^false].
	aNode isTemp
				ifTrue: [(aNode scope >= 0) ifTrue: [ ^self notify:'Name is already defined'] ]
				ifFalse: [ self warnAboutShadowed: aNode name ]
! !

!Encoder methodsFor: 'private' stamp: ''!
classEncoding
	"This is a hack so that the parser may findout what class it was parsing for when it wants to create a syntax error view."
	^ class! !

!Encoder methodsFor: 'encoding' stamp: ''!
encodeLiteral: object

	^self
		name: object
		key: (class literalScannedAs: object notifying: self)
		class: LiteralNode
		type: LdLitType
		set: litSet! !

!Encoder methodsFor: 'private' stamp: 'ar 8/14/2001 23:12'!
global: ref name: name

	^self
		name: name
		key: ref
		class: LiteralVariableNode
		type: LdLitIndType
		set: litIndSet! !

!Encoder methodsFor: 'encoding' stamp: ''!
cantStoreInto: varName

	^StdVariables includesKey: varName! !

!Encoder methodsFor: 'private' stamp: ''!
reallyBind: name

	| node |
	node := self newTemp: name.
	scopeTable at: name put: node.
	^node! !

!Encoder methodsFor: 'private' stamp: 'ar 3/26/2004 15:44'!
interactive
	^requestor interactive! !

!Encoder methodsFor: 'initialize-release' stamp: 'PeterHugossonMiller 9/2/2009 16:17'!
temps: tempVars literals: lits class: cl 
	"Decompile."

	supered := false.
	class := cl.
	nTemps := tempVars size.
	tempVars do: [:node | scopeTable at: node name put: node].
	(literalStream := lits readStream) position: lits size.
	sourceRanges := Dictionary new: 32.
	globalSourceRanges := OrderedCollection new: 32.
! !

!Encoder methodsFor: 'initialize-release' stamp: ''!
noteSuper

	supered := true! !

!Encoder methodsFor: 'accessing' stamp: 'eem 5/29/2008 09:36'!
methodNodeClass
	^MethodNode! !

!Encoder methodsFor: 'encoding' stamp: ''!
litIndex: literal
	| p |
	p := literalStream position.
	p = 256 ifTrue:
		[self notify: 'More than 256 literals referenced. 
You must split or otherwise simplify this method.
The 257th literal is: ', literal printString. ^nil].
		"Would like to show where it is in the source code, 
		 but that info is hard to get."
	literalStream nextPut: literal.
	^ p! !

!Encoder methodsFor: 'source mapping' stamp: ''!
noteSourceRange: range forNode: node

	sourceRanges at: node put: range! !

!Encoder methodsFor: 'results' stamp: 'di 10/12/1999 16:12'!
tempNames 

	^ self tempNodes collect:
		[:node | (node isMemberOf: MessageAsTempNode)
					ifTrue: [scopeTable keyAtValue: node]
					ifFalse: [node key]]! !

!Encoder methodsFor: 'temps' stamp: 'JorgeRessia 3/4/2010 22:00'!
bindTemp: name 
	"Declare a temporary; error not if a field or class variable."
	scopeTable at: name ifPresent:
	[:node|
			(requestor interactive)
						ifTrue: [self evaluateShadowingInteractivelyOf: node]
						ifFalse: [self evaluateShadowingNotInteractivelyOf: node] ].
	^self reallyBind: name! !

!Encoder methodsFor: 'private' stamp: 'eem 6/19/2008 13:02'!
warnAboutShadowed: name
	requestor addWarning: name,' is shadowed'.
	selector ifNotNil:
		[Transcript cr; show: class name,'>>', selector, '(', name,' is shadowed)']! !

!Encoder methodsFor: 'temps' stamp: 'mir 1/17/2004 12:31'!
bindTemp: name in: methodSelector
	"Declare a temporary; error not if a field or class variable."
	scopeTable at: name ifPresent:[:node|
		"When non-interactive raise the error only if its a duplicate"
		(node isTemp or:[requestor interactive])
			ifTrue:[^self notify:'Name is already defined']
			ifFalse:[Transcript 
				show: '(', name, ' is shadowed in "' , class printString , '>>' , methodSelector printString , '")']].
	^self reallyBind: name! !

!EncoderForLongFormV3 commentStamp: '<historical>'!
I am an alternate to EncoderForV3 that tries to use thje longest forms of bytecodes possible so as to avoid using as many bytecode as possible to allow for the unused portions of the bytecode set this makes available to be reassigned.



I do not use the following ranges

0 through 111

	   0- 15 	0000iiii 	Push Receiver Variable #iiii

	  16- 31 	0001iiii 	Push Temporary Location #iiii

	  32- 63 	001iiiii 		Push Literal Constant #iiiii

	  64- 95 	010iiiii 		Push Literal Variable #iiiii

	  96-103 	01100iii 	Pop and Store Receiver Variable #iii

	104-111 	01101iii 	Pop and Store Temporary Location #iii

138-159

	138-143 				Unused.

	144-151 	10010iii 	Jump iii + 1 (i.e., 1 through 8).

	152-159 	10011iii 	Pop and Jump 0n False iii +1 (i.e., 1 through 8).

176-255

	176-191 	1011iiii 	Send Arithmetic Message #iiii

	192-207 	1100iiii 	Send Special Message #iiii

	208-223 	1101iiii 	Send Literal Selector #iiii With No Arguments

	224-239 	1110iiii 	Send Literal Selector #iiii With 1 Argument

	240-255 	1111iiii 	Send Literal Selector #iiii With 2 Arguments

= 112 + (160 - 138) + (256 - 176) =  214, or 84% of the bytecodes!
!EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 16:52'!
genBranchPopFalse: distance
	"See BlueBook page 596"
	distance < 0 ifTrue:
		[^self outOfRangeError: 'distance' index: distance range: 0 to: 1023].
	distance < 1024 ifTrue:
		["172-175 	101011ii jjjjjjjj 	Pop and Jump On False ii *256+jjjjjjjj"
		 stream
			nextPut: 172 + (distance bitShift: -8);
			nextPut: distance + 1024 \\ 256.
		 ^self].
	^self outOfRangeError: 'distance' index: distance range: 0 to: 1023! !

!EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 6/19/2008 08:50'!
genStorePopInstVar: instVarIndex
	"See BlueBook page 596"
	(instVarIndex >= 0 and: [instVarIndex < 64]) ifTrue:
		["130 	10000010 jjkkkkkk 	Pop and Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk"
		 stream
			nextPut: 130;
			nextPut: instVarIndex.
		 ^self].
	self genStorePopInstVarLong: instVarIndex! !

!EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 6/19/2008 08:51'!
genStoreInstVarLong: instVarIndex
	"See BlueBook page 596"
	"See also MaybeContextInstanceVariableNode"
	(instVarIndex >= 0 and: [instVarIndex < 256]) ifTrue: 
		["132 	10000100 iiijjjjj kkkkkkkk 	(Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj"
		 stream
			nextPut: 132;
			nextPut: 160;
			nextPut: instVarIndex.
		 ^self].
	^self outOfRangeError: 'index' index: instVarIndex range: 0 to: 255! !

!EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 16:55'!
genSendSuper: selectorLiteralIndex numArgs: nArgs
	"See BlueBook page 596 (with exceptions for 132 & 134)"
	nArgs < 0 ifTrue:
		[^self outOfRangeError: 'numArgs' index: nArgs range: 0 to: 31 "!!!!"].
	selectorLiteralIndex < 0 ifTrue:
		[^self outOfRangeError: 'selector literal index' index: selectorLiteralIndex range: 0 to: 255].
	(selectorLiteralIndex < 32 and: [nArgs < 8]) ifTrue: 
		["	133 	10000011 jjjkkkkk 	Send Literal Selector #kkkkk To Superclass With jjj Arguments"
		 stream
			nextPut: 133;
			nextPut: ((nArgs bitShift: 5) + selectorLiteralIndex).
		 ^self].
	(selectorLiteralIndex <= 255 and: [nArgs <= 31]) ifTrue: 
		["In Squeak V3
			132 	10000100 jjjjjjjj kkkkkkkk 	Send Literal Selector #kkkkkkkk With jjjjjjjj Arguments
		  is replaced by
			132 	10000100 ooojjjjj kkkkkkkk
				ooo = 0 => Send Literal Selector #kkkkkkkk With jjjjj Arguments
				ooo = 1 => Send Literal Selector #kkkkkkkk To Superclass With jjjjj Arguments"
		stream
			nextPut: 132;
			nextPut: 32 + nArgs;
			nextPut: selectorLiteralIndex.
		 ^self].
	nArgs > 31 ifTrue:
		[^self outOfRangeError: 'numArgs' index: nArgs range: 0 to: 31].
	selectorLiteralIndex > 255 ifTrue: 
		[^self outOfRangeError: 'selector literal index' index: selectorLiteralIndex range: 0 to: 255]! !

!EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 6/19/2008 08:46'!
genPushInstVar: instVarIndex
	"See BlueBook page 596"
	(instVarIndex >= 0 and: [instVarIndex < 64]) ifTrue: 
		["128 	10000000 jjkkkkkk 	Push (Receiver Variable, Temporary Location, Literal Constant, Literal Variable) [jj] #kkkkkk"
		 stream
			nextPut: 128;
			nextPut: instVarIndex.
		 ^self].
	self genPushInstVarLong: instVarIndex! !

!EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 5/15/2008 14:12'!
genDup
	"See BlueBook page 596"
	"136 	10001000 	Duplicate Stack Top"
	stream nextPut: 136! !

!EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 5/15/2008 14:12'!
genReturnReceiver
	"See BlueBook page 596"
	"120-123 	011110ii 	Return (receiver, true, false, nil) [ii] From Message"
	stream nextPut: 120! !

!EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 16:54'!
genPushLiteral: literalIndex
	"See BlueBook page 596"
	literalIndex < 0 ifTrue: 
		[^self outOfRangeError: 'index' index: literalIndex range: 0 to: 255].
	literalIndex < 64 ifTrue: 
		["128 	10000000 jjkkkkkk 	Push (Receiver Variable, Temporary Location, Literal Constant, Literal Variable) [jj] #kkkkkk"
		 stream
			nextPut: 128;
			nextPut: 128 + literalIndex.
		 ^self].
	literalIndex < 256 ifTrue: 
		["132 	10000100 iiijjjjj kkkkkkkk 	(Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj"
		 stream
			nextPut: 132;
			nextPut: 96;
			nextPut: literalIndex.
		 ^self].
	^self outOfRangeError: 'index' index: literalIndex range: 0 to: 255! !

!EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 5/15/2008 14:12'!
genReturnTop
	"See BlueBook page 596"
	"124-125 	0111110i 	Return Stack Top From (Message, Block) [i]"
	stream nextPut: 124! !

!EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 16:58'!
genStoreTemp: tempIndex
	"See BlueBook page 596"
	tempIndex < 0 ifTrue:
		[^self outOfRangeError: 'index' index: tempIndex range: 0 to: 63].
	tempIndex < 64 ifTrue: 
		["129 	10000001 jjkkkkkk 	Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk"
		 stream
			nextPut: 129;
			nextPut: 64 + tempIndex.
		 ^self].
	^self outOfRangeError: 'index' index: tempIndex range: 0 to: 63! !

!EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 5/15/2008 14:12'!
genPushSpecialLiteral: aLiteral
	"112-119 	01110iii 	Push (receiver, true, false, nil, -1, 0, 1, 2) [iii]"
	| index |
	index := #(true false nil -1 0 1 2) indexOf: aLiteral ifAbsent: 0.
	index = 0 ifTrue:
		[^self error: 'push special literal: ', aLiteral printString,  ' is not one of true false nil -1 0 1 2'].
	stream nextPut: index + 112! !

!EncoderForLongFormV3 methodsFor: 'initialize-release' stamp: 'eem 5/15/2008 14:11'!
initScopeAndLiteralTables
	super initScopeAndLiteralTables.
	"Start with an empty selector set to avoid the special selectors."
	selectorSet := Dictionary new: 16! !

!EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 16:58'!
genStorePopTemp: tempIndex
	"See BlueBook page 596"
	tempIndex < 0 ifTrue:
		[^self outOfRangeError: 'index' index: tempIndex range: 0 to: 63].
	tempIndex < 64 ifTrue: 
		["130 	10000010 jjkkkkkk 	Pop and Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk"
		 stream
			nextPut: 130;
			nextPut: 64 + tempIndex.
		 ^self].
	^self outOfRangeError: 'index' index: tempIndex range: 0 to: 63! !

!EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 5/15/2008 14:12'!
genReturnTopToCaller
	"See BlueBook page 596"
	"124-125 	0111110i 	Return Stack Top From (Message, Block) [i]"
	stream nextPut: 125! !

!EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 5/15/2008 14:12'!
genPushReceiver
	"See BlueBook page 596"
	"112-119 	01110iii 	Push (receiver, true, false, nil, -1, 0, 1, 2) [iii]"
	stream nextPut: 112! !

!EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 16:54'!
genPushTemp: tempIndex
	"See BlueBook page 596"
	tempIndex < 0 ifTrue:
		[^self outOfRangeError: 'index' index: tempIndex range: 0 to: 63].
	tempIndex < 64 ifTrue: 
		["128 	10000000 jjkkkkkk 	Push (Receiver Variable, Temporary Location, Literal Constant, Literal Variable) [jj] #kkkkkk"
		 stream
			nextPut: 128;
			nextPut: 64 + tempIndex.
		 ^self].
	^self outOfRangeError: 'index' index: tempIndex range: 0 to: 63! !

!EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 6/19/2008 08:48'!
genStoreInstVar: instVarIndex
	"See BlueBook page 596"
	(instVarIndex >= 0 and: [instVarIndex < 64]) ifTrue: 
		["129 	10000001 jjkkkkkk 	Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk"
		 stream
			nextPut: 129;
			nextPut: instVarIndex.
		 ^self].
	self genStoreInstVarLong: instVarIndex! !

!EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 16:53'!
genBranchPopTrue: distance
	"See BlueBook page 596"
	distance < 0 ifTrue:
		[^self outOfRangeError: 'distance' index: distance range: 0 to: 1023].
	distance < 1024 ifTrue:
		["168-171 	101010ii jjjjjjjj 	Pop and Jump On True ii *256+jjjjjjjj"
		 stream
			nextPut: 168 + (distance bitShift: -8);
			nextPut: distance + 1024 \\ 256.
		 ^self].
	^self outOfRangeError: 'distance' index: distance range: 0 to: 1023! !

!EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 5/15/2008 14:12'!
genReturnSpecialLiteral: aLiteral
	"120-123 	011110ii 	Return (receiver, true, false, nil) [ii] From Message"
	| index |
	index := #(true false nil) indexOf: aLiteral ifAbsent: 0.
	index = 0 ifTrue:
		[^self error: 'return special literal: ', aLiteral printString,  ' is not one of true false nil'].
	stream nextPut: 120 + index! !

!EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 5/15/2008 14:20'!
genJump: distance
	"See BlueBook page 596"
	^self genJumpLong: distance! !

!EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 16:57'!
genStoreLiteralVar: literalIndex
	"See BlueBook page 596"
	literalIndex < 0 ifTrue:
		[^self outOfRangeError: 'index' index: literalIndex range: 0 to: 255].
	literalIndex < 64 ifTrue: 
		["129 	10000001 jjkkkkkk 	Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk"
		 stream
			nextPut: 129;
			nextPut: 192 + literalIndex.
		 ^self].
	literalIndex <= 255 ifTrue: 
		["132 	10000100 iiijjjjj kkkkkkkk 	(Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj"
		 stream
			nextPut: 132;
			nextPut: 224;
			nextPut: literalIndex.
		 ^self].
	^self outOfRangeError: 'index' index: literalIndex range: 0 to: 255! !

!EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 6/19/2008 08:51'!
genPushInstVarLong: instVarIndex
	"See BlueBook page 596"
	"See also MaybeContextInstanceVariableNode"
	(instVarIndex >= 0 and: [instVarIndex < 256]) ifTrue: 
		["132 	10000100 iiijjjjj kkkkkkkk 	(Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj"
		 stream
			nextPut: 132;
			nextPut: 64;
			nextPut: instVarIndex.
		 ^self].
	^self outOfRangeError: 'index' index: instVarIndex range: 0 to: 255! !

!EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 16:56'!
genSend: selectorLiteralIndex numArgs: nArgs
	"See BlueBook page 596 (with exceptions for 132 & 134)"
	nArgs < 0 ifTrue:
		[^self outOfRangeError: 'numArgs' index: nArgs range: 0 to: 31 "!!!!"].
	selectorLiteralIndex < 0 ifTrue:
		["No special selector sends in long form."
		^self outOfRangeError: 'selector literal index' index: selectorLiteralIndex range: 0 to: 255].
	(selectorLiteralIndex < 32 and: [nArgs < 8]) ifTrue: 
		["	131 	10000011 jjjkkkkk 	Send Literal Selector #kkkkk With jjj Arguments"
		 stream
			nextPut: 131;
			nextPut: ((nArgs bitShift: 5) + selectorLiteralIndex).
		 ^self].
	(selectorLiteralIndex < 64 and: [nArgs < 4]) ifTrue: 
	 	["In Squeak V3
			134 	10000110 jjjjjjjj kkkkkkkk 	Send Literal Selector #kkkkkkkk To Superclass With jjjjjjjj Arguments
		 is replaced by
			134 	10000110 jjkkkkkk 	Send Literal Selector #kkkkkk With jj Arguments"
		 stream
			nextPut: 134;
			nextPut: ((nArgs bitShift: 6) + selectorLiteralIndex).
		 ^self].
	(selectorLiteralIndex <= 255 and: [nArgs <= 31]) ifTrue: 
		["In Squeak V3
			132 	10000100 jjjjjjjj kkkkkkkk 	Send Literal Selector #kkkkkkkk With jjjjjjjj Arguments
		  is replaced by
			132 	10000100 ooojjjjj kkkkkkkk
				ooo = 0 => Send Literal Selector #kkkkkkkk With jjjjj Arguments
				ooo = 1 => Send Literal Selector #kkkkkkkk To Superclass With jjjjj Arguments"
		stream
			nextPut: 132;
			nextPut: nArgs;
			nextPut: selectorLiteralIndex.
		 ^self].
	nArgs > 31 ifTrue:
		[^self outOfRangeError: 'numArgs' index: nArgs range: 0 to: 31].
	selectorLiteralIndex > 255 ifTrue: 
		[^self outOfRangeError: 'selector literal index' index: selectorLiteralIndex range: 0 to: 255]! !

!EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 16:58'!
genStorePopLiteralVar: literalIndex
	"See BlueBook page 596"
	literalIndex < 0 ifTrue:
		[^self outOfRangeError: 'index' index: literalIndex range: 0 to: 255].
	literalIndex < 64 ifTrue: 
		["130 	10000010 jjkkkkkk 	Pop and Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk"
		 stream
			nextPut: 130;
			nextPut: 192 + literalIndex.
		 ^self].
	literalIndex <= 255 ifTrue: 
		["132 	10000100 iiijjjjj kkkkkkkk 	(Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj"
		 stream
			nextPut: 132;
			nextPut: 224;
			nextPut: literalIndex.
		 self genPop.
		 ^self].
	^self outOfRangeError: 'index' index: literalIndex range: 0 to: 255! !

!EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 16:54'!
genPushLiteralVar: literalIndex
	"See BlueBook page 596"
	literalIndex < 0 ifTrue: 
		[^self outOfRangeError: 'index' index: literalIndex range: 0 to: 255].
	literalIndex < 64 ifTrue: 
		["128 	10000000 jjkkkkkk 	Push (Receiver Variable, Temporary Location, Literal Constant, Literal Variable) [jj] #kkkkkk"
		 stream
			nextPut: 128;
			nextPut: 192 + literalIndex.
		 ^self].
	literalIndex < 256 ifTrue: 
		["132 	10000100 iiijjjjj kkkkkkkk 	(Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj"
		 stream
			nextPut: 132;
			nextPut: 128;
			nextPut: literalIndex.
		 ^self].
	^self outOfRangeError: 'index' index: literalIndex range: 0 to: 255! !

!EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 5/15/2008 14:12'!
genPushThisContext
	"See BlueBook page 596"
	"137 	10001001 	Push Active Context"
	stream nextPut: 137! !

!EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 6/19/2008 08:51'!
genStorePopInstVarLong: instVarIndex
	"See BlueBook page 596"
	"See also MaybeContextInstanceVariableNode"
	(instVarIndex >= 0 and: [instVarIndex < 256]) ifTrue: 
		["132 	10000100 iiijjjjj kkkkkkkk 	(Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj"
		 stream
			nextPut: 132;
			nextPut: 192;
			nextPut: instVarIndex.
		 ^self].
	^self outOfRangeError: 'index' index: instVarIndex range: 0 to: 255! !

!EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 16:53'!
genJumpLong: distance
	"See BlueBook page 596"
	(distance >= -1024 and: [distance < 1024]) ifTrue:
		["160-167 	10100iii jjjjjjjj 	Jump(iii - 4) *256+jjjjjjjj"
		 stream
			nextPut: 160 + (distance + 1024 bitShift: -8);
			nextPut: distance + 1024 \\ 256.
		 ^self].
	^self outOfRangeError: 'distance' index: distance range: -1024 to: 1023! !

!EncoderForLongFormV3 methodsFor: 'bytecode generation' stamp: 'eem 5/15/2008 14:12'!
genPop
	"See BlueBook page 596"
	"135 	10000111 	Pop Stack Top"
	stream nextPut: 135! !

!EncoderForLongFormV3PlusClosures commentStamp: '<historical>'!
An encoder for the V3 bytecode set augmented with the following bytecodes that are part of the full closure implementation.
	138   10001010 jkkkkkkk		Push (Array new: kkkkkkk) (j = 0)
								or	Pop kkkkkkk elements into: (Array new: kkkkkkk) (j = 1)

	140   10001100 kkkkkkkk jjjjjjjj 	Push Temp At kkkkkkkk In Temp Vector At: jjjjjjjj
	141   10001101 kkkkkkkk jjjjjjjj 	Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj
	142   10001110 kkkkkkkk jjjjjjjj 	Pop and Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj
	143   10001111 llllkkkk jjjjjjjj iiiiiiii	Push Closure Num Copied llll Num Args kkkk BlockSize jjjjjjjjiiiiiiii
This is an exact duplicate of EncoderForV3PlusClosures.
Could be a trait (or in Newspeak, a Mixin).
For now we impose upon you to synchronise any and all changes between these two classes.!
!EncoderForLongFormV3PlusClosures methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 17:10'!
genPushClosureCopyNumCopiedValues: numCopied numArgs: numArgs jumpSize: jumpSize
	"143 	10001111 llllkkkk jjjjjjjj iiiiiiii	Push Closure Num Copied llll Num Args kkkk BlockSize jjjjjjjjiiiiiiii"
	(jumpSize < 0 or: [jumpSize > 65535]) ifTrue:
		[^self outOfRangeError: 'block size' index: jumpSize range: 0 to: 65535].
	(numCopied < 0 or: [numCopied > 15]) ifTrue:
		[^self outOfRangeError: 'num copied' index: numCopied range: 0 to: 15].
	(numArgs < 0 or: [numArgs > 15]) ifTrue:
		[^self outOfRangeError: 'num args' index: numArgs range: 0 to: 15].
	stream
		nextPut: 143;
		nextPut: numArgs + (numCopied bitShift: 4);
		nextPut: (jumpSize bitShift: -8);
		nextPut: (jumpSize bitAnd: 16rFF)! !

!EncoderForLongFormV3PlusClosures methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 17:06'!
genPushConsArray: size
	(size < 0 or: [size > 127]) ifTrue:
		[^self outOfRangeError: 'numElements' index: size range: 0 to: 127].
	"138 	10001010 1kkkkkkk 	Pop kkkkkkk into: (Array new: kkkkkkk)"
	stream
		nextPut: 138;
		nextPut: size + 128! !

!EncoderForLongFormV3PlusClosures methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 17:05'!
genPushNewArray: size
	(size < 0 or: [size > 127]) ifTrue:
		[^self outOfRangeError: 'size' index: size range: 0 to: 127].
	"138 	10001010 0kkkkkkk 	Push (Array new: kkkkkkk)"
	stream
		nextPut: 138;
		nextPut: size! !

!EncoderForLongFormV3PlusClosures methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 17:04'!
genStorePopRemoteTemp: tempIndex inVectorAt: tempVectorIndex
	"142 	10001110 kkkkkkkk jjjjjjjj 	Pop and Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj"
	(tempIndex >= 0 and: [tempIndex < 256
	 and: [tempVectorIndex >= 0 and: [tempVectorIndex < 256]]]) ifTrue:
		[stream
			nextPut: 142;
			nextPut: tempIndex;
			nextPut: tempVectorIndex.
		 ^self].
	tempIndex >= 256 ifTrue:
		[^self outOfRangeError: 'remoteTempIndex' index: tempIndex range: 0 to: 255].
	tempVectorIndex >= 256 ifTrue:
		[^self outOfRangeError: 'tempVectorIndex' index: tempVectorIndex range: 0 to: 255]! !

!EncoderForLongFormV3PlusClosures methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 17:04'!
genStoreRemoteTemp: tempIndex inVectorAt: tempVectorIndex
	"141 	10001101 kkkkkkkk jjjjjjjj 	Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj"
	(tempIndex >= 0 and: [tempIndex < 256
	 and: [tempVectorIndex >= 0 and: [tempVectorIndex < 256]]]) ifTrue:
		[stream
			nextPut: 141;
			nextPut: tempIndex;
			nextPut: tempVectorIndex.
		 ^self].
	tempIndex >= 256 ifTrue:
		[^self outOfRangeError: 'remoteTempIndex' index: tempIndex range: 0 to: 255].
	tempVectorIndex >= 256 ifTrue:
		[^self outOfRangeError: 'tempVectorIndex' index: tempVectorIndex range: 0 to: 255]! !

!EncoderForLongFormV3PlusClosures methodsFor: 'testing' stamp: 'eem 5/24/2008 18:12'!
supportsClosureOpcodes
	^true! !

!EncoderForLongFormV3PlusClosures methodsFor: 'bytecode generation' stamp: 'eem 6/16/2008 09:45'!
genPushRemoteTemp: tempIndex inVectorAt: tempVectorIndex
	(tempIndex >= 0 and: [tempIndex < 256
	 and: [tempVectorIndex >= 0 and: [tempVectorIndex < 256]]]) ifTrue:
		["140 	10001100 kkkkkkkk jjjjjjjj 	Push Temp At kkkkkkkk In Temp Vector At: jjjjjjjj"
		 stream
			nextPut: 140;
			nextPut: tempIndex;
			nextPut: tempVectorIndex.
		 ^self].
	tempIndex >= 256 ifTrue:
		[^self outOfRangeError: 'remoteTempIndex' index: tempIndex range: 0 to: 255].
	tempVectorIndex >= 256 ifTrue:
		[^self outOfRangeError: 'tempVectorIndex' index: tempVectorIndex range: 0 to: 255]! !

!EncoderForSistaV1 commentStamp: 'eem 9/23/2014 12:18'!
EncoderForSistaV1 encodes a bytecode set for Sista, the Speculative Inlining Smalltalk Architecture, a project by Clément Bera and Eliot Miranda.  Sista is an optimizer that exists in the Smalltalk image, /not/ in the VM,  and optimizes by substituting normal bytecoded methods by optimized bytecoded methods that may use special bytecodes for which the Cogit can generate faster code.  These bytecodes eliminate overheads such as bounds checks or polymorphic code (indexing Array, ByteArray, String etc).  But the bulk of the optimization performed is in inlining blocks and sends for the common path.  This bytecode set therefore differs from a normal Smalltalk set in providing a set of inlined primitives that do not validate their arguments that the compiler generates only when it can prove that the primitives' arguments are valid.

The basic scheme is that the Cogit generates code containing performance counters.  When these counters trip, a callback into the image is performed, at which point Sista analyses some portion of the stack, looking at performance data for the methods on the stack, and optimises based on the stack and performance data.  Execution then resumes in the optimized code.

The Sista Cogit (e.g. SistaStackToRegisterMappingCogit) adds counters to conditional branches.  Each branch has an executed and a taken count.  On execution the executed count is decremented and if the count goes below zero the VM sends a message at a special index in the specialObjectsArray (as of writing, conditionalCounterTrippedOn:).  Then if the branch is taken the taken count is decremented.  The two counter values allow the Sista optimizer to collect basic block execution paths and to know what are the "hot" paths through execution that are worth agressively optimizing.  Since conditional branches are about 1/6 as frequent as sends, and since they can be used to determine the hot path through code, they are a better choice to count than, for example, method or block entry.

The VM provides a primitive that fills an Array with the state of the counters, and the state of each linked send in a method.  Tthe optimizer obtains the branch and send data for a method via this primitive.


This bytecde set encodes a bytecode set for Smalltalk that lifts limits on the number of literals and branch distances, and extended push integer and push character bytecodes.  Bytecodes are ordered by length to make decoding easier.  Bytecodes marked with an * are extensible via a prefix bytecode.

N.B.  Extension bytecodes can only come before extensible bytecodes, and only if valid (one cannot extend a bytecode extensible by Ext A with an Ext B).  An extensible bytecode consumes (and zeros) its extension(s).  Hence the hidden implicit variables holding extensions are always zero except after a valid sequence of extension bytecodes.

Instance Variables (inherited)

1 Byte Bytecodes
	0-15		0000 iiii 			Push Receiver Variable #iiii
	16-31		0001 iiii			Push Literal Variable #iiii
	32-63		001 iiiii				Push Literal #iiiii
	64-71		01000 iii			Push Temp #iii
	72-75		010010 ii			Push Temp #ii + 8
	76			01001100			Push Receiver
	77			01001101			Push true
	78			01001110			Push false
	79			01001111			Push nil
	80			01010000			Push 0
	81			01010001			Push 1
*	82			01010010			Push thisContext, (then Extend B = 1 => push thisProcess)
	83			01010011			Duplicate Stack Top
	84-87		010101 ii			UNASSIGNED
	88-91		010110 ii			Return Receiver/true/false/nil
	92			01011100			Return top
	93			01011101			BlockReturn nil
*	94			01011110			BlockReturn Top [* return from enclosing block N, N = Extend A, then jump by Ext B ]
*	95			01011111			Nop
	96-111		0110 iiii			Send Arithmetic Message #iiii #(#+ #- #< #> #'<=' #'>=' #= #'~=' #* #/ #'\\' #@ #bitShift: #'//' #bitAnd: #bitOr:)
	112-119	01110 iii			Send Special Message #iii #(#at: #at:put: #size #next #nextPut: #atEnd #'==' class)
	120		01111000			UNASSIGNED (was: blockCopy:)
	121		01111001			Send Special Message #value
	122-123	0111101 i			Send Special Message #i #(#value: #do:)
	124-127	011111 ii			Send Special Message #ii #(#new #new: #x #y))
	128-143	1000 iiii			Send Literal Selector #iiii With 0 Argument
	144-159	1001 iiii			Send Literal Selector #iiii With 1 Arguments
	160-175	1010 iiii			Send Literal Selector #iiii With 2 Arguments
	176-183	10110 iii			Jump iii + 1 (i.e., 1 through 8)
	184-191	10111 iii			Pop and Jump 0n True iii +1 (i.e., 1 through 8)
	192-199	11000 iii			Pop and Jump 0n False iii +1 (i.e., 1 through 8)
	200-207	11001 iii			Pop and Store Receiver Variable #iii
	208-215	11010 iii			Pop and Store Temporary Variable #iii
	216		11011000			Pop Stack Top
	217		11011001			UNASSIGNED
	218-219	1101101 i			UNASSIGNED
	220-223	110111 ii			UNASSIGNED

2 Byte Bytecodes
*	224		11100000	aaaaaaaa	Extend A (Ext A = Ext A prev * 256 + Ext A)
*	225		11100001	bbbbbbbb	Extend B (Ext B = Ext B prev * 256 + Ext B)
*	226		11100010	iiiiiiii		Push Receiver Variable #iiiiiiii (+ Extend A * 256)
*	227		11100011	iiiiiiii		Push Literal Variable #iiiiiiii (+ Extend A * 256)
*	228		11100100	iiiiiiii		Push Literal #iiiiiiii (+ Extend A * 256)
	229		11100101	iiiiiiii		Push Temporary Variable #iiiiiiii
	230		11100110	iiiiiiii		PushNClosureTemps iiiiiiii
	231		11100111	jkkkkkkk	Push (Array new: kkkkkkk) (j = 0)
									&	Pop kkkkkkk elements into: (Array new: kkkkkkk) (j = 1)
*	232		11101000	iiiiiiii		Push Integer #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0, a=0, s=1)
*	233		11101001	iiiiiiii		Push Character #iiiiiiii (+ Extend B * 256)
**	234		11101010	iiiiijjj		Send Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments
**	235		11101011	iiiiijjj		Send To Superclass Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments
*	236		11101100	iiiiiiii		Trap If Not Instance Of Behavior/Array Of Behavior #iiiiiiii (+ Extend A * 256, where Extend A >= 0)
*	237		11101101	iiiiiiii		Jump #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0, a=0, s=1)
*	238		11101110	iiiiiiii		Pop and Jump 0n True #iiiiiiii (+ Extend B * 256, where Extend B >= 0)
*	239		11101111	iiiiiiii		Pop and Jump 0n False #iiiiiiii (+ Extend B * 256, where Extend B >= 0)
*	240		11110000	iiiiiiii		Pop and Store Receiver Variable #iiiiiii (+ Extend A * 256)
*	241		11110001	iiiiiiii		Pop and Store Literal Variable #iiiiiiii (+ Extend A * 256)
	242		11110010	iiiiiiii		Pop and Store Temporary Variable #iiiiiiii
*	243		11110011	iiiiiiii		Store Receiver Variable #iiiiiii (+ Extend A * 256)
*	244		11110100	iiiiiiii		Store Literal Variable #iiiiiiii (+ Extend A * 256)
	245		11110110	iiiiiiii		Store Temporary Variable #iiiiiiii
	246-247	1111011 i	xxxxxxxx	UNASSIGNED

3 Byte Bytecodes
	248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution.
	249		11111001 	xxxxxxxx	syyyyyyy	Reserved for Push Float
**	250		11111010 	eeiiikkk		jjjjjjjj		Push Closure Num Copied iii (+ExtA//16*8) Num Args kkk (+ ExtA\\16*8) BlockSize jjjjjjjj (+ExtB*256). ee = num extensions
	251		11111011 	kkkkkkkk	jjjjjjjj		Push Temp At kkkkkkkk In Temp Vector At: jjjjjjjj
	252		11111100 	kkkkkkkk	jjjjjjjj		Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj
	253		11111101 	kkkkkkkk	jjjjjjjj		Pop and Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj
	254-255	1111111i	xxxxxxxx	yyyyyyyy	UNASSIGNED

The Call Primitive Bytecode specifies either a primitive in the primitive table (m=0) or an inlined primitive (m=1). Non-inlined primtiives from the primitive table have index (jjjjjjj * 256) + iiiiiiii and return from the method if they succeed.  This bytecode is only valid as the first bytecode of a method.  Inline primitives have index (jjjjjjj * 256) + iiiiiiii, cannot fail, and do not return when they succeed, yielding a result (typically on top of stack after popping their arguments, but possibly in a byte data stack, for example for unboxed floating-point primitives).

We sort the inline primitive operations by arity.  Nullary primitives occupy the 0-999 range.  Unary primitives occupy the 1-1999 range, etc.

We define the following inlined primitives:
1000	unchecked class
1001	unchecked pointer numSlots
1002	unchecked pointer basicSize
1003	unchecked byte8Type format numBytes (includes CompiledMethod)
1004	unchecked short16Type format numShorts
1005	unchecked word32Type format numWords
1006	unchecked doubleWord64Type format numDoubleWords

2000	unchecked SmallInteger #+.  Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)
2001	unchecked SmallInteger #-.  Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)
2002	unchecked SmallInteger #*.  Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)
2003	unchecked SmallInteger #/.  Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)
2004	unchecked SmallInteger #//.  Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)
2005	unchecked SmallInteger #\\.  Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)
2006	unchecked SmallInteger #quo:.  Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)

2016	unchecked SmallInteger #bitAnd:.  Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)
2017	unchecked SmallInteger #bitOr:.  Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)
2018	unchecked SmallInteger #bitXor:.  Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)
2019	unchecked SmallInteger #bitShift:.  Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)

2032	unchecked SmallInteger #>.  Both arguments are SmallIntegers
2033	unchecked SmallInteger #<.  Both arguments are SmallIntegers
2034	unchecked SmallInteger #>=.  Both arguments are SmallIntegers
2035	unchecked SmallInteger #<=.  Both arguments are SmallIntegers
2036	unchecked SmallInteger #=.  Both arguments are SmallIntegers
2037	unchecked SmallInteger #~=.  Both arguments are SmallIntegers

2064	unchecked Pointer Object>>at:.		The receiver is guaranteed to be a pointer object.  The 0-relative (1-relative?) index is an in-range SmallInteger
2065	unchecked Byte Object>>at:.			The receiver is guaranteed to be a non-pointer object.  The 0-relative (1-relative?) index is an in-range SmallInteger.  The result is a SmallInteger.
2066	unchecked 16-bit Word Object>>at:.			The receiver is guaranteed to be a non-pointer object.  The 0-relative (1-relative?) index is an in-range SmallInteger.  The result is a SmallInteger.
2067	unchecked Word Object>>at:.			The receiver is guaranteed to be a non-pointer object.  The 0-relative (1-relative?) index is an in-range SmallInteger.  The result is a SmallInteger.
2068	unchecked DoubleWord Object>>at:.	The receiver is guaranteed to be a non-pointer object.  The 0-relative (1-relative?) index is an in-range SmallInteger.  The result is a SmallInteger or a LargePositiveInteger.
2069	unchecked QuadWord Object>>at:.		The receiver is guaranteed to be a non-pointer object.  The 0-relative (1-relative?) index is an in-range SmallInteger.  The result is a SmallInteger or a LargePositiveInteger.

3000	unchecked Pointer Object>>at:put:.			The receiver is guaranteed to be a pointer object.  The 0-relative (1-relative?) index is an in-range SmallInteger
3001	unchecked Byte Object>>at:put:.			The receiver is guaranteed to be a non-pointer object.  The 0-relative (1-relative?) index is an in-range SmallInteger.  The argument is a SmallInteger.  The primitive stores the least significant 8 bits.
3002	unchecked Word Object>>at:put:.			The receiver is guaranteed to be a non-pointer object.  The 0-relative (1-relative?) index is an in-range SmallInteger.  The argument is a SmallInteger.  The primitive stores the least significant 16 bits.
3003	unchecked DoubleWord Object>>at:put:.	The receiver is guaranteed to be a non-pointer object.  The 0-relative (1-relative?) index is an in-range SmallInteger.  The argument is a SmallInteger.  The primitive stores the least significant 32 bits.
3004	unchecked QuadWord Object>>at:put:.		The receiver is guaranteed to be a non-pointer object.  The 0-relative (1-relative?) index is an in-range SmallInteger.  The argument is a SmallInteger.  The primitive stores the least significant 64 bits.!
!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/7/2014 16:28'!
genBranchPopFalse: distance
	(distance > 0 and: [distance < 9]) ifTrue:
		["192-199	11000 iii			Pop and Jump 0n False iii + 1 (i.e., 1 through 8)"
		 stream nextPut: 191 + distance.
		 ^self].
	^self genBranchPopFalseLong: distance! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/8/2014 10:37'!
genStorePopInstVar: instVarIndex
	"200-207	11001 iii			Pop and Store Receiver Variable #iii
	 240		11110000	iiiiiiii	Pop and Store Receiver Variable #iiiiiii (+ Extend A * 256)"
	(instVarIndex < 0 or: [instVarIndex > 7]) ifTrue:
		[^self genStorePopInstVarLong: instVarIndex].
	stream nextPut: 200 + instVarIndex! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/7/2014 16:33'!
genBranchPopFalseLong: distance
	"239		11101111	iiiiiiii		Pop and Jump 0n False #iiiiiiii (+ Extend B * 256, where Extend B >= 0)	"
	| distanceMod256 |
	(distance < 0 or: [distance > 32767]) ifTrue:
		[^self outOfRangeError: 'distance' index: distance range: 0 to: 32767].
	distanceMod256 := (distance < 0 or: [distance > 255])
							ifTrue:
								[self genUnsignedSingleExtendB: (distance bitShift: -8).
								 distance bitAnd: 255]
							ifFalse: [distance].
	stream
		nextPut: 239;
		nextPut: distanceMod256! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/8/2014 10:22'!
genSendSuper: selectorLiteralIndex numArgs: nArgs
	| extendedIndex extendedNArgs |
	(selectorLiteralIndex < 0 or: [selectorLiteralIndex > 65535]) ifTrue:
		[^self outOfRangeError: 'selectorLiteralIndex' index: selectorLiteralIndex range: 0 to: 65535].
	(nArgs < 0 or: [nArgs > 31]) ifTrue:
		[^self outOfRangeError: 'numArgs' index: nArgs range: 0 to: 31 "!!!!"].
	(extendedIndex := selectorLiteralIndex) > 31 ifTrue:
		[self genUnsignedSingleExtendA: extendedIndex // 32.
		 extendedIndex := extendedIndex \\ 32].
	(extendedNArgs := nArgs) > 7 ifTrue:
		[self genUnsignedSingleExtendB: extendedNArgs // 8.
		 extendedNArgs := extendedNArgs \\ 8].
	"235		11101011	iiiiijjj		Send To Superclass Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments"
	stream
		nextPut: 235;
		nextPut: extendedNArgs + (extendedIndex * 8)! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/7/2014 16:57'!
genDup
	"83			01010011			Duplicate Stack Top"
	stream nextPut: 83! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/8/2014 10:39'!
genStorePopRemoteTemp: tempIndex inVectorAt: tempVectorIndex
	"253		11111101 	kkkkkkkk	jjjjjjjj		Pop and Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj"
	(tempIndex < 0 or: [tempIndex >= 256]) ifTrue:
		[^self outOfRangeError: 'remoteTempIndex' index: tempIndex range: 0 to: 255].
	(tempVectorIndex < 0 or: [tempVectorIndex >= 256]) ifTrue:
		[^self outOfRangeError: 'tempVectorIndex' index: tempVectorIndex range: 0 to: 255].
	stream
		nextPut: 253;
		nextPut: tempIndex;
		nextPut: tempVectorIndex! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eliot 10/18/2012 14:48'!
genUnsignedSingleExtendA: extendedIndex
	(extendedIndex between: 0 and: 255) ifFalse:
		[^self outOfRangeError: 'index' index: extendedIndex range: 0 to: 255].
	"224		11100000	aaaaaaaa	Extend A (Ext A = Ext A prev * 256 + Ext A)"
	stream
		nextPut: 224;
		nextPut: extendedIndex! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 8/1/2014 06:53'!
genTrapIfNotInstanceOf: literalIndex
	"*	236		11101100	iiiiiiii		Trap If Not Instance Of Behavior/Array Of Behavior #iiiiiiii (+ Extend A * 256, where Extend A >= 0)"

	| extendedIndex |
	(literalIndex < 0 or: [literalIndex > 65535]) ifTrue:
		[^self outOfRangeError: 'index' index: literalIndex range: 0 to: 65536].
	(extendedIndex := literalIndex) > 255 ifTrue:
		[self genUnsignedSingleExtendA: extendedIndex // 256.
		 extendedIndex := extendedIndex \\ 256].
	stream
		nextPut: 236;
		nextPut: extendedIndex! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/8/2014 09:27'!
genPushCharacter: aCharacterOrCode
	"233		11101001	i i i i i i i i	Push Character #iiiiiiii (+ Extend B * 256)"
	"Why restrict the range to 16 bits when we could encode arbitrarily 32-bit Characters?
	 Well, 16 bits requires 4 bytes (extB + byte, 78 + byte) and so beyond this range we
	 lose space verses a single-byte pushLiteral and a 4 byte Character literal on 32-bits.
	 And generating the same bytecode on 64-bit and 32-bit is important if we want to be
	 able to load binary code from one to the other (e.g. via Fuel)."
	| code |
	code := aCharacterOrCode isInteger ifTrue: [aCharacterOrCode] ifFalse: [aCharacterOrCode asInteger].
	(code < 0 or: [code > 65535]) ifTrue:
		[^self outOfRangeError: 'character' index: code range: 0 to: 65535].
	(code > 255) ifTrue:
		[self genUnsignedSingleExtendB: (code bitShift: -8)].
	stream
		nextPut: 233;
		nextPut: (code bitAnd: 255)! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/8/2014 09:56'!
genReturnReceiver
	"88-91		010110 ii			Return Receiver/true/false/nil"
	stream nextPut: 88! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 8/7/2014 16:02'!
genCallPrimitive: primitiveIndex
	"248		11111000	i i i i i i i i	0jjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256)"
	"N.B. We could have made CallPrimitive a 2-byte code taking an extension, but that would
	 complicate the VM's determination of the primitive number and the primitive error code
	 store since the extension, being optional, would make the sequence variable length."
	(primitiveIndex < 1 or: [primitiveIndex > 65535]) ifTrue:
		[self outOfRangeError: 'primitive index' index: primitiveIndex range: 1 to: 65535].
	stream
		nextPut: 248;
		nextPut: (primitiveIndex bitAnd: 255);
		nextPut: (primitiveIndex bitShift: -8)! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'ClementBera 1/27/2015 16:01'!
genPushLiteral: literalIndex
    | extendedIndex |
    (literalIndex < 0 or: [literalIndex > 32767]) ifTrue:
        [^self outOfRangeError: 'index' index: literalIndex range: 0 to: 32768].
    literalIndex < 32 ifTrue: 
        ["32-63     001iiiii     Push Literal #iiiii"
         stream nextPut: 32 + literalIndex.
         ^self].
    "228        11100100    i i i i i i i i    Push Literal #iiiiiiii (+ Extend A * 256)"
    (extendedIndex := literalIndex) > 255 ifTrue:
        [self genUnsignedSingleExtendA: extendedIndex // 256.
         extendedIndex := extendedIndex \\ 256].
    stream
        nextPut: 228;
        nextPut: extendedIndex! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/8/2014 10:06'!
genReturnTop
	"92		1011100		Return Stack Top From Message"
	stream nextPut: 92! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'ClementBEra 4/2/2015 09:42'!
genReturnTopToCaller
	"94		01011110		Return Stack Top From Block [* return from enclosing block N, ExtA]"
	"If extended, the least significant bit of the extension determines if we return to the caller or not
	 and the most significant bits determine how many levels of the static chain to return from.
		ExtA = iiiiiiij
		iiiiiii=0,j=0	=>	return to caller
		iiiiiii=0,j=1	=>	illegal
		iiiiiii=1,j=0	=>	return to outerContext
		iiiiiii=1,j=1	=>	return to outerContext sender/return from outerContext
		iiiiiii=2,j=0	=>	return to outerContext outerContext
		iiiiiii=2,j=1	=>	return to outerContext outerContext sender/return from outerContext outerContext
		etc"

	stream nextPut: 94! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/8/2014 10:27'!
genStoreInstVar: instVarIndex
	"243		11110011	iiiiiiii		Store Receiver Variable #iiiiiii (+ Extend A * 256)"
	self genStoreInstVarLong: instVarIndex! !

!EncoderForSistaV1 methodsFor: 'in-line primitive generation' stamp: 'eem 4/7/2014 16:38'!
genInlineSmallIntegerAdd
	^self genCallInlinePrimitive: 0! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'ClementBEra 4/2/2015 09:42'!
genPushConsArray: size
	(size < 0 or: [size > 127]) ifTrue:
		[^self outOfRangeError: 'size' index: size range: 0 to: 127].
	"231		11100111	jkkkkkkk	Push (Array new: kkkkkkk) (j = 0)
									&	Pop kkkkkkk elements into: (Array new: kkkkkkk) (j = 1)"
	stream
		nextPut: 231;
		nextPut: size + 128! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/8/2014 09:52'!
genPushTemp: tempIndex
	(tempIndex < 0 or: [tempIndex > 63]) ifTrue:
		[^self outOfRangeError: 'index' index: tempIndex range: 0 to: 63].
	tempIndex < 12 ifTrue: 
		["64-71		01000 i i i		Push Temporary Variable #iii
		   72-75	010010 i i		Push Temporary Variable #ii + 8"
		 stream nextPut: 64 + tempIndex.
		 ^self].
	"229		11100101	i i i i i i i i	Push Temporary Variable #iiiiiiii"
	stream
		nextPut: 229;
		nextPut: tempIndex! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'ClementBera 1/27/2015 14:14'!
genPushNClosureTemps: numTemps
	"	230		11100110	iiiiiiii		PushNClosureTemps iiiiiiii"
	(numTemps < 0 or: [numTemps >= 64]) ifTrue:
		[^self outOfRangeError: 'closure num temps' index: numTemps range: 0 to: 127].
	stream nextPut: 230.
	stream nextPut: numTemps! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eliot 11/4/2012 15:01'!
genPushNewArray: size
	(size < 0 or: [size > 127]) ifTrue:
		[^self outOfRangeError: 'size' index: size range: 0 to: 127].
	"231		11100111	jkkkkkkk	Push (Array new: kkkkkkk) (j = 0)
									&	Pop kkkkkkk elements into: (Array new: kkkkkkk) (j = 1)"
	stream
		nextPut: 231;
		nextPut: size! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/8/2014 09:58'!
genReturnSpecialLiteral: aLiteral
	"88-91		010110 ii			Return Receiver/true/false/nil"
	| index |
	index := #(true false nil) indexOf: aLiteral ifAbsent: 0.
	index = 0 ifTrue:
		[^self error: 'return special literal: ', aLiteral printString,  ' is not one of true false nil'].
	stream nextPut: 88 + index! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/7/2014 16:59'!
genJump: distance
	(distance > 0 and: [distance < 9]) ifTrue:
		["176-183	10110 iii			Jump iii + 1 (i.e., 1 through 8)"
		 stream nextPut: 175 + distance.
		 ^self].
	"237		11101101	iiiiiiii		Jump #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0, a=0, s=1)"
	^self genJumpLong: distance! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/8/2014 10:45'!
genStoreRemoteTemp: tempIndex inVectorAt: tempVectorIndex
	"252		11111100 	kkkkkkkk	jjjjjjjj		Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj"
	(tempIndex < 0 or: [tempIndex >= 256]) ifTrue:
		[^self outOfRangeError: 'remoteTempIndex' index: tempIndex range: 0 to: 255].
	(tempVectorIndex < 0 or: [tempVectorIndex >= 256]) ifTrue:
		[^self outOfRangeError: 'tempVectorIndex' index: tempVectorIndex range: 0 to: 255].
	stream
		nextPut: 252;
		nextPut: tempIndex;
		nextPut: tempVectorIndex! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/8/2014 10:28'!
genPushInstVarLong: instVarIndex
	"226		11100010	i i i i i i i i	Push Receiver Variable #iiiiiiii (+ Extend A * 256)"
	"See also MaybeContextInstanceVariableNode"
	(instVarIndex < 0 or: [instVarIndex > 65535]) ifTrue:
		[^self outOfRangeError: 'index' index: instVarIndex range: 0 to: 65535].
	instVarIndex > 255 ifTrue:
		[self genUnsignedSingleExtendA: instVarIndex // 256].
	stream
		nextPut: 226;
		nextPut: instVarIndex \\ 256! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'ClementBEra 4/2/2015 09:42'!
genSendDirectedSuper: selectorLiteralIndex numArgs: nArgs
	| extendedIndex |
	(selectorLiteralIndex < 0 or: [selectorLiteralIndex > 65535]) ifTrue:
		[^self outOfRangeError: 'selectorLiteralIndex' index: selectorLiteralIndex range: 0 to: 65535].
	(nArgs < 0 or: [nArgs > 31]) ifTrue:
		[^self outOfRangeError: 'numArgs' index: nArgs range: 0 to: 31 "!!!!"].
	(extendedIndex := selectorLiteralIndex) > 31 ifTrue:
		[self genUnsignedSingleExtendA: extendedIndex // 32.
		 extendedIndex := extendedIndex \\ 32].
	"Bit 6 of the ExtB byte is the directed send flag.  Bit 6 allows for future expansion to up to 255 args."
	self genUnsignedSingleExtendB: nArgs // 8 + 64.
	"235		11101011	iiiiijjj		Send To Superclass Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments"
	stream
		nextPut: 235;
		nextPut: nArgs \\ 8 + (extendedIndex * 8)! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eliot 10/22/2012 16:07'!
genSignedSingleExtendB: extendedIndex
	(extendedIndex between: -128 and: 127) ifFalse:
		[^self outOfRangeError: 'index' index: extendedIndex range: -128 to: 127].
	"225		11100001	sbbbbbbb	Extend B (Ext B = Ext B prev * 256 + Ext B)"
	stream
		nextPut: 225;
		nextPut: (extendedIndex >= 0 ifTrue: [extendedIndex] ifFalse: [extendedIndex + 256]) ! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eliot 10/18/2012 14:51'!
genPushLiteralVar: literalIndex
	| extendedIndex |
	(literalIndex < 0 or: [literalIndex > 65535]) ifTrue:
		[^self outOfRangeError: 'index' index: literalIndex range: 0 to: 65535].
	literalIndex < 16 ifTrue: 
		["16-31		0001 i i i i		Push Literal Variable #iiii"
		 stream nextPut: 16 + literalIndex.
		 ^self].
	"227		11100011	i i i i i i i i	Push Literal Variable #iiiiiiii (+ Extend A * 256)"
	(extendedIndex := literalIndex) > 255 ifTrue:
		[self genUnsignedSingleExtendA: extendedIndex // 256.
		 extendedIndex := extendedIndex \\ 256].
	stream
		nextPut: 227;
		nextPut: extendedIndex! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eliot 10/18/2012 14:47'!
genUnsignedMultipleExtendA: extendedIndex
	"224		11100000	aaaaaaaa	Extend A (Ext A = Ext A prev * 256 + Ext A)"
	extendedIndex > 255 ifTrue:
		[self genUnsignedMultipleExtendA: extendedIndex // 256].
	stream
		nextPut: 224;
		nextPut: extendedIndex \\ 256! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/8/2014 09:22'!
genPushInteger: anInteger
	"80			01010000				Push 0
	 81			01010001				Push 1
	 232		11101000	i i i i i i i i	Push Integer #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0, a=0, s=1)"
	"Why restrict the range to 16 bits when we could encode arbitrarily large integers?
	 Well, 16 bits requires 4 bytes (extB + byte, 78 + byte) and so beyond this range we lose space
	 verses a single-byte pushLiteral and a 4 byte integer literal on 32-bits.  And generating the same
	 bytecode on 64-bit and 32-bit is important if we want to be able to load binary code from one to
	 the other (e.g. via Fuel)."
	anInteger = 0 ifTrue:
		[stream nextPut: 80.
		 ^self].
	anInteger = 1 ifTrue:
		[stream nextPut: 81.
		 ^self].
	(anInteger < -32768 or: [anInteger > 32767]) ifTrue:
		[^self outOfRangeError: 'integer' index: anInteger range: -32768 to: 32767].
	(anInteger < 0 or: [anInteger > 255]) ifTrue:
		[self genSignedSingleExtendB: (anInteger bitShift: -8)].
	stream
		nextPut: 232;
		nextPut: (anInteger bitAnd: 255)! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'ClementBEra 4/2/2015 09:43'!
genTrap
	"217		11011001			Unconditionnal trap"
	stream nextPut: 217! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/7/2014 16:59'!
genJumpLong: distance
	"237		11101101	iiiiiiii		Jump #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0, a=0, s=1)"
	(distance between: -32768 and: 32767) ifFalse:
		[^self outOfRangeError: 'index' index: distance range: -32768 to: 32767].
	(distance < 0 or: [distance > 255]) ifTrue:
		[self genSignedSingleExtendB: (distance bitShift: -8)].
	stream
		nextPut: 237;
		nextPut: (distance bitAnd: 255)! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/7/2014 17:01'!
genPop
	"216		11011000			Pop Stack Top"
	stream nextPut: 216! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/8/2014 10:28'!
genStoreInstVarLong: instVarIndex
	"243		11110011	iiiiiiii		Store Receiver Variable #iiiiiii (+ Extend A * 256)"
	(instVarIndex < 0 or: [instVarIndex > 65535]) ifTrue:
		[^self outOfRangeError: 'index' index: instVarIndex range: 0 to: 65535].
	instVarIndex > 255 ifTrue:
		[self genUnsignedSingleExtendA: instVarIndex // 256].
	stream
		nextPut: 243;
		nextPut: instVarIndex \\ 256! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/7/2014 17:01'!
genPushClosureCopyNumCopiedValues: numCopied numArgs: numArgs jumpSize: jumpSize
	"250		11111010 eeiiikkk		jjjjjjjj		Push Closure Num Copied iii (+ Ext A // 16 * 8) Num Args kkk (+ Ext A \\ 16 * 8) BlockSize jjjjjjjj (+ Ext B * 256). ee = num extensions"
	"Including numExtensions makes decoding the bytecode quicker since it obviates having to scan from the beginning of a method."
	| numExtensions numCopiedMod8 numArgsMod8 extA |
	(jumpSize < 0 or: [jumpSize > 65535]) ifTrue:
		[^self outOfRangeError: 'block size' index: jumpSize range: 0 to: 65535].
	(numCopied < 0 or: [numCopied > 127]) ifTrue:
		[^self outOfRangeError: 'num copied' index: numCopied range: 0 to: 127].
	(numArgs < 0 or: [numArgs > 127]) ifTrue:
		[^self outOfRangeError: 'num args' index: numArgs range: 0 to: 127].
	extA := numExtensions := 0.
	(numArgsMod8 := numArgs) > 7 ifTrue:
		[extA := numArgs // 8.
		 numArgsMod8 := numArgsMod8 \\ 8].
	(numCopiedMod8 := numCopied) > 7 ifTrue:
		[extA := extA + (numCopied // 8 * 16).
		 numCopiedMod8 := numCopiedMod8 \\ 8].
	extA ~= 0 ifTrue:
		[self genUnsignedSingleExtendA: extA.
		 numExtensions := 1].
	jumpSize > 255 ifTrue:
		[numExtensions := numExtensions + 1.
		 self genUnsignedSingleExtendB: jumpSize // 256].
	stream
		nextPut: 250;
		nextPut: (numExtensions bitShift: 6) + (numCopiedMod8 bitShift: 3) + numArgsMod8;
		nextPut: (jumpSize bitAnd: 16rFF)! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eliot 10/12/2012 15:12'!
genPushInstVar: instVarIndex
	(instVarIndex between: 0 and: 15) ifTrue:
		["0-15 	0000iiii 	Push Receiver Variable #iiii"
		 stream nextPut: 0 + instVarIndex.
		 ^self].
	self genPushInstVarLong: instVarIndex! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'ClementBEra 4/2/2015 09:43'!
genStoreTemp: tempIndex
	"245		11110110	iiiiiiii		Store Temporary Variable #iiiiiiii"
	(tempIndex < 0 or: [tempIndex > 63]) ifTrue:
		[^self outOfRangeError: 'index' index: tempIndex range: 0 to: 63].
	stream
		nextPut: 245;
		nextPut: tempIndex! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'ClementBEra 4/2/2015 09:42'!
genPushSpecialLiteral: aLiteral
	"77			01001101			Push true
	 78			01001110			Push false
	 79			01001111			Push nil
	 80			01010000			Push 0
	 81			01010001			Push 1
	 232		11101000	iiiiiiii		Push Integer #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0, a=0, s=1)"
	| index |
	aLiteral isInteger ifTrue:
		[aLiteral == 0 ifTrue:
			[stream nextPut: 80.
			 ^self].
		 aLiteral == 1 ifTrue:
			[stream nextPut: 81.
			 ^self].
		 ^self genPushInteger: aLiteral].
	index := #(true false nil)
					indexOf: aLiteral
					ifAbsent: [^self error: 'push special literal: ', aLiteral printString,  ' is not one of true false nil'].
	stream nextPut: 76 + index! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/8/2014 09:29'!
genPushRemoteTemp: tempIndex inVectorAt: tempVectorIndex
	"251		11111011 kkkkkkkk	jjjjjjjj		Push Temp At kkkkkkkk In Temp Vector At: jjjjjjjj"
	(tempIndex < 0 or: [tempIndex >= 256]) ifTrue:
		[^self outOfRangeError: 'remoteTempIndex' index: tempIndex range: 0 to: 255].
	(tempVectorIndex < 0 or: [tempVectorIndex >= 256]) ifTrue:
		[^self outOfRangeError: 'tempVectorIndex' index: tempVectorIndex range: 0 to: 255].
	stream
		nextPut: 251;
		nextPut: tempIndex;
		nextPut: tempVectorIndex! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/7/2014 16:33'!
genBranchPopTrueLong: distance
	"238		11101110	iiiiiiii		Pop and Jump 0n True #iiiiiiii (+ Extend B * 256, where Extend B >= 0)"
	| distanceMod256 |
	(distance < 0 or: [distance > 32767]) ifTrue:
		[^self outOfRangeError: 'distance' index: distance range: 0 to: 32767].
	(distance > 0 and: [distance < 9]) ifTrue:
		["184-191	10111 iii			Pop and Jump 0n True iii + 1 (i.e., 1 through 8)"
		 stream nextPut: 183 + distance.
		 ^self].
	distanceMod256 := (distance < 0 or: [distance > 255])
							ifTrue:
								[self genUnsignedSingleExtendB: (distance bitShift: -8).
								 distance bitAnd: 255]
							ifFalse: [distance].
	stream
		nextPut: 238;
		nextPut: distanceMod256! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/8/2014 10:43'!
genStorePopTemp: tempIndex
	"208-215	11010 iii			Pop and Store Temporary Variable #iii
	 242		11110010	iiiiiiii	Pop and Store Temporary Variable #iiiiiiii"
	(tempIndex < 0 or: [tempIndex > 63]) ifTrue:
		[^self outOfRangeError: 'index' index: tempIndex range: 0 to: 63].
	tempIndex < 8 ifTrue:
		[stream nextPut: 208 + tempIndex.
		 ^self].
	stream
		nextPut: 242;
		nextPut: tempIndex! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eliot 10/18/2012 14:43'!
genPushReceiver
	"76			01001100		Push Receiver"
	stream nextPut: 76! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/7/2014 16:31'!
genBranchPopTrue: distance
	(distance > 0 and: [distance < 9]) ifTrue:
		["184-191	10111 iii			Pop and Jump 0n True iii + 1 (i.e., 1 through 8)"
		 stream nextPut: 183 + distance.
		 ^self].
	^self genBranchPopTrueLong: distance! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/7/2014 16:37'!
genCallInlinePrimitive: primitiveIndex
	"248		11111000	i i i i i i i i	1jjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256)"
	"N.B. We could have made CallPrimitive a 2-byte code taking an extension, but that would
	 complicate the VM's determination of the primitive number and the primitive error code
	 store since the extension, being optional, would make the sequence variable length."
	(primitiveIndex < 1 or: [primitiveIndex > 32767]) ifTrue:
		[self outOfRangeError: 'primitive index' index: primitiveIndex range: 1 to: 32767].
	stream
		nextPut: 248;
		nextPut: (primitiveIndex bitAnd: 255);
		nextPut: (primitiveIndex bitShift: -8) + 128! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/8/2014 10:35'!
genStoreLiteralVar: literalIndex
	"244		11110100	iiiiiiii		Store Literal Variable #iiiiiiii (+ Extend A * 256)"
	(literalIndex < 0 or: [literalIndex > 65535]) ifTrue:
		[^self outOfRangeError: 'index' index: literalIndex range: 0 to: 65535].
	literalIndex > 255 ifTrue: 
		[self genUnsignedSingleExtendA: literalIndex // 256].
	stream
		nextPut: 244;
		nextPut: literalIndex \\ 256! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/8/2014 10:18'!
genSend: selectorLiteralIndex numArgs: nArgs
	| extendedIndex extendedNArgs |
	(selectorLiteralIndex < 0 or: [selectorLiteralIndex > 65535]) ifTrue:
		[^self outOfRangeError: 'selectorLiteralIndex' index: selectorLiteralIndex range: 0 to: 65535].
	(nArgs < 0 or: [nArgs > 31]) ifTrue:
		[^self outOfRangeError: 'numArgs' index: nArgs range: 0 to: 31 "!!!!"].
	(selectorLiteralIndex < 16 and: [nArgs < 3]) ifTrue: 
	 	["128-143	1000 iiii			Send Literal Selector #iiii With 0 Argument
		  144-159	1001 iiii			Send Literal Selector #iiii With 1 Arguments
		  160-175	1010 iiii			Send Literal Selector #iiii With 2 Arguments"
		 stream nextPut: 128 + (nArgs * 16) + selectorLiteralIndex.
		 ^self].
	(extendedIndex := selectorLiteralIndex) > 31 ifTrue:
		[self genUnsignedSingleExtendA: extendedIndex // 32.
		 extendedIndex := extendedIndex \\ 32].
	(extendedNArgs := nArgs) > 7 ifTrue:
		[self genUnsignedSingleExtendB: extendedNArgs // 8.
		 extendedNArgs := extendedNArgs \\ 8].
	"234		11101010	i i i i i j j j	Send Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments"
	stream
		nextPut: 238;
		nextPut: extendedNArgs + (extendedIndex * 8)! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/8/2014 10:39'!
genStorePopLiteralVar: literalIndex
	"241		11110001	iiiiiiii		Pop and Store Literal Variable #iiiiiiii (+ Extend A * 256)"
	(literalIndex < 0 or: [literalIndex > 65535]) ifTrue:
		[^self outOfRangeError: 'index' index: literalIndex range: 0 to: 65535].
	literalIndex > 255 ifTrue: 
		[self genUnsignedSingleExtendA: literalIndex // 256].
	stream
		nextPut: 241;
		nextPut: literalIndex \\ 256! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/7/2014 16:27'!
genNop
	"95			01011111			Nop"
	stream nextPut: 95! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/8/2014 10:21'!
genSendSpecial: specialSelectorIndex numArgs: nArgs
	self assert: (specialSelectorIndex between: 1 and: Smalltalk specialSelectorSize).
	self assert: nArgs = (Smalltalk specialNargsAt: specialSelectorIndex).
	"Special selector sends.
		96-111		0110 iiii			Send Arithmetic Message #iiii #(#+ #- #< #> #'<=' #'>=' #= #'~=' #* #/ #'\\' #@ #bitShift: #'//' #bitAnd: #bitOr:)
		112-119	01110 iii			Send Special Message #iii #(#at: #at:put: #size ? ? ? #'==' class ? value value: ? ? ? ? ?)"

	stream nextPut: specialSelectorIndex + 95! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 7/28/2014 20:51'!
genPushThisContext
	"82			01010010			Push thisContext, (then e.g. Extend B 1 = push thisProcess)"
	stream nextPut: 82! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eem 4/8/2014 10:37'!
genStorePopInstVarLong: instVarIndex
	"240		11110000	iiiiiiii		Pop and Store Receiver Variable #iiiiiii (+ Extend A * 256)"
	(instVarIndex < 0 or: [instVarIndex > 65535]) ifTrue:
		[^self outOfRangeError: 'index' index: instVarIndex range: 0 to: 65535].
	instVarIndex > 255 ifTrue:
		[self genUnsignedSingleExtendA: instVarIndex // 256].
	stream
		nextPut: 240;
		nextPut: instVarIndex \\ 256! !

!EncoderForSistaV1 methodsFor: 'bytecode generation' stamp: 'eliot 10/18/2012 14:48'!
genUnsignedSingleExtendB: extendedIndex
	(extendedIndex between: 0 and: 255) ifFalse:
		[^self outOfRangeError: 'index' index: extendedIndex range: 0 to: 255].
	"225		11100001	sbbbbbbb	Extend B (Ext B = Ext B prev * 256 + Ext B)"
	stream
		nextPut: 225;
		nextPut: extendedIndex! !

!EncoderForSistaV1 class methodsFor: 'instruction stream support' stamp: 'eem 5/18/2014 19:18'!
isStorePopAt: pc in: method
	"Answer whether the bytecode at pc is a store or store-pop."

	"	200-207	11001 iii						Pop and Store Receiver Variable #iii
		208-215	11010 iii						Pop and Store Temporary Variable #iii
	 *	224		11100000	aaaaaaaa			Extend A (Ext A = Ext A prev * 256 + Ext A)
	 *	240		11110000	iiiiiiii				Pop and Store Receiver Variable #iiiiiii (+ Extend A * 256)
	 *	241		11110001	iiiiiiii				Pop and Store Literal Variable #iiiiiiii (+ Extend A * 256)
		242		11110010	iiiiiiii				Pop and Store Temporary Variable #iiiiiiii

		253		11111101 	kkkkkkkk	jjjjjjjj	Pop and Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj"

	| byte |
	byte := self nonExtensionBytecodeAt: pc in: method.
	^byte >= 200
	  and: [byte <= 215
		 or: [(byte between: 240 and: 242)
		 or: [byte = 253]]]! !

!EncoderForSistaV1 class methodsFor: 'compiled method support' stamp: 'eem 5/18/2014 18:59'!
bindingWriteScanBlockFor: litVarIndex using: scanner
	"Answer a block argument for InstructionStream>>scanFor: that answers true
	 for writes of the value of the binding with zero-relative index litVarIndex.
	 N.B. Don't assume the compiler uses the most compact encoding available."

	"*	224		11100000	aaaaaaaa	Extend A (Ext A = Ext A prev * 256 + Ext A)
	 *	241		11110001	iiiiiiii		Pop and Store Literal Variable #iiiiiiii (+ Extend A * 256)
	 *	244		11110100	iiiiiiii		Store Literal Variable #iiiiiiii (+ Extend A * 256)"
	| extension |
	extension := 0.
	^[:b| | prevext |
	   prevext := extension.
	   extension := b = 224 ifTrue: [scanner followingByte bitShift: 8] ifFalse: [0].
	   (b = 241 or: [b = 244])
	   and: [scanner followingByte + prevext = litVarIndex]]! !

!EncoderForSistaV1 class methodsFor: 'block closure support' stamp: 'ClementBera 12/29/2014 11:44'!
numLocalTempsForBlockAt: startpc in: method
	| firstByte |
	firstByte := method at: startpc.
	^ firstByte = 230 
		ifFalse: [ 0 ]
		ifTrue: [ (method at: startpc + 1) + 1 ]
	! !

!EncoderForSistaV1 class methodsFor: 'compiled method support' stamp: 'eem 5/18/2014 19:00'!
supportsClosures
	"Answer if the instruction set supports closures (contains
	 closure creation and indirect temp access bytecodes)."

	^true! !

!EncoderForSistaV1 class methodsFor: 'bytecode decoding' stamp: 'eem 8/8/2014 19:40'!
stackDeltaForPrimitive: primitiveIndex in: method
	"Answer the stack delta for the callPrimitive: bytecode (see my class comment).
	 There is no delta for non-inlined primitives (its implicitly 0 - method numArgs).
	 Inlined primitives are grouped by the thousand by argument count, 32 args max ;-)."
	^primitiveIndex < 32678
		ifTrue: [0]
		ifFalse: [primitiveIndex - 32768 // 1000]! !

!EncoderForSistaV1 class methodsFor: 'instruction stream support' stamp: 'eem 5/18/2014 19:17'!
isExtension: bytecode
	"Answer if the bytecode is an extension bytecode, i.e. one that extends
	 the range of the following bytecode."
	^bytecode >= 16rE0 and: [bytecode <= 16rE1]! !

!EncoderForSistaV1 class methodsFor: 'instruction stream support' stamp: 'eem 5/18/2014 19:10'!
isRealSendAt: pc in: method
	"Answer whether the bytecode at pc is a real message-send, not blockCopy:."

	^self isSendAt: pc in: method! !

!EncoderForSistaV1 class methodsFor: 'compiled method support' stamp: 'eem 5/18/2014 18:59'!
instVarWriteScanBlockFor: varIndexCode using: scanner
	"Answer a block argument for InstructionStream>>scanFor: that answers true
	 for writes of the inst var with zero-relative index varIndexCode.
	 N.B. Don't assume the compiler uses the most compact encoding available."

	"	200-207	11001 iii			Pop and Store Receiver Variable #iii
	*	224		11100000	aaaaaaaa	Extend A (Ext A = Ext A prev * 256 + Ext A)
	*	240		11110000	iiiiiiii		Pop and Store Receiver Variable #iiiiiii (+ Extend A * 256)
	*	243		11110011	iiiiiiii		Store Receiver Variable #iiiiiii (+ Extend A * 256)"
	| extension |
	extension := 0.
	^[:b| | prevext |
	   prevext := extension.
	   extension := b = 224 ifTrue: [scanner followingByte bitShift: 8] ifFalse: [0].
	   (b >= 200
	    and: [b < 208
	    and: [b - 200 = varIndexCode]])
	   or: [(b = 240 or: [b = 243])
		  and: [scanner followingByte + prevext = varIndexCode]]]! !

!EncoderForSistaV1 class methodsFor: 'instruction stream support' stamp: 'eem 5/18/2014 19:03'!
isBranchIfFalseAt: pc in: method
	"Answer whether the bytecode at pc is a conditional branch-if-false."

	"	192-199	11000 iii				Pop and Jump 0n False iii +1 (i.e., 1 through 8)
	 *	239		11101111	iiiiiiii		Pop and Jump 0n False #iiiiiiii (+ Extend B * 256, where Extend B >= 0)"
	| byte |
	byte := self nonExtensionBytecodeAt: pc in: method.
	^byte >= 192 and: [byte <= 199 or: [byte = 239]]! !

!EncoderForSistaV1 class methodsFor: 'bytecode decoding' stamp: 'ClementBera 1/27/2015 14:15'!
backJumpBytecodeSize
	^ 4! !

!EncoderForSistaV1 class methodsFor: 'instruction stream support' stamp: 'eem 5/18/2014 19:00'!
bytecodeSize: bytecode
	"Answer the number of bytes in the bytecode."
	bytecode < 224 ifTrue: [^1].
	bytecode < 248 ifTrue: [^2].
	^3! !

!EncoderForSistaV1 class methodsFor: 'instruction stream support' stamp: 'ClementBera 12/29/2014 12:15'!
isCreateBlockAt: pc in: method
	"Answer whether the bytecode at pc is a block creation bytecode."
	
	"250		11111010 	eeiiikkk		jjjjjjjj		Push Closure Num Copied iii (+ExtA//16*8) Num Args kkk (+ ExtA\\16*8) BlockSize jjjjjjjj (+ExtB*256). ee = num extensions"

	| byte |
	byte := self nonExtensionBytecodeAt: pc in: method.
	^ byte = 250! !

!EncoderForSistaV1 class methodsFor: 'instruction stream support' stamp: 'ClementBera 2/24/2015 16:09'!
nonExtensionBytecodeAt: pc in: method
	"Answer the actual bytecode at pc in method, skipping past any preceeding extensions."
	| scanpc byte |
	scanpc := pc.
	[ byte := method at: scanpc.
	 byte >= 224 and: [byte <= 225]] whileTrue: [ scanpc := scanpc + 2 ].
	^ byte! !

!EncoderForSistaV1 class methodsFor: 'instruction stream support' stamp: 'eem 5/18/2014 19:01'!
isBlockReturnAt: pc in: method
	"Answer whether the bytecode at pc is a return from block."
	"	93			01011101			BlockReturn nil
	 *	94			01011110			BlockReturn Top [* return from enclosing block N, N = Extend A, then jump by Ext B ]"
	^(self nonExtensionBytecodeAt: pc in: method) between: 93 and: 94! !

!EncoderForSistaV1 class methodsFor: 'instruction stream support' stamp: 'eem 9/3/2014 08:52'!
isReturnTopFromMethodAt: pc in: method
	"Answer whether the bytecode at pc is a return stack top from method."

	^(method at: pc) = 92! !

!EncoderForSistaV1 class methodsFor: 'instruction stream support' stamp: 'eem 5/18/2014 19:14'!
isSendAt: pc in: method
	"Answer whether the bytecode at pc is a message-send."

	"	96-111		0110 iiii			Send Arithmetic Message #iiii #(#+ #- #< #> #'<=' #'>=' #= #'~=' #* #/ #'\\' #@ #bitShift: #'//' #bitAnd: #bitOr:)
		112-119	01110 iii			Send Special Message #iii #(#at: #at:put: #size #next #nextPut: #atEnd #'==' class)
		120		01111000			UNASSIGNED (was: blockCopy:)
		121		01111001			Send Special Message #value
		122-123	0111101 i			Send Special Message #i #(#value: #do:)
		124-127	011111 ii			Send Special Message #ii #(#new #new: #x #y))
		128-143	1000 iiii			Send Literal Selector #iiii With 0 Argument
		144-159	1001 iiii			Send Literal Selector #iiii With 1 Arguments
		160-175	1010 iiii			Send Literal Selector #iiii With 2 Arguments
	 **	234		11101010	iiiiijjj	Send Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments
	 **	235		11101011	iiiiijjj	Send To Superclass Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments"

	| byte |
	byte := self nonExtensionBytecodeAt: pc in: method.
	^byte >= 96
	  and: [byte <= 175
		 or: [byte >= 234 and: [byte <= 235]]]! !

!EncoderForSistaV1 class methodsFor: 'compiled method support' stamp: 'eem 5/18/2014 18:57'!
instVarReadScanBlockFor: varIndexCode using: scanner
	"Answer a block argument for InstructionStream>>scanFor: that answers true
	 for reads of the inst var with zero-relative index varIndexCode.
	 N.B. Don't assume the compiler uses the most compact encoding available."

	"	0-15		0000 i i i i 				Push Receiver Variable #iiii
	*	224		11100000	aaaaaaaa	Extend A (Ext A = Ext A prev * 256 + Ext A)
	*	226		11100010	i i i i i i i i	Push Receiver Variable #iiiiiiii (+ Extend A * 256)"
	| extension |
	extension := 0.
	^[:b| | prevext |
	   prevext := extension.
	   extension := b = 224 ifTrue: [scanner followingByte bitShift: 8] ifFalse: [0].
	   (b < 16 and: [b = varIndexCode])
	    or: [b = 226
			and: [scanner followingByte + prevext = varIndexCode]]]! !

!EncoderForSistaV1 class methodsFor: 'compiled method support' stamp: 'eem 5/18/2014 18:54'!
bindingReadScanBlockFor: litVarIndex using: scanner
	"Answer a block argument for InstructionStream>>scanFor: that answers true
	 for reads of the value of the binding with zero-relative index litVarIndex.
	 N.B. Don't assume the compiler uses the most compact encoding available."

	"	16-31		0001 i i i i				Push Literal Variable #iiii
	 *	224		11100000	aaaaaaaa	Extend A (Ext A = Ext A prev * 256 + Ext A)
	 *	227		11100011	i i i i i i i i	Push Literal Variable #iiiiiiii (+ Extend A * 256)"
	| extension |
	extension := 0.
	^[:b| | prevext |
	   prevext := extension.
	   extension := b = 224 ifTrue: [scanner followingByte bitShift: 8] ifFalse: [0].
	   (b < 32 and: [b >= 16 and: [b - 16 = litVarIndex]])
	    or: [b = 227
			and: [scanner followingByte + prevext = litVarIndex]]]! !

!EncoderForSistaV1 class methodsFor: 'scanning' stamp: 'eem 5/18/2014 19:39'!
method: method refersInBytecodeToLiteral: aLiteral specialSelectorIndex: specialOrNil
	"Answer if method refers to the literal aLiteral in the bytecode, as opposed to in its literal frame."

	"	77			01001101				Push true
		78			01001110				Push false
		79			01001111				Push nil
		80			01010000				Push 0
		81			01010001				Push 1
		88-91		010110 ii				Return Receiver/true/false/nil
		93			01011101				BlockReturn nil
		96-111		0110 iiii				Send Arithmetic Message #iiii #(#+ #- #< #> #'<=' #'>=' #= #'~=' #* #/ #'\\' #@ #bitShift: #'//' #bitAnd: #bitOr:)
		112-119	01110 iii				Send Special Message #iii #(#at: #at:put: #size #next #nextPut: #atEnd #'==' class)
		120		01111000				UNASSIGNED (was: blockCopy:)
		121		01111001				Send Special Message #value
		122-123	0111101 i				Send Special Message #i #(#value: #do:)
		124-127	011111 ii				Send Special Message #ii #(#new #new: #x #y))
	*	224		11100000	aaaaaaaa	Extend A (Ext A = Ext A prev * 256 + Ext A)
	*	225		11100001	sbbbbbbb	Extend B (Ext B = Ext B prev * 256 + Ext B)
	*	232		11101000	iiiiiiii		Push Integer #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0, a=0, s=1)
	*	233		11101001	iiiiiiii		Push Character #iiiiiiii (+ Extend B * 256)
		249		11111001 	xxxxxxxx	syyyyyyy	Reserved for Push Float"
	| byte extended scanner |
	specialOrNil ifNotNil:
		[byte := specialOrNil + 95.
		^(InstructionStream on: method) scanFor: [:b| b = byte]].
	extended := false.
	aLiteral isInteger ifTrue:
		[(aLiteral >= -32768 and: [aLiteral <= 32767]) ifFalse: [^false].
		 scanner := InstructionStream on: method.
		 (aLiteral >= 0 and: [aLiteral <= 255]) ifTrue:
			[aLiteral <= 1 ifTrue:
				[byte := aLiteral + 80.
				 ^scanner scanFor: [:b| b = byte]].
			 ^scanner scanFor:
				[:b|
				(b = 232
				 and: [extended not
				 and: [scanner followingByte = aLiteral]])
				or: [extended := b = 225.
					false]]].
		 byte := (aLiteral bitShift: -8) bitAnd: 255.
		^scanner scanFor:
			[:b|
			(b = 232
			 and: [extended
			 and: [scanner followingByte = (aLiteral bitAnd: 255)]])
			or: [extended := b = 225 and: [scanner followingByte = byte].
				false]]].
	aLiteral isCharacter ifTrue:
		[aLiteral asciiValue <= 65535 ifFalse: [^false].
		 scanner := InstructionStream on: method.
		 aLiteral asciiValue <= 255 ifTrue:
			[^scanner scanFor:
				[:b|
				(b = 233
				 and: [extended not
				 and: [scanner followingByte = aLiteral]])
				or: [extended := b = 225.
					false]]].
		 byte := (aLiteral bitShift: -8) bitAnd: 255.
		^scanner scanFor:
			[:b|
			(b = 233
			 and: [extended
			 and: [scanner followingByte = (aLiteral bitAnd: 255)]])
			or: [extended := b = 225 and: [scanner followingByte = byte].
				false]]].
	aLiteral == nil ifTrue:
		[^(InstructionStream on: method) scanFor: [:b| b = 79 or: [b = 91 or: b = 93]]].
	aLiteral == true ifTrue:
		[^(InstructionStream on: method) scanFor: [:b| b = 77 or: [b = 89]]].
	aLiteral == false ifTrue:
		[^(InstructionStream on: method) scanFor: [:b| b = 78 or: [b = 90]]].
	
	^false! !

!EncoderForSistaV1 class methodsFor: 'instruction stream support' stamp: 'eem 5/18/2014 13:29'!
isJustPopAt: pc in: method
	"Answer whether the bytecode at pc is a pop."

	^(method at: pc) = 216 "216		11011000			Pop Stack Top"! !

!EncoderForSistaV1 class methodsFor: 'instruction stream support' stamp: 'eem 5/18/2014 19:00'!
interpretJumpIn: anInstructionStream
	"Double-dispatch through the encoder to select the correct unconditional jump decoder for the instruction set."
	^anInstructionStream interpretSistaV1Jump! !

!EncoderForSistaV1 class methodsFor: 'instruction stream support' stamp: 'eem 5/18/2014 19:04'!
isBranchIfTrueAt: pc in: method
	"Answer whether the bytecode at pc is a conditional branch-if-true."

	"	184-191	10111 iii				Pop and Jump 0n True iii +1 (i.e., 1 through 8)
	 *	238		11101110	iiiiiiii		Pop and Jump 0n True #iiiiiiii (+ Extend B * 256, where Extend B >= 0))"
	| byte |
	byte := self nonExtensionBytecodeAt: pc in: method.
	^byte >= 184 and: [byte <= 191 or: [byte = 238]]! !

!EncoderForSistaV1 class methodsFor: 'bytecode decoding' stamp: 'ClementBEra 4/2/2015 09:43'!
selectorToSendOrItselfFor: anInstructionStream in: method at: pc
	"If anInstructionStream is at a send bytecode then answer the send's selector,
	 otherwise answer anInstructionStream itself.  The rationale for answering
	 anInstructionStream instead of, say, nil, is that potentially any existing object
	 can be used as a selector, but since anInstructionStream postdates the method,
	 it can't be one of them.

	 The compilcation is that for convenience we assume the pc could be
	 pointing to the raw send bytecode after its extensions, or at the extension
	 preceeding the raw send bytecode.
		96-111		0110 iiii			Send Arithmetic Message #iiii #(#+ #- #< #> #'<=' #'>=' #= #'~=' #* #/ #'\\' #@ #bitShift: #'//' #bitAnd: #bitOr:)
		112-119	01110 iii			Send Special Message #iii #(#at: #at:put: #size #next #nextPut: #atEnd #'==' class)
		120		01111000			UNASSIGNED (was: blockCopy:)
		121		01111001			Send Special Message #value
		122-123	0111101 i			Send Special Message #i #(#value: #do:)
		124-127	011111 ii			Send Special Message #ii #(#new #new: #x #y))
		128-143	1000 iiii			Send Literal Selector #iiii With 0 Argument
		144-159	1001 iiii			Send Literal Selector #iiii With 1 Arguments
		160-175	1010 iiii			Send Literal Selector #iiii With 2 Arguments
	*	224		11100000	aaaaaaaa	Extend A (Ext A = Ext A prev * 256 + Ext A)
	*	225		11100001	bbbbbbbb	Extend B (Ext B = Ext B prev * 256 + Ext B)
	**	234		11101010	iiiiijjj		Send Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments
	**	235		11101011	iiiiijjj		Send To Superclass Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments"

	| byte |
	byte := method at: pc.
	byte < 96 ifTrue:
		[^anInstructionStream].
	byte <= 175 ifTrue: 
		["special byte or short send"
		 ^byte >= 128
			ifTrue: [method literalAt: (byte bitAnd: 15) + 1]
			ifFalse: [Smalltalk specialSelectorAt: byte - 95]].
	byte < 234 ifTrue: "need to check for either extension cuz order of extensions is not restricted. so extB could preceed extA"
		[(byte >= 224 and: [byte <= 225]) ifTrue:
			[^self extensionsAt: pc in: method into:
				[:extA :extB :nExtBytes| | byteAfter index |
				byteAfter := method at: pc + nExtBytes.
				(byteAfter >= 234 and: [byteAfter <= 235])
					ifTrue:
						[index := ((method at: pc + nExtBytes + 1) bitShift: -3) + (extA bitShift: 5).
						 method literalAt: index + 1]
					ifFalse: [anInstructionStream]]].
		^anInstructionStream].
	byte > 235 ifTrue:
		[^anInstructionStream].
	"they could be extended..."
	^self extensionsAt: pc in: method into:
		[:extA :extB :nExtBytes| | index |
		 index := ((method at: pc + 1) bitShift: -3) + (extA bitShift: 5).
		 method literalAt: index + 1]! !

!EncoderForSistaV1 class methodsFor: 'instruction stream support' stamp: 'eem 5/18/2014 19:11'!
isReturnAt: pc in: method
	"Answer whether the bytecode at pc is a return from block."
	"	88-91		010110 ii			Return Receiver/true/false/nil
		92			01011100			Return top
		93			01011101			BlockReturn nil
	 *	94			01011110			BlockReturn Top [* return from enclosing block N, N = Extend A, then jump by Ext B ]"
	^(self nonExtensionBytecodeAt: pc in: method) between: 88 and: 94! !

!EncoderForSistaV1 class methodsFor: 'instruction stream support' stamp: 'eem 5/18/2014 19:06'!
isJumpAt: pc in: method
	"Answer whether the bytecode at pc is an (unconditional) jump."

	"	176-183	10110 iii				Jump iii + 1 (i.e., 1 through 8)
	 *	225		11100001	bbbbbbbb	Extend B (Ext B = Ext B prev * 256 + Ext B)
	 *	237		11101101	iiiiiiii		Jump #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0, a=0, s=1)"
	| byte |
	byte := self nonExtensionBytecodeAt: pc in: method.
	^byte >= 176 and: [byte <= 183 or: [byte = 237]]! !

!EncoderForSistaV1 class methodsFor: 'instruction stream support' stamp: 'eem 5/18/2014 19:19'!
isStoreAt: pc in: method
	"Answer whether the bytecode at pc is a store or store-pop."

	"	200-207	11001 iii						Pop and Store Receiver Variable #iii
		208-215	11010 iii						Pop and Store Temporary Variable #iii
	 *	224		11100000	aaaaaaaa			Extend A (Ext A = Ext A prev * 256 + Ext A)
	 *	240		11110000	iiiiiiii				Pop and Store Receiver Variable #iiiiiii (+ Extend A * 256)
	 *	241		11110001	iiiiiiii				Pop and Store Literal Variable #iiiiiiii (+ Extend A * 256)
		242		11110010	iiiiiiii				Pop and Store Temporary Variable #iiiiiiii
	 *	243		11110011	iiiiiiii				Store Receiver Variable #iiiiiii (+ Extend A * 256)
	 *	244		11110100	iiiiiiii				Store Literal Variable #iiiiiiii (+ Extend A * 256)
		245		11110110	iiiiiiii				Store Temporary Variable #iiiiiiii

		252		11111100 	kkkkkkkk	jjjjjjjj	Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj
		253		11111101 	kkkkkkkk	jjjjjjjj	Pop and Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj"

	| byte |
	byte := self nonExtensionBytecodeAt: pc in: method.
	^byte >= 200
	  and: [byte <= 215
		 or: [(byte between: 240 and: 245)
		 or: [(byte between: 252 and: 253)]]]! !

!EncoderForSistaV1 class methodsFor: 'compiled method support' stamp: 'eem 5/18/2014 18:56'!
extensionsAt: bcpc in: method into: aTrinaryBlock
	"If the bytecode at pc is an extension then evaluate aBinaryBlock with the values of extA and extB and number of extension *bytes*.
	 If the bytecode at pc is not extended then evaluate aBinaryBlock with 0 and 0.
	224		11100000	aaaaaaaa	Extend A (Ext A = Ext A prev * 256 + Ext A)
	225		11100001	bbbbbbbb	Extend B (Ext B = Ext B prev * 256 + Ext B)"
 
	| scanpc byte extByte extA extB |
	scanpc := bcpc.
	"There may be an extension (it could be a false positive).  We must scan as fast as possible..."
	extA := extB := 0.
	[byte := method at: scanpc.
	 byte >= 224 and: [byte <= 225]] whileTrue: 
		[extByte := method at: scanpc + 1.
		 scanpc := scanpc + 2.
		 byte = 224
			ifTrue:
				[extA := (extA bitShift: 8) + extByte]
			ifFalse:
				[extB := (extB = 0 and: [extByte > 127])
					ifTrue: [extByte - 256]
					ifFalse: [(extB bitShift: 8) + extByte]]].
	^aTrinaryBlock value: extA value: extB value: scanpc - bcpc


"Why use
	byte >= 224 and: [byte <= 225]
 and not
	(byte bitAnd: 16rFE) = 16rE0
 ?
 | n |
 n := 100000000.
 #(0 224) collect:
	[:byte|
	{ Time millisecondsToRun: [1 to: n do: [:i| (byte >= 224 and: [byte <= 225]) ifTrue: []]].
	   Time millisecondsToRun: [1 to: n do: [:i| (byte bitAnd: 16rFE) = 16rE0 ifTrue: []]] }] #(#(297 599) #(702 671))"! !

!EncoderForSistaV1 class methodsFor: 'instruction stream support' stamp: 'eem 5/18/2014 19:00'!
interpretNextInstructionFor: aClient in: anInstructionStream
	"Double-dispatch through the encoder to select the correct instruction set decoder."
	^anInstructionStream interpretNextSistaV1InstructionFor: aClient! !

!EncoderForSistaV1 class methodsFor: 'instruction stream support' stamp: 'eem 5/18/2014 19:21'!
superSendScanBlockUsing: scanner
	"Answer a block argument for InstructionStream>>scanFor:
	 that answers true for super sends."

	"*	224		11100000	aaaaaaaa	Extend A (Ext A = Ext A prev * 256 + Ext A)
	 *	225		11100001	sbbbbbbb	Extend B (Ext B = Ext B prev * 256 + Ext B)
	 **	235		11101011	iiiiijjj		Send To Superclass Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments"
					
	^[:instr | instr = 235]! !

!EncoderForSistaV1 class methodsFor: 'bytecode decoding' stamp: 'ClementBera 1/27/2015 15:00'!
isAlternateBytecodeSet
	^ true! !

!EncoderForSistaV1 class methodsFor: 'instruction stream support' stamp: 'eem 5/18/2014 18:59'!
interpretJumpIfCondIn: anInstructionStream
	"Double-dispatch through the encoder to select the correct conditional jump decoder for the instruction set."
	^anInstructionStream interpretSistaV1JumpIfCond! !

!EncoderForSistaV1 class methodsFor: 'bytecode decoding' stamp: 'eem 5/18/2014 19:22'!
callPrimitiveCode
	"Answer the call primitive bytecode, if it exists in the encoder's bytecode set, or nil if not.
	 248	11111000 	iiiiiiii	mjjjjjjj	Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution."
	^248! !

!EncoderForSistaV1 class methodsFor: 'bytecode decoding' stamp: 'ClementBera 1/27/2015 14:15'!
specialLiterals
	^ #(true false nil 0 1) ! !

!EncoderForSistaV1 class methodsFor: 'bytecode decoding' stamp: 'ClementBera 12/29/2014 11:37'!
unusedBytecode
	"Answer the opcode of a single-byte unused bytecode, if it exists in the encoder's bytecode set, or nil if not."
	^ 84! !

!EncoderForV3 commentStamp: '<historical>'!
I add behaviour to Encoder to size and emit bytecodes for the Squeak V3.x VM bytecode set.  The intention is for another subclass to restrict the range of bytecodes used to long forms only, allowing the bytecode set to be redefined by avoiding using the many short forms.  The short forms may then be reassigned.!
!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 16:59'!
genBranchPopFalse: distance
	"See BlueBook page 596"
	distance < 0 ifTrue:
		[^self outOfRangeError: 'distance' index: distance range: 0 to: 1023].
	(distance > 0 and: [distance < 9]) ifTrue:
		["152-159 	10011iii 	Pop and Jump 0n False iii +1 (i.e., 1 through 8)"
		 stream nextPut: 152 + distance - 1.
		 ^self].
	distance < 1024 ifTrue:
		["172-175 	101011ii jjjjjjjj 	Pop and Jump On False ii *256+jjjjjjjj"
		 stream
			nextPut: 172 + (distance bitShift: -8);
			nextPut: distance + 1024 \\ 256.
		 ^self].
	^self outOfRangeError: 'distance' index: distance range: 0 to: 1023! !

!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 6/19/2008 08:43'!
genStorePopInstVar: instVarIndex
	"See BlueBook page 596"
	instVarIndex >= 0 ifTrue:
		[instVarIndex < 8 ifTrue:
			["96-103 	01100iii 	Pop and Store Receiver Variable #iii"
			 stream nextPut: 96 + instVarIndex.
			 ^self].
		instVarIndex < 64 ifTrue:
			["130 	10000010 jjkkkkkk 	Pop and Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk"
			 stream
				nextPut: 130;
				nextPut: instVarIndex.
			 ^self]].
	self genStorePopInstVarLong: instVarIndex! !

!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 6/19/2008 08:51'!
genStoreInstVarLong: instVarIndex
	"See BlueBook page 596"
	"See also MaybeContextInstanceVariableNode"
	(instVarIndex >= 0 and: [instVarIndex < 256]) ifTrue: 
		["132 	10000100 iiijjjjj kkkkkkkk 	(Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj"
		 stream
			nextPut: 132;
			nextPut: 160;
			nextPut: instVarIndex.
		 ^self].
	^self outOfRangeError: 'index' index: instVarIndex range: 0 to: 255! !

!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 17:00'!
genSendSuper: selectorLiteralIndex numArgs: nArgs
	"See BlueBook page 596 (with exceptions for 132 & 134)"
	nArgs < 0 ifTrue:
		[^self outOfRangeError: 'numArgs' index: nArgs range: 0 to: 31 "!!!!"].
	selectorLiteralIndex < 0 ifTrue:
		[^self outOfRangeError: 'selector literal index' index: selectorLiteralIndex range: 0 to: 255].
	(selectorLiteralIndex < 32 and: [nArgs < 8]) ifTrue: 
		["	133 	10000011 jjjkkkkk 	Send Literal Selector #kkkkk To Superclass With jjj Arguments"
		 stream
			nextPut: 133;
			nextPut: ((nArgs bitShift: 5) + selectorLiteralIndex).
		 ^self].
	(selectorLiteralIndex < 256 and: [nArgs < 32]) ifTrue: 
		["In Squeak V3
			132 	10000100 jjjjjjjj kkkkkkkk 	Send Literal Selector #kkkkkkkk With jjjjjjjj Arguments
		  is replaced by
			132 	10000100 ooojjjjj kkkkkkkk
				ooo = 0 => Send Literal Selector #kkkkkkkk With jjjjj Arguments
				ooo = 1 => Send Literal Selector #kkkkkkkk To Superclass With jjjjj Arguments"
		stream
			nextPut: 132;
			nextPut: 32 + nArgs;
			nextPut: selectorLiteralIndex.
		 ^self].
	nArgs >= 32 ifTrue:
		[^self outOfRangeError: 'numArgs' index: nArgs range: 0 to: 31].
	selectorLiteralIndex >= 256 ifTrue: 
		[^self outOfRangeError: 'selector literal index' index: selectorLiteralIndex range: 0 to: 255]! !

!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 6/19/2008 08:40'!
genPushInstVar: instVarIndex
	"See BlueBook page 596"
	instVarIndex >= 0 ifTrue:
		[instVarIndex < 16 ifTrue:
			["0-15 	0000iiii 	Push Receiver Variable #iiii"
			 stream nextPut: 0 + instVarIndex.
			 ^self].
		instVarIndex < 64 ifTrue:
			["128 	10000000 jjkkkkkk 	Push (Receiver Variable, Temporary Location, Literal Constant, Literal Variable) [jj] #kkkkkk"
			 stream
				nextPut: 128;
				nextPut: instVarIndex.
			 ^self]].
	self genPushInstVarLong: instVarIndex! !

!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 5/15/2008 09:40'!
genDup
	"See BlueBook page 596"
	"136 	10001000 	Duplicate Stack Top"
	stream nextPut: 136! !

!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 5/14/2008 17:40'!
genReturnReceiver
	"See BlueBook page 596"
	"120-123 	011110ii 	Return (receiver, true, false, nil) [ii] From Message"
	stream nextPut: 120! !

!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 17:00'!
genPushLiteral: literalIndex
	"See BlueBook page 596"
	literalIndex < 0 ifTrue: 
		[^self outOfRangeError: 'index' index: literalIndex range: 0 to: 255].
	literalIndex < 32 ifTrue: 
		["32-63 	001iiiii 	Push Literal Constant #iiiii"
		 stream nextPut: 32 + literalIndex.
		 ^self].
	literalIndex < 64 ifTrue: 
		["128 	10000000 jjkkkkkk 	Push (Receiver Variable, Temporary Location, Literal Constant, Literal Variable) [jj] #kkkkkk"
		 stream
			nextPut: 128;
			nextPut: 128 + literalIndex.
		 ^self].
	literalIndex < 256 ifTrue: 
		["132 	10000100 iiijjjjj kkkkkkkk 	(Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj"
		 stream
			nextPut: 132;
			nextPut: 96;
			nextPut: literalIndex.
		 ^self].
	^self outOfRangeError: 'index' index: literalIndex range: 0 to: 255! !

!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 5/14/2008 17:35'!
genReturnTop
	"See BlueBook page 596"
	"124-125 	0111110i 	Return Stack Top From (Message, Block) [i]"
	stream nextPut: 124! !

!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 17:01'!
genStoreTemp: tempIndex
	"See BlueBook page 596"
	tempIndex < 0 ifTrue:
		[^self outOfRangeError: 'index' index: tempIndex range: 0 to: 63].
	tempIndex < 64 ifTrue: 
		["129 	10000001 jjkkkkkk 	Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk"
		 stream
			nextPut: 129;
			nextPut: 64 + tempIndex.
		 ^self].
	^self outOfRangeError: 'index' index: tempIndex range: 0 to: 63! !

!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 5/14/2008 17:38'!
genPushSpecialLiteral: aLiteral
	"112-119 	01110iii 	Push (receiver, true, false, nil, -1, 0, 1, 2) [iii]"
	| index |
	index := #(true false nil -1 0 1 2) indexOf: aLiteral ifAbsent: 0.
	index = 0 ifTrue:
		[^self error: 'push special literal: ', aLiteral printString,  ' is not one of true false nil -1 0 1 2'].
	stream nextPut: index + 112! !

!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 17:01'!
genStorePopTemp: tempIndex
	"See BlueBook page 596"
	tempIndex < 0 ifTrue:
		[^self outOfRangeError: 'index' index: tempIndex range: 0 to: 63].
	tempIndex < 8 ifTrue: 
		["104-111 	01101iii 	Pop and Store Temporary Location #iii"
		 stream nextPut: 104 + tempIndex.
		 ^self].
	tempIndex < 64 ifTrue: 
		["130 	10000010 jjkkkkkk 	Pop and Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk"
		 stream
			nextPut: 130;
			nextPut: 64 + tempIndex.
		 ^self].
	^self outOfRangeError: 'index' index: tempIndex range: 0 to: 63! !

!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 5/14/2008 17:35'!
genReturnTopToCaller
	"See BlueBook page 596"
	"124-125 	0111110i 	Return Stack Top From (Message, Block) [i]"
	stream nextPut: 125! !

!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 5/14/2008 16:16'!
genPushReceiver
	"See BlueBook page 596"
	"112-119 	01110iii 	Push (receiver, true, false, nil, -1, 0, 1, 2) [iii]"
	stream nextPut: 112! !

!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 17:00'!
genPushTemp: tempIndex
	"See BlueBook page 596"
	tempIndex < 0 ifTrue:
		[^self outOfRangeError: 'index' index: tempIndex range: 0 to: 63].
	tempIndex < 16 ifTrue: 
		["16-31 	0001iiii 	Push Temporary Location #iiii"
		 stream nextPut: 16 + tempIndex.
		 ^self].
	tempIndex < 64 ifTrue: 
		["128 	10000000 jjkkkkkk 	Push (Receiver Variable, Temporary Location, Literal Constant, Literal Variable) [jj] #kkkkkk"
		 stream
			nextPut: 128;
			nextPut: 64 + tempIndex.
		 ^self].
	^self outOfRangeError: 'index' index: tempIndex range: 0 to: 63! !

!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 6/19/2008 08:37'!
genStoreInstVar: instVarIndex
	"See BlueBook page 596"
	(instVarIndex >= 0 and: [instVarIndex < 64]) ifTrue: 
		["129 	10000001 jjkkkkkk 	Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk"
		 stream
			nextPut: 129;
			nextPut: instVarIndex.
		 ^self].
	self genStoreInstVarLong: instVarIndex! !

!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 16:59'!
genBranchPopTrue: distance
	"See BlueBook page 596"
	distance < 0 ifTrue:
		[^self outOfRangeError: 'distance' index: distance range: 0 to: 1023].
	distance < 1024 ifTrue:
		["168-171 	101010ii jjjjjjjj 	Pop and Jump On True ii *256+jjjjjjjj"
		 stream
			nextPut: 168 + (distance bitShift: -8);
			nextPut: distance + 1024 \\ 256.
		 ^self].
	^self outOfRangeError: 'distance' index: distance range: 0 to: 1023! !

!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 5/14/2008 17:39'!
genReturnSpecialLiteral: aLiteral
	"120-123 	011110ii 	Return (receiver, true, false, nil) [ii] From Message"
	| index |
	index := #(true false nil) indexOf: aLiteral ifAbsent: 0.
	index = 0 ifTrue:
		[^self error: 'return special literal: ', aLiteral printString,  ' is not one of true false nil'].
	stream nextPut: 120 + index! !

!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 5/14/2008 17:41'!
genJump: distance
	"See BlueBook page 596"
	(distance > 0 and: [distance < 9]) ifTrue:
		["144-151 	10010iii 	Jump iii + 1 (i.e., 1 through 8)"
		 stream nextPut: 144 + distance - 1.
		 ^self].
	"160-167 	10100iii jjjjjjjj 	Jump(iii - 4) *256+jjjjjjjj"
	^self genJumpLong: distance! !

!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 17:01'!
genStoreLiteralVar: literalIndex
	"See BlueBook page 596"
	literalIndex < 0 ifTrue:
		[^self outOfRangeError: 'index' index: literalIndex range: 0 to: 255].
	literalIndex < 64 ifTrue: 
		["129 	10000001 jjkkkkkk 	Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk"
		 stream
			nextPut: 129;
			nextPut: 192 + literalIndex.
		 ^self].
	literalIndex < 256 ifTrue: 
		["132 	10000100 iiijjjjj kkkkkkkk 	(Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj"
		 stream
			nextPut: 132;
			nextPut: 224;
			nextPut: literalIndex.
		 ^self].
	^self outOfRangeError: 'index' index: literalIndex range: 0 to: 255! !

!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 6/19/2008 08:51'!
genPushInstVarLong: instVarIndex
	"See BlueBook page 596"
	"See also MaybeContextInstanceVariableNode"
	(instVarIndex >= 0 and: [instVarIndex < 256]) ifTrue: 
		["132 	10000100 iiijjjjj kkkkkkkk 	(Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj"
		 stream
			nextPut: 132;
			nextPut: 64;
			nextPut: instVarIndex.
		 ^self].
	^self outOfRangeError: 'index' index: instVarIndex range: 0 to: 255! !

!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 17:00'!
genSend: selectorLiteralIndex numArgs: nArgs
	"See BlueBook page 596 (with exceptions for 132 & 134)"
	nArgs < 0 ifTrue:
		[^self outOfRangeError: 'numArgs' index: nArgs range: 0 to: 31 "!!!!"].
	selectorLiteralIndex < 0 ifTrue:
		["Special selector sends.
			176-191 	1011iiii 	Send Arithmetic Message #iiii
			192-207 	1100iiii 	Send Special Message #iiii"
		self flag: #yuck.
		 (selectorLiteralIndex negated between: 176 and: 207) ifFalse:
			[^self outOfRangeError: 'special selector code' index: selectorLiteralIndex negated range: 176 to: 207].
		 stream nextPut: selectorLiteralIndex negated.
		 ^self].
	(selectorLiteralIndex < 16 and: [nArgs < 3]) ifTrue:
		["	208-223 	1101iiii 	Send Literal Selector #iiii With No Arguments
			224-239 	1110iiii 	Send Literal Selector #iiii With 1 Argument
			240-255 	1111iiii 	Send Literal Selector #iiii With 2 Arguments"
		 stream nextPut: 208 + (nArgs * 16) + selectorLiteralIndex.
		 ^self].
	(selectorLiteralIndex < 32 and: [nArgs < 8]) ifTrue: 
		["	131 	10000011 jjjkkkkk 	Send Literal Selector #kkkkk With jjj Arguments"
		 stream
			nextPut: 131;
			nextPut: ((nArgs bitShift: 5) + selectorLiteralIndex).
		 ^self].
	(selectorLiteralIndex < 64 and: [nArgs < 4]) ifTrue: 
	 	["In Squeak V3
			134 	10000110 jjjjjjjj kkkkkkkk 	Send Literal Selector #kkkkkkkk To Superclass With jjjjjjjj Arguments
		 is replaced by
			134 	10000110 jjkkkkkk 	Send Literal Selector #kkkkkk With jj Arguments"
		 stream
			nextPut: 134;
			nextPut: ((nArgs bitShift: 6) + selectorLiteralIndex).
		 ^self].
	(selectorLiteralIndex < 256 and: [nArgs < 32]) ifTrue: 
		["In Squeak V3
			132 	10000100 jjjjjjjj kkkkkkkk 	Send Literal Selector #kkkkkkkk With jjjjjjjj Arguments
		  is replaced by
			132 	10000100 ooojjjjj kkkkkkkk
				ooo = 0 => Send Literal Selector #kkkkkkkk With jjjjj Arguments
				ooo = 1 => Send Literal Selector #kkkkkkkk To Superclass With jjjjj Arguments"
		stream
			nextPut: 132;
			nextPut: nArgs;
			nextPut: selectorLiteralIndex.
		 ^self].
	nArgs >= 32 ifTrue:
		[^self outOfRangeError: 'numArgs' index: nArgs range: 0 to: 31].
	selectorLiteralIndex >= 256 ifTrue: 
		[^self outOfRangeError: 'selector literal index' index: selectorLiteralIndex range: 0 to: 255]! !

!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 17:01'!
genStorePopLiteralVar: literalIndex
	"See BlueBook page 596"
	literalIndex < 0 ifTrue:
		[^self outOfRangeError: 'index' index: literalIndex range: 0 to: 255].
	literalIndex < 64 ifTrue: 
		["130 	10000010 jjkkkkkk 	Pop and Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk"
		 stream
			nextPut: 130;
			nextPut: 192 + literalIndex.
		 ^self].
	literalIndex < 256 ifTrue: 
		["132 	10000100 iiijjjjj kkkkkkkk 	(Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj"
		 stream
			nextPut: 132;
			nextPut: 224;
			nextPut: literalIndex.
		 self genPop.
		 ^self].
	^self outOfRangeError: 'index' index: literalIndex range: 0 to: 255! !

!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 16:59'!
genPushLiteralVar: literalIndex
	"See BlueBook page 596"
	literalIndex < 0 ifTrue: 
		[^self outOfRangeError: 'index' index: literalIndex range: 0 to: 255].
	literalIndex < 32 ifTrue: 
		["64-95 	010iiiii 	Push Literal Variable #iiiii"
		 stream nextPut: 64 + literalIndex.
		 ^self].
	literalIndex < 64 ifTrue: 
		["128 	10000000 jjkkkkkk 	Push (Receiver Variable, Temporary Location, Literal Constant, Literal Variable) [jj] #kkkkkk"
		 stream
			nextPut: 128;
			nextPut: 192 + literalIndex.
		 ^self].
	literalIndex < 256 ifTrue: 
		["132 	10000100 iiijjjjj kkkkkkkk 	(Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj"
		 stream
			nextPut: 132;
			nextPut: 128;
			nextPut: literalIndex.
		 ^self].
	^self outOfRangeError: 'index' index: literalIndex range: 0 to: 255! !

!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'ClementBera 1/27/2015 14:15'!
genSendSpecial: specialSelectorIndex numArgs: nArgs
	self assert: (specialSelectorIndex between: 1 and: Smalltalk specialSelectorSize).
	self assert: nArgs = (Smalltalk specialNargsAt: specialSelectorIndex).
	"Special selector sends.
		96-111		0110 iiii			Send Arithmetic Message #iiii #(#+ #- #< #> #'<=' #'>=' #= #'~=' #* #/ #'\\' #@ #bitShift: #'//' #bitAnd: #bitOr:)
		112-119	01110 iii			Send Special Message #iii #(#at: #at:put: #size ? ? ? #'==' class ? value value: ? ? ? ? ?)"

	stream nextPut: specialSelectorIndex + 175! !

!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 5/14/2008 17:36'!
genPushThisContext
	"See BlueBook page 596"
	"137 	10001001 	Push Active Context"
	stream nextPut: 137! !

!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 6/19/2008 08:52'!
genStorePopInstVarLong: instVarIndex
	"See BlueBook page 596"
	"See also MaybeContextInstanceVariableNode"
	(instVarIndex >= 0 and: [instVarIndex < 256]) ifTrue: 
		["132 	10000100 iiijjjjj kkkkkkkk 	(Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj"
		 stream
			nextPut: 132;
			nextPut: 192;
			nextPut: instVarIndex.
		 ^self].
	^self outOfRangeError: 'index' index: instVarIndex range: 0 to: 255! !

!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 16:59'!
genJumpLong: distance
	"See BlueBook page 596"
	(distance >= -1024 and: [distance < 1024]) ifTrue:
		["160-167 	10100iii jjjjjjjj 	Jump(iii - 4) *256+jjjjjjjj"
		 stream
			nextPut: 160 + (distance + 1024 bitShift: -8);
			nextPut: distance + 1024 \\ 256.
		 ^self].
	^self outOfRangeError: 'distance' index: distance range: -1024 to: 1023! !

!EncoderForV3 methodsFor: 'bytecode generation' stamp: 'eem 5/14/2008 17:27'!
genPop
	"See BlueBook page 596"
	"135 	10000111 	Pop Stack Top"
	stream nextPut: 135! !

!EncoderForV3 class methodsFor: 'compiled method support' stamp: 'ClementBera 12/29/2014 11:37'!
supportsClosures
	"Answer if the instruction set supports closures (contains
	 closure creation and indirect temp access bytecodes)."

	^ false! !

!EncoderForV3PlusClosures commentStamp: '<historical>'!
An encoder for the V3 bytecode set augmented with the following bytecodes that are part of the full closure implementation.
	138   10001010 jkkkkkkk		Push (Array new: kkkkkkk) (j = 0)
								or	Pop kkkkkkk elements into: (Array new: kkkkkkk) (j = 1)

	140   10001100 kkkkkkkk jjjjjjjj 	Push Temp At kkkkkkkk In Temp Vector At: jjjjjjjj
	141   10001101 kkkkkkkk jjjjjjjj 	Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj
	142   10001110 kkkkkkkk jjjjjjjj 	Pop and Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj
	143   10001111 llllkkkk jjjjjjjj iiiiiiii	Push Closure Num Copied llll Num Args kkkk BlockSize jjjjjjjjiiiiiiii
This is an exact duplicate of EncoderForLongFormV3PlusClosures.
Could be a trait (or in Newspeak, a Mixin).
For now we impose upon you to synchronise any and all changes between these two classes.!
!EncoderForV3PlusClosures methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 17:11'!
genPushClosureCopyNumCopiedValues: numCopied numArgs: numArgs jumpSize: jumpSize
	"143 	10001111 llllkkkk jjjjjjjj iiiiiiii	Push Closure Num Copied llll Num Args kkkk BlockSize jjjjjjjjiiiiiiii"
	(jumpSize < 0 or: [jumpSize > 65535]) ifTrue:
		[^self outOfRangeError: 'block size' index: jumpSize range: 0 to: 65535].
	(numCopied < 0 or: [numCopied > 15]) ifTrue:
		[^self outOfRangeError: 'num copied' index: numCopied range: 0 to: 15].
	(numArgs < 0 or: [numArgs > 15]) ifTrue:
		[^self outOfRangeError: 'num args' index: numArgs range: 0 to: 15].
	stream
		nextPut: 143;
		nextPut: numArgs + (numCopied bitShift: 4);
		nextPut: (jumpSize bitShift: -8);
		nextPut: (jumpSize bitAnd: 16rFF)! !

!EncoderForV3PlusClosures methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 17:03'!
genPushConsArray: size
	(size < 0 or: [size > 127]) ifTrue:
		[^self outOfRangeError: 'numElements' index: size range: 0 to: 127].
	"138 	10001010 1kkkkkkk 	Push (Array new: kkkkkkk)"
	stream
		nextPut: 138;
		nextPut: size + 128! !

!EncoderForV3PlusClosures methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 17:06'!
genPushNewArray: size
	(size < 0 or: [size > 127]) ifTrue:
		[^self outOfRangeError: 'numElements' index: size range: 0 to: 127].
	"138 	10001010 0kkkkkkk 	Pop kkkkkkk into: (Array new: kkkkkkk)"
	stream
		nextPut: 138;
		nextPut: size! !

!EncoderForV3PlusClosures methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 17:02'!
genStorePopRemoteTemp: tempIndex inVectorAt: tempVectorIndex
	"142 	10001110 kkkkkkkk jjjjjjjj 	Pop and Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj"
	(tempIndex >= 0 and: [tempIndex < 256
	 and: [tempVectorIndex >= 0 and: [tempVectorIndex < 256]]]) ifTrue:
		[stream
			nextPut: 142;
			nextPut: tempIndex;
			nextPut: tempVectorIndex.
		 ^self].
	tempIndex >= 256 ifTrue:
		[^self outOfRangeError: 'remoteTempIndex' index: tempIndex range: 0 to: 255].
	tempVectorIndex >= 256 ifTrue:
		[^self outOfRangeError: 'tempVectorIndex' index: tempVectorIndex range: 0 to: 255]! !

!EncoderForV3PlusClosures methodsFor: 'bytecode generation' stamp: 'eem 5/30/2008 17:02'!
genStoreRemoteTemp: tempIndex inVectorAt: tempVectorIndex
	"141 	10001101 kkkkkkkk jjjjjjjj 	Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj"
	(tempIndex >= 0 and: [tempIndex < 256
	 and: [tempVectorIndex >= 0 and: [tempVectorIndex < 256]]]) ifTrue:
		[stream
			nextPut: 141;
			nextPut: tempIndex;
			nextPut: tempVectorIndex.
		 ^self].
	tempIndex >= 256 ifTrue:
		[^self outOfRangeError: 'remoteTempIndex' index: tempIndex range: 0 to: 255].
	tempVectorIndex >= 256 ifTrue:
		[^self outOfRangeError: 'tempVectorIndex' index: tempVectorIndex range: 0 to: 255]! !

!EncoderForV3PlusClosures methodsFor: 'testing' stamp: 'eem 5/24/2008 18:12'!
supportsClosureOpcodes
	^true! !

!EncoderForV3PlusClosures methodsFor: 'bytecode generation' stamp: 'eem 6/16/2008 09:45'!
genPushRemoteTemp: tempIndex inVectorAt: tempVectorIndex
	(tempIndex >= 0 and: [tempIndex < 256
	 and: [tempVectorIndex >= 0 and: [tempVectorIndex < 256]]]) ifTrue:
		["140 	10001100 kkkkkkkk jjjjjjjj 	Push Temp At kkkkkkkk In Temp Vector At: jjjjjjjj"
		 stream
			nextPut: 140;
			nextPut: tempIndex;
			nextPut: tempVectorIndex.
		 ^self].
	tempIndex >= 256 ifTrue:
		[^self outOfRangeError: 'remoteTempIndex' index: tempIndex range: 0 to: 255].
	tempVectorIndex >= 256 ifTrue:
		[^self outOfRangeError: 'tempVectorIndex' index: tempVectorIndex range: 0 to: 255]! !

!EncoderForV3PlusClosures class methodsFor: 'instruction stream support' stamp: 'ClementBera 12/29/2014 12:24'!
isStorePopAt: pc in: method
	"Answer whether the bytecode at pc is a store or store-pop."
	
	| byte |
	byte := method at: pc.
	"130		extendedStoreAndPopBytecode"
	^ byte = 130
		or: [
			"142		storeAndPopRemoteTempLongBytecode"
			byte = 142
		or: [
			"96 103		storeAndPopReceiverVariableBytecode"
			"104 111	storeAndPopTemporaryVariableBytecode"
			byte between: 96 and: 111 ]]! !

!EncoderForV3PlusClosures class methodsFor: 'compiled method support' stamp: 'ClementBera 12/29/2014 12:11'!
bindingWriteScanBlockFor: litVarIndex using: scanner
	"Answer a block argument for InstructionStream>>scanFor: that answers true
	 for writes of the value of the binding with zero-relative index litVarIndex.
	 N.B. Don't assume the compiler uses the most compact encoding available."
	^ [:b|
		(b = 129 or: [b = 130])
			ifTrue: [scanner followingByte - 192 = litVarIndex]
			ifFalse:
				[b = 132
				 and: [scanner followingByte >= 224
				 and: [scanner thirdByte = litVarIndex]]]]! !

!EncoderForV3PlusClosures class methodsFor: 'block closure support' stamp: 'ClementBera 12/29/2014 14:50'!
numLocalTempsForBlockAt: startpc in: method
	"4 = size of push closure copy bytecode"
	^ BlockLocalTempCounter
		tempCountForBlockAt: startpc - 4 
		in: method ! !

!EncoderForV3PlusClosures class methodsFor: 'compiled method support' stamp: 'ClementBera 12/29/2014 11:37'!
supportsClosures
	"Answer if the instruction set supports closures (contains
	 closure creation and indirect temp access bytecodes)."

	^true! !

!EncoderForV3PlusClosures class methodsFor: 'bytecode decoding' stamp: 'ClementBera 12/29/2014 12:03'!
stackDeltaForPrimitive: primitiveIndex in: method
	"We do not use inlined primitive in v3PlusClosure bytecode set"
	^ 0! !

!EncoderForV3PlusClosures class methodsFor: 'compiled method support' stamp: 'ClementBera 12/29/2014 12:11'!
instVarWriteScanBlockFor: varIndexCode using: scanner
	"Answer a block argument for InstructionStream>>scanFor: that answers true
	 for writes of the inst var with zero-relative index varIndexCode.
	 N.B. Don't assume the compiler uses the most compact encoding available."
	^ [:b|
		b >= 96
		and: [b <= 103
				ifTrue: [b - 96 = varIndexCode]
				ifFalse:
					[(b = 129 or: [b = 130])
						ifTrue: [scanner followingByte = varIndexCode and: [varIndexCode <= 63]]
						ifFalse:
							[b = 132
							 and: [(scanner followingByte between: 160 and: 223)
							 and: [scanner thirdByte = varIndexCode]]]]]]! !

!EncoderForV3PlusClosures class methodsFor: 'instruction stream support' stamp: 'ClementBera 12/29/2014 12:18'!
isBranchIfFalseAt: pc in: method
	"Answer whether the bytecode at pc is a conditional branch-if-false."
	
	
	| byte |
	byte := method at: pc.
	^(byte between: 152 and: 159) or: [byte between: 172 and: 175]! !

!EncoderForV3PlusClosures class methodsFor: 'bytecode decoding' stamp: 'ClementBera 1/27/2015 14:15'!
backJumpBytecodeSize
	^ 2! !

!EncoderForV3PlusClosures class methodsFor: 'instruction stream support' stamp: 'ClementBera 12/29/2014 11:33'!
bytecodeSize: bytecode
	| type |
	type := bytecode // 16.
	"extensions"
	^ type = 8
		ifTrue: [#(2 2 2 2 3 2 2 1 1 1 2 3 3 3 3 4) at: bytecode \\ 16 + 1]
		ifFalse: [
			"long jumps"
			type = 10
				ifTrue: [2]
				ifFalse: [1]]! !

!EncoderForV3PlusClosures class methodsFor: 'instruction stream support' stamp: 'ClementBera 12/29/2014 12:15'!
isCreateBlockAt: pc in: method
	^ (method at: pc) = 143! !

!EncoderForV3PlusClosures class methodsFor: 'instruction stream support' stamp: 'ClementBera 2/24/2015 16:08'!
nonExtensionBytecodeAt: pc in: method
	"Answer the actual bytecode at pc in method, skipping past any preceeding extensions."
	^ method at: pc! !

!EncoderForV3PlusClosures class methodsFor: 'instruction stream support' stamp: 'ClementBera 12/29/2014 11:57'!
isBlockReturnAt: pc in: method
	^ (method at: pc) =  125! !

!EncoderForV3PlusClosures class methodsFor: 'instruction stream support' stamp: 'ClementBera 12/29/2014 12:23'!
isSendAt: pc in: method
	"Answer whether the bytecode at pc is a message-send."
	
	| byte |
	byte := method at: pc.
	^byte >= 131
	  and: [ "special send or short send" 
		byte >= 176 or: [ "long sends" byte <= 134]]! !

!EncoderForV3PlusClosures class methodsFor: 'compiled method support' stamp: 'ClementBera 12/29/2014 12:13'!
instVarReadScanBlockFor: varIndexCode using: scanner
	"Answer a block argument for InstructionStream>>scanFor: that answers true
	 for reads of the inst var with zero-relative index varIndexCode.
	 N.B. Don't assume the compiler uses the most compact encoding available."
	^ [:b|
		b < 16
			ifTrue: [b = varIndexCode]
			ifFalse:
				[b = 128
					ifTrue: [scanner followingByte = varIndexCode and: [varIndexCode <= 63]]
					ifFalse:
						[b = 132
						 and: [(scanner followingByte between: 64 and: 95)
						 and: [scanner thirdByte = varIndexCode]]]]]! !

!EncoderForV3PlusClosures class methodsFor: 'compiled method support' stamp: 'ClementBera 12/29/2014 12:12'!
bindingReadScanBlockFor: litIndex using: scanner
	"Answer a block argument for InstructionStream>>scanFor: that answers true
	 for reads of the value of the binding with zero-relative index litVarIndex.
	 N.B. Don't assume the compiler uses the most compact encoding available."
	^ [:b|
		b >= 64
		and:
			[b <= 95
				ifTrue: [b - 64 = litIndex]
				ifFalse:
					[b = 128
						ifTrue: [scanner followingByte - 192 = litIndex]
						ifFalse:
							[b = 132
							 and: [(scanner followingByte between: 128 and: 159)
							 and: [scanner thirdByte = litIndex]]]]]]! !

!EncoderForV3PlusClosures class methodsFor: 'instruction stream support' stamp: 'ClementBera 12/29/2014 12:20'!
isJustPopAt: pc in: method
	"Answer whether the bytecode at pc is a pop."

	^ (method at: pc) = 135! !

!EncoderForV3PlusClosures class methodsFor: 'instruction stream support' stamp: 'ClementBera 12/29/2014 12:19'!
isBranchIfTrueAt: pc in: method
	"Answer whether the bytecode at pc is a conditional branch-if-true."
	
	| byte |
	byte := method at: pc.
	^ byte between: 168 and: 171! !

!EncoderForV3PlusClosures class methodsFor: 'instruction stream support' stamp: 'ClementBera 12/28/2014 18:09'!
interpretJumpIn: anInstructionStream
	"Double-dispatch through the encoder to select the correct unconditional jump decoder for the instruction set."
	^ anInstructionStream interpretV3PlusClosureJump! !

!EncoderForV3PlusClosures class methodsFor: 'instruction stream support' stamp: 'ClementBera 12/29/2014 11:50'!
selectorToSendOrItselfFor: anInstructionStream in: method at: pc
	"If anInstructionStream is at a send bytecode then answer the send's selector,
	 otherwise answer anInstructionStream itself.  The rationale for answering
	 anInstructionStream instead of, say, nil, is that potentially any existing object
	 can be used as a selector, but since anInstructionStream postdates the method,
	 it can't be one of them."

	| byte byte2 |
	byte := method at: pc.
	byte < 131 ifTrue: [^ anInstructionStream].
	byte >= 176
		ifTrue: [
			"special byte or short send"
			byte >= 208
				ifTrue: [^ method literalAt: (byte bitAnd: 15) + 1]
				ifFalse: [^ Smalltalk specialSelectorAt: byte - 176 + 1]]
		ifFalse: [
			byte <= 134 
				ifTrue: [ 
					byte2 := method at: pc + 1.
					byte = 131 ifTrue: [^ method literalAt: byte2 \\ 32 + 1].
					byte = 132 ifTrue: [
						byte2 < 64 ifTrue: [^ method literalAt: ( method at: pc + 2) + 1]]	.
					byte = 133 ifTrue: [^ method literalAt: byte2 \\ 32 + 1].
					byte = 134 ifTrue: [^ method literalAt: byte2 \\ 64 + 1]]].
	^ anInstructionStream! !

!EncoderForV3PlusClosures class methodsFor: 'instruction stream support' stamp: 'ClementBera 12/29/2014 12:21'!
isReturnAt: pc in: method
	"Answer whether the bytecode at pc is a return from block."
	
	^(method at: pc) between: 120 and: 125! !

!EncoderForV3PlusClosures class methodsFor: 'instruction stream support' stamp: 'ClementBera 12/29/2014 12:17'!
isJumpAt: pc in: method
	"Answer whether the bytecode at pc is an (unconditional) jump."

	| byte |
	byte := method at: pc.
	^ (byte between: 144 and: 151) or: [byte between: 160 and: 167]! !

!EncoderForV3PlusClosures class methodsFor: 'instruction stream support' stamp: 'ClementBera 12/29/2014 12:23'!
isStoreAt: pc in: method
	"Answer whether the bytecode at pc is a store or store-pop."

	| byte |
	byte := method at: pc.
	^(byte between: 96 and: 142)
		and: [
			"96 103		storeAndPopReceiverVariableBytecode"
			"104 111	storeAndPopTemporaryVariableBytecode"
			byte <= 111 
			or: [
				"129		extendedStoreBytecode"
				byte >= 129
				and: [
					"130		extendedStoreAndPopBytecode"
					byte <= 130
					or: [(
							"132		doubleExtendedDoAnythingBytecode"
							byte = 132	 
							and: [ (method at: pc+1) >= 160 ])
					or: [
						"141		storeRemoteTempLongBytecode"
						byte = 141
					or: [
						"142		storeAndPopRemoteTempLongBytecode"
						byte = 142]]]]]]! !

!EncoderForV3PlusClosures class methodsFor: 'instruction stream support' stamp: 'ClementBera 12/28/2014 18:08'!
interpretNextInstructionFor: aClient in: anInstructionStream
	"Double-dispatch through the encoder to select the correct instruction set decoder."
	^ anInstructionStream interpretNextV3PlusClosureInstructionFor: aClient! !

!EncoderForV3PlusClosures class methodsFor: 'bytecode decoding' stamp: 'ClementBera 1/27/2015 15:00'!
isAlternateBytecodeSet
	^ false! !

!EncoderForV3PlusClosures class methodsFor: 'instruction stream support' stamp: 'ClementBera 12/28/2014 18:09'!
interpretJumpIfCondIn: anInstructionStream
	"Double-dispatch through the encoder to select the correct conditional jump decoder for the instruction set."
	^anInstructionStream interpretV3PlusClosureJumpIfCond! !

!EncoderForV3PlusClosures class methodsFor: 'bytecode decoding' stamp: 'ClementBera 12/29/2014 12:03'!
callPrimitiveCode
	"Answer the call primitive bytecode, if it exists in the encoder's bytecode set, or nil if not."
	^ Smalltalk vm isSpur ifTrue: [ 139 ]! !

!EncoderForV3PlusClosures class methodsFor: 'bytecode decoding' stamp: 'ClementBera 1/27/2015 14:15'!
specialLiterals
	^ #(true false nil -1 0 1 2) ! !

!EncoderForV3PlusClosures class methodsFor: 'bytecode decoding' stamp: 'ClementBera 12/29/2014 11:36'!
unusedBytecode
	"Answer the opcode of a single-byte unused bytecode, if it exists in the encoder's bytecode set, or nil if not."
	^ 126! !

!EntryCompletion commentStamp: 'AlainPlantec 11/29/2010 10:58'!
An EntryCompletion is a handler for the driving of the completion menu in a PluggableTextFieldMorph. The completion menu is an IdentifierChooserMorph which is typically built and popup when a character is entered in a PluggableTextFieldMorph. 

Instance Variables
	chooseBlock:		<Block>
	chooser:		<IdentifierChooserMorph>
	dataSourceBlock:		<Block>
	filterBlock:		<Block>
	previousToken:		<String>

chooseBlock
	- One argument block which is evaluated when a token is chosen, the token is passed as argument

chooser
	- The IdentifierChooserMorph which is currently opened

dataSourceBlock
	- The block that is evaluated in order to get the list of items

filterBlock
	- The block used to filter the dataSource list, it takes 2 args, the first is an item from the current dataSource list element, the second is the token fetched from the requestor (the PluggableTextFieldMorph). It returns true if the current dataSource list element is to be kept

previousToken
	- Used to be able to not open the list if the current text in the PluggableTextFieldMorph was the previous chosen one
!
!EntryCompletion methodsFor: 'event-handling' stamp: 'AlainPlantec 11/26/2010 15:55'!
handlesKeyboard: anEvent
	^ anEvent keyCharacter = Character arrowDown
		or: [chooser notNil and: [ anEvent keyCharacter = Character escape]]! !

!EntryCompletion methodsFor: 'accessing' stamp: 'AlainPlantec 11/24/2010 22:28'!
choose: aToken
	chooseBlock 
		ifNotNil: [self closeChooser.
			previousToken := aToken.
			chooseBlock value: aToken]! !

!EntryCompletion methodsFor: 'accessing' stamp: 'AlainPlantec 11/22/2010 16:04'!
chooseBlock

	^ chooseBlock! !

!EntryCompletion methodsFor: 'accessing' stamp: 'ClementBera 7/26/2013 16:38'!
chooserWith: aToken
	| applicants |
	applicants  := self filteredValuesWith: aToken.
	aToken 
		ifNil: [applicants isEmpty 
			ifFalse: [self setChooserWith: nil labels: applicants]]
		ifNotNil: [ | meaningfulApplicants | 
			meaningfulApplicants := (applicants copyWithout: nil) asSet.
			meaningfulApplicants isEmpty 
				ifFalse: [(meaningfulApplicants size = 1 and: [aToken = meaningfulApplicants anyOne])
					ifFalse: [(previousToken isNil or: [previousToken size ~= aToken size])
						ifTrue: [self setChooserWith: aToken labels: applicants]]].
			previousToken := aToken].
	^ chooser! !

!EntryCompletion methodsFor: 'accessing' stamp: 'StephaneDucasse 9/30/2014 12:07'!
setChooserWith: aToken labels: labels
	chooser 
		ifNil: [chooser := IdentifierChooserMorph 
							labels: labels
							chooseBlock: [:token | self choose: token]].
	^ chooser! !

!EntryCompletion methodsFor: 'accessing' stamp: 'AlainPlantec 11/29/2010 09:34'!
openChooserWith: aToken from: aFieldMorph 
	self closeChooser.
	self chooserWith: aToken.
	chooser
		ifNotNil: [ | baseColor |
			baseColor := aFieldMorph window
				ifNil: [aFieldMorph color veryMuchLighter]
				ifNotNil: [:w | w paneColor veryMuchLighter].
			chooser baseColor: baseColor.
			chooser oneMenuOfWidth: aFieldMorph bounds width - aFieldMorph layoutInset - (aFieldMorph borderWidth * 2) - 2.
			
			chooser fillStyle: (aFieldMorph theme textEditorNormalFillStyleFor: aFieldMorph).
			chooser open.
			chooser requestor: aFieldMorph.
			chooser position: aFieldMorph bottomLeft + (aFieldMorph borderWidth @ 0).
			chooser boundsInWorld bottomLeft y  > chooser allowedArea bottom
                		ifTrue: [chooser forcesHeight: (chooser allowedArea bottom - (chooser boundsInWorld topLeft y + 2))]].
	^ chooser! !

!EntryCompletion methodsFor: 'event-handling' stamp: 'BenjaminVanRyseghem 9/8/2013 17:58'!
closeIfNotNeeded: aMorph

	(chooser isNotNil and:[ chooser hasKeyboardFocus or: [ aMorph hasKeyboardFocus ] ]) ifFalse: [ self closeChooser ]! !

!EntryCompletion methodsFor: 'accessing' stamp: 'AlainPlantec 11/22/2010 16:04'!
chooseBlock: aBlock

	chooseBlock := aBlock! !

!EntryCompletion methodsFor: 'accessing' stamp: 'AlainPlantec 11/25/2010 10:20'!
dataSourceBlock
	^ dataSourceBlock ifNil: [dataSourceBlock := [:token | #()]]! !

!EntryCompletion methodsFor: 'accessing' stamp: 'AlainPlantec 11/24/2010 17:02'!
filterBlock

	^ filterBlock ifNil: [filterBlock := [:currApplicant  :currText | true]]! !

!EntryCompletion methodsFor: 'accessing' stamp: 'AlainPlantec 11/25/2010 09:06'!
dataSourceBlock: aBlock
	dataSourceBlock := aBlock! !

!EntryCompletion methodsFor: 'accessing' stamp: 'AlainPlantec 11/23/2010 18:18'!
filterBlock: aBlock

	filterBlock := aBlock! !

!EntryCompletion methodsFor: 'event-handling' stamp: 'AlainPlantec 11/27/2010 22:50'!
keystroke: anEvent from: aMorph
	(self handlesKeyboard: anEvent) 
		ifFalse: [^ false].
	(chooser notNil and: [ anEvent keyCharacter = Character escape])
		ifTrue: [self closeChooser. 
			aMorph takeKeyboardFocus.
			^ true].
	(chooser isNil and: [ anEvent keyCharacter = Character arrowDown])
		ifTrue: [previousToken := nil.
			self openChooserWith: aMorph textMorph text string from: aMorph.
			chooser ifNotNil: [^ true]].
	^ chooser 
		ifNil: [false]
		ifNotNil: [chooser keyStroke: anEvent]
	! !

!EntryCompletion methodsFor: 'event-handling' stamp: 'AlainPlantec 11/24/2010 22:19'!
mouseDownFromTextMorph: anEvent
	self closeChooser! !

!EntryCompletion methodsFor: 'accessing' stamp: 'AlainPlantec 11/26/2010 09:13'!
positionChooser
        "Position the chooser to fit on the display."

   ! !

!EntryCompletion methodsFor: 'accessing' stamp: 'AlainPlantec 11/26/2010 08:23'!
positionChooser: aChooser
        "Position the list morph to fit on the display."

        aChooser boundsInWorld bottomLeft y + aChooser listHeight > aChooser world bottom
                ifTrue: [aChooser listMorph
                                        bounds: (aChooser boundsInWorld topLeft - (0 @ aChooser listHeight) extent: aChooser width @ aChooser listHeight)]
                ifFalse: [aChooser listMorph
                                        bounds: (aChooser boundsInWorld bottomLeft extent: aChooser width @ aChooser listHeight)] ! !

!EntryCompletion methodsFor: 'accessing' stamp: 'AlainPlantec 11/27/2010 07:29'!
filteredValuesWith: aToken
	^ (self dataSourceBlock value: aToken) 
		select: [:v | aToken isNil or: [v isNil or: [self filterBlock value: v value: aToken]]]! !

!EntryCompletion methodsFor: 'accessing' stamp: 'AlainPlantec 11/29/2010 08:57'!
openChooserWithAllOrCloseFrom: aFieldMorph 
	chooser 
		ifNotNil: [self closeChooser]
		ifNil: [self openChooserWith: nil from: aFieldMorph].
	^ chooser! !

!EntryCompletion methodsFor: 'accessing' stamp: 'AlainPlantec 11/24/2010 21:30'!
closeChooser
	chooser 
		ifNotNil: [chooser close.
			chooser := nil].
! !

!EntryCompletion methodsFor: 'accessing' stamp: 'AlainPlantec 11/25/2010 20:12'!
chooser
	^ chooser! !

!EntryCompletion class methodsFor: 'examples' stamp: 'StephaneDucasse 9/30/2014 12:25'!
exampleTextEntryWithCompletionDialog
	"self exampleTextEntryWithCompletionDialog"

	<exampleWidget>
	| applicants entryCompletion |
	applicants := (Array
		streamContents: [ :strm | 
			Symbol
				allSymbolTablesDo: [ :each | 
					(each notEmpty and: [ each first canBeGlobalVarInitial and: [ Smalltalk globals includesKey: each ] ])
						ifTrue: [ strm nextPut: each ] ] ]) sort.
	entryCompletion := EntryCompletion new
		dataSourceBlock: [ :currText | applicants ];
		filterBlock: [ :currApplicant :currText | currText size > 3 and: [ currApplicant asUppercase includesSubstring: currText asString asUppercase ] ].
	^ UIManager default
		request: 'Enter a class name fragment (at least 4 characters)'
		initialAnswer: ''
		title: 'Text entry with completion example: simple find a class'
		entryCompletion: entryCompletion! !

!EnvironmentChooser commentStamp: '<historical>'!
I am widget for selecting environments.!
!EnvironmentChooser methodsFor: 'updating' stamp: 'CamilloBruni 9/26/2013 19:59'!
update
	self environmentsView
		emptyList.
		
	self enableGlobal ifTrue: [ 
		self environmentsView addItemLabeled: 'System-wide' do: [ 
			self environment: RBBrowserEnvironment new ]].
	
	self environments do: [ :environemnt| |capturedValue|
		capturedValue := environemnt.
		self environmentsView
			addItemLabeled: capturedValue label
			do: [ self environment: capturedValue ]].
	
	self enableCustom ifTrue: [ 
		self environmentsView addItemLabeled: 'Custom...' do: [
			self chooseNewEnvironment ifNotNil: [ :newEnvironment | 
				self environment: newEnvironment ]]].! !

!EnvironmentChooser methodsFor: 'actions' stamp: 'CamilloBruni 10/1/2013 12:16'!
chooseNewEnvironment
	| packagesAndClasses packages classes packageEnvironment classEnvironment |
	
	packagesAndClasses := PackageAndClassChooser new chooseModalTo: self window.
	(packagesAndClasses isNil or: [ packagesAndClasses isEmpty])
		ifTrue: [ ^ nil ].
	
	self flag: 'TODO create proper environments in a less ugly way'.
	packages := OrderedCollection new.
	classes := OrderedCollection new.
	
	packagesAndClasses do: [ :each |
		(each isKindOf: RPackage)
			ifTrue: [ packages add: each ]
			ifFalse: [ classes add: each ]].
		
	packageEnvironment := RBPackageEnvironment packages: packages.
	classEnvironment := RBClassEnvironment classes: classes.
	
	classes ifEmpty: [ ^ packageEnvironment ].
	packages ifEmpty: [ ^ classEnvironment ].
	^ packageEnvironment | classEnvironment! !

!EnvironmentChooser methodsFor: 'accessing' stamp: 'PeterUhnak 4/12/2015 18:30'!
labelView
	^ labelView ifNil: [ 
		labelView := self instantiate: LabelModel.
		labelView label: 'Environment:' ]! !

!EnvironmentChooser methodsFor: 'accessing' stamp: 'CamilloBruni 11/17/2013 15:33'!
enableCustom: aBoolean
	^ enableCustom value: aBoolean! !

!EnvironmentChooser methodsFor: 'initialization' stamp: 'CamilloBruni 9/26/2013 01:07'!
initializeWidgets
	environmentsHolder whenChangedDo: [ self update ].
	enableCustom whenChangedDo: [ self update ].
	enableGlobal whenChangedDo: [ self update ].
	self update.! !

!EnvironmentChooser methodsFor: 'accessing' stamp: 'CamilloBruni 11/17/2013 15:33'!
environment
	^ environmentHolder value! !

!EnvironmentChooser methodsFor: 'accessing' stamp: 'CamilloBruni 11/17/2013 15:34'!
environments: aCollection
	environmentsHolder value: aCollection! !

!EnvironmentChooser methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 1/24/2014 16:07'!
initialize
	enableCustom := true asValueHolder.
	enableGlobal := true asValueHolder.
	environmentsHolder := #() asValueHolder.
	environmentHolder := nil asValueHolder.
	super initialize.! !

!EnvironmentChooser methodsFor: 'events' stamp: 'CamilloBruni 9/26/2013 01:10'!
whenEnvironmentChanged: aBlock
	environmentHolder whenChangedDo: aBlock! !

!EnvironmentChooser methodsFor: 'accessing' stamp: 'PeterUhnak 4/12/2015 18:31'!
label
	^ self labelView label! !

!EnvironmentChooser methodsFor: 'accessing' stamp: 'CamilloBruni 11/17/2013 15:33'!
environment: anEnvironment
	self environment = anEnvironment 
		ifFalse: [ environmentHolder value: anEnvironment ]! !

!EnvironmentChooser methodsFor: 'accessing' stamp: 'CamilloBruni 11/17/2013 15:33'!
enableCustom
	^ enableCustom value! !

!EnvironmentChooser methodsFor: 'accessing' stamp: 'CamilloBruni 11/17/2013 15:33'!
enableGlobal
	^ enableGlobal value! !

!EnvironmentChooser methodsFor: 'accessing' stamp: 'CamilloBruni 11/17/2013 15:34'!
environments
	^ environmentsHolder value! !

!EnvironmentChooser methodsFor: 'accessing' stamp: 'CamilloBruni 9/26/2013 00:51'!
environmentsView
	^ environmentsView ifNil: [ 
		environmentsView := self instantiate: DropListModel. ]! !

!EnvironmentChooser methodsFor: 'accessing' stamp: 'CamilloBruni 11/17/2013 15:33'!
enableGlobal: aBoolean
	^ enableGlobal value: aBoolean! !

!EnvironmentChooser methodsFor: 'accessing' stamp: 'PeterUhnak 4/12/2015 18:31'!
label: aString
	self labelView label: aString! !

!EnvironmentChooser class methodsFor: 'specs' stamp: 'CamilloBruni 9/26/2013 00:50'!
defaultSpec
	<spec>
	
	^ SpecLayout composed
		newRow: [ :r| 
			r 
				add: #labelView width: 45; 
				add: #environmentsView ]! !

!EqualityTester commentStamp: 'mjr 8/20/2003 13:04'!
I provide a simple way to test the equality properties of any object.!
!EqualityTester methodsFor: 'operation' stamp: 'mjr 8/20/2003 18:56'!
resultFor: runs 
	"Test that equality is the same over runs and answer the result"
	1
		to: runs
		do: [:i | self prototype = self prototype
				ifFalse: [^ false]]. 
	^ true! !

!Error commentStamp: '<historical>'!
>From the ANSI standard:
This protocol describes the behavior of instances of class Error. These are used to represent error conditions that prevent the normal continuation of processing. Actual error exceptions used by an application may be subclasses of this class.
As Error is explicitly specified  to be subclassable, conforming implementations must implement its behavior in a non-fragile manner.

Additional notes:
Error>defaultAction uses an explicit test for the presence of the Debugger class to decide whether or not it is in development mode.  In the future, TFEI hopes to enhance the semantics of #defaultAction to improve support for pluggable default handlers.!
!Error methodsFor: 'private' stamp: 'ajh 2/1/2003 00:54'!
isResumable
	"Determine whether an exception is resumable."

	^ false! !

!Error methodsFor: '*SUnit-Core' stamp: 'NiallRoss 7/18/2010 11:59'!
sunitAnnounce: aTestCase toResult: aTestResult
	aTestResult addError: aTestCase.
	self sunitExitWith: false.! !

!Error methodsFor: 'exceptiondescription' stamp: 'ajh 9/4/2002 19:24'!
defaultAction
	"No one has handled this error, but now give them a chance to decide how to debug it.  If none handle this either then open debugger (see UnhandedError-defaultAction)"

	UnhandledError signalForException: self! !

!ErrorDialogWindow commentStamp: 'gvc 5/18/2007 14:51'!
A message dialog with an error icon.!
!ErrorDialogWindow methodsFor: 'as yet unclassified' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
icon
	"Answer an icon for the receiver."
	
	^ Smalltalk ui icons errorIcon! !

!ErrorDialogWindow class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
taskbarIcon
	"Answer the icon for the receiver in a task bar."

	^ Smalltalk ui icons smallErrorIcon! !

!ErrorNonInteractive commentStamp: 'IgorStasenko 1/25/2011 13:29'!
This error thrown when image runs in non-interactive mode (no user intervention possible nor expected),
but application trying to use tools which require user's intervention.
For example, in headless image application trying to query a user name, or dialog to confirm with proceeding some action.!
!ErrorNonInteractive methodsFor: 'accessing' stamp: 'IgorStasenko 1/24/2011 10:36'!
exception: anError

	exception := anError! !

!ErrorNonInteractive methodsFor: 'accessing' stamp: 'MarcusDenker 12/2/2013 14:06'!
description
	^ String streamContents: [ :s |
		s nextPutAll: 'An attempt to use interactive tools detected, while in non-interactive mode'. 
		self messageText  ifNotEmpty: [ :message| 
			s cr; tab; nextPutAll: message ].
		self exception ifNotNil: [ :ex |
			s cr; tab; print: ex ]].! !

!ErrorNonInteractive methodsFor: 'accessing' stamp: 'IgorStasenko 1/24/2011 10:36'!
exception

	^ exception! !

!ErrorNonInteractive methodsFor: 'exceptiondescription' stamp: 'CamilloBruni 7/24/2012 16:22'!
defaultAction
	" log error and quit "
	
	^ UIManager default 
		quitFrom: self signalerContext 
		withMessage: self description! !

!ErrorNonInteractive class methodsFor: 'signalling' stamp: 'IgorStasenko 1/24/2011 10:34'!
signalForException: anError

	^ self new
		exception: anError;
		signal! !

!ErrorState commentStamp: '<historical>'!
I am the state when there was an error during the loading!
!ErrorState methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/26/2013 23:23'!
image

	^ Smalltalk ui icons smallCancelIcon asMorph! !

!EvaluateCommandLineHandler commentStamp: '<historical>'!
Usage: eval [--help] [--save] [ --no-quit ] <smalltalk expression>
	--help                   list this help message
	--save                   save the image after evaluation of the expression
	--no-quit                if specified, the image continues runing after
	                         evaluating the <smalltalk expression>
	<smallltalk expression>  a valid Smalltalk expression which is evaluated and 
	                         the result is printed on stdout

Documentation:
A CommandLineHandler that reads a string from the command line, outputs the evaluated result and quits the image. 

This handler either evaluates the arguments passed to the image:
	pharo Pharo.image eval  1 + 2
	
or it can read directly from stdin:

	echo "1+2" | $PHARO_VM my.image eval

Important: don't manually save the image at the end of the expression by calling something like 'Smalltalk snapshot: true andSave: true'!! Instead, use the safer --save option.!
!EvaluateCommandLineHandler methodsFor: 'activation' stamp: 'CamilloBruni 5/26/2013 16:14'!
evaluateArguments
	| argumentString |
	argumentString :=  self argumentString.
	argumentString ifEmpty: [ ^ self ].
	self evaluate: argumentString! !

!EvaluateCommandLineHandler methodsFor: 'activation' stamp: 'MarcusDenker 12/2/2013 14:06'!
evaluateStdIn
	| stdin |
	stdin := FileStream stdin ifNil: [ ^ self ].
	stdin atEnd  ifTrue: [ ^ self ].
	
	self flag: #todo. "the whole compilation machinery does not work with stdin directly, hence we load everything a buffer first"
	self evaluate: (String streamContents: [ :s|
		[ stdin atEnd ] whileFalse: [ 
			stdin next ifNotNil: [ :char|
			s nextPut: char ]]])! !

!EvaluateCommandLineHandler methodsFor: 'activation' stamp: 'CamilloBruni 6/1/2013 11:18'!
argumentString
	| arguments skipArguments |
	
	"Now this is ugly... Coral would be nice here!! Basically we strip skipArguments if, and only if they appear at the beginning of arguments"
	skipArguments := #( '--no-quit' '--save' '-e').

	arguments := (skipArguments includes: self arguments first)
		ifFalse: [ self arguments ]
		ifTrue: [
			(self arguments size >= 2 and: [ skipArguments includes: self arguments second ])
				ifTrue: [ self arguments allButFirst: 2 ]
				ifFalse: [ self arguments allButFirst ]].
		
	^ arguments joinUsing: Character space.! !

!EvaluateCommandLineHandler methodsFor: 'commands' stamp: 'MarcusDenker 5/21/2013 16:31'!
evaluate: aStream
	| result exceptionClassToUse |
	
	"workaround to make old Compiler unloadable"
	exceptionClassToUse := (Smalltalk compilerClass == OpalCompiler) 
		ifTrue: [OCSemanticWarning]
		ifFalse: [Smalltalk globals at: #ParserNotification].
	
	[ 
		result := Smalltalk evaluate: aStream.
		self hasSessionChanged
			ifFalse: [ self stdout print: result; lf ]
	] on: Error, ParserNotification do: [ :error |
		self handleError: error ].! !

!EvaluateCommandLineHandler methodsFor: 'activation' stamp: 'CamilloBruni 5/29/2013 15:51'!
activate
	self activateHelp
		ifTrue: [  ^ self ].
		
	self arguments 
		ifEmpty: [ ^ self evaluateStdIn ].
		
	self evaluateArguments.
	
	(self hasOption: 'save')
		ifTrue: [ 
			^ Smalltalk 
				snapshot: true 
				andQuit: (self hasOption: 'no-quit') not ].
	
	(self hasOption: 'no-quit')
		ifFalse: [ self quit ]! !

!EvaluateCommandLineHandler class methodsFor: 'handler selection' stamp: 'CamilloBruni 7/4/2012 00:20'!
isResponsibleFor: commandLineArguments
	"directly handle top-level -e and --evaluate options"
	commandLineArguments withFirstArgument: [ :arg| 
		(#('-e' '--evaluate') includes: arg)
			ifTrue: [ ^ true ]].
	
	^ commandLineArguments includesSubCommand: self commandName! !

!EvaluateCommandLineHandler class methodsFor: 'accessing' stamp: 'CamilloBruni 4/28/2012 22:48'!
commandName
	^ 'eval'! !

!EvaluateCommandLineHandler class methodsFor: 'accessing' stamp: 'CamilloBruni 2/6/2013 18:16'!
description
	^ 'Directly evaluates passed in one line scripts'! !

!EventManager commentStamp: 'tlk 5/7/2006 20:01'!
An EventManager is used to registers a 'observer' object's interest in in changes to an 'observed' object.  Then when the observered object is changed,  EventManager broadcasts the an update message to all objects with a registered interest.  Finally, the Event manager can be used to remove an object from the list of observer object.

An interested object is said to be a dependant on the target object.  Registering an interest in an event is called adding a dependant. Deregistering is called removing  a dependant.  The EventManager's action map is a WeakIdentityDictionary that maps events (selectors) to dependants (objects & selectors) in a way that ensures the mapping is to specific objects (hence identity) and in a way that allows the object to be garbage collected if not other used (hence weak.)  EventManager class has ActionMaps which has one actionMap for each object.

Classic uses of an EventManager are to implement the Observer Pattern, see ChangeNotification or the MorphicModle as examples.!
!EventManager methodsFor: 'accessing' stamp: 'MarcusDenker 7/25/2014 15:43'!
updateableActionMap
	actionMap 
		ifNil: [ actionMap := self createActionMap ].
	^actionMap 
	! !

!EventManager methodsFor: 'dependents access' stamp: 'reThink 3/3/2001 10:07'!
removeDependent: anObject
	"Remove the given object as one of the receiver's dependents."

	self 
		removeActionsWithReceiver: anObject
		forEvent: self changedEventSelector.
	^ anObject! !

!EventManager methodsFor: 'accessing' stamp: 'reThink 3/3/2001 10:07'!
changedEventSelector

	^#changed:! !

!EventManager methodsFor: 'copying' stamp: 'StephaneDucasse 10/2/2010 17:00'!
postCopy

	super postCopy.
	self release! !

!EventManager methodsFor: 'updating' stamp: 'reThink 3/3/2001 10:20'!
changed: aParameter 
	"Receiver changed. The change is denoted by the argument aParameter. 
	Usually the argument is a Symbol that is part of the dependent's change 
	protocol. Inform all of the dependents."

	self 
		triggerEvent: self changedEventSelector
		with: aParameter! !

!EventManager methodsFor: 'accessing' stamp: 'reThink 3/3/2001 10:07'!
updateEventSelector

	^#update:! !

!EventManager methodsFor: 'accessing' stamp: 'reThink 2/18/2001 15:39'!
releaseActionMap

    actionMap := nil! !

!EventManager methodsFor: 'dependents access' stamp: 'reThink 3/3/2001 10:07'!
addDependent: anObject
	"Make the given object one of the receiver's dependents."

	self
		when: self changedEventSelector
		send: self updateEventSelector
		to: anObject.
	^anObject! !

!EventManager methodsFor: 'dependents access' stamp: 'reThink 3/3/2001 10:18'!
dependents

	^(self actionSequenceForEvent: self changedEventSelector) asSet
		collect:
			[:each | each receiver]! !

!EventManager methodsFor: 'dependents access' stamp: 'reThink 3/3/2001 10:07'!
breakDependents
	"Remove all of the receiver's dependents."

	self removeActionsForEvent: self changedEventSelector! !

!EventManager methodsFor: 'accessing' stamp: 'MarcusDenker 7/25/2014 15:41'!
actionMap
	^ actionMap
		ifNil:  [ self createActionMap ]
		ifNotNil: [ actionMap ]! !

!EventManager class methodsFor: 'accessing' stamp: 'nice 4/19/2011 00:02'!
actionMaps

	^ActionMaps ifNil: [ActionMaps := WeakIdentityKeyDictionary new]! !

!EventManager class methodsFor: 'accessing' stamp: 'reThink 2/18/2001 14:42'!
actionMapFor: anObject

    ^self actionMaps
        at: anObject
        ifAbsent: [self createActionMap]! !

!EventManager class methodsFor: 'initialization' stamp: 'MarcusDenker 10/2/2013 20:16'!
flushEvents
	"Object flushEvents"
	
	self actionMaps keysAndValuesDo:[:rcvr :evtDict| rcvr ifNotNil:[
		"make sure we don't modify evtDict while enumerating"
		evtDict keysDo: [:evtName| | msgSet |
			msgSet := evtDict at: evtName ifAbsent:[nil].
			(msgSet == nil) ifTrue:[rcvr removeActionsForEvent: evtName]]]].
	EventManager actionMaps finalizeValues. ! !

!EventManager class methodsFor: 'accessing' stamp: 'reThink 2/25/2001 08:52'!
updateableActionMapFor: anObject

    ^self actionMaps
        at: anObject
        ifAbsentPut: [self createActionMap]! !

!EventManager class methodsFor: 'releasing' stamp: 'reThink 2/18/2001 15:34'!
releaseActionMapFor: anObject

	self actionMaps
		removeKey: anObject
		ifAbsent: []! !

!EventManager class methodsFor: 'cleanup' stamp: 'StephaneDucasse 3/9/2010 22:22'!
cleanUp: aggressive
	"Dump all ActionMaps but only when we're aggressively cleaning"

	aggressive ifTrue: [ActionMaps := nil].! !

!EventManagerTest methodsFor: 'private' stamp: 'JWS 9/7/2000 17:19'!
getFalse

	^false! !

!EventManagerTest methodsFor: 'running-dependent action' stamp: 'ar 8/26/2009 21:37'!
testBlockReceiverOneArg
	eventSource when: #anEvent: evaluate:[:arg1| eventListener add: arg1].
	eventSource triggerEvent: #anEvent: with: 9.
	self should: [eventListener includes: 9]! !

!EventManagerTest methodsFor: 'running-remove actions' stamp: 'SqR 2/19/2001 14:01'!
testRemoveActionsTwiceForEvent

	eventSource
		when: #anEvent send: #size to: eventListener;
		when: #anEvent send: #getTrue to: self;
		when: #anEvent: send: #fizzbin to: self.
	eventSource removeActionsForEvent: #anEvent.
	self assert: (eventSource hasActionForEvent: #anEvent) not.
	eventSource removeActionsForEvent: #anEvent.
	self assert: (eventSource hasActionForEvent: #anEvent) not.! !

!EventManagerTest methodsFor: 'running-dependent action' stamp: 'ar 8/26/2009 21:37'!
testBlockReceiverNoArgs
	eventSource when: #anEvent evaluate:[self heardEvent].
	eventSource triggerEvent: #anEvent.
	self should: [succeeded]! !

!EventManagerTest methodsFor: 'private' stamp: 'jws 9/7/2000 16:37'!
addArg1: arg1
addArg2: arg2

	eventListener
		add: arg1;
		add: arg2! !

!EventManagerTest methodsFor: 'private' stamp: 'JWS 9/7/2000 17:20'!
heardEvent

	succeeded := true! !

!EventManagerTest methodsFor: 'running-dependent action' stamp: 'jws 9/7/2000 16:39'!
testNoArgumentEvent

	eventSource when: #anEvent send: #heardEvent to: self.
	eventSource triggerEvent: #anEvent.
	self should: [succeeded]! !

!EventManagerTest methodsFor: 'private' stamp: 'JWS 9/7/2000 17:19'!
getTrue

	^true! !

!EventManagerTest methodsFor: 'running-broadcast query' stamp: 'jws 11/28/2000 15:52'!
testSingleValueSupplier

	eventSource
		when: #needsValue
		send: #getTrue
		to: self.
	succeeded := eventSource triggerEvent: #needsValue.
	self should: [succeeded]! !

!EventManagerTest methodsFor: 'running-dependent action' stamp: 'JWS 9/7/2000 17:20'!
testTwoArgumentEvent

	eventSource when: #anEvent:info: send: #addArg1:addArg2: to: self.
	eventSource triggerEvent: #anEvent:info: withArguments: #( 9 42 ).
	self should: [(eventListener includes: 9) and: [eventListener includes: 42]]! !

!EventManagerTest methodsFor: 'running-dependent action' stamp: 'ar 8/26/2009 21:38'!
testBlockReceiverTwoArgs
	eventSource when: #anEvent:info: evaluate:[:arg1 :arg2| self addArg1: arg1 addArg2: arg2].
	eventSource triggerEvent: #anEvent:info: withArguments: #( 9 42 ).
	self should: [(eventListener includes: 9) and: [eventListener includes: 42]]! !

!EventManagerTest methodsFor: 'running-dependent value' stamp: 'JWS 9/7/2000 17:21'!
testReturnValueWithOneListener

	| value |
	eventSource
		when: #needsValue
		send: #yourself
		to: eventListener.
	value := eventSource triggerEvent: #needsValue.
	self should: [value == eventListener]! !

!EventManagerTest methodsFor: 'running-dependent value' stamp: 'JWS 9/7/2000 17:21'!
testReturnValueWithNoListeners

	| value |
	value := eventSource triggerEvent: #needsValue.
	self should: [value == nil]! !

!EventManagerTest methodsFor: 'running-broadcast query' stamp: 'JWS 9/7/2000 17:21'!
testMultipleValueSuppliers

	eventSource
		when: #needsValue
		send: #getFalse
		to: self.
	eventSource
		when: #needsValue
		send: #getTrue
		to: self.
	succeeded := eventSource triggerEvent: #needsValue.
	self should: [succeeded]! !

!EventManagerTest methodsFor: 'running' stamp: 'jws 11/28/2000 16:25'!
tearDown

	eventSource releaseActionMap.
	eventSource := nil.
	eventListener := nil.
	super tearDown.
! !

!EventManagerTest methodsFor: 'running-dependent action supplied arguments' stamp: 'JWS 9/7/2000 17:20'!
testNoArgumentEventDependentSuppliedArgument

	eventSource when: #anEvent send: #add: to: eventListener with: 'boundValue'.
	eventSource triggerEvent: #anEvent.
	self should: [eventListener includes: 'boundValue']! !

!EventManagerTest methodsFor: 'private' stamp: 'JWS 9/7/2000 17:19'!
getTrue: anArg

	^true! !

!EventManagerTest methodsFor: 'running' stamp: 'JWS 9/7/2000 17:19'!
setUp

	super setUp.
	eventSource := EventManager new.
	eventListener := Bag new.
	succeeded := false! !

!EventManagerTest methodsFor: 'running-dependent action supplied arguments' stamp: 'JWS 9/7/2000 17:21'!
testNoArgumentEventDependentSuppliedArguments

	eventSource 
		when: #anEvent 
		send: #addArg1:addArg2: 
		to: self 
		withArguments: #('hello' 'world').
	eventSource triggerEvent: #anEvent.
	self should: [(eventListener includes: 'hello') and: [eventListener includes: 'world']]! !

!EventManagerTest methodsFor: 'running-dependent value' stamp: 'JWS 9/7/2000 17:21'!
testReturnValueWithManyListeners

	| value newListener |
	newListener := 'busybody'.
	eventSource
		when: #needsValue
		send: #yourself
		to: eventListener.
	eventSource
		when: #needsValue
		send: #yourself
		to: newListener.
	value := eventSource triggerEvent: #needsValue.
	self should: [value == newListener]! !

!EventManagerTest methodsFor: 'running-remove actions' stamp: 'gk 8/14/2007 23:51'!
testRemoveActionsWithReceiver

	| action |
	eventSource
		when: #anEvent send: #size to: eventListener;
		when: #anEvent send: #getTrue to: self;
		when: #anEvent: send: #fizzbin to: self.
	self assert: (eventSource hasActionsWithReceiver: self).
	eventSource removeActionsWithReceiver: self.
	action := eventSource actionForEvent: #anEvent.
	self assert: (action respondsTo: #receiver).
	self assert: ((action receiver == self) not).
	self assert: ((eventSource hasActionsWithReceiver: self) not)! !

!EventManagerTest methodsFor: 'running-copying' stamp: 'SqR 11/12/2000 19:38'!
testCopy
	"Ensure that the actionMap is zapped when
	you make a copy of anEventManager"

	eventSource when: #blah send: #yourself to: eventListener.
	self assert: eventSource actionMap keys isEmpty not.
	self assert: eventSource copy actionMap keys isEmpty! !

!EventManagerTest methodsFor: 'running-remove actions' stamp: 'SqR 2/19/2001 14:01'!
testRemoveActionsForEvent

	eventSource
		when: #anEvent send: #size to: eventListener;
		when: #anEvent send: #getTrue to: self;
		when: #anEvent: send: #fizzbin to: self.
	eventSource removeActionsForEvent: #anEvent.
	self shouldnt: [eventSource hasActionForEvent: #anEvent]! !

!EventManagerTest methodsFor: 'private' stamp: 'JWS 9/7/2000 17:19'!
getFalse: anArg

	^false! !

!EventManagerTest methodsFor: 'running-dependent action' stamp: 'JWS 9/7/2000 17:20'!
testOneArgumentEvent

	eventSource when: #anEvent: send: #add: to: eventListener.
	eventSource triggerEvent: #anEvent: with: 9.
	self should: [eventListener includes: 9]! !

!EventManagerTest methodsFor: 'running-broadcast query' stamp: 'JWS 9/7/2000 17:21'!
testMultipleValueSuppliersEventHasArguments

	eventSource
		when: #needsValue:
		send: #getFalse:
		to: self.
	eventSource
		when: #needsValue:
		send: #getTrue:
		to: self.
	succeeded := eventSource triggerEvent: #needsValue: with: 'kolme'.
	self should: [succeeded]! !

!EventSensorConstants commentStamp: 'LaurentLaffont 3/15/2011 20:48'!
This is a constants, used by EventSensor to identify various event types and theirs contents.

NOTE: A constant values should be kept in sync with VM-side, which are defined in sq.h header file.!
!EventSensorConstants class methodsFor: 'pool initialization' stamp: 'John M McIntosh 10/31/2008 14:34'!
initialize
	"EventSensorConstants initialize"
	RedButtonBit := 4.
	BlueButtonBit := 2.
	YellowButtonBit := 1.

	ShiftKeyBit := 1.
	CtrlKeyBit := 2.
	OptionKeyBit := 4.
	CommandKeyBit := 8.

	"Types of events"
	EventTypeNone := 0.
	EventTypeMouse := 1.
	EventTypeKeyboard := 2.
	EventTypeDragDropFiles := 3.
	EventTypeMenu := 4.
	EventTypeWindow := 5.

	"Press codes for keyboard events"
	EventKeyChar := 0.
	EventKeyDown := 1.
	EventKeyUp := 2.
	
	"Window event action codes"
	WindowEventMetricChange := 1. " size or position of window changed - value1-4 are left/top/right/bottom values "
	WindowEventClose := 2. " window close icon pressed "
	WindowEventIconise := 3. " window iconised  or hidden etc "
	WindowEventActivated :=4. " window made active - some platforms only - do not rely upon this "
	WindowEventPaint := 5. " window area (in value1-4) needs updating. Some platforms do not need to send this, do not rely on it in image "	
! !

!ExactFloatPrintPolicy commentStamp: '<historical>'!
I am ExactFloatPrintPolicy.

Through FloatPrintPolicy and double dispatch I force Float>>#printOn:base: to dynamically use the slower but accurate way to print Floats using Float>>#absPrintExactlyOn:base:!
!ExactFloatPrintPolicy methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 2/8/2013 11:57'!
absPrint: float on: stream base: base
	"Doube dispatch to the slower but accurate way to print"

	^ float absPrintExactlyOn: stream base: base ! !

!ExampleBuilderMorph commentStamp: 'gvc 7/19/2007 16:49'!
Morph with an inset border by default and theme access. Overrides openModal: to allow multiple free example dialogs to be presented.!
!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
questionWithoutCancel: aStringOrText
	"Open a question dialog."

	^self questionWithoutCancel: aStringOrText title: 'Question' translated! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newWindowFor: aModel title: titleString
	"Answer a new window morph."
	
	^self theme
		newWindowIn: self
		for: aModel
		title: titleString! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newColorChooserFor: aModel getColor: getSel setColor: setSel help: helpText
	"Answer a color chooser with the given selectors."

	^self theme
		newColorChooserIn: self
		for: aModel
		getColor: getSel
		setColor: setSel
		getEnabled: nil
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newGroupbox
	"Answer a plain groupbox."

	^self theme
		newGroupboxIn: self! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newColorChooserFor: aModel getColor: getSel setColor: setSel getEnabled: enabledSel help: helpText
	"Answer a color chooser with the given selectors."

	^self theme
		newColorChooserIn: self
		for: aModel
		getColor: getSel
		setColor: setSel
		getEnabled: enabledSel
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newIncrementalSliderFor: aModel getValue: getSel setValue: setSel min: min max: max quantum: quantum getEnabled: enabledSel help: helpText
	"Answer an inremental slider with the given selectors."

	^self theme
		newIncrementalSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: min
		max: max
		quantum: quantum
		getEnabled: enabledSel
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
deny: aStringOrText
	"Open a denial dialog."

	^self deny: aStringOrText title: 'Access Denied' translated! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newLabelGroup: labelsAndControls font: aFont labelColor: aColor
	"Answer a morph laid out with a column of labels and a column of associated controls.
	Controls having a vResizing value of #spaceFill will
	cause their row to use #spaceFill also, otherwise #shrinkWrap."

	^self theme
		newLabelGroupIn: self
		for: labelsAndControls
		font: aFont
		labelColor: aColor
! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newCloseButton
	"Answer a new close button."

	^self newCloseButtonFor: self ! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newGroupbox: aString
	"Answer a groupbox with the given label."

	^self theme
		newGroupboxIn: self
		label: aString! !

!ExampleBuilderMorph methodsFor: 'theme' stamp: ''!
theme
	"Answer the ui theme that provides controls."

	^ Smalltalk ui theme! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newSliderFor: aModel getValue: getSel setValue: setSel getEnabled: enabledSel help: helpText
	"Answer a slider with the given selectors."

	^self theme
		newSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: 0
		max: 1
		quantum: nil
		getEnabled: enabledSel
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
fileOpen: title extensions: exts path: path
	"Answer the result of a file open dialog with the given title, extensions to show and path."

	^self 
		fileOpen: title
		extensions: exts
		path: path
		preview: nil! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newButtonFor: aModel getState: stateSel action: actionSel arguments: args getEnabled: enabledSel labelForm: aForm help: helpText
	"Answer a new button."

	^self theme
		newButtonIn: self for: aModel
		getState: stateSel
		action: actionSel
		arguments: args
		getEnabled: enabledSel 
		label: (AlphaImageMorph new image: aForm)
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newPanel
	"Answer a new panel."

	^self theme
		newPanelIn: self! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newPluggableDialogWindow: title
	"Answer a new pluggable dialog with the given content."

	^self
		newPluggableDialogWindow: title
		for: nil! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newSVSelector: aColor help: helpText
	"Answer a saturation-volume selector with the given color."

	^self theme
		newSVSelectorIn: self
		color: aColor
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newListFor: aModel list: listSelector selected: getSelector changeSelected: setSelector help: helpText
	"Answer a list for the given model."

	^self
		newListFor: aModel
		list: listSelector
		selected: getSelector
		changeSelected: setSelector
		getEnabled: nil
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newMenu
	"Answer a new menu."

	^self theme
		newMenuIn: self
		for: self! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
centeredAlert: aStringOrText title: aString configure: aBlock
	"Open an alert dialog.
	Configure the dialog with the 1 argument block
	before opening modally."

	^self theme
		centeredAlertIn: self
		text: aStringOrText
		title: aString
		configure: aBlock! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newMenuFor: aModel
	"Answer a new menu."

	^self theme
		newMenuIn: self
		for: aModel! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newBasicTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel menu: menuSelector
	"Answer a text editor for the given model."

	^self theme
		newBasicTextEditorIn: self
		for: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel
		menu: menuSelector! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newMorphDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel getEnabled: enabledSel useIndex: useIndex help: helpText
	"Answer a morph drop list for the given model."

	^self theme
		newMorphDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		useIndex: useIndex
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newRadioButtonFor: aModel getSelected: getSel setSelected: setSel getEnabled: enabledSel label: stringOrText help: helpText
	"Answer a checkbox (radio button appearance) with the given label."

	^self theme
		newRadioButtonIn: self
		for: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		label: stringOrText
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newStack: controls
	"Answer a morph laid out with a stack of controls."

	^self theme
		newStackIn: self
		for: controls! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newAlphaImage: aForm help: helpText
	"Answer an alpha image morph."

	^self theme
		newAlphaImageIn: self
		image: aForm
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
chooseFont
	"Answer the result of a font selector dialog."

	^self chooseFont: nil! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newButtonFor: aModel action: actionSel getEnabled: enabledSel label: stringOrText help: helpText
	"Answer a new button."

	^self
		newButtonFor: aModel
		getState: nil
		action: actionSel
		arguments: nil
		getEnabled: enabledSel 
		label: stringOrText
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newBalloonHelp: aTextStringOrMorph for: aMorph corner: cornerSymbol
	"Answer a new balloon help with the given contents for aMorph
	at a given corner."

	^self theme
		newBalloonHelpIn: self
		contents: aTextStringOrMorph
		for: aMorph
		corner: cornerSymbol! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newAlphaSelector: aModel getAlpha: getSel setAlpha: setSel help: helpText
	"Answer an alpha channel selector with the given selectors."

	^self theme
		newAlphaSelectorIn: self
		for: aModel
		getAlpha: getSel
		setAlpha: setSel
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
message: aStringOrText
	"Open a message dialog."

	^self message: aStringOrText title: 'Information' translated! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel menu: menuSelector
	"Answer a text editor for the given model."

	^self theme
		newTextEditorIn: self
		for: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel
		menu: menuSelector! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newBasicTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel
	"Answer a text editor for the given model."

	^self
		newBasicTextEditorFor: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel
		menu: nil! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
chooseDirectory: title path: path
	"Answer the result of a file dialog with the given title, answer a directory."

	^self theme
		chooseDirectoryIn: self
		title: title
		path: path! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
longMessage: aStringOrText title: aString
	"Open a (long) message dialog."

	^self theme
		longMessageIn: self
		text: aStringOrText
		title: aString! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newCheckboxFor: aModel getSelected: getSel setSelected: setSel getEnabled: enabledSel label: stringOrText help: helpText
	"Answer a checkbox with the given label."

	^self theme
		newCheckboxIn: self
		for: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		label: stringOrText
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel font: aFont help: helpText
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel
		font: aFont
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newDialogPanel
	"Answer a new main dialog panel."

	^self theme
		newDialogPanelIn: self! !

!ExampleBuilderMorph methodsFor: 'services' stamp: 'FernandoOlivero 3/2/2011 09:35'!
chooseColor: aColor title: label
	"Answer the user choice of a colour."
	
	^ self theme 
		chooseColorIn: self modalMorph
		title: (label ifNil: ['Choose Color' translated])
		color: aColor! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newCheckboxFor: aModel getSelected: getSel setSelected: setSel label: stringOrText help: helpText
	"Answer a checkbox with the given label."

	^self theme
		newCheckboxIn: self
		for: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: nil
		label: stringOrText
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newCancelButtonFor: aModel
	"Answer a new cancel button."

	^self theme
		newCancelButtonIn: self
		for: aModel! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newButtonFor: aModel getState: stateSel action: actionSel arguments: args getEnabled: enabledSel label: stringOrText help: helpText
	"Answer a new button."

	^self theme
		newButtonIn: self for: aModel
		getState: stateSel
		action: actionSel
		arguments: args
		getEnabled: enabledSel 
		label: stringOrText
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newPluggableDialogWindow: title for: contentMorph
	"Answer a new pluggable dialog with the given content."

	^self theme
		newPluggableDialogWindowIn: self
		title: title
		for: contentMorph! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newOKButton
	"Answer a new OK button."

	^self newOKButtonFor: self! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newGroupbox: aString for: control
	"Answer a groupbox with the given label and control."

	^self theme
		newGroupboxIn: self
		label: aString
		for: control! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newFuzzyLabelFor: aModel label: aString getEnabled: enabledSel
	"Answer a new fuzzy label."

	^self theme
		newFuzzyLabelIn: self
		for: aModel
		label: aString
		offset: 1
		alpha: 0.5
		getEnabled: enabledSel! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel help: helpText entryCompletion: anEntryCompletion
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel
		help: helpText
		entryCompletion: anEntryCompletion! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newYesButton
	"Answer a new Yes button."

	^self newYesButtonFor: self! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel 
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newEditableDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel addToList: addSel class: aClass default: defaultValue ghostText: ghostText getEnabled: enabledSel useIndex: useIndex help: helpText
	"Answer an editable drop list for the given model."

	^self theme
		newEditableDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		addToList: addSel
		class: aClass
		default: defaultValue
		ghostText: ghostText
		getEnabled: enabledSel
		useIndex: useIndex
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
chooseColor
	"Answer the result of a color selector dialog ."

	^self chooseColor: Color black! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newMorphDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel help: helpText
	"Answer a morph drop list for the given model."

	^self 
		newMorphDropListFor: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: nil
		useIndex: true
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newListFor: aModel list: listSelector selected: getSelector changeSelected: setSelector icon: iconSelector getEnabled: enabledSel help: helpText
	"Answer a list for the given model."

	^self theme
		newListIn: self
		for: aModel
		list: listSelector
		selected: getSelector
		changeSelected: setSelector
		icon: iconSelector
		getEnabled: enabledSel
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newString: aStringOrText font: aFont style: aStyle
	"Answer a new embossed string."

	^self theme
		newStringIn: self
		label: aStringOrText
		font: aFont
		style: aStyle! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newCheckboxFor: aModel getSelected: getSel setSelected: setSel getEnabled: enabledSel getLabel: labelSel help: helpText
	"Answer a checkbox with the given label."

	^self theme
		newCheckboxIn: self
		for: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		getLabel: labelSel
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newMorphDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel getEnabled: enabledSel help: helpText
	"Answer a morph drop list for the given model."

	^self 
		newMorphDropListFor: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		useIndex: true
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel getEnabled: enabledSel useIndex: useIndex help: helpText
	"Answer a drop list for the given model."

	^self theme
		newDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		useIndex: useIndex
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel 
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newToolbar
	"Answer a toolbar."

	^self theme
		newToolbarIn: self! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel help: helpText
	"Answer a drop list for the given model."

	^self
		newDropListFor: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: nil
		useIndex: true
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
chooseFont: aFont 
	"Answer the result of a font selector dialog with the given initial font."

	^self theme
		chooseFontIn: self
		title: 'Font Selector' translated
		font: aFont! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newCloseButtonFor: aModel
	"Answer a new close button."

	^self theme
		newCloseButtonIn: self
		for: aModel! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newVerticalSeparator
	"Answer a vertical separator."

	^self theme
		newVerticalSeparatorIn: self! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
proceed: aStringOrText
	"Open a proceed dialog."

	^self proceed: aStringOrText title: 'Proceed' translated! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
fileSave: title path: path
	"Answer the result of a file save open dialog with the given title."

	^self
		fileSave: title
		extensions: nil
		path: path! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newHSVASelector: aColor help: helpText
	"Answer a hue-saturation-volume selector with the given color."

	^self theme
		newHSVASelectorIn: self
		color: aColor
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
deny: aStringOrText title: aString
	"Open a denial dialog."

	^self theme
		denyIn: self
		text: aStringOrText
		title: aString! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newScrollPaneFor: aMorph
	"Answer a new scroll pane morph to scroll the given morph."
	
	^self theme
		newScrollPaneIn: self
		for: aMorph! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
chooseColor: aColor 
	"Answer the result of a color selector dialog with the given color."

	^self theme
		chooseColorIn: self
		title: 'Colour Selector' translated
		color: aColor! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newPluggableDialogWindow
	"Answer a new pluggable dialog."

	^self
		newPluggableDialogWindow: 'Dialog'! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
alert: aStringOrText title: aString configure: aBlock
	"Open an alert dialog.
	Configure the dialog with the 1 argument block
	before opening modally."

	^self theme
		alertIn: self
		text: aStringOrText
		title: aString
		configure: aBlock! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newButtonLabelFor: aModel label: aString getEnabled: enabledSel
	"Answer a new button text label."

	^self theme
		newButtonLabelIn: self
		for: aModel
		label: aString
		getEnabled: enabledSel! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newOKButtonFor: aModel
	"Answer a new OK button."

	^self
		newOKButtonFor: aModel
		getEnabled: nil! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newCancelButton
	"Answer a new cancel button."

	^self newCancelButtonFor: self! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newString: aStringOrText style: aStyle
	"Answer a new embossed string."

	^self theme
		newStringIn: self
		label: aStringOrText
		font: self theme labelFont
		style: aStyle! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newHueSelector: aModel getHue: getSel setHue: setSel help: helpText
	"Answer a hue selector with the given selectors."

	^self theme
		newHueSelectorIn: self
		for: aModel
		getHue: getSel
		setHue: setSel
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newEditableDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel addToList: addSel ghostText: ghostText getEnabled: enabledSel help: helpText
	"Answer an editable drop list for the given model."

	^self theme
		newEditableDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		addToList: addSel
		class: String
		default: ''
		ghostText: ghostText
		getEnabled: enabledSel
		useIndex: false
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newGroupboxFor: control
	"Answer a plain groupbox with the given control."

	^self theme
		newGroupboxIn: self
		for: control! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newOverflowRowForAll: aCollectionOfMorphs
	"Answer a new overflow row morph that provides a drop down for
	the given contents that are unable to fit the bounds."
	
	^self theme
		newOverflowRowIn: self
		forAll: aCollectionOfMorphs! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newEmbeddedMenu
	"Answer a new menu."

	^self theme
		newEmbeddedMenuIn: self
		for: self! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newSliderFor: aModel getValue: getSel setValue: setSel help: helpText
	"Answer a slider with the given selectors."

	^self theme
		newSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: 0
		max: 1
		quantum: nil
		getEnabled: nil
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newButtonFor: aModel getState: stateSel action: actionSel arguments: args getEnabled: enabledSel getLabel: labelSel help: helpText
	"Answer a new button."

	^self theme
		newButtonIn: self for: aModel
		getState: stateSel
		action: actionSel
		arguments: args
		getEnabled: enabledSel 
		getLabel: labelSel
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
fileOpen: title
	"Answer the result of a file open dialog with the given title."

	^self
		fileOpen: title
		extensions: nil! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
message: aStringOrText title: aString
	"Open a message dialog."

	^self theme
		messageIn: self
		text: aStringOrText
		title: aString! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newTabGroup: labelsAndPages
	"Answer a tab group with the given tab labels associated with pages."

	^self theme
		newTabGroupIn: self
		for: labelsAndPages! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newMorphListFor: aModel list: listSelector getSelected: getSelector setSelected: setSelector getEnabled: enabledSel help: helpText
	"Answer a morph list for the given model."

	^self theme
		newMorphListIn: self
		for: aModel
		list: listSelector
		getSelected: getSelector
		setSelected: setSelector
		getEnabled: enabledSel
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newNoButtonFor: aModel
	"Answer a new No button."

	^self theme
		newNoButtonIn: self
		for: aModel! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel font: aFont help: helpText entryCompletion: anEntryCompletion
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel
		font: aFont
		help: helpText
		entryCompletion: anEntryCompletion
! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newBasicTextEditorFor: aModel getText: getSel setText: setSel
	"Answer a text editor for the given model."

	^self
		newBasicTextEditorFor: aModel
		getText: getSel
		setText: setSel
		getEnabled: nil! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newImage: aForm size: aPoint
	"Answer a new image."

	^self theme
		newImageIn: self
		form: aForm
		size: aPoint! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
textEntry: aStringOrText title: aString entryText: defaultEntryText
	"Open a text entry dialog."

	^self theme
		textEntryIn: self
		text: aStringOrText
		title: aString
		entryText: defaultEntryText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newImage: aForm
	"Answer a new image."

	^self theme
		newImageIn: self
		form: aForm! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
chooseDropList: aStringOrText list: aList
	"Open a drop list chooser dialog."

	^self
		chooseDropList: aStringOrText
		title: 'Choose' translated
		list: aList! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newImageFor: aModel get: getSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newImageIn: self
		for: aModel
		get: getSel
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
alert: aStringOrText title: aString
	"Open an alert dialog."

	^self
		alert: aStringOrText
		title: aString
		configure: [:d | ]! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
alert: aStringOrText
	"Open an alert dialog."

	^self alert: aStringOrText title: 'Alert' translated! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
proceed: aStringOrText title: aString
	"Open a proceed dialog and answer true if not cancelled, false otherwise."

	^self theme
		proceedIn: self
		text: aStringOrText
		title: aString! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel
	"Answer a text editor for the given model."

	^self theme
		newAutoAcceptTextEditorIn: self
		for: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newBalloonHelp: aTextStringOrMorph for: aMorph
	"Answer a new balloon help with the given contents for aMorph
	at a given corner."

	^self theme
		newBalloonHelpIn: self
		contents: aTextStringOrMorph
		for: aMorph
		corner: #bottomLeft! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newTreeFor: aModel list: listSelector selected: getSelector changeSelected: setSelector
	"Answer a new tree morph."
	
	^self theme
		newTreeIn: self
		for: aModel
		list: listSelector
		selected: getSelector
		changeSelected: setSelector! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
abort: aStringOrText
	"Open an error dialog."

	^self abort: aStringOrText title: 'Error' translated! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newColorPresenterFor: aModel getColor: getSel help: helpText
	"Answer a color presenter with the given selectors."

	^self theme
		newColorPresenterIn: self
		for: aModel
		getColor: getSel
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newBracketSliderFor: aModel getValue: getSel setValue: setSel min: minValue max: maxValue quantum: quantum getEnabled: enabledSel help: helpText
	"Answer a bracket slider with the given selectors."

	^self theme
		newBracketSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: minValue
		max: maxValue
		quantum: quantum
		getEnabled: enabledSel
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newButtonFor: aModel action: actionSel label: stringOrText help: helpText
	"Answer a new button."

	^self
		newButtonFor: aModel
		getState: nil
		action: actionSel
		arguments: nil
		getEnabled: nil 
		label: stringOrText
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newOKButtonFor: aModel getEnabled: enabledSel
	"Answer a new OK button."

	^self theme
		newOKButtonIn: self
		for: aModel
		getEnabled: enabledSel! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newMorphListFor: aModel list: listSelector getSelected: getSelector setSelected: setSelector help: helpText
	"Answer a morph list for the given model."

	^self
		newMorphListFor: aModel
		list: listSelector
		getSelected: getSelector
		setSelected: setSelector
		getEnabled: nil
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newText: aStringOrText
	"Answer a new text."

	^self theme
		newTextIn: self
		text: aStringOrText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel font: aFont help: helpText
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel
		font: aFont
		help: helpText
! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel help: helpText entryCompletion: anEntryCompletion

	"Answer a text entry for the given model."

	^self theme
		newTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel 
		help: helpText
		entryCompletion: anEntryCompletion! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel getEnabled: enabledSel help: helpText
	"Answer a drop list for the given model."

	^self theme
		newDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		useIndex: true
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
fileSave: title extensions: exts path: path
	"Answer the result of a file save dialog with the given title, extensions to show and path."

	^self theme
		fileSaveIn: self
		title: title
		extensions: exts
		path: path! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newLabelFor: aModel label: aString getEnabled: enabledSel
	"Answer a new text label."

	^self theme
		newLabelIn: self
		for: aModel
		label: aString
		getEnabled: enabledSel! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel help: helpText entryCompletion: anEntryCompletion
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel
		help: helpText
		entryCompletion: anEntryCompletion! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newNoButton
	"Answer a new No button."

	^self newNoButtonFor: self! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newLabel: aString
	"Answer a new text label."

	^self
		newLabelFor: nil
		label: aString
		getEnabled: nil! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newHSVSelector: aColor help: helpText
	"Answer a hue-saturation-volume selector with the given color."

	^self theme
		newHSVSelectorIn: self
		color: aColor
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newLabelGroup: labelsAndControls
	"Answer a morph laid out with a column of labels and a column of associated controls.
	Controls having a vResizing value of #spaceFill will
	cause their row to use #spaceFill also, otherwise #shrinkWrap."

	^self theme
		newLabelGroupIn: self
		for: labelsAndControls! !

!ExampleBuilderMorph methodsFor: 'as yet unclassified' stamp: 'gvc 3/6/2010 17:08'!
openModal: aSystemWindow
	"Open the given window an available position without modality.
	Answer the system window."
	
	|baseArea areas searching foundRect|
	aSystemWindow extent: aSystemWindow initialExtent.
	areas := World submorphs
		select: [:m | m isKindOf: DialogWindow]
		thenCollect: [:m | m bounds expandBy: 8].
	baseArea := RealEstateAgent maximumUsableArea insetBy: 8.
	searching := true.
	baseArea allAreasOutsideList: areas do: [:rect |
		searching ifTrue: [
			aSystemWindow extent <= (rect insetBy: 8) extent
				ifTrue: [foundRect := rect.
						searching := false]]].
	searching ifTrue: [foundRect := baseArea].
	aSystemWindow setWindowColor: self theme windowColor.
	aSystemWindow position: foundRect topLeft + 8.
	aSystemWindow openAsIs.
	^aSystemWindow! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newRow: controls
	"Answer a morph laid out with a row of controls."

	^self theme
		newRowIn: self
		for: controls! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newTextEditorFor: aModel getText: getSel setText: setSel
	"Answer a text editor for the given model."

	^self
		newTextEditorFor: aModel
		getText: getSel
		setText: setSel
		getEnabled: nil! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newTitle: aString for: control
	"Answer a morph laid out with a column with a title."

	^self theme
		newTitleIn: self
		label: aString
		for: control! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newExpander: aString for: aControl
	"Answer an expander with the given label and control."

	^self theme
		newExpanderIn: self
		label: aString
		forAll: {aControl}! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newMultistateButton
	"Answer a new multistate button morph.
	To be usable it needs to have fill styles assigned to various states along
	with mouse-up/down actions."
	
	^self theme
		newMultistateButtonIn: self! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newColumn: controls
	"Answer a morph laid out with a column of controls."

	^self theme
		newColumnIn: self
		for: controls! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
question: aStringOrText title: aString
	"Open a question dialog and answer true if yes,
	false if no and nil if cancelled."

	^self theme
		questionIn: self
		text: aStringOrText
		title: aString! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newGroupboxForAll: controls
	"Answer a plain groupbox with the given controls."

	^self theme
		newGroupboxIn: self
		forAll: controls! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
fileOpen: title extensions: exts path: path preview: preview
	"Answer the result of a file open dialog with the given title, extensions to show, path and preview type."

	^self theme
		fileOpenIn: self
		title: title
		extensions: exts
		path: path
		preview: preview! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newBracketSliderFor: aModel getValue: getSel setValue: setSel min: minValue max: maxValue quantum: quantum help: helpText
	"Answer a bracket slider with the given selectors."

	^self
		newBracketSliderFor: aModel
		getValue: getSel
		setValue: setSel
		min: minValue
		max: maxValue
		quantum: quantum 
		getEnabled: nil
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newToolDockingBar
	"Answer a tool docking bar."

	^self theme
		newToolDockingBarIn: self! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel font: aFont help: helpText entryCompletion: anEntryCompletion
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel
		font: aFont
		help: helpText
		entryCompletion: anEntryCompletion! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
textEntry: aStringOrText title: aString
	"Open a text entry dialog."

	^self
		textEntry: aStringOrText
		title: aString
		entryText: ''! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel 
	"Answer a text editor for the given model."

	^self 
		newTextEditorFor: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel
		menu: nil! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newTextEntryFor: aModel getText: getSel setText: setSel help: helpText
	"Answer a text entry for the given model."

	^self
		newTextEntryFor: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: nil 
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
chooseDirectory: title 
	"Answer the result of a file dialog with the given title, answer a directory."

	^self
		chooseDirectory: title
		path: nil! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newLabelFor: aModel getLabel: labelSel getEnabled: enabledSel
	"Answer a new text label."

	^self theme
		newLabelIn: self
		for: aModel
		getLabel: labelSel
		getEnabled: enabledSel! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
fileSave: title extensions: exts
	"Answer the result of a file save dialog with the given title."

	^self
		fileSave: title
		extensions: exts
		path: nil! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newSeparator
	"Answer an horizontal separator."

	^self theme
		newSeparatorIn: self! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newExpander: aString
	"Answer an expander with the given label."

	^self theme
		newExpanderIn: self
		label: aString
		forAll: #()! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
fileSave: title
	"Answer the result of a file save dialog with the given title."

	^self
		fileSave: title
		extensions: nil
		path: nil! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newCloseControlFor: aModel action: aValuable help: helpText
	"Answer a new cancel button."

	^self theme
		newCloseControlIn: self
		for: aModel
		action: aValuable
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
chooseDropList: aStringOrText title: aString list: aList
	"Open a drop list chooser dialog."

	^self theme
		chooseDropListIn: self
		text: aStringOrText
		title: aString
		list: aList! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newSliderFor: aModel getValue: getSel setValue: setSel min: min max: max quantum: quantum getEnabled: enabledSel help: helpText
	"Answer a slider with the given selectors."

	^self theme
		newSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: min
		max: max
		quantum: quantum
		getEnabled: enabledSel
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
question: aStringOrText
	"Open a question dialog."

	^self question: aStringOrText title: 'Question' translated! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
textEntry: aStringOrText
	"Open a text entry dialog."

	^self textEntry: aStringOrText title: 'Entry' translated! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newListFor: aModel list: listSelector selected: getSelector changeSelected: setSelector getEnabled: enabledSel help: helpText
	"Answer a list for the given model."

	^self theme
		newListIn: self
		for: aModel
		list: listSelector
		selected: getSelector
		changeSelected: setSelector
		getEnabled: enabledSel
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newGroupbox: aString forAll: controls
	"Answer a groupbox with the given label and controls."

	^self theme
		newGroupboxIn: self
		label: aString
		forAll: controls! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newString: aStringOrText
	"Answer a new embossed string."

	^self theme
		newStringIn: self
		label: aStringOrText
		font: self theme labelFont
		style: #plain! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newExpander: aString forAll: controls
	"Answer an expander with the given label and controls."

	^self theme
		newExpanderIn: self
		label: aString
		forAll: controls! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
questionWithoutCancel: aStringOrText title: aString
	"Open a question dialog and answer true if yes,
	false if no and nil if cancelled."

	^self theme
		questionWithoutCancelIn: self
		text: aStringOrText
		title: aString! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newButtonLabel: aString
	"Answer a new button text label."

	^self
		newButtonLabelFor: nil
		label: aString
		getEnabled: nil! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newToolbar: controls
	"Answer a toolbar with the given controls."

	^self theme
		newToolbarIn: self
		for: controls! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newToolSpacer
	"Answer a tool spacer."

	^self theme
		newToolSpacerIn: self! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newFuzzyLabel: aString
	"Answer a new fuzzy label."

	^self theme
		newFuzzyLabelIn: self
		for: nil
		label: aString
		offset: 1
		alpha: 0.5
		getEnabled: nil! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newRow
	"Answer a morph laid out as a row."

	^self theme
		newRowIn: self
		for: #()! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
fileOpen: title extensions: exts
	"Answer the result of a file open dialog with the given title and extensions to show."

	^self
		fileOpen: title
		extensions: exts
		path: nil! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newStack
	"Answer a morph laid out as a stack."

	^self theme
		newStackIn: self
		for: #()! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newFuzzyLabelFor: aModel label: aString offset: offset alpha: alpha getEnabled: enabledSel
	"Answer a new fuzzy label."

	^self theme
		newFuzzyLabelIn: self
		for: aModel
		label: aString
		offset: offset
		alpha: alpha
		getEnabled: enabledSel! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
chooseFileName: title extensions: exts path: path preview: preview
	"Answer the result of a file name chooser dialog with the given title, extensions
	to show, path and preview type."

	^self theme
		chooseFileNameIn: self
		title: title
		extensions: exts
		path: path
		preview: preview! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newRadioButtonFor: aModel getSelected: getSel setSelected: setSel label: stringOrText help: helpText
	"Answer a checkbox (radio button appearance) with the given label."

	^self
		newRadioButtonFor: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: nil
		label: stringOrText
		help: helpText! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newYesButtonFor: aModel
	"Answer a new yes button."

	^self theme
		newYesButtonIn: self
		for: aModel! !

!ExampleBuilderMorph methodsFor: 'controls' stamp: ''!
newToolbarHandle
	"Answer a toolbar handle."

	^self theme
		newToolbarHandleIn: self! !

!ExampleBuilderMorph methodsFor: 'services' stamp: ''!
abort: aStringOrText title: aString
	"Open an error dialog."

	^self theme
		abortIn: self
		text: aStringOrText
		title: aString! !

!ExampleClassVariable commentStamp: 'MarcusDenker 3/4/2015 18:00'!
I am an example for a class variable that stores the value in the variable.
(same semantics as normal variables but using reflective code path for testing)!
!ExampleClassVariable methodsFor: 'meta-object-protocol' stamp: 'MarcusDenker 3/4/2015 17:57'!
write:	 anObject
	state := anObject
	 ! !

!ExampleClassVariable methodsFor: 'meta-object-protocol' stamp: 'MarcusDenker 3/4/2015 17:57'!
read
	^state! !

!ExampleForTest1 commentStamp: 'TorstenBergmann 2/5/2014 08:35'!
An example class at level 1 (directly below Object) used for testing class hierarchy!
!ExampleForTest11 commentStamp: 'TorstenBergmann 2/5/2014 08:35'!
An example class at level 2 (indirectly below Object) used for testing class hierarchy!
!ExampleForTest111 commentStamp: 'TorstenBergmann 2/5/2014 08:35'!
An example class at level 3 (indirectly below Object) used for testing class hierarchy!
!ExampleForTest112 commentStamp: 'TorstenBergmann 2/5/2014 08:35'!
An example class at level 3 (indirectly below Object) used for testing class hierarchy!
!ExampleForTest12 commentStamp: 'TorstenBergmann 2/5/2014 08:35'!
An example class at level 2 (indirectly below Object) used for testing class hierarchy!
!ExampleRadioButtonModel commentStamp: 'gvc 9/23/2008 11:58'!
Model used for radio buttons in example of basic controls (see "UITheme exampleBasicControls").!
!ExampleRadioButtonModel methodsFor: 'as yet unclassified' stamp: 'gvc 8/7/2007 13:17'!
beLeft
	"Set the option to #left."

	self option: #left! !

!ExampleRadioButtonModel methodsFor: 'initialization' stamp: 'gvc 8/7/2007 13:17'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		option: #left! !

!ExampleRadioButtonModel methodsFor: 'as yet unclassified' stamp: 'gvc 8/7/2007 13:17'!
beCenter
	"Set the option to #center."

	self option: #center! !

!ExampleRadioButtonModel methodsFor: 'as yet unclassified' stamp: 'gvc 8/7/2007 13:16'!
isCenter
	"Answer whether the option if #center."

	^self option == #center! !

!ExampleRadioButtonModel methodsFor: 'accessing' stamp: 'gvc 8/7/2007 13:15'!
option: aSymbol
	"Set the value of option"

	option := aSymbol.
	self
		changed: #isLeft;
		changed: #isCenter;
		changed: #isRight! !

!ExampleRadioButtonModel methodsFor: 'as yet unclassified' stamp: 'gvc 8/7/2007 13:16'!
isRight
	"Answer whether the option if #right."

	^self option == #right! !

!ExampleRadioButtonModel methodsFor: 'as yet unclassified' stamp: 'gvc 8/7/2007 13:16'!
isLeft
	"Answer whether the option if #left."

	^self option == #left! !

!ExampleRadioButtonModel methodsFor: 'as yet unclassified' stamp: 'gvc 8/7/2007 13:17'!
beRight
	"Set the option to #right."

	self option: #right! !

!ExampleRadioButtonModel methodsFor: 'accessing' stamp: 'gvc 8/7/2007 13:13'!
option
	"Answer the value of option"

	^ option! !

!ExampleSetTest commentStamp: 'TorstenBergmann 2/12/2014 23:16'!
SUnit tests for example set!
!ExampleSetTest methodsFor: 'testing' stamp: 'BaseSystem 8/30/2009 09:40'!
testRemove
	full remove: 5.
	self assert: (full includes: #abc).
	self deny: (full includes: 5)! !

!ExampleSetTest methodsFor: 'testing' stamp: 'BaseSystem 8/30/2009 09:40'!
testAdd
	empty add: 5.
	self assert: (empty includes: 5)! !

!ExampleSetTest methodsFor: 'testing' stamp: 'StephaneDucasse 6/9/2012 22:58'!
testIllegal
	self 
		should: [empty at: 5] 
		raise: self defaultTestError.
	self 
		should: [empty at: 5 put: #abc] 
		raise: self defaultTestError! !

!ExampleSetTest methodsFor: 'testing' stamp: 'BaseSystem 8/30/2009 09:40'!
testGrow
	empty addAll: (1 to: 100).
	self assert: empty size = 100! !

!ExampleSetTest methodsFor: 'testing' stamp: 'BaseSystem 8/30/2009 09:40'!
testOccurrences
	self assert: (empty occurrencesOf: 0) = 0.
	self assert: (full occurrencesOf: 5) = 1.
	full add: 5.
	self assert: (full occurrencesOf: 5) = 1! !

!ExampleSetTest methodsFor: 'testing' stamp: 'BaseSystem 8/30/2009 09:40'!
testIncludes
	self assert: (full includes: 5).
	self assert: (full includes: #abc)! !

!ExampleSetTest methodsFor: 'running' stamp: 'BaseSystem 8/30/2009 09:40'!
setUp
	empty := Set new.
	full := Set with: 5 with: #abc! !

!ExampleSlotWithDefaultValue commentStamp: 'MarcusDenker 2/25/2015 17:17'!
NOTE: this is an example of what can be done with Slots. It is *not* an example of what *should* be done with Slots.

I am showing how a slot can initialize itself on object creation.

#name => ExampleSlotWithDefaultValue default: 5!
!ExampleSlotWithDefaultValue methodsFor: 'initialization' stamp: 'MarcusDenker 2/25/2015 17:08'!
initialize: anObject
	self write: default to: anObject. 
	! !

!ExampleSlotWithDefaultValue methodsFor: 'accessing' stamp: 'MarcusDenker 2/25/2015 17:08'!
default: anObject
	default := anObject! !

!ExampleSlotWithDefaultValue methodsFor: 'meta-object-protocol' stamp: 'MarcusDenker 2/7/2015 15:17'!
wantsInitalization
	^ true! !

!ExampleSlotWithDefaultValue methodsFor: 'printing' stamp: 'MarcusDenker 2/25/2015 17:12'!
printOn: aStream
	aStream 
		store: self name;
		nextPutAll: ' => ';
		nextPutAll: self class name;
		nextPutAll: ' default: ';
		store: default! !

!ExampleSlotWithState commentStamp: 'MarcusDenker 7/2/2014 14:33'!
I am a simple example for a Slot.

Instead of mapping to a field, I store the value myself. This means that all instances share the
slot, similar to a class variable.

I just overide the methods for reflective read and write (#read and #write:to:), I do not bother to emit bytecode myself but rely on the fallback that the compiler will generate code for reflective read and write (see the emit* method of my superclass).

PharoClassInstaller make: [ :builder |
	builder name: #A;
	slots: { TestSlot named: #iv };
	category: #Playground ].


In class A we can implement accessors:

iv
	^iv

iv: anObject
	iv := anObject


They look like normal ivar accesses, but in the background, the compiler delegated to the Slot the code generation, calling emit*, which leads
to the bytecode e.g. for the read:

21 <20> pushConstant: iv => TestSlot
22 <70> self
23 <E1> send: read:
24 <7C> returnTop

you could override the emit* methods to generate faster code, but to get something running it is not needed.

To test, e.g. you can set the slot from one object and read it from another:

A new iv: 6
A new iv 

Then inspect the slot: 

(A slotNamed: #iv) inspect!
!ExampleSlotWithState methodsFor: 'meta-object-protocol' stamp: 'MarcusDenker 6/27/2014 09:44'!
write: aValue to: anObject
	value := aValue! !

!ExampleSlotWithState methodsFor: 'meta-object-protocol' stamp: 'MarcusDenker 6/27/2014 09:44'!
read: anObject
	^ value! !

!Exception commentStamp: 'MarcusDenker 6/9/2014 16:43'!
This is the main class used to implement the exception handling system (EHS).  It plays two distinct roles:  that of the exception, and that of the exception handler.  More specifically, it implements the bulk of the protocols laid out in the ANSI specification - those protocol names are reflected in the message categories.

Exception is an abstract class.  Instances should neither be created nor trapped.  In most cases, subclasses should inherit from Error or Notification rather than directly from Exception.

Exceptions have an optional #messageText that can be set when they are signaled.
Exceptions also have the concept of #signaler, the object that is the subject of the exception.
This will be set automatically (to the #receiver), but can be set when the exception is signaled. 

In implementing this EHS, The Fourth Estate Inc. incorporated some ideas and code from Craig Latta's EHS.  His insights were crucial in allowing us to implement Context>>valueUninterruptably (and by extension, #ensure: and #ifCurtailed:), and we imported the following methods with little or no modification:

Context>>terminateTo:
Context>>terminate
Context>>receiver:
Context>>answer:

Thanks, Craig!!!
!Exception methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/18/2011 15:33'!
description
	"Return a textual description of the exception."

	^ String streamContents: [ :stream | | mt |
		stream << self class name.
		(mt := self messageText) isEmptyOrNil
			ifFalse: [ stream << ': ' << mt ] ]! !

!Exception methodsFor: 'handling' stamp: 'CamilloBruni 2/13/2012 16:59'!
freeze
	"freeze the context stack to keep the exception usable outside the catch blocks"
	self freezeUpTo: thisContext! !

!Exception methodsFor: 'accessing' stamp: 'pnm 8/16/2000 15:23'!
tag: t
	"This message is not specified in the ANSI protocol, but that looks like an oversight because #tag is specified, and the spec states that the signaler may store the tag value."

	tag := t! !

!Exception methodsFor: 'handling' stamp: 'CamilloBruni 7/12/2013 13:26'!
resignalAs: replacementException
	"Signal an alternative exception in place of the receiver."
	^ replacementException signalIn: signalContext! !

!Exception methodsFor: 'testing' stamp: 'ajh 2/1/2003 01:32'!
isNested
	"Determine whether the current exception handler is within the scope of another handler for the same exception."

	^ handlerContext nextHandlerContext canHandleSignal: self! !

!Exception methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/18/2011 15:22'!
signaler: anObject
	"Set the object that is the subject involving me.
	This is set automatically to my #receiver during #signal
	but could be overwritten when I am signaled"

	signaler := anObject! !

!Exception methodsFor: 'signaling' stamp: 'SvenVanCaekenberghe 4/18/2011 13:55'!
signal
	"Ask ContextHandlers in the sender chain to handle this signal.  The default is to execute and return my defaultAction."

	signalContext := thisContext contextTag.
	signaler ifNil: [ signaler := self receiver ].
	^ signalContext nextHandlerContext handleSignal: self! !

!Exception methodsFor: 'printing' stamp: 'ajh 9/30/2001 15:33'!
printOn: stream

	stream nextPutAll: self description! !

!Exception methodsFor: 'signaling' stamp: 'ajh 9/30/2001 20:13'!
signal: signalerText
	"Signal the occurrence of an exceptional condition with a specified textual description."

	self messageText: signalerText.
	^ self signal! !

!Exception methodsFor: 'handling' stamp: 'ajh 1/29/2003 13:37'!
return: returnValue
	"Return the argument as the value of the block protected by the active exception handler."

	handlerContext return: returnValue! !

!Exception methodsFor: 'handling' stamp: 'SvenVanCaekenberghe 4/18/2011 15:18'!
resume: resumptionValue
	"Return resumptionValue as the value of the signal message."

	self isResumable ifFalse: [ IllegalResumeAttempt signal ].
	self resumeUnchecked: resumptionValue! !

!Exception methodsFor: 'handling' stamp: 'StephaneDucasse 2/16/2010 14:03'!
return
	"Return nil as the value of the block protected by the active exception handler."

	self return: self defaultReturnValue! !

!Exception methodsFor: 'private' stamp: 'SvenVanCaekenberghe 4/18/2011 15:17'!
defaultResumeValue
	"Answer the value that by default should be returned if the exception is resumed"
	
	^ nil! !

!Exception methodsFor: 'handling' stamp: 'ajh 2/16/2003 17:37'!
searchFrom: aContext
	" Set the context where the handler search will start. "

	signalContext := aContext contextTag! !

!Exception methodsFor: 'testing' stamp: 'ajh 2/1/2003 00:58'!
isResumable
	"Determine whether an exception is resumable."

	^ true! !

!Exception methodsFor: 'handling' stamp: 'SvenVanCaekenberghe 4/18/2011 15:18'!
resumeUnchecked: resumptionValue
	"Return resumptionValue as the value of #signal, unless this was called after an #outer message, then return resumptionValue as the value of #outer."

	| ctxt |
	outerContext 
		ifNil: [
			signalContext return: resumptionValue ] 
		ifNotNil: [
			ctxt := outerContext.
			outerContext := ctxt tempAt: 1. "prevOuterContext in #outer"
			ctxt return: resumptionValue ]
! !

!Exception methodsFor: 'handling' stamp: 'StephaneDucasse 2/16/2010 14:02'!
resume
	"Return from the message that signaled the receiver."

	self resume: self defaultResumeValue! !

!Exception methodsFor: 'accessing' stamp: 'ClementBera 9/27/2013 17:57'!
tag
	"Return an exception's tag value."

	^ tag 
		ifNil: [ self messageText ]
		ifNotNil: [ tag ]! !

!Exception methodsFor: 'accessing' stamp: 'CamilloBruni 7/17/2013 21:24'!
signalerContext
	"Find the first sender of signal(:), the first context which is neither for an instance method nor for a class side method of Exception (or subclass).
	This will make sure that the same context is found for both, `Error signal` and `Error new signal`"

	^ signalContext findContextSuchThat: [ :context |
		(context receiver == self 
		or: [ context receiver == self class ]) not ]! !

!Exception methodsFor: 'signaling' stamp: 'ajh 9/30/2001 15:33'!
messageText: signalerText
	"Set an exception's message text."

	messageText := signalerText! !

!Exception methodsFor: 'private' stamp: 'StephaneDucasse 2/16/2010 14:02'!
defaultReturnValue
	"Answer the value that by default should be returned if the exception is returned"
	^nil! !

!Exception methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/18/2011 15:22'!
signaler
	"Return the object that is the subject involving me.
	This is set automatically to my #receiver during #signal
	but could be overwritten when I am signaled"

	^ signaler! !

!Exception methodsFor: '*SUnit-Core' stamp: 'jp 3/17/2003 10:03'!
sunitExitWith: aValue
 
        self return: aValue! !

!Exception methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/18/2011 15:20'!
receiver
	^ self signalerContext receiver! !

!Exception methodsFor: 'handling' stamp: 'MarcusDenker 7/23/2014 22:32'!
freezeUpTo:  aContext
	"freeze the signal context up to the given context so the exception is usable outside the catch block"
	signalContext := signalContext copyTo: aContext! !

!Exception methodsFor: 'handling' stamp: 'ajh 2/1/2003 01:33'!
pass
	"Yield control to the enclosing exception action for the receiver."

	handlerContext nextHandlerContext handleSignal: self! !

!Exception methodsFor: 'accessing' stamp: 'ajh 9/30/2001 15:33'!
defaultAction
	"The default action taken if the exception is signaled."

	self subclassResponsibility! !

!Exception methodsFor: 'handling' stamp: 'ajh 1/29/2003 13:37'!
retryUsing: alternativeBlock
	"Abort an exception handler and evaluate a new block in place of the handler's protected block."

	handlerContext restartWithNewReceiver: alternativeBlock
! !

!Exception methodsFor: 'handling' stamp: 'ajh 1/29/2003 13:36'!
retry
	"Abort an exception handler and re-evaluate its protected block."

	handlerContext restart! !

!Exception methodsFor: 'private' stamp: 'ajh 1/29/2003 13:44'!
privHandlerContext: aContextTag

	handlerContext := aContextTag! !

!Exception methodsFor: 'accessing' stamp: 'StephaneDucasse 2/13/2010 12:18'!
messageText
	"Return an exception's message text."

	^ messageText ifNil: [ String empty ]! !

!Exception methodsFor: 'handling' stamp: 'MarcusDenker 9/29/2013 09:05'!
debug
	"open a debugger on myself"
	^ Smalltalk tools debugger debugError: self! !

!Exception methodsFor: 'signaling' stamp: 'CamilloBruni 7/12/2013 13:15'!
signalIn: context
	"Ask ContextHandlers in the sender chain starting at the given context to handle this signal. 
	The default is to execute and return my defaultAction."

	signalContext := context.
	signaler ifNil: [ signaler := self receiver ].
	^ signalContext nextHandlerContext handleSignal: self! !

!Exception methodsFor: 'handling' stamp: 'SvenVanCaekenberghe 4/18/2011 15:17'!
outer
	"Evaluate the enclosing exception action and return to here instead of signal if it resumes (see #resumeUnchecked:)."

	| prevOuterContext |
	self isResumable 
		ifTrue: [
			prevOuterContext := outerContext.
			outerContext := thisContext contextTag ].
	self pass.
! !

!Exception methodsFor: 'private' stamp: 'MartinMcClureWithAndresValloud 8/17/2014 07:54'!
privHandlerContext

	^handlerContext! !

!Exception class methodsFor: 'exceptioninstantiator' stamp: 'CamilloBruni 7/12/2013 13:17'!
signal: message in: context
	"Signal the occurrence of an exceptional condition with a specified textual description in the given context."

	^ self new 
		messageText: message;
		signalIn: context! !

!Exception class methodsFor: 'exceptionselector' stamp: 'SvenVanCaekenberghe 11/22/2013 23:51'!
- anotherException
	"Create an exception set containing the receiver 
	and anotherException as exclusion."

	^ ExceptionSetWithExclusions new
		add: self;
		addExclusion: anotherException;
		yourself! !

!Exception class methodsFor: 'exceptioninstantiator' stamp: 'ajh 9/30/2001 21:54'!
signal
	"Signal the occurrence of an exceptional condition."

	^ self new signal! !

!Exception class methodsFor: '*Polymorph-Widgets-Themes' stamp: 'YuriyTymchuk 12/20/2013 11:18'!
systemIcon

	^ Smalltalk ui icons iconNamed: #exceptionIcon! !

!Exception class methodsFor: 'exceptioninstantiator' stamp: 'CamilloBruni 7/12/2013 13:16'!
signal: message
	"Signal the occurrence of an exceptional condition with a specified textual description."

	^ self new signal: message! !

!Exception class methodsFor: 'exceptionselector' stamp: 'ajh 8/5/2003 11:33'!
handles: exception
	"Determine whether an exception handler will accept a signaled exception."

	^ exception isKindOf: self! !

!Exception class methodsFor: 'exceptionselector' stamp: 'SvenVanCaekenberghe 11/22/2013 23:51'!
, anotherException
	"Create an exception set containing the receiver and anotherException"

	^ ExceptionSet new
		add: self;
		add: anotherException;
		yourself! !

!Exception class methodsFor: 'exceptioninstantiator' stamp: 'CamilloBruni 7/12/2013 13:16'!
signalIn: context
	"Signal the occurrence of an exceptional condition in the given context."

	^ self new signalIn: context! !

!ExceptionSet commentStamp: '<historical>'!
An ExceptionSet is a grouping of exception handlers which acts as a single handler.  Within the group, the most recently added handler will be the last handler found during a handler search (in the case where more than one handler in the group is capable of handling a given exception). !
!ExceptionSet methodsFor: 'exceptionselector' stamp: 'SvenVanCaekenberghe 11/22/2013 23:39'!
- anotherException
	"Create an exception set containnig the receiver
	and anotherException as an exclusion."

	^ ExceptionSetWithExclusions new
		add: self;
		addExclusion: anotherException;
		yourself! !

!ExceptionSet methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 09:52'!
initialize

	super initialize.
	exceptions := OrderedCollection new! !

!ExceptionSet methodsFor: 'exceptionselector' stamp: 'SvenVanCaekenberghe 11/22/2013 23:43'!
handles: anException
	"Determine whether an exception handler will accept a signaled exception."

	^ exceptions anySatisfy: [ :exception | exception handles: anException ]! !

!ExceptionSet methodsFor: 'exceptionselector' stamp: 'SvenVanCaekenberghe 11/22/2013 23:34'!
, anException
	"Return an exception set that contains the receiver and the argument exception. This is commonly used to specify a set of exception selectors for an exception handler."

	self add: anException! !

!ExceptionSet methodsFor: 'private' stamp: 'SvenVanCaekenberghe 11/22/2013 23:40'!
add: anException
	"Add anException to the exceptions that I handle"
	
	^ exceptions add: anException! !

!ExceptionSetWithExclusions commentStamp: '<historical>'!
I am ExceptionSetWithExclusions, an ExceptionSet that explicitely does not handle a number of exclusion Exceptions.!
!ExceptionSetWithExclusions methodsFor: 'exceptionselector' stamp: 'SvenVanCaekenberghe 11/22/2013 13:34'!
- exception
	"Add exception as an exclusion to me.
	I will explicitely not handle my exclusion exceptions."
	
	self addExclusion: exception! !

!ExceptionSetWithExclusions methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 11/22/2013 13:10'!
initialize

	super initialize.
	exclusions := OrderedCollection new! !

!ExceptionSetWithExclusions methodsFor: 'exceptionselector' stamp: 'SvenVanCaekenberghe 11/22/2013 23:47'!
handles: exception
	"Return true when I will handled exception.
	I extend my superclass behavior by explicitely 
	not handling a number of exclusion exceptions."

	^ (super handles: exception) 
			and: [ exclusions noneSatisfy: [ :each | each handles: exception ] ]! !

!ExceptionSetWithExclusions methodsFor: 'private' stamp: 'SvenVanCaekenberghe 11/22/2013 13:35'!
addExclusion: exception
	"Add exception as an exclusion to me.
	I will explicitely not handle my exclusion exceptions."
	
	^ exclusions add: exception! !

!ExceptionTester commentStamp: 'TorstenBergmann 2/5/2014 08:36'!
Utility class to test exceptions!
!ExceptionTester methodsFor: 'signaledexception tests' stamp: 'tpr 5/27/2004 21:50'!
simpleOuterTest
	"uses #resume"

	[[self doSomething.
	MyTestNotification signal.
	"self doSomethingElse"
	self doSomethingExceptional]
		on: MyTestNotification
		do: [:ex | ex outer. self doSomethingElse]]
				on: MyTestNotification
				do: [:ex | self doYetAnotherThing. ex resume]! !

!ExceptionTester methodsFor: 'tests' stamp: 'tfei 6/8/1999 12:50'!
simpleEnsureTestWithError

	[self doSomething.
	MyTestError signal.
	self doSomethingElse]
		ensure:
			[self doYetAnotherThing].
	! !

!ExceptionTester methodsFor: 'tests' stamp: 'brp 10/22/2004 12:00'!
simpleNoTimeoutTest

	[ self doSomething ]
		valueWithin: 1 day onTimeout:
			[ self doSomethingElse ].
	! !

!ExceptionTester methodsFor: 'logging' stamp: 'tfei 6/8/1999 09:38'!
logTestResult: aString

	| index |
	index := self suiteLog size.
	self suiteLog 
		at: index
		put: ((self suiteLog at: index), ' ', aString)! !

!ExceptionTester methodsFor: 'signaledexception results' stamp: 'tfei 6/13/1999 01:23'!
simpleRetryUsingTestResults

	^OrderedCollection new
			add: self doSomethingString;
			add: self doYetAnotherThingString;
			yourself! !

!ExceptionTester methodsFor: 'results' stamp: 'tfei 8/19/1999 02:39'!
resumableFallOffTheEndHandlerResults

	^OrderedCollection new
		add: self doSomethingString;
		add: self doSomethingExceptionalString;
		add: self doYetAnotherThingString;
		yourself! !

!ExceptionTester methodsFor: 'results' stamp: 'tfei 6/8/1999 10:13'!
simpleEnsureTestWithNotificationResults

	^OrderedCollection new
		add: self doSomethingString;
		add: self doSomethingElseString;
		add: self doYetAnotherThingString;
		yourself! !

!ExceptionTester methodsFor: 'signaledexception tests' stamp: 'nice 1/5/2010 15:59'!
simpleResumeTest

	"see if we can resume twice"

	
	[ | it |self doSomething.
	it := MyResumableTestError signal.
	it = 3 ifTrue: [self doSomethingElse].
	it := MyResumableTestError signal.
	it = 3 ifTrue: [self doSomethingElse].
	]
		on: MyResumableTestError
		do:
			[:ex |
			self doYetAnotherThing.
			ex resume: 3]! !

!ExceptionTester methodsFor: 'tests' stamp: 'brp 10/22/2004 12:00'!
simpleTimeoutWithZeroDurationTest

	[ self doSomething ]
		valueWithin: 0 seconds onTimeout:
			[ self doSomethingElse ].
	! !

!ExceptionTester methodsFor: 'signaledexception tests' stamp: 'dtl 6/1/2004 21:49'!
doubleOuterTest
	"uses #resume"

	[[[self doSomething.
	MyTestNotification signal.
	self doSomethingExceptional]
		on: MyTestNotification
		do: [:ex | ex outer.
			self doSomethingExceptional]]
			on: MyTestNotification
			do: [:ex | ex outer.
				self doSomethingElse]]
				on: MyTestNotification
				do: [:ex | self doYetAnotherThing. ex resume]! !

!ExceptionTester methodsFor: 'results' stamp: 'tfei 6/9/1999 17:44'!
simpleEnsureTestWithErrorResults

	^OrderedCollection new
		add: self doSomethingString;
		add: 'Unhandled Exception';
		add: self doYetAnotherThingString;
		yourself! !

!ExceptionTester methodsFor: 'results' stamp: 'tfei 6/8/1999 18:55'!
simpleEnsureTestWithUparrowResults

	^OrderedCollection new
		add: self doSomethingString;
"		add: self doSomethingElseString;"
		add: self doYetAnotherThingString;
		yourself! !

!ExceptionTester methodsFor: 'signaledexception results' stamp: 'dtl 6/1/2004 21:56'!
doublePassOuterTestResults

	^OrderedCollection new
		add: self doSomethingString;
		add: self doYetAnotherThingString;
		add: self doSomethingElseString;
		yourself! !

!ExceptionTester methodsFor: 'signaledexception results' stamp: 'tfei 6/13/1999 01:23'!
simpleRetryTestResults

	^OrderedCollection new
			add: self doSomethingString;
			add: self doYetAnotherThingString;
			add: self doSomethingString;
			add: self doSomethingElseString;
			yourself! !

!ExceptionTester methodsFor: 'accessing' stamp: 'brp 10/21/2004 17:16'!
iterationsBeforeTimeout: anInteger

	iterationsBeforeTimeout := anInteger! !

!ExceptionTester methodsFor: 'suites' stamp: 'tfei 6/13/1999 01:25'!
runAllTests
	"ExceptionTester new runAllTests"

	self
		runBasicTests;
		runBasicANSISignaledExceptionTests! !

!ExceptionTester methodsFor: 'tests' stamp: 'brp 10/22/2004 12:00'!
simpleTimeoutTest

	| n |
	[1 to: 1000000 do: [ :i | n := i. self doSomething ] ]
		valueWithin: 50 milliSeconds onTimeout:
			[ self iterationsBeforeTimeout: n.
			self doSomethingElse ]! !

!ExceptionTester methodsFor: 'accessing' stamp: 'tfei 6/8/1999 09:15'!
doYetAnotherThingString

	^'Do yet another thing.'! !

!ExceptionTester methodsFor: 'signaledexception tests' stamp: 'tfei 6/13/1999 01:02'!
simpleRetryTest

	| theMeaningOfLife |
	theMeaningOfLife := nil.
	[self doSomething.
	theMeaningOfLife == nil
		ifTrue: [MyTestError signal]
		ifFalse: [self doSomethingElse]]
			on: MyTestError
			do:
				[:ex |
				theMeaningOfLife := 42.
				self doYetAnotherThing.
				ex retry]! !

!ExceptionTester methodsFor: 'accessing' stamp: 'tfei 6/8/1999 09:14'!
doSomethingExceptionalString

	^'Do something exceptional.'! !

!ExceptionTester methodsFor: 'results' stamp: 'tfei 11/14/1999 17:29'!
doubleResumeTestResults

       ^OrderedCollection new
               add: self doSomethingString;
               add: self doSomethingElseString;
               add: self doYetAnotherThingString;
               yourself! !

!ExceptionTester methodsFor: 'tests' stamp: 'tfei 6/7/1999 13:43'!
nonResumableFallOffTheEndHandler
	
	[self doSomething.
	MyTestError signal.
	self doSomethingElse]
		on: MyTestError
		do: [:ex | self doSomethingExceptional].
	self doYetAnotherThing! !

!ExceptionTester methodsFor: 'testing' stamp: 'brp 10/21/2004 17:40'!
runTest: aSelector

	| actualResult expectedResult |
	[ self 
		logTest: aSelector;
		clearLog;
		perform: aSelector ]
			on: MyTestError do: 
				[ :ex | self log: 'Unhandled Exception'.
					ex return: nil ].

	actualResult	:= self log.
	expectedResult := self perform: (aSelector, #Results) asSymbol.

	actualResult = expectedResult
		ifTrue: [self logTestResult: 'succeeded']
		ifFalse: [self logTestResult: 'failed' ].
! !

!ExceptionTester methodsFor: 'pseudo actions' stamp: 'tfei 6/8/1999 09:14'!
doSomethingElse

	self log: self doSomethingElseString! !

!ExceptionTester methodsFor: 'pseudo actions' stamp: 'tfei 6/8/1999 09:16'!
methodWithError

	MyTestError signal: self testString! !

!ExceptionTester methodsFor: 'suites' stamp: 'tfei 6/9/1999 16:06'!
runBasicTests

	self basicTestSelectors
		do:
			[:eachTestSelector |
			self runTest: eachTestSelector]! !

!ExceptionTester methodsFor: 'accessing' stamp: 'tfei 6/8/1999 09:14'!
doSomethingElseString

	^'Do something else.'! !

!ExceptionTester methodsFor: 'accessing' stamp: 'tfei 6/7/1999 15:03'!
log

	log == nil
		ifTrue: [log := OrderedCollection new].
	^log! !

!ExceptionTester methodsFor: 'tests' stamp: 'tfei 6/9/1999 16:04'!
simpleEnsureTestWithUparrow

	[self doSomething.
	true ifTrue: [^nil].
	self doSomethingElse]
		ensure:
			[self doYetAnotherThing].
	! !

!ExceptionTester methodsFor: 'tests' stamp: 'tfei 6/7/1999 14:28'!
warningTest

	self log: 'About to signal warning.'.
	Warning signal: 'Ouch'.
	self log: 'Warning signal handled and resumed.'! !

!ExceptionTester methodsFor: 'signaledexception results' stamp: 'dtl 6/1/2004 21:56'!
doubleOuterPassTestResults

	^OrderedCollection new
		add: self doSomethingString;
		add: self doYetAnotherThingString;
		add: self doSomethingElseString;
		yourself! !

!ExceptionTester methodsFor: 'signaledexception tests' stamp: 'tfei 6/13/1999 02:12'!
simpleResignalAsTest
	"ExceptionTester new simpleResignalAsTest"

	[self doSomething.
	MyTestNotification signal.
	self doSomethingElse]
		on: MyTestNotification
		do:
			[:ex | ex resignalAs: MyTestError new]! !

!ExceptionTester methodsFor: 'signaledexception results' stamp: 'tfei 6/13/1999 01:10'!
simpleOuterTestResults

	^OrderedCollection new
		add: self doSomethingString;
		add: self doYetAnotherThingString;
		add: self doSomethingElseString;
		yourself! !

!ExceptionTester methodsFor: 'signaledexception tests' stamp: 'CamilloBruni 7/12/2013 13:21'!
simpleIsNestedTest
	"uses resignalAs:"

	[ self doSomething.
	MyTestError signal.
	self doSomethingElse 
	] on: MyTestError do: [ :exception |
		"expecting to detect handler in #runTest:"
		exception isNested 
			ifTrue: [
				self doYetAnotherThing.
				exception resignalAs: MyTestNotification new ]]! !

!ExceptionTester methodsFor: 'accessing' stamp: 'tfei 6/8/1999 09:13'!
doSomethingString

	^'Do something.'! !

!ExceptionTester methodsFor: 'signaledexception tests' stamp: 'dtl 6/1/2004 21:52'!
doublePassOuterTest
	"uses #resume"

	[[[self doSomething.
	MyTestNotification signal.
	self doSomethingExceptional]
		on: MyTestNotification
		do: [:ex | ex pass.
			self doSomethingExceptional]]
			on: MyTestNotification
			do: [:ex | ex outer.
				self doSomethingElse]]
				on: MyTestNotification
				do: [:ex | self doYetAnotherThing. ex resume]! !

!ExceptionTester methodsFor: 'tests' stamp: 'tfei 11/14/1999 17:26'!
doubleResumeTest

       [self doSomething.
       MyResumableTestError signal.
       self doSomethingElse.
       MyResumableTestError signal.
       self doYetAnotherThing]
               on: MyResumableTestError
               do: [:ex | ex resume].! !

!ExceptionTester methodsFor: 'results' stamp: 'brp 10/21/2004 16:52'!
simpleTimeoutWithZeroDurationTestResults

	^OrderedCollection new
		add: self doSomethingElseString;
		yourself! !

!ExceptionTester methodsFor: 'accessing' stamp: 'brp 10/21/2004 17:54'!
basicTestSelectors
	^ #(#simpleEnsureTest #simpleEnsureTestWithNotification #simpleEnsureTestWithUparrow #simpleEnsureTestWithError #signalFromHandlerActionTest #resumableFallOffTheEndHandler #nonResumableFallOffTheEndHandler #doubleResumeTest #simpleTimeoutWithZeroDurationTest #simpleTimeoutTest simpleNoTimeoutTest)! !

!ExceptionTester methodsFor: 'results' stamp: 'tfei 8/19/1999 01:51'!
signalFromHandlerActionTestResults

	^OrderedCollection new
		add: self doSomethingString;
		add: self doYetAnotherThingString;
		add: 'Unhandled Exception';
		yourself! !

!ExceptionTester methodsFor: 'signaledexception results' stamp: 'tfei 6/13/1999 01:11'!
simpleResignalAsTestResults

	^OrderedCollection new
		add: self doSomethingString;
		add: 'Unhandled Exception';
		yourself! !

!ExceptionTester methodsFor: 'tests' stamp: 'tfei 6/8/1999 10:15'!
simpleEnsureTestWithNotification

	[self doSomething.
	self methodWithNotification.
	self doSomethingElse]
		ensure:
			[self doYetAnotherThing].
	! !

!ExceptionTester methodsFor: 'signaledexception tests' stamp: 'dtl 6/1/2004 21:51'!
doubleOuterPassTest
	"uses #resume"

	[[[self doSomething.
	MyTestNotification signal.
	self doSomethingExceptional]
		on: MyTestNotification
		do: [:ex | ex outer.
			self doSomethingElse]]
			on: MyTestNotification
			do: [:ex | ex pass.
				self doSomethingExceptional]]
				on: MyTestNotification
				do: [:ex | self doYetAnotherThing. ex resume]! !

!ExceptionTester methodsFor: 'tests' stamp: 'tfei 8/19/1999 01:39'!
signalFromHandlerActionTest

	[self doSomething.
	MyTestError signal.
	self doSomethingElse]
		on: MyTestError
		do:
			[self doYetAnotherThing.
			MyTestError signal]! !

!ExceptionTester methodsFor: 'signaledexception tests' stamp: 'tfei 6/13/1999 00:59'!
simpleReturnTest

	| it |
	it :=
		[self doSomething.
		MyTestError signal.
		self doSomethingElse]
			on: MyTestError
			do: [:ex | ex return: 3].
	it = 3 ifTrue: [self doYetAnotherThing]! !

!ExceptionTester methodsFor: 'logging' stamp: 'tfei 6/12/1999 23:07'!
logTest: aSelector

	self suiteLog add: aSelector! !

!ExceptionTester methodsFor: 'results' stamp: 'tfei 6/8/1999 09:21'!
nonResumableFallOffTheEndHandlerResults

	^OrderedCollection new
		add: self doSomethingString;
		add: self doSomethingExceptionalString;
		add: self doYetAnotherThingString;
		yourself! !

!ExceptionTester methodsFor: 'results' stamp: 'brp 10/21/2004 16:54'!
simpleNoTimeoutTestResults

	^OrderedCollection new
		add: self doSomethingString;
		yourself! !

!ExceptionTester methodsFor: 'tests' stamp: 'tfei 6/8/1999 09:44'!
simpleEnsureTest

	[self doSomething.
	self doSomethingElse]
		ensure:
			[self doYetAnotherThing].
	! !

!ExceptionTester methodsFor: 'accessing' stamp: 'brp 10/21/2004 17:15'!
iterationsBeforeTimeout

	^ iterationsBeforeTimeout! !

!ExceptionTester methodsFor: 'logging' stamp: 'tfei 6/7/1999 15:03'!
log: aString

	self log add: aString! !

!ExceptionTester methodsFor: 'signaledexception tests' stamp: 'tfei 6/13/1999 01:03'!
simpleRetryUsingTest

	[self doSomething.
	MyTestError signal.
	self doSomethingElse]
		on: MyTestError
		do:
			[:ex | ex retryUsing: [self doYetAnotherThing]]! !

!ExceptionTester methodsFor: 'accessing' stamp: 'tfei 6/8/1999 09:30'!
suiteLog

	suiteLog == nil
		ifTrue: [suiteLog := OrderedCollection new].
	^suiteLog! !

!ExceptionTester methodsFor: 'accessing' stamp: 'tfei 6/8/1999 09:15'!
testString

	^'This is only a test.'! !

!ExceptionTester methodsFor: 'accessing' stamp: 'dtl 6/1/2004 21:53'!
basicANSISignaledExceptionTestSelectors

	^#( simpleIsNestedTest simpleOuterTest doubleOuterTest doubleOuterPassTest doublePassOuterTest simplePassTest simpleResignalAsTest simpleResumeTest simpleRetryTest simpleRetryUsingTest simpleReturnTest)! !

!ExceptionTester methodsFor: 'signaledexception results' stamp: 'RAA 12/8/2000 12:59'!
simpleResumeTestResults

	"see if we can resume twice"

	^OrderedCollection new
			add: self doSomethingString;
			add: self doYetAnotherThingString;
			add: self doSomethingElseString;
			add: self doYetAnotherThingString;
			add: self doSomethingElseString;
			yourself! !

!ExceptionTester methodsFor: 'signaledexception results' stamp: 'tfei 6/13/1999 01:10'!
simplePassTestResults

	^OrderedCollection new
		add: self doSomethingString;
		add: self doYetAnotherThingString;
		add: 'Unhandled Exception';
		yourself! !

!ExceptionTester methodsFor: 'signaledexception results' stamp: 'tfei 6/13/1999 01:09'!
simpleIsNestedTestResults

	^OrderedCollection new
		add: self doSomethingString;
		add: self doYetAnotherThingString;
		add: self doSomethingElseString;
		yourself! !

!ExceptionTester methodsFor: 'signaledexception results' stamp: 'tfei 6/13/1999 02:22'!
simpleReturnTestResults

	^OrderedCollection new
		add: self doSomethingString;
		add: self doYetAnotherThingString;
		yourself! !

!ExceptionTester methodsFor: 'logging' stamp: 'tfei 6/8/1999 09:17'!
clearLog

	log := nil! !

!ExceptionTester methodsFor: 'suites' stamp: 'tfei 6/12/1999 23:54'!
runBasicANSISignaledExceptionTests

	self basicANSISignaledExceptionTestSelectors
		do:
			[:eachTestSelector |
			self runTest: eachTestSelector]! !

!ExceptionTester methodsFor: 'pseudo actions' stamp: 'tfei 6/8/1999 09:14'!
doSomethingExceptional

	self log: self doSomethingExceptionalString! !

!ExceptionTester methodsFor: 'pseudo actions' stamp: 'tfei 6/8/1999 09:16'!
methodWithNotification

	MyTestNotification signal: self testString! !

!ExceptionTester methodsFor: 'tests' stamp: 'tfei 6/9/1999 16:07'!
resumableFallOffTheEndHandler

	[self doSomething.
	MyTestNotification signal.
	self doSomethingElse]
		on: MyTestNotification
		do: [:ex | self doSomethingExceptional].
	self doYetAnotherThing! !

!ExceptionTester methodsFor: 'results' stamp: 'brp 10/21/2004 17:44'!
simpleTimeoutTestResults

	| things |
	things := OrderedCollection new: self iterationsBeforeTimeout.

	self iterationsBeforeTimeout timesRepeat: [ things add: self  doSomethingString ].
	things add: self doSomethingElseString.

	^ things! !

!ExceptionTester methodsFor: 'results' stamp: 'tfei 6/8/1999 09:47'!
simpleEnsureTestResults

	^OrderedCollection new
		add: self doSomethingString;
		add: self doSomethingElseString;
		add: self doYetAnotherThingString;
		yourself! !

!ExceptionTester methodsFor: 'pseudo actions' stamp: 'tfei 6/8/1999 09:13'!
doSomething

	self log: self doSomethingString! !

!ExceptionTester methodsFor: 'logging' stamp: 'PeterHugossonMiller 9/3/2009 01:25'!
contents

	^( self log
		inject: (String new: 80) writeStream
		into: 
			[:result :item |
			result 
				cr; 
				nextPutAll: item;
				yourself] ) contents! !

!ExceptionTester methodsFor: 'signaledexception tests' stamp: 'tfei 6/13/1999 00:37'!
simplePassTest

	[self doSomething.
	MyTestError signal.
	self doSomethingElse]
		on: MyTestError
		do:
			[:ex |
			self doYetAnotherThing.
			ex pass "expecting handler in #runTest:"]! !

!ExceptionTester methodsFor: 'pseudo actions' stamp: 'tfei 6/8/1999 09:15'!
doYetAnotherThing

	self log: self doYetAnotherThingString! !

!ExceptionTests commentStamp: 'TorstenBergmann 2/5/2014 08:36'!
SUnit tests for exceptions!
!ExceptionTests methodsFor: 'testing-exceptiontester' stamp: 'dtl 6/1/2004 21:54'!
testDoublePassOuter
	self assertSuccess: (ExceptionTester new runTest: #doublePassOuterTest ) ! !

!ExceptionTests methodsFor: 'testing-exceptiontester' stamp: 'md 3/25/2003 23:48'!
testSimpleReturn
	self assertSuccess: (ExceptionTester new runTest: #simpleReturnTest ) ! !

!ExceptionTests methodsFor: 'testing-exceptiontester' stamp: 'md 3/25/2003 23:42'!
testSimplePass
	self assertSuccess: (ExceptionTester new runTest: #simplePassTest ) ! !

!ExceptionTests methodsFor: 'testing-handling' stamp: 'GabrielOmarCotelli 11/21/2013 15:01'!
testHandlingWithSeveralExclusions
	| wasHandled |
	wasHandled := false.
	self
		should: [ 
			[ ZeroDivide signalWithDividend: 1 ]
				on: Error - Warning - ZeroDivide
				do: [ :exception | 
					wasHandled := true.
					exception return ] ]
		raise: ZeroDivide.
	self deny: wasHandled.
	
	self
		should: [ 
			[ ZeroDivide signalWithDividend: 1 ]
				on: Error - (Warning , ZeroDivide)
				do: [ :exception | 
					wasHandled := true.
					exception return ] ]
		raise: ZeroDivide.
	self deny: wasHandled.! !

!ExceptionTests methodsFor: 'testing-exceptiontester' stamp: 'md 3/25/2003 23:48'!
testSimpleEnsure
	self assertSuccess: (ExceptionTester new runTest: #simpleEnsureTest ) ! !

!ExceptionTests methodsFor: 'testing-outer' stamp: 'dtl 6/1/2004 22:00'!
testNonResumablePass

	self should: [
		[Error signal. 4] 
			on: Error 
			do: [:ex | ex pass. ex return: 5]
		] raise: Error
! !

!ExceptionTests methodsFor: 'testing-handling' stamp: 'MartinMcClure 8/18/2014 08:53'!
testHandlerFromAction
	"A test ensuring that nested exceptions work as expected."

	| result |
	result := [ 
	[ 
	[ self error: 'trigger error' ]
		on: ZeroDivide
		do: [ :ex | 'inner' ] ]
		on: Error
		do: [ :ex | 3 / 0 ] ]
		on: ZeroDivide
		do: [ :ex | 'outer' ].
	self assert: 'outer' = result description: 'Incorrect handler'! !

!ExceptionTests methodsFor: 'testing-exceptiontester' stamp: 'md 3/25/2003 23:45'!
testSimpleEnsureTestWithError
	self assertSuccess: (ExceptionTester new runTest: #simpleEnsureTestWithError ) ! !

!ExceptionTests methodsFor: 'testing-exceptiontester' stamp: 'md 3/25/2003 23:44'!
testResumableFallOffTheEndHandler
	self assertSuccess: (ExceptionTester new runTest: #resumableFallOffTheEndHandler ) ! !

!ExceptionTests methodsFor: 'testing-exceptiontester' stamp: 'md 3/25/2003 23:43'!
testSimpleResignalAs
	self assertSuccess: (ExceptionTester new runTest: #simpleResignalAsTest ) ! !

!ExceptionTests methodsFor: 'testing-outer' stamp: 'dtl 6/1/2004 21:59'!
testNonResumableOuter

	self should: [
		[Error signal. 4] 
			on: Error 
			do: [:ex | ex outer. ex return: 5]
		] raise: Error
! !

!ExceptionTests methodsFor: 'testing-exceptiontester' stamp: 'md 3/25/2003 23:46'!
testSimpleIsNested
	self assertSuccess: (ExceptionTester new runTest: #simpleIsNestedTest ) ! !

!ExceptionTests methodsFor: 'testing-exceptiontester' stamp: 'md 3/25/2003 23:47'!
testSimpleRetryUsing
	self assertSuccess: (ExceptionTester new runTest: #simpleRetryUsingTest ) ! !

!ExceptionTests methodsFor: 'testing-outer' stamp: 'StephaneDucasse 5/28/2011 13:49'!
testResumablePass

	| result |
	result := [Notification signal. 4] 
		on: Notification 
		do: [:ex | ex pass. ex return: 5].
	self assert: result = 4
! !

!ExceptionTests methodsFor: 'testing-handling' stamp: 'SvenVanCaekenberghe 11/22/2013 16:25'!
testHandlingExceptionSetWithExclusion

	| wasHandled  |

	wasHandled := false.

	self
		should: [ 
			[ ZeroDivide signalWithDividend: 1 ]
				on: Error, ArithmeticError - ZeroDivide
				do: [ :exception | 
					wasHandled := true.
					exception return ] ]
		raise: ZeroDivide.
	
	self deny: wasHandled! !

!ExceptionTests methodsFor: 'testing-handling' stamp: 'GabrielOmarCotelli 11/21/2013 14:39'!
testHandlingWhenThereIsSomeExclusionButDontApplies

	| wasHandled result |

	wasHandled := false.

	result := [ 
	ZeroDivide signalWithDividend: 1.
	2 ]
		on: Error - MessageNotUnderstood
		do: [ :exception | 
			wasHandled := true.
			exception return ].

	self
		assert: wasHandled;
		assert: result isNil! !

!ExceptionTests methodsFor: 'testing-handling' stamp: 'MartinMcClure 8/18/2014 08:52'!
testHandlerContext
	"A test ensuring that when evaluating the action block the exception environment is set to the handler context."

	| result |
	result := [ 
	[ 
	[ MyResumableTestError signal ]
		on: MyTestError
		do: [ 'handler 2' ] ]
		on: MyResumableTestError
		do: [ MyTestError signal ] ]
		on: MyTestError
		do: [ 'handler 1' ].
	self assert: 'handler 1' = result description: 'Incorrect handler'! !

!ExceptionTests methodsFor: 'testing-exceptiontester' stamp: 'md 3/25/2003 23:46'!
testSimpleEnsureTestWithNotification
	self assertSuccess: (ExceptionTester new runTest: #simpleEnsureTestWithNotification ) ! !

!ExceptionTests methodsFor: 'private' stamp: 'md 3/25/2003 23:40'!
assertSuccess: anExceptionTester
	self should: [ ( anExceptionTester suiteLog first) endsWith:  'succeeded'].! !

!ExceptionTests methodsFor: 'testing-exceptiontester' stamp: 'dtl 6/1/2004 21:54'!
testDoubleOuterPass
	self assertSuccess: (ExceptionTester new runTest: #doubleOuterPassTest ) ! !

!ExceptionTests methodsFor: 'testing' stamp: 'brp 10/21/2004 16:42'!
testNoTimeout
	self assertSuccess: (ExceptionTester new runTest: #simpleNoTimeoutTest ) ! !

!ExceptionTests methodsFor: 'testing-handling' stamp: 'GabrielOmarCotelli 11/21/2013 15:32'!
testHandlingWithSeveralExclusionsAndExceptionSetsHandling

	| wasHandled result |

	wasHandled := false.

	result := [ 
	ZeroDivide signalWithDividend: 1.
	2 ]
		on: Error - MessageNotUnderstood - Warning
		do: [ :exception | 
			wasHandled := true.
			exception return ].

	self
		assert: wasHandled;
		assert: result isNil.
		
	wasHandled := false.

	result := [ 
	ZeroDivide signalWithDividend: 1.
	2 ]
		on: Error - (MessageNotUnderstood , Warning)
		do: [ :exception | 
			wasHandled := true.
			exception return ].

	self
		assert: wasHandled;
		assert: result isNil.	! !

!ExceptionTests methodsFor: 'testing-exceptiontester' stamp: 'md 3/25/2003 23:45'!
testSimpleEnsureTestWithUparrow
	self assertSuccess: (ExceptionTester new runTest: #simpleEnsureTestWithUparrow ) ! !

!ExceptionTests methodsFor: 'testing-exceptiontester' stamp: 'md 3/25/2003 23:48'!
testSimpleRetry
	self assertSuccess: (ExceptionTester new runTest: #simpleRetryTest ) ! !

!ExceptionTests methodsFor: 'testing-exceptiontester' stamp: 'md 3/25/2003 23:44'!
testSignalFromHandlerActionTest
	self assertSuccess: (ExceptionTester new runTest: #signalFromHandlerActionTest ) ! !

!ExceptionTests methodsFor: 'testing-outer' stamp: 'StephaneDucasse 5/28/2011 13:50'!
testResumableOuter

	| result |
	result := [Notification signal. 4] 
		on: Notification 
		do: [:ex | ex outer. ex return: 5].
	self assert: result = 5
! !

!ExceptionTests methodsFor: 'testing-exceptiontester' stamp: 'md 3/25/2003 23:44'!
testNonResumableFallOffTheEndHandler
	self assertSuccess: (ExceptionTester new runTest: #nonResumableFallOffTheEndHandler ) ! !

!ExceptionTests methodsFor: 'testing' stamp: 'brp 10/21/2004 16:41'!
testTimeoutWithZeroDuration
	self assertSuccess: (ExceptionTester new runTest: #simpleTimeoutWithZeroDurationTest ) ! !

!ExceptionTests methodsFor: 'testing-exceptiontester' stamp: 'md 3/25/2003 23:43'!
testDoubleResume
	self assertSuccess: (ExceptionTester new runTest: #doubleResumeTest ) ! !

!ExceptionTests methodsFor: 'testing-exceptiontester' stamp: 'md 3/25/2003 23:41'!
testSimpleOuter
	self assertSuccess: (ExceptionTester new runTest: #simpleOuterTest ) ! !

!ExceptionTests methodsFor: 'testing-handling' stamp: 'GabrielOmarCotelli 11/21/2013 14:38'!
testHandlingWithExclusion

	| wasHandled  |

	wasHandled := false.

	self
		should: [ 
			[ ZeroDivide signalWithDividend: 1 ]
				on: Error - ZeroDivide
				do: [ :exception | 
					wasHandled := true.
					exception return ] ]
		raise: ZeroDivide.
	
	self deny: wasHandled! !

!ExceptionTests methodsFor: 'testing-exceptiontester' stamp: 'md 3/25/2003 23:48'!
testSimpleResume
	self assertSuccess: (ExceptionTester new runTest: #simpleResumeTest ) ! !

!ExclusiveWeakMessageSend commentStamp: 'LaurentLaffont 4/15/2011 20:18'!
See NonReentrantWeakMessageSend!
!ExclusiveWeakMessageSend methodsFor: 'accessing' stamp: 'gvc 10/25/2006 18:07'!
executing
	"Answer from the shared value holder."

	^executing contents! !

!ExclusiveWeakMessageSend methodsFor: 'initialization' stamp: 'gvc 10/25/2006 18:13'!
initialize
	"Initialize the receiver."

	executing := self class newSharedState.
	super initialize.! !

!ExclusiveWeakMessageSend methodsFor: 'accessing' stamp: 'gvc 10/25/2006 18:06'!
executing: aBoolean
	"Set on the shared value holder."

	executing contents: aBoolean! !

!ExclusiveWeakMessageSend methodsFor: 'evaluating' stamp: 'gvc 7/30/2009 13:39'!
basicExecuting: aValueHolder
	"Set the shared value holder."

	executing := aValueHolder! !

!ExclusiveWeakMessageSend class methodsFor: 'as yet unclassified' stamp: 'gvc 10/25/2006 18:13'!
newSharedState
	"Answer a new ValueHolder with false as the contents."

	^ValueHolder new contents: false! !

!Exit commentStamp: '<historical>'!
An Exit is an exception that quit the image without saving with a given success status.

Exit signalFaillure: 'something went wrong'!
!Exit methodsFor: 'accessing' stamp: 'ErwanDouaille 4/8/2013 10:46'!
status
	^ status! !

!Exit methodsFor: 'accessing' stamp: 'ErwanDouaille 4/8/2013 11:07'!
printMessage
	|stderr|
	stderr := VTermOutputDriver stderr.
	self isSuccess ifFalse: [ stderr red ].
	stderr
		nextPutAll: self messageText; lf;
		clear.! !

!Exit methodsFor: 'accessing' stamp: 'CamilloBruni 4/20/2013 19:16'!
defaultAction
 	self messageText isEmpty
		ifFalse: [ self printMessage ].
	Smalltalk exit: self status! !

!Exit methodsFor: 'accessing' stamp: 'ErwanDouaille 4/8/2013 10:46'!
status: anInteger
	status := anInteger .! !

!Exit methodsFor: 'printing' stamp: 'CamilloBruni 5/9/2013 20:10'!
printOn: aStream
	super printOn: aStream.
	aStream space print: self status.! !

!Exit methodsFor: 'testing' stamp: 'ErwanDouaille 4/8/2013 10:47'!
isSuccess
	^self status = 0! !

!Exit class methodsFor: 'instance creation' stamp: 'CamilloBruni 4/8/2013 16:24'!
failure
	^ self status: 1! !

!Exit class methodsFor: 'signalling' stamp: 'ErwanDouaille 4/8/2013 10:52'!
signalSuccess
 	^self success signal! !

!Exit class methodsFor: 'instance creation' stamp: 'CamilloBruni 4/8/2013 16:24'!
success
	^ self status: 0! !

!Exit class methodsFor: 'signalling' stamp: 'ErwanDouaille 4/8/2013 10:53'!
signalSuccess: aMessage 
 	^self success signal: aMessage! !

!Exit class methodsFor: 'signalling' stamp: 'CamilloBruni 4/14/2013 22:27'!
signalFailure: aMessage
 	^ self failure signal: aMessage! !

!Exit class methodsFor: 'instance creation' stamp: 'CamilloBruni 4/8/2013 16:25'!
status: aPositiveInteger
	^ self new
		status: aPositiveInteger;
		yourself! !

!Exit class methodsFor: 'signalling' stamp: 'CamilloBruni 4/14/2013 22:27'!
signalFailure
 	^ self failure signal! !

!ExpanderMorph commentStamp: 'gvc 5/18/2007 13:13'!
A morph that can expand or collapse to show its contents.!
!ExpanderMorph methodsFor: 'operations' stamp: 'gvc 7/27/2006 11:32'!
showMorphs: aBoolean
	"Hide/Show the other morphs."

	self submorphs do: [:m |
		m == self titleMorph ifFalse: [
			m
				visible: aBoolean;
				disableTableLayout: aBoolean not]]! !

!ExpanderMorph methodsFor: 'accessing' stamp: 'GaryChambers 1/25/2011 13:48'!
announcer
	"Answer the receiver's announcer, creating if required."
	
	^ announcer ifNil: [ announcer := Announcer new ]! !

!ExpanderMorph methodsFor: 'updating' stamp: 'GaryChambers 12/6/2011 11:51'!
update: aspect
	"Update the receiver."

	aspect = #expanded
		ifTrue: [self spaceFillWeight: (self expanded
					ifTrue: [1]
					ifFalse: [0]).
				self showMorphs: self expanded.
				self fixLayout.
				self expanded
					ifTrue: [self announce: (ExpanderMorphExpanded on: self)]
					ifFalse: [self announce: (ExpanderMorphContracted on: self)]]! !

!ExpanderMorph methodsFor: 'operations' stamp: 'AlainPlantec 7/9/2013 11:22'!
fixLayout
	"Fix the owner layout, nasty!!"

	self owner ifNil: [ ^ self ].
	self owner
		allMorphsDo: [ :m | 
			(m respondsTo: #resetExtent)
				ifTrue: [ 
					self defer: (MessageSend receiver: m selector: #resetExtent).
					self defer: (MessageSend receiver: m selector: #setScrollDeltas) ].
			(m isKindOf: self class)
				ifTrue: [ self defer: (MessageSend receiver: m selector: #adoptPaneColor) ] ].
	self defer: (MessageSend receiver: self owner selector: #changed)! !

!ExpanderMorph methodsFor: 'accessing' stamp: 'GaryChambers 1/25/2011 13:40'!
announcer: anObject

	announcer := anObject! !

!ExpanderMorph methodsFor: 'accessing' stamp: 'gvc 7/27/2006 10:30'!
titleMorph
	"Answer the value of titleMorph"

	^ titleMorph! !

!ExpanderMorph methodsFor: 'operations' stamp: 'GaryChambers 1/24/2011 13:23'!
expandedSizingRigid
	"Set the vResizing to be (temporarily) #rigid."

	self expanded ifTrue: [self vResizing: #rigid]! !

!ExpanderMorph methodsFor: 'accessing' stamp: 'gvc 9/13/2006 10:30'!
font: aFont
	"Set the title font"

	self titleMorph font: aFont! !

!ExpanderMorph methodsFor: 'operations' stamp: 'GaryChambers 1/25/2011 13:46'!
announce: anAnnouncement
	"see Announcements packages.
	No need to announce if no subscribers."
	
	announcer ifNotNil: [announcer announce: anAnnouncement]! !

!ExpanderMorph methodsFor: 'initialization' stamp: 'GaryChambers 12/8/2011 14:42'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		changeTableLayout;
		listDirection: #topToBottom;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		titleMorph: self defaultTitleMorph;
		expanded: false! !

!ExpanderMorph methodsFor: 'accessing' stamp: 'gvc 7/27/2006 11:23'!
expanded
	"Answer whether the title is expanded."
	
	^self titleMorph expanded! !

!ExpanderMorph methodsFor: 'operations' stamp: 'gvc 7/27/2006 11:24'!
addedMorph: aMorph
	"Notify the receiver that the given morph was just added."

	aMorph == self titleMorph ifFalse: [
		self titleMorph ifNotNil: [
			aMorph
				visible: self expanded;
				disableTableLayout: self expanded not]]! !

!ExpanderMorph methodsFor: 'accessing' stamp: 'gvc 7/27/2006 10:35'!
titleMorph: aMorph
	"Set the value of titleMorph"

	titleMorph ifNotNil: [titleMorph delete; removeDependent: self].
	titleMorph := aMorph.
	aMorph ifNotNil: [
		aMorph addDependent: self.
		 self addMorph: aMorph]! !

!ExpanderMorph methodsFor: 'accessing' stamp: 'gvc 7/27/2006 11:23'!
expanded: aBoolean
	"Set whether the title is expanded."
	
	self titleMorph expanded: aBoolean! !

!ExpanderMorph methodsFor: 'accessing' stamp: 'gvc 9/13/2006 10:29'!
font
	"Answer the title font"

	^self titleMorph font! !

!ExpanderMorph methodsFor: 'operations' stamp: 'MarcusDenker 8/23/2014 11:35'!
titleText: aStringOrText

	self titleMorph titleText: aStringOrText! !

!ExpanderMorph methodsFor: 'initialization' stamp: 'GaryChambers 12/8/2011 16:48'!
defaultTitleMorph
	"Answer a default title morph for the receiver."

	^ExpanderTitleMorph basicNew
		basicTheme: self theme;
		initialize;
		hResizing: #spaceFill;
		vResizing: #shrinkWrap;
		basicTheme: nil! !

!ExpanderMorph class methodsFor: 'as yet unclassified' stamp: 'gvc 7/27/2006 10:54'!
titleText: aStringOrText
	"Answer a new instance of the receiver with the given title text."

	^self new titleText: aStringOrText! !

!ExpanderMorphAnnouncement methodsFor: 'accessing' stamp: 'GaryChambers 1/25/2011 13:32'!
expanderMorph

	^ expanderMorph! !

!ExpanderMorphAnnouncement methodsFor: 'accessing' stamp: 'GaryChambers 1/25/2011 13:32'!
expanderMorph: anObject

	expanderMorph := anObject! !

!ExpanderMorphAnnouncement class methodsFor: 'as yet unclassified' stamp: 'GaryChambers 1/25/2011 13:45'!
on: anExpanderMorph
	"Answer a new announcement for the given expander."

	^self new expanderMorph: anExpanderMorph! !

!ExpanderMorphContracted commentStamp: 'LaurentLaffont 4/15/2011 20:18'!
I am an Announcement that occurs when an ExpanderMorph is contracted (rolled-up).
 
Example where visibility of another UI component depends on the expanded/contracted state of Expander 2
 
|builder expanders ex1 ex2 text list row|
builder := UITheme builder.
expanders := builder newColumn: {
 ex1 := builder newExpander: 'Expander 1'.
 ex2 := builder newExpander: 'Expander 2'}.
expanders
 width: 100;
 hResizing: #rigid.
text := builder
 newTextEditorFor: (ValueHolder new contents: 'Some text')
 getText: #contents setText: #contents:.
list := (builder
 newListFor: (ListModel new list: #('One' 'Two' 'Three' 'Four'); selectionIndex: 3)
 list: #list selected: #selectionIndex changeSelected: #selectionIndex:
 help: 'This is a list')
  minWidth: 120;
  visible: false;
  disableTableLayout: true.
ex2 announcer
 when: ExpanderMorphContracted do: [list hide; disableTableLayout: true];
 when: ExpanderMorphExpanded do: [list show; disableTableLayout: false].
row := builder newRow: {
 expanders.
 (builder newRow: {text. list})
  vResizing: #spaceFill}.!
!ExpanderTitleMorph commentStamp: 'gvc 5/18/2007 13:12'!
The titlebar area for and ExpanderMorph. Includes title label and expand/collapse button.!
!ExpanderTitleMorph methodsFor: 'style' stamp: 'gvc 1/20/2010 11:59'!
themeChanged
	"Update the button corner style from default
	to match the receiver."
	
	super themeChanged.
	self buttonMorph cornerStyle: self cornerStyle! !

!ExpanderTitleMorph methodsFor: 'accessing' stamp: 'GaryChambers 7/27/2011 18:04'!
labelMorph: anObject
	"Set the value of labelMorph.
	need to wrap to provide clipping!!"

	labelMorph ifNotNil: [self removeMorph: labelMorph owner].
	labelMorph := anObject.
	labelMorph ifNotNil: [self addMorph: (
		Morph new
			color: Color transparent;
			changeTableLayout;
			layoutInset: 4 @ 0;
			listDirection: #leftToRight;
			listCentering: #center;
			hResizing: #spaceFill;
			vResizing: #shrinkWrap;
			clipSubmorphs: true;
			addMorph: labelMorph)]! !

!ExpanderTitleMorph methodsFor: 'geometry' stamp: 'GaryChambers 12/21/2011 16:29'!
extent: aPoint 
	"Set the receiver's extent to value provided.
	Update the gradient fills."

	|answer|
	aPoint = self extent ifTrue: [^super extent: aPoint].
	answer := super extent: aPoint.
	self fillStyle isOrientedFill
		ifTrue: [self fillStyle: self normalFillStyle].
	^answer! !

!ExpanderTitleMorph methodsFor: 'private' stamp: 'AlainPlantec 12/17/2009 14:33'!
buttonWidth
	"Answer based on scrollbar size."
	
	^(self theme scrollbarThickness + 3)
		max: self theme expanderTitleControlButtonWidth! !

!ExpanderTitleMorph methodsFor: 'accessing' stamp: 'gvc 1/23/2009 16:30'!
adoptPaneColor: paneColor
	"Update the fill styles, corner styles, label colour
	and expansion button indicator."
	
	super adoptPaneColor: paneColor.
	paneColor ifNil: [^self].
	self fillStyle: self normalFillStyle.
	self borderStyle baseColor: paneColor twiceDarker.
	self buttonMorph cornerStyle: self cornerStyle.
	self labelMorph color: paneColor contrastingColor.
	self changed: #expandLabel! !

!ExpanderTitleMorph methodsFor: 'style' stamp: 'gvc 5/23/2007 14:28'!
normalFillStyle
	"Return the normal fillStyle of the receiver."
	
	^self theme expanderTitleNormalFillStyleFor: self! !

!ExpanderTitleMorph methodsFor: 'operations' stamp: 'gvc 7/27/2006 10:23'!
toggleExpanded
	"Toggle the expanded state."

	self expanded: self expanded not! !

!ExpanderTitleMorph methodsFor: 'instance creation' stamp: 'GaryChambers 7/27/2011 17:10'!
newLabelMorph
	"Answer a new label morph for the receiver."

	^LabelMorph new
		hResizing: #spaceFill;
		vResizing: #shrinkWrap! !

!ExpanderTitleMorph methodsFor: 'initialization' stamp: 'gvc 1/22/2009 15:37'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		expanded: false;
		changeTableLayout;
		borderStyle: self defaultBorderStyle;
		layoutInset: (self theme expanderTitleInsetFor: self);
		listDirection: #leftToRight;
		listCentering: #center;
		wrapCentering: #center;
		buttonMorph: self newExpandButtonMorph;
		addMorph: self buttonMorph;
		labelMorph: self newLabelMorph;
		on: #mouseUp send: #toggleExpanded to: self! !

!ExpanderTitleMorph methodsFor: 'accessing' stamp: 'gvc 9/13/2006 10:23'!
labelMorph
	"Answer the value of labelMorph"

	^ labelMorph! !

!ExpanderTitleMorph methodsFor: 'accessing' stamp: 'gvc 9/13/2006 10:28'!
font: aFont
	"Set the label font"

	((self labelMorph isKindOf: StringMorph) or: [self labelMorph isTextMorph])
		ifTrue: [self labelMorph font: aFont]! !

!ExpanderTitleMorph methodsFor: 'accessing' stamp: 'gvc 1/22/2009 15:37'!
buttonMorph: anObject
	"Set the value of buttonMorph"

	buttonMorph := anObject! !

!ExpanderTitleMorph methodsFor: 'accessing' stamp: 'gvc 9/23/2006 16:46'!
defaultBorderStyle
	"Answer the default border style for the receiver."

	^BorderStyle raised width: 1! !

!ExpanderTitleMorph methodsFor: 'accessing' stamp: 'gvc 7/27/2006 10:16'!
expanded
	"Answer the value of expanded"

	^ expanded! !

!ExpanderTitleMorph methodsFor: 'accessing' stamp: 'gvc 7/27/2006 10:24'!
expanded: aBoolean
	"Set the value of expanded"

	expanded := aBoolean.
	self
		changed: #expanded;
		changed: #expandLabel! !

!ExpanderTitleMorph methodsFor: 'instance creation' stamp: 'gvc 1/22/2009 15:35'!
newExpandButtonMorph
	"Answer a new expand button."

	^(ControlButtonMorph
			on: self
			getState: nil
			action: #toggleExpanded
			label: #expandLabel)
		hResizing: #rigid;
		vResizing: #spaceFill;
		cornerStyle: self cornerStyle;
		extent: self buttonWidth asPoint! !

!ExpanderTitleMorph methodsFor: 'accessing' stamp: 'gvc 9/13/2006 10:29'!
font
	"Answer the label font"

	^((self labelMorph isKindOf: StringMorph) or: [self labelMorph isTextMorph])
		ifTrue: [self labelMorph font]! !

!ExpanderTitleMorph methodsFor: 'operations' stamp: 'gvc 9/13/2006 10:24'!
titleText: aStringOrText
	"Set the text if the title morph is capable."

	((self labelMorph isKindOf: StringMorph) or: [self labelMorph isTextMorph])
		ifTrue: [self labelMorph contents: aStringOrText]! !

!ExpanderTitleMorph methodsFor: 'accessing' stamp: 'gvc 1/22/2009 15:37'!
buttonMorph
	"Answer the value of buttonMorph"

	^ buttonMorph! !

!ExpanderTitleMorph methodsFor: 'operations' stamp: 'gvc 1/31/2009 16:41'!
expandLabel
	"Answer the label for the expand button."

	^AlphaImageMorph new image: (
		ScrollBar
			arrowOfDirection: (self expanded ifTrue: [#top] ifFalse: [#bottom])
			size: self buttonWidth - 3
			color: self paneColor darker)! !

!ExpanderTitleMorph methodsFor: 'protocol' stamp: 'gvc 10/18/2006 11:15'!
titleText
	"Answer the text if the title morph is capable."

	^((self labelMorph isKindOf: StringMorph) or: [self labelMorph isTextMorph])
		ifTrue: [self labelMorph contents]
		ifFalse: ['']! !

!ExpressionEvaluated commentStamp: '<historical>'!
This announcement correspond to code evaluation.  For example, a DoIt or PrintIt evaluated in a workspace raises one of this announcements.!
!ExpressionEvaluated methodsFor: 'temporal for remove' stamp: 'GuillermoPolito 8/2/2012 00:42'!
expression
	^self expressionEvaluated! !

!ExpressionEvaluated methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:42'!
expressionEvaluated
	
	^ expressionEvaluated! !

!ExpressionEvaluated methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:42'!
context: anObject
	
	context := anObject! !

!ExpressionEvaluated methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:42'!
expressionEvaluated: anObject
	
	expressionEvaluated := anObject! !

!ExpressionEvaluated methodsFor: 'temporal for remove' stamp: 'GuillermoPolito 8/2/2012 00:50'!
item
	^expressionEvaluated! !

!ExpressionEvaluated methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:42'!
context
	
	^ context! !

!ExpressionEvaluated class methodsFor: 'instance creation' stamp: 'GuillermoPolito 8/2/2012 00:41'!
expression: theEvaluatedExpression
	^self expression: theEvaluatedExpression context: nil! !

!ExpressionEvaluated class methodsFor: 'instance creation' stamp: 'GuillermoPolito 8/2/2012 00:42'!
expression: theEvaluatedExpression context: anExecutionContext
	^self new
			expressionEvaluated: theEvaluatedExpression;
			context: anExecutionContext;
			yourself! !

!ExternalClipboard commentStamp: 'michael.rueger 3/2/2009 13:25'!
An ExternalClipboard is the abstract superclass for the platform specific clipboards based on the clipboard plugin (former ExtendedClipboardInterface originally developed for Sophie).

Instance Variables
	clipboard:		SmallInteger

clipboard
	- handle for the external clipboard. If 0 the external clipboard is invalid
!
!ExternalClipboard methodsFor: 'initialization' stamp: 'StephaneDucasse 8/30/2009 14:55'!
initialize
	super initialize.
	clipboard := [self createClipboard] on: Error do: [:ex | clipboard := 0]! !

!ExternalClipboard methodsFor: 'primitives' stamp: 'michael.rueger 3/2/2009 13:42'!
primClearClipboard:  aClipboard
	<primitive:'ioClearClipboard' module: 'ClipboardExtendedPlugin'>
	^ self primitiveFailed.
! !

!ExternalClipboard methodsFor: 'primitives' stamp: 'marcus.denker 6/11/2009 12:24'!
primReadClipboardData: aClipboard format: format

	<primitive:'ioReadClipboardData' module: 'ClipboardExtendedPlugin'>
	^ self primitiveFailed! !

!ExternalClipboard methodsFor: 'primitives' stamp: 'michael.rueger 3/25/2009 14:22'!
addClipboardData: data dataFormat: aFormat
	clipboard = 0 ifTrue: 
		[Clipboard clipboardText: data asString.	
		^self].
	self primAddClipboardData: clipboard data: data dataFormat: aFormat! !

!ExternalClipboard methodsFor: 'accessing' stamp: 'michael.rueger 3/25/2009 14:47'!
clipboardText: text 

	| string data |
	string := text asString.
	self noteRecentClipping: text asText.
	contents := text asText.
	data := (string convertToWithConverter: UTF8TextConverter new) asByteArray.
	clipboard = 0 ifTrue: 
		[^super clipboardText: text].
	self clearClipboard.
	self primAddClipboardData: clipboard data: data dataFormat: 'public.utf8-plain-text'! !

!ExternalClipboard methodsFor: 'primitives' stamp: 'michael.rueger 3/2/2009 13:42'!
primCreateClipboard
	<primitive:'ioCreateClipboard' module: 'ClipboardExtendedPlugin'>
	^ self primitiveFailed.
! !

!ExternalClipboard methodsFor: 'accessing' stamp: 'michael.rueger 6/10/2009 13:42'!
clipboardText
	"Return the text currently in the clipboard. If the system clipboard is empty, or if it differs from the Smalltalk clipboard text, use the Smalltalk clipboard. This is done since (a) the Mac clipboard gives up on very large chunks of text and (b) since not all platforms support the notion of a clipboard."

	| decodedString bytes |
	clipboard = 0 ifTrue: 
		[^super clipboardText].
	bytes := self primReadClipboardData: clipboard format: 'public.utf8-plain-text'.
	bytes
		ifNil: [^super clipboardText].
	decodedString := bytes asString convertFromWithConverter: UTF8TextConverter new.
	decodedString := decodedString replaceAll: 10 asCharacter with: 13 asCharacter.
	^decodedString = contents asString
		ifTrue: [contents]
		ifFalse: [decodedString asText].
! !

!ExternalClipboard methodsFor: 'primitives' stamp: 'michael.rueger 3/25/2009 14:25'!
primGetClipboardFormat: aClipboard formatNumber: formatNumber

	<primitive:'ioGetClipboardFormat' module: 'ClipboardExtendedPlugin'>
	^ self primitiveFailed! !

!ExternalClipboard methodsFor: 'accessing' stamp: 'michael.rueger 3/2/2009 13:42'!
clearClipboard
	clipboard = 0 ifTrue: [^self].
	^ self primClearClipboard: clipboard.! !

!ExternalClipboard methodsFor: 'private' stamp: 'michael.rueger 3/2/2009 13:42'!
createClipboard
	clipboard = 0 ifTrue: [^self].
	^ self primCreateClipboard.! !

!ExternalClipboard methodsFor: 'primitives' stamp: 'michael.rueger 3/25/2009 14:25'!
primAddClipboardData: aClipboard data: data dataFormat: aFormat

	<primitive:'ioAddClipboardData' module: 'ClipboardExtendedPlugin'>
	^ self primitiveFailed! !

!ExternalDropHandler commentStamp: 'TorstenBergmann 1/31/2014 10:29'!
Handle a number of dropped files from the OS!
!ExternalDropHandler methodsFor: 'accessing' stamp: ''!
extension
	^extension! !

!ExternalDropHandler methodsFor: 'accessing' stamp: ''!
handle: dropStream in: pasteUp dropEvent: anEvent
	
	^action cull: dropStream 
			cull: pasteUp 
			cull: anEvent
	! !

!ExternalDropHandler methodsFor: 'accessing' stamp: ''!
type
	^type! !

!ExternalDropHandler methodsFor: 'testing' stamp: 'CamilloBruni 5/7/2012 01:19'!
matchesExtension: aExtension
	(self extension isNil or: [aExtension isNil])
		ifTrue: [^false].
	FileSystem disk isCaseSensitive
		ifTrue: [^extension = aExtension]
		ifFalse: [^extension sameAs: aExtension]! !

!ExternalDropHandler methodsFor: 'testing' stamp: ''!
matchesTypes: types
	(self type isNil or: [types isNil])
		ifTrue: [^false].
	^types anySatisfy: [:mimeType | mimeType beginsWith: self type]! !

!ExternalDropHandler methodsFor: 'initialize' stamp: ''!
type: aType extension: anExtension action: anAction 
	action := anAction.
	type := aType.
	extension := anExtension! !

!ExternalDropHandler class methodsFor: 'cleanup' stamp: 'MarcusDenker 7/26/2013 17:00'!
cleanUp
	self resetRegisteredHandlers.! !

!ExternalDropHandler class methodsFor: 'initialization' stamp: 'PavelKrivanek 11/20/2012 21:25'!
initialize
	"ExternalDropHandler initialize"

	self resetRegisteredHandlers.

	! !

!ExternalDropHandler class methodsFor: 'accessing' stamp: 'CamilloBruni 5/23/2012 16:55'!
lookupServiceBasedHandler: dropStream
	"the file was just droped, let's do our job"
	| fileName services theOne |
	fileName := dropStream name.

	services := (Smalltalk tools fileList itemsForFile: fileName asFileReference)
		reject: [:svc | self unwantedSelectors includes: svc selector].

	"no service, default behavior"
	services isEmpty
		ifTrue: [^nil].

	theOne := self chooseServiceFrom: services.
	^theOne
		ifNotNil: [ExternalDropHandler type: nil extension: nil action: [:stream | theOne performServiceFor: stream]]! !

!ExternalDropHandler class methodsFor: 'private' stamp: ''!
chooseServiceFrom: aCollection
	"private - choose a service from aCollection asking the user if  
	needed"
	aCollection size = 1 ifTrue: [^ aCollection anyOne].
	^ UIManager default chooseFrom: (aCollection collect: [:each | 
			each label]) values: aCollection.
! !

!ExternalDropHandler class methodsFor: 'private' stamp: ''!
unwantedSelectors
	"private - answer a collection well known unwanted selectors "
	^ #(#removeLineFeeds: #addFileToNewZip: #compressFile: #putUpdate: )! !

!ExternalDropHandler class methodsFor: 'private' stamp: ''!
resetRegisteredHandlers
	RegisteredHandlers := nil! !

!ExternalDropHandler class methodsFor: 'accessing' stamp: ''!
defaultHandler: externalDropHandler
	DefaultHandler := externalDropHandler! !

!ExternalDropHandler class methodsFor: 'private' stamp: ''!
registeredHandlers
	RegisteredHandlers ifNil: [RegisteredHandlers := OrderedCollection new].
	^RegisteredHandlers! !

!ExternalDropHandler class methodsFor: 'instance creation' stamp: ''!
type: aType extension: anExtension action: anAction 
	^self new type: aType extension: anExtension action: anAction ! !

!ExternalDropHandler class methodsFor: 'accessing' stamp: 'CamilloBruni 5/4/2012 21:26'!
lookupExternalDropHandler: stream

	| types extension serviceHandler |
	types := stream mimeTypes.

	types ifNotNil: [
		self registeredHandlers do: [:handler | 
			(handler matchesTypes: types)
				ifTrue: [^handler]]].

	extension := stream name asFileReference extension.
	self registeredHandlers do: [:handler | 
		(handler matchesExtension: extension)
				ifTrue: [^handler]].
	serviceHandler := self lookupServiceBasedHandler: stream.
	^serviceHandler
		ifNil: [self defaultHandler]! !

!ExternalDropHandler class methodsFor: 'accessing' stamp: ''!
registerHandler: aHandler
	self registeredHandlers add: aHandler! !

!ExternalDropHandler class methodsFor: 'accessing' stamp: ''!
defaultHandler
	DefaultHandler ifNil: [DefaultHandler := ExternalDropHandler type: nil extension: nil action: [:dropStream | dropStream edit]].
	^DefaultHandler! !

!ExternalSemaphoreTable commentStamp: 'HenrikSperreJohansen 8/18/2011 11:25'!
By John M McIntosh johnmci@smalltalkconsulting.com
This class was written to mange the external semaphore table. When I was writing a Socket test server I discovered various race conditions on the access to the externalSemaphore table. This new class uses class side methods to restrict access using two mutex semaphores, one for removal and one for additions to the table. It seemed cleaner to deligate the reponsibility here versus adding more code and another class variable to SystemDictionary 

Note that in Smalltalk recreateSpecialObjectsArray we still directly play with the table.

Henrik Sperre Johansen
The name is somewhat of a misnomer; the table can be used for any objects, not just semaphores.
That is its main usage though, so a split which deals with semaphores and other external objects differently 
(In the same underlying table) is not currently worth it.
Therefore, while in general not all users will care if the table is above a certain size, we still guard  against adding more objects than the limit above which external signals would be lost (on some VMs.)
!
!ExternalSemaphoreTable class methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 8/17/2011 14:55'!
registerExternalObject: anObject
	^ ProtectAdd critical: [self safelyRegisterExternalObject: anObject]
! !

!ExternalSemaphoreTable class methodsFor: 'private' stamp: 'HenrikSperreJohansen 8/16/2011 14:45'!
unprotectedExternalObjects
	^Smalltalk specialObjectsArray at: 39! !

!ExternalSemaphoreTable class methodsFor: 'initialize' stamp: 'HenrikSperreJohansen 8/17/2011 14:54'!
initialize
	ProtectAdd := Semaphore forMutualExclusion.
	ProtectRemove := Semaphore forMutualExclusion! !

!ExternalSemaphoreTable class methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 8/17/2011 14:55'!
unregisterExternalObject: anObject
	ProtectRemove critical: [self safelyUnregisterExternalObject: anObject]
! !

!ExternalSemaphoreTable class methodsFor: 'private' stamp: 'HenrikSperreJohansen 8/18/2011 10:33'!
collectionBasedOn: externalObjects withRoomFor: anObject
	"Called if no slots to put anObject in have been found in externalObjects "
	"Return a externalObject collection which does, either:
		- Same collection with some slots freed up by finalization logic
		- A larger array, which has replaced the parameter as canonical externalObject array.
	An error must be raised if this method is incapable of fulfilling its duties"
	
	| newObjects newSize |
	"grow linearly"
	newSize :=  externalObjects size +20.
	(self freedSlotsIn: externalObjects ratherThanIncreaseSizeTo: newSize) 
		ifTrue: [newObjects := externalObjects]
		ifFalse: [
			newObjects := externalObjects species new: newSize. 
			newObjects replaceFrom: 1 to:  externalObjects size with: externalObjects startingAt: 1.	
			self unprotectedExternalObjects: newObjects.].
	^newObjects! !

!ExternalSemaphoreTable class methodsFor: 'private' stamp: 'HenrikSperreJohansen 8/16/2011 14:45'!
unprotectedExternalObjects: aCollection
	^Smalltalk specialObjectsArray at: 39 put: aCollection! !

!ExternalSemaphoreTable class methodsFor: 'private' stamp: 'ClementBera 4/11/2013 14:06'!
slotFor: anObject in: aCollection
	"find the first empty slot, or nil if there is none"

	"The following was written in an atomic fashion using special methods with no suspension points, not sure if on purpose, but keeping it that way for now.
	Uses should be protected by the ProtectTable semaphore anyhow, but... it's too much work to reason 100% about it"

	| firstEmptyIndex |
	1 to: aCollection size do: [ :i | 
		| obj |
		obj := aCollection at: i.
		obj == anObject
			ifTrue: [ ^ i ].	"object already there, just return its index"
		(firstEmptyIndex isNil and: [ obj isNil ])
			ifTrue: [ firstEmptyIndex := i ] ].
	^ firstEmptyIndex! !

!ExternalSemaphoreTable class methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 8/18/2011 10:18'!
clearExternalObjects
	"Clear the array of objects that have been registered for use in non-Smalltalk code."
	"Only lock additions, removals executing in parallel would have little effect on the resulting array"

	ProtectAdd critical: [
		self unprotectedExternalObjects: Array new].
! !

!ExternalSemaphoreTable class methodsFor: 'private' stamp: 'SvenVanCaekenberghe 11/18/2013 16:20'!
freedSlotsIn: externalObjects ratherThanIncreaseSizeTo: newSize
	"In some VM's, the external object table has a max size, which has to be increased for vm to reference them correctly."
	"In that case, try to gc to free slots first before actually increasing the max size"
	"Return whether I ended up freeing slots by GC'ing, or one should increase the size of "
	^Smalltalk vm maxExternalSemaphores
		ifNotNil: [:maxSize |
			(maxSize < newSize) and: 
				[| needToGrow |
				Smalltalk garbageCollect.
				"Do we have free slots now? If not, performing the GC didn't help and we still have to grow."
				needToGrow := externalObjects includes: nil.
				
				needToGrow 
					ifTrue: ["If we did GC, warn we had to gc so actions could be taken if appropriate."
						self traceCr: DateAndTime now printString;
							traceCr:  'WARNING:  Had to GC to make room for more external objects.';
							traceCr: 'If this happens often, it would be a good idea to either:';
							traceCr: '- Raise the maxExternalObjects size.';
							traceCr: '- Write your code to explicitly release them rather than wait for finalization.']
					ifFalse:  [Smalltalk vm maxExternalSemaphores: newSize].
				needToGrow]]
		ifNil:[false]! !

!ExternalSemaphoreTable class methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 7/15/2011 15:30'!
safelyUnregisterExternalObject: anObject
	"Unregister the given object in the external objects array. Do nothing if it isn't registered.
	JMM change to return if we clear the element, since it should only appear once in the array"

	| objects |
	anObject ifNil: [^ self].
	objects := self unprotectedExternalObjects.
	1 to: objects size do: [:i |
		(objects at: i) == anObject ifTrue: 
		[objects at: i put: nil.
		^self]].
! !

!ExternalSemaphoreTable class methodsFor: 'accessing' stamp: 'ClementBera 4/11/2013 14:01'!
safelyRegisterExternalObject: anObject
	"Register the given object in the external objects array and return its index. If it is already there, just return its index."

	| objects firstEmptyIndex |
	objects := self unprotectedExternalObjects.

	"find the first empty slot"
	firstEmptyIndex := 
		(self slotFor: anObject in: objects) 
			ifNil: ["if object has no empty slots,  we need to get a collection which does"
				objects := self collectionBasedOn: objects withRoomFor: anObject.
				self slotFor: anObject in: objects.].
	objects at: firstEmptyIndex put: anObject.
	^ firstEmptyIndex
! !

!ExternalSemaphoreTable class methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 8/18/2011 10:42'!
externalObjects
	"Not really sure why this is protected, once called you are out of protection of the locks anyways, and any use of the object is dangerous...
	Only additions can potentially change the actual array in use though, so only lock that."
	^ProtectAdd critical: [self unprotectedExternalObjects].! !

!EyeAbstractInspector commentStamp: '<historical>'!
I am the abstract superclass for all kind of inspectors!
!EyeAbstractInspector methodsFor: 'initialization' stamp: 'CamilloBruni 10/15/2013 17:25'!
initializeShortcuts
	"override to add custom shortcuts to your model"! !

!EyeAbstractInspector methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
object

	^ object value! !

!EyeAbstractInspector methodsFor: 'event-handling' stamp: 'CamilloBruni 9/20/2013 20:39'!
close
	"Override in sublcasses for special actions"! !

!EyeAbstractInspector methodsFor: 'event-handling' stamp: 'CamilloBruni 9/20/2013 18:25'!
objectChanged
	"triggered when the inspected object is changed"
	self subclassResponsibility! !

!EyeAbstractInspector methodsFor: 'api' stamp: 'CamilloBruni 2/25/2014 18:39'!
labelFor: anEyeElement error: error
	^ 'Error while accessing label of ', anEyeElement accessorCode printString! !

!EyeAbstractInspector methodsFor: 'event-handling' stamp: 'CamilloBruni 10/15/2013 18:25'!
ownerChanged
	self
		customMenuActions: self owner customMenuActions;
		takeKeyboardFocus! !

!EyeAbstractInspector methodsFor: 'actions' stamp: ''!
browseSelectedObjectClass
	self selectedObjectDo: [ :anObject | Smalltalk tools browser newOnClass: anObject class ]! !

!EyeAbstractInspector methodsFor: 'testing' stamp: 'CamilloBruni 10/15/2013 18:11'!
hasSelectedObject
	^ self selectedElement isNotNil! !

!EyeAbstractInspector methodsFor: 'accessing' stamp: 'CamilloBruni 10/15/2013 18:26'!
customMenuActions: anObject
	customMenuActions := anObject! !

!EyeAbstractInspector methodsFor: 'initialization' stamp: 'CamilloBruni 10/15/2013 17:12'!
shortCuts
	"Answers a dictionary of the shortcuts usable in EyeInspector"

	|shortCuts|

	shortCuts := Dictionary new.
	
	shortCuts at: $d command put: [ self diveIntoSelectedObject ].
	
	shortCuts at: $i command put: [ self inspectSelectedObjectInNewWindow ].
	shortCuts at: $i command shift put: [ self exploreSelectedObject ].
	
	shortCuts at: $b command put: [ self browseSelectedObject ].
	shortCuts at: $h command put: [ self browseSelectedObjectClassHierarchy ].
	
	^shortCuts! !

!EyeAbstractInspector methodsFor: 'initialization' stamp: 'DucasseStephane 9/10/2014 09:59'!
initialize

	"The inspected object will be stored in the valueObject object to be able to use WhenObjectChanged:"
	
	object := nil asValueHolder.
	super initialize.
! !

!EyeAbstractInspector methodsFor: 'accessing' stamp: 'CamilloBruni 10/15/2013 17:05'!
selectedObject
	^ self subclassResponsibility! !

!EyeAbstractInspector methodsFor: 'accessing' stamp: 'CamilloBruni 9/20/2013 22:47'!
title
	^ self object class printString! !

!EyeAbstractInspector methodsFor: 'initialization' stamp: 'CamilloBruni 10/15/2013 17:32'!
initializePresenter
	
	object whenChangedDo: [ self objectChanged ].
	self initializeShortcuts.! !

!EyeAbstractInspector methodsFor: 'accessing' stamp: 'CamilloBruni 9/20/2013 19:24'!
inspect: anObject 
	self object: anObject.
	! !

!EyeAbstractInspector methodsFor: 'actions' stamp: ''!
inspectInNewWindow: anObject

	anObject inspect! !

!EyeAbstractInspector methodsFor: 'actions' stamp: ''!
browseSelectedObject
	self selectedObjectDo: [ :anObject | anObject browse ]! !

!EyeAbstractInspector methodsFor: 'accessing' stamp: 'NicolaiHess 6/15/2014 21:54'!
text
	^ text ifNil: [ 
		text := self instantiate: TextModel.
		text aboutToStyle: true. ]! !

!EyeAbstractInspector methodsFor: 'menu' stamp: 'StephaneDucasse 10/22/2014 21:31'!
refreshSubMenu: aMenu
	"Add a refresh button in the inspector. Not used anymore since there is this loop in initializeInspectorLoop."

	aMenu 
		add: 'Refresh Inspector'
		target: self
		selector: #refresh.	
	aMenu addLine.
	! !

!EyeAbstractInspector methodsFor: 'private-focus' stamp: 'CamilloBruni 10/15/2013 18:26'!
takeKeyboardFocus
	super takeKeyboardFocus! !

!EyeAbstractInspector methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
object: anObject

	object value: anObject! !

!EyeAbstractInspector methodsFor: 'accessing' stamp: 'abc 10/18/2013 14:54'!
selectedObjectDo: aBlock
	self selectedElement ifNotNil: [ :element |
		aBlock value: element value ]! !

!EyeAbstractInspector methodsFor: 'actions' stamp: 'CamilloBruni 10/15/2013 18:19'!
diveIntoSelectedObject
	self selectedObjectDo: [ :anObject | self diveInto: anObject ]! !

!EyeAbstractInspector methodsFor: 'event-handling' stamp: 'BenjaminVanRyseghem 11/8/2013 17:52'!
diveInto: anObject
	self owner ifNotNil: [ :navigator | 
		(navigator respondsTo: #diveInto:)
			ifTrue: [ ^ navigator diveInto: anObject ] ].
		
	self inspectInNewWindow: anObject.! !

!EyeAbstractInspector methodsFor: 'initialization' stamp: 'CamilloBruni 9/21/2013 14:35'!
initializeWidgets! !

!EyeAbstractInspector methodsFor: 'menu' stamp: 'CamilloBruni 10/15/2013 18:29'!
inspectionMenu: aMenu
	
	self hasSelectedObject ifFalse: [ ^ aMenu ].
	self inspectionSubMenu: aMenu.
	self selectedElement inspectionMenu: aMenu.
	^aMenu! !

!EyeAbstractInspector methodsFor: 'accessing' stamp: 'MarcusDenker 12/2/2013 14:06'!
selectedElementDo: aBlock
	self selectedElement ifNotNil: aBlock! !

!EyeAbstractInspector methodsFor: 'menu' stamp: 'BenjaminVanRyseghem 11/1/2013 15:50'!
inspectionSubMenu: aMenu

	aMenu addGroup: [:aGroup |
		aGroup addItem: [ :item |
			item
				name: 'Inspect' translated;
				action: [ self inspectSelectedObjectInNewWindow ];
				shortcut: $i command mac | $i alt win | $i alt unix ].
		aGroup addItem: [ :item |
			item
				name: 'Explore' translated;
				action: [ self exploreSelectedObject ];
				shortcut: $i shift command mac | $i shift alt win | $i shift alt unix ].

	self customMenuActions cull: aMenu cull: aGroup.
			
	]! !

!EyeAbstractInspector methodsFor: 'accessing' stamp: 'CamilloBruni 9/21/2013 16:08'!
variants
	| variants defaultInspectorClass |
	
	variants := OrderedCollection new.
	defaultInspectorClass := self object class inspectorClass.
	
	variants add: defaultInspectorClass. 
	"We only need the basic inspector if we modify something"
	defaultInspectorClass = Object inspectorClass
		ifFalse: [  variants add: EyeBasicInspector ].
	variants add: EyeTreeInspector.
	variants addAll: self object class additionalInspectorClasses. 
	^ variants! !

!EyeAbstractInspector methodsFor: 'actions' stamp: ''!
browseSelectedObjectClassHierarchy
	self selectedObjectDo: [ :anObject | anObject class browseHierarchy ]! !

!EyeAbstractInspector methodsFor: 'accessing' stamp: 'CamilloBruni 10/15/2013 18:26'!
customMenuActions
	^ customMenuActions ifNil: [ customMenuActions := [  ] ]! !

!EyeAbstractInspector methodsFor: 'accessing' stamp: 'CamilloBruni 10/15/2013 18:11'!
selectedElement
	"return the currently selected object wrapper / eye-element"
	^ self subclassResponsibility! !

!EyeAbstractInspector methodsFor: 'actions' stamp: ''!
exploreSelectedObject
	self selectedObjectDo: [ :anObject | anObject explore ].! !

!EyeAbstractInspector methodsFor: 'actions' stamp: ''!
inspectSelectedObjectInNewWindow
	self selectedObjectDo: [ :anObject | self inspectInNewWindow: anObject ].! !

!EyeAbstractInspector class methodsFor: 'spec' stamp: 'CamilloBruni 9/20/2013 20:31'!
debuggerSpec
	<spec:#default>
	^ self inspectorSpec! !

!EyeAbstractInspector class methodsFor: 'accessing' stamp: 'CamilloBruni 9/20/2013 20:10'!
taskbarIcon
	^ Smalltalk ui icons smallInspectItIcon! !

!EyeAbstractInspector class methodsFor: 'accessing' stamp: 'CamilloBruni 9/20/2013 18:37'!
label
	"Override to return a proper label displayd in the inspector choice"
	^ self name! !

!EyeAbstractInspector class methodsFor: 'spec' stamp: 'CamilloBruni 9/20/2013 20:30'!
inspectorSpec
	<spec>
	self subclassResponsibility! !

!EyeBagInspector commentStamp: '<historical>'!
Specialized version of inspector showing occurrences of items of the bag!
!EyeBagInspector methodsFor: 'list' stamp: 'ClementBera 8/12/2013 10:33'!
sortedKeys

	^ [ [ self object valuesAndCounts keys sorted ] 
		on: Error 
		do: [ "case of non sortable keys" self object valuesAndCounts keys ] 
			] on: Error do: [ #() ]! !

!EyeBagInspector methodsFor: 'list' stamp: 'ClementBera 8/12/2013 10:35'!
addVariableFields: elements

	self sortedKeys do: [ :key |
		elements add: (BagEyeElement host: self object index: key)]! !

!EyeBasicInspector commentStamp: '<historical>'!
I am a special inspector that only lists the real fields of an object. I have exactly the same behavior as my superclass but I am used as a placeholder for the the different inspector views in the InspectorNavigator.!
!EyeBasicInspector class methodsFor: 'accessing' stamp: 'CamilloBruni 9/20/2013 18:39'!
label
	^ 'Basic Inspector'! !

!EyeByteArrayInspector commentStamp: '<historical>'!
Specialized version of inspector showing the hex and string representation of the byte array in some variations.
!
!EyeByteArrayInspector methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 12/21/2013 20:50'!
objectAsLatin1String
	| width str |
	str := String
		new:
			(width := self object size < 5000
				ifTrue: [ self object size ]
				ifFalse: [ 5000 ]).
	str replaceFrom: 1 to: str size with: (self object copyFrom: 1 to: width).
	^ str! !

!EyeByteArrayInspector methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 12/21/2013 20:56'!
objectAsHexBytes
	^ String
		streamContents: [ :s | 
			s nextPutAll: '['.
			self object 
				do: [ :each | s << (each printPaddedWith: $0 to: 2 base: 16) ] 
				separatedBy: [ s nextPut: $  ].
			s nextPut: $] ]
		limitedTo: 5000! !

!EyeByteArrayInspector methodsFor: 'list' stamp: 'SvenVanCaekenberghe 2/25/2014 09:03'!
addSpecialFields: elements
	elements add: (DynamicEyeElement 
		host: self object 
		label: 'hex bytes' 
		description: [ self objectAsHexBytes ]
		value: [ self object ]).
	elements add: (DynamicEyeElement 
		host: self object 
		label: 'hex string' 
		value: [ self objectAsHexString ]).
	elements add: (DynamicEyeElement 
		host: self object 
		label: 'latin-1 string' 
		value: [ self objectAsLatin1String ]).
	elements add: (DynamicEyeElement 
		host: self object 
		label: 'utf-8 string' 
		value: [ 
			[ self objectAsUTF8String ] 
				on: ZnInvalidUTF8 
				do: [ :exception | exception asString ] ]).! !

!EyeByteArrayInspector methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 12/21/2013 21:01'!
objectAsUTF8String
	^ String
		streamContents: [ :out | 
			| in encoder |
			encoder := ZnUTF8Encoder new.
			in := self object readStream.
			[ in atEnd ] whileFalse: [ 
				out nextPut: (encoder nextFromStream: in) ] ]
		limitedTo: 5000! !

!EyeByteArrayInspector methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 12/21/2013 20:56'!
objectAsHexString
	^ String
		streamContents: [ :s | 
			self object do: [ :each | s << (each printPaddedWith: $0 to: 2 base: 16) ] ]
		limitedTo: 5000! !

!EyeCharacterInspector commentStamp: 'SvenVanCaekenberghe 2/24/2014 14:44'!
I am  EyeCharacterInspector.
I am a EyeInspector.

I offer a specialized inspector to look at Character instances. 

I show the Unicode code point in standard notation, like U+0041 for $A.
!
!EyeCharacterInspector methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 2/24/2014 14:51'!
objectAsUnicodeCodePoint
	^ String streamContents: [ :stream | 
			stream << 'U+'.
			self object codePoint 
				printOn: stream base: 16 nDigits: 4 ]! !

!EyeCharacterInspector methodsFor: 'list' stamp: 'SvenVanCaekenberghe 2/25/2014 09:01'!
addSpecialFields: elements

	elements add: (DynamicEyeElement 
		host: self object 
		label: 'unicode' 
		description: [ self objectAsUnicodeCodePoint ]
		value: [ self object codePoint ])! !

!EyeCollectionInspector commentStamp: '<historical>'!
Specialized version of inspector showing the size of the inspected collection in title.!
!EyeCollectionInspector methodsFor: 'list' stamp: 'ClementBera 5/3/2013 14:00'!
addInstancesVariable: elements
	"Do nothing"! !

!EyeCollectionInspector methodsFor: 'accessing' stamp: 'ClementBera 6/25/2013 14:25'!
objectVariableSize
	^ [ self object size ] on: Error do: [ self object basicSize ]! !

!EyeCollectionInspector methodsFor: 'list' stamp: 'ClementBera 4/30/2013 16:03'!
addVariableFields: elements
	"add the variable fields to the inspector. Shorten the list for very long collection (cf limit1 and limit2), set them so that you can modify and save them"

	self variableFieldsToShow do: [ :index |
		elements add: (IndexedEyeElement host: self object index: index) ]! !

!EyeCollectionInspector methodsFor: 'accessing' stamp: 'ClementBera 3/7/2014 11:54'!
title
	^ super title, ' [', self objectVariableSize asString, ']' ! !

!EyeCollectionInspector methodsFor: 'list' stamp: 'ClementBera 5/3/2013 14:00'!
addAllInstVars: elements
	"Do nothing"! !

!EyeCollectionInspector class methodsFor: 'accessing' stamp: 'CamilloBruni 9/20/2013 21:13'!
label
	^ 'Collection Inspector'! !

!EyeCompiledMethodInspector commentStamp: '<historical>'!
Specialized version of inspector showing bytecodes symbolic representation, ast, ir, literals.!
!EyeCompiledMethodInspector methodsFor: 'list' stamp: 'ClementBera 5/2/2013 10:23'!
addInstancesVariable: elements
	"Do nothing"! !

!EyeCompiledMethodInspector methodsFor: 'list' stamp: 'ClementBera 5/3/2013 14:17'!
addVariableFields: elements
	
	self object initialPC to: self object size do: [ :index |
		elements add: (DynamicEyeElement 
				host: self object 
				label: 'bc ', index asString 
				value: (self object at: index) asString)].! !

!EyeCompiledMethodInspector methodsFor: 'accessing' stamp: 'CamilloBruni 9/21/2013 20:06'!
title
	^ self object printString ! !

!EyeCompiledMethodInspector methodsFor: 'list' stamp: 'ClementBera 5/2/2013 10:51'!
addSpecialFields: elements

	elements add: (DynamicEyeElement 
			host: self object 
			label: 'ast' 
			value: [ self object ast ]).
			
	elements add: (DynamicEyeElement 
			host: self object 
			label: 'ir' 
			description: [ :value | | string |
				string := value longPrintString.
				string copyFrom: 2 to: string size ]
			value: [ self object ir ]).

	elements add: (DynamicEyeElement 
			host: self object 
			label: 'all bytecodes' 
			value: [ self object symbolic ]).

	elements add: (DynamicEyeElement 
			host: self object 
			label: 'header' 
			value: [ self object headerDescription ]).
			
	self object literals withIndexDo: [ :literal :index|
		elements add: (DynamicEyeElement 
				host: self object 
				label: 'literal ', index asString 
				value: literal) ].
			! !

!EyeCompiledMethodInspector methodsFor: 'list' stamp: 'ClementBera 5/2/2013 10:22'!
addAllInstVars: elements
	"Useless for compiledMethod"! !

!EyeCompiledMethodInspector class methodsFor: 'accessing' stamp: 'CamilloBruni 9/20/2013 21:13'!
label
	^ 'Compiled Method Inspector'! !

!EyeDateAndTimeInspector commentStamp: '<historical>'!
I am EyeDateAndTimeInspector.
I am an EyeInspector.

I am a specialized Inspector for DateAndTime.
I show  all individual elements by name, as well as a UTC representation.!
!EyeDateAndTimeInspector methodsFor: 'list' stamp: 'SvenVanCaekenberghe 2/25/2014 09:05'!
addSpecialFields: elements

	elements add: (DynamicEyeElement 
		host: self object 
		label: 'year' 
		value: [ self object year ]).
			
	elements add: (DynamicEyeElement 
		host: self object 
		label: 'month of year' 
		value: [ self object monthIndex ]).
			
	elements add: (DynamicEyeElement 
		host: self object 
		label: 'day of month' 
		value: [ self object dayOfMonth ]).
		
	elements add: (DynamicEyeElement 
		host: self object 
		label: 'full hours' 
		value: [ self object hours ]).
			
	elements add: (DynamicEyeElement 
		host: self object 
		label: 'full minutes' 
		value: [ self object minutes ]).
			
	elements add: (DynamicEyeElement 
		host: self object 
		label: 'full seconds' 
		value: [ self object seconds ]).
		
	elements add: (DynamicEyeElement 
		host: self object 
		label: 'utc' 
		value: [ self object asUTC ])! !

!EyeDebuggerContextInspector commentStamp: '<historical>'!
Specific context inspector for the bottom right of the debugger!
!EyeDebuggerContextInspector methodsFor: 'list' stamp: 'NicolaiHess 9/2/2014 21:58'!
generateElements
	"generate the collection of elements to show in the inspector for the object inspected"

	| elements |
	elements := OrderedCollection new.
	self addSelf: elements.
	"only if object is not nil this elements are retrievable"
	self object
		ifNotNil: [ 
			self addStackTop: elements.
			self addAllInstVars: elements.
			self addSpecialFields: elements.
			self addInstancesVariable: elements.
			self addVariableFields: elements ].
	^ elements! !

!EyeDebuggerContextInspector methodsFor: 'list' stamp: 'ClementBera 5/3/2013 13:31'!
addInstancesVariable: elements
	"Do nothing"! !

!EyeDebuggerContextInspector methodsFor: 'list' stamp: 'ClementBera 8/5/2013 10:44'!
addSpecialFields: elements
	
	elements add: (DynamicEyeElement 
		host: self object 
		label: 'all temp vars' 
		value: [ String streamContents: [ :s | 
					self object tempNames withIndexDo: [ :name :index | 
						s 
							nextPutAll: name ;
							nextPut: Character space ;
							nextPut: $: ;
							nextPut: Character space ;
							nextPutAll: (self object namedTempAt: index) asString ;
							nextPut: Character lf ] ] ]).! !

!EyeDebuggerContextInspector methodsFor: 'list' stamp: 'abc 10/18/2013 14:09'!
addStackTop: elements

	elements add: (DynamicEyeElement 
			host: self object 
			label: 'stackTop' 
			value: [ self object stackPtr > 0 ifTrue: [ self object top ] ifFalse: [ #emptyStack ] ] ).! !

!EyeDebuggerContextInspector methodsFor: 'list' stamp: 'ClementBera 9/11/2013 08:44'!
addSelf: elements
	"Add self to the list of elements you can access in the inspector with the label thisContext"

	elements add: (ThisContextEyeElement host: self object).! !

!EyeDebuggerContextInspector methodsFor: 'list' stamp: 'ClementBera 5/3/2013 13:32'!
addAllInstVars: elements
	"Do nothing"! !

!EyeDictionaryInspector commentStamp: '<historical>'!
Specialized version of inspector showing keys on left panel and values on description panel!
!EyeDictionaryInspector methodsFor: 'accessing' stamp: 'MarcusDenker 10/7/2013 21:24'!
sortedKeys

	^ [ [ self object keys sort ] 
		on: Error 
		do: [ "case of non sortable keys" self object keys ]
			] on: Error do: [ #() ]! !

!EyeDictionaryInspector methodsFor: 'list' stamp: 'ClementBera 6/25/2013 14:42'!
addVariableFields: elements

	self sortedKeys do: [ :key |
		elements add: (IndexedEyeElement host: self object index: key)]! !

!EyeEditor commentStamp: '<historical>'!
I am an abstract view model for editors displayed in the inspector!
!EyeEditor class methodsFor: 'accessing' stamp: 'CamilloBruni 9/21/2013 20:16'!
label
	^ 'Default Editor'! !

!EyeFileSystemInspector commentStamp: '<historical>'!
I am an inspector dedicated to the visualization of file systems!
!EyeFileSystemInspector methodsFor: 'api' stamp: 'MarcusDenker 10/5/2013 21:58'!
childrenForObject: aFileReference
	aFileReference isDirectory ifFalse: [^#()].
	^ aFileReference children collect: [ :each |
		DynamicEyeElement
			host: aFileReference
			value: each
		 ]! !

!EyeFileSystemInspector methodsFor: 'api' stamp: 'MarcusDenker 10/5/2013 22:01'!
roots
	^ self childrenForObject: self object! !

!EyeFileSystemInspector class methodsFor: 'accessing' stamp: 'MarcusDenker 10/5/2013 22:00'!
label
	^ 'FileReference Tree Inspector'! !

!EyeFloatInspector commentStamp: '<historical>'!
I am EyeFloatInspector.
I am an EyeInspector.

I am a specialized Inspector for Floats.
I add extra elements (sign, significand, exponent) of the Float object that I am inspecting.

Note that these should be interpreted as

sign * significand * (2 raisedToInteger: exponent)!
!EyeFloatInspector methodsFor: 'list' stamp: 'KrisGybels 10/22/2014 17:41'!
addSpecialFields: elements

	elements add: (DynamicEyeElement 
		host: self object 
		label: 'sign' 
		value: [ self object sign ]).
			
	elements add: (DynamicEyeElement 
		host: self object 
		label: 'significand' 
		value: [ self object significand ]).
			
	elements add: (DynamicEyeElement 
		host: self object 
		label: 'exponent' 
		value: [ self object exponent ]).

	elements add: (DynamicEyeElement
		host: self object
		label: 'binary'
		value: [ self object binaryLiteralString ]).
! !

!EyeInspector commentStamp: 'MarcusDenker 1/17/2014 13:44'!
To do a specific inspector subclass this and override 	EyeInspector>>addSpecialFields
Then on your object override
	Object>>inspectorClass
so it returns your new inspector!
!EyeInspector methodsFor: 'event-handling' stamp: 'BenComan 4/13/2014 02:43'!
updateList
	"update the list of elements displayed according to the new object"

	| elements |
"	self haltOnce."
	elements := self generateElements.	
	self list getItems = elements ifTrue: [ ^ self ].
	"first reset the items to make sure we don't interfere with the display block"
	self list items: #().
	self list
		displayBlock: [ :eyeElement :index | 
			self labelFor: (elements at: index ifAbsent: [ InstanceVariableEyeElement host: nil ]) ].
	self list items: elements.
	
	"handle when last item of list is removed"
	(self list selectedIndex > self list getItems size) ifTrue: [ self list setSelectedIndex: self list getItems size  ].
	
	"handle when selected dictionary key is removed"
	self list setSelectedIndex: self list selectedIndex.
	
	self list menu: [ :aMenu | self inspectionMenu: aMenu ]! !

!EyeInspector methodsFor: 'accessing' stamp: 'ClementBera 4/30/2013 14:25'!
doItContext
	"Define a context where the DoIt method of the inspector should be done. To be overrriden in subclasses"
	^ nil! !

!EyeInspector methodsFor: 'initialization' stamp: 'CamilloBruni 10/15/2013 17:24'!
initializeShortcuts
	"initialize the inspector' shortcuts with the dictionary defined in self shortCuts"
	self shortCuts keysAndValuesDo: [ :key :value |
		self list bindKeyCombination: key toAction: value ]
! !

!EyeInspector methodsFor: 'accessing' stamp: 'ClementBera 3/12/2013 14:16'!
description
	^ description! !

!EyeInspector methodsFor: 'event-handling' stamp: 'MarcusDenker 9/5/2013 12:51'!
saveElement
	"When you press Cmd+s on the description TextModel, you can save the new value in the inspected object"

	|newValue|
		
	newValue := description doItReceiver class compiler		
		source: description text readStream;
		context: nil "should be object in case of methodContext";
		receiver:  description doItReceiver;
		failBlock: [^ self];
		evaluate.
		
	self selectedElement save: newValue.
	self objectChanged! !

!EyeInspector methodsFor: 'list' stamp: 'SvenVanCaekenberghe 3/14/2014 10:33'!
generateElements
	"generate the collection of elements to show in the inspector for the object inspected"

	| elements |
	elements := OrderedCollection new.

	self addSelf: elements.
	self showClass ifTrue: [ self addClass: elements ].
	self showAllInstVars ifTrue: [ self addAllInstVars: elements ].
	self addSpecialFields: elements.
	self addInstancesVariable: elements.
	self addVariableFields: elements.
	
	^ elements! !

!EyeInspector methodsFor: 'event-handling' stamp: 'ClementBer 10/18/2013 16:25'!
objectChanged
	"triggered when the inspected object is changed"
	
	self updateList.
	
	self text doItReceiver: self object. 
	self description doItReceiver: self object.
	  
	self text doItContext: self doItContext. 
	self description doItContext: self doItContext.
	
	! !

!EyeInspector methodsFor: 'list' stamp: 'ClementBera 7/8/2014 15:53'!
limit1
	"This is the max index shown before skipping to the 
	last limit2 elements of very long arrays"
	
	^ 100! !

!EyeInspector methodsFor: 'accessing' stamp: 'CamilloBruni 5/2/2013 21:33'!
selectedObject
	^self selectedElement value! !

!EyeInspector methodsFor: 'initialization' stamp: 'CamilloBruni 10/15/2013 16:58'!
shortCuts
	| shortCuts |
	shortCuts := super shortCuts.

	shortCuts at: $c command put: [ self copySelectedItemAccessorCode ].
	
	^ shortCuts! !

!EyeInspector methodsFor: 'event-handling' stamp: 'CamilloBruni 2/25/2014 18:59'!
refreshDescription: item
	"When you select an element in the list of the inspector, print on the description textModel the element selected"
	| newDescription |
	item ifNil: [ ^ self ].
	
	newDescription := ([ item description ] on: Error do: [ 'Error while printing ', item accessorCode ]).
	
	description text = newDescription
		ifTrue: [ ^ self ].
		
	self 
		keepScrollPositionOf: description 
		during: [ description text: newDescription ].! !

!EyeInspector methodsFor: 'accessing' stamp: 'CamilloBruni 9/14/2013 17:13'!
printTimeout
	^ 10 seconds! !

!EyeInspector methodsFor: 'list' stamp: 'ClementBera 4/30/2013 14:23'!
addSpecialFields: elements
	"Override in subclass to add fields to the inspector. You need to choose the appropriate sublcass of AbstractEyeElement"
	
	"ex :
	elements add: (AbstractEyeElement host: self object)"! !

!EyeInspector methodsFor: 'event-handling' stamp: 'BenjaminVanRyseghem 10/1/2013 13:37'!
keepScrollPositionOf: specHolder during: aBlock
	| scrollValue |
	specHolder widget 
		ifNil: [ ^ aBlock value ].
		
	scrollValue := description scrollValue.
	aBlock value.
	description scrollValue: scrollValue.! !

!EyeInspector methodsFor: 'accessing' stamp: 'ClementBera 3/12/2013 14:16'!
description: anObject
	description := anObject! !

!EyeInspector methodsFor: 'list' stamp: 'CamilloBruni 9/21/2013 16:04'!
addClass: elements
	"Add class to the list of elements you can access in the inspector"

	elements add: (ClassEyeElement host: self object).! !

!EyeInspector methodsFor: 'accessing' stamp: 'CamilloBruni 9/21/2013 15:32'!
selectedIndex: integer
	^ self list setSelectedIndex: integer! !

!EyeInspector methodsFor: 'initialization' stamp: 'CamilloBruni 10/15/2013 17:25'!
initializePresenter
	"initialize the event handlings"
	super initializePresenter.
		
	description whenTextIsAccepted: [ :newText |
		self saveElement: newText.
		self refreshDescription ].! !

!EyeInspector methodsFor: 'event-handling' stamp: 'CamilloBruni 9/14/2013 17:09'!
refreshPrintDescription
	self printDescription: self selectedElement! !

!EyeInspector methodsFor: 'inspecting' stamp: 'CamilloBruni 9/21/2013 15:34'!
inspect: anObject 
	"This is called to update the inspector model with a new object, updates the UI"

	self object: anObject.
	self list setSelectedIndex: 1.
	self refresh
	! !

!EyeInspector methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/8/2013 17:54'!
list
	^ list ifNil: [ 
		list := self instantiate: NewListModel.
		list 
			handlesDoubleClick: true;
			whenSelectedItemChanged: [ :item |
				self refreshDescription: item ];
			doubleClickAction: [ self diveIntoSelectedObject ]. ]! !

!EyeInspector methodsFor: 'private' stamp: 'CamilloBruni 9/21/2013 15:33'!
takeKeyboardFocus
	^ self list takeKeyboardFocus! !

!EyeInspector methodsFor: 'accessing' stamp: 'CamilloBruni 9/21/2013 15:32'!
selectedIndex
	^ self list selectedIndex! !

!EyeInspector methodsFor: 'list' stamp: 'ClementBera 4/30/2013 11:42'!
addInstancesVariable: elements
	"Add all the instance variables to the list of elements you can access in the inspector, set them so that you can modify and save them"

	self object class allInstVarNames do: [:name |
		elements add: (InstanceVariableEyeElement host: self object instVarName: name) ]! !

!EyeInspector methodsFor: 'list' stamp: 'ClementBera 4/30/2013 11:35'!
addAllInstVars: elements
	"Add AllInstVars to the list of elements you can access in the inspector"

	elements add: (AllInstVarsEyeElement host: self object).! !

!EyeInspector methodsFor: 'list' stamp: 'ClementBera 4/30/2013 16:13'!
variableFieldsToShow
	"Answers the indexes of the variable fields of the object to show.
	Shorten the list for very long collection (cf limit1 and limit2)"

	|bSize|
	
	bSize := self objectVariableSize.
	
	^ bSize <= (self limit1 + self limit2)
			ifTrue: [1 to: bSize]
			ifFalse: [(1 to: self limit1) , (bSize - self limit2 + 1 to: bSize)].! !

!EyeInspector methodsFor: 'initialization' stamp: 'CamilloBruni 9/21/2013 15:28'!
initializeWidgets
	
	description := self instantiate: TextModel.
	
		
 	
! !

!EyeInspector methodsFor: 'event-handling' stamp: 'CamilloBruni 9/14/2013 17:10'!
printDescription
	^ description text! !

!EyeInspector methodsFor: 'accessing' stamp: 'ClementBera 4/30/2013 16:14'!
objectVariableSize
	^ self object basicSize! !

!EyeInspector methodsFor: 'list' stamp: 'ClementBera 4/30/2013 11:21'!
addSelf: elements
	"Add self to the list of elements you can access in the inspector"

	elements add: (SelfEyeElement host: self object).! !

!EyeInspector methodsFor: 'menu' stamp: 'StephaneDucasse 4/3/2014 21:36'!
inspectionMenu: aMenu
	
	self hasSelectedObject ifFalse: [ ^ aMenu ].
	super inspectionMenu: aMenu.! !

!EyeInspector methodsFor: 'accessing' stamp: 'ClementBera 3/29/2013 13:48'!
objectClass

	^ self object class! !

!EyeInspector methodsFor: 'initialization' stamp: 'StephaneDucasse 3/7/2014 10:51'!
step
	self refresh! !

!EyeInspector methodsFor: 'event-handling' stamp: 'SvenVanCaekenberghe 3/30/2014 13:11'!
refresh
	"refresh the object in the inspector, updating his modified instance variables"

	description hasUnacceptedEdits 
		ifTrue: [  ^ self ].
	description getSelection size = 0 
		ifTrue: [ self refreshDescription; updateList ]! !

!EyeInspector methodsFor: 'event-handling' stamp: 'CamilloBruni 9/14/2013 17:17'!
refreshDescription
	self refreshDescription: self selectedElement! !

!EyeInspector methodsFor: 'private' stamp: 'CamilloBruni 2/25/2014 18:48'!
labelFor: anEyeElement
	^ anEyeElement label! !

!EyeInspector methodsFor: 'accessing' stamp: 'CamilloBruni 9/21/2013 15:32'!
selectedObject: anObject
	"Sets the selectedElement of the inspector to anObject. If anObject is not in the list, then sets the selectedElement to 1"

	self list setSelectedIndex: 1.
	self list listItems withIndexDo: [ :item :index | 
		item value == anObject 
			ifTrue: [ self list setSelectedIndex: index ] ]! !

!EyeInspector methodsFor: 'list' stamp: 'ClementBera 4/30/2013 16:02'!
addVariableFields: elements
	"add the variable fields to the inspector. Shorten the list for very long collection (cf limit1 and limit2), set them so that you can modify and save them"

	self variableFieldsToShow do: [ :index |
		elements add: (BasicIndexedEyeElement host: self object index: index) ]! !

!EyeInspector methodsFor: 'actions' stamp: 'abc 10/18/2013 14:56'!
copySelectedItemAccessorCode
	self hasSelectedObject
		ifFalse: [ ^ self ].
	self selectedElement copyAccessorCode.! !

!EyeInspector methodsFor: 'private' stamp: 'CamilloBruni 7/16/2013 15:01'!
canDiscardEdits

	^ true! !

!EyeInspector methodsFor: 'inspecting' stamp: 'MarcusDenker 9/28/2013 15:40'!
explore: anObject 
	"This is called to open a new ObjectExplorer on the object"

	^self class explore: anObject! !

!EyeInspector methodsFor: 'accessing' stamp: 'CamilloBruni 9/21/2013 15:42'!
elements
	^ self list getItems! !

!EyeInspector methodsFor: 'event-handling' stamp: 'ClementBer 10/18/2013 16:26'!
printDescription: item
	self refreshDescription: item! !

!EyeInspector methodsFor: 'accessing' stamp: 'NicolaiHess 7/23/2014 00:40'!
selectedElement
	^ self list selectedItem ifNil: [ 
		"sometimes the new list model desynchronize its selected index from its selected element,
		this mean that the inspector evaluates 'list setSelectedIndex: 1' but 'list selectedItem' still returns nil.
		This code fixes this case, that is triggered for example when you do Cmd+c in an ObjectExplorer."
		self list selectedIndex ifNotNil: [ :currentIndex | 
			currentIndex = 0
				ifTrue: [ ^ nil ].
			self list listItems ifNotEmpty: [ :aList | 
				aList at: currentIndex  ] ] ]! !

!EyeInspector methodsFor: 'list' stamp: 'ClementBera 7/8/2014 15:53'!
limit2
	"This is the number of elements to show at the end of very long arrays"
	
	^ 10! !

!EyeInspector methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/14/2014 10:32'!
showClass
	^ self class showClass! !

!EyeInspector methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/14/2014 10:32'!
showAllInstVars
	^ self class showAllInstVars! !

!EyeInspector methodsFor: 'event-handling' stamp: 'MarcusDenker 9/5/2013 12:48'!
saveElement: newText
	"When you press Cmd+s on the description TextModel, you can save the new value in the inspected object"

	|newValue|
		
	newValue := description doItReceiver class compiler
		source: newText;
		context: self doItContext;
		receiver: description doItReceiver;
		failBlock: [^ self];
		evaluate.
	
	self selectedElement save: newValue.
	self objectChanged.! !

!EyeInspector class methodsFor: 'inspecting' stamp: 'MarcusDenker 9/28/2013 17:01'!
inspect: anObject label: aString
	(InspectorNavigator openInspector: (self inspector: anObject)) window title: aString.
	^ anObject
! !

!EyeInspector class methodsFor: 'spec' stamp: 'BenjaminVanRyseghem 5/19/2013 16:38'!
debuggerSpec
	<spec:#default>
	
	^ SpecLayout composed
		add: #list origin: 0@0 corner: 0.33@1;
		addVSplitter;
		add: #description origin: 0.33@0 corner: 1@1;
		yourself! !

!EyeInspector class methodsFor: 'inspecting' stamp: 'BenjaminVanRyseghem 5/19/2013 16:37'!
basicInspect: anObject 
	^ self new 
		inspect: anObject;
		openWithSpec: #inspectorSpec;
		yourself! !

!EyeInspector class methodsFor: 'accessing' stamp: 'CamilloBruni 9/21/2013 16:15'!
label
	^ 'Default Inspector'! !

!EyeInspector class methodsFor: 'inspecting' stamp: 'CamilloBruni 9/21/2013 16:31'!
inspect: anObject 
	InspectorNavigator openInspector: (self inspector: anObject).
	^ anObject! !

!EyeInspector class methodsFor: 'spec' stamp: 'BenjaminVanRyseghem 5/19/2013 16:38'!
debuggerSpecSlow
	<spec>
	
	^ SpecLayout composed
		newRow: [:row | 
			row 
				add: #list width: 135;
				add: #description ];
		yourself! !

!EyeInspector class methodsFor: 'tools registry' stamp: 'EstebanLorenzano 3/20/2015 16:49'!
registerToolsOn: registry
	"Add ourselves to registry. See [Smalltalk tools]" 
	registry 
		register: self as: #inspector;
		register: self as: #basicInspector.! !

!EyeInspector class methodsFor: 'inspecting' stamp: 'MarcusDenker 9/28/2013 15:32'!
explore: anObject 
	InspectorNavigator openExplorer: (self inspector: anObject).
	^ anObject! !

!EyeInspector class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 3/14/2014 10:31'!
showClass
	^ false! !

!EyeInspector class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 3/14/2014 10:31'!
showAllInstVars
	^ false! !

!EyeInspector class methodsFor: 'inspecting' stamp: 'ClementBera 7/3/2013 12:52'!
inspector: anObject 
	^ anObject class inspectorClass new
		inspect: anObject;
		yourself! !

!EyeInspector class methodsFor: 'spec' stamp: 'CamilloBruni 9/18/2013 22:13'!
inspectorSpec
	<spec>
	
	^ SpecLayout composed
		newRow: [ :r |
			r 
				newColumn: #list right: 0.6;
				addSplitter;
				newColumn: #description left: 0.4 ]
		bottom: 0.3;
		addHSplitter;
		newRow: #text top: 0.7;
		yourself! !

!EyeInspectorTest methodsFor: 'tests' stamp: 'BenComan 4/6/2015 23:20'!
testErrorRaised
	| inspector morphsBefore morphsAfter |
	morphsBefore := World submorphs. 
	self instancesToTry do: [ :each | inspector := each inspector ].
	morphsAfter := World submorphs. 
	(morphsAfter copyWithoutAll: morphsBefore) do: [ :morph | morph delete ].! !

!EyeInspectorTest methodsFor: 'accessing' stamp: 'cb 6/25/2013 13:14'!
instancesToTry
	^ { 
	Object new . 
	Class . 
	Metaclass . 
	Array new .
	Dictionary new . 
	WordArray new. 
	ByteArray new. 
	Color red .
	thisContext . 
	PluggableTextMorph new . 
	12 . 
	#symbol . 
	(12.32) . 
	TBehavior . 
	(SmallInteger>>#+) . 
	#(1 2 3) . 
	#[1 2 3] .
	[  1 + 2 ] .
	Error new .
	(1 << 40)
	}! !

!EyeInspectorToolBar commentStamp: '<historical>'!
Toolbar to explore previous or next inpected elements!
!EyeInspectorToolBar methodsFor: 'event-handling' stamp: 'CamilloBruni 9/20/2013 22:24'!
update
	self preventUpdatesDuring: [ 
		self updateInspectorChoice.
		self updateInspectorType.
		self previousButton enabled: self history hasPrevious.
		self nextButton enabled: self history hasNext ]! !

!EyeInspectorToolBar methodsFor: 'event-handling' stamp: 'BenjaminVanRyseghem 11/18/2013 14:42'!
updateInspectorChoice
	self inspectorTypes
		ifNotNil: [ :variants | 
			self inspectorChoice listItems = variants
				ifTrue: [  ^ self ].
			self inspectorChoice
				items: variants;
				displayBlock: [ :label | label ]]! !

!EyeInspectorToolBar methodsFor: 'accessing' stamp: 'CamilloBruni 9/20/2013 22:29'!
previousButton
	previousButton
		ifNil: [ 
			previousButton := self instantiate: ButtonModel.
			previousButton label: '<'.
			previousButton
				action: [ 
					self inspectorWrapper inspectPrevious.
					self update. ] ].
	^ previousButton! !

!EyeInspectorToolBar methodsFor: 'initialization' stamp: 'CamilloBruni 9/20/2013 22:28'!
initializeWidgets
	" nothing to do"! !

!EyeInspectorToolBar methodsFor: 'event-handling' stamp: 'CamilloBruni 9/21/2013 16:38'!
updateInspectorType
	
	
	self inspectorType
		ifNotNil: [ :inspectorClass | 
			self inspectorChoice selectedItem = inspectorClass
				ifTrue: [  ^ self ].
			self inspectorChoice setSelectedItem: inspectorClass ].! !

!EyeInspectorToolBar methodsFor: 'accessing' stamp: 'CamilloBruni 9/20/2013 19:36'!
inspectorType
	^ self inspectorWrapper inspectorType! !

!EyeInspectorToolBar methodsFor: 'accessing' stamp: 'CamilloBruni 9/18/2013 22:22'!
history
	^ self inspectorWrapper history! !

!EyeInspectorToolBar methodsFor: 'accessing' stamp: 'CamilloBruni 9/20/2013 22:29'!
nextButton
	nextButton
		ifNil: [ 
			nextButton := self instantiate: ButtonModel.
			nextButton 
				label: '>';
				action: [ 
					self inspectorWrapper inspectNext.
					self update. ]].
	^ nextButton! !

!EyeInspectorToolBar methodsFor: 'initialization' stamp: 'CamilloBruni 9/20/2013 22:25'!
initialize
	isUpdating := false.
	super initialize.! !

!EyeInspectorToolBar methodsFor: 'actions' stamp: 'CamilloBruni 9/21/2013 16:32'!
inspectorType: anInspectorClass
	^ self inspectorWrapper inspectorType: anInspectorClass! !

!EyeInspectorToolBar methodsFor: 'private' stamp: 'CamilloBruni 9/20/2013 22:29'!
preventUpdatesDuring: aBlock
	"Used to prevent back-firing when the toolbar is update from the outside"
	isUpdating ifTrue: [ 
		^ self ].
	isUpdating := true.
	aBlock ensure: [ isUpdating := false ]! !

!EyeInspectorToolBar methodsFor: 'accessing' stamp: 'CamilloBruni 9/18/2013 22:11'!
inspectorWrapper
	^ self owner! !

!EyeInspectorToolBar methodsFor: 'accessing' stamp: 'CamilloBruni 9/20/2013 19:32'!
inspectorTypes
	^ self inspectorWrapper inspectorTypes! !

!EyeInspectorToolBar methodsFor: 'accessing' stamp: 'CamilloBruni 9/20/2013 22:29'!
inspectorChoice
	inspectorChoice
		ifNil: [ 
			inspectorChoice := self instantiate: DropListModel.
			inspectorChoice
				whenSelectedItemChanged: [ :inspectorType |
					self preventUpdatesDuring: [
						self inspectorType: inspectorType ]]].
	^ inspectorChoice! !

!EyeInspectorToolBar class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 11/8/2013 16:58'!
defaultSpec
	<spec>
	^ SpecLayout composed
		newRow: [ :r | 
			r
				add: #previousButton width: 24;
				add: #nextButton width: 28;
				add: #inspectorChoice
		];
	yourself.! !

!EyeIntegerInspector commentStamp: '<historical>'!
Specialized version of inspector showing hex, octal and binary representations.

If within Unicode range, show a Character having using the Integer value as code point.!
!EyeIntegerInspector methodsFor: 'list' stamp: 'SvenVanCaekenberghe 2/25/2014 09:17'!
addSpecialFields: elements

	elements add: (DynamicEyeElement 
		host: self object 
		label: 'hex' 
		description: [ self object printStringRadix: 16 ]
		value: [ self object ]).
			
	elements add: (DynamicEyeElement 
		host: self object 
		label: 'octal' 
		description: [ self object printStringRadix: 8 ]
		value: [ self object ]).
			
	elements add: (DynamicEyeElement 
		host: self object 
		label: 'binary' 
		description: [ self object printStringRadix: 2 ]
		value: [ self object ]).
			
	(self object between: 0 and: 16r10FFFF)
		ifTrue: [ 
			elements add: (DynamicEyeElement 
				host: self object 
				label: 'character' 
				description: [ :value | value printString ]
				value: [ self object asCharacter ]) ]! !

!EyeMethodContextInspector commentStamp: '<historical>'!
I am an eye inspector specified for MethodContext!
!EyeMethodContextInspector methodsFor: 'list' stamp: 'ClementBera 6/25/2013 14:46'!
tempNames

	^ [ self object tempNames ]
		on: Error
		do: [ #() ]! !

!EyeMethodContextInspector methodsFor: 'accessing' stamp: 'ClementBera 4/30/2013 14:25'!
doItContext
	^ self object! !

!EyeMethodContextInspector methodsFor: 'list' stamp: 'ClementBera 8/5/2013 10:44'!
addVariableFields: elements

	self tempNames withIndexDo: [ :name :index |
		elements add: (ContextTempEyeElement host: self object tempName: name tempIndex: index) ]! !

!EyeMethodContextInspector class methodsFor: 'accessing' stamp: 'CamilloBruni 9/20/2013 21:13'!
label
	^ 'Context Inspector'! !

!EyeMethodEditor commentStamp: '<historical>'!
A simple editor for complied methods.!
!EyeMethodEditor methodsFor: 'accessing' stamp: 'CamilloBruni 9/21/2013 20:04'!
method
	^ self object! !

!EyeMethodEditor methodsFor: 'accessing' stamp: 'CamilloBruni 9/21/2013 20:09'!
toolbar
	^ toolbar ifNil: [ 
		toolbar := self instantiate: MethodToolbar. ]! !

!EyeMethodEditor methodsFor: 'event-handling' stamp: 'CamilloBruni 9/21/2013 20:08'!
objectChanged
	self text 
		text: self method sourceCode;
		behavior: self method methodClass.
	
	self toolbar method: self method! !

!EyeMethodEditor methodsFor: 'accessing' stamp: 'CamilloBruni 9/21/2013 20:07'!
title
	^ self method printString ! !

!EyeMethodEditor class methodsFor: 'accessing' stamp: 'CamilloBruni 9/21/2013 20:17'!
label
	^ 'Method Editor'! !

!EyeMethodEditor class methodsFor: 'spec' stamp: 'CamilloBruni 9/21/2013 20:15'!
inspectorSpec
	<spec>
	
	^ SpecLayout composed
		add: #text;
		yourself! !

!EyeMorphViewer commentStamp: '<historical>'!
A simple inspector view that displays a morph!
!EyeMorphViewer methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 17:46'!
container
	^ container ifNil: [ container := (PanelMorph new 
		changeProportionalLayout)
		asSpecAdapter
		 vSpaceFill;
		hSpaceFill]! !

!EyeMorphViewer methodsFor: 'initialization' stamp: 'StephaneDucasse 3/7/2014 10:52'!
step
	self objectChanged! !

!EyeMorphViewer methodsFor: 'accessing' stamp: 'CamilloBruni 9/22/2013 19:53'!
thumbnailSize
	^ self container extent! !

!EyeMorphViewer methodsFor: 'event-handling' stamp: 'NicolaiHess 6/15/2014 21:58'!
objectChanged
	| newThumbnail |
	
	newThumbnail := self thumbnailMorph.
	newThumbnail when: #extent send: #resize: to: newThumbnail.
	self text doItReceiver: self object. 
	self container morph removeAllMorphs.
	self container morph
		addMorph: newThumbnail
		fullFrame: LayoutFrame identity! !

!EyeMorphViewer methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 10/17/2013 17:28'!
initializePresenter

	self whenWindowChanged: [ self objectChanged ]! !

!EyeMorphViewer methodsFor: 'event-handling' stamp: 'CamilloBruni 9/22/2013 19:51'!
thumbnailMorph
	^self object taskThumbnailOfSize: self thumbnailSize! !

!EyeMorphViewer class methodsFor: 'accessing' stamp: 'CamilloBruni 9/22/2013 19:40'!
label
	^ 'Morph Viewer'! !

!EyeMorphViewer class methodsFor: 'spec' stamp: 'NicolaiHess 6/15/2014 21:59'!
inspectorSpec
	<spec>
	
	^ SpecLayout composed
		newRow: #container bottom: 0.3;
		addHSplitter;
		newRow: #text top: 0.7;
		yourself! !

!EyePointerExplorer commentStamp: 'MarcusDenker 8/5/2014 16:11'!
A variant on the TreeInspector that works "backwards".

By default it shows both weak and strong references (#openOn:) but I can be configured to omit weak refs with #openStrongOn:

Like the TreeInspector, it shows a tree of objects, but expanding a node won't show the objects which that node references, but rather the objects that reference that node.  Its main use is to track down memory leaks: if you want to know why a particular object is still alive, open a PointerExplorer on it and drill down until you find the root object that's referencing it.  For example, find all the references to the symbol #zot with:

EyePointerExplorer openOn: #zot

For the "name" of the object, the PointerExplorer shows each object's identityHash, to allow the user to identify when two similar objects are identical and notice cycles.

!
!EyePointerExplorer methodsFor: 'accessing' stamp: 'MarcusDenker 8/5/2014 10:41'!
object: anObject
	Smalltalk garbageCollect.
	super object: (EyePointerWrapper wrap: anObject)! !

!EyePointerExplorer methodsFor: 'initialization' stamp: 'MarcusDenker 8/5/2014 15:48'!
initialize
	super initialize.
	onlyStrong := false.! !

!EyePointerExplorer methodsFor: 'accessing' stamp: 'MarcusDenker 8/5/2014 10:35'!
tree
	^ tree ifNil: [ 
		tree := self instantiate: TreeModel.
		tree whenBuiltDo: [ self initializeShortcuts ].
		tree 
			whenSelectedItemChanged: [ :item | item ifNotNil: [ self text doItReceiver: item value ]];	
			displayBlock:  [ :anObject | self labelFor: anObject ];
			menu:          [ :menu |  self inspectionMenu: menu ];
			hasChildrenBlock: [ :o | true  ];
			childrenBlock: [ :anObject | self childrenFor: anObject ];
			yourself]! !

!EyePointerExplorer methodsFor: 'accessing' stamp: 'MarcusDenker 9/4/2014 16:17'!
selectedObjectDo: aBlock

	self selectedElement ifNotNil: [ :element |
		aBlock value: element value wrappedObject ]! !

!EyePointerExplorer methodsFor: 'accessing' stamp: 'MarcusDenker 8/5/2014 16:10'!
title
	^ 'Pointers to: ', self object printString! !

!EyePointerExplorer methodsFor: 'api' stamp: 'MarcusDenker 8/5/2014 16:11'!
childrenForObject: anObject
	| objects  |
	objects := anObject wrappedObject pointersToExcept: { self. anObject}.
	"filter out all wrappers and (otionally) all those who pointing only weakly to subject"
	objects := objects reject: [ :each | each class =  EyePointerWrapper].
	onlyStrong ifTrue: [objects := objects reject: [ :each | each pointsOnlyWeaklyTo: anObject wrappedObject]]. 
	^ objects collect: [ :each |
		(PointerEyeElement
			host: anObject wrappedObject 
			value: each)]! !

!EyePointerExplorer methodsFor: 'accessing' stamp: 'MarcusDenker 8/5/2014 09:06'!
roots
	^ self childrenForObject: self object! !

!EyePointerExplorer methodsFor: 'accessing' stamp: 'MarcusDenker 9/4/2014 16:17'!
valueClass
	^ self value wrappedObject class! !

!EyePointerExplorer methodsFor: 'event-handling' stamp: 'MarcusDenker 8/5/2014 09:28'!
objectChanged
	self text doItReceiver: self object. 
	self tree roots: self roots.! !

!EyePointerExplorer methodsFor: 'api' stamp: 'MarcusDenker 8/5/2014 15:51'!
onlyStrong
	onlyStrong := true! !

!EyePointerExplorer class methodsFor: 'instance creation' stamp: 'MarcusDenker 8/5/2014 15:52'!
openStrongOn: anObject
	"only show strong references"
	^(self new 
		onlyStrong;
		inspect: anObject) openWithSpec! !

!EyePointerExplorer class methodsFor: 'accessing' stamp: 'MarcusDenker 8/2/2014 13:17'!
label
	^ 'Pointer Explorer'! !

!EyePointerExplorer class methodsFor: 'instance creation' stamp: 'MarcusDenker 8/5/2014 10:34'!
openOn: anObject
	^(self new inspect: anObject) openWithSpec! !

!EyePointerExplorer class methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 8/7/2014 11:36'!
registerToolsOn: registry
	"Add ourselves to registry. See [Smalltalk tools class]
	self registerToolsOn: Smalltalk tools
	" 
	registry register: self as: #pointerExplorer
! !

!EyePointerWrapper commentStamp: 'MarcusDenker 8/5/2014 10:38'!
A wrapper used by the PointerExplorer.
I wrap a reference so we can stop follwoing back pointers.!
!EyePointerWrapper methodsFor: 'printing' stamp: 'MarcusDenker 8/5/2014 16:09'!
printString
	^wrapped printString! !

!EyePointerWrapper methodsFor: 'accessing' stamp: 'MarcusDenker 8/5/2014 10:39'!
wrappedObject
	^wrapped! !

!EyePointerWrapper methodsFor: 'accessing' stamp: 'MarcusDenker 8/5/2014 10:40'!
wrappedObject: anObject
	wrapped := anObject! !

!EyePointerWrapper class methodsFor: 'instance creation' stamp: 'MarcusDenker 8/5/2014 10:39'!
wrap: anObject
	^self new wrappedObject: anObject.! !

!EyeSetInspector commentStamp: '<historical>'!
Specialized version of inspector showing values only!
!EyeSetInspector methodsFor: 'list' stamp: 'ClementBera 4/30/2013 16:37'!
addVariableFields: elements
	"add the variable fields to the inspector. Shorten the list for very long collection (cf limit1 and limit2), set them so that you can modify and save them"
	| externalIndex |
	externalIndex := 1.
	self object array withIndexDo: [ :value :index |
		value ifNotNil: [ 
			elements add: (SetEyeElement host: self object index: index externalIndex: externalIndex).
			externalIndex := externalIndex + 1 ]]! !

!EyeStringInspector commentStamp: 'SvenVanCaekenberghe 3/14/2014 10:35'!
EyeStringInspector is is the EyeInspector for Strings.
Right now, the only difference is that the list of elements for the tree is overridden to be empty.
!
!EyeStringInspector methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 3/14/2014 10:36'!
elements
	^ #()! !

!EyeSyntaxTreeInspector commentStamp: 'MarcusDenker 8/4/2014 16:22'!
I am an inspector showing abstract syntax trees. 
Instead of showing the full complexity, show the structure of the code by only showing the nodes.

As an example, inspect 

	(Object>>#halt) ast
!
!EyeSyntaxTreeInspector methodsFor: 'api' stamp: 'NicolaiHess 9/8/2014 19:47'!
childrenForObject: aNode
	^ aNode children collect: [ :each | 
			DynamicEyeElement
				host: aNode
				label: each class name
				description: [ :node | node formattedCode ]
				value: [each] ]! !

!EyeSyntaxTreeInspector methodsFor: 'api' stamp: 'MarcusDenker 8/3/2014 12:59'!
roots
	^ self childrenForObject: self object! !

!EyeSyntaxTreeInspector class methodsFor: 'accessing' stamp: 'MarcusDenker 8/3/2014 12:59'!
label
	^ 'AST Inspector'! !

!EyeTreeInspector commentStamp: '<historical>'!
I am a tree inspector that takes the EyeElements from the default inspectors and displays them in a tree.!
!EyeTreeInspector methodsFor: 'initialization' stamp: 'CamilloBruni 10/15/2013 17:58'!
initializeShortcuts
	"initialize the inspector' shortcuts with the dictionary defined in self shortCuts"
	
	self shortCuts keysAndValuesDo: [ :key :value |
		self tree bindKeyCombination: key toAction: value ]! !

!EyeTreeInspector methodsFor: 'api' stamp: 'EstebanLorenzano 4/9/2015 16:58'!
childrenForObject: anObject
	^ (EyeInspector inspector: anObject) elements 
			select: [ :element | element shouldShowInTree ]! !

!EyeTreeInspector methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 3/15/2014 23:39'!
roots
	^ { RootEyeElement host: self object }! !

!EyeTreeInspector methodsFor: 'api' stamp: 'CamilloBruni 9/21/2013 19:50'!
childrenFor: anEyeElement
	^ self childrenForObject: anEyeElement value! !

!EyeTreeInspector methodsFor: 'event-handling' stamp: 'MarcusDenker 10/4/2013 16:39'!
objectChanged
	self text doItReceiver: self object. 
	self tree
		roots: self roots;
		expandRoots.! !

!EyeTreeInspector methodsFor: 'event-handling' stamp: 'BenComan 3/17/2014 23:38'!
ownerChanged
	super ownerChanged.
	self expandRoots.
! !

!EyeTreeInspector methodsFor: 'accessing' stamp: 'CamilloBruni 9/22/2013 19:33'!
selectedObject
	^self selectedElement value! !

!EyeTreeInspector methodsFor: 'accessing' stamp: 'BenComan 3/16/2014 01:52'!
tree
	^ tree ifNil: [ 
		tree := self instantiate: TreeModel.
		tree whenBuiltDo: [ self initializeShortcuts ].
		tree 
			whenSelectedItemChanged: [ :item | item ifNotNil: [ self text doItReceiver: item value ]];	
			childrenBlock: [ :anObject | self childrenFor: anObject ];
			iconBlock:     [ :treeNode | self iconFor: treeNode ];
			displayBlock:  [ :anObject | self labelFor: anObject ];
			menu:          [ :menu |     self inspectionMenu: menu ];
			doubleClick: [
				 self diveInto: self selectedObject ];
			yourself]! !

!EyeTreeInspector methodsFor: 'api' stamp: 'BenComan 3/17/2014 22:19'!
expandRoots
	self tree expandRoots! !

!EyeTreeInspector methodsFor: 'api' stamp: 'CamilloBruni 2/25/2014 18:48'!
labelFor: anEyeElement
	"Take care of errors that might occur during label access"
	^ [ anEyeElement longLabel ]
		on: Error do: [ :error |
			anEyeElement label, ': ', (self labelFor: anEyeElement error: error) ]! !

!EyeTreeInspector methodsFor: 'api' stamp: 'CamilloBruni 2/25/2014 18:24'!
iconFor: anEyeElement
	anEyeElement withErrorsDo: [ :error |
		^ self iconFor: anEyeElement error: error ].
		
	^ [ anEyeElement icon ]
		on: Error do: [ :error |
			self iconFor: anEyeElement error: error ]! !

!EyeTreeInspector methodsFor: 'api' stamp: 'CamilloBruni 2/25/2014 18:08'!
iconFor: anEyeElement error: error
	^ Smalltalk ui icons smallWarningIcon! !

!EyeTreeInspector methodsFor: 'accessing' stamp: 'PabloHerrero 11/29/2013 14:03'!
selectedElement
	self tree hasSelectedItem
		ifFalse: [ ^ nil ].
	^ self tree selectedItem content! !

!EyeTreeInspector methodsFor: 'private-focus' stamp: 'CamilloBruni 10/15/2013 18:24'!
takeKeyboardFocus
	^ self tree takeKeyboardFocus! !

!EyeTreeInspector class methodsFor: 'accessing' stamp: 'CamilloBruni 9/21/2013 16:15'!
label
	^ 'Tree Inspector'! !

!EyeTreeInspector class methodsFor: 'spec' stamp: 'CamilloBruni 9/21/2013 14:38'!
inspectorSpec
	<spec>
	
	^ SpecLayout composed
		newRow: #tree bottom: 0.3;
		addHSplitter;
		newRow: #text top: 0.7;
		yourself! !

!EyeViewHierarchyInspector commentStamp: '<historical>'!
A special tree inspector that displays the submorph hierarchy of the inspected morph.!
!EyeViewHierarchyInspector methodsFor: 'api' stamp: 'CamilloBruni 9/21/2013 19:51'!
childrenForObject: aMorph
	^ aMorph submorphs collect: [ :each |
		DynamicEyeElement
			host: aMorph
			value: each
		 ]! !

!EyeViewHierarchyInspector methodsFor: 'api' stamp: 'CamilloBruni 9/21/2013 19:51'!
roots
	^ self childrenForObject: self object! !

!EyeViewHierarchyInspector class methodsFor: 'accessing' stamp: 'CamilloBruni 9/21/2013 16:15'!
label
	^ 'Morph View Hierarchy Inspector'! !

!FIFOQueueTests commentStamp: 'TorstenBergmann 2/20/2014 15:29'!
SUnit tests for FIFO queues!
!FIFOQueueTests methodsFor: 'tests' stamp: 'IgorStasenko 2/28/2011 14:36'!
testFlush
	| q v sema |
	q := self newQueue.
	sema := Semaphore new.
	
	[ #( 1 2 3 4 5 6 7 8 9 10 ) do: [:each |
		q nextPut: each ]. sema signal ] fork.
	
	v := 0.
	
	sema wait. 
	q flush: [:each | self assert: v < each. v := each ].

	self assert: v = 10	! !

!FIFOQueueTests methodsFor: 'tests' stamp: 'IgorStasenko 4/15/2011 11:41'!
testBasics
	| q |
	q := self newQueue.
	
	q nextPut: 5.
	
	self assert: q peek = 5.
	self assert: q nextOrNil = 5.
	
	q nextPut: 10.
	q nextPut: 15.
	
	self assert: q nextOrNil = 10.
	self assert: q peek = 15.
	self assert: q nextOrNil = 15.
	
	self assert: q nextOrNil == nil! !

!FIFOQueueTests methodsFor: 'tests' stamp: 'Igor.Stasenko 10/16/2010 01:20'!
runValidationTest
	| q sema prio pusher feeder
		feeders r crit done |

	r := Random new.
	q := AtomicSharedQueue new.
	feeders := OrderedCollection new.
	count := 0.
	sema := Semaphore new.
	crit := Semaphore forMutualExclusion.
	done := Semaphore new.
	
	prio := Processor activePriority.
	pusher := [ sema wait. 1 to: 100 do: [:i | q nextPut: i ]. ].
	feeder := [ sema wait. 
		[ q next. 
		crit critical: [count := count + 1 ]. count < 1000 ] whileTrue. done signal ].
	
	10 timesRepeat: [
		| proc |
		proc := pusher newProcess priority: prio + (r next * 10) asInteger  - 5.
		proc resume.
		proc := feeder newProcess priority: prio + (r next * 10) asInteger  - 10.
		feeders add: proc. 
		proc resume.		
	].

	" let them run "
	20 timesRepeat: [ sema signal ].
	Processor yield.
	
	done waitTimeoutSeconds: 10.
	 
	feeders do: [:ea | ea terminate ].
	self assert: (count = 1000 ) 
! !

!FIFOQueueTests methodsFor: 'tests' stamp: 'IgorStasenko 2/28/2011 15:17'!
testContention1
	"here is a test case that breaks the standard SharedQueue from Squeak 3.8"

	| q r1 r2 |
	q := AtomicSharedQueue new.
	q nextPut: 5.
	q nextPut: 10.

	self should: [ q nextOrNil = 5 ].

	[ r1 := q next ] fork.
	[ r2 := q next ] fork.
	Processor  yield.   "let the above two threads block"
	
	q nextPut: 10.
	Processor yield.

	self should: [ r1 = 10 ].
	self should: [ r2 = 10 ].
	self should: [ q nextOrNil = nil ].
! !

!FIFOQueueTests methodsFor: 'instance creation' stamp: 'IgorStasenko 11/2/2010 01:39'!
newQueue

	^ WaitfreeQueue new! !

!FIFOQueueTests methodsFor: 'tests' stamp: 'Igor.Stasenko 10/16/2010 02:08'!
testFlushAllSuchThat
	| q |
	q := self newQueue.

	
	#( 1 2 3 4 5 6 7 8 9 10 ) do: [:each | q nextPut: each ]. 
	
	q flushAllSuchThat: [:each | each odd ].
	
	q flush: [:each | self assert: each even ].
	
	self assert: q nextOrNil == nil! !

!FIFOQueueTests methodsFor: 'tests' stamp: 'Igor.Stasenko 10/15/2010 19:53'!
runValidationTest2
	| q sema prio pusher r cnt |

	r := Random new.
	q := AtomicSharedQueue new.
	cnt := 0.
	sema := Semaphore new.
	
	prio := Processor activePriority.
	pusher := [ sema wait. 1 to: 100 do: [:i | q nextPut: i ]. Processor yield ].
	
	10 timesRepeat: [
		| proc |
		proc := pusher newProcess priority: prio + (r next * 10) asInteger  - 5.
		proc resume.
	].

	" let them run "
	10 timesRepeat: [ sema signal ].
	Processor yield.
	
	[ q next. cnt := cnt + 1. cnt < 1000 ] whileTrue.
"
	started := Time now asSeconds. 
	[
	[ count < (1000) ] whileTrue: [
		Time now asSeconds - started > 20 ifTrue: [ self error: 'deadlock' ].
	 Processor yield ].
	] ensure: [ 
		feeders do: [:ea | ea terminate ]
	]
"! !

!FIFOQueueTests methodsFor: 'tests' stamp: 'Igor.Stasenko 10/15/2010 18:34'!
testSuchThat
	| q |
	q := self newQueue.
	
	#( 1 2 3 4 5 6 7 8 9 10 ) do: [:each |
		q nextPut: each ].

	self assert: (q nextOrNilSuchThat: [:e | e = 100 ]) isNil.	

	self assert: (q nextOrNilSuchThat: [:e | e = 5 ]) = 5.	

	9 timesRepeat: [ 
		self assert: (q nextOrNil notNil) ].
	
	self assert: q nextOrNil isNil! !

!FIFOQueueTests methodsFor: 'tests' stamp: 'IgorStasenko 2/28/2011 15:10'!
testSize
	| q |
	q := self newQueue.
	
	#( 1 2 3 4 5 6 7 8 9 10 ) do: [:each |
		q nextPut: each ].

	self assert: (q size = 10)! !

!FIFOQueueTests methodsFor: 'tests' stamp: 'IgorStasenko 2/28/2011 14:42'!
testHeavyContention
	"run 10 threads, pushing new values to queue,
	and 10 threads pullung values from queue,
	at random priorities"
	
	| q sema prio pusher feeder
		feeders r crit done |

	r := Random new.
	q := AtomicSharedQueue new.
	feeders := OrderedCollection new.
	count := 0.
	sema := Semaphore new.
	crit := Semaphore forMutualExclusion.
	done := Semaphore new.
	
	prio := Processor activePriority.
	pusher := [ sema wait. 1 to: 100 do: [:i | q nextPut: i ]. ].
	feeder := [ sema wait. 
		[ q next.  crit critical: [count := count + 1 ]. count < 1000 ] whileTrue. done signal ].
	
	10 timesRepeat: [
		| proc |
		proc := pusher newProcess priority: prio + (r next * 10) asInteger.
		proc resume.
		
		proc := feeder newProcess priority: prio + (r next * 10) asInteger.
		feeders add: proc. 
		proc resume.		
	].

	" let them run "
	20 timesRepeat: [ sema signal ].
	Processor yield.
	
	done waitTimeoutSeconds: 10.
	 
	feeders do: [:ea | ea terminate ].
	self assert: (count = 1000 ).
	self assert: q nextOrNil == nil! !

!FIFOQueueTests methodsFor: 'tests' stamp: 'Igor.Stasenko 10/15/2010 18:56'!
testNextOrNilSuchThat
	| q item |
	q := self newQueue.
	q nextPut: 5.
	q nextPut: 6.

	item := q nextOrNilSuchThat: [ :x | x even ].
	self should: [ item = 6 ].

	self should: [ q nextOrNil = 5 ].
	self should: [ q nextOrNil = nil ].
! !

!FIFOQueueTests methodsFor: 'tests' stamp: 'Igor.Stasenko 10/16/2010 01:52'!
testHeavyContention2
	"run 10 threads, pushing new values to queue,
	and 10 threads pullung values from queue,
	at random priorities"
	
	| q sema prio pusher feeder
		feeders r crit done |

	r := Random new.
	q := AtomicSharedQueue new.
	feeders := OrderedCollection new.
	count := 0.
	sema := Semaphore new.
	crit := Semaphore forMutualExclusion.
	done := Semaphore new.
	
	prio := Processor activePriority.
	pusher := [ sema wait. 1 to: 100 do: [:i | q nextPut: i ]. ].
	feeder := [ sema wait. 
		[ q waitForNewItems. q next. crit critical: [count := count + 1 ]. count < 1000 ] whileTrue. done signal ].
	
	10 timesRepeat: [
		| proc |
		proc := pusher newProcess priority: prio + (r next * 10) asInteger - 5.
		proc resume.
		proc := feeder newProcess priority: prio + (r next * 10) asInteger - 5.
		feeders add: proc. 
		proc resume.		
	].

	" let them run "
	20 timesRepeat: [ sema signal ].
	Processor yield.
	
	done waitTimeoutSeconds: 10.
	 
	feeders do: [:ea | ea terminate ].
	self assert: (count = 1000 ).
	self assert: q nextOrNil == nil
! !

!FLAbstractCollectionCluster commentStamp: '<historical>'!
A FLAbstractCollectionCluster is the common behavior for all cluster collections. !
!FLAbstractCollectionCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 2/25/2013 14:44'!
materializeReferencesOf: anObject with: aDecoder
	"Hook method"

	self subclassResponsibility! !

!FLAbstractCollectionCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 2/25/2013 14:44'!
serializeReferencesOf: anObject with: anEncoder
	^ self subclassResponsibility ! !

!FLAbstractCollectionCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 7/26/2012 14:33'!
afterMaterializationStepWith: aDecoder  

	objects do: [ :anObject | anObject fuelAfterMaterialization ]! !

!FLAbstractCollectionCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 7/26/2012 14:22'!
serializeReferencesStepWith: anEncoder

	objects do: [ :anObject | self serializeReferencesOf: anObject with: anEncoder ]! !

!FLAbstractCollectionCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 7/26/2012 14:24'!
materializeReferencesStepWith: aDecoder

	objects do: [ :anObject | self materializeReferencesOf: anObject with: aDecoder ]! !

!FLAbstractCollectionCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 7/26/2012 16:07'!
serializeInstance: anObject with: anEncoder
	anEncoder encodePositiveInteger: anObject size! !

!FLAbstractCollectionCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 7/26/2012 14:06'!
materializeInstanceWith: aDecoder

	^theClass new: aDecoder nextEncodedPositiveInteger! !

!FLAbstractCollectionCluster class methodsFor: 'analyzing' stamp: 'MarianoMartinezPeck 7/26/2012 17:38'!
clusterBucketIn: aClusterization

	"During the materialization references step, we may send, for example, #hash to the newly materialized objects. #hash can be implemented delegating to OTHER objects which may not have been materialized yet (I mean, its references may not have been set yet). So in this case, we need to let these clusters at the end."
	^aClusterization postBaselevelBucket! !

!FLAnalysis commentStamp: 'MartinDias 8/29/2011 19:15'!
I am responsible of traversing the graph of references starting from a root object. I will produce a clusterization which the serializer will store on a stream.

An example of use is:

	(FLAnalyzer newDefault 
		clusterizationOf: (Array with: 1@2 with: 3@4))
		clusters.
!
!FLAnalysis methodsFor: 'tracing' stamp: 'MarianoMartinezPeck 9/18/2012 10:58'!
privateTrace: anObject

	privateObjectStack push: anObject! !

!FLAnalysis methodsFor: 'initialize-release' stamp: 'MarianoMartinezPeck 9/18/2012 10:58'!
initializeWith: aMapper private: privateMapper root: anObject

	self initialize.
	firstMapper := aMapper.
	privateFirstMapper := privateMapper.
	aMapper analysis: self.
	privateMapper analysis: self.
	root := anObject.
	objectStack := FLSimpleStack new.
	privateObjectStack := FLSimpleStack new.
	clusterization := FLClusterization new.
! !

!FLAnalysis methodsFor: 'mapping' stamp: 'MaxLeske 5/3/2013 15:35'!
mapAndTrace: anObject
	"Map an object to its cluster. Trace its references."

	firstMapper mapAndTrace: anObject fuelReplacement! !

!FLAnalysis methodsFor: 'mapping' stamp: 'MarianoMartinezPeck 9/18/2012 10:58'!
privateMapAndTrace: anObject
	"Map an object to its cluster. Trace its references."

	privateFirstMapper mapAndTrace: anObject! !

!FLAnalysis methodsFor: 'accessing' stamp: 'MartinDias 9/9/2011 21:47'!
clusterization

	^clusterization! !

!FLAnalysis methodsFor: 'hooks' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper
	^ aGeneralMapper visitSubstitution: self by: nil! !

!FLAnalysis methodsFor: 'analyzing' stamp: 'MarianoMartinezPeck 9/18/2012 10:58'!
run

	objectStack push: root.
	[ objectStack isEmpty ] 
		whileFalse: [ self mapAndTrace: objectStack pop ].
	[ privateObjectStack isEmpty ] 
		whileFalse: [ self privateMapAndTrace: privateObjectStack pop ].! !

!FLAnalysis methodsFor: 'tracing' stamp: 'MartinDias 8/20/2011 22:11'!
trace: anObject

	objectStack push: anObject! !

!FLAnalysis class methodsFor: 'instance creation' stamp: 'MarianoMartinezPeck 9/18/2012 10:59'!
newWith: aMapper private: privateMapper root: anObject

	^self basicNew
		initializeWith: aMapper private: privateMapper root: anObject;
		yourself.! !

!FLAnalyzer commentStamp: 'MartinDias 8/29/2011 19:15'!
I am responsible of traversing the graph of references starting from a root object. I will produce a clusterization which the serializer will store on a stream.

An example of use is:

	(FLAnalyzer newDefault 
		clusterizationOf: (Array with: 1@2 with: 3@4))
		clusters.
!
!FLAnalyzer methodsFor: 'configuring' stamp: 'MartinDias 9/10/2011 17:04'!
when: aCondition substituteBy: aFactory

	pluggableSubstitutions add: aCondition -> aFactory! !

!FLAnalyzer methodsFor: 'analyzing' stamp: 'MartinDias 2/21/2013 17:30'!
lightGlobalMappers

	^ globalSymbols isEmpty
		ifTrue: [ #() ]
		ifFalse: [ Array with: (FLLightGlobalMapper for: globalSymbols in: self globalEnvironment) ]! !

!FLAnalyzer methodsFor: 'defaults' stamp: 'MarianoMartinezPeck 12/14/2011 20:43'!
generalMapper

	^generalMapperFactory value! !

!FLAnalyzer methodsFor: 'protected' stamp: 'MartinDias 9/10/2011 17:55'!
pluggableSubstitutionMappers

	^pluggableSubstitutions collect: [:aLink |
		FLPluggableSubstitutionMapper 
			when: aLink key
			substituteBy: aLink value]! !

!FLAnalyzer methodsFor: 'protected' stamp: 'MartinDias 1/10/2012 14:25'!
firstInMapperChain

	^ self mappers first
! !

!FLAnalyzer methodsFor: 'accessing' stamp: 'MartinDias 9/11/2011 11:22'!
globalMappers
	
	^globalMappersFactory value! !

!FLAnalyzer methodsFor: 'analyzing' stamp: 'MartinDias 9/14/2011 00:15'!
analysisFor: anObject

	^analysisFactory value: anObject! !

!FLAnalyzer methodsFor: 'configuring' stamp: 'MartinDias 12/30/2011 19:25'!
considerGlobal: aSymbol 

	globalSymbols add: aSymbol! !

!FLAnalyzer methodsFor: 'hooks' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper
	^ aGeneralMapper visitSubstitution: self by: nil! !

!FLAnalyzer methodsFor: 'accessing' stamp: 'MartinDias 2/21/2013 23:35'!
globalEnvironment
	"Answer a dictionary where the look up for global symbols will be done during serialization."
	
	^ globalEnvironment! !

!FLAnalyzer methodsFor: 'protected' stamp: 'MarianoMartinezPeck 9/18/2012 11:00'!
setDefaultAnalysis

	analysisFactory := [:anObject | 
		(FLAnalysis 
			newWith: self firstInMapperChain 
			private: self privateFirstInMapperChain
			root: anObject)
			run;
			yourself ]! !

!FLAnalyzer methodsFor: 'accessing' stamp: 'MartinDias 2/25/2013 11:26'!
globalEnvironment: aDictionary 

	globalEnvironment := aDictionary ! !

!FLAnalyzer methodsFor: 'protected' stamp: 'MarianoMartinezPeck 9/18/2012 11:00'!
privateMappers

	^ OrderedCollection new
		addAll: self globalMappers;
		add: self generalMapper;
		reduceRight: [:left :right | left next: right ];
		yourself! !

!FLAnalyzer methodsFor: 'initialization' stamp: 'MartinDias 2/21/2013 23:35'!
initialize

	super initialize.
	self setDefaultAnalysis.
	self useLightMappers.
	pluggableSubstitutions := OrderedCollection new.
	internalClasses := IdentitySet new.
	internalMethods := IdentitySet new. 
	globalEnvironment := self class environment.
	globalSymbols := self class defaultGlobalSymbols asIdentitySet.
! !

!FLAnalyzer methodsFor: 'accessing' stamp: 'MartinDias 5/21/2012 12:30'!
useLightMappers

	globalMappersFactory := [self lightGlobalMappers].
	generalMapperFactory := [FLLightGeneralMapper new].! !

!FLAnalyzer methodsFor: 'protected' stamp: 'MarianoMartinezPeck 9/18/2012 11:00'!
privateFirstInMapperChain

	^ self privateMappers first
! !

!FLAnalyzer methodsFor: 'configuring' stamp: 'MartinDias 1/10/2012 14:41'!
globalSymbols
	"Answer the collection of symbols whose associations and values in Smalltalk globals will be considered as globals by Fuel."
	
	^ globalSymbols! !

!FLAnalyzer methodsFor: 'protected' stamp: 'MartinDias 1/10/2012 14:21'!
mappers

	^ OrderedCollection new
		addAll: self pluggableSubstitutionMappers;
		addAll: self globalMappers;
		add: self generalMapper;
		reduceRight: [:left :right | left next: right ];
		yourself! !

!FLAnalyzer class methodsFor: 'accessing' stamp: 'MarcusDenker 10/15/2013 12:53'!
defaultGlobalSymbols

    ^ #(#Smalltalk #SourceFiles #Transcript #Undeclared #Display #TextConstants #ActiveWorld #ActiveHand #ActiveEvent #Sensor #Processor #SystemOrganization #World) select: [:each | self environment includesKey: each ]! !

!FLAnalyzer class methodsFor: 'instance creation' stamp: 'MartinDias 9/9/2011 21:25'!
newDefault
	"Returns an instance with default configuration."

	^self new! !

!FLBadSignature commentStamp: 'MarianoMartinezPeck 10/23/2011 14:32'!
I represent an error produced during materialization when the serialized signature doesn't match the materializer's signature (accessible via FLMaterializer>>signature). A signature is a byte prefix that should prefix a well-serialized stream.!
!FLBadSignature class methodsFor: 'signaling' stamp: 'MartinDias 3/20/2012 12:03'!
signalCurrentSignature: currentSignature streamSignature: streamSignature

	^ self signal: 'Unexpected stream signature ', streamSignature asString, ' where it should be ', currentSignature asString, '.'! !

!FLBadVersion commentStamp: 'MarianoMartinezPeck 10/23/2011 14:33'!
I represent an error produced during materialization when the serialized version doesn't match the materializer's version (accessible via FLMaterializer>>version). A version is encoded in 16 bits and is enconded heading the serialized stream, after the signature.!
!FLBadVersion class methodsFor: 'signaling' stamp: 'MartinDias 3/20/2012 12:04'!
signalCurrentVersion: currentVersion streamVersion: streamVersion

	^ self signal: 'Unexpected stream version ', streamVersion asString, ' where it should be ', currentVersion asString, '.'
! !

!FLBasicSerializationTest commentStamp: 'TorstenBergmann 2/3/2014 23:24'!
SUnit tests for basic fuel serialization!
!FLBasicSerializationTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 4/17/2012 20:36'!
testWideAndByteCharacters
    "Since wide and byte characters are represented in the same class, this case is prone to fail."
	
	| materialized aByteCharacter aWideCharacter|
	aWideCharacter := Character value: 12345.
	aByteCharacter := $a.
	materialized := self resultOfSerializeAndMaterialize: (Array with: aWideCharacter with: aByteCharacter ).
	self assert: materialized first = aWideCharacter.
	self assert: materialized second == aByteCharacter.! !

!FLBasicSerializationTest methodsFor: 'tests' stamp: 'MartinDias 1/9/2012 21:00'!
testCharacter
	"Test character serialization. If the code is less than 255 the same instance is used. But if it is bigger, new ones are created. For more info read Character class comment and Character class >> value:"

	self assertSerializationIdentityOf: $a.
	self assertSerializationEqualityOf: (Character value: 12345). "Japanese Hiragana 'A' "
	self assertSerializationEqualityOf: Character allCharacters.
	self assertSerializationEqualityOf: (Array with: $a with: (Character value: 12345)).! !

!FLBasicSerializationTest methodsFor: 'tests-globals' stamp: 'MartinDias 12/15/2011 15:41'!
testCompiledMethod
	"They should be considered as globals by default."
	
	self assertSerializationIdentityOf: FLPair >> #left
! !

!FLBasicSerializationTest methodsFor: 'tests-numbers' stamp: 'MartinDias 10/17/2010 20:57'!
testSmallIntegerMaxValue

	self assertSerializationIdentityOf: SmallInteger maxVal .
	! !

!FLBasicSerializationTest methodsFor: 'tests-collections-Pharo1.3' stamp: 'MartinDias 8/13/2011 21:00'!
testSetWithSetElement

	self assertSerializationEqualityOf: (Set with: (SetElement with: 3))! !

!FLBasicSerializationTest methodsFor: 'failures' stamp: 'MaxLeske 2/26/2013 22:24'!
expectedFailures
	| failures |
	failures := #(testConsiderCustomWideSymbolGlobal).
		((SystemVersion current major = 1) 
			and: [SystemVersion current minor < 3]) ifTrue: [ 
				failures := failures, #(testSetElement testSetWithNil testSetWithSetElement) ].
	
	^ failures! !

!FLBasicSerializationTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 9/2/2011 14:25'!
testPoint

	self assertSerializationEqualityOf: 10@20.
	self assertSerializationEqualityOf: -10@20.
	self assertSerializationEqualityOf: -10@ -20.
	self assertSerializationEqualityOf: 1.1@2.2.
	self assertSerializationEqualityOf: 1.1@ -2.2.
	! !

!FLBasicSerializationTest methodsFor: 'tests-collections' stamp: 'MartinDias 10/5/2011 18:18'!
testSet
	| set materialized |
	set := Set new.
	set add: 10.
	set add: 20.
	set add: 30.
	set add: 30.
	
	materialized := self resultOfSerializeAndMaterialize: set.
	self assert: set = materialized.
	self assert: materialized size = 3.
	self assert: (materialized includes: 10).
	self assert: (materialized includes: 20).
	self assert: (materialized includes: 30).	! !

!FLBasicSerializationTest methodsFor: 'tests-cycles' stamp: 'MartinDias 11/11/2010 19:31'!
testCyclicLinks

	| a b c materializedA |
	a := Link new.
	b := Link new.
	c := Link new.
	
	a nextLink: b.
	b nextLink: c.
	c nextLink: a.
	
	materializedA := self resultOfSerializeAndMaterialize: a.

	"We can't check using the equality of the links because hangs ad infinitum. So we only check that the structure is right."
	self assert: materializedA nextLink nextLink nextLink == materializedA.
	self deny: materializedA nextLink == materializedA.
	self deny: materializedA nextLink nextLink == materializedA.! !

!FLBasicSerializationTest methodsFor: 'tests-numbers' stamp: 'MarianoMartinezPeck 10/11/2011 12:07'!
testFloat
	
	self assertSerializationEqualityOf: 180.0.
	self assertSerializationEqualityOf: 0.0.
	self assertSerializationEqualityOf: -0.0.
	self assertSerializationEqualityOf: 11.22321.
	self assertSerializationEqualityOf: -11.22321.
	self assertSerializationEqualityOf: -132311.22321.
	self assertSerializationEqualityOf: 1234567890.123456789.
	self assertSerializationEqualityOf: -1234567890.123456789.
	self assertSerializationEqualityOf: Float e.
	self assertSerializationEqualityOf: Float infinity.
	self assertSerializationEqualityOf: Float halfPi.
	self assertSerializationEqualityOf: Float negativeZero.
	self assertSerializationEqualityOf: Float halfPi.
	self assertSerializationEqualityOf: Float pi.
! !

!FLBasicSerializationTest methodsFor: 'tests' stamp: 'MartinDias 10/17/2010 20:56'!
testNil

	self assertSerializationIdentityOf: nil! !

!FLBasicSerializationTest methodsFor: 'tests-strings' stamp: 'dsfsfs 6/26/2012 09:57'!
testWideString

	self assertSerializationEqualityOf: 'aString' asWideString.
	self assertSerializationEqualityOf: (WideString
               streamContents: [ :stream |
                       2000 timesRepeat: [
                               stream nextPut: (256 to: 1000) atRandom asCharacter ] ] ).
! !

!FLBasicSerializationTest methodsFor: 'tests-collections' stamp: 'MartinDias 10/26/2010 19:46'!
testEmptyArray
	self assertSerializationEqualityOf: #()! !

!FLBasicSerializationTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 9/2/2011 10:42'!
testDate

	self assertSerializationEqualityOf: (Date fromDays: 37023).
	self assertSerializationEqualityOf: (Date today).
	self assertSerializationEqualityOf: (Date year: 3050 month: 12 day: 31).
	self assertSerializationEqualityOf: (Date year: 1600 month: 12 day: 31).
	 
	
	
	
	! !

!FLBasicSerializationTest methodsFor: 'tests-streams' stamp: 'MartinDias 10/5/2011 18:18'!
testWriteStream

	| aWriteStream materialized |
	aWriteStream := WriteStream on: (ByteArray new: 1).

	materialized := self resultOfSerializeAndMaterialize: aWriteStream.
	
	aWriteStream nextPut: 1.
	self assert: 1 = aWriteStream size.

	self assert: 0 = materialized size.
	materialized nextPut: 2.
	self assert: (Array with: 2) = materialized contents asArray.
! !

!FLBasicSerializationTest methodsFor: 'tests-numbers' stamp: 'MarianoMartinezPeck 10/11/2011 12:12'!
testLargePositiveInteger

	self assertSerializationEqualityOf: 354314316134313999999999.
	self assertSerializationEqualityOf: 100 factorial.
	! !

!FLBasicSerializationTest methodsFor: 'tests-collections' stamp: 'MarianoMartinezPeck 10/11/2011 12:00'!
testByteArrays

	self assertSerializationEqualityOf: { #[1 2 3 4 5 6]. #[1 2 3 4 5 6]. #[7 8 9 10 11 12]. #[7 8 9 10 11 12] }.
	self assertSerializationEqualityOf:  (ByteArray with: 10 with: 20 with: 30).
	self assertSerializationEqualityOf: ByteArray new.
	self assertSerializationEqualityOf: (ByteArray new: 100).
	self assertSerializationEqualityOf: (0 to: 255) asByteArray.! !

!FLBasicSerializationTest methodsFor: 'tests' stamp: 'MaxLeske 10/18/2012 08:07'!
testDateOffsets
	| bst sast materialized object |
	bst := TimeZone timeZones third.
	sast := TimeZone timeZones fourth.
	
	DateAndTime localTimeZone: bst.
	self assert: DateAndTime now offset equals: 1 hour.
	object := Date fromDays: 37023.
	self assert: object start offset equals: 0 hours.
	materialized := self resultOfSerializeAndMaterialize: object.
	self assert: materialized start offset equals: 0 hours.
	
	DateAndTime localTimeZone: sast.
	self assert: DateAndTime now offset equals: 2 hours.
	object := Date fromDays: 37023.
	self assert: object start offset equals: 0 hours.
	materialized := self resultOfSerializeAndMaterialize: object.
	self assert: materialized start offset equals: 0 hours
	! !

!FLBasicSerializationTest methodsFor: 'tests' stamp: 'MartinDias 6/3/2011 21:20'!
testLotsOfCharacters

	| all |
	all := OrderedCollection new.
	(1 << 16) timesRepeat: [
	all add: (1 to: 255 ) atRandom asCharacter ].
	self assertSerializationEqualityOf: all.! !

!FLBasicSerializationTest methodsFor: 'tests-globals' stamp: 'MartinDias 12/30/2011 18:44'!
testGlobalClass
	"A class should be global by default."
	
	self assertSerializationIdentityOf: Integer.
! !

!FLBasicSerializationTest methodsFor: 'tests-numbers' stamp: 'MartinDias 9/29/2010 11:27'!
testSmallIntegerNegative

	self assertSerializationIdentityOf: -42.! !

!FLBasicSerializationTest methodsFor: 'tests-collections-Pharo1.3' stamp: 'MartinDias 8/13/2011 20:58'!
testSetWithNil

	self assertSerializationEqualityOf: (Set with: nil)! !

!FLBasicSerializationTest methodsFor: 'tests' stamp: 'MartinDias 10/17/2010 20:59'!
testTrue

	self assertSerializationIdentityOf: true! !

!FLBasicSerializationTest methodsFor: 'tests-globals' stamp: 'CamilloBruni 4/29/2013 19:11'!
testConsiderCustomGlobal
	"A custom global variable is treated as global by Fuel, when we explicitly specify this."
	
	| aPerson globalKey |
	
	globalKey := #FLGlobalVariableForTesting.
	self analyzer considerGlobal: globalKey.

	aPerson := FLPerson new.
	[ 
		Smalltalk globals at: globalKey put: aPerson.
		self assertSerializationIdentityOf: aPerson.
	] ensure: [ Smalltalk globals removeKey: globalKey ]
! !

!FLBasicSerializationTest methodsFor: 'tests-strings' stamp: 'MartinDias 10/5/2011 18:17'!
testRemoteString
	"Tests that the materialized RemoteString has *the same* location on file."

	| aRemoteString materializedRemoteString |	
	aRemoteString := RemoteString new setSourcePointer: thisContext method sourcePointer.

	materializedRemoteString := self resultOfSerializeAndMaterialize: aRemoteString.

	self assert: aRemoteString string = materializedRemoteString string.
	self assert: aRemoteString sourcePointer == materializedRemoteString sourcePointer.! !

!FLBasicSerializationTest methodsFor: 'tests-numbers' stamp: 'MarianoMartinezPeck 10/11/2011 12:12'!
testLargeNegativeInteger

	self assertSerializationEqualityOf: -354314316134313999999999.
	self assertSerializationEqualityOf: 0-100 factorial.! !

!FLBasicSerializationTest methodsFor: 'tests-numbers' stamp: 'MarianoMartinezPeck 10/11/2011 12:16'!
testSmallInteger

	self assertSerializationIdentityOf: -1212.
	self assertSerializationIdentityOf: 7.
	self assertSerializationIdentityOf: 0.
	self assertSerializationIdentityOf: 1111.
	self assertSerializationIdentityOf: SmallInteger one.

! !

!FLBasicSerializationTest methodsFor: 'tests-cycles' stamp: 'MartinDias 3/21/2011 16:08'!
testCyclicLink

	| a materializedA |
	a := Link new.
	a nextLink: a.
	
	materializedA := self resultOfSerializeAndMaterialize: a.

	"We can't check using the equality of the links because hangs ad infinitum. So we only check that the structure is right."
	self assert: materializedA nextLink == materializedA! !

!FLBasicSerializationTest methodsFor: 'tests-strings' stamp: 'MarianoMartinezPeck 10/11/2011 12:20'!
testSymbol

	self assertSerializationIdentityOf: #testSymbol.
	self assertSerializationIdentityOf: #with:with:with:with:.
	self assertSerializationIdentityOf: #'hello there'.! !

!FLBasicSerializationTest methodsFor: 'tests' stamp: 'MartinDias 10/5/2011 18:18'!
testSharedReferences
	| oneDotOne  point1 point2 materialized array |
	
	oneDotOne := 1.1.
	
	"I cannot directly use 4.2 because the Compiler reuses the same float instance 4.2 for the literals and hence the last assert fails. "
	point1:= Point x: oneDotOne y: (Float readFrom: '4.2' readStream).
	point2:= Point x: (Float readFrom: '4.2' readStream) y: oneDotOne.
	array := (Array with: point1 with: point2).
	
	materialized := self resultOfSerializeAndMaterialize: array.
	self assert: array = materialized.
	self assert: materialized first x == materialized second y.
	self deny: materialized first y == materialized second x.
	

	
	! !

!FLBasicSerializationTest methodsFor: 'tests-globals' stamp: 'MartinDias 1/10/2012 14:30'!
testSmalltalkGlobals
	"Smalltalk globals should be global by default."

	self assertSerializationIdentityOf: Smalltalk globals! !

!FLBasicSerializationTest methodsFor: 'tests-collections' stamp: 'MartinDias 10/26/2010 19:46'!
testEmptyOrderedCollection

	self assertSerializationEqualityOf: OrderedCollection new! !

!FLBasicSerializationTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 10/11/2011 12:12'!
testFraction

	self assertSerializationEqualityOf: (3 / 4).
	self assertSerializationEqualityOf: (4 / 3).
	self assertSerializationEqualityOf: (-4 / 3).
	self assertSerializationEqualityOf: (-4 / -3).
	self assertSerializationEqualityOf: (4 / -3).	
	self assertSerializationIdentityOf: (0-0 / -3).	
	self assertSerializationEqualityOf: 0-(1001/1000).	


! !

!FLBasicSerializationTest methodsFor: 'tests-graph-modification' stamp: 'MaxLeske 5/3/2013 17:38'!
testFuelReplacement
	| object |
	self 
		assert: (self resultOfSerializeAndMaterialize: FLReplacementClassMock)
		equals: nil.
		
	self
		assert: (self resultOfSerializeAndMaterialize: {FLReplacementClassMock})
		equals: { nil }.

	object := FLReplacementMock new
		ignoreMe;
		yourself.
	self 
		assert: (self resultOfSerializeAndMaterialize: {object})
		equals: { nil }.
		
	object dontIgnoreMe.
	self 
		assert: (self resultOfSerializeAndMaterialize: {object})
		equals: { object }! !

!FLBasicSerializationTest methodsFor: 'tests-collections' stamp: 'MartinDias 6/5/2011 01:52'!
testEmptySet

	self assertSerializationEqualityOf: Set new! !

!FLBasicSerializationTest methodsFor: 'tests-collections' stamp: 'MartinDias 9/19/2011 11:27'!
testArray
	self assertSerializationEqualityOf: #(1).
	self assertSerializationEqualityOf: #(10 20).
	self assertSerializationEqualityOf: #(1 2 3 #('Hello' 2 3)).
	

! !

!FLBasicSerializationTest methodsFor: 'tests-collections' stamp: 'MarianoMartinezPeck 6/20/2011 17:21'!
testRunArray

	self assertSerializationEqualityOf: (RunArray runs: #(1 2 1) values: #(1 2 3))
! !

!FLBasicSerializationTest methodsFor: 'tests-fuelAfterMaterialization' stamp: 'MarianoMartinezPeck 4/19/2012 19:10'!
testExecuteAfterMaterialization

	| anObject result aClass |
	aClass := 
		self newClass
			addInstVarNamed: 'a';
			duringTestCompileSilently: 'fuelAfterMaterialization a := #A';
			yourself.
	anObject := aClass new.

	result := self resultOfSerializeAndMaterialize: anObject.

	self assert: #A = (result instVarNamed: 'a').
! !

!FLBasicSerializationTest methodsFor: 'tests' stamp: 'MaxLeske 10/18/2012 08:08'!
testDateOffsetsChanging
	| bst sast object |
	bst := TimeZone timeZones third.
	sast := TimeZone timeZones fourth.
	
	DateAndTime localTimeZone: bst.
	self assert: DateAndTime now offset equals: 1 hour.
	object := Date fromDays: 37023.
	self assert: object start offset equals: 0 hours.
	self serialize:object.
	
	DateAndTime localTimeZone: sast.
	self assert: DateAndTime now offset equals: 2 hours.
	object := Date fromDays: 37023.
	self assert: object start offset equals: 0 hours.
	self assert: self materialized start offset equals: 0 hours
	! !

!FLBasicSerializationTest methodsFor: 'tests' stamp: 'MartinDias 11/25/2010 18:40'!
testPair

	self assertSerializationEqualityOf:
			(FLPair new
				left: 10;
				right: 20;
				yourself)! !

!FLBasicSerializationTest methodsFor: 'tests-collections' stamp: 'MartinDias 3/21/2011 16:10'!
testWordArray

	self assertSerializationEqualityOf: (WordArray with: 10 with: 20)! !

!FLBasicSerializationTest methodsFor: 'tests' stamp: 'MartinDias 10/17/2010 20:59'!
testFalse

	self assertSerializationIdentityOf: false! !

!FLBasicSerializationTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 9/20/2011 20:39'!
testTime

	self assertSerializationEqualityOf: (Time fromSeconds: 84072).
	self assertSerializationEqualityOf: (Time hour: 24 minute: 60 second: 60).
	self assertSerializationEqualityOf: (Time hour: 23 minute: 59 second: 59).
	self assertSerializationEqualityOf: (Time hour: 0 minute: 0 second: 0).
	self assertSerializationEqualityOf: (Time seconds: 0 nanoSeconds: 5).
	self assertSerializationEqualityOf: (Time allInstances sort:  [:a :b | a asSeconds > b asSeconds]) first.
	self assertSerializationEqualityOf: (Time allInstances sort:  [:a :b | a nanoSecond > b nanoSecond]) first
		
! !

!FLBasicSerializationTest methodsFor: 'tests-globals' stamp: 'MartinDias 12/15/2011 15:42'!
testClassSideCompiledMethod
	"They should be considered as globals by default."
	
	self assertSerializationIdentityOf: FLGlobalSendMock class >> #newInstanceToSerialize
! !

!FLBasicSerializationTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 10/11/2011 12:06'!
testExceptions
	| ex |
	ex := (Error new messageText: 'sample error').
	self assert: (self resultOfSerializeAndMaterialize: ex) messageText equals: ex messageText.
	
	ex := (Warning new messageText: 'sample warning').
	self assert: (self resultOfSerializeAndMaterialize: ex) messageText equals: ex messageText.
	
	ex := (Notification new messageText: 'sample notification').
	self assert: (self resultOfSerializeAndMaterialize: ex) messageText equals: ex messageText.
	
! !

!FLBasicSerializationTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 6/20/2011 17:09'!
testColor

	self assertSerializationEqualityOf: Color blue.
	self assertSerializationEqualityOf: Color black.
	! !

!FLBasicSerializationTest methodsFor: 'tests-collections-Pharo1.3' stamp: 'MartinDias 9/9/2011 12:49'!
testSetElement

	self assertSerializationEqualityOf: (SetElement with: 3)! !

!FLBasicSerializationTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 9/2/2011 14:25'!
testRectangle
	
	self assertSerializationEqualityOf: (10@20 corner: 30@40).
	self assertSerializationEqualityOf: (1.1@2.2 corner: 3.3@4.4).
	self assertSerializationEqualityOf: (1.1@ -2.2 corner: -3.3@4.4).! !

!FLBasicSerializationTest methodsFor: 'tests-globals' stamp: 'CamilloBruni 4/29/2013 19:10'!
testConsiderCustomWideSymbolGlobal
	"The same than #testConsiderCustomGlobal but with a WideSymbol."
	
	| aWideSymbol aPerson |
	
	aWideSymbol := (WideString streamContents: [ :stream |
		256 to: 260 do: [ :code | 
			stream nextPut: code asCharacter ] ]) asSymbol.

	self analyzer considerGlobal: aWideSymbol.

	aPerson := FLPerson new.
	
	[ 
		Smalltalk globals at: aWideSymbol put: aPerson.
		self assertSerializationIdentityOf: aPerson 
	] ensure: [ Smalltalk globals removeKey: aWideSymbol ].
! !

!FLBasicSerializationTest methodsFor: 'tests' stamp: 'MartinDias 9/9/2011 01:40'!
testDuration
	
	self assertSerializationEqualityOf: 123 seconds.
	self assertSerializationEqualityOf: -123 seconds.
	self assertSerializationEqualityOf: (
		Duration 
			seconds: 3 
			nanoSeconds: 35).
	
! !

!FLBasicSerializationTest methodsFor: 'tests-not-so-basic' stamp: 'MartinDias 5/19/2012 18:48'!
testNotSerializableObject

	self 
		should: [ self serialize: FLNotSerializableMock new ] 
		raise: FLNotSerializable
		whoseDescriptionIncludes: FLNotSerializableMock new printString
		description: 'User can prevent some objects from serialization.'! !

!FLBasicSerializationTest methodsFor: 'tests-collections' stamp: 'MartinDias 4/19/2011 13:02'!
testColorArray

	self assertSerializationEqualityOf: (ColorArray with: (Color r: 0.0 g: 0.031 b: 0.008) with: (Color r: 0.0 g: 0.07 b: 0.023))! !

!FLBasicSerializationTest methodsFor: 'tests-numbers' stamp: 'MarianoMartinezPeck 6/15/2012 19:55'!
testAllRangeOfIntegers

		self assertSerializationIdentityOf: 100.
		self assertSerializationIdentityOf: 10000.
		self assertSerializationIdentityOf: 100000.
		self assertSerializationIdentityOf: 10000000.
		self assertSerializationIdentityOf: 100000000.
		self assertSerializationIdentityOf: 1000000000.
		self assertSerializationEqualityOf: 3000000000.
		self assertSerializationEqualityOf: 10000000000.
		self assertSerializationEqualityOf: 100000000000.
		self assertSerializationEqualityOf: 100 factorial.

		self assertSerializationIdentityOf: -100.
		self assertSerializationIdentityOf: -10000.
		self assertSerializationIdentityOf: -100000.
		self assertSerializationIdentityOf: -10000000.
		self assertSerializationIdentityOf: -100000000.
		self assertSerializationIdentityOf: -1000000000.
		self assertSerializationEqualityOf: -3000000000.
		self assertSerializationEqualityOf: -10000000000.
		self assertSerializationEqualityOf: -100000000000.
		self assertSerializationEqualityOf:  100 factorial * -1.

! !

!FLBasicSerializationTest methodsFor: 'tests' stamp: 'MartinDias 6/3/2011 20:27'!
testLotsOfNils

	self assertSerializationEqualityOf: (Array new: 1 << 16).! !

!FLBasicSerializationTest methodsFor: 'tests-globals' stamp: 'MartinDias 12/30/2011 18:44'!
testGlobalMetaclass
	"A metaclass should be global by default."
	
	self assertSerializationIdentityOf: Integer class.
! !

!FLBasicSerializationTest methodsFor: 'tests-collections' stamp: 'MartinDias 10/26/2010 19:45'!
testEmptyDictionary

	self assertSerializationEqualityOf: Dictionary new! !

!FLBasicSerializationTest methodsFor: 'tests-strings' stamp: 'MarianoMartinezPeck 10/11/2011 12:17'!
testString

	self assertSerializationEqualityOf: 'testString'.
	self assertSerializationEqualityOf:  'Hi, I''m String-object'.
	self assertSerializationEqualityOf:  String new.
	self assertSerializationEqualityOf:  (0 to: 255) asByteArray asString.
	
! !

!FLBasicSerializationTest methodsFor: 'tests-cycles' stamp: 'MartinDias 10/5/2011 18:15'!
testCyclicLinksInArray

	| a b c materializedA materialized |
	a := Link new.
	b := Link new.
	c := Link new.
	
	a nextLink: b.
	b nextLink: c.
	c nextLink: a.
	
	materialized := self resultOfSerializeAndMaterialize: (Array with: a with: b with: c).
	materializedA := materialized first.

	"We can't check using the equality of the links because hangs ad infinitum. So we only check that the structure is right."
	self assert: materialized size = 3.
	self assert: materializedA nextLink nextLink nextLink == materializedA.
	self deny: materializedA nextLink == materializedA.
	self deny: materializedA nextLink nextLink == materializedA.! !

!FLBasicSerializationTest methodsFor: 'tests-numbers' stamp: 'MarianoMartinezPeck 10/11/2011 12:14'!
testScaledDecimal

	self assertSerializationEqualityOf: (13/11s6).
	self assertSerializationEqualityOf: (-13/11s6).
	self assertSerializationEqualityOf: (7621476292473147/9007199254740992s8).
	self assertSerializationEqualityOf: (-7621476292473147/9007199254740992s8).
	self assertSerializationEqualityOf: (-0/9007199254740992s8).
	self assertSerializationEqualityOf: ((13 / 11) asScaledDecimal: 6).
	self assertSerializationEqualityOf: ((11 / 13) asFloat asScaledDecimal).
! !

!FLBasicSerializationTest methodsFor: 'tests-collections' stamp: 'MartinDias 10/5/2011 17:51'!
testBitmap
	| bitmap materialized |
	self assertSerializationEqualityOf: (Bitmap with: 0 with: 16rFFFFFFFF).
	self assertSerializationEqualityOf: (Bitmap with: 4278190080).
	self assertSerializationEqualityOf: (Bitmap new: 4096).
	self assertSerializationEqualityOf: (Bitmap with: 0 with: 4294967295).
	self assertSerializationEqualityOf: (Bitmap new: 256).
	self assertSerializationEqualityOf: (Bitmap with: 0).
	bitmap := Bitmap new: 3.
	bitmap at: 1 put: 4324.
	bitmap at: 2 put: 5674.
	bitmap at: 3 put: 8978.
	materialized := self resultOfSerializeAndMaterialize: bitmap.
	self assert: (materialized at: 1) = 4324.
	self assert: (materialized at: 2) = 5674.
	self assert: (materialized at: 3) = 8978.	


! !

!FLBasicSerializationTest methodsFor: 'tests-not-so-basic' stamp: 'MartinDias 8/8/2011 15:47'!
testGradientFillStyle

	self assertSerializationEqualityOf: GradientFillStyle sample! !

!FLBasicSerializationTest methodsFor: 'running' stamp: 'MaxLeske 10/18/2012 07:42'!
tearDown
	super tearDown.
	DateAndTime localTimeZone: currentTimeZone! !

!FLBasicSerializationTest methodsFor: 'tests-collections' stamp: 'MarianoMartinezPeck 4/20/2012 21:37'!
testMethodDictionary
	self resultOfSerializeAndMaterializeMethodDictionary: FLPair methodDict.
	! !

!FLBasicSerializationTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 10/11/2011 12:21'!
testUUID

	self assertSerializationEqualityOf: (UUID fromString: 'a3b64357-377a-5b41-b575-1c653084a121').
	self assertSerializationEqualityOf: UUID nilUUID.
	self assertSerializationEqualityOf: UUID new.
	! !

!FLBasicSerializationTest methodsFor: 'tests-globals' stamp: 'MaxLeske 2/20/2013 22:18'!
testSystemDictionary
	"We want to treat the <Smalltalk globals> instance of SystemDictionary
	specially but want to serialize all others"

	self assertSerializationEqualityOf: SystemDictionary new! !

!FLBasicSerializationTest methodsFor: 'tests-collections' stamp: 'MartinDias 10/5/2011 17:54'!
testBag
	| bag materialized |
	bag := Bag new.
	bag add: 10.
	bag add: 20.
	bag add: 30.
	bag add: 30.
	
	materialized := self resultOfSerializeAndMaterialize: bag.
	self assert:  bag ~~ materialized.
	self assert: bag = materialized.
	self assert: materialized size = 4.
	! !

!FLBasicSerializationTest methodsFor: 'tests-collections' stamp: 'MartinDias 10/17/2010 20:59'!
testDictionary

	self assertSerializationEqualityOf: (Dictionary with: 1->2).! !

!FLBasicSerializationTest methodsFor: 'running' stamp: 'MaxLeske 10/18/2012 07:42'!
setUp
	super setUp.
	currentTimeZone := DateAndTime localTimeZone.! !

!FLBasicSerializationTest methodsFor: 'tests-cycles' stamp: 'MartinDias 10/5/2011 18:16'!
testRecursiveArray

	| arr materialized |
	arr := Array new: 3.
	arr at: 1 put: 10.
	arr at: 2 put: 20.
	arr at: 3 put: arr.
	
	materialized := self resultOfSerializeAndMaterialize: arr.

	"We can't check using the equality of the links because hangs ad infinitum. So we only check that the structure is right."
	self assert: materialized first = 10.
	self assert: materialized second = 20.
	self assert: materialized third == materialized.! !

!FLBasicSerializationTest methodsFor: 'tests-collections' stamp: 'MarianoMartinezPeck 6/20/2011 17:11'!
testNestedDictionary

	| childDic dic |
	childDic := Dictionary new.
	childDic at: #child1 put: 'abcde'.
	dic := Dictionary new.
	dic at: #parent1 put: 'sample string.'.
	dic at: #parent2 put: 100.
	dic at: #parent3 put: #(10 20 30 ).
	dic at: #parent4 put: childDic.
	
	self assertSerializationEqualityOf: childDic.
	self assertSerializationEqualityOf: dic.! !

!FLBasicSerializationTest methodsFor: 'tests-globals' stamp: 'CamilloBruni 4/29/2013 19:10'!
testDontConsiderCustomGlobal
	"A custom global variable is not treated as global by Fuel, unless we explicitly specify this."
	
	| aPerson globalName |
	
	aPerson := FLPerson new.
	globalName := #FLGlobalVariableForTesting.
	
	[ 
		Smalltalk globals at: globalName put: aPerson.
		self deny: (self resultOfSerializeAndMaterialize: aPerson) == aPerson 
	] ensure: [ Smalltalk globals removeKey: globalName ]. 
! !

!FLBasicSerializationTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 9/2/2011 10:41'!
testDateAndTime
	
	| initialTime initialDate |
	initialTime := Time fromSeconds: 76020.
	initialDate := Date fromSeconds: 3492288000.
	self assertSerializationEqualityOf: (DateAndTime date: initialDate time: initialTime).
	
	initialTime := (Time hour: 24 minute: 60 second: 60).
	initialDate := Date year: 3050 month: 12 day: 31.
	self assertSerializationEqualityOf: (DateAndTime date: initialDate time: initialTime).
	
	initialTime := (Time hour: 24 minute: 60 second: 60).
	initialDate := Date year: 1600 month: 12 day: 31.
	self assertSerializationEqualityOf: (DateAndTime date: initialDate time: initialTime).
	! !

!FLBasicSerializationTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 9/6/2011 23:33'!
testAssociation

	self assertSerializationEqualityOf: 1-> 'marino'.
	self assertSerializationEqualityOf: nil-> 'marino'.
	self assertSerializationEqualityOf: nil-> nil.
	self assertSerializationEqualityOf: nil-> #(1 3 4).
	self assertSerializationEqualityOf: nil-> true.! !

!FLBasicSerializationTest methodsFor: 'tests-streams' stamp: 'MartinDias 10/5/2011 18:15'!
testReadStream

	| aReadStream materialized |
	aReadStream := ReadStream on: 'A'.

	materialized := self resultOfSerializeAndMaterialize: aReadStream.
	
	self assert: $A = aReadStream next.

	self deny: materialized atEnd.
	self assert: $A = materialized next.
	self assert: materialized atEnd.! !

!FLBasicSerializationTest methodsFor: 'tests-numbers' stamp: 'MartinDias 10/17/2010 21:04'!
testSmallIntegerMinValue

	self assertSerializationIdentityOf: SmallInteger minVal ! !

!FLBasicSerializationTest methodsFor: 'tests-cycles' stamp: 'MarianoMartinezPeck 9/28/2011 22:35'!
testCyclicIdentitySet

	| aSet materializedSet |
	aSet := IdentitySet new.
	aSet add: aSet.
	
	materializedSet := self resultOfSerializeAndMaterialize: aSet.
	self assert: aSet ~~ materializedSet .
	self assert: (materializedSet includes: materializedSet) description: 'The materialized set has to include himself. Note aSet = materializedSet is false, bacause equality implementation checks that materializedSet *identity-includes* each element of aSet, which is false.'! !

!FLBasicSerializationTest methodsFor: 'tests-collections' stamp: 'MarianoMartinezPeck 6/6/2011 23:10'!
testInterval

	self assertSerializationEqualityOf: (-10 to: 10 by: 5).
	self assertSerializationEqualityOf: (-0 to: 0 by: 1).
	self assertSerializationEqualityOf: (1 to: 10 by: 2).
	self assertSerializationEqualityOf: (33333333333333331 to: 1444444444444444440 by: 2).
	self assertSerializationEqualityOf: (0 to: 1 by: 2).
	! !

!FLBasicSerializationTest methodsFor: 'tests-collections' stamp: 'MartinDias 9/29/2010 11:27'!
testOrderedCollection

	self assertSerializationEqualityOf: (OrderedCollection with: 10 with: 20)! !

!FLBitsObjectCluster commentStamp: 'MartinDias 8/1/2011 02:59'!
I have the common behavior for generic storing and loading variable bits objects.!
!FLBitsObjectCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 10/13/2011 16:26'!
registerIndexesOn: aDictionary

	self flag: #todo. "Converting objects collection here in this method is a bit confusing. This is because since this cluster is for primitives, they do not have pointers to other objects. Hence, instead of storing them in a IdentitySet we can use an OrderedCollection and then just convert them at the end. For more details see FLBitsObjectCluster >> #add: anObject traceWith: aAnalysis"
	objects := objects asIdentitySet.
	super registerIndexesOn: aDictionary.! !

!FLBitsObjectCluster methodsFor: 'analyzing' stamp: 'MartinDias 1/8/2012 13:12'!
newAnalyzingCollection
	"Answer a collection for the objects that correspond to this cluster."

	^OrderedCollection new! !

!FLBitsObjectCluster methodsFor: 'analyzing' stamp: 'MartinDias 10/13/2011 16:26'!
add: anObject traceWith: aAnalysis
	"Add an object to the cluster. We know the object doesn't have references."

	objects addLast: anObject! !

!FLBlockClosureSerializationTest commentStamp: 'TorstenBergmann 2/3/2014 23:26'!
SUnit tests for fuel serialization of block closures!
!FLBlockClosureSerializationTest methodsFor: 'tests-clean' stamp: 'MartinDias 3/23/2012 02:01'!
testBlockClosureWithThreeArguments
	| closure materializedClosure |
	closure := [ :a :b :c | a + b + c ].
	materializedClosure := self resultOfSerializeAndMaterialize: closure.
	closure assertWellMaterializedInto: materializedClosure in: self.
	self assert: (materializedClosure value: 1 value: 2 value: 3) = 6! !

!FLBlockClosureSerializationTest methodsFor: 'tests-change' stamp: 'MarianoMartinezPeck 4/19/2012 19:10'!
testBlockClosureRemoved
	"Raise an error when materializing a closure whose method was removed."

	| aClass aClosure |
	aClass := self newClass
		duringTestCompileSilently: 'methodWithClosure  ^ [ 42 ]';
		yourself.
	aClosure := aClass new perform: #methodWithClosure.
	self serialize: aClosure.
	aClass removeSelectorSilently: #methodWithClosure.
	self should: [ self materialized ] raise: FLMethodNotFound! !

!FLBlockClosureSerializationTest methodsFor: 'tests-unclean' stamp: 'MartinDias 3/23/2012 12:09'!
testBlockClosureWithSelfSend
	| closure materializedClosure |
	closure := self class blockClosureWithSelfSend.
	materializedClosure := self resultOfSerializeAndMaterialize: closure.
	closure assertWellMaterializedInto: materializedClosure in: self.
	self assert: materializedClosure value = closure value! !

!FLBlockClosureSerializationTest methodsFor: 'tests-change' stamp: 'MarianoMartinezPeck 4/19/2012 19:10'!
testBlockClosureChangeDifferentBytecodes
	"Raise an error when materializing a closure whose method has changed bytecodes."

	| aClass aClosure |
	aClass := self newClass
		duringTestCompileSilently: 'methodWithClosure  ^ [ 42 ]';
		yourself.
	aClosure := aClass new perform: #methodWithClosure.
	self serialize: aClosure.
	aClass duringTestCompileSilently: 'methodWithClosure  ^ 42'.
	self should: [ self materialized ] raise: FLMethodChanged! !

!FLBlockClosureSerializationTest methodsFor: 'tests-change' stamp: 'MarianoMartinezPeck 4/19/2012 19:10'!
testBlockClosureChangeSameBytecodes
	"Tolerate materializing a closure whose method has changed but not the bytecodes."

	| aClass aClosure materializedClosure |
	aClass := self newClass
		duringTestCompileSilently: 'methodWithClosure  ^ [ 41 ]';
		yourself.
	aClosure := aClass new perform: #methodWithClosure.
	self serialize: aClosure.
	aClass duringTestCompileSilently: 'methodWithClosure  ^ [ 42 ]'.
	self deny: aClosure method isInstalled.
	materializedClosure := self materialized.
	self assert: materializedClosure value = 42! !

!FLBlockClosureSerializationTest methodsFor: 'tests-clean' stamp: 'MartinDias 3/23/2012 12:21'!
testNestedBlockClosure
	| closure materializedClosure |
	closure := [ [ 42 ] ].
	materializedClosure := self resultOfSerializeAndMaterialize: closure.
	closure assertWellMaterializedInto: materializedClosure in: self.
	self assert: materializedClosure value value = 42! !

!FLBlockClosureSerializationTest methodsFor: 'tests-clean' stamp: 'mada 5/4/2012 11:10'!
testBlockClosureWithTempVariableRead
	| closure materializedClosure |
	closure := self class blockClosureWithTempVariableRead.
	materializedClosure := self resultOfSerializeAndMaterialize: closure.
	closure assertWellMaterializedInto: materializedClosure in: self.
	self assert: materializedClosure value = 'TEST'.
! !

!FLBlockClosureSerializationTest methodsFor: 'tests-clean' stamp: 'MartinDias 3/23/2012 02:03'!
testBlockClosureWithClassVariableRead
	| closure materializedClosure |
	ClassVariableForTesting := nil.
	closure := [ ClassVariableForTesting ].
	materializedClosure := self resultOfSerializeAndMaterialize: closure.
	closure assertWellMaterializedInto: materializedClosure in: self.

	ClassVariableForTesting := true.
	self assert: materializedClosure value.
	ClassVariableForTesting := false.
	self deny: materializedClosure value! !

!FLBlockClosureSerializationTest class methodsFor: 'closures for testing' stamp: 'MartinDias 3/23/2012 12:08'!
blockClosureWithSelfSend
	^ [ self printString ]! !

!FLBlockClosureSerializationTest class methodsFor: 'closures for testing' stamp: 'mada 5/4/2012 11:10'!
blockClosureWithTempVariableRead
	| string |
	string := 'test'.
	^ [ string asUppercase ].! !

!FLBufferedWriteStream commentStamp: 'MarianoMartinezPeck 6/5/2011 12:41'!
FLBufferedWriteStream is a buffered write stream we use for Fuel serialization. Instead of directly using the stream provided to FLSerializer at creation time by the user, we create an instance of FLBufferedWriteStream for that stream.

MultiByteFileStream has no real buffer and goes to disk too frequently. With FLBufferedWriteStream we keep stuff in a cache and only go to disk when this is full.

The way of using it is jut FLBufferedWriteStream on: aWriteStream. For example:

FLBufferedWriteStream on: (FileDirectory default forceNewFileNamed:  'TestFile') binary

With the message #sizeBuffer: you can set the size of the buffer.

Make sure to always send #flush or #close when you're done, otherwise the last buffer might not yet have been written.
!
!FLBufferedWriteStream methodsFor: 'initialize-release' stamp: 'MartinDias 1/6/2012 18:06'!
initializeOn: writeStream bufferSize: aSize

	self initialize.
	self initializeStream: writeStream.
	self sizeBuffer: aSize.
	position := 0.! !

!FLBufferedWriteStream methodsFor: 'private' stamp: 'MarianoMartinezPeck 8/17/2012 12:10'!
buffer
	buffer ifNil: [ self sizeBuffer: self defaultBufferSize ].
	^ buffer! !

!FLBufferedWriteStream methodsFor: 'file open/close' stamp: 'MarianoMartinezPeck 5/17/2011 23:32'!
close
	self flushBuffer.
	stream close! !

!FLBufferedWriteStream methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 9/23/2011 22:34'!
bufferFreeSize
	^ buffer size - position! !

!FLBufferedWriteStream methodsFor: 'writing' stamp: 'MarianoMartinezPeck 10/9/2011 22:47'!
nextBytesPutAll: collection
	self flushBufferIfFull.
	collection size <= self bufferFreeSize
		ifTrue: [
			self buffer replaceFrom: position + 1 to: position + collection size with: collection.
			position := position + collection size ]
		ifFalse: [
			self flushBuffer.
			collection size > (self buffer size / 2)
				ifTrue: [ stream nextBytesPutAll: collection ]
				ifFalse: [ self nextBytesPutAll: collection ] ]
! !

!FLBufferedWriteStream methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 8/16/2012 13:47'!
nextPut: object
	self flushBufferIfFull.
	position := position + 1.
	self buffer at: position put: object ! !

!FLBufferedWriteStream methodsFor: 'private' stamp: 'MaxLeske 10/29/2013 21:51'!
copyWordObjectToBuffer: aWordObject
	| blt |
	blt := (BitBlt
		toForm: (Form new hackBits: self buffer))
		sourceForm: (Form new hackBits: aWordObject).
	blt combinationRule: Form over. "store"
	blt 
		sourceX: 0;
		sourceY: 0;
		height: aWordObject byteSize // 4;
		width: 4.
	blt 
		destX: 0;
		destY:  position // 4.
	blt copyBits! !

!FLBufferedWriteStream methodsFor: 'private' stamp: 'MarianoMartinezPeck 10/22/2011 12:46'!
flushBuffer
	position = 0 ifTrue: [ ^ self ].
	position = buffer size
		ifTrue: [
			stream nextPutAll: buffer ]
		ifFalse: [
			streamRespondsToNextPutAllStartingAt
				ifTrue: [ stream next: position putAll: buffer startingAt: 1 ]
				ifFalse: [ stream nextPutAll: (buffer copyFrom: 1 to: position) ] ].
	position := 0! !

!FLBufferedWriteStream methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 8/16/2012 12:41'!
sizeBuffer: size
    buffer ifNotNil: [self flushBuffer].
    buffer := (stream isBinary ifTrue: [ ByteArray ] ifFalse: [ String ]) new: size
! !

!FLBufferedWriteStream methodsFor: 'initialize-release' stamp: 'MarianoMartinezPeck 10/22/2011 12:46'!
initializeStream: aWriteStream
	stream := aWriteStream.
	"This is ugly, but it is an optimization for #flushBuffer"
	streamRespondsToNextPutAllStartingAt := (stream respondsTo: #next:putAll:startingAt:).! !

!FLBufferedWriteStream methodsFor: 'printing' stamp: 'MarianoMartinezPeck 5/17/2011 23:32'!
printOn: aStream
	aStream 
		nextPutAll: 'a '; 
		nextPutAll: self class name! !

!FLBufferedWriteStream methodsFor: 'writing' stamp: 'MartinDias 2/20/2014 00:26'!
nextWordsPut: aWordObject

	| byteSize |
	byteSize := aWordObject basicSize * 4.

	"Ensure we are at bigger than the words added, with size next power-of-two"
	byteSize > buffer size ifTrue: [ self sizeBuffer: 1 << (byteSize highBit)].
	
	"BitBlt needs word-aligned access of object. Flushing the buffer is a very good idea because after the position will be zero, which is word aligned.  Word objects always have a full number of words of data to write. (otherwise they'd be variableByte objects or something :P) So as long as the size you write per instance also takes N words, the position will always be aligned (except when writing the first object of a cluster) . After that, we flush when an object larger than current buffer is encountered (statistically rare), or if the buffer is full (which we do anyways).
	Finally, we also need enough free space in the buffer"
	((position bitAnd: 3) = 0 and: [byteSize < self bufferFreeSize])
      	ifFalse: [self flushBuffer].

	self copyWordObjectToBuffer: aWordObject.
	position := position +  byteSize.! !

!FLBufferedWriteStream methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 5/17/2011 23:32'!
defaultBufferSize
	^ 8192 "2 raisedTo: 13  "
	

! !

!FLBufferedWriteStream methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 5/17/2011 23:32'!
flush
	self flushBuffer.
	stream flush! !

!FLBufferedWriteStream methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 4/23/2012 16:02'!
nextPutAll: collection
	self flushBufferIfFull.
	collection size <= self bufferFreeSize
		ifTrue: [
			self buffer replaceFrom: position + 1 to: position + collection size with: collection.
			position := position + collection size ]
		ifFalse: [
			self flushBuffer.
			collection size > (self buffer size / 2)
				ifTrue: [ stream nextPutAll: collection ]
				ifFalse: [ self nextPutAll: collection ] ]
! !

!FLBufferedWriteStream methodsFor: 'accessing' stamp: 'MartinDias 5/11/2012 20:40'!
position
	^ position + stream position! !

!FLBufferedWriteStream methodsFor: 'private' stamp: 'MarianoMartinezPeck 9/23/2011 22:35'!
flushBufferIfFull
	position = buffer size 
		ifTrue: [ self flushBuffer ]
! !

!FLBufferedWriteStream class methodsFor: 'instance creation' stamp: 'MartinDias 1/6/2012 19:14'!
on: writeStream bufferSize: aSize
	^ self basicNew
		initializeOn: writeStream 
		bufferSize: aSize;
		yourself! !

!FLBufferedWriteStream class methodsFor: 'instance creation' stamp: 'MartinDias 1/6/2012 19:27'!
on: writeStream 

	^ self on: writeStream bufferSize: self defaultBufferSize! !

!FLBufferedWriteStream class methodsFor: 'accessing' stamp: 'MartinDias 1/6/2012 19:28'!
defaultBufferSize 
	^ 4096! !

!FLByteArrayStreamStrategy commentStamp: 'MartinDias 10/12/2011 11:37'!
I am a strategy that emulate what we offer with FLSerializer class >> #serializeInMemory:  and  FLMaterializer class >> #materializeFromByteArray: !
!FLByteArrayStreamStrategy methodsFor: 'writing' stamp: 'MartinDias 10/12/2011 10:20'!
writeStreamDo: aValuable
	"Evaluates the argument with a write stream. Answers the result."
	
	inMemoryStream := ByteArray new writeStream.
	^aValuable value: inMemoryStream binary
! !

!FLByteArrayStreamStrategy methodsFor: 'reading' stamp: 'MartinDias 10/12/2011 10:21'!
readStreamDo: aValuable
	"Evaluates the argument with a read stream. Answers the result."
	
	^aValuable value: inMemoryStream contents readStream! !

!FLByteObjectCluster commentStamp: 'MartinDias 8/1/2011 02:59'!
I am the generic cluster for storing and loading variable byte objects.!
!FLByteObjectCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/30/2011 02:24'!
materializeInstanceWith: aDecoder

	| instance size |
	size := aDecoder nextEncodedPositiveInteger.
	instance := theClass basicNew: size.
	aDecoder nextEncodedBytesInto: instance.
	^ instance
! !

!FLByteObjectCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/29/2011 20:03'!
serializeInstance: anObject with: anEncoder

	anEncoder encodePositiveInteger: anObject basicSize.
	anEncoder encodeBytes: anObject.! !

!FLClassNotFound commentStamp: 'MarianoMartinezPeck 10/23/2011 14:34'!
I represent an error produced during materialization when a serialized class or trait name doesn't exist.!
!FLClassNotFound class methodsFor: 'signaling' stamp: 'MartinDias 3/20/2012 12:06'!
signalWithName: className
	^ self signal: 'Class named ', className printString, ' not found.'! !

!FLClassSerializationTest commentStamp: '<historical>'!
I have the common behavior for testing class serialization.!
!FLClassSerializationTest methodsFor: 'running' stamp: 'MartinDias 10/8/2011 04:14'!
newSecondaryTrait
	"Returns a trait for testing"

	^ self newTraitSuffixed: 'Secondary'! !

!FLClassSerializationTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 10/16/2012 09:33'!
during: aBlock rename: aClass as: anotherClass

	[ Smalltalk at: aClass name put: anotherClass.
	^aBlock value ] ensure: [ 
	Smalltalk at: aClass name put: aClass ].! !

!FLClassSerializationTest methodsFor: 'running' stamp: 'MarianoMartinezPeck 11/21/2011 20:20'!
newClassWithInstanceVariableNames: instanceVariableNames
	"Returns a class for testing, with the specified instance variables."

	^ self newClassWithInstanceVariableNames: instanceVariableNames superclass: Object! !

!FLClassSerializationTest methodsFor: 'running' stamp: 'MarianoMartinezPeck 4/19/2012 19:10'!
newClassWithInstanceVariableNames: instanceVariableNames superclass: aSuperclass
	"Returns a class for testing, with the specified instance variables."

	^ self 
		newSubclassOf: aSuperclass
		instanceVariableNames: instanceVariableNames
		classVariableNames: ''! !

!FLClassSerializationTest methodsFor: 'tests' stamp: 'MartinDias 10/8/2011 03:11'!
newClassOrTrait
	"Returns a class for testing"

	^ self newClassWithInstanceVariableNames: ''! !

!FLClassSerializationTest methodsFor: 'tests' stamp: 'MartinDias 3/23/2011 17:42'!
newInstanceFrom: aClass

	^ aClass new! !

!FLClassSerializationTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 12/13/2011 20:45'!
newClassOrTraitWithSuperClass: superclass
	"Returns a class for testing"

	^ self newClassWithInstanceVariableNames: '' superclass: superclass! !

!FLClassWithRecursiveSubstitution commentStamp: 'TorstenBergmann 2/3/2014 23:21'!
A test mock for a class with recursive substitution!
!FLClassWithRecursiveSubstitution methodsFor: 'accessing' stamp: 'MartinDias 5/9/2012 00:47'!
index: anObject
	index := anObject ! !

!FLClassWithRecursiveSubstitution methodsFor: 'serialization' stamp: 'MartinDias 5/9/2012 00:57'!
fuelAccept: aGeneralMapper

	^ index < 10
		ifTrue: [
			aGeneralMapper 
				visitSubstitution: self 
				by: (self copy index: self index + 1)
				onRecursionDo: [ super fuelAccept: aGeneralMapper ] ]
		ifFalse: [
			super fuelAccept: aGeneralMapper ]! !

!FLClassWithRecursiveSubstitution methodsFor: 'accessing' stamp: 'MartinDias 5/9/2012 00:48'!
index
	^ index! !

!FLCluster commentStamp: 'MartinDias 8/29/2011 19:20'!
I represent a cluster of objects grouped by some specific similarity. I know how to serialize and materialize them all together.!
!FLCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/29/2011 19:48'!
materializePostInstancesStepWith: aDecoder

! !

!FLCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/29/2011 19:48'!
afterMaterializationStepWith: aDecoder
! !

!FLCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/29/2011 19:44'!
serializeReferencesStepWith: anEncoder
! !

!FLCluster methodsFor: 'accessing' stamp: 'MartinDias 8/29/2011 00:50'!
objects
	"Answer the objects that this cluster groups."

	self subclassResponsibility! !

!FLCluster methodsFor: 'initialize-release' stamp: 'MartinDias 1/8/2012 14:32'!
initializeAnalyzing

	self initialize.! !

!FLCluster methodsFor: 'hooks' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper
	^ aGeneralMapper visitSubstitution: self by: nil! !

!FLCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 9/19/2012 14:38'!
clusterSerializeStepWith: aSerialization
	"Serialize cluster stuff"! !

!FLCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 9/19/2012 14:38'!
clusterMaterializeStepWith: aMaterialization
	"Materialize cluster stuff"
! !

!FLCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/29/2011 19:44'!
serializePostInstancesStepWith: anEncoder
! !

!FLCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 1/8/2012 15:00'!
materializeInstancesStepWith: aDecoder
! !

!FLCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 8/29/2011 01:23'!
registerIndexesOn: aDictionary
	"Maps objects with indexes in the dictionary."! !

!FLCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/29/2011 19:48'!
materializeReferencesStepWith: aDecoder
! !

!FLCluster methodsFor: 'analyzing' stamp: 'MartinDias 8/29/2011 00:54'!
clusterReferencesDo: aBlock
	"Evaluate a block with each object referenced by the cluster"! !

!FLCluster methodsFor: 'analyzing' stamp: 'MarianoMartinezPeck 9/18/2012 11:00'!
traceWith: anAnalysis 

	self clusterReferencesDo: [ :aChild | anAnalysis privateTrace: aChild ]! !

!FLCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 1/8/2012 15:11'!
serializeInstancesStepWith: anEncoder
! !

!FLCluster methodsFor: 'initialize-release' stamp: 'MartinDias 1/8/2012 14:36'!
initializeMaterializing

	self initialize.! !

!FLCluster class methodsFor: 'instance creation' stamp: 'MartinDias 2/17/2012 03:18'!
newMaterializing

	^ self basicNew
		initializeMaterializing;
		yourself.! !

!FLCluster class methodsFor: 'analyzing' stamp: 'MartinDias 1/8/2012 15:36'!
clusterBucketIn: aClusterization
	"Answer in which clusters bucket place this cluster. This defines the sort order in which the clusters will be ordered. See FLAnalyzer >> clusteredObjects for more information."

	self subclassResponsibility ! !

!FLCluster class methodsFor: 'instance creation' stamp: 'MartinDias 1/8/2012 14:32'!
newAnalyzing

	^ self basicNew
		initializeAnalyzing;
		yourself.! !

!FLCluster class methodsFor: 'instance creation' stamp: 'MartinDias 1/8/2012 14:33'!
new
	self error: 'Use another instance creation message.'! !

!FLClusterization commentStamp: 'MartinDias 8/29/2011 19:12'!
I manage the clusters collected during the analysis step of serialization.!
!FLClusterization methodsFor: 'initialization' stamp: 'MarianoMartinezPeck 7/26/2012 17:36'!
initialize

	super initialize.
	primitivesBucket := IdentityDictionary new.
	baselevelBucket := IdentityDictionary new.
	globalsBucket := IdentityDictionary new.
	metalevelInstanceSideBucket := IdentityDictionary new.
	metalevelClassSideBucket := IdentityDictionary new.
	substitutionsBucket := IdentityDictionary new.
	postBaselevelBucket := IdentityDictionary new.
! !

!FLClusterization methodsFor: 'cluster buckets' stamp: 'MartinDias 8/20/2011 22:52'!
substitutionsBucket
	
	^ substitutionsBucket! !

!FLClusterization methodsFor: 'cluster buckets' stamp: 'MarianoMartinezPeck 7/26/2012 17:36'!
postBaselevelBucket
	
	^ postBaselevelBucket! !

!FLClusterization methodsFor: 'cluster buckets' stamp: 'MartinDias 8/20/2011 22:27'!
baselevelBucket
	
	^ baselevelBucket! !

!FLClusterization methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 1/11/2012 11:02'!
objectCount

	^self clusterBuckets sum: [ :aClusterBucket | 
		aClusterBucket
			inject: 0 
			into: [ :sum :aCluster | sum + aCluster objects size ] ].! !

!FLClusterization methodsFor: 'accessing' stamp: 'MartinDias 1/11/2012 00:27'!
clusters
	
	^self clusterBuckets gather: [:c | c ].
! !

!FLClusterization methodsFor: 'cluster buckets' stamp: 'MartinDias 9/15/2011 20:16'!
globalsBucket
	
	^ globalsBucket ! !

!FLClusterization methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 7/26/2012 17:36'!
clusterBuckets
	"Answer a new collection with all the clusters that have been collected in trace. Note that order is imporant."

	^ OrderedCollection new 
		add: globalsBucket;
		add: primitivesBucket;
		add: metalevelClassSideBucket;
		add: metalevelInstanceSideBucket;
		add: baselevelBucket;
		add: postBaselevelBucket;
		add: substitutionsBucket;
		yourself.! !

!FLClusterization methodsFor: 'hooks' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper
	^ aGeneralMapper visitSubstitution: self by: nil! !

!FLClusterization methodsFor: 'cluster buckets' stamp: 'MartinDias 9/17/2011 00:27'!
metalevelClassSideBucket
	
	^ metalevelClassSideBucket! !

!FLClusterization methodsFor: 'cluster buckets' stamp: 'MartinDias 9/17/2011 00:27'!
metalevelInstanceSideBucket
	
	^ metalevelInstanceSideBucket ! !

!FLClusterization methodsFor: 'cluster buckets' stamp: 'MartinDias 9/17/2011 00:29'!
primitivesBucket
	
	^ primitivesBucket! !

!FLCompiledMethodCluster commentStamp: '<historical>'!
I am a cluster for CompiledMethod instances.

How CompiledMethod trailers are serialized can be established using methods in 'configurating' class-side protocol.!
!FLCompiledMethodCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/29/2011 19:43'!
serializeReferencesStepWith: anEncoder

	objects do: [ :aCompiledMethod | self serializeLiteralsOf: aCompiledMethod with: anEncoder ]! !

!FLCompiledMethodCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/29/2011 19:48'!
materializeReferencesStepWith: aDecoder

	objects do: [ :aCompiledMethod | self materializeLiteralsTo: aCompiledMethod with: aDecoder ]! !

!FLCompiledMethodCluster methodsFor: 'protected' stamp: 'MartinDias 3/21/2012 19:14'!
serializeLiteralsOf: aCompiledMethod with: anEncoder

	aCompiledMethod fuelPrepare.
	1 to: aCompiledMethod numLiterals 
		do: [ :index | anEncoder encodeReferenceTo: (aCompiledMethod literalAt: index) ]! !

!FLCompiledMethodCluster methodsFor: 'protected' stamp: 'MartinDias 12/29/2011 19:48'!
materializeLiteralsTo: compiledMethod with: aDecoder

	1 to: compiledMethod numLiterals 
		do: [ :index | compiledMethod literalAt: index put: aDecoder nextEncodedReference ]
! !

!FLCompiledMethodCluster methodsFor: 'analyzing' stamp: 'MartinDias 3/21/2012 19:14'!
referencesOf: aCompiledMethod do: aBlock

	aCompiledMethod fuelPrepare.
	1 to: aCompiledMethod numLiterals
		do: [ :index | aBlock value: (aCompiledMethod literalAt: index) ]! !

!FLCompiledMethodCluster methodsFor: 'serialize/materialize' stamp: 'MaxLeske 1/8/2015 08:18'!
serializeInstance: aCompiledMethodToSerialize with: anEncoder
	| header bytecodesPlusTrailerSize cmSize cmInitialPC aCompiledMethod |
	"In 64 bit VMs the header is actually 64 bits wide but only 32 bits
	contain information."
	aCompiledMethod := self class transformationForSerializing value: aCompiledMethodToSerialize.

	header := aCompiledMethod header.
	cmSize := aCompiledMethod size.
	cmInitialPC := aCompiledMethod initialPC.
	bytecodesPlusTrailerSize := cmSize - cmInitialPC + 1.

	anEncoder 
		encodeInt32: header; "Signed int as of Pharo 40"
		encodeUint16: bytecodesPlusTrailerSize.	

	cmInitialPC to: cmSize
		do: [ :index | anEncoder encodeByte: (aCompiledMethod at: index) ]! !

!FLCompiledMethodCluster methodsFor: 'serialize/materialize' stamp: 'MaxLeske 1/7/2015 22:37'!
materializeInstanceWith: aDecoder

	| compiledMethod header bytecodesPlusTrailerSize |

	header := aDecoder nextEncodedInt32.
	bytecodesPlusTrailerSize := aDecoder nextEncodedUint16.

	compiledMethod := CompiledMethod newMethod: bytecodesPlusTrailerSize header: header.

	compiledMethod initialPC to: compiledMethod size
		do: [ :index | compiledMethod at: index put: aDecoder nextEncodedByte ].
		
	^ compiledMethod! !

!FLCompiledMethodCluster class methodsFor: 'analyzing' stamp: 'MartinDias 1/8/2012 15:37'!
clusterBucketIn: aClusterization

	^aClusterization primitivesBucket! !

!FLCompiledMethodCluster class methodsFor: 'configuring' stamp: 'MartinDias 2/18/2013 17:58'!
setTrailerWithNoChange
	"Make compiled methods be serialized as they are."

	^ self transformationForSerializing: [:aCompiledMethod | aCompiledMethod ]! !

!FLCompiledMethodCluster class methodsFor: 'configuring' stamp: 'MartinDias 2/18/2013 17:58'!
setTrailerWithNoSource
	"Make compiled methods be serialized without source code."

	^ self transformationForSerializing: [:aCompiledMethod |
		aCompiledMethod copyWithTrailerBytes: CompiledMethodTrailer empty ]! !

!FLCompiledMethodCluster class methodsFor: 'class initialization' stamp: 'MaxLeske 11/6/2013 09:11'!
initialize 
	self setTrailerWithSourceCode! !

!FLCompiledMethodCluster class methodsFor: 'configuring' stamp: 'MartinDias 2/18/2013 17:59'!
setTrailerWithSourceCode
	"Make compiled methods be serialized with embedded source code."

	^ self transformationForSerializing: [:aCompiledMethod | 
		aCompiledMethod copyWithTrailerBytes: 
			(CompiledMethodTrailer new sourceCode: aCompiledMethod sourceCode) ]! !

!FLCompiledMethodCluster class methodsFor: 'accessing' stamp: 'MartinDias 2/18/2013 17:58'!
transformationForSerializing: aBlockWithOneArgument 
	transformationForSerializing := aBlockWithOneArgument! !

!FLCompiledMethodCluster class methodsFor: 'accessing' stamp: 'MartinDias 2/25/2013 14:32'!
transformationForSerializing 
	"Answer a block closure that receives a CompiledMethod and returns another or the same CompiledMethod ready for being serialized."
	^ transformationForSerializing! !

!FLCompiledMethodCluster class methodsFor: 'cleanup' stamp: 'MarcusDenker 10/11/2013 12:37'!
cleanUp
	self initialize ! !

!FLCompiledMethodSerializationTest methodsFor: 'helpers' stamp: 'MaxLeske 11/6/2013 15:04'!
useNotInstalled
	theClass 
		duringTestCompileSilently: 'm  ^ 42'
		storeSource: false.
	theCompiledMethod := theClass methodNamed: #m.
	theClass methodDict removeKey: #m! !

!FLCompiledMethodSerializationTest methodsFor: 'tests' stamp: 'MaxLeske 11/6/2013 15:29'!
testDoIt
	| materialized |
	"Since Pharo 3.0 decompilation of compiled methods is no longer possible.
	That means we have to store the source too."
	self useDoIt.
	
	theCompiledMethod selector: #DoIt.
	self assert: theCompiledMethod isDoIt.
	self assert: theCompiledMethod isInstalled.
	self deny: theCompiledMethod trailer hasSource.
	self assert: theCompiledMethod trailer isEmpty.
	self deny: theCompiledMethod trailer hasSourcePointer.
	
	materialized := self resultOfSerializeAndMaterialize: theCompiledMethod.
	"not possible since it's a different instance"
	self deny: materialized isInstalled.
	self assert: materialized isDoIt.
	"we serialized the source"
	self assert: materialized trailer hasSource.
	self deny: materialized trailer isEmpty.
	self deny: materialized trailer hasSourcePointer.
	
	self assert: (materialized isEqualRegardlessTrailerTo: theCompiledMethod)! !

!FLCompiledMethodSerializationTest methodsFor: 'tests' stamp: 'MaxLeske 11/6/2013 15:29'!
testNotInstalled
	| materialized |
	"Since Pharo 3.0 decompilation of compiled methods is no longer possible.
	That means we have to store the source too."
	self useNotInstalled.
	
	self deny: theCompiledMethod isInstalled.
	self deny: theCompiledMethod isDoIt.
	self deny: theCompiledMethod trailer hasSource.
	self assert: theCompiledMethod trailer isEmpty.
	self deny: theCompiledMethod trailer hasSourcePointer.
	
	materialized := self resultOfSerializeAndMaterialize: theCompiledMethod.
	self deny: materialized isInstalled.
	self deny: materialized isDoIt.
	"we serialized the source"
	self assert: materialized trailer hasSource.
	self deny: materialized trailer isEmpty.
	self deny: materialized trailer hasSourcePointer.
	
	self assert: (materialized isEqualRegardlessTrailerTo: theCompiledMethod)! !

!FLCompiledMethodSerializationTest methodsFor: 'helpers' stamp: 'MaxLeske 11/6/2013 15:05'!
useInstalled
	theClass 
		duringTestCompileSilently: 'm  ^ 42'
		storeSource: true.
	theCompiledMethod := theClass methodNamed: #m! !

!FLCompiledMethodSerializationTest methodsFor: 'tests' stamp: 'MaxLeske 11/6/2013 15:21'!
testInstalled
	| materialized |
	"Since Pharo 3.0 decompilation of compiled methods is no longer possible.
	That means we have to store the source too."
	self useInstalled.
	
	self assert: theCompiledMethod isInstalled.
	self deny: theCompiledMethod isDoIt.
	self deny: theCompiledMethod trailer hasSource.
	self deny: theCompiledMethod trailer isEmpty.
	self assert: theCompiledMethod trailer hasSourcePointer.
	
	"if installed but not different, the installed instance will be answered"
	materialized := self resultOfSerializeAndMaterialize: theCompiledMethod.
	self assert: materialized == theCompiledMethod! !

!FLCompiledMethodSerializationTest methodsFor: 'helpers' stamp: 'MaxLeske 11/6/2013 15:04'!
useDoIt
	theClass 
		duringTestCompileSilently: 'm  ^ 42'
		storeSource: false.
	theCompiledMethod := theClass methodNamed: #m.
	theClass methodDict
		at: #DoIt
		put: theCompiledMethod! !

!FLCompiledMethodSerializationTest methodsFor: 'as yet unclassified' stamp: 'MaxLeske 11/6/2013 15:29'!
testInstalledModified
	| copy materialized |
	"Since Pharo 3.0 decompilation of compiled methods is no longer possible.
	That means we have to store the source too."
	self useInstalled.
	
	self assert: theCompiledMethod isInstalled.
	self deny: theCompiledMethod isDoIt.
	self deny: theCompiledMethod trailer hasSource.
	self deny: theCompiledMethod trailer isEmpty.
	self assert: theCompiledMethod trailer hasSourcePointer.
	
	copy := theCompiledMethod copy.
	"different instance can not be installed at the same time."
	self deny: copy isInstalled.
	self deny: copy isDoIt.
	self deny: copy trailer hasSource.
	self deny: copy trailer isEmpty.
	self assert: copy trailer hasSourcePointer.
	
	"if installed but not different, the installed instance will be answered"
	materialized := self resultOfSerializeAndMaterialize: copy.
	self deny: materialized == theCompiledMethod.
	self deny: materialized == copy.
	self deny: materialized isInstalled.
	self deny: materialized isDoIt.
	"we serialized the source"
	self assert: materialized trailer hasSource.
	self deny: materialized trailer isEmpty.
	self deny: materialized trailer hasSourcePointer! !

!FLCompiledMethodSerializationTest methodsFor: 'running' stamp: 'MaxLeske 11/6/2013 15:01'!
setUp
	super setUp.
	theClass := self newClass class! !

!FLContextSerializationTest commentStamp: 'TorstenBergmann 2/3/2014 23:32'!
SUnit tests for fuel serialization of methods contexts!
!FLContextSerializationTest methodsFor: 'running' stamp: 'MartinDias 3/26/2012 22:52'!
setUp
	super setUp.
	thisContextSample := self class thisContextSample.! !

!FLContextSerializationTest methodsFor: 'tests' stamp: 'MarcusDenker 4/25/2013 15:09'!
testDoIt
	"Serialization of DoIt methods should be possible by default."
	
	| context |
	[ Smalltalk evaluate: 'self error' ]
		on: Error 
		do: [:error | context:= error signalerContext copyStack ].
	
	self serialize: context! !

!FLContextSerializationTest methodsFor: 'tests' stamp: 'MaxLeske 7/18/2014 17:46'!
testContextWithNilPc
	"This test should be improved"
	| context1  materializedContext1  |
	context1 := (Context newForMethod: FLPair >> #method1).
	context1 
		initializeWith: nil 
		stackPtr: 1 
		method: FLPair >> #method1 
		receiver:  (FLPair new right: 4; left: 2) 
		sender: nil.
		
	materializedContext1 := self resultOfSerializeAndMaterialize: context1.
	context1 assertWellMaterializedInto: materializedContext1 in: self.! !

!FLContextSerializationTest methodsFor: 'tests' stamp: 'MaxLeske 7/18/2014 17:42'!
testContext
	"This test should be improved"
	| context1  materializedContext1  |
	context1 := (Context newForMethod: FLPair >> #method1).
	context1 
		initializeWith: 23 
		stackPtr: 1 
		method: FLPair >> #method1 
		receiver:  (FLPair new right: 4; left: 2) 
		sender: nil.
		
	materializedContext1 := self resultOfSerializeAndMaterialize: context1.
	context1 assertWellMaterializedInto: materializedContext1 in: self.! !

!FLContextSerializationTest methodsFor: 'tests' stamp: 'MaxLeske 7/18/2014 17:47'!
testContextWithTemp
	"This test should be improved"
	| context1  materializedContext1  |
	context1 := (Context newForMethod: FLPair >> #methodWithTemp).
	context1 
		initializeWith: nil 
		stackPtr: 1 
		method: FLPair >> #methodWithTemp 
		receiver:  (FLPair new right: 4; left: 2) 
		sender: nil.
	context1 tempNamed: 'string' put: 'capo'.
	
	materializedContext1 := self resultOfSerializeAndMaterialize: context1.
	self assert: (materializedContext1 tempNamed: 'string') = 'capo'.
	context1 assertWellMaterializedInto: materializedContext1 in: self.! !

!FLContextSerializationTest methodsFor: 'tests' stamp: 'MaxLeske 7/18/2014 17:43'!
testContextThisContext

	| materializedContext context |
	context := thisContextSample.
	materializedContext := self resultOfSerializeAndMaterialize: context.
	
	self deny:  context == materializedContext.
	"I cannot compare by = because MethodContext do not implement it and it will finally use the identity."
	self assert: context pc = materializedContext pc.
	self assert: context stackPtr = materializedContext stackPtr.
	self assert: context method = materializedContext method.
	self assert: context receiver = materializedContext receiver.
	"I cannot compare by = because MethodContext do not implement it and it will finally use the identity."
	self deny: context sender ==  materializedContext sender.
	self assert: context sender pc == materializedContext sender pc.
	self assert: context sender stackPtr = materializedContext sender stackPtr.
	"etc...."
! !

!FLContextSerializationTest methodsFor: 'tests' stamp: 'MaxLeske 7/18/2014 17:47'!
testContextWithSender
	"This test should be improved"
	| context1 context2 materializedContext1 |
	context1 := (Context newForMethod: FLPair >> #method1).
	context1 
		initializeWith: 23 
		stackPtr: 1 
		method: FLPair >> #method1 
		receiver:  (FLPair new right: 4; left: 2) 
		sender: nil.
		
	context2 := (Context newForMethod: FLPair >> #method2).
	context2 
		initializeWith: 18 
		stackPtr: 1 
		method: FLPair >> #method2 
		receiver:  (FLPair new right: 5; left: 6) 
		sender: nil.

	context1 privSender:  context2.
		
	materializedContext1 := self resultOfSerializeAndMaterialize: context1.
	context1 assertWellMaterializedInto: materializedContext1 in: self.! !

!FLContextSerializationTest methodsFor: 'tests' stamp: 'MaxLeske 7/18/2014 17:44'!
testContextWithClosureAndSender
	"This test should be improved"
	| context1  materializedContext2  context2 |
	
	context1 := (Context newForMethod: FLPair >> #method1).
	context1 
		initializeWith: 23 
		stackPtr: 1 
		method: FLPair >> #method1 
		receiver:  (FLPair new right: 4; left: 2) 
		sender: nil.
	
	context2 := self class blockClosureContextTestingWithSender: context1.
	materializedContext2 := self resultOfSerializeAndMaterialize: context2.
	context2 assertWellMaterializedInto: materializedContext2 in: self.
	
! !

!FLContextSerializationTest methodsFor: 'tests' stamp: 'MaxLeske 7/18/2014 17:46'!
testContextWithClosureContextWithOutPointerTesting
	"This test should be improved"
	| context1  materializedContext1  |
	context1 := self class blockClosureContextWithOutPointerTesting.
	self assert: (context1 tempNamed: 'string') = 'test'. 
	materializedContext1 := self resultOfSerializeAndMaterialize: context1.
	self assert: (materializedContext1 tempNamed: 'string') = 'test'. 
	context1 assertWellMaterializedInto: materializedContext1 in: self.
	
! !

!FLContextSerializationTest methodsFor: 'tests' stamp: 'MaxLeske 7/18/2014 17:45'!
testContextWithClosure
	"This test should be improved"
	| context1  materializedContext1  |
	context1 := self class blockClosureContextTesting.
	materializedContext1 := self resultOfSerializeAndMaterialize: context1.
	context1 assertWellMaterializedInto: materializedContext1 in: self.
	
! !

!FLContextSerializationTest class methodsFor: 'closures for testing' stamp: 'MarianoMartinezPeck 5/24/2011 13:44'!
blockClosureContextTestingWithSender: aSenderContext
	^ [self class] asContextWithSender: aSenderContext! !

!FLContextSerializationTest class methodsFor: 'running' stamp: 'MartinDias 3/26/2012 22:54'!
thisContextSample
	^ thisContext copy! !

!FLContextSerializationTest class methodsFor: 'closures for testing' stamp: 'MarianoMartinezPeck 7/1/2011 11:11'!
blockClosureContextWithOutPointerTesting
	| string |
	string := 'test'.
	^ [self class. string asUppercase] asContext! !

!FLContextSerializationTest class methodsFor: 'closures for testing' stamp: 'MarianoMartinezPeck 5/24/2011 13:44'!
blockClosureContextTesting
	^ [self class] asContext! !

!FLDecoder commentStamp: 'MartinDias 1/6/2012 16:08'!
I am an abstraction used by the materialization algorithm to decode the graph from a stream.!
!FLDecoder methodsFor: 'decoding' stamp: 'MartinDias 12/29/2011 21:07'!
nextEncodedByte
	^stream next! !

!FLDecoder methodsFor: 'decoding' stamp: 'MarianoMartinezPeck 1/7/2012 14:57'!
nextEncodedPositiveInteger
	"Read a 32-bit signed integer from the next 4 bytes"
	| s |
	s := 0.
	1 to: 4 do: [:i | s := (s bitShift: 8) + stream next].
	^ s! !

!FLDecoder methodsFor: 'decoding' stamp: 'MarianoMartinezPeck 1/7/2012 14:58'!
nextEncodedString
	| length aByteArray |

	"read the length in binary mode"
	length := stream next.		"first byte."
	length >= 192 ifTrue: [length := length - 192.
		1 to: 3 do: [:ii | length := length * 256 + stream next]].
	aByteArray := ByteArray new: length.

	stream nextInto: aByteArray.
	^aByteArray asString.
! !

!FLDecoder methodsFor: 'decoding' stamp: 'MartinDias 2/17/2012 04:10'!
decodeYourself

	| objectCount |
	objectCount := self nextEncodedPositiveInteger.
	
	indexStream := FLIndexStream on: stream digits: objectCount digitLength.
	objects := Array new: objectCount.
	objectsWriteStream := WriteStream on: objects.

	isBigEndian := self nextEncodedPositiveInteger.
! !

!FLDecoder methodsFor: 'decoding' stamp: 'MartinDias 12/30/2011 15:34'!
nextEncodedReference 

	^ objects at: indexStream nextIndex! !

!FLDecoder methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 8/1/2013 10:01'!
variablesMappingFor: aClass

	| variables |
	variables := FLVariablesMapping materializing: aClass from: self.
	
	migrations 
		select: [ :m | (m targetClass == aClass) or: [ aClass inheritsFrom: m targetClass ] ]
		thenDo: [ :m | m applyTo: variables ].
		
	^ variables
	! !

!FLDecoder methodsFor: 'decoding' stamp: 'MarianoMartinezPeck 1/7/2012 14:56'!
nextEncodedInt32
	| n firstDigit |
	n := firstDigit := stream next.
	n := (n bitShift: 8) + stream next.
	n := (n bitShift: 8) + stream next.
	n := (n bitShift: 8) + stream next.
	firstDigit >= 128 ifTrue: [n := -16r100000000 + n].  "decode negative 32-bit integer"
	^ n
! !

!FLDecoder methodsFor: 'accessing' stamp: 'MartinDias 12/29/2011 18:51'!
objects
	^ objects! !

!FLDecoder methodsFor: 'decoding' stamp: 'MarianoMartinezPeck 6/9/2012 11:56'!
nextEncodedUint24
	"Answer the next unsigned, 24-bit integer from this (binary) stream."

	| n |
	n := stream next.
	n := (n bitShift: 8) + stream next.
	n := (n bitShift: 8) + stream next.
	^ n
! !

!FLDecoder methodsFor: 'accessing' stamp: 'MartinDias 2/21/2013 23:47'!
globalEnvironment
	"Answer a dictionary where the look up for global symbols will be done during materialization."
	
	^ globalEnvironment! !

!FLDecoder methodsFor: 'accessing' stamp: 'MartinDias 2/17/2012 04:06'!
registerAll: someObjects

	objectsWriteStream nextPutAll: someObjects.! !

!FLDecoder methodsFor: 'accessing' stamp: 'MartinDias 1/5/2012 13:12'!
classNamed: className 

	^ (migrations
		detect: [:m | m sourceClassName = className ]
		ifNone: [ ^ self globalClassNamed: className ])
		targetClass.
		! !

!FLDecoder methodsFor: 'initializing' stamp: 'MartinDias 2/21/2013 23:50'!
initializeOn: aStream migrations: aCollection globalEnvironment: aDictionary 

	self initialize.
	stream := aStream.
	migrations := aCollection.
	globalEnvironment := aDictionary.! !

!FLDecoder methodsFor: 'accessing' stamp: 'MartinDias 12/29/2011 18:27'!
isBigEndian
	^ isBigEndian! !

!FLDecoder methodsFor: 'decoding' stamp: 'MartinDias 12/29/2011 21:02'!
nextEncodedWordsInto: aWordsObject 
	stream fuelNextWordsInto: aWordsObject ! !

!FLDecoder methodsFor: 'decoding' stamp: 'MartinDias 12/30/2011 02:25'!
nextEncodedBytesInto: aBytesObject
	stream next: aBytesObject basicSize into: aBytesObject ! !

!FLDecoder methodsFor: 'decoding' stamp: 'MartinDias 2/21/2013 15:27'!
nextEncodedClusterClass

	^ self class environment at: self nextEncodedString asSymbol! !

!FLDecoder methodsFor: 'decoding' stamp: 'MarianoMartinezPeck 6/9/2012 12:32'!
nextEncodedUint16
	"Answer the next unsigned, 16-bit integer from this (binary) stream."
	^ (stream next bitShift: 8) + (stream next).
	! !

!FLDecoder methodsFor: 'decoding' stamp: 'MarianoMartinezPeck 6/9/2012 20:01'!
nextEncodedInt24
	| n firstDigit |
	n := firstDigit := stream next.
	n := (n bitShift: 8) + stream next.
	n := (n bitShift: 8) + stream next.
	firstDigit >= 128 ifTrue: [n := -16r1000000 + n].  "decode negative 24-bit integer"
	^ n
! !

!FLDecoder methodsFor: 'decoding' stamp: 'MarianoMartinezPeck 1/7/2012 20:09'!
nextEncodedBitmap

	^ Bitmap newFromStream: stream! !

!FLDecoder methodsFor: 'decoding' stamp: 'MarianoMartinezPeck 1/7/2012 14:59'!
nextEncodedUint32
	"Answer the next unsigned, 32-bit integer from this (binary) stream."

	| n |
	n := stream next.
	n := (n bitShift: 8) + stream next.
	n := (n bitShift: 8) + stream next.
	n := (n bitShift: 8) + stream next.
	^ n
! !

!FLDecoder methodsFor: 'accessing' stamp: 'MartinDias 2/21/2013 23:48'!
globalClassNamed: className

	^ globalEnvironment 
		at: className
		ifAbsent: [ FLClassNotFound signalWithName: className ]! !

!FLDecoder methodsFor: 'decoding' stamp: 'MarianoMartinezPeck 6/8/2012 22:55'!
nextEncodedUint8
	"Answer the next unsigned, 16-bit integer from this (binary) stream."
	^ stream next.
	
! !

!FLDecoder class methodsFor: 'instance creation' stamp: 'MartinDias 2/21/2013 23:43'!
on: aStream migrations: aCollection globalEnvironment: aDictionary
	
	^self basicNew
		initializeOn: aStream 
		migrations: aCollection 
		globalEnvironment: aDictionary;
		yourself.! !

!FLDelayedSerializationMock methodsFor: 'serializing' stamp: 'MaxLeske 5/2/2013 09:15'!
run
	"Serialize the graph starting at the root object."

	self analysisStep.
	self headerStep.
	self instancesStep.
	(Delay forMilliseconds: 100) wait.
	self referencesStep.
	self trailerStep.! !

!FLDelayedSerializerMock methodsFor: 'protected' stamp: 'MaxLeske 5/4/2013 16:17'!
setDefaultSerialization

	^ serializationFactory := [:anObject :anEncoder | 
		(FLDelayedSerializationMock 
			with: anEncoder
			root: anObject 
			analyzer: self analyzer)
			run;
			yourself ]! !

!FLDictionaryCollectionCluster commentStamp: '<historical>'!
A FLDictionaryCollectionCluster is a special optional cluster that rather than using the default (variable object) serialization, uses #keysAndValuesDo: to iterate objects and #add: during materialization. This way we avoid analyzing/serializing lots of nil. Also, the rehash is not needed. So far we use it for Dictionary, IdentityDictionary and MethodDictionary.!
!FLDictionaryCollectionCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 7/26/2012 16:13'!
materializeReferencesOf: anObject with: aDecoder
	aDecoder nextEncodedPositiveInteger "anObject size"
		 timesRepeat: 
			[ anObject add: aDecoder nextEncodedReference -> aDecoder nextEncodedReference ]! !

!FLDictionaryCollectionCluster methodsFor: 'serialize/materialize' stamp: 'MaxLeske 5/3/2013 09:54'!
serializeReferencesOf: anObject with: anEncoder
	| refs |
	refs := self references at: anObject ifAbsent: [ ^ self ].
	anEncoder encodePositiveInteger: refs first.
	refs allButFirst do: [ :value | anEncoder encodeReferenceTo: value ]
	! !

!FLDictionaryCollectionCluster methodsFor: 'analyzing' stamp: 'MarianoMartinezPeck 7/28/2012 22:27'!
referencesOf: anObject do: aBlock
	aBlock value: anObject size.
	anObject
		keysAndValuesDo: [ :key :value | 
			aBlock value: key. 
			aBlock value: value.  ]
! !

!FLEncoder commentStamp: 'MartinDias 1/6/2012 16:08'!
I am an abstraction used by the serialization algorithm to encode the graph in a stream.!
!FLEncoder methodsFor: 'encoding' stamp: 'MartinDias 12/30/2011 15:31'!
encodeYourself

	self encodePositiveInteger: objectCount.
	self encodePositiveInteger: Smalltalk isBigEndian asBit.! !

!FLEncoder methodsFor: 'accessing' stamp: 'MartinDias 12/29/2011 17:12'!
objectsIndexes
	^ objectsIndexes! !

!FLEncoder methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 4/20/2012 23:31'!
objectCount: aNumber

	objectCount := aNumber.
	objectsIndexes := FLLargeIdentityDictionary new.
	indexStream := FLIndexStream on: stream digits: aNumber digitLength.! !

!FLEncoder methodsFor: 'encoding' stamp: 'MarianoMartinezPeck 1/7/2012 20:13'!
encodeInt32: aSmallInteger 
	"Write a signed integer to the next 4 bytes"
	| pos |
	pos := aSmallInteger < 0
		ifTrue: [(0-aSmallInteger) bitInvert32 + 1]
		ifFalse: [aSmallInteger].
	1 to: 4 do: [:i | stream nextPut: (pos digitAt: 5-i)].
! !

!FLEncoder methodsFor: 'encoding' stamp: 'MarianoMartinezPeck 6/9/2012 12:13'!
encodeUint32: aSmallInteger 
	"Append to the receiver an Integer as the next 4 bytes."
	stream		
		nextPut: (aSmallInteger bitShift: -24);
		nextPut: ((aSmallInteger bitShift: -16) bitAnd: 255);
		nextPut: ((aSmallInteger bitShift: -8) bitAnd: 255);
		nextPut: (aSmallInteger bitAnd: 255)
! !

!FLEncoder methodsFor: 'accessing' stamp: 'MartinDias 12/29/2011 18:46'!
objectCount
	^ objectCount! !

!FLEncoder methodsFor: 'encoding' stamp: 'MarianoMartinezPeck 1/7/2012 20:13'!
encodePositiveInteger: anInteger
	"Append to the receiver an Integer as the next 4 bytes."
	1 to: 4 do: [:i | stream nextPut: (anInteger digitAt: 4+1-i)].! !

!FLEncoder methodsFor: 'hooks' stamp: 'MartinDias 5/11/2012 16:15'!
fuelAccept: aGeneralMapper
	^ aGeneralMapper visitSubstitution: self by: nil! !

!FLEncoder methodsFor: 'encoding' stamp: 'MartinDias 12/30/2011 15:34'!
encodeWeakReferenceTo: anObject

	indexStream 
		nextIndexPut: (objectsIndexes at: anObject ifAbsent: [objectsIndexes at: nil]) 
! !

!FLEncoder methodsFor: 'encoding' stamp: 'MarianoMartinezPeck 6/9/2012 12:16'!
encodeUint24: aSmallInteger 
	"Append to the receiver an Integer as the next 3 bytes."
	stream		
		nextPut: ((aSmallInteger bitShift: -16) bitAnd: 255);
		nextPut: ((aSmallInteger bitShift: -8) bitAnd: 255);
		nextPut: (aSmallInteger bitAnd: 255)

! !

!FLEncoder methodsFor: 'encoding' stamp: 'MarianoMartinezPeck 1/7/2012 20:08'!
encodeBitmap: aBitmap 
	"Append to the receiver an Integer as the next two bytes."
	aBitmap writeOn: stream.
! !

!FLEncoder methodsFor: 'encoding' stamp: 'MarianoMartinezPeck 1/11/2012 22:24'!
encodeReferenceTo: anObject

	indexStream 
		nextIndexPut: (objectsIndexes at: anObject ifAbsent: [FLObjectNotFound signalWith: anObject])! !

!FLEncoder methodsFor: 'encoding' stamp: 'MartinDias 2/20/2012 15:37'!
encodeClusterClass: aClusterClass 

	self encodeString: aClusterClass name! !

!FLEncoder methodsFor: 'encoding' stamp: 'MarianoMartinezPeck 6/9/2012 20:00'!
encodeInt24: aSmallInteger 
	"Write a signed integer to the next 4 bytes"
	| pos |
	pos := aSmallInteger < 0
		ifTrue: [((0-aSmallInteger) bitXor: 16rFFFFFF) + 1]
		ifFalse: [aSmallInteger].
	1 to: 3 do: [:i | stream nextPut: (pos digitAt: 4-i)].
! !

!FLEncoder methodsFor: 'encoding' stamp: 'MarianoMartinezPeck 6/8/2012 22:54'!
encodeUint8: aSmallInteger 
	"Append to the receiver an Integer as the next two bytes."
	stream nextPut: aSmallInteger ! !

!FLEncoder methodsFor: 'accessing' stamp: 'MartinDias 2/21/2013 23:52'!
globalEnvironment
	"Answer a dictionary where the look up for global symbols will be done during serialization."
	
	^ globalEnvironment! !

!FLEncoder methodsFor: 'initialize-release' stamp: 'MartinDias 2/22/2013 10:57'!
initializeOn: aStream globalEnvironment: aDictionary
	
	self initialize.
	stream := FLBufferedWriteStream on: aStream.
	globalEnvironment := aDictionary.! !

!FLEncoder methodsFor: 'encoding' stamp: 'MartinDias 12/29/2011 20:18'!
encodeWords: aWordsObject
	stream nextWordsPut: aWordsObject! !

!FLEncoder methodsFor: 'encoding' stamp: 'MartinDias 12/29/2011 20:16'!
encodeBytes: aBytesObject
	stream nextBytesPutAll: aBytesObject ! !

!FLEncoder methodsFor: 'encoding' stamp: 'MartinDias 12/29/2011 20:11'!
encodeByte: aSmallInteger 
	stream nextPut: aSmallInteger! !

!FLEncoder methodsFor: 'encoding' stamp: 'MartinDias 1/6/2012 22:42'!
flush

	^ stream flush.! !

!FLEncoder methodsFor: 'encoding' stamp: 'MarianoMartinezPeck 1/7/2012 20:13'!
encodeString: aString
	| length |
	(length := aString size) < 192
		ifTrue: [stream nextPut: length]
		ifFalse: 
			[stream nextPut: (length digitAt: 4)+192.
			stream nextPut: (length digitAt: 3).
			stream nextPut: (length digitAt: 2).
			stream nextPut: (length digitAt: 1)].
	stream nextBytesPutAll: aString.! !

!FLEncoder methodsFor: 'encoding' stamp: 'MarianoMartinezPeck 1/7/2012 20:13'!
encodeUint16: aSmallInteger 
	"Append to the receiver an Integer as the next two bytes."
	stream nextPut: (aSmallInteger bitShift: -8).
	stream nextPut: (aSmallInteger bitAnd: 255).! !

!FLEncoder class methodsFor: 'instance creation' stamp: 'MartinDias 2/22/2013 10:57'!
on: aStream globalEnvironment: aDictionary do: aBlock
	
	| anEncoder |
	anEncoder := self on: aStream globalEnvironment: aDictionary.
	^ [ aBlock value: anEncoder ] ensure: [ anEncoder flush ]! !

!FLEncoder class methodsFor: 'instance creation' stamp: 'MartinDias 2/22/2013 10:59'!
on: aStream globalEnvironment: aDictionary
	
	^self basicNew
		initializeOn: aStream
		globalEnvironment: aDictionary;
		yourself.! !

!FLError commentStamp: '<historical>'!
I represent an error produced during Fuel operation.!
!FLFileStreamStrategy commentStamp: 'MartinDias 10/12/2011 11:37'!
I am a strategy for traditional file streams.!
!FLFileStreamStrategy methodsFor: 'writing' stamp: 'MartinDias 12/7/2011 01:59'!
writeStreamDo: aValuable
	"Evaluates the argument with a write stream. Answers the result."

	^self fileStreamClass
		forceNewFileNamed: self fileName 
		do: [ :aStream | aValuable value: aStream binary ]! !

!FLFileStreamStrategy methodsFor: 'writing' stamp: 'MartinDias 12/7/2011 02:01'!
fileStreamClass
	"Returns the FileStream specific class"
	
	^fileStreamClass! !

!FLFileStreamStrategy methodsFor: 'writing' stamp: 'MarcusDenker 7/10/2012 10:35'!
fileName
	"Answer a filename to serialize and materialize using it."

	^ Smalltalk image shortImageName, '-tests.fuel'! !

!FLFileStreamStrategy methodsFor: 'writing' stamp: 'MartinDias 12/7/2011 02:02'!
initializeWith: aFileStreamClass

	self initialize.	
	fileStreamClass := aFileStreamClass.! !

!FLFileStreamStrategy methodsFor: 'reading' stamp: 'MartinDias 12/7/2011 01:59'!
readStreamDo: aValuable
	"Evaluates the argument with a read stream. Answers the result."
	
	^self fileStreamClass
		oldFileNamed: self fileName
		do: [ :aStream | aValuable value: aStream binary ]! !

!FLFileStreamStrategy class methodsFor: 'instance creation' stamp: 'MartinDias 12/7/2011 02:05'!
new
	self error: 'Invalid creation method.'! !

!FLFileStreamStrategy class methodsFor: 'instance creation' stamp: 'MartinDias 12/7/2011 02:03'!
newWith: aFileStream

	^self basicNew
		initializeWith: aFileStream;
		yourself! !

!FLFileStreamStrategy class methodsFor: 'instance creation' stamp: 'MartinDias 12/7/2011 02:03'!
newWithMultiByteFileStream

	^self newWith: MultiByteFileStream! !

!FLFileStreamStrategy class methodsFor: 'instance creation' stamp: 'MartinDias 12/7/2011 02:02'!
newWithStandardFileStream

	^self newWith: StandardFileStream! !

!FLFixedObjectCluster commentStamp: 'MartinDias 5/30/2011 01:25'!
I am a generic cluster for objects without indexable variables.!
!FLFixedObjectCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 2/17/2012 03:05'!
serializeInstancesStepWith: anEncoder
	"Do nothing. I know my objects have nothing to serialize in this step."
! !

!FLFixedObjectCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 2/20/2013 21:46'!
materializeInstanceWith: aDecoder

	^theClass fuelNew! !

!FLFuelCommandLineHandler commentStamp: '<historical>'!
I handle .fuel files that are passed as arguments when starting the image. 

Usage: fuel [save] [quit] <fuelFile>
 
	save    save the image after loading <fuelFile>
	quit    Don't save the image and directly quit the image fater loading <fuelFile>
	
Documentation:
This command will load the <fuelFile> and materialize/install it's contents. If no argument is specified the image continues running with the loaded contents.


Example:

	#Load a fuel file and save and quit the image with the contents:
	pharo Pharo.image save quit path/to/foo.fuel

	#Load the contents of foo.fuel and save the image, but continue running:
	pharo Pharo.image save path/to/foo.fuel
	
	#Load the contents of foo.fuel and continue running without saving:
	pharo Pharo.image path/to/foo.fuel
!
!FLFuelCommandLineHandler methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 8/4/2012 22:14'!
fileExtension
	^ self class fileExtension! !

!FLFuelCommandLineHandler methodsFor: 'manage' stamp: 'MarianoMartinezPeck 8/4/2012 23:46'!
manageFile: aFileReference

	aFileReference readStreamDo: [ :stream |
		stream binary.
		FileStream stdout nextPutAll: 'Materializing from file: ', aFileReference fullName; lf.
		FLMaterializer new materializeFrom: stream.
		FileStream stdout nextPutAll: 'Materialization finished'; lf.
		].! !

!FLFuelCommandLineHandler methodsFor: 'manage' stamp: 'MarianoMartinezPeck 8/4/2012 22:10'!
manageFiles
	"Load all the source files in the given array."
	files := (self commandLine allFilesWithExtension: self fileExtension)
		 collect: [ :each | (FileSystem disk resolve: each) asFileReference ].
	files ifNil: [ ^self ].
	files do: [ :reference | self manageFile: reference ] 
! !

!FLFuelCommandLineHandler methodsFor: 'activation' stamp: 'MaxLeske 8/25/2014 23:18'!
activate
	[ self manageFiles ]
		on: Error
		do: [ :ex | ^ self exitFailure: ex description ].
	
	(self commandLine hasOption: 'save') ifTrue: [
		Smalltalk saveSession ].
	
	self exitSuccess.
	
	Smalltalk
		snapshot: false
		andQuit: (self commandLine hasOption: 'quit')! !

!FLFuelCommandLineHandler class methodsFor: 'handler selection' stamp: 'MarianoMartinezPeck 8/4/2012 22:18'!
isResponsibleFor: aCommandLine
	"This handler is reponsible only for .fuel files"
	(aCommandLine hasFileWithExtension: self fileExtension)
		ifTrue: [ ^ true ].
	^ super isResponsibleFor: aCommandLine
	! !

!FLFuelCommandLineHandler class methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 8/4/2012 22:19'!
fileExtension
	^ '.fuel'! !

!FLFuelCommandLineHandler class methodsFor: 'accessing' stamp: 'CamilloBruni 2/6/2013 18:18'!
description
	^ 'Loads fuel files'! !

!FLFuelCommandLineHandler class methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 8/4/2012 22:16'!
commandName
	^ 'Fuel'! !

!FLGZipStrategy commentStamp: '<historical>'!
I am a strategy for using GZipStream.!
!FLGZipStrategy methodsFor: 'initialize-release' stamp: 'MartinDias 10/12/2011 18:41'!
initializeWith: aStreamStrategy

	self initialize.
	targetStrategy := aStreamStrategy.! !

!FLGZipStrategy methodsFor: 'writing' stamp: 'MaxLeske 8/5/2013 09:01'!
writeStreamDo: aValuable
	"Evaluates the argument with a write stream. Answers the result."
	
	targetStrategy writeStreamDo: [:aStream |
		^ GZipWriteStream with: aStream do: aValuable]
! !

!FLGZipStrategy methodsFor: 'reading' stamp: 'MaxLeske 8/5/2013 09:01'!
readStreamDo: aValuable
	"Evaluates the argument with a read stream. Answers the result."
	
	targetStrategy readStreamDo: [:aStream |
		^ GZipReadStream with: aStream do: aValuable]
! !

!FLGZipStrategy class methodsFor: 'instance creation' stamp: 'MartinDias 10/12/2011 18:40'!
newWithTarget: aStreamStrategy

	^self basicNew
		initializeWith: aStreamStrategy;
		yourself
		! !

!FLGZippedBasicSerializationTest commentStamp: 'TorstenBergmann 2/3/2014 23:25'!
SUnit tests for basic serialization that is zipped!
!FLGZippedBasicSerializationTest methodsFor: 'tests' stamp: 'MartinDias 12/9/2011 16:16'!
testWideString

	| anObject |
	anObject := OrderedCollection new.
	600 timesRepeat: [
	       anObject add: (WideString
	               streamContents: [ :stream |
	                       600 timesRepeat: [
	                               stream nextPut: (256 to: 1000) atRandom asCharacter ] ] ) ].

	self assertSerializationEqualityOf: anObject! !

!FLGZippedBasicSerializationTest methodsFor: 'expected failures' stamp: 'MartinDias 4/12/2012 20:02'!
expectedFailures

	^ super expectedFailures, #(testWideString)! !

!FLGZippedBasicSerializationTest methodsFor: 'tests' stamp: 'MartinDias 9/27/2011 22:37'!
testByteArray

	self assertSerializationEqualityOf: #[1 2 3 4 5 6 7]! !

!FLGZippedBasicSerializationTest methodsFor: 'tests' stamp: 'MartinDias 9/27/2011 22:45'!
testCompleteBinaryTree

	| aCollection numberOfLeafs |
	numberOfLeafs := 2 raisedTo: 13.
	aCollection := OrderedCollection new.
	1 to: numberOfLeafs do: [ :i | 
		aCollection add: (
			FLPair new 
				left: (2 * i); 
				right: (2 * i) + 1;
				yourself) ].
	
	[aCollection size > 1] 
		whileTrue: [
			aCollection := aCollection pairsCollect: [ :leftPair :rightPair | 
				FLPair new 
					left: leftPair;
					right: rightPair;
					yourself ] ].

	self assertSerializationEqualityOf: aCollection! !

!FLGZippedBasicSerializationTest methodsFor: 'running' stamp: 'MartinDias 3/22/2012 20:14'!
setUp
	super setUp.
	self useGzipInMemoryStream.! !

!FLGZippedBasicSerializationTest methodsFor: 'tests' stamp: 'MartinDias 9/27/2011 22:44'!
testPairs

	| pairs |
	pairs := (1 to: 1 << 14) 
		collect: [ :i | 
			FLPair new 
				left: i; 
				right: i+1;
				yourself ].

	self assertSerializationEqualityOf: pairs! !

!FLGZippedBasicSerializationTest class methodsFor: 'testing' stamp: 'MartinDias 3/22/2012 20:08'!
shouldInheritSelectors 
	^true! !

!FLGlobalClassCluster commentStamp: 'MartinDias 5/30/2011 01:28'!
I am a cluster for classes that should be present when materializing. In other words, it only serializes a reference to the class, using its name.!
!FLGlobalClassCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/30/2011 12:29'!
materializeInstanceWith: aDecoder

	^self materializeGlobalClassFrom: aDecoder ! !

!FLGlobalClassCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/30/2011 12:27'!
serializeInstance: aClass with: anEncoder
	
	self serializeGlobalClass: aClass on: anEncoder! !

!FLGlobalClassSerializationTest commentStamp: 'MartinDias 11/28/2011 10:48'!
I test the serialization of classes as *global* objects, i.e. the classes has to be present in the image at materialization time.!
!FLGlobalClassSerializationTest methodsFor: 'tests' stamp: ''!
testClassSideMethodNotFoundAfterRemoval
	"Tests that serializer does not tolarate when the method was removed between serialization and materialization"
	
	| classOrTrait |
	classOrTrait := self newClassOrTrait.
	classOrTrait classSide duringTestCompileSilently: 'you'.
	
	self serialize: classOrTrait classSide >> #you.
	classOrTrait classSide removeSelectorSilently: #you.
	
	self 
		should: [self materialized] 
		raise: FLMethodNotFound
		whoseDescriptionIncludes: classOrTrait classSide printString 
		description: 'Should raise an error when method is not present.' 
	
! !

!FLGlobalClassSerializationTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 4/19/2012 19:40'!
testInstanceOfAnObsoleteClass
	"Tests that serializer does not serialize an instance of an obsolete class."
	
	| aClass instance |
	aClass := self newClassOrTrait.
	instance := self newInstanceFrom: aClass.
	self removeFromSystem: aClass.

	self 
		should: [self serialize: instance ] 
		raise: FLObsolete
		whoseDescriptionIncludes: aClass name
		description: 'Should raise an error when serializing as global an obsolete class.' ! !

!FLGlobalClassSerializationTest methodsFor: 'tests' stamp: ''!
testClassSideObsolete
	"Tests that serializer does not serialize as global the class-side of an obsolete class or trait."
	
	| classOrTrait |
	classOrTrait := self newClassOrTrait.
	self removeFromSystem: classOrTrait.

	self 
		should: [self serialize: classOrTrait ] 
		raise: FLObsolete
		whoseDescriptionIncludes: classOrTrait name
		description: 'Should raise an error when serializing as global an obsolete class or trait.' ! !

!FLGlobalClassSerializationTest methodsFor: 'tests' stamp: ''!
testObsolete
	"Tests that serializer does not serialize as global an obsolete class or trait."
	
	| classOrTrait |
	classOrTrait := self newClassOrTrait.
	self removeFromSystem: classOrTrait.

	self 
		should: [self serialize: classOrTrait ] 
		raise: FLObsolete
		whoseDescriptionIncludes: classOrTrait name
		description: 'Should raise an error when serializing as global an obsolete class or trait.' ! !

!FLGlobalClassSerializationTest methodsFor: 'tests' stamp: ''!
testClassSidePreservesIdentity
	"Tests that serialization of the class side preserves identity"
	
	self assertSerializationIdentityOf: self newClassOrTrait classSide ! !

!FLGlobalClassSerializationTest methodsFor: 'tests' stamp: ''!
testClassSideMethodPreservesIdentity
	"Tests that serialization of a method in the class-side of a class or trait preserves identity"
	
	| classOrTrait |
	classOrTrait := self newClassOrTrait.
	classOrTrait classSide duringTestCompileSilently: 'you'.
	self assertSerializationIdentityOf: classOrTrait classSide >> #you! !

!FLGlobalClassSerializationTest methodsFor: 'tests' stamp: ''!
testNotFoundAfterRename
	"Tests that serializer does not tolarate when the class was renamed between serialization and materialization"
	
	| classOrTrait |
	classOrTrait := self newClassOrTrait.
	
	self serialize: classOrTrait.
	classOrTrait renameSilently: (classOrTrait name, 'Renamed') asSymbol.
	
	self should: [self materialized] raise: FLClassNotFound.! !

!FLGlobalClassSerializationTest methodsFor: 'tests' stamp: ''!
testPreservesIdentity
	"Tests that serialization of the class or trait preserves identity"
	
	self assertSerializationIdentityOf: self newClassOrTrait! !

!FLGlobalClassSerializationTest methodsFor: 'tests' stamp: ''!
testMethodNotFoundAfterRemoval
	"Tests that serializer does not tolarate when the method was removed between serialization and materialization"
	
	| classOrTrait |
	classOrTrait := self newClassOrTrait.
	classOrTrait duringTestCompileSilently: 'you'.
	
	self serialize: classOrTrait >> #you.
	classOrTrait removeSelectorSilently: #you.
	
	self 
		should: [self materialized] 
		raise: FLMethodNotFound
		whoseDescriptionIncludes: classOrTrait name, '>>#you' 
		description: 'Should raise an error when method is not present.' 
	
! !

!FLGlobalClassSerializationTest methodsFor: 'tests' stamp: ''!
testMethodPreservesIdentity
	"Tests that serialization of a method in a class or trait preserves identity"
	
	| classOrTrait |
	classOrTrait := self newClassOrTrait.
	classOrTrait duringTestCompileSilently: 'you'.
	self assertSerializationIdentityOf: classOrTrait >> #you! !

!FLGlobalClassSerializationTest methodsFor: 'tests' stamp: ''!
testNotFoundAfterRemoval
	"Tests that serializer does not tolarate when the class was removed between serialization and materialization"
	
	| classOrTrait |
	classOrTrait := self newClassOrTrait.
	
	self serialize: classOrTrait.
	self removeFromSystem: classOrTrait.
	
	self should: [self materialized] raise: FLClassNotFound.! !

!FLGlobalClassSideCluster commentStamp: 'MartinDias 8/1/2011 02:57'!
I am a cluster for those Metaclasses and ClassTrait who are not stored in detail.!
!FLGlobalClassSideCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/30/2011 12:29'!
materializeInstanceWith: aDecoder

	^(self materializeGlobalClassFrom: aDecoder) classSide! !

!FLGlobalClassSideCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/30/2011 12:27'!
serializeInstance: aClassOrTraitClassSide with: anEncoder

	self serializeGlobalClass: aClassOrTraitClassSide instanceSide on: anEncoder
! !

!FLGlobalCluster commentStamp: 'MartinDias 9/16/2011 14:49'!
I am a cluster for objects that are reachables from Smalltalk global dictionary.!
!FLGlobalCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/30/2011 12:24'!
serializeGlobalClass: aClass on: anEncoder
	
	aClass isObsolete ifTrue: [ FLObsolete signalWithName: aClass name ].
	anEncoder encodeString: aClass name ! !

!FLGlobalCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/30/2011 12:24'!
serializeGlobalAssociationKeyed: aSymbol on: anEncoder
	
	anEncoder encodeString: aSymbol! !

!FLGlobalCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 2/21/2013 17:30'!
materializeGlobalAssociationFrom: aDecoder

	| globalName |
	globalName := aDecoder nextEncodedString asSymbol.
	^ aDecoder globalEnvironment
		associationAt: globalName
		ifAbsent: [ FLGlobalNotFound signalWithName: globalName ]
! !

!FLGlobalCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 1/5/2012 01:05'!
materializeGlobalClassFrom: aDecoder

	| className |
	className := aDecoder nextEncodedString asSymbol.
	^ aDecoder classNamed: className! !

!FLGlobalCluster class methodsFor: 'analyzing' stamp: 'MartinDias 1/8/2012 15:38'!
clusterBucketIn: aClusterization

	^aClusterization globalsBucket ! !

!FLGlobalCompiledMethodCluster commentStamp: '<historical>'!
I clusterize CompiledMethods that will be obtained on materialization accessing method dictionary of the corresponding class in Smalltalk globals.
!
!FLGlobalCompiledMethodCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 3/20/2012 00:38'!
materializeInstanceWith: aDecoder

	| methodClass selector method serializedHash |
	methodClass := self materializeGlobalClassFrom: aDecoder.
	(aDecoder nextEncodedByte = 1) ifTrue: [
		methodClass := methodClass classSide].
	selector := aDecoder nextEncodedString asSymbol.
	method := methodClass  
		compiledMethodAt: selector
		ifAbsent: [FLMethodNotFound signalWith: methodClass name and: selector].
	serializedHash := aDecoder nextEncodedUint16.
	method bytecodesHash =  serializedHash
		ifFalse: [FLMethodChanged signalWith: methodClass name and: selector].
	^method! !

!FLGlobalCompiledMethodCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 3/20/2012 00:38'!
serializeInstance: aCompiledMethod with: anEncoder
	| methodClass |
	methodClass := aCompiledMethod methodClass.
	self serializeGlobalClass: methodClass instanceSide on: anEncoder.
	anEncoder encodeByte: (methodClass isClassSide ifTrue: [1] ifFalse: [0]).
	anEncoder encodeString: aCompiledMethod selector.
	anEncoder encodeUint16: aCompiledMethod bytecodesHash.! !

!FLGlobalEnvironmentTest commentStamp: 'TorstenBergmann 2/3/2014 23:27'!
SUnit tests for global fuel environment!
!FLGlobalEnvironmentTest methodsFor: 'tests' stamp: 'MartinDias 2/25/2013 13:21'!
testGlobalClass
	"A class should be global by default. On materialization, the global symbol should be found in the global environment."
	
	materializationEnvironment 
		at: #Integer 
		put: FLPerson.

	self assert: (self resultOfSerializeAndMaterialize: Integer) == FLPerson! !

!FLGlobalEnvironmentTest methodsFor: 'tests' stamp: 'MartinDias 2/25/2013 13:15'!
testGlobalMetaclassNotFound
	"If a class is not defined in the materialization environment, a proper error should be raised."
	
	self serialize: Integer class.
	
	self should: [ self materialization ] 
		raise: FLClassNotFound 
		description: 'Raise an error since the class is not present in materialization global environment'! !

!FLGlobalEnvironmentTest methodsFor: 'tests' stamp: 'MartinDias 2/25/2013 13:48'!
testCompiledMethodChanged
	"A compiled methods should be serialized as global by default. On materialization, it must be found in the global environment, and the bytecodes hash must be the same. Else, raise a proper error."
	
	| classA classB |
	classA := self newClass
		duringTestCompileSilently: 'm  ^ 42';
		yourself.
	classB := self newClass
		duringTestCompileSilently: 'm  ^ [ 42 ]';
		yourself.

	materializationEnvironment 
		at: classA name
		put: classB.

	self serialize: classA >> #m.

	self should: [ self materialization ]
		raise: FLMethodChanged 
		description: 'Serialized and materialized methods should have the same bytecodes.'! !

!FLGlobalEnvironmentTest methodsFor: 'tests' stamp: 'MartinDias 2/25/2013 13:51'!
testClassSideCompiledMethod
	"Any class-side compiled method should be serialized as global by default. On materialization, it should be found in the global environment, and the bytecodes hash must be the same."
	
	| classA classB |
	classA := self newClass.
	classA class duringTestCompileSilently: 'm  ^ 42'.
	classB := self newClass.
	classB class duringTestCompileSilently: 'm    ^    42   '.
	self assert: (classA class >> #m) bytecodesHash = (classB class >> #m) bytecodesHash.
	self deny: (classA class >> #m) == (classB class >> #m).

	materializationEnvironment 
		at: classA name
		put: classB.

	self assert: (self resultOfSerializeAndMaterialize: classA class >> #m) == (classB class >> #m)! !

!FLGlobalEnvironmentTest methodsFor: 'tests' stamp: 'MartinDias 2/25/2013 13:17'!
testConsiderCustomGlobal
	"A custom global variable is treated as global if we explicitly specify that on serialization."
	
	self analyzer considerGlobal: #FLGlobalVariableForTesting.

	serializationEnvironment 
		at: #FLGlobalVariableForTesting put: 42.

	materializationEnvironment 
		at: #FLGlobalVariableForTesting put: 7.
	
	self assert: (self resultOfSerializeAndMaterialize: 42) equals: 7! !

!FLGlobalEnvironmentTest methodsFor: 'tests' stamp: 'MartinDias 2/25/2013 13:51'!
testCompiledMethod
	"Any compiled method should be serialized as global by default. On materialization, it should be found in the global environment, and the bytecodes hash must be the same."
	
	| classA classB |
	classA := self newClass
		duringTestCompileSilently: 'm  ^ 42';
		yourself.
	classB := self newClass
		duringTestCompileSilently: 'm    ^    42   ';
		yourself.
	self assert: (classA >> #m) bytecodesHash = (classB >> #m) bytecodesHash.
	self deny: (classA >> #m) == (classB >> #m).

	materializationEnvironment 
		at: classA name
		put: classB.

	self assert: (self resultOfSerializeAndMaterialize: classA >> #m) == (classB >> #m)! !

!FLGlobalEnvironmentTest methodsFor: 'tests' stamp: 'MartinDias 2/25/2013 13:13'!
testConsiderCustomGlobalNotFound
	"A custom global variable is treated as global if we explicitly specify that on serialization. Then, if the variable is not defined in the materialization environment, a error should be raised."
	
	self analyzer considerGlobal: #FLGlobalVariableForTesting.

	serializationEnvironment 
		at: #FLGlobalVariableForTesting put: 42.

	self serialize: 42.
	self 
		should: [ self materialization ] 
		raise: FLGlobalNotFound 
		description: 'Raise an error since the variable is not present in materialization global environment'! !

!FLGlobalEnvironmentTest methodsFor: 'tests' stamp: 'MartinDias 2/25/2013 13:16'!
testDontConsiderCustomGlobal
	"A custom global variable is not treated as global unless we explicitly specify during serialization."
	
	| anObject |
	anObject := Object new.
	serializationEnvironment 
		at: #FLGlobalVariableForTesting put: anObject.
	materializationEnvironment 
		at: #FLGlobalVariableForTesting put: anObject;
		at: #Object put: Object.
	
	self deny: (self analyzer globalSymbols includes: #FLGlobalVariableForTesting).
	self deny: (self resultOfSerializeAndMaterialize: anObject) == anObject! !

!FLGlobalEnvironmentTest methodsFor: 'tests' stamp: 'MartinDias 2/25/2013 13:15'!
testGlobalClassNotFound
	"If a class is not defined in the materialization environment, a proper error should be raised."

	self serialize: Integer.
	
	self should: [ self materialization ] 
		raise: FLClassNotFound 
		description: 'Raise an error since the class is not present in materialization global environment'! !

!FLGlobalEnvironmentTest methodsFor: 'running' stamp: 'MartinDias 2/24/2013 19:46'!
setUp 
	super setUp.
	serializationEnvironment := Dictionary new.
	materializationEnvironment := Dictionary new.
	
	self analyzer globalEnvironment: serializationEnvironment.
	self materializer globalEnvironment: materializationEnvironment.! !

!FLGlobalEnvironmentTest methodsFor: 'tests' stamp: 'MartinDias 2/25/2013 13:21'!
testGlobalMetaclass
	"A metaclass should be global by default. On materialization, the global symbol should be found in the global environment."

	materializationEnvironment 
		at: #Integer 
		put: FLPerson.

	self assert: (self resultOfSerializeAndMaterialize: Integer class) == FLPerson class! !

!FLGlobalNotFound commentStamp: 'MartinDias 12/16/2011 01:16'!
I represent an error produced during materialization when a serialized global name doesn't exist (at Smalltalk globals).!
!FLGlobalNotFound class methodsFor: 'signaling' stamp: 'MartinDias 3/20/2012 12:06'!
signalWithName: aName
	^ self signal: 'Global named ', aName printString, ' not found.'! !

!FLGlobalSendCluster commentStamp: 'MarianoMartinezPeck 10/23/2011 14:39'!
I clusterize objects that will be obtained on materialization via a message send to a global object. 

Explained with an example:

Suppose we have a special instance of User that represents the admin user, and it is a unique instance in the image. In case the admin user is referenced in our graph, we want to treat that object as a global. We can do that in this way:

User >> fuelAccept: aVisitor
    ^self == User admin
        ifTrue: [aVisitor visitGlobalSend: self]
        ifFalse: [super fuelAccept: aVisitor]

User >> fuelGlobalName
    ^#User

User >> fuelSelector
    ^#admin

So what will happen is that during serialization, the admin user won't be completly serialized (with all its intance variables) but instead its global name and selector are stored. Then, at materialization time, Fuel will send the selector #admin to the class User, and use what that answers as the admin user of the materialized graph.

We test this feature in FLGlobalSendSerializationTest.!
!FLGlobalSendCluster methodsFor: 'initialize-release' stamp: 'MarianoMartinezPeck 11/17/2012 12:49'!
initializeAnalyzing
	super initializeAnalyzing.
	globalSends := IdentityDictionary new.! !

!FLGlobalSendCluster methodsFor: 'mapping' stamp: 'MartinDias 1/10/2012 02:53'!
add: anObject name: globalName selector: selector traceWith: anAnalysis

	self add: anObject traceWith: anAnalysis.
	globalSends
		at: anObject
		ifAbsentPut: [ Association key: globalName value: selector ]! !

!FLGlobalSendCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 2/20/2013 20:54'!
serializeInstance: anObject with: anEncoder
	
	| globalSend |
	globalSend := globalSends at: anObject.
	
	self serializeGlobalAssociationKeyed: globalSend key on: anEncoder.
	anEncoder encodeString: globalSend value.
! !

!FLGlobalSendCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 2/20/2013 20:54'!
materializeInstanceWith: aDecoder

	| global selector |
	global := (self materializeGlobalAssociationFrom: aDecoder) value.	
	selector := aDecoder nextEncodedString asSymbol.
	^ global perform: selector! !

!FLGlobalSendMock commentStamp: 'TorstenBergmann 2/3/2014 23:21'!
A mock for a global send!
!FLGlobalSendMock methodsFor: 'comparing' stamp: 'MartinDias 9/15/2011 02:58'!
hash
	"Answer an integer value that is related to the identity of the receiver."

	^ contents hash! !

!FLGlobalSendMock methodsFor: 'comparing' stamp: 'MartinDias 9/15/2011 02:58'!
= anObject
	"Answer whether the receiver and anObject represent the same object."

	self == anObject
		ifTrue: [ ^ true ].
	self class = anObject class
		ifFalse: [ ^ false ].
	^ contents = anObject contents! !

!FLGlobalSendMock methodsFor: 'printing' stamp: 'MartinDias 9/15/2011 02:59'!
printOn: aStream
	"Append a sequence of characters to aStream that identify the receiver."

	super printOn: aStream.
	aStream
		nextPutAll: ' contents: ';
		print: contents! !

!FLGlobalSendMock methodsFor: 'accessing' stamp: 'MartinDias 9/15/2011 02:58'!
contents: anObject
	contents := anObject! !

!FLGlobalSendMock methodsFor: 'serialization' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper

	^aGeneralMapper visitGlobalSend: self name: #FLGlobalSendMock selector: #newInstanceToMaterialize! !

!FLGlobalSendMock methodsFor: 'accessing' stamp: 'MartinDias 9/15/2011 02:58'!
contents
	^ contents! !

!FLGlobalSendMock methodsFor: 'initialization' stamp: 'MartinDias 9/15/2011 02:56'!
initializeWith: aByteSymbol
	
	super initialize.
	contents := aByteSymbol ! !

!FLGlobalSendMock class methodsFor: 'instance creation' stamp: 'MartinDias 9/15/2011 02:56'!
newWith: aByteSymbol 
	
	^self basicNew
		initializeWith: aByteSymbol;
		yourself! !

!FLGlobalSendMock class methodsFor: 'instance creation' stamp: 'MartinDias 9/15/2011 02:57'!
newInstanceToMaterialize
	
	^self newWith: #materializing! !

!FLGlobalSendMock class methodsFor: 'instance creation' stamp: 'MartinDias 9/15/2011 02:55'!
newInstanceToSerialize
	
	^self newWith: #serializing! !

!FLGlobalSendNotPresentMock commentStamp: 'TorstenBergmann 2/3/2014 23:22'!
A test mock where a global send is not present!
!FLGlobalSendNotPresentMock methodsFor: 'serialization' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper

	^aGeneralMapper visitGlobalSend: self name: #FLKeyNotPresentInSmalltalks selector: #someSelector! !

!FLGlobalSendSerializationTest commentStamp: 'TorstenBergmann 2/3/2014 23:28'!
SUnit tests for fuel serialization of global sends!
!FLGlobalSendSerializationTest methodsFor: 'tests' stamp: 'MartinDias 3/20/2012 14:11'!
testGlobalNotFound

	self should: [ self resultOfSerializeAndMaterialize: FLGlobalSendNotPresentMock new ]
		raise: FLGlobalNotFound
		whoseDescriptionIncludes: #FLKeyNotPresentInSmalltalks 
		description: 'Should raise an error when global name is not present in Smalltalks globals.' 
	
! !

!FLGlobalSendSerializationTest methodsFor: 'tests' stamp: 'MartinDias 2/20/2013 21:40'!
testBasic

	| result |
	self deny: FLGlobalSendMock newInstanceToSerialize = FLGlobalSendMock newInstanceToMaterialize.

	result := self resultOfSerializeAndMaterialize: FLGlobalSendMock newInstanceToSerialize.
	self assert: FLGlobalSendMock newInstanceToMaterialize = result.! !

!FLGlobalTraitSerializationTest commentStamp: '<historical>'!
I test the serialization of traits as *external* objects, i.e. the traits has to be present in the image at materialization time.!
!FLGlobalTraitSerializationTest methodsFor: 'tests' stamp: ''!
testClassSideMethodNotFoundAfterRemoval
	"Tests that serializer does not tolarate when the method was removed between serialization and materialization"
	
	| classOrTrait |
	classOrTrait := self newClassOrTrait.
	classOrTrait classSide duringTestCompileSilently: 'you'.
	
	self serialize: classOrTrait classSide >> #you.
	classOrTrait classSide removeSelectorSilently: #you.
	
	self 
		should: [self materialized] 
		raise: FLMethodNotFound
		whoseDescriptionIncludes: classOrTrait classSide printString 
		description: 'Should raise an error when method is not present.' 
	
! !

!FLGlobalTraitSerializationTest methodsFor: 'tests' stamp: ''!
testClassSideObsolete
	"Tests that serializer does not serialize as global the class-side of an obsolete class or trait."
	
	| classOrTrait |
	classOrTrait := self newClassOrTrait.
	self removeFromSystem: classOrTrait.

	self 
		should: [self serialize: classOrTrait ] 
		raise: FLObsolete
		whoseDescriptionIncludes: classOrTrait name
		description: 'Should raise an error when serializing as global an obsolete class or trait.' ! !

!FLGlobalTraitSerializationTest methodsFor: 'tests' stamp: ''!
testObsolete
	"Tests that serializer does not serialize as global an obsolete class or trait."
	
	| classOrTrait |
	classOrTrait := self newClassOrTrait.
	self removeFromSystem: classOrTrait.

	self 
		should: [self serialize: classOrTrait ] 
		raise: FLObsolete
		whoseDescriptionIncludes: classOrTrait name
		description: 'Should raise an error when serializing as global an obsolete class or trait.' ! !

!FLGlobalTraitSerializationTest methodsFor: 'tests' stamp: ''!
testClassSidePreservesIdentity
	"Tests that serialization of the class side preserves identity"
	
	self assertSerializationIdentityOf: self newClassOrTrait classSide ! !

!FLGlobalTraitSerializationTest methodsFor: 'tests' stamp: ''!
testClassSideMethodPreservesIdentity
	"Tests that serialization of a method in the class-side of a class or trait preserves identity"
	
	| classOrTrait |
	classOrTrait := self newClassOrTrait.
	classOrTrait classSide duringTestCompileSilently: 'you'.
	self assertSerializationIdentityOf: classOrTrait classSide >> #you! !

!FLGlobalTraitSerializationTest methodsFor: 'tests' stamp: ''!
testNotFoundAfterRename
	"Tests that serializer does not tolarate when the class was renamed between serialization and materialization"
	
	| classOrTrait |
	classOrTrait := self newClassOrTrait.
	
	self serialize: classOrTrait.
	classOrTrait renameSilently: (classOrTrait name, 'Renamed') asSymbol.
	
	self should: [self materialized] raise: FLClassNotFound.! !

!FLGlobalTraitSerializationTest methodsFor: 'tests' stamp: ''!
testPreservesIdentity
	"Tests that serialization of the class or trait preserves identity"
	
	self assertSerializationIdentityOf: self newClassOrTrait! !

!FLGlobalTraitSerializationTest methodsFor: 'tests' stamp: ''!
testMethodNotFoundAfterRemoval
	"Tests that serializer does not tolarate when the method was removed between serialization and materialization"
	
	| classOrTrait |
	classOrTrait := self newClassOrTrait.
	classOrTrait duringTestCompileSilently: 'you'.
	
	self serialize: classOrTrait >> #you.
	classOrTrait removeSelectorSilently: #you.
	
	self 
		should: [self materialized] 
		raise: FLMethodNotFound
		whoseDescriptionIncludes: classOrTrait name, '>>#you' 
		description: 'Should raise an error when method is not present.' 
	
! !

!FLGlobalTraitSerializationTest methodsFor: 'tests' stamp: ''!
testMethodPreservesIdentity
	"Tests that serialization of a method in a class or trait preserves identity"
	
	| classOrTrait |
	classOrTrait := self newClassOrTrait.
	classOrTrait duringTestCompileSilently: 'you'.
	self assertSerializationIdentityOf: classOrTrait >> #you! !

!FLGlobalTraitSerializationTest methodsFor: 'tests' stamp: ''!
testNotFoundAfterRemoval
	"Tests that serializer does not tolarate when the class was removed between serialization and materialization"
	
	| classOrTrait |
	classOrTrait := self newClassOrTrait.
	
	self serialize: classOrTrait.
	self removeFromSystem: classOrTrait.
	
	self should: [self materialized] raise: FLClassNotFound.! !

!FLGlobalValueCluster commentStamp: 'MartinDias 5/30/2011 01:28'!
I am a cluster for known objects that belong to Smalltalk global dictionary.

For example, Transcript could be serialized and materialized by me.!
!FLGlobalValueCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/30/2011 12:29'!
materializeInstanceWith: aDecoder

	^(self materializeGlobalAssociationFrom: aDecoder) value! !

!FLGlobalValueCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 2/21/2013 17:30'!
serializeInstance: anObject with: anEncoder
	
	self serializeGlobalAssociationKeyed: (anEncoder globalEnvironment keyAtValue: anObject) on: anEncoder! !

!FLHashedCollectionSerializationTest commentStamp: 'TorstenBergmann 2/3/2014 23:28'!
SUnit tests for fuel serialization of hashed collections!
!FLHashedCollectionSerializationTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 5/20/2011 13:46'!
testSetRehash
	|  aSet person1 person2 person3 materializedSet newPerson1 |
	aSet := Set new.
	person1 := FLPerson new id: 1.
	person2 := FLPerson new id: 5.
	person3 := FLPerson new id: 8.
	aSet
		add: person1;
		add: person2;
		add: person3.

	self assert: (aSet includes: person1).
	self assert: (aSet includes: person2).
	self assert: (aSet includes: person3).
	
	materializedSet := self resultOfSerializeAndMaterialize: aSet.

    "If Fuel serializes the Set normally, it will copy its internal array just as it is. Hence, the element will be in the same order. But the objects instead may be recreated. SqueakVM assigns an identity hash at creation time (stored in the object header). So, all objects who didn't implement #hash will be finally using #identityHash. I cannot change the identityHash of an object,  so I do a test changing the id by hand.
Now, let's say that the id of person 1 change to 3 (this would be the same case when Fuel creates new objects and a new identity hash is asigned) . This 3 is not coincidence. It has to be a hash such that:
    (hash \\ aSet array size) + 1   gives you a position in the array that has a next nil in the array. In this case, the person1 is at position 2 of the array and there is a nil in position 3 and one at 5..   So (3 \\ 5) + 1 = 4.  So....Set >> scanFor:  will start to search from position 4 and since it will find a nil in 5 it will assume it has to stop searching and that the object is not present. For more details check .Set >> scanFor: "
	newPerson1 := materializedSet detect: [:each | each id = person1 id].
	newPerson1 id: 3.
	"Fuel rehashes the set at the end. This means, after having materialized the instnaces of the set. In this case, we are chanign the has of the object once it was already been materialzed, so we should simulate the rehash done by Fuel"
	materializedSet rehash.
	self assert: (materializedSet includes: newPerson1).! !

!FLHashedCollectionSerializationTest methodsFor: 'tests' stamp: 'MartinDias 10/5/2011 19:23'!
testDictionaryRehash
	|  aDictionary person1 person2 person3 materializedDict newPerson1 |

	aDictionary := Dictionary new.
	person1 := FLPerson new id: 1.
	person2 := FLPerson new id: 5.
	person3 := FLPerson new id: 8.
	aDictionary
		at: person1 put: person1;
		at: person2 put: person2;
		at: person3 put: person3.

	self assert: (aDictionary at: person1) = person1.
	self assert: (aDictionary at: person2) = person2.
	self assert: (aDictionary at: person3) = person3.
	

	materializedDict := self resultOfSerializeAndMaterialize: aDictionary.

    "If Fuel serializes the Dictionary  normally, it will copy its internal array just as it is. Hence, the element will be in the same order. But the objects instead may be recreated. SqueakVM assigns an identity hash at creation time (stored in the object header). So, all objects who didn't implement #hash will be finally using #identityHash. I cannot change the identityHash of an object,  so I do a test changing the id by hand.
Now, let's say that the id of person 1 change to 3 (this would be the same case when Fuel creates new objects and a new identity hash is asigned) . This 3 is not coincidence. It has to be a hash such that:
    (hash \\ aDictionary array size) + 1   gives you a position in the array that has a next nil in the array. In this case, the person1 is at position 2 of the array and there is a nil in position 3 and one at 5..   So (3 \\ 5) + 1 = 4.  So....Dictionary >> scanFor:  will start to search from position 4 and since it will find a nil in 5 it will assume it has to stop searching and that the object is not present. For more details check .Dictionary  >> scanFor: "

	newPerson1 := materializedDict keys detect: [:each | each id = person1 id].
	newPerson1 id: 3.
"Fuel rehashes the set at the end. This means, after having materialized the instnaces of the set. In this case, we are chanign the has of the object once it was already been materialzed, so we should simulate the rehash done by Fuel"
	materializedDict rehash.
	self assert: (materializedDict includesKey: newPerson1).! !

!FLHeader commentStamp: '<historical>'!
An instance of FLHeader is serialized together with the orignal object graph to serialize. This header is useful to:

1) Attach additional state or metadata associated to the graph being serialized.
2) Attach pre and post materialization actions!
!FLHeader methodsFor: 'initialization' stamp: 'MarianoMartinezPeck 7/28/2012 12:33'!
initialize
	additionalObjects := IdentityDictionary new.
	preMaterializationActions := OrderedCollection new.
	postMaterializationActions := OrderedCollection new.! !

!FLHeader methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 7/28/2012 13:48'!
materialization: aMaterialization
	"This is just set once the materialization had happened"
	materialization := aMaterialization ! !

!FLHeader methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 7/28/2012 14:25'!
addPostMaterializationAction: aCleanBlockClosure
	"The closure may (or not) have one parameter and it will be the materialization."
	aCleanBlockClosure isClean ifFalse: [ self error: 'Post materializaton actions have to be clean closures. For more details see method BlocKClosure >> #isClean' ].
	postMaterializationActions add: aCleanBlockClosure ! !

!FLHeader methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 8/21/2012 16:50'!
postMaterializationActions: listOfPostMaterializationActions
	postMaterializationActions := listOfPostMaterializationActions.
	! !

!FLHeader methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 8/21/2012 16:50'!
preMaterializationActions: listOfPreMaterializationActions
	preMaterializationActions := listOfPreMaterializationActions.
	! !

!FLHeader methodsFor: 'testing' stamp: 'MartinDias 2/25/2013 14:55'!
isEmpty
	^ preMaterializationActions isEmpty 
		and: [ postMaterializationActions isEmpty
		and: [ additionalObjects isEmpty ] ]! !

!FLHeader methodsFor: '*GT-InspectorExtensions-Core' stamp: 'MaxLeske 3/4/2014 11:55'!
gtGetMetaData
	|assoc|
	
	assoc := OrderedCollection new.
	assoc add: ('Meta' ->(String streamContents: [ :stream |
		additionalObjects do: [ :add | add printOn: stream. stream crlf ]])).
	assoc add: ('Pre materialization actions:' -> (String streamContents: [ :stream |
		preMaterializationActions do: [ :action | action printOn: stream ]])).
	assoc add: ('Post materialization actions: ' -> (String streamContents: [ :stream |
		postMaterializationActions do: [ :action | action printOn: stream ]])).
	^ assoc! !

!FLHeader methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 7/28/2012 11:53'!
additionalObjectAt: key
	^ additionalObjects at: key! !

!FLHeader methodsFor: 'executing' stamp: 'MarianoMartinezPeck 7/28/2012 14:25'!
executePreMaterializationActions
	preMaterializationActions do: [:each | each value]! !

!FLHeader methodsFor: 'executing' stamp: 'MarianoMartinezPeck 7/28/2012 14:25'!
executePostMaterializationActions
	postMaterializationActions do: [:each | each cull: materialization]! !

!FLHeader methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 7/28/2012 11:36'!
at: key putAdditionalObject: anObject 
	"This is useful if we want to attach objects to a package that will also be serialized. The way they are stored is key-value."
	additionalObjects at: key put: anObject! !

!FLHeader methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 7/28/2012 14:24'!
addPreMaterializationAction: aCleanBlockClosure
	aCleanBlockClosure isClean ifFalse: [ self error: 'Pre materializaton actions have to be clean closures. For more details see method BlocKClosure >> #isClean' ].
	preMaterializationActions add: aCleanBlockClosure ! !

!FLHeaderSerializationTest commentStamp: 'TorstenBergmann 2/3/2014 23:32'!
SUnit tests for header serialization in fuel!
!FLHeaderSerializationTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 7/28/2012 13:47'!
testAdditionalObjects

	| materialization |
	self serializer at: #test putAdditionalObject: 'test'.
	self serializer at: 42 putAdditionalObject: 68.
	
	self assertSerializationEqualityOf: 'foo'.

	self assert: (self materialization additionalObjectAt: #test) equals: 'test'.
	self assert: (self materialization additionalObjectAt: 42) equals: 68.
	! !

!FLHeaderSerializationTest methodsFor: 'tests' stamp: 'MaxLeske 10/3/2014 20:43'!
testPreMaterializationActions

	| aClass |
	aClass := self 
		newSubclassNamed: #FuelPreMaterializationTestClassToBeDeleted 
		of: Object
		instanceVariableNames: ''
		classVariableNames: 'TestClassVariable TestClassVariable2'.
	aClass class
		duringTestCompileSilently: 'postLoadMethod  TestClassVariable := 1';
		duringTestCompileSilently: 'postLoadMethod2  TestClassVariable := 2';
		duringTestCompileSilently: 'classVariable  ^TestClassVariable '.
	
	aClass perform: #postLoadMethod.
	self assert: (aClass perform: #classVariable) = 1.
	
	self serializer addPreMaterializationAction: [  (Smalltalk at: #FuelPreMaterializationTestClassToBeDeleted) perform: #postLoadMethod2  ].
	self serialize: aClass.
	self assert: (aClass perform: #classVariable) = 1.
	self materialized.	
	self assert: (aClass perform: #classVariable) = 2.
! !

!FLHeaderSerializationTest methodsFor: 'tests' stamp: 'MaxLeske 10/3/2014 20:42'!
testPostMaterializationActions

	| aClass |
	aClass := self 
		newSubclassNamed: #FuelPostMaterializationTestClassToBeDeleted 
		of: Object
		instanceVariableNames: ''
		classVariableNames: 'TestClassVariable TestClassVariable2'.
	aClass class
		duringTestCompileSilently: 'postLoadMethod  TestClassVariable := 1';
		duringTestCompileSilently: 'postLoadMethod2  TestClassVariable := 2';
		duringTestCompileSilently: 'classVariable  ^TestClassVariable '.
	
	aClass perform: #postLoadMethod.
	self assert: (aClass perform: #classVariable) = 1.
	
	self serializer addPostMaterializationAction: [  (Smalltalk at: #FuelPostMaterializationTestClassToBeDeleted) perform: #postLoadMethod2  ].
	self serialize: aClass.
	self assert: (aClass perform: #classVariable) = 1.
	self materialized.	
	self assert: (aClass perform: #classVariable) = 2.
! !

!FLHeaderSerializationTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 7/28/2012 15:04'!
testJustMaterializeHeader

	self serializer at: #test putAdditionalObject: 'test'.
	self serializer at: 42 putAdditionalObject: 68.
	
	self serialize: 'foo'.
	
	self assert: (self materializationHeader additionalObjectAt: #test) equals: 'test'.
	self assert: (self materializationHeader additionalObjectAt: 42) equals: 68.
	! !

!FLHookPrimitiveCluster commentStamp: '<historical>'!
I am a cluster for simple objects who define serialization and materialization via hooks on their classes.!
!FLHookPrimitiveCluster methodsFor: 'printing' stamp: 'MartinDias 5/11/2012 19:23'!
printNameOn: aStream
	"Append to the argument, aStream, a sequence of characters that  
	identifies the receiver."
	
	super printNameOn: aStream.
	aStream nextPut: $[.
	theClass printOn: aStream.
	aStream nextPut: $].! !

!FLHookPrimitiveCluster methodsFor: 'analyzing' stamp: 'MarianoMartinezPeck 4/23/2012 16:33'!
clusterReferencesDo: aBlock

	aBlock value: theClass! !

!FLHookPrimitiveCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 9/19/2012 14:41'!
clusterSerializeStepWith: aSerialization

	super clusterSerializeStepWith: aSerialization.
	aSerialization encoder encodeReferenceTo: theClass.	! !

!FLHookPrimitiveCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/30/2011 10:48'!
serializeInstance: anObject with: anEncoder

	anObject serializeOn: anEncoder! !

!FLHookPrimitiveCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/30/2011 10:47'!
materializeInstanceWith: aDecoder
	
	^theClass materializeFrom: aDecoder! !

!FLHookPrimitiveCluster methodsFor: 'initialize-release' stamp: 'MartinDias 2/25/2013 14:47'!
initializeAnalyzing: aClass

	self initializeAnalyzing.
	theClass := aClass! !

!FLHookPrimitiveCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 9/19/2012 14:42'!
clusterMaterializeStepWith: aMaterialization

	super clusterMaterializeStepWith: aMaterialization.
	theClass := aMaterialization decoder nextEncodedReference.
! !

!FLHookPrimitiveCluster class methodsFor: 'instance creation' stamp: 'MarianoMartinezPeck 4/23/2012 16:34'!
newAnalyzing: aClass

	^ self basicNew
		initializeAnalyzing: aClass;
		yourself.! !

!FLHookedSubstitutionTest commentStamp: 'TorstenBergmann 2/3/2014 23:32'!
SUnit tests for hooked serialization using fuel!
!FLHookedSubstitutionTest methodsFor: 'tests' stamp: 'MartinDias 5/9/2012 01:17'!
testSubstituteByItself

	| aRecursiveClass result | 
	aRecursiveClass := (self newSubclassOf: Object instanceVariableNames: '' classVariableNames: '') 
		duringTestCompileSilently: 'fuelAccept: aMapper  
			^aMapper 
				visitSubstitution: self by: self 
				onRecursionDo: [super fuelAccept: aMapper]';
		yourself.

	result := self resultOfSerializeAndMaterialize: aRecursiveClass new.	
	
	"self flag: #todo." "Should test that it doesn't enter in loop."! !

!FLHookedSubstitutionTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 4/19/2012 19:12'!
testProxyByTargetInsideObjectAndAnalisysIsPropagated

	| aProxyClass result original pair pairRoot | 
	aProxyClass := (self newSubclassOf: Object instanceVariableNames: 'target' classVariableNames: '') 
		duringTestCompileSilently: 'target: x  target := x';
		duringTestCompileSilently: 'fuelAccept: aVisitor  ^aVisitor visitSubstitution: self by: target';
		yourself.

	pair := FLPair new.
	pair left: 6.
	pair right: 'foo'. 

	original := aProxyClass new target: pair; yourself.

	pairRoot := FLPair new left: original; yourself.

	result := self resultOfSerializeAndMaterialize: pairRoot.
	
	self assert: result left left = 6.
	self assert: result left right = 'foo'.
	self assert: result right isNil.
			
! !

!FLHookedSubstitutionTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 4/19/2012 19:12'!
testTransientByNil

	| result aClassOfTransientObjects | 
	aClassOfTransientObjects := self newClass
		duringTestCompileSilently: 'fuelAccept: aVisitor  ^aVisitor visitSubstitution: self by: nil';
		yourself.

	result := self resultOfSerializeAndMaterialize: aClassOfTransientObjects new.
	
	self assert: result isNil.! !

!FLHookedSubstitutionTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 4/19/2012 19:12'!
testObjectByProxyThatBecomesItsContent
	"Tests a substitution of an object by a proxy that becomes another object on materialization."

	| aProxyClass result | 
	aProxyClass := (self newSubclassOf: Object instanceVariableNames: 'someState' classVariableNames: '') 
		duringTestCompileSilently: 'initialize  someState := 5@1';
		duringTestCompileSilently: 'fuelAccept: aVisitor  ^aVisitor visitSubstitution: self by: (FLProxyThatBecomesItsContent newWith: someState)';
		yourself.

	result := self resultOfSerializeAndMaterialize: aProxyClass new.
	
	self assert: 5@1 = result.! !

!FLHookedSubstitutionTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 4/19/2012 19:12'!
testProxyByTarget

	| aProxyClass result original | 
	aProxyClass := (self newSubclassOf: Object instanceVariableNames: 'target' classVariableNames: '') 
		duringTestCompileSilently: 'target: x  target := x';
		duringTestCompileSilently: 'fuelAccept: aVisitor  ^aVisitor visitSubstitution: self by: target';
		yourself.

	original := aProxyClass new target: 5; yourself.

	result := self resultOfSerializeAndMaterialize: original.
	
	self assert: 5 = result.! !

!FLHookedSubstitutionTest methodsFor: 'tests' stamp: 'MartinDias 5/9/2012 01:00'!
testAvoidRecursion

	| aClass result original | 
	original := FLClassWithRecursiveSubstitution new index: 1.
	
	result := self resultOfSerializeAndMaterialize: original.
	
	self assert: result index = 2! !

!FLHookedSubstitutionTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 4/19/2012 19:12'!
testProxyByTargetAnalisysIsPropagated

	| aProxyClass result pair | 
	self flag: #todo. "I don't understand what are we testing here."

	aProxyClass := (self newSubclassOf: Object instanceVariableNames: 'target' classVariableNames: '') 
		duringTestCompileSilently: 'target: x  target := x';
		duringTestCompileSilently: 'fuelAccept: aVisitor  ^aVisitor visitSubstitution: self by: target';
		yourself.

	pair := FLPair new.
	pair left: 6.
	pair right: 'foo'. 

	aProxyClass new target: pair; yourself.

	result := self resultOfSerializeAndMaterialize: pair.
	
	self assert: result left = 6.
	self assert: result right = 'foo'.! !

!FLHookedSubstitutionTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 4/19/2012 19:12'!
testClassWithCachedValueByNil

	| aClassWithCachedValue result original | 
	aClassWithCachedValue := (self newSubclassOf: Object instanceVariableNames: 'cache' classVariableNames: '') 
		duringTestCompileSilently: 'cache ^cache';
		duringTestCompileSilently: 'cache: x cache := x';
		duringTestCompileSilently: '
			fuelAccept: aVisitor  
				^cache 
					ifNil: [ super fuelAccept: aVisitor ]
					ifNotNil: [ aVisitor visitSubstitution: self by: (self copy cache: nil)]';
		yourself.

	original := aClassWithCachedValue new cache: 5; yourself.

	result := self resultOfSerializeAndMaterialize: original.
	
	self assert: result cache isNil.! !

!FLHookedSubstitutionTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 4/19/2012 19:12'!
testProxyInsideObjectByTarget

	| aProxyClass result original pair | 
	aProxyClass := (self newSubclassOf: Object instanceVariableNames: 'target' classVariableNames: '') 
		duringTestCompileSilently: 'target: x  target := x';
		duringTestCompileSilently: 'fuelAccept: aVisitor  ^aVisitor visitSubstitution: self by: target';
		yourself.

	original := aProxyClass new target: 5; yourself.
	
	pair := FLPair new.
	pair left: original.
	pair right: 'foo'. 

	result := self resultOfSerializeAndMaterialize: pair.
	
	self assert: result left = 5.
	self assert: result right = 'foo'.
		
! !

!FLIgnoredVariablesTest commentStamp: 'TorstenBergmann 2/3/2014 23:26'!
SUnit tests for serialization with ignored variables!
!FLIgnoredVariablesTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 4/19/2012 12:46'!
testAllVariablesIgnored

	| anObject result aClass |
	aClass := self newClassWithInstanceVariableNames: 'a b'.
	aClass class duringTestCompileSilently: 'fuelIgnoredInstanceVariableNames ^#(a b)'.
	anObject := aClass new
		instVarAt: 1 put: $A;
		instVarAt: 2 put: $B;
		yourself.

	result := self resultOfSerializeAndMaterialize: anObject.

	self assert: (result instVarAt: 1) isNil.
	self assert: (result instVarAt: 2) isNil.
! !

!FLIgnoredVariablesTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 4/19/2012 12:46'!
testTwoIgnoredVariables

	| anObject result aClass |
	aClass := self newClassWithInstanceVariableNames: 'a b c'.
	aClass class duringTestCompileSilently: 'fuelIgnoredInstanceVariableNames ^#(a c)'.
	anObject := aClass new
		instVarAt: 1 put: $A;
		instVarAt: 2 put: $B;
		instVarAt: 3 put: $C;
		yourself.

	result := self resultOfSerializeAndMaterialize: anObject.

	self assert: nil = (result instVarAt: 1).
	self assert: $B = (result instVarAt: 2).
	self assert: nil = (result instVarAt: 3).! !

!FLIgnoredVariablesTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 4/19/2012 12:07'!
testIgnoredValueIsNotMaterialized

	| anObject materializedInstances aClass |
	aClass := self newClassWithInstanceVariableNames: 'a'.
	aClass class duringTestCompileSilently: 'fuelIgnoredInstanceVariableNames ^#(a)'.
	anObject := aClass new
		instVarAt: 1 put: #A;
		yourself.

	self serialize: anObject.
	materializedInstances := self materializedObjects.

	self deny: (materializedInstances includes: #A)
! !

!FLIgnoredVariablesTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 4/19/2012 12:46'!
testOneIgnoredVariable

	| anObject result aClass |
	aClass := self newClassWithInstanceVariableNames: 'a b c'.
	aClass class duringTestCompileSilently: 'fuelIgnoredInstanceVariableNames ^#(b)'.
	anObject := aClass new
		instVarAt: 1 put: $A;
		instVarAt: 2 put: $B;
		instVarAt: 3 put: $C;
		yourself.

	result := self resultOfSerializeAndMaterialize: anObject.

	self assert: $A = (result instVarAt: 1).
	self assert: nil = (result instVarAt: 2).
	self assert: $C = (result instVarAt: 3)! !

!FLInMemoryBasicSerializationTest commentStamp: 'TorstenBergmann 2/3/2014 23:25'!
SUnit tests for basic in memory serialization!
!FLInMemoryBasicSerializationTest methodsFor: 'tests' stamp: 'MartinDias 3/28/2012 22:58'!
testConsiderCustomGlobal
	"Since FLSerializer class >> serializeToByteArray: does not allow customizing serialization, this test is disabled."! !

!FLInMemoryBasicSerializationTest methodsFor: 'running' stamp: 'MartinDias 3/28/2012 22:46'!
serialize: anObject

	byteArray := FLSerializer serializeToByteArray: anObject! !

!FLInMemoryBasicSerializationTest methodsFor: 'running' stamp: 'MartinDias 3/28/2012 22:48'!
materialized

	^ FLMaterializer materializeFromByteArray: byteArray.
! !

!FLInMemoryBasicSerializationTest methodsFor: 'running' stamp: 'MartinDias 3/28/2012 22:48'!
materialization

	self error: 'Disabled, instead use #materialized.'
! !

!FLInMemoryBasicSerializationTest methodsFor: 'tests' stamp: 'MartinDias 3/28/2012 22:56'!
testStringGlobalsAndClosure

	| materialized |
	materialized := self resultOfSerializeAndMaterialize:  (Array 
			with: 'a string' 
			with: Transcript
			with: [ Transcript show: 'a string' ]).
	self assert: materialized first = 'a string'.
	self assert: materialized second == Transcript! !

!FLInMemoryBasicSerializationTest class methodsFor: 'testing' stamp: 'MartinDias 3/28/2012 22:49'!
shouldInheritSelectors 
	^ true! !

!FLIndexStream commentStamp: '<historical>'!
I am an optimized stream for writing and reading *indexes*, i.e. positive integers with a known upper bound. !
!FLIndexStream methodsFor: 'accessing' stamp: 'MartinDias 12/30/2011 15:25'!
nextIndex
	
	| s |
	s := 0.
	1 to: digits do: 
		[:i | s := (s bitShift: 8) bitOr: stream next].
	^ s! !

!FLIndexStream methodsFor: 'accessing' stamp: 'MartinDias 12/30/2011 15:21'!
nextIndexPut: v

	1 to: digits do: [:i | stream nextPut: (v digitAt: digits + 1 - i)]
! !

!FLIndexStream methodsFor: 'initialize-release' stamp: 'MartinDias 12/30/2011 14:28'!
initializeOn: aStream digits: aNumberOfDigits

	self initialize.
	stream := aStream.
	digits := aNumberOfDigits! !

!FLIndexStream class methodsFor: 'instance creation' stamp: 'MartinDias 12/30/2011 14:33'!
on: aStream digits: aNumberOfDigits

	^ self basicNew 
		initializeOn: aStream 
		digits: aNumberOfDigits;
		yourself.

	! !

!FLIndexStreamTest commentStamp: 'TorstenBergmann 2/3/2014 23:22'!
SUnit tests for index streams!
!FLIndexStreamTest methodsFor: 'running' stamp: 'MartinDias 12/30/2011 15:29'!
indexStreamOn: aStream digits: aNumberOfDigits
	^ FLIndexStream 
		on: aStream
		digits: aNumberOfDigits! !

!FLIndexStreamTest methodsFor: 'tests' stamp: 'MartinDias 12/30/2011 15:28'!
testNextIndex

	| indexes indexStream targetStream |
	indexes := #(0 1 128 255).
	targetStream := #() writeStream.

	indexStream := self 
		indexStreamOn: targetStream
		digits: 1.
	indexes do: [:x | indexStream nextIndexPut: x ].

	indexStream := self 
		indexStreamOn: targetStream contents readStream
		digits: 1.

	indexes do: [:x | self assert: indexStream nextIndex = x ].! !

!FLIndexStreamTest methodsFor: 'tests' stamp: 'MartinDias 12/30/2011 15:28'!
testNextIndexPut

	| indexStream targetStream |
	targetStream := #() writeStream.
	indexStream := self 
		indexStreamOn: targetStream
		digits: 1.
	
	indexStream nextIndexPut: 0.
	indexStream nextIndexPut: 1.! !

!FLIndexStreamTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:23'!
testCreation
	self indexStreamOn: #() writeStream digits: 2! !

!FLIteratingCluster commentStamp: '<historical>'!
I am a template class whose algorithm for serialize a collection of objects consists on delegate the serialization of each individual object to the subclass.!
!FLIteratingCluster methodsFor: 'analyzing' stamp: 'MartinDias 3/24/2014 10:59'!
addReferenceFrom: anObject to: anotherObject
	| list |
	list := self references
		at: anObject
		ifAbsentPut: [ OrderedCollection new ].

	list add: anotherObject! !

!FLIteratingCluster methodsFor: 'accessing' stamp: 'MaxLeske 5/3/2013 08:36'!
references
	^ references ifNil: [  references := FLLargeIdentityDictionary new ]! !

!FLIteratingCluster methodsFor: 'accessing' stamp: 'MartinDias 8/29/2011 00:59'!
objects

	^objects! !

!FLIteratingCluster methodsFor: 'initialize-release' stamp: 'MartinDias 1/8/2012 14:32'!
initializeAnalyzing

	super initializeAnalyzing.
	objects := self newAnalyzingCollection.! !

!FLIteratingCluster methodsFor: 'analyzing' stamp: 'MartinDias 8/29/2011 00:56'!
referencesOf: anObject do: aBlock
	"Evaluate a block with each object referenced by anObject"! !

!FLIteratingCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 9/19/2012 14:41'!
clusterSerializeStepWith: aSerialization

	super clusterSerializeStepWith: aSerialization.
	aSerialization encoder encodePositiveInteger: objects size.! !

!FLIteratingCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/30/2011 13:37'!
serializeInstance: anObject with: anEncoder
	"Hook method that each subclass should customize for its special way of serializing"! !

!FLIteratingCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/29/2011 19:48'!
materializeInstanceWith: aDecoder
	"Hook method that each subclass should customize for its special way of materializing"

	^ self subclassResponsibility! !

!FLIteratingCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 9/19/2012 14:42'!
clusterMaterializeStepWith: aMaterialization

	super clusterMaterializeStepWith: aMaterialization.
	objects := Array new: aMaterialization decoder nextEncodedPositiveInteger! !

!FLIteratingCluster methodsFor: 'analyzing' stamp: 'MaxLeske 5/4/2013 09:46'!
add: anObject traceWith: aAnalysis
	"Add an object to the cluster and trace references."

	objects addIfNotPresent: anObject ifPresentDo: [ ^ self ].

	self 
		referencesOf: anObject 
		do: [ :aChild || actual |
			actual := aChild fuelReplacement.
			self addReferenceFrom: anObject to: actual.
			aAnalysis trace: actual ]! !

!FLIteratingCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 2/17/2012 03:01'!
materializeInstancesStepWith: aDecoder

	1 to: objects size do: [ :index |
		objects 
			at: index 
			put: (self materializeInstanceWith: aDecoder) ].! !

!FLIteratingCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 8/29/2011 01:22'!
registerIndexesOn: aDictionary

	self objects do: [ :instance | aDictionary at: instance put: aDictionary size + 1 ].! !

!FLIteratingCluster methodsFor: 'printing' stamp: 'MartinDias 8/29/2011 00:52'!
printOn: aStream

	self printNameOn: aStream.
	aStream nextPutAll: '->'.
	objects printElementsOn: aStream! !

!FLIteratingCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 2/17/2012 03:03'!
serializeInstancesStepWith: anEncoder

	objects do: [ :instance | self serializeInstance: instance with: anEncoder ]! !

!FLIteratingCluster methodsFor: 'analyzing' stamp: 'MarianoMartinezPeck 4/20/2012 23:31'!
newAnalyzingCollection
	"Answer a collection for the objects that correspond to this cluster."

	^ FLLargeIdentitySet new! !

!FLIteratingCluster methodsFor: 'analyzing' stamp: 'MaxLeske 5/3/2013 10:48'!
addReferencesFrom: anObject to: aCollection
	aCollection do: [ :ref |
		self addReferenceFrom: anObject to: ref ]! !

!FLIteratingCluster methodsFor: 'printing' stamp: 'MartinDias 8/29/2011 01:16'!
printNameOn: aStream

	super printOn: aStream! !

!FLLargeIdentityDictionary commentStamp: '<historical>'!
I am an IdentityDictionary optimized for including a large number of elements.!
!FLLargeIdentityDictionary methodsFor: 'accessing' stamp: 'MartinDias 3/24/2014 11:13'!
at: key ifAbsentPut: aBlock 
	"Return the value at the given key. 
	If key is not included in the receiver store the result 
	of evaluating aBlock as new value."

	^ self at: key ifAbsent: [self at: key put: aBlock value]! !

!FLLargeIdentityDictionary methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 1/12/2012 18:00'!
at: key ifPresent: presentBlock ifAbsent: absentBlock

	| hash |
	(keys at: (hash := key largeIdentityHash + 1)) ifNotNil: [ :keyList | 
		1 to: (tallies at: hash) do: [ :index |
			(keyList at: index) == key ifTrue: [
				^ presentBlock value: ((values at: hash) at: index) ] ] ].
	^absentBlock value! !

!FLLargeIdentityDictionary methodsFor: 'accessing' stamp: 'ul 3/24/2010 21:57'!
keys

	^Array new: tally streamContents: [ :stream |
		self keysDo: [ :key | stream nextPut: key ] ]! !

!FLLargeIdentityDictionary methodsFor: 'enumerating' stamp: 'ul 3/24/2010 21:45'!
keysDo: aBlock

	tally = 0 ifTrue: [ ^self ].
	1 to: 4096 do: [ :arrayIndex |
		| keyArray |
		keyArray := keys at: arrayIndex.
		1 to: (tallies at: arrayIndex) do: [ :index |
			aBlock value: (keyArray at: index) ] ]! !

!FLLargeIdentityDictionary methodsFor: 'initialization' stamp: 'ul 12/18/2011 11:31'!
initialize

	super initialize.
	keys := Array new: 4096.
	values := Array new: 4096! !

!FLLargeIdentityDictionary methodsFor: 'removing' stamp: 'ul 12/18/2011 11:22'!
removeKey: key ifAbsent: aBlock

	| hash |
	(keys at: (hash := key largeIdentityHash + 1)) ifNotNil: [ :keyList |
		| size |
		1 to: (size := tallies at: hash) do: [ :index |
			(keyList at: index) == key ifTrue: [
				| valueList |
				keyList
					at: index put: (keyList at: size);
					at: size put: nil.
				(valueList := values at: hash)
					at: index put: (valueList at: size);
					at: size put: nil.
				(size := size - 1) < (keyList size // 4) ifTrue: [
					| newList |
					newList := Array new: size * 2.
					newList
						replaceFrom: 1
						to: size
						with: keyList
						startingAt: 1.
					keys at: hash put: newList.
					newList := Array new: size * 2.
					newList
						replaceFrom: 1
						to: size
						with: valueList
						startingAt: 1.
					values at: hash put: newList ].
				tallies at: hash put: size.
				tally := tally - 1.
				^key ] ] ].
	^aBlock value! !

!FLLargeIdentityDictionary methodsFor: 'accessing' stamp: 'ul 12/18/2011 11:21'!
at: key put: value

	| hash |
	(keys at: (hash := key largeIdentityHash + 1))
		ifNil: [ 
			keys at: hash put: (Array with: key).
			values at: hash put: (Array with: value).
			tallies at: hash put: 1.
			tally := tally + 1 ]
		ifNotNil: [ :keyList | 
			| newIndex |
			1 to: (tallies at: hash) do: [ :index |
				(keyList at: index) == key ifTrue: [
					^(values at: hash) at: index put: value ] ].
			tally := tally + 1.
			keyList size < (newIndex := (tallies at: hash) + 1)
				ifFalse: [ 
					keyList at: newIndex put: key.
					(values at: hash) at: newIndex put: value ]
				ifTrue: [
					| newList |
					(newList := Array new: keyList size * 2)
						replaceFrom: 1 
						to: keyList size
						with: keyList
						startingAt: 1;
						at: newIndex put: key.
					keys at: hash put: newList.
					(newList := Array new: keyList size * 2)
						replaceFrom: 1 
						to: keyList size
						with: (values at: hash)
						startingAt: 1;
						at: newIndex put: value.
					values at: hash put: newList ].
			tallies at: hash put: newIndex ].
	^value! !

!FLLargeIdentityDictionary methodsFor: 'accessing' stamp: 'ul 12/18/2011 11:21'!
at: key

	| hash |
	(keys at: (hash := key largeIdentityHash + 1)) ifNotNil: [ :keyList | 
		1 to: (tallies at: hash) do: [ :index |
			(keyList at: index) == key ifTrue: [
				^(values at: hash) at: index ] ] ].
	self errorKeyNotFound: key! !

!FLLargeIdentityDictionary methodsFor: 'enumerating' stamp: 'ul 3/24/2010 21:47'!
do: aBlock

	^self valuesDo: aBlock! !

!FLLargeIdentityDictionary methodsFor: 'accessing' stamp: 'ul 12/18/2011 11:22'!
at: key ifAbsent: aBlock

	| hash |
	(keys at: (hash := key largeIdentityHash + 1)) ifNotNil: [ :keyList | 
		1 to: (tallies at: hash) do: [ :index |
			(keyList at: index) == key ifTrue: [
				^(values at: hash) at: index ] ] ].
	^aBlock value! !

!FLLargeIdentityDictionary methodsFor: 'copying' stamp: 'ul 12/18/2011 11:35'!
postCopy

	super postCopy.
	keys := keys copy.
	values := values copy.
	1 to: 4096 do: [ :index |
		(keys at: index) ifNotNil: [ :list |
			keys at: index put: list copy.
			values at: index put: (values at: index) copy ] ]! !

!FLLargeIdentityDictionary methodsFor: 'private' stamp: 'MarianoMartinezPeck 12/20/2011 10:29'!
errorKeyNotFound: aKey

	KeyNotFound signalFor: aKey! !

!FLLargeIdentityDictionary methodsFor: 'enumerating' stamp: 'ul 3/24/2010 21:46'!
valuesDo: aBlock

	tally = 0 ifTrue: [ ^self ].
	1 to: 4096 do: [ :arrayIndex |
		| valueArray |
		valueArray := values at: arrayIndex.
		1 to: (tallies at: arrayIndex) do: [ :index |
			aBlock value: (valueArray at: index) ] ]! !

!FLLargeIdentityDictionary methodsFor: 'enumerating' stamp: 'ul 3/24/2010 21:35'!
keysAndValuesDo: aBlock

	tally = 0 ifTrue: [ ^self ].
	1 to: 4096 do: [ :arrayIndex |
		| keyArray valueArray |
		keyArray := keys at: arrayIndex.
		valueArray := values at: arrayIndex.
		1 to: (tallies at: arrayIndex) do: [ :index |
			aBlock
				value: (keyArray at: index)
				value: (valueArray at: index) ] ]! !

!FLLargeIdentityDictionary methodsFor: 'testing' stamp: 'MarianoMartinezPekc 1/10/2012 18:57'!
includesKey: key

	| hash |
	^(keys at: (hash := key largeIdentityHash + 1))
		ifNil: [ false ]
		ifNotNil: [ :keyList | 
			key 
				ifNotNil: [ keyList fuelPointsTo: key ]
				ifNil: [
					1 to: (tallies at: hash) do: [ :index |
						(keyList at: index) == key ifTrue: [ ^true ] ].
					false ] ]! !

!FLLargeIdentityDictionary methodsFor: 'accessing' stamp: 'ul 3/24/2010 21:57'!
values

	^Array new: tally streamContents: [ :stream |
		self valuesDo: [ :value | stream nextPut: value ] ]! !

!FLLargeIdentityHashedCollection commentStamp: '<historical>'!
I share behavior for special HashedCollections that are optimized for including a large number of elements.!
!FLLargeIdentityHashedCollection methodsFor: 'copying' stamp: 'ul 12/18/2011 11:35'!
postCopy

	tallies := tallies copy
! !

!FLLargeIdentityHashedCollection methodsFor: 'initialization' stamp: 'ul 12/18/2011 11:31'!
initialize

	tally := 0.
	tallies := Array new: 4096 withAll: 0! !

!FLLargeIdentityHashedCollection methodsFor: 'accessing' stamp: 'ul 12/18/2011 11:33'!
size

	^tally! !

!FLLargeIdentityHashedCollection class methodsFor: 'initialize-release' stamp: 'MarianoMartinezPeck 5/28/2012 01:16'!
initialize

	| rng |
	rng := Random seed: 664399324.
	PermutationMap := (0 to: 4095) asArray shuffleBy: rng! !

!FLLargeIdentityHashedCollection class methodsFor: 'comparing' stamp: 'ul 12/18/2011 11:24'!
permuteHash: anInteger
	"Return an integer between 1 and 4096 when the argument is between 1 and 4096."

	^PermutationMap at: anInteger! !

!FLLargeIdentitySet commentStamp: 'HenrikSperreJohansen 12/16/2011 12:55'!
A LargeIdentitySet is an IdentitySet for large collections.
Rather than using linear probing, it takes advantage of the fact that identityHash (on a classic, 32bit VM) 
in Pharo only has 4096 unique values, using a bucket for each of those.
It will still work if hash range changes (ie buckets are chosen mod 4096), 
but the potential gain will be lower the more diverse the hash space is.

With linear probing you risk an array looking like this:
Index:	Hash:
	1	X
	2	X
	3	X
	4	4
	5	5
	6	4
	7	4
	8	7
	9	6
	10	X

While with buckets the same dataset looks:
Index:	Hash:
	1	X
	2	X
	3	X
	4	[4, 4, 4]
	5	5
	6	6
	7	7
	8	X
	9	X
	10	X

So includes: can generally be done faster (also sped up byusing a special primitive), 
and removal of objects does not have to do extensive cleanup if object was part of a chain.!
!FLLargeIdentitySet methodsFor: 'initialization' stamp: 'ul 12/18/2011 11:31'!
initialize

	super initialize.
	array := Array new: 4096.
	includesNil := false! !

!FLLargeIdentitySet methodsFor: 'enumerating' stamp: 'ul 3/23/2010 08:35'!
do: aBlock

	tally = 0 ifTrue: [ ^self ].
	includesNil ifTrue: [ aBlock value: nil ].
	1 to: 4096 do: [ :arrayIndex |
		| subArray |
		subArray := array at: arrayIndex.
		1 to: (tallies at: arrayIndex) do: [ :index |
			aBlock value: (subArray at: index) ] ]! !

!FLLargeIdentitySet methodsFor: 'adding' stamp: 'MarianoMartinezPekc 1/10/2012 18:57'!
add: anObject

	| hash |
	anObject ifNil: [ 
		includesNil ifFalse: [
			includesNil := true.
			tally := tally + 1 ].
		^anObject ].
	(array at: (hash := anObject largeIdentityHash + 1))
		ifNil: [ 
			array at: hash put: (Array with: anObject).
			tallies at: hash put: 1.
			tally := tally + 1 ]
		ifNotNil: [ :list | 
			(list fuelPointsTo: anObject) ifFalse: [
				| newIndex |
				tally := tally + 1.
				list size < (newIndex := (tallies at: hash) + 1)
					ifFalse: [ list at: newIndex put: anObject ]
					ifTrue: [
						| newList |
						newList := Array new: list size * 2.
						newList
							replaceFrom: 1 
							to: list size
							with: list
							startingAt: 1;
							at: newIndex put: anObject.
						array at: hash put: newList ].
				tallies at: hash put: newIndex ] ].
	^anObject! !

!FLLargeIdentitySet methodsFor: 'copying' stamp: 'ul 12/18/2011 11:35'!
postCopy

	super postCopy.
	array := array copy.
	1 to: 4096 do: [ :index |
		(array at: index) ifNotNil: [ :list |
			array at: index put: list copy ] ]! !

!FLLargeIdentitySet methodsFor: 'removing' stamp: 'MarianoMartinezPekc 1/10/2012 18:57'!
remove: anObject ifAbsent: aBlock

	| list hash size |
	anObject ifNil: [
		includesNil ifTrue: [
			includesNil := false.
			tally := tally - 1.
			^anObject ].
		^aBlock value ].
	list := (array at: (hash := anObject largeIdentityHash + 1)) ifNil: [ ^aBlock value ].
	(list fuelPointsTo: anObject) ifFalse: [ ^aBlock value ].
	1 to: (size := tallies at: hash) do: [ :index |
		(list at: index) == anObject 	ifTrue: [
			list
				at: index put: (list at: size);
				at: size put: nil.
			(size := size - 1) < (list size // 4) ifTrue: [
				| newList |
				newList := Array new: size * 2.
				newList
					replaceFrom: 1
					to: size
					with: list
					startingAt: 1.
				array at: hash put: newList ].
			tallies at: hash put: size.
			tally := tally - 1.
			^anObject ] ].
	^aBlock value! !

!FLLargeIdentitySet methodsFor: 'adding' stamp: 'MarianoMartinezPekc 1/10/2012 18:57'!
addIfNotPresent: anObject ifPresentDo: aBlock

	| hash |
	anObject ifNil: [ 
		includesNil ifFalse: [
			includesNil := true.
			tally := tally + 1 ].
		^anObject ].
	(array at: (hash := anObject largeIdentityHash + 1))
		ifNil: [ 
			array at: hash put: (Array with: anObject).
			tallies at: hash put: 1.
			tally := tally + 1 ]
		ifNotNil: [ :list | 
			(list fuelPointsTo: anObject) 
			ifTrue: [ aBlock value]
			ifFalse: [
				| newIndex |
				tally := tally + 1.
				list size < (newIndex := (tallies at: hash) + 1)
					ifFalse: [ list at: newIndex put: anObject ]
					ifTrue: [
						| newList |
						newList := Array new: list size * 2.
						newList
							replaceFrom: 1 
							to: list size
							with: list
							startingAt: 1;
							at: newIndex put: anObject.
						array at: hash put: newList ].
				tallies at: hash put: newIndex ] ].
	^anObject! !

!FLLargeIdentitySet methodsFor: 'testing' stamp: 'MarianoMartinezPekc 1/10/2012 18:57'!
includes: anObject

	anObject ifNil: [ ^includesNil ].
	^(array at: (anObject largeIdentityHash + 1))
		ifNil: [ false ]
		ifNotNil: [ :list | list fuelPointsTo: anObject ]! !

!FLLightGeneralMapper commentStamp: '<historical>'!
I know how to map an object to its default cluster. I can map every object.!
!FLLightGeneralMapper methodsFor: 'visiting' stamp: 'MartinDias 1/9/2012 18:23'!
visitWordsObject: anObject

	self mapAndTraceByObjectClass: anObject to: FLWordObjectCluster! !

!FLLightGeneralMapper methodsFor: 'visiting' stamp: 'MartinDias 3/28/2012 21:19'!
visitHookPrimitive: anObject

	self mapAndTraceByObjectClass: anObject to: FLHookPrimitiveCluster
	! !

!FLLightGeneralMapper methodsFor: 'visiting' stamp: 'MartinDias 2/20/2013 20:55'!
visitGlobalSend: anObject name: globalName selector: aSymbol

	(self clusterKeyedByClusterName: FLGlobalSendCluster)
		add: anObject name: globalName selector: aSymbol traceWith: analysis
! !

!FLLightGeneralMapper methodsFor: 'protected-mapping' stamp: 'MartinDias 1/9/2012 21:08'!
clusterClassForCharacter: aCharacter

	^ aCharacter isOctetCharacter 
		ifTrue: [ FLHookPrimitiveCluster ]
		ifFalse: [ FLFixedObjectCluster ]! !

!FLLightGeneralMapper methodsFor: 'visiting' stamp: 'MartinDias 5/18/2012 17:38'!
visitNotSerializable: anObject
	FLNotSerializable signalWith: anObject! !

!FLLightGeneralMapper methodsFor: 'visiting' stamp: 'MartinDias 1/9/2012 18:23'!
visitVariableObject: anObject

	self mapAndTraceByObjectClass: anObject to: FLVariableObjectCluster! !

!FLLightGeneralMapper methodsFor: 'visiting' stamp: 'MartinDias 1/9/2012 21:08'!
visitCharacter: aCharacter

	self flag: #todo.	"confusing"
	self mapAndTraceByObjectClass: aCharacter to: (self clusterClassForCharacter: aCharacter)! !

!FLLightGeneralMapper methodsFor: 'protected-mapping' stamp: 'MarianoMartinezPeck 6/9/2012 11:58'!
clusterClassForSmallInteger: aSmallInteger

	aSmallInteger >= 0 ifTrue: [
		aSmallInteger <= 255 ifTrue: [^ FLPositive8SmallIntegerCluster].
		aSmallInteger <= 65535 ifTrue: [^ FLPositive16SmallIntegerCluster].
		aSmallInteger <= 16777215 ifTrue: [^ FLPositive24SmallIntegerCluster].
		aSmallInteger <= 4294967295 ifTrue: [^ FLPositive32SmallIntegerCluster].
	].
	aSmallInteger >= -128 ifTrue: [^ FLNegative8SmallIntegerCluster].
	aSmallInteger >= -32768 ifTrue: [^ FLNegative16SmallIntegerCluster].
	aSmallInteger >= -8388608 ifTrue: [^ FLNegative24SmallIntegerCluster].
	aSmallInteger >= -2147483648 ifTrue: [^ FLNegative32SmallIntegerCluster].

! !

!FLLightGeneralMapper methodsFor: 'visiting' stamp: 'MartinDias 1/9/2012 18:23'!
visitFixedObject: anObject

	self mapAndTraceByObjectClass: anObject to: FLFixedObjectCluster! !

!FLLightGeneralMapper methodsFor: 'visiting' stamp: 'MartinDias 1/9/2012 21:09'!
visitSmallInteger: aSmallInteger

	self mapAndTraceByClusterName: aSmallInteger to: (self clusterClassForSmallInteger: aSmallInteger)! !

!FLLightGeneralMapper methodsFor: 'visiting' stamp: 'MartinDias 1/9/2012 18:23'!
visitClassTrait: aClassTrait

	self mapAndTraceByClusterName: aClassTrait to: FLGlobalClassSideCluster! !

!FLLightGeneralMapper methodsFor: 'visiting' stamp: 'MartinDias 1/9/2012 18:23'!
visitMetaclass: aMetaclass

	self mapAndTraceByClusterName: aMetaclass to: FLGlobalClassSideCluster! !

!FLLightGeneralMapper methodsFor: 'protected-mapping' stamp: 'MaxLeske 2/20/2013 22:23'!
mapAndTraceInstanceSideGlobal: aClassOrTrait

	(self clusterKeyedByClusterName: FLGlobalClassCluster)
		add: aClassOrTrait traceWith: analysis
! !

!FLLightGeneralMapper methodsFor: 'visiting' stamp: 'MartinDias 1/9/2012 18:23'!
visitBytesObject: anObject

	self mapAndTraceByObjectClass: anObject to: FLByteObjectCluster! !

!FLLightGeneralMapper methodsFor: 'visiting' stamp: 'MartinDias 1/9/2012 18:34'!
visitPoint: aPoint

	self mapAndTraceByClusterName: aPoint to: FLPointCluster! !

!FLLightGeneralMapper methodsFor: 'visiting' stamp: 'MartinDias 1/9/2012 18:34'!
visitRectangle: aRectangle

	self mapAndTraceByClusterName: aRectangle to: FLRectangleCluster! !

!FLLightGeneralMapper methodsFor: 'visiting' stamp: 'MartinDias 5/9/2012 01:05'!
visitSubstitution: anObject by: anotherObject onRecursionDo: aBlock

	| cluster |
	cluster := self clusterKeyedByClusterName: FLSubstitutionCluster.

	(cluster isSubstitute: anObject)
		ifTrue: aBlock
		ifFalse: [
			cluster
				add: anObject
				substitutedBy: anotherObject
				traceWith: analysis ]
! !

!FLLightGeneralMapper methodsFor: 'visiting' stamp: 'MarianoMartinezPeck 7/26/2012 16:14'!
visitDictionary: aDictionary

	self mapAndTraceByObjectClass: aDictionary to: FLDictionaryCollectionCluster
! !

!FLLightGeneralMapper methodsFor: 'visiting' stamp: 'MartinDias 1/9/2012 18:29'!
visitSubstitution: anObject by: anotherObject

	(self clusterKeyedByClusterName: FLSubstitutionCluster)
		add: anObject substitutedBy: anotherObject traceWith: analysis
! !

!FLLightGeneralMapper methodsFor: 'visiting' stamp: 'MartinDias 1/8/2012 20:14'!
visitTrait: aTrait

	self mapAndTraceInstanceSideGlobal: aTrait! !

!FLLightGeneralMapper methodsFor: 'mapping' stamp: 'MartinDias 1/8/2012 12:36'!
mapAndTrace: anObject

	anObject fuelAccept: self
! !

!FLLightGeneralMapper methodsFor: 'visiting' stamp: 'MarianoMartinezPeck 7/26/2012 17:41'!
visitSimpleCollection: aCollection
	self mapAndTraceByObjectClass: aCollection to: FLSimpleCollectionCluster
! !

!FLLightGeneralMapper methodsFor: 'visiting' stamp: 'MartinDias 1/8/2012 20:14'!
visitClass: aClass

	self mapAndTraceInstanceSideGlobal: aClass! !

!FLLightGeneralMapper methodsFor: 'visiting' stamp: 'MartinDias 1/9/2012 18:23'!
visitWeakObject: anObject

	self mapAndTraceByObjectClass: anObject to: FLWeakVariableObjectCluster! !

!FLLightGeneralMapper methodsFor: 'visiting' stamp: 'MartinDias 2/18/2013 19:05'!
visitCompiledMethod: aCompiledMethod
	(aCompiledMethod isInstalled not or: [aCompiledMethod isDoIt ])
		ifTrue: [ self mapAndTraceByClusterName: aCompiledMethod to: FLCompiledMethodCluster ]
		ifFalse: [self mapAndTraceByClusterName: aCompiledMethod to: FLGlobalCompiledMethodCluster]
		
	
	! !

!FLLightGeneralMapper methodsFor: 'visiting' stamp: 'MartinDias 1/9/2012 18:23'!
visitMethodContext: aMethodContext

	self mapAndTraceByObjectClass: aMethodContext to: FLMethodContextCluster
! !

!FLLightGlobalMapper commentStamp: '<historical>'!
I map classes, traits, and global objects that belong to Smalltalk dictionary. I collaborate in serialization default behavior. 

For example, the global Transcript as well as any class in the image, are mapped by me.!
!FLLightGlobalMapper methodsFor: 'mapping' stamp: 'MartinDias 1/9/2012 18:36'!
mapAndTrace: anObject
	"Uses the Chain of Responsibility pattern to answer the cluster which maps with the received object."

	(globals includes: anObject) 
		ifTrue: [ self mapAndTraceByClusterName: anObject to: FLGlobalValueCluster ]
		ifFalse: [ next mapAndTrace: anObject ]! !

!FLLightGlobalMapper methodsFor: 'initialize-release' stamp: 'MartinDias 1/9/2012 18:11'!
initializeWith: someObjects

	self initialize.
	globals := someObjects.! !

!FLLightGlobalMapper class methodsFor: 'private' stamp: 'MartinDias 2/25/2013 11:25'!
valuesFor: globalSymbols in: globalEnvironment
	"Some globals, like ActiveHand have a nil value in the Smalltalk globals. Therefore, we cannot map nil to globalCluster. We could filter before in #defaultGlobalSymbols but that means that not even the Association will be consider global."
	| values |
	values := IdentitySet new: globalSymbols size.
	"todo: optimized ugly code"
	globalSymbols 
		do: [:aSymbol | 
			(globalEnvironment 
				at: aSymbol ifPresent: [:value | 
					value ifNotNil: [ 
						values add: value ] ]) ].
	^ values! !

!FLLightGlobalMapper class methodsFor: 'instance creation' stamp: 'MartinDias 2/22/2013 12:57'!
for: globalSymbols in: globalEnvironment

	^ self basicNew
		initializeWith: (self valuesFor: globalSymbols in: globalEnvironment);
		yourself.! !

!FLMapper commentStamp: 'MartinDias 8/11/2011 03:09'!
The purpose of my hierarchy is to map objects with clusters.!
!FLMapper methodsFor: 'protected-mapping' stamp: 'MartinDias 1/9/2012 18:27'!
clusterKeyedByObjectClass: clusterClass class: objectClass

	^ self 
		clusterInstanceOf: clusterClass 
		keyInBucket: objectClass 
		factory: [ clusterClass newAnalyzing: objectClass ]! !

!FLMapper methodsFor: 'protected-mapping' stamp: 'MartinDias 1/9/2012 18:28'!
mapAndTraceByObjectClass: anObject to: aClusterClass

	(self clusterKeyedByObjectClass: aClusterClass class: anObject class)
		add: anObject traceWith: analysis
! !

!FLMapper methodsFor: 'mapping' stamp: 'MartinDias 1/8/2012 12:38'!
mapAndTrace: anObject

	self subclassResponsibility! !

!FLMapper methodsFor: 'protected-mapping' stamp: 'MartinDias 1/9/2012 18:29'!
clusterKeyedByClusterName: aClusterClass factory: clusterFactory

	^ self
		clusterInstanceOf: aClusterClass
		keyInBucket: aClusterClass name
		factory: clusterFactory
! !

!FLMapper methodsFor: 'protected-mapping' stamp: 'MartinDias 1/9/2012 18:29'!
mapAndTraceByClusterName: anObject to: aClusterClass

	(self clusterKeyedByClusterName: aClusterClass)
		add: anObject traceWith: analysis
! !

!FLMapper methodsFor: 'hooks' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper
	^ aGeneralMapper visitSubstitution: self by: nil! !

!FLMapper methodsFor: 'accessing' stamp: 'MartinDias 8/7/2011 17:19'!
next: anObject
	next := anObject! !

!FLMapper methodsFor: 'protected-mapping' stamp: 'MartinDias 1/8/2012 20:45'!
clusterInstanceOf: aClusterClass keyInBucket: clusterKey factory: clusterFactory

	| bucket |
	bucket := aClusterClass clusterBucketIn: analysis clusterization.
	^ bucket
		at: clusterKey
		ifAbsentPut: [ 
			clusterFactory value 
				traceWith: analysis;
				yourself ].
! !

!FLMapper methodsFor: 'accessing' stamp: 'ClementBera 7/26/2013 16:39'!
analysis: anAnalysis

	analysis := anAnalysis.
	next ifNotNil: [ next analysis: anAnalysis ]! !

!FLMapper methodsFor: 'protected-mapping' stamp: 'MartinDias 1/9/2012 18:29'!
clusterKeyedByClusterName: aClusterClass

	^ self
		clusterKeyedByClusterName: aClusterClass 
		factory:  [ aClusterClass newAnalyzing ]! !

!FLMaterialization commentStamp: 'MarianoMartinezPeck 10/23/2011 14:42'!
I implement the algorithm for materializing an object graph on a stream. FLMaterializer known how to build instances of me.!
!FLMaterialization methodsFor: 'accessing' stamp: 'MartinDias 9/9/2011 01:58'!
root

	^ root ! !

!FLMaterialization methodsFor: 'private' stamp: 'MartinDias 12/29/2011 18:11'!
referencesStep

	clusters do: [ :aCluster | aCluster materializeReferencesStepWith: decoder ]! !

!FLMaterialization methodsFor: 'private' stamp: 'MartinDias 12/29/2011 18:11'!
trailerStep

	root := decoder nextEncodedReference! !

!FLMaterialization methodsFor: 'accessing' stamp: 'MartinDias 12/29/2011 18:12'!
objects
	"Answer a collection with the materialized objects."

	^ decoder objects ! !

!FLMaterialization methodsFor: 'header' stamp: 'MarianoMartinezPeck 7/28/2012 13:47'!
additionalObjectAt: aKey
	^ header additionalObjectAt: aKey! !

!FLMaterialization methodsFor: 'materializing' stamp: 'MarianoMartinezPeck 9/27/2011 16:50'!
run

	self headerStep.
	self instancesStep.
	self referencesStep.
	self trailerStep.
	self afterMaterializationStep.! !

!FLMaterialization methodsFor: 'private' stamp: 'MartinDias 12/29/2011 18:09'!
afterMaterializationStep

	clusters do: [ :aCluster | aCluster afterMaterializationStepWith: decoder ]! !

!FLMaterialization methodsFor: 'private' stamp: 'MartinDias 12/29/2011 18:25'!
registerAll: materializedObjects
	
	decoder registerAll: materializedObjects ! !

!FLMaterialization methodsFor: 'private' stamp: 'MartinDias 12/29/2011 18:27'!
headerStep

	decoder decodeYourself.
	clusterCount := decoder nextEncodedPositiveInteger.
	clusters := OrderedCollection new: clusterCount.
	clusters resetTo: 1. "Hack that avoids OrderedCollection>>makeRoomAtLast"! !

!FLMaterialization methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 7/28/2012 13:46'!
header: aHeader
	header := aHeader
	! !

!FLMaterialization methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 9/19/2012 14:36'!
decoder
	^ decoder! !

!FLMaterialization methodsFor: 'private' stamp: 'MarianoMartinezPeck 9/19/2012 14:38'!
clusterInstancesStep

	| aCluster |
	aCluster := decoder nextEncodedClusterClass newMaterializing.
	aCluster clusterMaterializeStepWith: self.
	aCluster materializeInstancesStepWith: decoder.
	self registerAll: aCluster objects.
	aCluster materializePostInstancesStepWith: decoder.
	clusters add: aCluster.! !

!FLMaterialization methodsFor: 'private' stamp: 'MartinDias 9/9/2011 01:58'!
instancesStep

	clusterCount timesRepeat: [ self clusterInstancesStep ]
! !

!FLMaterialization methodsFor: 'initialize-release' stamp: 'MartinDias 1/5/2012 14:30'!
initializeWith: aDecoder

	self initialize.
	decoder := aDecoder.
! !

!FLMaterialization class methodsFor: 'instance creation' stamp: 'MartinDias 1/5/2012 14:29'!
with: aDecoder

	^self basicNew
		initializeWith: aDecoder;
		yourself
! !

!FLMaterializationError commentStamp: '<historical>'!
I represent an error happened during materialization.!
!FLMaterializationError class methodsFor: 'exceptioninstantiator' stamp: 'MartinDias 3/20/2012 12:47'!
signal: signalerText

	^ super signal: 'Materialization error. ', signalerText
	! !

!FLMaterializer commentStamp: 'MartinDias 8/29/2011 19:06'!
I am a binary object materializer. 

See an example of use in FLSerializer's documentation.

!
!FLMaterializer methodsFor: 'protected' stamp: 'MartinDias 2/25/2013 14:46'!
decodeHeaderWith: aDecoder
	"See FLSerializer>>encodeHeaderWith:"
	
	"todo: fix"
	"Here I cannot use #materializeFrom: again because I will end up in an infinitive loop. Therefore, I use #materializationFactory."
	^(aDecoder nextEncodedByte = 0) 
		ifTrue: [ FLHeader new ]
		ifFalse: [ (self class newDefault materializationFactory value: aDecoder) root ]! !

!FLMaterializer methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 7/29/2012 23:31'!
materializationFactory
	^ materializationFactory! !

!FLMaterializer methodsFor: 'hooks' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper
	^ aGeneralMapper visitSubstitution: self by: nil! !

!FLMaterializer methodsFor: 'materializing' stamp: 'MartinDias 2/24/2013 20:13'!
materializeFrom: aStream

	| aDecoder materialization header |
	aDecoder := 
		FLDecoder 
			on: aStream 
			migrations: migrations 
			globalEnvironment: globalEnvironment.
	self verifySignatureFrom: aDecoder.
	self verifyVersionFrom: aDecoder.
	header := self decodeHeaderWith: aDecoder.
	header executePreMaterializationActions.
	materialization := materializationFactory value: aDecoder.
	"This is useful because when the user materialize something, what it is answered is the materialization objet, and not the materializer. Hence, it is difficult to query the header (like asking the additionalObjects) because materializer is lost. Therefore, we also set the header to the materialization."
	materialization header: header. 
	"This is useful because the postMaterializationActions may need to have access to the state of the materialization, for example, to the root"
	header materialization: materialization.
	header executePostMaterializationActions.
	^ materialization 
	! !

!FLMaterializer methodsFor: 'accessing' stamp: 'MartinDias 10/6/2011 22:57'!
version
	^ version! !

!FLMaterializer methodsFor: 'accessing' stamp: 'MartinDias 2/21/2013 23:47'!
globalEnvironment
	"Answer a dictionary where the look up for global symbols will be done during materialization."
	
	^ globalEnvironment! !

!FLMaterializer methodsFor: 'accessing' stamp: 'MartinDias 2/21/2013 23:47'!
globalEnvironment: aDictionary
	"Set the dictionary where the look up for global symbols will be done during materialization."
	
	globalEnvironment := aDictionary! !

!FLMaterializer methodsFor: 'protected' stamp: 'MartinDias 1/6/2012 20:34'!
setDefaultMaterialization

	materializationFactory := [:aDecoder | 
		(FLMaterialization 
			with: aDecoder)
			run; 
			yourself ]
	
	
! !

!FLMaterializer methodsFor: 'initialization' stamp: 'MartinDias 2/21/2013 23:48'!
initialize

	super initialize.
	self setDefaultMaterialization.
	self signature: self class defaultSignature.
	self version: self class currentVersion.
	migrations := Dictionary new.
	globalEnvironment := self class environment.! !

!FLMaterializer methodsFor: 'configuring-migration' stamp: 'MartinDias 1/5/2012 01:04'!
migrateClassNamed: aSymbol toClass: aClass

	self 
		migrateClassNamed: aSymbol 
		toClass: aClass 
		variables: #()! !

!FLMaterializer methodsFor: 'configuring-migration' stamp: 'MartinDias 5/18/2012 18:56'!
migrateClassNamed: aSymbol toClass: aClass variables: aDictionary 

	migrations
		at: aSymbol
		put: (FLMigration fromClassNamed: aSymbol toClass: aClass variables: aDictionary)! !

!FLMaterializer methodsFor: 'accessing' stamp: 'MartinDias 10/6/2011 22:57'!
signature
	^ signature! !

!FLMaterializer methodsFor: 'accessing' stamp: 'MartinDias 10/6/2011 22:57'!
signature: anObject
	signature := anObject! !

!FLMaterializer methodsFor: 'protected' stamp: 'MartinDias 1/7/2012 12:21'!
verifySignatureFrom: aDecoder

	| streamSignature |
	streamSignature := ByteArray new: self signature size.
	aDecoder nextEncodedBytesInto: streamSignature.
	(self signature asByteArray = streamSignature) ifFalse: [ 
		FLBadSignature 
			signalCurrentSignature: self signature 
			streamSignature: streamSignature  ].
! !

!FLMaterializer methodsFor: 'protected' stamp: 'MartinDias 1/7/2012 12:13'!
verifyVersionFrom: aDecoder

	| streamVersion |
	streamVersion := aDecoder nextEncodedUint16.
	(self version = streamVersion) ifFalse: [ 
		FLBadVersion 
			signalCurrentVersion: self version 
			streamVersion: streamVersion ]
! !

!FLMaterializer methodsFor: 'materializing' stamp: 'MartinDias 2/25/2013 14:19'!
materializeHeaderFrom: aStream

	| aDecoder |
	aDecoder := 
		FLDecoder 
			on: aStream 
			migrations: migrations 
			globalEnvironment: globalEnvironment.
	self verifySignatureFrom: aDecoder.
	self verifyVersionFrom: aDecoder.
	^ self decodeHeaderWith: aDecoder! !

!FLMaterializer methodsFor: 'configuring-migration' stamp: 'MartinDias 2/21/2013 16:38'!
migrateClassNamed: aSymbol variables: aDictionary 

	self 
		migrateClassNamed: aSymbol 
		toClass: (self class environment at: aSymbol)
		variables: aDictionary! !

!FLMaterializer methodsFor: 'accessing' stamp: 'MartinDias 10/6/2011 22:57'!
version: anObject
	version := anObject! !

!FLMaterializer class methodsFor: '*FuelSystem-FileRegistry' stamp: 'CamilloBruni 2/3/2013 17:56'!
fileReaderServicesForFile: fullName suffix: suffix
	<fileService>
	suffix = 'fuel'
		ifFalse: [ ^ #() ].
	^ { self serviceFuelMaterialize }! !

!FLMaterializer class methodsFor: 'materializing-shortcuts' stamp: 'MarianoMartinezPeck 7/28/2012 14:58'!
materializeHeaderFromFileNamed: aFilename

	^ self materializationHeaderFromFileNamed: aFilename
! !

!FLMaterializer class methodsFor: 'materializing-shortcuts' stamp: 'MarianoMartinezPeck 9/27/2011 17:15'!
materializeFromFileNamed: aFilename

	^ (self materializationFromFileNamed: aFilename) root
! !

!FLMaterializer class methodsFor: 'protected' stamp: 'MaxLeske 1/7/2015 22:38'!
currentVersion
	"If you change this method, you should also create a version in ConfigurationOfFuel and FLSerializer >> currentVersion"
	^ 194! !

!FLMaterializer class methodsFor: 'protected' stamp: 'MartinDias 10/6/2011 23:31'!
defaultSignature
	^ 'FUEL'! !

!FLMaterializer class methodsFor: 'materializing-shortcuts' stamp: 'MarianoMartinezPeck 7/28/2012 14:57'!
materializationHeaderFromFileNamed: aFilename

	^StandardFileStream 
		oldFileNamed: aFilename 
		do: [:aFileStream | 
			(self newDefault materializeHeaderFrom: aFileStream binary) ]
! !

!FLMaterializer class methodsFor: '*FuelSystem-FileRegistry' stamp: 'CamilloBruni 2/3/2013 17:37'!
serviceFuelMaterialize
	^ SimpleServiceEntry 
		provider: self 
		label: 'Materialize Fuel file'
		selector: #materializeFromFileNamed:
		description: 'Materialize objects previously serialized with Fuel'
		buttonLabel: 'materialize'! !

!FLMaterializer class methodsFor: 'materializing-shortcuts' stamp: 'MarianoMartinezPeck 9/27/2011 17:14'!
materializationFromFileNamed: aFilename

	^StandardFileStream 
		oldFileNamed: aFilename 
		do: [:aFileStream | 
			(self newDefault materializeFrom: aFileStream binary) ]
! !

!FLMaterializer class methodsFor: 'materializing-shortcuts' stamp: 'MartinDias 9/9/2011 20:25'!
materializeFromByteArray: byteArray

	^(self newDefault materializeFrom: byteArray readStream) root! !

!FLMaterializer class methodsFor: 'instance creation' stamp: 'MartinDias 9/10/2011 18:16'!
newDefault

	^self new! !

!FLMethodChanged commentStamp: '<historical>'!
I represent an error produced during materialization when is detected a change in the bytecodes of a method serialized as global. 

This error was born when testing the materialization of a BlockClosure defined in a method that changed. The test produced a VM crash.!
!FLMethodChanged class methodsFor: 'signaling' stamp: 'MartinDias 3/20/2012 17:47'!
signalWith: aGlobalName and: aSelector
	^ self signal: 'Method ', aGlobalName, '>>#', aSelector, ' changed its bytecodes.'! !

!FLMethodContextCluster commentStamp: 'MartinDias 5/30/2011 01:18'!
I am a cluster for MethodContexts.!
!FLMethodContextCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/29/2011 20:58'!
materializeInstanceWith: aDecoder

	^ theClass newFromFrameSize: aDecoder nextEncodedByte
! !

!FLMethodContextCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/29/2011 20:04'!
serializeInstance: aMethodContext with: anEncoder

	anEncoder encodeByte: aMethodContext method frameSize.
! !

!FLMethodNotFound commentStamp: 'MartinDias 12/16/2011 01:17'!
I represent an error produced during materialization when a serialized method in a class or trait name doesn't exist (at Smalltalk globals).!
!FLMethodNotFound class methodsFor: 'signaling' stamp: 'MartinDias 3/20/2012 17:48'!
signalWith: aGlobalName and: aSelector
	^ self signal: 'Method ', aGlobalName, '>>#', aSelector, ' not found.'! !

!FLMigration commentStamp: 'MartinDias 1/6/2012 16:04'!
I represent migration information about a class.

See 'configuring-migration' protocol in FLMaterializer.!
!FLMigration methodsFor: 'evaluating' stamp: 'MartinDias 1/5/2012 13:14'!
applyTo: aVariablesMapping 
	
	variables do: [:link |
		aVariablesMapping 
			map: link key 
			to: link value ]
	! !

!FLMigration methodsFor: 'accessing' stamp: 'MartinDias 1/5/2012 01:09'!
sourceClassName

	^ sourceClassName! !

!FLMigration methodsFor: 'initializing' stamp: 'MartinDias 1/5/2012 13:12'!
initializeClassNamed: aSymbol toClass: aClass variables: anArray 
	
	self initialize.
	sourceClassName := aSymbol.
	targetClass := aClass.
	variables := anArray.! !

!FLMigration methodsFor: 'accessing' stamp: 'MartinDias 1/5/2012 13:12'!
targetClass

	^ targetClass! !

!FLMigration class methodsFor: 'instance creation' stamp: 'MartinDias 1/4/2012 23:57'!
fromClassNamed: aSymbol toClass: aClass variables: anArray 

	^self basicNew
		initializeClassNamed: aSymbol 
		toClass: aClass 
		variables: anArray;
		yourself.! !

!FLMigrationTest commentStamp: 'TorstenBergmann 2/3/2014 23:26'!
SUnit tests for migrations!
!FLMigrationTest methodsFor: 'tests-automatic' stamp: 'MartinDias 1/6/2012 15:46'!
testVariableInsertion
	"Tests that serializer tolarates when there is a new instance variable on materialization"
	
	| pairClass aPair resultPair |	
	pairClass := self newClassWithInstanceVariableNames: 'left right'.
	aPair := pairClass new.
	aPair instVarAt: 1 put: $A.	
	aPair instVarAt: 2 put: $B.
	
	self serialize: aPair.
	self redefined: pairClass with: 'left middle right'.
	resultPair := self materialized.

	self assert: $A = (resultPair instVarAt: 1).
	self assert: nil = (resultPair instVarAt: 2).
	self assert: $B = (resultPair instVarAt: 3).! !

!FLMigrationTest methodsFor: 'tests-manual' stamp: 'MartinDias 1/6/2012 15:46'!
testBadDestinationVariableRename
	
	| pointClass aPoint pointClassName |
	pointClass := self newClassWithInstanceVariableNames: 'x y'.
	pointClassName := pointClass name.
	aPoint := pointClass new.
	
	self materializer 
		migrateClassNamed: pointClassName 
		variables: {('x' -> 'posX')}.
		
	self serialize: aPoint.
	self should: [ self materialized ] raise: Error. 
	
	self flag: #todo."Assert an specific materialization error"! !

!FLMigrationTest methodsFor: 'running' stamp: 'MarianoMartinezPeck 7/10/2012 16:47'!
redefined: aClass with: instanceVariableNames

	| name |
	name := aClass name.
	self removeFromSystem: aClass.
	"In this case we need to create a class with notifications"
	^ (self withNotificationsNewClassWithInstanceVariableNames: instanceVariableNames) renameSilently: name.
	! !

!FLMigrationTest methodsFor: 'tests-automatic' stamp: 'MartinDias 1/6/2012 15:46'!
testChangeInSuperclass
	"Tests that serializer tolarates when there is a change in the superclass between serialization and materialization"
	
	|  aClass aClassSubclass instance materializedInstance |	
	
	aClass := self newClassWithInstanceVariableNames: 'a b c' superclass: Object.
	aClassSubclass := self newClassWithInstanceVariableNames: 'd e' superclass: aClass.
	
	instance := aClassSubclass new.
	instance instVarNamed: 'a' put: $A.	
	instance instVarNamed: 'b' put: $B.	
	instance instVarNamed: 'c' put: $C.	
	instance instVarNamed: 'd' put: $D.	
	instance instVarNamed: 'e' put: $E.	
	
	self serialize: instance.
	aClass removeInstVarNamed: 'a'.
	aClass removeInstVarNamed: 'b'.
	aClass addInstVarNamed: 'x'.
	aClassSubclass superclass: aClass.
	
	materializedInstance := self materialized.

	self assert: $D = (materializedInstance instVarNamed: 'd').
	self assert: $E = (materializedInstance instVarNamed: 'e').
	self should: [materializedInstance instVarNamed: 'a'] raise: Error. 
	self should: [materializedInstance instVarNamed: 'b'] raise: Error. 
	self assert: $C = (materializedInstance instVarNamed: 'c').
	self assert: (materializedInstance instVarNamed: 'x') isNil.
	  
	
	! !

!FLMigrationTest methodsFor: 'tests-automatic' stamp: 'MarianoMartinezPeck 10/16/2012 09:35'!
testFormatFixedToVariable
	"Tests that serializer can tolerate a format change from a *fixed* class to *weak/variable*.
	Notice, however, that the other way around (variable to fixed) doesn't work so far"
	
	| materialized |
	self serialize: FLPair new.
	materialized := self during: [ self materialized ] rename: FLPair as: FLWeakClassMock.
	self assert: materialized size = 0! !

!FLMigrationTest methodsFor: 'tests-automatic' stamp: 'MartinDias 1/6/2012 15:46'!
testSuperclassChange
	"Tests that serializer tolarates when the superclass changed between serialization and materialization"
	
	|  aClass aClassSubclass instance materializedInstance anotherSuperclass |	
	
	aClass := self newClassWithInstanceVariableNames: 'a b c' superclass: Object.
	aClassSubclass := self newClassWithInstanceVariableNames: 'd e' superclass: aClass.
	anotherSuperclass := self newClassWithInstanceVariableNames: 'x' superclass: Object.
	
	instance := aClassSubclass new.
	instance instVarNamed: 'a' put: $A.	
	instance instVarNamed: 'b' put: $B.	
	instance instVarNamed: 'c' put: $C.	
	instance instVarNamed: 'd' put: $D.	
	instance instVarNamed: 'e' put: $E.	
	
	self serialize: instance.
	aClassSubclass superclass: anotherSuperclass.
	materializedInstance := self materialized.

	self assert: $D = (materializedInstance instVarNamed: 'd').
	self assert: $E = (materializedInstance instVarNamed: 'e').
	self should: [materializedInstance instVarNamed: 'a'] raise: Error. 
	self should: [materializedInstance instVarNamed: 'b'] raise: Error. 
	self should: [materializedInstance instVarNamed: 'c'] raise: Error. 
	self assert: (materializedInstance instVarNamed: 'x') isNil.
	  
	
	! !

!FLMigrationTest methodsFor: 'tests-automatic' stamp: 'MartinDias 1/6/2012 15:46'!
testVariableRemoved
	"Tests that serializer tolarates when an instance variable is missing on materialization"
	
	| pairClass aPair resultPair |	
	pairClass := self newClassWithInstanceVariableNames: 'left right'.
	aPair := pairClass new.
	aPair instVarAt: 1 put: $A.	
	aPair instVarAt: 2 put: $B.	

	self serialize: aPair.
	self redefined: pairClass with: 'right'.
	resultPair := self materialized.
	
	self assert: $B = (resultPair instVarAt: 1).	! !

!FLMigrationTest methodsFor: 'tests-manual' stamp: 'MartinDias 5/18/2012 22:59'!
testVariableRename
	
	| pointClass aPoint resultPoint pointClassName |
	pointClass := self newClassWithInstanceVariableNames: 'x y'.
	pointClassName := pointClass name.
	aPoint := pointClass new.
	aPoint instVarNamed: 'x' put: 7.	
	aPoint instVarNamed: 'y' put: 11.
	
	self serialize: aPoint.
	self redefined: pointClass with: 'posY posX'.	
		
	self materializer 
		migrateClassNamed: pointClassName 
		variables: {'x' -> 'posX'. 'y' -> 'posY'}.
		
	resultPoint := self materialized.

	self assert: (resultPoint instVarNamed: 'posX') = 7.
	self assert: (resultPoint instVarNamed: 'posY') = 11.! !

!FLMigrationTest methodsFor: 'tests-manual' stamp: 'MarianoMartinezPeck 4/19/2012 18:01'!
testClassRename
	
	| pointClass aPoint resultPoint pointClassName |
	pointClass := self newClassWithInstanceVariableNames: 'x y'.
	pointClassName := pointClass name.
	aPoint := pointClass new.
	aPoint instVarNamed: 'x' put: 7.	
	aPoint instVarNamed: 'y' put: 11.
	
	self serialize: aPoint.
	pointClass renameSilently: (pointClassName, 'Renamed') asSymbol.

	self materializer 
		migrateClassNamed: pointClassName 
		toClass: pointClass.
		
	resultPoint := self materialized.

	self assert: (resultPoint instVarNamed: 'x') = 7.
	self assert: (resultPoint instVarNamed: 'y') = 11.! !

!FLMigrationTest methodsFor: 'tests-automatic' stamp: 'MartinDias 1/6/2012 15:46'!
testVariableOrderChange
	"Tests that serializer tolarates when the order in the instance variables changed between serialization and materialization"
	
	| pairClass aPair resultPair |	
	pairClass := self newClassWithInstanceVariableNames: 'left right'.
	aPair := pairClass new.
	aPair instVarAt: 1 put: $A.	
	aPair instVarAt: 2 put: $B.	
	
	self serialize: aPair.
	self redefined: pairClass with: 'right left'.
	resultPair := self materialized.

	self assert: $B = (resultPair instVarAt: 1).
	self assert: $A = (resultPair instVarAt: 2).	! !

!FLMigrationTest methodsFor: 'tests-manual' stamp: 'MartinDias 5/18/2012 23:00'!
testClassAndVariableRename
	
	| pointClass aPoint resultPoint pointClassName |
	pointClass := self newClassWithInstanceVariableNames: 'x y'.
	pointClassName := pointClass name.
	aPoint := pointClass new.
	aPoint instVarNamed: 'x' put: 7.	
	aPoint instVarNamed: 'y' put: 11.
	
	self serialize: aPoint.
	pointClass renameSilently: (pointClassName, 'Renamed') asSymbol.
	pointClass := self redefined: pointClass with: 'posY posX'.	
		
	self materializer 
		migrateClassNamed: pointClassName 
		toClass: pointClass
		variables: {'x' -> 'posX'. 'y' -> 'posY'}.
		
	resultPoint := self materialized.

	self assert: (resultPoint instVarNamed: 'posX') = 7.
	self assert: (resultPoint instVarNamed: 'posY') = 11.! !

!FLMultiByteStreamStrategy commentStamp: 'MartinDias 10/12/2011 11:37'!
I am a strategy for MultiByteBinaryOrTextStream..!
!FLMultiByteStreamStrategy methodsFor: 'writing' stamp: 'MartinDias 10/12/2011 10:25'!
writeStreamDo: aValuable
	"Evaluates the argument with a write stream. Answers the result."

	inMemoryStream := MultiByteBinaryOrTextStream on: ''.
	^aValuable value: inMemoryStream binary
! !

!FLMultiByteStreamStrategy methodsFor: 'reading' stamp: 'MartinDias 10/12/2011 10:25'!
readStreamDo: aValuable
	"Evaluates the argument with a read stream. Answers the result."
	
	^aValuable value: inMemoryStream reset! !

!FLNegative16SmallIntegerCluster commentStamp: 'TorstenBergmann 2/3/2014 23:19'!
A cluster of unsigned int 16bit!
!FLNegative16SmallIntegerCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 6/8/2012 22:50'!
materializeInstanceWith: aDecoder
	
	^ aDecoder nextEncodedUint16 negated ! !

!FLNegative16SmallIntegerCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 6/8/2012 22:50'!
serializeInstance: anInteger with: anEncoder
	
	anEncoder encodeUint16: anInteger abs! !

!FLNegative24SmallIntegerCluster commentStamp: 'TorstenBergmann 2/3/2014 23:19'!
A cluster of unsigned int 24bit!
!FLNegative24SmallIntegerCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 6/9/2012 11:52'!
materializeInstanceWith: aDecoder
	
	^ aDecoder nextEncodedUint24 negated ! !

!FLNegative24SmallIntegerCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 6/9/2012 11:52'!
serializeInstance: anInteger with: anEncoder
	
	anEncoder encodeUint24: anInteger abs! !

!FLNegative32SmallIntegerCluster commentStamp: 'TorstenBergmann 2/3/2014 23:19'!
A cluster of unsigned int 32bit!
!FLNegative32SmallIntegerCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 6/8/2012 22:57'!
materializeInstanceWith: aDecoder
	
	^ aDecoder nextEncodedUint32 negated ! !

!FLNegative32SmallIntegerCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 6/8/2012 22:57'!
serializeInstance: anInteger with: anEncoder
	
	anEncoder encodeUint32: anInteger abs! !

!FLNegative8SmallIntegerCluster commentStamp: 'TorstenBergmann 2/3/2014 23:19'!
A cluster of unsigned int 8bit!
!FLNegative8SmallIntegerCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 6/8/2012 22:52'!
materializeInstanceWith: aDecoder

	^ aDecoder nextEncodedUint8 negated! !

!FLNegative8SmallIntegerCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 6/8/2012 22:53'!
serializeInstance: anInteger with: anEncoder

	anEncoder encodeUint8: anInteger abs! !

!FLNotSerializable commentStamp: '<historical>'!
I represent an error which may happen while tracing in the graph an object that is forbidden of being serialized.!
!FLNotSerializable class methodsFor: 'signaling' stamp: 'MartinDias 5/16/2012 00:39'!
signalWith: anObject

 	self signal: 'Found a forbidden object in the graph: ', anObject printString.! !

!FLNotSerializableMock commentStamp: 'TorstenBergmann 2/3/2014 23:23'!
A test mock which is not serializable!
!FLNotSerializableMock methodsFor: 'hooks' stamp: 'MartinDias 5/18/2012 17:37'!
fuelAccept: aGeneralMapper

	aGeneralMapper visitNotSerializable: self! !

!FLObjectCluster commentStamp: 'MartinDias 8/29/2011 19:20'!
I implement a generic way of serializing and materializing an object, for those that do not need more special way of doing it.!
!FLObjectCluster methodsFor: 'analyzing' stamp: 'MartinDias 5/30/2011 03:45'!
clusterReferencesDo: aBlock

	aBlock value: theClass! !

!FLObjectCluster methodsFor: 'printing' stamp: 'MarianoMartinezPeck 12/9/2011 20:26'!
theClass 
	^ theClass! !

!FLObjectCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 9/19/2012 14:41'!
clusterSerializeStepWith: aSerialization

	super clusterSerializeStepWith: aSerialization.
	aSerialization encoder encodeReferenceTo: theClass.! !

!FLObjectCluster methodsFor: 'initialize-release' stamp: 'MartinDias 1/11/2012 00:36'!
initializeAnalyzing: aClass

	self initializeAnalyzing.
	theClass := aClass! !

!FLObjectCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 9/19/2012 14:42'!
clusterMaterializeStepWith: aMaterialization

	super clusterMaterializeStepWith: aMaterialization.
	theClass := aMaterialization decoder nextEncodedReference.
! !

!FLObjectCluster methodsFor: 'printing' stamp: 'MarianoMartinezPeck 10/24/2011 10:58'!
printNameOn: aStream
	"Append to the argument, aStream, a sequence of characters that  
	identifies the receiver."
	
	super printNameOn: aStream.
	aStream nextPut: $[.
	theClass printOn: aStream.
	aStream nextPut: $].
	! !

!FLObjectCluster class methodsFor: 'instance creation' stamp: 'MartinDias 1/8/2012 14:31'!
newAnalyzing: aClass

	^ self basicNew
		initializeAnalyzing: aClass;
		yourself.! !

!FLObjectCluster class methodsFor: 'analyzing' stamp: 'MartinDias 1/8/2012 15:38'!
clusterBucketIn: aClusterization

	^aClusterization baselevelBucket ! !

!FLObjectNotFound commentStamp: '<historical>'!
I represent an error which may happen during serialization, when trying to encode on the stream a reference to an object that should be encoded before, but it is not.

This usually happens when the graph changes during serialization. 

Another possible cause is a bug in the analysis step of serialization.!
!FLObjectNotFound class methodsFor: 'signaling' stamp: 'MartinDias 3/20/2012 12:15'!
signalWith: anObject

 	self signal: (
		String streamContents: [ :stream |
			stream << 'Unexpected reference to '.
			stream print: anObject.
			stream << ' in the graph. This usually happens when the graph changes during serialization.'.
			]
	)! !

!FLObsolete commentStamp: '<historical>'!
I am an error produced during serialization, signaled when trying to serialize an obsolete class as global. It is a prevention, because such class is lekely to be absent during materialization.!
!FLObsolete class methodsFor: 'signaling' stamp: 'MartinDias 3/19/2012 00:02'!
signalWithName: classOrTraitName
	^ self signal: classOrTraitName printString, ' can not be serialized as global because it is obsolete.'! !

!FLOptimizedObjectCluster commentStamp: '<historical>'!
I have shared behavior of some optional clusters.!
!FLOptimizedObjectCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/30/2011 13:41'!
materializeReferencesOf: anObject with: aDecoder
	"Hook method"

	self subclassResponsibility! !

!FLOptimizedObjectCluster methodsFor: 'serialize/materialize' stamp: 'MaxLeske 5/3/2013 09:32'!
serializeReferencesOf: anObject with: anEncoder
	(self references at: anObject ifAbsent: [ ^ self ]) do: [ :value |
		anEncoder encodeReferenceTo: value ]! !

!FLOptimizedObjectCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 2/17/2012 03:05'!
serializeInstancesStepWith: anEncoder
	"Do nothing. I know my objects have nothing to serialize in this step."
! !

!FLOptimizedObjectCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/29/2011 19:43'!
serializeReferencesStepWith: anEncoder

	objects do: [ :anObject | self serializeReferencesOf: anObject with: anEncoder ]! !

!FLOptimizedObjectCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/29/2011 19:48'!
materializeReferencesStepWith: aDecoder

	objects do: [ :anObject | self materializeReferencesOf: anObject with: aDecoder ]! !

!FLOptimizedObjectCluster class methodsFor: 'analyzing' stamp: 'MartinDias 1/8/2012 15:39'!
clusterBucketIn: aClusterization

	^aClusterization baselevelBucket ! !

!FLPair commentStamp: 'TorstenBergmann 2/3/2014 23:23'!
A test mock for pairs!
!FLPair methodsFor: 'accessing' stamp: 'MartinDias 9/16/2010 19:58'!
right
	^ right! !

!FLPair methodsFor: 'comparing' stamp: 'MartinDias 10/15/2010 10:54'!
hash
	"Answer an integer value that is related to the identity of the receiver."

	^ self right hash bitXor: self left hash! !

!FLPair methodsFor: 'comparing' stamp: 'MartinDias 10/15/2010 10:54'!
= anObject
	"Answer whether the receiver and anObject represent the same object."

	self == anObject
		ifTrue: [ ^ true ].
	self class = anObject class
		ifFalse: [ ^ false ].
	^ self right = anObject right and: [ self left = anObject left ]! !

!FLPair methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 5/23/2011 00:14'!
method2
	self name.
	! !

!FLPair methodsFor: 'accessing' stamp: 'MartinDias 9/16/2010 19:58'!
right: anObject
	right := anObject! !

!FLPair methodsFor: 'printing' stamp: 'MartinDias 8/20/2011 22:57'!
printOn: aStream
	"Append a sequence of characters to aStream that identify the receiver."

	super printOn: aStream.
	aStream
		nextPutAll: '(';
		print: left;
		space;
		print: right;
		nextPutAll: ')'! !

!FLPair methodsFor: 'accessing' stamp: 'MartinDias 9/16/2010 19:58'!
left
	^ left! !

!FLPair methodsFor: 'accessing' stamp: 'MartinDias 9/16/2010 19:58'!
left: anObject
	left := anObject! !

!FLPair methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 7/1/2011 11:17'!
methodWithTemp
	| string |
	string := 'test'.
	self name.
	self printString.
	! !

!FLPair methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 5/23/2011 00:14'!
method1
	self name.
	self printString.
	! !

!FLPerson commentStamp: 'MarianoMartinezPeck 5/19/2011 23:51'!
FLPerson is a class just to be able to change the hash of an object and try to test problems with hash.!
!FLPerson methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 5/19/2011 22:28'!
id
	^ id! !

!FLPerson methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 5/19/2011 22:28'!
id: anObject
	id := anObject! !

!FLPerson methodsFor: 'comparing' stamp: 'MarianoMartinezPeck 5/19/2011 22:29'!
hash
	"Answer an integer value that is related to the identity of the receiver."

	^ id! !

!FLPerson methodsFor: 'comparing' stamp: 'MarianoMartinezPeck 5/19/2011 22:29'!
= anObject
	"Answer whether the receiver and anObject represent the same object."

	self == anObject
		ifTrue: [ ^ true ].
	self class = anObject class
		ifFalse: [ ^ false ].
	^ id = anObject id! !

!FLPluggableSubstitutionMapper commentStamp: 'MartinDias 8/20/2011 23:45'!
I map substituted objects. 

For example, suppose you want to substitute instances of WriteStream by nil. In such case, I will map every WriteStream instance to my substitutions cluster, and its factory block will value to nil with any argument.
!
!FLPluggableSubstitutionMapper methodsFor: 'mapping' stamp: 'MartinDias 5/9/2012 00:12'!
mapAndTrace: anObject
	"Uses the Chain of Responsibility pattern to answer the cluster which maps with the received object."

	(condition value: anObject)
		ifTrue: [ self mapAndTraceSubstitutionIfNotRecursive: anObject ]
		ifFalse: [ next mapAndTrace: anObject ]! !

!FLPluggableSubstitutionMapper methodsFor: 'mapping' stamp: 'MartinDias 5/9/2012 00:13'!
mapAndTraceSubstitutionIfNotRecursive: anObject
		
	| cluster |
	cluster := self clusterKeyedByClusterName: FLSubstitutionCluster.

	(cluster isSubstitute: anObject)
		ifTrue: [ next mapAndTrace: anObject ]
		ifFalse: [
			cluster
				add: anObject
				substitutedBy: (substitutionFactory value: anObject)
				traceWith: analysis ]
! !

!FLPluggableSubstitutionMapper methodsFor: 'initialize-release' stamp: 'MartinDias 1/9/2012 14:53'!
initializeWith: aCondition substitutionFactory: aBlock

	self initialize.
	condition := aCondition.
	substitutionFactory := aBlock.! !

!FLPluggableSubstitutionMapper class methodsFor: 'instance creation' stamp: 'MartinDias 1/9/2012 14:52'!
when: aCondition substituteBy: aFactory

	^self basicNew
		initializeWith: aCondition 
		substitutionFactory: aFactory;
		yourself! !

!FLPluggableSubstitutionTest commentStamp: 'TorstenBergmann 2/3/2014 23:31'!
SUnit tests for fuels pluggable substitutions!
!FLPluggableSubstitutionTest methodsFor: 'tests' stamp: 'MartinDias 5/8/2012 19:57'!
testSubstituteByItself

	| result |
	self analyzer when: [:x | true ] substituteBy: [:x | x ].

	result := self resultOfSerializeAndMaterialize: 1.
	
	self assert: result = 1.! !

!FLPluggableSubstitutionTest methodsFor: 'tests' stamp: 'MartinDias 10/7/2011 16:33'!
testTransientPairLeft

	| result |
	self analyzer when: [:x | FLPair = x class and: [x left isNil not]] substituteBy: [:x | x copy left: nil].

	result := self resultOfSerializeAndMaterialize: (FLPair new left: $A; yourself).
	
	self assert: result left isNil.! !

!FLPluggableSubstitutionTest methodsFor: 'tests' stamp: 'MartinDias 10/7/2011 16:33'!
testTransientPair

	| result |
	self analyzer when: [:x | FLPair = x class] substituteBy: [:x | nil].

	result := self resultOfSerializeAndMaterialize: FLPair new.
	
	self assert: result isNil.! !

!FLPluggableSubstitutionTest methodsFor: 'failures' stamp: 'MarianoMartinezPeck 11/17/2012 13:18'!
expectedFailures

	^ #(testPrivateExcludedAndWithConflicts)! !

!FLPluggableSubstitutionTest methodsFor: 'tests' stamp: 'MartinDias 5/9/2012 00:17'!
testAvoidRecursion

	| result |
	self analyzer when: [:x | x < 10 ] substituteBy: [:x | x + 1 ].

	result := self resultOfSerializeAndMaterialize: 1.
	
	self assert: result = 2.! !

!FLPluggableSubstitutionTest methodsFor: 'tests' stamp: 'MartinDias 5/8/2012 19:26'!
testUniqueSubstitution
	"Tests that an object with two occurrences in the graph is substituted to the *same* object."

	| result |
	self analyzer when: [ :x | x isNumber ] substituteBy: [ :x | x printString ].

	"This line demonstrates that behavior being tested is not trivial"
	self deny: 1 printString == 1 printString.

	result := self resultOfSerializeAndMaterialize: (Array with: 1 with: 1).
	
	self assert: result first = '1'.	
	self assert: result first == result second.! !

!FLPluggableSubstitutionTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 9/18/2012 11:03'!
testPrivateExcluded

	| result |
	self analyzer when: [:x | x isBehavior ] substituteBy: [:x | FLWeakClassMock ].

	result := self resultOfSerializeAndMaterialize: {String new. FLPair}.
	
	self assert: result first class == ByteString.
	self assert: result second == FLWeakClassMock.! !

!FLPluggableSubstitutionTest methodsFor: 'tests' stamp: 'MartinDias 5/8/2012 20:03'!
testSimple

	| result |
	self analyzer when: [:x | x < 0 ] substituteBy: [:x | 0 ].

	result := self resultOfSerializeAndMaterialize: -1.
	
	self assert: result = 0.! !

!FLPluggableSubstitutionTest methodsFor: 'tests' stamp: 'MartinDias 10/7/2011 16:33'!
testLowercaseSomeSymbols

	| result |
	self analyzer when: [:x | #A = x] substituteBy: [:x | #a].
	self analyzer when: [:x | #B = x] substituteBy: [:x | #b].

	result := self resultOfSerializeAndMaterialize: #(A B C).
	
	self assert: #(a b C) = result.! !

!FLPluggableSubstitutionTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 9/18/2012 11:03'!
testPrivateExcludedAndWithConflicts

	| result |
	self analyzer when: [:x | FLPair == x ] substituteBy: [:x | FLWeakClassMock ].

	result := self resultOfSerializeAndMaterialize: {FLPair new. FLPair}.
	
	self assert: result first class == FLPair.
	self assert: result second == FLWeakClassMock.! !

!FLPointCluster commentStamp: 'MarianoMartinezPeck 9/8/2011 22:33'!
FLPointCluster is an optional class that optimizes Point instances, since there are a lot of instances in the system, it makes sense to optimize them. We take advantage of bytecode optimizations done by Pharo for messages like #@, #x and #y. In addition, we avoid the overhead of class reshape, etc. !
!FLPointCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/29/2011 19:48'!
materializeReferencesOf: aPoint with: aDecoder

		aPoint setX: aDecoder nextEncodedReference setY: aDecoder nextEncodedReference.	
! !

!FLPointCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/29/2011 19:48'!
materializeInstanceWith: aDecoder
	"Since in Pharo #@ is associated with a special bytecode, it is faster than doing  Point basicNew"
	^ 0@0 
	! !

!FLPointCluster methodsFor: 'analyzing' stamp: 'MarianoMartinezPeck 9/8/2011 21:37'!
referencesOf: aPoint do: aBlock

	aBlock value: aPoint x.
	aBlock value: aPoint y.
	! !

!FLPointerObjectCluster commentStamp: 'MartinDias 8/1/2011 03:00'!
I have the common behavior for storing and loading pointer objects.!
!FLPointerObjectCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/29/2011 19:48'!
materializeReferencesOf: anObject with: aDecoder

	variablesMapping materializeReferencesOf: anObject with: aDecoder! !

!FLPointerObjectCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/29/2011 19:43'!
serializeReferencesOf: anObject with: anEncoder
	
	variablesMapping serializeReferencesOf: anObject with: anEncoder
! !

!FLPointerObjectCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/29/2011 19:48'!
afterMaterializationStepWith: aDecoder  

	objects do: [ :anObject | anObject fuelAfterMaterialization ]! !

!FLPointerObjectCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/29/2011 19:43'!
serializeReferencesStepWith: anEncoder

	objects do: [ :anObject | self serializeReferencesOf: anObject with: anEncoder ]! !

!FLPointerObjectCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/29/2011 19:48'!
materializeReferencesStepWith: aDecoder

	objects do: [ :anObject | self materializeReferencesOf: anObject with: aDecoder ]! !

!FLPointerObjectCluster methodsFor: 'analyzing' stamp: 'MartinDias 12/22/2011 15:07'!
referencesOf: anObject do: aBlock

	variablesMapping referencesOf: anObject do: aBlock! !

!FLPointerObjectCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 9/19/2012 14:41'!
clusterSerializeStepWith: aSerialization

	super clusterSerializeStepWith: aSerialization.
	variablesMapping serializeOn: aSerialization encoder.! !

!FLPointerObjectCluster methodsFor: 'initialize-release' stamp: 'MaxLeske 5/3/2013 17:43'!
initializeAnalyzing: aClass

	super initializeAnalyzing: aClass.
	variablesMapping := FLVariablesMapping 
		newAnalyzing: theClass
		references: self references! !

!FLPointerObjectCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 9/19/2012 14:42'!
clusterMaterializeStepWith: aMaterialization

	super clusterMaterializeStepWith: aMaterialization.
	variablesMapping := aMaterialization decoder variablesMappingFor: theClass.! !

!FLPositive16SmallIntegerCluster commentStamp: 'TorstenBergmann 2/3/2014 23:20'!
unsigned, 16-bit integer cluster!
!FLPositive16SmallIntegerCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 6/8/2012 22:51'!
materializeInstanceWith: aDecoder
	
	^ aDecoder nextEncodedUint16 ! !

!FLPositive16SmallIntegerCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 6/8/2012 22:51'!
serializeInstance: anInteger with: anEncoder
	
	anEncoder encodeUint16: anInteger! !

!FLPositive24SmallIntegerCluster commentStamp: 'TorstenBergmann 2/3/2014 23:20'!
unsigned, 24-bit integer!
!FLPositive24SmallIntegerCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 6/9/2012 11:52'!
materializeInstanceWith: aDecoder
	
	^ aDecoder nextEncodedUint24 ! !

!FLPositive24SmallIntegerCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 6/9/2012 11:52'!
serializeInstance: anInteger with: anEncoder
	
	anEncoder encodeUint24: anInteger! !

!FLPositive32SmallIntegerCluster commentStamp: 'TorstenBergmann 2/3/2014 23:20'!
unsigned, 32-bit integer!
!FLPositive32SmallIntegerCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 6/8/2012 22:57'!
materializeInstanceWith: aDecoder

	^ aDecoder nextEncodedUint32! !

!FLPositive32SmallIntegerCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 6/8/2012 22:57'!
serializeInstance: anInteger with: anEncoder

	anEncoder encodeUint32: anInteger! !

!FLPositive8SmallIntegerCluster commentStamp: 'TorstenBergmann 2/3/2014 23:20'!
unsigned, 8-bit integer!
!FLPositive8SmallIntegerCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 6/8/2012 22:52'!
materializeInstanceWith: aDecoder

	^ aDecoder nextEncodedUint8! !

!FLPositive8SmallIntegerCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 6/8/2012 22:52'!
serializeInstance: anInteger with: anEncoder

	anEncoder encodeUint8: anInteger! !

!FLPrimitiveCluster commentStamp: 'MartinDias 8/29/2011 19:21'!
I am a cluster that serializes and materializes interacting directly with the stream.!
!FLPrimitiveCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 10/13/2011 16:26'!
registerIndexesOn: aDictionary

	self flag: #todo. "Converting objects collection here in this method is a bit confusing. This is because since this cluster is for primitives, they do not have pointers to other objects. Hence, instead of storing them in a IdentitySet we can use an OrderedCollection and then just convert them at the end. For more details see FLPrimitiveCluster >> #add: anObject traceWith: aAnalysis"
	objects := objects asIdentitySet.
	super registerIndexesOn: aDictionary.! !

!FLPrimitiveCluster methodsFor: 'analyzing' stamp: 'MartinDias 1/8/2012 13:12'!
newAnalyzingCollection
	"Answer a collection for the objects that correspond to this cluster."

	^OrderedCollection new! !

!FLPrimitiveCluster methodsFor: 'analyzing' stamp: 'MartinDias 1/9/2012 17:12'!
add: anObject traceWith: anAnalysis
	"Add an object to the cluster. We know the object doesn't have references."

	objects addLast: anObject! !

!FLPrimitiveCluster class methodsFor: 'analyzing' stamp: 'MartinDias 1/8/2012 15:39'!
clusterBucketIn: aClusterization

	^aClusterization primitivesBucket ! !

!FLProcessSerializationTest methodsFor: 'tests' stamp: 'MaxLeske 5/2/2013 09:20'!
testSerializingShortDelay
	| process |
	process := [ 2 timesRepeat: [ | d |
		d := Delay forMilliseconds: 50.
		d wait ] ] forkAt: Processor userBackgroundPriority.
	
	self 
		shouldnt: [ self serialize: process ]
		raise: FLObjectNotFound! !

!FLProcessSerializationTest methodsFor: 'running' stamp: 'MaxLeske 5/4/2013 16:17'!
setUpSerializer
	^ serializer := FLDelayedSerializerMock newDefault! !

!FLProxyThatBecomesItsContent commentStamp: 'MartinDias 11/17/2011 03:18'!
Used at #testObjectByProxyThatBecomesItsContent!
!FLProxyThatBecomesItsContent methodsFor: 'serialization' stamp: 'MartinDias 11/17/2011 03:03'!
fuelAfterMaterialization 

	self become: contents! !

!FLProxyThatBecomesItsContent methodsFor: 'initialization' stamp: 'MartinDias 11/17/2011 03:04'!
initializeWith: anObject
	
	super initialize.
	contents := anObject! !

!FLProxyThatBecomesItsContent class methodsFor: 'instance creation' stamp: 'MartinDias 11/17/2011 02:59'!
newWith: aByteSymbol 
	
	^self basicNew
		initializeWith: aByteSymbol;
		yourself! !

!FLRectangleCluster commentStamp: 'MarianoMartinezPeck 9/8/2011 22:53'!
FLRectangleCluster is an optional class that optimizes Rectangle instances, since there are a lot of instances in the system, it makes sense to optimize them. We take advantage of bytecode optimizations done by Pharo for messages like #new, #@, #x and #y. In addition, we avoid the overhead of class reshape, etc. !
!FLRectangleCluster methodsFor: 'serialize/materialize' stamp: 'MaxLeske 10/3/2014 19:53'!
materializeReferencesOf: aRectangle with: aDecoder
		
		aRectangle 
			fuelSetOrigin: aDecoder nextEncodedReference @ aDecoder nextEncodedReference	
		 	corner: aDecoder nextEncodedReference @ aDecoder nextEncodedReference! !

!FLRectangleCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/29/2011 19:48'!
materializeInstanceWith: aDecoder
	"Since in Pharo #@ is associated with a special bytecode, it is faster than doing  Point basicNew"
	^ Rectangle basicNew! !

!FLRectangleCluster methodsFor: 'analyzing' stamp: 'MarianoMartinezPeck 9/8/2011 22:45'!
referencesOf: aRectangle do: aBlock

	aBlock value: aRectangle origin x.
	aBlock value: aRectangle origin y.
	aBlock value: aRectangle corner x.
	aBlock value: aRectangle corner y.! !

!FLReplacementClassMock class methodsFor: 'accessing' stamp: 'MaxLeske 5/3/2013 16:28'!
fuelReplacement
	^ nil! !

!FLReplacementMock methodsFor: 'accessing' stamp: 'MaxLeske 5/3/2013 17:34'!
dontIgnoreMe
	ignoreMe := false! !

!FLReplacementMock methodsFor: 'accessing' stamp: 'MaxLeske 5/3/2013 17:34'!
ignoreMe
	^ ignoreMe := true! !

!FLReplacementMock methodsFor: 'accessing' stamp: 'MaxLeske 5/3/2013 17:34'!
fuelReplacement
	^ ignoreMe
		ifTrue: [ nil ]
		ifFalse: [ self ]! !

!FLReplacementMock methodsFor: 'comparing' stamp: 'MaxLeske 5/3/2013 11:26'!
= anObject
	^ self class = anObject class! !

!FLSerialization commentStamp: 'MarianoMartinezPeck 10/23/2011 14:42'!
I implement the algorithm for serializing an object graph on a stream. FLSerializer known how to build instances of me.!
!FLSerialization methodsFor: 'accessing' stamp: 'MartinDias 9/9/2011 01:33'!
root
	^ root! !

!FLSerialization methodsFor: 'initialize-release' stamp: 'MaxLeske 5/3/2013 17:39'!
initializeWith: anEncoder root: anObject analyzer: anAnalyzer
			
	self initialize.
	encoder := anEncoder.
	root := anObject fuelReplacement.
	analyzer := anAnalyzer.! !

!FLSerialization methodsFor: 'private' stamp: 'MartinDias 12/29/2011 18:06'!
referencesStep

	clusters do: [ :aCluster | aCluster serializeReferencesStepWith: encoder ]! !

!FLSerialization methodsFor: 'private' stamp: 'MartinDias 12/29/2011 17:07'!
trailerStep

	encoder encodeReferenceTo: root! !

!FLSerialization methodsFor: 'private' stamp: 'MaxLeske 5/3/2013 09:27'!
analysisStep

	| anAnalysis |
	anAnalysis := analyzer analysisFor: root.
	clusters := anAnalysis clusterization clusters.
	encoder objectCount: anAnalysis clusterization objectCount
! !

!FLSerialization methodsFor: 'accessing' stamp: 'MartinDias 1/6/2012 12:24'!
objects
	"Answer a collection with the serialized objects."

	^ encoder objectsIndexes keys! !

!FLSerialization methodsFor: 'hooks' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper
	^ aGeneralMapper visitSubstitution: self by: nil! !

!FLSerialization methodsFor: 'serializing' stamp: 'MarianoMartinezPeck 7/26/2012 16:04'!
run
	"Serialize the graph starting at the root object."

	self analysisStep.
	self headerStep.
	self instancesStep.
	self referencesStep.
	self trailerStep.! !

!FLSerialization methodsFor: 'private' stamp: 'MartinDias 12/29/2011 18:28'!
headerStep
	
	encoder encodeYourself.
	encoder encodePositiveInteger: clusters size.! !

!FLSerialization methodsFor: 'accessing' stamp: 'MartinDias 9/13/2011 16:34'!
clusters
	^ clusters! !

!FLSerialization methodsFor: 'private' stamp: 'MarianoMartinezPeck 9/19/2012 14:40'!
clusterInstancesStepOf: aCluster

	encoder encodeClusterClass: aCluster class.
	aCluster clusterSerializeStepWith: self.
	aCluster serializeInstancesStepWith: encoder.
	aCluster serializePostInstancesStepWith: encoder.
! !

!FLSerialization methodsFor: 'debugging' stamp: 'MarianoMartinezPeck 9/24/2013 15:57'!
clustersSortedByAmountOfObjects
	^ self clusters sorted: [ :a :b | a objects size > b objects size ]! !

!FLSerialization methodsFor: 'accessing' stamp: 'MartinDias 12/29/2011 16:55'!
encoder
	^ encoder! !

!FLSerialization methodsFor: 'private' stamp: 'MartinDias 1/6/2012 12:24'!
instancesStep

	clusters do: [ :aCluster | aCluster registerIndexesOn: encoder objectsIndexes ].
	clusters do: [ :aCluster | self clusterInstancesStepOf: aCluster ]! !

!FLSerialization class methodsFor: 'instance creation' stamp: 'MartinDias 1/5/2012 14:34'!
with: anEncoder root: anObject analyzer: anAnalyzer
	
	^ self basicNew
		initializeWith: anEncoder
		root: anObject
		analyzer: anAnalyzer;
		yourself! !

!FLSerializationError commentStamp: '<historical>'!
I represent an error happened during serialization.!
!FLSerializationError class methodsFor: 'exceptioninstantiator' stamp: 'MartinDias 3/20/2012 12:47'!
signal: signalerText

	^ super signal: 'Serialization error. ', signalerText
	! !

!FLSerializationTest commentStamp: 'TorstenBergmann 2/3/2014 23:24'!
Superclass for serialization tests!
!FLSerializationTest methodsFor: 'running' stamp: 'MartinDias 10/8/2011 04:05'!
tearDownTraits
	self cleanUpTraits! !

!FLSerializationTest methodsFor: 'running' stamp: 'MartinDias 1/6/2012 11:07'!
materializedObjects
	
	^ self materialization objects! !

!FLSerializationTest methodsFor: 'accessing' stamp: 'MartinDias 10/7/2011 16:33'!
analyzer
	^serializer analyzer! !

!FLSerializationTest methodsFor: 'running' stamp: 'MarianoMartinezPeck 12/9/2011 20:28'!
serializationOf: anObject 
	self streamFactory writeStreamDo: [:aStream |
	^ serializer serialize: anObject on: aStream. ].
! !

!FLSerializationTest methodsFor: 'class-factory' stamp: 'MarianoMartinezPeck 4/19/2012 19:30'!
withNotificationsNewClassWithInstanceVariableNames: instanceVariableNames
	"Returns a class for testing, with the specified instance variables."

	^ classFactory withNotificationsNewClassWithInstanceVariableNames: instanceVariableNames! !

!FLSerializationTest methodsFor: 'stream-strategies' stamp: 'MartinDias 10/12/2011 11:21'!
useInMemorySerializationStream 
	"This is a special factory to test what we offer with FLSerializer class >> #serializeInMemory:  and  FLMaterializer class >> #materializeFromByteArray: "
	streamFactory := FLByteArrayStreamStrategy new! !

!FLSerializationTest methodsFor: 'accessing' stamp: 'MaxLeske 9/26/2014 18:56'!
traits	
	^ traits ifNil: [ traits := OrderedCollection new ]! !

!FLSerializationTest methodsFor: 'stream-strategies' stamp: 'MartinDias 10/12/2011 11:21'!
useMemoryStream

	streamFactory := FLMultiByteStreamStrategy new! !

!FLSerializationTest methodsFor: 'running' stamp: 'MartinDias 10/6/2011 23:52'!
setUpMaterializer
	materializer := FLMaterializer newDefault! !

!FLSerializationTest methodsFor: 'traits-factory' stamp: 'MarianoMartinezPeck 8/13/2012 22:20'!
newTraitNamed: traitName inCategory: aCategory

	^ Trait 
		named: traitName asSymbol
		uses: Array new 
		category: aCategory asSymbol! !

!FLSerializationTest methodsFor: 'running' stamp: 'MartinDias 10/12/2011 10:56'!
resultOfSerializeAndMaterialize: anObject

	self serialize: anObject.
	^ self materialized
! !

!FLSerializationTest methodsFor: 'running' stamp: 'MarianoMartinezPeck 7/28/2012 15:03'!
materializationHeader
	
	self streamFactory readStreamDo: [:aStream |
		^ self materializer materializeHeaderFrom: aStream ]! !

!FLSerializationTest methodsFor: 'running' stamp: 'MarianoMartinezPeck 5/11/2012 10:46'!
resultOfSerializeAndMaterializeMethod: aCompiledMethod
	self analyzer considerInternalMethod: aCompiledMethod. 
	self serialize: aCompiledMethod.
	^ self materialized
! !

!FLSerializationTest methodsFor: 'class-factory' stamp: 'MarianoMartinezPeck 4/19/2012 19:18'!
withNotificationsNewClass
	^ self classFactory withNotificationsNewClass! !

!FLSerializationTest methodsFor: 'running' stamp: 'MarianoMartinezPeck 4/20/2012 21:38'!
resultOfSerializeAndMaterializeCompiledMethod: aCompiledMethod
	| materialized |
	materialized := self resultOfSerializeAndMaterialize: aCompiledMethod.
	self assert: (materialized isEqualRegardlessTrailerTo: aCompiledMethod)! !

!FLSerializationTest methodsFor: 'class-factory' stamp: 'MarianoMartinezPeck 4/19/2012 19:19'!
newSubclassOf: aClass  instanceVariableNames: ivNamesString classVariableNames: classVarsString
	^ self classFactory silentlyNewSubclassOf: aClass instanceVariableNames: ivNamesString classVariableNames:  classVarsString! !

!FLSerializationTest methodsFor: 'cleaning' stamp: 'S 6/17/2013 13:16'!
deleteFileNamed: aFilename
	 aFilename asFileReference ensureDelete! !

!FLSerializationTest methodsFor: 'running' stamp: 'MarianoMartinezPeck 4/20/2012 21:35'!
resultOfSerializeAndMaterializeMethodDictionary: aMethodDictionary
	| materialized |
	materialized := self resultOfSerializeAndMaterialize: aMethodDictionary.
	self assert: (materialized isEqualRegardlessMethodsTrailerTo: aMethodDictionary)! !

!FLSerializationTest methodsFor: 'running' stamp: 'MartinDias 12/30/2011 19:03'!
tearDownGlobalVariables

	Smalltalk globals removeKey: #FLGlobalVariableForTesting ifAbsent: []! !

!FLSerializationTest methodsFor: 'accessing' stamp: 'MartinDias 10/7/2011 16:31'!
classFactory
	^classFactory! !

!FLSerializationTest methodsFor: 'traits-factory' stamp: 'MartinDias 10/8/2011 04:03'!
traitNamePrefix
	^'FLTraitForTesting'! !

!FLSerializationTest methodsFor: 'running' stamp: 'MartinDias 1/6/2012 11:07'!
materialization
	
	self streamFactory readStreamDo: [:aStream |
		^ self materializer materializeFrom: aStream ]! !

!FLSerializationTest methodsFor: 'running' stamp: 'MartinDias 1/6/2012 11:13'!
serializationOf: anObject includes: anotherObject 
	| serialization |
	self streamFactory writeStreamDo: [:aStream |
	serialization := serializer serialize: anObject on: aStream.
	^ serialization objects includes: anotherObject ].! !

!FLSerializationTest methodsFor: 'class-factory' stamp: 'MaxLeske 10/3/2014 21:18'!
newSubclassNamed: nameString of: aClass  instanceVariableNames: ivNamesString classVariableNames: classVarsString
	| class |
	SystemAnnouncer uniqueInstance suspendAllWhile: [
		class := aClass
			subclass: nameString asSymbol
			instanceVariableNames: ivNamesString
			classVariableNames:  classVarsString
			category: self classFactory defaultCategory
	].
	self classFactory createdClasses add: class.
	^ class! !

!FLSerializationTest methodsFor: 'running' stamp: 'MaxLeske 2/27/2013 21:49'!
tearDown
	super tearDown.
	"Traits should be cleaned before classFactory because it seems class factory only knwos how to clean classes, not traits."
	self tearDownTraits.
	self tearDownClassFactory.
	self tearDownGlobalVariables.
	self tearDownInstanceVariables! !

!FLSerializationTest methodsFor: 'running' stamp: 'MaxLeske 2/27/2013 21:49'!
tearDownInstanceVariables
	self class withAllSuperclasses do: [ :class |
		class = TestCase ifTrue: [ ^ self ].
		
		class instVarNames do: [ :varName |
			self 
				instVarNamed: varName
				put: nil ] ]! !

!FLSerializationTest methodsFor: 'class-factory' stamp: 'MarianoMartinezPeck 4/19/2012 19:28'!
newClassInCategory: aCategory
	^ self classFactory silentlyNewClassInCategory: aCategory! !

!FLSerializationTest methodsFor: 'running' stamp: 'MartinDias 10/6/2011 23:52'!
setUpSerializer
	serializer := FLSerializer newDefault! !

!FLSerializationTest methodsFor: 'traits-factory' stamp: 'MaxLeske 9/26/2014 18:54'!
newTraitSuffixed: suffix

	| trait |
	trait := Trait 
		named: (self traitNamePrefix, suffix) asSymbol
		uses: Array new 
		category: (self classFactory packageName, '-', self classFactory defaultCategoryPostfix) asSymbol.
	self traits add: trait.
	
	^ trait! !

!FLSerializationTest methodsFor: 'accessing' stamp: 'MartinDias 10/12/2011 10:57'!
streamFactory
	^streamFactory! !

!FLSerializationTest methodsFor: 'running' stamp: 'MartinDias 10/7/2011 16:29'!
setUpClassFactory
	classFactory := ClassFactoryForTestCase new
! !

!FLSerializationTest methodsFor: 'class-factory' stamp: 'MarianoMartinezPeck 4/19/2012 19:14'!
newClass
	^ self newSubclassOf: Object 
		instanceVariableNames: '' 
		classVariableNames: ''
! !

!FLSerializationTest methodsFor: 'stream-strategies' stamp: 'MartinDias 12/7/2011 02:11'!
useMultiByteFileStream

	streamFactory := FLFileStreamStrategy newWithMultiByteFileStream! !

!FLSerializationTest methodsFor: 'running' stamp: 'MartinDias 4/12/2012 17:21'!
setUp
	super setUp.
	self setUpClassFactory.
	self setUpSerializer.
	self setUpMaterializer.
	"You have several stream strategies available on 'stream-strategies' category."
	self useMemoryStream.
! !

!FLSerializationTest methodsFor: 'cleaning' stamp: 'MarianoMartinezPeck 4/19/2012 19:39'!
removeFromSystem: aClassOrTrait
	aClassOrTrait removeFromSystem: false! !

!FLSerializationTest methodsFor: 'running' stamp: 'MartinDias 10/12/2011 10:58'!
serialize: anObject

	self streamFactory writeStreamDo: [:aStream |
		self serializer serialize: anObject on: aStream ]! !

!FLSerializationTest methodsFor: 'traits-factory' stamp: 'MaxLeske 9/26/2014 18:55'!
cleanUpTraits
	self traits do: [ :aTrait | self removeFromSystem: aTrait ]! !

!FLSerializationTest methodsFor: 'accessing' stamp: 'MartinDias 10/6/2011 23:44'!
materializer
	^materializer! !

!FLSerializationTest methodsFor: 'running' stamp: 'MartinDias 3/22/2012 10:39'!
assertSerializationEqualityOf: anObject
	"Asserts that the original object and the materialized one are equal (but not the same)"

	| materialized |
	materialized := self resultOfSerializeAndMaterialize: anObject.
	self assert: anObject ~~ materialized description: 'The materialized object should not be the same as the serialized one'.
	self assert: anObject = materialized description: 'The materialized object should be equal to serialized one'.! !

!FLSerializationTest methodsFor: 'stream-strategies' stamp: 'MartinDias 10/12/2011 18:42'!
useGzipInMemoryStream

	streamFactory := FLGZipStrategy newWithTarget: FLByteArrayStreamStrategy new! !

!FLSerializationTest methodsFor: 'accessing' stamp: 'MartinDias 10/6/2011 23:44'!
serializer
	^serializer! !

!FLSerializationTest methodsFor: 'stream-strategies' stamp: 'MartinDias 12/7/2011 02:11'!
useStandardFileStream

	streamFactory := FLFileStreamStrategy newWithStandardFileStream! !

!FLSerializationTest methodsFor: 'running' stamp: 'MartinDias 10/8/2011 01:26'!
tearDownClassFactory
	self classFactory cleanUp! !

!FLSerializationTest methodsFor: 'running' stamp: 'MartinDias 11/29/2011 20:44'!
assertSerializationIdentityOf: anObject
	"Asserts that the original object and the materialized one are the same"

	| result |
	result := self resultOfSerializeAndMaterialize: anObject.
	self 
		assert: anObject == result 
		description: 'The materialized object is not the same as the serialized one'.! !

!FLSerializationTest methodsFor: 'running' stamp: 'MartinDias 1/6/2012 11:07'!
materialized
	
	^ self materialization root! !

!FLSerializationTest class methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 10/31/2011 11:58'!
packageNamesUnderTest
	^ #('Fuel')! !

!FLSerializer commentStamp: 'MartinDias 8/29/2011 19:10'!
I am a binary object serializer.

An example of use:

| sourceArray loadedArray |
sourceArray := 
	Array 
		with: 'a string' 
		with: Transcript
		with: [ Transcript show: 'a string' ].

"Store to the file"
FLSerializer serialize: sourceArray toFileNamed: 'example.FL'. 

"Load from the file"
loadedArray := FLMaterializer materializeFromFileNamed: 'example.FL'. 

"The arrays are not the same"
[ sourceArray ~~ loadedArray ] assert.

"The strings are not the same"
[ sourceArray first ~~ loadedArray first ] assert.
[ sourceArray first = loadedArray first ] assert.

"The global instance Transcript is the same"
[ sourceArray second == loadedArray second ] assert.

"Appreciate in Transcript that the loaded block prints a string"
loadedArray third value.
!
!FLSerializer methodsFor: 'protected' stamp: 'MartinDias 1/6/2012 20:31'!
serializationFactory

	^ serializationFactory ifNil: [ 
		self setDefaultSerialization.
		serializationFactory ].! !

!FLSerializer methodsFor: 'accessing' stamp: 'ClementBera 7/26/2013 16:40'!
analyzer
	^ analyzer ifNil: [ analyzer := self defaultAnalyzer ]! !

!FLSerializer methodsFor: 'protected' stamp: 'MartinDias 2/25/2013 14:46'!
encodeHeaderWith: anEncoder

	"todo: fix how header is encoded"
	anEncoder encodeByte: (header isEmpty ifTrue: [0] ifFalse: [1]).

	header isEmpty ifFalse: [
		self class newDefault serializationFactory value: header value: anEncoder ]! !

!FLSerializer methodsFor: 'protected' stamp: 'MartinDias 1/6/2012 20:31'!
setDefaultSerialization

	^ serializationFactory := [:anObject :anEncoder | 
		(FLSerialization 
			with: anEncoder
			root: anObject 
			analyzer: self analyzer)
			run;
			yourself ]! !

!FLSerializer methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 5/30/2012 21:50'!
stream: aStream
	stream := aStream! !

!FLSerializer methodsFor: 'hooks' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper
	^ aGeneralMapper visitSubstitution: self by: nil! !

!FLSerializer methodsFor: 'accessing' stamp: 'MartinDias 10/6/2011 22:56'!
version
	^ version! !

!FLSerializer methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 8/21/2012 16:49'!
header
	^ header! !

!FLSerializer methodsFor: 'accessing' stamp: 'MartinDias 8/20/2011 17:33'!
analyzer: anObject
	analyzer := anObject! !

!FLSerializer methodsFor: 'initialization' stamp: 'MarianoMartinezPeck 7/28/2012 11:37'!
initialize

	super initialize.
	self signature: self class defaultSignature.
	self version: self class currentVersion.
	header := FLHeader new.! !

!FLSerializer methodsFor: 'serializing' stamp: 'MarianoMartinezPeck 8/19/2012 23:57'!
serialize: anObject toFileNamed: aFilename
	"Serialize the graph starting at the root object received and answers the FLSerialization object"
	StandardFileStream 
		forceNewFileNamed: aFilename 
		do: [ :aFileStream |
			aFileStream binary. 
			self serialize: anObject on: aFileStream ]
	! !

!FLSerializer methodsFor: 'header' stamp: 'MarianoMartinezPeck 7/28/2012 12:32'!
addPostMaterializationAction: aCleanBlockClosure
	header addPostMaterializationAction: aCleanBlockClosure! !

!FLSerializer methodsFor: 'accessing' stamp: 'MartinDias 10/6/2011 22:56'!
signature
	^ signature! !

!FLSerializer methodsFor: 'accessing' stamp: 'MartinDias 10/6/2011 22:56'!
signature: anObject
	signature := anObject! !

!FLSerializer methodsFor: 'serializing' stamp: 'MarianoMartinezPeck 5/30/2012 21:49'!
serialize: anObject
	"Serialize the graph starting at the root object received and answers the FLSerialization object"

	^ self serialize: anObject on: stream! !

!FLSerializer methodsFor: 'protected' stamp: 'MartinDias 9/13/2011 19:26'!
defaultAnalyzer

	^FLAnalyzer newDefault! !

!FLSerializer methodsFor: 'protected' stamp: 'MartinDias 1/7/2012 12:07'!
encodeVersionWith: anEncoder
	anEncoder encodeUint16: self version
! !

!FLSerializer methodsFor: 'protected' stamp: 'MartinDias 1/7/2012 12:07'!
encodeSignatureWith: anEncoder
	anEncoder encodeBytes: self signature asByteArray! !

!FLSerializer methodsFor: 'header' stamp: 'MarianoMartinezPeck 7/28/2012 11:38'!
at: key putAdditionalObject: anObject 
	"This is useful if we want to attach objects to a package that will also be serialized. The way they are stored is key-value."
	header at: key putAdditionalObject: anObject ! !

!FLSerializer methodsFor: 'serializing' stamp: 'MartinDias 2/24/2013 20:17'!
serialize: anObject on: aStream
	"Serialize the graph starting at the root object received and answers the FLSerialization object"

	FLEncoder
		on: aStream 
		globalEnvironment: self analyzer globalEnvironment
		do: [ :anEncoder | 
			self encodeSignatureWith: anEncoder.
			self encodeVersionWith: anEncoder.
			self encodeHeaderWith: anEncoder.
			^ self serializationFactory value: anObject value: anEncoder ]! !

!FLSerializer methodsFor: 'accessing' stamp: 'MartinDias 10/6/2011 22:56'!
version: anObject
	version := anObject! !

!FLSerializer methodsFor: 'header' stamp: 'MarianoMartinezPeck 7/28/2012 11:38'!
addPreMaterializationAction: aCleanBlockClosure
	header addPreMaterializationAction: aCleanBlockClosure! !

!FLSerializer class methodsFor: 'instance creation' stamp: 'MartinDias 9/25/2011 20:12'!
newLight

	^self new! !

!FLSerializer class methodsFor: 'serializing-shortcuts' stamp: 'mada 5/10/2012 20:56'!
serialize: anObject toFileNamed: aFilename

	self newDefault serialize: anObject toFileNamed: aFilename! !

!FLSerializer class methodsFor: 'protected' stamp: 'MaxLeske 1/7/2015 22:38'!
currentVersion
	"If you change this method, you should also create a version in ConfigurationOfFuel and FLMaterializer >> currentVersion"
	^ 194! !

!FLSerializer class methodsFor: 'protected' stamp: 'MartinDias 10/6/2011 23:28'!
defaultSignature
	^ 'FUEL'! !

!FLSerializer class methodsFor: 'instance creation' stamp: 'MarianoMartinezPeck 5/30/2012 21:48'!
on: aStream
	^ self newLight 
		stream: aStream;
		yourself! !

!FLSerializer class methodsFor: 'serializing-shortcuts' stamp: 'MarianoMartinezPeck 5/11/2012 16:23'!
serialize: anObject on: aStream

	self newDefault serialize: anObject on: aStream! !

!FLSerializer class methodsFor: 'instance creation' stamp: 'MartinDias 9/25/2011 20:12'!
newDefault

	^self newLight! !

!FLSerializer class methodsFor: 'serializing-shortcuts' stamp: 'MartinDias 1/11/2012 00:45'!
serializeToByteArray: anObject
	"No stream is needed by the user. An internal in-memory stream will be used. This method returns a ByteArray representing the serialization"

	| aStream |
	aStream := WriteStream on: (ByteArray new: 100).
	self newDefault serialize: anObject on: aStream.
	^ aStream contents! !

!FLSignatureTest commentStamp: 'TorstenBergmann 2/3/2014 23:31'!
SUnit tests for fuel serializations, here signatures!
!FLSignatureTest methodsFor: 'tests' stamp: 'MartinDias 10/7/2011 12:22'!
testSameSignature

	serializer signature: 'FUELx'.
	materializer signature: 'FUELx'.
	self assertSerializationEqualityOf: 'content'! !

!FLSignatureTest methodsFor: 'tests' stamp: 'MartinDias 3/20/2012 12:59'!
testBadSignature

	serializer signature: 'FUELx'.
	materializer signature: 'FUELy'.
	self
		should: [ self resultOfSerializeAndMaterialize: 'content' ]
		raise: FLBadSignature
		whoseDescriptionIncludes: 'FUELy'
		description: 'The materializer should raise an error when signature differs of the expected one.'! !

!FLSimpleCollectionCluster commentStamp: '<historical>'!
A FLSimpleCollectionCluster is a special optional cluster that rather than using the default (variable object) serialization, uses #do: to iterate objects and #add: during materialization. So far we use it for Set, IdentitySet and OrderedCollection.!
!FLSimpleCollectionCluster methodsFor: 'serialize/materialize' stamp: 'MarianoMartinezPeck 7/26/2012 16:10'!
materializeReferencesOf: anObject with: aDecoder
	aDecoder nextEncodedPositiveInteger "anObject size"
		 timesRepeat: 
			[ anObject add: aDecoder nextEncodedReference ]! !

!FLSimpleCollectionCluster methodsFor: 'serialize/materialize' stamp: 'MaxLeske 5/3/2013 09:49'!
serializeReferencesOf: anObject with: anEncoder
	| refs |
	refs := self references at: anObject ifAbsent: [ ^ self ].
	anEncoder encodePositiveInteger: refs first.
	refs allButFirst do: [ :each |
		anEncoder encodeReferenceTo: each ]
	! !

!FLSimpleCollectionCluster methodsFor: 'analyzing' stamp: 'MarianoMartinezPeck 7/28/2012 22:27'!
referencesOf: anObject do: aBlock
	aBlock value: anObject size.
	anObject
		do: [ :each | aBlock value: each ]
! !

!FLSimpleStack commentStamp: 'MarianoMartinezPeck 6/5/2011 12:29'!
FLSimpleStack is a simple stack used in Fuel to avoid a recursion while traversing the graph to serialize. While analizing the content of an object (inst vars) we can encounter simple objects (direct string representation) or complex objects (composite). In the latter case we start analizing those instVars.

So... Imagine object X with two instVars Y and Z. Imagine the method of the traverse is called #analye:.  So you do #analize: X.  Then, in such method you check whether X has regular pointers to regular objects, and if true, you analize them. So in this case you would send #analyze: Y and #analize: Z, generating the recursion. Right ?  Notice that the time between analyse: Y and analyse: Z is dependent on the graph that is attached to Y. Y can have objects that have further objects etc. So leaving X aside, Y can be the first object to serialize and Z the last.

With this FLSimpleStack, instead of sending #analyze: Y and #analize: Z  what Fuel does is just to do a push on a stack:   #push: Y  and #push: Z. And then we are done with X, so we pop from the stack and we continue with the next object (at some point in the future we will pop Y and Z) When there are no more objects in the stack it means we are done. !
!FLSimpleStack methodsFor: 'adding' stamp: 'MartinDias 5/15/2011 23:15'!
grow
	"Become larger in capacity."
	| newArray |
	newArray := Array new: array size * 2.
	newArray replaceFrom: 1 to: array size with: array startingAt: 1.
	array := newArray! !

!FLSimpleStack methodsFor: 'removing' stamp: 'MartinDias 5/15/2011 22:52'!
pop
	"Returns the first element and remove it from the stack."

	slotIndex := slotIndex - 1.	
	^ array at: slotIndex ! !

!FLSimpleStack methodsFor: 'accessing' stamp: 'MartinDias 5/15/2011 23:08'!
capacity

	^ array size! !

!FLSimpleStack methodsFor: 'accessing' stamp: 'MartinDias 5/15/2011 22:54'!
isEmpty

	^ 1 = slotIndex! !

!FLSimpleStack methodsFor: 'printing' stamp: 'MartinDias 6/3/2011 20:25'!
printOn: aStream 
	"Append a sequence of characters that identify the receiver to aStream."

	super printOn: aStream.
	array printElementsOn: aStream
! !

!FLSimpleStack methodsFor: 'adding' stamp: 'MartinDias 5/15/2011 22:44'!
push: anObject 
	"Adds a new object of any kind on top of the stack."

	array at: slotIndex put: anObject.
	array size = slotIndex ifTrue: [ self grow ].
	slotIndex := slotIndex + 1.
	^ anObject.! !

!FLSimpleStack methodsFor: 'initialize-release' stamp: 'MartinDias 5/15/2011 23:10'!
initialize: hintSize

	array := Array new: hintSize.
	slotIndex := 1.! !

!FLSimpleStack class methodsFor: 'instance creation' stamp: 'MartinDias 5/15/2011 23:09'!
new: nElements
	"Create a Set large enough to hold nElements without growing"
	^ self basicNew initialize: nElements! !

!FLSimpleStack class methodsFor: 'instance creation' stamp: 'MartinDias 5/15/2011 23:11'!
hintSize

	^64! !

!FLSimpleStack class methodsFor: 'instance creation' stamp: 'MartinDias 5/15/2011 23:11'!
new
	
	^ self new: self hintSize! !

!FLSimpleStackTest methodsFor: 'testing' stamp: 'MartinDias 10/5/2011 19:23'!
testCapacity

	| stack |
	stack := FLSimpleStack new: 3.
	self assert: 3 = stack capacity.
	
	stack := FLSimpleStack new: 5.
	self assert: 5 = stack capacity.! !

!FLSimpleStackTest methodsFor: 'tests-adding' stamp: 'MartinDias 5/15/2011 23:13'!
testGrow

	| stack |
	stack := FLSimpleStack new: 1.
	self assert: 1 = stack capacity.
	stack push: #a.
	self assert: 1 < stack capacity.! !

!FLSimpleStackTest methodsFor: 'testing' stamp: 'MartinDias 5/15/2011 22:50'!
testPop

	| stack |
	stack := FLSimpleStack new.
	stack push: 1.
	stack pop.
	self assert: stack isEmpty.! !

!FLSimpleStackTest methodsFor: 'testing' stamp: 'MartinDias 5/15/2011 22:50'!
testIsEmpty

	| stack |
	stack := FLSimpleStack new.
	self assert: stack isEmpty.! !

!FLSimpleStackTest methodsFor: 'testing' stamp: 'MartinDias 5/15/2011 22:50'!
testPush

	| stack |
	stack := FLSimpleStack new.
	stack push: 1.
	self deny: stack isEmpty.! !

!FLSingletonMock commentStamp: 'TorstenBergmann 2/3/2014 23:28'!
A mock for a singleton!
!FLSingletonMock methodsFor: 'accessing' stamp: 'MML 10/19/2012 17:26'!
reference
	^ reference! !

!FLSingletonMock methodsFor: 'accessing' stamp: 'MML 10/19/2012 17:26'!
reference: anObject
	^ reference := anObject! !

!FLSingletonMock class methodsFor: 'instance creation' stamp: 'MML 10/19/2012 17:26'!
new
	self error: 'I''m a singleton!!'! !

!FLSingletonMock class methodsFor: 'accessing' stamp: 'MaxLeske 2/26/2013 22:37'!
reset
	Instance := nil! !

!FLSingletonMock class methodsFor: 'accessing' stamp: 'MaxLeske 2/26/2013 22:37'!
instance
	^ Instance ifNil: [ Instance := self basicNew ]! !

!FLSingletonMockEnforced commentStamp: 'TorstenBergmann 2/3/2014 23:29'!
A test mock where a new instance is enforced!
!FLSingletonMockEnforced class methodsFor: 'fuel' stamp: 'MaxLeske 2/20/2013 23:13'!
fuelNew
	^ self instance! !

!FLSingletonTest commentStamp: 'TorstenBergmann 2/3/2014 23:31'!
SUnit tests for fuel serialization of singletons!
!FLSingletonTest methodsFor: 'tests' stamp: 'MML 10/19/2012 17:43'!
testSingletonMaterializationEnforced
	| singleton materialized |
	singleton := FLSingletonMockEnforced instance.
	singleton reference: 'a reference'.
	self assert: singleton equals: FLSingletonMockEnforced instance.
	
	materialized := self resultOfSerializeAndMaterialize: singleton.
	self assert: materialized == singleton.
	self deny: materialized reference isNil.
	self assert: materialized reference == singleton reference.
	
	FLSingletonMock reset "cannot do this in tearDown because that's used by some helper methods"! !

!FLSingletonTest methodsFor: 'tests' stamp: 'MML 10/19/2012 17:31'!
testSingletonMaterializationEnforcedNoInstance
	| singleton materialized |
	singleton := FLSingletonMockEnforced instance.
	singleton reference: 'a reference'.
	self assert: singleton equals: FLSingletonMockEnforced instance.
	
	self serialize: singleton.
	FLSingletonMock reset.
	
	materialized := self materialized.
	self deny: materialized == singleton.
	self deny: materialized reference isNil.
	self assert: materialized reference equals: singleton reference.
	
	FLSingletonMock reset "cannot do this in tearDown because that's used by some helper methods"! !

!FLSingletonTest methodsFor: 'running' stamp: 'MML 10/19/2012 17:28'!
setUp
	super setUp.
	FLSingletonMock reset! !

!FLSingletonTest methodsFor: 'tests' stamp: 'MML 10/19/2012 17:31'!
testSingletonMaterialization
	| singleton materialized |
	singleton := FLSingletonMock instance.
	singleton reference: 'a reference'.
	self assert: singleton equals: FLSingletonMock instance.
	
	materialized := self resultOfSerializeAndMaterialize: singleton.
	self deny: materialized == singleton.
	self deny: materialized reference isNil.
	self deny: materialized reference == singleton reference.
	
	FLSingletonMock reset "cannot do this in tearDown because that's used by some helper methods"! !

!FLSmallIntegerCluster commentStamp: 'MartinDias 1/7/2012 11:57'!
I don't have so much sense as a class.!
!FLSortedCollectionSerializationTest commentStamp: 'TorstenBergmann 2/3/2014 23:30'!
SUnit tests for fuel serialization of sorted collections!
!FLSortedCollectionSerializationTest methodsFor: 'tests' stamp: 'MartinDias 3/26/2012 22:28'!
testSortedCollectionWithInstanceVariableReferenceChange
	"IMPORTANT: this test is to demonstrate a limitation.  Unfortunatly there is nothing we can do to solve this problem. The sortBlock was serialized with a method context with different receiver, different temps, etc.
	Tests serialization of a SortedCollection whose sortBlock has a reference to the outer context. 
	Note: Equality can not be used to assert, since its behavior is this:
	| x y |
	x := SortedCollection sortBlock: [:a :b | a >= b ].
	y := SortedCollection sortBlock: [:a :b | a >= b ].
	self assert: x ~= y"

	| aSortedCollection materialized |
	instanceVariableForTesting := false.
	aSortedCollection := self sortedBlockClosureWithInstanceVariable.

	materialized := self resultOfSerializeAndMaterialize: aSortedCollection.

	instanceVariableForTesting := true.
	materialized addAll: #(2 3 1).
	aSortedCollection addAll: #(2 3 1).

	"IMPORTANT: Unfortunatly there is nothing we can do to solve this problem. The sortBlock was serialized with a method context with different values."
	self deny: aSortedCollection asArray = materialized asArray.! !

!FLSortedCollectionSerializationTest methodsFor: 'tests' stamp: 'mariano 12/4/2011 18:57'!
testSortedCollectionWithClassVariableReference
	"Tests serialization of a SortedCollection whose sortBlock has a reference to the outer context. 
	Note: Equality can not be used to assert, since its behavior is this:
	| x y |
	x := SortedCollection sortBlock: [:a :b | a >= b ].
	y := SortedCollection sortBlock: [:a :b | a >= b ].
	self assert: x ~= y"

	| aSortedCollection materialized |
	ClassVariableForTesting := false.
	
	aSortedCollection := self class sortedCollectionForTestingWithClassVariable.
	materialized := self resultOfSerializeAndMaterialize: aSortedCollection.
	ClassVariableForTesting := true.
	materialized addAll: #(2 3 1).
	aSortedCollection addAll: #(2 3 1).
	
	aSortedCollection sortBlock assertWellMaterializedInto:  materialized sortBlock in: self.
	self assert: aSortedCollection asArray = materialized asArray.! !

!FLSortedCollectionSerializationTest methodsFor: 'tests' stamp: 'MartinDias 3/26/2012 22:29'!
testSortedCollectionWithInstanceVariableReference
	"Tests serialization of a SortedCollection whose sortBlock has a reference to the outer context. 
	Note: Equality can not be used to assert, since its behavior is this:
	| x y |
	x := SortedCollection sortBlock: [:a :b | a >= b ].
	y := SortedCollection sortBlock: [:a :b | a >= b ].
	self assert: x ~= y"

	| aSortedCollection materialized |
	instanceVariableForTesting := false.
	aSortedCollection := self sortedBlockClosureWithInstanceVariable.
	
	materialized := self resultOfSerializeAndMaterialize: aSortedCollection.
	materialized addAll: #(2 3 1).
	aSortedCollection addAll: #(2 3 1).
	
	self assert: aSortedCollection asArray = materialized asArray.
	self assert: aSortedCollection asArray = #(3 2 1)! !

!FLSortedCollectionSerializationTest methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 6/8/2011 17:50'!
classVariableForTesting
	
	^ ClassVariableForTesting! !

!FLSortedCollectionSerializationTest methodsFor: 'running' stamp: 'MartinDias 3/26/2012 21:40'!
sortedBlockClosureWithInstanceVariable
	^ SortedCollection
		sortBlock: [ :a :b | 
			instanceVariableForTesting
				ifTrue: [ a <= b ]
				ifFalse: [ a >= b ] ]! !

!FLSortedCollectionSerializationTest methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 6/8/2011 17:50'!
classVariableForTesting: anObject
	
	ClassVariableForTesting := anObject ! !

!FLSortedCollectionSerializationTest methodsFor: 'tests' stamp: 'MartinDias 10/5/2011 19:24'!
testSortedCollection
	"Tests that a SortedCollection works fine after materialization. 
	Note: Equality can not be used to assert, since its behavior is this:
	| x y |
	x := SortedCollection sortBlock: [:a :b | a >= b ].
	y := SortedCollection sortBlock: [:a :b | a >= b ].
	self assert: x ~= y"

	| aSortBlock aSortedCollection materialized |
	aSortBlock := [:a :b | a >= b ].
	aSortedCollection := SortedCollection sortBlock: aSortBlock.

	materialized := self resultOfSerializeAndMaterialize: aSortedCollection.
	self assert: aSortedCollection sortBlock ~~ materialized sortBlock.

	materialized addAll: #(2 1 3).
	aSortedCollection addAll: #(2 1 3).	
	self assert: aSortedCollection asArray = materialized asArray.! !

!FLSortedCollectionSerializationTest methodsFor: 'tests' stamp: 'MarcusDenker 5/21/2013 15:20'!
testSortedCollectionWithClassVariableChanges
	"Tests serialization of a SortedCollection whose sortBlock has a reference to a class variable and its value is changed. See also FLBlockClosureSerializationTest >> testBlockClosureWithClassVariableChanges  and FLCompiledMethodSerializationTest >> testMethodChangingClassVariable"

	| aSortedCollection materialized mmethod index |
	ClassVariableForTesting := false.
	
	aSortedCollection := self class sortedCollectionForTestingWithClassVariable.
	materialized := self resultOfSerializeAndMaterialize: aSortedCollection.
	"the class variable ClassVariableForTesting should be false"
	
	mmethod := materialized sortBlock outerContext method.
	
	index := mmethod literals indexOf: (self class bindingOf: #ClassVariableForTesting).
	
	self deny: (mmethod literalAt: index) value.
	ClassVariableForTesting := true.
	"the class variable ClassVariableForTesting should be true"
	self assert: (mmethod literalAt: index) value.
	
! !

!FLSortedCollectionSerializationTest class methodsFor: 'sorted collections for testing' stamp: 'MarcusDenker 5/21/2013 15:21'!
sortedCollectionForTestingWithClassVariable.
	^  SortedCollection sortBlock: [:a :b | 
		ClassVariableForTesting 
			ifTrue: [ a <= b ] 
			ifFalse: [ a >= b ] ]. 
! !

!FLStreamStrategy commentStamp: 'MartinDias 10/12/2011 11:36'!
I am a strategy that help tests for writing (and then reading) on streams.!
!FLStreamStrategy methodsFor: 'reading' stamp: 'MartinDias 10/12/2011 10:18'!
readStreamDo: aValuable
	"Evaluates the argument with a read stream. Answer the result."
	
	self subclassResponsibility ! !

!FLStreamStrategy methodsFor: 'writing' stamp: 'MartinDias 10/12/2011 10:18'!
writeStreamDo: aValuable
	"Evaluates the argument with a write stream. Answer the result."
	
	self subclassResponsibility ! !

!FLStreamStrategy methodsFor: 'serializing' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper
	"Visit myself as a substitution. See #fuelSubstitution."

	^ aGeneralMapper visitSubstitution: self by: nil! !

!FLSubstitutionCluster commentStamp: 'MartinDias 1/9/2012 15:04'!
I am a cluster for objects that have to be replaced in the object graph by another one (at serialization time).

Examples of use:

1) Suppose you want to substitute instances of WriteStream by nil. In such case, WriteStream has to implement this method:

fuelAccept: aVisitor
	^aVisitor visitSubstitution: self by: nil


2) Suppose you want to substitute every integer in the graph by its string representation. In such case you should configure the analyzer through:

anAnalyzer when: [:x | x isInteger] substituteBy: [:x | x printString].

In this way, when you serialize #(1 2), you will then materialize #('1' '2')!
!FLSubstitutionCluster methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 10/16/2012 09:32'!
isSubstitute: anObject

	^ substitutes identityIncludes: anObject! !

!FLSubstitutionCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 8/20/2011 23:18'!
registerIndexesOn: aDictionary

	substitutions keysAndValuesDo: [ :anObject :theSubstitution | 
		| substitutionIndex |
		substitutionIndex := aDictionary at: theSubstitution.
		aDictionary at: anObject put: substitutionIndex. ].! !

!FLSubstitutionCluster methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 5/15/2012 11:52'!
substitutions
	^ substitutions ! !

!FLSubstitutionCluster methodsFor: 'printing' stamp: 'MartinDias 8/29/2011 01:16'!
printOn: aStream

	super printOn: aStream.
	aStream nextPutAll: '->'.
	substitutions printElementsOn: aStream! !

!FLSubstitutionCluster methodsFor: 'accessing' stamp: 'MartinDias 8/29/2011 01:04'!
objects
	"This cluster does not have objects"
	
	^#()! !

!FLSubstitutionCluster methodsFor: 'initialize-release' stamp: 'MartinDias 5/9/2012 00:14'!
initializeAnalyzing

	super initializeAnalyzing.
	substitutions := IdentityDictionary new.
	substitutes := IdentitySet new.! !

!FLSubstitutionCluster methodsFor: 'analyzing' stamp: 'MartinDias 5/9/2012 00:14'!
add: anObject substitutedBy: anotherObject traceWith: aAnalysis

	substitutions 
		at: anObject 
		ifAbsent: [ 
			substitutions at: anObject put: anotherObject.
			substitutes add: anotherObject.
			aAnalysis trace: anotherObject ].! !

!FLSubstitutionCluster class methodsFor: 'analyzing' stamp: 'MartinDias 1/8/2012 15:39'!
clusterBucketIn: aClusterization

	^aClusterization substitutionsBucket! !

!FLTraitSerializationTest commentStamp: '<historical>'!
I have the common behavior for testing trait serialization.!
!FLTraitSerializationTest methodsFor: 'running' stamp: 'MartinDias 10/8/2011 04:14'!
newSecondaryTrait
	"Returns a trait for testing"

	^ self newTraitSuffixed: 'Secondary'! !

!FLTraitSerializationTest methodsFor: 'running' stamp: 'MarianoMartinezPeck 4/19/2012 19:13'!
newInstanceFrom: aTrait

	| aClass |
	aClass := self newClass.
	"If one wants to use a materialized trait in a class, it has to be added to Smalltalk globals. Fuel does not do that. Fuel just materializes the trait. It is up to the user to decide what to do with it.  "
	Smalltalk globals at: aTrait name put: aTrait.
	aClass addToComposition: aTrait.
	^ aClass new! !

!FLTraitSerializationTest methodsFor: 'running' stamp: 'MartinDias 10/8/2011 04:14'!
newClassOrTrait
	"Returns a trait for testing"

	^ self newTraitSuffixed: 'Main'! !

!FLUserGuidesTest commentStamp: 'TorstenBergmann 2/3/2014 23:30'!
SUnit tests to guide users with fuel serialization!
!FLUserGuidesTest methodsFor: 'tests-Managing Globals' stamp: 'MartinDias 5/19/2012 01:10'!
testConsiderGlobal
	
	| aSerializer anArray materializedArray |
	"Prepare an array whose two elements are system globals."
	anArray := Array with: Set new with: Set new.
	Smalltalk at: #GlobalSet1 put: anArray first.
	Smalltalk at: #GlobalSet2 put: anArray second.

	"Serialize considering *only first* as a global object."
	FileStream forceNewFileNamed: 'demo.fuel' do: [:aStream |
		aSerializer := FLSerializer newDefault.
		aSerializer analyzer considerGlobal: #GlobalSet1.
		aSerializer serialize: anArray on: aStream binary].

	"Materialize"
	FileStream oldFileNamed: 'demo.fuel' do: [:aStream |
		materializedArray := (FLMaterializer newDefault 
			materializeFrom: aStream binary) root].
		
	"Check that second element is a new Set."
	[ (Smalltalk at: #GlobalSet1) == materializedArray first ] assert.
	[ (Smalltalk at: #GlobalSet2) ~~ materializedArray second ] assert.
! !

!FLUserGuidesTest methodsFor: 'tests-Customizing Graph' stamp: 'MartinDias 5/24/2012 11:06'!
testPluggableSubstitution

	| materialized objectToSerialize aSerializer |
	
	objectToSerialize := Array with: 'hello' with: '' writeStream.
	
	FileStream forceNewFileNamed: 'demo.fuel' do: [ :aStream |
		aSerializer := FLSerializer newDefault.
		aSerializer analyzer when: [ :o | o isStream ] substituteBy: [ :o | nil ].
		aSerializer		 
			serialize: objectToSerialize
	 		on: aStream binary ].

	FileStream oldFileNamed: 'demo.fuel' do: [ :aStream |
		(FLMaterializer newDefault 
			materializeFrom: aStream binary) 
			root ].! !

!FLUserGuidesTest methodsFor: 'running' stamp: 'MartinDias 2/16/2013 19:43'!
tearDown
	super tearDown.
	#('demo.fuel' 'numbers.fuel' 'number.fuel.zip' 'example.FL' ) 
		do: [:each | self deleteFileNamed: each ].
		! !

!FLUserGuidesTest methodsFor: 'tests-Getting Started' stamp: 'MartinDias 5/18/2012 14:33'!
testFileShortcuts

| materializedString |
FLSerializer serialize: 'stringToSerialize' toFileNamed: 'demo.fuel'. 
materializedString := FLMaterializer materializeFromFileNamed: 'demo.fuel'.
! !

!FLUserGuidesTest methodsFor: 'tests-Getting Started' stamp: 'MartinDias 5/18/2012 15:39'!
testGZip

	| materialization |
	FileStream forceNewFileNamed: 'number.fuel.zip' do: [:aFileStream | 
		|gzip|
		aFileStream binary.
		gzip := GZipWriteStream on: aFileStream.
		FLSerializer newDefault serialize: 123 on: gzip.
		gzip close. ].
	
	FileStream oldFileNamed: 'number.fuel.zip' do: [:aFileStream | 
		|gzip|
		aFileStream binary.
		gzip := GZipReadStream on: aFileStream.		
		materialization := FLMaterializer newDefault 
			materializeFrom: gzip.
		gzip close. ].! !

!FLUserGuidesTest methodsFor: 'tests-Getting Started' stamp: 'MartinDias 5/18/2012 15:34'!
testShowingProgressBar
	| materializedString |
	(Smalltalk globals includesKey: #FLProgressSerialization) ifFalse: [
		" Needs:
		(ConfigurationOfFuel project latestVersion) load: 'FuelProgressUpdate'.
		"
		^self ].
	
	FileStream forceNewFileNamed: 'numbers.fuel' do: [:aStream |
		FLSerializer newDefault 
			showProgress;
			serialize: (1 to: 200000) asArray 
			on: aStream binary ].
	
	FileStream oldFileNamed: 'numbers.fuel' do: [:aStream | 
		FLMaterializer newDefault 
			showProgress;
			materializeFrom: aStream binary ].! !

!FLUserGuidesTest methodsFor: 'tests-Getting Started' stamp: 'MartinDias 5/19/2012 00:48'!
testFileStream

	| materializedString |
	FileStream forceNewFileNamed: 'demo.fuel' do: [:aStream |
		FLSerializer newDefault 
			serialize: 'stringToSerialize' 
	 		on: aStream binary].

	FileStream oldFileNamed: 'demo.fuel' do: [:aStream |
		materializedString := (FLMaterializer newDefault 
			materializeFrom: aStream binary) root].! !

!FLUserGuidesTest methodsFor: 'tests-Getting Started' stamp: 'MartinDias 5/18/2012 14:32'!
testMemoryStream

| anArray materializedString |
anArray := FLSerializer serializeToByteArray: 'stringToSerialize'. 
materializedString := FLMaterializer materializeFromByteArray: anArray.

! !

!FLUserGuidesTest methodsFor: 'tests-Getting Started' stamp: 'MartinDias 5/18/2012 19:29'!
testDemo

| sourceArray loadedArray |
sourceArray := 
	Array 
		with: 'a string' 
		with: Transcript
		with: [ Transcript show: 'a string'; flush ].
"Store to the file"
FLSerializer serialize: sourceArray toFileNamed: 'example.FL'. 
"Load from the file"
loadedArray := FLMaterializer materializeFromFileNamed: 'example.FL'. 
"The arrays are not the same"
[ sourceArray ~~ loadedArray ] assert.
"The strings are not the same"
[ sourceArray first ~~ loadedArray first ] assert.
[ sourceArray first = loadedArray first ] assert.
"The global instance Transcript is the same"
[ sourceArray second == loadedArray second ] assert.
"Look at Transcript how the loaded block prints a string"
loadedArray third value.! !

!FLVariableObjectCluster commentStamp: 'MartinDias 5/30/2011 01:25'!
I am a generic cluster for objects with indexable variables.!
!FLVariableObjectCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 3/23/2012 12:34'!
materializeReferencesOf: anObject with: aDecoder

	super materializeReferencesOf: anObject with: aDecoder.
	self materializeReferencesVariablePartOf: anObject with: aDecoder.! !

!FLVariableObjectCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/29/2011 19:44'!
serializeReferencesOf: anObject with: anEncoder

	super serializeReferencesOf: anObject with: anEncoder.
	self serializeReferencesVariablePartOf: anObject with: anEncoder. ! !

!FLVariableObjectCluster methodsFor: 'analyzing' stamp: 'MaxLeske 5/4/2013 10:35'!
addVariableReferenceFrom: anObject to: anotherObject
	| list |
	list := self variableReferences
		at: anObject
		ifAbsent: [ nil ].
	list ifNil: [ self variableReferences at: anObject put: (list := OrderedCollection new) ].	
	list add: anotherObject! !

!FLVariableObjectCluster methodsFor: 'accessing' stamp: 'MaxLeske 5/3/2013 17:31'!
variableReferences
	^ variableReferences ifNil: [ variableReferences := FLLargeIdentityDictionary new ]! !

!FLVariableObjectCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 3/23/2012 12:34'!
materializeReferencesVariablePartOf: anObject with: aDecoder

	1 to: anObject basicSize 
		do: [ :index | anObject basicAt: index put: aDecoder nextEncodedReference ]! !

!FLVariableObjectCluster methodsFor: 'serialize/materialize' stamp: 'MaxLeske 5/4/2013 10:24'!
serializeReferencesVariablePartOf: anObject with: anEncoder
	
	(self variableReferences at: anObject ifAbsent: [ ^ self ]) do: [ :value |
		anEncoder encodeReferenceTo: value ]! !

!FLVariableObjectCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/29/2011 19:44'!
serializeInstance: anObject with: anEncoder

	anEncoder encodePositiveInteger: anObject basicSize! !

!FLVariableObjectCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 2/20/2013 21:46'!
materializeInstanceWith: aDecoder

	^theClass fuelNew: aDecoder nextEncodedPositiveInteger! !

!FLVariableObjectCluster methodsFor: 'analyzing' stamp: 'MarianoMartinezPeck 12/6/2011 18:41'!
variablePartReferencesOf: anObject do: aBlock 

	1 to: anObject basicSize 
		do: [ :index | aBlock value: (anObject basicAt: index) ]! !

!FLVariableObjectCluster methodsFor: 'analyzing' stamp: 'MaxLeske 5/4/2013 11:05'!
add: anObject traceWith: aAnalysis
	"Add an object to the cluster and trace references."
	objects addIfNotPresent: anObject ifPresentDo: [ ^ self ].

	self 
		referencesOf: anObject 
		do: [ :aChild || actual |
			actual := aChild fuelReplacement.
			self addReferenceFrom: anObject to: actual.
			aAnalysis trace: actual ].
		
	self
		variablePartReferencesOf: anObject
		do: [ :aChild || actual |
			actual := aChild fuelReplacement.
			self addVariableReferenceFrom: anObject to: actual.
			aAnalysis trace: actual ]! !

!FLVariablesMapping commentStamp: 'MartinDias 8/1/2011 03:01'!
I am used to materialize instance variables in an object, tolerating "class shape changing".

Cases tolerated are:
- instance variable added
- instance variable order change
- instance variable removed
!
!FLVariablesMapping methodsFor: 'serialize/materialize' stamp: 'MartinDias 5/11/2012 14:07'!
materializeReferencesOf: anObject with: aDecoder 

	mapping do: [ :index | 
			| reference |
			reference := aDecoder nextEncodedReference.
			index ifNotNil: [
				anObject 
					instVarAt: index
					put: reference ]].! !

!FLVariablesMapping methodsFor: 'serialize/materialize' stamp: 'MaxLeske 5/3/2013 17:41'!
serializeReferencesOf: anObject with: anEncoder 

	(self references at: anObject ifAbsent: [ ^ self ]) do: [ :value |
		anEncoder encodeReferenceTo: value ].! !

!FLVariablesMapping methodsFor: 'private' stamp: 'MartinDias 12/22/2011 15:24'!
instanceVariableNamesToSerialize

	| ignoredInstanceVariableNames instanceVariableNamesToSerialize |
	ignoredInstanceVariableNames := theClass fuelIgnoredInstanceVariableNames.
	instanceVariableNamesToSerialize := OrderedCollection new.

	theClass instanceVariableNamesDo: [:name | 
		(ignoredInstanceVariableNames includes: name) 
			ifFalse: [ instanceVariableNamesToSerialize add: name ]].

	^ instanceVariableNamesToSerialize! !

!FLVariablesMapping methodsFor: 'initialize-release' stamp: 'MaxLeske 5/3/2013 17:42'!
initializeWithClass: aClass references: aCollection
	self initialize.
	theClass := aClass.
	references := aCollection! !

!FLVariablesMapping methodsFor: 'accessing' stamp: 'MartinDias 1/11/2012 00:22'!
map: sourceName to: destinationName

	| indexOfVariableToMap |
	indexOfVariableToMap := notIgnoredVariables indexOf: sourceName.
	indexOfVariableToMap > 0
		ifTrue: [ mapping 
			at: indexOfVariableToMap 
			put: (theClass
				instVarIndexFor: destinationName
				ifAbsent: [self error: 'Bad variable destination.'])].
! !

!FLVariablesMapping methodsFor: 'accessing' stamp: 'MaxLeske 5/3/2013 17:41'!
references
	^ references! !

!FLVariablesMapping methodsFor: 'serialize/materialize' stamp: 'MartinDias 1/7/2012 11:54'!
initializeMaterializingFrom: aDecoder

	notIgnoredVariables := (1 to: aDecoder nextEncodedByte) collect: [ :index | aDecoder nextEncodedString ].

	mapping := notIgnoredVariables  
		collect: [ :name | theClass instVarIndexFor: name ifAbsent: [ nil ] ].

! !

!FLVariablesMapping methodsFor: 'serialize/materialize' stamp: 'MartinDias 1/8/2012 14:42'!
initializeAnalyzing

	notIgnoredVariables := self instanceVariableNamesToSerialize.
	
	mapping := notIgnoredVariables 
		collect: [ :name | theClass instVarIndexFor: name ].! !

!FLVariablesMapping methodsFor: 'analyzing' stamp: 'MartinDias 12/22/2011 15:08'!
referencesOf: anObject do: aBlock

	mapping do: [ :index | aBlock value: (anObject instVarAt: index) ].! !

!FLVariablesMapping methodsFor: 'initialize-release' stamp: 'MaxLeske 5/3/2013 17:03'!
initializeWithClass: aClass
	self initialize.
	theClass := aClass! !

!FLVariablesMapping methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/29/2011 20:10'!
serializeOn: anEncoder

	anEncoder encodeByte: notIgnoredVariables size.	
	notIgnoredVariables do: [ :name | anEncoder encodeString: name ].! !

!FLVariablesMapping class methodsFor: 'instance creation' stamp: 'MaxLeske 5/3/2013 17:03'!
materializing: aClass from: aDecoder
	
	^ self basicNew
		initializeWithClass: aClass;
		initializeMaterializingFrom: aDecoder;
		yourself.! !

!FLVariablesMapping class methodsFor: 'instance creation' stamp: 'MaxLeske 5/3/2013 17:42'!
newAnalyzing: anAnalysis references: aCollection

	^ self basicNew
		initializeWithClass: anAnalysis references: aCollection;
		initializeAnalyzing;
		yourself! !

!FLVersionTest commentStamp: 'TorstenBergmann 2/3/2014 23:29'!
SUnit tests for fuel versioning!
!FLVersionTest methodsFor: 'tests' stamp: 'MartinDias 3/20/2012 12:59'!
testBadVersion

	serializer version: 2.
	materializer version: 1.
	self
		should: [ self resultOfSerializeAndMaterialize: 'content' ]
		raise: FLBadVersion
		whoseDescriptionIncludes: '2'
		description: 'The materializer should raise an error when version differs of the expected one.'! !

!FLVersionTest methodsFor: 'tests' stamp: 'MartinDias 10/7/2011 12:24'!
testSameVersion

	serializer version: 1.
	materializer version: 1.
	self assertSerializationEqualityOf: 'content'! !

!FLWeakClassMock commentStamp: 'TorstenBergmann 2/3/2014 23:23'!
Test mock for a weak class!
!FLWeakClassMock methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 12/6/2011 21:22'!
instVar1: anObject
	instVar1 := anObject! !

!FLWeakClassMock methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 12/6/2011 21:23'!
instVar1
	^ instVar1 ! !

!FLWeakObjectsTest commentStamp: 'TorstenBergmann 2/3/2014 23:29'!
SUnit tests for fuel serialization of weak objects!
!FLWeakObjectsTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 12/6/2011 13:59'!
testWeakWithStrongReferenceFromGraph2
	"This tests when there are weak objects inside the graph to serialize and there are also strong references from the graph."
	| weak graph obj1 obj2 materializedGraph |
	obj1 := 11.
	obj2 := 'something'.
	weak := WeakArray with: obj1 with: obj2. 
	graph := OrderedCollection with: 40 with: 'aaaa' with: weak with: obj2 with: (Point x: weak y: weak).
	 
	materializedGraph := self resultOfSerializeAndMaterialize: graph.
	self assert: (materializedGraph at: 3) first isNil.
	self assert: (materializedGraph at: 3) second = obj2.
	
	self deny: (self serializationOf: graph includes: 11).
	self assert: (self serializationOf: graph includes: obj2).
	
	 
		

! !

!FLWeakObjectsTest methodsFor: 'tests' stamp: 'MartinDias 3/22/2012 22:54'!
testAssociationWithWeakFinalizationList
	"This tests an association with WeakFInalizationList as its value."
	| weak association materializedAssociation object list |
	
	object := Object new.
	list := WeakFinalizationList new.
	weak := WeakFinalizerItem new list: list object: object executor: nil.
	association := Association key: #foo value: weak.
	
	materializedAssociation := self resultOfSerializeAndMaterialize: association.
	"Both, 'executor' and 'list' are fixed instance variables, hence they are strong and hence should not be replaced by nil. Instead, 'object' is stored in the variable part of WeakFinalizationItem, so it is weak and so it should have been replaced by nil."
	self assert: materializedAssociation value executor isNil.
	self assert: materializedAssociation value list isNil not.
	self assert: materializedAssociation value object isNil.
	self assert: materializedAssociation key = #foo.
	! !

!FLWeakObjectsTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 12/6/2011 19:16'!
testAssociationWithWeak
	"This tests an association with weak values. InstVar1 is a fixed instance variable, hence they are strong and hence should not be replaed by nil. Instead, 'weak' is stored in the variable part of FLWeakClassMock, so it is weak and so it should have been replaced by nil."
	| weak association materializedAssociation |
	
	weak := FLWeakClassMock new: 1.
	weak instVar1: 'nonWeak'.
	weak basicAt: 1 put: 'weak'. 
	association := Association key: #foo value: weak.
	
	materializedAssociation := self resultOfSerializeAndMaterialize: association.
	self assert: materializedAssociation value instVar1 isNil not.
	self assert: (materializedAssociation value basicAt: 1) isNil.
	self assert: materializedAssociation key = #foo.
	! !

!FLWeakObjectsTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 12/6/2011 12:11'!
testWeakWithStrongReferenceFromGraph
	"This tests when there are weak objects inside the graph to serialize and there are also strong references from the graph."
	| weak graph obj1 obj2 materializedGraph |
	obj1 := 11.
	obj2 := 'something'.
	weak := WeakArray with: obj1 with: obj2. 
	graph := OrderedCollection with: 40 with: 'aaaa' with: weak with: obj2.
	
	materializedGraph := self resultOfSerializeAndMaterialize: graph.
	self assert: (materializedGraph at: 3) first isNil.
	self assert: (materializedGraph at: 3) second = obj2.
	
	self deny: (self serializationOf: graph includes: 11).
	self assert: (self serializationOf: graph includes: obj2).
	
	 
		

! !

!FLWeakObjectsTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 12/6/2011 12:11'!
testWeakAndNoStrongReferenceFromGraph
	"This tests when there are weak objects inside the graph to serialize but there are no strong references from the graph."
	| weak graph obj1 obj2 materializedGraph |
	obj1 := 11.
	obj2 := 'something'.
	weak := WeakArray with: obj1 with: obj2. 
	graph := OrderedCollection with: 40 with: 'aaaa' with: weak.
	
	materializedGraph := self resultOfSerializeAndMaterialize: graph.
	self assert: (materializedGraph at: 3) first isNil.
	self assert: (materializedGraph at: 3) second isNil.
	
	self deny: (self serializationOf: graph includes: 11).
	self deny: (self serializationOf: graph includes: 'something').
	
	 
		
! !

!FLWeakVariableObjectCluster commentStamp: '<historical>'!
I am a cluster for objects with weak indexable variables.!
!FLWeakVariableObjectCluster methodsFor: 'analyzing' stamp: 'MarianoMartinezPeck 12/6/2011 19:22'!
variablePartReferencesOf: anObject do: aBlock 
	"Since the variable part of Weak classes are weak references, we should not do nothing here."! !

!FLWeakVariableObjectCluster methodsFor: 'analyzing' stamp: 'MartinDias 2/17/2012 03:24'!
clusterReferencesDo: aBlock
	"Ensures that nil could be encoded, later in references step."

	super clusterReferencesDo: aBlock.
	aBlock value: nil! !

!FLWeakVariableObjectCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/29/2011 19:44'!
serializeReferencesVariablePartOf: anObject with: anEncoder
	
	1 to: anObject basicSize do: [ :index |
		anEncoder encodeWeakReferenceTo: (anObject basicAt: index) ]! !

!FLWordObjectCluster commentStamp: 'MarianoMartinezPeck 9/6/2011 22:50'!
I am the generic cluster for storing and loading variable word objects. Most word-like objects are subclasses from ArrayedCollection. Hence, we may have used the method #writeOn: to serialize, and #newFromStream: to materialize. 

#writeOn: is slow because it ALWAYS encode wors in a big endian format. Most machines today are even little endian. Even worst, #newFromStream: has to always do a #restoreEndianness. 

#newFromStream: is fast because it uses the method #nextWordsInto: which is a hack but that is really fast. The problem is that #nextWordsInto: has to always do the #restoreEndianness when we are in little endian machines (most of the time).

Hence, this cluster provives the best of both worlds: the serialization is done with a platform-dependen way, that is, the endianness will be the same of the machine where we are serializing. In addition, we serialize with the same hack that #nextWordsInto: uses, that is, the Bitmap >> hackBits:
And the materialization will use a variation of #nextWordsInto:  (#fuelNextWordsInto:) that ONLY does the #restoreEndianness if the machine where we are materializing has a different endianness than where we have serialized the object. To do this, while serializing, we store in the header of the Fuel stream, the endianness. Then in materialization, we compare agains that. 

Conclusion: we only restore endianness when needed.

Notice, in addition, that the method #newFromStream: sends the message #restoreEndianness. This method EXPECTS that the object was serialized in big endian format, and it will only change the endianness if we are materializing in a little endian machine. This means that if you serialize in little endian and materialize in big endian, you are screw.  For this reason, this cluster uses a method that always change the endianness, Bitmap class >> swapBytesIn:from:to: 

Future work: maybe we can modify and use the Bitmap hackBits:   not only for materialization but also for serialization. 
!
!FLWordObjectCluster methodsFor: 'endianness' stamp: 'MarianoMartinezPeck 9/6/2011 12:34'!
swapBytesOf: aWordObject
	Bitmap
                swapBytesIn: aWordObject
                from: 1
                to: aWordObject basicSize.
	^ aWordObject! !

!FLWordObjectCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/29/2011 20:59'!
materializeInstanceWith: aDecoder

	| inst wideSize |

	wideSize :=  aDecoder nextEncodedPositiveInteger.
	inst := theClass basicNew: wideSize.	

	aDecoder nextEncodedWordsInto: inst. 

	(aDecoder isBigEndian = Smalltalk isBigEndian asBit)
		ifTrue: [^ inst ]
		ifFalse: [ ^ self swapBytesOf: inst ] 
	! !

!FLWordObjectCluster methodsFor: 'serialize/materialize' stamp: 'MartinDias 12/29/2011 20:05'!
serializeInstance: aWordObject with: anEncoder

	anEncoder encodePositiveInteger: aWordObject basicSize.
	anEncoder encodeWords: aWordObject

! !

!FT2BitmapSize commentStamp: '<historical>'!
Do not rearrange these fields!!

This structure models the size of a bitmap strike (i.e., a bitmap
instance of the font for a given resolution) in a fixed-size font
face.  It is used for the `availableSizes' field of the
FT2Face structure.

<Fields>
height :: The (vertical) baseline-to-baseline distance in pixels.
It makes most sense to define the height of a bitmap
font in this way.

width  :: The average width of the font (in pixels).  Since the
algorithms to compute this value are different for the
various bitmap formats, it can only give an additional
hint if the `height' value isn't sufficient to select
the proper font.  For monospaced fonts the average width
is the same as the maximum width.

size   :: The point size in 26.6 fractional format this font shall
represent (for a given vertical resolution).

x_ppem :: The horizontal ppem value (in 26.6 fractional format).

y_ppem :: The vertical ppem value (in 26.6 fractional format).
Usually, this is the `nominal' pixel height of the font.

<Note>
The values in this structure are taken from the bitmap font.  If
the font doesn't provide a parameter it is set to zero to indicate
that the information is not available.

The following formula converts from dpi to ppem:

ppem = size * dpi / 72

where `size' is in points.

Windows FNT:
The `size' parameter is not reliable: There exist fonts (e.g.,
app850.fon) which have a wrong size for some subfonts; x_ppem
and y_ppem are thus set equal to pixel width and height given in
in the Windows FNT header.

TrueType embedded bitmaps:
`size', `width', and `height' values are not contained in the
bitmap strike itself.  They are computed from the global font
parameters.
!
!FT2Constants commentStamp: '<historical>'!
The various flags from the Freetype/2 header.

The LoadXXXX flags can be used with primitiveLoadGlyph:flags: or with the Cairo primCairoFtFontCreateForFtFace:flags:scale: primitives.

FT_LOAD_DEFAULT ::
  Corresponding to 0, this value is used a default glyph load.  In this
  case, the following will happen:
                                                                        
  1. FreeType looks for a bitmap for the glyph corresponding to the
     face's current size.  If one is found, the function returns.  The
     bitmap data can be accessed from the glyph slot (see note below).
                                                                        
  2. If no embedded bitmap is searched or found, FreeType looks for a
     scalable outline.  If one is found, it is loaded from the font
     file, scaled to device pixels, then "hinted" to the pixel grid in
     order to optimize it.  The outline data can be accessed from the
     glyph slot (see note below).
                                                                        
  Note that by default, the glyph loader doesn't render outlines into
  bitmaps.  The following flags are used to modify this default
  behaviour to more specific and useful cases.
                                                                        
FT_LOAD_NO_SCALE ::
  Don't scale the vector outline being loaded to 26.6 fractional
  pixels, but kept in font units.  Note that this also disables
  hinting and the loading of embedded bitmaps.  You should only use it
  when you want to retrieve the original glyph outlines in font units.
                                                                        
FT_LOAD_NO_HINTING ::
  Don't hint glyph outlines after their scaling to device pixels.
  This generally generates "blurrier" glyphs in anti-aliased modes.
                                                                        
  This flag is ignored if @FT_LOAD_NO_SCALE is set.
                                                                        
FT_LOAD_RENDER ::
  Render the glyph outline immediately into a bitmap before the glyph
  loader returns.  By default, the glyph is rendered for the
  @FT_RENDER_MODE_NORMAL mode, which corresponds to 8-bit anti-aliased
  bitmaps using 256 opacity levels.  You can use either
  @FT_LOAD_TARGET_MONO or @FT_LOAD_MONOCHROME to render 1-bit
  monochrome bitmaps.
                                                                        
  This flag is ignored if @FT_LOAD_NO_SCALE is set.
                                                                        
FT_LOAD_NO_BITMAP ::
  Don't look for bitmaps when loading the glyph.  Only scalable
  outlines will be loaded when available, and scaled, hinted, or
  rendered depending on other bit flags.
                                                                        
  This does not prevent you from rendering outlines to bitmaps
  with @FT_LOAD_RENDER, however.
                                                                        
FT_LOAD_VERTICAL_LAYOUT ::
  Prepare the glyph image for vertical text layout.  This basically
  means that `face.glyph.advance' will correspond to the vertical
  advance height (instead of the default horizontal advance width),
  and that the glyph image will be translated to match the vertical
  bearings positions.
                                                                        
FT_LOAD_FORCE_AUTOHINT ::
  Force the use of the FreeType auto-hinter when a glyph outline is
  loaded.  You shouldn't need this in a typical application, since it
  is mostly used to experiment with its algorithm.
                                                                        
FT_LOAD_CROP_BITMAP ::
  Indicates that the glyph loader should try to crop the bitmap (i.e.,
  remove all space around its black bits) when loading it.  This is
  only useful when loading embedded bitmaps in certain fonts, since
  bitmaps rendered with @FT_LOAD_RENDER are always cropped by default.
                                                                        
FT_LOAD_PEDANTIC ::
  Indicates that the glyph loader should perform pedantic
  verifications during glyph loading, rejecting invalid fonts.  This
  is mostly used to detect broken glyphs in fonts.  By default,
  FreeType tries to handle broken fonts also.
                                                                        
FT_LOAD_IGNORE_GLOBAL_ADVANCE_WIDTH ::
  Indicates that the glyph loader should ignore the global advance
  width defined in the font.  As far as we know, this is only used by
  the X-TrueType font server, in order to deal correctly with the
  incorrect metrics contained in DynaLab's TrueType CJK fonts.
                                                                        
FT_LOAD_NO_RECURSE ::
  This flag is only used internally.  It merely indicates that the
  glyph loader should not load composite glyphs recursively.  Instead,
  it should set the `num_subglyph' and `subglyphs' values of the glyph
  slot accordingly, and set "glyph->format" to
  @FT_GLYPH_FORMAT_COMPOSITE.
                                                                        
  The description of sub-glyphs is not available to client
  applications for now.
                                                                        
FT_LOAD_IGNORE_TRANSFORM ::
  Indicates that the glyph loader should not try to transform the
  loaded glyph image.  This doesn't prevent scaling, hinting, or
  rendering.
                                                                        
FT_LOAD_MONOCHROME ::
  This flag is used with @FT_LOAD_RENDER to indicate that you want
  to render a 1-bit monochrome glyph bitmap from a vectorial outline.
                                                                        
  Note that this has no effect on the hinting algorithm used by the
  glyph loader.  You should better use @FT_LOAD_TARGET_MONO if you
  want to render monochrome-optimized glyph images instead.
                                                                        
FT_LOAD_LINEAR_DESIGN ::
  Return the linearly scaled metrics expressed in original font units
  instead of the default 16.16 pixel values.
                                                                        
FT_LOAD_NO_AUTOHINT ::
  Indicates that the auto-hinter should never be used to hint glyph
  outlines.  This doesn't prevent native format-specific hinters from
  being used.  This can be important for certain fonts where unhinted
  output is better than auto-hinted one.

One of following flags (as LoadTargetXXX) can be used to further specify the result.

   FT_RENDER_MODE_NORMAL ::                                          
     This is the default render mode; it corresponds to 8-bit        
     anti-aliased bitmaps, using 256 levels of opacity.              
                                                                     
   FT_RENDER_MODE_LIGHT ::                                           
     This is similar to @FT_RENDER_MODE_NORMAL, except that this     
     changes the hinting to prevent stem width quantization.  This   
     results in glyph shapes that are more similar to the original,  
     while being a bit more fuzzy ("better shapes", instead of       
     "better contrast" if you want :-).                              
                                                                     
   FT_RENDER_MODE_MONO ::                                            
     This mode corresponds to 1-bit bitmaps.                         
                                                                     
   FT_RENDER_MODE_LCD ::                                             
     This mode corresponds to horizontal RGB/BGR sub-pixel displays, 
     like LCD-screens.  It produces 8-bit bitmaps that are 3 times   
     the width of the original glyph outline in pixels, and which use
     the @FT_PIXEL_MODE_LCD mode.                                    
                                                                     
   FT_RENDER_MODE_LCD_V ::                                           
     This mode corresponds to vertical RGB/BGR sub-pixel displays    
     (like PDA screens, rotated LCD displays, etc.).  It produces    
     8-bit bitmaps that are 3 times the height of the original       
     glyph outline in pixels and use the @FT_PIXEL_MODE_LCD_V mode.  
                                                                     
<Note>                                                               
  The LCD-optimized glyph bitmaps produced by FT_Render_Glyph are    
  _not filtered_ to reduce color-fringes.  It is up to the caller to 
  perform this pass.                                                 

!
!FT2Constants class methodsFor: 'class initialization' stamp: 'tween 8/13/2006 15:55'!
initialize
	"FT2Constants initialize"

	LoadDefault := 0.
	LoadNoScale := 1.
	LoadNoHinting := 2.
	LoadRender := 4.
	LoadNoBitmap := 8.
	LoadVerticalLayout := 16.
	LoadForceAutohint := 32.
	LoadCropBitmap := 64.
	LoadPedantic := 128.
	LoadIgnoreGlobalAdvanceWidth := 512.
	LoadNoRecurse := 1024.
	LoadIgnoreTransform := 2048.
	LoadMonochrome := 4096.
	LoadLinearDesign := 8192.
	LoadSbitsOnly := 16384.
	LoadNoAutohint := 32768.

	"One of these flags may be OR'd with the above."
	LoadTargetNormal := 0.
	LoadTargetLight := 1 bitShift: 16.
	LoadTargetMono := 2 bitShift: 16.
	LoadTargetLCD := 3 bitShift: 16.
	LoadTargetLCDV  := 4 bitShift: 16.

	"rendering mode constants"
	RenderModeNormal := 0.
	RenderModeLight := 1.
	RenderModeMono := 2.
	RenderModeLCD := 3.	
	RenderModeLCDV := 4.

	"pixel mode constants"
	PixelModeNone := 0.
	PixelModeMono := 1.
	PixelModeGray := 2.
	PixelModeGray2 := 3.
	PixelModeGray4 := 4.
	PixelModeLCD := 5.
	PixelModeLCDV := 6.
	
	StyleFlagItalic := 1.
	StyleFlagBold := 2.
! !

!FT2Error commentStamp: '<historical>'!
This is an Error that knows how to get the Freetype2 error code and string.!
!FT2Error methodsFor: 'accessing' stamp: 'nk 11/4/2004 13:31'!
errorCode
	errorCode
		ifNotNil: [^ errorCode].
	^ errorCode := [FT2Library errorCode]
				on: Error
				do: [:ex | ex return: 'can''t get error code']! !

!FT2Error methodsFor: 'accessing' stamp: 'nk 11/4/2004 13:31'!
errorString
	errorString
		ifNotNil: [^ errorString].
	^ errorString := [FT2Library errorString]
				on: Error
				do: [:ex | ex return: 'can''t get error string']! !

!FT2Error methodsFor: 'accessing' stamp: 'nk 3/17/2005 12:50'!
messageText
	^String streamContents: [ :strm |
		messageText ifNotNil: [ strm nextPutAll: messageText; space ].
		self errorCode isZero ifFalse: [
			strm nextPutAll: '[error '; print: self errorCode; nextPutAll: '][';
				nextPutAll: self errorString;
				nextPut: $] ]]! !

!FT2Face commentStamp: '<historical>'!
Do not rearrange these fields!!
New fields should go at the end, because the plugin has to know about these indexes.

ByteArray representing a pointer to the malloc'd FT_Face struct:
handle

Copied from the FT_Face struct on creation:
numFaces faceIndex faceFlags styleFlags numGlyphs familyName styleName numFixedSizes availableSizes numCharmaps charmaps

Copied on creation, but only relevant to scalable outlines:
bbox unitsPerEm ascender descender height maxAdvanceWidth maxAdvanceHeight underlinePosition underlineThickness 

Working memory:
glyph -- FT2GlyphSlot, set by loadGlyph or loadChar
size -- the active size, set by activateSize, used by loadGlyph, getKerning, etc.
charmap -- set by setCharmap
!
!FT2Face methodsFor: 'accessing' stamp: 'nk 11/3/2004 11:56'!
ascender
	^ascender! !

!FT2Face methodsFor: 'private-primitives' stamp: 'nk 11/3/2004 18:05'!
primLoadCharacter: index flags: flags
	<primitive: 'primitiveLoadCharacter' module: 'FT2Plugin'>
	^self primitiveFailed! !

!FT2Face methodsFor: 'accessing' stamp: 'nk 11/3/2004 11:56'!
maxAdvanceWidth
	^maxAdvanceWidth! !

!FT2Face methodsFor: 'accessing' stamp: 'nk 11/3/2004 11:56'!
numFaces
	^numFaces! !

!FT2Face methodsFor: 'private' stamp: 'tween 7/29/2006 11:31'!
primLoadFields
	<primitive: 'primitiveLoadFaceFields' module: 'FT2Plugin'>
	^self primitiveFailed! !

!FT2Face methodsFor: 'accessing' stamp: 'nk 11/3/2004 17:06'!
bbox
	bbox
		ifNil: [bbox := Rectangle new.
			self primLoadBbox: bbox].
	^ bbox! !

!FT2Face methodsFor: 'private-primitives' stamp: 'bf 11/19/2005 12:56'!
primRenderGlyphIntoForm: aForm
	<primitive: 'primitiveRenderGlyphIntoForm' module: 'FT2Plugin'>
	^self primitiveFailed! !

!FT2Face methodsFor: 'rendering' stamp: 'tween 8/13/2006 15:57'!
renderGlyphIntoForm: aForm pixelMode: anInteger
	"render the current glyph (selected by loadChar/loadGlyph into the given form (1 or 8 bpp)
	with pixel mode anInteger "
	self primRenderGlyphIntoForm: aForm pixelMode: anInteger
! !

!FT2Face methodsFor: 'charmaps' stamp: 'nk 11/3/2004 19:36'!
getCharMap
	self primGetCharMap.! !

!FT2Face methodsFor: 'glyphs' stamp: 'jl 5/30/2006 14:08'!
glyphOfCharacter: aCharacter
	"load a glyph with outline, glyph is not scaled "
	| em aGlyph |
	em := self unitsPerEm.
	self validate.
	self setPixelWidth: em height: em.
	self loadCharacter: aCharacter asInteger flags: LoadIgnoreTransform. "load glyph metrics"
	aGlyph := self glyph shallowCopy. " copy because 'face glyph' is only a slot"
	aGlyph outline: (self characterOutline: aCharacter).
	^aGlyph! !

!FT2Face methodsFor: 'accessing' stamp: 'nk 11/3/2004 11:56'!
height
	^height! !

!FT2Face methodsFor: 'kerning' stamp: 'tween 3/11/2007 21:17'!
kerningLeft: leftCharacter right: rightCharacter
	[^self primGetKerningLeft: (self primGetCharIndex: leftCharacter asInteger)  
		right: (self primGetCharIndex: rightCharacter asInteger) 
	] on: FT2Error do:[:e | ^0@0]! !

!FT2Face methodsFor: 'private-primitives' stamp: 'nk 11/4/2004 13:35'!
primSetPixelWidth: x height: y
	<primitive: 'primitiveSetPixelSizes' module: 'FT2Plugin'>
	^self primitiveFailed.! !

!FT2Face methodsFor: 'private' stamp: 'tween 7/31/2006 21:30'!
loadFields
	self isValid 
		ifTrue:[
			[self primLoadFields] 
			on: FT2Error
			do:[:e |
				"need to do something here"]]! !

!FT2Face methodsFor: 'testing' stamp: 'tween 8/7/2006 08:47'!
isItalic
	styleFlags == nil ifTrue:[^false].
	^styleFlags allMask: StyleFlagItalic! !

!FT2Face methodsFor: 'accessing' stamp: 'bf 11/17/2005 15:56'!
glyph
	glyph ifNil: [ glyph := FT2GlyphSlot fromFace: self ].
	^glyph! !

!FT2Face methodsFor: 'rendering' stamp: 'tween 8/2/2006 17:40'!
angle: angle scalePoint: scalePoint offset: aPoint slant: slant
	| oneX oneY matrix delta slantOne|
	oneX := (16r10000 * scalePoint x) asInteger.
	oneY :=  (16r10000 * scalePoint y) asInteger.
	slantOne := (16r10000 * scalePoint x * slant) asInteger.
	matrix := IntegerArray new: 4.
	angle isZero ifTrue: [
		matrix at: 1 put: oneX.
		matrix at: 2 put: slantOne.
		matrix at: 4 put: oneY.
	] ifFalse: [
		| phi cos sin |
		phi := angle degreesToRadians.
		cos := (phi sin * oneX) rounded.
		sin := (phi cos * oneY) rounded.
		matrix at: 1 put: sin.
		matrix at: 2 put: cos negated.
		matrix at: 3 put: cos.
		matrix at: 4 put: sin.
 	].
	delta := IntegerArray new: 2.
	delta at: 1 put: (aPoint x * 64) rounded. 
	delta at: 2 put: (aPoint y * 64) rounded.
	self primSetTransform: matrix delta: delta.
! !

!FT2Face methodsFor: 'private-primitives' stamp: 'nk 11/3/2004 19:35'!
primGetCharMap
	<primitive: 'primitiveGetFaceCharMap' module: 'FT2Plugin'>
	^self primitiveFailed! !

!FT2Face methodsFor: 'accessing' stamp: 'nk 11/3/2004 21:05'!
charmaps
	"Answer an Array of Strings naming the different character maps available for setCharMap:"
	charmaps ifNil: [
		charmaps := Array new: numCharmaps.
		self getCharMapsInto: charmaps ].
	^charmaps! !

!FT2Face methodsFor: 'glyphs' stamp: 'nk 11/3/2004 18:23'!
setPixelWidth: x height: y
	self primSetPixelWidth: x height: y! !

!FT2Face methodsFor: 'private-primitives' stamp: 'tween 8/13/2006 15:56'!
primRenderGlyphIntoForm: aForm pixelMode: anInteger
	<primitive: 'primitiveRenderGlyphIntoFormWithRenderMode' module: 'FT2Plugin'>
	^self primitiveFailed! !

!FT2Face methodsFor: 'charmaps' stamp: 'nk 11/3/2004 20:38'!
getCharMapsInto: array
	self primGetCharMapsInto: array.! !

!FT2Face methodsFor: 'accessing' stamp: 'nk 11/3/2004 11:56'!
familyName
	^familyName! !

!FT2Face methodsFor: 'private-primitives' stamp: 'bf 11/18/2005 19:33'!
primSetBitmapLeft: x top: y
	<primitive: 'primitiveSetBitmapLefttop' module: 'FT2Plugin'>
	^self primitiveFailed.! !

!FT2Face methodsFor: 'accessing' stamp: 'nk 11/3/2004 11:56'!
underlineThickness
	^underlineThickness! !

!FT2Face methodsFor: 'private-primitives' stamp: 'tween 7/24/2006 21:10'!
primNewMemoryFaceByteSize: anInteger index: anInteger2
	<primitive: 'primitiveNewMemoryFaceByteSizeAndIndex' module: 'FT2Plugin'>
	^self primitiveFailed! !

!FT2Face methodsFor: 'accessing' stamp: 'nk 11/3/2004 11:56'!
numFixedSizes
	^numFixedSizes! !

!FT2Face methodsFor: 'private-primitives' stamp: 'nk 11/4/2004 13:34'!
primLoadBbox: aRectangle
	<primitive: 'primitiveLoadFaceBbox' module: 'FT2Plugin'>
	^self primitiveFailed.! !

!FT2Face methodsFor: 'private-primitives' stamp: 'jl 5/30/2006 13:21'!
primGetCharIndex: characterCode
	"Return the glyph index of a given character code"
	<primitive: 'primitiveGetFaceCharIndex' module: 'FT2Plugin'>
	^self primitiveFailed.
! !

!FT2Face methodsFor: 'accessing' stamp: 'nk 11/3/2004 11:56'!
numGlyphs
	^numGlyphs! !

!FT2Face methodsFor: 'private-primitives' stamp: 'tween 8/11/2007 11:24'!
primGetPostscriptName 
	<primitive: 'primitiveGetPostscriptName' module: 'FT2Plugin'>
	^nil! !

!FT2Face methodsFor: 'rendering' stamp: 'tween 8/2/2006 20:47'!
transformOutlineAngle: angle scalePoint: scalePoint slant: slant
	| oneX oneY matrix  slantOne|
	oneX := (16r10000 * scalePoint x) asInteger.
	oneY :=  (16r10000 * scalePoint y) asInteger.
	slantOne := (16r10000 * scalePoint x * slant) asInteger.
	matrix := IntegerArray new: 4.
	angle isZero ifTrue: [
		matrix at: 1 put: oneX.
		matrix at: 2 put: slantOne.
		matrix at: 4 put: oneY.
	] ifFalse: [
		| phi cos sin |
		phi := angle degreesToRadians.
		cos := (phi sin * oneX) rounded.
		sin := (phi cos * oneY) rounded.
		matrix at: 1 put: sin.
		matrix at: 2 put: cos negated.
		matrix at: 3 put: cos.
		matrix at: 4 put: sin.
 	].
	self primTransformGlyphSlotOutline: matrix! !

!FT2Face methodsFor: 'testing' stamp: 'tween 8/7/2006 08:46'!
isBold
	styleFlags == nil ifTrue:[^false].
	^styleFlags allMask: StyleFlagBold! !

!FT2Face methodsFor: 'accessing' stamp: 'nk 11/3/2004 11:56'!
availableSizes
	^availableSizes! !

!FT2Face methodsFor: 'rendering' stamp: 'tween 8/2/2006 21:19'!
emboldenOutline: strength
	^self primEmboldenGlyphSlotOutline: (strength * 64) rounded! !

!FT2Face methodsFor: 'private-primitives' stamp: 'nk 11/3/2004 19:35'!
primSetCharMap: encodingString
	<primitive: 'primitiveSetFaceCharMap' module: 'FT2Plugin'>
	^self primitiveFailed! !

!FT2Face methodsFor: 'initialize-release' stamp: 'DenisKudryashov 1/29/2013 22:04'!
newFaceFromFile: fileName index: anInteger
	[self primNewFaceFromFile: fileName fullName index: anInteger]
		on: FT2Error 
		do:[:e | ^self "need to do something here?"].
	self class register: self.! !

!FT2Face methodsFor: 'outlines' stamp: 'MichaelRueger 12/16/2009 14:59'!
characterOutline: aCharacter
	^self loadCharacterOutline: aCharacter asUnicode flags: LoadIgnoreTransform! !

!FT2Face methodsFor: 'glyphs' stamp: 'MichaelRueger 12/16/2009 15:41'!
glyphOfCharacter: aCharacter fontSize: fontSize
	^self glyphOfCharacter: aCharacter pixelSize: fontSize@fontSize! !

!FT2Face methodsFor: 'accessing' stamp: 'nk 11/3/2004 11:56'!
styleFlags
	^styleFlags! !

!FT2Face methodsFor: 'accessing' stamp: 'nk 11/3/2004 20:46'!
encoding
	encoding ifNil: [ self getCharMap ].
	^encoding! !

!FT2Face methodsFor: 'outlines' stamp: 'jl 5/24/2006 15:22'!
loadCharacterOutline: index flags: flags
	| em outline |
	em := unitsPerEm.
	self setPixelWidth: em height: em.
	self loadCharacter: index flags: flags.
	outline := FT2Outline new.
	outline primLoadSizesFrom: self.
	outline allocateArrays.
	outline primLoadArraysFrom: self.

	^outline! !

!FT2Face methodsFor: 'private-primitives' stamp: 'jl 5/30/2006 13:23'!
primGetKerningLeft: leftGlyphIndex right: rightGlyphIndex
	"self primGetKerningLeft: $V asInteger  right: $a asInteger "
	<primitive: 'primitiveGetKerningLeftRight' module: 'FT2Plugin'>
	^self primitiveFailed.! !

!FT2Face methodsFor: 'private-primitives' stamp: 'nk 11/3/2004 15:58'!
primNewFaceFromFile: fileName index: anInteger
	<primitive: 'primitiveNewFaceFromFileAndIndex' module: 'FT2Plugin'>
	^self primitiveFailed! !

!FT2Face methodsFor: 'rendering' stamp: 'tween 8/2/2006 20:48'!
translateOutlineBy: aPoint
	| delta|
	delta := IntegerArray new: 2.
	delta at: 1 put: (aPoint x * 64) rounded. 
	delta at: 2 put: (aPoint y * 64) rounded.
	self primTranslateGlyphSlotOutline: delta.! !

!FT2Face methodsFor: 'accessing' stamp: 'nk 11/3/2004 11:56'!
faceFlags
	^faceFlags! !

!FT2Face methodsFor: 'rendering' stamp: 'bf 11/21/2005 18:07'!
angle: angle scale: scale offset: aPoint
	| one matrix delta |
	one := (16r10000 * scale) asInteger.
	matrix := IntegerArray new: 4.
	angle isZero ifTrue: [
		matrix at: 1 put: one.
		matrix at: 4 put: one.
	] ifFalse: [
		| phi cos sin |
		phi := angle degreesToRadians.
		cos := (phi sin * one) rounded.
		sin := (phi cos * one) rounded.
		matrix at: 1 put: sin.
		matrix at: 2 put: cos negated.
		matrix at: 3 put: cos.
		matrix at: 4 put: sin.
 	].
	delta := IntegerArray new: 2.
	delta at: 1 put: (aPoint x * 64) rounded. 
	delta at: 2 put: (aPoint y * 64) rounded.
	self primSetTransform: matrix delta: delta.
! !

!FT2Face methodsFor: 'testing' stamp: 'tween 8/7/2006 08:47'!
isRegular
	styleFlags == nil ifTrue:[^true].
	^styleFlags = 0! !

!FT2Face methodsFor: 'accessing' stamp: 'nk 11/3/2004 11:56'!
numCharmaps
	^numCharmaps! !

!FT2Face methodsFor: 'private-primitives' stamp: 'bf 11/19/2005 15:36'!
primSetTransform: matrixWordArray delta: deltaWordArray
	"matrix is 16.16 fixed point
		x' = x*m[0] + y*m[1]                                 
		y' = x*m[2] + y*yy[3]
	delta is 26.6 fixed point
		x' = x + d[0]
		y' = y + d[1]
	"
	<primitive: 'primitiveSetTransform' module: 'FT2Plugin'>
	^self primitiveFailed.! !

!FT2Face methodsFor: 'private-primitives' stamp: 'tween 8/2/2006 21:14'!
primEmboldenGlyphSlotOutline: strengthInteger
	<primitive: 'primitiveEmboldenFaceGlyphSlotOutline' module: 'FT2Plugin'>
	^self primitiveFailed.! !

!FT2Face methodsFor: 'testing' stamp: 'tween 8/7/2006 08:47'!
isFixedWidth
	styleFlags == nil ifTrue:[^false].
	^faceFlags allMask: 4 "FT_FACE_FLAG_FIXED_WIDTH" ! !

!FT2Face methodsFor: 'private-primitives' stamp: 'jl 5/30/2006 15:59'!
primGetTrackKerningPointSize: pointSize degree: degree
	<primitive: 'primitiveGetTrackKerningPointSizeDegree' module: 'FT2Plugin'>
	^self primitiveFailed.! !

!FT2Face methodsFor: 'accessing' stamp: 'tween 8/11/2007 11:24'!
postscriptName
	^self primGetPostscriptName! !

!FT2Face methodsFor: 'printing' stamp: 'ClementBera 7/26/2013 16:42'!
printOn: aStream 
	super printOn: aStream.
	handle ifNil: [^self].
	"self familyName isNil ifTrue: [ self loadFields ]."
	aStream
		nextPut: $[;
		nextPutAll: (self familyName ifNil: ['?']);
		space;
		nextPutAll: (self styleName ifNil: ['?']);
		nextPut: $]! !

!FT2Face methodsFor: 'private-primitives' stamp: 'nk 11/3/2004 18:05'!
primLoadGlyph: index flags: flags
	<primitive: 'primitiveLoadGlyph' module: 'FT2Plugin'>
	^self primitiveFailed! !

!FT2Face methodsFor: 'glyphs' stamp: 'nk 11/3/2004 18:25'!
loadGlyph: index flags: flags
	self primLoadGlyph: index flags: flags.
	glyph
		ifNil: [ glyph := FT2GlyphSlot fromFace: self ]
		ifNotNil: [ glyph loadFrom: self ].
! !

!FT2Face methodsFor: 'accessing' stamp: 'nk 11/3/2004 11:56'!
faceIndex
	^faceIndex! !

!FT2Face methodsFor: 'private-primitives' stamp: 'nk 11/4/2004 13:35'!
primGetCharMapsInto: array
	<primitive: 'primitiveGetFaceCharMapsIntoArray' module: 'FT2Plugin'>
	^self primitiveFailed.! !

!FT2Face methodsFor: 'rendering' stamp: 'MichaelRueger 12/16/2009 15:42'!
transform: aMatrix

	| matrix delta |
	matrix := IntegerArray new: 4.
	matrix at: 1 put: (aMatrix a11 * 16r10000) rounded.
	matrix at: 2 put: (aMatrix a12 * 16r10000) rounded.
	matrix at: 3 put: (aMatrix a21 * 16r10000) rounded.
	matrix at: 4 put: (aMatrix a22 * 16r10000) rounded.

	delta := IntegerArray new: 2.
	delta at: 1 put: (aMatrix a13 * 64) rounded. 
	delta at: 2 put: (aMatrix a23 * 64) rounded.
	self primSetTransform: matrix delta: delta.
! !

!FT2Face methodsFor: 'accessing' stamp: 'nk 11/3/2004 11:56'!
maxAdvanceHeight
	^maxAdvanceHeight! !

!FT2Face methodsFor: 'accessing' stamp: 'nk 11/3/2004 11:56'!
styleName
	^styleName! !

!FT2Face methodsFor: 'accessing' stamp: 'nk 11/3/2004 11:56'!
size
	^size! !

!FT2Face methodsFor: 'rendering' stamp: 'tween 3/22/2006 23:07'!
angle: angle scalePoint: scalePoint offset: aPoint
	| oneX oneY matrix delta |
	oneX := (16r10000 * scalePoint x) asInteger.
	oneY :=  (16r10000 * scalePoint y) asInteger.
	matrix := IntegerArray new: 4.
	angle isZero ifTrue: [
		matrix at: 1 put: oneX.
		matrix at: 4 put: oneY.
	] ifFalse: [
		| phi cos sin |
		phi := angle degreesToRadians.
		cos := (phi sin * oneX) rounded.
		sin := (phi cos * oneY) rounded.
		matrix at: 1 put: sin.
		matrix at: 2 put: cos negated.
		matrix at: 3 put: cos.
		matrix at: 4 put: sin.
 	].
	delta := IntegerArray new: 2.
	delta at: 1 put: (aPoint x * 64) rounded. 
	delta at: 2 put: (aPoint y * 64) rounded.
	self primSetTransform: matrix delta: delta.
! !

!FT2Face methodsFor: 'glyphs' stamp: 'nk 11/3/2004 18:25'!
loadCharacter: index flags: flags
	self primLoadCharacter: index flags: flags.
	glyph
		ifNil: [ glyph := FT2GlyphSlot fromFace: self ]
		ifNotNil: [ glyph loadFrom: self ].
! !

!FT2Face methodsFor: 'accessing' stamp: 'tween 7/24/2006 22:49'!
memoryFaceData
	self subclassResponsibility! !

!FT2Face methodsFor: 'private-primitives' stamp: 'tween 8/2/2006 20:45'!
primTranslateGlyphSlotOutline:  anIntegerArray
	<primitive: 'primitiveTranslateFaceGlyphSlotOutline' module: 'FT2Plugin'>
	^self primitiveFailed.! !

!FT2Face methodsFor: 'rendering' stamp: 'bf 11/19/2005 12:56'!
renderGlyphIntoForm: aForm
	"render the current glyph (selected by loadChar/loadGlyph into the given form (1 or 8 bpp)"
	self primRenderGlyphIntoForm: aForm
! !

!FT2Face methodsFor: 'charmaps' stamp: 'nk 11/3/2004 20:39'!
setCharMap: encodingString
	self primSetCharMap: encodingString.
	self primGetCharMap.
! !

!FT2Face methodsFor: 'glyphs' stamp: 'MichaelRueger 12/16/2009 15:40'!
glyphOfCharacter: aCharacter pixelSize: pixelSize
	"load a glyph with outline, glyph is not scaled "
	| aGlyph |
	self validate.
	self setPixelWidth: pixelSize x height: pixelSize y.
	self loadCharacter: aCharacter asUnicode flags: LoadIgnoreTransform. "load glyph metrics"
	aGlyph := self glyph. " copy because 'face glyph' is only a slot"
	glyph := nil.
	^aGlyph! !

!FT2Face methodsFor: 'accessing' stamp: 'nk 11/3/2004 11:56'!
descender
	^descender! !

!FT2Face methodsFor: 'private-primitives' stamp: 'tween 8/6/2006 15:47'!
primDestroyHandle
	<primitive: 'primitiveDoneFacePreserveFields' module: 'FT2Plugin'>
	^self primitiveFailed.! !

!FT2Face methodsFor: 'accessing' stamp: 'nk 11/3/2004 11:56'!
underlinePosition
	^underlinePosition! !

!FT2Face methodsFor: 'accessing' stamp: 'nk 11/3/2004 11:56'!
unitsPerEm
	^unitsPerEm! !

!FT2Face methodsFor: 'rendering' stamp: 'tween 8/2/2006 10:05'!
angle: angle scale: scale offset: aPoint slant: slant
	| one matrix delta slantOne |
	one := (16r10000 * scale) asInteger.
	slantOne := (16r10000 * scale* slant) asInteger.
	matrix := IntegerArray new: 4.
	angle isZero ifTrue: [
		matrix at: 1 put: one.
		matrix at: 2 put: slantOne.
		matrix at: 4 put: one.
	] ifFalse: [
		| phi cos sin |
		phi := angle degreesToRadians.
		cos := (phi sin * one) rounded.
		sin := (phi cos * one) rounded.
		matrix at: 1 put: sin.
		matrix at: 2 put: cos negated.
		matrix at: 3 put: cos.
		matrix at: 4 put: sin.
 	].
	delta := IntegerArray new: 2.
	delta at: 1 put: (aPoint x * 64) rounded. 
	delta at: 2 put: (aPoint y * 64) rounded.
	self primSetTransform: matrix delta: delta.
! !

!FT2Face methodsFor: 'initialize-release' stamp: 'tween 8/12/2006 10:01'!
newFaceFromExternalMemory: aFreeTypeExternalMemory index: anInteger
	| memSize |

	aFreeTypeExternalMemory validate.
	memSize := aFreeTypeExternalMemory bytes size.
	[self 
		primNewFaceFromExternalMemory: aFreeTypeExternalMemory 
		size: memSize 
		index: anInteger]
			on: FT2Error 
			do:[:e |"need to do something here?"].
	self isValid ifTrue:[self class register: self]! !

!FT2Face methodsFor: 'private-primitives' stamp: 'jl 5/29/2006 15:52'!
primHasKerning
	<primitive: 'primitiveHasKerning' module: 'FT2Plugin'>
	^self primitiveFailed.! !

!FT2Face methodsFor: 'private-primitives' stamp: 'tween 8/2/2006 20:45'!
primTransformGlyphSlotOutline:  anIntegerArray
	<primitive: 'primitiveTransformFaceGlyphSlotOutline' module: 'FT2Plugin'>
	^self primitiveFailed.! !

!FT2GlyphRenderer commentStamp: '<historical>'!
i am used to render freetype glyphs using balloon primitives.!
!FT2GlyphRenderer methodsFor: 'initailize-release' stamp: 'IgorStasenko 11/21/2011 16:32'!
initForFont: aFont surface: aSurface

	self assert: (aFont class == FreeTypeFont).
	
	surface := aSurface.
	font := aFont.
	slot := SimpleTextGlyphInfo new.
	
	pixelSize := font pixelSize rounded.

	blt := BitBlt toForm: surface form.

	self loadSurfaceTransform.

	colorMap := Bitmap new: 256.
	
	blt 
		sourceForm: form;
		sourceX: 0;
		sourceY: 0;
		destOrigin: 0@0;
		sourceOrigin: 0@0;
		halftoneForm: nil;
		combinationRule: 24;
		width: form width;
		height: form height;
		colorMap: colorMap;
		clipRect: surface clipRect.
	
	translation := IntegerArray new: 2.
! !

!FT2GlyphRenderer methodsFor: 'accessing' stamp: 'IgorStasenko 10/19/2011 15:37'!
form
	^ form! !

!FT2GlyphRenderer methodsFor: 'private' stamp: 'IgorStasenko 11/7/2011 13:45'!
setPosition: aPoint advance: advancePt baseline: baselineOffset
	"aPoint is a text origin in user's coordinate system,
	and andvance is accumulated advance came from another renderer instance, expressed in surface's coordinate system"

	| pt offset |
	
	offset :=  baselineOffset - font getPreciseAscent "(font face ascender  * pixelSize / font face unitsPerEm)".

	pt := aPoint + (0@offset).
	pt := surface pathTransform transform: pt.
	origin := pt.
	pt := pt + advancePt.
	
	"remember the origin, so on #getAdvance , we will answer the current advance for renderer in surface coordinate system"
	
"	2 raisedTo: 6 "
	penX := (pt x * 64) rounded.
	penY := (pt y * 64) rounded.

! !

!FT2GlyphRenderer methodsFor: 'rendering' stamp: 'IgorStasenko 11/7/2011 13:45'!
renderGlyphsIn: text from: start to: stop
	| face |
	face := font face.
"	face
		setPixelWidth: pixelSize height: pixelSize.
"
	start to: stop do: [:i | | bx by |
		
		bx := penX + bitmapX.
		by := penY + bitmapY.

		"add a small shift, to incorporate subpixel position"
		
		translation at: 1 put: descend x + (bx bitAnd: 2r111111).
		translation at: 2 put: descend y - (by bitAnd: 2r111111). 

		face primSetTransform: matrix delta: translation.

		self loadUnicode: (text at: i) asUnicode.
	
		self clearBitmap.
		face renderGlyphIntoForm: form.

		blt
			destX: bx >> 6;
			destY: by >> 6;
			copyBits.

	"increment x by horizontal advance"
		penX := penX + slot advanceX.
		penY := penY - slot advanceY.

	].

! !

!FT2GlyphRenderer methodsFor: 'private' stamp: 'IgorStasenko 7/12/2011 20:11'!
loadSlotInfo
	slot loadFrom: font face.! !

!FT2GlyphRenderer methodsFor: 'private' stamp: 'FernandoOlivero 9/9/2013 19:35'!
pixelValue32Of: aColor 
	^ aColor pixelWordForDepth: 32! !

!FT2GlyphRenderer methodsFor: 'accessing' stamp: 'FernandoOlivero 9/9/2013 19:36'!
setColor: color
	"Set the color which will be used to render glyphs."
	
	| clr rgb alpha |
	currentColor = color ifTrue: [ ^ self ].
	currentColor := color.
	clr := self pixelValue32Of: color. 
	rgb := clr bitAnd: 16rFFFFFF.
	alpha := clr >> 24.
	
 	0 to: 255 do:[:i | | a |
		a :=  (i+1) * alpha bitAnd: 16rFF00.
		colorMap at: i+1 put: ( (a<<16) + rgb ).
	].

"	colorMap at: 1 put: (Color red  alpha: 0.1) pixelValue32."
! !

!FT2GlyphRenderer methodsFor: 'private' stamp: 'IgorStasenko 11/7/2011 14:25'!
loadSurfaceTransform
	| m mt org xaxis yaxis sum xmin xmax ymin ymax formW formH fix face bbox |
	
	face := font face.

	face 
		setPixelWidth: pixelSize height: pixelSize.
	
	bbox := face bbox.
	m := surface pathTransform copy transposed.

	org := m transform: 0@0.
	xaxis := (m transform: bbox right - bbox left * pixelSize / face unitsPerEm @ 0) - org.
	yaxis := (m transform: 0 @ (bbox bottom - bbox top * pixelSize / face unitsPerEm)) - org.
	sum := xaxis + yaxis.
	
	xmin := 0 min: ((xaxis x min: yaxis x) min: sum x).
	ymin := 0 min: ((xaxis y min: yaxis y) min: sum y).
	xmax := 0 max: ((xaxis x max: yaxis x) max: sum x).
	ymax := 0 max: ((xaxis y max: yaxis y) max: sum y).

	formW := (xmax - xmin) ceiling + 1.
	formH := (ymax - ymin) ceiling  + 1.

" freetype 'zero' points to bottom-left point on form" 

	"calculate bitmap translation relative to top-left corner of glyph"
	bitmapX := (yaxis x negated + xmin * 64.0) rounded.
	bitmapY := (xaxis y negated + ymin * 64.0) rounded.

	descend := 0 @  ((face bbox height -  face bbox bottom  * pixelSize / face unitsPerEm) +1).
	descend := (m transform: descend) - org.
	descend := descend + (xmin negated@(ymin negated)).
	descend := (descend * 64 ) rounded.

	form := Form extent: formW @ formH depth: 8.

	blt 
		sourceForm: form;
		width: form width;
		height: form height.

	"prepare transformation matrix for freetype"
	
	matrix := IntegerArray new: 4.

	"values in matrix are 16.16 fixed point floating values" 
	fix := 65536. "(2 raisedTo: 16)."
	
	matrix 
		at: 1 put: (m sx * fix) rounded;
		at: 2 put: (m shx * fix) rounded;
		at: 3 put: (m shy * fix) rounded;
		at: 4 put: (m sy * fix) rounded.

! !

!FT2GlyphRenderer methodsFor: 'private' stamp: 'IgorStasenko 10/25/2011 18:40'!
loadUnicode: unicode

	| ext hintingFlags flags arr face |
	
	face := font face.

"	hintingFlags := FreeTypeSettings current hintingFlags."
	flags :=  LoadNoBitmap bitOr: 2 "hintingFlags".
"	bitOr:( LoadIgnoreTransform  bitOr: 2 ). "
	face primLoadCharacter: unicode flags: flags.

	self loadSlotInfo.
! !

!FT2GlyphRenderer methodsFor: 'private' stamp: 'IgorStasenko 10/19/2011 15:31'!
clearBitmap
	
	form bits atAllPut: 0.
! !

!FT2GlyphRenderer methodsFor: 'accessing' stamp: 'IgorStasenko 10/25/2011 18:29'!
getAdvance
	"aPoint is a text origin in user's coordinate system,
	and anvance is accumulated advance came from another renderer instance, expressed in surface's coordinate system"

	| pt |
	pt := (penX/64.0) @ (penY/64.0) - origin.

	^ pt! !

!FT2GlyphRenderer class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/20/2011 10:29'!
forFont: aFont surface: aSurface
	^ self new initForFont: aFont surface: aSurface! !

!FT2GlyphSlot commentStamp: '<historical>'!
Do not rearrange these fields!!

face -- the FT2Face that owns this FT2GlyphSlot.


Note that even when the glyph image is transformed, the metrics are not.

linearHoriAdvance -- For scalable formats only, this field holds the
linearly scaled horizontal advance width for the glyph (i.e. the scaled
and unhinted value of the hori advance).  This can be important to
perform correct WYSIWYG layout.

Note that this value is expressed by default in 16.16 pixels. However,
when the glyph is loaded with the FT_LOAD_LINEAR_DESIGN flag, this field
contains simply the value of the advance in original font units.

linearVertAdvance -- For scalable formats only, this field holds the
linearly scaled vertical advance height for the glyph.  See
linearHoriAdvance for comments.

advance -- This is the transformed advance width for the glyph.

format -- This field indicates the format of the image contained in the
glyph slot.  Typically FT_GLYPH_FORMAT_BITMAP, FT_GLYPH_FORMAT_OUTLINE,
and FT_GLYPH_FORMAT_COMPOSITE, but others are possible.

bitmap -- This field is used as a bitmap descriptor when the slot format
is FT_GLYPH_FORMAT_BITMAP.  Note that the address and content of the
bitmap buffer can change between calls of @FT_Load_Glyph and a few other
functions.

bitmap_left -- This is the bitmap's left bearing expressed in integer
pixels.  Of course, this is only valid if the format is
FT_GLYPH_FORMAT_BITMAP.

bitmap_top -- This is the bitmap's top bearing expressed in integer
pixels.  Remember that this is the distance from the baseline to the
top-most glyph scanline, upwards y-coordinates being *positive*.

outline -- The outline descriptor for the current glyph image if its
format is FT_GLYPH_FORMAT_OUTLINE.

num_subglyphs -- The number of subglyphs in a composite glyph.  This
field is only valid for the composite glyph format that should normally
only be loaded with the @FT_LOAD_NO_RECURSE flag.  For now this is
internal to FreeType.

subglyphs -- An array of subglyph descriptors for composite glyphs.
There are `num_subglyphs' elements in there.  Currently internal to
FreeType.

control_data -- Certain font drivers can also return the control data
for a given glyph image (e.g.  TrueType bytecode, Type 1 charstrings,
etc.).  This field is a pointer to such data.

control_len -- This is the length in bytes of the control data.

other -- Really wicked formats can use this pointer to present their own
glyph image to client apps.  Note that the app will need to know about
the image format.

width, height, hBearingX, hBearingY, hAdvance, vBearingX, vBearingY, vAdvance 
-- The metrics of the last loaded glyph in the slot.  The
returned values depend on the last load flags (see the @FT_Load_Glyph
API function) and can be expressed either in 26.6 fractional pixels or
font units.
!
!FT2GlyphSlot methodsFor: 'accessing-convenience' stamp: 'tween 3/11/2007 08:56'!
roundedPixelLinearAdvance
	"Answer the scaled linearAdvance, rounded to whole pixels"
	^linearHorizontalAdvance  rounded @ linearVerticalAdvance rounded
! !

!FT2GlyphSlot methodsFor: 'accessing-convenience' stamp: 'bf 11/19/2005 17:16'!
advance
	^advanceX@advanceY! !

!FT2GlyphSlot methodsFor: 'private' stamp: 'nk 11/3/2004 17:58'!
primLoadFrom: anFT2Face
	<primitive: 'primitiveLoadGlyphSlotFromFace' module: 'FT2Plugin'>
	^self primitiveFailed.! !

!FT2GlyphSlot methodsFor: 'accessing-fields' stamp: 'nk 11/3/2004 12:11'!
advanceX
	^advanceX! !

!FT2GlyphSlot methodsFor: 'accessing-fields' stamp: 'bf 11/20/2005 14:53'!
width
	^width! !

!FT2GlyphSlot methodsFor: 'accessing-fields' stamp: 'MichaelRueger 12/16/2009 15:10'!
outline
	^outline! !

!FT2GlyphSlot methodsFor: 'accessing-fields' stamp: 'nk 11/3/2004 12:11'!
linearVerticalAdvance
	^linearVerticalAdvance! !

!FT2GlyphSlot methodsFor: 'accessing-convenience' stamp: 'bf 11/20/2005 14:56'!
hBearing
	^hBearingX@hBearingY! !

!FT2GlyphSlot methodsFor: 'accessing-fields' stamp: 'bf 11/20/2005 14:52'!
hBearingY
	^hBearingY! !

!FT2GlyphSlot methodsFor: 'accessing-fields' stamp: 'nk 11/3/2004 12:11'!
advanceY
	^advanceY! !

!FT2GlyphSlot methodsFor: 'accessing-convenience' stamp: 'tween 8/5/2007 11:14'!
linearAdvance
	^"("(linearHorizontalAdvance @ linearVerticalAdvance) "* 2540) rounded"
! !

!FT2GlyphSlot methodsFor: 'accessing-fields' stamp: 'bf 11/20/2005 14:52'!
hBearingX
	^hBearingX! !

!FT2GlyphSlot methodsFor: 'accessing-fields' stamp: 'bf 11/20/2005 14:53'!
height
	^height! !

!FT2GlyphSlot methodsFor: 'accessing-fields' stamp: 'MichaelRueger 12/16/2009 15:00'!
outline: anOutline
	outline := anOutline! !

!FT2GlyphSlot methodsFor: 'accessing-convenience' stamp: 'bf 11/20/2005 14:42'!
extent
	^width@height! !

!FT2GlyphSlot methodsFor: 'accessing-fields' stamp: 'nk 11/3/2004 12:11'!
linearHorizontalAdvance
	^linearHorizontalAdvance! !

!FT2GlyphSlot methodsFor: 'accessing-fields' stamp: 'nk 11/3/2004 12:11'!
bitmapLeft
	^bitmapLeft! !

!FT2GlyphSlot methodsFor: 'private' stamp: 'StephaneDucasse 3/17/2010 20:56'!
loadFrom: anFT2Face
	face := anFT2Face.
	self primLoadFrom: anFT2Face.
	format := ((Smalltalk isLittleEndian) ifTrue: [ format reversed ] ifFalse: [ format ]) asString.
	linearHorizontalAdvance := linearHorizontalAdvance / 65536.0.
	linearVerticalAdvance isZero ifFalse: [ linearVerticalAdvance := linearVerticalAdvance / 65536.0 ].
	advanceX := advanceX bitShift: -6.
	advanceY isZero ifFalse: [ advanceY := advanceY bitShift: -6 ].
	width := width + 63 bitShift: -6. "round up"
	height := height + 63 bitShift: -6. "round up"
	hBearingX := hBearingX bitShift: -6.
	hBearingY := hBearingY bitShift: -6.
	hAdvance := hAdvance bitShift: -6.
	vBearingX := vBearingX bitShift: -6.
	vBearingY := vBearingY bitShift: -6.
	vAdvance := vAdvance bitShift: -6.! !

!FT2GlyphSlot methodsFor: 'accessing-fields' stamp: 'nk 11/3/2004 12:11'!
format
	^format! !

!FT2GlyphSlot methodsFor: 'accessing-fields' stamp: 'nk 11/3/2004 12:11'!
bitmapTop
	^bitmapTop! !

!FT2GlyphSlot class methodsFor: 'instance creation' stamp: 'nk 11/3/2004 17:38'!
fromFace: anFT2Face
	^(super new)
		loadFrom: anFT2Face;
		yourself.! !

!FT2Handle commentStamp: '<historical>'!
handle holds a (typically 32-bit) pointer to an externally managed object.!
!FT2Handle methodsFor: 'error handling' stamp: 'nk 11/3/2004 13:51'!
errorCode
	<primitive: 'primitiveErrorCode' module: 'FT2Plugin'>
	^self primitiveFailed! !

!FT2Handle methodsFor: 'comparing' stamp: 'Igor.Stasenko 10/12/2010 19:48'!
hash
	^ handle hash! !

!FT2Handle methodsFor: 'private' stamp: 'IgorStasenko 10/9/2012 18:54'!
destroyHandle
	"remove receiver from finalization registry, so #finalize won't try to free handle again" 
	self class deregister: self. 

	self pvtDestroyHandle.
! !

!FT2Handle methodsFor: 'finalization' stamp: 'IgorStasenko 10/15/2012 17:07'!
finalize
	"If session has changed, and startup is not yet done, we do not attempt 
	to free external resources"
	Session == Smalltalk session ifFalse: [ ^ self ].
	self pvtDestroyHandle.
! !

!FT2Handle methodsFor: 'private' stamp: 'IgorStasenko 10/9/2012 18:51'!
pvtDestroyHandle
	"This should only be sent from the finalizer."
	handle ifNil: [ ^self ].
	
	self primDestroyHandle.
	self beNull.
! !

!FT2Handle methodsFor: 'error handling' stamp: 'nk 11/4/2004 13:32'!
primitiveFailed
	^self primitiveFailed: 'Freetype2 primitive failed'! !

!FT2Handle methodsFor: 'private' stamp: 'nk 11/3/2004 16:10'!
beNull
	handle := nil.! !

!FT2Handle methodsFor: 'private' stamp: 'nk 11/3/2004 21:19'!
handle
	^handle! !

!FT2Handle methodsFor: 'error handling' stamp: 'nk 11/3/2004 21:07'!
errorString
	<primitive: 'primitiveErrorString' module: 'FT2Plugin'>
	^self primitiveFailed! !

!FT2Handle methodsFor: 'initialization' stamp: 'nk 3/11/2005 18:44'!
initialize
	self shouldNotImplement.! !

!FT2Handle methodsFor: 'private' stamp: 'nk 11/3/2004 12:21'!
primDestroyHandle
	self subclassResponsibility! !

!FT2Handle methodsFor: 'comparing' stamp: 'Igor.Stasenko 10/12/2010 19:47'!
= anObject
	^ (self class == anObject class) and: [ handle = anObject handle ]! !

!FT2Handle methodsFor: 'printing' stamp: 'ClementBera 7/26/2013 16:42'!
printOn: aStream
	| handleHex |
	super printOn: aStream.
	handle ifNil: [ ^aStream nextPutAll: '<nil>' ].
	handleHex := (handle unsignedLongAt: 1 bigEndian: Smalltalk isBigEndian) printStringHex.
	aStream nextPutAll: '<0x'; nextPutAll: handleHex; nextPut: $>.! !

!FT2Handle methodsFor: 'printing' stamp: 'nk 3/17/2005 16:40'!
isValid
	^handle notNil and: [ handle anySatisfy: [ :b | b isZero not ] ]! !

!FT2Handle methodsFor: 'error handling' stamp: 'nk 11/4/2004 13:33'!
primitiveFailed: aString
	^FT2Error new
		signal: aString! !

!FT2Handle class methodsFor: 'error reporting' stamp: 'nk 11/3/2004 13:51'!
errorCode
	<primitive: 'primitiveErrorCode' module: 'FT2Plugin'>
	^self primitiveFailed! !

!FT2Handle class methodsFor: 'error reporting' stamp: 'nk 11/3/2004 15:50'!
moduleErrorCode
	<primitive: 'primitiveModuleErrorCode' module: 'FT2Plugin'>
	^self primitiveFailed! !

!FT2Handle class methodsFor: 'private-handle registry' stamp: 'IgorStasenko 10/9/2012 18:50'!
register: anFT2Handle

	self registry add: anFT2Handle.! !

!FT2Handle class methodsFor: 'error reporting' stamp: 'nk 11/3/2004 15:49'!
errorString
	<primitive: 'primitiveErrorString' module: 'FT2Plugin'>
	^self primitiveFailed! !

!FT2Handle class methodsFor: 'class initialization' stamp: 'IgorStasenko 10/9/2012 17:50'!
initialize
	"FT2Handle initialize"

	Smalltalk removeFromShutDownList: self.
	Smalltalk removeFromStartUpList: self. "in case it was added by earlier version"
	Smalltalk addToStartUpList: self.
! !

!FT2Handle class methodsFor: 'system startup' stamp: 'IgorStasenko 10/9/2012 18:51'!
clearRegistry

	self registry
		do: [:each | each beNull ];
		removeAll.! !

!FT2Handle class methodsFor: 'private-handle registry' stamp: 'IgorStasenko 10/9/2012 18:50'!
deregister: anFT2Handle

	self registry remove: anFT2Handle ifAbsent: nil.! !

!FT2Handle class methodsFor: 'private-handle registry' stamp: 'Igor.Stasenko 10/12/2010 19:45'!
registry
	^Registry ifNil: [ Registry := WeakRegistry new]! !

!FT2Handle class methodsFor: 'initialize-release' stamp: 'nk 11/3/2004 21:00'!
unload
	Smalltalk removeFromStartUpList: self.
	Smalltalk removeFromShutDownList: self.
! !

!FT2Handle class methodsFor: 'system startup' stamp: 'IgorStasenko 10/15/2012 17:08'!
startUp: booting
	booting ifFalse: [ ^ self ].
	
	self clearRegistry. 
	"update session"
	Session := Smalltalk session
! !

!FT2Library commentStamp: '<historical>'!
This is a wrapper for the global 'library' in the plugin.
It is provided for the use of Cairo APIs that take an FT_Library argument.!
!FT2Library methodsFor: 'private-primitives' stamp: 'tween 3/17/2007 14:18'!
current
	^[self primCurrentLibrary] on: Error do: [:e | nil]! !

!FT2Library methodsFor: 'private-primitives' stamp: 'nk 11/4/2004 13:32'!
primCurrentLibrary
	<primitive: 'primitiveLibraryHandle' module: 'FT2Plugin'>
	^self primitiveFailed! !

!FT2Library methodsFor: 'private-primitives' stamp: 'nk 11/4/2004 13:27'!
destroyHandle
	"This is not a managed handle, but a global. Do nothing."! !

!FT2Library class methodsFor: 'instance creation' stamp: 'nk 3/17/2005 14:19'!
current
	^[ (self basicNew)
		current ] on: FT2Error do: [ :ex | ex return: nil ].! !

!FT2MemoryFaceData commentStamp: 'TorstenBergmann 2/4/2014 22:06'!
Freetype 2 MemoryFace data  !
!FT2MemoryFaceData methodsFor: 'accessing' stamp: 'tween 7/24/2006 23:04'!
bytes
	^bytes
	! !

!FT2MemoryFaceData methodsFor: 'primitives' stamp: 'tween 7/24/2006 22:32'!
primMalloc: aByteArray
	"copy aByteArray into newly allocated, external memory, and store the
	address of that memory in the receiver's handle"
	<primitive: 'primitiveMallocMemoryFaceData' module: 'FT2Plugin'>
	^self primitiveFailed! !

!FT2MemoryFaceData methodsFor: 'validation' stamp: 'tween 7/31/2006 21:48'!
validate
	self isValid 
		ifFalse: [
			bytes ifNotNil:[
				[self primMalloc: bytes]
					on: FT2Error 
					do:[:e |"need to do something here?"].
				self isValid ifTrue:[self class register: self]]]! !

!FT2MemoryFaceData methodsFor: 'primitives' stamp: 'tween 7/24/2006 21:52'!
primDestroyHandle
	<primitive: 'primitiveFreeMemoryFaceData' module: 'FT2Plugin'>
	^self primitiveFailed.! !

!FT2MemoryFaceData methodsFor: 'initialize-release' stamp: 'tween 7/24/2006 21:53'!
free
	^self destroyHandle! !

!FT2MemoryFaceData methodsFor: 'accessing' stamp: 'tween 7/24/2006 22:43'!
bytes: aByteArray

	bytes := aByteArray.
	! !

!FT2MemoryFaceData class methodsFor: 'instance creation' stamp: 'tween 8/6/2006 11:11'!
bytes: aByteArray
	| answer |
	answer := self basicNew
		bytes: aByteArray;
		yourself.
	^answer! !

!FT2Outline commentStamp: '<historical>'!
@instVar: contoursSize - The number of contours in the outline.
@instVar: pointsSize - The number of points in the outline.
@instVar: points - an array of  26.6 fixed point integer pairs giving the outline's point coordinates.

@instVar: tags	- an array of pointsSize bytes, giving each outline point's type. 

(counting from 0)

If bit 0 is unset, the point is 'off' the curve, i.e., a Bézier control point, while it is 'on' when set.

Bit 1 is meaningful for 'off' points only. If set, it indicates a third-order Bézier arc control point; and a second-order control point if unset.

@instVar: contours - an array of contoursSize shorts, giving the end point of each contour within the outline. For example, the first contour is defined by the points '0' to 'contours[0]', the second one is defined by the points 'contours[0]+1' to 'contours[1]', etc.

@instVar: flags - a set of bit flags used to characterize the outline and give hints to the scan-converter and hinter on how to convert/grid-fit it.!
!FT2Outline methodsFor: 'accessing' stamp: 'jl 5/24/2006 15:19'!
contoursCollection
	"returns a list of contours with tag => points list pairs"
	| allPoints result start end |
	allPoints := self pointCollection.
	
	result := OrderedCollection new.
	start := 1.
	"no normal iteration because contours size can be bigger than contourSize"
	1 to: contoursSize do: [ :i |
		end := (contours at: i) + 1. "c converion"
		result add: ((tags copyFrom: start to: end) ->  (allPoints copyFrom: start to: end)).
		start := end + 1.
	].

	^result

		

		
! !

!FT2Outline methodsFor: 'private' stamp: 'jl 5/24/2006 13:58'!
allocateArrays
	" allocate the arrays for the primLoadArraysFrom:"
	points := 	IntegerArray new: pointsSize * 2.
	tags := 		ByteArray new: pointsSize.
	contours := 	ShortIntegerArray new: contoursSize.! !

!FT2Outline methodsFor: 'accessing' stamp: 'jl 5/24/2006 14:26'!
pointCollection

	^(1 to: pointsSize * 2 by: 2) collect: [ :i | ((points at: i) / 64) @ ((points at: i + 1) / 64)]

		

		
! !

!FT2Outline methodsFor: 'private' stamp: 'jl 5/23/2006 17:01'!
primLoadSizesFrom: anFT2Face
	<primitive: 'primitiveLoadOutlineSizesFromFace' module: 'FT2Plugin'>
	^self primitiveFailed.! !

!FT2Outline methodsFor: 'private' stamp: 'jl 5/23/2006 17:01'!
primLoadArraysFrom: anFT2Face
	<primitive: 'primitiveLoadOutlineArraysFromFace' module: 'FT2Plugin'>
	^self primitiveFailed.! !

!FT2Version commentStamp: '<historical>'!
Do not rearrange these fields!!

This is used to report FT2 version information. Its fields must remain unchanged, or you must change FT2Plugin>>primitiveVersion.!
!FT2Version methodsFor: 'primitives' stamp: 'nk 11/3/2004 11:20'!
libraryVersion
	<primitive: 'primitiveVersion' module: 'FT2Plugin'>
	^self primitiveFailed.
! !

!FT2Version methodsFor: 'accessing' stamp: 'nk 3/21/2004 11:03'!
minor
	^minor! !

!FT2Version methodsFor: 'accessing' stamp: 'nk 11/3/2004 11:17'!
patch
	^patch! !

!FT2Version methodsFor: 'printing' stamp: 'nk 11/3/2004 11:22'!
printOn: aStream
	aStream print: major; nextPut: $.; print: minor; nextPut:$.; print: patch.! !

!FT2Version methodsFor: 'accessing' stamp: 'nk 3/21/2004 11:03'!
major
	^major! !

!FT2Version class methodsFor: 'instance creation' stamp: 'nk 11/4/2004 11:10'!
current
	"
	FT2Version current
	"
	^ [(self new)
		libraryVersion;
		yourself] on: Error do: [:ex | ex return: nil]! !

!FTPClient commentStamp: 'mir 5/12/2003 17:55'!
A minimal FTP client program.  Could store all state in inst vars, and use an instance to represent the full state of a connection in progress.  But simpler to do all that in one method and have it be a complete transaction.

Always operates in passive mode (PASV).  All connections are initiated from client in order to get through firewalls.

See ServerDirectory openFTP, ServerDirectory getFileNamed:, ServerDirectory putFile:named: for examples of use.

See TCP/IP, second edition, by Dr. Sidnie Feit, McGraw-Hill, 1997, Chapter 14, p311.!
!FTPClient methodsFor: 'private protocol' stamp: 'mir 2/13/2002 18:06'!
getData

	| dataStream |
	dataStream := RWBinaryOrTextStream on: (String new: 4000).
	self getDataInto: dataStream.
	self closeDataSocket.
	^dataStream contents
! !

!FTPClient methodsFor: 'protocol' stamp: 'mir 3/7/2002 13:36'!
binary
	self sendCommand: 'TYPE I'.
	self lookForCode: 200! !

!FTPClient methodsFor: 'private protocol' stamp: 'michael.rueger 6/16/2009 11:28'!
openPassiveDataConnection
	| portInfo list dataPort remoteHostAddress remoteAddressString |
	self sendCommand: 'PASV'.
	self lookForCode: 227 ifDifferent: [:response | (TelnetProtocolError protocolInstance: self) signal: 'Could not enter passive mode: ' , response].

	portInfo := (self lastResponse findTokens: '()') at: 2.
	list := portInfo findTokens: ','.
	remoteHostAddress := ByteArray
		with: (list at: 1) asNumber
		with: (list at: 2) asNumber
		with: (list at: 3) asNumber
		with: (list at: 4) asNumber.
	remoteAddressString := String streamContents: [:addrStream | remoteHostAddress
		do: [ :each | each printOn: addrStream ]
		separatedBy: [ addrStream nextPut: $. ]].
 	dataPort := (list at: 5) asNumber * 256 + (list at: 6) asNumber.
	self openDataSocket: (NetNameResolver addressForName: remoteAddressString) port: dataPort! !

!FTPClient methodsFor: 'protocol' stamp: 'mir 11/19/2002 19:23'!
getFileNamed: remoteFileName
	| data |
	self openPassiveDataConnection.
	self sendCommand: 'RETR ', remoteFileName.
	[self checkResponse]
		on: TelnetProtocolError
		do: [:ex |
			self closeDataSocket.
			ex pass].
	data := self getData.
	self checkResponse.
	^data
! !

!FTPClient methodsFor: 'private' stamp: 'mir 10/31/2000 16:24'!
dataSocket
	^dataSocket! !

!FTPClient methodsFor: 'protocol' stamp: 'mir 11/13/2002 17:52'!
changeDirectoryTo: newDirName
	self sendCommand: 'CWD ' , newDirName.
	self checkResponse.
! !

!FTPClient methodsFor: 'protocol' stamp: 'mir 11/19/2002 17:10'!
makeDirectory: newDirName
	self sendCommand: 'MKD ' , newDirName.
	self checkResponse.
! !

!FTPClient methodsFor: 'private' stamp: 'mir 11/14/2002 18:14'!
sendStreamContents: aStream
	self dataSocket sendStreamContents: aStream checkBlock: [self checkForPendingError. true]! !

!FTPClient methodsFor: 'protocol' stamp: 'mir 11/14/2002 16:55'!
passive
	self sendCommand: 'PASV'.
	self lookForCode: 227! !

!FTPClient methodsFor: 'protocol' stamp: 'mir 11/19/2002 16:54'!
putFileNamed: filePath as: fileNameOnServer
	"FTP a file to the server."


	| fileStream |
	fileStream := FileStream readOnlyFileNamed: filePath.
	fileStream
		ifNil: [(FileDoesNotExistException fileName: filePath) signal].
	self putFileStreamContents: fileStream as: fileNameOnServer
! !

!FTPClient methodsFor: 'protocol' stamp: 'mir 12/8/2003 16:54'!
putFileStreamContents: fileStream as: fileNameOnServer
	"FTP a file to the server."


	self openPassiveDataConnection.
	self sendCommand: 'STOR ', fileNameOnServer.

	fileStream reset.

	[self sendStreamContents: fileStream]
		ensure: [self closeDataSocket].

	self checkResponse.
	self checkResponse.
! !

!FTPClient methodsFor: 'protocol' stamp: 'mir 10/31/2000 13:12'!
quit
	self sendCommand: 'QUIT'.
	self close! !

!FTPClient methodsFor: 'private' stamp: 'mir 2/19/2002 18:27'!
closeDataSocket
	self dataSocket
		ifNotNil: [
			self dataSocket closeAndDestroy.
			self dataSocket: nil]
! !

!FTPClient methodsFor: 'protocol' stamp: 'mir 11/13/2002 17:50'!
removeFileNamed: remoteFileName
	self sendCommand: 'DELE ', remoteFileName.
	self checkResponse.
! !

!FTPClient methodsFor: 'private protocol' stamp: 'LucFabresse 11/2/2010 22:10'!
lookForCode: code ifDifferent: handleBlock 
	"We are expecting a certain numeric code next.  
	However, in the FTP protocol, multiple lines are allowed.  
	If the response is multi-line, the fourth character of the first line is a  
	$- and the last line repeats the numeric code but the code is followed by 
	a space. So it's possible that there are more lines left of the last response that 
	we need to throw away. We use peekForAll: so that we don't discard the
	next response that is not a continuation line."

	
	"check for multi-line response"
	(self lastResponse size > 3
			and: [(self lastResponse at: 4) = $-])
		ifTrue: ["Discard continuation lines."
			 | headToDiscard |
			headToDiscard := self lastResponse first: 4.
			[[self stream peekForAll: headToDiscard]
				whileTrue: [self stream nextLine]]
				on: Exception
				do: [:ex | ^handleBlock value: nil]].
	^ super lookForCode: code ifDifferent: handleBlock! !

!FTPClient methodsFor: 'protocol' stamp: 'mir 11/12/2002 18:39'!
loginUser: userName password: passwdString

	self user: userName.
	self password: passwdString.

	self login! !

!FTPClient methodsFor: 'protocol' stamp: 'mir 11/19/2002 16:50'!
getFileList
	| dirList |
	self openPassiveDataConnection.
	self sendCommand: 'NLST'.
	dirList := self getData.
	self checkResponse.
	self checkResponse.
	^dirList
! !

!FTPClient methodsFor: 'protocol' stamp: 'mir 3/7/2002 13:36'!
ascii
	self sendCommand: 'TYPE A'.
	self lookForCode: 200! !

!FTPClient methodsFor: 'protocol' stamp: 'mir 11/19/2002 17:12'!
deleteFileNamed: fileName
	self sendCommand: 'DELE ' , fileName.
	self checkResponse.
! !

!FTPClient methodsFor: 'protocol' stamp: 'mir 11/19/2002 17:11'!
deleteDirectory: dirName
	self sendCommand: 'RMD ' , dirName.
	self checkResponse.
! !

!FTPClient methodsFor: 'protocol' stamp: 'mir 2/20/2002 13:53'!
getDirectory
	| dirList |
	self openPassiveDataConnection.
	self sendCommand: 'LIST'.
	dirList := self getData.
	self checkResponse.
	self checkResponse.
	^dirList
! !

!FTPClient methodsFor: 'protocol' stamp: 'nk 1/26/2005 16:40'!
renameFileNamed: oldFileName to: newFileName
	self sendCommand: 'RNFR ' , oldFileName.
	self lookForCode: 350.
	self sendCommand: 'RNTO ' , newFileName.
	self lookForCode: 250! !

!FTPClient methodsFor: 'protocol' stamp: 'mir 5/9/2003 15:50'!
getFileNamed: remoteFileName into: dataStream
	self openPassiveDataConnection.
	self sendCommand: 'RETR ', remoteFileName.
	[self checkResponse]
		on: TelnetProtocolError
		do: [:ex |
			self closeDataSocket.
			ex pass].
	self getDataInto: dataStream.
	self closeDataSocket.
	self checkResponse! !

!FTPClient methodsFor: 'private protocol' stamp: 'svp 10/28/2003 11:06'!
get: limit dataInto: dataStream
	"Reel in data until the server closes the connection or the limit is reached.
	At the same time, watch for errors on otherSocket."

	| buf bytesRead currentlyRead |
	currentlyRead := 0.
	buf := String new: 4000.
	[currentlyRead < limit and: 
	[self dataSocket isConnected or: [self dataSocket dataAvailable]]]
		whileTrue: [
			self checkForPendingError.
			bytesRead := self dataSocket receiveDataWithTimeoutInto: buf.
			1 to: (bytesRead min: (limit - currentlyRead)) do: [:ii | dataStream nextPut: (buf at: ii)].
			currentlyRead := currentlyRead + bytesRead].
	dataStream reset.	"position: 0."
	^ dataStream! !

!FTPClient methodsFor: 'protocol' stamp: 'mir 10/31/2000 19:03'!
getPartial: limit fileNamed: remoteFileName into: dataStream
	| data |
	self openPassiveDataConnection.
	self sendCommand: 'RETR ', remoteFileName.
	[self checkResponse]
		on: TelnetProtocolError
		do: [:ex |
			self closeDataSocket.
			ex pass].
	data := self get: limit dataInto: dataStream.
	self abortDataConnection.
	^data
! !

!FTPClient methodsFor: 'private' stamp: 'mir 10/31/2000 18:23'!
dataSocket: aSocket
	dataSocket := aSocket! !

!FTPClient methodsFor: 'private' stamp: 'mir 4/7/2003 17:20'!
login

	self user ifNil: [^self].

	["repeat both USER and PASS since some servers require it"
	self sendCommand: 'USER ', self user.

	"331 Password required"
	self lookForCode: 331.
	"will ask user, if needed"
	self sendCommand: 'PASS ', self password.

	"230 User logged in"
	([self lookForCode: 230.]
		on: TelnetProtocolError
		do: [false]) == false
		] whileTrue: [
			(LoginFailedException protocolInstance: self) signal: self lastResponse]

! !

!FTPClient methodsFor: 'private protocol' stamp: 'svp 10/28/2003 11:04'!
getDataInto: dataStream
	"Reel in all data until the server closes the connection.  At the same time, watch for errors on otherSocket.  Don't know how much is coming.  Put the data on the stream."

	| buf bytesRead |
	buf := String new: 4000.
	[self dataSocket isConnected or: [self dataSocket dataAvailable]]
		whileTrue: [
			self checkForPendingError.
			bytesRead := self dataSocket receiveDataWithTimeoutInto: buf.
			1 to: bytesRead do: [:ii | dataStream nextPut: (buf at: ii)]].
	dataStream reset.	"position: 0."
	^ dataStream! !

!FTPClient methodsFor: 'protocol' stamp: 'mir 11/14/2002 17:51'!
openDataSocket: remoteHostAddress port: dataPort
	dataSocket := Socket new.
	dataSocket connectTo: remoteHostAddress port: dataPort! !

!FTPClient methodsFor: 'protocol' stamp: 'mir 2/13/2002 18:05'!
abortDataConnection
	self sendCommand: 'ABOR'.
	self closeDataSocket! !

!FTPClient methodsFor: 'protocol' stamp: 'mir 11/14/2002 16:43'!
pwd
	| result |
	self sendCommand: 'PWD'.
	self lookForCode: 257.
	result := self lastResponse.
	^result copyFrom: (result indexOf: $")+1 to: (result lastIndexOf: $")-1! !

!FTPClient class methodsFor: 'accessing' stamp: 'mir 10/30/2000 20:10'!
defaultPortNumber
	^21! !

!FTPClient class methodsFor: 'accessing' stamp: 'mir 2/25/2002 19:08'!
logFlag
	^#ftp! !

!FTPClient class methodsFor: 'accessing' stamp: 'mir 2/13/2002 17:50'!
rawResponseCodes
	#(200 'Command okay.'
	500 'Syntax error, command unrecognized. This may include errors such as command line too long.'
	501 'Syntax error in parameters or arguments.'
	202 'Command not implemented, superfluous at this site.'
	502 'Command not implemented.'
	503 'Bad sequence of commands.'
	504 'Command not implemented for that parameter.'
	110 'Restart marker reply. In this case, the text is exact and not left to the particular implementation; it must read: MARK yyyy = mmmm Where yyyy is User-process data stream marker, and mmmm server''s equivalent marker (note the spaces between markers and "=").'
	211 'System status, or system help reply.'
	212 'Directory status.'
	213 'File status.'
	214 'Help message. On how to use the server or the meaning of a particular non-standard command. This reply is useful only to the human user.'
	215 'NAME system type. Where NAME is an official system name from the list in the Assigned Numbers document.'
	120 'Service ready in nnn minutes.'

	220 'Service ready for new user.'
	221 'Service closing control connection. Logged out if appropriate.'
	421 'Service not available, closing control connection. This may be a reply to any command if the service knows it must shut down.'
	125 'Data connection already open; transfer starting.'
	225 'Data connection open; no transfer in progress.'
	425 'Can''t open data connection.'
	226 'Closing data connection. Requested file action successful (for example, file transfer or file abort).'
	426 'Connection closed; transfer aborted.'
	227 'Entering Passive Mode (h1,h2,h3,h4,p1,p2).'

	230 'User logged in, proceed.'
	530 'Not logged in.'
	331 'User name okay, need password.'
	332 'Need account for login.'
	532 'Need account for storing files.'
	150 'File status okay; about to open data connection.'
	250 'Requested file action okay, completed.'
	257 '"PATHNAME" created.'
	350 'Requested file action pending further information.'
	450 'Requested file action not taken. File unavailable (e.g., file busy).'
	550 'Requested action not taken. File unavailable (e.g., file not found, no access).'
	451 'Requested action aborted. Local error in processing.'
	551 'Requested action aborted. Page type unknown.'
	452 'Requested action not taken. Insufficient storage space in system.'
	552 'Requested file action aborted. Exceeded storage allocation (for current directory or dataset).'
	553 'Requested action not taken. File name not allowed.')
! !

!FailingTestResourceTestCase commentStamp: 'TorstenBergmann 2/12/2014 23:14'!
SUnit tests for failing test resources!
!FailingTestResourceTestCase methodsFor: 'utility' stamp: 'StephaneDucasse 6/9/2012 22:58'!
clearOuterResourceStateDuring: aBlock
	"Make the resource impossible to make available, then ensure that every test raises a failure but not an error (which its setUp would do if it reached it and the resource were nil)."

	^super clearOuterResourceStateDuring:
		[SimpleTestResource preventAvailabilityDuring:
			[self should: aBlock raise: self defaultTestFailure]]! !

!FallbackMenu commentStamp: '<historical>'!
I appear when there is an error while trying to build a menu from pragmas.

I include items to:
* Debug: give the user an opportunity to see and correct the error
* Explain: why they're seeing a different menu
* Custom: clients can add items to me by implementing #fallbackMenuOn:. Browse implementors for examples.!
!FallbackMenu methodsFor: 'private' stamp: 'SeanDeNigris 6/16/2013 13:48'!
builder: aPragmaMenuBuilder

	builder := aPragmaMenuBuilder.! !

!FallbackMenu methodsFor: 'private' stamp: 'SeanDeNigris 6/14/2013 02:31'!
fallbackMenuExplanations

	| workspace wsBindings |
	wsBindings := Dictionary newFrom: { #menu-> self }.
	workspace := Smalltalk tools workspace
		openContents: '"Something is wrong with this menu. 
To investigate just debug following expression:"
menu debug'.
	workspace
		label: 'Fallback menu explanations';
		setBindings: wsBindings.! !

!FallbackMenu methodsFor: 'menu actions' stamp: 'SeanDeNigris 6/16/2013 14:50'!
debug

	"If we don't reset the builder after debugging, the fallback menu does not appear anymore"
	[ builder menuSpec asMenuMorph ] ensure: [ builder reset ].! !

!FallbackMenu methodsFor: 'private' stamp: 'SeanDeNigris 6/16/2013 13:59'!
menu
	"Build the menu that is put up if something is going wrong with the menubuilder"

	| menu |
	menu := UIManager default newMenuIn: ActiveWorld for: self.
	menu addStayUpItem.
	menu add: 'Why you see this menu'
		target: self
		selector: #fallbackMenuExplanations.
	menu add: 'Debug'
		target: self
		selector: #debug.
	menu addLine.
	client fallbackMenuOn: menu.
	^ menu! !

!FallbackMenu methodsFor: 'private' stamp: 'SeanDeNigris 6/16/2013 13:49'!
client: anObject

	client := anObject.! !

!FallbackMenu class methodsFor: 'instance creation' stamp: 'SeanDeNigris 6/16/2013 13:48'!
when: aPragmaMenuBuilder fails: anObject
	
	^ self new
			builder: aPragmaMenuBuilder;
			client: anObject;
			menu.! !

!False commentStamp: '<historical>'!
False defines the behavior of its single instance, false -- logical negation. Notice how the truth-value checks become direct message sends, without the need for explicit testing.

Be aware however that most of these methods are not sent as real messages in normal use. Most are inline coded by the compiler as test and jump bytecodes - avoiding the overhead of the full message sends. So simply redefining these methods here will have no effect.!
!False methodsFor: 'controlling' stamp: ''!
and: alternativeBlock 
	"Nonevaluating conjunction -- answer with false since the receiver is false."

	^self! !

!False methodsFor: 'logical operations' stamp: ''!
| aBoolean 
	"Evaluating disjunction (OR) -- answer with the argument, aBoolean."

	^aBoolean! !

!False methodsFor: 'controlling' stamp: ''!
ifTrue: alternativeBlock 
	"Since the condition is false, answer the value of the false alternative, 
	which is nil. Execution does not actually reach here because the
	expression is compiled in-line."

	^nil! !

!False methodsFor: 'controlling' stamp: ''!
ifTrue: trueAlternativeBlock ifFalse: falseAlternativeBlock 
	"Answer the value of falseAlternativeBlock. Execution does not
	actually reach here because the expression is compiled in-line."

	^falseAlternativeBlock value! !

!False methodsFor: 'controlling' stamp: ''!
ifFalse: alternativeBlock 
	"Answer the value of alternativeBlock. Execution does not actually
	reach here because the expression is compiled in-line."

	^alternativeBlock value! !

!False methodsFor: 'controlling' stamp: ''!
or: alternativeBlock 
	"Nonevaluating disjunction -- answer value of alternativeBlock."

	^alternativeBlock value! !

!False methodsFor: 'printing' stamp: ''!
printOn: aStream 

	aStream nextPutAll: 'false'! !

!False methodsFor: 'logical operations' stamp: 'md 7/30/2005 18:05'!
& aBoolean 
	"Evaluating conjunction -- answer false since receiver is false."

	^self! !

!False methodsFor: 'logical operations' stamp: 'CamilloBruni 8/1/2012 16:25'!
xor: aBoolean
	^aBoolean value! !

!False methodsFor: 'logical operations' stamp: ''!
not
	"Negation -- answer true since the receiver is false."

	^true! !

!False methodsFor: 'controlling' stamp: ''!
ifFalse: falseAlternativeBlock ifTrue: trueAlternativeBlock 
	"Answer the value of falseAlternativeBlock. Execution does not
	actually reach here because the expression is compiled in-line."

	^falseAlternativeBlock value! !

!False methodsFor: 'converting' stamp: 'IgorStasenko 12/28/2012 15:09'!
asBit

	^ 0! !

!False class methodsFor: '*Fuel' stamp: 'MartinDias 2/21/2013 12:51'!
materializeFrom: aDecoder
	"Answer my unique instance"

	^ false! !

!FalseTest commentStamp: 'TorstenBergmann 2/5/2014 08:50'!
SUnit tests for false/False class!
!FalseTest methodsFor: 'tests controlling' stamp: 'sd 6/5/2005 09:04'!
testOr

	self assert: (false or: ['alternativeBlock']) = 'alternativeBlock'.! !

!FalseTest methodsFor: 'tests controlling' stamp: 'sd 6/5/2005 09:03'!
testIfFalse
	
	self assert: ((false ifFalse: ['alternativeBlock']) = 'alternativeBlock'). ! !

!FalseTest methodsFor: 'tests controlling' stamp: 'sd 6/5/2005 09:03'!
testIfFalseIfTrue

	self assert: (false ifFalse: ['falseAlternativeBlock'] 
                      ifTrue: ['trueAlternativeBlock']) = 'falseAlternativeBlock'. ! !

!FalseTest methodsFor: 'tests controlling' stamp: 'sd 6/5/2005 09:03'!
testIfTrueIfFalse

	self assert: (false ifTrue: ['trueAlternativeBlock'] 
                      ifFalse: ['falseAlternativeBlock']) = 'falseAlternativeBlock'. ! !

!FalseTest methodsFor: 'tests controlling' stamp: 'FabrizioPerin 3/13/2010 15:23'!
testAnd

	self deny: (false and: ['alternativeBlock']).! !

!FalseTest methodsFor: 'tests logical operations' stamp: 'FabrizioPerin 3/13/2010 15:24'!
testOR

	self assert: (false | true).
	self deny: (false | false).! !

!FalseTest methodsFor: 'tests logical operations' stamp: 'FabrizioPerin 3/13/2010 15:23'!
testAND

	self deny: (false & true).
	self deny: (false & false).! !

!FalseTest methodsFor: 'tests logical operations' stamp: 'StephaneDucasse 3/5/2010 15:32'!
testNot

	self assert: (false not).! !

!FalseTest methodsFor: 'tests printing' stamp: 'sd 6/5/2005 09:04'!
testPrintOn

	self assert: (String streamContents: [:stream | false printOn: stream]) = 'false'. ! !

!FalseTest methodsFor: 'tests instance creation' stamp: 'StephaneDucasse 6/9/2012 22:58'!
testNew

	self should: [False new] raise: self defaultTestError ! !

!FalseTest methodsFor: 'tests logical operations' stamp: 'Md 11/18/2010 18:49'!
testXor
	self assert: (false xor: true) = true.
	self assert: (false xor: false) = false.
	self assert: (false xor: [true]) = true.
	self assert: (false xor: [false]) = false.! !

!FalseTest methodsFor: 'tests converting' stamp: 'StephaneDucasse 2/2/2010 13:49'!
testAsBit

       self assert: (false asBit = 0).! !

!FalseTest methodsFor: 'tests controlling' stamp: 'GabrielOmarCotelli 5/25/2010 21:22'!
testIfTrue
	self
		assert:
			(false
				ifTrue: [ 'alternativeBlock' ]) isNil! !

!FastDraggingFrameMorph commentStamp: 'AlainPlantec 2/22/2012 23:23'!
I represents the windows frame for window dragging or resizing when fast dragging or fast resizing is wanted (when  UITheme currentSettings fastDragging is set to true).
For window resizing, I'm created by a corner or an edge grip when the mouse is clicked on it (see SystemWindow>>doFastWindowReframe:). For window dragging, I'm created when the top window bar is clicked (see SystemWindow>>doFastFrameDrag:).  I'm always created with the same bounds as the target window bounds. The mouse focus is given to me and my bounds are changed while the hand is moving. On mouse up, the window bounds is set to my own bounds and then I'm deleted.

Instance Variables
	location:		<Symbol>
	startGap:		<Point>
	target:		<SystemWindow>

location
	- The symbol representing the corner or the edge (#topLeft, #top, #topRight .... or #left). I'm set to nil for window dragging

startGap
	- For window dragging, keep track of the distance between the window top bar first click location and the window position

target
	- The window to be resized or dragged
!
!FastDraggingFrameMorph methodsFor: 'accessing' stamp: 'FernandoOlivero 9/10/2013 09:57'!
target: aSystemWindow 
	target := aSystemWindow.
	self color: (target paneColor alpha: 0.35).
	self bounds: aSystemWindow bounds.
	self currentHand newMouseFocus: self! !

!FastDraggingFrameMorph methodsFor: 'initialization' stamp: 'FernandoOlivero 9/10/2013 09:56'!
defaultColor 
	^ Color gray alpha: 0.15.
	! !

!FastDraggingFrameMorph methodsFor: 'event handling' stamp: 'AlainPlantec 2/22/2012 23:17'!
mouseUp: evt 
	target
		ifNotNil: [Display
				deferUpdatesIn: Display boundingBox
				while: [target bounds: self bounds]].
	self delete! !

!FastDraggingFrameMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/22/2012 23:05'!
location: aSymbol
	"The symbol wich represents the corner or the edge grip location (#topLeft, #top ..., #bottomLeft or #left)"
	location := aSymbol! !

!FastDraggingFrameMorph methodsFor: 'event handling' stamp: 'AlainPlantec 2/22/2012 22:12'!
draggedTo: aPoint
	self position: aPoint + startGap
! !

!FastDraggingFrameMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/22/2012 21:51'!
wantsToBeTopmost
	"Answer if the receiver want to be one of the topmost objects in 
	its owner"
	^ true! !

!FastDraggingFrameMorph methodsFor: 'event handling' stamp: 'AlainPlantec 2/22/2012 23:17'!
handlesMouseDown: evt
	^ true! !

!FastDraggingFrameMorph methodsFor: 'event handling' stamp: 'AlainPlantec 2/22/2012 22:18'!
reframedTo: aPoint 
	self
		bounds: (self bounds withSideOrCorner: location setToPoint: aPoint)! !

!FastDraggingFrameMorph methodsFor: 'initialization' stamp: 'FernandoOlivero 9/10/2013 09:56'!
defaultBorderColor 
	^ Color gray ! !

!FastDraggingFrameMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/22/2012 23:06'!
startGap: aPoint
	"APoint is the distance between the window position and the first click position" 
	startGap := aPoint! !

!FastDraggingFrameMorph methodsFor: 'event handling' stamp: 'AlainPlantec 2/22/2012 23:09'!
mouseDown: evt
	"Normally, should not be possible"
	self delete ! !

!FastDraggingFrameMorph methodsFor: 'testing' stamp: 'AlainPlantec 2/22/2012 22:28'!
isForDragging
	^ location isNil! !

!FastDraggingFrameMorph methodsFor: 'event handling' stamp: 'AlainPlantec 2/22/2012 22:29'!
mouseMove: evt
	self isForDragging 
		ifTrue: [self draggedTo: evt position]
		ifFalse: [self reframedTo: evt position]
! !

!FastDraggingFrameMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/22/2012 18:56'!
target
	^ target! !

!FastDraggingFrameMorph methodsFor: 'initialization' stamp: 'FernandoOlivero 9/10/2013 09:56'!
defaultBorderWidth
	^ 2.
	! !

!FastDraggingFrameMorph class methodsFor: 'instance creation' stamp: 'AlainPlantec 2/23/2012 00:16'!
forResizing: aWindow fromLocation: aSideOrCorner
	| b  |
	b := self new.	
	b target: aWindow.
	b location: aSideOrCorner.
	^ b ! !

!FastDraggingFrameMorph class methodsFor: 'instance creation' stamp: 'AlainPlantec 2/22/2012 23:34'!
forDragging: aWindow clickedAt: aPoint
	| b |
	b := self new.
	b target: aWindow.
	b startGap: aWindow topLeft - aPoint.
	^ b! !

!FastInflateStream commentStamp: '<historical>'!
This class adds the following optimizations to the basic Inflate decompression:

a) Bit reversed access
If we want to fetch the bits efficiently then we have them in the wrong bit order (e.g., when we should fetch 2r100 we would get 2r001). But since the huffman tree lookup determines the efficiency of the decompression, reversing the bits before traversal is expensive. Therefore the entries in each table are stored in REVERSE BIT ORDER. This is achieved by a reverse increment of the current table index in the huffman table construction phase (see method increment:bits:). According to my measures this speeds up the implementation by about 30-40%.

b) Inplace storage of code meanings and extra bits
Rather than looking up the meaning for each code during decompression of blocks we store the appropriate values directly in the huffman tables, using a pre-defined mapping. Even though this does not make a big difference in speed, it cleans up the code and allows easier translation into primitive code (which is clearly one goal of this implementation).

c) Precomputed huffman tables for fixed blocks
So we don't have to compute the huffman tables from scratch. The precomputed tables are not in our superclass to avoid double storage (and my superclass is more intended for documentation anyways).!
!FastInflateStream methodsFor: 'bit access' stamp: 'ar 12/4/1998 02:02'!
nextSingleBits: n
	"Fetch the bits all at once"
	^self nextBits: n.! !

!FastInflateStream methodsFor: 'huffman trees' stamp: 'ar 12/4/1998 02:26'!
literalLengthMap
	^LiteralLengthMap! !

!FastInflateStream methodsFor: 'huffman trees' stamp: 'ar 12/4/1998 01:48'!
increment: value bits: nBits
	"Increment value in reverse bit order, e.g. 
	for a 3 bit value count as follows:
		000 / 100 / 010 / 110
		001 / 101 / 011 / 111
	See the class comment why we need this."
	| result bit |
	result := value.
	"Test the lowest bit first"
	bit := 1 << (nBits - 1).
	"If the currently tested bit is set then we need to
	turn this bit off and test the next bit right to it"
	[(result bitAnd: bit) = 0] whileFalse:[ 
		"Turn off current bit"
		result := result bitXor: bit.
		"And continue testing the next bit"
		bit := bit bitShift: -1].
	"Turn on the right-most bit that we haven't touched in the loop above"
	^result bitXor: bit! !

!FastInflateStream methodsFor: 'inflating' stamp: 'ar 12/4/1998 19:15'!
processFixedBlock
	litTable := FixedLitTable.
	distTable := FixedDistTable.
	state := state bitOr: BlockProceedBit.
	self proceedFixedBlock.! !

!FastInflateStream methodsFor: 'huffman trees' stamp: 'ar 12/4/1998 02:26'!
distanceMap
	^DistanceMap! !

!FastInflateStream methodsFor: 'inflating' stamp: 'ar 2/2/2001 15:47'!
decompressBlock: llTable with: dTable
	"Process the compressed data in the block.
	llTable is the huffman table for literal/length codes
	and dTable is the huffman table for distance codes."
	| value extra length distance oldPos oldBits oldBitPos |
	<primitive: 'primitiveInflateDecompressBlock' module: 'ZipPlugin'>
	[readLimit < collection size and:[sourcePos <= sourceLimit]] whileTrue:[
		"Back up stuff if we're running out of space"
		oldBits := bitBuf.
		oldBitPos := bitPos.
		oldPos := sourcePos.
		value := self decodeValueFrom: llTable.
		value < 256 ifTrue:[ "A literal"
			collection byteAt: (readLimit := readLimit + 1) put: value.
		] ifFalse:["length/distance or end of block"
			value = 256 ifTrue:["End of block"
				state := state bitAnd: StateNoMoreData.
				^self].
			"Compute the actual length value (including possible extra bits)"
			extra := (value bitShift: -16) - 1.
			length := value bitAnd: 16rFFFF.
			extra > 0 ifTrue:[length := length + (self nextBits: extra)].
			"Compute the distance value"
			value := self decodeValueFrom: dTable.
			extra := (value bitShift: -16).
			distance := value bitAnd: 16rFFFF.
			extra > 0 ifTrue:[distance := distance + (self nextBits: extra)].
			(readLimit + length >= collection size) ifTrue:[
				bitBuf := oldBits.
				bitPos := oldBitPos.
				sourcePos := oldPos.
				^self].
			collection 
					replaceFrom: readLimit+1 
					to: readLimit + length + 1 
					with: collection 
					startingAt: readLimit - distance + 1.
			readLimit := readLimit + length.
		].
	].! !

!FastInflateStream class methodsFor: 'initialization' stamp: 'ar 12/21/1999 23:00'!
initialize
	"FastInflateStream initialize"
	| low high |

	"Init literal/length map"
	low := #(3 4 5 6 7 8 9 10 11 13 15 17 19 23 27 31 35 43 51 59 67 83 99 115 131 163 195 227 258 ).
	high := #(0 0 0 0 0 0 0 0 1 1 1 1 2 2 2 2 3 3 3 3 4 4 4 4 5 5 5 5 0 0).
	LiteralLengthMap := WordArray new: 256 + 32.
	1 to: 257 do:[:i| LiteralLengthMap at: i put: i-1].
	1 to: 29 do:[:i| LiteralLengthMap at: 257+i put: (low at:i) + ( (high at: i) + 1 << 16)].

	"Init distance map"
	high := #(0 0 0 0 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9 10 10 11 11 12 12 13 13).
	low := #(1 2 3 4 5 7 9 13 17 25 33 49 65 97 129 193 257 385 513 769
			1025 1537 2049 3073 4097 6145 8193 12289 16385 24577).
	DistanceMap := WordArray new: 32.
	1 to: 30 do:[:i| DistanceMap at: i put: (low at: i) + ( (high at: i) << 16)].

	"Init fixed block huffman tables"
	FixedLitTable := self basicNew
				huffmanTableFrom: FixedLitCodes
				mappedBy: LiteralLengthMap.
	FixedDistTable := self basicNew
				huffmanTableFrom: FixedDistCodes
				mappedBy: DistanceMap.! !

!FileCompilerRequestor commentStamp: '<historical>'!
I am an Object used to interact with the OpalCompiler.
I keep a reference to the original input so that error messages can be properly analyzed later-on.!
!FileCompilerRequestor methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 15:38'!
initialize
	interactive := false.! !

!FileCompilerRequestor methodsFor: 'testing' stamp: 'CamilloBruni 7/17/2013 15:38'!
interactive
	^ interactive! !

!FileCompilerRequestor methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2013 16:12'!
fileReference: anObject
	fileReference := anObject! !

!FileCompilerRequestor methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2013 16:45'!
failBlock
	^ [ :exception | exception pass ]! !

!FileCompilerRequestor methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2013 16:12'!
fileReference
	^ fileReference! !

!FileCompilerRequestor methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2013 16:12'!
contents: anObject
	contents := anObject! !

!FileCompilerRequestor methodsFor: 'accessing' stamp: 'CamilloBruni 7/17/2013 15:38'!
interactive: aBoolean
	interactive := aBoolean! !

!FileCompilerRequestor methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2013 16:12'!
contents
	^ contents! !

!FileCompilerRequestor methodsFor: 'accessing' stamp: 'CamilloBruni 7/17/2013 15:29'!
text
	"compatibility method for the method installer"
	^ self contents! !

!FileCompilerRequestor methodsFor: 'interactive error protocol' stamp: 'CamilloBruni 7/10/2013 18:46'!
notify: message at: location in: code
	self flag: #hack.
	"Should use the new OPalWarnings directly instead of recreating a SyntaxErrorNotification"
	SyntaxErrorNotification 
		inClass: STCommandLineHandler
		category: nil 
		withCode: code
		doitFlag: nil
		errorMessage: message
		location: location.! !

!FileCompilerRequestor class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/17/2013 15:08'!
fileStream: fileStream
	^ self fileReference: fileStream name asFileReference! !

!FileCompilerRequestor class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/10/2013 16:12'!
fileReference: aFileReference
	^ self new
		fileReference: aFileReference;
		yourself! !

!FileContentsBrowser commentStamp: '<historical>'!
I am a class browser view on a fileout (either a source file (.st) or change set (.cs)). I do not actually load the code into to the system, nor do I alter the classes in the image. Use me to vet code in a comfortable way before loading it into your image.

From a FileList, I can be invoked by selecting a source file and selecting the "browse code" menu item from the yellow button menu.

I use PseudoClass, PseudoClassOrganizers, and PseudoMetaclass to model the class structure of the source file.!
!FileContentsBrowser methodsFor: 'infoview' stamp: 'alain.plantec 5/30/2008 13:04'!
updateInfoView

	self changed: #infoViewContents! !

!FileContentsBrowser methodsFor: 'other' stamp: 'VincentBlondeau 1/28/2015 16:13'!
browseVersions
	"Create and schedule a message set browser on all versions of the 
	currently selected message selector."

	| class selector |
	selector := self selectedMessageName.
	class := self selectedClassOrMetaClass.
	(class exists and: [ class realClass includesSelector: selector ])
		ifTrue: [ Smalltalk tools versionBrowser browseVersionsForClass: class realClass selector: selector ]! !

!FileContentsBrowser methodsFor: 'creation' stamp: 'SD 10/18/2013 14:26'!
messageList
	"Answer an Array of the message selectors of the currently selected message category, provided that the messageCategoryListIndex is in proper range.  Otherwise, answer an empty Array  If messageCategoryListIndex is found to be larger than the number of categories (it happens!!), it is reset to zero."
	^ super messageList sorted! !

!FileContentsBrowser methodsFor: 'other' stamp: ''!
changeMessageCategories: aString 
	"The characters in aString represent an edited version of the the message 
	categories for the selected class. Update this information in the system 
	and inform any dependents that the categories have been changed. This 
	message is invoked because the user had issued the categories command 
	and edited the message categories. Then the user issued the accept 
	command."

	self classOrMetaClassOrganizer changeFromString: aString.
	self unlock.
	self editClass.
	self classListIndex: classListIndex.
	^ true! !

!FileContentsBrowser methodsFor: 'creation' stamp: 'MarcusDenker 11/13/2012 15:10'!
createViews
	contentsSymbol := self defaultDiffsSymbol.
	"#showDiffs or #prettyDiffs"
	^ self open! !

!FileContentsBrowser methodsFor: 'other' stamp: 'sw 10/1/2001 11:16'!
labelString
	"Answer the string for the window title"

	^ 'File Contents Browser ', (self selectedSystemCategoryName ifNil: [''])! !

!FileContentsBrowser methodsFor: 'keys' stamp: 'sma 2/6/2000 12:05'!
packageListKey: aChar from: view
	aChar == $f ifTrue: [^ self findClass].
	self arrowKey: aChar from: view! !

!FileContentsBrowser methodsFor: 'filein/fileout' stamp: 'wod 2/3/1999 18:46'!
fileInMessageCategories
	Cursor read showWhile:[
		self selectedClassOrMetaClass fileInCategory: self selectedMessageCategoryName.
	].! !

!FileContentsBrowser methodsFor: 'metaclass' stamp: 'sd 11/20/2005 21:27'!
selectedClassOrMetaClass
	"Answer the selected class or metaclass."

	| cls |
	self metaClassIndicated
		ifTrue: [^ (cls := self selectedClass) ifNotNil: [cls metaClass]]
		ifFalse: [^ self selectedClass]! !

!FileContentsBrowser methodsFor: 'filein/fileout' stamp: 'wod 5/13/1998 14:19'!
fileOutPackage
	Cursor write showWhile:[
		self selectedPackage fileOut.
	].! !

!FileContentsBrowser methodsFor: 'menus' stamp: 'tpr 3/11/2001 21:26'!
classListMenu: aMenu shifted: ignored
	"Answer the class list menu, ignoring the state of the shift key in this case"

	^ self classListMenu: aMenu! !

!FileContentsBrowser methodsFor: 'class list' stamp: ''!
classList
	"Answer an array of the class names of the selected category. Answer an 
	empty array if no selection exists."

	(systemCategoryListIndex = 0 or:[self selectedPackage isNil])
		ifTrue: [^Array new]
		ifFalse: [^self selectedPackage classes keys asSortedCollection].! !

!FileContentsBrowser methodsFor: 'removing' stamp: 'StephaneDucasse 8/29/2013 21:05'!
removeMessageCategory
	"If a message category is selected, create a Confirmer so the user can 
	verify that the currently selected message category should be removed
 	from the system. If so, remove it."

	| messageCategoryName |
	messageCategoryListIndex = 0 ifTrue: [^ self].
	self okToChange ifFalse: [^ self].
	messageCategoryName := self selectedMessageCategoryName.
	(self messageList size = 0
		or: [self confirm: 'Are you sure you want to
remove this method category 
and all its methods?']) ifFalse: [^ self].
	self selectedClassOrMetaClass removeProtocol: messageCategoryName.
	self messageCategoryListIndex: 0.
	self changed: #messageCategoryList.! !

!FileContentsBrowser methodsFor: 'other' stamp: 'sma 2/6/2000 12:27'!
methodHierarchy
	(self selectedClassOrMetaClass isNil or:
		[self selectedClassOrMetaClass hasDefinition])
			ifFalse: [super methodHierarchy]! !

!FileContentsBrowser methodsFor: '*Shout-Styling' stamp: ''!
shoutAboutToStyle: aPluggableShoutMorphOrView 
	self shoutIsModeStyleable
		ifFalse: [^ false].
	aPluggableShoutMorphOrView classOrMetaClass: self selectedClassOrMetaClass.
	^ true! !

!FileContentsBrowser methodsFor: 'accessing' stamp: 'sd 11/20/2005 21:27'!
contents: input notifying: aController 
	"The retrieved information has changed and its source must now be 
	updated. The information can be a variety of things, depending on the 
	list selections (such as templates for class or message definition, methods) 
	or the user menu commands (such as definition, comment, hierarchy). 
	Answer the result of updating the source."

	| aString aText theClass |
	aString := input asString.
	aText := input asText.

	editSelection == #editComment 
		ifTrue: [theClass := self selectedClass.
				theClass ifNil: [self inform: 'You must select a class
before giving it a comment.'.
				^ false].
				theClass comment: aText. ^ true].
	editSelection == #editMessageCategories 
		ifTrue: [^ self changeMessageCategories: aString].

	self inform:'You cannot change the current selection'.
	^false
! !

!FileContentsBrowser methodsFor: 'menus' stamp: 'MarcusDenker 10/7/2012 11:35'!
messageListMenu: aMenu
	^aMenu addList: #(
		('FileIn'						fileInMessage)
		('FileOut'					fileOutMessage)
		-
		('Senders (n)'				browseSenders)
		('Implementors (m)'			browseImplementors)
		('Method inheritance (h)'	methodHierarchy)
		('Versions (v)'				browseVersions)
		-
		('Remove'					removeMessage))
! !

!FileContentsBrowser methodsFor: 'class list' stamp: 'StephaneDucasse 5/28/2011 13:40'!
findClass
	| pattern foundClass classNames index foundPackage |
	self okToChange ifFalse: [^ self classNotFound].
	pattern := (UIManager default request: 'Class Name?') asLowercase.
	pattern isEmptyOrNil ifTrue: [^ self].
	classNames := Set new.
	self packages do:[:p| classNames addAll: p classes keys].
	classNames := classNames asArray select: 
		[:n | (n asLowercase indexOfSubCollection: pattern startingAt: 1) > 0].
	classNames isEmpty ifTrue: [^ self].
	index := classNames size = 1
				ifTrue:	[1]
				ifFalse:	[(UIManager default chooseFrom: classNames lines: #())].
	index = 0 ifTrue: [^ self].
	foundPackage := nil.
	foundClass := nil.
	self packages do:[:p| 
		(p classes includesKey: (classNames at: index)) ifTrue:[
			foundClass := p classes at: (classNames at: index).
			foundPackage := p]].
	foundClass isNil ifTrue:[^self].
 	self systemCategoryListIndex: (self systemCategoryList indexOf: foundPackage packageName asSymbol).
	self classListIndex: (self classList indexOf: foundClass name). ! !

!FileContentsBrowser methodsFor: 'menus' stamp: 'sw 11/13/2001 09:12'!
contentsSymbolQuints
	"Answer a list of quintuplets representing information on the alternative views available in the code pane.  For the file-contents browser, the choices are restricted to source and the two diffing options"

	^ self sourceAndDiffsQuintsOnly! !

!FileContentsBrowser methodsFor: 'menus' stamp: 'MarcusDenker 10/7/2012 11:40'!
messageCategoryMenu: aMenu
	^aMenu addList: #(
		('FileIn'					fileInMessageCategories)
		('FileOut'				fileOutMessageCategories)
		-
		('Reorganize'			editMessageCategories)
	     -
		('Add item...'			addCategory)				
		('Rename...'				renameCategory)	
		('Remove'				removeMessageCategory)	
		('Remove existing'		removeUnmodifiedMethods))! !

!FileContentsBrowser methodsFor: 'creation' stamp: 'EstebanLorenzano 5/3/2014 13:54'!
addLowerPanesTo: window at: nominalFractions with: editString

	| verticalOffset row codePane infoPane infoHeight |

	row := AlignmentMorph newColumn
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		layoutInset: 0;
		borderWidth: 1;
		borderColor: Smalltalk ui theme borderColor;
		layoutPolicy: ProportionalLayout new.

	codePane := PluggableTextMorph on: self text: #contents accept: #contents:notifying:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:.
	infoPane := PluggableTextMorph on: self text: #infoViewContents accept: nil
			readSelection: nil menu: nil.
	infoPane askBeforeDiscardingEdits: false.
	verticalOffset := 0.

	infoHeight := 20.
	row 
		addMorph: (codePane borderWidth: 0)
		fullFrame: (
			LayoutFrame identity
				topOffset: verticalOffset ; bottomOffset: infoHeight negated).

	row 
		addMorph: (infoPane borderWidth: 0; hideScrollBarsIndefinitely)
		fullFrame: ((0@1 corner: 1@1) asLayoutFrame topOffset: infoHeight negated).
	window 
		addMorph: row
		frame: nominalFractions.

	row on: #mouseEnter send: #paneTransition: to: window.
	row on: #mouseLeave send: #paneTransition: to: window.

! !

!FileContentsBrowser methodsFor: 'accessing' stamp: ''!
packages: aDictionary
	packages := aDictionary.! !

!FileContentsBrowser methodsFor: 'infoview' stamp: 'sma 5/6/2000 19:19'!
extraInfo
	^ (self
		methodDiffFor: (self selectedClassOrMetaClass sourceCodeAt: self selectedMessageName)
		class: self selectedClass
		selector: self selectedMessageName
		meta: self metaClassIndicated) unembellished
			ifTrue: [' - identical']
			ifFalse: [' - modified']! !

!FileContentsBrowser methodsFor: 'diffs' stamp: 'lr 3/14/2010 21:13'!
modifiedClassDefinition
	| pClass rClass old new diff |
	pClass := self selectedClassOrMetaClass.
	pClass hasDefinition
		ifFalse: [ ^ pClass definition ].
	rClass := Smalltalk globals at: self selectedClass name asSymbol ifAbsent: [ nil ].
	rClass isNil
		ifTrue: [ ^ pClass definition ].
	self metaClassIndicated
		ifTrue: [ rClass := rClass class ].
	old := rClass definition.
	new := pClass definition.
	Cursor wait showWhile: [ diff := ClassDiffBuilder buildDisplayPatchFrom: old to: new ].
	^ diff! !

!FileContentsBrowser methodsFor: 'filein/fileout' stamp: 'wod 6/16/1998 17:14'!
fileOutMessage

	self selectedMessageName ifNil: [^self].
	Cursor write showWhile: [
		self selectedClassOrMetaClass fileOutMethod: self selectedMessageName].! !

!FileContentsBrowser methodsFor: 'edit pane' stamp: 'MarcusDenker 8/28/2013 10:53'!
selectedBytecodes
	"Compile the source code for the selected message selector and extract and return
	the bytecode listing."
	| class selector |
	class := self selectedClassOrMetaClass.
	selector := self selectedMessageName.
	contents := class sourceCodeAt: selector.
	contents := self class compiler parse: contents.
	contents := contents generate.
	^ contents symbolic asText! !

!FileContentsBrowser methodsFor: 'infoview' stamp: 'lr 3/14/2010 21:13'!
infoViewContents
	"Answer the string to show in the info view"

	| theClass stamp exists |
	editSelection == #newClass
		ifTrue: [ ^ self packageInfo: self selectedPackage ].
	self selectedClass isNil
		ifTrue: [ ^ '' ].
	theClass := Smalltalk globals at: self selectedClass name asSymbol ifAbsent: [  ].
	editSelection == #editClass
		ifTrue: [ 
			^ theClass notNil
				ifTrue: [ 'Class exists already in the system' translated ]
				ifFalse: [ 'New class' translated ] ].
	editSelection == #editMessage
		ifFalse: [ ^ '' ].
	(theClass notNil and: [ self metaClassIndicated ])
		ifTrue: [ theClass := theClass class ].
	stamp := self selectedClassOrMetaClass stampAt: self selectedMessageName.
	exists := theClass notNil and: [ theClass includesSelector: self selectedMessageName ].
	^ stamp = 'methodWasRemoved'
		ifTrue: [ 
			exists
				ifTrue: [ 'Existing method removed  by this change-set' translated ]
				ifFalse: [ 'Removal request for a method that is not present in this image' translated ] ]
		ifFalse: [ 
			stamp , ' · '
				,
					(exists
						ifTrue: [ 'Method already exists' translated , self extraInfo ]
						ifFalse: [ 'New method' translated ]) ]! !

!FileContentsBrowser methodsFor: 'menus' stamp: 'MarcusDenker 10/7/2012 11:54'!
classListMenu: aMenu

	^ aMenu addList: #(
		('Definition'				editClass)
		('Comment'				editComment)
		-				
		('Browse full (b)'		browseMethodFull)		
		('Class refs (N)'			browseClassRefs)	
		-
		('FileIn'					fileInClass)
		('FileOut'				fileOutClass)
		-
		('Rename...'				renameClass)	
		('Remove'				removeClass) 
		-
		('Remove existing'		removeUnmodifiedCategories))
! !

!FileContentsBrowser methodsFor: 'creation' stamp: 'MarcusDenker 11/13/2012 15:10'!
open
	"Create a pluggable version of all the views for a Browser, including views and controllers."
	| window aListExtent next mySingletonList |
	window := (SystemWindow labelled: 'later') model: self.
	self packages size = 1
		ifTrue: [
			aListExtent := 0.333333 @ 0.34.
			self systemCategoryListIndex: 1.
			mySingletonList := PluggableListMorph on: self list: #systemCategorySingleton
					selected: #indexIsOne changeSelected: #indexIsOne:
					menu: nil
					keystroke: #packageListKey:from:.
			mySingletonList hideScrollBarsIndefinitely.
			window addMorph: mySingletonList frame: (0@0 extent: 1.0@0.06).
			next := 0@0.06]
		ifFalse: [
			aListExtent := 0.25 @ 0.4.
			window addMorph: (PluggableListMorph on: self list: #systemCategoryList
					selected: #systemCategoryListIndex changeSelected: #systemCategoryListIndex:
					menu: nil
					keystroke: #packageListKey:from:)
				frame: (0@0 extent: aListExtent).
			next := aListExtent x @ 0].

	self addClassAndSwitchesTo: window at: (next extent: aListExtent) plus: 0.

	next := next + (aListExtent x @ 0).
	window addMorph: (PluggableListMorph on: self list: #messageCategoryList
			selected: #messageCategoryListIndex changeSelected: #messageCategoryListIndex:
			menu: #messageCategoryMenu:)
		frame: (next extent: aListExtent).
	next := next + (aListExtent x @ 0).
	window addMorph: (PluggableListMorph on: self list: #messageList
			selected: #messageListIndex changeSelected: #messageListIndex:
			menu: #messageListMenu:
			keystroke: #messageListKey:from:)
		frame: (next extent: aListExtent).

	self addLowerPanesTo: window at: (0@0.4 corner: 1@1) with: nil.
	^ window
! !

!FileContentsBrowser methodsFor: 'removing' stamp: 'wod 2/3/1999 18:47'!
removeUnmodifiedMethods
	| theClass cat |
	self okToChange ifFalse:[^self].
	theClass := self selectedClassOrMetaClass.
	theClass isNil ifTrue:[^self].
	cat := self selectedMessageCategoryName.
	cat isNil ifTrue:[^self].
	Cursor wait showWhile:[
		theClass removeUnmodifiedMethods: (theClass organization listAtCategoryNamed: cat).
	].
	self messageListIndex: 0.
	self changed: #messageList.! !

!FileContentsBrowser methodsFor: 'removing' stamp: 'StephaneDucasse 8/29/2013 21:05'!
removePackage
	systemCategoryListIndex = 0 ifTrue: [^ self].
	self okToChange ifFalse: [^ self].
	(self confirm: 'Are you sure you want to
remove this package 
and all its classes?') ifFalse:[^self].
	(systemOrganizer listAtCategoryNamed: self selectedSystemCategoryName) do:[:el|
		systemOrganizer removeElement: el].
	self packages removeKey: self selectedPackage packageName.
	systemOrganizer removeProtocol: self selectedSystemCategoryName.
	self systemCategoryListIndex: 0.
	self changed: #systemCategoryList! !

!FileContentsBrowser methodsFor: 'filein/fileout' stamp: ''!
fileInClass
	Cursor read showWhile:[
		self selectedClass fileIn.
	].! !

!FileContentsBrowser methodsFor: 'filein/fileout' stamp: 'wod 6/16/1998 17:14'!
fileInMessage
	
	self selectedMessageName ifNil: [^self].
	Cursor read showWhile: [
		self selectedClassOrMetaClass fileInMethod: self selectedMessageName.
	].! !

!FileContentsBrowser methodsFor: 'removing' stamp: 'sd 11/20/2005 21:27'!
removeMessage
	| messageName |
	messageListIndex = 0
		ifTrue: [^ self].
	self okToChange
		ifFalse: [^ self].
	messageName := self selectedMessageName.
	(self selectedClass confirmRemovalOf: messageName)
		ifFalse: [^ false].
	self selectedClassOrMetaClass removeMethod: self selectedMessageName.
	self messageListIndex: 0.
	self setClassOrganizer.
	"In case organization not cached"
	self changed: #messageList! !

!FileContentsBrowser methodsFor: 'accessing' stamp: ''!
packages
	^packages! !

!FileContentsBrowser methodsFor: 'removing' stamp: 'MarcusDenker 9/24/2013 14:13'!
removeClass
	| class | 
	classListIndex = 0 ifTrue: [^ self].
	class := self selectedClass.
	(self confirm:'Are you certain that you
want to delete the class ', class name, '?') ifFalse:[^self].
	self selectedPackage removeClass: class.
	self classListIndex: 0.
	self changed: #classList.! !

!FileContentsBrowser methodsFor: 'edit pane' stamp: 'MarcusDenker 8/28/2013 10:32'!
selectedMessage
	"Answer a copy of the source code for the selected message selector."

	| class selector |
	class := self selectedClassOrMetaClass.
	selector := self selectedMessageName.
	contents := class sourceCodeAt: selector.
	self browseWithPrettyPrint
		ifTrue: [ contents := class compiler format: contents ].
	self showingAnyKindOfDiffs
		ifTrue: [ 
			contents := self
				methodDiffFor: contents
				class: self selectedClass
				selector: self selectedMessageName
				meta: self metaClassIndicated ].
	^ contents! !

!FileContentsBrowser methodsFor: 'class list' stamp: 'StephaneDucasse 10/15/2011 20:54'!
browseMethodFull
	| myClass |
	(myClass := self selectedClassOrMetaClass) ifNotNil:
		[Smalltalk tools browser fullOnClass: myClass realClass selector: self selectedMessageName]! !

!FileContentsBrowser methodsFor: 'other' stamp: 'MarcusDenker 10/13/2013 07:59'!
browseSenders
	"Create and schedule a message set browser on all senders of the 
	currently selected message selector. Do nothing if no message is selected."

	messageListIndex ~= 0 
		ifTrue: [self systemNavigation browseAllSendersOf: self selectedMessageName]! !

!FileContentsBrowser methodsFor: 'keys' stamp: 'sma 5/6/2000 18:50'!
messageListKey: aChar from: view
	aChar == $b ifTrue: [^ self browseMethodFull].
	super messageListKey: aChar from: view! !

!FileContentsBrowser methodsFor: 'accessing' stamp: ''!
selectedPackage
	| cat |
	cat := self selectedSystemCategoryName.
	cat isNil ifTrue:[^nil].
	^self packages at: cat asString ifAbsent:[nil]! !

!FileContentsBrowser methodsFor: 'removing' stamp: 'sd 11/20/2005 21:27'!
removeUnmodifiedCategories
	| theClass |
	self okToChange ifFalse: [^self].
	theClass := self selectedClass.
	theClass isNil ifTrue: [^self].
	Cursor wait showWhile:
		[theClass removeUnmodifiedMethods: theClass selectors.
		theClass metaClass removeUnmodifiedMethods: theClass metaClass selectors].
	self messageCategoryListIndex: 0.
	self changed: #messageCategoryList.! !

!FileContentsBrowser methodsFor: 'initialization' stamp: 'dew 9/15/2001 16:19'!
defaultBrowserTitle
	^ 'File Contents Browser'! !

!FileContentsBrowser methodsFor: 'class list' stamp: ''!
selectedClass
	"Answer the class that is currently selected. Answer nil if no selection 
	exists."

	self selectedClassName == nil ifTrue: [^nil].
	^self selectedPackage classAt: self selectedClassName! !

!FileContentsBrowser methodsFor: 'diffs' stamp: 'lr 3/14/2010 21:13'!
methodDiffFor: aString class: aPseudoClass selector: selector meta: meta
	"Answer the diff between the current copy of the given class/selector/meta for the string provided"

	| theClass source |
	theClass := Smalltalk globals at: aPseudoClass name ifAbsent: [ ^ aString copy ].
	meta
		ifTrue: [ theClass := theClass class ].
	(theClass includesSelector: selector)
		ifFalse: [ ^ aString copy ].
	source := theClass sourceCodeAt: selector.
	^ Cursor wait
		showWhile: [ 
			TextDiffBuilder
				buildDisplayPatchFrom: source
				to: aString
				inClass: theClass
				prettyDiffs: self showingPrettyDiffs ]! !

!FileContentsBrowser methodsFor: 'keys' stamp: 'sma 5/6/2000 18:48'!
classListKey: aChar from: view
	aChar == $b ifTrue: [^ self browseMethodFull].
	aChar == $N ifTrue: [^ self browseClassRefs].
	self packageListKey: aChar from: view! !

!FileContentsBrowser methodsFor: 'filein/fileout' stamp: 'wod 2/3/1999 18:46'!
fileOutMessageCategories
	Cursor write showWhile:[
		self selectedClassOrMetaClass fileOutCategory: self selectedMessageCategoryName.
	].! !

!FileContentsBrowser methodsFor: 'infoview' stamp: 'lr 3/14/2010 21:13'!
packageInfo: p
	| nClasses newClasses oldClasses |
	p isNil
		ifTrue: [ ^ '' ].
	nClasses := newClasses := oldClasses := 0.
	p classes
		do: [ :cls | 
			nClasses := nClasses + 1.
			(Smalltalk globals includesKey: cls name asSymbol)
				ifTrue: [ oldClasses := oldClasses + 1 ]
				ifFalse: [ newClasses := newClasses + 1 ] ].
	^ nClasses printString , ' classes (' , newClasses printString , ' new / ' , oldClasses printString , ' modified)'! !

!FileContentsBrowser methodsFor: 'class list' stamp: 'DamienCassou 9/29/2009 09:11'!
renameClass
	| oldName newName |
	classListIndex = 0 ifTrue: [^ self].
	self okToChange ifFalse: [^ self].
	oldName := self selectedClass name.
	newName := (self request: 'Please type new class name'
						initialAnswer: oldName) asSymbol.
	(newName isEmptyOrNil or:[newName = oldName]) ifTrue: [^ self].
	(self selectedPackage classes includesKey: newName)
		ifTrue: [^ self error: newName , ' already exists in the package'].
	systemOrganizer classify: newName under: self selectedSystemCategoryName.
	systemOrganizer removeElement: oldName.
	self selectedPackage renameClass: self selectedClass to: newName.
	self changed: #classList.
	self classListIndex: ((systemOrganizer listAtCategoryNamed: self selectedSystemCategoryName) indexOf: newName).
! !

!FileContentsBrowser methodsFor: 'other' stamp: 'sd 11/20/2005 21:27'!
didCodeChangeElsewhere
	"Determine whether the code for the currently selected method and class has been changed somewhere else."

	| aClass |
	(aClass := self selectedClassOrMetaClass) ifNil: [^ false].

	(aClass isKindOf: PseudoClass) ifTrue: [^ false]. "class not installed"
	^super didCodeChangeElsewhere! !

!FileContentsBrowser methodsFor: 'accessing' stamp: ''!
contents
	self updateInfoView.
	(editSelection == #newClass and:[self selectedPackage notNil])
		ifTrue: [^self selectedPackage packageInfo].
	editSelection == #editClass
		ifTrue:[^self modifiedClassDefinition].
	^super contents! !

!FileContentsBrowser methodsFor: 'metaclass' stamp: 'sd 11/20/2005 21:27'!
setClassOrganizer
	"Install whatever organization is appropriate"
	| theClass |
	classOrganizer := nil.
	metaClassOrganizer := nil.
	classListIndex = 0 ifTrue: [^ self].
	classOrganizer := (theClass := self selectedClass) organization.
	metaClassOrganizer := theClass metaClass organization.
! !

!FileContentsBrowser methodsFor: 'filein/fileout' stamp: ''!
fileOutClass
	Cursor write showWhile:[
		self selectedClass fileOut.
	].! !

!FileContentsBrowser class methodsFor: 'System-FileRegistry' stamp: 'CamilloBruni 2/3/2013 17:21'!
fileReaderServicesForFile: fullName suffix: suffix
	<fileService>

	((FileStream isSourceFileSuffix: suffix) or: [ suffix = '*' ])
		ifTrue: [ ^Array with: self serviceBrowseCode].

	^(fullName endsWith: 'cs.gz')
		ifTrue: [ Array with: self serviceBrowseCompressedCode ]
		ifFalse: [#()]
! !

!FileContentsBrowser class methodsFor: 'instance creation' stamp: 'IgorStasenko 3/6/2011 18:12'!
browseStream: aStream

	aStream setConverterForCode.
	self browseStream: aStream named: aStream name! !

!FileContentsBrowser class methodsFor: 'instance creation' stamp: 'nice 1/5/2010 15:59'!
browseStream: aStream named: aString

	| browser |
	Cursor wait showWhile: [ | package packageDict organizer |
		packageDict := Dictionary new.
		browser := self new.
		organizer := SystemOrganizer defaultList: Array new.
		package := (FilePackage new fullName: aString; fileInFrom: aStream).
		packageDict 
			at: package packageName 
			put: package.
		organizer 
			classifyAll: package classes keys 
			under: package packageName.
		(browser := self systemOrganizer: organizer)
			packages: packageDict].
	self
		openBrowserView: browser createViews
		label: 'File Contents Browser'.
! !

!FileContentsBrowser class methodsFor: 'instance creation' stamp: 'MarcusDenker 6/14/2014 12:18'!
browseCompressedCodeStream: aStandardFileStream
	"Browse the selected file in fileIn format."

	| unzipped |
	unzipped := [ 
	| zipped |
	zipped := GZipReadStream on: aStandardFileStream.
	MultiByteBinaryOrTextStream with: zipped contents asString ]
		ensure: [ aStandardFileStream close ].
	unzipped reset.
	self browseStream: unzipped named: aStandardFileStream name! !

!FileContentsBrowser class methodsFor: 'instance creation' stamp: 'nice 1/5/2010 15:59'!
browseFiles: fileList

	| browser |
	Cursor wait showWhile: [ | packageDict organizer |
		packageDict := Dictionary new.
		organizer := SystemOrganizer defaultList: Array new.
		fileList do: [:fileName | | package |
			package := FilePackage fromFileNamed: fileName.
			packageDict 
				at: package packageName 
				put: package.
			organizer 
				classifyAll: package classes keys 
				under: package packageName].
		(browser := self systemOrganizer: organizer)
			packages: packageDict].
	self
		openBrowserView: browser createViews
		label: 'File Contents Browser'.
! !

!FileContentsBrowser class methodsFor: 'System-FileRegistry' stamp: 'tbn 8/11/2010 10:11'!
serviceBrowseCode
	"Answer the service of opening a file-contents browser"

	^ (SimpleServiceEntry
		provider: self 
		label: 'Code-file browser'
		selector: #browseStream:
		description: 'Open a "file-contents browser" on this file, allowing you to view and selectively load its code'
		buttonLabel: 'code')
		argumentGetter: [ :fileList | fileList readOnlyStream ]! !

!FileContentsBrowser class methodsFor: 'System-FileRegistry' stamp: 'tbn 8/11/2010 10:12'!
serviceBrowseCompressedCode
	"Answer a service for opening a changelist browser on a file"

	^ (SimpleServiceEntry 
		provider: self 
		label: 'Code-file browser'
		selector: #browseCompressedCodeStream:
		description: 'Open a "file-contents browser" on this file, allowing you to view and selectively load its code'
		buttonLabel: 'Code')
		argumentGetter: [ :fileList | fileList readOnlyStream ]! !

!FileContentsBrowser class methodsFor: 'System-FileRegistry' stamp: 'md 11/23/2004 13:34'!
services
	"Answer potential file services associated with this class"

	^ {self serviceBrowseCode}.! !

!FileContentsBrowser class methodsFor: 'initialization' stamp: 'GabrielOmarCotelli 6/4/2009 20:36'!
initialize

	FileServices registerFileReader: self! !

!FileContentsBrowser class methodsFor: 'instance creation' stamp: 'onierstrasz 11/11/2013 12:25'!
browseFile: aFilename
	"Open a file contents browser on a file of the given name"

	aFilename ifNil: [^ self inform: 'File name to browse is nil'].
	self browseFiles: (Array with: aFilename)! !

!FileContentsBrowser class methodsFor: 'initialization' stamp: 'GabrielOmarCotelli 6/4/2009 20:37'!
unload

	FileServices unregisterFileReader: self ! !

!FileContentsBrowser class methodsFor: 'System-FileRegistry' stamp: 'CamilloBruni 2/3/2013 17:27'!
fileReaderServicesForDirectory: aDirectory
	<directoryService>
	^{ self serviceBrowseCodeFiles }! !

!FileContentsBrowser class methodsFor: 'System-FileRegistry' stamp: 'CamilloBruni 5/9/2012 11:54'!
selectAndBrowseFile: aFileList
	"When no file are selected you can ask to browse several of them"

	| selectionPattern files |
	selectionPattern := UIManager default request:'What files?' initialAnswer: '*.cs;*.st'.
	selectionPattern ifNil: [selectionPattern := String new].
	files := (aFileList directory filesMatching: selectionPattern).
	self browseFiles: files.


! !

!FileContentsBrowser class methodsFor: 'System-FileRegistry' stamp: 'tbn 8/11/2010 10:11'!
serviceBrowseCodeFiles

	^  (SimpleServiceEntry 
		provider: self
		label: 'Browse code files' 
		selector: #selectAndBrowseFile:)
		argumentGetter: [ :fileList | fileList ];
		yourself! !

!FileDialogWindow commentStamp: 'StephaneDucasse 7/6/2014 14:56'!
Dialog based file chooser for selecting or saving files. Supports various types of answer (file stream, file name, directory path etc) with optional extension filters and image or text file preview.!
!FileDialogWindow methodsFor: 'actions' stamp: 'gvc 1/10/2007 10:41'!
ok
	"Apply the changes and close."

	self cancelled: false.
	self applyChanges.
	self answer: (self perform: self actionSelector).
	answer ifNil: [
		self cancelled: true.
		^self delete].
	super ok! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 8/23/2006 19:51'!
fileListMorph: anObject
	"Set the value of fileListMorph"

	fileListMorph := anObject! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 8/31/2006 15:19'!
answer
	"Answer the result of performing the action selector."
	
	self cancelled ifTrue: [^nil].
	^answer! !

!FileDialogWindow methodsFor: 'instance creation' stamp: 'gvc 5/14/2007 16:33'!
newImagePreviewMorph
	"Answer a new image preview morph."

	^ImagePreviewMorph new
		cornerStyle: self preferredCornerStyle;
		image: nil
		size: self previewSize! !

!FileDialogWindow methodsFor: 'actions' stamp: 'SeanDeNigris 7/12/2012 08:45'!
saveSelectedFile
	"Open a stream on the selected file if available and return it."

	|d f|
	
	d := self selectedFileDirectory ifNil: [^nil].
	f := self selectedFileName ifNil: [self fileNameText trimBoth].
	f ifEmpty: [ ^ nil ].
	
	f := d asFileReference / f.
	(f extension isEmpty and: [self defaultExtension notNil])
		 ifTrue: [ f := f, self defaultExtension].
	f exists 
		ifFalse: [ ^ f ].
		
	^(self
		proceed: ('The file {1} already exists.
Overwrite the file?' translated format: {f printString})
		title: 'Save File' translated)
			ifTrue: [ f delete ]! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'SeanDeNigris 6/21/2012 19:24'!
answerDirectory
	"Set the receiver to answer a directory."
	
	self actionSelector: #selectedAnyFileDirectory.
	self fileSelectionBlock: self directoryFileSelectionBlock.
	self changed: #okEnabled! !

!FileDialogWindow methodsFor: 'actions' stamp: 'gvc 3/23/2007 16:04'!
answerSaveFile
	"Set the receiver to answer a new file stream."
	
	self actionSelector: #saveSelectedFile.
	self changed: #okEnabled! !

!FileDialogWindow methodsFor: 'instance creation' stamp: 'GuillermoPolito 6/22/2012 13:04'!
newFileList
	"Answer a new file list."
	
	^(self
			newListFor: self
			list: #files
			selected: #selectedFileIndex
			changeSelected: #selectedFileIndex:
			icon: #iconFor:
			getEnabled: nil
			help: nil)
		wrapSelector: #basename;
		doubleClickSelector: #doubleClickFile;
		minWidth: 200! !

!FileDialogWindow methodsFor: 'private' stamp: 'CamilloBruni 2/14/2012 11:46'!
directoriesFor: item
	"Answer the filtered entries."
	
	^item directories! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 8/23/2006 14:19'!
directories: anObject
	"Set the value of directories"

	directories := anObject! !

!FileDialogWindow methodsFor: 'actions' stamp: 'SeanDeNigris 6/21/2012 19:23'!
selectedPathName
	"Answer the name of the selected path."

	selectedDirectory := self selectedFileDirectory ifNil: [^nil].
	^ self selectedFileName 
		ifNil: [ selectedDirectory fullName ]
		ifNotNil: [ :filename | (selectedDirectory / filename) fullName ].! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'GuillermoPolito 6/22/2012 13:06'!
cache: dir
	"Cache the contents of the given directory and answer them."

	self entryCacheDirectory = dir
		ifFalse: [Cursor wait showWhile: [
					self
						entryCache: (dir isReadable ifFalse: [ #() ] ifTrue: [ dir entries ]);
						entryCacheDirectory: dir]].
	^self entryCache! !

!FileDialogWindow methodsFor: 'actions' stamp: 'SeanDeNigris 7/17/2012 17:24'!
selectDirectory: aFileReference
	"Expand and select the given directory."

	self changed: #(openPath), aFileReference pathSegments! !

!FileDialogWindow methodsFor: 'instance creation' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
newNewDirectoryButton
	"Answer a new 'new directory' button."

	^self 
		newButtonFor: self
		getState: nil
		action: #newDirectory
		arguments: nil
		getEnabled: nil
		labelForm: Smalltalk ui icons smallOpenIcon
		help: 'Press to create a new directory within the current directory' translated! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 8/24/2006 08:51'!
fileSortBlock
	"Answer the value of fileSortBlock"

	^ fileSortBlock! !

!FileDialogWindow methodsFor: 'actions' stamp: 'SeanDeNigris 6/21/2012 19:11'!
initialDirectories
	"Answer the initial directories."
	
	| dirList |
	dirList := FileSystem disk root directories collect: [ :each |
		FileDirectoryWrapper with: each name: each basename model: self ].
	
	dirList isEmpty ifTrue: [ | workingDirectory 	wrapper |
		workingDirectory := FileSystem disk workingDirectory.
		wrapper := FileDirectoryWrapper 
			with:  workingDirectory
			name: workingDirectory basename
			model: self.
		dirList := Array with: wrapper ].
	^dirList! !

!FileDialogWindow methodsFor: 'update' stamp: 'GaryChambers 12/2/2011 12:45'!
updateFiles
	"Notify that the files have changed."

	self changed: #files! !

!FileDialogWindow methodsFor: 'initialization' stamp: 'SeanDeNigris 6/21/2012 20:27'!
initialize
	"Initialize the receiver."

	selectedFileIndex := 0.
	fileNameText := ''.
	self
		answerPathName;
		directories: self initialDirectories;
		showDirectoriesInFileList: true;
		fileSelectionBlock: self defaultFileSelectionBlock;
		fileSortBlock: self defaultFileSortBlock.
	super initialize. "Must be at end or signals error. No idea why - SeanDeNigris"! !

!FileDialogWindow methodsFor: 'actions' stamp: 'EstebanLorenzano 3/9/2015 17:13'!
selectPathName: aString
	"Select the directory and set the file name text
	from the given string."

	| reference |
	reference := aString asFileReference asAbsolute.
	
	reference exists
		ifFalse: [ ^ self selectPathName: FileSystem disk workingDirectory ].
	
	reference isDirectory 
		ifTrue: [ ^ self selectDirectory: reference ].
		
	"must be a file then"
	self selectDirectory: reference parent.
	self fileNameText: reference basename.! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 8/24/2006 08:44'!
showDirectoriesInFileList: anObject
	"Set the value of showDirectoriesInFileList"

	showDirectoriesInFileList := anObject.
	self updateFiles! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 4/3/2007 15:19'!
fileNameText: aString
	"The typed file name has changed."

	fileNameText = aString asString ifTrue: [^self].
	fileNameText := aString asString.
	self updateFiles.
	self
		changed: #fileNameText;
		changed: #okEnabled.
	self selectFileFromPattern! !

!FileDialogWindow methodsFor: 'actions' stamp: 'GuillermoPolito 6/22/2012 13:21'!
deleteFileOrDirectory
	"Delete the selected file or directory."

	|entry|
	self hasSelectedFileOrDirectory ifFalse: [^self].
	entry := self selectedFileEntry.
	entry isDirectory
		ifTrue: [(self 
					proceed: 'Are you sure you wish to delete the\selected directory along with its files?' withCRs translated
					title: 'Delete Directory' translated) ifTrue: [
						entry asFileReference delete.
						self
							clearEntryCache;
							updateDirectories]]
		ifFalse: [(self 
					proceed: 'Are you sure you wish to delete the\file' withCRs translated, ' "', entry name, '"?'
					title: 'Delete Directory' translated) ifTrue: [
						entry asFileReference delete.
						self
							selectedFileIndex: 0;
							clearEntryCache;
							updateFiles]].! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 5/14/2007 16:42'!
previewType: anObject
	"Set the value of previewType.
	See #updatePreview for supported types."

	previewType := anObject! !

!FileDialogWindow methodsFor: 'instance creation' stamp: 'gvc 4/3/2007 15:20'!
newFileNameTextEntry
	"Answer a new file name text entry morph."

	^self
		newAutoAcceptTextEntryFor: self
		getText: #fileNameText
		setText: #fileNameText:
		getEnabled: nil
		help: 'File name filter pattern' translated! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 7/30/2009 14:00'!
answer: anObject
	"Set the answer."
	
	answer := anObject! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 10/11/2006 13:33'!
defaultExtension
	"Answer the value of defaultExtension"

	^ defaultExtension! !

!FileDialogWindow methodsFor: 'update' stamp: 'gvc 5/14/2007 16:36'!
updateTextPreview
	"Update the text preview."

	|str text|
	str := self openSelectedFile.
	str ifNil: [^self].
	[[text := str next: 5000]
		on: Error do: []]
		ensure: [str close].
	text ifNil: [text := ''].
	self previewMorph
		setText: text! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 8/27/2006 10:33'!
actionSelector: anObject
	"Set the value of actionSelector"

	actionSelector := anObject! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 8/24/2006 08:39'!
fileSelectionBlock
	"Answer the value of fileSelectionBlock"

	^ fileSelectionBlock! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'SeanDeNigris 6/21/2012 19:28'!
defaultFileSortBlock
	"Answer the default file stor block"

	^[:entry1 :entry2 |
		entry1 isDirectory = entry2 isDirectory
			ifTrue: [entry1 basename <= entry2 basename]
			ifFalse: [entry1 isDirectory
						ifTrue: [true]
						ifFalse: [entry2 isDirectory
									ifTrue: [false]
									ifFalse: [entry1 basename <= entry2 basename]]]]! !

!FileDialogWindow methodsFor: 'instance creation' stamp: 'gvc 9/22/2009 10:54'!
newDirectoryTree
	"Answer a new directory tree."
	
	^(self newTreeFor: self
		list: #directories
		selected: #selectedDirectory
		changeSelected: #selectedDirectory:)
		minHeight: 200;
		minWidth: 180! !

!FileDialogWindow methodsFor: 'instance creation' stamp: 'S 6/17/2013 13:26'!
newDirectory
	"Create a new directory within the selected directory."

	|dir dirName title|
	dir := self selectedFileDirectory ifNil: [^self].
	title := 'Create Directory' translated.
	dirName := self
		textEntry: 'Enter directory name' translated
		title: title.
	dirName ifNil: [^self].
	
	[
		(dir / dirName) exists
			ifTrue: [
				^self
					alert: 'A file or directory already exists\with the name' withCRs translated, ' "', dirName, '"'
					title: title
		].
		(dir / dirName) ensureCreateDirectory
	]
	on: Error
	do: [:ex |
		^self
			alert: 'Invalid directory name' translated, ' "', dirName, '"'
			title: title
	].

	self
		clearEntryCache;
		updateDirectories! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 8/24/2006 08:51'!
fileSortBlock: anObject
	"Set the value of fileSortBlock"

	fileSortBlock := anObject! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 9/27/2006 10:21'!
entryCacheDirectory
	"Answer the value of entryCacheDirectory"

	^ entryCacheDirectory! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/8/2012 14:43'!
fileNamePattern
	"Answer the file name pattern to filter on."
	
	^self fileNameText trimBoth, '*'! !

!FileDialogWindow methodsFor: 'actions' stamp: 'CamilloBruni 5/4/2012 20:07'!
validExtensions: aList
	"Set the filter for the files to be those with the given extensions."
	
	aList notEmpty
		ifTrue: [self defaultExtension: aList first].
	self fileSelectionBlock: [:de |
		de isDirectory
			ifTrue: [self showDirectoriesInFileList]
			ifFalse: [
				(self fileNamePattern match: de name) and: [
						aList includes: de extension asLowercase]]] ! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 8/23/2006 14:19'!
directories
	"Answer the value of directories"

	^ directories! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 9/27/2006 13:55'!
previewMorph: anObject
	"Set the value of previewMorph"

	previewMorph := anObject! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 8/24/2006 08:45'!
fileSelectionBlock: anObject
	"Set the value of fileSelectionBlock"

	fileSelectionBlock := anObject.
	self updateFiles! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 8/23/2006 15:42'!
selectedFileIndex
	"Answer the value of selectedFileIndex"

	^ selectedFileIndex! !

!FileDialogWindow methodsFor: 'actions' stamp: 'gvc 3/23/2007 16:04'!
answerPathName
	"Set the receiver to answer the selected path name."
	
	self actionSelector: #selectedPathName.
	self changed: #okEnabled! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 8/27/2006 10:33'!
actionSelector
	"Answer the value of actionSelector"

	^ actionSelector! !

!FileDialogWindow methodsFor: 'widget API' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
iconFor: anEntry
	"Answer the icon to use for the directory entry."

	^ anEntry isDirectory
		ifTrue: [ Smalltalk ui icons smallOpenIcon ]
		ifFalse: [(self isImageFile: anEntry basename)
					ifTrue: [ Smalltalk ui icons smallPaintIcon]
					ifFalse: [ Smalltalk ui icons smallLeftFlushIcon]]! !

!FileDialogWindow methodsFor: 'enumerating' stamp: 'MarcusDenker 7/28/2014 17:51'!
files
	"Answer the contents of the selected directory."

	self selectedFileDirectory ifNil: [ ^#() ].
	
	^Cursor wait showWhile: [ | cache filteredCache |
		cache := self cache: self selectedFileDirectory.
		filteredCache := cache select: self fileSelectionBlock.
		filteredCache asSortedCollection: self fileSortBlock ].! !

!FileDialogWindow methodsFor: 'actions' stamp: 'GuillermoPolito 6/22/2012 13:12'!
selectParentDirectory
	"Switch to the parent directory."

	self hasParentDirectory ifFalse: [^self].
	self selectDirectory: self selectedFileDirectory asFileReference parent! !

!FileDialogWindow methodsFor: 'actions' stamp: 'GuillermoPolito 6/22/2012 13:08'!
doubleClickFile
	"If the selected entry is a directory then navigate it
	otherwise ok the dialog."
	
	|fe de sm|
	fe := self selectedFileEntry.
	fe ifNil: [^self].
	fe isDirectory
		ifTrue: [de := self selectedFileDirectory.
				sm := self directoryTreeMorph selectedMorph.
				self changed: #(openPath), de pathSegments.
				sm := self directoryTreeMorph selectedMorph.
				self selectedDirectory: (sm children detect: [:w |
					w complexContents item basename  = fe basename ]) complexContents]
		ifFalse: [self ok]! !

!FileDialogWindow methodsFor: 'testing' stamp: 'SeanDeNigris 6/21/2012 20:22'!
hasSelectedFileOrDirectory
	"Answer whether a file or directopry is selected in the file list."

	^ self selectedFileIndex ~= 0! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 8/23/2006 19:51'!
directoryTreeMorph: anObject
	"Set the value of directoryTreeMorph"

	directoryTreeMorph := anObject! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 8/23/2006 19:51'!
directoryTreeMorph
	"Answer the value of directoryTreeMorph"

	^ directoryTreeMorph! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 9/27/2006 13:55'!
previewMorph
	"Answer the value of previewMorph"

	^ previewMorph! !

!FileDialogWindow methodsFor: 'actions' stamp: 'gvc 9/22/2009 10:55'!
newContentMorph
	"Answer a new content morph."

	self
		directoryTreeMorph: self newDirectoryTree;
		fileListMorph: self newFileList;
		previewMorph: self newPreviewMorph.
	^(self newRow: {
		self newColumn: {
			self newGroupbox: 'Directory' translated for: self directoryTreeMorph.
			(self newLabelGroup: {
				'File name' translated->self newFileNameTextEntry})
				vResizing: #shrinkWrap}.
		self newGroupbox: 'File' translated forAll: {
			self fileListMorph.
			self newActionButtonRow}},
		(self previewMorph notNil
			ifTrue: [{self newGroupbox: 'Preview' translated for: self previewMorph}]
			ifFalse: [#()]))
		vResizing: #spaceFill! !

!FileDialogWindow methodsFor: 'controls' stamp: 'gvc 3/23/2007 15:59'!
newOKButton
	"Answer a new OK button."

	^self
		newOKButtonFor: self
		getEnabled: #okEnabled! !

!FileDialogWindow methodsFor: 'actions' stamp: 'SeanDeNigris 2/1/2013 11:59'!
selectedAnyFileDirectory
	"If a directory is selected in the 'File' pane, return that. Otherwise, return the directory selected in 'Directory pane (i.e. the tree)"

	| selectedFile isDirectorySelected |
	selectedFile := self selectedFileEntry.
	isDirectorySelected := selectedFile isNil not and: [ selectedFile isDirectory ].
	^ isDirectorySelected
			ifTrue: [ selectedFile asFileReference ]
			ifFalse: [ self selectedFileDirectory ].! !

!FileDialogWindow methodsFor: 'instance creation' stamp: 'MartinWalk 1/6/2015 18:45'!
newTextPreviewMorph
	"Answer a new text preview morph."

	^(self newTextEditorFor: self getText: nil setText: nil getEnabled: nil)
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		extent: self previewSize;
		minWidth: self previewSize x;
		minHeight: self previewSize y;
		enabled: false! !

!FileDialogWindow methodsFor: 'instance creation' stamp: 'gvc 4/24/2007 10:39'!
newActionButtonRow
	"Answer a new row with the action buttons."
	
	^(self newRow: {
		self newUpButton.
		self newNewDirectoryButton.
		self newDeleteButton})
		listCentering: #bottomRight! !

!FileDialogWindow methodsFor: 'actions' stamp: 'gvc 4/4/2007 16:08'!
answerFileEntry
	"Set the receiver to answer the selected file entry."
	
	self actionSelector: #selectedFileEntry.
	self changed: #okEnabled! !

!FileDialogWindow methodsFor: 'actions' stamp: 'CamilloBruni 5/4/2012 19:59'!
addInitialPanel
	"Add the panel."

	super addInitialPanel.
	self selectDirectory: FileSystem disk workingDirectory ! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 5/14/2007 16:38'!
previewSize
	"Answer the size of preview to use."

	self previewType == #text ifTrue: [^256@256].
	^128@128! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 8/24/2006 08:46'!
selectedFileIndex: anObject
	"Set the value of selectedFileIndex"

	selectedFileIndex := anObject.
	self updateSelectedFile! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 9/27/2006 10:21'!
entryCache: anObject
	"Set the value of entryCache"

	entryCache := anObject! !

!FileDialogWindow methodsFor: 'instance creation' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
newUpButton
	"Answer a new up one directory level button."

	^self 
		newButtonFor: self
		getState: nil
		action: #selectParentDirectory
		arguments: nil
		getEnabled: #hasParentDirectory
		labelForm: Smalltalk ui icons smallUndoIcon
		help: 'Press to switch to the parent of the current directory' translated! !

!FileDialogWindow methodsFor: 'actions' stamp: 'GaryChambers 10/13/2011 17:56'!
updateDirectories
	"Update the directory tree and reselect the current."

	|dir|
	dir := self selectedFileDirectory.
	self changed: #directories.
	self selectDirectory: dir.
	self updateFiles! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 8/24/2006 08:49'!
selectedDirectory: anObject
	"Set the value of selectedDirectory"

	selectedDirectory := anObject.
	self
		selectedFileIndex: 0;
		updateSelectedDirectory;
		updateFiles! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 8/24/2006 08:42'!
showDirectoriesInFileList
	"Answer the value of showDirectoriesInFileList"

	^ showDirectoriesInFileList! !

!FileDialogWindow methodsFor: 'actions' stamp: 'gvc 5/14/2007 16:25'!
updatePreview
	"Update the preview."

	self previewType == #image ifTrue: [self updateImagePreview].
	self previewType == #text ifTrue: [self updateTextPreview]! !

!FileDialogWindow methodsFor: 'update' stamp: 'gvc 4/24/2007 10:40'!
updateSelectedFile
	"Notify that the selected file has changed."

	self
		changed: #selectedFileIndex;
		changed: #selectedFileEntry;
		changed: #selectedFileName;
		changed: #selectedPathName;
		changed: #okEnabled;
		changed: #hasSelectedFileOrDirectory.
	self updatePreview! !

!FileDialogWindow methodsFor: 'initialization' stamp: 'AlainPlantec 1/11/2010 22:00'!
initialExtent
	^ 750@550! !

!FileDialogWindow methodsFor: 'actions' stamp: 'SvenVanCaekenberghe 1/8/2012 14:43'!
saveForcedSelectedFile
	"Open a stream on the selected file if available and return it."

	|d f|
	d := self selectedFileDirectory ifNil: [^nil].
	f := self selectedFileName ifNil: [self fileNameText trimBoth].
	f ifEmpty: [^nil].
	^d forceNewFileNamed: f! !

!FileDialogWindow methodsFor: 'actions' stamp: 'MarcusDenker 10/3/2013 23:50'!
selectedFileName

	^ self selectedFileEntry ifNotNil: [ :dir | dir basename ]! !

!FileDialogWindow methodsFor: 'instance creation' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
newDeleteButton
	"Answer a new delete button."

	^self 
		newButtonFor: self
		getState: nil
		action: #deleteFileOrDirectory
		arguments: nil
		getEnabled: #hasSelectedFileOrDirectory
		labelForm: Smalltalk ui icons smallDeleteIcon
		help: 'Press to delete the selected file or directory' translated! !

!FileDialogWindow methodsFor: 'actions' stamp: 'gvc 4/24/2007 11:23'!
clearEntryCache
	"Clear the entry cache."

	self
		entryCache: nil;
		entryCacheDirectory: nil! !

!FileDialogWindow methodsFor: 'actions' stamp: 'gvc 3/23/2007 16:04'!
answerOpenFile
	"Set the receiver to answer a new file stream on an existing file."
	
	self actionSelector: #openSelectedFile.
	self changed: #okEnabled! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 9/27/2006 13:30'!
previewType
	"Answer the value of previewType"

	^ previewType! !

!FileDialogWindow methodsFor: 'testing' stamp: 'SeanDeNigris 7/12/2012 08:44'!
isImageFile: aString
	"Answer whether the file name indicates an image file."

	aString ifNil: [^false].
	^#('pcx' 'bmp' 'jpeg' 'xbm' 'pnm' 'ppm' 'gif' 'pam' 'jpg' 'png' 'pbm')
		includes: aString asFileReference extension asLowercase! !

!FileDialogWindow methodsFor: 'testing' stamp: 'gvc 4/4/2007 16:34'!
okEnabled
	"Answer wether the ok button should be enabled."

	(#(selectedAnyFileDirectory selectedPathName)
			includes: self actionSelector) ifTrue: [^true].
	((#(saveSelectedFile saveForcedSelectedFile)
			includes: self actionSelector) and: [self fileNameText notEmpty]) ifTrue: [^true].
	(self actionSelector = #selectedFileName and: [
		self selectedFileName notNil]) ifTrue: [^true].
	^self selectedFileName notNil and: [self selectedFileEntry isDirectory not]! !

!FileDialogWindow methodsFor: 'testing' stamp: 'SeanDeNigris 6/21/2012 20:22'!
hasParentDirectory
	"Answer whether the selected directory in the tree part has a parent."

	^ self selectedFileDirectory ifNotNil: [ :dir | dir isRoot not ] ifNil: [ false ].! !

!FileDialogWindow methodsFor: 'update' stamp: 'gvc 4/24/2007 10:41'!
updateSelectedDirectory
	"Notify that the selected directory has changed."

	self
		changed: #selectedDirectory;
		changed: #selectedFileDirectory;
		changed: #selectedPathName;
		changed: #hasParentDirectory! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 9/27/2006 10:21'!
entryCache
	"Answer the value of entryCache"

	^ entryCache! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 9/22/2009 11:17'!
isResizeable
	"Answer whether we are not we can be resized."

	^true! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 8/23/2006 19:51'!
fileListMorph
	"Answer the value of fileListMorph"

	^ fileListMorph! !

!FileDialogWindow methodsFor: 'actions' stamp: 'gvc 11/5/2008 12:09'!
selectedFileEntry
	"Answer the selected file."

	self selectedFileIndex = 0 ifTrue: [^nil].
	^self files at: self selectedFileIndex ifAbsent: [nil]! !

!FileDialogWindow methodsFor: 'open/close' stamp: 'FernandoOlivero 9/24/2012 16:47'!
openSelectedFile
	"Open a stream on the selected file if available and return it."

	|d f fileRef |
	d := self selectedFileDirectory ifNil: [^nil].
	f := self selectedFileName ifNil: [^nil].
	self selectedFileEntry isDirectory ifTrue: [^nil].
	fileRef := d/f.
	^ fileRef exists ifTrue: [ fileRef readStream ] ifFalse: nil  ! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 9/27/2006 10:21'!
entryCacheDirectory: anObject
	"Set the value of entryCacheDirectory"

	entryCacheDirectory := anObject! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 8/24/2006 15:54'!
fileNameText
	"Answer the typed file name."

	^fileNameText! !

!FileDialogWindow methodsFor: 'actions' stamp: 'CamilloBruni 9/5/2012 20:37'!
selectedFileDirectory
	"Answer the selected file directory in the tree part."

	^ (self selectedDirectory ifNil: [^nil]) item! !

!FileDialogWindow methodsFor: 'actions' stamp: 'gvc 8/23/2006 14:19'!
defaultLabel
	"Answer the default label for the receiver."

	^'File' translated! !

!FileDialogWindow methodsFor: 'actions' stamp: 'gvc 4/4/2007 16:00'!
answerFileName
	"Set the receiver to answer the selected file name."
	
	self actionSelector: #selectedFileName.
	self changed: #okEnabled! !

!FileDialogWindow methodsFor: 'actions' stamp: 'MarcusDenker 7/26/2014 20:19'!
selectFileFromPattern
	"If there is a single file matching the pattern then select it.
	If none then try for a directory."

	| f matches subMatches |
	f := self files.
	matches := f select: [ :de | self fileNamePattern match: de name ].
	subMatches := matches reject: [ :de | de isDirectory ].
	subMatches size = 1
		ifTrue: [ ^ self selectedFileIndex: (f indexOf: subMatches first) ].
	subMatches := matches select: [ :de | de isDirectory ].
	subMatches size = 1
		ifTrue: [ ^ self selectedFileIndex: (f indexOf: subMatches first) ].
	self selectedFileIndex: 0! !

!FileDialogWindow methodsFor: 'instance creation' stamp: 'gvc 5/14/2007 16:24'!
newPreviewMorph
	"Answer a new preview morph."

	self previewType == #image ifTrue: [^self newImagePreviewMorph].
	self previewType == #text ifTrue: [^self newTextPreviewMorph].
	^nil! !

!FileDialogWindow methodsFor: 'update' stamp: 'gvc 5/14/2007 16:33'!
updateImagePreview
	"Update the image preview."

	|str form|
	(self isImageFile: self selectedFileName)
		ifFalse: [^self previewMorph
					image: nil
					size: self previewSize].
	str := self openSelectedFile.
	str ifNil: [^self].
	[[str binary.
	form := ImageReadWriter formFromStream: str]
		on: Error do: []]
		ensure: [str close].
	self previewMorph
		image: form
		size: self previewSize! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'stephane.ducasse 4/13/2009 21:06'!
directoryFileSelectionBlock
	"Answer the directory file selection block."

	^[:de |
		de isDirectory
			ifTrue: [self showDirectoriesInFileList]
			ifFalse: [false]] ! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'SeanDeNigris 6/21/2012 19:26'!
defaultFileSelectionBlock
	"Answer the default file selection block."

	^[:entry |
		entry isDirectory
			ifTrue: [self showDirectoriesInFileList]
			ifFalse: [self fileNamePattern match: entry basename]]! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 8/23/2006 14:33'!
selectedDirectory
	"Answer the value of selectedDirectory"

	^ selectedDirectory! !

!FileDialogWindow methodsFor: 'accessing' stamp: 'gvc 10/11/2006 13:33'!
defaultExtension: anObject
	"Set the value of defaultExtension"

	defaultExtension := anObject! !

!FileDialogWindow class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
taskbarIcon
	"Answer the icon for the receiver in a task bar."

	^ Smalltalk ui icons smallOpenIcon! !

!FileDialogWindowTest methodsFor: 'tests' stamp: 'S 6/17/2013 13:26'!
testIssue6406

	| aFolder dialog file invalidFolder |
	aFolder := (FileSystem workingDirectory / 'folder') ensureCreateDirectory.
	[ 
	"Absolute folder paths work"
	dialog := FileDialogWindow new selectPathName: aFolder fullName.
	"just compare the lower-case path names for now since on mac the test will fail
	under certain circumstances..."
	self 
		assert: dialog selectedFileDirectory fullName asLowercase
		equals: aFolder fullName asLowercase.
	
	"Relative folder paths work"
	dialog := FileDialogWindow new selectPathName: 'folder' asFileReference.
	self 
		assert: dialog selectedFileDirectory fullName asLowercase
		equals: aFolder fullName asLowercase.
	
	"Invalid folder defaults to the working folder"
	invalidFolder := 'cant-possibly-exist-for-testIssue6406'.
	dialog := FileDialogWindow new selectPathName: invalidFolder.
	self 
		assert: dialog selectedFileDirectory fullName asLowercase
		equals: FileSystem workingDirectory fullName asLowercase.
	] ensure: [ aFolder ensureDelete. ]! !

!FileDirectoryWrapper methodsFor: 'as yet unclassified' stamp: 'RAA 6/16/2000 18:30'!
settingSelector

	^#setSelectedDirectoryTo:! !

!FileDirectoryWrapper methodsFor: 'accessing' stamp: 'RAA 7/21/2000 11:00'!
balloonText

	^balloonText! !

!FileDirectoryWrapper methodsFor: 'converting' stamp: 'MarcusDenker 9/29/2014 13:57'!
asString
	 ^itemName! !

!FileDirectoryWrapper methodsFor: 'accessing' stamp: 'RAA 7/21/2000 11:01'!
balloonText: aStringOrNil

	balloonText := aStringOrNil! !

!FileDirectoryWrapper methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 6/22/2012 12:54'!
directoriesFor: anItem
	^model directoriesFor: anItem! !

!FileDirectoryWrapper methodsFor: 'accessing' stamp: 'CamilloBruni 9/4/2013 15:33'!
hasContents
	"Return whether this directory has subfolders. The value is cached to 
	avoid a performance penalty.	Also for performance reasons, the code 
	below will just assume that the directory does indeed have contents in a 
	few of cases:  
	1. If the item is not a FileDirectory (thus avoiding the cost 
	of refreshing directories that are not local) 
	2. If it's the root directory of a given volume 
	3. If there is an error computing the FileDirectory's contents
	"
	hasContents ifNil: [
		hasContents := [ 
				item isDirectory 
				and: [ item isReadable 
				and: [ item hasDirectories ]]
			] on: Error do: [ :error | false ]].
	^ hasContents! !

!FileDirectoryWrapper methodsFor: 'accessing' stamp: 'CamilloBruni 2/14/2012 13:03'!
contents

	^((model directoriesFor: item) 
		sort: [ :a :b | a basename caseInsensitiveLessOrEqual: b basename]) 
		collect: [ :directory| 
			self class with: directory name: directory basename model: self ]
! !

!FileDirectoryWrapper methodsFor: 'accessing' stamp: 'sps 12/5/2002 16:59'!
setItem: anObject name: aString model: aModel

	item := anObject.
	model := aModel.
	itemName := aString.
	hasContents := nil.
! !

!FileDirectoryWrapper methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
icon
	"Answer a form to be used as icon"
	"^ item isRemoteDirectory
		ifTrue: [ Smalltalk ui icons smallRemoteOpenIcon]
		ifFalse: [Smalltalk ui icons smallOpenIcon]"
	^ Smalltalk ui icons smallOpenIcon! !

!FileDirectoryWrapper class methodsFor: 'as yet unclassified' stamp: 'RAA 6/15/2000 18:01'!
with: anObject name: aString model: aModel

	^self new 
		setItem: anObject name: aString model: aModel! !

!FileDoesNotExist commentStamp: 'cwp 11/18/2009 12:35'!
I am raised when an operation is attempted on a file that does not exist. This includes cases where a file operation is attempted on a directory.!
!FileDoesNotExistException commentStamp: 'TorstenBergmann 2/3/2014 23:37'!
Notify when fie does not exist!
!FileDoesNotExistException methodsFor: 'accessing' stamp: 'mir 7/25/2000 16:41'!
readOnly
	^readOnly == true! !

!FileDoesNotExistException methodsFor: 'accessing' stamp: 'mir 7/25/2000 16:40'!
readOnly: aBoolean
	readOnly := aBoolean! !

!FileDoesNotExistException methodsFor: 'exceptiondescription' stamp: 'pavel.krivanek 6/17/2010 10:00'!
defaultAction
	"The default action taken if the exception is signaled."

	^ UIManager default fileDoesNotExistsDefaultAction: self
! !

!FileDoesNotExistException class methodsFor: 'examples' stamp: 'mir 2/29/2000 11:44'!
example
	"FileDoesNotExistException example"

	| result |
	result := [(StandardFileStream readOnlyFileNamed: 'error42.log') contentsOfEntireFile]
		on: FileDoesNotExistException
		do: [:ex | 'No error log'].
	Transcript show: result; cr! !

!FileExists commentStamp: 'cwp 11/18/2009 12:37'!
I am raised on an attempt to create a file or directory over top of an existing file.!
!FileExistsException commentStamp: 'TorstenBergmann 2/3/2014 23:37'!
Notify when file exists!
!FileExistsException methodsFor: 'accessing' stamp: 'LC 10/24/2001 21:42'!
fileClass: aClass
	fileClass := aClass! !

!FileExistsException methodsFor: 'accessing' stamp: 'LC 10/24/2001 21:49'!
fileClass
	^ fileClass ifNil: [StandardFileStream]! !

!FileExistsException methodsFor: 'exceptiondescription' stamp: 'pavel.krivanek 6/17/2010 10:00'!
defaultAction
	"The default action taken if the exception is signaled."

	^ UIManager default fileExistsDefaultAction: self
! !

!FileExistsException class methodsFor: 'exceptioninstantiator' stamp: 'LC 10/24/2001 21:50'!
fileName: aFileName fileClass: aClass 
	^ self new
		fileName: aFileName;
		fileClass: aClass! !

!FileHandle commentStamp: 'cwp 11/18/2009 13:02'!
I provide an interface for doing IO on an open file. I keep an id, which as an opaque identifier used by the FilePlugin primitives. I translate positions from the 1-based indexes used in Smalltalk to the 0-based offsets used by the primitives.

I do not implement the primitives myself, instead delegating those to an instance of FilePluginPrimitives.!
!FileHandle methodsFor: 'streams-compatibility' stamp: 'MaxLeske 1/25/2014 23:07'!
binaryReadStream
	^ (FileStream onHandle: self)
		ifNil: [ self streamError ]
		ifNotNilDo: [ :stream | 
			stream
				binary;
				yourself ]! !

!FileHandle methodsFor: 'public' stamp: 'CamilloBruni 5/24/2012 15:20'!
size
	
	self flag: 'TODO: remove once FileHandles are really used!!'.
	self assureOpen.
	
	^ Primitives size: id! !

!FileHandle methodsFor: 'public' stamp: 'cwp 11/20/2009 14:59'!
close
	Primitives close: id.
	id := nil! !

!FileHandle methodsFor: 'testing' stamp: 'cwp 7/22/2009 07:10'!
isOpen
	^ (Primitives sizeOrNil: id) notNil! !

!FileHandle methodsFor: 'finalization' stamp: 'CamilloBruni 5/24/2012 15:07'!
finalize
	self primCloseNoError: id.! !

!FileHandle methodsFor: 'public' stamp: 'CamilloBruni 5/24/2012 15:20'!
at: index write: buffer startingAt: start count: count
	
	self flag: 'TODO: remove once FileHandles are really used!!'.
	self assureOpen.
	
	Primitives 
		setPosition: id to: index - 1;
		write: id from: buffer startingAt: start count: count
! !

!FileHandle methodsFor: 'finalization' stamp: 'CamilloBruni 5/24/2012 15:05'!
register
	"register the instance for proper clreanup on garbage collection"
	^self class register: self! !

!FileHandle methodsFor: 'public' stamp: 'abc 5/11/2012 23:22'!
readStream
	^ (FileStream onHandle: self)
		ifNil: [ self streamError ]
	! !

!FileHandle methodsFor: 'public' stamp: 'abc 5/11/2012 23:22'!
streamError
	reference exists
		ifFalse: [FileDoesNotExist signalWith: reference].
	self error: 'Unable to open file ' , reference printString! !

!FileHandle methodsFor: 'public' stamp: 'CamilloBruni 5/24/2012 15:20'!
at: index read: buffer startingAt: start count: count
	
	self flag: 'TODO: remove once FileHandles are really used!!'.
	self assureOpen.
	
	^ Primitives 
		setPosition: id to: index - 1;
		read: id into: buffer startingAt: start count: count
! !

!FileHandle methodsFor: 'public' stamp: 'CamilloBruni 5/24/2012 15:19'!
assureOpen
	"compatibility method to make the FileHandle Tests pass"
	self isOpen ifFalse: [ id := self basicOpen ].! !

!FileHandle methodsFor: 'private' stamp: 'cwp 11/20/2009 16:48'!
startUp
	"This functionality is disabled for now, to avoid doing lots of processing
	on start up."
	
	"We're starting up in a new OS process, so the file id will be invalid.
	Try to reopen the file, but fail silently: just leave the id as nil. #isOpen will
	answer false, and we'll raise an error if anyone tries to do IO."
	
	self basicOpen! !

!FileHandle methodsFor: 'public' stamp: 'abc 5/11/2012 23:22'!
writeStream
	^( FileStream onHandle: self)
		 ifNil: [ self streamError ]! !

!FileHandle methodsFor: 'public' stamp: 'CamilloBruni 5/24/2012 15:20'!
flush
	
	self flag: 'TODO: remove once FileHandles are really used!!'.
	self assureOpen.
	
	Primitives flush: id! !

!FileHandle methodsFor: 'public' stamp: 'CamilloBruni 5/24/2012 15:18'!
open
	self flag: 'TODO: for now we solely rely on the old FileStreams'
	"id := self basicOpen.
	id ifNil: 	[
		reference exists ifFalse: [FileDoesNotExist signalWith: reference].
		self error: 'Unable to open file ' , reference printString]"! !

!FileHandle methodsFor: 'public' stamp: 'cwp 7/22/2009 08:17'!
truncateTo: anInteger
	Primitives truncate: id to: anInteger.
	self reopen! !

!FileHandle class methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 5/24/2012 15:06'!
registry
	^Registry ifNil: [Registry := WeakRegistry new]
! !

!FileHandle class methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 5/24/2012 15:06'!
register: aFileHandle
	"properly register the given FileHandle for being closed on garbage collection"
	^self registry add: aFileHandle! !

!FileHandle class methodsFor: 'class initialization' stamp: 'cwp 11/20/2009 16:16'!
initialize
	self useFilePlugin.
! !

!FileHandle class methodsFor: 'class initialization' stamp: 'EstebanLorenzano 4/2/2012 11:46'!
useFilePlugin
	Primitives := FilePluginPrims new! !

!FileHandle class methodsFor: 'class initialization' stamp: 'cwp 11/20/2009 16:51'!
startUp: resuming
	"This functionality is disabled for now, to avoid doing a lot of processing at
	image start up. To reenable, add this class to the start up list."
	
	resuming ifTrue: [self allInstancesDo: [:ea | ea startUp]]! !

!FileHandleTest commentStamp: 'TorstenBergmann 1/31/2014 11:49'!
SUnit tests for file handles, the tests may be found in superclass!
!FileHandleTest methodsFor: 'running' stamp: 'EstebanLorenzano 4/3/2012 11:42'!
createFileSystem
	^ FileSystem store: DiskStore activeClass createDefault! !

!FileList commentStamp: 'StephaneDucasse 3/28/2010 20:44'!
A FileList is a tool to deal with files.

FileList open				"open FileList"!
!FileList methodsFor: 'private' stamp: 'CamilloBruni 8/14/2011 15:48'!
selectedDirectory
	^ self directory! !

!FileList methodsFor: 'drag''n''drop' stamp: 'MarcusDenker 10/15/2013 18:18'!
acceptDroppingMorph: aTransferMorph event: evt inMorph: dest
	| oldEntry destDirectory newEntry response |
	destDirectory := self dropDestinationDirectory: dest event: evt.
	oldEntry := FileSystem disk referenceTo: aTransferMorph passenger.
	newEntry := destDirectory / oldEntry basename.
	oldEntry = newEntry ifTrue: [ "Transcript nextPutAll: 'same as old name'; cr." ^ true ].
	newEntry ifNotNil: [ | msg |
		msg := String streamContents: [ :s |
			s nextPutAll: 'destination file ';
				nextPutAll: newEntry parent fullName;
				nextPutAll: ' exists already,';
				cr;
				nextPutAll: 'and is ';
				nextPutAll: (oldEntry modificationTime < newEntry modificationTime
					ifTrue: [ 'newer' ] ifFalse: [ 'not newer' ]);
				nextPutAll: ' than source file ';
				nextPutAll: oldEntry parent fullName;
				nextPut: $.;
				cr;
				nextPutAll: 'Overwrite file ';
				nextPutAll: newEntry basename;
				nextPut: $?
		].
		response := self confirm: msg.
		response ifFalse: [ ^false ].
	].

	aTransferMorph shouldCopy
		ifTrue: [ oldEntry copyAs: newEntry ]
		ifFalse: [ oldEntry renameTo: newEntry ].

	self updateFileList; fileListIndex: 0.

	aTransferMorph source model ~= self
		ifTrue: [ aTransferMorph source model updateFileList; fileListIndex: 0 ].
	"Transcript nextPutAll: 'copied'; cr."
	^true! !

!FileList methodsFor: 'private' stamp: 'onierstrasz 11/11/2013 12:26'!
okHit
	ok := true.
	self directory
		ifNil: [self inform: 'Missing directory']
		ifNotNil: [modalView delete]! !

!FileList methodsFor: 'private' stamp: 'CamilloBruni 8/12/2011 20:10'!
postOpen

	reference ifNotNil: [
		self changed: #(openPath) , reference pathSegments. 
	].
! !

!FileList methodsFor: 'private' stamp: 'NicolaiHess 12/1/2013 01:54'!
filesMatching: aRegex
	"Answer a list of directory entries which match the patternString.
	The patternString may consist of multiple patterns separated by ';'.
	Each pattern can include a '*' or '#' as wildcards - see String>>match:"

	| files |
	files :=  [self directory files] on:DirectoryDoesNotExist do:[#()].
	pattern ifNil: [ ^ files ].
	^ files select: [:entry | (aRegex search: entry basename)]! !

!FileList methodsFor: 'private' stamp: 'CamilloBruni 8/12/2011 20:25'!
directoriesFor: directory
	"item may be file directory or server directory"
	| entries |
	entries := directory directories.
	dirSelectionBlock ifNotNil:[ entries := entries select: dirSelectionBlock ].
	^entries! !

!FileList methodsFor: 'private' stamp: 'PavelKrivanek 7/13/2012 14:07'!
findFileListIndex: aMorphTreeSelectionChanged 
	| node selectedPath |
	
	selectedPath := aMorphTreeSelectionChanged selection selectedNodePath.
	selectedPath ifNil: [^ self].
	node := selectedPath first.
	self fileListIndex: (self fileList indexOf: node item).
! !

!FileList methodsFor: 'initialization' stamp: 'CamilloBruni 4/24/2013 19:27'!
initialDirectoryList

	| dirList |
	dirList := self fileSystem root directories collect: [ :each |
		FileDirectoryWrapper with: each name: each basename model: self].
	
	dirList isEmpty ifTrue:[
		dirList := Array with: (FileDirectoryWrapper 
			with: self fileSystem workingDirectory
			name: self fileSystem workingDirectory basename 
			model: self)].
		
	^dirList! !

!FileList methodsFor: 'own services' stamp: 'sw 2/22/2002 02:35'!
okayAndCancelServices
	"Answer ok and cancel services"

	^ {self serviceOkay. self serviceCancel}! !

!FileList methodsFor: 'initialization' stamp: 'CamilloBruni 8/12/2011 20:18'!
labelString
	reference ifNil: [ ^ '[]' ].
	^ reference basename  contractTo: 50! !

!FileList methodsFor: 'file menu action' stamp: 'hfm 11/29/2008 19:24'!
getHex
	"Get contents of file again, and display in Hex. Do this by making the cancel string be the contents, and doing a cancel."

	Cursor read showWhile: [
		brevityState := #needToGetBriefHex.
		self changed: #contents].
! !

!FileList methodsFor: 'user interface' stamp: ''!
morphicGrid
	grid := FileListGrid new
		parent: self.
	grid
		onSelectionChangeSend: #findFileListIndex: to: self ;
		menu: #fileListMenu  shifted: false.
	^ grid treeMorph
! !

!FileList methodsFor: 'private' stamp: 'CamilloBruni 7/10/2012 21:59'!
sortBlockTimestamp
	"Answer block to decide what order to display the directory entries."

	^ [ :x :y | |xIsDir|
			((xIsDir := x isDirectory) = y isDirectory) 
				ifTrue: [   x modificationTime  <= y modificationTime ]
				ifFalse: [
					"directories always precede files"
					xIsDir ]]! !

!FileList methodsFor: 'initialization' stamp: 'MarcusDenker 8/15/2010 15:05'!
initialize
	super initialize.
	ok := false.
	dirSelectionBlock := [ :dirName | true].! !

!FileList methodsFor: 'initialization' stamp: 'SeanDeNigris 7/12/2012 08:44'!
setFileStream: aStream
	"Used to initialize a spawned file editor.  Sets directory too."
	self directory: aStream name asFileReference.
	pattern := nil.
	aStream close.
	brevityState := #needToGetBrief.
	self changed: #fileList.
	self changed: #contents.
	self changed: #selectedDirectory.
! !

!FileList methodsFor: 'user interface' stamp: 'AlainPlantec 8/28/2011 13:51'!
morphicFileContentsPane

	^(PluggableTextMorph 
		on: self 
		text: #contents 
		accept: #put:
		readSelection: nil 
		menu: #fileContentsMenu:shifted:) 
! !

!FileList methodsFor: 'initialization' stamp: 'NicolaiHess 2/7/2014 23:51'!
folderSelectButtonRow
	"Answer the button row used for folder selection"

	| aRow |
	aRow := AlignmentMorph newRow beSticky.
	aRow color: Color transparent.
	aRow clipSubmorphs: true.
	aRow layoutInset: 0@0; cellInset: 6.
	aRow setNameTo: 'buttons'.
	^ aRow! !

!FileList methodsFor: 'own services' stamp: 'tbn 8/11/2010 10:17'!
serviceViewContentsInWorkspace
	"Answer a service for viewing the contents of a file in a workspace"
	
	^ (SimpleServiceEntry 
		provider: self 
		label: 'Workspace with contents' 
		selector: #viewContentsInWorkspace)
		description: 'Open a new Workspace whose contents are set to the contents of this file'! !

!FileList methodsFor: 'private' stamp: 'CamilloBruni 2/14/2012 14:54'!
defaultContents
	contents := list isNil
		ifTrue: [String new]
		ifFalse: [
			String streamContents: [:s | 
				s << 'NO FILE SELECTED' translated; cr.
				s << '  -- Folder Summary --' translated; cr.
				list do: [:item | s << item basename; cr]]].
	brevityState := #FileList.
	^ contents! !

!FileList methodsFor: 'volume list and pattern' stamp: 'MarcusDenker 2/11/2012 13:57'!
volumeList
	"Answer the current list of volumes."

	^ volumeList
! !

!FileList methodsFor: 'private' stamp: 'NicolaiHess 2/8/2014 00:10'!
getSelectedFolder
	"Answer the selected folder or nil if dialog was canceled"

	ok ifFalse: [ ^ nil ].
	^ self directory! !

!FileList methodsFor: '*Shout-Styling' stamp: 'AlainPlantec 8/27/2011 00:26'!
shoutAboutToStyle: aPluggableShoutMorphOrView 
	^ false! !

!FileList methodsFor: 'private' stamp: 'NicolaiHess 11/27/2014 21:53'!
updateFileList
	"Update my files list with file names in the current directory  
	that match the pattern.
	The pattern string may have embedded newlines or semicolons; these separate different patterns."
	list := self listForPattern: pattern.
	listIndex := self getListIndex.
	volumeListIndex := volumeList size.
	contents := ''.
	self changed: #volumeListIndex.
	self changed: #fileList.
	self grid updateList.
	self updateButtonRow! !

!FileList methodsFor: 'own services' stamp: 'tbn 8/11/2010 10:59'!
serviceAddNewFile
	"Answer a service entry characterizing the 'add new file' command"

	^(SimpleServiceEntry 
		provider: self 
		label: 'Add new file' 
		selector: #addNewFile 
		description: 'Create a new,. empty file, and add it to the current directory.')
		usingLineAfter: false! !

!FileList methodsFor: 'own services' stamp: 'sw 2/22/2002 02:36'!
servicesForFolderSelector
	"Answer the ok and cancel servies for the folder selector"

	^ self okayAndCancelServices! !

!FileList methodsFor: 'own services' stamp: 'CarloTeixeira 7/3/2010 22:25'!
deleteDirectory
	self basicDeleteDirectory.
	self updateFileList.
	self updateDirectory.
! !

!FileList methodsFor: 'own services' stamp: 'CamilloBruni 7/10/2012 22:34'!
openImageInWindow
	"Handle five file formats: GIF, JPG, PNG, Form stoteOn: (run coded), and
	BMP. Fail if file format is not recognized."
	| image |
	self reference streamWritable: false do: [ :stream|
		image := Form fromBinaryStream: stream].
	
	(World drawingClass withForm: image) openInWorld! !

!FileList methodsFor: 'private' stamp: 'AlexisParseghian 3/25/2012 20:24'!
selectEncoding
	"self new selectEncoding"
	
	| aMenu  |
	aMenu := UIManager default 
				newMenuIn: self for: self.
				
	TextConverter allSubclasses do: [:each | | names |
		names := each encodingNames.
		names notEmpty ifTrue: [ | label |
			label := '' writeStream.
			names 
				do: [ :eachName | label nextPutAll: eachName ] 
				separatedBy: [ label nextPutAll: ', '].
			aMenu  "add: label contents action: names first asSymbol"
				add: label contents
				target: self
				selector: #fileEncoding: 
				argument: names first asSymbol ]].
	
	aMenu popUpInWorld! !

!FileList methodsFor: 'volume list and pattern' stamp: 'HilaireFernandes 1/2/2014 23:57'!
volumeListIndex: index
	"Select the volume name having the given index."

	| delim path |
	volumeListIndex := index.
	index = 1 
		ifTrue: [self directory: FileSystem disk root ]
		ifFalse: [
			delim := reference fileSystem delimiter.
			path := String streamContents: [:stream |
				2 to: index do: [:i |
					stream nextPutAll: (volumeList at: i) trimBoth.
					i < index ifTrue: [stream nextPut: delim]]]].
	brevityState := #FileList.
	self addPath: path.
	self changed: #fileList.
	self changed: #contents.
	self updateButtonRow! !

!FileList methodsFor: 'file menu action' stamp: 'MarcusDenker 8/15/2010 15:06'!
get
	"Get contents of file again, it may have changed. Do this by making the cancel string be the contents, and doing a cancel."

	Cursor read
		showWhile: [ 
			self okToChange
				ifFalse: [ ^ nil ].
			brevityState := brevityState == #briefHex
				ifTrue: [ #needToGetFullHex ]
				ifFalse: [ #needToGetFull ].
			self changed: #contents ]! !

!FileList methodsFor: 'accessing' stamp: 'CamilloBruni 2/16/2012 12:13'!
reference
	^ reference! !

!FileList methodsFor: 'accessing' stamp: 'CamilloBruni 2/16/2012 12:14'!
directory: dir
	^ self reference: dir! !

!FileList methodsFor: 'own services' stamp: 'HilaireFernandes 1/2/2014 23:58'!
basicDeleteDirectory
	"Remove the currently selected directory"
	reference entries isEmpty
		 ifFalse:[^self inform:'Directory must be empty'].
	
	(self confirm: 'Really delete ' , reference basename , '?') 
		ifFalse: [^ self].
	
	self volumeListIndex: self volumeListIndex-1.

	reference delete.
	self directory: reference parent! !

!FileList methodsFor: 'own services' stamp: 'tbn 8/11/2010 10:14'!
serviceGetHex

	^  (SimpleServiceEntry 
			provider: self 
			label: 'View as hex' 
			selector: #getHex
			description: 'View as hex')
			
! !

!FileList methodsFor: 'own services' stamp: 'GabrielOmarCotelli 11/30/2013 16:15'!
servicesFromSelectorSpecs: symbolArray
	"Answer an array of services represented by the incoming symbols, eliminating any that do not have a currently-registered service.  Pass the symbol #- along unchanged to serve as a separator between services"

	"FileList new servicesFromSelectorSpecs: #(fileIn: fileIntoNewChangeSet: browseChangesFile:)"

	| registeredServices services |
	services := OrderedCollection new.
	registeredServices := self class allRegisteredServices.
	symbolArray
		do: [ :sel | 
			sel == #-
				ifTrue: [ services add: sel ]
				ifFalse: [ registeredServices detect: [ :each | each selector = sel ] ifFound: [ :service | services add: service ] ] ].
	^ services! !

!FileList methodsFor: 'accessing' stamp: 'hfm 11/29/2008 18:30'!
fileList
	"Answer the list of files in the current volume."

	^ list! !

!FileList methodsFor: 'file menu action' stamp: 'S 6/17/2013 13:24'!
addNewFile
	self 
		addNew: 'File'
		byEvaluating: [:newName | (self directory / newName) ensureCreateFile ]
! !

!FileList methodsFor: 'private' stamp: 'CamilloBruni 7/10/2012 22:53'!
readContentsBrief: brevityFlag
	"Read the contents of the receiver's selected file, unless it is too long, in which case show just the first 5000 characters. Don't create a file if it doesn't already exist."
	| fileSize first5000 |

	self reference streamWritable: false do: [:f|		
		(brevityFlag not or: [(fileSize := f size) <= 100000]) 
			ifTrue:[
				contents := [ f contents asString ]
					on: Error
					do: [ :ex | ^ f binary contents asString ].
				brevityState := #fullFile.   "don't change till actually read"
				^ contents].

		"if brevityFlag is true, don't display long files when first selected"
		[ first5000 := f next: 5000 ]
			on: Error
			do: [ :ex | first5000 := (f binary next: 5000) asString  ]].
	
	contents := '{1}
------------------------------------------
... end of the first 5000 characters.' translated format: {first5000}.
	brevityState := #briefFile.   "don't change till actually read"
	^ contents.
! !

!FileList methodsFor: 'private' stamp: 'GabrielOmarCotelli 11/30/2013 16:11'!
addPath: aString
	"Add the given string to the list of recently visited directories."

	| full |
	aString ifNil: [^self].
	full := String streamContents: [ :strm | 
		2 to: volumeList size do: [ :i | 
			strm nextPutAll: (volumeList at: i) trimBoth.
			strm nextPut: FileSystem disk separator]].
	full := full, aString.
"Remove and super-directories of aString from the collection."
	RecentDirs removeAllSuchThat: [ :aDir | ((aDir, '*') match: full)].

"If a sub-directory is in the list, do nothing."
	RecentDirs detect: [ :aDir | ((full, '*') match: aDir)] ifFound: [^self].

	[RecentDirs size >= 10]
		whileTrue: [RecentDirs removeFirst].
	RecentDirs addLast: full! !

!FileList methodsFor: 'drag''n''drop' stamp: 'nk 6/15/2003 22:00'!
isDirectoryList: aMorph
	^aMorph isKindOf: SimpleHierarchicalListMorph! !

!FileList methodsFor: 'volume list and pattern' stamp: 'EstebanLorenzano 4/2/2012 11:43'!
veryDeepFixupWith: deepCopier
	super veryDeepFixupWith: deepCopier.
	volumeListIndex := 1.
	self directory: FileSystem disk workingDirectory.
	self updateFileList! !

!FileList methodsFor: 'private' stamp: 'CamilloBruni 8/14/2011 15:50'!
setSelectedDirectoryTo: aFileDirectoryWrapper
	self directory: aFileDirectoryWrapper withoutListWrapper.
	brevityState := #FileList.
	"self addPath: path."
	self changed: #fileList.
	self changed: #contents.
	self changed: #selectedDirectory.! !

!FileList methodsFor: 'private' stamp: 'EstebanLorenzano 4/2/2012 11:43'!
recentDirs
	"Put up a menu and let the user select from the list of recently visited directories."

	| dirName |
	RecentDirs isEmpty ifTrue: [ ^ self ].
	dirName := UIManager default chooseFrom: RecentDirs values: RecentDirs.
	dirName ifNil: [ ^ self ].
	self directory: (FileSystem disk root resolve: dirName)! !

!FileList methodsFor: 'private' stamp: 'CamilloBruni 8/12/2011 20:09'!
isFileSelected
	"return if a file is currently selected"

	^ reference notNil and: [ reference isFile ].! !

!FileList methodsFor: 'user interface' stamp: 'CamilloBruni 2/16/2012 11:15'!
optionalButtonSpecs: aSpecArray
	optionalButtonSpecs := aSpecArray! !

!FileList methodsFor: 'volume list and pattern' stamp: 'CamilloBruni 8/12/2011 21:40'!
volumeListIndex
	"Answer the index of the currently selected volume."

	^ volumeListIndex
! !

!FileList methodsFor: 'drag''n''drop' stamp: 'CamilloBruni 8/12/2011 22:03'!
dragPassengerFor: item inMorph: dragSource
	^ item contents copy
! !

!FileList methodsFor: 'file list menu' stamp: 'CamilloBruni 8/12/2011 21:27'!
itemsForNoFile

	| services |
	services := OrderedCollection new.
	services addAll: (self itemsForDirectory: (self isFileSelected ifFalse: [ self directory ] ifTrue: [])).
	^ services

		! !

!FileList methodsFor: 'own services' stamp: 'tbn 8/11/2010 10:14'!
serviceDeleteFile

	^ (SimpleServiceEntry 
		provider: self 
		label: 'Delete' 
		selector: #deleteFile)
		description: 'Delete the seleted item'! !

!FileList methodsFor: 'own services' stamp: 'CamilloBruni 7/10/2012 22:34'!
viewContentsInWorkspace
	"View the contents of my selected file in a new workspace"
	
	| aString |
	
	self reference streamWritable: false do: [ :stream|
		aString := stream setConverterForCode contentsOfEntireFile ].
	
	UIManager default edit: aString label: 'Workspace from ', self reference basename! !

!FileList methodsFor: 'accessing' stamp: 'MarcusDenker 12/2/2013 14:14'!
reference: dir
	| tmpReference |
	"Set the path of the volume to be displayed."
	self okToChange ifFalse: [^ self].
	
	tmpReference := dir 
		ifNotNil: [ :d| d asFileReference]
		ifNil: [ FileSystem disk workingDirectory ].
	tmpReference isReadable 
		ifFalse: [ ^ self inform: ('Cannot read {1}' translated format: { tmpReference})].
	reference := tmpReference.
	sortMode ifNil: [sortMode := #date].
	
	volumeList := ((Array with: '[]'), reference pathSegments)  
				withIndexCollect: [:each :i | ( String new: i-1 withAll: $ ), each].
	
	volumeListIndex  := volumeList size.	
		
	self changed: #relabel.
	self changed: #volumeList.
	self updateFileList.! !

!FileList methodsFor: 'own services' stamp: 'tbn 8/11/2010 10:14'!
serviceOkay
	"Answer a service for hitting the okay button"

	^ (SimpleServiceEntry new
		provider: self 
		label: 'Okay' 
		selector: #okHit 
		description: 'Hit here to accept the current selection')
		buttonLabel: 'Ok'! !

!FileList methodsFor: 'private' stamp: 'hfm 11/29/2008 18:38'!
registeredFileReaderClasses
	"return the list of classes that provide file reader services"

	^ self class registeredFileReaderClasses! !

!FileList methodsFor: 'file menu action' stamp: 'hfm 11/29/2008 19:24'!
getEncodedText

	Cursor read showWhile: [
		self selectEncoding.
		self changed: #contents].
! !

!FileList methodsFor: 'user interface' stamp: 'RAA 2/17/2001 12:18'!
morphicDirectoryTreePane

	^self morphicDirectoryTreePaneFiltered: #initialDirectoryList
! !

!FileList methodsFor: 'file list' stamp: 'CamilloBruni 2/16/2012 12:29'!
readOnlyStream
	"Answer a read-only stream on the selected file. For the various stream-reading services."
	
	^ MultiByteFileStream readOnlyFileNamed: self reference fullName! !

!FileList methodsFor: 'accessing' stamp: 'CamilloBruni 8/12/2011 21:18'!
pattern
	^ pattern 
! !

!FileList methodsFor: 'file list menu' stamp: 'hfm 11/29/2008 18:42'!
itemsForAnyFile
	"Answer a list of universal services that could apply to any file"
	
	| services |
	services := OrderedCollection new: 4.
	services add: self serviceCopyName. 
	services add: self serviceRenameFile. 
	services add: self serviceDeleteFile.
	services add: self serviceViewContentsInWorkspace.
	^ services! !

!FileList methodsFor: 'initialization' stamp: 'CamilloBruni 8/14/2011 15:50'!
updateDirectory
	"directory has been changed externally, by calling directory:.
	Now change the view to reflect the change."
	self changed: #selectedDirectory.
	self postOpen.! !

!FileList methodsFor: 'volume list and pattern' stamp: 'CamilloBruni 8/12/2011 21:14'!
listForPattern: aPattern
	"Make the list be those file names which match the pattern."

	| newList |
	newList := self filesMatching: aPattern.
	newList := newList asArray sort: self sortBlock.
	^ newList ! !

!FileList methodsFor: 'own services' stamp: 'tbn 8/11/2010 10:13'!
serviceCompressFile
	"Answer a service for compressing a file"

	^ SimpleServiceEntry 
		provider: self 
		label: 'Compress' 
		selector: #compressFile 
		description: 'Compress file' 
		buttonLabel: 'Compress'! !

!FileList methodsFor: 'accessing' stamp: 'CamilloBruni 2/14/2012 15:02'!
getListIndex
	^ list indexOf: reference ifAbsent: [ 0 ]! !

!FileList methodsFor: 'private' stamp: ''!
sortBlockBasename
	"Answer block to decide what order to display the directory entries."

	^ [ :x :y | |xIsDir|
			((xIsDir := x isDirectory) = y isDirectory) 
				ifTrue: [   x basename <= y basename  ]
				ifFalse: [
					"directories always precede files"
					xIsDir ]]! !

!FileList methodsFor: 'user interface' stamp: 'CamilloBruni 2/16/2012 11:15'!
optionalButtonSpecs
	^ optionalButtonSpecs! !

!FileList methodsFor: 'initialization' stamp: 'CamilloBruni 8/12/2011 21:56'!
optionalButtonRow
	"Answer the button row associated with a file list"

	| aRow |
	aRow := AlignmentMorph newRow beSticky.
	aRow color: Color transparent.
	aRow clipSubmorphs: true.
	aRow layoutInset: 0@0; cellInset: 6.
	aRow setNameTo: 'buttons'.
	aRow setProperty: #buttonRow toValue: true.  "Used for dynamic retrieval later on"
	^ aRow! !

!FileList methodsFor: 'user interface' stamp: 'CamilloBruni 8/14/2011 15:19'!
morphicPatternPane
	"Remove the vertical scrollbar since the minHeight would otherwise
	be too large to fit the layout frame. Added here for Pharo since
	FileList2 has been merged into FileList."
	
	^ SearchMorph new
		model: self;
		setIndexSelector: #pattern:;
		searchList: self class searchList;
		vResizing: #spaceFill;
		hResizing: #spaceFill;
		yourself! !

!FileList methodsFor: 'initialization' stamp: 'tbn 6/29/2012 10:58'!
dynamicButtonServices
	"Answer services for buttons that may come and go in the button pane, depending on selection"

	^ reference isDirectory 
		ifTrue: [#()]
		ifFalse:
			[ | toReject |
				toReject := self buttonSelectorsToSuppress.
				(self itemsForFile: reference) reject:
					[:svc | toReject includes: svc selector]]! !

!FileList methodsFor: 'own services' stamp: 'tbn 8/11/2010 10:13'!
serviceCancel
	"Answer a service for hitting the cancel button"

	^ (SimpleServiceEntry new
		provider: self label: 'Cancel' 
		selector: #cancelHit 
		description: 'Hit here to cancel ')
		buttonLabel: 'Cancel'! !

!FileList methodsFor: 'drag''n''drop' stamp: 'hfm 11/29/2008 19:21'!
dragTransferTypeForMorph: aMorph
	^#file! !

!FileList methodsFor: 'file menu action' stamp: 'tbn 4/23/2012 16:24'!
renameFile
	"Rename the currently selected file"
	| newName response |
	listIndex = 0 ifTrue: [^ self].
	self okToChange ifFalse: [^ self].
	(response := UIManager default request: 'NewFileName?' translated
 					initialAnswer: reference basename)
		isEmptyOrNil ifTrue: [^ self].
	newName := response asFileName.
	newName = reference basename ifTrue: [^ self].
	reference renameTo: newName.
	self updateFileList.
	listIndex := list findFirst: [:item | item = newName].
	
	listIndex > 0 
		ifTrue: [reference := newName].
	self changed: #fileListIndex.
! !

!FileList methodsFor: 'private' stamp: 'AlexisParseghian 3/25/2012 23:26'!
fileEncoding: aByteSymbol 
	fileEncoding := aByteSymbol.
	brevityState := #needToGetBrief.
	self changed: #contents! !

!FileList methodsFor: 'own services' stamp: 'tbn 8/11/2010 10:14'!
serviceGetEncodedText

	^  (SimpleServiceEntry 
			provider: self 
			label: 'View as encoded text'
			selector: #getEncodedText
			description: 'View as encoded text')

! !

!FileList methodsFor: 'private' stamp: 'AlexisParseghian 3/26/2012 00:19'!
sortBlock: aBlockClosure 
	sortBlock := aBlockClosure.
	self updateFileList! !

!FileList methodsFor: 'private' stamp: 'CamilloBruni 2/16/2012 19:07'!
fullName
	"Answer the full name for the currently selected file; answer nil if no file is selected."
	^ reference fullName! !

!FileList methodsFor: 'file list menu' stamp: 'CamilloBruni 8/12/2011 20:03'!
fileListMenu: aMenu

	reference
		ifNil: [^ self noFileSelectedMenu: aMenu]
		ifNotNil: [^ self fileSelectedMenu: aMenu].
! !

!FileList methodsFor: 'file list menu' stamp: 'hfm 11/29/2008 19:33'!
suffixOfSelectedFile
	"Answer the file extension of the receiver's selected file"
	^ self class suffixOf: self fullName.! !

!FileList methodsFor: 'accessing' stamp: 'CamilloBruni 2/14/2012 14:37'!
directory
	
	^ reference isFile 
		ifTrue: [ reference parent ]
		ifFalse: [ reference ]! !

!FileList methodsFor: 'accessing' stamp: 'CamilloBruni 4/24/2013 19:27'!
fileSystem
	^ reference 
		ifNil: [ FileSystem disk ]
		ifNotNil: [ reference fileSystem ]! !

!FileList methodsFor: 'private' stamp: 'CamilloBruni 7/10/2012 22:00'!
sortBlockPermissions
	"Answer block to decide what order to display the directory entries."

	^ [ :x :y | |xIsDir|
			((xIsDir := x isDirectory) = y isDirectory) 
				ifTrue: [   x permissions <= y permissions  ]
				ifFalse: [
					"directories always precede files"
					xIsDir ]]! !

!FileList methodsFor: 'file menu action' stamp: 'CamilloBruni 7/10/2012 22:50'!
deleteFile
	"Delete the currently selected file"
	listIndex = 0 ifTrue: [^ self].
	
	(self confirm: ('Really delete {1}?' translated format: { reference basename } ))
		ifFalse: [^ self].
	
	reference delete.
	reference := reference parent.
	
	self updateFileList.
	brevityState := #FileList.
	self get! !

!FileList methodsFor: 'own services' stamp: 'S 6/17/2013 13:26'!
addNewDirectory
	self 
		addNew: 'Directory'
		byEvaluating: [:newName | 
			(self directory / newName ) ensureCreateDirectory ]
! !

!FileList methodsFor: 'private' stamp: 'AlexisParseghian 3/26/2012 00:15'!
sortBlock
	"Answer block to decide what order to display the directory entries."

	^ sortBlock ifNil: [ sortBlock := self sortBlockBasename ]! !

!FileList methodsFor: 'own services' stamp: 'tbn 8/11/2010 10:15'!
serviceRenameFile

	^ (SimpleServiceEntry 
		provider: self 
		label: 'Rename' 
		selector: #renameFile 
		description: 'Rename file')! !

!FileList methodsFor: 'user interface' stamp: 'AlexisParseghian 3/15/2012 23:57'!
grid
	^ grid ifNil: [ grid := self morphicGrid ]! !

!FileList methodsFor: 'drag''n''drop' stamp: 'nk 6/15/2003 13:07'!
dropDestinationDirectory: dest event: evt
	"Answer a FileDirectory representing the drop destination in the directory hierarchy morph dest"
	^ (dest itemFromPoint: evt position) withoutListWrapper! !

!FileList methodsFor: 'menu messages' stamp: 'hfm 11/29/2008 19:22'!
copyName

	listIndex = 0 ifTrue: [^ self].
	Clipboard clipboardText: self fullName asText.
! !

!FileList methodsFor: 'own services' stamp: 'tbn 8/11/2010 10:14'!
serviceGet
	"Answer a service for getting the entire file"

	^  (SimpleServiceEntry 
			provider: self 
			label: 'Get entire file' 
			selector: #get
			description: 'If the file has only been partially read in, because it is very large, read the entire file in at this time.')! !

!FileList methodsFor: 'drag''n''drop' stamp: 'BenjaminVanRyseghem 11/5/2013 11:23'!
wantsDroppedMorph: aTransferMorph event: evt inMorph: dest
	| retval |
	retval := (aTransferMorph isTransferable)
		and: [ (aTransferMorph dragTransferType == #file)
				and: [ self isDirectoryList: dest ]].
	^retval! !

!FileList methodsFor: 'volume list and pattern' stamp: 'CamilloBruni 1/17/2012 16:20'!
changeDirectoryTo: aFileDirectory
	"Change directory as requested."
	self directory: aFileDirectory.
	self updateDirectory! !

!FileList methodsFor: 'menu messages' stamp: 'CamilloBruni 8/12/2011 21:37'!
perform: selector orSendTo: otherTarget 
	"Selector was just chosen from a menu by a user.
	If it's one of the three sort-by items, handle it specially.
	If I can respond myself, then perform it on myself. 
	If not, send it to otherTarget, presumably the editPane from which the menu was invoked."
 
	^ (#(get getHex copyName openImageInWindow renameFile deleteFile deleteDirectory addNewFile recentDirs ) includes: selector)
				ifTrue: [self perform: selector]
				ifFalse: [super perform: selector orSendTo: otherTarget]! !

!FileList methodsFor: 'file menu action' stamp: 'NicolaiHess 2/8/2014 00:27'!
addNew: aString byEvaluating: aBlock
	"A parameterization of earlier versions of #addNewDirectory and
	#addNewFile.  Fixes the bug in each that pushing the cancel button
	in the FillInTheBlank dialog gave a walkback."

	| response newName index |
	self okToChange ifFalse: [^ self].
	(response := UIManager default
						request: ('New {1} Name?' translated format: {aString translated})
						initialAnswer: ('{1}Name' translated format: {aString translated}))
		isEmptyOrNil ifTrue: [^ self].
	newName := response asFileName.
	Cursor wait showWhile: [
		aBlock value: newName].
	self updateFileList.
	self updateDirectory.
	list ifNotNil:[
	index := list indexOf: newName.
	index = 0 ifTrue: [
		index := list findFirst: [:line | line basename endsWith: newName]].
	self fileListIndex: index.]
! !

!FileList methodsFor: 'volume menu' stamp: 'StephaneDucasse 10/27/2014 09:34'!
volumeMenu: aMenu
	aMenu 
		add: 'Recent...'  selector:	#recentDirs;
		addLine;
		add: 'Delete directory...' selector: #deleteDirectory; 
		addLine.
	aMenu
		addServices: (self itemsForDirectory: self directory)
		for: self
		extraLines: #().
	^aMenu.! !

!FileList methodsFor: 'private' stamp: 'CamilloBruni 2/14/2012 14:56'!
selectedDirectory: aFileDirectoryWrapper
	| file |
	file := aFileDirectoryWrapper withoutListWrapper.
	file ifNil: [ 
		brevityState := #FileList.
		self changed: #fileList.
		self changed: #selectedDirectory.
		^ self ].
	self directory: file.
	brevityState := #FileList.
	"self addPath: path."
	self changed: #fileList.
	self changed: #contents.
	self changed: #selectedDirectory.! !

!FileList methodsFor: 'file list menu' stamp: 'EstebanLorenzano 2/1/2013 11:24'!
fileContentsMenu: aMenu shifted: shifted
	"Construct aMenu to have items appropriate for the file browser's code pane, given the shift state provided"

	| shiftMenu services maybeLine extraLines |
	shifted ifTrue:
		[shiftMenu := SmalltalkEditor shiftedYellowButtonMenu.
		^ aMenu addAllFrom: shiftMenu].
	reference ifNotNil:
		[services := OrderedCollection new.
		(#(briefHex briefFile needToGetBriefHex needToGetBrief) includes: brevityState) ifTrue:
			[services add: self serviceGet].
		(#(fullHex briefHex needToGetFullHex needToGetBriefHex) includes: brevityState) ifFalse:
			[services add: self serviceGetHex].
		(#(needToGetShiftJIS needToGetEUCJP needToGetCNGB needToGetEUCKR needToGetUTF8) includes: brevityState) ifFalse:
			[services add: self serviceGetEncodedText].
		maybeLine := services size.
		(FileStream sourceFileSuffixes includes: self suffixOfSelectedFile) ifTrue:
			[services addAll:
				(self servicesFromSelectorSpecs:
					#(fileIntoNewChangeSet: fileIn: browseChangesFile: browseFile:))].

		extraLines := OrderedCollection new.
		maybeLine > 0 ifTrue: [extraLines add: maybeLine].
		services size > maybeLine ifTrue: [extraLines add: services size].
		aMenu 
			addServices: services
			for: self reference
			extraLines: extraLines].

	aMenu addAllFromPragma: 'fileListContentMenu' target: self.

	^ aMenu
! !

!FileList methodsFor: 'file list menu' stamp: 'CamilloBruni 8/12/2011 20:51'!
itemsForFile: file
	"Answer a list of services appropriate for a file"
	^ (self class itemsForFile: file).! !

!FileList methodsFor: 'accessing' stamp: 'nice 5/13/2012 17:43'!
pattern: aStringOrNil
	pattern := aStringOrNil ifNotNil: [:aString |
		aString asString trimBoth
			ifEmpty: [nil]
			ifNotEmpty: [:trimmed | trimmed asRegex]].
	self updateFileList.
! !

!FileList methodsFor: 'file menu action' stamp: 'CamilloBruni 2/16/2012 12:17'!
compressFile
	"Compress the currently selected file"

	| f |
	f := StandardFileStream
				readOnlyFileNamed: self reference fullName.
	f compressFile.
	self updateFileList! !

!FileList methodsFor: 'own services' stamp: 'tbn 8/11/2010 10:13'!
serviceCopyName

	^ (SimpleServiceEntry 
		provider: self 
		label: 'Copy name to clipboard' 
		selector: #copyName 
		description: 'Copy name to clipboard' )! !

!FileList methodsFor: 'updating' stamp: 'hfm 11/29/2008 19:33'!
update: aParameter
	"Receive a change notice from an object of whom the receiver is a dependent"

	(aParameter == #fileListChanged) ifTrue: [self updateFileList].
	super update: aParameter! !

!FileList methodsFor: 'file list menu' stamp: 'MarcusDenker 3/3/2012 16:22'!
fileSelectedMenu: aMenu
	| n1 n2 n3 services |
	services := OrderedCollection withAll: (self itemsForFile: reference).
	n1 := services size.
	services addAll: self itemsForAnyFile.
	n2 := services size.
	services addAll: self itemsForNoFile.
	n3 := services size.
	services := services collect: [ :svc | svc copy.].
	services do: [ :svc | svc addDependent: self; doNotUseLineAfter ].
	^ aMenu 
		addServices: services 
		for: self
		extraLines: (Array with: n1 with: n2 with: n3)
! !

!FileList methodsFor: 'private' stamp: 'NicolaiHess 2/11/2014 23:51'!
put: aText
	"Private - put the supplied text onto the file"

	| ff type |
	brevityState == #fullFile 
		ifTrue:[
			ff := StandardFileStream newFileNamed:reference  fullName.
			Cursor write showWhile: [ff nextPutAll: aText asString; close].
			reference basename = ff localName 
				ifTrue: [contents := aText asString]
				ifFalse: [	 self updateFileList. "user renamed the file" ].
			^ true  "accepted"].

	listIndex = 0 
		ifTrue: [
			self inform: 'No fileName is selected' translated.
			^ false  "failed" ].
	type := 'These'.
	
	brevityState = #briefFile ifTrue: [type := 'Abbreviated'].
	brevityState = #briefHex ifTrue: [type := 'Abbreviated'].
	brevityState = #fullHex ifTrue: [type := 'Hexadecimal'].
	brevityState = #FileList ifTrue: [type := 'Directory'].
	
	self inform: ('{1} contents cannot
meaningfully be saved at present.' translated format:{type translated}).
	^ false  "failed"! !

!FileList methodsFor: 'file list menu' stamp: 'hfm 11/29/2008 19:26'!
noFileSelectedMenu: aMenu

	^ aMenu
		addServices: self itemsForNoFile 
		for: self
		extraLines: #()
		
! !

!FileList methodsFor: 'private' stamp: 'CamilloBruni 8/14/2011 15:33'!
cancelHit

	modalView delete.! !

!FileList methodsFor: 'file list menu' stamp: 'StephaneDucasse 3/5/2010 14:42'!
itemsForDirectory: dir 
	| services |
	services := OrderedCollection new.
	dir ifNotNil: [
		services
			addAll: (self class itemsForDirectory: dir).
		services last useLineAfter. ].
	services add: self serviceAddNewFile.
	services add: self serviceAddNewDirectory.
	^ services! !

!FileList methodsFor: 'initialization' stamp: 'GabrielOmarCotelli 11/30/2013 16:17'!
updateButtonRow
	"Dynamically update the contents of the button row, if any."

	self dependents
		detect: [ :m | m isSystemWindow and: [ m model == self ] ]
		ifFound: [ :aWindow | 
			| aRow |
			aRow := aWindow findDeepSubmorphThat: [ :m | m hasProperty: #buttonRow ] ifAbsent: [ ^ self ].
			aRow submorphs size - 1 timesRepeat: [ aRow submorphs last delete ].
			self dynamicButtonServices
				do: [ :service | 
					aRow addMorphBack: (service buttonToTriggerIn: self).
					service addDependent: self ] ]! !

!FileList methodsFor: 'user interface' stamp: 'AlexisParseghian 3/26/2012 00:18'!
setSortSelector: aByteSymbol 
	self sortBlock: (self perform: aByteSymbol).! !

!FileList methodsFor: 'private' stamp: 'CamilloBruni 7/10/2012 21:59'!
sortBlockFilesize
	"Answer block to decide what order to display the directory entries."

	^ [ :x :y | |xIsDir|
			((xIsDir := x isDirectory) = y isDirectory) 
				ifTrue: [   x size <= y size  ]
				ifFalse: [
					"directories always precede files"
					xIsDir ]]! !

!FileList methodsFor: 'own services' stamp: 'tbn 8/11/2010 10:12'!
serviceAddNewDirectory
	"Answer a service entry characterizing the 'add new directory' command"

	^ SimpleServiceEntry 
		provider: self 
		label: 'Add new directory' 
		selector: #addNewDirectory
		description: 'Adds a new, empty directory (folder)' ! !

!FileList methodsFor: 'initialization' stamp: 'MarcusDenker 5/25/2011 12:21'!
buttonSelectorsToSuppress
	"Answer a list of action selectors whose corresponding services we would prefer *not* to have appear in the filelist's button pane; this can be hand-jimmied to suit personal taste."

	^ #(removeLineFeeds: addFileToNewZip: compressFile:)! !

!FileList methodsFor: 'user interface' stamp: 'AlexisParseghian 3/15/2012 23:38'!
morphicFileListPane
	^ grid ifNil: [ grid := self morphicGrid ].
! !

!FileList methodsFor: 'private' stamp: 'CamilloBruni 7/10/2012 22:44'!
readContentsHex: brevity
	"retrieve the contents from the external file unless it is too long.
	  Don't create a file here.  Check if exists."
	| size data hexData s |

	self reference streamWritable: false do: [ :f| 
		f isNil 
			ifTrue: [^ 'For some reason, this file cannot be read' translated].
		f binary.
		((size := f size)) > 5000 & brevity
			ifTrue: [data := f next: 10000. f close. brevityState := #briefHex]
			ifFalse: [data := f contentsOfEntireFile. brevityState := #fullHex].

		s := (String new: data size*4) writeStream.
		0 to: data size-1 by: 16 do:
			[:loc | s nextPutAll: loc printStringHex; space;
				nextPut: $(; print: loc; nextPut: $); space; tab.
			loc+1 to: (loc+16 min: data size) do: [:i | s nextPutAll: (data at: i) printStringHex; space].
			s cr].
		hexData := s contents].
	
	^ contents := ((size > 5000) & brevity
		ifTrue: ['{3}
------------------------------------------
... end of the first 5000 characters.' translated format: {hexData}]
		ifFalse: [hexData]).
! !

!FileList methodsFor: 'accessing' stamp: 'MarcusDenker 10/15/2013 18:16'!
fileListIndex: anInteger
	"Select the file name having the given index, and display its contents."

	| item |
	self okToChange ifFalse: [^ self].
	listIndex := anInteger.
	listIndex = 0 
		ifFalse: [
			item := (list at: anInteger).
			item isDirectory
				ifTrue: [
					listIndex := 0.
					brevityState := #FileList.
					self addPath: item fullName.
					self directory: item ]
				ifFalse: [reference := item]].  "open the file selected"

	brevityState := #needToGetBrief.
	self changed: #fileListIndex.
	self changed: #contents.
	self updateButtonRow! !

!FileList methodsFor: 'private' stamp: 'RAA 6/21/2000 12:06'!
modalView: aSystemWindowOrSuch

	modalView := aSystemWindowOrSuch! !

!FileList methodsFor: 'accessing' stamp: 'CamilloBruni 2/14/2012 15:00'!
fileListIndex
	"Answer the index of the currently selected file."
	^ listIndex! !

!FileList methodsFor: 'user interface' stamp: 'CamilloBruni 8/14/2011 15:48'!
morphicDirectoryTreePaneFiltered: aSymbol
	^(SimpleHierarchicalListMorph 
		on: self
		list: aSymbol
		selected: #selectedDirectory
		changeSelected: #selectedDirectory:
		menu: #volumeMenu:
		keystroke: nil)
			autoDeselect: false;
			enableDrag: false;
			enableDrop: true;
			yourself
		
! !

!FileList methodsFor: 'private' stamp: 'MarcusDenker 9/13/2013 14:04'!
contents
	"Answer the contents of the file, reading it first if needed."
	"Possible brevityState values:
		FileList,
		fullFile, briefFile, needToGetFull, needToGetBrief,
		fullHex, briefHex, needToGetFullHex, needToGetBriefHex"
	
	self reference isReadable 
		ifFalse: [ ^ 'cannot read {1}' translated format: { reference }].
	(listIndex = 0) | (brevityState == #FileList) ifTrue: [^ self defaultContents].  "no file selected"
	brevityState == #fullFile ifTrue: [^ contents]. 
	brevityState == #fullHex ifTrue: [^ contents].
	brevityState == #briefFile ifTrue: [^ contents].
	brevityState == #briefHex ifTrue: [^ contents].

	brevityState == #needToGetFullHex ifTrue: [^ self readContentsHex: false].
	brevityState == #needToGetBriefHex ifTrue: [^ self readContentsHex: true].

	brevityState == #needToGetFull ifTrue: [^ self readContentsBrief: false].
	brevityState == #needToGetBrief ifTrue: [^ self readContentsBrief: true].  "default"

	(TextConverter allEncodingNames includes: brevityState) 
		ifTrue: [ ^self readContentsAsEncoding: brevityState].

	self error: 'unknown state ' , brevityState printString! !

!FileList methodsFor: 'initialization' stamp: 'sw 2/22/2002 02:34'!
universalButtonServices
	"Answer the services to be reflected in the receiver's buttons"

	^ self optionalButtonSpecs! !

!FileList class methodsFor: 'menu' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
contentMenu: aBuilder
	<contextMenu>
	<fileListContentMenu>
	
	(aBuilder item: #'Find...' translated)
		keyText: 'f';
		selector: #find;
		icon: Smalltalk ui icons smallFindIcon.
	(aBuilder item: #'Find again' translated)
		keyText: 'g';
		selector: #findAgain;
		icon: Smalltalk ui icons smallFindIcon.
	(aBuilder item: #'Set search string' translated)
		keyText: 'h';
		selector: #setSearchString;
		withSeparatorAfter.
		
	(aBuilder item: #'Do again' translated)
		keyText: 'j';
		selector: #again;
		icon: Smalltalk ui icons smallRedoIcon.
	(aBuilder item: #'Undo' translated)
		keyText: 'z';
		selector: #undo;
		icon: Smalltalk ui icons smallUndoIcon;
		withSeparatorAfter.
		
	(aBuilder item: #'Copy' translated)
		keyText: 'c';
		selector: #copySelection;
		icon: Smalltalk ui icons smallCopyIcon.
	(aBuilder item: #'Cut' translated)
		keyText: 'x';
		selector: #cut;
		icon: Smalltalk ui icons smallCutIcon.
	(aBuilder item: #'Paste' translated)
		keyText: 'v';
		selector: #paste;
		icon: Smalltalk ui icons smallPasteIcon.
	(aBuilder item: #'Paste...' translated)
		selector: #pasteRecent;
		icon: Smalltalk ui icons smallPasteIcon;
		withSeparatorAfter .
		
	(aBuilder item: #'Do it' translated)
		keyText: 'd';
		selector: #doIt;
		icon: Smalltalk ui icons smallDoItIcon.
	(aBuilder item: #'Print it' translated)
		keyText: 'p';
		selector: #printIt;
		icon: Smalltalk ui icons smallPrintItIcon.
	(aBuilder item: #'Inspect it' translated)
		keyText: 'i';
		selector: #inspectIt;
		icon: Smalltalk ui icons smallInspectItIcon.
	(aBuilder item: #'FileIn selection' translated)
		keyText: 'G';
		selector: #fileItIn;
		withSeparatorAfter.
		
	(aBuilder item: #'Accept' translated)
		keyText: 's';
		selector: #accept;
		icon: Smalltalk ui icons smallOkIcon.
	(aBuilder item: #'Cancel' translated)
		keyText: 'l';
		selector: #cancel;
		icon: Smalltalk ui icons smallCancelIcon;
		withSeparatorAfter.
		
	(aBuilder item: #'More...' translated)
		selector: #shiftedYellowButtonActivity.
! !

!FileList class methodsFor: 'initialization' stamp: 'hfm 11/29/2008 19:38'!
removeObsolete
	"FileList removeObsolete"
	self registeredFileReaderClasses copy 
		do:[:cls| cls isObsolete ifTrue:[self unregisterFileReader: cls]]! !

!FileList class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
taskbarIcon
	"Answer the icon for the receiver in a task bar."

	^ Smalltalk ui icons smallOpenIcon! !

!FileList class methodsFor: 'world menu' stamp: 'TorstenBergmann 2/12/2014 09:25'!
menuCommandOn: aBuilder 
	<worldMenu> 
	(aBuilder item: #'File Browser')
		parent: #Tools;
		order: 0.43;
		action:[self open]; 
		icon: self taskbarIcon.
	aBuilder withSeparatorAfter.		! !

!FileList class methodsFor: 'morphic ui' stamp: 'CamilloBruni 2/14/2012 14:34'!
morphicViewOnDirectory: aFileDirectory

	^ self 
		morphicViewOnFile: aFileDirectory 
		contents: nil
		fileList: (self new directory: aFileDirectory).! !

!FileList class methodsFor: 'utility' stamp: 'CamilloBruni 5/4/2012 20:09'!
suffixOf: aName
	"Answer the file extension of the given file"
	^ aName
		ifNil: ['']
		ifNotNil: [ aName asFileReference extension asLowercase]! !

!FileList class methodsFor: 'file reader registration' stamp: 'hfm 11/29/2008 19:04'!
registerFileReader: aProviderClass
	"register the given class as providing services for reading files"

	| registeredReaders |
	registeredReaders := self registeredFileReaderClasses.
	(registeredReaders includes: aProviderClass) 
			ifFalse: [ registeredReaders addLast: aProviderClass ]! !

!FileList class methodsFor: 'file reader registration' stamp: 'hfm 11/29/2008 18:37'!
registeredFileReaderClasses
	FileReaderRegistry := nil. "wipe it out"
	^FileServices registeredFileReaderClasses
	! !

!FileList class methodsFor: 'file reader registration' stamp: 'hfm 11/29/2008 19:39'!
unregisterFileReader: aProviderClass
	"unregister the given class as providing services for reading files"

	self registeredFileReaderClasses remove: aProviderClass ifAbsent: [nil]! !

!FileList class methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
theme
	^ Smalltalk ui theme ! !

!FileList class methodsFor: 'utility' stamp: 'hfm 11/29/2008 18:58'!
itemsForDirectory: aFileDirectory
	"Answer a list of services appropriate when no file is selected."

	| services |
	services := OrderedCollection new.
	self registeredFileReaderClasses do: [:reader |
		reader ifNotNil: [services addAll: (reader fileReaderServicesForDirectory: aFileDirectory) ]].
	^ services! !

!FileList class methodsFor: 'initialization' stamp: 'MarcusDenker 12/12/2009 07:36'!
initialize
	"FileList initialize"

	RecentDirs := OrderedCollection new.
	(self systemNavigation allClassesImplementing: #fileReaderServicesForFile:suffix:) do: 		[:providerMetaclass |
			self registerFileReader: providerMetaclass soleInstance]! !

!FileList class methodsFor: 'morphic ui' stamp: 'StephaneDucasse 12/19/2012 16:36'!
morphicViewOnFile: aFile contents: contents fileList: aFileList
	|  window fileListBottom midLine fileListTopOffset buttonPane fileContentsView |

	window := (SystemWindow labelled: aFile fullName) model: aFileList.

	fileListTopOffset := (TextStyle defaultFont pointSize * 2) + 11.
	fileListBottom := 0.4.
	midLine := 0.2.
	buttonPane := aFileList optionalButtonRow addMorph:
		(aFileList morphicPatternPane).
		
	self addFullPanesTo: window from: {
		{aFileList morphicDirectoryTreePane. (0@0 corner: midLine@1) asLayoutFrame }.
		{buttonPane. (midLine@0 corner: 1@0) asLayoutFrame bottomOffset: (fileListTopOffset-3)}.
		{aFileList morphicFileListPane. (midLine @ 0 corner: 1@fileListBottom) asLayoutFrame topOffset: fileListTopOffset}.
		{fileContentsView := aFileList morphicFileContentsPane. (midLine@fileListBottom corner: 1@1) asLayoutFrame}.
	}.
	
	contents ifNotNil: [
		fileContentsView editString: contents.
		fileContentsView hasUnacceptedEdits: true].
	
	aFileList postOpen.
	^ window ! !

!FileList class methodsFor: 'file reader registration' stamp: 'hfm 11/29/2008 19:36'!
isReaderNamedRegistered: aSymbol
	"return if a given reader class has been registered. Note that this is on purpose that the argument is
	a symbol and not a class"

	 ^ (self registeredFileReaderClasses collect: [:each | each name]) includes: aSymbol
! !

!FileList class methodsFor: 'utility' stamp: 'StephaneDucasse 12/19/2012 16:36'!
addFullPanesTo: window from: aCollection

	aCollection do: [ :each | 
		window addMorph: each first fullFrame: each second ]! !

!FileList class methodsFor: 'tools registry' stamp: 'IgorStasenko 2/19/2011 03:00'!
registerToolsOn: registry
	"Add ourselves to registry. See [Smalltalk tools]" 
	registry register: self as: #fileList
! !

!FileList class methodsFor: 'instance creation' stamp: 'MarcusDenker 7/26/2014 20:15'!
openOn: aFileReference
	"Open a view of an instance of me on the given file reference."
	"FileList openOn: FileSystem memory"
	(self morphicViewOnDirectory: aFileReference) openInWorld! !

!FileList class methodsFor: 'instance creation' stamp: 'MarcusDenker 7/26/2014 20:14'!
open
	"Open a view of an instance of me on the default directory."
	^ self openOn: FileSystem disk workingDirectory! !

!FileList class methodsFor: 'utility' stamp: 'AlainRastoul 4/19/2012 15:00'!
itemsForFile: file
	"Answer a list of services appropriate for a file of the given full name"

	| services suffix |
	suffix := self suffixOf: file fullName.
	services := OrderedCollection new.
	self registeredFileReaderClasses do: [:reader |
		reader ifNotNil: [
				services addAll: (reader fileReaderServicesForFile: file fullName suffix: suffix)]].
	^ services! !

!FileList class methodsFor: 'instance creation' stamp: 'MarcusDenker 7/26/2014 20:12'!
openEditorOn: aFileStream editString: editString 
	"Open an editor on the given FileStream."
	| editor |
	editor :=  self 
		morphicViewOnFile: aFileStream fullName asFileReference 
		contents: editString
		fileList: (self new setFileStream: aFileStream).
	
	^ editor openInWorld! !

!FileList class methodsFor: 'file reader registration' stamp: 'MarcusDenker 10/16/2013 21:56'!
allRegisteredServices
	"self allRegisteredServices"

	^self registeredFileReaderClasses flatCollect: [:each | each services]
	! !

!FileList class methodsFor: 'accessing' stamp: 'CamilloBruni 8/12/2011 21:53'!
searchList
	^ searchList ifNil: [ searchList := OrderedCollection new ].! !

!FileListGrid commentStamp: 'TorstenBergmann 2/4/2014 20:43'!
A grid for a list of files!
!FileListGrid methodsFor: 'menus' stamp: 'AlexisParseghian 3/15/2012 23:25'!
fileListMenu: aMenuMorph 
	^ parent fileListMenu: aMenuMorph! !

!FileListGrid methodsFor: 'accessing' stamp: ''!
parent: aFileList
	parent := aFileList! !

!FileListGrid methodsFor: 'accessing' stamp: ''!
rootNodeClassFromItem: anItem
	^ FileListGridNode! !

!FileListGrid methodsFor: 'user interface' stamp: 'CamilloBruni 7/10/2012 22:03'!
treeMorph
	treeMorph ifNil: [ 
		treeMorph := (self treeMorphClass on: self)
			columns: {
				MorphTreeColumn new
					rowMorphGetSelector: #fileName;
					startWidth: 300;
					headerButtonLabel: 'File name' translated 
						font: nil 
						target: self parent 
						actionSelector: #setSortSelector: arguments: { #sortBlockBasename }.
				MorphTreeColumn new
					rowMorphGetSelector: #fileSize;
					headerButtonLabel: 'Size' translated font: nil 
						target: self parent 
						actionSelector: #setSortSelector: arguments: { #sortBlockFilesize }.
				MorphTreeColumn new
					rowMorphGetSelector: #modificationDate;
					headerButtonLabel: 'Last mod.' translated font: nil  
						target: self parent 
						actionSelector: #setSortSelector: arguments: { #sortBlockTimestamp }.
				MorphTreeColumn new
					rowMorphGetSelector: #filePermissions;
					headerButtonLabel: 'Permissions' translated font: nil  
						target: self parent 
						actionSelector: #setSortSelector: arguments: { #sortBlockPermissions }}.
		treeMorph 
			hResizing: #spaceFill; 
			vResizing: #spaceFill; 
			columnInset: 3; 
			getMenuSelector: #fileListMenu:;
			makeLastColumnUnbounded.
		].

	^ treeMorph buildContents ! !

!FileListGrid methodsFor: 'accessing' stamp: ''!
rootItems
	^ parent fileList! !

!FileListGrid methodsFor: 'accessing' stamp: ''!
parent
	^ parent! !

!FileListGridNode commentStamp: 'TorstenBergmann 2/4/2014 20:42'!
A node in the file list grid!
!FileListGridNode methodsFor: 'user interface' stamp: 'CamilloBruni 7/10/2012 22:03'!
modificationDate
	^ self theme newTextIn: self text: item modificationTime asString! !

!FileListGridNode methodsFor: 'user interface' stamp: 'AlexisParseghian 3/14/2012 14:36'!
fileName
	^ self theme newTextIn: self text: item basename! !

!FileListGridNode methodsFor: 'user interface' stamp: 'CamilloBruni 7/10/2012 22:02'!
filePermissions
	^ self theme newTextIn: self text: item permissions asString! !

!FileListGridNode methodsFor: 'user interface' stamp: 'CamilloBruni 7/10/2012 22:04'!
fileSize
	^ self theme newTextIn: self text: item humanReadableSize asString! !

!FileLocator commentStamp: '<historical>'!
I am a late-bound reference. I refer to a file or directory in relation to a well-known location on the filesystem, called an origin. When asked to perform concrete operation, I look up the current location of my origin, and resolve my path against it. 

Usage
----------
FileLocator vmDirectory parent pathString
	> '/Applications'


FileLocator desktop.
FileLocator desktop basename.

FileLocator home basename.
FileLocator image.
FileLocator vmBinary asAbsolute pathString 
	>  '/Applications/CogVM.app/Contents/MacOS/CogVM'
FileLocator vmBinary pathString 
	> '/Applications/CogVM.app/Contents/MacOS/CogVM'
		




Implementation
------------------------
origin 
	A symbolic name for base reference I use to resolve myself.

path
	A relative path that is resolved against my origin"
	
	!
!FileLocator methodsFor: 'comparing' stamp: 'cwp 10/25/2009 11:05'!
hash
	^ origin hash bitXor: path hash! !

!FileLocator methodsFor: 'streams-compatibility' stamp: 'MaxLeske 1/26/2014 20:50'!
binaryReadStream
	^ self resolve binaryReadStream! !

!FileLocator methodsFor: 'accessing' stamp: 'cwp 10/25/2009 21:31'!
origin
	^ origin! !

!FileLocator methodsFor: 'streams' stamp: 'CamilloBruni 7/10/2012 15:26'!
readStream
	^ self resolve readStream ! !

!FileLocator methodsFor: 'copying' stamp: 'CamilloBruni 7/10/2012 15:17'!
copyWithPath: newPath
	^ self class origin: origin path: newPath! !

!FileLocator methodsFor: 'converting' stamp: 'cwp 10/25/2009 10:30'!
asAbsolute
	^ self ! !

!FileLocator methodsFor: 'accessing' stamp: 'cwp 10/25/2009 21:31'!
path
	^ path! !

!FileLocator methodsFor: 'testing' stamp: 'cwp 10/25/2009 11:15'!
isRelative
	^ false! !

!FileLocator methodsFor: 'navigating' stamp: 'CamilloBruni 7/10/2012 15:19'!
resolveString: aString
	| filesystem thePath |
	filesystem := (Resolver resolve: origin) fileSystem.
	thePath := filesystem pathFromString: aString.
	^ self withPath: (path resolvePath: thePath)! !

!FileLocator methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 15:23'!
fullPath
	^ self resolve path! !

!FileLocator methodsFor: 'error handling' stamp: 'CamilloBruni 5/24/2012 12:35'!
doesNotUnderstand: aMessage
	"Redirect message to the resolved version of this FileLocator.
	If FileReference won't understand the message send a normal DNU."

	| resolved |
	
	resolved := self resolve.
	(resolved respondsTo: aMessage selector)
		ifTrue: [ ^ resolved perform: aMessage selector withArguments: aMessage arguments ].
	
	^ super doesNotUnderstand: aMessage.! !

!FileLocator methodsFor: 'streams' stamp: 'CamilloBruni 7/10/2012 15:26'!
writeStream
	^ self resolve writeStream ! !

!FileLocator methodsFor: 'printing' stamp: 'EstebanLorenzano 4/3/2012 12:55'!
printOn: aStream
	| fs |
	aStream
		nextPut: ${;
		nextPutAll: origin;
		nextPut: $}.
	path isWorkingDirectory
		ifTrue: [ ^ self ].
	fs := self fileSystem.
	aStream nextPut: fs delimiter.
	fs printPath: path on: aStream! !

!FileLocator methodsFor: 'testing' stamp: 'cwp 10/25/2009 10:30'!
isAbsolute
	^ true! !

!FileLocator methodsFor: 'converting' stamp: 'EstebanLorenzano 4/12/2012 14:28'!
asFileReference
	^ self resolve! !

!FileLocator methodsFor: 'comparing' stamp: 'cwp 10/26/2009 10:28'!
= other
	^ self species = other species
		and: [origin = other origin
			and: [path = other path]]! !

!FileLocator methodsFor: 'operations' stamp: 'CamilloBruni 7/10/2012 17:45'!
renameTo: newBasename
	
	| result |
	result := self resolve renameTo: newBasename.
	path size > 0
		ifTrue: [ path basename: newBasename ]
		ifFalse: [ path := result path ]! !

!FileLocator methodsFor: 'navigating' stamp: 'cwp 10/25/2009 09:59'!
resolve
	^ (Resolver resolve: origin) resolve: path! !

!FileLocator methodsFor: 'accessing' stamp: 'StephaneDucasse 9/14/2012 11:12'!
absolutePath
	"Return the absolute path"
	^ self resolve path! !

!FileLocator methodsFor: 'initialize-release' stamp: 'cwp 10/25/2009 09:56'!
initializeWithOrigin: aSymbol path: aPath
	self initialize.
	origin := aSymbol.
	path := aPath.! !

!FileLocator class methodsFor: 'origins' stamp: 'CamilloBruni 7/10/2012 21:36'!
root
	^ FileSystem disk root! !

!FileLocator class methodsFor: 'mac-origins' stamp: 'CamilloBruni 11/8/2013 19:06'!
systemLibrary
	^ self origin: #systemLibrary! !

!FileLocator class methodsFor: 'windows-origins' stamp: 'CamilloBruni 7/10/2012 21:38'!
P
	^ self driveNamed: #P
! !

!FileLocator class methodsFor: 'windows-origins' stamp: 'CamilloBruni 7/10/2012 21:38'!
N
	^ self driveNamed: #N
! !

!FileLocator class methodsFor: 'class initialization' stamp: 'cwp 11/20/2009 15:01'!
initialize
	Smalltalk addToStartUpList: self.
	self startUp: true! !

!FileLocator class methodsFor: 'origins' stamp: 'cwp 10/26/2009 13:49'!
vmDirectory
	^ self origin: #vmDirectory! !

!FileLocator class methodsFor: 'mac-origins' stamp: 'CamilloBruni 11/7/2013 21:01'!
systemApplicationSupport
	^ self origin: #systemApplicationSupport! !

!FileLocator class methodsFor: 'origins' stamp: 'cwp 10/27/2009 09:34'!
home
	^ self origin: #home! !

!FileLocator class methodsFor: 'mac-origins' stamp: 'CamilloBruni 11/7/2013 21:02'!
userApplicationSupport
	^ self origin: #userApplicationSupport! !

!FileLocator class methodsFor: 'windows-origins' stamp: 'CamilloBruni 7/10/2012 21:38'!
H
	^ self driveNamed: #H
! !

!FileLocator class methodsFor: 'class initialization' stamp: 'EstebanLorenzano 4/2/2012 11:39'!
startUp: resuming
	resuming
		ifFalse: [ ^ self ].
	Resolver := InteractiveResolver new.
	Resolver addResolver: SystemResolver new.
	Resolver addResolver: PlatformResolver forCurrentPlatform! !

!FileLocator class methodsFor: 'windows-origins' stamp: 'CamilloBruni 7/10/2012 21:38'!
F
	^ self driveNamed: #F
! !

!FileLocator class methodsFor: 'windows-origins' stamp: 'CamilloBruni 7/10/2012 21:38'!
Y
	^ self driveNamed: #Y
! !

!FileLocator class methodsFor: 'origins' stamp: 'DamienCassou 12/20/2013 11:59'!
temp
	^ self origin: #temp! !

!FileLocator class methodsFor: 'windows-origins' stamp: 'CamilloBruni 7/10/2012 21:38'!
D
	^ self driveNamed: #D
! !

!FileLocator class methodsFor: 'windows-origins' stamp: 'CamilloBruni 7/10/2012 21:38'!
U
	^ self driveNamed: #U
! !

!FileLocator class methodsFor: 'windows-origins' stamp: 'CamilloBruni 7/10/2012 21:38'!
Q
	^ self driveNamed: #Q
! !

!FileLocator class methodsFor: 'origins' stamp: 'CamilloBruni 5/24/2012 12:07'!
preferences
	^ self origin: #preferences! !

!FileLocator class methodsFor: 'origins' stamp: 'CamilloBruni 7/10/2012 21:36'!
workingDirectory
	^ FileSystem disk referenceTo: RelativePath new! !

!FileLocator class methodsFor: 'origins' stamp: 'lr 7/13/2010 13:35'!
imageDirectory
	^ self origin: #imageDirectory ! !

!FileLocator class methodsFor: 'windows-origins' stamp: 'CamilloBruni 7/10/2012 21:38'!
Z
	^ self driveNamed: #Z
! !

!FileLocator class methodsFor: 'windows-origins' stamp: 'CamilloBruni 7/10/2012 21:38'!
C
	^ self driveNamed: #C
! !

!FileLocator class methodsFor: 'windows-origins' stamp: 'CamilloBruni 7/10/2012 21:38'!
M
	^ self driveNamed: #M
! !

!FileLocator class methodsFor: 'windows-origins' stamp: 'CamilloBruni 7/10/2012 21:38'!
I
	^ self driveNamed: #I
! !

!FileLocator class methodsFor: 'origins' stamp: 'cwp 10/26/2009 11:37'!
vmBinary
	^ self origin: #vmBinary! !

!FileLocator class methodsFor: 'origins' stamp: 'lr 7/13/2010 13:29'!
changes
	^ self origin: #changes ! !

!FileLocator class methodsFor: 'windows-origins' stamp: 'CamilloBruni 7/10/2012 21:38'!
T
	^ self driveNamed: #T
! !

!FileLocator class methodsFor: 'windows-origins' stamp: 'CamilloBruni 7/10/2012 21:38'!
W
	^ self driveNamed: #W! !

!FileLocator class methodsFor: 'windows-origins' stamp: 'CamilloBruni 7/10/2012 21:38'!
R
	^ self driveNamed: #R
! !

!FileLocator class methodsFor: 'origins' stamp: 'CamilloBruni 11/8/2013 18:39'!
cache
	^ self origin: #cache! !

!FileLocator class methodsFor: 'mac-origins' stamp: 'CamilloBruni 11/8/2013 18:38'!
userLibrary
	^ self origin: #userLibrary! !

!FileLocator class methodsFor: 'origins' stamp: 'CamilloBruni 5/24/2012 12:07'!
documents
	^ self origin: #documents! !

!FileLocator class methodsFor: 'windows-origins' stamp: 'CamilloBruni 7/10/2012 21:38'!
S
	^ self driveNamed: #S
! !

!FileLocator class methodsFor: 'windows-origins' stamp: 'CamilloBruni 7/10/2012 21:39'!
driveNamed: driveName
	^ FileReference fileSystem: (FileSystem disk) path: Path / (driveName, ':')! !

!FileLocator class methodsFor: 'instance creation' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
origin: aSymbol 
	^ self origin: aSymbol path: Path workingDirectory! !

!FileLocator class methodsFor: 'windows-origins' stamp: 'CamilloBruni 7/10/2012 21:38'!
L
	^ self driveNamed: #L
! !

!FileLocator class methodsFor: 'windows-origins' stamp: 'CamilloBruni 7/10/2012 21:38'!
O
	^ self driveNamed: #O
! !

!FileLocator class methodsFor: 'windows-origins' stamp: 'CamilloBruni 7/10/2012 21:38'!
J
	^ self driveNamed: #J
! !

!FileLocator class methodsFor: 'unix-origins' stamp: 'CamilloBruni 11/7/2013 21:02'!
userData
	^ self origin: #userData! !

!FileLocator class methodsFor: 'windows-origins' stamp: 'CamilloBruni 7/10/2012 21:38'!
E
	^ self driveNamed: #E
! !

!FileLocator class methodsFor: 'windows-origins' stamp: 'CamilloBruni 7/10/2012 21:38'!
K
	^ self driveNamed: #K
! !

!FileLocator class methodsFor: 'origins' stamp: 'cwp 10/25/2009 09:54'!
image
	^ self origin: #image ! !

!FileLocator class methodsFor: 'windows-origins' stamp: 'CamilloBruni 7/10/2012 21:38'!
G
	^ self driveNamed: #G
! !

!FileLocator class methodsFor: 'origins' stamp: 'CamilloBruni 7/10/2012 21:39'!
cwd
	^ self workingDirectory! !

!FileLocator class methodsFor: 'origins' stamp: 'cwp 10/27/2009 10:24'!
desktop
	^ self origin: #desktop! !

!FileLocator class methodsFor: 'accessing' stamp: 'cwp 10/27/2009 11:25'!
supportedOrigins
	| origins current |
	origins := IdentitySet new.
	current := Resolver.
	[current notNil] whileTrue:
		[origins addAll: current supportedOrigins.
		current := current next].
	^ origins! !

!FileLocator class methodsFor: 'windows-origins' stamp: 'CamilloBruni 7/10/2012 21:38'!
A
	^ self driveNamed: #A 
! !

!FileLocator class methodsFor: 'class initialization' stamp: 'cwp 10/27/2009 10:28'!
flushCaches
	Resolver flushCaches! !

!FileLocator class methodsFor: 'class initialization' stamp: 'cwp 10/26/2009 20:54'!
addResolver: aResolver
	Resolver addResolver: aResolver! !

!FileLocator class methodsFor: 'windows-origins' stamp: 'CamilloBruni 7/10/2012 21:38'!
B
	^ self driveNamed: #B
! !

!FileLocator class methodsFor: 'windows-origins' stamp: 'CamilloBruni 7/10/2012 21:38'!
X
	^ self driveNamed: #X
! !

!FileLocator class methodsFor: 'instance creation' stamp: 'CamilloBruni 5/24/2012 14:49'!
origin: aSymbol path: aPath
	^ self basicNew 
			initializeWithOrigin: aSymbol path: aPath! !

!FileLocator class methodsFor: 'windows-origins' stamp: 'CamilloBruni 7/10/2012 21:38'!
V
	^ self driveNamed: #V
! !

!FileLocatorTest commentStamp: 'TorstenBergmann 1/31/2014 11:38'!
SUnit test for FileLocator!
!FileLocatorTest methodsFor: 'resolution tests' stamp: 'CamilloBruni 2/22/2014 15:03'!
testResolvePath
	| result path |
	locator := FileLocator image / 'plonk'.
	result := locator resolve: (Path * 'griffle').
	path := (Path * 'plonk') / 'griffle'.
	self assert: result class = locator class.
	self assert: result origin = locator origin.
	self assert: result path = path.! !

!FileLocatorTest methodsFor: 'compatibility tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testIsRelative
	locator := FileLocator image.
	self deny: locator isRelative! !

!FileLocatorTest methodsFor: 'resolution tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testResolveAbsoluteReference
	| result reference |
	locator := FileLocator image / 'plonk'.
	reference := FileSystem memory / 'griffle'.
	result := locator resolve: reference..
	self assert: result == reference! !

!FileLocatorTest methodsFor: 'compatibility tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testEqual
	| a b |
	a := FileLocator image.
	b := FileLocator image.
	self deny: a == b.
	self assert: a = b.! !

!FileLocatorTest methodsFor: 'compatibility tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testAsAbsolute
	locator := FileLocator image.
	self assert: locator asAbsolute = locator! !

!FileLocatorTest methodsFor: 'resolution tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testResolveCompoundString
	| result compound |
	locator := FileLocator image / 'plonk'.
	compound := 'griffle', locator fileSystem delimiter asString, 'nurp'.
	result := locator resolve: compound.
	self assert: result class = locator class.
	self assert: result origin = locator origin.
	self assert: result path = ((Path * 'plonk') / 'griffle' / 'nurp')! !

!FileLocatorTest methodsFor: 'compatibility tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testContainsLocator
	locator := FileLocator image.
	self assert: (locator contains: locator / 'griffle').! !

!FileLocatorTest methodsFor: 'resolution tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testImageDirectory
	locator := FileLocator image.
	self assert: locator resolve = FileLocator image resolve! !

!FileLocatorTest methodsFor: 'compatibility tests' stamp: 'CamilloBruni 2/25/2014 14:38'!
testMoveTo
	| old new |
	[
		old := FileLocator imageDirectory / 'testMoveTo_old'.
		old ensureCreateFile.
		
		new := FileLocator home / 'testMoveTo_new'.
		old moveTo: new.
		
		self deny: old exists.
		self assert: new exists.
	] ensure: [ 
		old ensureDelete.
		new ensureDelete.
	]! !

!FileLocatorTest methodsFor: 'compatibility tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testCommaAddsExtension
	locator := FileLocator image / 'griffle'.
	self assert: (locator , 'plonk') basename = 'griffle.plonk'! !

!FileLocatorTest methodsFor: 'compatibility tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testIsRoot
	locator := FileLocator image.
	(locator resolve path size) timesRepeat: [locator := locator / '..'].
	self assert: locator isRoot! !

!FileLocatorTest methodsFor: 'resolution tests' stamp: 'CamilloBruni 2/22/2014 15:03'!
testResolveString
	| result path |
	locator := FileLocator image / 'plonk'.
	result := locator resolve: 'griffle'.
	path := (Path * 'plonk') / 'griffle'.
	self assert: result class = locator class.
	self assert: result origin = locator origin.
	self assert: result path = path.! !

!FileLocatorTest methodsFor: 'compatibility tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testIsAbsolute
	locator := FileLocator image.
	self assert: locator isAbsolute! !

!FileLocatorTest methodsFor: 'compatibility tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testSlash
	locator := FileLocator image / 'griffle'.
	self assert: locator = (FileLocator image / 'griffle')! !

!FileLocatorTest methodsFor: 'resolution tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testResolveRelativeReference
	| result reference |
	locator := FileLocator image / 'plonk'.
	self flag: 'this is a bit weird...'.
	reference := FileSystem memory * 'griffle'.
	result := locator resolve: reference..
	self assert: result class= locator class.
	self assert: result origin = locator origin.
	self assert: result path = reference path.! !

!FileLocatorTest methodsFor: 'compatibility tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testCommaAddsExtensionAgain
	locator := FileLocator image / 'griffle.plonk'.
	self assert: (locator , 'nurp') basename = 'griffle.plonk.nurp'! !

!FileLocatorTest methodsFor: 'compatibility tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testWithExtensionAddsExtension
	locator := FileLocator image / 'griffle'.
	self assert: (locator withExtension: 'plonk') basename = 'griffle.plonk'! !

!FileLocatorTest methodsFor: 'compatibility tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testOriginBasename
	locator := FileLocator image.
	self assert: locator basename = FileLocator image resolve basename! !

!FileLocatorTest methodsFor: 'compatibility tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testFileSystem
	locator := FileLocator image.
	self assert: (locator fileSystem isKindOf: FileSystem)! !

!FileLocatorTest methodsFor: 'compatibility tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testBasename
	locator := FileLocator image / 'griffle'.
	self assert: locator basename = 'griffle'! !

!FileLocatorTest methodsFor: 'compatibility tests' stamp: 'CamilloBruni 2/22/2014 15:16'!
testExtension
	locator := FileLocator image, 'bak'.
	self assert: (locator basename endsWith: '.bak')	! !

!FileLocatorTest methodsFor: 'tests' stamp: 'CamilloBruni 7/10/2012 22:54'!
testCPath
	| ref |
	ref := FileLocator C / 'WINDOWS'.
	self assert: (ref fileSystem isKindOf: FileSystem).
	self assert: ref path = (Path / 'C:' / 'WINDOWS')! !

!FileLocatorTest methodsFor: 'compatibility tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testContainsPath
	"self debug: #testContainsPath"
	
	locator := FileLocator image.
	self assert: (locator contains: (locator resolve / 'griffle') path).! !

!FileLocatorTest methodsFor: 'compatibility tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testContainsReference
	locator := FileLocator image.
	self assert: (locator contains: (locator resolve / 'griffle')).! !

!FileLocatorTest methodsFor: 'compatibility tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testIsNotRoot
	locator := FileLocator image.
	self deny: locator isRoot! !

!FileLocatorTest methodsFor: 'compatibility tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testWithExtensionReplacesExtension
	locator := FileLocator image / 'griffle.nurp'.
	self assert: (locator withExtension: 'plonk') basename = 'griffle.plonk'! !

!FileLocatorTest methodsFor: 'compatibility tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testParent
	locator := FileLocator image.
	self assert: locator parent resolve = FileLocator imageDirectory resolve! !

!FileModifyingSimpleServiceEntry commentStamp: 'nk 11/26/2002 12:03'!
I represent a service that may change the contents of a directory.
Such changes include:
* file creation
* file deletion
* file modification!
!FileModifyingSimpleServiceEntry methodsFor: 'performing service' stamp: 'nk 11/26/2002 12:08'!
performServiceFor: anObject
	| retval |
	retval := super performServiceFor: anObject.
	self changed: #fileListChanged.
	^retval	"is this used anywhere?"! !

!FilePackage commentStamp: 'TorstenBergmann 1/31/2014 10:27'!
Represents a file package used to browse code files. This is for instance used in the FileContentsBrowser!
!FilePackage methodsFor: 'private' stamp: 'MarcusDenker 5/18/2013 15:44'!
removedMethod: string with: chgRec
	| class tokens |
	tokens := string parseLiterals.
	(tokens size = 3 and:[(tokens at: 2) == #removeSelector: ]) ifTrue:[
		class := self getClass: (tokens at: 1).
		^class removeSelector: (tokens at: 3).
	].
	(tokens size = 4 and:[(tokens at: 2) == #class and:[(tokens at: 3) == #removeSelector:]]) ifTrue:[
		class := self getClass: (tokens at: 1).
		^class metaClass removeSelector: (tokens at: 4).
	].
	doIts add: chgRec! !

!FilePackage methodsFor: 'change record types' stamp: ''!
method: chgRec
	(self getClass: chgRec methodClassName) methodChange: chgRec! !

!FilePackage methodsFor: 'accessing' stamp: 'pnm
8/23/2000 17:10'!
fullName: aString
	fullName := aString! !

!FilePackage methodsFor: 'private' stamp: 'MarcusDenker 5/18/2013 15:44'!
possibleSystemSource: chgRec
	| tokens |
	sourceSystem isEmpty ifTrue:[
		tokens := chgRec string parseLiterals.
		(tokens size = 1 and:[tokens first isString]) ifTrue:[
			sourceSystem := tokens first.
			^self]].
	doIts add: chgRec.! !

!FilePackage methodsFor: 'change record types' stamp: ''!
classComment: chgRec

	(self getClass: chgRec methodClassName) classComment: chgRec! !

!FilePackage methodsFor: 'accessing' stamp: ''!
classAt: className
	^self classes at: className! !

!FilePackage methodsFor: 'accessing' stamp: 'md 1/15/2014 14:06'!
packageInfo
	^String streamContents:[:s|
		s nextPutAll:'Package: '.
		s nextPutAll: self fullPackageName asString; cr; cr.
		sourceSystem isEmpty ifFalse:[
			s nextPutAll: sourceSystem; cr; cr].
		doIts isEmpty ifFalse:[
			s nextPutAll:'Unresolvable doIts:'; cr; cr.
			doIts do:[:chgRec|
				s nextPut:$!!; nextPutAll: chgRec string; nextPut: $!!; cr]]].! !

!FilePackage methodsFor: 'change record types' stamp: 'avi 1/19/2004 23:47'!
doIts
	^ doIts! !

!FilePackage methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 09:54'!
initialize
	super initialize.
	classes := Dictionary new.
	classOrder := OrderedCollection new.
	sourceSystem := ''.
	doIts := OrderedCollection new.! !

!FilePackage methodsFor: 'filein/fileout' stamp: 'alain.plantec 2/6/2009 17:02'!
fileOutOn: aStream
	| doitsMark |
	doitsMark := 1.
	doIts isEmpty ifFalse:[doitsMark := self askForDoits].
	doitsMark = 0 ifTrue: [^nil].
	doitsMark = 2 ifTrue:[self fileOutDoits: aStream].
	classOrder do:[:cls|
		cls fileOutDefinitionOn: aStream.
	].
	classes do:[:cls|
		cls fileOutMethodsOn: aStream.
		cls hasMetaclass ifTrue:[cls metaClass fileOutMethodsOn: aStream].
	].
	doitsMark = 3 ifTrue:[self fileOutDoits: aStream].! !

!FilePackage methodsFor: 'private' stamp: 'MarcusDenker 5/18/2013 15:44'!
metaClassDefinition: string with: chgRec
	| tokens theClass |
	tokens := string parseLiterals.
	theClass := self getClass: (tokens at: 1).
	theClass metaClass definition: string.
	classOrder add: theClass metaClass.! !

!FilePackage methodsFor: 'accessing' stamp: 'CamilloBruni 5/7/2012 02:09'!
packageName
	^ self fullPackageName  asFileReference basename! !

!FilePackage methodsFor: 'change record types' stamp: ''!
preamble: chgRec
	self doIt: chgRec! !

!FilePackage methodsFor: 'accessing' stamp: ''!
fullPackageName
	^fullName! !

!FilePackage methodsFor: 'filein/fileout' stamp: ''!
fileInDoits
	doIts do:[:chgRec| chgRec fileIn].! !

!FilePackage methodsFor: 'accessing' stamp: ''!
removeClass: aPseudoClass
	(self classes removeKey: aPseudoClass name).
	classOrder copy do:[:cls|
		cls name = aPseudoClass name ifTrue:[ classOrder remove: cls].
	].! !

!FilePackage methodsFor: 'change record types' stamp: ''!
doIt: chgRec
	| string |
	string := chgRec string.
	('*ubclass:*instanceVariableNames:*classVariableNames:*poolDictionaries:*category:*'
		match: string) ifTrue:[^self classDefinition: string with: chgRec].
	('* class*instanceVariableNames:*'
		match: string) ifTrue:[^self metaClassDefinition: string with: chgRec].
	('* removeSelector: *'
		match: string) ifTrue:[^self removedMethod: string with: chgRec].
	('* comment:*'
		match: string) ifTrue:[^self msgClassComment: string with: chgRec].
	('* initialize'
		match: string) ifTrue:[^self]. "Initialization is done based on class>>initialize"
	('''From *'
		match: string) ifTrue:[^self possibleSystemSource: chgRec].
	doIts add: chgRec.! !

!FilePackage methodsFor: 'reading' stamp: 'SeanDeNigris 6/21/2012 09:04'!
fileInFrom: aStream
	| changes |
	changes := ChangeSet scanFile: aStream from: 0 to: aStream size.
	aStream close.
	('Processing ', self packageName) 
		displayProgressFrom: 1
		to: changes size
		during:[:bar| | chgRec |
			1 to: changes size do:[:i|
				bar current: i.
				chgRec := changes at: i.
				self perform: (chgRec type copyWith: $:) asSymbol
with: chgRec.
			].
		].! !

!FilePackage methodsFor: 'filein/fileout' stamp: 'alain.plantec 2/6/2009 17:01'!
askForDoits
	| choice choices |
	choices := {'do not process' translated. 'at the beginning' translated. 'at the end' translated}.
	choice := nil.
	[choices includes: choice] whileFalse: [
		choice := UIManager default 
				chooseFrom: choices 
				values: choices 
				title: 'Unprocessed doIts found. When to process those?' translated.
		choice ifNil: [^0]].
	^choices indexOf: choice! !

!FilePackage methodsFor: 'accessing' stamp: ''!
classes
	^classes! !

!FilePackage methodsFor: 'accessing' stamp: ''!
renameClass: aPseudoClass to: newName
	| oldName |
	oldName := aPseudoClass name.
	self classes removeKey: oldName.
	self classes at: newName put: aPseudoClass.
	aPseudoClass renameTo: newName.! !

!FilePackage methodsFor: 'filein/fileout' stamp: ''!
fileOutDoits: aStream
	doIts do:[:chgRec| chgRec fileOutOn: aStream].! !

!FilePackage methodsFor: 'change record types' stamp: 'MarcusDenker 5/18/2013 15:44'!
classDefinition: string with: chgRec
	| tokens theClass |
	
	self flag: #traits.
		
	tokens := string parseLiterals.

	"tokens size = 11 ifFalse:[^doIts add: chgRec]."

	theClass := self getClass: (tokens at: 3).
	theClass definition: string.
	classOrder add: theClass.! !

!FilePackage methodsFor: 'private' stamp: 'MarcusDenker 5/18/2013 15:44'!
msgClassComment: string with: chgRec
	| tokens theClass |
	tokens := string parseLiterals.
	(tokens size = 3 and:[(tokens at: 3) isString]) ifTrue:[
		theClass := self getClass: tokens first.
		^theClass commentString: tokens last].
	(tokens size = 4 and:[(tokens at: 3) asString = 'class' and:[(tokens at: 4) isString]]) ifTrue:[
		theClass := self getClass: tokens first.
		theClass metaClass commentString: tokens last].
! !

!FilePackage methodsFor: 'filein/fileout' stamp: 'alain.plantec 2/6/2009 17:02'!
fileIn
	| doitsMark |
	doitsMark := 1.
	doIts isEmpty ifFalse:[doitsMark := self askForDoits].
	doitsMark = 0 ifTrue: [^nil].
	doitsMark = 2 ifTrue:[self fileInDoits].
	classOrder do:[:cls|
		cls fileInDefinition.
	].
	classes do:[:cls|
		Transcript cr; show:'Filing in ', cls name.
		cls fileInMethods.
		cls hasMetaclass ifTrue:[cls metaClass fileInMethods].
	].
	doitsMark = 3 ifTrue:[self fileInDoits].! !

!FilePackage methodsFor: 'private' stamp: ''!
getClass: className
	| pseudoClass |
	(classes includesKey: className) ifTrue:[
		^classes at: className.
	].
	pseudoClass := PseudoClass new.
	pseudoClass name: className.
	classes at: className put: pseudoClass.
	^pseudoClass.! !

!FilePackage methodsFor: 'filein/fileout' stamp: 'ar 7/17/2005 03:36'!
fileOut
	| fileName stream |
	fileName := UIManager default request: 'Enter the file name' initialAnswer:''.
	stream := FileStream newFileNamed: fileName.
	sourceSystem isEmpty ifFalse:[
		stream nextChunkPut: sourceSystem printString;cr ].
	self fileOutOn: stream.
	stream cr; cr.
	self classes do:[:cls|
		cls needsInitialize ifTrue:[
			stream cr; nextChunkPut: cls name,' initialize']].
	stream cr.
	stream close.

	"DeepCopier new checkVariables."
! !

!FilePackage methodsFor: 'initialize' stamp: 'StephaneDucasse 2/2/2010 21:52'!
fromFileNamed: aName
	
	fullName := aName.
	FileStream 
		readOnlyFileNamed: aName 
		do: [ :aStream |
			aStream setConverterForCode.
			self fileInFrom: aStream] ! !

!FilePackage class methodsFor: 'instance creation' stamp: ''!
fromFileNamed: aName
	^self new fromFileNamed: aName! !

!FilePathEncoder commentStamp: 'yo 10/19/2004 21:36'!
This class absorb the difference of internal and external representation of the file path.  The idea is to keep the internal one as much as possible, and only when it goes to a primitive, the encoded file path, i.e. the native platform representation is passsed to the primitive.

	The converter used is obtained by "LanguageEnvironment defaultFileNameConverter".
!
!FilePathEncoder class methodsFor: 'encoding' stamp: 'MartinDias 10/2/2013 16:09'!
decode: aString
	^ aString convertFromWithConverter: LanguageEnvironment defaultFileNameConverter.! !

!FilePathEncoder class methodsFor: 'encoding' stamp: 'MartinDias 10/2/2013 16:07'!
encode: pathString
	^ pathString convertToWithConverter: LanguageEnvironment defaultFileNameConverter.! !

!FilePathEncoder class methodsFor: '*System-Settings' stamp: 'NicolaiHess 6/4/2014 00:26'!
settingInputWidgetForNode: aSettingNode
	^ aSettingNode  inputWidgetForFileOrDirectoryWithAction: #chooseFilePath.! !

!FilePluginPrims commentStamp: 'cwp 11/18/2009 13:02'!
I provide an interface to the primitives in the FilePlugin.
!
!FilePluginPrims methodsFor: 'encoding primitives' stamp: 'lr 7/13/2010 14:10'!
decode: aString
	^ aString convertFromWithConverter: LanguageEnvironment defaultFileNameConverter! !

!FilePluginPrims methodsFor: 'path primitives' stamp: 'cwp 7/20/2009 17:23'!
getMacFile: fileName type: typeString creator: creatorString
	"Get the Macintosh file type and creator info for the file with the given name. Fails if the file does not exist or if the type and creator type arguments are not strings of length 4. This primitive is Mac specific; it is a noop on other platforms."

 	<primitive: 'primitiveDirectoryGetMacTypeAndCreator' module: 'FilePlugin'>

! !

!FilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/20/2009 17:27'!
close: id
	"Close this file."

	<primitive: 'primitiveFileClose' module: 'FilePlugin'>
	! !

!FilePluginPrims methodsFor: 'path primitives' stamp: 'cwp 7/20/2009 17:22'!
deleteFile: aFileName
	"Delete the file of the given name. 
	Return self if the primitive succeeds, nil otherwise."

	<primitive: 'primitiveFileDelete' module: 'FilePlugin'>
	^ nil
! !

!FilePluginPrims methodsFor: 'path primitives' stamp: 'cwp 7/20/2009 17:25'!
setMacFileNamed: fileName type: typeString creator: creatorString
	"Set the Macintosh file type and creator info for the file with the given name. Fails if the 
	file does not exist or if the type and creator type arguments are not strings of length 4. This
	primitive is Mac specific; it is a noop on other platforms."

 	<primitive: 'primitiveDirectorySetMacTypeAndCreator' module: 'FilePlugin'>
	self primitiveFailed
! !

!FilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/20/2009 17:26'!
atEnd: id
	"Answer true if the file position is at the end of the file."

	<primitive: 'primitiveFileAtEnd' module: 'FilePlugin'>
	self primitiveFailed
! !

!FilePluginPrims methodsFor: 'path primitives' stamp: 'CamilloBruni 6/17/2013 11:06'!
lookupEntryIn: fullPath index: index
	"Look up the index-th entry of the directory with the given fully-qualified path 
	(i.e., starting from the root of the file hierarchy) and return an array containing:

	<name> <creationTime> <modificationTime> <dirFlag> <fileSize>

	The empty string enumerates the top-level files or drives. (For example, on Unix, the empty 
	path enumerates the contents of '/'. On Macs and PCs, it enumerates the mounted volumes/drives.)

	The creation and modification times are in seconds since the start of the Smalltalk time epoch. 
	DirFlag is true if the entry is a directory. FileSize the file size in bytes or zero for directories. 
	The primitive returns nil when index is past the end of the directory. It fails if the given path 
	is bad."

 	<primitive: 'primitiveDirectoryLookup' module: 'FilePlugin' error: errorCode >
	
	^ #badDirectoryPath

! !

!FilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/20/2009 17:33'!
truncate: id to: anInteger
	"Truncate this file to the given position."

	<primitive: 'primitiveFileTruncate' module: 'FilePlugin'>
	self primitiveFailed
! !

!FilePluginPrims methodsFor: 'path primitives' stamp: 'cwp 11/17/2009 16:26'!
createDirectory: fullPath
	"Create a directory named by the given path. 
	Fail if the path is bad or if a file or directory by that name already exists."

 	<primitive: 'primitiveDirectoryCreate' module: 'FilePlugin'>
	^ nil
! !

!FilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/20/2009 17:27'!
getPosition: id
	"Get this files current position."

	<primitive: 'primitiveFileGetPosition' module: 'FilePlugin'>
	self primitiveFailed
! !

!FilePluginPrims methodsFor: 'path primitives' stamp: 'CamilloBruni 6/17/2013 11:05'!
lookupDirectory: fullPath filename: fileName
 	<primitive: 'primitiveDirectoryEntry' module: 'FilePlugin'>
	
	^ #badDirectoryPath

! !

!FilePluginPrims methodsFor: 'path primitives' stamp: 'cwp 7/20/2009 17:24'!
rename: oldFileFullName to: newFileFullName 
	"Rename the file of the given name to the new name. Fail if there is no file of the old name 
	or if there is an existing file with the new name."

	<primitive: 'primitiveFileRename' module: 'FilePlugin'>
	^nil! !

!FilePluginPrims methodsFor: 'encoding primitives' stamp: 'lr 7/13/2010 14:11'!
encode: aString
	^ aString convertToWithConverter: LanguageEnvironment defaultFileNameConverter! !

!FilePluginPrims methodsFor: 'file primitives' stamp: 'lr 3/21/2010 12:10'!
flush: id
	"Flush pending changes to the disk"
	
	| pos |
	<primitive: 'primitiveFileFlush' module: 'FilePlugin'>
	"In some OS's seeking to 0 and back will do a flush"
	pos := self getPosition: id.
	self setPosition: id to: 0; setPosition: id to: pos! !

!FilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/20/2009 17:28'!
read: id into: byteArray startingAt: startIndex count: count
	"Read up to count bytes of data from this file into the given string or byte array starting at the given index. Answer the number of bytes actually read."

	<primitive: 'primitiveFileRead' module: 'FilePlugin'>
	self primitiveFailed! !

!FilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/20/2009 17:30'!
size: id
	"Answer the size of this file."

	<primitive: 'primitiveFileSize' module: 'FilePlugin'>
	self primitiveFailed
! !

!FilePluginPrims methodsFor: 'path primitives' stamp: 'cwp 10/11/2009 11:02'!
imageFile
	"Answer the full path name for the current image."

	<primitive: 121>
	self primitiveFailed! !

!FilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/20/2009 17:27'!
open: fileName writable: writableFlag
	"Open a file of the given name, and return the file ID obtained.
	If writableFlag is true, then
		if there is none with this name, then create one
		else prepare to overwrite the existing from the beginning
	otherwise
		if the file exists, open it read-only
		else return nil"

	<primitive: 'primitiveFileOpen' module: 'FilePlugin'>
	^ nil
! !

!FilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/20/2009 17:30'!
setPosition: id to: anInteger
	"Set this file to the given position."

	<primitive: 'primitiveFileSetPosition' module: 'FilePlugin'>
	self primitiveFailed
! !

!FilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/22/2009 07:10'!
sizeOrNil: id
	"Answer the size of this file."

	<primitive: 'primitiveFileSize' module: 'FilePlugin'>
	^ nil! !

!FilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/20/2009 17:33'!
write: id from: stringOrByteArray startingAt: startIndex count: count
	"Write count bytes onto this file from the given string or byte array starting at the given index. 	Answer the number of bytes written."

	<primitive: 'primitiveFileWrite' module: 'FilePlugin'>
	self primitiveFailed! !

!FilePluginPrims methodsFor: 'path primitives' stamp: 'cwp 10/11/2009 11:02'!
delimiter
	"Return the path delimiter for the underlying platform's file system."

 	<primitive: 'primitiveDirectoryDelimitor' module: 'FilePlugin'>
	self primitiveFailed
! !

!FilePluginPrims methodsFor: 'path primitives' stamp: 'cwp 7/20/2009 17:21'!
deleteDirectory: fullPath
	"Delete the directory named by the given path. 
	Fail if the path is bad or if a directory by that name does not exist."

 	<primitive: 'primitiveDirectoryDelete' module: 'FilePlugin'>
	self primitiveFailed
! !

!FileReference commentStamp: '<historical>'!
I combine a filesystem and path, which is sufficient to refer to a concrete file or directory. I provide methods for navigating my filesystem, performing filesystem operations and opening and closing files.  I am the primary mechanism for working with files and directories. 

| working |
working := FileSystem disk workingDirectory.
working files 

| disk |
disk := FileSystem disk.
disk root.                               	"a reference to the root directory"
disk working.                         	"a reference to the working directory"!
!FileReference methodsFor: 'testing' stamp: 'cwp 7/20/2009 09:26'!
isRoot
	^ path isRoot! !

!FileReference methodsFor: 'testing' stamp: 'StephaneDucasse 6/22/2012 17:35'!
hasFiles
	"Return whether the receiver has children that are files."
	"FileSystem workingDirectory hasFiles"
	
	^ filesystem hasFiles: path! !

!FileReference methodsFor: 'testing' stamp: 'CamilloBruni 5/9/2012 00:37'!
isReadable
	^ filesystem isReadable: path! !

!FileReference methodsFor: 'streams-compatibility' stamp: 'MaxLeske 1/25/2014 22:50'!
binaryReadStream
	^ filesystem binaryReadStreamOn: self path! !

!FileReference methodsFor: '*GT-InspectorExtensions-Core' stamp: 'MaxLeske 3/4/2014 11:57'!
gtInspectorFuelIn: composite
	<gtInspectorPresentationOrder: 40>
	"(FileSystem disk workingDirectory / 'GTtest.fuel') writeStreamDo: [ :stream |
	FLSerializer newDefault
		at: #author putAdditionalObject: 'Author: Max Leske';
		at: #date putAdditionalObject: DateAndTime now;
		addPreMaterializationAction: [ Smalltalk inform: 'starting materialization' ];
		addPostMaterializationAction: [ :materialization | materialization inspect ];
		serialize: 'foo' on: stream binary ].
	
FLMaterializer materializeFromFileNamed: 'GTtest.fuel'"
	composite table
			title: 'Fuel Header';
			display: [
				(FLMaterializer materializeHeaderFromFileNamed: self fullName) gtGetMetaData ];
			column: 'Property' evaluated: [:assoc| assoc key ];
			column: 'Value' evaluated: [:assoc| assoc value];
			when: [ self extension = 'fuel' ]! !

!FileReference methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/24/2015 14:44'!
spotterForZipFilesFor: aStep
	<spotterOrder: 10>
	| zipFileSystem |
	self isZipFile ifFalse: [ ^ self ].
	aStep listProcessor
			allCandidates: [ 
				zipFileSystem := (FileSystem zip: self) open.
				zipFileSystem workingDirectory files ];
			title: 'Files';
			candidatesLimit: Float infinity;
			itemName: #basename;
			itemIcon: [ GLMUIThemeExtraIcons glamorousBrowse ];
			filter: GTFilterSubstring
	! !

!FileReference methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 3/2/2015 22:26'!
spotterForZipDirectoriesFor: aStep
	<spotterOrder: 10>
	| zipFileSystem |
	self isZipFile ifFalse: [ ^ self ].
	aStep listProcessor
			allCandidates: [ 
				zipFileSystem := (FileSystem zip: self) open.
				zipFileSystem workingDirectory directories ];
			title: 'Directories';
			candidatesLimit: Float infinity;
			itemName: #basename;
			itemIcon: [ GLMUIThemeExtraIcons glamorousFolder ];
			filter: GTFilterSubstring! !

!FileReference methodsFor: 'operations' stamp: 'CamilloBruni 7/10/2012 15:52'!
deleteIfAbsent: aBlock
	self exists 
		ifTrue: [ self delete ]
		ifFalse: aBlock! !

!FileReference methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 3/9/2015 08:11'!
spotterPreviewContentsIn: aComposite
	<spotterPreview: 20>
	
	self isFile ifFalse: [ ^ self ].
	aComposite text
		title: [ self gtDisplayString ]; 
		display: #yourself;
		entity: (self readStreamDo: [ :stream | 
					| result |
					result := [(stream next: 10000) asString]
						on: Error 
						do: [ (stream binary next: 10000) asString ].
					stream size > 10000
						ifTrue: [ result, '  ... truncated ...' ]
						ifFalse: [ result ] ])! !

!FileReference methodsFor: 'accessing' stamp: 'CamilloBruni 1/19/2012 14:16'!
path
	"Return the path internal representation that denotes the receiver in the context of its filesystem. "
	^ path! !

!FileReference methodsFor: 'comparing' stamp: 'EstebanLorenzano 4/3/2012 13:05'!
containsReference: aReference
	^  aReference fileSystem = filesystem and: [path contains: aReference path]! !

!FileReference methodsFor: 'converting' stamp: 'CamilloBruni 7/10/2012 15:03'!
asAbsolute
	"Return the receiver as an absolute file reference."
	
	^ self isAbsolute
		ifTrue: [ self ]
		ifFalse: [ filesystem referenceTo: (filesystem resolve: path) ]! !

!FileReference methodsFor: 'accessing' stamp: 'sd 2/11/2011 19:58'!
entry
	"Return the entry (meta data) describing the receiver."
	^ filesystem entryAt: path! !

!FileReference methodsFor: 'resolving' stamp: 'cwp 11/21/2009 11:30'!
resolveString: aString 
	| thePath |
	thePath := filesystem pathFromString: aString.
	^ filesystem referenceTo: (path resolve: thePath)! !

!FileReference methodsFor: 'accessing' stamp: 'CamilloBruni 1/27/2014 17:18'!
absolutePath
	"Return the absolute of the receiver"
	^ self path isRelative
		ifFalse: [ self path ]
		ifTrue: [ filesystem resolve: self path ]! !

!FileReference methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/24/2015 14:44'!
spotterForFilesFor: aStep
	<spotterOrder: 20>
	^ self isDirectory ifTrue: [
		aStep listProcessor
			allCandidates: [ self files ];
			title: 'Files';
			candidatesLimit: Float infinity;
			itemName: #basename;
			itemIcon: [ GLMUIThemeExtraIcons glamorousBrowse ];
			filter: GTFilterSubstring ]! !

!FileReference methodsFor: 'accessing' stamp: 'CamilloBruni 5/9/2012 13:04'!
mimeTypes
	"Return the possible mime types for the given path."
	^ filesystem mimeTypesAt: path! !

!FileReference methodsFor: 'testing' stamp: 'CamilloBruni 7/10/2012 20:17'!
hasDirectories
	"Return whether the receiver has children that are directories."
	"FileSystem workingDirectory hasDirectories"
	
	^ filesystem hasDirectories: path! !

!FileReference methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 10/22/2014 11:37'!
gtInspectorPngIn: composite
	<gtInspectorPresentationOrder: 0>
	composite morph
			title: 'Picture';
			display: [ self binaryReadStreamDo: [ :stream | PNGReadWriter formFromStream: stream ] ];
			when: [ self mimeTypes notNil and: [ self mimeTypes first matches: ZnMimeType imagePng ] ]! !

!FileReference methodsFor: 'testing' stamp: 'cwp 1/13/2009 20:52'!
exists
	^ filesystem exists: path! !

!FileReference methodsFor: 'streams' stamp: 'CamilloBruni 1/20/2012 13:24'!
openWritable: aBoolean 
	^ filesystem open: path writable: aBoolean! !

!FileReference methodsFor: 'operations' stamp: 'CamilloBruni 2/22/2014 14:56'!
copyTo: aReference
	self isDirectory
		ifTrue: [ aReference ensureCreateDirectory ]
		ifFalse: [ 
			filesystem = aReference fileSystem
				ifTrue: [ filesystem copy: path to: aReference resolve path ]
				ifFalse: [ filesystem copy: path toReference: aReference ] ]! !

!FileReference methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 20:51'!
modificationTime 
	^ filesystem modificationTime: self path! !

!FileReference methodsFor: 'accessing' stamp: 'CamilloBruni 5/7/2012 11:37'!
macTypeAndCreator
	| results typeString creatorString |
	"get the Macintosh file type and creator info for the file with the given name. Fails if the file does not exist or if the type and creator type arguments are not strings of length 4. Does nothing on other platforms (where the underlying primitive is a noop)."
	"FileDirectory default getMacFileNamed: 'foo'"

	self flag: 'TODO'.
	"
	typeString := ByteArray new: 4 withAll: ($? asInteger). #[63 63 63 63]
	creatorString := ByteArray new: 4 withAll: ($? asInteger).
	[self primGetMacFileNamed: (self fullNameFor: fileName) asVmPathName
		type: typeString
		creator: creatorString.] ensure: 
		[typeString := typeString asString. 
		creatorString := creatorString asString].
	results := Array with: typeString convertFromSystemString with: creatorString convertFromSystemString.
	^results"
! !

!FileReference methodsFor: 'accessing' stamp: 'sd 2/11/2011 20:34'!
fullName
	"Return the full path name of the receiver."
	^ filesystem stringFromPath: (filesystem resolve: path)! !

!FileReference methodsFor: 'operations' stamp: 'S 6/17/2013 13:33'!
ensureCreateDirectory
	"Create if necessary a directory for the receiver."
	filesystem ensureCreateDirectory: path
	! !

!FileReference methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 1/28/2015 21:00'!
spotterPreviewItemsIn: aComposite
	<spotterPreview: 10>
	
	self isDirectory ifFalse: [ ^ self ].
	aComposite list
		title: [ self gtDisplayString ];
		display: #yourself;
		format: [ :folder | 
			GTSpotterItemBrick new 
				text: folder basename; 
				icon: (folder isDirectory 
								ifTrue: [Smalltalk ui theme icons glamorousFolder]
								ifFalse: [Smalltalk ui theme icons glamorousBrowse] ); 
				disable; 
				yourself ];
		styled: [ :brick | brick ];
		entity: self directories, self files.
		
	self flag: 'move "entity: self" somewhere else, maybe'! !

!FileReference methodsFor: 'navigating' stamp: 'CamilloBruni 2/21/2014 22:31'!
, extension
	^ self withPath: self path, extension! !

!FileReference methodsFor: 'operations' stamp: 'CamilloBruni 2/22/2014 14:58'!
moveTo: aReference
	
	| result |
	result := self fileSystem 
		rename: self path
		to: aReference resolve path.
	result ifNotNil: [
		self setFileSystem: filesystem path: aReference path ].		! !

!FileReference methodsFor: 'accessing' stamp: 'EstebanLorenzano 4/3/2012 13:03'!
fileSystem
	"Return the filesystem to which the receiver belong."
	^ filesystem! !

!FileReference methodsFor: 'testing' stamp: 'cwp 7/20/2009 09:25'!
isRelative
	^ path isRelative! !

!FileReference methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 15:23'!
fullPath
	^ self path! !

!FileReference methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 2/3/2015 12:45'!
gtInspectorZipItemsIn: composite
	<gtInspectorPresentationOrder: 0>
	^ composite table 
		title: 'Items';
		display: [ 
			| children root |
			root := (FileSystem zip: self) open workingDirectory.
			children := root directories, root files.
			self isRoot 
				ifTrue: [ children ]
				ifFalse: [ 
					children asOrderedCollection 
						addFirst: self parent;
						yourself ] ];
		column: 'Name' evaluated: [:each | self parent = each 
								ifTrue: [ '..' ] 
								ifFalse: [ each basename ]] width: 400;
		column: 'Size' evaluated: [:each | each humanReadableSize] width: 100;
		column: 'Creation' evaluated: [ :each | 
			String streamContents: [:s | 
				each creationTime printYMDOn: s.
				s nextPut: Character space.
				each creationTime printHMSOn: s ]];
		icon: [ :each | 
			each isDirectory 
				ifTrue: [ GLMUIThemeExtraIcons glamorousFolder ] 
				ifFalse: [ GLMUIThemeExtraIcons glamorousBrowse ] ];
		when: [ self isFile and: [ #('zip' 'jar' 'ear' 'war') includes: self extension ] ];
		act: [ :table | table update ] icon: GLMUIThemeExtraIcons glamorousRefresh entitled: 'Refresh'! !

!FileReference methodsFor: 'operations' stamp: 'cwp 7/22/2009 07:42'!
delete
	filesystem delete: path! !

!FileReference methodsFor: 'resolving' stamp: 'CamilloBruni 1/19/2012 12:45'!
resolvePath: anObject
	^ self withPath: (path resolve: anObject)! !

!FileReference methodsFor: 'streams' stamp: 'CamilloBruni 7/10/2012 15:25'!
writeStream
	^ filesystem writeStreamOn: self path! !

!FileReference methodsFor: 'testing' stamp: 'StephaneDucasse 6/22/2012 17:32'!
hasChildren
	"Return whether the receiver has any children."
	"FileSystem workingDirectory hasChildren"
	
	^ filesystem hasChildren: path! !

!FileReference methodsFor: 'testing' stamp: 'cwp 1/13/2009 21:57'!
isFile
	^ filesystem isFile: path! !

!FileReference methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 2/28/2014 06:40'!
gtInspectorActionMaterializeFuel
	<gtInspectorAction>
	^ GLMGenericAction new
		action: [ :composite | 
			| result |
			result := FLMaterializer materializeFromFileNamed: self fullName.
			composite selection: result ];
		icon: GLMUIThemeExtraIcons glamorousAdd;
		condition: [ self extension = 'fuel' ];
		title: 'Materialize'! !

!FileReference methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 10/22/2014 11:37'!
gtInspectorItemsIn: composite
	<gtInspectorPresentationOrder: 0>
	^ composite table 
		title: 'Items';
		display: [ 
			| children |
			children := self directories, self files.
			self isRoot 
				ifTrue: [ children ]
				ifFalse: [ 
					children asOrderedCollection 
						addFirst: self parent;
						yourself ] ];
		column: 'Name' evaluated: [:each | (self isChildOf: each) 
								ifTrue: [ '..' ] 
								ifFalse: [ each basename ]] width: 400;
		column: 'Size' evaluated: [:each | each humanReadableSize] width: 100;
		column: 'Creation' evaluated: [ :each | 
			String streamContents: [:s | 
				each creationTime printYMDOn: s.
				s nextPut: Character space.
				each creationTime printHMSOn: s ]];
		icon: [ :each | 
			each isDirectory 
				ifTrue: [ GLMUIThemeExtraIcons glamorousFolder ] 
				ifFalse: [ GLMUIThemeExtraIcons glamorousBrowse ] ];
		when: [self isDirectory and: [self hasChildren]];
		selectionAct: [:table | table selection delete. table update] entitled: 'Delete';
		act: [ :table | table update ] icon: GLMUIThemeExtraIcons glamorousRefresh entitled: 'Refresh'! !

!FileReference methodsFor: 'initialize-release' stamp: 'EstebanLorenzano 4/3/2012 13:07'!
setFileSystem: aFilesystem path: aPath
	filesystem := aFilesystem.
	path := aPath! !

!FileReference methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 1/28/2015 21:57'!
spotterPreviewPngIn: aComposite
	<spotterPreview: 10>
	
	(self mimeTypes notNil and: [ 
		self mimeTypes first matches: ZnMimeType imagePng ]) 
		ifFalse: [ ^ self ].
	aComposite custom: 
		((self binaryReadStreamDo: [ :stream | PNGReadWriter formFromStream: stream ])
			asAlphaImageMorph asBrick margin: 20)! !

!FileReference methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 10/27/2014 10:44'!
gtInspectorJpegIn: composite
	<gtInspectorPresentationOrder: 0>
	composite morph
			title: 'Picture';
			display: [ self binaryReadStreamDo: [ :stream | ImageReadWriter formFromStream: stream ] ];
			when: [ self mimeTypes notNil and: [ self mimeTypes first matches: ZnMimeType imageJpeg ] ]! !

!FileReference methodsFor: '*monticellofiletree-filesystem-utilities' stamp: 'dkh 8/10/2012 10:27'!
fileTreeUtilityClass
    ^ MCFileTreeFileSystemUtils! !

!FileReference methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/24/2015 14:44'!
spotterForDirectoriesFor: aStep
	<spotterOrder: 10>
	^ self isDirectory ifTrue: [
		aStep listProcessor
			allCandidates: [ self directories ];
			title: 'Directories';
			candidatesLimit: Float infinity;
			itemName: #basename;
			itemIcon: [ GLMUIThemeExtraIcons glamorousFolder ];
			filter: GTFilterSubstring ]! !

!FileReference methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 3/11/2015 22:05'!
spotterPreviewZipItemsIn: aComposite
	<spotterPreview: 10>

	| zip |
	self isZipFile ifFalse: [ ^ self ].
	zip:= (FileSystem zip: self) open workingDirectory.
	aComposite list
		title: [ self gtDisplayString ];
		display: #yourself;
		format: [ :folder | 
			GTSpotterItemBrick new 
				text: folder basename; 
				icon: (folder isDirectory 
								ifTrue: [Smalltalk ui theme icons glamorousFolder]
								ifFalse: [Smalltalk ui theme icons glamorousBrowse] ); 
				disable; 
				yourself ];
		styled: [ :brick | brick ];
		entity: (zip directories, zip files)! !

!FileReference methodsFor: 'operations' stamp: 'StephaneDucasse 8/4/2012 10:55'!
createDirectory
	"Create a directory if it does not already exist, if this is the case raise the DirectoryExists exception."
	filesystem createDirectory: path! !

!FileReference methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 20:50'!
creationTime 
	^ filesystem creationTime: self path! !

!FileReference methodsFor: 'testing' stamp: 'CamilloBruni 5/9/2012 00:37'!
isWritable
	^ filesystem isWritable: path! !

!FileReference methodsFor: 'testing' stamp: 'EstebanLorenzano 8/2/2012 15:42'!
isSymlink 
	^ filesystem isSymlink: path! !

!FileReference methodsFor: 'testing' stamp: 'cwp 1/13/2009 21:39'!
isDirectory
	^ filesystem isDirectory: path! !

!FileReference methodsFor: 'printing' stamp: 'cwp 10/11/2009 22:32'!
printOn: aStream
	filesystem forReferencePrintOn: aStream.
	filesystem printPath: path on: aStream! !

!FileReference methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 10/22/2014 11:37'!
gtInspectorGifIn: composite
	<gtInspectorPresentationOrder: 0>
	composite morph
			title: 'Picture';
			display: [ self binaryReadStreamDo: [ :stream | GIFReadWriter formFromStream: stream ] ];
			when: [ self mimeTypes notNil and: [ self mimeTypes first matches: ZnMimeType imageGif ] ]! !

!FileReference methodsFor: 'utility' stamp: 'GuillermoPolito 6/22/2012 13:31'!
nextVersion
	"Assumes a file name includes a version number encoded as '.' followed by digits 
	preceding the file extension.  Increment the version number and answer the new file name.
	If a version number is not found, return just the file"

	| parent version versionNumbers nameWithoutExtension |
	
	self exists
		ifFalse: [ ^ self ].
	
	parent := self parent.
	nameWithoutExtension := self basename copyUpTo: $..
	
	versionNumbers := parent files 
				select: [ :f| 
					(f basename beginsWith: nameWithoutExtension) ]
				thenCollect: [ :f| 
					Number squeezeNumberOutOfString: f basename ifFail: [ 0 ]].
	
	versionNumbers ifEmpty: [ ^self ].
	
	version := versionNumbers max + 1.
	^ parent / (nameWithoutExtension , '.', version asString) , self extension! !

!FileReference methodsFor: 'resolving' stamp: 'EstebanLorenzano 4/3/2012 13:09'!
resolveReference: aReference
	
	^ (filesystem = aReference fileSystem or: [aReference isRelative])
		ifTrue: [filesystem referenceTo: (path resolvePath: aReference path)]
		ifFalse: [aReference]! !

!FileReference methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 12/6/2014 13:18'!
gtDisplayOn: stream
	filesystem printPath: path on: stream! !

!FileReference methodsFor: 'navigating' stamp: 'EstebanLorenzano 4/3/2012 13:07'!
entries
	"Return the entries (meta data - file description) of the direct children of the receiver"
	^ self fileSystem entriesAt: self path ! !

!FileReference methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 22:06'!
size
	^ filesystem size: path! !

!FileReference methodsFor: 'comparing' stamp: 'cwp 9/16/2009 23:54'!
hash
	^ path hash bitXor: filesystem hash! !

!FileReference methodsFor: 'streams' stamp: 'CamilloBruni 7/10/2012 15:25'!
readStream
	^ filesystem readStreamOn: self path! !

!FileReference methodsFor: 'copying' stamp: 'CamilloBruni 7/10/2012 15:17'!
copyWithPath: newPath
	^ filesystem referenceTo: newPath! !

!FileReference methodsFor: 'testing' stamp: 'cwp 7/20/2009 09:24'!
isAbsolute
	^ path isAbsolute! !

!FileReference methodsFor: 'printing' stamp: 'sd 2/11/2011 20:34'!
pathString
	"Return the full path name of the receiver."
	
	^ filesystem stringFromPath: (filesystem resolve: path)! !

!FileReference methodsFor: 'converting' stamp: 'EstebanLorenzano 4/12/2012 14:28'!
asFileReference
	^ self! !

!FileReference methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 21:29'!
permissions
	^ filesystem permissions: self path! !

!FileReference methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 10/24/2014 15:00'!
gtInspectorContentsIn: composite
	<gtInspectorPresentationOrder: 5>
	composite rubricText
			title: 'Contents';
			display: [ 
				self readStreamDo: [ :stream | 
					| result |
					result := [(stream next: 10000) asString]
						on: Error 
						do: [ (stream binary next: 10000) asString ].
					stream size > 10000
						ifTrue: [ result, '  ... truncated ...' ]
						ifFalse: [ result ] ] ];
			withLineNumbers: true;
			when: [ self isFile ]! !

!FileReference methodsFor: 'comparing' stamp: 'EstebanLorenzano 4/3/2012 13:02'!
= other
	^ self species = other species
		and: [self path = other path
			and: [self fileSystem = other fileSystem]]! !

!FileReference methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 2/2/2015 14:34'!
isZipFile
	^ self isFile and: [ #('zip' 'jar' 'ear' 'war') includes: self extension ]! !

!FileReference methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 10/27/2014 10:18'!
gtInspectorStScriptIn: composite
	<gtInspectorPresentationOrder: 0>
	composite smalltalkCode
			title: 'Script';
			display: [ self readStreamDo: [ :s | s contents ] ];
			selectionPopulate: #selection
				on: $o
				entitled: 'Do it and open (o)'
				with: [ :text :object | 
					Smalltalk compiler evaluate: text selectedText for: object logged: false ];
			act: [ :text |
				self ensureDelete; writeStreamDo: [ :s | s nextPutAll: text text asString ] ]
				icon: GLMUIThemeExtraIcons glamorousSave
				on: $s
				entitled: 'Save';
			when: [ self extension = 'st' or: [self extension = 'ph'] ]! !

!FileReference methodsFor: 'operations' stamp: 'CamilloBruni 2/22/2014 14:58'!
renameTo: newBasename
	
	| destinationPath |
	destinationPath := self fileSystem 
		rename: self 
		to: self parent / newBasename.
	
	destinationPath ifNotNil: [
		self 
			setFileSystem: filesystem 
			path: destinationPath ].
	^ self
		! !

!FileReference methodsFor: 'accessing' stamp: 'cwp 10/26/2009 02:02'!
resolve
	^ self! !

!FileReference methodsFor: '*metacello-platform' stamp: 'ChristopheDemarey 5/24/2013 14:54'!
asRepositorySpecFor: aMetacelloMCProject
  ^ aMetacelloMCProject repositorySpec
    description: self fullName;
    type: 'directory';
    yourself! !

!FileReference methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 3/9/2015 08:08'!
spotterPreviewStScriptIn: aComposite
	<spotterPreview: 10>
	
	(self extension = 'st' or: [self extension = 'ph']) 
		ifFalse: [ ^ self ].
	aComposite pharoMethod 
		title: [self gtDisplayString];
		display: #yourself;
		smalltalkClass: [ nil ];
		entity: (self readStreamDo: #contents)! !

!FileReference methodsFor: 'accessing' stamp: 'CamilloBruni 5/7/2012 02:01'!
setMacType: aTypeString creator: aCreatorString
	self flag: 'TODO'.
	
" 	self primSetMacFileNamed: (self fullNameFor: fileName) asVmPathName
		type: typeString convertToSystemString
		creator: creatorString convertToSystemString.
"! !

!FileReference class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 3/26/2015 00:04'!
gtExampleGif
	<gtExample>
	^ FileSystem memory workingDirectory / 'pharoicon.gif' 
		writeStreamDo: [ :stream |
			GIFReadWriter 
				putForm: ThemeIcons current pharoIcon 
				onStream: stream ];
		yourself! !

!FileReference class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 3/26/2015 00:04'!
gtExamplePng
	<gtExample>
	^ FileSystem memory workingDirectory / 'pharoicon.png' 
		writeStreamDo: [ :stream |
			PNGReadWriter 
				putForm: ThemeIcons current pharoIcon 
				onStream: stream ];
		yourself! !

!FileReference class methodsFor: 'instance creation' stamp: 'EstebanLorenzano 4/3/2012 13:21'!
fileSystem: aFilesystem path: aPath
	^ self new setFileSystem: aFilesystem path: aPath! !

!FileReference class methodsFor: 'instance creation' stamp: 'ChristopheDemarey 6/25/2014 16:36'!
newTempFilePrefix: prefix suffix: suffix
	| tmpDir random fileName |
	
	tmpDir := FileLocator temp asFileReference.
	[ random := UUIDGenerator default generateRandomBitsOfLength: 100.
	fileName := prefix , random asString, suffix ] doWhileTrue: [ (tmpDir / fileName) exists ].
	^ fileName asFileReference! !

!FileReference class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 3/26/2015 00:04'!
gtExampleDirectory
	<gtExample>
	| directory subDirectory |
	directory := FileSystem memory workingDirectory / 'directory'.
	directory createDirectory.
	directory / 'file1.txt' writeStreamDo: [ :stream | stream nextPutAll: 'File1 contents' ].
	directory / 'file2.txt' writeStreamDo: [ :stream | stream nextPutAll: 'File2 contents' ].
	subDirectory := (directory / 'subdirectory') createDirectory.
	subDirectory / 'file3.txt' writeStreamDo: [ :stream | stream nextPutAll: 'File3 contents' ].
	^ directory! !

!FileReference class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 3/26/2015 00:04'!
gtExampleText
	<gtExample>
	^ FileSystem memory workingDirectory / 'sample.txt' 
		writeStreamDo: [ :stream |
			stream nextPutAll: self comment ];
		yourself! !

!FileReference class methodsFor: 'cross platform' stamp: 'EstebanLorenzano 4/2/2012 11:43'!
/ aString
	"Answer a reference to the argument resolved against the root of the current disk filesystem."
	
	^ FileSystem disk / aString! !

!FileReference class methodsFor: '*Spec-Inspector' stamp: 'MarcusDenker 10/5/2013 22:00'!
additionalInspectorClasses
	^ super additionalInspectorClasses, { EyeFileSystemInspector }! !

!FileReferenceTest commentStamp: 'TorstenBergmann 1/31/2014 11:39'!
SUnit tests for file reference!
!FileReferenceTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:41'!
testReadStreamNotFound
	| ref  |
	ref := filesystem * 'plonk'.
	self
		should: [ref readStream]
		raise: FileDoesNotExist ! !

!FileReferenceTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/12/2012 14:25'!
testAllDirectories
	"allDirectories returns all folders recursively nested in a reference"
	<publicTest>
	"self debug: #testAllDirectories"
	| ref children |
	filesystem createDirectory: '/alpha'.
	filesystem createDirectory: '/alpha/beta'.
	filesystem createDirectory: '/alpha/beta/delta'.
	filesystem createDirectory: '/alpha/gamma'.
	
	ref := filesystem / 'alpha'.
	children := ref allDirectories.
	"all children returns the directories: '/alpha', '/alpha/beta', and '/alpha/gamma'."
	self assert: children size = 4.
	
	children do:
		[:child |
		self assert: child class = FileReference.
		self assert: (ref = child or: [ref contains: child])].
	self assert: (children collect: [:ea | ea basename]) = #('alpha' 'beta' 'gamma' 'delta')! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 6/23/2012 00:16'!
testReadStreamIfAbsent
	| ref stream path |
	path := Path * 'plonk'.
	filesystem store createFile: path.
	ref := filesystem referenceTo: path.
	[ 
	stream := ref readStreamIfAbsent: [ self signalFailure: 'Should not reach here.' ].
	 ] 
		ensure: [ stream ifNotNil: [ stream close ] ]! !

!FileReferenceTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/12/2012 14:25'!
testAllChildren
	"allChildren returns all the files and folders recursively nested in a reference"
	<publicTest>
	"self debug: #testAllChildren"
	| ref children |
	filesystem createDirectory: '/alpha'.
	filesystem createDirectory: '/alpha/beta'.
	filesystem createDirectory: '/alpha/beta/delta'.
	filesystem createDirectory: '/alpha/gamma'.
	
	ref := filesystem / 'alpha'.
	children := ref allChildren.
	"all children returns the nodes: '/alpha', '/alpha/beta',  '/alpha/beta/delta', and '/alpha/gamma'."
	self assert: children size = 4.
	children do:
		[:child |
		self assert: child class = FileReference.
		self assert: (ref = child or: [ref contains: child])].
	self assert: (children collect: [:ea | ea basename]) = #('alpha' 'beta' 'gamma' 'delta')! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:41'!
testIsNotAbsolute
	self deny: (filesystem * 'plonk') isAbsolute! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:31'!
testIsRelative
	self assert: (filesystem * 'plonk') isRelative! !

!FileReferenceTest methodsFor: 'tests' stamp: 'StephaneDucasse 6/17/2012 19:17'!
testDeleteAllChildren
	"allChildren returns all the files and folders recursively nested in a reference"
	<publicTest>
	"self debug: #testDeleteAllChildren"
	| ref children |
	filesystem createDirectory: '/alpha'.
	filesystem createDirectory: '/alpha/beta'.
	filesystem createDirectory: '/alpha/beta/delta'.
	filesystem createDirectory: '/alpha/gamma'.
	
	ref := filesystem / 'alpha'.
	ref deleteAllChildren.
	
	self assert: ref exists.
	self deny: (ref / 'beta') exists.
	self deny: (ref / 'beta' / 'delta') exists.
	self deny: (ref / 'beta' / 'gamma') exists.! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 6/22/2012 18:03'!
testHasChildren
	<publicTest>
	"self debug: #testHasChildren"
	| ref children |
	filesystem createDirectory: '/alpha'.
	filesystem createDirectory: '/alpha/beta'.
	filesystem createDirectory: '/alpha/beta/delta'.
	filesystem createDirectory: '/alpha/gamma'.
	
	ref := filesystem / 'alpha'.
	
	self assert: ref hasChildren.
	self assert: (ref / 'beta') hasChildren.
	self deny: (ref / 'beta' / 'delta') hasChildren.
	self deny: (ref / 'beta' / 'gamma') hasChildren.! !

!FileReferenceTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testPathRelativeTo
	| parent childPath relative |
	parent := filesystem / 'griffle'.
	childPath := Path / 'griffle' / 'plonk' / 'nurb'.
	relative := childPath relativeTo: parent.
	self assert: relative = (Path * 'plonk' / 'nurb')! !

!FileReferenceTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:43'!
testAllEntries
	| ref entries |
	filesystem createDirectory: '/alpha'.
	filesystem createDirectory: '/alpha/beta'.
	filesystem createDirectory: '/alpha/beta/delta'.
	filesystem createDirectory: '/alpha/gamma'.
	
	ref := filesystem / 'alpha'.
	entries := ref allEntries.
	self assert: entries size = 4.
	entries do:
		[:entry |
		self assert: entry class = FileSystemDirectoryEntry.
		self assert: (ref = entry reference or: [ref contains: entry reference])].
	self assert: (entries collect: [:ea | ea basename]) = #('alpha' 'beta' 'gamma' 'delta')! !

!FileReferenceTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testDoesntContainLocator
	| ref |
	ref := filesystem * 'griffle'. 
	self deny: (ref contains: FileLocator image)! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:47'!
testRootParent
	| root |
	root := filesystem root.
	self assert: root parent == root! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 6/23/2012 00:17'!
testWriteStreamifPresent
	| ref stream |
	ref := filesystem / 'plonk'.
	[stream := ref writeStreamIfPresent: [self signalFailure: 'Should not reach here']]
		ensure: [stream ifNotNil: [stream close]]! !

!FileReferenceTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testContainsLocator
	| ref |
	ref := FileLocator imageDirectory resolve parent.
	self assert: (ref contains: FileLocator image)! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 6/23/2012 00:19'!
testWriteStreamDoifPresent
	| ref s |
	ref := filesystem / 'plonk'.
	ref 
		writeStreamDo:
			[:stream |
			s := stream.
			self deny: stream isNil ]
		ifPresent: [self signalFailure: 'The file does not exist!!'].
		! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:44'!
testAsAbsoluteIdentity
	| ref |
	ref := filesystem / 'plonk'.
	self assert: ref asAbsolute == ref! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 6/13/2013 16:06'!
testContents
	| ref contents |
	
	contents := '12345 abcdf!!'.
	ref := filesystem * 'file'.
	
	ref writeStreamDo: [ :stream |
		stream nextPutAll: contents ].
	
	self assert: ref contents asString equals: contents! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:42'!
testGrandchildOfReference
	| griffle  nurb |
	griffle := filesystem / 'griffle'.
	nurb := filesystem / 'griffle' / 'plonk' / 'nurb'.
	self deny: (griffle isChildOf: nurb).
	self deny: (nurb isChildOf: griffle).! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:47'!
testResolve
	| ref |
	ref := filesystem / 'griffle'.
	self assert: ref resolve == ref! !

!FileReferenceTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testSimpleResolution
	| base relative absolute |
	base := filesystem / 'plonk'.
	relative := (Path * 'griffle') / 'zonk'.
	absolute := base resolve: relative.
	self assert: absolute isAbsolute.
	self assert: (absolute path at: 1) = 'plonk'.
	self assert: (absolute path at: 2) = 'griffle'.
	self assert: (absolute path at: 3) = 'zonk'.
	
	! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:42'!
testCommaAddsExtension
	| ref result |
	ref := filesystem * 'plonk'.
	result := ref, 'griffle'.
	self assert: result basename = 'plonk.griffle'! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 6/23/2012 00:19'!
testWriteStreamDo
	| ref s |
	ref := filesystem / 'plonk'.
	ref writeStreamDo:
		[:stream |
		s := stream.
		self deny: stream isNil ].
		! !

!FileReferenceTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/12/2012 14:25'!
testChildren
	| ref children |
	filesystem createDirectory: '/alpha'.
	filesystem createDirectory: '/alpha/beta'.
	filesystem createDirectory: '/alpha/gamma'.
	
	ref := filesystem / 'alpha'.
	children := ref children.
	self assert: children size = 2.
	children do:
		[:child |
		self assert: child class = FileReference.
		self assert: (child isChildOf: ref).
		self assert: (#('beta' 'gamma') includes: child basename)]! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 6/23/2012 00:17'!
testWriteStream
	| ref stream |
	ref := filesystem / 'plonk'.
	[stream := ref writeStream.]
		ensure: [stream ifNotNil: [stream close]]! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:44'!
testAsAbsoluteConverted
	"Converts a relative reference to absolute, and asserts
	that it's absolute and still has the same path."
	
	| ref absolute |
	ref := filesystem * 'plonk'.
	absolute := ref asAbsolute.
	self assert: absolute isAbsolute.
	self assert: (absolute path at: 1) = 'plonk'! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 6/22/2012 18:22'!
testBasenameWithoutExtension
	"self debug: #testBasenameWithoutExtension"
	
	| ref |
	
	ref := filesystem root.
	self assert: ref basename = '/'.
	
	ref := filesystem * 'plonk' / 'griffle'.
	self assert: ref basenameWithoutExtension = 'griffle'.
	
	ref := filesystem * 'plonk' / 'griffle.taz'.
	self assert: ref basenameWithoutExtension = 'griffle'.
	
	ref := filesystem * 'plonk' / 'griffle.taz.zork'.
	self assert: ref basenameWithoutExtension = 'griffle.taz'.! !

!FileReferenceTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/3/2012 13:18'!
testDoesntContainReferenceFileSystem
	| ref other |
	ref := filesystem  * 'griffle'.
	other := FileSystem memory / 'griffle' / 'nurp'.
	self deny: (ref contains: other)! !

!FileReferenceTest methodsFor: 'tests' stamp: 'S 6/17/2013 13:24'!
testHasDirectories
	<publicTest>
	"self debug: #testHasDirectories"
	| ref children |
	filesystem createDirectory: '/alpha'.
	filesystem createDirectory: '/alpha/beta'.
	
	(filesystem / 'alpha' / 'beta' / 'delta') ensureCreateFile.
	
	filesystem createDirectory: '/alpha/gamma'.
	ref := filesystem / 'alpha'.
	
	self assert: ref hasDirectories.
	self deny: (ref / 'beta') hasDirectories.
	self deny: (ref / 'beta' / 'gamma') hasDirectories.! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:31'!
testSlash
	| ref result |
	ref := filesystem * 'plonk'.
	result := ref / 'griffle'.
	self assert: result class = ref class.
	self assert: result  isRelative.
	self assert: (result path at: 1) = 'plonk'.
	self assert: (result path at: 2) = 'griffle'.
! !

!FileReferenceTest methodsFor: 'tests' stamp: 'StephaneDucasse 6/17/2012 19:17'!
testDeleteAll
	"allChildren returns all the files and folders recursively nested in a reference"
	<publicTest>
	"self debug: #testDeleteAll"
	| ref children |
	filesystem createDirectory: '/alpha'.
	filesystem createDirectory: '/alpha/beta'.
	filesystem createDirectory: '/alpha/beta/delta'.
	filesystem createDirectory: '/alpha/gamma'.
	
	ref := filesystem / 'alpha'.
	ref deleteAll.
	
	self deny: ref exists.
	self deny: (ref / 'beta') exists.
	self deny: (ref / 'beta' / 'delta') exists.
	self deny: (ref / 'beta' / 'gamma') exists.! !

!FileReferenceTest methodsFor: 'support' stamp: 'S 6/17/2013 13:33'!
createFile: aPath
	filesystem ensureCreateDirectory: aPath parent.
	(filesystem writeStreamOn: aPath) close! !

!FileReferenceTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testChildOfPath
	| parent  child |
	parent := Path / 'griffle'.
	child := filesystem / 'griffle' / 'nurb'.
	self deny: (child isChildOf: parent).
	self deny: (parent isChildOf: child).! !

!FileReferenceTest methodsFor: 'tests stream' stamp: 'EstebanLorenzano 4/2/2012 11:41'!
testReadStreamDoNotFound
	| ref |
	ref := filesystem / 'plonk'.
	self
		should: [ref readStreamDo: [:s]]
		raise: FileDoesNotExist ! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 6/23/2012 00:18'!
testReadStreamDoifAbsent
	| ref path s |
	path := Path * 'plonk'.
	filesystem store createFile: path.
	ref := filesystem referenceTo: path.
	ref
		readStreamDo: [ :stream | 
			self deny: stream isNil.
			s := stream ]
		ifAbsent: [ self signalFailure: 'The file exists!!' ].! !

!FileReferenceTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testRelativeToReference
	| parent child relative |
	parent := filesystem / 'griffle'.
	child := filesystem  / 'griffle' / 'plonk' / 'nurb'.
	relative := child relativeTo: parent.
	self assert: relative = (Path * 'plonk' / 'nurb')! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:46'!
testUnequalContent
	| a b |
	a := filesystem * 'plonk'.
	b := filesystem * 'griffle'.
	self deny: a = b.! !

!FileReferenceTest methodsFor: 'tests' stamp: 'S 6/17/2013 13:26'!
testRename

	| file newName tmp originalPwd originalFullName |
	[
		file := (FileLocator imageDirectory / 'oldName') ensureCreateFile.
		originalFullName := file fullName.
		tmp := (FileLocator imageDirectory / 'tmp') ensureCreateDirectory.
		originalPwd := FileSystem disk workingDirectory.
		
		file renameTo: 'newName'.
		
		self deny: originalFullName asFileReference exists.
		self assert: file basename equals: 'newName'.
		self assert: (originalFullName asFileReference parent / 'newName') exists		
	] ensure: [
		file delete.
		tmp deleteAll.
	].! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:50'!
testContainsPath
	| ref |
	ref := filesystem  * 'griffle'.
	self assert: (ref contains: (ref / 'nurp') path)! !

!FileReferenceTest methodsFor: 'tests' stamp: 'S 6/17/2013 13:24'!
testHasFiles
	<publicTest>
	"self debug: #testHasFiles"
	| ref children |
	filesystem createDirectory: '/alpha'.
	filesystem createDirectory: '/alpha/beta'.
	(filesystem / 'alpha' / 'beta' / 'delta') ensureCreateFile.
	filesystem createDirectory: '/alpha/beta/eta'.
	filesystem createDirectory: '/alpha/gamma'.
	ref := filesystem / 'alpha'.
	
	self deny: ref hasFiles.
	self assert: (ref / 'beta') hasFiles.
	self deny: (ref / 'beta' / 'gamma') hasFiles.! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:49'!
testIsNotRoot
	self deny: (filesystem / 'plonk') isRoot! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:24'!
testWithExtentionReplacesExtension
	| ref result |
	ref := filesystem * 'plonk.griffle'.
	result := ref withExtension: 'nurp'.
	self assert: result isRelative.
	self assert: result basename = 'plonk.nurp'! !

!FileReferenceTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/12/2012 14:25'!
testChildDirectories
	| childDirectories |
	filesystem createDirectory: '/beta'.
	filesystem createDirectory: '/gamma'.	
	(filesystem / 'delta')
		writeStreamDo: [ :stream | stream nextPutAll: '1' ].
	(filesystem / 'epsilon')
		writeStreamDo: [ :stream | stream nextPutAll: '2' ].
	childDirectories := filesystem root directories.
	self assert: childDirectories size = 2.
	childDirectories do: [ :each | 
		self assert: each class = FileReference.
		self assert: each isDirectory description: 'Collection should not contain references to files.' ]! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:48'!
testParent
	| ref parent |
	ref := filesystem * 'plonk' / 'griffle'.
	parent := ref parent.
	self assert: parent class = ref class.
	self assert: (parent path at: 1) = 'plonk'! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:42'!
testChildOfReference
	| parent  child |
	parent := filesystem / 'griffle'.
	child := filesystem / 'griffle' / 'nurb'.
	self assert: (child isChildOf: parent).
	self deny: (parent isChildOf: child).! !

!FileReferenceTest methodsFor: 'tests' stamp: 'S 6/17/2013 13:24'!
testRenameTargetExists

	| existingFile fileToRename |
	[
		existingFile := 'existingFile' asFileReference ensureCreateFile.
		fileToRename := 'fileToRename' asFileReference ensureCreateFile.
		self should: [ fileToRename renameTo: existingFile basename ] raise: FileExists ]
		ensure: [
			existingFile delete.
			fileToRename delete ].! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:42'!
testEqual

	| a b |
	a := filesystem * 'plonk'.
	b := filesystem * 'plonk'.
	self deny: a == b.
	self assert: a = b.! !

!FileReferenceTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/28/2012 00:13'!
testBaseAndExtension
	"self debug: #testBaseAndExtension"
	
	| noExtension simpleExtension complexExtension |
	noExtension := filesystem * 'plonk'.
	self assert: noExtension extension equals: ''.

	"We create a reference to the plonk/griffle.taz in the context of filesystem"
	simpleExtension := filesystem * 'plonk' / 'griffle.taz'.
	self assert: simpleExtension base = 'griffle'.
	self assert: simpleExtension extension = 'taz'.
	
	"Note that the extension of a complex extension starts after the last extension delimiter"
	complexExtension := filesystem * 'plonk' / 'griffle.taz.txt'.
	self assert: complexExtension base equals: 'griffle'.
	self assert: complexExtension extension equals: 'txt'.! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 6/23/2012 00:14'!
testWriteStreamExists
	| ref stream path |
	path := Path * 'plonk'.
	filesystem store createFile: path.
	ref := filesystem referenceTo: path.
	[stream := ref writeStream ] 
		ensure: [ stream ifNotNil: [ stream close ] ]! !

!FileReferenceTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testWorkingDirectoryParent
	| wd |
	wd := filesystem referenceTo: Path workingDirectory.
	self assert: wd parent path size = 1.
	self assert: (wd parent path at: 1) = '..'.! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:49'!
testDoesntContainReferencePath
	| ref other |
	ref := filesystem * 'griffle'.
	other := filesystem * 'nurp'.
	self deny: (ref contains: other)! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:41'!
testIndicator
	"self debug: #testIndicator"
	
	| ref |
	ref := filesystem * 'plonk' / 'griffle'.
	self deny: ref exists.
	self assert: ref indicator = '?'.
	
	ref := filesystem workingDirectory / 'plonk'.
	self deny: ref exists.
	[ref createDirectory.
	 self assert: ref exists.
	self assert: ref isDirectory.
	 self assert: ref indicator equals: '/' ] ensure: [ref delete].
	
	ref := filesystem workingDirectory / 'plonk'.
	self deny: ref exists.
	[ref writeStreamDo: [:stream | stream nextPutAll: 'foo'  ] ifPresent: [self fail].
	 self assert: ref exists.
	self assert: ref isFile.
	 self assert: ref indicator equals: '' ] ensure: [ref delete].! !

!FileReferenceTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/3/2012 13:09'!
testParentResolutionWithAbsoluteReference
	| base relative absolute |
	base := (filesystem / '/plonk' / 'pinto').
	relative := (FileSystem memory / 'griffle' / 'zonk').
	absolute := base resolve: relative.
	self assert: absolute fileSystem == relative fileSystem.
	self assert: absolute isAbsolute.
	self assert: (absolute path at: 1) = 'griffle'.
	self assert: (absolute path at: 2) = 'zonk'.
	
	! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:47'!
testReadStreamDoifAbsentNot
	| ref pass |
	pass := false.
	ref := filesystem * 'plonk'.
	ref 
		readStreamDo: [:stream]
		ifAbsent: [pass := true].
	self assert: pass! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:31'!
testIsNotRelative
	self deny: (filesystem / 'plonk') isRelative! !

!FileReferenceTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:43'!
testEntries

	| ref entries |
	filesystem createDirectory: '/alpha'.
	filesystem createDirectory: '/alpha/beta'.
	filesystem createDirectory: '/alpha/gamma'.
	
	ref := filesystem  / 'alpha'.
	entries := ref entries.
	self assert: entries size = 2.
	entries do:
		[:entry |
		self assert: entry class = FileSystemDirectoryEntry.
		self assert: (entry reference isChildOf: ref).
		self assert: (#('beta' 'gamma') includes: entry reference basename)]! !

!FileReferenceTest methodsFor: 'tests' stamp: 'S 6/17/2013 13:24'!
testExists

	| reference |
	reference := filesystem / 'plonk'.
	
	reference ensureCreateFile.
	self assert: reference exists.

	reference delete.
	self deny: reference exists. ! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:49'!
testIsRoot
	self assert: (filesystem root) isRoot! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:48'!
testParentResolutionWithReference
	| base relative absolute |
	base := (filesystem / 'plonk' / 'pinto').
	relative := (filesystem referenceTo: '../griffle/zonk').
	absolute := base resolve: relative.
	self assert: absolute isAbsolute.
	self assert: (absolute path at: 1) = 'plonk'.
	self assert: (absolute path at: 2) = 'griffle'.
	self assert: (absolute path at: 3) = 'zonk'.
	
	! !

!FileReferenceTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:43'!
testParentResolutionWithRemoteReference
	| base relative absolute |
	base := (filesystem / 'plonk' / 'pinto').
	relative := (FileSystem memory referenceTo: '../griffle/zonk').
	absolute := base resolve: relative.
	self assert: absolute isAbsolute.
	self assert: (absolute path at: 1) = 'plonk'.
	self assert: (absolute path at: 2) = 'griffle'.
	self assert: (absolute path at: 3) = 'zonk'.
	
	! !

!FileReferenceTest methodsFor: 'tests' stamp: 'MarcusDenker 9/12/2013 14:48'!
testEnsureDelete
	| reference |
	reference := filesystem / 'plonk'.	"Deletes the file if it exists"
	reference ensureCreateFile.
	self assert: reference exists.
	reference ensureDelete.
	self deny: reference exists.	"No-op if file does not exist"
	reference ensureDelete! !

!FileReferenceTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testWriteStreamDoifPresentNot
	| ref pass path |
	pass := false.
	path := Path * 'plonk'.
	filesystem store createFile: path.
	ref := filesystem referenceTo: path.
	ref writeStreamDo: [ :stream |  ] ifPresent: [ pass := true ].
	self assert: pass! !

!FileReferenceTest methodsFor: 'tests' stamp: 'BernardoContreras 2/20/2015 22:50'!
testParentUpTo
	| base a b c |
	[ 
		base := filesystem workingDirectory.
		(base / 'testParentUpTo') ensureCreateDirectory.
		a := (base / 'testParentUpTo' / 'A') ensureCreateDirectory.
		b := (base / 'testParentUpTo' / 'A' / 'B') ensureCreateDirectory.
		c := (base / 'testParentUpTo' / 'A' / 'B' / 'C') ensureCreateDirectory.
		self assert: b equals: (c parentUpTo: 'B').
		self assert: a equals: (c parentUpTo: 'A').
		self assert: (base / 'testParentUpTo') equals: (c parentUpTo: 'testParentUpTo').
		self assert: base equals: (c parentUpTo: 'notAParent') 
	] ensure: [ 
		(base / 'testParentUpTo') ensureDeleteAll 
	]! !

!FileReferenceTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testParentResolutionWithPath
	| base relative absolute |
	base := filesystem / 'plonk' / 'pinto'.
	relative := Path parent / 'griffle' / 'zonk'.
	absolute := base resolve: relative.
	self assert: absolute isAbsolute.
	self assert: (absolute path at: 1) = 'plonk'.
	self assert: (absolute path at: 2) = 'griffle'.
	self assert: (absolute path at: 3) = 'zonk'.
	! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:41'!
testIsAbsolute
	self assert: (filesystem / 'plonk') isAbsolute! !

!FileReferenceTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testMakeRelative
	"self run: #testMakeRelative"

	| parent child relative |
	parent := filesystem / 'griffle'.
	child := filesystem / 'griffle' / 'plonk' / 'nurb'.
	relative := parent makeRelative: child.
	self assert: relative = (Path * 'plonk' / 'nurb')! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 6/23/2012 00:19'!
testWriteStreamDoExists
	| ref s path |
	path := Path * 'plonk'.
	filesystem store createFile: path.
	ref := filesystem referenceTo: path.
	ref
		writeStreamDo: [ :stream | 
			s := stream.
			self deny: stream isNil ].! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:42'!
testCommaAddsExtensionAgain
	| ref result |
	ref := filesystem * 'plonk.griffle'.
	result := ref, 'nurp'.
	self assert: result basename = 'plonk.griffle.nurp'! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:46'!
testSiblingOfReference
	| griffle  nurb |
	griffle := filesystem / 'griffle'.
	nurb := filesystem / 'nurb'.
	self deny: (griffle isChildOf: nurb).
	self deny: (nurb isChildOf: griffle).! !

!FileReferenceTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testWriteStreamifPresentExists
	| ref pass path |
	pass := false.
	path := Path * 'plonk'.
	filesystem store createFile: path.
	ref := filesystem referenceTo: path.
	ref writeStreamIfPresent: [ pass := true ].
	self assert: pass! !

!FileReferenceTest methodsFor: 'tests' stamp: 'S 6/17/2013 13:24'!
testDeleteIfAbsent
	| flag reference |
	flag := false.
	reference := filesystem / 'plonk'.

	reference ensureCreateFile.
	reference exists ifFalse: [self error].
	reference deleteIfAbsent: [flag := true].
	self deny: flag.
	
	reference exists ifTrue: [self error].
	reference deleteIfAbsent: [flag := true].
	self assert: flag.! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:43'!
testBasename
	"self debug: #testBasename"
	
	| ref |
	
	ref := filesystem root.
	self assert: ref basename = '/'.
	
	ref := filesystem * 'plonk' / 'griffle'.
	self assert: ref basename = 'griffle'.
	
	ref := filesystem * 'plonk' / 'griffle.taz'.
	self assert: ref basename = 'griffle.taz'.! !

!FileReferenceTest methodsFor: 'running' stamp: 'EstebanLorenzano 4/2/2012 11:43'!
setUp
	filesystem := FileSystem memory.! !

!FileReferenceTest methodsFor: 'tests' stamp: 'ChristopheDemarey 6/25/2014 16:34'!
testTempFilePrefixSuffix
	| fileRef |
	fileRef := FileReference newTempFilePrefix: 'FileReference' suffix: 'Test'.
	self assert: (fileRef isKindOf: FileReference).
	self assert: fileRef exists not.! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:31'!
testWithExtentionAddsExtension
	| ref result |
	ref := filesystem * 'plonk'.
	result := ref withExtension: 'griffle'.
	self assert: result isRelative.
	self assert: result basename = 'plonk.griffle'! !

!FileReferenceTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testRelativeToPath
	| parentPath child relative |
	parentPath := Path / 'griffle'.
	child := filesystem / 'griffle' / 'plonk' / 'nurb'.
	relative := child relativeTo: parentPath.
	self assert: relative = (Path * 'plonk' / 'nurb')! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/9/2011 16:12'!
testGlob
	| ref children |
	filesystem createDirectory: '/alpha'.
	filesystem createDirectory: '/alpha/beta'.
	filesystem createDirectory: '/alpha/gamma'.
	
	ref := filesystem root.
	children := ref glob: [ :node| true].
	self assert: children size == 4. "including root"
	
	children := ref glob: [ :node| node basename size > 1].
	self assert: children size == 3. "without root"
	
	children := ref glob: [ :node| node basename = #gamma].
	self assert: children size == 1. "gamma"
	self assert: children first basename = #gamma.! !

!FileReferenceTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/12/2012 14:25'!
testChildFiles
	| childFiles |
	filesystem createDirectory: '/beta'.
	filesystem createDirectory: '/gamma'.	
	(filesystem / 'delta')
		writeStreamDo: [ :stream | stream nextPutAll: '1' ].
	(filesystem / 'epsilon')
		writeStreamDo: [ :stream | stream nextPutAll: '2' ].
	childFiles := filesystem root files.
	self assert: childFiles size = 2.
	childFiles do: [ :each | 
		self assert: each class = FileReference.
		self assert: each isFile description: 'Collection should not contain references to directories.' ]! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:49'!
testContainsReference
	| ref |
	ref := filesystem * 'griffle'.
	self assert: (ref contains: ref / 'nurp')! !

!FileReferenceTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testDoesntContainPath
	| ref |
	ref := filesystem * 'griffle'.
	self deny: (ref contains: (Path * 'nurp'))! !

!FileReferenceTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/12/2012 14:28'!
testAsReference
	| ref |
	ref := filesystem * 'plonk'.
	self assert: ref asFileReference == ref! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 6/23/2012 00:15'!
testReadStream
	| ref stream path |
	path := Path * 'plonk'.
	filesystem store createFile: path.
	ref := filesystem referenceTo: path.
	[stream := ref readStream. ] 
		ensure: [ stream ifNotNil: [ stream close ] ]! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 6/23/2012 00:18'!
testReadStreamDo
	| ref path s |
	path := Path * 'plonk'.
	filesystem store createFile: path.
	ref := filesystem referenceTo: path.
	ref
		readStreamDo: [ :stream | 
			self deny: stream isNil.
			s := stream ].! !

!FileReferenceTest methodsFor: 'tests' stamp: 'CamilloBruni 8/12/2011 15:46'!
testUnequalSize
	| a b |
	a := filesystem * 'plonk'.
	b := filesystem / 'plonk' / 'griffle'.
	self deny: a = b.! !

!FileServices commentStamp: 'TorstenBergmann 2/4/2014 20:23'!
Registered file services for specific file types!
!FileServices class methodsFor: 'removing' stamp: 'StephaneDucasse 9/9/2010 09:50'!
removeObsolete
	"FileServices removeObsolete"
	self registeredFileReaderClasses copy 
		do: [:cls| cls isObsolete ifTrue:[self unregisterFileReader: cls]]! !

!FileServices class methodsFor: 'initialize-release' stamp: 'StephaneDucasse 9/9/2010 09:49'!
initialize
	"FileServices initialize"
	Smalltalk globals allClassesDo: [ :aClass |
		(aClass class includesSelector: #fileReaderServicesForFile:suffix:)
			ifTrue: [self registerFileReader: aClass]].! !

!FileServices class methodsFor: 'testing' stamp: 'CamilloBruni 2/3/2013 17:19'!
isReaderNamedRegistered: aSymbol
	"return if a given reader class has been registered. Note that this is on purpose that the argument is
	a symbol and not a class"

	^ self registeredFileReaderClasses 
		anySatisfy: [:each | each name = aSymbol ]
! !

!FileServices class methodsFor: 'helper' stamp: 'CamilloBruni 5/4/2012 20:10'!
suffixOf: aName
	"Answer the file extension of the given file"
	^ aName
		ifNil: ['']
		ifNotNil: [  aName asFileReference extension asLowercase]! !

!FileServices class methodsFor: 'adding' stamp: 'ar 7/16/2005 17:00'!
registerFileReader: aProviderClass
	"register the given class as providing services for reading files"

	| registeredReaders |
	registeredReaders := self registeredFileReaderClasses.
	(registeredReaders includes: aProviderClass) 
			ifFalse: [ registeredReaders addLast: aProviderClass ]! !

!FileServices class methodsFor: 'accessing' stamp: 'ar 7/16/2005 17:00'!
itemsForFile: fullName
	"Answer a list of services appropriate for a file of the given full name"

	| services suffix |
	suffix := self suffixOf: fullName.
	services := OrderedCollection new.
	self registeredFileReaderClasses do: [:reader |
		reader ifNotNil: [services addAll: (reader fileReaderServicesForFile: fullName suffix: suffix)]].
	^ services! !

!FileServices class methodsFor: 'accessing' stamp: 'ar 7/16/2005 17:00'!
itemsForDirectory: aFileDirectory
	"Answer a list of services appropriate when no file is selected."

	| services |
	services := OrderedCollection new.
	self registeredFileReaderClasses do: [:reader |
		reader ifNotNil: [services addAll: (reader fileReaderServicesForDirectory: aFileDirectory) ]].
	^ services! !

!FileServices class methodsFor: 'adding' stamp: 'ar 7/16/2005 16:59'!
registeredFileReaderClasses
	FileReaderRegistry ifNil: [FileReaderRegistry := OrderedCollection new].
	^ FileReaderRegistry! !

!FileServices class methodsFor: 'removing' stamp: 'ar 7/16/2005 17:00'!
unregisterFileReader: aProviderClass
	"unregister the given class as providing services for reading files"

	self registeredFileReaderClasses remove: aProviderClass ifAbsent: [nil]! !

!FileServices class methodsFor: 'accessing' stamp: 'CamilloBruni 2/3/2013 17:20'!
allRegisteredServices
	"self allRegisteredServices"

	| allServices |
	allServices := OrderedCollection new.
	self registeredFileReaderClasses do: [:each | 
		allServices addAll: (each services)].
	^ allServices! !

!FileServices class methodsFor: 'cleanup' stamp: 'StephaneDucasse 3/9/2010 16:31'!
cleanUp
	"Remove obsolete services"

	self removeObsolete! !

!FileStream commentStamp: '<historical>'!
I represent a Stream that accesses a FilePage from a File. One use for my instance is to access larger "virtual Strings" than can be stored contiguously in main memory. I restrict the objects stored and retrieved to be Integers or Characters. An end of file pointer terminates reading; it can be extended by writing past it, or the file can be explicitly truncated.
	
To use the file system for most applications, you typically create a FileStream. This is done by sending a message to a FileDirectory (file:, oldFile:, newFile:, rename:newName:) which creates an instance of me. Accesses to the file are then done via my instance.

*** On DOS, files cannot be shortened!!  ***  To overwrite a file with a shorter one, first delete the old file (FileDirectory deleteFilePath: 'Hard Disk:aFolder:dataFolder:foo') or (aFileDirectory deleteFileNamed: 'foo').  Then write your new shorter version.!
!FileStream methodsFor: 'file accessing' stamp: 'CamilloBruni 8/1/2012 16:05'!
file
	"Answer the file for the page the receiver is streaming over."

	self subclassResponsibility! !

!FileStream methodsFor: 'positioning' stamp: 'CamilloBruni 8/1/2012 16:16'!
skip: n
	"Set the character position to n characters from the current position.
	Error if not enough characters left in the file."
 
	self subclassResponsibility! !

!FileStream methodsFor: 'file modes' stamp: 'jm 9/21/1998 12:59'!
binary
	"Set this file to binary mode."

	self subclassResponsibility
! !

!FileStream methodsFor: 'file open/close' stamp: 'jm 9/21/1998 13:02'!
close
	"Close this file."

	self subclassResponsibility
! !

!FileStream methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:31'!
next

	(position >= readLimit and: [self atEnd])
		ifTrue: [^nil]
		ifFalse: [^collection at: (position := position + 1)]! !

!FileStream methodsFor: 'positioning' stamp: 'CamilloBruni 8/1/2012 16:13'!
position: pos
	"Set the current character position in the file to pos."

	self subclassResponsibility! !

!FileStream methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:31'!
contentsOfEntireFile
	"Read all of the contents of the receiver."

	| s binary |
	self readOnly.
	binary := self isBinary.
	self reset.	"erases knowledge of whether it is binary"
	binary ifTrue: [self binary].
	s := self next: self size.
	self close.
	^s! !

!FileStream methodsFor: 'file modes' stamp: 'jm 9/21/1998 13:01'!
text
	"Set this file to text (ascii) mode."

	self ascii.
! !

!FileStream methodsFor: 'file open/close' stamp: 'jm 9/21/1998 13:04'!
reopen
	"Ensure that the receiver is open, re-open it if necessary."
	"Details: Files that were open when a snapshot occurs are no longer valid when the snapshot is resumed. This operation re-opens the file if that has happened."

	self subclassResponsibility
! !

!FileStream methodsFor: 'positioning' stamp: 'JMM 5/24/2001 22:58'!
truncate: pos
	"Truncate file to pos"

	self subclassResponsibility! !

!FileStream methodsFor: '*zinc-resource-meta-core' stamp: 'SvenVanCaekenberghe 10/25/2013 16:48'!
asZnUrl
	"Convert the receiver in a file:// ZnUrl"

	| fileUrl |
	fileUrl := ZnUrl new.
	fileUrl scheme: #file.
	self directory pathSegments do: [ :each | fileUrl addPathSegment: each ].
	fileUrl addPathSegment: self localName.
	^ fileUrl! !

!FileStream methodsFor: 'printing' stamp: ''!
printOn: aStream

	super printOn: aStream.
	aStream nextPutAll: ' on '.
	self file printOn: aStream! !

!FileStream methodsFor: 'accessing' stamp: 'CamilloBruni 5/23/2012 16:55'!
mimeTypes
	^ self name asFileReference mimeTypes.! !

!FileStream methodsFor: 'accessing' stamp: ''!
nextPutAll: aCollection
	"1/31/96 sw: made subclass responsibility"

	self subclassResponsibility! !

!FileStream methodsFor: 'printing' stamp: 'tk 12/5/2001 09:12'!
longPrintOn: aStream
	"Do nothing, so it will print short.  Called to print the error file.  If the error was in a file operation, we can't read the contents of that file.  Just print its name instead."
! !

!FileStream methodsFor: 'file modes' stamp: 'jm 9/21/1998 13:00'!
readWrite
	"Set this file's mode to read-write."

	self subclassResponsibility
! !

!FileStream methodsFor: 'positioning' stamp: 'CamilloBruni 8/1/2012 16:16'!
setToEnd
	"Set the current character position to the end of the File. The same as
	self position: self size."

	self subclassResponsibility! !

!FileStream methodsFor: 'file modes' stamp: 'jm 9/21/1998 13:01'!
ascii
	"Set this file to ascii (text) mode."

	self subclassResponsibility
! !

!FileStream methodsFor: '*System-Changes' stamp: 'StephaneDucasse 3/23/2010 22:42'!
fileIntoNewChangeSet
	"File all of my contents into a new change set." 

	self readOnly.
	ChangeSet newChangesFromStream: self named: (self localName)
! !

!FileStream methodsFor: '*Compression' stamp: 'MarcusDenker 1/19/2011 15:43'!
viewGZipContents
       "View the contents of a gzipped file"

       | stringContents |
       self binary.
       stringContents := self contentsOfEntireFile.
       stringContents := Cursor wait showWhile: [(GZipReadStream on: stringContents) upToEnd].
       stringContents := stringContents asString withSqueakLineEndings.

       UIManager default
               edit: stringContents
               label: 'Decompressed contents of: ', self localName! !

!FileStream methodsFor: 'accessing' stamp: 'CamilloBruni 8/1/2012 16:16'!
size
	"Answer the size of the file in characters."

	self subclassResponsibility! !

!FileStream methodsFor: 'file accessing' stamp: 'CamilloBruni 5/7/2012 02:09'!
localName

	^ self name asFileReference basename
! !

!FileStream methodsFor: 'testing' stamp: 'CamilloBruni 8/1/2012 16:00'!
atEnd
	"Answer true if the current position is >= the end of file position."

	self subclassResponsibility! !

!FileStream methodsFor: 'accessing' stamp: ''!
nextPut: aByte
	"1/31/96 sw: subclassResponsibility"

	self subclassResponsibility! !

!FileStream methodsFor: '*Tool-FileList' stamp: 'IgorStasenko 3/6/2011 18:52'!
edit
	"Create and schedule an editor on this file."

	Smalltalk tools fileList openEditorOn: self editString: nil.
! !

!FileStream methodsFor: 'accessing' stamp: 'abc 5/11/2012 23:29'!
directoryEntry
	^(self directory / self localName) entry! !

!FileStream methodsFor: 'positioning' stamp: 'CamilloBruni 8/1/2012 16:15'!
reset
	"Set the current character position to the beginning of the file."

	self subclassResponsibility! !

!FileStream methodsFor: 'accessing' stamp: 'nice 11/22/2009 18:11'!
next: anInteger

	| newCollection howManyRead increment |
	newCollection := self collectionSpecies new: anInteger.
	howManyRead := 0.
	[howManyRead < anInteger] whileTrue:
		[self atEnd ifTrue:
			[(howManyRead + 1) to: anInteger do: [:i | newCollection at: i put: (self next)].
			^newCollection].
		increment := (readLimit - position) min: (anInteger - howManyRead).
		newCollection replaceFrom: (howManyRead + 1)
			to: (howManyRead := howManyRead + increment)
			with: collection
			startingAt: (position + 1).
		position := position + increment].
	^newCollection! !

!FileStream methodsFor: '*Network-Url' stamp: 'fbs 2/2/2005 13:23'!
url
	"Convert my path into a file:// type url String."
	
	^self asUrl asString! !

!FileStream methodsFor: '*Network-Url' stamp: 'SvenVanCaekenberghe 10/25/2013 17:04'!
asUrl
	^ self asZnUrl ! !

!FileStream methodsFor: 'file modes' stamp: 'mir 8/24/2004 17:58'!
readOnlyStream
	^self readOnly! !

!FileStream methodsFor: 'printing' stamp: 'tk 12/5/2001 09:32'!
longPrintOn: aStream limitedTo: sizeLimit indent: indent

	"Do nothing, so it will print short.  Called to print the error file.  If the error was in a file operation, we can't read the contents of that file.  Just print its name instead."

	aStream cr! !

!FileStream methodsFor: 'positioning' stamp: 'CamilloBruni 8/1/2012 16:12'!
position
	"Answer the current character position in the file."

	self subclassResponsibility! !

!FileStream methodsFor: 'file open/close' stamp: 'jm 9/21/1998 13:03'!
flush
	"When writing, flush the current buffer out to disk."

	self subclassResponsibility
! !

!FileStream methodsFor: '*codeimport' stamp: 'GuillermoPolito 5/5/2012 19:34'!
fileIn
	"Guarantee that the receiver is readOnly before fileIn for efficiency and
	to eliminate remote sharing conflicts."

	self readOnly.
	CodeImporter evaluateFileStream: self.! !

!FileStream methodsFor: 'file modes' stamp: 'jm 9/21/1998 12:59'!
readOnly
	"Set this file's mode to read-only."

	self subclassResponsibility
! !

!FileStream methodsFor: 'converting' stamp: 'tk 2/4/2000 09:16'!
asBinaryOrTextStream
	"I can switch between binary and text data"

	^ self! !

!FileStream methodsFor: 'file accessing' stamp: 'CamilloBruni 8/1/2012 16:11'!
name
	"Answer the name of the file for the page the receiver is streaming over."

	self subclassResponsibility! !

!FileStream methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:31'!
contents
	"Return the contents of the receiver. Do not close or otherwise touch the receiver. Return data in whatever mode the receiver is in (e.g., binary or text)."
	| s savePos |
	savePos := self position.
	self position: 0.
	s := self next: self size.
	self position: savePos.
	^s! !

!FileStream methodsFor: 'file open/close' stamp: 'jm 9/21/1998 13:02'!
closed
	"Answer true if this file is closed."

	self subclassResponsibility
! !

!FileStream class methodsFor: 'instance creation' stamp: 'CamilloBruni 5/4/2012 21:11'!
fullName: fileName
	^ fileName asFileReference fullName ! !

!FileStream class methodsFor: 'file reader services' stamp: 'stephaneducasse 2/4/2006 20:32'!
removeLineFeeds: fullName
	| fileContents |
	fileContents := ((FileStream readOnlyFileNamed: fullName) wantsLineEndConversion: true) contentsOfEntireFile.
	(FileStream newFileNamed: fullName) 
		nextPutAll: fileContents;
		close.! !

!FileStream class methodsFor: 'instance creation' stamp: 'VeronicaUquillas 6/11/2010 14:52'!
oldFileNamed: fileName do: aBlock
	"Returns the result of aBlock."
	
	^ self detectFile: [ self oldFileNamed: fileName ] do: aBlock! !

!FileStream class methodsFor: 'instance creation' stamp: ''!
newFileNamed: fileName 
	^ self concreteStream newFileNamed: (self fullName: fileName)! !

!FileStream class methodsFor: 'concrete classes' stamp: 'yo 7/5/2004 20:18'!
concreteStream
	"Who should we really direct class queries to?  "
	^ MultiByteFileStream.
! !

!FileStream class methodsFor: '*Tool-FileList' stamp: 'tbn 8/11/2010 10:33'!
serviceRemoveLineFeeds
	"Answer a service for removing linefeeds from a file"

	^ FileModifyingSimpleServiceEntry
		provider: self 
		label: 'Remove line feeds'
		selector: #removeLineFeeds:	
		description: 'Remove line feeds in file'
		buttonLabel: 'Remove lfs'! !

!FileStream class methodsFor: 'instance creation' stamp: 'tpr 10/16/2001 12:49'!
forceNewFileNamed: fileName
 	"Create a new file with the given name, and answer a stream opened for writing on that file. If the file already exists, delete it without asking before creating the new file."

	^self concreteStream forceNewFileNamed: fileName! !

!FileStream class methodsFor: '*Tool-FileList' stamp: 'sd 2/1/2002 22:28'!
services

	^ Array 
			with: self serviceRemoveLineFeeds
			with: self serviceFileIn
	! !

!FileStream class methodsFor: 'initialize-release' stamp: 'CamilloBruni 5/9/2012 12:07'!
initialize
	TheStdioHandles := Array new: 3.
	
	"original comment was: the intent being before: AutoStart"
	Smalltalk
		addToStartUpList: self after: DiskStore; 
		addToShutDownList: self after: DiskStore! !

!FileStream class methodsFor: 'instance creation' stamp: 'VeronicaUquillas 6/11/2010 14:52'!
fileNamed: fileName do: aBlock
	"Returns the result of aBlock."
	
	^ self detectFile: [ self fileNamed: fileName ] do: aBlock! !

!FileStream class methodsFor: 'instance creation' stamp: ''!
readOnlyFileNamed: fileName 
	^ self concreteStream readOnlyFileNamed: (self fullName: fileName)! !

!FileStream class methodsFor: '*FileSystem-Core' stamp: 'abc 5/11/2012 23:23'!
onHandle: aFileSystemHandle
	^ self concreteStream new
		open: aFileSystemHandle fullName
		forWrite: aFileSystemHandle isWritable! !

!FileStream class methodsFor: 'stdio' stamp: 'StephaneDucasse 5/18/2011 23:19'!
stdioHandles
	<primitive: 'primitiveFileStdioHandles' module: 'FilePlugin' error: ec>
	self primitiveFailed! !

!FileStream class methodsFor: 'file reader services' stamp: 'MarcusDenker 2/14/2010 09:35'!
sourceFileSuffixes

	^#('st' 'cs')

! !

!FileStream class methodsFor: 'initialize-release' stamp: 'GabrielOmarCotelli 6/4/2009 20:36'!
unload

	FileServices unregisterFileReader: self ! !

!FileStream class methodsFor: 'stdio' stamp: 'StephaneDucasse 5/18/2011 23:13'!
flushAndVoidStdioFiles

	StdioFiles ifNotNil: [
		StdioFiles do: [ :file |
			file ifNotNil: [ 
				file isReadOnly ifFalse: [
					[ file flush ]
						on: Error
						do: [ :ex | "care less" ] ] ] ].
		self voidStdioFiles ]! !

!FileStream class methodsFor: 'dnd requests' stamp: 'VeronicaUquillas 6/11/2010 14:52'!
requestDropStream: dropIndex
	"Request a read-only stream for some file that was dropped onto the application"
	^self concreteStream new requestDropStream: dropIndex.! !

!FileStream class methodsFor: 'file reader services' stamp: 'MarcusDenker 7/4/2014 11:00'!
isSourceFileSuffix: suffix

	^ self sourceFileSuffixes includes: suffix
! !

!FileStream class methodsFor: 'system startup' stamp: 'MarcusDenker 7/4/2014 10:58'!
startUp: resuming
	resuming
		ifFalse: [ ^ self ].
	self voidStdioFiles.
	[ TheStdioHandles := self stdioHandles ]
		on: Error
		do: [ :ex | 
			TheStdioHandles isArray
				ifFalse: [ TheStdioHandles := Array new: 3 ] ]! !

!FileStream class methodsFor: 'file reader services' stamp: 'AlejandroInfante 11/11/2013 14:54'!
fileIn: fullName
	"File in the entire contents of the file specified by the name provided"

	| ff fn |
	fullName ifNil: [^ self inform: 'Filename is nil.'].
	fn := fullName asFileReference.
	fn := (Smalltalk hasClassNamed: #GZipReadStream) 
		ifTrue: [(Smalltalk classNamed:  #GZipReadStream) uncompressedFileName: fn fullName]
		ifFalse: [fn fullName].
	ff := self readOnlyFileNamed: fn.
	ff fileIn.
! !

!FileStream class methodsFor: '*Tool-FileList' stamp: 'CamilloBruni 2/3/2013 17:21'!
fileReaderServicesForFile: fullName suffix: suffix
	<fileService>
	"Answer services for the given file"

	^ ((self isSourceFileSuffix: suffix) or: [ suffix = '*' ])
		ifTrue:
			[{self serviceRemoveLineFeeds.
			self serviceFileIn}]
		ifFalse:
			[#()]! !

!FileStream class methodsFor: 'instance creation' stamp: ''!
oldFileNamed: fileName 
	^ self concreteStream oldFileNamed: (self fullName: fileName)! !

!FileStream class methodsFor: 'stdio' stamp: 'SeanDeNigris 5/3/2012 22:37'!
stdin

	^Stdin ifNil: [
		Stdin := self standardIOStreamNamed: #stdin forWrite: false.
		Stdin
			disableReadBuffering;
			yourself ].! !

!FileStream class methodsFor: 'instance creation' stamp: 'VeronicaUquillas 6/11/2010 14:52'!
newFileNamed: fileName do: aBlock
	"Returns the result of aBlock."
	
	^ self detectFile: [ self newFileNamed: fileName ] do: aBlock! !

!FileStream class methodsFor: 'instance creation' stamp: 'StephaneDucasse 2/2/2010 21:46'!
readOnlyFileNamed: fileName do: aBlock
	"Open the existing file with the given name for read-only access and pass it as argument to aBlock.
	Returns the result of aBlock."
	
	^ self detectFile: [ self readOnlyFileNamed: fileName ] do: aBlock! !

!FileStream class methodsFor: 'instance creation' stamp: 'TPR 8/26/1999 10:49'!
isAFileNamed: fName
	"return whether a file exists with the given name"
	^self concreteStream isAFileNamed: (self fullName: fName)! !

!FileStream class methodsFor: 'stdio' stamp: 'StephaneDucasse 5/18/2011 23:20'!
voidStdioFiles

	 Stdin := Stdout := Stderr := StdioFiles := nil! !

!FileStream class methodsFor: 'stdio' stamp: 'cami 7/22/2013 18:26'!
standardIOStreamNamed: moniker forWrite: forWrite
	"Create if necessary and store default stdin, stdout and other files based on the their names"
	
	| index |
	
	self flag: #todo. "This is an ugly hack, while waiting for a real fix for windows. There  several problems with this approach, but it allow us to run tests, etc."
	Smalltalk os isWin32 
		ifTrue: [ 
			[ ^ MultiByteFileStream forceNewFileNamed: moniker asString ]
			on: CannotDeleteFileException do: [
				"HACK: if the image is opened a second time windows barks about the already opened locked file"
				^ MultiByteFileStream forceNewFileNamed: moniker asString, '_', (Random new nextInt: SmallInteger maxVal) asString   ]]. 	
	
	index := #(stdin stdout stderr) identityIndexOf: moniker.
	^((StdioFiles ifNil: [ StdioFiles := Array new: 3 ]) at: index)
		ifNil: [
			StdioFiles
				at: index 
				put: (
					(TheStdioHandles at: index)
						ifNil: [ ^self error: moniker, ' is unavailable' ]
						ifNotNil: [ :handle |
							MultiByteFileStream newForStdio
								openOnHandle: handle
								name: moniker
								forWrite: forWrite ]) ]
! !

!FileStream class methodsFor: 'instance creation' stamp: 'StephaneDucasse 8/21/2010 22:50'!
oldFileOrNoneNamed: fileName
	"If the file exists, answer a read-only FileStream on it. If it doesn't, answer nil."

	| fullName |
	fullName := self fullName: fileName.
	^ (self concreteStream isAFileNamed: fullName)
		ifTrue: [ self concreteStream readOnlyFileNamed: fullName]
		ifFalse: [ nil].
! !

!FileStream class methodsFor: 'instance creation' stamp: 'StephaneDucasse 8/3/2010 18:23'!
detectFile: aBlock do: anotherBlock

	^aBlock value
		ifNil: [nil]
      	ifNotNil: [:file| [anotherBlock value: file] ensure: [file close]]! !

!FileStream class methodsFor: 'utils' stamp: 'stephane.ducasse 7/10/2009 16:30'!
convertCRtoLF: fileName
	"Convert the given file to LF line endings. Put the result in a file with the extention '.lf'"

	| in out c justPutCR |
	in := (self readOnlyFileNamed: fileName) binary.
	out :=  (self newFileNamed: fileName, '.lf') binary.
	justPutCR := false.
	[in atEnd] whileFalse: [
		c := in next.
		c = 10
			ifTrue: [
				out nextPut: 13.
				justPutCR := true]
			ifFalse: [
				(justPutCR and: [c = 10]) ifFalse: [out nextPut: c].
				justPutCR := false]].
	in close.
	out close.
! !

!FileStream class methodsFor: 'stdio' stamp: 'StephaneDucasse 5/18/2011 23:15'!
newForStdio
	"This is a hook for subclasses to initialize themselves properly."

	^self new! !

!FileStream class methodsFor: 'file reader services' stamp: 'BenComan 3/4/2014 22:57'!
writeSourceCodeFrom: aStream baseName: baseName isSt: stOrCsFlag

	| extension converter fileName  |
	[ 	extension :=  stOrCsFlag ifTrue: ['.st']  ifFalse: ['.cs'].
		converter := aStream contents isAsciiString 
			ifTrue: [MacRomanTextConverter new] 
			ifFalse: [UTF8TextConverter new].
		fileName := baseName, extension.
		fileName := FileSystem disk checkName: fileName fixErrors: true.
		[FileStream newFileNamed: fileName do: [:fileStream |
			fileName := fileStream name. "in case it is changed when handling FileExistsException"
			(converter isMemberOf: UTF8TextConverter)
				ifTrue: [fileStream binary.
						UTF8TextConverter writeBOMOn: fileStream].
			fileStream
				text;
				converter: converter;
				nextPutAll: aStream contents;
				close]] on: Abort do: [:e | ^self ]
	] on: Error do: 
	[ 	:error | 
		error isResumable 
			ifTrue: [ error resumeUnchecked: error defaultAction]
			ifFalse: [ error pass ]
	].
	self inform: 'Filed out to: ', String cr, fileName.! !

!FileStream class methodsFor: '*Tool-FileList' stamp: 'tbn 8/11/2010 10:18'!
serviceFileIn
	"Answer a service for filing in an entire file"

	^ SimpleServiceEntry 
		provider: self 
		label: 'FileIn entire file'
		selector: #fileIn:
		description: 'File in the entire contents of the file, which is expected to contain Smalltalk code in fileout ("chunk") format'
		buttonLabel: 'Filein'! !

!FileStream class methodsFor: 'instance creation' stamp: 'di 2/15/98 14:03'!
new
	^ self basicNew! !

!FileStream class methodsFor: 'system startup' stamp: 'StephaneDucasse 5/18/2011 23:15'!
shutDown: quitting

	quitting ifTrue: [ self flushAndVoidStdioFiles ]! !

!FileStream class methodsFor: 'instance creation' stamp: 'VeronicaUquillas 6/11/2010 14:52'!
forceNewFileNamed: fileName do: aBlock
	"Returns the result of aBlock."
	
	^ self detectFile: [ self forceNewFileNamed: fileName ] do: aBlock! !

!FileStream class methodsFor: 'instance creation' stamp: ''!
fileNamed: fileName 
	^ self concreteStream fileNamed: (self fullName: fileName)! !

!FileStream class methodsFor: 'stdio' stamp: 'StephaneDucasse 5/18/2011 23:19'!
stderr

	^Stderr ifNil: [ Stderr := self standardIOStreamNamed: #stderr forWrite: true ]! !

!FileStream class methodsFor: 'stdio' stamp: 'StephaneDucasse 5/18/2011 23:20'!
stdout

	^Stdout ifNil: [ Stdout := self standardIOStreamNamed: #stdout forWrite: true ]! !

!FileStreamException commentStamp: 'TorstenBergmann 2/3/2014 23:36'!
Common superclass for exceptions while using file streams!
!FileStreamException methodsFor: 'exceptiondescription' stamp: 'mir 2/23/2000 20:14'!
messageText
	
	"Return an exception's message text."

	^messageText == nil
		ifTrue: [fileName printString]
		ifFalse: [messageText]! !

!FileStreamException methodsFor: 'exceptionbuilder' stamp: 'mir 2/23/2000 20:13'!
fileName: aFileName
	fileName := aFileName! !

!FileStreamException methodsFor: 'exceptiondescription' stamp: 'mir 2/25/2000 17:29'!
fileName
	^fileName! !

!FileStreamException methodsFor: 'exceptiondescription' stamp: 'mir 2/23/2000 20:13'!
isResumable
	"Determine whether an exception is resumable."

	^true! !

!FileStreamException class methodsFor: 'exceptioninstantiator' stamp: 'mir 2/23/2000 20:12'!
fileName: aFileName
	^self new fileName: aFileName! !

!FileStreamTest methodsFor: 'testing' stamp: 'HenrikSperreJohansen 3/15/2010 22:34'!
testReadIntoStartingAtCountBufferedAll
	"Tests for correct count and contents when all could be read, some pre-buffered"
	self doTestsForReading: 5000 
		intoBufferWithSize: 6000 
		startingAt: 500 
		fromFileOfSize: 6000 
		offsetBy: 200.! !

!FileStreamTest methodsFor: 'testing' stamp: 'VincentBlondeau 3/6/2015 17:45'!
testFileTruncation
	"Ensure that nextChunkPut:/nextChunk works properly on a caching file"

	"self debug: #testFileTruncation"

	| file |
	file := 'TruncationTest.txt' asFileReference.
	[ 
	file writeStreamDo: [ :s | s nextPutAll: '1234567890' ].
	file
		writeStreamDo: [ :s | 
			self assert: s contents equals: '1234567890'.
			s truncate: 4 ].
	file readStreamDo: [ :s | self assert: s contents equals: '1234' ] ]
		ensure: [ file ensureDelete ]! !

!FileStreamTest methodsFor: 'testing' stamp: 'CamilloBruni 7/10/2013 17:23'!
testCachingNextChunkPut
	"Ensure that nextChunkPut:/nextChunk works properly on a caching file"
	| file text read filename |
	filename := 'testCachingNextChunkPut'.
	[file := FileStream forceNewFileNamed: filename.
	text := 'this is a chunkful of text'.
	file nextChunkPut: text.
	read := [file position: 0; nextChunkText] valueWithin: 1 seconds onTimeout:[''].
	self assert: read = text.
	] ensure:[
		file close. 
		(FileSystem disk workingDirectory / filename) ensureDelete ].! !

!FileStreamTest methodsFor: 'testing' stamp: 'HenrikSperreJohansen 3/15/2010 22:27'!
testReadIntoStartingAtCountNotAll
	
	"Tests for correct count and contents when not all could be read, and none pre-buffered"
	self doTestsForReading: 500 
		intoBufferWithSize: 800 
		startingAt: 10 
		fromFileOfSize: 300 
		offsetBy: 0.! !

!FileStreamTest methodsFor: 'testing' stamp: 'CamilloBruni 7/10/2013 15:24'!
testNextChunkOutOfBounds
	"self debug: #testNextChunkOutOfBounds"
	
	"Ensure that nextChunkPut:/nextChunk works properly on a caching file"
	| file text read filename |
	filename := 'testNextChunkOutOfBounds'.
	[file := FileStream forceNewFileNamed: filename.
	text := 'this is a chunkful of text'.
	file nextChunkPut: text.
	read := [file position: 999999; nextChunkText] valueWithin: 1 seconds onTimeout:[nil].
	self assert: read = ''.
	] ensure: [ 
		file close.
		(FileSystem disk workingDirectory / filename) ensureDelete ].! !

!FileStreamTest methodsFor: 'testing' stamp: 'HenrikSperreJohansen 3/15/2010 22:29'!
testReadIntoStartingAtCountAll
	"Tests for correct count and contents when all could be read, none pre-buffered"
	self doTestsForReading: 100 
		intoBufferWithSize: 400 
		startingAt: 100 
		fromFileOfSize: 200 
		offsetBy: 0.
	! !

!FileStreamTest methodsFor: 'testing' stamp: 'HenrikSperreJohansen 3/15/2010 22:48'!
testReadIntoStartingAtCountBufferedNotAll
	"Tests for correct count and contents when all could be read, some pre-buffered"
	self doTestsForReading: 8000 
		intoBufferWithSize: 10000 
		startingAt: 500 
		fromFileOfSize: 6000 
		offsetBy: 200.! !

!FileStreamTest methodsFor: 'private' stamp: 'S 6/17/2013 13:16'!
doTestsForReading: count intoBufferWithSize: readSize startingAt: startIndex fromFileOfSize: writeSize offsetBy: startOffset
	"Do the actual assertions for read/write buffers with the given parameters
	
	If offset > 0, some elements will be fetched from buffer.
	If count > writeSize - startOffset, not all will be successfully read."
	
 	| file  filename |
	filename :=  'filestream.tst'.
	[ |writeBuffer  readBuffer bytesRead|
	writeBuffer := (ByteArray new: writeSize).
	0 to: writeSize -1 do: [:ix | writeBuffer at: ix +1 put: (ix \\ 255) + 1].

	(StandardFileStream forceNewFileNamed: filename)
		 binary ;
		 nextPutAll: writeBuffer ;
		 close.
	file := StandardFileStream readOnlyFileNamed: filename.
	
	readBuffer := ByteArray new: readSize.

	startOffset > 0 ifTrue: [file next: startOffset].
	bytesRead := file
		readInto: readBuffer
		startingAt: startIndex
		count: count.
	"Test the count is correct, ie. either read count, or the remaining bytes in write buffer"
	self assert: ((writeSize - startOffset) min: count) equals: bytesRead.
	
	"quick test for total not written"
	self assert: readSize - bytesRead equals: (readBuffer occurrencesOf: 0).
	
	"compare test for readStream and what was in write"
	1 to: readSize do:
		[ : n | |expected|
		expected := 
			(n between: startIndex and: startIndex + bytesRead -1)
				ifTrue: [ (writeBuffer at: startOffset + n - startIndex +1) ]
				ifFalse: [ 0 ].	
		self assert: expected equals: (readBuffer at: n)  ] ]
	ensure: [ 
		file ifNotNil: [ file close ].
		(FileSystem disk workingDirectory / filename) ensureDelete ]! !

!FileStreamTest methodsFor: 'testing' stamp: 'Anonymous 6/17/2013 13:16'!
testNextLine
	| filename lines text |
	filename := 'filestream.tst'.
	lines := #('line 1' ' and line 2' '' 'fourth').
	text := lines first , String cr , lines second , String crlf , lines third , String lf , lines fourth.
	[ 
	| file |
	(StandardFileStream forceNewFileNamed: filename)
		nextPutAll: text;
		close.
	file := StandardFileStream readOnlyFileNamed: filename.
	lines do: [ :e | self assert: file nextLine = e ].
	self assert: file nextLine isNil.
	file close ] ensure: [ 
		(FileSystem disk workingDirectory / filename) ensureDelete ].! !

!FileStreamTest methodsFor: 'testing' stamp: 'S 6/17/2013 13:16'!
testDetectFileDo
	| file |
	[ file := 'filestream.tst' asFileReference.
	file writeStreamDo: [ :s | s nextPutAll: '42' ].
	FileStream
		detectFile: [ file readStream ]
		do: [ :stream | 
			self assert: stream notNil.
			self deny: stream closed.
			self assert: stream contentsOfEntireFile = '42']]
		ensure: [
			file ensureDelete ].! !

!FileSystem commentStamp: '<historical>'!
I present a low-level protocol for interacting with filesystems. I hold a reference to
a store (a subinstance of FileSystemStore) which takes care of the details of performing 
file and directory operations on the filesystem I represent. 

I keep track of the current directory, and am responsible for resolving all paths that
I pass into my store. My store acts as a factory and offers platform specific actions.


FileSystem instances know two methods that return a Reference object: workingDirectory and root.

FileSystem disk workingDirectory
FileSystem disk root

!
!FileSystem methodsFor: 'private' stamp: 'CamilloBruni 1/20/2012 12:33'!
copyFrom: inputStream to: destPath
	| buffer out |
	out := nil.
	(self exists: destPath)
		ifTrue: [ store signalFileExists: destPath ].
	^ [ 
	out := self writeStreamOn: destPath.
	buffer := ByteArray new: 1024.
	[ inputStream atEnd ]
		whileFalse: [ 
			buffer := inputStream nextInto: buffer.
			out nextPutAll: buffer ]] ensure: [ out ifNotNil: [ out close ]]! !

!FileSystem methodsFor: 'public-enumerating' stamp: 'CamilloBruni 1/19/2012 00:31'!
childrenAt: aResolvable
	^ Array streamContents: [ :out | 
		self childrenAt: aResolvable do: [ :path|
			out nextPut: path ]].! !

!FileSystem methodsFor: 'public' stamp: 'cwp 3/29/2011 15:54'!
resolve: aResolvable
	^ aResolvable asResolvedBy: self! !

!FileSystem methodsFor: 'accessing' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
root
	"Returns the root of the receiver filesystem, i.e. / on unix"
	^ self referenceTo: Path root! !

!FileSystem methodsFor: 'public' stamp: 'CamilloBruni 9/5/2012 11:26'!
referenceTo: aResolvable 
	"Answer a reference to the argument from the context of the receiver filesystem.  	
		Example: Filesystem disk referenceTo: 'plonk.taz'"

	^ FileReference 
		fileSystem: self
		path: (self pathFromObject: aResolvable)! !

!FileSystem methodsFor: 'public-enumerating' stamp: 'CamilloBruni 7/10/2012 15:44'!
fileNamesAt: aResolvable do: aBlock
	| path |
	path := self resolve: aResolvable.
	store
		directoryAt: path
		ifAbsent: [ store signalDirectoryDoesNotExist: path ]
		fileNodesDo: [ :entry | 
			aBlock value: (store basenameFromEntry: entry) ]! !

!FileSystem methodsFor: 'public-enumerating' stamp: 'CamilloBruni 6/22/2012 21:58'!
childrenAt: aResolvable do: aBlock
	| path |
	path := self resolve: aResolvable.
	store
		directoryAt: path
		ifAbsent: [ store signalDirectoryDoesNotExist: path ]
		nodesDo: [ :entry | 
			aBlock value: path / (store basenameFromEntry: entry) ]! !

!FileSystem methodsFor: 'public-enumerating' stamp: 'CamilloBruni 7/10/2012 15:43'!
childNamesAt: aResolvable
	^ Array streamContents: [ :out | 
		self childNamesAt: aResolvable do: [ :path|
			out nextPut: path ]].! !

!FileSystem methodsFor: 'public' stamp: 'cwp 3/25/2011 13:15'!
createDirectory: aResolvable
	"Resolve aResolvable into an absolute path, then as the store to create a directory there. 
	The store is expected to raise an exception if it cannot do so."

	^ store createDirectory: (self resolve: aResolvable)! !

!FileSystem methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 2/7/2014 05:36'!
gtInspectorWorkingDirectoryItemsIn: composite
	<gtInspectorPresentationOrder: 40>
	(self workingDirectory gtInspectorItemsIn: composite)
		title: 'Working directory'! !

!FileSystem methodsFor: 'accessing' stamp: 'cwp 3/29/2011 15:57'!
workingDirectoryPath
	^ workingDirectory! !

!FileSystem methodsFor: 'public' stamp: 'S 6/17/2013 13:33'!
ensureCreateDirectory: aResolvable
	"Resolve the argument to an absolute path, then ask the store to make
	sure that all the directories contained in the argument path exist or are created."
	
	store ensureCreateDirectory: (self resolve: aResolvable)! !

!FileSystem methodsFor: 'navigating' stamp: 'cwp 3/29/2011 15:56'!
resolveString: aString
	"Returns the root of the receiver filesystem, i.e. / on unix"
	
	^ workingDirectory resolvePath: (store pathFromString: aString)! !

!FileSystem methodsFor: 'accessing' stamp: 'CamilloBruni 5/4/2012 19:14'!
workingDirectoryPath: aPath

	aPath isAbsolute 
		ifFalse: [ self error: 'Cannot set the working directory to a relative path' ].
	workingDirectory := aPath
! !

!FileSystem methodsFor: 'public' stamp: 'MaxLeske 1/25/2014 23:02'!
binaryReadStreamOn: aResolvable
	"Resolve the argument into an absolute path and open a file handle on the file
	at that path. Ask the handle to give us a read stream for reading the file."

	^ (self open: aResolvable writable: false) binaryReadStream.! !

!FileSystem methodsFor: 'delegated' stamp: 'cwp 3/25/2011 13:16'!
openFileStream: aResolvable writable: aBoolean
	^ store 
		openFileStream: (self resolve: aResolvable) 
		writable: aBoolean! !

!FileSystem methodsFor: 'public-enumerating' stamp: 'CamilloBruni 6/22/2012 17:57'!
entriesAt: aResolvable do: aBlock
	^ self 
		entriesAt: aResolvable 
		ifAbsent: [ store signalDirectoryDoesNotExist: ( self resolve: aResolvable) ]
		do: aBlock ! !

!FileSystem methodsFor: 'converting' stamp: 'cwp 11/21/2009 11:30'!
pathFromObject: anObject 
	^ anObject asPathWith: self! !

!FileSystem methodsFor: 'initialize-release' stamp: 'cwp 2/18/2011 20:33'!
initializeWithStore: aStore
	store := aStore.
	workingDirectory := store defaultWorkingDirectory! !

!FileSystem methodsFor: 'printing' stamp: 'cwp 2/28/2011 12:29'!
printPath: aPath on: aStream
	store printPath: aPath on: aStream! !

!FileSystem methodsFor: 'accessing' stamp: 'cwp 2/18/2011 16:08'!
store
	^ store! !

!FileSystem methodsFor: 'public-testing' stamp: 'StephaneDucasse 6/22/2012 17:30'!
hasChildren: aResolvable
	"Returns whether aResolvable has children."
	store directoryAt: (self resolve: aResolvable)
			ifAbsent: [ ^false ]
			nodesDo:  [ :node | ^true ].
	^false! !

!FileSystem methodsFor: 'public-enumerating' stamp: 'CamilloBruni 1/19/2012 00:32'!
directoriesAt: aResolvable
	^ Array streamContents: [ :out | 
		self directoriesAt: aResolvable do: [ :path|
			out nextPut: path ]].! !

!FileSystem methodsFor: 'accessing' stamp: 'CamilloBruni 5/7/2012 01:12'!
separator
	"Return path separator used by this filesystem."

	^ store separator! !

!FileSystem methodsFor: 'public' stamp: 'CamilloBruni 7/10/2012 20:54'!
modificationTime: aResolvable
	"Resolve the argument, and answer true if the result refers
	to a directory, false if it refers to a file or doesn't exist."

	^ store modificationTime: (self resolve: aResolvable)! !

!FileSystem methodsFor: 'public' stamp: 'CamilloBruni 7/10/2012 20:54'!
creationTime: aResolvable
	"Resolve the argument, and answer true if the result refers
	to a directory, false if it refers to a file or doesn't exist."

	^ store creationTime: (self resolve: aResolvable)! !

!FileSystem methodsFor: 'public-testing' stamp: 'CamilloBruni 7/10/2012 21:31'!
isReadable: aResolvable
	"Resolve the argument, and answer true if the there is
	a file or directory that can be read from."
	
	^ (self permissions: aResolvable) isReadable! !

!FileSystem methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 2/7/2014 05:36'!
gtInspectorRootItemsIn: composite
	<gtInspectorPresentationOrder: 40>
	(self root gtInspectorItemsIn: composite)
		title: 'Root directory'! !

!FileSystem methodsFor: 'accessing' stamp: 'StephaneDucasse 7/3/2011 16:07'!
workingDirectory
	"Returns a reference to the directory from where the image was launched"

	^ self referenceTo: self workingDirectoryPath! !

!FileSystem methodsFor: 'navigating' stamp: 'CamilloBruni 2/4/2012 19:22'!
resolvePath: aPath
	"Return a path where the argument is resolved in the context of the
	receiver. The behavior is similar to the one of a command line.
		> cd /a/b/c
		> cd b
		The shell will attempt to make /a/b/c/b the current directory. "

	^ workingDirectory resolve: aPath! !

!FileSystem methodsFor: 'public' stamp: 'EstebanLorenzano 4/3/2012 13:27'!
entryAt: aResolvable
	| path |
	path := self resolve: aResolvable.
	^ store
		nodeAt: path
		ifPresent: [ :node | store entryFromNode: node fileSystem: self path: path ]
		ifAbsent: [ store signalFileDoesNotExist: path ]! !

!FileSystem methodsFor: 'converting' stamp: 'cwp 2/18/2011 16:39'!
pathFromString: aString
	^ store pathFromString: aString! !

!FileSystem methodsFor: 'public' stamp: 'cwp 3/25/2011 19:23'!
open
	"Some kinds of filesystems need to open connections to external resources. Does nothing by default."
	
	store open! !

!FileSystem methodsFor: 'public-enumerating' stamp: 'CamilloBruni 1/19/2012 00:32'!
filesAt: aResolvable
	^ Array streamContents: [ :out | 
		self filesAt: aResolvable do: [ :path|
			out nextPut: path ]].! !

!FileSystem methodsFor: 'public' stamp: 'CamilloBruni 5/10/2012 16:01'!
checkName: aString fixErrors: fixErrors
	^ store checkName: aString fixErrors: fixErrors! !

!FileSystem methodsFor: 'public' stamp: 'EstebanLorenzano 4/3/2012 13:24'!
rename: sourcePath ifAbsent: aBlock to: destPath ifPresent: pBlock
	"Rename the file referenced as sourcePath to the destination referred as destPath. 
	Perform associate actions in case of problems."
	
	| source destination |
	source := self resolve: sourcePath.
	destination := self resolve: destPath.
	store
		rename: source
		ifAbsent: aBlock
		to: destination
		ifPresent: pBlock
		fileSystem: self.
	^ destination! !

!FileSystem methodsFor: 'public' stamp: 'cwp 3/25/2011 19:14'!
delimiter
	"Return path delimiter used by this filesystem."

	^ store delimiter! !

!FileSystem methodsFor: 'public' stamp: 'CamilloBruni 1/20/2012 13:23'!
readStreamOn: aResolvable
	"Resolve the argument into an absolute path and open a file handle on the file
	at that path. Ask the handle to give us a read stream for reading the file."

	^ (self open: aResolvable writable: false) readStream.! !

!FileSystem methodsFor: 'public-testing' stamp: 'cwp 3/25/2011 19:21'!
isDirectory: aResolvable
	"Resolve the argument, and answer true if the result refers
	to a directory, false if it refers to a file or doesn't exist."

	^ store isDirectory: (self resolve: aResolvable)! !

!FileSystem methodsFor: 'public-enumerating' stamp: 'CamilloBruni 1/19/2012 00:30'!
directoriesAt: aResolvable do: aBlock
	| path |
	path := self resolve: aResolvable.
	store
		directoryAt: path
		ifAbsent: [ store signalDirectoryDoesNotExist: path ]
		directoryNodesDo: [ :entry | 
			aBlock value: path / (store basenameFromEntry: entry) ]! !

!FileSystem methodsFor: 'public-enumerating' stamp: 'GuillermoPolito 6/22/2012 12:21'!
entriesAt: aResolvable
	^ Array
		streamContents: [ :out | 
			self entriesAt: aResolvable do: [ :entry | out nextPut: entry ]
		]! !

!FileSystem methodsFor: 'navigating' stamp: 'cwp 3/25/2011 13:04'!
/ anObject
	"Return the absolute reference obtained by resolving anObject against the
	root of this filesystem."
	
	^ self root / anObject! !

!FileSystem methodsFor: 'public-testing' stamp: 'EstebanLorenzano 8/2/2012 15:42'!
isSymlink: aResolvable
	"Resolve the argument, and answer true if the result refers
	to a directory, false if it refers to a file or doesn't exist."

	^ store isSymlink: (self resolve: aResolvable)! !

!FileSystem methodsFor: 'public-enumerating' stamp: 'CamilloBruni 7/10/2012 15:43'!
directoryNamesAt: aResolvable do: aBlock
	| path |
	path := self resolve: aResolvable.
	store
		directoryAt: path
		ifAbsent: [ store signalDirectoryDoesNotExist: path ]
		directoryNodesDo: [ :entry | 
			aBlock value: (store basenameFromEntry: entry) ]! !

!FileSystem methodsFor: 'public' stamp: 'cwp 2/19/2011 01:39'!
close
	store close! !

!FileSystem methodsFor: 'public-enumerating' stamp: 'CamilloBruni 1/19/2012 00:30'!
filesAt: aResolvable do: aBlock
	| path |
	path := self resolve: aResolvable.
	store
		directoryAt: path
		ifAbsent: [ store signalDirectoryDoesNotExist: path ]
		fileNodesDo: [ :entry | 
			aBlock value: path / (store basenameFromEntry: entry) ]! !

!FileSystem methodsFor: 'public-testing' stamp: 'CamilloBruni 5/7/2012 01:19'!
isCaseSensitive
	^ self store isCaseSensitive! !

!FileSystem methodsFor: 'converting' stamp: 'cwp 2/18/2011 12:09'!
stringFromPath: aPath
	^ store stringFromPath: aPath! !

!FileSystem methodsFor: 'public' stamp: 'CamilloBruni 1/20/2012 13:23'!
writeStreamOn: aResolvable
	"Open a write stream on the file referred by the argument. It can be a string or a path"

	^ (self open: aResolvable writable: true) writeStream.! !

!FileSystem methodsFor: 'public-testing' stamp: 'CamilloBruni 7/10/2012 21:31'!
isWritable: aResolvable
	"Resolve the argument, and answer true if the there is
	a file that can be written to or directory that can be changed."
	
	^  (self permissions: aResolvable) isWritable! !

!FileSystem methodsFor: 'public' stamp: 'SeanDeNigris 8/17/2012 09:30'!
rename: sourcePath to: destName
	"Rename the file referenced as sourcePath to destPath.  Raise exceptions 
	FileExists or FileDoesNotExist  if the operation fails"
	
	^ self
		rename: sourcePath
		ifAbsent: [store signalFileDoesNotExist: sourcePath]
		to: destName
		ifPresent: [store signalFileExists: destName]! !

!FileSystem methodsFor: '*FileSystem-Disk' stamp: 'VincentBlondeau 1/30/2015 14:54'!
isDiskFileSystem
	^ store isDiskFileSystem! !

!FileSystem methodsFor: 'accessing' stamp: 'cwp 3/29/2011 15:58'!
changeDirectory: aPath
	self workingDirectoryPath: (self resolve: aPath)! !

!FileSystem methodsFor: 'printing' stamp: 'cwp 2/18/2011 16:34'!
forReferencePrintOn: aStream
	store forReferencePrintOn: aStream! !

!FileSystem methodsFor: 'public' stamp: 'cwp 3/25/2011 13:14'!
delete: aResolvable
	store delete: (self resolve: aResolvable)! !

!FileSystem methodsFor: 'navigating' stamp: 'EstebanLorenzano 4/3/2012 13:06'!
resolveReference: aReference
	^ aReference fileSystem = self ifTrue:
		[workingDirectory resolvePath: aReference path]! !

!FileSystem methodsFor: 'public-testing' stamp: 'CamilloBruni 9/4/2013 15:30'!
hasDirectories: aResolvable
	self
		entriesAt: aResolvable
		ifAbsent: [  ^ false ]
		do: [ :entry | 
			entry isDirectory ifTrue: [ ^true ] ].
	^false! !

!FileSystem methodsFor: 'comparing' stamp: 'cwp 2/18/2011 16:08'!
hash
	^ store hash! !

!FileSystem methodsFor: 'public' stamp: 'cwp 3/25/2011 19:19'!
exists: aResolvable
	"Resolve the argument, and answer true if the there is
	a file or directory at that path, false if there is not."
	
	^ store exists: (self resolve: aResolvable)! !

!FileSystem methodsFor: 'public' stamp: 'EstebanLorenzano 4/3/2012 13:29'!
copy: sourcePath ifAbsent: absentBlock to: destinationPath ifPresent: presentBlock
	"Copy the file referenced as sourcePath to the destination referred as destPath. Perform associate actions in case of problems."

	store
		copy: (self resolve: sourcePath)
		ifAbsent: absentBlock
		to: (self resolve: destinationPath)
		ifPresent: presentBlock
		fileSystem: self! !

!FileSystem methodsFor: 'public-testing' stamp: 'CamilloBruni 6/22/2012 17:57'!
hasFiles: aResolvable
	self
		entriesAt: aResolvable
		ifAbsent: [  ^ false ]
		do: [ :entry | entry isFile ifTrue: [ ^true ] ].
	^false! !

!FileSystem methodsFor: 'public-enumerating' stamp: 'CamilloBruni 7/10/2012 15:44'!
fileNamesAt: aResolvable
	^ Array streamContents: [ :out | 
		self fileNamesAt: aResolvable do: [ :path|
			out nextPut: path ]].! !

!FileSystem methodsFor: 'private' stamp: 'CamilloBruni 9/5/2012 11:28'!
openStreamDescription: aResolvable writable: aBoolean
	"I am  a helper method to delegate basicOpen:writable: to the store.
	 I am called from FileSystemHandle implementations."
	
	| path |
	
	path := self resolve: aResolvable.
	^ store basicOpen: path writable: aBoolean! !

!FileSystem methodsFor: 'public' stamp: 'CamilloBruni 5/9/2012 13:03'!
mimeTypesAt: aResolvable
	"Return the possible mime types for the given path."
	^ store mimeTypesAt: (self resolve: aResolvable)! !

!FileSystem methodsFor: '*FileSystem-Memory' stamp: 'VincentBlondeau 1/30/2015 14:55'!
isMemoryFileSystem
	^ store isMemoryFileSystem! !

!FileSystem methodsFor: 'public-enumerating' stamp: 'CamilloBruni 6/22/2012 17:56'!
entriesAt: aResolvable ifAbsent: absentBlock do: aBlock
	| path entry aFilesystem |
	path := self resolve: aResolvable.
	aFilesystem := self.
	store
		directoryAt: path
		ifAbsent: [ ^ absentBlock value ]
		nodesDo: [ :node | 
			entry := store entryFromNode: node path: path for: aFilesystem.
			aBlock value: entry ]! !

!FileSystem methodsFor: 'public' stamp: 'cwp 4/3/2011 22:17'!
copy: sourcePath to: destPath
	"Copy the file referenced as sourcePath to the destination referred as destPath.  
	If there is no file at sourcePath, raise FileDoesNotExist.
	If destPath is a file, raise FileExists."
	
	self
		copy: sourcePath
		ifAbsent: [ store signalFileDoesNotExist: sourcePath ]
		to: destPath
		ifPresent: [ store signalFileExists: destPath ]! !

!FileSystem methodsFor: 'private' stamp: 'EstebanLorenzano 4/3/2012 13:06'!
copy: aPath toReference: destRef
	| inputStream path |
	
	path := self resolve: aPath.
	
	[
	inputStream := self readStreamOn: path.
	inputStream ifNil: [ store signalFileDoesNotExist: path ].
	destRef fileSystem copyFrom: inputStream to: destRef path 
	
		] ensure: [ inputStream ifNotNil: [ inputStream close ]]! !

!FileSystem methodsFor: 'public-enumerating' stamp: 'CamilloBruni 7/10/2012 15:48'!
directoryNamesAt: aResolvable
	^ Array streamContents: [ :out | 
		self directoryNamesAt: aResolvable do: [ :name|
			out nextPut: name ]].! !

!FileSystem methodsFor: 'comparing' stamp: 'cwp 2/18/2011 16:08'!
= other
	^ self species = other species and: [self store = other store]! !

!FileSystem methodsFor: 'public' stamp: 'CamilloBruni 7/10/2012 22:09'!
size: aResolvable
	"Resolve the argument and return the size for this file or directory "

	^ store size: (self resolve: aResolvable)! !

!FileSystem methodsFor: 'public' stamp: 'EstebanLorenzano 4/12/2012 14:25'!
open: aResolvable writable: aBoolean 
	"Resolve aResolvable into an absolute path, then ask the store to open the file at
	that path using the specified access mode."
	
	| path |
	path := self resolve: aResolvable.
	^ store handleClass 
		open: (FileReference fileSystem: self path: path) 
		writable: aBoolean
		! !

!FileSystem methodsFor: 'public' stamp: 'CamilloBruni 7/10/2012 21:31'!
permissions: aResolvable
	"Resolve the argument and return the Permissions for this file or directory "

	^ store permissions: (self resolve: aResolvable)! !

!FileSystem methodsFor: 'public-enumerating' stamp: 'CamilloBruni 7/10/2012 15:43'!
childNamesAt: aResolvable do: aBlock
	| path |
	path := self resolve: aResolvable.
	store
		directoryAt: path
		ifAbsent: [ store signalDirectoryDoesNotExist: path ]
		nodesDo: [ :entry | 
			aBlock value: (store basenameFromEntry: entry) ]! !

!FileSystem methodsFor: 'public' stamp: 'CamilloBruni 5/7/2012 01:15'!
extensionDelimiter
	^ $.! !

!FileSystem methodsFor: 'public-testing' stamp: 'CamilloBruni 6/1/2012 14:45'!
isFile: aResolvable
	"Resolve the argument, and answer true if the result refers
	to a file, false if it refers to a directory or doesn't exist."

	^ store isFile: (self resolve: aResolvable)! !

!FileSystem methodsFor: 'navigating' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
* anObject
	"Return a relative reference."
	
	^ self referenceTo:( Path * anObject)! !

!FileSystem class methodsFor: '*filesystem-disk' stamp: 'CamilloBruni 5/4/2012 20:54'!
root
	^ self disk root! !

!FileSystem class methodsFor: '*filesystem-disk' stamp: 'CamilloBruni 5/7/2012 11:57'!
lookInUsualPlaces: fileName
	"Check the default directory, the imagePath, and the vmPath (and the vmPath's owner) for this file."

	| file |
	 (file := fileName asFileReference) exists
		ifTrue: [ ^ file ].

	(file := Smalltalk imageFile resolve: fileName) exists
		ifTrue: [ ^ file ].

	(file :=  Smalltalk vmDirectory resolve: fileName) exists
		ifTrue: [ ^ file ].

	(file := Smalltalk vmDirectory parent resolve: fileName) exists
		ifTrue: [ ^ file ].

	^ nil! !

!FileSystem class methodsFor: '*filesystem-disk' stamp: 'CamilloBruni 5/4/2012 20:53'!
workingDirectory
	^ self disk workingDirectory! !

!FileSystem class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 3/26/2015 00:11'!
gtExampleZip
	<gtExample: 'Zip file system'>
	| zipFile zip |
	zipFile := FileSystem memory workingDirectory / 'test.zip'.
	zip := (FileSystem zip: zipFile) open.
	zip / 'sample.txt'
		writeStreamDo: [ :stream |
				stream nextPutAll: self comment ];
			yourself.
	^ zip! !

!FileSystem class methodsFor: '*filesystem-disk' stamp: 'EstebanLorenzano 4/3/2012 11:30'!
disk
	"Answer a filesystem that represents the 'on-disk' filesystem used by the host operating system."

	^ DiskStore currentFileSystem! !

!FileSystem class methodsFor: '*filesystem-disk' stamp: 'CamilloBruni 5/4/2012 19:19'!
* aFileOrDirectoryName
	^ self disk * aFileOrDirectoryName! !

!FileSystem class methodsFor: '*filesystem-zip' stamp: 'EstebanLorenzano 4/3/2012 17:20'!
zip: aReference
	^ self store: (ZipStore reference: aReference)! !

!FileSystem class methodsFor: 'instance creation' stamp: 'cwp 2/18/2011 20:34'!
store: aStore
	^ self basicNew
		initializeWithStore: aStore;
		yourself! !

!FileSystem class methodsFor: '*filesystem-memory' stamp: 'EstebanLorenzano 4/3/2012 09:36'!
memory
	^ self store: (MemoryStore new)! !

!FileSystem class methodsFor: 'initializing' stamp: 'EstebanLorenzano 4/3/2012 13:13'!
startUp: aBoolean
	"This is only here to deal with migration from older versions of
	FileSystem that wanted to receive startup notifcations."
	
	Smalltalk removeFromStartUpList: self! !

!FileSystem class methodsFor: '*filesystem-disk' stamp: 'CamilloBruni 5/4/2012 19:19'!
/ aFileOrDirectoryName
	^ self disk / aFileOrDirectoryName! !

!FileSystemDirectoryEntry commentStamp: 'cwp 11/18/2009 11:09'!
I am a cache for metadata about a file or directory. The information I hold is as follows:

reference
	A reference to the file or directory to which my data pertains.
	
creation
	The creation date and time, stored as number seconds since the 
	Smalltalk epoch.
	
modification
	The modification date and time, number seconds since the Smalltalk epoch.
	
isDirectory 
	True if my data pertains to a directory, false if a file.
	
size
	Size in bytes for a file, 0 for a directory.
!
!FileSystemDirectoryEntry methodsFor: 'delegate' stamp: 'CamilloBruni 8/15/2011 17:02'!
extension
	^ reference extension! !

!FileSystemDirectoryEntry methodsFor: 'accessing' stamp: 'StephaneDucasse 1/27/2011 22:15'!
size
	"Returns the receiver size"
	^ size! !

!FileSystemDirectoryEntry methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 21:20'!
creationTime
	"Return the creation date and time of the entry receiver."
	
	^ creation! !

!FileSystemDirectoryEntry methodsFor: 'initialize-release' stamp: 'EstebanLorenzano 8/2/2012 15:33'!
initializeWithRef: ref 
	creation: cTime 
	modification: mTime 
	isDir: directoryBoolean
	size: bytes 
	posixPermissions: posixNumber 
	isSymlink: symlinkBoolean
	
	reference := ref.
	creation := cTime.
	modification := mTime.
	isDirectory := directoryBoolean.
	size := bytes.
	posixPermissions := posixNumber.
	isSymlink := symlinkBoolean.! !

!FileSystemDirectoryEntry methodsFor: 'testing' stamp: 'EstebanLorenzano 8/2/2012 15:32'!
isSymlink 
	^isSymlink! !

!FileSystemDirectoryEntry methodsFor: 'delegate' stamp: 'CamilloBruni 8/12/2011 20:33'!
fullName
	^ reference fullName! !

!FileSystemDirectoryEntry methodsFor: 'testing' stamp: 'StephaneDucasse 1/27/2011 22:16'!
isDirectory
	"Return whether the receiver is a directory"
	
	^ isDirectory! !

!FileSystemDirectoryEntry methodsFor: 'delegate' stamp: 'CamilloBruni 8/12/2011 20:32'!
readStream
	^ reference readStream! !

!FileSystemDirectoryEntry methodsFor: 'converting' stamp: 'EstebanLorenzano 4/12/2012 14:28'!
asFileReference
	^ reference! !

!FileSystemDirectoryEntry methodsFor: 'accessing' stamp: 'abc 5/11/2012 23:31'!
creation
	^ self creationTime ! !

!FileSystemDirectoryEntry methodsFor: 'accessing' stamp: 'StephaneDucasse 1/27/2011 22:15'!
modificationSeconds
	"Return the modification date and time of the entry receiver in seconds."
	^ modification! !

!FileSystemDirectoryEntry methodsFor: 'accessing' stamp: 'EstebanLorenzano 7/3/2012 11:29'!
permissions 
	^self posixPermissions
		ifNotNil: [ FileSystemPermission posixPermissions: self posixPermissions ]! !

!FileSystemDirectoryEntry methodsFor: 'delegate' stamp: 'CamilloBruni 8/12/2011 20:33'!
writeStream
	^ reference writeStream! !

!FileSystemDirectoryEntry methodsFor: 'accessing' stamp: 'abc 5/11/2012 23:30'!
modification
	^ self modificationTime ! !

!FileSystemDirectoryEntry methodsFor: 'printing' stamp: 'MarcusDenker 12/2/2013 14:06'!
printOn: aStream

	aStream nextPutAll: 'DirectoryEntry: '.
	reference ifNotNil: [:ref | aStream nextPutAll: reference printString].! !

!FileSystemDirectoryEntry methodsFor: 'testing' stamp: 'StephaneDucasse 1/27/2011 22:16'!
isFile
	"Return whether the receiver is a file"
	
	^ isDirectory not! !

!FileSystemDirectoryEntry methodsFor: 'delegate' stamp: 'CamilloBruni 8/12/2011 20:56'!
pathSegments
	^ reference pathSegments! !

!FileSystemDirectoryEntry methodsFor: 'accessing' stamp: 'cwp 11/15/2009 21:54'!
reference
	^ reference! !

!FileSystemDirectoryEntry methodsFor: '*monticellofiletree-filesystem-utilities' stamp: 'dkh 8/10/2012 09:06'!
readStreamDo: aBlock
    ^ reference readStreamDo: aBlock! !

!FileSystemDirectoryEntry methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2010 17:59'!
basename

	^ reference basename! !

!FileSystemDirectoryEntry methodsFor: '*monticellofiletree-filesystem-utilities' stamp: 'dkh 8/10/2012 09:04'!
name
    ^ self basename! !

!FileSystemDirectoryEntry methodsFor: 'accessing' stamp: 'EstebanLorenzano 6/22/2012 14:54'!
posixPermissions 
	^posixPermissions! !

!FileSystemDirectoryEntry methodsFor: 'accessing' stamp: 'StephaneDucasse 8/3/2012 22:14'!
creationSeconds
	"Return the creation date and time of the entry receiver in seconds."
		
	^ creation asSeconds! !

!FileSystemDirectoryEntry methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 21:20'!
modificationTime
	"Return the modification date and time of the entry receiver."

	^  modification! !

!FileSystemDirectoryEntry class methodsFor: 'accessing' stamp: 'EstebanLorenzano 6/22/2012 14:52'!
allPosixPermissions 
	^8r777! !

!FileSystemDirectoryEntry class methodsFor: 'instance creation' stamp: 'EstebanLorenzano 8/2/2012 15:37'!
fileSystem: aFilesystem path: aPath creation: cTime modification: mTime isDir: aBoolean size: anInteger posixPermissions: posixNumber isSymlink: symlinkBooleam
	"Create a directory entry given a filesystem and a path in such filesystem. In addition, the creation and modification time are required as well as a boolean that indicates whether the entry is a folder or a file and its size."

	^ self 
		reference: (aFilesystem referenceTo: aPath)
		creation: cTime
		modification: mTime
		isDir: aBoolean
		size: anInteger
		posixPermissions: posixNumber
		isSymlink: symlinkBooleam! !

!FileSystemDirectoryEntry class methodsFor: 'instance creation' stamp: 'EstebanLorenzano 8/2/2012 15:36'!
reference: ref creation: cTime modification: mTime isDir: aBoolean size: anInteger posixPermissions: posixNumber isSymlink: symlinkBoolean
	"Create a directory entry for the file reference ref, with the creation time, cTime, the modification time, mTime. aBoolean indicates if the entry represents a directory or a file of size given by anInteger"
	
	^ self basicNew
		initializeWithRef: ref
		creation: cTime
		modification: mTime
		isDir: aBoolean
		size: anInteger
		posixPermissions: posixNumber
		isSymlink: symlinkBoolean! !

!FileSystemError commentStamp: 'cwp 11/18/2009 12:32'!
I am an abstract superclass for errors that may occur during filesystem operations.!
!FileSystemError methodsFor: 'testing' stamp: 'lr 8/16/2010 16:00'!
isResumable
	^ true! !

!FileSystemError methodsFor: 'accessing' stamp: 'lr 7/13/2010 15:31'!
reference
	^ reference! !

!FileSystemError methodsFor: 'initialize-release' stamp: 'lr 8/16/2010 16:00'!
initializeWithReference: aReference
	reference := aReference.
	messageText := aReference printString! !

!FileSystemError class methodsFor: 'instance creation' stamp: 'cwp 11/14/2009 23:32'!
reference: aReference
	^ self basicNew initializeWithReference: aReference! !

!FileSystemError class methodsFor: 'instance creation' stamp: 'cwp 11/14/2009 23:31'!
signalWith: aReference
	^ (self reference: aReference) signal! !

!FileSystemGuide commentStamp: 'cwp 11/18/2009 12:09'!
I am an abstract superclass for objects that fulfill the Guide role in the Guide/Visitor pattern. My subclasses know how to traverse a filesystem in a specific order, "showing" the files and directories they encounter to a visitor.

visitor
	An object that fulfills the Visitor role and implements the visitor protocol.
	
work
	An OrderedCollection, used to keep track of filesystem nodes that have not yet been visited!
!FileSystemGuide methodsFor: 'showing' stamp: 'CamilloBruni 8/12/2011 18:20'!
pushAll: aCollection 
	aCollection do: [ :ea | self push: ea ]! !

!FileSystemGuide methodsFor: 'initialization' stamp: 'StephaneDucasse 1/27/2011 10:37'!
initialize

	super initialize.
	work := OrderedCollection new! !

!FileSystemGuide methodsFor: 'initialize-release' stamp: 'cwp 10/29/2009 23:48'!
initializeWithVisitor: aVisitor
	self initialize.
	visitor := aVisitor.
	! !

!FileSystemGuide methodsFor: 'removing' stamp: 'CamilloBruni 8/12/2011 18:18'!
pop
	^ work removeLast! !

!FileSystemGuide methodsFor: 'accessing' stamp: 'CamilloBruni 4/10/2013 12:29'!
selectChildren
	^ selectChildren! !

!FileSystemGuide methodsFor: 'adding' stamp: 'CamilloBruni 8/12/2011 18:18'!
push: anObject
	work add: anObject! !

!FileSystemGuide methodsFor: 'accessing' stamp: 'CamilloBruni 8/12/2011 18:22'!
top
	^ work removeFirst! !

!FileSystemGuide methodsFor: 'showing' stamp: 'cwp 10/29/2009 23:21'!
show: aReference
	self subclassResponsibility! !

!FileSystemGuide methodsFor: 'accessing' stamp: 'CamilloBruni 4/10/2013 12:34'!
selectChildren: aBlock
	"With this block you can control how the guide spreads over directories.
	Example: 
		self selectChildren: [ :parentEntry | parentEntry isSymlink not ].
		This will prevent the outer visitor to see any children of symlinked directories.
		
	Since the guides essentially rearrange the files visited controlling which children
	you see is the main concern of the guide. All the other visiting aspects can be 
	controlled in the visitor."
	selectChildren := aBlock! !

!FileSystemGuide methodsFor: 'showing' stamp: 'lr 7/13/2010 15:36'!
whileNotDoneDo: aBlock
	[ work isEmpty ] whileFalse: [ aBlock value ]! !

!FileSystemGuide methodsFor: 'testing' stamp: 'CamilloBruni 4/10/2013 12:29'!
shouldVisitChildrenOf: anEntry
	^ selectChildren 
		ifNil: [ true ]
		ifNotNil: [ selectChildren cull: anEntry ]! !

!FileSystemGuide class methodsFor: 'instance creation' stamp: 'CamilloBruni 4/10/2013 12:29'!
show: aReference to: aVisitor selecting: aBlock
	^ (self for: aVisitor)
		selectChildren:  aBlock;
		show: aReference! !

!FileSystemGuide class methodsFor: 'instance creation' stamp: 'cwp 11/17/2009 11:58'!
show: aReference to: aVisitor
	^ (self for: aVisitor) show: aReference! !

!FileSystemGuide class methodsFor: 'instance creation' stamp: 'cwp 10/29/2009 19:27'!
for: aVisitor
	^ self basicNew initializeWithVisitor: aVisitor! !

!FileSystemHandle commentStamp: 'cwp 11/18/2009 11:11'!
I am an abstract superclass for file handle implementations. I provide a uniform interface that streams can use for read and write operations on a file regardless of the filesystem. I encapsulate the actual IO primitives.!
!FileSystemHandle methodsFor: 'public' stamp: 'cwp 7/26/2009 12:50'!
close
	self subclassResponsibility! !

!FileSystemHandle methodsFor: 'testing' stamp: 'cwp 7/26/2009 12:50'!
isOpen
	self subclassResponsibility! !

!FileSystemHandle methodsFor: 'testing' stamp: 'abc 5/11/2012 23:24'!
isWritable
	^ writable! !

!FileSystemHandle methodsFor: 'public' stamp: 'cwp 7/26/2009 12:50'!
at: offset write: buffer startingAt: start count: count
	self subclassResponsibility! !

!FileSystemHandle methodsFor: 'accessing' stamp: 'abc 5/11/2012 23:24'!
fullName
	^ reference fullName! !

!FileSystemHandle methodsFor: 'private' stamp: 'EstebanLorenzano 4/3/2012 13:06'!
basicOpen
	"get the raw stream description from the filesystem's store"
	^ self fileSystem 
		openStreamDescription: reference path
		writable: writable! !

!FileSystemHandle methodsFor: 'public' stamp: 'PavelKrivanek 11/23/2012 12:21'!
readStream
	self subclassResponsibility! !

!FileSystemHandle methodsFor: 'accessing' stamp: 'EstebanLorenzano 4/3/2012 13:02'!
fileSystem
	^ reference fileSystem ! !

!FileSystemHandle methodsFor: 'public' stamp: 'SeanDeNigris 6/13/2012 07:47'!
ensureClosed
	reference exists ifTrue: [self close]! !

!FileSystemHandle methodsFor: 'public' stamp: 'cwp 7/26/2009 12:51'!
reopen
	self close.
	self open! !

!FileSystemHandle methodsFor: 'public' stamp: 'cwp 7/26/2009 12:50'!
at: offset read: buffer startingAt: start count: count
	self subclassResponsibility! !

!FileSystemHandle methodsFor: 'public' stamp: 'lr 4/13/2010 16:10'!
at: index put: anObject
	| buffer |
	buffer := ByteArray with: (anObject isCharacter
		ifTrue: [ anObject codePoint ]
		ifFalse: [ anObject ]).
	self at: index write: buffer startingAt: 1 count: 1.
	! !

!FileSystemHandle methodsFor: 'public' stamp: 'cwp 7/29/2009 22:19'!
at: index
	| buffer |
	buffer := ByteArray new: 1.
	self at: index read: buffer startingAt: 1 count: 1.
	^ buffer at: 1! !

!FileSystemHandle methodsFor: 'accessing' stamp: 'cwp 7/26/2009 12:51'!
reference
	^ reference! !

!FileSystemHandle methodsFor: 'public' stamp: 'PavelKrivanek 11/23/2012 12:21'!
writeStream
	self subclassResponsibility! !

!FileSystemHandle methodsFor: 'public' stamp: 'cwp 7/26/2009 12:50'!
flush
	self subclassResponsibility! !

!FileSystemHandle methodsFor: 'public' stamp: 'cwp 7/26/2009 12:50'!
open
	self subclassResponsibility! !

!FileSystemHandle methodsFor: 'initialize-release' stamp: 'cwp 11/20/2009 14:56'!
setReference: aReference writable: aBoolean
	reference := aReference resolve.
	writable := aBoolean! !

!FileSystemHandle methodsFor: 'public' stamp: 'cwp 7/26/2009 12:50'!
truncateTo: anInteger
	self subclassResponsibility! !

!FileSystemHandle class methodsFor: 'instance creation' stamp: 'cwp 7/26/2009 12:52'!
on: aReference writable: aBoolean
	^ self new setReference: aReference writable: aBoolean! !

!FileSystemHandle class methodsFor: 'instance creation' stamp: 'cwp 7/26/2009 12:52'!
open: aReference writable: aBoolean
	^ (self on: aReference writable: aBoolean) open! !

!FileSystemHandleTest commentStamp: 'TorstenBergmann 1/31/2014 11:35'!
SUnit tests for FileSystemHandle!
!FileSystemHandleTest methodsFor: 'tests' stamp: 'cwp 7/29/2009 22:03'!
testAtPut
	| in |
	handle at: 1 put: 3.
	in := ByteArray new: 1.
	handle at: 1 read: in startingAt: 1 count: 1.
	self assert: in first = 3! !

!FileSystemHandleTest methodsFor: 'tests' stamp: 'cwp 7/31/2009 00:13'!
testReadBufferTooLarge
	| out in result |
	out := #(1 2 3) asByteArray.
	in := ByteArray new: 5.
	in atAllPut: 9.
	handle at: 1 write: out startingAt: 1 count: 3.
	result := handle at: 1 read: in startingAt: 2 count: 4.
	self assert: result = 3.
	self assert: in = #(9 1 2 3 9) asByteArray.! !

!FileSystemHandleTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:23'!
testEnsureClosed
	filesystem := self createFileSystem.
	reference := filesystem * 'plonk'.
	handle := reference openWritable: true.
	handle ensureClosed.
	self deny: handle isOpen.
	handle ensureClosed.
	reference ensureDelete.
	handle reference exists
		ifTrue: [ self error ].
	handle ensureClosed! !

!FileSystemHandleTest methodsFor: 'running' stamp: 'EstebanLorenzano 4/3/2012 11:43'!
createFileSystem
	self subclassResponsibility ! !

!FileSystemHandleTest methodsFor: 'running' stamp: 'S 6/17/2013 13:16'!
tearDown
	handle ensureClosed.
	reference ensureDelete.! !

!FileSystemHandleTest methodsFor: 'tests' stamp: 'cwp 7/26/2009 14:15'!
testIO
	| out in |
	out := #(1 2 3) asByteArray.
	in := ByteArray new: 3.
	handle at: 1 write: out startingAt: 1 count: 3.
	handle at: 1 read: in startingAt: 1 count: 3.
	self assert: out = in.! !

!FileSystemHandleTest methodsFor: 'tests' stamp: 'cwp 7/26/2009 14:16'!
testReadOnly
	handle close.
	handle := reference openWritable: false.
	self 
		should: 
			[ handle 
				at: 1
				write: #(1 2 3 )
				startingAt: 1
				count: 3 ]
		raise: Error! !

!FileSystemHandleTest methodsFor: 'tests' stamp: 'cwp 7/26/2009 14:16'!
testTruncate
	| out |
	out := #(1 2 3 4 5) asByteArray.
	handle at: 1 write: out startingAt: 1 count: 5.
	handle truncateTo: 3.
	self assert: handle size = 3! !

!FileSystemHandleTest methodsFor: 'tests' stamp: 'cwp 7/29/2009 22:06'!
testAt
	handle at: 1 write: (ByteArray with: 3) startingAt: 1 count: 1.
	self assert: (handle at: 1) = 3! !

!FileSystemHandleTest methodsFor: 'running' stamp: 'EstebanLorenzano 4/3/2012 11:42'!
setUp
	filesystem := self createFileSystem.
	reference := filesystem * 'plonk'.
	handle := reference openWritable: true! !

!FileSystemHandleTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:23'!
testAtPutBinaryAscii
	handle at: 1 put: 32.
	handle at: 1 put: Character space! !

!FileSystemHandleTest methodsFor: 'tests' stamp: 'cwp 7/26/2009 12:45'!
testReference
	self assert: handle reference = reference asAbsolute! !

!FileSystemHandleTest methodsFor: 'tests' stamp: 'cwp 7/29/2009 22:11'!
testSizeAfterGrow
	| out |
	out := #(1 2 3) asByteArray.
	handle at: 1 write: out startingAt: 1 count: 3.
	self assert: handle size = 3! !

!FileSystemHandleTest methodsFor: 'tests' stamp: 'cwp 7/29/2009 22:13'!
testSizeNoGrow
	| bytes |
	bytes := #(1 2 3 4) asByteArray.
	handle at: 1 write: bytes startingAt: 1 count: 3.
	handle at: 4 write: bytes startingAt: 4 count: 1.
	self assert: handle size = 4! !

!FileSystemHandleTest methodsFor: 'tests' stamp: 'cwp 7/28/2009 22:40'!
testWriteStream
	| stream |
	stream := handle writeStream.
	self assert: (stream respondsTo: #nextPut:)! !

!FileSystemHandleTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:23'!
testAtWriteBinaryAscii
	handle
		at: 1
		write: #[32]
		startingAt: 1
		count: 1.
	handle
		at: 1
		write: (String with: Character space)
		startingAt: 1
		count: 1! !

!FileSystemHandleTest methodsFor: 'tests' stamp: 'CamilloBruni 5/24/2012 15:21'!
testCreatedOpen
	
	
	self flag: 'TODO: activated once FileHandle is in use again!!'.
	"self assert: handle isOpen"! !

!FileSystemHandleTest methodsFor: 'tests' stamp: 'cwp 7/26/2009 12:23'!
testClose
	handle close.
	self deny: handle isOpen
	! !

!FileSystemHandleTest class methodsFor: 'testing' stamp: 'cwp 7/26/2009 12:46'!
shouldInheritSelectors 
	^ true! !

!FileSystemHandleTest class methodsFor: 'testing' stamp: 'EstebanLorenzano 4/3/2012 09:38'!
isAbstract
	^ self name = #FileSystemHandleTest! !

!FileSystemPermission commentStamp: '<historical>'!
I'm a set of permissions for a Directory Entry!
!FileSystemPermission methodsFor: 'accessing' stamp: 'EstebanLorenzano 6/22/2012 15:11'!
otherRead
	^ self permissionBitAt: 3! !

!FileSystemPermission methodsFor: 'accessing' stamp: 'EstebanLorenzano 6/22/2012 15:11'!
otherExecute
	^ self permissionBitAt: 1! !

!FileSystemPermission methodsFor: 'accessing' stamp: 'EstebanLorenzano 6/22/2012 15:11'!
groupWrite
	^ self permissionBitAt: 5! !

!FileSystemPermission methodsFor: 'testing' stamp: 'CamilloBruni 7/10/2012 21:32'!
isReadable
	^ self ownerRead! !

!FileSystemPermission methodsFor: 'comparing' stamp: 'NicolaiHess 12/25/2013 14:52'!
> other
	^ other posixPermission < posixPermission! !

!FileSystemPermission methodsFor: 'testing' stamp: 'CamilloBruni 7/10/2012 21:33'!
isWritable
	^ self ownerWrite! !

!FileSystemPermission methodsFor: 'accessing' stamp: 'EstebanLorenzano 6/22/2012 15:12'!
ownerExecute
	^ self permissionBitAt: 7! !

!FileSystemPermission methodsFor: 'accessing' stamp: 'EstebanLorenzano 7/3/2012 11:28'!
permissionBitAt: bitIndex
	^ (posixPermission bitAt: bitIndex) == 1! !

!FileSystemPermission methodsFor: 'comparing' stamp: 'NicolaiHess 12/25/2013 14:53'!
>= other
	^ other posixPermission <= posixPermission! !

!FileSystemPermission methodsFor: 'comparing' stamp: 'CamilloBruni 7/10/2012 22:01'!
< other
	^ posixPermission < other posixPermission! !

!FileSystemPermission methodsFor: 'initialization' stamp: 'EstebanLorenzano 6/22/2012 15:02'!
initialize: aNumber
	posixPermission := aNumber.
	self initialize.	! !

!FileSystemPermission methodsFor: 'private' stamp: 'NicolaiHess 12/25/2013 14:54'!
posixPermission
	^ posixPermission! !

!FileSystemPermission methodsFor: 'printing' stamp: 'EstebanLorenzano 6/22/2012 15:06'!
printOn: aStream
	aStream 
		"Owner"
		nextPut: (self ownerRead ifTrue: [ $r ] ifFalse: [ $- ]);
		nextPut: (self ownerWrite ifTrue: [ $w ] ifFalse: [ $- ]);
		nextPut: (self ownerExecute ifTrue: [ $x ] ifFalse: [ $- ]);
		"Group"
		nextPut: (self groupRead ifTrue: [ $r ] ifFalse: [ $- ]);
		nextPut: (self groupWrite ifTrue: [ $w ] ifFalse: [ $- ]);
		nextPut: (self groupExecute ifTrue: [ $x ] ifFalse: [ $- ]);
		"Other"
		nextPut: (self otherRead ifTrue: [ $r ] ifFalse: [ $- ]);
		nextPut: (self otherWrite ifTrue: [ $w ] ifFalse: [ $- ]);
		nextPut: (self otherExecute ifTrue: [ $x ] ifFalse: [ $- ])
		! !

!FileSystemPermission methodsFor: 'accessing' stamp: 'EstebanLorenzano 6/22/2012 15:10'!
groupRead
	^ self permissionBitAt: 6! !

!FileSystemPermission methodsFor: 'accessing' stamp: 'EstebanLorenzano 6/22/2012 15:12'!
ownerRead
	^ self permissionBitAt: 9! !

!FileSystemPermission methodsFor: 'accessing' stamp: 'EstebanLorenzano 6/22/2012 15:11'!
otherWrite
	^ self permissionBitAt: 2! !

!FileSystemPermission methodsFor: 'accessing' stamp: 'EstebanLorenzano 6/22/2012 15:10'!
groupExecute
	^ self permissionBitAt: 4! !

!FileSystemPermission methodsFor: 'accessing' stamp: 'EstebanLorenzano 6/22/2012 15:12'!
ownerWrite
	^ self permissionBitAt: 8! !

!FileSystemPermission methodsFor: 'comparing' stamp: 'NicolaiHess 12/25/2013 14:53'!
<= other
	^ (posixPermission > other posixPermission) not! !

!FileSystemPermission class methodsFor: 'instance creation' stamp: 'EstebanLorenzano 6/22/2012 15:01'!
posixPermissions: aNumber
	^self basicNew 
		initialize: aNumber;
		yourself! !

!FileSystemPermission class methodsFor: 'instance creation' stamp: 'EstebanLorenzano 6/22/2012 15:02'!
new 
	self error: 'Should not be called. Use #posixPermission: instead'! !

!FileSystemPermission class methodsFor: 'instance creation' stamp: 'CamilloBruni 3/23/2013 00:14'!
default
	^ self posixPermissions: 8r777! !

!FileSystemResolver commentStamp: 'cwp 3/29/2011 17:04'!
I am an abstract superclass for objects that can resolve origins into references. Such objects use the Chain of Responsibility pattern, and when unable to resolve a particular origin, delegate that resolution request to the next resolver in the list.

next
	The next resolver in the list, or nil
!
!FileSystemResolver methodsFor: 'resolving' stamp: 'cwp 10/27/2009 11:18'!
resolve: aSymbol
	^ (self canResolve: aSymbol)
		ifTrue: [self perform: aSymbol]
		ifFalse: [self unknownOrigin: aSymbol]! !

!FileSystemResolver methodsFor: 'resolving' stamp: 'cwp 10/27/2009 09:26'!
unknownOrigin: aSymbol
	^ next ifNotNil: [next resolve: aSymbol]! !

!FileSystemResolver methodsFor: 'resolving' stamp: 'cwp 10/27/2009 11:18'!
canResolve: aSymbol
	^ self supportedOrigins includes: aSymbol! !

!FileSystemResolver methodsFor: 'accessing' stamp: 'cwp 10/26/2009 20:53'!
addResolver: aResolver
	next
		ifNil: [next := aResolver]
		ifNotNil: [next addResolver: aResolver]! !

!FileSystemResolver methodsFor: 'resolving' stamp: 'CamilloBruni 9/7/2013 11:28'!
resolveString: aString
	| decoded fs |
	decoded := FilePathEncoder decode: aString.
	fs := FileSystem disk.
	^ FileReference 
		fileSystem: fs 
		path: (fs pathFromString: decoded)! !

!FileSystemResolver methodsFor: 'accessing' stamp: 'cwp 10/27/2009 10:28'!
flushLocalCache! !

!FileSystemResolver methodsFor: 'accessing' stamp: 'cwp 10/27/2009 11:25'!
next
	^ next! !

!FileSystemResolver methodsFor: 'resolving' stamp: 'cwp 10/26/2009 20:06'!
supportedOrigins
	^ #()! !

!FileSystemResolver methodsFor: 'accessing' stamp: 'cwp 10/27/2009 10:28'!
flushCaches
	self flushLocalCache.
	next ifNotNil: [next flushCaches]! !

!FileSystemResolverTest commentStamp: 'TorstenBergmann 1/31/2014 11:35'!
SUnit tests for FileSystemResolver!
!FileSystemResolverTest methodsFor: 'running' stamp: 'cwp 10/27/2009 11:12'!
createResolver
	self subclassResponsibility ! !

!FileSystemResolverTest methodsFor: 'running' stamp: 'cwp 10/26/2009 21:25'!
setUp
	resolver := self createResolver.! !

!FileSystemResolverTest methodsFor: 'asserting' stamp: 'DamienCassou 6/28/2013 14:35'!
assertOriginResolves: aSymbol
	| reference |
	reference := resolver resolve: aSymbol.
	self assert: (reference isKindOf: FileReference).
	self assert: reference isAbsolute.
	self assert: reference exists.
	^ reference! !

!FileSystemResolverTest class methodsFor: 'testing' stamp: 'EstebanLorenzano 4/3/2012 09:40'!
isAbstract
	^ self name = #FileSystemResolverTest! !

!FileSystemStore commentStamp: '<historical>'!
I am an abstract superclass for store implementations. My subclasses provide access to the actual data storage of a particular kind of filesystem. 

The file system can be accessed via
	FileSystem disk 
	FileSystem memory
	
My associated filesystem can be accessed as follows:
      DiskStore currentFileSystem!
!FileSystemStore methodsFor: 'public' stamp: 'CamilloBruni 5/24/2013 13:47'!
nodeAt: aPath
	^ self 
		nodeAt: aPath 
		ifPresent: [ :node| node ]
		ifAbsent: [ NotFound signalFor: aPath in: self ]! !

!FileSystemStore methodsFor: 'private' stamp: 'EstebanLorenzano 8/2/2012 15:35'!
entryFromNode: aNode fileSystem: aFilesystem path: aPath
	^ FileSystemDirectoryEntry
		fileSystem: aFilesystem
		path: aPath
		creation: (self basicCreationTime: aNode)
		modification:(self basicModificationTime: aNode)
		isDir: (self basicIsDirectory: aNode)
		size: (self basicSize: aNode)
		posixPermissions: (self basicPosixPermissions: aNode)
		isSymlink: (self basicIsSymlink: aNode)! !

!FileSystemStore methodsFor: 'abstract' stamp: 'CamilloBruni 5/5/2013 01:17'!
basicEntry: directoryEntry path: aPath nodesDo: aBlock
	self subclassResponsibility ! !

!FileSystemStore methodsFor: 'error signalling' stamp: 'CamilloBruni 1/20/2012 13:34'!
basicOpen: aPath writable: aBoolean
	"open the file at the given path and return an identifier"
	self subclassResponsibility! !

!FileSystemStore methodsFor: 'abstract' stamp: 'cwp 2/18/2011 23:59'!
createDirectory: aPath
	self subclassResponsibility ! !

!FileSystemStore methodsFor: 'public' stamp: 'CamilloBruni 5/5/2013 01:22'!
directoryAt: aPath ifAbsent: absentBlock nodesDo: aBlock
	^ self
		nodeAt: aPath
		ifPresent: [ :entry | 
			(self basicIsDirectory: entry)
				ifTrue: [ self basicEntry: entry path: aPath nodesDo: aBlock ]
				ifFalse: [ DirectoryDoesNotExist signalWith: aPath ] ]
		ifAbsent: absentBlock! !

!FileSystemStore methodsFor: 'public' stamp: 'S 6/17/2013 13:33'!
ensureCreateDirectory: aPath
	(self isDirectory: aPath) ifTrue: [ ^ self ].
	self ensureCreateDirectory: aPath parent.
	self createDirectory: aPath! !

!FileSystemStore methodsFor: 'abstract' stamp: 'EstebanLorenzano 8/2/2012 15:38'!
basicIsSymlink: aNode
	^self subclassResponsibility 
	! !

!FileSystemStore methodsFor: 'public' stamp: 'PavelKrivanek 11/23/2012 12:21'!
openFileStream: path writable: writable
	self subclassResponsibility! !

!FileSystemStore methodsFor: 'public' stamp: 'CamilloBruni 7/10/2012 21:05'!
directoryAt: aPath ifAbsent: absentBlock fileNodesDo: aBlock
	^ self 
		directoryAt: aPath 
		ifAbsent: absentBlock 
		nodesDo: [ :entry|
			(self basicIsDirectory: entry) 
				ifFalse: [ aBlock value: entry ]].! !

!FileSystemStore methodsFor: 'converting' stamp: 'BenComan 3/13/2014 16:24'!
printPath: aPath on: out
	"Use the unix convention by default, since it's the most common."
	
	aPath isAbsolute ifTrue: [ out nextPut: self delimiter ].
	^ aPath printOn: out delimiter: self delimiter! !

!FileSystemStore methodsFor: 'abstract' stamp: 'CamilloBruni 1/20/2012 11:34'!
basicIsFile: aNode
	"Used to decide whether the low-level representation (node / entry) from the store is a file.
	This private message should only be called form within the store."
	self subclassResponsibility ! !

!FileSystemStore methodsFor: 'private' stamp: 'CamilloBruni 6/22/2012 20:07'!
copy: sourcePath ifAbsent: absentBlock to: destinationPath ifPresent: presentBlock fileSystem: aFilesystem

	| buffer out in |
	
	in := nil.
	out := nil.
	buffer := nil.
	[
		in := aFilesystem readStreamOn: sourcePath.
		in ifNil: [ ^ absentBlock value ].
		
		(self exists: destinationPath)
			ifTrue: [ "cannot overwrite destination"
				^ presentBlock value ].
			
		out := aFilesystem writeStreamOn: destinationPath.
		buffer := ByteArray new: 1024.
		
		[ in atEnd ]
			whileFalse: [ 
				buffer := in nextInto: buffer.
				out nextPutAll: buffer ]]
	ensure: [ 
		in ifNotNil: [ in close ].
		out ifNotNil: [ out close ]]! !

!FileSystemStore methodsFor: 'accessing' stamp: 'CamilloBruni 5/7/2012 01:13'!
separator
	^ self class separator! !

!FileSystemStore methodsFor: 'public' stamp: 'CamilloBruni 6/22/2012 21:02'!
entryFromNode: node path: path for: aFileystem
	| entryPath |
	entryPath := path / (self basenameFromEntry: node).
	^ self entryFromNode: node fileSystem: aFileystem path: entryPath! !

!FileSystemStore methodsFor: 'public' stamp: 'NicolaiHess 2/24/2015 00:42'!
modificationTime: aPath
	^ self 
		nodeAt: aPath 
		ifPresent: [ :entry | self basicModificationTime: entry ] 
		ifAbsent: [ self signalFileDoesNotExist: aPath ].
	! !

!FileSystemStore methodsFor: 'public' stamp: 'NicolaiHess 2/24/2015 00:42'!
creationTime: aPath
	^ self 
		nodeAt: aPath 
		ifPresent: [ :entry | self basicCreationTime: entry ] 
		ifAbsent: [ self signalFileDoesNotExist: aPath ].
	! !

!FileSystemStore methodsFor: 'abstract' stamp: 'CamilloBruni 7/10/2012 21:12'!
basicSize: aNode
	"Used to get the size of the low-level representation (node / entry) "
	self subclassResponsibility ! !

!FileSystemStore methodsFor: 'converting' stamp: 'CamilloBruni 5/7/2012 02:20'!
pathFromString: aString
	"Use the unix convention by default, since many filesystems are based on it."
	
	^ Path from: aString delimiter: self delimiter! !

!FileSystemStore methodsFor: 'private' stamp: 'cwp 2/18/2011 12:28'!
filename: aByteString matches: aByteString2
	^ aByteString = aByteString2! !

!FileSystemStore methodsFor: 'public' stamp: 'CamilloBruni 5/10/2012 16:01'!
checkName: aString fixErrors: fixErrors
	^ self subclassResponsibility! !

!FileSystemStore methodsFor: 'abstract' stamp: 'cwp 2/19/2011 01:38'!
open
	"Some kinds of filesystems need to open connections to external resources"! !

!FileSystemStore methodsFor: 'public' stamp: 'cwp 2/18/2011 13:22'!
isDirectory: aPath
	aPath isRoot ifTrue: [ ^ true ].
	self 
		nodeAt: aPath 
		ifPresent: [ :entry | ^ self basicIsDirectory: entry ] 
		ifAbsent: [ ^ false ].
	! !

!FileSystemStore methodsFor: 'public' stamp: 'EstebanLorenzano 8/2/2012 15:42'!
isSymlink: aPath
	aPath isRoot ifTrue: [ ^ true ].
	self 
		nodeAt: aPath 
		ifPresent: [ :entry | ^ self basicIsSymlink: entry ] 
		ifAbsent: [ ^ false ].
	! !

!FileSystemStore methodsFor: 'error signalling' stamp: 'CamilloBruni 9/5/2012 11:27'!
signalFileExists: aPath
	^ FileExists signalWith: aPath! !

!FileSystemStore methodsFor: 'accessing' stamp: 'cwp 2/18/2011 17:19'!
delimiter
	^ self class delimiter! !

!FileSystemStore methodsFor: 'abstract' stamp: 'cwp 2/19/2011 01:39'!
close
	"Some kinds of filesystems need to open connections to external resources"! !

!FileSystemStore methodsFor: 'error signalling' stamp: 'CamilloBruni 9/5/2012 11:27'!
signalFileDoesNotExist: aPath
	^ FileDoesNotExist signalWith: aPath! !

!FileSystemStore methodsFor: 'error signalling' stamp: 'CamilloBruni 9/5/2012 11:27'!
signalDirectoryExists: aPath
	^ DirectoryExists signalWith: aPath! !

!FileSystemStore methodsFor: 'accessing' stamp: 'CamilloBruni 5/7/2012 01:20'!
isCaseSensitive
	^ self class isCaseSensitive! !

!FileSystemStore methodsFor: 'converting' stamp: 'CamilloBruni 1/19/2012 00:24'!
stringFromPath: aPath
	^ String streamContents: [ :out | 
		self printPath: aPath on: out ]! !

!FileSystemStore methodsFor: 'public' stamp: 'CamilloBruni 5/9/2012 00:40'!
isWritable: aPath
	self nodeAt: aPath 
		ifPresent: [ :entry | ^ self basicIsWritable: entry ] 
		ifAbsent: [ ^ false ].
	! !

!FileSystemStore methodsFor: 'abstract' stamp: 'CamilloBruni 5/24/2013 13:39'!
rename: sourcePath to: destinationPath
	self subclassResponsibility ! !

!FileSystemStore methodsFor: 'accessing' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
defaultWorkingDirectory
	^ Path root! !

!FileSystemStore methodsFor: 'abstract' stamp: 'CamilloBruni 7/10/2012 21:15'!
basicPosixPermissions: aNode
	"Used to get the posix permissions from a low-level filesystem entry / node"
	self subclassResponsibility ! !

!FileSystemStore methodsFor: '*FileSystem-Disk' stamp: 'VincentBlondeau 1/30/2015 14:57'!
isDiskFileSystem
	^ false! !

!FileSystemStore methodsFor: 'abstract' stamp: 'CamilloBruni 1/20/2012 11:34'!
basicIsDirectory: aNode
	"Used to decide whether the low-level representation (node / entry) from the store is a directory.
	This private message should only be called form within the store."
	self subclassResponsibility ! !

!FileSystemStore methodsFor: 'abstract' stamp: 'cwp 2/18/2011 13:25'!
delete: aPath
	self subclassResponsibility ! !

!FileSystemStore methodsFor: 'abstract' stamp: 'cwp 2/18/2011 12:50'!
nodeAt: aPath ifPresent: presentBlock ifAbsent: absentBlock
	self subclassResponsibility ! !

!FileSystemStore methodsFor: 'public' stamp: 'CamilloBruni 5/5/2013 01:06'!
exists: aPath
	self 
		nodeAt: aPath 
		ifPresent: [ :entry | ^ true ] 
		ifAbsent: [ ^ false ].
	! !

!FileSystemStore methodsFor: 'public' stamp: 'SvenVanCaekenberghe 10/22/2013 11:38'!
mimeTypesAt: aPath
	| mimeType |
	mimeType := ZnMimeType 
						forFilenameExtension: aPath extension 
						ifAbsent: [  ^ nil ].
	^ Array with: mimeType! !

!FileSystemStore methodsFor: 'private' stamp: 'SeanDeNigris 8/17/2012 09:30'!
rename: sourcePath ifAbsent: absentBlock to: destinationPath ifPresent: presentBlock fileSystem: anFSFilesystem

	| result |
	(self exists: destinationPath) ifTrue: [ ^ presentBlock value ].
	(self exists: sourcePath) ifFalse: [ ^ absentBlock value ].
	result := self rename: sourcePath to: destinationPath.
	result ifNil: [ self primitiveFailed ].
	^ self.! !

!FileSystemStore methodsFor: 'error signalling' stamp: 'CamilloBruni 9/5/2012 11:27'!
signalDirectoryDoesNotExist: aPath
	^ DirectoryDoesNotExist signalWith: aPath! !

!FileSystemStore methodsFor: '*FileSystem-Memory' stamp: 'VincentBlondeau 1/31/2015 12:18'!
isMemoryFileSystem
	^ false! !

!FileSystemStore methodsFor: 'public' stamp: 'PavelKrivanek 11/23/2012 12:21'!
basenameFromEntry: aNode
	"Used to extract the basename from the low-level representation (node / entry) from the store."
	self subclassResponsibility! !

!FileSystemStore methodsFor: 'public' stamp: 'NicolaiHess 2/24/2015 00:42'!
size: aPath
	^ self 
		nodeAt: aPath 
		ifPresent: [ :entry | self basicSize: entry ] 
		ifAbsent: [ self signalFileDoesNotExist: aPath ]
	! !

!FileSystemStore methodsFor: 'abstract' stamp: 'CamilloBruni 7/10/2012 20:56'!
basicCreationTime: aNode
	"Used to decide whether the low-level representation (node / entry) from the store is a readable
	file or a directory whose contents can be listed."
	self subclassResponsibility ! !

!FileSystemStore methodsFor: 'public' stamp: 'CamilloBruni 3/23/2013 00:13'!
permissions: aPath
	self nodeAt: aPath 
		ifPresent: [ :entry | ^ FileSystemPermission posixPermissions: (self basicPosixPermissions: entry) ] 
		ifAbsent: [ ^ FileSystemPermission default ].
	! !

!FileSystemStore methodsFor: 'public' stamp: 'CamilloBruni 1/19/2012 00:15'!
directoryAt: aPath ifAbsent: absentBlock directoryNodesDo: aBlock
	^ self 
		directoryAt: aPath 
		ifAbsent: absentBlock 
		nodesDo: [ :entry|
			(self basicIsDirectory: entry) 
				ifTrue: [ aBlock value: entry ]].! !

!FileSystemStore methodsFor: 'public' stamp: 'CamilloBruni 1/20/2012 13:13'!
isFile: aPath
	"slow solution for big directories!! "
	^ self 
		nodeAt: aPath 
		ifPresent: [ :entry | ^ self basicIsFile: entry ] 
		ifAbsent: [ ^ false ]
	! !

!FileSystemStore methodsFor: 'abstract' stamp: 'CamilloBruni 7/10/2012 20:56'!
basicModificationTime: aNode
	"Used to decide whether the low-level representation (node / entry) from the store is a readable
	file or a directory whose contents can be listed."
	self subclassResponsibility ! !

!FileSystemStore methodsFor: 'abstract' stamp: 'CamilloBruni 5/9/2012 00:41'!
basicIsWritable: aNode
	"Used to decide whether the low-level representation (node / entry) from the store is 
	a writable file or can be changed."
	self subclassResponsibility ! !

!FileSystemStore class methodsFor: 'accessing' stamp: 'CamilloBruni 5/7/2012 01:20'!
isCaseSensitive
	^ self shouldBeImplemented! !

!FileSystemStore class methodsFor: 'accessing' stamp: 'CamilloBruni 5/7/2012 01:11'!
separator
	self shouldBeImplemented! !

!FileSystemStore class methodsFor: 'accessing' stamp: 'CamilloBruni 5/7/2012 01:10'!
delimiter
	self shouldBeImplemented ! !

!FileSystemTest commentStamp: '<historical>'!
I am an abstract file system test. 
I directly test 
- the public interface of a FileSystem using these methods directly
- the FileSystem in general through the operation methods of the FileReference!
!FileSystemTest methodsFor: 'tests' stamp: 'S 6/17/2013 13:33'!
testEnsureDirectory
	| path |
	
	path := Path * 'plonk'.
	self markForCleanup: path.
	
	filesystem ensureCreateDirectory: path.
	self assert: (filesystem isDirectory: path).! !

!FileSystemTest methodsFor: 'tests-streams' stamp: 'CamilloBruni 5/24/2013 14:27'!
testReadStreamIfAbsent
	| reference stream |
	self markForCleanup: (reference := filesystem workingDirectory / 'griffle').
	self assert: (reference readStreamIfAbsent: [ true ]).
	reference writeStreamDo: [ :ws | ws nextPutAll: 'griffle' ].
	stream := reference readStreamIfAbsent: [ false ].
	self assert: stream contents asString = 'griffle'.
	stream close! !

!FileSystemTest methodsFor: 'tests' stamp: 'CamilloBruni 5/24/2013 14:40'!
testFile
	| path |
	
	path := Path * 'gooly'.
	self markForCleanup: path.
	
	(filesystem open: path writable: true) writeStream close.
	self assert: (filesystem exists: path).
	self deny: (filesystem isDirectory: path).
	self assert: (filesystem isFile: path).
	
	filesystem delete: path.
	self deny: (filesystem exists: path)! !

!FileSystemTest methodsFor: 'tests-streams-compatibility' stamp: 'MaxLeske 1/25/2014 23:13'!
testBinaryReadStreamDoIfAbsent
	| reference |
	self markForCleanup: (reference := filesystem workingDirectory / 'griffle').
	self assert: (reference 
		binaryReadStreamDo: [ :stream | false ]
		ifAbsent: [ true ]).
	reference writeStreamDo: [ :ws | ws nextPutAll: 'griffle' ].
	self assert: (reference 
		binaryReadStreamDo: [ :stream | stream contents asString = 'griffle' ]
		ifAbsent: [ false ])! !

!FileSystemTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testRootIsNotAFile
	self deny: (filesystem isFile: Path root)! !

!FileSystemTest methodsFor: 'tests-streams-compatibility' stamp: 'MaxLeske 1/25/2014 23:13'!
testBinaryReadStreamDo
	| reference |
	self markForCleanup: (reference := filesystem workingDirectory / 'griffle').
	self 
		should: [ reference binaryReadStreamDo: [ :stream | self assert: false ] ] 
		raise: FileDoesNotExist.
	reference writeStreamDo: [ :ws | ws nextPutAll: 'griffle' ].
	self assert: (reference readStreamDo: [ :stream | stream contents asString ]) 
		= 'griffle'! !

!FileSystemTest methodsFor: 'tests' stamp: 'CamilloBruni 5/24/2013 14:27'!
testChildrenAt
	| directory entries |
	directory := Path * 'plonk'.
	
	filesystem createDirectory: directory.
	filesystem createDirectory: directory / 'griffle'.
	filesystem createDirectory: directory / 'bint'.
	
	self markForCleanup: directory / 'griffle'.
	self markForCleanup: directory / 'bint'.
	self markForCleanup: directory.
	
	entries := filesystem childrenAt: directory.
	
	self assert: entries size = 2.
	entries do: [ :ea | 
		self assert: (ea isKindOf: Path).
		self assert: ea parent = (filesystem resolve: directory).
		self assert: (#('griffle' 'bint' ) includes: ea basename) ]! !

!FileSystemTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testChangeDirectoryString
	| cwd |
	filesystem workingDirectoryPath: (Path / 'plonk').
	filesystem changeDirectory: 'griffle'.
	cwd := filesystem workingDirectoryPath.
	self assert: cwd isAbsolute.
	self assert: (cwd at: 1) = 'plonk'.
	self assert: (cwd at: 2) = 'griffle'! !

!FileSystemTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/3/2012 13:06'!
testRoot
	self assert: filesystem root fileSystem = filesystem.
	self assert: filesystem root path = Path root.
	self assert: filesystem root isRoot.! !

!FileSystemTest methodsFor: 'tests-streams' stamp: 'CamilloBruni 5/24/2013 14:27'!
testWriteStreamDo
	| reference |
	self markForCleanup: (reference := filesystem workingDirectory / 'griffle').
	self assert: (reference writeStreamDo: [ :stream |
		stream nextPutAll: 'griffle'.
		true ]).
	self assert: (filesystem workingDirectory / 'griffle') isFile.
	self assert: (reference writeStreamDo: [ :stream | true ])! !

!FileSystemTest methodsFor: 'tests-streams' stamp: 'DamienCassou 11/27/2013 17:44'!
testReadingAfterWriting
	| reference stream |
	self markForCleanup: (reference := filesystem workingDirectory / 'griffle').
	self deny: reference exists.
	reference writeStreamDo: [ :ws | ws nextPutAll: 'griffle' ].
	stream := reference readStream.
	self assert: stream contents equals: 'griffle'.
	stream close! !

!FileSystemTest methodsFor: 'tests-streams' stamp: 'CamilloBruni 5/24/2013 14:27'!
testWriteStream
	| reference stream |
	self markForCleanup: (reference := filesystem workingDirectory / 'griffle').
	stream := reference writeStream.
	stream nextPutAll: 'griffle'.
	stream close.
	self assert: (filesystem workingDirectory / 'griffle') isFile.
	stream := reference writeStream.
	stream close! !

!FileSystemTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testChangeDirectory
	| cwd |
	filesystem workingDirectoryPath: Path / 'plonk'.
	filesystem changeDirectory: 'griffle'.
	cwd := filesystem workingDirectoryPath.
	self assert: cwd isAbsolute.
	self assert: (cwd at: 1) = 'plonk'.
	self assert: (cwd at: 2) = 'griffle'.
! !

!FileSystemTest methodsFor: 'tests' stamp: 'cwp 7/20/2009 07:30'!
testDelimiter
	self assert: filesystem delimiter isCharacter! !

!FileSystemTest methodsFor: 'initialize-release' stamp: 'EstebanLorenzano 4/3/2012 13:04'!
createFileSystem
	self subclassResponsibility ! !

!FileSystemTest methodsFor: 'tests' stamp: 'BenComan 2/18/2014 01:26'!
testEntryAt
	| path1 path2 entry1 entry2  |

	path1 := Path * 'plonk1'.
	path2 := Path * 'plonk2'.
	self markForCleanup: path1.
	self markForCleanup: path2.
	
	filesystem createDirectory: path1.
	(Delay forSeconds: 2) wait. "#creationTime seems limited to 1 second resolution"
	filesystem createDirectory: path2.
	
	entry1 := filesystem entryAt: path1.
	entry2 := filesystem entryAt: path2.
	
	self assert: entry1 isDirectory.
	self assert: entry2 isDirectory.
	self assert: entry1 reference = (filesystem referenceTo: path1) asAbsolute.
	self assert: entry2 reference = (filesystem referenceTo: path2) asAbsolute.

	self assert: entry1 creationTime < entry2 creationTime.
	self assert: entry1 modificationTime < entry2 modificationTime.
! !

!FileSystemTest methodsFor: 'tests' stamp: 'S 6/17/2013 13:24'!
testCopyWithCorrectBasename
        | directory |
        self
                markForCleanup: 'gooly';
                markForCleanup: 'plonk'.
        directory := filesystem workingDirectory.
        (directory / 'gooly') ensureCreateFile.
        directory / 'gooly' copyTo: directory / 'plonk'.
        self assert: (directory / 'plonk') exists.
        self assert: (directory childNames includes: 'plonk')! !

!FileSystemTest methodsFor: 'tests' stamp: 'NicolaiHess 2/24/2015 00:40'!
testNonExistentFileSize
	| base file1 file2 |
	
	base := filesystem workingDirectory.
	file1 := (base / 'file1') ensureCreateFile.
	file2 := (base / 'file2').
	self markForCleanup: base / 'file1'.
	
	self shouldnt: [ file1 size ] raise: FileDoesNotExist.
	self should: [ file2 size ] raise: FileDoesNotExist! !

!FileSystemTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/3/2012 13:06'!
testWorking
	self assert: filesystem workingDirectory fileSystem = filesystem.
	self assert: filesystem workingDirectory path = filesystem workingDirectoryPath! !

!FileSystemTest methodsFor: 'tests' stamp: 'CamilloBruni 11/5/2013 17:42'!
testFileNames
	| reference |
	#('test one' 'test with two' 'test-äöü' 'test.äöü') do: [ :each |
		reference := filesystem workingDirectory / each.
		self assert: reference basename = each.
		self deny: reference exists.
		reference
			writeStreamDo: [ :stream | stream nextPutAll: 'gooly' ]
			ifPresent: [ self fail ].
		[	self assert: reference exists.
			self assert: (filesystem workingDirectory children
				anySatisfy: [ :ref | ref = reference ]) ]
		ensure: [ reference delete ] ]! !

!FileSystemTest methodsFor: 'tests' stamp: 'CamilloBruni 5/24/2013 14:30'!
testCreateDirectoryExists
	| path |
	
	path := Path * 'griffle'.
	self markForCleanup: path.
	
	filesystem createDirectory: path.
	self 
		should: [filesystem createDirectory: path]
		raise: DirectoryExists.
		

	
	
! !

!FileSystemTest methodsFor: 'tests' stamp: 'CamilloBruni 5/24/2013 14:30'!
testCopy
	| out in contents |
	
	self
		markForCleanup: 'gooly';
		markForCleanup: 'plonk'.
		
	out := filesystem writeStreamOn: 'gooly'.
	[ out nextPutAll: 'gooly' ] ensure: [ out close ].
	filesystem copy: 'gooly' to: 'plonk'.
	
	in := filesystem readStreamOn: 'plonk'.
	contents := [ in contents asString ] ensure: [ in close ].
	self assert: contents equals: 'gooly'! !

!FileSystemTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testRootIsDirectory
	self assert: (filesystem isDirectory: Path root)! !

!FileSystemTest methodsFor: 'tests-streams-compatibility' stamp: 'MaxLeske 1/25/2014 23:15'!
testBinaryReadStream
	| reference stream |
	self markForCleanup: (reference := filesystem workingDirectory / 'griffle').
	self should: [ reference binaryReadStream ] raise: FileDoesNotExist.
	reference writeStreamDo: [ :ws | ws nextPutAll: 'griffle' ].
	stream := reference binaryReadStream.
	self assert: stream contents asString equals: 'griffle'.
	stream close! !

!FileSystemTest methodsFor: 'tests' stamp: 'S 6/17/2013 13:26'!
testMoveToFailingExistingDestination
	| base file folder |
	
	base := filesystem workingDirectory.
	
	folder := (base / 'folder') ensureCreateDirectory. 
	(folder / 'newFile') ensureCreateFile.
	file := (base / 'file') ensureCreateFile.
	
	"Cleanup after running"
	self 
		markForCleanup: (base / 'folder' / 'newFile');
		markForCleanup: (base / 'folder') ;
		markForCleanup: (base / 'file').	
	
	"Destination exists already"
	self should: [ file moveTo: (folder / 'newFile') ] raise: Error.
	self assert: (base / 'file') exists.
	self assert: (folder / 'newFile') exists.! !

!FileSystemTest methodsFor: 'tests' stamp: 'CamilloBruni 5/24/2013 14:30'!
testCopyDestExists
	| out |
	
	self 
		markForCleanup: 'gooly'; 
		markForCleanup: 'plonk'.
		
	out := (filesystem open: 'gooly' writable: true) writeStream.
	[out nextPutAll: 'gooly'] ensure: [out close].

	(filesystem open: 'plonk' writable: true) writeStream close.
	
	self 
		should: [filesystem copy: 'gooly' to: 'plonk']
		raise: FileExists! !

!FileSystemTest methodsFor: 'tests-streams' stamp: 'CamilloBruni 5/24/2013 14:27'!
testReadStreamDoIfAbsent
	| reference |
	self markForCleanup: (reference := filesystem workingDirectory / 'griffle').
	self assert: (reference 
		readStreamDo: [ :stream | false ]
		ifAbsent: [ true ]).
	reference writeStreamDo: [ :ws | ws nextPutAll: 'griffle' ].
	self assert: (reference 
		readStreamDo: [ :stream | stream contents asString = 'griffle' ]
		ifAbsent: [ false ])! !

!FileSystemTest methodsFor: 'tests' stamp: 'CamilloBruni 8/21/2013 17:55'!
testChildrenSorting
	| directory sorted |
	
	directory := Path * 'plonk'.
	
	filesystem createDirectory: directory.
	filesystem createDirectory: directory / 'alfa'.
	filesystem createDirectory: directory / 'beta'.
	
	self markForCleanup: directory / 'alfa'.
	self markForCleanup: directory / 'beta'.
	self markForCleanup: directory.
	
	sorted := (filesystem childrenAt: directory) sorted.
	self assert: sorted size = 2.
	self assert: (sorted at: 1) basename = 'alfa'.
	self assert: (sorted at: 2) basename = 'beta'.! !

!FileSystemTest methodsFor: 'tests' stamp: 'NicolaiHess 2/24/2015 00:27'!
testNonExistentEntryAt
	| path1 path2  |
	path1 := Path * 'plonk1'.
	path2 := Path * 'plonk2'.
	self markForCleanup: path1.
	filesystem createDirectory: path1.

	self shouldnt: [ filesystem entryAt: path1 ] raise: FileDoesNotExist.
	self should: [ filesystem entryAt: path2 ] raise: FileDoesNotExist! !

!FileSystemTest methodsFor: 'tests-streams' stamp: 'CamilloBruni 5/24/2013 14:27'!
testWriteStreamIfPresent
	| reference stream |
	self markForCleanup: (reference := filesystem workingDirectory / 'griffle').
	stream := reference writeStreamIfPresent: [ false ].
	stream nextPutAll: 'griffle'.
	stream close.
	self assert: (filesystem workingDirectory / 'griffle') isFile.
	self assert: (reference writeStreamIfPresent: [ true ])! !

!FileSystemTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:23'!
testEnsureDirectoryCreatesParent
	| path |
	path := Path * 'plonk' / 'griffle'.
	self markForCleanup: path.
	self markForCleanup: path parent.
	filesystem ensureCreateDirectory: path.
	self assert: (filesystem isDirectory: Path * 'plonk').
	self assert: (filesystem isDirectory: path)! !

!FileSystemTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:23'!
testEnsureDirectoryExists
	| path |
	path := Path * 'plonk'.
	self markForCleanup: path.
	filesystem createDirectory: path.
	filesystem ensureCreateDirectory: path! !

!FileSystemTest methodsFor: 'tests' stamp: 'S 6/17/2013 13:26'!
testMoveTo
	| base file folder |
	
	base := filesystem workingDirectory.
	
	folder := (base / 'folder') ensureCreateDirectory. 
	file := (base / 'file') ensureCreateFile.
	
	"Cleanup after running"
	self 
		markForCleanup: (base / 'folder' / 'newFile');
		markForCleanup: (base / 'folder') ;
		markForCleanup: (base / 'file').	
	
	file moveTo: (folder / 'newFile').
	self deny: (base / 'file') exists.
	self assert: (folder / 'newFile') exists.! !

!FileSystemTest methodsFor: 'tests' stamp: 'CamilloBruni 5/24/2013 14:39'!
testDirectory
	| path |
	
	path := Path * 'plonk'.
	self markForCleanup: path.
	
	filesystem createDirectory: path.
	
	self assert: (filesystem exists: path).
	self assert: (filesystem isDirectory: path).
	
	filesystem delete: path.
	self deny: (filesystem isFile: path).
	self deny: (filesystem exists: path)! !

!FileSystemTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testSetWorkingDirectory
	| cwd |
	filesystem workingDirectoryPath: (Path / 'plonk').
	cwd := filesystem workingDirectoryPath.
	self assert: cwd isAbsolute.
	self assert: (cwd at: 1) = 'plonk'! !

!FileSystemTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testRootExists
	self assert: (filesystem exists: Path root)! !

!FileSystemTest methodsFor: 'tests-streams-compatibility' stamp: 'MaxLeske 1/25/2014 23:14'!
testBinaryReadStreamIfAbsent
	| reference stream |
	self markForCleanup: (reference := filesystem workingDirectory / 'griffle').
	self assert: (reference binaryReadStreamIfAbsent: [ true ]).
	reference writeStreamDo: [ :ws | ws nextPutAll: 'griffle' ].
	stream := reference binaryReadStreamIfAbsent: [ false ].
	self assert: stream contents asString = 'griffle'.
	stream close! !

!FileSystemTest methodsFor: 'initialize-release' stamp: 'CamilloBruni 5/24/2013 14:27'!
markForCleanup: anObject
	toDelete add: (filesystem resolve: anObject)! !

!FileSystemTest methodsFor: 'tests' stamp: 'cwp 7/20/2009 07:30'!
testDefaultWorkingDirectory
	self assert: filesystem workingDirectory isRoot! !

!FileSystemTest methodsFor: 'tests' stamp: 'CamilloBruni 7/8/2012 15:30'!
testReferenceTo
	|path|
	"use a relative path since absolute path behavior differs on mac, linux vs win native filesystems"
	path := Path * 'a' / 'b'.
	self assert: (filesystem referenceTo: 'a/b') path = path.! !

!FileSystemTest methodsFor: 'tests' stamp: 'CamilloBruni 8/21/2013 17:54'!
testChildrenSortingRoot
	| directory1 directory2 |
	"self skip."
	
	directory1 := Path * 'plonk1'.
	directory2 := Path * 'plonk2'.
	
	filesystem createDirectory: directory1.
	filesystem createDirectory: directory2.
	
	self markForCleanup: directory1.
	self markForCleanup: directory2.
	
	self assert: filesystem workingDirectory children sorted size = filesystem workingDirectory children size! !

!FileSystemTest methodsFor: 'tests-streams' stamp: 'CamilloBruni 5/24/2013 14:27'!
testWriteStreamDoIfPresent
	| reference |
	self markForCleanup: (reference := filesystem workingDirectory / 'griffle').
	self assert: (reference 
		writeStreamDo: [ :stream |
			stream nextPutAll: 'griffle'.
			true ]
		ifPresent: [ false ]).
	self assert: (filesystem workingDirectory / 'griffle') isFile.
	self assert: (reference 
		writeStreamDo: [ :stream | true ]
		ifPresent: [ true ])! !

!FileSystemTest methodsFor: 'initialize-release' stamp: 'CamilloBruni 5/24/2013 14:28'!
tearDown
	toDelete
		select: [ :path | filesystem exists: path ]
		thenDo: [ :path | filesystem delete: path ]! !

!FileSystemTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:41'!
testCopySourceDoesntExist
	self 
		should: [filesystem copy: 'plonk' to: 'griffle']
		raise: FileDoesNotExist! !

!FileSystemTest methodsFor: 'tests' stamp: 'S 6/17/2013 13:24'!
testDelete
	"Unlike ensureDelete, delete raises an exception if the file does not exist."
	| reference |
	
	reference := filesystem workingDirectory / 'does-not-exist'.
	self deny: reference exists.
	
	self 
		should: [ reference delete ]
		raise: FileDoesNotExist.
		
		
	reference := ( filesystem workingDirectory / 'file') ensureCreateFile.
	reference delete.
	
	self deny: reference exists. 
		
! !

!FileSystemTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testSetRelativeWorkingDirectory
	self 
		should: [filesystem workingDirectoryPath: (Path * 'plonk')]
		raise: Error
	! !

!FileSystemTest methodsFor: 'initialize-release' stamp: 'EstebanLorenzano 4/3/2012 11:42'!
setUp
	filesystem := self createFileSystem.
	toDelete := OrderedCollection new.! !

!FileSystemTest methodsFor: 'tests' stamp: 'S 6/17/2013 13:26'!
testMoveToFailingMissingSource
	| base folder |
	
	base := filesystem workingDirectory.
	
	folder := (base / 'folder') ensureCreateDirectory. 
	
	"Cleanup after running"
	self 
		markForCleanup: (base / 'folder' / 'newFile');
		markForCleanup: (base / 'folder').
	
	self deny: (base / 'file') exists.
	"Destination exists already"
	self should: [ (base / 'file') moveTo: (folder / 'newFile') ] raise: Error.
	self deny: (base / 'file') exists.
	self deny: (folder / 'newFile') exists.! !

!FileSystemTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testCreateDirectoryNoParent
	| path |
	path := Path * 'griffle' / 'nurp'.
	self 
		should: [filesystem createDirectory: path]
		raise: DirectoryDoesNotExist.
	
	
! !

!FileSystemTest methodsFor: 'tests' stamp: 'CamilloBruni 5/24/2013 14:31'!
testEntriesAt
	| directory entries |
	directory := Path * 'plonk'.
	
	filesystem createDirectory: directory.
	filesystem createDirectory: directory / 'griffle'.
	filesystem createDirectory: directory / 'bint'.
	
	self 
		markForCleanup: directory / 'griffle';
		markForCleanup: directory / 'bint';
		markForCleanup: directory.
	
	entries := filesystem entriesAt: directory.
	self assert: entries size = 2.
	entries do: [ :ea | 
		self assert: (ea isKindOf: FileSystemDirectoryEntry).
		self assert: ea reference parent path = (filesystem resolve: directory).
		self assert: (#('griffle' 'bint' ) includes: ea reference basename).
		self assert: ea isDirectory ]! !

!FileSystemTest methodsFor: 'tests-streams' stamp: 'CamilloBruni 8/31/2013 20:23'!
testReadStream
	| reference stream |
	self markForCleanup: (reference := filesystem workingDirectory / 'griffle').
	self should: [ reference readStream ] raise: FileDoesNotExist.
	reference writeStreamDo: [ :ws | ws nextPutAll: 'griffle' ].
	stream := reference readStream.
	self assert: stream contents asString equals: 'griffle'.
	stream close! !

!FileSystemTest methodsFor: 'tests' stamp: 'S 6/17/2013 13:24'!
testMoveToFailingMissingDestination
	| base file |
	
	base := filesystem workingDirectory.
	
	file := (base / 'file') ensureCreateFile.
	
	"Cleanup after running"
	self 
		markForCleanup: (base / 'folder' / 'newFile');
		markForCleanup: (base / 'folder') ;
		markForCleanup: (base / 'file').	
	
	"Destination exists already"
	self deny: (base / 'folder') exists.
	self should: [ file moveTo: (base / 'folder' / 'newFile') ] raise: Error.
	self assert: (base / 'file') exists.
	self deny: (base / 'folder' / 'newFile') exists.! !

!FileSystemTest methodsFor: 'tests-streams' stamp: 'CamilloBruni 5/24/2013 14:27'!
testReadStreamDo
	| reference |
	self markForCleanup: (reference := filesystem workingDirectory / 'griffle').
	self 
		should: [ reference readStreamDo: [ :stream | self assert: false ] ] 
		raise: FileDoesNotExist.
	reference writeStreamDo: [ :ws | ws nextPutAll: 'griffle' ].
	self assert: (reference readStreamDo: [ :stream | stream contents asString ]) 
		= 'griffle'! !

!FileSystemTest class methodsFor: 'testing' stamp: 'cwp 7/20/2009 08:56'!
shouldInheritSelectors
	^ true
	! !

!FileSystemTest class methodsFor: 'testing' stamp: 'EstebanLorenzano 4/3/2012 09:37'!
isAbstract
	^ self name = #FileSystemTest! !

!FileSystemTest class methodsFor: 'accessing' stamp: 'EstebanLorenzano 4/3/2012 12:53'!
packageNamesUnderTest
	^ #('FileSystem')! !

!FileSystemTreeTest commentStamp: 'TorstenBergmann 1/31/2014 11:39'!
SUnit tests for a file system tree!
!FileSystemTreeTest methodsFor: 'running' stamp: 'lr 7/13/2010 15:26'!
createDirectory: aString
	self subclassResponsibility! !

!FileSystemTreeTest methodsFor: 'running' stamp: 'lr 7/13/2010 15:26'!
createFile: aString
	self subclassResponsibility! !

!FileSystemTreeTest methodsFor: 'running' stamp: 'cwp 10/30/2009 13:32'!
setUpGreek
	self 
		createDirectory: '/alpha';
		createDirectory: '/alpha/beta';
		createFile: '/alpha/beta/gamma';
		createFile: '/alpha/beta/delta';
		createDirectory: '/alpha/epsilon';
		createFile: '/alpha/epsilon/zeta'! !

!FileSystemTreeTest class methodsFor: 'testing' stamp: 'EstebanLorenzano 4/3/2012 11:38'!
isAbstract
	^ self name = #FileSystemTreeTest! !

!FileSystemVisitor commentStamp: 'cwp 11/18/2009 12:25'!
I am an abstract superclass for objects that can perform operations on directory trees. My subclasses implement the visitor protocol, and process filesystem nodes shown to them by guides.!
!FileSystemVisitor methodsFor: 'visiting' stamp: 'cwp 11/15/2009 00:45'!
visitFile: aReference
	^ self visitReference: aReference! !

!FileSystemVisitor methodsFor: 'visiting' stamp: 'cwp 11/15/2009 00:45'!
visitReference: aReference! !

!FileSystemVisitor methodsFor: 'visiting' stamp: 'cwp 11/15/2009 00:45'!
visitDirectory: aReference
	^ self visitReference: aReference! !

!FileWriteError commentStamp: 'TorstenBergmann 2/3/2014 23:38'!
Notify about an error when trying to attempt to write to a file!
!FillStyle commentStamp: '<historical>'!
FillStyle is an abstract base class for fills in the BalloonEngine.!
!FillStyle methodsFor: 'converting' stamp: 'ar 6/4/2001 00:41'!
mixed: fraction with: aColor
	^self asColor mixed: fraction with: aColor! !

!FillStyle methodsFor: 'testing' stamp: 'ar 6/18/1999 07:57'!
isOrientedFill
	"Return true if the receiver keeps an orientation (e.g., origin, direction, and normal)"
	^false! !

!FillStyle methodsFor: 'testing' stamp: 'ar 11/9/1998 13:54'!
isBitmapFill
	^false! !

!FillStyle methodsFor: 'converting' stamp: 'Sd 11/2/2010 12:54'!
asColor
	^self subclassResponsibility ! !

!FillStyle methodsFor: 'testing' stamp: 'ar 10/26/2000 19:24'!
isTransparent
	^false! !

!FillStyle methodsFor: 'testing' stamp: 'gvc 3/20/2008 23:03'!
isCompositeFill
	"Answer whether the receiver is a composite fill.
	False by default."

	^false! !

!FillStyle methodsFor: 'testing' stamp: 'ar 11/9/1998 13:54'!
isGradientFill
	^false! !

!FillStyle methodsFor: 'testing' stamp: 'ar 11/9/1998 13:54'!
isSolidFill
	^false! !

!FillStyle methodsFor: 'accessing' stamp: 'ar 1/14/1999 15:23'!
scaledPixelValue32
	"Return a pixel value of depth 32 for the primary color in the fill style"
	^self asColor scaledPixelValue32! !

!FillStyle methodsFor: 'testing' stamp: 'ar 9/2/1999 14:28'!
isTranslucent
	^true "Since we don't know better"! !

!FillStyle methodsFor: '*Polymorph-Widgets' stamp: 'gvc 3/21/2008 16:35'!
fillRectangle: aRectangle on: aCanvas
	"Fill the given rectangle on the given canvas with the receiver."
	
	aCanvas fillRectangle: aRectangle basicFillStyle: self! !

!FillStyleBorder commentStamp: 'gvc 9/23/2008 11:56'!
BorderStyle supporting general (potentially composite) fillstyles. !
!FillStyleBorder methodsFor: 'drawing' stamp: 'gvc 6/24/2008 16:15'!
frameRectangle: aRectangle on: aCanvas
	"Fill the border areas with the fill style, clipping for each segment."
	
	(self borderRectsFor: aRectangle) do: [:r |
		aCanvas
			fillRectangle: r
			fillStyle: self fillStyle]! !

!FillStyleBorder methodsFor: 'accessing' stamp: 'gvc 6/24/2008 16:20'!
fillStyle: anObject
	"Set the value of fillStyle"

	fillStyle := anObject.
	anObject ifNotNil: [self baseColor: anObject asColor]! !

!FillStyleBorder methodsFor: 'accessing' stamp: 'gvc 6/24/2008 16:18'!
fillStyle
	"Answer the value of fillStyle"

	^fillStyle ifNil: [self color]! !

!FillStyleBorder methodsFor: 'testing' stamp: 'gvc 6/25/2008 12:11'!
hasFillStyle
	"Answer true."

	^true! !

!FillStyleBorder methodsFor: 'geometry' stamp: 'gvc 6/24/2008 16:19'!
borderRectsFor: aRectangle
	"Answer a collection of rectangles to fill.
	Just four here for a rectangular border."

	|rTop rBottom rLeft rRight w|
	w := self width.
	rTop := aRectangle topLeft corner: aRectangle right @ (aRectangle top + w).
	rBottom := aRectangle left @ (aRectangle bottom - w) corner: aRectangle bottomRight.
	rLeft := aRectangle left @ (aRectangle top + w) corner: aRectangle left + w @ (aRectangle bottom - w).
	rRight := aRectangle right - w @ (aRectangle top + w) corner: aRectangle right @ (aRectangle bottom - w).
	^{rTop. rBottom. rLeft. rRight}! !

!FilterTest commentStamp: 'TorstenBergmann 1/31/2014 11:30'!
SUnit test for debugger filters!
!FilterTest methodsFor: 'tests' stamp: 'AndreiChis 9/30/2013 11:01'!
testKernelClassesFilter
	| kernelClassesFilter setContext |
	
	setContext := session stepInto stepInto stack first.
	kernelClassesFilter := KernelClassesFilter new.
	self assert: (kernelClassesFilter shouldDisplay: context).
	self assert: (kernelClassesFilter shouldDisplay: nilContext).
	self deny: (kernelClassesFilter shouldDisplay: setContext)! !

!FilterTest methodsFor: 'tests' stamp: 'AndreiChis 9/30/2013 11:01'!
testSelectorFilter
	| doItFilter nilMessagesFilter |
	
	doItFilter := SelectorFilter forSelector: #doIt.
	self assert: (doItFilter shouldDisplay: context).
	self assert: (doItFilter shouldDisplay: nilContext).
	nilMessagesFilter := SelectorFilter forSelectors: (OrderedCollection with: #isNil with: #ifNil:).
	self assert: (nilMessagesFilter shouldDisplay: context)	"self deny: (nilMessagesFilter shouldDisplay: otherSession context)"! !

!FilterTest methodsFor: 'tests' stamp: 'AndreiChis 9/30/2013 11:01'!
testBooleanFilter
	| kernelFilter doItFilter filters booleanFilter |
	
	kernelFilter := KernelClassesFilter new.
	doItFilter := SelectorFilter forSelector: #doIt.
	filters := OrderedCollection with: kernelFilter with: doItFilter.
	booleanFilter := BooleanFilter withFilters: filters operator: #or:.
	self assert: (booleanFilter shouldDisplay: context)! !

!FilterTest methodsFor: 'running' stamp: 'AndreiChis 9/30/2013 11:00'!
setUp

	context := [ (Set with: 1 with: 2) collect: [ :e | e * 2 ]. self halt ] asContext.
	process := Process 
		forContext: context 
		priority: Processor userInterruptPriority.
	session := DebugSession 
		process: process 
		context: context.
	nilContext := [ self isNil ] asContext.
	otherProcess := Process 
		forContext: nilContext 
		priority: Processor userInterruptPriority.
	otherSession := (DebugSession 
		process: otherProcess 
		context: nilContext) stepInto! !

!FilterTest methodsFor: 'tests' stamp: 'AndreiChis 9/30/2013 11:01'!
testBlockFilter
	| fromBlockFilter |
	
	fromBlockFilter := [ :ctx | ctx isNotNil ] asFilter.
	self assert: (fromBlockFilter shouldDisplay: context)! !

!FindReplaceService commentStamp: 'TorstenBergmann 1/31/2014 12:21'!
Model for a find and replace service in editors!
!FindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 11/10/2010 19:39'!
findStartIndex
	^ findStartIndex! !

!FindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 11/10/2010 12:35'!
isRegex
	^ isRegex ifNil: [isRegex := false]! !

!FindReplaceService methodsFor: 'services' stamp: 'AlainPlantec 11/18/2010 09:08'!
findRegex
	| s |
	s := self entireWordsOnly
		ifTrue: ['\<', self regexString, '\>']
		ifFalse: [ self regexString].
	[^ self caseSensitive
			ifTrue: [s asRegex]
			ifFalse: [s asRegexIgnoringCase]]
		on: Error 
		do: [self changed: #regexError. 
			^ '' asRegex]
! !

!FindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 11/17/2010 15:50'!
findTextSilently: aStringOrText
	findText := aStringOrText asText.
	self changed: #findText! !

!FindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 11/10/2010 12:47'!
replaceText
	^ replaceText ifNil: [replaceText := '']! !

!FindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 11/12/2010 21:23'!
isRegex: aBoolean
	isRegex := aBoolean.
	self changed: #findPolicy
! !

!FindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 11/16/2010 08:34'!
replaceText: aStringOrText
	replaceText := aStringOrText asString.
	self changed: #findPolicy
! !

!FindReplaceService methodsFor: 'services' stamp: 'AlainPlantec 4/27/2011 15:34'!
replaceInTextMorph: aTextMorph

	findStartIndex := self searchBackwards 
		ifTrue: [aTextMorph editor stopIndex] 
		ifFalse: [aTextMorph editor startIndex].
	(self findInTextMorph: aTextMorph)
		ifNotNil: [aTextMorph replaceSelectionWith: self replaceText]! !

!FindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 11/12/2010 21:24'!
wrapAround: aBoolean
	wrapAround := aBoolean.
	self changed: #findPolicy

! !

!FindReplaceService methodsFor: 'services' stamp: 'BernardoContreras 3/19/2015 19:58'!
findNextSubstring: aSubstring inTextMorph: aTextMorph
	| where  |
	findStartIndex 
		ifNil: [findStartIndex := aTextMorph editor startIndex].
	findStartIndex > 0 
		ifTrue: [where := aTextMorph findNextString: aSubstring asString startingAt: findStartIndex].
	(where isNil and: [self wrapAround])
		ifTrue: [where := aTextMorph findNextString: aSubstring asString startingAt: 1].
	^ where
! !

!FindReplaceService methodsFor: 'services' stamp: 'AlainPlantec 4/27/2011 15:26'!
findNextSubString: aSubString inTextMorph: aTextMorph
	| where  |
	findStartIndex 
		ifNil: [findStartIndex := aTextMorph editor startIndex].
	findStartIndex > 0 
		ifTrue: [where := aTextMorph findNextString: aSubString asString startingAt: findStartIndex].
	(where isNil and: [self wrapAround])
		ifTrue: [where := aTextMorph findNextString: aSubString asString startingAt: 1].
	^ where
! !

!FindReplaceService methodsFor: 'accessing' stamp: 'NicolaiHess 2/3/2015 22:43'!
convertedFindString
	| specials |
	specials := '^$:\+*[](){}'.
	^String 
		streamContents: [:s | self findString 
			do: [:c | (specials includes: c) ifTrue: [s nextPut:$\].
				s nextPut: c]]! !

!FindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 11/17/2010 15:55'!
findText
	^ (findText ifNil: [findText := '' asText. findText]) asString! !

!FindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 11/12/2010 21:23'!
searchBackwards: aBoolean
	searchBackwards := aBoolean.
	self changed: #findPolicy
! !

!FindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 11/12/2010 21:22'!
caseSensitive: aBoolean
	caseSensitive := aBoolean.
	self changed: #findPolicy! !

!FindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 11/12/2010 08:19'!
findText: aStringOrText isRegex: aBoolean entireWordsOnly: forEntireWordsOnly
		self isRegex: aBoolean.
		self findText: aStringOrText.
		self entireWordsOnly: forEntireWordsOnly! !

!FindReplaceService methodsFor: 'services' stamp: 'AlainPlantec 11/11/2010 23:46'!
replaceAllInTextMorph: aTextMorph
	| startIdx |
	startIdx := self wrapAround ifTrue: [1] ifFalse: [aTextMorph editor selectionInterval first].
	aTextMorph replaceAll: self findRegex with: self replaceText startingAt: startIdx
! !

!FindReplaceService methodsFor: 'services' stamp: 'AlainPlantec 11/21/2010 22:00'!
findInTextMorph: aTextMorph
	| where  |
	findStartIndex 
		ifNil: [findStartIndex := self searchBackwards 
			ifTrue: [aTextMorph editor stopIndex]
			ifFalse: [aTextMorph editor startIndex]].
	findStartIndex > 0 
		ifTrue: [where := aTextMorph
			findAndSelect: self findRegex
			startingAt: findStartIndex
			searchBackwards: self searchBackwards].
	(where isNil and: [self wrapAround])
		ifTrue: [ | idx |
			idx := self searchBackwards ifTrue: [aTextMorph editor string size] ifFalse: [1].
			where := aTextMorph
				findAndSelect: self findRegex
				startingAt: idx
				searchBackwards: self searchBackwards].
	where ifNil: [aTextMorph flash].
	^ where
! !

!FindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 11/17/2010 15:59'!
regexString
	^ self isRegex 
		ifTrue: [self findString]
		ifFalse: [self convertedFindString]
! !

!FindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 11/12/2010 12:08'!
findText: aStringOrText isRegex: isReg caseSensitive: isCaseSensitive entireWordsOnly: forEntireWordsOnly
		self isRegex: isReg.
		self findText: aStringOrText.
		self entireWordsOnly: forEntireWordsOnly.
		self caseSensitive: isCaseSensitive! !

!FindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 11/10/2010 12:35'!
wrapAround
	^ wrapAround ifNil: [wrapAround := true]! !

!FindReplaceService methodsFor: 'updating' stamp: 'AlainPlantec 11/10/2010 19:43'!
updateFindStartIndexForTextMorph: aTextMorph
	| si |
	si := aTextMorph editor selectionInterval.
	self findStartIndex: (self searchBackwards ifTrue: [si first - 1] ifFalse: [si last + 1])! !

!FindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 11/12/2010 21:22'!
entireWordsOnly: aBoolean
	entireWordsOnly := aBoolean.
	self changed: #findPolicy! !

!FindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 11/17/2010 15:59'!
selectionRegexString
	^ self convertedFindString
! !

!FindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 11/26/2010 17:56'!
findText: aStringOrText isRegex: aBoolean
		self isRegex: aBoolean.
		self findText: aStringOrText.
		self replaceText: ''.
! !

!FindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 11/12/2010 12:06'!
caseSensitive
	^ caseSensitive ifNil: [caseSensitive := TextEditor caseSensitiveFinds]! !

!FindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 11/17/2010 15:49'!
findText: aStringOrText
	findText := aStringOrText asText.
	self changed: #findPolicy! !

!FindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 11/10/2010 12:35'!
searchBackwards
	^ searchBackwards ifNil: [searchBackwards := false]! !

!FindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 11/10/2010 12:35'!
entireWordsOnly
	^ entireWordsOnly ifNil: [entireWordsOnly := false]! !

!FindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 11/17/2010 15:55'!
findString
	^ self findText asString! !

!FindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 11/10/2010 19:39'!
findStartIndex: anInteger
	findStartIndex := anInteger! !

!FindReplaceService class methodsFor: 'accessing' stamp: 'AlainPlantec 11/12/2010 21:07'!
default
	^ EditorFindReplaceDialogWindow singleton state
! !

!Finder commentStamp: 'BenjaminVanRyseghem 9/15/2010 11:17'!
I'm the finderUI model in the MVC pattern.

I'm compute the search string and I construct a resultDictionary.
Then I throw events everywhere and my views are redrawn.!
!Finder methodsFor: 'private' stamp: 'sd 4/21/2011 15:56'!
resetEnvironment
	"I send an event when I reset the environment"
	self environment: self defaultEnvironment.
	self triggerEvent: #resetEnvironment.! !

!Finder methodsFor: 'accessing' stamp: 'sd 4/21/2011 15:55'!
searchingString: aString
	"When the search string is modified (in fact, when I make a search) I rebuild the result dictionary"

	searchingString := aString.
	self constructDictionary.! !

!Finder methodsFor: 'private-pragma' stamp: 'BenjaminVanRyseghem 2/21/2012 08:46'!
constructDictionaryWithPragmaSearch: aString 
	"construct dictionary when searching for pragmas"
	
	| dictionary |
	dictionary := self pragmaSearch: aString.
	dictionary keysDo:[ :k || result |
		result := Dictionary new.
		(dictionary at: k) do: [:method || key value |
				key := method selector.
				value := method methodClass.
				(result 
					at: key
					ifAbsentPut: OrderedCollection new ) add: value].
		dictionary at: k put: result ].
	self resultDictionary: dictionary.! !

!Finder methodsFor: 'private' stamp: 'BenComan 12/6/2014 15:08'!
methodSearch: aSelectBlock 
	| result | 
	result := OrderedCollection new.
	
	self packagesSelection classesAndTraits do:[ :class |
			class methodsDo: [ :method | 
				(aSelectBlock value: method) ifTrue: [ result add: method ]].
			class classSide methodsDo: [ :method | 
				(aSelectBlock value: method) ifTrue: [ result add: method ]]
			]
			displayingProgress: [ :aClass | aClass name ].
	^ result! !

!Finder methodsFor: 'accessing' stamp: 'sd 4/21/2011 15:55'!
selectedMethod
	"I should answer a CompiledMethod"
	^selectedMethod! !

!Finder methodsFor: 'initialization' stamp: 'sd 4/21/2011 15:50'!
initialize
	super initialize.
	searchingString := self defaultString.
	environment := self defaultEnvironment.
	packagesSelection := self defaultPackagesSelection.
	resultDictionary := Dictionary new.
	currentSearchMode := #Selectors.
	useRegEx := false.
	! !

!Finder methodsFor: 'accessing' stamp: 'sd 4/21/2011 15:50'!
environment: aCollection

	 environment := aCollection! !

!Finder methodsFor: 'accessing' stamp: 'sd 4/21/2011 15:55'!
searchingString

	^searchingString! !

!Finder methodsFor: 'private-class' stamp: 'CamilloBruni 10/10/2012 13:56'!
computeListOfClasses: aString
	"Compute in the case I'm searching class names"
		
	^ self useRegEx
		ifTrue: [ | regex |
			regex := aString asRegex.
			self classSearch: [ :class | regex search: class name ]]
		ifFalse: [ 
			self classSearch: [ :class |
				class name includesSubstring: aString caseSensitive: false ]].! !

!Finder methodsFor: 'default' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
defaultPackagesSelection
	 ^ self environment! !

!Finder methodsFor: 'accessing' stamp: 'sd 4/21/2011 15:56'!
packagesSelection: aCollection
	"I change the classes selection, then I rebuild the result dictionary"
	packagesSelection :=  aCollection.
	self constructDictionary.! !

!Finder methodsFor: 'accessing' stamp: 'sd 4/21/2011 15:55'!
resultDictionary: aDictionary
	"When the result dictionary is update, I send an event through the whole universe"

	resultDictionary := aDictionary.
	self triggerEvent: #updateResultDictionary.
	self selectedMethod: nil.
	self selectedClass: nil.
	self triggerEvent: #updateSourceCode.! !

!Finder methodsFor: 'private' stamp: 'sd 4/21/2011 15:49'!
enableUseRegEx
	"send a enable useRegEx dropbox event"
	^ self triggerEvent: #enableUseRegEx! !

!Finder methodsFor: 'private' stamp: 'CamilloBruni 10/9/2012 20:47'!
sourceSearch: aSearchString
	"I'm searching in sources"
	^ self useRegEx
		ifTrue: [ self sourceRegexSearch: aSearchString ]
		ifFalse:[ self sourceStringSearch: aSearchString ].! !

!Finder methodsFor: 'private-example' stamp: 'MarcusDenker 10/23/2014 17:12'!
computeWithMethodFinder: aString
	"Compute the selectors for the single example of receiver and args, in the very top pane"

	| data result resultArray dataStrings methodFinder dataObjects temporarySearchResult statements |
	(aString includes: $.)
		ifFalse: [ ^ #() ].	"delete trailing period. This should be fixed in the Parser!!"
	data := aString trimRight: [ :char | char isSeparator or: [ char = $. ] ].
	methodFinder := MethodFinder new.
	data := methodFinder cleanInputs: data.	"remove common mistakes"
	[ dataObjects := Smalltalk compiler evaluate: '{' , data , '}' ]
		on: SyntaxErrorNotification
		do: [ :e | 
			self inform: 'Syntax Error: ' , e errorMessage.
			^ #() ].	"#( data1 data2 result )"
	statements := (self class compiler parse: 'zort ' , data) body statements reject: [ :each | each isReturn ].
	dataStrings := statements
		collect: [ :node | 
			String
				streamContents: [ :strm | 
					node isMessage
						ifTrue: [ strm nextPut: $( ].
					strm << node formattedCode.
					node isMessage
						ifTrue: [ strm nextPut: $) ] ] ].
	dataObjects size < 2
		ifTrue: [ 
			self
				inform:
					'If you are giving an example of receiver, \args, and result, please put periods between the parts.\Otherwise just type one selector fragment'
						withCRs.
			^ #() ].
	dataObjects := Array with: dataObjects allButLast with: dataObjects last.	"#( (data1 data2) result )"
	result := methodFinder
		load: dataObjects;
		findMessage.
	(result first beginsWith: 'no single method')
		ifFalse: [ 
			temporarySearchResult := self testObjects: dataObjects strings: dataStrings.
			dataObjects := temporarySearchResult second.
			dataStrings := temporarySearchResult third ].
	resultArray := self listFromResult: result.
	resultArray isEmpty
		ifTrue: [ self inform: result first ].
	dataStrings size = (dataObjects first size + 1)
		ifTrue: [ 
			resultArray := resultArray
				collect: [ :expression | 
					| newExp |
					newExp := expression.
					dataObjects first
						withIndexDo: [ :lit :i | newExp := newExp copyReplaceAll: 'data' , i printString with: (dataStrings at: i) ].
					newExp , ' --> ' , dataStrings last ] ].
	^ resultArray! !

!Finder methodsFor: 'private-selector' stamp: 'sd 4/21/2011 15:40'!
constructDictionaryWithMessagesNameSearch: aString
	"Construct dictionary when searching for selector"
	
	| result listOfMethods |
	result := Dictionary new.
	listOfMethods := self messagesNameSearch: aString.
	listOfMethods do: [:method || key value |
			key := method selector.
			value := method methodClass.
			(result includesKey: key)
				ifTrue: [ (result at: key) add: value]
				ifFalse: [ result at: key put: (OrderedCollection new add: value; yourself)]].
	self resultDictionary: result.! !

!Finder methodsFor: 'accessing' stamp: 'sd 4/21/2011 15:52'!
useRegEx
	"I should answer a boolean that tells whether regExpression should be taken into account"
	 ^ useRegEx! !

!Finder methodsFor: 'default' stamp: 'sd 4/21/2011 15:52'!
uiClass
	"Answer the class used to create UI"
	 ^FinderUI! !

!Finder methodsFor: 'default' stamp: 'NicolaiHess 12/5/2014 20:48'!
defaultEnvironment
	 ^ RBBrowserEnvironment new! !

!Finder methodsFor: 'private' stamp: 'NicolaiHess 12/5/2014 21:38'!
classSearch: aSelectBlock
	| result |
	result := OrderedCollection new.
	self packagesSelection classesAndTraitsDo:[ :class | 
			(aSelectBlock value: class)
				ifTrue: [ result add: class ] ].
	^ result! !

!Finder methodsFor: 'accessing' stamp: 'sd 4/21/2011 15:49'!
currentSearchMode
	"Getter"
	"I shoud answer a Symbol in :
		- #Selectors
		- #Classes
		- #Source
		- #Examples"
	
	 ^ currentSearchMode! !

!Finder methodsFor: 'private-selector' stamp: 'CamilloBruni 10/10/2012 11:20'!
messageSearchBlockFrom: aString
	| exactMatch |
	
	exactMatch := aString first = $" and: [ aString last = $"].
	
	exactMatch ifFalse: [ 
		^ [ :method | 
			method selector includesSubstring: aString caseSensitive: false ]].
		
	 ^ (Symbol findInterned: (aString copyFrom: 2 to: aString size - 1))
		ifNil: [  nil ]
		ifNotNil: [ :aSymbol | 
			[ :method | method selector = aSymbol ]].! !

!Finder methodsFor: 'display' stamp: 'FernandoOlivero 5/30/2011 09:59'!
open
	^ (self uiClass on: self) open! !

!Finder methodsFor: 'accessing' stamp: 'sd 4/21/2011 15:55'!
resultDictionary
	"I should answer a dictionary"
	^resultDictionary! !

!Finder methodsFor: 'private-class' stamp: 'MarcusDenker 5/7/2013 23:28'!
constructClassNamesDictionary
	"Construct the dictionary in the case I'm searching in class names"
	
	| result listOfClasses |
	listOfClasses := self computeListOfClasses: self searchingString.
	result := Dictionary new.
	listOfClasses do: [:each | 
		result at: each put: (each selectors sort: [:a :b | a < b])].
	self resultDictionary: result.! !

!Finder methodsFor: 'private' stamp: 'MarcusDenker 5/18/2013 15:44'!
findSelector: aString
	"Answer the selector of aString."

	| example tokens |
	example := aString.
	tokens := example parseLiterals.
	tokens size = 1 ifTrue: [^ tokens first].
	tokens first == #'^' ifTrue: [^ nil].
	(tokens second includes: $:) ifTrue: [^ example findSelector].
	Symbol hasInterned: tokens second ifTrue: [:aSymbol | ^ aSymbol].
	^ nil! !

!Finder methodsFor: 'checkbox' stamp: 'BenjaminVanRyseghem 5/14/2012 13:45'!
isClassNamesSymbol
	"answer if the current mode is Classes"
	^self currentSearchMode = #Classes! !

!Finder methodsFor: 'private' stamp: 'CamilloBruni 10/10/2012 14:07'!
testObjects: dataObjects strings: dataStrings
	"Try to make substitutions in the user's inputs and search for the selector again.
		1 no change to answer.
		2 answer Array -> OrderedCollection.
		2 answer Character -> String
		4 answer Symbol or String of len 1 -> Character
	For each of these, try straight, and try converting args:
		Character -> String
		Symbol or String of len 1 -> Character
	Return array with result, dataObjects, dataStrings.  Don't ever do a find on the same set of data twice."

	| selectors classes didUnmodifiedAnswer |
	
	selectors := {#asString. #first. #asOrderedCollection}.
	classes := {Character. String. Array}.
	didUnmodifiedAnswer := false.
	
	selectors withIndexDo: [:ansSel :ansInd | | tempDataObjects result tempDataStrings answerMod | 
		"Modify the answer object"
		answerMod := false.
		tempDataObjects := dataObjects copyTwoLevel.  
		tempDataStrings := dataStrings copy.
		(dataObjects last isKindOf: (classes at: ansInd)) ifTrue: [
			((ansSel ~~ #first) or: [dataObjects last size = 1]) ifTrue: [
				tempDataObjects at: tempDataObjects size put: (tempDataObjects last perform: ansSel).	"asString"
				tempDataStrings at: tempDataStrings size put: tempDataStrings last, ' ', ansSel.
				result := MethodFinder new load: tempDataObjects; findMessage.
				(result first beginsWith: 'no single method') ifFalse: [
					"found a selector!!"
					^ Array with: result first with: tempDataObjects with: tempDataStrings].	
				answerMod := true]].

		selectors allButLast withIndexDo: [:argSel :argInd | | dds ddo | 
			"Modify an argument object"
			"for args, no reason to do Array -> OrderedCollection.  Identical protocol."
			didUnmodifiedAnswer not | answerMod ifTrue: [
			ddo := tempDataObjects copyTwoLevel. 
			dds := tempDataStrings copy.
			dataObjects first withIndexDo: [:arg :ind |
				(arg isKindOf: (classes at: argInd))  ifTrue: [
					((argSel ~~ #first) or: [arg size = 1]) ifTrue: [
						ddo first at: ind put: ((ddo first at: ind) perform: argSel).	"asString"
						dds at: ind put: (dds at: ind), ' ', argSel.
						result := MethodFinder new load: ddo; findMessage.
						(result first beginsWith: 'no single method') ifFalse: [
							"found a selector!!"
						^ Array with: result first with: ddo with: dds].	
					didUnmodifiedAnswer not & answerMod not ifTrue: [
						didUnmodifiedAnswer := true].
					]]]]].
	].
	^ Array with: 'no single method does that function' with: dataObjects with: dataStrings! !

!Finder methodsFor: 'checkbox' stamp: 'SeanDeNigris 6/25/2012 15:06'!
isExamplesSymbol
	"Answer if the current mode is Examples"
	^self currentSearchMode = #Examples! !

!Finder methodsFor: 'private-selector' stamp: 'CamilloBruni 10/10/2012 11:17'!
messagesNameSearch: aString
	"I'm searching for selectors"
	^ self useRegEx
		ifTrue: [ | regex |
			regex := aString asRegex.
			self methodSearch: [ :method| 	regex search: method selector asString ]]
		ifFalse: [
			self methodSearch: (self messageSearchBlockFrom: aString)].! !

!Finder methodsFor: 'checkbox' stamp: 'BenjaminVanRyseghem 9/15/2010 23:23'!
isSelectorsSymbol
"answer if the current mode is Selectors"
	^self currentSearchMode = #Selectors! !

!Finder methodsFor: 'accessing' stamp: 'SeanDeNigris 6/25/2012 15:05'!
currentSearchMode: aSymbol
	"Setter"
	"If #Examples is selected, I disable the RegEx checkbo. Then I rebuild the resultDictionary"

	currentSearchMode := aSymbol.
	self isExamplesSymbol
		ifTrue: [ self disableUseRegEx]
		ifFalse:[ self enableUseRegEx].
		
	self update: #sourceCode.
	self constructDictionary! !

!Finder methodsFor: 'accessing' stamp: 'NicolaiHess 12/5/2014 21:07'!
environment
	 ^ environment ! !

!Finder methodsFor: 'accessing' stamp: 'sd 4/21/2011 15:55'!
selectedMethod: aMethod
	"When the method seletion is changed, I send an event to UI"
	selectedMethod := aMethod.
	self triggerEvent: #updateSelectedMethod! !

!Finder methodsFor: 'accessing' stamp: 'sd 4/21/2011 15:55'!
selectedClass: aClass
	"When the class seletion is changed, I send an event to UI"
	selectedClass := aClass.
	self triggerEvent: #updateSelectedClass
	! !

!Finder methodsFor: 'private' stamp: 'sd 4/21/2011 15:57'!
listFromResult: resultOC
	"The argument, resulOC, is of the form #('(data1 op data2)' '(...)'). Answer a sorted array."

	(resultOC first beginsWith: 'no single method') ifTrue: [^ #()].
	^ resultOC sort: [:a :b | 
		(a copyFrom: 6 to: a size) < (b copyFrom: 6 to: b size)].
! !

!Finder methodsFor: 'accessing' stamp: 'NicolaiHess 11/30/2013 14:29'!
selection: aSelectionHolder
	"anObject is a selection holder"
	"Depending of the value of currentSearchMode, I fill selectedMethod and SelectedClass with the good items."
	"Then, I update the source code text area"

	| path methodNode method classNode class |
	(aSelectionHolder isNil or: [aSelectionHolder selectedNodePath isNil]) ifTrue: [
		self selectedClass: nil.
		self selectedMethod: nil.
		^self].
	path := aSelectionHolder selectedNodePath.
	self isSelectorsSymbol
		ifTrue: [
			path first isSingle
				ifTrue: [
					method := path first itemMethod selector.
					class := path first itemMethod methodClass ]
				ifFalse: [
					methodNode := path first.
					classNode := path at: 2 ifAbsent: [ nil ]]].
	self isClassNamesSymbol
		ifTrue: [
			classNode := path first.
			methodNode := path at: 2 ifAbsent:[nil]].
	self isSourceSymbol
		ifTrue: [
			methodNode := path first.
			classNode := path at: 2 ifAbsent:[nil]].
	self isExamplesSymbol
		ifTrue: [
			methodNode := path first.
			classNode := path at: 2 ifAbsent:[nil]].
	self isPragmasSymbol
		ifTrue: [
			methodNode := path at:2 ifAbsent: [ nil ].
			classNode := path at: 3 ifAbsent:[nil]].		

	classNode ifNotNil: [ class := classNode item ].
	self selectedClass: class.
	
	methodNode ifNotNil: [ method := methodNode item ].
	self selectedMethod: method.
	
	self triggerEvent: #updateSourceCode! !

!Finder methodsFor: 'private-example' stamp: 'NicolaiHess 12/5/2014 21:28'!
constructDictionaryWithMethodFinder: aString
	"construct dictionary when searching patterns"

	| result listOfStrings listOfSelectors |
	result := Dictionary new.
	listOfStrings := self computeWithMethodFinder: aString.
	listOfSelectors := listOfStrings collect: [ :each | self findSelector: each ].
	self packagesSelection classesDo:[ :class | 
			class methodsDo:  [ :method | 
					| index |
					(index := listOfSelectors indexOf: method selector) = 0
						ifFalse: [ 
							| key value |
							key := listOfStrings at: index.
							value := method methodClass.
							(result includesKey: key)
								ifTrue: [ (result at: key) add: value ]
								ifFalse: [ 
									result
										at: key
										put:
											(OrderedCollection new
												add: value;
												yourself) ] ] ] ].
	self resultDictionary: result! !

!Finder methodsFor: 'accessing' stamp: 'sd 4/21/2011 15:51'!
useRegEx: aBoolean

	useRegEx :=  aBoolean.! !

!Finder methodsFor: 'checkbox' stamp: 'sd 4/21/2011 15:50'!
isSourceSymbol
	"answer if the current mode is Source"
	^self currentSearchMode = #Source! !

!Finder methodsFor: 'private' stamp: 'CamilloBruni 10/9/2012 20:47'!
sourceRegexSearch: aSearchString
	| regex |
	regex := aSearchString asRegex.
	^ self methodSearch: [ :method | regex search: method sourceCode ]! !

!Finder methodsFor: 'accessing' stamp: 'sd 4/21/2011 15:55'!
selectedClass

	^selectedClass! !

!Finder methodsFor: 'private' stamp: 'CamilloBruni 10/9/2012 20:47'!
sourceStringSearch: aSearchString 
	^ self 
		methodSearch: [ :method |
			method sourceCode includesSubstring: aSearchString caseSensitive: false ]! !

!Finder methodsFor: 'private' stamp: 'MarcusDenker 10/15/2013 18:14'!
constructDictionary
	"I construct the adequate dictionary regarding the search mode"

	self searchingString isEmpty ifTrue: [ ^ self resultDictionary: Dictionary new].
	[ :job|
		job title: 'Searching...'.
		self isSelectorsSymbol
			ifTrue: [ self constructDictionaryWithMessagesNameSearch: self searchingString].
		self isClassNamesSymbol
			ifTrue: [ self constructClassNamesDictionary].
		self isSourceSymbol
			ifTrue: [ self constructSourceDictionary].
		self isExamplesSymbol
			ifTrue: [ self constructDictionaryWithMethodFinder: self searchingString].
		self isPragmasSymbol
			ifTrue: [ self constructDictionaryWithPragmaSearch: self searchingString ].
	] asJob run! !

!Finder methodsFor: 'private' stamp: 'CamilloBruni 10/9/2012 20:51'!
constructSourceDictionary
"construct dictionary when searching source"
	| result listOfMethods |
	result := Dictionary new.
	listOfMethods := self sourceSearch: self searchingString.
	listOfMethods do: [:method || key value |
		key := method selector.
		value := method methodClass.
		(result includesKey: key)
			ifTrue: [ (result at: key) add: value]
			ifFalse: [ result at: key put: (OrderedCollection new add: value; yourself)]].
	self resultDictionary: result.! !

!Finder methodsFor: 'private-pragma' stamp: 'CamilloBruni 10/10/2012 13:59'!
pragmaSearch: aString 
	| result byCondition |
	" I choose a dictionary here because the next step is to group result by pragmas "
	result := Dictionary new.
	
	byCondition :=  self useRegEx 
		ifTrue: [[ :pragma | pragma keyword matchesRegexIgnoringCase: aString ]]
		ifFalse: [[ :pragma | pragma keyword includesSubstring: aString caseSensitive: false ]].
				
	(PragmaCollector filter: byCondition) reset; 
		do: [ :pragma || pragmaName |
			pragmaName := String streamContents: [:s |
								s << '<'; << pragma keyword; << '>' ].
			(result at: pragmaName ifAbsentPut: OrderedCollection new)				
				add: pragma method ].
	^ result! !

!Finder methodsFor: 'default' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
defaultString
	^''! !

!Finder methodsFor: 'private' stamp: 'sd 4/21/2011 15:49'!
disableUseRegEx
	"send a disable useRegEx dropbox event"
	^ self triggerEvent: #disableUseRegEx! !

!Finder methodsFor: 'accessing' stamp: 'sd 4/21/2011 15:56'!
packagesSelection
	"I should be a selection of classes"
	^packagesSelection! !

!Finder methodsFor: 'accessing' stamp: 'bvr 9/19/2010 18:27'!
searchingStringSilently: aString
	searchingString := aString.
! !

!Finder methodsFor: 'checkbox' stamp: 'BenjaminVanRyseghem 5/14/2012 13:49'!
isPragmasSymbol
"answer if the current mode is Pragmas"
	^self currentSearchMode = #Pragmas! !

!Finder class methodsFor: 'menu' stamp: 'AlainPlantec 2/14/2011 21:25'!
open
	^ self new open! !

!Finder class methodsFor: 'menu' stamp: 'TorstenBergmann 2/12/2014 09:22'!
finderMenuOn: aBuilder 
	"I build a menu"
	<worldMenu>
	(aBuilder item: #Finder)
		action: [self open];
		order: 0.10;
		parent: #Tools;
		help: 'Looking for something ?';
		icon: self icon.
	aBuilder withSeparatorAfter.	! !

!Finder class methodsFor: 'tools registry' stamp: 'IgorStasenko 2/19/2011 03:02'!
registerToolsOn: registry
	"Add ourselves to registry. See [Smalltalk tools]" 

	registry register: self as: #finder

	! !

!Finder class methodsFor: 'menu' stamp: 'BenjaminVanRyseghem 3/18/2011 11:30'!
icon
	"My menu icon"
	^ FinderUI icon! !

!FinderClassNode commentStamp: '<historical>'!
A FinderClassNode is a node used by the FinderUI's tree representing a Class!
!FinderClassNode methodsFor: 'private' stamp: 'BenjaminVanRyseghem 2/8/2012 17:08'!
browseClass

	^ Smalltalk tools browser fullOnClass: self item selector: self parentNode item! !

!FinderClassNode methodsFor: 'private' stamp: 'BenjaminVanRyseghem 1/7/2012 18:11'!
browseReferences

	self systemNavigation browseAllCallsOnClass: self item.! !

!FinderClassNode methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 2/26/2011 12:46'!
keyStroke: anEvent
	(anEvent controlKeyPressed or: [ anEvent commandKeyPressed ]) ifFalse: [ ^ false ].
	anEvent keyCharacter == $h ifTrue: [ ^ self browseHierarchy ].
	anEvent keyCharacter == $N ifTrue: [ ^ self browseReferences ].
	^ super keyStroke: anEvent.! !

!FinderClassNode methodsFor: 'private' stamp: 'BenjaminVanRyseghem 1/7/2012 18:11'!
browseHierarchy

	self systemNavigation browseHierarchy: self item! !

!FinderClassNode methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/15/2010 12:06'!
childrenItems
	"I search the children, if I have not got any, I call my super method"
	^ (self model resultDictionary at: self item ifAbsent:[^super childrenItems])! !

!FinderClassNode methodsFor: 'accessing' stamp: 'AlainPlantec 2/13/2011 21:03'!
childNodeClassFromItem: anItem 
	"The children (if there are some) are instances of
	FinderMethodNode (in the case of a Classes research)"
	^ FinderMethodNode ! !

!FinderClassNode methodsFor: 'private' stamp: 'BenjaminVanRyseghem 2/8/2012 17:08'!
browse

	self hasParentNode ifFalse: [ ^ super browseClass ].
	^ self browseClass! !

!FinderClassNode methodsFor: 'event handling' stamp: 'StephaneDucasse 10/22/2014 21:31'!
menu: menu shifted: aBoolean
	menu
		add: 'Hierarchy (h)'
		target: self
		selector: #browseHierarchy.
	menu
		add: 'References (N)'
		target: self
		selector: #browseReferences.
	^ super menu: menu shifted: aBoolean.! !

!FinderExampleClassNode commentStamp: '<historical>'!
A FinderExampleClassNode is a node used by the FinderUI's tree representing the Class for the method deduced
from an examples (by MethodFinder)!
!FinderExampleClassNode methodsFor: 'private' stamp: 'NicolaiHess 12/22/2013 00:25'!
displayString
	(self parentNode receiver isKindOf: self item)
		ifTrue: [ ^ '*' , super displayString ].
	^ super displayString! !

!FinderExampleMethodNode commentStamp: '<historical>'!
A FinderExampleMethodNode is a node used by the FinderUI's tree representing a Method deduced
from an examples (by MethodFinder)!
!FinderExampleMethodNode methodsFor: 'private' stamp: 'MarcusDenker 7/9/2014 13:15'!
selector
	^ self model finder findSelector: self item! !

!FinderExampleMethodNode methodsFor: 'private' stamp: 'MarcusDenker 7/9/2014 13:15'!
receiver
	| index rec |
	index := self item findString: self selector.
	rec := self item copyFrom: 1 to: index - 1.
	^ Smalltalk compiler evaluate: rec! !

!FinderExampleMethodNode methodsFor: 'private' stamp: 'MarcusDenker 7/9/2014 13:15'!
childNodeClassFromItem: anItem
	"I answer the class of my children nodes (if I have some)"

	^ FinderExampleClassNode! !

!FinderMethodNode commentStamp: '<historical>'!
A FinderMethodNode is a node used by the FinderUI's tree representing a Method!
!FinderMethodNode methodsFor: 'events handling' stamp: 'BenjaminVanRyseghem 2/26/2011 12:49'!
addInspectMenuItem: menu

	self hasParentNode ifTrue: [ ^ super addInspectMenuItem: menu ].! !

!FinderMethodNode methodsFor: 'private' stamp: 'MarcusDenker 6/28/2014 11:47'!
browseImplementors
	SystemNavigation new browseAllImplementorsOf: self selector 
		! !

!FinderMethodNode methodsFor: 'private' stamp: 'NicolaiHess 12/21/2013 23:56'!
selector
^ self item! !

!FinderMethodNode methodsFor: 'private' stamp: 'NicolaiHess 12/22/2013 00:05'!
browseSenders

	SystemNavigation new browseSendersOf: self selector name: 'Senders of ', self selector autoSelect: self selector! !

!FinderMethodNode methodsFor: 'private' stamp: 'BenjaminVanRyseghem 2/8/2012 17:08'!
browseClass

	^ Smalltalk tools browser fullOnClass: self parentNode item selector: self item! !

!FinderMethodNode methodsFor: 'events handling' stamp: 'BenjaminVanRyseghem 2/26/2011 12:46'!
keyStroke: anEvent
	(anEvent controlKeyPressed or: [ anEvent commandKeyPressed ]) ifFalse: [ ^ false ].
	anEvent keyCharacter == $n ifTrue: [ ^ self browseSenders ].
	anEvent keyCharacter == $m ifTrue: [ ^ self browseImplementors ].
	^ super keyStroke: anEvent.! !

!FinderMethodNode methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/14/2012 13:51'!
childrenItems
	"I search the children, if I have not got any, I call my super method"

	self model isPragmasSymbol
		ifTrue: [ ^  (self model resultDictionary at: parentNode item ifAbsent:[^super childrenItems]) at: self item ifAbsent: [ ^ super childrenItems]].
	^ (self model resultDictionary at: self item ifAbsent:[^super childrenItems])! !

!FinderMethodNode methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/15/2010 12:13'!
childNodeClassFromItem: anItem
"I answer the class of my children nodes (if I have some)"
	^ FinderClassNode! !

!FinderMethodNode methodsFor: 'private' stamp: 'MarcusDenker 10/15/2013 18:08'!
inspectItem
	self hasParentNode ifTrue: [ (self parentNode item compiledMethodAt: self item) inspect ].! !

!FinderMethodNode methodsFor: 'private' stamp: 'BenjaminVanRyseghem 6/22/2012 14:42'!
isSingle

	^ false! !

!FinderMethodNode methodsFor: 'private' stamp: 'MarcusDenker 6/28/2014 11:51'!
browse
	self item isSymbol	ifTrue: [ 	
		^ SystemNavigation new browseAllImplementorsOf: self item ].
	self item browse.! !

!FinderMethodNode methodsFor: 'events handling' stamp: 'StephaneDucasse 10/22/2014 21:31'!
menu: menu shifted: aBoolean
	
	menu
		add: 'Implementors (m)'
		target: self
		selector: #browseImplementors.
		
	menu
		add: 'Senders (n)'
		target: self
		selector: #browseSenders.
		
	^ super menu: menu shifted: aBoolean.! !

!FinderNode commentStamp: '<historical>'!
A FinderNode is an abstract class used by the tree of FinderUI!
!FinderNode methodsFor: 'events handling' stamp: 'StephaneDucasse 10/22/2014 21:31'!
addInspectMenuItem: menu

	menu
		add: 'Inspect (i)'
		target: self
		selector: #inspectItem.! !

!FinderNode methodsFor: 'private' stamp: 'BenjaminVanRyseghem 2/8/2012 17:08'!
browseClass

	^ Smalltalk tools browser fullOnClass: self item! !

!FinderNode methodsFor: 'events handling' stamp: 'BenjaminVanRyseghem 2/26/2011 12:44'!
keyStroke: anEvent
	(anEvent controlKeyPressed or: [ anEvent commandKeyPressed ]) ifFalse: [ ^ false ].
	anEvent keyCharacter == $b ifTrue: [ ^ self browse ].
	anEvent keyCharacter == $i ifTrue: [ ^ self inspectItem ].! !

!FinderNode methodsFor: 'private' stamp: 'CamilloBruni 2/21/2011 16:05'!
inspectItem
	self item inspect! !

!FinderNode methodsFor: 'private' stamp: 'MarcusDenker 12/21/2013 00:53'!
displayString
	
	^ self item asString! !

!FinderNode methodsFor: 'testing' stamp: 'CamilloBruni 2/21/2011 15:47'!
hasParentNode
	^ self parentNode isNil not! !

!FinderNode methodsFor: 'private' stamp: 'CamilloBruni 2/21/2011 15:29'!
doubleClick
	self browse! !

!FinderNode methodsFor: 'private' stamp: 'BenjaminVanRyseghem 3/3/2011 13:30'!
browse

	self subclassResponsibility! !

!FinderNode methodsFor: 'events handling' stamp: 'StephaneDucasse 10/22/2014 21:31'!
menu: menu shifted: aBoolean
	menu
		add: 'Browse (b)'
		target: self
		selector: #browse.
	self addInspectMenuItem: menu.
		
	menu addLine.
	menu
		add: 'Expand All'
		target: self model
		selector: #expandAll.
	menu
		add: 'Collapse All'
		target: self model
		selector: #collapseAll.
	^menu! !

!FinderPlugin commentStamp: '<historical>'!
I show the finder bar within Nautilus!
!FinderPlugin methodsFor: 'display' stamp: 'BenjaminVanRysgehem 4/29/2012 14:01'!
openFinderUI
	"The finder bar calls this method when the user accepts his search query."
	finderui open.
	
	"Without that, if you reuse the same Finder for anotehr research, it will open a new window again"
	finder
		removeActionsWithReceiver: self! !

!FinderPlugin methodsFor: 'registration' stamp: 'DamienCassou 4/27/2012 19:18'!
registerTo: aModel
	"I don't see any use of Nautilus notifications for this plugin."! !

!FinderPlugin methodsFor: 'display' stamp: 'BenjaminVanRysgehem 4/28/2012 20:48'!
display
	"Nautilus calls this method when the plugin is first displayed. Show the Finder bar."
	finder := Finder new.
	
	finder
		when: #updateResultDictionary
		send: #openFinderUI
		to: self.
		
	finderui := FinderUI on: finder.
	
	^ (finderui buildSearchModeToolBar: StandardWindow new) height: 25! !

!FinderPlugin class methodsFor: 'position' stamp: 'DamienCassou 4/27/2012 19:19'!
defaultPosition 
	^ #top! !

!FinderPlugin class methodsFor: 'information' stamp: 'DamienCassou 4/27/2012 19:21'!
description
	"Use class comment as a description for the plugin"
	^ self comment! !

!FinderPragmaNode commentStamp: '<historical>'!
A FinderPragmaNode is a Node used to render a pragma in the Finder Tree!
!FinderPragmaNode methodsFor: 'private' stamp: 'BenjaminVanRyseghem 2/21/2012 08:29'!
browseClass! !

!FinderPragmaNode methodsFor: 'private' stamp: 'BenjaminVanRyseghem 2/21/2012 08:29'!
browseReferences

	self systemNavigation browseAllCallsOnClass: self item.! !

!FinderPragmaNode methodsFor: 'private' stamp: 'BenjaminVanRyseghem 2/21/2012 08:29'!
browseHierarchy! !

!FinderPragmaNode methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 2/21/2012 08:29'!
keyStroke: anEvent
	(anEvent controlKeyPressed or: [ anEvent commandKeyPressed ]) ifFalse: [ ^ false ].
	anEvent keyCharacter == $h ifTrue: [ ^ self browseHierarchy ].
	anEvent keyCharacter == $N ifTrue: [ ^ self browseReferences ].
	^ super keyStroke: anEvent.! !

!FinderPragmaNode methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/21/2012 08:49'!
childrenItems
	"I search the children, if I have not got any, I call my super method"

	^ (self model resultDictionary at: self item ifAbsent:[^super childrenItems]) keys! !

!FinderPragmaNode methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/21/2012 08:52'!
childNodeClassFromItem: anItem 
	
	^ FinderMethodNode ! !

!FinderPragmaNode methodsFor: 'private' stamp: 'BenjaminVanRyseghem 2/21/2012 08:29'!
foundReceiverOf: aString
	"It's ugly, but I haven't found a method that allows me to do that easily"

	| selector index firstPart |
	selector := (self model finder findSelector: aString).
	index := selector indexOf: $:.
	firstPart := selector.
	(index = 0)
		ifFalse: [firstPart := selector copyFrom: 1 to: index].
	index :=  aString findString: firstPart.
	^ aString copyFrom: 1 to: (index-1).! !

!FinderPragmaNode methodsFor: 'private' stamp: 'BenjaminVanRyseghem 2/21/2012 08:29'!
browse! !

!FinderPragmaNode methodsFor: 'event handling' stamp: 'StephaneDucasse 10/22/2014 21:32'!
menu: menu shifted: aBoolean
	menu
		add: 'Hierarchy (h)'
		target: self
		selector: #browseHierarchy.
	menu
		add: 'References (N)'
		target: self
		selector: #browseReferences.
	^ super menu: menu shifted: aBoolean.! !

!FinderSingleMethodNode commentStamp: '<historical>'!
A FinderSingleMethodNode is a node used to display a selector implemented only once in the system!
!FinderSingleMethodNode methodsFor: 'printing' stamp: 'NicolaiHess 11/30/2013 14:27'!
displayString 

	^ self itemMethod selector, ' (',self itemMethod methodClass name,')'! !

!FinderSingleMethodNode methodsFor: 'private' stamp: 'BenjaminVanRyseghem 6/22/2012 14:43'!
isSingle

	^ true! !

!FinderSingleMethodNode methodsFor: 'private' stamp: 'MarcusDenker 7/9/2014 13:15'!
itemMethod
	| itemClass |
	itemClass := (self model resultDictionary at: self item) first.
	^ itemClass >> self item! !

!FinderSingleMethodNode methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/22/2012 14:48'!
childrenItems

	^ #()! !

!FinderUI commentStamp: '<historical>'!
A FinderUI is a UI used to render a Finder instance.

This tool is used to look for selectors, class, source code or patterns through the system, or through a specified environment!
!FinderUI methodsFor: 'items creation' stamp: 'BenjaminVanRyseghem 2/17/2011 11:06'!
buildSearchButton
	^ (PluggableButtonMorph 
			on: self 
			getState: #searchButtonState 
			action: #searchButtonAction 
			label: #searchButtonLabel)
			hResizing: #shrinkWrap! !

!FinderUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/23/2011 15:27'!
searchingString: aString

	^self finder searchingString: aString! !

!FinderUI methodsFor: 'items creation' stamp: 'sd 3/25/2012 20:45'!
buildSourceTextArea

	sourceTextArea := PluggableTextMorph
				on: self
				text: #sourceCode
				accept: #compileSource:notifying:
				readSelection: #autoSelection
				menu: #msgPaneMenu:shifted:.
				
	sourceTextArea askBeforeDiscardingEdits: true.
	sourceTextArea font: StandardFonts codeFont.
	self updateSourceCode.
	^ sourceTextArea! !

!FinderUI methodsFor: 'private' stamp: 'EstebanLorenzano 1/31/2013 19:24'!
msgPaneMenu: aMenu shifted: shifted
	| donorMenu |
	
	donorMenu := shifted
		ifTrue: [SmalltalkEditor shiftedYellowButtonMenu]
		ifFalse: [SmalltalkEditor yellowButtonMenu].
	^ aMenu addAllFrom: donorMenu! !

!FinderUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
versionsButtonState
	^self selectedClass isNil | self isClassNamesSymbol.! !

!FinderUI methodsFor: 'accessing' stamp: 'MarcusDenker 9/24/2014 18:14'!
searchedTextList: aCollection

	searchedTextList := aCollection! !

!FinderUI methodsFor: 'searching' stamp: 'SeanDeNigris 6/25/2012 19:23'!
forSelectorsDo: selectorBlock forClassNamesDo: classNamesBlock forSourceDo: sourceBlock forExamplesDo: exampleBlock forPragmasDo: pragmaBlock

	self isSelectorsSymbol
		ifTrue: [^selectorBlock value].
	self isClassNamesSymbol
		ifTrue: [^classNamesBlock value].
	self isSourceSymbol
		ifTrue: [^sourceBlock value].
	self isExamplesSymbol
		ifTrue: [^exampleBlock value].
	self isPragmasSymbol
		ifTrue: [^pragmaBlock value].! !

!FinderUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
sendersButtonState
	^self selectedMethod isNil | self isClassNamesSymbol.! !

!FinderUI methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 23:05'!
initialize

	super initialize.

	finder := nil.
	forceSearch := nil.
	searchingTextArea := nil.
	sourceTextArea := nil.
	useRegExCheckbox := nil.
	wrapBlockOrSelector := [: i | i asString ].! !

!FinderUI methodsFor: 'buttons behavior' stamp: 'StephaneDucasse 12/11/2013 13:28'!
environmentButtonLabel
	^ 'Packages...'! !

!FinderUI methodsFor: '*necompletion' stamp: 'StephaneDucasse 6/21/2014 13:32'!
selectedClassOrMetaClass

	^ self selectedClass! !

!FinderUI methodsFor: 'private' stamp: 'BernardoContreras 12/15/2011 17:55'!
openPackageChooser
	(DialogItemsChooser
		on: self
		unselectedItems: self constructPackagesSet
		selectedItems: (self constructPackagesSet: self packagesSelection)
		selectedItemsSetterSelector: #collectFromPackages: 
		title: 'Package Chooser'
		unselectedItemsLabel: 'Unselected Packages' translated
		selectedItemsLabel: 'Selected Packages' translated) open! !

!FinderUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/15/2010 02:16'!
updateSelectedMethod
	self changed: #selectedMethod! !

!FinderUI methodsFor: 'events handling' stamp: 'BenjaminVanRyseghem 2/25/2011 16:48'!
doubleClick
	self selectedNode doubleClick! !

!FinderUI methodsFor: '*Shout-Styling' stamp: 'ClementBera 7/26/2013 16:39'!
shoutAboutToStyle: aPluggableShoutMorphOrView

	aPluggableShoutMorphOrView classOrMetaClass: self selectedClass.
	self selectedClass ifNil: [^ false].
	self selectedMethod ifNil: [^ false].
	^ true! !

!FinderUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
hierarchyButtonAction
	self hierarchy.! !

!FinderUI methodsFor: 'items creation' stamp: 'BenjaminVanRyseghem 9/15/2010 02:04'!
buildImplementorsButton
	^ (PluggableButtonMorph 
			on: self 
			getState: #implementorsButtonState 
			action: #implementorsButtonAction 
			label: #implementorsButtonLabel)
			hResizing: #spaceFill! !

!FinderUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/17/2010 02:16'!
packagesSelection: aCollection

	self finder packagesSelection: aCollection.! !

!FinderUI methodsFor: 'private' stamp: 'MarcusDenker 4/29/2011 00:34'!
inheritance
	
		self selectedClass ifNotNil: [ :class |.
				self selectedMethod ifNotNil: [:selector | 
					SystemNavigation new methodHierarchyBrowserForClass: class selector: selector]]! !

!FinderUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
allClassesButtonState
	^false! !

!FinderUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
searchButtonLabel
	^'Search'! !

!FinderUI methodsFor: 'display' stamp: 'BenjaminVanRyseghem 9/15/2010 02:47'!
defaultWindowLabel
	^'Finder'.! !

!FinderUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/15/2010 02:45'!
useRegEx
	^ self finder useRegEx! !

!FinderUI methodsFor: 'text areas behavior' stamp: 'BenjaminVanRyseghem 2/17/2011 11:21'!
searchingAccept: aText

	self forceSearch
		ifFalse: [aText asString = self searchingString ifTrue: [^self]].
	self searchingString: aText asString.
	forceSearch := false.! !

!FinderUI methodsFor: 'items creation' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
buildAllTextArea
	self buildSearchingTextArea.
	self buildSourceTextArea.! !

!FinderUI methodsFor: 'display' stamp: 'AlainPlantec 2/13/2011 22:03'!
open
	| window |
	window := StandardWindow new model: self.
	self addAllItems: window.
	window setLabel: self defaultWindowLabel.
	window openInWorld.
	self searchingTextArea contentMorph takeKeyboardFocus! !

!FinderUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
versionsButtonLabel
	^'Versions'! !

!FinderUI methodsFor: 'do it requirements' stamp: 'MarcusDenker 6/21/2011 16:33'!
doItReceiver

	^ self selectedClass ifNotNil: [:selectedClass | selectedClass theNonMetaClass].! !

!FinderUI methodsFor: 'tree behavior' stamp: 'BenjaminVanRyseghem 9/14/2010 16:35'!
resultDictionary 
	^self finder resultDictionary ! !

!FinderUI methodsFor: 'buttons behavior' stamp: 'MarcusDenker 6/28/2014 11:34'!
versionsButtonAction
	Smalltalk tools versionBrowser 
		browseVersionsForClass: self selectedClass 
		selector: self selectedMethod! !

!FinderUI methodsFor: 'items creation' stamp: 'BenjaminVanRyseghem 9/15/2010 02:04'!
buildVersionsButton
	^ (PluggableButtonMorph 
			on: self 
			getState: #versionsButtonState 
			action: #versionsButtonAction 
			label: #versionsButtonLabel)
			hResizing: #spaceFill! !

!FinderUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/13/2010 16:03'!
finder: aFinder
	finder := aFinder! !

!FinderUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 3/3/2011 13:29'!
browseButtonState
	^self selectedClass isNil or: [self selectedMethod isNil]! !

!FinderUI methodsFor: 'private' stamp: 'NicolaiHess 12/5/2014 21:05'!
constructPackagesSet
	| result |
	result := ((self environment packages collect:#name )difference: (self packagesSelection packages collect:#name)).
	^result asSet asSortedCollection: [:a :b | a<b]! !

!FinderUI methodsFor: 'private' stamp: 'BernardoContreras 2/16/2015 13:37'!
autoSelection
	| aString firstIndex interval string size |

	(self searchingString isEmpty or: [ self useRegEx] )
		ifTrue: [^ 0 to:0 ].
	
	self isSourceSymbol ifFalse: [^ 0 to: 0].
		
	aString := sourceTextArea text asString asLowercase.
	
	aString = self defaultExplanation asLowercase
		ifTrue: [ ^ 0 to: 0].
	
	string := self searchingString asLowercase.
	(string includes: $*)
		ifTrue: [| list lastIndex|
			list := string substrings: '*'.
			firstIndex := aString findString: list first.
			lastIndex := (aString findString: list last startingAt: firstIndex) + list last size - 1.
			interval := firstIndex to: lastIndex]
		ifFalse: [
			firstIndex := aString findString: string.
			size := string size.
			interval := firstIndex to: (firstIndex + size - 1)].
		
	^ firstIndex = 0 
		ifTrue: [ 0 to:0 ]
		ifFalse: [interval]! !

!FinderUI methodsFor: 'private' stamp: 'MarcusDenker 4/29/2011 00:35'!
senders

	self selectedMethod 
		ifNotNil: [ :selector |.
			 	SystemNavigation new browseSendersOf: selector name: 'Senders of ', selector asString autoSelect: selector asString].! !

!FinderUI methodsFor: 'items creation' stamp: 'BenjaminVanRyseghem 9/15/2010 02:03'!
buildBrowseButton
	^ (PluggableButtonMorph 
			on: self 
			getState: #browseButtonState 
			action: #browseButtonAction 
			label: #browseButtonLabel)
			hResizing: #spaceFill! !

!FinderUI methodsFor: 'mode list' stamp: 'BenjaminVanRyseghem 9/15/2010 00:10'!
isSelectorsSymbol
	^self finder isSelectorsSymbol! !

!FinderUI methodsFor: 'accessing' stamp: 'bvr 9/19/2010 18:27'!
currentSearchMode: aSymbol
	
	self finder searchingStringSilently: self searchingTextArea contentMorph textMorph text asString.
	self searchingTextArea contentMorph textMorph hasUnacceptedEdits:false.
	self finder currentSearchMode: aSymbol.
	.! !

!FinderUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/15/2010 02:16'!
updateSelectedClass
	self changed: #selectedClass! !

!FinderUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 9/17/2010 01:57'!
allClassesButtonAction

	self finder packagesSelection: self environment.! !

!FinderUI methodsFor: '*necompletion' stamp: 'StephaneDucasse 6/21/2014 13:32'!
isCodeCompletionAllowed

	^ true! !

!FinderUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/18/2010 16:39'!
searchedTextListMaxSize: anInteger
	[self searchedTextList size > anInteger]
		whileTrue: [ self searchedTextList removeLast].
	self changed: #searchedTextList.! !

!FinderUI methodsFor: 'accessing' stamp: 'AlainPlantec 10/8/2011 13:48'!
selection: aSelection
	
	super selection: aSelection.
	self finder selection: aSelection! !

!FinderUI methodsFor: 'text areas behavior' stamp: 'ClementBera 7/26/2013 16:39'!
sourceCode

	^ self selectedClass 
		ifNil: [
			self isExamplesSymbol
				ifTrue: [ self class methodFinderExplanation ]
				ifFalse: [ self defaultExplanation]]
		ifNotNil:[
			self selectedMethod 
				ifNil: [
					self buildDescriptionOf: self selectedClass]
				ifNotNil:[
					| method |
					method := self isExamplesSymbol
								ifTrue: [self finder findSelector: self selectedMethod]
								ifFalse: [self selectedMethod].
					(self selectedClass >> method) sourceCode]]! !

!FinderUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
browseButtonLabel
	^'Browse'! !

!FinderUI methodsFor: 'text areas behavior' stamp: 'BenjaminVanRyseghem 3/4/2011 12:18'!
buildDescriptionOf: aClass

	| stream |
	stream := WriteStream on: ''.
	stream 
		nextPutAll: aClass definition.
	aClass hasComment
		ifTrue: [
			stream
				nextPut: Character cr;
				nextPut: Character cr;
				nextPut: Character cr;
				nextPutAll: aClass comment].

	^ stream contents! !

!FinderUI methodsFor: 'tree behavior' stamp: 'BenjaminVanRyseghem 9/18/2010 15:08'!
rootItems
	^self resultDictionary keys sort:[:a :b | a name  < b name]! !

!FinderUI methodsFor: 'private' stamp: 'MarcusDenker 4/29/2011 00:34'!
hierarchy
	
		self selectedClass ifNotNil: [ :class |
			self selectedMethod
				ifNil: [SystemNavigation new browseHierarchy: class]
				ifNotNil: [:selector | 
					SystemNavigation new browseHierarchy:class selector: selector]]! !

!FinderUI methodsFor: 'mode list' stamp: 'BenjaminVanRyseghem 9/14/2010 23:54'!
isSourceSymbol
	^self finder isSourceSymbol! !

!FinderUI methodsFor: '*Polymorph-TaskbarIcons' stamp: 'StephaneDucasse 6/21/2014 13:32'!
taskbarIcon
 
	^ self class icon! !

!FinderUI methodsFor: 'display' stamp: 'AlainPlantec 2/13/2011 21:17'!
initialExtent
	^700 @ 500! !

!FinderUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/13/2010 16:11'!
selectedClass
	^ self finder selectedClass! !

!FinderUI methodsFor: 'checkbox' stamp: 'BenjaminVanRyseghem 9/15/2010 01:47'!
disableUseRegEx
	useRegExCheckbox isSelected
		ifTrue: [ useRegExCheckbox toggleSelected].
	useRegExCheckbox enabled: false.
! !

!FinderUI methodsFor: 'items creation' stamp: 'EstebanLorenzano 5/1/2014 11:26'!
defaultTreeMorph
	|  col |
	col := MorphTreeColumn new
		rowMorphGetSelector: [:node | node displayString asMorph ].
	
	self headerLabel
		ifNotNil: [	col headerButtonLabel: self headerLabel font: nil].
			
	^ (self treeMorphClass on: self) 
			columns:  (Array with: col);
			hResizing: #spaceFill;
			vResizing: #spaceFill;
			resizerWidth: 0;
			columnInset: 0; 
			rowInset: 2; 
			keystrokeActionSelector: #keyStroke:;
			"preferedPaneColor: Color white;"
			multiSelection: self multiSelection;
			autoMultiSelection: self autoMultiSelection;
			isCheckList: self isCheckList;
			doubleClickSelector: #doubleClick;
			getMenuSelector: #menu:shifted:";
			rowColorForEven: Color veryLightGray muchLighter odd: Color white".! !

!FinderUI methodsFor: 'items creation' stamp: 'AlainPlantec 10/8/2011 14:20'!
buildPackagesTree
	^ self defaultTreeMorph! !

!FinderUI methodsFor: 'private' stamp: 'MarcusDenker 6/28/2014 11:47'!
implementors

	self selectedMethod ifNil: [^self].
 	SystemNavigation new browseAllImplementorsOf: self selectedMethod! !

!FinderUI methodsFor: 'accessing' stamp: 'AlainPlantec 2/13/2011 21:28'!
addToSearchedTextList: aString 
	self searchedTextList: (self searchedTextList
			remove: aString
			ifAbsent: [];
			 yourself).
	self searchedTextList size = self searchedTextListMaxSize
		ifTrue: [self searchedTextList removeLast].
	self searchedTextList addFirst: aString ! !

!FinderUI methodsFor: 'items creation' stamp: 'MarcusDenker 5/15/2011 15:21'!
buildSearchModeToolBar: aWindow
	^aWindow newToolbar: {
		self buildSearchingTextArea.
		self buildSearchButton.
		self buildRegExChooser.
		self buildSearchModeDropListIn: aWindow.
		self buildEnvironmentButton.
		self buildAllClassesButton}.! !

!FinderUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
hierarchyButtonLabel
	^'Hierarchy'! !

!FinderUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
resetEnvironment
	self triggerEvent: #resetEnvironment! !

!FinderUI methodsFor: 'do it requirements' stamp: 'BenjaminVanRyseghem 4/14/2011 11:47'!
doItContext

	^ nil! !

!FinderUI methodsFor: 'items creation' stamp: 'BenjaminVanRyseghem 9/15/2010 02:04'!
buildSendersButton
	^ (PluggableButtonMorph 
			on: self 
			getState: #sendersButtonState 
			action: #sendersButtonAction 
			label: #sendersButtonLabel)
			hResizing: #spaceFill! !

!FinderUI methodsFor: 'items creation' stamp: 'BenjaminVanRyseghem 9/16/2010 22:59'!
buildBrowseToolBar: aWindow
	| toolbar |
	toolbar := aWindow newToolbar: {
		self buildBrowseButton.
		self buildSendersButton.
		self buildImplementorsButton.
		self buildVersionsButton.
		self buildInheritanceButton.
		self buildHierarchyButton}.
	^toolbar hResizing: #shrinkWrap! !

!FinderUI methodsFor: 'events handling' stamp: 'StephaneDucasse 3/12/2011 15:07'!
keyStroke: event
	self selectedNode ifNotNil: [:node | node keyStroke: event]! !

!FinderUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 9/16/2010 01:16'!
environmentButtonAction
	self openPackageChooser! !

!FinderUI methodsFor: 'items creation' stamp: 'AlainPlantec 2/13/2011 22:30'!
buildRegExChooser
	| string btnHeight btnWidth |
	string := 'Regexp'.
	btnHeight := StandardFonts buttonFont height + 8.
	btnWidth := 0.
	string do: [:c | btnWidth := btnWidth + (StandardFonts buttonFont widthOf: c)].
	^useRegExCheckbox := (CheckboxMorph 
									on: self finder
									selected: #useRegEx
									changeSelected: #useRegEx:)
									beCheckbox;
									vResizing: #rigid;
									height: btnHeight;
									width: btnWidth + 30;
									label: string! !

!FinderUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/13/2010 16:13'!
selectedMethod
	^ self finder selectedMethod! !

!FinderUI methodsFor: 'accessing' stamp: 'MarcusDenker 9/24/2014 18:14'!
searchedTextList
	^searchedTextList ifNil: [ searchedTextList := OrderedCollection new]! !

!FinderUI methodsFor: 'mode list' stamp: 'SeanDeNigris 6/25/2012 19:20'!
searchModesList
	^#(Selectors Classes Source Pragmas Examples)! !

!FinderUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/13/2010 16:06'!
searchingString
	^self finder searchingString! !

!FinderUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
inheritanceButtonLabel
	^'Inheritance'! !

!FinderUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/15/2010 01:21'!
resetSearchedTextList
	self searchedTextList removeAll.! !

!FinderUI methodsFor: 'items creation' stamp: 'BenjaminVanRyseghem 9/15/2010 02:03'!
buildHierarchyButton
	^ (PluggableButtonMorph 
			on: self 
			getState: #hierarchyButtonState 
			action: #hierarchyButtonAction 
			label: #hierarchyButtonLabel)
			hResizing: #spaceFill! !

!FinderUI methodsFor: 'text areas behavior' stamp: 'MarcusDenker 6/14/2014 12:16'!
compileSource: aString notifying: aController

	| class method |
	(self selectedClass isNil or: [ self selectedMethod isNil ])
		ifTrue:[
			self changed: #clearUserEdits.
			^self].
	class := self selectedClass.
	method := class compiledMethodAt: self selectedMethod.
	(class compile: (aString asString) classified: method category notifying: aController)
			ifNil: [^ self ]
			ifNotNil: [:selector |
				self changed: #clearUserEdits ]! !

!FinderUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
labelFont
	^StandardFonts defaultFont! !

!FinderUI methodsFor: 'items creation' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
buildAllClassesButton
	^ PluggableButtonMorph 
			on: self 
			getState: #allClassesButtonState 
			action: #allClassesButtonAction 
			label: #allClassesButtonLabel! !

!FinderUI methodsFor: 'checkbox' stamp: 'BenjaminVanRyseghem 9/15/2010 01:41'!
enableUseRegEx
	useRegExCheckbox 
		enabled: true;
		updateEnabled! !

!FinderUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
inheritanceButtonState
	^self selectedClass isNil | self isClassNamesSymbol.! !

!FinderUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
environmentButtonState
	^false.! !

!FinderUI methodsFor: 't - accessing' stamp: 'NicolaiHess 12/21/2013 23:33'!
rootNodeClassFromItem: anItem 
	"To have the good class for my nodes, I ask my owner,
	because he is the only one who knows his state"
	^ self 
		forSelectorsDo: [
			(self resultDictionary at: anItem) size > 1
				ifTrue: [ FinderMethodNode ]
				ifFalse: [ FinderSingleMethodNode ]]
		forClassNamesDo: [FinderClassNode]
		forSourceDo: [FinderMethodNode]
		forExamplesDo: [FinderExampleMethodNode] 
		forPragmasDo: [FinderPragmaNode]! !

!FinderUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/14/2010 17:44'!
currentSearchMode
	^self finder currentSearchMode! !

!FinderUI methodsFor: 'items creation' stamp: 'AlainPlantec 2/13/2011 21:44'!
useRegExCheckbox
	^ useRegExCheckbox ifNil: [self buildRegExChooser]
! !

!FinderUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/2/2011 16:41'!
forceSearch

	 ^ forceSearch ifNil: [forceSearch := false].! !

!FinderUI methodsFor: 'text areas behavior' stamp: 'BenjaminVanRyseghem 5/16/2011 13:38'!
updateSourceCode
	
	self changed: #sourceCode.! !

!FinderUI methodsFor: 'accessing' stamp: 'MarcusDenker 8/9/2014 13:06'!
searchedTextListMaxSize
	^20! !

!FinderUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
implementorsButtonState
	^self selectedMethod isNil | self isClassNamesSymbol.! !

!FinderUI methodsFor: 'mode list' stamp: 'BenjaminVanRyseghem 5/14/2012 13:45'!
isClassNamesSymbol

	^self finder isClassNamesSymbol! !

!FinderUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
implementorsButtonAction
	self implementors.! !

!FinderUI methodsFor: 'mode list' stamp: 'SeanDeNigris 6/25/2012 15:05'!
isExamplesSymbol
	^self finder isExamplesSymbol! !

!FinderUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
hierarchyButtonState
	^self selectedClass isNil.! !

!FinderUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
inheritanceButtonAction
	self inheritance.! !

!FinderUI methodsFor: 'private' stamp: 'SeanDeNigris 6/25/2012 19:18'!
defaultExplanation
^
'The Finder can be used in 4 different ways:
	- Selectors: your research is done among selectors
	- Classes : your research is done among classes names
	- Source : your research is done among all the source code
	- Pragmas: your research is done among pragmas
	- Examples : your research uses the Method Finder behavior 
			   (for further informations, print ''FinderUI methodFinderExplanation'')
	
			
In these four modes, you can also tick the ''Use RegEx'' checkbox.
If you pick this box, your search will be done using regular expressions instead of just matching.

The ''Select classes'' button opened a dialog window  to select which classes will be used for the search.
The ''All classes'' button is used to reset the classes selection.'! !

!FinderUI methodsFor: 'items creation' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
buildEnvironmentButton
	^ (PluggableButtonMorph 
			on: self 
			getState: #environmentButtonState 
			action: #environmentButtonAction 
			label: #environmentButtonLabel)
			beSticky! !

!FinderUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/13/2010 16:12'!
environment

	^ self finder environment.! !

!FinderUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/13/2010 16:46'!
searchModeHelpText
	^'Choose the mode for the search'! !

!FinderUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 2/17/2011 11:20'!
searchButtonAction
	
	forceSearch := true.
	self searchingTextArea contentMorph acceptTextInModel.! !

!FinderUI methodsFor: '*necompletion' stamp: 'StephaneDucasse 6/21/2014 13:32'!
guessTypeForName: aString 
 
	self flag: 'we may be able to do something more sophisticated here, but needed something to prevent a DNU. Returning nil was taken from AbstractTool. See Debugger or Workspace for actual guessing logic'.
	^ nil.! !

!FinderUI methodsFor: 'items creation' stamp: 'BenjaminVanRyseghem 9/15/2010 02:04'!
buildInheritanceButton
	^ (PluggableButtonMorph 
			on: self 
			getState: #inheritanceButtonState 
			action: #inheritanceButtonAction 
			label: #inheritanceButtonLabel)
			hResizing: #spaceFill! !

!FinderUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/13/2010 16:02'!
finder
	^finder! !

!FinderUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
searchButtonState
	^false.! !

!FinderUI methodsFor: 't - accessing' stamp: 'MarcusDenker 12/9/2013 12:45'!
menu: menu shifted: b 
	self selectedNode ifNil: [ ^menu ].
	^ self selectedNode menu: menu shifted: b ! !

!FinderUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
implementorsButtonLabel
	^'Implementors'! !

!FinderUI methodsFor: 'accessing' stamp: 'AlainPlantec 2/13/2011 21:48'!
searchingTextArea
	^searchingTextArea ifNil: [self buildSearchingTextArea]! !

!FinderUI methodsFor: 'items creation' stamp: 'BenjaminVanRyseghem 9/13/2010 17:28'!
buildSearchingTextArea
	^ searchingTextArea := 
		(EditableDropListMorph
				on: self
				list: #searchedTextList
				selected: #searchingString
				changeSelected: #searchingAccept:
				useIndex: false 
				addToList: #addToSearchedTextList:
				class: String
				getEnabled: nil) hResizing: #spaceFill; 
				ghostText: 'Hit return to accept' translated.

	! !

!FinderUI methodsFor: 'private' stamp: 'NicolaiHess 12/5/2014 21:03'!
constructPackagesSet: aPackageEnvironment
	| result |
	result := aPackageEnvironment packages collect:[:c | c name].
		^(result reject: [:each | each isNil]) asSet asSortedCollection: [:a :b | a < b ].! !

!FinderUI methodsFor: 'buttons behavior' stamp: 'AlainPlantec 2/13/2011 22:31'!
allClassesButtonLabel
	^ 'All Packages'! !

!FinderUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 3/3/2011 13:28'!
browseButtonAction

	self selectedNode browse.! !

!FinderUI methodsFor: 'text areas behavior' stamp: 'NicolaiHess 12/5/2014 21:05'!
collectFromPackages: aCollection
	self packagesSelection: (self environment forPackageNames: aCollection)! !

!FinderUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
sendersButtonLabel
	^'Senders'! !

!FinderUI methodsFor: 'items creation' stamp: 'MarcusDenker 10/15/2013 18:14'!
addAllItems: aWindow
	| toolbar height  btnFont  btnToolbar cst |
	toolbar := self buildSearchModeToolBar: aWindow.
	height := toolbar minExtent y.
	cst := 15.
	
	aWindow 
		addMorph: toolbar
		fullFrame: ( (0 @ 0 corner: 1 @ 0) asLayoutFrame bottomOffset: height).
	aWindow
		addMorph: self buildPackagesTree buildContents
		fullFrame: ((0@0 corner: 1@0.58) asLayoutFrame topOffset: height).
	btnFont := StandardFonts buttonFont.
	btnToolbar := self buildBrowseToolBar: aWindow.
	aWindow
		addMorph: btnToolbar
		fullFrame: ((0@0.58 corner: 1@0.58) asLayoutFrame bottomOffset: (btnFont height +cst)).
	aWindow 
		addMorph: self sourceTextArea
		fullFrame: ((0@0.58 corner: 1@1) asLayoutFrame topOffset: btnFont height +cst)
! !

!FinderUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/16/2010 21:09'!
packagesSelection
	^self finder packagesSelection! !

!FinderUI methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 8/30/2010 3:44'!
sendersButtonAction
	self senders.! !

!FinderUI methodsFor: 'accessing' stamp: 'AlainPlantec 2/13/2011 21:41'!
sourceTextArea
	^sourceTextArea ifNil: [self buildSourceTextArea]! !

!FinderUI methodsFor: 'mode list' stamp: 'BenjaminVanRyseghem 5/14/2012 13:49'!
isPragmasSymbol
	^self finder isPragmasSymbol! !

!FinderUI methodsFor: 'items creation' stamp: 'FernandoOlivero 4/12/2011 09:45'!
buildSearchModeDropListIn: aWindow
			^(self theme 
				newDropListIn: aWindow
				for:self				
				list: #searchModesList
				getSelected: #currentSearchMode
				setSelected: #currentSearchMode:
				getEnabled: nil
				useIndex: false 
				help: self searchModeHelpText) hResizing: #rigid; width: 120; yourself
! !

!FinderUI class methodsFor: 'event subscriptions' stamp: 'BenjaminVanRyseghem 2/25/2011 17:04'!
subscribesUpdateSourceCodeOn: aFinder to: anInstance
	aFinder
		when: #updateSourceCode
		send: #updateSourceCode
		to: anInstance.! !

!FinderUI class methodsFor: 'event subscriptions' stamp: 'AlainPlantec 2/13/2011 22:20'!
subscribesResetEnvironmentOn: aFinder to: anInstance 
	aFinder
		when: #resetEnvironment
		send: #resetEnvironment
		to: anInstance! !

!FinderUI class methodsFor: 'event subscriptions' stamp: 'BenjaminVanRyseghem 2/25/2011 17:04'!
subscribesEnableUseRegExOn: aFinder to: anInstance
	aFinder
		when: #enableUseRegEx
		send: #enableUseRegEx
		to: anInstance.! !

!FinderUI class methodsFor: 'event subscriptions' stamp: 'BenjaminVanRyseghem 2/25/2011 17:05'!
subscribesUpdateListOn: aFinder to: anInstance
	aFinder
		when: #updateResultDictionary
		send: #updateList
		to: anInstance.! !

!FinderUI class methodsFor: 'initialize-release' stamp: 'AlainPlantec 2/13/2011 22:20'!
initialize
	searchedTextListMaxSize := 15! !

!FinderUI class methodsFor: 'event subscriptions' stamp: 'BenjaminVanRyseghem 2/25/2011 17:04'!
subscribesDisableUseRegExOn: aFinder to: anInstance.
	aFinder
		when: #disableUseRegEx
		send: #disableUseRegEx
		to: anInstance.! !

!FinderUI class methodsFor: 'accessing' stamp: 'bvr 9/19/2010 19:19'!
searchedTextListMaxSize: anInteger

	self allInstancesDo: [:each | each searchedTextListMaxSize: anInteger].
	searchedTextListMaxSize := anInteger! !

!FinderUI class methodsFor: 'explanations' stamp: 'SeanDeNigris 6/25/2012 19:19'!
methodFinderExplanation
	"The comment in the bottom pane"

	false ifTrue: [MethodFinder methodFor: #( (4 3) 7  (0 5) 5  (5 5) 10)].
		"to keep the method methodFor: from being removed from the system"

	^ 'Type a fragment of a selector in the search box and click <Search>.

Or, use an example to find a method in the system.  An example is made up of the following three items separated by a period: receiver. args. answer.    For example, type: 3. 4. 7. into the search box and click <Search>

Alternatively, in this bottom pane, use #methodFor: directly to find a method in the system.  Select this line of code and choose "print it".  

	MethodFinder methodFor: #( (4 3) 7  (0 5) 5  (5 5) 10).
This will discover (data1 + data2).

You supply inputs and answers and the system will find the method.  Each inner array is a list of inputs.  It contains the receiver and zero or more arguments.  For Booleans and any computed arguments, use brace notation.

	MethodFinder methodFor: { {1. 3}. true.  {20. 10}. false}.
This will discover the expressions (data1 < data2), (data2 > data1), and many others.

	MethodFinder methodFor: { {''29 Apr 1999'' asDate}. ''Thursday''.  
		{''30 Apr 1999'' asDate}. ''Friday'' }.
This will discover the expression (data1 weekday)

Receiver and arguments do not have to be in the right order.
See MethodFinder.verify for more examples.'! !

!FinderUI class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 2/25/2011 17:04'!
on: aFinder
	| instance |
	instance := self new finder: aFinder.
	self doAllSubscriptionsOn: aFinder to: instance.
	^instance.! !

!FinderUI class methodsFor: 'event subscriptions' stamp: 'BenjaminVanRyseghem 2/25/2011 17:04'!
subscribesUpdateSelectedMethodOn: aFinder to: anInstance
	aFinder
		when: #updateSelectedMethod
		send: #updateSelectedMethod
		to: anInstance.! !

!FinderUI class methodsFor: 'event subscriptions' stamp: 'BenjaminVanRyseghem 2/25/2011 17:04'!
subscribesUpdateSelectedClassOn: aFinder to: anInstance
	aFinder
		when: #updateSelectedClass
		send: #updateSelectedClass
		to: anInstance.! !

!FinderUI class methodsFor: 'event subscriptions' stamp: 'BenjaminVanRyseghem 2/25/2011 17:05'!
doAllSubscriptionsOn: aFinder to: anInstance
	self subscribesUpdateSourceCodeOn: aFinder to: anInstance.
	self subscribesResetEnvironmentOn: aFinder to: anInstance.
	self subscribesEnableUseRegExOn: aFinder to: anInstance.
	self subscribesDisableUseRegExOn: aFinder to: anInstance.
	self subscribesUpdateSelectedMethodOn: aFinder to: anInstance.
	self subscribesUpdateSelectedClassOn: aFinder to: anInstance.
	self subscribesUpdateListOn: aFinder to: anInstance! !

!FinderUI class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/15/2013 14:19'!
icon
	^ Smalltalk ui icons iconNamed: #smallFindIcon! !

!FixedFaceFont commentStamp: 'tak 12/22/2004 01:45'!
I am a font for special purpose like password or fallback.
I can show same form whenever someone requests any character.

Variable displaySelector is future use to show a form dynamically.
(Although it would be unnecessary...)!
!FixedFaceFont methodsFor: 'accessing' stamp: 'tak 12/20/2004 10:51'!
maxAscii
	^ SmallInteger maxVal! !

!FixedFaceFont methodsFor: 'accessing' stamp: 'ar 1/5/2003 16:58'!
ascent
	^baseFont ascent! !

!FixedFaceFont methodsFor: 'displaying' stamp: 'yo 1/7/2005 12:00'!
displayString: aString on: aDisplayContext from: startIndex to: stopIndex at: aPoint kern: kernDelta 
	| size |
	size := stopIndex - startIndex + 1.
	^ self perform: displaySelector withArguments: (Array with: aDisplayContext with: size with: aPoint with: kernDelta with: aPoint y + self ascent).! !

!FixedFaceFont methodsFor: 'displaying' stamp: 'yo 1/7/2005 11:51'!
displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta from: fromFont baselineY: baselineY
	| destPoint |
	destPoint := self
				displayString: aString
				on: aBitBlt
				from: startIndex
				to: stopIndex
				at: aPoint
				kern: kernDelta
				baselineY: baselineY.
	^ Array with: stopIndex + 1 with: destPoint! !

!FixedFaceFont methodsFor: 'displaying' stamp: 'yo 1/7/2005 11:49'!
displayErrorOn: aCanvas length: length at: aPoint kern: kernDelta baselineY: baselineY
	| maskedString |
	maskedString := String new: length.
	maskedString atAllPut: substitutionCharacter.
	^ baseFont
		displayString: maskedString
		on: aCanvas
		from: 1
		to: length
		at: aPoint
		kern: kernDelta
		baselineY: baselineY! !

!FixedFaceFont methodsFor: 'caching' stamp: 'nk 3/15/2004 18:48'!
releaseCachedState
	baseFont releaseCachedState.! !

!FixedFaceFont methodsFor: 'accessing' stamp: 'ar 1/5/2003 16:57'!
height
	^baseFont height! !

!FixedFaceFont methodsFor: 'displaying' stamp: 'ar 1/5/2003 17:00'!
installOn: aDisplayContext foregroundColor: foregroundColor backgroundColor: backgroundColor
	^baseFont installOn: aDisplayContext foregroundColor: foregroundColor backgroundColor: backgroundColor! !

!FixedFaceFont methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 09:54'!
initialize
	super initialize.
	baseFont := TextStyle defaultFont.
	self passwordFont! !

!FixedFaceFont methodsFor: 'accessing' stamp: 'ar 1/5/2003 16:57'!
baseFont
	^baseFont! !

!FixedFaceFont methodsFor: 'private' stamp: 'yo 1/11/2005 18:54'!
glyphInfoOf: aCharacter into: glyphInfoArray

	^ baseFont glyphInfoOf: substitutionCharacter into: glyphInfoArray.
! !

!FixedFaceFont methodsFor: 'accessing' stamp: 'nk 8/31/2004 09:26'!
lineGrid
	^baseFont lineGrid! !

!FixedFaceFont methodsFor: 'displaying' stamp: 'yo 1/7/2005 12:19'!
displayString: aString on: aDisplayContext from: startIndex to: stopIndex at: aPoint kern: kernDelta baselineY: baselineY
	| size |
	size := stopIndex - startIndex + 1.
	^ self perform: displaySelector withArguments: (Array with: aDisplayContext with: size with: aPoint with: kernDelta with: baselineY).! !

!FixedFaceFont methodsFor: 'displaying' stamp: 'yo 1/7/2005 11:50'!
displayPasswordOn: aCanvas length: length at: aPoint kern: kernDelta baselineY: baselineY
	| maskedString |
	maskedString := String new: length.
	maskedString atAllPut: substitutionCharacter.
	^ baseFont
		displayString: maskedString
		on: aCanvas
		from: 1
		to: length
		at: aPoint
		kern: kernDelta
		baselineY: baselineY! !

!FixedFaceFont methodsFor: 'accessing' stamp: 'ar 1/5/2003 16:58'!
descentKern
	^baseFont descentKern! !

!FixedFaceFont methodsFor: 'accessing' stamp: 'tak 12/20/2004 10:10'!
emphasized: emph
	^self class new baseFont: (baseFont emphasized: emph)! !

!FixedFaceFont methodsFor: 'accessing' stamp: 'tak 12/20/2004 10:19'!
fontSize: aNumber 
	self baseFont: (StrikeFont familyName: baseFont familyName size: aNumber) copy! !

!FixedFaceFont methodsFor: 'accessing' stamp: 'nk 8/31/2004 09:25'!
familyName
	^baseFont familyName, '-pw'! !

!FixedFaceFont methodsFor: 'displaying' stamp: 'tak 12/20/2004 18:06'!
displayPasswordOn: aCanvas length: length at: aPoint kern: kernDelta 
	| maskedString |
	maskedString := String new: length.
	maskedString atAllPut: substitutionCharacter.
	^ baseFont
		displayString: maskedString
		on: aCanvas
		from: 1
		to: length
		at: aPoint
		kern: kernDelta! !

!FixedFaceFont methodsFor: 'accessing' stamp: 'ar 1/5/2003 16:57'!
baseFont: aFont
	baseFont := aFont! !

!FixedFaceFont methodsFor: 'initialization' stamp: 'yo 1/7/2005 11:59'!
passwordFont
	displaySelector := #displayPasswordOn:length:at:kern:baselineY:.
	substitutionCharacter := $*! !

!FixedFaceFont methodsFor: 'accessing' stamp: 'ar 1/5/2003 16:59'!
baseKern
	^baseFont baseKern! !

!FixedFaceFont methodsFor: 'displaying' stamp: 'tak 12/20/2004 11:10'!
displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta from: fromFont 
	| destPoint |
	destPoint := self
				displayString: aString
				on: aBitBlt
				from: startIndex
				to: stopIndex
				at: aPoint
				kern: kernDelta.
	^ Array with: stopIndex + 1 with: destPoint! !

!FixedFaceFont methodsFor: 'accessing' stamp: 'tak 12/22/2004 02:01'!
characterFormAt: character 
	^ baseFont characterFormAt: substitutionCharacter! !

!FixedFaceFont methodsFor: 'measuring' stamp: 'tak 12/20/2004 18:05'!
widthOf: aCharacter 
	^ baseFont widthOf: substitutionCharacter! !

!FixedFaceFont methodsFor: 'displaying' stamp: 'tak 12/20/2004 18:06'!
displayErrorOn: aCanvas length: length at: aPoint kern: kernDelta 
	| maskedString |
	maskedString := String new: length.
	maskedString atAllPut: substitutionCharacter.
	^ baseFont
		displayString: maskedString
		on: aCanvas
		from: 1
		to: length
		at: aPoint
		kern: kernDelta! !

!FixedFaceFont methodsFor: 'accessing' stamp: 'ar 1/5/2003 17:00'!
descent
	^baseFont descent! !

!FixedFaceFont methodsFor: 'accessing' stamp: 'nk 8/31/2004 09:28'!
pointSize
	^baseFont pointSize! !

!FixedFaceFont methodsFor: 'accessing' stamp: 'ar 1/5/2003 16:59'!
passwordCharacter
	^$*! !

!FixedFaceFont methodsFor: 'initialization' stamp: 'yo 1/7/2005 11:59'!
errorFont
	displaySelector := #displayErrorOn:length:at:kern:baselineY:.
	substitutionCharacter := $?.! !

!FixedLayout commentStamp: '<historical>'!
I am the default layout for objects.

I contain a fixed number of Slots.
Instances of classes using this kind of layout have always the same size.!
!FixedLayout methodsFor: 'format' stamp: 'ToonVerwaest 4/1/2011 01:27'!
instanceSpecificationBase
	^ 0! !

!FixedLayout class methodsFor: 'instance creation' stamp: 'MartinDias 7/11/2013 16:01'!
extending: superLayout scope: aScope host: aClass
	^ (superLayout extend: aScope)
		host: aClass;
		yourself! !

!Float commentStamp: 'VeronicaUquillas 6/11/2010 14:51'!
My instances represent IEEE-754 floating-point double-precision numbers.  They have about 16 digits of accuracy and their range is between plus and minus 10^307. Some valid examples are:
	
	8.0 13.3 0.3 2.5e6 1.27e-30 1.27e-31 -12.987654e12

Mainly: no embedded blanks, little e for tens power, and a digit on both sides of the decimal point.  It is actually possible to specify a radix for Float constants.  This is great for teaching about numbers, but may be confusing to the average reader:

	3r20.2 --> 6.66666666666667
	8r20.2 --> 16.25

If you don't have access to the definition of IEEE-754, you can figure out what is going on by printing various simple values in Float hex.  It may help you to know that the basic format is...
	sign		1 bit
	exponent	11 bits with bias of 1023 (16r3FF) to produce an exponent
						in the range -1023 .. +1024
				- 16r000:
					significand = 0: Float zero
					significand ~= 0: Denormalized number (exp = -1024, no hidden '1' bit)
				- 16r7FF:
					significand = 0: Infinity
					significand ~= 0: Not A Number (NaN) representation
	mantissa	53 bits, but only 52 are stored (20 in the first word, 32 in the second).  This is because a normalized mantissa, by definition, has a 1 to the right of its floating point, and IEEE-754 omits this redundant bit to gain an extra bit of precision instead.  People talk about the mantissa without its leading one as the FRACTION, and with its leading 1 as the SIGNFICAND.

The single-precision format is...
	sign		1 bit
	exponent	8 bits, with bias of 127, to represent -126 to +127
                    - 0x0 and 0xFF reserved for Float zero (mantissa is ignored)
                    - 16r7F reserved for Float underflow/overflow (mantissa is ignored)
	mantissa	24 bits, but only 23 are stored
This format is used in FloatArray (qv), and much can be learned from the conversion routines, Float asIEEE32BitWord, and Float class fromIEEE32Bit:.

Thanks to Rich Harmon for asking many questions and to Tim Olson, Bruce Cohen, Rick Zaccone and others for the answers that I have collected here.!
!Float methodsFor: 'converting' stamp: 'nice 5/30/2006 02:29'!
asIEEE32BitWord
	"Convert the receiver into a 32 bit Integer value representing the same number in IEEE 32 bit format.
	Used for conversion in FloatArrays only."
	
	| word1 word2 sign mantissa exponent destWord truncatedBits mask roundToUpper |
	
	"skip fast positive and nnegative zero"
	self = 0.0 ifTrue: [^self basicAt: 1].
	
	"retrieve 64 bits of IEEE 754 double"
	word1 := self basicAt: 1.
	word2 := self basicAt: 2.
	
	"prepare sign exponent and mantissa of 32 bits float"
	sign := word1 bitAnd: 16r80000000.
	exponent := ((word1 bitShift: -20) bitAnd: 16r7FF) - 1023 + 127.
	mantissa := (word2 bitShift: -29) + ((word1 bitAnd:  16rFFFFF) bitShift: 3).
	truncatedBits := (word2 bitAnd: 16r1FFFFFFF).

	"We must now honour default IEEE rounding mode (round to nearest even)"
	
	"we are below gradual underflow, even if rounded to upper mantissa"
	exponent < -24 ifTrue: [^sign "this can be negative zero"].
	
	"BEWARE: rounding occurs on less than 23bits when gradual underflow"
	exponent <= 0
		ifTrue:
			[mask := 1 bitShift: exponent negated.
			mantissa := mantissa bitOr: 16r800000.
			roundToUpper := (mantissa bitAnd: mask) isZero not
				and: [truncatedBits isZero not
					or: [(mantissa bitAnd: mask - 1) isZero not
						or: [(mantissa bitAnd: mask*2) isZero not]]].
			mantissa := mantissa bitShift: exponent - 1.
			"exponent := exponent + 1"]
		ifFalse:
			[roundToUpper := (truncatedBits bitAnd: 16r10000000) isZero not
				and: [(mantissa bitAnd: 16r1) isZero not
					or: [(truncatedBits bitAnd: 16r0FFFFFFF) isZero not]]
			].
		
	"adjust mantissa and exponent due to IEEE rounding mode"
	roundToUpper
		ifTrue:
			[mantissa := mantissa + 1.
			mantissa > 16r7FFFFF
				ifTrue:
					[mantissa := 0.
					exponent := exponent+1]].

	exponent > 254 ifTrue: ["Overflow"
		exponent := 255.
		self isNaN
			ifTrue: [mantissa isZero
				ifTrue: ["BEWARE: do not convert a NaN to infinity due to truncatedBits"
					mantissa := 1]]
			ifFalse: [mantissa := 0]].
		
	"Encode the word"
	destWord := (sign bitOr: ((exponent max: 0) bitShift: 23)) bitOr: mantissa.
	^ destWord! !

!Float methodsFor: 'comparing' stamp: 'nice 3/28/2006 23:36'!
<= aNumber 
	"Primitive. Compare the receiver with the argument and return true
	if the receiver is less than or equal to the argument. Otherwise return
	false. Fail if the argument is not a Float. Optional. See Object
	documentation whatIsAPrimitive."

	<primitive: 45>
	^ aNumber adaptToFloat: self andCompare: #<=! !

!Float methodsFor: 'truncation and round off' stamp: 'GuillermoPolito 6/22/2012 14:45'!
round: numberOfWishedDecimal
        "only leave a fixed amount of decimal"
        "10.12345 round: 2 => 10.12"
        
        | v |
        v := 10 raisedTo: numberOfWishedDecimal.
        ^ ((self * v) rounded / v) asFloat
! !

!Float methodsFor: 'testing' stamp: 'ar 6/9/2000 18:56'!
isPowerOfTwo
	"Return true if the receiver is an integral power of two.
	Floats never return true here."
	^false! !

!Float methodsFor: 'converting' stamp: ''!
radiansToDegrees
	"Answer the receiver in degrees. Assumes the receiver is in radians."

	^self / RadiansPerDegree! !

!Float methodsFor: 'mathematical functions' stamp: 'jmv 10/13/2011 09:03'!
nthRoot: aPositiveInteger
	"Answer the nth root of the receiver."
	aPositiveInteger = 2 ifTrue: [
		^self sqrt ].

	(aPositiveInteger isInteger not or: [ aPositiveInteger negative ])
		ifTrue: [^ ArithmeticError signal: 'nth root only defined for positive Integer n.'].
	
	^self negative
		ifTrue: [
			aPositiveInteger odd
				ifTrue: [ (self negated raisedTo: 1.0 / aPositiveInteger) negated ]
				ifFalse: [ ArithmeticError signal: 'Negative numbers don''t have even roots.' ]]
		ifFalse: [ self raisedTo: 1.0 / aPositiveInteger ]! !

!Float methodsFor: 'comparing' stamp: 'nice 3/28/2006 23:36'!
< aNumber 
	"Primitive. Compare the receiver with the argument and return true
	if the receiver is less than the argument. Otherwise return false.
	Fail if the argument is not a Float. Essential. See Object documentation
	whatIsAPrimitive."

	<primitive: 43>
	^ aNumber adaptToFloat: self andCompare: #<! !

!Float methodsFor: 'mathematical functions' stamp: 'nice 11/1/2010 11:56'!
degreeCos
	"Take care of exceptional values"
	
	self isFinite ifTrue: [^super degreeCos].
	^self degreesToRadians cos! !

!Float methodsFor: 'mathematical functions' stamp: 'laza 12/21/1999 12:15'!
safeArcCos
	"Answer the angle in radians."
	(self between: -1.0 and: 1.0)
		ifTrue: [^ self arcCos]
		ifFalse: [^ self sign arcCos]! !

!Float methodsFor: 'converting' stamp: 'di 11/6/1998 13:38'!
adaptToFraction: rcvr andSend: selector
	"If I am involved in arithmetic with a Fraction, convert it to a Float."
	^ rcvr asFloat perform: selector with: self! !

!Float methodsFor: 'testing' stamp: 'tao 10/10/97 16:39'!
isNaN
	"simple, byte-order independent test for Not-a-Number"

	^ self ~= self! !

!Float methodsFor: 'converting' stamp: 'nice 1/4/2009 20:31'!
adaptToInteger: rcvr andCompare: selector 
	"If I am involved in comparison with an Integer, convert myself to a
	Fraction. This way, no bit is lost and comparison is exact."
	
	self isFinite
		ifFalse: [
			selector == #= ifTrue: [^false].
			selector == #~= ifTrue: [^true].
			self isNaN ifTrue: [^ false].
			(selector = #< or: [selector = #'<='])
				ifTrue: [^ self positive].
			(selector = #> or: [selector = #'>='])
				ifTrue: [^ self positive not].
			^self error: 'unknow comparison selector'].
		
	"Try to avoid asTrueFraction because it can cost"
	selector == #= ifTrue: [
		self fractionPart = 0.0 ifFalse: [^false]].
	selector == #~= ifTrue: [
		self fractionPart = 0.0 ifFalse: [^true]].
	
	^ rcvr perform: selector with: self asTrueFraction! !

!Float methodsFor: 'truncation and round off' stamp: 'nice 12/1/2009 12:07'!
ulp
	"Answer the unit of least precision of self (the power of two corresponding to last bit of mantissa)"
	
	| exponent |
	self isFinite ifFalse: [
		self isNaN ifTrue: [^self].
		^Float infinity].
	self = 0.0 ifTrue: [^Float fmin].
	exponent := self exponent.
	^exponent < self class emin
		ifTrue: [Float fminDenormalized]
 		ifFalse: [Float epsilon timesTwoPower: exponent]! !

!Float methodsFor: 'arithmetic' stamp: 'nice 8/21/2010 22:31'!
abs
	"This is faster than using Number abs and works for negativeZero."
	self <= 0.0
		ifTrue: [^ 0.0 - self]
		ifFalse: [^ self]! !

!Float methodsFor: 'accessing' stamp: 'StephaneDucasse 9/24/2010 20:47'!
basicAt: index put: value
	"Primitive. Assumes receiver is indexable. Store the second argument 
	value in the indexable element of the receiver indicated by index. Fail 
	if the index is not an Integer or is out of bounds. Or fail if the value is 
	not of the right type for this kind of collection. Answer the value that 
	was stored. Essential. Do not override in a subclass. See Object 
	documentation whatIsAPrimitive.

	This version of basicAt: is specifically for floats, answering the most significant
	word for index 1 and the least significant word for index 2.  This alows the VM
	to store floats in whatever order it chooses while it appears to the image that
	they are always in big-endian/PowerPC order."

	<primitive: 39>
	^super basicAt: index put: value! !

!Float methodsFor: 'mathematical functions' stamp: ''!
arcTan
	"Answer the angle in radians.
	 Optional. See Object documentation whatIsAPrimitive."

	| theta eps step sinTheta cosTheta |
	<primitive: 57>

	"Newton-Raphson"
	self < 0.0 ifTrue: [ ^ 0.0 - (0.0 - self) arcTan ].

	"first guess"
	theta := (self * Halfpi) / (self + 1.0).

	"iterate"
	eps := Halfpi * Epsilon.
	step := theta.
	[(step * step) > eps] whileTrue: [
		sinTheta := theta sin.
		cosTheta := theta cos.
		step := (sinTheta * cosTheta) - (self * cosTheta * cosTheta).
		theta := theta - step].
	^ theta! !

!Float methodsFor: 'truncation and round off' stamp: 'nice 12/2/2009 17:35'!
predecessor
	| ulp |
	self isFinite ifFalse: [
		(self isNaN or: [self negative]) ifTrue: [^self].
		^Float fmax].
	self = 0.0 ifTrue: [^Float fmin negated].
	ulp := self ulp.
	^self - (0.5 * ulp) = self
		ifTrue: [self - ulp]
		ifFalse: [self - (0.5 * ulp)]! !

!Float methodsFor: 'mathematical functions' stamp: ''!
sin
	"Answer the sine of the receiver taken as an angle in radians.
	 Optional. See Object documentation whatIsAPrimitive."

	| sum delta self2 i |
	<primitive: 56>

	"Taylor series"
	"normalize to the range [0..Pi/2]"
	self < 0.0 ifTrue: [^ (0.0 - ((0.0 - self) sin))].
	self > Twopi ifTrue: [^ (self \\ Twopi) sin].
	self > Pi ifTrue: [^ (0.0 - (self - Pi) sin)].
	self > Halfpi ifTrue: [^ (Pi - self) sin].

	"unroll loop to avoid use of abs"
	sum := delta := self.
	self2 := 0.0 - (self * self).
	i := 2.0.
	[delta > Epsilon] whileTrue: [
		"once"
		delta := (delta * self2) / (i * (i + 1.0)).
		i := i + 2.0.
		sum := sum + delta.
		"twice"
		delta := (delta * self2) / (i * (i + 1.0)).
		i := i + 2.0.
		sum := sum + delta].
	^ sum! !

!Float methodsFor: 'converting' stamp: 'sma 5/3/2000 21:46'!
asFraction
	^ self asTrueFraction ! !

!Float methodsFor: 'mathematical functions' stamp: 'nice 5/16/2012 21:15'!
floorLog: radix
	"Answer the floor of the log base radix of the receiver.
	The result may be off by one due to rounding errors, except in base 2."

	(radix = 2 and: [self > 0.0]) ifTrue: [^self exponent].
	^ (self log: radix) floor
! !

!Float methodsFor: 'mathematical functions' stamp: ''!
timesTwoPower: anInteger 
	"Primitive. Answer with the receiver multiplied by 2.0 raised
	to the power of the argument.
	Optional. See Object documentation whatIsAPrimitive."

	<primitive: 54>

	anInteger < -29 ifTrue: [^ self * (2.0 raisedToInteger: anInteger)].
	anInteger < 0 ifTrue: [^ self / (1 bitShift: (0 - anInteger)) asFloat].
	anInteger < 30 ifTrue: [^ self * (1 bitShift: anInteger) asFloat].
	^ self * (2.0 raisedToInteger: anInteger)! !

!Float methodsFor: 'mathematical functions' stamp: 'nice 10/30/2009 22:21'!
arcTan: denominator
	"Answer the angle in radians.
	 Optional. See Object documentation whatIsAPrimitive.
	Implementation note: use sign in order to catch cases of negativeZero"

	^self = 0.0
		ifTrue: [denominator sign >= 0
			ifTrue: [ 0 ]
			ifFalse: [ self sign >= 0
				ifTrue: [ Pi ]
				ifFalse: [ Pi negated ]]]
		ifFalse: [denominator = 0.0
			ifTrue: [self > 0.0
				ifTrue: [ Halfpi ]
				ifFalse: [ Halfpi negated ]]
			ifFalse: [denominator > 0
				ifTrue: [ (self / denominator) arcTan ]
				ifFalse: [self > 0
					ifTrue: [ ((self / denominator) arcTan) + Pi ]
					ifFalse: [ ((self / denominator) arcTan) - Pi ]]]]! !

!Float methodsFor: 'printing' stamp: 'KrisGybels 10/22/2014 17:39'!
binaryLiteralString

	^ String streamContents: [ :stream | self printBinaryLiteralOn: stream ]! !

!Float methodsFor: 'mathematical functions' stamp: 'tao 4/19/98 23:22'!
reciprocalFloorLog: radix 
	"Quick computation of (self log: radix) floor, when self < 1.0.
	Avoids infinite recursion problems with denormalized numbers"

	| adjust scale n |
	adjust := 0.
	scale := 1.0.
	[(n := radix / (self * scale)) isInfinite]
		whileTrue:
			[scale := scale * radix.
			adjust := adjust + 1].
	^ ((n floorLog: radix) + adjust) negated! !

!Float methodsFor: 'comparing' stamp: 'nice 7/10/2009 22:14'!
>= aNumber 
	"Primitive. Compare the receiver with the argument and return true
	if the receiver is greater than or equal to the argument. Otherwise return
	false. Fail if the argument is not a Float. Optional. See Object documentation 
	whatIsAPrimitive. "

	<primitive: 46>
	^ aNumber adaptToFloat: self andCompare: #>=! !

!Float methodsFor: 'arithmetic' stamp: 'nice 12/20/2012 23:16'!
negated
	"Answer a Number that is the negation of the receiver.
	Implementation note: this version cares of negativeZero."

	^-1.0 * self! !

!Float methodsFor: 'mathematical functions' stamp: ''!
exp
	"Answer E raised to the receiver power.
	 Optional. See Object documentation whatIsAPrimitive." 

	| base fract correction delta div |
	<primitive: 59>

	"Taylor series"
	"check the special cases"
	self < 0.0 ifTrue: [^ (self negated exp) reciprocal].
	self = 0.0 ifTrue: [^ 1].
	self abs > MaxValLn ifTrue: [self error: 'exp overflow'].

	"get first approximation by raising e to integer power"
	base := E raisedToInteger: (self truncated).

	"now compute the correction with a short Taylor series"
	"fract will be 0..1, so correction will be 1..E"
	"in the worst case, convergance time is logarithmic with 1/Epsilon"
	fract := self fractionPart.
	fract = 0.0 ifTrue: [ ^ base ].  "no correction required"

	correction := 1.0 + fract.
	delta := fract * fract / 2.0.
	div := 2.0.
	[delta > Epsilon] whileTrue: [
		correction := correction + delta.
		div := div + 1.0.
		delta := delta * fract / div].
	correction := correction + delta.
	^ base * correction! !

!Float methodsFor: 'mathematical functions' stamp: ''!
log
	"Answer the base 10 logarithm of the receiver."

	^ self ln / Ln10! !

!Float methodsFor: 'arithmetic' stamp: 'GabrielOmarCotelli 5/23/2009 20:40'!
reciprocal

	"Returns the reciprocal.
	If self is 0.0 the / signals a ZeroDivide"
	
	^1.0 / self! !

!Float methodsFor: 'printing' stamp: 'ClementBera 9/27/2013 17:26'!
absPrintExactlyOn: aStream base: base
	"Print my value on a stream in the given base.  Assumes that my value is strictly
	positive; negative numbers, zero, and NaNs have already been handled elsewhere.
	Based upon the algorithm outlined in:
	Robert G. Burger and R. Kent Dybvig
	Printing Floating Point Numbers Quickly and Accurately
	ACM SIGPLAN 1996 Conference on Programming Language Design and Implementation
	June 1996.
	This version guarantees that the printed representation exactly represents my value
	by using exact integer arithmetic."

	| fBase significand exp baseExpEstimate be be1 r s mPlus mMinus scale roundingIncludesLimits d tc1 tc2 fixedFormat decPointCount |
	self isInfinite ifTrue: [
			aStream nextPutAll: 'Float infinity'.
			^ self].
	fBase := base asFloat.
	significand := self significandAsInteger.
	roundingIncludesLimits := significand even.
	exp := (self exponent - 52) max: MinValLogBase2.
	baseExpEstimate := (self exponent * fBase reciprocalLogBase2 - 1.0e-10) ceiling.
	exp >= 0
		ifTrue:
			[be := 1 << exp.
			significand ~= 16r10000000000000
				ifTrue:
					[r := significand * be * 2.
					s := 2.
					mPlus := be]
				ifFalse:
					[be1 := be * 2.
					r := significand * be1 * 2.
					s := 4.
					mPlus := be1].
				mMinus := be]
		ifFalse:
			[(exp = MinValLogBase2) | (significand ~= 16r10000000000000)
				ifTrue:
					[r := significand * 2.
					s := (1 << (exp negated)) * 2.
					mPlus := 1]
				ifFalse:
					[r := significand * 4.
					s := (1 << (exp negated + 1)) * 2.
					mPlus := 2].
				mMinus := 1].
	baseExpEstimate >= 0
		ifTrue: [s := s * (base raisedToInteger: baseExpEstimate)]
		ifFalse:
			[scale := base raisedToInteger: baseExpEstimate negated.
			r := r * scale.
			mPlus := mPlus * scale.
			mMinus := mMinus * scale].
	(r + mPlus > s) | (roundingIncludesLimits & (r + mPlus = s))
		ifTrue: [baseExpEstimate := baseExpEstimate + 1]
		ifFalse:
			[r := r * base.
			mPlus := mPlus * base.
			mMinus := mMinus * base].
	(fixedFormat := baseExpEstimate between: -3 and: 6)
		ifTrue:
			[decPointCount := baseExpEstimate.
			baseExpEstimate <= 0
				ifTrue: [aStream nextPutAll: ('0.000000' truncateTo: 2 - baseExpEstimate)]]
		ifFalse:
			[decPointCount := 1]. 
	[d := r // s.
	r := r \\ s.
	(tc1 := (r < mMinus) | (roundingIncludesLimits & (r = mMinus))) |
	(tc2 := (r + mPlus > s) | (roundingIncludesLimits & (r + mPlus = s)))] whileFalse:
		[aStream nextPut: (Character digitValue: d).
		r := r * base.
		mPlus := mPlus * base.
		mMinus := mMinus * base.
		decPointCount := decPointCount - 1.
		decPointCount = 0 ifTrue: [aStream nextPut: $.]].
	tc2 ifTrue:
		[tc1 not | (tc1 & (r*2 >= s)) ifTrue: [d := d + 1]].
	aStream nextPut: (Character digitValue: d).
	decPointCount > 0
		ifTrue:
		[decPointCount - 1 to: 1 by: -1 do: [:i | aStream nextPut: $0].
		aStream nextPutAll: '.0'].
	fixedFormat ifFalse:
		[aStream nextPut: $e.
		aStream nextPutAll: (baseExpEstimate - 1) printString]! !

!Float methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 2/8/2013 15:48'!
absPrintInexactlyOn: aStream base: base
	"Print my value on a stream in the given base.  Assumes that my value is strictly
	positive; negative numbers, zero, and NaNs have already been handled elsewhere.
	Based upon the algorithm outlined in:
	Robert G. Burger and R. Kent Dybvig
	Printing Floating Point Numbers Quickly and Accurately
	ACM SIGPLAN 1996 Conference on Programming Language Design and Implementation
	June 1996.
	This version performs all calculations with Floats instead of LargeIntegers, and loses
	about 3 lsbs of accuracy compared to an exact conversion."

	| significantBits fBase exp baseExpEstimate r s mPlus mMinus scale d tc1 tc2 fixedFormat decPointCount |
	self isInfinite ifTrue: [aStream nextPutAll: 'Float infinity'. ^ self].
	significantBits := 50.  "approximately 3 lsb's of accuracy loss during conversion"
	fBase := base asFloat.
	exp := self exponent.
	baseExpEstimate := (exp * fBase reciprocalLogBase2 - 1.0e-10) ceiling.
	exp >= 0
		ifTrue:
			[r := self.
			s := 1.0.
			mPlus := 1.0 timesTwoPower: exp - significantBits.
			mMinus := self significand ~= 1.0 ifTrue: [mPlus] ifFalse: [mPlus / 2.0]]
		ifFalse:
			[r := self timesTwoPower: significantBits.
			s := 1.0 timesTwoPower:  significantBits.
			mMinus := 1.0 timesTwoPower: (exp max: -1024).
			mPlus :=
				(exp = MinValLogBase2) | (self significand ~= 1.0)
					ifTrue: [mMinus]
					ifFalse: [mMinus * 2.0]].
	baseExpEstimate >= 0
		ifTrue:
			[s := s * (fBase raisedToInteger: baseExpEstimate).
			exp = 1023
				ifTrue:   "scale down to prevent overflow to Infinity during conversion"
					[r := r / fBase.
					s := s / fBase.
					mPlus := mPlus / fBase.
					mMinus := mMinus / fBase]]
		ifFalse:
			[exp < -1023
				ifTrue:   "scale up to prevent denorm reciprocals overflowing to Infinity"
					[d := (53 * fBase reciprocalLogBase2 - 1.0e-10) ceiling.
					scale := fBase raisedToInteger: d.
					r := r * scale.
					mPlus := mPlus * scale.
					mMinus := mMinus * scale.
					scale := fBase raisedToInteger: (baseExpEstimate + d) negated]
				ifFalse:
				[scale := fBase raisedToInteger: baseExpEstimate negated].
			s := s / scale].
	(r + mPlus >= s)
		ifTrue: [baseExpEstimate := baseExpEstimate + 1]
		ifFalse:
			[s := s / fBase].
	(fixedFormat := baseExpEstimate between: -3 and: 6)
		ifTrue:
			[decPointCount := baseExpEstimate.
			baseExpEstimate <= 0
				ifTrue: [aStream nextPutAll: ('0.000000' truncateTo: 2 - baseExpEstimate)]]
		ifFalse:
			[decPointCount := 1].
	[d := (r / s) truncated.
	r := r - (d * s).
	(tc1 := r <= mMinus) | (tc2 := r + mPlus >= s)] whileFalse:
		[aStream nextPut: (Character digitValue: d).
		r := r * fBase.
		mPlus := mPlus * fBase.
		mMinus := mMinus * fBase.
		decPointCount := decPointCount - 1.
		decPointCount = 0 ifTrue: [aStream nextPut: $.]].
	tc2 ifTrue:
		[tc1 not | (tc1 & (r*2.0 >= s)) ifTrue: [d := d + 1]].
	aStream nextPut: (Character digitValue: d).
	decPointCount > 0
		ifTrue:
		[decPointCount - 1 to: 1 by: -1 do: [:i | aStream nextPut: $0].
		aStream nextPutAll: '.0'].
	fixedFormat ifFalse:
		[aStream nextPut: $e.
		aStream nextPutAll: (baseExpEstimate - 1) printString]! !

!Float methodsFor: 'accessing' stamp: 'eem 4/19/2009 18:03'!
at: index put: value 
	^self basicAt: index put: value! !

!Float methodsFor: 'truncation and round off' stamp: 'nice 7/24/2008 01:32'!
rounded
	"Answer the integer nearest the receiver.
	Implementation note: super would not handle tricky inexact arithmetic"
	
	"self assert: 5000000000000001.0 rounded = 5000000000000001"

	self fractionPart abs < 0.5
		ifTrue: [^self truncated]
		ifFalse: [^self truncated + self sign rounded]! !

!Float methodsFor: 'arithmetic' stamp: 'NicolaiHess 3/20/2015 22:47'!
/ aNumber 
	"Primitive. Answer the result of dividing receiver by aNumber.
	Fail if the argument is not a Float. Essential. See Object documentation
	whatIsAPrimitive."

	<primitive: 50>
	aNumber = 0.0 ifTrue: [ ^ ZeroDivide signalWithDividend: self].
	^aNumber adaptToFloat: self andSend: #/! !

!Float methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TommasoDalSasso 1/30/2015 16:42'!
gtInspectorVariableValuePairs
	
	^ OrderedCollection
		with: '1' -> (self at: 1)
		with: '2' -> (self at: 2)! !

!Float methodsFor: 'mathematical functions' stamp: 'tao 10/15/97 14:23'!
reciprocalLogBase2
	"optimized for self = 10, for use in conversion for printing"

	^ self = 10.0
		ifTrue: [Ln2 / Ln10]
		ifFalse: [Ln2 / self ln]! !

!Float methodsFor: 'printing' stamp: 'StephaneDucasse 7/21/2010 17:41'!
hex  

	^ String streamContents:
		[:strm | | word nibble |
		1 to: 2 do:
			[:i | word := self at: i.
			1 to: 8 do: 
				[:s | nibble := (word bitShift: -8+s*4) bitAnd: 16rF.
				strm nextPut: ('0123456789ABCDEF' at: nibble+1)]]]
"
(-2.0 to: 2.0) collect: [:f | f hex]
"! !

!Float methodsFor: 'comparing' stamp: 'nice 7/19/2009 19:27'!
closeTo: num
 	"are these two numbers close?"
	num isNumber ifFalse: [^[self = num] ifError: [false]].
	self = 0.0 ifTrue: [^num abs < 0.0001].
	num = 0 ifTrue: [^self abs < 0.0001].
	^self = num asFloat
		or: [(self - num) abs / (self abs max: num abs) < 0.0001]! !

!Float methodsFor: 'converting' stamp: 'nice 1/4/2009 20:31'!
adaptToFraction: rcvr andCompare: selector 
	"If I am involved in comparison with a Fraction, convert myself to a
	Fraction. This way, no bit is lost and comparison is exact."
	
	self isFinite
		ifFalse: [
			selector == #= ifTrue: [^false].
			selector == #~= ifTrue: [^true].
			self isNaN ifTrue: [^ false].
			(selector = #< or: [selector = #'<='])
				ifTrue: [^ self positive].
			(selector = #> or: [selector = #'>='])
				ifTrue: [^ self positive not].
			^self error: 'unknow comparison selector'].
		
	"Try to avoid asTrueFraction because it can cost"
	selector == #= ifTrue: [
		rcvr denominator isPowerOfTwo ifFalse: [^false]].
	selector == #~= ifTrue: [
		rcvr denominator isPowerOfTwo ifFalse: [^true]].

	^ rcvr perform: selector with: self asTrueFraction! !

!Float methodsFor: 'truncation and round off' stamp: ''!
fractionPart
	"Primitive. Answer a Float whose value is the difference between the 
	receiver and the receiver's asInteger value. Optional. See Object 
	documentation whatIsAPrimitive."

	<primitive: 52>
	^self - self truncated asFloat! !

!Float methodsFor: 'mathematical functions' stamp: 'jm 4/28/1998 01:10'!
sign
	"Answer 1 if the receiver is greater than 0, -1 if less than 0, else 0.
	Handle IEEE-754 negative-zero by reporting a sign of -1"

	self > 0 ifTrue: [^ 1].
	(self < 0 or: [((self at: 1) bitShift: -31) = 1]) ifTrue: [^ -1].
	^ 0! !

!Float methodsFor: 'mathematical functions' stamp: ''!
arcCos
	"Answer the angle in radians."

	^ Halfpi - self arcSin! !

!Float methodsFor: 'testing' stamp: ''!
isFloat
	^ true! !

!Float methodsFor: 'printing' stamp: 'nice 11/3/2011 20:26'!
asMinimalDecimalFraction
	"Answer the shortest decimal Fraction that will equal self when converted back asFloat.
	A decimal Fraction has only powers of 2 and 5 as decnominator.
	For example, 0.1 asMinimalDecimalFraction = (1/10)."

	| significand exp baseExpEstimate r s mPlus mMinus scale roundingIncludesLimits d tc1 tc2 fixedFormat decPointCount slowbit shead denominator numerator |
	self isFinite ifFalse: [self error: 'Only finite Float can be converted to a Fraction'].
	self = 0.0 ifTrue: [^0].
	self < 0.0 ifTrue: [^self negated asMinimalDecimalFraction negated].
	numerator := 0.
	denominator := 0.
	significand := self significandAsInteger.
	roundingIncludesLimits := significand even.
	exp := (self exponent - 52) max: MinValLogBase2.
	baseExpEstimate := (self exponent * 10 asFloat reciprocalLogBase2 - 1.0e-10) ceiling.
	exp >= 0
		ifTrue:
			[significand ~= 16r10000000000000
				ifTrue:
					[r := significand bitShift: 1 + exp.
					s := 2.
					mPlus := mMinus := 1 bitShift: exp]
				ifFalse:
					[r := significand bitShift: 2 + exp.
					s := 4.
					mPlus := 2 * (mMinus := 1 bitShift: exp)]]
		ifFalse:
			[(exp = MinValLogBase2 or: [significand ~= 16r10000000000000])
				ifTrue:
					[r := significand bitShift: 1.
					s := 1 bitShift: 1 - exp.
					mPlus := mMinus := 1]
				ifFalse:
					[r := significand bitShift: 2.
					s := 1 bitShift: 2 - exp.
					mPlus := 2.
					mMinus := 1]].
	baseExpEstimate >= 0
		ifTrue: [s := s * (10 raisedToInteger: baseExpEstimate)]
		ifFalse:
			[scale := 10 raisedToInteger: baseExpEstimate negated.
			r := r * scale.
			mPlus := mPlus * scale.
			mMinus := mMinus * scale].
	((r + mPlus < s) not and: [roundingIncludesLimits or: [r + mPlus > s]])
		ifTrue: [baseExpEstimate := baseExpEstimate + 1]
		ifFalse:
			[r := r * 10.
			mPlus := mPlus * 10.
			mMinus := mMinus * 10].
	(fixedFormat := baseExpEstimate between: -3 and: 6)
		ifTrue:
			[decPointCount := baseExpEstimate.
			baseExpEstimate <= 0
				ifTrue: [denominator := 10 raisedTo: baseExpEstimate negated]]
		ifFalse:
			[decPointCount := 1].
	slowbit := 1 - s lowBit .
	shead := s bitShift: slowbit.
	[d := (r bitShift: slowbit) // shead.
	r := r - (d * s).
	(tc1 := (r > mMinus) not and: [roundingIncludesLimits or: [r < mMinus]]) |
	(tc2 := (r + mPlus < s) not and: [roundingIncludesLimits or: [r + mPlus > s]])] whileFalse:
		[numerator := 10 * numerator + d.
		denominator := 10 * denominator.
		r := r * 10.
		mPlus := mPlus * 10.
		mMinus := mMinus * 10.
		decPointCount := decPointCount - 1.
		decPointCount = 0 ifTrue: [denominator := 1]].
	tc2 ifTrue:
		[(tc1 not or: [r * 2 >= s]) ifTrue: [d := d + 1]].
	numerator := 10 * numerator + d.
	denominator := 10 * denominator.
	decPointCount > 0
		ifTrue:
		[numerator := (10 raisedTo: decPointCount - 1) * numerator].
	fixedFormat ifFalse:
		[(baseExpEstimate - 1) > 0
			ifTrue: [numerator := (10 raisedTo: baseExpEstimate - 1) * numerator]
			ifFalse: [denominator := (10 raisedTo: 1 - baseExpEstimate) * (denominator max: 1)]].
	denominator < 2 ifTrue: [^numerator].
	^numerator / denominator! !

!Float methodsFor: '*Fuel' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper

	^aGeneralMapper visitHookPrimitive: self! !

!Float methodsFor: '*GT-InspectorExtensions-Core' stamp: 'SvenVanCaekenberghe 12/1/2014 21:52'!
gtInspectorFloatIn: composite
	<gtInspectorPresentationOrder: 30>
	^ composite table
		title: 'Float';
		display: [ 
			(self respondsTo: #binaryLiteralString)
				ifTrue: [
					{'binary' -> self binaryLiteralString.
					'significand' -> self significand.
					'exponent' -> self exponent} ]
				ifFalse: [
					{'significand' -> self significand.
					'exponent' -> self exponent} ] ];
		column: 'Key' evaluated: #key;
		column: 'Value' evaluated: #value;
		send: #value! !

!Float methodsFor: 'arithmetic' stamp: 'di 11/6/1998 13:22'!
+ aNumber 
	"Primitive. Answer the sum of the receiver and aNumber. Essential.
	Fail if the argument is not a Float. See Object documentation
	whatIsAPrimitive."

	<primitive: 41>
	^ aNumber adaptToFloat: self andSend: #+! !

!Float methodsFor: 'mathematical functions' stamp: ''!
tan
	"Answer the tangent of the receiver taken as an angle in radians."

	^ self sin / self cos! !

!Float methodsFor: 'converting' stamp: ''!
degreesToRadians
	"Answer the receiver in radians. Assumes the receiver is in degrees."

	^self * RadiansPerDegree! !

!Float methodsFor: 'arithmetic' stamp: 'di 11/6/1998 13:55'!
- aNumber 
	"Primitive. Answer the difference between the receiver and aNumber.
	Fail if the argument is not a Float. Essential. See Object documentation
	whatIsAPrimitive."

	<primitive: 42>
	^ aNumber adaptToFloat: self andSend: #-! !

!Float methodsFor: 'converting' stamp: 'nice 4/23/2011 02:24'!
withNegativeSign
	"Same as super, but handle the subtle case of Float negativeZero"
	
	self = 0.0 ifTrue: [^self class negativeZero].  
	^super withNegativeSign! !

!Float methodsFor: 'mathematical functions' stamp: ''!
cos
	"Answer the cosine of the receiver taken as an angle in radians."

	^ (self + Halfpi) sin! !

!Float methodsFor: 'accessing' stamp: 'eem 4/19/2009 18:03'!
at: index 
	^self basicAt: index! !

!Float methodsFor: 'printing' stamp: 'KrisGybels 10/26/2014 10:55'!
printBinaryLiteralOn: stream

	"Floats represent those numbers that can be written in Pharo notation as literals of the form {sign}2r1.{fraction}e{exponent} -- where {sign} is the minus
	sign or is empty, {fraction} is a sequence of 52 bits and {exponent} is an integer from -1022 to 1023 -- as well as those numbers that can be written
	as {sign}2r0.{fraction}e-1022 and some special values. This method prints a Float as such a literal expression, or a message expression in the case of
	the special values. Evaluating the expression always results in a Float with the exact same bit pattern, with the exception of the not-a-number Floats
	which all get printed as 'Float nan'. The following article has a table in the section 'Summary' at the end which enumerates the different bit patterns
	of Floats and how to interpret them, which was used in writing this method: http://steve.hollasch.net/cgindex/coding/ieeefloat.html"

	| signBit exponentBits fractionBits |

	signBit := (self basicAt: 1) bitShift: -31.
	exponentBits := ((self basicAt: 1) bitShift: -20) bitAnd: 2r11111111111.
	fractionBits := (((self basicAt: 1) bitAnd: 2r11111111111111111111) bitShift: 32) bitOr: (self basicAt: 2).

	(exponentBits = 2047) ifTrue: [ 
		(fractionBits = 0) ifTrue: [
			stream nextPutAll: 'Float infinity'.
			(signBit = 1) ifTrue: [ stream nextPutAll: ' negated' ].
		] ifFalse: [
			stream nextPutAll: 'Float nan'.
		].
		^ self
	].

	(signBit = 1) ifTrue: [ stream nextPut: $- ].
	(exponentBits = 0) ifTrue: [ 
		(fractionBits = 0) ifTrue: [
			stream nextPutAll: '0.0'
		] ifFalse: [
			stream nextPutAll: '2r0.'.
			fractionBits printOn: stream base: 2 length: (Float precision - 1) padded: true.
			stream nextPutAll: 'e-1022'.
		].
		^ self
	].

	stream nextPutAll: '2r1.'.
	fractionBits printOn: stream base: 2 length: (Float precision - 1) padded: true.
	stream nextPut: $e.
	(exponentBits - 1023) printOn: stream base: 10.! !

!Float methodsFor: 'copying' stamp: 'pmm 3/13/2010 11:30'!
veryDeepCopyWith: deepCopier
	"Return self.  Do not record me."

	^ self shallowCopy! !

!Float methodsFor: 'truncation and round off' stamp: 'nice 4/26/2006 05:09'!
truncated
	"Answer with a SmallInteger equal to the value of the receiver without 
	its fractional part. The primitive fails if the truncated value cannot be 
	represented as a SmallInteger. In that case, the code below will compute 
	a LargeInteger truncated value.
	Essential. See Object documentation whatIsAPrimitive. "

	<primitive: 51>
	(self isInfinite or: [self isNaN]) ifTrue: [self error: 'Cannot truncate this number'].

	self abs < 2.0e16
		ifTrue: ["Fastest way when it may not be an integer"
				"^ (self quo: 1073741823.0) * 1073741823 + (self rem: 1073741823.0) truncated"
				| di df q r |
				di := (SmallInteger maxVal bitShift: -1)+1.
				df := di asFloat.
				q := self quo: df.
				r := self - (q asFloat * df).
				^q*di+r truncated]
		ifFalse: [^ self asTrueFraction.  "Extract all bits of the mantissa and shift if necess"]

		

		! !

!Float methodsFor: 'truncation and round off' stamp: 'tk 12/30/2000 20:04'!
reduce
    "If self is close to an integer, return that integer"

    (self closeTo: self rounded) ifTrue: [^ self rounded]! !

!Float methodsFor: 'truncation and round off' stamp: ''!
integerPart
	"Answer a Float whose value is the receiver's truncated value."

	^self - self fractionPart! !

!Float methodsFor: 'converting' stamp: 'st 9/17/2004 17:14'!
asApproximateFractionAtOrder: maxOrder
	"Answer a Fraction approximating the receiver. This conversion uses the 
	continued fraction method to approximate a floating point number. If maxOrder
	is zero, use maximum order"

	| num1 denom1 num2 denom2 int frac newD temp order |
	num1 := self asInteger.	"The first of two alternating numerators"
	denom1 := 1.		"The first of two alternating denominators"
	num2 := 1.		"The second numerator"
	denom2 := 0.		"The second denominator--will update"
	int := num1.		"The integer part of self"
	frac := self fractionPart.		"The fractional part of self"
	order := maxOrder = 0 ifTrue: [-1] ifFalse: [maxOrder].
	[frac = 0 or: [order = 0] ]
		whileFalse: 
			["repeat while the fractional part is not zero and max order is not reached"
			order := order - 1.
			newD := 1.0 / frac.			"Take reciprocal of the fractional part"
			int := newD asInteger.		"get the integer part of this"
			frac := newD fractionPart.	"and save the fractional part for next time"
			temp := num2.				"Get old numerator and save it"
			num2 := num1.				"Set second numerator to first"
			num1 := num1 * int + temp.	"Update first numerator"
			temp := denom2.				"Get old denominator and save it"
			denom2 := denom1.			"Set second denominator to first"
			denom1 := int * denom1 + temp.		"Update first denominator"
			10000000000.0 < denom1
				ifTrue: 
					["Is ratio past float precision?  If so, pick which 
					of the two ratios to use"
					num2 = 0.0 
						ifTrue: ["Is second denominator 0?"
								^ Fraction numerator: num1 denominator: denom1].
					^ Fraction numerator: num2 denominator: denom2]].
	"If fractional part is zero, return the first ratio"
	denom1 = 1
		ifTrue: ["Am I really an Integer?"
				^ num1 "Yes, return Integer result"]
		ifFalse: ["Otherwise return Fraction result"
				^ Fraction numerator: num1 denominator: denom1]! !

!Float methodsFor: 'testing' stamp: 'nice 3/14/2008 23:45'!
isFinite
	"simple, byte-order independent test for rejecting Not-a-Number and (Negative)Infinity"

	^(self - self) = 0.0! !

!Float methodsFor: 'truncation and round off' stamp: ''!
exponent
	"Primitive. Consider the receiver to be represented as a power of two
	multiplied by a mantissa (between one and two). Answer with the
	SmallInteger to whose power two is raised. Optional. See Object
	documentation whatIsAPrimitive."

	| positive |
	<primitive: 53>
	self >= 1.0 ifTrue: [^self floorLog: 2].
	self > 0.0
		ifTrue: 
			[positive := (1.0 / self) exponent.
			self = (1.0 / (1.0 timesTwoPower: positive))
				ifTrue: [^positive negated]
				ifFalse: [^positive negated - 1]].
	self = 0.0 ifTrue: [^-1].
	^self negated exponent! !

!Float methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 2/8/2013 11:41'!
printOn: stream base: base
	"Handle sign, zero, and NaNs; all other values passed to FloatPrintPolicy" 

	self isNaN ifTrue: [ ^ stream nextPutAll: 'Float nan' ]. "check for NaN before sign"
	self isInfinite 
		ifTrue: [ 
			stream nextPutAll: 'Float infinity'.
			^ self sign = -1 ifTrue: [ stream nextPutAll: ' negated' ] ].
	self > 0.0
		ifTrue: [ FloatPrintPolicy absPrint: self on: stream base: base ]
		ifFalse: [
			self sign = -1 ifTrue: [ stream nextPut: $- ].
			self = 0.0
				ifTrue: [ stream nextPutAll: '0.0' ]
				ifFalse: [ FloatPrintPolicy absPrint: self negated on: stream base: base ] ]! !

!Float methodsFor: 'accessing' stamp: 'StephaneDucasse 9/24/2010 20:46'!
basicAt: index
	"Primitive. Assumes receiver is indexable. Answer the value of an 
	indexable element in the receiver. Fail if the argument index is not an 
	Integer or is out of bounds. Essential. Do not override in a subclass. See 
	Object documentation whatIsAPrimitive.

	This version of basicAt: is specifically for floats, answering the most significant
	word for index 1 and the least significant word for index 2.  This alows the VM
	to store floats in whatever order it chooses while it appears to the image that
	they are always in big-endian/PowerPC order."

	<primitive: 38>
	^super basicAt: index.
	! !

!Float methodsFor: 'comparing' stamp: 'nice 3/28/2006 23:36'!
> aNumber 
	"Primitive. Compare the receiver with the argument and return true
	if the receiver is greater than the argument. Otherwise return false.
	Fail if the argument is not a Float. Essential. See Object documentation
	whatIsAPrimitive."

	<primitive: 44>
	^ aNumber adaptToFloat: self andCompare: #>! !

!Float methodsFor: 'converting' stamp: 'nice 3/29/2006 01:01'!
asTrueFraction
	" Answer a fraction that EXACTLY represents self,
	  a double precision IEEE floating point number.
	  Floats are stored in the same form on all platforms.
	  (Does handle gradual underflow but not NANs.)
	  By David N. Smith with significant performance
	  improvements by Luciano Esteban Notarfrancesco.
	  (Version of 11April97)"
	| signexp positive expPart exp fraction fractionPart signedFraction result zeroBitsCount |
	self isInfinite ifTrue: [self error: 'Cannot represent infinity as a fraction'].
	self isNaN ifTrue: [self error: 'Cannot represent Not-a-Number as a fraction'].


	" Extract the sign and the biased exponent "
	signexp := (self basicAt: 1) bitShift: -20.
	positive := (signexp bitAnd: 16r800) = 0.
	expPart := signexp bitAnd: 16r7FF.

	" Extract fractional part; answer 0 if this is a true 0.0 value "
	fractionPart := (((self basicAt: 1) bitAnd: 16rFFFFF) bitShift: 32)+ (self basicAt: 2).
	( expPart=0 and: [ fractionPart=0 ] ) ifTrue: [ ^ 0  ].

	" Replace omitted leading 1 in fraction unless gradual underflow"
	fraction := expPart = 0
		ifTrue: [fractionPart bitShift: 1]
		ifFalse: [fractionPart bitOr: 16r0010000000000000].
	signedFraction := positive ifTrue: [fraction] ifFalse: [fraction negated].
	
	"Unbias exponent: 16r3FF is bias; 52 is fraction width"
	exp := 16r3FF + 52 - expPart.

	" Form the result. When exp>52, the exponent is adjusted by
	  the number of trailing zero bits in the fraction to minimize
	  the (huge) time otherwise spent in #gcd:. "
	exp negative
		ifTrue: [
			result := signedFraction bitShift: exp negated ]
		ifFalse:	[
			zeroBitsCount := fraction lowBit - 1.
			exp := exp - zeroBitsCount.
			exp <= 0
				ifTrue: [
					zeroBitsCount := zeroBitsCount + exp.
					"exp := 0."   " Not needed; exp not
refernced again "
					result := signedFraction bitShift:
zeroBitsCount negated ]
				ifFalse: [
					result := Fraction
						numerator: (signedFraction
bitShift: zeroBitsCount negated)
						denominator: (1 bitShift:
exp) ] ].

	"Low cost validation omitted after extensive testing"
	"(result asFloat = self) ifFalse: [self error: 'asTrueFraction validation failed']."
	^ result ! !

!Float methodsFor: 'comparing' stamp: 'nice 6/11/2009 01:03'!
hash
	"Hash is reimplemented because = is implemented. Both words of the float are used; 8 bits are removed from each end to clear most of the exponent regardless of the byte ordering. (The bitAnd:'s ensure that the intermediate results do not become a large integer.) Slower than the original version in the ratios 12:5 to 2:1 depending on values. (DNS, 11 May, 1997)"

	(self isFinite and: [self fractionPart = 0.0]) ifTrue: [^self truncated hash].
	^ (((self basicAt: 1) bitAnd: 16r00FFFF00) +
	   ((self basicAt: 2) bitAnd: 16r00FFFF00)) bitShift: -8
! !

!Float methodsFor: 'mathematical functions' stamp: 'nice 7/15/2011 13:59'!
ln
	"Answer the natural logarithm of the receiver.
	 Optional. See Object documentation whatIsAPrimitive."

	| expt n mant x div pow delta sum eps |
	<primitive: 58>

	"Taylor series"
	self <= 0.0 ifTrue: [^DomainError signal: 'ln is only defined for x > 0' from: 0].

	"get a rough estimate from binary exponent"
	expt := self exponent.
	n := Ln2 * expt.
	mant := self timesTwoPower: 0 - expt.

	"compute fine correction from mantinssa in Taylor series"
	"mant is in the range [0..2]"
	"we unroll the loop to avoid use of abs"
	x := mant - 1.0.
	div := 1.0.
	pow := delta := sum := x.
	x := x negated.  "x <= 0"
	eps := Epsilon * (n abs + 1.0).
	[delta > eps] whileTrue: [
		"pass one: delta is positive"
		div := div + 1.0.
		pow := pow * x.
		delta := pow / div.
		sum := sum + delta.
		"pass two: delta is negative"
		div := div + 1.0.
		pow := pow * x.
		delta := pow / div.
		sum := sum + delta].

	^ n + sum

	"2.718284 ln 1.0"! !

!Float methodsFor: 'mathematical functions' stamp: 'nice 11/1/2010 11:56'!
degreeSin
	"Take care of exceptional values"
	
	self isFinite ifTrue: [^super degreeSin].
	^self degreesToRadians sin! !

!Float methodsFor: 'testing' stamp: 'nice 3/14/2008 23:49'!
isLiteral
	"There is no literal representation of NaN.
	However, there are literal representations of Infinity, like 1.0e1000.
	But since they are not able to print properly, only case of finite Float is considered."
	
	^self isFinite! !

!Float methodsFor: 'mathematical functions' stamp: 'CamilloBruni 8/1/2012 16:16'!
sqrt
	"Answer the square root of the receiver. 
	 Optional. See Object documentation whatIsAPrimitive."
	| exp guess eps delta |
	<primitive: 55>
	"Newton-Raphson"
	self <= 0.0
		ifTrue: [self = 0.0
				ifTrue: [^ 0.0]
				ifFalse: ["v Chg"
					^ DomainError signal: 'sqrt undefined for number less than zero.']].
	"first guess is half the exponent"
	exp := self exponent // 2.
	guess := self timesTwoPower: 0 - exp.
	"get eps value"
	eps := guess * Epsilon.
	eps := eps * eps.
	delta := self - (guess * guess) / (guess * 2.0).
	[delta * delta > eps]
		whileTrue: 
			[guess := guess + delta.
			delta := self - (guess * guess) / (guess * 2.0)].
	^ guess! !

!Float methodsFor: 'comparing' stamp: 'KrisGybels 10/26/2014 11:51'!
literalEqual: other

	^ (super literalEqual: other) and: [ self isZero not or: [ self sign = other sign ] ]! !

!Float methodsFor: 'private' stamp: 'MarcusDenker 6/12/2014 13:30'!
absPrintOn: aStream base: base digitCount: digitCount 
	"Print me in the given base, using digitCount significant figures."

	| fuzz x exp q fBase scale logScale xi |
	self isInfinite ifTrue: [^ aStream nextPutAll: 'Infinity'].
	fBase := base asFloat.
	"x is myself normalized to [1.0, fBase), exp is my exponent"
	exp := self floorLog: fBase.
	scale := 1.0.
	logScale := 0.
	[(x := fBase raisedTo: (exp + logScale)) = 0]
		whileTrue:
			[scale := scale * fBase.
			logScale := logScale + 1].
	x := self * scale / x.
	fuzz := fBase raisedTo: 1 - digitCount.
	"round the last digit to be printed"
	x := 0.5 * fuzz + x.
	x >= fBase
		ifTrue: 
			["check if rounding has unnormalized x"
			x := x / fBase.
			exp := exp + 1].
	(exp < 6 and: [exp > -4])
		ifTrue: 
			["decimal notation"
			q := 0.
			exp < 0 ifTrue: [1 to: 1 - exp do: [:i | aStream nextPut: ('0.0000'
at: i)]]]
		ifFalse: 
			["scientific notation"
			q := exp.
			exp := 0].
	[x >= fuzz]
		whileTrue: 
			["use fuzz to track significance"
			xi := x asInteger.
			aStream nextPut: (Character digitValue: xi).
			x := x - xi asFloat * fBase.
			fuzz := fuzz * fBase.
			exp := exp - 1.
			exp = -1 ifTrue: [aStream nextPut: $.]].
	[exp >= -1]
		whileTrue: 
			[aStream nextPut: $0.
			exp := exp - 1.
			exp = -1 ifTrue: [aStream nextPut: $.]].
	q ~= 0
		ifTrue: 
			[aStream nextPut: $e.
			q printOn: aStream]! !

!Float methodsFor: 'copying' stamp: ''!
deepCopy

	^self copy! !

!Float methodsFor: 'mathematical functions' stamp: 'nice 7/15/2011 14:12'!
arcSin
	"Answer the angle in radians."

	((self < -1.0) or: [self > 1.0]) ifTrue: [^DomainError signal: 'Value out of range' from: -1 to: 1].
	((self = -1.0) or: [self = 1.0])
		ifTrue: [^ Halfpi * self]
		ifFalse: [^ (self / (1.0 - (self * self)) sqrt) arcTan]! !

!Float methodsFor: 'printing' stamp: 'nice 3/15/2008 22:41'!
storeOn: aStream 
	"Print the Number exactly so it can be interpreted back unchanged"
	
	self storeOn: aStream base: 10! !

!Float methodsFor: 'truncation and round off' stamp: 'nice 6/7/2012 00:17'!
significandAsInteger
	"Answer the mantissa of a Float shifted so as to have the ulp equal to 1.
	For exceptional values, infinity and nan, just answer the bit pattern."

	self isFinite ifTrue:
		[^(self timesTwoPower: self class precision - 1 - (self exponent max: self class emin)) truncated abs].
	^(((self basicAt: 1) bitAnd: 16r000FFFFF) bitShift: 32) bitOr: (self basicAt: 2)! !

!Float methodsFor: 'printing' stamp: 'nice 10/31/2009 23:45'!
storeOn: aStream base: base 
	"Print the Number exactly so it can be interpreted back unchanged"
	self isFinite
		ifTrue: [self sign = -1 ifTrue: [aStream nextPutAll: '-'].
			base = 10 ifFalse: [aStream print: base; nextPut: $r].
			self = 0.0
				ifTrue: [aStream nextPutAll: '0.0']
				ifFalse: [self abs absPrintExactlyOn: aStream base: base]]
		ifFalse: [self isNaN
				ifTrue: [aStream nextPutAll: 'Float nan']
				ifFalse: [self > 0.0
						ifTrue: [aStream nextPutAll: 'Float infinity']
						ifFalse: [aStream nextPutAll: 'Float infinity negated']]]! !

!Float methodsFor: 'copying' stamp: 'nice 10/4/2009 23:16'!
shallowCopy

	^self - 0.0! !

!Float methodsFor: 'printing' stamp: 'StephaneDucasse 2/28/2011 09:22'!
printPaddedWith: aCharacter to: aNumber 
	"Answer the string containing the ASCII representation of the receiver 
	padded on the left with aCharacter to be at least on aNumber 
	integerPart characters and padded the right with aCharacter to be at 
	least anInteger fractionPart characters."
	| aStream digits fPadding fLen iPadding iLen curLen periodIndex |
	#Numeric.
	"2000/03/04  Harmon R. Added Date and Time support"
	aStream := (String new: 10) writeStream.
	self printOn: aStream.
	digits := aStream contents.
	periodIndex := digits indexOf: $..
	curLen := periodIndex - 1.
	iLen := aNumber integerPart.
	curLen < iLen
		ifTrue: [iPadding := (String new: (iLen - curLen) asInteger) atAllPut: aCharacter;
					 yourself]
		ifFalse: [iPadding := ''].
	curLen := digits size - periodIndex.
	"n.b. Treat aNumber as a string format specifier rather than as a number, because
	floating point truncation can produce incorrect results for the fraction part."
	fLen := (aNumber asString copyAfterLast: $. )
		ifNotEmpty: [:s | s asInteger]
		ifEmpty: [ 0 ].
	curLen < fLen
		ifTrue: [fPadding := (String new: fLen - curLen) atAllPut: aCharacter;
					 yourself]
		ifFalse: [fPadding := ''].
	^ iPadding , digits , fPadding! !

!Float methodsFor: 'converting' stamp: 'st 9/17/2004 17:17'!
asApproximateFraction
	"Answer a Fraction approximating the receiver. This conversion uses the 
	continued fraction method to approximate a floating point number."

	^ self asApproximateFractionAtOrder: 0! !

!Float methodsFor: '*Fuel' stamp: 'MartinDias 12/30/2011 10:55'!
serializeOn: anEncoder

	anEncoder 
		encodeUint32: (self at: 1);
		encodeUint32: (self at: 2).! !

!Float methodsFor: 'mathematical functions' stamp: 'nice 4/23/2011 02:26'!
copySignTo: aNumber
	"Return a number with same magnitude as aNumber and same sign as self.
	Implementation note: take care of Float negativeZero, which is considered as having a negative sign."

	(self > 0.0 or: [(self at: 1) = 0]) ifTrue: [^ aNumber abs].
	^aNumber withNegativeSign! !

!Float methodsFor: 'converting' stamp: 'di 11/6/1998 13:07'!
adaptToInteger: rcvr andSend: selector
	"If I am involved in arithmetic with an Integer, convert it to a Float."
	^ rcvr asFloat perform: selector with: self! !

!Float methodsFor: 'testing' stamp: 'jm 4/30/1998 13:50'!
isInfinite
	"Return true if the receiver is positive or negative infinity."

	^ self = Infinity or: [self = NegativeInfinity]
! !

!Float methodsFor: 'comparing' stamp: 'nice 3/28/2006 23:36'!
= aNumber 
	"Primitive. Compare the receiver with the argument and return true
	if the receiver is equal to the argument. Otherwise return false.
	Fail if the argument is not a Float. Essential. See Object documentation
	whatIsAPrimitive."

	<primitive: 47>
	aNumber isNumber ifFalse: [^ false].
	^ aNumber adaptToFloat: self andCompare: #=! !

!Float methodsFor: 'truncation and round off' stamp: 'tao 4/19/98 13:14'!
significand

	^ self timesTwoPower: (self exponent negated)! !

!Float methodsFor: 'converting' stamp: ''!
asFloat
	"Answer the receiver itself."

	^self! !

!Float methodsFor: 'printing' stamp: 'nice 3/24/2008 16:56'!
printShowingDecimalPlaces: placesDesired
	"This implementation avoids any rounding error caused by rounded or roundTo:"
	
	^self asTrueFraction printShowingDecimalPlaces: placesDesired! !

!Float methodsFor: 'testing' stamp: 'StephaneDucasse 10/16/2011 18:14'!
isSelfEvaluating
    ^true! !

!Float methodsFor: 'truncation and round off' stamp: 'nice 12/2/2009 17:35'!
successor
	| ulp |
	self isFinite ifFalse: [
		(self isNaN or: [self positive]) ifTrue: [^self].
		^Float fmax negated].
	self = 0.0 ifTrue: [^Float fmin].
	ulp := self ulp.
	^self + (0.5 * ulp) = self
		ifTrue: [self + ulp]
		ifFalse: [self + (0.5 * ulp)]! !

!Float methodsFor: 'arithmetic' stamp: 'di 11/6/1998 13:54'!
* aNumber 
	"Primitive. Answer the result of multiplying the receiver by aNumber.
	Fail if the argument is not a Float. Essential. See Object documentation
	whatIsAPrimitive."

	<primitive: 49>
	^ aNumber adaptToFloat: self andSend: #*! !

!Float methodsFor: 'testing' stamp: ''!
isZero
	^self = 0.0! !

!Float methodsFor: 'comparing' stamp: ''!
~= aNumber 
	"Primitive. Compare the receiver with the argument and return true
	if the receiver is not equal to the argument. Otherwise return false.
	Fail if the argument is not a Float. Optional. See Object documentation
	whatIsAPrimitive."

	<primitive: 48>
	^super ~= aNumber! !

!Float class methodsFor: 'constants' stamp: 'nice 6/8/2009 15:20'!
fmax
	"Answer the maximum finite floating point value representable."
	
	^MaxVal! !

!Float class methodsFor: 'constants' stamp: 'sw 10/8/1999 22:59'!
halfPi
	^ Halfpi! !

!Float class methodsFor: 'constants' stamp: 'nice 6/8/2009 15:22'!
fminDenormalized
	"Answer the minimum denormalized value representable."
	
	^1.0 timesTwoPower: MinValLogBase2! !

!Float class methodsFor: 'instance creation' stamp: ''!
readFrom: aStream 
	"Answer a new Float as described on the stream, aStream."

	^(super readFrom: aStream) asFloat! !

!Float class methodsFor: 'constants' stamp: ''!
e
	"Answer the constant, E."

	^E! !

!Float class methodsFor: '*Fuel' stamp: 'MartinDias 12/30/2011 11:00'!
materializeFrom: aDecoder

	^ (self new: 2)
		at: 1 put: aDecoder nextEncodedUint32;
		at: 2 put: aDecoder nextEncodedUint32;
		yourself.
! !

!Float class methodsFor: 'constants' stamp: 'tao 4/23/98 11:37'!
infinity
	"Answer the value used to represent an infinite magnitude"

	^ Infinity! !

!Float class methodsFor: 'constants' stamp: 'nice 6/8/2009 15:33'!
fmin
	"Answer minimum positive representable value."
	
	^self denormalized
		ifTrue: [self fminDenormalized]
		ifFalse: [self fminNormalized]! !

!Float class methodsFor: 'constants' stamp: 'nice 6/8/2009 15:43'!
emin
	"Answer exponent of minimal normalized representable value"
	
	^-1022! !

!Float class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 3/26/2015 00:14'!
gtExampleZero
	<gtExample: 'Zero'>
	^ 0.0! !

!Float class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 3/26/2015 00:14'!
gtExampleNegativeE
	<gtExample: 'Float with negative e'>
	^ 42.42e-42! !

!Float class methodsFor: 'class initialization' stamp: 'nice 3/15/2008 22:42'!
initialize
	"Float initialize"
	"Constants from Computer Approximations, pp. 182-183:
		Pi = 3.14159265358979323846264338327950288
		Pi/2 = 1.57079632679489661923132169163975144
		Pi*2 = 6.28318530717958647692528676655900576
		Pi/180 = 0.01745329251994329576923690768488612
		2.0 ln = 0.69314718055994530941723212145817657
		2.0 sqrt = 1.41421356237309504880168872420969808"

	Pi := 3.14159265358979323846264338327950288.
	Halfpi := Pi / 2.0.
	Twopi := Pi * 2.0.
	ThreePi := Pi * 3.0.
	RadiansPerDegree := Pi / 180.0.

	Ln2 := 0.69314718055994530941723212145817657.
	Ln10 := 10.0 ln.
	Sqrt2 := 1.41421356237309504880168872420969808.
	E := 2.718281828459045235360287471353.

	Epsilon := 0.000000000001.  "Defines precision of mathematical functions"

	MaxVal := 1.7976931348623157e308.
	MaxValLn := 709.782712893384.
	MinValLogBase2 := -1074.

	Infinity := MaxVal * MaxVal.
	NegativeInfinity := 0.0 - Infinity.
	NaN := Infinity - Infinity.
	NegativeZero := 1.0 / Infinity negated.
! !

!Float class methodsFor: 'constants' stamp: 'tao 4/23/98 12:05'!
negativeZero

	^ NegativeZero! !

!Float class methodsFor: 'instance creation' stamp: 'nice 3/15/2008 00:54'!
readFrom: aStream ifFail: aBlock
	"Answer a new Float as described on the stream, aStream."

	^(super readFrom: aStream ifFail: [^aBlock value]) asFloat! !

!Float class methodsFor: 'constants' stamp: 'nice 6/8/2009 15:22'!
fminNormalized
	"Answer the minimum normalized value representable."
	
	^1.0 timesTwoPower: -1022! !

!Float class methodsFor: 'constants' stamp: 'nice 6/11/2009 12:29'!
denormalized
	"Answer whether implementation supports denormalized numbers (also known as gradual underflow)."
	
	^true! !

!Float class methodsFor: 'constants' stamp: 'nice 6/11/2009 12:40'!
precision
	"Answer the apparent precision of the floating point representation.
	That is the maximum number of radix-based digits (bits if radix=2) representable in floating point without round off error.
	Technically, 52 bits are stored in the representation, and normalized numbers have an implied leading 1 that does not need to be stored.
	Note that denormalized floating point numbers don't have the implied leading 1, and thus gradually loose precision.
	This format conforms IEEE 754 double precision standard."
	
	^53! !

!Float class methodsFor: 'constants' stamp: 'nice 6/8/2009 15:16'!
radix
	"Answer the radix used for internal floating point representation."
	
	^2! !

!Float class methodsFor: 'constants' stamp: 'tao 4/23/98 11:38'!
nan
	"Answer the canonical value used to represent Not-A-Number"

	^ NaN! !

!Float class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 3/26/2015 00:13'!
gtExampleE
	<gtExample: 'Float with e'>
	^ 42.42e42! !

!Float class methodsFor: '*Spec-Inspector' stamp: 'SvenVanCaekenberghe 12/21/2013 20:46'!
inspectorClass
	^ EyeFloatInspector! !

!Float class methodsFor: 'instance creation' stamp: 'nice 12/26/2014 13:06'!
fromIEEE32Bit: word
	"Convert the given 32 bit word (which is supposed to be a positive 32bit value) from a 32bit IEEE floating point representation into an actual Pharo float object (being 64bit wide). Should only be used for conversion in FloatArrays or likewise objects."
	
	| sign mantissa exponent newFloat shiftToNormalize |
	word negative ifTrue: [^ self error:'Cannot deal with negative numbers'].
	word = 0 ifTrue: [^ 0.0].
	sign := word bitAnd: 16r80000000.
	word = sign ifTrue: [^self negativeZero].
	
	exponent := ((word bitShift: -23) bitAnd: 16rFF) - 127.
	mantissa := word bitAnd:  16r7FFFFF.

	exponent = 128 ifTrue:["Either NAN or INF"
		mantissa = 0 ifFalse:[^ Float nan].
		sign = 0 
			ifTrue:[^ Float infinity]
			ifFalse:[^ Float infinity negated]].

	exponent = -127 ifTrue: [
		"gradual underflow (denormalized number)
		Shift the mantissa and remove leading 1 to normalize the Float"
		shiftToNormalize := 24 - mantissa highBit.
		mantissa := (mantissa bitShift: shiftToNormalize) bitAnd: 16r7FFFFF.
		exponent := -126 - shiftToNormalize].
	
	"Create new float"
	newFloat := self new: 2.
	newFloat basicAt: 1 put: ((sign bitOr: (1023 + exponent bitShift: 20)) bitOr: (mantissa bitShift: -3)).
	newFloat basicAt: 2 put: ((mantissa bitAnd: 7) bitShift: 29).
	^newFloat! !

!Float class methodsFor: 'constants' stamp: 'GabrielOmarCotelli 5/25/2009 15:42'!
one
	
	^1.0! !

!Float class methodsFor: 'instance creation' stamp: 'KrisGybels 10/22/2014 17:43'!
fromIEEE64Bit: doubleWord

    ^ (self new: 2) basicAt: 1 put: (doubleWord bitShift: -32); basicAt: 2 put: (doubleWord bitAnd: 16rFFFFFFFF); yourself! !

!Float class methodsFor: 'constants' stamp: 'nice 6/11/2009 12:30'!
epsilon
	"Answer difference between 1.0 and previous representable value"
	
	^1.0 timesTwoPower: 1 - self precision! !

!Float class methodsFor: 'constants' stamp: 'nice 6/8/2009 15:42'!
emax
	"Answer exponent of maximal representable value"
	
	^1023! !

!Float class methodsFor: 'constants' stamp: 'yo 6/17/2004 17:44'!
threePi

	^ ThreePi
! !

!Float class methodsFor: 'constants' stamp: ''!
pi
	"Answer the constant, Pi."

	^Pi! !

!Float class methodsFor: 'constants' stamp: 'jmv 10/13/2011 19:57'!
maxExactInteger
	"Answer the biggest integer such that it is exactly represented in a float, and all smaller integers also are"
	^1 bitShift: self precision! !

!Float class methodsFor: 'constants' stamp: 'yo 6/17/2004 17:41'!
twoPi

	^ Twopi
! !

!FloatArray commentStamp: '<historical>'!
FloatArrays store 32bit IEEE floating point numbers.!
!FloatArray methodsFor: '*Collections-arithmetic' stamp: 'ar 9/14/1998 22:48'!
+= anObject
	^anObject isNumber
		ifTrue:[self primAddScalar: anObject asFloat]
		ifFalse:[self primAddArray: anObject]! !

!FloatArray methodsFor: 'primitives-plugin' stamp: 'ar 2/2/2001 15:47'!
primMulScalar: scalarValue

	<primitive: 'primitiveMulScalar' module: 'FloatArrayPlugin'>
	1 to: self size do:[:i| self at: i put: (self at: i) * scalarValue].! !

!FloatArray methodsFor: 'primitives-plugin' stamp: 'ar 2/2/2001 15:47'!
primAddScalar: scalarValue

	<primitive: 'primitiveAddScalar' module: 'FloatArrayPlugin'>
	1 to: self size do:[:i| self at: i put: (self at: i) + scalarValue].! !

!FloatArray methodsFor: '*Collections-arithmetic' stamp: 'yo 9/14/2004 17:12'!
\\= other

	other isNumber ifTrue: [
		1 to: self size do: [:i |
			self at: i put: (self at: i) \\ other
		].
		^ self.
	].
	1 to: (self size min: other size) do: [:i |
		self at: i put: (self at: i) \\ (other at: i).
	].

! !

!FloatArray methodsFor: 'primitives-plugin' stamp: 'ar 2/2/2001 15:47'!
primDivScalar: scalarValue

	<primitive: 'primitiveDivScalar' module: 'FloatArrayPlugin'>
	1 to: self size do:[:i| self at: i put: (self at: i) / scalarValue].! !

!FloatArray methodsFor: 'primitives-plugin' stamp: 'ar 2/2/2001 15:47'!
primAddArray: floatArray

	<primitive: 'primitiveAddFloatArray' module: 'FloatArrayPlugin'>
	1 to: self size do:[:i| self at: i put: (self at: i) + (floatArray at: i)].! !

!FloatArray methodsFor: '*Collections-arithmetic' stamp: 'GuillermoPolito 2/18/2011 07:23'!
+ anObject
	^self copy += anObject! !

!FloatArray methodsFor: '*Collections-arithmetic' stamp: 'StephaneDucasse 12/24/2011 12:04'!
- anObject
	^self shallowCopy -= anObject! !

!FloatArray methodsFor: 'accessing' stamp: 'ar 2/2/2001 15:47'!
at: index
	<primitive: 'primitiveAt' module: 'FloatArrayPlugin'>
	^Float fromIEEE32Bit: (self basicAt: index)! !

!FloatArray methodsFor: 'converting' stamp: 'ar 9/14/1998 23:46'!
asFloatArray
	^self! !

!FloatArray methodsFor: '*Collections-arithmetic' stamp: 'ar 9/14/1998 22:49'!
-= anObject
	^anObject isNumber
		ifTrue:[self primSubScalar: anObject asFloat]
		ifFalse:[self primSubArray: anObject]! !

!FloatArray methodsFor: 'primitives-plugin' stamp: 'jcg 6/12/2003 17:54'!
sum

	<primitive: 'primitiveSum' module: 'FloatArrayPlugin'>
	^ super sum! !

!FloatArray methodsFor: '*Collections-arithmetic' stamp: 'ar 9/14/1998 22:49'!
*= anObject
	^anObject isNumber
		ifTrue:[self primMulScalar: anObject asFloat]
		ifFalse:[self primMulArray: anObject]! !

!FloatArray methodsFor: 'arithmetic' stamp: 'MarcusDenker 3/22/2011 20:18'!
dot: aFloatVector
	"Primitive. Return the dot product of the receiver and the argument.
	Fail if the argument is not of the same size as the receiver."
       | result |
	<primitive: 'primitiveDotProduct' module: 'FloatArrayPlugin'>
	self size = aFloatVector size ifFalse:[^self error:'Must be equal size'].
	result := 0.0.
	1 to: self size do:[:i|
		result := result + ((self at: i) * (aFloatVector at: i))].
	^result! !

!FloatArray methodsFor: 'comparing' stamp: 'ar 5/3/2001 13:02'!
hash
	| result |
	<primitive:'primitiveHashArray' module: 'FloatArrayPlugin'>
	result := 0.
	1 to: self size do:[:i| result := result + (self basicAt: i) ].
	^result bitAnd: 16r1FFFFFFF! !

!FloatArray methodsFor: '*Collections-arithmetic' stamp: 'GuillermoPolito 2/18/2011 07:23'!
negated
	^self copy *= -1! !

!FloatArray methodsFor: 'primitives-plugin' stamp: 'ar 2/2/2001 15:47'!
primSubScalar: scalarValue

	<primitive: 'primitiveSubScalar' module: 'FloatArrayPlugin'>
	1 to: self size do:[:i| self at: i put: (self at: i) - scalarValue].! !

!FloatArray methodsFor: 'primitives-plugin' stamp: 'ar 2/2/2001 15:47'!
primDivArray: floatArray

	<primitive: 'primitiveDivFloatArray' module: 'FloatArrayPlugin'>
	1 to: self size do:[:i| self at: i put: (self at: i) / (floatArray at: i)].! !

!FloatArray methodsFor: 'comparing' stamp: 'ar 2/2/2001 15:47'!
= aFloatArray 
	| length |
	<primitive: 'primitiveEqual' module: 'FloatArrayPlugin'>
	aFloatArray class = self class ifFalse: [^ false].
	length := self size.
	length = aFloatArray size ifFalse: [^ false].
	1 to: self size do: [:i | (self at: i)
			= (aFloatArray at: i) ifFalse: [^ false]].
	^ true! !

!FloatArray methodsFor: '*Collections-arithmetic' stamp: 'ar 10/7/1998 19:58'!
/= anObject
	^anObject isNumber
		ifTrue:[self primDivScalar: anObject asFloat]
		ifFalse:[self primDivArray: anObject]! !

!FloatArray methodsFor: 'accessing' stamp: 'ar 2/2/2001 15:47'!
at: index put: value
	<primitive: 'primitiveAtPut' module: 'FloatArrayPlugin'>
	value isFloat 
		ifTrue:[self basicAt: index put: value asIEEE32BitWord]
		ifFalse:[self at: index put: value asFloat].
	^value! !

!FloatArray methodsFor: 'accessing' stamp: 'ar 11/2/1998 12:19'!
defaultElement
	"Return the default element of the receiver"
	^0.0! !

!FloatArray methodsFor: 'primitives-plugin' stamp: 'ar 2/2/2001 15:47'!
primSubArray: floatArray

	<primitive: 'primitiveSubFloatArray' module: 'FloatArrayPlugin'>
	1 to: self size do:[:i| self at: i put: (self at: i) - (floatArray at: i)].! !

!FloatArray methodsFor: 'primitives-plugin' stamp: 'ar 2/2/2001 15:47'!
primMulArray: floatArray

	<primitive: 'primitiveMulFloatArray' module: 'FloatArrayPlugin'>
	1 to: self size do:[:i| self at: i put: (self at: i) * (floatArray at: i)].! !

!FloatArray methodsFor: 'private' stamp: 'ar 10/9/1998 11:27'!
replaceFrom: start to: stop with: replacement startingAt: repStart 
	"Primitive. This destructively replaces elements from start to stop in the receiver starting at index, repStart, in the collection, replacement. Answer the receiver. Range checks are performed in the primitive only. Optional. See Object documentation whatIsAPrimitive."
	<primitive: 105>
	super replaceFrom: start to: stop with: replacement startingAt: repStart! !

!FloatArray methodsFor: '*Collections-arithmetic' stamp: 'nice 11/24/2007 00:10'!
adaptToNumber: rcvr andSend: selector
	"If I am involved in arithmetic with a Number. If possible,
	convert it to a float and perform the (more efficient) primitive operation."
	selector == #+ ifTrue:[^self + rcvr].
	selector == #* ifTrue:[^self * rcvr].
	selector == #- ifTrue:[^self negated += rcvr].
	selector == #/ ifTrue:[
		"DO NOT USE TRIVIAL CODE
			^self reciprocal * rcvr
		BECAUSE OF GRADUAL UNDERFLOW
		self should: (1.0e-39 / (FloatArray with: 1.0e-39)) first < 2."
			^(self class new: self size withAll: rcvr) / self
		].
	^super adaptToNumber: rcvr andSend: selector! !

!FloatArray methodsFor: '*Collections-arithmetic' stamp: 'GuillermoPolito 2/18/2011 07:23'!
* anObject
	^self copy *= anObject! !

!FloatArray methodsFor: '*Collections-arithmetic' stamp: 'GuillermoPolito 2/18/2011 07:22'!
/ anObject
	^self copy /= anObject! !

!FloatArrayTest commentStamp: 'nice 5/30/2006 01:24'!
These tests are used to assert that FloatArrayPlugin has same results as Float asIEEE32BitWord!
!FloatArrayTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButLast
	"self debug: #testAllButLast"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButLast.
	self deny: abf last = col last.
	self assert: abf size + 1 = col size! !

!FloatArrayTest methodsFor: 'tests - begins ends with' stamp: ''!
testsEndsWith
	
	self assert: (self nonEmpty endsWith: self nonEmpty copyWithoutFirst).
	self assert: (self nonEmpty endsWith: self nonEmpty).
	self deny: (self nonEmpty endsWith: (self nonEmpty copyWith: self nonEmpty first)).! !

!FloatArrayTest methodsFor: 'tests - equality' stamp: ''!
testHasEqualElementsOfIdenticalCollectionObjects
	"self debug: #testHasEqualElementsOfIdenticalCollectionObjects"
	
	self assert: (self empty hasEqualElements: self empty). 
	self assert: (self nonEmpty hasEqualElements: self nonEmpty). 
	! !

!FloatArrayTest methodsFor: 'tests - copying with replacement' stamp: ''!
testCopyReplaceAllWith1Occurence
	| result  firstIndexesOfOccurrence index endPartIndexResult endPartIndexCollection |
	
	result := self collectionWith1TimeSubcollection  copyReplaceAll: self oldSubCollection with: self replacementCollection .
	
	"detecting indexes of olSubCollection"
	firstIndexesOfOccurrence  := self firstIndexesOf: self oldSubCollection in: self collectionWith1TimeSubcollection .
	index:= firstIndexesOfOccurrence at: 1.
	
	"verify content of 'result' : "
	"first part of 'result'' : '"

	1 to: (index -1) do: 
		[
		:i |  
		self assert: (self collectionWith1TimeSubcollection  at:i)=(result at: i)
		].

	" middle part containing replacementCollection : "
	
	index to: (index + self replacementCollection size-1) do: 
		[
		:i |
		self assert: ( result at: i )=(self replacementCollection at: ( i - index + 1 ))
		].
	
	" end part :"
	
	endPartIndexResult :=  index + self replacementCollection  size .
	endPartIndexCollection :=   index + self oldSubCollection size  .
	
	1 to: (result size - endPartIndexResult - 1 ) do:
		[ 
		:i |
		self assert: (result at: ( endPartIndexResult + i - 1 ) ) = (self collectionWith1TimeSubcollection  at: ( endPartIndexCollection + i - 1 ) ).
		].
	
	
	! !

!FloatArrayTest methodsFor: 'tests - index access' stamp: ''!
testLastIndexOf
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection lastIndexOf: element) = 1.
	self assert: (collection lastIndexOf: self elementNotInForIndexAccessing) = 0! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyWithReplacementTest
	self replacementCollection.
	self oldSubCollection.
	self collectionWith1TimeSubcollection.
	self assert: (self howMany: self oldSubCollection in: self collectionWith1TimeSubcollection) = 1! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 16:36'!
moreThan4Elements

" return a collection including at leat 4 elements"
	^ nonEmpty5ElementsNoDuplicate ! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 16:27'!
secondIndex
" return an index between 'nonEmpty' bounds that is > to 'first index' "
	^self firstIndex +1! !

!FloatArrayTest methodsFor: 'tests - subcollections access' stamp: ''!
testFirstNElements
	"self debug: #testFirstNElements"
	| result |
	result := self moreThan3Elements first: self moreThan3Elements size - 1.
	1 
		to: result size
		do: [ :i | self assert: (result at: i) = (self moreThan3Elements at: i) ].
	self assert: result size = (self moreThan3Elements size - 1).
	self 
		should: [ self moreThan3Elements first: self moreThan3Elements size + 1 ]
		raise: Error! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 15:35'!
collectionWith2TimeSubcollection
" return a collection including 'oldSubCollection'  two or many time "
	^ collectionWith2TimeSubcollection ifNil: [ collectionWith2TimeSubcollection := self collectionWith1TimeSubcollection, self oldSubCollection  ].! !

!FloatArrayTest methodsFor: 'tests - puting with indexes' stamp: ''!
testFromToPut
	
	| collection index |
	index := self indexArray anyOne.
	collection := self nonEmpty copy.
	collection from: 1 to: index  put: self aValue..
	1 to: index do:
		[:i | self assert: (collection at: i)= self aValue].
	(index +1) to: collection size do:
		[:i | self assert: (collection at:i)= (self nonEmpty at:i)].! !

!FloatArrayTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithoutFirst

	| result |
	result := self nonEmpty copyWithoutFirst.
	
	self assert: result size = (self nonEmpty size - 1).
	
	1 to: result size do:
		[:i |
		self assert: (result at: i)= (self nonEmpty at: (i + 1))].! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0TStructuralEqualityTest
	self empty.
	self nonEmpty.
	self assert: self empty isEmpty.
	self deny: self nonEmpty isEmpty! !

!FloatArrayTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionTwoSimilarElementsInIntersection
	"self debug: #testIntersectionBasic"
	| inter |
	inter := self collection intersection: (self collectionClass with: self anotherElementOrAssociationIn).
	self assert: (self collection occurrencesOf: self anotherElementOrAssociationIn) = self numberOfSimilarElementsInIntersection.
	self assert: (inter includes: self anotherElementOrAssociationIn value)! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 16:37'!
unsortedCollection
" retur a collection that is not yat sorted"
	^nonEmpty5ElementsNoDuplicate ! !

!FloatArrayTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testLastIndexOfDuplicate
	"self debug: #testLastIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection first.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'lastIndexOf: should return the position of the last occurrence :'"
	self assert: (collection lastIndexOf: element) = collection size! !

!FloatArrayTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAnyNoneThere
	"self debug: #testIncludesAnyOfNoneThere'"
	
	self deny: (self nonEmpty includesAny: self empty).
	self deny: (self nonEmpty includesAny: { self elementNotIn. self anotherElementNotIn })! !

!FloatArrayTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedArray
	| result collection |
	collection := self collectionWithSortableElements .
	result := collection  asArray sort.
	self assert: (result class includesBehavior: Array).
	self assert: result isSorted.
	self assert: result size = collection size! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'CamilloBruni 9/9/2011 12:11'!
collectionWithoutEqualElements

" return a collection not including equal elements "
	^ nonEmpty5ElementsNoDuplicate ! !

!FloatArrayTest methodsFor: 'tests - converting' stamp: ''!
testAsArray
	"self debug: #testAsArray3"
	self 
		assertSameContents: self collectionWithoutEqualElements
		whenConvertedTo: Array! !

!FloatArrayTest methodsFor: 'test - creation' stamp: ''!
testWith
	"self debug: #testWith"
	
	| aCol anElement |
	anElement := self collectionMoreThan5Elements anyOne.
	aCol := self collectionClass with: anElement.
	self assert: (aCol includes: anElement).! !

!FloatArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testBefore
	"self debug: #testBefore"
	self assert: (self moreThan4Elements before: (self moreThan4Elements at: 2)) = (self moreThan4Elements at: 1).
	self 
		should: [ self moreThan4Elements before: (self moreThan4Elements at: 1) ]
		raise: Error.
	self 
		should: [ self moreThan4Elements before: 66 ]
		raise: Error! !

!FloatArrayTest methodsFor: 'tests - copy' stamp: ''!
testCopyNotSame
	"self debug: #testCopySameClass"
	"A copy of a collection should always be of the same class as the instance it copies"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: copy  == self nonEmpty.! !

!FloatArrayTest methodsFor: 'tests - set arithmetic' stamp: ''!
testUnionOfEmpties
	"self debug: #testUnionOfEmpties"
	
	self assert:  (self empty union: self empty) isEmpty.
	
	! !

!FloatArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindFirst

	| element result |
	element := self nonEmptyMoreThan1Element   at:1.
	 result:=self nonEmptyMoreThan1Element  findFirst: [:each | each =element].
	
	self assert: result=1. ! !

!FloatArrayTest methodsFor: 'tests - copying part of sequenceable for multipliness' stamp: ''!
testCopyUpToWithDuplicate
	| result element  collection |
	collection := self collectionWithSameAtEndAndBegining .
	element := collection  last.
	
	" collectionWithSameAtEndAndBegining first and last elements are equals.
	'copyUpTo:' should copy until the first occurence :"
	result := collection   copyUpTo: (element ).
	
	"verifying content: "
	self assert: result isEmpty.

! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
testOFixtureReplacementSequencedTest

	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	
	self elementInForReplacement.
	self assert: (self nonEmpty includes: self elementInForReplacement ) .
	
	self newElement.
	
	self firstIndex.
	self assert: (self firstIndex >= 1 & self firstIndex <= self nonEmpty size).
	
	self secondIndex.
	self assert: (self secondIndex >= 1 & self secondIndex <= self nonEmpty size).
	
	self assert: self firstIndex <=self secondIndex .
	
	self replacementCollection.
	
	self replacementCollectionSameSize.
	self assert: (self secondIndex  - self firstIndex +1)= self replacementCollectionSameSize size
	! !

!FloatArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithIndexCollect
	
	| result index collection |
	index := 0.
	collection := self nonEmptyMoreThan1Element .
	result := collection  withIndexCollect: [:each :i | 
		self assert: i = (index := index + 1).	
		self assert: i = (collection  indexOf: each) .
		each] . 
	
	1 to: result size do:[: i | self assert: (result at:i)= (collection at: i)].
	self assert: result size = collection size.! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 16:26'!
firstIndex
" return an index between 'nonEmpty' bounds that is < to 'second index' "
	^2! !

!FloatArrayTest methodsFor: 'tests - printing' stamp: ''!
testPrintElementsOn

	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printElementsOn: aStream .
	allElementsAsString:=(result findBetweenSubStrs: ' ' ).
	1 to: allElementsAsString size do:
		[:i | 
		self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString).
			].! !

!FloatArrayTest methodsFor: 'tests - begins ends with' stamp: ''!
testsEndsWithEmpty
	
	self deny: (self nonEmpty endsWith: self empty).
	self deny: (self empty endsWith: self nonEmpty).
	! !

!FloatArrayTest methodsFor: 'tests - concatenation' stamp: ''!
testConcatenationWithEmpty
	| result |
	result:= self empty,self secondCollection .
	
	1 to: self secondCollection size do:
		[:i | 
		self assert: (self secondCollection at:i)= (result at:i).
		].
	"size : "
	self assert: result size = ( self secondCollection size).! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIterateSequencedReadableTest

	| res |
	
	self nonEmptyMoreThan1Element.
	self assert: self nonEmptyMoreThan1Element  size > 1.
	
	
	self empty.
	self assert: self empty isEmpty .
	
	res := true.
	self nonEmptyMoreThan1Element    
	detect: [ :each | (self nonEmptyMoreThan1Element    occurrencesOf: each) > 1 ]
	ifNone: [ res := false ].
	self assert: res = false.! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 15:50'!
anotherElementNotIn
" return an element different of 'elementNotIn'  not included in 'nonEmpty' "
	^ elementNotIn ! !

!FloatArrayTest methodsFor: 'tests - copying part of sequenceable for multipliness' stamp: ''!
testCopyUpToLastWithDuplicate
	| result element  collection |
	collection := self collectionWithSameAtEndAndBegining .
	element := collection  first.
	
	" collectionWithSameAtEndAndBegining first and last elements are equals.
	'copyUpToLast:' should copy until the last occurence :"
	result := collection   copyUpToLast: (element ).
	
	"verifying content: "
	1 to: result size do:
		[:i |
		self assert: (result at: i ) = ( collection at: i )  
		].
	
	self assert: result size = (collection size - 1).

! !

!FloatArrayTest methodsFor: 'tests - puting with indexes' stamp: ''!
testSwapWith
	"self debug: #testSwapWith"
	| result index |
	index := self indexArray anyOne.
	result:= self nonEmpty copy .
	result swap: index with: 1.
	self assert: (result at: index) = (self nonEmpty at:1).
	self assert: (result at: 1) = (self nonEmpty at: index).
	! !

!FloatArrayTest methodsFor: 'tests - puting with indexes' stamp: ''!
testAtAllIndexesPut
	
	self nonEmpty atAllPut: self aValue.
	self nonEmpty do:[ :each| self assert: each = self aValue].
	! !

!FloatArrayTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithSequenceable

	| result index element |
	index := self indexInNonEmpty .
	element := self nonEmpty at: index.
	result := self nonEmpty copyWith: (element ).
	
	self assert: result size = (self nonEmpty size + 1).
	self assert: result last = element .
	
	1 to: (result size - 1) do:
	[ :i |
	self assert: (result at: i) = ( self nonEmpty at: ( i  ))].! !

!FloatArrayTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterLastEmpty

	| delim emptyStream |
	delim := ', '.
	emptyStream := ReadWriteStream on: ''.
	self empty asStringOn: emptyStream delimiter: delim last:'and'.
	self assert: emptyStream contents = ''.
! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 15:39'!
collectionWith1TimeSubcollection
" return a collection including 'oldSubCollection'  only one time "
	^ collectionWith1TimeSubcollection ifNil: [ collectionWith1TimeSubcollection := collectionWithSameAtEndAndBegining  , self oldSubCollection , collectionWithSameAtEndAndBegining  ].! !

!FloatArrayTest methodsFor: 'tests - puting with indexes' stamp: ''!
testAtAllPut
	| |
	self nonEmpty atAll: self indexArray put: self aValue..
	
	self indexArray do:
		[:i | self assert: (self nonEmpty at: i)=self aValue ].
	! !

!FloatArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testAtOutOfBounds
	"self debug: #testAtOutOfBounds"
	self 
		should: [ self moreThan4Elements at: self moreThan4Elements size + 1 ]
		raise: Error.
	self 
		should: [ self moreThan4Elements at: -1 ]
		raise: Error! !

!FloatArrayTest methodsFor: 'test - creation' stamp: ''!
testOfSize
	"self debug: #testOfSize"
	
	| aCol |
	aCol := self collectionClass ofSize: 3.
	self assert: (aCol size = 3).
! !

!FloatArrayTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyEmpty
	"self debug: #testCopyEmpty"
	
	| copy | 
	copy := self empty copy.
	self assert: copy isEmpty.! !

!FloatArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithCollect
	
	| result firstCollection secondCollection index  |

	firstCollection := self nonEmptyMoreThan1Element.
	secondCollection := firstCollection copy.
	index := 0.
	
	result := firstCollection  with: secondCollection collect:
		[:a :b |
		( index := index + 1).
		self assert: (firstCollection at: index) equals:  a. 
		self assert: (secondCollection at: index) equals:  b.
		b].
	
	1 to: result size do:[: i | self assert: (result at:i)= (secondCollection  at: i)].
	self assert: result size = secondCollection  size.! !

!FloatArrayTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterLastOne

	| delim oneItemStream result |
	
	delim := ', '.
	result:=''.
	oneItemStream := ReadWriteStream on: result.
	self nonEmpty1Element  asStringOn: oneItemStream delimiter: delim last: 'and'.
	oneItemStream do:[:each | self assert: each = (self nonEmpty1Element first asString)].
	

	! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSetAritmeticTest
	self collection.
	self deny: self collection isEmpty.
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self anotherElementOrAssociationNotIn.
	self collection isDictionary
		ifTrue: [ self deny: (self collection associations includes: self anotherElementOrAssociationNotIn key) ]
		ifFalse: [ self deny: (self collection includes: self anotherElementOrAssociationNotIn) ].
	self collectionClass! !

!FloatArrayTest methodsFor: 'tests - printing' stamp: ''!
testPrintOnDelimiter
	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printOn: aStream delimiter: ', ' .
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString).
			].! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIncludeWithIdentityTest
	| anElement |
	self collectionWithCopyNonIdentical.
	anElement := self collectionWithCopyNonIdentical anyOne.
	self deny: anElement == anElement copy! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 10:44'!
collectionWithoutNilElements
" return a collection that doesn't includes a nil element  and that doesn't includes equal elements'"
	^ nonEmpty5ElementsNoDuplicate ! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixturePutTest
	self aValue.
	self anotherValue.
	
	self anIndex.
	self nonEmpty isDictionary 
		ifFalse:[self assert: (self anIndex >=1 & self anIndex <= self nonEmpty size).].
	
	self empty.
	self assert: self empty isEmpty .
	
	self nonEmpty.
	self deny: self nonEmpty  isEmpty.! !

!FloatArrayTest methodsFor: 'tests - replacing' stamp: ''!
testReplaceFromToWithStartingAt
	| result  repStart collection replacementCollec firstInd secondInd |
	collection := self nonEmpty .
	result := collection copy.
	replacementCollec := self replacementCollectionSameSize .
	firstInd := self firstIndex .
	secondInd := self secondIndex .
	repStart := replacementCollec  size - ( secondInd  - firstInd   + 1 ) + 1.
	result replaceFrom: firstInd  to: secondInd with: replacementCollec  startingAt: repStart   .
	
	"verify content of 'result' : "
	"first part of 'result'' : '" 
	
	1 to: ( firstInd  - 1 ) do: [ :i | self assert: ( collection  at:i ) = ( result at: i ) ].
	
	" middle part containing replacementCollection : "
	
	( firstInd ) to: ( replacementCollec   size - repStart +1 ) do: 
		[:i|
		self assert: (result at: i)=( replacementCollec   at: ( repStart  + ( i  - firstInd  ) ) ) ].
	
	" end part :"
	( firstInd  + replacementCollec   size ) to: ( result size ) do:
		[ :i |
		self assert: ( result at: i ) = ( collection  at: ( secondInd  + 1 - ( firstInd  + replacementCollec   size ) + i ) ) ].! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureTConvertTest
	"a collection of number without equal elements:"

	| res |
	self collectionWithoutEqualElements.
	res := true.
	self collectionWithoutEqualElements
		detect: [ :each | (self collectionWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false! !

!FloatArrayTest methodsFor: 'requirements' stamp: ''!
valueArray
" return a collection (with the same size than 'indexArray' )of values to be put in 'nonEmpty'  at indexes in 'indexArray' "
	| result |
	result := Array new: self indexArray size.
	1 to: result size do:
		[:i |
		result at:i put: (self aValue ).
		].
	^ result.! !

!FloatArrayTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterMore

	| delim multiItemStream result index |
	"delim := ', '.
	multiItemStream := '' readWrite.
	self oneTwoThreeItemCol asStringOn: multiItemStream delimiter: ', '.
	self assert: multiItemStream contents = '1, 2, 3'."
	
	delim := ', '.
	result:=''.
	multiItemStream := ReadWriteStream on:result.
	self nonEmpty  asStringOn: multiItemStream delimiter: ', '.
	
	index:=1.
	(result findBetweenSubStrs: ', ' )do:
		[:each |
		self assert: each= ((self nonEmpty at:index)asString).
		index:=index+1
		].! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 16:23'!
anIndex
" return an index in nonEmpty bounds"
	^ 2! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 12:05'!
collectionMoreThan5Elements
" return a collection including at least 5 elements"
	
	^ nonEmpty5ElementsNoDuplicate ! !

!FloatArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testDetectSequenced
" testing that detect keep the first element returning true for sequenceable collections "

	| element result |
	element := self nonEmptyMoreThan1Element   at:1.
	result:=self nonEmptyMoreThan1Element  detect: [:each | each notNil ].
	self assert: result = element. ! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureAsStringCommaAndDelimiterTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty.
	self nonEmpty1Element.
	self assert: self nonEmpty1Element size = 1! !

!FloatArrayTest methodsFor: 'testing' stamp: 'nice 5/30/2006 03:17'!
testFloatArrayPluginPrimitiveAt
	"if FloatArrayPlugin primitive are not here, this test is dumb.
	Otherwise, it will compare primitive and #fromIEEE32Bit:"
	
	#(
		"regular numbers no truncation or rounding"
		2r0.0 2r1.0 2r1.1 2r1.00000000000000000000001
		2r1.0e-10 2r1.1e-10 2r1.00000000000000000000001e-10
		2r1.0e10 2r1.1e10 2r1.00000000000000000000001e10
		
		"smallest float32 before gradual underflow"
		2r1.0e-126
		
		"biggest float32"
		2r1.11111111111111111111111e127
		
		"overflow"
		2r1.11111111111111111111111e128
		
		"gradual underflow"
		2r0.11111111111111111111111e-126
		2r0.00000000000000000000001e-126
		
		"with rounding mode : tests on 25 bits"
		
		2r1.0000000000000000000000001
		2r1.0000000000000000000000010
		2r1.0000000000000000000000011
		2r1.0000000000000000000000100
		2r1.0000000000000000000000101
		2r1.0000000000000000000000110
		2r1.0000000000000000000000111
		2r1.1111111111111111111111001
		2r1.1111111111111111111111010
		2r1.1111111111111111111111011
		2r1.1111111111111111111111101
		2r1.1111111111111111111111110
		2r1.1111111111111111111111111
		
		"overflow"
		2r1.1111111111111111111111110e127
		
		"gradual underflow"
		2r0.1111111111111111111111111e-126
		2r0.1111111111111111111111110e-126
		2r0.1111111111111111111111101e-126
		2r0.1111111111111111111111011e-126
		2r0.1111111111111111111111010e-126
		2r0.1111111111111111111111001e-126
		2r0.0000000000000000000000111e-126
		2r0.0000000000000000000000110e-126
		2r0.0000000000000000000000101e-126
		2r0.0000000000000000000000011e-126
		2r0.0000000000000000000000010e-126
		2r0.0000000000000000000000001e-126
		2r0.0000000000000000000000010000000000000000000000000001e-126
		) do: [:e |
			self assert: ((FloatArray with: e) at: 1) = (Float fromIEEE32Bit: ((FloatArray with: e) basicAt: 1)).
			self assert: ((FloatArray with: e negated) at: 1) = (Float fromIEEE32Bit: ((FloatArray with: e negated) basicAt: 1))].
		
	"special cases"
	(Array with: Float infinity with: Float infinity negated with: Float negativeZero)
		do: [:e | self assert: ((FloatArray with: e) at: 1) = (Float fromIEEE32Bit: ((FloatArray with: e) basicAt: 1))].
		
	"Cannot compare NaN"
	(Array with: Float nan)
		do: [:e | self assert: (Float fromIEEE32Bit: ((FloatArray with: e) basicAt: 1)) isNaN].! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 15:55'!
collectionMoreThan1NoDuplicates
	" return a collection of size > 1 without equal elements"
	^ nonEmpty5ElementsNoDuplicate ! !

!FloatArrayTest methodsFor: 'tests - sorting' stamp: ''!
testSorted
	| result tmp unsorted |
	unsorted := self unsortedCollection.
	result := unsorted sorted.
	self deny: unsorted == result.
	tmp := result at: 1.
	result
		do: [ :each | 
			self assert: each >= tmp.
			tmp := each ]! !

!FloatArrayTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAnyAllThere
	"self debug: #testIncludesAnyOfAllThere'"
	self deny: (self nonEmpty includesAny: self empty).
	self assert: (self nonEmpty includesAny: { self nonEmpty anyOne }).
	self assert: (self nonEmpty includesAny: self nonEmpty).! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 15:45'!
elementToAdd
" return an element of type 'nonEmpy' elements'type'  not  yet included in nonEmpty" 
	^ elementNotIn ! !

!FloatArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testPairsDo
	| index |
	index:=1.
	
	self nonEmptyMoreThan1Element  pairsDo: 
		[:each1 :each2 | 
		self assert:(self nonEmptyMoreThan1Element at:index)=each1.
		self assert:(self nonEmptyMoreThan1Element at:(index+1))=each2.
		index:=index+2].
	
	self nonEmptyMoreThan1Element size odd
		ifTrue:[self assert: index=self nonEmptyMoreThan1Element size]
		ifFalse:[self assert: index=(self nonEmptyMoreThan1Element size+1)].! !

!FloatArrayTest methodsFor: 'requirements' stamp: ''!
collectionWithCopy
	"return a collection of type 'self collectionWIithoutEqualsElements class' containing no elements equals ( with identity equality)
	but  2 elements only equals with classic equality"
	| result collection |
	collection := OrderedCollection withAll: self elementsCopyNonIdenticalWithoutEqualElements.
	collection add: collection first copy.
	result := self elementsCopyNonIdenticalWithoutEqualElements class withAll: collection.
	^ result! !

!FloatArrayTest methodsFor: 'tests - subcollections access' stamp: ''!
testLastNElements
	"self debug: #testLastNElements"
	| result |
	result := self moreThan3Elements last: self moreThan3Elements size - 1.
	1 
		to: result size
		do: [ :i | self assert: (result at: i) = (self moreThan3Elements at: i + 1) ].
	self assert: result size = (self moreThan3Elements size - 1).
	self 
		should: [ self moreThan3Elements last: self moreThan3Elements size + 1 ]
		raise: Error! !

!FloatArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testCollectFromTo
	
	| result |
	result:=self nonEmptyMoreThan1Element 
		collect: [ :each | each ]
		from: 1
		to: (self nonEmptyMoreThan1Element size - 1).
		
	1 to: result size
		do: [ :i | self assert: (self nonEmptyMoreThan1Element at: i) = (result at: i) ].
	self assert: result size = (self nonEmptyMoreThan1Element size - 1)! !

!FloatArrayTest methodsFor: 'tests - printing' stamp: ''!
testPrintNameOn

	| aStream result |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printNameOn: aStream .
	Transcript show: result asString.
	self nonEmpty class name first isVowel
		ifTrue:[ self assert: aStream contents =('an ',self nonEmpty class name ) ]
		ifFalse:[self assert: aStream contents =('a ',self nonEmpty class name)].! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0SortingArrayedTest
	| tmp sorted |
	" an unsorted collection of number "
	self unsortedCollection.
	self unsortedCollection do: [ :each | each isNumber ].
	sorted := true.
	self unsortedCollection
		pairsDo: [ :each1 :each2 | 
			each2 < each1
				ifTrue: [ sorted := false ] ].
	self assert: sorted = false.	" a collection of number sorted in an ascending order"
	self sortedInAscendingOrderCollection.
	self sortedInAscendingOrderCollection do: [ :each | each isNumber ].
	tmp := self sortedInAscendingOrderCollection at: 1.
	self sortedInAscendingOrderCollection
		do: [ :each | 
			self assert: each >= tmp.
			tmp := each ]! !

!FloatArrayTest methodsFor: 'test - equality' stamp: ''!
testEqualSignIsTrueForNonIdenticalButEqualCollections
	"self debug: #testEqualSignIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty = self empty copy). 
	self assert: (self empty copy = self empty).
	self assert: (self empty copy = self empty copy).
		
	self assert: (self nonEmpty = self nonEmpty copy). 
	self assert: (self nonEmpty copy = self nonEmpty).
	self assert: (self nonEmpty copy = self nonEmpty copy).! !

!FloatArrayTest methodsFor: 'tests - copying with replacement' stamp: ''!
testCopyReplaceAllWithManyOccurence
	| result firstIndexesOfOccurrence resultBetweenPartIndex collectionBetweenPartIndex diff |
	" testing fixture here as this method may be not used for collection that can't contain equals element :"
	self collectionWith2TimeSubcollection.
	self assert: (self howMany: self oldSubCollection in: self collectionWith2TimeSubcollection) = 2.	" test :"
	diff := self replacementCollection size - self oldSubCollection size.
	result := self collectionWith2TimeSubcollection copyReplaceAll: self oldSubCollection with: self replacementCollection.	"detecting indexes of olSubCollection"
	firstIndexesOfOccurrence := self firstIndexesOf: self oldSubCollection in: self collectionWith2TimeSubcollection.	" verifying that replacementCollection has been put in places of oldSubCollections "
	firstIndexesOfOccurrence
		do: [ :each | 
			(firstIndexesOfOccurrence indexOf: each) = 1
				ifTrue: [ each to: self replacementCollection size do: [ :i | self assert: (result at: i) = (self replacementCollection at: i - each + 1) ] ]
				ifFalse: [ each + diff to: self replacementCollection size do: [ :i | self assert: (result at: i) = (self replacementCollection at: i - each + 1) ] ] ].	" verifying that the 'between' parts correspond to the initial collection : "
	1 to: firstIndexesOfOccurrence size do: [ :i | 
		i = 1
			ifTrue: [ 1 to: (firstIndexesOfOccurrence at: i) - 1 do: [ :j | self assert: (result at: i) = (self collectionWith2TimeSubcollection at: i) ] ]
			ifFalse: [ 
				resultBetweenPartIndex := (firstIndexesOfOccurrence at: i - 1) + self replacementCollection size.
				collectionBetweenPartIndex := (firstIndexesOfOccurrence at: i - 1) + self oldSubCollection size.
				1 to: (firstIndexesOfOccurrence at: i) - collectionBetweenPartIndex - 1 do: [ :j | 
					self
						assert:
							(result at: resultBetweenPartIndex + i - 1)
								= (self collectionWith2TimeSubcollection at: collectionBetweenPartIndex + i - 1) ] ]	" specific comportement for the begining of the collection :"	" between parts till the end : " ].	"final part :"
	1 to: self collectionWith2TimeSubcollection size - (firstIndexesOfOccurrence last + self oldSubCollection size) do: [ :i | 
		self
			assert:
				(result at: firstIndexesOfOccurrence last + self replacementCollection size - 1 + i)
					= (self collectionWith2TimeSubcollection at: firstIndexesOfOccurrence last + self oldSubCollection size - 1 + i) ]! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 16:35'!
elementInForElementAccessing
" return an element inculded in 'moreThan4Elements'"
	^ elementInNonEmpty ! !

!FloatArrayTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testIndexOfStartingAtDuplicate
	"self debug: #testLastIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection last.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'indexOf:ifAbsent:startingAt: should return the position of the first occurrence :'"
	self assert: (collection 
			indexOf: element
			startingAt: 1
			ifAbsent: [ 55 ]) = 1.
	self assert: (collection 
			indexOf: element
			startingAt: 2
			ifAbsent: [ 55 ]) = collection size! !

!FloatArrayTest methodsFor: 'tests - copying with replacement' stamp: ''!
testCopyReplaceFromToWithInsertion
	| result  indexOfSubcollection |
	
	indexOfSubcollection := (self firstIndexesOf: self oldSubCollection  in:  self collectionWith1TimeSubcollection) at: 1. 
	
	result := self collectionWith1TimeSubcollection  copyReplaceFrom: indexOfSubcollection  to: ( indexOfSubcollection - 1 ) with: self replacementCollection .
	
	"verify content of 'result' : "
	"first part of 'result'' : '"
	
	1 to: (indexOfSubcollection -1) do: 
		[
		:i | 
		self assert: (self collectionWith1TimeSubcollection  at:i)=(result at: i)
		].
	
	" middle part containing replacementCollection : "
	indexOfSubcollection  to: (indexOfSubcollection  + self replacementCollection size-1) do: 
		[
		:i |
		self assert: ( result at: i )=(self replacementCollection at: ( i - indexOfSubcollection +1 ))
		].
	
	" end part :"
	(indexOfSubcollection  + self replacementCollection size) to: (result size) do:
		[:i|
		self assert: (result at: i)=(self collectionWith1TimeSubcollection  at: (i-self replacementCollection size))].
	
	" verify size: "	
	self assert: result size=(self collectionWith1TimeSubcollection  size + self replacementCollection size).
	

	

	
	! !

!FloatArrayTest methodsFor: 'tests - replacing' stamp: ''!
testReplaceFromToWith
	| result  collection replacementCollec firstInd secondInd |
	collection := self nonEmpty .
	replacementCollec := self replacementCollectionSameSize .
	firstInd := self firstIndex .
	secondInd := self secondIndex .
	result := collection  copy.
	result replaceFrom: firstInd  to: secondInd  with: replacementCollec .
	
	"verify content of 'result' : "
	"first part of 'result'' : '"
	
	1 to: ( firstInd - 1 ) do: [ :i | self assert: (collection  at:i ) = ( result at: i ) ].
	
	" middle part containing replacementCollection : "
	
	( firstInd ) to: ( firstInd  + replacementCollec size - 1 ) do: 
		[ :i |
		self assert: ( result at: i ) = ( replacementCollec  at: ( i - firstInd  +1 ) ) 
		].
	
	" end part :"
	( firstInd  + replacementCollec   size) to: (result size) do:
		[:i|
		self assert: ( result at: i ) = ( collection at: ( secondInd  + 1 - ( firstInd + replacementCollec size ) + i ) ) ].
	
	! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 16:26'!
newElement
"return an element that will be put in the collection in place of another"
	^ elementNotIn ! !

!FloatArrayTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsCommaStringMore

	"self assert: self oneTwoThreeItemCol asCommaString = '1, 2, 3'.
	self assert: self oneTwoThreeItemCol asCommaStringAnd = '1, 2 and 3'
"

	| result resultAnd index allElementsAsString |
	result:= self nonEmpty asCommaString .
	resultAnd:= self nonEmpty asCommaStringAnd .
 
	index := 1.
	(result findBetweenSubStrs: ',' )do:
		[:each |
		index = 1
			ifTrue: [self assert: each= ((self nonEmpty at:index)asString)]
			ifFalse: [self assert: each= (' ',(self nonEmpty at:index) asString)].
		index:=index+1
		].
	
	"verifying esultAnd :"
	allElementsAsString:=(resultAnd findBetweenSubStrs: ',' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size )
			ifTrue: [
			i = 1
				ifTrue:[self assert: (allElementsAsString at:i)=((self nonEmpty at:i) asString)]
				ifFalse:[self assert: (allElementsAsString at:i)=(' ',(self nonEmpty at:i) asString)]
				].
		i=(allElementsAsString size)
			ifTrue:[ 
			i = 1
				ifTrue:[self assert: (allElementsAsString at:i)=( (self nonEmpty at:i ) asString ,' and ', (self nonEmpty at: ( i + 1) ) asString )]
				ifFalse:[self assert: (allElementsAsString at:i)=( ' ' , (self nonEmpty at:i ) asString ,' and ', (self nonEmpty at: ( i + 1) ) asString )]
				].
		
		
			].! !

!FloatArrayTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWith
	"self debug: #testCopyNonEmptyWith"
	| res anElement |
	anElement := self elementToAdd .
	res := self nonEmpty copyWith: anElement.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self assert: (res includes: (anElement value)).
	self nonEmpty do: [ :each | res includes: each ]! !

!FloatArrayTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfterLastEmpty
	| result |
	result := self empty copyAfterLast: self collectionWithoutEqualElements first.
	self assert: result isEmpty.! !

!FloatArrayTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyEmptyMethod
	| result |
	result := self collectionWithoutEqualElements  copyEmpty .
	self assert: result isEmpty .
	self assert: result class= self nonEmpty class.! !

!FloatArrayTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutAllNotIncluded
	"self debug: #testCopyNonEmptyWithoutAllNotIncluded"
	| res |
	res := self nonEmpty copyWithoutAll: self collectionNotIncluded.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self nonEmpty do: [ :each | self assert: (res includes: each) ]! !

!FloatArrayTest methodsFor: 'tests - puting with indexes' stamp: ''!
testAtAllPutAll

	| aValueArray |
	aValueArray := self valueArray .
	self nonEmpty atAll: self indexArray putAll: aValueArray  .
	
	1 to: self indexArray size do:
		[:i |
		self assert: (self nonEmpty at:(self indexArray at: i))= (aValueArray  at:i) ]! !

!FloatArrayTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfSubCollectionStartingAt
	"self debug: #testIndexOfIfAbsent"
	| subcollection index collection |
	collection := self collectionMoreThan1NoDuplicates.
	subcollection := self collectionMoreThan1NoDuplicates.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 1.
	self assert: index = 1.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 2.
	self assert: index = 0! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 15:02'!
collectionWithSortableElements
" return a collection elements that can be sorte ( understanding message ' < '  or ' > ')"
	^ nonEmpty5ElementsNoDuplicate ! !

!FloatArrayTest methodsFor: 'tests - copying part of sequenceable for multipliness' stamp: ''!
testCopyAfterWithDuplicate
	| result element  collection |
	collection := self collectionWithSameAtEndAndBegining .
	element := collection  last.
	
	" collectionWithSameAtEndAndBegining first and last elements are equals.
	'copyAfter:' should copy after the first occurence :"
	result := collection   copyAfter: (element ).
	
	"verifying content: "
	1 to: result size do: 
		[:i |
		self assert: (collection  at:(i + 1 )) = (result at: (i))
		].

	"verify size: "
	self assert: result size = (collection size - 1).! !

!FloatArrayTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedCollectionWithSortBlock
	| result tmp |
	result := self collectionWithSortableElements  asSortedCollection: [:a :b | a > b].
	self assert: (result class includesBehavior: SortedCollection).
	result do: 
		[ :each | 
		self assert: (self collectionWithSortableElements   occurrencesOf: each) = (result occurrencesOf: each) ].
	self assert: result size = self collectionWithSortableElements  size.
	tmp:=result at: 1.
	result do: [:each| self assert: tmp>=each. tmp:=each].
	! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureTConvertAsSetForMultiplinessTest
	"a collection  with equal elements:"

	| res |
	self withEqualElements.
	res := true.
	self withEqualElements detect: [ :each | (self withEqualElements occurrencesOf: each) > 1 ] ifNone: [ res := false ].
	self assert: res = true! !

!FloatArrayTest methodsFor: 'tests - sorting' stamp: ''!
testSortedUsingBlock
	| result tmp |
	result := self unsortedCollection sorted:  [:a :b | a>b]..
	tmp := result at: 1.
	result do:
		[:each | self assert: each<=tmp. tmp:= each. ].! !

!FloatArrayTest methodsFor: 'test - creation' stamp: ''!
testWithAll
	"self debug: #testWithAll"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection .
	aCol := self collectionClass withAll: collection  .
	
	collection do: [ :each | self assert: (aCol occurrencesOf: each ) = ( collection occurrencesOf: each ) ].
	
	self assert: (aCol size = collection size ).! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIndexAccessTest
	| res collection element |
	self collectionMoreThan1NoDuplicates.
	self assert: self collectionMoreThan1NoDuplicates size > 1.
	res := true.
	self collectionMoreThan1NoDuplicates
		detect: [ :each | (self collectionMoreThan1NoDuplicates occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false.
	self elementInForIndexAccessing.
	self
		assert: ((collection := self collectionMoreThan1NoDuplicates) includes: (element := self elementInForIndexAccessing)).
	self elementNotInForIndexAccessing.
	self deny: (self collectionMoreThan1NoDuplicates includes: self elementNotInForIndexAccessing)! !

!FloatArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithDo
	
	| firstCollection secondCollection index |

	firstCollection := self nonEmptyMoreThan1Element.
	secondCollection := firstCollection copy.
	index := 0.
	
	firstCollection  with: secondCollection do:
		[:a :b |
		( index := index + 1).
		self assert: (firstCollection at: index) equals:  a. 
		self assert: (secondCollection at: index) equals:  b.]
	
	! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 16:41'!
sortedInAscendingOrderCollection
" return a collection sorted in an acsending order"
	^ sortedCollection ifNil: [ sortedCollection := ( FloatArray new: 3)at: 1 put: 1.0 ; at: 2 put: 2.0 ; at: 3 put: 3.0 ; yourself ]
	! !

!FloatArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testAllButFirstDo
	
	| result |
	result:= OrderedCollection  new.
	
	self nonEmptyMoreThan1Element  allButFirstDo: [:each | result add: each].
	
	1 to: (result size) do:
		[:i|
		self assert: (self nonEmptyMoreThan1Element  at:(i +1))=(result at:i)].
	
	self assert: result size=(self nonEmptyMoreThan1Element  size-1).! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 14:55'!
secondCollection
" return a collection that will be the second part of the concatenation"
	^ collectionWithEqualElements ! !

!FloatArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithDoError
	
	self should: [self nonEmptyMoreThan1Element with: self empty do:[:a :b | ]] raise: Error.! !

!FloatArrayTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyCreatesNewObject
	"self debug: #testCopyCreatesNewObject"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: self nonEmpty == copy.
	! !

!FloatArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testAtWrap
	"self debug: #testAt"
	"
	self assert: (self accessCollection at: 1) = 1.
	self assert: (self accessCollection at: 2) = 2.
	"
	| index |
	index := self moreThan4Elements indexOf: self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: index) = self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: index + self moreThan4Elements size) = self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: index - self moreThan4Elements size) = self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: 1 + self moreThan4Elements size) = (self moreThan4Elements at: 1)! !

!FloatArrayTest methodsFor: 'tests - arithmetic' stamp: 'nice 11/23/2007 23:53'!
testArithmeticCoercion
	"This test is related to http://bugs.squeak.org/view.php?id=6782"
	
	self should: [3.0 / (FloatArray with: 2.0) = (FloatArray with: 1.5)].
	self should: [3.0 * (FloatArray with: 2.0) = (FloatArray with: 6.0)].
	self should: [3.0 + (FloatArray with: 2.0) = (FloatArray with: 5.0)].
	self should: [3.0 - (FloatArray with: 2.0) = (FloatArray with: 1.0)].! !

!FloatArrayTest methodsFor: 'tests - concatenation' stamp: ''!
testConcatenation
	| result index |
	result:= self firstCollection,self secondCollection .
	"first part : "
	index := 1.
	self firstCollection do: 
		[:each | 
		self assert: (self firstCollection at: index)=each.
		index := index+1.].
	"second part : "
	1 to: self secondCollection size do:
		[:i | 
		self assert: (self secondCollection at:i)= (result at:index).
		index:=index+1].
	"size : "
	self assert: result size = (self firstCollection size + self secondCollection size).! !

!FloatArrayTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutNotIncluded
	"self debug: #testCopyNonEmptyWithoutNotIncluded"
	| res |
	res := self nonEmpty copyWithout: self elementToAdd.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self nonEmpty do: [ :each | self assert: (res includes: each) ]! !

!FloatArrayTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithout
	"self debug: #testCopyNonEmptyWithout"
	
	| res anElementOfTheCollection |
	anElementOfTheCollection :=  self nonEmpty anyOne.
	res := (self nonEmpty copyWithout: anElementOfTheCollection).
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self deny: (res includes: anElementOfTheCollection).
	self nonEmpty do:
		[:each | (each = anElementOfTheCollection) 
					ifFalse: [self assert: (res includes: each)]].
	
! !

!FloatArrayTest methodsFor: 'tests - converting' stamp: ''!
testAsOrderedCollection
	
	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: OrderedCollection! !

!FloatArrayTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionItself
	"self debug: #testIntersectionItself"
	
	| result |
	result :=  (self collectionWithoutEqualElements intersection: self collectionWithoutEqualElements).
	self assert: result size  = self collectionWithoutEqualElements size.
	self collectionWithoutEqualElements do: [ :each|
		self assert: (result includes: each) ].
	! !

!FloatArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testKeysAndValuesDo
	"| result |
	result:= OrderedCollection new.
	
	self nonEmptyMoreThan1Element  keysAndValuesDo: 
		[:i :value|
		result add: (value+i)].
	
	1 to: result size do:
		[:i|
		self assert: (result at:i)=((self nonEmptyMoreThan1Element at:i)+i)]"
	|  indexes elements |
	indexes:= OrderedCollection new.
	elements := OrderedCollection new.
	
	self nonEmptyMoreThan1Element  keysAndValuesDo: 
		[:i :value|
		indexes  add: (i).
		elements add: value].
	
	(1 to: self nonEmptyMoreThan1Element size )do:
		[ :i |
		self assert: (indexes at: i) = i.
		self assert: (elements at: i) = (self nonEmptyMoreThan1Element at: i).	
		].
	
	self assert: indexes size = elements size. 
	self assert: indexes size = self nonEmptyMoreThan1Element size . 
	
	! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0CopyTest
	self empty.
	self assert: self empty size = 0.
	self nonEmpty.
	self assert: (self nonEmpty size = 0) not.
	self collectionWithElementsToRemove.
	self assert: (self collectionWithElementsToRemove size = 0) not.
	self collectionWithElementsToRemove do: [ :each | self assert: (self nonEmpty includes: each) ].
	self elementToAdd.
	self deny: (self nonEmpty includes: self elementToAdd).
	self collectionNotIncluded.
	self collectionNotIncluded do: [ :each | self deny: (self nonEmpty includes: each) ]! !

!FloatArrayTest methodsFor: 'tests - streaming' stamp: ''!
testStreamContentsProtocol
	| result index |
	result:= self collectionClass << [ :s|
		s 
			nextPutAll: self firstCollection;
			nextPutAll: self secondCollection ].
	self assert: result equals: self firstCollection, self secondCollection.! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 15:30'!
indexInNonEmpty
" return an index between bounds of 'nonEmpty' "

	^ 3.! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 16:07'!
collectionWithNonIdentitySameAtEndAndBegining
	" return a collection with elements at end and begining equals only with classic equality (they are not the same object).
(others elements of the collection are not equal to those elements)"
	^ collectionWithSameAtEndAndBegining 		! !

!FloatArrayTest methodsFor: 'tests - begins ends with' stamp: ''!
testsBeginsWithEmpty
	
	self deny: (self nonEmpty beginsWith:(self empty)).
	self deny: (self empty beginsWith:(self nonEmpty )).
! !

!FloatArrayTest methodsFor: 'tests - equality' stamp: ''!
testHasEqualElements
	"self debug: #testHasEqualElements"

	self deny: (self empty hasEqualElements: self nonEmpty).
	self deny: (self nonEmpty hasEqualElements: self nonEmpty asSet). 
	self deny: (self nonEmpty reversed hasEqualElements: self nonEmpty).
	self deny: (self nonEmpty hasEqualElements: self nonEmpty reversed).! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSequencedConcatenationTest
	self empty.
	self assert: self empty isEmpty.
	self firstCollection.
	self secondCollection! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 15:50'!
collectionWithCopyNonIdentical
	" return a collection that include elements for which 'copy' return a different object (this is not the case of SmallInteger)"
	^ nonEmpty5ElementsNoDuplicate ! !

!FloatArrayTest methodsFor: 'test - equality' stamp: ''!
testEqualSign
	"self debug: #testEqualSign"

	self deny: (self empty = self nonEmpty).! !

!FloatArrayTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedCollection

	| aCollection result |
	aCollection := self collectionWithSortableElements .
	result := aCollection asSortedCollection.
	
	self assert: (result class includesBehavior: SortedCollection).
	result do: 
		[ :each | 
		self assert: (aCollection occurrencesOf: each) = (result occurrencesOf: each) ].
	
	self assert: result size = aCollection size.! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0TSequencedStructuralEqualityTest
	self nonEmpty at: 1	"Ensures #nonEmpty is sequenceable"! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 11:45'!
collectionClass 
	
	^ FloatArray! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 14:57'!
nonEmpty1Element
" return a collection of size 1 including one element"
	^ nonEmpty1Element ! !

!FloatArrayTest methodsFor: 'tests - begins ends with' stamp: ''!
testsBeginsWith
	
	self assert: (self nonEmpty beginsWith:(self nonEmpty copyUpTo: self nonEmpty last)).
	self assert: (self nonEmpty beginsWith:(self nonEmpty )).
	self deny: (self nonEmpty beginsWith:(self nonEmpty copyWith:self nonEmpty first)).! !

!FloatArrayTest methodsFor: 'tests - set arithmetic' stamp: ''!
testUnion
	"self debug: #testUnionOfEmpties"
	
	| union |
	union := self empty union: self nonEmpty.
	self containsAll: union of: self empty andOf: self nonEmpty.
	union := self nonEmpty union: self empty.
	self containsAll: union of: self empty andOf: self nonEmpty.
	union := self collection union: self nonEmpty.
	self containsAll: union of: self collection andOf: self nonEmpty.! !

!FloatArrayTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWithout
	"self debug: #testCopyEmptyWithout"
	| res |
	res := self empty copyWithout: self elementToAdd.
	self assert: res size = self empty size.
	self deny: (res includes: self elementToAdd)! !

!FloatArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testDo! !

!FloatArrayTest methodsFor: 'tests - equality' stamp: ''!
testHasEqualElementsIsTrueForNonIdenticalButEqualCollections
	"self debug: #testHasEqualElementsIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty hasEqualElements: self empty copy). 
	self assert: (self empty copy hasEqualElements: self empty).
	self assert: (self empty copy hasEqualElements: self empty copy).
		
	self assert: (self nonEmpty hasEqualElements: self nonEmpty copy). 
	self assert: (self nonEmpty copy hasEqualElements: self nonEmpty).
	self assert: (self nonEmpty copy hasEqualElements: self nonEmpty copy).! !

!FloatArrayTest methodsFor: 'tests - copying with replacement' stamp: ''!
testCopyReplaceFromToWith
	| result  indexOfSubcollection lastIndexOfOldSubcollection lastIndexOfReplacementCollection |
	
	indexOfSubcollection := (self firstIndexesOf: self oldSubCollection  in:  self collectionWith1TimeSubcollection) at: 1. 
	lastIndexOfOldSubcollection := indexOfSubcollection + self oldSubCollection size -1.
	lastIndexOfReplacementCollection := indexOfSubcollection + self replacementCollection  size -1.
	
	result := self collectionWith1TimeSubcollection  copyReplaceFrom: indexOfSubcollection  to: lastIndexOfOldSubcollection   with: self replacementCollection .
	
	"verify content of 'result' : "
	"first part of 'result'  "
	
	1 to: (indexOfSubcollection  - 1) do: 
		[ 
		:i | 
		self assert: (self collectionWith1TimeSubcollection  at:i) = (result at: i)
		].
	
	" middle part containing replacementCollection : "
	
	(indexOfSubcollection ) to: ( lastIndexOfReplacementCollection  ) do: 
		[
		:i |
		self assert: (result at: i)=(self replacementCollection at: (i - indexOfSubcollection +1))
		].
	
	" end part :"
	1 to: (result size - lastIndexOfReplacementCollection   ) do:
		[ 
		:i |
		self assert: (result at: ( lastIndexOfReplacementCollection  + i  ) ) = (self collectionWith1TimeSubcollection  at: ( lastIndexOfOldSubcollection  + i  ) ).
		].
	
	
	

	
	! !

!FloatArrayTest methodsFor: 'tests - copying same contents' stamp: ''!
testShuffled
	| result |
	result := self nonEmpty shuffled .
	
	"verify content of 'result: '"
	result do: [:each | self assert: (self nonEmpty occurrencesOf: each)=(result occurrencesOf: each)].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!FloatArrayTest methodsFor: 'tests - copy' stamp: ''!
testCopySameClass
	"self debug: #testCopySameClass"
	"A copy of a collection should always be of the same class as the instance it copies"
	
	| copy | 
	copy := self empty copy.
	self assert: copy class == self empty class.! !

!FloatArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testAfter
	"self debug: #testAfter"
	self assert: (self moreThan4Elements after: (self moreThan4Elements at: 1)) = (self moreThan4Elements at: 2).
	self 
		should: 
			[ self moreThan4Elements after: (self moreThan4Elements at: self moreThan4Elements size) ]
		raise: Error.
	self 
		should: [ self moreThan4Elements after: self elementNotInForElementAccessing ]
		raise: Error! !

!FloatArrayTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButFirstNElements
	"self debug: #testAllButFirst"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButFirst: 2.
	1 
		to: abf size
		do: [ :i | self assert: (abf at: i) = (col at: i + 2) ].
	self assert: abf size + 2 = col size! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureAsSetForIdentityMultiplinessTest
	"a collection (of elements for which copy is not identical ) without equal elements:"

	| anElement res |
	self elementsCopyNonIdenticalWithoutEqualElements.
	anElement := self elementsCopyNonIdenticalWithoutEqualElements anyOne.
	self deny: anElement copy == anElement.
	res := true.
	self elementsCopyNonIdenticalWithoutEqualElements
		detect: [ :each | (self elementsCopyNonIdenticalWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 15:36'!
oldSubCollection
" return a subCollection included in collectionWith1TimeSubcollection .
ex :   subCollection := #( 2 3 4) and collectionWith1TimeSubcollection := #(1 2 3 4 5)"
	^ nonEmpty5ElementsNoDuplicate ! !

!FloatArrayTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfter
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyAfter: (collection  at:index ).
	
	"verifying content: "
	(1) to: result size do: 
		[:i |
		self assert: (collection   at:(i + index ))=(result at: (i))].

	"verify size: "
	self assert: result size = (collection   size - index).! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixturePrintTest
	self nonEmpty! !

!FloatArrayTest methodsFor: 'tests - sorting' stamp: ''!
testIsSortedBy
	self assert: (self sortedInAscendingOrderCollection isSortedBy: [:a :b | a<b]).
	self deny: (self sortedInAscendingOrderCollection isSortedBy: [:a :b | a>b]).
! !

!FloatArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testReverseWithDo
	
	| firstCollection secondCollection index |

	firstCollection := self nonEmptyMoreThan1Element.
	secondCollection := firstCollection copy.
	index := firstCollection size.
	
	firstCollection  reverseWith: secondCollection do:
		[:a :b |
	
		self assert: (firstCollection at: index) equals:  a. 
		self assert: (secondCollection at: index) equals:  b.
			( index := index - 1).]
	
	
	! !

!FloatArrayTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyFromTo
	| result  index collection |
	collection := self collectionWithoutEqualElements .
	index :=self indexInForCollectionWithoutDuplicates .
	result := collection   copyFrom: index  to: collection  size .
	
	"verify content of 'result' : "
	1 to: result size do:
		[:i | 
		self assert: (result at:i)=(collection  at: (i + index - 1))].
	
	"verify size of 'result' : "
	self assert: result size = (collection  size - index + 1).! !

!FloatArrayTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAllNoneThere
	"self debug: #testIncludesAllOfNoneThere'"
	self deny: (self empty includesAll: self nonEmpty ).
	self deny: (self nonEmpty includesAll: { self elementNotIn. self anotherElementNotIn })! !

!FloatArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testKeysAndValuesDoEmpty
	| result |
	result:= OrderedCollection new.
	
	self empty  keysAndValuesDo: 
		[:i :value|
		result add: (value+i)].
	
	self assert: result isEmpty .! !

!FloatArrayTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfStartingAt
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			indexOf: element
			startingAt: 2
			ifAbsent: [ 99 ]) = 99.
	self assert: (collection 
			indexOf: element
			startingAt: 1
			ifAbsent: [ 99 ]) = 1.
	self assert: (collection 
			indexOf: self elementNotInForIndexAccessing
			startingAt: 1
			ifAbsent: [ 99 ]) = 99! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 16:35'!
elementNotInForElementAccessing
" return an element not included in 'moreThan4Elements' "
	^ elementNotIn ! !

!FloatArrayTest methodsFor: 'tests - as set tests' stamp: ''!
testAsSetWithEqualsElements
	| result |
	result := self withEqualElements asSet.
	self withEqualElements do: [ :each | self assert: (result occurrencesOf: each) = 1 ].
	self assert: result class = Set! !

!FloatArrayTest methodsFor: 'tests - printing' stamp: ''!
testPrintOnDelimiterLast

	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printOn: aStream delimiter: ', ' last: 'and'.
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 )
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString)].
		i=(allElementsAsString size-1)
			ifTrue:[ self deny: (allElementsAsString at:i)=('and')asString].
		i=(allElementsAsString size)
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:(i-1))asString)].
			].! !

!FloatArrayTest methodsFor: 'tests - converting' stamp: ''!
testAsBag

	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: Bag! !

!FloatArrayTest methodsFor: 'tests - copying part of sequenceable for multipliness' stamp: ''!
testCopyAfterLastWithDuplicate
	| result element  collection |
	collection := self collectionWithSameAtEndAndBegining .
	element := collection  first.
	
	" collectionWithSameAtEndAndBegining first and last elements are equals.
	'copyAfter:' should copy after the last occurence of element :"
	result := collection   copyAfterLast: (element ).
	
	"verifying content: "
	self assert: result isEmpty.

! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 15:26'!
indexInForCollectionWithoutDuplicates
" return an index between 'collectionWithoutEqualsElements'  bounds"
	^ 2.! !

!FloatArrayTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWith
	"self debug: #testCopyWith"
	| res anElement |
	anElement := self elementToAdd.
	res := self empty copyWith: anElement.
	self assert: res size = (self empty size + 1).
	self assert: (res includes: (anElement value))! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureConverAsSortedTest
	self collectionWithSortableElements.
	self deny: self collectionWithSortableElements isEmpty! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
howMany: aSubCollection in: collection
" return an integer representing how many time 'subCollection'  appears in 'collection'  "
	| tmp nTime |
	tmp := collection.
	nTime:= 0.
	
	[tmp isEmpty ]whileFalse:
		[
		(tmp beginsWith: aSubCollection)
			ifTrue: [ 	
				nTime := nTime + 1.
				1 to: aSubCollection size do: [:i | tmp := tmp copyWithoutFirst.]
				]
			ifFalse: [tmp := tmp copyWithoutFirst.]
		 ].
	
	^ nTime.
	! !

!FloatArrayTest methodsFor: 'tests - printing' stamp: ''!
testStoreOn
" for the moment work only for collection that include simple elements such that Integer"

"| string str result cuttedResult index elementsAsStringExpected elementsAsStringObtained tmp |
string := ''.
str := ReadWriteStream  on: string.
elementsAsStringExpected := OrderedCollection new.
elementsAsStringObtained := OrderedCollection new.
self nonEmpty do: [ :each | elementsAsStringExpected  add: each asString].

self nonEmpty storeOn: str.
result := str contents .
cuttedResult := ( result findBetweenSubStrs: ';' ).

index := 1.

cuttedResult do:
	[ :each |
	index = 1 
		ifTrue: [ self assert: (each beginsWith: ( tmp := '((' , self nonEmpty class asString , ' new) add: '           )).
				tmp := each copyFrom: ( tmp size + 1) to: ( each size ).
				elementsAsStringObtained add: tmp.
				index := index + 1. ]
		ifFalse:  [ 
		 index < cuttedResult size
			ifTrue:[self assert: (each beginsWith: ( tmp:=  ' add: '   )).
				tmp := each copyFrom: ( tmp size + 1) to: ( each size ).
				elementsAsStringObtained add: tmp.
					index := index + 1.]
			ifFalse: [self assert: ( each = ' yourself)' ) ].
			]
	
	].


	elementsAsStringExpected do: [ :each | self assert: (elementsAsStringExpected occurrencesOf: each ) = ( elementsAsStringObtained occurrencesOf: each) ]"

! !

!FloatArrayTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfStartingAtIfAbsent
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			indexOf: element
			startingAt: 2
			ifAbsent: [ 99 ]) = 99.
	self assert: (collection 
			indexOf: element
			startingAt: 1
			ifAbsent: [ 99 ]) = 1.
	self assert: (collection 
			indexOf: self elementNotInForIndexAccessing
			startingAt: 1
			ifAbsent: [ 99 ]) = 99! !

!FloatArrayTest methodsFor: 'tests - replacing' stamp: ''!
testReplaceAllWith
	| result  collection oldElement newElement oldOccurrences |
	collection := self nonEmpty .
	result := collection  copy.
	oldElement := self elementInForReplacement .
	newElement := self newElement .
	oldOccurrences := (result occurrencesOf: oldElement) + (result occurrencesOf: newElement).
	result replaceAll: oldElement  with: newElement  .
	
	self assert: oldOccurrences = (result occurrencesOf: newElement)! !

!FloatArrayTest methodsFor: 'tests - set arithmetic' stamp: ''!
numberOfSimilarElementsInIntersection
	^ self collection occurrencesOf: self anotherElementOrAssociationIn! !

!FloatArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testAtAll
	"self debug: #testAtAll"
	"	self flag: #theCollectionshouldbe102030intheFixture.
	
	self assert: (self accessCollection atAll: #(2 1)) first = self accessCollection second.
	self assert: (self accessCollection atAll: #(2)) first = self accessCollection second."
	| result |
	result := self moreThan4Elements atAll: #(2 1 2 ).
	self assert: (result at: 1) = (self moreThan4Elements at: 2).
	self assert: (result at: 2) = (self moreThan4Elements at: 1).
	self assert: (result at: 3) = (self moreThan4Elements at: 2).
	self assert: (self moreThan4Elements atAll: #()) = self moreThan4Elements species new! !

!FloatArrayTest methodsFor: 'tests - converting' stamp: ''!
assertNonDuplicatedContents: aCollection whenConvertedTo: aClass 
	| result |
	result := aCollection perform: ('as' , aClass name) asSymbol.
	self assert: (result class includesBehavior: aClass).
	result do: 
		[ :each | 
		self assert: (aCollection occurrencesOf: each) = (result occurrencesOf: each) ].
	^ result! !

!FloatArrayTest methodsFor: 'tests - copying same contents' stamp: ''!
testShallowCopy
	| result |
	result := self nonEmpty shallowCopy .
	
	"verify content of 'result: '"
	1 to: self nonEmpty size do:
		[:i | self assert: ((result at:i)=(self nonEmpty at:i))].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!FloatArrayTest methodsFor: 'tests - streaming' stamp: ''!
testStreamContentsSized
	| result |
	result:= self collectionClass new: 1 streamContents: [ :s|
		s 
			nextPutAll: self firstCollection;
			nextPutAll: self secondCollection ].
	self assert: result equals: self firstCollection, self secondCollection.
	
	result:= self collectionClass new: 1000 streamContents: [ :s|
		s 
			nextPutAll: self firstCollection;
			nextPutAll: self secondCollection ].
	self assert: result equals: self firstCollection, self secondCollection.! !

!FloatArrayTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfIfAbsent
	"self debug: #testIndexOfIfAbsent"
	| collection |
	collection := self collectionMoreThan1NoDuplicates.
	self assert: (collection 
			indexOf: collection first
			ifAbsent: [ 33 ]) = 1.
	self assert: (collection 
			indexOf: self elementNotInForIndexAccessing
			ifAbsent: [ 33 ]) = 33! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyPartOfSequenceableTest
	self collectionWithoutEqualElements.
	self collectionWithoutEqualElements
		do: [ :each | self assert: (self collectionWithoutEqualElements occurrencesOf: each) = 1 ].
	self indexInForCollectionWithoutDuplicates.
	self
		assert:
			(self indexInForCollectionWithoutDuplicates > 0 & self indexInForCollectionWithoutDuplicates)
				< self collectionWithoutEqualElements size.
	self empty.
	self assert: self empty isEmpty! !

!FloatArrayTest methodsFor: 'test - creation' stamp: ''!
testWithWithWith
	"self debug: #testWithWithWith"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom:1 to: 3 .
	aCol := self collectionClass with: (collection at:1) with: ( collection at:2 ) with: ( collection at: 3).

	1 to: 3 do: [ :i | self assert: ( aCol occurrencesOf: ( collection at: i ) ) = ( collection occurrencesOf: ( collection at: i ) ) ].! !

!FloatArrayTest methodsFor: 'tests - converting' stamp: ''!
testAsIdentitySet
	"test with a collection without equal elements :"
	self 
		assertSameContents: self collectionWithoutEqualElements
		whenConvertedTo: IdentitySet.
! !

!FloatArrayTest methodsFor: 'tests - converting' stamp: ''!
testAsSet
	| |
	"test with a collection without equal elements :"
	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: Set.
	! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyWithOrWithoutSpecificElementsTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self indexInNonEmpty.
	self assert: self indexInNonEmpty > 0.
	self assert: self indexInNonEmpty <= self nonEmpty size! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 15:55'!
elementNotInForIndexAccessing
" return an element not included in 'collectionMoreThan1NoDuplicates' "
	^ elementNotIn ! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 14:55'!
firstCollection
" return a collection that will be the first part of the concatenation"
	^ nonEmpty5ElementsNoDuplicate ! !

!FloatArrayTest methodsFor: 'tests - includes' stamp: ''!
testIncludesElementIsThere
	"self debug: #testIncludesElementIsThere"
	
	self assert: (self nonEmpty includes: self nonEmpty anyOne).! !

!FloatArrayTest methodsFor: 'tests - sorting' stamp: ''!
testSortUsingSortBlock
	| result tmp |
	result := self unsortedCollection sort: [:a :b | a>b].
	tmp := result at: 1.
	result do:
		[:each | self assert: each<=tmp. tmp:= each. ].! !

!FloatArrayTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifferenceWithSeparateCollection
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifferenceWithSeparateCollection"
	| res separateCol |
	
	separateCol := self collectionClass with: self anotherElementOrAssociationNotIn.
	res := self collectionWithoutEqualElements difference: separateCol.
	
	self deny: (res includes: self anotherElementOrAssociationNotIn).
	self assert: res size equals: self collectionWithoutEqualElements size.
	
	self collectionWithoutEqualElements do: [ :each|
		self assert: (res includes: each)].
	
	res := separateCol difference: self collection.
	self deny: (res includes: self collection anyOne).
	self assert: res equals: separateCol! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCloneTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 15:04'!
withEqualElements
	^ collectionWithEqualElements ! !

!FloatArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testAtLastError
	"self debug: #testAtLast"
	self 
		should: [ self moreThan4Elements atLast: self moreThan4Elements size + 1 ]
		raise: Error! !

!FloatArrayTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpToLastEmpty
	| result |
	result := self empty copyUpToLast: self collectionWithoutEqualElements first.
	self assert: result isEmpty.! !

!FloatArrayTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpToLast
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyUpToLast: (collection  at:index).
	
	"verify content of 'result' :"
	1 to: result size do: [:i| self assert: (collection   at:i)=(result at:i)].
	
	"verify size of 'result' :"
	self assert: result size = (index-1).! !

!FloatArrayTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfSubCollectionStartingAtIfAbsent
	"self debug: #testIndexOfIfAbsent"
	| index absent subcollection collection |
	collection := self collectionMoreThan1NoDuplicates.
	subcollection := self collectionMoreThan1NoDuplicates.
	absent := false.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 1
		ifAbsent: [ absent := true ].
	self assert: absent = false.
	absent := false.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 2
		ifAbsent: [ absent := true ].
	self assert: absent = true! !

!FloatArrayTest methodsFor: 'tests - printing' stamp: ''!
testPrintOn
	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printOn: aStream .
	allElementsAsString:=(result findBetweenSubStrs: ' ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i=1
			ifTrue:[
			self accessCollection class name first isVowel 
				ifTrue:[self assert: (allElementsAsString at:i)='an' ]
				ifFalse:[self assert: (allElementsAsString at:i)='a'].].
		i=2
			ifTrue:[self assert: (allElementsAsString at:i)=self accessCollection class name].
		i>2
			ifTrue:[self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString).].	
			].! !

!FloatArrayTest methodsFor: 'tests - at put' stamp: ''!
testAtPutTwoValues
	"self debug: #testAtPutTwoValues"
	
	self nonEmpty at: self anIndex put: self aValue.
	self nonEmpty at: self anIndex put: self anotherValue.
	self assert: (self nonEmpty at: self anIndex) = self anotherValue.! !

!FloatArrayTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpTo
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyUpTo: (collection  at:index).
	
	"verify content of 'result' :"
	1 to: result size do: [:i| self assert: (collection   at:i)=(result at:i)].
	
	"verify size of 'result' :"
	self assert: result size = (index-1).
	! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 15:44'!
collectionWithElementsToRemove
" return a collection of elements included in 'nonEmpty'  "
	^ nonEmptySubcollection 
	ifNil: [ nonEmptySubcollection := (FloatArray new:2 ) at:1 put: self nonEmpty first ; at:2 put: self nonEmpty last ; yourself ]! !

!FloatArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testLast
	"self debug: #testLast"
	self assert: self moreThan4Elements last = (self moreThan4Elements at: self moreThan4Elements size)! !

!FloatArrayTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterLastMore

	| delim multiItemStream result last allElementsAsString |
	
	delim := ', '.
	last := 'and'.
	result:=''.
	multiItemStream := ReadWriteStream on:result.
	self nonEmpty  asStringOn: multiItemStream delimiter: ', ' last: last.
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 )
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString)].
		i=(allElementsAsString size-1)
			ifTrue:[ self deny: (allElementsAsString at:i)=(last)asString].
		i=(allElementsAsString size)
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:(i-1))asString)].
			].
	
! !

!FloatArrayTest methodsFor: 'tests - copying same contents' stamp: ''!
testReversed
	| result |
	result := self nonEmpty reversed .
	
	"verify content of 'result: '"
	1 to:  result size do:
		[:i | self assert: ((result at:i)=(self nonEmpty at:(self nonEmpty size-i+1)))].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIncludeTest
	| anElementIn |
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self elementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self elementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self anotherElementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self anotherElementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self empty.
	self assert: self empty isEmpty! !

!FloatArrayTest methodsFor: 'tests - including with identity' stamp: ''!
testIdentityIncludes
	" test the comportement in presence of elements 'includes' but not 'identityIncludes' "
	" can not be used by collections that can't include elements for wich copy doesn't return another instance "
	| collection anElement |
	
	collection := self collectionWithCopyNonIdentical.
	anElement := collection anyOne copy.

	self deny: (collection identityIncludes: anElement)! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIndexAccessFotMultipliness
	self collectionWithSameAtEndAndBegining.
	self assert: self collectionWithSameAtEndAndBegining first = self collectionWithSameAtEndAndBegining last.
	self assert: self collectionWithSameAtEndAndBegining size > 1.
	1 to: self collectionWithSameAtEndAndBegining size do: [ :i | 
		i > 1 & (i < self collectionWithSameAtEndAndBegining size)
			ifTrue: [ self deny: (self collectionWithSameAtEndAndBegining at: i) = self collectionWithSameAtEndAndBegining first ] ]! !

!FloatArrayTest methodsFor: 'tests - includes' stamp: ''!
testIncludesElementIsNotThere
	"self debug: #testIncludesElementIsNotThere"
	
	self deny: (self nonEmpty includes: self elementNotIn).
	self assert: (self nonEmpty includes: self nonEmpty anyOne).
	self deny: (self empty includes: self elementNotIn)! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 15:37'!
replacementCollection
" return a collection that will be used to replace 'oldSubcollection' in ' collectionWith1TimeSubcollection'  " 
	^ collectionWithSameAtEndAndBegining ! !

!FloatArrayTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfterEmpty
	| result |
	result := self empty copyAfter: self collectionWithoutEqualElements first.
	self assert: result isEmpty.
	! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 15:28'!
collectionWithSameAtEndAndBegining
" return a collection with elements at end and begining equals .
(others elements of the collection are not equal to those elements)"
	^ collectionWithSameAtEndAndBegining ! !

!FloatArrayTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testLastIndexOfStartingAtDuplicate
	"self debug: #testLastIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection last.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'lastIndexOf:ifAbsent:startingAt: should return the position of the last occurrence :'"
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size
			ifAbsent: [ 55 ]) = collection size.
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size - 1
			ifAbsent: [ 55 ]) = 1! !

!FloatArrayTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithoutIndex
	| result index |
	index := self indexInNonEmpty .
	result := self nonEmpty copyWithoutIndex: index .
	
	"verify content of 'result:'"
	1 to: result size do:
		[:i | 
		i<( index ) ifTrue: [self assert: ((result at:i )= (self nonEmpty at:i))].
		i>=( index ) ifTrue: [self assert: (result at:i )= (self nonEmpty at:(i+1))]].
	
	"verify size of result : "
	self assert: result size=(self nonEmpty size -1).! !

!FloatArrayTest methodsFor: 'tests - puting with indexes' stamp: ''!
testAtWrapPut
	"self debug: #testAtWrapPut"
	| index |
	index := self indexArray anyOne.
	
	self nonEmpty atWrap: 0 put: self aValue.
	self assert: (self nonEmpty at:(self nonEmpty size))=self aValue.
	
	self nonEmpty atWrap: (self nonEmpty size+1) put: self aValue.
	self assert: (self nonEmpty at:(1))=self aValue.
	
	self nonEmpty atWrap: (index  ) put: self aValue.
	self assert: (self nonEmpty at: index ) = self aValue.
	
	self nonEmpty atWrap: (self nonEmpty size+index  ) put: self aValue .
	self assert: (self nonEmpty at:(index ))=self aValue .! !

!FloatArrayTest methodsFor: 'testing' stamp: 'nice 5/30/2006 03:17'!
testFloatArrayPluginPrimitiveAtPut
	"if FloatArrayPlugin primitive are not here, this test is dumb.
	Otherwise, it will compare primitive and #asIEEE32BitWord"
	
	#(
		"regular numbers no truncation or rounding"
		2r0.0 2r1.0 2r1.1 2r1.00000000000000000000001
		2r1.0e-10 2r1.1e-10 2r1.00000000000000000000001e-10
		2r1.0e10 2r1.1e10 2r1.00000000000000000000001e10
		
		"smallest float32 before gradual underflow"
		2r1.0e-126
		
		"biggest float32"
		2r1.11111111111111111111111e127
		
		"overflow"
		2r1.11111111111111111111111e128
		
		"gradual underflow"
		2r0.11111111111111111111111e-126
		2r0.00000000000000000000001e-126
		
		"with rounding mode : tests on 25 bits"
		
		2r1.0000000000000000000000001
		2r1.0000000000000000000000010
		2r1.0000000000000000000000011
		2r1.0000000000000000000000100
		2r1.0000000000000000000000101
		2r1.0000000000000000000000110
		2r1.0000000000000000000000111
		2r1.1111111111111111111111001
		2r1.1111111111111111111111010
		2r1.1111111111111111111111011
		2r1.1111111111111111111111101
		2r1.1111111111111111111111110
		2r1.1111111111111111111111111
		
		"overflow"
		2r1.1111111111111111111111110e127
		
		"gradual underflow"
		2r0.1111111111111111111111111e-126
		2r0.1111111111111111111111110e-126
		2r0.1111111111111111111111101e-126
		2r0.1111111111111111111111011e-126
		2r0.1111111111111111111111010e-126
		2r0.1111111111111111111111001e-126
		2r0.0000000000000000000000111e-126
		2r0.0000000000000000000000110e-126
		2r0.0000000000000000000000101e-126
		2r0.0000000000000000000000011e-126
		2r0.0000000000000000000000010e-126
		2r0.0000000000000000000000001e-126
		2r0.0000000000000000000000010000000000000000000000000001e-126
		) do: [:e |
			self assert: ((FloatArray with: e) basicAt: 1) = e asIEEE32BitWord.
			self assert: ((FloatArray with: e negated) basicAt: 1) = e negated asIEEE32BitWord].
		
	"special cases"
	(Array with: Float infinity with: Float infinity negated with: Float negativeZero with: Float nan)
		do: [:e | self assert: ((FloatArray with: e) basicAt: 1) = e asIEEE32BitWord].
		! !

!FloatArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testReverseDo
	| result |
	result:= OrderedCollection new.
	self nonEmpty reverseDo: [: each | result add: each].
	
	1 to: result size do:
		[:i|
		self assert: (result at: i)=(self nonEmpty at:(self nonEmpty size-i+1))].! !

!FloatArrayTest methodsFor: 'tests - copy' stamp: ''!
testCopyEquals
	"self debug: #testCopySameClass"
	"A copy should be equivalent to the things it's a copy of"
	
	| copy | 
	copy := self nonEmpty copy.
	self assert: copy  = self nonEmpty.! !

!FloatArrayTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testIndexOfDuplicate
	"self debug: #testIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection last.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'indexOf: should return the position of the first occurrence :'"
	self assert: (collection indexOf: element) = 1! !

!FloatArrayTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWithoutAll
	"self debug: #testCopyEmptyWithoutAll"
	| res |
	res := self empty copyWithoutAll: self collectionWithElementsToRemove.
	self assert: res size = self empty size.
	self collectionWithElementsToRemove do: [ :each | self deny: (res includes: each) ]! !

!FloatArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testAtPin
	"self debug: #testAtPin"
	self assert: (self moreThan4Elements atPin: 2) = self moreThan4Elements second.
	self assert: (self moreThan4Elements atPin: 99) = self moreThan4Elements last.
	self assert: (self moreThan4Elements atPin: -99) = self moreThan4Elements first! !

!FloatArrayTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutAll
	"self debug: #testCopyNonEmptyWithoutAll"
	| res |
	res := self nonEmpty copyWithoutAll: self collectionWithElementsToRemove.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self collectionWithElementsToRemove do: [ :each | self deny: (res includes: (each)) ].
	self nonEmpty do: 
		[ :each | 
		(self collectionWithElementsToRemove includes: each) ifFalse: [ self assert: (res includes: each) ] ]! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 15:04'!
elementsCopyNonIdenticalWithoutEqualElements
	" return a collection that does niot incllude equal elements ( classic equality )
	all elements included are elements for which copy is not identical to the element  "
	^ nonEmpty5ElementsNoDuplicate ! !

!FloatArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testAtLastIfAbsent
	"self debug: #testAtLastIfAbsent"
	self assert: (self moreThan4Elements 
			atLast: 1
			ifAbsent: [ nil ]) = self moreThan4Elements last.
	self assert: (self moreThan4Elements 
			atLast: self moreThan4Elements size + 1
			ifAbsent: [ 222 ]) = 222! !

!FloatArrayTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButLastNElements
	"self debug: #testAllButFirst"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButLast: 2.
	1 
		to: abf size
		do: [ :i | self assert: (abf at: i) = (col at: i) ].
	self assert: abf size + 2 = col size! !

!FloatArrayTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfterLast
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyAfterLast: (collection  at:index ).
	
	"verifying content: "
	(1) to: result size do: 
		[:i |
		self assert: (collection   at:(i + index ))=(result at: (i))].

	"verify size: "
	self assert: result size = (collection   size - index).! !

!FloatArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindFirstNotIn

	| result |
	
	 result:=self empty findFirst: [:each | true].
	
	self assert: result=0. ! !

!FloatArrayTest methodsFor: 'test - equality' stamp: ''!
testEqualSignIsTrueForEmptyButNonIdenticalCollections
	"self debug: #testEqualSignIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty = self empty copy). 
	self assert: (self empty copy = self empty).
	self assert: (self empty copy = self empty copy).
		
! !

!FloatArrayTest methodsFor: 'tests - converting' stamp: ''!
assertNoDuplicates: aCollection whenConvertedTo: aClass 
	| result |
	result := self collectionWithEqualElements asIdentitySet.
	self assert: (result class includesBehavior: IdentitySet).
	self collectionWithEqualElements do: [ :initial | self assert: (result occurrencesOf: initial) = 1 ]! !

!FloatArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testAfterIfAbsent
	"self debug: #testAfterIfAbsent"
	self assert: (self moreThan4Elements 
			after: (self moreThan4Elements at: 1)
			ifAbsent: [ 33 ]) = (self moreThan4Elements at: 2).
	self assert: (self moreThan4Elements 
			after: (self moreThan4Elements at: self moreThan4Elements size)
			ifAbsent: [ 33 ]) = 33.
	self assert: (self moreThan4Elements 
			after: self elementNotInForElementAccessing
			ifAbsent: [ 33 ]) = 33! !

!FloatArrayTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsCommaStringEmpty

	self assert: self empty asCommaString = ''.
	self assert: self empty asCommaStringAnd = ''.
	
! !

!FloatArrayTest methodsFor: 'tests - copying with or without' stamp: ''!
testForceToPaddingWith

	| result element |
	element := self nonEmpty at: self indexInNonEmpty .
	result := self nonEmpty forceTo: (self nonEmpty size+2) paddingWith: ( element ).
	
	"verify content of 'result' : "
	1 to: self nonEmpty  size do:
		[:i | self assert: ( self nonEmpty at: i ) = ( result at:(i) ). ].
	
	(result size - 1) to: result size do:
		[:i | self assert: ( result at:i ) = ( element ) ].

	"verify size of 'result' :"
	self assert: result size = (self nonEmpty size + 2).! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 10:45'!
nonEmpty

	^ nonEmpty5ElementsNoDuplicate ! !

!FloatArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindLast

	| element result |
	element := self nonEmptyMoreThan1Element  at:self nonEmptyMoreThan1Element  size.
	 result:=self nonEmptyMoreThan1Element  findLast: [:each | each =element].
	
	self assert: result=self nonEmptyMoreThan1Element  size. ! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCreationWithTest
	self collectionMoreThan5Elements.
	self assert: self collectionMoreThan5Elements size >= 5! !

!FloatArrayTest methodsFor: 'tests - streaming' stamp: ''!
testNewStreamContentsReturnsCollectionOfCorrectSize
	| result item originalSize |
	originalSize := 10.
	item := self firstCollection first.
	result := self collectionClass
		new: originalSize
		streamContents: [ :stream | 
			1 to: originalSize + 1 do: [ :each | stream nextPut: item ].
			stream position: originalSize ].
	self assert: result size equals: originalSize! !

!FloatArrayTest methodsFor: 'tests - at put' stamp: ''!
testAtPut
	"self debug: #testAtPut"
	
	self nonEmpty at: self anIndex put: self aValue.
	self assert: (self nonEmpty at: self anIndex) = self aValue.
	! !

!FloatArrayTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyNonEmpty
	"self debug: #testCopyNonEmpty"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: copy isEmpty.
	self assert: copy size = self nonEmpty size.
	self nonEmpty do: 
		[:each | copy includes: each]! !

!FloatArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testReverseDoEmpty
	| result |
	result:= OrderedCollection new.
	self empty reverseDo: [: each | result add: each].
	
	self assert: result isEmpty .! !

!FloatArrayTest methodsFor: 'test - creation' stamp: ''!
testWithWith
	"self debug: #testWithWith"
	
	| aCol collection element1 element2 |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom: 1 to: 2  .
	element1 := collection at: 1.
	element2 := collection at:2.
	
	aCol := self collectionClass with: element1  with: element2 .
	self assert: (aCol occurrencesOf: element1 ) = ( collection occurrencesOf: element1).
	self assert: (aCol occurrencesOf: element2 ) = ( collection occurrencesOf: element2).
	
	! !

!FloatArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testFirstSecondThird
	"self debug: #testFirstSecondThird"
	self assert: self moreThan4Elements first = (self moreThan4Elements at: 1).
	self assert: self moreThan4Elements second = (self moreThan4Elements at: 2).
	self assert: self moreThan4Elements third = (self moreThan4Elements at: 3).
	self assert: self moreThan4Elements fourth = (self moreThan4Elements at: 4)! !

!FloatArrayTest methodsFor: 'requirements' stamp: ''!
collectionWithIdentical
	"return a collection of type : 'self collectionWIithoutEqualsElements class containing two elements equals ( with identity equality)"
	| result collection anElement |
	collection := OrderedCollection withAll: self elementsCopyNonIdenticalWithoutEqualElements.
	anElement := collection first.
	collection add: anElement.
	result := self elementsCopyNonIdenticalWithoutEqualElements class withAll: collection.
	^ result! !

!FloatArrayTest methodsFor: 'tests - copying with or without' stamp: ''!
testForceToPaddingStartWith

	| result element |
	element := self nonEmpty at: self indexInNonEmpty .
	result := self nonEmpty forceTo: (self nonEmpty size+2) paddingStartWith: ( element ).
	
	"verify content of 'result' : "
	1 to: 2   do:
		[:i | self assert: ( element ) = ( result at:(i) ) ].
	
	3 to: result size do:
		[:i | self assert: ( result at:i ) = ( self nonEmpty at:(i-2) ) ].

	"verify size of 'result' :"
	self assert: result size = (self nonEmpty size + 2).! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 10:55'!
sizeCollection
	"Answers a collection not empty"
	^ nonEmpty5ElementsNoDuplicate ! !

!FloatArrayTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithFirst

	| index element result |
	index:= self indexInNonEmpty .
	element:= self nonEmpty at: index.
	
	result := self nonEmpty copyWithFirst: element.	
	
	self assert: result size = (self nonEmpty size + 1).
	self assert: result first = element .
	
	2 to: result size do:
	[ :i |
	self assert: (result at: i) = ( self nonEmpty at: ( i - 1 ))].! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 16:22'!
aValue
" return a value to put into nonEmpty"
	^ elementNotIn ! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 10:45'!
empty
	^ empty ! !

!FloatArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testAtLast
	"self debug: #testAtLast"
	| index |
	self assert: (self moreThan4Elements atLast: 1) = self moreThan4Elements last.
	"tmp:=1.
	self do:
		[:each | 
		each =self elementInForIndexAccessing 
			ifTrue:[index:=tmp].
		tmp:=tmp+1]."
	index := self moreThan4Elements indexOf: self elementInForElementAccessing.
	self assert: (self moreThan4Elements atLast: index) = (self moreThan4Elements at: self moreThan4Elements size - index + 1)! !

!FloatArrayTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterEmpty

	| delim emptyStream |
	delim := ', '.
	emptyStream := ReadWriteStream on: ''.
	self empty asStringOn: emptyStream delimiter: delim.
	self assert: emptyStream contents = ''.
! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 16:23'!
indexArray
" return a Collection including indexes between bounds of 'nonEmpty' "

	^ { 1. 4. 3.}! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 14:56'!
collection

	^ nonEmpty5ElementsNoDuplicate ! !

!FloatArrayTest methodsFor: 'tests - sorting' stamp: ''!
testSort
	| result tmp |
	result := self unsortedCollection sort.
	tmp := result at: 1.
	result do:
		[:each | self assert: each>=tmp. tmp:= each. ].! !

!FloatArrayTest methodsFor: 'tests - puting with indexes' stamp: ''!
testAtLastPut
	| result index |
	index := self indexArray anyOne.
	result := self nonEmpty atLast: index  put: self aValue.
	
	self assert: (self nonEmpty at: (self nonEmpty size +1 - index)) = self aValue .! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 14:55'!
anotherElementOrAssociationIn
	" return an element (or an association for Dictionary ) present  in 'collection' "
	^ self collection anyOne! !

!FloatArrayTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionEmpty
	"self debug: #testIntersectionEmpty"
	
	| inter |
	inter := self empty intersection: self empty.
	self assert: inter isEmpty. 
	inter := self empty intersection: self collection .
	self assert: inter =  self empty.
	! !

!FloatArrayTest methodsFor: 'tests - sorting' stamp: ''!
testIsSorted
	self assert: self sortedInAscendingOrderCollection isSorted.
	self deny: self unsortedCollection isSorted! !

!FloatArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testAtRandom
	| result |
	result := self nonEmpty atRandom .
	self assert: (self nonEmpty includes: result).! !

!FloatArrayTest methodsFor: 'tests - converting' stamp: ''!
assertSameContents: aCollection whenConvertedTo: aClass 
	| result |
	result := self assertNonDuplicatedContents: aCollection whenConvertedTo: aClass.
	self assert: result size = aCollection size! !

!FloatArrayTest methodsFor: 'tests - equality' stamp: ''!
testEqualSignForSequenceableCollections
	"self debug: #testEqualSign"

	self deny: (self nonEmpty = self nonEmpty asSet). 
	self deny: (self nonEmpty reversed = self nonEmpty).
	self deny: (self nonEmpty = self nonEmpty reversed).! !

!FloatArrayTest methodsFor: 'tests - streaming' stamp: ''!
testStreamContents
	| result index |
	result:= self collectionClass streamContents: [ :s|
		s 
			nextPutAll: self firstCollection;
			nextPutAll: self secondCollection ].
	self assert: result equals: self firstCollection, self secondCollection.! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureBeginsEndsWithTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self assert: self nonEmpty size > 1.
	self empty.
	self assert: self empty isEmpty! !

!FloatArrayTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifferenceWithNonNullIntersection
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifferenceWithNonNullIntersection"
	"	#(1 2 3) difference: #(2 4) 
	->  #(1 3)"
	| res overlapping |
	overlapping := self collectionClass 
		with: self anotherElementOrAssociationNotIn
		with: self anotherElementOrAssociationIn.
	res := self collection difference: overlapping.
	self deny: (res includes: self anotherElementOrAssociationIn).
	overlapping do: [ :each | self deny: (res includes: each) ]! !

!FloatArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testAtIfAbsent
	"self debug: #testAt"
	| absent |
	absent := false.
	self moreThan4Elements 
		at: self moreThan4Elements size + 1
		ifAbsent: [ absent := true ].
	self assert: absent = true.
	absent := false.
	self moreThan4Elements 
		at: self moreThan4Elements size
		ifAbsent: [ absent := true ].
	self assert: absent = false! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 15:41'!
collectionNotIncluded
" return a collection for wich each element is not included in 'nonEmpty' "
	^ collectionNotIncluded 
		ifNil: [ collectionNotIncluded := (FloatArray new: 2) at:1 put: elementNotIn ; at: 2 put: elementNotIn  ; yourself ].! !

!FloatArrayTest methodsFor: 'test - equality' stamp: ''!
testEqualSignOfIdenticalCollectionObjects
	"self debug: #testEqualSignOfIdenticalCollectionObjects"
	
	self assert: (self empty = self empty). 
	self assert: (self nonEmpty = self nonEmpty). 
	! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSubcollectionAccessTest
	self moreThan3Elements.
	self assert: self moreThan3Elements size > 2! !

!FloatArrayTest methodsFor: 'tests - index access' stamp: ''!
testIndexOf
	"self debug: #testIndexOf"
	| tmp index collection |
	collection := self collectionMoreThan1NoDuplicates.
	tmp := collection size.
	collection reverseDo: 
		[ :each | 
		each = self elementInForIndexAccessing ifTrue: [ index := tmp ].
		tmp := tmp - 1 ].
	self assert: (collection indexOf: self elementInForIndexAccessing) = index! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 14:56'!
anotherElementOrAssociationNotIn
	" return an element (or an association for Dictionary )not present  in 'collection' "
	^ elementNotIn ! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 16:02'!
elementInForIndexAccessing
" return an element included in 'collectionMoreThan1NoDuplicates' "
	^ elementInNonEmpty .! !

!FloatArrayTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testLastIndexOfIfAbsentDuplicate
	"self debug: #testIndexOfIfAbsent"
	"self debug: #testLastIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection first.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'lastIndexOf: should return the position of the last occurrence :'"
	self assert: (collection 
			lastIndexOf: element
			ifAbsent: [ 55 ]) = collection size! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSequencedElementAccessTest
	self moreThan4Elements.
	self assert: self moreThan4Elements size >= 4.
	self subCollectionNotIn.
	self subCollectionNotIn detect: [ :each | (self moreThan4Elements includes: each) not ] ifNone: [ self assert: false ].
	self elementNotInForElementAccessing.
	self deny: (self moreThan4Elements includes: self elementNotInForElementAccessing).
	self elementInForElementAccessing.
	self assert: (self moreThan4Elements includes: self elementInForElementAccessing)! !

!FloatArrayTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionBasic
	"self debug: #testIntersectionBasic"
	| inter |
	inter := self collection intersection: (self collectionClass with: self anotherElementOrAssociationIn).
	self deny: inter isEmpty.
	self assert: (inter includes: self anotherElementOrAssociationIn value)! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 16:24'!
anotherValue
" return a value ( not eual to 'aValue' ) to put into nonEmpty "
	^ elementInNonEmpty ! !

!FloatArrayTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifference
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifference"
	
	| difference |
	self assert: (self collectionWithoutEqualElements difference: self collectionWithoutEqualElements) isEmpty.
	self assert: (self empty difference: self collectionWithoutEqualElements) isEmpty.
	difference := (self collectionWithoutEqualElements difference: self empty).
	self assert: difference size = self collectionWithoutEqualElements	 size.
	self collectionWithoutEqualElements do: [ :each |
		self assert: (difference includes: each)].
! !

!FloatArrayTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButFirst
	"self debug: #testAllButFirst"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButFirst.
	self deny: abf first = col first.
	self assert: abf size + 1 = col size! !

!FloatArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testAllButLastDo
	
	| result |
	result:= OrderedCollection  new.
	
	self nonEmptyMoreThan1Element  allButLastDo: [:each | result add: each].
	
	1 to: (result size) do:
		[:i|
		self assert: (self nonEmptyMoreThan1Element  at:(i ))=(result at:i)].
	
	self assert: result size=(self nonEmptyMoreThan1Element  size-1).! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyPartOfForMultipliness
	self collectionWithSameAtEndAndBegining.
	self assert: self collectionWithSameAtEndAndBegining first = self collectionWithSameAtEndAndBegining last.
	self assert: self collectionWithSameAtEndAndBegining size > 1.
	1 to: self collectionWithSameAtEndAndBegining size do: [ :i | 
		i > 1 & (i < self collectionWithSameAtEndAndBegining size)
			ifTrue: [ self deny: (self collectionWithSameAtEndAndBegining at: i) = self collectionWithSameAtEndAndBegining first ] ]! !

!FloatArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testPairsCollect
	
	| index result |
	index:=0.
	
	result:=self nonEmptyMoreThan1Element  pairsCollect: 
		[:each1 :each2 | 
		self assert: ( self nonEmptyMoreThan1Element indexOf: each2 ) = (index := index + 2).
		(self nonEmptyMoreThan1Element indexOf: each2) = ((self nonEmptyMoreThan1Element indexOf: each1) + 1).
		].
	
	result do: 
		[:each | self assert: each = true].
	
! !

!FloatArrayTest methodsFor: 'tests - copying same contents' stamp: ''!
testShallowCopyEmpty
	| result |
	result := self empty shallowCopy .
	self assert: result isEmpty .! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 16:36'!
subCollectionNotIn
" return a collection for which at least one element is not included in 'moreThan4Elements' "
	^ collectionNotIncluded 
		ifNil: [ collectionNotIncluded := (FloatArray new: 2) at:1 put: elementNotIn ; at: 2 put: elementNotIn  ; yourself ].! !

!FloatArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithIndexDo
	
	"| result |
	result:=Array new: self nonEmptyMoreThan1Element size.
	self nonEmptyMoreThan1Element  withIndexDo: [:each :i | result at:i put:(each+i)].
	
	1 to: result size do:[: i | self assert: (result at:i)= ((self nonEmptyMoreThan1Element at: i) + i)]"
	|  indexes elements |
	indexes:= OrderedCollection new.
	elements := OrderedCollection new.
	
	self nonEmptyMoreThan1Element  withIndexDo: 
		[:value :i  |
		indexes  add: (i).
		elements add: value].
	
	(1 to: self nonEmptyMoreThan1Element size )do:
		[ :i |
		self assert: (indexes at: i) = i.
		self assert: (elements at: i) = (self nonEmptyMoreThan1Element at: i).	
		].
	
	self assert: indexes size = elements size. 
	self assert: indexes size = self nonEmptyMoreThan1Element size . 
	! !

!FloatArrayTest methodsFor: 'tests - copying same contents' stamp: ''!
testReverse

	| result |
	result := self nonEmpty reversed.	
	"verify content of 'result: '"
	1 to: result size do:
		[:i | self assert: ((result at: i) 
			= (self nonEmpty at: (self nonEmpty size - i + 1)))].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!FloatArrayTest methodsFor: 'test - creation' stamp: ''!
testWithWithWithWith
	"self debug: #testWithWithWithWith"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom: 1 to: 4.
	aCol := self collectionClass with: (collection at:1) with: ( collection at:2 ) with: ( collection at: 3) with: ( collection at: 4).

	1 to: 3 do: [ :i | self assert: ( aCol occurrencesOf: ( collection at: i ) ) = ( collection occurrencesOf: ( collection at: i ) ) ].! !

!FloatArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testBeforeIfAbsent
	"self debug: #testBefore"
	self assert: (self moreThan4Elements 
			before: (self moreThan4Elements at: 1)
			ifAbsent: [ 99 ]) = 99.
	self assert: (self moreThan4Elements 
			before: (self moreThan4Elements at: 2)
			ifAbsent: [ 99 ]) = (self moreThan4Elements at: 1)! !

!FloatArrayTest methodsFor: 'tests - as identity set' stamp: ''!
testAsIdentitySetWithoutIdentityEqualsElements
	| result collection |
	collection := self collectionWithCopy.
	result := collection asIdentitySet.
	" no elements should have been removed as no elements are equels with Identity equality"
	self assert: result size = collection size.
	collection do: 
		[ :each | 
		(collection occurrencesOf: each) = (result asOrderedCollection occurrencesOf: each) ].
	self assert: result class = IdentitySet! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixturePutOneOrMoreElementsTest
	self aValue.

	
	self indexArray.
	self indexArray do: [
		:each| 
		self assert: each class = SmallInteger. 
		self assert: (each>=1 & each<= self nonEmpty size).
		].
	
	self assert: self indexArray size = self valueArray size.
	
	self empty.
	self assert: self empty isEmpty .
	
	self nonEmpty.
	self deny: self nonEmpty  isEmpty.! !

!FloatArrayTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpToEmpty
	| result |
	result := self empty copyUpTo: self collectionWithoutEqualElements first.
	self assert: result isEmpty.
	! !

!FloatArrayTest methodsFor: 'tests - set arithmetic' stamp: ''!
containsAll: union of: one andOf: another
			
	self assert: (one allSatisfy: [:each | union includes: each]).
	self assert: (another allSatisfy: [:each | union includes: each])! !

!FloatArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindLastNotIn

	| result |
	
	 result:=self empty findFirst: [:each | true].
	
	self assert: result=0. ! !

!FloatArrayTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsCommaStringOne
	
	"self assert: self oneItemCol asCommaString = '1'.
	self assert: self oneItemCol asCommaStringAnd = '1'."

	self assert: self nonEmpty1Element  asCommaString = (self nonEmpty1Element first asString).
	self assert: self nonEmpty1Element  asCommaStringAnd = (self nonEmpty1Element first asString).
	! !

!FloatArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFromToDo
	
	| result |
	result:= OrderedCollection  new.
	
	self nonEmptyMoreThan1Element  from: 1 to: (self nonEmptyMoreThan1Element  size -1) do: [:each | result add: each].
	
	1 to: (self nonEmptyMoreThan1Element  size -1) do:
		[:i|
		self assert: (self nonEmptyMoreThan1Element  at:i )=(result at:i)].
	self assert: result size=(self nonEmptyMoreThan1Element  size-1).! !

!FloatArrayTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopySameContentsTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 16:34'!
replacementCollectionSameSize
" return a collection of size (secondIndex - firstIndex + 1)"
	^replacementCollectionSameSize 
		ifNil: [ 	replacementCollectionSameSize := FloatArray new: (self secondIndex  - self firstIndex  + 1).
				 1 to: replacementCollectionSameSize size do:
					[ :i | replacementCollectionSameSize at:i put: elementInNonEmpty ].
				replacementCollectionSameSize.
				 ].! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 15:50'!
elementNotIn
"return an element not included in 'nonEmpty' "

	^ elementNotIn ! !

!FloatArrayTest methodsFor: 'running' stamp: 'delaunay 5/14/2009 16:40'!
setUp

empty := FloatArray new.
elementInNonEmpty := 7.0.
nonEmpty5ElementsNoDuplicate := (FloatArray new:5)  at: 1 put: 1.5 ; at: 2 put: 2.5 ; at: 3 put: elementInNonEmpty  ; at: 4 put: 4.5 ; at: 5 put: 5.5 ; yourself.
elementNotIn := 999.0.
elementTwiceIn := 2.3 .
collectionWithEqualElements := (FloatArray new: 3)  at: 1 put: 2.0 ; at: 2 put: 2.0 ; at: 3 put: 3.5 ; yourself.
nonEmpty1Element := ( FloatArray new: 1) at:1 put: 1.2 ; yourself.
collectionWithSameAtEndAndBegining := (FloatArray new: 3)  at: 1 put: 2.0 ; at: 2 put: 1.0 ; at: 3 put: 2.0 copy ; yourself.! !

!FloatArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testAt
	"self debug: #testAt"
	"
	self assert: (self accessCollection at: 1) = 1.
	self assert: (self accessCollection at: 2) = 2.
	"
	| index |
	index := self moreThan4Elements indexOf: self elementInForElementAccessing.
	self assert: (self moreThan4Elements at: index) = self elementInForElementAccessing! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 16:44'!
moreThan3Elements
	" return a collection including atLeast 3 elements"
	^ nonEmpty5ElementsNoDuplicate ! !

!FloatArrayTest methodsFor: 'requirements' stamp: ''!
elementInForReplacement
" return an element included in 'nonEmpty' "
^ self nonEmpty anyOne.! !

!FloatArrayTest methodsFor: 'tests - element accessing' stamp: ''!
testMiddle
	"self debug: #testMiddle"
	self assert: self moreThan4Elements middle = (self moreThan4Elements at: self moreThan4Elements size // 2 + 1)! !

!FloatArrayTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 16:11'!
nonEmptyMoreThan1Element
" return a collection that doesn't includes equal elements' and doesn't include nil elements'" 
	^nonEmpty5ElementsNoDuplicate ! !

!FloatArrayTest methodsFor: 'test - creation' stamp: ''!
testWithWithWithWithWith
	"self debug: #testWithWithWithWithWith"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom: 1 to: 5 .
	aCol := self collectionClass with: (collection at:1) with: ( collection at:2 ) with: ( collection at: 3) with: (collection at: 4 ) with: ( collection at: 5 ).

	1 to: 3 do: [ :i | self assert: ( aCol occurrencesOf: ( collection at: i ) ) = ( collection occurrencesOf: ( collection at: i ) ) ].! !

!FloatArrayTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testIndexOfIfAbsentDuplicate
	"self debug: #testIndexOfIfAbsent"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection last.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'indexOf:ifAbsent: should return the position of the first occurrence :'"
	self assert: (collection 
			indexOf: element
			ifAbsent: [ 55 ]) = 1! !

!FloatArrayTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterOne

	| delim oneItemStream result |
	"delim := ', '.
	oneItemStream := '' readWrite.
	self oneItemCol asStringOn: oneItemStream delimiter: delim.
	self assert: oneItemStream contents = '1'."
	
	delim := ', '.
	result:=''.
	oneItemStream := ReadWriteStream on: result.
	self nonEmpty1Element  asStringOn: oneItemStream delimiter: delim.
	oneItemStream do:[:each | self assert: each = (self nonEmpty1Element first asString)].
	

	! !

!FloatArrayTest methodsFor: 'tests - at put' stamp: ''!
testAtPutOutOfBounds
	"self debug: #testAtPutOutOfBounds"
	
	self should: [self empty at: self anIndex put: self aValue] raise: Error
	! !

!FloatArrayTest methodsFor: 'tests - index access' stamp: ''!
testLastIndexOfIfAbsent
	"self debug: #testIndexOfIfAbsent"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			lastIndexOf: element
			ifAbsent: [ 99 ]) = 1.
	self assert: (collection 
			lastIndexOf: self elementNotInForIndexAccessing
			ifAbsent: [ 99 ]) = 99! !

!FloatArrayTest methodsFor: 'tests - index access' stamp: ''!
testLastIndexOfStartingAt
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection last.
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size
			ifAbsent: [ 99 ]) = collection size.
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size - 1
			ifAbsent: [ 99 ]) = 99.
	self assert: (collection 
			lastIndexOf: self elementNotInForIndexAccessing
			startingAt: collection size
			ifAbsent: [ 99 ]) = 99! !

!FloatArrayTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithCollectError
	self should: [self nonEmptyMoreThan1Element with: self empty collect:[:a :b | ]] raise: Error.! !

!FloatArrayTest methodsFor: 'tests - copying with replacement' stamp: ''!
firstIndexesOf: aSubCollection in: collection
" return an OrderedCollection with the first indexes of the occurrences of subCollection in  collection "
	| tmp result currentIndex |
	tmp:= collection.
	result:= OrderedCollection new.
	currentIndex := 1.
	
	[tmp isEmpty ]whileFalse:
		[
		(tmp beginsWith: aSubCollection)
			ifTrue: [ 	
				result add: currentIndex.
				1 to: aSubCollection size do: 
					[:i | 
					tmp := tmp copyWithoutFirst.
					currentIndex := currentIndex + 1]
				]
			ifFalse: [
				tmp := tmp copyWithoutFirst.
				currentIndex := currentIndex +1.
				]
		 ].
	
	^ result.
	! !

!FloatPrintPolicy commentStamp: '<historical>'!
I am FloatPrintPolicy.
I am a DynamicVariable.

I control whether Float instances are printed exactly or inexactly. The inexact printing is much faster, but can be less accurate. 

The default policy is ExactFloatPrintPolicy.

FloatPrintPolicy 
	value: InexactFloatPrintPolicy new 
	during: [ Float pi printString ]!
!FloatPrintPolicy methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 2/8/2013 11:20'!
initialize
	default := ExactFloatPrintPolicy new! !

!FloatPrintPolicy methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/8/2013 11:20'!
default
	^ default! !

!FloatPrintPolicy class methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 2/8/2013 11:52'!
absPrint: float on: stream base: base
	"I delegate Float printing to the current dynamic value of myself"

	self value absPrint: float on: stream base: base! !

!FloatTest commentStamp: 'fbs 3/8/2004 22:13'!
I provide a test suite for Float values. Examine my tests to see how Floats should behave, and see how to use them.!
!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/13/2011 09:06'!
testRaisedTo
	"
	FloatTest new testRaisedTo
	"
	self should: [ -1.23 raisedTo: 1/4 ] raise: ArithmeticError! !

!FloatTest methodsFor: 'tests - printing' stamp: 'MarcusDenker 4/19/2013 15:01'!
testPrintPaddedWithTo
	"The problem was caused by treating the format specifier as a number rather than
	as a string, such the the number may be a Float subject to floating point rounding
	errors. The solution to treat the format specifier as a string, and extract the integer
	fields before and after the decimal point in the string."

	self assert: (1.0 printPaddedWith: $0 to: 2.2) = '01.00'.
	self assert: (1.0 printPaddedWith: $X to: 2.2) = 'X1.0X'.
	self assert: (1.0 printPaddedWith: $0 to: 2) = '01.0'.
	self assert: (12345.6789 printPaddedWith: $0 to: 2) = '12345.6789'.
	self assert: (12345.6789 printPaddedWith: $0 to: 2.2) = '12345.6789'.
	self assert: (12.34 printPaddedWith: $0 to: 2.2) = '12.34'.
	self assert: (12345.6789 printPaddedWith: $0 to: 2.2) = '12345.6789'.
	self assert: (123.456 printPaddedWith: $X to: 4.4) = 'X123.456X'.
	self assert: (1.0 printPaddedWith: $0 to: 2.1) = '01.0'.
	self assert: (1.0 printPaddedWith: $0 to: 2.2) = '01.00'.
	self assert: (1.0 printPaddedWith: $0 to: 2.3) = '01.000'. "previously failed due to float usage"
	self assert: (1.0 printPaddedWith: $0 to: 2.4) = '01.0000'. "previously failed due to float usage"
	self assert: (1.0 printPaddedWith: $0 to: 2.5) = '01.00000'

! !

!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'nice 10/31/2010 21:49'!
testDegreeCosForExceptionalValues
	self assert: Float nan degreeCos isNaN.
	self assert: Float infinity degreeCos isNaN.
	self assert: Float infinity negated degreeCos isNaN.! !

!FloatTest methodsFor: 'tests - conversion' stamp: 'StephaneDucasse 11/1/2010 08:09'!
testFloatPrinting
	"This test shows that floats are printed exactly. The idea is too make sure that users understand that "
	
	self assert: (0.1+0.2) printString = '0.30000000000000004'.
	self assert: (-0.1-0.2) printString =  '-0.30000000000000004'.
	self assert: 240 degreesToRadians cos =  -0.5000000000000004.
  	self assert: 240 degreesToRadians cos abs = 0.5000000000000004! !

!FloatTest methodsFor: 'tests - conversion' stamp: 'nice 6/3/2011 21:29'!
testFloor
	self assert: 1.0 floor = 1.
	self assert: 1.1 floor = 1.
	self assert: -2.0 floor = -2.
	self assert: -2.1 floor = -3.! !

!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'nice 5/16/2012 21:12'!
testFloorLog2
	"Float internal representation of Float being in base 2, we expect (aFloat floorLog: 2) to be exact."
	
	| aBitLess aBitMore |
	aBitMore := 1 + Float epsilon.
	aBitLess := 1 - Float epsilon.
	Float emin + 1 to: Float emax - 1 do: [:exp |
		| exactPowerOfTwo |
		exactPowerOfTwo := 1.0 timesTwoPower: exp.
		self assert: (exactPowerOfTwo floorLog: 2) equals: exp.
		self assert: (exactPowerOfTwo * aBitMore floorLog: 2) equals: exp.
		self assert: (exactPowerOfTwo * aBitLess floorLog: 2) equals: exp - 1].! !

!FloatTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:23'!
testHash
	self assert: 2 = 2.0 ==> (2 hash = 2.0 hash).
	self assert: 1 / 2 = 0.5 ==> ((1 / 2) hash = 0.5 hash).
	Float nan hash.
	Float infinity hash! !

!FloatTest methodsFor: 'tests - infinity behavior' stamp: 'nice 10/17/2007 23:54'!
testInfinityCloseTo
	"This is a test for bug http://bugs.squeak.org/view.php?id=6729:"
	
 	"FloatTest new testInfinityCloseTo"

	self deny: (Float infinity closeTo: Float infinity negated).
	self deny: (Float infinity negated closeTo: Float infinity).! !

!FloatTest methodsFor: 'tests - compare' stamp: 'StephaneDucasse 2/13/2010 11:18'!
testSetOfFloat
      "Classical disagreement between hash and = did lead to a bug.
       This is a non regression test from http://bugs.squeak.org/view.php?id=3360"
	"self debug: #testSetOfFloat"

       | size3 size4 |
       size3 := (Set new: 3) add: 3; add: 3.0; size.
       size4 := (Set new: 4) add: 3; add: 3.0; size.
       self assert: size3 = size4 description: 'The size of a Set should not depend on its capacity.'! !

!FloatTest methodsFor: 'tests - zero behavior' stamp: 'sd 6/5/2005 08:33'!
testZero1
	"FloatTest new testZero1"

	self assert: Float negativeZero = 0 asFloat.
	self assert: (Float negativeZero at: 1) ~= (0 asFloat at: 1).

	"The negative zero has a bit representation that is different from the bit representation of the positive zero. Nevertheless, both values are defined to be equal."
! !

!FloatTest methodsFor: 'tests - compare' stamp: 'nice 7/10/2009 22:27'!
testComparisonWhenPrimitiveFails
	"This is related to http://bugs.squeak.org/view.php?id=7361"

	self deny: 0.5 < (1/4).
	self deny: 0.5 < (1/2).
	self assert: 0.5 < (3/4).
	
	self deny: 0.5 <= (1/4).
	self assert: 0.5 <= (1/2).
	self assert: 0.5 <= (3/4).
	
	self assert: 0.5 > (1/4).
	self deny: 0.5 > (1/2).
	self deny: 0.5 > (3/4).
	
	self assert: 0.5 >= (1/4).
	self assert: 0.5 >= (1/2).
	self deny: 0.5 >= (3/4).
	
	self deny: 0.5 = (1/4).
	self assert: 0.5 = (1/2).
	self deny: 0.5 = (3/4).
	
	self assert: 0.5 ~= (1/4).
	self deny: 0.5 ~= (1/2).
	self assert: 0.5 ~= (3/4).! !

!FloatTest methodsFor: 'tests - IEEE 754' stamp: 'nice 12/26/2014 13:32'!
test32bitConversion
	"Except for NaN, we can convert a 32bits float to a 64bits float exactly.
	Thus we can convert the 64bits float to the original 32bits float pattern."
	
	#(16r0 "zero"
	 16r80000000 "negative zero"
	 16r1 "min unormalized"
	 16r12345 "a unnormalized"
	 16r801FEDCB "a negative unnormalized"
	 16r7FFFFF "largest unnormalized"
	 16r800000 "smallest normalized"
	 16r468ACDEF "a normalized float"
	 16rCABD1234 "a negative normalized float"
	 16r7F7FFFFF "largest finite float"
	 16r7F800000 "positive infinity"
	 16rFF800000 "negative infinity"
	)
	  do: [:originalWord | self assert: (Float fromIEEE32Bit: originalWord) asIEEE32BitWord = originalWord]! !

!FloatTest methodsFor: 'tests - conversion' stamp: 'nice 6/3/2011 21:28'!
testCeiling
	self assert: 1.0 ceiling = 1.
	self assert: 1.1 ceiling = 2.
	self assert: -2.0 ceiling = -2.
	self assert: -2.1 ceiling = -2.! !

!FloatTest methodsFor: 'tests - zero behavior' stamp: 'nice 3/23/2008 16:00'!
testZeroSignificandAsInteger
	"This is about http://bugs.squeak.org/view.php?id=6990"
	
	self assert: 0.0 significandAsInteger = 0! !

!FloatTest methodsFor: 'tests - IEEE 754' stamp: 'nice 5/30/2006 02:34'!
test32bitGradualUnderflow
	"method asIEEE32BitWord did not respect IEEE gradual underflow"
	
	| conv expected exponentPart |
	
	"IEEE 32 bits Float have 1 bit sign/8 bit exponent/23 bits of mantissa after leading 1
	2r1.mmmmmmmmmmmmmmmmmmmmmmm * (2 raisedTo: 2reeeeeeee-127) * sign
	except when 2reeeeeeee isZero, which is a gradual underflow:
	2r0.mmmmmmmmmmmmmmmmmmmmmmm * (2 raisedTo: 2r00000000-126) * sign
	and when 2reeeeeeee = 255, which is infinity if mantissa all zero or nan otherwise"
	
	"case 1: This example is the first gradual underflow case"
	conv := 2r0.11111111111111111111111e-126 asIEEE32BitWord.
	
	"expected float encoded as sign/exponent/mantissa (whithout leading 1 or 0)"
	exponentPart := 0.
	expected := exponentPart bitOr: 2r11111111111111111111111.
	self assert: expected = conv.
	
	"case 2: smallest number"
	conv := 2r0.00000000000000000000001e-126 asIEEE32BitWord.
	expected := exponentPart bitOr: 2r1.
	self assert: expected = conv.
	
	"case 3: round to nearest even also in underflow cases... here round to upper"
	conv := 2r0.000000000000000000000011e-126 asIEEE32BitWord.
	expected := exponentPart bitOr: 2r10.
	self assert: expected = conv.
	
	"case 4: round to nearest even also in underflow cases... here round to lower"
	conv := 2r0.000000000000000000000101e-126 asIEEE32BitWord.
	expected := exponentPart bitOr: 2r10.
	self assert: expected = conv.
	
	"case 5: round to nearest even also in underflow cases... here round to upper"
	conv := 2r0.0000000000000000000001011e-126 asIEEE32BitWord.
	expected := exponentPart bitOr: 2r11.
	self assert: expected = conv.
	! !

!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'nice 7/14/2011 13:30'!
testCopySignTo

      "Set up"
      | negatives negz positives strictNegatives strictPositives zero |
      strictPositives := {2. 2.5. Float infinity}.
      strictNegatives := {-3. -3.25. Float infinity negated}.
      zero := 0.0.
      negz := Float negativeZero.
      positives := strictPositives copyWith: zero.
      negatives := strictNegatives copyWith: negz.

      "Test the copy sign functions"
      positives do: [:aPositiveSign |
              positives do: [:aPositive |
                      self assert: (aPositiveSign copySignTo: aPositive) = aPositive].
              negatives do: [:aNegative |
                      self assert: (aPositiveSign copySignTo: aNegative) = aNegative negated].
              (aPositiveSign copySignTo: zero) sign = 0.
              (aPositiveSign copySignTo: negz) sign = 0].

      negatives do: [:aNegativeSign |
              positives do: [:aPositive |
                      self assert: (aNegativeSign copySignTo: aPositive) = aPositive negated].
              negatives do: [:aNegative |
                      self assert: (aNegativeSign copySignTo: aNegative) = aNegative].
              (aNegativeSign copySignTo: zero) sign = -1.
              (aNegativeSign copySignTo: negz) sign = -1].! !

!FloatTest methodsFor: 'tests - NaN behavior' stamp: 'sd 6/5/2005 08:31'!
testNaN1
   	"FloatTest new testNaN1"

	self assert: Float nan == Float nan.
	self deny: Float nan = Float nan.
	"a NaN is not equal to itself."
! !

!FloatTest methodsFor: 'tests - zero behavior' stamp: 'nice 8/21/2010 22:30'!
testNegativeZeroSign
	self assert: Float negativeZero sign = -1! !

!FloatTest methodsFor: 'tests - printing' stamp: 'SvenVanCaekenberghe 2/8/2013 15:54'!
testFloatPrintPolicy
	"It is hard to test printing Floats reliably, but this at least covers the code path"

	| pi |
	
	pi := FloatPrintPolicy value: InexactFloatPrintPolicy new during: [ Float pi printString ].
	self assert: (pi beginsWith: '3.14159').
	
	pi := FloatPrintPolicy value: ExactFloatPrintPolicy new during: [ Float pi printString ].
	self assert: (pi beginsWith: '3.14159').! !

!FloatTest methodsFor: 'tests - conversion' stamp: 'nice 4/26/2006 05:21'!
testFloatTruncated
	"(10 raisedTo: 16) asFloat has an exact representation (no round off error).
	It should convert back to integer without loosing bits.
	This is a no regression test on http://bugs.impara.de/view.php?id=3504"
	
	| x y int r |
	int := 10 raisedTo: 16.
	x := int asFloat.
	y := (5 raisedTo: 16) asFloat timesTwoPower: 16.
	self assert: x = y.
	
	self assert: x asInteger = int.
	
	"this one should be true for any float"
	self assert: x asInteger = x asTrueFraction asInteger.

	"a random test"
	r := Random new.
	10000 timesRepeat: [
		x := r next * 1.9999e16 + 1.0e12 .
		self assert: x truncated = x asTrueFraction truncated]! !

!FloatTest methodsFor: 'tests - NaN behavior' stamp: 'StephaneDucasse 5/28/2011 13:45'!
testNaN2
	"Two NaN values are always considered to be different.
	On an little-endian machine (32 bit Intel), Float nan is 16rFFF80000 16r00000000.
	On a big-endian machine (PowerPC), Float nan is 16r7FF80000 16r00000000. Changing
	the bit pattern of the first word of a NaN produces another value that is still
	considered equal to NaN. This test should work on both little endian and big
	endian machines. However, it is not guaranteed to work on future 64 bit versions
	of Squeak, for which Float may have different internal representations."

	"FloatTest new testNaN2"

	| nan1 nan2 |
	nan1 := Float nan copy.
	nan2 := Float nan copy.

	"test two instances of NaN with the same bit pattern"
	self deny: nan1 = nan2.
	self deny: nan1 == nan2.
	self deny: nan1 = nan1.
	self assert: nan1 == nan1.

	"change the bit pattern of nan1"
	self assert: nan1 size = 2.
	self assert: (nan1 at: 2) = 0.
	nan1 at: 1 put: (nan1 at: 1) + 999.
	self assert: nan1 isNaN.
	self assert: nan2 isNaN.
	self deny: (nan1 at: 1) = (nan2 at: 1).

	"test two instances of NaN with different bit patterns"
	self deny: nan1 = nan2.
	self deny: nan1 == nan2.
	self deny: nan1 = nan1.
	self assert: nan1 == nan1
! !

!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'Janniklaval 10/23/2010 13:39'!
testSign

      "Set up"
      | negatives negz positives strictNegatives strictPositives zero |
      strictPositives := {2. 2.5. Float infinity}.
      strictNegatives := {-3. -3.25. Float infinity negated}.
      zero := 0.0.
      negz := Float negativeZero.
      positives := strictPositives copyWith: zero.
      negatives := strictNegatives copyWith: negz.

      "The sign of non zeros"
      strictPositives do: [:aPositive | self assert: aPositive sign = 1].
      strictNegatives do: [:aNegative | self assert: aNegative sign = -1].

      "The sign of zeros"
      self assert: zero sign = 0.
      self assert: negz sign = -1. "remark though that negz >= 0.0, and is thus considered positive... Weird"

      "Test the copy sign functions"
      positives do: [:aPositiveSign |
              positives do: [:aPositive |
                      self assert: (aPositive sign: aPositiveSign) = aPositive].
              negatives do: [:aNegative |
                      self assert: (aNegative sign: aPositiveSign) = aNegative negated].
              (zero sign: aPositiveSign) sign = 0.
              (negz sign: aPositiveSign) sign = 0].

      negatives do: [:aNegativeSign |
              positives do: [:aPositive |
                      self assert: (aPositive sign: aNegativeSign) = aPositive negated].
              negatives do: [:aNegative |
                      self assert: (aNegative sign: aNegativeSign) = aNegative].
              (zero sign: aNegativeSign) sign = -1.
              (negz sign: aNegativeSign) sign = -1].! !

!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'CamilloBruni 8/31/2013 20:23'!
testDegreeSin
	45.0 degreeSin.	"Following tests use approximate equality, because sine are generally evaluated using inexact Floating point arithmetic"
	self assert: (45.0 degreeSin squared - 0.5) abs <= Float epsilon.
	self assert: (30.0 degreeSin - 0.5) abs <= Float epsilon.
	self assert: (-30.0 degreeSin + 0.5) abs <= Float epsilon.
	-360.0 to: 360.0 do: [ :i | self assert: (i degreeSin closeTo: i degreesToRadians sin) ].	"Following tests use strict equality which is a requested property of degreeSin"
	-10.0 to: 10.0 do: [ :k | 
		self assert: (k * 360 + 90) degreeSin - 1 = 0.
		self assert: (k * 360 - 90) degreeSin + 1 = 0.
		self assert: (k * 360 + 180) degreeSin = 0.
		self assert: (k * 360) degreeSin = 0 ]! !

!FloatTest methodsFor: 'tests - conversion' stamp: 'nice 6/3/2011 21:37'!
testRounded
	self assert: 0.9 rounded = 1.
	self assert: 1.0 rounded = 1.
	self assert: 1.1 rounded = 1.
	self assert: -1.9 rounded = -2.
	self assert: -2.0 rounded = -2.
	self assert: -2.1 rounded = -2.
	
	"In case of tie, round to upper magnitude"
	self assert: 1.5 rounded = 2.
	self assert: -1.5 rounded = -2.! !

!FloatTest methodsFor: 'tests - compare' stamp: 'KrisGybels 10/26/2014 11:47'!
testLiteralEqual

	self deny: (0.0 literalEqual: 0.0 negated).
	self deny: (-0.0 literalEqual: -0.0 negated).
	self deny: (0.0 literalEqual: -0.0).
! !

!FloatTest methodsFor: 'tests - conversion' stamp: 'nice 5/6/2006 22:13'!
testIntegerAsFloat
	"assert IEEE 754 round to nearest even mode is honoured"
	
	self deny: 16r1FFFFFFFFFFFF0801 asFloat = 16r1FFFFFFFFFFFF0800 asFloat. "this test is on 65 bits"
	self deny: 16r1FFFFFFFFFFFF0802 asFloat = 16r1FFFFFFFFFFFF0800 asFloat. "this test is on 64 bits"
	self assert: 16r1FFFFFFFFFFF1F800 asFloat = 16r1FFFFFFFFFFF20000 asFloat. "nearest even is upper"
	self assert: 16r1FFFFFFFFFFFF0800 asFloat = 16r1FFFFFFFFFFFF0000 asFloat. "nearest even is lower"
! !

!FloatTest methodsFor: 'tests - rounding' stamp: 'GuillermoPolito 6/22/2012 14:44'!
testRounding
        "
        self debug: #testRounding
        "

        self assert: (10.1234 round: 2) = 10.12.
        self assert: (10.1234 round: 0) = 10! !

!FloatTest methodsFor: 'tests - conversion' stamp: 'nice 6/3/2011 21:34'!
testTruncated
	self assert: 1.0 truncated = 1.
	self assert: 1.1 truncated = 1.
	self assert: -2.0 truncated = -2.
	self assert: -2.1 truncated = -2.! !

!FloatTest methodsFor: 'tests - infinity behavior' stamp: 'nice 7/14/2009 09:32'!
testHugeIntegerCloseTo
	"This is a test for bug http://bugs.squeak.org/view.php?id=7368"
	
 	"FloatTest new testHugeIntegerCloseTo"

	self deny: (1.0 closeTo: 200 factorial).
	self deny: (200 factorial closeTo: 1.0).
	self assert: (Float infinity closeTo: 200 factorial) = (200 factorial closeTo: Float infinity).! !

!FloatTest methodsFor: 'tests' stamp: 'nice 10/4/2009 23:13'!
testCopy
	"Elementary tests"
	self assert: 2.0 copy = 2.0.
	self assert: -0.5 copy = -0.5.
	
	"Are exceptional Floats preserved by the copy ?"
	self assert: Float nan copy isNaN.
	self assert: Float infinity copy = Float infinity.
	self assert: Float infinity negated copy = Float infinity negated.
	
	"Is the sign of zero preserved by the copy ?"
	self assert: 0.0 copy hex = 0.0 hex.
	self assert: Float negativeZero copy hex = Float negativeZero hex.! !

!FloatTest methodsFor: 'tests - NaN behavior' stamp: 'MarcusDenker 4/10/2015 10:36'!
testNaNCompare
	"IEEE 754 states that NaN cannot be ordered.
	As a consequence, every arithmetic comparison involving a NaN SHOULD return false.
	Except the is different test (~=).
	This test does verify this rule"
	
	| compareSelectors theNaN anotherNaN comparand brokenMethods warningMessage |
	self skip.
	compareSelectors := #(#< #<= #> #>= #=).
	theNaN := Float nan.
	anotherNaN := Float infinity - Float infinity.
	comparand := {1. 2.3. Float infinity. 2/3. 1.25s2. 2 raisedTo: 50}.
	comparand := comparand , (comparand collect: [:e | e negated]).
	comparand := comparand , {theNaN. anotherNaN}.

"do a first pass to collect all broken methods"
	brokenMethods := Set new.
	comparand do: [:comp |
		compareSelectors do: [:op |
			(theNaN perform: op with: comp) ifTrue: [brokenMethods add: (theNaN class lookupSelector: op)].
			(comp perform: op with: theNaN) ifTrue: [brokenMethods add: (comp class lookupSelector: op)]].
		(theNaN ~= comp) ifFalse: [brokenMethods add: (theNaN class lookupSelector: #~=)].
		(comp ~= theNaN) ifFalse: [brokenMethods add: (comp class lookupSelector: #~=)]].
	
"build a warning message to tell about all broken methods at once"
	warningMessage := String streamContents: [:s |
			s nextPutAll: 'According to IEEE 754 comparing with a NaN should always return false, except ~= that should return true.'; cr.
			s nextPutAll: 'All these methods failed to do so. They are either broken or call a broken one'.
			brokenMethods do: [:e | s cr; print: e methodClass; nextPutAll: '>>'; print: e selector]].
		
"Redo the tests so as to eventually open a debugger on one of the failures"
	brokenMethods := Set new.
	comparand do: [:comp2 |
		compareSelectors do: [:op2 |
			self deny: (theNaN perform: op2 with: comp2) description: warningMessage.
			self deny: (comp2 perform: op2 with: theNaN) description: warningMessage].
		self assert: (theNaN ~= comp2) description: warningMessage.
		self assert: (comp2 ~= theNaN) description: warningMessage].! !

!FloatTest methodsFor: 'tests - IEEE 754' stamp: 'nice 5/30/2006 00:07'!
test32bitRoundingMode
	"method asIEEE32BitWord did not respect IEEE default rounding mode"
	
	| conv expected exponentPart |
	
	"IEEE 32 bits Float have 1 bit sign/8 bit exponent/23 bits of mantissa after leading 1
	2r1.mmmmmmmmmmmmmmmmmmmmmmm * (2 raisedTo: 2reeeeeeee-127) * sign
	except when 2reeeeeeee isZero, which is a gradual underflow:
	2r0.mmmmmmmmmmmmmmmmmmmmmmm * (2 raisedTo: 2r00000000-127) * sign
	and when 2reeeeeeee = 255, which is infinity if mantissa all zero or nan otherwise"
	
	"This example has two extra bits in mantissa for testing rounding mode
	case 1: should obviously round to upper"
	conv := 2r1.0000000000000000000000111e25 asIEEE32BitWord.
	
	"expected float encoded as sign/exponent/mantissa (whithout leading 1)"
	exponentPart := 25+127 bitShift: 23. "127 is 2r01111111 or 16r7F"
	expected := exponentPart bitOr: 2r10.
	self assert: expected = conv.
	
	"case 2: exactly in the mid point of two 32 bit float: round toward nearest even (to upper)"
	conv := 2r1.0000000000000000000000110e25 asIEEE32BitWord.
	expected := exponentPart bitOr: 2r10.
	self assert: expected = conv.
	
	"case 3: exactly in the mid point of two 32 bit float: round toward nearest even (to lower)"
	conv := 2r1.0000000000000000000000010e25 asIEEE32BitWord.
	expected := exponentPart bitOr: 2r0.
	self assert: expected = conv.
	
	"case 4: obviously round to upper"
	conv := 2r1.0000000000000000000000011e25 asIEEE32BitWord.
	expected := exponentPart bitOr: 2r1.
	self assert: expected = conv.
! !

!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'CamilloBruni 8/31/2013 20:23'!
testDegreeCos
	45.0 degreeCos.	"Following tests use approximate equality, because cosine are generally evaluated using inexact Floating point arithmetic"
	self assert: (45.0 degreeCos squared - 0.5) abs <= Float epsilon.
	self assert: (60.0 degreeCos - 0.5) abs <= Float epsilon.
	self assert: (120.0 degreeCos + 0.5) abs <= Float epsilon.
	-360.0 to: 360.0 do: [ :i | self assert: (i degreeCos closeTo: i degreesToRadians cos) ].	"Following tests use strict equality which is a requested property of degreeCos"
	-10.0 to: 10.0 do: [ :k | 
		self assert: (k * 360 + 90) degreeCos = 0.
		self assert: (k * 360 - 90) degreeCos = 0.
		self assert: (k * 360 + 180) degreeCos + 1 = 0.
		self assert: (k * 360) degreeCos - 1 = 0 ]! !

!FloatTest methodsFor: 'tests - characterization' stamp: 'nice 6/11/2009 20:47'!
testCharacterization

	"Test the largest finite representable floating point value"
	self assert: Float fmax successor = Float infinity.
	self assert: Float infinity predecessor = Float fmax.
	self assert: Float fmax negated predecessor = Float infinity negated.
	self assert: Float infinity negated successor = Float fmax negated.
	
	"Test the smallest positive representable floating point value"
	self assert: Float fmin predecessor = 0.0.
	self assert: 0.0 successor = Float fmin.
	self assert: Float fmin negated successor = 0.0.
	self assert: 0.0 predecessor = Float fmin negated.
	
	"Test the relative precision"
	self assert: Float one + Float epsilon > Float one.
	self assert: Float one + Float epsilon = Float one successor.
	self assert: Float one + (Float epsilon / Float radix) = Float one.
	
	"Test maximum and minimum exponent"
	self assert: Float fmax exponent = Float emax.
	self assert: Float fminNormalized exponent = Float emin.
	Float denormalized ifTrue: [
		self assert: Float fminDenormalized exponent = (Float emin + 1 - Float precision)].
	
	"Alternative tests for maximum and minimum"
	self assert: (Float radix - Float epsilon) * (Float radix raisedTo: Float emax) = Float fmax.
	self assert: Float epsilon * (Float radix raisedTo: Float emin) = Float fmin.
	
	"Test sucessors and predecessors"
	self assert: Float one predecessor successor = Float one.
	self assert: Float one successor predecessor = Float one.
	self assert: Float one negated predecessor successor = Float one negated.
	self assert: Float one negated successor predecessor = Float one negated.
	self assert: Float infinity successor = Float infinity.
	self assert: Float infinity negated predecessor = Float infinity negated.
	self assert: Float nan predecessor isNaN.
	self assert: Float nan successor isNaN.
	
	"SPECIFIC FOR IEEE 754 double precision - 64 bits"
	self assert: Float fmax hex = '7FEFFFFFFFFFFFFF'.
	self assert: Float fminDenormalized hex = '0000000000000001'.
	self assert: Float fminNormalized hex = '0010000000000000'.
	self assert: 0.0 hex = '0000000000000000'.
	self assert: Float negativeZero hex = '8000000000000000'.
	self assert: Float one hex = '3FF0000000000000'.
	self assert: Float infinity hex = '7FF0000000000000'.
	self assert: Float infinity negated hex = 'FFF0000000000000'.! !

!FloatTest methodsFor: 'tests - characterization' stamp: 'jmv 10/11/2011 08:55'!
testMaxExactInteger
	"
	FloatTest new testMaxExactInteger
	"

	self assert: Float maxExactInteger asFloat truncated = Float maxExactInteger.
	0 to: 10000 do: [ :j |
		self assert: (Float maxExactInteger-j) asFloat truncated = (Float maxExactInteger-j) ].
	self deny: (Float maxExactInteger+1) asFloat truncated = (Float maxExactInteger+1)
	! !

!FloatTest methodsFor: 'tests - arithmetic' stamp: 'st 9/20/2004 17:04'!
testContinuedFractions
	self assert: (Float pi asApproximateFractionAtOrder: 1) = (22/7).
	self assert: (Float pi asApproximateFractionAtOrder: 3) = (355/113)! !

!FloatTest methodsFor: 'tests - conversion' stamp: 'nice 3/14/2008 23:59'!
testReadFromManyDigits
	"A naive algorithm may interpret these representations as Infinity or NaN.
	This is http://bugs.squeak.org/view.php?id=6982"
	
	| s1 s2 |
	s1 := '1' , (String new: 321 withAll: $0) , '.0e-321'.
	s2 := '0.' , (String new: 320 withAll: $0) , '1e321'.
	self assert: (Number readFrom: s1) = 1.
	self assert: (Number readFrom: s2) = 1.! !

!FloatTest methodsFor: 'tests - NaN behavior' stamp: 'sd 6/5/2005 08:32'!
testNaN4
   	"FloatTest new testNaN4"

	| dict |
	dict := Dictionary new.
	dict at: Float nan put: #NaN.
	self deny: (dict includes: Float nan).
	"as a NaN is not equal to itself, it can not be retrieved when it is used as a dictionary key"
! !

!FloatTest methodsFor: 'tests - compare' stamp: 'nice 7/19/2009 19:24'!
testCloseTo
	self deny: (Float nan closeTo: Float nan) description: 'NaN isn''t close to anything'.
	self deny: (Float nan closeTo: 1.0) description: 'NaN isn''t close to anything'.
	self deny: (1.0 closeTo: Float nan) description: 'NaN isn''t close to anything'.
	
	self deny: (-1.0 closeTo: 1.0).
	self deny: (1.0 closeTo: Float infinity).
	self assert: (Float infinity closeTo: Float infinity) description: 'since they are =, they also are closeTo:'.
	
	self assert: (1.0/3.0 closeTo: 1/3).
	self assert: (1.0e-8 closeTo: 0).
	self assert: (0 closeTo: 1.0e-8).
	self assert: (1+1.0e-8 closeTo: 1.0).
	
	self assert: (1000000001.0 closeTo: 1000000000.0).
	self deny: (1000000001 closeTo: 1000000000) description: 'exact representation are considered closeTo: only if equal'.! !

!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'nice 10/31/2010 21:49'!
testDegreeSinForExceptionalValues
	self assert: Float nan degreeSin isNaN.
	self assert: Float infinity degreeSin isNaN.
	self assert: Float infinity negated degreeSin isNaN.! !

!FloatTest methodsFor: 'tests - IEEE 754' stamp: 'al 6/22/2008 11:52'!
testNaN5
	self assert: ((Float nan asIEEE32BitWord printPaddedWith: $0 to: 32 base: 2)
		copyFrom: 2 to: 9) = '11111111'.
	self assert: (Float fromIEEE32Bit:
		(Integer readFrom: '01111111110000000000000000000000' readStream base: 2)) isNaN! !

!FloatTest methodsFor: 'tests' stamp: 'nice 7/15/2011 14:53'!
testFractionAsFloatWithUnderflow
	"test rounding to nearest even"

	| underflowPower |
	underflowPower := Float emin - Float precision.
	self assert: (2 raisedTo: underflowPower) asFloat = 0.0.	
	self assert: (2 raisedTo: underflowPower) negated asFloat = 0.0.
	self assert: (2 raisedTo: underflowPower) negated asFloat sign = -1 description: 'a negative underflow should return a negative zero'.! !

!FloatTest methodsFor: 'tests - arithmetic' stamp: 'nice 10/14/2011 21:43'!
testZeroRaisedToNegativePower
	"this is a test related to http://bugs.squeak.org/view.php?id=6781"
	
	self should: [0.0 raisedTo: -1] raise: ZeroDivide.
	self should: [0.0 raisedTo: -1.0] raise: ZeroDivide.! !

!FloatTest methodsFor: 'tests - zero behavior' stamp: 'md 4/16/2003 15:02'!
testIsZero
	self assert: 0.0 isZero.
	self deny:  0.1 isZero.! !

!FloatTest methodsFor: 'tests - printing' stamp: 'KrisGybels 10/26/2014 11:10'!
testBinaryLiteralString

	self assert: 0.0 binaryLiteralString = '0.0'.
	self assert: 0.0 negated binaryLiteralString = '-0.0'.
	self assert: Float infinity binaryLiteralString = 'Float infinity'.
	self assert: Float infinity negated binaryLiteralString = 'Float infinity negated'.
	self assert: Float nan binaryLiteralString = 'Float nan'.

	self assert: Float fminDenormalized binaryLiteralString = '2r0.0000000000000000000000000000000000000000000000000001e-1022'.
	self assert: Float fminNormalized binaryLiteralString = '2r1.0000000000000000000000000000000000000000000000000000e-1022'.
	self assert: (Float fminNormalized - Float fminDenormalized) binaryLiteralString = '2r0.1111111111111111111111111111111111111111111111111111e-1022'.
	self assert: Float epsilon binaryLiteralString = '2r1.0000000000000000000000000000000000000000000000000000e-52'.
	self assert: Float fmax binaryLiteralString = '2r1.1111111111111111111111111111111111111111111111111111e1023'.

	self assert: Float fminDenormalized negated binaryLiteralString = '-2r0.0000000000000000000000000000000000000000000000000001e-1022'.
	self assert: Float fminNormalized negated binaryLiteralString = '-2r1.0000000000000000000000000000000000000000000000000000e-1022'.

	self assert: 1.0 binaryLiteralString = '2r1.0000000000000000000000000000000000000000000000000000e0'.
	self assert: (1.0 + Float epsilon) binaryLiteralString = '2r1.0000000000000000000000000000000000000000000000000001e0'.
	self assert: (1.0 - (Float epsilon / 2)) binaryLiteralString = '2r1.1111111111111111111111111111111111111111111111111111e-1'.
	self assert: 2.0 binaryLiteralString = '2r1.0000000000000000000000000000000000000000000000000000e1'.
	
	self assert: 0.1 binaryLiteralString = '2r1.1001100110011001100110011001100110011001100110011010e-4'.
	self assert: 0.2 binaryLiteralString = '2r1.1001100110011001100110011001100110011001100110011010e-3'.
	self assert: 0.3 binaryLiteralString = '2r1.0011001100110011001100110011001100110011001100110011e-2'.
	self assert: (0.1 + 0.2) binaryLiteralString = '2r1.0011001100110011001100110011001100110011001100110100e-2'.
	self assert: 0.5 binaryLiteralString = '2r1.0000000000000000000000000000000000000000000000000000e-1'.
	
	self assert: 2r0.0000000000000000000000000000000000000000000000000001e-1022 binaryLiteralString = '2r0.0000000000000000000000000000000000000000000000000001e-1022'.
	self assert: 2r0.0101010101010101010101010101010101010101010101010101e-1022 binaryLiteralString = '2r0.0101010101010101010101010101010101010101010101010101e-1022'.
	self assert: 2r0.1010101010101010101010101010101010101010101010101010e-1022 binaryLiteralString = '2r0.1010101010101010101010101010101010101010101010101010e-1022'.
	self assert: 2r0.1111111111111111111111111111111111111111111111111111e-1022 binaryLiteralString = '2r0.1111111111111111111111111111111111111111111111111111e-1022'.
	self assert: 2r1.0101010101010101010101010101010101010101010101010101e-3 binaryLiteralString = '2r1.0101010101010101010101010101010101010101010101010101e-3'.
	self assert: 2r1.1010101010101010101010101010101010101010101010101010e3 binaryLiteralString = '2r1.1010101010101010101010101010101010101010101010101010e3'.
	self assert: 2r1.1111111111111111111111111111111111111111111111111111e1023 binaryLiteralString = '2r1.1111111111111111111111111111111111111111111111111111e1023'.

	self assert: -2r0.0000000000000000000000000000000000000000000000000001e-1022 binaryLiteralString = '-2r0.0000000000000000000000000000000000000000000000000001e-1022'.
	self assert: -2r1.0000000000000000000000000000000000000000000000000000e-1022 binaryLiteralString = '-2r1.0000000000000000000000000000000000000000000000000000e-1022'.
	self assert: -2r1.1111111111111111111111111111111111111111111111111111e1023 binaryLiteralString = '-2r1.1111111111111111111111111111111111111111111111111111e1023'.

	self assert: (Float fromIEEE64Bit: 2r0111111111110000000000000000000000000000000000000000000000000001) binaryLiteralString = 'Float nan'.
	self assert: (Float fromIEEE64Bit: 2r0111111111111111111111111111111111111111111111111111111111111111) binaryLiteralString = 'Float nan'.
	self assert: (Float fromIEEE64Bit: 2r1111111111110000000000000000000000000000000000000000000000000001) binaryLiteralString = 'Float nan'.
	self assert: (Float fromIEEE64Bit: 2r1111111111111111111111111111111111111111111111111111111111111111) binaryLiteralString = 'Float nan'.
! !

!FloatTest methodsFor: 'tests - arithmetic' stamp: 'GabrielOmarCotelli 6/6/2009 17:14'!
testDivide

	self assert: 1.5 / 2.0 = 0.75.
	
	self assert: 2.0 / 1 = 2.0.
	
	self should: [ 2.0 / 0 ] raise: ZeroDivide.
	self should: [ 2.0 / 0.0 ] raise: ZeroDivide.
	self should: [ 1.2 / Float negativeZero ] raise: ZeroDivide.
	self should: [ 1.2 / (1.3 - 1.3) ] raise: ZeroDivide
	! !

!FloatTest methodsFor: 'tests - conversion' stamp: 'dtl 9/18/2004 12:40'!
testStringAsNumber
	"This covers parsing in Number>>readFrom:"

	| aFloat |
	aFloat := '10r-12.3456' asNumber.
	self assert: -12.3456 = aFloat.
	aFloat := '10r-12.3456e2' asNumber.
	self assert: -1234.56 = aFloat.
	aFloat := '10r-12.3456d2' asNumber.
	self assert: -1234.56 = aFloat.
	aFloat := '10r-12.3456q2' asNumber.
	self assert: -1234.56 = aFloat.
	aFloat := '-12.3456q2' asNumber.
	self assert: -1234.56 = aFloat.
	aFloat := '12.3456q2' asNumber.
	self assert: 1234.56 = aFloat.
! !

!FloatTest methodsFor: 'tests - compare' stamp: 'nice 5/30/2008 01:23'!
testComparison
	
	"test equality when Float conversion loose bits"
	| a b c |
	a := 16r1FFFFFFFFFFFFF1.
	b := 16r1FFFFFFFFFFFFF3.
	c := a asFloat.
	self assert: ((a = c) & (b = c)) ==> (a = b).
	
	"Test equality when Float conversion exact"
	self assert: 16r1FFFFFFFFFFFFF = 16r1FFFFFFFFFFFFF asFloat.
	self assert: 16r1FFFFFFFFFFFFF = 16r1FFFFFFFFFFFFF asFloat asInteger.
	
	"Test inequality when Float conversion loose bits"
	self assert: (((1 bitShift: 54)+1)/(1 bitShift: 54)) > 1.
	self assert: (((1 bitShift: 54)+1)/(1 bitShift: 54)) > 1.0.
	
	self assert: (((1 bitShift: 54)-1)/(1 bitShift: 54)) < 1.
	self assert: (((1 bitShift: 54)-1)/(1 bitShift: 54)) < 1.0.
	
	"Test exact vs inexact arithmetic"
	(1 to: 100) do: [:i |
		i isPowerOfTwo
			ifTrue: [self assert: (1/i) = (1/i) asFloat]
			ifFalse: [self deny: (1/i) = (1/i) asFloat]].
	
	"Test overflow (compare to infinity)"
	a := (11 raisedTo: 400) / 2.
	b := (13 raisedTo: 400) / 2.
	c := a asFloat.
	self assert: ((a = c) & (b = c)) ==> (a = b).
	
	"every integer is smaller than infinity"
	self assert: a < Float infinity.
	self assert: a > Float infinity negated.
	
	"Test underflow"
	self deny: 1 / (11 raisedTo: 400) = 0.
	self deny: 1 / (11 raisedTo: 400) = 0.0.
	
	"Test hash code"
	self assert:
		((Set new: 3) add: 3; add: 3.0; size) =
		((Set new: 4) add: 3; add: 3.0; size).! !

!FloatTest methodsFor: 'tests - infinity behavior' stamp: 'sd 6/5/2005 08:30'!
testInfinity1
   "FloatTest new testInfinity1"

	| i1  i2 |

	i1 := 10000 exp.
	i2 := 1000000000 exp.
	self assert: i1 isInfinite & i2 isInfinite & (i1 = i2).
	"All infinities are equal. (This is a very substantial difference to NaN's, which are never equal."
! !

!FloatTest methodsFor: 'tests - infinity behavior' stamp: 'sd 6/5/2005 08:30'!
testInfinity2
   "FloatTest new testInfinity2"

	| i1  i2 |
	i1 := 10000 exp.
	i2 := 1000000000 exp.
	i2 := 0 - i2. " this is entirely ok. You can compute with infinite values."

	self assert: i1 isInfinite & i2 isInfinite & i1 positive & i2 negative.
	self deny: i1 = i2.
  	"All infinities are signed. Negative infinity is not equal to Infinity"
! !

!FloatTest methodsFor: 'tests - conversion' stamp: 'nice 7/24/2008 02:04'!
testFloatRounded
	"5000000000000001 asFloat has an exact representation (no round off error).
	It should round to nearest integer without loosing bits.
	This is a no regression test on http://bugs.squeak.org/view.php?id=7134"
	
	| x y int r |
	
	"This is a preamble asserting exactness of representation
	and quality of various conversions"
	int := 5000000000000001.
	x := int asFloat.
	y := (5 asFloat squared squared squared squared timesTwoPower: 15) + 1.
	self assert: x = y.
	self assert: x asTrueFraction = int.
	
	"this one should be true for any float
	in order to conform to ISO/IEC 10967-2"
	self assert: x rounded = x asTrueFraction rounded.
	self assert: x negated rounded = x negated asTrueFraction rounded.

	"a random test"
	r := Random new.
	10000 timesRepeat: [
		x := r next * 1.9999e16 + 1.0e12 .
		self assert: x rounded = x asTrueFraction rounded.
		self assert: x negated rounded = x negated asTrueFraction rounded]! !

!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'nice 10/30/2009 22:23'!
testArcTan

	self assert: ((100 arcTan: 100) closeTo: Float pi / 4).
	self assert: ((-100 arcTan: 100) closeTo: Float pi / -4).
	self assert: ((100 arcTan: -100) closeTo: Float pi * 3 / 4).
	self assert: ((-100 arcTan: -100) closeTo: Float pi * -3 / 4).
	self assert: ((0 arcTan: 100) closeTo: 0).
	self assert: ((0 arcTan: -100) closeTo: Float pi).
	self assert: ((100 arcTan: 0) closeTo: Float pi / 2).
	self assert: ((-100 arcTan: 0) closeTo: Float pi / -2).
	
	self assert: ((Float negativeZero arcTan: 100) closeTo: 0).
	self assert: ((Float negativeZero arcTan: -100) closeTo: Float pi * -1).
	
	self assert: (0 arcTan: 0) = 0.
	self assert: (Float negativeZero arcTan: 0) = 0.
	self assert: ((0 arcTan: Float negativeZero) closeTo: Float pi).
	self assert: ((Float negativeZero arcTan: Float negativeZero) closeTo: Float pi negated). ! !

!FloatTest methodsFor: 'tests - NaN behavior' stamp: 'nice 3/14/2008 23:42'!
testNaNisLiteral
	self deny: Float nan isLiteral description: 'there is no literal representation of NaN'! !

!FloatTest methodsFor: 'tests - conversion' stamp: 'nice 5/7/2006 16:22'!
testFractionAsFloat
	"use a random test"
	
	| r m frac err collec |
	r := Random new seed: 1234567.
	m := (2 raisedTo: 54) - 1.
	200 timesRepeat: [
		frac := ((r nextInt: m) * (r nextInt: m) + 1) / ((r nextInt: m) * (r nextInt: m) + 1).
		err := (frac - frac asFloat asTrueFraction) * frac reciprocal * (1 bitShift: 52).
		self assert: err < (1/2)].
	
	collec := #(16r10000000000000 16r1FFFFFFFFFFFFF 1 2 16r20000000000000 16r20000000000001 16r3FFFFFFFFFFFFF 16r3FFFFFFFFFFFFE 16r3FFFFFFFFFFFFD).
	collec do: [:num |
		collec do: [:den |
			frac := Fraction numerator: num denominator: den.
			err := (frac - frac asFloat asTrueFraction) * frac reciprocal * (1 bitShift: 52).
			self assert: err <= (1/2)]].! !

!FloatTest methodsFor: 'tests - NaN behavior' stamp: 'GabrielOmarCotelli 5/23/2009 20:38'!
testReciprocal

	self 
		assert: 1.0 reciprocal = 1.0;
		assert: 2.0 reciprocal = 0.5;
		assert: -1.0 reciprocal = -1.0;
		assert: -2.0 reciprocal = -0.5.
		
	self should: [ 0.0 reciprocal ] raise: ZeroDivide! !

!FloatTest methodsFor: 'tests - printing' stamp: 'nice 10/11/2008 21:45'!
testStoreBase16
	"This bug was reported in mantis http://bugs.squeak.org/view.php?id=6695"

	self
		assert: (20.0 storeStringBase: 16) = '16r14.0'
		description: 'the radix prefix should not be omitted, except in base 10'! !

!FloatTest methodsFor: 'tests - zero behavior' stamp: 'nice 8/21/2010 22:29'!
testNegativeZeroAbs
	self assert: Float negativeZero abs sign positive description: 'the absolute value of a negative zero is zero'! !

!FloatTest methodsFor: 'tests - NaN behavior' stamp: 'sd 6/5/2005 08:32'!
testNaN3
   "FloatTest new testNaN3"

   	| set item identitySet |
	set := Set new.
	set add: (item := Float nan).
	self deny: (set includes: item).
	identitySet := IdentitySet new.
	identitySet add: (item := Float nan).
	self assert: (identitySet includes: item).
	"as a NaN is not equal to itself, it can not be retrieved from a set"
! !

!FloatTest methodsFor: 'tests - conversion' stamp: 'nice 1/10/2007 02:29'!
testFractionAsFloat2
	"test rounding to nearest even"
		
	self assert: ((1<<52)+0+(1/4)) asFloat asTrueFraction = ((1<<52)+0).
	self assert: ((1<<52)+0+(1/2)) asFloat asTrueFraction = ((1<<52)+0).
	self assert: ((1<<52)+0+(3/4)) asFloat asTrueFraction = ((1<<52)+1).
	self assert: ((1<<52)+1+(1/4)) asFloat asTrueFraction = ((1<<52)+1).
	self assert: ((1<<52)+1+(1/2)) asFloat asTrueFraction = ((1<<52)+2).
	self assert: ((1<<52)+1+(3/4)) asFloat asTrueFraction = ((1<<52)+2).! !

!FloatTest methodsFor: 'tests' stamp: 'MarcusDenker 5/2/2013 11:27'!
testStoreOn
	"If storeOn: prints exactly and the parser avoid cumulating round off Errors,
	then Float should be read back exactly.
	Note: there is no guarantee to restore the bit pattern of NaN though"
	
	self assert: (self class compiler evaluate: Float halfPi storeString) = Float halfPi.
	self assert: (self class compiler evaluate: Float halfPi negated storeString) = Float halfPi negated.
	self assert: (self class compiler evaluate: Float infinity storeString) = Float infinity.
	self assert: (self class compiler evaluate: Float infinity negated storeString) = Float infinity negated.
	self assert: (self class compiler evaluate: Float nan storeString) isNaN.! !

!FloatingPointException commentStamp: 'SvenVanCaekenberghe 4/21/2011 12:39'!
I am FloatingPointException, an ArithmeticError indicating a problem in a floating point calculation.

Precision underflow or overflow could be considered FloatingPointExceptions.

ZeroDivide, DomainError and NaNException are examples of more specific ArithmeticErrors that can be signaled before an operation is actually attempted.!
!FontChooser commentStamp: 'StephaneDucasse 1/1/2010 18:00'!
I'm an object holding information to choose a font from a list of fonts.!
!FontChooser methodsFor: 'accessing' stamp: 'NicolaiHess 1/25/2014 00:19'!
pointSizeList

	pointSizeList ifNotNil: [ ^ pointSizeList ].
	^ pointSizeList := (1 to: 256) collect: [ :each | each asString padLeftTo: 3 ].! !

!FontChooser methodsFor: 'selected' stamp: 'HenrikSperreJohansen 9/5/2013 16:19'!
selectedFontIndex
	| font textStyleName family |
	
	selectedFontIndex ifNotNil: [^selectedFontIndex].
	selectedFontIndex := 0.
	font := (getSelector isSymbol and:[target notNil])
		ifTrue:[target perform: getSelector]
		ifFalse:[getSelector].
	self setStyleValuesFrom: font.
	(font isKindOf: AbstractFont)
		ifTrue:[
			pointSize := font pointSize.
			textStyleName := font textStyleName.
			family := self fontList detect:[:f | f familyName = textStyleName] ifNone:[].
			selectedFontIndex := self fontList indexOf: family ifAbsent:[0]].
	self selectedFontIndex: selectedFontIndex.
	^selectedFontIndex! !

!FontChooser methodsFor: 'action' stamp: 'StephaneDucasse 11/11/2013 17:41'!
refreshFontList
	
	^fontList := LogicalFontManager current allFamilies! !

!FontChooser methodsFor: 'accessing' stamp: 'SeanDeNigris 1/23/2014 15:23'!
fontStyleListStrings
	"names of simulated styles are enclosed in parenthesis"

	^ self fontStyleList collect: [:fontFamilyMember | | styleName |
		styleName := fontFamilyMember styleName.
		fontFamilyMember simulated
			ifTrue: ['(', styleName, ')']
			ifFalse: [styleName]].! !

!FontChooser methodsFor: 'action' stamp: 'NicolaiHess 12/13/2014 01:29'!
updateFontList
	FreeTypeFontProvider current updateFromSystem.
	self refreshFontList.
	self changed:#fontListStrings.! !

!FontChooser methodsFor: 'selected' stamp: 'StephaneDucasse 11/11/2013 18:29'!
setPointSizeListFrom: aFontFamilyMember
	| style old new |
	old := pointSizeList.
	(aFontFamilyMember isKindOf: FontFamilyMemberAbstract)
		ifTrue:[
			style := TextStyle named: aFontFamilyMember family familyName.
			style ifNotNil:[
				new := style pointSizes collect: [:each | 
					each reduce asString padLeftTo: 3]]].
	new ifNil: [ new := (1 to: 256) collect: [:each | 
				each asString padLeftTo: 3 ]].
	
	pointSizeList := new.
	old ~= new ifTrue: [ self announcer announce: #pointSizeListChanged]! !

!FontChooser methodsFor: 'accessing' stamp: 'SeanDeNigris 1/23/2014 15:24'!
getSelector: aSelectorSymbolOrFont

	getSelector := aSelectorSymbolOrFont! !

!FontChooser methodsFor: 'initialization' stamp: 'tween 8/4/2007 10:27'!
initialize
	super initialize.
	title := 'Choose A Font'.! !

!FontChooser methodsFor: 'accessing' stamp: 'SeanDeNigris 1/23/2014 15:24'!
pointSize: aNumber

	pointSize := aNumber.
	self announcer announce: #pointSizeChanged.! !

!FontChooser methodsFor: 'selected' stamp: 'HenrikSperreJohansen 9/5/2013 16:34'!
selectedPointSizeIndex

	^self pointSizeList indexOf: (pointSize reduce asString padLeftTo: 3)! !

!FontChooser methodsFor: 'accessing' stamp: 'SeanDeNigris 1/23/2014 15:26'!
title: aString

	title := aString! !

!FontChooser methodsFor: 'selected' stamp: 'StephaneDucasse 11/11/2013 17:32'!
selectedFontStyleIndex: anIndex
	| familyMember |
	anIndex = 0
		ifTrue: [^self].
	selectedFontStyleIndex := anIndex.
	familyMember := self fontStyleList at: anIndex.
	self setStyleValuesFrom: familyMember.
	self announcer announce:  #selectedFontStyleIndex.! !

!FontChooser methodsFor: 'selected' stamp: 'SeanDeNigris 1/23/2014 15:12'!
selectedPointSizeIndex: anIndex

	anIndex = 0 ifTrue: [^self].
	pointSize := (self pointSizeList at: anIndex) trimBoth asNumber.
	self announcer announce: #pointSizeChanged.
	! !

!FontChooser methodsFor: 'selected' stamp: 'tween 8/19/2007 16:23'!
selectedFontStyleIndex
	| family member |
	selectedFontStyleIndex ifNotNil: [
		^selectedFontStyleIndex := selectedFontStyleIndex min: self fontStyleList size].
	family := self fontList at: selectedFontIndex ifAbsent:[^0].
	member := family closestMemberWithStretchValue: stretchValue weightValue: weightValue slantValue: slantValue.
	selectedFontStyleIndex := self fontStyleList indexOf: member.
	^selectedFontStyleIndex! !

!FontChooser methodsFor: 'selected' stamp: 'tween 8/18/2007 11:18'!
selectedFont
	| font style |

	font := self unemphasizedSelectedFont.
	font ifNil:[^nil].
	style := self fontStyleList at: self selectedFontStyleIndex ifAbsent:[nil].
	style ifNil:[^nil].
	(style isKindOf: TextStyleAsFontFamilyMember)
		ifTrue:[	^font emphasized: style emphasisCode].		
	^LogicalFont 
		familyName: font familyName 
		pointSize: pointSize 
		stretchValue: style stretchValue
		weightValue: style weightValue
		slantValue: style slantValue

	! !

!FontChooser methodsFor: 'accessing' stamp: 'SeanDeNigris 1/23/2014 15:26'!
target: anObject

	target := anObject! !

!FontChooser methodsFor: 'selected' stamp: 'tween 8/27/2007 23:12'!
selectedPointSize
	^self selectedFont pointSize! !

!FontChooser methodsFor: 'accessing' stamp: 'SeanDeNigris 1/23/2014 15:13'!
fontList
	
	^ fontList ifNil: [ self refreshFontList ].! !

!FontChooser methodsFor: 'accessing' stamp: 'StephaneDucasse 11/11/2013 17:06'!
announcer

	^ announcer ifNil: [ announcer := Announcer new ]! !

!FontChooser methodsFor: 'action' stamp: 'SeanDeNigris 1/23/2014 15:16'!
apply

	(target isNil or: [ setSelector isNil ]) ifTrue: [ ^ self ].			
	self selectedFont ifNotNil: [ :font | target perform: setSelector with: font ].! !

!FontChooser methodsFor: 'selected' stamp: 'StephaneDucasse 11/11/2013 17:27'!
selectedFontFamily

	^ self fontList at: self selectedFontIndex ifAbsent: [nil].
	
	! !

!FontChooser methodsFor: 'accessing' stamp: 'SeanDeNigris 1/23/2014 15:24'!
getSelector

	^ getSelector! !

!FontChooser methodsFor: 'accessing' stamp: 'SeanDeNigris 1/23/2014 15:18'!
fontListStrings

	| isUpdateRequired |
	isUpdateRequired := fontListStrings isNil or: [fontList size ~= fontListStrings size].
	isUpdateRequired ifTrue: [
		fontListStrings := self fontList collect: [:each | each familyName]].
	^ fontListStrings! !

!FontChooser methodsFor: 'selected' stamp: 'SeanDeNigris 1/23/2014 15:13'!
selectedFontIndex: anIndex

	| family member newStyleIndex |
	anIndex = 0 ifTrue: [^self].
	selectedFontIndex := anIndex.
	"change the selected style to be the closest to the last
	user selected weight slant and stretch values. 
	By user selected I mean that the user changed the style list selection, 
	rather than a change being forced because a particular family didn't have that style"
	family := self fontList at: selectedFontIndex.
	member := family closestMemberWithStretchValue: stretchValue weightValue: weightValue slantValue: slantValue.
	newStyleIndex := self fontStyleList indexOf: member.
	selectedFontStyleIndex := newStyleIndex. 
	self setPointSizeListFrom: member.
	self announcer announce: #selectedFontStyleIndex.
	self announcer announce: #selectedFontIndex.
	! !

!FontChooser methodsFor: 'accessing' stamp: 'tween 8/4/2007 10:27'!
windowTitle
	^ title translated! !

!FontChooser methodsFor: 'accessing' stamp: 'SeanDeNigris 1/23/2014 15:19'!
fontStyleList

	^ self selectedFontFamily
		ifNil: [ #() ]
		ifNotNil: [ :family | fontStyleList := family members asSortedCollection ].! !

!FontChooser methodsFor: 'action' stamp: 'tween 8/18/2007 21:10'!
unemphasizedSelectedFont
	|name font family |
	family := self fontList at: self selectedFontIndex ifAbsent:[nil].
	family ifNil:[^nil].
	(family isKindOf: TextStyleAsFontFamily)
		ifTrue:[^family textStyle fontOfPointSize: pointSize].
	name :=  family familyName.
	font := LogicalFont 
		familyName: name
		pointSize: pointSize 
		stretchValue: 5
		weightValue: 400
		slantValue: 0.
	font realFont isTTCFont "true for FreeTypeFont"
		ifFalse: [font := font textStyle fontOfPointSize: pointSize].
	^font
! !

!FontChooser methodsFor: 'accessing' stamp: 'SeanDeNigris 1/23/2014 15:25'!
setSelector: selector

	setSelector := selector! !

!FontChooser methodsFor: 'accessing' stamp: 'SeanDeNigris 1/23/2014 15:24'!
pointSize

	^ pointSize ifNil: [pointSize := 10.0]! !

!FontChooser methodsFor: 'accessing' stamp: 'SeanDeNigris 1/23/2014 15:26'!
target

	^ target! !

!FontChooser methodsFor: 'action' stamp: 'tween 8/18/2007 13:49'!
setStyleValuesFrom: aFont
	((aFont isKindOf: LogicalFont) or:[aFont isKindOf: FontFamilyMemberAbstract])
		ifTrue:[
			weightValue := aFont weightValue.
			slantValue := aFont slantValue.
			stretchValue := aFont stretchValue]
		ifFalse:[
			weightValue := (aFont emphasis bitAnd: 1) > 0 ifTrue:[700] ifFalse:[400].
			slantValue := (aFont emphasis bitAnd: 2) > 0 ifTrue:[1] ifFalse:[0].
			stretchValue := 5 "normal"]! !

!FontChooser class methodsFor: 'open' stamp: 'MarcusDenker 11/13/2012 15:10'!
openWithWindowTitle: titleString for: anObject setSelector: setSelector getSelector: getSelector
	"FontChooser openWithWindowTitle: 'Choose the Menu Font' for: StandardFonts setSelector: #menuFont: getSelector: #menuFont"
	
	| instance windowMorph world |
	instance := self new.
	instance 
		title: titleString;
		target: anObject;
		setSelector: setSelector;
		getSelector: getSelector.
	world := self currentWorld.
	(windowMorph := FontChooserMorph withModel: instance)
		"position: self currentWorld primaryHand position;"
		position: ((World width-640)/2)@((World height-480)/2);
		extent: 640@480;
		open.
	^windowMorph
 ! !

!FontChooser class methodsFor: 'instance creation' stamp: 'StephaneDucasse 1/1/2010 18:00'!
windowTitle: titleString for: anObject setSelector: setSelector getSelector: getSelector
	
	| instance answer |
	instance := self new.
	instance 
		title: titleString;
		target: anObject;
		setSelector: setSelector;
		getSelector: getSelector.
	(answer := FontChooserMorph withModel: instance)
		position: self currentWorld primaryHand position;
		extent: 450@220;
		createWindow.
	^answer! !

!FontChooserMorph commentStamp: '<historical>'!
I'm the UI of a font chooser. 

FontChooser 
	openWithWindowTitle: 'Choose the Menu Font' 
	for: StandardFonts 
	setSelector: #menuFont: 
	getSelector: #menuFont
	
!
!FontChooserMorph methodsFor: 'interface building' stamp: 'SeanDeNigris 1/23/2014 16:16'!
newLanguageList

	| widget |
	widget := PluggableListMorph
		on: self 
		list: #languages
		selected: #languageIndex
		changeSelected: #languageIndex:.
	^ widget	
			color: Color white;
			borderInset;
			vResizing: #spaceFill;
			hResizing: #spaceFill;
			yourself.! !

!FontChooserMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 11/11/2013 17:27'!
languageIndex

	| item |
	item := self pangrams detect: [ :one | one value = selectedPangram ] ifNone: nil.
	^self pangrams indexOf: item.! !

!FontChooserMorph methodsFor: 'actions' stamp: 'SeanDeNigris 1/23/2014 16:34'!
updatePointSize

	pointSizeList ifNotNil: [ pointSizeList selectionIndex: model selectedPointSizeIndex ].
	"this should not be like that but managed by the list!!!!!!!!"
	
	self updatePreview! !

!FontChooserMorph methodsFor: 'actions' stamp: 'SeanDeNigris 1/23/2014 16:34'!
updateStyleList

	styleList ifNotNil: [ styleList selectionIndex: model selectedFontStyleIndex ].
	"this should not be like that but managed by the list!!!!!!!!"
	
	self updatePreview! !

!FontChooserMorph methodsFor: 'interface building' stamp: 'SeanDeNigris 1/23/2014 15:32'!
languages
	
	^ self pangrams collect: #key! !

!FontChooserMorph methodsFor: 'initialize-release' stamp: 'StephaneDucasse 1/21/2014 21:20'!
initializeWithModel: aFontChooser
	self 
		model: aFontChooser;
		clipSubmorphs: true;
		setLabel: self model windowTitle;
		name: 'FontChooser'.
	self model announcer when: #pointSizeListChanged send: #updatePointSizeList to: self.
	self model announcer when: #selectedFontIndex send: #updateFontIndex to: self.
	self model announcer when: #pointSizeChanged send: #updatePointSize to: self.
	self model announcer when: #selectedFontStyleIndex send: #updateStyleList to: self.
	self updatePreview! !

!FontChooserMorph methodsFor: 'actions' stamp: 'SeanDeNigris 1/23/2014 16:33'!
updateFontList

	model updateFontList.
	self announcer announce: #fontsUpdated.! !

!FontChooserMorph methodsFor: 'accessing' stamp: 'SeanDeNigris 1/23/2014 16:18'!
pointSizeString

	^ model pointSize asString.! !

!FontChooserMorph methodsFor: 'accessing' stamp: 'SeanDeNigris 1/23/2014 16:31'!
result
	^ result! !

!FontChooserMorph methodsFor: 'interface building' stamp: 'SeanDeNigris 1/23/2014 15:42'!
newFontSizePanel

	pointSizeMorph := self newFontPointSizeField.
	^ Morph new
		borderWidth: 1;
		borderColor: Color black;
		hResizing: #spaceFill;
		vResizing: #shrinkwrap;
		color: Color transparent;
		layoutPolicy: TableLayout new;
		cellInset: 0;
		listCentering: #topLeft;
		listDirection: #leftToRight;
		cellPositioning: #leftCenter;
		clipSubmorphs: true;
		addMorphBack: self newFontPointSizeLabel;
		addMorphBack: pointSizeMorph.
		! !

!FontChooserMorph methodsFor: 'interface building' stamp: 'SeanDeNigris 1/23/2014 15:12'!
newFontPointSizeField 
	
	^ (PluggableTextMorph on: self text: #pointSizeString accept: #pointSizeString:)
		acceptOnCR: true;
		hideVScrollBarIndefinitely: true;
		color: Color gray veryMuchLighter;
		borderColor: #inset;
		vResizing: #rigid;
		hResizing: #spaceFill;
		width: (TextStyle defaultFont widthOfString: '99999999.99');
		height: TextStyle defaultFont height + 6;
		yourself.
	! !

!FontChooserMorph methodsFor: 'actions' stamp: 'SeanDeNigris 1/23/2014 16:25'!
pointSizeString: aText
	
	| string number |
	string := aText asString trimBoth.
	string isEmpty ifTrue: [^self].
	string
		detect: [:c | c isDigit not and: [c ~= $.]]
		ifFound: [^self].
	[number := string asNumber asFloat] on: Error do: [:e | ^self].
	(number < 1 or: [number > 1024])
		ifTrue: [^self].

	pointSizeMorph ifNotNil: [pointSizeMorph hasUnacceptedEdits: false].
	model pointSize: number! !

!FontChooserMorph methodsFor: 'accessing' stamp: 'SeanDeNigris 1/24/2014 22:27'!
previewText
	"Answer the preview text based on current font."
	
	| sample i maxLineLength endOfLineCharacters |
	model selectedFont isNil ifTrue: [ ^'' ].
	sample := String new writeStream.
	model selectedFont isSymbolFont ifFalse: [ 
		| pangram |
		pangram := self selectedPangram.
		sample 
			nextPutAll: pangram; cr;
			nextPutAll: pangram asUppercase;
			cr ].
	i := 0.
	maxLineLength := 30.
	endOfLineCharacters := '@Z`z'.
	33 to: 255 do: [ :asciiValue | | character |
		character := Character value: asciiValue.
		sample nextPut: character.
		i := i + 1.
		((endOfLineCharacters includes: character) or: [ i = maxLineLength ]) 
			ifTrue: [ 
				i := 0.
				sample cr ] ].
	^ sample contents.! !

!FontChooserMorph methodsFor: 'actions' stamp: 'SeanDeNigris 1/23/2014 16:34'!
updatePreview

	 self fontPreviewPanel scrollTarget: self newFontPreviewInnerPanel! !

!FontChooserMorph methodsFor: 'ui elements' stamp: 'SeanDeNigris 1/23/2014 16:17'!
okButton

	okButton ifNotNil: [ ^ okButton ].
	okButton := self
			newButtonFor: self
			action: #okButtonClicked
			label: 'OK' translated
			help: 'Click here to close this dialog, and accept your selection' translated.
		^ okButton
			hResizing: #spaceFill;
			yourself.! !

!FontChooserMorph methodsFor: 'initialize-release' stamp: 'StephaneDucasse 11/11/2013 16:32'!
initializeLabelArea
	"Customize the window bar by removing all the decorations"
	
	super initializeLabelArea.
	self
		removeCollapseBox;
		removeExpandBox;
		removeMenuBox! !

!FontChooserMorph methodsFor: 'ui elements' stamp: 'SeanDeNigris 1/23/2014 16:32'!
updateButton

	updateButton ifNotNil: [ ^ updateButton ].
	updateButton := self
		newButtonFor: self
		action: #updateButtonClicked
		label: 'Update' translated
		help: 'Click here to rescan Font Folder and update the font list' translated.
	^ updateButton
		hResizing: #spaceFill;
		yourself.! !

!FontChooserMorph methodsFor: 'interface building' stamp: 'SeanDeNigris 1/23/2014 15:41'!
newFontPreviewInnerPanel
	"Answer a morph for the preview text."
	
	| textMorph |
	textMorph := self newText: self previewText.
	textMorph margins: 4.
	^ self model selectedFont
		ifNil: [ textMorph ]
		ifNotNil: [ :f | textMorph beAllFont: f ]! !

!FontChooserMorph methodsFor: 'interface building' stamp: 'SeanDeNigris 1/24/2014 22:29'!
newFontStyleList 

	| widget minWidth requiredWidth |
	widget := PluggableListMorph
		on: self model
		list: #fontStyleListStrings
		selected: #selectedFontStyleIndex
		changeSelected: #selectedFontStyleIndex:.
		
	minWidth := widget font widthOfStringOrText: 'Condensed Extra Bold Oblique' "long, but not the longest".
	requiredWidth := self
		widthRequiredFor: [ :each | widget font widthOfStringOrText: each styleName ]
		from: model fontStyleList
		noLessThan: minWidth.

	^ widget	
			color: Color white;
			borderInset;
			vResizing: #spaceFill;
			hResizing: #spaceFill;
			width: requiredWidth + widget scrollBarThickness + (widget font widthOfStringOrText: '  ');
			yourself.! !

!FontChooserMorph methodsFor: 'interface building' stamp: 'SeanDeNigris 1/23/2014 15:41'!
newFontPointSizeLabel 

	^ StringMorph
		contents: 'Point size:' translated;
		yourself.! !

!FontChooserMorph methodsFor: 'actions' stamp: 'tween 8/4/2007 20:28'!
apply
	result := model selectedFont.
	model apply! !

!FontChooserMorph methodsFor: 'interface building' stamp: 'SeanDeNigris 1/24/2014 22:36'!
newFontList 

	| widget requiredWidth |
	widget := PluggableListMorph
		on: self model
		list: #fontListStrings
		selected: #selectedFontIndex
		changeSelected: #selectedFontIndex:.

	requiredWidth := self
		widthRequiredFor: [ :each | widget font widthOfStringOrText: each familyName ]
		from: model fontList
		noLessThan: 20.

	widget	
		color: Color white;
		borderInset;
		vResizing: #spaceFill;
		hResizing: #spaceFill;
		width: requiredWidth + widget scrollBarThickness + (widget font widthOfStringOrText: '  ').
		
	self model announcer when: #fontsUpdated send: #verifyContents to: widget.
	
	^ widget.! !

!FontChooserMorph methodsFor: 'actions' stamp: 'SeanDeNigris 1/23/2014 16:33'!
updateButtonClicked

	self updateFontList.! !

!FontChooserMorph methodsFor: 'private' stamp: 'SeanDeNigris 1/24/2014 22:28'!
widthRequiredFor: aBlock from: aCollection noLessThan: anInteger
	"aBlock - takes each item as an argument, and returns the width it needs"

	^ aCollection inject: anInteger into: [ :max :each | | itemWidth |
		itemWidth := aBlock value: each.
		max max: itemWidth ].! !

!FontChooserMorph methodsFor: 'ui elements' stamp: 'StephaneDucasse 11/11/2013 18:19'!
applyButton
	^applyButton ifNil: [
		applyButton := (self
			newButtonFor: self
			action: #applyButtonClicked
			label: 'Apply' translated
			help: 'Click here to apply your selection without closing this dialog' translated)
			hResizing: #spaceFill ]! !

!FontChooserMorph methodsFor: 'interface building' stamp: 'SeanDeNigris 1/23/2014 15:32'!
createWindow
	"Create the package loader window."
	
	| buttonBar buttonBarOffset previewFrame buttonBarFrame |	
	buttonBar := self newRow: {
		self applyButton.
		self okButton.
		self cancelButton.
		self updateButton }.
	buttonBar cellInset: 8@0.
	buttonBarOffset := buttonBar minExtent y negated - (2 * ProportionalSplitterMorph splitterWidth).
	
	fontList := self newFontList borderWidth: 0.
	self 
		addMorph: fontList
		frame: (0.0 @ 0.0 corner: 0.4 @ 0.4).

	styleList := self newFontStyleList
		borderWidth: 0;
		yourself.
	self 
		addMorph: styleList
		frame: (0.4 @ 0.0 corner: 0.6 @ 0.4).

	pointSizeList := self newPointSizeList
		borderWidth: 0;
		yourself.
	self 
		addMorph: pointSizeList
		frame: (0.6 @ 0.0 corner: 0.75 @ 0.4).
		
	languageList := self newLanguageList
		borderWidth: 0;
		yourself.
	self 
		addMorph: languageList
		frame: (0.75 @ 0.0 corner: 1.0 @ 0.4).
	self languageIndex: 1.	
	
	previewFrame := (0 @ 0.4 corner: 1 @1) asLayoutFrame
		bottomOffset: buttonBarOffset
		yourself.
	self 
		addMorph: self fontPreviewPanel
		fullFrame: previewFrame. 

	buttonBarFrame := (0 @1 corner: 1@1) asLayoutFrame
		topOffset: buttonBarOffset;
		yourself.
	self 
		addMorph: buttonBar
		fullFrame: buttonBarFrame.! !

!FontChooserMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 11/11/2013 17:39'!
selectedPangram
	^ selectedPangram ifNil: [ self pangrams first value ]! !

!FontChooserMorph methodsFor: 'ui elements' stamp: 'StephaneDucasse 11/11/2013 18:19'!
fontPreviewPanel 

	^fontPreviewPanel ifNil:
		[ fontPreviewPanel := self newScrollPaneFor: self newFontPreviewInnerPanel ]! !

!FontChooserMorph methodsFor: 'actions' stamp: 'tween 8/4/2007 20:25'!
delete
	model := nil.
	super delete
	! !

!FontChooserMorph methodsFor: 'interface building' stamp: 'SeanDeNigris 1/23/2014 16:16'!
newPointSizeList 

	| widget |
	widget := PluggableListMorph
		on: self model
		list: #pointSizeList
		selected: #selectedPointSizeIndex
		changeSelected: #selectedPointSizeIndex:.
	^ widget	
			color: Color white;
			borderInset;
			vResizing: #spaceFill;
			hResizing: #spaceFill;
			yourself.! !

!FontChooserMorph methodsFor: 'ui elements' stamp: 'StephaneDucasse 11/11/2013 18:19'!
cancelButton
	^cancelButton ifNil: [
		cancelButton := (self
			newButtonFor: self
			action: #cancelButtonClicked
			label: 'Cancel' translated
			help: 'Click here to cancel and close this dialog' translated)
			hResizing: #spaceFill ]! !

!FontChooserMorph methodsFor: 'actions' stamp: 'tween 8/4/2007 20:27'!
cancelButtonClicked
	result :=nil.
	self delete
	! !

!FontChooserMorph methodsFor: 'actions' stamp: 'tween 8/4/2007 13:49'!
applyButtonClicked
	self apply.
	! !

!FontChooserMorph methodsFor: 'interface building' stamp: 'HenrikSperreJohansen 9/5/2013 16:05'!
pangrams
	^ OrderedCollection new
		add: 'English' -> 'the quick brown fox jumps over the lazy dog';
		add: 'Bulgarian' -> 'Под южно дърво, цъфтящо в синьо, бягаше малко пухкаво зайче.';
		add: 'Czech' -> 'Příliš žluťoučký kůň úpěl ďábelské ódy.';
		add: 'Chinese' -> '視野無限廣，窗外有藍天
    微風迎客，軟語伴茶';
		add: 'Danish' -> 'Quizdeltagerne spiste jordbær med fløde, mens cirkusklovnen Walther spillede på xylofon.';
		add: 'Dutch' -> 'Pa''s wijze lynx bezag vroom het fikse aquaduct';
		add: 'Esperanto' -> 'Eĥoŝanĝo ĉiuĵaŭde';
		add: 'Estonian' -> 'See väike mölder jõuab rongile hüpata';
		add: 'Finnish' -> 'Viekas kettu punaturkki laiskan koiran takaa kurkki';
		add: 'French' -> 'Voix ambiguë d''un cœur qui au zéphyr préfère les jattes de kiwis';
		add: 'German' -> 'Zwölf Boxkämpfer jagen Viktor quer über den großen Sylter Deich';
		add: 'Greek' -> 'Θέλει αρετή και τόλμη η ελευθερία. (Ανδρέας Κάλβος)';
		add: 'Hebrew' -> 'דג סקרן שט לו בים זך אך לפתע פגש חבורה נחמדה שצצה כך';
		add: 'Hungarian' -> 'Egy hűtlen vejét fülöncsípő, dühös mexikói úr Wesselényinél mázol Quitóban';
		add: 'Italian' -> 'Ma la volpe, col suo balzo, ha raggiunto il quieto Fido.';
		add: 'Japanese' -> 'いろはにほへと ちりぬるを わかよたれそ つねならむ うゐのおくやま けふこえて あさきゆめみし ゑひもせす';
		add: 'Korean' -> '다람쥐 헌 쳇바퀴에 타고파';
		add: 'Latvian' -> 'Sarkanās jūrascūciņas peld pa jūru.';
		add: 'Norwegian' -> 'En god stil må først og fremst være klar. Den må være passende. Aristoteles.';
		add: 'Portugese' -> 'A rápida raposa castanha salta por cima do cão lento.';
		add: 'Brazilian portugese' -> 'A ligeira raposa marrom ataca o cão preguiçoso';
		add: 'Polish' -> 'Pchnąć w tę łódź jeża lub ośm skrzyń fig';
		add: 'Romanian' -> 'Agera vulpe maronie sare peste câinele cel leneş';
		add: 'Russian' -> 'Съешь ещё этих мягких французских булок да выпей же чаю';
		add: 'Serbian (cyrillic)' -> 'Чешће цeђење мрeжастим џаком побољшава фертилизацију генских хибрида.';
		add: 'Serbian (latin)' -> 'Češće ceđenje mrežastim džakom poboljšava fertilizaciju genskih hibrida.';
		add: 'Slovak' -> 'Kŕdeľ šťastných ďatľov učí pri ústí Váhu mĺkveho koňa obhrýzať kôru a žrať čerstvé mäso.';
		add: 'Slovene' -> 'V kožuščku hudobnega fanta stopiclja mizar in kliče 0619872345.';
		add:
				'Spanish'
						->
							'El veloz murciélago hindú comía feliz cardillo y kiwi. La cigüeña tocaba el saxofón detrás del palenque de paja.';
		add: 'Swedish' -> 'Flygande bäckasiner söka hwila på mjuka tuvor';
		add:
				'Thai'
						->
							'เป็นมนุษย์สุดประเสริฐเลิศคุณค่า
    กว่าบรรดาฝูงสัตว์เดรัจฉาน
    จงฝ่าฟันพัฒนาวิชาการ อย่าล้างผลาญฤๅเข่นฆ่าบีฑาใคร
    ไม่ถือโทษโกรธแช่งซัดฮึดฮัดด่า
    หัดอภัยเหมือนกีฬาอัชฌาสัย
    ปฏิบัติประพฤติกฎกำหนดใจ
    พูดจาให้จ๊ะ ๆ จ๋า ๆ น่าฟังเอยฯ';
		add: 'Turkish' -> 'Pijamalı hasta, yağız şoföre çabucak güvendi';
		yourself!]lang[(2798)0! !

!FontChooserMorph methodsFor: 'actions' stamp: 'SeanDeNigris 1/23/2014 16:17'!
okButtonClicked

	self apply.
	self delete.! !

!FontChooserMorph methodsFor: 'actions' stamp: 'StephaneDucasse 11/11/2013 18:48'!
updateFontIndex

	fontList ifNotNil: [ fontList selectionIndex: model selectedFontIndex ].
	styleList ifNotNil: [ styleList updateList ].
	pointSizeList ifNotNil: [ pointSizeList updateList ].
	self updatePreview! !

!FontChooserMorph methodsFor: 'interface building' stamp: 'SeanDeNigris 1/23/2014 16:17'!
open

	^ self createWindow openAsIsIn: self currentWorld.! !

!FontChooserMorph methodsFor: 'actions' stamp: 'SeanDeNigris 1/23/2014 16:34'!
updatePointSizeList

	pointSizeList ifNotNil: [ pointSizeList updateList ].
	self updatePreview! !

!FontChooserMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 1/21/2014 21:32'!
languageIndex: anIndex

	anIndex isZero ifTrue: [ ^ self ]. 
	selectedPangram := (self pangrams at: anIndex) value.
	languageList selectionIndex: anIndex.
	self updatePreview! !

!FontChooserMorph class methodsFor: 'instance creation' stamp: 'tween 8/4/2007 10:24'!
withModel: aFontChooser
	^self new 
		initializeWithModel: aFontChooser;
		yourself.! !

!FontFamilyAbstract commentStamp: 'TorstenBergmann 2/4/2014 22:07'!
Abstract font family!
!FontFamilyAbstract methodsFor: 'accessing' stamp: 'tween 8/18/2007 13:47'!
members
	"Answer the value of members"

	^ members! !

!FontFamilyAbstract methodsFor: 'accessing' stamp: 'tween 8/18/2007 13:46'!
familyName: anObject
	"Set the value of familyName"

	familyName := anObject! !

!FontFamilyAbstract methodsFor: 'printing' stamp: 'tween 9/7/2007 19:36'!
printOn: aStream
	aStream 
		nextPutAll: self class name asString;
		nextPut: $ ;
		nextPutAll: self familyName printString! !

!FontFamilyAbstract methodsFor: 'accessing' stamp: 'tween 8/18/2007 13:46'!
familyName
	"Answer the value of familyName"

	^ familyName! !

!FontFamilyAbstract methodsFor: 'member lookup' stamp: 'tween 8/18/2007 13:50'!
closestMemberWithStretchValue: stretchValue weightValue: weightValue slantValue: slantValue
	"answer the member that has weight, slant and stretch values that most closely 
	match those given by stretchValue, weightValue, and slantValue"
	
	^(self members asSortedCollection:[:a :b | 
		a isCloserMatchThan: b 
			toStretch: stretchValue 
			weight: weightValue 
			slant: slantValue]) first. ! !

!FontFamilyMemberAbstract commentStamp: 'TorstenBergmann 2/4/2014 22:08'!
Abstract member for a font family!
!FontFamilyMemberAbstract methodsFor: 'accessing' stamp: 'tween 9/8/2007 13:24'!
stretchValue
	self subclassResponsibility! !

!FontFamilyMemberAbstract methodsFor: 'comparing' stamp: 'tween 9/29/2007 13:00'!
closenessVectorForStretch: stretch slant: slant weight: weight
	| normalizedSlant |
	normalizedSlant := slant.
	normalizedSlant ~= 0 ifTrue:[
		 "treat italic and oblique as though they were they same"
		normalizedSlant := LogicalFont slantItalic].
	^{(stretch - LogicalFont stretchRegular) * 11. slant * 7. ((weight - LogicalFont weightRegular) / 100) * 5}! !

!FontFamilyMemberAbstract methodsFor: 'accessing' stamp: 'tween 8/18/2007 13:41'!
styleName
	"Answer the value of styleName"

	^ styleName! !

!FontFamilyMemberAbstract methodsFor: 'accessing' stamp: 'tween 8/25/2007 14:22'!
family
	^family! !

!FontFamilyMemberAbstract methodsFor: 'converting' stamp: 'tween 9/8/2007 13:25'!
asLogicalFontOfPointSize: pointSize
	^LogicalFont
		familyName: self family familyName 
		pointSize: pointSize 
		stretchValue: self stretchValue
		weightValue: self weightValue
		slantValue: self slantValue! !

!FontFamilyMemberAbstract methodsFor: 'accessing' stamp: 'tween 8/18/2007 13:41'!
styleName: anObject
	"Set the value of styleName"

	styleName := anObject! !

!FontFamilyMemberAbstract methodsFor: 'accessing' stamp: 'tween 9/8/2007 13:24'!
weightValue
	self subclassResponsibility! !

!FontFamilyMemberAbstract methodsFor: 'accessing' stamp: 'tween 9/8/2007 13:24'!
slantValue
	self subclassResponsibility! !

!FontFamilyMemberAbstract methodsFor: 'accessing' stamp: 'tween 8/25/2007 14:22'!
family: aFontFamily
	family := aFontFamily! !

!FontFamilyMemberAbstract methodsFor: 'comparing' stamp: 'tween 8/18/2007 13:42'!
closenessVector
	^self closenessVectorForStretch: self stretchValue slant: self slantValue weight: self weightValue! !

!FontFamilyMemberAbstract methodsFor: 'comparing' stamp: 'tween 8/18/2007 13:43'!
isCloserMatchThan: otherMember toStretch: inputStretch weight: inputWeight slant: inputSlant 
	| inputVector vector otherVector distance otherDistance dotProduct otherDotProduct |
	
	inputVector := self closenessVectorForStretch: inputStretch slant: inputSlant weight: inputWeight.
	vector := self closenessVector.
	otherVector := otherMember closenessVector.
	distance := (((inputVector first - vector first) raisedTo: 2) +
			((inputVector second - vector second) raisedTo: 2) +
			((inputVector third - vector third) raisedTo: 2)) sqrt.
	otherDistance := (((inputVector first - otherVector first) raisedTo: 2) +
			((inputVector second - otherVector second) raisedTo: 2) +
			((inputVector third - otherVector third) raisedTo: 2)) sqrt.
	distance < otherDistance ifTrue:[^true].
	distance > otherDistance ifTrue:[^false].	
	dotProduct := (inputVector first * vector first) +
				(inputVector second * vector second) +
				(inputVector third * vector third).
	otherDotProduct := (inputVector first * otherVector first) +
				(inputVector second * otherVector second) +
				(inputVector third * otherVector third).
	dotProduct > otherDotProduct ifTrue:[^true].
	dotProduct < otherDotProduct ifTrue:[^false].	
	vector first > otherVector first ifTrue:[^true].
	vector first < otherVector first ifTrue:[^false].
	vector second > otherVector second ifTrue:[^true].
	vector second < otherVector second ifTrue:[^false].
	vector third > otherVector third ifTrue:[^true].
	vector third < otherVector third ifTrue:[^false].
	^false ! !

!FontProviderAbstract commentStamp: 'tween 3/14/2007 22:59'!
Abstract superClass for fontProviders
	examples of possible fontProviders are 
		StrikeFontProvider
		FreeTypeFontProvider
		Win32NativeFontProvider
		!
!FontProviderAbstract methodsFor: 'accessing' stamp: 'tween 8/16/2007 22:00'!
families
	self subclassResponsibility! !

!FontSet commentStamp: '<historical>'!
FontSet provides a mechanism for storing a set of fonts as a class that can be conveniently filedOut, filedIn, and installed as a TextStyle.

The most common use is...
	Find a font you like.
	Use BitFont to convert a bunch of sizes to data files named, eg, LovelyNN.BF
	Use FontSet convertFontsNamed: 'Lovely' to produce a FontSet named Lovely.
	FileOut that FontSet for later use.
	Use Lovely installAsTextStyle to make all sizes available in a TextStyle
		named #Lovely in the TextConstants dictionary.
	Use ctrl-k in any text pane to select the new Lovely style for that paragraph.
	Then use cmd-1 through 5 or cmd-k to set the point-size for any selection.
!
!FontSet class methodsFor: 'filein/out' stamp: 'sma 12/29/1999 11:49'!
fileOut
	"FileOut and then change the properties of the file so that it won't be
	treated as text by, eg, email attachment facilities"

	super fileOut.
	(FileStream oldFileNamed: self name , '.st') setFileTypeToObject; close! !

!FontSet class methodsFor: 'converting' stamp: 'lr 7/4/2009 10:42'!
convertTextStyleNamed: aString 
	| style fontSet |
	(style := TextStyle named: aString) ifNil: [ ^ self error: 'unknown text style ' , aString ].
	fontSet := self fontSetClass: aString.
	style fontArray do: [ :each | fontSet compileFont: each ]! !

!FontSet class methodsFor: 'compiling' stamp: 'sma 12/29/1999 11:48'!
acceptsLoggingOfCompilation
	"Dont log sources for my subclasses, so as not to waste time
	and space storing printString versions of the string literals."

	^ self == FontSet! !

!FontSet class methodsFor: 'installing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
installAsDefault 
	"FontSetNewYork installAsDefault"
	
	(self confirm: 'Do you want to install' translated, '
''' , self fontName , ''' as default font?' translated)
		ifFalse: [^ self].
	self installAsTextStyle.
	TextSharedInformation at: #DefaultTextStyle put: (TextStyle named: self fontName).
	
! !

!FontSet class methodsFor: 'private' stamp: 'simon.denier 6/11/2010 14:33'!
fontSetClass: aString 
	| className fontSet |
	className := (self name , (aString select: [ :c | c isAlphaNumeric ]) capitalized) asSymbol.
	fontSet := Smalltalk globals
		at: className
		ifAbsentPut: 
			[ self 
				subclass: className
				instanceVariableNames: ''
				classVariableNames: ''
				poolDictionaries: ''
				category: self fontCategory ].
	(fontSet inheritsFrom: self) ifFalse: [ ^ self error: 'The name ' , className , ' is already in use' ].
	^ fontSet! !

!FontSet class methodsFor: 'converting' stamp: 'CamilloBruni 5/4/2012 20:17'!
convertFontsNamed: familyName inDirectoryNamed: dirName 
	"FontSet convertFontsNamed: 'Tekton' inDirectoryNamed: 'Tekton Fonts' "
	"This utility is for use after you have used BitFont to produce data files 
	for the fonts you wish to use.  It will read the BitFont files and build
	a fontset class from them.  If one already exists, the sizes that can be
	found will be overwritten."
	"For this utility to work as is, the BitFont data files must be named 'familyNN.BF',
	and must reside in the directory named by dirName (use '' for the current directory)."
	"Check first for matching file names and usable FontSet class name."
	| allFontNames fontSet dir |
	
	dir := FileSystem disk workingDirectory.
	dirName isEmpty 
		ifFalse: [ dir := dir / dirName ].
		
	allFontNames := dir files select: [ :file|  familyName , '..\.BF' matches: file basename].
	allFontNames isEmpty 
		ifTrue: [ ^ self error: 'No files found like ' , familyName , 'NN.BF' ].
	
	fontSet := self fontSetClass: familyName.
	
	allFontNames do: [ :each | 
		Transcript cr; show: each.
		fontSet compileFont: (StrikeFont new readFromBitFont: (dir / each) fullName) ]! !

!FontSet class methodsFor: 'as yet unclassified' stamp: 'di 9/15/97 12:01'!
convertFontsNamed: familyName  "FontSet convertFontsNamed: 'Palatino' "
	^ self convertFontsNamed: familyName inDirectoryNamed: ''! !

!FontSet class methodsFor: 'private' stamp: 'ClementBera 6/13/2013 15:23'!
fontName
	^ self name asSymbol! !

!FontSet class methodsFor: 'compiling' stamp: 'CamilloBruni 5/4/2012 20:11'!
compileFont: strikeFont 
	| tempName literalString header sizeStr familyName |
	tempName := 'FontTemp.sf2'.
	strikeFont writeAsStrike2named: tempName.
	literalString := (Base64MimeConverter mimeEncode: (FileStream readOnlyFileNamed: tempName) binary) contents fullPrintString.
	sizeStr := strikeFont pointSize asString.
	familyName := strikeFont name first: (strikeFont name findLast: [ :x | x isDigit not ]).
	header := 'size' , sizeStr , '
	^ self fontNamed: ''' , familyName , sizeStr , ''' fromMimeLiteral:
'.
	self class 
		compile: header , literalString
		classified: 'fonts'
		notifying: nil.
		
	(FileSystem root workingDirectory / tempName) delete.! !

!FontSet class methodsFor: 'private' stamp: 'sma 12/29/1999 12:58'!
fontCategory
	^ 'Graphics-Fonts' asSymbol! !

!FontSet class methodsFor: 'installing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
installAsTextStyle
	"FontSetNewYork installAsTextStyle"
	| selectors |
	(TextSharedInformation includesKey: self fontName) ifTrue: 
		[ (self confirm: self fontName , ' is already defined in TextSharedInformation.
Do you want to replace that definition?') ifFalse: [ ^ self ] ].
	selectors := (self class selectors select: [ :s | s beginsWith: 'size' ]) asSortedCollection.
	TextSharedInformation 
		at: self fontName
		put: (TextStyle fontArray: (selectors collect: [ :each | self perform: each ]))! !

!FontSet class methodsFor: 'installing' stamp: 'di 1/24/2005 11:13'!
fontNamed: fontName fromMimeLiteral: aString
	"This method allows a font set to be captured as sourcecode in a subclass.
	The string literals will presumably be created by printing, eg,
		(FileStream readOnlyFileNamed: 'Palatino24.sf2') contentsOfEntireFile,
		and following the logic in compileFont: to encode and add a heading.

	See the method installAsTextStyle to see how this can be used."

	^ StrikeFont new 
		name: fontName;
		readFromStrike2Stream: (Base64MimeConverter mimeDecodeToBytes: aString readStream)! !

!FontSubstitutionDuringLoading commentStamp: '<historical>'!
signaled by font loading code when reading a DiskProxy that calls for a missing font.!
!FontSubstitutionDuringLoading methodsFor: 'accessing' stamp: 'nk 11/8/2004 15:01'!
pixelSize
	"Answer the value of pixelSize"

	^ pixelSize! !

!FontSubstitutionDuringLoading methodsFor: 'accessing' stamp: 'nk 11/8/2004 15:01'!
pixelSize: anObject
	"Set the value of pixelSize"

	pixelSize := anObject! !

!FontSubstitutionDuringLoading methodsFor: 'accessing' stamp: 'AlainPlantec 11/29/2009 21:33'!
defaultAction
	familyName ifNil: [ familyName := 'NoName' ].
	pixelSize ifNil: [ pixelSize := 12 ].

	^((familyName beginsWith: 'Comic')
		ifTrue: [ TextStyle named: (StandardFonts buttonFont familyName) ]
		ifFalse: [ TextStyle default ]) fontOfSize: pixelSize.! !

!FontSubstitutionDuringLoading methodsFor: 'accessing' stamp: 'nk 11/8/2004 15:01'!
familyName: anObject
	"Set the value of familyName"

	familyName := anObject! !

!FontSubstitutionDuringLoading methodsFor: 'printing' stamp: 'nk 11/8/2004 16:55'!
printOn: aStream
	super printOn: aStream.
	aStream nextPut: $(;
		nextPutAll: familyName;
		nextPut: $-;
		print: pixelSize;
		nextPut: $).! !

!FontSubstitutionDuringLoading methodsFor: 'accessing' stamp: 'nk 11/8/2004 15:01'!
familyName
	"Answer the value of familyName"

	^ familyName! !

!FontSubstitutionDuringLoading class methodsFor: 'instance creation' stamp: 'nk 11/8/2004 15:07'!
forFamilyName: aName pixelSize: aSize
	^(self new)
		familyName: aName;
		pixelSize: aSize;
		yourself.! !

!FontTest commentStamp: 'tak 3/11/2005 14:31'!
I am mainly a test for fallback font.
FontTest buildSuite run!
!FontTest methodsFor: 'testing' stamp: 'AlainPlantec 9/15/2011 17:26'!
testParagraph
	"self debug: #testParagraph"
	| text p style height width |
	text := 'test' asText.
	p := Paragraph new.
	style := TextStyle default.
	p
		compose: text
		style: style
		from: 1
		in: (0 @ 0 corner: 100 @ 100).
	"See CompositionScanner>>setActualFont: &  
	CompositionScanner>>composeFrom:inRectangle:firstLine:leftSide:rightSide:"
	height := style defaultFont height + style leading.
	width := text
				inject: 0
				into: [:tally :next | tally
						+ (style defaultFont widthOf: next)].
	p adjustRightX.
	self assert: p extent = (width @ height)! !

!FontTest methodsFor: 'testing' stamp: 'sd 2/4/2008 21:10'!
testDisplay
	"self debug: #testDisplay"
	| text font bb destPoint width |
	text := 'test' asText.
	font := TextStyle default fontOfSize: 21.
	text addAttribute: (TextFontReference toFont: font).
	bb := (Form extent: 100 @ 30) getCanvas privatePort.
	bb combinationRule: Form paint.

	font installOn: bb foregroundColor: Color black backgroundColor: Color white.
	destPoint := font displayString: text on: bb from: 1 to: 4 at: 0@0 kern: 1.

	width := text inject: 0 into: [:max :char | max + (font widthOf: char)].
	self assert: destPoint x = (width + 4).
	"bb destForm asMorph openInHand."
! !

!FooSharedPool commentStamp: 'NicoPaez 10/17/2010 14:44'!
Just a class for testing.!
!Form commentStamp: 'ls 1/4/2004 17:16'!
A rectangular array of pixels, used for holding images.  All pictures, including character images are Forms.  The depth of a Form is how many bits are used to specify the color at each pixel.  The actual bits are held in a Bitmap, whose internal structure is different at each depth.  Class Color allows you to deal with colors without knowing how they are actually encoded inside a Bitmap.
	  The supported depths (in bits) are 1, 2, 4, 8, 16, and 32.  The number of actual colors at these depths are: 2, 4, 16, 256, 32768, and 16 million.
	Forms are indexed starting at 0 instead of 1; thus, the top-left pixel of a Form has coordinates 0@0.
	Forms are combined using BitBlt.  See the comment in class BitBlt.  Forms that repeat many times to fill a large destination are InfiniteForms.

	colorAt: x@y		Returns the abstract Color at this location
	displayAt: x@y		shows this form on the screen
	displayOn: aMedium at: x@y	shows this form in a Window, a Form, or other DisplayMedium
	fillColor: aColor		Set all the pixels to the color.
	edit		launch an editor to change the bits of this form.
	pixelValueAt: x@y	The encoded color.  The encoding depends on the depth.
!
!Form methodsFor: 'other' stamp: 'ar 12/12/2003 18:24'!
fixAlpha
	"Fix the alpha channel if the receiver is 32bit"
	| bb |
	self depth = 32 ifFalse:[^self].
	bb := BitBlt toForm: self.
	bb combinationRule: 40 "fixAlpha:with:".
	bb copyBits.! !

!Form methodsFor: 'other' stamp: 'bf 8/17/2009 13:08'!
preMultiplyAlpha
	"Pre-multiply each pixel by its alpha, for proper alpha compositing (BitBlt rule 34).
	E.g., half-transparent green 16r7F00FF00 becomes 16r7F007F00"

	depth = 32 ifFalse: [^self].
	1 to: bits size do: [:i |
		| v a r g b |
		v := bits at: i.
		a := v bitShift: -24.
		r := ((v bitShift: -16) bitAnd: 255) * a // 255.
		g := ((v bitShift: -8) bitAnd: 255) * a // 255.
		b := (v bitAnd: 255) * a // 255.
		bits at: i put: (a bitShift: 24) + (r bitShift: 16) + (g bitShift: 8) + b].! !

!Form methodsFor: 'filling' stamp: 'CamilloBruni 8/1/2012 16:01'!
bitPatternForDepth: suspectedDepth
	"Only called when a Form is being used as a fillColor.  Use a Pattern or InfiniteForm instead for this purpose.
	Interpret me as an array of (32/depth) Color pixelValues.  BitBlt aligns the first element of this array with the top scanline of the destinationForm, the second with the second, and so on, cycling through the color array as necessary."

	^ self! !

!Form methodsFor: 'transitions' stamp: 'Jb 11/19/2010 16:29'!
fadeImageSquares: otherImage at: topLeft 
	"Display fadeImageSquares: (Form fromDisplay: (40@40 extent: 300@300)) reverse at: 40@40"
	^ self fadeImage: otherImage at: topLeft indexAndMaskDo:
		[:i :mask |
		mask fill: ((16-i) asPoint extent: (i*2) asPoint) fillColor: Color black.
		i <= 16]! !

!Form methodsFor: '*Morphic-Base-Support' stamp: 'LB 8/26/2002 18:08'!
stencil
	"return a 1-bit deep, black-and-white stencil of myself"

	| canvas |
	canvas := FormCanvas extent: self extent depth: 1.
	canvas fillColor: (Color white).

	canvas stencil: self at: 0@0  
				sourceRect: (Rectangle origin: 0@0 corner: self extent) color: Color black.

	^ canvas form
! !

!Form methodsFor: 'analyzing' stamp: 'StephaneDucasse 10/25/2013 16:14'!
rectangleEnclosingPixelsNotOfColor: aColor
	"Answer the smallest rectangle enclosing all the pixels of me that are different from the given color. Useful for extracting a foreground graphic from its background."

	| cm slice copyBlt countBlt top bottom newH left right |
	"map the specified color to 1 and all others to 0"
	cm := Bitmap new: (1 bitShift: (self depth min: 15)).
	cm primFill: 1.
	cm at: (aColor indexInMap: cm) put: 0.

	"build a 1-pixel high horizontal slice and BitBlts for counting pixels of interest"
	slice := Form extent: width@1 depth: 1.
	copyBlt := (BitBlt toForm: slice)
		sourceForm: self;
		combinationRule: Form over;
		destX: 0 destY: 0 width: width height: 1;
		colorMap: cm.
	countBlt := (BitBlt toForm: slice)
		fillColor: (Bitmap with: 0);
		destRect: (0@0 extent: slice extent);
		combinationRule: 32.

	"scan in from top and bottom"
	top := (0 to: height)
		detect: [:y |
			copyBlt sourceOrigin: 0@y; copyBits.
			countBlt copyBits > 0]
		ifNone: [^ 0@0 extent: 0@0].
	bottom := (height - 1 to: top by: -1)
		detect: [:y |
			copyBlt sourceOrigin: 0@y; copyBits.
			countBlt copyBits > 0].

	"build a 1-pixel wide vertical slice and BitBlts for counting pixels of interest"
	newH := bottom - top + 1.
	slice := Form extent: 1@newH depth: 1.
	copyBlt := (BitBlt current toForm: slice)
		sourceForm: self;
		combinationRule: Form over;
		destX: 0 destY: 0 width: 1 height: newH;
		colorMap: cm.
	countBlt := (BitBlt current toForm: slice)
		fillColor: (Bitmap with: 0);
		destRect: (0@0 extent: slice extent);
		combinationRule: 32.

	"scan in from left and right"
	left := (0 to: width)
		detect: [:x |
			copyBlt sourceOrigin: x@top; copyBits.
			countBlt copyBits > 0].
	right := (width - 1 to: left by: -1)
		detect: [:x |
			copyBlt sourceOrigin: x@top; copyBits.
			countBlt copyBits > 0].

	^ left@top corner: (right + 1)@(bottom + 1)
! !

!Form methodsFor: 'displaying' stamp: 'ar 5/14/2001 23:33'!
displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: rule fillColor: aForm

	aDisplayMedium copyBits: self boundingBox
		from: self
		at: aDisplayPoint + self offset
		clippingBox: clipRectangle
		rule: rule
		fillColor: aForm
		map: (self colormapIfNeededFor: aDisplayMedium).
! !

!Form methodsFor: 'color mapping' stamp: 'FernandoOlivero 9/9/2013 19:40'!
balancedPatternFor: aColor depth: aDepth 
	 
	"A generalization of bitPatternForDepth: as it exists.  Generates a 2x2 stipple of color.
	The topLeft and bottomRight pixel are closest approx to this color"
	| pv1 pv2 mask1 mask2 pv3 c |
	
	aColor isTransparent ifTrue:[  ^ Bitmap with: 0 ].

	(depth 
		between: 4
		and: 16) ifFalse: [ ^ aColor bitPatternForDepth: depth ].
	
	pv1 := aColor pixelValueForDepth: depth.
	"
	Subtract error due to pv1 to get pv2.
	pv2 := (self - (err1 := (Color colorFromPixelValue: pv1 depth: depth) - self))
						pixelValueForDepth: depth.
	Subtract error due to 2 pv1's and pv2 to get pv3.
	pv3 := (self - err1 - err1 - ((Color colorFromPixelValue: pv2 depth: depth) - self))
						pixelValueForDepth: depth.
"
	"Above two statements computed faster by the following..."
	pv2 := (c := aColor - ((Color 
			colorFromPixelValue: pv1
			depth: depth) - aColor)) pixelValueForDepth: depth.
	pv3 := c + (c - (Color 
				colorFromPixelValue: pv2
				depth: depth)) pixelValueForDepth: depth.

	"Return to a 2-word bitmap that encodes a 2x2 stipple of the given pixelValues."
	mask1 := #(
		#-
		#-
		#-
		16843009
		#-
		#-
		#-
		65537
		#-
		#-
		#-
		#-
		#-
		#-
		#-
		1
	) at: depth.	"replicates every other 4 bits"	"replicates every other 8 bits"	"replicates every other 16 bits"
	mask2 := #(
		#-
		#-
		#-
		269488144
		#-
		#-
		#-
		16777472
		#-
		#-
		#-
		#-
		#-
		#-
		#-
		65536
	) at: depth.	"replicates the other 4 bits"	"replicates the other 8 bits"	"replicates the other 16 bits"
	^  Bitmap 
		with: mask1 * pv1 + (mask2 * pv2)
		with: mask1 * pv3 + (mask2 * pv1).
	! !

!Form methodsFor: 'color mapping' stamp: 'ar 5/15/2001 16:16'!
bitPatternFor: aColor
	"Return the pixel word for representing the given color on the receiver"
	aColor isColor ifFalse:[^aColor bitPatternForDepth: self depth].
	self hasNonStandardPalette
		ifTrue:[^Bitmap with: (self pixelWordFor: aColor)]
		ifFalse:[^aColor bitPatternForDepth: self depth]! !

!Form methodsFor: 'filein/out' stamp: ''!
storeBits:startBit to:stopBit on:aStream
	bits storeBits:startBit to:stopBit on:aStream.! !

!Form methodsFor: 'testing' stamp: 'ar 5/28/2000 14:58'!
isBltAccelerated: ruleInteger for: sourceForm
	"Return true if the receiver can perform accelerated blts operations by itself"
	^false! !

!Form methodsFor: 'image manipulation' stamp: 'StephaneDucasse 10/25/2013 16:14'!
replaceColor: oldColor withColor: newColor
	"Replace one color with another everywhere is this form"

	| cm newInd target ff |
	self depth = 32
		ifTrue: [cm := (Color  cachedColormapFrom: 16 to: 32) copy]
		ifFalse: [cm := Bitmap new: (1 bitShift: (self depth min: 15)).
				1 to: cm size do: [:i | cm at: i put: i - 1]].
	newInd := newColor pixelValueForDepth: self depth.
	cm at: (oldColor pixelValueForDepth: (self depth min: 16))+1 put: newInd.
	target := newColor isTransparent 
		ifTrue: [ff := Form extent: self extent depth: depth.
			ff fillWithColor: newColor.  ff]
		ifFalse: [self].
	(BitBlt toForm: target)
		sourceForm: self;
		sourceOrigin: 0@0;
		combinationRule: Form paint;
		destX: 0 destY: 0 width: width height: height;
		colorMap: cm;
		copyBits.
	newColor = Color transparent 
		ifTrue: [target displayOn: self].! !

!Form methodsFor: 'testing' stamp: 'ar 5/15/2001 16:14'!
hasNonStandardPalette
	"Return true if the receiver has a non-standard palette.
	Non-standard means that RGBA components may be located
	at positions differing from the standard Squeak RGBA layout
	at the receiver's depth."
	^false! !

!Form methodsFor: 'color mapping' stamp: 'ar 5/17/2001 15:42'!
colormapIfNeededForDepth: destDepth
	"Return a colormap for displaying the receiver at the given depth, or nil if no colormap is needed."

	self depth = destDepth ifTrue: [^ nil].  "not needed if depths are the same"
	^ Color colorMapIfNeededFrom: self depth to: destDepth
! !

!Form methodsFor: 'scaling, rotation' stamp: 'ar 5/14/2001 23:33'!
flipBy: direction centerAt: aPoint
	"Return a copy of the receiver flipped either #vertical or #horizontal."
	| newForm quad |
	newForm := self class extent: self extent depth: depth.
	quad := self boundingBox innerCorners.
	quad := (direction = #vertical ifTrue: [#(2 1 4 3)] ifFalse: [#(4 3 2 1)])
		collect: [:i | quad at: i].
	(WarpBlt current toForm: newForm)
		sourceForm: self;
		colorMap: (self colormapIfNeededFor: newForm);
		combinationRule: 3;
		copyQuad: quad toRect: newForm boundingBox.
	newForm offset: (self offset flipBy: direction centerAt: aPoint).
	^ newForm
"
[Sensor anyButtonPressed] whileFalse:
	[((Form fromDisplay: (Sensor cursorPoint extent: 130@66))
			flipBy: #vertical centerAt: 0@0) display]
"
"Consistency test...
 | f f2 p | [Sensor anyButtonPressed] whileFalse:
	[f := Form fromDisplay: ((p := Sensor cursorPoint) extent: 31@41).
	Display fillBlack: (p extent: 31@41).
	f2 := f flipBy: #vertical centerAt: 0@0.
	(f2 flipBy: #vertical centerAt: 0@0) displayAt: p]
"
! !

!Form methodsFor: 'transitions' stamp: 'jm 10/16/97 15:21'!
wipeImage: otherImage at: topLeft delta: delta
	"Display wipeImage: (Form fromDisplay: (40@40 extent: 300@300)) reverse
		at: 40@40 delta: 0@-2"

	self wipeImage: otherImage at: topLeft delta: delta clippingBox: nil.
! !

!Form methodsFor: 'testing' stamp: 'ar 7/21/2007 21:37'!
isAllWhite
	"Answer whether all bits in the receiver are white"
	| word |
	self unhibernate.
	word := Color white pixelWordForDepth: self depth.
	1 to: bits size do: [:i | (bits at: i) = word ifFalse: [^ false]].
	^ true! !

!Form methodsFor: 'color mapping' stamp: 'ar 5/16/2001 22:23'!
colormapIfNeededFor: destForm
	"Return a ColorMap mapping from the receiver to destForm."
	(self hasNonStandardPalette or:[destForm hasNonStandardPalette]) 
		ifTrue:[^self colormapFromARGB mappingTo: destForm colormapFromARGB]
		ifFalse:[^self colormapIfNeededForDepth: destForm depth]! !

!Form methodsFor: 'initialization' stamp: 'ar 5/28/2000 18:45'!
shutDown
	"The system is going down. Try to preserve some space"
	self hibernate! !

!Form methodsFor: 'filling' stamp: 'StephaneDucasse 10/25/2013 16:13'!
eraseShape: bwForm
	"use bwForm as a mask to clear all pixels where bwForm has 1's"
	((BitBlt  destForm: self sourceForm: bwForm 
		fillColor: nil
		combinationRule: Form erase1bitShape	"Cut a hole in the picture with my mask"
		destOrigin: bwForm offset 
		sourceOrigin: 0@0
		extent: self extent clipRect: self boundingBox)
		colorMap: (Bitmap with: 0 with: 16rFFFFFFFF))
		copyBits.
! !

!Form methodsFor: 'transitions' stamp: 'di 3/2/98 09:15'!
zoomOutTo: otherImage at: topLeft
	"Display zoomOutTo: (Form fromDisplay: (40@40 extent: 300@300)) reverse at: 40@40"
	^ self zoomIn: false orOutTo: otherImage at: topLeft
		vanishingPoint: otherImage extent//2+topLeft! !

!Form methodsFor: 'transitions' stamp: 'nice 1/5/2010 15:59'!
zoomIn: goingIn orOutTo: otherImage at: topLeft vanishingPoint: vp 
	"Display zoomInTo: (Form fromDisplay: (40@40 extent: 300@300)) reverse at: 40@40.
	Display zoomOutTo: (Form fromDisplay: (40@40 extent: 300@300)) reverse at: 40@40."
	| nSteps minTime startTime |
	nSteps := 16.
	minTime := 500.  "milliseconds"
	startTime := Time millisecondClockValue.
	^ self wipeImage: otherImage at: topLeft clippingBox: nil rectForIndex:
		[:i | | bigR j lilR lead | "i runs from 1 to nsteps"
		i > nSteps
			ifTrue: [nil "indicates all done"]
			ifFalse:
			["If we are going too fast, delay for a bit"
			lead := startTime + (i-1*minTime//nSteps) - Time millisecondClockValue.
			lead > 10 ifTrue: [(Delay forMilliseconds: lead) wait].

			"Return an array with the difference rectangles for this step."
			j := goingIn ifTrue: [i] ifFalse: [nSteps+1-i].
			bigR := vp - (vp*(j)//nSteps) corner:
				vp + (otherImage extent-vp*(j)//nSteps).
			lilR := vp - (vp*(j-1)//nSteps) corner:
				vp + (otherImage extent-vp*(j-1)//nSteps).
			bigR areasOutside: lilR]]! !

!Form methodsFor: '*Morphic-Base' stamp: 'ar 7/8/2006 21:01'!
iconOrThumbnailOfSize: aNumberOrPoint 
	"Answer an appropiate form to represent the receiver"
	^ self scaledIntoFormOfSize: aNumberOrPoint! !

!Form methodsFor: 'filein/out' stamp: 'ar 2/24/2001 22:39'!
replaceByResource: aForm
	"Replace the receiver by some resource that just got loaded"
	(self extent = aForm extent and:[self depth = aForm depth]) ifTrue:[
		bits := aForm bits.
	].! !

!Form methodsFor: 'filein/out' stamp: 'laza 3/29/2004 12:21'!
storeBitsOn:aStream base:anInteger
	bits do: [:word | 
		anInteger = 10
			ifTrue: [aStream space]
			ifFalse: [aStream crtab: 2].
		word storeOn: aStream base: anInteger].
! !

!Form methodsFor: 'transitions' stamp: 'di 3/2/98 09:14'!
zoomInTo: otherImage at: topLeft
	"Display zoomInTo: (Form fromDisplay: (40@40 extent: 300@300)) reverse at: 40@40"
	^ self zoomIn: true orOutTo: otherImage at: topLeft
		vanishingPoint: otherImage extent//2+topLeft! !

!Form methodsFor: 'analyzing' stamp: 'StephaneDucasse 10/25/2013 16:16'!
xTallyPixelValue: pv orNot: not
	"Return an array of the number of pixels with value pv by x-value.
	Note that if not is true, then this will tally those different from pv."
	| cm slice countBlt copyBlt |
	cm := self newColorMap.		"Map all colors but pv to zero"
	not ifTrue: [cm atAllPut: 1].		"... or all but pv to one"
	cm at: pv+1 put: 1 - (cm at: pv+1).
	slice := Form extent: 1@height.
	copyBlt := (BitBlt destForm: slice sourceForm: self
				halftoneForm: nil combinationRule: Form over
				destOrigin: 0@0 sourceOrigin: 0@0 extent: 1 @ slice height
				clipRect: slice boundingBox) colorMap: cm.
	countBlt := (BitBlt toForm: slice)
				fillColor: (Bitmap with: 0);
				destRect: (0@0 extent: slice extent);
				combinationRule: 32.
	^ (0 to: width-1) collect:
		[:x |
		copyBlt sourceOrigin: x@0; copyBits.
		countBlt copyBits]! !

!Form methodsFor: 'pixel access' stamp: 'ar 5/17/2001 15:39'!
isTransparentAt: aPoint 
	"Return true if the receiver is transparent at the given point."

	self depth = 1 ifTrue: [^ false].  "no transparency at depth 1"
	^ (self pixelValueAt: aPoint) = (self pixelValueFor: Color transparent)
! !

!Form methodsFor: 'private' stamp: 'tk 3/13/2000 15:21'!
hackBits: bitThing
	"This method provides an initialization so that BitBlt may be used, eg, to 
	copy ByteArrays and other non-pointer objects efficiently.
	The resulting form looks 4 wide, 8 deep, and bitThing-size-in-words high."
	width := 4.
	depth := 8.
	bitThing class isBits ifFalse: [self error: 'bitThing must be a non-pointer object'].
	bitThing class isBytes
		ifTrue: [height := bitThing basicSize // 4]
		ifFalse: [height := bitThing basicSize].
	bits := bitThing! !

!Form methodsFor: '*Graphics-Files' stamp: 'sw 2/20/2002 15:37'!
writeJPEGfileNamed: fileName 
	"Write a JPEG file to the given filename using default settings"

	self writeJPEGfileNamed: fileName progressive: false

"
Display writeJPEGfileNamed: 'display.jpeg'
Form fromUser writeJPEGfileNamed: 'yourPatch.jpeg'
"! !

!Form methodsFor: 'filein/out' stamp: ''!
storeOn: aStream base: anInteger 
	"Store the receiver out as an expression that can be evaluated to recreate a Form with the same contents as the original."

	self unhibernate.
	aStream nextPut: $(.
	aStream nextPutAll: self species name.
	aStream crtab: 1.
	aStream nextPutAll: 'extent: '.
	self extent printOn: aStream.
	aStream crtab: 1.
	aStream nextPutAll: 'depth: '.
	self depth printOn: aStream.
	aStream crtab: 1.
	aStream nextPutAll: 'fromArray: #('.
	self storeBitsOn:aStream base:anInteger.
	aStream nextPut: $).
	aStream crtab: 1.
	aStream nextPutAll: 'offset: '.
	self offset printOn: aStream.
	aStream nextPut: $).
! !

!Form methodsFor: 'pixel access' stamp: 'StephaneDucasse 10/25/2013 16:14'!
pixelValueAt: aPoint put: pixelValue
	"Store the given raw pixel value at the given point. Typical clients use colorAt:put: to store a color. "

	(BitBlt bitPokerToForm: self) pixelAt: aPoint put: pixelValue.
! !

!Form methodsFor: '*Morphic-Base' stamp: 'AlainPlantec 12/10/2009 11:07'!
floodFillTolerance
	^ self class floodFillTolerance! !

!Form methodsFor: '*Polymorph-Widgets-Themes' stamp: 'EstebanLorenzano 5/10/2013 14:56'!
mergeWith: aForm
	^ self mergeWith: aForm at: 0@0! !

!Form methodsFor: 'transitions' stamp: 'jm 5/21/1998 23:46'!
slideImage: otherImage at: topLeft delta: delta
	"Display slideImage: (Form fromDisplay: (40@40 extent: 300@300)) reverse
		at: 40@40 delta: 3@-4"
	| bb nSteps clipRect |
	bb := otherImage boundingBox.
	clipRect := topLeft extent: otherImage extent.
	nSteps := 1.
	delta x = 0 ifFalse: [nSteps := nSteps max: (bb width//delta x abs) + 1].
	delta y = 0 ifFalse: [nSteps := nSteps max: (bb height//delta y abs) + 1].
	1 to: nSteps do:
			[:i | self copyBits: bb from: otherImage
				at: delta*(i-nSteps) + topLeft
				clippingBox: clipRect rule: Form paint fillColor: nil.
			Display forceDisplayUpdate]! !

!Form methodsFor: 'initialization' stamp: 'ar 5/26/2000 00:46'!
finish
	"If there are any pending operations on the receiver complete them. Do not return before all modifications have taken effect."! !

!Form methodsFor: 'accessing' stamp: 'ar 5/17/2001 15:45'!
depth
	^ depth < 0 ifTrue:[0-depth] ifFalse:[depth]! !

!Form methodsFor: 'accessing' stamp: 'ar 5/27/2000 16:56'!
displayScreen
	"Return the display screen the receiver is allocated on. 
	Forms in general are Squeak internal and not allocated on any particular display."
	^nil! !

!Form methodsFor: 'color mapping' stamp: 'FernandoOlivero 9/9/2013 19:41'!
balancedPatternFor: aColor
	"Return the pixel word for representing the given color on the receiver"
	self hasNonStandardPalette
		ifTrue:[ ^ self bitPatternFor: aColor]
		ifFalse:[^ self balancedPatternFor: aColor depth: self depth]! !

!Form methodsFor: 'converting' stamp: 'HenrikSperreJohansen 5/26/2010 15:59'!
dimmed: factor
	"Answer a dimmed variant of this form. factor in a float between 0 and 1"
	"(Form fromUser dimmed: 0.6) asMorph openInWorld"
	^ self collectColors: [ :color |
			color alpha: (color alpha min: factor)]! !

!Form methodsFor: 'other' stamp: 'ar 4/30/2008 12:18'!
fillAlpha: alphaValue
	"Fill a 32bit form with a constant alpha value"
	| bb |
	self depth = 32 ifFalse:[^self error: 'Only valid for 32 bit forms'].
	bb := BitBlt toForm: self.
	bb combinationRule: 7. "bitOr:with:".
	bb fillColor: (Bitmap with: alphaValue << 24).
	bb copyBits.
! !

!Form methodsFor: 'converting' stamp: 'StephaneDucasse 10/25/2013 16:12'!
asFormOfDepth: d
	| newForm |
	d = self depth ifTrue:[^self].
	newForm := Form extent: self extent depth: d.
	(BitBlt toForm: newForm)
		colorMap: (self colormapIfNeededFor: newForm);
		copy: (self boundingBox)
		from: 0@0 in: self
		fillColor: nil rule: Form over.
	"Special case: For a 16 -> 32 bit conversion fill the alpha channel because it gets lost in translation."
	(self depth = 16 and:[d= 32]) ifTrue:[newForm fillAlpha: 255].
	^newForm! !

!Form methodsFor: 'filein/out' stamp: 'nice 1/5/2010 15:59'!
store15To24HexBitsOn:aStream

	| buf lineWidth |

	"write data for 16-bit form, optimized for encoders writing directly to files to do one single file write rather than 12. I'm not sure I understand the significance of the shifting pattern, but I think I faithfully translated it from the original"

	lineWidth := 0.
	buf := String new: 12.
	bits do: [:word | | i | 
		i := 0.
		"upper pixel"
		buf at: (i := i + 1) put: ((word bitShift: -27) bitAnd: 15) asHexDigit.
		buf at: (i := i + 1) put: ((word bitShift: -32) bitAnd: 8) asHexDigit.

		buf at: (i := i + 1) put: ((word bitShift: -22) bitAnd: 15) asHexDigit.
		buf at: (i := i + 1) put: ((word bitShift: -27) bitAnd: 8) asHexDigit.

		buf at: (i := i + 1) put: ((word bitShift: -17) bitAnd: 15) asHexDigit.
		buf at: (i := i + 1) put: ((word bitShift: -22) bitAnd: 8) asHexDigit.

		"lower pixel"

		buf at: (i := i + 1) put: ((word bitShift: -11) bitAnd: 15) asHexDigit.
		buf at: (i := i + 1) put: ((word bitShift: -16) bitAnd: 8) asHexDigit.

		buf at: (i := i + 1) put: ((word bitShift: -6) bitAnd: 15) asHexDigit.
		buf at: (i := i + 1) put: ((word bitShift: -11) bitAnd: 8) asHexDigit.

		buf at: (i := i + 1) put: ((word bitShift: -1) bitAnd: 15) asHexDigit.
		buf at: (i := i + 1) put: ((word bitShift: -6) bitAnd: 8) asHexDigit.
		aStream nextPutAll: buf.
		lineWidth := lineWidth + 12.
		lineWidth > 100 ifTrue: [ aStream cr. lineWidth := 0 ].
		"#( 31 26 21 15 10 5 )  do:[:startBit | ]"
	].! !

!Form methodsFor: 'converting' stamp: 'HenrikSperreJohansen 5/26/2010 16:00'!
darker: aFactor
	"Answer a darker variant of this form. aFactor is a float between 0 and 1 representing the strength of 
	the darkening."
	"(Form fromUser darker: 0.08) asMorph openInWorld"
	"(Form fromUser darker: 0.16) asMorph openInWorld"
	
	^ self collectColors: [ :color |
				color adjustBrightness: aFactor negated]! !

!Form methodsFor: 'accessing' stamp: ''!
height
	^ height! !

!Form methodsFor: '*Graphics-Files' stamp: 'MarianoMartinezPeck 3/24/2010 21:13'!
writeJPEGfileNamed: fileName  progressive: aBoolean
	"Write a JPEG file to the given filename using default settings.  Make it progressive or not, depending on the boolean argument"

	PluginBasedJPEGReadWriter putForm: self quality: -1 "default" progressiveJPEG: aBoolean onFileNamed: fileName

"
Display writeJPEGfileNamed: 'display.jpeg' progressive: false.
Form fromUser writeJPEGfileNamed: 'yourPatch.jpeg' progressive: true
"! !

!Form methodsFor: 'copying' stamp: 'StephaneDucasse 10/25/2013 16:13'!
copyBits: sourceRect from: sourceForm at: destOrigin colorMap: map 
	"Make up a BitBlt table and copy the bits with the given colorMap."
	((BitBlt  
		destForm: self
		sourceForm: sourceForm
		halftoneForm: nil
		combinationRule: Form over
		destOrigin: destOrigin
		sourceOrigin: sourceRect origin
		extent: sourceRect extent
		clipRect: self boundingBox) colorMap: map) copyBits! !

!Form methodsFor: '*Morphic-Base' stamp: 'StephaneDucasse 5/23/2013 18:34'!
asMorph
	^ImageMorph new form: self! !

!Form methodsFor: 'filein/out' stamp: 'tk 2/19/1999 07:30'!
writeUncompressedOn: file
	"Write the receiver on the file in the format depth, extent, offset, bits.  Warning:  Caller must put header info on file!!  Use writeUncompressedOnFileNamed: instead."
	self unhibernate.
	file binary.
	file nextPut: depth.
	file nextWordPut: width.
	file nextWordPut: height.
	file nextWordPut: ((self offset x) >=0
					ifTrue: [self offset x]
					ifFalse: [self offset x + 65536]).
	file nextWordPut: ((self offset y) >=0
					ifTrue: [self offset y]
					ifFalse: [self offset y + 65536]).
	bits writeUncompressedOn: file! !

!Form methodsFor: 'color mapping' stamp: 'di 10/16/2001 15:23'!
reducedPaletteOfSize: nColors
	"Return an array of colors of size nColors, such that those colors
	represent well the pixel values actually found in this form."
	| threshold tallies colorTallies dist delta palette cts top cluster |
	tallies := self tallyPixelValues.  "An array of tallies for each pixel value"
	threshold := width * height // 500.

	"Make an array of (color -> tally) for all tallies over threshold"
	colorTallies := Array streamContents:
		[:s | tallies withIndexDo:
			[:v :i | v >= threshold ifTrue:
				[s nextPut: (Color colorFromPixelValue: i-1 depth: depth) -> v]]].

	"Extract a set of clusters by picking the top tally, and then removing all others
	whose color is within dist of it.  Iterate the process, adjusting dist until we get nColors."
	dist := 0.2.  delta := dist / 2.
		[cts := colorTallies copy.
		palette := Array streamContents: [:s |
			[cts isEmpty] whileFalse:
				[top := cts detectMax: [:a | a value].
				cluster := cts select: [:a | (a key diff: top key) < dist].
				s nextPut: top key -> (cluster detectSum: [:a | a value]).
				cts := cts copyWithoutAll: cluster]].
		palette size = nColors or: [delta < 0.001]]
		whileFalse:
			[palette size > nColors
				ifTrue: [dist := dist + delta]
				ifFalse: [dist := dist - delta].
			delta := delta / 2].
	^ palette collect: [:a | a key]
! !

!Form methodsFor: '*Morphic-Base' stamp: 'ar 7/8/2006 21:01'!
scaledIntoFormOfSize: aNumberOrPoint 
	"Scale and center the receiver into a form of a given size"

	| extent scale scaledForm result |

	extent := aNumberOrPoint asPoint.
	extent = self extent ifTrue: [^ self].

	(self height isZero or: [self width isZero])
		ifTrue: [^ Form extent: extent depth: self depth].

	scale := extent y / self height min: extent x / self width.
	scaledForm := self
				magnify: self boundingBox
				by: scale
				smoothing: 8.

	result := Form extent: extent depth: 32.
	result getCanvas
		translucentImage: scaledForm
		at: extent - scaledForm extent // 2.

	^ result
! !

!Form methodsFor: 'initialization' stamp: 'ar 5/17/2001 22:54'!
allocateForm: extentPoint
	"Allocate a new form which is similar to the receiver and can be used for accelerated blts"
	^Form extent: extentPoint depth: self nativeDepth! !

!Form methodsFor: 'copying' stamp: 'ar 6/9/2000 19:00'!
contentsOfArea: aRect into: newForm
 	"Return a new form which derives from the portion of the original form delineated by aRect."
	^ newForm copyBits: aRect from: self at: 0@0
		clippingBox: newForm boundingBox rule: Form over fillColor: nil! !

!Form methodsFor: 'filein/out' stamp: 'mu 8/17/2003 00:35'!
writeBitsOn: file
	bits writeOn: file! !

!Form methodsFor: 'testing' stamp: 'ar 5/28/2000 15:04'!
isDisplayScreen
	^false! !

!Form methodsFor: 'converting' stamp: 'ar 3/28/2010 15:34'!
collectColors: aBlock
	"Create a new copy of the receiver with all the colors transformed by aBlock"
	^self collectPixels:[:pv|
		(aBlock value: (Color colorFromPixelValue: pv depth: self depth)) 
			pixelValueForDepth: self depth.
	].! !

!Form methodsFor: 'color mapping' stamp: ''!
makeBWForm: foregroundColor
	"Map this form into a B/W form with 1's in the foreground regions."
	| bwForm map |
	bwForm := Form extent: self extent.
	map := self newColorMap.  "All non-foreground go to 0's"
	map at: (foregroundColor indexInMap: map) put: 1.
	bwForm copyBits: self boundingBox from: self at: 0@0 colorMap: map.
	^ bwForm! !

!Form methodsFor: '*Polymorph-Widgets-Themes' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
setAsBackground
	"Set this form as a background image."
	| world |
	world := self currentWorld.
	world backgroundMorph: ((Smalltalk ui theme builder newAlphaImage: self help: nil) autoSize: false;
			 layout: #scaled;
			 lock) ! !

!Form methodsFor: 'accessing' stamp: ''!
bits
	"Answer the receiver's Bitmap containing its bits."

	^ bits! !

!Form methodsFor: 'other' stamp: 'RAA 1/30/2002 16:42'!
relativeTextAnchorPosition

	^nil		"so forms can be in TextAnchors"! !

!Form methodsFor: 'converting' stamp: 'StephaneDucasse 3/27/2010 21:09'!
dimmed
	"Answer a dimmed variant of this form."
	"Form fromUser dimmed asMorph openInWorld"
	^ self dimmed: 0.5! !

!Form methodsFor: 'copying' stamp: 'StephaneDucasse 10/25/2013 16:13'!
copy: destRectangle from: sourcePt in: sourceForm rule: rule 
	"Make up a BitBlt table and copy the bits."
	(BitBlt toForm: self)
		copy: destRectangle
		from: sourcePt in: sourceForm
		fillColor: nil rule: rule! !

!Form methodsFor: 'converting' stamp: 'ClementBera 7/26/2013 16:40'!
colorReduced
	"Return a color-reduced ColorForm version of the receiver, if possible, or the receiver itself if not."

	| tally tallyDepth colorCount newForm cm oldPixelValues newFormColors nextColorIndex c |
	tally := self tallyPixelValues asArray.
	tallyDepth := (tally size log: 2) asInteger.
	colorCount := 0.
	tally do: [:n | n > 0 ifTrue: [colorCount := colorCount + 1]].
	(tally at: 1) = 0 ifTrue: [colorCount := colorCount + 1].  "include transparent"
	colorCount > 256 ifTrue: [^ self].  "cannot reduce"
	newForm := self formForColorCount: colorCount.

	"build an array of just the colors used, and a color map to translate
	 old pixel values to their indices into this color array"
	cm := Bitmap new: tally size.
	oldPixelValues := self colormapIfNeededForDepth: 32.
	newFormColors := Array new: colorCount.
	newFormColors at: 1 put: Color transparent.
	nextColorIndex := 2.
	2 to: cm size do: [:i |
		(tally at: i) > 0 ifTrue: [
			oldPixelValues 
				ifNil: [c := Color colorFromPixelValue: i - 1 depth: tallyDepth]
				ifNotNil: [c := Color colorFromPixelValue: (oldPixelValues at: i) depth: 32].
			newFormColors at: nextColorIndex put: c.
			cm at: i put: nextColorIndex - 1.  "pixel values are zero-based indices"
			nextColorIndex := nextColorIndex + 1]].

	"copy pixels into new ColorForm, mapping to new pixel values"
	newForm copyBits: self boundingBox
		from: self
		at: 0@0
		clippingBox: self boundingBox
		rule: Form over
		fillColor: nil
		map: cm.
	newForm colors: newFormColors.
	newForm offset: offset.
	^ newForm
! !

!Form methodsFor: 'filling' stamp: 'StephaneDucasse 10/25/2013 16:13'!
fillFromXYColorBlock: colorBlock
	"General Gradient Fill.
	Supply relative x and y in [0.0 ... 1.0] to colorBlock,
	and paint each pixel with the color that comes back"
	| poker yRel xRel |
	poker := BitBlt bitPokerToForm: self.
	0 to: height-1 do:
		[:y | yRel := y asFloat / (height-1) asFloat.
		0 to: width-1 do:
			[:x |  xRel := x asFloat / (width-1) asFloat.
			poker pixelAt: x@y
				put: ((colorBlock value: xRel value: yRel) pixelWordForDepth: self depth)]]
"
 | d |
((Form extent: 100@20 depth: Display depth)
	fillFromXYColorBlock:
	[:x :y | d := 1.0 - (x - 0.5) abs - (y - 0.5) abs.
	Color r: d g: 0 b: 1.0-d]) display
"! !

!Form methodsFor: 'filling' stamp: 'di 2/19/1999 07:07'!
anyShapeFill
	"Fill the interior of the outermost outlined region in the receiver, a 1-bit deep form.  Typically the resulting form is used with fillShape:fillColor: to paint a solid color.  See also convexShapeFill:"

	| shape |
	"Draw a seed line around the edge and fill inward from the outside."
	shape := self findShapeAroundSeedBlock: [:f | f borderWidth: 1].
	"Reverse so that this becomes solid in the middle"
	shape := shape reverse.
	"Finally erase any bits from the original so the fill is only elsewhere"
	shape copy: shape boundingBox from: self to: 0@0 rule: Form erase.
	^ shape! !

!Form methodsFor: 'accessing' stamp: 'ar 5/17/2001 15:41'!
bitsSize
	| pixPerWord |
	depth == nil ifTrue: [depth := 1].
	pixPerWord := 32 // self depth.
	^ width + pixPerWord - 1 // pixPerWord * height! !

!Form methodsFor: 'bordering' stamp: 'StephaneDucasse 10/25/2013 16:12'!
border: rect width: borderWidth rule: rule fillColor: fillColor
        "Paint a border whose rectangular area is defined by rect. The
width of the border of each side is borderWidth. Uses fillColor for drawing
the border."
        | blt |
        blt := (BitBlt toForm: self) combinationRule: rule; fillColor: fillColor.
        blt sourceOrigin: 0@0.
        blt destOrigin: rect origin.
        blt width: rect width; height: borderWidth; copyBits.
        blt destY: rect corner y - borderWidth; copyBits.
        blt destY: rect origin y + borderWidth.
        blt height: rect height - borderWidth - borderWidth; width:
borderWidth; copyBits.
        blt destX: rect corner x - borderWidth; copyBits! !

!Form methodsFor: '*Graphics-Files' stamp: 'di 7/6/1998 23:00'!
writeOnMovie: file
	"Write just my bits on the file."
	self unhibernate.
	bits writeUncompressedOn: file! !

!Form methodsFor: 'color mapping' stamp: 'ar 5/15/2001 16:16'!
pixelWordFor: aColor
	"Return the pixel word for representing the given color on the receiver"
	| basicPattern |
	self hasNonStandardPalette 
		ifFalse:[^aColor pixelWordForDepth: self depth].
	basicPattern := self pixelValueFor: aColor.
	self depth = 32 
		ifTrue:[^basicPattern]
		ifFalse:[^aColor pixelWordFor: self depth filledWith: basicPattern]! !

!Form methodsFor: 'color mapping' stamp: 'ar 5/15/2001 16:16'!
pixelValueFor: aColor
	"Return the pixel word for representing the given color on the receiver"
	self hasNonStandardPalette
		ifTrue:[^self colormapFromARGB mapPixel: (aColor pixelValueForDepth: 32)]
		ifFalse:[^aColor pixelValueForDepth: self depth]! !

!Form methodsFor: 'accessing' stamp: 'ar 2/16/2000 22:00'!
offset
	^offset ifNil:[0@0]! !

!Form methodsFor: 'transitions' stamp: 'Jb 11/19/2010 15:44'!
fadeImageCoarse: otherImage at: topLeft
	"Display fadeImageCoarse: (Form fromDisplay: (40@40 extent: 300@300)) reverse at: 40@40"
	| d pix|
	d := self depth.
	^ self fadeImage: otherImage at: topLeft indexAndMaskDo:
		[:i :mask | | j |
		i=1 ifTrue: [pix := (1 bitShift: d) - 1.
					1 to: 8//d-1 do: [:q | pix := pix bitOr: (pix bitShift: d*4)]]			.
		i <= 16 ifTrue:[
		j := i-1//4+1.
		(0 to: 28 by: 4) do: [:k |
			mask bits at: j+k
				put: (pix bitOr: (mask bits at: j+k))].
		true]
		ifFalse: [false]]! !

!Form methodsFor: 'pixel access' stamp: 'ar 5/14/2001 23:46'!
colorAt: aPoint put: aColor
	"Store a Color into the pixel at coordinate aPoint.  "

	self pixelValueAt: aPoint put: (self pixelValueFor: aColor).

"[Sensor anyButtonPressed] whileFalse:
	[Display colorAt: Sensor cursorPoint put: Color red]"
! !

!Form methodsFor: 'analyzing' stamp: 'StephaneDucasse 10/25/2013 16:14'!
primCountBits
	"Count the non-zero pixels of this form."
	self depth > 8 ifTrue:
		[^(self asFormOfDepth: 8) primCountBits].
	^ (BitBlt toForm: self)
		fillColor: (Bitmap with: 0);
		destRect: (0@0 extent: width@height);
		combinationRule: 32;
		copyBits! !

!Form methodsFor: 'converting' stamp: 'ar 7/23/1999 17:04'!
orderedDither32To16
	"Do an ordered dithering for converting from 32 to 16 bit depth."
	| ditherMatrix ii out inBits outBits index pv dmv r di dmi dmo g b pvOut outIndex |
	self depth = 32 ifFalse:[^self error:'Must be 32bit for this'].
	ditherMatrix := #(	0	8	2	10
						12	4	14	6
						3	11	1	9
						15	7	13	5).
	ii := (0 to: 31) collect:[:i| i].
	out := Form extent: self extent depth: 16.
	inBits := self bits.
	outBits := out bits.
	index := outIndex := 0.
	pvOut := 0.
	0 to: self height-1 do:[:y|
		0 to: self width-1 do:[:x|
			pv := inBits at: (index := index + 1).
			dmv := ditherMatrix at: (y bitAnd: 3) * 4 + (x bitAnd: 3) + 1.
			r := pv bitAnd: 255.	di := r * 496 bitShift: -8.
			dmi := di bitAnd: 15.	dmo := di bitShift: -4.
			r := dmv < dmi ifTrue:[ii at: 2+dmo] ifFalse:[ii at: 1+dmo].
			g := (pv bitShift: -8) bitAnd: 255.	di := g * 496 bitShift: -8.
			dmi := di bitAnd: 15.	dmo := di bitShift: -4.
			g := dmv < dmi ifTrue:[ii at: 2+dmo] ifFalse:[ii at: 1+dmo].
			b := (pv bitShift: -16) bitAnd: 255.	di := b * 496 bitShift: -8.
			dmi := di bitAnd: 15.	dmo := di bitShift: -4.
			b := dmv < dmi ifTrue:[ii at: 2+dmo] ifFalse:[ii at: 1+dmo].
			pvOut := (pvOut bitShift: 16) + 
						(b bitShift: 10) + (g bitShift: 5) + r.
			(x bitAnd: 1) = 1 ifTrue:[
				outBits at: (outIndex := outIndex+1) put: pvOut.
				pvOut := 0].
		].
		(self width bitAnd: 1) = 1 ifTrue:[
			outBits at: (outIndex := outIndex+1) put: (pvOut bitShift: -16).
			pvOut := 0].
	].
	^out! !

!Form methodsFor: 'resources' stamp: 'StephaneDucasse 3/17/2010 20:56'!
readResourceFrom: aStream 
	"Store a resource representation of the receiver on aStream.
	Must be specific to the receiver so that no code is filed out."

	| bitsSize msb |
	(aStream next: 4) asString = self resourceTag 
		ifFalse: 
			[aStream position: aStream position - 4.
			^self readNativeResourceFrom: aStream].
	width := aStream nextNumber: 4.
	height := aStream nextNumber: 4.
	depth := aStream nextNumber: 4.
	bitsSize := aStream nextNumber: 4.
	bitsSize = 0 
		ifFalse: 
			[bits := aStream next: bitsSize.
			^self].
	msb := (aStream nextNumber: 4) = 1.
	bitsSize := aStream nextNumber: 4.
	bits := Bitmap new: self bitsSize.
	(Form 
		extent: width @ height
		depth: depth
		bits: (aStream next: bitsSize * 4)) displayOn: self.
	msb = Smalltalk  isBigEndian 
		ifFalse: 
			[Bitmap 
				swapBytesIn: bits
				from: 1
				to: bits size]! !

!Form methodsFor: 'scaling, rotation' stamp: 'jannik.laval 5/1/2010 16:12'!
flipHorizontally
	"Flip the image around the x axis. Flip the form upside/down"
	| rowLen row topIndex botIndex |
	self unhibernate.
	rowLen := bits size // height.
	row := Bitmap new: rowLen.
	topIndex := 1.
	botIndex := bits size - rowLen + 1.
	1 to: height // 2 do: [ :i |
		[topIndex+rowLen <= botIndex] assert.
		row replaceFrom: 1 to: rowLen with: bits startingAt: topIndex.
		bits replaceFrom: topIndex to: topIndex+rowLen-1 with: bits startingAt: botIndex.
		bits replaceFrom: botIndex to: botIndex+rowLen-1 with: row startingAt: 1.
		topIndex := topIndex + rowLen.
		 botIndex := botIndex - rowLen ].! !

!Form methodsFor: 'converting' stamp: 'StephaneDucasse 10/25/2013 16:12'!
asGrayScale
	"Assume the receiver is a grayscale image. Return a grayscale ColorForm computed by extracting the brightness levels of one color component. This technique allows a 32-bit Form to be converted to an 8-bit ColorForm to save space while retaining a full 255 levels of gray. (The usual colormapping technique quantizes to 8, 16, or 32 levels, which loses information.)"
	| f32 srcForm result map bb grays |
	self depth = 32 ifFalse: [
		f32 := Form extent: width@height depth: 32.
		self displayOn: f32.
		^ f32 asGrayScale].
	self unhibernate.
	srcForm := Form extent: (width * 4)@height depth: 8.
	srcForm bits: bits.
	result := ColorForm extent: width@height depth: 8.
	map := Bitmap new: 256.
	2 to: 256 do: [:i | map at: i put: i - 1].
	map at: 1 put: 1.  "map zero pixel values to near-black"
	bb := (BitBlt toForm: result)
		sourceForm: srcForm;
		combinationRule: Form over;
		colorMap: map.
	0 to: width - 1 do: [:dstX |
		bb  sourceRect: (((dstX * 4) + 2)@0 extent: 1@height);
			destOrigin: dstX@0;
			copyBits].

	"final BitBlt to zero-out pixels that were truely transparent in the original"
	map := Bitmap new: 512.
	map at: 1 put: 16rFF.
	(BitBlt toForm: result)
		sourceForm: self;
		sourceRect: self boundingBox;
		destOrigin: 0@0;
		combinationRule: Form erase;
		colorMap: map;
		copyBits.
	
	grays := (0 to: 255) collect: [:brightness | Color gray: brightness asFloat / 255.0].
	grays at: 1 put: Color transparent.
	result colors: grays.
	^ result
! !

!Form methodsFor: '*Polymorph-Widgets' stamp: 'BenjaminVanRyseghem 2/21/2013 23:14'!
listRenderOn: aCanvas atRow: index bounds: aRectangle color: aColor backgroundColor: backgroundColor from: aList
	self asMorph
		listRenderOn: aCanvas
		atRow: index
		bounds: aRectangle
		color: aColor
		backgroundColor: backgroundColor
		from: aList! !

!Form methodsFor: 'filein/out' stamp: 'mu 8/17/2003 00:43'!
readBitsFrom: aBinaryStream
	
	bits := Bitmap newFromStream: aBinaryStream.
	bits size = self bitsSize ifFalse: [self error: 'wrong bitmap size; bad Form file?'].
	^ self
! !

!Form methodsFor: 'private' stamp: 'ar 10/30/2000 23:22'!
setResourceBits: aForm
	"Private. Really. Used for setting the 'resource bits' when externalizing some form"
	bits := aForm.! !

!Form methodsFor: 'copying' stamp: 'tk 8/19/1998 16:11'!
veryDeepCopyWith: deepCopier
	"Return self.  I am immutable in the Morphic world.  Do not record me."
	^ self! !

!Form methodsFor: 'scaling, rotation' stamp: 'AliakseiSyrel 4/1/2014 11:21'!
magnifyBy: scale 
	"Answer a Form created as a scaling of the receiver.
	Scale may be a Float, and may be greater or less than 1.0."

	^ self magnify: self boundingBox by: scale
			smoothing: (scale < 1 ifTrue: [2] ifFalse: [1])! !

!Form methodsFor: 'testing' stamp: 'JuanVuletich 10/12/2010 12:44'!
mightBeTranslucent
	"Answer whether this form may be translucent"
	^self depth = 32! !

!Form methodsFor: 'transitions' stamp: 'ar 5/28/2000 12:12'!
pageWarp: otherImage at: topLeft forward: forward
	"Produce a page-turning illusion that gradually reveals otherImage
	located at topLeft in this form.
	forward == true means turn pages toward you, else away. [ignored for now]"
	| pageRect oldPage nSteps buffer p leafRect sourceQuad warp oldBottom d |
	pageRect := otherImage boundingBox.
	oldPage := self copy: (pageRect translateBy: topLeft).
	(forward ifTrue: [oldPage] ifFalse: [otherImage])
		border: pageRect
		widthRectangle: (Rectangle
				left: 0
				right: 2
				top: 1
				bottom: 1)
		rule: Form over
		fillColor: Color black.
	oldBottom := self copy: ((pageRect bottomLeft + topLeft) extent: (pageRect width@(pageRect height//4))).
	nSteps := 8.
	buffer := Form extent: otherImage extent + (0@(pageRect height//4)) depth: self depth.
	d := pageRect topLeft + (0@(pageRect height//4)) - pageRect topRight.
	1 to: nSteps-1 do:
		[:i | forward
			ifTrue: [buffer copy: pageRect from: otherImage to: 0@0 rule: Form over.
					p := pageRect topRight + (d * i // nSteps)]
			ifFalse: [buffer copy: pageRect from: oldPage to: 0@0 rule: Form over.
					p := pageRect topRight + (d * (nSteps-i) // nSteps)].
		buffer copy: oldBottom boundingBox from: oldBottom to: pageRect bottomLeft rule: Form over.
		leafRect := pageRect topLeft corner: p x @ (pageRect bottom + p y).
		sourceQuad := Array with: pageRect topLeft
			with: pageRect bottomLeft + (0@p y)
			with: pageRect bottomRight
			with: pageRect topRight - (0@p y).
		warp := (WarpBlt current toForm: buffer)
				clipRect: leafRect;
				sourceForm: (forward ifTrue: [oldPage] ifFalse: [otherImage]);
				combinationRule: Form paint.
		warp copyQuad: sourceQuad toRect: leafRect.
		self copy: buffer boundingBox from: buffer to: topLeft rule: Form over.
		Display forceDisplayUpdate].

	buffer copy: pageRect from: otherImage to: 0@0 rule: Form over.
	buffer copy: oldBottom boundingBox from: oldBottom to: pageRect bottomLeft rule: Form over.
	self copy: buffer boundingBox from: buffer to: topLeft rule: Form over.
	Display forceDisplayUpdate.
"
1 to: 4 do: [:corner | Display pageWarp:
				(Form fromDisplay: (10@10 extent: 200@300)) reverse
			at: 10@10 forward: false]
"
! !

!Form methodsFor: 'filein/out' stamp: 'mu 8/17/2003 00:44'!
readAttributesFrom: aBinaryStream
	| offsetX offsetY |
	depth := aBinaryStream next.
	(self depth isPowerOfTwo and: [self depth between: 1 and: 32])
		ifFalse: [self error: 'invalid depth; bad Form file?'].
	width := aBinaryStream nextWord.
	height := aBinaryStream nextWord.
	offsetX  := aBinaryStream nextWord.
	offsetY := aBinaryStream nextWord.
	offsetX > 32767 ifTrue: [offsetX := offsetX - 65536].
	offsetY > 32767 ifTrue: [offsetY := offsetY - 65536].
	offset := Point x: offsetX y: offsetY.
	
! !

!Form methodsFor: 'copying' stamp: 'jm 2/27/98 09:35'!
deepCopy

	^ self shallowCopy
		bits: bits copy;
		offset: offset copy
! !

!Form methodsFor: 'filling' stamp: 'StephaneDucasse 10/25/2013 16:13'!
findShapeAroundSeedBlock: seedBlock
	"Build a shape that is black in any region marked by seedBlock. 
	SeedBlock will be supplied a form, in which to blacken various
	pixels as 'seeds'.  Then the seeds are smeared until 
	there is no change in the smear when it fills the region, ie,
	when smearing hits a black border and thus goes no further."
	| smearForm previousSmear all count smearPort |
	self assert: [self depth > 1]. "Only meaningful for B/W forms."
	all := self boundingBox.
	smearForm := Form extent: self extent.
	smearPort := BitBlt toForm: smearForm.
	seedBlock value: smearForm.		"Blacken seeds to be smeared"
	smearPort copyForm: self to: 0 @ 0 rule: Form erase.  "Clear any in black"
	previousSmear := smearForm deepCopy.
	count := 1.
	[count = 10 and:   "check for no change every 10 smears"
		[count := 1.
		previousSmear copy: all from: 0 @ 0 in: smearForm rule: Form reverse.
		previousSmear isAllWhite]]
		whileFalse: 
			[smearPort copyForm: smearForm to: 1 @ 0 rule: Form under.
			smearPort copyForm: smearForm to: -1 @ 0 rule: Form under.
			"After horiz smear, trim around the region border"
			smearPort copyForm: self to: 0 @ 0 rule: Form erase.
			smearPort copyForm: smearForm to: 0 @ 1 rule: Form under.
			smearPort copyForm: smearForm to: 0 @ -1 rule: Form under.
			"After vert smear, trim around the region border"
			smearPort copyForm: self to: 0 @ 0 rule: Form erase.
			count := count+1.
			count = 9 ifTrue: "Save penultimate smear for comparison"
				[previousSmear copy: all from: 0 @ 0 in: smearForm rule: Form over]].
	"Now paint the filled region in me with aHalftone"
	^ smearForm! !

!Form methodsFor: 'analyzing' stamp: ''!
innerPixelRectFor: pv orNot: not
	"Return a rectangle describing the smallest part of me that includes 
	all pixels of value pv.
	Note:  If orNot is true, then produce a copy that includes all pixels
	that are DIFFERENT from the supplied (background) value"

	| xTally yTally |
	xTally := self xTallyPixelValue: pv orNot: not.
	yTally := self yTallyPixelValue: pv orNot: not.
	^ ((xTally findFirst: [:t | t>0]) - 1) @ ((yTally findFirst: [:t | t>0]) - 1)
		corner:
			(xTally findLast: [:t | t>0])@(yTally findLast: [:t | t>0])! !

!Form methodsFor: 'converting' stamp: 'ar 2/7/2004 18:16'!
asSourceForm
	^self! !

!Form methodsFor: 'displaying' stamp: ''!
displayOnPort: port at: location
	port copyForm: self to: location rule: Form over! !

!Form methodsFor: 'analyzing' stamp: 'StephaneDucasse 10/25/2013 16:16'!
yTallyPixelValue: pv orNot: not
	"Return an array of the number of pixels with value pv by y-value.
	Note that if not is true, then this will tally those different from pv."
	| cm slice copyBlt countBlt |
	cm := self newColorMap.		"Map all colors but pv to zero"
	not ifTrue: [cm atAllPut: 1].		"... or all but pv to one"
	cm at: pv+1 put: 1 - (cm at: pv+1).
	slice := Form extent: width@1.
	copyBlt := (BitBlt destForm: slice sourceForm: self
				halftoneForm: nil combinationRule: Form over
				destOrigin: 0@0 sourceOrigin: 0@0 extent: slice width @ 1
				clipRect: slice boundingBox) colorMap: cm.
	countBlt := (BitBlt toForm: slice)
				fillColor: (Bitmap with: 0);
				destRect: (0@0 extent: slice extent);
				combinationRule: 32.
	^ (0 to: height-1) collect:
		[:y |
		copyBlt sourceOrigin: 0@y; copyBits.
		countBlt copyBits]! !

!Form methodsFor: 'display box access' stamp: ''!
boundingBox
	^ Rectangle origin: 0 @ 0
			corner: width @ height! !

!Form methodsFor: 'analyzing' stamp: 'jm 6/18/1999 18:41'!
tallyPixelValues
	"Answer a Bitmap whose elements contain the number of pixels in this Form with the pixel value corresponding to their index. Note that the pixels of multiple Forms can be tallied together using tallyPixelValuesInRect:into:."

	^ self tallyPixelValuesInRect: self boundingBox
		into: (Bitmap new: (1 bitShift: (self depth min: 15)))
"
Move a little rectangle around the screen and print its tallies...
 | r tallies nonZero |
Cursor blank showWhile: [
[Sensor anyButtonPressed] whileFalse:
	[r := Sensor cursorPoint extent: 10@10.
	Display border: (r expandBy: 2) width: 2 rule: Form reverse fillColor: nil.
	tallies := (Display copy: r) tallyPixelValues.
	nonZero := (1 to: tallies size) select: [:i | (tallies at: i) > 0]
			thenCollect: [:i | (tallies at: i) -> (i-1)].
	nonZero printString , '          ' displayAt: 0@0.
	Display border: (r expandBy: 2) width: 2 rule: Form reverse fillColor: nil]]
"
! !

!Form methodsFor: 'accessing' stamp: ''!
bits: aBitmap 
	"Reset the Bitmap containing the receiver's bits."

	bits := aBitmap! !

!Form methodsFor: '*Morphic-Core' stamp: 'PavelKrivanek 11/18/2012 20:37'!
defaultCanvasClass

	"Return the default canvas used for drawing onto the receiver"
	^ FormCanvas! !

!Form methodsFor: 'analyzing' stamp: 'jm 12/5/97 19:48'!
colorsUsed
	"Return a list of the Colors this form uses."

	| tallies tallyDepth usedColors |
	tallies := self tallyPixelValues.
	tallyDepth := (tallies size log: 2) asInteger.
	usedColors := OrderedCollection new.
	tallies doWithIndex: [:count :i |
		count > 0 ifTrue: [
			usedColors add: (Color colorFromPixelValue: i - 1 depth: tallyDepth)]].
	^ usedColors asArray
! !

!Form methodsFor: '*Polymorph-Widgets-Themes' stamp: 'EstebanLorenzano 5/10/2013 14:56'!
mergeBottomRightWith: aForm
	^ self 
		mergeWith: aForm 
		at: self extent - aForm extent! !

!Form methodsFor: 'filein/out' stamp: 'mu 8/17/2003 00:44'!
readFrom: aBinaryStream
	"Reads the receiver from the given binary stream with the format:
		depth, extent, offset, bits."
	self readAttributesFrom: aBinaryStream.
	self readBitsFrom: aBinaryStream! !

!Form methodsFor: 'transitions' stamp: 'IgorStasenko 12/22/2012 03:28'!
wipeImage: otherImage at: topLeft clippingBox: clipBox rectForIndex: rectForIndexBlock

	| i clipRect t rectOrList waitTime |
	i := 0.
	clipRect := topLeft extent: otherImage extent.
	clipBox ifNotNil: [clipRect := clipRect intersect: clipBox ifNone: [ ^ self ]].
	[rectOrList := rectForIndexBlock value: (i := i + 1).
	 rectOrList == nil]
		whileFalse: [
			t := Time millisecondClockValue.
			rectOrList asOrderedCollection do: [:r |
				self copyBits: r from: otherImage at: topLeft + r topLeft
					clippingBox: clipRect rule: Form over fillColor: nil].
			Display forceDisplayUpdate.
			waitTime := 3 - (Time millisecondClockValue - t).
			waitTime > 0 ifTrue:
				["(Delay forMilliseconds: waitTime) wait"]].
! !

!Form methodsFor: 'other' stamp: 'jm 1/6/98 10:37'!
primPrintHScale: hScale vScale: vScale landscape: aBoolean
	"On platforms that support it, this primitive prints the receiver, assumed to be a Form, to the default printer."
	"(Form extent: 10@10) primPrintHScale: 1.0 vScale: 1.0 landscape: true"

	<primitive: 232>
	self primitiveFailed
! !

!Form methodsFor: 'filein/out' stamp: 'di 8/5/1998 11:37'!
hibernate
	"Replace my bitmap with a compactly encoded representation (a ByteArray).  It is vital that BitBlt and any other access to the bitmap (such as writing to a file) not be used when in this state.  Since BitBlt will fail if the bitmap size is wrong (not = bitsSize), we do not allow replacement by a byteArray of the same (or larger) size."

	"NOTE: This method copies code from Bitmap compressToByteArray so that it can
	nil out the old bits during the copy, thus avoiding 2x need for extra storage."
	| compactBits lastByte |
	(bits isMemberOf: Bitmap) ifFalse: [^ self  "already hibernated or weird state"].
	compactBits := ByteArray new: (bits size*4) + 7 + (bits size//1984*3).
	lastByte := bits compress: bits toByteArray: compactBits.
	lastByte < (bits size*4) ifTrue:
		[bits := nil.  "Let GC reclaim the old bits before the copy if necessary"
		bits := compactBits copyFrom: 1 to: lastByte]! !

!Form methodsFor: 'testing' stamp: 'ar 5/27/2000 16:54'!
isExternalForm
	^false! !

!Form methodsFor: 'copying' stamp: ''!
copy: aRect
 	"Return a new form which derives from the portion of the original form delineated by aRect."
	| newForm |
	newForm := self class extent: aRect extent depth: depth.
	^ newForm copyBits: aRect from: self at: 0@0
		clippingBox: newForm boundingBox rule: Form over fillColor: nil! !

!Form methodsFor: 'color mapping' stamp: 'ar 5/17/2001 15:41'!
newColorMap 
	"Return an uninitialized color map array appropriate to this Form's depth."

	^ Bitmap new: (1 bitShift: (self depth min: 15))
! !

!Form methodsFor: 'color mapping' stamp: 'StephaneDucasse 10/25/2013 16:13'!
mapColor: oldColor to: newColor
	"Make all pixels of the given color in this Form to the given new color."
	"Warnings: This method modifies the receiver. It may lose some color accuracy on 32-bit Forms, since the transformation uses a color map with only 15-bit resolution."

	| map |
	map := (Color cachedColormapFrom: self depth to: self depth) copy.
	map at: (oldColor indexInMap: map) put: (newColor pixelWordForDepth: self depth).
	(BitBlt toForm: self)
		sourceForm: self;
		sourceOrigin: 0@0;
		combinationRule: Form over;
		destX: 0 destY: 0 width: width height: height;
		colorMap: map;
		copyBits.
! !

!Form methodsFor: 'accessing' stamp: 'CamilloBruni 8/1/2012 16:06'!
form
	"Answer the receiver's form.  For vanilla Forms, this degenerates to self.  Makes several methods that operate on both Forms and MaskedForms much more straightforward."

	^ self! !

!Form methodsFor: 'transitions' stamp: 'MarcusDenker 10/2/2013 20:21'!
fadeImage: otherImage at: topLeft
	indexAndMaskDo: indexAndMaskBlock
	
	"This fade uses halftones as a blending hack.
	Zeros in the halftone produce the original image (self), and 
	ones in the halftone produce the 'otherImage'.
	IndexAndMaskBlock gets evaluated prior to each cycle,
	and the resulting boolean determines whether to continue cycling."
	| index imageRect maskForm resultForm |
	imageRect := otherImage boundingBox.
	resultForm := self copy: (topLeft extent: imageRect extent).
	maskForm := Form extent: 32@32.
	index := 0.

	[indexAndMaskBlock value: (index := index+1) value: maskForm]
	whileTrue:
		[maskForm reverse.
		resultForm copyBits: imageRect from: resultForm at: 0@0
			clippingBox: imageRect rule: Form over fillColor: maskForm.
		maskForm reverse.
		resultForm copyBits: imageRect from: otherImage at: 0@0
			clippingBox: imageRect rule: Form under fillColor: maskForm.
		self copyBits: imageRect from: resultForm at: topLeft
				clippingBox: self boundingBox rule: Form over fillColor: nil.
		Display forceDisplayUpdate]! !

!Form methodsFor: 'converting' stamp: 'jm 11/12/97 19:28'!
as8BitColorForm
	"Simple conversion of zero pixels to transparent.  Force it to 8 bits."

	| f map |
	f := ColorForm extent: self extent depth: 8.
	self displayOn: f at: self offset negated.
	map := Color indexedColors copy.
	map at: 1 put: Color transparent.
	f colors: map.
	f offset: self offset.
	^ f
! !

!Form methodsFor: 'transitions' stamp: 'Jb 11/19/2010 15:53'!
fadeImageVert: otherImage at: topLeft
	"Display fadeImageVert: (Form fromDisplay: (10@10 extent: 300@300)) reverse at: 10@10"
	| d |
	d := self depth.
	^ self fadeImage: otherImage at: topLeft indexAndMaskDo:
		[:i :mask |
		mask fill: ((mask width//2//d-i*d)@0 extent: i*2*d@mask height) fillColor: Color black.
		i <= (mask width//d)]! !

!Form methodsFor: 'accessing' stamp: 'ar 5/28/2000 00:48'!
hasBeenModified: aBool
	"Change the receiver to reflect the modification state"
	aBool ifTrue:[^self unhibernate].
	self shouldPreserveContents
		ifTrue:[self hibernate]
		ifFalse:[bits := nil]! !

!Form methodsFor: 'analyzing' stamp: 'ar 5/17/2001 15:40'!
dominantColor
	| tally max maxi |
	self depth > 16 ifTrue:
		[^(self asFormOfDepth: 16) dominantColor].
	tally := self tallyPixelValues.
	max := maxi := 0.
	tally withIndexDo: [:n :i | n > max ifTrue: [max := n. maxi := i]].
	^ Color colorFromPixelValue: maxi - 1 depth: self depth! !

!Form methodsFor: 'accessing' stamp: ''!
extent
	^ width @ height! !

!Form methodsFor: 'transitions' stamp: ''!
fadeImageHorFine: otherImage at: topLeft
	"Display fadeImageHorFine: (Form fromDisplay: (10@10 extent: 300@300)) reverse at: 10@10"
	^ self fadeImage: otherImage at: topLeft indexAndMaskDo:
		[:i :mask |
		mask fill: (0@(i-1) extent: mask width@1) fillColor: Color black.
		mask fill: (0@(i-1+16) extent: mask width@1) fillColor: Color black.
		(i*2) <= mask width]! !

!Form methodsFor: 'color mapping' stamp: 'ar 5/27/2000 20:14'!
rgbaBitMasks
	"Return the masks for specifying the R,G,B, and A components in the receiver"
	self depth <= 8
		ifTrue:[^#(16rFF0000 16rFF00 16rFF 16rFF000000)].
	self depth = 16
		ifTrue:[^#(16r7C00 16r3E0 16r1F 16r0)].
	self depth = 32
		ifTrue:[^#(16rFF0000 16rFF00 16rFF 16rFF000000)].
	self error:'Bad depth for form'! !

!Form methodsFor: 'transitions' stamp: ''!
fadeImageHor: otherImage at: topLeft
	"Display fadeImageHor: (Form fromDisplay: (10@10 extent: 300@300)) reverse at: 10@10"
	^ self fadeImage: otherImage at: topLeft indexAndMaskDo:
		[:i :mask |
		mask fill: (0@(mask height//2-i) extent: mask width@(i*2)) fillColor: Color black.
		(i*2) <= mask width]! !

!Form methodsFor: 'displaying' stamp: 'StephaneDucasse 10/25/2013 16:14'!
paintBits: sourceForm at: destOrigin translucent: factor
	"Make up a BitBlt table and copy the bits with the given colorMap."
	(BitBlt destForm: self
		sourceForm: sourceForm
		halftoneForm: nil
		combinationRule: 31
		destOrigin: destOrigin
		sourceOrigin: 0@0
		extent: sourceForm extent
		clipRect: self boundingBox)
		copyBitsTranslucent: ((0 max: (factor*255.0) asInteger) min: 255)
"
 | f f2 f3 | f := Form fromUser. f replaceColor: f peripheralColor withColor: Color transparent.
f2 := Form fromDisplay: (0@0 extent: f extent). f3 := f2 deepCopy.
0.0 to: 1.0 by: 1.0/32 do:
	[:t | f3 := f2 deepCopy. f3 paintBits: f at: 0@0 translucent: t.
	f3 displayAt: 0@0. (Delay forMilliseconds: 100) wait].
"! !

!Form methodsFor: 'testing' stamp: 'ar 5/28/2000 14:58'!
shouldPreserveContents
	"Return true if the receiver should preserve it's contents when flagged to be clean. Most forms can not be trivially restored by some drawing operation but some may."
	^true! !

!Form methodsFor: 'analyzing' stamp: 'StephaneDucasse 10/25/2013 16:16'!
tallyPixelValuesInRect: destRect into: valueTable
	"Tally the selected pixels of this Form into valueTable, a Bitmap of depth 2^depth similar to a color map. Answer valueTable."

	(BitBlt toForm: self)
		sourceForm: self;  "src must be given for color map ops"
		sourceOrigin: 0@0;
		tallyMap: valueTable;
		combinationRule: 33;
		destRect: destRect;
		copyBits.
	^ valueTable

"
Move a little rectangle around the screen and print its tallies...
 | r tallies nonZero |
Cursor blank showWhile: [
[Sensor anyButtonPressed] whileFalse:
	[r := Sensor cursorPoint extent: 10@10.
	Display border: (r expandBy: 2) width: 2 rule: Form reverse fillColor: nil.
	tallies := (Display copy: r) tallyPixelValues.
	nonZero := (1 to: tallies size) select: [:i | (tallies at: i) > 0]
			thenCollect: [:i | (tallies at: i) -> (i-1)].
	nonZero printString , '          ' displayAt: 0@0.
	Display border: (r expandBy: 2) width: 2 rule: Form reverse fillColor: nil]]
"! !

!Form methodsFor: 'testing' stamp: 'ar 5/17/2001 15:47'!
isLittleEndian
	"Return true if the receiver contains little endian pixels, meaning the left-most pixel is stored in the least significant bits of a word."
	^depth < 0! !

!Form methodsFor: 'scaling, rotation' stamp: ''!
magnify: aRectangle by: scale 
	"Answer a Form created as a scaling of the receiver.
	Scale may be a Float, and may be greater or less than 1.0."
	^ self magnify: aRectangle by: scale smoothing: 1

"Dynamic test...
[Sensor anyButtonPressed] whileFalse:
	[(Display magnify: (Sensor cursorPoint extent: 31@41) by: 5@3) display]
"
"Scaling test...
| f cp | f := Form fromDisplay: (Rectangle originFromUser: 100@100).
Display restoreAfter: [Sensor waitNoButton.
[Sensor anyButtonPressed] whileFalse:
	[cp := Sensor cursorPoint.
	(f magnify: f boundingBox by: (cp x asFloat@cp y asFloat)/f extent) display]]
"
"Consistency test...
 | f f2 p | [Sensor anyButtonPressed] whileFalse:
	[f := Form fromDisplay: ((p := Sensor cursorPoint) extent: 31@41).
	Display fillBlack: (p extent: 31@41).
	f2 := f magnify: f boundingBox by: 5@3.
	(f2 shrink: f2 boundingBox by: 5@3) displayAt: p]
"
! !

!Form methodsFor: 'scaling, rotation' stamp: 'tpr 9/28/2004 17:00'!
magnify: aRectangle by: scale smoothing: cellSize
        "Answer a Form created as a scaling of the receiver.
        Scale may be a Float or even a Point, and may be greater or less than 1.0."
        | newForm |
        newForm := self blankCopyOf: aRectangle scaledBy: scale.
        (WarpBlt current toForm: newForm)
                sourceForm: self;
                colorMap: (self colormapIfNeededFor: newForm);
                cellSize: cellSize;  "installs a new colormap if cellSize > 1"
                combinationRule: 3;
                copyQuad: aRectangle innerCorners toRect: newForm boundingBox.
        ^ newForm

"Dynamic test...
[Sensor anyButtonPressed] whileFalse:
        [(Display magnify: (Sensor cursorPoint extent: 131@81) by: 0.5 smoothing: 2) display]
"
"Scaling test...
| f cp | f := Form fromDisplay: (Rectangle originFromUser: 100@100).
Display restoreAfter: [Sensor waitNoButton.
[Sensor anyButtonPressed] whileFalse:
        [cp := Sensor cursorPoint.
        (f magnify: f boundingBox by: (cp x asFloat@cp y asFloat)/f extent smoothing: 2) display]]
"! !

!Form methodsFor: 'resources' stamp: 'ar 2/27/2001 14:56'!
resourceTag
	^'FORM'! !

!Form methodsFor: 'copying' stamp: 'StephaneDucasse 10/25/2013 16:13'!
copyBits: sourceRect from: sourceForm at: destOrigin clippingBox: clipRect rule: rule fillColor: aForm 
	"Make up a BitBlt table and copy the bits."

	(BitBlt  
		destForm: self
		sourceForm: sourceForm
		fillColor: aForm
		combinationRule: rule
		destOrigin: destOrigin
		sourceOrigin: sourceRect origin
		extent: sourceRect extent
		clipRect: clipRect) copyBits! !

!Form methodsFor: 'copying' stamp: 'StephaneDucasse 10/25/2013 16:13'!
copyBits: sourceForm at: destOrigin translucent: factor
	"Make up a BitBlt table and copy the bits with the given colorMap."
	(BitBlt  
		destForm: self
		sourceForm: sourceForm
		halftoneForm: nil
		combinationRule: 30
		destOrigin: destOrigin
		sourceOrigin: 0@0
		extent: sourceForm extent
		clipRect: self boundingBox)
		copyBitsTranslucent: ((0 max: (factor*255.0) asInteger) min: 255)
"
 | f f2 f3 | f := Form fromUser. f2 := Form fromDisplay: (0@0 extent: f extent). f3 := f2 deepCopy.
0.0 to: 1.0 by: 1.0/32 do:
	[:t | f3 := f2 deepCopy. f3 copyBits: f at: 0@0 translucent: t.
	f3 displayAt: 0@0. (Delay forMilliseconds: 100) wait].
"! !

!Form methodsFor: 'copying' stamp: 'RAA 9/28/1999 11:20'!
blankCopyOf: aRectangle scaledBy: scale

        ^ self class extent: (aRectangle extent * scale) truncated depth: depth! !

!Form methodsFor: 'color mapping' stamp: 'ar 5/15/2001 16:16'!
colormapToARGB
	"Return a ColorMap mapping from the receiver into canonical ARGB space."
	self hasNonStandardPalette 
		ifTrue:[^self colormapFromARGB inverseMap].
	self depth <= 8 ifTrue:[
		^ColorMap
			shifts: #(0 0 0 0)
			masks: #(16rFF0000 16rFF00 16rFF 16rFF000000)
			colors: (Color colorMapIfNeededFrom: self depth to: 32)].
	self depth = 16 ifTrue:[
		^ColorMap 
			shifts: #( 9 6 3 0) 
			masks: #(16r7C00 16r3E0 16r1F 0)].
	self depth = 32 ifTrue:[
		^ColorMap
			shifts: #(0 0 0 0) 
			masks: #(16rFF0000 16rFF00 16rFF 16rFF000000)].
	self error:'Bad depth'! !

!Form methodsFor: 'bordering' stamp: 'EstebanLorenzano 5/3/2014 13:58'!
borderWidth: anInteger 
	"Set the width of the border for the receiver to be anInteger and paint it 
	using black as the border color."

	self 
		border: self boundingBox 
		width: anInteger 
		fillColor: Smalltalk ui theme borderColor! !

!Form methodsFor: 'accessing' stamp: 'MarcusDenker 9/13/2013 14:04'!
depth: bitsPerPixel
	(bitsPerPixel > 32 or:
		[(bitsPerPixel bitAnd: bitsPerPixel-1) ~= 0])
		ifTrue: [self error: 'bitsPerPixel must be 1, 2, 4, 8, 16 or 32'].
	depth := bitsPerPixel! !

!Form methodsFor: 'printing' stamp: 'di 3/15/1999 14:50'!
printOn: aStream
    aStream
        nextPutAll: self class name;
        nextPut: $(; print: width;
        nextPut: $x; print: height;
        nextPut: $x; print: depth;
        nextPut: $).
! !

!Form methodsFor: 'filein/out' stamp: ''!
storeHexBitsOn:aStream
	^self storeBits:28 to:0 on:aStream.! !

!Form methodsFor: 'displaying' stamp: 'ar 3/2/2001 21:32'!
displayScaledOn: aForm
	"Display the receiver on aForm, scaling if necessary.
		Form fromUser displayScaledOn: Display.
	"
	self extent = aForm extent ifTrue:[^self displayOn: aForm].
	(WarpBlt current toForm: aForm)
		sourceForm: self destRect: aForm boundingBox;
		combinationRule: Form paint;
		cellSize: 2;
		warpBits.! !

!Form methodsFor: 'converting' stamp: 'HenrikSperreJohansen 5/26/2010 15:59'!
lighter: aFactor
	"Answer a lighter variant of this form. aFactor is a float from 0 to 1 representing the strength of 
	the lightening."
	"(Form fromUser lighter: 0.16) asMorph openInWorld"
	"(Form fromUser lighter: 0.30) asMorph openInWorld"
	^self collectColors: [:color | 
			color adjustSaturation: -0.03 brightness: aFactor]! !

!Form methodsFor: 'accessing' stamp: ''!
width
	^ width! !

!Form methodsFor: 'filein/out' stamp: ''!
storeOn: aStream

	self storeOn: aStream base: 10! !

!Form methodsFor: 'accessing' stamp: 'tk 3/9/97'!
center
	"Note that offset is ignored here.  Are we really going to embrace offset?  "
	^ (width @ height) // 2! !

!Form methodsFor: 'filling' stamp: 'StephaneDucasse 10/25/2013 16:13'!
fill: aRectangle rule: anInteger fillColor: aForm 
	"Replace a rectangular area of the receiver with the pattern described by aForm 
	according to the rule anInteger."
	(BitBlt toForm: self)
		copy: aRectangle
		from: 0@0 in: nil
		fillColor: aForm rule: anInteger! !

!Form methodsFor: 'scaling, rotation' stamp: 'RAA 7/13/2000 12:09'!
scaledToSize: newExtent

	| scale |

	newExtent = self extent ifTrue: [^self].
	scale := newExtent x / self width min: newExtent y / self height.
	^self magnify: self boundingBox by: scale smoothing: 2.
! !

!Form methodsFor: 'displaying' stamp: 'MarcusDenker 10/2/2013 20:21'!
displayResourceFormOn: aForm
	"a special display method for blowing up resource thumbnails"
	
	self extent = aForm extent
		ifTrue: [ ^ self displayOn: aForm ].

	"We've got no bilinear interpolation. Use WarpBlt instead"
	(WarpBlt current toForm: aForm)
		sourceForm: self destRect: aForm boundingBox;
		combinationRule: 3;
		cellSize: 2;
		warpBits.
! !

!Form methodsFor: 'color mapping' stamp: 'ar 5/15/2001 16:16'!
colormapFromARGB
	"Return a ColorMap mapping from canonical ARGB space into the receiver.
	Note: This version is optimized for Squeak forms."
	| map nBits |
	self hasNonStandardPalette 
		ifTrue:[^ColorMap mappingFromARGB: self rgbaBitMasks].
	self depth <= 8 ifTrue:[
		map := Color colorMapIfNeededFrom: 32 to: self depth.
		map size = 512 ifTrue:[nBits := 3].
		map size = 4096 ifTrue:[nBits := 4].
		map size = 32768 ifTrue:[nBits := 5].
		^ColorMap
			shifts: (Array 
						with: 3 * nBits - 24
						with: 2 * nBits - 16
						with: 1 * nBits - 8
						with: 0)
			masks: (Array
						with: (1 << nBits) - 1 << (24 - nBits)
						with: (1 << nBits) - 1 << (16 - nBits)
						with: (1 << nBits) - 1 << (8 - nBits)
						with: 0)
			colors: map].
	self depth = 16 ifTrue:[
		^ColorMap
			shifts: #(-9 -6 -3 0)
			masks: #(16rF80000 16rF800 16rF8 0)].
	self depth = 32 ifTrue:[
		^ColorMap
			shifts: #(0 0 0 0)
			masks: #(16rFF0000 16rFF00 16rFF 16rFF000000)].
	self error:'Bad depth'! !

!Form methodsFor: 'scaling, rotation' stamp: 'nice 1/5/2010 15:59'!
rotateBy: deg magnify: scale smoothing: cellSize
	"Rotate the receiver by the indicated number of degrees and magnify. scale can be a Point to make for interesting 3D effects "
	"rot is the destination form, big enough for any angle."

	| side rot warp r1 pts bigSide |
	side := 1 + self extent r asInteger.
	bigSide := (side asPoint * scale) rounded.
	rot := self blankCopyOf: self boundingBox scaledBy: ( bigSide / self extent ).
	warp := (WarpBlt current toForm: rot)
		sourceForm: self;
		colorMap: (self colormapIfNeededFor: rot);
		cellSize: cellSize;  "installs a new colormap if cellSize > 1"
		combinationRule: Form paint.
	r1 := (0@0 extent: side@side) align: (side@side)//2 with: self boundingBox center.

	"Rotate the corners of the source rectangle." 
	pts := r1 innerCorners collect:
		[:pt | | p | p := pt - r1 center.
		(r1 center x asFloat + (p x asFloat*deg degreeCos) + (p y asFloat*deg degreeSin)) @
		(r1 center y asFloat - (p x asFloat*deg degreeSin) + (p y asFloat*deg degreeCos))].
	warp copyQuad: pts toRect: rot boundingBox.
	^ rot
"
 | a f |  f := Form fromDisplay: (0@0 extent: 200@200).  a := 0.
[Sensor anyButtonPressed] whileFalse:
	[((Form fromDisplay: (Sensor cursorPoint extent: 130@66))
		rotateBy: (a := a+5) magnify: 0.75@2 smoothing: 2) display].
f display
"! !

!Form methodsFor: 'scaling, rotation' stamp: ''!
shrink: aRectangle by: scale 
	| scalePt |
	scalePt := scale asPoint.
	^ self magnify: aRectangle by: (1.0 / scalePt x asFloat) @ (1.0 / scalePt y asFloat)! !

!Form methodsFor: 'accessing' stamp: ''!
offset: aPoint

	offset := aPoint! !

!Form methodsFor: 'filein/out' stamp: 'ar 3/3/2001 15:50'!
unhibernate
	"If my bitmap has been compressed into a ByteArray,
	then expand it now, and return true."
	| resBits |
	bits isForm ifTrue:[
		resBits := bits.
		bits := Bitmap new: self bitsSize.
		resBits displayResourceFormOn: self.
		^true].
	bits == nil ifTrue:[bits := Bitmap new: self bitsSize. ^true].
	(bits isMemberOf: ByteArray)
		ifTrue: [bits := Bitmap decompressFromByteArray: bits. ^ true].
	^ false! !

!Form methodsFor: 'testing' stamp: 'RAA 8/14/2000 10:00'!
isStatic

	^false! !

!Form methodsFor: 'color mapping' stamp: 'ar 12/14/2001 18:11'!
maskingMap
	"Return a color map that maps all colors except transparent to words of all ones. Used to create a mask for a Form whose transparent pixel value is zero."
	^Color maskingMap: self depth! !

!Form methodsFor: 'filein/out' stamp: 'mu 8/17/2003 00:35'!
writeAttributesOn: file
	self unhibernate.
	file nextPut: depth.
	file nextWordPut: width.
	file nextWordPut: height.
	file nextWordPut: ((self offset x) >=0
					ifTrue: [self offset x]
					ifFalse: [self offset x + 65536]).
	file nextWordPut: ((self offset y) >=0
					ifTrue: [self offset y]
					ifFalse: [self offset y + 65536]).
	! !

!Form methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 7/14/2014 06:51'!
gtInspectorFormIn: composite
	<gtInspectorPresentationOrder: 90>  
	^ composite morph 
		title: 'Morph';
		display: [ self asMorph ]! !

!Form methodsFor: 'filling' stamp: ''!
fillFromYColorBlock: colorBlock
	"Vertical Gradient Fill.
	Supply relative y in [0.0 ... 1.0] to colorBlock,
	and paint each pixel with the color that comes back"
	| yRel |
	0 to: height-1 do:
		[:y |  yRel := y asFloat / (height-1) asFloat.
		self fill: (0@y extent: width@1) 
			fillColor: (colorBlock value: yRel)]
"
((Form extent: 100@100 depth: Display depth)
	fillFromYColorBlock: [:y | Color r: y g: 0.0 b: 0.5]) display
"! !

!Form methodsFor: 'bordering' stamp: ''!
borderWidth: anInteger color: aMask
	"Set the width of the border for the receiver to be anInteger and paint it 
	using aMask as the border color."

	self border: self boundingBox width: anInteger fillColor: aMask! !

!Form methodsFor: 'private' stamp: ''!
initFromArray: array
	"Fill the bitmap from array.  If the array is shorter,
	then cycle around in its contents until the bitmap is filled."
	| ax aSize array32 i j word16 |
	ax := 0.
	aSize := array size.
	aSize > bits size ifTrue:
		["backward compatibility with old 16-bit bitmaps and their forms"
		array32 := Array new: height * (width + 31 // 32).
		i := j := 0.
		1 to: height do:
			[:y | 1 to: width+15//16 do:
				[:x16 | word16 := array at: (i := i + 1).
				x16 odd ifTrue: [array32 at: (j := j+1) put: (word16 bitShift: 16)]
						ifFalse: [array32 at: j put: ((array32 at: j) bitOr: word16)]]].
		^ self initFromArray: array32].
	1 to: bits size do:
		[:index |
		(ax := ax + 1) > aSize ifTrue: [ax := 1].
		bits at: index put: (array at: ax)]! !

!Form methodsFor: 'pixel access' stamp: 'ar 5/17/2001 15:42'!
colorAt: aPoint
	"Return the color in the pixel at the given point.  "

	^ Color 
		colorFromPixelValue: (self pixelValueAt: aPoint)
		depth: self depth
! !

!Form methodsFor: 'converting' stamp: 'StephaneDucasse 3/27/2010 21:30'!
darker
	"Answer a darker variant of this form."
	
	^ self darker: 0.16! !

!Form methodsFor: 'copying' stamp: ''!
copy: sourceRectangle from: sourceForm to: destPt rule: rule
	^ self copy: (destPt extent: sourceRectangle extent)
		from: sourceRectangle topLeft in: sourceForm rule: rule! !

!Form methodsFor: 'pixel access' stamp: 'StephaneDucasse 10/25/2013 16:14'!
pixelValueAt: aPoint 
	"Return the raw pixel value at the given point. This pixel value depends on the receiver's depth. Typical clients use colorAt: to get a Color.  "

	^ (BitBlt bitPeekerFromForm: self) pixelAt: aPoint
! !

!Form methodsFor: 'display box access' stamp: ''!
computeBoundingBox
	^ Rectangle origin: 0 @ 0
			corner: width @ height! !

!Form methodsFor: 'image manipulation' stamp: 'jm 6/30/1999 15:36'!
trimBordersOfColor: aColor
	"Answer a copy of this Form with each edge trimmed in to the first pixel that is not of the given color. (That is, border strips of the given color are removed)."

	| r |
	r := self rectangleEnclosingPixelsNotOfColor: aColor.
	^ self copy: r
! !

!Form methodsFor: 'scaling, rotation' stamp: ''!
rotateBy: deg
	"Rotate the receiver by the indicated number of degrees."
	"rot is the destination form, bit enough for any angle."

	^ self rotateBy: deg smoothing: 1
"
 | a f |  f := Form fromDisplay: (0@0 extent: 200@200).  a := 0.
[Sensor anyButtonPressed] whileFalse:
	[((Form fromDisplay: (Sensor cursorPoint extent: 130@66))
		rotateBy: (a := a+5)) display].
f display
"! !

!Form methodsFor: 'copying' stamp: 'StephaneDucasse 10/25/2013 16:13'!
copyBits: sourceRect from: sourceForm at: destOrigin clippingBox: clipRect rule: rule fillColor: aForm map: map
	"Make up a BitBlt table and copy the bits.  Use a colorMap."

	((BitBlt  
		destForm: self
		sourceForm: sourceForm
		fillColor: aForm
		combinationRule: rule
		destOrigin: destOrigin
		sourceOrigin: sourceRect origin
		extent: sourceRect extent
		clipRect: clipRect) colorMap: map) copyBits! !

!Form methodsFor: 'converting' stamp: 'nice 1/5/2010 15:59'!
copyWithColorsReducedTo: nColors
	"Note: this has not been engineered.
	There are better solutions in the literature."
	| palette colorMap |
	palette := self reducedPaletteOfSize: nColors.
	colorMap := (1 to: (1 bitShift: depth)) collect:
		[:i | | pc closest | pc := Color colorFromPixelValue: i-1 depth: depth.
		closest := palette detectMin: [:c | c diff: pc].
		closest pixelValueForDepth: depth].
	^ self deepCopy copyBits: self boundingBox from: self at: 0@0 colorMap: (colorMap as: Bitmap)
		! !

!Form methodsFor: 'scaling, rotation' stamp: 'wiz 1/22/2006 01:15'!
rotateBy: direction centerAt: aPoint
	"Return a rotated copy of the receiver. 
	direction = #none, #right, #left, or #pi"
	| newForm quad rot scale |
	direction == #none ifTrue: [^ self].
	scale :=  (direction = #pi ifTrue: [width@height] ifFalse: [height@width]) / self extent .
	newForm := self blankCopyOf: self boundingBox scaledBy: scale.
	quad := self boundingBox innerCorners.
	rot := #(right pi left) indexOf: direction.
	(WarpBlt current toForm: newForm)
		sourceForm: self;
		colorMap: (self colormapIfNeededFor: newForm);
		combinationRule: 3;
		copyQuad: ((1+rot to: 4+rot) collect: [:i | quad atWrap: i])
			 toRect: newForm boundingBox.
	newForm offset: (self offset rotateBy: direction centerAt: aPoint).
	^ newForm
"
[Sensor anyButtonPressed] whileFalse:
	[((Form fromDisplay: (Sensor cursorPoint extent: 130@66))
		rotateBy: #left centerAt: 0@0) display]
"
"Consistency test...
 | f f2 p | [Sensor anyButtonPressed] whileFalse:
	[f := Form fromDisplay: ((p := Sensor cursorPoint) extent: 31@41).
	Display fillBlack: (p extent: 31@41).
	f2 := f rotateBy: #left centerAt: 0@0.
	(f2 rotateBy: #right centerAt: 0@0) displayAt: p]
"
! !

!Form methodsFor: 'filling' stamp: ''!
fillFromXColorBlock: colorBlock
	"Horizontal Gradient Fill.
	Supply relative x in [0.0 ... 1.0] to colorBlock,
	and paint each pixel with the color that comes back"
	| xRel |
	0 to: width-1 do:
		[:x |  xRel := x asFloat / (width-1) asFloat.
		self fill: (x@0 extent: 1@height) 
			fillColor: (colorBlock value: xRel)]
"
((Form extent: 100@100 depth: Display depth)
	fillFromXColorBlock: [:x | Color r: x g: 0.0 b: 0.5]) display
"! !

!Form methodsFor: 'converting' stamp: 'ar 4/2/2010 22:35'!
collectPixels: aBlock
	"Create a new copy of the receiver with all the pixels transformed by aBlock"
	self depth = 32 ifFalse:[
		"Perform the operation in 32bpp"
		^((self asFormOfDepth: 32) collectPixels: aBlock) asFormOfDepth: self depth].
	self unhibernate. "ensure unhibernated before touching bits"
	^Form 
		extent: self extent 
		depth: self depth
		bits: (self bits collect: aBlock)! !

!Form methodsFor: 'displaying' stamp: 'StephaneDucasse 10/25/2013 16:13'!
drawLine: sourceForm from: beginPoint to: endPoint clippingBox: clipRect rule: anInteger fillColor: aForm 
	"Refer to the comment in 
	DisplayMedium|drawLine:from:to:clippingBox:rule:mask:." 
	
	| dotSetter |
	"set up an instance of BitBlt for display"
	dotSetter := BitBlt 
		destForm: self
		sourceForm: sourceForm
		fillColor: aForm
		combinationRule: anInteger
		destOrigin: beginPoint
		sourceOrigin: 0 @ 0
		extent: sourceForm extent
		clipRect: clipRect.
	dotSetter drawFrom: beginPoint to: endPoint! !

!Form methodsFor: 'transitions' stamp: 'Jb 11/19/2010 15:45'!
fadeImageFine: otherImage at: topLeft
	"Display fadeImageFine: (Form fromDisplay: (40@40 extent: 300@300)) reverse at: 40@40"
	| d pix|
	d := self depth.
	^ self fadeImage: otherImage at: topLeft indexAndMaskDo:
		[:i :mask | | j ii  |
		i=1 ifTrue: [pix := (1 bitShift: d) - 1.
					1 to: 8//d-1 do:
						[:q | pix := pix bitOr: (pix bitShift: d*4)]].
		i <= 16 ifTrue:
		[ii := #(0 10 2 8 7 13 5 15 1 11 3 9 6 12 4 14) at: i.
		j := ii//4+1.
		(0 to: 28 by: 4) do:
			[:k | mask bits at: j+k put:
				((mask bits at: j+k) bitOr: (pix))].
		true]
		ifFalse: [false]]! !

!Form methodsFor: 'accessing' stamp: 'ar 5/17/2001 15:50'!
nativeDepth
	"Return the 'native' depth of the receiver, e.g., including the endianess"
	^depth! !

!Form methodsFor: 'analyzing' stamp: 'StephaneDucasse 10/25/2013 16:14'!
pixelCompare: aRect with: otherForm at: otherLoc
	"Compare the selected bits of this form (those within aRect) against
	those in a similar rectangle of otherFrom.  Return the sum of the
	absolute value of the differences of the color values of every pixel.
	Obviously, this is most useful for rgb (16- or 32-bit) pixels but,
	in the case of 8-bits or less, this will return the sum of the differing
	bits of the corresponding pixel values (somewhat less useful)"
	| pixPerWord temp |
	pixPerWord := 32//self depth.
	(aRect left\\pixPerWord = 0 and: [aRect right\\pixPerWord = 0]) ifTrue:
		["If word-aligned, use on-the-fly difference"
		^ (BitBlt toForm: self) copy: aRect from: otherLoc in: otherForm
				fillColor: nil rule: 32].
	"Otherwise, combine in a word-sized form and then compute difference"
	temp := self copy: aRect.
	temp copy: aRect from: otherLoc in: otherForm rule: 21.
	^ (BitBlt toForm: temp) copy: aRect from: otherLoc in: nil
				fillColor: (Bitmap with: 0) rule: 32
"  Dumb example prints zero only when you move over the original rectangle...
 | f diff | f := Form fromUser.
[Sensor anyButtonPressed] whileFalse:
	[diff := f pixelCompare: f boundingBox
		with: Display at: Sensor cursorPoint.
	diff printString , '        ' displayAt: 0@0]
"! !

!Form methodsFor: 'private' stamp: 'ar 5/28/2000 15:49'!
setExtent: extent depth: bitsPerPixel bits: bitmap
	"Create a virtual bit map with the given extent and bitsPerPixel."

	width := extent x asInteger.
	width < 0 ifTrue: [width := 0].
	height := extent y asInteger.
	height < 0 ifTrue: [height := 0].
	depth := bitsPerPixel.
	(bits isNil or:[self bitsSize = bitmap size]) ifFalse:[^self error:'Bad dimensions'].
	bits := bitmap! !

!Form methodsFor: 'scaling, rotation' stamp: 'tpr 9/28/2004 16:55'!
rotateBy: deg smoothing: cellSize
	"Rotate the receiver by the indicated number of degrees."
	^self rotateBy: deg magnify: 1 smoothing: cellSize
"
 | a f |  f := Form fromDisplay: (0@0 extent: 200@200).  a := 0.
[Sensor anyButtonPressed] whileFalse:
	[((Form fromDisplay: (Sensor cursorPoint extent: 130@66))
		rotateBy: (a := a+5) smoothing: 2) display].
f display
"! !

!Form methodsFor: 'resources' stamp: 'StephaneDucasse 3/17/2010 20:57'!
storeResourceOn: aStream
	"Store a resource representation of the receiver on aStream.
	Must be specific to the receiver so that no code is filed out."
	self hibernate.
	aStream nextPutAll: self resourceTag asByteArray. "tag"
	aStream nextNumber: 4 put: width.
	aStream nextNumber: 4 put: height.
	aStream nextNumber: 4 put: depth.
	(bits isMemberOf: ByteArray) ifFalse:
		"must store bitmap"
		[aStream nextNumber: 4 put: 0. "tag"
		aStream nextNumber: 4 put: (Smalltalk  isBigEndian ifTrue:[1] ifFalse: [0])].
	aStream nextNumber: 4 put: bits size.
	aStream nextPutAll: bits.
! !

!Form methodsFor: '*Morphic-Core' stamp: 'ar 5/28/2000 12:03'!
getCanvas
	"Return a Canvas that can be used to draw onto the receiver"
	^self defaultCanvasClass on: self! !

!Form methodsFor: 'color mapping' stamp: 'StephaneDucasse 10/25/2013 16:14'!
mapColors: oldColorBitsCollection to: newColorBits
	"Make all pixels of the given color in this Form to the given new color."
	"Warnings: This method modifies the receiver. It may lose some color accuracy on 32-bit Forms, since the transformation uses a color map with only 15-bit resolution."

	| map |
	self depth < 16
		ifTrue: [map := (Color cachedColormapFrom: self depth to: self depth) copy]
		ifFalse: [
			"use maximum resolution color map"
			"source is 16-bit or 32-bit RGB; use colormap with 5 bits per color component"
			map := Color computeRGBColormapFor: self depth bitsPerColor: 5].
	oldColorBitsCollection do:[ :oldColor | map at: oldColor put: newColorBits].

	(BitBlt toForm: self)
		sourceForm: self;
		sourceOrigin: 0@0;
		combinationRule: Form over;
		destX: 0 destY: 0 width: width height: height;
		colorMap: map;
		copyBits.
! !

!Form methodsFor: 'bordering' stamp: ''!
borderWidth: anInteger fillColor: aMask
	"Set the width of the border for the receiver to be anInteger and paint it 
	using aMask as the border color."

	self border: self boundingBox width: anInteger fillColor: aMask! !

!Form methodsFor: '*Graphics-Files' stamp: 'ar 6/16/2002 17:53'!
writeBMPfileNamed: fName  "Display writeBMPfileNamed: 'display.bmp'"
	BMPReadWriter putForm: self onFileNamed: fName! !

!Form methodsFor: 'testing' stamp: 'ar 2/10/2004 17:18'!
isTranslucent
	"Answer whether this form may be translucent"
	^self depth = 32! !

!Form methodsFor: 'converting' stamp: 'StephaneDucasse 3/27/2010 21:38'!
lighter
	"Answer a lighter variant of this form"

	^ self lighter: 0.16! !

!Form methodsFor: 'private' stamp: '6/9/97 16:10 di'!
setExtent: extent depth: bitsPerPixel
	"Create a virtual bit map with the given extent and bitsPerPixel."

	width := extent x asInteger.
	width < 0 ifTrue: [width := 0].
	height := extent y asInteger.
	height < 0 ifTrue: [height := 0].
	depth := bitsPerPixel.
	bits := Bitmap new: self bitsSize! !

!Form methodsFor: 'testing' stamp: 'ar 5/17/2001 15:46'!
isBigEndian
	"Return true if the receiver contains big endian pixels, meaning the left-most pixel is stored in the most significant bits of a word."
	^depth > 0! !

!Form methodsFor: 'initialization' stamp: ''!
fromDisplay: aRectangle 
	"Create a virtual bit map from a user specified rectangular area on the 
	display screen. Reallocates bitmap only if aRectangle ~= the receiver's 
	extent."

	(width = aRectangle width and: [height = aRectangle height])
		ifFalse: [self setExtent: aRectangle extent depth: depth].
	self
		copyBits: (aRectangle origin extent: self extent)
		from: Display
		at: 0 @ 0
		clippingBox: self boundingBox
		rule: Form over
		fillColor: nil! !

!Form methodsFor: 'image manipulation' stamp: 'StephaneDucasse 10/25/2013 16:16'!
smear: dir distance: dist
	"Smear any black pixels in this form in the direction dir in Log N steps"
	| skew bb |
	bb := BitBlt destForm: self sourceForm: self fillColor: nil
		combinationRule: Form under destOrigin: 0@0 sourceOrigin: 0@0
		extent: self extent clipRect: self boundingBox.
	skew := 1.
	[skew < dist] whileTrue:
		[bb destOrigin: dir*skew; copyBits.
		skew := skew+skew]! !

!Form methodsFor: '*Graphics-Files' stamp: 'ar 12/9/2002 16:04'!
readNativeResourceFrom: byteStream
	| img aStream |
	(byteStream isKindOf: FileStream) ifTrue:[
		"Ugly, but ImageReadWriter will send #reset which is implemented as #reopen and we may not be able to do so."
		aStream := RWBinaryOrTextStream with: byteStream contents.
	] ifFalse:[
		aStream := byteStream.
	].
	img := [ImageReadWriter formFromStream: aStream] on: Error do:[:ex| nil].
	img ifNil:[^nil].
	(img isColorForm and:[self isColorForm]) ifTrue:[
		| cc |
		cc := img colors.
		img colors: nil.
		img displayOn: self.
		img colors: cc.
	] ifFalse:[
		img displayOn: self.
	].
	img := nil.! !

!Form methodsFor: 'testing' stamp: 'ar 5/28/2000 14:58'!
isFillAccelerated: ruleInteger for: aColor
	"Return true if the receiver can perform accelerated fill operations by itself"
	^false! !

!Form methodsFor: '*Polymorph-Widgets-Themes' stamp: 'EstebanLorenzano 5/10/2013 15:28'!
mergeWith: aForm at: aPoint
	| mergedForm |

	mergedForm := self deepCopy.
	mergedForm getCanvas 
		translucentImage: aForm 
		at: aPoint. 
		
	^ mergedForm ! !

!Form methodsFor: '*Athens-Core' stamp: 'IgorStasenko 3/8/2012 13:45'!
asAthensPaintOn: canvas 

	^ canvas surface createFormPaint: self! !

!Form methodsFor: 'filein/out' stamp: 'jm 3/27/98 16:54'!
readFromOldFormat: aBinaryStream
	"Read a Form in the original ST-80 format."

	| w h offsetX offsetY newForm theBits pos |
	self error: 'this method must be updated to read into 32-bit word bitmaps'.
	w := aBinaryStream nextWord.
	h := aBinaryStream nextWord.
	offsetX  := aBinaryStream nextWord.
	offsetY := aBinaryStream nextWord.
	offsetX > 32767 ifTrue: [offsetX := offsetX - 65536].
	offsetY > 32767 ifTrue: [offsetY := offsetY - 65536].
	newForm := Form extent: w @ h offset: offsetX @ offsetY.
	theBits := newForm bits.
	pos := 0.
	1 to: w + 15 // 16 do: [:j |
		1 to: h do: [:i |
			theBits at: (pos := pos+1) put: aBinaryStream nextWord]].
	newForm bits: theBits.
	^ newForm
! !

!Form methodsFor: 'filein/out' stamp: 'mu 8/17/2003 00:36'!
writeOn: file
	"Write the receiver on the file in the format
		depth, extent, offset, bits."
	self writeAttributesOn: file.
	self writeBitsOn: file! !

!Form methodsFor: 'filling' stamp: 'di 9/11/1998 16:25'!
convexShapeFill: aMask 
	"Fill the interior of the outtermost outlined region in the receiver.  The outlined region must not be concave by more than 90 degrees.  Typically aMask is Color black, to produce a solid fill. then the resulting form is used with fillShape: to paint a solid color.  See also anyShapeFill"
	| destForm tempForm |
	destForm := Form extent: self extent.  destForm fillBlack.
	tempForm := Form extent: self extent.
	(0@0) fourNeighbors do:
		[:dir |  "Smear self in all 4 directions, and AND the result"
		self displayOn: tempForm at: (0@0) - self offset.
		tempForm smear: dir distance: (dir dotProduct: tempForm extent) abs.
		tempForm displayOn: destForm at: 0@0
			clippingBox: destForm boundingBox
			rule: Form and fillColor: nil].
	destForm displayOn: self at: 0@0
		clippingBox: self boundingBox
		rule: Form over fillColor: aMask! !

!Form methodsFor: 'filein/out' stamp: ''!
store32To24HexBitsOn:aStream
	^self storeBits:20 to:0 on:aStream.! !

!Form methodsFor: 'initialization' stamp: 'ar 6/16/2002 18:39'!
swapEndianness
	"Swap from big to little endian pixels and vice versa"
	depth := 0 - depth.! !

!Form methodsFor: 'transitions' stamp: 'jm 10/16/97 15:17'!
wipeImage: otherImage at: topLeft delta: delta clippingBox: clipBox

	| wipeRect bb nSteps |
	bb := otherImage boundingBox.
	wipeRect := delta x = 0
		ifTrue:
		[delta y = 0 ifTrue: [nSteps := 1. bb "allow 0@0"] ifFalse: [
		nSteps := bb height//delta y abs + 1.  "Vertical movement"
		delta y > 0
			ifTrue: [bb topLeft extent: bb width@delta y]
			ifFalse: [bb bottomLeft+delta extent: bb width@delta y negated]]]
		ifFalse:
		[nSteps := bb width//delta x abs + 1.  "Horizontal movement"
		delta x > 0
			ifTrue: [bb topLeft extent: delta x@bb height]
			ifFalse: [bb topRight+delta extent: delta x negated@bb height]].
	^ self wipeImage: otherImage at: topLeft clippingBox: clipBox rectForIndex:
		[:i | i <= nSteps
			ifTrue: [wipeRect translateBy: (delta* (i-1))]
			ifFalse: [nil]]! !

!Form methodsFor: 'other' stamp: 'jm 9/27/97 21:02'!
formForColorCount: colorCount
	"Return a ColorForm of sufficient depth to represent the given number of colors. The maximum number of colors is 256."

	colorCount > 256 ifTrue: [^ self error: 'too many colors'].

	colorCount > 16 ifTrue: [^ ColorForm extent: self extent depth: 8].
	colorCount > 4 ifTrue: [^ ColorForm extent: self extent depth: 4].
	colorCount > 2 ifTrue: [^ ColorForm extent: self extent depth: 2].
	^ ColorForm extent: self extent depth: 1
! !

!Form methodsFor: 'copying' stamp: 'ar 6/9/2000 18:59'!
contentsOfArea: aRect
 	"Return a new form which derives from the portion of the original form delineated by aRect."
	^self contentsOfArea: aRect 
		into: (self class extent: aRect extent depth: depth).! !

!Form methodsFor: 'private' stamp: 'ar 12/19/2000 16:23'!
privateFloodFillValue: aColor
	"Private. Compute the pixel value in the receiver's depth but take into account implicit color conversions by BitBlt."
	| f1 f2 bb |
	f1 := Form extent: 1@1 depth: depth.
	f2 := Form extent: 1@1 depth: 32.
	bb := BitBlt toForm: f1.
	bb fillColor: aColor; 
		destRect: (0@0 corner: 1@1); 
		combinationRule: 3; 
		copyBits.
	bb := BitBlt toForm: f2.
	bb sourceForm: f1; 
		sourceOrigin: 0@0;
		destRect: (0@0 corner: 1@1);
		combinationRule: 3;
		copyBits.
	^f2 pixelValueAt: 0@0.! !

!Form methodsFor: 'testing' stamp: 'ar 10/30/2000 23:23'!
isForm
	^true! !

!Form methodsFor: 'accessing' stamp: 'ar 5/28/2000 00:48'!
hasBeenModified
	"Return true if something *might* have been drawn into the receiver"
	^(bits == nil or:[bits class == ByteArray]) not
	"Read the above as: If the receiver has forgotten its contents (bits == nil) 
	or is still hibernated it can't be modified."! !

!Form methodsFor: 'initialization' stamp: 'ar 5/26/2000 00:45'!
flush
	"If there are any pending operations on the receiver start doing them. In time, they will show up on the receiver but not necessarily immediately after this method returns."! !

!Form methodsFor: '*Morphic-Base' stamp: 'BenjaminVanRyseghem 2/7/2014 15:20'!
asAlphaImageMorph

	^ AlphaImageMorph new image: self! !

!Form methodsFor: 'converting' stamp: 'MarcusDenker 4/10/2011 10:14'!
asCursorForm

	^ Form newFrom: self! !

!Form methodsFor: 'converting' stamp: 'CamilloBruni 9/19/2013 10:24'!
asGrayScaleWithAlpha
	"Unlike asGrayScale, this method fully preserves the alpha channel and only desaturates the form(makes grayscale)."
	^ (self asFormOfDepth: 32) collectColors: [ :c |  |l|
		l := c luminance.
		Color r:l g: l b: l alpha: c alpha ]! !

!Form class methodsFor: 'settings' stamp: 'AlainPlantec 12/10/2009 11:06'!
floodFillTolerance: aFloat
	(aFloat >= 0.0 and: [aFloat < 0.3])
		ifTrue: [FloodFillTolerance := aFloat]
		ifFalse: [FloodFillTolerance := 0.0]! !

!Form class methodsFor: 'mode constants' stamp: 'di 12/31/1998 14:02'!
paintAlpha
	"Answer the integer denoting BitBlt's paint-with-constant-alpha rule."

	^ 31! !

!Form class methodsFor: 'mode constants' stamp: ''!
and
	"Answer the integer denoting the logical 'and' combination rule."

	^1! !

!Form class methodsFor: 'shut down' stamp: 'ar 5/28/2000 23:35'!
shutDown  "Form shutDown"
	"Compress all instances in the system.  Will decompress on demand..."
	Form allInstancesDo: [:f | f hibernate].
	ColorForm allInstancesDo: [:f | f hibernate].! !

!Form class methodsFor: 'instance creation' stamp: ''!
fromDisplay: aRectangle using: oldForm
	"Like fromDisplay: only if oldForm is the right size, copy into it and answer it instead."

	((oldForm ~~ nil) and: [oldForm extent = aRectangle extent])
		ifTrue:
			[oldForm fromDisplay: aRectangle.
			 ^ oldForm]
		ifFalse:
			[^ self fromDisplay: aRectangle]! !

!Form class methodsFor: 'instance creation' stamp: 'ar 10/9/1998 23:44'!
extent: extentPoint depth: bitsPerPixel bits: aBitmap
	"Answer an instance of me with blank bitmap of the given dimensions and depth."

	^ self basicNew setExtent: extentPoint depth: bitsPerPixel bits: aBitmap! !

!Form class methodsFor: 'mode constants' stamp: ''!
paint
	"Answer the integer denoting the 'paint' combination rule."

	^25! !

!Form class methodsFor: 'mode constants' stamp: ''!
over
	"Answer the integer denoting mode over."

	^3! !

!Form class methodsFor: 'instance creation' stamp: 'ar 3/1/2006 22:50'!
fromUser: gridPoint
	"Answer an instance of me with bitmap initialized from the area of the 
	display screen designated by the user. The grid for selecting an area is 
	aPoint. Ensures that the returned form has positive extent."
	| rect |
	rect := Rectangle fromUser: gridPoint.
	^ self fromDisplay: (rect origin extent: (rect extent max: gridPoint))! !

!Form class methodsFor: '*Graphics-Files' stamp: 'PavelKrivanek 11/21/2012 21:19'!
fromBinaryStream: aBinaryStream
	"Read a Form or ColorForm from given file, using the first byte of the file to guess its format. Currently handles: GIF, uncompressed BMP, and both old and new DisplayObject writeOn: formats, JPEG, and PCX. Return nil if the file could not be read or was of an unrecognized format."

	| firstByte |
	aBinaryStream binary.
	firstByte := aBinaryStream next.
	firstByte = 1 ifTrue: [
		"old Squeakform format"
		^ self new readFromOldFormat: aBinaryStream].
	firstByte = 2 ifTrue: [
		"new Squeak form format"
		^ self new readFrom: aBinaryStream].

	"Try for JPG, GIF, or PCX..."
	"Note: The following call closes the stream."
	^ ImageReadWriter formFromStream: aBinaryStream
! !

!Form class methodsFor: '*Graphics-Files-FileRegistry' stamp: 'MarcusDenker 3/23/2011 18:28'!
services

	^ Array 
		with: self serviceOpenImageInWindow
		with: self serviceImageAsBackground ! !

!Form class methodsFor: 'initialize-release' stamp: 'GabrielOmarCotelli 6/4/2009 20:34'!
initialize

	FileServices registerFileReader: self! !

!Form class methodsFor: 'instance creation' stamp: 'StephaneDucasse 3/24/2010 10:48'!
fromUser
	"Answer an instance of me with bitmap initialized from the area of the 
	display screen designated by the user. The grid for selecting an area is 
	1@1."
	"self fromUser asMorph openInWorld"
	
	^self fromUser: 1 @ 1! !

!Form class methodsFor: '*Graphics-Files-FileRegistry' stamp: 'StephaneDucasse 11/13/2009 18:42'!
openImageInWindow: fullName 
	"Handle five file formats: GIF, JPG, PNG, Form storeOn: (run coded), and
	BMP. Fail if file format is not recognized."
	
	| image |
	image := self fromFileNamed: fullName.
	(World drawingClass withForm: image) openInWorld! !

!Form class methodsFor: 'instance creation' stamp: ''!
fromDisplay: aRectangle 
	"Answer an instance of me with bitmap initialized from the area of the 
	display screen defined by aRectangle."

	^ (self extent: aRectangle extent depth: Display depth)
		fromDisplay: aRectangle! !

!Form class methodsFor: 'instance creation' stamp: 'nice 1/5/2010 15:59'!
extent: extentPoint fromStipple: fourNibbles
	"Answer an instance of me with bitmap initialized from
	a repeating 4x4 bit stipple encoded in a 16-bit constant."
	
	^ (self extent: extentPoint depth: 1)
		initFromArray: ((1 to: 4) collect:
				[:i | | nibble | nibble := (fourNibbles bitShift: -4*(4-i)) bitAnd: 16rF.
				16r11111111 * nibble])  "fill 32 bits with each 4-bit nibble"
! !

!Form class methodsFor: 'mode constants' stamp: ''!
blend
	"Answer the integer denoting BitBlt's alpha blend combination rule."
	^24! !

!Form class methodsFor: 'initialization' stamp: 'GabrielOmarCotelli 6/4/2009 20:34'!
unload

	FileServices unregisterFileReader: self ! !

!Form class methodsFor: 'mode constants' stamp: ''!
reverse
	"Answer the integer denoting mode reverse."

	^6! !

!Form class methodsFor: '*Graphics-Files-FileRegistry' stamp: 'CamilloBruni 2/3/2013 17:21'!
fileReaderServicesForFile: fullName suffix: suffix
	<fileService>

	^((ImageReadWriter allTypicalFileExtensions add: '*'; add: 'form'; yourself)
		includes: suffix)
		ifTrue: [ self services ]
		ifFalse: [#()]
! !

!Form class methodsFor: 'instance creation' stamp: 'jm 3/27/98 16:36'!
extent: extentPoint depth: bitsPerPixel
	"Answer an instance of me with blank bitmap of the given dimensions and depth."

	^ self basicNew setExtent: extentPoint depth: bitsPerPixel
! !

!Form class methodsFor: 'mode constants' stamp: ''!
erase
	"Answer the integer denoting mode erase."

	^4! !

!Form class methodsFor: 'mode constants' stamp: ''!
oldPaint
	"Answer the integer denoting the 'paint' combination rule."

	^16! !

!Form class methodsFor: 'instance creation' stamp: 'jm 3/27/98 16:27'!
extent: extentPoint
	"Answer an instance of me with a blank bitmap of depth 1."

	^ self extent: extentPoint depth: 1
! !

!Form class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 3/26/2015 00:11'!
gtExampleEmptyForm32x32
	<gtExample: 'Empty Form 32x32'>
	^ Form extent: 32@32! !

!Form class methodsFor: 'instance creation' stamp: 'StephaneDucasse 10/25/2013 16:17'!
dotOfSize: diameter
	"Create a form which contains a round black dot."
	| radius form bb rect centerX centerY centerYBias centerXBias radiusSquared xOverY maxy dx |
	radius := diameter//2.
	form := self extent: diameter@diameter offset: (0@0) - (radius@radius).	
	bb := (BitBlt toForm: form)
		sourceX: 0; sourceY: 0;
		combinationRule: Form over;
		fillColor: Color black.
	rect := form boundingBox.
	centerX := rect center x.
	centerY := rect center y.
	centerYBias := rect height odd ifTrue: [0] ifFalse: [1].
	centerXBias := rect width odd ifTrue: [0] ifFalse: [1].
	radiusSquared := (rect height asFloat / 2.0) squared - 0.01.
	xOverY := rect width asFloat / rect height asFloat.
	maxy := rect height - 1 // 2.

	"First do the inner fill, and collect x values"
	0 to: maxy do:
		[:dy |
		dx := ((radiusSquared - (dy * dy) asFloat) sqrt * xOverY) truncated.
		bb	destX: centerX - centerXBias - dx
			destY: centerY - centerYBias - dy
			width: dx + dx + centerXBias + 1
			height: 1;
			copyBits.
		bb	destY: centerY + dy;
			copyBits].
	^ form
"
Time millisecondsToRun:
	[1 to: 20 do: [:i | (Form dotOfSize: i) displayAt: (i*20)@(i*20)]]
"! !

!Form class methodsFor: '*Graphics-Files-FileRegistry' stamp: 'GabrielOmarCotelli 6/4/2009 20:42'!
setBackgroundFromImageFileNamed: aFileName

	(self fromFileNamed: aFileName) setAsBackground! !

!Form class methodsFor: 'mode constants' stamp: ''!
erase1bitShape
	"Answer the integer denoting mode erase."

	^ 26! !

!Form class methodsFor: 'instance creation' stamp: 'jm 3/27/98 16:35'!
extent: extentPoint depth: bitsPerPixel fromArray: anArray offset: offsetPoint 
	"Answer an instance of me with a pixmap of the given depth initialized from anArray."

	^ (self extent: extentPoint depth: bitsPerPixel)
		offset: offsetPoint;
		initFromArray: anArray
! !

!Form class methodsFor: 'mode constants' stamp: ''!
under
	"Answer the integer denoting mode under."

	^7! !

!Form class methodsFor: '*Morphic-Base' stamp: 'AlainPlantec 12/10/2009 11:00'!
floodFillTolerance
	^ FloodFillTolerance ifNil: [FloodFillTolerance := 0.0]! !

!Form class methodsFor: 'instance creation' stamp: 'jm 3/27/98 16:26'!
extent: extentPoint offset: offsetPoint 
	"Answer an instance of me with a blank bitmap of depth 1."

	^ (self extent: extentPoint depth: 1) offset: offsetPoint
! !

!Form class methodsFor: '*Graphics-Files-FileRegistry' stamp: 'tbn 8/11/2010 10:19'!
serviceOpenImageInWindow
	"Answer a service for opening a graphic in a window"

	^ SimpleServiceEntry 
		provider: self 
		label: 'Open graphic in a window'
		selector: #openImageInWindow:
		description: 'Open a graphic file in a window'
		buttonLabel: 'Open'! !

!Form class methodsFor: 'mode constants' stamp: ''!
oldErase1bitShape
	"Answer the integer denoting mode erase."

	^ 17! !

!Form class methodsFor: '*Graphics-Files-FileRegistry' stamp: 'tbn 8/11/2010 10:18'!
serviceImageAsBackground
	"Answer a service for setting the desktop background from a given graphical file's contents"

	^ SimpleServiceEntry 
		provider: self 
		label: 'Use graphic as background'
		selector: #setBackgroundFromImageFileNamed:
		description: 'Use the graphic as the background for the desktop'
		buttonLabel: 'Background'! !

!Form class methodsFor: 'mode constants' stamp: 'di 12/31/1998 14:02'!
blendAlpha
	"Answer the integer denoting BitBlt's blend-with-constant-alpha rule."

	^ 30! !

!Form class methodsFor: 'instance creation' stamp: 'jm 3/27/98 16:33'!
extent: extentPoint fromArray: anArray offset: offsetPoint 
	"Answer an instance of me of depth 1 with bitmap initialized from anArray."

	^ (self extent: extentPoint depth: 1)
		offset: offsetPoint;
		initFromArray: anArray
! !

!Form class methodsFor: '*Graphics-Files' stamp: 'StephaneDucasse 2/2/2010 22:20'!
fromFileNamed: fileName 
	"Read a Form or ColorForm from the given file."
	
	^ FileStream 
			readOnlyFileNamed: fileName 
			do: [:aFile |
					aFile binary.
					self fromBinaryStream: aFile.]
		! !

!FormCanvas commentStamp: '<historical>'!
Note that when shadowDrawing is true, shadowStipple may be either a color, for a solid shadow of the given color, or it may be a stipple used to simulate gray shading when the display cannot support alpha blending.!
!FormCanvas methodsFor: 'drawing-support' stamp: 'ar 6/17/1999 03:02'!
clipBy: aRectangle during: aBlock
	"Set a clipping rectangle active only during the execution of aBlock.
	Note: In the future we may want to have more general clip shapes - not just rectangles"
	^aBlock value: (self copyClipRect: aRectangle)! !

!FormCanvas methodsFor: 'drawing-polygons' stamp: 'IgorStasenko 7/18/2011 18:11'!
drawPolygon: vertices fillStyle: aFillStyle borderWidth: bw borderColor: bc
	"Use a BalloonCanvas"
	self asBalloonCanvas 
		drawPolygon: vertices asArray
		fillStyle: aFillStyle
		borderWidth: bw 
		borderColor: bc! !

!FormCanvas methodsFor: 'accessing' stamp: ''!
depth

	^ form depth
! !

!FormCanvas methodsFor: 'private' stamp: 'FernandoOlivero 9/9/2013 11:52'!
setPaintColor: aColor
	"Install a new color used for filling."
	
	| paintColor screen patternWord |
	paintColor := aColor.
	paintColor ifNil: [paintColor := Color transparent].
	paintColor isColor ifFalse: [ 
		(paintColor isKindOf: InfiniteForm) 
			ifFalse: [^self error:'Cannot install color'].
		^port fillPattern: paintColor; combinationRule: Form paint].
	"Okay, so paintColor really *is* a color"
	port sourceForm: nil.
	(paintColor isTranslucent) ifFalse: [
		port fillPattern: paintColor.
		port combinationRule: Form paint.
		self depth = 8 ifTrue: [
			port fillColor: (form balancedPatternFor: paintColor)].
		^self].
	"paintColor is translucent color"

	self depth > 8 ifTrue: [
		"BitBlt setup for alpha mapped transfer"
		port fillPattern: paintColor.
		self depth = 16
			ifTrue: [port alphaBits: paintColor privateAlpha; combinationRule: 31]
			ifFalse: [port combinationRule: Form blend].
		^self].

	"Can't represent actual transparency -- use stipple pattern"
	screen := self translucentMaskFor: paintColor alpha depth: self depth.
	patternWord := form pixelWordFor: paintColor.
	port fillPattern: (screen collect: [:maskWord | maskWord bitAnd: patternWord]).
	port combinationRule: Form paint
! !

!FormCanvas methodsFor: '*Rubric-Editing-Core' stamp: 'AlainPlantec 4/11/2013 10:26'!
rubParagraph: para bounds: bounds color: c

	| scanner |
	self setPaintColor: c.
	scanner := (port clippedBy: (bounds translateBy: origin)) rubDisplayScannerFor: para
		foreground: c background: Color transparent
		ignoreColorChanges: false.
	para drawOn: (self copyClipRect: bounds) using: scanner at: origin + bounds topLeft.
! !

!FormCanvas methodsFor: 'drawing-support' stamp: 'ar 6/17/1999 03:02'!
translateBy: delta during: aBlock
	"Set a translation only during the execution of aBlock."
	^aBlock value: (self copyOffset: delta)! !

!FormCanvas methodsFor: 'drawing-text' stamp: 'IgorStasenko 7/18/2011 18:12'!
drawString: aString from: firstIndex to: lastIndex in: bounds font: fontOrNil color: c
	| font portRect |
	port colorMap: nil.
	portRect := port clipRect.
	port clipByX1: bounds left + origin x 
		y1: bounds top + origin y 
		x2: bounds right + origin x 
		y2: bounds bottom + origin y.
	font := fontOrNil ifNil: [TextStyle defaultFont].
	port combinationRule: Form paint.
	font installOn: port
		foregroundColor: c
		backgroundColor: Color transparent.
	font displayString: aString asString on: port 
		from: firstIndex to: lastIndex at: (bounds topLeft + origin) kern: 0.
	port clipRect: portRect.! !

!FormCanvas methodsFor: 'private' stamp: 'FernandoOlivero 9/12/2013 13:36'!
translucentPatterns
	^ self class translucentPatterns! !

!FormCanvas methodsFor: 'copying' stamp: 'ar 6/17/1999 02:52'!
copyOffset: aPoint
	^ self copyOrigin: origin + aPoint clipRect: clipRect! !

!FormCanvas methodsFor: 'private' stamp: 'tpr 9/15/2004 10:28'!
setClearColor: aColor
	"Install a new clear color - e.g., a color is used for clearing the background"
	| clearColor |
	clearColor := aColor ifNil:[Color transparent].
	clearColor isColor ifFalse:[
		(clearColor isKindOf: InfiniteForm) ifFalse:[^self error:'Cannot install color'].
		^port fillPattern: clearColor; combinationRule: Form over].
	"Okay, so clearColor really *is* a color"
	port sourceForm: nil.
	port combinationRule: Form over.
	port fillPattern: clearColor.
	self depth = 8 ifTrue:[
		"Use a stipple pattern"
		port fillColor: (form balancedPatternFor: clearColor)].
! !

!FormCanvas methodsFor: 'accessing' stamp: 'ar 6/22/1999 14:06'!
clipRect
	"Return the currently active clipping rectangle"
	^ clipRect translateBy: origin negated! !

!FormCanvas methodsFor: 'accessing' stamp: 'ar 5/28/2000 17:11'!
allocateForm: extentPoint
	"Allocate a new form which is similar to the receiver"
	^form allocateForm: extentPoint! !

!FormCanvas methodsFor: 'initialization' stamp: 'FernandoOlivero 9/11/2013 13:29'!
initializeTranslucentPatterns
	
	TranslucentPatterns := Array new: 8. 
	#(1 2 4 8 ) do: 
		[ :d | | mask bits pattern patternList | 
		patternList := Array new: 5.
		mask := (1 bitShift: d) - 1.
		bits := 2 * d.
		[ bits >= 32 ] whileFalse: 
			[ mask := mask bitOr: (mask bitShift: bits).	"double the length of mask"
			bits := bits + bits ].
		"0% pattern"
		pattern := Bitmap 
			with: 0
			with: 0.
		patternList 
			at: 1
			put: pattern.
		"25% pattern"
		pattern := Bitmap 
			with: mask
			with: 0.
		patternList 
			at: 2
			put: pattern.
		"50% pattern"
		pattern := Bitmap 
			with: mask
			with: mask bitInvert32.
		patternList 
			at: 3
			put: pattern.
		"75% pattern"
		pattern := Bitmap 
			with: mask
			with: 4294967295.
		patternList 
			at: 4
			put: pattern.
		"100% pattern"
		pattern := Bitmap 
			with: 4294967295
			with: 4294967295.
		patternList 
			at: 5
			put: pattern.
		TranslucentPatterns 
			at: d
			put: patternList ]! !

!FormCanvas methodsFor: 'accessing' stamp: 'ar 12/31/2001 03:26'!
contentsOfArea: aRectangle into: aForm
	| bb |
	self flush.
	bb := BitBlt toForm: aForm.
	bb sourceForm: form; combinationRule: Form over;
		sourceX: (aRectangle left + origin x); sourceY: (aRectangle top + origin y);
		width: aRectangle width; height: aRectangle height;
		copyBits.
	^aForm! !

!FormCanvas methodsFor: 'accessing' stamp: ''!
form

	^ form! !

!FormCanvas methodsFor: 'private' stamp: 'yo 6/18/2004 15:11'!
privateWarp: aForm transform: aTransform at: extraOffset sourceRect: sourceRect cellSize: cellSize
	"Warp the given using the appropriate transform and offset."
	| globalRect sourceQuad warp tfm |
	tfm := aTransform.
	globalRect := tfm localBoundsToGlobal: sourceRect.
	sourceQuad := (tfm sourceQuadFor: globalRect) collect:[:p| p - sourceRect topLeft].
	extraOffset ifNotNil:[globalRect := globalRect translateBy: extraOffset].
     warp := (WarpBlt current toForm: port destForm)
                combinationRule: Form paint;
                sourceQuad: sourceQuad destRect: (globalRect origin corner: globalRect corner+(1@1));
                clipRect: port clipRect.
	warp cellSize: cellSize.
	warp sourceForm: aForm.
	warp warpBits! !

!FormCanvas methodsFor: 'copying' stamp: 'IgorStasenko 12/22/2012 03:26'!
copyOffset: aPoint clipRect: sourceClip
	"Make a copy of me offset by aPoint, and further clipped
	by sourceClip, a rectangle in the un-offset coordinates"
	^ self copyOrigin: aPoint + origin
		clipRect: ((sourceClip translateBy: origin) intersect: clipRect ifNone: [ 0@0 corner: 0@0 ])! !

!FormCanvas methodsFor: 'private' stamp: 'RAA 12/17/2000 13:24'!
privateClipRect

	^clipRect! !

!FormCanvas methodsFor: 'drawing' stamp: 'ar 5/14/2000 15:50'!
fillColor: c
	"Note: This always fills, even if the color is transparent."
	self setClearColor: c.
	port fillRect: form boundingBox offset: origin.! !

!FormCanvas methodsFor: 'initialization' stamp: 'ar 2/17/2000 00:21'!
reset

	origin := 0@0.							"origin of the top-left corner of this cavas"
	clipRect := (0@0 corner: 10000@10000).		"default clipping rectangle"
	self shadowColor: nil.! !

!FormCanvas methodsFor: 'testing' stamp: 'ar 6/22/1999 14:08'!
isVisible: aRectangle
	"Optimization"
	(aRectangle right + origin x) < clipRect left	ifTrue: [^ false].
	(aRectangle left + origin x) > clipRect right	ifTrue: [^ false].
	(aRectangle bottom + origin y) < clipRect top	ifTrue: [^ false].
	(aRectangle top + origin y) > clipRect bottom	ifTrue: [^ false].
	^ true
! !

!FormCanvas methodsFor: 'drawing-images' stamp: 'tpr 9/15/2004 10:27'!
stencil: stencilForm at: aPoint sourceRect: sourceRect color: aColor
	"Flood this canvas with aColor wherever stencilForm has non-zero pixels"
	self setPaintColor: aColor.
	port colorMap: stencilForm maskingMap.
	port stencil: stencilForm
		at: aPoint + origin
		sourceRect: sourceRect.! !

!FormCanvas methodsFor: 'accessing' stamp: ''!
extent

	^ form extent! !

!FormCanvas methodsFor: 'drawing-rectangles' stamp: 'ar 2/16/2000 22:07'!
frameAndFillRectangle: r fillColor: fillColor borderWidth: borderWidth topLeftColor: topLeftColor bottomRightColor: bottomRightColor

	| w h rect |
	"First use quick code for top and left borders and fill"
	self frameAndFillRectangle: r
		fillColor: fillColor
		borderWidth: borderWidth
		borderColor: topLeftColor.

	"Now use slow code for bevelled bottom and right borders"
	bottomRightColor isTransparent ifFalse: [
		borderWidth isNumber
			ifTrue: [w := h := borderWidth]
			ifFalse: [w := borderWidth x.   h := borderWidth y].
		rect := r translateBy: origin.
		self setFillColor: bottomRightColor.
		port 
			 frameRectRight: rect width: w;
			 frameRectBottom: rect height: h].
! !

!FormCanvas methodsFor: '*Morphic-Base' stamp: 'ar 11/11/1998 22:57'!
asBalloonCanvas
	^(BalloonCanvas on: form) setOrigin: origin clipRect: clipRect! !

!FormCanvas methodsFor: 'copying' stamp: 'nice 1/13/2010 21:21'!
postCopy
	"The copy share same underlying Form but with its own grafPort."

	super postCopy.
	self resetGrafPort! !

!FormCanvas methodsFor: 'private' stamp: 'MarcusDenker 3/24/2012 21:31'!
resetGrafPort
	"Private!! Create a new grafPort for a new copy."

	port := GrafPort toForm: form.
	port clipRect: clipRect.
! !

!FormCanvas methodsFor: 'copying' stamp: 'ar 6/17/1999 02:51'!
copyClipRect: aRectangle
	^ self copyOrigin: origin clipRect: (aRectangle translateBy: origin)
! !

!FormCanvas methodsFor: '*Morphic-Base' stamp: 'GaryChambers 9/8/2011 14:48'!
roundShadowCornersOf: aMorph in: bounds during: aBlock
	aMorph wantsRoundedCorners ifFalse:[^aBlock value].
	(self seesNothingOutside: (CornerRounder rectWithinCornersOf: bounds))
		ifTrue: ["Don't bother with corner logic if the region is inside them"
				^ aBlock value].
	CornerRounder roundShadowCornersOf: aMorph on: self in: bounds
		displayBlock: aBlock
		borderWidth: aMorph borderWidthForRounding
		corners: aMorph roundedCorners! !

!FormCanvas methodsFor: 'other' stamp: ''!
showAt: pt

	^ form displayAt: pt! !

!FormCanvas methodsFor: 'drawing-text' stamp: 'IgorStasenko 7/18/2011 18:12'!
drawString: aString from: firstIndex to: lastIndex in: bounds font: fontOrNil color: c underline: underline underlineColor: uc strikethrough: strikethrough strikethroughColor: sc
	| font portRect endPoint |
	port colorMap: nil.
	portRect := port clipRect.
	port clipByX1: bounds left + origin x 
		y1: bounds top + origin y 
		x2: bounds right + origin x 
		y2: bounds bottom + origin y.
	font := fontOrNil ifNil: [TextStyle defaultFont].
	port combinationRule: Form paint.
	font installOn: port
		foregroundColor: c
		backgroundColor: Color transparent.
	endPoint := font displayString: aString asString on: port 
		from: firstIndex to: lastIndex at: (bounds topLeft + origin) kern: 0.
	underline ifTrue:[
		font installOn: port
			foregroundColor: uc
			backgroundColor: Color transparent.
		font displayUnderlineOn: port from: (bounds topLeft + origin + (0@font ascent)) to: endPoint.	
		].
	port clipRect: portRect.! !

!FormCanvas methodsFor: 'accessing' stamp: 'ar 6/22/1999 14:10'!
origin
	"Return the current origin for drawing operations"
	^ origin! !

!FormCanvas methodsFor: '*Morphic-Base' stamp: 'IgorStasenko 7/18/2011 18:12'!
drawString: aString from: firstIndex to: lastIndex autoBoundAt: aPoint font: fontOrNil color: c

	| font textStyle portRect bounds character width carriageReturn lineWidth lineHeight |

	carriageReturn := Character cr.
	width := lineWidth := 0.
	font := StandardFonts codeFont.
	textStyle := font textStyle.
	lineHeight := textStyle lineGrid.
	1 to: aString size do: 
		[:i | 
		character := aString at: i.
		character = carriageReturn
		  ifTrue: 
			[lineWidth := lineWidth max: width.
			lineHeight := lineHeight + textStyle lineGrid.
			width := 0]
		  ifFalse: [width := width + (font widthOf: character)]].
	lineWidth := lineWidth max: width.
	bounds := aPoint extent: (lineWidth  @ lineHeight).
	
	port colorMap: nil.
	portRect := port clipRect.
	port clipByX1: bounds left + origin x 
		y1: bounds top + origin y 
		x2: bounds right + origin x 
		y2: bounds bottom + origin y.
	port combinationRule: Form paint.
	port fill: bounds fillColor: Color white rule: Form paint.
	font installOn: port
		foregroundColor: c
		backgroundColor: Color white.
	aString lines doWithIndex: [:line :index |
		font displayString: line on: port 
			from: 1 to: line size at: (bounds topLeft + origin + (0@(index-1)*textStyle lineGrid)) kern: 0.
	].
	port clipRect: portRect.! !

!FormCanvas methodsFor: 'drawing-support' stamp: 'ar 6/17/1999 02:55'!
translateTo: newOrigin clippingTo: aRectangle during: aBlock
	"Set a new origin and clipping rectangle only during the execution of aBlock."
	aBlock value: (self copyOrigin: newOrigin clipRect: aRectangle)! !

!FormCanvas methodsFor: 'drawing' stamp: 'ar 2/16/2000 22:07'!
line: pt1 to: pt2 width: w color: c
	| offset |
	offset := origin - (w // 2) asPoint.
	self setFillColor: c.
	port width: w; height: w;
		drawFrom: (pt1 + offset) to: (pt2 + offset)! !

!FormCanvas methodsFor: 'private' stamp: 'RAA 12/17/2000 13:25'!
privatePort

	^port! !

!FormCanvas methodsFor: '*Morphic-Base' stamp: 'ar 12/30/2001 18:58'!
roundCornersOf: aMorph in: bounds during: aBlock
	aMorph wantsRoundedCorners ifFalse:[^aBlock value].
	(self seesNothingOutside: (CornerRounder rectWithinCornersOf: bounds))
		ifTrue: ["Don't bother with corner logic if the region is inside them"
				^ aBlock value].
	CornerRounder roundCornersOf: aMorph on: self in: bounds
		displayBlock: aBlock
		borderWidth: aMorph borderWidthForRounding
		corners: aMorph roundedCorners! !

!FormCanvas methodsFor: 'drawing-rectangles' stamp: 'IgorStasenko 7/18/2011 18:14'!
fillRectangle: aRectangle basicFillStyle: aFillStyle
	"Fill the given rectangle with the given, non-composite, fill style."
	
	| pattern |

	(aFillStyle isKindOf: InfiniteForm) ifTrue: [
		^self infiniteFillRectangle: aRectangle fillStyle: aFillStyle
	].

	(aFillStyle isSolidFill) 
		ifTrue:[^self fillRectangle: aRectangle color: aFillStyle asColor].
	"We have a very special case for filling with infinite forms"
	(aFillStyle isBitmapFill and:[aFillStyle origin = (0@0)]) ifTrue:[
		pattern := aFillStyle form.
		(aFillStyle direction = (pattern width @ 0) 
			and:[aFillStyle normal = (0@pattern height)]) ifTrue:[
				"Can use an InfiniteForm"
				^self fillRectangle: aRectangle color: (InfiniteForm with: pattern)].
	].
	"Use a BalloonCanvas instead"
	self balloonFillRectangle: aRectangle fillStyle: aFillStyle.! !

!FormCanvas methodsFor: 'other' stamp: ''!
flushDisplay
		Display deferUpdates: false; forceDisplayUpdate.! !

!FormCanvas methodsFor: 'drawing-ovals' stamp: 'di 5/25/2001 01:40'!
fillOval: r color: fillColor borderWidth: borderWidth borderColor: borderColor
	| rect |
	"draw the border of the oval"
	rect := (r translateBy: origin) truncated.
	(borderWidth = 0 or: [borderColor isTransparent]) ifFalse:[
		self setFillColor: borderColor.
		(r area > 10000 or: [fillColor isTranslucent]) 
			ifTrue: [port frameOval: rect borderWidth: borderWidth]
			ifFalse: [port fillOval: rect]]. "faster this way"
	"fill the inside"
	fillColor isTransparent ifFalse:
		[self setFillColor: fillColor.
		port fillOval: (rect insetBy: borderWidth)].
! !

!FormCanvas methodsFor: 'other' stamp: 'StephaneDucasse 2/9/2011 14:51'!
forceToScreen: rect
	^Display forceToScreen: rect.
! !

!FormCanvas methodsFor: 'private' stamp: 'ar 5/14/2001 23:34'!
image: aForm at: aPoint sourceRect: sourceRect rule: rule 
	"Draw the portion of the given Form defined by sourceRect at the given point using the given BitBlt combination rule."
	port colorMap: (aForm colormapIfNeededFor: form); fillColor: nil.
	port image: aForm at: aPoint + origin sourceRect: sourceRect rule: rule.! !

!FormCanvas methodsFor: 'printing' stamp: 'ar 5/28/2000 17:07'!
printOn: aStream
	super printOn: aStream.
	aStream nextPutAll:' on: '; print: form.! !

!FormCanvas methodsFor: 'drawing' stamp: 'ar 9/9/2000 22:18'!
render: anObject
	"Do some 3D operations with the object if possible"
	^self asBalloonCanvas render: anObject! !

!FormCanvas methodsFor: 'drawing-support' stamp: 'IgorStasenko 7/18/2011 18:21'!
transformBy: aDisplayTransform clippingTo: aClipRect during: aBlock	 smoothing: cellSize

	"Note: This method has been originally copied from TransformationMorph."
	| innerRect patchRect sourceQuad warp start subCanvas rule|
	(aDisplayTransform isPureTranslation) ifTrue:[
		^aBlock value: (self copyOffset: aDisplayTransform offset negated truncated
							clipRect: aClipRect)
	].
	"Prepare an appropriate warp from patch to innerRect"
	innerRect := aClipRect.
	patchRect := (aDisplayTransform globalBoundsToLocal: innerRect) truncated.
	sourceQuad := (aDisplayTransform sourceQuadFor: innerRect)
					collect: [:p | p - patchRect topLeft].
	warp := self warpFrom: sourceQuad toRect: innerRect.
	warp cellSize: cellSize.

	"Render the submorphs visible in the clipping rectangle, as patchForm"
	start := (self depth = 1)
		"If this is true B&W, then we need a first pass for erasure."
		ifTrue: [1] ifFalse: [2].
	"If my depth has alpha, do blending rather than paint"
	rule := self depth = 32 ifTrue: [Form blend] ifFalse: [Form paint].
	start to: 2 do:
		[:i | "If i=1 we first make a shadow and erase it for opaque whites in B&W"
		subCanvas := self class extent: patchRect extent depth: self depth.
		i=1	ifTrue: [ warp combinationRule: Form erase ]
			ifFalse: [ warp combinationRule: rule].
		subCanvas translateBy: patchRect topLeft negated
			during:[:offsetCanvas| aBlock value: offsetCanvas].
		warp sourceForm: subCanvas form; warpBits.
		warp sourceForm: nil.  subCanvas := nil "release space for next loop"]
! !

!FormCanvas methodsFor: 'private' stamp: 'MarcusDenker 3/24/2012 21:31'!
setForm: aForm

	self reset.
	form := aForm.
	port := GrafPort toForm: form.
! !

!FormCanvas methodsFor: 'other' stamp: 'ar 5/28/2000 12:12'!
warpFrom: sourceQuad toRect: destRect
        ^ (WarpBlt current toForm: port destForm)
                combinationRule: Form paint;
                sourceQuad: sourceQuad destRect: (destRect translateBy: origin);
                clipRect: clipRect! !

!FormCanvas methodsFor: 'private' stamp: 'ar 8/8/2001 14:21'!
image: aForm at: aPoint sourceRect: sourceRect rule: rule alpha: sourceAlpha
	"Draw the portion of the given Form defined by sourceRect at the given point using the given BitBlt combination rule."
	port colorMap: (aForm colormapIfNeededFor: form); fillColor: nil.
	port image: aForm at: aPoint + origin sourceRect: sourceRect rule: rule alpha: sourceAlpha.! !

!FormCanvas methodsFor: 'private' stamp: 'ar 6/22/1999 14:06'!
setOrigin: aPoint clipRect: aRectangle

	origin := aPoint.
	clipRect := aRectangle.
	port clipRect: aRectangle.
! !

!FormCanvas methodsFor: 'drawing-text' stamp: 'IgorStasenko 7/18/2011 18:12'!
drawString: aString from: firstIndex to: lastIndex at: aPoint font: fontOrNil color: c
	| font |
	port colorMap: nil.
	font := fontOrNil ifNil: [TextStyle defaultFont].
	port combinationRule: Form paint.
	font installOn: port
		foregroundColor: c
		backgroundColor: Color transparent.
	font displayString: aString on: port 
		from: firstIndex to: lastIndex at: (origin + aPoint) kern: 0.! !

!FormCanvas methodsFor: 'private' stamp: 'FernandoOlivero 9/9/2013 11:51'!
setFillColor: aColor
	"Install a new color used for filling."
	| screen patternWord fillColor |
	fillColor := aColor.
	fillColor ifNil:[fillColor := Color transparent].
	fillColor isColor ifFalse:[
		(fillColor isKindOf: InfiniteForm) ifFalse:[^self error:'Cannot install color'].
		^port fillPattern: fillColor; combinationRule: Form over].
	"Okay, so fillColor really *is* a color"
	port sourceForm: nil.
	fillColor isTranslucent ifFalse:[
		port combinationRule: Form over.
		port fillPattern: fillColor.
		self depth = 8 ifTrue:[
			"In 8 bit depth it's usually a good idea to use a stipple pattern"
			port fillColor: (form balancedPatternFor: fillColor)].
		^self].
	"fillColor is some translucent color"

	self depth > 8 ifTrue:[
		"BitBlt setup for alpha masked transfer"
		port fillPattern: fillColor.
		self depth = 16
			ifTrue:[port alphaBits: fillColor privateAlpha; combinationRule: 30]
			ifFalse:[port combinationRule: Form blend].
		^self].
	"Can't represent actual transparency -- use stipple pattern"
	screen := self translucentMaskFor: fillColor alpha depth: self depth.
	patternWord := form pixelWordFor: fillColor.
	port fillPattern: (screen collect: [:maskWord | maskWord bitAnd: patternWord]).
	port combinationRule: Form paint.
! !

!FormCanvas methodsFor: 'drawing-polygons' stamp: 'ar 6/18/1999 08:57'!
drawPolygon: vertices color: aColor borderWidth: bw borderColor: bc
	"Generalize for the BalloonCanvas"
	^self drawPolygon: vertices fillStyle: aColor borderWidth: bw borderColor: bc! !

!FormCanvas methodsFor: 'drawing-rectangles' stamp: 'IgorStasenko 12/22/2012 03:25'!
infiniteFillRectangle: aRectangle fillStyle: aFillStyle

	| additionalOffset rInPortTerms clippedPort targetTopLeft clipOffset ex |

	"this is a bit of a kludge to get the form to be aligned where I *think* it should be.
	something better is needed, but not now"

	additionalOffset := 0@0.
	ex := aFillStyle form extent.
	rInPortTerms := (aRectangle intersect: aFillStyle boundingBox ifNone: ["nothing to draw" ^ self ]) translateBy: origin.
	clippedPort := port clippedBy: rInPortTerms.
	targetTopLeft := clippedPort clipRect topLeft truncateTo: ex.
	clipOffset := rInPortTerms topLeft - targetTopLeft.
	additionalOffset := (clipOffset \\ ex) - ex.
	^aFillStyle
		displayOnPort: clippedPort
		offsetBy: additionalOffset
! !

!FormCanvas methodsFor: 'drawing-ovals' stamp: 'IgorStasenko 7/18/2011 18:13'!
fillOval: aRectangle fillStyle: aFillStyle borderWidth: bw borderColor: bc
	"Fill the given oval."

	self flag: #bob.		"this and its siblings could be moved up to Canvas with the
						right #balloonFillOval:..."

	(aFillStyle isBitmapFill and:[aFillStyle isKindOf: InfiniteForm]) ifTrue:[
		self flag: #fixThis.
		^self fillOval: aRectangle color: aFillStyle borderWidth: bw borderColor: bc].
	(aFillStyle isSolidFill) ifTrue:[
		^self fillOval: aRectangle color: aFillStyle asColor borderWidth: bw borderColor: bc].
	"Use a BalloonCanvas instead"
	self balloonFillOval: aRectangle fillStyle: aFillStyle borderWidth: bw borderColor: bc! !

!FormCanvas methodsFor: 'drawing-ovals' stamp: 'RAA 11/6/2000 15:21'!
balloonFillOval: aRectangle fillStyle: aFillStyle borderWidth: bw borderColor: bc

	self asBalloonCanvas
		fillOval: aRectangle
		fillStyle: aFillStyle
		borderWidth: bw
		borderColor: bc! !

!FormCanvas methodsFor: 'private' stamp: 'FernandoOlivero 9/12/2013 13:36'!
translucentMaskFor: alphaValue depth: d
	"Return a pattern representing a mask usable for stipple transparency"
	^(self translucentPatterns at: d) at: ((alphaValue min: 1.0 max: 0.0) * 4) rounded + 1 ! !

!FormCanvas methodsFor: 'drawing' stamp: 'IgorStasenko 7/18/2011 18:15'!
paragraph: para bounds: bounds color: c

	| scanner |
	self setPaintColor: c.
	scanner := (port clippedBy: (bounds translateBy: origin)) displayScannerFor: para
		foreground: c background: Color transparent
		ignoreColorChanges: false.
	para displayOn: (self copyClipRect: bounds) using: scanner at: origin+ bounds topLeft.
! !

!FormCanvas methodsFor: 'drawing-rectangles' stamp: 'ar 5/14/2000 15:50'!
frameAndFillRectangle: r fillColor: fillColor borderWidth: borderWidth borderColor: borderColor
	| rect |
	rect := r translateBy: origin.
	"draw the border of the rectangle"
	borderColor isTransparent ifFalse:[
		self setFillColor: borderColor.
		(r area > 10000 or: [fillColor isTranslucent]) ifTrue: [
			port frameRect: rect borderWidth: borderWidth.
		] ifFalse: ["for small rectangles, it's faster to fill the entire outer rectangle
					than to compute and fill the border rects"
					port fillRect: rect offset: origin]].

	"fill the inside"
	fillColor isTransparent ifFalse:
		[self setFillColor: fillColor.
		port fillRect: (rect insetBy: borderWidth) offset: origin].! !

!FormCanvas methodsFor: 'drawing-images' stamp: 'ar 12/30/2001 16:36'!
warpImage: aForm transform: aTransform at: extraOffset sourceRect: sourceRect cellSize: cellSize
	"Warp the given using the appropriate transform and offset."
	| tfm |
	tfm := (MatrixTransform2x3 withOffset: origin) composedWithLocal: aTransform.
	^self privateWarp: aForm transform: tfm at: extraOffset sourceRect: sourceRect cellSize: cellSize! !

!FormCanvas methodsFor: 'other' stamp: 'StephaneDucasse 10/25/2013 16:17'!
showAt: pt invalidRects: updateRects
	| blt |
	blt := (BitBlt toForm: Display)
			sourceForm: form;
			combinationRule: Form over.
	updateRects do:
		[:rect |
		blt sourceRect: rect;
			destOrigin: rect topLeft + pt;
			copyBits]! !

!FormCanvas methodsFor: 'copying' stamp: 'IgorStasenko 12/22/2012 03:26'!
copyOrigin: aPoint clipRect: aRectangle
	"Return a copy of this canvas with the given origin. The clipping rectangle of this canvas is the intersection of the given rectangle and the receiver's current clipping rectangle. This allows the clipping rectangles of nested clipping morphs to be composed."
	^ self copy
		setOrigin: aPoint
		clipRect: (clipRect intersect: aRectangle ifNone: ["well, now we will clip everything" 0@0 corner: 0@0])! !

!FormCanvas methodsFor: 'initialization' stamp: 'ar 5/27/2000 21:51'!
finish
	"If there are any pending operations on the receiver complete them. Do not return before all modifications have taken effect."
	form finish! !

!FormCanvas methodsFor: 'Morphic-Base-Balloon' stamp: 'gvc 3/16/2009 13:36'!
balloonFillRectangle: aRectangle fillStyle: aFillStyle

	self asBalloonCanvas fillRectangle: aRectangle basicFillStyle: aFillStyle! !

!FormCanvas class methodsFor: 'caching' stamp: 'FernandoOlivero 9/12/2013 13:35'!
initializeTranslucentPatterns
	
	TranslucentPatterns := Array new: 8. 
	#(1 2 4 8 ) do: 
		[ :d | | mask bits pattern patternList | 
		patternList := Array new: 5.
		mask := (1 bitShift: d) - 1.
		bits := 2 * d.
		[ bits >= 32 ] whileFalse: 
			[ mask := mask bitOr: (mask bitShift: bits).	"double the length of mask"
			bits := bits + bits ].
		"0% pattern"
		pattern := Bitmap 
			with: 0
			with: 0.
		patternList 
			at: 1
			put: pattern.
		"25% pattern"
		pattern := Bitmap 
			with: mask
			with: 0.
		patternList 
			at: 2
			put: pattern.
		"50% pattern"
		pattern := Bitmap 
			with: mask
			with: mask bitInvert32.
		patternList 
			at: 3
			put: pattern.
		"75% pattern"
		pattern := Bitmap 
			with: mask
			with: 4294967295.
		patternList 
			at: 4
			put: pattern.
		"100% pattern"
		pattern := Bitmap 
			with: 4294967295
			with: 4294967295.
		patternList 
			at: 5
			put: pattern.
		TranslucentPatterns 
			at: d
			put: patternList ]! !

!FormCanvas class methodsFor: 'instance creation' stamp: ''!
extent: extent depth: depth

	^ self new setForm: (Form extent: extent depth: depth)! !

!FormCanvas class methodsFor: 'instance creation' stamp: 'jm 8/2/97 13:54'!
on: aForm

	^ self new setForm: aForm
! !

!FormCanvas class methodsFor: 'instance creation' stamp: ''!
extent: aPoint

	^ self extent: aPoint depth: Display depth
! !

!FormCanvas class methodsFor: 'caching' stamp: 'FernandoOlivero 9/12/2013 13:36'!
translucentPatterns
	TranslucentPatterns isNil ifTrue:[ self initializeTranslucentPatterns ].
	^ 	TranslucentPatterns  ! !

!FormCanvas class methodsFor: 'instance creation' stamp: 'nk 7/4/2003 10:11'!
extent: extent depth: depth origin: aPoint clipRect: aRectangle

	^ self new
		setForm: (Form extent: extent depth: depth);
		setOrigin: aPoint clipRect: aRectangle;
		yourself! !

!FormTest commentStamp: 'ar 7/21/2007 21:39'!
Various tests for class form.!
!FormTest methodsFor: 'tests' stamp: 'VincentBlondeau 1/30/2015 17:51'!
test32BitFormBlackShouldStayBlackAfterSave
	"Solve bug: https://pharo.fogbugz.com/f/cases/14619/Strange-behavior-of-TestRunner-Icon"

	| blackForm |
	blackForm := (Form extent: 10 @ 10) fillColor: Color black.
	self assert: blackForm colorsUsed first equals: Color black! !

!FormTest methodsFor: 'tests' stamp: 'nice 1/5/2010 15:59'!
testIsAllWhite	"self run: #testIsAllWhite"
	"Make sure #isAllWhite works for all bit depths"
	
	#(-32 -16 -8 -4 -2 -1 1 2 4 8 16 32) do:[:d| | form |
		form := Form extent: 16@16 depth: d.
		form fillBlack.
		self deny: form isAllWhite.
		form fillWhite.
		self assert: form isAllWhite.
	].
! !

!FormTest methodsFor: 'tests' stamp: 'HenrikSperreJohansen 5/27/2010 23:26'!
test32BitTranslucentBlackIsBlack
	|form|
	form := Form extent: 1@1 depth: 32.
	form colorAt: 0@0 put: (Color black alpha: 0.0).
	self assert:  0 equals: (form pixelValueAt: 0@0)! !

!Fraction commentStamp: 'VeronicaUquillas 6/11/2010 14:04'!
Fraction provides methods for dealing with fractions like 1/3 as fractions (not as 0.33333...).  All public arithmetic operations answer reduced fractions (see examples).

instance variables: 'numerator denominator '

Examples: (note the parentheses required to get the right answers in Smalltalk and Pharo):

(2/3) + (2/3)
(2/3) + (1/2)		 "answers shows the reduced fraction" 
(2/3) raisedToInteger: 5		 "fractions also can have exponents"
!
!Fraction methodsFor: 'truncation and round off' stamp: 'HenrikSperreJohansen 1/19/2012 15:44'!
asSmallerPowerOfTwo
	"Convert the receiver into a power of two which is not larger than the receiver"
	| quotient |
	(numerator = 0 or: [numerator sign ~= denominator sign]) ifTrue: [^DomainError signal: 'Value outside (0 , infinity)' from: 0].
	^(quotient := denominator // numerator) > 0 
		ifTrue: [	"If my quotient is a power of two, we, we need to check remainder, to see if we should shift by highbit or not.
				 (This is equivalent to Integer asSmallerPowerOfTwo returning self when receiver is power of two) "
				 (quotient isPowerOfTwo and: [denominator \\ numerator = 0]) 
					ifTrue: [Fraction numerator: 1 denominator: quotient]
					ifFalse:[Fraction numerator: 1 denominator:  (1 bitShift: quotient highBit)]]
					
		ifFalse: [1 bitShift: ((numerator // denominator) highBit -1)]! !

!Fraction methodsFor: 'testing' stamp: 'ClementBera 9/27/2013 17:38'!
isPowerOfTwo
	|reduced|
	reduced := self reduced.
	^(reduced numerator = 1 and: [reduced denominator isPowerOfTwo])
	 or: [reduced denominator = 1 and: [reduced numerator isPowerOfTwo]]! !

!Fraction methodsFor: 'mathematical functions' stamp: 'LC 4/22/1998 14:03'!
raisedToInteger: anInteger 
	"See Number | raisedToInteger:"
	anInteger = 0 ifTrue: [^ 1].
	anInteger < 0 ifTrue: [^ self reciprocal raisedToInteger: anInteger negated].
	^ Fraction numerator: (numerator raisedToInteger: anInteger)
		denominator: (denominator raisedToInteger: anInteger)! !

!Fraction methodsFor: 'mathematical functions' stamp: 'jmv 10/13/2011 21:38'!
nthRoot: aPositiveInteger
	"Answer the nth root of the receiver."

	| d n |
	n := numerator nthRoot: aPositiveInteger.
	d := denominator nthRoot: aPositiveInteger.
	"The #sqrt method in integer will only answer a Float if there's no exact square root.
	So, we need a float anyway."
	(n isInfinite or: [ d isInfinite ]) ifTrue: [
		^self asFloat nthRoot: aPositiveInteger ].
	^n / d! !

!Fraction methodsFor: 'private' stamp: ''!
denominator

	^denominator! !

!Fraction methodsFor: 'comparing' stamp: 'nice 3/28/2006 23:37'!
< aNumber
	aNumber isFraction ifTrue:
		[^ numerator * aNumber denominator < (aNumber numerator * denominator)].
	^ aNumber adaptToFraction: self andCompare: #<! !

!Fraction methodsFor: 'arithmetic' stamp: 'nice 3/11/2013 08:09'!
+ aNumber 
	"Answer the sum of the receiver and aNumber."
	| n d d1 d2 |
	aNumber isInteger ifTrue:
		[^Fraction numerator: numerator + (denominator * aNumber) denominator: denominator].
	aNumber isFraction ifTrue: 
		[d := denominator gcd: aNumber denominator.
		n := numerator * (d1 := aNumber denominator // d) + (aNumber numerator * (d2 := denominator // d)).
		d1 := d1 * d2.
		n := n // (d2 := n gcd: d).
		(d := d1 * (d // d2)) = 1 ifTrue: [^ n].
		^ Fraction numerator: n denominator: d].
	^ aNumber adaptToFraction: self andSend: #+! !

!Fraction methodsFor: 'arithmetic' stamp: 'nice 3/11/2013 08:09'!
- aNumber
	"Answer the difference between the receiver and aNumber."
	aNumber isInteger ifTrue:
		[^Fraction numerator: numerator - (denominator * aNumber) denominator: denominator].
	aNumber isFraction ifTrue:
		[^ self + aNumber negated].
	^ aNumber adaptToFraction: self andSend: #-! !

!Fraction methodsFor: 'printing' stamp: 'nice 3/29/2011 22:56'!
printOn: aStream showingDecimalPlaces: placesDesired
	"Same as super, but provides a faster implementation by inlining some Fraction protocol thus avoiding intermediate Fraction creation."
	
	| roundedFractionPart integerPart scaling |
	placesDesired <= 0
		ifTrue: [self rounded printOn: aStream]
		ifFalse:
			[scaling := 10 raisedToInteger: placesDesired.
			integerPart := numerator abs quo: denominator.
			roundedFractionPart := (numerator abs - (integerPart * denominator)) * scaling * 2 + denominator quo: denominator * 2.
			roundedFractionPart = scaling
				ifTrue:
					[integerPart := integerPart + 1.
					roundedFractionPart := 0].
			"Don't print minus sign if result is rouded to zero"
			(numerator negative and: [integerPart > 0 or: [roundedFractionPart > 0]]) ifTrue: [aStream nextPut: $-].
			integerPart printOn: aStream.
			aStream nextPut: $..
			roundedFractionPart printOn: aStream base: 10 length: placesDesired padded: true].! !

!Fraction methodsFor: 'printing' stamp: ''!
printOn: aStream

	aStream nextPut: $(.
	numerator printOn: aStream.
	aStream nextPut: $/.
	denominator printOn: aStream.
	aStream nextPut: $).
! !

!Fraction methodsFor: 'truncation and round off' stamp: ''!
truncated 
	"Refer to the comment in Number|truncated."

	^numerator quo: denominator! !

!Fraction methodsFor: 'converting' stamp: 'nice 2/13/2010 22:58'!
asScaledDecimal
	"Convert the receiver to a ScaledDecimal.
	If there is a finite decimal representation of the receiver, then use the exact number of decimal places required.
	Else, use a default number of decimals."
	
	| pow2 pow5 q q5 |
	pow2 := denominator lowBit - 1.
	q := denominator bitShift: pow2 negated.
	pow5 := 0.
	[q = 1]
		whileFalse: [
			q5 := q // 5.
			(q - (5 * q5)) = 0 ifFalse: [^super asScaledDecimal].
			q := q5.
			pow5 := pow5 + 1].
	^self asScaledDecimal: (pow2 max: pow5)! !

!Fraction methodsFor: 'converting' stamp: ''!
asFraction	
	"Answer the receiver itself."

	^self! !

!Fraction methodsFor: 'mathematical functions' stamp: 'LC 4/22/1998 14:05'!
squared
	"See Fraction (Number) | squared"
	^ Fraction numerator: numerator squared denominator: denominator squared! !

!Fraction methodsFor: 'printing' stamp: 'laza 3/29/2004 12:56'!
printOn: aStream base: base

	aStream nextPut: $(.
	numerator printOn: aStream base: base.
	aStream nextPut: $/.
	denominator printOn: aStream base: base.
	aStream nextPut: $).
! !

!Fraction methodsFor: 'comparing' stamp: 'nice 6/11/2009 02:52'!
hash
	"Hash is reimplemented because = is implemented.
	Care is taken that a Fraction equal to a Float also have an equal hash"

	| tmp |
	denominator isPowerOfTwo ifTrue: [
		"If denominator is a power of two, I can be exactly equal to a Float"
		tmp := self asFloat.
		tmp isFinite ifTrue: [^tmp hash]].
	
	"Else, I cannot be exactly equal to a Float, use own hash algorithm.
	(Assume the fraction is already reduced)"
	^numerator hash bitXor: denominator hash! !

!Fraction methodsFor: 'comparing' stamp: 'nice 1/4/2009 17:35'!
> aNumber
	aNumber isFraction ifTrue:
		[^ numerator * aNumber denominator > (aNumber numerator * denominator)].
	^ aNumber adaptToFraction: self andCompare: #>! !

!Fraction methodsFor: 'mathematical functions' stamp: 'MarcusDenker 7/23/2014 22:28'!
ln
	"This function is defined because super ln might overflow."
	| res |
	self <= 0 ifTrue: [^DomainError signal: 'ln is only defined for x > 0' from: 0].
	"Test self < 1 before converting to float in order to avoid precision loss due to gradual underflow."
	numerator < denominator ifTrue: [^self reciprocal ln negated].
	res := super ln.
	res isFinite ifTrue: [^res].
	^numerator ln - denominator ln! !

!Fraction methodsFor: 'mathematical functions' stamp: 'jmv 10/13/2011 20:16'!
sqrt
	| d n |
	n := numerator sqrt.
	d := denominator sqrt.
	"The #sqrt method in integer will only answer a Float if there's no exact square root.
	So, we need a float anyway."
	(n isInfinite or: [ d isInfinite ]) ifTrue: [
		^self asFloat sqrt ].
	^n / d! !

!Fraction methodsFor: 'truncation and round off' stamp: 'HenrikSperreJohansen 1/19/2012 15:43'!
asLargerPowerOfTwo
	"Convert the receiver into a power of two which is not less than the receiver"
	| quotient |
	(numerator = 0 or: [numerator sign ~= denominator sign]) ifTrue: [^DomainError signal: 'Value outside (0 , infinity)' from: 0].
	^(quotient := denominator // numerator) > 0 
		ifTrue: [Fraction numerator: 1 denominator:  (1 bitShift: (quotient highBit -1))]
		ifFalse: [quotient := numerator // denominator.
				"If my quotient is a power of two, we, we need to check remainder, to see if we should shift by highbit or not.
				 (This is equivalent to Integer asLargerPowerOfTwo returning self when receiver is power of two) "
				(quotient isPowerOfTwo and: [numerator \\ denominator = 0])
					ifTrue: [quotient]
					ifFalse: [1 bitShift: (quotient highBit )]]! !

!Fraction methodsFor: 'private' stamp: ''!
numerator

	^numerator! !

!Fraction methodsFor: 'arithmetic' stamp: ''!
negated 
	"Refer to the comment in Number|negated."

	^ Fraction
		numerator: numerator negated
		denominator: denominator! !

!Fraction methodsFor: 'comparing' stamp: 'nice 1/4/2009 17:35'!
>= aNumber
	aNumber isFraction ifTrue:
		[^ numerator * aNumber denominator >= (aNumber numerator * denominator)].
	^ aNumber adaptToFraction: self andCompare: #>=! !

!Fraction methodsFor: 'private' stamp: 'GabrielOmarCotelli 5/23/2009 20:36'!
reciprocal
	
	numerator abs = 1 ifTrue: [^denominator * numerator].
	^self class numerator: denominator denominator: numerator! !

!Fraction methodsFor: 'private' stamp: 'tfei 4/12/1999 12:45'!
setNumerator: n denominator: d

	d = 0
		ifTrue: [^(ZeroDivide dividend: n) signal]
		ifFalse: 
			[numerator := n asInteger.
			denominator := d asInteger abs. "keep sign in numerator"
			d < 0 ifTrue: [numerator := numerator negated]]! !

!Fraction methodsFor: 'mathematical functions' stamp: 'MarcusDenker 7/23/2014 22:28'!
log
	"This function is defined because super log might overflow."
	| res |
	self <= 0 ifTrue: [^DomainError signal: 'log is only defined for x > 0' from: 0].
	"Test self < 1 before converting to float in order to avoid precision loss due to gradual underflow."
	numerator < denominator ifTrue: [^self reciprocal log negated].
	res := super log.
	res isFinite ifTrue: [^res].
	^numerator log - denominator log! !

!Fraction methodsFor: 'testing' stamp: 'ul 11/29/2010 20:05'!
negative

	^numerator negative! !

!Fraction methodsFor: 'converting' stamp: 'nice 11/21/2011 22:34'!
asFloat
	"Answer a Float that closely approximates the value of the receiver.
	This implementation will answer the closest floating point number to the receiver.
	In case of a tie, it will use the IEEE 754 round to nearest even mode.
	In case of overflow, it will answer +/- Float infinity."

	| a b mantissa exponent hasTruncatedBits lostBit n ha hb hm |
	a := numerator abs.
	b := denominator.	"denominator is always positive"
	ha := a highBitOfMagnitude.
	hb := b highBitOfMagnitude.
	
	"Number of bits to keep in mantissa plus one to handle rounding."
	n := 1 + Float precision.

	"If both numerator and denominator are represented exactly in floating point number,
	then fastest thing to do is to use hardwired float division."
	(ha < n and: [hb < n]) ifTrue: [^numerator asFloat / denominator asFloat].

	"Shift the fraction by a power of two exponent so as to obtain a mantissa with n bits.
	First guess is rough, the mantissa might have n+1 bits."
	exponent := ha - hb - n.
	exponent >= 0
		ifTrue: [b := b bitShift: exponent]
		ifFalse: [a := a bitShift: exponent negated].
	mantissa := a quo: b.
	hasTruncatedBits := a > (mantissa * b).
	hm := mantissa highBit.
	
	"Check for gradual underflow, in which case the mantissa will loose bits.
	Keep at least one bit to let underflow preserve the sign of zero."
	lostBit := Float emin - (exponent + hm - 1).
	lostBit > 0 ifTrue: [n := n - lostBit max: 1].

	"Remove excess bits in the mantissa."
	hm > n
		ifTrue:
			[exponent := exponent + hm - n.
			hasTruncatedBits := hasTruncatedBits or: [mantissa anyBitOfMagnitudeFrom: 1 to: hm - n].
			mantissa := mantissa bitShift: n - hm].

	"Check if mantissa must be rounded upward.
	The case of tie (mantissa odd & hasTruncatedBits not)
	will be handled by Integer>>asFloat."
	(hasTruncatedBits and: [mantissa odd])
		ifTrue: [mantissa := mantissa + 1].

	^ (self positive
			ifTrue: [mantissa asFloat]
			ifFalse: [mantissa asFloat negated])
		timesTwoPower: exponent! !

!Fraction methodsFor: 'printing' stamp: 'laza 3/29/2004 13:25'!
storeOn: aStream base: base

	aStream nextPut: $(.
	numerator storeOn: aStream base: base.
	aStream nextPut: $/.
	denominator storeOn: aStream base: base.
	aStream nextPut: $).
! !

!Fraction methodsFor: 'comparing' stamp: 'nice 3/28/2006 23:41'!
= aNumber
	aNumber isNumber ifFalse: [^ false].
	aNumber isFraction
		ifTrue: [numerator = 0 ifTrue: [^ aNumber numerator = 0].
				^ (numerator * aNumber denominator) =
					(aNumber numerator * denominator)
				"Note: used to just compare num and denom,
					but this fails for improper fractions"].
	^ aNumber adaptToFraction: self andCompare: #=! !

!Fraction methodsFor: 'converting' stamp: ''!
isFraction
	^ true! !

!Fraction methodsFor: 'converting' stamp: 'nice 9/7/2011 21:56'!
adaptToInteger: rcvr andSend: selector
	"If I am involved in arithmetic with an Integer, convert it to a Fraction."
	^ (Fraction numerator: rcvr denominator: 1) perform: selector with: self! !

!Fraction methodsFor: 'private' stamp: ''!
reduced

	| gcd numer denom |
	numerator = 0 ifTrue: [^0].
	gcd := numerator gcd: denominator.
	numer := numerator // gcd.
	denom := denominator // gcd.
	denom = 1 ifTrue: [^numer].
	^Fraction numerator: numer denominator: denom! !

!Fraction methodsFor: 'truncation and round off' stamp: 'GuillermoPolito 6/22/2012 14:49'!
round: numberOfWishedDecimal
	^self asFloat round: numberOfWishedDecimal! !

!Fraction methodsFor: 'self evaluating' stamp: 'apb 4/20/2006 18:41'!
isSelfEvaluating 
	^ true! !

!Fraction methodsFor: 'arithmetic' stamp: 'di 11/6/1998 13:58'!
* aNumber 
	"Answer the result of multiplying the receiver by aNumber."
	| d1 d2 |
	aNumber isFraction ifTrue: 
		[d1 := numerator gcd: aNumber denominator.
		d2 := denominator gcd: aNumber numerator.
		(d2 = denominator and: [d1 = aNumber denominator])
			ifTrue: [^ numerator // d1 * (aNumber numerator // d2)].
		^ Fraction numerator: numerator // d1 * (aNumber numerator // d2)
				denominator: denominator // d2 * (aNumber denominator // d1)].
	^ aNumber adaptToFraction: self andSend: #*! !

!Fraction methodsFor: 'arithmetic' stamp: 'di 11/6/1998 13:58'!
/ aNumber
	"Answer the result of dividing the receiver by aNumber."
	aNumber isFraction
		ifTrue: [^self * aNumber reciprocal].
	^ aNumber adaptToFraction: self andSend: #/! !

!Fraction methodsFor: 'comparing' stamp: 'nice 1/4/2009 17:34'!
<= aNumber
	aNumber isFraction ifTrue:
		[^ numerator * aNumber denominator <= (aNumber numerator * denominator)].
	^ aNumber adaptToFraction: self andCompare: #<=! !

!Fraction class methodsFor: '*AST-Core-Parser' stamp: 'YuriyTymchuk 10/29/2013 11:10'!
readFrom: stringOrStream 
	"Answer a Fraction as described on aStream with following rules:
	- numerator can specify a different radix (like '16rABC').
	- fraction sign '/' is optional, and must immediately follow numerator without space.
	- denominator must immediately follow fraction sign and can specify a different radix (like 16rABC).
	If stringOrStream does not start with a valid number description, fail."
	
	^(NumberParser on: stringOrStream) nextFraction! !

!Fraction class methodsFor: 'instance creation' stamp: 'di 8/31/1999 10:16'!
numerator: numInteger denominator: denInteger 
	"Answer an instance of me (numInteger/denInteger).
	NOTE: This primitive initialization method will not reduce improper fractions,
	so normal usage should be coded as, eg,
		(Fraction numerator: a denominator: b) reduced
	or, more simply, as
		a / b."

	^self new setNumerator: numInteger denominator: denInteger! !

!FractionTest commentStamp: 'TorstenBergmann 2/5/2014 08:36'!
SUnit tests for fractions!
!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'CamilloBruni 8/31/2013 20:23'!
testDegreeCos
	"self run: #testDegreeCos"

	(4 / 3) degreeCos.
	-361 / 3 to: 359 / 3 do: [ :i | self assert: (i degreeCos closeTo: i degreesToRadians cos) ]! !

!FractionTest methodsFor: 'private' stamp: 'jmv 10/11/2011 22:12'!
assert: a classAndValueEquals: b
	self assert: a class = b class.
	self assert: a = b! !

!FractionTest methodsFor: 'tests - conversions' stamp: 'nice 6/3/2011 21:32'!
testFloor
	self assert: (3 / 2) floor = 1.
	self assert: (-3 / 2) floor = -2.! !

!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/13/2011 21:38'!
testInexactRaisedTo
	"
	FractionTest new testInexactRaisedTo
	"
	self assert: (((1 << 1024 + 1) / (1 << 1024 + 3)) raisedTo: 1/3) = 1.0.
	self assert: (((1 << 1024 + 1) / (1 << 1024 + 3)) negated raisedTo: 1/3) = -1.0! !

!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/13/2011 21:48'!
testSqrtErrorConditions
	"
	FractionTest new testSqrtErrorConditions
	"
	self should: [ (-1/4) sqrt ] raise: DomainError.
	self should: [ ((1 << 1024 + 1) / (1 << 1024 + 3)) negated sqrt ] raise: DomainError! !

!FractionTest methodsFor: 'tests - conversions' stamp: 'HenrikSperreJohansen 1/19/2012 16:15'!
testAsSmallerPowerOfTwo

"SmallIntegers, Fraction value < 1"
	"Exact power of two"
	self assert: (1/2) asSmallerPowerOfTwo equals: 1/2.
	"Non-reduced exact power of two"
	self assert: (Fraction numerator: 2 denominator:  4) asSmallerPowerOfTwo equals: 1/2.
	"Not power of two"
	self assert: (2 / 5) asSmallerPowerOfTwo equals: 1/4.
	"Non-reduced non-power of two"
	self assert: (Fraction numerator: 10 denominator: 25) asSmallerPowerOfTwo equals: 1/4.
"SmallIntegers, Fraction value  > 1"
	"Exact power of two"
	self assert: (Fraction numerator: 2 denominator:  1) asSmallerPowerOfTwo equals: 2.
	"Non-reduced exact power of two"
	self assert: (Fraction numerator: 4 denominator:  2) asSmallerPowerOfTwo equals: 2.
	"Not power of two"
	self assert: (11 / 2) asSmallerPowerOfTwo equals: 4.
	"Non-reduced non-power of two"
	self assert: (Fraction numerator: 44 denominator: 8) asSmallerPowerOfTwo equals: 4.
"LargeIntegers, Fraction value < 1"
	"Exact power of two"
	self assert: (1/(2 raisedTo:80)) asSmallerPowerOfTwo equals: 1/(2 raisedTo: 80).
	"Non-reduced exact power of two"
	self assert: (Fraction numerator: (2 raisedTo: 80) denominator: (2 raisedTo: 160)) asSmallerPowerOfTwo equals: 1/(2 raisedTo: 80).
	"Not power of two"
	self assert: (1/((2 raisedTo:80) - 1)) asSmallerPowerOfTwo equals: 1/(2 raisedTo: 80).
	"Non-reduced non-power of two"
	self assert: (Fraction numerator: (2 raisedTo: 80) denominator: (2 raisedTo: 160) - 1) asSmallerPowerOfTwo equals: 1/(2 raisedTo: 80).
"LargeIntegers, Fraction value > 1"
	"Exact power of two"
	self assert: (Fraction numerator: (2 raisedTo:80) denominator:  1) asSmallerPowerOfTwo equals: (2 raisedTo: 80).
	"Non-reduced exact power of two"
	self assert: (Fraction numerator: (2 raisedTo: 160) denominator: (2 raisedTo: 80)) asSmallerPowerOfTwo equals: (2 raisedTo: 80).
	"Not power of two"
	self assert: (Fraction numerator: (2 raisedTo:80) +1 denominator:  1) asSmallerPowerOfTwo equals: (2 raisedTo: 80).
	"Non-reduced non-power of two"
	self assert: (Fraction numerator: (2 raisedTo: 160) +1 denominator: (2 raisedTo: 80)) asSmallerPowerOfTwo equals: (2 raisedTo: 80).

	
"Error condition: numerator is 0"
	self should: [(Fraction numerator: 0 denominator: 1) asSmallerPowerOfTwo] raise: DomainError.
"Errro condition: Negative fraction"
	"SmallIntegers, variations of negated numerator/denominator, and reduced/ non-reduced "
	self should: [(Fraction numerator: 1 negated denominator: 2) asSmallerPowerOfTwo] raise: DomainError.
	self should: [(Fraction numerator: 1 denominator: 2 negated) asSmallerPowerOfTwo] raise: DomainError.
	self should: [(Fraction numerator: 2 negated denominator: 4) asSmallerPowerOfTwo] raise: DomainError.
	self should: [(Fraction numerator: 2 denominator: 4 negated) asSmallerPowerOfTwo] raise: DomainError.
	"LargeNegativeIntegers, variations of negated numerator/denominator, and reduced/ non-reduced "
	self should: [(Fraction numerator: 1 negated denominator: (2 raisedTo: 80)) asSmallerPowerOfTwo] raise: DomainError.
	self should: [(Fraction numerator: 1 denominator:(2 raisedTo: 80) negated) asSmallerPowerOfTwo] raise: DomainError.
	self should: [(Fraction numerator: (2 raisedTo: 80) negated denominator: (2 raisedTo: 160)) asSmallerPowerOfTwo] raise: DomainError.
	self should: [(Fraction numerator: (2 raisedTo: 80) denominator: (2 raisedTo: 160) negated) asSmallerPowerOfTwo] raise: DomainError
! !

!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'nice 12/11/2012 19:56'!
testFloorLog
	self assert: (1/100 floorLog: 10) = -2.
	self assert: (((2 raisedTo: Float emax + 11)/3) floorLog: 10)
		= ((Float emax + 11)*2 log - 3 log) floor description: 'Fraction>>log should not overflow'.
	self assert: ((3/(2 raisedTo: Float precision - Float emin)) floorLog: 10)
		= ((Float emin - Float precision)*2 log + 3 log) floor description: 'Fraction>>log should not underflow'! !

!FractionTest methodsFor: 'tests - reading' stamp: 'nice 10/30/2011 16:46'!
testReadFrom
	self assert: (Fraction readFromString: '3') = 3 description: 'denominator is optional'.
	self assert: (Fraction readFromString: '2/3') = (2/3) description: 'fraction and denominator must follow numerator'.
	self assert: (Fraction readFromString: '-2/3') = (-2/3) description: 'numerator can specify a minus sign'.
	.self assert: (Fraction readFromString: '2/-5') = (-2/5) description: 'denominator can specify a minus sign'.
	self assert: (Fraction readFromString: '-3/-7') = (3/7) description: 'numerator and denominator can both specify a minus sign'.
	self assert: (Fraction readFromString: '2e3/3') = (2000/3) description: 'numerator can specify an exponent'.
	self assert: (Fraction readFromString: '3/1e4') = (3/10000) description: 'denominator can specify an exponent'.
	self assert: (Fraction readFromString: '16rA0/3') = (160/3) description: 'numerator can specify a radix'.
	self assert: (Fraction readFromString: '1/3r22') = (1/8) description: 'denominator can specify a radix'.! !

!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/11/2011 22:27'!
testExactRaisedTo
	"
	FractionTest new testExactRaisedTo
	"
	| f |
	self assert: (4/9 raisedTo: 1/2) classAndValueEquals: 2/3.
	self assert: (9/4 raisedTo: 1/2) classAndValueEquals: 3/2.
	#( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) pairsDo: [ :a :b |
		f := a / b.
		self assert: (f squared raisedTo: 1/2) classAndValueEquals: f.
		self assert: (f negated squared raisedTo: 1/2) classAndValueEquals: f.
		f := b / a.
		self assert: (f squared raisedTo: 1/2) classAndValueEquals: f.
		self assert: (f negated squared raisedTo: 1/2) classAndValueEquals: f ].

	self assert: (8/27 raisedTo: 1/3) classAndValueEquals: 2/3.
	self assert: (27/8 raisedTo: 1/3) classAndValueEquals: 3/2.
	#( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) pairsDo: [ :a :b |
		f := a / b.
		self assert: ((f raisedTo: 3) raisedTo: 1/3) classAndValueEquals: f.
		self assert: ((f negated raisedTo: 3) raisedTo: 1/3) classAndValueEquals: f negated.
		f := b / a.
		self assert: ((f raisedTo: 3) raisedTo: 1/3) classAndValueEquals: f.
		self assert: ((f negated raisedTo: 3) raisedTo: 1/3) classAndValueEquals: f negated ].

	self assert: (4/9 raisedTo: 3/2) classAndValueEquals: 8/27.
	self assert: (8/27 raisedTo: 2/3) classAndValueEquals: 4/9.
	#( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) pairsDo: [ :a :b |
		f := a / b.
		self assert: ((f raisedTo: 3) raisedTo: 2/3) classAndValueEquals: f*f.
		self assert: ((f raisedTo: 2) raisedTo: 3/2) classAndValueEquals: f*f*f.
		self assert: ((f negated raisedTo: 3) raisedTo: 2/3) classAndValueEquals: f*f.
		self assert: ((f negated raisedTo: 2) raisedTo: 3/2) classAndValueEquals: f*f*f.
		f := b / a.
		self assert: ((f raisedTo: 3) raisedTo: 2/3) classAndValueEquals: f*f.
		self assert: ((f raisedTo: 2) raisedTo: 3/2) classAndValueEquals: f*f*f.
		self assert: ((f negated raisedTo: 3) raisedTo: 2/3) classAndValueEquals: f*f.
		self assert: ((f negated raisedTo: 2) raisedTo: 3/2) classAndValueEquals: f*f*f ].

	self assert: (32/243 raisedTo: 3/5) classAndValueEquals: 8/27.
	self assert: (8/27 raisedTo: 5/3) classAndValueEquals: 32/243.
	#( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) pairsDo: [ :a :b |
		f := a / b.
		self assert: ((f raisedTo: 5) raisedTo: 3/5) classAndValueEquals: f*f*f.
		self assert: ((f raisedTo: 3) raisedTo: 5/3) classAndValueEquals: f*f*f*f*f.
		self assert: ((f negated raisedTo: 5) raisedTo: 3/5) classAndValueEquals: (f*f*f) negated.
		self assert: ((f negated raisedTo: 3) raisedTo: 5/3) classAndValueEquals: (f*f*f*f*f) negated.

		self assert: ((f raisedTo: -5) raisedTo: 3/5) classAndValueEquals: 1/(f*f*f).
		self assert: ((f raisedTo: -3) raisedTo: 5/3) classAndValueEquals: 1/(f*f*f*f*f).
		self assert: ((f negated raisedTo: -5) raisedTo: 3/5) classAndValueEquals: -1/(f*f*f).
		self assert: ((f negated raisedTo: -3) raisedTo: 5/3) classAndValueEquals: -1/(f*f*f*f*f).
		self assert: ((f raisedTo: 5) raisedTo: -3/5) classAndValueEquals: 1/(f*f*f).
		self assert: ((f raisedTo: 3) raisedTo: -5/3) classAndValueEquals: 1/(f*f*f*f*f).
		self assert: ((f negated raisedTo: 5) raisedTo: -3/5) classAndValueEquals: -1/(f*f*f).
		self assert: ((f negated raisedTo: 3) raisedTo: -5/3) classAndValueEquals: -1/(f*f*f*f*f).

		"No exact result => Float result"
		self assert: ((f raisedTo: 3) +1 raisedTo: 5/3) isFloat.
		self assert: ((f negated raisedTo: 3) -1 raisedTo: 5/3) isFloat.

		f := b / a.
		self assert: ((f raisedTo: 5) raisedTo: 3/5) classAndValueEquals: f*f*f.
		self assert: ((f raisedTo: 3) raisedTo: 5/3) classAndValueEquals: f*f*f*f*f.
		self assert: ((f negated raisedTo: 5) raisedTo: 3/5) classAndValueEquals: (f*f*f) negated.
		self assert: ((f negated raisedTo: 3) raisedTo: 5/3) classAndValueEquals: (f*f*f*f*f) negated.

		"No exact result => Float result"
		self assert: ((f raisedTo: 3) +1 raisedTo: 5/3) isFloat.
		self assert: ((f negated raisedTo: 3) -1 raisedTo: 5/3) isFloat ].! !

!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'nice 6/12/2010 00:35'!
testLn
	self assert: ((1/100) ln closeTo: -2 * 10 ln).
	self assert: (((2 raisedTo: Float emax + 11)/3) ln closeTo: (Float emax + 11)*2 ln - 3 ln) description: 'Fraction>>ln should not overflow'.
	self assert: ((3/(2 raisedTo: Float precision - Float emin)) ln closeTo: (Float emin - Float precision)*2 ln + 3 ln) description: 'Fraction>>ln should not underflow'! !

!FractionTest methodsFor: 'tests - conversions' stamp: 'nice 6/3/2011 21:32'!
testCeiling
	self assert: (3 / 2) ceiling = 2.
	self assert: (-3 / 2) ceiling = -1.! !

!FractionTest methodsFor: 'tests - conversions' stamp: 'HenrikSperreJohansen 1/19/2012 16:15'!
testAsLargerPowerOfTwo

"SmallIntegers, Fraction value < 1"
	"Exact power of two"
	self assert: (1/2) asLargerPowerOfTwo equals: 1/2.
	"Non-reduced exact power of two"
	self assert: (Fraction numerator: 2 denominator:  4) asLargerPowerOfTwo equals: 1/2.
	"Not power of two"
	self assert: (2 / 5) asLargerPowerOfTwo equals: 1/2.
	"Non-reduced non-power of two"
	self assert: (Fraction numerator: 10 denominator: 25) asLargerPowerOfTwo equals: 1/2.
"SmallIntegers, Fraction value  > 1"
	"Exact power of two"
	self assert: (Fraction numerator: 2 denominator:  1) asLargerPowerOfTwo equals: 2.
	"Non-reduced exact power of two"
	self assert: (Fraction numerator: 4 denominator:  2) asLargerPowerOfTwo equals: 2.
	"Not power of two"
	self assert: (3 / 2) asLargerPowerOfTwo equals: 2.
	"Non-reduced non-power of two"
	self assert: (Fraction numerator: 12 denominator: 8) asLargerPowerOfTwo equals: 2.
"LargeIntegers, Fraction value < 1"
	"Exact power of two"
	self assert: (1/(2 raisedTo:80)) asLargerPowerOfTwo equals: 1/(2 raisedTo: 80).
	"Non-reduced exact power of two"
	self assert: (Fraction numerator: (2 raisedTo: 80) denominator: (2 raisedTo: 160)) asLargerPowerOfTwo equals: 1/(2 raisedTo: 80).
	"Not power of two"
	self assert: (1/((2 raisedTo: 80)+1)) asLargerPowerOfTwo equals: 1/(2 raisedTo: 80).
	"Non-reduced non-power of two"
	self assert: (Fraction numerator: (2 raisedTo: 80) denominator: (2 raisedTo: 160) + 1) asLargerPowerOfTwo equals: 1/(2 raisedTo: 80).
"LargeIntegers, Fraction value > 1"
	"Exact power of two"
	self assert: (Fraction numerator: (2 raisedTo:80) denominator:  1) asLargerPowerOfTwo equals: (2 raisedTo: 80).
	"Non-reduced exact power of two"
	self assert: (Fraction numerator: (2 raisedTo: 160) denominator: (2 raisedTo: 80)) asLargerPowerOfTwo equals: (2 raisedTo: 80).
	"Not power of two"
	self assert: (Fraction numerator: (2 raisedTo:80) -1 denominator:  1) asLargerPowerOfTwo equals: (2 raisedTo: 80).
	"Non-reduced non-power of two"
	self assert: (Fraction numerator: (2 raisedTo: 160) -1 denominator: (2 raisedTo: 80)) asLargerPowerOfTwo equals: (2 raisedTo: 80).

	
"Error condition: numerator is 0"
	self should: [(Fraction numerator: 0 denominator: 1) asLargerPowerOfTwo] raise: DomainError.
"Errro condition: Negative fraction"
	"SmallIntegers, variations of negated numerator/denominator, and reduced/ non-reduced "
	self should: [(Fraction numerator: 1 negated denominator: 2) asLargerPowerOfTwo] raise: DomainError.
	self should: [(Fraction numerator: 1 denominator: 2 negated) asLargerPowerOfTwo] raise: DomainError.
	self should: [(Fraction numerator: 2 negated denominator: 4) asLargerPowerOfTwo] raise: DomainError.
	self should: [(Fraction numerator: 2 denominator: 4 negated) asLargerPowerOfTwo] raise: DomainError.
	"LargeNegativeIntegers, variations of negated numerator/denominator, and reduced/ non-reduced "
	self should: [(Fraction numerator: 1 negated denominator: (2 raisedTo: 80)) asLargerPowerOfTwo] raise: DomainError.
	self should: [(Fraction numerator: 1 denominator:(2 raisedTo: 80) negated) asLargerPowerOfTwo] raise: DomainError.
	self should: [(Fraction numerator: (2 raisedTo: 80) negated denominator: (2 raisedTo: 160)) asLargerPowerOfTwo] raise: DomainError.
	self should: [(Fraction numerator: (2 raisedTo: 80) denominator: (2 raisedTo: 160) negated) asLargerPowerOfTwo] raise: DomainError
	
! !

!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/13/2011 21:49'!
testRaisedToErrorConditions
	"
	FractionTest new testRaisedToErrorConditions
	"
	self should: [ (-1/16) raisedTo: 1/4 ] raise: ArithmeticError.
	self should: [ ((1 << 1024 + 1) / (1 << 1024 + 3)) negated raisedTo: 1/4 ] raise: ArithmeticError! !

!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'nice 10/19/2011 20:48'!
testNthRoot
	self assert: ((-2 raisedTo: 35) / (3 raisedTo: 20) raisedTo: 1/5) equals: (-2 raisedTo: 7) / (3 raisedTo: 4).
	self assert: (1 / (1 << 2000) raisedTo: 1/100) equals: 1 / (1 << 20)! !

!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'nice 6/12/2010 00:37'!
testLog
	self assert: ((1/100) log closeTo: -2).
	self assert: (((2 raisedTo: Float emax + 11)/3) log closeTo: (Float emax + 11)*2 log - 3 log) description: 'Fraction>>log should not overflow'.
	self assert: ((3/(2 raisedTo: Float precision - Float emin)) log closeTo: (Float emin - Float precision)*2 log + 3 log) description: 'Fraction>>log should not underflow'! !

!FractionTest methodsFor: 'tests - reading' stamp: 'nice 10/30/2011 16:56'!
testIvalidReadFrom
	self should: [Fraction readFromString: '+3'] raise: Error description: 'numerator cannot specify a plus sign'.
	self should: [Fraction readFromString: '-2/+3'] raise: Error description: 'denominator cannot specify a plus sign'.
	self should: [Fraction readFromString: '(3/2)'] raise: Error description: 'parenthesis are not allowed'.
	self should: [Fraction readFromString: ' 3/25'] raise: Error description: 'leading spaces are not allowed before numerator'.
	self should: [Fraction readFromString: '22/ 3'] raise: Error description: 'leading spaces are not allowed before denominator'.
	
	"These behaviours are questionnable, but that's currently how it works:"
	self assert: (Fraction readFromString: '12345with some trailing characters') = 12345 description: 'non numeric trailing characters interrupt decoding'.
	self assert: (Fraction readFromString: '1 / 2') = 1 description: 'A space behind numerator interrupt decoding'.
	self assert: (Fraction readFromString: '22.0/3') = 22 description: 'decimal point interrupt decoding'.
	self assert: (Fraction readFromString: '23s0/3') = 23 description: 'scale specification interrupt decoding'.! !

!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'CamilloBruni 8/31/2013 20:23'!
testDegreeSin
	"self run: #testDegreeSin"

	(4 / 3) degreeSin.
	-361 / 3 to: 359 / 3 do: [ :i | self assert: (i degreeSin closeTo: i degreesToRadians sin) ]! !

!FractionTest methodsFor: 'tests - conversions' stamp: 'nice 6/3/2011 21:39'!
testRounded
	self assert: (4 / 5) rounded = 1.
	self assert: (6 / 5) rounded = 1.
	self assert: (-4 / 5) rounded = -1.
	self assert: (-6 / 5) rounded = -1.
	
	"In case of tie, round to upper magnitude"
	self assert: (3 / 2) rounded = 2.
	self assert: (-3 / 2) rounded = -2.! !

!FractionTest methodsFor: 'tests - sinuses' stamp: 'GabrielOmarCotelli 5/23/2009 20:19'!
testReciprocal

	self 
		assert: (1/2) reciprocal = 2;
		assert: (3/4) reciprocal = (4/3);
		assert: (-1/3) reciprocal = -3;
		assert: (-3/5) reciprocal = (-5/3)! !

!FractionTest methodsFor: 'tests - conversions' stamp: 'HenrikSperreJohansen 1/19/2012 16:08'!
testIsPowerOfTwo
	"LargeNegativeIntegers"
	self deny: (1 / (2 raisedTo: 80) negated) isPowerOfTwo.
	self deny: (1 negated / (2 raisedTo: 80) ) isPowerOfTwo.
	self deny: ((2 raisedTo: 80) negated / 3) isPowerOfTwo.
	self deny: ((2 raisedTo: 80) / 4 negated) isPowerOfTwo.
	"Negative SmallIntegers"
	self deny: (1/ 2 negated) isPowerOfTwo.
	" 0, incase implementation has forgotten edge case"
	self deny: (0 isPowerOfTwo).
	"Positive SmallIntegers"
	self assert: (1 isPowerOfTwo).
	self assert: (2 isPowerOfTwo).
	self deny:  (3 isPowerOfTwo).
	self assert: (4 isPowerOfTwo).
	self deny: (5 isPowerOfTwo).
	" LargePositiveIntegers"
	self deny: ((2 raisedTo: 80) - 1) isPowerOfTwo.
	self assert: (2 raisedTo: 80) isPowerOfTwo.
	self deny: ((2 raisedTo: 80) + 1) isPowerOfTwo! !

!FractionTest methodsFor: 'tests - rounding' stamp: 'GuillermoPolito 6/22/2012 14:51'!
testRounding
        "
        self debug: #testRounding
        "

        self assert: ((6/90) round: 2) equals: 0.07! !

!FractionTest methodsFor: 'tests - conversions' stamp: 'nice 6/3/2011 21:35'!
testTruncated
	self assert: (3 / 2) truncated = 1.
	self assert: (-3 / 2) truncated = -1.! !

!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/13/2011 21:27'!
testInexactSqrt
	"
	FractionTest new testInexactSqrt
	"
	self assert: ((1 << 1024 + 1) / (1 << 1024 + 3)) sqrt = 1.0! !

!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/11/2011 22:12'!
testExactSqrt
	"
	FractionTest new testExactSqrt
	"
	| f |
	self assert: (4/9) sqrt classAndValueEquals: 2/3.
	#( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) pairsDo: [ :i :j |
		f := i / j.
		self assert: f squared sqrt classAndValueEquals: f.
		f := j / i.
		self assert: f squared sqrt classAndValueEquals: f ]! !

!FractionTest methodsFor: 'tests - printing' stamp: 'nice 3/5/2010 22:35'!
testFractionPrinting

	self assert: (353/359) printString = '(353/359)'.
	self assert: ((2/3) printStringBase: 2) = '(10/11)'.
	self assert: ((2/3) storeStringBase: 2) = '(2r10/2r11)'.
	self assert: ((5/7) printStringBase: 3) = '(12/21)'.
	self assert: ((5/7) storeStringBase: 3) = '(3r12/3r21)'.
	self assert: ((11/13) printStringBase: 4) = '(23/31)'.
	self assert: ((11/13) storeStringBase: 4) = '(4r23/4r31)'.
	self assert: ((17/19) printStringBase: 5) = '(32/34)'.
	self assert: ((17/19) storeStringBase: 5) = '(5r32/5r34)'.
	self assert: ((23/29) printStringBase: 6) = '(35/45)'.
	self assert: ((23/29) storeStringBase: 6) = '(6r35/6r45)'.
	self assert: ((31/37) printStringBase: 7) = '(43/52)'.
	self assert: ((31/37) storeStringBase: 7) = '(7r43/7r52)'.
	self assert: ((41/43) printStringBase: 8) = '(51/53)'.
	self assert: ((41/43) storeStringBase: 8) = '(8r51/8r53)'.
	self assert: ((47/53) printStringBase: 9) = '(52/58)'.
	self assert: ((47/53) storeStringBase: 9) = '(9r52/9r58)'.
	self assert: ((59/61) printStringBase: 10) = '(59/61)'.
	self assert: ((59/61) storeStringBase: 10) = '(59/61)'.
	self assert: ((67/71) printStringBase: 11) = '(61/65)'.
	self assert: ((67/71) storeStringBase: 11) = '(11r61/11r65)'.
	self assert: ((73/79) printStringBase: 12) = '(61/67)'.
	self assert: ((73/79) storeStringBase: 12) = '(12r61/12r67)'.
	self assert: ((83/89) printStringBase: 13) = '(65/6B)'.
	self assert: ((83/89) storeStringBase: 13) = '(13r65/13r6B)'.
	self assert: ((97/101) printStringBase: 14) = '(6D/73)'.
	self assert: ((97/101) storeStringBase: 14) = '(14r6D/14r73)'.
	self assert: ((103/107) printStringBase: 15) = '(6D/72)'.
	self assert: ((103/107) storeStringBase: 15) = '(15r6D/15r72)'.
	self assert: ((109/113) printStringBase: 16) = '(6D/71)'.
	self assert: ((109/113) storeStringBase: 16) = '(16r6D/16r71)'.
	self assert: ((127/131) printStringBase: 17) = '(78/7C)'.
	self assert: ((127/131) storeStringBase: 17) = '(17r78/17r7C)'.
	self assert: ((137/139) printStringBase: 18) = '(7B/7D)'.
	self assert: ((137/139) storeStringBase: 18) = '(18r7B/18r7D)'.
	self assert: ((149/151) printStringBase: 19) = '(7G/7I)'.
	self assert: ((149/151) storeStringBase: 19) = '(19r7G/19r7I)'.
	self assert: ((157/163) printStringBase: 20) = '(7H/83)'.
	self assert: ((157/163) storeStringBase: 20) = '(20r7H/20r83)'.
	self assert: ((167/173) printStringBase: 21) = '(7K/85)'.
	self assert: ((167/173) storeStringBase: 21) = '(21r7K/21r85)'.
	self assert: ((179/181) printStringBase: 22) = '(83/85)'.
	self assert: ((179/181) storeStringBase: 22) = '(22r83/22r85)'.
	self assert: ((191/193) printStringBase: 23) = '(87/89)'.
	self assert: ((191/193) storeStringBase: 23) = '(23r87/23r89)'.
	self assert: ((197/199) printStringBase: 24) = '(85/87)'.
	self assert: ((197/199) storeStringBase: 24) = '(24r85/24r87)'.
	self assert: ((211/223) printStringBase: 25) = '(8B/8N)'.
	self assert: ((211/223) storeStringBase: 25) = '(25r8B/25r8N)'.
	self assert: ((227/229) printStringBase: 26) = '(8J/8L)'.
	self assert: ((227/229) storeStringBase: 26) = '(26r8J/26r8L)'.
	self assert: ((233/239) printStringBase: 27) = '(8H/8N)'.
	self assert: ((233/239) storeStringBase: 27) = '(27r8H/27r8N)'.
	self assert: ((241/251) printStringBase: 28) = '(8H/8R)'.
	self assert: ((241/251) storeStringBase: 28) = '(28r8H/28r8R)'.
	self assert: ((257/263) printStringBase: 29) = '(8P/92)'.
	self assert: ((257/263) storeStringBase: 29) = '(29r8P/29r92)'.
	self assert: ((269/271) printStringBase: 30) = '(8T/91)'.
	self assert: ((269/271) storeStringBase: 30) = '(30r8T/30r91)'.
	self assert: ((277/281) printStringBase: 31) = '(8T/92)'.
	self assert: ((277/281) storeStringBase: 31) = '(31r8T/31r92)'.
	self assert: ((283/293) printStringBase: 32) = '(8R/95)'.
	self assert: ((283/293) storeStringBase: 32) = '(32r8R/32r95)'.
	self assert: ((307/311) printStringBase: 33) = '(9A/9E)'.
	self assert: ((307/311) storeStringBase: 33) = '(33r9A/33r9E)'.
	self assert: ((313/317) printStringBase: 34) = '(97/9B)'.
	self assert: ((313/317) storeStringBase: 34) = '(34r97/34r9B)'.
	self assert: ((331/337) printStringBase: 35) = '(9G/9M)'.
	self assert: ((331/337) storeStringBase: 35) = '(35r9G/35r9M)'.
	self assert: ((347/349) printStringBase: 36) = '(9N/9P)'.
	self assert: ((347/349) storeStringBase: 36) = '(36r9N/36r9P)'.

	self assert: ((-2/3) printStringBase: 2) = '(-10/11)'.
	self assert: ((-2/3) storeStringBase: 2) = '(-2r10/2r11)'.
	self assert: ((5 / -7) printStringBase: 3) = '(-12/21)'.
	self assert: ((5 / -7) storeStringBase: 3) = '(-3r12/3r21)'.
! !

!FreeTypeCache commentStamp: 'TorstenBergmann 2/4/2014 22:09'!
Cache for freetype fonts!
!FreeTypeCache methodsFor: 'public' stamp: 'tween 8/10/2006 15:14'!
sizeOf: anObject
	^(anObject isKindOf: Form)
		ifTrue:[(anObject bitsSize * 4) + 32]
		ifFalse:[4]
	! !

!FreeTypeCache methodsFor: 'private' stamp: 'tween 8/10/2006 13:22'!
fifoEntryClass
	^FreeTypeCacheEntry! !

!FreeTypeCache methodsFor: 'public' stamp: 'ClementBera 7/26/2013 16:41'!
report
	"answer a description of the current state of the cache"
	| usedPercent |
	usedPercent := maximumSize 
		ifNil: [0]
		ifNotNil: [(used * 100 / maximumSize) asFloat rounded].
	^usedPercent asString,'% Full (maximumSize: ', maximumSize asString, ' , used: ', used asString,')'! !

!FreeTypeCache methodsFor: 'private' stamp: 'tween 8/10/2006 13:20'!
dictionaryClass
	^Dictionary! !

!FreeTypeCache methodsFor: 'add-remove' stamp: 'tween 8/10/2006 19:34'!
atFont: aFreeTypeFont charCode: charCodeInteger type: typeFlag 
	| entry charCodeTable typeTable |
	(charCodeTable := fontTable at: aFreeTypeFont ifAbsent:[])
		ifNotNil:[
			(typeTable := charCodeTable at: charCodeInteger ifAbsent:[])
				ifNotNil:[
					(entry := typeTable at: typeFlag ifAbsent:[])
						ifNotNil:[
							fifo moveDown: entry.
							^entry object]]].
	self error: 'Not found'! !

!FreeTypeCache methodsFor: 'public' stamp: 'AlainPlantec 11/26/2009 21:58'!
cacheSize
	^ self maximumSize / 1024! !

!FreeTypeCache methodsFor: 'private' stamp: 'tween 8/10/2006 19:03'!
fifoClass
	^FreeTypeCacheLinkedList! !

!FreeTypeCache methodsFor: 'private' stamp: 'tween 9/29/2007 20:10'!
shrinkTo: newSize
	"if the used size is greater than newSize, then remove all the receiver's entries"
	
	used > newSize ifTrue:[self removeAll]! !

!FreeTypeCache methodsFor: 'add-remove' stamp: 'nice 1/5/2010 15:59'!
removeAllForType: typeFlag
	| toRemove |
	
	toRemove := IdentitySet new.
	fifo do:[:entry |
		entry type = typeFlag
			ifTrue:[toRemove add: entry]].
	toRemove do:[:entry | | d | 
		fifo remove: entry.
		d := (fontTable at: entry font) at: entry charCode.
		d removeKey: entry type.	
		used := used - (self sizeOf: entry object) ]. 

	! !

!FreeTypeCache methodsFor: 'public' stamp: 'AlainPlantec 11/13/2009 14:46'!
maximumSize

	^ maximumSize ! !

!FreeTypeCache methodsFor: 'add-remove' stamp: 'ClementBera 7/26/2013 16:40'!
atFont: aFreeTypeFont charCode: charCodeInteger type: typeFlag put: anObject 
	| charCodeTable typeTable anObjectSize oldEntry oldEntrySize entry |
	
	anObjectSize := self sizeOf: anObject.
	(maximumSize notNil and:[anObjectSize > maximumSize]) 
		ifTrue:[^anObject].  
	(charCodeTable := fontTable at: aFreeTypeFont ifAbsentPut:[self dictionaryClass new: 60])
		ifNotNil:[
			(typeTable := charCodeTable at: charCodeInteger ifAbsentPut:[self dictionaryClass new: 10])
				ifNotNil:[
					oldEntry := typeTable at: typeFlag ifAbsent:[].
					oldEntrySize := (oldEntry 
						ifNil:[0] 
						ifNotNil:[self sizeOf: oldEntry object]). 
					entry := (self fifoEntryClass new
						font: aFreeTypeFont;
						charCode: charCodeInteger;
						type: typeFlag;
						object: anObject;
						yourself).
					typeTable at: typeFlag put: entry]].
	used := used + anObjectSize - oldEntrySize.
	oldEntry ifNotNil: [fifo remove: oldEntry].
	fifo addLast: entry.
	maximumSize ifNotNil:[self shrinkTo: maximumSize].
	^anObject
	! !

!FreeTypeCache methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 09:54'!
initialize
	super initialize.
	maximumSize := self class defaultMaximumSize.
	fontTable := self dictionaryClass new: 100.
	used := 0.
	fifo := self fifoClass new
	! !

!FreeTypeCache methodsFor: 'public' stamp: 'tween 8/10/2006 12:56'!
maximumSize: anIntegerOrNil

	maximumSize := anIntegerOrNil.
	maximumSize ifNotNil:[
		used > maximumSize
			ifTrue:["shrink"
				self shrinkTo: maximumSize]]! !

!FreeTypeCache methodsFor: 'add-remove' stamp: 'tween 8/10/2006 21:20'!
atFont: aFreeTypeFont charCode: charCodeInteger type: typeFlag ifAbsentPut: aBlock 
	| charCodeTable typeTable entry v vSize |
	
	charCodeTable := fontTable at: aFreeTypeFont ifAbsentPut:[self dictionaryClass new: 60].
	typeTable := charCodeTable at: charCodeInteger ifAbsentPut:[self dictionaryClass new: 10].
	entry := typeTable at: typeFlag ifAbsent:[].
	entry 
		ifNotNil:[
			fifo moveDown: entry.
			^entry object].
	v := aBlock value.
	vSize := self sizeOf: v.
	(maximumSize notNil and:[vSize > maximumSize]) 
		ifTrue:[^v].  
	used := used + vSize.
	entry := (self fifoEntryClass new
		 font: aFreeTypeFont;
		charCode: charCodeInteger;
		type: typeFlag;
		object: v;
		yourself).
	typeTable at: typeFlag put: entry.
	fifo addLast: entry.
	maximumSize ifNotNil:[self shrinkTo: maximumSize].
	^v
	! !

!FreeTypeCache methodsFor: 'public' stamp: 'AlainPlantec 11/26/2009 21:59'!
cacheSize: anInteger
	self maximumSize: (anInteger * 1024)! !

!FreeTypeCache methodsFor: 'add-remove' stamp: 'nice 1/5/2010 15:59'!
removeAllForFont: aFreeTypeFont
	| toRemove |
	
	(fontTable includesKey: aFreeTypeFont) ifFalse:[^self].
	toRemove := IdentitySet new.
	fifo do:[:entry |
		entry font = aFreeTypeFont
			ifTrue:[toRemove add: entry]].
	toRemove do:[:entry | | d | 
		fifo remove: entry.
		d := (fontTable at: entry font) at: entry charCode.
		d removeKey: entry type.	
		used := used - (self sizeOf: entry object) ]. 

	! !

!FreeTypeCache methodsFor: 'add-remove' stamp: 'tween 8/10/2006 13:40'!
removeAll
	fontTable := self dictionaryClass new: 100.
	fifo := self fifoClass new.
	used := 0.

	! !

!FreeTypeCache class methodsFor: 'system shutdown' stamp: 'tween 8/10/2006 15:44'!
clearCacheOnShutdown
	"answer true if the cache should be cleared on image shutdown"
	
	^true! !

!FreeTypeCache class methodsFor: 'accessing' stamp: 'tween 8/10/2006 15:45'!
initialize
	"
	self initialize.
	"
	
	Smalltalk addToShutDownList: self.  "should it be at a particular place in the list?"! !

!FreeTypeCache class methodsFor: 'accessing' stamp: 'tween 8/10/2006 09:30'!
defaultMaximumSize
	"answer the default maximumSize in bytes"
	^1024*5000 "5 Megabytes"! !

!FreeTypeCache class methodsFor: 'accessing' stamp: 'tween 8/10/2006 15:45'!
shutDown: quitting 

	(current notNil and: [self clearCacheOnShutdown])
		ifTrue:[self current removeAll]! !

!FreeTypeCache class methodsFor: 'accessing' stamp: 'tween 8/10/2006 15:33'!
clearCurrent
	"
	self clearCurrent.
	"
	current := nil! !

!FreeTypeCache class methodsFor: 'accessing' stamp: 'ClementBera 7/26/2013 16:16'!
current
	^ current ifNil: [  current := self new ]! !

!FreeTypeCache class methodsFor: 'cleanup' stamp: 'MarcusDenker 4/22/2011 10:32'!
cleanUp
	self clearCurrent! !

!FreeTypeCacheConstants commentStamp: 'TorstenBergmann 2/4/2014 22:09'!
Constants for the FreeType cache!
!FreeTypeCacheConstants class methodsFor: 'class initialization' stamp: 'tween 3/31/2007 21:31'!
initialize
	"
	FreeTypeCacheConstants initialize
	"
	
	FreeTypeCacheWidth := 0.
	FreeTypeCacheGlyph := 100.	"start at 100 and allow room for 64 subpixel positioned glyphs"
	FreeTypeCacheGlyphLCD := 200. "start at 200 and allow room for 64 subpixel positioned glyphs"
	FreeTypeCacheGlyphMono := 3.
	FreeTypeCacheLinearWidth := 4
	! !

!FreeTypeCacheEntry commentStamp: 'TorstenBergmann 2/4/2014 22:09'!
An entry for the FreeTypeCache!
!FreeTypeCacheEntry methodsFor: 'accessing' stamp: 'tween 8/10/2006 14:55'!
object: anObject
	"Set the value of object"

	object := anObject! !

!FreeTypeCacheEntry methodsFor: 'comparing' stamp: 'tween 8/10/2006 13:34'!
hash
	^charCode hash! !

!FreeTypeCacheEntry methodsFor: 'accessing' stamp: 'tween 8/10/2006 14:55'!
object
	"Answer the value of object"

	^ object! !

!FreeTypeCacheEntry methodsFor: 'comparing' stamp: 'tween 8/10/2006 14:58'!
= aFreeTypeCacheEntry
	"equailty based on font,charcode, type, object, but not nextLink"
	
	(aFreeTypeCacheEntry isKindOf: FreeTypeCacheEntry) 
		ifFalse:[^false].
	^font = aFreeTypeCacheEntry font and: [
		charCode = aFreeTypeCacheEntry charCode
			and: [type = aFreeTypeCacheEntry type
				and:[object = aFreeTypeCacheEntry object]]]! !

!FreeTypeCacheEntry methodsFor: 'accessing' stamp: 'tween 8/10/2006 13:16'!
charCode
	"Answer the value of charCode"

	^ charCode! !

!FreeTypeCacheEntry methodsFor: 'accessing' stamp: 'tween 8/10/2006 13:16'!
charCode: anObject
	"Set the value of charCode"

	charCode := anObject! !

!FreeTypeCacheEntry methodsFor: 'accessing' stamp: 'tween 8/10/2006 13:16'!
font
	"Answer the value of font"

	^ font! !

!FreeTypeCacheEntry methodsFor: 'accessing' stamp: 'tween 8/10/2006 13:16'!
type
	"Answer the value of type"

	^ type! !

!FreeTypeCacheEntry methodsFor: 'accessing' stamp: 'tween 8/10/2006 17:56'!
previousLink
	"Answer the value of previousLink"

	^ previousLink! !

!FreeTypeCacheEntry methodsFor: 'accessing' stamp: 'tween 8/10/2006 13:16'!
type: anObject
	"Set the value of type"

	type := anObject! !

!FreeTypeCacheEntry methodsFor: 'accessing' stamp: 'tween 8/10/2006 17:56'!
previousLink: anObject
	"Set the value of previousLink"

	previousLink := anObject! !

!FreeTypeCacheEntry methodsFor: 'accessing' stamp: 'tween 8/10/2006 13:16'!
font: anObject
	"Set the value of font"

	font := anObject! !

!FreeTypeCacheLinkedList commentStamp: 'TorstenBergmann 2/4/2014 22:09'!
A linked list for the FreeTypeCache!
!FreeTypeCacheLinkedList methodsFor: 'adding' stamp: 'nice 4/19/2011 00:03'!
add: link after: otherLink
	"Add otherLink  after link in the list. Answer aLink."

	| savedLink |

	savedLink := otherLink nextLink.
	otherLink nextLink: link.
	link nextLink:  savedLink.
	savedLink ifNotNil: [savedLink previousLink: link].
	link previousLink: otherLink.
	^link.
	
	! !

!FreeTypeCacheLinkedList methodsFor: 'removing' stamp: 'tween 8/10/2006 21:06'!
removeFirst
	"Remove the first element and answer it. If the receiver is empty, create 
	an error notification."

	| oldLink |
	self emptyCheck.
	oldLink := firstLink.
	oldLink previousLink: nil.
	lastLink == firstLink 
		ifTrue:[
			lastLink := firstLink := nil.
			oldLink nextLink: nil.
			^oldLink].
	firstLink := oldLink nextLink.
	firstLink == nil 
		ifTrue:[firstLink := lastLink := nil]
		ifFalse:[firstLink previousLink: nil].
	oldLink nextLink: nil.
	^oldLink! !

!FreeTypeCacheLinkedList methodsFor: 'removing' stamp: 'tween 8/10/2006 21:09'!
removeLast
	"Remove the first element and answer it. If the receiver is empty, create 
	an error notification."

	| oldLink |
	self emptyCheck.
	oldLink := lastLink.
	oldLink nextLink: nil.
	lastLink == firstLink 
		ifTrue:[
			lastLink := firstLink := nil.
			oldLink previousLink: nil.
			^oldLink].
	lastLink := oldLink previousLink.
	lastLink == nil 
		ifTrue:[firstLink := lastLink := nil]
		ifFalse:[lastLink nextLink: nil].
	oldLink previousLink: nil.
	^oldLink! !

!FreeTypeCacheLinkedList methodsFor: 'removing' stamp: 'tween 8/10/2006 18:48'!
remove: aLink ifAbsent: aBlock  
	| prev next  |

	prev := aLink previousLink.
	next := aLink nextLink.
	prev == nil ifFalse: [prev nextLink: next].
	next == nil ifFalse: [next previousLink: prev].
	aLink == firstLink ifTrue:[firstLink := next].
	aLink == lastLink ifTrue:[lastLink := prev].
	aLink nextLink: nil.
	aLink previousLink: nil.		
	^aLink! !

!FreeTypeCacheLinkedList methodsFor: 'adding' stamp: 'nice 4/19/2011 00:05'!
addFirst: aLink 
	"Add aLink to the beginning of the receiver's list. Answer aLink."

	self isEmpty 
		ifTrue: [^lastLink :=firstLink := aLink].
	aLink nextLink: firstLink.
	aLink previousLink: nil.
	firstLink ifNotNil: [firstLink previousLink: aLink].
	firstLink := aLink.
	^aLink! !

!FreeTypeCacheLinkedList methodsFor: 'reordering' stamp: 'tween 3/31/2007 12:31'!
moveDown: aLink
	|  e1 e2 e3 e4  |
	
	(e3 := aLink nextLink) ifNil:[^self].
	e2 := aLink.
	e4 := e3 nextLink.
	e1 := e2 previousLink.
	"swap e2 & e3"
	e1 ifNotNil:[e1 nextLink: e2].
	e2 nextLink: e3.
	e3 nextLink: e4.
	e4 ifNotNil:[e4 previousLink: e3].
	e3 previousLink: e2.
	e2 previousLink: e1

	! !

!FreeTypeCacheLinkedList methodsFor: 'adding' stamp: 'nice 4/19/2011 00:04'!
add: link before: otherLink
	| savedLink |
	firstLink == otherLink ifTrue: [^ self addFirst: link].
	otherLink 
		ifNotNil:[
			savedLink := otherLink previousLink.
			link nextLink: otherLink.
			link previousLink: savedLink.
			otherLink previousLink: link.
			savedLink ifNotNil: [savedLink nextLink: link]].
	^ self errorNotFound: otherLink! !

!FreeTypeCacheLinkedList methodsFor: 'adding' stamp: 'nice 4/19/2011 00:06'!
addLast: aLink 
	"Add aLink to the end of the receiver's list. Answer aLink."

	self isEmpty 
		ifTrue: [^firstLink := lastLink := aLink].
	aLink previousLink: lastLink.
	aLink nextLink: nil.
	lastLink ifNotNil: [lastLink nextLink: aLink].
	lastLink := aLink.
	^aLink! !

!FreeTypeCacheTest commentStamp: 'TorstenBergmann 2/4/2014 22:12'!
SUnit tests for FreeType cache!
!FreeTypeCacheTest methodsFor: 'tests' stamp: 'tween 9/29/2007 20:02'!
testEntriesRemovedFIFO
	| |
	cache maximumSize: 10*(cache sizeOf: font1XGlyph).
	1 to: 10 do:[:i |
		cache 
			atFont: font1 
			charCode: (1000-i) 
			type: FreeTypeCacheGlyph 
			put: font1XGlyph].
	self validateCollections: cache.
	11 to:1000 do:[:i |
		cache 
			atFont: font1 
			charCode: (1000-i) 
			type: FreeTypeCacheGlyph 
			put: font1XGlyph.
		self validateSizes: cache.
		self validateCollections: cache.
		"i-9 to: i do:[:i2 |
			self 
				shouldnt: [cache atFont: font1 charCode: 1000-i2 type: FreeTypeCacheGlyph]
				raise: Error]."
		self 
			should: [cache atFont: font1 charCode: 1000-(i-10) type: FreeTypeCacheGlyph]
			raise: Error].  
	self validateSizes: cache.

	! !

!FreeTypeCacheTest methodsFor: 'tests' stamp: 'tween 8/10/2006 12:48'!
testSetMaximumSizeUnbounded
		
	| u |
	u := fullCache instVarNamed: #used.
	fullCache maximumSize: nil. "unbounded"
	self assert: u = (fullCache instVarNamed: #used).
	self validateSizes: cache.
	self validateCollections: cache
! !

!FreeTypeCacheTest methodsFor: 'tests' stamp: 'tween 8/10/2006 15:52'!
testNormalGetIfAbsentPut
	| u g r |
	cache maximumSize: nil. 
	u := cache instVarNamed: #used.
	r := cache 
		atFont: font1 
		charCode: $X asInteger 
		type: FreeTypeCacheGlyph 
		ifAbsentPut: [font1XGlyph].
	self assert: (r isKindOf: GlyphForm).
	self assert: (cache instVarNamed: #used) > u. "grown"
	self validateSizes: cache.
	g := cache atFont: font1 charCode: $X asInteger type: FreeTypeCacheGlyph.
	self assert: g == font1XGlyph.
	self validateSizes: cache.
	self validateCollections: cache
	! !

!FreeTypeCacheTest methodsFor: 'tests' stamp: 'tween 8/10/2006 15:29'!
testRemoveAllForType
	| fifo |

	fullCache maximumSize: nil.	
	1 to: 100 do:[:i |
		fullCache atFont: font1 charCode: i type: 1 put: font1XGlyph].
	1 to: 100 do:[:i |
		fullCache atFont: font2 charCode: i type: 2 put: font1YGlyph].
	1 to: 100 do:[:i |
		fullCache atFont: font3 charCode: i type: 3 put: font1ZGlyph].
	fifo := fullCache instVarNamed: #fifo.
	self assert: (fifo detect:[:each | each type = 1] ifNone:[]) notNil.
	self assert: (fifo detect:[:each | each type = 2] ifNone:[]) notNil.
	self assert: (fifo detect:[:each | each type = 3] ifNone:[]) notNil.
	fullCache removeAllForType: 1.
	self validateSizes: fullCache.
	self validateCollections: fullCache.
	fifo := (fullCache instVarNamed: #fifo).
	self assert: (fifo detect:[:each | each type = 1] ifNone:[]) isNil.
	self assert: (fifo detect:[:each | each type = 2] ifNone:[]) notNil.
	self assert: (fifo detect:[:each | each type = 3] ifNone:[]) notNil.
	! !

!FreeTypeCacheTest methodsFor: 'tests' stamp: 'tween 8/10/2006 11:19'!
testFailedGet
	| |

	self 
		should: [cache atFont: font1 charCode: $X asInteger type: FreeTypeCacheGlyph] 
		raise: Error.
	self assert: (cache instVarNamed: #fontTable) isEmpty. 
	self assert: (cache instVarNamed: #used) = 0.
	self validateSizes: cache
	! !

!FreeTypeCacheTest methodsFor: 'tests' stamp: 'tween 8/10/2006 12:48'!
testSetMaximumSizeGrow
	| u m |
	
	u := fullCache instVarNamed: #used.
	m := fullCache instVarNamed: #maximumSize.
	fullCache maximumSize: m * 2 . "grow"
	self assert: u = (fullCache instVarNamed: #used).	
	self validateSizes: cache.
	self validateCollections: cache! !

!FreeTypeCacheTest methodsFor: 'tests' stamp: 'tween 3/31/2007 12:26'!
testNormalGetIfAbsentPutTwiceIntoNonEmptyCache
	| u g r |
	cache maximumSize: nil. 
	u := cache instVarNamed: #used.
	r := cache 
		atFont: font1 
		charCode: $Z asInteger 
		type: FreeTypeCacheGlyph 
		ifAbsentPut: [font1XGlyph].
	r := cache 
		atFont: font1 
		charCode: $X asInteger 
		type: FreeTypeCacheGlyph 
		ifAbsentPut: [font1XGlyph].
	r := cache 
		atFont: font1 
		charCode: $X asInteger 
		type: FreeTypeCacheGlyph 
		ifAbsentPut: [font1XGlyph].
	self assert: (r isKindOf: GlyphForm).
	self assert: (cache instVarNamed: #used) > u. "grown"
	self validateSizes: cache.
	g := cache atFont: font1 charCode: $X asInteger type: FreeTypeCacheGlyph.
	self assert: g == font1XGlyph.
	self validateSizes: cache.
	self validateCollections: cache
	! !

!FreeTypeCacheTest methodsFor: 'tests' stamp: 'tween 3/31/2007 12:26'!
testNormalGetIfAbsentPutTwice
	| u g r |
	cache maximumSize: nil. 
	u := cache instVarNamed: #used.
	r := cache 
		atFont: font1 
		charCode: $X asInteger 
		type: FreeTypeCacheGlyph 
		ifAbsentPut: [font1XGlyph].
	r := cache 
		atFont: font1 
		charCode: $X asInteger 
		type: FreeTypeCacheGlyph 
		ifAbsentPut: [font1XGlyph].
	self assert: (r isKindOf: GlyphForm).
	self assert: (cache instVarNamed: #used) > u. "grown"
	self validateSizes: cache.
	g := cache atFont: font1 charCode: $X asInteger type: FreeTypeCacheGlyph.
	self assert: g == font1XGlyph.
	self validateSizes: cache.
	self validateCollections: cache
	! !

!FreeTypeCacheTest methodsFor: 'tests' stamp: 'tween 8/10/2006 13:41'!
testInstanceInitialization
	self assert: (cache instVarNamed: #maximumSize) = FreeTypeCache defaultMaximumSize.
	self assert: (cache instVarNamed: #used) = 0.
	self assert: (cache instVarNamed: #fontTable) class = cache dictionaryClass.
	self assert: (cache instVarNamed: #fontTable) isEmpty.
	self assert: (cache instVarNamed: #fifo) class = cache fifoClass.
	self assert: (cache instVarNamed: #fifo) isEmpty.
	! !

!FreeTypeCacheTest methodsFor: 'tests' stamp: 'tween 8/10/2006 13:05'!
testRemoveAll
	| m fifo fontTable |
	m := fullCache instVarNamed: #maximumSize.
	fifo := fullCache instVarNamed: #fifo.
	fontTable := fullCache instVarNamed: #fontTable.
	fullCache removeAll.
	self assert: (fullCache instVarNamed: #fifo) isEmpty.
	self assert: (fullCache instVarNamed: #fontTable) isEmpty.
	self assert: (fullCache instVarNamed: #used) = 0.
	self assert: m = (fullCache instVarNamed: #maximumSize).
	self assert: fifo class = (fullCache instVarNamed: #fifo) class.
	self assert: fontTable class = (fullCache instVarNamed: #fontTable) class.	! !

!FreeTypeCacheTest methodsFor: 'private' stamp: 'tween 3/31/2007 12:12'!
validateCollections: aFreeTypeCache
	"check that the fifo list entries match the fontTable dict hierarchy"
	| fontTable fontTableEntries fifo lastLink |
	fontTable := aFreeTypeCache instVarNamed: #fontTable.
	fifo := aFreeTypeCache instVarNamed: #fifo.
	lastLink := (fifo instVarNamed:#lastLink).
	fontTableEntries := Set new.
	fontTable keysAndValuesDo:[:k1 :v1 |
		v1 keysAndValuesDo:[:k2 :v2 |
			v2 keysAndValuesDo:[:k3 :v3 |
				fontTableEntries add: v3 ]]].
	self assert: fifo size = fontTableEntries size.
	self assert: (fifo asSet = fontTableEntries).
	self assert: (lastLink isNil or:[lastLink nextLink isNil]) 
	

	! !

!FreeTypeCacheTest methodsFor: 'tests' stamp: 'GabrielOmarCotelli 5/25/2010 21:22'!
testSetMaximumSize
	cache maximumSize: 0.
	self assert: (cache instVarNamed: #maximumSize) = 0.
	cache maximumSize: 99999999999999999.
	self assert: (cache instVarNamed: #maximumSize) = 99999999999999999.
	cache maximumSize: nil.	"unbounded"
	self assert: (cache instVarNamed: #maximumSize) isNil.
	self validateSizes: cache.
	self validateCollections: cache! !

!FreeTypeCacheTest methodsFor: 'tests' stamp: 'tween 9/29/2007 20:07'!
testSetMaximumSizeShrink
	| m |

	m := fullCache instVarNamed: #maximumSize.
	fullCache maximumSize: m // 2 . "shrink"
	self assert: (fullCache instVarNamed: #used) = 0. "cache is cleared when used > maximumSize"
	self validateSizes: fullCache.
	self validateCollections: fullCache.	
		
		! !

!FreeTypeCacheTest methodsFor: 'tests' stamp: 'tween 8/10/2006 14:57'!
testFreeTypeCacheEntry
	| f f2  f3 |
	f := FreeTypeCacheEntry new.
	f charCode: 1; font: font1; type: FreeTypeCacheGlyph; object: font1XGlyph.
	f2 := FreeTypeCacheEntry new.
	f2 charCode: 2; font: font1; type: FreeTypeCacheGlyphLCD; object: font1XGlyph.
	f nextLink: f2.
	self assert: f ~= f2.
	self assert: f nextLink = f2 .
	
	f3 := f copy.
	f3 nextLink: nil.
	self assert: f = f3. "equality not based on nextLink"! !

!FreeTypeCacheTest methodsFor: 'tests' stamp: 'tween 8/10/2006 14:21'!
testRemoveAllForFont
	| fifo |

	fullCache maximumSize: nil.	
	1 to: 100 do:[:i |
		fullCache atFont: font1 charCode: i type: 1 put: font1XGlyph].
	1 to: 100 do:[:i |
		fullCache atFont: font2 charCode: i type: 2 put: font1YGlyph].
	1 to: 100 do:[:i |
		fullCache atFont: font3 charCode: i type: 3 put: font1ZGlyph].
	fifo := fullCache instVarNamed: #fifo.
	self assert: (fifo detect:[:each | each font = font1] ifNone:[]) notNil.
	self assert: (fifo detect:[:each | each font = font2] ifNone:[]) notNil.
	self assert: (fifo detect:[:each | each font = font3] ifNone:[]) notNil.
	fullCache removeAllForFont: font1.
	self validateSizes: fullCache.
	self validateCollections: fullCache.
	fifo := (fullCache instVarNamed: #fifo).
	self assert: (fifo detect:[:each | each font = font1] ifNone:[]) isNil.
	self assert: (fifo detect:[:each | each font = font2] ifNone:[]) notNil.
	self assert: (fifo detect:[:each | each font = font2] ifNone:[]) notNil.
	! !

!FreeTypeCacheTest methodsFor: 'tests' stamp: 'tween 8/10/2006 12:47'!
testNormalPutGet
	| u g |
	cache maximumSize: nil. 
	u := cache instVarNamed: #used.
	cache atFont: font1 charCode: $X asInteger type: FreeTypeCacheGlyph put: font1XGlyph.
	self assert: (cache instVarNamed: #used) > u. "grown"
	self validateSizes: cache. 
	g := cache atFont: font1 charCode: $X asInteger type: FreeTypeCacheGlyph.
	self assert: g == font1XGlyph.
	self validateSizes: cache. 
	self validateCollections: cache
	! !

!FreeTypeCacheTest methodsFor: 'running' stamp: 'tween 3/23/2007 08:07'!
setUp

	cache := FreeTypeCache new.
	font1 := FreeTypeFont basicNew.
	font2 := FreeTypeFont basicNew.
	font3 := FreeTypeFont basicNew.
	font1XGlyph := (GlyphForm extent: 100@100 depth: 32)
		advance: 100;
		linearAdvance: 10000;
		yourself.
	font1YGlyph := (GlyphForm extent: 100@100 depth: 32)
		advance: 100;
		linearAdvance: 10000;
		yourself.
	font1ZGlyph := (GlyphForm extent: 100@100 depth: 32)
		advance: 100;
		linearAdvance: 10000;
		yourself.
	fullCache := FreeTypeCache new.
	fullCache 
		maximumSize: (10*(fullCache sizeOf: font1YGlyph))..
	1 to: 10 do:[:i |
		fullCache atFont: font1 charCode: i type: FreeTypeCacheGlyph put: font1YGlyph]. ! !

!FreeTypeCacheTest methodsFor: 'tests' stamp: 'tween 8/10/2006 09:24'!
testSingleton
	self assert: FreeTypeCache current class = FreeTypeCache.
	self assert: FreeTypeCache current ==  FreeTypeCache current.
	! !

!FreeTypeCacheTest methodsFor: 'tests' stamp: 'tween 8/10/2006 13:52'!
testReport
	self assert: fullCache report = '100% Full (maximumSize: 400320 , used: 400320)'.
	fullCache maximumSize:  800640.
	self assert: fullCache report = '50% Full (maximumSize: 800640 , used: 400320)'.
	self assert: cache report = '0% Full (maximumSize: 5120000 , used: 0)'.
	cache maximumSize: nil.
	self assert: cache report = '0% Full (maximumSize: nil , used: 0)'.	! !

!FreeTypeCacheTest methodsFor: 'private' stamp: 'tween 8/10/2006 15:04'!
validateSizes: aFreeTypeCache
	"check that the used, maximumSize, and caches entries are valid"
	| fontTable calcSize max used |
	fontTable := aFreeTypeCache instVarNamed: #fontTable.
	used := aFreeTypeCache instVarNamed: #used.
	max := aFreeTypeCache instVarNamed: #maximumSize.
	calcSize := 0.
	fontTable do:[:charCodeTable |
		charCodeTable do:[:typeTable |
			typeTable do:[:entry |
				calcSize := calcSize + (aFreeTypeCache sizeOf: entry object)]]].
	self assert: calcSize = used.
	self assert: (max isNil or:[used <= max])
	! !

!FreeTypeCacheTest methodsFor: 'tests' stamp: 'tween 8/10/2006 10:29'!
testConstants
	
	| constants |
	constants := {FreeTypeCacheWidth. FreeTypeCacheGlyphMono. FreeTypeCacheGlyphLCD.FreeTypeCacheGlyph}.
	self assert: constants asSet size = constants size. "no 2 have same value"
	self assert: (constants detect:[:x | x isNil] ifNone:[]) isNil. "no value is nil"
	
	! !

!FreeTypeCacheTest methodsFor: 'tests' stamp: 'tween 3/31/2007 12:21'!
testNormalPutGetTwice
	| u g |
	cache maximumSize: nil. 
	u := cache instVarNamed: #used.
	cache atFont: font1 charCode: $X asInteger type: FreeTypeCacheGlyph put: font1XGlyph.
	self assert: (cache instVarNamed: #used) > u. "grown"
	self validateSizes: cache. 
	g := cache atFont: font1 charCode: $X asInteger type: FreeTypeCacheGlyph.
	g := cache atFont: font1 charCode: $X asInteger type: FreeTypeCacheGlyph.
	self assert: g == font1XGlyph.
	self validateSizes: cache. 
	self validateCollections: cache
	! !

!FreeTypeCacheTest methodsFor: 'tests' stamp: 'tween 8/10/2006 15:12'!
testNormalPutGetWidth
	| u g |
	cache maximumSize: nil. 
	u := cache instVarNamed: #used.
	cache atFont: font1 charCode: $X asInteger type: FreeTypeCacheWidth put: 100.
	self assert: (cache instVarNamed: #used) > u. "grown"
	self validateSizes: cache. 
	g := cache atFont: font1 charCode: $X asInteger type: FreeTypeCacheWidth.
	self assert: g = 100.
	self validateSizes: cache. 
	self validateCollections: cache
	! !

!FreeTypeCacheTest methodsFor: 'tests' stamp: 'tween 9/29/2007 20:05'!
testMaximumSizeRespectedOnIfAbsentPut
	| |
	cache maximumSize: (cache sizeOf: font1XGlyph).
	cache 
		atFont: font1 
		charCode: $X asInteger 
		type: FreeTypeCacheGlyph 
		ifAbsentPut: font1XGlyph.
	self validateSizes: cache.
	self validateCollections: cache.
	cache 
		atFont: font1 
		charCode: $Y asInteger 
		type: FreeTypeCacheGlyph 
		ifAbsentPut: font1XGlyph.	
	self assert: (cache instVarNamed:#used) = 0. "cache has been cleared on reaching max size"
	self validateSizes: cache.
	self validateCollections: cache.
	self 
		should: [cache atFont: font1 charCode: $X asInteger type: FreeTypeCacheGlyph]
		raise: Error.	
	self 
		should: [cache atFont: font1 charCode: $Y asInteger type: FreeTypeCacheGlyph]
		raise: Error.	
	! !

!FreeTypeCacheTest methodsFor: 'tests' stamp: 'tween 8/10/2006 14:41'!
testPutSameElementTwice
	| |
	cache maximumSize: nil. 
	cache atFont: font1 charCode: $X asInteger type: FreeTypeCacheGlyph put: font1XGlyph.
	self assert: (cache instVarNamed: #used) = (cache sizeOf: font1XGlyph).
	self validateSizes: cache. 
	self validateCollections: cache.
	cache atFont: font1 charCode: $X asInteger type: FreeTypeCacheGlyph put: font1XGlyph.
	self assert: (cache instVarNamed: #used) = (cache sizeOf: font1XGlyph).
	self validateSizes: cache. 
	self validateCollections: cache
	! !

!FreeTypeCacheTest methodsFor: 'tests' stamp: 'tween 9/29/2007 20:06'!
testMaximumSizeRespectedOnPut
	| |
	cache maximumSize: (cache sizeOf: font1XGlyph).
	cache 
		atFont: font1 
		charCode: $X asInteger 
		type: FreeTypeCacheGlyph 
		put: font1XGlyph.
	self validateSizes: cache.
	self validateCollections: cache.
	cache 
		atFont: font1 
		charCode: $Y asInteger 
		type: FreeTypeCacheGlyph 
		put: font1XGlyph.	
	self assert: (cache instVarNamed:#used) = 0. "cache has been cleared on reaching max size"
	self validateSizes: cache.
	self validateCollections: cache.
	self 
		should: [cache atFont: font1 charCode: $X asInteger type: FreeTypeCacheGlyph]
		raise: Error.	
	self 
		should: [cache atFont: font1 charCode: $Y asInteger type: FreeTypeCacheGlyph]
		raise: Error.	
	! !

!FreeTypeEmbeddedFileInfo commentStamp: 'TorstenBergmann 2/4/2014 22:10'!
File info for embbeded FreeType fonts!
!FreeTypeEmbeddedFileInfo methodsFor: 'accessing' stamp: 'tween 7/16/2007 00:16'!
locationType
	"Answer the value of locationType"

	^ #embedded! !

!FreeTypeEmbeddedFileInfo methodsFor: 'accessing' stamp: 'tween 7/16/2007 00:21'!
baseName
	"Answer the value of baseName"

	^ baseName! !

!FreeTypeEmbeddedFileInfo methodsFor: 'printing' stamp: 'tween 8/16/2007 01:08'!
printOn: aStream
	"super printOn: aStream."
	aStream 
		nextPutAll:  '{', self locationType asString,'}';
		nextPutAll: '(' , fileContents size asString, ' bytes )';
		nextPutAll: '[',index asString,'] ';
		nextPutAll: familyName asString;
		nextPutAll: ' - ', styleName asString;
		nextPutAll: ' - ', postscriptName asString;		
		nextPutAll: ' ',(bold ifTrue:['B'] ifFalse:['']);
		nextPutAll: ' ',(italic ifTrue:['I'] ifFalse:['']);
		nextPutAll: ' ',(fixedWidth ifTrue:['Monospaced'] ifFalse:['']);
		nextPutAll: ' ',(stretchValue asString);
		nextPutAll: ' ',(weightValue asString);	
		cr! !

!FreeTypeEmbeddedFileInfo methodsFor: 'accessing' stamp: 'tween 7/16/2007 00:19'!
fileContents
	"Answer the value of fileContents"

	^ fileContents! !

!FreeTypeEmbeddedFileInfo methodsFor: 'accessing' stamp: 'tween 7/16/2007 00:19'!
baseName: anObject
	"Set the value of baseName"

	baseName := anObject! !

!FreeTypeEmbeddedFileInfo methodsFor: 'testing' stamp: 'tween 7/16/2007 00:31'!
isEmbedded
	^true! !

!FreeTypeEmbeddedFileInfo methodsFor: 'accessing' stamp: 'tween 7/16/2007 00:19'!
fileContents: anObject
	"Set the value of fileContents"

	fileContents := anObject! !

!FreeTypeEmbeddedFileInfo methodsFor: 'accessing' stamp: 'tween 7/28/2007 12:43'!
fileSize
	^fileContents size! !

!FreeTypeExternalMemory commentStamp: 'TorstenBergmann 2/4/2014 22:06'!
FreeType externalMemory !
!FreeTypeExternalMemory methodsFor: 'accessing' stamp: 'tween 8/12/2006 08:40'!
bytes
	^bytes! !

!FreeTypeExternalMemory methodsFor: 'validation' stamp: 'tween 8/12/2006 10:25'!
validate
	self isValid 
		ifFalse: [
			bytes ifNotNil:[
				[self primCopyToExternalMemory: bytes]
					on: FT2Error 
					do:[:e |"need to do something here?"].
				self isValid ifTrue:[self class register: self]]]! !

!FreeTypeExternalMemory methodsFor: 'primitives' stamp: 'tween 8/12/2006 10:24'!
primDestroyHandle
	<primitive: 'primitiveFreeExternalMemory' module: 'FT2Plugin'>
	^self primitiveFailed! !

!FreeTypeExternalMemory methodsFor: 'primitives' stamp: 'tween 8/12/2006 10:25'!
primCopyToExternalMemory: aByteArray
	"copy aByteArray into newly allocated, external memory, and store the
	address of that memory in the receiver's handle"
	<primitive: 'primitiveCopyToExternalMemory' module: 'FT2Plugin'>
	^self primitiveFailed! !

!FreeTypeExternalMemory methodsFor: 'accessing' stamp: 'tween 8/12/2006 08:40'!
bytes: aByteArray
	bytes := aByteArray! !

!FreeTypeExternalMemory class methodsFor: 'instance creation' stamp: 'tween 8/12/2006 08:42'!
bytes: aByteArray
	| answer |
	answer := self basicNew
		bytes: aByteArray;
		yourself.
	^answer! !

!FreeTypeFace commentStamp: 'TorstenBergmann 2/4/2014 22:06'!
Do not rearrange these fields!!!
!FreeTypeFace methodsFor: 'validation' stamp: 'tween 3/17/2007 12:19'!
newFaceFromFile: fileName index: anInteger
	| answer |
	valid := nil.
	answer := super newFaceFromFile: fileName index: anInteger.
	valid := super isValid.
	^answer
	! !

!FreeTypeFace methodsFor: 'accessing' stamp: 'tween 3/16/2007 12:44'!
styleName
	^super styleName ifNil:['']! !

!FreeTypeFace methodsFor: 'validation' stamp: 'YuriyTymchuk 1/31/2013 18:31'!
validate
	"If the receiver is not valid (has a nil handle), then create the 
	receiver to obtain a handle and load the receiver's fields"
	session == Smalltalk session ifFalse: [ 
		handle := nil.
		session := Smalltalk session.
		
		self create.
		 ].
	
	self isValid ifFalse: [self create]! !

!FreeTypeFace methodsFor: 'testing' stamp: 'tween 3/31/2007 14:52'!
hasKerning
	^hasKerning ifNil:[
		[hasKerning := self primHasKerning = 64] 
			on: Error do:[:e | hasKerning := false].
		hasKerning]! !

!FreeTypeFace methodsFor: 'accessing' stamp: 'tween 3/16/2007 12:44'!
familyName
	^super familyName ifNil:['?']! !

!FreeTypeFace methodsFor: 'accessing' stamp: 'tween 3/16/2007 12:44'!
fileContentsExternalMemoryBytes
	^fileContentsExternalMemory ifNotNil:[fileContentsExternalMemory bytes]! !

!FreeTypeFace methodsFor: 'caching' stamp: 'IgorStasenko 10/9/2012 17:41'!
releaseCachedState

	hasKerning := nil.
! !

!FreeTypeFace methodsFor: 'initialize-release' stamp: 'tween 3/16/2007 12:53'!
beNull
	super beNull.
	valid := nil
	! !

!FreeTypeFace methodsFor: 'accessing' stamp: 'tween 3/16/2007 12:44'!
fileContentsExternalMemory: aFreeTypeExternalMemory
	fileContentsExternalMemory := aFreeTypeExternalMemory! !

!FreeTypeFace methodsFor: 'accessing' stamp: 'tween 3/16/2007 12:44'!
filename
	^filename! !

!FreeTypeFace methodsFor: 'validation' stamp: 'tween 3/16/2007 12:44'!
primNewFaceFromExternalMemory: aFreeTypeExternalMemory size: anInteger index: anInteger2
	<primitive: 'primitiveNewMemoryFaceFromExternalMemoryAndIndex' module: 'FT2Plugin'>
	^self primitiveFailed! !

!FreeTypeFace methodsFor: 'initialize-release' stamp: 'tween 3/16/2007 12:44'!
actAsExecutor
	super actAsExecutor.
	filename := '<finalizer>'.! !

!FreeTypeFace methodsFor: 'validation' stamp: 'ClementBera 7/26/2013 16:42'!
create
	"create me in the FT2Plugin. This gets my handle, and loads the fields"
	
	fileContentsExternalMemory 
		ifNil: [		
			self
				newFaceFromFile: filename asFileReference
				index: index ]
		ifNotNil: [
			self 
				newFaceFromExternalMemory: fileContentsExternalMemory 
				index: index ].
	self loadFields
! !

!FreeTypeFace methodsFor: 'accessing' stamp: 'tween 3/16/2007 12:44'!
filename: aString
	filename := aString! !

!FreeTypeFace methodsFor: 'accessing' stamp: 'tween 3/16/2007 12:44'!
index: anInteger
	index := anInteger! !

!FreeTypeFace methodsFor: 'testing' stamp: 'tween 3/31/2007 16:18'!
isValid
	^valid ifNil:[valid := super isValid]! !

!FreeTypeFace methodsFor: 'validation' stamp: 'tween 3/17/2007 12:21'!
newFaceFromExternalMemory: aFreeTypeExternalMemory index: anInteger
	| answer |
	valid := nil.
	answer := super newFaceFromExternalMemory: aFreeTypeExternalMemory index: anInteger.
	valid := super isValid.
	^answer
	! !

!FreeTypeFace methodsFor: 'testing' stamp: 'tween 3/16/2007 12:44'!
hasFamilyName
	^super familyName notNil! !

!FreeTypeFace methodsFor: 'testing' stamp: 'tween 3/16/2007 12:44'!
hasStyleName
	^super styleName notNil! !

!FreeTypeFace methodsFor: 'accessing' stamp: 'tween 3/16/2007 12:44'!
index
	^index! !

!FreeTypeFace class methodsFor: 'font dirs' stamp: 'CamilloBruni 5/4/2012 20:18'!
fontPathFor: aFilename
	"aFilename is local. Try hard to return a valid path to be handed to freetype library"
	
	"temporary solution ;-)"
	^ (FileSystem disk workingDirectory / 'Fonts' / aFilename) fullName! !

!FreeTypeFace class methodsFor: 'font dirs' stamp: 'tween 3/16/2007 12:44'!
rememberFontDir: aDirecory! !

!FreeTypeFace class methodsFor: 'instance creation' stamp: 'CamilloBruni 5/4/2012 20:21'!
fromFile: aFileName index: anInteger
	"share alike instances"
	| file |
	file := aFileName asFileReference.
	self rememberFontDir: file parent fullName .
	
	self allInstancesDo: [:inst |
		(inst filename = aFileName and: [inst index = anInteger])
			ifTrue: [^inst "validate"]].
		
	^ (self basicNew)
		filename: aFileName;
		index: anInteger;
		yourself! !

!FreeTypeFace class methodsFor: 'instance creation' stamp: 'tween 3/16/2007 12:44'!
fromBytes: aByteArray index: anInteger
	"share alike instances"
	
	self allInstancesDo: [:inst |
		(inst fileContentsExternalMemoryBytes = aByteArray and: [inst index = anInteger])
			ifTrue: [^inst "validate"]].
	^(self basicNew)
		fileContentsExternalMemory: (FreeTypeExternalMemory bytes: aByteArray);
		index: anInteger;
		yourself! !

!FreeTypeFileInfo commentStamp: 'TorstenBergmann 2/4/2014 22:10'!
File infos for a FreeType font!
!FreeTypeFileInfo methodsFor: 'accessing' stamp: 'tween 3/16/2007 04:26'!
absolutePath: anObject
	"Set the value of absolutePath"

	absolutePath := anObject! !

!FreeTypeFileInfo methodsFor: 'accessing' stamp: 'CamilloBruni 5/4/2012 20:21'!
baseName
	^ absolutePath asFileReference basename! !

!FreeTypeFileInfo methodsFor: 'accessing' stamp: 'tween 3/16/2007 04:26'!
absolutePath
	"Answer the value of absolutePath"

	^ absolutePath! !

!FreeTypeFileInfo methodsFor: 'accessing' stamp: 'tween 3/16/2007 01:14'!
modificationTime: anObject
	"Set the value of modificationTime"

	modificationTime := anObject! !

!FreeTypeFileInfo methodsFor: 'accessing' stamp: 'tween 3/16/2007 00:55'!
fileSize
	"Answer the value of fileSize"

	^ fileSize! !

!FreeTypeFileInfo methodsFor: 'accessing' stamp: 'tween 3/16/2007 00:55'!
fileSize: anObject
	"Set the value of fileSize"

	fileSize := anObject! !

!FreeTypeFileInfo methodsFor: 'printing' stamp: 'tween 8/16/2007 01:08'!
printOn: aStream
	"super printOn: aStream."
	aStream 
		nextPutAll: familyGroupName asString, '::',styleNameExtracted asString, ' '; 
		nextPutAll:  
			(locationType = #absolute 
				ifTrue:[''] 
				ifFalse:['{',locationType asString,'}']);
		nextPutAll: absoluteOrRelativePath asString;
		nextPutAll: '[',index asString,'] ';
		nextPutAll: familyName asString;
		nextPutAll: ' - ', styleName asString;
		nextPutAll: ' - ', postscriptName asString;		
		nextPutAll: ' ',(bold ifTrue:['B'] ifFalse:['']);
		nextPutAll: ' ',(italic ifTrue:['I'] ifFalse:['']);
		nextPutAll: ' ',(fixedWidth ifTrue:['Monospaced'] ifFalse:['']);
		nextPutAll: ' ',(stretchValue asString);
		nextPutAll: ' ',(weightValue asString);	
		cr! !

!FreeTypeFileInfo methodsFor: 'accessing' stamp: 'tween 3/15/2007 17:31'!
locationType
	"Answer the value of locationType"

	^ locationType! !

!FreeTypeFileInfo methodsFor: 'accessing' stamp: 'tween 3/15/2007 18:29'!
absoluteOrRelativePath
	"Answer the value of absoluteOrRelativePath"

	^ absoluteOrRelativePath! !

!FreeTypeFileInfo methodsFor: 'accessing' stamp: 'tween 3/15/2007 17:31'!
locationType: anObject
	"Set the value of locationType"

	locationType := anObject! !

!FreeTypeFileInfo methodsFor: 'accessing' stamp: 'tween 3/15/2007 18:29'!
absoluteOrRelativePath: anObject
	"Set the value of absoluteOrRelativePath"

	absoluteOrRelativePath := anObject! !

!FreeTypeFileInfo methodsFor: 'accessing' stamp: 'tween 3/16/2007 01:14'!
modificationTime
	"Answer the value of modificationTime"

	^ modificationTime! !

!FreeTypeFileInfoAbstract commentStamp: 'TorstenBergmann 2/4/2014 22:10'!
Abstract superclass for file infos for a FreeType font!
!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 7/16/2007 00:20'!
numFaces
	"Answer the value of numFaces"

	^ numFaces! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 8/12/2007 19:27'!
styleNameExtracted
	^styleNameExtracted! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 8/16/2007 01:04'!
stretchValue: anObject
	"Set the value of stretchValue"

	stretchValue := anObject! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 7/16/2007 00:20'!
bold: anObject
	"Set the value of bold"

	bold := anObject! !

!FreeTypeFileInfoAbstract methodsFor: 'testing' stamp: 'tween 7/16/2007 00:31'!
isEmbedded
	^false! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 7/16/2007 00:20'!
italic
	"Answer the value of italic"

	^ italic! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/8/2012 14:44'!
styleNameWithWeightForcedToBe: aString italicForcedToBe: aString2
	| answer |
	answer := ''.
	stretch ifNotNil:[
		answer := answer ,stretch].
	answer := answer , ' ', aString.
	answer := answer , ' ', aString2.
	answer := answer trimBoth.
	^answer
		 
	! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 7/16/2007 00:20'!
bold
	"Answer the value of bold"

	^ bold! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 9/29/2007 10:41'!
isItalicOrOblique
	^self slantValue > 0! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 7/16/2007 00:20'!
postscriptName
	"Answer the value of postscriptName"

	^ postscriptName! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/8/2012 14:44'!
validStyleName
	"answer the receiver's styleName, or an alternative 
	name to use if the styleName is invalid for some reason"
	
	
	(styleName copyWithout: $? ) 
		ifEmpty:[ | answer |
			"workaround problem with FreeType 2.2.1 and MS Gothic, MS Mincho
			where familyName is not read correctly. This may be fixed in later versions
			of FreeType"
			answer := ''.
			italic ifTrue:[answer := answer , 'Italic '].
			bold ifTrue:[answer := answer, 'Bold '].
			(italic or:[bold]) not ifTrue:[answer := answer, 'Regular '].
			^answer trimBoth].
	^styleName! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 8/16/2007 01:04'!
weightValue
	"Answer the value of weightValue"

	^ weightValue! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 7/16/2007 00:20'!
postscriptName: anObject
	"Set the value of postscriptName"

	postscriptName := anObject! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/8/2012 14:44'!
styleNameWithItalicForcedToBe: aString
	| answer |
	answer := ''.
	stretch ifNotNil:[
		answer := answer ,stretch].
	(weight notNil "and:[weight asLowercase ~= 'medium']") 
		ifTrue:[
			answer := answer , ' ', weight].
	answer := answer , ' ', aString.
	answer := answer trimBoth.
	^answer
		 
	! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 8/16/2007 20:59'!
slant
	"Answer the value of slant"

	^ slant! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 7/16/2007 00:20'!
index
	"Answer the value of index"

	^ index! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 8/16/2007 01:04'!
stretchValue
	"Answer the value of stretchValue"

	^ stretchValue! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 7/16/2007 00:20'!
styleName
	"Answer the value of styleName"

	^ styleName! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 7/16/2007 00:20'!
numFaces: anObject
	"Set the value of numFaces"

	numFaces := anObject! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/8/2012 14:44'!
styleNameWithWeightForcedToBe: aString
	| answer |
	answer := ''.
	stretch ifNotNil:[
		answer := answer ,stretch].
	answer := answer , ' ', aString.
	slant ifNotNil:[
		answer := answer , ' ', slant].
	answer := answer trimBoth.
	^answer
		 
	! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 7/16/2007 00:20'!
familyName
	"Answer the value of familyName"

	^ familyName! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 9/29/2007 10:42'!
isBolderThan: val
	^self weightValue >= val! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 8/16/2007 01:04'!
weightValue: anObject
	"Set the value of weightValue"

	weightValue := anObject! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 7/16/2007 00:20'!
familyGroupName
	"Answer the value of familyGroupName"

	^ familyGroupName! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 7/16/2007 00:20'!
familyName: anObject
	"Set the value of familyName"

	familyName := anObject! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 8/11/2007 14:22'!
stretch
	"Answer the value of stretch"

	^ stretch! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 7/16/2007 00:20'!
italic: anObject
	"Set the value of italic"

	italic := anObject! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 8/16/2007 20:59'!
style
	"Answer the value of slant"

	^ slant! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 8/11/2007 14:22'!
weight
	"Answer the value of weight"

	^ weight! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/8/2012 14:44'!
extractAttributesFromNames
	"derive values for the receiver's style(italic), weight, and stretch inst vars.
	Also set the familyGroupName and styleNameExtracted"

	| p |

	p:= FreeTypeNameParser new
		familyNameIn: self validFamilyName;
		styleNameIn: self validStyleName;
		italicFlag: italic;
		boldFlag: bold;
		parse.
	familyGroupName := p familyName.
	slant := p extractedSlant.
	slantValue := p extractedSlantValue.
	weight := p extractedWeight.
	weightValue := p extractedWeightValue.
	stretch := p extractedStretch.
	stretchValue := p extractedStretchValue.
	upright := p extractedUpright.
	styleNameExtracted := ''.
	stretch ifNotNil:[
		styleNameExtracted := styleNameExtracted ,stretch].
	(weight notNil "and:[weight asLowercase ~= 'medium']") 
		ifTrue:[
			styleNameExtracted := styleNameExtracted , ' ', weight].
	slant ifNotNil:[
		styleNameExtracted := styleNameExtracted , ' ', slant].
	styleNameExtracted := styleNameExtracted trimBoth.
	styleNameExtracted ifEmpty: [
		styleNameExtracted := upright ifNil:['Regular']].
		 
	! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 7/16/2007 00:20'!
fixedWidth
	"Answer the value of fixedWidth"

	^ fixedWidth! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 7/16/2007 00:20'!
index: anObject
	"Set the value of index"

	index := anObject! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 7/16/2007 00:20'!
styleName: anObject
	"Set the value of styleName"

	styleName := anObject! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 9/1/2007 18:38'!
validFamilyName
	"answer the receiver's familyName, or an alternative 
	name to use if the familyName is invalid for some reason"
	
	(familyName copyWithout: $? ) 
		ifEmpty:[
			"workaround problem with FreeType 2.2.1 and MS Gothic, MS Mincho
			where familyName is not read correctly. This may be fixed in later versions
			of FreeType"
			self baseName asUppercase = 'MSGOTHIC'
				ifTrue:[
					index = 0 ifTrue:[^'MS Gothic'].
					index = 1 ifTrue:[^'MS PGothic'].
					index = 2 ifTrue:[^'MS UI Gothic']].
			self baseName asUppercase = 'MSMINCHO'
				ifTrue:[
					index = 0 ifTrue:[^'MS Mincho'].
					index = 1 ifTrue:[^'MS PMincho'].				
			^self baseName asUppercase, ' ', index asString]].
	^familyName! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 8/16/2007 21:39'!
slantValue
	^slantValue! !

!FreeTypeFileInfoAbstract methodsFor: 'accessing' stamp: 'tween 7/16/2007 00:20'!
fixedWidth: anObject
	"Set the value of fixedWidth"

	fixedWidth := anObject! !

!FreeTypeFont commentStamp: 'TorstenBergmann 2/4/2014 22:10'!
A FreeType font!
!FreeTypeFont methodsFor: 'measuring' stamp: 'tween 4/3/2007 17:22'!
ascent
	| asc desc h |
	cachedAscent ifNotNil:[^cachedAscent].
	asc := self basicAscent.
	desc := self descent.
	h := self height.
	asc + desc < h ifFalse:[^cachedAscent := asc].
	"height is greater than asc+desc, adjust ascent to include the difference"
	^cachedAscent := h - desc ! !

!FreeTypeFont methodsFor: 'displaying' stamp: 'tween 3/17/2007 11:32'!
displayUnderlineOn: aDisplayContext from: baselineStartPoint to: baselineEndPoint
	| underlineTop underlineBottom underlineThickness s e |

	underlineThickness := (self face underlineThickness * self pixelSize / self face unitsPerEm). 
	underlineTop := (self face underlinePosition * self pixelSize / self face unitsPerEm) negated - (underlineThickness/2).
	underlineTop := underlineTop rounded + 1.  "needs the +1 , possibly because glyph origins are moved down by 1 so that their baselines line up with strike fonts"
	underlineBottom := underlineTop + underlineThickness ceiling.
	s := baselineStartPoint + (0@underlineTop).
	e := baselineEndPoint + (0@(underlineBottom)).
	self displayLineGlyphOn: aDisplayContext from: s to: e! !

!FreeTypeFont methodsFor: 'testing' stamp: 'tween 9/29/2007 09:45'!
isSimulatedRegular
	^simulatedEmphasis = 0! !

!FreeTypeFont methodsFor: 'measuring' stamp: 'tween 3/31/2007 23:08'!
hintedWidthOf: aCharacter
	"retrieve advance width for character. try to use cached glyph if possible"
	| charCode answer |
	
	charCode := aCharacter asUnicode asInteger.
	answer := FreeTypeCache current 
		atFont: self 
		charCode: charCode 
		type: FreeTypeCacheWidth
		ifAbsentPut: [self getWidthOf: aCharacter].
	^answer
! !

!FreeTypeFont methodsFor: 'accessing' stamp: 'tween 9/29/2007 09:42'!
simulatedEmphasis
	"Answer the simulatedEmphasis.
	This is 
		0 - normal (no simulatedEmphasis, or simulated regular).
		1 - bold 
		2 - italic
		3 - bold & italic"
	^simulatedEmphasis ifNil:[0]! !

!FreeTypeFont methodsFor: '*Athens-Text' stamp: 'IgorStasenko 11/7/2011 14:15'!
getGlyphWidth: aCharacter 
	aCharacter asciiValue = 9 ifTrue: [ 
		^  (self linearWidthOf: Character space) * 8
		]. 
	^ (self linearWidthOf: aCharacter)! !

!FreeTypeFont methodsFor: 'testing' stamp: 'tween 9/29/2007 09:41'!
isSimulated
	^simulatedEmphasis notNil! !

!FreeTypeFont methodsFor: 'initialize-release' stamp: 'tween 3/17/2007 11:39'!
initialize: aFont

	self face: aFont face.! !

!FreeTypeFont methodsFor: 'measuring' stamp: 'tween 4/3/2007 17:25'!
height

	^cachedHeight ifNil:[
		cachedHeight := (self face height * self pixelSize / self face unitsPerEm) ceiling ]! !

!FreeTypeFont methodsFor: '*Athens-Text' stamp: 'IgorStasenko 10/28/2011 11:46'!
getPreciseHeight
	"get precise font ascent, can be floating value"
	
	^(self face height * self pixelSize / self face unitsPerEm) asFloat.
! !

!FreeTypeFont methodsFor: 'measuring' stamp: 'tween 7/15/2007 21:59'!
kerningLeft: leftChar right: rightChar
	^self isSubPixelPositioned
		ifTrue: [self linearKerningLeft: leftChar right: rightChar]
		ifFalse:[self hintedKerningLeft: leftChar right: rightChar]! !

!FreeTypeFont methodsFor: 'measuring' stamp: 'tween 3/17/2007 11:45'!
pointSize: aSize
	pointSize := aSize! !

!FreeTypeFont methodsFor: 'accessing' stamp: 'tween 3/17/2007 11:34'!
face: aFace
	face := aFace! !

!FreeTypeFont methodsFor: 'accessing' stamp: 'tween 9/29/2007 09:43'!
simulatedBoldStrength
	"Answer the amount by which glyphs need to be emboldened/lightened
	according to the receiver's simulated emphasis and the face's real emphasis"
	| bold faceBold |
	
	self isSimulated ifFalse:[^0].
	bold := self isSimulatedBold.
	faceBold := face isBold.
	(bold and: [faceBold not])
		ifTrue:[^self pixelSize/24].
	^0! !

!FreeTypeFont methodsFor: 'accessing' stamp: 'tween 9/29/2007 09:44'!
simulatedItalicSlant
	"Answer the slant that needs to be added to italicize/un-italicize
	glyphs according to the receiver's simulated emphasis and the face's 
	real emphasis"
	| italic faceItalic |
	
	self isSimulated ifFalse:[^0].
	italic := self isSimulatedItalic.
	faceItalic := face isItalic.
	(italic and: [faceItalic not])
		ifTrue:[^self defaultSimulatedItalicSlant].
	^0! !

!FreeTypeFont methodsFor: '*Athens-Text' stamp: 'IgorStasenko 9/1/2012 21:00'!
getPreciseAscent
	"we using face bouding box for getting ascent value, otherwise two different
	font sizes on same line won't align properly"
	
	^(self face ascender * self pixelSize / self face unitsPerEm) asFloat.
! !

!FreeTypeFont methodsFor: 'testing' stamp: 'tween 9/29/2007 09:48'!
isItalic
	^(simulatedEmphasis == nil and:[self face isItalic])
		or:[self isSimulatedItalic]! !

!FreeTypeFont methodsFor: 'testing' stamp: 'nice 1/5/2010 15:59'!
hasDistinctGlyphsForAll: asciiString
	"Answer true if the receiver has glyphs for all the characters
	in asciiString and no single glyph is shared by more than one character, false otherwise.
	The default behaviour is to answer true, but subclasses may reimplement"
	| setOfIndices |
	self face isValid ifFalse:[^false].
	setOfIndices := Set new.
	asciiString asSet do:[:c | | i |
		(i := self face primGetCharIndex: c asInteger) = 0
			ifTrue:[^false]
			ifFalse:[
				(setOfIndices includes: i)
					ifTrue:[^false]
					ifFalse:[setOfIndices add: i]]].
	^true! !

!FreeTypeFont methodsFor: 'measuring' stamp: 'tween 3/31/2007 11:38'!
pixelSize
	^pixelSize ifNil:[pixelSize := super pixelSize rounded]! !

!FreeTypeFont methodsFor: '*Athens-Text' stamp: 'IgorStasenko 10/20/2011 05:12'!
glyphRendererOn: anAthensSurface

	^ anAthensSurface getFreetypeFontRendererFor: self
! !

!FreeTypeFont methodsFor: 'glyph lookup' stamp: 'tween 9/1/2007 15:35'!
glyphOf: aCharacter destDepth: destDepth colorValue: aColorValue subpixelPosition: sub
	"sub can be between 0 and 63 and denotes the sub-pixel position of the glyph"
	| validSub |
	validSub := self isSubPixelPositioned
		ifTrue: [((sub asInteger max: 0) min: 63) "bitAnd: 2r111000"]
		ifFalse:[0].
	^(destDepth >=8 and:[FreeTypeSettings current subPixelAntiAliasing])
		ifTrue:[
			self 
				subGlyphOf: aCharacter
				colorValue: aColorValue
				mono: FreeTypeSettings current monoHinting
				subpixelPosition: validSub]
		ifFalse:[
			(destDepth >= 8 and:[FreeTypeSettings current bitBltSubPixelAvailable])
				ifTrue:[
					self 
						mode41GlyphOf: aCharacter
						colorValue: aColorValue
						mono: FreeTypeSettings current monoHinting
						subpixelPosition: validSub]
				ifFalse:[
					self 
						glyphOf: aCharacter
						colorValue: aColorValue
						mono: FreeTypeSettings current monoHinting
						subpixelPosition: validSub]]! !

!FreeTypeFont methodsFor: 'accessing' stamp: 'tween 3/17/2007 11:47'!
setFace: aFreetypeFace pointSize: anInteger
	face := aFreetypeFace.
	pointSize := anInteger.! !

!FreeTypeFont methodsFor: 'accessing' stamp: 'tween 9/29/2007 09:44'!
defaultSimulatedItalicSlant
	^0.22! !

!FreeTypeFont methodsFor: 'accessing' stamp: 'tween 3/17/2007 11:33'!
face
	"Validate, and answer, the receiver's face"
	
	^face validate! !

!FreeTypeFont methodsFor: '*Athens-Text' stamp: 'IgorStasenko 11/7/2011 14:47'!
getPreciseDescent
	"we using face bouding box for getting ascent value, otherwise two different
	font sizes on same line won't align properly"
	
	^(self face descender * self pixelSize / self face unitsPerEm) asFloat negated.

! !

!FreeTypeFont methodsFor: 'testing' stamp: 'tween 8/1/2007 01:08'!
isSymbolFont
	| charmaps |
	symbolFont ifNotNil:[^symbolFont].
	self face isValid ifFalse:[^false].
	charmaps := self face charmaps.
	(charmaps includes: 'symb') ifTrue:[^symbolFont := true]."MS Symbol font"
	^symbolFont := false! !

!FreeTypeFont methodsFor: 'measuring' stamp: 'tween 4/2/2007 22:11'!
widthAndKernedWidthOfLeft: leftCharacter right: rightCharacterOrNil into: aTwoElementArray
	"Set the first element of aTwoElementArray to the width of leftCharacter and 
	the second element to the width of left character when kerned with
	rightCharacterOrNil. Answer the receiver
	
	We use a widthAndKernedWidthCache to store these values for speed"	
	| privateArray |
 
	privateArray := (self widthAndKernedWidthCache at: leftCharacter ifAbsentPut:[Dictionary new])
		at: (rightCharacterOrNil ifNil:[0 asCharacter])
		ifAbsentPut:[ 
			super 
				widthAndKernedWidthOfLeft: leftCharacter 
				right: rightCharacterOrNil 
				into: (Array new: 2)].
	"We can't answer privateArray, we MUST copy its elements into aTwoElementArray"
	aTwoElementArray 
		at: 1 put: (privateArray at: 1);
		at: 2 put: (privateArray at: 2).
	^aTwoElementArray! !

!FreeTypeFont methodsFor: 'testing' stamp: 'tween 7/15/2007 21:57'!
subPixelPositioned
	"Answer true if the receiver is currently using subpixel positioned
	glyphs, false otherwise. This affects how padded space sizes are calculated
	when composing text."
	| settings |
	^subPixelPositioned 
		ifNil:[
			settings := FreeTypeSettings current.
			subPixelPositioned := settings hinting not or:[settings lightHinting]]! !

!FreeTypeFont methodsFor: 'testing' stamp: 'tween 3/29/2007 13:28'!
hasGlyphsForAll: asciiString
	"Answer true if the receiver has glyphs for all the characters
	in asciiString, false otherwise.
	The default behaviour is to answer true, but subclasses may reimplement"
	
	self face isValid ifFalse:[^false].
	asciiString do:[:c |
		(self face primGetCharIndex: c asInteger) = 0
			ifTrue:[^false]].
	^true! !

!FreeTypeFont methodsFor: 'glyph lookup' stamp: 'tween 4/4/2007 19:14'!
mode41GlyphOf: aCharacter colorValue: aColorValue mono: monoBoolean subpixelPosition: sub

	| |
	^FreeTypeCache current
		atFont: self
		charCode: aCharacter asUnicode asInteger
		type: (FreeTypeCacheGlyph + sub)
		ifAbsentPut: [
			FreeTypeGlyphRenderer current
				mode41GlyphOf: aCharacter 
				colorValue: aColorValue 
				mono: monoBoolean 
				subpixelPosition: sub 
				font: self]

! !

!FreeTypeFont methodsFor: 'glyph lookup' stamp: 'tween 4/4/2007 19:13'!
subGlyphOf: aCharacter colorValue: aColorValue mono: monoBoolean subpixelPosition: sub

	| |
	^FreeTypeCache current
		atFont: self
		charCode: aCharacter asUnicode asInteger
		type: FreeTypeCacheGlyphLCD + sub
		ifAbsentPut: [
			FreeTypeGlyphRenderer current
				subGlyphOf: aCharacter 
				colorValue: aColorValue 
				mono: monoBoolean 
				subpixelPosition: sub 
				font: self]

! !

!FreeTypeFont methodsFor: 'glyph lookup' stamp: 'tween 4/4/2007 19:13'!
glyphOf: aCharacter colorValue: aColorValue mono: monoBoolean subpixelPosition: sub

	| |
	^FreeTypeCache current
		atFont: self
		charCode: aCharacter asUnicode asInteger
		type: ((1+sub) << 32) + aColorValue
		ifAbsentPut: [
			FreeTypeGlyphRenderer current
				glyphOf: aCharacter 
				colorValue: aColorValue 
				mono: monoBoolean 
				subpixelPosition: sub 
				font: self]

! !

!FreeTypeFont methodsFor: 'testing' stamp: 'tween 7/15/2007 21:55'!
isSubPixelPositioned
	"Answer true if the receiver is currently using subpixel positioned
	glyphs, false otherwise. This affects how padded space sizes are calculated
	when composing text. 
	Currently, only FreeTypeFonts are subPixelPositioned, and only when not
	Hinted"
	
	^self subPixelPositioned! !

!FreeTypeFont methodsFor: 'measuring' stamp: 'tween 7/15/2007 22:00'!
widthOf: aCharacter
	"retrieve advance width for character. try to use cached glyph if possible"
	^self isSubPixelPositioned
		ifTrue:[self linearWidthOf: aCharacter]
		ifFalse: [self hintedWidthOf: aCharacter]
! !

!FreeTypeFont methodsFor: 'measuring' stamp: 'tween 4/3/2007 17:24'!
descent
	^cachedDescent ifNil:[ 
		cachedDescent := ((self face descender * self pixelSize // self face unitsPerEm) negated) ]! !

!FreeTypeFont methodsFor: 'accessing' stamp: 'tween 7/15/2007 22:00'!
clearCachedMetrics
	widthAndKernedWidthCache := cachedHeight := cachedAscent := cachedDescent := subPixelPositioned := nil! !

!FreeTypeFont methodsFor: 'displaying' stamp: 'tween 9/1/2007 10:32'!
displayLineGlyphOn: aDisplayContext from: startPoint to: endPoint
	|  oldCombinationRule oldHalftoneForm originalColorMap clr depth foreColorVal foreColorAlpha glyph width height
	startPointX startPointY endPointX endPointY foreColor |
	oldCombinationRule := aDisplayContext combinationRule .
	oldHalftoneForm := aDisplayContext halftoneForm .
	originalColorMap := aDisplayContext colorMap.
	clr := (foreColor := aDisplayContext lastFontForegroundColor ifNil:[Color black asNontranslucentColor]) 
		pixelValueForDepth: 32.
	depth := aDisplayContext destForm depth.
	foreColorVal := clr bitAnd: 16rFFFFFF.
	foreColorAlpha := (clr bitAnd: 16rFF000000) >> 24.
	depth <= 8
		ifTrue:[
			aDisplayContext colorMap: (aDisplayContext cachedFontColormapFrom:32 to: depth)]
		ifFalse:[
			aDisplayContext colorMap: nil].
	startPointX := startPoint x truncated.
	startPointY := startPoint y.
	endPointX := endPoint x ceiling.
	endPointY := endPoint y.
	width := endPointX - startPointX.
	height := endPointY - startPointY.
	glyph := (Form extent: width@height depth: 32) fillWhite. "we could cache a big white glyph somewhere to save having to create this. Clipping will make only a part of it display"
	aDisplayContext sourceForm: glyph.
	aDisplayContext destOrigin: startPointX@startPointY.
	aDisplayContext width: width.
	aDisplayContext height: height.
	aDisplayContext 
		sourceOrigin: 0@0;
		halftoneForm: nil.
	(FreeTypeSettings current bitBltSubPixelAvailable and: [depth >= 8])
		ifTrue:[
			aDisplayContext 
				combinationRule: 41.
			aDisplayContext 
				copyBitsColor: foreColorVal 
				alpha: foreColorAlpha 
				gammaTable: FreeTypeSettings current gammaTable
				ungammaTable: FreeTypeSettings current gammaInverseTable]
		ifFalse:[
			glyph fillWithColor: foreColor.
			aDisplayContext combinationRule: (depth <= 8 ifTrue: [Form paint] ifFalse: [34]).
			aDisplayContext copyBits].		
	aDisplayContext 
		colorMap: originalColorMap;
		combinationRule: oldCombinationRule;
		halftoneForm: oldHalftoneForm.
	
	! !

!FreeTypeFont methodsFor: 'testing' stamp: 'tween 9/29/2007 09:49'!
isBold
	^(simulatedEmphasis == nil and:[self face isBold])
		or:[self isSimulatedBold]! !

!FreeTypeFont methodsFor: 'measuring' stamp: 'tween 7/4/2009 12:58'!
widthOfString: aString from: startIndex to: stopIndex
	"Measure the length of the given string between start and stop index.
	Currently this allows for the right side bearing of the last char, but does not allow for the left side bearing of the first char. We really need a new method - boundingBoxOfString that allows for both. Senders of this will also need to know the LSB of the first char, and position their text accordingly"
	| char nextChar resultX glyph a subPixelPosition |

	a := Array new: 2.
	"FreeTypeSettings current hinting ifFalse:[
		^self linearWidthOfString: aString from: startIndex to: stopIndex]."
	resultX := 0.
	startIndex to: stopIndex do:[:i | 
		char := aString at: i.
		nextChar := (i + 1 <= stopIndex)
			ifTrue:[ aString at: i + 1]
			ifFalse:[nil].
		self widthAndKernedWidthOfLeft: char right:  nextChar into: a. 
		resultX := resultX + (a at:2).
		i = stopIndex 
			ifTrue:[
				subPixelPosition := (((resultX \\ 1) roundTo: "1/64" 0.015625) * 64) asInteger.
				subPixelPosition = 64 
					ifTrue:[
						subPixelPosition := 0.
						resultX := resultX + 1 ].
				subPixelPosition := (subPixelPosition max: 0) min: 63.
				glyph := self glyphOf: char colorValue: 0 mono: FreeTypeSettings current monoHinting subpixelPosition: subPixelPosition.
				glyph ifNotNil:[
					"currently the glyph is too wide. This is to allow for some extra space to ensure 
					the glyph is not clipped when it is produced. Either make the width accurate,
					or hold the RSB value separately, or hold an accurate width separately"
					resultX := resultX "+ 2" + glyph offset x "negated" + (glyph width - (a at: 2)  "glyph linearAdvance x floor")]]].
	^resultX ceiling ! !

!FreeTypeFont methodsFor: '*Text-Scanning' stamp: 'nice 10/29/2013 04:07'!
scanByteCharactersFrom: startIndex to: stopIndex in: aByteString with: aCharacterScanner rightX: rightX
	"scan a single byte character string"
	^aCharacterScanner scanKernableByteCharactersFrom: startIndex to: stopIndex in: aByteString rightX: rightX! !

!FreeTypeFont methodsFor: 'testing' stamp: 'tween 3/17/2007 11:42'!
isTTCFont
	"not really - look for senders of this"
	^true! !

!FreeTypeFont methodsFor: 'accessing' stamp: 'tween 3/17/2007 11:44'!
maxAscii
	"should have default in AbstractFont"
	^SmallInteger maxVal! !

!FreeTypeFont methodsFor: 'measuring' stamp: 'tween 4/3/2007 16:42'!
hintedKerningLeft: leftChar right: rightChar
	^(self linearKerningLeft: leftChar right: rightChar) rounded! !

!FreeTypeFont methodsFor: 'displaying' stamp: 'tween 3/17/2007 11:30'!
displayString: aString on: aDisplayContext from: startIndex to: stopIndex at: aPoint kern: kernDelta
	
	^self displayString: aString
		on: aDisplayContext
		from: startIndex
		to: stopIndex
		at: aPoint
		kern: kernDelta
		baselineY: aPoint y  + self ascent! !

!FreeTypeFont methodsFor: 'accessing' stamp: 'tween 9/29/2007 09:43'!
simulatedEmphasis: anIntegerOrNil
	"Set the simulatedEmphasis.
	This is 
		nil - no simulated emphasis
		0 - normal (simulated regular).
		1 - bold 
		2 - italic
		3 - bold & italic"
	simulatedEmphasis := anIntegerOrNil! !

!FreeTypeFont methodsFor: 'initialize-release' stamp: 'tween 3/17/2007 11:45'!
releaseCachedState
	face releaseCachedState.
	FreeTypeCache current removeAllForFont: self.! !

!FreeTypeFont methodsFor: 'testing' stamp: 'tween 9/29/2007 09:49'!
isRegular
	^(simulatedEmphasis == nil and:[self face isRegular])
		or: [self isSimulatedRegular]! !

!FreeTypeFont methodsFor: 'displaying' stamp: 'tween 4/5/2007 08:15'!
installOn: aBitBlt foregroundColor: foreColor backgroundColor: backColor

	| |
	"fcolor := foreColor pixelValueForDepth: 32."
	aBitBlt installFreeTypeFont: self foregroundColor: foreColor backgroundColor: backColor.
! !

!FreeTypeFont methodsFor: 'testing' stamp: 'tween 3/17/2007 11:41'!
isFixedWidth
	^self face isFixedWidth ! !

!FreeTypeFont methodsFor: 'testing' stamp: 'tween 9/29/2007 09:45'!
isSimulatedItalic
	^self simulatedEmphasis anyMask: 2! !

!FreeTypeFont methodsFor: 'printing' stamp: 'tween 3/17/2007 11:45'!
printOn: aStream

	aStream
		nextPutAll: self class name;
		nextPut: $(;
		print: face familyName;
		space;
		print: face styleName;
		space;
		print: pointSize;
		nextPut: $)! !

!FreeTypeFont methodsFor: 'measuring' stamp: 'tween 3/17/2007 11:43'!
lineGrid

	^self height! !

!FreeTypeFont methodsFor: 'notifications' stamp: 'tween 4/3/2007 16:48'!
pixelsPerInchChanged
	"the TextStyle pixels per inch setting has changed"
	
	pixelSize := nil.
	widthAndKernedWidthCache := nil.
	FreeTypeCache current removeAllForFont: self.! !

!FreeTypeFont methodsFor: 'accessing' stamp: 'tween 8/27/2007 10:02'!
postscriptName
	^self face postscriptName! !

!FreeTypeFont methodsFor: 'measuring' stamp: 'tween 4/2/2007 22:10'!
widthAndKernedWidthCache
	^widthAndKernedWidthCache ifNil:[widthAndKernedWidthCache := Dictionary new]! !

!FreeTypeFont methodsFor: 'accessing' stamp: 'dik 6/10/2010 21:13'!
veryDeepCopyWith: deepCopier! !

!FreeTypeFont methodsFor: 'displaying' stamp: 'tween 4/5/2007 09:32'!
displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta baselineY: baselineY
	| glyph  depth foreColorVal foreColorAlpha originalColorMap clr subPixelPosition widthAndKernedWidth char nextChar floatDestX  destX destY offset gammaTable gammaInverseTable useRule41 |
	
	useRule41 := FreeTypeSettings current bitBltSubPixelAvailable and: [aBitBlt destForm depth >= 8].
	depth := aBitBlt destForm depth.
	originalColorMap := aBitBlt colorMap.
	clr := (aBitBlt lastFontForegroundColor ifNil:[Color black asNontranslucentColor]) 
		pixelValueForDepth: 32.
	useRule41 
		ifTrue:[
			foreColorVal := clr bitAnd: 16rFFFFFF.
			foreColorAlpha := (clr bitAnd: 16rFF000000) >> 24.
			gammaTable := FreeTypeSettings current gammaTable.
			gammaInverseTable := FreeTypeSettings current gammaInverseTable.]
		ifFalse:[
			foreColorVal := clr].
	depth <= 8
		ifTrue:[
			aBitBlt colorMap: (aBitBlt cachedFontColormapFrom:32 to: depth)]
		ifFalse:[
			aBitBlt colorMap: nil].
	destX := aPoint x.
	destY := baselineY.
	floatDestX := aPoint x.
	widthAndKernedWidth := Array new: 2.
 	startIndex to: stopIndex do: [:i | 
		subPixelPosition := ((floatDestX \\ 1) roundTo: "1/64" 0.015625) * 64.
		subPixelPosition = 64 
			ifTrue:[
				subPixelPosition := 0.
				destX := destX + 1].
		char := aString at: i.
		glyph := self 
			glyphOf: char 
			destDepth: depth 
			colorValue: foreColorVal 
			subpixelPosition: subPixelPosition.
		aBitBlt sourceForm: glyph.
		offset := glyph offset.
		aBitBlt destX: destX + offset x.
		aBitBlt destY: destY + offset y.
		aBitBlt width: glyph width.
		aBitBlt height: glyph height.
		useRule41
			ifTrue:[
				aBitBlt 
					copyBitsColor: foreColorVal 
					alpha: foreColorAlpha 
					gammaTable: gammaTable
					ungammaTable: gammaInverseTable]
			ifFalse:[
				aBitBlt copyBits].
		nextChar := (i + 1 <= stopIndex) 
				ifTrue:[aString at: i + 1]
				ifFalse:[nil].
		self 
			widthAndKernedWidthOfLeft: char 
			right: nextChar
			into: widthAndKernedWidth.
		floatDestX := floatDestX + (widthAndKernedWidth at: 2) + kernDelta.
		destX := floatDestX ].
	aBitBlt colorMap: originalColorMap.
	^ destX @ destY 
! !

!FreeTypeFont methodsFor: '*Text-Scanning' stamp: 'nice 10/29/2013 04:08'!
scanMultibyteCharactersFrom: startIndex to: stopIndex in: aWideString with: aCharacterScanner rightX: rightX
	"scan a multibyte character string"
	^aCharacterScanner scanKernableMultibyteCharactersFrom: startIndex to: stopIndex in: aWideString rightX: rightX ! !

!FreeTypeFont methodsFor: 'measuring' stamp: 'tween 3/26/2007 13:14'!
basicAscent

	^(self face ascender * self pixelSize // self face unitsPerEm).
! !

!FreeTypeFont methodsFor: 'measuring' stamp: 'tween 3/17/2007 11:28'!
descentKern
	"should have default in AbstractFont"
	^0! !

!FreeTypeFont methodsFor: 'accessing' stamp: 'tween 3/31/2007 11:57'!
hash
	^pointSize hash! !

!FreeTypeFont methodsFor: 'measuring' stamp: 'michael.rueger 2/5/2009 17:03'!
getLinearWidthOf: aCharacter 
	| em glyph la charCode |

	aCharacter < $  ifTrue: [^self getLinearWidthOf: $ ].
	charCode := aCharacter asUnicode asInteger.
	(self face charmaps includes:'unic')
		ifTrue:[
			(self isSymbolFont and:[charCode >= 16r20 and: [charCode <= 16rFF ] ])
				ifTrue:[charCode := charCode + 16rF000]]
		ifFalse:[
			(self face charmaps includes:'armn')
				ifTrue:[ "select apple roman char map, and map character from unicode to mac encoding"
					self face setCharMap:'armn'.
					charCode := aCharacter unicodeToMacRoman asUnicode asInteger. "check this!!"]].
	em := self pixelSize.
	face validate.
	face setPixelWidth: em height: em.
	[face loadCharacter: charCode flags: (LoadNoBitmap bitOr: (LoadIgnoreTransform bitOr: "FreeTypeSettings current hintingFlags" 2 "no hinting"))]
		on: FT2Error do:[:e |
			face loadGlyph: 0 flags: (LoadNoBitmap bitOr: (LoadIgnoreTransform bitOr: FreeTypeSettings current hintingFlags "no hinting")) ].
	glyph := face glyph.
	la := glyph linearHorizontalAdvance.
	la isZero ifTrue:[
		"FreeType 2.2.1 sometimes screws up when getting metrics,
		Maybe the bug is in the plugin?
		For example Calibri pixel size 13 gives linearAdvance x of zero !!
		We try again at double the size, and half the result"
		em := self pixelSize * 2.
		face validate.
		face setPixelWidth: em height: em.
		face loadCharacter: charCode flags:(LoadNoBitmap bitOr: (LoadIgnoreTransform bitOr: "FreeTypeSettings current hintingFlags" 2 "no hinting")). "load glyph metrics"
		glyph := face glyph.
		la := glyph linearHorizontalAdvance / 2.0].
	^la
! !

!FreeTypeFont methodsFor: 'measuring' stamp: 'michael.rueger 2/5/2009 17:04'!
linearKerningLeft: leftChar right: rightChar
	| f  l r |

	f := self face.
	f hasKerning ifFalse:[^0].
	l := leftChar asUnicode.
	r := rightChar asUnicode.
	(self face charmaps includes:'unic')
		ifTrue:[
			self isSymbolFont 
				ifTrue:[
					(l asInteger >= 16r20 and:[l asInteger <= 16rFF ])
						ifTrue:[l := (Character value: l asInteger + 16rF000) asUnicode].
					(r asInteger >= 16r20 and:[ r asInteger <= 16rFF ])
						ifTrue:[r := (Character value: r asInteger + 16rF000) asUnicode]]]
		ifFalse:[
			(self face charmaps includes:'armn')
				ifTrue:[ "select apple roman char map, and map characters from unicode to mac encoding"
					self face setCharMap:'armn'.
					(l asInteger >= 16r20 and:[l asInteger <= 16rFF ])
						ifTrue:[l := (Character value: l asInteger) unicodeToMacRoman].
					(r asInteger >= 16r20 and:[ r asInteger <= 16rFF ])
						ifTrue:[r := (Character value: r asInteger) unicodeToMacRoman]]].
	^(f kerningLeft: l right: r) x asFloat *  self pixelSize / f unitsPerEm! !

!FreeTypeFont methodsFor: 'displaying' stamp: 'tween 3/17/2007 11:30'!
displayStrikeoutOn: aDisplayContext from: baselineStartPoint to: baselineEndPoint
	| top bottom strikeoutThickness s e |
	
	"the strikeout size/position for TrueType fonts should really come from the TT_OS2 table.
	This needs to be read by the plugin when the face is created.
	For now, we use the underlineThickness, and 1/4 of the ascender from the baseline"
	strikeoutThickness := (self face underlineThickness * self pixelSize / self face unitsPerEm). 			
	top := ((self face ascender / 4) * self pixelSize / self face unitsPerEm) negated - (strikeoutThickness/2).
	top := top rounded.
	bottom := top + strikeoutThickness ceiling.
	s := baselineStartPoint + (0@top).
	e := baselineEndPoint + (0@bottom).
	self displayLineGlyphOn: aDisplayContext from: s to: e
	! !

!FreeTypeFont methodsFor: 'measuring' stamp: 'tween 3/31/2007 20:18'!
linearWidthOf: aCharacter
	"retrieve linear advance width for character. try to use cached glyph if possible.
	This is the scaled, unrounded advance width."
	| charCode answer |
	
	charCode := aCharacter asUnicode asInteger.
	answer := FreeTypeCache current 
		atFont: self 
		charCode: charCode 
		type: FreeTypeCacheLinearWidth
		ifAbsentPut: [self getLinearWidthOf: aCharacter].
	^answer
! !

!FreeTypeFont methodsFor: 'accessing' stamp: 'tween 3/17/2007 11:44'!
minAscii
	"should have default in AbstractFont"
	^0! !

!FreeTypeFont methodsFor: 'testing' stamp: 'tween 9/29/2007 09:42'!
isSimulatedBold
	^self simulatedEmphasis anyMask: 1! !

!FreeTypeFont methodsFor: 'glyph lookup' stamp: 'tween 9/1/2007 09:54'!
characterFormAt: aCharacter
	FreeTypeSettings current 
		forceNonSubPixelDuring:[
			^self 
				glyphOf: aCharacter 
				destDepth: 32 
				colorValue: (Color black pixelValueForDepth: 32)
				subpixelPosition: 0]! !

!FreeTypeFont methodsFor: 'measuring' stamp: 'michael.rueger 2/5/2009 17:03'!
getWidthOf: aCharacter 
	"Glyphs are either 1 or 8 bit deep. For 32 bpp we use 8 bits, otherwise 1"
	| em glyph hintingFlags flags charCode |

	aCharacter < $  ifTrue: [^self getWidthOf: $ ].
	charCode := aCharacter asUnicode asInteger.
	(self face charmaps includes:'unic')
		ifTrue:[
			(self isSymbolFont and:[charCode >= 16r20 and: [charCode <= 16rFF ] ])
				ifTrue:[charCode := charCode + 16rF000]]
		ifFalse:[
			(self face charmaps includes:'armn')
				ifTrue:[ "select apple roman char map, and map character from unicode to mac encoding"
					self face setCharMap:'armn'.
					charCode := aCharacter unicodeToMacRoman asUnicode asInteger. "check this!!"]].
	em := self pixelSize.
	face validate.
	face isValid ifFalse:[^0].
	face setPixelWidth: em height: em.
	hintingFlags := FreeTypeSettings current hintingFlags.
	flags :=  LoadNoBitmap bitOr:( LoadIgnoreTransform bitOr: hintingFlags). 
	[face loadCharacter: charCode flags: flags.
	] on:FT2Error do:[:e | "character not in map?"^0]. 
	glyph := face glyph.
	"When not hinting FreeType sets the advance to the truncated linearAdvance.
	The characters appear squashed together. Rounding is probably better, so we 
	answer the rounded linear advance here"
	^self subPixelPositioned
		ifTrue:[ glyph roundedPixelLinearAdvance x]
		ifFalse:[ glyph advance x].
! !

!FreeTypeFont methodsFor: 'measuring' stamp: 'tween 3/17/2007 11:45'!
pointSize
	^pointSize! !

!FreeTypeFont methodsFor: '*Athens-Text' stamp: 'IgorStasenko 11/20/2013 14:15'!
asFreetypeFont
	^ self! !

!FreeTypeFont methodsFor: 'accessing' stamp: 'tween 3/17/2007 11:27'!
depth

	^ 32.! !

!FreeTypeFont class methodsFor: 'instance creation' stamp: 'tween 7/16/2007 00:33'!
fromBytes: aByteArray pointSize: anInteger  index: i
	^self new
		setFace: (FreeTypeFace fromBytes: aByteArray index: i) pointSize: anInteger; 
		yourself! !

!FreeTypeFont class methodsFor: 'instance creation' stamp: 'marcus.denker 12/16/2008 11:17'!
fromFile: aFileName pointSize: anInteger index: i
	^self new
		setFace: (FreeTypeFace fromFile: aFileName index: i) pointSize: anInteger; 
		yourself! !

!FreeTypeFont class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/15/2012 19:13'!
forLogicalFont: aLogicalFont fileInfo: aFreeTypeFileInfoAbstract
	| pointSize index |
	pointSize := aLogicalFont pointSize.
	index := aFreeTypeFileInfoAbstract index.  
	^aFreeTypeFileInfoAbstract isEmbedded
		ifTrue:[
			self 
				fromBytes: aFreeTypeFileInfoAbstract fileContents 
				pointSize: pointSize 
				index: index]
		ifFalse:[
			self 
				fromFile: aFreeTypeFileInfoAbstract absolutePath
				pointSize: pointSize 
				index: index]! !

!FreeTypeFontFamily commentStamp: 'TorstenBergmann 2/4/2014 22:07'!
FreeType font family!
!FreeTypeFontFamily methodsFor: 'initialization' stamp: 'tween 8/16/2007 20:44'!
initialize
	super initialize.
	members := OrderedCollection new.! !

!FreeTypeFontFamily methodsFor: 'simulated members' stamp: 'nice 1/5/2010 15:59'!
addSimulatedMembers
	| membersBySlantAndStretch membersByWeightAndStretch |
	membersBySlantAndStretch := Dictionary new.
	members do:[:each| 
		(membersBySlantAndStretch 
			at: {each slantValue. each stretchValue} 
			ifAbsentPut:[OrderedCollection new]) 
				add: each].
	membersBySlantAndStretch keysAndValuesDo:[:key :col | | heaviest |
		heaviest := col ifNotEmpty:[col first].
		col do:[:each |
			heaviest weightValue < each weightValue
				ifTrue:[heaviest := each]].
		(heaviest weightValue between: (LogicalFont weightRegular - 50) and: (LogicalFont weightMedium + 50))
			ifTrue:[	members add: heaviest asSimulatedBold]].			
	membersByWeightAndStretch := Dictionary new.
	members do:[:each| | normalizedWeight |
		normalizedWeight := each weightValue.
		each weightValue = LogicalFont weightMedium ifTrue:[normalizedWeight := LogicalFont weightRegular].	
		"regular and medium weights are used interchangeably.
		For example, FreeSans has Regular-weightMedium(500), and Oblique-weightRegular(400).
		We don't want to simulate oblique-weightMedium(500) when a real 
		Oblique-weightMedium(500) exists, so we normalize any weightMedium(500)
		values to weightRegular(400) to prevent this happening" 	
		(membersByWeightAndStretch 
			at: {normalizedWeight. each stretchValue} 
			ifAbsentPut:[OrderedCollection new]) 
				add: each].	
	membersByWeightAndStretch keysAndValuesDo:[:key :col | | oblique regular |
		regular := col detect: [:each | each slantValue = 0] ifNone:[].
		oblique := col detect:[:each | each slantValue > 0] ifNone:[]. "oblique or italic"
		(oblique isNil and:[regular notNil]) 
			ifTrue:[
				regular simulated
					ifTrue:[members add: regular asSimulatedBoldOblique]
					ifFalse:[	members add: regular asSimulatedOblique]]]! !

!FreeTypeFontFamily methodsFor: 'accessing' stamp: 'nice 1/5/2010 15:59'!
addMembersFromFileInfos: aCollectionOfFreeTypeFileInfo
	
	
	aCollectionOfFreeTypeFileInfo do:[:aFileInfo | | member |
		member := FreeTypeFontFamilyMember fromFileInfo: aFileInfo.
		(self memberWithStyleName: member styleName)
			ifNil:[self addMember: member]].
	! !

!FreeTypeFontFamily methodsFor: 'simulated members' stamp: 'tween 8/18/2007 22:22'!
rebuildSimulatedMembers
	"FOR TESTING ONLY"
	
	members := members reject:[:each| each simulated].
	self addSimulatedMembers.! !

!FreeTypeFontFamily methodsFor: 'accessing' stamp: 'tween 8/16/2007 22:59'!
memberWithStyleName: aString
	^members detect:[:each | each styleName = aString] ifNone:[]
! !

!FreeTypeFontFamily methodsFor: 'accessing' stamp: 'tween 8/25/2007 14:26'!
addMember: aFreeTypeFontFamilyMember
	aFreeTypeFontFamilyMember family: self.
	members add: aFreeTypeFontFamilyMember! !

!FreeTypeFontFamilyMember commentStamp: 'TorstenBergmann 2/4/2014 22:08'!
FreeType FontFamily member  !
!FreeTypeFontFamilyMember methodsFor: 'copying' stamp: 'tween 9/29/2007 12:50'!
asSimulatedBoldOblique
	^self copy 
		slantValue: LogicalFont slantItalic; "treat italic and oblique the same"
		weightValue:LogicalFont weightBold;
		styleName: (fileInfo styleNameWithWeightForcedToBe: 'Bold' italicForcedToBe: 'Oblique');
		simulated: true;
		yourself! !

!FreeTypeFontFamilyMember methodsFor: 'copying' stamp: 'tween 9/29/2007 12:50'!
asSimulatedOblique
	^self copy 
		slantValue: LogicalFont slantItalic;  "treat italic and oblique the same"
		styleName: (fileInfo styleNameWithItalicForcedToBe: 'Oblique');
		simulated: true;
		yourself! !

!FreeTypeFontFamilyMember methodsFor: 'accessing' stamp: 'tween 8/16/2007 20:29'!
stretchName: anObject
	"Set the value of stretchName"

	stretchName := anObject! !

!FreeTypeFontFamilyMember methodsFor: 'accessing' stamp: 'tween 8/16/2007 20:29'!
stretchValue
	"Answer the value of stretchValue"

	^ stretchValue! !

!FreeTypeFontFamilyMember methodsFor: 'accessing' stamp: 'tween 8/16/2007 20:29'!
weightName: anObject
	"Set the value of weightName"

	weightName := anObject! !

!FreeTypeFontFamilyMember methodsFor: 'accessing' stamp: 'tween 8/16/2007 20:29'!
stretchValue: anObject
	"Set the value of stretchValue"

	stretchValue := anObject! !

!FreeTypeFontFamilyMember methodsFor: 'accessing' stamp: 'tween 8/16/2007 20:29'!
weightValue: anObject
	"Set the value of weightValue"

	weightValue := anObject! !

!FreeTypeFontFamilyMember methodsFor: 'copying' stamp: 'tween 9/29/2007 12:49'!
asSimulatedBold
	^self copy 
		weightValue: LogicalFont weightBold;
		styleName: (fileInfo styleNameWithWeightForcedToBe: 'Bold');
		simulated: true;
		yourself! !

!FreeTypeFontFamilyMember methodsFor: 'accessing' stamp: 'tween 8/16/2007 20:29'!
slantValue: anObject
	"Set the value of slantValue"

	slantValue := anObject! !

!FreeTypeFontFamilyMember methodsFor: 'comparing' stamp: 'tween 9/29/2007 12:51'!
sortValue
	| v normalizedWeight | 
	normalizedWeight := weightValue.
	normalizedWeight = LogicalFont weightMedium 
		ifTrue:["sort medium and regular weights as though they were the same"
			normalizedWeight := LogicalFont weightRegular]. 
	v :=self simulated ifTrue:[10000] ifFalse:[0].
	v := v + (stretchValue * 1000).
	v := v + (normalizedWeight).
	v := v + (slantValue).
	^v
! !

!FreeTypeFontFamilyMember methodsFor: 'accessing' stamp: 'tween 8/16/2007 20:29'!
simulated
	"Answer the value of simulated"

	^ simulated! !

!FreeTypeFontFamilyMember methodsFor: 'accessing' stamp: 'tween 8/16/2007 20:29'!
stretchName
	"Answer the value of stretchName"

	^ stretchName! !

!FreeTypeFontFamilyMember methodsFor: 'accessing' stamp: 'tween 8/16/2007 20:46'!
fileInfo
	"Answer the value of fileInfo"

	^ fileInfo! !

!FreeTypeFontFamilyMember methodsFor: 'accessing' stamp: 'tween 8/16/2007 20:29'!
simulated: anObject
	"Set the value of simulated"

	simulated := anObject! !

!FreeTypeFontFamilyMember methodsFor: 'accessing' stamp: 'tween 8/16/2007 20:29'!
weightName
	"Answer the value of weightName"

	^ weightName! !

!FreeTypeFontFamilyMember methodsFor: 'accessing' stamp: 'tween 8/16/2007 20:46'!
fileInfo: anObject
	"Set the value of fileInfo"

	fileInfo := anObject! !

!FreeTypeFontFamilyMember methodsFor: 'accessing' stamp: 'tween 8/16/2007 20:29'!
weightValue
	"Answer the value of weightValue"

	^ weightValue! !

!FreeTypeFontFamilyMember methodsFor: 'accessing' stamp: 'tween 8/16/2007 20:29'!
slantName
	"Answer the value of slantName"

	^ slantName! !

!FreeTypeFontFamilyMember methodsFor: 'accessing' stamp: 'tween 8/16/2007 20:29'!
slantName: anObject
	"Set the value of slantName"

	slantName := anObject! !

!FreeTypeFontFamilyMember methodsFor: 'accessing' stamp: 'tween 8/16/2007 20:29'!
slantValue
	"Answer the value of slantValue"

	^ slantValue! !

!FreeTypeFontFamilyMember methodsFor: 'comparing' stamp: 'tween 8/16/2007 23:23'!
<= aFreeTypeFontFamilyMember
	^self sortValue <= aFreeTypeFontFamilyMember sortValue! !

!FreeTypeFontFamilyMember class methodsFor: 'instance creation' stamp: 'tween 8/16/2007 21:39'!
fromFileInfo: aFreeTypeFileInfo
	
	^self new
		fileInfo: aFreeTypeFileInfo;
		simulated: false;
		styleName: aFreeTypeFileInfo styleNameExtracted;
		stretchName: aFreeTypeFileInfo stretch;
		stretchValue: aFreeTypeFileInfo stretchValue;
		weightName: aFreeTypeFileInfo weight;
		weightValue: aFreeTypeFileInfo weightValue;
		slantName: aFreeTypeFileInfo slant;
		slantValue: aFreeTypeFileInfo slantValue;
		yourself
		! !

!FreeTypeFontProvider commentStamp: 'JurajKubelka 8/23/2014 12:55'!
This is a font provider for true type fonts. You can use it to add TTF files to your image:

FreeTypeFontProvider current 
	updateFontsFromSystem;
	updateAvailableFontFamilies. 

You can add TTF fonts from a spetial dirrectory:
FreeTypeFontProvider current 
	updateFromDirectory: './fonts/' asFileReference done: Set new.

Then you can use font dialog:
	FreeTypeFontSelectorDialogWindow new open.

Or set for example set ballon or default font as following:
	StandardFonts balloonFont: 
	        (LogicalFont familyName: 'Arial'  pointSize: 10). 
	StandardFonts defaultFont: 
	        (LogicalFont familyName: 'Arial'  pointSize: 10).!
!FreeTypeFontProvider methodsFor: 'loading and updating' stamp: 'JurajKubelka 8/23/2014 14:00'!
updateFontsFromSystem
	| done |
	"Add all the embedded file infos"
	FT2Library current ifNil: [ ^ self ].
	self updateEmbeddedFreeTypeFonts.
	done := Set new.	"visited directories are tracked in done, so that they are not processed twice"
	self platformImageRelativeDirectories
		do: [ :each | self updateFromDirectory: each done: done ]
		displayingProgress: 'Loading image relative font files'.
	self platformVMRelativeDirectories
		do: [ :each | self updateFromDirectory: each done: done ]
		displayingProgress: 'Loading vm relative font files'.
	self platformAbsoluteDirectories
		do: [ :each | self updateFromDirectory: each done: done ]
		displayingProgress: 'Loading platform font files'! !

!FreeTypeFontProvider methodsFor: 'file paths' stamp: 'nice 10/30/2013 21:38'!
getWindowsFontFolderPath
	"Answer the windows font folder path.
	This is obtained through the Windows API if FFI is present,
	otherwise it is a guess !!"

	| externalLibraryClass externalTypeClass fun buff |
	externalLibraryClass := Smalltalk globals at: #ExternalLibraryFunction ifAbsent: [  ].
	externalTypeClass := Smalltalk globals at: #ExternalType ifAbsent: [  ].
	(externalLibraryClass isNil or: [ externalTypeClass isNil ])
		ifTrue: [ ^ self guessWindowsFontFolderPath ].
	fun := externalLibraryClass
		name: 'SHGetFolderPathA'
		module: 'shfolder.dll'
		callType: 1
		returnType: externalTypeClass long
		argumentTypes:
			{(externalTypeClass long).
			(externalTypeClass long).
			(externalTypeClass long).
			(externalTypeClass long).
			(externalTypeClass char asPointerType)}.
	buff := ByteArray new: 1024.
	[ 
	| r |
	r := fun
		invokeWith: 0
		with: 16r0014
		with: 0
		with: 0
		with: buff	"CSIDL_FONTS" ]
		on: Error
		do: [ :e | 
			"will get error if ffiplugin is missing"
			^ self guessWindowsFontFolderPath ].
	^ (buff copyFrom: 1 to: (buff indexOf: 0) - 1) asString! !

!FreeTypeFontProvider methodsFor: 'loading and updating' stamp: 'tween 3/14/2007 23:17'!
loadFromSystem
	self updateFromSystem.
	! !

!FreeTypeFontProvider methodsFor: 'error handling' stamp: 'CamilloBruni 7/15/2012 19:19'!
failedToOpen: face from: path index: i
	face destroyHandle.
	"Transcript cr; show: 'Failed : ', path asString, '[', i asString,']'."
	"remove all cache entries for path with index >= i"
	
	
	
			
	
	! !

!FreeTypeFontProvider methodsFor: 'accessing' stamp: 'tween 7/28/2007 13:28'!
addFirstFileInfo: aFreeTypeFileInfo index: i
	fileInfos addFirst: aFreeTypeFileInfo
	
	
		
	
	
	
			
	
	! !

!FreeTypeFontProvider methodsFor: 'error handling' stamp: 'CamilloBruni 7/15/2012 19:19'!
failedToOpen: face index: i
	face destroyHandle.
	"Transcript cr; show: 'Failed : ', path asString, '[', i asString,']'."
	"remove all cache entries for path with index >= i"
	
	
	
			
	
	! !

!FreeTypeFontProvider methodsFor: 'loading and updating' stamp: 'CamilloBruni 7/15/2012 19:26'!
updateAvailableFontFamilies
	'Calculating available font families' displayProgressFrom: 0 to: 1 during:[ :bar |
		"self removeUnavailableTextStyles."
		"self addTextStylesWithPointSizes: #(8 10 12 15 24)."
		tempFileInfos := nil.
		self buildFamilies.
		tempFamilies := nil ].! !

!FreeTypeFontProvider methodsFor: 'loading and updating' stamp: 'CamilloBruni 7/15/2012 19:34'!
updateFromDirectory: aDirectory done: aSet
	"get info from fonts in aDirectory"
	
	(aSet includes: aDirectory) ifTrue: [ ^ self ].
	aSet add: aDirectory.
	aDirectory files 
		do: [ :each |
			"SUSE 10.2 has lots of files ending .gz that aren't fonts.
			We skip them to save time'"
			((each basename beginsWith: '.' ) or: [ each basename asLowercase endsWith:' .gz' ])
				ifFalse: [ self updateFromFile: each ]]
		displayingProgress: 'Loading fonts in ', aDirectory fullName.
		
	aDirectory directories do: [ :each |
		self updateFromDirectory: each done: aSet ].! !

!FreeTypeFontProvider methodsFor: 'initialization' stamp: 'JurajKubelka 8/23/2014 14:41'!
initialize
	super initialize.
	fileInfos := OrderedCollection  new: 100.
	fileInfoCache := Dictionary new: 100. "keyed by file size" 
	families := Dictionary new.
	fontInstallers := OrderedCollection new.
	! !

!FreeTypeFontProvider methodsFor: 'loading and updating' stamp: 'CamilloBruni 7/15/2012 19:26'!
prepareForUpdating.
	
	tempFileInfos := fileInfos. "tempFileInfos will be used during update"
	tempFamilies := families.   "tempFamilies will be used during update"
	fileInfos := OrderedCollection  new: 100.! !

!FreeTypeFontProvider methodsFor: 'accessing' stamp: 'CamilloBruni 7/15/2012 19:18'!
fileInfosByFamilyAndGroup
	"Answer a Dictionary of Dictionaries of Sets.
	familyName->familyGroupName->Set(FreeTypeFileInfo)
	
	self current fileInfosByFamilyAndGroup
	"
	| answer |
	answer := Dictionary new.
	"file could be in fileInfos twice?
	need to only process once, need directory precedence?"
	fileInfos do:[:info | | group family |
		family := answer at: info familyName ifAbsentPut:[Dictionary new].
		group := family at: info familyGroupName ifAbsentPut: [OrderedCollection new].
		group 
			detect:[:each| 
				each bold = info bold
				and:[ each italic = info italic
				and:[ each fixedWidth = info fixedWidth
				and:[ each postscriptName = info postscriptName
				and:[ each styleName = info styleName ]]]]]
			ifNone:[ group add: info]].
	^ answer	! !

!FreeTypeFontProvider methodsFor: 'file paths' stamp: 'CamilloBruni 7/15/2012 18:52'!
platformImageRelativeDirectories
	
	| directory |
	directory :=  Smalltalk imagePath asFileReference / 'Fonts'.
	directory exists
		ifTrue: [ ^ { directory } ].
	^ #()! !

!FreeTypeFontProvider methodsFor: 'font lookup' stamp: 'tween 9/29/2007 10:48'!
fontFor: aLogicalFont familyName: familyName
	| info answer simulatedSqueakEmphasis needsSimulatedBold needsSimulatedSlant
	squeakBoldEmphasis squeakItalicEmphasis |
	
	FT2Library current == nil ifTrue:[^nil].
	info:= self fontInfoFor: aLogicalFont familyName: familyName.
	info ifNil:[^nil].
	answer := FreeTypeFont forLogicalFont: aLogicalFont fileInfo: info.
	needsSimulatedBold := aLogicalFont isBoldOrBolder and:[(info isBolderThan: 500) not].
	needsSimulatedSlant := aLogicalFont isItalicOrOblique and: [info isItalicOrOblique not].
	(needsSimulatedBold or:[needsSimulatedSlant])
		ifTrue:[
			squeakBoldEmphasis := 1.
			squeakItalicEmphasis := 2.
			simulatedSqueakEmphasis := 0.
			needsSimulatedBold 
				ifTrue:[
					simulatedSqueakEmphasis := simulatedSqueakEmphasis + squeakBoldEmphasis].
			needsSimulatedSlant 
				ifTrue:[
					simulatedSqueakEmphasis := simulatedSqueakEmphasis + squeakItalicEmphasis].
			answer simulatedEmphasis: simulatedSqueakEmphasis].
	answer face validate.
	answer face isValid ifFalse:[^nil].  "we may get this if startup causes text display BEFORE receiver has been updated from the system"
	^answer! !

!FreeTypeFontProvider methodsFor: 'loading and updating' stamp: 'CamilloBruni 7/15/2012 19:23'!
updateFileCacheInfo.
	fileInfoCache values 
		do:[ :col |
			col copy do:[:each | | dir |
				dir := each absolutePath asFileReference.
				dir exists ifFalse: [ col remove: each ]]]
		displayingProgress: [ 'Updating cached file info' ].! !

!FreeTypeFontProvider methodsFor: '*EmbeddedFreeType-Tests' stamp: 'JurajKubelka 8/23/2014 14:54'!
includesInstaller: anEmbeddedFreeTypeFontInstaller 
	^ fontInstallers identityIncludes: anEmbeddedFreeTypeFontInstaller! !

!FreeTypeFontProvider methodsFor: 'font families' stamp: 'tween 8/16/2007 21:43'!
buildFamilyNamed: aFamilyGroupName
	| infos family|
	family := FreeTypeFontFamily new
		familyName: aFamilyGroupName;
		yourself. 
	infos := fileInfos select:[:each | each familyGroupName = aFamilyGroupName].
	family addMembersFromFileInfos: infos.
	family addSimulatedMembers.
	^family
		
			
			
		! !

!FreeTypeFontProvider methodsFor: 'loading and updating' stamp: 'CamilloBruni 7/15/2012 19:11'!
validCachedInfoFor: aFile index: i
	"answer info from cache if the file on the disk has the same size/timestamp as the cached info, otherwise answer nil"
	| cacheEntry fileSize modificationTime path |

	fileSize := aFile size.
	modificationTime :=  aFile modificationTime.
	path := aFile fullName.
	cacheEntry := (fileInfoCache at: {fileSize. i} ifAbsentPut: [ Set new ])
		detect: [ :each | 
			each modificationTime = modificationTime
			and: [ each absolutePath = path ]]
		ifNone:[].
	"cacheEntry ifNotNil:[Transcript cr; show: 'from cache : ', cacheEntry asString]."
	^ cacheEntry! !

!FreeTypeFontProvider methodsFor: 'file paths' stamp: 'NicolaiHess 9/23/2014 21:13'!
guessWindowsFontFolderPath
	"Guess the location of the Windows font folder"
	| possibilities |

	possibilities := Set new.
	'cdefghijklmnopqrstuvwxyz' do:[:drive |
		#('windows\fonts' 'winnt\fonts') do:[:path | | d |
			(d := (FileLocator driveNamed: drive asSymbol) resolve: path) exists
				ifTrue:[possibilities add: d]]].
	possibilities := possibilities asSortedCollection: [:a :b | a entry creationTime >= b  entry creationTime].
	possibilities ifNotEmpty:[ ^ possibilities first fullName ].
	^nil
	
		 	
			! !

!FreeTypeFontProvider methodsFor: 'loading and updating' stamp: 'EstebanLorenzano 12/2/2014 14:20'!
updateEmbeddedFreeTypeFonts
	fontInstallers do: [ :each | each installAllFontsIn: self ].
	self buildFamilies! !

!FreeTypeFontProvider methodsFor: 'file paths' stamp: 'cami 7/22/2013 18:29'!
platformAbsoluteDirectories
	Smalltalk os isWin32
		ifTrue: [ ^ self winFontDirectories ].
	Smalltalk os isUnix
		ifTrue: [ ^ self unixFontDirectories ].
	Smalltalk os isMacOSX
		ifTrue: [ ^ self macOSXFolderDirectories ].
	^ {}! !

!FreeTypeFontProvider methodsFor: 'file paths' stamp: 'CamilloBruni 7/15/2012 18:50'!
macOSXFolderDirectories
	"Answer the Mac OS X font folder paths.
	This needs some FFI code, but for the time being, we guess these and omit the user fonts folder"
	
	^#('/System/Library/Fonts' '/Library/Fonts')
		collect: [ :each| each asFileReference ]
		thenSelect: [ :each| each exists ].! !

!FreeTypeFontProvider methodsFor: 'loading and updating' stamp: 'DrGeoUser 9/23/2014 17:07'!
updateFromFile: aFile
	| i face numFaces cachedInfo info cachedNumFaces path |
	
	i:= 0.
	[(cachedInfo := self validCachedInfoFor: aFile index: i) notNil]
		whileTrue:[
			i = 0 ifTrue: [ cachedNumFaces := cachedInfo numFaces ].
			self addFileInfo: cachedInfo index: i.
			i := i + 1.].
		
	(cachedNumFaces notNil and:[ i >= cachedNumFaces ]) ifTrue:[ ^ self ].
	
	path := aFile fullName convertToWithConverter: UTF8TextConverter new .
	[face := FreeTypeFace basicNew filename: path; index:  i.
	["we use the primNewFaceFromFile:index: method because we want to do this as fast as possible and we don't need the face registered because it will be explicitly destroyed later"
	face primNewFaceFromFile: path index: i.
	face loadFields]
		on: FT2Error
		do: [:e | ^self failedToOpen: face from: path index: i ].
	(face height notNil  and:[face hasFamilyName and:[face hasStyleName and:[face isValid]]])
		ifFalse: [ ^self failedToOpen:face from: path index: i ]
		ifTrue: [
			numFaces ifNil: [numFaces := face numFaces].
			info :=FreeTypeFileInfo new
				absoluteOrRelativePath: aFile path isAbsolute;
				absolutePath: path; "used for quick lookup on same platform"
				locationType: #default;
				index: i;
				fileSize: aFile size;
				modificationTime: aFile modificationTime;
				familyName: face familyName;
				styleName: face styleName;
				postscriptName: face postscriptName;
				bold: face isBold;
				italic: face isItalic;
				fixedWidth: face isFixedWidth;
				numFaces: numFaces;
				extractAttributesFromNames;
				yourself.
			self addFileInfo: info index: i.
			self cacheFileInfo: info index: i.
			"Transcript show: 'from file : ', info asString."
			face destroyHandle].
	i := i + 1.
	i < numFaces "note, we use < rather than <= , because i is zero based"] whileTrue:[].
	
	
		
	
	
	
			
	
	! !

!FreeTypeFontProvider methodsFor: 'font families' stamp: 'tween 8/18/2007 14:19'!
families
	
	^tempFamilies ifNil:[families]! !

!FreeTypeFontProvider methodsFor: 'accessing' stamp: 'tween 3/16/2007 12:41'!
cacheFileInfo: aFreeTypeFileInfo index: i

	(fileInfoCache  at:  {aFreeTypeFileInfo fileSize. i} ifAbsentPut:[Set new])
		add:  aFreeTypeFileInfo
	
	
		
	
	
	
			
	
	! !

!FreeTypeFontProvider methodsFor: 'font families' stamp: 'CamilloBruni 7/15/2012 19:19'!
buildFamilies
	| familyNames |
	families := Dictionary new.
	familyNames := (fileInfos collect: [:each | each familyGroupName]) asSet asSortedCollection asArray.
	familyNames do:[:familyName | | family |
		family := self buildFamilyNamed: familyName.
		families at: familyName put: family ].! !

!FreeTypeFontProvider methodsFor: 'font lookup' stamp: 'tween 8/27/2007 11:33'!
fontInfoFor: aLogicalFont familyName: familyName
	| family member |
	
	"use tempFileInfos if not nil, i.e. during an update" 
	"^self fontInfoFor: aLogicalFont in: (tempFileInfos ifNil:[fileInfos]) "
	family := self families at: familyName ifAbsent:[].
	family ifNil:[^nil].
	member := family 
		closestMemberWithStretchValue: aLogicalFont stretchValue 
		weightValue: aLogicalFont weightValue 
		slantValue: aLogicalFont slantValue.
	member ifNil:[^nil].
	^member fileInfo! !

!FreeTypeFontProvider methodsFor: 'file paths' stamp: 'CamilloBruni 7/15/2012 18:49'!
unixFontDirectories

	"Answer the unix/linux font folder paths"
	^ #('/usr/share/fonts' '/usr/local/share/fonts') 
		collect: [ :each| each asFileReference ]
		thenSelect: [ :each| each exists ].! !

!FreeTypeFontProvider methodsFor: 'accessing' stamp: 'JurajKubelka 8/23/2014 14:50'!
addFontInstaller: aFontInstaller
	(fontInstallers includes: aFontInstaller) ifTrue: [ ^ self ].
	fontInstallers add: aFontInstaller! !

!FreeTypeFontProvider methodsFor: 'removing' stamp: 'JurajKubelka 8/23/2014 15:57'!
removeFontInstaller: anEmbeddedFreeTypeFontInstaller 
	fontInstallers remove: anEmbeddedFreeTypeFontInstaller ifAbsent: [ ]! !

!FreeTypeFontProvider methodsFor: 'file paths' stamp: 'CamilloBruni 7/15/2012 18:47'!
winFontDirectories
	| directory |
	directory := self getWindowsFontFolderPath.
	directory ifNil: [ ^ #() ].
	directory := directory asFileReference.
	directory exists 
		ifTrue: [ ^ { directory }].
	^ #()! !

!FreeTypeFontProvider methodsFor: 'accessing' stamp: 'JurajKubelka 8/23/2014 14:14'!
addFileInfo: aFreeTypeFileInfo
	fileInfos add: aFreeTypeFileInfo
	
	
		
	
	
	
			
	
	! !

!FreeTypeFontProvider methodsFor: 'loading and updating' stamp: 'EstebanLorenzano 12/1/2014 15:00'!
updateFromSystem
	| i |
	i := 0.
	self prepareForUpdating.
	'FreeType' displayProgressFrom: 0 to: 3 during:[ :mainBar |
		self updateFileCacheInfo.
		mainBar current: 1.
		self updateFontsFromSystem.
		mainBar current: 2.
		self updateAvailableFontFamilies.
		mainBar current: 3 ].
	LogicalFont allInstances do:[:each | each clearRealFont]. "in case they have a bad one"
			! !

!FreeTypeFontProvider methodsFor: 'accessing' stamp: 'tween 3/16/2007 12:39'!
addFileInfo: aFreeTypeFileInfo index: i
	fileInfos add: aFreeTypeFileInfo
	
	
		
	
	
	
			
	
	! !

!FreeTypeFontProvider methodsFor: 'file paths' stamp: 'CamilloBruni 7/15/2012 18:52'!
platformVMRelativeDirectories
	
	| directory |
	directory :=  Smalltalk vm path asFileReference / 'Fonts'.
	directory exists
		ifTrue: [ ^ { directory } ].
	^ #()! !

!FreeTypeFontProvider class methodsFor: 'class initialization' stamp: 'JurajKubelka 8/23/2014 15:51'!
initialize
	"
	self initialize
	"
	"ensure that other classes have also been initialized by forcefully initializing them now.
	It then does not matter which order they are initialized in during the package load"
	FT2Constants initialize.
	FreeTypeCache initialize.
	FreeTypeCacheConstants initialize.
	FreeTypeSettings initialize.
	
	current := nil.
	self current. "this creates an instance of me, and updates from the system"! !

!FreeTypeFontProvider class methodsFor: 'accessing' stamp: 'tween 3/23/2007 09:59'!
current
	"
	current := nil.
	TimeProfileBrowser onBlock: [FreeTypeFontProvider current]
	"
	^current 
		ifNil:[
			current := self new.
			current updateFromSystem]! !

!FreeTypeFontProvider class methodsFor: 'extra fonts registration' stamp: 'IgorStasenko 4/9/2014 15:11'!
registerFont: aClassWithFont

	"Do nothing if freetype is disabled currently"
	
	FreeTypeSystemSettings loadFt2Library ifTrue: [ 
		aClassWithFont installFontsIn: self current
		 ]! !

!FreeTypeFontSelectorDialogWindow commentStamp: 'LaurentLaffont 4/15/2011 20:19'!
I'm a dialog to select a font. 

Usage example:

|fontSelector|
fontSelector := FreeTypeFontSelectorDialogWindow new.
UITheme builder openModal: fontSelector.
fontSelector selectedFont inspect.!
!FreeTypeFontSelectorDialogWindow methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 12/11/2009 07:39'!
updateFromSelectedFont
	"Update our state based on the selected font."

	|font|
	font := self selectedFont ifNil: [TextStyle defaultFont].
	fontFamilyIndex := (self fontFamilies indexOf: font familyName).
	fontSizeIndex := (self fontSizes indexOf: font pointSize).
	isBold := (font emphasis allMask: TextEmphasis bold emphasisCode).
	isItalic := (font emphasis allMask: TextEmphasis italic emphasisCode).
	self
		changed: #fontFamilyIndex;
		changed: #fontSizeIndex;
		changed: #isBold;
		changed: #isItalic.
	self textPreviewMorph ifNotNil: [:tp |
		tp font: self selectedFont.
		self changed: #previewText]! !

!FreeTypeFontSelectorDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 4/21/2009 17:14'!
matchingFont
	"Answer the font that matches the selections."

	|lf emp|
	self familyName ifNil: [^TextStyle defaultFont].
	lf := LogicalFont
		familyName: self familyName 
		pointSize: (self fontSize ifNil: [10]).
	emp := self isBold
		ifTrue: [TextEmphasis bold emphasisCode]
		ifFalse: [TextEmphasis normal emphasisCode].
	self isItalic
		ifTrue: [emp := emp + TextEmphasis italic emphasisCode].
	self isUnderlined
		ifTrue: [emp := emp + TextEmphasis underlined emphasisCode].
	self isStruckOut
		ifTrue: [emp := emp + TextEmphasis struckOut emphasisCode].
	lf := lf emphasis: emp.
	lf realFont ifNil: [^TextStyle defaultFont].
	^lf ! !

!FreeTypeFontSelectorDialogWindow methodsFor: 'as yet unclassified' stamp: 'GaryChambers 8/25/2011 17:33'!
defaultFontFamilies
	"Answer the set of available fonts families that are supported in the font that they represent."
	
	|fonts defaultFont|
	defaultFont := TextStyle default fontOfPointSize: self theme listFont pointSize.
	fonts := (LogicalFontManager current allFamilies asSortedCollection: [:a :b | 
		a familyName <= b familyName]) collect: [:ff |
			 (ff
				closestMemberWithStretchValue: LogicalFont stretchRegular
				weightValue: LogicalFont weightRegular
				slantValue: LogicalFont slantRegular)
				asLogicalFontOfPointSize: self theme listFont pointSize].
	^fonts collect: [:f | |dispFont|
		dispFont := defaultFont.
		f familyName asText
			addAttribute: (TextFontReference toFont: dispFont)]! !

!FreeTypeFontSelectorDialogWindow methodsFor: 'instance creation' stamp: 'gvc 4/21/2009 17:49'!
newFontStyleButtonRowMorph
	"Answer a new font style button row morph."

	^self newRow: {
		self newBoldButtonMorph.
		self newItalicButtonMorph}! !

!FreeTypeGlyphRenderer commentStamp: 'tween 4/4/2007 09:48'!
This class produces glyphs for a FreeTypeFont.
It can be subclassed to provide, for example, sub-pixel anti-aliased glyphs.!
!FreeTypeGlyphRenderer methodsFor: 'private' stamp: 'tween 4/4/2007 21:24'!
convert8to32: aGlyphForm colorValue: foreColorValue
	"convert from the 8 bit deep form produced by FreeType, where each byte represents the intensity of a single pixel, to a 32 bit deep form with pixels of color foreColorValue " 
	| w h s answer rowstart bytes word littleEndian shift v a colorVal foreColorVal foreColorA foreColorR foreColorG foreColorB r g b |

	foreColorVal := foreColorValue.
	foreColorA := foreColorVal >> 24.
	foreColorR := foreColorVal >> 16 bitAnd: 16rFF.
	foreColorG := foreColorVal >> 8 bitAnd: 16rFF.
	foreColorB := foreColorVal bitAnd: 16rFF.
	bytes := aGlyphForm bits.
	w := aGlyphForm width.
	h := aGlyphForm height.
	answer := aGlyphForm class extent: w@h depth: 32.
	answer 
		offset: (aGlyphForm offset x) @ (aGlyphForm offset y);
		advance: aGlyphForm advance;
		linearAdvance: aGlyphForm linearAdvance.
	s := w + 3 >> 2.
	littleEndian := aGlyphForm isLittleEndian.
	0 to: h - 1 do: [:y |
		rowstart := (y * s)+1.
		0 to: w - 1 do:[:x | 
			word := bytes at: rowstart + (x//4).
			shift := 8* (littleEndian 
				ifTrue:[x bitAnd: 3] 
				ifFalse:[3-(x bitAnd: 3)]).
			v := word >>shift bitAnd: 16rFF.
			a := v > 0 ifTrue:[v * foreColorA // 16rFF] ifFalse:[0].
			r := v > 0 ifTrue:[a * foreColorR // 16rFF] ifFalse:[0].
			g := v > 0 ifTrue:[a * foreColorG // 16rFF] ifFalse:[0].
			b := v > 0 ifTrue:[a * foreColorB // 16rFF] ifFalse:[0].
			colorVal := (a bitShift: 24) + (r bitShift: 16) + (g bitShift: 8) + b.
			answer bits integerAt: (y*w)+(x+1) put: colorVal]].
	^answer! !

!FreeTypeGlyphRenderer methodsFor: 'public' stamp: 'tween 4/4/2007 10:35'!
glyphOf: aCharacter colorValue: aColorValue mono: monoBoolean subpixelPosition: sub font: aFreeTypeFont

	| f |
	f := self 
		renderGlyph: aCharacter 
		depth: (monoBoolean ifTrue:[1] ifFalse:[8]) 
		subpixelPosition: sub
		font: aFreeTypeFont.
	monoBoolean 
		ifTrue:[
			f := self fixBytesForMono: f.
			f := f asFormOfDepth: 8].
	f := self convert8to32: f colorValue: aColorValue.
	^f
	! !

!FreeTypeGlyphRenderer methodsFor: 'public' stamp: 'tween 4/4/2007 19:25'!
subGlyphOf: aCharacter colorValue: aColorValue mono: monoBoolean subpixelPosition: sub font: aFreeTypeFont
	"the default renderer does not support sub-pixel anti-aliasing,
	so answer an ordinary glyph"
	^self mode41GlyphOf: aCharacter colorValue: aColorValue mono: monoBoolean subpixelPosition: sub font: aFreeTypeFont
! !

!FreeTypeGlyphRenderer methodsFor: 'private' stamp: 'nice 1/5/2010 15:59'!
renderGlyph: aCharacter depth: depth subpixelPosition: sub font: aFreeTypeFont
	"Glyphs are either 1 or 8 bit deep. For 32 bpp we use 8 bits, otherwise 1"
	| em form glyph charCode slant extraWidth extraHeight boldExtra offsetX offsetY s synthBoldStrength face |

	charCode := aCharacter asUnicode asInteger.
	(aFreeTypeFont face charmaps includes:'unic')
		ifTrue:[
			(aFreeTypeFont isSymbolFont and:[charCode >= 16r20 and: [charCode <= 16rFF ] ])
				ifTrue:[charCode := charCode + 16rF000]]
		ifFalse:[
			(aFreeTypeFont face charmaps includes:'armn')
				ifTrue:[ "select apple roman char map, and map character from unicode to mac encoding"
					aFreeTypeFont face setCharMap:'armn'.
					charCode := aCharacter unicodeToMacRoman asUnicode asInteger. "check this!!"]].
	aCharacter < $  ifTrue: ["charCode := $  asUnicode asInteger"
		^(GlyphForm extent: 0@0 depth: depth)
			advance: 0@0;
			linearAdvance: 0@0;
			offset:0@0;
			yourself ].
	em := aFreeTypeFont pixelSize.
	[ | hintingFlags flags |face := aFreeTypeFont face.
	face setPixelWidth: em height: em.
	hintingFlags := FreeTypeSettings current hintingFlags.
	flags :=  LoadNoBitmap bitOr:( LoadIgnoreTransform bitOr: hintingFlags). 
	face loadCharacter:charCode flags: flags]
	on: FT2Error do:[:e | 
		^(GlyphForm extent: 0@0 depth: depth)
			advance: 0@0;
			linearAdvance: 0@0;
			offset:0@0;
			yourself]. 
	glyph := face glyph. 
	slant := aFreeTypeFont simulatedItalicSlant.
	extraWidth := (glyph height * slant) abs ceiling.
	synthBoldStrength := aFreeTypeFont simulatedBoldStrength.
	boldExtra := 4 * synthBoldStrength abs ceiling.
	extraWidth := extraWidth + boldExtra.
	sub > 0 ifTrue:[ extraWidth := extraWidth + 1].
	extraHeight := boldExtra.
	form := GlyphForm extent: (glyph width + extraWidth + 1)@(glyph height + extraHeight+ 1) depth: depth.
	s := (glyph height-glyph hBearingY)  * slant.
	s := s sign * (s abs ceiling). 
	offsetX := glyph hBearingX negated + s + (boldExtra // 2) .
	offsetY := glyph height - glyph hBearingY + (boldExtra//2).
	synthBoldStrength ~= 0
		ifTrue:[face emboldenOutline: synthBoldStrength].
	face transformOutlineAngle: 0 scalePoint: 1@1  slant: slant.
	face translateOutlineBy: (offsetX+(sub/64))@offsetY.
	face renderGlyphIntoForm: form.
	form offset: (glyph hBearingX - s - (boldExtra // 2) ) @ (glyph hBearingY + 1 + (boldExtra / 2) ceiling  ) negated.
	"When not hinting FreeType sets the advance to the truncated linearAdvance.
	The characters appear squashed together. Rounding is probably better, so we fix the advance here"
	aFreeTypeFont subPixelPositioned
		ifTrue:[ form advance: glyph roundedPixelLinearAdvance]
		ifFalse:[ form advance: glyph advance].
	form linearAdvance: glyph linearAdvance.
	^form! !

!FreeTypeGlyphRenderer methodsFor: 'private' stamp: 'tween 4/4/2007 10:25'!
convert8To32: aGlyphForm
		"convert aGlyphForm from the 8 bit deep form produced by FreeType, where each byte represents the intensity of a single pixel, to a 32 bit deep form" 
	| w h s answer rowstart bytes word littleEndian shift v a colorVal |

	bytes := aGlyphForm bits.
	w := aGlyphForm width.
	h := aGlyphForm height.
	answer := aGlyphForm class extent: w@h depth: 32.
	answer 
		offset: (aGlyphForm offset x) @(aGlyphForm offset y);
		advance: aGlyphForm advance;
		linearAdvance: aGlyphForm linearAdvance.
	s := w + 3 >> 2.
	littleEndian := aGlyphForm isLittleEndian.
	0 to: h - 1 do: [:y |
		rowstart := (y * s)+1.
		0 to: w - 1 do:[:x | 
			word := bytes at: rowstart + (x//4).
			shift := 8* (littleEndian 
				ifTrue:[x bitAnd: 3] 
				ifFalse:[3-(x bitAnd: 3)]).
			v := word >>shift bitAnd: 16rFF.
			a := v > 0 ifTrue:[16rFF] ifFalse:[0].
			colorVal := v + (v bitShift: 8) +  (v bitShift: 16) + (a bitShift: 24).
			answer bits integerAt: (y*w)+(x+1) put: colorVal]].
	^answer! !

!FreeTypeGlyphRenderer methodsFor: 'public' stamp: 'tween 4/4/2007 20:53'!
mode41GlyphOf: aCharacter colorValue: aColorValue mono: monoBoolean subpixelPosition: sub font: aFreeTypeFont

	| f |
	f := self 
		renderGlyph: aCharacter 
		depth: (monoBoolean ifTrue:[1] ifFalse:[8]) 
		subpixelPosition: sub 
		font: aFreeTypeFont.
	monoBoolean 
		ifTrue:[
			f := self fixBytesForMono: f.
			f := f asFormOfDepth: 32]
		ifFalse:[
			f := self convert8To32: f].
	^f! !

!FreeTypeGlyphRenderer methodsFor: 'private' stamp: 'tween 4/4/2007 10:28'!
fixBytesForMono: aGlyphForm
	"On Windows, the bits in each byte are in reverse order, and inverted.
	i.e. 2r10100000 should be 2r11111010  to display correctly.
	This needs further investigation"
	| b newB bits |
	bits := aGlyphForm bits.
	1 to: bits byteSize do:[:i |
		b := bits byteAt: i.
		newB := ((((((((b bitAnd: 2r10000000) bitShift: -7)
			bitOr: ((b bitAnd: 2r1000000) bitShift: -5))
			bitOr: ((b bitAnd: 2r100000) bitShift: -3))
			bitOr: ((b bitAnd: 2r10000) bitShift: -1))
			bitOr: ((b bitAnd: 2r1000) bitShift: 1))
			bitOr: ((b bitAnd: 2r100) bitShift: 3))
			bitOr: ((b bitAnd: 2r10) bitShift: 5))
			bitOr: ((b bitAnd: 2r1) bitShift: 7).
		bits byteAt: i put: (newB bitXor: 2r11111111)].
	^aGlyphForm! !

!FreeTypeGlyphRenderer class methodsFor: 'accessing' stamp: 'tween 4/4/2007 09:50'!
current: aKindOfFreeTypeGlyphRender
	current := aKindOfFreeTypeGlyphRender! !

!FreeTypeGlyphRenderer class methodsFor: 'instance creation' stamp: 'tween 4/4/2007 19:24'!
current
	"
	FreeTypeGlyphRenderer current
	"
	^current ifNil:[current := self new]! !

!FreeTypeNameParser commentStamp: 'TorstenBergmann 2/4/2014 22:11'!
A name parser!
!FreeTypeNameParser methodsFor: 'parsing' stamp: 'tween 8/14/2007 22:01'!
extractUpright
	"extract from current combined name.
	answer new combinedName"
	| normalTok start end | 

	normalTok := tokens reversed 
		detect: [:tok | 
			(self normalNames 
				detect: [:str | str asLowercase = tok first asLowercase] 
				ifNone:[]) notNil ]
		ifNone:[].
	normalTok ifNotNil:[
		"remove it from combinedName"
		start := normalTok second.
		end :=  normalTok third.
		extractedUpright := combinedName copyFrom: start to: end.
		[start > 1 and:[delimiters includes: (combinedName at: start - 1)]]
			whileTrue:[start := start - 1].
		[end < combinedName size and:[delimiters includes: (combinedName at: end + 1)]]
			whileTrue:[end := end + 1].		
		combinedName := combinedName copyReplaceFrom: start to: end with: ' '].

	! !

!FreeTypeNameParser methodsFor: 'accessing' stamp: 'tween 8/12/2007 12:29'!
extractedStretch
	^extractedStretch! !

!FreeTypeNameParser methodsFor: 'parsing' stamp: 'tween 9/29/2007 12:34'!
extractWeight
	"match and remove last weight tokens"
	| matches start end |

	extractedWeightValue := LogicalFont weightRegular.
	(self weightNames 
		detect: [:each |
			matches := self lastMatchValueSequence: each allButFirst.
			matches ifNotNil:[extractedWeightValue := each first].
			matches notNil]
		ifNone:[]) ifNotNil:[
			start := matches first second.
			end :=  matches last third.
			extractedWeight := combinedName copyFrom: start to: end.
			[start > 1 and:[delimiters includes: (combinedName at: start - 1)]] "also remove delimiters before token"
				whileTrue:[start := start - 1].
			[end < combinedName size and:[delimiters includes: (combinedName at: end + 1)]] "also remove delimiters after token"
				whileTrue:[end := end + 1].		
			combinedName := combinedName copyReplaceFrom: start to: end with: ' '.].	
	(extractedWeight isNil and:[boldFlag])
		ifTrue:["no weight specified in familyName or styleName; force it to be 'Bold'"
			extractedWeight := 'Bold'.
			extractedWeightValue := LogicalFont weightBold]	! !

!FreeTypeNameParser methodsFor: 'accessing' stamp: 'tween 8/16/2007 21:33'!
extractedSlantValue
	^extractedSlantValue! !

!FreeTypeNameParser methodsFor: 'known names' stamp: 'tween 8/25/2007 13:28'!
normalNames
	^self class normalNames
! !

!FreeTypeNameParser methodsFor: 'known names' stamp: 'tween 8/16/2007 02:12'!
italicNames
	^self class italicNames! !

!FreeTypeNameParser methodsFor: 'initialization' stamp: 'nice 10/30/2013 21:39'!
initialize
	super initialize.
	delimiters := ',.-_'.
	Character separators do:[:c | delimiters := delimiters , c asString].
! !

!FreeTypeNameParser methodsFor: 'known names' stamp: 'tween 9/29/2007 11:41'!
weightNames
	^self class weightNames
			! !

!FreeTypeNameParser methodsFor: 'accessing' stamp: 'tween 8/12/2007 12:29'!
extractedWeight
	^extractedWeight! !

!FreeTypeNameParser methodsFor: 'accessing' stamp: 'tween 8/16/2007 21:32'!
extractedSlant
	^extractedSlant! !

!FreeTypeNameParser methodsFor: 'accessing' stamp: 'tween 8/16/2007 00:55'!
extractedStretchValue
	^extractedStretchValue! !

!FreeTypeNameParser methodsFor: 'parsing' stamp: 'tween 9/29/2007 12:35'!
extractStretch
	"match and remove last stretch tokens"
	| matches start end |

	extractedStretchValue := LogicalFont stretchRegular.
	(self stretchNames 
		detect: [:each |
			matches := self lastMatchValueSequence: each allButFirst.
			matches ifNotNil:[extractedStretchValue := each first].
			matches notNil]
		ifNone:[]) ifNotNil:[
			start := matches first second.
			end :=  matches last third.
			extractedStretch := combinedName copyFrom: start to: end.
			[start > 1 and:[delimiters includes: (combinedName at: start - 1)]] "also remove delimiters before token"
				whileTrue:[start := start - 1].
			[end < combinedName size and:[delimiters includes: (combinedName at: end + 1)]] "also remove delimiters after token"
				whileTrue:[end := end + 1].		
			combinedName := combinedName copyReplaceFrom: start to: end with: ' '.
			"re-tokenize"
			"tokens := self tokenize: combinedName delimiters: delimiters"].	! !

!FreeTypeNameParser methodsFor: 'accessing' stamp: 'tween 8/12/2007 20:14'!
italicFlag: aBoolean
	italicFlag := aBoolean! !

!FreeTypeNameParser methodsFor: 'accessing' stamp: 'tween 8/16/2007 00:55'!
extractedWeightValue
	^extractedWeightValue! !

!FreeTypeNameParser methodsFor: 'accessing' stamp: 'tween 8/11/2007 23:39'!
familyNameIn: familyName
	familyNameIn := familyName.

	! !

!FreeTypeNameParser methodsFor: 'parsing' stamp: 'SvenVanCaekenberghe 1/8/2012 14:44'!
parse

	| styleName |
	styleNameIn := self splitBadTokensIn: styleNameIn.
	combinedName := styleNameIn trimBoth.
	tokens := self tokenize: combinedName.
	self extractUpright.
	styleName := combinedName.
	combinedName := familyNameIn trimBoth.
	self addStyleNameToCombinedName: styleName..
	tokens := self tokenize: combinedName.
	self extractSlant.
	tokens := self tokenize: combinedName.
	self extractStretch.
	tokens := self tokenize: combinedName.
	self extractWeight.
	! !

!FreeTypeNameParser methodsFor: 'accessing' stamp: 'tween 8/12/2007 20:14'!
boldFlag: aBoolean
	boldFlag := aBoolean! !

!FreeTypeNameParser methodsFor: 'parsing' stamp: 'nice 10/30/2013 21:39'!
tokenize: aString 
	"answer an OrderedCollection of {string. start. end} tuples.
	tokens are separated by $- $_ $, $. and whitespace"
	| currentTokens answer start |
	
	currentTokens := aString findTokens: delimiters keep: delimiters.
	answer := OrderedCollection new.
	start := 1.
	currentTokens do:[:tok |
		(delimiters includes: tok first)
			ifFalse:[answer add: {tok. start. start+tok size - 1}].
		start := start + tok size].
	^answer! !

!FreeTypeNameParser methodsFor: 'known names' stamp: 'tween 8/16/2007 02:54'!
italicAndObliqueNames
	^self class italicAndObliqueNames! !

!FreeTypeNameParser methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/8/2012 14:44'!
familyName
	^combinedName trimBoth! !

!FreeTypeNameParser methodsFor: 'parsing' stamp: 'tween 8/13/2007 23:02'!
addStyleNameToCombinedName: aStyleString
	| lcCombined lcStyleName addStyle index |
	lcCombined := combinedName asLowercase.
	lcStyleName := aStyleString asLowercase.
	addStyle := true.
	(index := lcCombined findString: lcStyleName) > 0
		ifTrue:[ 
			(index = 1 or:[delimiters includes: (lcCombined at: index - 1)])
				ifTrue:[
					((index + lcStyleName size > lcCombined size) or:[ delimiters includes: (lcCombined at: index + lcStyleName size) ])
						ifTrue:["don't add the style to the combinedName, because it already contains it"
							addStyle := false]]].
	addStyle ifTrue:[combinedName := combinedName , ' ', aStyleString].
	! !

!FreeTypeNameParser methodsFor: 'parsing' stamp: 'tween 9/29/2007 12:03'!
extractSlant

	|  matches start end |

	"match and remove last italic/oblique token"
	extractedSlant := nil.
	extractedSlantValue := LogicalFont slantRegular. "not italic or oblique"
	(self italicAndObliqueNames 
		detect: [:each |
			(matches := self lastMatchValueSequence: {each}) notNil]
		ifNone:[]) ifNotNil:[
			start := matches first second.
			end :=  matches last third.
			extractedSlant := combinedName copyFrom: start to: end.
			"extractedSlantValue := (self italicNames includes: extractedSlant asLowercase)
				ifTrue:[1]
				ifFalse:[2]."
			extractedSlantValue := LogicalFont slantItalic. "treat italic and oblique the same, as italic"
			[start > 1 and:[delimiters includes: (combinedName at: start - 1)]] "also remove delimiters before token"
				whileTrue:[start := start - 1].
			[end < combinedName size and:[delimiters includes: (combinedName at: end + 1)]] "also remove delimiters after token"
				whileTrue:[end := end + 1].		
			combinedName := combinedName copyReplaceFrom: start to: end with: ' '.].
	(extractedSlant isNil and:[italicFlag])
		ifTrue:["no italic specified in familyName or styleName; force it to be 'Italic'"
			extractedSlant := 'Italic'.
			extractedSlantValue := LogicalFont slantItalic]		! !

!FreeTypeNameParser methodsFor: 'known names' stamp: 'tween 9/29/2007 11:41'!
stretchNames
	^self class stretchNames! !

!FreeTypeNameParser methodsFor: 'accessing' stamp: 'tween 8/16/2007 01:16'!
extractedUpright
	^extractedUpright! !

!FreeTypeNameParser methodsFor: 'accessing' stamp: 'tween 8/11/2007 23:39'!
styleNameIn: styleName
	
	styleNameIn := styleName. 
! !

!FreeTypeNameParser methodsFor: 'accessing' stamp: 'tween 8/11/2007 18:06'!
familyName: familyName
	familyNameIn := familyName.

	! !

!FreeTypeNameParser methodsFor: 'parsing' stamp: 'tween 8/11/2007 18:23'!
lastMatchValueSequence: values
	"answer the last contiguous tokens that match pattern tokens, 
	or nil if not found.
	matching is case insensitive "
	| answer  nullToken match tok |
	nullToken := {''. nil. nil}.
	tokens size - values size + 1 to: 1 by: -1 do:[:ti |
		match := true.
		answer := Array new.
		1 to: values size do:[:vi |
			tok := tokens at: ti + vi - 1 ifAbsent: [nullToken].
			(match and: [tok first asLowercase = ( values at: vi) asLowercase])
				ifFalse:[match := false]
				ifTrue:[answer := answer, {tok} ]].
		match ifTrue:[^answer]].
	^nil
			
! !

!FreeTypeNameParser methodsFor: 'parsing' stamp: 'nice 1/5/2010 15:59'!
splitBadTokensIn: aString
	"split tokens such as BoldOblique, that should be two words"
	| str |
	str := aString.
	#(	('bold' 'oblique') ('bold' 'italic')
	) do:[:pair | | i |
		(i := str asLowercase findString: pair first, pair second startingAt: 1) > 0
			ifTrue:[
				str := (str first: i + pair first size - 1), ' ', (str last: (str size - (i + pair first size - 1)))]].
	^str! !

!FreeTypeNameParser methodsFor: 'accessing' stamp: 'tween 8/11/2007 18:06'!
styleName: styleName
	
	styleNameIn := styleName. 
! !

!FreeTypeNameParser class methodsFor: 'known names' stamp: 'tween 9/30/2007 12:44'!
normalNames
	"Answer a sequence of String tokens that indicate a Regular
	(i.e. non-oblique, non-italic) font within a font family-style name"
	"
	TO RE-INITIALIZE...
	self instVarNamed: #normalNames put: nil.
	"
	normalNames ifNotNil:[^normalNames].
	^normalNames := #('Book' 'Normal' 'Regular' 'Roman' 'Upright').! !

!FreeTypeNameParser class methodsFor: 'known names' stamp: 'tween 9/30/2007 12:43'!
obliqueNames
	"Answer a sequence of String tokens that indicate an oblique font
	within a font family-style name"
	"
	TO RE-INITIALIZE...
	self instVarNamed: #obliqueNames put: nil.
	"
	obliqueNames ifNotNil:[^obliqueNames].
	^obliqueNames := #(
		'inclined'
		'oblique'
		'backslanted'
		'backslant'
		'slanted').! !

!FreeTypeNameParser class methodsFor: 'known names' stamp: 'tween 9/30/2007 12:42'!
stretchNames
	"Answer a sequence of arrays.
	Each array has an integer stretch value as its first element (1 - 9).
	The remaining elements are String tokens which might appear
	within a font family-style name"
	"
	TO RE-INITIALIZE...
	self instVarNamed: #stretchNames put: nil.
	"
	stretchNames ifNotNil:[^stretchNames].
	^stretchNames := {
		{LogicalFont stretchExtraCompressed. 'extra'. 'compressed'}.
		{LogicalFont stretchExtraCompressed. 'extracompressed'}.
		{LogicalFont stretchExtraCompressed. 'ext'. 'compressed'}.
		{LogicalFont stretchExtraCompressed. 'extcompressed'}.
		{LogicalFont stretchUltraCompressed. 'ultra'. 'compressed'}.
		{LogicalFont stretchUltraCompressed. 'ultracompressed'}.
		{LogicalFont stretchUltraCondensed. 'ultra'. 'condensed'}.
		{LogicalFont stretchUltraCondensed. 'ultracondensed'}.
		{LogicalFont stretchUltraCondensed. 'ultra'. 'cond'}.
		{LogicalFont stretchUltraCondensed. 'ultracond'}.
		{LogicalFont stretchCompressed. 'compressed'}.
		{LogicalFont stretchExtraCondensed. 'extra'. 'condensed'}.
		{LogicalFont stretchExtraCondensed. 'extracondensed'}.
		{LogicalFont stretchExtraCondensed. 'ext'. 'condensed'}.
		{LogicalFont stretchExtraCondensed. 'extcondensed'}.
		{LogicalFont stretchExtraCondensed. 'extra'. 'cond'}.
		{LogicalFont stretchExtraCondensed. 'extracond'}.
		{LogicalFont stretchExtraCondensed. 'ext'. 'cond'}.
		{LogicalFont stretchExtraCondensed. 'extcond'}.
		{LogicalFont stretchNarrow. 'narrow'}.
		{LogicalFont stretchCompact. 'compact'}.
		{LogicalFont stretchSemiCondensed. 'semi'. 'condensed'}.
		{LogicalFont stretchSemiCondensed. 'semicondensed'}.
		{LogicalFont stretchSemiCondensed. 'semi'. 'cond'}.
		{LogicalFont stretchSemiCondensed. 'semicond'}.
		{LogicalFont stretchWide. 'wide'}.
		{LogicalFont stretchSemiExpanded. 'semi'. 'expanded'}.
		{LogicalFont stretchSemiExpanded. 'semiexpanded'}.
		{LogicalFont stretchSemiExtended. 'semi'. 'extended'}.
		{LogicalFont stretchSemiExtended. 'semiextended'}.
		{LogicalFont stretchExtraExpanded. 'extra'. 'expanded'}.
		{LogicalFont stretchExtraExpanded. 'extraexpanded'}.
		{LogicalFont stretchExtraExpanded. 'ext'. 'expanded'}.
		{LogicalFont stretchExtraExpanded. 'extexpanded'}.
		{LogicalFont stretchExtraExtended. 'extra'. 'extended'}.
		{LogicalFont stretchExtraExtended. 'extraextended'}.
		{LogicalFont stretchExtraExtended. 'ext'. 'extended'}.
		{LogicalFont stretchExtraExtended. 'extextended'}.
		{LogicalFont stretchUltraExpanded. 'ultra'. 'expanded'}.
		{LogicalFont stretchUltraExpanded. 'ultraexpanded'}.
		{LogicalFont stretchUltraExtended. 'ultra'. 'extended'}.
		{LogicalFont stretchUltraExtended. 'ultraextended'}.
		{LogicalFont stretchCondensed. 'condensed'}.
		{LogicalFont stretchCondensed. 'cond'}.
		{LogicalFont stretchExpanded. 'expanded'}.
		{LogicalFont stretchExtended. 'extended'}	
		}.  "search for them in the order given here"
! !

!FreeTypeNameParser class methodsFor: 'known names' stamp: 'tween 9/30/2007 12:41'!
weightNames
	"Answer a sequence of arrays.
	Each array has an integer weight value as its first element.
	The remaining elements are String tokens which might appear
	within a font family-style name"
	"
	TO RE-INITIALIZE...
	self instVarNamed: #weightNames put: nil.
	"
	weightNames ifNotNil:[^weightNames].
	^weightNames := {
		{LogicalFont weightExtraThin. 'extra'. 'thin'}.
		{LogicalFont weightExtraThin.'extrathin'}.
		{LogicalFont weightExtraThin. 'ext'. 'thin'}.
		{LogicalFont weightExtraThin. 'extthin'}.
		{LogicalFont weightUltraThin.'ultra'. 'thin'}.
		{LogicalFont weightUltraThin.'ultrathin'}.
		{LogicalFont weightExtraLight. 'extra'. 'light'}.
		{LogicalFont weightExtraLight. 'extralight'}.
		{LogicalFont weightExtraLight. 'ext'. 'light'}.
		{LogicalFont weightExtraLight. 'extlight'}.
		{LogicalFont weightUltraLight. 'ultra'. 'light'}.
		{LogicalFont weightUltraLight. 'ultralight'}.
		{LogicalFont weightSemiBold. 'semi'. 'bold'}.
		{LogicalFont weightSemiBold. 'semibold'}.
		{LogicalFont weightDemiBold. 'demi'. 'bold'}.
		{LogicalFont weightDemiBold. 'demibold'}.
		{LogicalFont weightExtraBold. 'extra'. 'bold'}.
		{LogicalFont weightExtraBold. 'extrabold'}.
		{LogicalFont weightExtraBold. 'ext'. 'bold'}.
		{LogicalFont weightExtraBold. 'extbold'}. 
		{LogicalFont weightUltraBold. 'ultra'. 'bold'}.
		{LogicalFont weightUltraBold. 'ultrabold'}.
		{LogicalFont weightExtraBlack. 'extra'. 'black'}.
		{LogicalFont weightExtraBlack. 'extrablack'}.
		{LogicalFont weightExtraBlack. 'ext'. 'black'}.
		{LogicalFont weightExtraBlack. 'extblack'}.
		{LogicalFont weightUltraBlack.'ultra'. 'black'}.
		{LogicalFont weightUltraBlack. 'ultrablack'}.
		{LogicalFont weightBold. 'bold'}.
		{LogicalFont weightThin.'thin'}.
		{LogicalFont weightLight. 'light'}.
		{LogicalFont weightMedium. 'medium'}.
		{LogicalFont weightBlack. 'black'}.
		{LogicalFont weightHeavy. 'heavy'}.
		{LogicalFont weightNord. 'nord'}.
		{LogicalFont weightDemi. 'demi'}.
		{LogicalFont weightUltra. 'ultra'}.
		} 
			! !

!FreeTypeNameParser class methodsFor: 'known names' stamp: 'tween 8/16/2007 02:47'!
italicAndObliqueNames
	^self italicNames, self obliqueNames! !

!FreeTypeNameParser class methodsFor: 'known names' stamp: 'tween 9/30/2007 12:44'!
italicNames
	"Answer a sequence of String tokens that indicate an italic font
	within a font family-style name"
	"
	TO RE-INITIALIZE...
	self instVarNamed: #italicNames put: nil.
	"
	italicNames ifNotNil:[^italicNames].
	^italicNames := #(
		'ita'
		'ital'
		'italic'
		'cursive'
		'kursiv').! !

!FreeTypeSettings commentStamp: 'TorstenBergmann 2/4/2014 22:11'!
Settings for FreeType!
!FreeTypeSettings methodsFor: 'accessing' stamp: 'tween 3/30/2007 18:16'!
lightHinting
	^lightHinting ifNil:[lightHinting := true]! !

!FreeTypeSettings methodsFor: 'accessing' stamp: 'tween 3/30/2007 18:04'!
clearBitBltSubPixelAvailable	
	
	bitBltSubPixelAvailable := nil.! !

!FreeTypeSettings methodsFor: 'accessing' stamp: 'tween 3/30/2007 18:15'!
hintingFlags
	| answer |
	answer := 0. 	
	self hinting 
		ifTrue:[
			self forceAutoHinting ifTrue:[answer := answer bitOr: 32 "forceAutoHinting"].	
			self lightHinting ifTrue:[answer := answer bitOr: LoadTargetLight].
			self monoHinting ifTrue:[answer := answer bitOr: LoadTargetMono].
			self lcdHinting ifTrue:[answer := answer bitOr: LoadTargetLCD].
			self lcdvHinting ifTrue:[answer := answer bitOr: LoadTargetLCDV]]
		ifFalse:[answer := 2 "no hinting"].
	^answer! !

!FreeTypeSettings methodsFor: 'accessing' stamp: 'tween 3/30/2007 18:12'!
forceAutoHinting
	^forceAutoHinting ifNil:[forceAutoHinting := false]! !

!FreeTypeSettings methodsFor: 'accessing' stamp: 'tween 3/30/2007 18:13'!
forceNonSubPixelCount
	^forceNonSubPixelCount ifNil:[forceNonSubPixelCount := 0]! !

!FreeTypeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 11/24/2009 16:26'!
hintingSymbol
	"#Full, #Light, #Normal or #None"
	^ self monoHinting 
		ifTrue: [#Full]
		ifFalse: [
			self lightHinting 
				ifTrue: [#Light]
				ifFalse: [
					self hinting 
						ifTrue: [#Normal]
						ifFalse: [#None]]]
! !

!FreeTypeSettings methodsFor: 'accessing' stamp: 'marcus.denker 11/29/2008 10:43'!
setSubPixelFilter: ratiosArray
	"Set the subPixelFilters from ratiosArray.
	the ratiosArray can specify the red, green, and blue filter ratios separately.
	e.g. #((1 3 5 3 1) (1 4 7 4 1) (1 2 3 2 1))
	or, as single set of ratios e.g. #(1 3 5 3 1)" 
	
	| validArray newFilters |
	validArray := ratiosArray.
	(ratiosArray size = 5)
		ifTrue:[validArray := {ratiosArray. ratiosArray. ratiosArray}].
	newFilters := self subPixelFiltersFromRatios: validArray. 
	(newFilters = subPixelFilters)
		ifFalse:[
			subPixelFilters := newFilters.
			FreeTypeCache current removeAllForType: FreeTypeCacheGlyphLCD.
			World restoreMorphicDisplay]! !

!FreeTypeSettings methodsFor: 'accessing' stamp: 'tween 3/30/2007 18:25'!
gammaInverseTable
	^gammaInverseTable! !

!FreeTypeSettings methodsFor: 'accessing' stamp: 'marcus.denker 11/29/2008 10:41'!
setGamma: aFloat

	(aFloat closeTo: self gamma)
		ifFalse:[
			gamma := aFloat.
			(gamma closeTo: 1.0)
				ifTrue:[gammaTable := gammaInverseTable := nil]
				ifFalse:[
					gammaTable := ByteArray new: 256.
					gammaInverseTable := ByteArray new: 256.
					0 to: 255 do:[:i |
						| g ug |
						g := ((i / 255.0) raisedTo: (1.0/gamma)) * 255.
						ug := ((i / 255.0) raisedTo: gamma) * 255.
						g := (g rounded min: 255) max: 0 .
						ug := (ug rounded min: 255) max: 0 .
						gammaTable at: i + 1 put: g.
						gammaInverseTable at: i + 1 put: ug]].
				World restoreMorphicDisplay]! !

!FreeTypeSettings methodsFor: 'accessing' stamp: 'tween 3/30/2007 18:20'!
subPixelAntiAliasing
	self bitBltSubPixelAvailable ifFalse:[^false].
	self forceNonSubPixelCount > 0 ifTrue:[^false].
	^subPixelAntiAliasing ifNil:[false]! !

!FreeTypeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 11/26/2009 22:22'!
glyphContrast
	^ 100 - ((self gamma  sqrt * 100) - 50)! !

!FreeTypeSettings methodsFor: 'accessing' stamp: 'tween 3/30/2007 18:15'!
lcdHinting
	^lcdHinting ifNil:[lcdHinting := false]! !

!FreeTypeSettings methodsFor: 'accessing' stamp: 'tween 3/30/2007 18:25'!
gammaTable
	^gammaTable! !

!FreeTypeSettings methodsFor: 'accessing' stamp: 'tween 4/2/2007 23:29'!
pretendBitBltSubPixelUnavailableDuring: aBlock	
	"
	For testing/profiling only. 
	
	Answer true if the the subPixel combination rule is available, false otherwise.
	to test :-
	
	bitBltSubPixelAvailable := false. 
	FreeTypeCache current removeAll.
	Smalltalk isMorphic
		ifTrue:[World restoreMorphicDisplay]
		
	"
	| old |
	old := bitBltSubPixelAvailable.
	[bitBltSubPixelAvailable := false.
	FreeTypeCache current removeAll.
	aBlock value.
	] ensure:[
		bitBltSubPixelAvailable := old.
		FreeTypeCache current removeAll.]! !

!FreeTypeSettings methodsFor: 'accessing' stamp: 'tween 3/30/2007 18:15'!
lcdvHinting
	^lcdvHinting ifNil:[lcdvHinting := false]! !

!FreeTypeSettings methodsFor: 'accessing' stamp: 'tween 3/30/2007 18:17'!
monoHinting
	^monoHinting ifNil:[monoHinting := false]! !

!FreeTypeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/6/2009 12:42'!
monitorType: aSymbol
	"#LCD or #CRT"
	subPixelAntiAliasing := aSymbol = #LCD.
	World restoreMorphicDisplay.! !

!FreeTypeSettings methodsFor: 'accessing' stamp: 'tween 3/30/2007 18:13'!
hinting
	^hinting ifNil:[hinting := true]! !

!FreeTypeSettings methodsFor: 'accessing' stamp: 'Pavelkrivanek 11/6/2010 12:20'!
monitorType
  "#LCD or #CRT"
  ^ self subPixelAntiAliasing ifTrue: [#LCD] ifFalse: [#CRT]
! !

!FreeTypeSettings methodsFor: 'accessing' stamp: 'tween 3/30/2007 18:13'!
forceNonSubPixelDuring: aBlock
	forceNonSubPixelCount ifNil:[forceNonSubPixelCount := 0].
	forceNonSubPixelCount := forceNonSubPixelCount + 1.
	aBlock ensure:[forceNonSubPixelCount := forceNonSubPixelCount - 1]! !

!FreeTypeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 1/5/2010 11:40'!
subPixelAntiAliasing: aBoolean
	subPixelAntiAliasing := aBoolean! !

!FreeTypeSettings methodsFor: 'accessing' stamp: 'tween 3/30/2007 18:22'!
subPixelFilters
	^subPixelFilters ifNil:[subPixelFilters := self subPixelFiltersFromRatios: self defaultSubPixelFilterRatios]! !

!FreeTypeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 11/26/2009 22:21'!
glyphContrast: aContrastValue
	" value between 1 and 100.
	100 is highest contrast and maps to gamma 0.25
	1 is lowest contrast and maps to gamma 2.22"
	Cursor wait showWhile: [
		| v g |
		v := (((aContrastValue asNumber) min: 100) max: 1) asFloat.
		(v closeTo: 50.0) 
			ifTrue: [g := 1.0]
			ifFalse: [g := ((100 - v) + 50 / 100.0) raisedTo: 2].
		self setGamma: g].
! !

!FreeTypeSettings methodsFor: 'accessing' stamp: 'tween 3/30/2007 18:22'!
subPixelFiltersFromRatios: anArray
	"Convert the ratios in anArray to a similar array containing the filter proportions as floats.
	Example:
	if <array3ofArrays5> = #((1 3 5 3 1) (1 3 5 3 1) (1 3 5 3 1))
	Then the answer is #(#(0.0769230769230769 0.2307692307692308 0.3846153846153846 0.2307692307692308 0.0769230769230769) #(0.0769230769230769 0.2307692307692308 0.3846153846153846 0.2307692307692308 0.0769230769230769) #(0.0769230769230769 0.2307692307692308 0.3846153846153846 0.2307692307692308 0.0769230769230769))"
	
	| r g b rRatios gRatios bRatios rsum gsum bsum rfilter gfilter bfilter blurR blurG blurB |
		
	r := "Color red luminance" 1.0 .
	g := "Color green luminance" 1.0 .
	b := "Color blue luminance"1.0 .
	blurR :=  anArray first.
	blurG := anArray second.
	blurB := anArray third.
	rRatios := blurR collect:[:i | r*i].
	gRatios := blurG collect:[:i | g*i].
	bRatios := blurB collect:[:i | b*i].
	"rRatios := 	{g*blurR first .	b*blurR second.	r*blurR third.	g*bl.	b*blur*blur }.							
	gRatios := 	{b*blur*blur.	r*blur.	g.		b*blur.	r*blur*blur}.
	bRatios :=	{r*blur*blur.	g*blur.	b.		r*blur.	g*blur*blur }."
	rsum := rRatios inject:0 into:[:t :i | t+i].
	gsum := gRatios inject:0 into:[:t :i | t+i].
	bsum := bRatios inject:0 into:[:t :i | t+i].
	rfilter := rRatios collect:[:e | e / rsum].
	gfilter := gRatios collect:[:e | e / gsum].
	bfilter := bRatios collect:[:e | e / bsum].
	^{rfilter. gfilter. bfilter}! !

!FreeTypeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 1/5/2010 10:53'!
bitBltSubPixelAvailable	
	"Answer true if the the subPixel combination rule is available, false otherwise.
	to test :-
	bitBltSubPixelAvailable := false. 
	FreeTypeCache current removeAll.
	World restoreMorphicDisplay
	"
	
	| form bitBlt color |
	bitBltSubPixelAvailable == nil ifFalse:[^bitBltSubPixelAvailable].
	form := Form extent: 10@10 depth: 32.
	bitBlt := GrafPort toForm: form.
	bitBlt combinationRule: 41.
	bitBlt sourceForm: (Form extent: 5@5 depth: 32).
	bitBlt destOrigin: 1@1.
	bitBlt width: 5; height: 5.
	color := Color black asNontranslucentColor pixelValueForDepth: 32.
	[bitBlt 
		copyBitsColor: (color bitAnd: 16rFFFFFF)
		alpha: (color bitAnd: 16rFF000000) >> 24 
		gammaTable: nil
		ungammaTable: nil]
	on: Error do:[:e | ^bitBltSubPixelAvailable := false].
	#toDo. "need to check that rule 41 has done the right thing, and isn't someone elses new BitBlt rule"
	^bitBltSubPixelAvailable := true
	! !

!FreeTypeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 11/27/2009 09:13'!
gamma
	^gamma ifNil:[gamma := 1.0] ! !

!FreeTypeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 9/15/2011 17:26'!
hintingSymbol: aSymbol
	"#Full, #Light, #Normal or #None"
	monoHinting := aSymbol = #Full.
	lightHinting := aSymbol = #Light.
	hinting := monoHinting or:[lightHinting or:[aSymbol = #Normal]].
	FreeTypeCache current removeAll.
	FreeTypeFont allSubInstances do:[:each | each clearCachedMetrics].
	Paragraph allSubInstances do:[:each | each composeAll].
	World restoreMorphicDisplay.

! !

!FreeTypeSettings methodsFor: 'accessing' stamp: 'tween 3/30/2007 18:03'!
clearForceNonSubPixelCount
	
	forceNonSubPixelCount := nil. ! !

!FreeTypeSettings methodsFor: 'accessing' stamp: 'tween 3/30/2007 18:12'!
defaultSubPixelFilterRatios
	^#((1 3 5 3 1) (1 3 5 3 1) (1 3 5 3 1))! !

!FreeTypeSettings class methodsFor: 'settings' stamp: 'AlainPlantec 12/3/2009 12:42'!
updateFontsAtImageStartup
	^ UpdateFontsAtImageStartup ifNil: [UpdateFontsAtImageStartup := false]! !

!FreeTypeSettings class methodsFor: 'settings' stamp: 'AlainPlantec 12/3/2009 12:43'!
updateFontsAtImageStartup: aBoolean
	UpdateFontsAtImageStartup := aBoolean! !

!FreeTypeSettings class methodsFor: 'class initialization' stamp: 'MarcusDenker 3/17/2012 10:04'!
initialize
	"
	self initialize
	"
	Smalltalk removeFromStartUpList: self.
	Smalltalk addToStartUpList: self . ! !

!FreeTypeSettings class methodsFor: 'shutdown' stamp: 'tween 8/31/2007 18:00'!
shutDown: quitting 
	self current clearBitBltSubPixelAvailable.
	self current clearForceNonSubPixelCount! !

!FreeTypeSettings class methodsFor: 'startup' stamp: 'EstebanLorenzano 12/1/2014 15:39'!
updateFreeType
	self current 
		clearBitBltSubPixelAvailable;
		clearForceNonSubPixelCount.
	"Embeded fonts update always"
	FreeTypeFontProvider current updateEmbeddedFreeTypeFonts. 
	self updateFontsAtImageStartup 
		ifTrue: [ FreeTypeFontProvider current updateFromSystem ]! !

!FreeTypeSettings class methodsFor: 'startup' stamp: 'EstebanLorenzano 12/1/2014 15:38'!
startUp: resuming
	resuming ifTrue:[ self updateFreeType ]! !

!FreeTypeSettings class methodsFor: 'instance creation' stamp: 'tween 3/30/2007 17:54'!
current
	current == nil ifFalse:[^current].
	^current := self new! !

!FreeTypeSubPixelAntiAliasedGlyphRenderer commentStamp: 'TorstenBergmann 2/4/2014 22:11'!
A SubPixel-AntiAliased GlyphRenderer for FreeType!
!FreeTypeSubPixelAntiAliasedGlyphRenderer methodsFor: 'rendering' stamp: 'tween 4/4/2007 18:42'!
filter: aGlyphForm
	"aGlyphForm should be 3x stretched 8 bit GlyphForm"
	| w h s answer rowstart bytes word littleEndian shift v a colorVal i 
	  prevG prevB r g b nextR nextG  filters rfilter gfilter bfilter  
	balR balG balB |
	
	"correctionFactor := 0.0 ."
	filters := FreeTypeSettings current subPixelFilters.
	rfilter := filters at: 1.
	gfilter := filters at: 2.
	bfilter := filters at: 3.
	bytes := aGlyphForm bits.
	w := aGlyphForm width.
	h := aGlyphForm height.
	answer := aGlyphForm class extent: ((aGlyphForm width / 3) ceiling + 2)@h depth: 32.
	answer 
		offset: (aGlyphForm offset x / 3) rounded@(aGlyphForm offset y);
		advance: (aGlyphForm advance / 3) rounded;
		linearAdvance: aGlyphForm linearAdvance.	
	s := w + 3 >> 2.
	littleEndian := aGlyphForm isLittleEndian.
	0 to: h - 1 do: [:y |
		rowstart := (y * s)+1.
		prevG := prevB :=0.
		0 to: w - 1 by: 3 do:[:x | 
			0 to: 2 do:[:subpixelindex |
				i := x + subpixelindex.
				word := bytes at: rowstart + (i//4).
				shift := -8* (littleEndian 
					ifTrue:[i bitAnd: 3] 
					ifFalse:[3-(i bitAnd: 3)]).
				v := (word bitShift: shift) bitAnd: 16rFF.
				subpixelindex = 0 ifTrue:[r := v].
				subpixelindex = 1 ifTrue:[g := v].
				subpixelindex = 2 ifTrue:[b := v]].
			x >= (w-3)
				ifTrue:[nextR := nextG := 0]
				ifFalse:[
					0 to: 1 do:[:subpixelindex |
						i := x + 3 + subpixelindex.
						word := bytes at: rowstart + (i//4).
						shift := -8* (littleEndian 
							ifTrue:[i bitAnd: 3] 
							ifFalse:[3-(i bitAnd: 3)]).
						v := (word bitShift: shift) bitAnd: 16rFF.
						subpixelindex = 0 ifTrue:[nextR := v].
						subpixelindex = 1 ifTrue:[nextG := v]]].
			"balance r g b"	
			balR := (prevG*(rfilter at: 1))+
				(prevB*(rfilter at: 2))+
				(r*(rfilter at: 3))+
				(g*(rfilter at: 4))+
				(b*(rfilter at: 5)).
			balG := (prevB*(gfilter at: 1))+
				(r*(gfilter at: 2))+
				(g*(gfilter at: 3))+
				(b*(gfilter at: 4))+
				(nextR*(gfilter at: 5)).
			balB := (r*(bfilter at: 1))+
				(g*(bfilter at: 2))+
				(b*(bfilter at: 3))+
				(nextR*(bfilter at: 4))+
				(nextG*(bfilter at: 5)).
			"luminance := (0.299*balR)+(0.587*balG)+(0.114*balB).
			balR := balR + ((luminance - balR)*correctionFactor).
			balG := balG + ((luminance - balG)*correctionFactor).
			balB := balB + ((luminance - balB)*correctionFactor)."
			balR := balR  truncated.
			balR < 0 ifTrue:[balR := 0] ifFalse:[balR > 255 ifTrue:[balR := 255]].	
			balG := balG  truncated.
			balG < 0 ifTrue:[balG := 0] ifFalse:[balG > 255 ifTrue:[balG := 255]].		
			balB := balB  truncated.
			balB < 0 ifTrue:[balB := 0] ifFalse:[balB > 255 ifTrue:[balB := 255]].	 
			a := balR + balG + balB > 0 ifTrue:[16rFF] ifFalse:[0].
			colorVal := balB + (balG bitShift: 8) +  (balR bitShift: 16) + (a bitShift: 24).
			answer bits integerAt: (y*answer width)+(x//3+1) put: colorVal.
			prevB := b. prevG := g.  "remember the unbalanced values" ]].
	^answer! !

!FreeTypeSubPixelAntiAliasedGlyphRenderer methodsFor: 'rendering' stamp: 'tween 4/4/2007 18:43'!
subGlyphOf: aCharacter colorValue: aColorValue mono: monoBoolean subpixelPosition: sub font: aFreeTypeFont

	| f |
	monoBoolean
		ifFalse:[
			f := self 
				renderStretchedGlyph: aCharacter 
				depth: 8 
				subpixelPosition: sub 
				font: aFreeTypeFont. 
			f := self filter: f]
		ifTrue:[
			f := self 
				renderGlyph: aCharacter 
				depth: 1 
				subpixelPosition: sub 
				font: aFreeTypeFont.
			f := self fixBytesForMono: f.					
			f := f asFormOfDepth: 32].
	^f! !

!FreeTypeSubPixelAntiAliasedGlyphRenderer methodsFor: 'rendering' stamp: 'nice 1/5/2010 15:59'!
renderStretchedGlyph: aCharacter depth: depth subpixelPosition: sub font: aFreeTypeFont
	"Glyphs are either 1 or 8 bit deep. For 32 bpp we use 8 bits, otherwise 1"
	| em form glyph scaleX charCode slant extraWidth s offsetX offsetY synthBoldStrength boldExtra extraHeight face |

	charCode := aCharacter asUnicode asInteger.
	(aFreeTypeFont face charmaps includes:'unic')
		ifTrue:[
		(aFreeTypeFont isSymbolFont and:[charCode >= 16r20 and: [charCode <= 16rFF ]  ])
			ifTrue:[charCode := charCode + 16rF000]]
		ifFalse:[
			(aFreeTypeFont face charmaps includes:'armn')
				ifTrue:[ "select apple roman char map, and map character from unicode to mac encoding"
					aFreeTypeFont face setCharMap:'armn'.
					charCode := aCharacter unicodeToMacRoman asUnicode asInteger. "check this!!"]].
	aCharacter < $  ifTrue: ["charCode := $  asUnicode asInteger"
		^(GlyphForm extent: 0@0 depth: depth)
			advance: 0@0;
			linearAdvance: 0@0;
			offset:0@0;
			yourself ].
	scaleX := 3.
	em := aFreeTypeFont pixelSize.
	[ | hintingFlags flags |face := aFreeTypeFont face.
	face setPixelWidth: em height: em.
	hintingFlags := FreeTypeSettings current hintingFlags.
	flags :=  LoadNoBitmap bitOr:( LoadIgnoreTransform bitOr: hintingFlags). 
	face loadCharacter:charCode flags: flags. 
	] on: FT2Error do:[:e | 
		^(GlyphForm extent: 0@0 depth: depth)
			advance: 0@0;
			linearAdvance: 0@0;
			offset:0@0;
			yourself]. 
	glyph := face glyph.
	slant := aFreeTypeFont simulatedItalicSlant.
	synthBoldStrength := aFreeTypeFont simulatedBoldStrength.
	synthBoldStrength ~= 0
		ifTrue:[face emboldenOutline: synthBoldStrength].
	boldExtra := 4 * synthBoldStrength abs ceiling.
	face transformOutlineAngle: 0 scalePoint: scaleX@1  slant: slant.
	extraWidth := (glyph height * slant) abs ceiling.
	extraWidth := extraWidth + boldExtra.
	sub > 0 ifTrue:[ extraWidth := extraWidth + 3].
	extraHeight := boldExtra.
	form := GlyphForm 
		extent: ((glyph width + extraWidth "+ 6" + 1 + 2)*scaleX)@(glyph height +extraHeight + 1)  
		depth: depth.
	s := (glyph height-glyph hBearingY)  * slant.
	s := s sign * (s abs ceiling). 
	offsetX := (glyph hBearingX negated + s + (boldExtra // 2) + 1) * scaleX .
	offsetY := glyph height - glyph hBearingY + (boldExtra//2).
	face translateOutlineBy: (offsetX+(sub*scaleX/64))@offsetY.
	face renderGlyphIntoForm: form.
	form offset: ((glyph hBearingX - s - 1 - (boldExtra // 2)) * scaleX)@ (glyph hBearingY + 1 + (boldExtra / 2) ceiling) negated.
	"When not hinting FreeType sets the advance to the truncated linearAdvance.
	The characters appear squashed together. Rounding is probably better, so we fix the advance here"
	aFreeTypeFont subPixelPositioned
		ifTrue:[ form advance: glyph roundedPixelLinearAdvance * (scaleX@1)]
		ifFalse:[ form advance: glyph advance x * scaleX@glyph advance y].
	form linearAdvance: glyph linearAdvance.
	^form! !

!FreeTypeSubPixelAntiAliasedGlyphRenderer class methodsFor: 'class initialization' stamp: 'AlainPlantec 1/5/2010 11:44'!
initialize
	"
	self initialize
	"
	FreeTypeGlyphRenderer current: self new.
! !

!FreeTypeSystemSettings commentStamp: 'TorstenBergmann 2/12/2014 23:27'!
Settings for the FreeType system!
!FreeTypeSystemSettings class methodsFor: 'settings' stamp: 'AlainPlantec 9/17/2011 16:09'!
loadFt2Library
	^ LoadFT2Library ifNil: [LoadFT2Library := false]
! !

!FreeTypeSystemSettings class methodsFor: 'settings' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
ft2LibraryVersion
	^ Smalltalk ui theme 
		newLabelIn: World 
		for: self 
		label: 'Available version: ', FT2Version current libraryVersion asString 
		getEnabled: nil.! !

!FreeTypeSystemSettings class methodsFor: 'settings' stamp: 'CamilloBruni 7/15/2012 18:58'!
loadFt2Library: aBoolean
	(LoadFT2Library = aBoolean) 
		ifTrue: [^ self].
	LoadFT2Library := aBoolean.
	aBoolean 
		ifTrue: [FreeTypeFontProvider current updateFromSystem]
		ifFalse: [StandardFonts restoreDefaultFonts.
			FreeTypeFontProvider unload]
! !

!FreeTypeSystemSettings class methodsFor: 'settings' stamp: 'StephaneDucasse 11/12/2014 14:07'!
freeTypeSettingsOn: aBuilder 
	<systemsettings>
	(aBuilder setting: #noFt2Library)
		target: self;
		icon: Smalltalk ui icons smallConfigurationIcon;
		type: #Label;
		label: 'Free type';
		precondition: [FT2Library current isNil];
		parent: #appearance;
		order: 3;  
		description: 'Free type fonts are not available probably because the FT2 plugin is not installed. Check your VM installation'.
	(aBuilder setting: #loadFt2Library)
		target: self;
		dialog: [self ft2LibraryVersion];
		icon: Smalltalk ui icons smallConfigurationIcon;
		label: 'Use Free type';
		description: 'If checked then allows free type fonts using and update available fonts by scanning the current system';
		precondition: [FT2Library current notNil];
		parent: #appearance; 
		order: 3;  
		with: [
			(aBuilder pickOne: #monitorType) label: 'Monitor type';
				 description: 'LCD is generally better for laptops, CRT for others';
				 target: FreeTypeSettings;
				 targetSelector: #current;
				 order: 0;
				 default: #LCD;
				 domainValues: {#LCD. #CRT}.
			(aBuilder setting: #updateFontsAtImageStartup)
				order: 1;
				target: FreeTypeSettings;
				label: 'Update fonts at startup';
				description: 'If true, then the available font list is recomputed at each startup' .
			(aBuilder group: #advancedSettings) 
				order: 10;
				label: 'Advanced features' ;
				description: 'Some very specific parameters as the hinting or the cache size' ;
				with: [
					(aBuilder range: #cacheSize) 
						target: FreeTypeCache; 
						 targetSelector: #current;
						 label: 'Cache size' ;
						 description: 'The size of the cache in KBytes' ;
						 default: 5000;
						range: (0 to: 50000 by: 10).
					(aBuilder pickOne: #hintingSymbol) label: 'Hinting' ;
						 description: 'Changes the glyph shapes:'  , '
o FULL: glyph shapes features are snapped to pixel boundaries. Glyphs are monochrome, with no anti-aliasing. This option changes the shapes the most.'  , '
o LIGHT: glyph shapes features are partially snapped to pixel boundaries. This option changes the shapes less than with Full, resulting in better shapes, but less contrast.'  , '
o NORMAL: glyph shapes features are snapped to pixel boundaries. Glyphs are anti-aliased.'  , '
o NONE: use the original glyph shapes without snapping their features to pixel boundaries. This gives the best shapes, but with less contrast and more fuzziness.' ;
						 target: FreeTypeSettings;
						 targetSelector: #current;
						 default: #Light;
						 domainValues: {
							'Light' translated->#Light. 
							'Normal' translated ->#Normal. 
							'Full' translated -> #Full. 
							'None' translated -> #None}.
					(aBuilder range: #glyphContrast) target: FreeTypeSettings;
						 targetSelector: #current;
						 label: 'Glyph contrast' ;
						 description: 'Change the contrast level for glyphs. This is an integer between 1 and 100' translated;
						 default: 50;
						range: (0 to: 100 by: 10)]]! !

!FreeTypeSystemSettings class methodsFor: 'settings' stamp: 'MikeMueller 3/5/2013 12:58'!
noFt2Library: aBoolean 

	"ignore it for now"
! !

!FreeTypeSystemSettings class methodsFor: 'settings' stamp: 'AlainPlantec 9/17/2011 15:50'!
noFt2Library
	^ 'Free type fonts are not available'! !

!FuelOutStackDebugAction commentStamp: '<historical>'!
A FuelOutStackDebugAction is	a debugging action that serialize a portion of the current stack trace using fuel.
!
!FuelOutStackDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 10/7/2013 11:47'!
id

	^ #fuelOutStack! !

!FuelOutStackDebugAction methodsFor: 'actions' stamp: 'AndreiChis 10/7/2013 11:51'!
executeAction

	self serializeStack! !

!FuelOutStackDebugAction methodsFor: 'actions' stamp: 'BenComan 3/18/2014 16:58'!
serializeStack
	| date fileName |
	"Serialize a portion of the current stack trace using fuel.."
	date := DateAndTime now.
	
	fileName := String streamContents: [ :s|
		s 
			<< 'Debugger-Stack-';
			<< self interruptedContext receiver class theNonMetaClass name;
			<< '-'.
		date printYMDOn: s.
		s 
			<< '-'; print: date hour24; print: date minute; print: date second;
			<< '.fuel'].

	[ self class
		serializeTestFailureContext: self interruptedContext copyStack		
		toFileNamed: fileName.
		self inform: 'Stack fuelled to file: ' , fileName asFileReference fullName ] 
	on: Error 
	do: [:err| self inform: 'Stack fuelling failed ', String cr, err printString "and simply continue..." ].! !

!FuelOutStackDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 10/7/2013 11:47'!
defaultLabel

	^ 'Fuel out Stack'! !

!FuelOutStackDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 10/7/2013 11:48'!
defaultOrder

	^ 125! !

!FuelOutStackDebugAction class methodsFor: 'private' stamp: 'AndreiChis 10/7/2013 11:59'!
encodeDebugInformationOn: aSerializer
	| str |
	
	str := String new writeStream. 
	str print: Date today; space; print: Time now.
	aSerializer at: #Timestamp putAdditionalObject: str contents. 
	
	str := String new writeStream. 
	str nextPutAll: 'VM: ';
		nextPutAll: Smalltalk os name asString;
		nextPutAll: ' - ';	
		nextPutAll: Smalltalk os subtype asString;
		nextPutAll: ' - ';
		nextPutAll: Smalltalk os version asString;
		nextPutAll: ' - ';
		nextPutAll: Smalltalk vm version asString.
	aSerializer at: #VM putAdditionalObject: str contents. 
		
	str := String new writeStream. 
	str nextPutAll: 'Image: ';
		nextPutAll:  SystemVersion current version asString;
		nextPutAll: ' [';
		nextPutAll: Smalltalk lastUpdateString asString;
		nextPutAll: ']'.
	aSerializer at: #Image putAdditionalObject: str contents.! !

!FuelOutStackDebugAction class methodsFor: 'serialization' stamp: 'AndreiChis 10/7/2013 11:59'!
serializeTestFailureContext: aContext toFileNamed: aFilename
	| serializer |
	
	serializer := FLSerializer newDefault.
	self encodeDebugInformationOn: serializer. 
	serializer addPostMaterializationAction: [ :materialization | 
		Smalltalk tools debugger
			openOn: Processor activeProcess 
			context: materialization root 
			label: 'External stack' 
			contents: nil 
			fullView: false ].
		
	serializer
		" use the sender context, generally the current context is not interesting"
		serialize: aContext
		toFileNamed: aFilename! !

!FuelOutStackDebugAction class methodsFor: 'registration' stamp: 'AndreiChis 10/7/2013 12:05'!
actionType
	<contextMenuDebuggingAction>! !

!FullStackDebugAction commentStamp: '<historical>'!
A FullStackDebugAction displays the entire stack in the stack widget.
!
!FullStackDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/20/2013 15:47'!
id

	^ #fullStack! !

!FullStackDebugAction methodsFor: 'actions' stamp: 'AndreiChis 9/29/2013 16:28'!
executeAction
	
	self debugger stack expandBy: self expandedStackSize
	! !

!FullStackDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/20/2013 16:00'!
enabled

	^ self shouldEnableFullStackButton! !

!FullStackDebugAction methodsFor: 'testing' stamp: 'AndreiChis 9/20/2013 15:59'!
shouldEnableFullStackButton

	self debugger ifNil: [ ^ false ].  
		
	^ self debugger stack listItems 
		ifEmpty: [ false ] 
		ifNotEmpty: [ :aList |
			aList last sender notNil ] ! !

!FullStackDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/20/2013 15:47'!
defaultLabel

	^ 'Full Stack'! !

!FullStackDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/20/2013 15:46'!
defaultOrder

	^ 30! !

!FullStackDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/29/2013 16:28'!
expandedStackSize

	^ 100000! !

!FullStackDebugAction class methodsFor: 'registration' stamp: 'AndreiChis 9/21/2013 22:14'!
actionType
	<debuggingAction>
	<contextMenuDebuggingAction>! !

!FullscreenMorph commentStamp: 'gvc 5/18/2007 13:04'!
Provides for another morph to occupy the full screen area (less docking bars).!
!FullscreenMorph methodsFor: 'accessing' stamp: 'IgorStasenko 12/19/2012 17:58'!
setContentMorph: aMorph
	"Replace the submorphs with aMorph."
	
	self removeAllMorphs.
	self
		addMorph: aMorph
		fullFrame: LayoutFrame identity! !

!FullscreenMorph methodsFor: 'testing' stamp: 'gvc 9/14/2006 16:15'!
isAdheringToTop
	"Must implement. Answer false."
	
	^false! !

!FullscreenMorph methodsFor: 'initialize' stamp: 'gvc 12/3/2007 12:39'!
defaultColor
	"Return the receiver's default color."
	
	^Color white! !

!FullscreenMorph methodsFor: 'testing' stamp: 'gvc 9/14/2006 16:15'!
isAdheringToLeft
	"Must implement. Answer false."
	
	^false! !

!FullscreenMorph methodsFor: 'accessing' stamp: 'gvc 11/30/2006 10:44'!
contentMorph
	"Answer the current content."
	
	^self submorphs first! !

!FullscreenMorph methodsFor: 'testing' stamp: 'gvc 9/14/2006 16:15'!
isAdheringToBottom
	"Must implement. Answer false."
	
	^false! !

!FullscreenMorph methodsFor: 'open/close' stamp: 'GuillermoPolito 5/1/2012 20:06'!
openAsIsIn: aWorld
	"Start stepping."
	
	aWorld addMorph: self.
	(self submorphs notEmpty and: [self submorphs first isSystemWindow])
		ifTrue: [self submorphs first openedFullscreen].
	aWorld startSteppingSubmorphsOf: self.
	
	self announceOpened.! !

!FullscreenMorph methodsFor: 'testing' stamp: 'gvc 9/14/2006 16:11'!
isDockingBar
	"Answer yes so we get updated when the Display is resized."

	^true! !

!FullscreenMorph methodsFor: 'private - layout' stamp: 'gvc 9/14/2006 19:27'!
updateBounds
	"Update the receiver's bounds to fill the world."

	self bounds: self owner clearArea
	! !

!FullscreenMorph methodsFor: 'initialization' stamp: 'gvc 9/19/2006 12:57'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		changeProportionalLayout;
		bounds: World clearArea;
		beSticky! !

!FullscreenMorph methodsFor: 'private - accessing' stamp: 'gvc 9/14/2006 16:21'!
edgeToAdhereTo
	"Must implement. Answer #none."
	
	^#none! !

!FullscreenMorph methodsFor: 'recategorized' stamp: 'MarcusDenker 12/11/2009 07:39'!
layoutChanged
	"Don't pass to owner, since the receiver doesn't care!! Improves frame rate."
	
	fullBounds := nil.
	self layoutPolicy ifNotNil:[:l | l flushLayoutCache].! !

!FullscreenMorph methodsFor: 'initialize' stamp: 'gvc 9/15/2006 09:04'!
openInWorld: aWorld
	"Open as is."
	
	^self openAsIsIn: aWorld! !

!FullscreenMorph methodsFor: 'open/close' stamp: 'gvc 11/30/2006 14:06'!
openAsIs
	"Open in the current world with the current position and extent."
	
	^self openAsIsIn: self currentWorld
! !

!FullscreenMorph methodsFor: 'testing' stamp: 'gvc 9/14/2006 16:15'!
isAdheringToRight
	"Must implement. Answer false."
	
	^false! !

!FuzzyLabelMorph commentStamp: 'gvc 5/18/2007 13:16'!
A label that underdraws to the top-left, top-right, bottom-right and bottom left by a specifed offset in a contrasting colour to the receiver's with a specified alpha value.!
!FuzzyLabelMorph methodsFor: 'initialization' stamp: 'gvc 8/9/2007 12:52'!
initialize
	"Initialize the receiver."

	offset := 1.
	alpha := 0.5.
	super initialize! !

!FuzzyLabelMorph methodsFor: 'accessing' stamp: 'gvc 3/26/2007 16:57'!
alpha
	"Answer the value of alpha"

	^ alpha! !

!FuzzyLabelMorph methodsFor: 'as yet unclassified' stamp: 'gvc 8/9/2007 12:52'!
initWithContents: aString font: aFont emphasis: emphasisCode
	"Grrr, why do they do basicNew?"
	
	offset := 1.
	alpha := 0.5.
	super initWithContents: aString font: aFont emphasis: emphasisCode! !

!FuzzyLabelMorph methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 3/24/2010 17:12'!
drawOn: aCanvas
	"Draw based on enablement."
	
	|pc fuzzColor labelColor|
	pc := self paneColor.
	labelColor := self enabled
		ifTrue: [self color]
		ifFalse: [pc twiceDarker].
	fuzzColor := self enabled
		ifTrue: [labelColor twiceDarker darker contrastingColor alpha: self 
alpha]
		ifFalse: [Color transparent].
	aCanvas depth < 8 ifTrue: [fuzzColor := Color transparent alpha: 0.001].
	fuzzColor isTransparent ifFalse: [
		aCanvas
			drawString: self contents
			in: (self bounds translateBy: 0 @ -1)
			font: self fontToUse
			color: fuzzColor;
			drawString: self contents
			in: (self bounds translateBy: (self offset * 2) @ -1)
			font: self fontToUse
			color: fuzzColor;
			drawString: self contents
			in: (self bounds translateBy: (self offset * 2) @ (self offset 
* 2 - 1))
			font: self fontToUse
			color: fuzzColor;
			drawString: self contents
			in: (self bounds translateBy: 0 @ (self offset * 2 - 1))
			font: self fontToUse
			color: fuzzColor].
	aCanvas
		drawString: self contents
		in: (self bounds translateBy: self offset @ (self offset - 1))
		font: self fontToUse
		color: labelColor! !

!FuzzyLabelMorph methodsFor: 'accessing' stamp: 'gvc 3/16/2007 10:45'!
offset
	"Answer the value of offset"

	^ offset! !

!FuzzyLabelMorph methodsFor: 'accessing' stamp: 'gvc 8/9/2007 13:06'!
offset: anObject
	"Set the value of offset"

	offset := anObject.
	self fitContents! !

!FuzzyLabelMorph methodsFor: 'as yet unclassified' stamp: 'gvc 5/29/2007 17:02'!
measureContents
	"Add 2 times offset."
	
	^super measureContents ceiling + (self offset * 2) asPoint! !

!FuzzyLabelMorph methodsFor: 'as yet unclassified' stamp: 'gvc 5/29/2007 17:22'!
setWidth: width
	"Set the width/extent."
	
	self extent: width @ (self fontToUse height ceiling + (2 * self offset))! !

!FuzzyLabelMorph methodsFor: 'accessing' stamp: 'gvc 8/9/2007 12:51'!
alpha: anObject
	"Set the value of alpha"

	alpha := anObject.
	self changed! !

!GB2312 commentStamp: 'yo 10/19/2004 19:52'!
This class represents the domestic character encoding called GB 2312 used for simplified Chinese.
!
!GB2312 class methodsFor: 'class methods' stamp: 'yo 8/6/2003 05:30'!
isLetter: char

	| value leading |

	leading := char leadingChar.
	value := char charCode.

	leading = 0 ifTrue: [^ super isLetter: char].

	value := value // 94 + 1.
	^ 1 <= value and: [value < 84].
! !

!GB2312 class methodsFor: 'class methods' stamp: 'StephaneDucasse 8/22/2013 14:31'!
initialize
	"
	GB2312 initialize
"
	EncodedCharSet declareEncodedCharSet: self atIndex: 2+1.
	EncodedCharSet declareEncodedCharSet: self atIndex: 8+1.
	compoundTextSequence := String streamContents: 
		[ :stream | 
		stream nextPut: Character escape.
		stream nextPut: $$.
		stream nextPut: $(.
		stream nextPut: $A ]! !

!GB2312 class methodsFor: 'class methods' stamp: 'Alexandre.Bergel 11/20/2008 11:17'!
compoundTextSequence
	^ compoundTextSequence! !

!GB2312 class methodsFor: 'class methods' stamp: 'Alexandre.Bergel 11/20/2008 11:17'!
nextPutValue: ascii toStream: aStream withShiftSequenceIfNeededForTextConverterState: state 
	| c1 c2 |
	state charSize: 2.
	state g0Leading ~= self leadingChar ifTrue: 
		[ state g0Leading: self leadingChar.
		state g0Size: 2.
		aStream basicNextPutAll: compoundTextSequence ].
	c1 := ascii // 94 + 33.
	c2 := ascii \\ 94 + 33.
	^ aStream
		basicNextPut: (Character value: c1);
		basicNextPut: (Character value: c2)! !

!GB2312 class methodsFor: 'class methods' stamp: 'yo 10/22/2002 19:51'!
leadingChar

	^ 2.
! !

!GB2312 class methodsFor: 'class methods' stamp: 'yo 10/14/2003 10:19'!
ucsTable

	^ UCSTable gb2312Table.
! !

!GIFReadWriter commentStamp: '<historical>'!
Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved.

Used with permission.  Modified for use in Squeak.!
!GIFReadWriter methodsFor: 'private-decoding' stamp: 'lr 7/4/2009 10:42'!
readColorTable: numberOfEntries 
	| array r g b |
	array := Array new: numberOfEntries.
	1 
		to: array size
		do: 
			[ :i | 
			r := self next.
			g := self next.
			b := self next.
			array 
				at: i
				put: (Color 
						r: r
						g: g
						b: b
						range: 255) ].
	^ array! !

!GIFReadWriter methodsFor: 'private-bits access' stamp: 'lr 7/4/2009 10:42'!
nextBits
	| integer readBitCount shiftCount byte |
	integer := 0.
	remainBitCount = 0 
		ifTrue: 
			[ readBitCount := 8.
			shiftCount := 0 ]
		ifFalse: 
			[ readBitCount := remainBitCount.
			shiftCount := remainBitCount - 8 ].
	[ readBitCount < codeSize ] whileTrue: 
		[ byte := self nextByte.
		byte == nil ifTrue: [ ^ eoiCode ].
		integer := integer + (byte bitShift: shiftCount).
		shiftCount := shiftCount + 8.
		readBitCount := readBitCount + 8 ].
	(remainBitCount := readBitCount - codeSize) = 0 
		ifTrue: [ byte := self nextByte ]
		ifFalse: [ byte := self peekByte ].
	byte == nil ifTrue: [ ^ eoiCode ].
	^ integer + (byte bitShift: shiftCount) bitAnd: maxCode! !

!GIFReadWriter methodsFor: 'stream access' stamp: 'bf 5/29/2003 01:23'!
close
	"Write terminator"
	self nextPut: Terminator.
	^super close! !

!GIFReadWriter methodsFor: 'private-packing' stamp: ''!
nextBytePut: aByte
	bufStream nextPut: aByte.
	bufStream size >= 254 ifTrue: [self flushBuffer]! !

!GIFReadWriter methodsFor: 'private' stamp: 'lr 7/4/2009 10:42'!
checkCodeSize
	(freeCode > maxCode and: [ codeSize < 12 ]) ifTrue: 
		[ codeSize := codeSize + 1.
		maxCode := (1 bitShift: codeSize) - 1 ]! !

!GIFReadWriter methodsFor: 'private-encoding' stamp: 'lr 7/4/2009 10:42'!
readPixelFrom: bits 
	"Since bits is a Bitmap with 32 bit values, watch out for the
padding at the end of each row.  But, GIF format already wants padding to
32 bit boundary!!  OK as is.  tk 9/14/97"
	| pixel |
	ypos >= height ifTrue: [ ^ nil ].
	pixel := bits byteAt: ypos * rowByteSize + xpos + 1.
	self updatePixelPosition.
	^ pixel! !

!GIFReadWriter methodsFor: 'private-encoding' stamp: ''!
writeWord: aWord
	self nextPut: (aWord bitAnd: 255).
	self nextPut: ((aWord bitShift: -8) bitAnd: 255).
	^aWord! !

!GIFReadWriter methodsFor: 'private-decoding' stamp: ''!
readWord
	^self next + (self next bitShift: 8)! !

!GIFReadWriter methodsFor: 'private-packing' stamp: ''!
peekByte
	bufStream atEnd
		ifTrue:
			[self atEnd ifTrue: [^nil].
			self fillBuffer].
	^bufStream peek! !

!GIFReadWriter methodsFor: 'private-decoding' stamp: 'CamilloBruni 8/1/2012 16:14'!
readBitData
	"using modified Lempel-Ziv Welch algorithm."
	| outCodes outCount bitMask initCodeSize code curCode oldCode inCode finChar i bytes f c packedBits hasLocalColor localColorSize maxOutCodes |
	maxOutCodes := 4096.
	offset := self readWord @ self readWord.	"Image Left@Image Top"
	width := self readWord.
	height := self readWord.

	"---
	Local Color Table Flag        1 Bit
	Interlace Flag                1 Bit
	Sort Flag                     1 Bit
	Reserved                      2 Bits
	Size of Local Color Table     3 Bits
	----"
	packedBits := self next.
	interlace := (packedBits bitAnd: 64) ~= 0.
	hasLocalColor := (packedBits bitAnd: 128) ~= 0.
	localColorSize := 1 bitShift: (packedBits bitAnd: 7) + 1.
	hasLocalColor ifTrue: [ localColorTable := self readColorTable: localColorSize ].
	pass := 0.
	xpos := 0.
	ypos := 0.
	rowByteSize := (width + 3) // 4 * 4.
	remainBitCount := 0.
	bufByte := 0.
	bufStream := ByteArray new readStream.
	outCodes := ByteArray new: maxOutCodes + 1.
	outCount := 0.
	prefixTable := Array new: 4096.
	suffixTable := Array new: 4096.
	initCodeSize := self next.
	bitMask := (1 bitShift: initCodeSize) - 1.
	self setParameters: initCodeSize.
	bitsPerPixel > 8 ifTrue: [ ^ self error: 'never heard of a GIF that deep' ].
	bytes := ByteArray new: rowByteSize * height.
	[ (code := self readCode) = eoiCode ] whileFalse: 
		[ code = clearCode 
			ifTrue: 
				[ self setParameters: initCodeSize.
				curCode := oldCode := code := self readCode.
				finChar := curCode bitAnd: bitMask.
				"Horrible hack to avoid running off the end of the bitmap.  Seems to cure problem reading some gifs!!?"
				xpos = 0 
					ifTrue: 
						[ ypos < height ifTrue: 
							[ bytes 
								at: ypos * rowByteSize + xpos + 1
								put: finChar ] ]
					ifFalse: 
						[ bytes 
							at: ypos * rowByteSize + xpos + 1
							put: finChar ].
				self updatePixelPosition ]
			ifFalse: 
				[ curCode := inCode := code.
				curCode >= freeCode ifTrue: 
					[ curCode := oldCode.
					outCodes 
						at: (outCount := outCount + 1)
						put: finChar ].
				[ curCode > bitMask ] whileTrue: 
					[ outCount > maxOutCodes ifTrue: [ ^ self error: 'corrupt GIF file (OutCount)' ].
					outCodes 
						at: (outCount := outCount + 1)
						put: (suffixTable at: curCode + 1).
					curCode := prefixTable at: curCode + 1 ].
				finChar := curCode bitAnd: bitMask.
				outCodes 
					at: (outCount := outCount + 1)
					put: finChar.
				i := outCount.
				[ i > 0 ] whileTrue: 
					[ "self writePixel: (outCodes at: i) to: bits"
					bytes 
						at: ypos * rowByteSize + xpos + 1
						put: (outCodes at: i).
					self updatePixelPosition.
					i := i - 1 ].
				outCount := 0.
				prefixTable 
					at: freeCode + 1
					put: oldCode.
				suffixTable 
					at: freeCode + 1
					put: finChar.
				oldCode := inCode.
				freeCode := freeCode + 1.
				self checkCodeSize ] ].
	prefixTable := suffixTable := nil.
	f := ColorForm 
		extent: width @ height
		depth: 8.
	f bits copyFromByteArray: bytes.
	"Squeak can handle depths 1, 2, 4, and 8"
	bitsPerPixel > 4 ifTrue: [ ^ f ].
	"reduce depth to save space"
	c := ColorForm 
		extent: width @ height
		depth: (bitsPerPixel = 3 
				ifTrue: [ 4 ]
				ifFalse: [ bitsPerPixel ]).
	f displayOn: c.
	^ c! !

!GIFReadWriter methodsFor: 'private-encoding' stamp: 'PeterHugossonMiller 9/3/2009 01:35'!
writeBitData: bits 
	"using modified Lempel-Ziv Welch algorithm."
	| maxBits maxMaxCode tSize initCodeSize ent tShift fCode pixel index disp nomatch |
	pass := 0.
	xpos := 0.
	ypos := 0.
	rowByteSize := (width * 8 + 31) // 32 * 4.
	remainBitCount := 0.
	bufByte := 0.
	bufStream := (ByteArray new: 256) writeStream.
	maxBits := 12.
	maxMaxCode := 1 bitShift: maxBits.
	tSize := 5003.
	prefixTable := Array new: tSize.
	suffixTable := Array new: tSize.
	initCodeSize := bitsPerPixel <= 1 
		ifTrue: [ 2 ]
		ifFalse: [ bitsPerPixel ].
	self nextPut: initCodeSize.
	self setParameters: initCodeSize.
	tShift := 0.
	fCode := tSize.
	[ fCode < 65536 ] whileTrue: 
		[ tShift := tShift + 1.
		fCode := fCode * 2 ].
	tShift := 8 - tShift.
	1 
		to: tSize
		do: 
			[ :i | 
			suffixTable 
				at: i
				put: -1 ].
	self writeCodeAndCheckCodeSize: clearCode.
	ent := self readPixelFrom: bits.
	[ (pixel := self readPixelFrom: bits) == nil ] whileFalse: 
		[ fCode := (pixel bitShift: maxBits) + ent.
		index := ((pixel bitShift: tShift) bitXor: ent) + 1.
		(suffixTable at: index) = fCode 
			ifTrue: [ ent := prefixTable at: index ]
			ifFalse: 
				[ nomatch := true.
				(suffixTable at: index) >= 0 ifTrue: 
					[ disp := tSize - index + 1.
					index = 1 ifTrue: [ disp := 1 ].
					"probe"
					
					[ (index := index - disp) < 1 ifTrue: [ index := index + tSize ].
					(suffixTable at: index) = fCode ifTrue: 
						[ ent := prefixTable at: index.
						nomatch := false
						"continue whileFalse:" ].
					nomatch and: [ (suffixTable at: index) > 0 ] ] whileTrue: 
						[ "probe"
						 ] ].
				"nomatch"
				nomatch ifTrue: 
					[ self writeCodeAndCheckCodeSize: ent.
					ent := pixel.
					freeCode < maxMaxCode 
						ifTrue: 
							[ prefixTable 
								at: index
								put: freeCode.
							suffixTable 
								at: index
								put: fCode.
							freeCode := freeCode + 1 ]
						ifFalse: 
							[ self writeCodeAndCheckCodeSize: clearCode.
							1 
								to: tSize
								do: 
									[ :i | 
									suffixTable 
										at: i
										put: -1 ].
							self setParameters: initCodeSize ] ] ] ].
	prefixTable := suffixTable := nil.
	self writeCodeAndCheckCodeSize: ent.
	self writeCodeAndCheckCodeSize: eoiCode.
	self flushCode.
	self nextPut: 0	"zero-length packet"! !

!GIFReadWriter methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
nextImage
	"Read in the next GIF image from the stream. Read it all into
memory first for speed."
	| f thisImageColorTable |
	stream class == ReadWriteStream ifFalse: 
		[ stream binary.
		self on: (ReadWriteStream with: stream contentsOfEntireFile) ].
	localColorTable := nil.
	self readHeader.
	f := self readBody.
	self close.
	f == nil ifTrue: [ ^ self error: 'corrupt GIF file' ].
	thisImageColorTable := localColorTable ifNil: [ colorPalette ].
	transparentIndex ifNotNil: 
		[ transparentIndex + 1 > thisImageColorTable size ifTrue: 
			[ thisImageColorTable := thisImageColorTable 
				forceTo: transparentIndex + 1
				paddingWith: Color white ].
		thisImageColorTable 
			at: transparentIndex + 1
			put: Color transparent ].
	f colors: thisImageColorTable.
	^ f! !

!GIFReadWriter methodsFor: 'private-decoding' stamp: 'lr 7/4/2009 10:42'!
skipBitData
	| misc blocksize |
	self readWord.	"skip Image Left"
	self readWord.	"skip Image Top"
	self readWord.	"width"
	self readWord.	"height"
	misc := self next.
	(misc bitAnd: 128) = 0 ifFalse: 
		[ "skip colormap"
		1 
			to: (1 bitShift: (misc bitAnd: 7) + 1)
			do: 
				[ :i | 
				self
					next;
					next;
					next ] ].
	self next.	"minimum code size"
	[ (blocksize := self next) > 0 ] whileTrue: [ self next: blocksize ]! !

!GIFReadWriter methodsFor: 'private-packing' stamp: 'damiencassou 5/30/2008 14:51'!
fillBuffer
	| packSize |
	packSize := self next.
	bufStream := (self next: packSize) readStream! !

!GIFReadWriter methodsFor: 'accessing' stamp: 'bf 5/29/2003 01:43'!
delay: aNumberOrNil
	"Set delay for next image in hundredth (1/100) of seconds"
	delay := aNumberOrNil! !

!GIFReadWriter methodsFor: 'private-encoding' stamp: ''!
flushCode
	self flushBits! !

!GIFReadWriter methodsFor: 'private-encoding' stamp: 'ClementBera 7/26/2013 16:44'!
writeHeader
	| byte |
	stream position = 0 ifTrue: 
		[ "For first image only"
		self nextPutAll: 'GIF89a' asByteArray.
		self writeWord: width.	"Screen Width"
		self writeWord: height.	"Screen Height"
		byte := 128.	"has color map"
		byte := byte bitOr: (bitsPerPixel - 1 bitShift: 5).	"color resolution"
		byte := byte bitOr: bitsPerPixel - 1.	"bits per pixel"
		self nextPut: byte.
		self nextPut: 0.	"background color."
		self nextPut: 0.	"reserved"
		colorPalette do: 
			[ :pixelValue | 
			self
				nextPut: ((pixelValue bitShift: -16) bitAnd: 255);
				nextPut: ((pixelValue bitShift: -8) bitAnd: 255);
				nextPut: (pixelValue bitAnd: 255) ].
		loopCount notNil ifTrue: 
			[ "Write a Netscape loop chunk"
			self nextPut: Extension.
			self nextPutAll: #(
					255
					11
					78
					69
					84
					83
					67
					65
					80
					69
					50
					46
					48
					3
					1
				) asByteArray.
			self writeWord: loopCount.
			self nextPut: 0 ] ].
	delay notNil | transparentIndex notNil ifTrue: 
		[ self
			nextPut: Extension;
			nextPutAll: #(249 4 ) asByteArray;
			nextPut: (transparentIndex 
					ifNil: [ 0 ]
					ifNotNil: [ 9 ]);
			writeWord: (delay ifNil: [ 0 ]);
			nextPut: (transparentIndex ifNil: [ 0 ]);
			nextPut: 0 ].
	self nextPut: ImageSeparator.
	self writeWord: 0.	"Image Left"
	self writeWord: 0.	"Image Top"
	self writeWord: width.	"Image Width"
	self writeWord: height.	"Image Height"
	byte := interlace 
		ifTrue: [ 64 ]
		ifFalse: [ 0 ].
	self nextPut: byte! !

!GIFReadWriter methodsFor: 'private-bits access' stamp: 'lr 7/4/2009 10:42'!
nextBitsPut: anInteger 
	| integer writeBitCount shiftCount |
	shiftCount := 0.
	remainBitCount = 0 
		ifTrue: 
			[ writeBitCount := 8.
			integer := anInteger ]
		ifFalse: 
			[ writeBitCount := remainBitCount.
			integer := bufByte + (anInteger bitShift: 8 - remainBitCount) ].
	[ writeBitCount < codeSize ] whileTrue: 
		[ self nextBytePut: ((integer bitShift: shiftCount) bitAnd: 255).
		shiftCount := shiftCount - 8.
		writeBitCount := writeBitCount + 8 ].
	(remainBitCount := writeBitCount - codeSize) = 0 
		ifTrue: [ self nextBytePut: (integer bitShift: shiftCount) ]
		ifFalse: [ bufByte := integer bitShift: shiftCount ].
	^ anInteger! !

!GIFReadWriter methodsFor: 'private-bits access' stamp: 'lr 7/4/2009 10:42'!
flushBits
	remainBitCount = 0 ifFalse: 
		[ self nextBytePut: bufByte.
		remainBitCount := 0 ].
	self flushBuffer! !

!GIFReadWriter methodsFor: 'private' stamp: 'lr 7/4/2009 10:42'!
setParameters: initCodeSize 
	clearCode := 1 bitShift: initCodeSize.
	eoiCode := clearCode + 1.
	freeCode := clearCode + 2.
	codeSize := initCodeSize + 1.
	maxCode := (1 bitShift: codeSize) - 1! !

!GIFReadWriter methodsFor: 'accessing' stamp: 'ar 10/24/2005 22:52'!
nextPutImage: aForm

	| reduced tempForm |
	aForm unhibernate.
	aForm depth > 8 ifTrue:[
		reduced := aForm colorReduced.  "minimize depth"
		reduced depth > 8 ifTrue: [
			"Not enough color space; do it the hard way."
			reduced := reduced asFormOfDepth: 8].
	] ifFalse:[reduced := aForm].
	reduced depth < 8 ifTrue: [
		"writeBitData: expects depth of 8"
		tempForm := reduced class extent: reduced extent depth: 8.
		(reduced isColorForm) ifTrue:[
			tempForm
				copyBits: reduced boundingBox
				from: reduced at: 0@0
				clippingBox: reduced boundingBox
				rule: Form over
				fillColor: nil
				map: nil.
			tempForm colors: reduced colors.
		] ifFalse: [reduced displayOn: tempForm].
		reduced := tempForm.
	].
	(reduced isColorForm) ifTrue:[
		(reduced colorsUsed includes: Color transparent) ifTrue: [
			transparentIndex := (reduced colors indexOf: Color transparent) - 1.
		]
	] ifFalse: [transparentIndex := nil].
	width := reduced width.
	height := reduced height.
	bitsPerPixel := reduced depth.
	colorPalette := reduced colormapIfNeededForDepth: 32.
	interlace := false.
	self writeHeader.
	self writeBitData: reduced bits.
! !

!GIFReadWriter methodsFor: 'private-encoding' stamp: ''!
writeCode: aCode
	self nextBitsPut: aCode! !

!GIFReadWriter methodsFor: 'private' stamp: 'lr 7/4/2009 10:42'!
updatePixelPosition
	(xpos := xpos + 1) >= width ifFalse: [ ^ self ].
	xpos := 0.
	interlace ifFalse: 
		[ ypos := ypos + 1.
		^ self ].
	pass = 0 ifTrue: 
		[ (ypos := ypos + 8) >= height ifTrue: 
			[ pass := pass + 1.
			ypos := 4 ].
		^ self ].
	pass = 1 ifTrue: 
		[ (ypos := ypos + 8) >= height ifTrue: 
			[ pass := pass + 1.
			ypos := 2 ].
		^ self ].
	pass = 2 ifTrue: 
		[ (ypos := ypos + 4) >= height ifTrue: 
			[ pass := pass + 1.
			ypos := 1 ].
		^ self ].
	pass = 3 ifTrue: 
		[ ypos := ypos + 2.
		^ self ].
	^ self error: 'can''t happen'! !

!GIFReadWriter methodsFor: 'private-packing' stamp: 'PeterHugossonMiller 9/3/2009 01:34'!
flushBuffer
	bufStream isEmpty ifTrue: [ ^ self ].
	self nextPut: bufStream size.
	self nextPutAll: bufStream contents.
	bufStream := (ByteArray new: 256) writeStream.! !

!GIFReadWriter methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
setStream: aStream 
	"Feed it in from an existing source"
	stream := aStream! !

!GIFReadWriter methodsFor: 'private-decoding' stamp: 'lr 7/4/2009 10:42'!
readHeader
	| is89 byte hasColorMap |
	(self hasMagicNumber: 'GIF87a' asByteArray) 
		ifTrue: [ is89 := false ]
		ifFalse: 
			[ (self hasMagicNumber: 'GIF89a' asByteArray) 
				ifTrue: [ is89 := true ]
				ifFalse: [ ^ self error: 'This does not appear to be a GIF file' ] ].
	self readWord.	"skip Screen Width"
	self readWord.	"skip Screen Height"
	byte := self next.
	hasColorMap := (byte bitAnd: 128) ~= 0.
	bitsPerPixel := (byte bitAnd: 7) + 1.
	byte := self next.	"skip background color."
	self next ~= 0 ifTrue: 
		[ is89 ifFalse: [ ^ self error: 'corrupt GIF file (screen descriptor)' ] ].
	hasColorMap 
		ifTrue: [ colorPalette := self readColorTable: (1 bitShift: bitsPerPixel) ]
		ifFalse: 
			[ "Transcript cr; show: 'GIF file does not have a color map.'."
			colorPalette := nil	"Palette monochromeDefault" ]! !

!GIFReadWriter methodsFor: 'accessing' stamp: 'bf 5/29/2003 01:39'!
loopCount: aNumber
	"Set looping. This must be done before any image is written!!"
	loopCount := aNumber! !

!GIFReadWriter methodsFor: 'private-encoding' stamp: ''!
writeCodeAndCheckCodeSize: aCode
	self writeCode: aCode.
	self checkCodeSize! !

!GIFReadWriter methodsFor: 'private-decoding' stamp: 'ClementBera 7/26/2013 16:43'!
readBody
	"Read the GIF blocks. Modified to return a form.  "
	| form extype block blocksize packedFields delay1 |
	form := nil.
	[ stream atEnd ] whileFalse: 
		[ block := self next.
		block = Terminator ifTrue: [ ^ form ].
		block = ImageSeparator 
			ifTrue: 
				[ form
					ifNil: [ form := self readBitData ]
					ifNotNil: [ self skipBitData ] ]
			ifFalse: 
				[ block = Extension ifFalse: [ ^ form	"^ self error: 'Unknown block type'" ].
				"Extension block"
				extype := self next.	"extension type"
				extype = 249 
					ifTrue: 
						[ "graphics control"
						self next = 4 ifFalse: [ ^ form	"^ self error: 'corrupt GIF file'" ].
						"====
				Reserved                      3 Bits
				Disposal Method               3 Bits
				User Input Flag               1 Bit
				Transparent Color Flag        1 Bit
				==="
						packedFields := self next.
						delay1 := self next.	"delay time 1"
						delay := (self next * 256 + delay1) * 10.	"delay time 2"
						transparentIndex := self next.
						(packedFields bitAnd: 1) = 0 ifTrue: [ transparentIndex := nil ].
						self next = 0 ifFalse: [ ^ form	"^ self error: 'corrupt GIF file'" ] ]
					ifFalse: 
						[ "Skip blocks"
						[ (blocksize := self next) > 0 ] whileTrue: 
							[ "Read the block and ignore it and eat the block terminator"
							self next: blocksize ] ] ] ]! !

!GIFReadWriter methodsFor: 'private-packing' stamp: ''!
nextByte
	bufStream atEnd
		ifTrue:
			[self atEnd ifTrue: [^nil].
			self fillBuffer].
	^bufStream next! !

!GIFReadWriter methodsFor: 'private-decoding' stamp: ''!
readCode
	^self nextBits! !

!GIFReadWriter methodsFor: 'accessing' stamp: 'di 9/15/1998 09:53'!
understandsImageFormat
	^('abc' collect: [:x | stream next asCharacter]) = 'GIF'! !

!GIFReadWriter class methodsFor: 'examples' stamp: 'AlejandroInfante 11/11/2013 15:06'!
grabScreenAndSaveOnDisk
	"GIFReadWriter grabScreenAndSaveOnDisk"
	| form fileName |
	
	form := Form fromUser.
	form bits size = 0 ifTrue: [ ^ self inform: 'Empty region selected.' ].
	
	fileName := (FileSystem disk workingDirectory / 'Pharo', 'gif') fullName.
		
	UIManager default 
		informUser: 'Writing ' translated, fileName
		during: 
			[ GIFReadWriter 
				putForm: form
				onFileNamed: fileName ]! !

!GIFReadWriter class methodsFor: 'initialization' stamp: 'lr 7/4/2009 10:42'!
initialize
	"GIFReadWriter initialize"
	ImageSeparator := $, asInteger.
	Extension := $!! asInteger.
	Terminator := $; asInteger! !

!GIFReadWriter class methodsFor: 'image reading/writing' stamp: 'asm 12/11/2003 21:29'!
wantsToHandleGIFs
	^ false! !

!GIFReadWriter class methodsFor: 'examples' stamp: 'bf 5/29/2003 01:56'!
exampleAnim
	"GIFReadWriter exampleAnim"

	| writer extent center |
	writer := GIFReadWriter on: (FileStream newFileNamed: 'anim.gif').
	writer loopCount: 20.		"Repeat 20 times"
	writer delay: 10.		"Wait 10/100 seconds"
	extent := 42@42.
	center := extent / 2.
	Cursor write showWhile: [
		[2 to: center x - 1 by: 2 do: [:r |
			"Make a fancy anim without using Canvas - inefficient as hell"
			| image |
			image := ColorForm extent: extent depth: 8.
			0.0 to: 359.0 do: [:theta | image colorAt: (center + (Point r: r degrees: theta)) rounded put: Color red].
			writer nextPutImage: image]
		]	ensure: [writer close]].! !

!GIFReadWriter class methodsFor: 'image reading/writing' stamp: 'GabrielOmarCotelli 12/3/2013 17:22'!
typicalFileExtensions
	"Answer a collection of file extensions (lowercase) which files that I can 
	read might commonly have"

	^ self allSubclasses
		detect: [ :cls | cls wantsToHandleGIFs ]
		ifFound: [ #() ]
		ifNone: [ 
			"if none of my subclasses wants , then i''ll have to do"
			#('gif') ]! !

!GLMAbstractWizardStep commentStamp: 'TorstenBergmann 3/10/2015 22:00'!
Abstract step in a wizard

Instance Variables
	input:		<Object>
	name:		<Object>
	numberOfDisplay:		<Object>
	presentationBlock:		<Object>
	previousStep:		<Object>

input
	- xxxxx

name
	- xxxxx

numberOfDisplay
	- xxxxx

presentationBlock
	- xxxxx

previousStep
	- xxxxx
!
!GLMAbstractWizardStep methodsFor: 'accessing' stamp: 'cyrilledelaunay 4/4/2011 12:03'!
size

	^ self subclassResponsibility ! !

!GLMAbstractWizardStep methodsFor: 'testing' stamp: 'cyrilledelaunay 4/4/2011 17:10'!
atEnd

	^ self size = self numberOfDisplay ! !

!GLMAbstractWizardStep methodsFor: 'accessing' stamp: 'cyrilledelaunay 4/4/2011 13:43'!
decrementNumberOfDisplay 

	self numberOfDisplay: self numberOfDisplay - 1! !

!GLMAbstractWizardStep methodsFor: 'scripting' stamp: 'cyrilledelaunay 4/4/2011 13:17'!
from: aSymbol

	self previousStep: aSymbol  ! !

!GLMAbstractWizardStep methodsFor: 'accessing' stamp: 'cyrilledelaunay 4/4/2011 13:07'!
numberOfDisplay
	
	^ numberOfDisplay ifNil: [numberOfDisplay := 0]! !

!GLMAbstractWizardStep methodsFor: 'accessing' stamp: 'cyrilledelaunay 4/4/2011 13:06'!
numberOfDisplay: aNumber
	
	numberOfDisplay := aNumber! !

!GLMAbstractWizardStep methodsFor: 'accessing' stamp: 'cyrilledelaunay 4/4/2011 13:43'!
incrementNumberOfDisplay

	self numberOfDisplay: self numberOfDisplay + 1! !

!GLMAbstractWizardStep methodsFor: 'testing' stamp: 'cyrilledelaunay 5/24/2011 17:12'!
overEnd

	^ self size < self numberOfDisplay ! !

!GLMAbstractWizardStep methodsFor: 'accessing' stamp: 'cyrilledelaunay 4/4/2011 12:02'!
presentationBlock

	^ presentationBlock ! !

!GLMAbstractWizardStep methodsFor: 'testing' stamp: 'cyrilledelaunay 4/4/2011 13:57'!
atBeginning 

	^ self numberOfDisplay = 1! !

!GLMAbstractWizardStep methodsFor: 'accessing' stamp: 'cyrilledelaunay 4/4/2011 12:02'!
name: aSymbolOrABlock

	name := aSymbolOrABlock! !

!GLMAbstractWizardStep methodsFor: 'accessing' stamp: 'cyrilledelaunay 4/12/2011 12:03'!
previousStep: aSymbol

	self previousStep add: aSymbol! !

!GLMAbstractWizardStep methodsFor: 'accessing' stamp: 'cyrilledelaunay 4/4/2011 12:02'!
presentationBlock: aBlock

	presentationBlock :=  aBlock! !

!GLMAbstractWizardStep methodsFor: 'accessing' stamp: 'cyrilledelaunay 4/4/2011 14:01'!
input: anObject

	input := anObject! !

!GLMAbstractWizardStep methodsFor: 'scripting' stamp: 'cyrilledelaunay 4/4/2011 13:16'!
show: aBlock

	self presentationBlock: aBlock  ! !

!GLMAbstractWizardStep methodsFor: 'accessing' stamp: 'cyrilledelaunay 4/4/2011 13:07'!
name

	^ name ifNil: [name := '']! !

!GLMAbstractWizardStep methodsFor: 'testing' stamp: 'cyrilledelaunay 5/25/2011 10:29'!
overBeginning 

	^ self numberOfDisplay < 1! !

!GLMAbstractWizardStep methodsFor: 'accessing' stamp: 'cyrilledelaunay 4/4/2011 14:00'!
input

	^ input ! !

!GLMAbstractWizardStep methodsFor: 'accessing' stamp: 'cyrilledelaunay 4/12/2011 12:02'!
previousStep

	^ previousStep ifNil: [previousStep := OrderedCollection new]! !

!GLMAccordionArrangement methodsFor: 'rendering' stamp: 'tg 1/6/2010 23:23'!
renderGlamorouslyOn: aRenderer
	^ aRenderer renderAccordionCompositePresentation: self composite! !

!GLMAccumulator commentStamp: 'TudorGirba 4/21/2011 21:20'!
An GLMAccumulator is an implicit type of browser that has the following behavior:
- each input entity has associated a pane without any relationship with the other panes
- based on the input entity if there already exists a pane associated, it is selected via GLMPaneSelected
- if there isnt a pane, a new pane is created
- based on entityToSelect, the associated pane is searched and potentially selected
- when a pane is selected in the user interface, the activeEntity is populated with the entity behind the selected pane

Input ports:
- entity
- entityToSelect

Output ports:
- activeEntity!
!GLMAccumulator methodsFor: 'accessing ports' stamp: 'tg 1/19/2010 21:24'!
entityToSelect: anObject
	^ (self pane port: #entityToSelect) value: anObject ! !

!GLMAccumulator methodsFor: 'rendering' stamp: 'tg 1/18/2010 08:36'!
renderGlamorouslyOn: aRenderer
	^ aRenderer renderAccumulator: self! !

!GLMAccumulator methodsFor: 'accessing ports' stamp: 'tg 2/2/2010 22:00'!
entityToSelect
	^ (self pane port: #entityToSelect) value! !

!GLMAccumulator methodsFor: 'private' stamp: 'tg 1/19/2010 21:50'!
tryToSelectPaneFrom: aPort
	self panes withIndexDo: [:each :i | 
		(each port: #entity) value = aPort value ifTrue: [
			self announce: 
				(GLMPaneSelected 
					pane: each 
					atPosition: i
					inBrowser: self).
			^ true ] ].
	^ false! !

!GLMAccumulator methodsFor: 'events' stamp: 'tg 1/18/2010 07:47'!
innerPortEvent: aPortEvent 
	aPortEvent portName = #entity ifFalse: [
		"We don't want to resend the transmission, but use a new SimpleTransmission." 
		(self pane port: aPortEvent portName) value: aPortEvent value]! !

!GLMAccumulator methodsFor: 'events' stamp: 'cyrilledelaunay 3/29/2011 10:04'!
outerPortEvent: aPortEvent 
 	super outerPortEvent: aPortEvent.
	aPortEvent port name = #entityToSelect ifTrue: [
		self tryToSelectPaneFrom: aPortEvent port ].	
	aPortEvent port name = #entity ifTrue: [
		self addPaneFrom: aPortEvent port ]! !

!GLMAccumulator methodsFor: 'accessing ports' stamp: 'tg 2/2/2010 21:31'!
activeEntity: anObject
	^ (self pane port: #activeEntity) value: anObject ! !

!GLMAccumulator methodsFor: 'accessing ports' stamp: 'tg 2/2/2010 22:03'!
activeEntity
	^ (self pane port: #activeEntity) value! !

!GLMAccumulator methodsFor: 'private' stamp: 'tg 1/31/2010 01:13'!
removePaneIndex: i
	| paneRemoved |
	paneRemoved := self panes removeAt: i.
	paneRemoved unregisterFromAllAnnouncements.
	self announce: (GLMPaneRemoved pane: paneRemoved fromBrowser: self )! !

!GLMAccumulator methodsFor: 'private' stamp: 'AndreiChis 5/30/2013 21:49'!
addPaneFrom: aPort 
	aPort value isNil ifTrue: [ ^ self ].
	(self tryToSelectPaneFrom: aPort) ifTrue: [ ^ self ].
	self panes addLast: (GLMPane named: (self panes size + 1) asString in: self).
	self newTransmission
		addActiveOrigin: aPort; 
		destination: (self panes last port: #entity); 
		transmit.
	self announce: 
			(GLMPaneAdded 
				pane: self panes last 
				atPosition: self panes size 
				inBrowser: self)! !

!GLMAccumulatorMorphicTest methodsFor: 'tests' stamp: ''!
testCloseTab
	| browser |
	browser := GLMAccumulator new.
	browser
		show: [ :a | 
			a title: [ :x | x asString ].
			a list display: [ :x | $a to: x ] ].
	window := browser openOn: $d.
	browser entity: $c.
	self assert: browser panes size equals: 2.
	self assert: self tabGroup pageMorphs size equals: 2.
	self tabGroup removePageIndex: 1.
	self assert: self tabGroup pageMorphs size equals: 1.
	self assert: browser panes size equals: 1! !

!GLMAccumulatorMorphicTest methodsFor: 'private' stamp: ''!
tabGroup
	^ self find: TabGroupMorph in: window! !

!GLMAccumulatorMorphicTest methodsFor: 'tests' stamp: ''!
testListInside
	| browser firstTreeMorph |
	browser := GLMAccumulator new.
	browser show: [ :a | a list display: [ :x | $a to: x ] ].
	window := browser openOn: $d.
	firstTreeMorph := self find: MorphTreeMorph  in: (self tabGroup pageAt: 1).
	self assert: ((firstTreeMorph roots collect: #complexContents) collect: #item) equals: ($a to: $d) asArray! !

!GLMAccumulatorMorphicTest methodsFor: 'tests' stamp: ''!
testActiveEntity
	| browser |
	browser := GLMAccumulator new.
	browser show: [ :a | a list display: [ :x | $a to: x ] ].
	browser entity: $d.
	browser entity: $e.
	window := browser openOn: $d.
	browser entity: $c.
	self tabGroup selectedPageIndex: 1.
	self tabGroup update: #selectedIndex.
	self assert: browser activeEntity equals: $d! !

!GLMAccumulatorMorphicTest methodsFor: 'tests' stamp: ''!
testSelectedTab
	| browser |
	browser := GLMAccumulator new.
	browser
		show: [ :a | 
			a title: [ :x | x asString ].
			a list display: [ :x | $a to: x ] ].
	window := browser openOn: $d.
	self assert: self tabGroup selectedPageIndex equals: 1.
	browser entity: $c.
	self assert: self tabGroup selectedPageIndex equals: 2.
	browser entity: $d.
	self assert: self tabGroup selectedPageIndex equals: 1! !

!GLMAccumulatorMorphicTest methodsFor: 'tests' stamp: 'AliakseiSyrel 10/18/2014 16:25'!
testTabTitle
	| browser firstTabLabel |
	browser := GLMAccumulator new.
	browser
		show: [ :a | 
			a title: [ :x | x asString ].
			a list display: [ :x | $a to: x ] ].
	window := browser openOn: $d.
	firstTabLabel := (self find: GLMTabLabelBrick in: self tabGroup tabSelectorMorph) submorphs first.
	self assert: firstTabLabel submorphs size equals: 2.
	self assert: firstTabLabel submorphs first label text equals: 'd'.
	self find: GLMActionButtonBrick in: firstTabLabel.! !

!GLMAccumulatorMorphicTest methodsFor: 'tests' stamp: 'Nicolasanquetil 5/3/2013 15:11'!
testPaneRemoval
	| browser |
	browser := GLMAccumulator new.
	browser show: [ :a | a list display: [ :x | $a to: x ] ].
	window := browser openOn: $d.
	self assert: browser activeEntity equals: $d.
	browser entity: $c.
	self assert: browser activeEntity equals: $c.
	self tabGroup removePageIndex: 1.
	self assert: self tabGroup tabSelectorMorph tabs size equals: 1.
	self assert: browser activeEntity equals: $c.
	self tabGroup removePageIndex: 1.
	self assert: self tabGroup tabSelectorMorph tabs isEmpty.
	self assert: browser activeEntity isNil.
	browser entity: $c.
	self assert: self tabGroup tabSelectorMorph tabs size equals: 1! !

!GLMAccumulatorMorphicTest methodsFor: 'tests' stamp: ''!
testCreation
	| browser |
	browser := GLMAccumulator new.
	browser show: [ :a | a list display: [ :x | $a to: x ] ].
	window := browser openOn: $d.
	self find: LazyTabGroupMorph in: window! !

!GLMAccumulatorMorphicTest methodsFor: 'tests' stamp: ''!
testPaneCreation
	| browser |
	browser := GLMAccumulator new.
	browser show: [ :a | a list display: [ :x | $a to: x ] ].
	window := browser openOn: $d.
	self assert: self tabGroup pages size equals: 1.
	browser entity: $c.
	self assert: self tabGroup pages size equals: 2! !

!GLMAccumulatorTest methodsFor: 'tests' stamp: 'Nicolasanquetil 5/3/2013 15:18'!
testRemovePaneIndex
	| accumulator presentation |
	accumulator := GLMAccumulator new.
	presentation := GLMPresentation new.
	accumulator addPresentation: presentation.
	accumulator entity: 42.
	accumulator entity: 43.
	accumulator removePaneIndex: 2.
	self assert: accumulator panes size equals: 1! !

!GLMAccumulatorTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testNoDuplicatePaneCreation
	| accumulator presentation |
	accumulator := GLMAccumulator new.
	presentation := GLMPresentation new.
	accumulator addPresentation: presentation.
	accumulator entity: 41.
	self assert: accumulator panes size equals: 1.
	accumulator entity: 42.
	self assert: accumulator panes size equals: 2.
	accumulator entity: 41.
	self assert: accumulator panes size equals: 2! !

!GLMAccumulatorTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPublishToOutside
	| accumulator presentation |
	accumulator := GLMAccumulator new.
	presentation := GLMPresentation new.
	accumulator addPresentation: presentation.
	accumulator startOn: 41.
	(accumulator panes first port: #selection) value: 42.
	self assert: (accumulator pane port: #selection) value equals: 42! !

!GLMAccumulatorTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPublishToOutsideWhenEmbedded
	| browser accumulator actualAccumulator |
	browser := GLMTabulator new.
	accumulator := GLMAccumulator new.
	accumulator addPresentation: GLMPresentation new.
	accumulator
		addTransmission:
			((GLMTransmission new)
				addActiveOrigin:
						((GLMPresentationBoundPort new)
								presentation: accumulator;
								name: #selection;
								yourself);
				destination:
						((GLMPresentationBoundPort new)
								presentation: accumulator;
								name: #anotherPort;
								yourself);
				yourself).
	browser addColumn: #one.
	browser
		addTransmission:
			((GLMTransmission new)
				ensurePresentIfNoneStrategy;
				addActiveOrigin:
						((GLMPresentationBoundPort new)
								presentation: browser;
								name: #entity;
								yourself);
				destination: ((browser paneNamed: #one) port: #entity);
				addPresentation: accumulator;
				yourself).
	browser startOn: 41.
	actualAccumulator := browser panes first presentations first.
	(actualAccumulator panes first port: #selection) value: 42.
	self assert: (actualAccumulator pane port: #selection) value equals: 42.
	self assert: (actualAccumulator pane port: #anotherPort) value notNil.
	self assert: (actualAccumulator pane port: #anotherPort) value equals: 42! !

!GLMAccumulatorTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPaneAddedAnnouncement
	| accumulator presentation annoumcementsCount |
	accumulator := GLMAccumulator new.
	presentation := GLMPresentation new.
	accumulator addPresentation: presentation.
	annoumcementsCount := 0.
	accumulator on: GLMPaneAdded do: [ :ann | annoumcementsCount := annoumcementsCount + 1 ].
	1 to: 42 do: [ :i | accumulator entity: i ].
	self assert: annoumcementsCount equals: 42! !

!GLMAccumulatorTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPaneSelectedAnnouncement
	| accumulator presentation annoumcementsCount otherAnnoumcementsCount |
	accumulator := GLMAccumulator new.
	presentation := GLMPresentation new.
	accumulator addPresentation: presentation.
	annoumcementsCount := 0.
	otherAnnoumcementsCount := 0.
	1 to: 42 do: [ :i | accumulator entity: i ].
	accumulator on: GLMPaneSelected do: [ :ann | annoumcementsCount := annoumcementsCount + 1 ].
	accumulator on: GLMPaneAdded do: [ :ann | otherAnnoumcementsCount := otherAnnoumcementsCount + 1 ].
	accumulator on: GLMPaneRemoved do: [ :ann | otherAnnoumcementsCount := otherAnnoumcementsCount + 1 ].
	self assert: annoumcementsCount equals: 0.
	self assert: otherAnnoumcementsCount equals: 0.
	1 to: 42 do: [ :i | accumulator entityToSelect: i ].
	self assert: annoumcementsCount equals: 42.
	self assert: otherAnnoumcementsCount equals: 0! !

!GLMAccumulatorTest methodsFor: 'tests' stamp: 'TudorGirba 5/20/2012 00:53'!
testCustomTransmissions
	| accumulator presentation |
	accumulator := GLMAccumulator new.
	presentation := GLMPresentation new.
	accumulator addPresentation: presentation.
	(accumulator transmit)
		fromOutsidePort: #selection;
		toOutsidePort: #otherPort.
	accumulator startOn: 41.
	(accumulator panes first port: #selection) value: 42.
	self assert: (accumulator pane port: #otherPort) value equals: 42! !

!GLMAccumulatorTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPaneRemovedAnnouncement
	| accumulator presentation annoumcementsCount |
	accumulator := GLMAccumulator new.
	presentation := GLMPresentation new.
	accumulator addPresentation: presentation.
	annoumcementsCount := 0.
	accumulator on: GLMPaneRemoved do: [ :ann | annoumcementsCount := annoumcementsCount + 1 ].
	1 to: 42 do: [ :i | accumulator entity: i ].
	self assert: annoumcementsCount equals: 0.
	1 to: 42 do: [ :i | accumulator removePaneIndex: 1 ].
	self assert: annoumcementsCount equals: 42! !

!GLMAccumulatorTest methodsFor: 'tests' stamp: 'TudorGirba 5/20/2012 00:53'!
testCopy
	| accumulator presentation copiedAccumulator |
	accumulator := GLMAccumulator new.
	presentation := GLMPresentation new.
	accumulator addPresentation: presentation.
	(accumulator transmit)
		fromOutsidePort: #selection;
		toOutsidePort: #otherPort.
	copiedAccumulator := accumulator copy.
	self assert: copiedAccumulator transmissions size equals: 1.
	self assert: copiedAccumulator transmissions first ~~ accumulator transmissions first.
	self assert: copiedAccumulator transmissions first destination pane == copiedAccumulator pane.
	self assert: copiedAccumulator transmissions first origins first pane ~~ accumulator pane.
	self assert: copiedAccumulator transmissions first origins first pane == copiedAccumulator pane! !

!GLMAccumulatorTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPaneCreation
	| accumulator presentation |
	accumulator := GLMAccumulator new.
	presentation := GLMPresentation new.
	accumulator addPresentation: presentation.
	accumulator entity: 41.
	self assert: accumulator panes size equals: 1.
	self assert: (accumulator panes first port: #entity) value equals: 41.
	self assert: accumulator panes first presentations first rootPrototype == presentation.
	accumulator entity: 42.
	self assert: accumulator panes size equals: 2.
	self assert: (accumulator panes first port: #entity) value equals: 41.
	self assert: (accumulator panes last port: #entity) value equals: 42.
	self assert: accumulator panes first presentations first rootPrototype equals: presentation.
	self assert: accumulator panes last presentations first rootPrototype equals: presentation! !

!GLMAccumulatorTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPaneName
	| accumulator presentation |
	accumulator := GLMAccumulator new.
	presentation := GLMPresentation new.
	accumulator addPresentation: presentation.
	accumulator entity: 41.
	self assert: accumulator panes first name equals: '1'.
	accumulator entity: 42.
	self assert: accumulator panes last name equals: '2'! !

!GLMAction commentStamp: '<historical>'!
Actions are elements of behavior that are executed upon a keyboard shortcut or other event.

Instances of Action are stored and maintained by Presentations. The exact representation is determined by the renderer, but actions can define a keyboard shortcut that should trigger the action or a title, category and position to be able to use the action as a context menu item.!
!GLMAction methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
category: aString 
	"The name of the category that should be used when this action is displayed in a context menu." 
	 
	category := aString! !

!GLMAction methodsFor: 'testing' stamp: 'tg 9/25/2010 17:52'!
worksWithSeaside
	^ false! !

!GLMAction methodsFor: 'accessing' stamp: 'TudorGirba 2/28/2014 06:23'!
condition: anObject
	condition := anObject! !

!GLMAction methodsFor: 'testing' stamp: 'tg 9/28/2009 11:09'!
hasIcon
	 
	^self icon notNil! !

!GLMAction methodsFor: 'public interface' stamp: 'TudorGirba 12/16/2011 17:45'!
actOn: aPresentation 
	 
	^ self action 
		glamourValueWithArgs: 
			(Array 
				with: aPresentation 
				withAll: aPresentation entity asGlamorousArray)! !

!GLMAction methodsFor: 'testing' stamp: 'TudorGirba 2/28/2014 06:32'!
isAvailableOn: aPresentation
	^ self condition glamourValueWithArgs: 
			(Array 
				with: aPresentation 
				withAll: aPresentation entity asGlamorousArray)! !

!GLMAction methodsFor: 'accessing' stamp: 'AndreiChis 10/5/2014 15:09'!
separatorAfter: aBoolean
	
	separatorAfter := aBoolean! !

!GLMAction methodsFor: 'accessing' stamp: 'AndreiChis 10/5/2014 15:10'!
withSeparatorBefore

	self separatorBefore: true! !

!GLMAction methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
position: anInteger 
	"The relative position within a context menu." 
	 
	position := anInteger! !

!GLMAction methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
title 
	"Title that this action should use in a context menu." 
	 
	^title! !

!GLMAction methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
action 
	"The code that should be executed when this action is triggered." 
	 
	^action! !

!GLMAction methodsFor: 'accessing' stamp: 'TudorGirba 2/28/2014 06:27'!
condition
	^ condition ifNil: [ true ]! !

!GLMAction methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
title: anObject 
	"Title that this action should use in a context menu." 
	 
	title := anObject! !

!GLMAction methodsFor: 'accessing' stamp: 'AndreiChis 10/5/2014 15:09'!
separatorBefore
	
	^ separatorBefore ifNil: [ false ]! !

!GLMAction methodsFor: 'testing' stamp: 'EstebanLorenzano 4/20/2012 15:00'!
isButton
	^self hasIcon! !

!GLMAction methodsFor: 'testing' stamp: ' 4/5/09 22:18'!
hasShortcut 
	 
	^self shortcut notNil! !

!GLMAction methodsFor: '*glamour-morphic-renderer' stamp: 'cyrilledelaunay 8/9/2011 13:56'!
morphicActOn: aPresentation

	^ self actOn: aPresentation! !

!GLMAction methodsFor: 'testing' stamp: 'EstebanLorenzano 4/20/2012 15:00'!
isMenu
	^self hasTitle and: [ self hasIcon not]! !

!GLMAction methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
category 
	"The name of the category that should be used when this action is displayed in a context menu." 
	 
	^category! !

!GLMAction methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
shortcut: aCharacter 
	"Shortcut character that this action should be triggered with when the focus rests on the corresponding presentation. 
	Modifiers are platform specific an can not be defined." 
	 
	shortcut := aCharacter! !

!GLMAction methodsFor: 'testing' stamp: ' 4/5/09 22:18'!
hasTitle 
	 
	^self title notNil! !

!GLMAction methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
action: aBlock 
	"The code that should be executed when this action is triggered. 
 
	The block can take optional arguments, the first will always be the 
	presentation on which this action was triggered." 
	 
	action := aBlock! !

!GLMAction methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
shortcut 
	"Shortcut character that this action should be triggered with when the focus rests on the corresponding presentation. 
	Modifiers are platform specific an can not be defined." 
	 
	^shortcut! !

!GLMAction methodsFor: 'accessing' stamp: 'AndreiChis 10/5/2014 15:09'!
separatorAfter
	
	^ separatorAfter ifNil: [ false ]! !

!GLMAction methodsFor: 'accessing' stamp: 'AndreiChis 10/5/2014 15:09'!
separatorBefore: aBoolean
	
	separatorBefore := aBoolean! !

!GLMAction methodsFor: 'accessing' stamp: 'tg 9/28/2009 11:06'!
icon: anObject
	icon := anObject! !

!GLMAction methodsFor: '*glamour-morphic-renderer' stamp: 'AndreiChis 1/14/2015 13:44'!
installKeyCombinationForPresentation: aPresentation onMorph: aMorph
	aMorph 
		on: (self shortcut isUppercase 
			ifTrue: [ self shortcut command shift ]
			ifFalse: [ self shortcut command ])
		do: [ self actOn: aPresentation ].
	aMorph 
		on: (self shortcut isUppercase 
			ifTrue: [ self shortcut ctrl shift ]
			ifFalse: [ self shortcut ctrl ])
		do: [ self actOn: aPresentation ]! !

!GLMAction methodsFor: 'accessing' stamp: 'AndreiChis 10/5/2014 15:09'!
withSeparatorAfter

	self separatorAfter: true! !

!GLMAction methodsFor: 'rendering' stamp: 'EstebanLorenzano 4/20/2012 15:11'!
renderGlamorouslyOn: aRenderer
	^aRenderer renderAction: self! !

!GLMAction methodsFor: 'accessing' stamp: 'EstebanLorenzano 12/10/2014 22:45'!
shortcutAsString 
	"Answers a string explaining shortcut"
	self shortcut ifNil: [ ^ '' ].
	^ String streamContents: [ :stream |
		stream << Smalltalk os menuShortcutModifierString << '+'.
		self shortcut isUppercase 
			ifTrue: [ stream << 'shift+' ].
		stream << self shortcut asLowercase asString ]! !

!GLMAction methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
position 
	"The relative position within a context menu." 
	 
	^position! !

!GLMAction methodsFor: 'testing' stamp: 'tg 9/17/2009 15:02'!
isCategorized
	 
	^self category notNil! !

!GLMAction methodsFor: 'testing' stamp: 'tg 9/25/2010 17:52'!
worksWithMorphic
	^ false! !

!GLMAction methodsFor: 'accessing' stamp: 'tg 9/28/2009 11:06'!
icon
	^ icon! !

!GLMActionAnnouncement methodsFor: 'accessing' stamp: 'david_roethlisberger 3/3/2009 16:28'!
action
	^action! !

!GLMActionAnnouncement methodsFor: 'accessing' stamp: 'david_roethlisberger 3/3/2009 16:28'!
action: anAction
	action := anAction! !

!GLMActionAnnouncement class methodsFor: 'instance creation' stamp: 'david_roethlisberger 3/3/2009 16:28'!
action: anAction
	^self new action: anAction; yourself! !

!GLMActionBrickDarkThemer methodsFor: 'modules' stamp: 'AliakseiSyrel 3/27/2015 13:23'!
popupThemer

	^ self registerModule: GLMActionBrickPopupDarkThemer new! !

!GLMActionBrickDarkThemer methodsFor: 'brick-scrollbar' stamp: 'AliakseiSyrel 3/27/2015 13:21'!
scrollbarWidth

	^ 2! !

!GLMActionBrickDarkThemer methodsFor: '*GT-Playground' stamp: 'AliakseiSyrel 3/27/2015 13:33'!
bindingThemer

	^ self registerModule: GTPlayBindingDarkThemer new! !

!GLMActionBrickDarkThemer methodsFor: 'brick-scrollpane' stamp: 'AliakseiSyrel 3/27/2015 13:35'!
scrollpaneBackgroundColor

	^ Color transparent! !

!GLMActionBrickPopupDarkThemer methodsFor: 'brick-popup' stamp: 'AliakseiSyrel 3/27/2015 13:23'!
borderWidth

	^ 2! !

!GLMActionBrickPopupThemer methodsFor: 'brick-popup' stamp: 'AliakseiSyrel 3/27/2015 11:42'!
borderWidth

	^ 2! !

!GLMActionBrickThemer methodsFor: 'modules' stamp: 'AliakseiSyrel 3/27/2015 11:38'!
popupThemer

	^ self registerModule: GLMActionBrickPopupThemer new! !

!GLMActionBrickThemer methodsFor: 'brick-scrollpane' stamp: 'AliakseiSyrel 3/27/2015 11:27'!
scrollbarWidth

	^ 2! !

!GLMActionBrickThemer methodsFor: '*GT-Playground' stamp: 'AliakseiSyrel 3/27/2015 12:23'!
bindingThemer

	^ self registerModule: GTPlayBindingThemer new! !

!GLMActionBrickThemer methodsFor: 'brick-scrollpane' stamp: 'AliakseiSyrel 3/27/2015 11:26'!
scrollpaneBackgroundColor

	^ Color transparent! !

!GLMActionButtonBrick commentStamp: 'AliakseiSyrel 3/22/2015 12:20'!
A GLMActionButtonBrick is a basic iconified action button without label that supports mouse click, hover and unhover actions.

action: with object argument to set on mouse clicked action.
hoverAction action: with object argument to set on mouse hover action.
unhoverAction: with object argument to set on mouse unhover action.

User can set normal icon and icon that will be used when action button is hovered with mouse sending:
icon: aForm
hoverIcon: aForm

Instance Variables
	clickAction:		<Object>
	hoverAction:		<Object>
	unhoverAction:		<Object>

clickAction
	- action on mouse clicked

hoverAction
	- action on mouse hovered

unhoverAction
	- action on mouse unhovered
!
!GLMActionButtonBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 3/22/2015 12:36'!
hShrinkWrap

	self width: [
		self vPadding + 
		(self icon isNil & self hoverIcon isNil
			ifTrue: [ 0 ]
			ifFalse: [
				self icon
					ifNil: [ self hoverIcon width ]
					ifNotNil: [ 
						self hoverIcon
							ifNil: [ self icon width ]
							ifNotNil: [ self icon width max: self hoverIcon width ] ] ]) ]! !

!GLMActionButtonBrick methodsFor: 'brick-interactable-actions' stamp: 'AliakseiSyrel 3/22/2015 11:55'!
deselect: anEvent
	super deselect: anEvent.
	
	unhoverAction ifNotNil: [ :a | a brickValue: self withEnoughArguments: { anEvent } ]! !

!GLMActionButtonBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 3/22/2015 12:36'!
vShrinkWrap

	self height: [
		self vPadding + 
		(self icon isNil & self hoverIcon isNil
			ifTrue: [ 0 ]
			ifFalse: [
				self icon
					ifNil: [ self hoverIcon height ]
					ifNotNil: [ 
						self hoverIcon
							ifNil: [ self icon height ]
							ifNotNil: [ self icon height max: self hoverIcon height ] ] ]) ]! !

!GLMActionButtonBrick methodsFor: 'brick-interactable-actions' stamp: 'AliakseiSyrel 3/22/2015 11:55'!
click: anEvent
	
	clickAction ifNil: [ ^ false ].
	clickAction brickValue: self withEnoughArguments: { anEvent }.
	
	^ true! !

!GLMActionButtonBrick methodsFor: 'action-button-accessing' stamp: 'AliakseiSyrel 3/22/2015 12:18'!
hoverIcon

	^ self selectedImage! !

!GLMActionButtonBrick methodsFor: 'action-button-accessing' stamp: 'AliakseiSyrel 3/22/2015 12:25'!
hoverIcon: anImage

	self selectedImage: anImage.
	self doLayoutForce! !

!GLMActionButtonBrick methodsFor: 'action-button-actions' stamp: 'AliakseiSyrel 3/22/2015 11:55'!
action: anObject

	clickAction := anObject! !

!GLMActionButtonBrick methodsFor: 'action-button-actions' stamp: 'AliakseiSyrel 3/22/2015 11:53'!
hoverAction: anObject

	hoverAction := anObject! !

!GLMActionButtonBrick methodsFor: 'action-button-accessing' stamp: 'AliakseiSyrel 3/22/2015 12:25'!
icon: anImage

	self normalImage: anImage.
	self doLayoutForce! !

!GLMActionButtonBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 3/22/2015 12:26'!
initialize
	super initialize.
	
	self
		hShrinkWrap;
		vShrinkWrap;
		enable! !

!GLMActionButtonBrick methodsFor: 'brick-interactable-actions' stamp: 'AliakseiSyrel 3/22/2015 11:55'!
select: anEvent
	super select: anEvent.
	
	hoverAction ifNotNil: [ :a | a brickValue: self withEnoughArguments: { anEvent } ]! !

!GLMActionButtonBrick methodsFor: 'action-button-actions' stamp: 'AliakseiSyrel 3/22/2015 11:53'!
unhoverAction: anObject

	unhoverAction := anObject! !

!GLMActionButtonBrick methodsFor: 'action-button-accessing' stamp: 'AliakseiSyrel 2/11/2015 11:11'!
icon

	^ self normalImage! !

!GLMActionButtonBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:38'!
exampleOpen

	self gtExample openCenteredInBrickWindowLabeled: 'Action button example'! !

!GLMActionButtonBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:18'!
gtExample
	<gtExample: 'Action button with icon and dynamic background color'>
	
	^ self new
			action: [ :b | b gtDisplayString logCr ];
			hoverAction: [ :b | b gtDisplayString logCr ];
			icon: GLMUIThemeExtraIcons glamorousGrayCircleEmpty;
			hoverIcon: GLMUIThemeExtraIcons glamorousRedCircle;
			selectedColor: Color veryVeryLightGray whiter slightlyLighter;
			pressedColor: Color veryVeryLightGray;
			borderColor: Color veryVeryLightGray;
			borderWidth: 1;
			padding: 5! !

!GLMActionListPresentation commentStamp: 'AndreiChis 10/3/2014 18:20'!
The goal of a GLMActionListPresentation is to group together and display a set of actions.  Actions should be added using the normal API from GLMPresentation.

The rendred will decide the actual way in which the actions are displayed (usually using a set of buttons).

For an example see GLMBasicExamples>>#simpleActionList!
!GLMActionListPresentation methodsFor: 'testing' stamp: 'EstebanLorenzano 4/20/2012 16:19'!
hasActions
	^false! !

!GLMActionListPresentation methodsFor: 'accessing' stamp: ''!
isVertical
	^ self isHorizontal not! !

!GLMActionListPresentation methodsFor: 'accessing' stamp: ''!
isHorizontal: anObject
	isHorizontal := anObject! !

!GLMActionListPresentation methodsFor: 'rendering' stamp: ''!
renderGlamorouslyOn: aRenderer
	self registerAnnouncements.
	^ aRenderer renderActionListPresentation: self! !

!GLMActionListPresentation methodsFor: 'accessing' stamp: 'AndreiChis 8/6/2013 18:34'!
isHorizontal
	^ isHorizontal ifNil: [isHorizontal := true]! !

!GLMActionListPresentation methodsFor: 'scripting' stamp: 'AndreiChis 8/6/2013 18:48'!
beVertical
	self isHorizontal: false! !

!GLMActionTest methodsFor: 'tests' stamp: 'EstebanLorenzano 12/10/2014 22:50'!
testShortcutAsString
	| action modifier |
	
	modifier := Smalltalk os menuShortcutModifierString.
	action := GLMAction new.
	action shortcut: $i.
	self assert: action shortcutAsString equals: modifier, '+i'.
	action shortcut: $I.
	self assert: action shortcutAsString equals: modifier, '+shift+i'.
	action shortcut: nil.
	self assert: action shortcutAsString isEmpty! !

!GLMActionTest methodsFor: 'tests' stamp: 'TudorGirba 2/28/2014 06:34'!
testCondition
	self 
		assert: (GLMAction new isAvailableOn: GLMPresentation new).
	self 
		deny: (GLMAction new 
			condition: [ false ];
			isAvailableOn: GLMPresentation new).
	self 
		deny: (GLMAction new 
			condition: [ :presentation :entity | false ];
			isAvailableOn: GLMPresentation new)! !

!GLMActionsToolbarMorphicTest methodsFor: 'as yet unclassified' stamp: 'AndreiChis 6/20/2013 11:05'!
expectedFailures
	^ #(testDynamicActionsAreUpdated)! !

!GLMActionsToolbarMorphicTest methodsFor: 'tests' stamp: 'AndreiChis 6/18/2013 16:32'!
testDynamicActionsAreUpdated
	| browser toolbar status count|
	count := 0.
	browser := GLMTabulator new.
	browser addStatusbar.
	browser row: #one.
	browser transmit to: #one; andShow: [:composite | 
		composite list
			title: 'List 1';
			dynamicActions: [ :list || actions |
				status := true.
				actions := OrderedCollection new.
				actions add: 
					((GLMGenericAction new) 
						action: [ :presentation :model | browser update]; 
						icon: GLMUIThemeExtraIcons glamorousAdd;
						title: count asString;
						yourself).
				actions	] ].
	window := browser openOn: (1 to: 10).
	status := false.
	count := 1.
	browser update.
	self assert: status. "the dynamic actions are regenerated"
	toolbar := self findLast: ToolDockingBarMorph in: window.
	self assert: toolbar submorphs first model title = '1' "the action has the new model"

	
	
	
! !

!GLMAlertBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/26/2015 23:06'!
initialize
	super initialize.
	
	self
		width:  300;
		textBrick: self newTextBrick;
		okButton: self newButtonBrick
	! !

!GLMAlertBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/19/2015 16:22'!
textBrick: aBrick

	textBrick := aBrick.
	
	self textBrick
		margin: #(0 3 3 3);
		vShrinkWrap.
	
	self addBrickBack: self textBrick! !

!GLMAlertBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 2/26/2015 23:02'!
newTextBrick

	^ GLMRubEditingAreaBrick new! !

!GLMAlertBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 2/26/2015 22:32'!
newButtonBrick

	^ GLMButtonBrick new! !

!GLMAlertBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/26/2015 23:12'!
okButton: anObject
	okButton := anObject.
	
	self okButton
		marginBottom: 3;
		text: 'OK';
		hAlign: #center;
		when: #onClicked do: [ self window ifNotNil: [ :w | w close ] ].
	
	self addBrickBack: self okButton! !

!GLMAlertBrick methodsFor: 'scripting' stamp: 'AliakseiSyrel 3/30/2015 12:01'!
alert: anObject
	|window|
	self alertOn: anObject.
	window := (self openInBrickWindowLabeled: 'Alert').
	#GLMSystemWindowBrick asClassIfAbsent: [ ^ self ].
	window
		noMenu;
		innerExtent: self extent! !

!GLMAlertBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/26/2015 22:34'!
okButton
	^ okButton! !

!GLMAlertBrick methodsFor: 'scripting' stamp: 'AliakseiSyrel 2/26/2015 23:02'!
alertOn: anObject

	self textBrick
		text: anObject asString! !

!GLMAlertBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/26/2015 22:33'!
textBrick

	^ textBrick! !

!GLMAlertBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:19'!
gtExample
	<gtExample: 'Simple alert window displaying a message'>
	^ self new alertOn: 'Hello world!!'
	! !

!GLMAlertBrick class methodsFor: 'examples' stamp: 'AliakseiSyrel 2/26/2015 23:15'!
exampleOpen

	'Hello world!!' brickAlert! !

!GLMAlertBrick class methodsFor: 'open' stamp: 'AliakseiSyrel 2/26/2015 22:44'!
alert: anObject

	self new alert: anObject
	! !

!GLMAllNilCondition commentStamp: 'AndreiChis 3/11/2015 23:58'!
Used to test if all defined arguments of a condition are nil.
!
!GLMAllNilCondition methodsFor: 'glamour' stamp: 'VeronicaUquillas 2/18/2011 15:11'!
glamourValueWithArgs: anArray 
	 
	^anArray allSatisfy: [:each | each isNil]! !

!GLMAllNotNilCondition commentStamp: '<historical>'!
Used to test if all defined arguments of a condition or not nil.

We use this as a default condition for presentations. Usually, you will want to define a condition as a block such as '[ :class :category | (class isKindOf: Class) and: [ category isKindOf: Symbol ] ]' (or something like that) but sometimes you just want to make sure that all arguments are defined. Since we do not know the number of arguments in advance, we use this class to interpret #glamourValueWithArgs: and return true if all arguments are not nil.!
!GLMAllNotNilCondition methodsFor: 'glamour' stamp: 'DamienCassou 9/10/2009 19:54'!
glamourValueWithArgs: anArray 
	 
	^anArray allSatisfy: [:each | each notNil]! !

!GLMAnimation commentStamp: 'AliakseiSyrel 2/17/2015 21:04'!
A GLMAnimation class is a basic animation class that works in background thread and performs brick transformation in UI thread!
!GLMAnimation methodsFor: 'scripting' stamp: 'AliakseiSyrel 2/17/2015 20:56'!
onStepped: aBlock

	steppedLogic := aBlock! !

!GLMAnimation methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/17/2015 12:24'!
animatedObject

	^ animatedObject! !

!GLMAnimation methodsFor: 'actions' stamp: 'AliakseiSyrel 2/18/2015 13:19'!
terminate

	self asyncTask terminate.
	(self isCompleted not & self animatedObject isNotNil) ifTrue: [
		ensureLogic brickValue: self animatedObject ]! !

!GLMAnimation methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/17/2015 12:05'!
asyncTask

	^ asyncTask ifNil: [ asyncTask := GLMAsyncTask new ]! !

!GLMAnimation methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/17/2015 13:17'!
needsStep: aBoolean

	doStep := aBoolean! !

!GLMAnimation methodsFor: 'scripting' stamp: 'AliakseiSyrel 2/17/2015 13:20'!
onCompleted: aBlock

	callback := aBlock! !

!GLMAnimation methodsFor: 'scripting' stamp: 'AliakseiSyrel 2/18/2015 11:41'!
linear

	self step: [ :b :from :to :delta | (to - from) * delta + from ]! !

!GLMAnimation methodsFor: 'animating' stamp: 'AliakseiSyrel 3/21/2015 16:24'!
animationStep
	|delta stepValue currentTime stop stepStamp|
	self needsStep: false.
	currentTime := Time millisecondClockValue.
	stop := currentTime >= self finishTime.
	delta := self duration = 0
		ifTrue: [ 1 ]
		ifFalse: [ ((currentTime - startTime) min: self duration) / self duration ].
	delta = 1 ifTrue: [ stop := true ].
	stepValue := stepLogic
		brickValue: self animatedObject
		withEnoughArguments: { self fromValue . self toValue . delta }.
	(delta = 1) | (stepValue = self toValue) ifTrue: [ stop := true ].
	stepStamp := stamp.
	UIManager default defer: [
		self asyncTask isTerminated not & (stepStamp = stamp) ifTrue: [
			steppedLogic brickValue: self animatedObject withEnoughArguments: { delta }.
			animationLogic brickValue: self animatedObject withEnoughArguments: { stepValue }.
			stop
				ifFalse: [ self needsStep: true. self asyncTask resume ]
				ifTrue: [ self shouldStop: true. self asyncTask resume ] ] ].
		
	self asyncTask pause
	
	! !

!GLMAnimation methodsFor: 'scripting' stamp: 'AliakseiSyrel 2/18/2015 13:01'!
ensure: aBlock

	ensureLogic := aBlock! !

!GLMAnimation methodsFor: 'scripting' stamp: 'AliakseiSyrel 3/21/2015 16:21'!
animate: anObject

	self asyncTask terminate.
	animatedObject := anObject.
	self reset.
	
	stamp := Time millisecondClockValue.
	self asyncTask
		doInBackground: [ [ self shouldStop ] whileFalse: [
				self needsStep ifTrue: [ self animationStep ] ] ];
		onCompleted: [ 
			isCompleted := true.
			[ callback brickValue: self animatedObject ]
				ensure: [ ensureLogic brickValue: self animatedObject ] ];
		priority: Processor userSchedulingPriority;
		execute! !

!GLMAnimation methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/17/2015 13:13'!
needsStep

	^ doStep ifNil: [ doStep := true ]! !

!GLMAnimation methodsFor: 'scripting' stamp: 'AliakseiSyrel 2/17/2015 12:31'!
step: anObject

	stepLogic := anObject! !

!GLMAnimation methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/17/2015 13:16'!
shouldStop: aBoolean

	shouldStop := aBoolean! !

!GLMAnimation methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/17/2015 12:25'!
toValue

	^ toValue ifNil: [ toValue := toLogic brickValue: self animatedObject ]! !

!GLMAnimation methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/17/2015 12:20'!
startTime

	^ startTime ifNil: [ startTime := Time millisecondClockValue ]! !

!GLMAnimation methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/17/2015 13:14'!
shouldStop

	 ^ shouldStop ifNil: [ shouldStop := false ]! !

!GLMAnimation methodsFor: 'scripting' stamp: 'AliakseiSyrel 2/17/2015 12:46'!
animation: anObject

	animationLogic := anObject! !

!GLMAnimation methodsFor: 'scripting' stamp: 'AliakseiSyrel 2/17/2015 12:23'!
to: anObject

	toLogic := anObject! !

!GLMAnimation methodsFor: 'actions' stamp: 'AliakseiSyrel 3/21/2015 01:14'!
reset

	isCompleted := false.
	shouldStop := false.
	doStep := true.
	fromValue := nil.
	toValue := nil.
	currentValue := nil.
	startTime := nil! !

!GLMAnimation methodsFor: 'scripting' stamp: 'AliakseiSyrel 2/17/2015 12:23'!
from: anObject

	fromLogic := anObject! !

!GLMAnimation methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/17/2015 12:24'!
fromValue

	^ fromValue ifNil: [ fromValue := fromLogic brickValue: self animatedObject ]! !

!GLMAnimation methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/17/2015 12:04'!
asyncTask: anObject
	asyncTask := anObject! !

!GLMAnimation methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/18/2015 12:59'!
isCompleted

	^ isCompleted ifNil: [ isCompleted := false ]! !

!GLMAnimation methodsFor: 'scripting' stamp: 'AliakseiSyrel 2/17/2015 12:09'!
duration: anInteger

	duration := anInteger! !

!GLMAnimation methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/17/2015 12:41'!
finishTime

	^ self startTime + self duration! !

!GLMAnimation methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/17/2015 12:42'!
duration

	^ duration ifNil: [ duration := 0 ]! !

!GLMAnimation class methodsFor: 'sources' stamp: 'AliakseiSyrel 3/19/2015 13:43'!
exampleSimple
	|brick|

	brick := GLMLabelBrick new
		color: Color lightBlue;
		textPosition: #center.

	GLMAnimation new
		linear;
		duration: 5000;
		from: 50@50;
		to: 400@400;
		animation: [ :b :v | b extent: v ];
		onStepped: [ :b :delta | b text: ((delta * 100) asInteger asString, '%') ];
		onCompleted: [ :b | b invalidateWith: [ b color: Color lightGreen; text: 'Done!! 100%' ] ];
		animate: brick.
	
	brick asBrickedMorph
		extent: 400@400;
		openInWindow! !

!GLMAnimation class methodsFor: 'instance creation' stamp: 'AliakseiSyrel 3/21/2015 01:36'!
borderColor

	^ GLMAnimation new
		step: [ :brick :from :to :delta |
			|r g b a|
			r := (to red - from red) * delta + from red.
			g := (to green - from green) * delta + from green.
			b := (to blue - from blue) * delta + from blue.
			a := (to alpha - from alpha) * delta + from alpha.
			Color r: r g: g b: b alpha: a ];
		animation: [ :b :v | b borderColor: v. b changed ]! !

!GLMAnimation class methodsFor: 'instance creation' stamp: 'AliakseiSyrel 3/27/2015 12:03'!
swipeLeft

	^ GLMAnimation new
		linear;
		duration: 250;
		from: 0;
		to: -1.2;
		animation: [ :b :v | b changed. b translateXTo: (v * b width). b changed ]! !

!GLMAnnouncementPropagationTest methodsFor: 'setup' stamp: 'tg 5/24/2010 17:27'!
tearDown
	GLMLogger reset! !

!GLMAnnouncementPropagationTest methodsFor: 'tests' stamp: 'Nicolasanquetil 5/3/2013 15:12'!
testPropagationDuringCircularDependencies
	| browser announcements |
	browser := GLMTabulator new.
	browser
		column: #one;
		column: #two.
	browser transmit
		to: #one;
		andShow: [ :a | a list display: [ :x | 1 to: x ] ].
	browser transmit
		from: #one;
		to: #two;
		andShow: [ :a | a list display: [ :x | 1 to: x ] ].
	browser transmit
		from: #two port: #toSelect;
		toOutsidePort: #toSelect.
	browser transmit
		fromOutsidePort: #toSelect;
		to: #one port: #selection.
	browser transmit
		fromOutsidePort: #toSelect;
		to: #two port: #selection.
	browser startOn: 100.
	((browser paneNamed: #one) port: #selection) value: 50.
	((browser paneNamed: #two) port: #toSelect) value: 42.
	self assert: ((browser paneNamed: #one) port: #selection) value equals: 42.
	self assert: ((browser paneNamed: #two) port: #selection) value equals: 42.
	announcements := GLMLogger instance announcements reverse reject: [ :each | each isKindOf: GLMTransmissionTriggered ].
	self assert: (announcements first isKindOf: GLMMatchingPresentationsChanged).
	self assert: (announcements second isKindOf: GLMPresentationsChanged).
	self assert: (announcements third isKindOf: GLMContextChanged).
	self assert: announcements third property equals: #toSelect.
	self assert: (announcements fourth isKindOf: GLMContextChanged).
	self assert: announcements fourth property equals: #toSelect.
	self assert: (announcements fourth isKindOf: GLMContextChanged).
	self assert: announcements fifth property equals: #selection.
	self assert: announcements fifth value equals: 42.
	self assert: (announcements fifth presentation isKindOf: GLMListPresentation).
	self assert: announcements fifth presentation pane name equals: #two.
	self assert: announcements sixth property equals: #selection.
	self assert: announcements sixth value equals: 42.
	self assert: (announcements sixth presentation isKindOf: GLMCompositePresentation).
	self assert: announcements sixth presentation pane name equals: #two! !

!GLMAnnouncementPropagationTest methodsFor: 'setup' stamp: 'TudorGirba 10/9/2011 08:04'!
expectedFailures
	^ #(testEntityPropogationAnnouncements testSimplePropagation)! !

!GLMAnnouncementPropagationTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testEntityPropogationAnnouncements
	"This tests the order in which announcements are raised in nested browsers. 
 
	This is of importance as, in this test, we add a browser to a pane when a 
	certain port of that pane gets updated using a BundleTransmission but this 
	browser has a transmission from its #outer pane that refers to the same 
	port.  In such a case we want the presentation to be set first so that it can 
	be notified when the outer port changes. 
 
	This is a sister test to testEntityPropogation that ensures that the 
	announcements are raised in the right order and not redundantly."

	| browser1 browser2 |
	browser1 := (GLMTabulator new)
		title: '1';
		yourself.
	browser2 := (GLMTabulator new)
		title: '2';
		yourself.
	browser1 pane name: 'b1 parent pane'.
	browser1 column: #'b1-pane'.
	browser2 column: #'b2-pane'.
	self assert: browser1 pane presentations size equals: 1.
	self assert: browser1 pane presentations first == browser1.
	(browser1 transmit)
		to: #'b1-pane';
		andShow: [ :a | a custom: browser2 ].
	(browser2 transmit)
		to: #'b2-pane';
		andShow: [ :a | a text ].
	self assert: GLMLogger instance announcements copy isEmpty.
	browser1 startOn: 42.
	self assert: GLMLogger instance announcements copy size equals: 12.	"1. The outer browser's outer pane changes its value."
	self assert: ((GLMLogger instance announcements copy at: 1) isKindOf: GLMContextChanged).
	self assert: (GLMLogger instance announcements copy at: 1) presentation == browser1.
	self assert: (GLMLogger instance announcements copy at: 1) property equals: #entity.
	self assert: (GLMLogger instance announcements copy at: 1) value equals: 42.	"2. The jumpstart transmission of the outer browser is triggered, updating the presentations..."
	self assert: ((GLMLogger instance announcements copy at: 2) isKindOf: GLMPresentationsChanged).
	self assert: (GLMLogger instance announcements copy at: 2) pane == browser1 panes first.
	self assert: (GLMLogger instance announcements copy at: 2) oldPresentations isEmpty.
	self assert: (GLMLogger instance announcements copy at: 2) presentations size equals: 1.
	self assert: (GLMLogger instance announcements copy at: 2) presentations first equals: browser2.	"3. ...and then the context."
	self assert: ((GLMLogger instance announcements copy at: 3) isKindOf: GLMContextChanged).
	self assert: (GLMLogger instance announcements at: 3) presentation equals: browser2.
	self assert: (GLMLogger instance announcements at: 3) property equals: #entity.
	self assert: (GLMLogger instance announcements at: 3) value equals: 42.	"4. The jumpstart transmission of the inner browser is triggered, updating the presentations..."
	self assert: ((GLMLogger instance announcements at: 4) isKindOf: GLMPresentationsChanged).
	self assert: (GLMLogger instance announcements at: 4) pane == browser2 panes first.
	self assert: (GLMLogger instance announcements at: 4) oldPresentations isEmpty.
	self assert: (GLMLogger instance announcements at: 4) presentations size equals: 1.
	self assert: (GLMLogger instance announcements at: 4) presentations first isNil.	"5. ...and then the context."
	self assert: ((GLMLogger instance announcements at: 5) isKindOf: GLMContextChanged).
	self assert: (GLMLogger instance announcements at: 5) presentation isNil.
	self assert: (GLMLogger instance announcements at: 5) property equals: #entity.
	self assert: (GLMLogger instance announcements at: 5) value equals: 42.	"6. Due to the context change of 5, the innermost presentation now matches."
	self assert: ((GLMLogger instance announcements at: 6) isKindOf: GLMMatchingPresentationsChanged).
	self assert: (GLMLogger instance announcements at: 6) pane == browser2 panes first.
	self assert: (GLMLogger instance announcements at: 6) oldMatchingPresentations isEmpty.
	self assert: (GLMLogger instance announcements at: 6) matchingPresentations size equals: 1.
	self assert: (GLMLogger instance announcements at: 6) matchingPresentations first isNil.	"7. Due to the context change of 3, the inner browser now matches."
	self assert: ((GLMLogger instance announcements at: 7) isKindOf: GLMMatchingPresentationsChanged).
	self assert: (GLMLogger instance announcements at: 7) pane == browser1 panes first.
	self assert: (GLMLogger instance announcements at: 7) oldMatchingPresentations isEmpty.
	self assert: (GLMLogger instance announcements at: 7) matchingPresentations size equals: 1.
	self assert: (GLMLogger instance announcements at: 7) matchingPresentations first == browser2.	"8. Due to the context change of 1, the outer browser now matches."
	self assert: ((GLMLogger instance announcements at: 8) isKindOf: GLMMatchingPresentationsChanged).
	self assert: (GLMLogger instance announcements at: 8) pane == browser1 pane.
	self assert: (GLMLogger instance announcements at: 8) oldMatchingPresentations isEmpty.
	self assert: (GLMLogger instance announcements at: 8) matchingPresentations size equals: 1.
	self assert: (GLMLogger instance announcements at: 8) matchingPresentations first == browser1! !

!GLMAnnouncementPropagationTest methodsFor: 'tests' stamp: 'TudorGirba 10/8/2011 18:54'!
testSimplePropagation
	| browser |
	browser := GLMTabulator new.
	browser column: #pane1.
	(browser transmit)
		to: #pane1;
		andShow: [ :a | a text ].
	browser startOn: 42.
	self assert: GLMLogger instance announcements copy size equals: 8! !

!GLMAnnouncementPropagationTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testSimple
	GLMPresentation new announce: GLMContextChanged new.
	self assert: GLMLogger instance announcements size equals: 1! !

!GLMAnnouncementPropagationTest methodsFor: 'setup' stamp: 'tg 5/24/2010 17:26'!
setUp
	GLMLogger instance: GLMMemoryLogger new! !

!GLMAnnouncementPropagationTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testSimpleEmptyPane
	| pane |
	pane := GLMPane new.
	pane browser: GLMBrowser new.
	(pane port: #entity) value: 42.
	self assert: GLMLogger instance announcements size equals: 1.
	self assert: (GLMLogger instance announcements first isKindOf: GLMContextChanged)! !

!GLMAnnouncer commentStamp: 'TudorGirba 1/23/2011 00:58'!
This is a specialization of the Announcer. The main added functionality is the ability to suspend the announcements from this announcer.!
!GLMAnnouncer methodsFor: 'accessing' stamp: 'tg 5/24/2010 17:27'!
announcer 
	^ self! !

!GLMAnnouncer methodsFor: 'accessing' stamp: 'TudorGirba 5/18/2011 13:45'!
resetAnnouncer
	registry reset! !

!GLMAnnouncer methodsFor: 'copying' stamp: 'TudorGirba 7/11/2011 11:16'!
postCopy
	super postCopy.
	registry := registry copy.! !

!GLMAnnouncer methodsFor: 'testing' stamp: 'AndreiChis 11/3/2013 12:40'!
isAnnouncementSuspended: anAnnouncement
	^ self suspendAll or: [ |announcementType|
		announcementType := anAnnouncement isClass 
			ifTrue: [ anAnnouncement ] ifFalse: [ anAnnouncement class ].
		self suspendedAnnouncemets anySatisfy: [ :anAnnouncementType |
			"Suspend the announcement if it has the same class or if it inherits from a suspended announcement class."
			announcementType = anAnnouncementType or: [ announcementType  inheritsFrom: anAnnouncementType ]  ] ]! !

!GLMAnnouncer methodsFor: 'accessing' stamp: 'AndreiChis 11/3/2013 11:22'!
suspendedAnnouncemets
	^ suspendedAnnouncemets ifNil: [ suspendedAnnouncemets := OrderedCollection new ].! !

!GLMAnnouncer methodsFor: 'accessing' stamp: 'TudorGirba 7/10/2011 02:10'!
glmSubscriptions
	^ registry glmSubscriptions! !

!GLMAnnouncer methodsFor: 'suspending' stamp: 'AndreiChis 11/3/2013 11:51'!
suspendAllWhile: aBlock
	| previousSuspensionState |
	previousSuspensionState := suspendAll.
	suspendAll := true.
	aBlock ensure: [suspendAll := previousSuspensionState]
	! !

!GLMAnnouncer methodsFor: 'suspending' stamp: 'AndreiChis 11/3/2013 12:39'!
suspendAll: aCollection while: aBlock
	| previousSuspendedAnnouncemets |
	previousSuspendedAnnouncemets := suspendedAnnouncemets.
	suspendedAnnouncemets := aCollection copy.
	aBlock ensure: [suspendedAnnouncemets := previousSuspendedAnnouncemets] ! !

!GLMAnnouncer methodsFor: 'announce' stamp: 'AndreiChis 11/3/2013 11:33'!
announce: anAnnouncement
	(self isAnnouncementSuspended: anAnnouncement) ifTrue: [ ^ anAnnouncement asAnnouncement ].
	^ super announce: anAnnouncement! !

!GLMAnnouncer methodsFor: 'suspending' stamp: 'tg 2/17/2010 23:04'!
suspendAll
	^ suspendAll ifNil: [ suspendAll := false ].! !

!GLMAnnouncerTest methodsFor: 'tests' stamp: 'AndreiChis 11/3/2013 12:26'!
testSuspendParticularAnnouncementWithInheritanceWhile
	| announcement instance |
	announcer subscribe: Announcement do: [ :ann | announcement := ann ].
	announcement := nil.
	instance := announcer announce: Announcement.
	self assert: announcement equals: instance.
	announcement := nil.
	announcer suspendAll: {Announcement} while: [ instance := announcer announce: GLMTestAnnouncement ].
	self assert: announcement isNil! !

!GLMAnnouncerTest methodsFor: 'tests' stamp: 'AndreiChis 11/3/2013 12:30'!
testSimpleNestedSuspendParticularAnnouncementWhile
	| announcement |
	announcer
		subscribe: GLMTestAnnouncement
		do: [ :ann | announcement := ann ].
	
	announcement := nil.
	announcer suspendAll: {GLMTestAnnouncement} while: [
		announcer suspendAll: {} while: [ ].
		announcer announce: GLMTestAnnouncement ].
	self assert: announcement isNil! !

!GLMAnnouncerTest methodsFor: 'tests' stamp: 'TudorGirba 3/15/2013 22:07'!
testNestedSuspendAllWhile
	| announcement |
	announcer
		subscribe: GLMTestAnnouncement
		do: [ :ann | announcement := ann ].
	
	announcement := nil.
	announcer suspendAllWhile: [
		announcer suspendAllWhile: [ ].
		announcer announce: GLMTestAnnouncement ].
	self assert: announcement isNil! !

!GLMAnnouncerTest methodsFor: 'tests' stamp: 'TudorGirba 3/15/2013 22:07'!
testSuspendAllWhile
	| announcement instance |
	announcer subscribe: GLMTestAnnouncement do: [ :ann | announcement := ann ].
	announcement := nil.
	instance := announcer announce: GLMTestAnnouncement.
	self assert: announcement equals: instance.
	announcement := nil.
	announcer suspendAllWhile: [ instance := announcer announce: GLMTestAnnouncement ].
	self assert: announcement isNil! !

!GLMAnnouncerTest methodsFor: 'tests' stamp: 'AndreiChis 11/3/2013 12:27'!
testSuspendParticularAnnouncementWhile
	| announcement instance |
	announcer subscribe: GLMTestAnnouncement do: [ :ann | announcement := ann ].
	announcer subscribe: GLMTestAnnouncement2 do: [ :ann | announcement := ann ].
	announcement := nil.
	instance := announcer announce: GLMTestAnnouncement.
	self assert: announcement equals: instance.
	announcement := nil.
	announcer suspendAll: {GLMTestAnnouncement} while: [ instance := announcer announce: GLMTestAnnouncement ].
	self assert: announcement isNil.
	announcement := nil.
	announcer suspendAll: {GLMTestAnnouncement} while: [ instance := announcer announce: Announcement ].
	self assert: announcement isNil.
	announcement := nil.
	announcer suspendAll: {GLMTestAnnouncement} while: [ instance := announcer announce: GLMTestAnnouncement2 ].
	self assert: announcement equals: instance.! !

!GLMAnnouncerTest methodsFor: 'tests' stamp: 'AndreiChis 11/3/2013 12:34'!
testNestedSuspendParticularAnnouncementWhile
	| announcement instance2 announcement2 |
	announcer
		subscribe: GLMTestAnnouncement, GLMTestAnnouncement2
		do: [ :ann | announcement := ann ].
	
	announcement2 := nil.
	announcer suspendAll: {GLMTestAnnouncement} while: [
		announcer suspendAll: {GLMTestAnnouncement2} while: [  
			instance2 := announcer announce: GLMTestAnnouncement.
			announcement2 := announcement.
			announcement := nil. ].
		announcer announce: GLMTestAnnouncement ].
	self assert: announcement isNil.
	self assert: announcement2 equals: instance2.! !

!GLMAnnouncerTest methodsFor: 'running' stamp: 'tg 2/17/2010 23:20'!
setUp
	announcer := GLMAnnouncer new! !

!GLMAnnouncingCollection methodsFor: 'initialization' stamp: 'AndreiChis 8/21/2013 15:17'!
indexOf: anElement

	^ collection indexOf: anElement! !

!GLMAnnouncingCollection methodsFor: 'initialization' stamp: ''!
size
	^ collection size! !

!GLMAnnouncingCollection methodsFor: 'testing' stamp: ''!
isEmpty
	^ collection isEmpty! !

!GLMAnnouncingCollection methodsFor: 'initialization' stamp: ''!
remove: anObject ifAbsent: aBlock

	collection remove: anObject ifAbsent: aBlock.
	self announce: GLMItemRemoved! !

!GLMAnnouncingCollection methodsFor: 'initialization' stamp: ''!
withIndexDo: aBlock

	^collection withIndexDo: aBlock! !

!GLMAnnouncingCollection methodsFor: 'private' stamp: ''!
includes: anObject 
	^collection includes: anObject! !

!GLMAnnouncingCollection methodsFor: 'initialization' stamp: ''!
add: newObject beforeOrLast: oldObject 
	(collection includes: oldObject)
		ifTrue: [ collection add: newObject before: oldObject ]
		ifFalse: [ collection add: newObject ].
	self announce: GLMItemAdded! !

!GLMAnnouncingCollection methodsFor: 'initialization' stamp: ''!
initialize
	super initialize.
	collection := OrderedCollection new! !

!GLMAnnouncingCollection methodsFor: 'initialization' stamp: ''!
at: anObject

	^collection at: anObject! !

!GLMAnnouncingCollection methodsFor: 'initialization' stamp: ''!
add: anObject

	collection add: anObject.
	self announce: GLMItemAdded! !

!GLMAnnouncingCollection methodsFor: 'private' stamp: ''!
collect: aBlock
	^collection collect: aBlock
	! !

!GLMAnnouncingCollection methodsFor: 'initialization' stamp: ''!
do: aBlock

	^collection do: aBlock! !

!GLMAnnouncingCollection methodsFor: 'initialization' stamp: ''!
printString
	^ collection printString ! !

!GLMAnnouncingCollection methodsFor: 'initialization' stamp: ''!
remove: anObject

	collection remove: anObject.
	self announce: GLMItemRemoved! !

!GLMAnnouncingCollection methodsFor: 'initialization' stamp: ''!
add: newObject before: oldObject 

	collection add: newObject before: oldObject.
	self announce: GLMItemAdded! !

!GLMAnnouncingCollection methodsFor: 'initialization' stamp: ''!
removeLast

	collection removeLast.
	self announce: GLMItemRemoved! !

!GLMAnnouncingCollection methodsFor: 'initialization' stamp: ''!
isCollection

	^true! !

!GLMApproximateScrollbarBrick commentStamp: 'AliakseiSyrel 12/6/2014 20:15'!
A GLMApproximateScrollbarBrick can be used only with GLMScrollListBrick or with other lists that uses adaptors.

Approximates the height of band depending on average height of all visible items.
!
!GLMApproximateScrollbarBrick methodsFor: 'scrollbar-calculations' stamp: 'AliakseiSyrel 3/30/2015 12:45'!
approximateBandHeight
	|visible averageItemHeight|
	
	visible := self scrollPane band submorphs select: [ :each | self scrollPane isPartiallyVisible: each ].
	visible isEmpty ifTrue: [ ^ 0 ].
	
	averageItemHeight := (visible inject: 0 into: [ :visibleHeight :each | visibleHeight + each height ]) / visible size.
	^ self scrollPane model count * averageItemHeight.! !

!GLMApproximateScrollbarBrick methodsFor: 'scrollbar-calculations' stamp: 'AliakseiSyrel 3/30/2015 12:45'!
calculateScrollbarHeight
	|bandHeight firstIndex lastIndex |
	bandHeight := self approximateBandHeight.
	bandHeight = 0 ifTrue: [ ^ 0 ].
	self scrollPane isFullyVisible ifTrue: [ ^ 0 ].
	
	firstIndex := self scrollPane getIndex: (self scrollPane band firstSubbrick).
	lastIndex := self scrollPane getIndex: (self scrollPane band lastSubbrick).
	
	^ ((lastIndex - firstIndex + 1) / self scrollPane model count * self height) ceiling.
	! !

!GLMApproximateScrollbarBrick methodsFor: 'scrollbar-calculations' stamp: 'AliakseiSyrel 3/30/2015 12:45'!
calculateScrollbarTopOffset
	|bandHeight firstIndex lastIndex|
	bandHeight := self approximateBandHeight.
	bandHeight = 0 ifTrue: [ ^ 0 ].
	
	firstIndex := self scrollPane getIndex: (self scrollPane band firstSubbrick).
	lastIndex := self scrollPane getIndex: (self scrollPane band lastSubbrick).
	
	^ ((firstIndex-1) / self scrollPane model count * self height) floor.! !

!GLMAsyncTask commentStamp: 'TudorGirba 11/26/2014 15:07'!
This is a utility that: 
- executes a job asynchroniously
- it remembers the process so that it can terminate the job, if needed
- triggers a callback when it's done!
!GLMAsyncTask methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/16/2015 09:56'!
task

	^ task ifNil: [ task := [  ] ]! !

!GLMAsyncTask methodsFor: 'async' stamp: 'AliakseiSyrel 2/14/2015 13:41'!
execute: aBlock withArguments: aCollection callback: callbackBlock priority: aPriority delay: anIntegerMilliseconds
	
	self terminate.
	
	callback := callbackBlock.
	process := [ |result|
		anIntegerMilliseconds > 0 ifTrue: [ anIntegerMilliseconds milliSeconds wait ].
		result := aBlock valueWithEnoughArguments: aCollection.
		"we use it to pass result from background thread and execute callback block in UI thread"
		UIManager default defer: [ self complete: result callback: callbackBlock ]
	]	newProcess.
	
	process priority: aPriority.
	process resume.
		
	^ self! !

!GLMAsyncTask methodsFor: 'async' stamp: 'AliakseiSyrel 2/16/2015 10:02'!
complete: anObject callback: aBlock
	
	process ifNil: [ ^ self terminate ].
	process isTerminated ifFalse: [ "for some cases when we try to return result of wrong process" ^ self ].
	
	callback = aBlock ifFalse: [ ^ self terminate ].
	
	callback ifNotNil: [ callback cull: anObject ].
	process := nil! !

!GLMAsyncTask methodsFor: 'async' stamp: 'AliakseiSyrel 2/17/2015 12:50'!
resume

	process ifNotNil: [ process resume ]! !

!GLMAsyncTask methodsFor: 'async' stamp: 'AliakseiSyrel 2/16/2015 09:48'!
execute: aBlock withArguments: aCollection callback: callbackBlock delay: anIntegerMilliseconds
	"execution happens with UI process priority so that communication with UI can be done in real time"
	
	^ self
		execute: aBlock
		withArguments: aCollection
		callback: callbackBlock
		priority: Processor userSchedulingPriority
		delay: anIntegerMilliseconds! !

!GLMAsyncTask methodsFor: 'async' stamp: 'AliakseiSyrel 2/13/2015 18:47'!
perform: aBlock delay: anInteger

	self
		execute: []
		withArguments: {}
		callback: aBlock
		delay: anInteger! !

!GLMAsyncTask methodsFor: 'async' stamp: 'AliakseiSyrel 2/16/2015 10:02'!
terminate

	process ifNotNil: [ process terminate. process := nil ]! !

!GLMAsyncTask methodsFor: 'scripting' stamp: 'AliakseiSyrel 2/17/2015 12:16'!
execute: anArguments

	^ self
		execute: self task
		withArguments: anArguments
		callback: self callback
		priority: self priority
		delay: self delay! !

!GLMAsyncTask methodsFor: 'scripting' stamp: 'AliakseiSyrel 2/16/2015 10:10'!
arguments: aCollection

	arguments := aCollection! !

!GLMAsyncTask methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/16/2015 09:56'!
delay

	^ delay ifNil: [ delay := 0 ]! !

!GLMAsyncTask methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/17/2015 14:06'!
isTerminated

	process ifNil: [ ^ true ].
	^ process isTerminated! !

!GLMAsyncTask methodsFor: 'scripting' stamp: 'AliakseiSyrel 2/16/2015 09:55'!
onCompleted: aBlock

	callback := aBlock! !

!GLMAsyncTask methodsFor: 'async' stamp: 'AliakseiSyrel 2/16/2015 09:49'!
execute: aBlock withArguments: aCollection callback: callbackBlock
	"execution happens with UI process priority so that communication with UI can be done in real time"
	
	^ self
		execute: aBlock
		withArguments: aCollection
		callback: callbackBlock
		priority: Processor userSchedulingPriority! !

!GLMAsyncTask methodsFor: 'async' stamp: 'AliakseiSyrel 2/17/2015 12:49'!
pause

	process ifNotNil: [ process suspend ]! !

!GLMAsyncTask methodsFor: 'scripting' stamp: 'AliakseiSyrel 2/17/2015 12:16'!
execute

	^ self execute: self arguments! !

!GLMAsyncTask methodsFor: 'scripting' stamp: 'AliakseiSyrel 2/16/2015 09:54'!
delay: anInteger

	delay := anInteger! !

!GLMAsyncTask methodsFor: 'scripting' stamp: 'AliakseiSyrel 2/16/2015 09:54'!
doInBackground: aBlock

	task := aBlock! !

!GLMAsyncTask methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/16/2015 10:10'!
arguments

	^ arguments ifNil: [ arguments := {  } ]! !

!GLMAsyncTask methodsFor: 'async' stamp: 'AliakseiSyrel 2/13/2015 18:50'!
perform: aBlock delay: anInteger priority: aPriority

	self
		execute: []
		withArguments: {}
		callback: aBlock
		priority: aPriority
		delay: anInteger! !

!GLMAsyncTask methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/16/2015 09:58'!
priority

	^ priority ifNil: [ priority := Processor userSchedulingPriority ]! !

!GLMAsyncTask methodsFor: 'async' stamp: 'AliakseiSyrel 2/16/2015 09:48'!
execute: aBlock withArguments: aCollection callback: callbackBlock priority: aPriority
		
	^ self
		execute: aBlock
		withArguments: aCollection
		callback: callbackBlock
		priority: aPriority
		delay: 0! !

!GLMAsyncTask methodsFor: 'scripting' stamp: 'AliakseiSyrel 2/16/2015 09:57'!
priority: anInteger

	priority := anInteger! !

!GLMAsyncTask methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/16/2015 09:56'!
callback

	^ callback ifNil: [ callback := [  ] ]! !

!GLMBandBrick commentStamp: 'AliakseiSyrel 3/22/2015 11:35'!
A GLMBandBrick is a simple Brick with height that shrinks to wrap subbricks.
Usually used within scroll panes!
!GLMBandBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/8/2015 17:39'!
initialize
	super initialize.
	
	self
		useVerticalLinearLayout;
		vShrinkWrap! !

!GLMBandBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:39'!
exampleOpen
	
	self gtExample openInBrickWindowLabeled: 'Band example'! !

!GLMBandBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:19'!
gtExample
	<gtExample: 'Example with subbricks'>
	
	^ self new
		hSpaceFill;
		vSpaceFill;
		with: [ :b | |count|
			count := 10.
			1 to: count do: [ :index | 
				b addBrickBack: (
					GLMLabelBrick new
						text: (index asString, ' of ', count asString);
						textPosition: #center;
						color: Color random muchLighter;
						height: 40;
						hSpaceFill ) ] ]! !

!GLMBasicExamples commentStamp: '<historical>'!
self open!
!GLMBasicExamples methodsFor: 'browsers' stamp: 'TudorGirba 5/19/2012 09:12'!
dashboard

	<glmBrowser: 'Dashboard' input: '42'>
	"self new dashboard openOn: 42"
	
	|tmpBrowser|
	tmpBrowser := GLMDashboard new.
	tmpBrowser addPaneNamed: #first.
	tmpBrowser addPaneNamed: #second.
	tmpBrowser addPaneNamed: #third.
	tmpBrowser addPaneNamed: #fourth.
	tmpBrowser addPaneNamed: #fifth.
	
	tmpBrowser transmit to: #first; andShow: [:a |
		a list
			display: [:i | #(a b c d e f g)];
			yourself
		].
	tmpBrowser transmit to: #second; andShow: [:a |
		a list
			display: [:i | #(a b c d e f g)]
		].
	tmpBrowser transmit to: #third; andShow: [:a |
		a list
			display: [:i | #(a b c d e f g)]
		].
	tmpBrowser transmit to: #fourth; andShow: [:a |
		a list
			display: [:i | #(a b c d e f g)]
		].
	tmpBrowser transmit to: #fifth; andShow: [:a |
		a list
			display: [:i | #(a b c d e f g h i j k l m n o p q r s t u v w x y z)]
		].
	^ tmpBrowser! !

!GLMBasicExamples methodsFor: 'tabs examples' stamp: 'TudorGirba 11/1/2013 23:33'!
tabsWithDifferentActions
	<glmBrowser: 'Tabs with different actions' input: '42'>
	"self new tabsWithDifferentActions openOn: 42"
	
	| browser |
	browser := GLMTabulator new.
	browser column: #one.
	browser transmit to: #one; andShow: [:a | 
		a text
			display: 'Tab with multiple actions. Switch between tabs to check the toolbars on the right';
			title: 'Tab with multiple actions';
			act: [:x | x inspect] icon: GLMUIThemeExtraIcons glamorousInspect entitled: 'Inspect with icon';
			act: [:x | x printString inspect] icon: GLMUIThemeExtraIcons glamorousBrowse entitled: 'Print it and inspect with icon';
			act: [:x | x inspect] entitled: 'Inspect without icon';
			act: [:x | x printString inspect] entitled: 'Print it and inspect without icon'.
		a text 
			display: 'Tab without actions. Switch between tabs to check the toolbars on the right';
			title: 'Tab without actions' ].
	^ browser! !

!GLMBasicExamples methodsFor: 'actions examples' stamp: ''!
spawnBrowserSelectionActions
	<glmBrowser: 'Spawn browser selection actions' input: '#(1 2 3 4)'>
	"self new spawnBrowserSelectionActions openOn: #(1 2 3 4)"
	|browser |
	browser := GLMTabulator new.
	browser column: #one.
	browser transmit to: #one; andShow: [ :a |
		a list
			title: 'Example';
			selectionSpawn: [:listPresentation |
				|tmpBrowser|
				tmpBrowser := GLMTabulator new row: #one; initialExtent: 100@100 ;yourself.
				tmpBrowser
					transmit to: #one ; andShow: [:b |
						b text
							display: [:input | input asString]
						].
				tmpBrowser startOn: listPresentation selection
				] entitled: 'Open in new browser'
			].
	^ browser! !

!GLMBasicExamples methodsFor: 'text' stamp: 'AnneEtien 11/29/2013 15:18'!
textSelection
	<glmBrowser: 'Text selection' input: '(1 to: 100)'>
	"	|browser |
		browser := self new textSelection.
		browser openOn: (1 to: 100).
		((browser paneNamed: #start) port: #selection) value: 2.
		((browser paneNamed: #end) port: #selection) value: 5.		
	"
	| browser |
	browser := GLMTabulator new.
	browser row: [ :r | r column: #start; column: #end ]; row: #text.
	browser transmit to: #start; andShow: [ :a | a list title: 'Start' ].
	browser transmit to: #end; andShow: [ :a | a list title: 'End' ].
	browser transmit to: #text; andShow: [ :a | 
		a text 
			title: 'Text with selection';
			display: 'some piece of text to test the selection interval on.'].
	browser transmit to: #text->#selectionInterval; from: #start; from: #end; when: [:s :e |  s notNil and: [ e notNil ]] ; transformed: [ :s :e | s to: e ].
"	browser transmit to: #start->#selection; from: #text->#selectionInterval; transformed: [:interval | interval first].
	browser transmit to: #end->#selection; from: #text->#selectionInterval; transformed: [:interval | interval last].
"	^ browser! !

!GLMBasicExamples methodsFor: 'browsers' stamp: 'TudorGirba 5/19/2012 09:13'!
validatorDynamic
	<glmBrowser: 'Dynamic validator' input: '42'>
	"self new validatorDynamic openOn: 42"

	| finder validator |
	finder := GLMFinder new.
	validator := GLMValidator new.
	validator validator: 'Ok' act: [:x | ].
	validator show: [:a | 
		a dynamic display: [:x |
			GLMListPresentation new display: [:y | 1 to: y]
			] ].
	finder show: [:a | a custom: validator].
	^ finder! !

!GLMBasicExamples methodsFor: 'explicit selection' stamp: ''!
multiInitialSelection
	"
		| browser |
		browser := self new multiInitialSelection.
		browser openOn: 5.
		(browser panes first port: #selection) value: #(2 5 3).
	"
	|browser |

	browser := GLMTabulator new.
	browser column: #one; column: #two.
	browser transmit to: #one; andShow: [ :a |
		a tree
			beMultiple;
			display: [:x | 1 to: x * 3]].
	browser transmit to: #two; from: #one; andShow: [ :a |
		a list ].
	^ browser! !

!GLMBasicExamples methodsFor: 'explicit selection' stamp: ''!
treeWithTagsMoreLevels
	<glmBrowser: 'Tree withTags more levels' input: '(1 to: 10)'>
	"
		self new treeWithTagsMoreLevels openOn: #(1 2 3 4 5 6 7 8 9 10)
	"
	|browser model|
	model := Dictionary new.
	model at: #some put: #(1 2 3 4).
	model at: #even put: #(2 6 8).
	model at: #odd put: #(3 7 9).
	
	browser := GLMTabulator new.
	browser column: #one.
	browser transmit to: #one; andShow: [ :a |
		a tree
			display: [model keys];
			children: [:child | child isSymbol
								ifTrue: [Array with: ((model at: child) select: [:c | c < 4]) with: ((model at: child) select: [:c | c >= 4])]
								ifFalse: [child isCollection
											ifTrue: [child]
											ifFalse: [#()]]];
			tags: [:item | Array streamContents: [:stream |
					item isNumber ifTrue: [
						stream nextPut: (item even ifTrue: ['even'] ifFalse: ['odd']).
						stream nextPut: (item < 4 ifTrue: ['<4'] ifFalse: ['>=4' ])]]]].  
	^ browser! !

!GLMBasicExamples methodsFor: 'others' stamp: ''!
taggedTree
	"self new taggedTree openOn: #(1 2 3 4 5)"
	|browser |

	browser := GLMTabulator new.
	browser column: #one; column: #two.
	browser transmit to: #one; andShow: [ :a |
		a tree
			tags: [:each | 
				{each even ifTrue: ['even'] ifFalse: ['odd'].
				each even ifTrue: ['x'] ifFalse: ['y']}
				]].
	browser transmit to: #two; from: #one; andShow: [ :a |
		a text
			display: [:x | 'You have selected ', x printString ]].
	^ browser! !

!GLMBasicExamples methodsFor: 'table' stamp: 'TudorGirba 6/7/2013 13:03'!
tableWithCustomWidth
	<glmBrowser: 'Table with custom width' input: '100'>
	"self new tableWithCustomWidth openOn: 100"
	| wrapper textBlock |	
	wrapper := GLMWrapper new.
	textBlock := [:x | (1 to: x) inject: '' into: [ :s :each | s, each asString]].
	wrapper show: [:a | 
		a table
			display: [ :x | 1 to: x ]; 
			column: 'Large column' evaluated: textBlock width: 400;
			column: 'Small column' evaluated: textBlock width: 50;
			column: 'Default column' evaluated: textBlock;
			column: 'Last column' evaluated: textBlock ].
	^ wrapper! !

!GLMBasicExamples methodsFor: 'explicit selection' stamp: ''!
treeWithTags
	<glmBrowser: 'Tree withTags' input: '(1 to: 10)'>
	"
		self new treeWithTags openOn: #(1 2 3 4 5 6 7 8 9 10)
	"
	|browser model|
	model := Dictionary new.
	model at: #some put: #(1 2 3 4).
	model at: #even put: #(2 6 8).
	model at: #odd put: #(3 7 9).
	
	browser := GLMTabulator new.
	browser column: #one.
	browser transmit to: #one; andShow: [ :a |
		a tree
			display: [model keys];  
			children: [:key | key isNumber ifFalse: [model at: key] ];
			tags: [:item | item isNumber ifTrue: [item even ifTrue: [#('even')] ifFalse: [#('odd')]] ifFalse: [#()]]].  
	^ browser! !

!GLMBasicExamples methodsFor: 'browsers' stamp: 'TudorGirba 5/19/2012 09:12'!
validator
	<glmBrowser: 'Validator' input: '42'>
	"self new validator openOn: 42"

	| finder validator |
	finder := GLMFinder new.
	validator := GLMValidator new.
	validator validator: 'Ok' act: [:x | ].
	validator show: [:a | a list display: [:x | 1 to: x ]].
	finder show: [:a | a custom: validator].
	^ finder! !

!GLMBasicExamples methodsFor: 'explicit selection' stamp: ''!
listsWithUpdatedSelection
	"self new listsWithUpdatedSelection openOn: 10"
	<glmBrowser: 'Updated selection' input: '10'>
	| browser |
	browser := GLMTabulator new.
	browser column: #one; column: #two; column: #three.
	browser transmit to: #one; andShow: [ :a | 
		a tree
			display: [:x | 1 to: x ]].
	browser transmit to: #two; andShow: [ :a | 
		a tree
			display: [:x | 1 to: x + 2 ]].
	browser transmit to: #three; andShow: [ :a |
		a tree
			beMultiple;
			display: [:x | 1 to: x ]].
	browser transmit to: #two port: #selection; from: #one; transformed: [:x | x + 2].
	browser transmit to: #one port: #selection; from: #two; transformed: [:x | x - 2].
	browser transmit to: #three port: #selection; from: #two; transformed: [:x | (1 to: (x - 2)) ].
	^ browser! !

!GLMBasicExamples methodsFor: 'others' stamp: ''!
doubleClick
	"self new doubleClick openOn: 100"

	<glmBrowser: 'Double click' input: '100'>
	| browser |
	browser := GLMTabulator new.
	browser
		column: #one;
		column: #two.
	browser
		transmit to: #one;
		andShow: [ :a | 
			a table display: [ :x | 1 to: x ]; 
				column: 'value' evaluated: #asString; 
				column: 'odd' evaluated: [:each | each odd asString ]].
	browser
		transmit to: #two;
		from: #one port: #strongSelection;
		andShow: [:a |  a list display: [ :x | 1 to: x ] ].
	^ browser! !

!GLMBasicExamples methodsFor: 'searching and filtering' stamp: 'AndreHora 2/14/2014 16:41'!
multipleFinderWithFilterAndSearch
	<glmBrowser: 'Search' input: '$a to: $z'>
	"self new multipleFinderWithFilterAndSearch openOn: (1 to: 100)"

	| finder |	
	finder := GLMFinder new.
	finder show: [:a | 
		a list
			beMultiple;
			title: 'Simple';
			dynamicActions: [:list | self actionsFor: list].
		a list
			title: 'With filter';
			beMultiple;
			dynamicActions: [:list | self actionsFor: list];
			filterOn: [:text :each | (Smalltalk evaluate: '[:each | ', text, ']') value: each];
			helpMessage:  'Enter a filtering request (e.g., "each > 10")'.
		a list
			title: 'With search';
			beMultiple;
			dynamicActions: [:list | self actionsFor: list];
			searchOn: [:text :each | (Smalltalk evaluate: '[:each | ', text, ']') value: each];
			helpMessage:  'Enter a search request (e.g., "each > 10")' ].
	^ finder ! !

!GLMBasicExamples methodsFor: 'text' stamp: 'AndreHora 2/14/2014 16:41'!
smalltalkCode
	<glmBrowser: 'Smalltalk code' input: '''"Enter some Smalltalk code and then accept to preview the result."'''>
	"self new smalltalkCode openOn: ''"
	| browser |
	browser := GLMTabulator new.
	browser row: #code span: 2; row: #preview.
	browser transmit to: #code; andShow: [ :a | 
		a smalltalkCode 
			title: 'Smalltalk Code';
			populate: #acceptedCode icon: GLMUIThemeExtraIcons glamorousAccept on: $s entitled: 'Accept' with: [:text | text text ] ].
	browser transmit from: #code port: #acceptedCode; to: #preview; andShow: [ :a | 
		a text 
			title: 'Evaluated result';
			display: [:code | [Smalltalk evaluate: code ] on: Error do: ['Error']];
			act: [:text | text displayValue explore] icon: GLMUIThemeExtraIcons glamorousInspect entitled: 'Explore' ].
	^ browser! !

!GLMBasicExamples methodsFor: 'composite' stamp: 'StephanEggermont 9/19/2014 15:56'!
textAttributes
	"self new textAttributes openOn: 1"
	<glmBrowser: 'Text attributes' input: '1'>	
	| browser |
	browser := GLMTabulator new.
	browser row: #list.
	browser transmit to: #list; andShow: [ :a |
		a text
			format: [ :x | ('Title' asText) 
				makeColor: Color blue from: 2 to: 4; 
				makeColor: Color red from: 4 to: 5; "notice overlap"
				addAttribute: (TextFontReference toFont: (LogicalFont familyName: 'Open Sans' pointSize: 36)) from: 1 to: 1; "ignored when font family cannot be found"
				yourself.]].
	^ browser ! !

!GLMBasicExamples methodsFor: 'others' stamp: ''!
fixSizePanes
	<glmBrowser: 'Fix size pane' input: '5'>
	"self new fixSizePanes openOn: 1"
	| browser |
	browser := GLMTabulator new.
	browser row: #variable; row: #fix size: 20.
	browser transmit to: #fix; andShow: [ :a | a label display: 'Fix size'].
	browser transmit to: #variable; andShow: [ :a | a text display: 'Variable size'].
	^ browser ! !

!GLMBasicExamples methodsFor: 'others' stamp: ''!
allowNil
	<glmBrowser: 'Allowing nil' input: '42'>
	"self new allowNil openOn: 42"
	| browser | 
	browser := GLMTabulator new.
	browser 
		column: [: c | c row: #one; row: #two];
		column: #details.
	browser transmit to: #one; andShow: [ :a |
		a tree 
			display: #(1 2 3);
			allowDeselection ].
	browser transmit to: #two; andShow: [ :a | 
		a tree 
			display: #(a b c);
			allowDeselection].
	browser transmit to: #details; from: #one; from: #two; andShow: [ :a | 
		a text 
			display: [ :one :two | one asString, two asString];
			allowNil ].
	^ browser! !

!GLMBasicExamples methodsFor: 'text' stamp: 'TudorGirba 1/20/2013 08:26'!
populatePortActionsWithDifferentTargets
	<glmBrowser: 'Populate port action with different targets' input: '$a to: $z'>
	"self new populatePortActionsWithDifferentTargets openOn: ($a to: $z)"
	| composer |
	composer := GLMCompositePresentation new.
	composer tabulator with: [:t | 
		t column: #index; column: [:c | c row: #recepient1; row: #recepient2].
		t transmit to: #index; andShow: [:a | 
			a list 
				selectionAct: [:list | (list pane port: #custom1) value: list selection ] on: $1 entitled: 'To recepient 1';
				selectionPopulate: #custom2 on: $2 entitled: 'To recepient 2' with: [:list | list selection ] ].
		t transmit from: #index port: #custom1; to: #recepient1; andShow: [:a | 
			a text title: 'Recepient 1'].
		t transmit from: #index port: #custom2; to: #recepient2; andShow: [:a | 
			a text title: 'Recepient 2'].
	].
	^ composer! !

!GLMBasicExamples methodsFor: 'explicit selection' stamp: ''!
singleInitialSelection
	"
		| browser |
		browser := self new singleInitialSelection.
		browser openOn: 5.
		(browser panes first port: #selection) value: 3.
	"
	|browser |

	browser := GLMTabulator new.
	browser column: #one; column: #two.
	browser transmit to: #one; andShow: [ :a |
		a tree
			display: [:x | 1 to: x];
			format: [:number | Text string: number printString attribute: TextColor red]].
	browser transmit to: #two; from: #one; andShow: [ :a |
		a list
			display: [:x | 1 to: x * 2]].
	^ browser! !

!GLMBasicExamples methodsFor: 'actions examples' stamp: ''!
tableWithIcons
	<glmBrowser: 'Icons' input: '($A to: $z)'>
	"self new tableWithIcons openOn: ($A to: $z)"
	|browser |
	browser := GLMTabulator new.
	browser column: #one; column: #two.
	browser transmit to: #one; andShow: [ :a |
		a act: [:presentation | presentation inspect] entitled: 'Inspect'. 
		a table
			title: 'Table with actions';
			act: [:presentation | presentation inspect] entitled: 'Inspect'; 
			column: 'Character' evaluated: [ :each | each asString ];
			column: 'ASCII' evaluated: [ :each | each asInteger printString ];
			selectionAct: [:tree | tree selection inspect ] on: $i entitled: 'Inspect';
			icon: [:each | each asInteger odd 
						ifTrue: [ GLMUIThemeExtraIcons glamorousRedCircle ] 
						ifFalse: [ GLMUIThemeExtraIcons glamorousGreenCircle ] ]].
	browser transmit to: #two; from: #one; andShow: [:a | a text ].
	^ browser! !

!GLMBasicExamples methodsFor: 'others' stamp: ''!
treeWithExpansion
	<glmBrowser: 'Tree with expansion' input: '#(($a $b $c $d) ($e $f) ($g $h $i $j ($l $m $n)))'>
	"self new treeWithExpansion openOn: #(($a $b $c $d) ($e $f) ($g $h $i $j ($l $m $n)))"
	|browser |
	browser := GLMTabulator new.
	browser column: #one; column: #two.
	browser transmit to: #one; andShow: [:a |
		a tree
			title: 'No expansion';
			children: [:x :i | x asString size > 1 ifTrue: [x] ifFalse: [OrderedCollection new] ].
		a tree
			title: 'Roots expanded';
			rootsExpanded;
			children: [:x :i | x asString size > 1 ifTrue: [x] ifFalse: [OrderedCollection new] ].
		a tree
			title: 'All expanded';
			allExpanded;
			children: [:x :i | x asString size > 1 ifTrue: [x] ifFalse: [OrderedCollection new] ] ].
	browser transmit to: #two; from: #one; andShow: [ :a | a text ].
	^ browser! !

!GLMBasicExamples methodsFor: 'actions examples' stamp: 'TudorGirba 11/28/2012 22:52'!
browserWithToolbar
	<glmBrowser: 'Toolbar' input: '''Browser with toolbar'''>
	"self new browserWithToolbar openOn: 'Browser with toolbar'"

	| wrapper |
	wrapper := GLMWrapper new.
	wrapper act: [:f | f inspect] icon: GLMUIThemeExtraIcons glamorousInspect on: $i entitled: 'Inspect with icon'.
	wrapper act: [:f | f inspect] on: $i entitled: 'Inspect without icon'.
	wrapper show: [:a | a text ].
	^ wrapper! !

!GLMBasicExamples methodsFor: 'actionlist' stamp: ''!
simpleActionList
	<glmBrowser: 'Action list' input: '#(1 2 3)'>	
	"self new simpleActionList openOn: #(1 2 3)"
	| browser |
	browser := GLMTabulator new.
	browser column: #one.
	browser transmit to: #one; andShow: [ :a |
		a actionList
			act: [:entity | entity inspect ] entitled: 'Inspect';
			act: [:entity | entity explore ] entitled: 'Explore'].
	^ browser! !

!GLMBasicExamples methodsFor: 'explicit selection' stamp: ''!
dropDownListWithInitialValue
	"self new dropDownListWithInitialValue openOn: 5"

	<glmBrowser: 'Drop-down with initial value' input: '5'>
	|browser |

	browser := GLMTabulator new.
	browser row: #one  size: 30; row: #two.
	browser transmit to: #one; andShow: [:a |
		a dropDownList
			display: [:x | (1 to: x) + 10 ];
			selectedIndex: 2 ].
	browser transmit from: #one; to: #two; andShow: [:a |
		a list
			display: [:x | 1 to: x ]].
	^ browser! !

!GLMBasicExamples methodsFor: 'table' stamp: 'AndreiChis 4/20/2014 20:04'!
simpleTableWithTags
	<glmBrowser: 'Table with tags' input: '1 to: 20'>
	"
	self new simpleTableWithTags openOn: (1 to: 20)
	"
	|browser|
	browser := GLMTabulator new.
	browser row: #row.

	browser transmit to: #row; andShow: [ :composite |
		composite table
			column: 'Base 8' 
				evaluated: [ :each | each printStringBase: 8 ] 
				tags: [:item | 
					Array streamContents: [:stream |
						item isNumber ifTrue: [
							stream nextPut: (item even ifTrue: ['even'] ifFalse: ['odd']).
							stream nextPut: (item < 3 ifTrue: ['<3'] ifFalse: ['>=3' ]) ] ] ];
			column: 'Base 10' 
				evaluated: [ :each | each asString ] 
				tags: [:item | 
					Array streamContents: [:stream |
						item isNumber ifTrue: [
							stream nextPut: (item even ifTrue: ['even'] ifFalse: ['odd']).
							stream nextPut: (item < 9 ifTrue: ['<9'] ifFalse: ['>=9' ])] ] ];
			column: 'Base 16' 
				evaluated: [ :each | each printStringBase: 16 ]
				tags: [:item | 
					Array streamContents: [:stream |
						item isNumber ifTrue: [
							stream nextPut: (item < 4 ifTrue: ['<4'] ifFalse: ['>=4' ]).
							stream nextPut: (item < 7 ifTrue: ['<7'] ifFalse: ['>=7' ])] ] ] ].
	^ browser! !

!GLMBasicExamples methodsFor: 'browsers' stamp: 'StephanEggermont 9/19/2014 11:39'!
wizard
	"<glmBrowser: 'Wizard' input: '100'>"
	"self new wizard inspect openOn: 100"

	| wizard |
	self flag: 'this example does not work in the example browser'.
	wizard := GLMWizard new.
	(wizard genericStep: #step)
		show: [:a | 
			a list
				display: [:list | 1 to: 100] ];
		name: 'Wizard pane';
		size: 2.
	^ wizard! !

!GLMBasicExamples methodsFor: 'tabs examples' stamp: ''!
tabsWithDifferentLabels
	<glmBrowser: 'Tabs with different labels' input: '1'>
	"self new tabsWithDifferentLabels openOn: 1"
	
	| finder |
	finder := GLMFinder new.
	(1 to: 3) do: [:i | 
		finder show: [:a | 
			a text
				title: i printString;
				display: [:x | i printString].
			a text
				titleIcon: GLMUIThemeExtraIcons glamorousBrowse;
				display: [:x | i printString] ]
	].
	
	^ finder! !

!GLMBasicExamples methodsFor: 'others' stamp: ''!
threeInterdependentPanes
	"self new threeInterdependentPanes openOn: 5"

	<glmBrowser: 'Three inter-dependent panes' input: '5'>
	| browser |
	browser := GLMTabulator new.
	browser
		column: #one;
		column: #two;
		column: #three.
	(browser transmit)
		to: #one;
		andShow: [ :a | a tree display: [ :x | 1 to: x ] ].
	(browser transmit)
		to: #two;
		from: #one;
		andShow: [ :a | a tree display: [ :x | 1 to: x * 2 ] ].
	(browser transmit)
		to: #three;
		from: #two;
		andShow: [ :a | 
					(a tree)
						display: [ :x | 1 to: x * 3 ];
						populate: #focus
							on: $f
							entitled: 'Focus'
							with: [ :list | list selection ] ].
	(browser transmit)
		toOutsidePort: #focus;
		from: #three port: #focus.
	(browser transmit)
		to: #one port: #selection;
		fromOutsidePort: #focus.
	(browser transmit)
		to: #two port: #selection;
		fromOutsidePort: #focus.
	^ browser! !

!GLMBasicExamples methodsFor: 'explicit selection' stamp: 'TudorGirba 5/29/2012 23:12'!
treeWithInitialSelection
	"
		| browser |
		browser := self new treeWithInitialSelection. 
		browser openOn: {
			#first->{$a->{}. $c->{}. $d->{}}.
			#second->{$e->{}. $f->{}}. 
			#third->{$h->{}}
		}.
		(browser panes first port: #selection) value: (browser panes first port: #entity) value first value first.
	"

	| browser |
	browser := GLMTabulator new.
	browser
		column: #one;
		column: [ :c | 
					c
						row: #two;
						row: #three ].
	(browser transmit)
		to: #one;
		andShow: [ :a | 
					(a tree)
						title: 'first tree';
						children: [ :x | x value ].
					(a tree)
						title: 'second tree';
						children: [ :x | x value ] ].
	(browser transmit)
		to: #two;
		from: #one;
		andShow: [ :a | a text title: 'Selection preview' ].
	(browser transmit)
		to: #three;
		from: #one port: #selectionPath;
		andShow: [ :a | a text title: 'Selection path preview' ].
	^ browser! !

!GLMBasicExamples methodsFor: 'text' stamp: ''!
populatePortAction
	<glmBrowser: 'Populate port action' input: 'String withAll: ''Select a piece of text and open on the next pane via the contextual menu or by pressing Modifier+o. Otherwise just open the complete copy of the current text on the next pane via the menu or by pressing Modifier+l.'''>
	"self new populatePortAction openOn: 'Select a piece of text and open on the next pane either with the overall button, or via the context menu'"
	| browser |
	browser := GLMFinder new.
	browser show: [:a | a text
		selectionPopulate: #selection on: $o entitled: 'Open selection on next pane' with: [:text | text selectedText ];
		populate: #selection icon: GLMUIThemeExtraIcons glamorousRight on: $l entitled: 'Open complete text on next pane' with: [:text | text text ]].
	^ browser ! !

!GLMBasicExamples methodsFor: 'browsers' stamp: 'TudorGirba 5/19/2012 09:12'!
dashboardsInDashboard

	<glmBrowser: 'Dashboards in dashboard' input: '42'>
	"self new dashboard openOn: 42"
	
	|tmpBrowser|
	tmpBrowser := GLMDashboard new.
	tmpBrowser addPaneNamed: #dashboard.
	tmpBrowser addPaneNamed: #second.
	tmpBrowser addPaneNamed: #third.
	
	tmpBrowser transmit to: #dashboard; andShow: [:a |
		a custom: (self dashboard)
		].
	tmpBrowser transmit to: #second; andShow: [:a |
		a custom: (self dashboard)
		].
	tmpBrowser transmit to: #third; andShow: [:a |
		a custom: (self dashboard)
		].
	^ tmpBrowser! !

!GLMBasicExamples methodsFor: 'browsers' stamp: 'TudorGirba 5/19/2012 09:12'!
dashboardWithSpecificExtents

	<glmBrowser: 'Dashboard specifying extents' input: '42'>
	"self new dashboardWithSpecificExtents openOn: 42"
	
	|tmpBrowser|
	tmpBrowser := GLMDashboard new.
	tmpBrowser rigidStrategy.
	tmpBrowser addPaneNamed: #first extent: 300@200.
	tmpBrowser addPaneNamed: #second extent: 200@200.
	tmpBrowser addPaneNamed: #third extent: 200@300.
	tmpBrowser addPaneNamed: #fourth extent: 300@300.
	tmpBrowser addPaneNamed: #fifth extent: 150@350.
	
	tmpBrowser transmit to: #first; andShow: [:a |
		a list
			display: [:i | #(a b c d e)];
			yourself
		].
	tmpBrowser transmit to: #second; andShow: [:a |
		a list
			display: [:i | #(a b c d e)]
		].
	tmpBrowser transmit to: #third; andShow: [:a |
		a list
			display: [:i | #(a b c d e)]
		].
	tmpBrowser transmit to: #fourth; andShow: [:a |
		a list
			display: [:i | #(a b c d e)]
		].
	tmpBrowser transmit to: #fifth; andShow: [:a |
		a list
			display: [:i | #(a b c d e)]
		].
	^ tmpBrowser! !

!GLMBasicExamples methodsFor: 'explicit selection' stamp: ''!
dropDownList
	"self new dropDownList openOn: 5"

	<glmBrowser: 'Drop-down' input: '5'>
	|browser |

	browser := GLMTabulator new.
	browser row: #one size: 30; row: #two.
	browser transmit to: #one; andShow: [:a |
		a dropDownList
			display: [:x | 1 to: x ];
			format: [:number | Text string: number printString attribute: TextColor red]].
	browser transmit from: #one; to: #two; andShow: [:a |
		a list
			display: [:x | 1 to: x * 2]].
	^ browser! !

!GLMBasicExamples methodsFor: 'others' stamp: 'TudorGirba 11/1/2013 23:31'!
compoundTaggedTree
	<glmBrowser: 'Tags' input: '#(window help home)'>
	"self new compoundTaggedTree openOn: #(window help home)"
	|browser |
	browser := GLMTabulator new.
	browser column: #one.
	browser transmit to: #one; andShow: [ :a | 
		a tree
			title: 'Combined Tags';
			tags: [:each | { {ThemeIcons current perform: (each, 'Icon') asSymbol . each asString }}].
		a tree
			title: 'Image Tags';
			tags: [:each | { ThemeIcons current perform: (each, 'Icon') asSymbol}].
		a tree
			title: 'Combined Tags - Filter by image';
			tags: [:each | 
				{ each == #help 
						ifTrue:[ {ThemeIcons current smallDeleteIcon . 'no ok' } ] 
						ifFalse:[ {ThemeIcons current smallOkIcon . each asString } ]} ];
			tagsFilter: [:each | 
				{ each == #help 
						ifTrue:[ ThemeIcons current smallDeleteIcon ] ifFalse:[ ThemeIcons current smallOkIcon ] } ].
		a tree
			title: 'Combined Tags - Filter by label';
			tags: [:each | 
				{ {ThemeIcons current perform: (each, 'Icon') asSymbol.
					each == #help ifTrue:[ 'no ok' ] ifFalse:[ 'ok' ]}} ];
			tagsFilter: [:each | 
				{ each == #help ifTrue:[ 'no ok' ] ifFalse:[ 'ok' ] } ] ].
	^ browser! !

!GLMBasicExamples methodsFor: 'drag and drop' stamp: ''!
listDragAndDrop
	"self new listDragAndDrop openOn: (1 to: 5) asOrderedCollection"
	| browser |
	browser := GLMTabulator new.
	browser column: #source; column: #target.
	browser transmit to: #source; andShow: [:a | 
		a list 
			title: 'Source';
			display: (1 to: 10);
			allowItemDrag: [:item :list | true ];
			transformDraggedItem: [:item :list | item + 100 ]
			].
	browser transmit to: #target; andShow: [:a |  
		a list
			title: 'Target'; 
			display: [:collection | collection ];
			allowDropOnItem: [:draggedObject :targetItem :list | draggedObject isNumber ];
			dropOnItem: [:draggedObject :targetItem :list | 
				list entity addLast: (targetItem + draggedObject).
				list update.
				true ]
			].
	^ browser! !

!GLMBasicExamples methodsFor: 'actions examples' stamp: ''!
spawnBrowserActions
	<glmBrowser: 'Spawn browser actions' input: '#(1 2 3 4)'>
	"self new spawnBrowserActions openOn: #(1 2 3 4)"
	|browser |
	browser := GLMTabulator new.
	browser column: #one.
	browser transmit to: #one; andShow: [ :a |
		a list
			title: 'Example'.
			].
	browser spawn: [:presentation |
				|tmpBrowser|
				tmpBrowser := GLMTabulator new row: #one; initialExtent: 200@200 ;yourself.
				tmpBrowser
					transmit to: #one ; andShow: [:b |
						b text
							display: [:input | input asString]
						].
				tmpBrowser startOn: presentation entity
				] entitled: 'Open in new browser'.
	^ browser! !

!GLMBasicExamples methodsFor: 'others' stamp: ''!
simpleExpander
	<glmBrowser: 'Simple Expander' input: '#(a b c)'>
	"self new simpleExpander  openOn: #(a b c)"
	| browser |
	browser := GLMExpander new.
	browser show: [ :a | 
		a title: [:x | x ].
		a text title: 'text1'. 
		a text title: 'text2'.].
	^ browser! !

!GLMBasicExamples methodsFor: 'others' stamp: 'TudorGirba 1/9/2014 15:19'!
morphWithCustomInteraction
	<glmBrowser: 'Morph with custom interaction' input: '42'>
	"self new morphWithCustomInteraction openOn: 42"
	^ GLMCompositePresentation new tabulator with: [ :tabulator |
		tabulator column: #morph; column: #preview.
		tabulator transmit to: #morph; andShow: [ :composite |
			composite morph 
				morph:[:morphPresentation |
					| button |
					(button := SimpleButtonMorph new)
						on: #mouseUp send: #value to: [morphPresentation selection: 'You just clicked'];
						label: 'I am a button. Please click me';
						yourself.
					]
			].
		tabulator transmit from: #morph; to: #preview; andShow: [ :a | a text ] ]! !

!GLMBasicExamples methodsFor: 'browsers' stamp: 'TudorGirba 10/30/2012 19:33'!
finderWithDifferentFirstPresentation
	<glmBrowser: 'Finder with different first presentation' input: '1 to: 42'>
	"self new finderWithDifferentFirstPresentation openOn: (1 to: 42)"
	| finder |	
	finder := GLMFinder new.
	finder with: [:f |
		f
			showFirst: [:a | a list]; 
			show: [:a | a list display: [:x | 1 to: x]
			]].
	^ finder! !

!GLMBasicExamples methodsFor: 'private' stamp: ''!
actionsFor: aPresentation 
	|actions|
	aPresentation isMultiple 
							ifTrue: [actions := (aPresentation selection) ifNil: [OrderedCollection new]]
							ifFalse: [actions := OrderedCollection with: aPresentation selection ].
	^ actions collect: [:i |
					(GLMGenericAction new) 
						action: [:each | self inform: 'Menu - Item', i printString]; 
						title: 'Menu - Item', i printString; 
						yourself ]! !

!GLMBasicExamples methodsFor: 'others' stamp: ''!
stacker
	<glmBrowser: 'Stacker' input: '5'>
	"self new stacker openOn: 5"
	
	| browser |
	browser := GLMStacker new.
	browser aPane: #x; aPane: #y.
	browser transmit to: #x; andShow: [ :a | 
		a title: 'x'.
		a list display: [:x | 1 to: x ]].
	browser transmit to: #y; andShow: [:a | 
		a title: '10 * x'.
		a list display: [:x |  1 to: (10*x )] ].
	^ browser ! !

!GLMBasicExamples methodsFor: 'explicit selection' stamp: ''!
listsInDashboardWithUpdatedSelection
	"self new listsInDashboardWithUpdatedSelection openOn: 10"
	<glmBrowser: 'Updated selection in dashboard' input: '10'>
	| browser |
	browser := GLMDashboard new.
	browser addPaneNamed: #one; addPaneNamed: #two; addPaneNamed: #three.
	browser transmit to: #one; andShow: [ :a | 
		a tree
			display: [:x | 1 to: x ]].
	browser transmit to: #two; andShow: [ :a | 
		a tree
			display: [:x | 1 to: x + 2 ]].
	browser transmit to: #three; andShow: [ :a |
		a tree
			beMultiple;
			display: [:x | 1 to: x ]].
	browser transmit to: #two port: #selection; from: #one; transformed: [:x | x + 2].
	browser transmit to: #one port: #selection; from: #two; transformed: [:x | x - 2].
	browser transmit to: #three port: #selection; from: #two; transformed: [:x | (1 to: (x - 2)) ].
	^ browser! !

!GLMBasicExamples methodsFor: 'others' stamp: ''!
interdependentPanes
	<glmBrowser: 'Two inter-dependent panes' input: '5'>
	"self new interdependentPanes openOn: 5"
	|browser |
	self flag: 'this example does not work'.
	browser := GLMTabulator new.
	browser column: #one; column: #two.
	browser transmit to: #one; andShow: [ :a | 
		a list
			display: [:x | 1 to: x * 3]].
	browser transmit to: #two; from: #one; andShow: [ :a | 
		a list
			display: [:x | 1 to: x * 3]].
	browser transmit to: #one; from: #two; andShow: [ :a | 
		a list
			display: [:x | 1 to: x * 3]].
	^ browser! !

!GLMBasicExamples methodsFor: 'others' stamp: ''!
morphIcons
	<glmBrowser: 'Morph icons' input: 'GLMUIThemeExtraIcons class selectors select: [:each | (each beginsWith: ''glamorous'') and: [(GLMUIThemeExtraIcons perform: each) isForm ]]'>
	"self new morphIcons openOn: (GLMUIThemeExtraIcons class selectors select: [:each | (each beginsWith: 'glamorous') and: [(GLMUIThemeExtraIcons perform: each) isForm ]])"
	| browser |
	browser := GLMTabulator new.
	browser column: #list; column: #preview.
	browser title: 'Glamorous Icons'.
	browser transmit to: #list; andShow: [ :a | 
		a list title: 'GLMUIThemeExtraIcons' ].
	browser transmit to: #preview; from: #list; andShow: [ :a |
		a morph
			title: [:symbol | symbol];
			display: [:symbol | 
				(GLMUIThemeExtraIcons perform: symbol) asMorph ] ].
	^ browser! !

!GLMBasicExamples methodsFor: 'browsers' stamp: 'TudorGirba 5/19/2012 09:12'!
simpleFinder
	<glmBrowser: 'Finder' input: '42'>
	"self new simpleFinder openOn: 42"
	| finder |	
	finder := GLMFinder new.
	finder show: [:a | a list display: [ :x | 1 to: x ]].
	^ finder! !

!GLMBasicExamples methodsFor: 'composite' stamp: ''!
formatAsWords
	"self new formatAsWords openOn: (1 to: 100)"
	<glmBrowser: 'Format' input: '(1 to: 100)'>	
	| browser |
	browser := GLMTabulator new.
	browser row: #list.
	browser transmit to: #list; andShow: [ :a |
		a tree
			format: [ :x | x asWords];
			display: [:x | x]].
	^ browser ! !

!GLMBasicExamples methodsFor: 'actions examples' stamp: ''!
simpleFinderWithMenu
	<glmBrowser: 'Browser menu' input: '$z'>
	"self new simpleFinderWithMenu openOn: $z"

	| finder |
	finder := GLMFinder new variableSizePanes.
	finder show: [:a | a list
			title: 'List';
			display: [:each | $a to: each];
			dynamicActionsOnSelection: [:list | self actionsFor: list ]].
	^ finder! !

!GLMBasicExamples methodsFor: 'actions examples' stamp: 'TudorGirba 10/19/2014 09:21'!
onChangeOfPortAction
	<glmBrowser: 'On change of port' input: '''Type something and check the Transcript'''>
	"self new onChangeOfPortAction openOn: 'Type something and check the Transcript' "

	^ GLMCompositePresentation new 
		with: [ :composite |
			composite rubricText 
				onChangeOfPort: #text act: [ :textPresentation | 
					Transcript cr; cr; show: textPresentation text ] ];
		act: [ Transcript open ] entitled: 'Open Transcript'! !

!GLMBasicExamples methodsFor: 'actions examples' stamp: ''!
staticAndDynamicMenu
	<glmBrowser: 'Menus' input: '$z'>
	"self new staticAndDynamicMenu openOn: $z"

	| finder |
	finder := GLMFinder new.
	finder show: [ :a |
		a list
			title: 'List';
			display: [:each | $a to: each];
			dynamicActionsOnSelection: [:list | self actionsFor: list ];
			selectionAct: [self inform: 'static action'] entitled: 'Static action';
			selectionAct: [self inform: 'static sub action'] entitled: 'Static sub action' categorized: 'Sub menu'.
		a text
			title: 'Text';
			display: [:each | 'Character ', each asString];
			dynamicActionsOnSelection: [:text | OrderedCollection with: (GLMGenericAction new title: 'Print selection'; action: [text selectedText inspect ]; yourself) ];
			selectionAct: [self inform: 'Text static action'] entitled: 'Static action'].
	^ finder! !

!GLMBasicExamples methodsFor: 'browsers' stamp: 'AndreiChis 4/27/2014 17:05'!
simplePager
	<glmBrowser: 'Pager' input: '42'>
	"self new simplePager openOn: 42"
	| pager |	
	pager := GLMPager new.
	pager show: [:a | a list display: [ :x | 1 to: x ]].
	^ pager! !

!GLMBasicExamples methodsFor: 'updating' stamp: ''!
updateableBrowser
	<glmBrowser: 'Updateable browser' input: '|collection|
	collection := GLMAnnouncingCollection new.
	collection add: 1.
	collection'>
	"
	|collection|
	collection := GLMAnnouncingCollection new.
	collection add: 1.
	self new updateableBrowser openOn: collection."
	
	| browser |
	browser := GLMTabulator new.
	browser column: #preview.
	browser 
		act: [:b | b entity add: (b entity size + 1). b update ] 	
		icon: GLMUIThemeExtraIcons glamorousAdd
		entitled: 'Add an item in the collection'.
	browser 
		act: [:b | b entity removeLast. b update ] 
		icon: GLMUIThemeExtraIcons glamorousRemove
		entitled: 'Remove last item from the collection'.
	browser 
		updateOn: GLMItemAdded from: #yourself;
		updateOn: GLMItemRemoved from: #yourself.
	browser transmit to: #preview; andShow: [ :a |
		a list 
			title: [:collection | 'List: ', collection size printString ];
			when: [:collection | collection size > 1 ].
		a text title: 'Text'; 
			format: [:collection | 'Current collection: ', collection printString, '
Add more items to show the list'] ].
	^ browser! !

!GLMBasicExamples methodsFor: 'table' stamp: 'AndreiChis 6/13/2014 13:39'!
simpleTableWithSorting
	<glmBrowser: 'Table with column sorting' input: '1 to: 20'>
	"
	self new simpleTableWithSorting openOn: (1 to: 20)
	"
	|browser|
	browser := GLMTabulator new.
	browser row: #row.

	browser transmit to: #row; andShow: [ :composite |
		composite table
			column: 'Base 10 (numeric descending sort)' 
				evaluated: [ :each | each asString ] 
				tags: [:item | item even ifTrue: ['even'] ifFalse: ['odd'] ]
				sortedBy: [ :x :y | x > y ] ;
			column: 'Base 16 (default alfabetic ascending sort)' 
				evaluated: [ :each | each printStringBase: 16 ]
				tags: [:item | item < 7 ifTrue: ['<7'] ifFalse: ['>=7' ] ] ].

	^ browser! !

!GLMBasicExamples methodsFor: 'explicit selection' stamp: ''!
treeWithChildrenByLevel
	"
		self new treeWithChildrenByLevel openOn: #(1 2 3 4 5)
	"

	<glmBrowser: 'Tree with children by level' input: '(1 to: 5)'>
	| browser |
	browser := GLMTabulator new.
	browser
		column: #one;
		column: [ :c | 
					c
						row: #two;
						row: #three ].
	(browser transmit)
		to: #one;
		andShow: [ :a | 
					(a tree)
						title: 'Tree';
						children: [ :item :x :level | 
									level > 1
										ifTrue: [ #() ]
										ifFalse: [ 1 to: item ] ]	"Children must return a collection" ].
	(browser transmit)
		to: #two;
		from: #one;
		andShow: [ :a | a text title: 'Selection preview' ].
	(browser transmit)
		to: #three;
		from: #one port: #selectionPath;
		andShow: [ :a | a text title: 'Selection path preview' ].
	^ browser! !

!GLMBasicExamples methodsFor: 'browsers' stamp: 'TudorGirba 5/19/2012 09:16'!
wrapper 
	
	<glmBrowser: 'Wrapper' input: '1 to: 42'>
	"self new wrapper openOn: (1 to: 42)"
	
	| wrapper |
	wrapper := GLMWrapper new title: 'Wrapper'.
	wrapper show: [:a | a list title: 'List'. a text title: 'Text' ].
	^ wrapper! !

!GLMBasicExamples methodsFor: 'others' stamp: 'TudorGirba 5/14/2013 08:52'!
watcher
	"self new watcher openOn: (Collection methods)"

	"You have to open the Watcher to see the effect."
	"GLMWatcherWindow uniqueInstance show."

	"<glmBrowser: 'Watcher' input: 'Collection methods'>"
	| browser |
	browser := GLMTabulator new.
	browser column: #one.
	browser transmit
		to: #one;
		andShow: [ :a | a list title: 'Collection methods'; format: #selector].
	browser transmit
		from: #one;
		toWatcher;
		andShow: [ :a | a smalltalkCode display: #getSource ].
	^ browser! !

!GLMBasicExamples methodsFor: 'browsers' stamp: ''!
accumulator
	"self new accumulator openOn: 42"

	<glmBrowser: 'Accumulator' input: '42'>
	| browser acc |
	browser := GLMTabulator new.
	acc := GLMAccumulator new.
	acc
		show: [ :a | 
			a title: [ :x | x asString ].
			a list
				display: [ :x | 1 to: x ] ].
	browser
		column: [ :c | 
					c
						row: #one span: 4;
						row: #two ];
		column: #three.
	(browser transmit)
		to: #one;
		andShow: [ :a | a list display: [ :x | x to: 10 * x ] ].
	(browser transmit)
		from: #one;
		to: #two;
		andShow: [ :a | a text display: [ :x | 'You have selected ' , x printString , '. Double cick to open to the right' ] ].
	"When double-clicking on a number in the list, opens a new tab on the right side"
	(browser transmit)
		from: #one port: #strongSelection;
		to: #three;
		andShowIfNone: [ :a | a custom: acc ].
	"When a number is selected in the list and a corresponding tab already exists on the right side, select the tab"
	(browser transmit)
		from: #one;
		to: #three port: #entityToSelect.
	"When a tab is selected on the right side, select the equivalent line in the first pane"
	(browser transmit)
		from: #three port: #activeEntity;
		to: #one port: #selection.
	^ browser! !

!GLMBasicExamples methodsFor: 'actions examples' stamp: 'TudorGirba 6/2/2012 00:32'!
multipleActions
	<glmBrowser: 'Multiple actions' input: '''This example shows how multiple actions are rendered.'''>
	"self new multipleActions openOn: 'This example shows how multiple actions are rendered.'"
	|browser |
	browser := GLMTabulator new.
	browser act: [:b | b inspect ] on: $/ entitled: 'Global action with shortcut'.
	browser column: #one.
	browser transmit to: #one; andShow: [ :a |
		a text 
			title: 'Example';
			selectionAct: [:text | text inspect ] on: $i entitled: 'Selection action';
			act: [:text | text inspect ] entitled: 'Action without icon';
			act: [:text | text inspect ] icon: GLMUIThemeExtraIcons glamorousInspect entitled: 'Action with icon' ].
	^ browser! !

!GLMBasicExamples methodsFor: 'others' stamp: ''!
treeWithAmountFiltering
	<glmBrowser: 'Smart lists' input: '(1 to: 10000)'>
	"self new treeWithAmountFiltering openOn: (1 to: 10000)"
	| browser |
	browser := GLMTabulator new.
	browser column: #one.
	browser transmit to: #one; andShow: [ :a | 
		a tree
			tags: [ :each | {each even printString} ];
			showOnly: 50 ].
	^ browser ! !

!GLMBasicExamples methodsFor: 'others' stamp: ''!
allowAllNil
	<glmBrowser: 'Allowing all nil' input: '5'>
	"self new allowAllNil openOn: 5"
	| browser |
	 
	browser := GLMTabulator new.
	browser 
		column: [: c | c row: #one; row: #two];
		column: #details.
	browser transmit to: #one; andShow: [ :a |
		a tree 
			display:[ :x| 1 to: x ];
			allowDeselection ].
	browser transmit to: #two; andShow: [ :a | 
		a tree 
			display: #(a b c);
			allowDeselection].
	browser transmit to: #details; from: #one; from: #two; andShow: [ :a |
		a text 
			display: [ :one :two | 'At least one is nil: ', one asString, '-', two asString];
			allowNil.
		a text 
			display: [ :one :two | 'All are nil: ', one asString, '-',  two asString];
			allowAllNil ].
		
	"if you need initial display"
	browser transmit to: #details; andShow: [:a | 
		a text display: [:x | 'All are nil'  ] ].
	
	^ browser! !

!GLMBasicExamples methodsFor: 'actions examples' stamp: ''!
treeWithMenu
	<glmBrowser: 'Tree with menu' input: '#(($a $b $c $d) ($e $f) ($g $h $i $j $l))'>
	"self new treeWithMenu openOn: #(($a $b $c $d) ($e $f) ($g $h $i $j $l))"
	|browser |
	browser := GLMTabulator new.
	browser column: #one; column: #two.
	browser transmit to: #one; andShow: [ :a |
		a tree
			children: [:x :i | x asString size > 1 ifTrue: [x] ifFalse: [OrderedCollection new] ];
			selectionAct: [:tree | tree inspect ] on: $i entitled: 'Inspect';
			icon: [:x | GLMUIThemeExtraIcons glamorousGrayCircle ]].
	browser transmit to: #two; from: #one; andShow: [:a | a text ].
	^ browser! !

!GLMBasicExamples methodsFor: 'composite' stamp: ''!
differentComposites
	"self new differentComposites openOn: (1 to: 100)"
	<glmBrowser: 'Composite arrangements' input: '(1 to: 100)'>	
	| browser |
	browser := GLMTabulator new.
	browser row: [:r | 
		r column: #tabbed; column: #accordion; column: #stackedVertically] span: 4; row: #preview.
	browser transmit to: #tabbed; andShow: [:a | 
		a title: 'Tabs'.
		a list title: 'List'. a text title: 'Text' ].
	browser transmit to: #accordion; andShow: [:a | 
		a accordionArrangement.
		a title: 'Accordion'.
		a list title: 'List'. a text title: 'Text' ].
	browser transmit to: #stackedVertically; andShow: [:a | 
		a title: 'Stack'.
		a stackedVerticallyArrangement.
		a list title: 'List'. a text title: 'Text' ].
	browser transmit to: #preview; from: #tabbed; andShow: [:a | 
		a text display: [:x | x printString, ' from tabbed' ]].
	browser transmit to: #preview; from: #accordion; andShow: [:a | 
		a text display: [:x | x printString, ' from accordion' ]].
	browser transmit to: #preview; from: #stackedVertically; andShow: [:a | 
		a text display: [:x | x printString, ' from stacked vertically' ]].
	^ browser ! !

!GLMBasicExamples methodsFor: 'others' stamp: 'TudorGirba 4/25/2012 07:40'!
diff
	<glmBrowser: 'Diff' input: '#(#(abc def ghi) #(abc xyz))'>
	"self new diff openOn: #(#(abc def ghi) #(abc xyz))"
	| browser | 
	browser := GLMTabulator new.
	browser 
		row: [:r | r column: #one; column: #two];
		row: #diff.
	browser transmit to: #one; andShow: [ :a |
		a list 
			display: #first ].
	browser transmit to: #two; andShow: [ :a | 
		a list
			display: #second ].
	browser transmit to: #diff; from: #one; from: #two; andShow: [ :a | 
		a diff
			display: [ :one :two | {one asString . two asString}] ].
	^ browser! !

!GLMBasicExamples methodsFor: 'table' stamp: 'TudorGirba 9/20/2013 08:26'!
simpleTable
	<glmBrowser: 'Table simple' input: '100'>
	"| f | 
	f := self new simpleTable.
	f openOn: 1000.
	(f panes first port: #selection) value: 1"
	| wrapper |	
	wrapper := GLMWrapper new.
	wrapper show: [:a | 
		a table
			display: [ :x | 1 to: x ]; 
			column: [:x | 'Numbers from 1 to ', x asString] evaluated: #asString;
			column: 'Even' evaluated: [ :each | each even asString ];
			column: 'Odd' evaluated: [ :each | each odd asString ] ].
	^ wrapper! !

!GLMBasicExamples methodsFor: 'searching and filtering' stamp: 'AndreiChis 10/27/2014 10:19'!
multipleFinderWithFilter
	<glmBrowser: 'Filter' input: '$a to: $z'>
	"self new multipleFinderWithFilter openOn: ($a to: $z)"

	| finder |	
	finder := GLMFinder new.
	finder show: [:a | 
		a list
			title: 'List';
			beMultiple;
			dynamicActions: [:list | self actionsFor: list];
			filterOn: [:text :each | Smalltalk compiler evaluate: '| each | each := self. ', text for: each logged: false ];
			helpMessage:  'Enter a filtering request (e.g., "each > $f")'. 
		a tree
			title: 'Tree';
			dynamicActions: [:list | self actionsFor: list];
			filterOn: [:text :each | Smalltalk compiler evaluate: '| each | each := self. ', text for: each logged: false ];
			helpMessage:  'Enter a filtering request (e.g., "each > $f")' ].
	^ finder ! !

!GLMBasicExamples methodsFor: 'text' stamp: 'TudorGirba 12/4/2014 11:51'!
textPortsExamples
	<glmBrowser: 'Text ports' input: '''Type and select to see the results previewed.'''>
	"self new textPortsExamples openOn: 'Type and select to see the results previewed.'"

	| browser |
	browser := GLMTabulator new.
	browser
		row: #main;
		row: [ :r | r column: #selectionInterval; column: #selectedText; column: #full ].
	(browser transmit)
		to: #main;
		andShow: [ :a | a rubricText ].
	(browser transmit)
		to: #selectionInterval;
		from: #main port: #selectionInterval;
		andShow: [ :a | a text title: '#selectionInterval port' ].
	(browser transmit)
		to: #selectedText;
		from: #main port: #selectedText;
		andShow: [ :a | a text title: '#selectedText port' ].
	(browser transmit)
		to: #full;
		from: #main port: #text;
		andShow: [ :a | a text title: '#text port'].
	^ browser! !

!GLMBasicExamples methodsFor: 'updating' stamp: ''!
validatingPresentation
	<glmBrowser: 'Validating presentation' input: '|collection|
	collection := GLMAnnouncingCollection new.
	collection add: 1; add: 2; add: 3.
	collection'>
	"
	|collection|
	collection := GLMAnnouncingCollection new.
	collection add: 1; add: 2; add: 3.
	self new validatingPresentation openOn: collection."
	
	| browser |
	browser := GLMTabulator new.
	browser column: #one; column: #two.
	browser transmit to: #one; andShow: [:a | 
		a list 
			title: 'List with port validation';
			shouldValidate: true;
			updateOn: GLMItemRemoved from: #yourself;
			updateOn: GLMItemAdded from: #yourself;
			act: [:list :all | all removeLast ] 
				icon: GLMUIThemeExtraIcons glamorousRemove 
				entitled: 'Remove last';
			act: [:list :all | all add: (all size + 1) ] 
				icon: GLMUIThemeExtraIcons glamorousAdd 
				entitled: 'Add last'. 
	 ].
	browser transmit from: #one; to: #two; andShow: [:a | 
		a text title: 'Preview' ].
	^ browser 
! !

!GLMBasicExamples class methodsFor: 'accessing' stamp: ''!
title 
	^ 'Basic Examples'! !

!GLMBoundPort methodsFor: 'comparing' stamp: ' 4/5/09 22:18'!
hash 
	"Ports which are equal should return hash. 
 
	Since equality is used only for matching port proxies (ParentPort) with 
	their actual port, the hash function is overridden only in ParentPort." 
	 
	^super hash! !

!GLMBoundPort methodsFor: 'comparing' stamp: ' 4/5/09 22:18'!
= anObject 
	"Compare this port with another for equality. 
 
	This is used to compare ParentPorts with PanePorts where the earlier is a proxy for the latter." 
	 
	^((anObject isKindOf: GLMBoundPort) and: [self pane = anObject pane]) 
		and: [self name = anObject name]! !

!GLMBoundPort methodsFor: 'validation' stamp: 'JorgeRessia 11/6/2009 13:09'!
validate: anObject 
	self pane presentations isEmpty ifTrue: [^true].
	^self pane presentations allSatisfy: [ :each | each validate: anObject on: self]! !

!GLMBoundPort methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
pane 
	 
	self subclassResponsibility! !

!GLMBoundPort methodsFor: 'validation' stamp: 'simondenier 4/15/2010 15:55'!
notingPresentationChangeDo: aBlock
	self pane notingPresentationChangeDo: aBlock! !

!GLMBoundPort methodsFor: 'testing' stamp: ' 4/5/09 22:18'!
hasPane 
	 
	^self pane notNil! !

!GLMBrick commentStamp: 'AliakseiSyrel 3/22/2015 11:34'!
A GLMBrick is the superclass of all Bricks. It subclasses cleaned morph with deleted layouting mechanism

Instance Variables
	brickBounds:		<GLMBrickBounds>
	ports:		<Dictionary>

brickBounds
	- wrapper object for brick geometry.  
		holds margin, padding properties.,
		responsible for calculation of outer/inner bounds depending on margin/padding

ports
	- dictionary of phlow bindings. is not implemented yet
!
!GLMBrick methodsFor: 'brick-layout-properties' stamp: ''!
hShrinkWrap

	self layout hShrinkWrap! !

!GLMBrick methodsFor: 'private-properties' stamp: ''!
privateThemer

	^ self valueOfProperty: #brickThemer ifAbsentPut: [ nil ]! !

!GLMBrick methodsFor: 'brick-geometry-properties' stamp: ''!
paddingLeft: anObject
	<brickBuilderProperty: #Geometry name: 'Padding Left' as: #asInteger getter: #paddingLeft model: #GLMUIBuilderTextFieldProperty>

	self wrappedBounds paddingLeft: anObject! !

!GLMBrick methodsFor: 'brick-structure-opening' stamp: ''!
openInBrickWindow

	^ self openInBrickWindowLabeled: self! !

!GLMBrick methodsFor: 'brick-properties-events' stamp: ''!
announce: aSymbol event: anEvent

	self announcer subscriptions glmSubscriptions do: [ :each |
		each announcementClass = aSymbol ifTrue: [
			(each handlesAnnouncement: aSymbol ) ifTrue: [
				[ each action cull: anEvent cull: self ] 
					on: UnhandledError fork: [:ex | ex pass ] ] ] ]! !

!GLMBrick methodsFor: 'brick-geometry' stamp: ''!
outerBounds
	"can be used in layouts"
	^ self wrappedBounds outerBounds! !

!GLMBrick methodsFor: 'brick-properties' stamp: ''!
color: aColor
	<brickBuilderProperty: #'Look&Feel' name: 'Color' as: #brickBuilderEvaluate getter: #color model: #GLMUIBuilderTextFieldProperty>

	self setProperty: #brickBackgroundColor toValue: aColor! !

!GLMBrick methodsFor: 'brick-properties-events' stamp: ''!
announce: anAnnouncement

	self announcer announce: anAnnouncement! !

!GLMBrick methodsFor: 'brick-layout' stamp: ''!
layoutSubbricks

	self layoutPolicy layout: self brickApi in: self innerBounds! !

!GLMBrick methodsFor: 'brick-layout-properties' stamp: ''!
floating

	^ self layout floating! !

!GLMBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 3/18/2015 21:25'!
initialize
	super initialize.
	color := Color transparent.
	self fillStyle: nil.
	submorphs := OrderedCollection new.
	
	self
		layoutProperties: GLMBrickLayoutProperties new;
		useHorizontalLinearLayout;
		renderer: GLMBrickRenderer new! !

!GLMBrick methodsFor: 'brick-geometry' stamp: ''!
brickBounds: aRectangle
	"directly sets brick bounds without layouting process"
	self wrappedBounds brickBounds: aRectangle! !

!GLMBrick methodsFor: 'brick-geometry-properties' stamp: ''!
maxWidth: anObject

	self layout maxWidth: anObject! !

!GLMBrick methodsFor: 'brick-geometry-properties' stamp: ''!
marginLeft: anObject
	<brickBuilderProperty: #Geometry name: 'Margin Left' as: #asInteger getter: #marginLeft model: #GLMUIBuilderTextFieldProperty>

	self wrappedBounds marginLeft: anObject! !

!GLMBrick methodsFor: 'brick-layout' stamp: ''!
invalidateLayout

	self layoutPolicy layout: self brickApi in: self wrappedBounds innerBounds! !

!GLMBrick methodsFor: 'brick-geometry-properties' stamp: ''!
marginBottom

	^ self wrappedBounds marginBottom! !

!GLMBrick methodsFor: 'brick-properties' stamp: ''!
data

	^ self valueOfProperty: #brickDataObject ifAbsentPut: [ nil ]! !

!GLMBrick methodsFor: 'brick-layout-properties' stamp: ''!
zIndex

	^ self layout zIndex! !

!GLMBrick methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 4/1/2015 17:52'!
brickApi

	^ brickApi ifNil: [ brickApi := GLMBrickWrapper on: self ]! !

!GLMBrick methodsFor: 'brick-structure-converting' stamp: ''!
brick

	^ self! !

!GLMBrick methodsFor: 'brick-layout-properties' stamp: ''!
vAlign: aSymbol
	<brickBuilderProperty: #Layout name: 'Vertical align' as: #asSymbol getter: #vAlign model: #GLMUIBuilderTextFieldProperty>

	self layout vAlign: aSymbol! !

!GLMBrick methodsFor: 'brick-geometry' stamp: ''!
width: anObject
	<brickBuilderProperty: #Geometry name: 'Width' as: #asInteger getter: #width model: #GLMUIBuilderTextFieldProperty>

	self privateWidth: anObject.
	self updateWidth! !

!GLMBrick methodsFor: 'brick-geometry-properties' stamp: ''!
paddingTop: anObject
	<brickBuilderProperty: #Geometry name: 'Padding Top' as: #asInteger getter: #paddingTop model: #GLMUIBuilderTextFieldProperty>

	self wrappedBounds paddingTop: anObject! !

!GLMBrick methodsFor: 'morph-drawing' stamp: 'AliakseiSyrel 3/31/2015 16:21'!
drawOnAthensCanvas: anAthensCanvas

	anAthensCanvas pathTransform restoreAfter: [
					anAthensCanvas pathTransform translateBy: (self globalBounds origin - self brickBounds origin).
					self onDrawAthensCanvas: anAthensCanvas ]! !

!GLMBrick methodsFor: 'brick-properties' stamp: ''!
with: aBlock

	aBlock cull: self! !

!GLMBrick methodsFor: 'brick-drawing' stamp: 'AliakseiSyrel 1/20/2015 21:05'!
onDraw: aCanvas

	self renderer render: self on: aCanvas. ! !

!GLMBrick methodsFor: 'morph-common' stamp: 'AliakseiSyrel 3/18/2015 20:50'!
privateMoveBy: delta 
	"Private!! Use 'position:' instead."
	bounds := bounds translateBy: delta.
	fullBounds ifNotNil: [fullBounds := fullBounds translateBy: delta].! !

!GLMBrick methodsFor: 'brick-structure-testing' stamp: ''!
hasSubbrick: aBrick

	^ aBrick owner = self! !

!GLMBrick methodsFor: 'private-extension' stamp: 'AliakseiSyrel 1/20/2015 22:17'!
valueOfProperty: aSymbol ifAbsentPut: aBlock 
	
	^ super valueOfProperty: aSymbol ifAbsentPut: aBlock! !

!GLMBrick methodsFor: 'brick-structure' stamp: ''!
subbrickBefore

	"Return the subbrick before me, or nil"
	| link |
	link := self brickDoubleLink.
	link ifNil: [ ^ nil ].
	link previousLink ifNil: [ ^ nil ].
	^ link previousLink value! !

!GLMBrick methodsFor: 'brick-properties' stamp: ''!
data: anObject

	^ self setProperty: #brickDataObject  toValue:  anObject! !

!GLMBrick methodsFor: 'brick-geometry-properties' stamp: ''!
padding

	^ self wrappedBounds padding! !

!GLMBrick methodsFor: 'brick-geometry-properties' stamp: ''!
marginRight: anObject
	<brickBuilderProperty: #Geometry name: 'Margin Right' as: #asInteger getter: #marginRight model: #GLMUIBuilderTextFieldProperty>

	self wrappedBounds marginRight: anObject! !

!GLMBrick methodsFor: 'brick-layout-events' stamp: ''!
onLayouted
	"called when I'm layouted in my parent"
	self updateFoundationBounds! !

!GLMBrick methodsFor: 'brick-structure-adding/removing' stamp: ''!
addBrick: aBrick before: otherBrick
	|result|
	result := self privateAddBrick: aBrick asBrick before: otherBrick.
	self privatePrepareBrickAfterAdding: result.
	self doLayoutForce.
	^ aBrick! !

!GLMBrick methodsFor: 'private-geometry' stamp: ''!
updateFoundationBounds

	self owner ifNotNil: [ :o | o isFoundationBrick ifTrue: [ 
		self doNotLayoutDuring: [
			(o isVShrinking | o isHShrinking) ifTrue: [ o privateExtent: self outerBounds extent ] ] ] ]! !

!GLMBrick methodsFor: 'brick-geometry' stamp: ''!
brickBounds

	^ self wrappedBounds brickBounds! !

!GLMBrick methodsFor: 'brick-geometry-transformations' stamp: ''!
withHeight: anInteger

	self wrappedBounds height: anInteger! !

!GLMBrick methodsFor: 'brick-geometry' stamp: 'AliakseiSyrel 2/17/2015 17:31'!
wrappedBounds: aBounds

	brickBounds := aBounds! !

!GLMBrick methodsFor: 'brick-structure-testing' stamp: ''!
isFirstInOwner

	^ self brickDoubleLink 
		ifNotNilDo: [ :bdl | bdl hasPredecessor not ]
		ifNil: [ false ]! !

!GLMBrick methodsFor: 'brick-structure' stamp: ''!
lastSubbrick

	^ self subbricks last! !

!GLMBrick methodsFor: 'brick-geometry-properties' stamp: ''!
margin: aCollection
	<brickBuilderProperty: #Geometry name: 'Margin' as: #brickBuilderEvaluate getter: #margin model: #GLMUIBuilderTextFieldProperty>

	self wrappedBounds margin: aCollection! !

!GLMBrick methodsFor: 'brick-structure-converting' stamp: ''!
asFormValue

	^ nil! !

!GLMBrick methodsFor: 'brick-properties-testing' stamp: ''!
isColorSet

	^ self hasProperty: #brickBackgroundColor! !

!GLMBrick methodsFor: 'brick-layout' stamp: 'AliakseiSyrel 1/20/2015 19:01'!
layoutPolicy: aLayout
	
	super layoutPolicy: aLayout! !

!GLMBrick methodsFor: 'private-geometry' stamp: ''!
customWidth

	^ self layout width brickValue: self! !

!GLMBrick methodsFor: 'brick-structure-adding/removing' stamp: ''!
removeBrick: aBrick
	|result|
	aBrick ifNil: [ ^ aBrick ].
	result := self privateRemoveBrick: aBrick.
	self	privatePrepareBrickAfterRemoving: aBrick.
	self doLayoutForce.
	^ result! !

!GLMBrick methodsFor: 'private-extension' stamp: 'AliakseiSyrel 1/26/2015 13:12'!
hasProperty: aSymbol 
	
	^ super hasProperty: aSymbol! !

!GLMBrick methodsFor: 'brick-structure-opening' stamp: ''!
openCenteredInBrickWindow

	self openCenteredInBrickWindowLabeled: self! !

!GLMBrick methodsFor: 'private-geometry' stamp: ''!
privateHeight: anObject
	
	self layout height: anObject! !

!GLMBrick methodsFor: 'brick-properties' stamp: ''!
themer: aThemer

	self setProperty: #brickThemer toValue: aThemer.
	self themerChanged! !

!GLMBrick methodsFor: 'brick-layout' stamp: ''!
layout: aLayout
	"Alias for layoutPolicy:"
	<brickBuilderProperty: #Layout name: 'Orientation' as: #brickBuilderLayout getter: #layoutPolicy model: #GLMUIBuilderTextFieldProperty>

	self layoutPolicy: aLayout! !

!GLMBrick methodsFor: 'brick-layout-properties' stamp: ''!
vShrinkWrap

	self layout vShrinkWrap! !

!GLMBrick methodsFor: 'brick-structure' stamp: ''!
withAllOwnersDo: aBlock
	"Evaluate aBlock with the receiver and all of its owners"
	aBlock cull: self.
	self owner ifNotNil:[ ^ self owner withAllOwnersDo: aBlock ]! !

!GLMBrick methodsFor: 'brick-geometry' stamp: ''!
globalBounds
	"converts local bounds to global bounds on fly"
	
	^ self owner ifNotNil: [ self brickBounds translateBy: self owner globalBoundsTranslateFactor ] ifNil: [ self brickBounds ].! !

!GLMBrick methodsFor: 'brick-structure-testing' stamp: ''!
isLastInOwner

	^ self brickDoubleLink
		ifNotNilDo: [ :bdl | bdl hasSuccessor not ]
		ifNil: [ false ]! !

!GLMBrick methodsFor: 'brick-geometry' stamp: ''!
height

	^ self brickBounds height! !

!GLMBrick methodsFor: 'brick-structure' stamp: ''!
subbricksReverseDo: aBlock

	self subbricks reverseDo: aBlock! !

!GLMBrick methodsFor: 'brick-structure' stamp: ''!
ownerThatIsA: aClass
	"Return the first enclosing morph that is a kind of aClass, or nil if none"

	^ self firstOwnerSuchThat: [:m | m isKindOf: aClass]! !

!GLMBrick methodsFor: 'brick-layout' stamp: ''!
doNotLayoutDuring: aBlock
	|wasAllowed|
	wasAllowed := self isLayotingAllowed.
	self isLayotingAllowed: false.
	[ aBlock cull: self ]
		ensure: [ wasAllowed ifTrue: [ self isLayotingAllowed: true ] ]! !

!GLMBrick methodsFor: 'brick-structure-converting' stamp: 'AliakseiSyrel 3/23/2015 22:03'!
asMorph

	^ self asBrickedMorph! !

!GLMBrick methodsFor: 'brick-properties' stamp: ''!
shadowWidth: anInteger
	<brickBuilderProperty: #'Look&Feel' name: 'Shadow Width' as: #asInteger getter: #shadowWidth model: #GLMUIBuilderTextFieldProperty>

	self setProperty: #brickShadowWidth toValue: anInteger! !

!GLMBrick methodsFor: 'private-layout' stamp: ''!
isLayotingAllowed: aBoolean

	self setProperty: #brickLayoutingAllowed toValue: aBoolean! !

!GLMBrick methodsFor: 'brick-structure' stamp: 'AliakseiSyrel 1/20/2015 22:34'!
subbricks

	^ self submorphs! !

!GLMBrick methodsFor: 'brick-properties' stamp: ''!
renderer: aRenderer

	self setProperty: #brickRenderer toValue: aRenderer! !

!GLMBrick methodsFor: 'brick-geometry-properties' stamp: ''!
marginRight

	^ self wrappedBounds marginRight! !

!GLMBrick methodsFor: 'brick-layout' stamp: ''!
layout
	"Alias for layoutProperies"
	^ self layoutProperties! !

!GLMBrick methodsFor: 'brick-structure' stamp: ''!
allSubbricks
	| all |
	all := OrderedCollection new.
	self allSubbricksDo: [:each | all add: each ].
	^ all! !

!GLMBrick methodsFor: 'brick-properties' stamp: ''!
border: aBorder

	self setProperty: #brickBorder toValue: aBorder! !

!GLMBrick methodsFor: 'private-structure' stamp: ''!
privateRemoveBrick: aBrick
	| predecessor successor link head tail index|
	aBrick ifNil: [ ^ aBrick ].
	(self hasSubbrick: aBrick) ifFalse: [ ^ aBrick ].
	
	link := aBrick brickDoubleLink.
	
	head := self firstSubbrick brickDoubleLink.
	tail := self lastSubbrick brickDoubleLink.
	
	predecessor := link previousLink.
	successor := link nextLink.
	predecessor
		ifNotNil: [ predecessor nextLink: successor ].
	successor
		ifNotNil: [ successor previousLink: predecessor ].
	link clearLinks.
	
	aBrick brickDoubleLink: nil.
	
	index := self subbricks find: aBrick.
	self privateSubbricks: (self subbricks copyWithoutIndex: index).
	aBrick owner: nil.
	
	^ aBrick! !

!GLMBrick methodsFor: 'brick-geometry-transformations' stamp: ''!
translateX: anInteger

	self wrappedBounds translateX: anInteger! !

!GLMBrick methodsFor: 'morph-drawing' stamp: 'AliakseiSyrel 3/31/2015 15:18'!
fullDrawOn: aCanvas
	"fixes bug in canvas, when it tries to draw a morph even if clip rect has size 0"
	aCanvas clipRect width = 0 | (aCanvas clipRect height = 0) ifTrue: [ ^ self ].
	super fullDrawOn: aCanvas! !

!GLMBrick methodsFor: 'morph-common' stamp: 'AliakseiSyrel 1/20/2015 21:05'!
fullBounds

	^ self globalBounds! !

!GLMBrick methodsFor: 'brick-geometry' stamp: ''!
globalInnerBounds
	"converts local inner bounds to global inner bounds on fly"
	
	^ self owner ifNotNil: [ self innerBounds translateBy: self owner globalBoundsTranslateFactor ] ifNil: [ self innerBounds ].! !

!GLMBrick methodsFor: 'brick-layout' stamp: 'AliakseiSyrel 1/20/2015 19:00'!
layoutPolicy

	^ super layoutPolicy! !

!GLMBrick methodsFor: 'private-structure' stamp: ''!
privateRemoveOutWorld: aBrick

	aBrick outOfWorld: aBrick world
	! !

!GLMBrick methodsFor: 'private-structure' stamp: ''!
privateAddBrickBack: aBrick
	|brick|
	
	brick := aBrick asBrick.
	self privateAddBrickLinkBack: brick.
	self privateSubbricks: (self subbricks copyWith: brick).
	
	^ aBrick! !

!GLMBrick methodsFor: 'brick-properties' stamp: ''!
border

	^ self valueOfProperty: #brickBorder ifAbsentPut: [ GLMBrickBorder new ]
	! !

!GLMBrick methodsFor: 'brick-properties-events' stamp: 'AliakseiSyrel 1/26/2015 13:14'!
onThemerChanged

	self changed! !

!GLMBrick methodsFor: 'brick-geometry' stamp: ''!
bounds: aRectangle
	"when you use this method, it changes brickBounds
	then recalculates layout and invalidates rectangle"
	self layoutAfter: [ :b | b wrappedBounds bounds: aRectangle ]! !

!GLMBrick methodsFor: 'brick-properties' stamp: ''!
renderer

	^ self valueOfProperty: #brickRenderer ifAbsentPut: [ nil ]! !

!GLMBrick methodsFor: 'brick-geometry-transformations' stamp: ''!
translateYTo: anInteger

	self translateY: (self brickBounds top negated + anInteger)! !

!GLMBrick methodsFor: 'brick-structure-converting' stamp: ''!
asBrick
	^ self! !

!GLMBrick methodsFor: 'brick-layout-properties' stamp: ''!
hSpaceFill: anInteger
	<brickBuilderProperty: #Layout name: 'Horizontal percent' as: #asInteger getter: #hPercent model: #GLMUIBuilderTextFieldProperty>

	self layout hSpaceFill: anInteger! !

!GLMBrick methodsFor: 'brick-geometry-properties' stamp: ''!
padding: aCollection
	<brickBuilderProperty: #Geometry name: 'Padding' as: #brickBuilderEvaluate getter: #padding model: #GLMUIBuilderTextFieldProperty>

	self wrappedBounds padding: aCollection! !

!GLMBrick methodsFor: 'brick-geometry' stamp: ''!
height: anObject
	<brickBuilderProperty: #Geometry name: 'Height' as: #asInteger getter: #height model: #GLMUIBuilderTextFieldProperty>

	self privateHeight: anObject.
	self updateHeight! !

!GLMBrick methodsFor: 'brick-geometry-properties' stamp: ''!
paddingRight: anObject
	<brickBuilderProperty: #Geometry name: 'Padding Right' as: #asInteger getter: #paddingRight model: #GLMUIBuilderTextFieldProperty>

	self wrappedBounds paddingRight: anObject! !

!GLMBrick methodsFor: 'brick-layout-properties' stamp: ''!
hAlign: aSymbol
	<brickBuilderProperty: #Layout name: 'Horizontal align' as: #asSymbol getter: #hAlign model: #GLMUIBuilderTextFieldProperty>

	self layout hAlign: aSymbol! !

!GLMBrick methodsFor: 'brick-properties' stamp: ''!
borderWidth

	^ self border width! !

!GLMBrick methodsFor: 'brick-geometry-properties' stamp: ''!
hMargin

	^ self marginLeft + self marginRight! !

!GLMBrick methodsFor: 'private-geometry' stamp: ''!
updateHeight
	"no need to care about height, when it's logic is not customized"
	self layout isHeightCustom ifFalse: [ ^ self ].
	[ self bounds: (self brickBounds withHeight: self customHeight) ]
		on: Exception
		do: [ "just skip and do nothing" ]! !

!GLMBrick methodsFor: 'brick-structure-adding/removing' stamp: ''!
addAllBricks: aCollection
	|bricks|
	bricks := self privateAddAllBricks: aCollection.
	bricks do: [ :b | self privatePrepareBrickAfterAdding: b ].
	self doLayoutForce.
	^ aCollection! !

!GLMBrick methodsFor: 'brick-geometry-properties' stamp: ''!
marginTop

	^ self wrappedBounds marginTop! !

!GLMBrick methodsFor: 'brick-geometry' stamp: ''!
extent: aPoint
	"actually works only if width or height are not custom"
	"updates layout"
	self changed.
	
	self width: aPoint x.
	self height: aPoint y.
	self wrappedBounds bounds: (self brickBounds origin extent: aPoint).
	
	self flag: 'do I need to layout morphs inside?'.
	self doLayout.
	
	self changed! !

!GLMBrick methodsFor: 'brick-layout' stamp: ''!
doLayout

	self isLayotingAllowed ifTrue: [
		GLMBrickLayouter uniqueInstance layoutIn: self brickApi ]! !

!GLMBrick methodsFor: 'brick-layout-properties' stamp: ''!
vAlign

	^ self layout vAlign! !

!GLMBrick methodsFor: 'private-structure' stamp: ''!
brickDoubleLink

	^ self valueOfProperty: #brickDoubleLink ifAbsentPut: [ nil ]! !

!GLMBrick methodsFor: 'private-structure' stamp: ''!
owner: aBrick
	|oldOwner|
	oldOwner := self owner.
	self privateOwner: aBrick.
	aBrick
		ifNotNil: [ self themerChanged ]
		ifNil: [ self onRemovedFrom: oldOwner ]! !

!GLMBrick methodsFor: 'brick-structure-testing' stamp: ''!
hasSubbricks

	^ self subbricks isEmpty not! !

!GLMBrick methodsFor: 'morph-common' stamp: 'AliakseiSyrel 2/13/2015 17:43'!
updateMorphBounds

	self withAllSubbricks select: #isMorphBrick thenDo: #onLayouted! !

!GLMBrick methodsFor: 'brick-geometry-properties' stamp: ''!
paddingBottom: anObject
	<brickBuilderProperty: #Geometry name: 'Padding Bottom' as: #asInteger getter: #paddingBottom model: #GLMUIBuilderTextFieldProperty>

	self wrappedBounds paddingBottom: anObject! !

!GLMBrick methodsFor: 'private-structure' stamp: ''!
brickDoubleLink: aDoubleLink

	self setProperty: #brickDoubleLink toValue: aDoubleLink! !

!GLMBrick methodsFor: 'brick-layout-properties' stamp: ''!
zIndex: anInteger

	self layout zIndex: anInteger! !

!GLMBrick methodsFor: 'morph-common' stamp: 'AliakseiSyrel 3/26/2015 17:58'!
haloClass
	"Answer the name of the desired kind of HaloMorph to launch on behalf of the receiver"

	^ #GLMHaloBrick! !

!GLMBrick methodsFor: 'brick-layout-properties' stamp: ''!
hSpaceFill

	self hSpaceFill: 100! !

!GLMBrick methodsFor: 'brick-structure-opening' stamp: ''!
window
	"Answer the receiver's window."
	#GLMWindowBrick asClassIfAbsent: [ 
		^ self ownerThatIsA: SystemWindow ].
	
	^ (self ownerThatIsA: #GLMWindowBrick asClass)
		ifNil: [ self ownerThatIsA: SystemWindow ]! !

!GLMBrick methodsFor: 'morph-common' stamp: 'AliakseiSyrel 3/26/2015 18:45'!
setConstrainedPosition: aPoint hangOut: partiallyOutside
	"Change the position of this morph and and all of its submorphs to aPoint, but don't let me go outside my owner's bounds."

	| trialRect delta boundingRectangle |
	self owner ifNil:[ ^ self ].
	trialRect := 0@0 extent: self outerBounds extent.
	boundingRectangle := (self owner paddingLeft @ self owner paddingTop) extent: self owner innerBounds extent.
	delta := (((aPoint + trialRect corner) min: (boundingRectangle corner)) - trialRect corner) max: boundingRectangle origin.
	
	self position: delta.
	self changed
! !

!GLMBrick methodsFor: 'private-structure' stamp: ''!
privateAddBrick: aBrick after: otherBrick
	| brick link otherLink otherLinkSuccessor index|
	brick := aBrick asBrick.
	
	otherLink := otherBrick brickDoubleLink.
	otherLink = self lastSubbrick brickDoubleLink
		ifTrue: [ ^ self privateAddBrickBack: aBrick ].
		
	link := brick asDoubleLink.
	brick brickDoubleLink: link.
	otherLinkSuccessor := otherLink nextLink.
	otherLink nextLink: link.
	link previousLink: otherLink.
	link nextLink: otherLinkSuccessor.
	otherLinkSuccessor previousLink: link.
	
	index := (self subbricks indexOf: otherBrick) + 1.
	self privateSubbricks: (self subbricks copyReplaceFrom: index to: index - 1 with: (Array with: brick)).
	
	brick owner: self.
	
	^ aBrick! !

!GLMBrick methodsFor: 'private-geometry' stamp: ''!
customHeight

	^ self layout height brickValue: self! !

!GLMBrick methodsFor: 'brick-structure-converting' stamp: ''!
asBrickedMorph

	^ GLMFoundationBrick new brickRoot: self! !

!GLMBrick methodsFor: 'private-extension' stamp: 'AliakseiSyrel 1/20/2015 18:30'!
removeProperty: aSymbol
	
	super removeProperty: aSymbol! !

!GLMBrick methodsFor: 'morph-common' stamp: 'AliakseiSyrel 1/21/2015 13:21'!
submorphBefore

	^ self subbrickBefore! !

!GLMBrick methodsFor: 'brick-structure' stamp: ''!
brickRoot

	^ self owner ifNotNil: [ self owner brickRoot ] ifNil: [ ^ self ]! !

!GLMBrick methodsFor: 'private-geometry' stamp: ''!
privateWidth: anObject

	self layout width: anObject! !

!GLMBrick methodsFor: 'brick-geometry-properties' stamp: ''!
margin

	^ self wrappedBounds margin! !

!GLMBrick methodsFor: 'brick-geometry-transformations' stamp: ''!
translateXTo: anInteger

	self translateX: (self brickBounds left negated + anInteger)! !

!GLMBrick methodsFor: 'brick-structure' stamp: ''!
subbrickAfter

	"Return the subbbrick after (behind) me, or nil"
	| link |
	link := self brickDoubleLink.
	link ifNil: [ ^ nil ].
	link nextLink ifNil: [ ^ nil ].
	^ link nextLink value! !

!GLMBrick methodsFor: 'brick-geometry-properties' stamp: ''!
minHeight: anObject

	self layout minHeight: anObject! !

!GLMBrick methodsFor: 'private-structure' stamp: ''!
privateAddBrick: aBrick before: otherBrick
	| brick link otherLink otherLinkPredeccessor index|
	brick := aBrick asBrick.
	
	otherLink := otherBrick brickDoubleLink.
	otherLink = self firstSubbrick brickDoubleLink
		ifTrue: [ ^ self privateAddBrickFirst: aBrick ].
		
	link := brick asDoubleLink.
	brick brickDoubleLink: link.
	otherLinkPredeccessor := otherLink previousLink.
	otherLink previousLink: link.
	link nextLink: otherLink.
	link previousLink: otherLinkPredeccessor.
	otherLinkPredeccessor nextLink: link.
	
	index := ((self subbricks indexOf: otherBrick) max: 1).
	self privateSubbricks: (self subbricks copyReplaceFrom: index to: index - 1 with: (Array with: brick)).
	
	brick owner: self.
	
	^ aBrick! !

!GLMBrick methodsFor: 'private-structure' stamp: ''!
privateAddIntoWorld: aBrick

	self world == aBrick world
		ifFalse: [ self privateRemoveOutWorld: aBrick ].
	aBrick intoWorld: self world
	! !

!GLMBrick methodsFor: 'brick-properties-events' stamp: ''!
when: aventName send: aSymbol to: aReceiver

	self announcer weak when: aventName send: aSymbol to: aReceiver! !

!GLMBrick methodsFor: 'morph-common' stamp: 'AliakseiSyrel 1/20/2015 21:05'!
removeAllMorphs
	| oldMorphs myWorld |
	"we don't invalidate world"
	myWorld := self world.
	submorphs do: [:m | myWorld ifNotNil: [ m outOfWorld: myWorld ]. m privateOwner: nil].
	oldMorphs := submorphs.
	submorphs := EmptyArray.
	oldMorphs do: [ :m | self removedMorph: m ].
! !

!GLMBrick methodsFor: 'brick-geometry-properties' stamp: ''!
hPadding

	^ self paddingLeft + self paddingRight! !

!GLMBrick methodsFor: 'private-structure' stamp: ''!
privateAddBrickFirst: aBrick
	| link head tail brick|
	
	brick := aBrick asBrick.
	head := nil.
	tail := nil.
	self hasSubbricks ifTrue: [
		head := self firstSubbrick brickDoubleLink.
		tail := self lastSubbrick brickDoubleLink ].
	
	link := brick asDoubleLink.
	brick brickDoubleLink: link.
	link nextLink: head.
	head ifNotNil: [ head previousLink: link ].
	
	self privateSubbricks: (self subbricks copyWithFirst: brick).
	brick owner: self.
	
	^ aBrick! !

!GLMBrick methodsFor: 'morph-drawing' stamp: 'AliakseiSyrel 3/31/2015 15:38'!
drawOn: aCanvas
	"super drawOn: aCanvas."
	
	"translating canvas coordinates"
	 (aCanvas isKindOf: ClippingCanvas) ifTrue: [ ^ self "no need to draw anything" ].
	self onDraw: (aCanvas copy setOrigin: (aCanvas origin + self globalBounds origin - self brickBounds origin) clipRect: (aCanvas clipRect translateBy: aCanvas origin))! !

!GLMBrick methodsFor: 'brick-layout-properties' stamp: ''!
floating: aSymbol

	self layout floating: aSymbol! !

!GLMBrick methodsFor: 'brick-structure' stamp: ''!
firstSubbrick

	^ self subbricks first! !

!GLMBrick methodsFor: 'private-layout' stamp: ''!
isLayotingAllowed

	^ self valueOfProperty: #brickLayoutingAllowed ifAbsent: [ true ]! !

!GLMBrick methodsFor: 'brick-geometry-transformations' stamp: ''!
translateBy: aPoint

	self wrappedBounds translateBy: aPoint! !

!GLMBrick methodsFor: 'brick-structure-adding/removing' stamp: ''!
addBrickBack: aBrick
	|result|
	result := self privateAddBrickBack: aBrick asBrick.
	self privatePrepareBrickAfterAdding: result.
	self doLayoutForce.
	^ aBrick! !

!GLMBrick methodsFor: 'morph-common' stamp: 'AliakseiSyrel 3/31/2015 15:09'!
drawingBounds

	^ self globalBounds! !

!GLMBrick methodsFor: 'brick-drawing' stamp: 'AliakseiSyrel 3/31/2015 16:05'!
onDrawAthensCanvas: aCanvas

	self renderer render: self onAthensCanvas: aCanvas. ! !

!GLMBrick methodsFor: 'brick-geometry' stamp: ''!
extent

	^ self brickBounds extent! !

!GLMBrick methodsFor: 'brick-layout' stamp: ''!
layoutAfter: aBlock

	self doNotLayoutDuring: aBlock.
	self doLayout! !

!GLMBrick methodsFor: 'private-structure' stamp: 'AliakseiSyrel 1/26/2015 12:47'!
privateOwner: aBrick

	owner := aBrick! !

!GLMBrick methodsFor: 'brick-geometry-properties' stamp: ''!
marginTop: anObject
	<brickBuilderProperty: #Geometry name: 'Margin Top' as: #asInteger getter: #marginTop model: #GLMUIBuilderTextFieldProperty>

	self wrappedBounds marginTop: anObject! !

!GLMBrick methodsFor: 'brick-layout-events' stamp: ''!
onChildrenLayouted
	"called when all my children finished layouting"
	self updateFoundationBounds! !

!GLMBrick methodsFor: 'brick-geometry-properties' stamp: ''!
vMargin

	^ self marginTop + self marginBottom! !

!GLMBrick methodsFor: 'brick-testing' stamp: 'AliakseiSyrel 1/20/2015 21:05'!
isFitsInParent

	^ self owner
		"if our owner is a brick"
		ifNotNil: [ self owner globalBounds containsRect: self globalBounds ]
		"if our owner is a morph"
		ifNil: [ self owner ifNotNil: [ self owner bounds containsRect: self globalBounds ] ifNil: [ ^ true ] ]! !

!GLMBrick methodsFor: 'morph-drawing' stamp: 'AliakseiSyrel 1/23/2015 13:16'!
drawSubmorphsOn: aCanvas
	| area zIndexedBricks |
	
	self submorphs isEmpty ifTrue: [ ^ self ].

	"make sure my children will not go away of my inner bounds (we take care about paddings)"
	area := aCanvas clipRect intersect: self globalInnerBounds ifNone: (0 @ 0 extent: 0 @ 0).
	"do smart drawing logic here"
	area width = 0 | (area height = 0) ifTrue: [ 
			"draw nothing"
			^ self ].
	
	zIndexedBricks := OrderedCollection new.
	
	self subbricks
		do: [ :each | 
			| intersection canvas globalBounds |
			each ifNotNil: [ self flag: 'fix nil case'.
			globalBounds := each isBrick
				ifTrue: [ each globalBounds ]
				ifFalse: [ each fullBounds ].
				
			(area intersects: globalBounds) ifTrue: [
				| zIndex |
				zIndex := each layoutProperties zIndex.
				zIndex = 1 ifTrue: [
					"immediately draw ones with the lowest possible z-index.
					With this approach performance doesn't degrade"
					intersection := area intersect: globalBounds ifNone: (0 @ 0 extent: 0 @ 0).
					canvas := aCanvas copyClipRect: intersection.
					each fullDrawOn: canvas ]
					"if z-index is not 1 we add it to collection, in order to sort and draw as second attempt"
				ifFalse: [ zIndexedBricks add: each ] ] ] ].
		
		"z-index drawing section"
		zIndexedBricks sort: [ :first :second | first layoutProperties zIndex < second layoutProperties zIndex ].
		
		zIndexedBricks do: [ :each |
			| intersection canvas globalBounds |
			each ifNotNil: [ self flag: 'fix nil case'.
			globalBounds := each isBrick
				ifTrue: [ each globalBounds ]
				ifFalse: [ each fullBounds ].
				
			intersection := area intersect: globalBounds ifNone: (0 @ 0 extent: 0 @ 0).
			canvas := aCanvas copyClipRect: intersection.
			each fullDrawOn: canvas ] ]
		! !

!GLMBrick methodsFor: 'morph-drawing' stamp: 'AliakseiSyrel 3/31/2015 15:40'!
drawSubmorphsOnAthensCanvas: anAthensCanvas
	| area zIndexedBricks |
	
	self submorphs isEmpty ifTrue: [ ^ self ].

	"make sure my children will not go away of my inner bounds (we take care about paddings)"
	area := anAthensCanvas clipRect intersect: self globalInnerBounds ifNone: (0 @ 0 extent: 0 @ 0).
	"do smart drawing logic here"
	area width = 0 | (area height = 0) ifTrue: [ 
			"draw nothing"
			^ self ].
	
	zIndexedBricks := OrderedCollection new.
	
	self subbricks
		do: [ :each | 
			| intersection  globalBounds |
			each ifNotNil: [ self flag: 'fix nil case'.
			globalBounds := each isBrick
				ifTrue: [ each globalBounds ]
				ifFalse: [ each fullBounds ].
				
			(area intersects: globalBounds) ifTrue: [
				| zIndex |
				zIndex := each layoutProperties zIndex.
				zIndex = 1 ifTrue: [
					"immediately draw ones with the lowest possible z-index.
					With this approach performance doesn't degrade"
					intersection := area intersect: globalBounds ifNone: (0 @ 0 extent: 0 @ 0).
					anAthensCanvas clipBy: intersection during: [ each fullDrawOnAthensCanvas: anAthensCanvas ] ]
					"if z-index is not 1 we add it to collection, in order to sort and draw as second attempt"
				ifFalse: [ zIndexedBricks add: each ] ] ] ].
		
		"z-index drawing section"
		zIndexedBricks sort: [ :first :second | first layoutProperties zIndex < second layoutProperties zIndex ].
		
		zIndexedBricks do: [ :each |
			| intersection globalBounds |
			each ifNotNil: [ self flag: 'fix nil case'.
			globalBounds := each isBrick
				ifTrue: [ each globalBounds ]
				ifFalse: [ each fullBounds ].
				
			intersection := area intersect: globalBounds ifNone: (0 @ 0 extent: 0 @ 0).
			anAthensCanvas clipBy: intersection during: [ each fullDrawOnAthensCanvas: anAthensCanvas ] ] ]
		! !

!GLMBrick methodsFor: 'private-structure' stamp: ''!
privateAddAllBricks: aCollection
	|bricks|
	bricks := aCollection collect: #asBrick.
	bricks do: [ :each | self privateAddBrickLinkBack: each ].
	self privateSubbricks: (self subbricks, bricks).
	^ bricks! !

!GLMBrick methodsFor: 'brick-layout-properties' stamp: ''!
vSpaceFill

	self vSpaceFill: 100! !

!GLMBrick methodsFor: 'morph-drawing' stamp: 'AliakseiSyrel 1/20/2015 21:05'!
changed
	"Report that the area occupied by this morph should be redrawn.
	Fixed to include submorphs outside the outerBounds."
	
	"fixed direct reference to fullBounds, causing wrong results, because fullBounds are not being updated when parent's or child's bounds changed"
	^ self fullBounds 
		ifNil: [self invalidRect: self privateFullBounds]
		ifNotNil: [self invalidRect: self fullBounds]! !

!GLMBrick methodsFor: 'brick-properties' stamp: ''!
themerChanged

	self onThemerChanged.
	self subbricks do: #themerChanged! !

!GLMBrick methodsFor: 'brick-geometry-properties' stamp: ''!
marginLeft

	^ self wrappedBounds marginLeft! !

!GLMBrick methodsFor: 'brick-properties' stamp: ''!
borderWidth: anObject
	<brickBuilderProperty: #'Look&Feel' name: 'Border width' as: #brickBuilderEvaluate getter: #borderWidth model: #GLMUIBuilderTextFieldProperty>

	self border width: anObject! !

!GLMBrick methodsFor: 'morph-common' stamp: 'AliakseiSyrel 2/13/2015 01:02'!
boundsInWorld

	^ self globalBounds! !

!GLMBrick methodsFor: 'brick-properties' stamp: ''!
borderColor
	
	^ self border color! !

!GLMBrick methodsFor: 'brick-layout' stamp: ''!
doLayoutForce

	self wrappedBounds
		markHeightDirty;
		markWidthDirty.
	
	self doLayout! !

!GLMBrick methodsFor: 'brick-layout-properties' stamp: ''!
hAlign

	^ self layout hAlign! !

!GLMBrick methodsFor: 'private-structure' stamp: ''!
privatePrepareBrickAfterRemoving: aBrick

	self privateRemoveOutWorld: aBrick! !

!GLMBrick methodsFor: 'private-structure' stamp: ''!
privatePrepareBrickAfterAdding: aBrick

	aBrick wrappedBounds markWidthDirty; markHeightDirty.
	self privateAddIntoWorld: aBrick! !

!GLMBrick methodsFor: 'brick-structure-testing' stamp: ''!
hasOwner

	^ self owner isNotNil! !

!GLMBrick methodsFor: 'brick-layout' stamp: 'AliakseiSyrel 1/20/2015 19:01'!
layoutProperties
	
	^ super layoutProperties! !

!GLMBrick methodsFor: 'brick-structure-testing' stamp: ''!
isBrick

	^ true! !

!GLMBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 2/25/2015 16:27'!
announcer

	^ super announcer! !

!GLMBrick methodsFor: 'private-geometry' stamp: ''!
globalBoundsTranslateFactor

	^ self owner ifNotNil: [ self owner globalBoundsTranslateFactor + self brickBounds origin ] ifNil: [ 0@0 ]! !

!GLMBrick methodsFor: 'brick-geometry' stamp: ''!
width

	^ self brickBounds width! !

!GLMBrick methodsFor: 'brick-structure' stamp: ''!
withAllSubbricks

	^ self allSubbricks add: self;
		 yourself! !

!GLMBrick methodsFor: 'private-extension' stamp: 'AliakseiSyrel 1/20/2015 18:29'!
setProperty: aSymbol toValue: anObject
	
	super setProperty: aSymbol toValue: anObject! !

!GLMBrick methodsFor: 'brick-properties' stamp: ''!
borderDo: aBlock

	aBlock cull: self border.
	^ self! !

!GLMBrick methodsFor: 'brick-structure-adding/removing' stamp: ''!
removeAllBricks
	|copy|
	copy := self subbricks copy.
	self privateRemoveAllBricks.
	copy do: [ :b | self privatePrepareBrickAfterRemoving: b ].
	self doLayoutForce! !

!GLMBrick methodsFor: 'brick-properties' stamp: ''!
color

	^ self valueOfProperty: #brickBackgroundColor ifAbsent: [ self themer backgroundColor ]! !

!GLMBrick methodsFor: 'private-structure' stamp: 'AliakseiSyrel 1/25/2015 15:46'!
privateSubbricks: aCollection

	submorphs := aCollection! !

!GLMBrick methodsFor: 'morph-common' stamp: 'AliakseiSyrel 1/21/2015 13:21'!
submorphAfter

	^ self subbrickAfter! !

!GLMBrick methodsFor: 'brick-geometry' stamp: 'AliakseiSyrel 1/21/2015 12:25'!
bounds

	^ self globalBounds! !

!GLMBrick methodsFor: 'brick-geometry-properties' stamp: ''!
vPadding

	^ self paddingTop + self paddingBottom! !

!GLMBrick methodsFor: 'brick-structure-testing' stamp: ''!
isFoundationBrick

	^ false! !

!GLMBrick methodsFor: 'brick-geometry' stamp: ''!
innerBounds
	"can be used in layouts"
	^ self wrappedBounds innerBounds! !

!GLMBrick methodsFor: 'private-layout' stamp: ''!
resetLayout

	self vResizing: #rigid.
	self hResizing: #rigid.
	self height: nil.
	self width: nil! !

!GLMBrick methodsFor: 'brick-geometry-transformations' stamp: ''!
position: aPoint

	self translateBy: (aPoint asNonFractionalPoint - self brickBounds topLeft)! !

!GLMBrick methodsFor: 'brick-layout-properties' stamp: ''!
useVerticalLinearLayout

	self layout: GLMVerticalLinearLayout uniqueInstance! !

!GLMBrick methodsFor: 'brick-geometry-transformations' stamp: ''!
translateY: anInteger

	self wrappedBounds translateY: anInteger! !

!GLMBrick methodsFor: 'brick-structure-converting' stamp: ''!
morph
	^ self! !

!GLMBrick methodsFor: 'brick-properties' stamp: ''!
markBorderColor: aColor width: anInteger

	self setProperty: #brickMarkBorderColor toValue: aColor.
	self setProperty: #brickMarkBorderWidth toValue: anInteger! !

!GLMBrick methodsFor: 'brick-layout-events' stamp: ''!
onLayoutEvent: aLayoutEvent
	"in case layout want's to trigger any specific event"! !

!GLMBrick methodsFor: 'morph-common' stamp: 'AliakseiSyrel 2/9/2015 14:42'!
taskThumbnailOfSize: thumbExtent
	"Answer a new task thumbnail for the receiver."

	|f t r|
	r := self globalBounds scaledAndCenteredIn: (0@0 extent: thumbExtent).
	f := Form extent: r extent depth: Display depth.
	t := MatrixTransform2x3 withScale: f extent / self extent.
	f getCanvas
		transformBy: t
		clippingTo: f boundingBox
		during: [:c | c translateBy: self globalBounds topLeft negated during: [:ct | self fullDrawOn: ct]]
		smoothing: 2.
	^ImageMorph new
		form: f! !

!GLMBrick methodsFor: 'private-extension' stamp: 'AliakseiSyrel 1/20/2015 22:16'!
valueOfProperty: aSymbol ifAbsent: aBlock
	
	^ super valueOfProperty: aSymbol ifAbsent: aBlock! !

!GLMBrick methodsFor: 'brick-structure' stamp: ''!
firstOwnerSuchThat: conditionBlock

	self allOwnersDo: [:m | (conditionBlock cull: m) ifTrue: [^ m]].
	^ nil
! !

!GLMBrick methodsFor: 'brick-layout-properties' stamp: ''!
useHorizontalLinearLayout

	self layout: GLMHorizontalLinearLayout uniqueInstance! !

!GLMBrick methodsFor: 'brick-geometry-properties' stamp: ''!
marginBottom: anObject
	<brickBuilderProperty: #Geometry name: 'Margin Bottom' as: #asInteger getter: #marginBottom model: #GLMUIBuilderTextFieldProperty>
	
	self wrappedBounds marginBottom: anObject! !

!GLMBrick methodsFor: 'brick-properties' stamp: ''!
themer

	^ self privateThemer
		ifNotNil: [ self privateThemer ]
		ifNil: [ self hasOwner
			ifTrue: [ self owner themer ]
			ifFalse: [ self theme brickThemer ] ]! !

!GLMBrick methodsFor: 'brick-geometry-properties' stamp: ''!
paddingLeft

	^ self wrappedBounds paddingLeft! !

!GLMBrick methodsFor: 'brick-structure' stamp: ''!
allSubbricksDo: aBlock

	self subbricks do: [:each | 
		each isBrick ifTrue: [ aBlock value: each. each allSubbricksDo: aBlock ] ]! !

!GLMBrick methodsFor: 'brick-structure-opening' stamp: ''!
openInBrickWindowLabeled: aLabel
	
	#GLMSystemWindowBrick asClassIfAbsent: [ 
		^ self asMorph openInWindow ].
	
	^ #GLMSystemWindowBrick asClass new
		label: aLabel;
		color: Color transparent;
		addBrickBack: (
			GLMBrick new
				vSpaceFill
				hSpaceFill;
				addBrickBack: self;
				yourself);
		extent: 400@400;
		openCenteredInWorld! !

!GLMBrick methodsFor: 'private-structure' stamp: ''!
privateAddBrickLinkBack: aBrick
	|link brick|
	
	brick := aBrick asBrick.
	link := brick asDoubleLink.
	brick brickDoubleLink: link.
	
	self hasSubbricks ifTrue: [
		self lastSubbrick brickDoubleLink nextLink: link.	
		link previousLink: self lastSubbrick brickDoubleLink ].
	
	brick owner: self.
	
	^ aBrick! !

!GLMBrick methodsFor: 'brick-properties' stamp: ''!
shadowWidth

	^ self valueOfProperty: #brickShadowWidth ifAbsentPut: [ 0 ]! !

!GLMBrick methodsFor: 'brick-structure' stamp: ''!
allOwnersDo: aBlock
	"Evaluate aBlock with all owners of the receiver"
	self owner ifNotNil:[ ^ self owner withAllOwnersDo: aBlock ].! !

!GLMBrick methodsFor: 'private-extension' stamp: 'AliakseiSyrel 1/20/2015 22:16'!
valueOfProperty: aSymbol
	
	^ super valueOfProperty: aSymbol! !

!GLMBrick methodsFor: 'brick-structure-adding/removing' stamp: ''!
addBrickFirst: aBrick
	|result|
	result := self privateAddBrickFirst: aBrick asBrick.
	self privatePrepareBrickAfterAdding: result.
	self doLayoutForce.
	^ aBrick! !

!GLMBrick methodsFor: 'brick-properties-events' stamp: ''!
when: aventName do: aBlock

	self announcer when: aventName do: aBlock! !

!GLMBrick methodsFor: 'brick-geometry-properties' stamp: ''!
paddingTop

	^ self wrappedBounds paddingTop! !

!GLMBrick methodsFor: 'brick-properties' stamp: ''!
shadowColor

	^ self valueOfProperty: #brickShadowColor ifAbsentPut: [ Color transparent ]! !

!GLMBrick methodsFor: 'brick-structure-adding/removing' stamp: ''!
addBrick: aBrick after: otherBrick
	|result|
	result := self privateAddBrick: aBrick asBrick after: otherBrick.
	self privatePrepareBrickAfterAdding: result.
	self doLayoutForce.
	^ aBrick! !

!GLMBrick methodsFor: 'brick-structure-events' stamp: ''!
onRemovedFrom: aBrick
	"is called when brick is removed from aBrick"
	self subbricks do: [ :each | each onRemovedFrom: aBrick ]! !

!GLMBrick methodsFor: 'brick-geometry-properties' stamp: ''!
maxHeight: anObject

	self layout maxHeight: anObject! !

!GLMBrick methodsFor: 'brick-geometry' stamp: ''!
globalOuterBounds
	"converts local outer bounds to global inner bounds on fly"
	
	^ self owner ifNotNil: [ self outerBounds translateBy: self owner globalBoundsTranslateFactor ] ifNil: [ self outerBounds ].! !

!GLMBrick methodsFor: 'brick-geometry-properties' stamp: ''!
paddingBottom

	^ self wrappedBounds paddingBottom! !

!GLMBrick methodsFor: 'brick-geometry' stamp: 'AliakseiSyrel 1/29/2015 23:52'!
wrappedBounds

	^ brickBounds ifNil: [ brickBounds := GLMBrickBounds new ]! !

!GLMBrick methodsFor: 'brick-geometry-properties' stamp: ''!
minWidth: anObject

	self layout minWidth: anObject! !

!GLMBrick methodsFor: 'private-geometry' stamp: ''!
updateWidth
	"no need to care about width, when it's logic is not customized"
	self layout isWidthCustom ifFalse: [ ^ self ].
	[ self bounds: (self brickBounds withWidth: self customWidth) ]
		on: Exception
		do: [ "just skip and do nothing" ]! !

!GLMBrick methodsFor: 'brick-geometry-transformations' stamp: ''!
withWidth: anInteger

	self wrappedBounds width: anInteger! !

!GLMBrick methodsFor: 'brick-structure-opening' stamp: ''!
openCenteredInBrickWindowLabeled: aLabel

	self
		vAlign: #center;
		hAlign: #center;
		openInBrickWindowLabeled: aLabel! !

!GLMBrick methodsFor: 'brick-structure' stamp: 'AliakseiSyrel 1/20/2015 22:41'!
owner

	^ owner! !

!GLMBrick methodsFor: 'morph-drawing' stamp: 'AliakseiSyrel 2/14/2015 12:42'!
changedWith: aBlock

	self changed.
	aBlock cull: self.
	self changed.! !

!GLMBrick methodsFor: 'morph-common' stamp: 'AliakseiSyrel 2/13/2015 17:42'!
isMorphBrick

	^ false! !

!GLMBrick methodsFor: 'brick-layout-properties' stamp: ''!
vSpaceFill: anInteger
	<brickBuilderProperty: #Layout name: 'Vertical percent' as: #asInteger getter: #vPercent model: #GLMUIBuilderTextFieldProperty>

	self layout vSpaceFill: anInteger! !

!GLMBrick methodsFor: 'brick-properties' stamp: ''!
shadowColor: aColor
	<brickBuilderProperty: #'Look&Feel' name: 'Shadow Color' as: #brickBuilderEvaluate getter: #shadowColor model: #GLMUIBuilderTextFieldProperty>

	self setProperty: #brickShadowColor toValue: aColor! !

!GLMBrick methodsFor: 'brick-layout' stamp: ''!
invalidateWith: aBlock

	aBlock cull: self.
	self doLayoutForce.! !

!GLMBrick methodsFor: 'private-structure' stamp: ''!
privateRemoveAllBricks
	
	self hasSubbricks ifFalse: [ ^ self ].
	self subbricks do: [:each |
		each brickDoubleLink: nil.
		each owner: nil ].
	self subbricks removeAll! !

!GLMBrick methodsFor: 'brick-layout' stamp: 'AliakseiSyrel 2/3/2015 10:57'!
layoutProperties: aLayoutProperties 

	super layoutProperties: aLayoutProperties! !

!GLMBrick methodsFor: 'brick-structure' stamp: ''!
subbricksCount

	^ self subbricks size! !

!GLMBrick methodsFor: 'brick-properties' stamp: ''!
borderColor: anObject
	<brickBuilderProperty: #'Look&Feel' name: 'Border color' as: #brickBuilderEvaluate getter: #borderColor model: #GLMUIBuilderTextFieldProperty>

	self border color: anObject! !

!GLMBrick methodsFor: 'brick-geometry-properties' stamp: ''!
paddingRight

	^ self wrappedBounds paddingRight! !

!GLMBrick class methodsFor: 'utils' stamp: 'AliakseiSyrel 2/9/2015 14:31'!
makeForm32Bit: aForm
	aForm ifNil: [ ^ nil ].
	aForm depth = 32 ifTrue: [ ^ aForm ].
	aForm depth: 32.
	aForm fixAlpha.
	^ aForm.! !

!GLMBrick class methodsFor: 'utils' stamp: 'AliakseiSyrel 2/9/2015 14:31'!
increaseFormExtentCentered: aForm to: aPoint
	| icon rect destination |
	
	aForm ifNil: [ ^ nil ].
	rect := Rectangle origin: 0@0 extent: aPoint.
	destination := (rect extent - aForm extent) / 2.
	icon := Form extent: rect extent depth: aForm depth.
	icon copyBits: rect from: aForm at: destination clippingBox: icon boundingBox rule: Form over fillColor: nil.
	^ icon! !

!GLMBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:17'!
gtExampleZindex
	<gtExample: 'Example of z-index support in Brick'>
	
	^ GLMBrick new
		hSpaceFill;
		vSpaceFill;
		color: Color blue;
		addBrickBack: (
			GLMBrick new
				color: Color green;
				brickBounds: (100@100 extent: 100@100);
				zIndex: 3);
		addBrickBack: (
			GLMBrick new
				color: Color yellow;
				brickBounds: (50@50 extent: 200@100);
				zIndex: 2);
		addBrickBack: (
			GLMBrick new
				color: Color red;
				brickBounds: (0@0 extent: 300@200);
				zIndex: 1);
		yourself! !

!GLMBrick class methodsFor: 'utils' stamp: 'AliakseiSyrel 2/9/2015 14:32'!
resizeImage: anImage scale: aScale

	((aScale > (1@0)) | (aScale > (0@1))) ifTrue: [
		^ self increaseFormExtentCentered: anImage to: (anImage extent * aScale).
	].

	aScale = (1@1) ifTrue: [
		^ anImage
	].
	
	^ anImage magnify: anImage boundingBox by: aScale smoothing: 2.! !

!GLMBrick class methodsFor: 'utils' stamp: 'AliakseiSyrel 2/9/2015 14:32'!
scaleForm: aForm to: aPoint
	|scaleX scaleY|
	
	aForm ifNil: [ ^ nil ].
	scaleX := aPoint x / aForm width.
	scaleY := aPoint y / aForm height.
	^ self scaleForm: aForm by: scaleX @ scaleY.! !

!GLMBrick class methodsFor: 'utils' stamp: 'AliakseiSyrel 2/9/2015 14:32'!
scalePatchForm: aForm size: aPoint
	"aPoint - width and height of new form
	
|form|

form := PatchForm scalePatchForm: (ImageReadWriter formFromFileNamed: 'abc_calculator_button_normal.p.png') size:800@800.
(ImageMorph withForm: form) openInWindow.

form := ImageReadWriter formFromFileNamed: 'abc_calculator_button_normal.png'.
form := PatchForm scaleForm: form by: (800/(form extent x))@(800/(form extent y)).
(ImageMorph withForm: form) openInWindow.
	
	"
	
	|x0 x1 y0 y1 width height newForm tmpForm color bottomHeight rightWidth newMiddleWidth newMiddleHeight|
	
	aForm ifNil: [ ^ nil ].
	
	color := Color red.
	x0 := x1 := y0 := y1 := 0.
	width := aForm extent x.
	height := aForm extent y.
	
	(0 to: width-1) collect: [ :each |
		(aForm colorAt: each@0) = color ifTrue: [ 
			x0 = 0 ifTrue: [ 
				x0 := each.
			]
		] ifFalse:[
			(x0 > 0 & x1 = 0) ifTrue:[
				x1 := each.
			].
		].
	].

	(0 to: height) collect: [ :each |
		(aForm colorAt: 0@each) = color ifTrue: [ 
			y0 = 0 ifTrue: [ 
				y0 := each.
			]
		] ifFalse:[
			(y0 > 0 & y1 = 0) ifTrue:[
				y1 := each.
			].
		].
	].

	rightWidth := width - x1 -1.
	bottomHeight := height - y1 - 1.
	newMiddleWidth := aPoint x - x0 - rightWidth + 1.
	newMiddleHeight := aPoint y - y0 - bottomHeight + 1.
	
	newForm := Form extent: aPoint depth: aForm depth.
	"left top corner"
	newForm copyBits: (1@1 corner: x0@y0)
		from: aForm at: 0@0 clippingBox: newForm boundingBox rule: Form over fillColor: nil.
	"left bottom corner"
	newForm copyBits: (1@y1 corner: x0@(height - 1))
		from: aForm at: 0@(aPoint y - bottomHeight) clippingBox: newForm boundingBox rule: Form over fillColor: nil.
	"right top corner"
	newForm copyBits: (x1@1 corner: (width-1)@y0)
		from: aForm at: (aPoint x - rightWidth)@0 clippingBox: newForm boundingBox rule: Form over fillColor: nil.
	"right bottom corner"
	newForm copyBits: (x1@y1 corner: (width - 1)@(height - 1))
		from: aForm at: (aPoint x - rightWidth)@(aPoint y - bottomHeight) clippingBox: newForm boundingBox rule: Form over fillColor: nil.
	
	"top middle block"
	tmpForm := aForm copy: (x0@1 corner: x1@y0).
	tmpForm := self scaleForm: tmpForm by: ((newMiddleWidth)/(x1-x0))@1.
	newForm copyBits: (0@0 corner: (tmpForm extent x)@(tmpForm extent y))
		from: tmpForm at: (x0-1)@0 clippingBox: newForm boundingBox rule: Form over fillColor: nil.
		
	"bottom middle block"
	tmpForm := aForm copy: (x0@y1 corner: x1@height).
	tmpForm := self scaleForm: tmpForm by: ((newMiddleWidth)/(x1-x0))@1.
	newForm copyBits: (0@0 corner: (tmpForm extent x)@(tmpForm extent y))
		from: tmpForm at: (x0-1)@(aPoint y - bottomHeight) clippingBox: newForm boundingBox rule: Form over fillColor: nil.
	
	"left middle block"
	tmpForm := aForm copy: (1@y0 corner: x0@y1).
	tmpForm := self scaleForm: tmpForm by: 1@((newMiddleHeight)/(y1-y0)).
	newForm copyBits: (0@0 corner: (tmpForm extent x)@(tmpForm extent y))
		from: tmpForm at: 0@(y0-1) clippingBox: newForm boundingBox rule: Form over fillColor: nil.
	
	"right middle block"
	tmpForm := aForm copy: (x1@y0 corner: width@y1).
	tmpForm := self scaleForm: tmpForm by: 1@((newMiddleHeight)/(y1-y0)).
	newForm copyBits: (0@0 corner: (tmpForm extent x)@(tmpForm extent y))
		from: tmpForm at: (aPoint x - rightWidth)@(y0-1) clippingBox: newForm boundingBox rule: Form over fillColor: nil.
		
	"middle block"
	tmpForm := aForm copy: (x0@y0 corner: x1@y1).
	tmpForm := self scaleForm: tmpForm by: ((newMiddleWidth)/(x1-x0))@((newMiddleHeight)/(y1-y0)).
	newForm copyBits: (0@0 corner: (tmpForm extent x)@(tmpForm extent y))
		from: tmpForm at: (x0-1)@(y0-1) clippingBox: newForm boundingBox rule: Form over fillColor: nil.
	
	^ newForm.
	
! !

!GLMBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:41'!
exampleZindexOpen
	"
	self exampleZindexOpen
	"
	self gtExampleZindex openInBrickWindowLabeled: 'Z-Index example'! !

!GLMBrick class methodsFor: 'utils' stamp: 'AliakseiSyrel 2/9/2015 14:32'!
scaleForm: aForm by: aPoint

	aForm ifNil: [ ^ nil ].
	^ aForm magnify: aForm boundingBox by: aPoint smoothing: 2! !

!GLMBrick class methodsFor: 'utils' stamp: 'AliakseiSyrel 2/9/2015 14:32'!
makeFormTransparent: aForm factor: aFloat
	"a float must be in interval [0.0, 1.0]"
	| a |
	
	aForm ifNil: [ ^ nil ].
	aForm depth = 32 ifFalse: [^ aForm ].
	
	a := (aFloat * 255) asInteger.
	1 to: aForm bits size do: [:i |
		| v r g b |
		v := aForm bits at: i.
		r := ((v bitShift: -16) bitAnd: 255) * a // 255.
		g := ((v bitShift: -8) bitAnd: 255) * a // 255.
		b := (v bitAnd: 255) * a // 255.
		aForm bits at: i put: (a bitShift: 24) + (r bitShift: 16) + (g bitShift: 8) + b ].
	^ aForm ! !

!GLMBrickAbstractModel commentStamp: 'AliakseiSyrel 12/6/2014 20:15'!
A GLMBrickAbstractAdaptor is an interface for all adaptors to be used with brick lazy widgets!
!GLMBrickAbstractModel methodsFor: 'adaptor api' stamp: 'AliakseiSyrel 12/6/2014 18:50'!
count

	self subclassResponsibility! !

!GLMBrickAbstractModel methodsFor: 'adaptor api' stamp: 'AliakseiSyrel 12/6/2014 18:53'!
morphAt: anInteger convert: aMorph

	self subclassResponsibility! !

!GLMBrickAnnouncement commentStamp: 'AliakseiSyrel 10/17/2014 10:11'!
A GLMBrickAnnouncement is default announcement used for any purpose by bricks.

Instance Variables
	data:		<Object>

data
	- xxxxx
!
!GLMBrickAnnouncement methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/4/2014 16:22'!
data: anObject
	data := anObject! !

!GLMBrickAnnouncement methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/4/2014 16:22'!
data
	^ data! !

!GLMBrickBorder methodsFor: 'color' stamp: 'AliakseiSyrel 2/11/2015 11:29'!
colorRight: aColor

	self color at: Right put: aColor! !

!GLMBrickBorder methodsFor: 'color' stamp: 'AliakseiSyrel 2/11/2015 11:53'!
colorBottom

	^ self color at: Bottom! !

!GLMBrickBorder methodsFor: 'width' stamp: 'AliakseiSyrel 2/11/2015 11:41'!
width: widths
	"The widths property can have from one to four values:
	
	width: #(25 50 75 100)
		top width is 25px
		right width is 50px
		bottom width is 75px
		left width is 100px
		
	width: #(25 50 75)
		top width is 25px
		right and left widths are 50px
		bottom width is 75px
		
	width: #(25 50)
		top and bottom widths are 25px
		right and left widths are 50px
		
	width: #(25)
		all four widths are 25px
		
	width: 25
		all four widths are 25px"
	
	widths ifNil: [ ^ self width: #(0) ].
	
	widths isCollection ifTrue: [
		widths isEmpty ifTrue: [ ^ self width: #(0) ].
		self
			widthTop: (widths at: 1);
			widthRight: (widths at: 1);
			widthBottom: (widths at: 1);
			widthLeft: (widths at: 1).
		widths size > 1 ifTrue: [
			self
				widthRight: (widths at: 2);
				widthLeft: (widths at: 2) ].
		widths size > 2 ifTrue: [
			self widthBottom: (widths at: 3) ].
		widths size > 3 ifTrue: [
			self widthLeft: (widths at: 4) ] ]
	ifFalse: [ ^ self width: {widths} ]! !

!GLMBrickBorder methodsFor: 'width' stamp: 'AliakseiSyrel 2/11/2015 11:37'!
widthBottom: anInteger

	self width at: Bottom put: anInteger! !

!GLMBrickBorder methodsFor: 'width' stamp: 'AliakseiSyrel 2/11/2015 11:29'!
width

	^ width ifNil: [ width := Array braceWith: 0 with: 0 with: 0 with: 0 ]! !

!GLMBrickBorder methodsFor: 'width' stamp: 'AliakseiSyrel 2/11/2015 11:37'!
widthLeft

	^ self width at: Left! !

!GLMBrickBorder methodsFor: 'color' stamp: 'AliakseiSyrel 2/11/2015 11:53'!
colorTop

	^ self color at: Top! !

!GLMBrickBorder methodsFor: 'width' stamp: 'AliakseiSyrel 2/11/2015 11:37'!
widthTop

	^ self width at: Top! !

!GLMBrickBorder methodsFor: 'color' stamp: 'AliakseiSyrel 2/11/2015 11:38'!
colorLeft: aColor
	"aColor may be any object, it will be called with brickValue: aBrick"
	self color at: Left put: aColor! !

!GLMBrickBorder methodsFor: 'color' stamp: 'AliakseiSyrel 2/11/2015 11:29'!
colorTop: aColor

	self color at: Top put: aColor! !

!GLMBrickBorder methodsFor: 'color' stamp: 'AliakseiSyrel 2/11/2015 11:36'!
color: colors
	"The colors property may have from one to four values:
	
	color: { Color red . Color blue . Color green . Color yellow }
		top color is red
		right color is blue
		bottom color is green
		left color is yellow
		
	color: { Color red . Color blue . Color green }
		top color is red
		right and left colors are blue
		bottom color is green
		
	color: { Color red . Color blue }
		top and bottom colors are red
		right and left colors are blue
		
	color: { Color red }
		all four colors are red
		
	color: Color red
		all four colors are red"
	
	colors ifNil: [ ^ self color: #(0) ].
	
	colors isCollection ifTrue: [
		colors isEmpty ifTrue: [ ^ self color: #(0) ].
		self
			colorTop: (colors at: 1);
			colorRight: (colors at: 1);
			colorBottom: (colors at: 1);
			colorLeft: (colors at: 1).
		colors size > 1 ifTrue: [
			self
				colorRight: (colors at: 2);
				colorLeft: (colors at: 2) ].
		colors size > 2 ifTrue: [
			self colorBottom: (colors at: 3) ].
		colors size > 3 ifTrue: [
			self colorLeft: (colors at: 4) ] ]
	ifFalse: [ ^ self color: { colors } ].! !

!GLMBrickBorder methodsFor: 'width' stamp: 'AliakseiSyrel 2/11/2015 11:37'!
widthBottom

	^ self width at: Bottom! !

!GLMBrickBorder methodsFor: 'width' stamp: 'AliakseiSyrel 2/11/2015 11:39'!
widthLeft: anInteger

	self width at: Left put: anInteger! !

!GLMBrickBorder methodsFor: 'width' stamp: 'AliakseiSyrel 2/11/2015 11:39'!
widthTop: anInteger

	self width at: Top put: anInteger! !

!GLMBrickBorder methodsFor: 'width' stamp: 'AliakseiSyrel 2/11/2015 11:37'!
widthRight

	^ self width at: Right! !

!GLMBrickBorder methodsFor: 'color' stamp: 'AliakseiSyrel 2/11/2015 11:53'!
colorRight

	^ self color at: Right! !

!GLMBrickBorder methodsFor: 'color' stamp: 'AliakseiSyrel 2/11/2015 11:29'!
color

	^ color ifNil: [ color := Array braceWith: Color transparent with: Color transparent with: Color transparent with: Color transparent ]! !

!GLMBrickBorder methodsFor: 'color' stamp: 'AliakseiSyrel 2/11/2015 11:53'!
colorLeft

	^ self color at: Left! !

!GLMBrickBorder methodsFor: 'width' stamp: 'AliakseiSyrel 2/11/2015 11:39'!
widthRight: anInteger

	self width at: Right put: anInteger! !

!GLMBrickBorder methodsFor: 'rendering' stamp: 'AliakseiSyrel 3/31/2015 16:12'!
renderBorderOf: aBrick on: aCanvas
	|canvas widthLeft widthRight widthTop widthBottom colorLeft colorRight colorTop colorBottom|
	
	canvas := aCanvas.
	
	widthLeft := self widthLeft brickValue: aBrick.
	widthRight := self widthRight brickValue: aBrick.
	widthTop := self widthTop brickValue: aBrick.
	widthBottom := self widthBottom brickValue: aBrick.
	
	colorLeft := self colorLeft brickValue: aBrick.
	colorRight := self colorRight brickValue: aBrick.
	colorTop := self colorTop brickValue: aBrick.
	colorBottom := self colorBottom brickValue: aBrick.
	
	canvas
		fillRectangle: (aBrick brickBounds origin extent: ((aBrick brickBounds width - widthRight) @ widthTop))
		color: colorTop.
		
	canvas
		fillRectangle: ((aBrick brickBounds right - widthRight) @ aBrick brickBounds top corner: (aBrick brickBounds corner - (0@widthBottom)))
		color: colorRight.
		
	canvas
		fillRectangle: ((aBrick brickBounds bottomLeft - (widthLeft negated @ widthBottom)) corner: aBrick brickBounds corner)
		color: colorBottom.
		
	canvas
		fillRectangle: ((aBrick brickBounds origin + (0@widthTop)) corner: (aBrick brickBounds bottomLeft + (widthLeft@0)))
		color: colorLeft.! !

!GLMBrickBorder methodsFor: 'color' stamp: 'AliakseiSyrel 2/11/2015 11:29'!
colorBottom: aColor

	self color at: Bottom put: aColor! !

!GLMBrickBorder class methodsFor: 'class initialization' stamp: 'JurajKubelka 3/12/2015 15:23'!
initialize
	Top := 1.
	Right := 2.
	Bottom := 3.
	Left := 4! !

!GLMBrickBounds methodsFor: 'accessing - bounds' stamp: 'AliakseiSyrel 2/1/2015 22:02'!
bounds

	^ self brickBounds! !

!GLMBrickBounds methodsFor: 'accessing - margin/padding' stamp: 'AliakseiSyrel 2/5/2015 11:56'!
paddingLeft: anInteger

	self padding at: Left put: anInteger.
	self updateCache! !

!GLMBrickBounds methodsFor: 'testing' stamp: 'AliakseiSyrel 1/30/2015 09:08'!
isHeightDirty

	^ self heightState = #dirty! !

!GLMBrickBounds methodsFor: 'testing' stamp: 'AliakseiSyrel 1/30/2015 09:05'!
isWidthDirty

	^ self widthState = #dirty! !

!GLMBrickBounds methodsFor: 'accessing - bounds' stamp: 'AliakseiSyrel 2/1/2015 22:26'!
innerBounds

	^ innerBounds ifNil: [ self updateCache. innerBounds ]! !

!GLMBrickBounds methodsFor: 'accessing - bounds' stamp: 'AliakseiSyrel 2/1/2015 22:27'!
outerBounds

	^ outerBounds ifNil: [ self updateCache. outerBounds ]! !

!GLMBrickBounds methodsFor: 'transformations' stamp: 'AliakseiSyrel 2/8/2015 20:05'!
translateY: anInteger

	self translateBy: 0@anInteger! !

!GLMBrickBounds methodsFor: 'private' stamp: 'AliakseiSyrel 3/22/2015 19:05'!
brickBounds: aRectangle
	"brickBounds give direct access to the bounds Rectangle"
	bounds := aRectangle ceiling.
	self updateCache! !

!GLMBrickBounds methodsFor: 'accessing - margin/padding' stamp: 'AliakseiSyrel 2/1/2015 22:23'!
marginBottom

	^ self margin at: Bottom! !

!GLMBrickBounds methodsFor: 'accessing - margin/padding' stamp: 'AliakseiSyrel 2/1/2015 22:11'!
margin

	"top right bottom left"
	^ margin ifNil: [ margin := Array braceWith: 0 with: 0 with: 0 with: 0 ]
! !

!GLMBrickBounds methodsFor: 'accessing - margin/padding' stamp: 'AliakseiSyrel 2/8/2015 20:07'!
marginLeft: anInteger

	self translateX: anInteger - self marginLeft.
	self margin at: Left put: anInteger.
	self updateCache! !

!GLMBrickBounds methodsFor: 'marking' stamp: 'AliakseiSyrel 1/30/2015 09:09'!
markHeightDirty

	self heightState: #dirty! !

!GLMBrickBounds methodsFor: 'accessing - margin/padding' stamp: 'AliakseiSyrel 2/8/2015 20:09'!
marginBottom: anInteger

	self translateY: self marginBottom - anInteger.
	self margin at: Bottom put: anInteger.
	self updateCache! !

!GLMBrickBounds methodsFor: 'marking' stamp: 'AliakseiSyrel 1/30/2015 09:06'!
markWidthDirty

	self widthState: #dirty! !

!GLMBrickBounds methodsFor: 'geometry' stamp: 'AliakseiSyrel 2/1/2015 22:52'!
width: anInteger

	self brickBounds: (self brickBounds withWidth: anInteger)! !

!GLMBrickBounds methodsFor: 'accessing - margin/padding' stamp: 'AliakseiSyrel 2/5/2015 11:56'!
paddingTop: anInteger

	self padding at: Top put: anInteger.
	self updateCache! !

!GLMBrickBounds methodsFor: 'accessing - margin/padding' stamp: 'AliakseiSyrel 2/1/2015 22:24'!
paddingLeft

	^ self padding at: Left! !

!GLMBrickBounds methodsFor: 'accessing - margin/padding' stamp: 'AliakseiSyrel 2/1/2015 22:24'!
marginRight

	^ self margin at: Right! !

!GLMBrickBounds methodsFor: 'transformations' stamp: 'AliakseiSyrel 2/8/2015 20:04'!
translateBy: aPoint

	self brickBounds: (self brickBounds translateBy: aPoint)! !

!GLMBrickBounds methodsFor: 'accessing - margin/padding' stamp: 'AliakseiSyrel 1/30/2015 09:07'!
widthState: aSymbol

	widthState := aSymbol! !

!GLMBrickBounds methodsFor: 'geometry' stamp: 'AliakseiSyrel 2/1/2015 22:52'!
extent

	^ self brickBounds extent! !

!GLMBrickBounds methodsFor: 'accessing - margin/padding' stamp: 'AliakseiSyrel 2/1/2015 22:20'!
padding

	"top right bottom left"
	^ padding ifNil: [ padding := Array braceWith: 0 with: 0 with: 0 with: 0 ]
! !

!GLMBrickBounds methodsFor: 'accessing - margin/padding' stamp: 'AliakseiSyrel 2/8/2015 20:08'!
marginRight: anInteger

	self translateX: self marginRight - anInteger.
	self margin at: Right put: anInteger.
	self updateCache! !

!GLMBrickBounds methodsFor: 'transformations' stamp: 'AliakseiSyrel 2/8/2015 20:05'!
translateX: anInteger

	self translateBy: anInteger@0! !

!GLMBrickBounds methodsFor: 'accessing - bounds' stamp: 'AliakseiSyrel 2/3/2015 15:33'!
heightState

	^ heightState ifNil: [ heightState := #dirty ]! !

!GLMBrickBounds methodsFor: 'accessing - margin/padding' stamp: 'AliakseiSyrel 2/8/2015 20:08'!
marginTop: anInteger

	self translateY: anInteger - self marginTop.
	self margin at: Top put: anInteger.
	self updateCache! !

!GLMBrickBounds methodsFor: 'testing' stamp: 'AliakseiSyrel 1/30/2015 09:08'!
isHeightClean

	^ self heightState = #clean! !

!GLMBrickBounds methodsFor: 'accessing - bounds' stamp: 'AliakseiSyrel 2/8/2015 12:42'!
bounds: aRectangle
	"changes bounds and marks width or height as dirty if it changes"
	self updateState: aRectangle.
	self brickBounds: aRectangle! !

!GLMBrickBounds methodsFor: 'testing' stamp: 'AliakseiSyrel 1/30/2015 09:05'!
isWidthClean

	^ self widthState = #clean! !

!GLMBrickBounds methodsFor: 'private' stamp: 'AliakseiSyrel 2/1/2015 22:03'!
brickBounds
	"brickBounds give direct access to the bounds Rectangle"
	^ bounds ifNil: [ bounds := 0@0 corner: 50@50 ]

	! !

!GLMBrickBounds methodsFor: 'accessing - margin/padding' stamp: 'AliakseiSyrel 2/5/2015 11:56'!
padding: paddings
	"The paddings property can have from one to four values:
	
	padding: #(25 50 75 100)
		top padding is 25px
		right padding is 50px
		bottom padding is 75px
		left padding is 100px
		
	padding: #(25 50 75)
		top padding is 25px
		right and left paddings are 50px
		bottom padding is 75px
		
	padding: #(25 50)
		top and bottom paddings are 25px
		right and left paddings are 50px
		
	padding: #(25)
		all four paddings are 25px
		
	padding: 25
		all four paddings are 25px"
	
	paddings ifNil: [ ^ self padding: #(0) ].
	
	paddings isCollection ifTrue: [
		paddings isEmpty ifTrue: [ ^ self padding: #(0) ].
		self
			paddingTop: (paddings at: Top);
			paddingRight: (paddings at: Top);
			paddingBottom: (paddings at: Top);
			paddingLeft: (paddings at: Top).
		paddings size > Top ifTrue: [
			self
				paddingRight: (paddings at: Right);
				paddingLeft: (paddings at: Right) ].
		paddings size > Right ifTrue: [
			self paddingBottom: (paddings at: Bottom) ].
		paddings size > Bottom ifTrue: [
			self paddingLeft: (paddings at: Left) ] ]
	ifFalse: [ ^ self padding: { paddings } ].
	self updateCache! !

!GLMBrickBounds methodsFor: 'geometry' stamp: 'AliakseiSyrel 2/1/2015 22:51'!
height: anInteger

	self brickBounds: (self brickBounds withHeight: anInteger)! !

!GLMBrickBounds methodsFor: 'private' stamp: 'AliakseiSyrel 2/8/2015 12:43'!
updateState: aRectangle

	self brickBounds width = aRectangle width ifFalse: [ self markWidthDirty ].
	self brickBounds height = aRectangle height ifFalse: [ self markHeightDirty ]! !

!GLMBrickBounds methodsFor: 'accessing - margin/padding' stamp: 'AliakseiSyrel 2/1/2015 22:25'!
paddingTop

	^ self padding at: Top! !

!GLMBrickBounds methodsFor: 'accessing - margin/padding' stamp: 'AliakseiSyrel 2/5/2015 11:56'!
paddingRight: anInteger

	self padding at: Right put: anInteger.
	self updateCache! !

!GLMBrickBounds methodsFor: 'accessing - margin/padding' stamp: 'AliakseiSyrel 2/1/2015 22:24'!
marginLeft

	^ self margin at: Left! !

!GLMBrickBounds methodsFor: 'marking' stamp: 'AliakseiSyrel 1/30/2015 09:08'!
markHeightClean

	self heightState: #clean! !

!GLMBrickBounds methodsFor: 'accessing - margin/padding' stamp: 'AliakseiSyrel 2/1/2015 22:25'!
paddingBottom

	^ self padding at: Bottom! !

!GLMBrickBounds methodsFor: 'geometry' stamp: 'AliakseiSyrel 2/8/2015 16:06'!
outerWidth: anInteger

	self brickBounds: (self brickBounds withWidth: (anInteger - self marginLeft - self marginRight))! !

!GLMBrickBounds methodsFor: 'marking' stamp: 'AliakseiSyrel 1/30/2015 09:06'!
markWidthClean

	self widthState: #clean! !

!GLMBrickBounds methodsFor: 'accessing - margin/padding' stamp: 'AliakseiSyrel 2/5/2015 11:55'!
margin: margins
	"The margins property can have from one to four values:
	
	margin: #(25 50 75 100)
		top margin is 25px
		right margin is 50px
		bottom margin is 75px
		left margin is 100px
		
	margin: #(25 50 75)
		top margin is 25px
		right and left margins are 50px
		bottom margin is 75px
		
	margin: #(25 50)
		top and bottom margins are 25px
		right and left margins are 50px
		
	margin: #(25)
		all four margins are 25px
		
	margin: 25
		all four margins are 25px"
	
	margins ifNil: [ ^ self margin: #(0) ].
	
	margins isCollection ifTrue: [
		margins isEmpty ifTrue: [ ^ self margin: #(0) ].
		self
			marginTop: (margins at: 1);
			marginRight: (margins at: 1);
			marginBottom: (margins at: 1);
			marginLeft: (margins at: 1).
		margins size > 1 ifTrue: [
			self
				marginRight: (margins at: 2);
				marginLeft: (margins at: 2) ].
		margins size > 2 ifTrue: [
			self marginBottom: (margins at: 3) ].
		margins size > 3 ifTrue: [
			self marginLeft: (margins at: 4) ] ]
	ifFalse: [ ^ self margin: {margins} ].
	
	self updateCache! !

!GLMBrickBounds methodsFor: 'accessing - margin/padding' stamp: 'AliakseiSyrel 2/1/2015 22:24'!
marginTop

	^ self margin at: Top! !

!GLMBrickBounds methodsFor: 'private' stamp: 'AliakseiSyrel 2/8/2015 19:57'!
updateCache
	|left top right bottom |
	
	left := self brickBounds origin x.
	top := self brickBounds origin y.
	right := self brickBounds corner x.
	bottom := self brickBounds corner y.
	
	innerBounds := ((left + self paddingLeft)@(top + self paddingTop)) corner: ((right - self paddingRight)@(bottom - self paddingBottom)).
	outerBounds := ((left - self marginLeft)@(top - self marginTop)) corner: ((right + self marginRight)@(bottom + self marginBottom)).! !

!GLMBrickBounds methodsFor: 'accessing - margin/padding' stamp: 'AliakseiSyrel 2/3/2015 15:33'!
widthState

	^ widthState ifNil: [ widthState := #dirty ]! !

!GLMBrickBounds methodsFor: 'geometry' stamp: 'AliakseiSyrel 2/6/2015 12:29'!
outerOrigin: aPoint
	
	self brickBounds: (aPoint + (self marginLeft @ self marginTop) extent: self extent )! !

!GLMBrickBounds methodsFor: 'accessing - margin/padding' stamp: 'AliakseiSyrel 2/1/2015 22:25'!
paddingRight

	^ self padding at: Right! !

!GLMBrickBounds methodsFor: 'accessing - margin/padding' stamp: 'AliakseiSyrel 2/5/2015 11:56'!
paddingBottom: anInteger

	self padding at: Bottom put: anInteger.
	self updateCache! !

!GLMBrickBounds methodsFor: 'accessing - bounds' stamp: 'AliakseiSyrel 1/30/2015 09:08'!
heightState: aSymbol

	heightState := aSymbol! !

!GLMBrickBounds methodsFor: 'geometry' stamp: 'AliakseiSyrel 2/3/2015 10:08'!
outerHeight: anInteger

	self brickBounds: (self brickBounds withHeight: (anInteger - self marginTop - self marginBottom))! !

!GLMBrickBounds class methodsFor: 'class initialization' stamp: 'JurajKubelka 3/12/2015 15:24'!
initialize	
	Top := 1.
	Right := 2.
	Bottom := 3.
	Left := 4! !

!GLMBrickColorThemer commentStamp: 'AliakseiSyrel 3/21/2015 20:42'!
I define different usefull colors!
!GLMBrickColorThemer methodsFor: 'brick-colors' stamp: 'AliakseiSyrel 3/21/2015 20:56'!
peterRiver

	^ Color brickColorRegistry at: #brickPeterRiver
		ifAbsentPut: [ Color r: 52 g: 152 b: 219 range: 255 ]! !

!GLMBrickColorThemer methodsFor: 'brick-colors' stamp: 'AliakseiSyrel 3/21/2015 20:56'!
emerald

	^ Color brickColorRegistry at: #brickEmerald
		ifAbsentPut: [ Color r: 46 g: 204 b: 113 range: 255 ]! !

!GLMBrickColorThemer methodsFor: 'brick-colors' stamp: 'AliakseiSyrel 3/21/2015 20:56'!
silver

	^ Color brickColorRegistry at: #brickSilver
		ifAbsentPut: [ Color r: 189 g: 195 b: 199 range: 255 ]! !

!GLMBrickColorThemer methodsFor: 'brick-colors' stamp: 'AliakseiSyrel 3/21/2015 21:09'!
whiten

	^ Color brickColorRegistry at: #brickWhiten
		ifAbsentPut: [ Color r: 241 g: 241 b: 241 range: 255 ]! !

!GLMBrickColorThemer methodsFor: 'brick-colors' stamp: 'AliakseiSyrel 3/21/2015 20:55'!
darken

	^ Color brickColorRegistry at: #brickDarken
		ifAbsentPut: [ Color r: 29 g: 29 b: 29 range: 255 ]! !

!GLMBrickColorThemer methodsFor: 'brick-colors' stamp: 'AliakseiSyrel 3/21/2015 21:05'!
clouds

	^ Color brickColorRegistry at: #brickClouds
		ifAbsentPut: [ Color r: 236 g: 240 b: 241 range: 255 ]! !

!GLMBrickColorThemer methodsFor: 'brick-colors' stamp: 'AliakseiSyrel 3/21/2015 20:54'!
alizarin

	^ Color brickColorRegistry at: #brickAlizarin
		ifAbsentPut: [ Color r: 231 g: 76 b: 60 range: 255 ]! !

!GLMBrickDarkThemer methodsFor: 'brick' stamp: 'AliakseiSyrel 3/21/2015 21:09'!
textColor

	^ self color whiten! !

!GLMBrickDarkThemer methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 3/17/2015 22:58'!
popupThemer

	^ self
		registerModule: GLMBrickPopupDarkThemer new! !

!GLMBrickDarkThemer methodsFor: 'brick-button' stamp: 'AndreiChis 3/2/2015 16:53'!
buttonSelectedColor

	^ Color veryDarkGray lighter slightlyDarker! !

!GLMBrickDarkThemer methodsFor: '*GT-Playground' stamp: 'AliakseiSyrel 3/30/2015 12:22'!
bindingThemer

	^ self registerModule: GTPlayBindingDarkThemer new
		to: GLMActionBrickDarkThemer new! !

!GLMBrickDarkThemer methodsFor: 'brick-scrollbar' stamp: 'AliakseiSyrel 1/26/2015 13:58'!
scrollbarColor

	^ Color black alpha: 0.5! !

!GLMBrickDarkThemer methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 3/21/2015 16:33'!
tabLabelThemer

	^ self
		registerModule: GLMBrickTabLabelDarkThemer new! !

!GLMBrickDarkThemer methodsFor: '*Glamour-Morphic-Brick' stamp: 'JurajKubelka 2/28/2015 19:07'!
popupHelpThemer

	^ self
		registerModule: GLMBrickPopupHelpDarkThemer new
		to: self
		named: #popupThemer! !

!GLMBrickDarkThemer methodsFor: '*Glamour-Morphic-Brick' stamp: 'JurajKubelka 2/28/2015 19:08'!
popupErrorThemer

	^ self
		registerModule: GLMBrickPopupErrorDarkThemer new
		to: self
		named: #popupThemer! !

!GLMBrickDarkThemer methodsFor: 'brick' stamp: 'AliakseiSyrel 1/30/2015 12:06'!
contentBackgroundColor

	^ Color darkGray darker! !

!GLMBrickDarkThemer methodsFor: '*Glamour-Morphic-Brick' stamp: 'JurajKubelka 2/28/2015 19:07'!
popupSuccessThemer

	^ self
		registerModule: GLMBrickPopupSuccessDarkThemer new
		to: self
		named: #popupThemer! !

!GLMBrickDarkThemer methodsFor: 'brick-checkbox' stamp: 'AliakseiSyrel 3/17/2015 22:56'!
checkboxBorderColor

	^ Color lightGray! !

!GLMBrickDarkThemer methodsFor: 'brick-button' stamp: 'AndreiChis 3/2/2015 16:52'!
buttonBackgroundColor

	^ Color veryDarkGray lighter! !

!GLMBrickDarkThemer methodsFor: '*Glamour-Core' stamp: 'AliakseiSyrel 3/27/2015 13:18'!
actionThemer

	^ GLMActionBrickDarkThemer new! !

!GLMBrickDarkThemer methodsFor: '*GT-Spotter' stamp: 'AliakseiSyrel 3/17/2015 22:59'!
spotterThemer

	^ self
		registerModule: GTSpotterWidgetDarkThemer new
		to: GTSpotterBrickDarkThemer new! !

!GLMBrickDarkThemer methodsFor: 'brick' stamp: 'AliakseiSyrel 3/21/2015 23:39'!
textSecondaryColor

	^ Color white! !

!GLMBrickDarkThemer methodsFor: 'brick-button' stamp: 'AndreiChis 3/2/2015 16:51'!
buttonPressedColor

	^ self backgroundColor whiter! !

!GLMBrickDataChanged commentStamp: 'AliakseiSyrel 10/17/2014 10:11'!
A GLMBrickDataChanged is fired when GLMBrick>>data is changed
!
!GLMBrickGeneralWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/1/2015 17:55'!
owner

	^ self brick owner ifNotNil: #brickApi! !

!GLMBrickGeneralWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/1/2015 17:18'!
isBrick

	^ self brick isBrick! !

!GLMBrickGeneralWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/1/2015 17:17'!
changed

	^ self brick changed! !

!GLMBrickGeneralWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/3/2015 21:08'!
hState

	^ self layout hState! !

!GLMBrickGeneralWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/3/2015 21:09'!
vState

	^ self layout vState! !

!GLMBrickGeneralWrapper methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/1/2015 17:18'!
brick

	^ brick! !

!GLMBrickGeneralWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/1/2015 17:18'!
layoutPolicy

	^ self brick layoutPolicy! !

!GLMBrickGeneralWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/1/2015 17:54'!
subbricks

	^ self brick subbricks collect:  #brickApi! !

!GLMBrickGeneralWrapper methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/1/2015 17:18'!
brick: aBrick

	brick := aBrick! !

!GLMBrickGeneralWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/1/2015 17:23'!
layout

	^ self brick layoutProperties! !

!GLMBrickGeneralWrapper class methodsFor: 'instance creation' stamp: 'AliakseiSyrel 4/1/2015 17:18'!
on: aBrick

	^ self new brick: aBrick! !

!GLMBrickHeightTraverser methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/2/2015 00:16'!
state

	^ #vState! !

!GLMBrickHeightTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 2/9/2015 23:30'!
hasMinDimensionRestriction: aBrick

	^ aBrick layout hasMinHeight! !

!GLMBrickHeightTraverser methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/1/2015 21:08'!
opposite

	^ GLMBrickWidthTraverser uniqueInstance! !

!GLMBrickHeightTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 4/2/2015 15:34'!
updateDimension: aBrick
	"my height is already calculated, maybe because my children triggered calculation"
	aBrick isHeightClean ifTrue: [ ^ self ].
	
	(self dimensionPolicy: aBrick) updateHeight: aBrick! !

!GLMBrickHeightTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 2/3/2015 16:47'!
customDependencies: aBrick

	^ aBrick layout heightDependencies! !

!GLMBrickHeightTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 4/2/2015 14:02'!
markDirty: aBrick

	self markLayoutDirty: aBrick owner.
	aBrick markHeightDirty! !

!GLMBrickHeightTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 4/2/2015 15:35'!
markClean: aBrick

	aBrick markHeightClean
	! !

!GLMBrickHeightTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 4/2/2015 14:02'!
isClean: aBrick

	^ aBrick isHeightClean! !

!GLMBrickHeightTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 2/9/2015 23:30'!
hasMaxDimensionRestriction: aBrick

	^ aBrick layout hasMaxHeight! !

!GLMBrickHeightTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 4/2/2015 14:02'!
isOppositeClean: aBrick

	^ aBrick isWidthClean! !

!GLMBrickHeightTraverser class methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/1/2015 21:06'!
uniqueInstance
	^ uniqueInstance ifNil: [ uniqueInstance := self new ]! !

!GLMBrickHeightTraverser class methodsFor: 'cleanup' stamp: 'AndreiChis 3/24/2015 18:50'!
cleanUp

	uniqueInstance := nil! !

!GLMBrickLayoutChildrenState methodsFor: 'layouting' stamp: 'AliakseiSyrel 4/2/2015 15:34'!
updateWidth: aBrick on: aLayout

	aBrick withWidth: (aLayout normalizeWidth: (aLayout widthChildrenDependency: aBrick) of: aBrick)! !

!GLMBrickLayoutChildrenState methodsFor: 'layouting' stamp: 'AliakseiSyrel 4/2/2015 00:23'!
layout: aBrick on: aTraverser

	"we need to calculate sizes of all subbricks"
	aTraverser layoutChildrenOf: aBrick.
	"first we calculate corresponding dimension"
	aTraverser updateDimension: aBrick.
	"after everything is done we can mark dimension as clean"
	aTraverser markClean: aBrick.
	"because my dimension changed, maybe my owner would like to adapt"
	aTraverser layoutOwnerOf: aBrick! !

!GLMBrickLayoutChildrenState methodsFor: 'testing' stamp: 'AliakseiSyrel 4/1/2015 23:29'!
isOnChildren
	^ true! !

!GLMBrickLayoutChildrenState methodsFor: 'layouting' stamp: 'AliakseiSyrel 4/2/2015 15:35'!
updateHeight: aBrick on: aLayout

	aBrick withHeight: (aLayout normalizeHeight: (aLayout heightChildrenDependency: aBrick) of: aBrick)! !

!GLMBrickLayoutMyselfState methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/1/2015 23:27'!
dimension: anObject
	dimension := anObject! !

!GLMBrickLayoutMyselfState methodsFor: 'initialization' stamp: 'AliakseiSyrel 4/1/2015 23:37'!
initialize
	super initialize.
	
	dimension := self defaultDimension! !

!GLMBrickLayoutMyselfState methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/1/2015 23:27'!
dimension
	^ dimension! !

!GLMBrickLayoutMyselfState methodsFor: 'layouting' stamp: 'AliakseiSyrel 4/2/2015 15:35'!
updateHeight: aBrick on: aLayout

	aBrick withHeight: (aLayout normalizeHeight: (aLayout heightMyselfDependency: aBrick) of: aBrick)! !

!GLMBrickLayoutMyselfState methodsFor: 'layouting' stamp: 'AliakseiSyrel 4/2/2015 14:04'!
updateWidth: aBrick on: aLayout

	aBrick withWidth: (aLayout normalizeWidth: (aLayout widthMyselfDependency: aBrick) of: aBrick)! !

!GLMBrickLayoutMyselfState methodsFor: 'initialization' stamp: 'AliakseiSyrel 4/1/2015 23:37'!
defaultDimension

	^ 50! !

!GLMBrickLayoutMyselfState methodsFor: 'layouting' stamp: 'AliakseiSyrel 4/2/2015 00:26'!
layout: aBrick on: aTraverser

	"immidiately set my dimension"
	aTraverser updateDimension: aBrick.
	aTraverser markClean: aBrick.
	aTraverser layoutChildrenOf: aBrick.
	aTraverser layoutOwnerOf: aBrick! !

!GLMBrickLayoutMyselfState methodsFor: 'testing' stamp: 'AliakseiSyrel 4/1/2015 23:36'!
isOnMyself

	^ true! !

!GLMBrickLayoutParentState methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/1/2015 23:27'!
percent
	^ percent! !

!GLMBrickLayoutParentState methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/1/2015 23:27'!
percent: anObject
	percent := anObject! !

!GLMBrickLayoutParentState methodsFor: 'initialization' stamp: 'AliakseiSyrel 4/1/2015 23:38'!
initialize
	super initialize.
	
	percent := self defaultPercent! !

!GLMBrickLayoutParentState methodsFor: 'layouting' stamp: 'AliakseiSyrel 4/2/2015 15:38'!
updateHeight: aBrick on: aLayout

	aBrick outerHeight: (aLayout normalizeHeight: (aLayout heightParentDependency: aBrick) of: aBrick)! !

!GLMBrickLayoutParentState methodsFor: 'testing' stamp: 'AliakseiSyrel 4/1/2015 23:30'!
isOnParent
	^ true! !

!GLMBrickLayoutParentState methodsFor: 'layouting' stamp: 'AliakseiSyrel 4/2/2015 15:36'!
updateWidth: aBrick on: aLayout

	aBrick outerWidth: (aLayout normalizeWidth: (aLayout widthParentDependency: aBrick) of: aBrick)! !

!GLMBrickLayoutParentState methodsFor: 'layouting' stamp: 'AliakseiSyrel 4/2/2015 00:26'!
layout: aBrick on: aTraverser

	aBrick owner ifNil: [ ^ aTraverser markClean: aBrick ].
	(aTraverser isDependsOnChildren: aBrick owner) ifTrue: [ Error signal: 'Circle dependency detected!!' ].
	
	"because I depend on my parent, it should be layouted first"
	aTraverser layoutOwnerOf: aBrick.
	"then I can update my dimension"
	aTraverser updateDimension: aBrick.
	"everething is done I can mark dimension as clean"
	aTraverser markClean: aBrick.
	"and I can say my children to layout themselves, because I'm already clean"
	aTraverser layoutChildrenOf: aBrick! !

!GLMBrickLayoutParentState methodsFor: 'layouting' stamp: 'AliakseiSyrel 4/2/2015 13:30'!
layoutPolicy: aBrick on: aTraverser

	^ (aBrick owner
		ifNil: [ aBrick ]
		ifNotNil: [ :owner |
			owner isBrick
				ifTrue: [ owner ]
				ifFalse: [ aBrick ] ]) layoutPolicy! !

!GLMBrickLayoutParentState methodsFor: 'initialization' stamp: 'AliakseiSyrel 4/1/2015 23:37'!
defaultPercent

	^ 100! !

!GLMBrickLayoutProperties commentStamp: 'AliakseiSyrel 10/17/2014 10:13'!
A GLMBrickLayoutProperties is  a holder class of layout properties used by layout policy

Instance Variables
	horizontalPercent:		<Object>
	marginBottom:		<Object>
	marginLeft:		<Object>
	marginRight:		<Object>
	marginTop:		<Object>
	maxHeightBlock:		<Object>
	maxWidthBlock:		<Object>
	minHeight:		<Object>
	minWidth:		<Object>
	paddingBottom:		<Object>
	paddingLeft:		<Object>
	paddingRight:		<Object>
	paddingTop:		<Object>
	verticalPercent:		<Object>

horizontalPercent
	- xxxxx

marginBottom
	- xxxxx

marginLeft
	- xxxxx

marginRight
	- xxxxx

marginTop
	- xxxxx

maxHeightBlock
	- xxxxx

maxWidthBlock
	- xxxxx

minHeight
	- xxxxx

minWidth
	- xxxxx

paddingBottom
	- xxxxx

paddingLeft
	- xxxxx

paddingRight
	- xxxxx

paddingTop
	- xxxxx

verticalPercent
	- xxxxx
!
!GLMBrickLayoutProperties methodsFor: 'scripting' stamp: 'AliakseiSyrel 3/22/2015 17:57'!
hSpaceFill
	"my width will change to fill 100% of my parent"
	self hSpaceFill: 100! !

!GLMBrickLayoutProperties methodsFor: 'scripting' stamp: 'AliakseiSyrel 4/1/2015 23:56'!
hShrinkWrap
	"my width will change to fit children"
	hState := self hState onChildrenDo: #yourself! !

!GLMBrickLayoutProperties methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/9/2015 22:14'!
maxWidth

	^ maxWidth ifNil: [ maxWidth := Float infinity ]! !

!GLMBrickLayoutProperties methodsFor: 'scripting' stamp: 'AliakseiSyrel 4/1/2015 23:55'!
vShrinkWrap

	vState := self vState onChildrenDo: #yourself! !

!GLMBrickLayoutProperties methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/1/2015 23:47'!
height

	^ self vState dimension! !

!GLMBrickLayoutProperties methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/10/2015 00:21'!
floating

	^ floating ifNil: [ floating := #none ]! !

!GLMBrickLayoutProperties methodsFor: 'initialization' stamp: 'AliakseiSyrel 4/2/2015 00:11'!
initialize
	super initialize.
	
	hState := GLMBrickLayoutDummState new.
	vState := GLMBrickLayoutDummState new! !

!GLMBrickLayoutProperties methodsFor: 'scripting' stamp: 'AliakseiSyrel 2/9/2015 22:12'!
maxWidth: anObject

	maxWidth := anObject! !

!GLMBrickLayoutProperties methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/10/2015 00:21'!
zIndex

	^ zIndex ifNil: [ zIndex := 1 ]! !

!GLMBrickLayoutProperties methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/9/2015 22:14'!
maxHeight

	^ maxHeight ifNil: [ maxHeight := Float infinity ]! !

!GLMBrickLayoutProperties methodsFor: 'scripting' stamp: 'AliakseiSyrel 4/2/2015 00:09'!
hPercent

	^ self hState percent! !

!GLMBrickLayoutProperties methodsFor: 'scripting' stamp: 'AliakseiSyrel 2/9/2015 22:12'!
minHeight: anObject
	
	minHeight := anObject! !

!GLMBrickLayoutProperties methodsFor: 'scripting' stamp: 'AliakseiSyrel 4/2/2015 00:09'!
vPercent: anInteger

	vState := self vState onParentDo: [ :s | s percent: anInteger ]! !

!GLMBrickLayoutProperties methodsFor: 'scripting' stamp: 'AliakseiSyrel 2/4/2015 13:09'!
vAlign: aSymbol

	vAlign := aSymbol! !

!GLMBrickLayoutProperties methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/1/2015 23:47'!
width: anObject

	hState := self hState onMyselfDo: [ :s | s dimension: anObject ]! !

!GLMBrickLayoutProperties methodsFor: 'scripting' stamp: 'AliakseiSyrel 11/19/2014 19:47'!
floating: aSymbol
	floating := aSymbol! !

!GLMBrickLayoutProperties methodsFor: 'private' stamp: 'AliakseiSyrel 2/9/2015 22:40'!
hasMinWidth

	^ (self minWidth isNumber ifTrue: [ self minWidth <= 0 ] ifFalse: [ false ]) not! !

!GLMBrickLayoutProperties methodsFor: 'scripting-advanced' stamp: 'AliakseiSyrel 2/3/2015 16:43'!
heightDependency: anObject

	self heightDependencies add: anObject! !

!GLMBrickLayoutProperties methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/1/2015 23:46'!
hState

	^ hState! !

!GLMBrickLayoutProperties methodsFor: 'testing' stamp: 'AliakseiSyrel 4/1/2015 23:57'!
isHShrinkWrap

	^ self hState isOnChildren! !

!GLMBrickLayoutProperties methodsFor: 'private' stamp: 'AliakseiSyrel 2/9/2015 22:40'!
hasMaxWidth

	^ (self maxWidth isNumber ifTrue: [ self maxWidth isInfinite ] ifFalse: [ false ]) not! !

!GLMBrickLayoutProperties methodsFor: 'scripting' stamp: 'AliakseiSyrel 4/2/2015 00:09'!
hPercent: anInteger

	hState := self hState onParentDo: [ :s | s percent: anInteger ]! !

!GLMBrickLayoutProperties methodsFor: 'scripting' stamp: 'AliakseiSyrel 4/2/2015 00:09'!
vPercent

	^ self vState percent! !

!GLMBrickLayoutProperties methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/17/2015 15:18'!
markDirty

	isDirty := true! !

!GLMBrickLayoutProperties methodsFor: 'scripting' stamp: 'AliakseiSyrel 4/1/2015 23:54'!
hSpaceFill: anInteger
	"my width will change to fill anInteger percents of my parent"
	self hPercent: anInteger! !

!GLMBrickLayoutProperties methodsFor: 'scripting' stamp: 'AliakseiSyrel 3/22/2015 17:57'!
vSpaceFill
	"my height will change to fill 100% of my parent"
	self vSpaceFill: 100! !

!GLMBrickLayoutProperties methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/1/2015 23:47'!
height: anObject

	vState := self vState onMyselfDo: [ :s | s dimension: anObject ]! !

!GLMBrickLayoutProperties methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/17/2015 15:19'!
isClean

	^ self isDirty not! !

!GLMBrickLayoutProperties methodsFor: 'private' stamp: 'AliakseiSyrel 2/3/2015 16:43'!
heightDependencies

	^ heightDependencies ifNil: [ heightDependencies := OrderedCollection new ]! !

!GLMBrickLayoutProperties methodsFor: 'scripting' stamp: 'AliakseiSyrel 2/9/2015 22:12'!
maxHeight: anObject

	maxHeight := anObject! !

!GLMBrickLayoutProperties methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/9/2015 22:15'!
minWidth

	^ minWidth ifNil: [ minWidth := 0 ]! !

!GLMBrickLayoutProperties methodsFor: 'private' stamp: 'AliakseiSyrel 2/9/2015 22:39'!
hasMaxHeight

	^ (self maxHeight isNumber ifTrue: [ self maxHeight isInfinite ] ifFalse: [ false ]) not! !

!GLMBrickLayoutProperties methodsFor: 'scripting' stamp: 'AliakseiSyrel 2/4/2015 13:09'!
hAlign: aSymbol

	hAlign := aSymbol! !

!GLMBrickLayoutProperties methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/10/2015 00:21'!
hAlign

	^ hAlign ifNil: [ hAlign := #none ]! !

!GLMBrickLayoutProperties methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/17/2015 15:18'!
isDirty

	^ isDirty ifNil: [ isDirty := true ]! !

!GLMBrickLayoutProperties methodsFor: 'testing' stamp: 'AliakseiSyrel 4/1/2015 23:59'!
isWidthCustom

	^ self hState isOnMyself! !

!GLMBrickLayoutProperties methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/1/2015 23:59'!
vState

	^ vState! !

!GLMBrickLayoutProperties methodsFor: 'scripting' stamp: 'AliakseiSyrel 2/9/2015 23:08'!
minWidth: anObject
	minWidth := anObject! !

!GLMBrickLayoutProperties methodsFor: 'scripting-advanced' stamp: 'AliakseiSyrel 2/3/2015 16:43'!
widthDependency: anObject

	self widthDependencies add: anObject! !

!GLMBrickLayoutProperties methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/1/2015 23:47'!
width

	^ self hState dimension! !

!GLMBrickLayoutProperties methodsFor: 'testing' stamp: 'AliakseiSyrel 4/1/2015 23:58'!
isHSpaceFill

	^ self hState isOnParent! !

!GLMBrickLayoutProperties methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/10/2015 00:22'!
vAlign

	^ vAlign ifNil: [ vAlign := #none ]! !

!GLMBrickLayoutProperties methodsFor: 'private' stamp: 'AliakseiSyrel 2/9/2015 22:40'!
hasMinHeight

	^ (self minHeight isNumber ifTrue: [ self minHeight <= 0 ] ifFalse: [ false ]) not! !

!GLMBrickLayoutProperties methodsFor: 'testing' stamp: 'AliakseiSyrel 4/1/2015 23:58'!
isHeightCustom

	^ self vState isOnMyself! !

!GLMBrickLayoutProperties methodsFor: 'testing' stamp: 'AliakseiSyrel 4/1/2015 23:59'!
isVSpaceFill

	^ self vState isOnParent! !

!GLMBrickLayoutProperties methodsFor: 'scripting' stamp: 'AliakseiSyrel 4/1/2015 23:55'!
vSpaceFill: anInteger
	"my height will change to fill anInteger percents of my parent"
	self vPercent: anInteger! !

!GLMBrickLayoutProperties methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/9/2015 22:15'!
minHeight

	^ minHeight ifNil: [ minHeight := 0 ]! !

!GLMBrickLayoutProperties methodsFor: 'private' stamp: 'AliakseiSyrel 2/3/2015 16:42'!
widthDependencies

	^ widthDependencies ifNil: [ widthDependencies := OrderedCollection new ]	! !

!GLMBrickLayoutProperties methodsFor: 'scripting' stamp: 'AliakseiSyrel 11/27/2014 20:49'!
zIndex: anObject
	zIndex := anObject! !

!GLMBrickLayoutProperties methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/17/2015 15:19'!
markClean

	isDirty := false! !

!GLMBrickLayoutProperties methodsFor: 'testing' stamp: 'AliakseiSyrel 4/1/2015 23:58'!
isVShrinkWrap

	^ self vState isOnChildren! !

!GLMBrickLayoutStacked methodsFor: 'accessing' stamp: 'AliakseiSyrel 12/1/2014 17:35'!
position: anObject
	position := anObject! !

!GLMBrickLayoutStacked methodsFor: 'accessing' stamp: 'AliakseiSyrel 12/1/2014 17:34'!
index: anObject
	index := anObject! !

!GLMBrickLayoutStacked methodsFor: 'accessing' stamp: 'AliakseiSyrel 12/1/2014 17:35'!
position
	^ position! !

!GLMBrickLayoutStacked methodsFor: 'accessing' stamp: 'AliakseiSyrel 12/1/2014 17:34'!
index
	^ index! !

!GLMBrickLayoutState methodsFor: 'doing' stamp: 'AliakseiSyrel 4/1/2015 23:43'!
onChildrenDo: aBlock

	^ self
		on: #isOnChildren
		do: aBlock
		ifAbsent: [ GLMBrickLayoutChildrenState new ]! !

!GLMBrickLayoutState methodsFor: 'doing' stamp: 'AliakseiSyrel 4/1/2015 23:42'!
on: aSymbol do: aBlock ifAbsent: absentBlock
	|state|
	state := (aSymbol cull: self)
		ifTrue: [ self ]
		ifFalse: absentBlock.
	aBlock cull: state.
	^ state! !

!GLMBrickLayoutState methodsFor: 'testing' stamp: 'AliakseiSyrel 4/1/2015 23:28'!
isOnChildren

	^ false! !

!GLMBrickLayoutState methodsFor: 'doing' stamp: 'AliakseiSyrel 4/1/2015 23:45'!
onParentDo: aBlock

	^ self
		on: #isOnParent
		do: aBlock
		ifAbsent: [ GLMBrickLayoutParentState new ]! !

!GLMBrickLayoutState methodsFor: 'doing' stamp: 'AliakseiSyrel 4/1/2015 23:44'!
onMyselfDo: aBlock

	^ self
		on: #isOnMyself
		do: aBlock
		ifAbsent: [ GLMBrickLayoutMyselfState new ]! !

!GLMBrickLayoutState methodsFor: 'testing' stamp: 'AliakseiSyrel 4/1/2015 23:28'!
isOnParent

	^ false! !

!GLMBrickLayoutState methodsFor: 'layouting' stamp: 'AliakseiSyrel 4/2/2015 00:35'!
updateHeight: aBrick on: aLayout! !

!GLMBrickLayoutState methodsFor: 'layouting' stamp: 'AliakseiSyrel 4/2/2015 00:22'!
layout: aBrick on: aTraverser! !

!GLMBrickLayoutState methodsFor: 'layouting' stamp: 'AliakseiSyrel 4/2/2015 00:35'!
updateWidth: aBrick on: aLayout! !

!GLMBrickLayoutState methodsFor: 'layouting' stamp: 'AliakseiSyrel 4/2/2015 13:27'!
layoutPolicy: aBrick on: aTraverser

	^ aBrick layoutPolicy! !

!GLMBrickLayoutState methodsFor: 'testing' stamp: 'AliakseiSyrel 4/1/2015 23:28'!
isOnMyself

	^ false! !

!GLMBrickLayoutTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 2/17/2015 15:24'!
isLayoutDirty: aBrick

	^ aBrick
		ifNotNil: [ :b | b layout isDirty ]
		ifNil: [ true ]! !

!GLMBrickLayoutTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 2/9/2015 23:30'!
hasMinDimensionRestriction: aBrick

	^ self subclassResponsibility! !

!GLMBrickLayoutTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 4/3/2015 21:03'!
isDependsOnChildren: aBrick

	^ (self stateOf: aBrick) isOnChildren! !

!GLMBrickLayoutTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 2/9/2015 23:50'!
prioritySortedSubbricks: aBrick
	|sorted|
	sorted := OrderedCollection newFrom: aBrick subbricks.
	sorted sort: [ :first :second | (self isDependsOnParent: first) ifFalse: [ true ]
		 ifTrue: [ (self isDependsOnParent: second) ifFalse: [ false ]
			ifTrue: [ (self hasDimensionRestrictions: first) ifFalse: [ false ]
				ifTrue: [ (self hasDimensionRestrictions: second) ifFalse: [ true ]
					ifTrue: [ (self hasMinDimensionRestriction: first) ifFalse: [ false ]
						ifTrue: [ true ] ] ] ] ] ].
	^ sorted! !

!GLMBrickLayoutTraverser methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/3/2015 21:07'!
stateOf: aBrick

	^ self state cull: aBrick! !

!GLMBrickLayoutTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 4/7/2015 19:42'!
markLayoutClean: aBrick

	aBrick ifNotNil: [ :b | b markLayoutClean ]! !

!GLMBrickLayoutTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 4/3/2015 21:03'!
isDependsOnMyself: aBrick

	^ (self stateOf: aBrick) isOnMyself! !

!GLMBrickLayoutTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 2/17/2015 15:39'!
layoutSubbricks: aBrick
	aBrick ifNil: [ ^ self ].
	aBrick isBrick ifFalse: [ ^ self ].
	((self isClean: aBrick) & (self isOppositeClean: aBrick))
		ifFalse: [ ^ self ].
	(self isLayoutClean: aBrick) ifTrue: [ ^ self ].
	(aBrick subbricks allSatisfy: [ :each | each isBrick ifTrue: [ (self isClean: each) & (self isOppositeClean: each) ] ifFalse: [ false ] ])
		ifFalse: [ ^ self ].
	
	aBrick invalidateLayout.
	self markLayoutClean: aBrick.
	aBrick onChildrenLayouted! !

!GLMBrickLayoutTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 4/2/2015 13:31'!
dimensionPolicy: aBrick

	^ (self stateOf: aBrick) layoutPolicy: aBrick on: self! !

!GLMBrickLayoutTraverser methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/1/2015 20:24'!
opposite

	^ self subclassResponsibility! !

!GLMBrickLayoutTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 2/1/2015 20:48'!
markDirty: aBrick

	^ self subclassResponsibility! !

!GLMBrickLayoutTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 2/3/2015 16:47'!
customDependencies: aBrick

	^ self subclassResponsibility! !

!GLMBrickLayoutTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 4/3/2015 21:04'!
isDependsOnParent: aBrick

	^ (self stateOf: aBrick) isOnParent! !

!GLMBrickLayoutTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 2/1/2015 20:29'!
markClean: aBrick

	^ self subclassResponsibility! !

!GLMBrickLayoutTraverser methodsFor: 'traversing' stamp: 'AliakseiSyrel 2/3/2015 17:39'!
layoutChildrenOf: aBrick

	(self prioritySortedSubbricks: aBrick) do: [ :each | self layoutAround: each inContext: aBrick ]! !

!GLMBrickLayoutTraverser methodsFor: 'traversing' stamp: 'AliakseiSyrel 2/8/2015 14:05'!
markDirtyChildrenAround: aBrick inContext: aContextBrick

	aBrick subbricks do: [ :each |
		each = aContextBrick ifFalse: [
			each isBrick ifTrue: [
			(self isClean: each) ifTrue: [
				self markDirty: each.
				self markDirtyAround: each inContext: aBrick ] ] ] ].! !

!GLMBrickLayoutTraverser methodsFor: 'traversing' stamp: 'AliakseiSyrel 4/1/2015 22:52'!
markDirtyCustomDependency: aBrick inContext: aContextBrick
	(aBrick isBrick) not | (aBrick = aContextBrick) ifTrue: [ ^ self ].
	
	(self hasCustomDependencies: aBrick) ifTrue: [
				self markDirty: aBrick.
				aBrick subbricks do: [ :each | each isBrick ifTrue: [
						self markDirty: each.
						self markDirtyAround: each inContext: aBrick ] ].
				
				(self customDependencies: aBrick) do: [ :each | |brick|
					[ brick := (each brickValue: aBrick) brickApi ] on: Exception do: [ brick := nil ].
					brick ifNotNil: [
						(brick = aContextBrick) not & (brick = aBrick) not & brick isBrick ifTrue: [
							(self isClean: brick) ifTrue: [
								self markDirty: brick.
								self markDirtyAround: brick inContext: aBrick ] ] ] ] ]! !

!GLMBrickLayoutTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 2/3/2015 18:06'!
hasCustomDependencies: aBrick

	^ (self customDependencies: aBrick) isEmpty not! !

!GLMBrickLayoutTraverser methodsFor: 'traversing' stamp: 'AliakseiSyrel 4/2/2015 00:29'!
layoutAround: aBrick inContext: aContextBrick
	"want to layout non-Brick object? nice try, bro."
	aBrick isBrick ifFalse: [ ^ self ].
	"if my dimension is clean why do you want to layout me?"
	(self isClean: aBrick) ifTrue: [ ^ self ].
	aBrick changed.
	"custom dependencies are very dangerous, as it's complicated
	to detect cycles fast"
	(self customDependencies: aBrick)
		do: [ :each | |b|
			[ b :=  (each brickValue: aBrick) brickApi ] on: Exception do: [ b := nil ] .
			b ifNotNil: [ self layoutAround: b inContext: aBrick ] ].
		
	(self stateOf: aBrick) layout: aBrick on: self.
	
	"and finally we position them"
	self layoutSubbricks: aBrick.
	self layoutSubbricks: aBrick owner.
	
	aBrick changed.
! !

!GLMBrickLayoutTraverser methodsFor: 'traversing' stamp: 'AliakseiSyrel 2/1/2015 20:27'!
layoutOwnerOf: aBrick

	aBrick owner ifNotNil: [ self layoutAround: aBrick owner inContext: aBrick ]! !

!GLMBrickLayoutTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 4/7/2015 19:42'!
markLayoutDirty: aBrick

	aBrick ifNotNil: [ :b | b isBrick ifTrue: [ b markLayoutDirty ] ]! !

!GLMBrickLayoutTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 2/1/2015 20:52'!
markOppositeDirty: aBrick

	^ self subclassResponsibility! !

!GLMBrickLayoutTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 2/9/2015 23:31'!
hasDimensionRestrictions: aBrick

	^ (self hasMinDimensionRestriction: aBrick) | (self hasMaxDimensionRestriction: aBrick)! !

!GLMBrickLayoutTraverser methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/2/2015 00:16'!
state

	^ self subclassResponsibility! !

!GLMBrickLayoutTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 2/1/2015 23:36'!
updateDimension: aBrick

	^ self subclassResponsibility! !

!GLMBrickLayoutTraverser methodsFor: 'traversing' stamp: 'AliakseiSyrel 4/2/2015 01:09'!
markDirtyAround: aBrick inContext: aContextBrick
	aBrick isBrick ifFalse: [ ^ self ].
	aBrick = aContextBrick ifTrue: [ ^ self ].
	
	aBrick owner ifNotNil: [
		(aBrick owner = aContextBrick) not & aBrick owner isBrick ifTrue: [
			(self isClean: aBrick owner) ifTrue: [
				(self isDependsOnChildren: aBrick owner) ifTrue: [
					self markDirty: aBrick owner.
					self markDirtyAround: aBrick owner inContext: aBrick ].
			
				((self isDependsOnMyself: aBrick) | (self isDependsOnChildren: aBrick))
					ifTrue: [ (aBrick owner subbricks anySatisfy: [ :each | self isDependsOnParent: each]) ifTrue: [
						self markDirty: aBrick owner.
						self markDirtyChildrenAround: aBrick owner inContext: aBrick ] ].
				
				(self isClean: aBrick owner) ifTrue: [
					(aBrick layout floating = #none) not | (aBrick layout vAlign = #none) not | (aBrick layout hAlign = #none) not ifTrue: [ 
						self markLayoutDirty: aBrick owner ] ] ] ] ].
	
	aBrick subbricks do: [ :each |
		each = aContextBrick ifFalse: [
			each isBrick ifTrue: [
			((self isDependsOnParent: each) & (self isClean: each))
					| (each layout floating = #none) not | (each layout vAlign = #none) not | (each layout hAlign = #none) not ifTrue: [
				self markDirty: each.
				self markDirtyAround: each inContext: aBrick ] ] ] ].
	
	self markDirtyCustomDependency: aBrick inContext: aContextBrick.
	aBrick subbricks do: [ :each | self markDirtyCustomDependency: each inContext: aBrick ]
	
! !

!GLMBrickLayoutTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 2/1/2015 20:33'!
isClean: aBrick

	^ self subclassResponsibility! !

!GLMBrickLayoutTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 2/9/2015 23:30'!
hasMaxDimensionRestriction: aBrick

	^ self subclassResponsibility! !

!GLMBrickLayoutTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 2/17/2015 15:24'!
isLayoutClean: aBrick

	^ aBrick
		ifNotNil: [ :b | b layout isClean ]
		ifNil: [ true ]! !

!GLMBrickLayoutTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 2/1/2015 20:50'!
isOppositeClean: aBrick

	^ self subclassResponsibility! !

!GLMBrickLayouter commentStamp: 'AliakseiSyrel 1/28/2015 13:09'!
A GLMBrickLayouter is Brick's brand new layout system.
It builds a graph where each Brick corresponds two nodes: WidthNode and HeightNode.  Each node can have 4 states:

1 - depends on parent
2 - depends on children
3 - depends on itself
4 - depends on opposite node.

Layouter traverses graph from root WidthNode. Depending on state it behaves differently:

1) If layouter meets node with state 1 it checks if its parent already positioned and its height or width calculated. Otherwise it returns to such node later as soon as it finished with parent. If node with state 1 has parent with state 2 a LayoutCycleException must be reaised.

2) If layouter meets node with state 2 it must skip it and continues traversing all children until all of them are not positioned. As soon as it happens it returns back to skipped node. In case any of children of node with state 2 has state 1 a LayoutCycleException must be reaised.

3) If layouter meets node with state 3 it immidiately calculates corresponding value and applies it. Then it checks if there is an unvisited child node. If yes moves to it, otherwise returns to parent node.

4) If layouter meets node with state 4 it swaps its working node to opposite and continues traversing. For WidthNode opposing node is HeightNode and for HeightNode it is WidthNode.  If both nodes have state 4 a LayoutCycleException must be raised.

Instance Variables
	rootHeightNode:		<Object>
	rootWidthNode:		<Object>

rootHeightNode
	- xxxxx

rootWidthNode
	- xxxxx
!
!GLMBrickLayouter methodsFor: 'private' stamp: 'AliakseiSyrel 4/2/2015 14:02'!
layout: aBrick

	aBrick isWidthDirty
		ifTrue: [ self widthTraverser layoutAround: aBrick inContext: nil ].
	aBrick isHeightDirty
		ifTrue: [ self heightTraverser layoutAround: aBrick inContext: nil ]! !

!GLMBrickLayouter methodsFor: 'private' stamp: 'AliakseiSyrel 4/2/2015 14:00'!
markDependent: aBrick

	(aBrick isWidthDirty | aBrick isHeightDirty)
		ifTrue: [
			"we mark layout as dirty of brick itself"
			aBrick layout markDirty.
			"and its direct parent"
			aBrick owner ifNotNil: [ :o | o isBrick ifTrue: [ o layout markDirty ] ] ].

	aBrick isWidthDirty
		ifTrue: [ self widthTraverser markDirtyAround: aBrick inContext: nil ].
	aBrick isHeightDirty
		ifTrue: [ self heightTraverser markDirtyAround: aBrick inContext: nil ]
	! !

!GLMBrickLayouter methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/1/2015 21:08'!
heightTraverser

	^ GLMBrickHeightTraverser uniqueInstance! !

!GLMBrickLayouter methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/1/2015 21:08'!
widthTraverser

	^ GLMBrickWidthTraverser uniqueInstance! !

!GLMBrickLayouter methodsFor: 'layouting' stamp: 'AliakseiSyrel 2/3/2015 18:26'!
layoutIn: aBrick

	self
		markDependent: aBrick;
		layout: aBrick! !

!GLMBrickLayouter class methodsFor: 'examples' stamp: 'AliakseiSyrel 2/3/2015 18:23'!
example

	|bricks|
	
	bricks := OrderedCollection new.
	1 to: 13 do: [ :i | bricks add: GLMBrick new ].
	
	(bricks at: 1) 
		width: 100;
		height: 100.
		
	(bricks at: 2)
		hResizing: #spaceFill;
		height: 20.
		
	(bricks at: 3)
		hResizing: #spaceFill;
		vResizing: #opposite.
		
	(bricks at: 4)
		hResizing: #spaceFill;
		vResizing: #spaceFill.
		
	(bricks at: 1)
		addBrickBack: (bricks at: 2);
		addBrickBack: (bricks at: 3);
		addBrickBack: (bricks at: 4).
		
	(bricks at: 5)
		hResizing: #spaceFill;
		vResizing: #shrinkWrap.
	
	(bricks at: 6)
		hResizing: #spaceFill;
		vResizing: #spaceFill.
	
	(bricks at: 7)
		width: 50;
		vResizing: #opposite.
		
	(bricks at: 8)
		hResizing: #spaceFill;
		vResizing: #shrinkWrap.
		
	(bricks at: 9)
		hResizing: #spaceFill;
		vResizing: #spaceFill.
	
	(bricks at: 10)
		hResizing: #spaceFill;
		vResizing: #spaceFill.
		
	(bricks at: 11)
		hResizing: #spaceFill;
		height: 20.
		
	(bricks at: 12)
		hResizing: #spaceFill;
		height: 20.
		
	(bricks at: 13)
		hResizing: #spaceFill;
		height: 20.
		
	(bricks at: 2)
		addBrickBack: (bricks at: 5);
		addBrickBack: (bricks at: 6).
		
	(bricks at: 3)
		addBrickBack: (bricks at: 7);
		addBrickBack: (bricks at: 8).
	
	(bricks at: 4)
		addBrickBack: (bricks at: 9);
		addBrickBack: (bricks at: 10).
		
	(bricks at: 5)
		addBrickBack: (bricks at: 11).
		
	(bricks at: 8)
		addBrickBack: (bricks at: 12);
		addBrickBack: (bricks at: 13).
	"self halt."
	^ bricks
	
	! !

!GLMBrickLayouter class methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/2/2015 00:56'!
uniqueInstance
	^ uniqueInstance ifNil: [ uniqueInstance := self new ]! !

!GLMBrickListModel commentStamp: 'AliakseiSyrel 12/6/2014 20:15'!
A GLMBrickListAdaptor is scriptable implementation of adaptor that is mostly used with list scroll brick

Instance Variables
	countLogic:		<Object>
	morphLogic:		<Object>
	origin:		<Object>

countLogic
	- xxxxx

morphLogic
	- xxxxx

origin
	- xxxxx
!
!GLMBrickListModel methodsFor: 'adaptor api' stamp: 'AliakseiSyrel 12/6/2014 19:49'!
count

	^ countLogic
		ifNil: [ origin size ]
		ifNotNil: [ countLogic cull: origin ] ! !

!GLMBrickListModel methodsFor: 'instance creation' stamp: 'AliakseiSyrel 12/6/2014 19:59'!
sizeLogic: aBlockWithNoParameters

	countLogic := aBlockWithNoParameters! !

!GLMBrickListModel methodsFor: 'instance creation' stamp: 'AliakseiSyrel 12/6/2014 20:00'!
on: anObject

	origin := anObject! !

!GLMBrickListModel methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/11/2015 15:23'!
origin

	^ origin! !

!GLMBrickListModel methodsFor: 'adaptor api' stamp: 'AliakseiSyrel 12/6/2014 20:03'!
morphAt: anInteger convert: aMorph

	^ morphLogic
		ifNil: [ (origin at: anInteger) asMorph ]
		ifNotNil: [
			morphLogic isSymbol
				ifTrue: [ origin perform: morphLogic withEnoughArguments: { anInteger . aMorph }  ]
				ifFalse: [ morphLogic cull: anInteger cull: aMorph ] ]! !

!GLMBrickListModel methodsFor: 'instance creation' stamp: 'AliakseiSyrel 12/6/2014 19:59'!
morphAtLogic: aBlockWithTwoParameters

	morphLogic := aBlockWithTwoParameters! !

!GLMBrickListModel class methodsFor: 'instance creation' stamp: 'AliakseiSyrel 12/6/2014 19:53'!
on: anObject

	^ self new on: anObject! !

!GLMBrickMorphWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/1/2015 17:19'!
isBrick

	^ false! !

!GLMBrickMorphWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/1/2015 17:20'!
subbricks

	^ self brick submorphs! !

!GLMBrickMorphWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/3/2015 21:06'!
hState

	^ GLMBrickLayoutDummState new! !

!GLMBrickMorphWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/3/2015 21:06'!
vState

	^ GLMBrickLayoutDummState new! !

!GLMBrickPopupDarkThemer commentStamp: 'AliakseiSyrel 3/21/2015 19:45'!
I'm a style module related to popup and modified for Dark Theme!
!GLMBrickPopupDarkThemer methodsFor: 'brick-popup' stamp: 'JurajKubelka 2/28/2015 19:09'!
textColor

	^ Color white slightlyDarker! !

!GLMBrickPopupDarkThemer methodsFor: 'brick-popup' stamp: 'AliakseiSyrel 3/27/2015 13:24'!
borderColor

	^ self themer color darken lighter! !

!GLMBrickPopupDarkThemer methodsFor: 'brick-popup' stamp: 'AliakseiSyrel 3/27/2015 13:36'!
backgroundColor

	^ Color veryDarkGray! !

!GLMBrickPopupErrorThemer methodsFor: 'brick-popup' stamp: 'AliakseiSyrel 2/11/2015 14:07'!
textColor

	^ Color r: 206 g: 38 b: 11 range: 255! !

!GLMBrickPopupErrorThemer methodsFor: 'brick-popup' stamp: 'AliakseiSyrel 2/11/2015 14:25'!
borderColor

	^ Color r: 225 g: 124 b: 108 range: 255! !

!GLMBrickPopupErrorThemer methodsFor: 'brick-popup' stamp: 'AliakseiSyrel 2/11/2015 14:31'!
backgroundColor
	"FBC9C1"
	^ Color r: 251 g: 201 b: 193 range: 255! !

!GLMBrickPopupHelpThemer methodsFor: 'brick-popup' stamp: 'AliakseiSyrel 2/11/2015 13:41'!
textColor

	^ Color r: 16 g: 172 b: 221 range: 255! !

!GLMBrickPopupHelpThemer methodsFor: 'brick-popup' stamp: 'AliakseiSyrel 2/11/2015 13:41'!
borderColor

	^ Color r: 48 g:194 b:240 range: 255! !

!GLMBrickPopupHelpThemer methodsFor: 'brick-popup' stamp: 'AliakseiSyrel 2/13/2015 01:51'!
backgroundColor

	^ Color r: 220 g: 246 b: 255 range: 255! !

!GLMBrickPopupSuccessThemer methodsFor: 'brick-popup' stamp: 'AliakseiSyrel 2/11/2015 14:29'!
textColor
	
	^ Color r: 0 g: 115 b: 0 range: 255! !

!GLMBrickPopupSuccessThemer methodsFor: 'brick-popup' stamp: 'AliakseiSyrel 2/11/2015 14:29'!
borderColor
	"#7FBF7F"
	^ Color r: 127 g: 191 b: 127 range: 255! !

!GLMBrickPopupSuccessThemer methodsFor: 'brick-popup' stamp: 'AliakseiSyrel 2/11/2015 14:28'!
backgroundColor

	^ Color r: 204 g: 229 b: 204 range: 255! !

!GLMBrickPopupThemer commentStamp: 'AliakseiSyrel 3/21/2015 19:45'!
I'm a style module related to popup!
!GLMBrickPopupThemer methodsFor: 'brick-popup' stamp: 'AliakseiSyrel 2/11/2015 13:45'!
textColor

	^ Color lightGray darker! !

!GLMBrickPopupThemer methodsFor: 'brick-popup' stamp: 'AliakseiSyrel 2/11/2015 13:41'!
borderWidth

	^ 1! !

!GLMBrickPopupThemer methodsFor: 'brick-popup' stamp: 'AliakseiSyrel 3/27/2015 00:48'!
borderColor

	^ Color veryLightGray! !

!GLMBrickPopupThemer methodsFor: 'brick-popup' stamp: 'AliakseiSyrel 3/27/2015 02:23'!
backgroundColor

	^ Color white! !

!GLMBrickRenderer commentStamp: 'AliakseiSyrel 10/17/2014 10:33'!
A GLMBrickRenderer is most simple separate renderer of Bricks. It support only borders
!
!GLMBrickRenderer methodsFor: 'rendering' stamp: 'AliakseiSyrel 3/18/2015 21:29'!
renderBackgroundColorOf: aBrick on: aCanvas
	|rectangle|
	rectangle := aBrick brickBounds expandBy: aBrick shadowWidth negated.
	aCanvas fillRectangle: rectangle color: aBrick color.
	(aBrick fillStyle = Color transparent) ifFalse: [ 
		aCanvas fillRectangle: rectangle fillStyle: aBrick fillStyle borderStyle: aBrick borderStyle ]! !

!GLMBrickRenderer methodsFor: 'private-shadow' stamp: 'AliakseiSyrel 1/24/2015 01:01'!
bottomRightCornerShadowOf: aBrick on: aCanvas
	|gradient width|
	width := aBrick shadowWidth.
	"draw top right corner"
	gradient := (self shadowGradientFor: aBrick)
		origin: aBrick brickBounds corner  - (width@width);
		direction: (width@width)/1.4;
		radial: true;
	yourself.
	
	aCanvas fillRectangle: (aBrick brickBounds corner  - (width@width) corner: (aBrick brickBounds corner)) fillStyle: gradient.! !

!GLMBrickRenderer methodsFor: 'rendering athens' stamp: 'AliakseiSyrel 3/31/2015 16:10'!
render: aBrick onAthensCanvas: aCanvas
	
	self render: aBrick on: (AthensCanvasWrapper on: aCanvas)! !

!GLMBrickRenderer methodsFor: 'private-shadow' stamp: 'AliakseiSyrel 1/24/2015 00:58'!
leftShadowOf: aBrick on: aCanvas
	|gradient width|
	width := aBrick shadowWidth.
	"draw left shadow"
	gradient := (self shadowGradientFor: aBrick)
		origin: aBrick brickBounds leftCenter + (width@0);
		direction: (width@0)negated;
		yourself.
	aCanvas fillRectangle: ((aBrick brickBounds origin + (0@width)) corner: (aBrick brickBounds origin + (width@width negated) + (0@ aBrick brickBounds height))) fillStyle: gradient.! !

!GLMBrickRenderer methodsFor: 'rendering' stamp: 'AliakseiSyrel 1/24/2015 01:12'!
render: aBrick on: aCanvas
	
	self
		renderBackgroundColorOf: aBrick on: aCanvas;
		renderShadowOf: aBrick on: aCanvas;
		renderBorderOf: aBrick on: aCanvas! !

!GLMBrickRenderer methodsFor: 'private-shadow' stamp: 'AliakseiSyrel 1/24/2015 00:57'!
shadowGradientFor: aBrick

	^ GradientFillStyle ramp: { 0.0 -> (aBrick shadowColor) . 1.0 -> (aBrick shadowColor alpha: 0)}! !

!GLMBrickRenderer methodsFor: 'private-shadow' stamp: 'AliakseiSyrel 1/24/2015 01:01'!
topRightCornerShadowOf: aBrick on: aCanvas
	|gradient width|
	width := aBrick shadowWidth.
	"draw top right corner"
	gradient := (self shadowGradientFor: aBrick)
		origin: aBrick brickBounds topRight  - (width@width negated);
		direction: (width@width negated)/1.4;
		radial: true;
	yourself.
	
	aCanvas fillRectangle: (aBrick brickBounds topRight - (width@0) corner: (aBrick brickBounds topRight + (0@width))) fillStyle: gradient.! !

!GLMBrickRenderer methodsFor: 'private-shadow' stamp: 'AliakseiSyrel 1/24/2015 01:02'!
bottomLeftCornerShadowOf: aBrick on: aCanvas
	|gradient width|
	width := aBrick shadowWidth.
	"draw top left corner"
	gradient := (self shadowGradientFor: aBrick)
		origin: aBrick brickBounds bottomLeft + (width@width negated);
		direction: (width negated@width)/1.4;
		radial: true;
		yourself.
	aCanvas fillRectangle: (aBrick brickBounds bottomLeft - (0@width) corner: (aBrick brickBounds bottomLeft + (width@0))) fillStyle: gradient.! !

!GLMBrickRenderer methodsFor: 'rendering' stamp: 'AliakseiSyrel 2/13/2015 21:45'!
renderBorderOf: aBrick on: aCanvas
	|markColor markWidth|
	aBrick border renderBorderOf: aBrick on: aCanvas.
	
	markColor := aBrick valueOfProperty: #brickMarkBorderColor ifAbsent: nil.
	markWidth := aBrick valueOfProperty: #brickMarkBorderWidth ifAbsent: nil.
	
	markColor isNotNil & markWidth isNotNil ifTrue: [
		aCanvas frameRectangle: aBrick brickBounds width: markWidth color: markColor ]! !

!GLMBrickRenderer methodsFor: 'private-shadow' stamp: 'AliakseiSyrel 1/24/2015 00:58'!
bottomShadowOf: aBrick on: aCanvas
	|gradient width|
	width := aBrick shadowWidth.
	"draw bottom shadow"
	gradient := (self shadowGradientFor: aBrick)
		origin: aBrick brickBounds bottomCenter - (0@width);
		direction: (0@width);
		yourself.
	aCanvas fillRectangle: ((aBrick brickBounds bottomLeft + (width@width negated)) corner: (aBrick brickBounds bottomLeft - (width @width) + (aBrick brickBounds width @ width))) fillStyle: gradient.! !

!GLMBrickRenderer methodsFor: 'private-shadow' stamp: 'AliakseiSyrel 1/24/2015 00:58'!
topLeftCornerShadowOf: aBrick on: aCanvas
	|gradient width|
	width := aBrick shadowWidth.
	"draw top left corner"
	gradient := (self shadowGradientFor: aBrick)
		origin: aBrick brickBounds origin + (width@width);
		direction: (width@width)/1.4 negated;
		radial: true;
		yourself.
	aCanvas fillRectangle: (aBrick brickBounds origin corner: (aBrick brickBounds origin + (width@width))) fillStyle: gradient.! !

!GLMBrickRenderer methodsFor: 'rendering' stamp: 'AliakseiSyrel 1/24/2015 01:24'!
renderShadowOf: aBrick on: aCanvas

	"no need to even try drawing if shadow width is zero"
	aBrick shadowWidth = 0 ifTrue: [ ^ self ].
	
	self
		topLeftCornerShadowOf: aBrick on: aCanvas;
		topRightCornerShadowOf: aBrick on: aCanvas;
		bottomRightCornerShadowOf: aBrick on: aCanvas;
		bottomLeftCornerShadowOf: aBrick on: aCanvas;
		leftShadowOf: aBrick on: aCanvas;
		topShadowOf: aBrick on: aCanvas;
		rightShadowOf: aBrick on: aCanvas;
		bottomShadowOf: aBrick on: aCanvas
! !

!GLMBrickRenderer methodsFor: 'private-shadow' stamp: 'AliakseiSyrel 1/24/2015 00:58'!
rightShadowOf: aBrick on: aCanvas
	|gradient width|
	width := aBrick shadowWidth.
	"draw top shadow"
	gradient := (self shadowGradientFor: aBrick)
		origin: aBrick brickBounds rightCenter - (width@0);
		direction: (width@0);
		yourself.
	aCanvas fillRectangle: ((aBrick brickBounds topRight + (width negated@width)) corner: (aBrick brickBounds corner + (width@width negated))) fillStyle: gradient.! !

!GLMBrickRenderer methodsFor: 'private-shadow' stamp: 'AliakseiSyrel 1/24/2015 00:58'!
topShadowOf: aBrick on: aCanvas
	|gradient width|
	width := aBrick shadowWidth.
	"draw top shadow"
	gradient := (self shadowGradientFor: aBrick)
		origin: aBrick brickBounds topCenter + (0@width);
		direction: (0@width)negated;
		yourself.
		
	aCanvas fillRectangle: ((aBrick brickBounds origin + (width@0)) corner: (aBrick brickBounds origin - (width@0) + (aBrick brickBounds width @ width))) fillStyle: gradient.! !

!GLMBrickTabLabelDarkThemer commentStamp: 'AliakseiSyrel 3/21/2015 19:44'!
I'm a style module related to tab label modified for Dark Theme!
!GLMBrickTabLabelDarkThemer methodsFor: 'brick-tab-label' stamp: 'AliakseiSyrel 3/21/2015 16:46'!
normalBorderStyleFor: aBrick

	^ BorderStyle simple
			width: 1;
			baseColor: Color transparent! !

!GLMBrickTabLabelDarkThemer methodsFor: 'brick-tab-label' stamp: 'AliakseiSyrel 3/21/2015 16:46'!
selectedBorderStyleFor: aBrick

	^ self normalBorderStyleFor: aBrick! !

!GLMBrickTabLabelDarkThemer methodsFor: 'brick-tab-label' stamp: 'AliakseiSyrel 3/21/2015 17:14'!
normalStyleFor: aBrick

	super normalStyleFor: aBrick.
	aBrick padding: #(0 1).! !

!GLMBrickTabLabelThemer commentStamp: 'AliakseiSyrel 3/21/2015 19:44'!
I'm a style module related to tab label!
!GLMBrickTabLabelThemer methodsFor: 'brick-tab-label' stamp: 'AliakseiSyrel 3/21/2015 16:35'!
normalBackgroundStyleFor: aBrick

	^ Smalltalk ui theme tabLabelNormalFillStyleFor: aBrick! !

!GLMBrickTabLabelThemer methodsFor: 'brick-tab-label' stamp: 'AliakseiSyrel 3/21/2015 16:36'!
selectedStyleFor: aBrick

	aBrick fillStyle: (self selectedBackgroundStyleFor: aBrick).
	aBrick borderStyle: (self selectedBorderStyleFor: aBrick)! !

!GLMBrickTabLabelThemer methodsFor: 'brick-tab-label' stamp: 'AliakseiSyrel 3/21/2015 16:36'!
selectedBorderStyleFor: aBrick

	^ Smalltalk ui theme tabLabelSelectedBorderStyleFor: aBrick! !

!GLMBrickTabLabelThemer methodsFor: 'brick-tab-label' stamp: 'AliakseiSyrel 3/21/2015 16:34'!
normalBorderStyleFor: aBrick

	^ Smalltalk ui theme tabLabelNormalBorderStyleFor: aBrick! !

!GLMBrickTabLabelThemer methodsFor: 'brick-tab-label' stamp: 'AliakseiSyrel 3/21/2015 16:36'!
selectedBackgroundStyleFor: aBrick

	^ Smalltalk ui theme tabLabelSelectedFillStyleFor: aBrick! !

!GLMBrickTabLabelThemer methodsFor: 'brick-tab-label' stamp: 'AliakseiSyrel 3/21/2015 16:35'!
normalStyleFor: aBrick

	aBrick fillStyle: (self normalBackgroundStyleFor: aBrick).
	aBrick borderStyle: (self normalBorderStyleFor: aBrick)! !

!GLMBrickTests methodsFor: 'defaults' stamp: 'AliakseiSyrel 2/4/2015 16:08'!
staticWidth

	^ 100! !

!GLMBrickTests methodsFor: 'tests-layouter' stamp: 'AliakseiSyrel 2/8/2015 13:42'!
test100DependsOnChildrenBricksInsideOneStatic
	|root current|
	
	root := self newBrickWithFullDependsOnChildren.
	current := root.
	1 to: 99 do: [ :index |
		current := current addBrickBack: self newBrickWithFullDependsOnChildren ].
	current := current addBrickBack: self newBrickWithStaticExtent.
	
	self assertAllSubbricksAreClean: root.
	
	self assert: root extent equals: current extent
	! !

!GLMBrickTests methodsFor: 'tests-geometry' stamp: 'AliakseiSyrel 2/8/2015 19:29'!
testTopMarginParentDependency
	|root margin brick|
	margin := 10.
	
	root := self newBrickWithStaticExtent.
	brick := self newBrickFullHeightAndWidthDependsOnParent: 100.
	brick marginTop: margin.
	root addBrickBack: brick.

	self assertAllSubbricksAreClean: root.
	self assert: root extent equals: self staticExtent.
	self assert: brick extent equals: (self staticExtent - (0@margin)).
	self assert: brick brickBounds equals: (0@margin corner: self staticExtent)! !

!GLMBrickTests methodsFor: 'tests-marker' stamp: 'AliakseiSyrel 4/1/2015 18:00'!
testMarkerOneParentInStaticHeight
	|root brick|
	
	root := self newBrickWithStaticExtent.
	brick := self newBrickWithFullFill.
	root addBrickBack: brick.
	self markFullyClean: root.
	
	brick wrappedBounds markHeightDirty.
	GLMBrickLayouter uniqueInstance markDependent: brick brickApi.
	
	self assert: brick wrappedBounds isWidthClean.
	self assert: brick wrappedBounds isHeightDirty.
	
	self assert: root wrappedBounds isWidthClean.
	self assert: root wrappedBounds isHeightClean.! !

!GLMBrickTests methodsFor: 'tests-layouter' stamp: 'AliakseiSyrel 2/8/2015 13:44'!
testTwoDependsOnParentInsideStatic
	|root brick1 brick2|
	
	root := self newBrickWithStaticExtent.
	brick1 := self newBrickFullHeightAndWidthDependsOnParent: 50.
	brick2 := self newBrickFullHeightAndWidthDependsOnParent: 50.
	
	root
		addBrickBack: brick1;
		addBrickBack: brick2.

	self assertAllSubbricksAreClean: root.
	
	self assert: root extent equals: self staticExtent.
	self assert: brick1 brickBounds equals: (0@0 extent: (self staticWidth / 2) @ self staticHeight).
	self assert: brick2 brickBounds equals: ((self staticWidth / 2)@0 extent: (self staticWidth / 2) @ self staticHeight).
	! !

!GLMBrickTests methodsFor: 'defaults' stamp: 'AliakseiSyrel 2/4/2015 16:36'!
staticExtent

	^ self staticWidth  @ self staticHeight! !

!GLMBrickTests methodsFor: 'tests-geometry' stamp: 'AliakseiSyrel 2/9/2015 23:03'!
testMaxHeightOneStatic
	|brick|
	
	brick := self newBrickWithStaticExtent.
	brick maxHeight: self staticSmallHeight.
	brick doLayoutForce.
	self assertAllSubbricksAreClean: brick.
	
	self assert: brick brickBounds equals: (0@0 extent: self staticWidth @ self staticSmallHeight)! !

!GLMBrickTests methodsFor: 'asserting' stamp: 'AliakseiSyrel 2/4/2015 16:04'!
assertWidthDirty: aBrick

	self assert: aBrick wrappedBounds widthState equals: #dirty.
	self assert: aBrick wrappedBounds isWidthDirty.
	self assert: aBrick wrappedBounds isWidthClean not! !

!GLMBrickTests methodsFor: 'asserting' stamp: 'AliakseiSyrel 2/4/2015 16:05'!
assertBrickClean: aBrick

	self assertWidthClean: aBrick.
	self assertHeightClean: aBrick! !

!GLMBrickTests methodsFor: 'defaults' stamp: 'AliakseiSyrel 2/8/2015 19:33'!
staticSmallHeight

	^ 50! !

!GLMBrickTests methodsFor: 'tests-geometry' stamp: 'AliakseiSyrel 2/8/2015 20:17'!
testLeftMarginChangeMyselfDependency
	|root margin newMargin brick|
	margin := 10.
	newMargin := 20.
	
	root := self newBrickWithStaticExtent.
	brick := self newBrickWithSmallStaticExtent.
	brick marginLeft: margin.
	root addBrickBack: brick.

	self assertAllSubbricksAreClean: root.
	self assert: root extent equals: self staticExtent.
	self assert: brick extent equals: self staticSmallExtent.
	self assert: brick brickBounds equals: (margin@0 extent: self staticSmallExtent).
	
	brick marginLeft: newMargin.
	brick doLayoutForce.
	
	self assertAllSubbricksAreClean: root.
	self assert: root extent equals: self staticExtent.
	self assert: brick extent equals: self staticSmallExtent.
	self assert: brick brickBounds equals: (newMargin@0 extent: self staticSmallExtent).! !

!GLMBrickTests methodsFor: 'tests-geometry' stamp: 'AliakseiSyrel 2/8/2015 19:36'!
testLeftMarginMyselfDependency
	|root margin brick|
	margin := 10.
	
	root := self newBrickWithStaticExtent.
	brick := self newBrickWithSmallStaticExtent.
	brick marginLeft: margin.
	root addBrickBack: brick.

	self assertAllSubbricksAreClean: root.
	self assert: root extent equals: self staticExtent.
	self assert: brick extent equals: self staticSmallExtent.
	self assert: brick brickBounds equals: (margin@0 extent: self staticSmallExtent)! !

!GLMBrickTests methodsFor: 'tests-geometry' stamp: 'AliakseiSyrel 2/9/2015 23:23'!
testMinHeightTwoParentDependencies
	|root brick1 brick2 height|
	height := 80.
	
	root := self newBrickWithStaticExtent.
	root useVerticalLinearLayout.
	brick1 := self newBrickWithFullFill.
	brick1 vSpaceFill: 50. "50% = 50px"
	brick1 minHeight: height. "min is 80px > 50%"
	brick2 := self newBrickWithFullFill.
	
	root addAllBricks:  { brick1 . brick2 }.
	self assertAllSubbricksAreClean: root.
	self assert: root extent equals: self staticExtent.
	self assert: brick1 extent equals: (self staticWidth @ height).
	self assert: brick2 extent equals: (self staticWidth @ (self staticHeight - height))! !

!GLMBrickTests methodsFor: 'tests-geometry' stamp: 'AliakseiSyrel 2/8/2015 19:36'!
testRightMarginMyselfDependency
	|root margin brick|
	margin := 10.
	
	root := self newBrickWithStaticExtent.
	brick := self newBrickWithSmallStaticExtent.
	brick marginRight: margin.
	root addBrickBack: brick.

	self assertAllSubbricksAreClean: root.
	self assert: root extent equals: self staticExtent.
	self assert: brick extent equals: self staticSmallExtent.
	self assert: brick brickBounds equals: (0@0 extent: self staticSmallExtent)! !

!GLMBrickTests methodsFor: 'instance-creation' stamp: 'AliakseiSyrel 3/22/2015 19:11'!
newBrickWithFullFill

	^ GLMBrick new 
		hSpaceFill;
		vSpaceFill;
		color: Color random;
		yourself! !

!GLMBrickTests methodsFor: 'tests-layouter' stamp: 'AliakseiSyrel 2/8/2015 13:55'!
testOneDependsOnParentOneDependsOnChildrenInsideStatic
	|root brick1 brick2 brick3 staticWidth staticHeight|
	
	staticWidth := 20.
	staticHeight := 50.
	
	root := self newBrickWithStaticExtent.
	brick1 := self newBrickFullHeightAndWidthDependsOnParent: 100.
	brick2 := self newBrickWithFullDependsOnChildren.
	brick3 := GLMBrick new width: staticWidth; height: staticHeight; yourself.
	
	root addBrickBack: brick1.
	self assert: root extent equals: self staticExtent.
	self assert: brick1 brickBounds equals: (0@0 extent: self staticExtent).
	
	root addBrickBack: brick2.
	self assert: root extent equals: self staticExtent.
	self assert: brick1 brickBounds equals: (0@0 extent: self staticExtent).
	self assert: brick2 brickBounds equals: (self staticWidth @0 extent: 0@0).
	
	brick2 addBrickBack: brick3.
		
	self assertAllSubbricksAreClean: root.
	
	self assert: root extent equals: self staticExtent.
	self assert: brick1 brickBounds equals: (0@0 extent: (self staticWidth - staticWidth) @ self staticHeight).
	self assert: brick2 brickBounds equals: ((self staticWidth - staticWidth)@0 extent: (staticWidth) @ staticHeight).
	self assert: brick3 brickBounds equals: (0@0 extent: (staticWidth) @ staticHeight).
	! !

!GLMBrickTests methodsFor: 'defaults' stamp: 'AliakseiSyrel 2/8/2015 19:33'!
staticSmallWidth

	^ 50! !

!GLMBrickTests methodsFor: 'asserting' stamp: 'AliakseiSyrel 2/4/2015 16:05'!
assertHeightClean: aBrick

	self assert: aBrick wrappedBounds heightState equals: #clean.
	self assert: aBrick wrappedBounds isHeightDirty not.
	self assert: aBrick wrappedBounds isHeightClean! !

!GLMBrickTests methodsFor: 'instance-creation' stamp: 'AliakseiSyrel 2/14/2015 16:33'!
markFullyClean: aBrick 

	aBrick withAllSubbricks do: [ :each | each wrappedBounds markWidthClean; markHeightClean ].
	^ aBrick! !

!GLMBrickTests methodsFor: 'tests-marker' stamp: 'AliakseiSyrel 4/1/2015 23:03'!
testMarkerOneChildrenInChildrenWidth
	|root brick|
	
	root := self newBrickWithFullDependsOnChildren.
	brick := self newBrickWithFullDependsOnChildren.
	root addBrickBack: brick.
	self markFullyClean: root.
	
	brick wrappedBounds markWidthDirty.
	GLMBrickLayouter uniqueInstance markDependent: brick brickApi.
	
	self assert: brick wrappedBounds isWidthDirty.
	self assert: brick wrappedBounds isHeightClean.
	
	self assert: root wrappedBounds isWidthDirty.
	self assert: root wrappedBounds isHeightClean.! !

!GLMBrickTests methodsFor: 'tests-marker' stamp: 'AliakseiSyrel 4/1/2015 23:04'!
testMarkerOneParentWidth
	|brick|
	
	brick := self newBrickWithFullFill.
	self markFullyClean: brick.
	
	brick wrappedBounds markWidthDirty.
	GLMBrickLayouter uniqueInstance markDependent: brick brickApi.
	
	self assert: brick wrappedBounds isWidthDirty.
	self assert: brick wrappedBounds isHeightClean.! !

!GLMBrickTests methodsFor: 'tests-geometry' stamp: 'AliakseiSyrel 2/8/2015 19:36'!
testBottomMarginMyselfDependency
	|root margin brick|
	margin := 10.
	
	root := self newBrickWithStaticExtent.
	brick := self newBrickWithSmallStaticExtent.
	brick marginBottom: margin.
	root addBrickBack: brick.

	self assertAllSubbricksAreClean: root.
	self assert: root extent equals: self staticExtent.
	self assert: brick extent equals: self staticSmallExtent.
	self assert: brick brickBounds equals: (0@0 extent: self staticSmallExtent)! !

!GLMBrickTests methodsFor: 'tests-align' stamp: 'AliakseiSyrel 3/22/2015 19:43'!
testFullAlignCenterShrinkWrapInSpaceFill
	|root brick1 brick2 brick3 increment|
	
	increment := 10.
	
	root := self newBrickWithStaticExtent.
	brick1 := self newBrickWithFullFill.
	brick2 := self newBrickWithFullDependsOnChildren.
	brick3 := self newBrickWithSmallStaticExtent.
	
	brick2
		vAlign: #center;
		hAlign: #center.
		
	root addBrickBack: brick1.
	brick1 addBrickBack: brick2.
	brick2 addBrickBack: brick3.
	
	self assertAllSubbricksAreClean: root.
	self assert: brick2 brickBounds equals: ((self staticExtent - self staticSmallExtent / 2) extent: self staticSmallExtent) ceiling.
	
	brick3
		height: brick3 height + increment;
		width: brick3 width + increment.
	self assertAllSubbricksAreClean: root.
	
	self assert: brick2 brickBounds equals: ((self staticExtent - self staticSmallExtent / 2 - (increment / 2) ) extent: (self staticSmallExtent + increment)) ceiling.
	
	
	
	! !

!GLMBrickTests methodsFor: 'tests-layouter' stamp: 'AliakseiSyrel 2/8/2015 13:40'!
testChangeChildrenInParentAndSubchildren
	|parent brick child|
	parent := self newBrickWithFullDependsOnChildren.
	brick := self newBrickWithStaticExtent.
	child := self newBrickFullHeightAndWidthDependsOnParent: 100.
	
	parent addBrickBack: brick.
	brick addBrickBack: child.
	self assertAllSubbricksAreClean: parent.
	self assert: parent extent equals: brick extent.
	self assert: child extent equals: brick extent.
	"height and width are changed, so parent should be re-layouted"
	brick height: self staticHeight * 2.
	brick width: self staticWidth * 2.
	
	self assertAllSubbricksAreClean: parent.
	self assert: brick extent equals: self staticExtent * 2.
	self assert: parent extent equals: brick extent.
	self assert: child extent equals: brick extent
	
! !

!GLMBrickTests methodsFor: 'tests-geometry' stamp: 'AliakseiSyrel 2/8/2015 19:29'!
testLeftMarginParentDependency
	|root margin brick|
	margin := 10.
	
	root := self newBrickWithStaticExtent.
	brick := self newBrickFullHeightAndWidthDependsOnParent: 100.
	brick marginLeft: margin.
	root addBrickBack: brick.

	self assertAllSubbricksAreClean: root.
	self assert: root extent equals: self staticExtent.
	self assert: brick extent equals: (self staticExtent - (margin@0)).
	self assert: brick brickBounds equals: (margin@0 corner: self staticExtent)! !

!GLMBrickTests methodsFor: 'tests-marker' stamp: 'AliakseiSyrel 4/1/2015 23:04'!
testMarkerOneParentHeight
	|brick|
	
	brick := self newBrickWithFullFill.
	self markFullyClean: brick.
	
	brick wrappedBounds markHeightDirty.
	GLMBrickLayouter uniqueInstance markDependent: brick brickApi.
	
	self assert: brick wrappedBounds isWidthClean.
	self assert: brick wrappedBounds isHeightDirty.! !

!GLMBrickTests methodsFor: 'tests-layouter' stamp: 'AliakseiSyrel 4/2/2015 00:56'!
testEmptyBrickDependsOnChildren
	|brick|
	
	brick := self newBrickWithFullDependsOnChildren.
	
	self assert: brick brickApi layout hState isOnChildren.
	self assert: brick brickApi layout vState isOnChildren.
	
	self assertAllSubbricksAreDirty: brick.
	brick doLayout.
	self assertAllSubbricksAreClean: brick.
	
	self assert: brick extent equals: 0@0! !

!GLMBrickTests methodsFor: 'tests-marker' stamp: 'AliakseiSyrel 4/1/2015 23:03'!
testMarkerOneChildrenHeight
	|brick|
	
	brick := self newBrickWithFullDependsOnChildren.
	self markFullyClean: brick.
	
	brick wrappedBounds markHeightDirty.
	GLMBrickLayouter uniqueInstance markDependent: brick brickApi.
	
	self assert: brick wrappedBounds isWidthClean.
	self assert: brick wrappedBounds isHeightDirty.! !

!GLMBrickTests methodsFor: 'instance-creation' stamp: 'AliakseiSyrel 3/22/2015 19:11'!
newBrickWithStaticExtent

	^ GLMBrick new 
		height: self staticHeight;
		width: self staticWidth;
		color: Color random;
		yourself! !

!GLMBrickTests methodsFor: 'asserting' stamp: 'AliakseiSyrel 2/4/2015 16:05'!
assertAllSubbricksAreDirty: aBrick

	aBrick withAllSubbricks do: [ :each | self assertBrickDirty: each ]! !

!GLMBrickTests methodsFor: 'tests-marker' stamp: 'AliakseiSyrel 4/1/2015 23:03'!
testMarkerOneChildrenInParentWidth
	|root brick|
	
	root := self newBrickWithFullFill.
	brick := self newBrickWithFullDependsOnChildren.
	root addBrickBack: brick.
	self markFullyClean: root.
	
	brick wrappedBounds markWidthDirty.
	GLMBrickLayouter uniqueInstance markDependent: brick brickApi.
	
	self assert: brick wrappedBounds isWidthDirty.
	self assert: brick wrappedBounds isHeightClean.
	
	self assert: root wrappedBounds isWidthClean.
	self assert: root wrappedBounds isHeightClean.! !

!GLMBrickTests methodsFor: 'tests-marker' stamp: 'AliakseiSyrel 4/1/2015 23:04'!
testMarkerOneParentInParentWidth
	|root brick|
	
	root := self newBrickWithFullFill.
	brick := self newBrickWithFullFill.
	root addBrickBack: brick.
	self markFullyClean: root.
	
	brick wrappedBounds markWidthDirty.
	GLMBrickLayouter uniqueInstance markDependent: brick brickApi.
	
	self assert: brick wrappedBounds isWidthDirty.
	self assert: brick wrappedBounds isHeightClean.
	
	self assert: root wrappedBounds isWidthClean.
	self assert: root wrappedBounds isHeightClean.! !

!GLMBrickTests methodsFor: 'tests-marker' stamp: 'AliakseiSyrel 4/1/2015 18:00'!
testMarkerOneStaticInStaticHeight
	|root brick|
	
	root := self newBrickWithStaticExtent.
	brick := self newBrickWithStaticExtent.
	root addBrickBack: brick.
	self markFullyClean: root.
	
	brick wrappedBounds markHeightDirty.
	GLMBrickLayouter uniqueInstance markDependent: brick brickApi.
	
	self assert: brick wrappedBounds isWidthClean.
	self assert: brick wrappedBounds isHeightDirty.
	
	self assert: root wrappedBounds isWidthClean.
	self assert: root wrappedBounds isHeightClean.! !

!GLMBrickTests methodsFor: 'tests-geometry' stamp: 'AliakseiSyrel 2/8/2015 19:30'!
testRightMarginParentDependency
	|root margin brick|
	margin := 10.
	
	root := self newBrickWithStaticExtent.
	brick := self newBrickFullHeightAndWidthDependsOnParent: 100.
	brick marginRight: margin.
	root addBrickBack: brick.

	self assertAllSubbricksAreClean: root.
	self assert: root extent equals: self staticExtent.
	self assert: brick extent equals: (self staticExtent - (margin@0)).
	self assert: brick brickBounds equals: (0@0 corner: self staticExtent - (margin@0))! !

!GLMBrickTests methodsFor: 'tests-layouter' stamp: 'AliakseiSyrel 2/8/2015 13:42'!
test100StaticBricksInsideEachOtherIndideStatic
	|root current|
	
	root := self newBrickWithStaticExtent.
	current := root.
	1 to: 100 do: [ :index |
		current := current addBrickBack: self newBrickWithStaticExtent ].
	
	self assertAllSubbricksAreClean: root.
	
	self assert: current extent equals: root extent
	! !

!GLMBrickTests methodsFor: 'tests-layouter' stamp: 'AliakseiSyrel 4/2/2015 00:57'!
testOneStaticBrick
	|brick|
	
	brick := self newBrickWithStaticExtent.
	
	self assert: brick brickApi layout hState isOnMyself.
	self assert: brick brickApi layout vState isOnMyself.
	self assertBrickClean: brick.
	self assert: brick extent equals: self staticExtent
	! !

!GLMBrickTests methodsFor: 'tests-marker' stamp: 'AliakseiSyrel 4/1/2015 18:00'!
testMarkerOneStaticInChildrenHeight
	|root brick|
	
	root := self newBrickWithFullDependsOnChildren.
	brick := self newBrickWithStaticExtent.
	root addBrickBack: brick.
	self markFullyClean: root.
	
	brick wrappedBounds markHeightDirty.
	GLMBrickLayouter uniqueInstance markDependent: brick brickApi.
	
	self assert: brick wrappedBounds isWidthClean.
	self assert: brick wrappedBounds isHeightDirty.
	
	self assert: root wrappedBounds isWidthClean.
	self assert: root wrappedBounds isHeightDirty.! !

!GLMBrickTests methodsFor: 'tests-layouter' stamp: 'AliakseiSyrel 3/23/2015 00:19'!
testTwoShrinkInShrinkChange
	|root brick1 brick2 brick3|
	
	root := self newBrickWithFullDependsOnChildren.
	brick1 := self newBrickWithFullDependsOnChildren.
	brick2 := self newBrickWithSmallStaticExtent.
	brick3 := self newBrickWithSmallStaticExtent.
	brick1 useVerticalLinearLayout.
	
	root addBrickBack: brick1.
	brick1 addBrickBack: brick2.
	brick1 addBrickBack: brick3.
	
	self assertAllSubbricksAreClean: root.
	self assert: root brickBounds equals: (0@0 extent: (self staticSmallWidth @ (2* self staticSmallHeight))).
	self assert: brick1 brickBounds equals: (0@0 extent: (self staticSmallWidth @ (2* self staticSmallHeight))).
	self assert: brick2 brickBounds equals: (0@0 extent: self staticSmallExtent).
	self assert: brick3 brickBounds equals: (0@self staticSmallHeight extent: self staticSmallExtent).
	
	brick2
		width: self staticWidth;
		height: self staticHeight.
	
	self assert: root brickBounds equals: (0@0 extent: (self staticWidth @ (self staticHeight + self staticSmallHeight))).
	self assert: brick1 brickBounds equals: (0@0 extent: (self staticWidth @ (self staticHeight + self staticSmallHeight))).
	self assert: brick2 brickBounds equals: (0@0 extent: self staticExtent).
	self assert: brick3 brickBounds equals: (0@self staticHeight extent: self staticSmallExtent).
	! !

!GLMBrickTests methodsFor: 'tests-layouter' stamp: 'AliakseiSyrel 2/8/2015 18:08'!
testShrinkWrapInStaticWithNeighbours
	|root band child1 child2 neighbour childWidth width|
	width := 20.
	childWidth := self staticWidth - width.
	
	root := self newBrickWithStaticExtent useHorizontalLinearLayout.
	band := GLMBrick new useVerticalLinearLayout; hSpaceFill; vShrinkWrap.
	child1 := GLMBrick new height: self staticHeight; hSpaceFill.
	child2 := GLMBrick new height: self staticHeight; hSpaceFill.
	neighbour := GLMBrick new vSpaceFill; width: width.
	
	root addAllBricks: { band. neighbour }.
	band addAllBricks: { child1. child2 }.
	
	self assertAllSubbricksAreClean: root.
	
	self assert: root brickBounds equals: (0@0 extent: self staticExtent).
	self assert: neighbour brickBounds equals: (childWidth@0 extent: width@self staticHeight).
	self assert: child1 brickBounds equals: (0@0 extent: childWidth@self staticHeight).
	self assert: child2 brickBounds equals: (0@self staticHeight extent: childWidth@self staticHeight).
	self assert: band brickBounds equals: (0@0 extent: childWidth@(self staticHeight+self staticHeight)).! !

!GLMBrickTests methodsFor: 'tests-geometry' stamp: 'AliakseiSyrel 2/8/2015 19:32'!
testBottomMarginParentDependency
	|root margin brick|
	margin := 10.
	
	root := self newBrickWithStaticExtent.
	brick := self newBrickFullHeightAndWidthDependsOnParent: 100.
	brick marginBottom: margin.
	root addBrickBack: brick.

	self assertAllSubbricksAreClean: root.
	self assert: root extent equals: self staticExtent.
	self assert: brick extent equals: (self staticExtent - (0@margin)).
	self assert: brick brickBounds equals: (0@0 corner: self staticExtent - (0@margin))! !

!GLMBrickTests methodsFor: 'tests-layouter' stamp: 'AliakseiSyrel 2/8/2015 13:44'!
testFreshBrickIsDirty

	self assertBrickDirty: GLMBrick new! !

!GLMBrickTests methodsFor: 'tests-floating' stamp: 'AliakseiSyrel 2/8/2015 19:40'!
testRightFloatingMySelfDependency
	|root floating brick|
	floating := #right.
	
	root := self newBrickWithStaticExtent.
	brick := self newBrickWithSmallStaticExtent.
	brick layout floating: floating.
	root addBrickBack: brick.

	self assertAllSubbricksAreClean: root.
	self assert: root extent equals: self staticExtent.
	self assert: brick extent equals: self staticSmallExtent.
	self assert: brick brickBounds equals: ((self staticWidth - self staticSmallWidth)@0 extent: self staticSmallExtent)! !

!GLMBrickTests methodsFor: 'tests-geometry' stamp: 'AliakseiSyrel 2/9/2015 23:15'!
testMaxHeightTwoParentDependencies
	|root brick1 brick2|
	
	root := self newBrickWithStaticExtent.
	root useVerticalLinearLayout.
	brick1 := self newBrickWithFullFill.
	brick1 maxHeight: self staticSmallHeight.
	brick2 := self newBrickWithFullFill.
	
	root addAllBricks:  { brick1 . brick2 }.
	self assertAllSubbricksAreClean: root.
	
	self assert: root extent equals: self staticExtent.
	self assert: brick1 extent equals: (self staticWidth @ self staticSmallHeight).
	self assert: brick2 extent equals: (self staticWidth @ (self staticHeight - self staticSmallHeight))! !

!GLMBrickTests methodsFor: 'tests-layouter' stamp: 'AliakseiSyrel 2/8/2015 13:42'!
test100FillBricksInsideEachOtherIndideStatic
	|root current|
	
	root := self newBrickWithStaticExtent.
	current := root.
	1 to: 100 do: [ :index |
		current := current addBrickBack: self newBrickWithFullFill ].
	
	self assertAllSubbricksAreClean: root.
	
	self assert: current extent equals: root extent
	! !

!GLMBrickTests methodsFor: 'tests-layouter' stamp: 'AliakseiSyrel 4/2/2015 00:55'!
testBrickDependsOnChildrenOneStatic
	|root brick|
	
	root := self newBrickWithFullDependsOnChildren.
	brick := self newBrickWithStaticExtent.
	
	root addBrickBack: brick.
	
	self assert: root brickApi layout hState isOnChildren.
	self assert: root brickApi layout vState isOnChildren.
	
	self assertAllSubbricksAreClean: root.
	
	self assert: root extent equals: brick extent! !

!GLMBrickTests methodsFor: 'tests-floating' stamp: 'AliakseiSyrel 2/8/2015 19:41'!
testLeftFloatingMySelfDependency
	|root floating brick|
	floating := #left.
	
	root := self newBrickWithStaticExtent.
	brick := self newBrickWithSmallStaticExtent.
	brick layout floating: floating.
	root addBrickBack: brick.

	self assertAllSubbricksAreClean: root.
	self assert: root extent equals: self staticExtent.
	self assert: brick extent equals: self staticSmallExtent.
	self assert: brick brickBounds equals: (0@0 extent: self staticSmallExtent)! !

!GLMBrickTests methodsFor: 'tests-floating' stamp: 'AliakseiSyrel 2/8/2015 19:53'!
testRightFloatingMySelfDependencyWithMargin
	|root margin floating brick|
	margin := 10.
	floating := #right.
	
	root := self newBrickWithStaticExtent.
	brick := self newBrickWithSmallStaticExtent.
	brick layout floating: floating.
	brick marginRight: margin.
	root addBrickBack: brick.

	self assertAllSubbricksAreClean: root.
	self assert: root extent equals: self staticExtent.
	self assert: brick extent equals: self staticSmallExtent.
	self assert: brick brickBounds equals: ((self staticWidth - margin - self staticSmallWidth)@0 extent: self staticSmallExtent)! !

!GLMBrickTests methodsFor: 'asserting' stamp: 'AliakseiSyrel 2/4/2015 16:04'!
assertBrickDirty: aBrick

	self assertWidthDirty: aBrick.
	self assertHeightDirty: aBrick! !

!GLMBrickTests methodsFor: 'tests-layouter' stamp: 'AliakseiSyrel 2/8/2015 13:43'!
testChangeChildrenInParent
	|parent brick|
	parent := self newBrickWithFullDependsOnChildren.
	brick := self newBrickWithStaticExtent.
	
	parent addBrickBack: brick.
	self assertAllSubbricksAreClean: parent.
	self assert: parent extent equals: brick extent.
	"height and width are changed, so parent should be re-layouted"
	brick height: self staticHeight * 2.
	brick width: self staticWidth * 2.
	
	self assertAllSubbricksAreClean: parent.
	self assert: brick extent equals: self staticExtent * 2.
	self assert: parent extent equals: brick extent
	
! !

!GLMBrickTests methodsFor: 'asserting' stamp: 'AliakseiSyrel 2/4/2015 16:04'!
assertWidthClean: aBrick

	self assert: aBrick wrappedBounds widthState equals: #clean.
	self assert: aBrick wrappedBounds isWidthDirty not.
	self assert: aBrick wrappedBounds isWidthClean! !

!GLMBrickTests methodsFor: 'defaults' stamp: 'AliakseiSyrel 2/4/2015 16:08'!
staticHeight

	^ 100! !

!GLMBrickTests methodsFor: 'defaults' stamp: 'AliakseiSyrel 2/8/2015 19:33'!
staticSmallExtent

	^ self staticSmallWidth  @ self staticSmallHeight! !

!GLMBrickTests methodsFor: 'instance-creation' stamp: 'AliakseiSyrel 3/22/2015 19:11'!
newBrickFullHeightAndWidthDependsOnParent: anInteger

	^ GLMBrick new
		vSpaceFill;
		hSpaceFill: anInteger;
		color: Color random;
		yourself! !

!GLMBrickTests methodsFor: 'tests-marker' stamp: 'AliakseiSyrel 4/1/2015 23:04'!
testMarkerOneStaticHeight
	|brick|
	
	brick := self newBrickWithStaticExtent.
	self markFullyClean: brick.
	
	brick wrappedBounds markHeightDirty.
	GLMBrickLayouter uniqueInstance markDependent: brick brickApi.
	
	self assert: brick wrappedBounds isWidthClean.
	self assert: brick wrappedBounds isHeightDirty.! !

!GLMBrickTests methodsFor: 'tests-marker' stamp: 'AliakseiSyrel 4/1/2015 18:00'!
testMarkerOneParentInParentHeight
	|root brick|
	
	root := self newBrickWithFullFill.
	brick := self newBrickWithFullFill.
	root addBrickBack: brick.
	self markFullyClean: root.
	
	brick wrappedBounds markHeightDirty.
	GLMBrickLayouter uniqueInstance markDependent: brick brickApi.
	
	self assert: brick wrappedBounds isWidthClean.
	self assert: brick wrappedBounds isHeightDirty.
	
	self assert: root wrappedBounds isWidthClean.
	self assert: root wrappedBounds isHeightClean.! !

!GLMBrickTests methodsFor: 'tests-marker' stamp: 'AliakseiSyrel 4/1/2015 23:03'!
testMarkerOneStaticInChildrenWidth
	|root brick|
	
	root := self newBrickWithFullDependsOnChildren.
	brick := self newBrickWithStaticExtent.
	root addBrickBack: brick.
	self markFullyClean: root.
	
	brick wrappedBounds markWidthDirty.
	GLMBrickLayouter uniqueInstance markDependent: brick brickApi.
	
	self assert: brick wrappedBounds isWidthDirty.
	self assert: brick wrappedBounds isHeightClean.
	
	self assert: root wrappedBounds isWidthDirty.
	self assert: root wrappedBounds isHeightClean.! !

!GLMBrickTests methodsFor: 'tests-marker' stamp: 'AliakseiSyrel 4/1/2015 17:59'!
testMarkerOneChildrenInChildrenHeight
	|root brick|
	
	root := self newBrickWithFullDependsOnChildren.
	brick := self newBrickWithFullDependsOnChildren.
	root addBrickBack: brick.
	self markFullyClean: root.
	
	brick wrappedBounds markHeightDirty.
	GLMBrickLayouter uniqueInstance markDependent: brick brickApi.
	
	self assert: brick wrappedBounds isWidthClean.
	self assert: brick wrappedBounds isHeightDirty.
	
	self assert: root wrappedBounds isWidthClean.
	self assert: root wrappedBounds isHeightDirty.! !

!GLMBrickTests methodsFor: 'asserting' stamp: 'AliakseiSyrel 2/4/2015 16:03'!
assertHeightDirty: aBrick

	self assert: aBrick wrappedBounds heightState equals: #dirty.
	self assert: aBrick wrappedBounds isHeightDirty.
	self assert: aBrick wrappedBounds isHeightClean not! !

!GLMBrickTests methodsFor: 'tests-marker' stamp: 'AliakseiSyrel 4/1/2015 23:03'!
testMarkerOneStaticWidth
	|brick|
	
	brick := self newBrickWithStaticExtent.
	self markFullyClean: brick.
	
	brick wrappedBounds markWidthDirty.
	GLMBrickLayouter uniqueInstance markDependent: brick brickApi.
	
	self assert: brick wrappedBounds isWidthDirty.
	self assert: brick wrappedBounds isHeightClean.! !

!GLMBrickTests methodsFor: 'tests-geometry' stamp: 'AliakseiSyrel 2/9/2015 23:03'!
testMaxWidthOneStatic
	|brick|
	
	brick := self newBrickWithStaticExtent.
	brick maxWidth: self staticSmallWidth.
	brick doLayoutForce.
	self assertAllSubbricksAreClean: brick.
	
	self assert: brick brickBounds equals: (0@0 extent: self staticSmallWidth @ self staticHeight)! !

!GLMBrickTests methodsFor: 'tests-geometry' stamp: 'AliakseiSyrel 2/9/2015 23:58'!
testMinAndMaxHeightTwoParentDependenciesReverse
	|root brick1 brick2 minHeight maxHeight|
	minHeight := 20.
	maxHeight := 60.
	
	root := self newBrickWithStaticExtent.
	root useVerticalLinearLayout.
	brick1 := self newBrickWithFullFill.
	brick1 vSpaceFill: 0. "0% = 0px"
	brick1 minHeight: minHeight. "min is 20px > 0%"
	brick2 := self newBrickWithFullFill.
	brick2 maxHeight: maxHeight. "max is 60 < 100%"
	
	root addAllBricks:  { brick1 . brick2 }.
	self assertAllSubbricksAreClean: root.
	self assert: root extent equals: self staticExtent.
	self assert: brick1 extent equals: (self staticWidth @ minHeight).
	self assert: brick2 extent equals: (self staticWidth @ maxHeight)! !

!GLMBrickTests methodsFor: 'tests-layouter' stamp: 'AliakseiSyrel 2/8/2015 13:44'!
testOneDependsOnParentOneStaticInsideStatic
	|root brick1 brick2 staticWidth|
	
	staticWidth := 20.
	
	root := self newBrickWithStaticExtent.
	brick1 := self newBrickFullHeightAndWidthDependsOnParent: 100.
	brick2 := GLMBrick new width: staticWidth; vSpaceFill; yourself.
	
	root
		addBrickBack: brick1;
		addBrickBack: brick2.
	
	self assertAllSubbricksAreClean: root.
	
	self assert: root extent equals: self staticExtent.
	self assert: brick1 brickBounds equals: (0@0 extent: (self staticWidth - staticWidth) @ self staticHeight).
	self assert: brick2 brickBounds equals: ((self staticWidth - staticWidth)@0 extent: (staticWidth) @ self staticHeight).
	! !

!GLMBrickTests methodsFor: 'tests-geometry' stamp: 'AliakseiSyrel 2/8/2015 19:36'!
testTopMarginMyselfDependency
	|root margin brick|
	margin := 10.
	
	root := self newBrickWithStaticExtent.
	brick := self newBrickWithSmallStaticExtent.
	brick marginTop: margin.
	root addBrickBack: brick.

	self assertAllSubbricksAreClean: root.
	self assert: root extent equals: self staticExtent.
	self assert: brick extent equals: self staticSmallExtent.
	self assert: brick brickBounds equals: (0@margin extent: self staticSmallExtent)! !

!GLMBrickTests methodsFor: 'tests-layouter' stamp: 'AliakseiSyrel 3/23/2015 00:11'!
testShrinkInShrinkChange
	|root brick1 brick2|
	
	root := self newBrickWithFullDependsOnChildren.
	brick1 := self newBrickWithFullDependsOnChildren.
	brick2 := self newBrickWithSmallStaticExtent.
	
	root addBrickBack: brick1.
	brick1 addBrickBack: brick2.
	
	self assertAllSubbricksAreClean: root.
	self assert: root brickBounds equals: (0@0 extent: self staticSmallExtent).
	
	brick2
		width: self staticWidth;
		height: self staticHeight.
	
	self assert: root brickBounds equals: (0@0 extent: self staticExtent).
	! !

!GLMBrickTests methodsFor: 'tests-layouter' stamp: 'AliakseiSyrel 4/2/2015 00:57'!
testFillBrickInsideStatic
	|root brick|
	
	root := self newBrickWithStaticExtent.
	brick := self newBrickWithFullFill.
	brick brickApi layout hState isOnParent.
	brick brickApi layout vState isOnParent.
	root addBrickBack: brick.
	
	self assertAllSubbricksAreClean: root.
	self assert: brick extent equals: root extent
	! !

!GLMBrickTests methodsFor: 'asserting' stamp: 'AliakseiSyrel 2/4/2015 16:06'!
assertAllSubbricksAreClean: aBrick

	aBrick withAllSubbricks do: [ :each | self assertBrickClean: each ]! !

!GLMBrickTests methodsFor: 'tests-geometry' stamp: 'AliakseiSyrel 2/9/2015 23:04'!
testMinHeightOneStatic
	|brick|
	
	brick := self newBrickWithSmallStaticExtent.
	brick minHeight: self staticHeight.
	brick doLayoutForce.
	self assertAllSubbricksAreClean: brick.
	
	self assert: brick brickBounds equals: (0@0 extent: self staticSmallWidth @ self staticHeight)! !

!GLMBrickTests methodsFor: 'tests-marker' stamp: 'AliakseiSyrel 4/1/2015 18:00'!
testMarkerOneChildrenInStaticHeight
	|root brick|
	
	root := self newBrickWithStaticExtent.
	brick := self newBrickWithFullDependsOnChildren.
	root addBrickBack: brick.
	self markFullyClean: root.
	
	brick wrappedBounds markHeightDirty.
	GLMBrickLayouter uniqueInstance markDependent: brick brickApi.
	
	self assert: brick wrappedBounds isWidthClean.
	self assert: brick wrappedBounds isHeightDirty.
	
	self assert: root wrappedBounds isWidthClean.
	self assert: root wrappedBounds isHeightClean.! !

!GLMBrickTests methodsFor: 'tests-marker' stamp: 'AliakseiSyrel 4/1/2015 18:00'!
testMarkerOneStaticInParentHeight
	|root brick|
	
	root := self newBrickWithFullFill.
	brick := self newBrickWithStaticExtent.
	root addBrickBack: brick.
	self markFullyClean: root.
	
	brick wrappedBounds markHeightDirty.
	GLMBrickLayouter uniqueInstance markDependent: brick brickApi.
	
	self assert: brick wrappedBounds isWidthClean.
	self assert: brick wrappedBounds isHeightDirty.
	
	self assert: root wrappedBounds isWidthClean.
	self assert: root wrappedBounds isHeightClean.! !

!GLMBrickTests methodsFor: 'tests-geometry' stamp: 'AliakseiSyrel 2/9/2015 23:58'!
testMinAndMaxHeightTwoParentDependencies
	|root brick1 brick2 minHeight maxHeight|
	minHeight := 60.
	maxHeight := 20.
	
	root := self newBrickWithStaticExtent.
	root useVerticalLinearLayout.
	brick1 := self newBrickWithFullFill.
	brick1 vSpaceFill: 50. "50% = 50px"
	brick1 minHeight: minHeight. "min is 60px > 50%"
	brick2 := self newBrickWithFullFill.
	brick2 maxHeight: maxHeight. "max is 20 < 100%"
	
	root addAllBricks:  { brick1 . brick2 }.
	self assertAllSubbricksAreClean: root.
	self assert: root extent equals: self staticExtent.
	self assert: brick1 extent equals: (self staticWidth @ minHeight).
	self assert: brick2 extent equals: (self staticWidth @ maxHeight)! !

!GLMBrickTests methodsFor: 'tests-marker' stamp: 'AliakseiSyrel 4/1/2015 23:04'!
testMarkerOneChildrenInStaticWidth
	|root brick|
	
	root := self newBrickWithStaticExtent.
	brick := self newBrickWithFullDependsOnChildren.
	root addBrickBack: brick.
	self markFullyClean: root.
	
	brick wrappedBounds markWidthDirty.
	GLMBrickLayouter uniqueInstance markDependent: brick brickApi.
	
	self assert: brick wrappedBounds isWidthDirty.
	self assert: brick wrappedBounds isHeightClean.
	
	self assert: root wrappedBounds isWidthClean.
	self assert: root wrappedBounds isHeightClean.! !

!GLMBrickTests methodsFor: 'tests-floating' stamp: 'AliakseiSyrel 2/8/2015 19:44'!
testLeftFloatingMySelfDependencyWithMargin
	|root floating margin brick|
	margin := 10.
	floating := #left.
	
	root := self newBrickWithStaticExtent.
	brick := self newBrickWithSmallStaticExtent.
	brick marginLeft: margin.
	brick layout floating: floating.
	root addBrickBack: brick.

	self assertAllSubbricksAreClean: root.
	self assert: root extent equals: self staticExtent.
	self assert: brick extent equals: self staticSmallExtent.
	self assert: brick brickBounds equals: (margin@0 extent: self staticSmallExtent)! !

!GLMBrickTests methodsFor: 'tests-marker' stamp: 'AliakseiSyrel 4/1/2015 23:03'!
testMarkerOneStaticInParentWidth
	|root brick|
	
	root := self newBrickWithFullFill.
	brick := self newBrickWithStaticExtent.
	root addBrickBack: brick.
	self markFullyClean: root.
	
	brick wrappedBounds markWidthDirty.
	GLMBrickLayouter uniqueInstance markDependent: brick brickApi.
	
	self assert: brick wrappedBounds isWidthDirty.
	self assert: brick wrappedBounds isHeightClean.
	
	self assert: root wrappedBounds isWidthClean.
	self assert: root wrappedBounds isHeightClean.! !

!GLMBrickTests methodsFor: 'running' stamp: 'AliakseiSyrel 2/4/2015 15:56'!
setUp
	super setUp.
	
	layouter := GLMBrickLayouter new! !

!GLMBrickTests methodsFor: 'tests-marker' stamp: 'AliakseiSyrel 4/1/2015 23:03'!
testMarkerOneStaticInStaticWidth
	|root brick|
	
	root := self newBrickWithStaticExtent.
	brick := self newBrickWithStaticExtent.
	root addBrickBack: brick.
	self markFullyClean: root.
	
	brick wrappedBounds markWidthDirty.
	GLMBrickLayouter uniqueInstance markDependent: brick brickApi.
	
	self assert: brick wrappedBounds isWidthDirty.
	self assert: brick wrappedBounds isHeightClean.
	
	self assert: root wrappedBounds isWidthClean.
	self assert: root wrappedBounds isHeightClean.! !

!GLMBrickTests methodsFor: 'tests-geometry' stamp: 'AliakseiSyrel 2/9/2015 23:05'!
testMinWidthOneStatic
	|brick|
	
	brick := self newBrickWithSmallStaticExtent.
	brick minWidth: self staticWidth.
	brick doLayoutForce.
	self assertAllSubbricksAreClean: brick.
	
	self assert: brick brickBounds equals: (0@0 extent: self staticWidth @ self staticSmallHeight)! !

!GLMBrickTests methodsFor: 'tests-marker' stamp: 'AliakseiSyrel 4/1/2015 18:00'!
testMarkerOneChildrenInParentHeight
	|root brick|
	
	root := self newBrickWithFullFill.
	brick := self newBrickWithFullDependsOnChildren.
	root addBrickBack: brick.
	self markFullyClean: root.
	
	brick wrappedBounds markHeightDirty.
	GLMBrickLayouter uniqueInstance markDependent: brick brickApi.
	
	self assert: brick wrappedBounds isWidthClean.
	self assert: brick wrappedBounds isHeightDirty.
	
	self assert: root wrappedBounds isWidthClean.
	self assert: root wrappedBounds isHeightClean.! !

!GLMBrickTests methodsFor: 'tests-marker' stamp: 'AliakseiSyrel 4/1/2015 23:04'!
testMarkerOneParentInStaticWidth
	|root brick|
	
	root := self newBrickWithStaticExtent.
	brick := self newBrickWithFullFill.
	root addBrickBack: brick.
	self markFullyClean: root.
	
	brick wrappedBounds markWidthDirty.
	GLMBrickLayouter uniqueInstance markDependent: brick brickApi.
	
	self assert: brick wrappedBounds isWidthDirty.
	self assert: brick wrappedBounds isHeightClean.
	
	self assert: root wrappedBounds isWidthClean.
	self assert: root wrappedBounds isHeightClean.! !

!GLMBrickTests methodsFor: 'instance-creation' stamp: 'AliakseiSyrel 3/22/2015 19:11'!
newBrickWithSmallStaticExtent

	^ GLMBrick new 
		height: self staticSmallHeight;
		width: self staticSmallWidth;
		color: Color random;
		yourself! !

!GLMBrickTests methodsFor: 'tests-marker' stamp: 'AliakseiSyrel 4/1/2015 23:04'!
testMarkerOneChildrenWidth
	|brick|
	
	brick := self newBrickWithFullDependsOnChildren.
	self markFullyClean: brick.
	
	brick wrappedBounds markWidthDirty.
	GLMBrickLayouter uniqueInstance markDependent: brick brickApi.
	
	self assert: brick wrappedBounds isWidthDirty.
	self assert: brick wrappedBounds isHeightClean.! !

!GLMBrickTests methodsFor: 'instance-creation' stamp: 'AliakseiSyrel 3/22/2015 19:11'!
newBrickWithFullDependsOnChildren

	^ GLMBrick new 
		hShrinkWrap;
		vShrinkWrap;
		color: Color random;
		yourself! !

!GLMBrickThemer commentStamp: 'AliakseiSyrel 3/17/2015 23:01'!
A GLMBrickThemer is the main Brick themer class where styles for core and basic Bricks are defined.

Instance Variables
	modules:		<Dictionary>

modules
	- dictionary with all registered style modules with association module name -> module
!
!GLMBrickThemer methodsFor: 'brick-modules' stamp: 'AliakseiSyrel 1/30/2015 16:18'!
addModule: aThemerModule named: aSymbol

	self modules at: aSymbol put: aThemerModule.
	aThemerModule themer: self.
	^ aThemerModule! !

!GLMBrickThemer methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 3/17/2015 22:58'!
popupThemer

	^ self
		registerModule: GLMBrickPopupThemer new! !

!GLMBrickThemer methodsFor: 'brick-checkbox' stamp: ''!
checkboxCheckedImage

	^ GLMUIThemeExtraIcons glamorousAccept! !

!GLMBrickThemer methodsFor: 'brick-scrollbar' stamp: ''!
scrollbarColor

	^ Color lightGray alpha: 0.5! !

!GLMBrickThemer methodsFor: 'brick' stamp: 'AliakseiSyrel 3/21/2015 23:39'!
textLightColor

	^ Color gray! !

!GLMBrickThemer methodsFor: 'brick-scrollbar' stamp: ''!
scrollbarOffset

	^ 1! !

!GLMBrickThemer methodsFor: 'brick-modules' stamp: 'AliakseiSyrel 2/11/2015 13:36'!
registerModule: aModule to: aThemer named: aString
	"Registers aModule to aThemer. It stores modules in a dictionaty where a key is a selector of my caller method. It allows to customize bricks that are not added to the application (in this case they don't have access to custom themer normaly, because owner is nil) using the same api as added one."
	^ self modules
		at: aString
		ifAbsent: [ aThemer addModule: aModule named: aString ]! !

!GLMBrickThemer methodsFor: 'brick-button' stamp: ''!
buttonBorderColor
	
	^ Color lightGray! !

!GLMBrickThemer methodsFor: 'brick' stamp: 'AliakseiSyrel 1/30/2015 11:52'!
contentBackgroundColor

	^ Color white! !

!GLMBrickThemer methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 2/11/2015 13:50'!
popupSuccessThemer

	^ self
		registerModule: GLMBrickPopupSuccessThemer new
		to: self
		named: #popupThemer! !

!GLMBrickThemer methodsFor: 'brick' stamp: 'AliakseiSyrel 3/21/2015 20:48'!
normalBorderColor

	^ self color silver! !

!GLMBrickThemer methodsFor: 'brick-scrollbar' stamp: ''!
scrollbarWidth

	^ 3! !

!GLMBrickThemer methodsFor: 'brick-rubric' stamp: ''!
rubricBorderColor

	^ Color transparent! !

!GLMBrickThemer methodsFor: 'brick-rubric' stamp: ''!
rubricCursorColor

	^ self rubricTextColor! !

!GLMBrickThemer methodsFor: 'brick-button' stamp: ''!
buttonMinHeight

	^ 26! !

!GLMBrickThemer methodsFor: 'brick-button' stamp: ''!
buttonMinWidth

	^ 70! !

!GLMBrickThemer methodsFor: 'brick' stamp: 'AliakseiSyrel 3/21/2015 23:39'!
textSecondaryColor

	^ Color r:25 g: 35 b: 45 range: 255! !

!GLMBrickThemer methodsFor: 'brick-checkbox' stamp: ''!
checkboxHeight

	^ 18! !

!GLMBrickThemer methodsFor: 'brick-checkbox' stamp: ''!
checkboxWidth

	^ 18! !

!GLMBrickThemer methodsFor: 'brick-rubric' stamp: ''!
rubricTextBackgroundColor

	^ Color transparent! !

!GLMBrickThemer methodsFor: 'brick-modules' stamp: 'AliakseiSyrel 3/17/2015 22:58'!
registerModule: aModule

	^ self
		registerModule: aModule
		to: self
		named: thisContext sender selector! !

!GLMBrickThemer methodsFor: 'brick-button' stamp: ''!
buttonPadding

	^ #(3 7)! !

!GLMBrickThemer methodsFor: 'brick' stamp: 'AliakseiSyrel 3/21/2015 20:59'!
textColor

	^ self color darken! !

!GLMBrickThemer methodsFor: 'brick-button' stamp: ''!
buttonSelectedColor

	^ Color veryVeryLightGray lighter slightlyDarker! !

!GLMBrickThemer methodsFor: 'brick-scrollbar' stamp: ''!
scrollbarCornerRadius

	^ 0! !

!GLMBrickThemer methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 3/18/2015 19:35'!
tabLabelThemer

	^ self
		registerModule: GLMBrickTabLabelThemer new! !

!GLMBrickThemer methodsFor: 'brick-rubric' stamp: ''!
rubricBackgroundColor

	^ self contentBackgroundColor! !

!GLMBrickThemer methodsFor: 'brick-modules' stamp: 'AliakseiSyrel 2/11/2015 13:37'!
registerModule: aModule to: aThemer

	^ self
		registerModule: aModule
		to: aThemer
		named: thisContext sender selector! !

!GLMBrickThemer methodsFor: 'brick-modules' stamp: 'AliakseiSyrel 1/30/2015 15:58'!
modules

	^ modules ifNil: [ modules := Dictionary new ]! !

!GLMBrickThemer methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 2/11/2015 13:50'!
popupErrorThemer

	^ self
		registerModule: GLMBrickPopupErrorThemer new
		to: self
		named: #popupThemer! !

!GLMBrickThemer methodsFor: 'brick' stamp: 'AliakseiSyrel 1/26/2015 13:10'!
backgroundColor

	^ Color transparent! !

!GLMBrickThemer methodsFor: 'brick-scrollbar' stamp: ''!
scrollbarPosition

	^ #right! !

!GLMBrickThemer methodsFor: 'brick-modules' stamp: 'AliakseiSyrel 1/30/2015 16:11'!
doesNotUnderstand: aMessage

	^ self modules at: aMessage selector ifAbsent: [ super doesNotUnderstand: aMessage ]
	! !

!GLMBrickThemer methodsFor: 'brick-text' stamp: ''!
textFamilyName

	^ Smalltalk ui theme labelFont familyName! !

!GLMBrickThemer methodsFor: 'brick-rubric' stamp: ''!
rubricTextFamilyName
	
	^ StandardFonts codeFont familyName! !

!GLMBrickThemer methodsFor: 'brick-rubric' stamp: ''!
rubricBorderWidth

	^ 0! !

!GLMBrickThemer methodsFor: 'brick-button' stamp: ''!
buttonBackgroundColor

	^ Color veryVeryLightGray lighter! !

!GLMBrickThemer methodsFor: 'brick' stamp: 'AliakseiSyrel 3/21/2015 20:45'!
focusedBorderColor

	^ self color peterRiver! !

!GLMBrickThemer methodsFor: '*Glamour-Core' stamp: 'AliakseiSyrel 3/27/2015 13:18'!
actionThemer

	^ GLMActionBrickThemer new! !

!GLMBrickThemer methodsFor: '*GT-Spotter' stamp: 'AliakseiSyrel 3/17/2015 22:59'!
spotterThemer

	^ self
		registerModule: GTSpotterWidgetThemer new
		to: GTSpotterBrickThemer new! !

!GLMBrickThemer methodsFor: '*GT-Playground' stamp: 'AliakseiSyrel 3/30/2015 12:22'!
bindingThemer

	^ self registerModule: GTPlayBindingThemer new
		to: GLMActionBrickThemer new! !

!GLMBrickThemer methodsFor: 'brick-text' stamp: ''!
textFontSize

	^ Smalltalk ui theme labelFont pointSize! !

!GLMBrickThemer methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 2/11/2015 13:49'!
popupHelpThemer

	^ self
		registerModule: GLMBrickPopupHelpThemer new
		to: self
		named: #popupThemer! !

!GLMBrickThemer methodsFor: 'brick-rubric' stamp: ''!
rubricTextColor

	^ self textColor! !

!GLMBrickThemer methodsFor: 'brick-checkbox' stamp: ''!
checkboxBorderWidth

	^ 2! !

!GLMBrickThemer methodsFor: 'brick-rubric' stamp: ''!
rubricTextFontSize
	
	^ StandardFonts codeFont pointSize! !

!GLMBrickThemer methodsFor: 'brick' stamp: 'AliakseiSyrel 3/21/2015 15:01'!
focusedBorderWidth

	^ 1! !

!GLMBrickThemer methodsFor: 'brick-scrollpane' stamp: ''!
scrollpaneBackgroundColor

	^ self contentBackgroundColor! !

!GLMBrickThemer methodsFor: 'brick-button' stamp: ''!
buttonBorderWidth
	
	^ 1! !

!GLMBrickThemer methodsFor: 'brick-checkbox' stamp: ''!
checkboxBorderColor

	^ Color lightGray! !

!GLMBrickThemer methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 3/21/2015 20:42'!
color

	^ self
		registerModule: GLMBrickColorThemer new! !

!GLMBrickThemer methodsFor: 'brick-button' stamp: ''!
buttonPressedColor

	^ Color veryVeryLightGray lighter slightlyDarker slightlyDarker! !

!GLMBrickThemerModule methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/30/2015 15:56'!
themer

	^ themer! !

!GLMBrickThemerModule methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/30/2015 15:56'!
themer: anObject
	themer := anObject! !

!GLMBrickWidthTraverser methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/2/2015 00:16'!
state

	^ #hState! !

!GLMBrickWidthTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 2/9/2015 23:31'!
hasMinDimensionRestriction: aBrick

	^ aBrick layout hasMinWidth! !

!GLMBrickWidthTraverser methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/1/2015 21:08'!
opposite

	^ GLMBrickHeightTraverser uniqueInstance! !

!GLMBrickWidthTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 4/2/2015 14:03'!
updateDimension: aBrick

	"my height is already calculated, maybe because it children triggered calculation"
	aBrick isWidthClean ifTrue: [ ^ self ].
	(self dimensionPolicy: aBrick)  updateWidth: aBrick! !

!GLMBrickWidthTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 2/3/2015 16:47'!
customDependencies: aBrick

	^ aBrick layout widthDependencies! !

!GLMBrickWidthTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 4/2/2015 14:01'!
markDirty: aBrick

	self markLayoutDirty: aBrick owner.
	aBrick markWidthDirty
	! !

!GLMBrickWidthTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 4/2/2015 15:34'!
markClean: aBrick

	aBrick markWidthClean
	! !

!GLMBrickWidthTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 4/2/2015 14:01'!
isClean: aBrick

	^ aBrick isWidthClean! !

!GLMBrickWidthTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 2/9/2015 23:30'!
hasMaxDimensionRestriction: aBrick

	^ aBrick layout hasMaxWidth! !

!GLMBrickWidthTraverser methodsFor: 'private' stamp: 'AliakseiSyrel 4/2/2015 14:02'!
isOppositeClean: aBrick

	^ aBrick isHeightClean! !

!GLMBrickWidthTraverser class methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/1/2015 21:07'!
uniqueInstance
	^ uniqueInstance ifNil: [ uniqueInstance := self new ]! !

!GLMBrickWidthTraverser class methodsFor: 'cleanup' stamp: 'AndreiChis 3/24/2015 18:50'!
cleanUp

	uniqueInstance := nil! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/2/2015 14:02'!
isHeightClean

	^ self brick wrappedBounds isHeightClean! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/2/2015 14:00'!
isHeightDirty

	^ self brick wrappedBounds isHeightDirty! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/7/2015 19:43'!
markLayoutDirty

	self layout markDirty! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/2/2015 14:01'!
isWidthClean

	^ self brick wrappedBounds isWidthClean! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/1/2015 17:31'!
innerBounds

	^ self brick innerBounds! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/2/2015 14:00'!
isWidthDirty

	^ self brick wrappedBounds isWidthDirty! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/1/2015 17:31'!
outerBounds

	^ self brick outerBounds! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/1/2015 17:37'!
translateY: anObject

	^ self brick translateY: anObject! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/1/2015 17:25'!
brickBounds: aRectangle

	^ self brick brickBounds: aRectangle! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/1/2015 17:28'!
paddingTop

	^ self brick paddingTop! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/1/2015 17:25'!
marginLeft

	^ self brick marginLeft! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/1/2015 17:27'!
marginBottom

	^ self brick marginBottom! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/1/2015 16:44'!
invalidateLayout

	^ self brick invalidateLayout! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/2/2015 15:35'!
markHeightClean

	^ self brick wrappedBounds markHeightClean! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/1/2015 17:30'!
onLayoutEvent: aLayoutEvent

	^ self brick onLayoutEvent: aLayoutEvent! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/2/2015 14:04'!
withHeight: anInteger

	^ self brick withHeight: anInteger! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/2/2015 14:02'!
markHeightDirty

	^ self brick wrappedBounds markHeightDirty! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/1/2015 17:28'!
paddingBottom

	^ self brick paddingBottom! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/2/2015 15:36'!
outerWidth: anInteger

	^ self brick wrappedBounds outerWidth: anInteger! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/2/2015 15:34'!
markWidthClean

	^ self brick wrappedBounds markWidthClean! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/2/2015 14:01'!
markWidthDirty

	^ self brick wrappedBounds markWidthDirty! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/1/2015 17:25'!
marginTop

	^ self brick marginTop! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/1/2015 17:28'!
paddingLeft

	^ self brick paddingLeft! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/2/2015 15:45'!
width

	^ self brick width! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/1/2015 17:36'!
marginRight

	^ self brick marginRight! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/2/2015 14:04'!
withWidth: anInteger

	^ self brick withWidth: anInteger! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/7/2015 19:43'!
markLayoutClean

	self layout markClean! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/2/2015 15:44'!
extent

	^ self brick extent! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/1/2015 17:24'!
onLayouted

	^ self brick onLayouted! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/2/2015 15:45'!
outerOrigin: aPoint

	^ self brick wrappedBounds outerOrigin: aPoint! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/1/2015 17:28'!
paddingRight

	^ self brick paddingRight! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/1/2015 17:37'!
translateX: anObject

	^ self brick translateX: anObject! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/1/2015 16:44'!
onChildrenLayouted

	^ self brick onChildrenLayouted! !

!GLMBrickWrapper methodsFor: 'api' stamp: 'AliakseiSyrel 4/2/2015 15:38'!
outerHeight: anInteger

	^ self brick wrappedBounds outerHeight: anInteger! !

!GLMBrickedMorph commentStamp: 'AliakseiSyrel 1/7/2015 23:25'!
A GLMBrickedMorph is a direct subclass of Morph with removed layouting mechanism!
!GLMBrickedMorph methodsFor: 'layout' stamp: 'AliakseiSyrel 1/7/2015 23:19'!
privateFullBounds
	^ self fullBounds! !

!GLMBrickedMorph methodsFor: 'change reporting' stamp: 'AliakseiSyrel 1/7/2015 23:21'!
privateInvalidateMorph: aMorph
	"empty"! !

!GLMBrickedMorph methodsFor: 'drawing' stamp: 'AliakseiSyrel 1/7/2015 23:18'!
clippingBounds

	^ self fullBounds! !

!GLMBrickedMorph methodsFor: 'layout' stamp: 'AliakseiSyrel 1/7/2015 23:16'!
doLayoutIn: layoutBounds
	"we remove morphic layouting mechanism"! !

!GLMBrickedMorph methodsFor: 'layout' stamp: 'AliakseiSyrel 1/7/2015 23:17'!
layoutBounds: aRectangle
	"I'm not a morph anymore"! !

!GLMBrickedMorph methodsFor: 'layout' stamp: 'AliakseiSyrel 1/7/2015 23:18'!
layoutChanged

	"empty"! !

!GLMBrickedMorph methodsFor: 'layout' stamp: 'AliakseiSyrel 1/7/2015 23:16'!
adjustLayoutBounds
	"no need in it"! !

!GLMBrickedMorph methodsFor: 'layout' stamp: 'AliakseiSyrel 1/7/2015 23:16'!
computeBounds
	"nothing to compute, everything is already computed"! !

!GLMBrickedMorph methodsFor: 'geometry' stamp: 'AliakseiSyrel 1/7/2015 23:18'!
outerBounds
	^ self fullBounds! !

!GLMBrickedMorph methodsFor: 'layout' stamp: 'AliakseiSyrel 1/7/2015 23:16'!
computeFullBounds
	"nothing to compute, everything is already computed"! !

!GLMBrowser commentStamp: 'TudorGirba 2/4/2011 17:50'!
The Browser is one of the core components in Glamour.

It contains panes and transmissions between their ports. These transformations can either be explicitely defined by the user (such as in the Tabulator) or implicitely defined (such as in the Finder).

Browsers serve as composition managers. They determine when and under which conditions transmissions should be triggered and how they connect the ports of panes. In return, panes inform the browsers when event occur on their ports so that the browser can make an informed decission on what to do.

A Browser is a Presentation which means that it can be nested into other browsers.!
!GLMBrowser methodsFor: 'announcements' stamp: 'TudorGirba 7/10/2011 17:00'!
resetAnnouncer
	super resetAnnouncer.
	self panes do: [:each | each resetAnnouncer ]! !

!GLMBrowser methodsFor: 'scripting' stamp: ' 4/5/09 22:18'!
startOn: anObject 
	 
	self initializeScriptingDefaults. 
	self entity: anObject! !

!GLMBrowser methodsFor: 'events' stamp: 'TudorGirba 2/9/2014 00:22'!
close
	self announce: GLMBrowserClosed new! !

!GLMBrowser methodsFor: 'scripting-private' stamp: 'tg 10/25/2010 02:35'!
resolvePort: aPortReference defaultPortName: aSymbol 
	^ aPortReference paneName = #outer 
		ifTrue: [
			(GLMPresentationBoundPort new) 
						presentation: self; 
						name: aPortReference portName;
						yourself] 
		ifFalse: [
			(self paneNamed: aPortReference paneName) port: aPortReference portName].! !

!GLMBrowser methodsFor: 'accessing' stamp: 'cyrilledelaunay 3/30/2011 11:56'!
initialExtent: aPoint

	initialExtent := aPoint! !

!GLMBrowser methodsFor: 'scripting' stamp: 'tg 1/18/2010 13:29'!
transmit
	^ self addTransmission: (GLMTransmission new browser: self; yourself)! !

!GLMBrowser methodsFor: 'accessing' stamp: 'TudorGirba 1/18/2011 14:23'!
removeAllPanes
	self panes do: [:each | each unregisterFromAllAnnouncements].
	^ self panes removeAll! !

!GLMBrowser methodsFor: 'updating' stamp: 'TudorGirba 1/7/2011 07:25'!
unregisterFromAllAnnouncements
	super unregisterFromAllAnnouncements.
	self panes do: [:each | 
		each unregisterFromAllAnnouncements ]! !

!GLMBrowser methodsFor: 'enumerating' stamp: 'TudorGirba 7/9/2011 20:03'!
withAllPanesAndPresentationsDo: aBlock
	super withAllPanesAndPresentationsDo: aBlock.
	self panes do: [:each | each withAllPanesAndPresentationsDo: aBlock ]! !

!GLMBrowser methodsFor: 'accessing' stamp: 'tg 3/31/2010 19:33'!
transmissions 
	^ transmissions! !

!GLMBrowser methodsFor: 'initialize-release' stamp: 'TudorGirba 5/20/2012 23:40'!
initialize
	super initialize.
	panes := OrderedCollection new.
	transmissions := OrderedCollection new.
	statusPane := nil.
	watcherPane := nil! !

!GLMBrowser methodsFor: 'accessing' stamp: 'TudorGirba 5/20/2012 23:40'!
watcherPane
	^ watcherPane ifNil: [watcherPane := GLMPane named: #'_watcher']! !

!GLMBrowser methodsFor: 'scripting' stamp: ' 4/5/09 22:18'!
custom: aPresentation 
	 
	self subclassResponsibility! !

!GLMBrowser methodsFor: 'scripting' stamp: 'tg 5/24/2009 19:15'!
initializeScriptingDefaults 
	"Initialize some default behavior if the user did not explcitly script it. 
 
	Subclasses can use this to create a default startup transmission or show 
	a default pane or something like that." 
	
	^self! !

!GLMBrowser methodsFor: 'events' stamp: 'TudorGirba 5/20/2012 22:21'!
outerPortEvent: aPortEvent  
	super outerPortEvent: aPortEvent.	
	aPortEvent hasChanged ifTrue: [
		(self transmissions select: [:each | 
			(each originatesAt: aPortEvent port) and: [
				( aPortEvent transmissionContext includesPort: each destination) not ]]) 
			do: [:each | each transmitIn: aPortEvent transmissionContext copy ]]! !

!GLMBrowser methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 12/18/2013 05:46'!
gtInspectorBrowserIn: composite
	<gtInspectorPresentationOrder: 40>  
	^ (composite wrapper with: [ :w |
		w title: 'Live'.
		w show: [:a | a custom: self copy ] ]
		) startOn: self entity! !

!GLMBrowser methodsFor: 'scripting' stamp: 'TudorGirba 7/15/2011 13:54'!
openOn: anObject with: aRenderer 
	 
	self startOn: anObject. 
	^ self openWith: aRenderer! !

!GLMBrowser methodsFor: 'accessing' stamp: 'tg 3/31/2010 21:55'!
addPane: aPane
	aPane browser: self.
	self panes add: aPane.
	self hasStatusbar ifTrue: [
		self addDefaultStatusbarTransmissionFrom: aPane ].
	^ aPane! !

!GLMBrowser methodsFor: 'accessing' stamp: 'tg 8/22/2010 21:33'!
removeLastPane
	self panes last unregisterFromAllAnnouncements.
	^ self panes removeLast! !

!GLMBrowser methodsFor: 'accessing' stamp: 'cyrilledelaunay 3/30/2011 11:55'!
initialExtent

	^ initialExtent ifNil: [ initialExtent := RealEstateAgent standardWindowExtent]! !

!GLMBrowser methodsFor: 'updating' stamp: 'tg 8/24/2010 21:41'!
update 
	self panes do: [:each | each update ].
	self announce: (GLMPresentationUpdated new presentation: self).! !

!GLMBrowser methodsFor: 'accessing' stamp: 'TudorGirba 4/22/2012 21:56'!
addTransmission: aTransmission 
	aTransmission browser: self.
	^ self transmissions addLast: aTransmission! !

!GLMBrowser methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 7/29/2014 11:01'!
gtInspectorTransmissionsIn: composite
	<gtInspectorPresentationOrder: 35>  
	^ composite list 
		title: 'Transmissions';
		display: [ self transmissions ]! !

!GLMBrowser methodsFor: 'scripting-private' stamp: 'tg 10/25/2010 02:35'!
resolveDestinationPort: aPortReference 
	self flag: 'this is a temporary hack due to initializeScripting transmitting directly a port'.
	(aPortReference isKindOf: GLMPort) ifTrue: [ ^ aPortReference ].
	^self resolvePort: aPortReference asGlamourTargetIdentifier defaultPortName: #entity! !

!GLMBrowser methodsFor: 'scripting-private' stamp: 'tg 10/25/2010 02:21'!
resolveOriginPort: aPortReference 
	 
	^self resolvePort: aPortReference asGlamourOriginIdentifier defaultPortName: #selection! !

!GLMBrowser methodsFor: 'accessing' stamp: 'TudorGirba 5/20/2012 23:18'!
watcherPane: anObject
	watcherPane := anObject ! !

!GLMBrowser methodsFor: 'accessing' stamp: 'tg 1/31/2010 00:26'!
removePane: aPane
	aPane unregisterFromAllAnnouncements.
	self panes remove: aPane! !

!GLMBrowser methodsFor: 'copying' stamp: 'TudorGirba 5/21/2012 00:32'!
postCopy
	| newPane newPanes newPanesMapping newTransmission oldPane oldWatcherPane |
	super postCopy.
	"needed for setting the right panes for the new transmissions"
	newPanesMapping := Dictionary new. 
	newPanes := OrderedCollection new.
	self panes do: [:each | 
		newPane := each copy.
		newPane browser: self.
		newPanes addLast: newPane.
		newPanesMapping at: each put: newPane ].
	oldPane := self pane.
	oldWatcherPane := self watcherPane.
	watcherPane := nil.
	pane := nil.
	newPanesMapping at: oldPane ifAbsentPut: [ self pane ].
	newPanesMapping at: oldWatcherPane ifAbsentPut: [ self watcherPane ].
	self flag: 'we should also copy the values of ports from pane and watcherPane'.
	transmissions := self transmissions collect: [ :each | 
		newTransmission := each copy.
		newTransmission 
			changePortsAccordingToPaneMapping: newPanesMapping 
			fromOldBrowser: nil
			toNewBrowser: self.
		newTransmission ].
	panes := newPanes! !

!GLMBrowser methodsFor: 'scripting' stamp: ' 4/5/09 22:18'!
openOn: anObject 
	 
	^self 
		openOn: anObject 
		with: self defaultRenderer! !

!GLMBrowser methodsFor: 'accessing' stamp: 'tg 3/31/2010 19:45'!
panes
	^ panes ifNil: [	panes := OrderedCollection new ]! !

!GLMBrowser methodsFor: 'scripting' stamp: ' 4/5/09 22:18'!
open 
	 
	^self openWith: self defaultRenderer! !

!GLMBrowser methodsFor: 'scripting' stamp: ' 4/5/09 22:18'!
defaultRenderer 
	 
	^GLMRenderer subclasses first new! !

!GLMBrowser methodsFor: 'accessing' stamp: 'TudorGirba 2/13/2014 19:02'!
lastActivePresentation: aPresentation
	"this hook gets triggered every time, a presentation gets activated in a pane.
	by default the browser does nothing.
	specific browsers could use this hook to provide special behavior"! !

!GLMBrowser methodsFor: 'scripting' stamp: 'TudorGirba 7/15/2011 13:54'!
openWith: aRenderer 
	 
	^ aRenderer open: self! !

!GLMBrowser methodsFor: 'scripting' stamp: 'jorge.ressia 6/2/2009 17:11'!
context

	^OrderedCollection new! !

!GLMBrowser class methodsFor: 'scripting' stamp: 'tg 4/1/2010 07:01'!
withStatusbar
	^ self new addStatusbar! !

!GLMBrowser class methodsFor: 'constants' stamp: 'tg 3/31/2010 19:23'!
defaultStatusbarPane
	^ #'_statusbar'! !

!GLMBrowser class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:02'!
gtExampleBasic
	<gtExample>
	^ GLMWrapper new! !

!GLMBrowserClosed commentStamp: 'TorstenBergmann 3/10/2015 21:58'!
Browser is closed!
!GLMBrowserClosing commentStamp: 'TorstenBergmann 3/10/2015 21:58'!
Browser is closing!
!GLMBrowserTest methodsFor: 'tests' stamp: 'Nicolasanquetil 5/3/2013 15:19'!
testWatcherCopy
	| browser pane transmission browserCopy |
	browser := GLMBrowser new.
	pane := GLMPane named: 'one'.
	browser addPane: pane.
	transmission := GLMTransmission new.
	browser addTransmission: transmission.
	transmission addActiveOrigin: (browser panes first port: #origin).
	transmission toWatcher.
	browserCopy := browser copy.
	self assert: browserCopy transmissions size equals: 1.
	self assert: (browserCopy panes first port: #origin) value equals: nil.
	self assert: (browserCopy watcherPane port: #entity) value equals: nil.
	(browserCopy panes first port: #origin) value: 42.
	browserCopy transmissions first transmit.
	self assert: (browserCopy watcherPane port: #entity) value equals: 42! !

!GLMBrowserTest methodsFor: 'tests' stamp: 'TudorGirba 3/15/2013 22:07'!
testUnregisterAnnouncementsWhenRemovingPane
	| announcer presentation browser pane |
	announcer := Announcer new.
	browser := GLMBrowser new.
	pane := GLMPane new.
	presentation := GLMPresentation new.
	pane addPresentation: presentation.
	browser addPane: pane.
	presentation updateOn: GLMTestAnnouncement from: [ announcer ].
	presentation registerAnnouncements.
	self assert: announcer numberOfSubscriptions equals: 1.
	browser removePane: pane.
	self assert: announcer numberOfSubscriptions equals: 0! !

!GLMBrowserTest methodsFor: 'tests' stamp: 'Nicolasanquetil 5/3/2013 15:19'!
testAddPane
	| browser pane |
	browser := GLMBrowser new.
	self assert: browser panes isEmpty.
	pane := GLMPane new.
	browser addPane: pane.
	self assert: pane browser equals: browser! !

!GLMBrowserTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testStatusbarTransmissions
	| browser pane |
	browser := GLMBrowser new.
	browser addStatusbar.
	pane := GLMPane new.
	browser addPane: pane.
	self assert: browser transmissions size equals: 1.
	self assert: browser transmissions first origins size equals: 1.
	self assert: browser transmissions first origins first equals: (pane port: #status).
	self assert: browser transmissions first destination equals: (browser panes first port: #entity).
	self assert: (browser transmissions first presentations first isKindOf: GLMLabelPresentation)! !

!GLMBrowserTest methodsFor: 'tests' stamp: 'AndreHora 5/9/2013 14:06'!
testWatcherCreation
	| browser |
	browser := GLMBrowser new.
	self assert: browser watcherPane name equals: #'_watcher'.
	(browser watcherPane port: #entity) value: 42.
	self assert: (browser watcherPane port: #entity) value equals: 42! !

!GLMBrowserTest methodsFor: 'tests' stamp: 'Nicolasanquetil 5/3/2013 15:04'!
testAddTransmissions
	| browser transmission |
	browser := GLMBrowser new.
	self assert: browser transmissions isEmpty.
	transmission := GLMTransmission new.
	browser addTransmission: transmission.
	self assert: transmission browser equals: browser! !

!GLMBrowserTest methodsFor: 'tests' stamp: 'TudorGirba 3/15/2013 22:07'!
testUnregisterAnnouncements
	| announcer presentation browser pane |
	announcer := Announcer new.
	browser := GLMBrowser new.
	pane := GLMPane new.
	presentation := GLMPresentation new.
	pane addPresentation: presentation.
	browser addPane: pane.
	presentation updateOn: GLMTestAnnouncement from: [ announcer ].
	presentation registerAnnouncements.
	self assert: announcer numberOfSubscriptions equals: 1.
	browser unregisterFromAllAnnouncements.
	self assert: announcer numberOfSubscriptions equals: 0! !

!GLMBrowserTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testHasStatusbar
	| browser |
	browser := GLMBrowser new.
	self deny: browser hasStatusbar.
	browser hasStatusbar: true.
	self assert: browser panes size equals: 1.
	self assert: browser panes first name equals: GLMBrowser defaultStatusbarPane.
	self assert: browser statusbarPane == browser panes first! !

!GLMBrowserTest methodsFor: 'tests' stamp: 'TudorGirba 8/19/2011 22:47'!
testCompositeInTheParentPane
	| browser |
	browser := GLMBrowser new.
	self assert: (browser pane presentations isKindOf: GLMCompositePresentation).
	self assert: browser pane presentations size equals: 1.
	self assert: browser pane presentations first equals: browser! !

!GLMBrowserTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testStatusbarTransmissionsTriggered
	| browser pane |
	browser := GLMTabulator new.
	browser addStatusbar.
	self assert: browser statusbarPane notNil.
	self assert: browser statusbarPane ~= browser.
	pane := (GLMPane in: browser) name: #one.
	browser addPane: pane.
	self assert: browser transmissions size equals: 1.
	(pane port: #status) value: #test.
	self assert: browser statusbarPane ~= browser.
	self assert: (browser statusbarPane port: #entity) value equals: #test.
	self assert: browser statusbarPane presentations size equals: 1.
	self assert: (browser statusbarPane presentations first isKindOf: GLMLabelPresentation)! !

!GLMBrowserTest methodsFor: 'tests' stamp: 'TudorGirba 3/15/2013 22:07'!
testUnregisterAnnouncementsWhenUpdatingPaneWithTwoAnnouncers
	| announcer browser announcer2 |
	announcer := Announcer new.
	announcer2 := Announcer new.
	browser := GLMTabulator new.
	browser row: #one.
	(browser transmit)
		to: #one;
		andShow: [ :presenter | 
					(presenter list)
						updateOn: GLMTestAnnouncement
							fromAll: [ 
									{announcer.
									nil.
									announcer2} ];
						display: [ :start | start to: 10 ] ].
	browser startOn: 1.
	browser panes first presentations first registerAnnouncements.
	browser unregisterFromAllAnnouncements.
	self assert: announcer numberOfSubscriptions equals: 0.
	self assert: announcer2 numberOfSubscriptions equals: 0! !

!GLMBrowserTest methodsFor: 'tests' stamp: 'TudorGirba 12/5/2011 12:26'!
testUpdateRecomputesMatchingPresentations
	| browser collection matchingPresentationsChangedAnnounced | 
	collection := GLMAnnouncingCollection new.
	collection add: 1.
	browser := GLMTabulator new.
	browser column: #one.
	browser transmit to: #one; andShow: [:a | 
		a list when: [:col | col isEmpty not ]].
	browser startOn: collection.
	matchingPresentationsChangedAnnounced := false.
	browser panes first on: GLMMatchingPresentationsChanged do: [:ann | 
		matchingPresentationsChangedAnnounced := true ].
	collection removeLast.
	browser update.
	self assert: matchingPresentationsChangedAnnounced! !

!GLMBrowserTest methodsFor: 'tests' stamp: 'TudorGirba 3/15/2013 22:07'!
testUnregisterAnnouncementsWhenUpdatingPane
	| announcer browser |
	announcer := Announcer new.
	browser := GLMTabulator new.
	browser row: #one.
	(browser transmit)
		to: #one;
		andShow: [ :presenter | 
					(presenter list)
						updateOn: GLMTestAnnouncement from: [ announcer ];
						display: [ :start | start to: 10 ] ].
	browser startOn: 1.
	browser panes first presentations first registerAnnouncements.
	browser unregisterFromAllAnnouncements.
	self assert: announcer numberOfSubscriptions equals: 0! !

!GLMBrowserTest methodsFor: 'tests' stamp: 'Nicolasanquetil 5/3/2013 15:13'!
testTransmissionTriggeredAnnounced
	| browser announcements pane1 pane2 transmission |
	announcements := OrderedCollection new.
	browser := GLMBrowser new.
	pane1 := GLMPane new.
	pane2 := GLMPane new.
	browser addPane: pane1.
	browser addPane: pane2.
	transmission := GLMTransmission new.
	transmission addActiveOrigin: (pane1 port: #origin).
	transmission destination: (pane2 port: #destination).
	browser addTransmission: transmission.
	browser
		on: GLMTransmissionTriggered
		do: [ :ann | announcements add: ann ].
	self assert: announcements isEmpty.
	transmission transmit.
	self assert: announcements size equals: 1! !

!GLMBrowserWithoutBlocksExample commentStamp: '<historical>'!
self openOn: 42!
!GLMBrowserWithoutBlocksExample methodsFor: 'as yet unclassified' stamp: 'TudorGirba 9/25/2013 06:52'!
displayList: aNumber
	^ 1 to: aNumber! !

!GLMBrowserWithoutBlocksExample methodsFor: 'as yet unclassified' stamp: 'TudorGirba 9/25/2013 06:54'!
compose
	| wrapper |
	wrapper := self wrapper.
	wrapper show: [ :a |
		a list 
			display: (MessageSend receiver: self selector: #displayList:) ]! !

!GLMBundleTransmissionTest methodsFor: 'tests' stamp: 'tg 1/14/2010 16:51'!
testTriggerConditionsWithParentPort 
	 
	| transmission presentation | 
	transmission := GLMTransmission new. 
	presentation := GLMPresentation new. 
	transmission 
		addActiveOrigin: 
			((GLMPresentationBoundPort new) 
				presentation: presentation; 
				name: #port1; 
				yourself). 
	self 
		assert: 
			(transmission 
				originatesAt: 
					((GLMPresentationBoundPort new) 
						presentation: presentation; 
						name: #port1; 
						yourself)). 
	self assert: (transmission originatesAt: (presentation pane port: #port1))! !

!GLMBundleTransmissionTest methodsFor: 'tests' stamp: 'tg 1/14/2010 16:40'!
testCopy
	| transmission newTransmission | 
	transmission := GLMTransmission new. 
	transmission addActiveOrigin: ((GLMSimplePort new) name: #port1; value: 1). 
	transmission addPassiveOrigin: ((GLMSimplePort new) name: #port2; value: 2). 
	transmission addActiveOrigin: ((GLMSimplePort new) name: #port3; value: 3). 
	transmission addPassiveOrigin: ((GLMSimplePort new) name: #port4; value: 4). 
	transmission destination: (GLMSimplePort new name: #port5). 

	newTransmission := transmission copy.
	
	self assert: transmission originReferences first ~= newTransmission originReferences first.! !

!GLMBundleTransmissionTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPorts
	"Tests that the origins are set up properly and that their order is retained."

	| transmission |
	transmission := GLMTransmission new.
	transmission
		addActiveOrigin:
			((GLMSimplePort new)
				name: #port1;
				value: 1).
	transmission
		addPassiveOrigin:
			((GLMSimplePort new)
				name: #port2;
				value: 2).
	transmission
		addActiveOrigin:
			((GLMSimplePort new)
				name: #port3;
				value: 3).
	transmission
		addPassiveOrigin:
			((GLMSimplePort new)
				name: #port4;
				value: 4).
	transmission destination: (GLMSimplePort new name: #port5).
	self assert: transmission originReferences size equals: 4.
	transmission originReferences do: [ :each | self assert: (each isKindOf: GLMOriginPortReference) ].
	self assert: (transmission originReferences at: 1) port name equals: #port1.
	self assert: (transmission originReferences at: 2) port name equals: #port2.
	self assert: (transmission originReferences at: 3) port name equals: #port3.
	self assert: (transmission originReferences at: 4) port name equals: #port4.
	self assert: transmission origins size equals: 4.
	transmission origins do: [ :each | self assert: (each isKindOf: GLMSimplePort) ].
	self assert: (transmission origins at: 1) name equals: #port1.
	self assert: (transmission origins at: 2) name equals: #port2.
	self assert: (transmission origins at: 3) name equals: #port3.
	self assert: (transmission origins at: 4) name equals: #port4.
	self assert: transmission activeOrigins size equals: 2.
	transmission activeOrigins do: [ :each | self assert: (each isKindOf: GLMSimplePort) ].
	self assert: (transmission activeOrigins at: 1) name equals: #port1.
	self assert: (transmission activeOrigins at: 2) name equals: #port3.
	self assert: transmission passiveOrigins size equals: 2.
	transmission passiveOrigins do: [ :each | self assert: (each isKindOf: GLMSimplePort) ].
	self assert: (transmission passiveOrigins at: 1) name equals: #port2.
	self assert: (transmission passiveOrigins at: 2) name equals: #port4.
	self assert: (transmission destination isKindOf: GLMSimplePort).
	self assert: transmission destination name equals: #port5! !

!GLMBundleTransmissionTest methodsFor: 'tests' stamp: 'tg 1/31/2010 01:40'!
testTriggerConditions 
	"Tests that the transmission is triggered only when the active origins change." 
	 
	| transmission port1 port2 | 
	transmission := GLMTransmission new. 
	port1 := GLMSimplePort new name: #port1. 
	port2 := GLMSimplePort new name: #port2. 
	transmission addActiveOrigin: port1. 
	transmission addPassiveOrigin: port2. 
	transmission destination: (GLMPort new name: #port3). 
	self assert: (transmission originatesAt: port1). 
	self assert: (transmission originatesAt: port2) not! !

!GLMBundleTransmissionTest methodsFor: 'tests' stamp: 'AndreiChis 5/30/2013 22:17'!
testPresentations
	"Tests that the presentations are set up correctly."

	| transmission presentation1 presentation2 presentation3 |
	transmission := GLMTransmission new ensureReplacePresentationsStrategy.
	transmission
		addActiveOrigin:
			((GLMSimplePort new)
				name: #port1;
				value: 1).
	transmission
		addPassiveOrigin:
			((GLMSimplePort new)
				name: #port2;
				value: 2).
	transmission destination: (GLMSimplePort new name: #port3).
	presentation1 := GLMPresentation new title: 'presentation1'.
	presentation2 := GLMPresentation new title: 'presentation2'.
	presentation3 := GLMPresentation new title: 'presentation3'.
	transmission transmissionStrategy addPresentation: presentation1.
	transmission transmissionStrategy addPresentation: presentation2.
	transmission transmissionStrategy addPresentation: presentation3.	"Test correct setup"
	self assert: transmission transmissionStrategy presentations size equals: 3.
	self assert: (transmission transmissionStrategy presentations at: 1) title = presentation1 title.
	self assert: (transmission transmissionStrategy presentations at: 2) title = presentation2 title.
	self assert: (transmission transmissionStrategy presentations at: 3) title = presentation3 title.
	self assert: (transmission transmissionStrategy presentations at: 1) ~~ presentation1.
	self assert: (transmission transmissionStrategy presentations at: 2) ~~ presentation2.
	self assert: (transmission transmissionStrategy presentations at: 3) ~~ presentation3! !

!GLMBundleTransmissionTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testTransmitting
	"Tests that the origins are set up properly and that their order is retained."

	| transmission |
	transmission := GLMTransmission new.
	transmission
		addActiveOrigin:
			((GLMSimplePort new)
				name: #port1;
				value: 1).
	transmission destination: (GLMSimplePort new name: #port5).
	self assert: transmission value equals: 1.
	self assert: transmission destination value isNil.
	transmission transmit.
	self assert: transmission destination value equals: 1.
	transmission
		addPassiveOrigin:
			((GLMSimplePort new)
				name: #port2;
				value: 2).
	transmission
		addActiveOrigin:
			((GLMSimplePort new)
				name: #port3;
				value: 3).
	transmission
		addPassiveOrigin:
			((GLMSimplePort new)
				name: #port4;
				value: 4).
	self assert: transmission value equals: (GLMMultiValue withAll: #(1 2 3 4)).
	transmission transmit.
	self assert: transmission destination value equals: (GLMMultiValue withAll: #(1 2 3 4))! !

!GLMButtonBrick commentStamp: 'AliakseiSyrel 3/22/2015 12:11'!
A GLMButtonBrick is a basic  button with label and icon to the left of the label

Instance Variables
	iconBrick:		<GLMInteractableBrick>
	labelBrick:		<GLMLabelBrick>

iconBrick
	- an icon to be displayed to the left of the label

labelBrick
	- label showing button text
!
!GLMButtonBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 2/25/2015 21:20'!
hShrinkWrap
	super hShrinkWrap.
	
	self label hShrinkWrap! !

!GLMButtonBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 2/25/2015 21:21'!
vShrinkWrap
	super vShrinkWrap.
	
	self label vShrinkWrap! !

!GLMButtonBrick methodsFor: 'brick-interactable-actions' stamp: 'AliakseiSyrel 2/26/2015 23:07'!
click: evt

	super click: evt.
	^ true! !

!GLMButtonBrick methodsFor: 'brick-properties-events' stamp: 'AliakseiSyrel 2/25/2015 21:08'!
onThemerChanged
	super onThemerChanged.

	self updateStyle! !

!GLMButtonBrick methodsFor: 'button-brick-creation' stamp: 'AliakseiSyrel 2/25/2015 21:16'!
newLabelBrick

	^ GLMLabelBrick new! !

!GLMButtonBrick methodsFor: 'button-brick-accessing' stamp: 'AliakseiSyrel 3/22/2015 12:41'!
labelBrick: anObject
	labelBrick := anObject.
	
	self label
		vShrinkWrap;
		hShrinkWrap;
		text: 'button';
		textPosition: #center;
		vAlign: #center;
		hAlign: #center.
	
	self addBrickBack: self label! !

!GLMButtonBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 3/27/2015 01:15'!
hSpaceFill: anInteger
	super hSpaceFill: anInteger.
	
	self label hSpaceFill.! !

!GLMButtonBrick methodsFor: 'button-brick-accessing' stamp: 'AliakseiSyrel 3/19/2015 13:28'!
iconBrick: anObject

	iconBrick := anObject! !

!GLMButtonBrick methodsFor: 'button-properties' stamp: 'AliakseiSyrel 3/22/2015 11:30'!
text: aString
	"changes button text, redraws and updates button bounds"
	self label text: aString! !

!GLMButtonBrick methodsFor: 'button-properties' stamp: 'AliakseiSyrel 2/25/2015 21:51'!
text

	^ self label text! !

!GLMButtonBrick methodsFor: 'button-updating' stamp: 'AliakseiSyrel 2/25/2015 21:24'!
updateStyle

	self borderWidth: self themer buttonBorderWidth.
	self borderColor: self themer buttonBorderColor.
	self padding: self themer buttonPadding.
	self normalColor: self themer buttonBackgroundColor.
	self selectedColor: self themer buttonSelectedColor.
	self pressedColor: self themer buttonPressedColor.
	self minWidth: self themer buttonMinWidth.
	self minHeight: self themer buttonMinHeight.
	self doLayoutForce
	! !

!GLMButtonBrick methodsFor: 'button-brick-accessing' stamp: 'AliakseiSyrel 2/26/2015 01:02'!
iconBrick

	^ iconBrick! !

!GLMButtonBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/25/2015 21:16'!
initialize
	super initialize.
	
	self
		enable;
		labelBrick: self newLabelBrick;
		hShrinkWrap;
		vShrinkWrap! !

!GLMButtonBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 3/27/2015 01:15'!
vSpaceFill: anInteger
	super vSpaceFill: anInteger.
	
	self label vSpaceFill.! !

!GLMButtonBrick methodsFor: 'button-brick-accessing' stamp: 'AliakseiSyrel 2/25/2015 21:13'!
label

	^ labelBrick! !

!GLMButtonBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:28'!
exampleOpen

	self gtExample openCenteredInBrickWindow! !

!GLMButtonBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:28'!
gtExample
	<gtExample: 'Simple button'>
	^ self new! !

!GLMButtonModel methodsFor: 'accessing' stamp: 'tg 11/8/2009 21:24'!
glamourAction: anObject
	glamourAction := anObject! !

!GLMButtonModel methodsFor: 'accessing' stamp: 'tg 11/8/2009 21:24'!
glamourAction
	^ glamourAction! !

!GLMButtonModel methodsFor: 'actions' stamp: 'tg 11/8/2009 21:25'!
buttonLabel
	^ self glamourAction title! !

!GLMButtonModel methodsFor: 'actions' stamp: 'tg 11/8/2009 21:35'!
execute
	self glamourAction actOn: self glamourPresentation! !

!GLMCheckboxBrick commentStamp: 'AliakseiSyrel 3/18/2015 17:11'!
A GLMCheckboxBrick is very simple checkbox with label support. If label text is set it becomes clickable too.

Instance Variables
	checkBrick:		<GLMInteractableBrick>
	labelBrick:		<GLMLabelBrick>

checkBrick
	- checkbox itself

labelBrick
	- label position to the right from checkbox
!
!GLMCheckboxBrick methodsFor: 'checkbox-brick-creation' stamp: 'AliakseiSyrel 2/25/2015 16:44'!
newCheckboxBrick

	^ GLMInteractableBrick new! !

!GLMCheckboxBrick methodsFor: 'checkbox-scripting' stamp: 'AliakseiSyrel 2/26/2015 20:52'!
id: anObejct

	id := anObejct! !

!GLMCheckboxBrick methodsFor: 'brick-interactable-actions' stamp: 'AliakseiSyrel 2/25/2015 16:46'!
deselect: anEvent
	super deselect: anEvent.
	self box deselect: anEvent.
	self label deselect: anEvent! !

!GLMCheckboxBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 2/25/2015 17:05'!
vShrinkWrap
	super vShrinkWrap.
	
	self label vShrinkWrap! !

!GLMCheckboxBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 2/25/2015 17:05'!
hShrinkWrap
	super hShrinkWrap.
	
	self label hShrinkWrap! !

!GLMCheckboxBrick methodsFor: 'brick-interactable-actions' stamp: 'AliakseiSyrel 2/25/2015 16:45'!
click: evt

	self toggle.
	^ true! !

!GLMCheckboxBrick methodsFor: 'checkbox-brick-accessing' stamp: 'JurajKubelka 2/28/2015 18:49'!
checkBrick: anObject
	checkBrick := anObject.
	self box
		borderColor: self themer checkboxBorderColor;
		borderWidth: self themer checkboxBorderWidth;
		vAlign: #center;
		checkedImage: self themer checkboxCheckedImage;
		width: self themer checkboxWidth;
		height: self themer checkboxHeight.
		
	self addBrickFirst: self box! !

!GLMCheckboxBrick methodsFor: 'checkbox-brick-creation' stamp: 'AliakseiSyrel 2/25/2015 16:45'!
newLabelBrick

	^ GLMLabelBrick new! !

!GLMCheckboxBrick methodsFor: 'brick-interactable-actions' stamp: 'AliakseiSyrel 2/25/2015 17:00'!
check
	self box check.
	self label check.
	super check! !

!GLMCheckboxBrick methodsFor: 'checkbox-brick-accessing' stamp: 'AliakseiSyrel 2/25/2015 16:40'!
box

	^ checkBrick! !

!GLMCheckboxBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 3/27/2015 01:16'!
hSpaceFill: anInteger
	super hSpaceFill: anInteger.
	
	self label hSpaceFill! !

!GLMCheckboxBrick methodsFor: 'checkbox-accessing' stamp: 'JurajKubelka 2/27/2015 12:13'!
action: aBlockClosure 
	"aBlockClosure can receive as the first argument aBoolean, as the second argument this object."
	self 
		when: #onChecked 
			do: [ :anAnnouncement :anAnnouncer | 
					aBlockClosure cull: true cull: self cull: anAnnouncement cull: anAnnouncer ];
		when: #onUnchecked
			do: [ :anAnnouncement :anAnnouncer | 
					aBlockClosure cull: false cull: self cull: anAnnouncement cull: anAnnouncer ]! !

!GLMCheckboxBrick methodsFor: 'checkbox-scripting' stamp: 'AliakseiSyrel 2/26/2015 00:07'!
text: aString

	self label text: aString.
	self label text isEmpty
			ifTrue: [ self removeBrick: self label ]
			ifFalse: [ (self hasSubbrick: self label)
				ifFalse: [ self addBrickBack: self label ] ].
	self doLayoutForce! !

!GLMCheckboxBrick methodsFor: 'checkbox-brick-accessing' stamp: 'AliakseiSyrel 2/25/2015 18:22'!
labelBrick: anObject
	labelBrick := anObject.
	
	labelBrick
		vAlign: #center;
		marginLeft: 5;
		textPosition: #leftCenter.! !

!GLMCheckboxBrick methodsFor: 'checkbox-accessing' stamp: 'AliakseiSyrel 2/26/2015 20:52'!
id

	^ id ifNil: [ self ]! !

!GLMCheckboxBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/25/2015 20:24'!
initialize
	super initialize.
	
	self
		checkBrick: self newCheckboxBrick;
		labelBrick: self newLabelBrick;
		useHorizontalLinearLayout;
		vShrinkWrap;
		hShrinkWrap;
		enable! !

!GLMCheckboxBrick methodsFor: 'brick-interactable-actions' stamp: 'AliakseiSyrel 2/25/2015 16:46'!
select: anEvent
	super select: anEvent.
	self box select: anEvent.
	self label select: anEvent! !

!GLMCheckboxBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 3/27/2015 01:15'!
vSpaceFill: anInteger
	super vSpaceFill: anInteger.
	
	self label vSpaceFill.! !

!GLMCheckboxBrick methodsFor: 'checkbox-brick-accessing' stamp: 'AliakseiSyrel 2/25/2015 16:39'!
label

	^ labelBrick! !

!GLMCheckboxBrick methodsFor: 'brick-interactable-actions' stamp: 'AliakseiSyrel 2/25/2015 17:00'!
uncheck
	self box uncheck.
	self label uncheck.
	super uncheck! !

!GLMCheckboxBrick methodsFor: 'checkbox-actions' stamp: 'AliakseiSyrel 2/25/2015 16:58'!
toggle

	self isChecked
		ifTrue: [ self uncheck ]
		ifFalse: [ self check ]! !

!GLMCheckboxBrick methodsFor: 'brick-structure-converting' stamp: 'AliakseiSyrel 2/26/2015 21:59'!
asFormValue

	^ self id -> self isChecked! !

!GLMCheckboxBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:29'!
gtExample
	<gtExample: 'Checkbox without label'>
	^ self new! !

!GLMCheckboxBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:29'!
gtExampleWithLabel
	<gtExample: 'Checkbox with label'>
	^ self new
		text: 'I''m label, click me';
		action: [ :boolean | self inform: 'Checkbox set to ', boolean asString ];
		yourself! !

!GLMCheckboxBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:29'!
exampleWithLabelOpen

	self gtExampleWithLabel openCenteredInBrickWindow! !

!GLMCheckboxBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:29'!
exampleOpen

	self gtExample openCenteredInBrickWindow! !

!GLMCollapsableBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/12/2015 16:57'!
contentBrick: aBrick
	contentBrick := aBrick.
	
	self contentBrick
		hSpaceFill;
		vShrinkWrap! !

!GLMCollapsableBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/12/2015 17:09'!
initialize
	super initialize.
	
	self
		useVerticalLinearLayout;
		vShrinkWrap! !

!GLMCollapsableBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/12/2015 16:55'!
contentBrick
	^ contentBrick! !

!GLMCollapsableBrick methodsFor: 'actions' stamp: 'AliakseiSyrel 2/12/2015 17:24'!
toggle

	self isExpanded
		ifTrue: [ self collapse ]
		ifFalse: [ self expand ]! !

!GLMCollapsableBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/12/2015 16:55'!
headerBrick
	^ headerBrick! !

!GLMCollapsableBrick methodsFor: 'actions' stamp: 'AliakseiSyrel 2/12/2015 17:08'!
expand

	self contentBrick ifNil: [ ^ self ].

	self isExpanded
		ifFalse: [ self addBrickBack: self contentBrick ]! !

!GLMCollapsableBrick methodsFor: 'actions' stamp: 'AliakseiSyrel 2/12/2015 17:08'!
collapse

	self contentBrick ifNil: [ ^ self ].

	self isExpanded
		ifTrue: [ self removeBrick: self contentBrick ]! !

!GLMCollapsableBrick methodsFor: 'testing' stamp: 'AliakseiSyrel 2/12/2015 16:59'!
isExpanded

	^ self hasSubbrick: self contentBrick! !

!GLMCollapsableBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/12/2015 17:07'!
headerBrick: aBrick
	headerBrick := aBrick.
	
	self headerBrick hSpaceFill.
	
	self addBrickFirst: self headerBrick! !

!GLMCollapsableBrick class methodsFor: 'instance creation' stamp: 'AliakseiSyrel 2/12/2015 17:31'!
createCollapsableArray: anInteger

	^ (1 to: anInteger) collect: [ :index | self createCollapsable hSpaceFill  ]! !

!GLMCollapsableBrick class methodsFor: 'instance creation' stamp: 'AliakseiSyrel 3/22/2015 11:52'!
createCollapsable

	^ self new
		with: [ :collapsable | 
			collapsable headerBrick:
				(GLMBrick new
					addBrickBack:
						(GLMActionButtonBrick new
							icon: GLMUIThemeExtraIcons glamorousRight;
							marginLeft: 10;
							height: [ :b | b icon height * 1.2 ];
							width: [ :b | b icon width * 1.2 ];
							checkedImage: GLMUIThemeExtraIcons glamorousDown;
							action: [ :b | 
								collapsable toggle.
								collapsable isExpanded
									ifTrue: [ b check ]
									ifFalse: [ b uncheck ] ]);
					addBrickBack:
						(GLMLabelBrick new
							marginLeft: 10;
							text: 'Header';
							hSpaceFill;
							height: [ :b | b approximateHeight ]);
					vShrinkWrap;
					hSpaceFill) ];
		contentBrick:
			(GLMBrick new
				useVerticalLinearLayout;
				hSpaceFill;
				addAllBricks: {
					(GLMBrick new color: Color random; hSpaceFill).
					(GLMBrick new color: Color random; hSpaceFill).
					(GLMBrick new color: Color random; hSpaceFill).
					(GLMBrick new color: Color random; hSpaceFill)};
				yourself)! !

!GLMCollapsableBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:31'!
gtExample
	<gtExample: 'Very simple one collapsable item'>
	^ self createCollapsable
		hSpaceFill;
		vShrinkWrap! !

!GLMCollapsableBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:32'!
exampleOpen
	
	self gtExample openInBrickWindowLabeled: 'Collapsable Example'! !

!GLMCompileText commentStamp: 'AndreiChis 5/6/2014 17:53'!
I am event indicating to the renderer to compile the code of the given presentation.!
!GLMCompileText methodsFor: 'accessing' stamp: 'AndreiChis 5/6/2014 17:40'!
context: anObject
	
	context := anObject! !

!GLMCompileText methodsFor: 'accessing' stamp: 'AndreiChis 5/6/2014 17:40'!
session: anObject
	
	session := anObject! !

!GLMCompileText methodsFor: 'accessing' stamp: 'AndreiChis 7/7/2014 10:04'!
action

	^ action! !

!GLMCompileText methodsFor: 'accessing' stamp: 'AndreiChis 5/6/2014 17:40'!
session
	
	^ session! !

!GLMCompileText methodsFor: 'accessing' stamp: 'AndreiChis 7/7/2014 10:04'!
action: aBlock

	action := aBlock! !

!GLMCompileText methodsFor: 'accessing' stamp: 'AndreiChis 5/6/2014 17:44'!
presentation: anObject

	presentation := anObject! !

!GLMCompileText methodsFor: 'accessing' stamp: 'AndreiChis 5/6/2014 17:40'!
context
	
	^ context! !

!GLMCompileText methodsFor: 'accessing' stamp: 'AndreiChis 5/6/2014 17:44'!
presentation

	^ presentation! !

!GLMCompositeArrangement commentStamp: 'tg 1/6/2010 23:12'!
This is a strategy to capture the intended arrangement of multiple presentations of a composite presentation. The subclasses define the actual arrangement.!
!GLMCompositeArrangement methodsFor: 'accessing' stamp: 'tg 1/6/2010 23:13'!
composite
	^ composite! !

!GLMCompositeArrangement methodsFor: 'accessing' stamp: 'tg 1/6/2010 23:13'!
composite: anObject
	composite := anObject! !

!GLMCompositeArrangement methodsFor: 'rendering' stamp: 'tg 1/6/2010 23:16'!
renderGlamorouslyOn: aRenderer
	self subclassResponsibility! !

!GLMCompositeArrangement class methodsFor: 'instance creation' stamp: 'tg 1/6/2010 23:14'!
of: aCompositePresentation
	^ self new composite: aCompositePresentation; yourself! !

!GLMCompositeBrick commentStamp: 'AliakseiSyrel 1/30/2015 10:13'!
I'm a composite brick that provides an api of creating different kind of scriptabe presentations like: 
 - list
 - pharoMethod
 - table
 - tree!
!GLMCompositeBrick methodsFor: 'phlow' stamp: 'AliakseiSyrel 1/30/2015 10:10'!
pharoMethod

	^ self custom: GLMPhlowPharoMethodBrick new! !

!GLMCompositeBrick methodsFor: 'phlow' stamp: 'AliakseiSyrel 1/11/2015 14:34'!
tree! !

!GLMCompositeBrick methodsFor: 'phlow' stamp: 'AliakseiSyrel 1/30/2015 10:10'!
table

	^ self custom: GLMPhlowTableBrick new! !

!GLMCompositeBrick methodsFor: 'phlow' stamp: 'AliakseiSyrel 1/30/2015 10:09'!
list

	^ self custom: GLMPhlowListBrick new! !

!GLMCompositeBrick methodsFor: 'phlow' stamp: 'TudorGirba 1/28/2015 21:26'!
custom: aBrick
	self flag: 'for now we only allow one subbrick in the composite.
	We have to revisit this implementation after the composite will allow for multiple subbricks'.
	self hasSubbricks ifFalse: [ self addBrickBack: aBrick ].
	^ aBrick! !

!GLMCompositeBrick methodsFor: 'phlow' stamp: 'TudorGirba 2/4/2015 13:39'!
text

	^ self custom: GLMPhlowTextBrick new! !

!GLMCompositeBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:30'!
examplePharoMethodOpen
	
	self gtExamplePharoMethod openInBrickWindowLabeled: 'Phlow Pharo method'! !

!GLMCompositeBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:30'!
gtExampleList
	<gtExample: 'Phlow simple list'>

	^ self new
		hSpaceFill;
		vSpaceFill;
		with: [ :b |
			b list
				title: 'Example';
				display: [ :x | x + 3 ];
				format: [ :anInteger | anInteger asString, ')' ];
				entity: (1 to: 100) ]! !

!GLMCompositeBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:30'!
gtExamplePharoMethod
	<gtExample: 'Phlow Pharo method'>

	^ self new
		hSpaceFill;
		vSpaceFill;
		with: [ :b |
			b pharoMethod
				title: #printString;
				display: #getSource;
				smalltalkClass: #methodClass;
				entity: Morph>>#bounds ]! !

!GLMCompositeBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:30'!
gtExampleTable
	<gtExample: 'Phlowr table'>
	
	^ self new
		hSpaceFill;
		vSpaceFill;
		with: [ :b |
			b table
				title: #asString;
				display: [ :anObject | (anObject gtInspectorVariableValuePairs asSortedCollection asOrderedCollection yourself) addFirst: 'self' -> anObject; yourself ];
				column: 'Variable'
					evaluated: [:assoc |	GTObjectPrinter new asNonTruncatedTextFrom: assoc key ]
					styled: [ :aBrick | aBrick textPosition: #rightCenter; margin: #(0 15 0 0); textColor: Color lightGray ];
				column: 'Variable'
					evaluated: [:assoc | GTObjectPrinter new asTruncatedTextFrom: assoc value ]
					styled: [ :aBrick | aBrick margin: #(0 0 0 15) ];
				entity: Morph new ]! !

!GLMCompositeBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:30'!
exampleListOpen
	
	self gtExampleList openInBrickWindow! !

!GLMCompositeBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:30'!
gtExampleListClassMethods
	<gtExample: 'Phlow list displaying all methods of an object '>

	^ self new
		hSpaceFill;
		vSpaceFill;
		with: [ :b |
			b list
			title: 'Methods of Object';
			display: #yourself;
			format: [ :compiledMethod | compiledMethod gtDisplayString ];
			styled: [ :brick | brick height: 30 ];
			entity: Object methods ]! !

!GLMCompositeBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:30'!
exampleTableOpen

	self gtExampleTable openInBrickWindowLabeled: 'Phlowr table'! !

!GLMCompositeBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:30'!
exampleListClassMethodsOpen
	
	self gtExampleListClassMethods openInBrickWindow! !

!GLMCompositeBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:30'!
exampleListWithCustomItemsOpen
	
	self gtExampleListWithCustomItems openInBrickWindowLabeled: 'Phlow list with custom item'! !

!GLMCompositeBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:30'!
gtExampleListWithCustomItems
	<gtExample: 'Phlow list with custom items'>

	^ self new
		hSpaceFill;
		vSpaceFill;
		with: [ :b |
			b list
				title: 'Example with custom items';
				display: [ :x | x + 3 ];
				format: [ :anInteger | anInteger asString ];
				styled: [ :aBrick | aBrick textPosition: #center; textColor: Color random ];
				entity: (1 to: 100) ]! !

!GLMCompositePresentation commentStamp: 'tg 2/20/2010 14:51'!
A composite presentation offers means to control the composition of multiple presentations by providing the arrangement of these presentations.!
!GLMCompositePresentation methodsFor: 'accessing' stamp: 'tg 1/5/2010 16:28'!
last
	^ self presentations last! !

!GLMCompositePresentation methodsFor: 'announcements' stamp: 'tg 1/30/2010 23:31'!
resetAnnouncer
	super resetAnnouncer.
	self presentations do: [:each | each resetAnnouncer ]! !

!GLMCompositePresentation methodsFor: 'scripting' stamp: 'TudorGirba 1/2/2012 01:15'!
dynamic
	^ self custom: GLMDynamicPresentation new! !

!GLMCompositePresentation methodsFor: 'scripting' stamp: 'TudorGirba 1/2/2012 01:15'!
morph
	^ self custom: GLMMorphPresentation new! !

!GLMCompositePresentation methodsFor: 'initialize-release' stamp: 'TudorGirba 9/9/2012 00:54'!
initialize 
	super initialize.
	self compose! !

!GLMCompositePresentation methodsFor: 'scripting' stamp: 'tg 1/14/2010 17:21'!
tabbedArrangement
	^ self arrangement: GLMTabbedArrangement new! !

!GLMCompositePresentation methodsFor: 'scripting' stamp: 'AndreiChis 5/24/2013 11:40'!
custom: aPresentation
	^ self add: (aPresentation sourceContext: thisContext sender)! !

!GLMCompositePresentation methodsFor: 'events' stamp: 'AndreiChis 11/15/2012 14:24'!
outerPortEvent: aPortEvent
	super outerPortEvent: aPortEvent.
	self do: [:each| each outerPortEvent: aPortEvent]! !

!GLMCompositePresentation methodsFor: 'accessing' stamp: 'AndreiChis 1/15/2015 16:28'!
second
	^ self presentations second! !

!GLMCompositePresentation methodsFor: 'scripting' stamp: 'TudorGirba 1/2/2012 01:15'!
tabulator
	^ self custom: GLMTabulator new! !

!GLMCompositePresentation methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 12/18/2013 05:46'!
gtInspectorBrowserIn: composite
	<gtInspectorPresentationOrder: 40>  
	^ (composite wrapper with: [ :w |
		w title: 'Live'.
		w show: [:a | a custom: self copy ] ]
		) startOn: self entity! !

!GLMCompositePresentation methodsFor: 'scripting opening' stamp: 'TudorGirba 10/7/2011 20:16'!
openOn: anObject with: aRenderer 
	 
	self startOn: anObject. 
	^ self openWith: aRenderer! !

!GLMCompositePresentation methodsFor: 'scripting' stamp: 'TudorGirba 1/2/2012 01:15'!
list 
	^ self custom: GLMListPresentation new! !

!GLMCompositePresentation methodsFor: 'updating' stamp: 'tg 8/24/2010 21:41'!
update
	self pane ports do: [:each |
		(self validate: each value on: each) ifFalse: [each resetValue] ].
	self presentations do: [ :each | each update ].
	self announce: (GLMPresentationUpdated new presentation: self).! !

!GLMCompositePresentation methodsFor: 'scripting' stamp: 'TudorGirba 1/2/2012 01:15'!
smalltalkCode
	^ self custom: GLMSmalltalkCodePresentation new! !

!GLMCompositePresentation methodsFor: 'accessing' stamp: 'tg 1/5/2010 15:17'!
isEmpty
	^ self presentations isEmpty! !

!GLMCompositePresentation methodsFor: 'accessing' stamp: 'tg 12/16/2009 17:45'!
presentations
	^ presentations ifNil: [presentations := OrderedCollection new]! !

!GLMCompositePresentation methodsFor: 'scripting' stamp: 'TudorGirba 1/2/2012 01:15'!
tree 
	^ self custom: GLMTreePresentation new! !

!GLMCompositePresentation methodsFor: 'comparison' stamp: 'TudorGirba 7/10/2011 13:08'!
postCopy
	super postCopy.
	presentations ifNotNil: [ :arg | 
		presentations := presentations collect: [ :each | each copy ] ].
	arrangement ifNotNil: [ :arg | 
		arrangement := arrangement copy.
		arrangement composite: self ]! !

!GLMCompositePresentation methodsFor: 'scripting opening' stamp: 'TudorGirba 10/7/2011 20:16'!
openOn: anObject 
	 
	^self 
		openOn: anObject 
		with: self defaultRenderer! !

!GLMCompositePresentation methodsFor: 'accessing' stamp: 'tg 1/5/2010 16:16'!
collect: aBlock
	^ self copy presentations: (self presentations collect: aBlock ); yourself! !

!GLMCompositePresentation methodsFor: 'scripting opening' stamp: 'TudorGirba 10/7/2011 20:16'!
open 
	 
	^self openWith: self defaultRenderer! !

!GLMCompositePresentation methodsFor: '*Glamour-Morphic-Pager' stamp: 'AliakseiSyrel 6/29/2014 00:59'!
pager
	^ self custom: GLMPager new! !

!GLMCompositePresentation methodsFor: 'scripting' stamp: 'TudorGirba 4/3/2013 17:02'!
spec
	^ self custom: GLMSpecPresentation new! !

!GLMCompositePresentation methodsFor: '*glamour-rubric-presentations' stamp: 'TudorGirba 3/25/2014 15:03'!
pharoPlayground
	^ self custom: GLMPharoPlaygroundPresentation new! !

!GLMCompositePresentation methodsFor: 'initialize-release' stamp: 'AndreiChis 6/23/2013 21:39'!
initializePresentation

	super initializePresentation.
	self do: [:each| each initializePresentation]! !

!GLMCompositePresentation methodsFor: 'scripting' stamp: 'tg 1/12/2010 14:37'!
verticallyStackedArrangement
	^ self stackedVerticallyArrangement! !

!GLMCompositePresentation methodsFor: 'scripting opening' stamp: 'TudorGirba 10/7/2011 20:16'!
startOn: anObject 
	
	self entity: anObject! !

!GLMCompositePresentation methodsFor: 'scripting' stamp: 'TudorGirba 1/2/2012 01:15'!
dropDownList
	^ self custom: GLMDropDownListPresentation new! !

!GLMCompositePresentation methodsFor: 'accessing' stamp: 'tg 1/5/2010 21:09'!
matchingPresentations
	^ self presentations select: [:each | each matches]! !

!GLMCompositePresentation methodsFor: 'accessing' stamp: 'tg 1/5/2010 16:05'!
first
	^ self presentations first! !

!GLMCompositePresentation methodsFor: '*glamour-rubric-presentations' stamp: 'TudorGirba 3/25/2014 15:02'!
pharoMethod
	^ self custom: GLMPharoMethodPresentation new! !

!GLMCompositePresentation methodsFor: 'scripting' stamp: 'tg 1/14/2010 02:56'!
stackedArrangement
	^ self stackedVerticallyArrangement! !

!GLMCompositePresentation methodsFor: 'scripting' stamp: 'TudorGirba 1/2/2012 01:15'!
text 
	^ self custom: GLMTextPresentation new! !

!GLMCompositePresentation methodsFor: 'announcements' stamp: 'tg 1/31/2010 00:26'!
unregisterFromAllAnnouncements
	super unregisterFromAllAnnouncements.
	self presentations do: [:each | each unregisterFromAllAnnouncements ]! !

!GLMCompositePresentation methodsFor: 'enumerating' stamp: 'TudorGirba 7/9/2011 20:06'!
withAllPanesAndPresentationsDo: aBlock
	super withAllPanesAndPresentationsDo: aBlock.
	self do: [:each | each withAllPanesAndPresentationsDo: aBlock ]! !

!GLMCompositePresentation methodsFor: 'building' stamp: 'TudorGirba 9/9/2012 00:55'!
compose
	"by default this method is empty.
	override this method in subclasses to define a custom browser"! !

!GLMCompositePresentation methodsFor: 'accessing' stamp: 'tg 1/6/2010 23:16'!
arrangement: anArrangement
	anArrangement composite: self.
	^ arrangement := anArrangement! !

!GLMCompositePresentation methodsFor: 'accessing' stamp: 'tg 1/5/2010 16:14'!
at: aNumber
	^ self presentations at: aNumber ! !

!GLMCompositePresentation methodsFor: 'accessing' stamp: 'TudorGirba 10/8/2011 16:39'!
add: aPresentation
	self pane notingPresentationChangeDo: [
		self presentations add: aPresentation.
		aPresentation pane: self pane ].
	^ aPresentation! !

!GLMCompositePresentation methodsFor: '*glamour-rubric-presentations' stamp: 'TudorGirba 6/2/2013 21:49'!
rubricText
	^ self custom: GLMRubricTextPresentation new! !

!GLMCompositePresentation methodsFor: 'accessing' stamp: 'tg 1/6/2010 11:56'!
pane: aPane 
	super pane: aPane.
	self presentations do: [:each | each pane: aPane ]! !

!GLMCompositePresentation methodsFor: 'accessing' stamp: 'tg 12/14/2009 23:55'!
presentations: anObject
	presentations := anObject! !

!GLMCompositePresentation methodsFor: 'scripting' stamp: 'TudorGirba 1/2/2012 01:15'!
actionList
	^ self custom: GLMActionListPresentation new! !

!GLMCompositePresentation methodsFor: 'accessing' stamp: 'tg 1/5/2010 16:11'!
anySatisfy: aBlock
	^ self presentations anySatisfy: aBlock ! !

!GLMCompositePresentation methodsFor: 'scripting' stamp: 'tg 1/12/2010 14:37'!
stackedVerticallyArrangement
	^ self arrangement: (GLMStackedVerticallyArrangement of: self)! !

!GLMCompositePresentation methodsFor: 'scripting' stamp: 'TudorGirba 1/2/2012 01:15'!
finder
	^ self custom: GLMFinder new! !

!GLMCompositePresentation methodsFor: 'accessing' stamp: 'tg 5/25/2010 23:55'!
clear
	arrangement := nil.
	presentations := nil! !

!GLMCompositePresentation methodsFor: 'accessing' stamp: 'tg 1/5/2010 16:13'!
size
	^ self presentations size! !

!GLMCompositePresentation methodsFor: 'scripting' stamp: 'tg 1/6/2010 23:15'!
accordionArrangement
	^ self arrangement: GLMAccordionArrangement new! !

!GLMCompositePresentation methodsFor: 'scripting' stamp: 'TudorGirba 11/14/2012 19:53'!
wrapper
	^ self custom: GLMWrapper new! !

!GLMCompositePresentation methodsFor: 'accessing' stamp: 'tg 1/12/2010 14:39'!
arrangement
	^ arrangement ifNil: [arrangement := GLMTabbedArrangement of: self]! !

!GLMCompositePresentation methodsFor: 'scripting' stamp: 'TudorGirba 1/31/2012 16:19'!
accumulator 
	^ self custom: GLMAccumulator new! !

!GLMCompositePresentation methodsFor: 'accessing' stamp: 'tg 1/5/2010 21:09'!
includes: aPresentation
	^ self presentations includes: aPresentation ! !

!GLMCompositePresentation methodsFor: 'accessing' stamp: 'tg 1/5/2010 16:11'!
select: aBlock
	^ self presentations select: aBlock! !

!GLMCompositePresentation methodsFor: 'rendering' stamp: 'tg 1/18/2010 21:31'!
renderGlamorouslyOn: aRenderer
	"we delegate to the arrangement to dispatch the type of the actual arrangement of the nested presentations"
	self registerAnnouncements.
	^ self arrangement renderGlamorouslyOn: aRenderer! !

!GLMCompositePresentation methodsFor: 'accessing' stamp: 'tg 1/5/2010 16:12'!
do: aBlock
	^ self presentations do: aBlock ! !

!GLMCompositePresentation methodsFor: 'scripting' stamp: 'TudorGirba 1/2/2012 01:15'!
label
	^ self custom: GLMLabelPresentation new! !

!GLMCompositePresentation methodsFor: 'accessing' stamp: 'TudorGirba 10/8/2011 15:21'!
pane
	^ pane ifNil: [
		pane := (GLMPane named: 'root' in: GLMNoBrowser new) 
				presentations: self; 
				yourself]! !

!GLMCompositePresentation methodsFor: 'scripting opening' stamp: 'TudorGirba 10/7/2011 20:16'!
defaultRenderer 
	 
	^GLMRenderer subclasses first new! !

!GLMCompositePresentation methodsFor: 'scripting' stamp: 'TudorGirba 1/2/2012 01:15'!
diff
	^ self custom: GLMDiffPresentation new! !

!GLMCompositePresentation methodsFor: 'accessing' stamp: 'tg 1/5/2010 16:11'!
allSatisfy: aBlock
	^ self presentations allSatisfy: aBlock ! !

!GLMCompositePresentation methodsFor: 'scripting' stamp: 'TudorGirba 1/2/2012 01:15'!
table
	^ self custom: GLMTablePresentation new! !

!GLMCompositePresentation methodsFor: 'scripting' stamp: 'TudorGirba 1/2/2012 01:15'!
composite: aBlock
	| composite |
	composite := GLMCompositePresentation new.
	aBlock value: composite.
	^ self custom: composite! !

!GLMCompositePresentation methodsFor: 'scripting opening' stamp: 'TudorGirba 10/7/2011 20:15'!
openWith: aRenderer 
	 
	^ aRenderer open: self! !

!GLMCompositePresentation class methodsFor: 'openning' stamp: 'TudorGirba 4/1/2013 08:56'!
openOn: anObject 
	^ self new openOn: anObject! !

!GLMCompositePresentation class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:02'!
gtExampleCompositePresentation
	<gtExample>

	^ self new
		list;
		table;
		tree! !

!GLMCompositePresentationAsStartMorphicTest methodsFor: 'tests' stamp: ''!
testSimpleOpen
	| p |
	p := GLMCompositePresentation new.
	p tabulator with: [:b | b row: #one. b transmit to: #one; andShow: [:a | a text ] ].
	window := p openOn: 42.
	self assert: (window isKindOf: GLMSystemWindow)! !

!GLMCompositePresentationMorphicTest methodsFor: 'private' stamp: ''!
compositePanel
	|composite|
	composite := self compositeMorph.
	self assert: (composite isKindOf: PanelMorph).
	self assert: (composite submorphs allSatisfy: [:morph | morph isKindOf: ExpanderMorph]).
	^ composite
! !

!GLMCompositePresentationMorphicTest methodsFor: 'private' stamp: ''!
compositeTabGroup
	|composite|
	composite := self compositeMorph.
	self assert: (composite isKindOf: LazyTabGroupMorph).
	^ composite
! !

!GLMCompositePresentationMorphicTest methodsFor: 'private' stamp: ''!
compositeMorph
	^ window submorphs last submorphs last submorphs last! !

!GLMCompositePresentationMorphicTest methodsFor: 'tests' stamp: ''!
testTabs
	| browser |
	browser := GLMTabulator new.
	browser column: #one.
	(browser transmit)
		to: #one;
		andShow: [ :a | 
					a list.
					a text ].
	window := browser openOn: 42.
	self assert: self compositeTabGroup pages size equals: 2! !

!GLMCompositePresentationMorphicTest methodsFor: 'tests' stamp: 'AndreiChis 5/30/2013 22:06'!
testFinder
	| finder |
	finder := GLMFinder new.
	finder
		show: [ :a | 
			a title: 'something'.
			a stackedArrangement.
			a list.
			a text ].
	self assert: finder transmission transmissionStrategy  presentations size equals: 2.
	finder startOn: (1 to: 42).
	self assert: finder panes first presentations size equals: 2.
	self assert: (finder panes first presentations arrangement isKindOf: GLMStackedVerticallyArrangement).
	window := finder open.
	self find: LazyTabGroupMorph in: window.! !

!GLMCompositePresentationMorphicTest methodsFor: 'tests' stamp: ''!
testStackedVertically
	| browser |
	browser := GLMTabulator new.
	browser column: #one.
	(browser transmit)
		to: #one;
		andShow: [ :a | 
					a stackedVerticallyArrangement.
					a list title: 'list'.
					a text title: 'text' ].
	window := browser openOn: 42.
	self assert: self compositeMorph class equals: PanelMorph.
	self assert: self compositeMorph submorphs size equals: 2.
	self assert: self compositeMorph submorphs size equals: 2.
	self assert: self compositeMorph submorphs first class equals: LazyTabGroupMorph! !

!GLMCompositePresentationMorphicTest methodsFor: 'tests' stamp: ''!
testTabsWithActions
	| browser |
	browser := GLMTabulator new.
	browser column: #one.
	(browser transmit)
		to: #one;
		andShow: [ :a | 
					a list act: #inspect entitled: 'Inspect'.
					a text ].
	window := browser openOn: 42.
	self assert: self compositeTabGroup toolbarMorph submorphs notEmpty.
	self compositeTabGroup selectedPageIndex: 2.
	self assert: self compositeTabGroup toolbarMorph submorphs isEmpty.
	self compositeTabGroup selectedPageIndex: 1.
	self assert: self compositeTabGroup toolbarMorph submorphs notEmpty! !

!GLMCompositePresentationMorphicTest methodsFor: 'tests' stamp: ''!
testAccordionWithTitle
	| browser |
	browser := GLMTabulator new.
	browser column: #one.
	(browser transmit)
		to: #one;
		andShow: [ :a | 
					a accordionArrangement.
					a title: 'title'.
					a list.
					a text ].
	window := browser openOn: 42.
	self assert: self compositeTabGroup submorphs notEmpty.
	self assert: self compositeTabGroup submorphs size equals: 2.
	self assert: self compositeTabGroup contentMorph class equals: PanelMorph.
	self assert: self compositeTabGroup contentMorph submorphs first submorphs size equals: 2.
	self assert: self compositeTabGroup contentMorph submorphs first submorphs first class equals: ExpanderMorph! !

!GLMCompositePresentationMorphicTest methodsFor: 'tests' stamp: ''!
testTabsWithTitleIconWithoutTitle
	| browser |
	browser := GLMTabulator new.
	browser column: #one.
	(browser transmit)
		to: #one;
		andShow: [ :a | 
					a titleIcon: GLMUIThemeExtraIcons glamorousBrowse.
					a list.
					a text ].
	window := browser openOn: 42.
	self assert: self compositeTabGroup submorphs size equals: 2.
	self assert: self compositeTabGroup submorphs first class equals: PanelMorph.
	self assert: self compositeTabGroup submorphs first submorphs size equals: 1.
	self assert: self compositeTabGroup submorphs first submorphs first class equals: LazyTabGroupMorph.
	self assert: self compositeTabGroup submorphs first submorphs first pages size equals: 2! !

!GLMCompositePresentationMorphicTest methodsFor: 'tests' stamp: ''!
testTabsWithUpdate
	| browser |
	browser := GLMTabulator new.
	browser column: #one.
	(browser transmit)
		to: #one;
		andShow: [ :a | 
					a list.
					a text ].
	window := browser openOn: 42.
	self assert: self compositeTabGroup pages size equals: 2.
	self shouldnt: [browser panes first presentations update]  raise: Error! !

!GLMCompositePresentationMorphicTest methodsFor: 'tests' stamp: ''!
testAccordion
	| browser |
	browser := GLMTabulator new.
	browser column: #one.
	(browser transmit)
		to: #one;
		andShow: [ :a | 
					a accordionArrangement.
					a list title: 'List'.
					a text title: 'Text' ].
	window := browser openOn: 42.
	self assert: self compositePanel submorphs notEmpty.
	self assert: self compositePanel submorphs size equals: 2.
	self assert: self compositePanel submorphs first class equals: ExpanderMorph.
	self assert: self compositePanel submorphs last class equals: ExpanderMorph! !

!GLMCompositePresentationMorphicTest methodsFor: 'tests' stamp: ''!
testStackedVerticallyWithTitle
	| browser |
	browser := GLMTabulator new.
	browser column: #one.
	(browser transmit)
		to: #one;
		andShow: [ :a | 
					a stackedVerticallyArrangement.
					a title: 'title'.
					a list title: 'list'.
					a text title: 'text' ].
	window := browser openOn: 42.
	self assert: self compositeTabGroup submorphs notEmpty.
	self assert: self compositeTabGroup submorphs size equals: 2.
	self assert: self compositeTabGroup contentMorph class equals: PanelMorph.
	self assert: self compositeTabGroup contentMorph submorphs size equals: 1.
	self assert: self compositeTabGroup contentMorph submorphs first class equals: PanelMorph.
	self assert: self compositeTabGroup contentMorph submorphs first submorphs size equals: 2.
	self assert: self compositeTabGroup contentMorph submorphs first submorphs first class equals: LazyTabGroupMorph! !

!GLMCompositePresentationMorphicTest methodsFor: 'tests' stamp: ''!
testTabsLastActivePresentation
	| browser |
	browser := GLMTabulator new.
	browser column: #one.
	(browser transmit)
		to: #one;
		andShow: [ :a | 
					a list.
					a text ].
	window := browser openOn: 42.
	self compositeTabGroup selectedPageIndex: 2.
	self assert: browser panes first lastActivePresentation notNil.
	self assert: (browser panes first lastActivePresentation isKindOf: GLMTextPresentation)! !

!GLMCompositePresentationMorphicTest methodsFor: 'tests' stamp: ''!
testOneTabWithActions
	| browser |
	browser := GLMTabulator new.
	browser column: #one.
	(browser transmit)
		to: #one;
		andShow: [ :a | a list act: #inspect entitled: 'Inspect' ].
	window := browser openOn: 42.
	self assert: self compositeMorph class equals: PanelMorph.
	self assert: self compositeMorph submorphs size equals: 2! !

!GLMCompositePresentationMorphicTest methodsFor: 'tests' stamp: ''!
testOneStackedVerticallyWithTitle
	| browser |
	browser := GLMTabulator new.
	browser column: #one.
	(browser transmit)
		to: #one;
		andShow: [ :a | 
					a stackedVerticallyArrangement.
					a title: 'title'.
					a list ].
	window := browser openOn: 42.
	self assert: self compositeTabGroup submorphs notEmpty.
	self assert: self compositeTabGroup submorphs size equals: 2.
	self assert: self compositeTabGroup contentMorph class equals: PanelMorph.
	self assert: self compositeTabGroup contentMorph submorphs size equals: 1.
	self assert: self compositeTabGroup contentMorph submorphs first class equals: PanelMorph.
	self assert: self compositeTabGroup contentMorph submorphs first submorphs size equals: 1.
	self assert: self compositeTabGroup contentMorph submorphs first submorphs first class equals: LazyTabGroupMorph! !

!GLMCompositePresentationMorphicTest methodsFor: 'tests' stamp: ''!
testTabsWithTitle
	| browser |
	browser := GLMTabulator new.
	browser column: #one.
	(browser transmit)
		to: #one;
		andShow: [ :a | 
					a title: 'title'.
					a list.
					a text ].
	window := browser openOn: 42.
	self assert: self compositeTabGroup submorphs size equals: 2.
	self assert: self compositeTabGroup submorphs first class equals: PanelMorph.
	self assert: self compositeTabGroup submorphs first submorphs size equals: 1.
	self assert: self compositeTabGroup submorphs first submorphs first class equals: LazyTabGroupMorph.
	self assert: self compositeTabGroup submorphs first submorphs first pages size equals: 2! !

!GLMCompositePresentationMorphicTest methodsFor: 'tests' stamp: ''!
testAccordionExpanded
	| browser |
	browser := GLMTabulator new.
	browser column: #one.
	browser transmit to: #one; andShow: [ :a | 
		a accordionArrangement.
		a list title: 'List'.
		a text title: 'Text'].
	window := browser openOn: 42.
	self assert: self compositePanel submorphs first expanded.
	self assert: self compositePanel submorphs last expanded not.! !

!GLMCompositePresentationTest methodsFor: 'tests' stamp: 'tg 5/25/2010 14:34'!
testPane
	| pane composite presentation |
	pane := GLMPane new.
	composite := GLMCompositePresentation new.
	presentation := GLMPresentation new.
	composite add: presentation.
	composite pane: pane.
	self assert: composite pane == pane.
	self assert: composite first pane == pane! !

!GLMCompositePresentationTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testAdd
	| composite |
	composite := GLMCompositePresentation new.
	composite add: GLMPresentation new.
	self assert: composite isEmpty not.
	self assert: composite presentations size equals: 1! !

!GLMCompositePresentationTest methodsFor: 'as yet unclassified' stamp: 'Nicolasanquetil 5/3/2013 15:06'!
testCompositeWithinCompositePanePropagation
	| composite0 composite1 composite21 composite22 pane |
	composite0 := GLMCompositePresentation new.
	composite1 := GLMCompositePresentation new.
	composite21 := GLMCompositePresentation new.
	composite22 := GLMCompositePresentation new.
	composite21 add: GLMPresentation new.
	composite1 add: composite21.
	composite22 add: GLMPresentation new.
	composite1 add: composite22.
	composite0 add: composite1.
	pane := GLMPane new.
	pane presentations: composite0.
	self assert: composite0 first first first pane equals: pane.
	self assert: (composite0 first at: 2) pane equals: pane.
	self assert: composite0 first first first pane equals: pane.
	self assert: (composite0 first at: 2) first pane equals: pane! !

!GLMCompositePresentationTest methodsFor: 'tests' stamp: 'TudorGirba 10/8/2011 16:38'!
testAddRaisesAnnouncement
	| composite announcementCount pane |
	composite := GLMCompositePresentation new.
	pane := composite pane.
	announcementCount := 0.
	composite entity: 42.
	pane on: GLMMatchingPresentationsChanged do: [:ann | 
		announcementCount := announcementCount + 1 ].
	composite add: GLMPresentation new.
	self assert: announcementCount equals: 1! !

!GLMCompositePresentationTest methodsFor: 'tests - composer' stamp: 'Nicolasanquetil 5/3/2013 15:20'!
testCreateTabulator
	| show |
	show := GLMCompositePresentation new.
	show tabulator
		with: [ :b | 
			b row: #one.
			b transmit
				to: #one;
				transformed: [ :x | x + 1 ];
				andShow: [ :a | a text ] ].
	self assert: show size equals: 1.
	self assert: (show first isKindOf: GLMTabulator).
	show startOn: 41.
	self assert: show first panes size equals: 1.
	self assert: (show first panes first port: #entity) value equals: 42! !

!GLMCompositePresentationTest methodsFor: 'tests' stamp: 'Nicolasanquetil 5/3/2013 15:14'!
testStartingPreservesItself
	| composite finder |
	composite := GLMCompositePresentation new.
	finder := composite finder.
	composite startOn: 42.
	self assert: composite pane presentations equals: composite.
	self assert: composite first == finder! !

!GLMCompositePresentationTest methodsFor: 'as yet unclassified' stamp: 'Nicolasanquetil 5/3/2013 15:20'!
testCompositeWithinCompositeOuterPortEvents
	| childComposite finder parentComposite count |
	count := 0.
	childComposite := GLMCompositePresentation new.
	finder := childComposite finder.
	finder show: [ :a | a list display: [ :x | 1 to: x ] ].
	finder
		on: GLMPaneAdded
		do: [ :a | count := count + 1 ].
	parentComposite := GLMCompositePresentation new.
	parentComposite custom: childComposite.
	parentComposite startOn: 10.
	self assert: count equals: 1! !

!GLMCompositePresentationTest methodsFor: 'tests' stamp: 'Nicolasanquetil 5/3/2013 15:13'!
testAddSetsCorrectPane
	| composite presentation |
	composite := GLMCompositePresentation new.
	presentation := GLMPresentation new.
	composite add: presentation.
	self assert: composite pane equals: presentation pane! !

!GLMCompositePresentationTest methodsFor: 'tests' stamp: 'Nicolasanquetil 5/3/2013 15:07'!
testDefaultPane
	| composite |
	composite := GLMCompositePresentation new.
	self assert: composite pane presentations equals: composite! !

!GLMCompositePresentationTest methodsFor: 'tests - composer' stamp: 'Nicolasanquetil 5/3/2013 15:14'!
testCreateFinder
	| show |
	show := GLMCompositePresentation new.
	show finder with: [ :b | b show: [ :a | a text ] ].
	self assert: show size equals: 1.
	self assert: (show first isKindOf: GLMFinder).
	show startOn: 42.
	self assert: show first panes size equals: 1.
	self assert: (show first panes first port: #entity) value equals: 42! !

!GLMCompositePresentationTest methodsFor: 'tests' stamp: 'tg 1/5/2010 15:17'!
testCreation
	| composite |
	composite := GLMCompositePresentation new.
	self assert: composite isEmpty! !

!GLMCondition commentStamp: 'TudorGirba 7/14/2011 10:53'!
GLMCondition is the abstract class for defininf a boolean condition applied on some input arguments. It is meant to be subclassed.!
!GLMContextChanged commentStamp: 'tg 2/20/2010 14:55'!
A GLMContextChanged is announced by a presentation when an outer port event raises.!
!GLMContextChanged methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
oldValue: anObject 
	 
	oldValue := anObject! !

!GLMContextChanged methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
property 
	 
	^property! !

!GLMContextChanged methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
value 
	 
	^value! !

!GLMContextChanged methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
value: anObject 
	 
	value := anObject! !

!GLMContextChanged methodsFor: 'printing' stamp: 'TudorGirba 10/30/2011 10:51'!
printOn: aStream
	super printOn: aStream.
	aStream 
		nextPutAll: ' (presentation = ';
		nextPutAll: self presentation printString;
		nextPutAll: ', property = #';
		nextPutAll: self property;
		nextPutAll: ', oldValue = ';
		nextPutAll: self oldValue asString;
		nextPutAll: ', value = ';
		nextPutAll: self value asString;
		nextPutAll: ')'! !

!GLMContextChanged methodsFor: 'testing' stamp: ' 4/5/09 22:18'!
announcesNewSelection 
	"ContextChanged announces a new selection if 
	the updated port is #selection and the new value is different from the current selection. 
	This method is useful when updating the selection in UI widgets, because 
	we only want to affect the widget when there actually is a new selection" 
	 
	^self property = #selection 
		and: [self presentation selection ~~ self value]! !

!GLMContextChanged methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
presentation: aPresentation 
	 
	presentation := aPresentation! !

!GLMContextChanged methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
oldValue 
	 
	^oldValue! !

!GLMContextChanged methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
property: aSymbol 
	 
	property := aSymbol! !

!GLMContextChanged methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
presentation 
	 
	^presentation! !

!GLMCustomCell methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
childrenCount 
	 
	^self children 
		inject: 0 
		into: [:sum :each | sum + each span]! !

!GLMCustomCell methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
id: anObject 
	 
	id := anObject! !

!GLMCustomCell methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
span 
	 
	^span ifNil: [span := 1]! !

!GLMCustomCell methodsFor: 'testing' stamp: ' 4/5/09 22:18'!
hasId 
	 
	^id notNil! !

!GLMCustomCell methodsFor: 'accessing' stamp: 'tg 10/22/2009 10:17'!
size
	^ size ifNil: [0]! !

!GLMCustomCell methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
browser: anObject 
	 
	browser := anObject! !

!GLMCustomCell methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
children 
	 
	^children ifNil: [children := OrderedCollection new]! !

!GLMCustomCell methodsFor: 'testing' stamp: ' 4/5/09 22:18'!
isRow 
	 
	^false! !

!GLMCustomCell methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
span: anObject 
	 
	span := anObject! !

!GLMCustomCell methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
id 
	 
	^id ifNil: [#anonymous]! !

!GLMCustomCell methodsFor: 'accessing' stamp: 'tg 10/22/2009 10:20'!
size: anObject
	size := anObject.! !

!GLMCustomCell methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
children: anObject 
	 
	children := anObject! !

!GLMCustomCell methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
browser 
	 
	^browser! !

!GLMCustomCell methodsFor: 'testing' stamp: ' 4/5/09 22:18'!
isColumn 
	 
	^false! !

!GLMCustomCell methodsFor: 'testing' stamp: ' 4/5/09 22:18'!
isSplitIntoColumns 
	 
	^self children allSatisfy: [:each | each isColumn]! !

!GLMCustomCell methodsFor: 'testing' stamp: ' 4/5/09 22:18'!
isSplitIntoRows 
	 
	^self children allSatisfy: [:each | each isRow]! !

!GLMCustomColumn methodsFor: 'scripting' stamp: ' 4/5/09 22:18'!
row: aBlockOrSymbol span: anInteger 
	 
	^self addRow: aBlockOrSymbol span: anInteger! !

!GLMCustomColumn methodsFor: 'scripting' stamp: 'tg 10/21/2009 22:08'!
row: aBlockOrSymbol size: anInteger 
	 
	^self addRow: aBlockOrSymbol size: anInteger! !

!GLMCustomColumn methodsFor: 'scripting' stamp: ' 4/5/09 22:18'!
row: aBlockOrSymbol 
	 
	^self addRow: aBlockOrSymbol! !

!GLMCustomColumn methodsFor: 'testing' stamp: ' 4/5/09 22:18'!
isColumn 
	 
	^true! !

!GLMCustomColumn methodsFor: 'accessing' stamp: 'jorge.ressia 6/2/2009 21:53'!
addRow: aBlockOrSymbol 
	 
	| newRow cell | 
	cell := aBlockOrSymbol isSymbol 
		ifTrue: 
			[self browser 
				addNewPaneNamed: aBlockOrSymbol. 
			(GLMCustomRow new) 
				id: aBlockOrSymbol; 
				browser: self browser] 
		ifFalse: 
			[newRow := GLMCustomRow new browser: self browser. 
			aBlockOrSymbol value: newRow. 
			newRow]. 
	self children addLast: cell. 
	^cell! !

!GLMCustomColumn methodsFor: 'accessing' stamp: 'tg 10/22/2009 10:20'!
addRow: aBlockOrSymbol size: anInteger 
	 
	^(self addRow: aBlockOrSymbol) size: anInteger; span: 0! !

!GLMCustomColumn methodsFor: 'accessing' stamp: 'tg 10/22/2009 10:20'!
addRow: aBlockOrSymbol span: anInteger 
	 
	^(self addRow: aBlockOrSymbol) span: anInteger; size: 0! !

!GLMCustomRow methodsFor: 'accessing' stamp: 'jorge.ressia 6/2/2009 21:49'!
addColumn: aBlockOrSymbol 
	 
	| newColumn cell | 
	cell := aBlockOrSymbol isSymbol 
		ifTrue: 
			[self browser 
				addNewPaneNamed: aBlockOrSymbol. 
			(GLMCustomColumn new) 
				id: aBlockOrSymbol; 
				browser: self browser] 
		ifFalse: 
			[newColumn := GLMCustomColumn new browser: self browser. 
			aBlockOrSymbol value: newColumn. 
			newColumn]. 
	self children addLast: cell. 
	^cell! !

!GLMCustomRow methodsFor: 'accessing' stamp: 'tg 10/22/2009 10:21'!
addColumn: aBlockOrSymbol size: anInteger 
	 
	^(self addColumn: aBlockOrSymbol) size: anInteger; span: 0! !

!GLMCustomRow methodsFor: 'scripting' stamp: ' 4/5/09 22:18'!
column: aBlockOrSymbol 
	 
	^self addColumn: aBlockOrSymbol! !

!GLMCustomRow methodsFor: 'accessing' stamp: 'tg 10/22/2009 10:21'!
addColumn: aBlockOrSymbol span: anInteger 
	 
	^(self addColumn: aBlockOrSymbol) span: anInteger; size: 0! !

!GLMCustomRow methodsFor: 'testing' stamp: ' 4/5/09 22:18'!
isRow 
	 
	^true! !

!GLMCustomRow methodsFor: 'scripting' stamp: 'tg 10/21/2009 22:08'!
column: aBlockOrSymbol size: anInteger 
	 
	^self addColumn: aBlockOrSymbol size: anInteger! !

!GLMCustomRow methodsFor: 'scripting' stamp: ' 4/5/09 22:18'!
column: aBlockOrSymbol span: anInteger 
	 
	^self addColumn: aBlockOrSymbol span: anInteger! !

!GLMDashboard methodsFor: 'accessing' stamp: 'cyrilledelaunay 7/29/2011 13:39'!
extentOfPaneNamed: aSymbol

	^ self panesExtents at: aSymbol ifAbsent: [
		"default extent for a pane"
		"#glamourOptimalExtent"
		self defaultPaneExtent
		]! !

!GLMDashboard methodsFor: 'rendering' stamp: 'cyrilledelaunay 6/7/2011 17:01'!
renderGlamorouslyOn: aRenderer 
	 
	^aRenderer renderDashboard: self! !

!GLMDashboard methodsFor: 'scripting' stamp: 'cyrilledelaunay 5/12/2011 16:08'!
addPaneNamed: aString

	self addNewPaneNamed: aString! !

!GLMDashboard methodsFor: 'accessing' stamp: 'cyrilledelaunay 5/17/2011 10:46'!
panesExtents

	^ panesExtents ifNil: [panesExtents := Dictionary new]! !

!GLMDashboard methodsFor: 'accessing' stamp: 'cyrilledelaunay 7/29/2011 13:46'!
defaultPaneExtent: anObject

	"so that each renderer can make specific the way to compute the default extent"
	defaultPaneExtent := anObject! !

!GLMDashboard methodsFor: 'scripting' stamp: 'TudorGirba 7/2/2011 22:53'!
initializeScriptingDefaults
	super initializeScriptingDefaults.
	self transmissions
		detect: [ :each | each originatesAt: (self pane port: #entity) ]
		ifNone: [ 
			self
				transmit to: (self panes first port: #entity);
				from: #outer port: #entity;
				andShow: [:a |  a custom: GLMFlexiblePresentation new ] ]! !

!GLMDashboard methodsFor: 'scripting' stamp: 'cyrilledelaunay 5/20/2011 11:06'!
rigidStrategy

	self extentStrategy: GLMRigidStrategy new ! !

!GLMDashboard methodsFor: 'scripting' stamp: 'cyrilledelaunay 5/20/2011 11:06'!
fillWidthStrategy

	self extentStrategy: GLMFillWidthStrategy new ! !

!GLMDashboard methodsFor: 'scripting' stamp: 'cyrilledelaunay 5/17/2011 10:47'!
addPaneNamed: aSymbol extent: aPoint

	self addPaneNamed: aSymbol.
	self panesExtents at: aSymbol put: aPoint! !

!GLMDashboard methodsFor: 'accessing' stamp: 'cyrilledelaunay 5/20/2011 11:40'!
extentStrategy

	^ extentStrategy ifNil: [extentStrategy := GLMFillWidthStrategy new].! !

!GLMDashboard methodsFor: 'accessing' stamp: 'cyrilledelaunay 7/29/2011 13:42'!
defaultPaneExtent

	^ defaultPaneExtent ifNil: [defaultPaneExtent := 300@150]! !

!GLMDashboard methodsFor: 'accessing' stamp: 'cyrilledelaunay 5/20/2011 11:03'!
extentStrategy: aGLMDashboardExtentStrategy

	extentStrategy := aGLMDashboardExtentStrategy.! !

!GLMDashboardExtentStrategy methodsFor: '*glamour-morphic-renderer' stamp: 'cyrilledelaunay 5/20/2011 11:27'!
initializeSecondColumn: aPanelMorph
	
	^ self subclassResponsibility ! !

!GLMDashboardExtentStrategy methodsFor: '*glamour-morphic-renderer' stamp: 'cyrilledelaunay 5/20/2011 11:10'!
initializePane: aMorphPane
	
	^ self subclassResponsibility ! !

!GLMDashboardExtentStrategy methodsFor: '*glamour-morphic-renderer' stamp: 'cyrilledelaunay 5/20/2011 11:27'!
initializeContainer: aPanelMorph
	
	^ self subclassResponsibility ! !

!GLMDashboardExtentStrategy methodsFor: '*glamour-morphic-renderer' stamp: 'cyrilledelaunay 5/20/2011 11:27'!
initializeFirstColumn: aPanelMorph
	
	^ self subclassResponsibility ! !

!GLMDashboardMorphicTest methodsFor: 'tests' stamp: 'Nicolasanquetil 5/3/2013 14:58'!
testPanesExtent
	| dashboard mainCell firstColumn secondColumn |
	dashboard := GLMDashboard.
	dashboard := GLMDashboard new.
	dashboard rigidStrategy.
	dashboard addPaneNamed: #one extent: 20 @ 45.
	dashboard addPaneNamed: #two extent: 50 @ 10.
	dashboard addPaneNamed: #three extent: 20 @ 40.
	dashboard addPaneNamed: #four.
	window := dashboard openOn: #start.
	mainCell := window submorphs last submorphs last submorphs last.
	firstColumn := mainCell submorphs first.
	secondColumn := mainCell submorphs second.
	self assert: firstColumn submorphs first extent equals: 20 @ 45.
	self assert: firstColumn submorphs second extent equals: 50 @ 10.
	self assert: secondColumn submorphs first extent equals: 20 @ 40	"self assert: secondColumn submorphs second extent = dashboard defaultPaneExtent "! !

!GLMDashboardMorphicTest methodsFor: 'tests' stamp: 'Nicolasanquetil 5/3/2013 15:07'!
testPanesExtentWithFillWidthStrategy
	| dashboard mainCell firstColumn secondColumn |
	dashboard := GLMDashboard.
	dashboard := GLMDashboard new.
	dashboard fillWidthStrategy.
	dashboard addPaneNamed: #one extent: 20 @ 45.
	dashboard addPaneNamed: #two extent: 50 @ 10.
	dashboard addPaneNamed: #three extent: 20 @ 40.
	dashboard addPaneNamed: #four.
	window := dashboard openOn: #start.
	mainCell := window submorphs last submorphs last submorphs last.
	firstColumn := mainCell submorphs first.
	secondColumn := mainCell submorphs second.
	self deny: firstColumn submorphs first extent = (20 @ 45).
	self assert: firstColumn submorphs first extent y equals: 45.
	self deny: firstColumn submorphs second extent = (50 @ 10).
	self assert: firstColumn submorphs second extent y equals: 10.
	self deny: secondColumn submorphs first extent = (20 @ 40).
	self assert: secondColumn submorphs first extent y equals: 40	"self deny: secondColumn submorphs second extent = dashboard defaultPaneExtent."	"self assert: secondColumn submorphs second extent  y = dashboard defaultPaneExtent y  "! !

!GLMDashboardTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPanesAndExtents
	| layout |
	layout := GLMDashboard new.
	layout rigidStrategy.
	layout addPaneNamed: #one extent: 20 @ 45.
	layout addPaneNamed: #two extent: 50 @ 10.
	layout addPaneNamed: #three extent: 20 @ 40.
	layout addPaneNamed: #four.
	self assert: layout panes size equals: 4.
	self assert: (layout extentOfPaneNamed: #one) equals: 20 @ 45.
	self assert: (layout extentOfPaneNamed: #two) equals: 50 @ 10.
	self assert: (layout extentOfPaneNamed: #three) equals: 20 @ 40	"self assert: (layout extentOfPaneNamed: #four) =  layout defaultPaneExtent. "! !

!GLMDashboardTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPanes
	| layout |
	layout := GLMDashboard new.
	layout addPaneNamed: #one.
	layout addPaneNamed: #two.
	layout addPaneNamed: #three.
	self assert: layout panes size equals: 3.
	#(#one #two #three) do: [ :aSymbol | self assert: (layout panes anySatisfy: [ :aGLMPane | aGLMPane name = aSymbol ]) ]! !

!GLMDebugSelection commentStamp: 'AndreiChis 5/6/2014 17:55'!
I am event indicating to the renderer to debug the currently selected text.!
!GLMDiffPresentation commentStamp: 'TudorGirba 7/14/2011 11:49'!
GLMDiffPresentation is meant to show the difference between two input text objects.

The convention is that the transformed entity should provide a collection with two elements.!
!GLMDiffPresentation methodsFor: 'accessing values' stamp: 'YuriyTymchuk 2/23/2015 16:31'!
contextClassValue
	^ self contextClass glamourValue: self entity! !

!GLMDiffPresentation methodsFor: 'rendering' stamp: ''!
renderGlamorouslyOn: aRenderer 
	self registerAnnouncements.
	^ aRenderer renderDiffPresentation: self! !

!GLMDiffPresentation methodsFor: 'accessing' stamp: 'YuriyTymchuk 2/23/2015 16:56'!
contextClass: aClassOrBlock
	"the class of method which source is being diffed"

	contextClass := aClassOrBlock! !

!GLMDiffPresentation methodsFor: 'accessing' stamp: 'YuriyTymchuk 2/23/2015 16:24'!
contextClass
	^ contextClass! !

!GLMDropDownListMorphSelectionChanged methodsFor: 'accessing' stamp: 'AndreiChis 8/20/2013 22:26'!
selectionIndex: anInteger
	selectionIndex := anInteger! !

!GLMDropDownListMorphSelectionChanged methodsFor: 'accessing' stamp: 'VeronicaUquillas 5/18/2010 20:15'!
selectionValue
	^ selectionValue! !

!GLMDropDownListMorphSelectionChanged methodsFor: 'accessing' stamp: 'VeronicaUquillas 5/18/2010 20:15'!
selectionValue: anObject
	selectionValue := anObject! !

!GLMDropDownListMorphSelectionChanged methodsFor: 'accessing' stamp: 'AndreiChis 8/20/2013 22:26'!
selectionIndex
	^ selectionIndex! !

!GLMDropDownListPresentation commentStamp: 'AndreiChis 10/3/2014 18:23'!
A GLMDropDownListPresentation is takes a list of objects and displays them in a drop down view.

For an example see GLMBasicExamples>>#dropDownList!
!GLMDropDownListPresentation methodsFor: 'accessing' stamp: ''!
selectedIndex
	^ selectedIndex ifNil:[ selectedIndex := 0 ] ! !

!GLMDropDownListPresentation methodsFor: 'rendering' stamp: ''!
defaultValidate: anObject on: aPort
	"we only allow objects that are in the display value"

	(aPort name == #selection) ifFalse: [ ^ true ].
	self entity isNil ifTrue: [ ^ false ].
	^ self displayValue includes: anObject ! !

!GLMDropDownListPresentation methodsFor: 'accessing' stamp: ''!
selectedIndex: index
	
	selectedIndex:= index! !

!GLMDropDownListPresentation methodsFor: 'rendering' stamp: ''!
renderGlamorouslyOn: aRenderer 
	self registerAnnouncements.
	^ aRenderer renderDropDownListPresentation: self! !

!GLMDropDownMorphicTest methodsFor: 'as yet unclassified' stamp: ''!
testSelectionTriggeredOnSelectedIndex
	| browser dropdown text dropdownMorph textMorph |
	browser := GLMTabulator new.
 	browser row: #one; row: #two.
 	browser transmit to: #one; andShow: [:a |
 		a dropDownList
 			display: [:x | (1 to: x) + 10 ];
 			selectedIndex: 2 ].
 	browser transmit from: #one; to: #two; andShow: [:a |
 		a text].
 	window := browser openOn: 5.
	dropdown := browser panes first presentations first.
	"Because #selectedIndex: must trigger a transmission, we should get the text presentation in #two"
	self assert: browser panes second presentations size equals: 1.
	text := browser panes second presentations first.
	dropdownMorph := self findWherePresentationIs: dropdown in: window.
	textMorph := self findWherePresentationIs: text in: window.
	self assert: dropdownMorph selectedItem contents equals: '12'.
	self assert: textMorph text asString equals: '12'! !

!GLMDropListModel methodsFor: 'accessing' stamp: 'VeronicaUquillas 5/18/2010 15:53'!
list: anObject
	list := anObject! !

!GLMDropListModel methodsFor: 'accessing' stamp: 'VeronicaUquillas 5/18/2010 15:55'!
announcer
	^ announcer ifNil: [announcer := GLMAnnouncer new]! !

!GLMDropListModel methodsFor: 'accessing' stamp: 'AndreiChis 8/21/2013 15:42'!
resetData

	list := nil.
	selectionIndex := nil! !

!GLMDropListModel methodsFor: 'accessing' stamp: 'VeronicaUquillas 5/26/2010 14:45'!
selectionIndex

	^ selectionIndex ifNil:[ selectionIndex:= self glamourPresentation selectedIndex ]! !

!GLMDropListModel methodsFor: 'accessing' stamp: 'AndreiChis 8/20/2013 22:43'!
selectionIndex: anObject
	selectionIndex := anObject.
	self announcer announce: (
			GLMDropDownListMorphSelectionChanged new 
				selectionValue: self selectedItem;
				selectionIndex: selectionIndex;
				yourself)! !

!GLMDropListModel methodsFor: 'accessing' stamp: 'VeronicaUquillas 5/18/2010 16:33'!
glamourPresentation: anObject
	glamourPresentation := anObject! !

!GLMDropListModel methodsFor: 'accessing' stamp: 'VeronicaUquillas 5/27/2010 17:48'!
selectedItem
	"Answer the currently selected item or nil if none."

	^self selectionIndex = 0
		ifTrue: [nil]
		ifFalse: [self glamourPresentation displayValue at: self selectionIndex]! !

!GLMDropListModel methodsFor: 'accessing' stamp: 'AndreiChis 8/21/2013 16:10'!
list

	^list ifNil: [ list:= (self glamourPresentation displayValue 
									collect:[ :each| (self glamourPresentation formatedDisplayValueOf: each) asMorph ])]! !

!GLMDropListModel methodsFor: 'accessing' stamp: 'VeronicaUquillas 5/18/2010 16:33'!
glamourPresentation

	^glamourPresentation! !

!GLMDynamicMorphicTest methodsFor: 'tests' stamp: ''!
testUpdate
	| browser dynamicContainerMorph presentationObject |
	browser := GLMTabulator new.
	browser column: #one.
	browser transmit to: #one; andShow: [ :a | 
		a dynamic presentation: [:some :object | 
			some custom: presentationObject ]].
	presentationObject := GLMTextPresentation new.
	window := browser openOn: 42.
	dynamicContainerMorph := window submorphs last submorphs first submorphs first.
	self assert: (dynamicContainerMorph isKindOf: PanelMorph).
	self assert: (dynamicContainerMorph submorphs first isKindOf: PluggableTextMorph).
	presentationObject := GLMListPresentation new.
	browser update.
	dynamicContainerMorph := window submorphs last submorphs first submorphs first.
	self assert: (dynamicContainerMorph isKindOf: PanelMorph).
	self assert: (dynamicContainerMorph submorphs first submorphs first isKindOf: MorphTreeMorph)! !

!GLMDynamicMorphicTest methodsFor: 'tests' stamp: ''!
expectedFailures 
	^ #(testWithDisplay)! !

!GLMDynamicMorphicTest methodsFor: 'tests' stamp: ''!
testWithDisplay
	| browser dynamic stacker text textMorph |
	browser := GLMTabulator new column: #stacker; yourself.
	browser transmit to: #stacker; andShow: [:c | 
		c dynamic
			display: [:number | |st|
				st := GLMStacker new.
				st aPane: #all.
				st transmit to: #all; andShow: [:a | a text display: ['All ', number asString]].
				st]].
	window := browser openOn: 10.
	dynamic := browser panes first presentations first.
	stacker := dynamic cachedPresentation first.
	self assert: stacker panes first presentations size equals: 1.
	text := stacker panes first presentations first.
	textMorph := self findWherePresentationIs: text in: window.
	self assert: textMorph text asString equals: 'All 10'
	! !

!GLMDynamicMorphicTest methodsFor: 'tests' stamp: ''!
testWithPresentation
	| browser dynamic text textMorph |
	browser := GLMTabulator new column: #stacker; yourself.
	browser transmit to: #stacker; andShow: [:c | 
		c dynamic
			presentation: [:presentation :number |
					presentation text display: ['All ', number asString]]].
	window := browser openOn: 10.
	dynamic := browser panes first presentations first.
	text := dynamic cachedPresentation first.
	textMorph := self findWherePresentationIs: text in: window.
	self assert: textMorph text asString equals: 'All 10'! !

!GLMDynamicMorphicTest methodsFor: 'tests' stamp: ''!
testSurroundingPanel
	| browser dynamicContainerMorph |
	browser := GLMTabulator new.
	browser column: #one.
	browser transmit to: #one; andShow: [ :a | a dynamic presentation: [:some :object | some text ]].
	window := browser openOn: 4.

	dynamicContainerMorph := window submorphs last submorphs first submorphs first.
	self assert: (dynamicContainerMorph isKindOf: PanelMorph).
	self assert: (dynamicContainerMorph submorphs first isKindOf: PluggableTextMorph)! !

!GLMDynamicPresentation commentStamp: 'tg 9/20/2009 14:25'!
A GLMDynamicPresentation is a presentation that takes the actual presentation from the display value. Like this, we can have the block of display return a presentation depending on the input.

A usage for this behavior is the Glamorous Editor, which takes the text as input and based on this it displays the browser.!
!GLMDynamicPresentation methodsFor: 'rendering' stamp: 'TudorGirba 5/25/2013 12:11'!
cachedPresentation
	"currentPresentation applies the transformation dynamically.
	This means that calling it twice, will retrieve two different objects.
	To solve the problem, cachedPresentation stores the last currentPresentation, and 
	it can be used for further inspection"
	^ cachedPresentation! !

!GLMDynamicPresentation methodsFor: 'initialize-release' stamp: ''!
initialize 
	super initialize.
	presentationTransformation := [ :aComposite :each | aComposite custom: each ]! !

!GLMDynamicPresentation methodsFor: 'accessing' stamp: ''!
presentationTransformation: anObject
	presentationTransformation := anObject! !

!GLMDynamicPresentation methodsFor: 'rendering' stamp: ''!
renderGlamorouslyOn: aRenderer 
	self registerAnnouncements.
	^ aRenderer renderDynamicPresentation: self! !

!GLMDynamicPresentation methodsFor: 'accessing' stamp: ''!
presentationTransformation
	^ presentationTransformation! !

!GLMDynamicPresentation methodsFor: 'scripting' stamp: ''!
with: aBlock
	self presentationTransformation: aBlock! !

!GLMDynamicPresentation methodsFor: 'as yet unclassified' stamp: 'AndreiChis 10/29/2014 16:41'!
outerPortEvent: aPortEvent
	
	super outerPortEvent: aPortEvent.
	"Propage the event to cached presentations"
	self cachedPresentation ifNotNil: [ 
		self cachedPresentation outerPortEvent: aPortEvent ] ! !

!GLMDynamicPresentation methodsFor: 'scripting' stamp: ''!
presentation: aBlock
	self presentationTransformation: aBlock! !

!GLMDynamicPresentation methodsFor: 'rendering' stamp: 'AndreiChis 6/24/2013 13:24'!
currentPresentation 
	| composite |
	composite := GLMCompositePresentation new.
	self presentationTransformation glamourValue: (
			composite asGlamorousMultiValue, 
			self displayValue asGlamorousMultiValue).
	composite pane: self pane.
	composite initializePresentation.
	cachedPresentation := composite.
	^ composite
"	^ self displayValue pane: self pane"! !

!GLMDynamicPresentation methodsFor: 'enumerating' stamp: 'TudorGirba 5/25/2013 12:12'!
withAllPanesAndPresentationsDo: aBlock
	super withAllPanesAndPresentationsDo: aBlock.
	self cachedPresentation ifNotNil: [ :presentation | presentation withAllPanesAndPresentationsDo: aBlock ]! !

!GLMDynamicPresentationTest methodsFor: 'tests' stamp: 'TudorGirba 7/14/2011 10:44'!
testCachedPresentation
	| dynamic currentPresentation |
	dynamic := GLMDynamicPresentation new.
	dynamic entity: 42.
	dynamic transformation: [ :entity | GLMTextPresentation new ].
	currentPresentation := dynamic currentPresentation.

	self assert: dynamic cachedPresentation == currentPresentation! !

!GLMDynamicPresentationTest methodsFor: 'tests' stamp: 'AndreiChis 10/29/2014 16:28'!
testIndirectEventsPropagationTransformation
	| dynamic textPresentation counter |
	counter := 0.
	dynamic := GLMDynamicPresentation new.
	dynamic entity: '42'.
	dynamic display: [ :entity | textPresentation := GLMTextPresentation new ].
	"Build the presentation"
	dynamic currentPresentation.
	
	textPresentation announcer when: GLMContextChanged do: [ :ann |
		ann property = #selectionInterval
			ifTrue: [ counter := counter + 1 ] ].
	textPresentation selectionInterval: (1 to: 2).
	
	self assert: counter equals: 1.! !

!GLMDynamicPresentationTest methodsFor: 'tests' stamp: 'AndreiChis 6/24/2013 13:30'!
testPresentationInitializationBlock
	| dynamic count |
	count := 0.
	dynamic := GLMDynamicPresentation new.
	dynamic transformation: [ :entity | 
		GLMListPresentation new 
			initialize: [ :pres | 
				count := count +1.
				pres selection: 5 ] ].
	dynamic entity: (1 to: 42).
	self assert: count = 0.
	self assert: (dynamic currentPresentation presentations first selection = 5).
	self assert: count = 1! !

!GLMDynamicPresentationTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPresentationTransformation
	| dynamic |
	dynamic := GLMDynamicPresentation new.
	dynamic entity: 42.
	dynamic presentationTransformation: [ :some :entity | (1 to: entity) do: [ :each | some text title: each asString ] ].
	self assert: dynamic currentPresentation presentations size equals: 42.
	self assert: dynamic currentPresentation pane == dynamic pane! !

!GLMDynamicPresentationTest methodsFor: 'tests' stamp: 'AndreiChis 10/29/2014 16:36'!
testDirectEventsPropagationTransformation
	| dynamic textPresentation counter |
	counter := 0.
	dynamic := GLMDynamicPresentation new.
	dynamic entity: '42'.
	dynamic display: [ :entity | textPresentation := GLMTextPresentation new ].
	
	"Build the presentation"
	dynamic currentPresentation.
	
	textPresentation announcer when: GLMContextChanged do: [ :ann |
		counter := counter + 1 ].
	dynamic outerPortEvent: (GLMPortEvent on: 1 previouslyValued: 2).
	
	self assert: counter equals: 1.! !

!GLMDynamicPresentationTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testDefaultPresentation
	| dynamic |
	dynamic := GLMDynamicPresentation new.
	dynamic entity: 42.
	dynamic transformation: [ :entity | GLMTextPresentation new ].
	self assert: dynamic currentPresentation presentations size equals: 1.
	self assert: (dynamic currentPresentation presentations first isKindOf: GLMTextPresentation).
	self assert: dynamic currentPresentation pane == dynamic pane! !

!GLMEditableLabelBrick commentStamp: 'AliakseiSyrel 3/19/2015 15:22'!
A GLMEditableLabelBrick is improved label that can be edited in-place double-clicking on it or using edit icon

Instance Variables
	editBrick:		<Object>
	labelBrick:		<Object>

editBrick
	- xxxxx

labelBrick
	- xxxxx
!
!GLMEditableLabelBrick methodsFor: 'label-events' stamp: 'AliakseiSyrel 3/21/2015 20:31'!
onEscapePressed

	self isCancelOnEscape ifTrue: [ self cancel ]! !

!GLMEditableLabelBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 3/19/2015 15:32'!
hShrinkWrap
	super hShrinkWrap.
	
	self labelBrick hShrinkWrap.
	self editBrick hShrinkWrap! !

!GLMEditableLabelBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 3/19/2015 15:33'!
vShrinkWrap
	super vShrinkWrap.
	
	self labelBrick vShrinkWrap.
	self editBrick vShrinkWrap! !

!GLMEditableLabelBrick methodsFor: 'label-events' stamp: 'AliakseiSyrel 3/21/2015 02:19'!
onTextChanged: ann

	self onTextAccepted: ann! !

!GLMEditableLabelBrick methodsFor: 'label-brick-actions' stamp: 'AliakseiSyrel 3/24/2015 10:28'!
beNormal
	
	self isReadMode ifTrue: [ ^ self ].
	self animateToNormal.
	self removeBrick: self editBrick.
	self activeHand releaseKeyboardFocus.
	self addBrickBack: self labelBrick.
	self announce: #onReadMode! !

!GLMEditableLabelBrick methodsFor: 'label-brick-accessing' stamp: 'AliakseiSyrel 3/21/2015 01:17'!
borderAnimation

	^ borderAnimation ifNil: [ borderAnimation := GLMAnimation borderColor duration: 200 ]! !

!GLMEditableLabelBrick methodsFor: 'label-brick-accessing' stamp: 'AliakseiSyrel 3/19/2015 15:30'!
editBrick

	^ editBrick! !

!GLMEditableLabelBrick methodsFor: 'label-brick-actions' stamp: 'AliakseiSyrel 3/21/2015 20:44'!
cancel

	self borderColor: self themer color alizarin.
	self beNormal! !

!GLMEditableLabelBrick methodsFor: 'label-brick-accessing' stamp: 'AliakseiSyrel 3/21/2015 19:14'!
labelBrick: aBrick

	labelBrick := aBrick.
	
	self labelBrick
		textPosition: #leftCenter.
	
	self addBrickBack: labelBrick
	! !

!GLMEditableLabelBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 3/27/2015 01:16'!
hSpaceFill: anInteger
	super hSpaceFill: anInteger.
	
	self labelBrick hSpaceFill.
	self editBrick hSpaceFill! !

!GLMEditableLabelBrick methodsFor: 'label-brick-testing' stamp: 'AliakseiSyrel 3/21/2015 01:40'!
isReadMode

	^ self isEditMode not! !

!GLMEditableLabelBrick methodsFor: 'label-brick-creation' stamp: 'AliakseiSyrel 3/19/2015 15:23'!
newEditBrick

	^ GLMRubTextFieldBrick new! !

!GLMEditableLabelBrick methodsFor: 'reflective operations' stamp: 'AliakseiSyrel 3/19/2015 15:30'!
doesNotUnderstand: aMessage
	^ self labelBrick
		perform: aMessage selector
		withArguments: aMessage arguments! !

!GLMEditableLabelBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 3/21/2015 19:52'!
initialize
	super initialize.
	
	self labelBrick: self newLabelBrick.
	self editBrick: self newEditBrick.
	
	self
		padding: self themer focusedBorderWidth;
		borderWidth: self themer focusedBorderWidth;
		hShrinkWrap;
		vShrinkWrap;
		enable;
		enableDoubleClick;
		when: #onDoubleClicked do: [ (self hasSubbrick: self editBrick) ifFalse: [ self beEdit ] ];
		bindKeyCombination: Character escape toAction: [ self onEscapePressed ]! !

!GLMEditableLabelBrick methodsFor: 'label-brick-actions' stamp: 'AliakseiSyrel 3/21/2015 16:07'!
cancelOnEscape

	cancelOnEscape := true! !

!GLMEditableLabelBrick methodsFor: 'label-events' stamp: 'AliakseiSyrel 3/21/2015 20:40'!
onTextAccepted: ann
	|isChanged|
	
	isChanged := (self text asString = ann morph text asString) not.
	ann morph text isEmpty
		ifFalse: [ self accept ]
		ifTrue: [ self cancel ].
	isChanged ifTrue: [ self announce: #onAccepted ]! !

!GLMEditableLabelBrick methodsFor: 'label-brick-actions' stamp: 'AliakseiSyrel 3/24/2015 10:28'!
beEdit

	self isEditMode ifTrue: [ ^ self ].
	self editBrick updateTextWith: self labelBrick text.
	self editBrick moveCursorToIndex: self labelBrick text size + 1.

	self addBrickFirst: self editBrick.
	self removeBrick: self labelBrick.
	self borderColor: (self themer focusedBorderColor alpha: 0).
	self editBrick rubric takeKeyboardFocus.
	self announce: #onEditMode! !

!GLMEditableLabelBrick methodsFor: 'label-animation' stamp: 'AliakseiSyrel 3/21/2015 15:40'!
animateToEditNotFocused

	self borderAnimation
		from: self borderColor first;
		to: self themer normalBorderColor;
		animate: self! !

!GLMEditableLabelBrick methodsFor: 'label-brick-accessing' stamp: 'AliakseiSyrel 3/27/2015 13:49'!
editBrick: aBrick

	editBrick := aBrick.
	
	self editBrick
		hShrinkWrap;
		vShrinkWrap;
		withoutMargins;
		withoutAdornment;
		withoutBorder;
		beTransparent;
		autoAccept: true;
		rubricTextFamilyName: self themer textFamilyName;
		rubricTextFontSize: self themer textFontSize.
	
	self editBrick rubric forceHeight: [ self labelBrick height ].
	
	self editBrick rubric announcer weak subscribe: RubReturnEntered  send: #onTextAccepted: to: self.
	self editBrick rubric announcer weak subscribe: MorphLostFocus send: #onLostFocus to: self.
	self editBrick rubric announcer weak subscribe: MorphGotFocus send: #onGotFocus: to: self.
	self editBrick rubric announcer weak subscribe: RubTextAcceptRequest send: #onTextChanged: to: self! !

!GLMEditableLabelBrick methodsFor: 'label-events' stamp: 'AliakseiSyrel 3/21/2015 15:41'!
onGotFocus: ann

	self animateToEditFocused! !

!GLMEditableLabelBrick methodsFor: 'geometry' stamp: 'AliakseiSyrel 3/21/2015 19:09'!
approximateWidth
	
	^ self hMargin + self hPadding + (self isReadMode
		ifTrue: [ self labelBrick approximateWidth ]
		ifFalse: [ self editBrick width + self editBrick hPadding + self editBrick hMargin])! !

!GLMEditableLabelBrick methodsFor: 'label-animation' stamp: 'AliakseiSyrel 3/21/2015 15:40'!
animateToNormal

	self borderAnimation
		from: self borderColor first;
		to: (self borderColor first alpha: 0);
		animate: self! !

!GLMEditableLabelBrick methodsFor: 'label-animation' stamp: 'AliakseiSyrel 3/21/2015 15:40'!
animateToEditFocused

	self borderAnimation
		from: self borderColor first;
		to: self themer focusedBorderColor;
		animate: self! !

!GLMEditableLabelBrick methodsFor: 'label-brick-creation' stamp: 'AliakseiSyrel 3/19/2015 15:21'!
newLabelBrick

	^ GLMLabelBrick new! !

!GLMEditableLabelBrick methodsFor: 'label-brick-testing' stamp: 'AliakseiSyrel 3/21/2015 01:40'!
isEditMode

	^ self hasSubbrick: self editBrick! !

!GLMEditableLabelBrick methodsFor: 'label-brick-testing' stamp: 'AliakseiSyrel 3/21/2015 16:09'!
isCancelOnFocusLost

	^ cancelOnFocusLost ifNil: [ cancelOnFocusLost := false ]! !

!GLMEditableLabelBrick methodsFor: 'label-events' stamp: 'AliakseiSyrel 3/21/2015 20:35'!
onLostFocus
	
	self isCancelOnFocusLost & self isEditMode
		ifTrue: [ self cancel ].
	
	self isEditMode
		ifTrue: [ self animateToEditNotFocused ]
		ifFalse: [ self animateToNormal ]! !

!GLMEditableLabelBrick methodsFor: 'label-brick-actions' stamp: 'AliakseiSyrel 3/21/2015 16:08'!
cancelOnFocusLost

	cancelOnFocusLost := true! !

!GLMEditableLabelBrick methodsFor: 'label-brick-actions' stamp: 'AliakseiSyrel 3/21/2015 20:44'!
accept

	self text: self editBrick text.
	self borderColor: self themer color emerald.
	self beNormal! !

!GLMEditableLabelBrick methodsFor: 'label-brick-testing' stamp: 'AliakseiSyrel 3/21/2015 16:07'!
isCancelOnEscape

	^ cancelOnEscape ifNil: [ cancelOnEscape := false ]! !

!GLMEditableLabelBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 3/27/2015 01:15'!
vSpaceFill: anInteger
	super vSpaceFill: anInteger.
	
	self labelBrick vSpaceFill.
	self editBrick vSpaceFill.! !

!GLMEditableLabelBrick methodsFor: 'label-brick-accessing' stamp: 'AliakseiSyrel 3/19/2015 13:59'!
labelBrick

	^ labelBrick! !

!GLMEditableLabelBrick methodsFor: 'geometry' stamp: 'AliakseiSyrel 3/21/2015 02:03'!
approximateHeight
	
	^ self labelBrick approximateHeight + self vMargin + self vPadding! !

!GLMEditableLabelBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:26'!
exampleOpen

	self gtExample openCenteredInBrickWindow! !

!GLMEditableLabelBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:26'!
gtExample
	<gtExample: 'Editable label simple example'>
	^ self new
		text: 'Click me to edit. Press enter to accept';
		yourself! !

!GLMEmptyPopupBrick methodsFor: 'events-processing' stamp: 'AliakseiSyrel 3/26/2015 23:39'!
onCreated

	! !

!GLMEmptyPopupBrick methodsFor: 'opening' stamp: 'AliakseiSyrel 3/3/2015 10:29'!
close

	self foundationBrick delete! !

!GLMEmptyPopupBrick methodsFor: 'initialization' stamp: 'JurajKubelka 2/26/2015 23:37'!
outOfWorld: aWorld
	super outOfWorld: aWorld.
	
	self unsubscribeListeners! !

!GLMEmptyPopupBrick methodsFor: 'instance creation' stamp: 'JurajKubelka 2/26/2015 23:36'!
newContentBrick

	^ GLMBandBrick new! !

!GLMEmptyPopupBrick methodsFor: 'instance creation' stamp: 'JurajKubelka 2/26/2015 23:36'!
newTriggerBrick

	^ GLMActionButtonBrick new
		icon: (self anchorBrick
			ifNil: [ GLMUIThemeExtraIcons glamorousExample ]
			ifNotNil: [ self anchorBrick brickTransparentImageForm ]);
		width: [ :b | b icon width ];
		height: [ :b | b icon height ]! !

!GLMEmptyPopupBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/27/2015 14:22'!
addContentBricks
	
	self onCreated.
	contentLogic ifNotNil: [
		self contentBrick addAllBricks: ((contentLogic brickValue: self withEnoughArguments: { self triggerBrick }) asOrderedCollection select: #isNotNil) ].
	self announce: #onCreated event: self triggerBrick! !

!GLMEmptyPopupBrick methodsFor: 'opening' stamp: 'AliakseiSyrel 3/3/2015 10:37'!
beRightToLeftWithOffset: anOffset

	self invalidateWith: [
		self triggerBrick hAlign: #right.
		self triggerBrick marginRight: anOffset.
		self foundationBrick bounds: (self foundationBrick bounds translateBy: (self width - self triggerBrick width - anOffset @ 0) negated ) ]! !

!GLMEmptyPopupBrick methodsFor: 'events-processing' stamp: 'JurajKubelka 2/27/2015 13:03'!
isInsideOfPopupBrick: anEvent
	^ (self isInsideOfTriggerBrick: anEvent) | (self isInsideOfContentBrick: anEvent)! !

!GLMEmptyPopupBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 3/26/2015 23:39'!
onCreated: aBlock

	contentLogic := aBlock! !

!GLMEmptyPopupBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/27/2015 11:40'!
contentBrick: aBrick

	contentBrick := aBrick.
	self contentBrick
		vShrinkWrap;
		hShrinkWrap;
		padding: self themer popupThemer borderWidth;
		color: self themer popupThemer backgroundColor; 
		borderColor: self themer popupThemer borderColor;
	 	borderWidth: self themer popupThemer borderWidth.
	self addBrickBack: contentBrick

	! !

!GLMEmptyPopupBrick methodsFor: 'initialization' stamp: 'JurajKubelka 2/26/2015 23:30'!
beHelp

	self themer: self themer popupHelpThemer themer! !

!GLMEmptyPopupBrick methodsFor: 'initialization' stamp: 'JurajKubelka 2/26/2015 23:33'!
initialize
	super initialize.
	
	self
		initializeListeners;
		useVerticalLinearLayout;
		vShrinkWrap;
		hShrinkWrap;
		enable.
	
	
	! !

!GLMEmptyPopupBrick methodsFor: 'accessing' stamp: 'JurajKubelka 2/26/2015 23:32'!
anchorBrick: aBrick

	anchorBrick := aBrick! !

!GLMEmptyPopupBrick methodsFor: 'opening' stamp: 'JurajKubelka 2/27/2015 13:13'!
openFor: aBrick
	^ self openAboveFor: aBrick! !

!GLMEmptyPopupBrick methodsFor: 'events-processing' stamp: 'AndreiChis 3/2/2015 15:05'!
isInsideOfContentBrick: anEvent
	^ self contentBrick 
		ifNil: [false]
		ifNotNil: [:aBrick | aBrick boundsInWorld containsPoint: anEvent position]! !

!GLMEmptyPopupBrick methodsFor: 'accessing' stamp: 'JurajKubelka 2/26/2015 23:32'!
anchorBrick

	^ anchorBrick! !

!GLMEmptyPopupBrick methodsFor: 'accessing' stamp: 'JurajKubelka 2/26/2015 23:35'!
triggerBrick

	^ triggerBrick! !

!GLMEmptyPopupBrick methodsFor: 'events-processing' stamp: 'AliakseiSyrel 3/27/2015 01:50'!
handleListenEvent: anEvent

	self isHideUnhover not & (anEvent type = #mouseMove)
		ifTrue: [ ^ self ].

	(self isInsideOfPopupBrick: anEvent) ifFalse: [ self close ]! !

!GLMEmptyPopupBrick methodsFor: 'initialization' stamp: 'JurajKubelka 2/26/2015 23:33'!
initializeListeners

	"using the most general event subscribtion for all events spawned by the hand"
	self activeHand addEventListener: self.! !

!GLMEmptyPopupBrick methodsFor: 'opening' stamp: 'AliakseiSyrel 3/27/2015 13:55'!
openBelow: aRectangle
	"aRectangle must be in global coordinates"
	^ self asBrickedMorph
		vShrinkWrap;
		hShrinkWrap;
		bounds: (aRectangle origin extent: (self extent + (0@self themer popupThemer borderWidth)));
		openInWorld
	! !

!GLMEmptyPopupBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/27/2015 00:03'!
triggerBrick: aBrick

	triggerBrick := aBrick.
	self triggerBrick
		color: self themer popupThemer backgroundColor;
		borderColor: self themer popupThemer borderColor;
		borderWidth: self themer popupThemer borderWidth;
		action: [ :b :evt | self close. self anchorBrick click: evt ].
		
	self addBrickBack: self triggerBrick.! !

!GLMEmptyPopupBrick methodsFor: 'initialization' stamp: 'JurajKubelka 2/26/2015 23:30'!
beSuccess

	self themer: self themer popupSuccessThemer themer! !

!GLMEmptyPopupBrick methodsFor: 'opening' stamp: 'AliakseiSyrel 3/27/2015 13:55'!
openAbove: aRectangle
	"aRectangle must be in global coordinates"
	^ self asBrickedMorph
		vShrinkWrap;
		hShrinkWrap;
		bounds: ((aRectangle origin - (0@self contentBrick height) + (0@self themer popupThemer borderWidth)) extent: self extent);
		openInWorld
	! !

!GLMEmptyPopupBrick methodsFor: 'actions' stamp: 'AliakseiSyrel 3/27/2015 01:49'!
isHideUnhover

	^ isHideUnhover ifNil: [ isHideUnhover := true ]! !

!GLMEmptyPopupBrick methodsFor: 'accessing' stamp: 'JurajKubelka 2/26/2015 23:36'!
contentBrick

	^ contentBrick

	! !

!GLMEmptyPopupBrick methodsFor: 'opening' stamp: 'AliakseiSyrel 3/27/2015 00:46'!
openBelowFor: aBrick

	self anchorBrick: aBrick.
	self triggerBrick: self newTriggerBrick.
	self contentBrick: self newContentBrick.
	self triggerBrick zIndex: 2.
	self triggerBrick
		borderDo: [ :b | b widthBottom: 0 ];
		marginBottom: self themer popupThemer borderWidth negated.
	self addContentBricks.
	
	^ aBrick ifNotNil: [ self openBelow: aBrick boundsInWorld ]! !

!GLMEmptyPopupBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/3/2015 10:28'!
foundationBrick

	^ (self owner isKindOf: GLMFoundationBrick)
		ifTrue: [ self owner ]
		ifFalse: [ self ]! !

!GLMEmptyPopupBrick methodsFor: 'actions' stamp: 'AliakseiSyrel 3/27/2015 01:48'!
doNotHideUnhover

	isHideUnhover := false! !

!GLMEmptyPopupBrick methodsFor: 'opening' stamp: 'AliakseiSyrel 3/27/2015 00:03'!
openAboveFor: aBrick

	self anchorBrick: aBrick.
	self contentBrick: self newContentBrick.
	self triggerBrick: self newTriggerBrick.
	self triggerBrick
		borderDo: [ :b | b widthTop: 0 ];
		marginTop: self themer popupThemer borderWidth negated.
	self addContentBricks.
	
	^ aBrick ifNotNil: [ self openAbove: aBrick boundsInWorld ]! !

!GLMEmptyPopupBrick methodsFor: 'events-processing' stamp: 'AndreiChis 3/2/2015 15:05'!
isInsideOfTriggerBrick: anEvent
	^ self triggerBrick 
		ifNil: [false]
		ifNotNil: [:aBrick | aBrick boundsInWorld containsPoint: anEvent position ]! !

!GLMEmptyPopupBrick methodsFor: 'initialization' stamp: 'JurajKubelka 2/26/2015 23:30'!
beError

	self themer: self themer popupErrorThemer themer! !

!GLMEmptyPopupBrick methodsFor: 'initialization' stamp: 'JurajKubelka 2/26/2015 23:37'!
unsubscribeListeners

	self activeHand removeEventListener: self! !

!GLMEmptyPopupBrick class methodsFor: 'examples' stamp: 'AliakseiSyrel 3/22/2015 11:53'!
createButton: hoverAction

	^ (GLMActionButtonBrick new
			color: Color white;
			icon: GLMUIThemeExtraIcons glamorousBrowse;
			hoverAction: hoverAction;
			width: [ :b | b icon width * 2 ];
			height: [ :b | b icon height * 2 ])! !

!GLMErrorPopper commentStamp: 'AndreiChis 10/1/2014 13:03'!
I am a popper that displays an error message.

GLMErrorPopper simpleErrorPopper!
!GLMErrorPopper methodsFor: 'initialization' stamp: 'TudorGirba 8/1/2014 22:47'!
initialize
	super initialize.
	self initializeTextMorph! !

!GLMErrorPopper methodsFor: 'initialization' stamp: 'TudorGirba 8/1/2014 22:46'!
initializeTextMorph
	textMorph := RubScrolledTextMorph new.
	textMorph
		beReadOnly;
		beWrapped;
		color: Color paleRed.
	self
		vResizing: #spaceFill;
		hResizing: #spaceFill;
		addMorph: textMorph fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 1))! !

!GLMErrorPopper methodsFor: 'initialization' stamp: 'AndreiChis 1/14/2015 12:18'!
withString: string from: aMorph

	aMorph textArea removeHighlightSegment.
	super withString: string from: aMorph! !

!GLMErrorPopper class methodsFor: 'examples' stamp: 'AndreiChis 10/1/2014 13:24'!
simpleErrorPopper
	"
	self simpleErrorPopper
	"

	(GLMErrorPopper new 
		withString: 'error message goes here' 
		from: RubScrolledTextMorph new) openInWorld! !

!GLMEvaluateSelection commentStamp: 'AndreiChis 5/6/2014 17:55'!
I am event indicating to the renderer to execute the currently selected text and perform an action with the result.!
!GLMEvaluateSelection methodsFor: 'accessing' stamp: 'AndreiChis 1/30/2015 14:45'!
initialize
	super initialize.
	isSyncronous := false! !

!GLMEvaluateSelection methodsFor: 'accessing' stamp: 'AndreiChis 1/30/2015 14:57'!
isSyncronous
	^ isSyncronous! !

!GLMEvaluateSelection methodsFor: 'accessing' stamp: 'AndreiChis 3/6/2014 14:53'!
action: anObject
	action := anObject! !

!GLMEvaluateSelection methodsFor: 'accessing' stamp: 'AndreiChis 1/30/2015 14:46'!
makeSyncronous
	isSyncronous := true! !

!GLMEvaluateSelection methodsFor: 'accessing' stamp: 'AndreiChis 3/6/2014 14:53'!
action
	^ action! !

!GLMExamples commentStamp: 'AndreiChis 8/28/2014 17:00'!
I am an abstract class used to group a series of examples.
My subclasses should define each example within a method and annotated the method with the pragma #glmBrowser:input: !
!GLMExamples class methodsFor: 'accessing' stamp: ''!
allExamples 
	^ Pragma allNamed: #glmBrowser:input: in: self! !

!GLMExamples class methodsFor: 'accessing' stamp: ''!
title
	^ 'Examples'! !

!GLMExamples class methodsFor: 'opening' stamp: 'TudorGirba 5/25/2013 12:08'!
open
	^ GLMExamplesBrowser new 
		title: self title;
		openOn: self! !

!GLMExamplesBrowser commentStamp: 'AndreiChis 10/20/2014 10:08'!
self new  openOn: GLMBasicExamples!
!GLMExamplesBrowser methodsFor: 'building' stamp: 'TudorGirba 9/9/2012 02:51'!
compose
	"self new openOn: GLMBasicExamples"

	self tabulator with: [:browser | 
		browser
			column: #titles;
			column: #example span: 4.
		browser transmit
			to: #titles;
			andShow: [ :a | self exampleListIn: a ].
		browser transmit
			to: #example;
			fromOutsidePort: #entity;
			from: #titles;
			andShow: [ :a | self exampleIn: a ] ]! !

!GLMExamplesBrowser methodsFor: 'private' stamp: 'AndreiChis 10/27/2014 10:17'!
exampleBrowserForPragma: each in: aClass
	| exampleBrowser wrapperBrowser |
	exampleBrowser := aClass new perform: each selector.

	wrapperBrowser := GLMTabulator new.
	wrapperBrowser column: #theOuterPane.
	wrapperBrowser transmit
		fromOutsideEntityPort; 
		to: #theOuterPane;
		andShow: [:a | 
			a custom: exampleBrowser ].
	^ wrapperBrowser startOn: (Smalltalk compiler evaluate: (each argumentAt: 2) logged: false)! !

!GLMExamplesBrowser methodsFor: 'building' stamp: 'AndreiChis 8/28/2014 17:13'!
exampleIn: composer
	| dynamicPresentation |
	dynamicPresentation := composer dynamic
		title: 'Browser';
		display: [ :exampleClass :examplePragma | self exampleBrowserForPragma: examplePragma in: exampleClass ].
	self flag: 'openTree is a method that depends on Roassal. It is not loaded in the core version of Glamour. A better solution is needed here for loading this actions maybe based on pragmas.'.
	(GLMBrowser canUnderstand: #openTree) ifTrue: [ 
		dynamicPresentation act: [ :dynamic | 
				dynamic cachedPresentation presentations first panes first presentations first openTree ] 
			entitled: 'View browser tree' ].
		
	composer smalltalkCode
		title: 'Source code';
		act: [ :text :exampleClass :examplePragma | Smalltalk tools browser fullOnClass: exampleClass selector: examplePragma selector ]
			icon: GLMUIThemeExtraIcons glamorousBrowse
			entitled: 'Browse';
		smalltalkClass: [ :exampleClass | exampleClass ];
		doItReceiver: [ :exampleClass | exampleClass ];
		display: [ :exampleClass :pragma | exampleClass sourceCodeAt: pragma selector ]! !

!GLMExamplesBrowser methodsFor: 'building' stamp: ''!
exampleListIn: a
	^ a list
		title: 'Examples';
		display: [ :exampleClass | exampleClass allExamples ];
		sorted: [ :x :y | (x argumentAt: 1) < (y argumentAt: 1) ];
		format: [ :each | each argumentAt: 1 ]! !

!GLMExamplesBrowser class methodsFor: 'user interface' stamp: 'TorstenBergmann 3/10/2015 21:49'!
open
	<script>
	
	self new openOn: GLMBasicExamples! !

!GLMExpander commentStamp: 'DamienCassou 7/26/2011 19:10'!
GLMExpander aims to implement a Hopscotch-like browser. This is similar to a tree where each tree node content is itself a presentation.!
!GLMExpander methodsFor: 'events' stamp: 'TudorGirba 1/9/2011 01:34'!
outerPortEvent: aPortEvent 
	 
	aPortEvent port name = #entity ifFalse: [^self]. 
	panes := nil. 
	self matches ifTrue: [
		"We only want to execute the transformation if the visibility condition matches"
		(self transformation glamourValue: aPortEvent port value) do: [:each |
			self addPaneFrom: (GLMSimplePort new value: each) ] ]! !

!GLMExpander methodsFor: 'rendering' stamp: 'TudorGirba 1/2/2011 18:59'!
renderGlamorouslyOn: aRenderer 
	^ aRenderer renderExpander: self! !

!GLMExpander methodsFor: 'events' stamp: 'TudorGirba 1/9/2011 01:46'!
innerPortEvent: aPortEvent 
	 
	aPortEvent portName = #entity ifFalse: [
		"We resend the value to the outer pane"
		"We don't want to resend the transmission, but use a new SimpleTransmission." 
		(self pane port: aPortEvent portName) value: aPortEvent value]! !

!GLMExpander methodsFor: 'events' stamp: 'AndreiChis 5/30/2013 21:50'!
addPaneFrom: aPort 
	self panes addLast: (GLMPane in: self).
	self newTransmission
		addActiveOrigin: aPort; 
		destination: (self panes last port: #entity); 
		transmit.
	self announce: 
			(GLMPaneAdded 
				pane: self panes last 
				atPosition: self panes size 
				inBrowser: self)! !

!GLMExpanderContentsNodeModel methodsFor: 'callbacks' stamp: 'TudorGirba 2/15/2011 12:25'!
elementColumn
	| row morph |
	
	morph := GLMMorphicPaneWithoutTitleRenderer new render: self containerNode item.
	morph 
		borderStyle: (UITheme current buttonSelectedBorderStyleFor: morph).

	row := OrderedCollection with: morph.
	^ UITheme current newRowIn: World for: row! !

!GLMExpanderContentsNodeModel methodsFor: 'accessing' stamp: 'TudorGirba 1/5/2011 16:49'!
containerNode: anObject
	containerNode := anObject! !

!GLMExpanderContentsNodeModel methodsFor: 'accessing' stamp: 'TudorGirba 1/5/2011 16:49'!
containerNode
	^ containerNode! !

!GLMExpanderContentsNodeModel methodsFor: 'accessing' stamp: 'TudorGirba 1/5/2011 14:09'!
icon
	^ nil! !

!GLMExpanderLabelNodeModel methodsFor: 'callbacks' stamp: 'TudorGirba 1/5/2011 23:21'!
elementColumn
	| row tags tagsFilter |
	row := OrderedCollection with: (self displayText).
	
"	tags:= self containerTree glamourPresentation tagsFor: self item to: #show.
	tagsFilter := self containerTree glamourPresentation tagsFor: self item to: #filter.
	tags withIndexDo:[ :each :index | 
			row addLast: (self buttonForTag: each 
									  filter: (tagsFilter at: index ifAbsentPut:[ each ])) ].
"	^ (UITheme current newRowIn: World for: row) fillStyle: Color veryLightGray! !

!GLMExpanderLabelNodeModel methodsFor: 'accessing' stamp: 'TudorGirba 1/5/2011 14:20'!
icon
	^ nil! !

!GLMExpanderLabelNodeModel methodsFor: 'callbacks' stamp: 'TudorGirba 1/5/2011 17:24'!
childrenItems
	^ OrderedCollection 
		with: ((GLMExpanderContentsNodeModel with: (self->self item)) containerNode: self)! !

!GLMExpanderLabelNodeModel methodsFor: 'accessing' stamp: 'TudorGirba 1/3/2011 14:10'!
displayText
	^ UITheme current 
		newTextIn: World
		text: (self item presentations titleValue ifNil: ['noname']) ! !

!GLMExpanderLabelNodeModel methodsFor: 'callbacks' stamp: 'TudorGirba 1/5/2011 10:50'!
contents
	^ self childrenItems! !

!GLMExpanderLabelNodeModel methodsFor: 'accessing' stamp: 'TudorGirba 1/3/2011 13:53'!
containerTree: anObject
	containerTree := anObject! !

!GLMExpanderLabelNodeModel methodsFor: 'accessing' stamp: 'TudorGirba 1/3/2011 13:53'!
containerTree
	^ containerTree! !

!GLMExpanderLabelNodeModel class methodsFor: 'instance creation' stamp: 'TudorGirba 1/2/2011 21:16'!
with: anObject in: aTreeModel
	^ (self with: anObject) containerTree: aTreeModel; yourself! !

!GLMExpanderMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 3/21/2012 21:55'!
testCreation
	| browser |
	browser := GLMExpander new.
	browser show: [ :a | a text ].
	window := browser openOn: #(#a #b #c).
	self assert: window submorphs last class equals: GeneralScrollPane.
	self assert: window submorphs last scrollTarget submorphs size equals: 3.
	self assert: window submorphs last scrollTarget submorphs first complexContents class equals: ExpanderMorph! !

!GLMExpanderTest methodsFor: 'tests' stamp: 'DamienCassou 7/2/2011 14:33'!
testConditionWhenEmbedded
	| expander tabulator |
	expander := GLMExpander new.
	expander display: [ :x :y | x + y ].
	expander show: [ :a | a text display: [ :x :y | x asString , y asString ] ].
	tabulator := GLMTabulator new.
	tabulator
		column: #one;
		column: #two.
	(tabulator transmit)
		to: #two;
		fromOutsidePort: #entity;
		from: #one port: #nilPort;
		andShow: [ :a | a custom: expander ].
	self shouldnt: [ tabulator startOn: 1 ] raise: Error! !

!GLMExpanderTest methodsFor: 'tests' stamp: 'DamienCassou 7/2/2011 14:33'!
testAllowNilConditionWhenEmbedded
	| expander tabulator |
	expander := GLMExpander new.
	expander allowNil.
	expander display: [ :x :y | x + y ].	"should lead to an error because nil is allowed in the block"
	expander show: [ :a | a text display: [ :x :y | x asString , y asString ] ].
	tabulator := GLMTabulator new.
	tabulator
		column: #one;
		column: #two.
	(tabulator transmit)
		to: #two;
		fromOutsidePort: #entity;
		from: #one port: #nilPort;
		andShow: [ :a | a custom: expander ].
	self should: [ tabulator startOn: 1 ] raise: Error! !

!GLMExpanderTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPresentations
	| expander |
	expander := GLMExpander new.
	expander show: [ :a | a text ].
	expander startOn: #(#a #b #c).
	self assert: expander panes size equals: 3.
	self assert: expander panes first presentations entity value equals: #a.
	self assert: expander panes first presentations size equals: 1.
	self assert: (expander panes first presentations first isKindOf: GLMTextPresentation)! !

!GLMExpanderTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testSimple
	| expander |
	expander := GLMExpander new.
	expander startOn: #(#a #b #c).
	self assert: expander panes size equals: 3.
	self assert: (expander panes first port: #entity) value equals: #a! !

!GLMExpanderTest methodsFor: 'tests' stamp: 'tg 5/1/2010 12:29'!
testCreation
	self assert: GLMExpander new panes isEmpty! !

!GLMExpanderTreeMorphModel methodsFor: 'accessing' stamp: 'TudorGirba 1/3/2011 14:07'!
roots
"	| filtered |"
	roots ifNil: [ self roots: self glamourExpander panes ].
	^ roots
"	filtered := roots select: [ :each | each shouldBeDisplayed ].
	((self shouldFilterByAmount and: [
		self amountToFilterBy < filtered size]) and: [
			filtered notEmpty]) ifTrue: [
		filtered := filtered first: self amountToFilterBy ].
	^ filtered"! !

!GLMExpanderTreeMorphModel methodsFor: 'accessing' stamp: 'TudorGirba 1/2/2011 19:32'!
glamourExpander: anObject
	glamourExpander := anObject! !

!GLMExpanderTreeMorphModel methodsFor: 'accessing' stamp: 'TudorGirba 1/2/2011 19:32'!
glamourExpander
	^ glamourExpander! !

!GLMExpanderTreeMorphModel methodsFor: 'accessing' stamp: 'TudorGirba 1/4/2011 15:06'!
nodeModelFor: anObject
	^ GLMExpanderLabelNodeModel with: anObject in: self! !

!GLMExpanderTreeMorphModel methodsFor: 'accessing' stamp: 'TudorGirba 1/3/2011 13:52'!
roots: anObjectOrCollection
	roots := anObjectOrCollection isCollection 
		ifTrue: [ anObjectOrCollection collect: [:each | self nodeModelFor: each ] ]
		ifFalse: [ OrderedCollection with: (self nodeModelFor: anObjectOrCollection) ]! !

!GLMExplicitBrowser commentStamp: 'TudorGirba 2/4/2011 17:50'!
A GLMExplicitBrowser is a browser that allows the user to explicitly define the panes and the flow of transmissions between them.!
!GLMExplicitBrowser methodsFor: 'scripting' stamp: 'DamienCassou 7/9/2011 20:19'!
showOn: aDestinationPane 
	"send this message when at the beginning of specifying a Transmission" 
	 
	self addTransmission: (
		GLMTransmission new
			ensureReplacePresentationsStrategy;
			destination: (self resolveDestinationPort: aDestinationPane); 
			yourself)! !

!GLMExplicitBrowser methodsFor: 'accessing' stamp: 'jorge.ressia 6/2/2009 23:25'!
updateContextWith: aPane 
! !

!GLMExplicitBrowser methodsFor: 'events' stamp: 'DamienCassou 7/3/2011 19:52'!
innerPortEvent: aPortEvent
	| wantedTransmissions |
	aPortEvent hasChanged
		ifFalse: [ ^ self ].
	wantedTransmissions := self transmissions
		select: [ :each | (each originatesAt: aPortEvent port) and: [ (aPortEvent transmissionContext includesPort: each destination) not ] ].
	wantedTransmissions do: [ :each | each transmitIn: aPortEvent transmissionContext copy ]! !

!GLMExplicitBrowser methodsFor: 'scripting' stamp: ' 4/5/09 22:18'!
sendTo: aDesinationPortReference fromOutside: anOriginPortName 
	"this is a shortcut method for propagating inside an outer port name to an inner port reference" 
	 
	self 
		sendTo: aDesinationPortReference 
		from: #outer -> anOriginPortName! !

!GLMExplicitBrowser methodsFor: 'scripting' stamp: 'TudorGirba 12/2/2010 20:10'!
fromOutside: aPortName
	 ^ self fromOutsidePort: aPortName! !

!GLMExplicitBrowser methodsFor: 'scripting' stamp: 'tg 1/11/2010 20:38'!
from: anOriginPortReference 
	"send this message after showOn: to specify an origin for the Transmission. 
	you can cascade several from: to specify additional origins" 
	 
	self lastTransmission 
		addActiveOrigin: (self resolveOriginPort: anOriginPortReference)! !

!GLMExplicitBrowser methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
paneNamed: aSymbol 
	 
	^self panes detect: [:each | each name = aSymbol]! !

!GLMExplicitBrowser methodsFor: 'accessing' stamp: 'jorge.ressia 6/2/2009 21:48'!
addNewPane
	
	^self addNewPaneNamed: 'undefined'! !

!GLMExplicitBrowser methodsFor: 'accessing' stamp: 'tg 1/11/2010 20:37'!
lastTransmission
	^ self transmissions last! !

!GLMExplicitBrowser methodsFor: 'scripting' stamp: 'tg 1/11/2010 20:38'!
passivelyFrom: anOriginPortReference 
	"passivelyForm: is similar to from: only the origin will be a passive one. 
	in other words, a change in the origin port will not initiate a Transmission" 
	 
	self lastTransmission
		addPassiveOrigin: (self resolveOriginPort: anOriginPortReference)! !

!GLMExplicitBrowser methodsFor: 'scripting' stamp: 'TudorGirba 12/2/2010 20:10'!
fromOutsidePort: aPortName
	 ^ self from: #outer->aPortName! !

!GLMExplicitBrowser methodsFor: 'scripting' stamp: 'tg 1/14/2010 16:10'!
sendTo: aDesinationPortReference from: anOriginPortReference with: aBlock 
	"this message links two port references with a transmission that holds no presentation" 
	 
	self transmissions 
		addLast: 
			((GLMTransmission new) 
				addActiveOrigin: (self resolveOriginPort: anOriginPortReference); 
				destination: (self resolveDestinationPort: aDesinationPortReference); 
				transformation: aBlock; 
				yourself)! !

!GLMExplicitBrowser methodsFor: 'accessing' stamp: 'tg 3/31/2010 22:49'!
addNewPaneNamed: aString
	^ self addPane: (GLMPane named: aString in: self)! !

!GLMExplicitBrowser methodsFor: 'scripting' stamp: 'tg 1/11/2010 20:39'!
custom: aPresentation 
	"this message sets a custom presentation to the current Transmission. 
	it is to be used within the using: block. 
	this message is particularly useful when you want to set a browser as a presentation" 
	 
	self lastTransmission addPresentation: aPresentation. 
	^ aPresentation! !

!GLMExplicitBrowser methodsFor: 'scripting' stamp: ' 4/5/09 22:18'!
sendToOutside: aPortName from: anOriginPortReference 
	"this is a shortcut method for exposing an inner port reference as an outer port name" 
	 
	self 
		sendTo: #outer -> aPortName 
		from: anOriginPortReference! !

!GLMExplicitBrowser methodsFor: 'scripting' stamp: 'tg 1/14/2010 16:10'!
sendTo: aDesinationPortReference from: anOriginPortReference 
	"this message links two port references with a transmission that holds no presentation" 
	 
	self transmissions 
		addLast: 
			((GLMTransmission new) 
				addActiveOrigin: (self resolveOriginPort: anOriginPortReference); 
				destination: (self resolveDestinationPort: aDesinationPortReference); 
				yourself)! !

!GLMExplicitBrowserCopyTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testTrasmissions
	self assert: copiedBrowser transmissions size equals: 2.
	self assert: copiedBrowser transmissions first ~~ browser transmissions first.
	self assert: copiedBrowser transmissions last ~~ browser transmissions last.
	self assert: (copiedBrowser transmissions first destination pane browser isKindOf: GLMNoBrowser).
	self assert: copiedBrowser transmissions last destination pane browser == copiedBrowser.
	self assert: copiedBrowser transmissions first origins first pane browser == copiedBrowser.
	self assert: copiedBrowser transmissions last origins first pane browser == copiedBrowser! !

!GLMExplicitBrowserCopyTest methodsFor: 'tests' stamp: 'tg 8/22/2010 15:45'!
testEquality
	self assert: (copiedBrowser = browser) not! !

!GLMExplicitBrowserCopyTest methodsFor: 'tests' stamp: 'DamienCassou 7/9/2011 20:19'!
setUp
	| pane1 pane2 transmission1 transmission2 | 
	browser := GLMExplicitBrowser new. 
	
	pane1 := browser addNewPane name: 'pane1'. 
	pane2 := browser addNewPane name: 'pane2'. 
	transmission1 := GLMTransmission new
		addActiveOrigin: (pane2 port: #selection); 
		destination: (GLMPresentationBoundPort new name: #selection; presentation: browser; yourself); 
		yourself.  
	browser addTransmission: transmission1. 
	transmission2 := GLMTransmission new 
		ensureReplacePresentationsStrategy;
		addActiveOrigin: (pane1 port: #selection); 
		destination: (pane2 port: #entity); 
		addPresentation: (GLMPresentation new title: 'presentation1');
		yourself.  
	browser addTransmission: transmission2. 
	copiedBrowser := browser copy! !

!GLMExplicitBrowserCopyTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPanes
	self assert: copiedBrowser panes size equals: 2.
	self assert: copiedBrowser panes first ~~ browser panes first.
	self assert: copiedBrowser panes last ~~ browser panes last.
	self assert: copiedBrowser panes first browser == copiedBrowser.
	self assert: copiedBrowser panes last browser == copiedBrowser.
	self assert: copiedBrowser panes first ports size equals: 1.
	self assert: copiedBrowser panes first ports first name equals: #selection.
	self assert: copiedBrowser panes first ports first pane == copiedBrowser panes first.
	self assert: copiedBrowser panes last ports size equals: 2.
	self assert: copiedBrowser panes last ports first name equals: #selection.
	self assert: copiedBrowser panes last ports last name equals: #entity! !

!GLMExplicitBrowserTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPresentationBoundPort
	| browser outerPort1 outerPort2 transmission1 transmission2 |
	browser := GLMExplicitBrowser new.
	browser addNewPane.
	GLMTestPane new addPresentation: browser.
	outerPort1 := (GLMPresentationBoundPort new)
		presentation: browser;
		name: #outerPort1;
		yourself.
	outerPort2 := (GLMPresentationBoundPort new)
		presentation: browser;
		name: #outerPort2;
		yourself.	"Capturing"
	browser
		addTransmission:
			(transmission1 := (GLMMockSimpleTransmission new)
				addActiveOrigin: outerPort1;
				destination: (browser panes first port: #innerPort1);
				yourself).	"Publishing"
	browser
		addTransmission:
			((transmission2 := GLMMockSimpleTransmission new)
				addActiveOrigin: (browser panes first port: #innerPort2);
				destination: outerPort2;
				yourself).
	(browser pane port: #outerPort1) value: 42.
	self assert: (browser panes first port: #innerPort1) value equals: 42.
	self assert: transmission1 wasTransmited.
	self deny: transmission2 wasTransmited.	"self assert: (browser pane port: #outerPort1) seenTransmissions size = 0. "	"self 
		assert: 
			((browser pane port: #outerPort1) seenTransmissions first isKindOf: 
					GLMSimpleTransmission). 
	self 
		assert: 
			((browser pane port: #outerPort1) seenTransmissions first origin isKindOf: 
					GLMSimplePort). 
	self 
		assert: 
			(browser pane port: #outerPort1) seenTransmissions first destination 
				== (browser pane port: #outerPort1). "	"self 
		assert: 
			(browser panes first port: #innerPort1) seenTransmissions size = 1. 
	self 
		assert: 
			(browser panes first port: #innerPort1) seenTransmissions first 
				== browser transmissions first. "
	(browser panes first port: #innerPort2) value: 43.
	self assert: (browser pane port: #outerPort2) value equals: 43	"self 
		assert: 
			(browser panes first port: #innerPort2) seenTransmissions size = 0. "	"self 
		assert: 
			((browser panes first port: #innerPort2) seenTransmissions first isKindOf: 
					GLMSimpleTransmission). 
	self 
		assert: 
			((browser panes first port: #innerPort2) seenTransmissions first origin 
				isKindOf: GLMSimplePort). 
	self 
		assert: 
			(browser panes first port: #innerPort2) seenTransmissions first destination 
				== (browser panes first port: #innerPort2). "	"self assert: (browser pane port: #outerPort2) seenTransmissions size = 1. 
	self 
		assert: 
			(browser pane port: #outerPort2) seenTransmissions first 
				== browser transmissions last"! !

!GLMExplicitBrowserTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testSimpleTransmission
	| browser pane1 pane2 presentation1 presentation2 transmission announcement |
	browser := GLMExplicitBrowser new.
	presentation1 := GLMPresentation new.
	presentation2 := GLMPresentation new.
	pane1 := browser addNewPane.
	pane2 := browser addNewPane.
	pane1 addPresentation: presentation1.
	pane2 addPresentation: presentation2.
	transmission := (GLMMockSimpleTransmission new)
		addActiveOrigin: (pane1 port: #selection);
		destination: (pane2 port: #entity);
		yourself.
	browser addTransmission: transmission.
	announcement := nil.
	presentation2 when: GLMContextChanged do: [ :ann | announcement := ann ].
	presentation1 selection: 'foo'.
	self assert: transmission wasTransmited.	"self assert: (pane1 port: #selection) seenTransmissions size = 0. 
	self assert: (pane2 port: #entity) seenTransmissions size = 1."	"self 
		assert: (pane1 port: #selection) seenTransmissions first ~~ transmission. "	"self assert: (pane2 port: #entity) seenTransmissions first == transmission. "
	self assert: (pane1 port: #selection) value equals: 'foo'.
	self assert: (pane2 port: #entity) value equals: 'foo'.
	self assert: announcement notNil! !

!GLMExplicitBrowserTest methodsFor: 'tests' stamp: 'tg 1/14/2010 16:10'!
testAddTransmissionReturn
	| transmission |
	transmission := GLMTransmission new.
	self assert: (GLMExplicitBrowser new addTransmission: transmission) == transmission! !

!GLMExplicitBrowserTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testJumpstartTransmission
	| browser presentation |
	browser := GLMExplicitBrowser new.
	presentation := GLMPresentation new.
	browser addNewPane.
	browser
		addTransmission:
			((GLMTransmission new)
				ensureReplacePresentationsStrategy;
				addActiveOrigin: (browser pane port: #entity);
				destination: (browser panes first port: #entity);
				addPresentation: presentation;
				yourself).
	self assert: (browser panes first port: #entity) value isNil.
	self assert: browser panes first presentations isEmpty.
	(browser pane port: #entity) value: #foo.
	self assert: (browser panes first port: #entity) value equals: #foo.
	self assert: browser panes first presentations size equals: 1.
	self assert: browser panes first presentations first rootPrototype equals: presentation! !

!GLMExplicitBrowserTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testSetup
	| browser pane1 pane2 transmission |
	browser := GLMExplicitBrowser new.
	pane1 := browser addNewPane.
	pane2 := browser addNewPane.
	transmission := (GLMTransmission new)
		addActiveOrigin: (pane1 port: #selection);
		destination: (pane2 port: #entity);
		yourself.
	browser addTransmission: transmission.
	self assert: browser panes size equals: 2.
	self assert: browser transmissions size equals: 1.
	self assert: browser panes first == pane1.
	self assert: browser panes last == pane2.
	self assert: pane1 browser == browser.
	self assert: pane2 browser == browser.
	self assert: browser transmissions first == transmission! !

!GLMExplicitBrowserTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testTriggeringConditions
	| browser pane1 pane2 transmission |
	browser := GLMExplicitBrowser new.
	browser pane: GLMTestPane new.
	pane1 := GLMTestPane new.
	pane2 := GLMTestPane new.
	transmission := (GLMTransmission new)
		addActiveOrigin: (pane1 port: #selection);
		destination: (pane2 port: #entity);
		yourself.
	browser addPane: pane1.
	browser addPane: pane2.
	browser addTransmission: transmission.
	self assert: (pane1 port: #selection) seenTransmissions isEmpty.
	self assert: (pane2 port: #entity) seenTransmissions isEmpty.
	(pane1 port: #selection) value: 12.
	self assert: (pane1 port: #selection) seenTransmissions size equals: 0.	"self 
		assert: 
			((pane1 port: #selection) seenTransmissions first isKindOf: 
					GLMSimpleTransmission). "
	self assert: (pane2 port: #entity) seenTransmissions size equals: 1.
	self assert: (pane2 port: #entity) seenTransmissions first == transmission.	"Setting the same value should re-publish but not trigger inner transmissions."
	(pane1 port: #selection) value: 12.
	self assert: (pane1 port: #selection) seenTransmissions size equals: 0.	"self 
		assert: 
			((pane1 port: #selection) seenTransmissions first isKindOf: 
					GLMSimpleTransmission). "	"self 
		assert: 
			((pane1 port: #selection) seenTransmissions last isKindOf: 
					GLMSimpleTransmission). "
	self assert: (pane2 port: #entity) seenTransmissions size equals: 1.
	self assert: (pane2 port: #entity) seenTransmissions first == transmission! !

!GLMExplicitBrowserTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testTransmissionBundle
	| browser pane1 pane2 pane3 presentation1 presentation2 transmission |
	browser := GLMExplicitBrowser new.
	presentation1 := GLMPresentation new.
	presentation2 := GLMPresentation new.
	pane1 := GLMTestPane new.
	pane2 := GLMTestPane new.
	pane3 := GLMTestPane new.
	pane1 addPresentation: GLMPresentation new.
	pane2 addPresentation: GLMPresentation new.
	pane3 addPresentation: presentation1.
	transmission := (GLMTransmission new)
		ensureReplacePresentationsStrategy;
		addActiveOrigin: (pane1 port: #selection);
		addPassiveOrigin: (pane2 port: #selection);
		destination: (pane3 port: #entity);
		addPresentation: presentation2;
		yourself.
	browser addPane: pane1.
	browser addPane: pane2.
	browser addPane: pane3.
	browser addTransmission: transmission.
	self assert: pane3 presentations size equals: 1.
	self assert: pane3 presentations first == presentation1.
	pane2 presentations first selection: #foo.
	self assert: (pane2 port: #selection) seenTransmissions size equals: 1.
	self assert: (pane3 port: #entity) seenTransmissions size equals: 0.
	pane1 presentations first selection: #bar.
	self assert: (pane1 port: #selection) seenTransmissions size equals: 1.
	self assert: (pane3 port: #entity) seenTransmissions size equals: 1.
	self assert: (pane3 port: #entity) seenTransmissions last == transmission.
	self assert: (pane3 port: #entity) value equals: (GLMMultiValue withAll: #(#bar #foo)).
	self assert: pane3 presentations size equals: 1.
	self assert: pane3 presentations first rootPrototype equals: presentation2! !

!GLMExtensionsTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testGlamourValueWithArgs
	"Block closure"

	self assert: ([ #foo ] glamourValueWithArgs: #(1 2)) equals: #foo.
	self assert: ([ :first | Array with: first ] glamourValueWithArgs: #(1 2)) equals: #(1).
	self assert: ([ :first :second | Array with: first with: second ] glamourValueWithArgs: #(1 2)) equals: #(1 2).
	self
		assert: ([ :first :second :third | Array with: first with: second with: third ] glamourValueWithArgs: #(1 2))
		equals: #(1 2 nil).	"Symbol"
	self assert: (#yourself glamourValueWithArgs: #(1 2)) equals: 1.
	self assert: (#yourself glamourValueWithArgs: #()) equals: nil! !

!GLMExtensionsTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testGlamourValue
	"Block closure"

	self assert: ([ #foo ] glamourValue: #(1 2)) equals: #foo.
	self assert: ([ :first | Array with: first ] glamourValue: #(1 2)) equals: #(#(1 2)).
	self assert: ([ :first :second | Array with: first with: second ] glamourValue: #(1 2)) equals: #(#(1 2) nil).
	self
		assert: ([ :first :second | Array with: first with: second ] glamourValue: (GLMMultiValue with: 1 with: 2))
		equals: #(1 2).	"Symbol"
	self assert: (#yourself glamourValueWithArgs: #(1 2)) equals: 1.
	self assert: (#yourself glamourValueWithArgs: #()) equals: nil	"self assert: (#yourself glamourValue: (MultiValue with: 1 with: 2)) = 1."! !

!GLMFallbackScrollListBrick commentStamp: 'AliakseiSyrel 1/24/2015 18:21'!
Use me in case something went wrong on production!
!GLMFallbackScrollListBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/27/2015 12:33'!
model: anAdaptor

	adaptor := anAdaptor.
	self initializeItems! !

!GLMFallbackScrollListBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/30/2015 12:45'!
model

	^ adaptor! !

!GLMFallbackScrollListBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 4/2/2015 00:58'!
initializeItems
	
	self band layoutAfter: [
		1 to: self model count do: [ :index |
			self band addBrickBack: ((self model morphAt: index convert: nil) asBrick with:[:b |
				b brickApi layout vState isOnParent ifTrue: [ b height: 30 ]]) ] ].
	
	self band hasSubbricks ifFalse: [ self emptyBrick ifNotNil: [ :b | self band addBrickBack: b ] ].! !

!GLMFallbackScrollListBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/27/2015 02:01'!
emptyBrick: aBrick
	
	emptyBrick := aBrick! !

!GLMFallbackScrollListBrick methodsFor: 'scrolling' stamp: 'AliakseiSyrel 3/27/2015 02:21'!
invalidate

	self band removeAllBricks.
	self initializeItems.
	self doLayoutForce.
	self update.
! !

!GLMFallbackScrollListBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/27/2015 01:53'!
emptyBrick

	^ emptyBrick! !

!GLMFillWidthAndHeightStrategy methodsFor: '*glamour-morphic-renderer' stamp: 'cyrilledelaunay 5/20/2011 11:30'!
initializeSecondColumn: aPanelMorph
	
	aPanelMorph 
		hResizing: #spaceFill;
		vResizing: #spaceFill.! !

!GLMFillWidthAndHeightStrategy methodsFor: '*glamour-morphic-renderer' stamp: 'cyrilledelaunay 5/20/2011 11:14'!
initializePane: aMorphPane
	
	aMorphPane
		hResizing: #spaceFill;
		vResizing: #spaceFill.! !

!GLMFillWidthAndHeightStrategy methodsFor: '*glamour-morphic-renderer' stamp: 'cyrilledelaunay 5/20/2011 11:31'!
initializeContainer: aPanelMorph
	
	aPanelMorph 
		hResizing: #spaceFill;
		vResizing: #shrinkWrap.! !

!GLMFillWidthAndHeightStrategy methodsFor: '*glamour-morphic-renderer' stamp: 'cyrilledelaunay 5/20/2011 11:31'!
initializeFirstColumn: aPanelMorph
	
	aPanelMorph 
		hResizing: #spaceFill;
		vResizing: #spaceFill.! !

!GLMFillWidthStrategy methodsFor: '*glamour-morphic-renderer' stamp: 'cyrilledelaunay 5/20/2011 11:29'!
initializeSecondColumn: aPanelMorph
	
	aPanelMorph 
		hResizing: #spaceFill;
		vResizing: #shrinkWrap.! !

!GLMFillWidthStrategy methodsFor: '*glamour-morphic-renderer' stamp: 'cyrilledelaunay 5/20/2011 11:12'!
initializePane: aMorphPane
	
	aMorphPane
		hResizing: #spaceFill;
		vResizing: #rigid.! !

!GLMFillWidthStrategy methodsFor: '*glamour-morphic-renderer' stamp: 'cyrilledelaunay 5/20/2011 15:21'!
initializeContainer: aPanelMorph
	
	aPanelMorph 
		hResizing: #spaceFill;
		vResizing: #shrinkWrap.! !

!GLMFillWidthStrategy methodsFor: '*glamour-morphic-renderer' stamp: 'cyrilledelaunay 5/20/2011 11:29'!
initializeFirstColumn: aPanelMorph
	
	aPanelMorph 
		hResizing: #spaceFill;
		vResizing: #shrinkWrap.! !

!GLMFinder commentStamp: 'TudorGirba 7/9/2011 18:16'!
A GLMFinder models a browsers that behaves like the Mac Finder: whenever the selection port is set on one pane, a new one is created to the right with the selection as entity. The Finder opens the first pane on the entity.

The Finder communicates with the Renderer 

Input ports:
- entity: this is passed to the first pane

Output ports:
- selection: this port is populated with the value from the last selection port from one of the panes!
!GLMFinder methodsFor: 'scripting' stamp: 'AndreiChis 5/29/2013 13:55'!
newFirstTransmission
	^ firstTransmission 
		ifNil: [ self newTransmission ]
		ifNotNil: [ self firstTransmission copy ]! !

!GLMFinder methodsFor: 'scripting' stamp: 'TudorGirba 1/26/2011 11:04'!
variableSizePanes
	self hasFixedSizePanes: false! !

!GLMFinder methodsFor: 'scripting' stamp: 'TudorGirba 1/26/2011 12:33'!
fixedSizePanes: anInteger
	self hasFixedSizePanes: true.
	fixedSizePanes := anInteger! !

!GLMFinder methodsFor: 'scripting' stamp: 'TudorGirba 1/2/2012 02:46'!
fromPrevious: aPortSymbol
	self flag: 'needs revisiting. it does not work anymore'.
	self scriptTransmission addActiveOrigin: (GLMPort new name: aPortSymbol)! !

!GLMFinder methodsFor: 'accessing' stamp: 'TudorGirba 1/26/2011 10:59'!
hasFixedSizePanes: aBoolean
	hasFixedSizePanes := aBoolean! !

!GLMFinder methodsFor: 'events' stamp: 'TudorGirba 6/14/2014 12:21'!
innerPortEvent: aPortEvent 
	aPortEvent isEntityPort ifFalse: [
		"We don't want to resend the transmission, but use a new SimpleTransmission." 
		(self pane port: aPortEvent portName) value: aPortEvent value]. 

	aPortEvent isSelectionPort ifTrue: [
		| index toReplace |
		index := self panes reversed indexOf: aPortEvent pane.
		(self panes reversed first: index - 2) do: [ :each |  
			self removeLastPane.
			self announce: (GLMPaneRemoved pane: each fromBrowser: self) ].
		index <= 1 
			ifTrue: [
				self addPaneFromInner: aPortEvent port.
				self announce: 
					(GLMPaneAdded 
						pane: self panes last 
						atPosition: self panes size 
						inBrowser: self) ]
			ifFalse: [
				toReplace := self removeLastPane.
				self lastActivePresentation: toReplace lastActivePresentation.
				self addPaneFromInner: aPortEvent port.
				self announce: 
					(GLMPaneReplaced 
							oldPane: toReplace 
							newPane: self panes last
							fromBrowser: self ) ] 
	]! !

!GLMFinder methodsFor: 'scripting' stamp: 'TudorGirba 1/2/2012 02:46'!
passivelyFromPrevious: aPortSymbol
	self flag: 'needs revisiting. it does not work anymore'.
	self scriptTransmission addPassiveOrigin: (GLMPort new name: aPortSymbol)! !

!GLMFinder methodsFor: 'private' stamp: 'AndreiChis 5/29/2013 13:54'!
addPaneFromOuter: aPort 
	"This method adds a new pane at the end of the finder."
	|newPane |
	newPane := self panes addLast: (GLMPane named: (self panes size + 1) asString in: self).
	self newFirstTransmission
		addActiveOrigin: aPort; 
		destination: (newPane port: #entity); 
		transmit! !

!GLMFinder methodsFor: 'accessing' stamp: 'TudorGirba 1/26/2011 10:59'!
hasFixedSizePanes
	^ hasFixedSizePanes ifNil: [hasFixedSizePanes := true]! !

!GLMFinder methodsFor: 'rendering' stamp: 'TudorGirba 12/5/2011 12:15'!
renderGlamorouslyOn: aRenderer 
	^ aRenderer renderFinder: self! !

!GLMFinder methodsFor: 'scripting' stamp: 'TudorGirba 1/26/2011 12:42'!
fixedSizePanes
	^ fixedSizePanes ifNil: [fixedSizePanes := 2]! !

!GLMFinder methodsFor: 'events' stamp: 'TudorGirba 10/30/2012 20:37'!
outerPortEvent: aPortEvent 
	 
	| toReplace |
	super outerPortEvent: aPortEvent.
	aPortEvent port name = #entity ifFalse: [^self]. 
	self panes isEmpty
		ifFalse: [
			toReplace := self panes first.
			panes := nil.
			self addPaneFromOuter: aPortEvent port.
			self announce: (GLMPaneReplaced 
						oldPane: toReplace 
						newPane: self panes first
						fromBrowser: self ) ]
		ifTrue: [
			self addPaneFromOuter: aPortEvent port.
			self announce: 
				(GLMPaneAdded 
					pane: self panes last 
					atPosition: self panes size 
					inBrowser: self)]! !

!GLMFinder methodsFor: 'scripting' stamp: 'AndreiChis 5/29/2013 13:51'!
showFirst: aBlock
	^ self firstTransmission transmissionStrategy presentationsFactory: aBlock ! !

!GLMFinder methodsFor: 'private' stamp: 'TudorGirba 12/5/2011 13:50'!
lastActivePresentation: aPresentation
	lastActivePresentation := aPresentation! !

!GLMFinder methodsFor: 'private' stamp: 'AndreiChis 5/29/2013 13:53'!
addPaneFromInner: aPort 
	"This method adds a new pane at the end of the finder. Data comes from a port that is in a pane inside the current browser."
	| newPane lastActive |
	"the lastActivePresentation is needed for knowing what presentation to show by default"
	lastActive := self panes isEmpty ifTrue: [nil] ifFalse: [ self lastActivePresentation ].
	newPane := GLMPane named: (self panes size + 1) asString in: self.
	newPane lastActivePresentation: lastActive.
	self panes addLast: newPane.
	self newTransmission
		addActiveOrigin: aPort; 
		destination: (newPane port: #entity); 
"		presentations: (self presentations copy); "
		transmit. 


	"This code was supposed to offer custom transmissions"
"	realTransmissions := self transmissions collect: [:oldTransmission |  
			newTransmission := GLMTransmission new ensureReplacePresentationsStrategy. 
			oldTransmission activeOrigins do: [:eachPort | 
				newTransmission addActiveOrigin: (aPort pane port: eachPort name)]. 
			oldTransmission passiveOrigins do: [:eachPort | 
				newTransmission addPassiveOrigin: (aPort pane port: eachPort name)]. 
			newTransmission 
				destination: (newPane port: #entity); 
				addPresentations: (self presentations collect: #copy);
				addPresentations: (oldTransmission presentations collect: #copy)] . 
	[realTransmissions isEmpty] assert.
	(realTransmissions select: [:each | each originatesAt: aPort]) 
		do: [:each | each transmit]. "! !

!GLMFinder methodsFor: 'private' stamp: 'TudorGirba 12/5/2011 13:50'!
lastActivePresentation
	^ lastActivePresentation ifNil: [ 
		self panes last lastActivePresentation ]! !

!GLMFinder methodsFor: 'scripting' stamp: 'AndreiChis 5/29/2013 13:50'!
firstTransmission
	^ firstTransmission ifNil: [
		firstTransmission := GLMTransmission new ensureReplacePresentationsStrategy ]! !

!GLMFinderMorphicTest methodsFor: 'tests' stamp: ''!
testFixedSize
	window := GLMFinder new openOn: 123.
	self assert: window submorphs last class equals: GLMPaneScroller! !

!GLMFinderMorphicTest methodsFor: 'tests' stamp: ''!
testRemovingVariableSizePanesWhenChangingEntity
	| finder |
	finder := GLMFinder new variableSizePanes.
	window := finder openOn: #a.
	self assert: window submorphs last scrollTarget submorphs size equals: 2.
	finder entity: #b.
	self assert: window submorphs last scrollTarget submorphs size equals: 2! !

!GLMFinderMorphicTest methodsFor: 'tests' stamp: ''!
testCreationVariableSize
	window := (GLMFinder new)
		variableSizePanes;
		openOn: 123.
	self assert: window submorphs last class equals: GeneralScrollPane! !

!GLMFinderMorphicTest methodsFor: 'tests' stamp: ''!
testRemovingVariableSizePanes
	| finder |
	finder := GLMFinder new variableSizePanes.
	window := finder openOn: 40.
	self assert: window submorphs last scrollTarget submorphs size equals: 2.
	(finder panes first port: #selection) value: 41.
	self assert: window submorphs last scrollTarget submorphs size equals: 4.
	(finder panes first port: #selection) value: 42.
	self assert: window submorphs last scrollTarget submorphs size equals: 4.
	(finder panes second port: #selection) value: 43.
	self assert: window submorphs last scrollTarget submorphs size equals: 6.
	(finder panes first port: #selection) value: 44.
	self assert: window submorphs last scrollTarget submorphs size equals: 4! !

!GLMFinderMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 5/20/2013 14:46'!
testDefaultFixedSizePanes
	| finder container |
	finder := GLMFinder new.
	window := finder openOn: 40.
	window width: 522.
	container := self find: TransformMorph in: window.
	self assert: container submorphs first width equals: window submorphs last width.
	(finder panes first port: #selection) value: 42.
	self assert: container submorphs size equals: 3.
	self
		assert: container submorphs first extent
		equals: container submorphs last extent.
	self assert: container submorphs first width <= (window submorphs last width / 2)! !

!GLMFinderMorphicTest methodsFor: 'tests' stamp: 'AndreHora 5/9/2013 15:37'!
testEmbeddedBrowserRefreshesRendering
	| tabulator finder tabulator1 textMorph1 textMorph2 content1 details1 |
	"self debug: #testEmbeddedBrowserRefreshesRendering"
	tabulator := GLMTabulator new.
	tabulator
		row: #content;
		row: #details.
	tabulator transmit
		to: #content;
		andShow: [ :a | a list display: [ :x | 1 to: x ] ].
	tabulator transmit
		from: #content;
		to: #details;
		andShow: [ :a | a text ].
	tabulator transmit
		from: #content;
		toOutsidePort: #selection.
	finder := GLMFinder new.
	finder show: [ :a | a custom: tabulator ].
	window := finder openOn: 42.
	tabulator1 := finder panes first presentations first.
	content1 := tabulator1 panes first.
	details1 := tabulator1 panes second.
	(content1 port: #selection) value: 41.
	textMorph1 := self findWherePresentationIs: details1 presentations first in: window.
	self assert: textMorph1 model text = '41'.
	(content1 port: #selection) value: 42.
	self assert: tabulator1 == finder panes first presentations first.
	self assert: details1 == tabulator1 panes second.
	self assert: details1 presentations first text asString equals: '42'.
	textMorph2 := self findWherePresentationIs: details1 presentations first in: window.
	self assert: textMorph2 model text asString equals: '42'! !

!GLMFinderMorphicTest methodsFor: 'tests' stamp: ''!
testOneFixedSizePane
	| finder |
	finder := GLMFinder new fixedSizePanes: 1.
	window := finder openOn: 40.
	self assert: window submorphs last submorphs first submorphs first width equals: window submorphs last width.
	(finder panes first port: #selection) value: 42.
	self assert: window submorphs last submorphs last submorphs size equals: 3.
	self
		assert: window submorphs last submorphs last submorphs first extent
		equals: window submorphs last submorphs last submorphs last extent.
	self assert: window submorphs last submorphs last submorphs first width equals: window submorphs last width! !

!GLMFinderMorphicTest methodsFor: 'tests' stamp: ''!
testMultiplePresentationsValidation
	| browser |
	browser := GLMFinder new.
	browser show: [:a | a list. a text ].
	window := browser openOn: ($a to: $d).
	(browser panes first port: #selection) value: $z.
	self assert: (browser panes first port: #selection) value equals: $z! !

!GLMFinderMorphicTest methodsFor: 'tests' stamp: ''!
testFinderWithEmbeddedBrowser

	| navigator finder tree1 tree2 |
	navigator := GLMTabulator new.
	navigator row: #content; row: #details.
	navigator transmit to: #content; andShow: [:a | a list display: #allSuperclasses].
	navigator transmit from: #content; to: #details; andShow: [ :a | a text ].
	navigator transmit from: #content; toOutsidePort: #selection.
	finder := GLMFinder new.
	finder show: [:a | a custom: navigator].

	window := finder openOn: String.
	(finder panes first port: #selection) value: Collection.
	
	self assert: finder panes first presentations first ~= finder panes last presentations first.

	tree1 := self find: MorphTreeMorph in: window submorphs last submorphs last submorphs first.
	tree2 := self findLast: MorphTreeMorph in: window submorphs last submorphs last submorphs last.
	self assert: tree1 notNil.
	self assert: tree2 notNil.
	self assert: tree1 ~= tree2.
	self assert: tree1 model glamourPresentation pane ~= tree2 model glamourPresentation pane.
	self assert: tree1 model glamourPresentation ~= tree2 model glamourPresentation.! !

!GLMFinderMorphicTest methodsFor: 'tests' stamp: ''!
testSpawnFinder
	| browser |
	browser := GLMFinder new.
	window := browser openOn: ($a to: $d).
	self repeatAssert: [window submorphs last class] equals: GLMPaneScroller.
! !

!GLMFinderMorphicTest methodsFor: 'tests' stamp: ''!
testNoSelection
	| browser treeMorph treeNodeMorph |
	browser := GLMFinder new.
	browser show: [:a | a tree noSelection].
	window := browser openOn: ($a to: $d).
	treeMorph := window submorphs last submorphs first submorphs first submorphs first submorphs first.
	treeNodeMorph := treeMorph scroller submorphs first.
	self send: treeMorph mouseUpOnItem: treeNodeMorph.
	self assert: browser panes size equals: 1! !

!GLMFinderMorphicTest methodsFor: 'tests' stamp: ''!
testClose
	| finder |
	finder := GLMFinder new.
	window := finder openOn: 123.
	self assert: window owner notNil.
	finder close.
	self assert: window owner isNil! !

!GLMFinderTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPaneReplacedAnnouncement
	| browser count |
	count := 0.
	browser := GLMFinder new.
	browser on: GLMPaneReplaced do: [ :ann | count := count + 1 ].
	browser startOn: #a.
	self assert: count equals: 0.
	(browser panes first port: #selection) value: #b.
	self assert: count equals: 0.
	(browser panes second port: #selection) value: #c.
	self assert: count equals: 0.
	(browser panes first port: #selection) value: #d.
	self assert: count equals: 1.
	browser entity: #e.
	self assert: count equals: 2! !

!GLMFinderTest methodsFor: 'tests' stamp: 'TudorGirba 7/21/2011 12:12'!
testExplicitTransmission
	| finder |
	finder := GLMFinder new.
	finder transmit fromOutsidePort: #entity; toOutsidePort: #selection.
	finder startOn: 42.
	self assert: (finder pane port: #selection) value equals: 42! !

!GLMFinderTest methodsFor: 'tests' stamp: 'TudorGirba 3/15/2013 22:07'!
testUnregisterAnnouncementsWhenRemovingPane
	| announcer browser presentation actualFirstPresentation actualLastPresentation |
	announcer := GLMAnnouncer new.
	browser := GLMFinder new.
	presentation := GLMPresentation new.
	presentation title: [ :entity | entity ].
	browser addPresentation: presentation.
	presentation updateOn: GLMTestAnnouncement from: [ announcer ].
	browser entity: #value1.
	actualFirstPresentation := browser panes first presentations first.
	actualFirstPresentation registerAnnouncements.
	self assert: announcer numberOfSubscriptions equals: 1.
	self assert: announcer glmSubscriptions anyOne announcementClass equals: GLMTestAnnouncement.
	self assert: announcer glmSubscriptions anyOne subscriber presentation equals: actualFirstPresentation.
	self assert: announcer glmSubscriptions anyOne subscriber presentation == actualFirstPresentation.
	(browser panes first port: #selection) value: #value2.
	browser panes last presentations first registerAnnouncements.
	actualLastPresentation := browser panes last presentations first.
	self assert: announcer numberOfSubscriptions equals: 2.
	self
		assert: (announcer glmSubscriptions allSatisfy: [ :each | each announcementClass = GLMTestAnnouncement ]).
	self
		assert:
			(announcer glmSubscriptions anySatisfy: [ :each | each subscriber presentation = actualFirstPresentation ]).
	self
		assert:
			(announcer glmSubscriptions
				anySatisfy: [ :each | each subscriber presentation == actualFirstPresentation ]).
	(browser panes first port: #selection) value: #value3.
	actualLastPresentation := browser panes last presentations first.	"because we removed the other pane"
	self assert: announcer numberOfSubscriptions equals: 1.
	self assert: announcer glmSubscriptions anyOne announcementClass equals: GLMTestAnnouncement.
	self assert: announcer glmSubscriptions anyOne subscriber presentation equals: actualFirstPresentation.
	self assert: announcer glmSubscriptions anyOne subscriber presentation == actualFirstPresentation! !

!GLMFinderTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPanesHaveDifferentRegistries
	| browser |
	browser := GLMFinder new.
	browser addPresentation: (GLMPresentation new title: 'presentation1').
	self assert: browser panes isEmpty.	"Outer entity changed."
	(browser pane port: #entity) value: #value1.
	self assert: browser panes size equals: 1.
	(browser panes first port: #selection) value: #value2.
	self assert: browser panes size equals: 2.
	self deny: (browser panes first instVarNamed: 'registry') == (browser panes second instVarNamed: 'registry')! !

!GLMFinderTest methodsFor: 'tests' stamp: 'AndreiChis 5/30/2013 22:19'!
testPortPublishing
	| browser |
	browser := GLMFinder new.
	(browser pane port: #entity) value: #value1.
	self assert: browser panes size equals: 1.
	self assert: browser pane ports size equals: 1.
	self assert: (browser pane port: #entity) value equals: #value1.
	(browser panes first port: #selection) value: #value2.
	self assert: browser panes size equals: 2.
	self assert: browser pane ports size equals: 3.
	self assert: (browser pane port: #entity) value equals: #value1.
	self assert: (browser pane port: #selection) value equals: #value2.
	(browser panes last port: #selection) value: #value3.
	self assert: browser panes size equals: 3.
	self assert: browser pane ports size equals: 3.
	self assert: (browser pane port: #entity) value equals: #value1.
	self assert: (browser pane port: #selection) value equals: #value3.
	(browser panes first port: #hover) value: #value4.
	self assert: browser panes size equals: 3.
	self assert: browser pane ports size equals: 4.
	self assert: (browser pane port: #entity) value equals: #value1.
	self assert: (browser pane port: #selection) value equals: #value3.
	self assert: (browser pane port: #hover) value equals: #value4! !

!GLMFinderTest methodsFor: 'tests' stamp: 'tg 3/31/2010 19:44'!
testEmptyPanes
	| browser | 
	browser := GLMFinder new. 
	self assert: browser panes isEmpty. 
	self assert: browser transmissions isEmpty.! !

!GLMFinderTest methodsFor: 'tests' stamp: 'DamienCassou 7/2/2011 22:01'!
testValidSubscriptionsInComplexBrowser
	| browser navigator tabulator1 tabulator2 pane1 pane2 content1 content2 details1 details2|
	
	navigator := GLMTabulator new.
	navigator row: #content; row: #details.
	navigator transmit to: #content; andShow: [:a | a list display: #allSuperclasses].
	navigator transmit from: #content; to: #details; andShow: [ :a | a text].
	navigator transmit from: #content; toOutsidePort: #selection.
	 
	browser := GLMFinder new. 
	browser show: [:a | a custom: navigator].
	self assert: browser panes isEmpty.
	(browser pane port: #entity) value: String. 
	self assert: browser panes size equals: 1. 
	pane1 := browser panes first.
	tabulator1 := pane1 presentations first.
	content1 := tabulator1 panes first.
	self assert: content1 presentations first displayValue size equals: 5. "5 superclasses of String".
	(content1 port: #selection) value: Collection. "Assumes Collection is a superclass of String" 
	self assert: browser panes size equals: 2. 
	pane2 := browser panes second.
	tabulator2 := pane2 presentations first.
	content2 := tabulator2 panes first.
	self assert: content1 presentations first displayValue size equals: 5. "5 superclasses of String".
	self assert: content2 presentations first displayValue size equals: 2. "2 superclasses of Collection".
	details1 := tabulator1 panes second.
	self assert: details1 presentations first displayValue equals: Collection.
	(content2 port: #selection) value: Object. "Assumes Object is a superclass of Collection"
	self assert: details1 presentations first displayValue equals: Collection.
	details2 := tabulator2 panes second.
	self assert: details2 presentations first displayValue equals: Object.
	self assert: content1 presentations first displayValue size equals: 5. "5 superclasses of String".
	self assert: content2 presentations first displayValue size equals: 2. "2 superclasses of Collection".! !

!GLMFinderTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPaneAddedAnnouncement
	| browser count |
	count := 0.
	browser := GLMFinder new.
	browser on: GLMPaneAdded do: [ :ann | count := count + 1 ].
	browser startOn: #a.
	self assert: count equals: 1.
	(browser panes first port: #selection) value: #b.
	self assert: count equals: 2! !

!GLMFinderTest methodsFor: 'tests' stamp: 'Nicolasanquetil 5/3/2013 15:16'!
testLastActivePresentation
	| browser |
	browser := GLMFinder new.
	browser
		show: [ :a | 
			a list title: 'a'.
			a text title: 'b'.
			a table title: 'c' ].
	browser startOn: 1.
	self assert: browser lastActivePresentation isNil.
	(browser panes first port: #selection) value: 2.
	self assert: browser lastActivePresentation isNil.
	browser panes last lastActivePresentation: browser panes last presentations last.
	self assert: browser lastActivePresentation equals: browser panes last presentations last.
	(browser panes first port: #selection) value: 3.
	self assert: browser panes last lastActivePresentation title equals: 'c'! !

!GLMFinderTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPaneRemovedAnnouncement
	| browser count |
	count := 0.
	browser := GLMFinder new.
	browser on: GLMPaneRemoved do: [ :ann | count := count + 1 ].
	browser startOn: #a.
	self assert: count equals: 0.
	(browser panes first port: #selection) value: #b.
	self assert: count equals: 0.
	(browser panes second port: #selection) value: #c.
	self assert: count equals: 0.
	(browser panes first port: #selection) value: #d.
	self assert: count equals: 1! !

!GLMFinderTest methodsFor: 'tests' stamp: 'TudorGirba 7/21/2011 13:46'!
testExplicitTransmissionComplex
	"this tests a possible bug in the context copying that might prevent the explicit outside transmission"

	| finder browser |
	finder := GLMFinder new.
	finder transmit fromOutsidePort: #entity; toOutsidePort: #something.

	browser := GLMTabulator new.
	browser row: #explorer; row: #details.
	browser transmit to: #explorer; andShow: [:a | a custom: finder].
	browser transmit from: #explorer port: #something; to: #details; andShow: [:a | a text ].
	browser startOn: 42.

	self assert: (browser panes first port: #something) value equals: 42! !

!GLMFinderTest methodsFor: 'tests' stamp: 'TudorGirba 1/26/2011 10:58'!
testFixedSize
	| browser | 
	browser := GLMFinder new. 
	self assert: browser hasFixedSizePanes.
	browser hasFixedSizePanes: false.
	self assert: browser hasFixedSizePanes not	! !

!GLMFinderTest methodsFor: 'tests' stamp: 'AndreiChis 5/30/2013 22:02'!
testPaneCreation
	| browser |
	browser := GLMFinder new.
	browser addPresentation: (GLMPresentation new title: 'presentation1').
	self assert: browser panes isEmpty.	"Outer entity changed."
	(browser pane port: #entity) value: #value1.
	self assert: browser panes size equals: 1.
	self assert: browser panes first browser == browser.
	self assert: (browser panes first port: #entity) value equals: #value1.
	self assert: browser panes first presentations size equals: 1.
	self assert: browser panes first presentations first title equals: 'presentation1'.
	self assert: browser panes first presentations first ~~ browser transmission transmissionStrategy presentations first.	"First pane selection changed."
	(browser panes first port: #selection) value: #value2.
	self assert: browser panes size equals: 2.
	self assert: browser panes last browser == browser.
	self assert: (browser panes last port: #entity) value equals: #value2.
	self assert: browser panes last presentations first title equals: 'presentation1'.
	self assert: browser panes last presentations first ~~ browser transmission transmissionStrategy presentations first.
	self assert: browser panes last presentations first ~~ browser panes first presentations first.	"Second pane selection changed."
	(browser panes last port: #selection) value: #value3.
	self assert: browser panes size equals: 3.
	self assert: browser panes last browser == browser.
	self assert: (browser panes last port: #entity) value equals: #value3.	"First pane selection changed again."
	(browser panes first port: #selection) value: #value4.
	self assert: browser panes size equals: 2.
	self assert: browser panes last browser == browser.
	self assert: (browser panes last port: #entity) value equals: #value4.	"Outer entity changed again."
	(browser pane port: #entity) value: #value5.
	self assert: browser panes size equals: 1.
	self assert: browser panes last browser == browser.
	self assert: (browser panes last port: #entity) value equals: #value5! !

!GLMFinderTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPaneName
	| browser |
	browser := GLMFinder new.
	browser addPresentation: (GLMPresentation new title: 'presentation1').
	(browser pane port: #entity) value: #value1.
	self assert: browser panes first name equals: '1'.
	(browser panes first port: #selection) value: #value2.
	self assert: browser panes last name equals: '2'! !

!GLMFlexiblePresentation commentStamp: '<historical>'!
A presentation that flexibly changes it behavior depending on the current entity.

If the entity is a collection, this class renders as a ListPresentation, otherwise as a TextPresentation.!
!GLMFlexiblePresentation methodsFor: 'accessing' stamp: ''!
currentPresentation 
	 
	^ (self displayValue isCollection and: [self displayValue isString not])
		ifTrue: [GLMListPresentation new showOnly: 50; pane: self pane]
		ifFalse: [GLMTextPresentation new pane: self pane]! !

!GLMFlexiblePresentation methodsFor: 'rendering' stamp: ''!
renderGlamorouslyOn: aRenderer 
	self registerAnnouncements. 
	^self currentPresentation renderGlamorouslyOn: aRenderer! !

!GLMFlexiblePresentationTest methodsFor: 'tests' stamp: 'tg 11/16/2009 15:11'!
testDefault
	| browser |
	browser := GLMTabulator new.
	browser startOn: #(1 2 3).
	self assert: (browser panes first presentations first isKindOf: GLMFlexiblePresentation).
	browser startOn: 1.
	self assert: (browser panes first presentations first isKindOf: GLMFlexiblePresentation).! !

!GLMFlexiblePresentationTest methodsFor: 'tests' stamp: 'TudorGirba 7/29/2011 19:22'!
testDynamic
	| browser childBrowser |
	childBrowser := GLMFinder new.
	browser := GLMTabulator new.
	browser column: #one.
	browser transmit to: #one; andShow: [ :a |
		a custom: (GLMDynamicPresentation new display: [childBrowser]) ].
	browser startOn: 42.
	self assert: browser panes first presentations first currentPresentation first == childBrowser.
	self assert: childBrowser pane == browser panes first ! !

!GLMFormBrick commentStamp: 'AliakseiSyrel 2/26/2015 23:27'!
A GLMFormBrick is scriptable html-like form with possibility to submit it.
!
!GLMFormBrick methodsFor: 'form-brick-creation' stamp: 'AliakseiSyrel 3/19/2015 16:26'!
newText

	^ GLMRubTextAreaBrick new
		width: 200;
		margin: #(3 0);
		vShrinkWrap;
		rubricTextFamilyName: StandardFonts defaultFont familyName! !

!GLMFormBrick methodsFor: 'form-brick-creation' stamp: 'AliakseiSyrel 2/26/2015 21:06'!
newLabel

	^ GLMLabelBrick new margin: #(3 0)! !

!GLMFormBrick methodsFor: 'form-scripting' stamp: 'AliakseiSyrel 2/26/2015 21:08'!
submit: aBlock

	aBlock cull: self submit! !

!GLMFormBrick methodsFor: 'form-scripting' stamp: 'AliakseiSyrel 2/26/2015 21:01'!
checkbox: aBlock

	aBlock cull: self checkbox
	! !

!GLMFormBrick methodsFor: 'form-scripting' stamp: 'AliakseiSyrel 2/26/2015 20:59'!
checkbox

	^ self addBrickBack: self newCheckbox! !

!GLMFormBrick methodsFor: 'form-actions' stamp: 'AliakseiSyrel 2/26/2015 23:18'!
submitForm

	self announce: (GLMFormSubmitted new result: self asFormValue)! !

!GLMFormBrick methodsFor: 'form-scripting' stamp: 'AliakseiSyrel 2/26/2015 23:18'!
submit

	^ self addBrickBack: (
		self newButton
			text: 'Submit';
			when: #onClicked do: [ self submitForm ])! !

!GLMFormBrick methodsFor: 'form-scripting' stamp: 'AliakseiSyrel 2/26/2015 23:31'!
text: aBlock

	aBlock cull: self text! !

!GLMFormBrick methodsFor: 'form-scripting' stamp: 'AliakseiSyrel 2/26/2015 23:31'!
text

	^ self addBrickBack: self newText! !

!GLMFormBrick methodsFor: 'form-brick-creation' stamp: 'AliakseiSyrel 2/26/2015 21:06'!
newCheckbox

	^ GLMCheckboxBrick new margin: #(3 0)! !

!GLMFormBrick methodsFor: 'form-brick-creation' stamp: 'AliakseiSyrel 2/26/2015 21:12'!
newButton

	^ GLMButtonBrick new margin: #(3 0)! !

!GLMFormBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/26/2015 21:23'!
initialize
	super initialize.
	
	self
		hShrinkWrap;
		color: Color veryVeryLightGray muchLighter;
		borderWidth: 1;
		borderColor: Color veryVeryLightGray;
		padding: # (4 7)! !

!GLMFormBrick methodsFor: 'form-scripting' stamp: 'AliakseiSyrel 2/26/2015 21:00'!
label

	^ self addBrickBack: self newLabel! !

!GLMFormBrick methodsFor: 'form-scripting' stamp: 'AliakseiSyrel 2/26/2015 21:27'!
title

	^ self addBrickBack: (self newLabel hAlign: #center)! !

!GLMFormBrick methodsFor: 'form-scripting' stamp: 'AliakseiSyrel 2/26/2015 21:26'!
title: aBlock

	aBlock cull: self title! !

!GLMFormBrick methodsFor: 'form-scripting' stamp: 'AliakseiSyrel 2/26/2015 21:01'!
label: aBlock

	aBlock cull: self label
	! !

!GLMFormBrick methodsFor: 'brick-structure-converting' stamp: 'AliakseiSyrel 2/26/2015 22:07'!
asFormValue
	|result|
	result := OrderedCollection new.
	self subbricks do: [ :each |
		each asFormValue ifNotNil: [ :v | result addAll: v asCollection ] ].
	^ result! !

!GLMFormBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:47'!
exampleOpen

	self gtExample
		when: GLMFormSubmitted do: [ :ann | ann result brickAlert ];
		openCenteredInBrickWindow! !

!GLMFormBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:20'!
gtExample
	<gtExample: 'Input form with title, two labels, four checkboxes, text and submit button'>
	^ self new
		title: [ :t | t
			text: 'Grüezi' ];
		text: [ :t | t
			text: 'Welcome to the Restaurant Zukunft zu Pharo in Berne'];
		label: [ :l | l
			text: 'What would you like to eat?' ];
		checkbox: [ :c | c
			id: #fondue;
			check;
			text: 'Cheese Fondue, CHF 20.-' ];
		checkbox: [ :c | c
			id: #raclette;
			text: 'Raclette, CHF 15.-' ];
		
		label: [ :l | l 
			text: 'What would you like to drink?' ];
		checkbox: [ :c | c
			id: #schorle;
			text: 'Apfel Schorle, CHF 4.-' ];
		checkbox: [ :c | c
			id: #rivella;
			check;
			text: 'Rivella, CHF 4.-' ];
		submit;
		yourself! !

!GLMFormSubmitted methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/26/2015 21:33'!
result
	^ result! !

!GLMFormSubmitted methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/26/2015 21:33'!
result: anObject
	result := anObject! !

!GLMFormatedPresentation commentStamp: 'TudorGirba 2/4/2011 17:56'!
GLMFormatedPresentation is an abstract presentation that offers a format block to be used for formatting the rendering of the presentation. The renderer will use the formatDisplayValueOf: method.!
!GLMFormatedPresentation methodsFor: 'accessing' stamp: 'tg 9/9/2009 01:03'!
formatedDisplayValueOf: anObject
	^ self format glamourValue: (anObject asGlamorousMultiValue, self entity asGlamorousMultiValue)! !

!GLMFormatedPresentation methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
format: anObject 
	 
	format := anObject! !

!GLMFormatedPresentation methodsFor: 'accessing' stamp: 'tg 9/11/2009 19:55'!
icon: anObject
	icon := anObject! !

!GLMFormatedPresentation methodsFor: 'accessing' stamp: 'tg 9/11/2009 19:56'!
iconFor: anObject
	^ self icon glamourValue: (anObject asGlamorousMultiValue, self entity asGlamorousMultiValue)! !

!GLMFormatedPresentation methodsFor: 'accessing' stamp: 'TudorGirba 9/25/2013 06:29'!
format
	^ format ifNil: [ format := #asString ]! !

!GLMFormatedPresentation methodsFor: 'accessing' stamp: 'TudorGirba 2/7/2014 05:53'!
formatedDisplayValue
	^ self formatedDisplayValueOf: self displayValue! !

!GLMFormatedPresentation methodsFor: 'accessing' stamp: 'tg 9/11/2009 19:56'!
icon
	^ icon ifNil: [ icon := [nil] ]! !

!GLMFormattedPresentationTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testFormat
	| presentation |
	presentation := GLMFormatedPresentation new.
	presentation format: [ :c | c ].
	self assert: (presentation formatedDisplayValueOf: 1) equals: 1.
	presentation entity: 41.
	presentation format: [ :a :c | a + c ].
	self assert: (presentation formatedDisplayValueOf: 1) equals: 42.
	presentation entity: (GLMMultiValue with: 20 with: 21).
	presentation format: [ :a :b :c | a + b + c ].
	self assert: (presentation formatedDisplayValueOf: 1) equals: 42! !

!GLMFoundationBrick commentStamp: 'AliakseiSyrel 10/17/2014 10:32'!
A GLMFoundationBrick is connection layer between brick widgets and morphic.

See GLMBrick class comment for more info.

Instance Variables
	brickRoot:		<Object>

brickRoot
	- xxxxx
!
!GLMFoundationBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 3/24/2015 13:45'!
hSpaceFill

	hResizing:= #spaceFill.
	self hResizing: #spaceFill! !

!GLMFoundationBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 3/24/2015 02:23'!
hShrinkWrap

	hResizing:= #shrinkWrap! !

!GLMFoundationBrick methodsFor: 'private' stamp: 'AliakseiSyrel 1/26/2015 12:38'!
privateThemer

	^ self valueOfProperty: #brickThemer ifAbsentPut: [ nil ]! !

!GLMFoundationBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 3/24/2015 02:23'!
vShrinkWrap

	vResizing:= #shrinkWrap! !

!GLMFoundationBrick methodsFor: 'initialize' stamp: 'AliakseiSyrel 1/29/2015 00:58'!
outOfWorld: aWorld
	super outOfWorld: aWorld.
	
	self brickRoot onRemovedFrom: self! !

!GLMFoundationBrick methodsFor: 'testing' stamp: 'AliakseiSyrel 3/24/2015 03:19'!
isHFilling

	^ hResizing = #spaceFill! !

!GLMFoundationBrick methodsFor: 'geometry' stamp: 'AliakseiSyrel 10/3/2014 18:43'!
globalBounds

	^ self bounds! !

!GLMFoundationBrick methodsFor: 'testing' stamp: 'AliakseiSyrel 3/24/2015 03:20'!
isVFilling

	^ vResizing = #spaceFill! !

!GLMFoundationBrick methodsFor: 'testing' stamp: 'AliakseiSyrel 3/24/2015 02:54'!
isFoundationBrick

	^ true! !

!GLMFoundationBrick methodsFor: 'testing' stamp: 'AliakseiSyrel 3/24/2015 02:24'!
isVShrinking

	^ vResizing = #shrinkWrap! !

!GLMFoundationBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 3/24/2015 03:21'!
vSpaceFill

	vResizing:= #spaceFill! !

!GLMFoundationBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/17/2014 10:21'!
brickRoot

	^ brickRoot! !

!GLMFoundationBrick methodsFor: 'reflective operations' stamp: 'AliakseiSyrel 2/17/2015 21:25'!
doesNotUnderstand: aMessage

	^ self brickRoot perform: aMessage selector withArguments: aMessage arguments! !

!GLMFoundationBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 3/24/2015 03:21'!
initialize
	super initialize.
	
	vResizing := #spaceFill.
	hResizing := #spaceFill.
	
	self
		beTransparent;
		brickRoot: GLMBrick new! !

!GLMFoundationBrick methodsFor: 'private' stamp: 'AliakseiSyrel 1/30/2015 16:48'!
brickThemerChanged

	self brickRoot themerChanged! !

!GLMFoundationBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/30/2015 16:29'!
themer

	^ self privateThemer
		ifNotNil: [ self privateThemer ]
		ifNil: [ self owner isNotNil
			ifTrue: [ self owner isBrick ifTrue: [ self owner themer ] ifFalse: [ super brickThemer ] ]
			ifFalse: [ self theme brickThemer ] ]! !

!GLMFoundationBrick methodsFor: 'adding' stamp: 'AliakseiSyrel 10/17/2014 09:48'!
addAllBricks: aCollection

	aCollection do: [ :each | self addBrickBack: each ]! !

!GLMFoundationBrick methodsFor: 'testing' stamp: 'AliakseiSyrel 10/11/2014 15:38'!
isFocused

	^ false! !

!GLMFoundationBrick methodsFor: 'geometry' stamp: 'AliakseiSyrel 3/24/2015 03:20'!
extent: aPoint
	|left top right bottom|
	
	super extent: aPoint.
	
	left := self brickRoot marginLeft.
	top := self brickRoot marginTop.
	
	right := self extent x - self brickRoot marginRight.
	bottom := self extent y - self brickRoot marginBottom.
	
	self isHFilling ifTrue: [ self brickRoot width: right - left ].
	self isVFilling ifTrue: [ self brickRoot height: bottom - top ].
	self brickRoot wrappedBounds bounds: (left@top corner: (right@bottom)).
	
	self brickRoot doLayoutForce! !

!GLMFoundationBrick methodsFor: 'geometry' stamp: 'AliakseiSyrel 1/20/2015 21:10'!
globalBoundsTranslateFactor

	^ self globalBounds origin! !

!GLMFoundationBrick methodsFor: 'private' stamp: 'AliakseiSyrel 10/24/2014 13:04'!
privateExtent: aPoint

	super extent: aPoint.! !

!GLMFoundationBrick methodsFor: 'adding' stamp: 'AliakseiSyrel 10/17/2014 10:17'!
addBrickBack: aBrick

	self brickRoot addBrickBack: aBrick.! !

!GLMFoundationBrick methodsFor: 'testing' stamp: 'AliakseiSyrel 3/24/2015 02:24'!
isHShrinking

	^ hResizing = #shrinkWrap! !

!GLMFoundationBrick methodsFor: 'layouting' stamp: 'AliakseiSyrel 2/6/2015 11:08'!
doLayout

	self brickRoot doLayoutForce.! !

!GLMFoundationBrick methodsFor: 'adding' stamp: 'AliakseiSyrel 1/20/2015 00:07'!
removeBrick: aBrick

	self brickRoot removeBrick: aBrick! !

!GLMFoundationBrick methodsFor: 'adding' stamp: 'AliakseiSyrel 10/17/2014 09:57'!
removeAllBricks

	self brickRoot removeAllBricks! !

!GLMFoundationBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/23/2015 21:59'!
brickRoot: aBrick

	self brickRoot ifNotNil: [
		self removeMorph: self brickRoot.
		brickRoot := nil.
	].
	
	brickRoot := aBrick.
	self addMorphBack: brickRoot.
	brickRoot onThemerChanged
	
	! !

!GLMFoundationBrick methodsFor: 'drawing' stamp: 'AliakseiSyrel 10/17/2014 23:47'!
fullDrawOn: aCanvas
	"preventing from drawing outside of me"
	super fullDrawOn: (aCanvas copyClipRect: self fullBounds).! !

!GLMFoundationBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/26/2015 13:01'!
themer: aThemer

	self setProperty: #brickThemer toValue: aThemer.
	self brickRoot themerChanged! !

!GLMFoundationBrick class methodsFor: 'instance creation' stamp: 'AliakseiSyrel 12/20/2014 20:36'!
root: aBrick

	^ self new brickRoot: aBrick! !

!GLMGenericAction commentStamp: '<historical>'!
This is an action that is supposed to work in any context (e.g., Morphic or Seaside)!
!GLMGenericAction methodsFor: 'testing' stamp: 'tg 9/25/2010 17:53'!
worksWithSeaside
	^ true! !

!GLMGenericAction methodsFor: 'testing' stamp: 'tg 9/25/2010 17:53'!
worksWithMorphic
	^ true! !

!GLMHaloBrick methodsFor: 'handles' stamp: 'AliakseiSyrel 3/26/2015 18:49'!
addGrabHandle: haloSpec! !

!GLMHaloBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 3/26/2015 18:53'!
initialize
	super initialize.
	
	self fillStyle: (Color lightBlue alpha: 0.2)! !

!GLMHaloBrick methodsFor: 'handles' stamp: 'AliakseiSyrel 3/26/2015 18:48'!
addDupHandle: haloSpec! !

!GLMHaloBrick methodsFor: 'settings' stamp: 'AliakseiSyrel 3/26/2015 18:02'!
showBoundsInHalo

	^ true! !

!GLMHaloBrick methodsFor: 'updating' stamp: 'AliakseiSyrel 3/26/2015 18:59'!
changed

	^ fullBounds 
		ifNil: [ self invalidRect: self privateFullBounds]
		ifNotNil: [ self invalidRect: fullBounds ]! !

!GLMHelperTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testGlamourValue
	self assert: ([ :a | a + 2 ] glamourValue: 40) equals: 42.
	self assert: ([ :a | a + 2 ] glamourValue: 40 asGlamorousMultiValue) equals: 42.
	self assert: ([ 42 ] glamourValue: 40 asGlamorousMultiValue) equals: 42.
	self assert: ([ :a | a first + a last ] glamourValue: #(40 2)) equals: 42.
	self assert: ([ :a :b | a + b ] glamourValue: (GLMMultiValue withAll: #(40 2))) equals: 42.
	self assert: ([ :a | a + 2 ] glamourValue: (GLMMultiValue withAll: #(40 2))) equals: 42.
	self assert: ([ 42 ] glamourValue: (GLMMultiValue withAll: #(40 2))) equals: 42! !

!GLMHelperTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testAsGlamorousMultiValue
	self assert: (GLMMultiValue with: #(1 2 3)) equals: #(1 2 3) asGlamorousMultiValue.
	self
		assert: 1 asGlamorousMultiValue , 2 asGlamorousMultiValue , 3 asGlamorousMultiValue
		equals: (GLMMultiValue withAll: #(1 2 3))! !

!GLMHighlightAndEvaluate commentStamp: 'AndreiChis 1/14/2015 13:15'!
I am event indicating to the renderer to execute the  highlighted text and perform an action with the result.!
!GLMHighlightAndEvaluate methodsFor: 'accessing' stamp: 'AndreiChis 1/14/2015 11:02'!
action
	^ action! !

!GLMHighlightAndEvaluate methodsFor: 'accessing' stamp: 'AndreiChis 1/14/2015 11:02'!
action: anObject
	action := anObject! !

!GLMHighlighterTextParserStyler methodsFor: 'accessing' stamp: 'AndreiChis 9/2/2014 15:09'!
parser: anObject
	
	parser := anObject! !

!GLMHighlighterTextParserStyler methodsFor: 'accessing' stamp: 'AndreiChis 9/2/2014 15:25'!
privateFormat: aText 
	self flag: 'This feature is not supported for now.'.
	^ aText! !

!GLMHighlighterTextParserStyler methodsFor: 'accessing' stamp: 'AndreiChis 9/2/2014 15:09'!
parser
	
	^ parser! !

!GLMHighlighterTextParserStyler methodsFor: 'accessing' stamp: 'AndreiChis 9/2/2014 16:39'!
privateStyle: aText 
	| styledText |
	aText makeAllColor: Color red.
	styledText := self parser parse: aText asString onError: [  ].
	(styledText notNil and: [ styledText ~~ aText ]) ifTrue: [ 
		self flag: 'change only the runs array of the original text.'.
		aText setString: aText string setRunsChecking: styledText runs ]! !

!GLMHighlighterTextRubEditingMode methodsFor: 'initialize-release' stamp: 'TudorGirba 9/1/2014 15:26'!
updateTextAreaWhenPlugged
	self withStyler.
	super updateTextAreaWhenPlugged! !

!GLMHighlighterTextRubEditingMode methodsFor: 'initialize-release' stamp: 'TudorGirba 9/1/2014 15:26'!
updateTextAreaWhenUnplugged
	self withoutStyler.
	super updateTextAreaWhenUnplugged

! !

!GLMHighlighterTextRubEditingMode methodsFor: 'initialize-release' stamp: 'AndreiChis 9/2/2014 16:13'!
withoutStyler
	self textArea withoutDecorator: self stylerDecorator! !

!GLMHighlighterTextRubEditingMode methodsFor: 'initialize-release' stamp: 'AndreiChis 9/2/2014 16:13'!
withStyler
	self textArea withDecorator: self stylerDecorator! !

!GLMHighlighterTextRubEditingMode methodsFor: 'accessing' stamp: 'AndreiChis 9/2/2014 16:13'!
stylerDecorator
	
	^ stylerDecorator! !

!GLMHighlighterTextRubEditingMode methodsFor: 'accessing' stamp: 'AndreiChis 9/2/2014 16:13'!
stylerDecorator: anObject
	
	stylerDecorator := anObject! !

!GLMHighlighterTextRubEditingMode class methodsFor: 'instance creation' stamp: 'AndreiChis 9/2/2014 16:13'!
withStylerDecorator: aDecorator

	^ self new stylerDecorator: aDecorator! !

!GLMHighlighterTextRubEditingMode class methodsFor: 'instance creation' stamp: 'AndreiChis 9/11/2014 15:17'!
withParserStyler: aParser

	^ self new stylerDecorator: (GLMHighlighterTextStylerDecorator
			withParserStyler: aParser)! !

!GLMHighlighterTextStylerDecorator methodsFor: 'editing' stamp: 'AndreiChis 9/2/2014 16:06'!
stylerStyledInBackground: styledCopyOfText
	next ifNil: [ ^self ].
	text string = styledCopyOfText string
		ifTrue: [ self stylerStyled: styledCopyOfText ].
! !

!GLMHighlighterTextStylerDecorator methodsFor: 'accessing' stamp: 'AndreiChis 9/2/2014 16:29'!
defaultStyler
	"There is no default styler"
	^ nil! !

!GLMHighlighterTextStylerDecorator methodsFor: 'editing' stamp: 'AndreiChis 9/2/2014 15:23'!
replaceFrom: start to: stop with: aText
	self okToStyle
		ifFalse: [ ^ next replaceFrom: start to: stop with: aText ].
	self
		disableDrawingWhile: [
			aText addAttribute: self defaultFontChange.
			text ifNil: [ text := self text ].
			text replaceFrom: start to: stop with: (self styler format: aText).
			self style: text.
			next text: text.
			self recomposeFrom: start to: start + aText size - 1 delta: aText size - (stop - start + 1).
			self textArea paragraphWasComposedFrom: start to: start + aText size - 1.
			self textArea paragraphReplacedTextFrom: start to: stop with: aText ]! !

!GLMHighlighterTextStylerDecorator methodsFor: 'accessing' stamp: 'AndreiChis 9/2/2014 16:29'!
styler
	"The styler responsible for highlighting text in the receiver"
	^ styler ifNil: [ styler := self defaultStyler ]! !

!GLMHighlighterTextStylerDecorator methodsFor: 'accessing' stamp: 'AndreiChis 9/2/2014 16:11'!
styler: aStylerObject
	
	styler := aStylerObject.
	styler view: self! !

!GLMHighlighterTextStylerDecorator methodsFor: 'editing' stamp: 'AndreiChis 9/2/2014 15:29'!
stylerStyled: styledCopyOfText
	next ifNil: [ ^self ].
	text runs: styledCopyOfText runs.
	(self textArea scrollPane ifNil: [ self textArea ]) changed! !

!GLMHighlighterTextStylerDecorator methodsFor: 'editing' stamp: 'AndreiChis 9/2/2014 16:25'!
style: aText
	self styler ifNotNil: [ :aStyler | aStyler styleInBackgroundProcess: aText ]! !

!GLMHighlighterTextStylerDecorator methodsFor: 'accessing' stamp: 'AndreiChis 9/2/2014 15:24'!
text
	^ next text! !

!GLMHighlighterTextStylerDecorator methodsFor: 'accessing' stamp: 'AndreiChis 9/2/2014 16:11'!
okToStyle
	^ true! !

!GLMHighlighterTextStylerDecorator class methodsFor: 'querying' stamp: 'AndreiChis 4/24/2014 13:38'!
key

	^ nil! !

!GLMHighlighterTextStylerDecorator class methodsFor: 'instance creation' stamp: 'AndreiChis 9/2/2014 16:37'!
withParserStyler: aParser
	
	^ self new styler: (GLMHighlighterTextParserStyler new parser: aParser)! !

!GLMHintableActionButtonBrick methodsFor: 'brick-interactable-actions' stamp: 'AndreiChis 3/24/2015 23:49'!
press
	super press.
	
	self class asyncTaskUniqueInstance terminate.
	self class reset.! !

!GLMHintableActionButtonBrick methodsFor: 'brick-interactable-actions' stamp: 'AndreiChis 3/24/2015 23:48'!
click: evt
	|result|
	result := super click: evt.
	self class asyncTaskUniqueInstance terminate.
	self class reset.
	^ result! !

!GLMHintableActionButtonBrick methodsFor: 'testing' stamp: 'AliakseiSyrel 2/13/2015 01:27'!
isModifierPressed: anEvent

	self hintModifier ifNil: [ ^ false ].
	self hintModifier = #shift ifTrue: [ ^ anEvent shiftPressed ].
	self hintModifier = #option ifTrue: [ ^ anEvent optionKeyPressed ].
	self hintModifier = #alt ifTrue: [ ^ anEvent altKeyPressed ].
	self hintModifier = #command ifTrue: [ ^ anEvent commandKeyPressed ].
	self hintModifier = #control ifTrue: [ ^ anEvent controlKeyPressed ].
	^ false! !

!GLMHintableActionButtonBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/17/2015 11:33'!
beNormal

	self beMode: #beNormal! !

!GLMHintableActionButtonBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/13/2015 00:49'!
hintTitle: anObject
	hintTitle := anObject! !

!GLMHintableActionButtonBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/17/2015 11:33'!
beSuccess

	self beMode: #beSuccess! !

!GLMHintableActionButtonBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/17/2015 11:33'!
beHelp

	self beMode: #beHelp! !

!GLMHintableActionButtonBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/13/2015 00:49'!
hintText: anObject

	hintText := anObject! !

!GLMHintableActionButtonBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/13/2015 00:49'!
hintDelay: anObject
	hintDelay := anObject! !

!GLMHintableActionButtonBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/13/2015 01:00'!
hintDelay

	^ hintDelay ifNil: [ hintDelay := 700 ]! !

!GLMHintableActionButtonBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/13/2015 00:49'!
hintModifier: anObject

	hintModifier := anObject! !

!GLMHintableActionButtonBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 3/22/2015 11:53'!
beMode: aMode

	self hoverAction: [ :aBrick :evt |
			self class asyncTaskUniqueInstance
				perform: [ self isInWorld ifTrue: [ self class openHint: self hintText title: self hintTitle type: aMode for: self ] ]
				delay: ((self isModifierPressed: evt) ifTrue: [ 0 ] ifFalse: [ self hintDelay ]) ]! !

!GLMHintableActionButtonBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/13/2015 00:49'!
hintText

	^ hintText ifNil: [ hintText := 'Need help?' ]! !

!GLMHintableActionButtonBrick methodsFor: 'initialization' stamp: 'AndreiChis 3/24/2015 23:48'!
initialize
	super initialize.
	
	self beHelp.
	self unhoverAction: [ :aBrick :anEvent |
		self class asyncTaskUniqueInstance terminate.
		(aBrick globalBounds containsPoint: anEvent position)
			ifFalse: [ self class 
				closeHint;
				reset ] ]! !

!GLMHintableActionButtonBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/13/2015 01:28'!
hintModifier

	^ hintModifier ifNil: [ hintModifier := #shift ]! !

!GLMHintableActionButtonBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/17/2015 11:33'!
beError

	self beMode: #beError! !

!GLMHintableActionButtonBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/13/2015 00:50'!
hintTitle

	^ hintTitle ifNil: [ hintTitle := 'Hi,' ]! !

!GLMHintableActionButtonBrick class methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/16/2015 14:58'!
hintBrickUniqueInstance

	^ hintBrick! !

!GLMHintableActionButtonBrick class methodsFor: 'actions' stamp: 'AliakseiSyrel 3/26/2015 17:33'!
reset

	self closeHint.
	asyncTask := nil.
	hintBrick := nil.! !

!GLMHintableActionButtonBrick class methodsFor: 'actions' stamp: 'AliakseiSyrel 3/26/2015 17:36'!
closeHint

	self asyncTaskUniqueInstance ifNotNil: #terminate.
	self hintBrickUniqueInstance ifNotNil: #close! !

!GLMHintableActionButtonBrick class methodsFor: 'converting' stamp: 'AliakseiSyrel 2/13/2015 00:54'!
asyncTaskUniqueInstance

	^ asyncTask ifNil: [ asyncTask := GLMAsyncTask new ]! !

!GLMHintableActionButtonBrick class methodsFor: 'actions' stamp: 'AliakseiSyrel 2/17/2015 10:08'!
openHint: aHintString title: aTitleString type: aTypeSymbol for: aBrick
	|brick|
	
	self closeHint.
	brick :=  GLMPopupBrick new
		hintText: aHintString;
		titleText: aTitleString;
		perform: aTypeSymbol withEnoughArguments: {  };
		openFor: aBrick.
		
	hintBrick := brick
		
	! !

!GLMHintableActionButtonBrick class methodsFor: 'cleanup' stamp: 'AndreiChis 3/24/2015 23:47'!
cleanUp

	self closeHint.
	self reset.! !

!GLMHorizontalBandBrick commentStamp: 'AliakseiSyrel 3/22/2015 11:35'!
A GLMHorizontalBandBrick is a simple Brick with width that shrinks to wrap  subbricks.
Usually used within horizontal scroll panes!
!GLMHorizontalBandBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/13/2015 00:26'!
initialize
	super initialize.
	
	self
		useHorizontalLinearLayout;
		hShrinkWrap! !

!GLMHorizontalLinearLayout methodsFor: 'width' stamp: 'AliakseiSyrel 2/8/2015 18:51'!
widthChildrenDependency: aBrick
	"returns the width of aBrick when it depends on children"
	^ aBrick paddingLeft + aBrick paddingRight + ((self nonFloatSubbricks: aBrick) detectSum: [ :each | each outerBounds width ])! !

!GLMHorizontalLinearLayout methodsFor: 'width' stamp: 'AliakseiSyrel 4/2/2015 15:37'!
widthParentDependency: aBrick
	|allowedWidth|
	aBrick owner ifNil: [ Exception signal: 'My width depends on parent, but it is nil' ].
	allowedWidth := aBrick owner subbricks inject: aBrick owner innerBounds width into: [ :width :each |
		each isWidthClean ifTrue: [
			(each layout hState isOnParent not | (self hasWidthRestrictions: each))
				ifTrue: [ width - each outerBounds width ]
				ifFalse: [ width ] ]
			ifFalse: [ width ] ].
	^ (allowedWidth * aBrick layout hPercent / 100) ceiling! !

!GLMHorizontalLinearLayout methodsFor: 'height' stamp: 'AliakseiSyrel 4/2/2015 15:38'!
heightParentDependency: aBrick
	"if aBrick depends on parent we calculate it as a percentage of the parent"
	aBrick owner ifNil: [ Exception signal: 'My height depends on parent, but it is nil' ].
	^ (aBrick owner innerBounds height * aBrick layout vPercent / 100) ceiling! !

!GLMHorizontalLinearLayout methodsFor: 'layout' stamp: 'AliakseiSyrel 4/2/2015 15:41'!
layout: aBrick in: newBounds

	self
		layout: aBrick
		in: newBounds
		inject: aBrick paddingLeft @ aBrick paddingTop
		into: [ :origin :each |
			each outerOrigin: origin.
			each outerBounds width@0 ]! !

!GLMHorizontalLinearLayout methodsFor: 'height' stamp: 'AliakseiSyrel 2/8/2015 18:50'!
heightChildrenDependency: aBrick
	"returns the height of aBrick when it depends on children"
	"in case of horizontal linear layout it is the height of the highest subbrick + corresponding paddings"
	^ aBrick paddingTop + aBrick paddingBottom + (((self nonFloatSubbricks: aBrick) detectMax: [ :each | each outerBounds height ])
		ifNil: [ 0 ]
		ifNotNil: [ :m | m outerBounds height ])! !

!GLMHorizontalLinearLayout methodsFor: 'layout' stamp: 'AliakseiSyrel 3/23/2015 19:20'!
align: aBrick in: parentBrick anchorPoint: aPoint inContext: aContext
	|align|
	
	self = aContext ifTrue: [ ^ self ].
	(parentBrick subbricks size = 1) & (aContext isNil) ifTrue: [
		GLMVerticalLinearLayout uniqueInstance align: aBrick in: parentBrick anchorPoint: aPoint inContext: self ].
	
	align := aBrick layout vAlign.
	
	align = #none ifTrue: [ ^ self ].
	align = #center ifTrue: [
		^ aBrick translateY: ((parentBrick innerBounds height - aBrick outerBounds height) / 2) asInteger ].
	align = #bottom ifTrue: [
		^ aBrick translateY: ((parentBrick innerBounds height - aBrick outerBounds height)) asInteger ].! !

!GLMHorizontalLinearLayout methodsFor: 'converting' stamp: 'AliakseiSyrel 2/13/2015 20:09'!
asString
	^ 'horizontal'! !

!GLMHorizontalLinearLayout class methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/16/2015 11:41'!
reset
	"
	self reset
	"
	uniqueInstance := nil! !

!GLMHorizontalLinearLayout class methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/3/2015 10:36'!
uniqueInstance
	^ uniqueInstance ifNil: [ uniqueInstance := self new ]! !

!GLMHorizontalLinearLayout class methodsFor: 'cleanup' stamp: 'AndreiChis 3/24/2015 18:51'!
cleanUp

	self reset! !

!GLMHorizontalScrollPaneBrick commentStamp: 'AliakseiSyrel 1/7/2015 23:38'!
A GLMHorizontalScrollPaneBrick is a very simple scrollpane with support of light scrollbar.
Acceleration mechanism is used for scrolling, as longer user scrolls faster it becomes.
!
!GLMHorizontalScrollPaneBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 12/10/2014 14:23'!
newBand
	^ GLMHorizontalBandBrick new! !

!GLMHorizontalScrollPaneBrick methodsFor: 'scrolling' stamp: 'AliakseiSyrel 12/10/2014 14:06'!
scrollUp: anInteger

	"preventing from scrolling if already at the top"
	band brickBounds origin x >= 0 ifTrue: [ ^ self ].
	"actuall scrolling"
	band brickBounds: (band brickBounds translateBy: (anInteger@ 0)).
	"returning scrollpane back if went away"
	band brickBounds origin x > 0 ifTrue: [ band brickBounds: (band brickBounds translateBy: (band brickBounds origin x@ 0 ) negated) ]! !

!GLMHorizontalScrollPaneBrick methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 12/10/2014 14:24'!
calculateMaxVelocity

	"max velocity must depend from the height of the band"
	^ (self band width / 15) max: self class defaultMaxVelocity! !

!GLMHorizontalScrollPaneBrick methodsFor: 'scrolling' stamp: 'AliakseiSyrel 12/10/2014 14:29'!
scrollTo: aBrick

	self shouldBeImplemented! !

!GLMHorizontalScrollPaneBrick methodsFor: 'scrolling' stamp: 'AliakseiSyrel 12/10/2014 14:25'!
scrollDown: anInteger
	
	band brickBounds corner x <= self width ifTrue: [ ^ self ].
	band brickBounds: (band brickBounds translateBy: (anInteger@ 0) negated).
	band brickBounds corner x < self width ifTrue: [ band brickBounds: (band brickBounds translateBy: ((self width - band brickBounds corner x)@0)) ]! !

!GLMImplicitBrowser commentStamp: 'TudorGirba 3/5/2011 21:22'!
A GLMImplicitBrowser is an abstract implementation of a browser that defines an implicit flow of transmissions.

When using implicit browsers, the developer does not have access to the internal transmissions.!
!GLMImplicitBrowser methodsFor: 'accessing' stamp: 'AndreiChis 5/29/2013 13:41'!
transmission
	^ transmission ifNil: [
		transmission := GLMTransmission new ensureReplacePresentationsStrategy.
		transmission ]! !

!GLMImplicitBrowser methodsFor: 'scripting' stamp: 'AndreiChis 5/29/2013 13:41'!
show: aBlock
	self transmission transmissionStrategy presentationsFactory: aBlock! !

!GLMImplicitBrowser methodsFor: 'accessing' stamp: 'AndreiChis 5/29/2013 13:41'!
newTransmission
	^ self transmission copy! !

!GLMImplicitBrowser methodsFor: 'accessing' stamp: 'AndreiChis 5/30/2013 17:21'!
addPresentation: aPresentation
	self transmission transmissionStrategy addPresentation: aPresentation ! !

!GLMInputPresentation commentStamp: 'AndreiChis 10/3/2014 18:38'!
A GLMInputPresentation should display an simple input text.

Right now this functionality is not supported by the morphic renderer.
!
!GLMInputPresentation methodsFor: 'rendering' stamp: ''!
renderGlamorouslyOn: aRenderer 
	self registerAnnouncements.
	^ aRenderer renderInputPresentation: self! !

!GLMInteractableBrick commentStamp: 'AliakseiSyrel 3/22/2015 11:38'!
A GLMInteractableBrick is a subclass of GLMBrick to allow user interactions such as: mouseLeave, mouseEnter, mouseDown, mouseUp and for each state can change background color or background image, that resizes accordinately to Brick's size. Supports doubleClick out of box, but it should be enabled sending enableDoubleClick message. When doubleClick is enabled announces #onDoubleClicked.

By default interactable brick is disabled and doesn't react to any user action. It should be first enabled sending enable message.

Instance Variables
	announcer:		<Announcer>
	checkedColor:		<Object>
	checkedImage:		<Object>
	isChecked:		<Boolean>
	isDoubleClickEnabled:		<Boolean>
	isEnabled:		<Boolean>
	isPressed:		<Boolean>
	isSelected:		<Boolean>
	normalColor:		<Object>
	normalImage:		<Object>
	pressedColor:		<Object>
	pressedImage:		<Object>
	selectedColor:		<Object>
	selectedImage:		<Object>

announcer
	- xxxxx

checkedColor
	- xxxxx

checkedImage
	- xxxxx

isChecked
	- xxxxx

isDoubleClickEnabled
	- xxxxx

isEnabled
	- xxxxx

isPressed
	- xxxxx

isSelected
	- xxxxx

normalColor
	- xxxxx

normalImage
	- xxxxx

pressedColor
	- xxxxx

pressedImage
	- xxxxx

selectedColor
	- xxxxx

selectedImage
	- xxxxx
!
!GLMInteractableBrick methodsFor: 'brick-interactable-accessing' stamp: 'AliakseiSyrel 10/11/2014 13:44'!
pressedImage
	^ pressedImage! !

!GLMInteractableBrick methodsFor: 'brick-interactable-testing' stamp: 'AliakseiSyrel 10/11/2014 13:43'!
isChecked
	^ isChecked.! !

!GLMInteractableBrick methodsFor: 'brick-interactable-accessing' stamp: 'AliakseiSyrel 10/11/2014 13:44'!
normalColor
	^ normalColor! !

!GLMInteractableBrick methodsFor: 'brick-interactable-actions' stamp: 'AliakseiSyrel 2/16/2015 14:45'!
deselect: anEvent

	self deselect! !

!GLMInteractableBrick methodsFor: 'brick-interactable-testing' stamp: 'AliakseiSyrel 10/11/2014 13:44'!
isEnabled
	^ isEnabled! !

!GLMInteractableBrick methodsFor: 'brick-interactable-testing' stamp: 'AliakseiSyrel 10/11/2014 13:44'!
isSelected
	^ isSelected.! !

!GLMInteractableBrick methodsFor: 'brick-interactable-actions' stamp: 'JurajKubelka 2/28/2015 13:31'!
enable: aBoolean
	
	isEnabled := aBoolean.! !

!GLMInteractableBrick methodsFor: 'brick-interactable-actions' stamp: 'AliakseiSyrel 3/24/2015 01:37'!
click: anEvent
	self announce: #onClicked event: anEvent.
	^ false! !

!GLMInteractableBrick methodsFor: 'brick-interactable-actions' stamp: 'AliakseiSyrel 2/25/2015 16:35'!
check
	"notifies #onChecked"
	self isChecked ifFalse: [
		isChecked := true.
		self announce: #onChecked.
		self changed ]! !

!GLMInteractableBrick methodsFor: 'brick-morph-mouse-events' stamp: 'AliakseiSyrel 2/16/2015 14:45'!
mouseUp: evt
	super mouseUp: evt.
	(self bounds containsPoint: evt position) & (self isPressed) ifTrue: [
		self depress.
		^ self click: evt
	] ifFalse: [
		self deselect: evt.
		^ self depress ]! !

!GLMInteractableBrick methodsFor: 'brick-interactable-accessing' stamp: 'AliakseiSyrel 10/11/2014 13:45'!
selectedImage
	^ selectedImage! !

!GLMInteractableBrick methodsFor: 'brick-interactable-accessing' stamp: 'AliakseiSyrel 10/11/2014 13:44'!
normalColor: anObject
	normalColor := anObject! !

!GLMInteractableBrick methodsFor: 'brick-interactable-testing' stamp: 'AliakseiSyrel 10/11/2014 13:44'!
isPressed
	^ isPressed.! !

!GLMInteractableBrick methodsFor: 'brick-morph-mouse-events' stamp: 'AliakseiSyrel 10/16/2014 23:00'!
handlesMouseOver: evt
	^ self isEnabled
		ifTrue: [ true ]
		ifFalse: [ super handlesMouseDown: evt ]! !

!GLMInteractableBrick methodsFor: 'brick-morph-mouse-events' stamp: 'AliakseiSyrel 10/16/2014 23:10'!
handlesMouseDown: evt
	
	^ self isEnabled
		ifTrue: [ true ]
		ifFalse: [ super handlesMouseDown: evt ]
	! !

!GLMInteractableBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 12/20/2014 16:30'!
initialize
	super initialize.
	
	isChecked := false.
	isPressed := false.
	isSelected := false.
	
	self renderer: GLMInteractableBrickRenderer new.
	
	self disable.! !

!GLMInteractableBrick methodsFor: 'brick-interactable-accessing' stamp: 'AliakseiSyrel 10/11/2014 13:44'!
pressedColor
	^ pressedColor! !

!GLMInteractableBrick methodsFor: 'brick-interactable-accessing' stamp: 'AliakseiSyrel 10/11/2014 13:44'!
selectedColor
	^ selectedColor! !

!GLMInteractableBrick methodsFor: 'brick-interactable-actions' stamp: 'AliakseiSyrel 10/11/2014 13:43'!
enable
	
	isEnabled := true.! !

!GLMInteractableBrick methodsFor: 'brick-interactable-actions' stamp: 'AliakseiSyrel 2/25/2015 16:36'!
uncheck
	"notifies #onUnchecked"
	self isChecked ifTrue: [
		isChecked := false.
		self announce: #onUnchecked.
		self changed ]! !

!GLMInteractableBrick methodsFor: 'brick-interactable-accessing' stamp: 'AliakseiSyrel 10/11/2014 13:43'!
checkedImage
	^ checkedImage! !

!GLMInteractableBrick methodsFor: 'brick-interactable-accessing' stamp: 'AliakseiSyrel 10/11/2014 13:43'!
checkedImage: anObject
	checkedImage := anObject! !

!GLMInteractableBrick methodsFor: 'brick-interactable-testing' stamp: 'AliakseiSyrel 10/11/2014 14:06'!
isFocused

	^ false! !

!GLMInteractableBrick methodsFor: 'brick-interactable-actions' stamp: 'AliakseiSyrel 10/11/2014 13:48'!
press
	self isPressed ifFalse: [
		isPressed := true.
		self changed.
	].

	^ false! !

!GLMInteractableBrick methodsFor: 'brick-interactable-accessing' stamp: 'AliakseiSyrel 10/11/2014 13:45'!
pressedImage: anObject
	pressedImage := anObject! !

!GLMInteractableBrick methodsFor: 'brick-interactable-actions' stamp: 'AliakseiSyrel 3/21/2015 19:51'!
enableDoubleClick

	isDoubleClickEnabled := true! !

!GLMInteractableBrick methodsFor: 'brick-interactable-accessing' stamp: 'AliakseiSyrel 10/11/2014 13:44'!
pressedColor: anObject
	pressedColor := anObject! !

!GLMInteractableBrick methodsFor: 'brick-interactable-accessing' stamp: 'AliakseiSyrel 10/11/2014 13:43'!
currentColor
	^ self state pressedColor: (self isPressed) selectedColor: (self isSelected) checkedColor: (self isChecked) of: self! !

!GLMInteractableBrick methodsFor: 'brick-interactable-actions' stamp: 'AliakseiSyrel 10/11/2014 13:43'!
disable
	isEnabled := false.! !

!GLMInteractableBrick methodsFor: 'brick-interactable-accessing' stamp: 'AliakseiSyrel 10/11/2014 13:45'!
selectedColor: anObject
	selectedColor := anObject! !

!GLMInteractableBrick methodsFor: 'brick-interactable-testing' stamp: 'AliakseiSyrel 3/21/2015 19:48'!
isDoubleClickEnabled

	^ isDoubleClickEnabled ifNil: [ isDoubleClickEnabled := false ]! !

!GLMInteractableBrick methodsFor: 'brick-interactable-accessing' stamp: 'AliakseiSyrel 10/11/2014 13:44'!
normalImage: anObject
	normalImage := anObject! !

!GLMInteractableBrick methodsFor: 'brick-interactable-actions' stamp: 'AliakseiSyrel 2/25/2015 16:37'!
deselect
	"notifies #onMouseUnhover"
	self isSelected ifTrue: [
		isSelected := false.
		self announce: #onMouseUnhover.
		self changed ]! !

!GLMInteractableBrick methodsFor: 'brick-interactable-actions' stamp: 'AliakseiSyrel 2/25/2015 16:37'!
depress
	self isPressed ifTrue: [
		isPressed := false.
		self changed.
		^ true ].
	^ false! !

!GLMInteractableBrick methodsFor: 'brick-interactable-accessing' stamp: 'AliakseiSyrel 10/11/2014 13:45'!
selectedImage: anObject
	selectedImage := anObject! !

!GLMInteractableBrick methodsFor: 'brick-interactable-accessing' stamp: 'AliakseiSyrel 10/11/2014 13:43'!
checkedColor: anObject
	checkedColor := anObject! !

!GLMInteractableBrick methodsFor: 'brick-morph-mouse-events' stamp: 'AliakseiSyrel 2/13/2015 01:22'!
mouseEnter: evt
	super mouseEnter: evt.
	^ self select: evt! !

!GLMInteractableBrick methodsFor: 'brick-interactable-accessing' stamp: 'AliakseiSyrel 10/17/2014 10:15'!
state

	^ self class! !

!GLMInteractableBrick methodsFor: 'brick-interactable-actions' stamp: 'AliakseiSyrel 2/13/2015 01:22'!
select: anEvent

	self select! !

!GLMInteractableBrick methodsFor: 'brick-interactable-accessing' stamp: 'AliakseiSyrel 10/11/2014 13:43'!
currentImage
	^ self state pressed: (self isPressed) selected: (self isSelected) checked: (self isChecked) of: self! !

!GLMInteractableBrick methodsFor: 'brick-interactable-accessing' stamp: 'AliakseiSyrel 10/11/2014 13:44'!
normalImage
	^ normalImage! !

!GLMInteractableBrick methodsFor: 'brick-interactable-actions' stamp: 'JurajKubelka 2/27/2015 12:59'!
check: aBoolean
	aBoolean
		ifTrue: [ self check ]
		ifFalse: [ self uncheck ]! !

!GLMInteractableBrick methodsFor: 'brick-morph-mouse-events' stamp: 'AliakseiSyrel 3/24/2015 01:19'!
mouseDown: evt
	|selectors|
	
	self isDoubleClickEnabled ifFalse: [
		super mouseDown: evt.
		^ self press ].
	
	selectors := Array
				with: #click:
				with: #doubleClick:
				with: #singleClick:
				with: nil.
				
	evt hand
		waitForClicksOrDrag: self
		event: evt
		selectors: selectors
		threshold: 10.
! !

!GLMInteractableBrick methodsFor: 'brick-interactable-actions' stamp: 'AliakseiSyrel 3/24/2015 01:38'!
singleClick: anEvent

	self announce: #onSingleClicked event: anEvent! !

!GLMInteractableBrick methodsFor: 'brick-morph-mouse-events' stamp: 'AliakseiSyrel 2/16/2015 14:45'!
mouseLeave: evt
	super mouseLeave: evt.
	^ self deselect: evt! !

!GLMInteractableBrick methodsFor: 'brick-interactable-actions' stamp: 'AliakseiSyrel 2/25/2015 16:38'!
select
	"notifies #onMouseHover"
	self isSelected ifFalse: [ 
		isSelected := true.
		self announce: #onMouseHover.
		self changed ]! !

!GLMInteractableBrick methodsFor: 'brick-interactable-actions' stamp: 'AliakseiSyrel 3/24/2015 01:37'!
doubleClick: anEvent

	self announce: #onDoubleClicked event: anEvent.
	^ false! !

!GLMInteractableBrick methodsFor: 'brick-interactable-accessing' stamp: 'AliakseiSyrel 10/11/2014 13:43'!
checkedColor
	^ checkedColor! !

!GLMInteractableBrick class methodsFor: 'states' stamp: 'AliakseiSyrel 11/27/2014 12:59'!
pressedColor: isPressed selectedColor: isSelected checkedColor: isChecked of:aTrick
	"answers sender with image, corresponding specified state"
	
	"pressed has the highest priority"
	(isPressed & aTrick pressedColor notNil)
		ifTrue: [ ^ aTrick pressedColor ].
		
	(isChecked & aTrick checkedColor notNil)
		ifTrue: [ ^ aTrick checkedColor ].
		
	(((isPressed & aTrick pressedColor isNil) | isSelected) & aTrick selectedColor notNil)
		ifTrue: [ ^ aTrick selectedColor ].

	
	^ aTrick normalColor.! !

!GLMInteractableBrick class methodsFor: 'states' stamp: 'AliakseiSyrel 10/17/2014 10:15'!
pressedColor: isPressed selectedColor: isSelected of: aTrick
	^ self pressedColor: isPressed selectedColor: isSelected checkedColor: false of: aTrick! !

!GLMInteractableBrick class methodsFor: 'states' stamp: 'AliakseiSyrel 10/17/2014 10:14'!
normalColorOf: aTrick
	^ self pressedColor: false selectedColor: false of: aTrick! !

!GLMInteractableBrick class methodsFor: 'states' stamp: 'AliakseiSyrel 11/27/2014 12:58'!
pressed: isPressed selected: isSelected checked: isChecked of: aTrick
	"answers sender with image, corresponding specified state"
	
	"pressed has the highest priority"
	(isPressed & aTrick pressedImage notNil)
		ifTrue: [ ^ aTrick pressedImage ].
	
	(isChecked & aTrick checkedImage notNil)
		ifTrue: [ ^ aTrick checkedImage ].
		
	(((isPressed & aTrick pressedImage isNil) | isSelected) & aTrick selectedImage notNil)
		ifTrue: [ ^ aTrick selectedImage ].
	
	^ aTrick normalImage.! !

!GLMInteractableBrick class methodsFor: 'states' stamp: 'AliakseiSyrel 10/17/2014 10:15'!
pressed: isPressed selected: isSelected of: aTrick
	^ self pressed: isPressed selected: isSelected checked: false of: aTrick! !

!GLMInteractableBrick class methodsFor: 'states' stamp: 'AliakseiSyrel 10/17/2014 10:14'!
pressed: isPressed of: aTrick
	^ self pressed: isPressed selected: false of: aTrick! !

!GLMInteractableBrick class methodsFor: 'states' stamp: 'AliakseiSyrel 10/17/2014 10:14'!
normalOf: aTrick
	^ self pressed: false selected: false of: aTrick! !

!GLMInteractableBrick class methodsFor: 'states' stamp: 'AliakseiSyrel 10/17/2014 10:15'!
selected: isSelected of: aTrick
	^ self pressed: false selected: isSelected of: aTrick! !

!GLMInteractableBrick class methodsFor: 'states' stamp: 'AliakseiSyrel 10/17/2014 10:15'!
pressedColor: isPressed of: aTrick
	^ self pressedColor: isPressed selectedColor: false of: aTrick! !

!GLMInteractableBrick class methodsFor: 'states' stamp: 'AliakseiSyrel 10/17/2014 10:15'!
selectedColor: isSelected of: aTrick
	^ self pressedColor: false selectedColor: isSelected of: aTrick! !

!GLMInteractableBrickRenderer commentStamp: 'AliakseiSyrel 10/17/2014 10:34'!
A GLMInteractableBrickRenderer is more advanced Brick renderer, that is used in all interactable Bricks to allow on-fly change of background color or image
!
!GLMInteractableBrickRenderer methodsFor: 'rendering' stamp: 'AliakseiSyrel 1/24/2015 01:14'!
renderColorOf: aBrick on: aCanvas
	|color|
	color := aBrick currentColor.
	color ifNotNil: [
		aCanvas fillRectangle: (aBrick brickBounds expandBy: aBrick shadowWidth negated) color: color ]! !

!GLMInteractableBrickRenderer methodsFor: 'rendering' stamp: 'AliakseiSyrel 1/24/2015 01:13'!
render: aBrick on: aCanvas

	self
		renderBackgroundColorOf: aBrick on: aCanvas;
		renderShadowOf: aBrick on: aCanvas;
		renderColorOf: aBrick on: aCanvas;
		renderImageOf: aBrick on: aCanvas;
		renderBorderOf: aBrick on: aCanvas! !

!GLMInteractableBrickRenderer methodsFor: 'rendering' stamp: 'AliakseiSyrel 1/24/2015 01:14'!
renderImageOf: aBrick on: aCanvas
	|image|
	
	image := aBrick currentImage.
	
	image ifNotNil: [
		aCanvas
			translucentImage: (GLMBrick resizeImage: image scale: ((aBrick brickBounds expandBy: aBrick shadowWidth negated) extent / image extent))
			at: (aBrick brickBounds expandBy: aBrick shadowWidth negated) origin ]! !

!GLMLabelBrick commentStamp: 'AliakseiSyrel 3/17/2015 21:31'!
A GLMLabelBrick is standard label Brick, that can shrink text if it's size becomes smaller then actual text size.

Text shrinking works out of box, you don't need to do anything

Instance Variables
	dotsBrick		<GLMStringBrick>
	isDotsAdded:		<boolean>
	stringBrick:		<GLMStringBrick>

dotsBrick
	- represents a Brick that is added at the end of the text when Brick's size becomes smaller than actual text size

isDotsAdded
	- true if dotsBrick is currently added visible, false otherwise

stringBrick
	- represents actual label text Brick
!
!GLMLabelBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 2/13/2015 20:30'!
textColor

	^ self label textColor! !

!GLMLabelBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 2/26/2015 00:19'!
hShrinkWrap
	super hShrinkWrap.
	
	self label hShrinkWrap.
	self dotsBrick hShrinkWrap! !

!GLMLabelBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 2/25/2015 18:20'!
vShrinkWrap
	super vShrinkWrap.
	
	self label vShrinkWrap.
	self dotsBrick vShrinkWrap! !

!GLMLabelBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 3/27/2015 01:14'!
hSpaceFill: anInteger
	super hSpaceFill: anInteger.
	
	self label hSpaceFill.
	self dotsBrick hShrinkWrap.! !

!GLMLabelBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 2/13/2015 20:28'!
textColor: aColor
	<brickBuilderProperty: #Text name: 'Text color' as: #brickBuilderEvaluate getter: #textColor model: #GLMUIBuilderTextFieldProperty>

	self label textColor: aColor.
	self dotsBrick textColor: aColor! !

!GLMLabelBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 2/13/2015 20:56'!
font: aLogicalFont

	self label font: aLogicalFont.
	self dotsBrick font: aLogicalFont.! !

!GLMLabelBrick methodsFor: 'label-default' stamp: 'AliakseiSyrel 10/16/2014 14:33'!
defaultDotsText
	^ '...'! !

!GLMLabelBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 10/16/2014 14:09'!
text
	^ self label text! !

!GLMLabelBrick methodsFor: 'brick-geometry' stamp: 'AliakseiSyrel 2/26/2015 00:23'!
height: anObject

	self vSpaceFill.
	super height: anObject.! !

!GLMLabelBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 3/27/2015 02:14'!
initialize
	super initialize.
	
	stringBrick := self newStringBrick.
	dotsBrick := self newStringBrick.
	
	self
		hShrinkWrap;
		vShrinkWrap.
	
	stringBrick
			marginRight: self defaultInsetBeforeDots.
	self privateAddBrickBack: stringBrick.
	
	"creating dots morph, that will be displayed when text is being clipped"
	dotsBrick
		text: self defaultDotsText;
		width: #approximateWidth;
		floating: #right;
		zIndex: 2;
		marginTop: 1! !

!GLMLabelBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 2/13/2015 20:29'!
fontSize

	^ self label fontSize! !

!GLMLabelBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 2/13/2015 20:29'!
fontSize: aNumber
	<brickBuilderProperty: #Text name: 'Font size' as: #asInteger getter: #fontSize model: #GLMUIBuilderTextFieldProperty>

	self label fontSize: aNumber.
	self dotsBrick fontSize: aNumber! !

!GLMLabelBrick methodsFor: 'brick-geometry' stamp: 'AliakseiSyrel 2/26/2015 00:23'!
width: anObject

	self hSpaceFill.
	super width: anObject.! !

!GLMLabelBrick methodsFor: 'brick-geometry' stamp: 'AliakseiSyrel 2/11/2015 12:28'!
approximateWidth
	
	^ self label approximateWidth + self hMargin + self hPadding! !

!GLMLabelBrick methodsFor: 'label-brick-accessing' stamp: 'AliakseiSyrel 10/17/2014 10:00'!
dotsBrick

	^ dotsBrick! !

!GLMLabelBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 10/18/2014 14:42'!
weightValue: anInteger

	self label weightValue: anInteger.
	self dotsBrick weightValue: anInteger.! !

!GLMLabelBrick methodsFor: 'label-brick-creation' stamp: 'AliakseiSyrel 10/17/2014 09:59'!
newStringBrick
	^ GLMStringBrick new! !

!GLMLabelBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 2/26/2015 00:29'!
text: aString
	<brickBuilderProperty: #Text name: 'Text' as: #asString getter: #text model: #GLMUIBuilderTextFieldProperty>
	
	self label text: aString.
	self wrappedBounds markWidthDirty.
	self doLayout! !

!GLMLabelBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 2/13/2015 20:28'!
textPosition

	^ self label textPosition! !

!GLMLabelBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/24/2015 01:19'!
familyName: aString

	self label familyName: aString.
	self dotsBrick familyName: aString! !

!GLMLabelBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 3/27/2015 01:15'!
vSpaceFill: anInteger
	super vSpaceFill: anInteger.
	
	self label vSpaceFill.
	self dotsBrick vSpaceFill.! !

!GLMLabelBrick methodsFor: 'label-brick-accessing' stamp: 'AliakseiSyrel 10/17/2014 10:00'!
label
	^ stringBrick! !

!GLMLabelBrick methodsFor: 'brick-geometry' stamp: 'AliakseiSyrel 2/11/2015 12:31'!
approximateHeight
	
	^ self label approximateHeight + self vMargin + self vPadding! !

!GLMLabelBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 2/13/2015 20:29'!
textPosition: aSymbol
	<brickBuilderProperty: #Text name: 'Text position' as: #asSymbol getter: #textPosition model: #GLMUIBuilderTextFieldProperty>

	self label textPosition: aSymbol.
	self dotsBrick textPosition: aSymbol.! !

!GLMLabelBrick methodsFor: 'brick-layout-events' stamp: 'AliakseiSyrel 3/19/2015 10:32'!
onLayouted
	super onLayouted.
	
	self label isFitsInParent
		ifTrue: [ self isDotsAdded
			ifTrue: [
				self privateRemoveBrick: self dotsBrick.
				self doLayoutForce.
				self changed ] ]
		ifFalse: [ self isDotsAdded
			ifFalse: [
				self privateAddBrickBack: self dotsBrick.
				self dotsBrick wrappedBounds height: self outerBounds height.
				self layoutPolicy layoutFloating: self dotsBrick in: self brickBounds.
				self doLayoutForce.
				self changed ] ]
	
	! !

!GLMLabelBrick methodsFor: 'label-testing' stamp: 'AliakseiSyrel 3/19/2015 10:21'!
isDotsAdded

	^ self hasSubbrick: self dotsBrick! !

!GLMLabelBrick methodsFor: 'label-brick-accessing' stamp: 'AliakseiSyrel 3/18/2015 17:14'!
contents: aStringOrText
	"alias for text: added to support polymorphism with default morphic label widgets"
	self text: aStringOrText asString! !

!GLMLabelBrick methodsFor: 'label-default' stamp: 'AliakseiSyrel 10/16/2014 14:03'!
defaultInsetBeforeDots
	^ 1! !

!GLMLabelBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:27'!
gtExampleWithPopup
	<gtExample: 'Label with text and popup showing when hovered with mouse'>
	^ self new
		enable;
		text: 'Hello';
		textPosition: #center;
		familyName: 'Bitmap DejaVu Sans';
		fontSize: 11;
		padding: 5;
		with: [ :b  | b
			when: #onMouseHover do: [ GLMPopupBrick new beHelp; openFor: b ] ]! !

!GLMLabelBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:48'!
exampleWithPopupOpen
	
	self gtExampleWithPopup openCenteredInBrickWindowLabeled: 'Label example'! !

!GLMLabelBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:27'!
gtExample
	<gtExample: 'Label with text'>
	^ self new
		text: 'Label'! !

!GLMLabelBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:48'!
exampleOpen

	self gtExample openCenteredInBrickWindow! !

!GLMLabelPresentation methodsFor: 'rendering' stamp: 'tg 3/30/2010 23:06'!
renderGlamorouslyOn: aRenderer 
	self registerAnnouncements.
	^ aRenderer renderLabelPresentation: self! !

!GLMLinearLayout methodsFor: 'height' stamp: 'AliakseiSyrel 4/2/2015 01:03'!
heightMyselfDependency: aBrick
	"when height depends only from aBrick just return its cutom height"
	
	^ aBrick layout height brickValue: aBrick brick! !

!GLMLinearLayout methodsFor: 'width' stamp: 'AliakseiSyrel 2/3/2015 09:28'!
widthChildrenDependency: aBrick

	^ self subclassResponsibility! !

!GLMLinearLayout methodsFor: 'height' stamp: 'AliakseiSyrel 2/3/2015 10:09'!
heightParentDependency: aBrick

	^ self subclassResponsibility! !

!GLMLinearLayout methodsFor: 'floating' stamp: 'AliakseiSyrel 2/8/2015 18:38'!
layoutFloatingLeft: aBrick in: newBounds
	| left top |
	
	left := aBrick marginLeft.
	top := aBrick marginTop.
	
	aBrick brickBounds: (left@top extent: aBrick extent).
	
	^ 0! !

!GLMLinearLayout methodsFor: 'width' stamp: 'AliakseiSyrel 4/2/2015 01:05'!
widthMyselfDependency: aBrick

	^ aBrick layout width brickValue: aBrick brick! !

!GLMLinearLayout methodsFor: 'testing' stamp: 'AliakseiSyrel 2/9/2015 22:47'!
hasHeightRestrictions: aBrick

	^ aBrick layout hasMinHeight | aBrick layout hasMaxHeight! !

!GLMLinearLayout methodsFor: 'testing' stamp: 'AliakseiSyrel 2/9/2015 22:48'!
hasWidthRestrictions: aBrick

	^ aBrick layout hasMinWidth | aBrick layout hasMaxWidth! !

!GLMLinearLayout methodsFor: 'floating' stamp: 'AliakseiSyrel 4/2/2015 01:09'!
isFloating: aBrick
	
	aBrick layout floating = #none ifTrue: [ ^ false ].
	
	^ self respondsTo: (self floatingMethodFor: aBrick layout floating)! !

!GLMLinearLayout methodsFor: 'floating' stamp: 'AliakseiSyrel 4/2/2015 01:09'!
layoutFloating: aBrick in: newBounds
	"must return an integer that will be added to the offset, if necessary"
	
	|float symbol|
	float := aBrick layout floating.
	symbol := self floatingMethodFor: float.
	
	^ (self respondsTo: symbol)
		ifTrue: [ self perform: symbol with: aBrick with: newBounds ]
		ifFalse: [ 0 ]! !

!GLMLinearLayout methodsFor: 'height' stamp: 'AliakseiSyrel 2/3/2015 09:28'!
heightChildrenDependency: aBrick

	^ self subclassResponsibility! !

!GLMLinearLayout methodsFor: 'height' stamp: 'AliakseiSyrel 2/9/2015 22:54'!
normalizeHeight: anInteger of: aBrick

	^ (anInteger max: (aBrick layout minHeight brickValue: aBrick))
		min: (aBrick layout maxHeight brickValue: aBrick)! !

!GLMLinearLayout methodsFor: 'width' stamp: 'AliakseiSyrel 2/3/2015 10:09'!
widthParentDependency: aBrick
	
	^ self subclassResponsibility! !

!GLMLinearLayout methodsFor: 'floating' stamp: 'AliakseiSyrel 2/25/2015 23:05'!
layoutFloatingRight: aBrick in: newBounds
	| left top |
	
	left := aBrick owner width - aBrick width - aBrick marginRight - aBrick owner paddingRight.
	top := aBrick marginTop + aBrick owner paddingTop.
	
	aBrick brickBounds: (left@top extent: aBrick extent).
	
	^ 0! !

!GLMLinearLayout methodsFor: 'height' stamp: 'AliakseiSyrel 4/2/2015 15:35'!
updateHeight: aBrick
	"this method should be called only when height of aBrick is dirty"
	aBrick isHeightClean ifTrue: [ Exception signal: 'Clean height can''t be updated!!' ].
	aBrick layout vState updateHeight: aBrick on: self
	
	
	! !

!GLMLinearLayout methodsFor: 'width' stamp: 'AliakseiSyrel 2/9/2015 22:54'!
normalizeWidth: anInteger of: aBrick

	^ (anInteger max: (aBrick layout minWidth brickValue: aBrick))
		min: (aBrick layout maxWidth brickValue: aBrick)! !

!GLMLinearLayout methodsFor: 'layout' stamp: 'AliakseiSyrel 2/3/2015 09:23'!
layout: aBrick in: newBounds

	^ self subclassResponsibility! !

!GLMLinearLayout methodsFor: 'layout' stamp: 'AliakseiSyrel 2/13/2015 18:20'!
layout: aBrick in: aRectangle inject: anInteger into: aBlock

	aBrick subbricks inject: anInteger into:[ :origin :each | |result|
		result := origin + ((self isFloating: each)
			ifFalse: [ aBlock cull: origin cull: each ]
			ifTrue: [ self layoutFloating: each in: aRectangle ]).
		"applying aligning: #none, #left, #center, #right"
		self align: each in: aBrick anchorPoint: origin inContext: nil.
		each onLayouted.
		result ].! !

!GLMLinearLayout methodsFor: 'width' stamp: 'AliakseiSyrel 4/2/2015 14:03'!
updateWidth: aBrick
	"aBrick is a Brick that uses me as current layout"
	"this method should be called only when width of aBrick is dirty"
	aBrick isWidthClean ifTrue: [ Exception signal: 'Clean width can''t be updated!!' ].
	aBrick layout hState updateWidth: aBrick on: self
	
	
	! !

!GLMLinearLayout methodsFor: 'floating' stamp: 'AliakseiSyrel 2/8/2015 17:13'!
floatingMethodFor: aSymbol

	^ ('layoutFloating', (aSymbol capitalized), ':in:') asSymbol! !

!GLMLinearLayout methodsFor: 'enumerating' stamp: 'AliakseiSyrel 2/8/2015 18:51'!
nonFloatSubbricks: aBrick

	^ aBrick subbricks select: [ :each | each layout floating = #none ]! !

!GLMLinearLayout methodsFor: 'layout' stamp: 'AliakseiSyrel 2/13/2015 18:20'!
align: aBrick in: parentBrick anchorPoint: aPoint inContext: aContext

	^ self subclassResponsibility! !

!GLMLinearLayout methodsFor: 'notifying' stamp: 'AliakseiSyrel 2/23/2015 14:15'!
sendEvent: aLayoutEvent to: aBrick

	aBrick onLayoutEvent: aLayoutEvent! !

!GLMLipsumWithSegmentsExample commentStamp: '<historical>'!
self new open!
!GLMLipsumWithSegmentsExample methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 20:51'!
presentation
	^ GLMCompositePresentation new
		with: [ :a | 
			| t seg |
			t := a rubricText.
"			t withLineNumbers: true.
			t withAnnotation: true.
			t wrapped: true.
			t tabWidth: 40.
			t withColumns: true.
"			
			seg := RubUnderlinedSegmentMorph from: 1 to: 29.
			seg icon: self iconProvider smallErrorIcon.
			seg label: 'Please review'.
			seg iconBlock: [ :segment :event | segment delete ].
			t addTextSegment: seg.
			
			seg := RubPlainSegmentMorph from: 535 to: 659.
			seg color: (Color green alpha: 0.3).
			seg icon: self iconProvider smallErrorIcon.
			seg label: 'Remove'.
			seg
				iconBlock: [ :segment :event | 
					segment textArea selectFrom: segment firstIndex to: segment lastIndex.
					segment textArea replaceSelectionWith: ''.
					segment delete ].
			t addTextSegment: seg.
			seg := RubUnderlinedSegmentMorph from: 1000 to: 1030.
			seg icon: self iconProvider smallHelpIcon.
			seg label: 'Print it'.
			seg iconBlock: [ :segment :event | Transcript show: segment getText ].
			t addTextSegment: seg]! !

!GLMListMorphicTest methodsFor: 'tests' stamp: ''!
testOnlyOneMorphPerRowInList
	| browser listMorph nodeMorphs|
	"self debug: #testOnlyOneMorphPerRowInList"
	browser := GLMTabulator new.
	browser
		column: #one.
	(browser transmit)
		to: #one;
		andShow: [ :a | a list display: [ :x | x ] ].
	window := browser openOn: (1 to: 100).
	World doOneCycle.
	listMorph := self find: MorphTreeMorph in: window.
	nodeMorphs := (self find: MorphTreeTransformMorph in: listMorph) submorphs.
	self assert: nodeMorphs size equals: 100.
	nodeMorphs do: [:node | "Always fails on node 43" self assert: node submorphs size equals: 1].! !

!GLMListMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 8/25/2013 22:48'!
testTwoPanesMultipleSelectionWithChange
	| browser treeMorphOne treeNodeMorph treeMorphTwo |
	browser := GLMTabulator new.
	browser
		column: #one;
		column: #two;
		column: #three.
	(browser transmit)
		to: #one;
		andShow: [ :a | a list display: [ :x | 1 to: x ] ].
	(browser transmit)
		to: #two;
		from: #one;
		andShow: [ :a | 
					(a list)
						beMultiple;
						display: [ :x | x * 10 to: x * 10 + 4 ] ].
	(browser transmit)
		to: #three;
		from: #two;
		andShow: [ :a | a text ].
	window := browser openOn: 4.	"we select 2 in the first pane"
	treeMorphOne := (window submorphs last submorphs at: 3) submorphs first submorphs first.
	treeNodeMorph := treeMorphOne scroller submorphs second.
	self send: treeMorphOne mouseUpOnItem: treeNodeMorph.	"we select all in the second pane"
	treeMorphTwo := (window submorphs last submorphs at: 4) submorphs first submorphs first.
	treeNodeMorph := treeMorphTwo scroller submorphs first.
	self send: treeMorphTwo mouseUpOnItem: treeNodeMorph.
	treeNodeMorph := treeMorphTwo scroller submorphs second.
	self send: treeMorphTwo mouseUpWithShift: true onItem: treeNodeMorph.
	self assert: ((browser paneNamed: #two) port: #selection) value asOrderedCollection equals: #(20 21) asOrderedCollection.	"we select 4 in the first pane"
	treeMorphOne := (window submorphs last submorphs at: 3) submorphs first submorphs first.
	treeNodeMorph := treeMorphOne scroller submorphs last.
	self send: treeMorphOne mouseUpOnItem: treeNodeMorph.	"we select the first two in the second pane"
	treeMorphTwo := (window submorphs last submorphs at: 4) submorphs first submorphs first.
	self assert: (treeMorphTwo model roots collect: #item) equals: #(40 41 42 43 44)  asOrderedCollection.
	treeNodeMorph := treeMorphTwo scroller submorphs first.
	self send: treeMorphTwo mouseUpOnItem: treeNodeMorph.
	treeNodeMorph := treeMorphTwo scroller submorphs second.
	self send: treeMorphTwo mouseUpWithShift: true onItem: treeNodeMorph.
	self assert: ((browser paneNamed: #two) port: #selection) value asOrderedCollection equals: #(40 41)  asOrderedCollection! !

!GLMListMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 12/18/2013 13:49'!
testTypeOfSingleSelection
	| composer firstTreeMorph treeNodeMorph |
	composer := GLMCompositePresentation new.
	composer list.
	window := composer openOn: { {1} asSet }.
	firstTreeMorph := self find: MorphTreeMorph in: window.
	treeNodeMorph := firstTreeMorph scroller submorphs first.
	self send: firstTreeMorph mouseUpOnItem: treeNodeMorph.
	self assert: composer selection equals: {1} asSet! !

!GLMListMorphicTest methodsFor: 'tests' stamp: 'Nicolasanquetil 5/3/2013 15:00'!
testTextBackgroundColor
	| browser firstTreeMorph secondTreeMorph treeNodeMorph txtMorph |
	browser := GLMTabulator new.
	browser column: #one.
	browser transmit
		to: #one;
		andShow: [ :a | 
					a list
						display: [ :x | 1 to: x ];
						textBackgroundColor: [ :aNumber | 
									(aNumber isDivisibleBy: 2)
										ifTrue: [ Color green ]
										ifFalse: [ Color red ] ] ].
	window := browser openOn: 4.
	firstTreeMorph := window submorphs last submorphs first submorphs first submorphs first.
	treeNodeMorph := firstTreeMorph scroller submorphs first.
	txtMorph := treeNodeMorph submorphs first submorphs first submorphs first.
	self assert: (txtMorph isKindOf: TextMorph).
	self assert: txtMorph backgroundColor equals: Color red.
	treeNodeMorph := firstTreeMorph scroller submorphs second.
	txtMorph := treeNodeMorph submorphs first submorphs first submorphs first.
	self assert: (txtMorph isKindOf: TextMorph).
	self assert: txtMorph backgroundColor equals: Color green.
	treeNodeMorph := firstTreeMorph scroller submorphs third.
	txtMorph := treeNodeMorph submorphs first submorphs first submorphs first.
	self assert: (txtMorph isKindOf: TextMorph).
	self assert: txtMorph backgroundColor equals: Color red.
	treeNodeMorph := firstTreeMorph scroller submorphs fourth.
	txtMorph := treeNodeMorph submorphs first submorphs first submorphs first.
	self assert: (txtMorph isKindOf: TextMorph).
	self assert: txtMorph backgroundColor equals: Color green! !

!GLMListMorphicTest methodsFor: 'tests' stamp: ''!
testListDoubleClickWithMultipleSelection
	| browser treeMorph treeNodeMorph lastTreeNodeMorph |
	browser := GLMFinder new.
	browser show: [:a | a tree beMultiple].
	window := browser openOn: ($a to: $d).
	treeMorph := window submorphs last submorphs first submorphs first submorphs first submorphs first.
	treeNodeMorph := treeMorph scroller submorphs first.
	lastTreeNodeMorph := treeMorph scroller submorphs last.
	self send: treeMorph mouseUpWithShift: false onItem: treeNodeMorph.
	self send: treeMorph mouseUpWithShift: true onItem: lastTreeNodeMorph.
	self send: treeMorph doubleClickWithShift: false onItem: treeNodeMorph.
	self assert: (browser panes first port: #strongSelection) value asSet equals: ($a to: $d) asSet! !

!GLMListMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 12/19/2013 11:54'!
testTypeOfMultipleSelection
	| composer firstTreeMorph treeNodeMorph |
	composer := GLMCompositePresentation new.
	composer list beMultiple.
	window := composer openOn: { {1} asSet . {1} asOrderedCollection }.
	firstTreeMorph := self find: MorphTreeMorph in: window.
	treeNodeMorph := firstTreeMorph scroller submorphs first.
	self send: firstTreeMorph mouseUpOnItem: treeNodeMorph.
	self assert: composer selection asOrderedCollection equals: {{1} asSet} asOrderedCollection! !

!GLMListMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 8/25/2013 22:48'!
testUpdateFromModel
	| browser treeMorphOne1 treeMorphTwo1 treeMorphOne2 treeMorphTwo2 |
	browser := GLMTabulator new.
	browser
		column: #one;
		column: #two.
	(browser transmit)
		to: #one;
		andShow: [ :a | a list display: [ :x | x - 3 to: x ] ].
	(browser transmit)
		to: #two;
		from: #one;
		andShow: [ :a | a list display: [ :x | x * 10 to: x * 10 + 2 ] ].
	window := browser openOn: 4.
	treeMorphOne1 := self find: MorphTreeMorph in: window.
	self assert: (treeMorphOne1 model roots collect: #item) equals: #(1 2 3 4) asOrderedCollection.
	((browser paneNamed: #one) port: #selection) value: 2.
	treeMorphTwo1 := self findLast: MorphTreeMorph in: window.
	self assert: (treeMorphTwo1 model roots collect: #item) equals: #(20 21 22) asOrderedCollection.
	browser entity: 8.
	treeMorphOne2 := self find: MorphTreeMorph in: window.
	self assert: (treeMorphOne2 model roots collect: #item) equals: #(5 6 7 8) asOrderedCollection.
	self assert: treeMorphOne1 ~= treeMorphOne2.
	self assert: window submorphs last submorphs last submorphs first submorphs isEmpty.
	((browser paneNamed: #one) port: #selection) value: 5.
	treeMorphTwo2 := self findLast: MorphTreeMorph in: window.
	self assert: (treeMorphTwo2 model roots collect: #item) equals: #(50 51 52) asOrderedCollection.
	self assert: treeMorphTwo1 ~= treeMorphTwo2! !

!GLMListMorphicTest methodsFor: 'tests' stamp: ''!
testListDoubleClick
	| browser treeMorph treeNodeMorph |
	browser := GLMFinder new.
	browser show: [ :a | a list ].
	window := browser openOn: ($a to: $d).
	treeMorph := window submorphs last submorphs first submorphs first submorphs first submorphs first.
	treeNodeMorph := treeMorph scroller submorphs first.
	self send: treeMorph mouseUpWithShift: false onItem: treeNodeMorph.
	self send: treeMorph doubleClickWithShift: false onItem: treeNodeMorph.
	self assert: (browser panes first port: #strongSelection) value equals: $a! !

!GLMListMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 12/18/2013 13:51'!
testMultipleSelectionWithChange
	| browser firstTreeMorph secondTreeMorph treeNodeMorph lastTreeNodeMorph |
	browser := GLMWrapper new.
	browser show: [ :a | 
					(a list)
						beMultiple;
						display: [ :x | x - 2 to: x ] ].
	window := browser openOn: 4.
	firstTreeMorph := window submorphs last submorphs first submorphs first submorphs first.
	treeNodeMorph := firstTreeMorph scroller submorphs first.
	lastTreeNodeMorph := firstTreeMorph scroller submorphs last.
	self send: firstTreeMorph mouseUpOnItem: treeNodeMorph.
	self send: firstTreeMorph mouseUpWithShift: true onItem: lastTreeNodeMorph.
	self
		assert: (firstTreeMorph model selection selectedNodePathList collect: [ :each | each first item ]) asOrderedCollection
		equals: #(2 3 4) asOrderedCollection.
	(browser pane port: #entity) value: 42.
	secondTreeMorph := window submorphs last submorphs first submorphs first submorphs first.
	treeNodeMorph := secondTreeMorph scroller submorphs first.
	lastTreeNodeMorph := secondTreeMorph scroller submorphs second.
	self send: secondTreeMorph mouseUpOnItem: treeNodeMorph.
	self send: secondTreeMorph mouseUpWithShift: true onItem: lastTreeNodeMorph.
	self
		assert: (secondTreeMorph model selection selectedNodePathList collect: [ :each | each first item ]) asOrderedCollection
		equals: #(40 41) asOrderedCollection! !

!GLMListMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 8/25/2013 22:48'!
testMultipleSelectionWithChangeFromModel
	| browser firstTreeMorph secondTreeMorph |
	browser := GLMTabulator new.
	browser column: #one.
	(browser transmit)
		to: #one;
		andShow: [ :a | 
					(a list)
						beMultiple;
						display: [ :x | x - 2 to: x ] ].
	window := browser openOn: 4.
	firstTreeMorph := window submorphs last submorphs first submorphs first submorphs first.
	self assert: (firstTreeMorph model roots collect: #item) equals: #(2 3 4) asOrderedCollection.
	((browser paneNamed: #one) port: #selection) value: #(2 3).
	self assert: ((browser paneNamed: #one) port: #selection) value asOrderedCollection equals: #(2 3) asOrderedCollection.
	(browser pane port: #entity) value: 42.
	secondTreeMorph := window submorphs last submorphs first submorphs first submorphs first.
	self assert: (secondTreeMorph model roots collect: #item) equals: #(40 41 42) asOrderedCollection.
	((browser paneNamed: #one) port: #selection) value: #(40 41).
	self
		assert: ((browser paneNamed: #one) port: #selection) value asOrderedCollection
		equals: #(40 41) asOrderedCollection.
	self assert: firstTreeMorph ~= secondTreeMorph! !

!GLMListPresentation commentStamp: 'AndreiChis 10/3/2014 18:28'!
A GLMListPresentation simply shows the given elements within a list.

Instance Variables
	tagsBlock:		<Object>
	tagsFilterBlock:		<Object>

tagsBlock
	- xxxxx

tagsFilterBlock
	- xxxxx
!
!GLMListPresentation methodsFor: 'validation' stamp: ''!
defaultValidate: anObject on: aPort
	"we only allow objects that are in the display value"

	(aPort name == #selection) ifFalse: [ ^ true ].
	self entity isNil ifTrue: [ ^ false ].
	^ self isMultiple
		ifTrue: [ anObject isCollection and: [
				anObject allSatisfy: [:each | self displayValue includes: each ] ]]
		ifFalse: [ self displayValue includes: anObject ]! !

!GLMListPresentation methodsFor: 'tags' stamp: ''!
computeTagsFor: aGlamourValue 

	^ self computeTagsFor: aGlamourValue from: self tagsBlock! !

!GLMListPresentation methodsFor: 'scripting' stamp: ''!
tags: aBlock

	self tagsBlock: aBlock.
	self hasTagsFilter ifFalse:[ self tagsFilter: aBlock ]! !

!GLMListPresentation methodsFor: 'rendering' stamp: ''!
renderGlamorouslyOn: aRenderer 
	self registerAnnouncements.
	^ aRenderer renderListPresentation: self! !

!GLMListPresentation methodsFor: 'tags' stamp: ''!
computeTagsFor: aGlamourValue from: aBlock
	| value |
	
	aBlock ifNil: [ ^ OrderedCollection new ].
	value := aBlock glamourValue: aGlamourValue.
	^ value isString
		ifTrue: [ OrderedCollection with: value ]
		ifFalse: [ value asOrderedCollection ]! !

!GLMListPresentation methodsFor: 'scripting' stamp: 'AndreiChis 4/20/2014 23:00'!
tagsBlock: anObject
	tagsBlock := anObject! !

!GLMListPresentation methodsFor: 'accessing' stamp: 'AndreiChis 4/20/2014 23:00'!
tagsBlock
	^ tagsBlock! !

!GLMListPresentation methodsFor: 'tags' stamp: ''!
computeTagsFilterFor: aGlamourValue 

	^ self computeTagsFor: aGlamourValue from: self tagsFilterBlock! !

!GLMListPresentation methodsFor: 'testing' stamp: ''!
hasTagsFilter
	^ self tagsFilterBlock notNil! !

!GLMListPresentation methodsFor: 'testing' stamp: ''!
hasTags
	^ self tagsBlock notNil! !

!GLMListPresentation methodsFor: 'scripting' stamp: 'AndreiChis 4/20/2014 23:00'!
tagsFilter: aBlock
	tagsFilterBlock := aBlock ! !

!GLMListPresentation methodsFor: 'accessing' stamp: 'AndreiChis 4/20/2014 23:00'!
tagsFilterBlock
	^ tagsFilterBlock! !

!GLMListPresentationTest methodsFor: 'tests' stamp: 'DamienCassou 5/8/2011 19:11'!
testSorted
	| presentation | 
	presentation := GLMListPresentation new. 
	presentation entity: #(#foo #bar #blurp).
	self assert: presentation displayValue equals: #(#foo #bar #blurp).
	presentation sorted. 
	self assert: presentation displayValue equals: #(#bar #blurp #foo).
	presentation sorted: [:a :b | a size < b size].  
	self assert: presentation displayValue equals: #(#bar #foo #blurp).! !

!GLMListPresentationTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testValidatePorts
	| pane presentation |
	pane := GLMPane named: 'test'.
	presentation := GLMListPresentation new.
	pane addPresentation: presentation.
	presentation shouldValidate: true.
	presentation entity: #(1 2).
	presentation selection: 2.
	self assert: presentation selection equals: 2.
	presentation selection: 3.	"this should be invalid"
	self assert: presentation selection equals: 2! !

!GLMListPresentationTest methodsFor: 'tests' stamp: 'tg 9/20/2009 15:19'!
testChildren
	| tree |
	tree := GLMTreePresentation new.
	tree transformation: [:aNumber | (1 to: aNumber ) collect: #printString ].
	tree children: [:each | self assert: (each isKindOf: String)  ].
	tree entity: 42.! !

!GLMListPresentationTest methodsFor: 'tests' stamp: 'lr 6/4/2010 13:50'!
testValidateWithMultipleSelection
	| pane presentation |
	pane := GLMPane named: 'test'. 
	presentation := GLMListPresentation new.
	presentation beMultiple.
	presentation shouldValidate: true.
	pane addPresentation: presentation.
	presentation entity: ($a to: $d).
	self assert: (presentation validate: (Array with: $a) on: (pane port: #selection)).
	self assert: (presentation validate: (Array with: $a with: $b) on: (pane port: #selection)).
	self deny: (presentation validate: ($a) on: (pane port: #selection)).
	self deny: (presentation validate: (Array with: $z) on: (pane port: #selection)).! !

!GLMListPresentationTest methodsFor: 'tests' stamp: 'lr 6/4/2010 13:50'!
testValidateOn
	| pane presentation |
	pane := GLMPane named: 'test'. 
	presentation := GLMListPresentation new.
	pane addPresentation: presentation.
	presentation shouldValidate: true.
	presentation entity: ($a to: $d).
	self deny: (presentation validate: (Array with: $a) on: (pane port: #selection)).
	self deny: (presentation validate: (Array with: $a with: $b) on: (pane port: #selection)).
	self assert: (presentation validate: $a on: (pane port: #selection)).
	self assert: (presentation validate: $b on: (pane port: #selection)).
	self deny: (presentation validate: $z on: (pane port: #selection)).! !

!GLMListPresentationTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testToSend
	| list |
	list := GLMListPresentation new.
	list selectionTransformation: [ :x | x + 1 ].
	list entity: (1 to: 100).
	list selection: 41.
	self assert: list selection equals: 42! !

!GLMListPresentationTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testCustomValidation
	| pane presentation |
	pane := GLMPane named: 'test'.
	presentation := GLMPresentation new.
	pane addPresentation: presentation.
	presentation customValidation: [ :object :aport :entity | aport ~= #selection or: [ object = (entity last + 40) ] ].
	presentation entity: (OrderedCollection with: 1 with: 2).
	self assert: presentation entity last equals: 2.
	self assert: (presentation validate: 42 on: (pane port: #selection))! !

!GLMListingPresentation commentStamp: 'TudorGirba 2/4/2011 20:41'!
This is the abstract class for a presentation that is supposed to show a list of elements. Thus, the displayValue should be a list.

Instance Variables:
	tagsBlock	<Object>
	searchBlock	<MocketryProxy | Object | SMProxy>
	filterBlock	<MocketryProxy | Object | SMProxy>
	amountToShowBlock	<Object>
	allowsMultipleSelection	<Boolean>
	tagsFilterBlock	<MocketryProxy | Object | SMProxy>
	allowsDeselection	<Boolean>
	tagsStyle	<String>
	helpMessage	<String>!
!GLMListingPresentation methodsFor: 'scripting' stamp: ''!
searchOn: aBlock
	searchBlock := aBlock! !

!GLMListingPresentation methodsFor: 'accessing' stamp: ''!
selectionPath
	^ (self pane port: #selectionPath) value! !

!GLMListingPresentation methodsFor: 'accessing' stamp: ''!
allowDropOnItemBlock
	^ allowDropOnItemBlock! !

!GLMListingPresentation methodsFor: 'testing' stamp: ''!
isSingle 
	^ self isMultiple not! !

!GLMListingPresentation methodsFor: 'testing' stamp: ''!
isMultiple
	^ allowsMultipleSelection ifNil: [ allowsMultipleSelection := false ]! !

!GLMListingPresentation methodsFor: 'scripting' stamp: 'AndreiChis 1/16/2015 19:01'!
withSmalltalkSearch
	self
		searchOn: [:text :each | 
			Smalltalk compiler evaluate: ' | entity each | each := self. entity := each.', text for: each logged: false];
		helpMessage: 'Quick selection field. Given your INPUT, it executes: self select: [:each | INPUT ]'! !

!GLMListingPresentation methodsFor: 'scripting' stamp: ''!
allowDropOnItem: aBlock
	allowDropOnItemBlock := aBlock! !

!GLMListingPresentation methodsFor: 'accessing' stamp: ''!
transformDraggedItemBlock
	^ transformDraggedItemBlock! !

!GLMListingPresentation methodsFor: 'scripting' stamp: ''!
allowItemDrag: aBlock
	allowItemDragBlock := aBlock! !

!GLMListingPresentation methodsFor: 'scripting' stamp: ''!
filterOn: aBlock 
	filterBlock := aBlock! !

!GLMListingPresentation methodsFor: 'accessing' stamp: ''!
grayRoundedTags

	tagsStyle := #grayRoundedButton! !

!GLMListingPresentation methodsFor: 'accessing values' stamp: ''!
displayValue
	^ sortBlock 
		ifNil: [super displayValue]
		ifNotNil: [super displayValue sorted: sortBlock]! !

!GLMListingPresentation methodsFor: 'scripting' stamp: ''!
sorted: aBlock
	sortBlock := aBlock  ! !

!GLMListingPresentation methodsFor: 'accessing' stamp: 'AndreiChis 11/3/2013 12:41'!
amountToShow
	^ (amountToShowBlock ifNil: [ [ self defaultAmountToShow ] ]) glamourValue: self entity! !

!GLMListingPresentation methodsFor: 'accessing' stamp: ''!
filterStrategy
	^filterBlock! !

!GLMListingPresentation methodsFor: 'accessing' stamp: ''!
sortBlock: anObject
	sortBlock := anObject! !

!GLMListingPresentation methodsFor: 'accessing' stamp: ''!
selectionPath: anObject
	(self pane port: #selectionPath) value: anObject! !

!GLMListingPresentation methodsFor: 'accessing values' stamp: ''!
allow: passengerObject droppedOnItem: anItem
	^ self allowDropOnItemBlock glamourValue: (GLMMultiValue with: passengerObject with: anItem with: self)! !

!GLMListingPresentation methodsFor: 'accessing' stamp: ''!
whiteRectangledTags

	tagsStyle := #whiteRectangledButton! !

!GLMListingPresentation methodsFor: 'accessing values' stamp: ''!
accept: passengerObject droppedOnItem: anItem
	self dropOnItemBlock glamourValue: (GLMMultiValue with: passengerObject with: anItem with: self).
	^ true! !

!GLMListingPresentation methodsFor: 'tags' stamp: 'AndreiChis 4/20/2014 23:01'!
computeTagsFilterFor: aGlamourValue 
	self subclassResponsibility ! !

!GLMListingPresentation methodsFor: 'accessing' stamp: ''!
columns
	self flag: 'this is rather hackish, but needed to treat list and tree in the same way.'.
	^ OrderedCollection new! !

!GLMListingPresentation methodsFor: 'accessing' stamp: ''!
helpMessage

	^ helpMessage ifNil: [
		helpMessage := 'Search Input'
		]

	! !

!GLMListingPresentation methodsFor: 'testing' stamp: ''!
allowsFilter
	^ filterBlock notNil! !

!GLMListingPresentation methodsFor: 'testing' stamp: ''!
allowsSearch
	^ searchBlock notNil! !

!GLMListingPresentation methodsFor: 'scripting' stamp: ''!
transformDraggedItem: aBlock
	transformDraggedItemBlock := aBlock! !

!GLMListingPresentation methodsFor: 'testing' stamp: ''!
isDropTarget
	^ self dropOnItemBlock notNil! !

!GLMListingPresentation methodsFor: 'accessing' stamp: 'AndreiChis 3/30/2015 14:25'!
allowsRecursiveSearch: aBoolean
	allowsRecursiveSearch := aBoolean! !

!GLMListingPresentation methodsFor: 'accessing' stamp: ''!
allowsDeselection
	^ allowsDeselection ifNil: [allowsDeselection := false]! !

!GLMListingPresentation methodsFor: 'accessing' stamp: ''!
sortBlock
	^ sortBlock! !

!GLMListingPresentation methodsFor: 'scripting' stamp: ''!
beMultiple
	allowsMultipleSelection := true! !

!GLMListingPresentation methodsFor: 'tags' stamp: 'AndreiChis 4/20/2014 22:15'!
tagsFor: anObject fromProvider: aTagProvider to: operation
	| glamourValue |
	
	glamourValue := (anObject asGlamorousMultiValue, self entity asGlamorousMultiValue).
	^ operation == #show 
		ifTrue: [ aTagProvider computeTagsFor: glamourValue ] 
		ifFalse: [ aTagProvider computeTagsFilterFor: glamourValue ]! !

!GLMListingPresentation methodsFor: 'testing' stamp: ''!
isDragSource 
	^ self dropOnItemBlock notNil! !

!GLMListingPresentation methodsFor: 'accessing' stamp: ''!
textBackgroundColor:  aBlockOrAColor

	textBackgroundColor := aBlockOrAColor! !

!GLMListingPresentation methodsFor: 'accessing' stamp: ''!
textBackgroundColorFor: anObject
	^ self textBackgroundColor glamourValue: (anObject asGlamorousMultiValue, self entity asGlamorousMultiValue)! !

!GLMListingPresentation methodsFor: 'scripting' stamp: ''!
showOnly: aBlock
	amountToShowBlock := aBlock! !

!GLMListingPresentation methodsFor: 'accessing' stamp: ''!
childrenValueOf: anObject atLevel: anInteger
	self flag: 'this is rather hackish, but needed to treat list and tree in the same way.'.
	^ OrderedCollection new! !

!GLMListingPresentation methodsFor: 'scripting' stamp: ''!
sorted
	sortBlock := [:a :b | a < b]! !

!GLMListingPresentation methodsFor: 'accessing' stamp: ''!
tagsStyle

	^tagsStyle ifNil:[ self grayRoundedTags. tagsStyle ]! !

!GLMListingPresentation methodsFor: 'accessing' stamp: ''!
allowsDeselection: anObject
	allowsDeselection := anObject! !

!GLMListingPresentation methodsFor: 'tags' stamp: 'AndreiChis 4/20/2014 16:35'!
tagsFor: anObject to: operation
	
	^ self 
		tagsFor: anObject 
		fromProvider: self 
		to: operation! !

!GLMListingPresentation methodsFor: 'scripting' stamp: ''!
dropOnItem: aBlock
	dropOnItemBlock := aBlock! !

!GLMListingPresentation methodsFor: 'scripting' stamp: ''!
beSingle
	allowsMultipleSelection := false! !

!GLMListingPresentation methodsFor: 'scripting' stamp: ''!
allowDeselection
	self allowsDeselection: true! !

!GLMListingPresentation methodsFor: 'accessing' stamp: ''!
dropOnItemBlock
	^ dropOnItemBlock ! !

!GLMListingPresentation methodsFor: 'accessing values' stamp: 'EstebanLorenzano 4/1/2012 12:40'!
transformedDraggedItem: anItem
	^ self transformDraggedItemBlock 
		ifNotNil: [ :transform | transform glamourValue: (GLMMultiValue with: anItem with: self)]
		ifNil: [ anItem ]! !

!GLMListingPresentation methodsFor: 'testing' stamp: ''!
allowsItemDrag
	^ self allowItemDragBlock notNil! !

!GLMListingPresentation methodsFor: 'accessing' stamp: ''!
textBackgroundColor

	^ textBackgroundColor ifNil: [textBackgroundColor := Color transparent]! !

!GLMListingPresentation methodsFor: 'testing' stamp: ''!
allowsInput
	^ self allowsFilter or: [ self allowsSearch ]! !

!GLMListingPresentation methodsFor: 'accessing' stamp: 'AndreiChis 11/3/2013 12:41'!
defaultAmountToShow
	^ 500! !

!GLMListingPresentation methodsFor: 'tags' stamp: 'AndreiChis 4/20/2014 23:01'!
computeTagsFor: aGlamourValue 
	self subclassResponsibility ! !

!GLMListingPresentation methodsFor: 'accessing' stamp: ''!
helpMessage: aString

	helpMessage := aString.

	! !

!GLMListingPresentation methodsFor: 'accessing' stamp: ''!
childrenValueOf: anObject
	self flag: 'this is rather hackish, but needed to treat list and tree in the same way.'.
	^ OrderedCollection new! !

!GLMListingPresentation methodsFor: 'accessing' stamp: ''!
searchStrategy
	^ searchBlock! !

!GLMListingPresentation methodsFor: 'accessing' stamp: ''!
allowItemDragBlock
	^ allowItemDragBlock! !

!GLMListingPresentation methodsFor: 'accessing' stamp: 'AndreiChis 3/30/2015 14:25'!
allowsRecursiveSearch
	^ allowsRecursiveSearch ifNil: [allowsRecursiveSearch := true]! !

!GLMLiveLabelBrick commentStamp: 'AliakseiSyrel 3/19/2015 13:23'!
A GLMLiveLabelBrick is simple extended label brick that updates text every world step. Text logic can be set by sending textLogic: message to me.

Instance Variables
	textLogic:		<BlockClosure>

textLogic
	- defines text updating logic
!
!GLMLiveLabelBrick methodsFor: 'accessing' stamp: 'TudorGirba 2/18/2015 22:14'!
textLogic: aBlock
	textLogic := aBlock! !

!GLMLiveLabelBrick methodsFor: 'stepping and presenter' stamp: 'AliakseiSyrel 3/19/2015 13:22'!
step
	|newText|
	newText := self textLogic value asString.
	self text = newText ifTrue:  [ ^ self ].
	self text: newText.
	self doLayoutForce! !

!GLMLiveLabelBrick methodsFor: 'initialization' stamp: 'TudorGirba 2/18/2015 22:14'!
initialize
	super initialize.
	textLogic := [ :x | x ]! !

!GLMLiveLabelBrick methodsFor: 'testing' stamp: 'TudorGirba 2/18/2015 22:11'!
wantsSteps
	^ true! !

!GLMLiveLabelBrick methodsFor: 'accessing' stamp: 'TudorGirba 2/18/2015 22:15'!
textLogic 
	^ textLogic! !

!GLMLoggedObject commentStamp: 'AndreiChis 3/12/2015 00:01'!
A GLMLoggedObject is a custom announcer that logs all events that it announces.

Instance Variables
	logger:		<Object>

logger
	- xxxxx
!
!GLMLoggedObject methodsFor: 'accessing' stamp: 'tg 5/24/2010 16:43'!
logger: anObject
	logger := anObject! !

!GLMLoggedObject methodsFor: 'initialize-release' stamp: 'TudorGirba 5/18/2011 12:06'!
initialize 
	super initialize.
	logger := GLMLogger instance ! !

!GLMLoggedObject methodsFor: 'accessing' stamp: 'tg 5/24/2010 16:43'!
logger
	^ logger! !

!GLMLoggedObject methodsFor: 'copying' stamp: 'TudorGirba 7/11/2011 11:20'!
postCopy 
	super postCopy.
	self resetAnnouncer! !

!GLMLoggedObject methodsFor: 'announce' stamp: 'tg 5/25/2010 23:53'!
announce: anAnnouncement
	self logger logAnnouncement: anAnnouncement from: self. 
	super announce: anAnnouncement! !

!GLMLoggedObject class methodsFor: 'accessing' stamp: 'tg 5/24/2010 16:48'!
logger: aLogger
	logger := aLogger! !

!GLMLoggedObject class methodsFor: 'class initialization' stamp: 'tg 5/24/2010 17:05'!
initialize 
	logger := GLMLogger instance! !

!GLMLoggedObject class methodsFor: 'accessing' stamp: 'tg 5/24/2010 16:47'!
logger
	^ logger! !

!GLMLogger commentStamp: 'tg 5/24/2010 17:00'!
This is the abstract class for the Glamour loggers. These classes are typically used for debugging hte highly dynamic Glamour model.!
!GLMLogger methodsFor: 'logging' stamp: 'tg 5/24/2010 16:45'!
logAnnouncement: anAnnouncement from: aGLMObject 
	
	! !

!GLMLogger class methodsFor: 'accessing' stamp: 'tg 5/24/2010 17:08'!
reset
	instance := nil! !

!GLMLogger class methodsFor: 'accessing' stamp: 'tg 5/24/2010 17:03'!
instance
	^ instance ifNil: [
		instance := self nullInstance ]! !

!GLMLogger class methodsFor: 'accessing' stamp: 'tg 5/24/2010 17:04'!
instance: aLogger
	instance := aLogger ! !

!GLMLogger class methodsFor: 'accessing' stamp: 'tg 5/24/2010 16:47'!
nullInstance 
	^ nullInstance ifNil: [
		nullInstance := GLMNullLogger new ]! !

!GLMLoggerTest methodsFor: 'tests' stamp: 'AndreiChis 12/16/2013 18:35'!
testDefault
	(GLMLoggedObject withAllSubclasses reject: [:each | 
		each hasAbstractMethods ]) do: [ :each |
			self assert: each new logger == GLMLogger nullInstance ]! !

!GLMLoggerTest methodsFor: 'tests' stamp: 'tg 5/24/2010 17:13'!
testCustomInstance
	| memoryLogger |
	self assert: GLMLogger instance == GLMLogger nullInstance.
	memoryLogger := GLMMemoryLogger new.
	GLMLogger instance: memoryLogger.
	self assert: GLMLogger instance == memoryLogger.
	GLMLogger reset.
	self assert: GLMLogger instance == GLMLogger nullInstance! !

!GLMMatchingPresentationsChanged commentStamp: 'tg 2/20/2010 14:56'!
A GLMMatchingPresentationsChanged is announced by the pane when the presentations that should be displayed change due to changes in the values of the ports of the pane.!
!GLMMatchingPresentationsChanged methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
oldMatchingPresentations: aCollection 
	"The presentations that matched before this announcement." 
	 
	oldMatchingPresentations := aCollection! !

!GLMMatchingPresentationsChanged methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
pane: aPane 
	"The pane on which the matching presentations changed." 
	 
	pane := aPane! !

!GLMMatchingPresentationsChanged methodsFor: 'accessing-convenience' stamp: 'tg 1/11/2010 20:59'!
matchingPresentations 
	"The presentations that match now."
	^ self pane matchingPresentations! !

!GLMMatchingPresentationsChanged methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
oldMatchingPresentations 
	"The presentations that matched before this announcement." 
	 
	^oldMatchingPresentations! !

!GLMMatchingPresentationsChanged methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
pane 
	"The pane on which the matching presentations changed." 
	 
	^pane! !

!GLMMatchingPresentationsChanged methodsFor: 'printing' stamp: 'tg 1/11/2010 08:47'!
printOn: aStream
	super printOn: aStream.
	aStream nextPutAll: ' (pane = ', self pane printString , ')'! !

!GLMMemoryLogger commentStamp: 'tg 5/24/2010 16:59'!
This class stores the announcements raised by the Glamour model in an ordered collection.

The collection can later be used for debugging.!
!GLMMemoryLogger methodsFor: 'accessing' stamp: 'tg 5/24/2010 17:30'!
announcements
	^ announcements! !

!GLMMemoryLogger methodsFor: 'accessing' stamp: 'tg 5/24/2010 17:30'!
announcements: anObject
	announcements := anObject! !

!GLMMemoryLogger methodsFor: 'initialize-release' stamp: 'tg 5/24/2010 16:46'!
initialize 
	announcements := OrderedCollection new! !

!GLMMemoryLogger methodsFor: 'logging' stamp: 'tg 5/24/2010 17:31'!
logAnnouncement: anAnnouncement from: aGLMObject 
	announcements add: anAnnouncement! !

!GLMMenuInvoked methodsFor: 'accessing' stamp: 'jre 7/31/2009 15:43'!
menuMorph
	^menuMorph! !

!GLMMenuInvoked methodsFor: 'initialization' stamp: 'jre 7/31/2009 15:43'!
initializeAction: anAction on: aMenuMorph 
	self action: anAction.
	menuMorph := aMenuMorph! !

!GLMMenuInvoked class methodsFor: 'instance creation' stamp: 'jre 7/31/2009 15:24'!
action: anAction on: aMenuMorph 
	^self new initializeAction: anAction on: aMenuMorph! !

!GLMMockPagerModel methodsFor: 'panes' stamp: 'StefanReichhart 3/12/2015 17:05'!
popPane: isSmooth
	self flag: 'the spotter-model will not pop its step unless the UI allows it by this call - hmmmmm'.
	self notifyPagePoped: nil! !

!GLMMockPagerModel methodsFor: 'scrolling' stamp: 'StefanReichhart 3/12/2015 17:05'!
scrollToPane: pageIndex callback: aBlock
	self flag: 'this method gets called directly from the gt-spotter model - hmmmmm'.
	aBlock value! !

!GLMMockSimpleTransmission methodsFor: 'tests' stamp: 'tg 1/14/2010 16:08'!
initialize
	super initialize.
	wasTransmited := false! !

!GLMMockSimpleTransmission methodsFor: 'tests' stamp: 'jre 9/18/2009 21:45'!
transmitIn: aContext

	wasTransmited := true.
	super transmitIn: aContext! !

!GLMMockSimpleTransmission methodsFor: 'tests' stamp: 'jorge.ressia 6/2/2009 21:23'!
wasTransmited
	^wasTransmited! !

!GLMMockSimpleTransmission methodsFor: 'tests' stamp: 'jorge.ressia 6/2/2009 21:26'!
transmit

	wasTransmited := true.
	super transmit.! !

!GLMMockSimpleTransmission class methodsFor: 'instance creation' stamp: 'jorge.ressia 6/2/2009 21:24'!
new

	^super new initialize! !

!GLMMorphBrick commentStamp: 'AliakseiSyrel 1/30/2015 10:14'!
A GLMMorphBrick is used as container for morphs to embed them inside bricks

Instance Variables
	morph:		<Morph>

morph
	- xxxxx
!
!GLMMorphBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 3/19/2015 17:37'!
hShrinkWrap
	
	hResizing := #shrinkWrap.
	self width: [ self morph width ]
	
	! !

!GLMMorphBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 3/19/2015 17:37'!
vShrinkWrap

	vResizing := #shrinkWrap.
	self height: [ self morph height ]
	
	! !

!GLMMorphBrick methodsFor: 'morph-drawing' stamp: 'AliakseiSyrel 3/23/2015 01:51'!
drawSubmorphsOn: aCanvas
	|rectangle|
	self flag: 'revisit'.
	rectangle := (aCanvas clipRect "withHeight: (aCanvas clipRect height min: self innerBounds height)") translateBy: aCanvas origin.
	self morph fullDrawOn: (aCanvas copy setOrigin: (aCanvas origin + self bounds origin - self morph bounds origin + (self paddingLeft @ self paddingTop)) clipRect: rectangle)! !

!GLMMorphBrick methodsFor: 'brick-properties-events' stamp: 'AliakseiSyrel 1/26/2015 12:48'!
onThemerChanged
	! !

!GLMMorphBrick methodsFor: 'testing' stamp: 'AliakseiSyrel 3/22/2015 16:37'!
isHFilling

	^ hResizing = #spaceFill! !

!GLMMorphBrick methodsFor: 'brick-geometry' stamp: 'AliakseiSyrel 3/22/2015 16:48'!
shrinkingWidth

	^ self morph width! !

!GLMMorphBrick methodsFor: 'testing' stamp: 'AliakseiSyrel 3/22/2015 16:37'!
isVFilling

	^ vResizing = #spaceFill! !

!GLMMorphBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 3/22/2015 17:56'!
hSpaceFill: anInteger
	super hSpaceFill: anInteger.
	
	hResizing := #spaceFill! !

!GLMMorphBrick methodsFor: 'testing' stamp: 'AliakseiSyrel 3/19/2015 17:35'!
isVShrinking

	^ vResizing = #shrinkWrap! !

!GLMMorphBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 12/6/2014 17:13'!
morph

	^ morph! !

!GLMMorphBrick methodsFor: 'brick-geometry' stamp: 'AliakseiSyrel 3/20/2015 12:17'!
brickBounds: aRectangle
	super brickBounds: aRectangle.
	
	self invalidateMorphBounds! !

!GLMMorphBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/30/2015 16:47'!
themerChanged

	self onThemerChanged.
	self morph brickThemerChanged! !

!GLMMorphBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 3/19/2015 16:17'!
initialize
	super initialize.
	
	isLayouting := false! !

!GLMMorphBrick methodsFor: 'brick-layout' stamp: 'AliakseiSyrel 2/3/2015 16:17'!
invalidateLayout

	! !

!GLMMorphBrick methodsFor: 'testing' stamp: 'AliakseiSyrel 3/19/2015 16:31'!
isShrinking

	^ self isHShrinking | self isVShrinking! !

!GLMMorphBrick methodsFor: 'brick-structure-events' stamp: 'AliakseiSyrel 2/4/2015 18:54'!
onRemovedFrom: aBrick
	
	"we should just override it and left empty,
	to prevent recursion calls of this method
	to be propagated to morph"! !

!GLMMorphBrick methodsFor: 'brick-layout' stamp: 'AliakseiSyrel 3/24/2015 02:38'!
invalidateMorphBounds: isForce
	| origin corner newBounds |
	isLayouting & (isForce not) ifTrue: [ ^ self ].
	origin := self paddingLeft @ self paddingTop.
	corner := self paddingRight @ self paddingBottom.
	newBounds := self globalBounds.
	newBounds := ((newBounds origin + origin) corner: (newBounds corner - corner)).
	
	self morph bounds: newBounds! !

!GLMMorphBrick methodsFor: 'layout' stamp: 'AliakseiSyrel 3/24/2015 02:39'!
layoutChanged
	super layoutChanged.
	
	self morph ifNil: [ ^ self ].
	self isShrinking ifFalse: [ ^ self ].
	isLayouting ifTrue: [ ^ self ].

	isLayouting := true.
	self changed.
	self isHShrinking
		ifTrue: [ self width: [ self shrinkingWidth + self hPadding ] ].
	self isVShrinking
		ifTrue: [ self height: [ self shrinkingHeight + self vPadding ] ].
		self invalidateMorphBounds: true.
	isLayouting := false.! !

!GLMMorphBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 3/18/2015 21:18'!
on: aMorph
	
	aMorph layoutProperties ifNil: [ 
		aMorph layoutProperties: GLMBrickLayoutProperties new.
		aMorph layoutProperties hSpaceFill; vSpaceFill ].
	(aMorph layoutProperties isKindOf: GLMBrickLayoutProperties) ifTrue: [
		self layoutProperties: aMorph layoutProperties ].

	morph := aMorph.
	morph layoutProperties: (GLMBrickLayoutProperties new).
	morph layoutProperties hSpaceFill; vSpaceFill.
	
	self addBrickBack: morph.
	super brickBounds: (0@0 extent: (morph width@morph height)).! !

!GLMMorphBrick methodsFor: 'brick-structure-adding/removing' stamp: 'AliakseiSyrel 1/30/2015 15:26'!
addBrickBack: aBrick
	|link|
	link := aBrick asDoubleLink.
	aBrick brickDoubleLink: link.
	
	self hasSubbricks ifTrue: [
		self lastSubbrick brickDoubleLink nextLink: link.	
		link previousLink: self lastSubbrick brickDoubleLink.
	].
	
	self privateSubbricks: (self subbricks copyWith: aBrick).
	aBrick privateOwner: self.! !

!GLMMorphBrick methodsFor: 'brick-layout' stamp: 'AliakseiSyrel 3/24/2015 02:39'!
invalidateMorphBounds

	self invalidateMorphBounds: false! !

!GLMMorphBrick methodsFor: 'testing' stamp: 'AliakseiSyrel 3/19/2015 17:37'!
isHShrinking

	^ hResizing = #shrinkWrap! !

!GLMMorphBrick methodsFor: 'morph-common' stamp: 'AliakseiSyrel 2/13/2015 17:42'!
isMorphBrick

	^ true! !

!GLMMorphBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 3/22/2015 17:57'!
vSpaceFill: anInteger
	super vSpaceFill: anInteger.
	
	vResizing := #spaceFill! !

!GLMMorphBrick methodsFor: 'brick-layout-events' stamp: 'AliakseiSyrel 3/20/2015 12:17'!
onLayouted
	super onLayouted.
	
	self invalidateMorphBounds! !

!GLMMorphBrick methodsFor: 'brick-geometry' stamp: 'AliakseiSyrel 3/22/2015 16:48'!
shrinkingHeight

	^ self morph height! !

!GLMMorphBrick class methodsFor: 'instance creation' stamp: 'AliakseiSyrel 12/6/2014 17:02'!
on: aMorph

	^ self new on: aMorph! !

!GLMMorphMorphicTest methodsFor: 'tests' stamp: 'Nicolasanquetil 5/3/2013 15:01'!
testMorphUpdateOnAnnounce
	| browser number originalMorph newMorph announcer |
	announcer := GLMAnnouncer new.
	number := 42.
	browser := GLMTabulator new.
	browser row: #morph.
	browser transmit
		to: #morph;
		andShow: [ :presenter | 
					presenter morph
						updateOn: Announcement from: [ announcer ];
						display: [ :x | number asString asMorph ] ].
	window := browser openOn: 42.
	originalMorph := self findLast: StringMorph in: window.
	self assert: originalMorph notNil.
	self assert: originalMorph contents equals: 42 asString.
	number := 43.
	announcer announce: Announcement.
	newMorph := self findLast: StringMorph in: window.
	self assert: newMorph ~= originalMorph.
	self assert: newMorph notNil.
	self assert: newMorph notNil.
	self assert: newMorph contents equals: 43 asString! !

!GLMMorphMorphicTest methodsFor: 'tests' stamp: 'Nicolasanquetil 5/3/2013 15:17'!
testMorphUpdate
	| browser number originalMorph newMorph |
	number := 42.
	browser := GLMTabulator new.
	browser row: #morph.
	browser transmit
		to: #morph;
		andShow: [ :presenter | presenter morph display: [ :x | number asString asMorph ] ].
	window := browser openOn: 42.
	originalMorph := self findLast: StringMorph in: window.
	self assert: originalMorph notNil.
	self assert: originalMorph contents equals: 42 asString.
	number := 43.
	browser update.
	newMorph := self findLast: StringMorph in: window.
	self assert: newMorph ~= originalMorph.
	self assert: newMorph notNil.
	self assert: newMorph notNil.
	self assert: newMorph contents equals: 43 asString! !

!GLMMorphPresentation commentStamp: 'TudorGirba 2/4/2011 21:13'!
This presentation offers a means to embed a Morph. It makes sense only for the Morph Renderer.!
!GLMMorphPresentation methodsFor: 'rendering' stamp: 'TudorGirba 1/9/2014 15:12'!
morph
	^ morphBuilder glamourValue: 
			(self asGlamorousMultiValue, 
			self displayValue asGlamorousMultiValue)! !

!GLMMorphPresentation methodsFor: 'rendering' stamp: 'TudorGirba 1/9/2014 15:01'!
morph: aBlock
	morphBuilder := aBlock! !

!GLMMorphPresentation methodsFor: 'initialization' stamp: 'TudorGirba 1/9/2014 15:12'!
initialize
	super initialize.
	morphBuilder := [ :thisPresentation :theDisplayValue | theDisplayValue asMorph ]! !

!GLMMorphPresentation methodsFor: 'rendering' stamp: ''!
renderGlamorouslyOn: aRenderer 
	self registerAnnouncements.
	^ aRenderer renderMorphPresentation: self! !

!GLMMorphTreeColumn methodsFor: 'accessing' stamp: 'tg 11/16/2009 05:01'!
glamourColumn: aColumn
	glamourColumn := aColumn! !

!GLMMorphTreeColumn methodsFor: 'column drawing' stamp: 'AndreiChis 11/13/2014 17:31'!
rowMorphFor: aNodeMorph
	| rowMorph cont |
	
	rowMorph := aNodeMorph rowMorphForColumn: glamourColumn.
	rowMorph
		ifNotNil: [rowMorph borderWidth: 0]
		ifNil: [rowMorph := self defaultRowMorph].
	cont := Morph new color: Color transparent;
				 layoutPolicy: RowLayout new;
				 hResizing: #shrinkWrap;
				 vResizing: #shrinkWrap;
				 layoutInset: container columnInset @ container rowInset;
				 yourself.
	cont addMorph: rowMorph.

	self isFirstColumn ifTrue: [ | icon |
		icon := container iconBlock value: aNodeMorph.
		icon ifNotNil: [ cont addMorph: icon asMorph ].
		"for first column we don't use horizontal inset"
		cont  layoutInset: 0 @ container rowInset.
	].
	^ cont ! !

!GLMMorphic class methodsFor: 'utils - morph creation' stamp: 'VeronicaUquillas 6/15/2010 10:33'!
alignmentMorph: aCollectionOfMorphs
	"Answer a row-oriented AlignmentMorph holding the given collection"
	| morph |

	morph:= AlignmentMorph new
		listDirection: #leftToRight;
		borderWidth: 0;
		color: Color transparent;
		vResizing: #shrinkWrap;
		hResizing: #shrinkWrap;
		layoutInset: 1;
		wrapCentering: #center;
		cellPositioning: #center.
	aCollectionOfMorphs do: [ :each | morph addMorphBack: each].
	^morph! !

!GLMMorphic class methodsFor: 'button styles' stamp: 'tg 9/23/2010 19:59'!
styleButton: button morph: m pressed: aBoolean style: aSymbol
	(self isGrayRoundedButton: aSymbol)
		ifTrue:[ self grayRoundedButtonStyle: button morph: m pressed: aBoolean ].
	
	(self isWhiteRectangledButton: aSymbol)
		ifTrue:[ self whiteRectangledButtonStyle: button morph: m pressed: aBoolean ]! !

!GLMMorphic class methodsFor: 'utils - morph creation' stamp: 'TudorGirba 1/21/2011 10:11'!
containerMorph
	^ PanelMorph new
		layoutPolicy: ProportionalLayout new;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		borderWidth: 0;
		yourself! !

!GLMMorphic class methodsFor: 'utils - morph creation' stamp: 'TudorGirba 11/1/2013 23:31'!
morphElement: anObject

	anObject isString
	ifTrue:[ ^StringMorph 
					contents: anObject 
					font: (LogicalFont 
						familyName: UITheme current buttonFont familyName
						pointSize: UITheme current buttonFont pointSize - 2) ].
	
	anObject isCollection 
	ifTrue: [ |row|
				row:= OrderedCollection new.
				anObject do: [ :e| row add: (self morphElement: e) ].
				^self alignmentMorph: row ].
				
	anObject isForm
	ifTrue:[ ^ImageMorph new form: anObject ].
	
	^self containerMorph! !

!GLMMorphic class methodsFor: 'button styles' stamp: 'tg 9/3/2010 14:07'!
isWhiteRectangledButton: aSymbol
	^aSymbol = #whiteRectangledButton! !

!GLMMorphic class methodsFor: 'utils - morph creation' stamp: 'tg 9/23/2010 21:17'!
togglingButtonLabelled: anObject pressed: aBoolean style: aSymbol
	| button oldLabel m |
	button := SimpleButtonMorph new.
	(oldLabel := button findA: StringMorph) ifNotNil: [ oldLabel delete ].
	m := self morphElement: anObject.
	button
		addMorph: m;
		borderColor: Color transparent.
	(self isAlignmentMorph: m)
		ifTrue:[ 
			button extent: (m width + 6 ) @ (m height + 6 ).
			m position: 3 @ 3 ]
		ifFalse:[ 
			(self isImageMorph: m)
				ifTrue: [ button extent: (m width + 6) @ (m height + 6) ]
				ifFalse:[ button extent: (m width + 6) @ (m height + 6) ].
			m position: 3 @ 3.	"button center - (m extent // 2)" ].
	self styleButton: button morph: m pressed: aBoolean style: aSymbol.
	m lock.
	^ button! !

!GLMMorphic class methodsFor: 'button styles' stamp: 'VeronicaUquillas 6/15/2010 10:49'!
isGrayRoundedButton: aSymbol

	^aSymbol = #grayRoundedButton
		or:[ aSymbol = #default ]! !

!GLMMorphic class methodsFor: 'testing' stamp: 'VeronicaUquillas 11/19/2009 20:08'!
isImageMorph: anObject

	^anObject isMemberOf: ImageMorph! !

!GLMMorphic class methodsFor: 'button styles' stamp: 'tg 9/23/2010 20:04'!
grayRoundedButtonStyle: button morph: aMorph pressed: aBoolean
	button useRoundedCorners.
	(self isAlignmentMorph: aMorph)
		ifTrue: [
			aBoolean 
				ifTrue: [	aMorph lastSubmorph color: Color gray.
						button fillStyle: (button theme buttonSelectedFillStyleFor: button).
						button borderStyle: (button theme buttonSelectedBorderStyleFor: button) ]
				ifFalse:[	aMorph lastSubmorph color: Color white.
						button fillStyle: (button theme buttonNormalFillStyleFor: button).
						button borderStyle: (button theme buttonNormalBorderStyleFor: button) ] ]
		ifFalse: [			
			aBoolean 
				ifTrue: [	aMorph color: Color gray.
						button color: Color veryLightGray ]
				ifFalse:[	aMorph color: Color white.
						button color: Color lightGray ] ]
! !

!GLMMorphic class methodsFor: 'utils - morph creation' stamp: 'TudorGirba 5/31/2012 22:37'!
emptyMorph
	^ self containerMorph
		fillStyle: (SolidFillStyle color: Color transparent );
		yourself! !

!GLMMorphic class methodsFor: 'testing' stamp: 'VeronicaUquillas 11/19/2009 20:08'!
isAlignmentMorph: anObject

	^anObject isMemberOf: AlignmentMorph! !

!GLMMorphic class methodsFor: 'button styles' stamp: 'VeronicaUquillas 1/10/2011 17:13'!
whiteRectangledButtonStyle: button morph: aMorph pressed: aBoolean

	button useSquareCorners.
	(self isAlignmentMorph: aMorph)
	ifTrue:[ 
		aBoolean 
		ifTrue: [ aMorph lastSubmorph color: Color white.
				      button borderColor: Color gray.
					button color: Color gray ]
		ifFalse:[ aMorph lastSubmorph color: Color black.
			            button borderColor: Color gray.
					button color: Color white ].
		button extent: aMorph width @ (aMorph height - 2).
		aMorph position: 0 @ 0 ]
	ifFalse:[			
		aBoolean 
		ifTrue: [ aMorph color: Color white.
			         button borderColor: Color gray.
				   button color: Color gray ]
		ifFalse:[ aMorph color: Color black.
			            button borderColor: Color gray.
					button color: Color white ].
		button extent: (aMorph width + 6) @ (aMorph height + 2).
		aMorph position: 3 @ 1 ]! !

!GLMMorphicAccordionRenderer methodsFor: 'rendering' stamp: 'VincentBlondeau 2/16/2014 12:38'!
render: aPresentation
	| presentations container expander |
	presentations := aPresentation matchingPresentations.
	presentations isEmpty
		ifTrue: [ ^ GLMMorphic emptyMorph ].
	presentations size = 1
		ifTrue: [ ^ self renderWithToolbar: presentations first ].
	container := GLMMorphic containerMorph.
	container changeTableLayout.
	presentations
		do: [ :each | 
			expander := self theme
				newExpanderIn: container
				label: (self titleOrIconOf: each in: container)
				forAll: {(self renderWithToolbar: each)}.
			container addMorphBack: expander.
			(aPresentation pane lastActivePresentation notNil
				and: [ each title = aPresentation pane lastActivePresentation title ])
				ifTrue: [ expander expanded: true ] ].
	(aPresentation pane lastActivePresentation isNil and: [ container submorphs notEmpty ])
		ifTrue: [ container submorphs first expanded: true ].
	^ container! !

!GLMMorphicAccumulatorRenderer methodsFor: 'private' stamp: 'TudorGirba 7/23/2011 20:26'!
removePage: aPage
	| removedPageIndex |
	removedPageIndex := self pages indexOf: aPage.
	self announcer suspendAllWhile: [ super removePage: aPage ].
	self announcer announce: 
		(LazyTabPageRemoved new 
			tabs: self; 
			page: aPage; 
			pageIndex: removedPageIndex;
			newIndex: self tabSelectorMorph selectedIndex).
	self pages isEmpty 
		ifTrue: [ self contentMorph removeAllMorphs ]! !

!GLMMorphicAccumulatorRenderer methodsFor: 'rendering' stamp: 'TudorGirba 2/15/2011 12:25'!
actOnPaneAdded: ann 
	tabs 
		addLazyPage: (GLMMorphicPaneWithoutTitleRenderer new render: ann pane) 
		label: (self titleOrIconOf: ann pane presentations in: tabs)
		toolbar: nil
		collapsable: true.
	tabs selectedPageIndex: tabs pages size! !

!GLMMorphicAccumulatorRenderer methodsFor: 'rendering' stamp: 'BernardoContreras 12/7/2014 00:34'!
render: aBrowser
	aBrowser panes isEmpty
		ifTrue: [ ^ GLMMorphic emptyMorph ].
	tabs := LazyTabGroupMorph new.
	tabs
		vResizing: #spaceFill;
		hResizing: #spaceFill;
		cornerStyle: (self theme tabGroupCornerStyleIn: nil);
		font: self theme labelFont.
	tabs announcer
		when: LazyTabPageChanged
		do: [ :ann | aBrowser activeEntity: ((aBrowser panes at: ann pageIndex) port: #entity) value ].
	tabs announcer
		when: LazyTabPageRemoved
		do: [ :ann | 
			aBrowser removePaneIndex: ann pageIndex.
			aBrowser panes isEmpty
				ifTrue: [ aBrowser activeEntity: nil ]
				ifFalse: [ aBrowser activeEntity: ((aBrowser panes at: ann newIndex) port: #entity) value ] ].
	aBrowser panes
		do: [ :each | 
			tabs
				addLazyPage: [ GLMMorphicPaneWithoutTitleRenderer new render: each ]
				label: (self titleOrIconOf: each presentations in: tabs)
				toolbar: (self renderToolbarForPresentation: each presentations inMorph: tabs)
				collapsable: true ].
	aBrowser on: GLMPaneSelected send: #actOnPaneSelected: to: self.
	aBrowser on: GLMPaneAdded send: #actOnPaneAdded: to: self.
	aBrowser on: GLMBrowserClosed send: #actOnBrowserClosed: to: self.
	tabs selectedPageIndex: tabs pages size.
	^ tabs! !

!GLMMorphicAccumulatorRenderer methodsFor: 'rendering' stamp: 'TudorGirba 2/15/2011 10:50'!
actOnPaneSelected: anAnnouncement
	tabs selectedPageIndex: anAnnouncement position! !

!GLMMorphicAction commentStamp: '<historical>'!
A GLMMorphicAction is special GLMAction that is only active when rendering Glamour browsers with Morphic.!
!GLMMorphicAction methodsFor: 'testing' stamp: 'tg 9/24/2010 15:36'!
worksWithMorphic
	^ true! !

!GLMMorphicActionListRenderer methodsFor: 'private' stamp: 'TudorGirba 11/1/2013 23:33'!
rectangleMorphFrom: anActionListPresentation
	^ BorderedMorph new
		borderWidth: 0;
		color: Color transparent;
		layoutPolicy: TableLayout new;
		cellPositioning: #topLeft;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		listDirection: (anActionListPresentation isHorizontal 
			ifTrue: [ #leftToRight ] 
			ifFalse: [ #topToBottom ] );
		listCentering: #topLeft;
		wrapCentering: #topLeft;
		cellInset: 5;
		yourself! !

!GLMMorphicActionListRenderer methodsFor: 'rendering' stamp: 'EstebanLorenzano 12/12/2011 22:00'!
actOnPresentationUpdated: ann
	container removeAllMorphs.
	container addMorphBack: (self morphFrom: ann presentation)! !

!GLMMorphicActionListRenderer methodsFor: 'private' stamp: 'EstebanLorenzano 12/12/2011 19:40'!
buttonMorph: aModel
	^UITheme current 
		newButtonIn: nil 
		for: aModel 
		getState: nil
		action: #execute
		arguments: nil 
		getEnabled: nil 
		label: aModel buttonLabel
		help: nil! !

!GLMMorphicActionListRenderer methodsFor: 'rendering' stamp: 'AndreiChis 8/6/2013 18:30'!
morphFrom: anActionListPresentation 
	| buttonsContainer buttonModel button |
	
	buttonsContainer := self rectangleMorphFrom: anActionListPresentation.
	
	anActionListPresentation allActions do: [ :each | 
		buttonModel := GLMButtonModel new.
		buttonModel glamourPresentation: anActionListPresentation.
		buttonModel glamourAction: each.

		button := self buttonMorph: buttonModel.
		buttonsContainer addMorphBack: button.
		button width: self class defaultWidth ].
	
	^ buttonsContainer! !

!GLMMorphicActionListRenderer methodsFor: 'rendering' stamp: 'EstebanLorenzano 12/12/2011 21:48'!
render: anActionListPresentation
	container := GLMMorphic containerMorph. 
	container 
		changeTableLayout;
		listDirection: #leftToRight;
		vResizing: #spaceFill;
		hResizing: #spaceFill.

	container addMorphBack: (self morphFrom: anActionListPresentation).
	
	anActionListPresentation on: GLMPresentationUpdated send: #actOnPresentationUpdated: to: self.
	
	^container ! !

!GLMMorphicActionListRenderer class methodsFor: 'defaults' stamp: 'EstebanLorenzano 12/12/2011 20:05'!
defaultWidth 
	^100! !

!GLMMorphicActionRenderer methodsFor: 'accessing' stamp: 'AndreiChis 3/27/2015 17:54'!
actionArguments
	^ {  }! !

!GLMMorphicActionRenderer methodsFor: 'rendering' stamp: 'AndreiChis 3/27/2015 17:54'!
render: anAction
	^ (UITheme current
		newButtonIn: nil
		for: anAction
		getState: nil
		action: self actionSelector
		arguments: self actionArguments
		getEnabled: nil
		label: (AlphaImageMorph new image: anAction icon)
		help: (anAction title , Character tab asString , anAction shortcutAsString) trimBoth)
		valueOfProperty: #noBorder ifAbsentPut: [ true ];
		valueOfProperty: #noFill ifAbsentPut: [ true ];
		setProperty: #wantsKeyboardFocusNavigation toValue: false;
		borderWidth: 0;
		yourself	"this is a hack to tell the GLMUITheme to not draw the border and the fill"	"to disable the focus"! !

!GLMMorphicActionRenderer methodsFor: 'accessing' stamp: 'AndreiChis 3/27/2015 17:47'!
actionSelector
	^ #morphicActOn:! !

!GLMMorphicBrowserRenderer methodsFor: 'callbacks' stamp: 'TudorGirba 4/12/2011 12:49'!
actOnBrowserClosed: ann
	self renderer window delete! !

!GLMMorphicDashboardRenderer methodsFor: 'private' stamp: 'AndreiChis 12/3/2012 17:27'!
renderPane: aPane inUI: aMorph from: aGLMDashboard

	| pane totalSpans currentSpanPosition currentOffset tmpExtent|
	pane := self renderObject: (aPane). 
	"pane
		hResizing: #rigid;
		vResizing: #rigid."
	
	
	"self haltIf: [aPane name = #dashboard]."
	"pane extent: (aGLMDashboard extentOfPaneNamed: aPane name). "
	aGLMDashboard extentStrategy initializePane: pane.
	pane extent: ((aGLMDashboard extentOfPaneNamed: aPane name) glamourValue: pane). 
	"self haltIf: [pane submorphs contains: [:a | a isKindOf: GeneralScrollPane]]."
	aMorph addMorph: pane.
! !

!GLMMorphicDashboardRenderer methodsFor: 'rendering' stamp: 'cyrilledelaunay 5/17/2011 11:31'!
firstColumnMinCellSizeFrom: aGLMDashboard

	|tmpMinVerticalSize tmpMinHorizontalSize|
	tmpMinHorizontalSize := (aGLMDashboard extentOfPaneNamed: (aGLMDashboard panes anyOne name)) x  .
	tmpMinVerticalSize :=  (aGLMDashboard extentOfPaneNamed: (aGLMDashboard panes anyOne name)) y.
	(self firstColumnPanesFrom: aGLMDashboard) do: [:aGLMPane |
		|tmpPaneExtent|
		tmpPaneExtent := aGLMDashboard extentOfPaneNamed: aGLMPane name.  
		tmpPaneExtent x < tmpMinHorizontalSize ifTrue: [tmpMinHorizontalSize := tmpPaneExtent x].
		tmpPaneExtent y < tmpMinVerticalSize ifTrue: [tmpMinVerticalSize := tmpPaneExtent y].
		].   
	^ tmpMinHorizontalSize @ tmpMinVerticalSize ! !

!GLMMorphicDashboardRenderer methodsFor: 'rendering' stamp: 'cyrilledelaunay 5/17/2011 11:08'!
secondColumnMaxCellSizeFrom: aGLMDashboard

	|tmpMaxVerticalSize tmpMaxHorizontalSize|
	tmpMaxHorizontalSize := 0.
	tmpMaxVerticalSize := 0.
	(self secondColumnPanesFrom: aGLMDashboard) do: [:aGLMPane |
		|tmpPaneExtent|
		tmpPaneExtent := aGLMDashboard extentOfPaneNamed: aGLMPane name.  
		tmpPaneExtent x > tmpMaxHorizontalSize ifTrue: [tmpMaxHorizontalSize := tmpPaneExtent x].
		tmpPaneExtent y > tmpMaxVerticalSize ifTrue: [tmpMaxVerticalSize := tmpPaneExtent y].
		].   
	^ tmpMaxHorizontalSize @ tmpMaxVerticalSize ! !

!GLMMorphicDashboardRenderer methodsFor: 'rendering' stamp: 'cyrilledelaunay 5/17/2011 11:32'!
secondColumnMinCellSizeFrom: aGLMDashboard

	|tmpMinVerticalSize tmpMinHorizontalSize|
	tmpMinHorizontalSize := (aGLMDashboard extentOfPaneNamed: (aGLMDashboard panes anyOne name)) x  .
	tmpMinVerticalSize :=  (aGLMDashboard extentOfPaneNamed: (aGLMDashboard panes anyOne name)) y.
	(self secondColumnPanesFrom: aGLMDashboard) do: [:aGLMPane |
		|tmpPaneExtent|
		tmpPaneExtent := aGLMDashboard extentOfPaneNamed: aGLMPane name.  
		tmpPaneExtent x < tmpMinHorizontalSize ifTrue: [tmpMinHorizontalSize := tmpPaneExtent x].
		tmpPaneExtent y < tmpMinVerticalSize ifTrue: [tmpMinVerticalSize := tmpPaneExtent y].
		].   
	^ tmpMinHorizontalSize @ tmpMinVerticalSize ! !

!GLMMorphicDashboardRenderer methodsFor: 'rendering' stamp: 'cyrilledelaunay 7/29/2011 13:47'!
render: aBrowser
	| container firstColumnContainer secondColumnContainer scrollPane panesMidSize|
	firstColumnContainer := PanelMorph new.
	secondColumnContainer := PanelMorph new.
	container := PanelMorph new.
	aBrowser defaultPaneExtent: #glamourOptimalExtent.
	firstColumnContainer  
		fillStyle: Color transparent;
		fillStyle: Color transparent;
		changeTableLayout;
		cellPositioning: #topRight;
		layoutInset: 2;
		"maxCellSize: (self firstColumnMaxCellSizeFrom: aBrowser) ;"
		"minCellSize: 20@20 ;"
		cellInset: 2.
		
	secondColumnContainer   
		fillStyle: Color transparent;
		changeTableLayout;
		cellPositioning: #topLeft; 
		layoutInset: 2;
		"maxCellSize: (self secondColumnMaxCellSizeFrom: aBrowser) ;"
		"minCellSize: (self secondColumnMaxCellSizeFrom: aBrowser);"
		cellInset: 2.
		
	container   
		fillStyle: Color transparent;
		changeTableLayout;
		extent: 200@200;
		layoutInset: 2;
		cellPositioning: #topLeft;
		"maxCellSize: 400@200;
		minCellSize: 400@150;"
		listDirection: #leftToRight;
		cellInset: 2.
	
	aBrowser extentStrategy initializeContainer: container.
	aBrowser extentStrategy initializeFirstColumn: firstColumnContainer.
	aBrowser extentStrategy initializeSecondColumn: secondColumnContainer.
	scrollPane := GeneralScrollPane new.
	scrollPane 
		changeScrollerTableLayout;
		scrollTarget: container.
		
	(self firstColumnPanesFrom: aBrowser) reverseDo: [:aGLMPane |
		self renderPane: aGLMPane inUI: firstColumnContainer  from: aBrowser.
		].  
	(self secondColumnPanesFrom: aBrowser) reverseDo: [:aGLMPane |
		self renderPane: aGLMPane inUI: secondColumnContainer  from: aBrowser
		].
	
	container addMorph: secondColumnContainer.
	container addMorph: firstColumnContainer.
	
	aBrowser on: GLMBrowserClosed send: #actOnBrowserClosed: to: self.
	^ scrollPane! !

!GLMMorphicDashboardRenderer methodsFor: 'rendering' stamp: 'cyrilledelaunay 5/17/2011 11:00'!
firstColumnPanesFrom: aGLMDashboard

	|tmpHalfSizePanes tmpResult|
	aGLMDashboard panes isEmpty ifTrue: [^#()].
	tmpResult := OrderedCollection new.
	tmpHalfSizePanes := (aGLMDashboard panes size / 2) asFloat rounded.
	1 to: tmpHalfSizePanes do: [:anIndex |
		tmpResult add: (aGLMDashboard panes at: anIndex)
		].
	^ tmpResult! !

!GLMMorphicDashboardRenderer methodsFor: 'rendering' stamp: 'cyrilledelaunay 5/17/2011 11:42'!
secondColumnPanesFrom: aGLMDashboard

	|tmpHalfSizePanes tmpResult|
	aGLMDashboard panes isEmpty ifTrue: [^#()].
	tmpResult := OrderedCollection new.
	tmpHalfSizePanes := (aGLMDashboard panes size / 2) asFloat rounded.
	(tmpHalfSizePanes + 1) to: aGLMDashboard panes size do: [:anIndex |
		tmpResult add: (aGLMDashboard panes at: anIndex)
		].
	^ tmpResult! !

!GLMMorphicDashboardRenderer methodsFor: 'rendering' stamp: 'cyrilledelaunay 5/17/2011 11:07'!
firstColumnMaxCellSizeFrom: aGLMDashboard

	|tmpMaxVerticalSize tmpMaxHorizontalSize|
	tmpMaxHorizontalSize := 0.
	tmpMaxVerticalSize := 0.
	(self firstColumnPanesFrom: aGLMDashboard) do: [:aGLMPane |
		|tmpPaneExtent|
		tmpPaneExtent := aGLMDashboard extentOfPaneNamed: aGLMPane name.  
		tmpPaneExtent x > tmpMaxHorizontalSize ifTrue: [tmpMaxHorizontalSize := tmpPaneExtent x].
		tmpPaneExtent y > tmpMaxVerticalSize ifTrue: [tmpMaxVerticalSize := tmpPaneExtent y].
		].   
	^ tmpMaxHorizontalSize @ tmpMaxVerticalSize 

	
	! !

!GLMMorphicDiffRenderer methodsFor: 'rendering' stamp: 'YuriyTymchuk 2/23/2015 16:32'!
render: aPresentation
	| textMorph |
	textMorph := (DiffMorph
		from: aPresentation displayValue first
		to: aPresentation displayValue last
		contextClass: aPresentation contextClassValue)
"			onKeyStrokeSend: #keystroke:from: to: textModel;
"			layoutFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 1));
			vResizing: #spaceFill;
			hResizing: #spaceFill;
			yourself.
"	self installActionsOnUI: textModel fromPresentation: aTextPresentation.
	aTextPresentation selectedTextBlock: [ textMorph textMorph editor selection ].
	aTextPresentation textBlock: [ textMorph textMorph editor text ].
"	^textMorph! !

!GLMMorphicDropDownRenderer methodsFor: 'as yet unclassified' stamp: 'AndreiChis 8/21/2013 16:02'!
actOnPresentationUpdated: ann

	listModel resetData.
	dropDownMorph 
		updateList;
		updateListSelectionIndex
	 ! !

!GLMMorphicDropDownRenderer methodsFor: 'as yet unclassified' stamp: 'AndreiChis 8/20/2013 23:11'!
actOnContextChanged: ann 
	ann property = #selection ifTrue: [ 
		listModel announcer suspendAllWhile: [
			dropDownMorph listSelectionIndex: (listModel glamourPresentation displayValue indexOf: ann value) ] ]! !

!GLMMorphicDropDownRenderer methodsFor: 'as yet unclassified' stamp: 'BernardoContreras 12/7/2014 00:35'!
render: aDropListPresentation
 
	listModel:= GLMDropListModel new glamourPresentation: aDropListPresentation.
	"When the morph changes, we want to update the glamour model"
	listModel announcer when: GLMDropDownListMorphSelectionChanged do: [ :ann | 
		aDropListPresentation selectedIndex: ann selectionIndex.
		aDropListPresentation selection: ann selectionValue ].
	listModel selectionIndex: aDropListPresentation selectedIndex.
	dropDownMorph := (MorphDropListMorph
			on: listModel
			list: #list
			selected: #selectionIndex
			changeSelected: #selectionIndex:
			useIndex: true )
		hResizing: #spaceFill;
		vResizing: #shrinkWrap.
	
	aDropListPresentation on: GLMContextChanged send: #actOnContextChanged: to: self.
	aDropListPresentation on: GLMPresentationUpdated send: #actOnPresentationUpdated: to: self.
	^ dropDownMorph
	! !

!GLMMorphicDynamicRenderer methodsFor: 'rendering' stamp: 'TudorGirba 2/15/2011 10:54'!
actOnPresentationUpdated: anAnnouncement
	container removeAllMorphs.
	container 
		addMorph: (self renderObject: anAnnouncement presentation currentPresentation) 
		fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 1)) ! !

!GLMMorphicDynamicRenderer methodsFor: 'rendering' stamp: 'TudorGirba 5/21/2012 05:17'!
render: aPresentation
	container := GLMMorphic containerMorph.
	container 
		addMorph: (self renderObject: aPresentation currentPresentation) 
		fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 1)).
	aPresentation on: GLMPresentationUpdated send: #actOnPresentationUpdated: to: self.
	^ container! !

!GLMMorphicExamplesTest methodsFor: 'tests' stamp: 'AndreiChis 10/27/2014 10:19'!
testSmoke
	GLMBasicExamples allExamples do: [:eachPragma | 
		| input browser |
		input := Smalltalk compiler evaluate: (eachPragma argumentAt: 2) logged: false.
		browser := GLMBasicExamples new perform: eachPragma selector.
		[window := browser openOn: input]
			ensure: [window notNil ifTrue: [window delete] ] ]! !

!GLMMorphicExpanderRenderer methodsFor: 'rendering' stamp: 'EstebanLorenzano 2/13/2012 13:18'!
renderWithTree: aBrowser
	| treeMorph treeModel |
	treeModel := GLMExpanderTreeMorphModel new glamourExpander: aBrowser.
	treeMorph := MorphTreeMorph new.
	treeMorph
		makeLastColumnUnbounded;
		getMenuSelector: #menu:shifted:;
		keystrokeActionSelector: #keyStroke:from:;
		cornerStyle: treeMorph preferredCornerStyle;
		borderStyle: (BorderStyle inset width: 1);
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		layoutFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 1));
		preferedPaneColor: Color white;	
		model: treeModel;
		columns: ( OrderedCollection with: (MorphTreeColumn new rowMorphGetSelector: #elementColumn)).
	treeMorph vShowScrollBar.
	aBrowser on: GLMBrowserClosed send: #actOnBrowserClosed: to: self.
	^ treeMorph buildContents! !

!GLMMorphicExpanderRenderer methodsFor: 'rendering' stamp: 'TudorGirba 2/26/2012 10:47'!
render: aBrowser
	^ self renderWithExpanders: aBrowser   ! !

!GLMMorphicExpanderRenderer methodsFor: 'rendering' stamp: 'TudorGirba 3/9/2011 10:20'!
renderWithExpanders: aBrowser
	| morph scroll panel expander |
	panel := PanelMorph new.
	panel 
		fillStyle: Color transparent;
		hResizing: #spaceFill;
		vResizing: #shrinkWrap;
		changeTableLayout;
		layoutInset: 2;
		cellInset: 2.
	scroll := GeneralScrollPane new.
	scroll 
		changeScrollerTableLayout;
		scrollTarget: panel.
	aBrowser panes do: [:each |
		expander := ExpanderMorph titleText: (each presentations titleValue ifNil: ['noname']).
		morph := GLMMorphicPaneWithoutTitleRenderer new render: each.
		morph 
			borderStyle: (UITheme current buttonSelectedBorderStyleFor: morph).
		expander addMorphBack: morph.
		panel addMorph: expander	].
	^ scroll! !

!GLMMorphicFinderRenderer methodsFor: 'rendering' stamp: 'TudorGirba 2/15/2011 18:11'!
actOnPaneReplaced: ann
	self subclassResponsibility! !

!GLMMorphicFinderRenderer methodsFor: 'rendering' stamp: 'TudorGirba 2/15/2011 18:10'!
actOnPaneAdded: ann
	self subclassResponsibility! !

!GLMMorphicFinderRenderer methodsFor: 'rendering' stamp: 'TudorGirba 2/15/2011 18:11'!
actOnPaneRemoved: ann
	self subclassResponsibility! !

!GLMMorphicFinderRenderer methodsFor: 'rendering' stamp: 'TudorGirba 2/15/2011 18:09'!
render: aBrowser
	^ self subclassResponsibility! !

!GLMMorphicFinderRenderer methodsFor: 'rendering' stamp: 'TudorGirba 4/12/2011 12:49'!
registerAnnouncementsFor: aBrowser
	aBrowser 
		on: GLMPaneRemoved send: #actOnPaneRemoved: to: self.
	aBrowser 
		on: GLMPaneAdded send: #actOnPaneAdded: to: self.
	aBrowser 
		on: GLMPaneReplaced send: #actOnPaneReplaced: to: self.
	aBrowser 
		on: GLMBrowserClosed send: #actOnBrowserClosed: to: self.! !

!GLMMorphicFixedPanesFinderRenderer methodsFor: 'rendering' stamp: 'TudorGirba 2/15/2011 18:10'!
actOnPaneReplaced: ann
	container popAndReplacePane: (self renderObject: ann newPane)! !

!GLMMorphicFixedPanesFinderRenderer methodsFor: 'rendering' stamp: 'TudorGirba 2/15/2011 18:10'!
actOnPaneAdded: ann
	container pushPane: (self renderObject: ann pane)! !

!GLMMorphicFixedPanesFinderRenderer methodsFor: 'rendering' stamp: 'TudorGirba 2/15/2011 18:10'!
actOnPaneRemoved: ann
	container popPane! !

!GLMMorphicFixedPanesFinderRenderer methodsFor: 'rendering' stamp: 'TudorGirba 2/15/2011 18:11'!
render: aBrowser
	container := GLMPaneScroller new
		name: 'scroller';
		vResizing: #spaceFill;
		hResizing: #spaceFill;
		yourself.
	container maxPanes: aBrowser fixedSizePanes.
	self registerAnnouncementsFor: aBrowser.  
	aBrowser panes
		do: [ :each | container pushPane: (self renderObject: each) ].
	^ container! !

!GLMMorphicIcons class methodsFor: 'accessing - icons' stamp: 'tg 11/20/2010 15:45'!
windowMenuInactiveFormContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 360282489 3565191296 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 3565191296 360282489 0 0 0 0 0 0 0 360282489 3565191296 4286611584 4286611584 4286611584 4286611584 3565191296 360282489 0 0 0 0 0 0 0 0 0 360282489 3565191296 4286611584 4286611584 3565191296 360282489 0 0 0 0 0 0 0 0 0 0 0 377520256 3565191296 3565191296 360282489 0 0 0 0 0 0 0 0 0 0 0 0 0 377520256 360282489 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!GLMMorphicIcons class methodsFor: 'accessing - icons' stamp: 'tg 11/20/2010 15:44'!
windowMenuFormContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 352321536 3556769792 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 3556769792 352321536 0 0 0 0 0 0 0 352321536 3556769792 4278190080 4278190080 4278190080 4278190080 3556769792 352321536 0 0 0 0 0 0 0 0 0 352321536 3556769792 4278190080 4278190080 3556769792 352321536 0 0 0 0 0 0 0 0 0 0 0 369098752 3556769792 3556769792 352321536 0 0 0 0 0 0 0 0 0 0 0 0 0 369098752 352321536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!GLMMorphicIcons class methodsFor: 'accessing - icons' stamp: 'tg 11/20/2010 15:45'!
toolbarMenuForm
	^self form16x16FromContents: self windowMenuFormContents ! !

!GLMMorphicIcons class methodsFor: 'accessing - icons' stamp: 'tg 11/20/2010 15:46'!
toolbarMenuInactiveForm
	^self form16x16FromContents: self windowMenuInactiveFormContents ! !

!GLMMorphicIcons class methodsFor: 'accessing - icons' stamp: 'tg 11/20/2010 15:45'!
form16x16FromContents: aByteArray 
	^ Form
	extent: 16@16
	depth: 32
	fromArray: aByteArray 
	offset: 0@0! !

!GLMMorphicLabelRenderer methodsFor: 'rendering' stamp: 'TudorGirba 7/1/2011 23:18'!
actOnPresentationUpdated: anAnnouncement
	labelMorph contents: anAnnouncement presentation formatedDisplayValue! !

!GLMMorphicLabelRenderer methodsFor: 'rendering' stamp: 'TudorGirba 7/1/2011 23:16'!
render: aLabelPresentation
	labelMorph := (LabelMorph contents: aLabelPresentation formatedDisplayValue) 
			layoutFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 1));
			vResizing: #spaceFill;
			hResizing: #spaceFill;
			font: StandardFonts haloFont;
			yourself.
	aLabelPresentation on: GLMPresentationUpdated send: #actOnPresentationUpdated: to: self.
	^labelMorph! !

!GLMMorphicListingRenderer methodsFor: 'private' stamp: 'AndreiChis 3/16/2015 14:40'!
newTreeMorph

	^ GLMPaginatedMorphTreeMorph new! !

!GLMMorphicListingRenderer methodsFor: 'private' stamp: 'AndreiChis 11/3/2013 11:48'!
suspendedAnnouncements
	^ OrderedCollection  
		with: GLMTreeMorphSelectionChanged 
		with: GLMTreeMorphStrongSelectionChanged 
		with: GLMMenuItemSelected 
		with: GLMKeyStroke! !

!GLMMorphicListingRenderer methodsFor: 'rendering' stamp: 'AndreiChis 11/3/2013 12:08'!
actOnContextChanged: anAnnouncement 
	anAnnouncement property = #selection ifTrue: [ 
		treeModel announcer 
			suspendAll: self suspendedAnnouncements
			while: [
				treeMorph model explicitSelection: anAnnouncement value ] ] ! !

!GLMMorphicListingRenderer methodsFor: 'rendering' stamp: 'BernardoContreras 12/7/2014 00:33'!
render: aPresentation
	| container textInput |
	treeModel := GLMTreeMorphModel new glamourPresentation: aPresentation.
	container := GLMMorphic containerMorph.
	treeMorph := self treeMorphFor: treeModel and: aPresentation.
	aPresentation allowsInput
		ifTrue: [
			textInput := self textInputFor: treeModel withHelpMessage: aPresentation helpMessage.
			treeMorph layoutFrame bottomOffset: -26.
			container addMorphBack: textInput ].
	container addMorphBack: treeMorph.
	self installActionsOnModel: treeModel fromPresentation: aPresentation.
	self installKeystrokeActionsOnMorph: treeMorph fromPresentation: aPresentation.
	aPresentation selection notNil
		ifTrue: [ treeModel announcer 
			suspendAll: self suspendedAnnouncements
			while: [ treeMorph model explicitSelection: aPresentation selection ] ].	"When the morph changes, we want to update the glamour model"
	treeModel announcer
		when: GLMTreeMorphSelectionChanged
		do: [ :ann | 
			aPresentation announcer
				suspendAllWhile: [ 
					aPresentation selection: ann selectionValue.
					aPresentation selectionPath: ann selectionPathValue ] ].
	treeModel announcer
		when: GLMTreeMorphStrongSelectionChanged
		do: [ :ann | aPresentation strongSelection: ann strongSelectionValue ].	"When the glamour model changes, we want to update the morph"
	aPresentation on: GLMContextChanged send: #actOnContextChanged: to: self.
	aPresentation on: GLMPresentationUpdated send: #actOnUpdatedPresentation: to: self.
	^ container! !

!GLMMorphicListingRenderer methodsFor: 'private' stamp: 'VincentBlondeau 2/14/2014 17:33'!
textInputFor: aTreeModel withHelpMessage: helpStringMessage
	| textInput |
	textInput := self theme
		newTextEntryIn: nil
		for: aTreeModel
		get: #inputText
		set: #inputText:
		class: String
		getEnabled: #inputTextEnabled
		help: helpStringMessage.
	textInput askBeforeDiscardingEdits: false.
	textInput layoutFrame: (LayoutFrame fractions: (0 @ 1 corner: 1 @ 1) offsets: (0 @ -26 corner: 0 @ -4)).
	textInput ghostText: 'enter search query'.
	^ textInput! !

!GLMMorphicListingRenderer methodsFor: 'private' stamp: 'AliakseiSyrel 10/7/2014 13:42'!
treeMorphFor: tmpTreeModel and: aPresentation
	| tmpTreeMorph columns |
	tmpTreeMorph := self newTreeMorph.
	tmpTreeMorph
		makeLastColumnUnbounded;
		doubleClickSelector: #onDoubleClick;
		getMenuSelector: #menu:shifted:;
		keystrokeActionSelector: #keyStroke:from:;
		columnInset: 3;
		rowInset: 1;
		cornerStyle: tmpTreeMorph preferredCornerStyle;
		borderStyle: (BorderStyle inset width: 1);
		autoDeselection: aPresentation allowsDeselection;
		dragEnabled: tmpTreeModel dragEnabled;
		dropEnabled: tmpTreeModel dropEnabled;		
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		layoutFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 1)).
	columns := aPresentation columns isEmpty 
		ifTrue: [ OrderedCollection with: (MorphTreeColumn new rowMorphGetSelector: #elementColumn)]
		ifFalse: [
			aPresentation columns collect: [:each | 
				GLMMorphTreeColumn new 
					startWidth: each width;
					glamourColumn: each; 
					headerButtonLabel: (aPresentation titleValueOfColumn: each)
					font: StandardFonts menuFont 
					target: tmpTreeModel
					actionSelector: #sortByColumn:
					arguments: {each}; 
					yourself ].
		].
	tmpTreeMorph
		preferedPaneColor: Smalltalk ui theme backgroundColor;	
		model: tmpTreeModel;
		columns: columns.
	aPresentation isMultiple 
		ifTrue: [tmpTreeMorph beMultiple] 
		ifFalse: [tmpTreeMorph beSingle].
	tmpTreeMorph chunkSize: aPresentation amountToShow.
	tmpTreeMorph pageSize: aPresentation amountToShow.
	tmpTreeMorph vShowScrollBar.
	^ tmpTreeMorph buildContents! !

!GLMMorphicListingRenderer methodsFor: 'rendering' stamp: 'TudorGirba 2/20/2012 15:18'!
actOnUpdatedPresentation: anAnnouncement
	treeMorph model updateRoots.
	self flag: 'Calling update list explicitly here is a hack. This should be solvable by the model through a notification mechanism'.
	treeMorph updateList! !

!GLMMorphicModel methodsFor: 'callbacks' stamp: 'TudorGirba 3/24/2013 12:56'!
keystroke: anEvent from: aMorph
	| action |

	action := self allKeystrokeActions detect: [:a | a shortcut = anEvent keyCharacter] ifNone: [nil].
	action ifNotNil: [ 
		self announce: (GLMKeyStroke action: action).
		^ true ].
	^ false! !

!GLMMorphicModel methodsFor: 'initialization' stamp: 'tg 8/4/2009 15:26'!
initialize
	super initialize.! !

!GLMMorphicModel methodsFor: 'callbacks' stamp: 'TudorGirba 11/25/2010 13:20'!
allKeystrokeActions
	^ (self glamourPresentation allActions, self glamourPresentation allSelectionActions) select: [ :action | 
		action hasShortcut ]! !

!GLMMorphicModel methodsFor: 'callbacks' stamp: 'AndreiChis 10/5/2014 15:22'!
menu: aMenuMorph 
	| subMenus targetMenuMorph subMenu allActions |
	subMenus := Dictionary new.
	allActions := self allMenuActions.
	allActions do: [ :action |
		targetMenuMorph := action category notNil 
			ifTrue: [ subMenus at: action category ifAbsentPut: [ 
					subMenu :=  MenuMorph new.
					aMenuMorph add: action category subMenu: subMenu.
					subMenu ] ]
			ifFalse: [ aMenuMorph ].
		(action separatorBefore and: [ allActions first ~= action ]) ifTrue: [ targetMenuMorph addLine ].
		(targetMenuMorph 
			add: action title
			target: self
			selector: #executeMenuAction:
			argument: action)
			icon:  action icon;
			keyText: (action hasShortcut 
				ifTrue: [ action shortcutAsString ]
				ifFalse: [ nil ]).
		(action separatorAfter and: [ allActions last ~= action ]) ifTrue: [ targetMenuMorph addLine ] ].
	^ aMenuMorph! !

!GLMMorphicModel methodsFor: 'callbacks' stamp: 'tg 11/19/2010 18:18'!
allMenuActions
	^ self glamourPresentation allSelectionActions select: [:action | action hasTitle ]! !

!GLMMorphicModel methodsFor: 'accessing' stamp: 'tg 8/4/2009 14:23'!
glamourPresentation: anObject
	glamourPresentation := anObject! !

!GLMMorphicModel methodsFor: 'callbacks' stamp: 'jre 7/31/2009 09:48'!
executeMenuAction: anAction
	self announce: (GLMMenuItemSelected action: anAction)! !

!GLMMorphicModel methodsFor: 'accessing' stamp: 'tg 8/4/2009 14:23'!
glamourPresentation
	^ glamourPresentation! !

!GLMMorphicMorphRenderer methodsFor: 'private' stamp: 'EstebanLorenzano 11/8/2011 00:22'!
allKeyboardActionsFor: aPresentation 
	^(aPresentation allActions, 
		aPresentation allSelectionActions) 
		select: [ :action | action hasShortcut ]! !

!GLMMorphicMorphRenderer methodsFor: 'rendering' stamp: 'EstebanLorenzano 11/8/2011 02:06'!
actOnKeyStroke: aPresentation event: anEvent from: aMorph 
	| action |

	anEvent commandKeyPressed ifFalse: [ ^self ].
	action := (self allKeyboardActionsFor: aPresentation) 
		detect: [ :each | each shortcut = anEvent keyCharacter  ] 
		ifNone: [ nil ].
		
	action 
		ifNotNil: [ action actOn: aPresentation].! !

!GLMMorphicMorphRenderer methodsFor: 'rendering' stamp: 'EstebanLorenzano 11/7/2011 11:23'!
actOnPresentationUpdated: ann
	container removeAllMorphs.
	container addMorphBack: (self morphFrom: ann presentation)! !

!GLMMorphicMorphRenderer methodsFor: 'rendering' stamp: 'TudorGirba 4/3/2013 16:57'!
render: aMorphPresentation
	container := GLMMorphic containerMorph.
	container 
		changeTableLayout;
		listDirection: #leftToRight;
		vResizing: #spaceFill;
		hResizing: #spaceFill.
	
	container addMorphBack: (self morphFrom: aMorphPresentation).
	
	aMorphPresentation on: GLMPresentationUpdated send: #actOnPresentationUpdated: to: self.

	^ container! !

!GLMMorphicMorphRenderer methodsFor: 'rendering' stamp: 'TudorGirba 1/9/2014 14:49'!
morphFrom: aMorphPresentation
	| morph  |
	
	morph := aMorphPresentation morph 
		vResizing: #spaceFill; 
		hResizing: #spaceFill;
		yourself.
	
	(self allKeyboardActionsFor: aMorphPresentation) ifNotEmpty: [
		morph 
			on: #keyStroke 
			send: #actOnKeyStroke:event:from: 
			to: self 
			withValue: aMorphPresentation ].
		
	^morph! !

!GLMMorphicPagerRenderer commentStamp: 'AndreiChis 6/28/2014 21:19'!
A GLMMorphicPagerRenderer is xxxxxxxxx.
!
!GLMMorphicPagerRenderer methodsFor: 'accessing' stamp: 'AndreiChis 6/28/2014 21:18'!
defaultScrollButtonIconRenderBlock

	^ [ :object | {Form new. Form new} ]! !

!GLMMorphicPagerRenderer methodsFor: 'callbacks' stamp: 'AliakseiSyrel 2/4/2015 15:17'!
actOnPaneReplaced: ann
	container brickRoot popAndReplacePane: (self renderObject: ann newPane)! !

!GLMMorphicPagerRenderer methodsFor: 'callbacks' stamp: 'AliakseiSyrel 2/4/2015 15:17'!
actOnPaneAdded: ann
	container brickRoot pushPane: (self renderObject: ann pane).! !

!GLMMorphicPagerRenderer methodsFor: 'callbacks' stamp: 'AliakseiSyrel 2/4/2015 15:17'!
actOnPaneRemoved: ann
	container brickRoot popPane! !

!GLMMorphicPagerRenderer methodsFor: 'rendering' stamp: 'AliakseiSyrel 2/4/2015 15:17'!
render: aBrowser
	|pagerModel|
	pagerModel := GLMPagerModel new
		isDependenciesShown: false;
		defaultNumberOfVisiblePages: aBrowser fixedSizePanes.
	
	aBrowser scrollButtonIconRenderBlock ifNotNil: [
		"result value of the block is raw icon of the Form class"
		pagerModel scrollButtonIconRenderBlock: [ :index | aBrowser scrollButtonIconRenderBlock cull: ((aBrowser panes at: index) port: #entity) value ]
	].
	
	container := (GLMPagerBrick new
		pagerModel: pagerModel;
		yourself) asBrickedMorph.

	"container maxPanes: aBrowser fixedSizePanes."
	self registerAnnouncementsFor: aBrowser.  
	aBrowser panes
		do: [ :each | container brickRoot pushPane: (self renderObject: each) ].
	^ container! !

!GLMMorphicPaneRenderer methodsFor: 'rendering' stamp: 'AndreiChis 10/5/2014 21:22'!
renderContainerFor: aPane

	contentMorph := self 
		morph: (self renderObject: aPane presentations) 
		withTitleOrNilOf: aPane presentations.
		
	container
		addMorph: contentMorph fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 1));
		adoptPaneColor: Color transparent! !

!GLMMorphicPaneRenderer methodsFor: 'rendering' stamp: 'AndreiChis 10/5/2014 21:27'!
render: aPane
	container := GLMMorphic containerMorph.
	self renderContainerFor: aPane.
	aPane on: GLMMatchingPresentationsChanged send: #actOnMatchingPresentationChanged: to: self.
	(aPane presentations hasTitle or: [aPane presentations hasTitleIcon]) ifTrue: [
		aPane on: GLMPresentationToolbarUpdated send: #actOnPresentationToolbarUpdated: to: self. ].
	^ container! !

!GLMMorphicPaneRenderer methodsFor: 'rendering' stamp: 'AliakseiSyrel 3/22/2015 11:48'!
actOnPresentationToolbarUpdated: anAnnouncement
	"If this method is called contentMorph should be an tab widget"
	| presentation |
	
	presentation := anAnnouncement presentation.	
	contentMorph updatePageAtIndex: 1
			withLabel: (self titleOrIconOf: presentation in: contentMorph)
			toolbar: (self renderToolbarForPresentation: presentation inMorph: contentMorph)
			action: (self labelActionBrickFor: presentation)
	
	! !

!GLMMorphicPaneRenderer methodsFor: 'rendering' stamp: 'AndreHora 2/14/2014 16:52'!
actOnMatchingPresentationChanged: anAnnouncement
	container removeAllMorphs.
	self renderContainerFor: anAnnouncement pane.
	self renderer window
		ifNotNil: [ 
			self flag: 'this check is fishy'.
			self renderer window fullBounds ]! !

!GLMMorphicPaneWithoutTitleRenderer methodsFor: 'rendering' stamp: 'TudorGirba 2/15/2011 12:29'!
renderMorphFor: aPane
	paneMorph
		addMorph: (self renderObject: aPane presentations) fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 1));
		adoptPaneColor: paneMorph paneColor! !

!GLMMorphicPaneWithoutTitleRenderer methodsFor: 'rendering' stamp: 'TudorGirba 2/15/2011 12:29'!
render: aPane
	paneMorph := GLMMorphic containerMorph.
	aPane
		on: GLMMatchingPresentationsChanged
		send: #actOnMatchingPresentationsChanged:
		to: self.
	self renderMorphFor: aPane.
	^ paneMorph! !

!GLMMorphicPaneWithoutTitleRenderer methodsFor: 'rendering' stamp: 'TudorGirba 2/15/2011 12:31'!
actOnMatchingPresentationsChanged: anAnnouncement 
	paneMorph	removeAllMorphs.
	self renderMorphFor: anAnnouncement pane.
	self renderer window fullBounds! !

!GLMMorphicPharoCodeRenderer methodsFor: 'callbacks' stamp: 'AndreiChis 7/7/2014 22:16'!
actOnCompileText: ann 
	
	"The current compiler wants to notify a text morph object in case of errors. 
	The compilation is delagated to the renderer, as the renderer has access
	to the text morph object."
	(ann session 
		recompileMethodTo: ann presentation text 
		inContext: ann context 
		notifying: textMorph) ifTrue: [ ann action ifNotNil: [ :action | action value ] ]! !

!GLMMorphicPharoCodeRenderer methodsFor: 'callbacks' stamp: 'AndreiChis 5/30/2014 14:33'!
evaluateAndPrintSelection

	UIManager default defer: [ 
		textMorph textArea editor printIt ]
	! !

!GLMMorphicPharoCodeRenderer methodsFor: 'callbacks' stamp: 'AndreiChis 4/11/2015 21:39'!
actOnHighlightAndEvaluate: ann 

	"We get here as a result of an announcement.
	If we do not defer the execution and an exception is triggered by the execution of the code
	then resuming the execution in the debugger will trigger an error when unwinding the stack."
	UIManager default defer: [ 
		textMorph textArea handleEdit: [
			textMorph textArea editor highlightEvaluateAndDo: ann action .
			textMorph shoutStyler style: textMorph text. ] ]! !

!GLMMorphicPharoCodeRenderer methodsFor: 'private' stamp: 'AndreiChis 1/14/2015 13:21'!
registerEventsForPresentation: aPresentation

	super registerEventsForPresentation: aPresentation.
	aPresentation on: GLMSelectCurrentLine send: #selectLine to: self.
	aPresentation on: GLMEvaluateSelection send: #actOnEvaluateSelection: to: self.
	aPresentation on: GLMHighlightAndEvaluate send: #actOnHighlightAndEvaluate: to: self.
	aPresentation on: GLMCompileText send: #actOnCompileText: to: self.
	aPresentation on: GLMDebugSelection send: #debugHighlightedText to: self.
	aPresentation on: GLMProfileSelection send: #profileHighlightedText to: self.
	aPresentation on: GLMPrintSelection send: #evaluateAndPopPrintHighlight to: self
	! !

!GLMMorphicPharoCodeRenderer methodsFor: 'rendering' stamp: 'AndreiChis 5/7/2014 17:15'!
modelFor: aPresentation

	^ GLMRubricSmalltalkTextModel new
		glamourPresentation: aPresentation;
		highlightSmalltalk: true;
		yourself! !

!GLMMorphicPharoCodeRenderer methodsFor: 'callbacks' stamp: 'AndreiChis 1/30/2015 14:58'!
actOnEvaluateSelection: ann 

	"We get here as a result of an announcement.
	If we do not defer the execution and an exception is triggered by the execution of the code
	then resuming the execution in the debugger will trigger an error when unwinding the stack."
	ann isSyncronous ifTrue: [ 
		textMorph textArea editor evaluateSelectionAndDo: ann action.
		^ self ]. 
	UIManager default defer: [ 
		textMorph textArea editor evaluateSelectionAndDo: ann action ]
	! !

!GLMMorphicPharoCodeRenderer methodsFor: 'callbacks' stamp: 'AndreiChis 4/11/2015 21:40'!
profileHighlightedText

	textMorph textArea editor tallyHighlight.
	textMorph shoutStyler style: textMorph text.! !

!GLMMorphicPharoCodeRenderer methodsFor: 'callbacks' stamp: 'AndreiChis 5/7/2014 18:01'!
selectLine
	
	textMorph textArea editor lineSelectAndEmptyCheck: [^ nil]! !

!GLMMorphicPharoCodeRenderer methodsFor: 'callbacks' stamp: 'AndreiChis 4/11/2015 21:39'!
evaluateAndPopPrintHighlight

	GLMPrintPopper installAlarmFor: [ 
		textMorph textArea editor highlightEvaluateAndDo: [ :result | 
			textMorph shoutStyler style: textMorph text.
			GLMPrintPopper new 
				openFromRubric: textMorph textArea withResult: result ] ]! !

!GLMMorphicPharoCodeRenderer methodsFor: 'callbacks' stamp: 'AndreiChis 4/11/2015 21:40'!
debugHighlightedText

	UIManager default defer: [ 
		textMorph textArea editor debugHighlight.
		textMorph shoutStyler style: textMorph text. ]
	! !

!GLMMorphicPharoCodeRendererTest methodsFor: 'tests' stamp: 'AndreiChis 12/27/2014 14:07'!
testCodeExecutionWithBindings
	| composite textMorph result |
	composite := GLMCompositePresentation new.
	composite pharoPlayground.
	window := composite openOn: 'a:=1'.

	result := nil.
	textMorph := self find: RubScrolledTextMorph in: window.
	textMorph textArea editor evaluateSelectionAndDo: [ :r | result := r ].
	self assert: result equals: 1! !

!GLMMorphicPharoMethodRenderer methodsFor: 'private' stamp: 'AndreiChis 5/7/2014 17:28'!
methodBindingsStrategy

	^ [ :currentBindings :aSymbol |
		 currentBindings associationAt: aSymbol ifAbsent: [nil] ]! !

!GLMMorphicPharoMethodRenderer methodsFor: 'rendering' stamp: 'AndreiChis 5/7/2014 17:30'!
modelFor: aPresentation

	^ (super modelFor: aPresentation)
		highlightSmalltalkContext: aPresentation highlightSmalltalkContext;
		bindingsStrategy: self methodBindingsStrategy;
		yourself! !

!GLMMorphicPharoMethodRenderer methodsFor: 'rendering' stamp: 'TudorGirba 7/11/2014 22:15'!
morph
	
	^ RubScrolledTextMorph new
		beForSmalltalkCode;
		model: textModel;
		color: Smalltalk ui theme backgroundColor;
		textFont: StandardFonts codeFont;
		yourself! !

!GLMMorphicPharoPlaygroundRenderer methodsFor: 'rendering' stamp: 'TudorGirba 8/3/2014 09:22'!
morph
	^ RubScrolledTextMorph new
		model: textModel;
		beForSmalltalkScripting;
		textFont: StandardFonts codeFont;
		color: Smalltalk ui theme backgroundColor;
		notificationStrategy: GLMPopperNotificationStrategy new;
		yourself! !

!GLMMorphicPharoPlaygroundRenderer methodsFor: 'callbacks' stamp: 'AndreiChis 3/27/2015 17:38'!
actOnVariableBindingsUpdated: ann 

	textModel variableBindings: nil.
	textModel appendVariableBinding: ann presentation variableBindings.
	textMorph shoutStyler style: textMorph text.! !

!GLMMorphicPharoPlaygroundRenderer methodsFor: 'private' stamp: 'AndreiChis 11/14/2014 12:12'!
workspaceBindingsStrategy

	^ [ :currentBindings :aString |
		(currentBindings includesKey: aString)
			ifFalse: [currentBindings add: (WorkspaceVariable key: aString asSymbol) ].
		currentBindings associationAt: aString]! !

!GLMMorphicPharoPlaygroundRenderer methodsFor: 'private' stamp: 'AndreiChis 3/19/2015 17:33'!
registerEventsForPresentation: aPresentation

	super registerEventsForPresentation: aPresentation.
	
	aPresentation on: GLMVariableBindingsChanged send: #actOnVariableBindingsUpdated: to: self.
	aPresentation on: GLMVariableBindingsAccessRequest send: #actOnVariableBindingsAccessRequest: to: self.
	! !

!GLMMorphicPharoPlaygroundRenderer methodsFor: 'rendering' stamp: 'AndreiChis 5/7/2014 17:15'!
modelFor: aPresentation

	^ (super modelFor: aPresentation)
		bindingsStrategy: self workspaceBindingsStrategy;
		appendVariableBinding: aPresentation variableBindings;
		yourself! !

!GLMMorphicPharoPlaygroundRenderer methodsFor: 'callbacks' stamp: 'AndreiChis 3/19/2015 17:37'!
actOnVariableBindingsAccessRequest: ann 

	ann action ifNotNil: [ :aBlock |
		aBlock cull: textModel variableBindings ]! !

!GLMMorphicPopupActionRenderer methodsFor: 'accessing' stamp: 'AndreiChis 3/27/2015 17:54'!
actionArguments
	^ nil! !

!GLMMorphicPopupActionRenderer methodsFor: 'accessing' stamp: 'AndreiChis 3/27/2015 17:48'!
actionSelector
	^ #popupActOn:from:! !

!GLMMorphicPresentationToolbarModel methodsFor: 'accessing' stamp: 'tg 11/6/2010 11:43'!
presentation: anObject
	presentation := anObject! !

!GLMMorphicPresentationToolbarModel methodsFor: 'accessing' stamp: 'tg 11/6/2010 11:43'!
renderer
	^ renderer! !

!GLMMorphicPresentationToolbarModel methodsFor: 'accessing' stamp: 'tg 11/6/2010 11:43'!
renderer: anObject
	renderer := anObject! !

!GLMMorphicPresentationToolbarModel methodsFor: 'accessing' stamp: 'tg 11/6/2010 11:43'!
presentation
	^ presentation! !

!GLMMorphicRenderer commentStamp: 'tg 4/1/2010 07:11'!
This is the class responsible for the binding to Morphic.

| browser |
browser := GLMTabulator new.
browser column: #one; column: #two.

browser transmit to: #one; andShow: [:a | a list.].
browser transmit to: #two; from: #one; andShow: [ :a |
	a text.].
browser openOn: #(a b c d)!
!GLMMorphicRenderer methodsFor: 'rendering presentations' stamp: 'TudorGirba 6/2/2013 21:48'!
renderRubricTextPresentation: aPresentation
	^ GLMMorphicRubricTextRenderer render: aPresentation from: self! !

!GLMMorphicRenderer methodsFor: 'rendering presentations' stamp: 'tg 8/22/2010 23:16'!
renderTreePresentation: aPresentation 
	^ GLMMorphicTreeRenderer render: aPresentation from: self! !

!GLMMorphicRenderer methodsFor: 'rendering presentations' stamp: 'tg 8/22/2010 23:12'!
renderListingPresentation: aPresentation 
	^ GLMMorphicListingRenderer render: aPresentation from: self! !

!GLMMorphicRenderer methodsFor: 'rendering presentations' stamp: 'TudorGirba 6/29/2012 09:47'!
renderDropDownListPresentation: aDropListPresentation
	^ GLMMorphicDropDownRenderer render: aDropListPresentation from: self	! !

!GLMMorphicRenderer methodsFor: 'accessing' stamp: 'tg 8/23/2010 00:33'!
window
	^ window! !

!GLMMorphicRenderer methodsFor: 'accessing' stamp: 'tg 8/23/2010 00:33'!
window: anObject
	window := anObject! !

!GLMMorphicRenderer methodsFor: 'rendering browsers' stamp: 'tg 8/24/2010 21:50'!
renderStacker: aBrowser 
	^ GLMMorphicStackerRenderer render: aBrowser from: self! !

!GLMMorphicRenderer methodsFor: 'rendering presentations' stamp: 'TudorGirba 7/1/2011 23:15'!
renderLabelPresentation: aLabelPresentation 
	^ GLMMorphicLabelRenderer render: aLabelPresentation from: self! !

!GLMMorphicRenderer methodsFor: 'rendering browsers' stamp: 'TudorGirba 5/18/2012 22:29'!
renderWrapper: aBrowser 
	^ GLMMorphicWrapperRenderer render: aBrowser from: self! !

!GLMMorphicRenderer methodsFor: 'rendering presentations' stamp: 'EstebanLorenzano 10/6/2011 22:29'!
renderMorphPresentation: aMorphPresentation 
	^ GLMMorphicMorphRenderer render: aMorphPresentation from: self! !

!GLMMorphicRenderer methodsFor: 'rendering browsers' stamp: 'TudorGirba 4/12/2011 13:49'!
renderWizard: aGLMWizard

	|tmpRenderer|
	tmpRenderer :=  GLMMorphicWizardRenderer new.
	aGLMWizard  setSpecificAnnouncementActionsTo: tmpRenderer.  
	^ (tmpRenderer renderer: self) render: aGLMWizard! !

!GLMMorphicRenderer methodsFor: 'rendering presentations' stamp: 'tg 9/3/2010 13:56'!
renderDiffPresentation: aPresentation
	^ GLMMorphicDiffRenderer render: aPresentation from: self! !

!GLMMorphicRenderer methodsFor: 'rendering presentations' stamp: 'TudorGirba 1/20/2011 21:53'!
renderInputPresentation: aPresentation 
	
	| morph |
	self flag: 'hook the cuis editor'.
	morph := GLMMorphic containerMorph.
	^ morph! !

!GLMMorphicRenderer methodsFor: 'rendering browsers' stamp: 'cyrilledelaunay 6/7/2011 17:01'!
renderDashboard: aBrowser 
	^ GLMMorphicDashboardRenderer render: aBrowser from: self! !

!GLMMorphicRenderer methodsFor: 'rendering presentations' stamp: 'TudorGirba 2/4/2011 18:10'!
renderDynamicPresentation: aPresentation
	^ GLMMorphicDynamicRenderer render: aPresentation from: self! !

!GLMMorphicRenderer methodsFor: 'rendering presentations' stamp: 'TudorGirba 5/17/2014 09:18'!
renderPharoPlaygroundPresentation: aWorkspacePresentation 
	^ GLMMorphicPharoPlaygroundRenderer render: aWorkspacePresentation from: self! !

!GLMMorphicRenderer methodsFor: 'rendering presentations' stamp: 'tg 8/22/2010 23:15'!
renderTablePresentation: aPresentation 
	^ GLMMorphicTableRenderer render: aPresentation from: self! !

!GLMMorphicRenderer methodsFor: 'rendering presentations' stamp: 'TudorGirba 4/3/2013 16:57'!
renderSpecPresentation: aPresentation 
	^ GLMMorphicSpecRenderer render: aPresentation from: self! !

!GLMMorphicRenderer methodsFor: 'rendering browsers' stamp: 'tg 8/24/2010 21:50'!
renderTabulator: aBrowser 
	^ GLMMorphicTabulatorRenderer render: aBrowser from: self! !

!GLMMorphicRenderer methodsFor: 'opening' stamp: 'TudorGirba 10/19/2013 03:48'!
open: aRenderable
	window := GLMMorphicWindowRenderer render: aRenderable from: self.
	^ window openInWorld ! !

!GLMMorphicRenderer methodsFor: 'rendering presentations' stamp: 'tg 8/22/2010 23:33'!
renderTabbedCompositePresentation: aCompositePresentation
	^ GLMMorphicTabbedRenderer render: aCompositePresentation from: self! !

!GLMMorphicRenderer methodsFor: 'rendering actions' stamp: 'AndreiChis 3/27/2015 17:50'!
renderPopupAction: anAction
	^ GLMMorphicPopupActionRenderer render: anAction from: self! !

!GLMMorphicRenderer methodsFor: 'rendering presentations' stamp: 'tg 8/22/2010 23:31'!
renderStackedVerticallyCompositePresentation: aCompositePresentation
	^ GLMMorphicVerticallyStackedRenderer render: aCompositePresentation from: self! !

!GLMMorphicRenderer methodsFor: 'rendering presentations' stamp: 'tg 8/22/2010 23:31'!
renderAccordionCompositePresentation: aCompositePresentation
	^ GLMMorphicAccordionRenderer render: aCompositePresentation from: self! !

!GLMMorphicRenderer methodsFor: 'rendering browsers' stamp: 'TudorGirba 2/15/2011 18:07'!
renderFinder: aBrowser 
	^ aBrowser hasFixedSizePanes 
		ifTrue: [GLMMorphicFixedPanesFinderRenderer render: aBrowser from: self]
		ifFalse: [GLMMorphicVariablePanesFinderRenderer render: aBrowser from: self]! !

!GLMMorphicRenderer methodsFor: 'rendering browsers' stamp: 'cyrilledelaunay 5/5/2011 12:03'!
renderValidator: aBrowser 

	| tmpValidatorRenderer |
	tmpValidatorRenderer :=  GLMMorphicValidatorRenderer new.
	aBrowser  setSpecificAnnouncementActionsTo: tmpValidatorRenderer.  
	^ tmpValidatorRenderer render: aBrowser from: self! !

!GLMMorphicRenderer methodsFor: 'rendering presentations' stamp: 'AndreiChis 4/22/2014 20:50'!
renderRubricHighlightedTextPresentation: aPresentation

	^ GLMMorphicRubricHighlightedTextRenderer render: aPresentation from: self! !

!GLMMorphicRenderer methodsFor: 'rendering browsers' stamp: 'TudorGirba 1/2/2011 18:58'!
renderExpander: aBrowser 
	^ GLMMorphicExpanderRenderer render: aBrowser from: self! !

!GLMMorphicRenderer methodsFor: 'rendering presentations' stamp: 'TudorGirba 5/17/2014 09:19'!
renderPharoMethodPresentation: aSmalltalkMethodPresentation 
	^ GLMMorphicPharoMethodRenderer render: aSmalltalkMethodPresentation from: self! !

!GLMMorphicRenderer methodsFor: 'rendering browsers' stamp: 'tg 8/24/2010 21:51'!
renderAccumulator: aBrowser 
	^ GLMMorphicAccumulatorRenderer render: aBrowser from: self! !

!GLMMorphicRenderer methodsFor: 'rendering presentations' stamp: 'TudorGirba 8/29/2011 23:51'!
renderSmalltalkCodePresentation: aSmalltalkCodePresentation 
	^ GLMMorphicSmalltalkCodeRenderer render: aSmalltalkCodePresentation from: self! !

!GLMMorphicRenderer methodsFor: '*Glamour-Morphic-Pager' stamp: 'TudorGirba 6/14/2014 12:10'!
renderPager: aBrowser 
	^ aBrowser hasFixedSizePanes 
		ifTrue: [GLMMorphicPagerRenderer render: aBrowser from: self]
		ifFalse: []! !

!GLMMorphicRenderer methodsFor: 'rendering presentations' stamp: 'EstebanLorenzano 4/20/2012 16:14'!
renderActionListPresentation: anActionListPresentation 
	^GLMMorphicActionListRenderer render: anActionListPresentation from: self! !

!GLMMorphicRenderer methodsFor: 'rendering presentations' stamp: 'tg 8/22/2010 20:22'!
renderTextPresentation: aTextPresentation 
	^ GLMMorphicTextRenderer render: aTextPresentation from: self! !

!GLMMorphicRenderer methodsFor: 'rendering actions' stamp: 'AndreiChis 3/27/2015 17:45'!
renderAction: anAction
	^ GLMMorphicActionRenderer render: anAction from: self! !

!GLMMorphicRenderer methodsFor: 'rendering presentations' stamp: 'tg 8/22/2010 23:14'!
renderListPresentation: aListPresentation 
	^ GLMMorphicListRenderer render: aListPresentation from: self! !

!GLMMorphicRenderer methodsFor: 'rendering' stamp: 'tg 8/24/2010 21:51'!
renderPane: aPane 
	^ GLMMorphicPaneRenderer render: aPane from: self! !

!GLMMorphicRubricHighlightedTextRenderer methodsFor: 'rendering' stamp: 'TudorGirba 9/5/2014 10:50'!
morph
	| morph |
	
	morph := super morph.
	morph editingMode: textModel glamourPresentation editingMode.
	morph textFont: textModel glamourPresentation morphicFont.
	^ morph
		! !

!GLMMorphicRubricTextRenderer methodsFor: 'rendering' stamp: 'AndreiChis 10/6/2014 21:47'!
morph
	|morph|
	morph := RubScrolledTextMorph new
		getSelectionSelector: #primarySelectionInterval;
		model: textModel;
		color: Smalltalk ui theme backgroundColor;
		textFont: StandardFonts defaultFont;
		yourself.
	self flag: 'Temporary solution until Moose moves to Pharo 4'.
	(Smalltalk ui theme class canPerform: #textColor) ifTrue: [ 
		morph textColor: Smalltalk ui theme  textColor ].
	^ morph! !

!GLMMorphicRubricTextRenderer methodsFor: 'private' stamp: 'AndreiChis 10/4/2014 22:39'!
actOnTextEditorRequest: ann

	textMorph textArea editor perform: ann selector	
! !

!GLMMorphicRubricTextRenderer methodsFor: 'private' stamp: 'AndreiChis 10/4/2014 22:39'!
registerEventsForPresentation: aPresentation

	aPresentation on: GLMPresentationUpdated send: #actOnPresentationUpdated: to: self.
	aPresentation on: GLMContextChanged send: #actOnContextChanged: to: self.
	aPresentation on: GLMTextEditorRequest send: #actOnTextEditorRequest: to: self.! !

!GLMMorphicRubricTextRenderer methodsFor: 'rendering' stamp: 'BernardoContreras 12/7/2014 00:35'!
render: aPresentation
	textModel := self modelFor: aPresentation.
	textModel primarySelectionInterval: aPresentation primarySelectionInterval.
	textMorph := self morph.
	aPresentation text: textMorph text.
	aPresentation withLineNumbers
		ifTrue: [ textMorph withLineNumbers ]
		ifFalse: [ textMorph withoutLineNumbers ].
	aPresentation withAnnotation
		ifTrue: [ textMorph withAnnotation ]
		ifFalse: [ textMorph withoutAnnotation ].
	aPresentation withColumns 
		ifTrue: [ textMorph withColumns ]
		ifFalse: [ textMorph withoutColumns ].
	textMorph wrapped: aPresentation wrapped.
	textMorph tabWidth: aPresentation tabWidth.
	aPresentation textSegments do: [:each | 
			textMorph addSegment: each ].
	(aPresentation textSegments anySatisfy: [ :ts | ts icon notNil ])
		ifTrue: [ textMorph withTextSegmentIcons ]
		ifFalse: [ textMorph withoutTextSegmentIcons ].
	textMorph textArea announcer
		when: RubTextChanged
		do: [ :ann | 
			aPresentation announcer
				suspendAllWhile: [ aPresentation text: textMorph text ] ].
	textMorph textArea announcer
		when: RubSelectionChanged
		do: [ :ann | 
			aPresentation announcer 
				suspendAllWhile: [ 
					aPresentation selectionInterval: textMorph selectionInterval.
					aPresentation selectedText: textMorph textArea selection ] ].
			
	textMorph textArea announcer
		when: RubTextAccepted
		do: [ :ann | aPresentation suspendAllWhile: [ aPresentation text: ann text ] ].
		
	self installActionsOnModel: textModel fromPresentation: aPresentation .
	self installKeystrokeActionsOnMorph: textMorph textArea fromPresentation: aPresentation.
	
	self registerEventsForPresentation: aPresentation.
	
	^ textMorph! !

!GLMMorphicRubricTextRenderer methodsFor: 'rendering' stamp: 'TudorGirba 6/3/2013 23:47'!
modelFor: aPresentation
	^ GLMRubricTextModel new
		glamourPresentation: aPresentation;
		yourself! !

!GLMMorphicRubricTextRenderer methodsFor: 'private' stamp: 'AlainPlantec 8/2/2013 15:51'!
actOnPresentationUpdated: ann 

	textMorph setText: ann presentation formatedDisplayValue! !

!GLMMorphicRubricTextRenderer methodsFor: 'private' stamp: 'AlainPlantec 8/2/2013 18:23'!
actOnContextChanged: ann
	ann property = #selectionInterval
		ifTrue: [
			ann value notNil 
				ifTrue: [textMorph setSelection: ann value ]
				ifFalse: [textMorph setSelection: (1 to: 0)] ]! !

!GLMMorphicSingleSpotter methodsFor: 'callbacks' stamp: 'ML 2/26/2011 17:05'!
arrowKey: anEvent from: aMorph
	"Ignore this request."! !

!GLMMorphicSingleSpotter methodsFor: 'accessing' stamp: 'ML 2/26/2011 17:05'!
answer
	"Answer the result of the dialog or nil, if this dialog has been cancelled."
	
	^ answer! !

!GLMMorphicSingleSpotter methodsFor: 'accessing-list' stamp: 'ML 2/26/2011 17:05'!
listLabels
	^ listLabels! !

!GLMMorphicSingleSpotter methodsFor: 'actions' stamp: 'ML 2/26/2011 17:05'!
ok
	answer := self model assisted
		ifTrue: [ self text ]
		ifFalse: [ self listSelection ].
	^ super ok! !

!GLMMorphicSingleSpotter methodsFor: 'testing' stamp: 'ML 2/26/2011 17:05'!
isEnabled
	^ self model assisted
		ifTrue: [ self text isEmptyOrNil not ]
		ifFalse: [ self listIndex > 0 ]! !

!GLMMorphicSingleSpotter methodsFor: 'actions' stamp: 'ML 2/26/2011 17:05'!
cancel
	answer := nil.
	^ super cancel! !

!GLMMorphicSingleSpotter methodsFor: 'morphic' stamp: 'ML 2/26/2011 17:05'!
newContentMorph
	^ (self newColumn: { self newTextMorph. self newListMorph })
		minWidth: 320;
		minHeight: 200;
		yourself! !

!GLMMorphicSingleSpotter methodsFor: 'morphic' stamp: 'ML 2/26/2011 17:05'!
newOKButton
	^ self newOKButtonFor: self getEnabled: #isEnabled! !

!GLMMorphicSingleSpotter methodsFor: 'accessing' stamp: 'MirceaLungu 2/26/2011 17:58'!
parent: anObject
	parent := anObject! !

!GLMMorphicSingleSpotter methodsFor: 'accessing-list' stamp: 'ML 2/26/2011 17:05'!
listSelection
	^ listValues at: self listIndex ifAbsent: [ nil ]! !

!GLMMorphicSingleSpotter methodsFor: 'morphic' stamp: 'ML 2/26/2011 17:05'!
newTextMorph
	textMorph := self
		newTextEntryFor: self
		getText: #text
		setText: #text:
		help: nil.
	textMorph
		autoAccept: true;
		selectAll.
	textMorph textMorph
		on: #keyStroke send: #editorKeyStroke: to: self.
	^ textMorph! !

!GLMMorphicSingleSpotter methodsFor: 'accessing-text' stamp: 'ML 2/26/2011 17:05'!
text
	^ text! !

!GLMMorphicSingleSpotter methodsFor: 'morphic' stamp: 'TudorGirba 10/26/2011 16:04'!
newListMorph
	listMorph := PluggableListMorph
		on: self
		list: #listLabels
		selected: #listIndex
		changeSelected: #listIndex:.
	listMorph
		borderStyle: (self theme listNormalBorderStyleFor: listMorph);
		color: (self theme listNormalFillStyleFor: listMorph);
		cornerStyle: self preferredCornerStyle;
		doubleClickSelector: #doubleClick;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		autoDeselect: false.
	^ listMorph! !

!GLMMorphicSingleSpotter methodsFor: 'accessing' stamp: 'MirceaLungu 2/26/2011 17:58'!
parent
	^ parent! !

!GLMMorphicSingleSpotter methodsFor: 'accessing-list' stamp: 'MirceaLungu 2/26/2011 18:09'!
listIndex: anInteger
	anInteger isZero not ifTrue: [
		parent selectionIn: self.].
	listIndex = anInteger
		ifTrue: [ ^ self ].
	listIndex := anInteger.
	self listSelection ifNotNil: [ :selection |
		self isAssisted ifTrue: [ 
			text := self model labelFor: self listSelection.
			self changed: #text ] ].
	self changed: #listIndex; changed: #isEnabled! !

!GLMMorphicSingleSpotter methodsFor: 'callbacks' stamp: 'ML 2/26/2011 17:05'!
doubleClick
	self ok! !

!GLMMorphicSingleSpotter methodsFor: 'initialization' stamp: 'MirceaLungu 2/26/2011 18:05'!
initializeOn: aRequest parent: theParent
	parent := theParent.
	self initializeOn: aRequest.
! !

!GLMMorphicSingleSpotter methodsFor: 'accessing-list' stamp: 'MirceaLungu 2/26/2011 18:04'!
listSelection: anObject

	self listIndex: (listValues indexOf: anObject ifAbsent: [ 0 ])! !

!GLMMorphicSingleSpotter methodsFor: 'callbacks' stamp: 'ML 2/26/2011 17:05'!
clickIconAt: anInteger
	"Ignore this request."! !

!GLMMorphicSingleSpotter methodsFor: 'accessing-list' stamp: 'ML 2/26/2011 17:05'!
listIndex
	^ listIndex! !

!GLMMorphicSingleSpotter methodsFor: 'callbacks' stamp: 'TudorGirba 10/25/2011 17:25'!
iconAt: anIndex
	^ model ifNotNil: [model iconFor: (listValues at: anIndex ifAbsent: [ ^ nil ])]! !

!GLMMorphicSingleSpotter methodsFor: 'morphic' stamp: 'MirceaLungu 2/26/2011 18:10'!
deselect
	self listIndex: 0.  ! !

!GLMMorphicSingleSpotter methodsFor: 'accessing-list' stamp: 'ML 2/26/2011 17:05'!
listValues: aCollection
	| previous |
	previous := self listSelection.
	listValues := aCollection asArray.
	listLabels := listValues
		collect: [ :each | model labelFor: each ].
	self changed: #listLabels; listSelection: previous! !

!GLMMorphicSingleSpotter methodsFor: 'accessing-text' stamp: 'ML 2/26/2011 17:05'!
text: aString
	text = aString
		ifTrue: [ ^ self ].
	text := aString.
	self listValues: (self model valuesFor: text).
	self isAssisted ifFalse: [
		self listIndex: (self listLabels size = 1
			ifTrue: [ 1 ]
			ifFalse: [ self listLabels findFirst: [ :each | each sameAs: text ] ]) ].
	self changed: #text; changed: #isEnabled! !

!GLMMorphicSingleSpotter methodsFor: 'testing' stamp: 'ML 2/26/2011 17:05'!
isAssisted
	^ self model assisted! !

!GLMMorphicSingleSpotter methodsFor: 'accessing-list' stamp: 'ML 2/26/2011 17:05'!
listValues
	^ listValues! !

!GLMMorphicSingleSpotter methodsFor: 'morphic' stamp: 'ML 2/26/2011 17:05'!
defaultFocusMorph
	^ textMorph! !

!GLMMorphicSingleSpotter methodsFor: 'callbacks' stamp: 'ML 2/26/2011 17:05'!
editorKeyStroke: anEvent
	anEvent keyCharacter = Character arrowDown ifTrue: [
		self listIndex: (self listIndex + 1 min: listValues size).
		^ true ].
	anEvent keyCharacter = Character arrowUp ifTrue: [
		self listIndex: (self listIndex - 1 max: 1). 
		^ true ].
	^ false! !

!GLMMorphicSingleSpotter methodsFor: 'initialization' stamp: 'ML 2/26/2011 17:05'!
initializeOn: aRequest
	model := aRequest.
	listValues := listLabels := #().
	listIndex := 0.
	self initialize.
	self title: aRequest prompt.
	self text: aRequest default
! !

!GLMMorphicSingleSpotter class methodsFor: 'instance creation' stamp: 'MirceaLungu 2/26/2011 17:59'!
on: aRequest parent: parent
	^ self basicNew initializeOn: aRequest parent: parent! !

!GLMMorphicSingleSpotter class methodsFor: 'instance creation' stamp: 'ML 2/26/2011 17:05'!
openOn: aRequest
	^ UITheme builder openModal: (self on: aRequest)! !

!GLMMorphicSingleSpotter class methodsFor: 'instance creation' stamp: 'ML 2/26/2011 17:05'!
on: aRequest
	^ self basicNew initializeOn: aRequest! !

!GLMMorphicSmalltalkCodeRenderer methodsFor: 'callbacks' stamp: 'AndreiChis 7/7/2014 22:16'!
actOnCompileText: ann 
	
	"The current compiler wants to notify a text morph object in case of errors. 
	The compilation is delagated to the renderer, as the renderer has access
	to the text morph object."
(ann session 
		recompileMethodTo: ann presentation text 
		inContext: ann context 
		notifying: textMorph) ifTrue: [ ann action ifNotNil: [ :action | action value ] ]
	! !

!GLMMorphicSmalltalkCodeRenderer methodsFor: 'callbacks' stamp: 'AndreiChis 11/13/2014 14:50'!
evaluateAndPrintSelection

	UIManager default defer: [ textMorph printIt ]! !

!GLMMorphicSmalltalkCodeRenderer methodsFor: 'callbacks' stamp: 'AndreiChis 5/6/2014 11:28'!
profileSelection

	textMorph tallyIt! !

!GLMMorphicSmalltalkCodeRenderer methodsFor: 'rendering' stamp: 'AndreiChis 5/7/2014 11:01'!
registerEventsForPresentation: aPresentation 

	super registerEventsForPresentation: aPresentation.
	aPresentation on: GLMVariableBindingsChanged send: #actOnVariableBindingsUpdated: to: self.
	aPresentation on: GLMEvaluateSelection send: #actOnEvaluateSelection: to: self.
	aPresentation on: GLMCompileText send: #actOnCompileText: to: self.
	aPresentation on: GLMDebugSelection send: #debugSelection to: self.
	aPresentation on: GLMProfileSelection send: #profileSelection to: self.
	aPresentation on: GLMPrintSelection send: #evaluateAndPrintSelection to: self.
	
! !

!GLMMorphicSmalltalkCodeRenderer methodsFor: 'rendering' stamp: 'AndreiChis 5/6/2014 14:00'!
textModelFor: aPresentation
	| tm |
	tm := GLMSmalltalkCodeModel new
		text: aPresentation formatedDisplayValue;
		glamourPresentation: aPresentation;
		highlightSmalltalk: true;
		highlightSmalltalkContext: aPresentation highlightSmalltalkContext.
	self addVariableBindingsOn: tm from: aPresentation.
	aPresentation isForScripting ifTrue: [ 
		tm bindingsStrategy: self workspaceBindingsStrategy ].
	^ tm! !

!GLMMorphicSmalltalkCodeRenderer methodsFor: 'callbacks' stamp: 'AndreiChis 5/6/2014 15:13'!
actOnEvaluateSelection: ann 

	"We get here as a result of an announcement.
	If we do not defer the execution and an exception is triggered by the execution of the code
	then resuming the execution in the debugger will trigger an error when unwinding the stack."
	UIManager default defer: [ 
		textMorph evaluateSelectionAndDo: ann action ]! !

!GLMMorphicSmalltalkCodeRenderer methodsFor: 'callbacks' stamp: 'AndreiChis 5/7/2014 11:22'!
debugSelection

	textMorph debugIt! !

!GLMMorphicSmalltalkCodeRenderer methodsFor: 'rendering' stamp: 'AndreiChis 3/6/2014 12:14'!
addVariableBindingsOn: aTextModel from: aPresentation

	aPresentation variableBindings do: [ :each | aTextModel addVariableBinding: each ].! !

!GLMMorphicSmalltalkCodeRenderer methodsFor: 'rendering' stamp: 'AndreiChis 6/26/2014 15:13'!
textMorphForModel: aTextModel
	| morph  |
	morph := GLMPluggableTextMorph new.
	morph styler workspace: aTextModel.
	morph
		on: aTextModel
			text: #text
			accept: #accept:notifying:
			readSelection: #selection
			menu: #menu:shifted:;
		changedAction: [:aText| 
			aText asString trimBoth ifNotEmpty:  [aTextModel text: aText] ];
		onKeyStrokeSend: #keystroke:from: to: aTextModel;
		layoutFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 1));
		vResizing: #spaceFill;
		hResizing: #spaceFill;
		color: Smalltalk ui theme backgroundColor;
		font: StandardFonts codeFont;
		yourself.
	^ morph! !

!GLMMorphicSmalltalkCodeRenderer methodsFor: 'callbacks' stamp: 'AndreiChis 3/6/2014 12:14'!
actOnVariableBindingsUpdated: ann 

	textModel variableBindings: nil.
	self addVariableBindingsOn: textModel from: ann presentation.
	textModel changed: #text. self flag: 'update just the style here'! !

!GLMMorphicSmalltalkCodeRenderer methodsFor: 'private' stamp: 'AndreiChis 9/30/2014 15:24'!
workspaceBindingsStrategy

	^ [ :currentBindings :aString |
		(currentBindings includesKey: aString)
			ifFalse: [currentBindings add: (WorkspaceVariable key: aString asSymbol) ].
		currentBindings associationAt: aString]! !

!GLMMorphicSpecRenderer methodsFor: 'rendering' stamp: 'TudorGirba 4/3/2013 17:00'!
actOnPresentationUpdated: ann
	container removeAllMorphs.
	container addMorphBack: (self morphFrom: ann presentation)! !

!GLMMorphicSpecRenderer methodsFor: 'rendering' stamp: 'AndreiChis 9/22/2014 10:49'!
render: aPresentation
	container := GLMMorphic containerMorph.
	container 
		changeTableLayout;
		listDirection: #leftToRight;
		vResizing: #spaceFill;
		hResizing: #spaceFill.
	
	container addMorphBack: aPresentation displayValue widget widget.
	
	aPresentation on: GLMPresentationUpdated send: #actOnPresentationUpdated: to: self.

	^ container! !

!GLMMorphicSpotter methodsFor: 'accessing' stamp: 'VincentBlondeau 2/14/2014 17:02'!
ok
	| nonEmpty |
	nonEmpty := self childrenMorphs reject: [ :e | e listIndex isZero ].
	nonEmpty size = 1
		ifTrue: [ answer := nonEmpty first listSelection ].
	^ super ok! !

!GLMMorphicSpotter methodsFor: 'accessing' stamp: 'ML 2/26/2011 17:08'!
answer
	^ answer! !

!GLMMorphicSpotter methodsFor: 'morphic' stamp: 'ML 2/26/2011 17:21'!
newContentMorph
	^ (self newColumn: 
			((OrderedCollection with: self newTextMorph) addAll: self newListMorphs; yourself) )
		minWidth: 320;
		minHeight: 200;
		yourself! !

!GLMMorphicSpotter methodsFor: 'accessing' stamp: 'ML 2/26/2011 17:08'!
childrenMorphs: anObject
	childrenMorphs := anObject! !

!GLMMorphicSpotter methodsFor: 'accessing' stamp: 'ML 2/26/2011 17:08'!
childrenMorphs
	^ childrenMorphs! !

!GLMMorphicSpotter methodsFor: 'accessing' stamp: 'ML 2/26/2011 17:07'!
textMorph: anObject
	textMorph := anObject! !

!GLMMorphicSpotter methodsFor: 'accessing' stamp: 'ML 2/26/2011 17:14'!
text: aString
	text = aString
		ifTrue: [ ^ self ].
	text := aString.
	self childrenMorphs do: [:each | each text: aString ].
	self changed: #text; changed: #isEnabled! !

!GLMMorphicSpotter methodsFor: 'morphic' stamp: 'ML 2/26/2011 17:13'!
newTextMorph
	textMorph := self
		newTextEntryFor: self
		getText: #text
		setText: #text:
		help: nil.
	textMorph
		autoAccept: true;
		selectAll.
	textMorph textMorph
		on: #keyStroke send: #editorKeyStroke: to: self.
	^ textMorph! !

!GLMMorphicSpotter methodsFor: 'accessing' stamp: 'ML 2/26/2011 17:08'!
text
	^ text! !

!GLMMorphicSpotter methodsFor: 'morphic' stamp: 'TudorGirba 2/27/2011 15:25'!
newListMorphs
	| list |
	self model requests do: [:each | 
		list := (GLMMorphicSingleSpotter on: each parent: self).
		self childrenMorphs add: list ].
	^ childrenMorphs collect: #newListMorph! !

!GLMMorphicSpotter methodsFor: 'initialization' stamp: 'ML 2/26/2011 17:18'!
initialize 
	childrenMorphs := OrderedCollection new.
	super initialize! !

!GLMMorphicSpotter methodsFor: 'accessing' stamp: 'ML 2/26/2011 17:07'!
textMorph
	^ textMorph! !

!GLMMorphicSpotter methodsFor: 'callbacks' stamp: 'ML 2/26/2011 17:21'!
editorKeyStroke: anEvent
"	anEvent keyCharacter = Character arrowDown ifTrue: [
		self listIndex: (self listIndex + 1 min: listValues size).
		^ true ].
	anEvent keyCharacter = Character arrowUp ifTrue: [
		self listIndex: (self listIndex - 1 max: 1). 
		^ true ]."
	^ false! !

!GLMMorphicSpotter methodsFor: 'initialization' stamp: 'ML 2/26/2011 17:16'!
initializeOn: aRequest
	model := aRequest.
	self initialize.
	self title: aRequest prompt.
	self text: aRequest default
! !

!GLMMorphicSpotter methodsFor: 'accessing' stamp: 'ML 2/26/2011 17:08'!
answer: anObject
	answer := anObject! !

!GLMMorphicSpotter methodsFor: 'callbacks' stamp: 'MirceaLungu 2/26/2011 18:10'!
selectionIn: singleSpotlight

	(self childrenMorphs reject: [:e| e = singleSpotlight] ) do: [:e| 
			e deselect.
		]! !

!GLMMorphicSpotter class methodsFor: 'instance creation' stamp: 'ML 2/26/2011 17:15'!
openOn: aRequest
	^ UITheme builder openModal: (self on: aRequest)! !

!GLMMorphicSpotter class methodsFor: 'instance creation' stamp: 'ML 2/26/2011 17:15'!
on: aRequest
	^ self basicNew initializeOn: aRequest! !

!GLMMorphicSpotterTest methodsFor: 'as yet unclassified' stamp: 'DamienCassou 12/3/2012 18:15'!
creation
	| composite classRequest methodRequest thirdRequest |
	composite  := GLMSpotterRequest new.

	classRequest := GLMSingleSpotterRequest new 
			prompt: 'Find Class';
			searchBlock: [ :string | Smalltalk allClassesAndTraits select: [:each | string, '*' match: each name] ];
			labelBlock: [ :class | class name ]";
			iconBlock: [ :class | class browserIcon ]".

	methodRequest := GLMSingleSpotterRequest new 
			prompt: 'Object Selectors';
			searchBlock: [ :string | Object selectors select: [:e| string, '*' match: e asString] ];
			labelBlock: [ :e | e ].

	thirdRequest := GLMSingleSpotterRequest new 
			prompt: 'Other Selectors';
			searchBlock: [ :string | Class selectors select: [:e| string, '*' match: e asString] ];
			labelBlock: [ :e | e ].
			
	(composite 
		add: classRequest;
		add: methodRequest;
		add: thirdRequest;
				signal) inspect.! !

!GLMMorphicStackerRenderer methodsFor: 'rendering' stamp: 'VincentBlondeau 2/16/2014 12:39'!
render: aBrowser
	| tabs |
	aBrowser panes isEmpty
		ifTrue: [ ^ GLMMorphic emptyMorph ].
	tabs := LazyTabGroupMorph new.
	tabs
		vResizing: #spaceFill;
		hResizing: #spaceFill;
		cornerStyle: (self theme tabGroupCornerStyleIn: nil);
		font: self theme labelFont.
	aBrowser panes
		do: [ :each | 
			self flag: 'add toolbar'.
			tabs
				addLazyPage: [ GLMMorphicPaneWithoutTitleRenderer new render: each ]
				label: (self titleOrIconOf: each presentations in: tabs)
				toolbar: (self renderToolbarForPresentation: each presentations inMorph: tabs) ].
	tabs selectedPageIndex: 1.
	aBrowser on: GLMBrowserClosed send: #actOnBrowserClosed: to: self.
	^ tabs! !

!GLMMorphicTabbedRenderer methodsFor: 'rendering' stamp: 'AliakseiSyrel 3/22/2015 11:48'!
actOnPresentationUpdated: ann
	| index presentations |
	presentations := ann presentation matchingPresentations.
	tabs pages size to: 1 by: -1 do: [ :i | tabs removePageIndex: i ].	
	presentations do: [ :each | 
		tabs 
			addLazyPage: [ self renderObject: each ]
			label: (self titleOrIconOf: each in: tabs)
			toolbar: (self renderToolbarForPresentation: each inMorph: tabs )
			action: (self labelActionBrickFor: each) ].
	index := 1.
	presentations withIndexDo: [ :each :i | 
		ann presentation pane lastActivePresentation notNil and: [ 
			each title = ann presentation pane lastActivePresentation title ifTrue: [ 
				index := i ] ] ].
	tabs selectedPageIndex: index.! !

!GLMMorphicTabbedRenderer methodsFor: 'rendering' stamp: 'AndreiChis 6/23/2014 15:37'!
actOnContextChanged: ann
	ann property = #activePresentation ifTrue: [ 
		tabs announcer suspendAllWhile: [ tabs selectedPageIndex: (ann presentation matchingPresentations indexOf: ann value) ] ]! !

!GLMMorphicTabbedRenderer methodsFor: 'rendering' stamp: 'AliakseiSyrel 3/22/2015 11:48'!
render: aPresentation
	| presentations index |
	presentations := aPresentation matchingPresentations.
	presentations isEmpty
		ifTrue: [ ^ GLMMorphic emptyMorph ].
	(presentations size = 1 and: [ presentations first hasTitle not ] )
		ifTrue: [ ^ self renderWithTitleOrNil: presentations first ].
	tabs := LazyTabGroupMorph new.
	tabs
		vResizing: #spaceFill;
		hResizing: #spaceFill;
		cornerStyle: (self theme tabGroupCornerStyleIn: nil);
		font: self theme buttonFont.
	tabs announcer
		when: LazyTabPageChanged
		do: [ :ann | aPresentation announcer suspendAllWhile: [ aPresentation  pane lastActivePresentation: (aPresentation matchingPresentations at: ann pageIndex) ]].
	presentations
		do: [ :each | 
			tabs
				addLazyPage: [ self renderObject: each ]
				label: (self titleOrIconOf: each in: tabs)
				toolbar: (self renderToolbarForPresentation: each inMorph: tabs)
				action: (self labelActionBrickFor: each) ].
	index := 1.
	presentations
		withIndexDo: [ :each :i | 
			(aPresentation pane isLastActivePresentation: each)
				ifTrue: [ index := i ] ].
	tabs announcer suspendAllWhile: [ tabs selectedPageIndex: index ].
	aPresentation on: GLMContextChanged send: #actOnContextChanged: to: self.
	aPresentation on: GLMPresentationUpdated send: #actOnPresentationUpdated: to: self.
	aPresentation on: GLMPresentationToolbarUpdated send: #actOnPresentationToolbarUpdated: to: self.
	^ tabs! !

!GLMMorphicTabbedRenderer methodsFor: 'rendering' stamp: 'AndreiChis 10/7/2014 14:06'!
actOnPresentationToolbarUpdated: ann
	| presentations |

	presentations := ann presentation matchingPresentations.
	tabs pages size to: 1 by: -1 do: [ :i | (tabs pages at: i) toolbar: GLMMorphic emptyMorph ].	
	presentations withIndexDo: [ :each :i | 
		tabs updatePageAtIndex: i
			withLabel: (self titleOrIconOf: each in: tabs)
			toolbar: (self renderToolbarForPresentation: each inMorph: tabs)
			action: (self labelActionMorphFor: each)]! !

!GLMMorphicTableRenderer methodsFor: 'private' stamp: 'AndreiChis 11/13/2014 17:34'!
newTreeMorph
	^ GLMPaginatedResizableMorphTreeMorph new.! !

!GLMMorphicTableRenderer methodsFor: 'rendering' stamp: 'AliakseiSyrel 10/7/2014 12:48'!
render: aPresentation
	| container |
	container := super render: aPresentation.
	"aPresentation shouldAllExpand ifTrue: [treeMorph expandAll ]."
	aPresentation shouldRootsExpand ifTrue: [treeMorph expandRoots . treeMorph makeLastColumnBounded ].
	"aPresentation shouldExpandToLevel ifTrue: [ treeMorph expandAllTo: aPresentation expandLevel ]."
	^ container! !

!GLMMorphicTabulatorRenderer methodsFor: 'private' stamp: 'AndreiChis 7/23/2014 17:45'!
renderCustomRow: aCell ofPane: aPane inUI: aMorph inBrowser: aBrowser 
	| pane totalSpans currentSpanPosition currentOffset |
	totalSpans := aCell children inject: 0 into: [ :sum :each | sum + each span ].
	currentSpanPosition := 0.
	currentOffset := 0.
	aCell children keysAndValuesDo: [ :index :each | 
		each hasId 
			ifTrue: [ pane := self renderObject: (aBrowser paneNamed: each id) ]
			ifFalse: [ 
				pane := GLMMorphic containerMorph.
				self 
					renderCustomColumn: each
					ofPane: aPane
					inUI: pane
					inBrowser: aBrowser.
				pane addPaneSplitters ].
		pane layoutFrame: (LayoutFrame new
				topFraction: 0 offset: 0;
				leftFraction: currentSpanPosition / totalSpans offset: currentOffset + self margin;
				bottomFraction: 1 offset: 0;
				rightFraction: (currentSpanPosition + each span) / totalSpans offset: currentOffset + each size - self margin;
				yourself).
		aMorph addMorphBack: pane.
		currentSpanPosition := currentSpanPosition + each span.
		currentOffset := currentOffset + each size ].
	(aCell children last size > 0) ifTrue: [
		(aMorph submorphs atLast: 2) layoutFrame rightOffset: (aMorph submorphs atLast: 2) layoutFrame rightOffset - currentOffset. 
		aMorph submorphs last layoutFrame leftOffset: aMorph submorphs last layoutFrame leftOffset - currentOffset. 
		aMorph submorphs last layoutFrame rightOffset: aMorph submorphs last layoutFrame rightOffset - currentOffset.].
	aMorph addPaneSplitters! !

!GLMMorphicTabulatorRenderer methodsFor: 'private' stamp: 'AndreiChis 7/23/2014 17:52'!
renderCustomColumn: aCell ofPane: aPane inUI: aMorph inBrowser: aBrowser
	| pane totalSpans currentSpanPosition currentOffset |
	totalSpans := aCell children inject: 0 into: [ :sum :each | sum + each span ].
	currentSpanPosition := 0.
	currentOffset := 0.
	aCell children
		keysAndValuesDo: [ :index :each | 
			each hasId
				ifTrue: [ pane := self renderObject: (aBrowser paneNamed: each id) ]
				ifFalse: [ 
					pane := GLMMorphic containerMorph.
					self
						renderCustomRow: each
						ofPane: aPane
						inUI: pane
						inBrowser: aBrowser.
					pane addPaneSplitters ].
			pane
				layoutFrame:
					(LayoutFrame new
						topFraction: currentSpanPosition / totalSpans offset: currentOffset + self margin;
						leftFraction: 0 offset: 0;
						bottomFraction: (currentSpanPosition + each span) / totalSpans offset: currentOffset + each size - self margin;
						rightFraction: 1 offset: 0;
						yourself).
			aMorph addMorphBack: pane.
			currentSpanPosition := currentSpanPosition + each span.
			currentOffset := currentOffset + each size ].
	aCell children last size > 0
		ifTrue: [ 
			(aMorph submorphs atLast: 2) layoutFrame
				bottomOffset: (aMorph submorphs atLast: 2) layoutFrame bottomOffset - currentOffset.
			aMorph submorphs last layoutFrame topOffset: aMorph submorphs last layoutFrame topOffset - currentOffset.
			aMorph submorphs last layoutFrame
				bottomOffset: aMorph submorphs last layoutFrame bottomOffset - currentOffset ].
	aMorph addPaneSplitters! !

!GLMMorphicTabulatorRenderer methodsFor: 'private' stamp: 'TudorGirba 5/20/2013 06:51'!
margin
	^ 5! !

!GLMMorphicTabulatorRenderer methodsFor: 'rendering' stamp: 'TudorGirba 4/12/2011 12:49'!
render: aBrowser
	| container |
	container := GLMMorphic containerMorph.
	aBrowser cell isRow 
		ifTrue: 
			[ self 
				renderCustomRow: aBrowser cell
				ofPane: aBrowser pane
				inUI: container
				inBrowser: aBrowser ]
		ifFalse: 
			[ self 
				renderCustomColumn: aBrowser cell
				ofPane: aBrowser pane
				inUI: container
				inBrowser: aBrowser ].
	aBrowser on: GLMBrowserClosed send: #actOnBrowserClosed: to: self.
	^ container! !

!GLMMorphicTest methodsFor: 'private' stamp: ''!
wait: maxWaitSeconds until: validateBlock evaluatesTo: expectedResult
	"Evaluate validateBlock until it returns expectedResult or 
maxWaitSeconds have passed,
	 pausing between evaluations.  Return the last result of validateBlock 
value"

	| startTime result |
	startTime := Time millisecondClockValue // 1000.
	[result := validateBlock value = expectedResult] whileFalse:
			[Time secondClock - startTime > maxWaitSeconds ifTrue: [^result].
			(Delay forMilliseconds: 50) wait].
	^ result
! !

!GLMMorphicTest methodsFor: 'private' stamp: ''!
findLast: aClass in: aMorph
	"Explores aMorph hierarchy of sub morphs to find the last morph whose class inherits from aClass"
	^ self findLastSatisfying: [:morph | morph isKindOf: aClass ] in: aMorph  ! !

!GLMMorphicTest methodsFor: 'private' stamp: ''!
send: treeMorph doubleClickWithShift: aBoolean onItem: treeNodeMorph
	| event |
	event:= MouseButtonEvent basicNew 
		setType: #mouseDown
		position: (treeNodeMorph bounds origin + (1@1))
		which: 4
		buttons: (aBoolean ifTrue: [8] ifFalse: [0])
		hand: (HandMorph new mouseFocus: treeNodeMorph; yourself)
		stamp: nil.
	treeMorph doubleClick: event! !

!GLMMorphicTest methodsFor: 'private' stamp: ''!
send: treeMorph mouseUpWithShift: aBoolean onItem: treeNodeMorph
	| mouseUp |
	mouseUp := MouseButtonEvent basicNew 
		setType: #mouseUp
		position: (treeNodeMorph bounds origin + (1@1))
		which: 4
		buttons: (aBoolean ifTrue: [8] ifFalse: [0])
		hand: (HandMorph new mouseFocus: treeNodeMorph; yourself)
		stamp: nil.
	treeMorph listManager mouseUp: mouseUp on: treeNodeMorph.! !

!GLMMorphicTest methodsFor: 'setup - tear down' stamp: ''!
tearDown
	window ifNotNil: [window delete]! !

!GLMMorphicTest methodsFor: 'private' stamp: ''!
send: treeMorph mouseDownWithShift: aBoolean onItem: treeNodeMorph
	| mouseUp |
	mouseUp := MouseButtonEvent basicNew 
		setType: #mouseDown
		position: (treeNodeMorph bounds origin + (1@1))
		which: 4
		buttons: (aBoolean ifTrue: [8] ifFalse: [0])
		hand: (HandMorph new mouseFocus: treeNodeMorph; yourself)
		stamp: nil.
	treeMorph mouseUp: mouseUp onMorph: treeNodeMorph.! !

!GLMMorphicTest methodsFor: 'private' stamp: ''!
findSatisfying: aBlock in: aMorph
	"Explores aMorph hierarchy of sub morphs to find a morph who satisfies aBlock"
	aMorph allMorphsDo: [:each | (aBlock value: each) ifTrue: [^ each]].
	self fail.! !

!GLMMorphicTest methodsFor: 'private' stamp: ''!
repeatAssert: aBlock equals: aResult

	self assert: (self wait: 0.5 until: aBlock evaluatesTo: aResult)! !

!GLMMorphicTest methodsFor: 'private' stamp: ''!
findWherePresentationIs: aPresentation in: aMorph
	"Explores aMorph hierarchy of sub morphs to find a morph whose model is exactly aModel"
	^ self findSatisfying: 
				[:morph | morph model notNil 
					and: [(morph model respondsTo: #glamourPresentation) 
					and: [morph model glamourPresentation == aPresentation]] ]
			in: aMorph  ! !

!GLMMorphicTest methodsFor: 'private' stamp: ''!
send: treeMorph mouseUpOnItem: treeNodeMorph
	^ self send: treeMorph mouseUpWithShift: false onItem: treeNodeMorph! !

!GLMMorphicTest methodsFor: 'private' stamp: ''!
find: aClass in: aMorph
	"Explores aMorph hierarchy of sub morphs to find a morph whose class inherits from aClass"
	^ self findSatisfying: [:morph | morph isKindOf: aClass ] in: aMorph  ! !

!GLMMorphicTest methodsFor: 'private' stamp: ''!
findLastSatisfying: aBlock in: aMorph
	"Explores aMorph hierarchy of sub morphs to find the last morph who satisfies aBlock"
	| lastMatch |
	lastMatch := nil. 
	aMorph allMorphsDo: [:each | (aBlock value: each) ifTrue: [lastMatch := each]].
	^ lastMatch ifNil: [self fail]! !

!GLMMorphicTextRenderer methodsFor: 'rendering' stamp: 'TudorGirba 6/3/2013 08:21'!
actOnPresentationUpdated: ann 
	textModel text: ann presentation formatedDisplayValue.
	textModel changed: #text! !

!GLMMorphicTextRenderer methodsFor: 'rendering' stamp: 'TudorGirba 9/20/2011 23:39'!
textModelFor: aPresentation
	^ GLMTextModel new
		text: aPresentation formatedDisplayValue;
		glamourPresentation: aPresentation! !

!GLMMorphicTextRenderer methodsFor: 'rendering' stamp: 'TudorGirba 2/10/2014 06:38'!
actOnContextChanged: ann 
	ann property = #selectionInterval
		ifTrue: [ 
			ann value notNil 
				ifTrue: [textMorph setSelection: ann value ]
				ifFalse: [textMorph setSelection: (1 to: 0)] ].
"	self flag: 'somehow this disturbs copy paste and cmd+shift+left selection'.
	ann property = #text
		ifTrue: [ 
			textMorph announcer suspendAll: {GLMTextChanged} while: [ 
					textModel changedText: ann value ] ]"! !

!GLMMorphicTextRenderer methodsFor: 'rendering' stamp: 'AndreiChis 5/7/2014 13:08'!
registerEventsForPresentation: aPresentation
	
	aPresentation on: GLMPresentationUpdated send: #actOnPresentationUpdated: to: self.
	aPresentation on: GLMContextChanged send: #actOnContextChanged: to: self.
	aPresentation on: GLMSelectCurrentLine send: #selectLine to: self.! !

!GLMMorphicTextRenderer methodsFor: 'rendering' stamp: 'BernardoContreras 12/7/2014 00:34'!
render: aPresentation
	textModel := self textModelFor: aPresentation.
	textMorph := self textMorphForModel: textModel.	"this is a horrible hack: 
	because we cannot get the update of when the text changes from the morph,
	we get the reference to the mutable text object :) :)"
	textModel text: textMorph text.
	textMorph setSelection: textModel selection. "Without setting the selection again 
	the smalltalkcode presentation shows no selection. Seems to be cause by the font: 
	message send when creating a GLMPluggableTextMorph"
	self installActionsOnModel: textModel fromPresentation: aPresentation .
	self installKeystrokeActionsOnMorph: textMorph textMorph fromPresentation: aPresentation.
	textMorph announcer
		when: GLMSelectedTextChanged
		do: [ :ann | 
			aPresentation announcer
				suspendAllWhile: [ 
					aPresentation selectionInterval: ann interval.
					aPresentation selectedText: ann selectedText ] ].
	textMorph announcer
		when: GLMTextChanged
		do: [ :ann | aPresentation suspendAllWhile: [ aPresentation text: ann text ] ].
	self registerEventsForPresentation: aPresentation.
	^ textMorph! !

!GLMMorphicTextRenderer methodsFor: 'rendering' stamp: 'AndreiChis 6/26/2014 15:13'!
textMorphForModel:  aTextModel
	^ (GLMPluggableTextMorph
		on: aTextModel
		text: #text
		accept: #accept:notifying:
		readSelection: #selection
		menu: #menu:shifted:)
		changedAction: [:aText|
			aText asString trimBoth ifNotEmpty:  [aTextModel text: aText] ];
		onKeyStrokeSend: #keystroke:from: to: aTextModel;
		layoutFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 1));
		vResizing: #spaceFill;
		hResizing: #spaceFill;
		color: Smalltalk ui theme backgroundColor;
		detachAllKeymapCategories;
		yourself! !

!GLMMorphicTextRenderer methodsFor: 'rendering' stamp: 'AndreiChis 2/27/2014 17:23'!
selectLine
	
	textMorph selectLine! !

!GLMMorphicTreeRenderer methodsFor: 'rendering' stamp: 'TudorGirba 2/9/2014 21:40'!
render: aPresentation
	| container |
	container := super render: aPresentation.
	aPresentation shouldAllExpand ifTrue: [treeMorph expandAll ].
	aPresentation shouldRootsExpand ifTrue: [treeMorph expandRoots ].
	aPresentation shouldExpandToLevel ifTrue: [ treeMorph expandAllTo: aPresentation expandLevel ].
	^ container! !

!GLMMorphicValidatorPaneRenderer methodsFor: 'rendering' stamp: 'cyrilledelaunay 4/8/2011 12:07'!
renderMorphFor: aPane

	paneMorph
		addMorph: 
			("self newColumnWith:  {" (self renderObject: aPane presentations)".  (self buttonRowFrom: self buttons) }") 
			fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 0.90));
		addMorph:  (self buttonRowFrom: self buttons)
			fullFrame: (LayoutFrame fractions: (0 @ 0.93 corner: 1 @ 1));
		adoptPaneColor: paneMorph paneColor! !

!GLMMorphicValidatorPaneRenderer methodsFor: 'rendering' stamp: 'cyrilledelaunay 3/23/2011 14:06'!
actOnMatchingPresentationsChanged: anAnnouncement 
	paneMorph	removeAllMorphs.
	self renderMorphFor: anAnnouncement pane.
	self renderer window fullBounds! !

!GLMMorphicValidatorPaneRenderer methodsFor: 'accessing' stamp: 'cyrilledelaunay 3/23/2011 14:12'!
buttons: aCollectionOfButtons

	buttons := aCollectionOfButtons! !

!GLMMorphicValidatorPaneRenderer methodsFor: 'rendering' stamp: 'cyrilledelaunay 3/23/2011 14:14'!
render: aPane

	paneMorph := GLMMorphic containerMorph.
	aPane
		on: GLMMatchingPresentationsChanged
		send: #actOnMatchingPresentationsChanged:
		to: self.
	self renderMorphFor: aPane.
	^ paneMorph! !

!GLMMorphicValidatorPaneRenderer methodsFor: 'rendering' stamp: 'cyrilledelaunay 3/31/2011 17:13'!
renderCompositiePresentation: aCompositePresentation
	
	paneMorph := GLMMorphic containerMorph.
	paneMorph
		addMorph: 
			(self newColumnWith:  { (self renderObject: aCompositePresentation).  (self buttonRowFrom: self buttons) }) 
			fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 1));
		"addMorphBack: (self buttonRowFrom: self buttons)  ;  "
		adoptPaneColor: paneMorph paneColor.
	
	^ paneMorph! !

!GLMMorphicValidatorPaneRenderer methodsFor: 'rendering' stamp: 'cyrilledelaunay 3/23/2011 16:39'!
newColumnWith: aCollectionOfMorphElements
	"use this method to create a new column in your block"
	<lint: 'Utility methods' rationale: 'defined here to facilate the use of the library' author: 'cyrille.delaunay'>
	
	|answer|
	answer := PanelMorph new
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		fillStyle: Color transparent; "non pane color tracking"
		changeTableLayout;
		cellInset: 8; yourself.
	aCollectionOfMorphElements do: [:m | answer addMorphBack: m].
	^answer! !

!GLMMorphicValidatorPaneRenderer methodsFor: 'accessing' stamp: 'cyrilledelaunay 3/23/2011 14:11'!
buttons

	^ buttons! !

!GLMMorphicValidatorPaneRenderer methodsFor: 'rendering' stamp: 'AndreiChis 10/9/2014 17:27'!
buttonRowFrom: aCollectionOfButtons
	"Answer a new ok/cancel button row."

	|answer curentButtons e|
	curentButtons := aCollectionOfButtons.
	e := 0@0.
	curentButtons do: [:b | e := e max: b minExtent].
	curentButtons do: [:b | b extent: e].
	answer := Morph new
		color: Color transparent;
		changeTableLayout;
		cellInset: 8;
		listDirection: #leftToRight;
		listCentering: #bottomRight;
		hResizing: #spaceFill;
		vResizing: #shrinkWrap.
	curentButtons do: [:b | answer addMorphBack: b].
	^answer

	! !

!GLMMorphicValidatorRenderer methodsFor: 'rendering' stamp: 'cyrilledelaunay 5/5/2011 12:10'!
render: aBrowser

	|tmpButtons|
	tmpButtons := OrderedCollection new.
	aBrowser panes isEmpty ifTrue: [ 
		"|tmpPane|
		tmpPane := (GLMPane in: aBrowser) 
				addPresentation: aBrowser presentations; 
				yourself.	
		(tmpPane port: #entity) value: aBrowser entity.	
		aBrowser panes add: tmpPane"
			].
	aBrowser buttonActions do: [:aGLMAction |
		|buttonModel|
		buttonModel := GLMButtonModel new.
		buttonModel glamourPresentation: aBrowser.
		buttonModel glamourAction: aGLMAction.
		tmpButtons add: (PluggableButtonMorph 
			on: buttonModel
			getState: nil
			action: #execute
			label: #buttonLabel)
		].
	aBrowser on: GLMBrowserClosed send: #actOnBrowserClosed: to: self.
	container := (GLMMorphicValidatorPaneRenderer new buttons: tmpButtons; render: aBrowser panes anyOne).
	^ container
	! !

!GLMMorphicValidatorRenderer methodsFor: 'rendering' stamp: 'cyrilledelaunay 3/23/2011 13:25'!
render: aBrowser from: aGLMRenderer

	self renderer: aGLMRenderer.
	^ self render: aBrowser
	! !

!GLMMorphicVariablePanesFinderRenderer methodsFor: 'rendering' stamp: 'TudorGirba 2/15/2011 18:11'!
addMorphFromObject: anObject toContainer: aContainerMorph
	| renderedMorph |
	renderedMorph := (self renderObject: anObject)
				vResizing: #spaceFill;
				hResizing: #rigid;
				minimumExtent: 200@10;
				extent: 200@10;
				yourself.
	aContainerMorph addMorphBack: renderedMorph.
	aContainerMorph addMorphBack: (EdgeGripMorph new
		width: ProportionalSplitterMorph splitterWidth;
		hResizing: #rigid; "not the default this time, vResizing is also #spaceFill by default"
		target: renderedMorph)! !

!GLMMorphicVariablePanesFinderRenderer methodsFor: 'rendering' stamp: 'TudorGirba 2/15/2011 18:13'!
actOnPaneReplaced: ann
	container removeMorph: container submorphs last.
	container removeMorph: container submorphs last.
	self addMorphFromObject: ann newPane toContainer: container.
	scrollPane hScrollbar glmAnimateValue: 1.0 duration: 200! !

!GLMMorphicVariablePanesFinderRenderer methodsFor: 'rendering' stamp: 'TudorGirba 2/15/2011 18:12'!
actOnPaneAdded: ann
	self addMorphFromObject: ann pane toContainer: container.
	scrollPane hScrollbar glmAnimateValue: 1.0 duration: 2000! !

!GLMMorphicVariablePanesFinderRenderer methodsFor: 'rendering' stamp: 'TudorGirba 2/15/2011 18:12'!
actOnPaneRemoved: ann
	container removeMorph: container submorphs last.
	container removeMorph: container submorphs last! !

!GLMMorphicVariablePanesFinderRenderer methodsFor: 'rendering' stamp: 'TudorGirba 2/15/2011 18:13'!
render: aBrowser
	container := GLMMorphic containerMorph.
	container 
		changeTableLayout;
		listDirection: #leftToRight;
		vResizing: #spaceFill;
		hResizing: #shrinkWrap.
	scrollPane := GeneralScrollPane new
		changeScrollerTableLayout;
		scrollTarget: container;
		yourself.
	self registerAnnouncementsFor: aBrowser.  
	aBrowser panes do: [ :each | self addMorphFromObject: each toContainer: container ].
	^ scrollPane! !

!GLMMorphicVerticallyStackedRenderer methodsFor: 'rendering' stamp: 'TudorGirba 1/20/2011 21:55'!
render: aPresentation
	| presentations container |
	presentations := aPresentation matchingPresentations.
	presentations isEmpty ifTrue: [ ^ GLMMorphic emptyMorph ].	
	container := GLMMorphic containerMorph.
	container changeTableLayout.
	presentations do: [ :each | 
		container addMorphBack: (self renderWithTitle: each) ].
	^ container! !

!GLMMorphicWatcherRenderer commentStamp: '<historical>'!
This is a special widget renderer in that it will get to render multiple panes on the same container morph provided by a unique instance of the GLMWatcherWindow.!
!GLMMorphicWatcherRenderer methodsFor: 'rendering' stamp: 'TudorGirba 5/27/2012 01:47'!
render: aPane
	"we just register for the announcement"
	
	aPane
		on: GLMMatchingPresentationsChanged
		send: #actOnMatchingPresentationsChanged:
		to: self
	! !

!GLMMorphicWatcherRenderer methodsFor: 'rendering' stamp: 'TudorGirba 5/28/2012 14:41'!
actOnMatchingPresentationsChanged: anAnnouncement
	"whenever a relevant pane changes its presentations,
	we override the contents from the GLMWatcherWindow"
	
	GLMWatcherWindow uniqueInstance 
		addContent: [ self renderObject: anAnnouncement pane presentations ]! !

!GLMMorphicWidgetRenderer commentStamp: '<historical>'!
This is a helper class that is supposed to be subclassed for each rendering logic of a specific morph. For example, there will be a TreeRenderer, a TextRenderer etc!
!GLMMorphicWidgetRenderer methodsFor: 'private' stamp: 'TudorGirba 3/24/2013 21:58'!
installActionsOnModel: aMorphicModel fromPresentation: aPresentation 
	aMorphicModel when: GLMMenuItemSelected do: [ :ann | ann action morphicActOn: aPresentation ].
	aMorphicModel when: GLMKeyStroke do: [ :ann | ann action actOn: aPresentation ].! !

!GLMMorphicWidgetRenderer methodsFor: 'private' stamp: 'TudorGirba 11/28/2012 22:23'!
menuIn: aMenuMorph for: aPresentation
	| subMenus targetMenuMorph subMenu |
	subMenus := Dictionary new.
	(aPresentation allActions select: [:each | each isMenu ]) do: [ :action |
		targetMenuMorph := action category notNil 
			ifTrue: [ subMenus at: action category ifAbsentPut: [ 
					subMenu :=  MenuMorph new.
					aMenuMorph add: action category subMenu: subMenu.
					subMenu ] ]
			ifFalse: [ aMenuMorph ].
		(targetMenuMorph 
			add: action title
			target: action 
			selector: #morphicActOn:
			argument: aPresentation)
			icon:  action icon;
			keyText: (action hasShortcut 
				ifTrue: [ action shortcutAsString ]
				ifFalse: [ nil ]) ].
	^ aMenuMorph! !

!GLMMorphicWidgetRenderer methodsFor: 'private' stamp: 'AliakseiSyrel 3/22/2015 18:13'!
titleOrIconOf: aPresentation in: container
	^ aPresentation hasTitleIcon 
		ifTrue: [
			| image |
			image := GLMInteractableBrick new
						normalImage: aPresentation titleIconValue.
			image maxWidth: [ aPresentation titleIconValue width * 2 ].
			image hSpaceFill.
			image vSpaceFill.
			aPresentation titleValue ifNotNil: [
				image setBalloonText: aPresentation titleValue maxLineLength: 100 ].
			image  ]
		ifFalse: [ aPresentation titleValue ifNil: [''] ]! !

!GLMMorphicWidgetRenderer methodsFor: 'rendering' stamp: 'TudorGirba 7/1/2014 10:44'!
installKeystrokeActionsOnMorph: aMorph fromPresentation: aPresentation
	aPresentation allActionsWithShortcuts do: [ :each |
		each installKeyCombinationForPresentation: aPresentation onMorph: aMorph ]! !

!GLMMorphicWidgetRenderer methodsFor: 'private' stamp: 'AliakseiSyrel 3/22/2015 11:48'!
morph: aMorph withTitleOf: aPresentation	
	| tabs |
	tabs := LazyTabGroupMorph new.
	tabs
		vResizing: #spaceFill;
		hResizing: #spaceFill;
		cornerStyle: (self theme tabGroupCornerStyleIn: nil);
		font: self theme labelFont.
	self flag: 'add a regular page instead of a lazy one'.
	self flag: 'handle the PresentationChanged announcement to update the label in the morph. 
	The problem is that at the moment I do not know how to link to the label in the tabSelectorMorph'.
	tabs 
		addLazyPage: [aMorph]
		label: (self titleOrIconOf: aPresentation in: tabs)
		toolbar: (self renderToolbarForPresentation: aPresentation inMorph: aMorph)
		action: (self labelActionBrickFor: aPresentation).
	tabs selectedPageIndex: 1.
	^ tabs! !

!GLMMorphicWidgetRenderer methodsFor: 'accessing' stamp: 'TudorGirba 1/5/2011 23:42'!
renderer
	^ renderer ifNil: [renderer := GLMMorphicRenderer new]! !

!GLMMorphicWidgetRenderer methodsFor: 'private' stamp: 'TudorGirba 1/31/2011 02:20'!
renderWithToolbar: aPresentation
	| presentationMorph |
	presentationMorph := self renderObject: aPresentation.
	^ self morph: presentationMorph withToolbarOf: aPresentation! !

!GLMMorphicWidgetRenderer methodsFor: 'private' stamp: 'tg 8/22/2010 23:52'!
moreToolbarActions: noIconActions on: aBrowser
	| menuMorph |
	menuMorph := MenuMorph new.
	noIconActions do: [ :each | 
		menuMorph 
				add: each title
				target: each
				selector: #actOn:
				argument: aBrowser ].
	^ menuMorph! !

!GLMMorphicWidgetRenderer methodsFor: 'private' stamp: 'TudorGirba 1/31/2011 02:21'!
morph: aMorph withToolbarOf: aPresentation
	| container offset dock |
	aPresentation hasActions ifFalse: [ ^ aMorph ].
	container := GLMMorphic containerMorph.
	offset := 0.
	dock := self renderToolbarForPresentation: aPresentation inMorph: container.
	offset := dock minExtent y.
	container addMorph: dock fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 0) offsets: (0 @ 0 corner: 0 @ offset)).	
	container 
		addMorph: aMorph 
		fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 1) offsets: (0 @ offset corner: 0 @ 0)).
	^ container! !

!GLMMorphicWidgetRenderer methodsFor: 'private' stamp: 'TudorGirba 1/5/2011 23:47'!
renderObject: anObject
	^ self renderer render: anObject ! !

!GLMMorphicWidgetRenderer methodsFor: 'private' stamp: 'TudorGirba 10/12/2014 10:52'!
labelActionMorphFor: aPresentation
	
	 ^ aPresentation titleAction 
		ifNil: [ nil ]
		ifNotNil: [ :labelAction |
			((labelAction isAvailableOn: aPresentation) and: [ labelAction hasIcon ])
				ifTrue: [ 
					MultistateButtonMorph new
						extent: labelAction icon extent;
						activeEnabledOverUpFillStyle: (ImageFillStyle form: labelAction icon);
						setBalloonText: labelAction title;
						addUpAction: [ labelAction actOn: aPresentation ] ]
				ifFalse: [ nil ] ]
	! !

!GLMMorphicWidgetRenderer methodsFor: 'factory' stamp: 'tg 8/23/2010 00:02'!
theme
	^ UITheme current! !

!GLMMorphicWidgetRenderer methodsFor: 'private' stamp: 'AndreiChis 3/25/2015 13:19'!
toolbarButtonsForPresentation: aPresentation

	^ (aPresentation allActions select: [:each | each isButton ]) 
		collect: [:each | |actionMorph|
			actionMorph := (each renderGlamorouslyOn: self renderer).
			actionMorph arguments 
				ifNil: [ actionMorph arguments: { aPresentation } ]
				ifNotNil: [ actionMorph arguments: ({ aPresentation }, actionMorph arguments) ].
			actionMorph ].
	! !

!GLMMorphicWidgetRenderer methodsFor: 'private' stamp: 'TudorGirba 1/31/2011 02:19'!
morph: aMorph withTitleOrNilOf: aPresentation
	(aPresentation hasTitle or: [aPresentation hasTitleIcon]) ifFalse: [
		"we render at least the toolbar"
		^ self morph: aMorph withToolbarOf: aPresentation ].
	^ self morph: aMorph withTitleOf: aPresentation! !

!GLMMorphicWidgetRenderer methodsFor: 'rendering' stamp: 'tg 8/22/2010 20:17'!
render: aPresentation
	^ self subclassResponsibility ! !

!GLMMorphicWidgetRenderer methodsFor: 'private' stamp: 'AliakseiSyrel 3/22/2015 11:52'!
labelActionBrickFor: aPresentation
	
	 ^ aPresentation titleAction 
		ifNil: [ nil ]
		ifNotNil: [ :labelAction |
			((labelAction isAvailableOn: aPresentation) and: [ labelAction hasIcon ])
				ifTrue: [
					GLMActionButtonBrick new
						icon: labelAction icon;
						setBalloonText: labelAction title;
						action: [ labelAction actOn: aPresentation ] ]
				ifFalse: [ nil ] ]
	! !

!GLMMorphicWidgetRenderer methodsFor: 'private' stamp: 'TudorGirba 1/28/2011 19:20'!
renderWithTitle: aPresentation
	| morph |
	morph := self renderObject: aPresentation.
	^ self morph: morph withTitleOf: aPresentation! !

!GLMMorphicWidgetRenderer methodsFor: 'private' stamp: 'TudorGirba 4/14/2011 23:59'!
titleOrIconOrNilOf: aPresentation in: container
	^ aPresentation hasTitleIcon 
		ifTrue: [
			| image |
			image := self theme 
					newImageIn: container
					form: aPresentation titleIconValue.
			aPresentation titleValue isNil ifFalse: [
				image setBalloonText: aPresentation titleValue maxLineLength: 10 ]  ]
		ifFalse: [ 
			aPresentation hasTitle 
				ifTrue: [ aPresentation titleValue ]
				ifFalse: [ nil ] ]! !

!GLMMorphicWidgetRenderer methodsFor: 'private' stamp: 'AndreiChis 3/25/2015 13:50'!
dropDownMenuFrom: aBlock withIcon: anIcon
	| activeForm passiveForm menuButton | 
	
	activeForm := anIcon.
	passiveForm := anIcon.
	menuButton := MultistateButtonMorph new extent: activeForm extent.
	^ menuButton
		extent: activeForm extent;
				activeEnabledOverUpFillStyle: (ImageFillStyle form: activeForm);
				passiveEnabledOverUpFillStyle: (ImageFillStyle form: activeForm);
				activeEnabledOverDownFillStyle: (ImageFillStyle form: passiveForm);
		passiveEnabledOverDownFillStyle: (ImageFillStyle form: passiveForm);
		addUpAction: aBlock;
		setBalloonText: 'Menu' translated;
		yourself

! !

!GLMMorphicWidgetRenderer methodsFor: 'private' stamp: 'TudorGirba 1/31/2011 02:19'!
renderWithTitleOrNil: aPresentation
	| morph |
	morph := self renderObject: aPresentation.
	^ self morph: morph withTitleOrNilOf: aPresentation! !

!GLMMorphicWidgetRenderer methodsFor: 'private' stamp: 'AndreiChis 3/25/2015 13:51'!
renderToolbarForPresentation: aPresentation inMorph: aMorph
	| dock buttons |
	dock := aMorph theme newToolDockingBarIn: aMorph.
	buttons := self toolbarButtonsForPresentation: aPresentation.
	dock addAllMorphs: buttons.
	(aPresentation allActions select: #isMenu) ifNotEmpty: [
			dock addMorphBack: (self 
				dropDownMenuFrom: [ | menu |
					menu := self menuIn: MenuMorph new for: aPresentation.
					menu popUpEvent: self currentEvent in: aMorph world ]
				withIcon: GLMUIThemeExtraIcons glamorousMore)].
	^ dock! !

!GLMMorphicWidgetRenderer methodsFor: 'accessing' stamp: 'tg 8/22/2010 20:20'!
renderer: anObject
	renderer := anObject! !

!GLMMorphicWidgetRenderer class methodsFor: 'instance creation' stamp: 'tg 8/22/2010 20:20'!
render: aPresentation from: aRenderer
	^ self new 
		renderer: aRenderer;
		render: aPresentation! !

!GLMMorphicWindowRenderer commentStamp: '<historical>'!
This renders the top most browser or composite presentation in a window.!
!GLMMorphicWindowRenderer methodsFor: 'rendering' stamp: 'TudorGirba 2/15/2011 11:23'!
actOnPresentationUpdated: ann
		self setLabelOf: window for: ann presentation! !

!GLMMorphicWindowRenderer methodsFor: 'rendering' stamp: 'tg 8/24/2010 22:04'!
titleFor: aRenderable
	^ aRenderable titleValue ifNil: [ 'Glamorous Browser' ]! !

!GLMMorphicWindowRenderer methodsFor: 'rendering' stamp: 'TudorGirba 3/3/2013 21:52'!
handlePotentialStatusbarFor: aRenderable
	| statusbarMorph bottomOffset |
	bottomOffset := 0.
	aRenderable hasStatusbar
		ifTrue: [ 
			statusbarMorph := GLMMorphicPaneWithoutTitleRenderer render: aRenderable statusbarPane from: self renderer.
			bottomOffset := (0 - (LabelMorph contents: 'XXX') minHeight) * 1.2.
			window
				addMorph: statusbarMorph
				fullFrame: (LayoutFrame fractions: (0 @ 1 corner: 1 @ 1) offsets: (2 @ bottomOffset corner: -2 @ 0)) ].
	^ bottomOffset! !

!GLMMorphicWindowRenderer methodsFor: 'rendering' stamp: 'AndreiChis 10/9/2014 17:41'!
setLabelOf: aWindow for: aRenderable
	aWindow setLabel: (self titleFor: aRenderable).! !

!GLMMorphicWindowRenderer methodsFor: 'rendering' stamp: 'TudorGirba 5/19/2013 21:08'!
render: aRenderable
	| dock offset bottomOffset |
	window := GLMSystemWindow new model: aRenderable.
	self installActionsOnModel: window fromPresentation: aRenderable .
	self installKeystrokeActionsOnMorph: window fromPresentation: aRenderable.

	self setLabelOf: window for: aRenderable.
	offset := 4.
	bottomOffset := 0.
	dock := self renderToolbarForPresentation: aRenderable inMorph: window.
	dock hResizing: #shrinkWrap.
	window toolbarBox: dock.
	bottomOffset := self handlePotentialStatusbarFor: aRenderable.
	window
		addMorph: (self renderObject: aRenderable)
		fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 1) offsets: (0 @ offset corner: 0 @ bottomOffset)).
	self setPotentialBackgroundColorFor: aRenderable.
	aRenderable on: GLMPresentationUpdated send: #actOnPresentationUpdated: to: self.
	aRenderable watcherPane notNil
		ifTrue: [ GLMMorphicWatcherRenderer render: aRenderable watcherPane from: self renderer ].
	^ window! !

!GLMMorphicWindowRenderer methodsFor: 'rendering' stamp: 'AndreiChis 3/25/2015 14:04'!
renderToolbarForPresentation: aPresentation inMorph: aMorph
	| dock buttons |
	dock := aMorph theme newToolDockingBarIn: aMorph.
	buttons := self toolbarButtonsForPresentation: aPresentation.
	dock addAllMorphs: buttons.
	dock addMorphBack: (self 
		dropDownMenuFrom: [ | menu defaultMenu |
				defaultMenu := aMorph buildWindowMenu.
				(aPresentation allActions select: #isMenu) ifNotEmpty: [ 
					defaultMenu addLine ].
				menu := self menuIn: defaultMenu for: aPresentation.
				menu popUpEvent: self currentEvent in: aMorph world ]
		withIcon: aMorph theme windowMenuForm).
	^ dock! !

!GLMMorphicWindowRenderer methodsFor: 'rendering' stamp: 'TudorGirba 2/11/2014 06:39'!
setPotentialBackgroundColorFor: aRenderable
	aRenderable colorValue ifNotNil: [ window borderColor: aRenderable colorValue ]! !

!GLMMorphicWizardRenderer methodsFor: 'rendering' stamp: 'cyrilledelaunay 3/31/2011 16:33'!
actOnPaneReplaced: ann

	container removeMorph: container submorphs last.
	self addMorphFromObject: ann newPane toContainer: container.
	"scrollPane hScrollbar glmAnimateValue: 1.0 duration: 200"! !

!GLMMorphicWizardRenderer methodsFor: 'rendering' stamp: 'cyrilledelaunay 4/4/2011 16:43'!
render: aBrowser
	container := GLMMorphic containerMorph.
	container
		changeTableLayout;
		listDirection: #leftToRight;
		vResizing: #spaceFill;
		hResizing: #spaceFill.
	scrollPane := GeneralScrollPane new
		changeScrollerTableLayout;
		scrollTarget: container;
		yourself.
	self registerAnnouncementsFor: aBrowser.  
	self addMorphFromObject: (aBrowser stepsAndPanes at: aBrowser currentStep) last toContainer: container .
	^ scrollPane! !

!GLMMorphicWizardRenderer methodsFor: 'rendering' stamp: 'cyrilledelaunay 3/31/2011 17:25'!
addMorphFromObject: anObject toContainer: aContainerMorph

	| renderedMorph |
	renderedMorph := (self renderObject: anObject).
				"vResizing: #spaceFill;
				hResizing: #rigid;
				minimumExtent: 200@10;
				extent: 200@10;
				yourself."
	aContainerMorph addMorphBack: renderedMorph.! !

!GLMMorphicWizardRenderer methodsFor: 'accessing' stamp: 'cyrilledelaunay 4/1/2011 14:16'!
parentRenderer

	^ parentRenderer! !

!GLMMorphicWizardRenderer methodsFor: 'accessing' stamp: 'cyrilledelaunay 4/1/2011 14:17'!
parentRenderer: aGLMMorphicRenderer

	parentRenderer := aGLMMorphicRenderer! !

!GLMMorphicWizardRenderer methodsFor: 'rendering' stamp: 'cyrilledelaunay 4/4/2011 14:52'!
actOnPaneAdded: ann
	container removeMorph: container submorphs last.
	self addMorphFromObject: ann pane toContainer: container.! !

!GLMMorphicWizardRenderer methodsFor: 'rendering' stamp: 'cyrilledelaunay 4/4/2011 15:53'!
actOnPaneRemoved: ann! !

!GLMMorphicWizardRenderer methodsFor: 'rendering' stamp: 'TudorGirba 4/12/2011 12:50'!
registerAnnouncementsFor: aBrowser
	aBrowser 
		on: GLMPaneRemoved send: #actOnPaneRemoved: to: self.
	aBrowser 
		on: GLMPaneAdded send: #actOnPaneAdded: to: self.
	aBrowser 
		on: GLMPaneReplaced send: #actOnPaneReplaced: to: self.
	aBrowser 
		on: GLMBrowserClosed send: #actOnBrowserClosed: to: self.! !

!GLMMorphicWrapperRenderer methodsFor: 'rendering' stamp: 'TudorGirba 5/18/2012 22:38'!
render: aBrowser
	| paneMorph |
	container := GLMMorphic containerMorph.
	
	paneMorph := self renderObject: aBrowser defaultPane.
	paneMorph layoutFrame: (LayoutFrame fractions: (0@0 corner: 1@1)).
	container addMorphBack: paneMorph.	
	
	aBrowser on: GLMBrowserClosed send: #actOnBrowserClosed: to: self.
	^ container ! !

!GLMMultiValue commentStamp: 'tg 12/19/2009 00:16'!
GLMMultiValue is helper class that is used in #glamourValue:.!
!GLMMultiValue methodsFor: 'testing' stamp: ' 4/5/09 22:18'!
asGlamorousArray 
	 
	^self asArray! !

!GLMMultiValue methodsFor: 'testing' stamp: 'tg 9/9/2009 01:02'!
asGlamorousMultiValue
	^ self! !

!GLMMultipleUpdateAction commentStamp: 'TudorGirba 1/7/2011 07:31'!
This class simply specifies that the updating announcement could come from any of the objects in the announcer objects collection.!
!GLMMultipleUpdateAction methodsFor: 'public' stamp: 'tg 5/3/2010 01:18'!
computeAnnouncerObjects 
	^ self transformation glamourValue: self presentation entity! !

!GLMNestedBrowserTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testInnerTransmissions
	"This tests that the nested transmissions have the destination correctly set 
	to be in the pane from the outer browser."

	| browser1 browser2 presentation innerBrowser |
	browser1 := GLMExplicitBrowser new.
	browser2 := GLMExplicitBrowser new.
	presentation := GLMPresentation new.
	browser1 addNewPane name: 'pane1'.
	browser2 addNewPane name: 'innerpane 1'.	"Jumpstart presentation for outer browser."
	browser1
		addTransmission:
			((GLMTransmission new)
				ensureReplacePresentationsStrategy;
				addActiveOrigin:
						((GLMPresentationBoundPort new)
								presentation: browser1;
								name: #entity;
								yourself);
				destination: (browser1 panes first port: #entity);
				addPresentation: browser2;
				yourself).	"Jumpstart presentation for inner browser."
	browser2
		addTransmission:
			((GLMTransmission new)
				ensureReplacePresentationsStrategy;
				addActiveOrigin:
						((GLMPresentationBoundPort new)
								presentation: browser2;
								name: #entity;
								yourself);
				destination: (browser2 panes first port: #entity);
				addPresentation: presentation;
				yourself).
	(browser1 pane port: #entity) value: 42.
	innerBrowser := browser1 panes first presentations first.
	self assert: innerBrowser transmissions size equals: 1.
	self assert: (innerBrowser transmissions first origins first isKindOf: GLMPresentationBoundPort).
	self assert: innerBrowser transmissions first origins first pane == browser1 panes first! !

!GLMNestedBrowserTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testChangeInnerSelection
	"Tests setting the selection of an inner pane from the oustide. 
 
	The test sets up a browser with two panes. The first contains a 
	list of numbers, the second a browser which again contains one 
	pane with a list of the same numbers. When the selection in the 
	first pane changes, we want the same number to be selected in 
	the second pane. 
 
	To achieve this, we pull in a port on the second pane and copy 
	it to the inner pane using a simple transmission."

	| browser1 browser2 list1 list2 |
	browser1 := GLMExplicitBrowser new.
	browser2 := GLMExplicitBrowser new.
	list1 := GLMListPresentation new.
	list2 := GLMListPresentation new.
	browser1 addNewPane.
	browser1 addNewPane.
	browser2 addNewPane.
	browser1 panes first addPresentation: list1.
	browser1 panes last addPresentation: browser2.
	browser2 panes first addPresentation: list2.
	browser1
		addTransmission:
			((GLMTransmission new)
				addActiveOrigin: (browser1 panes first port: #selection);
				destination: (browser1 panes last port: #innerSelection);
				yourself).
	browser2
		addTransmission:
			((GLMTransmission new)
				addActiveOrigin:
						((GLMPresentationBoundPort new)
								presentation: browser2;
								name: #innerSelection;
								yourself);
				destination: (browser2 panes first port: #selection);
				yourself).
	list1 entity: #(1 2 3).
	list2 entity: #(1 2 3).
	list1 selection: 1.
	self assert: list2 selection equals: 1.
	list1 selection: 2.
	self assert: list2 selection equals: 2! !

!GLMNestedBrowserTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testNestedBrowsersWithMultipleOrigins
	| browser innerBrowser transmittedOne transmittedTwo |
	innerBrowser := GLMTabulator new.
	innerBrowser row: #inner.
	(innerBrowser transmit)
		to: #inner;
		andShow: [ :a | a text ].
	browser := GLMTabulator new.
	browser
		column: #one;
		column: #two;
		column: #three.
	(browser transmit)
		to: #three;
		from: #one;
		from: #two;
		andShow: [ :a | 
					a
						custom:
							(innerBrowser
								display: [ :one :two | 
									transmittedOne := one.
									transmittedTwo := two ]) ].
	browser startOn: 1.
	((browser paneNamed: #one) port: #selection) value: 1.
	((browser paneNamed: #two) port: #selection) value: 2.
	self assert: transmittedOne equals: 1.
	self assert: transmittedTwo equals: 2! !

!GLMNestedBrowserTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testCondition
	"This tests that the nested browser is controlled by the condition"

	| browser1 browser2 transmission1 |
	browser1 := GLMExplicitBrowser new.
	browser2 := GLMExplicitBrowser new.
	browser1 title: 'browser1'.
	browser2 title: 'browser2'.
	browser2
		transformation: [ :x | 
					x = 42
						ifFalse: [ 
							self fail.
							42 ]
						ifTrue: [ 84 ] ];
		condition: [ :x | x = 42 ].
	browser1 addNewPane name: 'pane1'.
	transmission1 := GLMTransmission new ensureReplacePresentationsStrategy.
	transmission1 transmissionStrategy addPresentation: browser2.
	browser1
		addTransmission:
			(transmission1
				addActiveOrigin:
						((GLMPresentationBoundPort new)
								presentation: browser1;
								name: #entity;
								yourself);
				destination: (browser1 panes first port: #entity);
				yourself).
	self assert: (browser1 pane port: #entity) value isNil.
	self assert: (browser1 panes first port: #entity) value isNil.
	self assert: browser1 panes first presentations isEmpty.
	(browser1 pane port: #entity) value: 41.
	self assert: (browser1 pane port: #entity) value equals: 41.
	self assert: (browser1 panes first port: #entity) value equals: 41.
	self assert: browser1 panes first presentations size equals: 1.
	self assert: browser1 panes first matchingPresentations size equals: 0.
	(browser1 pane port: #entity) value: 42.
	self assert: (browser1 pane port: #entity) value equals: 42.	"	self assert: (browser1 panes first port: #entity) presentations value = 84.
"
	self assert: browser1 panes first presentations size equals: 1.
	self assert: browser1 panes first matchingPresentations size equals: 1! !

!GLMNestedBrowserTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testEntityPropogation
	"This tests that the nested transmissions have the destination correctly set 
	to be in the pane from the outer browser."

	| browser1 browser2 presentation innerBrowser transmission1 transmission2 |
	browser1 := GLMExplicitBrowser new.
	browser2 := GLMExplicitBrowser new.
	presentation := GLMPresentation new.
	browser1 title: 'browser1'.
	browser2 title: 'browser2'.
	browser1 addNewPane name: 'pane1'.
	browser2 addNewPane name: 'innerpane 1'.	"Jumpstart presentation for outer browser."
	transmission1 := GLMTransmission new ensureReplacePresentationsStrategy.
	transmission1 transmissionStrategy addPresentation: browser2.
	browser1
		addTransmission:
			(transmission1
				addActiveOrigin:
						((GLMPresentationBoundPort new)
								presentation: browser1;
								name: #entity;
								yourself);
				destination: (browser1 panes first port: #entity);
				yourself).	"Jumpstart presentation for inner browser."
	transmission2 := GLMTransmission new ensureReplacePresentationsStrategy.
	transmission2 transmissionStrategy addPresentation: presentation.
	browser2
		addTransmission:
			(transmission2
				addActiveOrigin:
						((GLMPresentationBoundPort new)
								presentation: browser2;
								name: #entity;
								yourself);
				destination: (browser2 panes first port: #entity);
				yourself).
	self assert: (browser1 pane port: #entity) value isNil.
	self assert: browser1 panes size equals: 1.
	self assert: (browser1 panes first port: #entity) value isNil.
	self assert: browser1 panes first presentations isEmpty.
	self assert: browser2 panes size equals: 1.
	self assert: (browser2 panes first port: #entity) value isNil.
	self assert: browser2 panes first presentations isEmpty.
	(browser1 pane port: #entity) value: 42.
	self assert: (browser1 pane port: #entity) value equals: 42.
	self assert: browser1 panes size equals: 1.
	self assert: (browser1 panes first port: #entity) value equals: 42.
	self assert: browser1 panes first presentations size equals: 1.
	innerBrowser := browser1 panes first presentations first.
	self assert: innerBrowser rootPrototype equals: browser2.
	self assert: innerBrowser pane == browser1 panes first.
	self assert: innerBrowser panes size equals: 1.
	self assert: (innerBrowser panes first port: #entity) value equals: 42.
	self assert: innerBrowser panes first presentations size equals: 1.
	self assert: innerBrowser panes first presentations first rootPrototype equals: presentation! !

!GLMNewScriptingTest methodsFor: 'tests' stamp: 'tg 1/14/2010 23:00'!
testNestedCompositesPaneReference
	| browser | 
	browser := GLMTabulator new. 
	browser column: #one. 
	browser transmit to: #one; andShow: [ :a |
		a list.
		a text.
		a composite: [:another | 
			another text.
			another list ] ].
	browser startOn: 42.
	(browser paneNamed: #one) presentations do: [:each |
		self assert: each pane == (browser paneNamed: #one) ].
	(browser paneNamed: #one) presentations last do: [:each |
		self assert: each pane == (browser paneNamed: #one) ]! !

!GLMNewScriptingTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testEntity
	| browser |
	browser := GLMTabulator new.
	browser column: #one.
	(browser transmit)
		to: #one;
		andShow: [ :a | a list ].
	browser startOn: ($a to: $d).
	self assert: ((browser paneNamed: #one) port: #entity) value equals: ($a to: $d)! !

!GLMNewScriptingTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testBundleTransmissionWithTransformation
	| browser |
	browser := GLMTabulator new.
	browser
		column: #one;
		column: #two.
	(browser transmit)
		to: #one;
		andShow: [ :a | a text ].
	(browser transmit)
		from: #one transformed: [ :x | x + 1 ];
		to: #two;
		andShow: [ :a | a text ].
	browser startOn: 1.
	((browser paneNamed: #one) port: #selection) value: 41.
	self assert: ((browser paneNamed: #two) port: #entity) value equals: 42! !

!GLMNewScriptingTest methodsFor: 'tests' stamp: 'TudorGirba 5/20/2012 00:52'!
testSimpleTransmission
	| browser |
	browser := GLMTabulator new.
	browser
		column: #one;
		column: #two.
	(browser transmit)
		from: #one port: #port1;
		fromOutsidePort: #outerPort;
		to: #two port: #port2.
	(browser transmit)
		from: #one port: #port3;
		toOutsidePort: #anotherOuterPort.
	self assert: browser transmissions size equals: 2.
	self assert: browser transmissions first browser == browser.
	self assert: (browser transmissions first transmissionStrategy isKindOf: GLMNoStrategy).
	self assert: browser transmissions first origins first equals: ((browser paneNamed: #one) port: #port1).
	self assert: browser transmissions first origins last equals: (browser pane port: #outerPort).
	self assert: browser transmissions first destination equals: ((browser paneNamed: #two) port: #port2).
	self assert: browser transmissions last browser == browser.
	self assert: (browser transmissions last transmissionStrategy isKindOf: GLMNoStrategy).
	self assert: browser transmissions last origins first equals: ((browser paneNamed: #one) port: #port3).
	self assert: browser transmissions last destination equals: (browser pane port: #anotherOuterPort)! !

!GLMNewScriptingTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testBundleTransmission
	| browser transmission |
	browser := GLMTabulator new.
	browser
		column: #one;
		column: #two;
		column: #three.
	(browser transmit)
		from: #one port: #port1;
		from: #two port: #port2;
		to: #three -> #port3;
		andShow: [ :a | 
					a list.
					a table ].
	transmission := browser transmissions first.
	self assert: browser transmissions size equals: 1.
	self assert: transmission browser == browser.
	self assert: (transmission transmissionStrategy isKindOf: GLMReplacePresentationsStrategy).
	self assert: transmission origins size equals: 2.
	self assert: transmission origins first equals: ((browser paneNamed: #one) port: #port1).
	self assert: transmission origins last equals: ((browser paneNamed: #two) port: #port2).
	self assert: transmission destination equals: ((browser paneNamed: #three) port: #port3).
	self assert: (transmission transmissionStrategy presentations isKindOf: GLMCompositePresentation).
	self assert: transmission transmissionStrategy presentations size equals: 2! !

!GLMNewScriptingTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testStartTabulator
	| browser |
	browser := GLMTabulator new.
	browser column: #one.
	(browser transmit)
		to: #one;
		andShow: [ :a | 
					a list.
					a text ].
	browser startOn: 42.
	self assert: ((browser paneNamed: #one) presentations isKindOf: GLMCompositePresentation).
	self assert: (browser paneNamed: #one) presentations size equals: 2! !

!GLMNewScriptingTest methodsFor: 'tests' stamp: 'TudorGirba 5/20/2012 00:54'!
testSimpleTransmissionWithTransformation
	| browser |
	browser := GLMTabulator new.
	browser
		column: #one;
		column: #two.
	(browser transmit)
		from: #one port: #port1;
		fromOutsidePort: #entity;
		to: #two port: #port2;
		when: [ :one :outer | one notNil and: [ outer notNil ] ];
		transformed: [ :one :outer | one + outer ].
	browser startOn: 2.
	self assert: ((browser paneNamed: #two) port: #port2) value isNil.
	((browser paneNamed: #one) port: #port1) value: 40.
	self assert: ((browser paneNamed: #two) port: #port2) value equals: 42! !

!GLMNewScriptingTest methodsFor: 'tests' stamp: 'TudorGirba 5/20/2012 00:54'!
testSimpleTransmissionWithCondition
	| browser |
	browser := GLMTabulator new.
	browser
		column: #one;
		column: #two.
	(browser transmit)
		from: #one port: #port1;
		fromOutsidePort: #entity;
		to: #two port: #port2;
		when: [ :one :outer | one notNil and: [ outer notNil and: [ one + outer = 42 ] ] ].
	browser startOn: 2.
	self assert: ((browser paneNamed: #two) port: #port2) value isNil.
	((browser paneNamed: #one) port: #port1) value: 39.
	self assert: ((browser paneNamed: #two) port: #port2) value isNil.
	((browser paneNamed: #one) port: #port1) value: 40.
	self assert: ((browser paneNamed: #two) port: #port2) value notNil! !

!GLMNewScriptingTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testStatusbar
	| browser |
	browser := GLMTabulator withStatusbar.
	browser row: #one.
	(browser transmit)
		to: #one;
		andShow: [ :a | a list display: #(1 2 3) ].
	self assert: browser transmissions size equals: 2.
	browser startOn: 42! !

!GLMNewScriptingTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testSelectionValidation
	| browser |
	browser := GLMTabulator new.
	browser
		column: [ :c | 
					c
						row: #one;
						row: #two ];
		column: #three.
	(browser transmit)
		to: #one;
		andShow: [ :a | a list display: [ :x | 1 to: x ] ].
	(browser transmit)
		to: #two;
		from: #one;
		andShow: [ :a | 
					(a list)
						beMultiple;
						display: [ :x | 1 to: x ] ].
	(browser transmit)
		to: #three;
		from: #two;
		andShow: [ :a | a text ].
	browser startOn: 42.
	((browser paneNamed: #one) port: #selection) value: 40.
	self assert: ((browser paneNamed: #two) port: #entity) value equals: 40.
	((browser paneNamed: #two) port: #selection) value: #(10 30 40).
	self assert: ((browser paneNamed: #two) port: #selection) value equals: #(10 30 40).
	self assert: ((browser paneNamed: #three) port: #entity) value equals: #(10 30 40).
	((browser paneNamed: #two) port: #selection) value: #(10 30).
	self assert: ((browser paneNamed: #two) port: #selection) value equals: #(10 30).
	self assert: ((browser paneNamed: #three) port: #entity) value equals: #(10 30).
	((browser paneNamed: #one) port: #selection) value: 5.
	self assert: ((browser paneNamed: #two) port: #entity) value equals: 5.
	((browser paneNamed: #two) port: #selection) value: #(1 3).
	self assert: ((browser paneNamed: #two) port: #selection) value equals: #(1 3).
	self assert: ((browser paneNamed: #three) port: #entity) value equals: #(1 3)! !

!GLMNewScriptingTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testBuildingNestedComposites
	| browser |
	browser := GLMTabulator new.
	browser column: #one.
	(browser transmit)
		to: #one;
		andShow: [ :a | 
					a list.
					a text.
					a
						composite: [ :another | 
							another text.
							another list ] ].
	browser startOn: 42.
	self assert: ((browser paneNamed: #one) presentations isKindOf: GLMCompositePresentation).
	self assert: (browser paneNamed: #one) presentations size equals: 3.
	self assert: ((browser paneNamed: #one) presentations last isKindOf: GLMCompositePresentation).
	self assert: (browser paneNamed: #one) presentations last size equals: 2! !

!GLMNoBrowser commentStamp: 'TudorGirba 2/4/2011 20:22'!
A NoBrowser is a browser without behavior and that does not require a container pane. The root pane is always placed in a NoBrowser.
Given that it has no behavior, a NoBrowser is a singleton to avoid multiple unnecessary instances.!
!GLMNoBrowser methodsFor: 'accessing' stamp: 'TudorGirba 2/4/2011 20:23'!
innerPortEvent: aPortEvent 
	"Needed for simulating a browser"! !

!GLMNoBrowser methodsFor: 'accessing' stamp: 'AndreiChis 6/20/2014 14:43'!
lastActivePresentation: aPresentation! !

!GLMNoBrowser class methodsFor: 'class initialization' stamp: 'jorge.ressia 6/3/2009 08:30'!
initialize

	self initializeUniqueInstance! !

!GLMNoBrowser class methodsFor: 'instance creation' stamp: 'jorge.ressia 6/3/2009 08:29'!
new

	^self uniqueInstance! !

!GLMNoBrowser class methodsFor: 'accessing' stamp: 'jorge.ressia 6/3/2009 08:30'!
uniqueInstance

	^uniqueInstance! !

!GLMNoBrowser class methodsFor: 'class initialization' stamp: 'tg 5/24/2010 17:17'!
initializeUniqueInstance

	uniqueInstance := self basicNew initialize! !

!GLMNoBrowserTest methodsFor: 'tests' stamp: 'jorge.ressia 6/3/2009 08:35'!
testCreation

	self deny: GLMNoBrowser new isNil.
	self assert: (GLMNoBrowser new) == GLMNoBrowser new! !

!GLMNoStrategy commentStamp: 'tg 2/20/2010 14:53'!
This is the default strategy that does nothing (an implementation of the Null pattern)!
!GLMNoStrategy methodsFor: 'transmitting' stamp: 'tg 2/20/2010 14:06'!
transmitIn: aContext
	"do nothing else then was already done by the transmission"! !

!GLMNullLogger commentStamp: 'tg 5/24/2010 16:58'!
This class simply implements the Null pattern.!
!GLMOriginPortReference commentStamp: '<historical>'!
Used by BundleTransmission to annotate its originating ports whether they are active or passive.

When a BundleTransmission consideres a port as active, the browser will trigger it when the corresponding port changes.!
!GLMOriginPortReference methodsFor: 'accessing-convenience' stamp: 'tg 1/5/2010 22:11'!
value
	^ self transformation isNil ifTrue: [self port value] ifFalse: [self transformation value: self port value]! !

!GLMOriginPortReference methodsFor: 'accessing' stamp: 'tg 1/5/2010 22:11'!
transformation: anObject
	transformation := anObject! !

!GLMOriginPortReference methodsFor: 'testing' stamp: ' 4/5/09 22:18'!
isPassive 
	 
	^self isActive not! !

!GLMOriginPortReference methodsFor: 'testing' stamp: ' 4/5/09 22:18'!
isActive 
	 
	^active ifNil: [active := true]! !

!GLMOriginPortReference methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
bePassive 
	 
	active := false! !

!GLMOriginPortReference methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
beActive 
	 
	active := true! !

!GLMOriginPortReference methodsFor: 'accessing' stamp: 'tg 1/5/2010 22:11'!
transformation
	^ transformation! !

!GLMPagePoped methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 10/14/2014 09:13'!
initialize
	super initialize.
	
	smooth := false.! !

!GLMPagePoped methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/14/2014 09:13'!
smooth
	^ smooth! !

!GLMPagePoped methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/14/2014 09:13'!
smooth: anObject
	smooth := anObject! !

!GLMPagePopedAndReplaced methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/17/2015 15:07'!
brick
	^ brick! !

!GLMPagePopedAndReplaced methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/17/2015 15:07'!
brick: anObject
	brick := anObject! !

!GLMPagePushed methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/5/2014 12:42'!
morph
	^ morph! !

!GLMPagePushed methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/5/2014 12:42'!
morph: aMorph
	morph := aMorph! !

!GLMPageSwitched methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/5/2014 17:46'!
smooth: anObject
	smooth := anObject! !

!GLMPageSwitched methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/23/2014 18:36'!
pageIndex
	^ pageIndex! !

!GLMPageSwitched methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/23/2014 18:36'!
pageIndex: anObject
	pageIndex := anObject! !

!GLMPageSwitched methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/5/2014 17:46'!
smooth
	^ smooth! !

!GLMPager methodsFor: 'accessing' stamp: 'AndreiChis 6/28/2014 21:16'!
scrollButtonIconRenderBlock

	^ scrollButtonIconRenderBlock! !

!GLMPager methodsFor: 'testing' stamp: 'AndreiChis 12/10/2014 17:21'!
shouldDisplayPresentationCreateBy: aCollection 
	^ true! !

!GLMPager methodsFor: 'accessing' stamp: 'AndreiChis 6/28/2014 21:16'!
scrollButtonIconRenderBlock: aBlock

	scrollButtonIconRenderBlock := aBlock! !

!GLMPager methodsFor: 'rendering' stamp: 'AliakseiSyrel 6/28/2014 22:05'!
renderGlamorouslyOn: aRenderer

	^ aRenderer renderPager: self! !

!GLMPagerBarBrick methodsFor: 'bar-accessing' stamp: 'AliakseiSyrel 2/8/2015 20:25'!
sliderBrick: aBrick

	sliderBrick := aBrick.
	
	self sliderBrick
		pagerModel: self pagerModel;
		height: self pagerModel circleButtonSize;
		width: [ self pagerModel circleButtonSize * self pagerModel actualNumberOfVisiblePages ].
		
	self sliderBrick layout
		floating: #left.
		
	self addBrickBack: self sliderBrick! !

!GLMPagerBarBrick methodsFor: 'bar-event-handling' stamp: 'AliakseiSyrel 2/16/2015 12:17'!
onPagePushed: addedAnnouncement

	self buttonsBrick onPagePushed: addedAnnouncement.
	self recomputeScrollBar! !

!GLMPagerBarBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/16/2015 09:43'!
initialize
	super initialize.
	
	self
		useVerticalLinearLayout! !

!GLMPagerBarBrick methodsFor: 'bar-instance creation' stamp: 'AliakseiSyrel 2/4/2015 12:46'!
newButtonsBrick

	^ GLMPagerButtonsPaneBrick new! !

!GLMPagerBarBrick methodsFor: 'bar-accessing' stamp: 'AliakseiSyrel 2/4/2015 11:41'!
pagerModel

	^ pagerModel! !

!GLMPagerBarBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/9/2015 15:01'!
recomputeScrollBar
	
	self sliderBrick ifNotNil: #setWidthAfterResizing! !

!GLMPagerBarBrick methodsFor: 'bar-event-handling' stamp: 'AliakseiSyrel 2/4/2015 14:45'!
onPagePoped

	buttonsBrick onPagePoped.
	self recomputeScrollBar.! !

!GLMPagerBarBrick methodsFor: 'bar-accessing' stamp: 'AliakseiSyrel 2/4/2015 14:57'!
buttonsBrick: aBrick

	buttonsBrick := aBrick.
	
	self buttonsBrick pagerModel: pagerModel.
	
	self buttonsBrick
		hShrinkWrap;
		vShrinkWrap.
	
	self addBrickBack: self buttonsBrick! !

!GLMPagerBarBrick methodsFor: 'bar-instance creation' stamp: 'AliakseiSyrel 2/4/2015 15:14'!
newSliderBrick

	^ GLMPagerScrollSlidingBrick new! !

!GLMPagerBarBrick methodsFor: 'bar-accessing' stamp: 'AliakseiSyrel 2/4/2015 11:57'!
buttonsBrick

	^ buttonsBrick! !

!GLMPagerBarBrick methodsFor: 'bar-accessing' stamp: 'AliakseiSyrel 2/8/2015 18:56'!
pagerModel: aModel
	
	pagerModel := aModel.
	
	self pagerModel announcer weak subscribe: GLMPagePushed send: #onPagePushed: to: self.
	self pagerModel announcer weak subscribe: GLMPagePoped send: #onPagePoped to: self.
	
	self sliderBrick: self newSliderBrick.
	self buttonsBrick: self newButtonsBrick.! !

!GLMPagerBarBrick methodsFor: 'bar-accessing' stamp: 'AliakseiSyrel 2/9/2015 15:01'!
sliderBrick

	^ sliderBrick! !

!GLMPagerBoundsChanged methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/4/2014 15:29'!
bounds: anObject
	bounds := anObject! !

!GLMPagerBoundsChanged methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/4/2014 15:29'!
bounds
	^ bounds! !

!GLMPagerBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/4/2015 11:30'!
initialColorInSystemWindow: aSystemWindow
	"Answer the colour the receiver should be when added to a SystemWindow."
	^ Color transparent! !

!GLMPagerBrick methodsFor: 'pager-accessing' stamp: 'AliakseiSyrel 2/4/2015 11:33'!
scrollBrick

	^ scrollBrick! !

!GLMPagerBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/4/2015 11:29'!
initializeShortcuts

	self
		bindKeyCombination: Character arrowLeft alt command
		toAction: [ self pagerModel selectToLeft ].
	
	self
		bindKeyCombination: Character arrowRight alt command
		toAction: [ self pagerModel selectToRight ].
	
	self
		bindKeyCombination: Character arrowLeft alt shift command
		toAction: [ self pressedScrollerSizeCombination: #left ].

	self
		bindKeyCombination: Character arrowRight alt shift command
		toAction: [ self pressedScrollerSizeCombination: #right ].! !

!GLMPagerBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/4/2015 11:19'!
outOfWorld: aWorld

	GLMPagerPanePreviewMorph remove.
	^ super outOfWorld: aWorld.! !

!GLMPagerBrick methodsFor: 'pager-accessing' stamp: 'AliakseiSyrel 2/4/2015 11:19'!
showScrollBarWhenNeeded: aBoolean

	showScrollBarWhenNeeded := aBoolean! !

!GLMPagerBrick methodsFor: 'pager-api' stamp: 'AliakseiSyrel 2/4/2015 11:27'!
popPane
	"pops the last pane with smooth animation"
	self pagerModel popPane: true.! !

!GLMPagerBrick methodsFor: 'pager-accessing' stamp: 'AliakseiSyrel 2/4/2015 13:56'!
pagerBar: aBrick

	pagerBar := aBrick.
	
	self pagerBar
		vShrinkWrap;
		hShrinkWrap.
	self pagerBar layout hAlign: #center.
	
	self pagerBar pagerModel: pagerModel.
	
	self addBrickBack: self pagerBar! !

!GLMPagerBrick methodsFor: 'pager-actions' stamp: 'AliakseiSyrel 2/4/2015 11:19'!
scrollerSizeShortcutAction: first second: second
	
	(first = #left & second = #left) ifTrue: [ pagerModel enlargeToLeft ].
	(first = #left & second = #right) ifTrue: [ pagerModel diminishToRight ].
	(first = #right & second = #left) ifTrue: [ pagerModel diminishToLeft ].
	(first = #right & second = #right) ifTrue: [ pagerModel enlargeToRight ]! !

!GLMPagerBrick methodsFor: 'pager-actions' stamp: 'AliakseiSyrel 2/4/2015 11:19'!
pressedScrollerSizeCombination: aSymbol

	firstCombination ifNil: [ firstCombination := aSymbol. ^ self].
	
	self scrollerSizeShortcutAction: firstCombination second: aSymbol.
	firstCombination := nil.! !

!GLMPagerBrick methodsFor: 'pager-instance creation' stamp: 'AliakseiSyrel 2/4/2015 12:47'!
newPagerBar

	^ GLMPagerBarBrick new! !

!GLMPagerBrick methodsFor: 'pager-accessing' stamp: 'AliakseiSyrel 2/4/2015 11:22'!
showScrollBarWhenNeeded
	"retuns true if scrollbar should be visible if number of pages > 1,
	otherwise false"
	^ showScrollBarWhenNeeded ifNil: [ showScrollBarWhenNeeded := true ]! !

!GLMPagerBrick methodsFor: 'pager-accessing' stamp: 'AliakseiSyrel 2/4/2015 11:19'!
pagerModel
	^ pagerModel! !

!GLMPagerBrick methodsFor: 'pager-accessing' stamp: 'AliakseiSyrel 2/4/2015 11:21'!
pagerBar

	^ pagerBar! !

!GLMPagerBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/8/2015 17:42'!
initialize
	super initialize.
	
	self useVerticalLinearLayout! !

!GLMPagerBrick methodsFor: 'pager-accessing' stamp: 'AliakseiSyrel 2/4/2015 13:03'!
pagerModel: aModel

	pagerModel := aModel.
	
	self pagerModel announcer weak subscribe: GLMPagePushed send: #onPagePushed to: self.
	self pagerModel announcer weak subscribe: GLMPagePoped send: #onPagePoped to: self.
	
	self initializeShortcuts.
	
	self scrollBrick: self newScrollBrick.
	self pagerBar: self newPagerBar! !

!GLMPagerBrick methodsFor: 'pager-api' stamp: 'AliakseiSyrel 2/4/2015 11:27'!
pushPane: aMorph
	"pushes a pane to the end with smooth scroll animation"
	self pagerModel pushPane: aMorph smooth: true.
	! !

!GLMPagerBrick methodsFor: 'pager-api' stamp: 'AliakseiSyrel 2/4/2015 11:27'!
popAndReplacePane: aMorph
	"replaces last pane with new pane"
	self pagerModel popAndReplacePane: aMorph! !

!GLMPagerBrick methodsFor: 'pager-event-handling' stamp: 'AliakseiSyrel 2/4/2015 15:19'!
onPagePoped

	self showOrHideScrollBar! !

!GLMPagerBrick methodsFor: 'pager-instance creation' stamp: 'AliakseiSyrel 2/4/2015 12:47'!
newScrollBrick

	^ GLMPagerScrollBrick new! !

!GLMPagerBrick methodsFor: 'pager-accessing' stamp: 'AliakseiSyrel 2/4/2015 13:23'!
scrollBrick: aBrick

	scrollBrick := aBrick.
	self scrollBrick pagerModel: pagerModel.
	
	self scrollBrick
		vSpaceFill;
		hSpaceFill.
	
	self addBrickBack: self scrollBrick! !

!GLMPagerBrick methodsFor: 'pager-event-handling' stamp: 'AliakseiSyrel 2/4/2015 15:19'!
onPagePushed

	self showOrHideScrollBar! !

!GLMPagerBrick methodsFor: 'pager-actions' stamp: 'AliakseiSyrel 2/16/2015 12:16'!
showOrHideScrollBar
	
	((self pagerModel size > 1) & (self showScrollBarWhenNeeded))
		ifTrue: [ (self hasSubbrick: self pagerBar)
			ifFalse: [ self addBrickBack: self pagerBar ] ]
		ifFalse: [ self removeBrick: self pagerBar ].! !

!GLMPagerBrick class methodsFor: 'examples' stamp: 'AliakseiSyrel 2/4/2015 17:49'!
exampleBasic
	|pager adapter|
	adapter := GLMPagerModel new.
	pager :=	GLMPagerBrick new.
	pager pagerModel: adapter.
	pager pushPane: (GLMLabelBrick new color: Color lightRed; text: 'Hello'; textPosition: #center).
	"pager pushPane: (GLMBrick new color: Color green).
	pager pushPane: (GLMBrick new color: Color yellow).
	pager pushPane: (GLMBrick new color: Color blue).
	pager pushPane: (GLMBrick new color: Color pink)."
	
	pager height: 600.
	pager width: 1024.
	pager asBrickedMorph openInWindow.
	
	pager inspect.! !

!GLMPagerButtonAnnouncement methodsFor: 'accessing' stamp: 'AliakseiSyrel 8/19/2014 16:28'!
buttonModel: anObject
	buttonModel := anObject! !

!GLMPagerButtonAnnouncement methodsFor: 'accessing' stamp: 'AliakseiSyrel 8/19/2014 16:28'!
buttonModel
	^ buttonModel! !

!GLMPagerButtonsPaneBrick methodsFor: 'buttons-event-handling' stamp: 'AliakseiSyrel 2/4/2015 12:37'!
onPagePushed: addedAnnouncement
	
	self addButton: self newButton! !

!GLMPagerButtonsPaneBrick methodsFor: 'buttons-accessing' stamp: 'AliakseiSyrel 2/4/2015 12:24'!
buttons: anObject

	buttons := anObject! !

!GLMPagerButtonsPaneBrick methodsFor: 'buttons-event-handling' stamp: 'AliakseiSyrel 2/4/2015 15:06'!
onPageSwitched

	self updateButtons! !

!GLMPagerButtonsPaneBrick methodsFor: 'buttons-updating' stamp: 'AliakseiSyrel 2/9/2015 14:24'!
updateButtons
	"first we uncheck all buttons"
	self buttons select: #isFocused thenDo: #uncheck.
	"then check only necessary"
	self pagerModel size > 0 ifTrue: [
		self buttons from: self pagerModel firstVisiblePageIndex to: self pagerModel lastVisiblePageIndex do: #check ]! !

!GLMPagerButtonsPaneBrick methodsFor: 'buttons-updating' stamp: 'AliakseiSyrel 2/9/2015 14:25'!
markButtonsInside: aBounds
	|index boundsLeft boundsRight firstFound lastFound |	
	self flag: 'refactor me'.
	
	firstFound := false.
	lastFound := false.
	index := 0.
	
	(pagerModel size = 0) ifTrue: [ ^ self ].
	boundsLeft := aBounds x.
	boundsRight := aBounds y.
	
	self buttons do: [ :indicator |
		index := index + 1.
		(self isScrollMustBeChecked: index withLeft: boundsLeft andRight: boundsRight)
			ifTrue: [
				indicator check.
				firstFound ifFalse: [
					pagerModel virtualFirstVisiblePageIndex: index.
					firstFound := true.
				]
			]
			ifFalse: [
				"uncheck only if not focused"
				indicator isFocused ifFalse: [ indicator uncheck ].
				(firstFound & (lastFound = false)) ifTrue: [
					pagerModel virtualLastVisiblePageIndex: index - 1.
					lastFound := true.
				]
			].
	].
	lastFound ifFalse: [
		pagerModel virtualLastVisiblePageIndex: index.
		lastFound := true.
	]
	
		
! !

!GLMPagerButtonsPaneBrick methodsFor: 'buttons-updating' stamp: 'AliakseiSyrel 2/9/2015 14:23'!
updateButtonsFocus
	"unfocus all"
	self buttons do: #setNotFocused.
	"because it's possible when nothing has focus"
	self pagerModel focusedPageIndex
		ifNotNil: [ (self buttons at: self pagerModel focusedPageIndex) setFocused ]
	! !

!GLMPagerButtonsPaneBrick methodsFor: 'buttons-calculations' stamp: 'AliakseiSyrel 2/9/2015 11:29'!
buttonCenterByIndex: aNumber
	| width |
	width := self pagerModel circleButtonSize.
	^ ( ( aNumber - 1 ) * ( width ) ) + ( width / 2 ).! !

!GLMPagerButtonsPaneBrick methodsFor: 'buttons-accessing' stamp: 'AliakseiSyrel 2/4/2015 15:04'!
pagerModel: aModel
	
	pagerModel := aModel.
		
	self pagerModel announcer weak subscribe: GLMPageSwitched send: #onPageSwitched to: self.
	self pagerModel announcer weak subscribe: GLMPagerBoundsChanged send: #onScrollBoundsChanged: to: self.
	self pagerModel announcer weak subscribe: GLMFocusedPageChanged send: #onFocusedPageChanged to: self.
		
	self updateButtons! !

!GLMPagerButtonsPaneBrick methodsFor: 'buttons-instance-creation' stamp: 'AliakseiSyrel 2/4/2015 14:49'!
newButton

	^ GLMPagerScrollButtonBrick new! !

!GLMPagerButtonsPaneBrick methodsFor: 'buttons-accessing' stamp: 'AliakseiSyrel 2/4/2015 12:23'!
pagerModel

	^ pagerModel! !

!GLMPagerButtonsPaneBrick methodsFor: 'buttons-event-handling' stamp: 'AliakseiSyrel 2/9/2015 14:19'!
onButtonDeselected

	GLMPagerPanePreviewMorph uniqueInstance hideFromWorld! !

!GLMPagerButtonsPaneBrick methodsFor: 'buttons-testing' stamp: 'AliakseiSyrel 2/4/2015 12:11'!
isScrollMustBeChecked: anIndex withLeft: leftBound andRight: rightBound
	| buttonCenter |
	
	buttonCenter := self buttonCenterByIndex: anIndex.
	^ (leftBound <= buttonCenter ) & (rightBound > buttonCenter)! !

!GLMPagerButtonsPaneBrick methodsFor: 'buttons-event-handling' stamp: 'AliakseiSyrel 2/9/2015 15:02'!
onPagePoped
	|button|
	
	button := self buttons removeLast.
	button announcer unsubscribe: self.
	
	self owner changed.
	self removeBrick: button.
	self updateButtons! !

!GLMPagerButtonsPaneBrick methodsFor: 'buttons-event-handling' stamp: 'AliakseiSyrel 2/9/2015 14:20'!
onButtonClicked: ann

	self pagerModel switchPaneTo: ann buttonModel index! !

!GLMPagerButtonsPaneBrick methodsFor: 'buttons-event-handling' stamp: 'AliakseiSyrel 2/9/2015 14:21'!
onFocusedPageChanged

	self
		updateButtonsFocus;
		updateButtons
! !

!GLMPagerButtonsPaneBrick methodsFor: 'buttons-event-handling' stamp: 'AliakseiSyrel 2/4/2015 12:11'!
onScrollBoundsChanged: boundsChangedAnnouncement

	self markButtonsInside: boundsChangedAnnouncement bounds.
	! !

!GLMPagerButtonsPaneBrick methodsFor: 'buttons-adding' stamp: 'AliakseiSyrel 2/16/2015 13:03'!
addButton: aBrick

	self buttons add: aBrick.
	
	aBrick enable.
	aBrick index: self buttons size.
	aBrick announcer weak subscribe: GLMPagerButtonClicked send: #onButtonClicked: to: self.
	aBrick announcer weak subscribe: GLMPagerButtonSelected send: #onButtonSelected: to: self.
	aBrick announcer weak subscribe: GLMPagerButtonDeselected send: #onButtonDeselected to: self.
	
	self theme pagerWidgetThemer defaultScrollButtonStyleFor: aBrick.
	
	aBrick height: self pagerModel circleButtonSize.
	aBrick width: self pagerModel circleButtonSize.
	
	self addBrickBack: aBrick.
	
	(self buttons size = 1) ifTrue: [ self updateButtonsFocus ].
		
	self updateButtons.! !

!GLMPagerButtonsPaneBrick methodsFor: 'buttons-accessing' stamp: 'AliakseiSyrel 2/4/2015 12:24'!
buttons

	^ buttons ifNil: [ buttons := OrderedCollection new ]! !

!GLMPagerButtonsPaneBrick methodsFor: 'buttons-event-handling' stamp: 'AliakseiSyrel 2/9/2015 14:21'!
onButtonSelected: ann

	"notify adapter that we need to update pane preview"
	GLMPagerPanePreviewMorph uniqueInstance showAt: (self buttons at: ann buttonModel index) globalBounds topCenter.
	self pagerModel updatePreview: ann buttonModel index! !

!GLMPagerModel methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/17/2015 19:19'!
scrollingDelay: anInteger

	scrollingDelay := anInteger! !

!GLMPagerModel methodsFor: 'private' stamp: 'AndreiChis 6/28/2014 21:11'!
virtualLastVisiblePageIndex: anIndex.

	virtualLastVisiblePageIndex := self normalizePaneIndex: anIndex.! !

!GLMPagerModel methodsFor: 'notifying' stamp: 'AliakseiSyrel 2/17/2015 15:01'!
notifyScrollPositionChanged: isSmooth callback: aBlock

	self notifyAll: (GLMPagerScrollPositionChanged new smooth: isSmooth; callback: aBlock; yourself).! !

!GLMPagerModel methodsFor: 'notifying' stamp: 'AliakseiSyrel 2/17/2015 15:01'!
notifySelectedPageChanged

	self notifyAll:  GLMSelectedPageChanged new.! !

!GLMPagerModel methodsFor: 'private' stamp: 'AliakseiSyrel 5/26/2014 17:58'!
virtualFirstVisiblePageIndex
	^ virtualFirstVisiblePageIndex! !

!GLMPagerModel methodsFor: 'panes' stamp: 'AliakseiSyrel 5/28/2014 00:38'!
isPaneVisible: aNumber

	^ (aNumber >= self firstVisiblePageIndex) & (aNumber <= self lastVisiblePageIndex)! !

!GLMPagerModel methodsFor: 'notifying' stamp: 'AliakseiSyrel 2/17/2015 15:01'!
notifyNumberOfVisiblePagesChanged

	self notifyAll: GLMNumberOfVisiblePagesChanged new.! !

!GLMPagerModel methodsFor: 'scrolling' stamp: 'AliakseiSyrel 2/17/2015 19:19'!
scrollingDelay

	^ scrollingDelay ifNil: [ scrollingDelay := 100 ]! !

!GLMPagerModel methodsFor: 'scrolling' stamp: 'AliakseiSyrel 11/15/2014 16:11'!
scrollToPane: pageIndex
	
	self scrollToPane: pageIndex callback: nil
	! !

!GLMPagerModel methodsFor: 'initialization' stamp: 'AliakseiSyrel 6/29/2014 00:29'!
initialize
	super initialize.

	pagesCount := 0.
	selectedPageIndex := 0.
	focusedMorphs := Dictionary new.
	isDependenciesShown := false.
		
	numberOfVisiblePages := self defaultNumberOfVisiblePages.
	
	firstVisiblePageIndex:= 0.
	lastVisiblePageIndex:= 0.
	
	self invariant.! !

!GLMPagerModel methodsFor: 'accessing' stamp: 'AliakseiSyrel 6/28/2014 22:05'!
scrollButtonIconRenderBlock
	^ scrollButtonIconRenderBlock! !

!GLMPagerModel methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/5/2014 22:23'!
selectedPageIndex: anIndex
	| normalizedIndex |
	"changes current selected page and scrolls to it if necessary. Also if possible re-focused available morph"
	
	normalizedIndex := self normalizePaneIndex: anIndex.
	
	(self isPaneVisible: normalizedIndex) ifFalse: [
		"we need to scroll if new selected page is invisible"
		self scrollToPane: (normalizedIndex < self firstVisiblePageIndex ifTrue: [ normalizedIndex ] ifFalse: [(normalizedIndex - self numberOfVisiblePages + 1)]).
	].
	
	selectedPageIndex := normalizedIndex.
	self focusPaneAt: normalizedIndex.
	self notifySelectedPageChanged.

	self invariant.! !

!GLMPagerModel methodsFor: 'panes' stamp: 'AliakseiSyrel 5/27/2014 15:01'!
enlargeToLeft

	self virtualFirstVisiblePageIndex: (self firstVisiblePageIndex - 1).
	self recomputeState.! !

!GLMPagerModel methodsFor: 'notifying' stamp: 'AliakseiSyrel 2/17/2015 15:01'!
notifySynchronizeScrollTo: aValue 
	
	self notifyAll: (GLMPagerSynchronizeScrollAnnouncement new value: aValue).! !

!GLMPagerModel methodsFor: 'panes' stamp: 'AliakseiSyrel 2/17/2015 15:07'!
popAndReplacePane: aMorph
	
	self doNotNotifyDuring: [ :m |
		m popPane;
			pushPane: aMorph smooth: false ].
		
	self notifyPagePoppedAndReplaced: aMorph! !

!GLMPagerModel methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/9/2015 14:47'!
isDebug

	^ true! !

!GLMPagerModel methodsFor: 'focus' stamp: 'AliakseiSyrel 5/27/2014 23:41'!
focusedMorphAt: pageIndex
	"returns previosely focused morph in the pane or nil if no morph was focused"
	
	^ focusedMorphs at: pageIndex ifAbsent: [ nil ]! !

!GLMPagerModel methodsFor: 'private' stamp: 'AndreiChis 6/28/2014 21:11'!
virtualFirstVisiblePageIndex: anIndex

	virtualFirstVisiblePageIndex := self normalizePaneIndex: anIndex.
	! !

!GLMPagerModel methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/5/2014 22:24'!
lastVisiblePageIndex
	| lastIndex |
	
	lastIndex := self firstVisiblePageIndex + self numberOfVisiblePages - 1.
	^ lastIndex > self size
		ifTrue: [ self size ]
		ifFalse: [ lastIndex ]! !

!GLMPagerModel methodsFor: 'accessing' stamp: 'AliakseiSyrel 6/29/2014 00:28'!
dependencyButtonSize
	^ self isDependenciesShown ifTrue: [ self circleButtonSize ] ifFalse: [ 0 ].! !

!GLMPagerModel methodsFor: 'notifying' stamp: 'AliakseiSyrel 2/17/2015 15:01'!
notifyAll: anAnnouncement
	
	self isNotificationsAllowed ifTrue: [
		self announcer announce: anAnnouncement ]! !

!GLMPagerModel methodsFor: 'panes' stamp: 'AliakseiSyrel 5/28/2014 00:38'!
selectToLeft
	"moves focus to left"
	
	self selectedPageIndex: (self selectedPageIndex - 1).! !

!GLMPagerModel methodsFor: 'panes' stamp: 'AliakseiSyrel 5/27/2014 15:01'!
enlargeToRight

	self virtualLastVisiblePageIndex: (self lastVisiblePageIndex + 1).
	self recomputeState.! !

!GLMPagerModel methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/4/2014 10:37'!
numberOfVisiblePages
	^ numberOfVisiblePages! !

!GLMPagerModel methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 8/18/2014 21:19'!
recomputeState: isSmooth
	"recomputes current model state and if necessary notifies all listeners about changes"
	|tmpNumberOfVisiblePages notifyNumberOfVisiblePagesChanged|
	
	notifyNumberOfVisiblePagesChanged := false.
	
	self invariant.
	
	((virtualFirstVisiblePageIndex isNil) & (virtualLastVisiblePageIndex isNil)) ifTrue: [ ^ self ].
	virtualFirstVisiblePageIndex ifNil: [ virtualFirstVisiblePageIndex := self firstVisiblePageIndex ].
	virtualLastVisiblePageIndex ifNil: [ virtualLastVisiblePageIndex := self lastVisiblePageIndex ].
	
	tmpNumberOfVisiblePages := virtualLastVisiblePageIndex - virtualFirstVisiblePageIndex + 1.
	tmpNumberOfVisiblePages = numberOfVisiblePages ifFalse: [ notifyNumberOfVisiblePagesChanged := true ].
	numberOfVisiblePages := tmpNumberOfVisiblePages.
	
	firstVisiblePageIndex := virtualFirstVisiblePageIndex.
	lastVisiblePageIndex := virtualLastVisiblePageIndex.

	self invariant.
	
	virtualFirstVisiblePageIndex = nil.
	virtualLastVisiblePageIndex = nil.
	
	notifyNumberOfVisiblePagesChanged ifTrue: [ self notifyNumberOfVisiblePagesChanged ].
	self notifyScrollPositionChanged: isSmooth.
	! !

!GLMPagerModel methodsFor: 'notifying' stamp: 'AliakseiSyrel 2/17/2015 15:01'!
notifyPagePoped: isSmooth

	self notifyAll: (GLMPagePoped new smooth: isSmooth).! !

!GLMPagerModel methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/23/2014 19:16'!
selectedPageIndex
	^ selectedPageIndex! !

!GLMPagerModel methodsFor: 'accessing' stamp: 'AliakseiSyrel 6/29/2014 00:28'!
isDependenciesShown
	^ isDependenciesShown! !

!GLMPagerModel methodsFor: 'accessing' stamp: 'AliakseiSyrel 6/29/2014 00:29'!
isDependenciesShown: aBoolean
	isDependenciesShown := aBoolean! !

!GLMPagerModel methodsFor: 'focus' stamp: 'AliakseiSyrel 5/27/2014 23:37'!
focusPaneAt: pageIndex
	"tries to focus previosely focused morph at specified pane by its index"
	
	( self isFocusedMorphVisibleAt: pageIndex ) ifTrue: [
		focusedPageIndex := pageIndex.
		(self focusedMorphAt: pageIndex) activeHand newKeyboardFocus: (self focusedMorphAt: pageIndex).
		self notifyFocusedPageChanged.
	].! !

!GLMPagerModel methodsFor: 'notifying' stamp: 'AliakseiSyrel 2/17/2015 15:07'!
notifyPagePoppedAndReplaced: aBrick

	self notifyAll: (GLMPagePopedAndReplaced new brick: aBrick)! !

!GLMPagerModel methodsFor: 'accessing' stamp: 'AliakseiSyrel 6/28/2014 22:05'!
scrollButtonIconRenderBlock: anObject
	scrollButtonIconRenderBlock := anObject! !

!GLMPagerModel methodsFor: 'private' stamp: 'AliakseiSyrel 5/28/2014 00:57'!
virtualLastVisiblePageIndex

	^ virtualLastVisiblePageIndex! !

!GLMPagerModel methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 5/26/2014 13:50'!
updatePreview: anIndex

	self announcer announce: (GLMPagerPreviewUpdate new pageIndex: anIndex )! !

!GLMPagerModel methodsFor: 'panes' stamp: 'AliakseiSyrel 11/15/2014 15:17'!
popPane: isSmooth

	self invariant.
	
	pagesCount >= 1 ifTrue: [
		|scrollTo smooth|
		smooth := isSmooth.
		
		focusedMorphs removeKey: pagesCount  ifAbsent: [ true ].
		pagesCount := pagesCount - 1.
		
		firstVisiblePageIndex = 1 ifTrue: [ smooth := false ].
		
		lastVisiblePageIndex > pagesCount ifTrue: [
			firstVisiblePageIndex := firstVisiblePageIndex - 1.
			lastVisiblePageIndex := lastVisiblePageIndex - 1.
		].
	
		firstVisiblePageIndex := firstVisiblePageIndex max: 1.
	
		pagesCount = 0 ifTrue: [
			selectedPageIndex := 0.
			firstVisiblePageIndex := 0.
		].
		
		self selectedPageIndex > pagesCount ifTrue: [
			self selectedPageIndex: pagesCount.
		].
	
		scrollTo := ((pagesCount = firstVisiblePageIndex) & (pagesCount > self numberOfVisiblePages)).
		self notifyPagePoped: smooth.
	].

	self invariant.! !

!GLMPagerModel methodsFor: 'private' stamp: 'AliakseiSyrel 5/27/2014 14:15'!
privateRecomputeIndexesAfterScrollAt: aFloat
	"while rounding fractional part < 0.5"
	|left right|
	
	self invariant.
	
	left := self convertValueToIndex: aFloat.
	right := left + self actualNumberOfVisiblePages - 1.
	firstVisiblePageIndex := left rounded.
	lastVisiblePageIndex := right rounded.
	
	lastVisiblePageIndex > self size ifTrue: [
		|delta|
		delta := lastVisiblePageIndex - self size.
		firstVisiblePageIndex := firstVisiblePageIndex - delta.
		lastVisiblePageIndex := lastVisiblePageIndex - delta.
	].
		
	self invariant.
	
	! !

!GLMPagerModel methodsFor: 'scrolling' stamp: 'AliakseiSyrel 11/15/2014 16:12'!
scrollToPane: pageIndex callback: aBlock
	"scrolls to specified pane specified by its index"

	self scrollTo: (self convertIndexToValue: pageIndex) smooth: true callback: aBlock
	! !

!GLMPagerModel methodsFor: 'accessing' stamp: 'AliakseiSyrel 8/18/2014 20:08'!
circleButtonSize
	^ 22! !

!GLMPagerModel methodsFor: 'panes' stamp: 'AliakseiSyrel 5/27/2014 15:10'!
diminishToLeft

	self actualNumberOfVisiblePages = 1 ifTrue: [ ^ self ].
	self virtualLastVisiblePageIndex: (self lastVisiblePageIndex - 1).
	self recomputeState.! !

!GLMPagerModel methodsFor: 'private' stamp: 'AliakseiSyrel 10/14/2014 09:56'!
convertIndexToValue: anIndex with: numberOfPagers
	"private"
	numberOfPagers = self actualNumberOfVisiblePages
		ifTrue: [ ^ 0 ]
		ifFalse: [ ^ (anIndex - 1) / (numberOfPagers - self actualNumberOfVisiblePages ) ]! !

!GLMPagerModel methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/17/2015 14:59'!
isNotificationsAllowed

	^ isNotificationsAllowed ifNil: [ isNotificationsAllowed := true ]! !

!GLMPagerModel methodsFor: 'notifying' stamp: 'AliakseiSyrel 2/17/2015 15:01'!
notifyFocusedPageChanged

	self notifyAll: GLMFocusedPageChanged new.! !

!GLMPagerModel methodsFor: 'notifying' stamp: 'AliakseiSyrel 11/15/2014 16:13'!
notifyScrollPositionChanged: isSmooth

	self notifyScrollPositionChanged: isSmooth callback: nil! !

!GLMPagerModel methodsFor: 'scrolling' stamp: 'AliakseiSyrel 5/26/2014 20:18'!
scrollToRight: isSmooth
	"notifies all listeners that it is time to scroll most right"

	self scrollTo: 1.0 smooth: isSmooth! !

!GLMPagerModel methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/5/2014 22:23'!
firstVisiblePageIndex
	^ firstVisiblePageIndex! !

!GLMPagerModel methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 8/18/2014 21:19'!
recomputeState
	self recomputeState: true
	! !

!GLMPagerModel methodsFor: 'panes' stamp: 'AliakseiSyrel 5/27/2014 15:10'!
diminishToRight

	self actualNumberOfVisiblePages = 1 ifTrue: [ ^ self ].
	self virtualFirstVisiblePageIndex: (self firstVisiblePageIndex + 1).
	self recomputeState.! !

!GLMPagerModel methodsFor: 'accessing' stamp: 'AliakseiSyrel 5/26/2014 20:29'!
actualNumberOfVisiblePages
	"returns actual number of visible pages based on first and last visible page indexes"

	(firstVisiblePageIndex = lastVisiblePageIndex) & (firstVisiblePageIndex = 0) ifTrue: [ ^ 0 ].
	^ lastVisiblePageIndex - firstVisiblePageIndex + 1.! !

!GLMPagerModel methodsFor: 'focus' stamp: 'AliakseiSyrel 5/27/2014 23:40'!
assignFocusableMorph: aMorph withPaneAt: paneIndex
	"assigns previosely focused morph with corresponding pane"
	
	focusedMorphs at: paneIndex put: aMorph.! !

!GLMPagerModel methodsFor: 'scrolling' stamp: 'AliakseiSyrel 11/15/2014 16:12'!
scrollTo: aFloat smooth: isSmooth callback: aBlock
	"notifies all listeners to scroll at the specified value"
	
	self privateRecomputeIndexesAfterScrollAt: aFloat.
	self notifyScrollPositionChanged: isSmooth callback: aBlock! !

!GLMPagerModel methodsFor: 'panes' stamp: 'AliakseiSyrel 5/28/2014 00:22'!
pushPane: aMorph smooth: aBoolean

	self invariant.
	
	pagesCount := pagesCount + 1.
	
	self size = 1
		ifTrue: [ 
			firstVisiblePageIndex := 1.
			lastVisiblePageIndex := 1.
			selectedPageIndex := 1.
		]
		ifFalse: [ 
			(self actualNumberOfVisiblePages < self numberOfVisiblePages) ifTrue: [
				lastVisiblePageIndex := lastVisiblePageIndex + 1.
			].
		].
	
	self notifyPagePushed: aMorph scrollTo: true smooth: aBoolean.
	self size = 1 ifTrue: [ self notifySelectedPageChanged ].
	
	self invariant.! !

!GLMPagerModel methodsFor: 'scrolling' stamp: 'AliakseiSyrel 11/15/2014 16:11'!
scrollTo: aFloat smooth: isSmooth
	
	self scrollTo: aFloat smooth: isSmooth callback: nil! !

!GLMPagerModel methodsFor: 'accessing' stamp: 'AndreiChis 4/15/2014 12:18'!
defaultNumberOfVisiblePages
	^ 2! !

!GLMPagerModel methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 5/28/2014 00:37'!
normalizePaneIndex: anIndex
	"retunes normalized pane index. For example: returns 1 if index < 1 and size if index > self size"
	
	anIndex < 1 ifTrue: [ ^ 1 ].
	anIndex > self size ifTrue: [ ^ self size ].
	^ anIndex.! !

!GLMPagerModel methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/3/2014 20:30'!
announcer
	^ announcer ifNil: [ announcer := Announcer new ]! !

!GLMPagerModel methodsFor: 'accessing' stamp: 'AliakseiSyrel 5/26/2014 19:29'!
size
	^ pagesCount.! !

!GLMPagerModel methodsFor: 'scrolling' stamp: 'AndreiChis 8/29/2014 12:52'!
switchPaneTo: anIndex
	| normalizedIndex |
	"switches pane to specified. Works as scrollToPane, but additionaly selects and focuses that pane."
	
	self invariant.
	
	normalizedIndex := self normalizePaneIndex: anIndex.
	
	self scrollToPane: normalizedIndex.	
	self focusPaneAt: normalizedIndex.
	
	selectedPageIndex := normalizedIndex.
	self notifySelectedPageChanged.
	
	self invariant.! !

!GLMPagerModel methodsFor: 'focus' stamp: 'AliakseiSyrel 7/15/2014 12:44'!
focusedMorphChanged: aMorph at: pageIndex
	"call this method if a morph was focused in a pane with specified index. As a result corresponding pane will be marked as selected"
	
	
	self assignFocusableMorph: aMorph withPaneAt: pageIndex.
	
	focusedPageIndex = pageIndex ifFalse: [ 
		focusedPageIndex := pageIndex.
		self selectedPageIndex: pageIndex.
		self notifyFocusedPageChanged.
	]
	! !

!GLMPagerModel methodsFor: 'scrolling' stamp: 'AliakseiSyrel 5/27/2014 13:27'!
convertValueToIndex: aValue
	
	^ (self size - self actualNumberOfVisiblePages) * aValue + 1.! !

!GLMPagerModel methodsFor: 'panes' stamp: 'AliakseiSyrel 10/14/2014 09:16'!
popPane

	self popPane: false.! !

!GLMPagerModel methodsFor: 'invariant' stamp: 'AliakseiSyrel 5/28/2014 01:09'!
invariant
	"If any of these exceptions rise, please notify us through moose-dev mail list. Your help is appreciated"
	
	self isDebug ifFalse: [ ^ self ].
	
	pagesCount >= 0 ifFalse: [ GLMPagerException signal: 'The number of page must be non negative' ].

	pagesCount > 1 ifTrue: [
		firstVisiblePageIndex >= 1 ifFalse: [GLMPagerException signal: 'First visible page index must be > 1 if number of pages > 0'].
		lastVisiblePageIndex >= 1 ifFalse: [GLMPagerException signal: 'Last visible page index must be > 1 if number of pages > 0'].
		lastVisiblePageIndex <= pagesCount ifFalse: [ GLMPagerException signal: 'Last visible page index must be less or equals to the number of pages' ].
		self actualNumberOfVisiblePages <= numberOfVisiblePages ifFalse: [ GLMPagerException signal: 'Actual number of visible pages must be less or equals to current number of visible pages' ].
		selectedPageIndex >= 1 ifFalse: [ GLMPagerException signal: 'Selected page index must be greater or equals then 1 if number of pages is more than 1' ].
	].

	pagesCount = 1 ifTrue: [ 
		firstVisiblePageIndex = 1 ifFalse: [GLMPagerException signal: 'First visible page index must be 1 if number of pages is 1'].
		lastVisiblePageIndex = 1 ifFalse: [GLMPagerException signal: 'Last visible page index must be 1 if number of pages is 1'].
		lastVisiblePageIndex = firstVisiblePageIndex ifFalse: [ GLMPagerException signal: 'First and Last visible page indexes must be equal if number of pages is 1' ].
		self actualNumberOfVisiblePages = 1 ifFalse: [ GLMPagerException signal: 'Actual number of visible pages must be 1 if number of pages is 1' ].
		selectedPageIndex = 1 ifFalse: [ GLMPagerException signal: 'Selected page index must be 1 if number of pages is 1' ].
	].

	pagesCount = 0 ifTrue: [ 
		firstVisiblePageIndex = 0 ifFalse: [GLMPagerException signal: 'First visible page index must be 0 if number of pages is 0'].
		lastVisiblePageIndex = 0 ifFalse: [GLMPagerException signal: 'Last visible page index must be 0 if number of pages is 0'].
		self actualNumberOfVisiblePages = 0 ifFalse: [ GLMPagerException signal: 'Actual number of visible pages must be 0 if there is no pages' ].
		selectedPageIndex = 0 ifFalse: [ GLMPagerException signal: 'Selected page index must be 0 if number of pages is 0' ].
	]! !

!GLMPagerModel methodsFor: 'focus' stamp: 'AliakseiSyrel 4/23/2014 20:34'!
isFocusedMorphVisibleAt: paneIndex
	|morph|
	
	morph := self focusedMorphAt: paneIndex.
	morph ifNil: [ ^ false ].
	^ morph isInWorld.! !

!GLMPagerModel methodsFor: 'notifying' stamp: 'AliakseiSyrel 2/17/2015 15:01'!
notifyScrollerBoundsChanged: aBounds

	self notifyAll: (GLMPagerBoundsChanged new bounds: aBounds).! !

!GLMPagerModel methodsFor: 'scrolling' stamp: 'AliakseiSyrel 2/17/2015 19:17'!
scrollToRightTask

	^ scrollToRightTask ifNil: [
		scrollToRightTask := GLMAsyncTask new.
		scrollToRightTask
			doInBackground: [ :isSmooth | isSmooth ];
			onCompleted: [ :isSmooth | self scrollToRight: isSmooth ];
			delay: self scrollingDelay ]! !

!GLMPagerModel methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/17/2015 17:44'!
doNotNotifyDuring: aBlock
	|allowed|
	allowed := self isNotificationsAllowed.
	isNotificationsAllowed := false.
	aBlock cull: self.
	allowed ifTrue: [ isNotificationsAllowed := true ]! !

!GLMPagerModel methodsFor: 'scrolling' stamp: 'AliakseiSyrel 10/14/2014 09:56'!
convertIndexToValue: anIndex
	
	^ self convertIndexToValue: anIndex with: self size! !

!GLMPagerModel methodsFor: 'scrolling' stamp: 'AliakseiSyrel 5/27/2014 14:29'!
synchronizeScrollTo: aValue
	
	self notifySynchronizeScrollTo: aValue.! !

!GLMPagerModel methodsFor: 'accessing' stamp: 'AliakseiSyrel 5/27/2014 11:06'!
defaultNumberOfVisiblePages: anInteger
	"use it only when the number of pages is 0"
	self size = 0 ifFalse: [ GLMPagerException signal: 'You can change default number of visible pages only when there is no pages' ].
	numberOfVisiblePages := anInteger.! !

!GLMPagerModel methodsFor: 'panes' stamp: 'AliakseiSyrel 5/28/2014 00:34'!
selectToRight
	"moves focus to right"
	
	self selectedPageIndex: (self selectedPageIndex + 1).! !

!GLMPagerModel methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/23/2014 19:26'!
focusedPageIndex
	^ focusedPageIndex! !

!GLMPagerModel methodsFor: 'notifying' stamp: 'AliakseiSyrel 2/17/2015 19:18'!
notifyPagePushed: aMorph scrollTo: isScroll smooth: isSmooth
	
	self notifyAll: (GLMPagePushed new morph: aMorph).
	
	isScroll ifTrue: [
		self scrollingDelay > 0
			ifTrue: [ self scrollToRightTask execute: { isSmooth } ]
			ifFalse: [ self scrollToRight: isSmooth ] ]! !

!GLMPagerModelTest methodsFor: 'tests' stamp: 'AliakseiSyrel 5/27/2014 23:24'!
testPrivateRecomputeIndexesAfterScrollAt

	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	
	self assert: pagerModel firstVisiblePageIndex equals: 1.
	self assert: pagerModel lastVisiblePageIndex equals: 1.
	
	"raw first visible must be 1.0, last visible 1.0 and after rounding 1 and 1"
	pagerModel privateRecomputeIndexesAfterScrollAt: 1.0.
	
	self assert: pagerModel firstVisiblePageIndex equals: 1.
	self assert: pagerModel lastVisiblePageIndex equals: 1.
	
	"raw first visible must be 1.0, last visible 1.0 and after rounding 1 and 1"
	pagerModel privateRecomputeIndexesAfterScrollAt: 0.0.
	
	self assert: pagerModel firstVisiblePageIndex equals: 1.
	self assert: pagerModel lastVisiblePageIndex equals: 1.
		
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
		
	"raw first visible must be 1.0, last visible 1.0 and after rounding 1 and 1"
	pagerModel privateRecomputeIndexesAfterScrollAt: 0.0.
	
	self assert: pagerModel firstVisiblePageIndex equals: 1.
	self assert: pagerModel lastVisiblePageIndex equals: 2.
	
	"raw first visible must be 4.4, last visible 5.4 and after rounding 4 and 5"
	pagerModel privateRecomputeIndexesAfterScrollAt: 0.85.
	
	self assert: pagerModel firstVisiblePageIndex equals: 4.
	self assert: pagerModel lastVisiblePageIndex equals: 5.
	
	"raw first visible must be 4.6, last visible 5.6 and after rounding 5 and 6"
	pagerModel privateRecomputeIndexesAfterScrollAt: 0.9.
	
	self assert: pagerModel firstVisiblePageIndex equals: 5.
	self assert: pagerModel lastVisiblePageIndex equals: 6.
	
	"raw first visible must be 4.5, last visible 5.5 and after rounding 5 and 6"
	pagerModel privateRecomputeIndexesAfterScrollAt: 0.875.
	
	self assert: pagerModel firstVisiblePageIndex equals: 5.
	self assert: pagerModel lastVisiblePageIndex equals: 6.
	
	"raw first visible must be 5.0, last visible 6.0 and after rounding 5 and 6"
	pagerModel privateRecomputeIndexesAfterScrollAt: 1.0.
	
	self assert: pagerModel firstVisiblePageIndex equals: 5.
	self assert: pagerModel lastVisiblePageIndex equals: 6.! !

!GLMPagerModelTest methodsFor: 'tests' stamp: 'AliakseiSyrel 5/27/2014 11:41'!
testModelInitialization

	self assert: pagerModel size equals: 0.
	self assert: pagerModel firstVisiblePageIndex equals: 0.
	self assert: pagerModel lastVisiblePageIndex equals: 0.
	self assert: pagerModel actualNumberOfVisiblePages equals: 0.
	self assert: pagerModel numberOfVisiblePages equals: 2.! !

!GLMPagerModelTest methodsFor: 'tests' stamp: 'AliakseiSyrel 10/5/2014 22:33'!
testPopLastPageOf5
	
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel popPane.
	
	self assert: pagerModel size equals: 4.
	self assert: pagerModel firstVisiblePageIndex equals: 3.
	self assert: pagerModel lastVisiblePageIndex equals: 4.
	self assert: pagerModel numberOfVisiblePages equals: 2.! !

!GLMPagerModelTest methodsFor: 'private' stamp: 'AndreiChis 4/15/2014 11:42'!
createSimplePaneMorph

	^ Morph new! !

!GLMPagerModelTest methodsFor: 'tests' stamp: 'AliakseiSyrel 5/27/2014 15:09'!
testDiminishToRight
	|counter right|
	
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	
	"assert that by default after creation the number of visible pages equals default value"
	counter := pagerModel defaultNumberOfVisiblePages.
	"position of right edge is a constant while diminishing to right"
	right := pagerModel lastVisiblePageIndex.
	self assert: pagerModel numberOfVisiblePages equals: counter.
	self assert: pagerModel numberOfVisiblePages equals: right - pagerModel firstVisiblePageIndex+1.
	self assert: pagerModel lastVisiblePageIndex equals: right.
	
	"diminish until numberOfVisible pages > 1"
	[ counter > 1 ] whileTrue: [
		pagerModel diminishToRight.
		counter := counter - 1.
		self assert: pagerModel numberOfVisiblePages equals: counter.
		self assert: pagerModel numberOfVisiblePages equals: right - pagerModel firstVisiblePageIndex+1.
		self assert: pagerModel lastVisiblePageIndex equals: right.
	].

	"now the number of visible pages must be not less then 1"
	(1 to: 3) do: [ :i|
		pagerModel diminishToRight.
		self assert: pagerModel numberOfVisiblePages equals: 1.
		self assert: pagerModel numberOfVisiblePages equals: right - pagerModel firstVisiblePageIndex+1.
		self assert: pagerModel lastVisiblePageIndex equals: right.
	].
! !

!GLMPagerModelTest methodsFor: 'tests' stamp: 'AliakseiSyrel 5/27/2014 23:18'!
testEnlargeToLeft
	|counter right |
	
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
		
	"assert that by default after creation the number of visible pages equals default value"
	counter := pagerModel numberOfVisiblePages.
	"position of right edge is a constant while enlarging to left"
	right := pagerModel lastVisiblePageIndex.
	self assert: pagerModel numberOfVisiblePages equals: counter.
	self assert: pagerModel numberOfVisiblePages equals: right - pagerModel firstVisiblePageIndex+1.
	self assert: pagerModel lastVisiblePageIndex equals: right.
	
	"enlarge until numberOfVisible pages > 1"
	[ counter < 6 ] whileTrue: [
		counter := counter + 1.
		pagerModel enlargeToLeft.
		self assert: pagerModel numberOfVisiblePages equals: counter.
		self assert: pagerModel numberOfVisiblePages equals: right - pagerModel firstVisiblePageIndex+1.
		self assert: pagerModel lastVisiblePageIndex equals: right.
	].

	"now the number of visible pages must be not bigger then 6"
	(1 to: 3) do: [ :i|
		pagerModel enlargeToLeft.
		self assert: pagerModel numberOfVisiblePages equals: 6.
		self assert: pagerModel numberOfVisiblePages equals: right - pagerModel firstVisiblePageIndex+1.
		self assert: pagerModel lastVisiblePageIndex equals: right.
		self assert: pagerModel firstVisiblePageIndex equals: 1.
	].
! !

!GLMPagerModelTest methodsFor: 'tests' stamp: 'AliakseiSyrel 5/28/2014 00:34'!
testSelectToRight

	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	
	pagerModel scrollTo: 0.0 smooth: false.
	
	self assert: pagerModel numberOfVisiblePages equals: 2.
	
	self assert: pagerModel selectedPageIndex equals: 1.
	self assert: pagerModel firstVisiblePageIndex equals: 1.
	self assert: pagerModel lastVisiblePageIndex equals: 2.
	
	pagerModel selectToRight.
	
	self assert: pagerModel selectedPageIndex equals: 2.
	self assert: pagerModel firstVisiblePageIndex equals: 1.
	self assert: pagerModel lastVisiblePageIndex equals: 2.
	
	pagerModel selectToRight.
	
	self assert: pagerModel selectedPageIndex equals: 3.
	self assert: pagerModel firstVisiblePageIndex equals: 2.
	self assert: pagerModel lastVisiblePageIndex equals: 3.
	
	pagerModel selectToRight.
	
	self assert: pagerModel selectedPageIndex equals: 4.
	self assert: pagerModel firstVisiblePageIndex equals: 3.
	self assert: pagerModel lastVisiblePageIndex equals: 4.
	
	pagerModel selectToRight.
	
	self assert: pagerModel selectedPageIndex equals: 5.
	self assert: pagerModel firstVisiblePageIndex equals: 4.
	self assert: pagerModel lastVisiblePageIndex equals: 5.
	
	pagerModel selectToRight.
	
	self assert: pagerModel selectedPageIndex equals: 6.
	self assert: pagerModel firstVisiblePageIndex equals: 5.
	self assert: pagerModel lastVisiblePageIndex equals: 6.! !

!GLMPagerModelTest methodsFor: 'tests' stamp: 'AliakseiSyrel 5/27/2014 23:22'!
testEnlargeToRight
	|counter left|
	
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	
	pagerModel scrollTo: 0.0 smooth: false.
	
	"assert that by default after creation the number of visible pages equals default value"
	counter := pagerModel numberOfVisiblePages.
	"position of left edge is a constant while enlargingto right"
	left := pagerModel firstVisiblePageIndex.
	self assert: pagerModel numberOfVisiblePages equals: counter.
	self assert: pagerModel numberOfVisiblePages equals: pagerModel lastVisiblePageIndex-left+1.
	self assert: pagerModel firstVisiblePageIndex equals: left.
	
	"diminish until numberOfVisible pages > 1"
	[ counter < 6 ] whileTrue: [
		counter := counter + 1.
		pagerModel enlargeToRight.
		self assert: pagerModel numberOfVisiblePages equals: counter.
		self assert: pagerModel numberOfVisiblePages equals: pagerModel lastVisiblePageIndex-left+1.
		self assert: pagerModel firstVisiblePageIndex equals: left.
	].

	"now the number of visible pages must be not bigger than 6"
	(1 to: 3) do: [ :i|
		pagerModel enlargeToRight.
		self assert: pagerModel numberOfVisiblePages equals: 6.
		self assert: pagerModel numberOfVisiblePages equals: pagerModel lastVisiblePageIndex-left+1.
		self assert: pagerModel firstVisiblePageIndex equals: left.
		self assert: pagerModel lastVisiblePageIndex equals: 6.
	].
! !

!GLMPagerModelTest methodsFor: 'tests' stamp: 'AliakseiSyrel 5/27/2014 23:26'!
testIsPaneVisible

	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	
	self assert: pagerModel numberOfVisiblePages equals: 2.
	
	self assert: (pagerModel isPaneVisible: 1) equals: false.
	self assert: (pagerModel isPaneVisible: 2) equals: false.
	self assert: (pagerModel isPaneVisible: 3) equals: false.
	self assert: (pagerModel isPaneVisible: 4) equals: false.
	self assert: (pagerModel isPaneVisible: 5) equals: true.
	self assert: (pagerModel isPaneVisible: 6) equals: true.! !

!GLMPagerModelTest methodsFor: 'running' stamp: 'AliakseiSyrel 2/17/2015 19:20'!
setUp

	pagerModel := GLMPagerModel new scrollingDelay: 0.
	pagerModel defaultNumberOfVisiblePages: 2.! !

!GLMPagerModelTest methodsFor: 'tests' stamp: 'TudorGirba 4/15/2014 22:45'!
testPanePushAnnouncement
	| count currentAnn paneMorph |
	
	count := 0.
	paneMorph := self createSimplePaneMorph.
	pagerModel announcer when: GLMPagePushed do: [ :ann | count := count + 1. currentAnn := ann ].
	
	pagerModel pushPane: paneMorph smooth: false.
	self assert: count equals: 1.
	self assert: currentAnn morph equals: paneMorph.
	
	paneMorph := self createSimplePaneMorph.
	pagerModel pushPane: paneMorph smooth: false.
	self assert: count equals: 2.
	self assert: currentAnn morph equals: paneMorph.
	
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	self assert: count equals: 4.! !

!GLMPagerModelTest methodsFor: 'tests' stamp: 'AliakseiSyrel 10/5/2014 22:36'!
testSelectionChangeAfterPopOfLastPage
	
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	
	self assert: pagerModel selectedPageIndex equals: 1.
	
	pagerModel selectedPageIndex: 5.
	self assert: pagerModel selectedPageIndex equals: 5.
	
	pagerModel popPane.
	
	self assert: pagerModel selectedPageIndex equals: 4.
	self assert: pagerModel size equals: 4.
	self assert: pagerModel firstVisiblePageIndex equals: 3.
	self assert: pagerModel lastVisiblePageIndex equals: 4.
	self assert: pagerModel numberOfVisiblePages equals: 2.
	
	pagerModel popPane.
	
	self assert: pagerModel selectedPageIndex equals: 3.
	self assert: pagerModel size equals: 3.
	self assert: pagerModel firstVisiblePageIndex equals: 2.
	self assert: pagerModel lastVisiblePageIndex equals: 3.
	self assert: pagerModel numberOfVisiblePages equals: 2.
	
	pagerModel popPane.
	
	self assert: pagerModel selectedPageIndex equals: 2.
	self assert: pagerModel size equals: 2.
	self assert: pagerModel firstVisiblePageIndex equals: 1.
	self assert: pagerModel lastVisiblePageIndex equals: 2.
	self assert: pagerModel numberOfVisiblePages equals: 2.
	
	pagerModel popPane.
	
	self assert: pagerModel selectedPageIndex equals: 1.
	self assert: pagerModel size equals: 1.
	self assert: pagerModel firstVisiblePageIndex equals: 1.
	self assert: pagerModel lastVisiblePageIndex equals: 1.
	self assert: pagerModel numberOfVisiblePages equals: 2.! !

!GLMPagerModelTest methodsFor: 'tests' stamp: 'AliakseiSyrel 5/28/2014 00:42'!
testSelectToLeft

	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	
	pagerModel switchPaneTo: 6.
	
	self assert: pagerModel numberOfVisiblePages equals: 2.
	
	self assert: pagerModel selectedPageIndex equals: 6.
	self assert: pagerModel firstVisiblePageIndex equals: 5.
	self assert: pagerModel lastVisiblePageIndex equals: 6.
	
	pagerModel selectToLeft.
	
	self assert: pagerModel selectedPageIndex equals: 5.
	self assert: pagerModel firstVisiblePageIndex equals: 5.
	self assert: pagerModel lastVisiblePageIndex equals: 6.
	
	pagerModel selectToLeft.
	
	self assert: pagerModel selectedPageIndex equals: 4.
	self assert: pagerModel firstVisiblePageIndex equals: 4.
	self assert: pagerModel lastVisiblePageIndex equals: 5.
	
	pagerModel selectToLeft.
	
	self assert: pagerModel selectedPageIndex equals: 3.
	self assert: pagerModel firstVisiblePageIndex equals: 3.
	self assert: pagerModel lastVisiblePageIndex equals: 4.
	
	pagerModel selectToLeft.
	
	self assert: pagerModel selectedPageIndex equals: 2.
	self assert: pagerModel firstVisiblePageIndex equals: 2.
	self assert: pagerModel lastVisiblePageIndex equals: 3.
	
	pagerModel selectToLeft.
	
	self assert: pagerModel selectedPageIndex equals: 1.
	self assert: pagerModel firstVisiblePageIndex equals: 1.
	self assert: pagerModel lastVisiblePageIndex equals: 2.

	! !

!GLMPagerModelTest methodsFor: 'tests' stamp: 'AliakseiSyrel 5/27/2014 11:08'!
testDiminishToLeft
	|counter left|
	
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	
	"assert that by default after creation the number of visible pages equals default value"
	counter := pagerModel numberOfVisiblePages.
	"position of left edge is a constant while diminishing to left"
	left := pagerModel firstVisiblePageIndex.
	self assert: pagerModel numberOfVisiblePages equals: counter.
	self assert: pagerModel numberOfVisiblePages equals: pagerModel lastVisiblePageIndex-left+1.
	self assert: pagerModel firstVisiblePageIndex equals: left.
	
	"diminish until numberOfVisible pages > 1"
	[ counter > 1 ] whileTrue: [
		pagerModel diminishToLeft.
		counter := counter - 1.
		self assert: pagerModel numberOfVisiblePages equals: counter.
		self assert: pagerModel numberOfVisiblePages equals: pagerModel lastVisiblePageIndex-left+1.
		self assert: pagerModel firstVisiblePageIndex equals: left.
	].

	"now the number of visible pages must be not less then 1"
	(1 to: 3) do: [ :i|
		pagerModel diminishToLeft.
		self assert: pagerModel numberOfVisiblePages equals: 1.
		self assert: pagerModel numberOfVisiblePages equals: pagerModel lastVisiblePageIndex-left+1.
		self assert: pagerModel firstVisiblePageIndex equals: left.
	].
! !

!GLMPagerModelTest methodsFor: 'tests' stamp: 'AliakseiSyrel 5/27/2014 11:40'!
testOnePanePush
	
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	
	self assert: pagerModel size equals: 1.
	self assert: pagerModel firstVisiblePageIndex equals: 1.
	self assert: pagerModel lastVisiblePageIndex equals: 1.
	self assert: pagerModel numberOfVisiblePages equals: 2.
	! !

!GLMPagerModelTest methodsFor: 'tests' stamp: 'AliakseiSyrel 5/27/2014 15:12'!
testOneReplacePane
	
	pagerModel popAndReplacePane: self createSimplePaneMorph.

	self assert: pagerModel size equals: 1.
	self assert: pagerModel firstVisiblePageIndex equals: 1.
	self assert: pagerModel lastVisiblePageIndex equals: 1.
	self assert: pagerModel numberOfVisiblePages equals: 2.
	! !

!GLMPagerModelTest methodsFor: 'tests' stamp: 'AliakseiSyrel 10/5/2014 22:33'!
testPopOnePage
	
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel popPane.
	
	self assert: pagerModel size equals: 1.
	self assert: pagerModel firstVisiblePageIndex equals: 1.
	self assert: pagerModel lastVisiblePageIndex equals: 1.
	self assert: pagerModel numberOfVisiblePages equals: 2.! !

!GLMPagerModelTest methodsFor: 'tests' stamp: 'AliakseiSyrel 5/27/2014 15:11'!
testEmptyPopPane
	| count |
	
	count := 0.
	pagerModel announcer when: GLMPagePoped do: [ :ann | count := count + 1 ].
	
	pagerModel popPane.
	
	self assert: count equals: 0.
	
	self assert: pagerModel size equals: 0.
	self assert: pagerModel firstVisiblePageIndex equals: 0.
	self assert: pagerModel lastVisiblePageIndex equals: 0.
	self assert: pagerModel numberOfVisiblePages equals: 2.
	
	pagerModel popPane.
	pagerModel popPane.
	
	self assert: count equals: 0.
	! !

!GLMPagerMorphTest methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/10/2015 00:54'!
panesMorphs

	^ pagerMorph subbricks first subbricks first subbricks! !

!GLMPagerMorphTest methodsFor: 'private' stamp: 'AndreiChis 5/7/2014 21:19'!
createSimplePaneMorph

	^ Morph new! !

!GLMPagerMorphTest methodsFor: 'running' stamp: 'AndreiChis 5/7/2014 21:33'!
tearDown

	window ifNotNil: [ window delete ]! !

!GLMPagerMorphTest methodsFor: 'private' stamp: 'AliakseiSyrel 2/10/2015 00:50'!
openInWindow

	window := pagerMorph asBrickedMorph openInWindow ! !

!GLMPagerMorphTest methodsFor: 'tests' stamp: 'AliakseiSyrel 5/26/2014 19:29'!
testPushPanesAfterOpen

	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	self openInWindow.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	
	self assert: pagerModel size equals: 3.
	self assert: self panesMorphs size equals: 3.
	self assert: self buttonsMorphs size equals: 3.
	
	
! !

!GLMPagerMorphTest methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/10/2015 00:53'!
buttonsMorphs

	^ pagerMorph subbricks second subbricks second subbricks! !

!GLMPagerMorphTest methodsFor: 'tests' stamp: 'AliakseiSyrel 5/26/2014 19:29'!
testPushPanesBeforeOpen

	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.
	pagerModel pushPane: self createSimplePaneMorph smooth: false.

	self openInWindow.
	
	self assert: pagerModel size equals: 3.
	self assert: self panesMorphs size equals: 3.
	self assert: self buttonsMorphs size equals: 3.
	
	
! !

!GLMPagerMorphTest methodsFor: 'running' stamp: 'AliakseiSyrel 2/10/2015 00:49'!
setUp

	pagerModel := GLMPagerModel new.
	pagerMorph := GLMPagerBrick new
		pagerModel: pagerModel
		yourself.! !

!GLMPagerPanePreviewMorph commentStamp: 'AndreiChis 5/27/2014 19:59'!
I am a morph showing a preview image of another morph.  I should be used like a singleton: my class provides an unique instance of me. That instance can be hiden, shown or updated.!
!GLMPagerPanePreviewMorph methodsFor: 'initialization' stamp: 'AliakseiSyrel 5/26/2014 14:18'!
maxExtent
	^ 300@300.! !

!GLMPagerPanePreviewMorph methodsFor: 'actions' stamp: 'AndreiChis 5/27/2014 19:38'!
hideFromWorld
	"Remove the morph from the world"
	self delete! !

!GLMPagerPanePreviewMorph methodsFor: 'initialization' stamp: 'AndreiChis 5/27/2014 19:30'!
initialize
	super initialize.

	self color: Color transparent.
	
	self theme pagerWidgetThemer previewPaneStyleFor: self.
	self borderWidth: self defaultBorderWidth.! !

!GLMPagerPanePreviewMorph methodsFor: 'actions' stamp: 'AndreiChis 5/27/2014 19:42'!
showAt: aPoint

	self 
		openInWorld;
		align: aPoint.! !

!GLMPagerPanePreviewMorph methodsFor: 'actions' stamp: 'AliakseiSyrel 2/9/2015 14:39'!
updateFor: aMorph

	thumbnail := aMorph taskThumbnailOfSize: self maxExtent.
	self image: thumbnail form.
	
	self position: position - ((thumbnail width / 2)@(thumbnail height + self defaultBottomMargin + self defaultBorderWidth)).! !

!GLMPagerPanePreviewMorph methodsFor: 'initialization' stamp: 'AliakseiSyrel 5/26/2014 15:16'!
defaultBottomMargin
	^ 11! !

!GLMPagerPanePreviewMorph methodsFor: 'actions' stamp: 'AliakseiSyrel 5/26/2014 14:17'!
align: aPoint
	
	position := aPoint.! !

!GLMPagerPanePreviewMorph methodsFor: 'initialization' stamp: 'AliakseiSyrel 5/26/2014 14:37'!
defaultBorderWidth
	^ 5! !

!GLMPagerPanePreviewMorph class methodsFor: 'actions' stamp: 'AndreiChis 5/27/2014 19:32'!
remove

	self uniqueInstance delete.	
	uniqueInstance := nil.! !

!GLMPagerPanePreviewMorph class methodsFor: 'accessing' stamp: 'AndreiChis 5/27/2014 19:31'!
uniqueInstance
	^ uniqueInstance ifNil: [ uniqueInstance := GLMPagerPanePreviewMorph new ].! !

!GLMPagerPanePreviewMorph class methodsFor: 'cleanup' stamp: 'AndreiChis 3/3/2015 13:59'!
cleanUp
	super cleanUp.
	uniqueInstance := nil! !

!GLMPagerPreviewUpdate methodsFor: 'accessing' stamp: 'AliakseiSyrel 5/26/2014 13:49'!
pageIndex: anObject
	pageIndex := anObject! !

!GLMPagerPreviewUpdate methodsFor: 'accessing' stamp: 'AliakseiSyrel 5/26/2014 13:49'!
pageIndex
	^ pageIndex! !

!GLMPagerScrollBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/14/2015 13:33'!
band: aBrick

	band := aBrick.
	band
		useHorizontalLinearLayout;
		layoutMorphs: true;
		width: [ self band subbricksCount * self width / ((self maxPanes min: self band subbricksCount) max: 1) ];
		vSpaceFill.
	"band actually depends from myself,
	because each pane is proportional to my size"
	band layout widthDependency: self.
	
	self addBrickBack: band.! !

!GLMPagerScrollBrick methodsFor: 'event-handling' stamp: 'AliakseiSyrel 2/17/2015 15:08'!
onPagePopedAndReplaced: ann

	self popAndReplace: ann brick! !

!GLMPagerScrollBrick methodsFor: 'event-handling' stamp: 'AliakseiSyrel 2/16/2015 12:18'!
onPagePushed: pushedAnnouncement

	"added new page to the end of pane"
	self pushPane: pushedAnnouncement morph
	
	
	
	
! !

!GLMPagerScrollBrick methodsFor: 'event-handling' stamp: 'AliakseiSyrel 12/4/2014 12:36'!
onPagePoped: popedAnnouncement
	self popPane: popedAnnouncement smooth.! !

!GLMPagerScrollBrick methodsFor: 'initialize' stamp: 'AliakseiSyrel 12/4/2014 09:47'!
outOfWorld: aWorld

	Morph announcer unsubscribe: self.
	^ super outOfWorld: aWorld.! !

!GLMPagerScrollBrick methodsFor: 'api' stamp: 'AliakseiSyrel 2/18/2015 13:17'!
popPane: isSmooth

	(isSmooth not or: [self lastPane isNil]) ifTrue: [ ^ self popPane ].
	
	self band doNotLayoutDuring: [ :b | b removeBrick: b lastSubbrick ].
	self
		scrollTo: (pagerModel convertIndexToValue: pagerModel firstVisiblePageIndex with: self band subbricksCount)
		smooth: isSmooth
		callback: [ self doLayoutForce ]! !

!GLMPagerScrollBrick methodsFor: 'scrolling' stamp: 'AliakseiSyrel 2/8/2015 13:46'!
convertScrollValue: aFloat
	self pagerModel actualNumberOfVisiblePages = 0 ifTrue: [ ^ 0 ].
	^ (self width - ((self width / self pagerModel actualNumberOfVisiblePages + self paneMargin) * self band subbricksCount)) * aFloat! !

!GLMPagerScrollBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 12/4/2014 12:09'!
maxPanes
	^ maxPanes! !

!GLMPagerScrollBrick methodsFor: 'scrolling' stamp: 'AliakseiSyrel 2/17/2015 13:41'!
scrollValue: value
	
	currentScrollDelta := value.
	
	self band doNotLayoutDuring: [ :b | b translateXTo: self scrollValue ].
	self changed! !

!GLMPagerScrollBrick methodsFor: 'event-handling' stamp: 'AliakseiSyrel 2/8/2015 16:58'!
focusChanged: anEvent
	| pageIndex newFocus |
	
	newFocus := anEvent morph.
	
	currentFocus = newFocus ifFalse: [
		currentFocus := newFocus.
		pageIndex := self pageOf: newFocus.
		(pageIndex > 0) ifTrue: [
			pagerModel focusedMorphChanged: newFocus at: pageIndex ] ]! !

!GLMPagerScrollBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 2/14/2015 13:31'!
newBand

	^ GLMScrollPaneBandBrick new! !

!GLMPagerScrollBrick methodsFor: 'event-handling' stamp: 'AliakseiSyrel 12/4/2014 09:47'!
onSynchronizeScroll: announcement

	"directly scrolls to value"
	self scrollTo: announcement value smooth: false! !

!GLMPagerScrollBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/17/2015 13:32'!
animation

	^ animation! !

!GLMPagerScrollBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 12/4/2014 11:53'!
paneAt: anIndex
	^ self panes at: anIndex.! !

!GLMPagerScrollBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 12/4/2014 12:38'!
lastPane

	self subbricksCount = 0 ifTrue: [ ^ nil ].
	^ self panes last.! !

!GLMPagerScrollBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 12/4/2014 09:41'!
band

	^ band! !

!GLMPagerScrollBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/8/2015 16:58'!
initialize
	super initialize.
	
	focus := Dictionary new.
	currentScrollDelta := 0.
	maxPanes := 2.
	self band: self newBand.
	Morph announcer weak 
		when: MorphGotFocus send: #focusChanged: to: self.! !

!GLMPagerScrollBrick methodsFor: 'api' stamp: 'AliakseiSyrel 2/17/2015 17:33'!
popAndReplace: aBrick
	|brick|

	brick := self configurePane: aBrick.
	brick wrappedBounds: self band lastSubbrick wrappedBounds.
	brick updateMorphBounds.
	
	self band doNotLayoutDuring: [ :b | b
		removeBrick: b lastSubbrick;
		addBrickBack: brick ].
	self changed
	
	! !

!GLMPagerScrollBrick methodsFor: 'event-handling' stamp: 'AliakseiSyrel 2/17/2015 17:45'!
onPagesNumberChanged

	self maxPanes: pagerModel numberOfVisiblePages.
	self doLayoutForce.
	self scrollToPane: pagerModel firstVisiblePageIndex smooth: false
	! !

!GLMPagerScrollBrick methodsFor: 'api' stamp: 'AliakseiSyrel 2/17/2015 17:28'!
pushPane: aMorph

	self band addBrickBack: (self configurePane: aMorph)! !

!GLMPagerScrollBrick methodsFor: 'event-handling' stamp: 'AliakseiSyrel 2/14/2015 12:25'!
onPositionChanged: announcement


	self scrollToPane: pagerModel firstVisiblePageIndex smooth: announcement smooth callback: announcement callback! !

!GLMPagerScrollBrick methodsFor: 'scrolling' stamp: 'AliakseiSyrel 12/4/2014 12:00'!
glmAnimateValue: aValue duration: anInteger

	self glmAnimateValue: aValue duration: anInteger callback: nil.! !

!GLMPagerScrollBrick methodsFor: 'scrolling' stamp: 'AliakseiSyrel 2/16/2015 12:12'!
updatePaneBounds

	self band updateMorphBounds! !

!GLMPagerScrollBrick methodsFor: 'scrolling' stamp: 'AliakseiSyrel 2/14/2015 12:32'!
scrollTo: aValue smooth: isSmooth callback: aBlock
	
 	isSmooth ifTrue: [ self glmAnimateValue: aValue duration: 300 callback: aBlock ]
				ifFalse: [ self scrollValue: (self convertScrollValue: aValue). self updatePaneBounds. aBlock value ].! !

!GLMPagerScrollBrick methodsFor: 'scrolling' stamp: 'AliakseiSyrel 2/14/2015 12:32'!
scrollTo: aValue smooth: isSmooth

 	self scrollTo: aValue smooth: isSmooth callback: nil! !

!GLMPagerScrollBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 12/4/2014 12:09'!
maxPanes: anInteger
	maxPanes := anInteger! !

!GLMPagerScrollBrick methodsFor: 'scrolling' stamp: 'AliakseiSyrel 2/18/2015 13:07'!
glmAnimateValue: aValue duration: anInteger callback: aBlock
	
	self animation ifNotNil: #terminate.
	animation := GLMAnimation new
		linear;
		duration: 300;
		from: self scrollValue;
		to: (self convertScrollValue: aValue);
		ensure: [ :b | b updatePaneBounds. aBlock brickValue: b ];
		animation: [ :b :v | b scrollValue: v ];
		animate: self! !

!GLMPagerScrollBrick methodsFor: 'event-handling' stamp: 'AliakseiSyrel 12/4/2014 09:47'!
onSelectedPageChanged
	
	self panes do: [ :each | each borderColor: Color transparent ].
	
	self theme pagerWidgetThemer selectedPaneStyleFor: (self panes at: pagerModel selectedPageIndex)! !

!GLMPagerScrollBrick methodsFor: 'scrolling' stamp: 'AliakseiSyrel 12/4/2014 09:49'!
scrollToPane: anIndex smooth: isSmooth callback: aBlock

	self scrollTo: (pagerModel convertIndexToValue: anIndex) smooth: isSmooth callback: aBlock.! !

!GLMPagerScrollBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 12/4/2014 13:57'!
scrollValue

	^ currentScrollDelta! !

!GLMPagerScrollBrick methodsFor: 'api' stamp: 'AliakseiSyrel 2/16/2015 12:47'!
popPane
	
	self band doNotLayoutDuring: [ :b | b removeBrick: b lastSubbrick ].
	self doLayoutForce! !

!GLMPagerScrollBrick methodsFor: 'api' stamp: 'AliakseiSyrel 2/17/2015 17:28'!
configurePane: aBrick
	|brick|
	brick := aBrick asBrick.
	brick
		layoutProperties: GLMBrickLayoutProperties new;
		"width of tab is proportional to number of visible panes and my width"
		width: [ self band width / self band subbricksCount ];
		vSpaceFill;
		marginLeft: self paneMargin;
		marginRight: self paneMargin.
		
	brick layout widthDependency: self band.
	^ brick! !

!GLMPagerScrollBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/17/2015 15:06'!
pagerModel: aModel
	
	pagerModel := aModel.
	maxPanes := aModel numberOfVisiblePages.
	
	pagerModel announcer weak
		when: GLMPagePushed send: #onPagePushed: to: self.
	
	pagerModel announcer weak
		when: GLMPagePoped send: #onPagePoped: to: self.
	
	pagerModel announcer weak
		when: GLMPagePopedAndReplaced send: #onPagePopedAndReplaced: to: self.
						
	pagerModel announcer weak
		when: GLMPagerSynchronizeScrollAnnouncement send: #onSynchronizeScroll: to: self.
		
	pagerModel announcer weak 
		when: GLMPagerScrollPositionChanged send: #onPositionChanged: to: self.
		
	pagerModel announcer weak 
		when: GLMNumberOfVisiblePagesChanged send: #onPagesNumberChanged to: self.
		
	pagerModel announcer weak 
		when: GLMSelectedPageChanged send: #onSelectedPageChanged to: self.
		
	pagerModel announcer weak 
		when: GLMPagerPreviewUpdate send: #onPagePreviewUpdate: to: self.! !

!GLMPagerScrollBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 12/4/2014 13:36'!
pagerModel

	^ pagerModel! !

!GLMPagerScrollBrick methodsFor: 'event-handling' stamp: 'AliakseiSyrel 12/4/2014 09:46'!
onPagePreviewUpdate: updateAnnouncement

	GLMPagerPanePreviewMorph uniqueInstance updateFor: (self paneAt: updateAnnouncement pageIndex).! !

!GLMPagerScrollBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/9/2015 14:50'!
paneMargin
	"please leave it 0, becasue otherwise it doesn't work"
	self flag: 'fix support of margin'.
	^ 0! !

!GLMPagerScrollBrick methodsFor: 'scrolling' stamp: 'AliakseiSyrel 12/4/2014 09:49'!
scrollToPane: anIndex smooth: isSmooth

	self scrollToPane: anIndex smooth: isSmooth callback: nil! !

!GLMPagerScrollBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 12/4/2014 11:57'!
panes

	^ self band submorphs! !

!GLMPagerScrollBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 12/4/2014 09:48'!
pageOf: aSubMorph
	"returns 0 if morph is not in pager"
	|parent page|	
	
	aSubMorph ifNil: [ ^ 0 ].
	
	parent := aSubMorph.
	
	[parent isNotNil & ((parent == self band) not) ] whileTrue: [
		page := parent.
		parent := parent owner.
	].
	
	^ parent isNil ifTrue: [ 0 ] ifFalse: [ self panes indexOf: page. ].
	! !

!GLMPagerScrollBrick methodsFor: 'brick-layout-events' stamp: 'AliakseiSyrel 2/17/2015 15:53'!
onChildrenLayouted
	super onChildrenLayouted.
	
	self band translateXTo: (self convertScrollValue: (self pagerModel convertIndexToValue: self pagerModel firstVisiblePageIndex))! !

!GLMPagerScrollButtonBrick methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/4/2015 14:47'!
isFocused
	^ focused! !

!GLMPagerScrollButtonBrick methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/9/2015 14:17'!
click: anEvent
	super click: anEvent.
	
	self announcer announce: (GLMPagerButtonClicked new buttonModel: self)
	! !

!GLMPagerScrollButtonBrick methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/4/2015 14:48'!
setNotFocused

	focused ifTrue: [
		self checkedImage: checkedIcon.
		self uncheck.
		focused := false ]! !

!GLMPagerScrollButtonBrick methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/4/2015 14:47'!
checkedIcon: aForm
	checkedIcon := aForm.! !

!GLMPagerScrollButtonBrick methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/4/2015 14:47'!
checkedIcon
	^ checkedIcon! !

!GLMPagerScrollButtonBrick methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/4/2015 14:59'!
deselect
	super deselect.
	
	self announcer announce: (GLMPagerButtonDeselected new buttonModel: self)
	! !

!GLMPagerScrollButtonBrick methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/4/2015 14:48'!
setFocused

	focused ifFalse: [
		self checkedImage: checkedFocusedIcon.
		self check.
		focused := true ]! !

!GLMPagerScrollButtonBrick methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/4/2015 14:47'!
initialize
	super initialize.

	focused := false.! !

!GLMPagerScrollButtonBrick methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/4/2015 14:47'!
checkedFocusedIcon
	^ checkedFocusedIcon! !

!GLMPagerScrollButtonBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/4/2015 14:49'!
index: anObject
	index := anObject! !

!GLMPagerScrollButtonBrick methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/4/2015 14:47'!
checkedFocusedIcon: aForm
	checkedFocusedIcon := aForm.! !

!GLMPagerScrollButtonBrick methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/4/2015 14:51'!
select
	super select.
	
	self announcer announce: (GLMPagerButtonSelected new buttonModel: self)
	! !

!GLMPagerScrollButtonBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/4/2015 14:49'!
index
	^ index! !

!GLMPagerScrollPositionChanged methodsFor: 'accessing' stamp: 'AliakseiSyrel 5/27/2014 13:44'!
smooth: anObject
	smooth := anObject! !

!GLMPagerScrollPositionChanged methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/15/2014 16:13'!
callback: anObject
	callback := anObject! !

!GLMPagerScrollPositionChanged methodsFor: 'accessing' stamp: 'AliakseiSyrel 5/27/2014 13:44'!
smooth
	^ smooth! !

!GLMPagerScrollPositionChanged methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/15/2014 16:13'!
callback
	^ callback! !

!GLMPagerScrollSlidingBrick methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/9/2015 11:42'!
computeWidth

	^ self pagerModel
		ifNil: [ 0 ]
		ifNotNil: [ :m | m circleButtonSize * m actualNumberOfVisiblePages ]! !

!GLMPagerScrollSlidingBrick methodsFor: 'slider-scrolling' stamp: 'AliakseiSyrel 2/14/2015 13:09'!
moveLeft: left "Integer - pixels"
	"moves scrollbar inside parent to the specified left distance in pixels and notifies all listeners about that"
	"Highly optimised to not update layout during moving"
	| right |
	right := left + self width.
	self changedWith: [ :b |
		b translateXTo: left.
		b leftPosition: left ].
	
	pagerModel notifyScrollerBoundsChanged: left@right! !

!GLMPagerScrollSlidingBrick methodsFor: 'event-mouse' stamp: 'AliakseiSyrel 2/9/2015 11:16'!
mouseUp: evt
	super mouseUp: evt.
	
	pagerModel recomputeState: isResizing not.
	
	isResizing ifTrue: [ self setWidthAfterResizing ].
	isResizing := false.
		
	(self globalBounds containsPoint: evt position)
		ifFalse: [ self setCursorToNormal: evt ]
		ifTrue: [ self setCursorToResizing: evt ] ! !

!GLMPagerScrollSlidingBrick methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/9/2015 11:57'!
computeScrollValue: aNumber
	|newValue delta|
	
	delta := self owner width - self width.
	newValue := (aNumber max: 0) min: delta.
		
	^ ((delta = 0)
		ifTrue: [ 0 ]
		ifFalse: [ newValue / delta ])! !

!GLMPagerScrollSlidingBrick methodsFor: 'slider-cursor' stamp: 'AliakseiSyrel 2/4/2015 15:12'!
setCursorToResizing: evt
	
	evt hand showTemporaryCursor: self resizeCursor! !

!GLMPagerScrollSlidingBrick methodsFor: 'slider-cursor' stamp: 'AliakseiSyrel 2/4/2015 15:12'!
setCursorToNormal: evt
		
	evt hand showTemporaryCursor: nil! !

!GLMPagerScrollSlidingBrick methodsFor: 'slider-accessing' stamp: 'AliakseiSyrel 2/14/2015 12:39'!
leftPosition

	^ leftPosition ifNil: [ leftPosition := 0 ]! !

!GLMPagerScrollSlidingBrick methodsFor: 'announcement handling' stamp: 'AliakseiSyrel 2/9/2015 14:28'!
onPositionChanged: announcement
	
	self scrollToPane: pagerModel firstVisiblePageIndex smooth: announcement smooth! !

!GLMPagerScrollSlidingBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/9/2015 11:38'!
initialize
	super initialize.
		
	resizingZoneWidth := 7.
	isRightResizing := false.
	isLeftResizing := false.
	isResizing := false.
		
	self
		normalColor: (Color veryLightGray alpha: 0.4);
		selectedColor: (Color veryLightGray alpha: 0.55);
		enable! !

!GLMPagerScrollSlidingBrick methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/9/2015 15:00'!
setWidthAfterResizing
	| left right |
	
	left := pagerModel circleButtonSize * (pagerModel firstVisiblePageIndex - 1).
	right := left + self computeWidth.
	
	self setPosition: left@right! !

!GLMPagerScrollSlidingBrick methodsFor: 'slider-testing' stamp: 'AliakseiSyrel 2/9/2015 11:51'!
isLeftResizingZone: evt
	
	^ (self globalBounds withWidth: resizingZoneWidth) containsPoint: evt position
	
	! !

!GLMPagerScrollSlidingBrick methodsFor: 'slider-scrolling' stamp: 'AliakseiSyrel 2/9/2015 11:35'!
scrollTo: aValue smooth: aBoolean
	"better to ignore smooth parameter,
	because animation is not neccessary"
	self scrollTo: aValue! !

!GLMPagerScrollSlidingBrick methodsFor: 'event-mouse' stamp: 'AliakseiSyrel 2/4/2015 15:12'!
handlesMouseOverDragging: evt
	^ true! !

!GLMPagerScrollSlidingBrick methodsFor: 'event-mouse' stamp: 'AliakseiSyrel 2/9/2015 11:50'!
handleMouseOver: anEvent
	super handleMouseOver: anEvent.
		
	isResizing | (self isLeftResizingZone: anEvent) | (self isRightResizingZone: anEvent)
		ifTrue: [ self setCursorToResizing: anEvent ]
		ifFalse: [ self setCursorToNormal: anEvent ].! !

!GLMPagerScrollSlidingBrick methodsFor: 'event-mouse' stamp: 'AliakseiSyrel 2/8/2015 19:11'!
mouseMove: evt

	isRightResizing
		ifTrue: [ self dragResizingRight: evt ]
		ifFalse: [
			isLeftResizing
				ifTrue: [ self dragResizingLeft: evt ]
				ifFalse: [ self dragSliding: evt ] ].! !

!GLMPagerScrollSlidingBrick methodsFor: 'slider-draging' stamp: 'AliakseiSyrel 2/8/2015 19:20'!
dragSliding: evt
	| newLeft value|
	
	newLeft := (evt position x - self owner globalBounds left - startDragX).
	value := self computeScrollValue: newLeft.
	
	self scrollTo: value.
	self synchronizeScrollTo: value.! !

!GLMPagerScrollSlidingBrick methodsFor: 'slider-draging' stamp: 'AliakseiSyrel 2/9/2015 12:52'!
dragResizingRight: anEvent
	| left right |

	left := self brickBounds left.
	right := anEvent position x - self owner globalBounds left - (startDragX - self computeWidth).
	right := (right max: (left + self pagerModel circleButtonSize)) min: self owner width.
	
	self setPosition: left@right
	! !

!GLMPagerScrollSlidingBrick methodsFor: 'slider-accessing' stamp: 'AliakseiSyrel 2/14/2015 12:39'!
leftPosition: anInteger

	leftPosition := anInteger! !

!GLMPagerScrollSlidingBrick methodsFor: 'slider-scrolling' stamp: 'AliakseiSyrel 2/9/2015 11:36'!
scrollTo: aFloat "Float - percentage/100"
	"scrolls to a specified float number which must be in interval [0.0, 1.0]"
	self moveLeft: (owner width - self width) * aFloat.! !

!GLMPagerScrollSlidingBrick methodsFor: 'slider-cursor' stamp: 'AliakseiSyrel 2/4/2015 15:12'!
resizeCursor

	^ Cursor resizeForEdge: #left! !

!GLMPagerScrollSlidingBrick methodsFor: 'slider-accessing' stamp: 'AliakseiSyrel 2/9/2015 14:28'!
pagerModel: anAdapter
	
	pagerModel := anAdapter.
			
	pagerModel announcer weak 
		subscribe: GLMNumberOfVisiblePagesChanged send: #onResized to: self.
		
	pagerModel announcer weak 
		subscribe: GLMPagerScrollPositionChanged send: #onPositionChanged: to: self.
		
	self width: self computeWidth! !

!GLMPagerScrollSlidingBrick methodsFor: 'slider-accessing' stamp: 'AliakseiSyrel 2/9/2015 11:43'!
pagerModel

	^ pagerModel! !

!GLMPagerScrollSlidingBrick methodsFor: 'announcement handling' stamp: 'AliakseiSyrel 2/9/2015 11:17'!
onResized

	self setWidthAfterResizing! !

!GLMPagerScrollSlidingBrick methodsFor: 'slider-scrolling' stamp: 'AliakseiSyrel 2/4/2015 15:12'!
synchronizeScrollTo: aValue

	pagerModel synchronizeScrollTo: aValue.! !

!GLMPagerScrollSlidingBrick methodsFor: 'slider-draging' stamp: 'AliakseiSyrel 2/9/2015 12:52'!
dragResizingLeft: anEvent
	| left right |
	
	right := self brickBounds right.
	left := anEvent position x - self owner globalBounds left - startDragX.
	left := (left max: 0) min: (right - self pagerModel circleButtonSize).
	
	self setPosition: left@right
	! !

!GLMPagerScrollSlidingBrick methodsFor: 'slider-scrolling' stamp: 'AliakseiSyrel 2/4/2015 15:12'!
scrollToPane: anIndex smooth: isSmooth

	self scrollTo: (pagerModel convertIndexToValue: anIndex) smooth: isSmooth.! !

!GLMPagerScrollSlidingBrick methodsFor: 'brick-layout-events' stamp: 'AliakseiSyrel 2/16/2015 12:01'!
onLayouted
	super onLayouted.
	"'slider onLayouted' logCr."
	self translateXTo: self leftPosition! !

!GLMPagerScrollSlidingBrick methodsFor: 'event-mouse' stamp: 'AliakseiSyrel 2/9/2015 11:50'!
mouseDown: evt

	startDragX := (evt position x - self globalBounds left).
	startResizingWidth := self width.
	
	isRightResizing := self isRightResizingZone: evt.
	
	"only one type of resizing is possible"
	isRightResizing
		ifFalse: [ isLeftResizing := self isLeftResizingZone: evt ]
		ifTrue: [ isLeftResizing := false ].

	isResizing := (isLeftResizing or: isRightResizing).
		
	super mouseDown: evt.! !

!GLMPagerScrollSlidingBrick methodsFor: 'event-mouse' stamp: 'AliakseiSyrel 2/4/2015 15:12'!
mouseLeave: evt

	self setCursorToNormal: evt.
	super mouseLeave: evt.! !

!GLMPagerScrollSlidingBrick methodsFor: 'brick-layout-events' stamp: 'AliakseiSyrel 2/16/2015 12:01'!
onChildrenLayouted
	super onChildrenLayouted.
	"'slider onChildrenLayouted' logCr."
	self translateXTo: self leftPosition! !

!GLMPagerScrollSlidingBrick methodsFor: 'slider-draging' stamp: 'AliakseiSyrel 2/14/2015 13:01'!
setPosition: aPoint
	"aPoint x - is my bounds left
	aPoint y - is my bounds right"
	"highly optimised to not update layout and do everything very clean"
	self changedWith: [ :b | b
			translateXTo: aPoint x;
			leftPosition: aPoint x;
			doNotLayoutDuring: [
				b width: aPoint y - aPoint x.
				b wrappedBounds markWidthClean ] ].
	
	self pagerModel notifyScrollerBoundsChanged: aPoint! !

!GLMPagerScrollSlidingBrick methodsFor: 'slider-testing' stamp: 'AliakseiSyrel 2/9/2015 11:50'!
isRightResizingZone: evt
	|resizingRectangle top left globalBounds|
	globalBounds := self globalBounds.
	
	top := globalBounds top.
	left := globalBounds right - resizingZoneWidth.
	
	resizingRectangle := left@top corner: globalBounds corner.
	
	^ resizingRectangle containsPoint: evt position.
	
	! !

!GLMPagerSynchronizeScrollAnnouncement methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/4/2014 14:18'!
value
	^ value! !

!GLMPagerSynchronizeScrollAnnouncement methodsFor: 'accessing' stamp: 'AliakseiSyrel 4/4/2014 14:18'!
value: anObject
	value := anObject! !

!GLMPagerWidgetThemer methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 5/26/2014 14:43'!
previewPaneStyleFor: aMorph

	aMorph borderColor: (Color lightGray)! !

!GLMPagerWidgetThemer methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/9/2015 14:29'!
defaultScrollButtonStyleFor: aButton

	aButton checkedIcon: GLMUIThemeExtraIcons glamorousGrayCircleEmpty.
	aButton checkedFocusedIcon: GLMUIThemeExtraIcons glamorousGrayCircle.
	
	aButton normalImage: GLMUIThemeExtraIcons glamorousGrayCircleEmpty.
	aButton selectedImage: GLMUIThemeExtraIcons glamorousGrayCircle.
	aButton checkedImage: aButton checkedIcon.! !

!GLMPagerWidgetThemer methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 5/28/2014 00:43'!
selectedPaneStyleFor: aMorph

	aMorph borderColor: (Color transparent)! !

!GLMPaginatedMorphTreeMorph methodsFor: 'stepping' stamp: 'AliakseiSyrel 3/24/2015 11:11'!
step

	self wantsSteps ifFalse: [ ^ self ].
	self window ifNil: [ ^ self ].
	self window isActive ifFalse: [ ^ self ].
	(self window boundsInWorld containsRect: self boundsInWorld) ifFalse: [ ^ self ].
	self model updateRoots.
	self updateList! !

!GLMPaginatedMorphTreeMorph methodsFor: 'testing' stamp: 'AndreiChis 3/16/2015 16:08'!
wantsSteps
	^ self model wantsSteps! !

!GLMPaginatedMorphTreeMorph methodsFor: 'stepping' stamp: 'AndreiChis 3/16/2015 15:58'!
stepTime
	^ self model stepTime! !

!GLMPaginatedResizableMorphTreeMorph methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 3/30/2015 13:54'!
resizeColumns
	| rowMorphsWidths |
	
	self columns size > 1 ifFalse: [ ^ self ].
	rowMorphsWidths := self rowMorphsWidths.
	self allNodeMorphs do: [ :node |
		node submorphs doWithIndex: [ :each :index | each hResizing: #rigid; width: (rowMorphsWidths at: index) ] ].
	self hHideScrollBar.! !

!GLMPaginatedResizableMorphTreeMorph methodsFor: 'events-processing' stamp: 'AliakseiSyrel 3/30/2015 13:51'!
toggleExpandedState: aMorph event: event
	super toggleExpandedState: aMorph event: event.
	self resizeColumns.! !

!GLMPaginatedResizableMorphTreeMorph methodsFor: 'updating' stamp: 'AliakseiSyrel 3/30/2015 13:51'!
updateColumnMorphs
	super updateColumnMorphs.
	self resizeColumns.
		
	! !

!GLMPane commentStamp: 'TudorGirba 2/15/2011 11:03'!
A GLMPane represents the "physical" building block of a browser. A pane is presented using a composite presentation (held in the presentations instance var).

It announces:
- GLMMatchingPresentationsChanged
- GLMPresentationsChanged

Instance Variables
	browser:		Browser
	lastActivePresentation:		Presentation
	name:		Symbol
	ports:		Collection of Ports
	presentations:		CompositePresentation!
!GLMPane methodsFor: 'private' stamp: 'AndreiChis 11/15/2012 14:19'!
portEvent: aPortEvent

	"we unregister all presentations from announcements because they will get replaced anyway"
	aPortEvent portName = #entity ifTrue: [ self unregisterFromAllAnnouncements ].
	self browser innerPortEvent: aPortEvent.
	self presentations outerPortEvent: aPortEvent! !

!GLMPane methodsFor: 'announcements' stamp: 'TudorGirba 7/10/2011 17:25'!
resetAnnouncer
	super resetAnnouncer.
	self presentations do: [ :each | each resetAnnouncer ]! !

!GLMPane methodsFor: 'accessing' stamp: 'TudorGirba 12/5/2011 12:54'!
matchingPresentations
	^ cachedMatchingPresentations := presentations matchingPresentations! !

!GLMPane methodsFor: 'accessing' stamp: 'TudorGirba 2/4/2011 15:36'!
port: aSymbol
	"returns the port with the given name"
	^ ports detect: [ :each | each name = aSymbol ] ifNone: [
		ports addLast: (
			(self class portClass new) 
						pane: self; 
						name: aSymbol; 
						yourself) ]! !

!GLMPane methodsFor: 'initialization' stamp: 'jorge.ressia 6/3/2009 09:10'!
defaultName

	^'undefined'! !

!GLMPane methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 7/4/2014 08:06'!
gtInspectorPortsIn: composite
	<gtInspectorPresentationOrder: 30>
	^ composite table
		title: 'Ports';
		display: [ self ports ];
		column: 'Port' evaluated: [ :each | each name ];
		column: 'Value' evaluated: [ :each | each value asString ]! !

!GLMPane methodsFor: 'accessing' stamp: 'tg 1/12/2010 07:36'!
ports
	^ ports! !

!GLMPane methodsFor: 'updating' stamp: 'tg 1/31/2010 00:26'!
unregisterFromAllAnnouncements
	self presentations unregisterFromAllAnnouncements! !

!GLMPane methodsFor: 'enumerating' stamp: 'TudorGirba 7/9/2011 19:45'!
withAllPanesAndPresentationsDo: aBlock
	aBlock value: self.
	self presentations withAllPanesAndPresentationsDo: aBlock! !

!GLMPane methodsFor: 'initialization' stamp: 'tg 5/25/2010 14:12'!
initialize
	super initialize.
	ports := OrderedCollection new.
	presentations := GLMCompositePresentation new pane: self; yourself! !

!GLMPane methodsFor: 'accessing' stamp: 'TudorGirba 7/21/2011 13:43'!
clearIn: aContext 
	self notingPresentationChangeDo: [
		self presentations clear.
		self ports do: [:each | each value: nil in: aContext copy ]]! !

!GLMPane methodsFor: 'testing' stamp: ' 4/5/09 22:18'!
hasBrowser 
	 
	^self browser isNil not! !

!GLMPane methodsFor: 'printing' stamp: 'DamienCassou 7/3/2011 19:56'!
printOn: aStream
	super printOn: aStream.
	aStream
		nextPut: $(;
		nextPutAll: self identityHash printString;
		space;
		nextPutAll: self name;
		nextPut: $)! !

!GLMPane methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
browser 
	 
	^browser! !

!GLMPane methodsFor: 'testing' stamp: 'TudorGirba 1/28/2011 00:13'!
isLastActivePresentation: aPresentation
	^ self lastActivePresentation notNil and: [ 
		aPresentation title = self lastActivePresentation title ]! !

!GLMPane methodsFor: 'private' stamp: 'tg 12/30/2009 18:50'!
isAllowedToNotePresentationsChanged
	^ allowedToNotePresentationsChanged ifNil: [allowedToNotePresentationsChanged := true ]! !

!GLMPane methodsFor: 'converting' stamp: ' 4/5/09 22:18'!
asGlamorousPane 
	 
	^self! !

!GLMPane methodsFor: 'accessing' stamp: 'tg 10/18/2009 19:29'!
lastActivePresentation
	^ lastActivePresentation! !

!GLMPane methodsFor: 'accessing' stamp: 'TudorGirba 12/5/2011 12:55'!
cachedMatchingPresentations
	^ cachedMatchingPresentations ifNil: [ cachedMatchingPresentations := self matchingPresentations ]! !

!GLMPane methodsFor: 'accessing' stamp: 'AndreiChis 6/23/2013 21:46'!
presentations: aCompositePresentation
	self notingPresentationChangeDo: [
		presentations pane: nil.
		presentations resetAnnouncer.
		aCompositePresentation pane: self.
		presentations := aCompositePresentation.
		presentations initializePresentation ]! !

!GLMPane methodsFor: 'enumerating' stamp: 'TudorGirba 7/10/2011 01:19'!
withAllPanes
	| result |
	result := OrderedCollection new.
	self withAllPanesAndPresentationsDo: [:each |
		(each isKindOf: GLMPane) ifTrue: [ result add: each ]].
	^ result! !

!GLMPane methodsFor: 'private' stamp: 'TudorGirba 12/5/2011 12:54'!
notingPresentationChangeDo: aBlock
	"Executes aBlock. If during the execution of the block one of my presentations change, I will emit announces. I also take care of not entering an infinite loop."
	| oldPresentations oldMatchingPresentations | 
	self isAllowedToNotePresentationsChanged ifFalse: [
		aBlock value.
		^ self].
	"this should create a context and then check for it before announcing.
	Like this we can deal with the problem of announcing the same announcement twice"
	allowedToNotePresentationsChanged := false.
	
	oldPresentations := presentations presentations copy. 
	oldMatchingPresentations := self cachedMatchingPresentations.
	aBlock value. 
	presentations presentations  ~= oldPresentations ifTrue: [
		self announce: ((GLMPresentationsChanged new) 
						pane: self; 
						oldPresentations: oldPresentations; 
						yourself)]. 
	self matchingPresentations ~= oldMatchingPresentations ifTrue: [
		self announce: ((GLMMatchingPresentationsChanged new) 
						pane: self; 
						oldMatchingPresentations: oldMatchingPresentations; 
						yourself)].
	allowedToNotePresentationsChanged := true.
! !

!GLMPane methodsFor: 'updating' stamp: 'AndreiChis 10/5/2014 21:26'!
updateToolbar

	self announce: (GLMPresentationToolbarUpdated new presentation: self presentations)! !

!GLMPane methodsFor: 'updating' stamp: 'TudorGirba 12/5/2011 12:57'!
update 
	self notingPresentationChangeDo: [
		"nothing in particular. 
		just make sure that matching presentations are recomputed"].
	self presentations do: [ :each | each update ]! !

!GLMPane methodsFor: 'accessing' stamp: 'tg 12/29/2009 23:19'!
browser: aBrowser
	browser := aBrowser! !

!GLMPane methodsFor: 'initialization' stamp: 'jorge.ressia 6/3/2009 09:10'!
initializeIn: aBrowser 
	
	self initializeNamed: self defaultName in: aBrowser! !

!GLMPane methodsFor: 'accessing' stamp: 'TudorGirba 12/5/2011 12:54'!
cachedMatchingPresentations: anObject
	^ cachedMatchingPresentations := anObject! !

!GLMPane methodsFor: 'accessing' stamp: 'tg 1/11/2010 18:06'!
presentations
	^ presentations! !

!GLMPane methodsFor: 'accessing' stamp: 'tg 1/12/2010 07:30'!
name: aString
	name := aString! !

!GLMPane methodsFor: 'accessing' stamp: 'tg 4/11/2010 23:28'!
addPresentation: aPresentation
	self addPresentations: (OrderedCollection with: aPresentation)! !

!GLMPane methodsFor: 'accessing' stamp: 'tg 5/25/2010 14:40'!
addPresentationSilently: each
	^ presentations
		add:
			(each
				pane: self;
				yourself)! !

!GLMPane methodsFor: 'copying' stamp: 'TudorGirba 7/11/2011 11:17'!
postCopy
	| newPort |
	super postCopy.
	self flag: 'self unregisterFromAllAnnouncements ?'.
	presentations := presentations copy.
	ports := ports collect: [:each | 
		newPort := each copy.
		newPort pane: self.
		self flag: 'what about value?'.
		newPort ]! !

!GLMPane methodsFor: 'rendering' stamp: ' 4/5/09 22:18'!
renderGlamorouslyOn: aRenderer 
	 
	^aRenderer renderPane: self! !

!GLMPane methodsFor: 'accessing' stamp: 'tg 5/25/2010 14:40'!
addPresentations: aCollection
	self notingPresentationChangeDo: [ 
		aCollection do: [ :each | self addPresentationSilently: each ] ]! !

!GLMPane methodsFor: 'enumerating' stamp: 'TudorGirba 7/9/2011 20:06'!
withAllPresentations
	| result |
	result := OrderedCollection new.
	self withAllPanesAndPresentationsDo: [:each |
		(each isKindOf: GLMPresentation) ifTrue: [ result add: each ]].
	^ result! !

!GLMPane methodsFor: 'accessing' stamp: 'TudorGirba 2/13/2014 19:00'!
lastActivePresentation: aPresentation
	(self port: #activePresentation) value: aPresentation.
	lastActivePresentation := aPresentation.
	self browser lastActivePresentation: aPresentation! !

!GLMPane methodsFor: 'initialization' stamp: 'jorge.ressia 6/2/2009 23:43'!
initializeNamed: aString 
	self initializeNamed: aString in: GLMNoBrowser new  ! !

!GLMPane methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
name 
	 
	^name! !

!GLMPane methodsFor: 'initialization' stamp: 'tg 1/11/2010 21:59'!
initializeNamed: aString in: aBrowser 
	self initialize.
	name := aString ifNil: [ self defaultName ].
	browser := aBrowser! !

!GLMPane class methodsFor: 'instance creation' stamp: 'jorge.ressia 6/3/2009 09:09'!
in: aBrowser 
	
	^self new initializeIn: aBrowser! !

!GLMPane class methodsFor: 'instance creation' stamp: 'jorge.ressia 6/2/2009 20:28'!
named: aString in: aBrowser

	^self new initializeNamed: aString in: aBrowser 
! !

!GLMPane class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:03'!
gtExampleBasic
	<gtExample>
	^ self named: 'Basic'! !

!GLMPane class methodsFor: 'private' stamp: ' 4/5/09 22:18'!
portClass 
	 
	^GLMPanePort! !

!GLMPane class methodsFor: 'instance creation' stamp: 'jorge.ressia 6/2/2009 23:42'!
named: aString 
	^self new initializeNamed: aString! !

!GLMPaneAdded commentStamp: 'TorstenBergmann 3/10/2015 21:58'!
A new pane was added!
!GLMPaneAnnouncement commentStamp: 'TudorGirba 2/4/2011 21:24'!
These announcements are used by the browser to communicate with the renderer whenever the panes configuration is modified in some way.

Instance Variables:
	pane	<GLMPane>
	browser	<GLMBrowser>
	position	<Integer>!
!GLMPaneAnnouncement methodsFor: 'accessing' stamp: 'tg 1/18/2010 11:06'!
position 
	 
	^position! !

!GLMPaneAnnouncement methodsFor: 'accessing' stamp: 'tg 1/18/2010 11:06'!
pane: anObject 
	 
	pane := anObject! !

!GLMPaneAnnouncement methodsFor: 'accessing' stamp: 'tg 1/18/2010 11:06'!
position: anObject 
	 
	position := anObject! !

!GLMPaneAnnouncement methodsFor: 'accessing' stamp: 'tg 1/18/2010 11:06'!
pane 
	 
	^pane! !

!GLMPaneAnnouncement methodsFor: 'accessing' stamp: 'tg 1/18/2010 11:06'!
browser: anObject 
	 
	browser := anObject! !

!GLMPaneAnnouncement methodsFor: 'accessing' stamp: 'tg 1/18/2010 11:06'!
browser 
	 
	^browser! !

!GLMPaneAnnouncement class methodsFor: 'instance creation' stamp: 'tg 1/18/2010 11:08'!
pane: aPane atPosition: anInteger inBrowser: aBrowser 
	 
	^(self new) 
		pane: aPane; 
		position: anInteger; 
		browser: aBrowser; 
		yourself! !

!GLMPanePort commentStamp: '<historical>'!
A port that belongs to a pane.

Bound ports have a few special characteristics in comparison to their superclass. For one, they don't just assign a value to themselves using #value: but rather generate a transmission that set the value so that the pane can handle the transmission and forward it to other ports if necessary, depending on the policy of the containing browser.!
!GLMPanePort methodsFor: 'accessing' stamp: 'TudorGirba 4/18/2011 22:30'!
resetValue
	| context |
	context := GLMTransmissionContext new.
	context addPort: self.
	self changeValueTo: nil in: context.! !

!GLMPanePort methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
value 
	 
	^value! !

!GLMPanePort methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
pane 
	 
	^pane! !

!GLMPanePort methodsFor: 'accessing' stamp: 'jre 9/19/2009 08:16'!
printOn: aStream 
	 
	aStream 
		nextPutAll: 'Port (pane='; 
		nextPutAll: self pane name printString; 
		nextPutAll: ' name='; 
		nextPutAll: self name printString; 
		nextPutAll: ' value='; 
		nextPutAll: self value printString; 
		nextPut: $)! !

!GLMPanePort methodsFor: 'copying' stamp: 'tg 12/30/2009 03:04'!
copyAccordingToPaneMapping: newPanesMapping inNewBrowser: anotherBrowser
	^ (newPanesMapping at: self pane) port: self name! !

!GLMPanePort methodsFor: 'accessing' stamp: 'TudorGirba 4/18/2011 19:43'!
silentValue: anObject
	value := anObject! !

!GLMPanePort methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
pane: aPane 
	 
	pane := aPane! !

!GLMPanePort methodsFor: 'accessing' stamp: 'jorge.ressia 5/30/2009 14:05'!
basicValue: anObject
	value := anObject. 
	! !

!GLMPanePort methodsFor: 'accessing' stamp: 'tg 12/17/2009 03:12'!
receive: aTransmission in: aContext
	self value: aTransmission value in: aContext! !

!GLMPanePort methodsFor: 'accessing' stamp: 'TudorGirba 4/18/2011 19:43'!
changeValueTo: anObject in: aTransmissionContext
	| oldValue | 
	oldValue := self value.
	self pane notingPresentationChangeDo: [
		self silentValue: anObject.  
		self pane portEvent: 
					(GLMPortEvent 
						on: self
						previouslyValued: oldValue
						in: aTransmissionContext) ]! !

!GLMPanePort methodsFor: 'accessing' stamp: 'tg 2/17/2010 22:51'!
value: anObject in: aContext
	(self validate: anObject) ifFalse: [^ self].
	aContext addPort: self.
	self changeValueTo: anObject in: aContext.! !

!GLMPaneRemoved commentStamp: 'TorstenBergmann 3/10/2015 21:58'!
A new pane was removed!
!GLMPaneRemoved class methodsFor: 'instance creation' stamp: ' 4/5/09 22:18'!
pane: aPane fromBrowser: aBrowser 
	 
	^(self new) 
		pane: aPane; 
		browser: aBrowser; 
		yourself! !

!GLMPaneReplaced commentStamp: 'TorstenBergmann 3/10/2015 21:59'!
An old pane was replaced with a new one

Instance Variables
	newPane:		<Object>
	oldPane:		<Object>

newPane
	- the new pane
	
oldPane
	- the old pane!
!GLMPaneReplaced methodsFor: 'accessing' stamp: 'tg 8/22/2010 21:36'!
newPane
	^ newPane! !

!GLMPaneReplaced methodsFor: 'accessing' stamp: 'tg 8/22/2010 21:36'!
newPane: anObject
	newPane := anObject! !

!GLMPaneReplaced methodsFor: 'accessing' stamp: 'tg 8/22/2010 21:36'!
oldPane
	^ oldPane! !

!GLMPaneReplaced methodsFor: 'accessing' stamp: 'tg 8/22/2010 21:36'!
oldPane: anObject
	oldPane := anObject! !

!GLMPaneReplaced class methodsFor: 'instance creation' stamp: 'tg 8/22/2010 21:35'!
oldPane: oldPane newPane: newPane fromBrowser: aBrowser
	^ self new 
		oldPane: oldPane;
		newPane: newPane;
		browser: aBrowser! !

!GLMPaneScroller methodsFor: 'accessing' stamp: 'TudorGirba 4/16/2014 23:52'!
initialColorInSystemWindow: aSystemWindow
	"Answer the colour the receiver should be when added to a SystemWindow."

	^Color transparent! !

!GLMPaneScroller methodsFor: 'scrolling' stamp: 'david_roethlisberger 3/18/2009 14:26'!
setScrollDeltas
	| range interval value |
	transform hasSubmorphs ifFalse: [scrollBar interval: 1.0. ^ self].
	range := self leftoverScrollRange.
	range = 0 ifTrue: [^ scrollBar interval: 1.0; setValue: 0].
	interval := ((self innerBounds width) / self totalScrollRange) asFloat.
	value := (transform offset x / range min: 1.0) asFloat.
	scrollBar interval: interval.
	scrollBar setValue: value.! !

!GLMPaneScroller methodsFor: 'layout' stamp: 'VincentBlondeau 2/14/2014 17:20'!
scrollBarHeight
	^ self theme scrollbarThickness! !

!GLMPaneScroller methodsFor: 'layout' stamp: 'david_roethlisberger 3/18/2009 14:21'!
bounds: aRectangle
	super bounds: aRectangle.
	self layoutWidgets.
	self layoutPanes.
	self setScrollDeltas.
! !

!GLMPaneScroller methodsFor: 'configuration' stamp: 'TudorGirba 1/26/2011 07:14'!
maxPanes
	^ maxPanes! !

!GLMPaneScroller methodsFor: 'scrolling' stamp: 'david_roethlisberger 3/18/2009 14:25'!
hideOrShowScrollBar
	self isScrollable ifTrue: [self showScrollBar] ifFalse: [self hideScrollBar]! !

!GLMPaneScroller methodsFor: 'layout' stamp: 'david_roethlisberger 3/18/2009 14:22'!
totalPaneWidth
	^ self innerBounds width - ((self sizing - 1) * self separatorWidth)! !

!GLMPaneScroller methodsFor: 'scrolling' stamp: 'david_roethlisberger 3/18/2009 14:26'!
totalScrollRange
	| submorphBounds |
	submorphBounds := transform localSubmorphBounds ifNil: [^ 0].
	^ submorphBounds width
! !

!GLMPaneScroller methodsFor: 'scrolling' stamp: ''!
adoptPaneColor: aColor
	super adoptPaneColor: aColor.
	scrollBar adoptPaneColor: aColor! !

!GLMPaneScroller methodsFor: 'layout' stamp: 'david_roethlisberger 3/18/2009 14:21'!
innerBounds
	| rect |
	rect := super innerBounds.
	^ self scrollBarIsVisible
		ifTrue: [rect withHeight: rect height - self scrollBarHeight - 1]
		ifFalse: [rect]! !

!GLMPaneScroller methodsFor: 'updating' stamp: 'david_roethlisberger 3/18/2009 14:27'!
updateSizing
	| old |
	old := sizing.
	self basicUpdateSizing.
	sizing = old ifFalse: [self layoutPanes].
	^sizing! !

!GLMPaneScroller methodsFor: 'initialization' stamp: 'TudorGirba 11/30/2012 14:26'!
initialize
	super initialize.
	self 
		color: Color transparent;
		borderWidth: 0;
		vResizing: #spaceFill;
		hResizing: #spaceFill.
	self 
		initializeTransform;
		initializeScrollbar.
	paneCount := 0.
	maxPanes := 2.! !

!GLMPaneScroller methodsFor: 'private' stamp: 'jorge.ressia 5/25/2009 16:25'!
basicUpdateSizing
	sizing := (self paneCount min: self maxPanes) max: 1! !

!GLMPaneScroller methodsFor: 'scrolling' stamp: 'david_roethlisberger 3/18/2009 14:25'!
isScrollable
	^ self leftoverScrollRange > 0! !

!GLMPaneScroller methodsFor: 'layout' stamp: 'david_roethlisberger 3/18/2009 14:43'!
adjustPaneHeight
	"This gets called after the scrollbar has been shown or hidden, to move the bottom
	of the panes to the right place."
	
	transform bounds: self innerBounds.
	transform submorphsDo: [:m | m bounds: (m bounds withHeight: self paneHeight)]! !

!GLMPaneScroller methodsFor: 'panes' stamp: 'tg 8/22/2010 22:40'!
popAndReplacePane: aMorph	
	transform removeMorph: transform lastSubmorph. "one for the separator"
	transform submorphs isEmpty
		ifFalse: [ transform removeMorph: transform lastSubmorph ].
	paneCount := paneCount - 1.	
	
	aMorph 
		borderWidth: 0;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		layoutInset: 0.
	transform hasSubmorphs 
		ifTrue: [ transform addMorphBack: self separator ].
	transform addMorphBack: (aMorph adoptPaneColor: self paneColor).
	paneCount := paneCount + 1.
	self updatePanes! !

!GLMPaneScroller methodsFor: 'panes' stamp: ''!
pushPane: aMorph	
	aMorph 
		borderWidth: 0;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		layoutInset: 0.
	transform hasSubmorphs 
		ifTrue: [ transform addMorphBack: self separator ].
	transform addMorphBack: (aMorph adoptPaneColor: self paneColor).
	paneCount := paneCount + 1.
	self updatePanes! !

!GLMPaneScroller methodsFor: 'initialization' stamp: 'TudorGirba 2/17/2012 07:47'!
initializeScrollbar
	scrollBar := ScrollBar new 
		model: self;
		setValueSelector: #scrollBarValue:;
		yourself.
	scrollBar 
		borderWidth: 0;
		borderColor: #inset;
		height: self scrollBarHeight.
	self resizeScrollBar.
! !

!GLMPaneScroller methodsFor: 'scrolling' stamp: 'david_roethlisberger 3/18/2009 14:26'!
showScrollBar
	self scrollBarIsVisible ifTrue: [^ self].
	self resizeScrollBar.
	self addMorphFront: scrollBar.
	self adjustPaneHeight.
	! !

!GLMPaneScroller methodsFor: 'layout' stamp: ''!
layoutWidgets
	| inner outer |
	outer := super innerBounds.
	inner := self innerBounds.
	transform bounds: inner.
	scrollBar bounds: ((inner left @ inner bottom)
						corner: outer bottomRight)! !

!GLMPaneScroller methodsFor: 'configuration' stamp: 'TudorGirba 1/26/2011 07:14'!
maxPanes: anInteger
	maxPanes := anInteger! !

!GLMPaneScroller methodsFor: 'input events' stamp: ''!
scrollBarMenuButtonPressed: anObject! !

!GLMPaneScroller methodsFor: 'updating' stamp: 'david_roethlisberger 3/18/2009 14:27'!
scrollBarValue: value
	transform hasSubmorphs ifFalse: [^ self].
	transform offset: (self leftoverScrollRange * value) rounded @ 0.! !

!GLMPaneScroller methodsFor: 'layout' stamp: 'TudorGirba 5/20/2013 06:37'!
separatorWidth
	^ 20! !

!GLMPaneScroller methodsFor: 'layout' stamp: 'david_roethlisberger 3/18/2009 14:21'!
layoutPanes
	| widths rect |
	widths := self computeMorphWidths.
	rect := 0@0 extent: (0 @ self paneHeight).
	transform submorphs 
					with: widths 
					do: [:m :w | 
						rect := rect withWidth: w.
						m bounds: rect.
						rect := rect translateBy: (w@0)]
						
! !

!GLMPaneScroller methodsFor: 'panes' stamp: 'TudorGirba 3/3/2013 21:42'!
separator
	^ "BorderedSubpaneDividerMorph new 
		vertical;
		adoptPaneColor: self paneColor;
		yourself"
		
	GLMMorphic emptyMorph! !

!GLMPaneScroller methodsFor: 'panes' stamp: ''!
popPane
	transform removeMorph: transform lastSubmorph. "one for the separator"
	transform submorphs isEmpty
		ifFalse: [ transform removeMorph: transform lastSubmorph ].
	paneCount := paneCount - 1.
	self updatePanes.! !

!GLMPaneScroller methodsFor: 'scrolling' stamp: 'david_roethlisberger 3/18/2009 14:25'!
scrollBarIsVisible
	^ submorphs includes: scrollBar! !

!GLMPaneScroller methodsFor: 'layout' stamp: 'jorge.ressia 5/25/2009 16:18'!
paneCount
	^ paneCount! !

!GLMPaneScroller methodsFor: 'initialization' stamp: 'david_roethlisberger 3/18/2009 14:26'!
initializeTransform
	transform := TransformMorph new.
	transform
		color: Color transparent;
		borderWidth: 0;
		vResizing: #spaceFill;
		hResizing: #spaceFill;
		disableTableLayout;
		bounds: super innerBounds.
	self addMorphBack: transform.
! !

!GLMPaneScroller methodsFor: 'layout' stamp: 'david_roethlisberger 3/18/2009 14:21'!
computeMorphWidths
	| paneWidths widths |
	paneWidths := self paneWidthsToFit: self totalPaneWidth.
	widths := OrderedCollection new.
	paneWidths do: [:w | widths add: w] separatedBy: [widths add: self separatorWidth].
	^ widths asArray
! !

!GLMPaneScroller methodsFor: 'layout' stamp: 'david_roethlisberger 3/18/2009 14:22'!
paneHeight
	^ transform bounds height! !

!GLMPaneScroller methodsFor: 'scrolling' stamp: 'david_roethlisberger 3/18/2009 14:25'!
hideScrollBar
	self removeMorph: scrollBar.
	self adjustPaneHeight.! !

!GLMPaneScroller methodsFor: 'layout' stamp: 'david_roethlisberger 3/18/2009 14:22'!
paneWidthsToFit: limit
	| padded |
	padded := Array new: self paneCount.
	padded atAllPut: (limit / self sizing) floor.
	(1 to: limit - padded sum) do: [:i | padded at: i put: (padded at: i) + 1].
	^ padded
	
	! !

!GLMPaneScroller methodsFor: 'layout' stamp: ''!
resizeScrollBar
	| inner outer |
	outer := super innerBounds.
	inner := outer withHeight: outer height - self scrollBarHeight.
	scrollBar bounds: ((inner left @ inner bottom) corner: outer bottomRight)! !

!GLMPaneScroller methodsFor: 'scrolling' stamp: 'TudorGirba 2/17/2012 07:48'!
scrollToRight
"	(transform submorphs size + 1) / 2 > paneCount ifTrue: [ 
"		scrollBar glmAnimateValue: 1.0 duration: 200 "]"! !

!GLMPaneScroller methodsFor: 'updating' stamp: 'jorge.ressia 5/25/2009 16:40'!
updatePanes
	self basicUpdateSizing.
	self layoutPanes.
	self hideOrShowScrollBar.
	self setScrollDeltas.
	self scrollToRight! !

!GLMPaneScroller methodsFor: 'scrolling' stamp: 'david_roethlisberger 3/18/2009 14:25'!
leftoverScrollRange
	^ (self totalScrollRange - self innerBounds width roundTo: self scrollDeltaWidth) max: 0
! !

!GLMPaneScroller methodsFor: 'scrolling' stamp: 'david_roethlisberger 3/18/2009 14:25'!
scrollDeltaWidth
	^ 1! !

!GLMPaneScroller methodsFor: 'accessing' stamp: 'david_roethlisberger 3/18/2009 14:27'!
sizing
	^ sizing ifNil: [self updateSizing]! !

!GLMPaneSelected commentStamp: 'TorstenBergmann 3/10/2015 21:59'!
A pane was selected!
!GLMPaneTest methodsFor: 'tests' stamp: 'lr 6/4/2010 13:53'!
testValidate
	| pane presentation |
	pane := GLMPane named: 'test'. 
	presentation := GLMListPresentation new.
	pane addPresentation: presentation.
	presentation entity: (OrderedCollection with: 1 with: 2).
	presentation shouldValidate: true.
	self assert: ((pane port: #selection) validate: 1).
	self assert: ((pane port: #selection) validate: 2).
	self deny: ((pane port: #selection) validate: 5)
! !

!GLMPaneTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPortsInmmutability
	| aPane ports |
	aPane := GLMPane in: 1.
	self assert: aPane ports isEmpty.
	ports := aPane ports.
	ports add: 1.
	self assert: ports size equals: 1.
	self assert: aPane ports isEmpty! !

!GLMPaneTest methodsFor: 'tests' stamp: 'tg 11/12/2009 22:01'!
testDefaultPortValue
	| pane |
	pane := GLMPane named: 'test'.
	self assert: (pane port: #somePort) value isNil! !

!GLMPaneTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPresentationAndBrowserConditions
	| pane presentation1 presentation2 presentation3 |
	pane := GLMPane named: 'test'.
	presentation1 := GLMExplicitBrowser new condition: [ :first :second | first = 1 and: [ second = 2 ] ].
	presentation2 := GLMTabulator new condition: [ :first | first = #foo ].
	presentation3 := GLMExplicitBrowser new useExplicitNotNil.
	pane addPresentation: presentation1.
	pane addPresentation: presentation2.
	pane addPresentation: presentation3.
	(pane port: #entity) value: (GLMMultiValue withAll: #(1 2)).
	self assert: pane matchingPresentations size equals: 2.
	self assert: pane matchingPresentations first == presentation1.
	self assert: pane matchingPresentations last == presentation3.
	(pane port: #entity) value: (GLMMultiValue withAll: #(#foo 2)).
	self assert: pane matchingPresentations size equals: 2.
	self assert: pane matchingPresentations first == presentation2.
	self assert: pane matchingPresentations last == presentation3.
	(pane port: #entity) value: (GLMMultiValue withAll: #(nil 2)).
	self assert: pane matchingPresentations size equals: 1! !

!GLMPaneTest methodsFor: 'tests' stamp: 'TudorGirba 7/9/2011 19:57'!
testDefaultCompositePresentation

 	| pane |
	pane := GLMPane named: 'test'. 
	self assert: (pane presentations isKindOf: GLMCompositePresentation)! !

!GLMPaneTest methodsFor: 'tests' stamp: 'tg 1/12/2010 13:53'!
expectedFailures
	^ #(testPortsInmmutability testPresentationsInmmutability)! !

!GLMPaneTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testIn
	| aPane |
	aPane := GLMPane in: 1.
	self assert: aPane name equals: aPane defaultName.
	self assert: aPane browser equals: 1.
	self assert: aPane ports isEmpty.
	self assert: aPane presentations isEmpty! !

!GLMPaneTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testNamedIn
	| aPane |
	aPane := GLMPane named: 1 in: 2.
	self assert: aPane name equals: 1.
	self assert: aPane browser equals: 2.
	self assert: aPane ports isEmpty.
	self assert: aPane presentations isEmpty! !

!GLMPaneTest methodsFor: 'tests' stamp: 'TudorGirba 12/5/2011 13:29'!
testCachedMatchingPresentations
	| aPane cachedMatchingPresentations |
	aPane := GLMPane in: nil.
	cachedMatchingPresentations := aPane cachedMatchingPresentations.
	self assert: cachedMatchingPresentations == aPane cachedMatchingPresentations.
	aPane matchingPresentations "this should refresh cached matching presentations".
	self assert: cachedMatchingPresentations ~~ aPane cachedMatchingPresentations! !

!GLMPaneTest methodsFor: 'tests' stamp: 'lr 6/4/2010 13:53'!
testDefaultValidate
	| pane |
	pane := GLMPane named: 'test'. 
	self assert: ((pane port: #selection) validate: 5)
! !

!GLMPaneTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPorts
	| pane port |
	pane := GLMPane named: 'test'.
	self assert: pane ports isEmpty.
	port := pane port: #foo.
	self assert: pane ports size equals: 1.
	self assert: pane ports first == port.
	self assert: (pane port: #foo) == port! !

!GLMPaneTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPresentationConditions
	| pane presentation1 presentation2 presentation3 |
	pane := GLMPane named: 'test'.
	presentation1 := GLMPresentation new condition: [ :first :second | first = 1 and: [ second = 2 ] ].
	presentation2 := GLMPresentation new condition: [ :first | first = #foo ].
	presentation3 := GLMPresentation new useExplicitNotNil.
	pane addPresentation: presentation1.
	pane addPresentation: presentation2.
	pane addPresentation: presentation3.
	(pane port: #entity) value: (GLMMultiValue withAll: #(1 2)).
	self assert: pane matchingPresentations size equals: 2.
	self assert: pane matchingPresentations first == presentation1.
	self assert: pane matchingPresentations last == presentation3.
	(pane port: #entity) value: (GLMMultiValue withAll: #(#foo 2)).
	self assert: pane matchingPresentations size equals: 2.
	self assert: pane matchingPresentations first == presentation2.
	self assert: pane matchingPresentations last == presentation3.
	(pane port: #entity) value: (GLMMultiValue withAll: #(nil 2)).
	self assert: pane matchingPresentations size equals: 1! !

!GLMPaneTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPresentations
	| pane presentation announcement |
	pane := GLMPane named: 'test'.
	presentation := GLMPresentation new.
	self assert: pane presentations isEmpty.
	announcement := nil.
	pane when: GLMPresentationsChanged do: [ :ann | announcement := ann ].
	pane addPresentation: presentation.
	self assert: pane presentations size equals: 1.
	self assert: pane presentations first == presentation.
	self assert: presentation pane == pane.
	self assert: announcement notNil! !

!GLMPaneTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPresentationsInmmutability
	| aPane presentations |
	aPane := GLMPane in: 1.
	self assert: aPane presentations isEmpty.
	presentations := aPane presentations.
	presentations add: 1.
	self assert: presentations size equals: 1.
	self assert: aPane presentations isEmpty! !

!GLMPaneTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testCopyAnnouncementsDoNotRaise
	| pane newPane |
	pane := GLMPane new.
	pane when: GLMPresentationsChanged do: [ :ann | self fail ].
	self assert: pane numberOfSubscriptions equals: 1.
	newPane := pane copy.
	newPane announce: GLMPresentationsChanged.
	self assert: newPane numberOfSubscriptions equals: 0! !

!GLMPaneTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testSimplePresentations
	| pane presentation announcement |
	pane := GLMPane named: 'test'.
	presentation := GLMPresentation new.
	self assert: pane presentations isEmpty.
	announcement := nil.
	pane when: GLMPresentationsChanged do: [ :ann | announcement := ann ].
	pane addPresentation: presentation.
	self assert: pane presentations size equals: 1.
	self assert: pane presentations first == presentation.
	self assert: presentation pane == pane.
	self assert: announcement notNil! !

!GLMPaneTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testAllRecursivePresentations
	| browser |
	browser := GLMTabulator new.
	browser column: #one.
	(browser transmit)
		to: #one;
		andShow: [ :a | a text ].
	browser startOn: 42.
	self assert: browser panes first withAllPresentations size equals: 2.
	self assert: browser pane withAllPresentations size equals: 4! !

!GLMPaneTest methodsFor: 'tests' stamp: 'tg 1/5/2010 21:07'!
testDefaultPresentations
	| pane |
	pane := GLMPane named: 'test'.
	self assert: (pane presentations isKindOf: GLMCompositePresentation)! !

!GLMPaneTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testCopyAnnouncements
	| pane newPane |
	pane := GLMPane new.
	pane when: GLMPresentationsChanged do: [ :ann | self fail ].
	self assert: pane numberOfSubscriptions equals: 1.
	newPane := pane copy.
	newPane announce: GLMPresentationsChanged.
	self assert: newPane numberOfSubscriptions equals: 0! !

!GLMPaneTest methodsFor: 'tests' stamp: 'TudorGirba 7/11/2011 11:11'!
testCopyNotTheSameRegistry

	| pane newPane |
	pane := GLMPane new.
	newPane := pane copy.
	self assert: pane glmSubscriptions ~~ newPane glmSubscriptions! !

!GLMPaneTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testNamed
	| aPane |
	aPane := GLMPane named: 1.
	self assert: aPane name equals: 1.
	self assert: aPane browser equals: GLMNoBrowser new.
	self assert: aPane ports isEmpty.
	self assert: aPane presentations isEmpty! !

!GLMPaneTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testCreation
	| aPane |
	aPane := GLMPane named: 1 in: 2.
	self assert: aPane name equals: 1.
	self assert: aPane browser equals: 2! !

!GLMPharoMethodPresentation commentStamp: 'AndreiChis 10/1/2014 13:52'!
I provide support for displaying a Smalltalk method.

self pharoMethodPresentationExample


!
!GLMPharoMethodPresentation methodsFor: 'accessing' stamp: 'AndreiChis 4/21/2014 18:57'!
smalltalkClass: aBlock
	"aBlock takes as parameters the entity objects and 
	its evaluation is expected to produce a Smalltalk class"
	highlightSmalltalkContext := aBlock.! !

!GLMPharoMethodPresentation methodsFor: 'accessing' stamp: 'AndreiChis 4/21/2014 18:57'!
highlightSmalltalkContext
	^ highlightSmalltalkContext isNil 
		ifTrue: [nil] 
		ifFalse: [highlightSmalltalkContext glamourValue: self entity]! !

!GLMPharoMethodPresentation methodsFor: 'rendering' stamp: 'TudorGirba 5/17/2014 09:19'!
renderGlamorouslyOn: aRenderer 
	self registerAnnouncements.
	^ aRenderer renderPharoMethodPresentation: self! !

!GLMPharoMethodPresentation class methodsFor: 'examples' stamp: 'AndreiChis 10/1/2014 13:51'!
pharoMethodPresentationExample
	"
	self pharoMethodPresentationExample
	"
	
	| browser |
	browser := GLMTabulator new.
	browser
		row: #r1;
		row: #r2.
	browser transmit
		to: #r1;
		andShow: [ :aComposite | aComposite pharoMethod display: [ :method | method sourceCode ] ].
	browser transmit
		to: #r2;
		andShow: [ :aComposite | 
					aComposite pharoMethod
						display: [ :method | method sourceCode ];
						smalltalkClass: [ :method | method methodClass ] ].
	browser openOn: CompiledMethod class >> #gtExampleSimple! !

!GLMPharoPlaygroundPresentation commentStamp: 'AndreiChis 10/1/2014 14:00'!
I provide support for displaying snippets of Smalltalk code  (e.g. dealing with variable binding)

self pharoPlaygroundPresentationExample!
!GLMPharoPlaygroundPresentation methodsFor: 'accessing' stamp: 'AndreiChis 5/3/2014 18:38'!
variableBindings
	^ (variableBindingsBlock glamourValue: self entity) ifNil: [OrderedCollection new]! !

!GLMPharoPlaygroundPresentation methodsFor: 'rendering' stamp: 'TudorGirba 5/17/2014 09:18'!
renderGlamorouslyOn: aRenderer 
	self registerAnnouncements.
	^ aRenderer renderPharoPlaygroundPresentation: self! !

!GLMPharoPlaygroundPresentation methodsFor: 'actions' stamp: 'AndreiChis 3/19/2015 17:02'!
withBindingsDo: aBlock

	self announce: (GLMVariableBindingsAccessRequest new action: aBlock)! !

!GLMPharoPlaygroundPresentation methodsFor: 'accessing' stamp: 'AndreiChis 5/3/2014 18:39'!
variableBindings: aBlock
	^ variableBindingsBlock := aBlock! !

!GLMPharoPlaygroundPresentation methodsFor: 'actions' stamp: 'AndreiChis 1/14/2015 11:14'!
installGoAction
	self selectionAct: [ :t :entity |
		t highlightEvaluateAndDo: [ :result | t selection: result ] ]
			on: $g
			entitled: 'Do it and go'! !

!GLMPharoPlaygroundPresentation methodsFor: 'actions' stamp: 'AndreiChis 5/7/2014 18:05'!
updateVariableBindings

	self announce: (GLMVariableBindingsChanged new presentation: self).! !

!GLMPharoPlaygroundPresentation methodsFor: 'actions' stamp: 'AndreiChis 3/19/2015 16:32'!
resetBindings

	self withBindingsDo: [ :bindings | bindings removeAll ]! !

!GLMPharoPlaygroundPresentation methodsFor: 'accessing' stamp: 'AndreiChis 3/19/2015 17:01'!
currentBindings

	self withBindingsDo: [ :bingings | ^ bingings copy ]! !

!GLMPharoPlaygroundPresentation class methodsFor: 'examples' stamp: 'AndreiChis 10/1/2014 14:00'!
pharoPlaygroundPresentationExample
	"
	self pharoPlaygroundPresentationExample
	"
	| browser |
	browser := GLMTabulator new.
	browser
		row: #r1;
		row: #r2.
	browser transmit
		to: #r1;
		andShow: [ :aComposite | 
					aComposite pharoPlayground
						selectionAct: [ :workspace :page | workspace evaluateSelection ] on: $d entitled: 'Do it';
						selectionAct: [ :workspace :page | workspace evaluateSelectionAndDo: [ :result | result inspect ] ]
							on: $i
							entitled: 'Inspect it';
						selectionAct: [ :workspace :page | workspace evaluateSelectionAndDo: [ :result | result explore ] ]
							on: $e
							entitled: 'Explore it' ].
	browser transmit
		to: #r2;
		andShow: [ :aComposite | 
					aComposite pharoPlayground
						variableBindings: [ 
							{(#browser -> browser).
							(#a -> 1)} ] ].
	browser
		openOn:
			'browser := GLMTabulator new.
browser row: #r1; row: #r2.

browser transmit to: #r1; andShow: [ :aComposite |
	aComposite pharoPlayground].
browser openOn:''self halt'' '! !

!GLMPhlowBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/5/2015 15:37'!
titleBrick: aBrick

	titleBrick := aBrick
		textPosition: #center;
		height: 0;
		hSpaceFill.
	self addBrickBack: titleBrick! !

!GLMPhlowBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/8/2015 17:42'!
initialize
	super initialize.
		
	self
		useVerticalLinearLayout;
		titleBrick: self newTitleBrick;
		hSpaceFill;
		vSpaceFill! !

!GLMPhlowBrick methodsFor: 'phlow' stamp: 'AliakseiSyrel 1/11/2015 17:25'!
display: aBlockOrSymbol

	self subclassResponsibility! !

!GLMPhlowBrick methodsFor: 'phlow' stamp: 'AliakseiSyrel 1/11/2015 17:53'!
entity

	^ entity! !

!GLMPhlowBrick methodsFor: 'brick-properties-events' stamp: 'AliakseiSyrel 3/21/2015 23:40'!
onThemerChanged
	super onThemerChanged.
	
	self titleBrick textColor: self themer textLightColor! !

!GLMPhlowBrick methodsFor: 'phlow' stamp: 'AliakseiSyrel 1/23/2015 12:18'!
title: anObject
	
	self setProperty: #phlowTitle toValue: anObject! !

!GLMPhlowBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 3/21/2015 23:40'!
newTitleBrick

	^ GLMLabelBrick new! !

!GLMPhlowBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/23/2015 12:23'!
titleLogic

	^ self valueOfProperty: #phlowTitle ifAbsent: [ '' ]! !

!GLMPhlowBrick methodsFor: 'phlow' stamp: 'AliakseiSyrel 1/23/2015 12:19'!
entity: anObject

	entity := anObject.
	self setTitle: (self titleLogic phlowValue: self entity)
	! !

!GLMPhlowBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/11/2015 17:24'!
titleBrick
	^ titleBrick! !

!GLMPhlowBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/5/2015 15:38'!
setTitle: aString

	self titleBrick text: aString.
	
	titleBrick height: (
		(aString isEmpty | aString isNil)
			ifFalse: [ 30 ]
			ifTrue: [ 0 ])! !

!GLMPhlowListBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 2/10/2015 14:58'!
newScrollList

	^ GLMFallbackScrollListBrick"GLMScrollListBrick" new! !

!GLMPhlowListBrick methodsFor: 'phlow' stamp: 'AliakseiSyrel 1/23/2015 12:20'!
format: anObject

	self setProperty: #phlowFormat toValue: anObject! !

!GLMPhlowListBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 1/11/2015 17:25'!
initialize
	super initialize.
		
	self listBrick: self newScrollList! !

!GLMPhlowListBrick methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/6/2015 11:33'!
displayLogic

	^ self valueOfProperty: #phlowDisplay ifAbsent: [ #yourself ]! !

!GLMPhlowListBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/6/2015 11:30'!
listBrick: aBrick

	scrollList := aBrick.
	self listBrick
		vSpaceFill;
		hSpaceFill.
		
	self addBrickBack: self listBrick! !

!GLMPhlowListBrick methodsFor: 'phlow' stamp: 'AliakseiSyrel 2/6/2015 11:31'!
display: anObject

	self setProperty: #phlowDisplay toValue: anObject! !

!GLMPhlowListBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/11/2015 16:30'!
listBrick

	^ scrollList! !

!GLMPhlowListBrick methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 3/27/2015 12:33'!
setAdaptor
	| adaptor |
	adaptor := (GLMBrickListModel on: self entity)
		morphAtLogic: [ :index :morph |
			self styledLogic
				phlowValue: (self formatLogic phlowValue: (self displayLogic phlowValue: (self entity at: index))) asBrick ].
	self listBrick model: adaptor! !

!GLMPhlowListBrick methodsFor: 'phlow' stamp: 'AliakseiSyrel 2/6/2015 11:37'!
entity: anObject

	super entity: anObject.
	self setAdaptor! !

!GLMPhlowListBrick methodsFor: 'phlow' stamp: 'AliakseiSyrel 1/23/2015 12:20'!
styled: anObject
	
	self setProperty: #phlowStyled toValue: anObject! !

!GLMPhlowListBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/23/2015 12:22'!
formatLogic

	^ self valueOfProperty: #phlowFormat ifAbsent: [ #yourself ]! !

!GLMPhlowListBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/23/2015 12:22'!
styledLogic
	
	^ self valueOfProperty: #phlowStyled ifAbsent: [ #yourself ]! !

!GLMPhlowListBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:31'!
example
	
	^ GLMCompositeBrick gtExampleList! !

!GLMPhlowListBrick class methodsFor: 'examples' stamp: 'AliakseiSyrel 1/11/2015 23:31'!
example2
	
	^ GLMCompositeBrick exampleListWithCustomItem! !

!GLMPhlowPharoMethodBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/23/2015 12:25'!
smalltalkClassLogic

	^ self valueOfProperty: #phlowSmalltalkClass ifAbsent: [ #yourself ]! !

!GLMPhlowPharoMethodBrick methodsFor: 'accessing' stamp: 'TudorGirba 2/4/2015 13:36'!
textBrick: aBrick

	super textBrick: aBrick.
	self textBrick beForSmalltalkCode.! !

!GLMPhlowPharoMethodBrick methodsFor: 'phlow' stamp: 'TudorGirba 2/4/2015 13:38'!
installEntity
	self textBrick classOrMetaClass: (self smalltalkClassLogic phlowValue: self entity).
	self textBrick setTextWith: (self displayLogic phlowValue: self entity)! !

!GLMPhlowPharoMethodBrick methodsFor: 'phlow' stamp: 'AliakseiSyrel 1/23/2015 12:25'!
smalltalkClass: anObject
	
	self setProperty: #phlowSmalltalkClass toValue: anObject! !

!GLMPhlowTableBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/11/2015 23:09'!
transformedEntity: anObject

	transformedEntity := anObject! !

!GLMPhlowTableBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/23/2015 12:28'!
displayLogic

	^ self valueOfProperty: #phlowDisplay ifAbsent: [ #yourself ]! !

!GLMPhlowTableBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/11/2015 22:23'!
addColumn: aColumn

	self columns add: aColumn! !

!GLMPhlowTableBrick methodsFor: 'phlow' stamp: 'AliakseiSyrel 1/23/2015 12:28'!
display: anObject
	
	self setProperty: #phlowDisplay toValue: anObject
	! !

!GLMPhlowTableBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/11/2015 23:08'!
transformedEntity

	^ transformedEntity! !

!GLMPhlowTableBrick methodsFor: 'phlow' stamp: 'AliakseiSyrel 1/23/2015 12:29'!
column: anObject evaluated: otherObject

	self column: anObject evaluated: otherObject styled: nil! !

!GLMPhlowTableBrick methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 3/27/2015 12:33'!
setAdaptor
	| adaptor |
	adaptor := (GLMBrickListModel on: self transformedEntity)
		morphAtLogic: [ :index | 
			GLMPhlowTableRowBrick new
				in: self;
				entity: (self transformedEntity at: index) ].
	self listBrick model: adaptor! !

!GLMPhlowTableBrick methodsFor: 'phlow' stamp: 'AliakseiSyrel 2/6/2015 11:37'!
entity: anObject

	self transformedEntity: (self displayLogic phlowValue: anObject).
	super entity: anObject.! !

!GLMPhlowTableBrick methodsFor: 'phlow' stamp: 'AliakseiSyrel 1/30/2015 10:10'!
column: anObject evaluated: otherObject styled: anotherObject

	self addColumn: (GLMPhlowTableColumn new 
		title: anObject;
		computation: otherObject;
		style: anotherObject)! !

!GLMPhlowTableBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/11/2015 22:04'!
columns

	^ columns ifNil: [ columns := OrderedCollection new ]! !

!GLMPhlowTableBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:31'!
example
	
	^ GLMCompositeBrick gtExampleTable! !

!GLMPhlowTableColumn methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/12/2015 12:13'!
style
	^ style! !

!GLMPhlowTableColumn methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/12/2015 12:13'!
computation
	^ computation! !

!GLMPhlowTableColumn methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/12/2015 12:13'!
computation: anObject
	computation := anObject! !

!GLMPhlowTableColumn methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/12/2015 12:13'!
title
	^ title! !

!GLMPhlowTableColumn methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/12/2015 12:13'!
title: anObject
	title := anObject! !

!GLMPhlowTableColumn methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/12/2015 12:13'!
style: anObject
	style := anObject! !

!GLMPhlowTableRowBrick methodsFor: 'adding' stamp: 'AliakseiSyrel 1/23/2015 12:30'!
addColumn: aColumn
	|brick|
	brick := (aColumn computation phlowValue: self entity) asBrick.
	brick := aColumn style phlowValue: brick.
	^ self addBrickBack: brick! !

!GLMPhlowTableRowBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 1/11/2015 22:38'!
initializeColumns
	"you can initialize only if entity and table both not nil"
	self removeAllBricks.
	(self entity isNil | self table isNil) ifTrue: [ ^ self ].
	self table columns do: [ :each | self addColumn: each ].
	self updateWidthPercentage! !

!GLMPhlowTableRowBrick methodsFor: 'acessing' stamp: 'AliakseiSyrel 1/11/2015 22:32'!
in: aTableBrick

	table := aTableBrick.
	self initializeColumns.! !

!GLMPhlowTableRowBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/5/2015 15:42'!
initialize
	super initialize.
	
	"My height is the height of the tallest subbrick"
	self
		vShrinkWrap;
		hSpaceFill! !

!GLMPhlowTableRowBrick methodsFor: 'phlow' stamp: 'AliakseiSyrel 1/11/2015 21:48'!
entity

	^ entity! !

!GLMPhlowTableRowBrick methodsFor: 'phlow' stamp: 'AliakseiSyrel 1/11/2015 22:32'!
entity: anObject
	
	entity := anObject.
	self initializeColumns.! !

!GLMPhlowTableRowBrick methodsFor: 'acessing' stamp: 'AliakseiSyrel 1/11/2015 22:19'!
table

	^ table! !

!GLMPhlowTableRowBrick methodsFor: 'updating' stamp: 'AliakseiSyrel 2/10/2015 00:18'!
updateWidthPercentage
	
	self subbricks ifEmpty: [ ^ self ].
	self subbricks do: [ :each | each hSpaceFill: (100 / self subbricksCount) ]! !

!GLMPhlowTextBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/23/2015 12:24'!
displayLogic

	^ self valueOfProperty: #phlowDisplay ifAbsent: [ #yourself ]! !

!GLMPhlowTextBrick methodsFor: 'accessing' stamp: 'TudorGirba 2/4/2015 13:35'!
textBrick: aBrick

	textBrick := aBrick.
	self textBrick
		wrapped: true.
		
	self textBrick layoutProperties
		vSpaceFill;
		hSpaceFill.
	self addBrickBack: self textBrick
	
! !

!GLMPhlowTextBrick methodsFor: 'phlow' stamp: 'AliakseiSyrel 1/23/2015 12:24'!
display: anObject

	self setProperty: #phlowDisplay toValue: anObject! !

!GLMPhlowTextBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 1/11/2015 22:42'!
initialize
	super initialize.
	
	self textBrick: self newTextBrick.! !

!GLMPhlowTextBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 1/30/2015 12:13'!
newTextBrick

	^ GLMRubScrolledTextBrick new! !

!GLMPhlowTextBrick methodsFor: 'phlow' stamp: 'TudorGirba 2/4/2015 13:38'!
entity: anObject
	super entity: anObject.
	
	self installEntity! !

!GLMPhlowTextBrick methodsFor: 'phlow' stamp: 'TudorGirba 2/4/2015 13:37'!
installEntity
	self textBrick setTextWith: (self displayLogic phlowValue: self entity)
	! !

!GLMPhlowTextBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/11/2015 17:20'!
textBrick

	^ textBrick
	
! !

!GLMPhlowTextBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:31'!
example
	
	^ GLMCompositeBrick gtExamplePharoMethod! !

!GLMPluggableTextMorph commentStamp: 'TudorGirba 7/14/2011 09:45'!
We subclass the default PluggableTextMorph just to raise the proper announcements when the text or when the selection changes.!
!GLMPluggableTextMorph methodsFor: 'accessing' stamp: 'tg 4/15/2010 18:00'!
announcer
	^ announcer ifNil: [announcer := GLMAnnouncer new]! !

!GLMPluggableTextMorph methodsFor: 'private' stamp: 'TudorGirba 2/8/2014 23:33'!
handleEdit: editBlock
	"We override this hook method to intercept pasting in the text morph.
	When pasting happens, we update the text port"
	super handleEdit: editBlock.
	self announcer announce: (GLMTextChanged new text: self text)! !

!GLMPluggableTextMorph methodsFor: 'interactive error protocol' stamp: 'TudorGirba 7/14/2011 22:40'!
announceSelection: aString from: start to: stop
	self announcer announce: (
		GLMSelectedTextChanged new 
			start: start; 
			end: stop;
			selectedText: aString )! !

!GLMPluggableTextMorph methodsFor: 'do-its' stamp: 'AndreiChis 5/6/2014 14:58'!
evaluateSelectionAndDo: aBlock

	^ self handleEdit: [textMorph editor evaluateSelectionAndDo: aBlock]! !

!GLMPluggableTextMorph methodsFor: 'private' stamp: 'TudorGirba 7/14/2011 09:44'!
textMorphClass
	"this is needed for intercepting the shortcuts"
	^ GLMTextMorphForEditView! !

!GLMPluggableTextMorph methodsFor: 'new selection' stamp: 'AndreiChis 2/27/2014 17:28'!
selectLine

	self handleEdit: [ 
		textMorph editor lineSelectAndEmptyCheck: [^ nil] ].! !

!GLMPluggableTextMorph methodsFor: 'interactive error protocol' stamp: 'TudorGirba 7/13/2011 18:08'!
selectFrom: start to: stop
	| result |
	result := super selectFrom: start to: stop.
	self announcer announce: (GLMSelectedTextChanged new start: start; end: stop).
	^ result! !

!GLMPopper commentStamp: 'AndreiChis 10/1/2014 13:03'!
This is a morph used for displaying various notifications.

It has a special ability to delete itself either when Esc is pressed, or when the focus is lost.

When opened the user has to spefify a text morph whose position and cursor are user to position this morph.

When triggered from a context menu action the class method installAlarmFor: should be used to open the popper as the text morph gets back the focus after the action was executed (and, hence, the popper is closed).!
!GLMPopper methodsFor: 'initialization' stamp: 'TudorGirba 8/1/2014 22:47'!
initialize
	super initialize.
	self changeProportionalLayout.
	self
		onAnnouncement: MorphLostFocus do: [ :ann | ann morph delete ];
		color: Color transparent! !

!GLMPopper methodsFor: 'private' stamp: 'TudorGirba 8/1/2014 23:01'!
withString: string from: aMorph
	| top width left stringMorph height desiredOrigin |
	desiredOrigin := self computeOriginFor: aMorph.
	stringMorph := RubEditingArea new updateTextWith: string.
	width := stringMorph width + 12 min: World width / 3.
	left := desiredOrigin x + width > World width
		ifTrue: [ World width - width ]
		ifFalse: [ desiredOrigin x ].
	height := (stringMorph
		beWrapped;
		width: width;
		yourself) height + 2 min: World height / 3.
	top := desiredOrigin y + height > World height
		ifTrue: [ World height - height ]
		ifFalse: [ desiredOrigin y ].
	self updateWithString: string from: aMorph.
	self
		top: top;
		left: left;
		width: width;
		height: height! !

!GLMPopper methodsFor: 'public' stamp: 'AndreiChis 1/12/2015 22:30'!
computeOriginFor: aMorph
	| desiredTop desiredLeft |
	"self halt."
	aMorph textArea scrollSelectionIntoView: nil.
	desiredTop := (self originMorphFor: aMorph) positionInWorld y - 6.
						"unclear why 6 is the magic number"
	desiredLeft := (self originMorphFor: aMorph) right + aMorph positionInWorld x + 6.
	^ desiredLeft @ desiredTop! !

!GLMPopper methodsFor: 'public' stamp: 'AndreiChis 1/12/2015 22:41'!
originMorphFor: aMorph

	(aMorph textArea hasSelection not and: [ 
		aMorph textArea hasHighlightSegment ]) ifTrue: [ 
			^ aMorph textArea getHighlightSegment ].
	^ aMorph textArea cursor! !

!GLMPopper methodsFor: 'private' stamp: 'AndreiChis 1/13/2015 20:07'!
updateWithString: string from: aMorph
	textMorph
		updateTextWith: string;
		takeKeyboardFocus;
		on: Character escape do: [ 
			self delete.
			aMorph textArea removeHighlightSegment.
			aMorph takeKeyboardFocus ];
		on: Character backspace do: [ 
			self delete.
			aMorph textArea removeHighlightSegment.
			aMorph takeKeyboardFocus ];
		onAnnouncement: MorphLostFocus do: [ :ann | 
			self delete.
			aMorph textArea removeHighlightSegment.
			"If this event is triggered then another morph already has the focus.
			Do not attempt to give the focus back to the original morph" ]! !

!GLMPopper class methodsFor: 'utils' stamp: 'AndreiChis 10/1/2014 11:46'!
installAlarmFor: aBlock

	World
		addAlarm: #value
		withArguments: #()
		for: aBlock
		at: Time millisecondClockValue + 50.! !

!GLMPopperNotificationStrategy commentStamp: 'AndreiChis 10/1/2014 13:35'!
I opened a new popper window that displays the given notification. (I do not alter the content of the text editor.)!
!GLMPopperNotificationStrategy methodsFor: 'as yet unclassified' stamp: 'AndreiChis 10/1/2014 11:56'!
notify: aString at: anInteger in: aStream
	| pos |
	pos := self editor selectionInterval notEmpty
		ifTrue: [self editor startIndex + anInteger - 1 ]
		ifFalse: [anInteger].
	self editor selectFrom: pos to: pos.
	
	GLMErrorPopper installAlarmFor: [ 
		(GLMErrorPopper new withString: aString from: self editor textArea owner owner owner)
			openInWorld ]! !

!GLMPopupAction methodsFor: 'actions' stamp: 'AliakseiSyrel 3/27/2015 13:19'!
popupActOn: aPresentation from: aButton

	GLMEmptyPopupBrick new
		with: [ :b | b themer: b themer actionThemer ];
		doNotHideUnhover;
		onCreated: [ :popup |self action glamourValueWithArgs: (Array 
				with: aPresentation 
				withAll: { aPresentation entity . popup }) ];
		openBelowFor: aButton;
		beRightToLeftWithOffset: 0! !

!GLMPopupAction methodsFor: 'rendering' stamp: 'AliakseiSyrel 3/26/2015 23:45'!
renderGlamorouslyOn: aRenderer
	^aRenderer renderPopupAction: self! !

!GLMPopupBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/13/2015 01:40'!
titleText
	^ titleText ifNil: [ titleText := 'Hi,' ]! !

!GLMPopupBrick methodsFor: 'events-processing' stamp: 'AliakseiSyrel 3/27/2015 11:41'!
onCreated
	self contentBrick padding: #(5 0).
	self titleBrick: self newTitleBrick.
	self hintBrick: self newHintBrick.! !

!GLMPopupBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/13/2015 01:39'!
hintText
	^ hintText ifNil: [ hintText := 'Need help?' ]! !

!GLMPopupBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 2/13/2015 01:40'!
newTitleBrick

	^ GLMLabelBrick new
		text: self titleText;
		padding: #(0 10);
		width: [ :b | b approximateWidth ];
		height: [ :b | b approximateHeight ]! !

!GLMPopupBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/13/2015 01:35'!
hintBrick: anObject
	hintBrick := anObject.
	
	
	self hintBrick
		textColor: self themer popupThemer textColor.
		
	self contentBrick addBrickBack: self hintBrick! !

!GLMPopupBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/13/2015 01:34'!
hintBrick
	^ hintBrick! !

!GLMPopupBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 2/13/2015 01:40'!
newHintBrick

	^ GLMLabelBrick new
		text: self hintText;
		padding: #(0 10);
		width: [ :b | b approximateWidth ];
		height: [ :b | b approximateHeight ]! !

!GLMPopupBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/13/2015 01:43'!
titleText: anObject
	titleText := anObject.
	
	self titleBrick ifNotNil: [ self titleBrick text: self titleText ]! !

!GLMPopupBrick methodsFor: 'events-processing' stamp: 'JurajKubelka 2/27/2015 13:04'!
handleListenEvent: anEvent
	(self isInsideOfTriggerBrick: anEvent) ifFalse: [ self close ]! !

!GLMPopupBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/13/2015 01:43'!
hintText: anObject
	hintText := anObject.
	
	self hintBrick ifNotNil: [ self hintBrick text: self hintText ]! !

!GLMPopupBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/13/2015 01:34'!
titleBrick
	^ titleBrick! !

!GLMPopupBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/13/2015 01:35'!
titleBrick: anObject
	titleBrick := anObject.
	
	self titleBrick
		textColor: self themer popupThemer textColor.
		
	self contentBrick addBrickFirst: self titleBrick! !

!GLMPopupBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:28'!
gtExampleAllTypesBelow
	<gtExample: 'Example of all popup types opening below of anchor brick'>

	^ GLMBrick new
		hShrinkWrap;
		vShrinkWrap;
		addBrickBack: (self createButton: [ :b | self new openBelowFor: b ]);
		addBrickBack: (self createButton: [ :b | self new beHelp; openBelowFor: b ]);
		addBrickBack: (self createButton: [ :b | self new beError; openBelowFor: b ]);
		addBrickBack: (self createButton: [ :b | self new beSuccess; openBelowFor: b ]);
		marginTop: 35! !

!GLMPopupBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:28'!
exampleAllTypesOpen
	
	self gtExampleAllTypes openCenteredInBrickWindowLabeled: 'All Popup Types'! !

!GLMPopupBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:28'!
exampleAllTypesBelowOpen
	
	self gtExampleAllTypesBelow openCenteredInBrickWindowLabeled: 'All Below Popup Types'! !

!GLMPopupBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:28'!
gtExampleAllTypes
	<gtExample: 'Example of all popup types'>

	^ GLMBrick new
		hShrinkWrap;
		vShrinkWrap;
		addBrickBack: (self createButton: [ :b | self new openFor: b ]);
		addBrickBack: (self createButton: [ :b | self new beHelp; openFor: b ]);
		addBrickBack: (self createButton: [ :b | self new beError; openFor: b ]);
		addBrickBack: (self createButton: [ :b | self new beSuccess; openFor: b ]);
		marginTop: 35;
		yourself! !

!GLMPort commentStamp: 'tg 12/19/2009 00:15'!
GLMPort represents the abstract port. Any port has a name. Subclasses can provide further semantics to a port.!
!GLMPort methodsFor: 'accessing' stamp: 'tg 12/18/2009 23:53'!
receive: aTransmission 
	self receive: aTransmission in: GLMTransmissionContext new! !

!GLMPort methodsFor: 'accessing' stamp: 'TudorGirba 4/18/2011 19:45'!
transientValue: anObject 
	| previousValue |
	previousValue := self value. 
	self value: anObject.
	self silentValue: previousValue! !

!GLMPort methodsFor: 'validation' stamp: 'JorgeRessia 11/6/2009 13:10'!
validate: anObject 

	^true! !

!GLMPort methodsFor: 'accessing' stamp: 'tg 12/18/2009 23:53'!
receive: aTransmission in: aContext 
	self subclassResponsibility! !

!GLMPort methodsFor: 'accessing' stamp: 'TudorGirba 4/18/2011 19:42'!
silentValue: anObject
	"This is meant to be used internally"
	self subclassResponsibility! !

!GLMPort methodsFor: 'testing' stamp: 'TudorGirba 6/14/2014 12:21'!
isSelectionPort
	^ self name = #selection! !

!GLMPort methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
value 
	 
	self subclassResponsibility! !

!GLMPort methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
name: aSymbol 
	 
	name := aSymbol! !

!GLMPort methodsFor: 'accessing' stamp: 'tg 2/17/2010 14:02'!
value: anObject 
	self value: anObject in: GLMTransmissionContext new! !

!GLMPort methodsFor: 'printing' stamp: 'tg 1/13/2010 16:31'!
printOn: aStream 
	super printOn: aStream.
	aStream 
		nextPut: Character space;
		nextPutAll: self identityHash printString;
		nextPutAll: ' (name='; 
		nextPutAll: self name printString; 
		nextPutAll: ' value='; 
		nextPutAll: self value printString; 
		nextPut: $)! !

!GLMPort methodsFor: 'testing' stamp: 'TudorGirba 6/14/2014 12:21'!
isEntityPort
	^ self name = #entity! !

!GLMPort methodsFor: 'copying' stamp: 'tg 12/30/2009 03:05'!
copyAccordingToPaneMapping: newPanesMapping inNewBrowser: anotherBrowser
	^ self subclassResponsibility! !

!GLMPort methodsFor: 'testing' stamp: 'tg 1/5/2010 13:40'!
hasPane
	^ false! !

!GLMPort methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
name 
	 
	^name! !

!GLMPort methodsFor: 'accessing' stamp: 'tg 12/18/2009 23:55'!
value: anObject in: aContext
	self subclassResponsibility! !

!GLMPort methodsFor: 'validation' stamp: 'simondenier 4/15/2010 15:56'!
notingPresentationChangeDo: aBlock
	aBlock value! !

!GLMPortChangeAction methodsFor: 'accessing' stamp: 'TudorGirba 10/17/2014 15:02'!
portName
	^ portName! !

!GLMPortChangeAction methodsFor: 'accessing' stamp: 'TudorGirba 10/17/2014 15:02'!
portName: anObject
	portName := anObject! !

!GLMPortEvent commentStamp: 'tg 12/19/2009 00:12'!
A GLMPortEvent is passed to the parent pane every time a Port changes.

Instance Variables
	oldValue:		<Object>
	port:		Port
	transmission:		Transmission
	transmissionContext:	TransmissionContext!
!GLMPortEvent methodsFor: 'accessing-convenience' stamp: ' 4/5/09 22:18'!
value 
	 
	^self port value! !

!GLMPortEvent methodsFor: 'initialize-release' stamp: 'jorge.ressia 5/30/2009 13:01'!
initializeOn: aPort previouslyValued: anObject 
	self initializeOn: aPort previouslyValued: anObject in: OrderedCollection new! !

!GLMPortEvent methodsFor: 'accessing-convenience' stamp: ' 4/5/09 22:18'!
pane 
	 
	^self port pane! !

!GLMPortEvent methodsFor: 'accessing-convenience' stamp: ' 4/5/09 22:18'!
portName 
	 
	^self port name! !

!GLMPortEvent methodsFor: 'initialize-release' stamp: 'jorge.ressia 5/30/2009 12:58'!
initializeOn: aPort previouslyValued: anObject in: aTransmissionContext 
	port := aPort.
	oldValue := anObject.
	transmissionContext := aTransmissionContext! !

!GLMPortEvent methodsFor: 'testing' stamp: 'TudorGirba 6/14/2014 12:20'!
isEntityPort
	^ self port isEntityPort! !

!GLMPortEvent methodsFor: 'accessing' stamp: 'tg 12/18/2009 23:58'!
transmissionContext
	^ transmissionContext! !

!GLMPortEvent methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
port 
	 
	^port! !

!GLMPortEvent methodsFor: 'printing' stamp: 'tg 2/17/2010 19:10'!
printOn: aStream
	super printOn: aStream.
	aStream 
		nextPutAll: '(port='.
	self port printOn: aStream.
	aStream nextPutAll: ' oldValue='; nextPutAll: self oldValue printString; nextPut: $)
		! !

!GLMPortEvent methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
oldValue 
	 
	^oldValue! !

!GLMPortEvent methodsFor: 'testing' stamp: 'TudorGirba 6/14/2014 12:20'!
isSelectionPort
	^ self port isSelectionPort! !

!GLMPortEvent methodsFor: 'testing' stamp: 'DamienCassou 7/3/2011 19:52'!
hasChanged
	"Answer whether the port value changed due to the event."

	^ self value ~~ self oldValue! !

!GLMPortEvent class methodsFor: 'instance creation' stamp: 'jorge.ressia 5/30/2009 12:55'!
on: aPort previouslyValued: anObject in: aTransmissionContext 
	^self new initializeOn: aPort previouslyValued: anObject in: aTransmissionContext ! !

!GLMPortEvent class methodsFor: 'instance creation' stamp: 'jorge.ressia 5/30/2009 11:47'!
on: aPort previouslyValued: anObject 
	^ self new 
		initializeOn: aPort
		previouslyValued: anObject! !

!GLMPortEventTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testCreation
	| anEvent |
	anEvent := GLMPortEvent on: 1 previouslyValued: 2.
	self assert: anEvent port equals: 1.
	self assert: anEvent oldValue equals: 2.
	self assert: anEvent transmissionContext isEmpty! !

!GLMPortEventTest methodsFor: 'tests' stamp: 'TudorGirba 7/29/2011 19:22'!
testInterdependentPanesCycleBreak
	| browser outerCount oneCount |
	outerCount := 0.
	oneCount := 0.
	browser := GLMTabulator new.
	browser
		column: #one;
		column: #two;
		column: #three.
	browser
		transmit to: #one;
		andShow: [ :a | a list display: [ :x | 1 to: x ] ].
	browser
		transmit to: #two;
		from: #one;
		andShow: [ :a | a list display: [ :x | 1 to: x * 2 ] ].
	browser
		transmit to: #three;
		from: #two;
		andShow: [ :a |  
					(a list)
						display: [ :x | 1 to: x * 3 ];
						populate: #focus
							on: $f
							entitled: 'Focus'
							with: [ :list | list selection ] ].
	browser transmit toOutsidePort: #focus; from: #three port: #focus; transformed: [ :x | outerCount := outerCount + 1 ].
	browser transmit to: #one port: #selection; fromOutsidePort: #focus; transformed: [ :x | oneCount := oneCount + 1 ].
	browser startOn: 5.
	((browser paneNamed: #one) port: #selection) value: 3.
	((browser paneNamed: #two) port: #selection) value: 6.
	((browser paneNamed: #three) port: #selection) value: 12.
	((browser paneNamed: #three) port: #focus) value: 12.
	self assert: oneCount equals: 1.
	self assert: outerCount equals: 1! !

!GLMPortEventTest methodsFor: 'tests' stamp: 'TudorGirba 7/29/2011 19:21'!
testInterdependentPanesProperPorts
	| browser |
	browser := GLMTabulator new.
	browser
		column: #one;
		column: #two;
		column: #three.
	browser
		transmit to: #one;
		andShow: [ :a | a list display: [ :x | 1 to: x ] ].
	browser
		transmit to: #two;
		from: #one;
		andShow: [ :a | a list display: [ :x | 1 to: x * 2 ] ].
	browser
		transmit to: #three;
		from: #two;
		andShow: [ :a | 
					(a list)
						display: [ :x | 1 to: x * 3 ];
						populate: #focus
							on: $f
							entitled: 'Focus'
							with: [ :list | list selection ] ].
	browser transmit toOutsidePort: #focus; from: #three port: #focus.
	browser transmit to: #one port: #selection; fromOutsidePort: #focus; transformed: [ :x | x + 1 ].
	browser transmit to: #two port: #selection; fromOutsidePort: #focus; transformed: [ :x | x + 2 ].
	browser startOn: 5.
	((browser paneNamed: #one) port: #selection) value: 3.
	((browser paneNamed: #two) port: #selection) value: 6.
	((browser paneNamed: #three) port: #selection) value: 12.
	((browser paneNamed: #three) port: #focus) value: 12.
	self assert: (browser pane port: #focus) value equals: 12.
	self assert: ((browser paneNamed: #one) port: #entity) value equals: 5.
	self assert: ((browser paneNamed: #one) port: #selection) value equals: 13.
	self assert: ((browser paneNamed: #two) port: #entity) value equals: 13.
	self assert: ((browser paneNamed: #two) port: #selection) value equals: 14.
	self assert: ((browser paneNamed: #three) port: #entity) value equals: 14.
	self assert: ((browser paneNamed: #three) port: #selection) value equals: nil! !

!GLMPortEventTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testCreationWithTransmissionContext
	| anEvent aContext |
	aContext := OrderedCollection new.
	anEvent := GLMPortEvent on: 1 previouslyValued: 2 in: aContext.
	self assert: anEvent port equals: 1.
	self assert: anEvent oldValue equals: 2.
	self assert: anEvent transmissionContext equals: aContext! !

!GLMPortEventTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPortName
	| anEvent |
	anEvent := GLMPortEvent
		on:
			((GLMPort new)
				name: '1';
				yourself)
		previouslyValued: 2.
	self assert: anEvent portName equals: '1'! !

!GLMPortIdentifier commentStamp: '<historical>'!
This class is a simple data structure to be used for identifying a port by name.!
!GLMPortIdentifier methodsFor: 'accessing' stamp: 'tg 10/25/2010 01:56'!
paneName: anObject
	paneName := anObject! !

!GLMPortIdentifier methodsFor: 'accessing' stamp: 'tg 10/25/2010 02:07'!
asGlamourTargetIdentifier
	self portName isNil ifTrue: [self portName: self class defaultTargetPortName].
	^ self ! !

!GLMPortIdentifier methodsFor: 'accessing' stamp: 'tg 10/25/2010 01:56'!
portName: anObject
	portName := anObject! !

!GLMPortIdentifier methodsFor: 'accessing' stamp: 'tg 10/25/2010 02:07'!
asGlamourOriginIdentifier
	self portName isNil ifTrue: [self portName: self class defaultOriginPortName].
	^ self ! !

!GLMPortIdentifier methodsFor: 'accessing' stamp: 'tg 10/25/2010 01:56'!
portName
	^ portName! !

!GLMPortIdentifier methodsFor: 'accessing' stamp: 'tg 10/25/2010 01:56'!
paneName
	^ paneName! !

!GLMPortIdentifier class methodsFor: 'accessing' stamp: 'tg 10/25/2010 02:07'!
defaultTargetPortName
	^ #entity! !

!GLMPortIdentifier class methodsFor: 'instance creation' stamp: 'tg 10/25/2010 02:09'!
defaultTargetOf: aPaneName
	^ self new 
		paneName: aPaneName;
		portName: self defaultTargetPortName! !

!GLMPortIdentifier class methodsFor: 'instance creation' stamp: 'tg 11/3/2010 13:35'!
pane: aPaneName port: aPortName
	^ self new 
		paneName: aPaneName;
		portName: aPortName! !

!GLMPortIdentifier class methodsFor: 'instance creation' stamp: 'tg 10/25/2010 02:09'!
defaultOriginOf: aPaneName
	^ self new 
		paneName: aPaneName;
		portName: self defaultOriginPortName! !

!GLMPortIdentifier class methodsFor: 'accessing' stamp: 'tg 10/25/2010 02:07'!
defaultOriginPortName
	^ #selection! !

!GLMPortIdentifierTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testAssociationAsTargetIdentifier
	self assert: ((#pane -> #port) asGlamourTargetIdentifier isKindOf: GLMPortIdentifier).
	self assert: (#pane -> #port) asGlamourTargetIdentifier paneName equals: #pane.
	self assert: (#pane -> #port) asGlamourTargetIdentifier portName equals: #port! !

!GLMPortIdentifierTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testSymbolAsTargetIdentifier
	self assert: (#pane asGlamourTargetIdentifier isKindOf: GLMPortIdentifier).
	self assert: #pane asGlamourTargetIdentifier paneName equals: #pane.
	self assert: #pane asGlamourTargetIdentifier portName equals: #entity! !

!GLMPortIdentifierTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testAssociationAsOriginIdentifier
	self assert: ((#pane -> #port) asGlamourOriginIdentifier isKindOf: GLMPortIdentifier).
	self assert: (#pane -> #port) asGlamourOriginIdentifier paneName equals: #pane.
	self assert: (#pane -> #port) asGlamourOriginIdentifier portName equals: #port! !

!GLMPortIdentifierTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testSymbolAsOriginIdentifier
	self assert: (#pane asGlamourOriginIdentifier isKindOf: GLMPortIdentifier).
	self assert: #pane asGlamourOriginIdentifier paneName equals: #pane.
	self assert: #pane asGlamourOriginIdentifier portName equals: #selection! !

!GLMPortIdentifierTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testAsOriginIdentifier
	| id |
	id := GLMPortIdentifier new.
	self assert: id asGlamourOriginIdentifier equals: id! !

!GLMPortIdentifierTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testAsTargetIdentifier
	| id |
	id := GLMPortIdentifier new.
	self assert: id asGlamourTargetIdentifier equals: id! !

!GLMPortReference commentStamp: 'tg 1/5/2010 22:18'!
A PortReference is used in Transmissions to bahavior that is specific to a Transmission instance.!
!GLMPortReference methodsFor: 'accessing' stamp: 'tg 1/5/2010 22:07'!
port: aPort
	port := aPort! !

!GLMPortReference methodsFor: 'as yet unclassified' stamp: 'DamienCassou 7/19/2011 17:55'!
postCopy 
	port := port copy! !

!GLMPortReference methodsFor: 'accessing' stamp: 'tg 1/5/2010 22:06'!
port 
	 
	^port! !

!GLMPortReference methodsFor: 'printing' stamp: 'tg 1/13/2010 16:37'!
printOn: aStream
	super printOn: aStream.
	aStream 
		nextPut: Character space;
		nextPutAll: self identityHash printString;
		nextPutAll: ' ('.
	port printOn: aStream.
	aStream nextPut: $)! !

!GLMPortReferenceTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testOriginTransformedValue
	| port reference |
	port := GLMSimplePort new value: 41.
	reference := (GLMOriginPortReference new)
		port: port;
		transformation: [ :x | x + 1 ].
	self assert: reference value equals: 42! !

!GLMPortReferenceTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testOriginValue
	| port reference |
	port := GLMSimplePort new value: 42.
	reference := GLMOriginPortReference new port: port.
	self assert: reference value equals: 42! !

!GLMPortTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPresentationBoundPort
	| presentation port |
	presentation := GLMPresentation new.
	port := (GLMPresentationBoundPort new)
		name: #port;
		presentation: presentation.
	port value: 42.
	self assert: (presentation pane port: #port) value equals: 42.
	(presentation pane port: #port) value: 43.
	self assert: port value equals: 43! !

!GLMPortTest methodsFor: 'tests' stamp: 'AndreiChis 6/24/2013 10:48'!
testPortInitializationDoesNotAffectTransmissionPort
	| browser count |
	count := 0.
	browser := GLMTabulator new.
	browser
		column: #one.
	(browser transmit)
		fromOutsidePort: #entity;
		to: #one port: #entity;
		andShow: [ :a :entity | 
			a list initialize: [ :pres |  
				count := count + 1.
				pres 
					entity: (1 to: 10) ] ].
	self assert: (browser panes first port: #entity) value equals: nil.
	browser startOn: (1 to: 42).
	self assert: (browser panes first port: #entity) value equals: (1 to: 42).
	self assert: count = 1.
	(browser pane port: #entity) value: (1 to: 43).
	self assert: (browser panes first port: #entity) value equals: (1 to: 43).
	self assert: count = 2.
! !

!GLMPortTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPortEquality
	| presentation port |
	presentation := GLMPresentation new.
	port := (GLMPresentationBoundPort new)
		name: #port;
		presentation: presentation.
	self assert: port equals: (presentation pane port: #port).
	self assert: (presentation pane port: #port) equals: port.
	self assert: port hash equals: (presentation pane port: #port) hash.
	self assert: (presentation pane port: #port) hash equals: port hash! !

!GLMPortTest methodsFor: 'tests' stamp: 'AndreiChis 6/24/2013 10:38'!
testPortInitializationFromTransmission
	| browser |
	browser := GLMTabulator new.
	browser
		column: #one.
	(browser transmit)
		fromOutsidePort: #entity;
		to: #one port: #entity;
		andShow: [ :a :entity | 
			a text initialize: [ :pres |  
				pres 
					text: ('foo', entity asString);
					selectionInterval: (2 to: 3) ] ].
	self assert: (browser panes first port: #text) value equals: nil.
	self assert: (browser panes first port: #selectionInterval) value equals: nil.
	browser startOn: 42.
	self assert: (browser panes first port: #text) value equals: 'foo42'.
	self assert: (browser panes first port: #selectionInterval) value equals: (2 to: 3).
	(browser pane port: #entity) transientValue: 43.
	self assert: (browser panes first port: #text) value equals: 'foo43'.
	self assert: (browser panes first port: #selectionInterval) value equals: (2 to: 3).
	(browser pane port: #entity) value: 44.
	self assert: (browser panes first port: #text) value equals: 'foo44'.
	self assert: (browser panes first port: #selectionInterval) value equals: (2 to: 3).! !

!GLMPortTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testTransientValue
	| port pane browser |
	browser := GLMTabulator new.
	browser
		column: #one;
		column: #two.
	(browser transmit)
		fromOutsidePort: #entity;
		to: #one port: #entity.
	(browser transmit)
		from: #one port: #entity;
		to: #two;
		andShow: [ :a | a text ].
	browser startOn: 42.
	self assert: (browser panes first port: #entity) value equals: 42.
	self assert: (browser panes last port: #entity) value equals: 42.
	(browser panes first port: #entity) transientValue: 43.
	self assert: (browser pane port: #entity) value equals: 42.
	self assert: (browser panes first port: #entity) value equals: 42.
	self assert: (browser panes last port: #entity) value equals: 43.
	(browser pane port: #entity) transientValue: 44.
	self assert: (browser pane port: #entity) value equals: 42.
	self assert: (browser panes first port: #entity) value equals: 44.
	self assert: (browser panes last port: #entity) value equals: 44! !

!GLMPortTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testResetValue
	| port |
	port := GLMTestPane new port: #port1.
	port value: 42.
	self assert: port value equals: 42.
	port resetValue.
	self assert: port value isNil! !

!GLMPortTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPanePortTransmissionCallingReceiveIn
	| originPort destinationPort transmission |
	originPort := GLMTestPane new port: #originPort.
	destinationPort := GLMTestPane new port: #destinationPort.
	self assert: destinationPort seenTransmissions isEmpty.
	transmission := (GLMTransmission new)
		addActiveOrigin: originPort;
		destination: destinationPort;
		transformation: [ :x | x + 1 ].
	originPort value: 41.
	transmission transmit.
	self assert: destinationPort seenTransmissions size equals: 1.
	self assert: destinationPort seenTransmissions first origins first value equals: 41.
	self assert: destinationPort seenTransmissions first destination == destinationPort.
	self assert: destinationPort value equals: 42! !

!GLMPortTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testSimplePort
	| port |
	port := GLMSimplePort new.
	port name: #foo.
	port value: 42.
	self assert: port name equals: #foo.
	self assert: port value equals: 42.
	self assert: port hasPane not! !

!GLMPortUpdater commentStamp: '<historical>'!
This is a strategy that populates a portSymbol with the result of evaluating valueBlock.!
!GLMPortUpdater methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
portSymbol 
	 
	^portSymbol! !

!GLMPortUpdater methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
glamourValueWithArgs: anArray 
	 
	(anArray first pane port: self portSymbol) 
		value: (self valueBlock glamourValueWithArgs: anArray)! !

!GLMPortUpdater methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
portSymbol: anObject 
	 
	portSymbol := anObject! !

!GLMPortUpdater methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
valueBlock: anObject 
	 
	valueBlock := anObject! !

!GLMPortUpdater methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
valueBlock 
	 
	^valueBlock! !

!GLMPresentIfNoneStrategy commentStamp: 'tg 2/20/2010 14:52'!
This strategy sets presentations only if none exits in the pane of the destination port.!
!GLMPresentIfNoneStrategy methodsFor: 'transmitting' stamp: 'TudorGirba 3/15/2013 21:15'!
transmitIn: aContext
	(self transmission destination hasPane and: [
		self transmission destination pane presentations isEmpty]) ifTrue: [	
			self transmission destination pane
				notingPresentationChangeDo: [
					self transmission destination pane clearIn: aContext.
					self transmission destination pane presentations: self presentations copy ] ]! !

!GLMPresentStrategy commentStamp: 'DamienCassou 7/9/2011 23:02'!
The abstract strategy that deals with setting of presentations on the pane of the destination port.!
!GLMPresentStrategy methodsFor: 'accessing' stamp: 'AndreiChis 5/29/2013 12:54'!
presentationsFactory: anObject
	presentationsFactory := anObject! !

!GLMPresentStrategy methodsFor: 'accessing' stamp: 'AndreiChis 8/11/2013 18:40'!
presentations
	<debuggingStone: #presentationCreation label: 'Presentation creation'>
	| presentations |
	presentations := GLMCompositePresentation new.
	self presentationsFactory glamourValue: (
			presentations asGlamorousMultiValue, 
			(self transmission origins collect: #value )).
	^ presentations! !

!GLMPresentStrategy methodsFor: 'accessing' stamp: 'AndreiChis 5/29/2013 12:54'!
presentationsFactory
	^ presentationsFactory! !

!GLMPresentStrategy methodsFor: 'accessing-convenience' stamp: 'tg 1/14/2010 17:07'!
addPresentations: aCollection
	aCollection do: [:each | self addPresentation: each ]! !

!GLMPresentStrategy methodsFor: 'accessing-convenience' stamp: 'AndreiChis 5/30/2013 18:01'!
addPresentation: aPresentation
	|currentPresentations|
	
	currentPresentations  := self presentations.
	self presentationsFactory: [ :composite | 
		currentPresentations do: [ :each | composite add: each ].
		composite add: aPresentation copy ]! !

!GLMPresentStrategy methodsFor: 'accessing' stamp: 'AndreiChis 5/30/2013 17:13'!
presentations: anObject
	"self presentationsFactory: anObject "! !

!GLMPresentation commentStamp: 'DamienCassou 7/19/2011 21:14'!
A GLMPresentation is the abstract class for the hierarchy of presentations. A presentation specifies how the pane (held in the pane instance variable) is going to be displayed. It typically reads at least the #entity port of a pane and populates at least the #selection port.

updateActions holds a collection of GLMUpdateAction that are used to update the presentation via announcements.

rawSelectionTransmissions holds a collection of transmission whose origins are this presentation's #rawSelection port. Destinations of this transmissions are on the pane. This collection always contains at least one transmission to the pane's #selection port. To transform the values travelling through this transmission use #send:. To add new transmissions, use #send:as:.

Because Glamour has a prototype-based design it relies on copying the presentations before installing them in panes (via transmissions). The parentPrototype instance variable keeps track of the presentation from which the current one was copied.

It raises:
- GLMContextChanged to let the world know that something has changed in the containing pane. This is typically used by the renderer to update the rendering.
- GLMPresentationUpdated to let the world know that the presentations wants to be updated because of reasons other than the pane context changed.!
!GLMPresentation methodsFor: 'copying' stamp: 'TudorGirba 2/11/2011 22:59'!
parentPrototype: aPresentation
	"used to keep track of the (prototype) presentation from which
	the current one was copied"
	parentPrototype := aPresentation! !

!GLMPresentation methodsFor: 'scripting actions' stamp: 'tg 11/19/2010 18:13'!
populate: aPortSymbol on: aCharacter entitled: aString with: aBlock 
	 
	self 
		addAction: 
			((GLMGenericAction new) 
				action: 
						((GLMPortUpdater new) 
								portSymbol: aPortSymbol; 
								valueBlock: aBlock; 
								yourself); 
				shortcut: aCharacter; 
				title: aString;
				yourself)! !

!GLMPresentation methodsFor: 'statusbar' stamp: 'TudorGirba 10/8/2011 18:47'!
addDefaultStatusbarTransmissionFrom: aPane
	| defaultTransmission |
	defaultTransmission := GLMTransmission new
		ensureReplacePresentationsStrategy;
		addActiveOrigin: (aPane port: #status); 
		destination: (self statusbarPane port: #entity); 
		addPresentation: self statusbarPresentation; 
		yourself.
	self addTransmission: defaultTransmission.! !

!GLMPresentation methodsFor: 'updating' stamp: 'tg 1/30/2010 23:22'!
registeredAnnouncers
	^ registeredAnnouncers ifNil: [registeredAnnouncers := OrderedCollection new]! !

!GLMPresentation methodsFor: 'accessing' stamp: 'tg 11/6/2009 20:08'!
color: aSymbolOrColor
	color := aSymbolOrColor! !

!GLMPresentation methodsFor: 'accessing' stamp: 'cyrilledelaunay 8/9/2011 11:18'!
addSelectionOpenBrowserAction: anAction
	self selectionOpenBrowserActions add: anAction! !

!GLMPresentation methodsFor: 'accessing' stamp: 'TudorGirba 5/20/2012 23:18'!
watcherPane
	^ nil! !

!GLMPresentation methodsFor: 'initialize-release' stamp: 'TudorGirba 10/17/2014 15:04'!
initialize
	super initialize.
	updateActions := OrderedCollection new.
	portChangeActions := OrderedCollection new.
	rawSelectionTransmissions := IdentitySet new.
	self addRawSelectionTransmissionTo: #selection! !

!GLMPresentation methodsFor: 'scripting' stamp: ' 4/5/09 22:18'!
display: aBlock 
	 
	self transformation: aBlock! !

!GLMPresentation methodsFor: 'scripting actions' stamp: 'TudorGirba 11/27/2010 12:37'!
actions: aBlock 
	self deprecated: 'use dynamicActionsOnSelection: for contextual actions, and dynamicActions for presentation-wide actions'.
	^ self dynamicActionsOnSelection: aBlock ! !

!GLMPresentation methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
title: aStringOrBlock 
	 
	title := aStringOrBlock! !

!GLMPresentation methodsFor: 'copying' stamp: 'tg 1/11/2010 22:32'!
rootPrototype
	^ self parentPrototype isNil 
		ifTrue: [ self ] 
		ifFalse: [ self parentPrototype rootPrototype ]
! !

!GLMPresentation methodsFor: 'events' stamp: 'TudorGirba 10/17/2014 15:12'!
outerPortEvent: aPortEvent
	self announce: (GLMContextChanged new
				presentation: self; 
				property: aPortEvent portName; 
				value: aPortEvent value; 
				oldValue: aPortEvent oldValue; 
				yourself).
	self portChangeActions do: [ :each | 
		each portName = aPortEvent portName ifTrue: [ 
			each actOn: self ] ]! !

!GLMPresentation methodsFor: 'accessing validation' stamp: 'tg 11/15/2009 23:52'!
customValidation: aBlock
	customValidation := aBlock.
	shouldValidate := true.! !

!GLMPresentation methodsFor: 'accessing' stamp: 'TudorGirba 2/28/2014 06:32'!
allActions 
	^ (self actions, self dynamicActions) 
			select: [ :each | each isAvailableOn: self ]! !

!GLMPresentation methodsFor: 'scripting actions' stamp: 'tg 9/25/2010 17:53'!
act: aBlock on: aCharacter 
	 
	self 
		addAction: 
			((GLMGenericAction new) 
				action: aBlock; 
				shortcut: aCharacter; 
				yourself)! !

!GLMPresentation methodsFor: 'accessing validation' stamp: 'tg 11/15/2009 23:50'!
shouldValidate: aBoolean
	shouldValidate := aBoolean ! !

!GLMPresentation methodsFor: 'updating' stamp: 'AndreiChis 10/5/2014 18:12'!
updateToolbar

	self announce: (GLMPresentationToolbarUpdated new presentation: self)! !

!GLMPresentation methodsFor: 'scripting actions' stamp: 'tg 9/25/2010 17:54'!
populate: aPortSymbol on: aCharacter with: aBlock
	self addAction: 
			((GLMGenericAction new) 
				action: ((GLMPortUpdater new) 
								portSymbol: aPortSymbol; 
								valueBlock: aBlock; 
								yourself); 
				shortcut: aCharacter; 
				yourself)! !

!GLMPresentation methodsFor: 'scripting' stamp: 'tg 9/25/2010 17:53'!
open: aBlock on: aCharacter entitled: aString 
	 
	self 
		addAction: 
			((GLMGenericAction new) 
				action: aBlock; 
				shortcut: aCharacter; 
				title: aString; 
				yourself)! !

!GLMPresentation methodsFor: 'testing' stamp: 'AndreiChis 8/11/2013 18:40'!
matches 
	<debuggingStone: #presentationCondition label: 'Presentation condition'>
	"answer true iff the presentation matches the current context so that it can be displayed"
	^ (self usesImplicitAllNil
	    ifTrue:[ GLMAllNilCondition new glamourValue: self entity ]
	    ifFalse:[ self usesImplicitNotNil 
			ifTrue: [GLMAllNotNilCondition new glamourValue: self entity] 
			ifFalse: [GLMSomeNotNilCondition new glamourValue: self entity] ]
		) and: [
			(self condition glamourValue: self entity) = true]! !

!GLMPresentation methodsFor: 'updating' stamp: 'tg 8/24/2010 21:40'!
update
	self pane ports do: [:each |
		(self validate: each value on: each) ifFalse: [each resetValue] ].
	self announce: (GLMPresentationUpdated new presentation: self)! !

!GLMPresentation methodsFor: 'accessing values' stamp: 'TudorGirba 12/17/2013 10:32'!
displayValue
	^ cachedDisplayedValue := self transformation glamourValue: self entity! !

!GLMPresentation methodsFor: 'scripting' stamp: ' 4/5/09 22:18'!
whenKindOf: aClass 
	 
	self when: [:each | each isKindOf: aClass]! !

!GLMPresentation methodsFor: 'scripting actions' stamp: 'tg 11/20/2010 20:14'!
selectionAct: aBlock entitled: aString categorized: anotherString
	 
	self 
		addSelectionAction: 
			((GLMGenericAction new) 
				action: aBlock; 
				title: aString; 
				category: anotherString;
				yourself)! !

!GLMPresentation methodsFor: 'accessing ports' stamp: 'TudorGirba 9/24/2012 08:10'!
rawSelection
	^ (self pane port: #rawSelection) value! !

!GLMPresentation methodsFor: 'scripting actions' stamp: 'tg 11/20/2010 20:15'!
selectionAct: aBlock entitled: aString 
	 
	self 
		addSelectionAction: 
			((GLMGenericAction new) 
				action: aBlock; 
				title: aString; 
				yourself)! !

!GLMPresentation methodsFor: 'stepping' stamp: 'AndreiChis 3/16/2015 16:49'!
stepTime

	^ stepTime ifNil: [ super stepTime ]! !

!GLMPresentation methodsFor: 'scripting' stamp: 'TudorGirba 7/29/2012 08:50'!
with: aBlock
	aBlock value: self! !

!GLMPresentation methodsFor: 'stepping' stamp: 'AndreiChis 3/16/2015 16:49'!
stepTime: anInteger

	stepTime := anInteger! !

!GLMPresentation methodsFor: 'accessing' stamp: 'tg 4/1/2010 07:15'!
acceptsSelection
	"this flag is used to specify whether the presentation
	is allowed to populate the selection port or not"
	^ acceptsSelection ifNil: [acceptsSelection := true]! !

!GLMPresentation methodsFor: 'accessing ports' stamp: 'DamienCassou 7/19/2011 21:16'!
status: anObject 
	self flag: 'what kind of transformation should we want here?'.
	(self pane port: #status) value: (self selectionTransformation glamourValue: anObject)! !

!GLMPresentation methodsFor: 'scripting actions' stamp: 'tg 9/25/2010 17:54'!
act: aBlock on: aCharacter entitled: aString categorized: anotherString 
	 
	self 
		addAction: 
			((GLMGenericAction new) 
				action: aBlock; 
				shortcut: aCharacter; 
				title: aString; 
				category: anotherString;
				yourself)! !

!GLMPresentation methodsFor: 'accessing' stamp: 'TudorGirba 10/17/2014 15:05'!
portChangeActions: anObject
	portChangeActions := anObject! !

!GLMPresentation methodsFor: 'scripting actions' stamp: 'tg 11/20/2010 20:13'!
selectionAct: aBlock on: aCharacter 
	 
	self 
		addSelectionAction: 
			((GLMGenericAction new) 
				action: aBlock; 
				shortcut: aCharacter; 
				yourself)! !

!GLMPresentation methodsFor: 'accessing' stamp: 'VeronicaUquillas 2/18/2011 15:14'!
useExplicitAllNil 
	 
	implicitAllNil := true! !

!GLMPresentation methodsFor: 'statusbar' stamp: 'TudorGirba 10/8/2011 18:47'!
addStatusbar
	self hasStatusbar: true
	! !

!GLMPresentation methodsFor: 'testing' stamp: ' 4/5/09 22:18'!
usesExplicitNotNil 
	 
	^self usesImplicitNotNil not! !

!GLMPresentation methodsFor: 'copying' stamp: 'tg 1/11/2010 22:33'!
parentPrototype
	^ parentPrototype! !

!GLMPresentation methodsFor: 'initialize-release' stamp: 'AndreHora 2/14/2014 16:53'!
initializePresentation
	initializationBlock ifNotNil: [ initializationBlock value: self ]! !

!GLMPresentation methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 7/4/2014 08:07'!
gtInspectorPanePortsIn: composite
	<gtInspectorPresentationOrder: 50>
	(self pane gtInspectorPortsIn: composite)
		title: 'Pane ports'! !

!GLMPresentation methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
transformation: aBlock 
	 
	transformation := aBlock! !

!GLMPresentation methodsFor: 'scripting actions' stamp: 'tg 11/20/2010 20:16'!
selectionAct: aBlock icon: anIcon entitled: aString
	self 
		addSelectionAction: 
			((GLMGenericAction new) 
				action: aBlock; 
				icon: anIcon;
				title: aString;
				yourself)! !

!GLMPresentation methodsFor: 'accessing' stamp: 'tg 11/14/2010 18:19'!
dynamicActionsOnSelection: aBlock
	selectionDynamicActionsBlock := aBlock! !

!GLMPresentation methodsFor: 'accessing' stamp: 'TudorGirba 2/28/2014 06:32'!
allSelectionActions 
	^ (self selectionActions, self dynamicActionsOnSelection)
			select: [ :each | each isAvailableOn: self ]! !

!GLMPresentation methodsFor: 'scripting actions' stamp: 'tg 9/25/2010 17:54'!
act: aBlock entitled: aString 
	 
	self 
		addAction: 
			((GLMGenericAction new) 
				action: aBlock; 
				title: aString; 
				yourself)! !

!GLMPresentation methodsFor: 'events' stamp: 'tg 2/22/2010 13:11'!
innerPortEvent: aPortEvent 
	 "Regular presentations do not have inner ports,
	  so the default behaviour is to do nothing"! !

!GLMPresentation methodsFor: 'scripting actions' stamp: 'tg 9/25/2010 17:53'!
act: aBlock on: aCharacter entitled: aString 
	 
	self 
		addAction: 
			((GLMGenericAction new) 
				action: aBlock; 
				shortcut: aCharacter; 
				title: aString; 
				yourself)! !

!GLMPresentation methodsFor: '*glamour-morphic-renderer' stamp: 'AndreiChis 12/3/2012 21:15'!
morphicSelectionAct: aBlock icon: anIcon on: aCharacter entitled: aString
	self 
		addSelectionAction: 
			((GLMMorphicAction new) 
				action: aBlock; 
				shortcut: aCharacter; 				
				icon: anIcon;
				title: aString;
				yourself)! !

!GLMPresentation methodsFor: 'transmitting' stamp: 'DamienCassou 7/19/2011 20:11'!
selectionTransformation: anObject 
	self selectionTransmission 	transformation: anObject ! !

!GLMPresentation methodsFor: 'accessing' stamp: 'TudorGirba 2/11/2011 23:04'!
actions
	"These are actions that make sense for the entire presentation."
	actions ifNil: [actions := OrderedCollection new].
	^ actions! !

!GLMPresentation methodsFor: 'accessing ports' stamp: 'tg 12/29/2009 00:31'!
entity: anObject
	(self pane port: #entity) value: anObject! !

!GLMPresentation methodsFor: 'accessing values' stamp: 'TudorGirba 12/17/2013 11:13'!
displayedValue
	"This returns the cached displayed value.
	
	This is particularly useful when we need to work with the
	value being displayed in the presentation without recomputing it."
	^ cachedDisplayedValue! !

!GLMPresentation methodsFor: 'enumerating' stamp: 'TudorGirba 7/9/2011 20:00'!
withAllPanesAndPresentationsDo: aBlock
	^ aBlock value: self! !

!GLMPresentation methodsFor: 'statusbar' stamp: 'TudorGirba 10/8/2011 18:47'!
statusbarPresentation
	^ GLMLabelPresentation new! !

!GLMPresentation methodsFor: 'printing' stamp: 'DamienCassou 7/3/2011 20:02'!
printOn: aStream
	super printOn: aStream.
	aStream
		nextPutAll: '(id=';
		nextPutAll: self identityHash printString;
		nextPutAll: ' title=';
		nextPutAll: self titleValue asString;
		nextPutAll: ' pane=';
		nextPutAll: self pane printString;
		nextPutAll: ')'! !

!GLMPresentation methodsFor: 'accessing' stamp: 'tg 12/29/2009 02:16'!
acceptsSelection: aBoolean
	acceptsSelection := aBoolean! !

!GLMPresentation methodsFor: 'statusbar' stamp: 'TudorGirba 10/8/2011 18:47'!
hasStatusbar: aBoolean
	aBoolean ifTrue: [
		statusPane := self addPane: (GLMPane new name: self class defaultStatusbarPane) ]
	! !

!GLMPresentation methodsFor: 'statusbar' stamp: 'TudorGirba 10/8/2011 18:47'!
hasStatusbar
	^ statusPane notNil! !

!GLMPresentation methodsFor: 'accessing ports' stamp: 'ChristopheDemarey 1/26/2015 12:06'!
selection: anObject
	"Tell the pane about the new selection. This method is called when the user changes a view's selection' (e.g., he clicks on an element in a list morph)." 
	(self pane port: #rawSelection) value: anObject.
	self acceptsSelection ifFalse: [^ self].
	rawSelectionTransmissions do: #transmit! !

!GLMPresentation methodsFor: 'scripting actions' stamp: 'TudorGirba 12/16/2011 17:40'!
spawn: aBlock entitled: aString 
	"These are actions that return a glamour browser to open at the end."
	self 
		addAction: 
			((GLMSpawnBrowserAction new) 
				action: aBlock; 
				title: aString; 
				yourself)! !

!GLMPresentation methodsFor: 'accessing' stamp: 'TudorGirba 2/11/2011 23:04'!
dynamicActions
	"These are actions that make sense for the entire presentation.
	They are dynamic in the sense that they will be evaluated lazily by the renderer"
	dynamicActionsBlock isNil ifTrue: [ ^ OrderedCollection new ].
	^ dynamicActionsBlock glamourValue: self! !

!GLMPresentation methodsFor: 'scripting actions' stamp: 'tg 11/19/2010 18:13'!
selectionPopulate: aPortSymbol on: aCharacter entitled: aString with: aBlock 
	 
	self 
		addSelectionAction: 
			((GLMGenericAction new) 
				action: 
						((GLMPortUpdater new) 
								portSymbol: aPortSymbol; 
								valueBlock: aBlock; 
								yourself); 
				shortcut: aCharacter; 
				title: aString;
				yourself)! !

!GLMPresentation methodsFor: 'scripting' stamp: 'TudorGirba 9/27/2012 22:24'!
noTitleIcon
	titleIcon := nil! !

!GLMPresentation methodsFor: 'updating' stamp: 'tg 5/3/2010 01:33'!
updateOn: anAnnouncement from: aBlockOrSymbol 
	updateActions add: (GLMSingleUpdateAction new 
		presentation: self;
		announcement: anAnnouncement; 
		transformation: aBlockOrSymbol;
		yourself)! !

!GLMPresentation methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
addAction: anAction 
	 
	self actions addLast: anAction! !

!GLMPresentation methodsFor: 'updating' stamp: 'tg 5/3/2010 01:33'!
updateOn: anAnnouncement fromAll: aBlockOrSymbol 
	updateActions add: (GLMMultipleUpdateAction new
		presentation: self; 
		announcement: anAnnouncement; 
		transformation: aBlockOrSymbol;
		yourself)! !

!GLMPresentation methodsFor: '*glamour-morphic-renderer' stamp: 'AndreiChis 12/3/2012 21:14'!
morphicPopulate: aPortSymbol icon: anIcon on: aCharacter entitled: aString with: aBlock 
	 
	self 
		addAction: 
			((GLMMorphicAction new) 
				action: 
						((GLMPortUpdater new) 
								portSymbol: aPortSymbol; 
								valueBlock: aBlock; 
								yourself); 
				shortcut: aCharacter; 
				icon: anIcon;
				title: aString;
				yourself)! !

!GLMPresentation methodsFor: 'scripting' stamp: 'DamienCassou 7/19/2011 20:49'!
send: aBlock as: aPortSymbol
	(self
			rawSelectionTransmissionFor: aPortSymbol
			ifNone: [ self addRawSelectionTransmissionTo: aPortSymbol ])
		transformation: aBlock! !

!GLMPresentation methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
transformation 
	 
	^transformation ifNil: [transformation := #yourself]! !

!GLMPresentation methodsFor: 'testing' stamp: 'VeronicaUquillas 2/18/2011 15:25'!
usesImplicitAllNil
	 
	^implicitAllNil ifNil: [implicitAllNil := false ]! !

!GLMPresentation methodsFor: '*glamour-morphic-renderer' stamp: 'AndreiChis 12/3/2012 21:15'!
morphicSelectionAct: aBlock entitled: aString 
	 
	self addSelectionAction: 
			((GLMMorphicAction new) 
				action: aBlock; 
				title: aString; 
				yourself)! !

!GLMPresentation methodsFor: 'rendering' stamp: 'tg 11/8/2009 00:24'!
renderGlamorouslyOn: aRenderer 
	self registerAnnouncements.
	^aRenderer renderPresentation: self! !

!GLMPresentation methodsFor: 'accessing ports' stamp: 'tg 12/29/2009 00:31'!
entity
	^ (self pane port: #entity) value! !

!GLMPresentation methodsFor: 'accessing' stamp: 'tg 11/6/2009 20:08'!
color
	^ color! !

!GLMPresentation methodsFor: 'accessing' stamp: 'TudorGirba 7/14/2011 15:39'!
pane
	^ pane ifNil: [
		pane := (GLMPane named: 'root' in: GLMNoBrowser new) 
				addPresentationSilently: self; 
				yourself]! !

!GLMPresentation methodsFor: 'accessing' stamp: 'TudorGirba 10/12/2014 10:52'!
titleAction

	^ self titleActionBlock 
		ifNil: [ nil ]
		ifNotNil: [ :aBlock |
			aBlock glamourValue: self ]! !

!GLMPresentation methodsFor: 'scripting' stamp: 'tg 8/25/2009 16:01'!
send: aBlock 
	self selectionTransformation: aBlock! !

!GLMPresentation methodsFor: 'accessing' stamp: 'tg 11/19/2010 18:15'!
addSelectionAction: anAction
	self selectionActions add: anAction! !

!GLMPresentation methodsFor: 'transmitting' stamp: 'DamienCassou 7/19/2011 20:36'!
addRawSelectionTransmissionTo: aPortSymbol
	^ rawSelectionTransmissions
		add:
			((GLMTransmission new)
				addActiveOrigin:
						((GLMPresentationBoundPort new)
								name: #rawSelection;
								presentation: self;
								yourself);
				destination:
						((GLMPresentationBoundPort new)
								name: aPortSymbol;
								presentation: self;
								yourself))! !

!GLMPresentation methodsFor: 'events' stamp: 'TudorGirba 10/18/2014 21:57'!
windowIsClosing 
	| event |
	event := GLMBrowserClosing new.
	self withAllPresentations do: [ :each | each announce: event ]! !

!GLMPresentation methodsFor: 'accessing' stamp: 'AndreiChis 5/24/2013 11:44'!
sourceContext
	^ sourceLink! !

!GLMPresentation methodsFor: 'accessing' stamp: 'AndreiChis 6/23/2013 21:46'!
initialize: aBlock
	"aBlock is called when the presentation is placed on a pane as a result
	of a transmission. It can be used to initialize  multiple ports."

	initializationBlock := aBlock! !

!GLMPresentation methodsFor: 'scripting' stamp: 'TudorGirba 9/27/2012 07:08'!
noTitle
	title := nil.
	titleIcon := nil! !

!GLMPresentation methodsFor: 'accessing' stamp: 'tg 9/30/2009 23:51'!
titleIcon
	^ titleIcon! !

!GLMPresentation methodsFor: 'accessing ports' stamp: 'tg 12/29/2009 00:31'!
selection
	^ (self pane port: #selection) value! !

!GLMPresentation methodsFor: 'stepping' stamp: 'AndreiChis 3/16/2015 16:50'!
wantsSteps: aBoolean

	wantsSteps := aBoolean! !

!GLMPresentation methodsFor: 'accessing values' stamp: 'tg 1/14/2010 02:47'!
titleValue
	^ self title glamourValue: self entity! !

!GLMPresentation methodsFor: 'validation' stamp: 'tg 11/15/2009 23:46'!
doValidate: anObject on: aPort 
	^ self customValidation isNil ifFalse: [ 
		self customValidation glamourValue: (
			anObject asGlamorousMultiValue,
			aPort name asGlamorousMultiValue, 
			self entity asGlamorousMultiValue) ]
	ifTrue: [ self defaultValidate: anObject on: aPort ]! !

!GLMPresentation methodsFor: 'testing' stamp: ' 4/5/09 22:18'!
usesImplicitNotNil 
	 
	^implicitNotNil ifNil: [implicitNotNil := true]! !

!GLMPresentation methodsFor: 'scripting actions' stamp: 'TudorGirba 10/17/2014 15:07'!
onChangeOfPort: aPortName act: aBlock
	self portChangeActions add: (
		GLMPortChangeAction new 
			portName: aPortName;
			action: aBlock)! !

!GLMPresentation methodsFor: 'validation' stamp: 'TudorGirba 2/11/2011 22:45'!
validate: anObject on: aPort 
	"This gets triggered when aPort wants to be changed.
	The presentation has a chance to veto the value."
	self shouldValidate ifFalse: [ ^ true ].
	^ self doValidate: anObject on: aPort.! !

!GLMPresentation methodsFor: '*glamour-morphic-renderer' stamp: 'AndreiChis 12/3/2012 21:14'!
morphicAct: aBlock on: aCharacter entitled: aString 
	 
	self 
		addAction: 
			((GLMMorphicAction new) 
				action: aBlock; 
				shortcut: aCharacter; 
				title: aString; 
				yourself)! !

!GLMPresentation methodsFor: 'transmitting' stamp: 'DamienCassou 7/19/2011 20:50'!
selectionTransmission
	^ self rawSelectionTransmissionFor: #selection ifNone: [nil]! !

!GLMPresentation methodsFor: '*glamour-morphic-renderer' stamp: 'AndreiChis 12/3/2012 21:15'!
morphicSelectionAct: aBlock icon: anIcon entitled: aString
	self 
		addSelectionAction: 
			((GLMMorphicAction new) 
				action: aBlock; 
				icon: anIcon;
				title: aString;
				yourself)! !

!GLMPresentation methodsFor: 'accessing' stamp: 'VeronicaUquillas 2/18/2011 15:15'!
useImplicitAllNil 
	 
	implicitAllNil := true! !

!GLMPresentation methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
useExplicitNotNil 
	 
	implicitNotNil := false! !

!GLMPresentation methodsFor: 'scripting' stamp: 'tg 11/18/2009 15:34'!
allowNil
	^ self useExplicitNotNil! !

!GLMPresentation methodsFor: 'accessing ports' stamp: 'DamienCassou 7/19/2011 21:16'!
strongSelection: anObject
	(self pane port: #strongSelection) value: (self selectionTransformation glamourValue: anObject)! !

!GLMPresentation methodsFor: 'transmitting' stamp: 'DamienCassou 7/19/2011 21:16'!
selectionTransformation
	"this is used for transforming the object before updating the selection"
	^ self selectionTransmission transformation ifNil: [#yourself]! !

!GLMPresentation methodsFor: 'copying' stamp: 'DamienCassou 7/19/2011 20:06'!
postCopy
	super postCopy.
	pane := nil.
	self flag: 'self unregisterFromAllAnnouncements.'.
	updateActions := updateActions
		collect: [ :each | 
			(each copy)
				presentation: self;
				yourself ].
	rawSelectionTransmissions := rawSelectionTransmissions collect: [:each | each copy].
	rawSelectionTransmissions do: [:transmission | transmission originReferences do: [:portRef | portRef port presentation: self]].
	rawSelectionTransmissions do: [:transmission | transmission destination presentation: self]! !

!GLMPresentation methodsFor: 'scripting actions' stamp: 'TudorGirba 3/5/2011 23:46'!
act: aBlock icon: anIcon on: aCharacter entitled: aString
	self 
		addAction: 
			((GLMGenericAction new) 
				action: aBlock; 
				shortcut: aCharacter; 				
				icon: anIcon;
				title: aString;
				yourself)! !

!GLMPresentation methodsFor: 'accessing' stamp: 'AndreiChis 5/24/2013 11:41'!
sourceContext: aContext
	sourceLink := aContext! !

!GLMPresentation methodsFor: 'scripting actions' stamp: 'TudorGirba 12/16/2011 17:40'!
spawn: aBlock icon: anIcon entitled: aString
	self 
		addAction: 
			((GLMSpawnBrowserAction new) 
				action: aBlock; 
				icon: anIcon;
				title: aString;
				yourself)! !

!GLMPresentation methodsFor: 'scripting actions' stamp: 'tg 11/19/2010 18:16'!
selectionAct: aBlock on: aCharacter entitled: aString 
	 
	self 
		addSelectionAction: 
			((GLMGenericAction new) 
				action: aBlock; 
				shortcut: aCharacter; 
				title: aString; 
				yourself)! !

!GLMPresentation methodsFor: 'scripting actions' stamp: 'TudorGirba 2/4/2011 22:05'!
populate: aPortSymbol icon: anIcon on: aCharacter entitled: aString with: aBlock 
	 
	self 
		addAction: 
			((GLMGenericAction new) 
				action: 
						((GLMPortUpdater new) 
								portSymbol: aPortSymbol; 
								valueBlock: aBlock; 
								yourself); 
				shortcut: aCharacter; 
				icon: anIcon;
				title: aString;
				yourself)! !

!GLMPresentation methodsFor: 'accessing' stamp: 'tg 9/30/2009 23:51'!
titleIcon: anObject
	titleIcon := anObject! !

!GLMPresentation methodsFor: 'accessing values' stamp: 'tg 11/1/2009 22:16'!
titleIconValue
	^ self titleIcon notNil
		ifTrue: [ self titleIcon glamourValue: self entity ]
		ifFalse: [ self titleIcon ]! !

!GLMPresentation methodsFor: 'accessing' stamp: 'tg 11/19/2010 18:16'!
selectionActions: anObject
	selectionActions := anObject! !

!GLMPresentation methodsFor: 'accessing' stamp: 'AndreiChis 12/5/2013 15:34'!
allActionsWithShortcuts 
	^ (self allActions, self allSelectionActions) select: [ :action | action hasShortcut ]! !

!GLMPresentation methodsFor: 'accessing validation' stamp: 'tg 11/15/2009 16:14'!
customValidation
	^ customValidation! !

!GLMPresentation methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
condition: anObject 
	 
	condition := anObject! !

!GLMPresentation methodsFor: 'accessing validation' stamp: 'tg 11/15/2009 23:47'!
shouldValidate
	^ shouldValidate ifNil: [shouldValidate := false]! !

!GLMPresentation methodsFor: 'scripting actions' stamp: 'tg 9/25/2010 17:54'!
populate: aPortSymbol icon: anIcon entitled: aString with: aBlock 
	 
	self 
		addAction: 
			((GLMGenericAction new) 
				action: 
						((GLMPortUpdater new) 
								portSymbol: aPortSymbol; 
								valueBlock: aBlock; 
								yourself); 
				icon: anIcon; 
				title: aString;
				yourself)! !

!GLMPresentation methodsFor: 'statusbar' stamp: 'TudorGirba 10/8/2011 18:47'!
statusbarPane
	^ statusPane! !

!GLMPresentation methodsFor: 'accessing' stamp: 'cyrilledelaunay 8/9/2011 11:18'!
addOpenBrowserAction: anAction 
	 
	self openBrowserActions addLast: anAction! !

!GLMPresentation methodsFor: 'updating' stamp: 'tg 5/3/2010 00:15'!
unregisterFromAllAnnouncements
	"this method should be called every time the presentation is not needed"
	updateActions do: [ :each | each unregisterFromAllAnnouncements ]! !

!GLMPresentation methodsFor: 'scripting actions' stamp: 'TudorGirba 10/12/2014 10:52'!
titleAction: aBlock 

	labelActionBlock := aBlock! !

!GLMPresentation methodsFor: 'validation' stamp: 'TudorGirba 3/5/2011 21:20'!
defaultValidate: anObject on: aPort 
	"by default any object is allowed in any port"
	"override this method in subclasses to specify stronger constraints"
	^ true! !

!GLMPresentation methodsFor: 'accessing values' stamp: 'tg 11/6/2009 20:08'!
colorValue
	^ self color notNil
		ifTrue: [ self color glamourValue: self entity ]
		ifFalse: [ self color ]
"
	
	self color isSymbol
		ifTrue: [ Color perform: self color ]
		ifFalse: [ self color ]"! !

!GLMPresentation methodsFor: 'accessing' stamp: 'TudorGirba 12/8/2013 21:47'!
dynamicActionsOnSelection
	"These are actions that make sense only in the context of values held in the selection port.
	They are dynamic in the sense that they will be evaluated lazily by the renderer"
	(selectionDynamicActionsBlock isNil or: [ 
		self selection isNil ])
		ifTrue: [ ^ OrderedCollection new ].
	^ selectionDynamicActionsBlock glamourValue: self! !

!GLMPresentation methodsFor: 'transmitting' stamp: 'DamienCassou 7/19/2011 20:48'!
rawSelectionTransmissionFor: aPortSymbol ifNone: ifNoneBlock
	^ rawSelectionTransmissions
		detect: [ :transmission | transmission destination port name = aPortSymbol ]
		ifNone: ifNoneBlock! !

!GLMPresentation methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
condition 
	 
	^condition ifNil: [condition := [true]]! !

!GLMPresentation methodsFor: 'accessing' stamp: 'tg 1/14/2010 02:47'!
title
	^ title! !

!GLMPresentation methodsFor: 'accessing' stamp: 'TudorGirba 10/17/2014 15:05'!
portChangeActions
	^ portChangeActions! !

!GLMPresentation methodsFor: 'scripting actions' stamp: 'TudorGirba 6/28/2014 22:21'!
selectionPopulate: aPortSymbol entitled: aString with: aBlock 
	 
	self 
		addSelectionAction: 
			((GLMGenericAction new) 
				action: 
						((GLMPortUpdater new) 
								portSymbol: aPortSymbol; 
								valueBlock: aBlock; 
								yourself); 
				title: aString;
				yourself)! !

!GLMPresentation methodsFor: 'accessing' stamp: 'TudorGirba 2/11/2011 23:04'!
selectionActions
	"These are actions that make sense only in the context of values held in the selection port."
	^ selectionActions ifNil: [ selectionActions := OrderedCollection new ]! !

!GLMPresentation methodsFor: 'enumerating' stamp: 'TudorGirba 7/10/2011 01:03'!
withAllPanes
	| result |
	result := OrderedCollection new.
	self withAllPanesAndPresentationsDo: [:each |
		(each isKindOf: GLMPane) ifTrue: [ result add: each ]].
	^ result! !

!GLMPresentation methodsFor: 'scripting' stamp: 'tg 12/29/2009 02:16'!
noSelection
	self acceptsSelection: false! !

!GLMPresentation methodsFor: '*glamour-morphic-renderer' stamp: 'AndreiChis 12/3/2012 21:14'!
morphicAct: aBlock icon: anIcon entitled: aString 
	 
	self addAction: 
			((GLMMorphicAction new) 
				action: aBlock; 
				title: aString; 
				icon: anIcon;
				yourself)! !

!GLMPresentation methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
pane: aPane 
	 
	pane := aPane! !

!GLMPresentation methodsFor: 'accessing' stamp: 'TudorGirba 10/12/2014 10:52'!
titleActionBlock

	^ labelActionBlock! !

!GLMPresentation methodsFor: 'updating' stamp: 'TudorGirba 7/10/2011 12:49'!
registerAnnouncements
	"this method is called from the rendering code"
	self flag: 'The announcements should potentially be interested in any ports, not just in entity'.
	updateActions do: [:each | each registerInPresentation ].! !

!GLMPresentation methodsFor: 'scripting actions' stamp: 'AndreiChis 10/31/2012 09:33'!
noActions
	actions := nil.
	dynamicActionsBlock := nil.! !

!GLMPresentation methodsFor: '*glamour-morphic-renderer' stamp: 'AndreiChis 12/3/2012 21:14'!
morphicAct: aBlock on: aCharacter icon: anIcon entitled: aString 
	 
	self 
		addAction: 
			((GLMMorphicAction new) 
				action: aBlock; 
				shortcut: aCharacter; 
				icon: anIcon;
				title: aString; 
				yourself)! !

!GLMPresentation methodsFor: 'accessing ports' stamp: 'tg 12/29/2009 00:31'!
strongSelection
	^ (self pane port: #strongSelection) value! !

!GLMPresentation methodsFor: 'scripting' stamp: ' 4/5/09 22:18'!
when: aBlock 
	 
	self condition: aBlock! !

!GLMPresentation methodsFor: 'testing' stamp: 'TudorGirba 1/31/2011 02:08'!
hasActions
	^ self allActions notEmpty! !

!GLMPresentation methodsFor: 'testing' stamp: 'tg 1/13/2010 22:28'!
hasTitle
	^ title notNil! !

!GLMPresentation methodsFor: 'copying' stamp: 'TudorGirba 7/11/2011 11:18'!
copy
	"we are overriding the copy method simply to retain the tree of all prototype presentations. 
	this is useful for debugging."

	| copy |
	self flag: 'perhaps this should be replaced with smarter analysys mechanisms'.
	copy := super copy.
	copy parentPrototype: self.
	^ copy! !

!GLMPresentation methodsFor: 'scripting actions' stamp: 'tg 11/19/2010 18:27'!
dynamicActions: aBlock 
	dynamicActionsBlock := aBlock! !

!GLMPresentation methodsFor: 'scripting actions' stamp: 'tg 9/25/2010 17:54'!
act: aBlock entitled: aString categorized: anotherString
	 
	self 
		addAction: 
			((GLMGenericAction new) 
				action: aBlock; 
				title: aString; 
				category: anotherString;
				yourself)! !

!GLMPresentation methodsFor: 'testing' stamp: 'tg 9/30/2009 23:51'!
hasTitleIcon
	^ self titleIcon notNil! !

!GLMPresentation methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
useImplicitNotNil 
	 
	implicitNotNil := true! !

!GLMPresentation methodsFor: 'scripting actions' stamp: 'TudorGirba 10/13/2014 23:49'!
selectionAct: aBlock icon: anIcon on: aCharacter entitled: aString 
	 
	self 
		addSelectionAction: 
			((GLMGenericAction new) 
				action: aBlock; 
				icon: anIcon;
				shortcut: aCharacter; 
				title: aString; 
				yourself)! !

!GLMPresentation methodsFor: 'scripting' stamp: 'VeronicaUquillas 2/18/2011 15:20'!
allowAllNil
	^ self useExplicitAllNil! !

!GLMPresentation methodsFor: '*glamour-morphic-renderer' stamp: 'AndreiChis 12/3/2012 21:14'!
morphicAct: aBlock entitled: aString 
	 
	self addAction: 
			((GLMMorphicAction new) 
				action: aBlock; 
				title: aString; 
				yourself)! !

!GLMPresentation methodsFor: 'stepping' stamp: 'AndreiChis 3/16/2015 16:53'!
wantsSteps

	^ wantsSteps ifNil: [ false ]! !

!GLMPresentation methodsFor: 'enumerating' stamp: 'TudorGirba 7/9/2011 22:28'!
withAllPresentations
	| result |
	result := OrderedCollection new.
	self withAllPanesAndPresentationsDo: [:each |
		(each isKindOf: GLMPresentation) ifTrue: [ result add: each ]].
	^ result! !

!GLMPresentation methodsFor: 'updating' stamp: 'tg 5/3/2010 01:33'!
updateOn: anAnnouncement from: aBlockOrSymbol when: aConditionBlock
	updateActions add: (GLMSingleUpdateAction new
		presentation: self; 
		announcement: anAnnouncement; 
		transformation: aBlockOrSymbol;
		condition: aConditionBlock;
		yourself)! !

!GLMPresentation methodsFor: 'scripting actions' stamp: 'tg 9/25/2010 17:53'!
act: aBlock icon: anIcon entitled: aString
	self 
		addAction: 
			((GLMGenericAction new) 
				action: aBlock; 
				icon: anIcon;
				title: aString;
				yourself)! !

!GLMPresentation methodsFor: 'scripting actions' stamp: 'TudorGirba 12/16/2011 17:40'!
selectionSpawn: aBlock entitled: aString 
	 
	"These are actions that return a glamour browser to open at the end."
	self 
		addSelectionAction: 
			((GLMSpawnBrowserAction new) 
				action: aBlock; 
				title: aString; 
				yourself)! !

!GLMPresentation class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:02'!
gtExampleBasic
	<gtExample>
	^ self new! !

!GLMPresentationBoundPort commentStamp: 'TudorGirba 2/4/2011 20:27'!
This is a fancy port that enables us to access the value of a port from outside of a browser. It is bound to a presentation in the sense that it asks the presentation dynamically for the pane. In this way, when a presentation is placed (or copied) in another pane, the value will be dynamically looked up.

Instance Variables:
	presentation	<GLMPresentation>!
!GLMPresentationBoundPort methodsFor: 'comparing' stamp: ' 4/5/09 22:18'!
hash 
	 
	^self port hash! !

!GLMPresentationBoundPort methodsFor: 'accessing' stamp: 'TudorGirba 12/5/2011 14:33'!
value 
	self flag: 'checking for #entity is rather not elegant, but it is a solution to not affect the other custom ports that will probably be desired to be populated in other ways.'.
	^ self name == #entity 
		ifTrue: [ self presentation transformation glamourValue: self port value asGlamorousMultiValue ] 
		ifFalse: [ self port value ]! !

!GLMPresentationBoundPort methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
pane 
	 
	^self presentation pane! !

!GLMPresentationBoundPort methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
port 
	 
	^self pane port: self name! !

!GLMPresentationBoundPort methodsFor: 'copying' stamp: 'tg 12/30/2009 03:06'!
copyAccordingToPaneMapping: newPanesMapping inNewBrowser: anotherBrowser
	^ self copy presentation: anotherBrowser! !

!GLMPresentationBoundPort methodsFor: 'accessing' stamp: 'tg 12/17/2009 03:14'!
receive: aTransmission in: aContext
	self port receive: aTransmission in: aContext
	
! !

!GLMPresentationBoundPort methodsFor: 'accessing' stamp: 'TudorGirba 4/18/2011 19:44'!
silentValue: anObject 
	self port silentValue: anObject    ! !

!GLMPresentationBoundPort methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
presentation: aPresentation 
	 
	presentation := aPresentation! !

!GLMPresentationBoundPort methodsFor: 'accessing' stamp: 'tg 12/18/2009 23:57'!
value: anObject in: aContext
	(self validate: anObject) ifFalse: [^ self].
	self port value: anObject in: aContext! !

!GLMPresentationBoundPort methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
presentation 
	 
	^presentation! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'tg 12/31/2009 00:24'!
testExplicitNotNilMultipleValues
	| presentation | 
	presentation := GLMPresentation new. 
	presentation useExplicitNotNil.
	(presentation pane port: #entity) value: (GLMMultiValue withAll: #(nil nil)).
	self assert: presentation matches not.
	(presentation pane port: #entity) value: (GLMMultiValue withAll: #(1 nil)).
	self assert: presentation matches.
	(presentation pane port: #entity) value: (GLMMultiValue withAll: #(nil 1)).
	self assert: presentation matches.
	(presentation pane port: #entity) value: (GLMMultiValue withAll: #(1 2)).
	self assert: presentation matches.! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'lr 6/4/2010 14:03'!
testValidate
	| pane presentation | 
	pane := GLMPane named: 'test'. 
	presentation := GLMPresentation new.
	pane addPresentation: presentation.
	presentation entity: (OrderedCollection with: 1 with: 2).
	self assert: (presentation validate: 1 on: (pane port: #foo)).
	self assert: (presentation validate: 2 on: (pane port: #foo)).
	self assert: (presentation validate: 5 on: (pane port: #foo))
! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'AndreiChis 12/12/2013 15:48'!
testAllSelectionActionsWithSelection
	| listing |
	listing := GLMPresentation new.
	listing addSelectionAction: GLMAction new.
	listing addSelectionAction: GLMAction new.
	listing selection: Object new.
	listing
		dynamicActionsOnSelection: [ :p | OrderedCollection with: GLMAction new with: GLMAction new with: GLMAction new ].
	self assert: listing allSelectionActions size equals: 5! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'TudorGirba 3/15/2013 22:07'!
testUnregisterAnnouncementsWhenEntityChanges
	| announcer1 presentation |
	announcer1 := Announcer new.
	presentation := GLMPresentation new.
	presentation updateOn: GLMTestAnnouncement from: [ announcer1 ].
	presentation entity: 1.
	presentation registerAnnouncements.
	self assert: announcer1 numberOfSubscriptions equals: 1.
	presentation entity: 2.
	self assert: announcer1 numberOfSubscriptions equals: 0.
	presentation registerAnnouncements.
	self assert: announcer1 numberOfSubscriptions equals: 1.
	presentation entity: nil.
	self assert: announcer1 numberOfSubscriptions equals: 0! !

!GLMPresentationTest methodsFor: 'testing' stamp: 'DamienCassou 7/19/2011 20:38'!
expectedFailures 
	^ #(testToSendMultipleValue)! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'TudorGirba 7/29/2012 08:50'!
testWithReturnsTheOriginalPresentation
	| p result |
	p := GLMPresentation new.
	result := p with: [ :thePresentation | GLMPresentation new ].
	self assert: result == p! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'tg 5/25/2010 23:09'!
testDefaultPane
	| presentation pane |
	presentation := GLMPresentation new.
	pane := presentation pane.
	self assert: pane presentations first pane == pane.
	self assert: pane presentations pane == pane.
	self assert: pane presentations first == presentation! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'AndreiChis 6/24/2013 13:32'!
testPresentationInitializationBlock
	| pane presentation count|
	count := 0.
	pane := GLMPane named: 'test'.
	presentation := GLMPresentation new
		initialize: [ :pres |
			(pres pane port: #test)  value: count ].
	pane addPresentation: presentation.
	self assert: (pane port: #test) value = nil.
	presentation initializePresentation.
	self assert: (pane port: #test) value = 0.
	self assert: (presentation pane port: #test) value = 0.
	count := 1.
	presentation initializePresentation.
	self assert: (pane port: #test) value = 1.
	self assert: (presentation pane port: #test) value = 1.! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'TudorGirba 7/29/2012 08:50'!
testWithBlockPassesTheParentPresentation
	| p presentationInWithBlock |
	p := GLMPresentation new.
	p with: [ :thePresentation | presentationInWithBlock := thePresentation ].
	self assert: presentationInWithBlock == p! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'AndreiChis 6/24/2013 10:24'!
testEntityPortInitialization
	| pane presentation |
	pane := GLMPane named: 'test'.
	presentation := GLMPresentation new
		initialize: [ :pres |
			pres entity: 2  ].
	pane addPresentation: presentation.
	self assert: presentation entity = nil.
	presentation initializePresentation.
	self assert: (pane port: #entity) value = 2.
	self assert: presentation entity = 2.! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 16:42'!
testToSend
	| presentation |
	presentation := GLMPresentation new.
	presentation selection: #foo.
	self assert: presentation selection equals: #foo.
	presentation selection: #(#foo #bar ).
	self assert: presentation selection equals: #(#foo #bar ).
	presentation selectionTransformation: [ :first :second | (first , second) asSymbol ].
	presentation selection: (GLMMultiValue withAll: #(#foo #bar )).
	self assert: presentation selection equals: #foobar! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testTitle
	| presentation |
	presentation := GLMPresentation new.
	presentation entity: #foo.
	self assert: presentation titleValue isNil.
	presentation title: '41'.
	self assert: presentation titleValue equals: '41'.
	presentation entity: '4'.
	presentation title: [ :x | x , '2' ].
	self assert: presentation titleValue equals: '42'.
	presentation entity: (GLMMultiValue withAll: #('4' '3')).
	presentation title: [ :first :second | first , second ].
	self assert: presentation titleValue equals: '43'! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'TudorGirba 3/15/2013 22:07'!
testUnregisterAnnouncements
	| announcer presentation |
	announcer := Announcer new.
	presentation := GLMPresentation new.
	presentation updateOn: GLMTestAnnouncement from: [ announcer ].
	presentation registerAnnouncements.
	self assert: announcer numberOfSubscriptions equals: 1.
	presentation unregisterFromAllAnnouncements.
	self assert: announcer numberOfSubscriptions equals: 0! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testUpdate
	| col pane presentation |
	col := OrderedCollection with: 1 with: 2.
	pane := GLMPane named: 'test'.
	presentation := GLMListPresentation new.
	pane addPresentation: presentation.
	presentation entity: col.
	presentation shouldValidate: true.
	presentation update.
	presentation selection: 2.
	self assert: presentation selection equals: 2.
	col removeLast.
	presentation update.
	self assert: presentation selection isNil! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'ChristopheDemarey 1/26/2015 12:19'!
testSelectionAvailableWhenNoSelectionDisabled
	| presentation |
	presentation := GLMPresentation new.

	presentation selection: 1.
	self assert: presentation selection equals: 1.
	self assert: presentation rawSelection equals: 1! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'tg 11/19/2010 18:27'!
testActions
	| listing |
	listing := GLMPresentation new.
	listing actions isEmpty.
	listing addAction: GLMAction new.
	listing actions size = 1.! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testToSendAs
	| presentation |
	presentation := GLMPresentation new.
	presentation selection: #foo.
	self assert: presentation selection equals: #foo.
	self assert: (presentation pane port: #newport) value equals: nil.
	presentation send: [ :num | num + 1 ] as: #newport.
	presentation selection: 1.
	self assert: (presentation pane port: #newport) value equals: 2.
	self assert: presentation selection equals: 1! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'tg 8/22/2010 15:46'!
testEquality
	| presentation |
	presentation := GLMPresentation new.
	self assert: (presentation = presentation copy) not! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'tg 1/13/2010 22:28'!
testHasTitle
	| presentation |
	presentation := GLMPresentation new.
	self assert: presentation hasTitle not.
	presentation title: 'something'.
	self assert: presentation hasTitle! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:16'!
testCopyTheTransformation
	| presentation newPresentation transformation |
	presentation := GLMPresentation new.
	presentation selectionTransformation: [:each | each + 1].
	newPresentation := presentation copy.
	self assert: (presentation selectionTransformation value: 1) equals: 2.
	self assert: (newPresentation selectionTransformation value: 1) equals: 2.! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testAllActions
	| listing |
	listing := GLMPresentation new.
	self assert: listing hasActions not.
	listing addAction: GLMAction new.
	listing addAction: GLMAction new.
	listing dynamicActions: [ :p | OrderedCollection with: GLMAction new with: GLMAction new with: GLMAction new ].
	self assert: listing allActions size equals: 5.
	self assert: listing hasActions! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'TudorGirba 3/15/2013 22:07'!
testUpdateOnPortsUpdate
	| col pane presentation announcer |
	col := OrderedCollection with: 1 with: 2.
	pane := GLMPane named: 'test'.
	presentation := GLMListPresentation new.
	announcer := Announcer new.
	pane addPresentation: presentation.
	presentation updateOn: GLMTestAnnouncement from: [ announcer ].
	presentation entity: col.
	presentation shouldValidate: true.
	presentation registerAnnouncements.
	presentation selection: 2.
	self assert: presentation selection equals: 2.
	col removeLast.
	announcer announce: GLMTestAnnouncement.
	self assert: presentation selection isNil! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'TudorGirba 9/5/2011 19:11'!
testWith
	| p presentationInWithBlock |
	p := GLMPresentation new.
	p with: [ :thePresentation | presentationInWithBlock := thePresentation ].
	self assert: presentationInWithBlock == p! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testMatching
	| presentation |
	presentation := GLMPresentation new.
	self assert: presentation usesImplicitNotNil.
	(presentation pane port: #entity) value: (GLMMultiValue withAll: #(nil 1)).
	self assert: presentation matches not.
	(presentation pane port: #entity) value: 1.
	self assert: presentation matches.
	presentation useExplicitNotNil.
	self assert: presentation usesImplicitNotNil not.
	(presentation pane port: #entity) value: (GLMMultiValue withAll: #(nil 1)).
	self assert: presentation matches.
	(presentation pane port: #entity) value: 1.
	self assert: presentation matches.
	presentation condition: [ :x | x > 1 ].
	presentation useImplicitNotNil.
	self assert: presentation usesImplicitNotNil.
	(presentation pane port: #entity) value: nil.
	self assert: presentation matches not.
	(presentation pane port: #entity) value: 1.
	self assert: presentation matches not.
	(presentation pane port: #entity) value: 2.
	self assert: presentation matches.
	presentation useExplicitNotNil.
	(presentation pane port: #entity) value: 1.
	self assert: presentation matches not.
	(presentation pane port: #entity) value: 2.
	self assert: presentation matches.
	self assert: presentation usesImplicitNotNil not.
	[ 
	(presentation pane port: #entity) value: (GLMMultiValue withAll: #(nil 1)).
	presentation matches.
	self signalFailure: 'Should have raised error' ]
		on: MessageNotUnderstood
		do: [ :err | 
			self assert: err message selector equals: #>.
			self assert: err message arguments equals: (Array with: 1) ]! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testCopyRootPrototype
	| presentation newPresentation yetAnotherPresentation |
	presentation := GLMPresentation new.
	newPresentation := presentation copy.
	self assert: newPresentation rootPrototype equals: presentation.
	self assert: newPresentation parentPrototype equals: presentation.
	yetAnotherPresentation := newPresentation copy.
	self assert: yetAnotherPresentation rootPrototype equals: presentation.
	self assert: yetAnotherPresentation parentPrototype equals: newPresentation! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'AndreiChis 6/24/2013 13:32'!
testPresentationInitializationBlockIsCalled
	| pane presentation count |
	count := 0.
	pane := GLMPane named: 'test'.
	presentation := GLMPresentation new
		initialize: [ :pres |
			count := count + 1 ].
	pane addPresentation: presentation.
	self assert: count = 0.
	presentation initializePresentation.
	self assert: count = 1.
	presentation initializePresentation.
	self assert: count = 2.
! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'tg 12/16/2009 17:49'!
testImplicitNotNilMultipleValues
	| presentation | 
	presentation := GLMPresentation new. 
	presentation useImplicitNotNil.
	(presentation pane port: #entity) value: (GLMMultiValue withAll: #(nil nil)).
	self assert: presentation matches not.
	(presentation pane port: #entity) value: (GLMMultiValue withAll: #(1 nil)).
	self assert: presentation matches not.
	(presentation pane port: #entity) value: (GLMMultiValue withAll: #(nil 1)).
	self assert: presentation matches not.
	(presentation pane port: #entity) value: (GLMMultiValue withAll: #(1 2)).
	self assert: presentation matches.! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'tg 1/5/2010 21:08'!
testSetup
	| presentation |
	presentation := GLMPresentation new. 
	self assert: presentation pane notNil. 
	self assert: (presentation pane presentations includes: presentation)! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testAnnouncement
	| pane presentation announcement |
	pane := GLMPane named: 'test'.
	presentation := GLMPresentation new.
	pane addPresentation: presentation.
	announcement := nil.
	presentation when: GLMContextChanged do: [ :ann | announcement := ann ].
	(pane port: #entity) value: 42.
	self assert: announcement notNil.
	self assert: announcement property equals: #entity.
	self assert: announcement value equals: 42! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'TudorGirba 10/17/2014 15:12'!
testOnChangeOfPortAct
	| pane presentation timesTriggered |
	pane := GLMPane named: 'test'.
	presentation := GLMPresentation new.
	pane addPresentation: presentation.
	timesTriggered := 0.
	presentation 
		onChangeOfPort: #test 
		act: [ timesTriggered := timesTriggered + 1 ].
	(pane port: #test) value: 42.	
	self assert: timesTriggered equals: 1! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testCopyAnnouncementsDoNotRaise
	| presentation newPresentation |
	presentation := GLMPresentation new.
	presentation when: GLMContextChanged do: [ :ann | self fail ].
	self assert: presentation numberOfSubscriptions equals: 1.
	newPresentation := presentation copy.
	newPresentation announce: GLMContextChanged.
	self assert: newPresentation numberOfSubscriptions equals: 0! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:03'!
testSelectionActions
	| listing |
	listing := GLMPresentation new.
	listing selectionActions isEmpty.
	listing addSelectionAction: GLMAction new.
	self assert: listing selectionActions size equals: 1.! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 16:42'!
testToSendMultipleValue
	| presentation |
	presentation := GLMPresentation new.
	presentation selection: (GLMMultiValue withAll: #(#foo #bar )).
	self assert: presentation selection equals: #foo.
	presentation selectionTransformation: [ :first :second | (first , second) asSymbol ].! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testContext
	| pane presentation |
	pane := GLMPane named: 'test'.
	presentation := GLMPresentation new.
	pane addPresentation: presentation.
	presentation selection: 42.
	self assert: (pane port: #selection) value equals: 42.
	(pane port: #entity) value: 'foo'.
	self assert: presentation entity equals: 'foo'! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'TudorGirba 7/11/2011 11:10'!
testCopyNotTheSameRegistry

	| presentation newPresentation |
	presentation := GLMPresentation new.
	newPresentation := presentation copy.
	self assert: presentation glmSubscriptions ~~ newPresentation glmSubscriptions! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'TudorGirba 3/15/2013 22:07'!
testUpdateOnTriggered
	| pane presentation announcer timesTriggered |
	pane := GLMPane named: 'test'.
	presentation := GLMPresentation new.
	announcer := Announcer new.
	pane addPresentation: presentation.
	timesTriggered := 0.
	presentation when: GLMPresentationUpdated do: [ :announcement | timesTriggered := timesTriggered + 1 ].
	presentation updateOn: GLMTestAnnouncement from: #yourself.
	presentation entity: announcer.
	presentation registerAnnouncements.
	announcer announce: GLMTestAnnouncement.
	self assert: timesTriggered equals: 1! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'TudorGirba 3/15/2013 22:07'!
testUpdateOnFromAllPortsUpdate
	| pane presentation announcers col updated |
	col := (1 to: 4) asOrderedCollection. 
	pane := GLMPane named: 'test'. 
	presentation := GLMListPresentation new.
	announcers := col collect: [:each | Announcer new].
	pane addPresentation: presentation.
	presentation updateOn: GLMTestAnnouncement fromAll: [ announcers ].
	presentation when: GLMPresentationUpdated do: [:a | updated := true ].
	presentation entity: col.
	presentation shouldValidate: true.
	presentation registerAnnouncements.

	updated := false.
	announcers last announce: GLMTestAnnouncement.
	self assert: updated.
	updated := false.
	announcers last announce: GLMTestAnnouncement.
	self assert: updated.
! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'TudorGirba 3/15/2013 22:07'!
testUpdateConditionallyTriggered
	| pane presentation announcer timesTriggered |
	pane := GLMPane named: 'test'.
	(pane port: #entity) value: 40.
	presentation := GLMPresentation new.
	announcer := Announcer new.
	pane addPresentation: presentation.
	timesTriggered := 0.
	presentation when: GLMPresentationUpdated do: [ :announcement | timesTriggered := timesTriggered + 1 ].
	presentation updateOn: GLMTestAnnouncement from: [ :x | announcer ] when: [ :ann :entity | ann parameter + entity = 42 ].
	presentation registerAnnouncements.
	announcer announce: (GLMTestAnnouncement new parameter: 0).
	self assert: timesTriggered equals: 0.
	announcer announce: (GLMTestAnnouncement new parameter: 2).
	self assert: timesTriggered equals: 1! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'tg 1/13/2010 22:30'!
testHasTitleIcon
	| presentation |
	presentation := GLMPresentation new.
	self assert: presentation hasTitleIcon not.
	presentation titleIcon: 'something'.
	self assert: presentation hasTitleIcon! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'TudorGirba 9/24/2012 08:12'!
testToRawSelection
	| presentation |
	presentation := GLMPresentation new.

	presentation selection: 1.
	self assert: presentation selection equals: 1.
	self assert: presentation rawSelection equals: 1.
	
	presentation selectionTransformation: [ :num  | num + 1].
	presentation selection: 1.
	self assert: presentation selection equals: 2.
	self assert: presentation rawSelection equals: 1.! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testDisplay
	| presentation |
	presentation := GLMPresentation new.
	presentation entity: #foo.
	self assert: presentation displayValue equals: #foo.
	presentation entity: #(#foo #bar).
	self assert: presentation displayValue equals: #(#foo #bar).
	presentation entity: (GLMMultiValue withAll: #(#foo #bar)).
	self assert: presentation displayValue equals: #foo.
	presentation transformation: [ :first :second | (first , second) asSymbol ].
	self assert: presentation displayValue equals: #foobar! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'ChristopheDemarey 1/26/2015 12:18'!
testRawSelectionAvailableWhenNoSelectionActive
"testSelectionNotAvailableWhenNoSelectionActive
testSelectionAvailableWhenNoSelectionDisabled"
	| presentation |
	presentation := GLMPresentation new.
	presentation acceptsSelection: false.

	presentation selection: 1.
	self assert: presentation selection equals: nil.
	self assert: presentation rawSelection equals: 1! !

!GLMPresentationTest methodsFor: 'tests' stamp: 'AndreiChis 12/12/2013 15:48'!
testAllSelectionActionsWithNoSelection
	| listing |
	listing := GLMPresentation new.
	listing addSelectionAction: GLMAction new.
	listing addSelectionAction: GLMAction new.
	listing
		dynamicActionsOnSelection: [ :p | OrderedCollection with: GLMAction new with: GLMAction new with: GLMAction new ].
	self assert: listing allSelectionActions size equals: 2! !

!GLMPresentationToolbarUpdated commentStamp: 'AndreiChis 10/5/2014 18:58'!
A GLMPresentationToolbarUpdated is announced by the presentation when it's toolbar actions ned to be updated. By toolbar actions we refer to those actions that apply on the entire presentations and not those that apply on the selection (which are usually displayed in a context menu).

Only the part of the morph that displays the actions is updated. !
!GLMPresentationToolbarUpdated methodsFor: 'accessing' stamp: 'AndreiChis 10/5/2014 17:06'!
presentation
	^ presentation! !

!GLMPresentationToolbarUpdated methodsFor: 'accessing' stamp: 'AndreiChis 10/5/2014 17:06'!
presentation: anObject
	presentation := anObject! !

!GLMPresentationUpdated commentStamp: 'tg 2/20/2010 14:54'!
A GLMPresentationUpdated is announced by the presentation when an update is wanted.!
!GLMPresentationUpdated methodsFor: 'accessing' stamp: 'tg 8/24/2010 21:40'!
presentation
	^ presentation! !

!GLMPresentationUpdated methodsFor: 'accessing' stamp: 'tg 8/24/2010 21:40'!
presentation: anObject
	presentation := anObject! !

!GLMPresentationsChanged commentStamp: 'tg 2/20/2010 14:57'!
A GLMPresentationsChanged is announced by the pane when the set of presentations changes.!
!GLMPresentationsChanged methodsFor: 'accessing-convenience' stamp: ' 4/5/09 22:18'!
presentations 
	"The presentationt that are currently present on the pane." 
	 
	^self pane presentations! !

!GLMPresentationsChanged methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
pane: aPane 
	"The pane on which the presentations changed." 
	 
	pane := aPane! !

!GLMPresentationsChanged methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
oldPresentations: aCollection 
	"The presentations that were present on the pane before the change." 
	 
	oldPresentations := aCollection! !

!GLMPresentationsChanged methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
pane 
	"The pane on which the presentations changed." 
	 
	^pane! !

!GLMPresentationsChanged methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
oldPresentations 
	"The presentations that were present on the pane before the change." 
	 
	^oldPresentations! !

!GLMPresentationsChanged methodsFor: 'printing' stamp: 'tg 1/11/2010 08:48'!
printOn: aStream
	super printOn: aStream.
	aStream nextPutAll: ' (pane = ', self pane printString , ')'! !

!GLMPrintPopper commentStamp: 'AndreiChis 10/1/2014 13:24'!
I am a popper that displays a notification message: I can display a given object or evaluate the selection of the attached text editor. 

I also offer a button for inspecting the object that is displayed.

GLMPrintPopper simpleObjectPopper
	
GLMPrintPopper selectionEvaluationPopper!
!GLMPrintPopper methodsFor: 'initialization' stamp: 'AndreiChis 9/30/2014 16:58'!
initializeInspectButton

	inspectButton := MultistateButtonMorph new
		extent: GLMUIThemeExtraIcons glamorousInspect extent;
		activeEnabledOverUpFillStyle: (ImageFillStyle form: GLMUIThemeExtraIcons glamorousInspect);
		setBalloonText: 'Inspect' translated.
	self
		addMorph: inspectButton
		fullFrame: (LayoutFrame fractions: (1 @ 0 corner: 1 @ 0) offsets: (inspectButton width  @ 0 corner: 0 @ (2*inspectButton width) ))! !

!GLMPrintPopper methodsFor: 'initialization' stamp: 'AndreiChis 9/30/2014 16:55'!
initializeTextMorph
	textMorph := RubScrolledTextMorph new.
	textMorph
		beReadOnly;
		beWrapped;
		color: BalloonMorph balloonColor.
	self
		vResizing: #spaceFill;
		hResizing: #spaceFill;
		addMorph: textMorph fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 1) offsets: (0 @ 0 corner: 0 @ 0))! !

!GLMPrintPopper methodsFor: 'initialization' stamp: 'TudorGirba 8/1/2014 22:47'!
initialize
	super initialize.
	self initializeInspectButton.
	self initializeTextMorph! !

!GLMPrintPopper methodsFor: 'public' stamp: 'AndreiChis 4/1/2015 12:52'!
openFromRubric: aMorph withResult: anObject
	| string |
	string := anObject printString.
	self withString: string from: aMorph.
	self width: self width + inspectButton width.
	textMorph
		on: $i command
		do: [ anObject inspect ].
	textMorph
		on: Character cr asKeyCombination
		do: [ 
			self delete.
			aMorph textArea removeHighlightSegment.
			aMorph editor atEndOfLineInsertAndSelect: string asComment.
			aMorph takeKeyboardFocus ].
	inspectButton addUpAction: [ anObject inspect ].
	self openInWorld! !

!GLMPrintPopper methodsFor: 'public' stamp: 'AndreiChis 10/1/2014 11:30'!
evaluateAndOpenFromRubric: aMorph

	self 
		openFromRubric: aMorph
		withResult: aMorph textArea editor evaluateSelection! !

!GLMPrintPopper class methodsFor: 'examples' stamp: 'AndreiChis 10/1/2014 13:25'!
selectionEvaluationPopper
	"
	self selectionEvaluationPopper
	"
	GLMPrintPopper new 
		evaluateAndOpenFromRubric: (RubScrolledTextMorph new 
			beForSmalltalkCode;
			updateTextWith: '1+2+4';
			setSelection: (1to:6))! !

!GLMPrintPopper class methodsFor: 'examples' stamp: 'AndreiChis 10/1/2014 13:25'!
simpleObjectPopper
	"
	self simpleObjectPopper
	"

	GLMPrintPopper new 
		openFromRubric: RubScrolledTextMorph new 
		withResult: 'notification goes here'.! !

!GLMPrintSelection commentStamp: 'AndreiChis 10/1/2014 13:40'!
I am event indicating to the renderer to execute and print the currently selected text.!
!GLMProfileSelection commentStamp: 'AndreiChis 5/6/2014 17:55'!
I am event indicating to the renderer to profile the currently selected text.!
!GLMRenderer commentStamp: 'tg 9/20/2009 12:43'!
A GLMRenderer is the abstract class for the renderer hierarchy. This should be subclassed for each rendering platform (e.g. Morphic)!
!GLMRenderer methodsFor: 'rendering' stamp: ' 4/5/09 22:18'!
renderPane: aPane 
	 
	^nil! !

!GLMRenderer methodsFor: 'rendering' stamp: 'tg 5/24/2009 19:30'!
renderPresentation: aPresentation 

	^ nil! !

!GLMRenderer methodsFor: 'rendering' stamp: ' 4/5/09 22:18'!
render: aRenderable 
	 
	^aRenderable renderGlamorouslyOn: self! !

!GLMRenderer methodsFor: 'rendering' stamp: ' 4/5/09 22:18'!
doOpen: aUI 
	 
	^self subclassResponsibility! !

!GLMRenderer methodsFor: 'rendering' stamp: ' 4/5/09 22:18'!
open: aRenderable 
	 
	^self doOpen: (self render: aRenderable)! !

!GLMReplacePresentationsStrategy commentStamp: 'tg 2/20/2010 14:52'!
This strategy replaces the presentations from the pane of the destination port.!
!GLMReplacePresentationsStrategy methodsFor: 'transmitting' stamp: 'tg 4/11/2010 23:36'!
transmitIn: aContext
	"it is important for the destination to be set after the presentation, 
	because when the presentation is a browser, we might forward the entity internally"
	self transmission destination hasPane ifTrue: [
		self transmission destination pane notingPresentationChangeDo: [
			self transmission destination pane clearIn: aContext.
			self transmission destination pane presentations: self presentations copy ]].
! !

!GLMRigidStrategy methodsFor: '*glamour-morphic-renderer' stamp: 'cyrilledelaunay 5/20/2011 11:28'!
initializeSecondColumn: aPanelMorph
	
	aPanelMorph 
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap.! !

!GLMRigidStrategy methodsFor: '*glamour-morphic-renderer' stamp: 'cyrilledelaunay 5/20/2011 11:13'!
initializePane: aMorphPane
	
	aMorphPane
		hResizing: #rigid;
		vResizing: #rigid.! !

!GLMRigidStrategy methodsFor: '*glamour-morphic-renderer' stamp: 'cyrilledelaunay 5/20/2011 11:28'!
initializeContainer: aPanelMorph
	
	aPanelMorph 
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap.! !

!GLMRigidStrategy methodsFor: '*glamour-morphic-renderer' stamp: 'cyrilledelaunay 5/20/2011 11:28'!
initializeFirstColumn: aPanelMorph
	
	aPanelMorph 
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap.! !

!GLMRubEditingAreaBrick commentStamp: 'AliakseiSyrel 3/23/2015 01:00'!
A GLMRubEditingAreaBrick is basic text editor brick used for multi line input fields. 

vShrinkWrap - height fits text size + vertical paddings
hShrinkWrap - doesn't make any sense.
vSpaceFill - fills parent vertically. Actual text editor height = parent height - vertical paddings
hSpaceFill - doesn't really makes sense, since text area still shrinks to fit text!
!GLMRubEditingAreaBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 3/19/2015 16:16'!
initialize
	super initialize.
	
	self
		hSpaceFill;
		vShrinkWrap! !

!GLMRubEditingAreaBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 3/20/2015 23:10'!
withoutBackground

	self rubric color: Color transparent! !

!GLMRubEditingAreaBrick methodsFor: 'rubric-brick-creation' stamp: 'AliakseiSyrel 2/12/2015 11:31'!
newRubricMorph

	^ RubEditingArea new beWrapped! !

!GLMRubEditingAreaBrick class methodsFor: 'examples-open' stamp: 'StefanReichhart 4/9/2015 12:49'!
exampleFillOpen

	self gtExampleFill openCenteredInBrickWindow! !

!GLMRubEditingAreaBrick class methodsFor: 'examples-open' stamp: 'StefanReichhart 4/9/2015 12:49'!
exampleScrollPaneOpen
	
	self gtExampleScrollPane openInBrickWindowLabeled: 'Rubric in ScrollPane'! !

!GLMRubEditingAreaBrick class methodsFor: 'examples-open' stamp: 'StefanReichhart 4/9/2015 12:49'!
exampleBandOpen

	self gtExampleBand openInBrickWindow! !

!GLMRubEditingAreaBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:21'!
gtExampleBand
	<gtExample: 'Two rubric text areas in band'>
	
	^ GLMBandBrick new
		padding: #(20 20);
		hSpaceFill;
		vShrinkWrap;
		color: Color veryVeryLightGray;
		addAllBricks: { self gtExampleBasic. self gtExampleBasic };
		yourself! !

!GLMRubEditingAreaBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:21'!
gtExample
	<gtExample: 'Basic Rubric Editing Area'>
	^ self gtExampleBasic
		updateTextWith: 'Hello world!!';
		yourself! !

!GLMRubEditingAreaBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:21'!
gtExampleBasic
	<gtExample: 'Basic Rubric Editing Area with padding and border'>
	^ self new
		padding: 20;
		borderWidth: 20;
		margin: 5;
		borderColor: Color veryLightGray! !

!GLMRubEditingAreaBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:21'!
gtExampleScrollPane
	<gtExample: 'Multiple rubric text areas in scroll pane'>
	
	^ GLMScrollPaneBrick new
		hSpaceFill;
		vSpaceFill;
		color: Color veryVeryLightGray;
		layoutMorphs: true;
		addAllBricks: ((1 to: 20) collect: [ :i | self gtExampleBasic ]);
		yourself! !

!GLMRubEditingAreaBrick class methodsFor: 'examples-open' stamp: 'StefanReichhart 4/9/2015 12:49'!
exampleOpen

	self gtExample openCenteredInBrickWindow! !

!GLMRubEditingAreaBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:21'!
gtExampleFill
	<gtExample: 'Basic Rubric Editing Area that fills parent'>
	^ self gtExampleBasic
		vSpaceFill;
		updateTextWith: 'Hello world!!';
		yourself! !

!GLMRubScrolledTextBrick commentStamp: 'AliakseiSyrel 1/30/2015 11:35'!
A GLMRubScrolledTextBrick is a wrapper for rubric scrolled text morph, to allow simple integration of rubric text field in brick

Instance Variables
	rubricMorph:		<Object>

rubricMorph
	- xxxxx
!
!GLMRubScrolledTextBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 3/20/2015 23:09'!
withoutBackground

	self rubric color: Color transparent.
	self rubric textArea color: Color transparent! !

!GLMRubScrolledTextBrick methodsFor: 'brick-properties-events' stamp: 'AliakseiSyrel 1/30/2015 12:12'!
onThemerChanged

	self updateStyle! !

!GLMRubScrolledTextBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 3/17/2015 23:02'!
rubricTextFontSize: aFloat

	self setProperty: #brickRubricTextFontSize toValue: aFloat.
	self updateStyle! !

!GLMRubScrolledTextBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/30/2015 11:55'!
rubricBackgroundColor

	^ self valueOfProperty: #brickRubricBackgroundColor ifAbsent: [ self themer rubricBackgroundColor ]! !

!GLMRubScrolledTextBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/30/2015 11:57'!
rubricBorderColor: aColor

	self setProperty: #brickRubricBorderColor toValue: aColor.
	self updateStyle! !

!GLMRubScrolledTextBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 3/20/2015 22:45'!
withoutMargins

	self margins: (0@0 corner: 0@0)! !

!GLMRubScrolledTextBrick methodsFor: 'rubric-accessing' stamp: 'AliakseiSyrel 1/30/2015 11:38'!
rubric: aMorph

	self morph ifNotNil: [ self removeMorph: self morph ].
	self on: aMorph! !

!GLMRubScrolledTextBrick methodsFor: 'reflective operations' stamp: 'AliakseiSyrel 1/30/2015 11:42'!
doesNotUnderstand: aMessage
	^ self rubric
		perform: aMessage selector 
		withArguments: aMessage arguments! !

!GLMRubScrolledTextBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 3/22/2015 13:18'!
initialize
	super initialize.
	
	self rubric: self newRubricMorph.
	self withoutBackground.
	self
		hSpaceFill;
		vSpaceFill! !

!GLMRubScrolledTextBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/30/2015 11:55'!
rubricBorderColor

	^ self valueOfProperty: #brickRubricBorderColor ifAbsent: [ self themer rubricBorderColor ]! !

!GLMRubScrolledTextBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 3/17/2015 23:10'!
rubricTextFamilyName

	^ self valueOfProperty: #brickRubricTextFamilyName ifAbsent: [ self themer rubricTextFamilyName ]! !

!GLMRubScrolledTextBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/30/2015 11:56'!
rubricBorderWidth

	^ self valueOfProperty: #brickRubricBorderWidth ifAbsent: [ self themer rubricBorderWidth ]! !

!GLMRubScrolledTextBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 3/20/2015 22:45'!
withoutBorder

	self rubricBorderWidth: 0.
	self rubricBorderColor: Color transparent.! !

!GLMRubScrolledTextBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 3/26/2015 16:38'!
rubricCursorColor

	^ self valueOfProperty: #brickRubricCursorColor ifAbsent: [ self themer rubricCursorColor ]! !

!GLMRubScrolledTextBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/30/2015 11:57'!
rubricBorderWidth: aColor

	self setProperty: #brickRubricBorderWidth toValue: aColor.
	self updateStyle! !

!GLMRubScrolledTextBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 3/20/2015 23:14'!
beTransparent

	self rubricBackgroundColor: Color transparent! !

!GLMRubScrolledTextBrick methodsFor: 'brick-properties' stamp: 'JurajKubelka 2/28/2015 19:34'!
rubricTextColor

	^ self valueOfProperty: #brickRubricTextColor ifAbsent: [ self themer rubricTextColor ]! !

!GLMRubScrolledTextBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 2/26/2015 22:42'!
text: aText

	self rubric updateTextWith: aText! !

!GLMRubScrolledTextBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 3/17/2015 23:02'!
rubricTextFontSize

	^ self valueOfProperty: #brickRubricTextFontSize ifAbsent: [ self themer rubricTextFontSize ]! !

!GLMRubScrolledTextBrick methodsFor: 'rubric-brick-creation' stamp: 'AliakseiSyrel 1/30/2015 11:29'!
newRubricMorph

	^ RubScrolledTextMorph new! !

!GLMRubScrolledTextBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 3/17/2015 23:10'!
rubricTextFamilyName: aString

	self setProperty: #brickRubricTextFamilyName toValue: aString.
	self updateStyle! !

!GLMRubScrolledTextBrick methodsFor: 'rubric-updating' stamp: 'AliakseiSyrel 3/26/2015 16:40'!
updateStyle

	self color: self rubricBackgroundColor.
	self rubric borderColor: self rubricBorderColor.
	self rubric borderWidth: self rubricBorderWidth.
	self rubric textColor: self rubricTextColor.
	self rubric font: (LogicalFont familyName: self rubricTextFamilyName pointSize: self rubricTextFontSize).
	self rubric cursor visibleCursorColor: self rubricCursorColor! !

!GLMRubScrolledTextBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/30/2015 11:57'!
rubricBackgroundColor: aColor

	self setProperty: #brickRubricBackgroundColor toValue: aColor.
	self updateStyle! !

!GLMRubScrolledTextBrick methodsFor: 'rubric-accessing' stamp: 'AliakseiSyrel 1/30/2015 11:38'!
rubric

	^ self morph! !

!GLMRubScrolledTextBrick methodsFor: 'brick-properties' stamp: 'JurajKubelka 2/28/2015 19:34'!
rubricTextColor: aColor

	self setProperty: #brickRubricTextColor toValue: aColor.
	self updateStyle! !

!GLMRubScrolledTextBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 3/26/2015 16:19'!
rubricCursorColor: aColor

	self setProperty: #brickRubricCursorColor toValue: aColor.
	self updateStyle! !

!GLMRubScrolledTextBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:22'!
gtExampleBand
	<gtExample: 'Two rubric text areas in band'>
	
	^ GLMBandBrick new
		padding: #(20 20);
		hSpaceFill;
		color: Color veryVeryLightGray;
		addAllBricks: { self new vShrinkWrap. self new vShrinkWrap};
		yourself! !

!GLMRubScrolledTextBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:22'!
gtExample
	<gtExample: 'Two rubric text areas filling half of size'>
	
	^ GLMBrick new
		useVerticalLinearLayout;
		padding: #(20 20);
		hSpaceFill;
		vSpaceFill;
		color: Color veryVeryLightGray;
		addAllBricks: { self new vSpaceFill: 50. self new vSpaceFill: 50 };
		yourself! !

!GLMRubScrolledTextBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:50'!
exampleOpen

	self gtExample openInBrickWindow! !

!GLMRubScrolledTextBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:50'!
exampleBandOpen

	self gtExampleBand openInBrickWindow! !

!GLMRubTextAreaBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/26/2015 23:44'!
initialize
	super initialize.
	
	self rubricBackgroundColor: Color transparent! !

!GLMRubTextAreaBrick methodsFor: 'rubric-brick-creation' stamp: 'AliakseiSyrel 2/26/2015 23:44'!
newRubricMorph

	^ super newRubricMorph
		beReadOnly;
		withoutAnyDecorator! !

!GLMRubTextFieldBrick commentStamp: 'AliakseiSyrel 3/22/2015 17:52'!
A GLMRubTextFieldBrick is basic text editor brick used for single line input fields. Supports variety of layout properties: 

vShrinkWrap - height fits text size + vertical paddings
hShrinkWrap - width fits text size + horizontal paddings
vSpaceFill - fills parent vertically. Actual text editor height = parent height - vertical paddings
hSpaceFill - fills parent hprozontally. Actual text editor width = parent width - horizontal paddings
beCentered - actuall text editor field will be centered vertically

Instance Variables
	isCentered:		<Boolean>

isCentered
	- true if actual text editor field should be centered vertically,
	   false otherwise
!
!GLMRubTextFieldBrick methodsFor: 'brick-geometry' stamp: 'AliakseiSyrel 3/20/2015 22:31'!
shrinkingWidth

	self rubric width: self rubric textArea width.
	self onLayouted.
	^ self rubric textArea width! !

!GLMRubTextFieldBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 3/23/2015 00:50'!
initialize
	super initialize.
	
	self
		vShrinkWrap;
		hShrinkWrap! !

!GLMRubTextFieldBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 3/22/2015 17:58'!
vSpaceFill: anInteger
	super vSpaceFill: anInteger.
	
	self isCentered ifTrue: [ self beCentered ]! !

!GLMRubTextFieldBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 3/22/2015 17:41'!
beCentered

	isCentered := true.
	self isVFilling
		ifTrue: [ self rubric forceHeight: [ self height - self vPadding ] ].! !

!GLMRubTextFieldBrick methodsFor: 'rubric-brick-creation' stamp: 'AliakseiSyrel 3/20/2015 12:46'!
newRubricMorph

	^ GLMRubTextFieldMorph new! !

!GLMRubTextFieldBrick methodsFor: 'rubric-testing' stamp: 'AliakseiSyrel 3/22/2015 16:38'!
isCentered

	^ isCentered ifNil: [ isCentered := false ]! !

!GLMRubTextFieldBrick class methodsFor: 'examples-open' stamp: 'StefanReichhart 4/9/2015 12:50'!
exampleHSpaceFillOpen

	self gtExampleHSpaceFill openCenteredInBrickWindow! !

!GLMRubTextFieldBrick class methodsFor: 'examples-open' stamp: 'StefanReichhart 4/9/2015 12:50'!
exampleVSpaceFillOpen

	self gtExampleVSpaceFill openCenteredInBrickWindow! !

!GLMRubTextFieldBrick class methodsFor: 'examples-open' stamp: 'StefanReichhart 4/9/2015 12:50'!
exampleFullSpaceFillCenteredOpen

	self gtExampleFullSpaceFillCentered openCenteredInBrickWindow! !

!GLMRubTextFieldBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:11'!
gtExampleFullSpaceFillCentered
	<gtExample: 'Rubric centered text field that fills parent'>
	^ self gtExampleWithBorder
			hSpaceFill;
			vSpaceFill;
			beCentered;
			setTextWith: 'Hello world!!';
			yourself! !

!GLMRubTextFieldBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:11'!
gtExampleHSpaceFill
	<gtExample: 'Rubric text field that shrinks to fit height of the text and fills parent width'>
	
	^ self gtExampleWithBorder
			hSpaceFill;
			setTextWith: 'Hello world!!';
			yourself! !

!GLMRubTextFieldBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:11'!
gtExample
	<gtExample: 'Rubric text field that shrinks to fit height and width of the text'>
	
	^ self gtExampleWithBorder
			setTextWith: 'Hello world!!';
			yourself! !

!GLMRubTextFieldBrick class methodsFor: 'examples-open' stamp: 'StefanReichhart 4/9/2015 12:50'!
exampleOpen

	self gtExample openCenteredInBrickWindow! !

!GLMRubTextFieldBrick class methodsFor: 'examples-open' stamp: 'StefanReichhart 4/9/2015 12:50'!
exampleVSpaceFillCenteredOpen

	self gtExampleVSpaceFillCentered openCenteredInBrickWindow! !

!GLMRubTextFieldBrick class methodsFor: 'examples-open' stamp: 'StefanReichhart 4/9/2015 12:50'!
exampleFullSpaceFillOpen

	self gtExampleFullSpaceFill openCenteredInBrickWindow! !

!GLMRubTextFieldBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:11'!
gtExampleVSpaceFill
	<gtExample: 'Rubric text field that shrinks to fit width of the text and fills parent height'>
	
	^ self gtExampleWithBorder
			vSpaceFill;
			setTextWith: 'Hello world!!';
			yourself! !

!GLMRubTextFieldBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:11'!
gtExampleVSpaceFillCentered
	<gtExample: 'Rubric centered text field that shrinks to fit width of the text and fills parent height'>
	
	^ self gtExampleWithBorder
			vSpaceFill;
			beCentered;
			setTextWith: 'Hello world!!';
			yourself! !

!GLMRubTextFieldBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:11'!
gtExampleFullSpaceFill
	<gtExample: 'Rubric centered text field that fills parent'>
	
	^ self gtExampleWithBorder
			hSpaceFill;
			vSpaceFill;
			setTextWith: 'Hello world!!';
			yourself! !

!GLMRubTextFieldBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:11'!
gtExampleWithBorder
	<gtExample: 'Rubric field with support of border'>
	
	^ self new
			padding: 20;
			borderWidth: 20;
			borderColor: Color lightGray! !

!GLMRubTextFieldMorph commentStamp: 'AliakseiSyrel 3/21/2015 18:59'!
A GLMRubTextFieldMorph is xxxxxxxxx.

Instance Variables
	customHeight:		<Object>

customHeight
	- xxxxx

Raw functions to center textarea:

	"for 16: 20,29 - 4"
	"newTop := ((self height - self textArea height) / 2.0).
	newTop := newTop truncated abs."
	
	"for 15: 20,28 - 3"
	"newTop := ((self height - self textArea height) / 2.0) + 1.
	newTop := newTop truncated abs."
	
	"for 14: 20,26 - 2"
	"newTop := ((self height - self textArea height) / 2.0) + 1.
	newTop := newTop truncated abs."
	
	"for 13: 20,24 - 1"
	"newTop := ((self height - self textArea height) / 2.0) + 1.
	newTop := newTop truncated abs."
	
	"for 12: 20,23 - 1"
	"newTop := ((self height - self textArea height) / 2.0).
	newTop := newTop truncated abs."
	
	"for 11:  20,21 - 0"
	"newTop := ((self height - self textArea height) / 2.0).
	newTop := newTop truncated abs."
	
	"for 10:  20,19 - 0"
	"newTop := ((self height - self textArea height) / 2.0).
	newTop := newTop truncated."
	
	"for 9: 20, 18 - 0"
	"newTop := ((self height - self textArea height) / 2.0) - 1.
	newTop := newTop truncated."
	
	"for 8: 20, 16 - 1"
	"newTop := ((self height - self textArea height) / 2.0) - 1.
	newTop := newTop truncated."
	
	"for 7: 20, 14 - 2"
	"newTop := ((self height - self textArea height) / 2.0) - 1.
	newTop := newTop truncated abs."!
!GLMRubTextFieldMorph methodsFor: 'initialize-release' stamp: 'AliakseiSyrel 3/20/2015 12:50'!
newScrollPane
	"using hacked ScrollPane to remove focus border"
	| sp |
	sp := GLMRubTextScrollPane new.
	sp scrollTarget: self defaultScrollTarget.
	^ sp! !

!GLMRubTextFieldMorph methodsFor: 'geometry' stamp: 'AliakseiSyrel 3/21/2015 19:00'!
extent: aPoint
	|newTop patch offset|
	super extent: aPoint.
	
	offset := (self height - self textArea height) / 2.0.
	patch := offset fractionPart rounded - offset sign.
	newTop := (offset + patch) truncated abs.
	
	self textArea top: newTop.! !

!GLMRubTextFieldMorph methodsFor: 'geometry' stamp: 'AliakseiSyrel 3/21/2015 17:05'!
forceHeight: anObject

	customHeight := anObject.! !

!GLMRubTextFieldMorph methodsFor: 'geometry' stamp: 'AliakseiSyrel 3/21/2015 17:05'!
textFieldHeight

	^ customHeight
		ifNil: [ self textArea height ]
		ifNotNil: [ customHeight brickValue: self ]! !

!GLMRubTextScrollPane methodsFor: 'scrollbars' stamp: 'AliakseiSyrel 3/20/2015 12:51'!
hScrollbarInterval
	"Answer the computed size of the thumb of the horizontal scrollbar."
	self scrollTarget width = 0 ifTrue: [ ^ 0 ].
	^ self scrollBounds width asFloat / self scrollTarget width min: 1.0.! !

!GLMRubTextScrollPane methodsFor: 'drawing' stamp: 'AliakseiSyrel 3/31/2015 16:35'!
drawKeyboardFocusOnAthensCanvas: aCanvas
	"empty to remove focus border"! !

!GLMRubTextScrollPane methodsFor: 'drawing' stamp: 'AliakseiSyrel 3/20/2015 12:51'!
drawKeyboardFocusOn: aCanvas
	"empty to remove focus border"! !

!GLMRubricExample methodsFor: 'opening' stamp: 'AlainPlantec 8/2/2013 22:25'!
open
	self presentation openOn: self loremIpsum ! !

!GLMRubricExample methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 22:25'!
iconProvider
	" For 2.0/3.0 compatibility "
	^ (Smalltalk respondsTo: #ui)
		ifTrue: [ (Smalltalk perform: #ui) icons]
		ifFalse: [ UITheme current ]! !

!GLMRubricExample methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/4/2014 21:31'!
loremIpsum
	^ String loremIpsum: 81233! !

!GLMRubricHighlightedTextPresentation commentStamp: 'AndreiChis 9/2/2014 16:39'!
|browser|
browser := GLMTabulator new.
browser row: #row.

browser transmit to: #row; andShow: [ :composite |
	composite custom: (GLMRubricHighlightedTextPresentation new
		editingMode: [GLMHighlighterTextRubEditingMode 
			withStylerDecorator: (RbEPersonDecorator new
				styler:  (GLMHighlighterTextParserStyler new
					parser: RbEPersonColorizer new))]) ].
	
browser openOn: '
person {	
	name	=	''Phil'';
	age = ''23'';	
}
person {}
'.!
!GLMRubricHighlightedTextPresentation methodsFor: 'accessing' stamp: 'TudorGirba 9/5/2014 11:05'!
font
	^ font! !

!GLMRubricHighlightedTextPresentation methodsFor: 'accessing' stamp: 'AndreiChis 4/22/2014 21:38'!
editingMode: aBlock
	
	editingMode := aBlock! !

!GLMRubricHighlightedTextPresentation methodsFor: 'accessing' stamp: 'TudorGirba 9/1/2014 11:24'!
editingMode
	^ editingMode isNil 
		ifTrue: [nil] 
		ifFalse: [editingMode glamourValue: self]! !

!GLMRubricHighlightedTextPresentation methodsFor: 'accessing' stamp: 'AndreiChis 4/22/2014 20:48'!
renderGlamorouslyOn: aRenderer
	self registerAnnouncements.
	^ aRenderer renderRubricHighlightedTextPresentation: self! !

!GLMRubricHighlightedTextPresentation methodsFor: 'accessing' stamp: 'TudorGirba 9/5/2014 10:51'!
morphicFont
	^ self font 
		ifNil: [ StandardFonts defaultFont  ]
		ifNotNil: [ :f | f glamourValue: self entity ]! !

!GLMRubricHighlightedTextPresentation methodsFor: 'accessing' stamp: 'TudorGirba 9/5/2014 11:05'!
font: anObject
	font := anObject! !

!GLMRubricSmalltalkCodePresentation commentStamp: 'AndreiChis 10/1/2014 13:48'!
I extend the simple Rubric text presentation with basic support for dealing with Smalltalk code.!
!GLMRubricSmalltalkCodePresentation methodsFor: 'accessing' stamp: 'AndreiChis 3/20/2015 18:15'!
executionSelectionActions

	^ { 
		(GLMGenericAction new) 
				title: 'Do it';
				action: [ :aPresentation |
					aPresentation highlightEvaluateAndDo: [ :result | ] ]; 
				shortcut: $d; 
				icon: GLMUIThemeExtraIcons glamorousSpawn;
				yourself.
		(GLMGenericAction new) 
				title: 'Print it';
				action: [ :aPresentation |
					aPresentation printSelection ]; 
				shortcut: $p; 
				yourself.
		(GLMGenericAction new) 
				title: 'Inspect it'; 
				action: [ :aPresentation |
					aPresentation highlightEvaluateAndDo: [ :result | result inspect ] ]; 
				shortcut: $i; 
				icon: GLMUIThemeExtraIcons glamorousInspect;
				yourself.
		(GLMGenericAction new) 
				title: 'Basic Inspect it'; 
				action: [ :aPresentation |
					aPresentation highlightEvaluateAndDo: [ :result | result basicInspect ] ]; 
				shortcut: $I; 
				icon: GLMUIThemeExtraIcons glamorousInspect;
				yourself.
		(GLMGenericAction new) 
				title: 'Debug it'; 
				action: [ :aPresentation |
					aPresentation debugSelection ]; 
				shortcut: $D;
				yourself.
		(GLMGenericAction new) 
				title: 'Profile it'; 
				action: [ :aPresentation |
					aPresentation profileSelection ]; 
				withSeparatorAfter;
				yourself.
		 }! !

!GLMRubricSmalltalkCodePresentation methodsFor: 'rendering' stamp: 'AndreiChis 5/20/2014 17:32'!
installDefaultSelectionActions

	self defaultSelectionActions do: [ :anAction |
		self addSelectionAction: anAction ]! !

!GLMRubricSmalltalkCodePresentation methodsFor: 'actions' stamp: 'AndreiChis 1/14/2015 11:02'!
highlightEvaluateAndDo: aBlock

	self announce: (GLMHighlightAndEvaluate new action: aBlock)! !

!GLMRubricSmalltalkCodePresentation methodsFor: 'actions' stamp: 'AndreiChis 3/19/2015 17:44'!
evaluateSelection

	self announce: (GLMEvaluateSelection new 
		action: [ :result | result ];
		makeSyncronous)! !

!GLMRubricSmalltalkCodePresentation methodsFor: 'actions' stamp: 'AndreiChis 5/21/2014 10:38'!
debugSelection

	self announce: GLMDebugSelection! !

!GLMRubricSmalltalkCodePresentation methodsFor: 'actions' stamp: 'AndreiChis 7/7/2014 10:14'!
compileTextIn: aContext from:  aSession andDo: aBlock

	self announce: (GLMCompileText new
		presentation: self;
		context: aContext;
		session: aSession;
		action: aBlock)! !

!GLMRubricSmalltalkCodePresentation methodsFor: 'actions' stamp: 'AndreiChis 5/21/2014 10:38'!
printSelection

	self announce: GLMPrintSelection! !

!GLMRubricSmalltalkCodePresentation methodsFor: 'accessing' stamp: 'AndreiChis 10/5/2014 16:48'!
browsingSelectionActions

	^ { (GLMGenericAction new) 
				title: 'Browse it';
				action: [ :aPresentation |
					aPresentation browseIt  ]; 
				shortcut: $b; 
				category: 'Code search...';
				yourself.
		(GLMGenericAction new) 
				title: 'Senders of it';
				action: [ :aPresentation |
					aPresentation sendersOfIt ]; 
				shortcut: $n; 
				category: 'Code search...';
				yourself.
		(GLMGenericAction new) 
				title: 'Implementors of it';
				action: [ :aPresentation |
					aPresentation implementorsOfIt ]; 
				shortcut: $m; 
				category: 'Code search...';
				yourself.
		(GLMGenericAction new) 
				title: 'References to it';
				action: [ :aPresentation |
					aPresentation referencesToIt ]; 
				"shortcut: $N; "
				category: 'Code search...';
				withSeparatorAfter;
				yourself.
		(GLMGenericAction new) 
				title: 'Extended string search'; 
				action: [ :aPresentation |
					aPresentation selectLine.
					self systemNavigation 
						browseMethodsWithString: aPresentation selectedText
						matchCase: false ]; 
				shortcut: $E;
				category: 'Code search...';
				yourself.
		(GLMGenericAction new) 
				title: 'Method source with it';
				action: [ :aPresentation |
					aPresentation selectLine.
					self systemNavigation 
						browseMethodsWithSourceString: aPresentation selectedText
						matchCase: false.]; 
				category: 'Code search...';
				withSeparatorAfter;
				yourself. }! !

!GLMRubricSmalltalkCodePresentation methodsFor: 'accessing' stamp: 'AndreiChis 10/5/2014 15:03'!
defaultSelectionActions

	^ self executionSelectionActions, 
		self codeEditingSelectionActions, 
		self browsingSelectionActions
	! !

!GLMRubricSmalltalkCodePresentation methodsFor: 'actions' stamp: 'AndreiChis 5/21/2014 10:38'!
profileSelection

	self announce: GLMProfileSelection! !

!GLMRubricSmalltalkCodePresentation methodsFor: 'actions browsing' stamp: 'AndreiChis 10/4/2014 23:14'!
browseIt

	self announce: (GLMTextEditorRequest for: #browseIt)! !

!GLMRubricSmalltalkCodePresentation methodsFor: 'actions browsing' stamp: 'AndreiChis 10/4/2014 23:14'!
referencesToIt

	self announce: (GLMTextEditorRequest for: #referencesToIt)! !

!GLMRubricSmalltalkCodePresentation methodsFor: 'actions' stamp: 'AndreiChis 5/3/2014 18:37'!
evaluateSelectionAndDo: aBlock

	self announce: (GLMEvaluateSelection new action: aBlock)! !

!GLMRubricSmalltalkCodePresentation methodsFor: 'actions browsing' stamp: 'AndreiChis 10/4/2014 23:14'!
sendersOfIt

	self announce: (GLMTextEditorRequest for: #sendersOfIt)! !

!GLMRubricSmalltalkCodePresentation methodsFor: 'actions browsing' stamp: 'AndreiChis 10/4/2014 23:14'!
implementorsOfIt

	self announce: (GLMTextEditorRequest for: #implementorsOfIt)! !

!GLMRubricSmalltalkTextModel methodsFor: 'shout' stamp: 'AndreiChis 4/21/2014 19:05'!
highlightSmalltalk: aBoolean
	highlightSmalltalk := aBoolean! !

!GLMRubricSmalltalkTextModel methodsFor: 'accessing' stamp: 'AndreiChis 5/7/2014 17:17'!
doItContext
	^ self glamourPresentation doItContext ! !

!GLMRubricSmalltalkTextModel methodsFor: 'bindings' stamp: 'AndreiChis 5/3/2014 18:16'!
hasBindingThatBeginsWith: aString
	^ self variableBindings keys anySatisfy: [:each | each beginsWith: aString]! !

!GLMRubricSmalltalkTextModel methodsFor: 'shout' stamp: 'AndreiChis 4/21/2014 19:05'!
highlightSmalltalkContext
	^ highlightSmalltalkContext! !

!GLMRubricSmalltalkTextModel methodsFor: 'accessing' stamp: 'AndreiChis 5/21/2014 10:36'!
selectedBehavior
	
	^ self highlightSmalltalkContext! !

!GLMRubricSmalltalkTextModel methodsFor: 'bindings' stamp: 'AndreiChis 5/3/2014 18:15'!
variableBindings
	^ variableBindings ifNil: [variableBindings := Dictionary new]! !

!GLMRubricSmalltalkTextModel methodsFor: 'bindings' stamp: 'AndreiChis 5/3/2014 19:24'!
hasBindingOf: aSymbol

	^ self variableBindings includesKey: aSymbol! !

!GLMRubricSmalltalkTextModel methodsFor: 'bindings' stamp: 'AndreiChis 5/7/2014 17:29'!
bindingsStrategy

	^ bindingsStrategy! !

!GLMRubricSmalltalkTextModel methodsFor: 'testing' stamp: 'AndreiChis 5/3/2014 18:17'!
isCodeCompletionAllowed 
	^true! !

!GLMRubricSmalltalkTextModel methodsFor: 'bindings' stamp: 'AndreiChis 1/30/2015 11:53'!
appendVariableBinding: anAssociationList

	anAssociationList ifNotNil: [
		anAssociationList do: [ :anAssociation | 
			self variableBindings add: (WorkspaceVariable key: anAssociation key value: anAssociation value) ] ]! !

!GLMRubricSmalltalkTextModel methodsFor: 'bindings' stamp: 'AndreiChis 5/3/2014 18:17'!
guessTypeForName: aString 
	^ nil! !

!GLMRubricSmalltalkTextModel methodsFor: 'shout' stamp: 'AndreiChis 4/21/2014 19:05'!
highlightSmalltalkContext: aClassOrMetaclass
	highlightSmalltalkContext := aClassOrMetaclass! !

!GLMRubricSmalltalkTextModel methodsFor: 'accessing' stamp: 'AndreiChis 5/30/2014 13:57'!
selectedClassOrMetaClass
	
	^ self selectedBehavior! !

!GLMRubricSmalltalkTextModel methodsFor: 'shout' stamp: 'AndreiChis 4/21/2014 19:04'!
highlightSmalltalk
	^ highlightSmalltalk! !

!GLMRubricSmalltalkTextModel methodsFor: 'accessing' stamp: 'AndreiChis 5/7/2014 17:17'!
doItReceiver
	^ self glamourPresentation doItReceiver ! !

!GLMRubricSmalltalkTextModel methodsFor: 'bindings' stamp: 'AndreiChis 5/7/2014 17:47'!
bindingOf: aSymbol

	^ self bindingsStrategy cull: self variableBindings cull: aSymbol! !

!GLMRubricSmalltalkTextModel methodsFor: 'bindings' stamp: 'AndreiChis 5/3/2014 18:16'!
variableBindings: aDictionary
	variableBindings := aDictionary! !

!GLMRubricSmalltalkTextModel methodsFor: 'bindings' stamp: 'AndreiChis 5/3/2014 18:15'!
bindingsStrategy: aBlock

	bindingsStrategy := aBlock! !

!GLMRubricSmalltalkTextModel methodsFor: 'shout' stamp: 'AndreiChis 4/21/2014 19:04'!
shoutAboutToStyle: aPluggableShoutMorph
	self highlightSmalltalk ifFalse: [^ false].
	self highlightSmalltalkContext ifNotNil: [ :classOrMetaClass |
 		aPluggableShoutMorph classOrMetaClass: classOrMetaClass  ].
	^ true! !

!GLMRubricTextModel methodsFor: 'accessing' stamp: 'TudorGirba 6/2/2013 22:03'!
announcer
	^ announcer ifNil: [ announcer := Announcer new weak ]! !

!GLMRubricTextModel methodsFor: 'callbacks' stamp: 'AndreiChis 5/21/2014 09:50'!
menu

	^ self menu: MenuMorph new! !

!GLMRubricTextModel methodsFor: 'accessing' stamp: 'AlainPlantec 9/18/2013 21:57'!
primarySelectionInterval: anInterval 
	primarySelectionInterval := anInterval! !

!GLMRubricTextModel methodsFor: 'accessing' stamp: 'TudorGirba 2/8/2014 23:32'!
getText
	^ self glamourPresentation formatedDisplayValue! !

!GLMRubricTextModel methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 14:47'!
setText: aText from: aRubScrolledTextMorph 
	self glamourPresentation text: aText.
	^true! !

!GLMRubricTextModel methodsFor: 'accessing' stamp: 'AlainPlantec 9/18/2013 21:56'!
primarySelectionInterval
	^ primarySelectionInterval! !

!GLMRubricTextModel methodsFor: 'accessing' stamp: 'TudorGirba 6/2/2013 22:03'!
announcer: anObject
	announcer := anObject! !

!GLMRubricTextMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 6/5/2013 23:19'!
testMultipleSelectionWithChange
	| composite textMorph textPresentation |
	composite := GLMCompositePresentation new with: [ :a | a rubricText display: '123456789' ].
	window := composite openOn: 4.
	textMorph := self find: RubScrolledTextMorph in: window.
	self assert: textMorph selectionInterval isEmpty.
	textPresentation := composite presentations first.
	textPresentation selectionInterval: (2 to: 5).
	self assert: textMorph textArea selection asString equals: '2345'.
	self assert: textPresentation selectedText asString equals: '2345'! !

!GLMRubricTextMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 3/31/2014 07:23'!
testPastingUpdatesTextPort
	| composite textMorph  |
	composite := GLMCompositePresentation new with: [ :a | a rubricText display: '' ].
	window := composite openOn: 42.
	textMorph := self find: RubEditingArea in: window.
	Clipboard clipboardText: '42'.
	textMorph editor paste.
	self assert: (composite pane port: #text) value asString equals: '42'! !

!GLMRubricTextMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 6/5/2013 23:20'!
testTextPortPopulatedByDefault
	| composite |
	composite := GLMCompositePresentation new with: [:a | a rubricText ].
	window := composite openOn: '42'.
	self assert: (composite pane port: #text) value asString equals: '42'! !

!GLMRubricTextMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 5/21/2014 22:10'!
testAcceptKeyCanBeOverriden
	| composite textMorph overriden |
	overriden := false.
	composite := GLMCompositePresentation new with: [ :a | a rubricText act: [ :text | overriden := true ] on: $s entitled: 'Override'].
	window := composite openOn: '4'.
	textMorph := self find: RubScrolledTextMorph in: window.
	self simulateOnlyOneClickOn: textMorph.
	Smalltalk os isMacOSX ifTrue: [self simulateKeyStroke: $s command].
	Smalltalk os isUnix ifTrue: [self simulateKeyStroke: $s alt].
	Smalltalk os isWindows ifTrue: [self simulateKeyStroke: $s alt].
	self assert: overriden! !

!GLMRubricTextMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 6/5/2013 23:18'!
testResettingTheSelection
	| composite textPresentation |
	composite := GLMCompositePresentation new with: [ :a | a rubricText display: '123456789' ].
	window := composite openOn: 4.
	textPresentation := composite presentations first.
	textPresentation selectionInterval: (2 to: 5).
	self shouldnt: [textPresentation selectionInterval: nil] raise: Error! !

!GLMRubricTextMorphicTest methodsFor: 'as yet unclassified' stamp: 'AndreiChis 10/2/2014 17:40'!
expectedFailures
	^ super expectedFailures, #(testOKeyCanBeOverriden)! !

!GLMRubricTextMorphicTest methodsFor: 'tests' stamp: 'AndreiChis 8/28/2014 19:47'!
testOKeyCanBeOverriden
	| composite textMorph overriden |
	overriden := false.
	composite := GLMCompositePresentation new with: [ :a | a rubricText act: [ :text | overriden := true ] on: $o entitled: 'Override'].
	window := composite openOn: '4'.
	textMorph := self find: RubScrolledTextMorph in: window.
	self simulateOnlyOneClickOn: textMorph.
	Smalltalk os isMacOSX ifTrue: [self simulateKeyStroke: $o command].
	Smalltalk os isUnix ifTrue: [self simulateKeyStroke: $o alt].
	Smalltalk os isWindows ifTrue: [self simulateKeyStroke: $o alt].
	self assert: overriden! !

!GLMRubricTextMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 8/2/2013 22:12'!
testUnregisterFromAnnouncementsWhenUpdating
	| composite announcingCollection numberOfExecutions |
	numberOfExecutions := 0.
	announcingCollection := GLMAnnouncingCollection new.
	composite :=  GLMCompositePresentation new with: [ :a | 
					(a rubricText)
						updateOn: GLMItemAdded from: [ announcingCollection ];
						display: [ 
								numberOfExecutions := numberOfExecutions + 1. 
								numberOfExecutions asString ] ].
	window := composite openOn: announcingCollection.
	1 to: 3 do: [ :each | announcingCollection add: each ].
	self assert: numberOfExecutions equals: 4	"it should not be 8"! !

!GLMRubricTextMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 7/16/2013 21:52'!
testExplicitAcceptDoesNotAffectTextPort
	| composite textMorph |
	composite := GLMCompositePresentation new with: [ :a | a rubricText display: '123' ].
	window := composite openOn: 4.
	textMorph := self find: RubScrolledTextMorph in: window.
	self simulateOnlyOneClickOn: textMorph.
	self simulateKeyStrokes: '4'.
	self assert: (composite pane port: #text) value asString equals: '1234'.
	self simulateKeyStroke: $s command.
	self simulateKeyStrokes: '56'.
	self assert: (composite pane port: #text) value asString equals: '123456'! !

!GLMRubricTextMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 7/16/2013 21:52'!
testEnteringTextInPort
	| composite textMorph |
	composite := GLMCompositePresentation new with: [ :a | a rubricText display: '' ].
	window := composite openOn: 4.
	textMorph := self find: RubScrolledTextMorph in: window.
	self simulateOnlyOneClickOn: textMorph.
	self simulateKeyStrokes: 'hello'.
	self assert: (composite pane port: #text) value asString equals: 'hello'! !

!GLMRubricTextMorphicTest methodsFor: 'private' stamp: 'TudorGirba 7/16/2013 21:52'!
simulateOnlyOneClickOn: aMorph
	(Delay forMilliseconds: HandMorph doubleClickTime + 1) wait.
	aMorph simulateClick! !

!GLMRubricTextPresentation commentStamp: 'AndreiChis 10/1/2014 13:48'!
A presentation that displays text using Rubric.

!
!GLMRubricTextPresentation methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 19:15'!
withTextSegments: aCollection
	self textSegments addAll: aCollection! !

!GLMRubricTextPresentation methodsFor: 'actions text' stamp: 'AndreiChis 10/3/2014 18:50'!
cut

	self announce: (GLMTextEditorRequest for: #cut)! !

!GLMRubricTextPresentation methodsFor: 'actions text' stamp: 'AndreiChis 10/4/2014 22:36'!
pasteRecent

	self announce: (GLMTextEditorRequest for: #pasteRecent)! !

!GLMRubricTextPresentation methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 19:15'!
textSegments
	^textSegments ifNil: [ textSegments := OrderedCollection new ]! !

!GLMRubricTextPresentation methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 18:21'!
withColumns: aBoolean
	
	withColumns := aBoolean! !

!GLMRubricTextPresentation methodsFor: 'actions text' stamp: 'AndreiChis 10/4/2014 22:35'!
copySelection

	self announce: (GLMTextEditorRequest for: #copySelection)! !

!GLMRubricTextPresentation methodsFor: 'accessing' stamp: 'AlainPlantec 9/18/2013 21:59'!
primarySelectionInterval
	^ primarySelectionInterval! !

!GLMRubricTextPresentation methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 20:45'!
addTextSegment: aTextSegmentMorph
	self textSegments add: aTextSegmentMorph! !

!GLMRubricTextPresentation methodsFor: 'accessing' stamp: 'AlainPlantec 9/18/2013 22:15'!
scrollAtIndex: anIndex
	self primarySelectionInterval: (anIndex to: anIndex - 1)! !

!GLMRubricTextPresentation methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 16:43'!
withAnnotation: aBoolean
	
	withAnnotation := aBoolean! !

!GLMRubricTextPresentation methodsFor: 'accessing' stamp: 'AndreiChis 10/5/2014 15:04'!
defaultSelectionActions

	^ self executionSelectionActions
	! !

!GLMRubricTextPresentation methodsFor: 'actions text' stamp: 'AndreiChis 10/4/2014 22:35'!
paste

	self announce: (GLMTextEditorRequest for: #paste)! !

!GLMRubricTextPresentation methodsFor: 'accessing' stamp: 'TudorGirba 10/17/2014 07:07'!
codeEditingSelectionActions

	^ { 
		(GLMGenericAction new) 
				title: 'Cut';
				action: [ :aPresentation |
					aPresentation cut ]; 
				shortcut: $x; 
				yourself.
		(GLMGenericAction new) 
				title: 'Copy';
				action: [ :aPresentation |
					aPresentation copySelection ]; 
				shortcut: $c; 
				yourself.
		(GLMGenericAction new) 
				title: 'Paste';
				action: [ :aPresentation |
					aPresentation paste ]; 
				shortcut: $v; 
				yourself.
		(GLMGenericAction new) 
				title: 'Paste...';
				action: [ :aPresentation |
					aPresentation pasteRecent  ]; 
				withSeparatorAfter;
				yourself. }! !

!GLMRubricTextPresentation methodsFor: 'accessing' stamp: 'AlainPlantec 9/18/2013 21:59'!
primarySelectionInterval: anInterval
	primarySelectionInterval := anInterval! !

!GLMRubricTextPresentation methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 16:48'!
wrapped
	
	^  wrapped ifNil: [ wrapped := true ]! !

!GLMRubricTextPresentation methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 16:43'!
withAnnotation
	
	^ withAnnotation ifNil: [ withAnnotation := false ]! !

!GLMRubricTextPresentation methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 16:57'!
tabWidth
	^ tabWidth ifNil: [ TextStyle default rubTabWidth ]! !

!GLMRubricTextPresentation methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 16:38'!
withLineNumbers: aBoolean
	
	withLineNumbers := aBoolean! !

!GLMRubricTextPresentation methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 16:56'!
tabWidth: anInteger
	tabWidth := anInteger! !

!GLMRubricTextPresentation methodsFor: 'rendering' stamp: 'TudorGirba 6/2/2013 21:38'!
renderGlamorouslyOn: aRenderer
	self registerAnnouncements.
	^ aRenderer renderRubricTextPresentation: self! !

!GLMRubricTextPresentation methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 16:45'!
wrapped: aBoolean
	
	wrapped := aBoolean! !

!GLMRubricTextPresentation methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 18:21'!
withColumns
	
	^ withColumns ifNil: [ withColumns := false ]! !

!GLMRubricTextPresentation methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 16:38'!
withLineNumbers
	
	^ withLineNumbers ifNil: [ withLineNumbers := false ]! !

!GLMScriptingTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testSimpleTransmission
	| browser |
	browser := GLMTabulator new.
	browser
		column: #one;
		column: #two.
	browser sendTo: #two -> #port2 from: #one -> #port1.
	self assert: browser transmissions size equals: 1.
	self assert: (browser transmissions first transmissionStrategy isKindOf: GLMNoStrategy).
	self assert: browser transmissions first origins first equals: ((browser paneNamed: #one) port: #port1).
	self assert: browser transmissions first destination equals: ((browser paneNamed: #two) port: #port2)! !

!GLMScriptingTest methodsFor: 'tests' stamp: 'TudorGirba 1/2/2012 02:45'!
expectedFailures 
	^ #(testFinderWithPreviousPort)! !

!GLMScriptingTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testNestedBrowserWithExplicitTransmission
	| browser innerBrowser realInnerBrowser |
	browser := GLMTabulator new.
	browser column: #one.
	innerBrowser := GLMTabulator new.
	innerBrowser column: #innerOne.
	(innerBrowser transmit)
		to: #innerOne;
		from: #outer port: #entity;
		andShow: [ :a | a text ].
	(browser transmit)
		to: #one;
		andShow: [ :a | a custom: innerBrowser ].
	browser startOn: 42.
	realInnerBrowser := (browser paneNamed: #one) presentations first.
	self assert: ((browser paneNamed: #one) port: #entity) value equals: 42.
	self assert: ((realInnerBrowser paneNamed: #innerOne) port: #entity) value equals: 42! !

!GLMScriptingTest methodsFor: 'tests' stamp: 'TudorGirba 7/29/2011 19:19'!
testAllowNil
	| browser presentationsChanged matchingPresentationsChanged |
	browser := GLMTabulator new.
	browser
		column: [ :c | 
					c
						row: #one;
						row: #two ];
		column: #details.
	browser
		transmit to: #one;
		andShow: [ :a | a tree display: #(1 2 3) ].
	browser
		transmit to: #two;
		andShow: [ :a | a tree display: #(#a #b #c) ].
	browser
		transmit to: #details;
		from: #one;
		from: #two;
		andShow: [ :a | 
					(a text)
						display: [ :one :two | one asString , two asString ];
						allowNil ].
	browser startOn: 42.
	(browser paneNamed: #details) when: GLMPresentationsChanged do: [ :a | presentationsChanged := true ].
	(browser paneNamed: #details) when: GLMMatchingPresentationsChanged do: [ :a | matchingPresentationsChanged := true ].
	presentationsChanged := false.
	matchingPresentationsChanged := false.
	((browser paneNamed: #one) port: #selection) value: 2.
	self assert: presentationsChanged.
	self assert: matchingPresentationsChanged.
	self assert: (browser paneNamed: #details) presentations first displayValue equals: '2nil'.
	presentationsChanged := false.
	((browser paneNamed: #two) port: #selection) value: #c.
	self assert: presentationsChanged.
	self assert: matchingPresentationsChanged.
	self assert: (browser paneNamed: #details) presentations first displayValue equals: '2c'.
	presentationsChanged := false.
	((browser paneNamed: #one) port: #selection) value: nil.
	self assert: presentationsChanged.
	self assert: matchingPresentationsChanged.
	self assert: (browser paneNamed: #details) presentations first displayValue equals: 'nilc'! !

!GLMScriptingTest methodsFor: 'tests' stamp: 'TudorGirba 7/29/2011 19:18'!
testDynamicActions
	| browser |
	browser := GLMTabulator new.
	browser column: #one.
	browser
		transmit to: #one;
		andShow: [ :a | 
					(a list)
						display: [ :x | 1 to: x ];
						dynamicActions: [ :list | 
									(1 to: list selection)
										collect: [ :index | 
											(GLMGenericAction new)
												action: [ index ];
												title: 'Action' , index printString;
												yourself ] ] ].
	browser startOn: 42.
	(browser panes first port: #selection) value: 3.
	self assert: browser panes first presentations first dynamicActions size equals: 3.
	(browser panes first port: #selection) value: 5.
	self assert: browser panes first presentations first dynamicActions size equals: 5! !

!GLMScriptingTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testScriptingDefaults
	| browser |
	browser := GLMTabulator new.
	browser startOn: 42.
	self assert: browser panes size equals: 1.
	self assert: browser transmissions size equals: 1.
	self assert: browser transmissions first origins first equals: (browser pane port: #entity).
	self assert: browser transmissions first destination equals: (browser panes first port: #entity)! !

!GLMScriptingTest methodsFor: 'tests' stamp: 'TudorGirba 7/29/2011 19:18'!
testEntityInUpdateAction
	| browser inputFromActionBlock |
	browser := GLMTabulator new.
	browser column: #one.
	browser
		transmit to: #one;
		andShow: [ :a | a text populate: #foo on: $m with: [ :list :input | inputFromActionBlock := input ] ].
	browser startOn: 42.
	browser panes first presentations first actions first actOn: browser panes first presentations first.
	self assert: inputFromActionBlock equals: 42! !

!GLMScriptingTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testNestedBrowserEntity
	| browser innerBrowser realInnerBrowser |
	browser := GLMTabulator new.
	browser column: #one.
	innerBrowser := GLMTabulator new.
	innerBrowser column: #innerOne.
	(innerBrowser transmit)
		to: #innerOne;
		from: #outer port: #entity;
		andShow: [ :a | a text ].
	(browser transmit)
		to: #one;
		andShow: [ :a | (a custom: innerBrowser) display: [ :x | x + 2 ] ].
	browser startOn: 40.
	realInnerBrowser := (browser paneNamed: #one) presentations first.
	self assert: ((browser paneNamed: #one) port: #entity) value equals: 40.
	self assert: (realInnerBrowser pane port: #entity) value equals: 40.
	self assert: ((realInnerBrowser paneNamed: #innerOne) port: #entity) value equals: 42! !

!GLMScriptingTest methodsFor: 'tests' stamp: 'AndreiChis 6/24/2013 11:00'!
testStartTransmissionFromInitializationBlock
	| browser |
	browser := GLMTabulator new.
	browser
		column: #one;
		column: #two.
	browser
		transmit to: #one;
		andShow: [ :a | 
			a list
				initialize: [ :pres | pres selection: 4 ] ].
	browser 
		transmit 
		from:#one port: #selection;
		to:#two port: #entity;
		andShow: [ :a |
			a text ].
	self assert: (browser paneNamed: #one) presentations isEmpty.
	self assert: (browser paneNamed: #two) presentations isEmpty.
	browser startOn: 42.
	self assert: (browser paneNamed: #one) presentations size equals: 1.
	self assert: (browser paneNamed: #one) presentations first selection equals: 4.
	self assert: (browser paneNamed: #two) presentations size equals: 1! !

!GLMScriptingTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testSimpleTransmissionsToOuter
	| browser |
	browser := GLMTabulator new.
	browser column: #one.
	browser sendTo: #outer -> #increased from: #outer -> #entity with: [ :x | x + 1 ].
	(browser transmit)
		to: #one;
		from: #outer port: #increased;
		andShow: [ :a | a text ].
	browser startOn: 41.
	self assert: ((browser paneNamed: #one) port: #entity) value equals: 42! !

!GLMScriptingTest methodsFor: 'tests' stamp: 'TudorGirba 7/29/2011 19:17'!
testNestedBrowserOther
	| browser innerBrowser realInnerBrowser |
	browser := GLMTabulator new.
	browser
		column: #one;
		column: #two.
	innerBrowser := GLMTabulator new.
	innerBrowser column: #innerOne.
	innerBrowser
		transmit to: #innerOne;
		andShow: [ :a | a text ].
	innerBrowser transmit toOutsidePort: #selection; from: #innerOne.
	browser
		transmit to: #one;
		andShow: [ :a | (a custom: innerBrowser) display: [ :x | x + 2 ] ].
	browser
		transmit to: #two;
		from: #one;
		andShow: [ :a | a text ].
	browser startOn: 40.
	realInnerBrowser := (browser paneNamed: #one) presentations first.
	self assert: ((browser paneNamed: #one) port: #entity) value equals: 40.
	self assert: (realInnerBrowser pane port: #entity) value equals: 40.
	self assert: ((realInnerBrowser paneNamed: #innerOne) port: #entity) value equals: 42.
	(realInnerBrowser panes first port: #selection) value: 7.
	self assert: (realInnerBrowser pane port: #selection) value equals: 7.
	self assert: (browser panes last port: #entity) value equals: 7! !

!GLMScriptingTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testUpdateAction
	| browser |
	browser := GLMTabulator new.
	browser
		column: #one;
		column: #two.
	(browser transmit)
		to: #one;
		andShow: [ :a | a list populate: #foo on: $m with: [ :list :input | 42 ] ].
	(browser transmit)
		to: #two;
		from: #one port: #foo;
		andShow: [ :a | a text ].
	browser startOn: #(1 2 3).
	self assert: browser panes first presentations size equals: 1.
	self assert: browser panes last presentations isEmpty.
	browser panes first presentations first actions first actOn: browser panes first presentations first.
	self assert: browser panes second presentations size equals: 1.
	self assert: browser panes second presentations first entity equals: 42! !

!GLMScriptingTest methodsFor: '*glamour-tests-morphic' stamp: 'TudorGirba 7/29/2011 19:17'!
testMorphicActionDefinition
	| browser |
	browser := GLMTabulator new.
	browser column: #one.
	browser
		transmit to: #one;
		andShow: [ :a | 
					a text morphicAct: [  ] entitled: ''.
					a list morphicAct: [  ] entitled: ''.
					a tree morphicAct: [  ] entitled: '' ].
	browser startOn: #(42).
	browser panes first presentations do: [ :each | self assert: each actions size equals: 1 ]! !

!GLMScriptingTest methodsFor: 'tests' stamp: 'TudorGirba 7/29/2011 19:18'!
testConditionalPresentation
	| browser |
	browser := GLMTabulator new.
	browser
		column: #one;
		column: #two.
	browser
		transmit to: #two;
		from: #one;
		andShow: [ :a | 
					a text when: [ :x | x = 42 ].
					a list when: [ :x | x > 42 ] ].
	((browser paneNamed: #one) port: #selection) value: 42.
	self assert: (browser paneNamed: #two) matchingPresentations size equals: 1.
	self assert: ((browser paneNamed: #two) matchingPresentations first isKindOf: GLMTextPresentation).
	((browser paneNamed: #one) port: #selection) value: 43.
	self assert: (browser paneNamed: #two) matchingPresentations size equals: 1.
	self assert: ((browser paneNamed: #two) matchingPresentations first isKindOf: GLMListPresentation)! !

!GLMScriptingTest methodsFor: 'tests' stamp: 'TudorGirba 7/29/2011 19:14'!
testTransmissionWithTwoOrigins
	| browser |
	browser := GLMTabulator new.
	browser
		column: #one;
		column: #two;
		column: #three.
	browser
		transmit to: #three;
		from: #one;
		from: #two;
		andShow: [ :a | a text ].
	((browser paneNamed: #one) port: #selection) value: 42.
	self assert: ((browser paneNamed: #three) port: #entity) value first equals: 42.
	self assert: ((browser paneNamed: #three) port: #entity) value last equals: nil.
	self assert: (browser paneNamed: #three) presentations size equals: 1.
	self assert: (browser paneNamed: #three) matchingPresentations size equals: 0.
	((browser paneNamed: #two) port: #selection) value: 43.
	self assert: ((browser paneNamed: #three) port: #entity) value first equals: 42.
	self assert: ((browser paneNamed: #three) port: #entity) value last equals: 43.
	self assert: (browser paneNamed: #three) matchingPresentations size equals: 1! !

!GLMScriptingTest methodsFor: 'tests' stamp: 'TudorGirba 7/29/2011 19:14'!
testStartWithOnlyJumpStart
	| browser |
	browser := GLMTabulator new.
	browser
		column: #one;
		column: #two.
	browser
		transmit to: #one;
		andShow: [ :a | a list ].
	browser
		transmit to: #two;
		from: #one;
		andShow: [ :a | a text ].
	self assert: browser transmissions size equals: 2.
	self assert: (browser paneNamed: #one) presentations isEmpty.
	self assert: (browser paneNamed: #two) presentations isEmpty.
	browser startOn: #(15 25 35).
	self assert: (browser paneNamed: #one) presentations size equals: 1.
	self assert: (browser paneNamed: #one) matchingPresentations size equals: 1.
	self assert: (browser paneNamed: #two) presentations isEmpty.
	self assert: (browser paneNamed: #two) matchingPresentations isEmpty! !

!GLMScriptingTest methodsFor: 'tests' stamp: 'TudorGirba 7/29/2011 19:19'!
testActionDefinition
	| browser |
	browser := GLMTabulator new.
	browser column: #one.
	browser
		transmit to: #one;
		andShow: [ :a | 
					a text act: [  ] entitled: ''.
					a list act: [  ] entitled: ''.
					a tree act: [  ] entitled: '' ].
	browser startOn: #(42).
	browser panes first presentations do: [ :each | self assert: each actions size equals: 1 ]! !

!GLMScriptingTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testPublishing
	| browser |
	browser := GLMTabulator new.
	browser column: #classes.
	browser sendToOutside: #selectedClass from: #classes -> #selection.
	browser sendTo: #classes -> #highlight fromOutside: #highlightedClass.
	(browser panes first port: #selection) value: 42.
	self assert: (browser pane port: #selectedClass) value equals: 42.
	self assert: (browser panes first port: #selection) value equals: 42.
	(browser pane port: #highlightedClass) value: 43.
	self assert: (browser pane port: #highlightedClass) value equals: 43.
	self assert: (browser panes first port: #highlight) value equals: 43.
	(browser panes first port: #highlight) value: 44.
	self assert: (browser pane port: #highlightedClass) value equals: 43.
	self assert: (browser panes first port: #highlight) value equals: 44.
	(browser pane port: #selectedClass) value: 45.
	self assert: (browser pane port: #selectedClass) value equals: 45.
	self assert: (browser panes first port: #selection) value equals: 42! !

!GLMScriptingTest methodsFor: 'tests' stamp: 'TudorGirba 7/29/2011 19:16'!
testOuterEntity
	| browser |
	browser := GLMTabulator new.
	browser
		column: #one;
		column: #two.
	browser
		transmit to: #one;
		andShow: [ :a | a text ].
	browser
		transmit to: #two;
		fromOutsidePort: #entity;
		andShow: [ :a | a text ].
	browser startOn: 42.
	self assert: browser transmissions first origins anyOne name equals: #entity.
	self assert: browser transmissions last origins anyOne name equals: #entity.
	self assert: browser transmissions size equals: 2! !

!GLMScriptingTest methodsFor: 'tests' stamp: 'TudorGirba 1/2/2012 01:48'!
testPublishingToOutsideAndInsideFinder
	| innerBrowser finder realInnerBrowser |
	finder := GLMFinder new.
	innerBrowser := GLMTabulator new.
	innerBrowser
		column: #one;
		column: #two.
	innerBrowser
		transmit to: #one;
		andShow: [ :a | a list display: [ :x | 1 to: 43 ] ].
	innerBrowser
		transmit to: #two;
		from: #one;
		andShow: [ :a | a text ].
	innerBrowser transmit toOutsidePort: #selection; from: #one port: #selection.
	finder show: [:a | a custom: innerBrowser].
	self assert: innerBrowser transmissions size equals: 3.
	self assert: innerBrowser transmissions second origins first pane == innerBrowser panes first.
	self assert: innerBrowser transmissions second destination pane == innerBrowser panes last.
	finder startOn: 43.
	realInnerBrowser := innerBrowser.
	self assert: realInnerBrowser transmissions size equals: 3.
	self assert: realInnerBrowser transmissions second origins first pane == realInnerBrowser panes first.
	self assert: realInnerBrowser transmissions second destination pane == realInnerBrowser panes last! !

!GLMScriptingTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testReferences
	| browser pane1 |
	browser := GLMExplicitBrowser new.
	pane1 := browser addNewPaneNamed: #pane1.
	self assert: (browser resolveOriginPort: #pane1) == (pane1 port: #selection).
	self assert: (browser resolveOriginPort: #pane1 -> #foo) == (pane1 port: #foo).
	self assert: (browser resolveDestinationPort: #pane1) == (pane1 port: #entity).
	self assert: (browser resolveDestinationPort: #pane1 -> #foo) == (pane1 port: #foo).
	self assert: ((browser resolveOriginPort: #outer) isKindOf: GLMPresentationBoundPort).
	self assert: (browser resolveOriginPort: #outer) presentation == browser.
	self assert: (browser resolveOriginPort: #outer) name equals: #selection.
	self assert: ((browser resolveOriginPort: #outer -> #foo) isKindOf: GLMPresentationBoundPort).
	self assert: (browser resolveOriginPort: #outer -> #foo) presentation == browser.
	self assert: (browser resolveOriginPort: #outer -> #foo) name equals: #foo.
	self assert: ((browser resolveDestinationPort: #outer) isKindOf: GLMPresentationBoundPort).
	self assert: (browser resolveDestinationPort: #outer) presentation == browser.
	self assert: (browser resolveDestinationPort: #outer) name equals: #entity.
	self assert: ((browser resolveDestinationPort: #outer -> #foo) isKindOf: GLMPresentationBoundPort).
	self assert: (browser resolveDestinationPort: #outer -> #foo) presentation == browser.
	self assert: (browser resolveDestinationPort: #outer -> #foo) name equals: #foo! !

!GLMScriptingTest methodsFor: 'tests' stamp: 'TudorGirba 7/29/2011 19:14'!
testStartTransmission
	| browser |
	browser := GLMTabulator new.
	browser
		column: #one;
		column: #two.
	browser
		transmit to: #one;
		andShow: [ :a | a list ].
	self assert: browser transmissions size equals: 1.
	self assert: (browser paneNamed: #one) presentations isEmpty.
	self assert: (browser paneNamed: #two) presentations isEmpty.
	browser startOn: 15.
	self assert: (browser paneNamed: #one) presentations size equals: 1.
	self assert: (browser paneNamed: #two) presentations isEmpty! !

!GLMScriptingTest methodsFor: 'tests' stamp: 'TudorGirba 7/29/2011 19:13'!
testTwoTransmissionsWithOnlyOneEvent
	| browser |
	browser := GLMTabulator new.
	browser
		column: #one;
		column: #two;
		column: #three.
	browser
		transmit to: #two;
		from: #one;
		andShow: [ :a | a list ].
	browser
		transmit to: #three;
		from: #two;
		andShow: [ :a | a text ].
	self assert: browser transmissions size equals: 2.
	self assert: (browser paneNamed: #one) presentations isEmpty.
	self assert: (browser paneNamed: #two) presentations isEmpty.
	self assert: (browser paneNamed: #three) presentations isEmpty.
	((browser paneNamed: #one) port: #selection) value: 42.
	self assert: ((browser paneNamed: #two) port: #entity) value equals: 42.
	self assert: (browser paneNamed: #one) presentations isEmpty.
	self assert: (browser paneNamed: #two) presentations size equals: 1.
	self assert: (browser paneNamed: #two) matchingPresentations size equals: 1.
	self assert: (browser paneNamed: #three) presentations isEmpty.
	self assert: (browser paneNamed: #three) matchingPresentations isEmpty! !

!GLMScriptingTest methodsFor: 'tests' stamp: 'TudorGirba 1/2/2012 02:45'!
testFinderWithPreviousPort
	| browser |
	browser := GLMFinder new.
	browser show: [:a | 
		a list
			title: 'Presentation1';
			display: [ :each | 1 to: each ]].
	browser 
		fromPrevious: #selection;
		passivelyFromPrevious: #highlight;
		andShow: [ :a | 
			a list
				title: 'Presentation2';
				display: [ :selection :highlight | 1 to: selection + highlight ] ].
	browser startOn: 42.
	self assert: browser panes first presentations size equals: 1.
	self assert: browser presentations first title equals: 'Presentation1'.
	self assert: browser transmissions size equals: 1.
	self assert: browser transmissions last origins size equals: 2.
	self assert: browser transmissions last transmissionStrategy presentations size equals: 1.
	self assert: browser transmissions last transmissionStrategy presentations first title equals: 'Presentation2'.
	self assert: (browser panes first port: #entity) value equals: 42.
	(browser panes first port: #highlight) value: 43.
	(browser panes first port: #selection) value: 41.
	self assert: browser panes size equals: 2.
	self assert: browser panes last presentations size equals: 2.
	self assert: browser panes last presentations last displayValue size equals: 84.
	self assert: browser panes last presentations size equals: 2! !

!GLMScriptingTest methodsFor: 'tests' stamp: 'TudorGirba 1/2/2012 01:48'!
testPublishingToOutsideFinder
	| innerBrowser finder |
	finder := GLMFinder new.
	innerBrowser := GLMTabulator new.
	innerBrowser column: #any.
	innerBrowser
		transmit to: #any;
		andShow: [ :a | a list display: [ :x | 1 to: 43 ] ].
	innerBrowser transmit toOutsidePort: #selection; from: #any port: #selection.
	finder show: [:a | a custom: innerBrowser].
	finder startOn: 43.
	self assert: (finder panes first port: #entity) value equals: 43.
	self assert: (finder panes first port: #selection) value isNil.
	((finder panes first presentations first paneNamed: #any) port: #selection) value: 42.
	self assert: (finder panes first port: #selection) value equals: 42.
	self assert: (finder panes first port: #entity) value equals: 43.
	self assert: finder panes size equals: 2.
	self assert: (finder panes last port: #entity) value equals: 42.
	self assert: (finder panes first presentations first isKindOf: GLMTabulator).
	self assert: (finder panes last presentations first isKindOf: GLMTabulator).
	self assert: (finder panes first presentations first isKindOf: GLMTabulator)! !

!GLMScriptingTest methodsFor: 'tests' stamp: 'TudorGirba 3/15/2013 22:07'!
testUpdateYourselfOn

	| announcer entity browser presentation |
	announcer := Announcer new.
	entity := OrderedCollection with: 1 with: 2 with: 3.
	browser := GLMTabulator new.
	browser column: #one.
	browser transmit to: #one; andShow: [ :a |
		presentation := a list 
			updateOn: GLMTestAnnouncement from: [ announcer ];
			shouldValidate: true ].
	browser startOn: entity.
	presentation registerAnnouncements.
	presentation selection: 3.
	entity removeLast.
	announcer announce: GLMTestAnnouncement.
	self assert: presentation selection isNil ! !

!GLMScriptingTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testThreePanesTransmissions
	| browser two |
	browser := GLMTabulator new.
	browser
		column: #one;
		column: #two;
		column: #three.
	(browser transmit)
		to: #three;
		from: #one;
		passivelyFrom: #two;
		andShow: [ :a | a text display: [ :x :y | two := y ] ].
	self assert: browser transmissions size equals: 1.
	self assert: browser transmissions first passiveOrigins size equals: 1.
	self assert: browser transmissions first activeOrigins size equals: 1.
	((browser paneNamed: #two) port: #selection) value: 15.
	self assert: ((browser paneNamed: #two) port: #selection) value equals: 15.
	self assert: ((browser paneNamed: #three) port: #entity) value isNil.
	((browser paneNamed: #one) port: #selection) value: 20.
	self assert: ((browser paneNamed: #one) port: #selection) value equals: 20.
	self assert: ((browser paneNamed: #three) port: #entity) value first equals: 20.
	self assert: ((browser paneNamed: #three) port: #entity) value last equals: 15! !

!GLMScrollListBrick commentStamp: 'AliakseiSyrel 1/30/2015 11:05'!
!
!GLMScrollListBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/27/2015 12:33'!
model: anAdaptor

	adaptor := anAdaptor.
	self band hasSubbricks ifFalse: [ self updateVisible ].
	
	"self layoutPolicy layout: self in: self brickBounds.
	self flag: 'Fix bug in Layouts'."
	self update.! !

!GLMScrollListBrick methodsFor: 'testing' stamp: 'AliakseiSyrel 3/31/2015 22:45'!
isUpdating

	^ isUpdating ifNil: [ isUpdating := false ]! !

!GLMScrollListBrick methodsFor: 'brick-layout-events' stamp: 'AliakseiSyrel 3/31/2015 23:08'!
onChildrenLayouted
	
	self doNotUpdateDuring: [ self update ]! !

!GLMScrollListBrick methodsFor: 'lazy scrolling' stamp: 'AliakseiSyrel 3/31/2015 18:38'!
getAndRemoveInvisibleMorph: aCollection
	|brick|
	brick := self retrieveLast: aCollection.
	^ brick ifNotNil: [ self removeBrickNoLayout: brick. brick morph ]! !

!GLMScrollListBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 1/25/2015 02:18'!
newBand
	^ super newBand height: [ :bandBrick |
		bandBrick subbricks isEmpty
			ifTrue: [ 0 ]
			ifFalse: [ bandBrick lastSubbrick brickBounds bottom ] ].! !

!GLMScrollListBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/25/2015 02:58'!
gatherInvisibleItems
			
	^ self band subbricks select: [ :each | (self isPartiallyVisible: each) not ]! !

!GLMScrollListBrick methodsFor: 'lazy scrolling' stamp: 'AliakseiSyrel 3/31/2015 18:36'!
updateVisible
	|invisible|
	
	self model ifNil: [ ^ self ].
	self model count = 0 ifTrue: [ ^ self ].
	
	invisible := self gatherInvisibleItems.
	invisible = self band subbricks & invisible isEmpty not ifTrue: [ ^ self ].
	
	self updateVisibleTop: invisible.
	self updateVisibleBottom: invisible.
	
	invisible do: [ :each | self removeBrickNoLayout: each ].
	
	visibleIndex := self getIndex: self band firstSubbrick ! !

!GLMScrollListBrick methodsFor: 'scrolling' stamp: 'AliakseiSyrel 1/29/2015 14:56'!
scrollPageDown
	
	self
		scrollDown: self calculateMaxVelocity;
		update;
		changed! !

!GLMScrollListBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/8/2015 17:42'!
initialize
	super initialize.
	
	self band useVerticalLinearLayout! !

!GLMScrollListBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/24/2015 15:06'!
visibleIndex

	^ visibleIndex ifNil: [ visibleIndex := 1 ]! !

!GLMScrollListBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/24/2015 15:15'!
setIndex: anInteger in: aBrick 

	aBrick setProperty: #brickScrollListIndex toValue: anInteger! !

!GLMScrollListBrick methodsFor: 'adding/removing' stamp: 'AliakseiSyrel 3/31/2015 22:34'!
addBrickBackNoLayout: aBrick

	self band doNotLayoutDuring: [ self band addBrickBack: aBrick ].
	^ aBrick! !

!GLMScrollListBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 12/6/2014 11:53'!
newVerticalScrollbar

	^ GLMApproximateScrollbarBrick new! !

!GLMScrollListBrick methodsFor: 'scrolling' stamp: 'AliakseiSyrel 4/1/2015 00:41'!
preventOverscrolling

	self band hasSubbricks ifFalse: [ ^ self ].

	self isFirstAdded & self isFirstVisible ifTrue: [
			(self bandTopOffset > 0) ifTrue: [
				self moveAllSubbricksBy: self topOffset negated.
				self moveBandTop.
				^ self update ] ].
	self isTopOverscrolled
		ifTrue: [ self moveBandTop.  ^ self update ].
	self isBottomOverscrolled & (self isFullyVisible not)
		ifTrue: [ self moveBandBottom. "self moveAllSubbricksBy: (self band height - self band lastSubbrick brickBounds bottom)." ^ self update ]! !

!GLMScrollListBrick methodsFor: 'lazy scrolling' stamp: 'AliakseiSyrel 3/30/2015 12:45'!
updateVisibleBottom: invisibleBricks
	|after|
	
	after := self band lastSubbrick.
	[ after isNotNil and: [ (self isPartiallyVisible: after) and: [ (self getIndex: after) < self model count ] ] ] whileTrue: [
		after := self
			addItemMorph: (
				self
					getMorphAt: (self getIndex: after) + 1
					recycled: (self getAndRemoveInvisibleMorph: invisibleBricks))
			after: after ].! !

!GLMScrollListBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 12/5/2014 10:52'!
retrieveLast: aCollection

	^ aCollection isEmpty
		ifTrue: [ nil ]
		ifFalse: [ aCollection removeLast ]! !

!GLMScrollListBrick methodsFor: 'scrolling' stamp: 'AliakseiSyrel 4/1/2015 00:28'!
update
	isUpdating := true.
	self updateVisible.
	self doNotLayoutDuring:  [ |delta|
		delta := self bandTopOffset + self topOffset.
		self band doLayoutForce.
		self band translateY: delta.  ].
	self preventOverscrolling.
	self verticalScrollbar updatePosition.
	isUpdating := false.! !

!GLMScrollListBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/24/2015 16:39'!
getIndex: aBrick 

	^ aBrick valueOfProperty: #brickScrollListIndex ifAbsent: [ ]! !

!GLMScrollListBrick methodsFor: 'adding/removing' stamp: 'AliakseiSyrel 3/31/2015 18:34'!
removeBrickNoLayout: aBrick

	self band doNotLayoutDuring: [ self band removeBrick: aBrick ]! !

!GLMScrollListBrick methodsFor: 'scrolling' stamp: 'AliakseiSyrel 1/24/2015 18:02'!
invalidate

	self scrollTo: self visibleIndex! !

!GLMScrollListBrick methodsFor: 'scrolling' stamp: 'AliakseiSyrel 3/31/2015 22:33'!
scrollTo: anInteger
	|brick index|
	self band doNotLayoutDuring: [ self band removeAllBricks ].
	self moveBandTop.
	visibleIndex := nil.
	
	self model count > 0 ifTrue: [
		index := (anInteger max: 1) min: self model count.
		brick := self getMorphAt: index recycled: nil.
		brick 	withWidth: self band width.
		brick 	doLayout.
	
		brick brickBounds: ((0@(0 max: ((self height - brick height) / 2))) extent: brick extent).
		self addBrickBackNoLayout: brick ].
	
	self update.
	self changed
	
	
	
	! !

!GLMScrollListBrick methodsFor: 'lazy scrolling' stamp: 'AliakseiSyrel 3/31/2015 18:44'!
updateVisibleTop: invisibleBricks
	|before|
	
	before := self band hasSubbricks not
		ifFalse: [ self band firstSubbrick ]
		ifTrue: [ self addBrickBackNoLayout: (self getMorphAt: self visibleIndex recycled: (self getAndRemoveInvisibleMorph: invisibleBricks)) ].
		
	[ before isNotNil and: [ (self isPartiallyVisible: before) and: [ (self getIndex: before) > 1 ] ] ] whileTrue: [
		before := self
			addItemMorph: (
				self
					getMorphAt: (self getIndex: before) - 1
					recycled: (self getAndRemoveInvisibleMorph: invisibleBricks))
			before: before  ]
	! !

!GLMScrollListBrick methodsFor: 'adding/removing' stamp: 'AliakseiSyrel 3/31/2015 18:41'!
addItemMorph: aMorph after: anotherMorph

	self addBrickBackNoLayout: aMorph.
	self setBoundsOf: aMorph after: anotherMorph.
	(self isPartiallyVisible: aMorph) ifFalse: [ self removeBrickNoLayout: aMorph. ^ nil ].
	^ aMorph! !

!GLMScrollListBrick methodsFor: 'testing' stamp: 'AliakseiSyrel 1/25/2015 02:56'!
isFullyVisible
	self band hasSubbricks ifFalse: [ ^ true ].
	^ self isLastAdded & self isFirstAdded & super isFullyVisible! !

!GLMScrollListBrick methodsFor: 'layouting' stamp: 'AliakseiSyrel 2/6/2015 11:27'!
setBoundsOf: aMorph after: afterMorph
	
	aMorph
		withWidth: self band width;
		brickBounds: (afterMorph brickBounds bottomLeft extent: aMorph extent)! !

!GLMScrollListBrick methodsFor: 'scrolling' stamp: 'AliakseiSyrel 3/31/2015 23:40'!
scrollUp: anInteger
	
	self scrollBy: (
		self isFirstAdded
			ifTrue: [ anInteger min: (self topOffset - self bandTopOffset) ]
			ifFalse: [ anInteger ])! !

!GLMScrollListBrick methodsFor: 'scrolling' stamp: 'AliakseiSyrel 1/25/2015 03:02'!
calculateMaxVelocity
	"max velocity must depend from the height of the band"
	^ (self height * 0.9) asInteger! !

!GLMScrollListBrick methodsFor: 'adding/removing' stamp: 'AliakseiSyrel 3/31/2015 18:42'!
addItemMorph: aMorph before: anotherMorph

	self addBrickBackNoLayout: aMorph before: anotherMorph.
	self setBoundsOf: aMorph before: anotherMorph.
	(self isPartiallyVisible: aMorph) ifFalse: [ self removeBrickNoLayout: aMorph.  ^ nil ].
	
	aMorph brickBounds top < 0
		ifTrue: [ self moveAllSubbricksBy: aMorph brickBounds top negated ]
		ifFalse: [ (self getIndex: aMorph) = 1 ifTrue: [
				self moveAllSubbricksBy: aMorph brickBounds top negated ] ].
	
	^ aMorph! !

!GLMScrollListBrick methodsFor: 'scrolling' stamp: 'AliakseiSyrel 3/30/2015 12:45'!
scrollToBottom

	self scrollTo: self model count! !

!GLMScrollListBrick methodsFor: 'scrolling' stamp: 'AliakseiSyrel 1/29/2015 14:56'!
scrollPageUp
	
	self
		scrollUp: self calculateMaxVelocity;
		update;
		changed! !

!GLMScrollListBrick methodsFor: 'adding/removing' stamp: 'AliakseiSyrel 3/31/2015 22:34'!
addBrickBackNoLayout: aBrick before: anotherBrick

	self band doNotLayoutDuring: [ self band addBrick: aBrick before: anotherBrick ].
	^ aBrick! !

!GLMScrollListBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/30/2015 12:45'!
model

	^ adaptor! !

!GLMScrollListBrick methodsFor: 'layouting' stamp: 'AliakseiSyrel 2/6/2015 11:27'!
setBoundsOf: aMorph before: beforeMorph
	|origin corner|
	
	aMorph withWidth: self band width.
	
	corner := beforeMorph brickBounds topRight.
	origin  := beforeMorph brickBounds topLeft - (0@aMorph height).
	
	aMorph brickBounds: (origin corner: corner)! !

!GLMScrollListBrick methodsFor: 'layouting' stamp: 'AliakseiSyrel 3/31/2015 22:45'!
doNotUpdateDuring: aBlock 

	self isUpdating ifTrue: [ ^ self ].
	isUpdating := true.
	aBlock cull: self.
	isUpdating := false.! !

!GLMScrollListBrick methodsFor: 'scrolling' stamp: 'AliakseiSyrel 3/31/2015 23:10'!
scrollBy: anInteger

	self privateScrollPosition: anInteger.
	self band translateY: anInteger.! !

!GLMScrollListBrick methodsFor: 'layouting' stamp: 'AliakseiSyrel 1/25/2015 02:14'!
moveAllSubbricksBy: anInteger

	self band subbricks do: [ :each | each translateY: anInteger ].
	self band translateY: anInteger negated! !

!GLMScrollListBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/25/2015 02:24'!
topOffset

	^ self band firstSubbrick brickBounds top! !

!GLMScrollListBrick methodsFor: 'brick-layout-events' stamp: 'AliakseiSyrel 3/31/2015 23:08'!
onLayouted
	
	self doNotUpdateDuring: [ self update ]! !

!GLMScrollListBrick methodsFor: 'scrolling' stamp: 'AliakseiSyrel 1/24/2015 18:07'!
scrollToTop

	self scrollTo: 1! !

!GLMScrollListBrick methodsFor: 'testing' stamp: 'AliakseiSyrel 1/25/2015 01:29'!
isFirstAdded

	^ (self getIndex: self band firstSubbrick) = 1! !

!GLMScrollListBrick methodsFor: 'scrolling' stamp: 'AliakseiSyrel 3/31/2015 23:04'!
scrollDown: anInteger
	
	self scrollBy: (
		self isLastAdded
			ifTrue: [ anInteger min: (self band brickBounds bottom - self height) ]
			ifFalse: [ anInteger ]) negated! !

!GLMScrollListBrick methodsFor: 'lazy scrolling' stamp: 'AliakseiSyrel 3/30/2015 12:45'!
getMorphAt: anInteger recycled: aMorph
	|newMorph|
	
	newMorph := (self model morphAt: anInteger convert: aMorph) asBrick.
	newMorph hSpaceFill.
	self setIndex: anInteger in: newMorph.
	^ newMorph! !

!GLMScrollListBrick methodsFor: 'testing' stamp: 'AliakseiSyrel 3/30/2015 12:45'!
isLastAdded

	^ (self getIndex: self band lastSubbrick) = self model count! !

!GLMScrollListBrick class methodsFor: 'examples' stamp: 'AliakseiSyrel 3/27/2015 12:34'!
exampleCollection

	GLMFoundationBrick new
		brickRoot: (self new model: (GLMBrickListModel new on: Smalltalk allClasses));
		extent: 300@400;
		openInWindow! !

!GLMScrollListBrick class methodsFor: 'examples' stamp: 'AliakseiSyrel 4/1/2015 00:27'!
exampleDifferentHeights
	|adaptor|
	adaptor := nil.
	adaptor := GLMBrickListModel new
		sizeLogic: [ 50 ];
		morphAtLogic: [ :index :morph |
			(morph ifNil: [ GLMLabelBrick new ])
				color: Color random muchLighter;
				text: index asString, ' of ', adaptor count asString;
				textPosition: #center;
				enable;
				height: [ :b | (((index % 10)*10 + 30) +  (1000 * (2 / b width))) asInteger ];
				hSpaceFill;
				yourself ].

	GLMFoundationBrick new
		brickRoot: (self new model: adaptor);
		extent: 800@400;
		openInWindow! !

!GLMScrollListBrick class methodsFor: 'examples' stamp: 'AliakseiSyrel 3/31/2015 23:41'!
example
	|adaptor|
	adaptor := nil.
	adaptor := GLMBrickListModel new
		sizeLogic: [ 20 ];
		morphAtLogic: [ :index :morph |
			(morph ifNil: [ GLMLabelBrick new ])
				color: Color random muchLighter;
				text: index asString, ' of ', adaptor count asString;
				textPosition: #center;
				height: 40;
				hSpaceFill;
				yourself ].

	GLMFoundationBrick new
		brickRoot: (self new model: adaptor);
		extent: 300@400;
		openInWindow! !

!GLMScrollListBrick class methodsFor: 'examples' stamp: 'AliakseiSyrel 3/31/2015 18:08'!
exampleInfinity
	|adaptor|
	adaptor := nil.
	adaptor := GLMBrickListModel new
		sizeLogic: [ Float infinity ];
		morphAtLogic: [ :index :morph | 
			(morph ifNil: [ GLMLabelBrick new ])
				color: Color random muchLighter;
				text: index asString, ' of ', adaptor count asString;
				height: 30;
				textPosition: #center;
				hSpaceFill;
				yourself ].

	GLMFoundationBrick new
		brickRoot: (self new model: adaptor);
		extent: 300@400;
		openInWindow! !

!GLMScrollPaneBandBrick commentStamp: 'AliakseiSyrel 2/18/2015 14:01'!
A GLMScrollPaneBandBrick is a band that is used with GLMScrollPaneBrick. It supports force updating of Morph bounds that is triggered after small delay to have no influence on performance

Instance Variables
	asyncTask:		<GLMAsyncTask>
	scrollpane:		<GLMScrollPaneBrick>
	shouldLayoutMorphs:		<Boolean>

asyncTask
	- asynchronous task used to delay the update of morph bounds

scrollpane
	- reference to my scrollpane, so that I could update scrollbar

shouldLayoutMorphs
	- true if I need to update morphic bounds, false otherwise
!
!GLMScrollPaneBandBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/13/2015 18:45'!
asyncTask

	^ asyncTask ifNil: [ asyncTask := GLMAsyncTask new ]! !

!GLMScrollPaneBandBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/12/2015 18:40'!
scrollpane: anObject
	scrollpane := anObject! !

!GLMScrollPaneBandBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/12/2015 18:40'!
scrollpane
	^ scrollpane! !

!GLMScrollPaneBandBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/18/2015 14:03'!
shouldLayoutMorphs

	^ shouldLayoutMorphs ifNil: [ shouldLayoutMorphs := false ]! !

!GLMScrollPaneBandBrick methodsFor: 'brick-layout-events' stamp: 'AliakseiSyrel 2/18/2015 13:51'!
onChildrenLayouted
	super onChildrenLayouted.
	
	self scrollpane ifNotNil: [ :s | s updateScrollbar ].
	
	self shouldLayoutMorphs ifFalse: [ ^ self ].
	self asyncTask
		perform: [ self updateMorphBounds ]
		delay: 400
		priority: Processor lowestPriority! !

!GLMScrollPaneBandBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/18/2015 13:51'!
layoutMorphs: aBoolean
	"if you know, that morphs are used in scrollpane set me to true.
	each time layout changes I relayout all morphs after some delay
	implemented using async task, such that it can be canceled"
	shouldLayoutMorphs := aBoolean! !

!GLMScrollPaneBrick commentStamp: 'AliakseiSyrel 1/30/2015 11:06'!
A GLMScrollPaneBrick is a simple scrollpane with customisable scrollbars

Instance Variables
	band:		<Object>
	lastScrollTimeStamp:		<Object>
	scrollPosition:		<Object>
	velocity:		<Object>
	verticalScrollbar:		<Object>

band
	- xxxxx

lastScrollTimeStamp
	- xxxxx

scrollPosition
	- xxxxx

velocity
	- xxxxx

verticalScrollbar
	- xxxxx
!
!GLMScrollPaneBrick methodsFor: 'scrollpane-brick-accessing' stamp: 'AliakseiSyrel 2/12/2015 18:41'!
band: aBrick

	band := aBrick.
	self band scrollpane: self.
	self band hSpaceFill.
	super addBrickBack: self band.! !

!GLMScrollPaneBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 12/5/2014 06:53'!
outOfWorld: aWorld
	super outOfWorld: aWorld.
	
	self unsubscribeListeners! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-events-mouse' stamp: 'AliakseiSyrel 2/18/2015 10:33'!
mouseWheel: event
	
	self
		scrollBy: (self calculateVelocity: event)
		direction: (event isUp ifTrue: [ #up ] ifFalse: [ #down ])! !

!GLMScrollPaneBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/26/2015 15:19'!
scrollpaneBackgroundColor: aColor

	self setProperty: #brickScrollpaneBackgroundColor toValue: aColor.
	self updateStyle! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-brick-creation' stamp: 'AliakseiSyrel 2/12/2015 18:39'!
newBand

	^ GLMScrollPaneBandBrick new! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-testing' stamp: 'AliakseiSyrel 12/5/2014 23:10'!
isPartiallyVisible: aBrick
	|myBounds testingBounds|
	"need to normalize bounds to take only y coordinate into account"
	
	myBounds := (self allowedBounds withWidth: 1) translateBy: (self allowedBounds origin negated x@0).
	testingBounds :=  (aBrick globalBounds withWidth: 1) translateBy: (aBrick globalBounds origin negated x@0).
	
	^ myBounds intersects: testingBounds! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-accessing' stamp: 'AliakseiSyrel 3/3/2015 14:50'!
layoutMorphs: aBoolean

	self band layoutMorphs: aBoolean! !

!GLMScrollPaneBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/8/2015 18:19'!
initialize
	super initialize.
	
	lastScrollTimeStamp := 0.

	self useVerticalLinearLayout.
	self band: self newBand.
	self verticalScrollbar: self newVerticalScrollbar.	
	"initializes listener for mouse wheel scroll on windows vm"
	self initializeListeners! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-brick-accessing' stamp: 'AliakseiSyrel 2/10/2015 15:12'!
verticalScrollbar: aBrick

	verticalScrollbar := aBrick.
	verticalScrollbar scrollPane: self.
	verticalScrollbar height: [ self height ].
	verticalScrollbar layout heightDependency: self.
	super addBrickBack: verticalScrollbar! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-accessing' stamp: 'AliakseiSyrel 1/25/2015 03:10'!
bandTopOffset

	^ self band brickBounds top! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-testing' stamp: 'AliakseiSyrel 1/25/2015 01:55'!
isFirstVisible

	self band hasSubbricks ifFalse: [ ^ true ].
	^ self isVisible: self band firstSubbrick! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-testing' stamp: 'AliakseiSyrel 12/5/2014 06:52'!
isKeyboardScrollEvent: anEvent

	(anEvent controlKeyPressed | anEvent commandKeyPressed) ifFalse: [^ false ].
	anEvent keyValue = 30 ifTrue: [ ^ true ].
	anEvent keyValue = 31 ifTrue: [ ^ true ].
	^ false! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-updating' stamp: 'AliakseiSyrel 2/25/2015 13:05'!
update

	self scrollDown: 0.
	self scrollUp: 0.
	self privateScrollPosition: self band brickBounds top.
	self band onChildrenLayouted! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-scrolling' stamp: 'AliakseiSyrel 1/27/2015 10:24'!
scrollTo: aBrick
	|delta|
	"if already visible no need to scroll"

	(self isVisible: aBrick) ifTrue: [ ^ self ].
	
	delta := ((self allowedBounds top - band globalBounds top) - (aBrick globalBounds top - band globalBounds top)).
	delta < 0 ifTrue: [ delta := delta + self allowedBounds height - aBrick height ].
		
	self band translateY: delta.
	self isBottomOverscrolled ifTrue: [ self moveBandBottom ].
	self isTopOverscrolled ifTrue: [ self moveBandTop ].
	
	self update.
	self changed.
	
	! !

!GLMScrollPaneBrick methodsFor: 'brick-structure-adding/removing' stamp: 'AliakseiSyrel 2/13/2015 13:57'!
addBrickBack: aBrick

	self band addBrickBack: aBrick! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-updating' stamp: 'AliakseiSyrel 2/12/2015 18:40'!
updateScrollbar

	self verticalScrollbar ifNotNil: [ :b | b updatePosition ]! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-scrolling' stamp: 'AliakseiSyrel 1/29/2015 15:01'!
scrollPageUp

	self
		scrollUp: self height;
		update;
		changed! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-scrolling' stamp: 'AliakseiSyrel 1/25/2015 03:12'!
scrollUp: anInteger

	self band translateY: anInteger.
	self isTopOverscrolled ifTrue: [ self moveBandTop ]! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-testing' stamp: 'AliakseiSyrel 12/5/2014 06:53'!
isVisible: aBrick
	|myBounds testingBounds|
	"need to normalize bounds to take only y coordinate into account"
	
	myBounds := (self allowedBounds withWidth: 0) translateBy: (self allowedBounds origin negated x@0).
	testingBounds :=  (aBrick globalBounds withWidth: 0) translateBy: (aBrick globalBounds origin negated x@0).
	
	^ myBounds containsRect: testingBounds! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-calculations' stamp: 'AliakseiSyrel 1/26/2015 14:50'!
calculateMaxVelocity
	"max velocity must depend from the height of the band"
	^ (self band height / 15) max: self class defaultMaxVelocity! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-scrolling' stamp: 'AliakseiSyrel 1/22/2015 21:00'!
scrollToBottom

	self band hasSubbricks ifFalse: [ ^ self ].
	self scrollTo: self band lastSubbrick! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-updating' stamp: 'AliakseiSyrel 1/26/2015 15:20'!
updateStyle

	self color: self scrollpaneBackgroundColor! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-testing' stamp: 'AliakseiSyrel 1/25/2015 03:10'!
isTopOverscrolled

	^ self bandTopOffset > 0! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-testing' stamp: 'AliakseiSyrel 4/2/2015 15:51'!
isBottomOverscrolled

	self isLastVisible ifFalse: [ ^ false ].
	self band brickBounds bottom < self height ifTrue: [ ^ true ].
	^ ((self band lastSubbrick brickBounds bottom + self band brickBounds top) < self height)! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-events-mouse' stamp: 'AliakseiSyrel 12/5/2014 06:52'!
handlesMouseWheel: evt
	^ true! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-accessing' stamp: 'AliakseiSyrel 12/5/2014 06:53'!
scrollPositionTop

	^ scrollPosition ifNil: [ scrollPosition := 0 ]! !

!GLMScrollPaneBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 12/5/2014 06:53'!
unsubscribeListeners

	self activeHand removeEventListener: self! !

!GLMScrollPaneBrick methodsFor: 'brick-layout-events' stamp: 'AliakseiSyrel 2/14/2015 13:43'!
onChildrenLayouted
	super onChildrenLayouted.
	
	self band translateY: self scrollPositionTop! !

!GLMScrollPaneBrick methodsFor: 'brick-structure-adding/removing' stamp: 'AliakseiSyrel 2/13/2015 13:57'!
addBrick: aBrick before: anotherBrick

	self band addBrick: aBrick before: anotherBrick! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-brick-accessing' stamp: 'AliakseiSyrel 12/5/2014 06:54'!
verticalScrollbar

	^ verticalScrollbar! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-transformations' stamp: 'AliakseiSyrel 1/25/2015 03:11'!
moveBandTop

	self band translateY: self bandTopOffset negated! !

!GLMScrollPaneBrick methodsFor: 'brick-properties-events' stamp: 'AliakseiSyrel 1/26/2015 15:20'!
onThemerChanged
	super onThemerChanged.
	
	self updateStyle! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-calculations' stamp: 'AliakseiSyrel 3/27/2015 14:55'!
calculateVelocity: event
	|delta|
	delta := event timeStamp - lastScrollTimeStamp.
		
	self velocity: (delta > self class defaultScrollTimeReset
		ifTrue: [ self class defaultScrollVelocity ]
		ifFalse: [ self velocityValue: delta ]).
		
	lastScrollTimeStamp := event timeStamp.
	
	^ self velocity ceiling! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-accessing' stamp: 'AliakseiSyrel 1/26/2015 15:14'!
velocity: anInteger

	velocity := anInteger! !

!GLMScrollPaneBrick methodsFor: 'private-scrolling' stamp: 'AliakseiSyrel 1/25/2015 20:14'!
privateScrollPosition: anInteger

	scrollPosition := anInteger.
	self announcer announce: GLMBrickScrollPositionChanged new! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-brick-accessing' stamp: 'AliakseiSyrel 12/5/2014 06:52'!
band

	^ band! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-scrolling' stamp: 'AliakseiSyrel 1/29/2015 14:54'!
scrollPageDown

	self
		scrollDown: self height;
		update;
		changed! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-brick-creation' stamp: 'AliakseiSyrel 1/26/2015 14:50'!
newVerticalScrollbar

	^ GLMScrollbarBrick new! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-events-mouse' stamp: 'AliakseiSyrel 1/26/2015 14:50'!
handleListenEvent: anEvent
	"checking if it's keyboard event (mouse wheel is keyboard event on windows o_O (wtf?)"
	anEvent type = #keystroke ifTrue: [
		"checking if mouse is inside me"
		((self boundsInWorld containsPoint: anEvent position)) ifTrue: [
			"actuall scrolling"
			self scrollByKeyboard: anEvent ] ]! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-scrolling' stamp: 'AliakseiSyrel 1/25/2015 20:13'!
scrollBy: anInteger direction: aSymbol

	self isFullyVisible ifTrue: [ ^ self ].
	
	aSymbol = #up ifTrue: [ self scrollUp: anInteger ].
	aSymbol = #down ifTrue: [ self scrollDown: anInteger ].
	
	self update.
	self changed! !

!GLMScrollPaneBrick methodsFor: 'brick-structure-adding/removing' stamp: 'AliakseiSyrel 2/13/2015 13:57'!
addAllBricks: aCollection

	self band addAllBricks: aCollection! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-calculations' stamp: 'AliakseiSyrel 3/31/2015 23:32'!
velocityValue: anInteger
	|time|
	
	time := anInteger <= self class defaultScrollTurboTime
		ifTrue: [ 2 ]
		ifFalse: [ 1 ].
	^ (self velocity + (self class defaultScrollAcceleration * time)) min: self calculateMaxVelocity! !

!GLMScrollPaneBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 12/5/2014 06:52'!
initializeListeners

	"using the most general event subscribtion for all events spawned by the hand"
	self activeHand addEventListener: self.! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-transformations' stamp: 'AliakseiSyrel 4/1/2015 00:07'!
moveBandBottom
	
	self band translateY: (self height - self band brickBounds bottom)! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-testing' stamp: 'AliakseiSyrel 1/25/2015 01:54'!
isFullyVisible

	^ self isFirstVisible & self isLastVisible! !

!GLMScrollPaneBrick methodsFor: 'brick-structure-adding/removing' stamp: 'AliakseiSyrel 1/25/2015 02:51'!
removeBrick: aBrick
	self band removeBrick: aBrick! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-testing' stamp: 'AliakseiSyrel 1/25/2015 01:55'!
isLastVisible

	self band hasSubbricks ifFalse: [ ^ true ].
	^ self isVisible: self band lastSubbrick! !

!GLMScrollPaneBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/29/2015 17:39'!
scrollpaneBackgroundColor

	^ self valueOfProperty: #brickScrollpaneBackgroundColor ifAbsent: [ self themer scrollpaneBackgroundColor ]! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-accessing' stamp: 'AliakseiSyrel 1/21/2015 13:25'!
scrollPositionBottom

	^ self scrollPositionTop + self innerBounds height! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-scrolling' stamp: 'AliakseiSyrel 1/29/2015 15:30'!
scrollByKeyboard: anEvent
	|direction|
	
	(self isKeyboardScrollEvent: anEvent) ifFalse: [^ self ].
	self velocity: (self calculateVelocity: anEvent).
	
	"keycode 30 is Event direction = #up"
	anEvent keyValue = 30 ifTrue: [ direction := #up ].
	"keycode 31 is Event direction = #down"
	anEvent keyValue = 31 ifTrue: [ direction := #down ].
	self scrollBy: velocity direction: direction! !

!GLMScrollPaneBrick methodsFor: 'brick-structure-adding/removing' stamp: 'AliakseiSyrel 1/25/2015 02:51'!
removeAllBricks
	
	self band removeAllBricks.
	self scrollToTop! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-accessing' stamp: 'AliakseiSyrel 12/5/2014 06:52'!
allowedBounds

	^ self globalBounds! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-scrolling' stamp: 'AliakseiSyrel 12/20/2014 15:52'!
scrollToTop

	self scrollBy: self scrollPositionTop negated direction: #up! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-scrolling' stamp: 'AliakseiSyrel 1/25/2015 03:09'!
scrollDown: anInteger
	
	self band translateY: anInteger negated.
	self isBottomOverscrolled ifTrue: [ self moveBandBottom ]! !

!GLMScrollPaneBrick methodsFor: 'scrollpane-accessing' stamp: 'AliakseiSyrel 1/26/2015 15:14'!
velocity

	^ velocity ifNil: [ velocity := self class defaultScrollVelocity ]! !

!GLMScrollPaneBrick class methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 10/18/2014 01:13'!
defaultScrollTimeReset
	^ 350! !

!GLMScrollPaneBrick class methodsFor: 'examples' stamp: 'AliakseiSyrel 2/8/2015 15:01'!
"protocol: examples"
example
	|foundation scrollPane|
	
	scrollPane := self new.
	
	foundation := GLMFoundationBrick new.
	foundation brickRoot: scrollPane.
	
	1 to: 20 do: [ :index |
		scrollPane addBrickBack: (GLMBrick new
			color: Color random;
			hSpaceFill;
			height: 50).
	].
	
	foundation extent: 200@200.
	
	foundation openInWindow! !

!GLMScrollPaneBrick class methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 10/18/2014 13:24'!
defaultScrollVelocity
	^ 15! !

!GLMScrollPaneBrick class methodsFor: 'examples' stamp: 'AliakseiSyrel 2/3/2015 22:18'!
"protocol: examples"
exampleLarge
	|foundation scrollPane|
	
	scrollPane := self new.
	
	foundation := GLMFoundationBrick new.
	foundation brickRoot: scrollPane.
	
	1 to: 1000 do: [ :index |
		scrollPane addBrickBack: (GLMBrick new
			color: Color random;
			hSpaceFill;
			height: 50).
	].
	
	foundation extent: 400@300.
	
	foundation openInWindow! !

!GLMScrollPaneBrick class methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 10/18/2014 01:11'!
defaultMaxVelocity
	^ self defaultScrollVelocity * 4! !

!GLMScrollPaneBrick class methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 3/27/2015 14:56'!
defaultScrollAcceleration

	^ 4! !

!GLMScrollPaneBrick class methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 11/27/2014 17:17'!
defaultScrollTurboTime

	^ 30! !

!GLMScrollbarBrick commentStamp: 'AliakseiSyrel 11/19/2014 20:32'!
A GLMScrollbarBrick is vertical scollbar for a scrollpane. User can't interact with it

Instance Variables
	bar:		<Object>
	scrollPane:		<Object>

bar
	- xxxxx

scrollPane
	- xxxxx
!
!GLMScrollbarBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/26/2015 14:29'!
scrollbarCornerRadius: anInteger

	self setProperty: #brickScrollbarCornerRadius toValue: anInteger.
	self updateStyle! !

!GLMScrollbarBrick methodsFor: 'scrollbar-brick-accessing' stamp: 'AliakseiSyrel 11/19/2014 20:11'!
bar

	^ bar! !

!GLMScrollbarBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/26/2015 13:30'!
scrollBarColor: aColor

	self setProperty: #brickScrollbarColor toValue: aColor.
	self updateStyle! !

!GLMScrollbarBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/29/2015 17:39'!
scrollbarCornerRadius

	^ self valueOfProperty: #brickScrollbarCornerRadius ifAbsent: [ self themer scrollbarCornerRadius ]
	! !

!GLMScrollbarBrick methodsFor: 'brick-properties-events' stamp: 'AliakseiSyrel 1/26/2015 13:54'!
onThemerChanged
	super onThemerChanged.

	self updateStyle! !

!GLMScrollbarBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/26/2015 13:30'!
scrollbarPosition: aSymbol

	self setProperty: #brickScrollbarPosition toValue: aSymbol.
	self updateStyle! !

!GLMScrollbarBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/29/2015 17:39'!
scrollbarOffset

	^ self valueOfProperty: #brickScrollbarOffset ifAbsent: [ self themer scrollbarOffset ]! !

!GLMScrollbarBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/29/2015 17:39'!
scrollbarPosition

	^ self valueOfProperty: #brickScrollbarPosition ifAbsent: [ self themer scrollbarPosition ]! !

!GLMScrollbarBrick methodsFor: 'scrollbar-updating' stamp: 'AliakseiSyrel 1/26/2015 13:53'!
updateStyle

	self bar color: self scrollBarColor.
	self layout floating: self scrollbarPosition.
	self width: self scrollbarWidth.
	
	self layout floating = #right ifTrue: [ self marginRight: self scrollbarOffset ].
	self layout floating = #bottom ifTrue: [ self marginBottom: self scrollbarOffset ].
	self layout floating = #left ifTrue: [ self marginLeft: self scrollbarOffset ].
	self layout floating = #top ifTrue: [ self marginTop: self scrollbarOffset ]! !

!GLMScrollbarBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/26/2015 13:30'!
scrollbarOffset: anInteger

	self setProperty: #brickScrollbarOffset toValue: anInteger.
	self updateStyle! !

!GLMScrollbarBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/29/2015 17:39'!
scrollBarColor

	^ self valueOfProperty: #brickScrollbarColor ifAbsent: [ self themer scrollbarColor ]! !

!GLMScrollbarBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/29/2015 17:39'!
scrollbarWidth

	^ self valueOfProperty: #brickScrollbarWidth ifAbsent: [ self themer scrollbarWidth ]! !

!GLMScrollbarBrick methodsFor: 'scrollbar-updating' stamp: 'AliakseiSyrel 2/25/2015 13:04'!
updatePosition
	|height top width|
	self scrollPane ifNil: [ ^ self ].
	self scrollPane band height = 0 ifTrue: [
		self bar brickBounds: ((0@0) extent: 0@0).
		^ self changed ].
	
	height := self calculateScrollbarHeight.
	top := self calculateScrollbarTopOffset.
	
	width := (height >= self height)
		ifTrue: [ 0 ]
		ifFalse: [ self width ].
	
	self bar brickBounds: (0@top extent: width@height).
	
	self changed! !

!GLMScrollbarBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/26/2015 13:29'!
scrollbarWidth: anInteger

	self setProperty: #brickScrollbarWidth toValue: anInteger.
	self updateStyle! !

!GLMScrollbarBrick methodsFor: 'scrollbar-calculations' stamp: 'AliakseiSyrel 12/6/2014 11:45'!
calculateScrollbarTopOffset

	^ (((self height) / (self scrollPane band height)) * (self scrollPane band brickBounds top abs)) floor.! !

!GLMScrollbarBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/8/2015 18:18'!
initialize
	super initialize.
	
	self
		useVerticalLinearLayout;
		bar: self newBar.! !

!GLMScrollbarBrick methodsFor: 'scrollbar-brick-accessing' stamp: 'AliakseiSyrel 1/26/2015 13:27'!
bar: aBrick

	bar := aBrick.
	self addBrickBack: aBrick! !

!GLMScrollbarBrick methodsFor: 'scrollbar-brick-accessing' stamp: 'AliakseiSyrel 1/26/2015 14:33'!
scrollPane

	^ scrollPane! !

!GLMScrollbarBrick methodsFor: 'scrollbar-brick-creation' stamp: 'AliakseiSyrel 11/19/2014 20:16'!
newBar

	^ GLMBrick new! !

!GLMScrollbarBrick methodsFor: 'scrollbar-calculations' stamp: 'AliakseiSyrel 3/27/2015 02:20'!
calculateScrollbarHeight

	^ (((self scrollPane height min: (self scrollPane layout maxHeight brickValue: self scrollPane)) / (self scrollPane band height)) * (self height min: (self scrollPane layout maxHeight brickValue: self scrollPane) )) ceiling.! !

!GLMScrollbarBrick methodsFor: 'scrollbar-brick-accessing' stamp: 'AliakseiSyrel 1/26/2015 14:33'!
scrollPane: anObject

	scrollPane := anObject.
	self updatePosition.! !

!GLMSegmentWithHelpAndMouseUpActionExample commentStamp: '<historical>'!
self new open!
!GLMSegmentWithHelpAndMouseUpActionExample methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 23:00'!
presentation
	^ GLMCompositePresentation new
		with: [ :a | 
			| t seg |
			t := a rubricText.
			seg := RubPlainSegmentMorph from: 400 to: 746.
			seg color: (Color green alpha: 0.3).
			seg setBalloonText: 'This sentence should be removed. Click on it to remove it'.
			seg
				on: #mouseDown
				send: #value
				to: [ 
					seg textArea selectFrom: seg firstIndex to: seg lastIndex.
					seg textArea replaceSelectionWith: ''.
					seg delete].
			t addTextSegment: seg ]! !

!GLMSelectCurrentLine commentStamp: 'AndreiChis 5/6/2014 17:51'!
I am event indicating to the renderer to select the entire line containing the cursor.!
!GLMSelectedTextChanged methodsFor: 'accessing' stamp: 'tg 4/15/2010 17:55'!
selectedText: anObject
	selectedText := anObject! !

!GLMSelectedTextChanged methodsFor: 'accessing' stamp: 'tg 4/15/2010 17:55'!
end: anObject
	end := anObject! !

!GLMSelectedTextChanged methodsFor: 'accessing' stamp: 'tg 4/15/2010 17:55'!
start
	^ start! !

!GLMSelectedTextChanged methodsFor: 'accessing' stamp: 'tg 4/15/2010 17:55'!
start: anObject
	start := anObject! !

!GLMSelectedTextChanged methodsFor: 'accessing' stamp: 'tg 4/15/2010 17:55'!
end
	^ end! !

!GLMSelectedTextChanged methodsFor: 'accessing' stamp: 'tg 4/15/2010 17:55'!
selectedText
	^ selectedText! !

!GLMSelectedTextChanged methodsFor: 'accessing' stamp: 'TudorGirba 7/14/2011 21:49'!
interval
	^ self start to: self end! !

!GLMSimplePort commentStamp: 'TudorGirba 2/4/2011 20:29'!
GLMSimplePort simply offers a hardcoded value. It is typically used in tests, but it can be useful in special cases when we need to simulate a Port.

Instance Variables:
	value	<ProtoObject | PseudoContext>!
!GLMSimplePort methodsFor: 'accessing' stamp: 'tg 12/18/2009 23:57'!
receive: aTransmission in: aContext
	self value: aTransmission value in: aContext! !

!GLMSimplePort methodsFor: 'accessing' stamp: 'TudorGirba 4/18/2011 19:43'!
silentValue: anObject
	value := anObject! !

!GLMSimplePort methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
value 
	 
	^value! !

!GLMSimplePort methodsFor: 'accessing' stamp: 'TudorGirba 4/18/2011 19:43'!
value: anObject in: aContext
	aContext addPort: self.
	self silentValue: anObject  ! !

!GLMSimpleRubricExample commentStamp: '<historical>'!
self new open!
!GLMSimpleRubricExample methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 20:52'!
presentation
	^ GLMCompositePresentation new
		with: [ :a | 
			| t seg |
			t := a rubricText.
			t withLineNumbers: true.
			t withAnnotation: true.
			t wrapped: true.
			t tabWidth: 40.
			t withColumns: true]! !

!GLMSingleSpotterRequest methodsFor: 'configuration' stamp: 'ML 2/26/2011 15:02'!
collection: aCollection caseSensitive: aBoolean
	"Configure this completion dialog with aCollection and match the elements case sensitive if aBoolean is true. Display the complete list if the filter is empty."

	self searchBlock: [ :value |
		value isEmpty
			ifTrue: [ aCollection ]
			ifFalse: [
				aCollection select: [ :each |
					self class
						substring: value
						matches: (self labelFor: each)
						caseSensitive: aBoolean ] ] ]! !

!GLMSingleSpotterRequest methodsFor: 'accessing' stamp: 'ML 2/26/2011 15:02'!
searchBlock
	^ searchBlock! !

!GLMSingleSpotterRequest methodsFor: 'accessing' stamp: 'ML 2/26/2011 15:02'!
prompt: aString
	"A string with the title for this request."
	
	prompt := aString! !

!GLMSingleSpotterRequest methodsFor: 'querying' stamp: 'ML 2/26/2011 15:02'!
valuesFor: anObject
	^ searchBlock value: anObject! !

!GLMSingleSpotterRequest methodsFor: 'accessing' stamp: 'ML 2/26/2011 15:02'!
assisted: aBoolean
	"A boolean indicating that the typing of the user is assisted but not constrained."
	
	assisted := aBoolean! !

!GLMSingleSpotterRequest methodsFor: 'configuration' stamp: 'ML 2/26/2011 15:02'!
collection: aCollection
	self collection: aCollection caseSensitive: false! !

!GLMSingleSpotterRequest methodsFor: 'accessing' stamp: 'ML 2/26/2011 15:02'!
default: aString
	"The default string initially used for filtering."
	
	default := aString! !

!GLMSingleSpotterRequest methodsFor: 'accessing' stamp: 'ML 2/26/2011 15:02'!
prompt
	^ prompt! !

!GLMSingleSpotterRequest methodsFor: 'initialization' stamp: 'ML 2/26/2011 15:02'!
initialize
	super initialize.
	prompt := 'Completion Request'.
	default := String new.
	assisted := false.
	searchBlock := [ :value | #() ].
	labelBlock := [ :value | value asString ].
	iconBlock := [ :value | nil ]! !

!GLMSingleSpotterRequest methodsFor: 'accessing' stamp: 'ML 2/26/2011 15:02'!
default
	^ default! !

!GLMSingleSpotterRequest methodsFor: 'initialize-release' stamp: 'TudorGirba 10/26/2011 16:01'!
defaultAction
	^(GLMMorphicSingleSpotter openOn: self) answer! !

!GLMSingleSpotterRequest methodsFor: 'querying' stamp: 'ML 2/26/2011 15:02'!
labelFor: anObject
	^ labelBlock value: anObject! !

!GLMSingleSpotterRequest methodsFor: 'dispatching' stamp: 'ML 2/26/2011 15:02'!
handleWith: anObject
	^ anObject handleCompletionRequest: self! !

!GLMSingleSpotterRequest methodsFor: 'accessing' stamp: 'ML 2/26/2011 15:02'!
iconBlock: aOneArgumentBlock
	"A one argument block answering the icon symbol for a given element."
	
	iconBlock := aOneArgumentBlock! !

!GLMSingleSpotterRequest methodsFor: 'accessing' stamp: 'ML 2/26/2011 15:02'!
iconBlock
	^ iconBlock! !

!GLMSingleSpotterRequest methodsFor: 'querying' stamp: 'ML 2/26/2011 15:02'!
iconFor: anObject
	^ iconBlock value: anObject! !

!GLMSingleSpotterRequest methodsFor: 'accessing' stamp: 'ML 2/26/2011 15:02'!
labelBlock
	^ labelBlock! !

!GLMSingleSpotterRequest methodsFor: 'accessing' stamp: 'ML 2/26/2011 15:02'!
labelBlock: aOneArgumentBlock
	"A one argument block answering the string for a given element."
	
	labelBlock := aOneArgumentBlock! !

!GLMSingleSpotterRequest methodsFor: 'accessing' stamp: 'ML 2/26/2011 15:02'!
assisted
	^ assisted! !

!GLMSingleSpotterRequest methodsFor: 'accessing' stamp: 'ML 2/26/2011 16:56'!
name
	^self prompt! !

!GLMSingleSpotterRequest methodsFor: 'accessing' stamp: 'ML 2/26/2011 15:02'!
searchBlock: aOneArgumentBlock
	"A one argument block returning the elements for the given filter."
	
	searchBlock := aOneArgumentBlock! !

!GLMSingleSpotterRequest class methodsFor: 'utilities' stamp: 'ML 2/26/2011 15:02'!
substring: testString matches: aString caseSensitive: aBoolean
	"Checks if a testString is a substring of aString. The matching parts do not necessarily need to be consecutive, for example 'egli' matches 'renggli'."

	| index |
	index := 0.
	testString do: [ :char |
		index := aString
			findString: (String with: char)
			startingAt: index + 1
			caseSensitive: aBoolean.
		index = 0
			ifTrue: [ ^ false ] ].
	^ true! !

!GLMSingleUpdateAction commentStamp: 'TudorGirba 1/7/2011 07:31'!
This class specifies that the updating announcement should come only from the single announcer object.!
!GLMSingleUpdateAction methodsFor: 'public' stamp: 'TudorGirba 7/1/2011 23:59'!
computeAnnouncerObjects 
	self flag: 'We catch the error because if there is a problem in the computation of the announcer object, we still want to be able to continue the execution'.
	^ OrderedCollection with: 
		([self transformation glamourValue: self presentation entity] 
			on: Error 
			do: [:e | self presentation entity. e resume])! !

!GLMSmalltalkCodeModel methodsFor: 'accessing' stamp: 'TudorGirba 9/20/2011 23:33'!
highlightSmalltalk: anObject
	highlightSmalltalk := anObject! !

!GLMSmalltalkCodeModel methodsFor: 'accessing' stamp: 'AndreiChis 8/13/2013 15:40'!
doItContext
	^ self glamourPresentation doItContext ! !

!GLMSmalltalkCodeModel methodsFor: 'accessing' stamp: 'TudorGirba 9/20/2011 23:33'!
hasBindingThatBeginsWith: aString
	^ self variableBindings keys anySatisfy: [:each | each beginsWith: aString]! !

!GLMSmalltalkCodeModel methodsFor: 'accessing' stamp: 'TudorGirba 9/20/2011 23:33'!
highlightSmalltalkContext
	^ highlightSmalltalkContext! !

!GLMSmalltalkCodeModel methodsFor: 'accessing' stamp: 'TudorGirba 9/20/2011 23:33'!
variableBindings
	^ variableBindings ifNil: [variableBindings := Dictionary new]! !

!GLMSmalltalkCodeModel methodsFor: 'accessing' stamp: 'TudorGirba 9/20/2011 23:33'!
hasBindingOf: aSymbol
	^ self variableBindings includesKey: aSymbol! !

!GLMSmalltalkCodeModel methodsFor: 'accessing' stamp: 'TudorGirba 9/20/2011 23:33'!
addVariableBinding: anAssociation
	self variableBindings at: anAssociation key put: anAssociation value! !

!GLMSmalltalkCodeModel methodsFor: 'accessing' stamp: 'AndreiChis 3/6/2014 12:17'!
bindingsStrategy

	^ bindingsStrategy ifNil: [ bindingsStrategy := self defaultBindingsStrategy ]! !

!GLMSmalltalkCodeModel methodsFor: 'completion' stamp: 'EstebanLorenzano 4/18/2012 09:57'!
isCodeCompletionAllowed 
	^true! !

!GLMSmalltalkCodeModel methodsFor: 'completion' stamp: 'TudorGirba 9/20/2011 23:33'!
guessTypeForName: aString 
	^ nil! !

!GLMSmalltalkCodeModel methodsFor: 'accessing' stamp: 'TudorGirba 9/20/2011 23:33'!
selectedClassOrMetaClass
	^ self highlightSmalltalkContext! !

!GLMSmalltalkCodeModel methodsFor: 'accessing' stamp: 'TudorGirba 9/20/2011 23:33'!
highlightSmalltalkContext: anObject
	highlightSmalltalkContext := anObject! !

!GLMSmalltalkCodeModel methodsFor: 'accessing' stamp: 'TudorGirba 9/20/2011 23:33'!
variableBindings: anObject
	variableBindings := anObject! !

!GLMSmalltalkCodeModel methodsFor: 'accessing' stamp: 'TudorGirba 9/20/2011 23:33'!
highlightSmalltalk
	^ highlightSmalltalk! !

!GLMSmalltalkCodeModel methodsFor: 'accessing' stamp: 'TudorGirba 9/20/2011 23:33'!
doItReceiver
	^ self glamourPresentation doItReceiver ! !

!GLMSmalltalkCodeModel methodsFor: 'accessing' stamp: 'VincentBlondeau 3/19/2014 11:54'!
bindingOf: aSymbol
	^ self bindingsStrategy cull: self variableBindings cull: aSymbol! !

!GLMSmalltalkCodeModel methodsFor: 'accessing' stamp: 'AndreiChis 3/6/2014 12:17'!
defaultBindingsStrategy

	^ [ :currentBindings :aSymbol |
		 currentBindings associationAt: aSymbol ifAbsent: [nil] ]! !

!GLMSmalltalkCodeModel methodsFor: 'accessing' stamp: 'AndreiChis 3/6/2014 12:16'!
bindingsStrategy: aBlock

	bindingsStrategy := aBlock! !

!GLMSmalltalkCodeModel methodsFor: 'accessing' stamp: 'TudorGirba 9/20/2011 23:33'!
shoutAboutToStyle: aPluggableShoutMorph
	self highlightSmalltalk ifFalse: [^ false].
	self highlightSmalltalkContext notNil ifTrue: [
		aPluggableShoutMorph classOrMetaClass: self highlightSmalltalkContext].
	^ true! !

!GLMSmalltalkCodeMorphicTest methodsFor: 'tests' stamp: ''!
testDefault
	| browser textMorph |
	browser := GLMTabulator new.
	browser column: #one.
	browser transmit to: #one; andShow: [ :a | a smalltalkCode display: '123456789'].
	window := browser openOn: 4.

	textMorph := window submorphs last submorphs first submorphs first.
	self assert: (textMorph isKindOf: GLMPluggableTextMorph)! !

!GLMSmalltalkCodeMorphicTest methodsFor: 'tests' stamp: 'AndreHora 5/9/2013 15:38'!
testExplicitAcceptDoesNotAffectTextPort
	| composite textMorph |
	composite := GLMCompositePresentation new with: [ :a | a smalltalkCode display: '123' ].
	window := composite openOn: 4.
	textMorph := self find: PluggableTextMorph in: window.
	textMorph simulateClick.
	self simulateKeyStrokes: '4'.
	self assert: (composite pane port: #text) value = '1234'.
	self simulateKeyStroke: $s command.
	self simulateKeyStrokes: '56'.
	self assert: (composite pane port: #text) value = '123456'! !

!GLMSmalltalkCodeMorphicTest methodsFor: 'tests' stamp: ''!
testForSmalltalkWorkspace
	| browser textMorph |
	browser := GLMTabulator new.
	browser column: #one.
	browser transmit to: #one; andShow: [ :a | a smalltalkCode variableBindings: [:x | {#theNumber -> x}]].
	window := browser openOn: 42.

	textMorph := self find: GLMPluggableTextMorph in: window.
	self assert: (textMorph model hasBindingOf: #theNumber)! !

!GLMSmalltalkCodePresentation commentStamp: 'AndreiChis 10/3/2014 18:37'!
A GLMSmalltalkCodePresentation can display Smalltalk code. It offers support for syntax highlighting and can also deal with undeclared bindings, if used as an workspace.

Instance Variables
	highlightSmalltalkContext:		<Object>
	isForScripting:		<Object>
	variableBindingsBlock:		<Object>

highlightSmalltalkContext
	- xxxxx

isForScripting
	- xxxxx

variableBindingsBlock
	- xxxxx
!
!GLMSmalltalkCodePresentation methodsFor: 'rendering' stamp: 'AndreiChis 5/6/2014 14:19'!
installDefaultSelectionActions

	self defaultSelectionActions do: [ :anAction |
		self addSelectionAction: anAction ]

	"self
		selectionAct: [ :aPresentation |
				aPresentation evaluateSelection ]
			on: $d
			entitled: 'Do it';
		selectionAct: [ :aPresentation |
				aPresentation evaluateSelectionAndDo: [ :result | result inspect ] ]
			on: $i
			entitled: 'Inspect it';
		selectionAct: [ :aPresentation |
				aPresentation debugSelection ]
			on: $D
			entitled: 'Debug it';
		selectionAct: [ :aPresentation |
				aPresentation profileSelection ]
			entitled: 'Profile it'"! !

!GLMSmalltalkCodePresentation methodsFor: 'accessing' stamp: ''!
highlightSmalltalkContext
	^ highlightSmalltalkContext isNil 
		ifTrue: [nil] 
		ifFalse: [highlightSmalltalkContext glamourValue: self entity]! !

!GLMSmalltalkCodePresentation methodsFor: 'accessing' stamp: 'AndreiChis 5/3/2014 18:39'!
variableBindings
	^ (variableBindingsBlock glamourValue: self entity) ifNil: [OrderedCollection new]! !

!GLMSmalltalkCodePresentation methodsFor: 'actions' stamp: 'AndreiChis 5/6/2014 11:16'!
evaluateSelection

	self evaluateSelectionAndDo: [ :result | result ]! !

!GLMSmalltalkCodePresentation methodsFor: 'actions' stamp: 'AndreiChis 5/6/2014 11:18'!
debugSelection

	self announce: GLMDebugSelection! !

!GLMSmalltalkCodePresentation methodsFor: 'accessing' stamp: 'AndreiChis 5/6/2014 12:12'!
isForScripting

	^ isForScripting ifNil: [ false ]! !

!GLMSmalltalkCodePresentation methodsFor: 'actions' stamp: 'AndreiChis 7/7/2014 10:04'!
compileTextIn: aContext from:  aSession andDo: aBlock

	self announce: (GLMCompileText new
		presentation: self;
		context: aContext;
		session: aSession;
		action: aBlock)! !

!GLMSmalltalkCodePresentation methodsFor: 'accessing' stamp: 'AndreiChis 5/3/2014 18:42'!
updateVariableBindings

	self announce: (GLMVariableBindingsChanged new presentation: self).! !

!GLMSmalltalkCodePresentation methodsFor: 'actions' stamp: 'AndreiChis 5/6/2014 12:11'!
beForScripting

	isForScripting := true! !

!GLMSmalltalkCodePresentation methodsFor: 'actions' stamp: 'AndreiChis 5/7/2014 10:57'!
printSelection

	self announce: GLMPrintSelection! !

!GLMSmalltalkCodePresentation methodsFor: 'rendering' stamp: ''!
renderGlamorouslyOn: aRenderer 
	self registerAnnouncements.
	^ aRenderer renderSmalltalkCodePresentation: self! !

!GLMSmalltalkCodePresentation methodsFor: 'actions' stamp: 'AndreiChis 5/6/2014 11:26'!
profileSelection

	self announce: GLMProfileSelection! !

!GLMSmalltalkCodePresentation methodsFor: 'accessing' stamp: ''!
smalltalkClass: aBlock
	"aBlock takes as parameters the entity objects and 
	its evaluation is expected to produce a Smalltalk class"
	highlightSmalltalkContext := aBlock.! !

!GLMSmalltalkCodePresentation methodsFor: 'accessing' stamp: 'AndreiChis 5/3/2014 18:39'!
variableBindings: aBlock
	^ variableBindingsBlock := aBlock! !

!GLMSmalltalkCodePresentation methodsFor: 'rendering' stamp: 'AndreiChis 5/7/2014 11:41'!
defaultSelectionActions

	^ { 
		(GLMGenericAction new) 
				title: 'Print it';
				action: [ :aPresentation |
					aPresentation printSelection ]; 
				shortcut: $p; 
				yourself.
		(GLMGenericAction new) 
				title: 'Do it';
				action: [ :aPresentation |
					aPresentation evaluateSelection ]; 
				shortcut: $d; 
				icon: GLMUIThemeExtraIcons glamorousSpawn;
				yourself.
		(GLMGenericAction new) 
				title: 'Inspect it'; 
				action: [ :aPresentation |
					aPresentation evaluateSelectionAndDo: [ :result | result inspect ] ]; 
				shortcut: $i; 
				icon: GLMUIThemeExtraIcons glamorousInspect;
				yourself.
		(GLMGenericAction new) 
				title: 'Debug it'; 
				action: [ :aPresentation |
					aPresentation debugSelection ]; 
				"shortcut: $D; "
				yourself.
		(GLMGenericAction new) 
				title: 'Profile it'; 
				action: [ :aPresentation |
					aPresentation profileSelection ]; 
				yourself
		 }! !

!GLMSmalltalkCodePresentation methodsFor: 'actions' stamp: 'AndreiChis 5/6/2014 11:16'!
evaluateSelectionAndDo: aBlock

	self announce: (GLMEvaluateSelection new action: aBlock)! !

!GLMSmalltalkEditor commentStamp: 'TudorGirba 7/14/2011 22:07'!
GLMSmalltalkEditor is a helper class for Glamour. The only goal for this class is to provide the hook needed to let the morph know when the selection has changed.!
!GLMSmalltalkEditor methodsFor: 'new selection' stamp: 'TudorGirba 7/14/2011 22:40'!
storeSelectionInParagraph
	super storeSelectionInParagraph.
	self morph ifNotNil: [
		self morph editView 
			announceSelection: self selection
			from: self startIndex 
			to: self stopIndex - 1 ]! !

!GLMSmalltalkEditor class methodsFor: 'class initialization' stamp: 'TudorGirba 7/28/2011 23:35'!
initialize
	"Initialize the keyboard shortcut maps and the shared buffers
	for copying text across views and managing again and undo." 
	super initialize! !

!GLMSomeNotNilCondition commentStamp: 'AndreiChis 3/11/2015 23:59'!
Used to test if at least a defined  arguments of a condition is not nil.
!
!GLMSomeNotNilCondition methodsFor: 'glamour' stamp: 'tg 12/31/2009 00:22'!
glamourValueWithArgs: anArray 
	 
	^anArray anySatisfy: [:each | each notNil]! !

!GLMSpawnBrowserAction methodsFor: '*glamour-morphic-renderer' stamp: 'cyrilledelaunay 8/9/2011 13:57'!
morphicActOn: aPresentation

	^ (self actOn: aPresentation) open! !

!GLMSpecPresentation commentStamp: 'AndreiChis 10/3/2014 18:25'!
This presentation offers a means to embed a Spec user interface within Glamour. !
!GLMSpecPresentation methodsFor: 'as yet unclassified' stamp: 'TudorGirba 4/3/2013 16:48'!
renderGlamorouslyOn: aRenderer 
	self registerAnnouncements.
	^ aRenderer renderSpecPresentation: self! !

!GLMSpotterRequest methodsFor: 'initialize-release' stamp: 'ML 2/26/2011 16:08'!
initialize
	super initialize.
	requests := OrderedCollection new.! !

!GLMSpotterRequest methodsFor: 'accessing' stamp: 'ML 2/26/2011 16:20'!
default
	^ default! !

!GLMSpotterRequest methodsFor: 'initialize-release' stamp: 'TudorGirba 2/27/2011 15:25'!
defaultAction
	^(GLMMorphicSpotter openOn: self) answer! !

!GLMSpotterRequest methodsFor: 'initialize-release' stamp: 'ML 2/26/2011 16:07'!
add: aRequest
	requests add: aRequest ! !

!GLMSpotterRequest methodsFor: 'accessing' stamp: 'ML 2/26/2011 16:19'!
prompt: anObject
	prompt := anObject! !

!GLMSpotterRequest methodsFor: 'initialize-release' stamp: 'ML 2/26/2011 16:10'!
handleWith: anObject
	^ anObject handleCompletionRequest: self! !

!GLMSpotterRequest methodsFor: 'accessing' stamp: 'ML 2/26/2011 16:29'!
requests
	^requests ! !

!GLMSpotterRequest methodsFor: 'accessing' stamp: 'ML 2/26/2011 16:20'!
default: anObject
	default := anObject! !

!GLMSpotterRequest methodsFor: 'accessing' stamp: 'ML 2/26/2011 16:19'!
prompt
	^ prompt! !

!GLMStackedScrollPaneBrick commentStamp: 'AliakseiSyrel 11/27/2014 23:31'!
A GLMStackedScrollPaneBrick is a more complicated scrollpane, with scrollbars and stacking mechanism of subbricks that have #stack floating parameter
!
!GLMStackedScrollPaneBrick methodsFor: 'scrolling' stamp: 'AliakseiSyrel 2/3/2015 21:39'!
update
	super update.
	
	"we need to update band's layout to support stacking"
	"self allowedBounds: self band layoutChildren."! !

!GLMStackedScrollPaneBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/30/2014 20:47'!
allowedBounds: aRectangle

	allowedBounds := aRectangle! !

!GLMStackedScrollPaneBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/8/2015 17:43'!
initialize
	super initialize.
	
	self band useVerticalLinearLayout! !

!GLMStackedScrollPaneBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/30/2014 20:47'!
allowedBounds

	^ allowedBounds ifNil: [ allowedBounds := self globalBounds ]! !

!GLMStackedScrollPaneBrick methodsFor: 'scrolling' stamp: 'AliakseiSyrel 1/24/2015 18:02'!
invalidate

	! !

!GLMStackedScrollPaneBrick class methodsFor: 'examples' stamp: 'AliakseiSyrel 2/3/2015 23:30'!
example

	super example! !

!GLMStackedVerticallyArrangement methodsFor: 'rendering' stamp: 'tg 1/7/2010 09:38'!
renderGlamorouslyOn: aRenderer
	^ aRenderer renderStackedVerticallyCompositePresentation: self composite! !

!GLMStacker commentStamp: '<historical>'!
A GLMStacker is an explicit browser that allows us to stack panes on top of each other and typically show them as tabs.!
!GLMStacker methodsFor: 'scripting' stamp: 'tg 6/12/2010 14:21'!
aPane: aBlockOrSymbol
	^ self addNewPaneNamed: aBlockOrSymbol! !

!GLMStacker methodsFor: 'scripting' stamp: 'DamienCassou 7/25/2011 08:48'!
panes: blocksOrSymbols
	^ blocksOrSymbols do: [:each | self aPane: each]! !

!GLMStacker methodsFor: 'rendering' stamp: 'tg 6/12/2010 14:18'!
renderGlamorouslyOn: aRenderer 
	^aRenderer renderStacker: self! !

!GLMStringBrick commentStamp: 'AliakseiSyrel 10/17/2014 10:06'!
A GLMStringBrick is low level String Brick. Text can't be drawn outside of Brick's bounds, which makes it very usefull for smart text shrinking.

Instance Variables
	familyName:		<Object>
	font:		<Object>
	fontSize:		<Object>
	text:		<Object>
	textColor:		<Object>
	textPosition:		<Object>
	textSize:		<Object>

familyName
	- xxxxx

font
	- xxxxx

fontSize
	- xxxxx

text
	- xxxxx

textColor
	- xxxxx

textPosition
	- xxxxx

textSize
	- xxxxx
!
!GLMStringBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/30/2015 12:34'!
textColor

	^ self valueOfProperty: #brickTextColor ifAbsent: [ self themer textColor ]! !

!GLMStringBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 2/26/2015 00:21'!
hShrinkWrap
	
	self hResizing: #rigid.
	self width: #approximateWidth! !

!GLMStringBrick methodsFor: 'geometry' stamp: 'AliakseiSyrel 3/21/2015 17:30'!
textPositionVerticalCenter

		^ (0@(self brickBounds height / 2.0)) - (0@(self font height/2.0)) truncated
	! !

!GLMStringBrick methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 2/26/2015 00:21'!
vShrinkWrap
	
	self vResizing: #rigid.
	self height: #approximateHeight! !

!GLMStringBrick methodsFor: 'testing' stamp: 'AliakseiSyrel 3/21/2015 02:03'!
isFitsInParent

	^ self owner
		ifNil: [ self brickBounds containsRect: (self outerBounds origin extent: self textSize) ]
		ifNotNil: [ self owner brickBounds width >= self textSize x ]! !

!GLMStringBrick methodsFor: 'private' stamp: 'AliakseiSyrel 2/18/2015 14:43'!
updateFont
	font := LogicalFont familyName: self familyName pointSize: self fontSize! !

!GLMStringBrick methodsFor: 'public' stamp: 'AliakseiSyrel 1/12/2015 17:17'!
sizeOf: aString

	^ (self font widthOfString: aString) @ self font height! !

!GLMStringBrick methodsFor: 'geometry' stamp: 'AliakseiSyrel 1/12/2015 17:18'!
textPositionHorizontalCenter

	^ (((self brickBounds width - self textSize x) max: 0) /2)@0! !

!GLMStringBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/4/2014 05:13'!
textSize

	^ textSize ifNil: [ textSize := self sizeOf: self text ]! !

!GLMStringBrick methodsFor: 'private' stamp: 'AliakseiSyrel 2/18/2015 15:09'!
customFont

	font := LogicalFont new
				familyName: self familyName; 
				fallbackFamilyNames: nil;
				pointSize: self fontSize; 
				weightValue: 400;
				stretchValue: 5;
				slantValue: 0;
				yourself! !

!GLMStringBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/18/2015 15:00'!
beBold

	self font forceBold! !

!GLMStringBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/4/2014 05:12'!
text

	^ text! !

!GLMStringBrick methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/30/2015 12:33'!
textColor: aColor

	self setProperty: #brickTextColor toValue: aColor.
	self updateFont.! !

!GLMStringBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/18/2014 16:34'!
font: aFont

	font := aFont.
	
	aFont ifNil: [ self updateFont ].
	
	familyName := font familyName.
	fontSize := font pointSize.! !

!GLMStringBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 3/17/2015 22:51'!
initialize
	super initialize.
	
	fontSize := self themer textFontSize.
	familyName := self themer textFamilyName.
	text := ''.
	
	textPosition := #leftCenter.
	
	self
		hShrinkWrap;
		vShrinkWrap.
	self updateFont.
	! !

!GLMStringBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 12/4/2014 10:34'!
highlightedText
	
	^ highlightedString ifNil: [ highlightedString := '' ]! !

!GLMStringBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/18/2015 15:00'!
beRegular

	self font
		forceNotBold;
		forceNotItalic! !

!GLMStringBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/25/2015 22:48'!
highlightingLogic
	"[ :aCanvas :aRectangle ]"
	
	^ self valueOfProperty: #brickHighlightingLogic ifAbsentPut: [
		[ :aCanvas :aRectangle | |rectangle|
			"because font calculates text width wrong"
			rectangle := aRectangle translateBy: ((3@1) negated + self brickBounds origin).
			aCanvas line: rectangle bottomLeft to: rectangle bottomRight width: 1 color: self textColor ] ] ! !

!GLMStringBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/4/2014 05:04'!
fontSize
	^ fontSize! !

!GLMStringBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/4/2014 05:05'!
fontSize: aNumber
	fontSize := aNumber.
	self updateFont.! !

!GLMStringBrick methodsFor: 'public' stamp: 'AliakseiSyrel 2/25/2015 22:34'!
highlight: aString

	highlightedString := aString.
	self changed! !

!GLMStringBrick methodsFor: 'geometry' stamp: 'AliakseiSyrel 2/3/2015 11:20'!
approximateWidth

	^ self textSize x + self hMargin + self hPadding! !

!GLMStringBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/16/2014 15:14'!
familyName
	^ familyName! !

!GLMStringBrick methodsFor: 'drawing' stamp: 'AliakseiSyrel 2/25/2015 22:46'!
onDraw: aCanvas

	super onDraw: aCanvas.
	
	self highlightedText isEmpty ifFalse: [
		self calculateHighlightingBounds do: [ :each |
			self highlightingLogic
				ifNil: [ aCanvas line: each bottomLeft to: each bottomRight width: 1 color: self textColor ]
				ifNotNil: [ self highlightingLogic cull: aCanvas cull: each ] ] ].
	
	aCanvas
		drawString: self text
		at: self calculateTextPosition
		font: self font
		color: self textColor! !

!GLMStringBrick methodsFor: 'drawing' stamp: 'AliakseiSyrel 3/31/2015 16:33'!
onDrawAthensCanvas: aCanvas
	|wrappedCanvas|
	
	super onDrawAthensCanvas: aCanvas.
	wrappedCanvas := AthensCanvasWrapper on: aCanvas.
	
	self highlightedText isEmpty ifFalse: [
		self calculateHighlightingBounds do: [ :each |
			self highlightingLogic
				ifNil: [ wrappedCanvas line: each bottomLeft to: each bottomRight width: 1 color: self textColor ]
				ifNotNil: [ self highlightingLogic cull: wrappedCanvas cull: each ] ] ].
		
	aCanvas pathTransform restoreAfter:[ 
			aCanvas pathTransform translateBy: (self calculateTextPosition - self brickBounds origin).
			aCanvas pathTransform translateX: 0 Y: font getPreciseAscent.
			self flag: #todo.	"scaled, so that FT-Plugin and Athens don't mix cached faces"
			aCanvas pathTransform scaleBy: 1.0000001 @ 1.0000001.
			aCanvas setPaint: self textColor.
			aCanvas setFont: self font.
			aCanvas drawString: self text from: 1 to: self text size ].
		
	wrappedCanvas
		drawString: self text
		at: (self calculateTextPosition - self brickBounds origin)
		font: self font
		color: self textColor! !

!GLMStringBrick methodsFor: 'private' stamp: 'AliakseiSyrel 1/22/2015 22:17'!
privateSetText: aString

	text := aString asString.
	textSize := nil.! !

!GLMStringBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/26/2015 00:41'!
text: aString

	self privateSetText: aString.
	self wrappedBounds markWidthDirty.! !

!GLMStringBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/21/2015 18:25'!
calculateTextPosition

	self textPosition = #leftCenter ifTrue: [ 
		^ (self brickBounds origin + self textPositionVerticalCenter) truncated
	].

	self textPosition = #center ifTrue: [ 
		^ (self brickBounds origin + self textPositionVerticalCenter + self textPositionHorizontalCenter)floor
	].

	self textPosition = #leftTop ifTrue: [
		^ self brickBounds origin
	].

	self textPosition = #rightCenter ifTrue: [
		^ ((self brickBounds topRight + self textPositionVerticalCenter - (self textSize x@0)) max: self brickBounds origin) floor
	].

	^ self brickBounds origin! !

!GLMStringBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/4/2014 05:04'!
familyName: aString
	familyName := aString.
	self updateFont.! !

!GLMStringBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/11/2014 01:13'!
textPosition

	^ textPosition! !

!GLMStringBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/12/2015 17:21'!
calculateHighlightingBounds
	|textBounds highlightBounds last|
	
	highlightBounds := OrderedCollection new.
	
	textBounds := (self calculateTextPosition extent: self textSize) translateBy: (0@0)negated.
	
	last := self text asLowercase findString: self highlightedText asLowercase startingAt: 1.
	last = 0 ifTrue: [^ highlightBounds].
	[last > 0] whileTrue: [ |beforeHighlightTextSize highlightSize matchingString|		
		matchingString := self text copyFrom: last to: last + self highlightedText size - 1.
		highlightSize := self sizeOf: matchingString.
		beforeHighlightTextSize := self sizeOf: (self text first: (last - 1)).
		highlightBounds add: ((textBounds translateBy: ((beforeHighlightTextSize x)@0)) withWidth: highlightSize x).
		last := self text asLowercase findString: self highlightedText asLowercase startingAt: last + 1 ].
	
	^ highlightBounds! !

!GLMStringBrick methodsFor: 'geometry' stamp: 'AliakseiSyrel 2/11/2015 12:33'!
approximateHeight

	^ self font height + self vMargin + self vPadding! !

!GLMStringBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 12/4/2014 11:17'!
highlightingLogic: aBlockWithTwoParameters
	"[ :aCanvas :aRectangle ]"
	
	self setProperty: #brickHighlightingLogic toValue: aBlockWithTwoParameters! !

!GLMStringBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/18/2014 13:19'!
textPosition: aSymbol
	"supported:
	#leftCenter
	#center
	#leftTop
	"
	textPosition := aSymbol.! !

!GLMStringBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/4/2014 05:06'!
font

	^ font! !

!GLMStringBrick class methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 3/3/2015 15:40'!
example

	| brick brick1 brick2 brick3|
	brick := GLMBrick new
		color: Color blue;
		width: 400;
		height: 300.
		
	brick1 := self new
		color: Color red;
		hSpaceFill: 75;
		vSpaceFill: 25;
		textPosition: #center;
		text: 'Brick 1'.
	
	brick2 := self new
		color: Color green;
		hSpaceFill: 25;
		vSpaceFill: 75;
		textPosition: #center;
		text: 'Brick 2'.
	
	brick3 := self new
		color: Color yellow;
		width: 50;
		height: 50;
		textPosition: #center;
		text: 'Brick 3'.
	
	brick
		addBrickBack: brick1;
		addBrickBack: brick2;
		addBrickBack: brick3.
		
	brick asBrickedMorph
		color: Color white;
		openInWindow! !

!GLMSystemWindow commentStamp: 'TudorGirba 1/27/2011 22:09'!
This is the window in which the Glamour browsers are rendered in Morphic.!
!GLMSystemWindow methodsFor: 'initialization' stamp: 'TudorGirba 5/28/2012 00:27'!
initialize 
	super initialize.
	self
		on: #keyStroke 
		send: #handleKeyStroke: 
		to: self	! !

!GLMSystemWindow methodsFor: 'building' stamp: 'TudorGirba 1/27/2011 23:35'!
extent: aPoint 
	super extent: aPoint.
	self fullBounds! !

!GLMSystemWindow methodsFor: 'announcement' stamp: 'TudorGirba 2/3/2011 09:06'!
allKeystrokeActions
	^ self model notNil 
		ifTrue: [
			(self model allActions, self model allSelectionActions) select: [ :action | 
				action hasShortcut ]]
		ifFalse: [#()]! !

!GLMSystemWindow methodsFor: 'open/close' stamp: 'TudorGirba 2/3/2011 09:06'!
delete
	self model notNil ifTrue: [self model unregisterFromAllAnnouncements].
	super delete! !

!GLMSystemWindow methodsFor: 'accessing' stamp: 'TudorGirba 1/27/2011 23:02'!
toolbarBox: anObject
	toolbarBox := anObject.
	self replacePane: menuBox with: toolbarBox! !

!GLMSystemWindow methodsFor: 'announcement' stamp: 'TudorGirba 1/31/2011 23:08'!
when: anAnnouncement do: aBlock 
	^ self announcer when: anAnnouncement do: aBlock! !

!GLMSystemWindow methodsFor: '*GT-Playground' stamp: 'AndreiChis 9/8/2014 22:55'!
acceptContents: aString 
	"Be compatible with edit:label:accept:.
	Not the best place for this method.
	Interim situation to move things forward..."
	self flag: #TODO.
	self model ifNotNil: [:aModel | aModel acceptContents: aString].

	! !

!GLMSystemWindow methodsFor: '*GT-Playground' stamp: 'AndreiChis 9/8/2014 22:56'!
acceptAction: anAction 
	"Be compatible with edit:label:accept:.
	Not the best place for this method.
	Interim situation to move things forward..."
	self flag: #TODO.
	self model ifNotNil: [:aModel | aModel acceptAction: anAction].! !

!GLMSystemWindow methodsFor: 'event handling' stamp: 'TudorGirba 1/31/2011 23:16'!
handleKeyStroke: anEvent
	| action |
	action := self allKeystrokeActions detect: [:a | 
		anEvent commandKeyPressed and: [ 
			a shortcut = anEvent keyCharacter ]] ifNone: [nil].
	action ifNotNil: [ self announcer announce: (GLMKeyStroke action: action) ]! !

!GLMSystemWindow class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:02'!
gtExampleEmptyBrowser
	<gtExample>
	^ self new model: GLMBrowser new! !

!GLMTabLabelBrick commentStamp: 'AliakseiSyrel 10/17/2014 10:06'!
A GLMTabLabelTurboBrick is  single resizable Tab Label used in LazyTabGroupMorph.

Instance Variables
	normalLabel:		<Object>
	selectedLabel:		<Object>
	tabSelector:		<Object>

normalLabel
	- xxxxx

selectedLabel
	- xxxxx

tabSelector
	- xxxxx
!
!GLMTabLabelBrick methodsFor: 'brick-tab-label-accessing' stamp: 'AliakseiSyrel 3/18/2015 19:46'!
selected: aBoolean
	"Use the appropriate label."

	self isSelected
		ifTrue: [ self beSelected ]
		ifFalse: [ self beNormal ]! !

!GLMTabLabelBrick methodsFor: 'brick-tab-label-testing' stamp: 'AliakseiSyrel 3/18/2015 19:50'!
isSelected
	"Answer whether the tab is selected."

	^ self tabSelector
		ifNil: [ false ]
		ifNotNil: [ :selector | selector selectedTab == self]! !

!GLMTabLabelBrick methodsFor: 'brick-tab-label-accessing' stamp: 'AliakseiSyrel 10/16/2014 09:24'!
selectedLabel

	^ selectedLabel! !

!GLMTabLabelBrick methodsFor: 'brick-tab-label-actions' stamp: 'AliakseiSyrel 3/18/2015 19:56'!
beSelected

	self removeAllBricks.
	self addBrickBack: self selectedLabel.
	self themer tabLabelThemer selectedStyleFor: self.
	self changed! !

!GLMTabLabelBrick methodsFor: 'brick-tab-label-accessing' stamp: 'AliakseiSyrel 10/16/2014 09:24'!
tabSelector: anObject

	tabSelector := anObject! !

!GLMTabLabelBrick methodsFor: 'brick-tab-label-actions' stamp: 'AliakseiSyrel 3/18/2015 19:56'!
beNormal

	self removeAllBricks.
	self addBrickBack: self normalLabel.
	self themer tabLabelThemer normalStyleFor: self.
	self changed! !

!GLMTabLabelBrick methodsFor: 'brick-tab-label-accessing' stamp: 'AliakseiSyrel 10/16/2014 09:24'!
tabSelector

	^ tabSelector! !

!GLMTabLabelBrick methodsFor: 'brick-tab-label-accessing' stamp: 'AliakseiSyrel 10/16/2014 09:24'!
normalLabel

	^ normalLabel! !

!GLMTabLabelBrick methodsFor: 'brick-interactable-actions' stamp: 'AliakseiSyrel 3/19/2015 10:33'!
deselect
	self owner ifNil: [ ^ self ].
	self layoutProperties minWidth: 0.
	self owner doLayoutForce! !

!GLMTabLabelBrick methodsFor: 'brick-tab-label-accessing' stamp: 'AliakseiSyrel 3/27/2015 13:50'!
font: aFont! !

!GLMTabLabelBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 3/18/2015 19:48'!
initialize
	super initialize.
	
	self enable! !

!GLMTabLabelBrick methodsFor: 'brick-tab-label-accessing' stamp: 'AliakseiSyrel 10/16/2014 09:24'!
selectedLabel: anObject

	selectedLabel := anObject! !

!GLMTabLabelBrick methodsFor: 'brick-tab-label-accessing' stamp: 'AliakseiSyrel 3/18/2015 19:52'!
label
	"Answer the label contents."

	^ self isSelected
		ifTrue: [self selectedLabel userString ifNil: [ self firstSubmorph ] ]
		ifFalse: [self normalLabel userString ifNil: [ self firstSubmorph ] ]! !

!GLMTabLabelBrick methodsFor: 'brick-tab-label-accessing' stamp: 'AliakseiSyrel 3/23/2015 22:45'!
label: aBrick selected: aSelectedBrick
	"Change the label contents"

	aBrick vSpaceFill.
	aSelectedBrick vSpaceFill.
	
	self maxWidth: aBrick layout maxWidth.
	
	self
		normalLabel: aBrick;
		selectedLabel: aSelectedBrick;
		selected: self isSelected.
	"in case label was changed"
	self doLayoutForce! !

!GLMTabLabelBrick methodsFor: 'brick-interactable-actions' stamp: 'AliakseiSyrel 3/19/2015 10:33'!
select
	self owner ifNil: [ ^ self ].
	self minWidth: [ (self label layout maxWidth brickValue: self label) min: self owner width ].
	self owner doLayoutForce! !

!GLMTabLabelBrick methodsFor: 'brick-tab-label-accessing' stamp: 'AliakseiSyrel 3/19/2015 10:13'!
label: aBrick
	"Change the label contents"
	
	self label: aBrick selected: aBrick! !

!GLMTabLabelBrick methodsFor: 'brick-tab-label-accessing' stamp: 'AliakseiSyrel 10/16/2014 09:24'!
normalLabel: anObject

	normalLabel := anObject! !

!GLMTabPanelBorder commentStamp: '<historical>'!
Specialized border for TabGroup. Does not draw border beneath the selectd tab and only draws on top.!
!GLMTabPanelBorder methodsFor: 'drawing' stamp: 'TudorGirba 4/16/2014 20:49'!
frameRectangle: aRectangle on: aCanvas
	"Draw the border taking the currently selected tab into account.
	Only works for top-positioned tabs for the moment."
	
	|w h r tab|
	w := self width.
	w isPoint ifTrue: [h := w y. w := w x] ifFalse:[h := w].
	tab := self selectedTab.
	tab ifNil: [	
		"r := aRectangle topLeft + (w@0) corner: aRectangle topRight - (w@h negated).
		aCanvas fillRectangle: r color: self color."
		^self]. "top"
	r := aRectangle topLeft corner: tab bounds left @(aRectangle top + h).
	aCanvas fillRectangle: r color: self color. 
	r :=  tab bounds right @ aRectangle top corner: aRectangle topRight - (w@h negated).
	aCanvas fillRectangle: r color: self color.
	
	r := aRectangle topLeft corner: aRectangle left + w @ (aRectangle bottom).
	aCanvas fillRectangle: r color: tab paneColor.
	r := aRectangle topRight corner: aRectangle right + w @ (aRectangle bottom).
	aCanvas fillRectangle: r color: tab paneColor.! !

!GLMTabSelectorBrick commentStamp: 'AliakseiSyrel 10/17/2014 10:33'!
A GLMTabSelectorBrick is a simplified TabSelectorMorph with support of smart tab resizing.
New implementation doesn't have any scrollbars or scroll arrows.

Instance Variables
	controls:		<Object>
	font:		<Object>
	selectedIndex:		<Object>
	tabs:		<Object>
	visibleTabRange:		<Object>
	wrapScrolling:		<Object>

controls
	- xxxxx

font
	- xxxxx

selectedIndex
	- xxxxx

tabs
	- xxxxx

visibleTabRange
	- xxxxx

wrapScrolling
	- xxxxx
!
!GLMTabSelectorBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/24/2015 13:40'!
selectedIndex
	"Answer the value of selectedIndex"

	^ selectedIndex ifNil: [ selectedIndex := 0 ]! !

!GLMTabSelectorBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 3/24/2015 11:38'!
handlesKeyboard: evt
	"Yes, we do it here."
	
	^ true! !

!GLMTabSelectorBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 3/24/2015 13:51'!
keyStroke: event 
	"Process keys navigation and space to toggle."

	(self navigationKey: event) ifTrue: [ ^ self ].
	event keyCharacter = Character arrowLeft
		ifTrue: [ self selectPreviousTab ].
	event keyCharacter = Character arrowRight
		ifTrue: [ self selectNextTab ]! !

!GLMTabSelectorBrick methodsFor: 'adding/removing' stamp: 'AliakseiSyrel 10/16/2014 09:20'!
removeTabIndex: anInteger
	"Remove the tab at the given index and
	adjust any selected (next or first if was last)."
	
	self tabs removeAt: anInteger.
	self selectedIndex: 0.
	self tabs ifNotEmpty: [
		self selectedIndex: self selectedIndex - 1 \\ self tabs size + 1]
		! !

!GLMTabSelectorBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/24/2015 13:51'!
selectedTab
	"Answer the selected tab."
	
	^ self selectedIndex = 0
		ifFalse: [self tabs at: self selectedIndex ifAbsent: [ nil ] ]! !

!GLMTabSelectorBrick methodsFor: 'adding/removing' stamp: 'AliakseiSyrel 3/24/2015 13:47'!
addTab: aStringOrMorph selected: selectedStringOrMorph
	"Add a new tab with the given text or morph and alternate for when selected."
	
	self tabs add: (self newLabelBrick: aStringOrMorph selected: selectedStringOrMorph).
	self updateTabs! !

!GLMTabSelectorBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 3/24/2015 13:52'!
newLabelBrick: aStringOrBrick selected: selectedStringOrBrick
	"Answer a new label brick with the given label text or brick and
	alternate when selected."
	^ GLMTabLabelBrick new
		label: aStringOrBrick selected: selectedStringOrBrick;
		when: #onClicked send: #onTabClicked:with: to: self;
		tabSelector: self;
		vSpaceFill! !

!GLMTabSelectorBrick methodsFor: 'actions' stamp: 'AliakseiSyrel 10/16/2014 09:20'!
selectPreviousTab
	"Select the previous tab, or the last if none selected."
	
	self selectedIndex: (self selectedIndex < 2
		ifTrue: [self tabs size]
		ifFalse: [self selectedIndex - 1])! !

!GLMTabSelectorBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/24/2015 13:28'!
font: aFont
	"Set the label font"
	font := aFont! !

!GLMTabSelectorBrick methodsFor: 'actions' stamp: 'AliakseiSyrel 3/24/2015 13:34'!
updateTabs
	"Update the submorphs based on visible tabs."

	|selectedTab|
	self removeAllBricks.
	self tabs ifEmpty: [ ^ self ].
	selectedTab := self selectedTab.
	self tabs do: [:t |
		t selected: (t == selectedTab).
		t hSpaceFill: 100 / self tabs size ].
	self
		addAllBricks: self tabs! !

!GLMTabSelectorBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/16/2014 09:20'!
tabs: anObject

	tabs := anObject! !

!GLMTabSelectorBrick methodsFor: 'adding/removing' stamp: 'AliakseiSyrel 3/24/2015 13:47'!
addTab: aStringOrMorph
	"Add a new tab with the given text."
	
	self tabs add: (self newLabelBrick: aStringOrMorph).
	self updateTabs! !

!GLMTabSelectorBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/24/2015 13:31'!
tabs

	^ tabs ifNil: [ tabs := OrderedCollection new ]! !

!GLMTabSelectorBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 3/24/2015 13:49'!
newLabelBrick: aStringOrBrick
	"Answer a new label brick with the given label text."

	^ GLMTabLabelBrick new
		label: aStringOrBrick;
		when: #onClicked send: #onTabClicked:with: to: self;
		tabSelector: self;
		vSpaceFill! !

!GLMTabSelectorBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 10/16/2014 09:20'!
keyboardFocusChange: aBoolean
	"The message is sent to a morph when its keyboard focus changes.
	Update for focus feedback."
	super keyboardFocusChange: aBoolean.
	self focusChanged! !

!GLMTabSelectorBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/24/2015 13:30'!
selectedIndex: index
	"Set the value of selectedIndex"

	|oldIndex|
	self selectedIndex == index ifTrue: [^ self ].
	oldIndex := self selectedIndex.
	selectedIndex := (index min: self tabs size).
	self updateTabs.
	self changed: #selectedIndex with: oldIndex! !

!GLMTabSelectorBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/24/2015 13:31'!
font
	"Answer the label font"
	^ font! !

!GLMTabSelectorBrick methodsFor: 'actions' stamp: 'AliakseiSyrel 3/24/2015 13:52'!
relabelTab: aTab with: aStringOrBrick
	"Relabel the tab update tab layout."

	aTab label: aStringOrBrick.
	self updateTabs! !

!GLMTabSelectorBrick methodsFor: 'actions' stamp: 'AliakseiSyrel 10/16/2014 09:20'!
selectNextTab
	"Select the next tab, or the first if none selected."
	
	self selectedIndex: self selectedIndex \\ self tabs size + 1! !

!GLMTabSelectorBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 3/24/2015 13:49'!
onTabClicked: anEvent with: aBrick 
	"A tab has been clicked."
	
	self selectedIndex: (self tabs indexOf: aBrick)! !

!GLMTabbedArrangement methodsFor: 'rendering' stamp: 'tg 1/6/2010 23:23'!
renderGlamorouslyOn: aRenderer
	^ aRenderer renderTabbedCompositePresentation: self composite! !

!GLMTableColumn commentStamp: 'TudorGirba 2/4/2011 21:14'!
This is a helper class for the TablePresentation.

Instance Variables:
	title	<ProtoObject | PseudoContext>
	computation	<ProtoObject | PseudoContext>!
!GLMTableColumn methodsFor: 'accessing' stamp: ''!
width: anObject
	width := anObject! !

!GLMTableColumn methodsFor: 'accessing' stamp: ''!
width
	^ width ifNil: [200]! !

!GLMTableColumn methodsFor: 'accessing' stamp: 'AndreiChis 4/21/2014 12:34'!
sortBlock: aBlock
	sortBlock := aBlock! !

!GLMTableColumn methodsFor: 'tags' stamp: ''!
computeTagsFilterFor: aGlamourValue 

	^ self computeTagsFor: aGlamourValue from: self tagsFilterBlock! !

!GLMTableColumn methodsFor: 'accessing' stamp: 'AndreiChis 4/20/2014 22:54'!
tagsFilter: aBlock
	tagsFilterBlock := aBlock ! !

!GLMTableColumn methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/7/2014 11:41'!
modifiedBlock: anObject
	modifiedBlock := anObject! !

!GLMTableColumn methodsFor: 'accessing' stamp: 'AndreiChis 4/17/2014 23:57'!
tagsFilterBlock
	^ tagsFilterBlock! !

!GLMTableColumn methodsFor: 'accessing' stamp: 'AndreiChis 4/20/2014 22:55'!
tagsBlock: aBlock
	tagsBlock := aBlock! !

!GLMTableColumn methodsFor: 'tags' stamp: ''!
computeTagsFor: aGlamourValue 

	^ self computeTagsFor: aGlamourValue from: self tagsBlock! !

!GLMTableColumn methodsFor: 'accessing' stamp: 'AndreiChis 6/13/2014 12:29'!
defaultSortBlockForPresentation: aGlamourPresentation
	
	^ [ :x :y | 		
			(aGlamourPresentation
				column: self 
				valueFor: x) asString <
			(aGlamourPresentation 
				column: self 
				valueFor: y) asString ] ! !

!GLMTableColumn methodsFor: 'scripting' stamp: ''!
tags: aBlock

	self tagsBlock: aBlock.
	self hasTagsFilter ifFalse:[ self tagsFilter: aBlock ]! !

!GLMTableColumn methodsFor: 'accessing' stamp: ''!
title
	^ title! !

!GLMTableColumn methodsFor: 'accessing' stamp: ''!
title: anObject
	title := anObject! !

!GLMTableColumn methodsFor: 'tags' stamp: ''!
computeTagsFor: aGlamourValue from: aBlock
	| value |
	
	aBlock ifNil: [ ^ OrderedCollection new ].
	value := aBlock glamourValue: aGlamourValue.
	^ value isString
		ifTrue: [ OrderedCollection with: value ]
		ifFalse: [ value asOrderedCollection ]! !

!GLMTableColumn methodsFor: 'accessing' stamp: 'AndreiChis 4/17/2014 23:56'!
tagsBlock
	^ tagsBlock! !

!GLMTableColumn methodsFor: 'accessing' stamp: ''!
computation: anObject
	computation := anObject! !

!GLMTableColumn methodsFor: 'accessing' stamp: ''!
computation
	^ computation! !

!GLMTableColumn methodsFor: 'accessing' stamp: 'AndreiChis 6/13/2014 11:56'!
sortBlock
	^ sortBlock! !

!GLMTableColumn methodsFor: 'testing' stamp: ''!
hasTagsFilter
	^ self tagsFilterBlock notNil! !

!GLMTableColumn methodsFor: 'testing' stamp: ''!
hasTags
	^ self tagsBlock notNil! !

!GLMTableColumn methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/7/2014 11:41'!
modifiedBlock
	^ modifiedBlock! !

!GLMTableMorphicTest methodsFor: 'tests' stamp: ''!
testColumnBlockTakesEntity

	| browser receivedEntity |
	browser := GLMFinder new.
	receivedEntity := nil.
	browser show: [:a | a table
		column: 'Even' evaluated: [:each :entity | receivedEntity := entity. 'x']].
	window := browser openOn: (1 to: 5).
	World doOneCycle.
	self repeatAssert: [receivedEntity] equals: (1 to: 5).
! !

!GLMTableMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 8/25/2013 22:47'!
testColumnLabel
	| browser tableMorph |
	browser := GLMTabulator new.
	browser column: #one.
	(browser transmit)
		to: #one;
		andShow: [ :a | 
					(a table)
						display: [ :x | x - 3 to: x ];
						column: 'Column' evaluated: [ :x | x asString ];
						column: [ :x | 'Number ' , x asString ] evaluated: #asString ].
	window := browser openOn: 4.
	tableMorph := self find: MorphTreeMorph in: window.
	self assert: (tableMorph model roots collect: #item) equals: #(1 2 3 4) asOrderedCollection.
	self assert: tableMorph columns first header label equals: 'Column'.
	self assert: tableMorph columns last header label equals: 'Number 4'! !

!GLMTablePresentation commentStamp: 'AndreiChis 10/3/2014 18:33'!
A GLMTablePresentation shows the given elements within a table.  If the #children block is set then it support a tree-like table where elements can be expanded.

Each column of the presetation can have its own tags and its own sorting block.

Instance Variables
	children:		<Object>
	columns:		<Object>
	rootsExpanded:		<Object>

children
	- xxxxx

columns
	- xxxxx

rootsExpanded
	- xxxxx
!
!GLMTablePresentation methodsFor: 'default actions' stamp: 'TudorGirba 7/21/2014 10:38'!
exportToCSV
	FileSystem workingDirectory / 'table-export.csv' writeStreamDo: [ :stream |
		self columns do: [ :column | 
						stream 
							nextPut: $";
							nextPutAll: (self titleValueOfColumn: column);
							nextPut: $" ]
						separatedBy: [ stream nextPut: $, ].
		stream cr.
		self displayValue 
			do: [ :each |
				self columns 
					do: [ :column | 
						stream 
							nextPut: $";
							nextPutAll: (self column: column valueFor: each) asString;
							nextPut: $" ]
					separatedBy: [ stream nextPut: $, ].
				stream cr ]
			displayingProgress: 'Exporting' ]! !

!GLMTablePresentation methodsFor: 'default actions' stamp: 'TudorGirba 7/21/2014 10:08'!
installExportToCSV
	self 
		act: [ self exportToCSV ]
		entitled: 'Export to CSV'! !

!GLMTablePresentation methodsFor: 'scripting' stamp: 'AndreiChis 4/18/2014 00:06'!
column: aBlockOrString evaluated: aBlock tags: anObject filtered: anotherObject
	self addColumn: (GLMTableColumn new 
		title: aBlockOrString; 
		computation: aBlock;
		tagsBlock: anObject;
		tagsFilter: anotherObject)! !

!GLMTablePresentation methodsFor: 'accessing' stamp: 'AndreiChis 8/4/2014 20:41'!
children
	 
	^ children! !

!GLMTablePresentation methodsFor: 'accessing' stamp: ''!
columns: aCollection
	columns := aCollection ! !

!GLMTablePresentation methodsFor: 'validation' stamp: 'AndreiChis 8/4/2014 20:55'!
defaultValidate: anObject on: aPort
	"we only allow objects that are in the display value"
	(aPort name == #selection) ifFalse: [ ^ true ].
	self entity isNil ifTrue: [ ^ false ].
	self allDisplayedDo: [:each | each = anObject ifTrue: [ ^ true ] ].
	^ false! !

!GLMTablePresentation methodsFor: 'scripting' stamp: 'TudorGirba 6/7/2013 12:52'!
column: aBlockOrString evaluated: aBlock width: aNumber 
	self addColumn: (GLMTableColumn new 
		title: aBlockOrString; 
		computation: aBlock;
		width: aNumber;
		yourself)	! !

!GLMTablePresentation methodsFor: 'initialization' stamp: 'TudorGirba 8/12/2014 15:10'!
initialize
	super initialize.
	children := [ #() ]! !

!GLMTablePresentation methodsFor: 'accessing' stamp: 'AndreiChis 8/4/2014 20:41'!
childrenValueOf: anObject atLevel: anInteger
	^ self children glamourValue: (
		anObject asGlamorousMultiValue, 
		self entity asGlamorousMultiValue,
		anInteger asGlamorousMultiValue,
		self asGlamorousMultiValue)! !

!GLMTablePresentation methodsFor: 'accessing' stamp: ''!
addColumn: aColumn
	self columns add: aColumn! !

!GLMTablePresentation methodsFor: 'accessing' stamp: 'AndreiChis 8/4/2014 21:52'!
shouldRootsExpand
	^ rootsExpanded ifNil: [false]! !

!GLMTablePresentation methodsFor: 'accessing' stamp: 'AndreiChis 8/4/2014 21:52'!
shouldRootsExpand: anObject
	rootsExpanded := anObject! !

!GLMTablePresentation methodsFor: 'private' stamp: ''!
column: aGlamourColumn valueFor: anObject
	^ aGlamourColumn computation glamourValue: 
		(anObject asGlamorousMultiValue,
		 self entity asGlamorousMultiValue)! !

!GLMTablePresentation methodsFor: 'testing' stamp: 'AndreiChis 4/20/2014 16:02'!
hasTagsFilter

	^ self columns anySatisfy: [ :aColumn | aColumn hasTagsFilter ]! !

!GLMTablePresentation methodsFor: 'validation' stamp: 'AndreiChis 8/4/2014 20:56'!
allDisplayedDo: aBlock
	self displayValue do: [ :eachRoot | 
		self withChildrenOf: eachRoot do: aBlock ]! !

!GLMTablePresentation methodsFor: 'scripting' stamp: 'AndreiChis 4/23/2014 13:29'!
column: aBlockOrString evaluated: aBlock width: aNumber tags: anObject
	self addColumn: (GLMTableColumn new 
		title: aBlockOrString; 
		computation: aBlock;
		width: aNumber;
		tags: anObject;
		yourself)	! !

!GLMTablePresentation methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 10/7/2014 11:41'!
column: aBlockOrString evaluated: aBlock modified: aModifiedBlock
	self addColumn: (GLMTableColumn new 
		title: aBlockOrString;
		computation: aBlock;
		modifiedBlock: aModifiedBlock)! !

!GLMTablePresentation methodsFor: 'private' stamp: ''!
titleValueOfColumn: aColumn
	^ aColumn title glamourValue: self entity! !

!GLMTablePresentation methodsFor: 'scripting' stamp: 'TudorGirba 5/18/2014 15:56'!
column: aBlockOrString evaluated: aBlock sortedBy: aSortingBlock
	self addColumn: (GLMTableColumn new 
		title: aBlockOrString; 
		computation: aBlock;
		sortBlock: aSortingBlock)! !

!GLMTablePresentation methodsFor: 'scripting' stamp: 'AndreiChis 4/21/2014 12:37'!
column: aBlockOrString evaluated: aBlock
	self addColumn: (GLMTableColumn new 
		title: aBlockOrString; 
		computation: aBlock)! !

!GLMTablePresentation methodsFor: 'scripting' stamp: 'AndreiChis 4/21/2014 12:35'!
column: aBlockOrString evaluated: aBlock tags: anObject sortedBy: aSortingBlock
	self addColumn: (GLMTableColumn new 
		title: aBlockOrString; 
		computation: aBlock;
		tags: anObject;
		sortBlock: aSortingBlock)! !

!GLMTablePresentation methodsFor: 'tags' stamp: 'AndreiChis 4/20/2014 16:32'!
computeTagsFilterFor: aGlamourValue
	| tags |
	
	tags := OrderedCollection new.
	self columns collect: [ :aColumn | 
		tags addAll: (aColumn computeTagsFilterFor: aGlamourValue) ].
	^ tags! !

!GLMTablePresentation methodsFor: 'validation' stamp: 'AndreiChis 8/4/2014 20:52'!
withChildrenOf: anObject do: aBlock
	aBlock value: anObject.
	(self childrenValueOf: anObject) do: [ :each |
		self withChildrenOf: each do: aBlock ]! !

!GLMTablePresentation methodsFor: 'accessing' stamp: ''!
columns
	^ columns ifNil: [ columns := OrderedCollection new ]! !

!GLMTablePresentation methodsFor: 'tags' stamp: 'AndreiChis 4/20/2014 16:23'!
computeTagsFor: anObject
	| tags |
	
	tags := OrderedCollection new.
	self columns collect: [ :aColumn | 
		tags addAll: (aColumn computeTagsFor: anObject) ].
	^ tags! !

!GLMTablePresentation methodsFor: 'scripting' stamp: 'AndreiChis 4/18/2014 00:06'!
column: aBlockOrString evaluated: aBlock tags: anObject 
	self addColumn: (GLMTableColumn new 
		title: aBlockOrString; 
		computation: aBlock;
		tags: anObject)! !

!GLMTablePresentation methodsFor: 'rendering' stamp: ''!
renderGlamorouslyOn: aRenderer 
	self registerAnnouncements.
	^ aRenderer renderTablePresentation: self! !

!GLMTablePresentation methodsFor: 'accessing' stamp: 'AndreiChis 8/4/2014 20:40'!
children: anObject 
	 
	children := anObject! !

!GLMTablePresentation methodsFor: 'testing' stamp: 'AndreiChis 4/20/2014 16:02'!
hasTags

	^ self columns anySatisfy: [ :aColumn | aColumn hasTags ]! !

!GLMTablePresentation methodsFor: 'accessing' stamp: 'AndreiChis 8/4/2014 20:41'!
childrenValueOf: anObject
	^ self children glamourValue: (anObject asGlamorousMultiValue, self entity asGlamorousMultiValue)! !

!GLMTablePresentation methodsFor: 'scripting' stamp: 'AndreiChis 6/13/2014 14:00'!
column: aBlockOrString evaluated: aBlock width: aNumber tags: anObject sortedBy: aSortingBlock
	self addColumn: (GLMTableColumn new 
		title: aBlockOrString; 
		computation: aBlock;
		width: aNumber;
		tags: anObject;
		sortBlock: aSortingBlock
		yourself)	! !

!GLMTabulator commentStamp: '<historical>'!
A GLMTabulator is an explicit browser that allows us to place panes in columns and rows.!
!GLMTabulator methodsFor: 'scripting' stamp: 'tg 10/22/2009 13:26'!
row: aBlockOrSymbol size: anInteger 
	 
	^self addRow: aBlockOrSymbol size: anInteger! !

!GLMTabulator methodsFor: 'private' stamp: ' 4/5/09 22:18'!
cellOrRow 
	 
	^cell ifNil: [cell := GLMCustomRow new browser: self]! !

!GLMTabulator methodsFor: 'layout' stamp: ' 4/5/09 22:18'!
addRow: aBlockOrSymbol 
	 
	^self cellOrColumn addRow: aBlockOrSymbol! !

!GLMTabulator methodsFor: 'scripting' stamp: ' 4/5/09 22:18'!
column: aBlockOrSymbol 
	 
	^self addColumn: aBlockOrSymbol! !

!GLMTabulator methodsFor: 'layout' stamp: ' 4/5/09 22:18'!
cell 
	 
	^cell! !

!GLMTabulator methodsFor: 'scripting' stamp: ' 4/5/09 22:18'!
column: aBlockOrSymbol span: anInteger 
	 
	^self addColumn: aBlockOrSymbol span: anInteger! !

!GLMTabulator methodsFor: 'scripting' stamp: ' 4/5/09 22:18'!
row: aBlockOrSymbol span: anInteger 
	 
	^self addRow: aBlockOrSymbol span: anInteger! !

!GLMTabulator methodsFor: 'layout' stamp: ' 4/5/09 22:18'!
addColumn: aBlockOrSymbol 
	 
	^self cellOrRow addColumn: aBlockOrSymbol! !

!GLMTabulator methodsFor: 'rendering' stamp: 'tg 1/10/2010 16:20'!
renderGlamorouslyOn: aRenderer 
	 
	^aRenderer renderTabulator: self! !

!GLMTabulator methodsFor: 'scripting' stamp: ' 4/5/09 22:18'!
row: aBlockOrSymbol 
	 
	^self addRow: aBlockOrSymbol! !

!GLMTabulator methodsFor: 'scripting' stamp: 'TudorGirba 7/2/2011 19:03'!
initializeScriptingDefaults
	super initializeScriptingDefaults.
	self cell isNil
		ifTrue: [ self addColumn: #pane ].
	self transmissions
		detect: [ :each | each originatesAt: (self pane port: #entity) ]
		ifNone: [ 
			self
				transmit 
				to: (self panes first port: #entity);
				from: #outer port: #entity;
				andShow: [ :a | a custom: GLMFlexiblePresentation new ] ]! !

!GLMTabulator methodsFor: 'layout' stamp: 'tg 10/22/2009 13:27'!
addColumn: aBlockOrSymbol size: anInteger 
	 
	^(self addColumn: aBlockOrSymbol) size: anInteger; span: 0! !

!GLMTabulator methodsFor: 'layout' stamp: ' 4/5/09 22:18'!
addColumn: aBlockOrSymbol span: anInteger 
	 
	^(self addColumn: aBlockOrSymbol) span: anInteger! !

!GLMTabulator methodsFor: 'private' stamp: ' 4/5/09 22:18'!
cellOrColumn 
	 
	^cell ifNil: [cell := GLMCustomColumn new browser: self]! !

!GLMTabulator methodsFor: 'layout' stamp: 'tg 10/22/2009 13:27'!
addRow: aBlockOrSymbol size: anInteger 
	 
	^(self addRow: aBlockOrSymbol) size: anInteger; span: 0! !

!GLMTabulator methodsFor: 'scripting' stamp: 'tg 10/22/2009 13:27'!
column: aBlockOrSymbol size: anInteger 
	 
	^self addColumn: aBlockOrSymbol size: anInteger! !

!GLMTabulator methodsFor: 'layout' stamp: ' 4/5/09 22:18'!
addRow: aBlockOrSymbol span: anInteger 
	 
	^(self addRow: aBlockOrSymbol) span: anInteger! !

!GLMTabulator class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 3/26/2015 00:05'!
gtExampleSimple
	<gtExample>
	^ GLMTabulator new 
		with: [ :t |
			t column: #one.
			t transmit to: #one; andShow: [ :a | a text] ];
		startOn: 42! !

!GLMTabulatorMorphicTest methodsFor: 'tests' stamp: ''!
testStatusbar
	| browser statusMorph |
	browser := GLMTabulator new.
	browser addStatusbar.
	browser row: #one.
	browser transmit to: #one; andShow: [:a | a list display: #(1 2 3)].
	window := browser openOn: 42.
	((browser paneNamed: #one) port: #status) value: 2.
	World doOneCycle.
	statusMorph := (window submorphs last: 2) first submorphs first.	
	self assert: (statusMorph isKindOf: LabelMorph)! !

!GLMTabulatorMorphicTest methodsFor: 'tests' stamp: 'AliakseiSyrel 3/21/2015 19:58'!
testSpawnTabulator

	| browser |
	browser := GLMTabulator new.
	window := browser openOn: ($a to: $d).
	self assert: window model == browser.
	self repeatAssert: [
		window submorphs last 
					submorphs last 
						submorphs last 
							submorphs last class] equals: GLMPaginatedMorphTreeMorph
! !

!GLMTabulatorMorphicTest methodsFor: 'tests' stamp: ''!
testMultipleInitialSelection
	| browser firstTreeMorph secondTreeMorph |
	browser := GLMTabulator new.
	browser column: #one.
	browser
		transmit to: #one;
		andShow: [ :a | 
					(a tree)
						beMultiple;
						display: [ :x | 1 to: x * 3 ] ].
	window := browser openOn: 5.
	(browser panes first port: #selection) value: #(2 5 3).
	firstTreeMorph := self find: MorphTreeMorph in: window.
	self assert: firstTreeMorph model selection notNil.
	self assert: firstTreeMorph model selection selectedItemOrItemsOrNil size equals: 3.! !

!GLMTabulatorTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testSimpleColumns
	| layout |
	layout := GLMTabulator new.
	layout addColumn: #first.
	layout addColumn: #second.
	self assert: layout cell children size equals: 2! !

!GLMTabulatorTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testComplex
	| layout |
	layout := GLMTabulator new.
	layout
		addColumn: [ :column | 
			column addRow: #second.
			column addRow: #third.
			column addRow: #fourth.
			column
				addRow: [ :row | 
					row addColumn: #fifth.
					row addColumn: #sixth ] ].
	layout addColumn: #first.
	self assert: layout cell children size equals: 2.
	self assert: layout cell children first children size equals: 4.
	self assert: layout cell children first children last children size equals: 2! !

!GLMTabulatorTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testSimpleRows
	| layout |
	layout := GLMTabulator new.
	layout addRow: #first.
	layout addRow: #second.
	self assert: layout cell children size equals: 2.
	self assert: layout cell isColumn.
	self assert: layout cell children first isRow! !

!GLMTabulatorTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testOneSimpleRowAndOneNested
	| layout |
	layout := GLMTabulator new.
	layout addRow: #first.
	layout
		addRow: [ :row | 
			row addColumn: #second.
			row addColumn: #third.
			row addColumn: #fourth ].
	self assert: layout cell children size equals: 2.
	self assert: layout cell children last children size equals: 3! !

!GLMTabulatorTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testOneSimpleColumnAndOneNested
	| layout |
	layout := GLMTabulator new.
	layout
		addColumn: [ :column | 
			column addRow: #second.
			column addRow: #third.
			column addRow: #fourth ].
	layout addColumn: #first.
	self assert: layout cell children size equals: 2.
	self assert: layout cell children first children size equals: 3! !

!GLMTestAnnouncement methodsFor: 'accessing' stamp: 'tg 2/22/2010 11:13'!
parameter: anObject
	parameter := anObject! !

!GLMTestAnnouncement methodsFor: 'accessing' stamp: 'tg 2/22/2010 11:13'!
parameter
	^ parameter! !

!GLMTestPane methodsFor: 'accessing' stamp: 'jorge.ressia 6/2/2009 21:37'!
browser: aBrowser 
	browser := aBrowser! !

!GLMTestPane methodsFor: 'accessing' stamp: 'tg 1/11/2010 21:59'!
browser
	browser isNil ifTrue: [ ^ GLMNoBrowser new ].
	^ browser! !

!GLMTestPane class methodsFor: 'private' stamp: ' 4/5/09 22:18'!
portClass 
	 
	^GLMTestPort! !

!GLMTestPane class methodsFor: 'private' stamp: 'jorge.ressia 6/3/2009 08:55'!
new

	^super new initialize! !

!GLMTestPort methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
receive: aTransmission 
	 
	self seenTransmissions addLast: aTransmission. 
	^super receive: aTransmission! !

!GLMTestPort methodsFor: 'accessing' stamp: 'TudorGirba 4/18/2011 18:23'!
receive: aTransmission in: aContext
	self seenTransmissions addLast: aTransmission. 
	^super receive: aTransmission in: aContext! !

!GLMTestPort methodsFor: 'accessing' stamp: ' 4/5/09 22:18'!
seenTransmissions 
	 
	^seenTransmissions ifNil: [seenTransmissions := OrderedCollection new]! !

!GLMTextChanged methodsFor: 'accessing' stamp: 'TudorGirba 7/29/2012 08:33'!
text: anObject
	text := anObject! !

!GLMTextChanged methodsFor: 'accessing' stamp: 'TudorGirba 7/29/2012 08:33'!
text
	^ text! !

!GLMTextEditorRequest commentStamp: 'AndreiChis 10/4/2014 22:49'!
I indicate to the renderer to execute a message on the text editor morph that contains the actual text.!
!GLMTextEditorRequest methodsFor: 'accessing' stamp: 'AndreiChis 10/4/2014 22:43'!
selector: anObject
	selector := anObject! !

!GLMTextEditorRequest methodsFor: 'accessing' stamp: 'AndreiChis 10/4/2014 22:43'!
selector
	^ selector! !

!GLMTextEditorRequest class methodsFor: 'instance creation' stamp: 'AndreiChis 10/3/2014 18:51'!
for: aSelector

	^ self new selector: aSelector! !

!GLMTextModel methodsFor: 'callbacks' stamp: 'TudorGirba 3/24/2013 12:56'!
keystroke: anEvent from: aMorph
	anEvent anyModifierKeyPressed ifTrue: [ ^ super keystroke: anEvent from: aMorph ].
	self glamourPresentation text: self text.
	^ false! !

!GLMTextModel methodsFor: 'callbacks' stamp: 'TudorGirba 2/14/2012 08:42'!
accept: aText notifying: anObject 
	aText asString trimBoth ifEmpty: [^self].
	self text: aText.
	self changed: #text! !

!GLMTextModel methodsFor: 'callbacks' stamp: 'tg 8/22/2010 13:14'!
selection
	^ self glamourPresentation selectionInterval ifNil: [1 to: 0]! !

!GLMTextModel methodsFor: 'accessing' stamp: 'TudorGirba 2/9/2014 00:13'!
changedText: aTextOrString
	text := aTextOrString.
	self changed: #text! !

!GLMTextModel methodsFor: 'callbacks' stamp: 'tg 5/14/2009 22:10'!
selectSilently: anIndex
	self changed: #selection! !

!GLMTextModel methodsFor: 'accessing' stamp: 'TudorGirba 2/9/2014 00:04'!
text: aTextOrString
	text := aTextOrString.
	self glamourPresentation ifNotNil: [ :presentation | presentation text: text ]! !

!GLMTextModel methodsFor: 'callbacks' stamp: 'david_roethlisberger 2/27/2009 11:50'!
text
	^text! !

!GLMTextModel methodsFor: 'callbacks' stamp: 'tg 8/4/2009 15:31'!
menu: aMorphMenu shifted: b
	^ self menu: aMorphMenu! !

!GLMTextMorphForEditView commentStamp: 'TudorGirba 7/14/2011 09:44'!
GLMTextMorphForEditView is meant to work with GLMPluggableTextMorph.!
!GLMTextMorphForEditView methodsFor: 'editing' stamp: 'VincentBlondeau 2/4/2014 15:48'!
acceptContents
	self flag: 'Hack for disable the CTRL+S behaviour'! !

!GLMTextMorphForEditView methodsFor: 'callbacks' stamp: 'TudorGirba 7/14/2011 11:10'!
keyStroke: anEvent
	| isHandledByModel |
	isHandledByModel := self editView model keystroke: anEvent from: self editView.
	isHandledByModel ifFalse: [ super keyStroke: anEvent ]! !

!GLMTextMorphForEditView methodsFor: 'private' stamp: 'TudorGirba 7/14/2011 21:37'!
editorClass
	"Answer the class used to create the receiver's editor"
	
	^GLMSmalltalkEditor! !

!GLMTextMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 3/31/2014 07:25'!
testPastingUpdatesTextPort
	| composite textMorph |
	composite := GLMCompositePresentation new with: [ :a | a text display: '' ].
	window := composite openOn: 42.
	textMorph := self find: PluggableTextMorph in: window.
	Clipboard clipboardText: '42'.
	textMorph paste.
	self assert: (composite pane port: #text) value = '42'! !

!GLMTextMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 7/29/2012 11:13'!
testTextPortPopulatedByDefault
	| composite |
	composite := GLMCompositePresentation new with: [:a | a text ].
	window := composite openOn: '42'.
	self assert: (composite pane port: #text) value asString equals: '42'! !

!GLMTextMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 4/24/2014 23:04'!
testAcceptKeyCanBeOverriden
	| composite textMorph overriden |
	overriden := false.
	composite := GLMCompositePresentation new with: [ :a | a text act: [ :text | overriden := true ] on: $s entitled: 'Override'].
	window := composite openOn: 4.
	textMorph := self find: PluggableTextMorph in: window.
	textMorph simulateClick.
	self simulateKeyStroke: $s command.
	self simulateKeyStroke: $s control.
	self simulateKeyStroke: $s alt.
	self assert: overriden.! !

!GLMTextMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 11/28/2012 22:04'!
testResettingTheSelection
	| composite textMorph textPresentation |
	composite := GLMCompositePresentation new with: [ :a | a text display: '123456789' ].
	window := composite openOn: 4.
	textPresentation := composite presentations first.
	textPresentation selectionInterval: (2 to: 5).
	self shouldnt: [textPresentation selectionInterval: nil] raise: Error! !

!GLMTextMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 3/31/2014 07:24'!
expectedFailures
	^ #(testUpdatingTextPortUpdatesTheMorph)! !

!GLMTextMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 2/9/2014 00:12'!
testUpdatingTextPortUpdatesTheMorph
	| composite textMorph |
	composite := GLMCompositePresentation new with: [:a | a text ].
	window := composite openOn: 'fourtytwo'.
	composite first text: '42'.
	self assert: (composite pane port: #text) value asString equals: '42'.
	textMorph := self find: GLMPluggableTextMorph in: window.
	self assert: textMorph text asString equals: '42'! !

!GLMTextMorphicTest methodsFor: 'tests' stamp: 'AndreHora 5/9/2013 15:39'!
testExplicitAcceptDoesNotAffectTextPort
	| composite textMorph |
	composite := GLMCompositePresentation new with: [ :a | a text display: '123' ].
	window := composite openOn: 4.
	textMorph := self find: PluggableTextMorph in: window.
	textMorph simulateClick.
	self simulateKeyStrokes: '4'.
	self assert: (composite pane port: #text) value = '1234'.
	self simulateKeyStroke: $s command.
	self simulateKeyStrokes: '56'.
	self assert: (composite pane port: #text) value = '123456'! !

!GLMTextMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 7/29/2012 08:52'!
testMultipleSelectionWithChange
	| composite textMorph textPresentation |
	composite := GLMCompositePresentation new with: [ :a | a text display: '123456789' ].
	window := composite openOn: 4.
	textMorph := self find: PluggableTextMorph in: window.
	self assert: textMorph selectionInterval isEmpty.
	textPresentation := composite presentations first.
	textPresentation selectionInterval: (2 to: 5).
	self assert: textMorph selectedContents asString equals: '2345'.
	self assert: textPresentation selectedText asString equals: '2345'! !

!GLMTextMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 7/29/2012 08:53'!
testUnregisterFromAnnouncementsWhenUpdating
	| composite announcingCollection numberOfExecutions |
	numberOfExecutions := 0.
	announcingCollection := GLMAnnouncingCollection new.
	composite :=  GLMCompositePresentation new with: [ :a | 
					(a text)
						updateOn: GLMItemAdded from: [ announcingCollection ];
						display: [ numberOfExecutions := numberOfExecutions + 1 ] ].
	window := composite openOn: announcingCollection.
	1 to: 3 do: [ :each | announcingCollection add: each ].
	self assert: numberOfExecutions equals: 4	"it should not be 8"! !

!GLMTextPresentation commentStamp: 'TudorGirba 3/5/2011 21:22'!
A presentation displaying text.

Instance Variables:
	selectedTextBlock	<ProtoObject>
	highlightSmalltalk	<Boolean>
	highlightSmalltalkContext	<Object>
	textBlock	<ProtoObject | PseudoContext>!
!GLMTextPresentation methodsFor: 'accessing' stamp: ''!
forSmalltalk
	highlightSmalltalk := true! !

!GLMTextPresentation methodsFor: 'accessing' stamp: ''!
highlightSmalltalkContext
	^ highlightSmalltalkContext isNil 
		ifTrue: [nil] 
		ifFalse: [highlightSmalltalkContext glamourValue: self entity]! !

!GLMTextPresentation methodsFor: 'rendering' stamp: ''!
renderGlamorouslyOn: aRenderer 
	self registerAnnouncements.
	^ aRenderer renderTextPresentation: self! !

!GLMTextPresentation methodsFor: 'accessing' stamp: ''!
highlightSmalltalk
	^ highlightSmalltalk ifNil: [highlightSmalltalk := false]! !

!GLMTextPresentation methodsFor: 'accessing' stamp: ''!
forSmalltalk: aBlock
	"aBlock takes as parameters the entity objects and 
	its evaluation is expected to produce a Smalltalk class"
	highlightSmalltalk := true.
	highlightSmalltalkContext := aBlock.! !

!GLMTextPresentationTest methodsFor: 'tests' stamp: 'TudorGirba 7/29/2012 11:13'!
expectedFailures

	^ #(testTextPortIsPopulatedByDefault)! !

!GLMTextPresentationTest methodsFor: 'tests' stamp: 'AndreiChis 6/24/2013 10:18'!
testSelectionIntervalInitialization
	| presentation |
	presentation := GLMTextPresentation new
		initialize: [ :pres | pres selectionInterval: (3 to: 9) ].
	self assert: presentation selectionInterval equals: nil.
	presentation initializePresentation.
	self assert: presentation selectionInterval equals: (3 to: 9)! !

!GLMTextPresentationTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testSelectedText
	| presentation |
	presentation := GLMTextPresentation new.
	self assert: presentation selectedText equals: ''.
	presentation selectedTextBlock: [ 'selection' ].
	self assert: presentation selectedText equals: 'selection'! !

!GLMTextPresentationTest methodsFor: 'tests' stamp: 'TudorGirba 7/29/2012 08:58'!
testTextPortIsPopulatedByDefault
	| composite |
	composite := (GLMCompositePresentation new with: [:a | a text ]) startOn: '42'.
	self assert: composite presentations first text equals: '42'! !

!GLMTextualPresentation commentStamp: 'AndreiChis 10/3/2014 18:27'!
This is the abstract class for a presentation that is supposed to show text. The #selectionText port and not the #selection port is populated by the renderer when the user selects a piece of text.

Instance Variables
	cursorPosition:		<Object>
	doItContext:		<Object>
	doItReceiver:		<Object>
	selectedText:		<Object>
	selectedTextBlock:		<Object>
	text:		<Object>
	textBlock:		<Object>
!
!GLMTextualPresentation methodsFor: 'accessing ports' stamp: ''!
cursorPosition: anObject 
	 
	cursorPosition := anObject! !

!GLMTextualPresentation methodsFor: 'accessing' stamp: 'AndreiChis 8/13/2013 15:43'!
doItContext
	"Return a context use for evaluating code in the presentation. Any variable contained in the executed code will be looked up in this context."
	^ doItContext glamourValue: self entity! !

!GLMTextualPresentation methodsFor: 'accessing' stamp: 'AndreiChis 8/13/2013 15:42'!
doItReceiver: aOneArgBlock
	"The block will be passed the current entity and is expected to return an object .This object will then be returned upon evaluation of 'self' within the presentation."
	doItReceiver := aOneArgBlock! !

!GLMTextualPresentation methodsFor: 'accessing ports' stamp: ''!
text: aString
	(self pane port: #text) value: aString copy! !

!GLMTextualPresentation methodsFor: 'accessing' stamp: ''!
textBlock
	^ textBlock! !

!GLMTextualPresentation methodsFor: 'accessing' stamp: 'AndreiChis 6/24/2013 10:12'!
selectionInterval
	^ (self pane port: #selectionInterval) value
! !

!GLMTextualPresentation methodsFor: 'accessing ports' stamp: ''!
text
	^ (self pane port: #text) value isNil 
		ifTrue: [self textBlock value]
		ifFalse: [(self pane port: #text) value]! !

!GLMTextualPresentation methodsFor: 'accessing' stamp: ''!
selectedTextBlock: anObject
	selectedTextBlock := anObject! !

!GLMTextualPresentation methodsFor: 'accessing' stamp: ''!
selectedTextBlock
	^ selectedTextBlock ifNil: [ [''] ]! !

!GLMTextualPresentation methodsFor: 'accessing' stamp: 'AndreiChis 4/17/2014 00:24'!
dynamicActionsOnSelection
	"Unlike the other types of presentations, in a text presentation the dynamic actions should be computed even if the selection port is not explicitly populated. A text presentation uses the port #selectedText to transmit the text that was selected by the user, and not the #selection port"
	(selectionDynamicActionsBlock isNil or: [ 
		self selectedText isNil ])
		ifTrue: [ ^ OrderedCollection new ].
	^ selectionDynamicActionsBlock glamourValue: self! !

!GLMTextualPresentation methodsFor: 'accessing' stamp: ''!
textBlock: anObject 
	textBlock := anObject! !

!GLMTextualPresentation methodsFor: 'accessing ports' stamp: ''!
selectedText: anObject
	(self pane port: #selectedText) value: anObject copy! !

!GLMTextualPresentation methodsFor: 'accessing' stamp: 'AndreiChis 8/13/2013 15:42'!
doItContext: aOneArgBlock
	"The block will be passed the current entity and is expected to return a context. Any code evaluated from the presentation will be executed as part of the retuned context."
	doItContext := aOneArgBlock! !

!GLMTextualPresentation methodsFor: 'accessing ports' stamp: ''!
selectedText
	^ (self pane port: #selectedText) value isNil 
		ifTrue: [self selectedTextBlock value]
		ifFalse: [(self pane port: #selectedText) value]! !

!GLMTextualPresentation methodsFor: 'accessing ports' stamp: ''!
cursorPosition 
	 
	^cursorPosition! !

!GLMTextualPresentation methodsFor: 'accessing' stamp: ''!
doItReceiver
	"Returns the object that should be used when evaluating 'self' within the presentation. 'nil' is the default value"
	^ doItReceiver glamourValue: self entity! !

!GLMTextualPresentation methodsFor: 'accessing' stamp: ''!
selectionInterval: anInterval
	(self pane port: #selectionInterval) value: anInterval! !

!GLMTextualPresentation methodsFor: 'accessing' stamp: 'AndreiChis 2/27/2014 17:45'!
selectLine
	"Select the current line if there is no current selection"
	self announce: GLMSelectCurrentLine.! !

!GLMThemeIcons commentStamp: 'TudorGirba 1/30/2011 22:49'!
This class holds a set of icons to be used in the Glamorous UI Theme.!
!GLMThemeIcons methodsFor: 'see class side' stamp: 'TudorGirba 1/30/2011 22:49'!
seeClassSide! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:40'!
radioButtonSelectedForm
	^ self form16x16FromContents: self radioButtonSelectedFormContents! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:41'!
windowCloseForm
	^ self form16x16FromContents: self windowCloseFormContents ! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:40'!
checkboxUnselectedForm
	^ self form16x16FromContents: self checkboxUnselectedFormContents 
! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:41'!
windowMinimizeForm
	^self form16x16FromContents: self windowMinimizeFormContents ! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:26'!
menuPinFormContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 83886080 100663296 83886080 0 0 0 0 0 0 0 0 0 0 0 0 1291845632 3774873600 4194304000 3774873600 788529152 0 0 0 0 0 0 0 0 0 0 1107296256 4278190080 4278190080 4278190080 4278190080 4278190080 788529152 0 0 0 0 0 0 0 0 83886080 3992977408 4278190080 4278190080 4278190080 4278190080 4278190080 3774873600 83886080 0 0 0 0 0 0 0 100663296 4194304000 4278190080 4278190080 4278190080 4278190080 4278190080 4194304000 100663296 0 0 0 0 0 0 0 83886080 3774873600 4278190080 4278190080 4278190080 4278190080 4278190080 3992977408 83886080 0 0 0 0 0 0 0 0 1291845632 4261412864 4278190080 4278190080 4278190080 4261412864 1107296256 0 0 0 0 0 0 0 0 0 0 1107296256 3992977408 4194304000 3774873600 1291845632 0 0 0 0 0 0 0 0 0 0 0 0 83886080 100663296 83886080 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 14:10'!
checkboxSelectedFormContents
	^#( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 0 0 0 0 0 0 4278190080 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4278190080 0 0 0 0 0 0 4278190080 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4278190080 0 0 0 0 0 0 4278190080 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4278190080 0 0 0 0 0 0 4278190080 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4278190080 0 0 0 0 0 0 4278190080 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4278190080 0 0 0 0 0 0 4278190080 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4278190080 0 0 0 0 0 0 4278190080 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4278190080 0 0 0 0 0 0 4278190080 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4278190080 0 0 0 0 0 0 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:15'!
windowMenuInactiveFormContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 360282489 3565191296 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 3565191296 360282489 0 0 0 0 0 0 0 360282489 3565191296 4286611584 4286611584 4286611584 4286611584 3565191296 360282489 0 0 0 0 0 0 0 0 0 360282489 3565191296 4286611584 4286611584 3565191296 360282489 0 0 0 0 0 0 0 0 0 0 0 377520256 3565191296 3565191296 360282489 0 0 0 0 0 0 0 0 0 0 0 0 0 377520256 360282489 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/27/2010 15:13'!
radioUnselectedFormContents
	^#( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 50331648 0 0 50331648 0 0 0 0 0 0 0 0 0 0 0 1023410176 3238002688 3909091328 3909091328 3238002688 1023410176 0 0 0 0 0 0 0 0 0 2097152000 3976200192 1275068416 452984832 452984832 1275068416 3976200192 872415232 0 0 0 0 0 0 0 1023410176 4278190080 335544320 0 0 0 0 335544320 4278190080 1023410176 0 0 0 0 0 50331648 3238002688 1275068416 0 0 0 0 0 0 1275068416 3238002688 50331648 0 0 0 0 0 3909091328 452984832 0 0 0 0 0 0 452984832 3909091328 0 0 0 0 0 0 3909091328 452984832 0 0 0 0 0 0 452984832 3909091328 0 0 0 0 0 33554432 3238002688 1275068416 0 0 0 0 0 0 1275068416 3238002688 50331648 0 0 0 0 0 1006632960 3992977408 335544320 0 0 0 0 335544320 4278190080 1023410176 0 0 0 0 0 0 0 2097152000 4278190080 1275068416 452984832 452984832 1275068416 3976200192 2097152000 0 0 0 0 0 0 0 0 0 1006632960 3238002688 3909091328 3909091328 3238002688 1023410176 0 0 0 0 0 0 0 0 0 0 0 33554432 0 0 50331648 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: 0@0! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:27'!
radioButtonSelectedFormContents
	^#( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 50331648 0 0 50331648 0 0 0 0 0 0 0 0 0 0 0 1023410176 3422946822 4043572228 4043572228 3422946822 1023410176 0 0 0 0 0 0 0 0 0 2214987270 4161078533 4284045657 4285690482 4285690482 4284045657 4161078533 1058280468 0 0 0 0 0 0 0 1023410176 4278190080 4285887861 4286611584 4286611584 4286611584 4286611584 4285887861 4278190080 1023410176 0 0 0 0 0 50331648 3422946822 4284045657 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4284045657 3422946822 50331648 0 0 0 0 0 4043572228 4285690482 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4285690482 4043572228 0 0 0 0 0 0 4043572228 4285690482 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4285690482 4043572228 0 0 0 0 0 33554432 3422946822 4284045657 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4284045657 3422946822 50331648 0 0 0 0 0 1006632960 4161078533 4285887861 4286611584 4286611584 4286611584 4286611584 4285887861 4278190080 1023410176 0 0 0 0 0 0 0 2214987270 4278190080 4284045657 4285690482 4285690482 4284045657 4161078533 2214987270 0 0 0 0 0 0 0 0 0 1006632960 3422946822 4043572228 4043572228 3422946822 1023410176 0 0 0 0 0 0 0 0 0 0 0 33554432 0 0 50331648 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/27/2010 15:24'!
windowCloseFormContents
	^#( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 167772160 0 0 0 0 0 0 0 0 167772160 3875536896 4076863488 234881024 0 234881024 2919235584 3858759680 0 0 0 0 0 0 0 0 402653184 3674210304 4261412864 3758096384 671088640 3758096384 4261412864 4278190080 335544320 0 0 0 0 0 0 0 0 352321536 3758096384 4143972352 4211081216 4143972352 3758096384 352321536 0 0 0 0 0 0 0 0 0 0 671088640 4211081216 4261412864 4211081216 671088640 0 0 0 0 0 0 0 0 0 0 352321536 3758096384 4143972352 4211081216 4143972352 3758096384 352321536 0 0 0 0 0 0 0 0 335544320 4278190080 4244635648 3758096384 671088640 3758096384 4143972352 3724541952 402653184 0 0 0 0 0 0 0 0 3892314112 2919235584 234881024 0 234881024 4278190080 1761607680 167772160 0 0 0 0 0 0 0 0 167772160 67108864 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/27/2010 15:13'!
radioSelectedFormContents
	^#( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 50331648 0 0 50331648 0 0 0 0 0 0 0 0 0 0 0 1023410176 3422946822 4043572228 4043572228 3422946822 1023410176 0 0 0 0 0 0 0 0 0 2214987270 4161078533 4284045657 4285690482 4285690482 4284045657 4161078533 1058280468 0 0 0 0 0 0 0 1023410176 4278190080 4285887861 4286611584 4286611584 4286611584 4286611584 4285887861 4278190080 1023410176 0 0 0 0 0 50331648 3422946822 4284045657 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4284045657 3422946822 50331648 0 0 0 0 0 4043572228 4285690482 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4285690482 4043572228 0 0 0 0 0 0 4043572228 4285690482 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4285690482 4043572228 0 0 0 0 0 33554432 3422946822 4284045657 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4284045657 3422946822 50331648 0 0 0 0 0 1006632960 4161078533 4285887861 4286611584 4286611584 4286611584 4286611584 4285887861 4278190080 1023410176 0 0 0 0 0 0 0 2214987270 4278190080 4284045657 4285690482 4285690482 4284045657 4161078533 2214987270 0 0 0 0 0 0 0 0 0 1006632960 3422946822 4043572228 4043572228 3422946822 1023410176 0 0 0 0 0 0 0 0 0 0 0 33554432 0 0 50331648 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: 0@0! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:40'!
radioButtonUnselectedForm
	^ self form16x16FromContents: self radioButtonUnselectedFormContents ! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/27/2010 15:23'!
windowMaximizeInactiveFormContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:52'!
windowMenuFormContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 352321536 3556769792 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 3556769792 352321536 0 0 0 0 0 0 0 352321536 3556769792 4278190080 4278190080 4278190080 4278190080 3556769792 352321536 0 0 0 0 0 0 0 0 0 352321536 3556769792 4278190080 4278190080 3556769792 352321536 0 0 0 0 0 0 0 0 0 0 0 369098752 3556769792 3556769792 352321536 0 0 0 0 0 0 0 0 0 0 0 0 0 369098752 352321536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!GLMThemeIcons class methodsFor: 'accessing' stamp: 'TudorGirba 12/7/2014 12:55'!
iconSetName
	^ 'Glamorous black'! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/27/2010 15:23'!
windowMinimizeInactiveFormContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 0 0 0 0 0 0 0 0 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:40'!
menuPinForm
	^self form16x16FromContents: self menuPinFormContents ! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:26'!
checkboxUnselectedFormContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:41'!
windowMaximizeInactiveForm
	^ self form16x16FromContents: self windowMaximizeInactiveFormContents ! !

!GLMThemeIcons class methodsFor: 'testing' stamp: 'TudorGirba 12/7/2014 12:53'!
isAbstract
	^ false! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:07'!
windowMaximizeFormContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/27/2010 15:23'!
windowCloseInactiveFromContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 176193664 0 0 0 0 0 0 0 0 176193664 3883958400 4085284992 243302528 0 243302528 2927657088 3867181184 0 0 0 0 0 0 0 0 411074688 3682631808 4269834368 3766517888 679049593 3766517888 4269834368 4286611584 343965824 0 0 0 0 0 0 0 0 360282489 3766517888 4152328063 4219436927 4152393856 3766517888 360282489 0 0 0 0 0 0 0 0 0 0 679049593 4219436927 4269834368 4219436927 679049593 0 0 0 0 0 0 0 0 0 0 360282489 3766517888 4152393856 4219436927 4152328063 3766517888 360282489 0 0 0 0 0 0 0 0 343965824 4286611584 4253057152 3766517888 679049593 3766517888 4152328063 3732963456 411074688 0 0 0 0 0 0 0 0 3900735616 2927657088 243302528 0 243302528 4286611584 1769897598 176193664 0 0 0 0 0 0 0 0 176193664 75530368 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:41'!
windowCloseInactiveForm
	^ self form16x16FromContents: self windowCloseInactiveFromContents ! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:39'!
form16x16FromContents: aByteArray 
	^ Form
	extent: 16@16
	depth: 32
	fromArray: aByteArray 
	offset: 0@0! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:41'!
windowMaximizeForm
	^ self form16x16FromContents: self windowMaximizeFormContents ! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:22'!
checkboxMarkerForm
	"Answer a new radio button marker form. We make it empty because we already have the selected radio button take care of the state."

	^Form extent: 12@12 depth: 32! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/27/2010 15:14'!
radioSelectedForm
	^ Form fromBinaryStream: ( Base64MimeConverter mimeDecodeToBytes: self radioSelectedFormContents readStream)
 ! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:52'!
windowMenuForm
	^self form16x16FromContents: self windowMenuFormContents ! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/27/2010 15:14'!
radioUnselectedForm
	^ Form fromBinaryStream: ( Base64MimeConverter mimeDecodeToBytes: self radioUnselectedFormContents readStream)
 ! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 14:10'!
checkboxSelectedForm
	^ self form16x16FromContents: self checkboxSelectedFormContents 
! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:27'!
radioButtonUnselectedFormContents
	^#( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 50331648 0 0 50331648 0 0 0 0 0 0 0 0 0 0 0 1023410176 3238002688 3909091328 3909091328 3238002688 1023410176 0 0 0 0 0 0 0 0 0 2097152000 3976200192 1275068416 452984832 452984832 1275068416 3976200192 872415232 0 0 0 0 0 0 0 1023410176 4278190080 335544320 0 0 0 0 335544320 4278190080 1023410176 0 0 0 0 0 50331648 3238002688 1275068416 0 0 0 0 0 0 1275068416 3238002688 50331648 0 0 0 0 0 3909091328 452984832 0 0 0 0 0 0 452984832 3909091328 0 0 0 0 0 0 3909091328 452984832 0 0 0 0 0 0 452984832 3909091328 0 0 0 0 0 33554432 3238002688 1275068416 0 0 0 0 0 0 1275068416 3238002688 50331648 0 0 0 0 0 1006632960 3992977408 335544320 0 0 0 0 335544320 4278190080 1023410176 0 0 0 0 0 0 0 2097152000 4278190080 1275068416 452984832 452984832 1275068416 3976200192 2097152000 0 0 0 0 0 0 0 0 0 1006632960 3238002688 3909091328 3909091328 3238002688 1023410176 0 0 0 0 0 0 0 0 0 0 0 33554432 0 0 50331648 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 09:11'!
radioButtonMarkerForm
	"Answer a new radio button marker form. We make it empty because we already have the selected radio button take care of the state."

	^Form extent: 12@12 depth: 32! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:41'!
windowMenuInactiveForm
	^self form16x16FromContents: self windowMenuInactiveFormContents ! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:09'!
windowMinimizeFormContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 0 0 0 0 0 0 0 0 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!GLMThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:42'!
windowMinimizeInactiveForm
	^self form16x16FromContents: self windowMinimizeInactiveFormContents ! !

!GLMTransmission commentStamp: 'DamienCassou 7/19/2011 16:53'!
A GLMTransmission models the connection between multiple origin ports and one destination port. Whenever an origin port changes the value, the corresponding transmissions are triggered by the browser.

The result of triggering a transmission is the setting of the value in the destination port. The transmissionStrategy can add further different semantics to this behavior.

A transmission takes place in a context. The context is started every time a new value is set from outside. Afterwards, the context is preserved internally. This is important for braking possible loops of transmission propagation.

There are two kind of origins for a transmission, active and passive ones. A change of value in an active origin will trigger the transmissions originating from it. A change of value in a passive origin will not trigger the transmission. However, a value in a passive origin is still part of the transmission value.!
!GLMTransmission methodsFor: 'testing' stamp: 'tg 1/31/2010 01:28'!
originatesAt: aPort
	^ (self activeOrigins includes: aPort) and: [self meetsCondition]! !

!GLMTransmission methodsFor: 'transmitting' stamp: 'tg 1/14/2010 13:09'!
transmit
	self transmitIn: GLMTransmissionContext new! !

!GLMTransmission methodsFor: 'accessing' stamp: 'tg 1/14/2010 12:20'!
origins
	^ self originReferences collect: [:each | each port]! !

!GLMTransmission methodsFor: 'scripting' stamp: 'tg 1/14/2010 23:26'!
from: aPort transformed: aBlock
	^ (self addActiveOrigin: (self browser resolveOriginPort: aPort)) transformation: aBlock! !

!GLMTransmission methodsFor: 'initialize-release' stamp: 'tg 5/24/2010 17:19'!
initialize
	super initialize.
	transmissionStrategy := GLMNoStrategy new.
	condition := true! !

!GLMTransmission methodsFor: 'accessing' stamp: 'DamienCassou 7/9/2011 20:19'!
ensureReplacePresentationsStrategy
	self transmissionStrategy class = GLMReplacePresentationsStrategy ifFalse: [
		self transmissionStrategy: (GLMReplacePresentationsStrategy of: self) ]! !

!GLMTransmission methodsFor: 'transmitting' stamp: 'AndreiChis 8/11/2013 18:40'!
value
	<debuggingStone: #transmissionTransformation label: 'Transmission transformation'>
	| originalValue |
	originalValue := self originReferences size = 1 
		ifTrue: [ self originReferences first value ] 
		ifFalse: [ GLMMultiValue withAll: (self originReferences collect: [:each | each value]) ].
	^ self transformation isNil 
		ifTrue: [ originalValue ] 
		ifFalse: [ self transformation glamourValue: originalValue ]! !

!GLMTransmission methodsFor: 'accessing' stamp: 'tg 1/5/2010 14:52'!
browser
	^ browser! !

!GLMTransmission methodsFor: 'accessing' stamp: 'tg 1/14/2010 16:07'!
addActiveOrigin: aPort 
	^ self originReferences 
		add: 
			((GLMOriginPortReference new) 
				port: aPort; 
				beActive; 
				yourself)! !

!GLMTransmission methodsFor: 'scripting' stamp: 'TudorGirba 5/20/2012 00:55'!
toOutside: aPortSymbol
	self deprecated: 'Use toOutsidePort: instead'.
	^ self toOutsidePort: aPortSymbol! !

!GLMTransmission methodsFor: 'scripting' stamp: 'DamienCassou 7/20/2011 07:42'!
whenKindOf: aClass 
	 
	self when: [:each | each isKindOf: aClass]! !

!GLMTransmission methodsFor: 'accessing' stamp: 'tg 12/30/2009 02:07'!
destination 
	 
	^destination! !

!GLMTransmission methodsFor: 'scripting' stamp: 'TudorGirba 10/2/2011 21:40'!
fromOutsideEntityPortTransformed: aBlock
	^ self fromOutsidePort: #entity transformed: aBlock! !

!GLMTransmission methodsFor: 'scripting' stamp: 'TudorGirba 5/1/2011 01:57'!
to: aPort
	"Ideally this method would be implemented as
	^ self to: aPaneSymbol port: #entiity.
	
	The problem is that beforehand we only had from: which could receive either a symbol for the pane, or an association for the port. This was bad, and now Glamour offers to:port:, but there are still legacy cases of to: being called with an association."

	^ self destination: (self browser resolveDestinationPort: aPort)! !

!GLMTransmission methodsFor: 'accessing' stamp: 'tg 1/5/2010 14:52'!
browser: anObject
	browser := anObject! !

!GLMTransmission methodsFor: 'scripting' stamp: 'TudorGirba 5/1/2011 01:56'!
from: aPort
	"Ideally this method would be implemented as
	^ self from: aPaneSymbol port: #selection.
	
	The problem is that beforehand we only had from: which could receive either a symbol for the pane, or an association for the port. This was bad, and now Glamour offers from:port:, but there are still legacy cases of from: being called with an association."

	^ self addActiveOrigin: (self browser resolveOriginPort: aPort)! !

!GLMTransmission methodsFor: 'accessing' stamp: 'tg 1/14/2010 16:43'!
transmissionStrategy
	^ transmissionStrategy! !

!GLMTransmission methodsFor: 'accessing' stamp: 'tg 1/14/2010 17:11'!
presentations
	^ self transmissionStrategy presentations! !

!GLMTransmission methodsFor: 'scripting' stamp: 'DamienCassou 7/10/2011 10:53'!
fromOutsidePort: aPortSymbol
	^ self from: #outer port: aPortSymbol! !

!GLMTransmission methodsFor: 'transmitting' stamp: 'TudorGirba 4/22/2012 23:09'!
transmitIn: aContext
	self flag: 'The transmitIt: and receive:in: both end up calling notingPresentationChangeDo:. So they should be handled by a surrounding notingPresentationChangeDo:. However, by doing that it seems that we break the morphic updating. No idea why'.
	self destination notingPresentationChangeDo: [
		self transmissionStrategy transmitIn: aContext.
		self destination receive: self in: aContext ].
	self browser notNil ifTrue: [
		self browser announce: GLMTransmissionTriggered new ]! !

!GLMTransmission methodsFor: 'accessing' stamp: 'tg 1/14/2010 16:53'!
addPresentation: aPresentation
	self transmissionStrategy addPresentation: aPresentation! !

!GLMTransmission methodsFor: 'copying' stamp: 'AndreiChis 5/29/2013 13:38'!
postCopy
	origins := self originReferences collect: [:each | each copy ].
	destination := destination copy.
	transmissionStrategy := transmissionStrategy copy.
	transmissionStrategy transmission: self! !

!GLMTransmission methodsFor: 'accessing' stamp: 'tg 1/14/2010 17:07'!
addPresentations: aCollection
	self transmissionStrategy addPresentations: aCollection! !

!GLMTransmission methodsFor: 'copying' stamp: 'tg 12/30/2009 02:06'!
changePortsAccordingToPaneMapping: newPanesMapping
	"newPanesMapping is a dictionary with 
	keys given by old panes and values by new panes"
	self destination: ((newPanesMapping at: self destination pane) port: self destination name).
! !

!GLMTransmission methodsFor: 'scripting' stamp: 'TudorGirba 2/23/2011 23:53'!
from: aPaneSymbol port: aPortSymbol transformed: aBlock
	^ (self from: (GLMPortIdentifier pane: aPaneSymbol port: aPortSymbol)) transformation: aBlock! !

!GLMTransmission methodsFor: 'transmitting' stamp: 'jre 9/18/2009 19:17'!
context
	 context ifNil: [context := OrderedCollection new].
	^context! !

!GLMTransmission methodsFor: 'accessing' stamp: 'tg 1/31/2010 01:22'!
condition: anObject
	condition := anObject! !

!GLMTransmission methodsFor: 'accessing' stamp: 'tg 1/14/2010 16:14'!
transformation: anObject 
	 
	transformation := anObject! !

!GLMTransmission methodsFor: 'scripting' stamp: 'DamienCassou 7/21/2011 10:48'!
passivelyFrom: aPaneSymbol port: aPortSymbol
	^ self passivelyFrom: (GLMPortIdentifier pane: aPaneSymbol port: aPortSymbol)! !

!GLMTransmission methodsFor: 'scripting' stamp: 'TudorGirba 5/20/2012 00:55'!
fromOutside: aPortSymbol
	self deprecated: 'Use fromOutsidePort: instead'.
	^ self fromOutsidePort: aPortSymbol! !

!GLMTransmission methodsFor: 'scripting' stamp: 'TudorGirba 10/2/2011 21:39'!
fromOutsideEntityPort
	^ self fromOutsidePort: #entity! !

!GLMTransmission methodsFor: 'accessing' stamp: 'tg 1/14/2010 12:24'!
activeOrigins 
	 
	^(self originReferences select: [:each | each isActive]) 
		collect: [:each | each port]! !

!GLMTransmission methodsFor: 'copying' stamp: 'lr 6/4/2010 14:04'!
changePortsAccordingToPaneMapping: newPanesMapping fromOldBrowser: aBrowser toNewBrowser: anotherBrowser
	| newPort |
	"newPanesMapping is a dictionary with 
	keys given by old panes and values by new panes"
	self destination: (self destination copyAccordingToPaneMapping: newPanesMapping inNewBrowser: anotherBrowser).
	self originReferences do: [:each | 
		newPort := each port copyAccordingToPaneMapping: newPanesMapping inNewBrowser: anotherBrowser.
		each port: newPort ]! !

!GLMTransmission methodsFor: 'accessing' stamp: 'tg 12/30/2009 02:07'!
destination: aPort 
	 
	destination := aPort! !

!GLMTransmission methodsFor: 'scripting' stamp: 'tg 2/20/2010 18:21'!
passivelyFrom: aPort
	^ self addPassiveOrigin: (self browser resolveOriginPort: aPort)! !

!GLMTransmission methodsFor: 'private accessing' stamp: 'DamienCassou 7/9/2011 22:43'!
originReferences
	"Returns the set of ports (instances of PortReference) the transmission receives its data from"
	^ origins ifNil: [origins := OrderedCollection new]! !

!GLMTransmission methodsFor: 'scripting' stamp: 'tg 1/31/2010 01:52'!
transformed: aBlock
	self transformation: aBlock! !

!GLMTransmission methodsFor: 'accessing' stamp: 'tg 1/31/2010 01:39'!
condition
	^ condition! !

!GLMTransmission methodsFor: 'transmitting' stamp: 'TudorGirba 4/18/2011 19:52'!
printOn: aStream 
	 
	aStream 
		nextPutAll: self class name;
		nextPutAll: ' (origins='; 
		nextPutAll: self origins printString; 
		nextPutAll: ' destination='; 
		nextPutAll: self destination printString; 
		nextPut: $)
	 
	! !

!GLMTransmission methodsFor: 'scripting' stamp: 'TudorGirba 5/20/2012 00:51'!
toWatcher
	""
	^ self destination: (self browser watcherPane port: #entity)! !

!GLMTransmission methodsFor: 'accessing' stamp: 'tg 1/15/2010 02:50'!
presentations: aCompositePresentation
	self transmissionStrategy presentations: aCompositePresentation! !

!GLMTransmission methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 7/29/2014 11:07'!
gtDisplayOn: stream
	self origins asArray gtDisplayOn: stream.
	stream nextPutAll: '->'.
	self destination gtDisplayOn: stream! !

!GLMTransmission methodsFor: 'scripting' stamp: 'TudorGirba 10/2/2011 21:40'!
fromOutsidePort: aPortSymbol transformed: aBlock
	^ self from: #outer port: aPortSymbol transformed: aBlock! !

!GLMTransmission methodsFor: 'accessing' stamp: 'tg 1/14/2010 16:07'!
addPassiveOrigin: aPort
	^ self originReferences 
		add: 
			((GLMOriginPortReference new) 
				port: aPort; 
				bePassive; 
				yourself)! !

!GLMTransmission methodsFor: 'transmitting' stamp: 'jre 9/18/2009 19:46'!
context: aContext
	 context := aContext! !

!GLMTransmission methodsFor: 'scripting' stamp: 'tg 11/3/2010 13:37'!
from: aPaneSymbol port: aPortSymbol
	^ self from: (GLMPortIdentifier pane: aPaneSymbol port: aPortSymbol)! !

!GLMTransmission methodsFor: 'scripting' stamp: 'AndreiChis 5/29/2013 12:57'!
andShow: aBlock
	"This method accepts a block with one argument.
	The block will be evaluated with an instance of GLMCompositePresentation.
	
	The block should construct the presentations that go in the composite presentation.
	The composite presentation will be the one that will get installed in the target pane
	once the transmission triggers.

	This method is meant to be used in a Glamour script.
	"
	
	self ensureReplacePresentationsStrategy.
	self transmissionStrategy presentationsFactory: aBlock.
	self origins isEmpty
		ifTrue: [ self from: #outer port: #entity ]! !

!GLMTransmission methodsFor: 'scripting' stamp: 'AndreiChis 5/29/2013 12:59'!
andShowIfNone: aBlock
	"This method accepts a block with one argument. 
	The block will be evaluated with an instance of GLMCompositePresentation.
	
	The block should construct the presentations that go in the composite presentation.
	The composite presentation will be the one that will get installed in the target pane
	once the transmission triggers.
	
	The particularity of this method is that the presentation will get installed in the target
	pane only if the target pane has no presentation already.

	This method is meant to be used in a Glamour script.
	"

	self ensurePresentIfNoneStrategy.
	self transmissionStrategy presentationsFactory: aBlock.
	self origins isEmpty
		ifTrue: [ self from: #outer port: #entity ]! !

!GLMTransmission methodsFor: 'scripting' stamp: 'tg 1/31/2010 01:44'!
when: aBlock
	self condition: aBlock! !

!GLMTransmission methodsFor: 'accessing' stamp: 'tg 1/14/2010 16:44'!
transmissionStrategy: anObject
	transmissionStrategy := anObject! !

!GLMTransmission methodsFor: 'accessing' stamp: 'tg 1/14/2010 16:25'!
transformation
	^ transformation! !

!GLMTransmission methodsFor: 'scripting' stamp: 'TudorGirba 12/2/2010 20:09'!
toOutsidePort: aPortSymbol
	^ self to: #outer->aPortSymbol! !

!GLMTransmission methodsFor: 'scripting' stamp: 'tg 11/3/2010 13:36'!
to: aPaneSymbol port: aPortSymbol
	^ self to: (GLMPortIdentifier pane: aPaneSymbol port: aPortSymbol)! !

!GLMTransmission methodsFor: 'accessing' stamp: 'tg 1/14/2010 12:23'!
passiveOrigins 
	 
	^(self originReferences select: [:each | each isPassive]) 
		collect: [:each | each port]! !

!GLMTransmission methodsFor: 'accessing' stamp: 'DamienCassou 7/9/2011 20:20'!
ensurePresentIfNoneStrategy
	self transmissionStrategy class = GLMPresentIfNoneStrategy ifFalse: [
		self transmissionStrategy: (GLMPresentIfNoneStrategy of: self) ]! !

!GLMTransmission methodsFor: 'testing' stamp: 'AndreiChis 8/11/2013 18:40'!
meetsCondition
	<debuggingStone: #transmissionCondition label: 'Transmission condition'>
	| originValues |
	originValues := self originReferences size = 1 
		ifTrue: [ self originReferences first value ] 
		ifFalse: [ GLMMultiValue withAll: (self originReferences collect: [:each | each value]) ].
	^ self condition glamourValue: originValues! !

!GLMTransmissionContext commentStamp: 'DamienCassou 7/9/2011 23:44'!
This class models the context in which a set of transmissions take place. In essence, it records all ports that were reached after an outside event. 
 
That is necessary for ensuring that transmissions do not get propagated forever. When the first transmission is triggered, a context is created and this context will then store all ports that any subsequent transmission touches. This info is used to break possible cycles

Instance Variables
	ports:		Collection of Ports!
!GLMTransmissionContext methodsFor: 'accessing' stamp: 'TudorGirba 7/21/2011 13:43'!
addPort: aPort
	self ports add: aPort! !

!GLMTransmissionContext methodsFor: 'accessing' stamp: 'tg 12/19/2009 00:19'!
forbiddenAnnouncements: anObject
	forbiddenAnnouncements := anObject! !

!GLMTransmissionContext methodsFor: 'accessing' stamp: 'tg 12/19/2009 00:22'!
forbidToAnnounceMatchingPresentationsChanged: aPane
	self forbid: aPane toAnnounce: GLMMatchingPresentationsChanged! !

!GLMTransmissionContext methodsFor: 'accessing' stamp: 'tg 12/19/2009 00:20'!
forbiddenAnnouncements
	"forbiddenAnnouncements holds a dictionary in which the key is a pane and the value is a collection of announcements"
	^ forbiddenAnnouncements ifNil: [forbiddenAnnouncements := IdentityDictionary new]! !

!GLMTransmissionContext methodsFor: 'accessing' stamp: 'tg 12/19/2009 00:25'!
canAnnounceMatchingPresentationsChanged: aPane
	^ self can: aPane announce: GLMMatchingPresentationsChanged! !

!GLMTransmissionContext methodsFor: 'accessing' stamp: 'tg 12/19/2009 00:21'!
forbid: aPane toAnnounce: anAnnouncement
	(self forbiddenAnnouncements at: aPane ifAbsentPut: [Set new])
		add: anAnnouncement! !

!GLMTransmissionContext methodsFor: 'accessing' stamp: 'tg 12/19/2009 00:23'!
canAnnouncePresentationsChanged: aPane
	self can: aPane announce: GLMPresentationsChanged! !

!GLMTransmissionContext methodsFor: 'testing' stamp: 'TudorGirba 7/21/2011 13:46'!
includesPort: aPort
	^ self ports includes: aPort! !

!GLMTransmissionContext methodsFor: 'accessing' stamp: 'tg 12/18/2009 23:33'!
ports
	^ ports ifNil: [ports := OrderedCollection new]! !

!GLMTransmissionContext methodsFor: 'accessing' stamp: 'tg 12/19/2009 00:26'!
can: aPane announce: anAnnouncement
	^ ((self forbiddenAnnouncements at: aPane ifAbsent: [Set new])
		includes: anAnnouncement ) not! !

!GLMTransmissionContext methodsFor: 'accessing' stamp: 'tg 12/18/2009 23:32'!
ports: anObject
	ports := anObject! !

!GLMTransmissionContext methodsFor: 'copying' stamp: 'TudorGirba 7/9/2011 23:54'!
postCopy
	ports := ports copy! !

!GLMTransmissionContext methodsFor: 'printing' stamp: 'TudorGirba 7/21/2011 13:39'!
printOn: aStream 
	super printOn: aStream.
	aStream nextPut: $(.
	ports printOn: aStream.
	aStream nextPut: $)
! !

!GLMTransmissionContext methodsFor: 'accessing' stamp: 'tg 12/19/2009 00:22'!
forbidToAnnouncePresentationsChanged: aPane
	self forbid: aPane toAnnounce: GLMPresentationsChanged! !

!GLMTransmissionContextTest methodsFor: 'tests' stamp: 'tg 12/19/2009 00:26'!
testForbiddenAnnouncements
	| context pane |
	context := GLMTransmissionContext new.
	pane := GLMPane new.
	self assert: (context canAnnounceMatchingPresentationsChanged: pane).
	context forbidToAnnounceMatchingPresentationsChanged: pane.
	self assert: (context canAnnounceMatchingPresentationsChanged: pane) not! !

!GLMTransmissionContextTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testCopy
	| context copy |
	context := GLMTransmissionContext new.
	context addPort: GLMSimplePort new.
	copy := context copy.
	self assert: copy ~~ context.
	self assert: copy ports equals: context ports.
	self assert: copy ports ~~ context ports! !

!GLMTransmissionContextTest methodsFor: 'tests' stamp: 'tg 12/19/2009 00:07'!
testInclues
	| context port |
	port := GLMSimplePort new.
	context := GLMTransmissionContext new.
	context addPort: port.
	self assert: (context includesPort: port)! !

!GLMTransmissionScriptingTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testFrom
	browser transmit from: #one.
	self assert: browser transmissions first origins first pane equals: browser panes first.
	self assert: browser transmissions first origins first name equals: GLMPortIdentifier defaultOriginPortName! !

!GLMTransmissionScriptingTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testFromPort
	browser transmit from: #one port: #port.
	self assert: browser transmissions first origins first pane equals: browser panes first.
	self assert: browser transmissions first origins first name equals: #port! !

!GLMTransmissionScriptingTest methodsFor: 'tests' stamp: 'TudorGirba 5/21/2012 00:04'!
testToWatcher
	browser transmit toWatcher.
	self assert: browser transmissions first destination pane equals: browser watcherPane! !

!GLMTransmissionScriptingTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testTo
	browser transmit to: #one.
	self assert: browser transmissions first destination pane equals: browser panes first.
	self assert: browser transmissions first destination name equals: GLMPortIdentifier defaultTargetPortName! !

!GLMTransmissionScriptingTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testToPort
	browser transmit to: #one port: #port.
	self assert: browser transmissions first destination pane equals: browser panes first.
	self assert: browser transmissions first destination name equals: #port! !

!GLMTransmissionScriptingTest methodsFor: 'running' stamp: 'tg 11/3/2010 13:23'!
setUp
	browser := GLMExplicitBrowser new.
	browser addPane: (GLMPane new name: #one).
	browser addPane: (GLMPane new name: #two).
	browser addPane: (GLMPane new name: #three).
! !

!GLMTransmissionStrategy commentStamp: 'tg 2/20/2010 14:45'!
The classes from this hierarchy define strategies for what should happen after the value have been set to the destination port.!
!GLMTransmissionStrategy methodsFor: 'accessing' stamp: 'tg 1/14/2010 17:07'!
addPresentations: aCollection
	"do nothing by default"! !

!GLMTransmissionStrategy methodsFor: 'accessing' stamp: 'tg 1/14/2010 17:11'!
presentations
	^ OrderedCollection new! !

!GLMTransmissionStrategy methodsFor: 'transmitting' stamp: 'tg 2/20/2010 14:05'!
transmitIn: aContext
	"override this method to add the desired semantics"
	self subclassResponsibility! !

!GLMTransmissionStrategy methodsFor: 'accessing' stamp: 'tg 1/14/2010 15:44'!
transmission
	^ transmission! !

!GLMTransmissionStrategy methodsFor: 'accessing' stamp: 'tg 1/14/2010 16:53'!
addPresentation: aPresentation
	"do nothing by default"! !

!GLMTransmissionStrategy methodsFor: 'accessing' stamp: 'tg 1/14/2010 15:44'!
transmission: anObject
	transmission := anObject! !

!GLMTransmissionStrategy class methodsFor: 'instance creation' stamp: 'tg 1/14/2010 15:45'!
of: aTransmission
	^ self new transmission: aTransmission; yourself! !

!GLMTransmissionTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testDefaultStrategy
	self assert: GLMTransmission new transmissionStrategy class equals: GLMNoStrategy! !

!GLMTransmissionTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testNoOverrideStrategy
	| pane1 pane2 transmission presentation |
	pane1 := GLMPane named: 'pane1'.
	pane2 := GLMPane named: 'pane2'.
	transmission := GLMTransmission new.
	transmission ensurePresentIfNoneStrategy.
	transmission addActiveOrigin: (pane1 port: #port1).
	transmission destination: (pane2 port: #port2).
	transmission addPresentation: GLMPresentation new.
	self assert: transmission presentations size equals: 1.
	self assert: transmission destination pane == pane2.
	self assert: transmission transmissionStrategy transmission == transmission.
	(pane1 port: #port1) value: 1.
	transmission transmit.
	self assert: pane2 presentations size equals: 1.
	presentation := pane2 presentations first.
	self assert: transmission destination pane == pane2.
	(pane1 port: #port1) value: 2.
	transmission transmit.
	self assert: pane2 presentations first rootPrototype equals: presentation rootPrototype.
	self assert: pane2 presentations first == presentation! !

!GLMTransmissionTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testWhenCondition
	"Tests that the transmission is triggered only when the origin changes."

	| transmission port1 port2 |
	transmission := GLMTransmission new.
	port1 := (GLMSimplePort new)
		name: #port1;
		value: #value1.
	port2 := GLMSimplePort new name: #port2.
	transmission addActiveOrigin: port1.
	transmission destination: port2.
	transmission condition: [ :entity | entity = #value1 ].
	self assert: transmission meetsCondition.
	transmission transmit.
	self assert: port2 value equals: #value1! !

!GLMTransmissionTest methodsFor: 'tests' stamp: 'tg 1/17/2010 16:15'!
testTriggerConditionsWithParentPort 
	| transmission presentation | 
	transmission := GLMTransmission new. 
	presentation := GLMPresentation new. 
	transmission addActiveOrigin: 
			((GLMPresentationBoundPort new) 
				presentation: presentation; 
				name: #port1; 
				yourself). 
	self assert: (transmission originatesAt: 
					((GLMPresentationBoundPort new) 
						presentation: presentation; 
						name: #port1; 
						yourself)). 
	self assert: (transmission originatesAt: (presentation pane port: #port1))! !

!GLMTransmissionTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 17:50'!
testCopy
	| transmission port1 port2 newTransmission |
	transmission := GLMTransmission new.
	port1 := GLMSimplePort new.
	port2 := GLMSimplePort new.
	transmission destination: port2.
	transmission addActiveOrigin: port1.
	newTransmission := transmission copy.
	self assert: newTransmission destination ~~ transmission destination.
	self assert: newTransmission origins first ~~ transmission origins first.! !

!GLMTransmissionTest methodsFor: 'tests' stamp: 'tg 1/31/2010 01:40'!
testTriggerConditions 
	"Tests that the transmission is triggered only when the origin changes." 
	
	| transmission port1 port2 | 
	transmission := GLMTransmission new. 
	port1 := GLMSimplePort new name: #port1. 
	port2 := GLMSimplePort new name: #port2. 
	transmission addActiveOrigin: port1. 
	transmission destination: port2. 
	self assert: (transmission originatesAt: port1). 
	self assert: (transmission originatesAt: port2) not. 
	self assert: (transmission originatesAt: GLMPort new) not! !

!GLMTransmissionTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testSimple
	| pane1 pane2 transmission |
	pane1 := GLMPane named: 'test1'.
	pane2 := GLMPane named: 'test2'.
	transmission := (GLMTransmission new)
		addActiveOrigin: (pane1 port: #output);
		destination: (pane2 port: #input);
		yourself.
	(pane1 port: #output) value: 42.
	self assert: (pane1 port: #output) value equals: 42.
	self assert: (pane2 port: #input) value equals: nil.
	transmission transmit.
	self assert: (pane1 port: #output) value equals: 42.
	self assert: (pane2 port: #input) value equals: 42! !

!GLMTransmissionTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testBundleStrategy
	| pane1 pane2 transmission presentation |
	pane1 := GLMPane named: 'pane1'.
	pane2 := GLMPane named: 'pane2'.
	transmission := GLMTransmission new.
	transmission ensureReplacePresentationsStrategy.	"ensureNoOverrideBundleStrategy"
	transmission addActiveOrigin: (pane1 port: #port1).
	transmission destination: (pane2 port: #port2).
	transmission addPresentation: GLMPresentation new.
	(pane1 port: #port1) value: 1.
	transmission transmit.
	self assert: pane2 presentations size equals: 1.
	presentation := pane2 presentations first.
	(pane1 port: #port1) value: 2.
	transmission transmit.
	self assert: pane2 presentations first rootPrototype equals: presentation rootPrototype.
	self assert: pane2 presentations first ~~ presentation! !

!GLMTransmissionTriggered commentStamp: '<historical>'!
A GLMTransmissionTriggered is announced by a browser when a transmission brokered by the browser is triggered.!
!GLMTreeBrick methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/13/2015 16:02'!
collapsableFor: anObject
	|collapsable|
	
	collapsable := GLMCollapsableBrick new.
	collapsable
		vShrinkWrap;
		hSpaceFill.
	
	collapsable headerBrick: (self headerFor: anObject in: collapsable).
	(self hasChildren: anObject)
		ifTrue: [
			collapsable contentBrick: (self class new on: anObject value).
			collapsable contentBrick
				vShrinkWrap;
				hSpaceFill;
				marginLeft: 19 ].
	collapsable expand.
	^ collapsable! !

!GLMTreeBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 2/12/2015 23:07'!
on: anObject
	"{ 'first'-> { 'sub 1' -> '11' . 'sub 2' -> '12' } }"
	
	self removeAllBricks.
	(anObject isCollection & anObject isString not)
		ifFalse: [ self addBrickBack: (self collapsableFor: anObject) ]
		ifTrue: [ anObject do: [ :each | self addBrickBack: (self collapsableFor: each) ] ].
	
	! !

!GLMTreeBrick methodsFor: 'protocol' stamp: 'AliakseiSyrel 2/12/2015 22:55'!
hasChildren: anObject

	anObject ifNil: [ ^ false ].
	anObject isVariableBinding ifFalse: [ ^ false ].
	anObject value ifNil: [ ^ false ].
	anObject value isCollection ifTrue: [ ^ anObject value isEmpty not ].
	^ true! !

!GLMTreeBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 3/22/2015 11:52'!
newToggleButtonFor: aCollapsable

	^ (GLMActionButtonBrick new
			icon: GLMUIThemeExtraIcons glamorousRight;
			checkedImage: GLMUIThemeExtraIcons glamorousDown;
			height: [ :b | b icon height * 1.2 ];
			width: [ :b | b icon width * 1.2 ];
			action: [ :b | 
				aCollapsable toggle.
				aCollapsable isExpanded
					ifTrue: [ b check ]
					ifFalse: [ b uncheck ] ])! !

!GLMTreeBrick methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/12/2015 20:26'!
headerFor: anObject in: aCollapsable
	|header|
	
	header := GLMBrick new.
	header
		hSpaceFill;
		vShrinkWrap.
		
	header addBrickBack:
		((anObject isVariableBinding
			ifTrue: [ anObject key asBrick ]
			ifFalse: [ anObject asBrick ])
				hSpaceFill).
				
	(self hasChildren: anObject) ifTrue: [
		header addBrickFirst: (self newToggleButtonFor: aCollapsable) ].
	
	^ header! !

!GLMTreeBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:51'!
exampleOpen
	
	self gtExample openInBrickWindowLabeled: 'Tree Example'
	! !

!GLMTreeBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:20'!
gtExample
	<gtExample: 'Simple tree with a few elements'>
	
	^ self new
		hSpaceFill;
		vShrinkWrap;
		on: {
			'First' -> '1'.
			'Second' -> '2'.
			'Third' -> { 
				'Sub First' -> '3-1'.
				'Sub Second' -> '3-2' } }
	! !

!GLMTreeMorphModel commentStamp: 'alain.plantec 9/8/2009 15:22'!
ClassTree new openOn: Collection
!
!GLMTreeMorphModel methodsFor: 'drag and drop' stamp: 'TudorGirba 1/3/2012 00:06'!
acceptDroppingMorph: transferMorph event: evt inMorph: listMorph 
	| targetItem |
	targetItem := (listMorph scrollerSubMorphFromPoint: evt position) complexContents item.	
	^ self glamourPresentation accept: transferMorph passenger droppedOnItem: targetItem! !

!GLMTreeMorphModel methodsFor: 'search and filtering' stamp: 'tg 9/30/2009 14:01'!
shouldFilterByAmount
	^ self amountToFilterBy notNil and: [self amountToFilterBy isZero not]! !

!GLMTreeMorphModel methodsFor: 'search and filtering' stamp: 'tg 8/18/2010 16:38'!
executeSearch
	| newSelection check |
	newSelection := OrderedCollection new.
	roots do: [ :each | 
		check := self glamourPresentation searchStrategy value: self inputText value: each item.
		check ifTrue: [newSelection add: each path]].
	newSelection isEmpty 
		ifFalse: [ self selection: (MorphTreeMorphMultipleSelection new selectedNodePathList: newSelection) ]
		ifTrue: [self selection: nil]! !

!GLMTreeMorphModel methodsFor: 'private selecting' stamp: 'tg 1/11/2010 22:02'!
explicitlySelectMultipleItems: aCollection 
	| newSelection collection|
	aCollection isNil ifTrue: [^ self].
	collection := aCollection isCollection ifTrue: [aCollection] ifFalse: [aCollection asOrderedCollection ].
	(self selection notNil and: [
		self selection selectedItemOrItemsOrNil = collection asOrderedCollection ]) ifTrue: [ ^ self ].
	newSelection := OrderedCollection new.
	self roots do: [:eachRoot |
		eachRoot withContentsDo: [:each |
			(collection includes: each item) ifTrue: [
				newSelection add: each path ]]].
	self selectAllNodePaths: newSelection! !

!GLMTreeMorphModel methodsFor: 'accessing' stamp: 'EstebanLorenzano 2/13/2012 13:20'!
rootNodes
	^self roots! !

!GLMTreeMorphModel methodsFor: 'accessing' stamp: 'tg 9/13/2009 03:28'!
childrenBlock: aBlock
	childrenBlock := aBlock ! !

!GLMTreeMorphModel methodsFor: 'announcements' stamp: 'tg 9/11/2009 00:17'!
announce: anAnnouncement
	self announcer announce: anAnnouncement ! !

!GLMTreeMorphModel methodsFor: 'search and filtering' stamp: 'tg 9/28/2009 00:11'!
doSearchOrFilter
	inputText isEmptyOrNil
		ifTrue: [ self resetInput ]
		ifFalse:[ 
			self glamourPresentation allowsFilter 
				ifTrue: [ self executeFilter ]
				ifFalse: [ self executeSearch ] ].
! !

!GLMTreeMorphModel methodsFor: 'callbacks' stamp: 'tg 9/13/2009 03:59'!
tagsToFilterBy
	^ tagsToFilterBy ifNil: [ tagsToFilterBy := OrderedCollection new ]! !

!GLMTreeMorphModel methodsFor: 'drag and drop' stamp: 'TudorGirba 1/3/2012 08:36'!
dropEnabled
	^ self glamourPresentation isDropTarget! !

!GLMTreeMorphModel methodsFor: 'accessing' stamp: 'tg 11/29/2009 02:37'!
selectionPathItems
	^ self selectedNodePath isNil ifTrue: [nil] ifFalse: [self selectedNodePath collect: [:each | each item]]! !

!GLMTreeMorphModel methodsFor: 'drag and drop' stamp: 'TudorGirba 1/2/2012 03:07'!
dragTransferTypeForMorph: listMorph
	^ self dragTransferType! !

!GLMTreeMorphModel methodsFor: 'stepping' stamp: 'AndreiChis 3/16/2015 17:01'!
forceStopStepping
	stopStepping := true.
	self changed.! !

!GLMTreeMorphModel methodsFor: 'stepping' stamp: 'AndreiChis 3/16/2015 16:47'!
stepTime
	^ self glamourPresentation stepTime! !

!GLMTreeMorphModel methodsFor: 'accessing' stamp: 'tg 1/18/2010 23:59'!
amountToFilterBy
	^ nil "amountToFilterBy ifNil: [self glamourPresentation amountToShow]"! !

!GLMTreeMorphModel methodsFor: 'accessing' stamp: 'AndreiChis 6/13/2014 12:32'!
displayValue
	
	^ columnToSortBy 
		ifNil: [self glamourPresentation displayValue]
		ifNotNil: [self glamourPresentation displayValue sorted: self sortBlock]! !

!GLMTreeMorphModel methodsFor: 'search and filtering' stamp: 'TudorGirba 5/22/2013 13:34'!
resetInput
	self updateRoots! !

!GLMTreeMorphModel methodsFor: 'search and filtering' stamp: 'tg 11/13/2009 02:10'!
shouldFilterByTextInput
	^ self glamourPresentation allowsFilter and: [ self inputText notEmpty ]! !

!GLMTreeMorphModel methodsFor: 'accessing' stamp: 'TudorGirba 8/25/2013 22:46'!
roots: anObjectOrCollection
	roots := anObjectOrCollection asOrderedCollection 
				collect: [:each | self nodeModelFor: each ]! !

!GLMTreeMorphModel methodsFor: 'accessing' stamp: 'tg 9/28/2009 01:24'!
inputText
	^ inputText ifNil: [inputText := '']! !

!GLMTreeMorphModel methodsFor: 'accessing' stamp: 'tg 9/8/2009 19:46'!
glamourPresentation: anObject
	glamourPresentation := anObject! !

!GLMTreeMorphModel methodsFor: 'drag and drop' stamp: 'TudorGirba 1/2/2012 03:07'!
dragTransferType
	^ #Glamour! !

!GLMTreeMorphModel methodsFor: 'callbacks' stamp: 'AlainPlantec 5/28/2012 07:35'!
resetTagsToFilterBy
	tagsToFilterBy := OrderedCollection new.
	self changed: #rootNodes.! !

!GLMTreeMorphModel methodsFor: 'accessing' stamp: 'tg 1/19/2010 00:12'!
defaultPageSize
	^ defaultPageSize! !

!GLMTreeMorphModel methodsFor: 'stepping' stamp: 'AndreiChis 3/16/2015 17:01'!
resetStopStepping
	stopStepping := false.
	self changed.! !

!GLMTreeMorphModel methodsFor: 'accessing' stamp: 'tg 9/8/2009 21:20'!
nodeModelFor: anObject
	^ (GLMTreeMorphNodeModel with: anObject) containerTree: self; yourself! !

!GLMTreeMorphModel methodsFor: 'accessing' stamp: 'tg 9/27/2009 23:05'!
inputText: anObject
	inputText := anObject.
	self doSearchOrFilter! !

!GLMTreeMorphModel methodsFor: 'actions' stamp: 'DamienCassou 5/11/2011 08:10'!
resetChildrenContents 
	self roots do: [:each | each resetContentsRecursively]! !

!GLMTreeMorphModel methodsFor: 'callbacks' stamp: 'TudorGirba 8/21/2011 22:58'!
keyStroke: aKeyboardEvent from: aTreeMorph 
	| action |
	action := self allKeystrokeActions detect: [:a | a shortcut = aKeyboardEvent keyCharacter] ifNone: [nil].
	action ifNotNil: [ self announce: (GLMKeyStroke action: action) ]! !

!GLMTreeMorphModel methodsFor: 'callbacks' stamp: 'AndreiChis 6/13/2014 12:30'!
sortBlock

	^ columnToSortBy sortBlock 
		ifNotNil: [ :aBlock | aBlock ]
		ifNil: [ 
			columnToSortBy defaultSortBlockForPresentation: self glamourPresentation ]! !

!GLMTreeMorphModel methodsFor: 'accessing' stamp: 'AndreiChis 4/21/2014 12:32'!
filteredRoots
	| filtered |
	roots ifNil: [ self roots: self displayValue ].
	filtered := roots select: [ :each | each shouldBeDisplayed ].
	^ filtered! !

!GLMTreeMorphModel methodsFor: 'accessing' stamp: 'tg 9/13/2009 03:24'!
childrenBlock
	^ childrenBlock ifNil: [ childrenBlock := self glamourPresentation children isNil 
		ifFalse: [self glamourPresentation children] ifTrue: [OrderedCollection new] ]! !

!GLMTreeMorphModel methodsFor: 'callbacks' stamp: 'AndreiChis 6/13/2014 12:31'!
sortByColumn: aGlamourColumn

	columnToSortBy := (columnToSortBy == aGlamourColumn 
		ifTrue: [ nil ]
		ifFalse: [ aGlamourColumn ]).
	self updateRoots! !

!GLMTreeMorphModel methodsFor: 'announcements' stamp: 'tg 9/11/2009 00:18'!
when: anAnnouncement do: aBlock
	self announcer when: anAnnouncement do: aBlock ! !

!GLMTreeMorphModel methodsFor: 'accessing' stamp: 'tg 9/30/2009 12:05'!
amountToFilterBy: aNumber 
	amountToFilterBy := aNumber! !

!GLMTreeMorphModel methodsFor: 'drag and drop' stamp: 'AndreHora 2/14/2014 17:27'!
wantsDroppedMorph: transferMorph event: evt inMorph: listMorph 
	| targetItem targetItemMorph |
	(transferMorph isKindOf: TransferMorph) ifFalse: [ ^ false ].
	transferMorph dragTransferType = self dragTransferType ifFalse: [ ^ false ].
	
	targetItemMorph := (listMorph scrollerSubMorphFromPoint: evt position).
	targetItemMorph ifNotNil: [
		targetItem := targetItemMorph complexContents item.	
		^ self glamourPresentation allow: transferMorph passenger droppedOnItem: targetItem ].
	self flag: 'we should ask the whole presentation if it wants to receive a dropped object'.
	^ false! !

!GLMTreeMorphModel methodsFor: 'callbacks' stamp: 'AndreiChis 3/30/2015 14:13'!
explicitSelection: anObject 
	"anObject is a domain object, not a Glamour related object"
	self glamourPresentation isMultiple 
		ifTrue: [ self explicitlySelectMultipleItems: anObject ]
		ifFalse: [ self explicitlySelectItem: anObject ]! !

!GLMTreeMorphModel methodsFor: 'accessing' stamp: 'tg 9/27/2009 16:29'!
inputTextEnabled
	^ true! !

!GLMTreeMorphModel methodsFor: 'callbacks' stamp: 'tg 12/29/2009 02:01'!
onDoubleClick
	self announcer announce: (GLMTreeMorphStrongSelectionChanged new strongSelectionValue: 
		(self selection ifNotNil: [self selection selectedItemOrItemsOrNil]))! !

!GLMTreeMorphModel methodsFor: 'accessing' stamp: 'TudorGirba 11/25/2010 13:21'!
allKeystrokeActions
	^ (self glamourPresentation allActions, self glamourPresentation allSelectionActions) select: [ :action | 
		action hasShortcut ]! !

!GLMTreeMorphModel methodsFor: 'callbacks' stamp: 'tg 9/14/2009 23:29'!
shouldFilterByTag: aTag
	^ self tagsToFilterBy includes: aTag ! !

!GLMTreeMorphModel methodsFor: 'callbacks' stamp: 'tg 12/29/2009 01:57'!
selection: aSelection 
	self selection = aSelection ifTrue: [ ^ self ].
	super selection: aSelection.
	self announcer announce: (
			GLMTreeMorphSelectionChanged new 
				selectionValue: (aSelection ifNotNil: [aSelection selectedItemOrItemsOrNil]);
				selectionPathValue: self selectionPathItems;
				yourself)! !

!GLMTreeMorphModel methodsFor: 'drag and drop' stamp: 'TudorGirba 1/3/2012 16:28'!
dragPassengerFor: item inMorph: listMorph
	^ self glamourPresentation transformedDraggedItem: item complexContents item ! !

!GLMTreeMorphModel methodsFor: 'accessing' stamp: 'AlainPlantec 5/28/2012 07:35'!
toggleAmountToFilterBy
	self amountToFilterBy notNil ifTrue: 
		[ self amountToFilterBy isZero 
			ifTrue: [ amountToFilterBy := self glamourPresentation amountToShow ]
			ifFalse: [ amountToFilterBy := 0 ].
		self changed: #rootNodes ]! !

!GLMTreeMorphModel methodsFor: 'callbacks' stamp: 'tg 11/29/2009 16:45'!
menu: menu shifted: b 
	"Set up the menu to apply to the receiver's, honoring the #shifted boolean"
	self selectedNode ifNotNil: [:current | current menu: menu shifted: b].
	^ menu! !

!GLMTreeMorphModel methodsFor: 'accessing' stamp: 'tg 9/13/2009 03:28'!
displayFormat: aBlock 
	displayFormat := aBlock ! !

!GLMTreeMorphModel methodsFor: 'accessing' stamp: 'EstebanLorenzano 2/13/2012 13:16'!
announcer
	^glmAnnouncer ifNil: [ glmAnnouncer := GLMAnnouncer new ]! !

!GLMTreeMorphModel methodsFor: 'accessing' stamp: 'AndreiChis 4/21/2014 12:32'!
roots
	| filtered |
	roots ifNil: [ self roots: self displayValue ].
	filtered := roots select: [ :each | each shouldBeDisplayed ].
	((self shouldFilterByAmount and: [
		self amountToFilterBy < filtered size]) and: [
			filtered notEmpty]) ifTrue: [
		filtered := filtered first: self amountToFilterBy ].
	^ filtered! !

!GLMTreeMorphModel methodsFor: 'search and filtering' stamp: 'TudorGirba 4/4/2012 19:52'!
executeFilter
	self updateRoots! !

!GLMTreeMorphModel methodsFor: 'accessing' stamp: 'tg 9/8/2009 19:46'!
glamourPresentation
	^ glamourPresentation! !

!GLMTreeMorphModel methodsFor: 'accessing' stamp: 'AlainPlantec 5/28/2012 07:35'!
updateRoots
	roots := nil.
	self changed: #rootNodes! !

!GLMTreeMorphModel methodsFor: 'accessing' stamp: 'tg 1/18/2010 23:54'!
defaultPageSize: anInteger
	defaultPageSize := anInteger! !

!GLMTreeMorphModel methodsFor: 'accessing' stamp: 'tg 9/13/2009 03:23'!
displayFormat
	^ displayFormat ifNil: [displayFormat := self glamourPresentation format]! !

!GLMTreeMorphModel methodsFor: 'stepping' stamp: 'AndreiChis 3/16/2015 17:01'!
wantsSteps
	^ self shouldStopStepping not and: [ self glamourPresentation wantsSteps ]! !

!GLMTreeMorphModel methodsFor: 'private selecting' stamp: 'cyrilledelaunay 7/22/2011 12:38'!
explicitlySelectItem: anObject 
	(self selectedItem notNil and: [self selectedItem = anObject]) ifTrue: [ ^ self ].
	(self selectedItem isNil and: [ anObject isNil ]) ifTrue: [ ^ self ].
	anObject isNil ifTrue: [
		"we make sure to update the morph list by deselecting everything"
		self selectNodePath: nil.
		self selection: nil.].
	self roots do: [:eachRoot |
		eachRoot withContentsDo: [:each |
			each item = anObject ifTrue: [
				each expandParentPath.
				self selectNodePath: each path.
				^ self]]]! !

!GLMTreeMorphModel methodsFor: 'accessing' stamp: 'cyrilledelaunay 8/9/2011 13:14'!
allMenuActions
	^ (self glamourPresentation allSelectionActions select: [:action | action hasTitle ]) ! !

!GLMTreeMorphModel methodsFor: 'drag and drop' stamp: 'TudorGirba 1/3/2012 16:31'!
dragEnabled
	^ self glamourPresentation allowsItemDrag! !

!GLMTreeMorphModel methodsFor: 'callbacks' stamp: 'AlainPlantec 5/28/2012 07:35'!
toggleFilteringByTag: aTag 
	(self shouldFilterByTag: aTag) 
		ifTrue: [self tagsToFilterBy remove: aTag ]
		ifFalse: [self tagsToFilterBy add: aTag].
	self resetChildrenContents.
	self changed: #rootNodes! !

!GLMTreeMorphModel methodsFor: 'stepping' stamp: 'AndreiChis 3/16/2015 15:57'!
shouldStopStepping

	^ stopStepping ifNil: [ false ]! !

!GLMTreeMorphNodeModel methodsFor: 'accessing' stamp: 'TudorGirba 2/27/2014 06:17'!
expandParentPath
"	self openItemPath: anArray"
	self containerTree expandNodePath: self path! !

!GLMTreeMorphNodeModel methodsFor: 'accessing' stamp: 'tg 9/8/2009 21:08'!
containerTree: anObject
	containerTree := anObject! !

!GLMTreeMorphNodeModel methodsFor: 'testing' stamp: 'alain.plantec 9/8/2009 14:37'!
enabled
	^ true! !

!GLMTreeMorphNodeModel methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/23/2015 23:11'!
valueFor: aGlamourColumn

	^ self containerTree glamourPresentation 
			column: aGlamourColumn
			valueFor: self item! !

!GLMTreeMorphNodeModel methodsFor: 'accessing' stamp: 'tg 9/8/2009 21:08'!
containerTree
	^ containerTree! !

!GLMTreeMorphNodeModel methodsFor: 'actions' stamp: 'DamienCassou 5/11/2011 08:17'!
resetContentsRecursively 
	self resetContents.
	self allContents do: [:each | each resetContentsRecursively]! !

!GLMTreeMorphNodeModel methodsFor: 'testing' stamp: 'tg 11/13/2009 02:10'!
shouldBeDisplayedByText
	self containerTree shouldFilterByTextInput ifFalse: [ ^ true ].
	self withContentsDo: 
		[ :node | 
		self flag: 'this should be delegated to the presentation
		and glamourValue should be used to include the entity ports'.
		(self containerTree glamourPresentation filterStrategy 
			value: self containerTree inputText asString
			value: node item) == true ifTrue: [ ^ true ] ].
	^ false! !

!GLMTreeMorphNodeModel methodsFor: 'callbacks' stamp: 'AndreiChis 4/20/2014 22:04'!
tagMorphsFrom: aTagProvider
	| tagMorphs tags tagsFilter |
	tagMorphs := OrderedCollection new.
	tags:= self containerTree glamourPresentation tagsFor: self item fromProvider: aTagProvider to: #show.
	tagsFilter := self containerTree glamourPresentation tagsFor: self item fromProvider: aTagProvider to: #filter.
	tags withIndexDo:[ :each :index | 
			tagMorphs addLast: (self buttonForTag: each 
									  filter: (tagsFilter at: index ifAbsentPut:[ each ])) ].
	^ tagMorphs! !

!GLMTreeMorphNodeModel methodsFor: 'accessing' stamp: 'tg 4/15/2010 00:24'!
path
	"returns the list of nodes to the root"
	^ self pathIn: OrderedCollection new.! !

!GLMTreeMorphNodeModel methodsFor: 'accessing' stamp: 'DamienCassou 5/11/2011 08:15'!
allContents
	^ self childrenItems
		collect: [ :d | 
			(self class with: d)
				parentNode: self;
				containerTree: self containerTree;
				yourself ]! !

!GLMTreeMorphNodeModel methodsFor: 'testing' stamp: 'tg 11/30/2009 02:10'!
shouldBeDisplayed
	^ self shouldBeDisplayedByTags and: [ self shouldBeDisplayedByText ]! !

!GLMTreeMorphNodeModel methodsFor: 'callbacks' stamp: 'AliakseiSyrel 3/23/2015 23:17'!
modified: aGlamourColumn with: aText

	aGlamourColumn modifiedBlock
		cull: aText
		cull: self item
		cull: self containerTree glamourPresentation! !

!GLMTreeMorphNodeModel methodsFor: 'printing' stamp: 'tg 9/9/2009 13:30'!
printOn: aStream
	aStream nextPutAll: 'a NodeModel with '.
	aStream nextPutAll: self item printString.! !

!GLMTreeMorphNodeModel methodsFor: 'accessing' stamp: 'cyrilledelaunay 7/6/2011 12:57'!
displayText
	^ (UITheme current 
		newTextIn: World
		text: (self containerTree glamourPresentation formatedDisplayValueOf: self item))
			backgroundColor: self textBackgroundColor;
			yourself! !

!GLMTreeMorphNodeModel methodsFor: 'enumerating' stamp: 'AndreiChis 3/30/2015 14:25'!
withContentsDo: aBlock
	aBlock value: self.
	self containerTree glamourPresentation allowsRecursiveSearch ifTrue: [  
		self contents do: [:each | each withContentsDo: aBlock ] ]! !

!GLMTreeMorphNodeModel methodsFor: 'menu' stamp: 'EstebanLorenzano 4/20/2012 16:18'!
menu: aMenuMorph shifted: b 
	| subMenus targetMenuMorph subMenu |
	subMenus := Dictionary new.
	self containerTree allMenuActions do: [ :action |
		targetMenuMorph := action category notNil 
			ifTrue: [ subMenus at: action category ifAbsentPut: [ 
					subMenu :=  MenuMorph new.
					aMenuMorph add: action category subMenu: subMenu.
					subMenu ] ]
			ifFalse: [ aMenuMorph ].
		(targetMenuMorph 
			add: action title
			target: self
			selector: #executeMenuAction:
			argument: action)
			icon:  action icon;
			keyText: (action hasShortcut 
				ifTrue: [ action shortcutAsString ]
				ifFalse: [ nil ]) ].
	^ aMenuMorph! !

!GLMTreeMorphNodeModel methodsFor: 'callbacks' stamp: 'AndreiChis 4/20/2014 22:04'!
elementColumn
	| rowElements |
	
	rowElements := OrderedCollection new
		add: self displayText;
		addAll: (self tagMorphsFrom: self containerTree glamourPresentation);
		yourself.
	
	^ (UITheme current newRowIn: World for: rowElements).! !

!GLMTreeMorphNodeModel methodsFor: 'accessing' stamp: 'tg 9/10/2009 12:44'!
pathIn: aCollection 
	self parentNode ifNotNil: [
		(aCollection includes: self parentNode)
			ifFalse: [self parentNode pathIn: aCollection]].
	aCollection add: self.
	^ aCollection! !

!GLMTreeMorphNodeModel methodsFor: 'actions' stamp: 'AliakseiSyrel 3/24/2015 02:03'!
selectItem

	self containerTree explicitlySelectItem: self item! !

!GLMTreeMorphNodeModel methodsFor: 'accessing' stamp: 'alain.plantec 9/8/2009 14:12'!
parentNode: aNode
	parentNode := aNode
	! !

!GLMTreeMorphNodeModel methodsFor: 'callbacks' stamp: 'AliakseiSyrel 3/30/2015 13:59'!
rowMorphForColumn: aGlamourColumn
	| rowElements contentMorph tagMorphs |
		
	aGlamourColumn modifiedBlock
		ifNil: [
			contentMorph := (self containerTree glamourPresentation 
			column: aGlamourColumn
			valueFor: self item) asMorph asReadOnlyMorph ]
		ifNotNil: [
			contentMorph := GLMEditableLabelBrick new
				cancelOnEscape;
				cancelOnFocusLost;
				text: (self valueFor: aGlamourColumn);
				hSpaceFill;
				with: [ :b | b editBrick rubricBackgroundColor: b themer rubricBackgroundColor ];
				when: #onEditMode do: [ self containerTree forceStopStepping ];
				when: #onReadMode do: [ self containerTree resetStopStepping ];
				when: #onSingleClicked do: [ :evt :brick | brick isReadMode ifTrue: [ self selectItem ] ];
				when: #onAccepted do: [ self modified: aGlamourColumn with: contentMorph text ];
				yourself.
			
			contentMorph := contentMorph asMorph
				hSpaceFill;
				vShrinkWrap ].
	
	tagMorphs := self tagMorphsFrom: aGlamourColumn.
	tagMorphs ifEmpty: [ ^ contentMorph ].
	
	rowElements := OrderedCollection new
		add: contentMorph;
		addAll: tagMorphs;
		yourself.			
	^ (UITheme current newRowIn: World for: rowElements)! !

!GLMTreeMorphNodeModel methodsFor: 'actions' stamp: 'DamienCassou 5/11/2011 07:55'!
resetContents
	contents := nil! !

!GLMTreeMorphNodeModel methodsFor: 'testing' stamp: 'tg 11/30/2009 02:15'!
shouldBeDisplayedByTags
	| nodeTags |
	self flag: 'it looks like this method does not really get called for children'.
"	self item mooseName = #'org::easymock' ifTrue: [self haltOnce ].
"	self containerTree tagsToFilterBy isEmpty ifTrue: [ ^ true ].
	self withContentsDo: [ :node | 
		nodeTags := self containerTree glamourPresentation tagsFor: node item to: #filter.
		(self containerTree tagsToFilterBy allSatisfy: [ :each | nodeTags includes: each ])
			ifTrue: [ ^ true ] ].
	^ false! !

!GLMTreeMorphNodeModel methodsFor: 'callbacks' stamp: 'VeronicaUquillas 6/15/2010 11:13'!
buttonForTag: each filter: filter
	| button |

	button := GLMMorphic 
		togglingButtonLabelled: each
		pressed: (self containerTree shouldFilterByTag: filter)
		style: self containerTree glamourPresentation tagsStyle.
	button
		target: self;
		actionSelector: #toggleFilteringByTag:;
		arguments: (Array with: filter).
	^ button! !

!GLMTreeMorphNodeModel methodsFor: 'accessing' stamp: 'cyrilledelaunay 7/6/2011 12:50'!
textBackgroundColor
	^ self containerTree glamourPresentation textBackgroundColorFor: self item! !

!GLMTreeMorphNodeModel methodsFor: 'accessing' stamp: 'alain.plantec 9/8/2009 14:12'!
parentNode
	^ parentNode! !

!GLMTreeMorphNodeModel methodsFor: 'testing' stamp: 'ewe 11/16/2012 14:32'!
= anObject
	"This is needed to handle the update of the whole list while still preserving the selection"
	^ self species = anObject species and: [ self item = anObject item ]! !

!GLMTreeMorphNodeModel methodsFor: 'accessing' stamp: 'tg 4/18/2010 23:19'!
childrenItems
	^ (self containerTree glamourPresentation childrenValueOf: self item atLevel: self path size) ifNil: [OrderedCollection new]! !

!GLMTreeMorphNodeModel methodsFor: 'accessing' stamp: 'TudorGirba 11/16/2013 13:46'!
helpText
	^ nil! !

!GLMTreeMorphNodeModel methodsFor: 'menu' stamp: 'tg 9/8/2009 21:09'!
keyStroke: aCharacter from: aTreeMorph 
	^ false
! !

!GLMTreeMorphNodeModel methodsFor: 'callbacks' stamp: 'tg 9/14/2009 23:33'!
toggleFilteringByTag: aTag 
	self containerTree toggleFilteringByTag: aTag! !

!GLMTreeMorphNodeModel methodsFor: 'menu' stamp: 'tg 9/16/2009 23:39'!
executeMenuAction: anAction
	self containerTree announce: (GLMMenuItemSelected action: anAction)! !

!GLMTreeMorphNodeModel methodsFor: 'accessing' stamp: 'DamienCassou 5/11/2011 08:16'!
contents
	^ contents ifNil: [ contents := self allContents select: [ :each | each shouldBeDisplayed ] ]! !

!GLMTreeMorphNodeModel methodsFor: 'accessing' stamp: 'tg 9/11/2009 19:54'!
icon
	^ self containerTree glamourPresentation iconFor: self item! !

!GLMTreeMorphSelectionChanged methodsFor: 'accessing' stamp: 'tg 12/29/2009 01:56'!
selectionPathValue: anObject
	selectionPathValue := anObject! !

!GLMTreeMorphSelectionChanged methodsFor: 'accessing' stamp: 'tg 12/29/2009 01:54'!
selectionValue
	^ selectionValue! !

!GLMTreeMorphSelectionChanged methodsFor: 'accessing' stamp: 'tg 12/29/2009 01:54'!
selectionValue: anObject
	selectionValue := anObject! !

!GLMTreeMorphSelectionChanged methodsFor: 'accessing' stamp: 'tg 12/29/2009 01:56'!
selectionPathValue
	^ selectionPathValue! !

!GLMTreeMorphStrongSelectionChanged methodsFor: 'accessing' stamp: 'tg 12/29/2009 01:58'!
strongSelectionValue: anObject
	strongSelectionValue := anObject! !

!GLMTreeMorphStrongSelectionChanged methodsFor: 'accessing' stamp: 'tg 12/29/2009 01:58'!
strongSelectionValue
	^ strongSelectionValue! !

!GLMTreeMorphicTest methodsFor: 'tests' stamp: ''!
testTreeSelection
	| browser treeNodeMorph |
	browser := GLMFinder new.
	browser show: [:a | a tree].
	window := browser openOn: ($a to: $d).
	treeNodeMorph := self treeRoots first.
	self send: self tree mouseUpOnItem: treeNodeMorph.
	self assert: (browser panes first port: #selection) value equals: $a! !

!GLMTreeMorphicTest methodsFor: 'tests' stamp: ''!
testTreeDefaultAllowDeseletion
	| browser treeNodeMorph |
	browser := GLMFinder new.
	browser show: [:a | a tree].
	window := browser openOn: ($a to: $d).
	treeNodeMorph := self treeRoots first.
	self send: self tree mouseUpOnItem: treeNodeMorph.
	self send: self tree mouseUpOnItem: treeNodeMorph.
	self assert: (browser panes first port: #selection) value equals: $a! !

!GLMTreeMorphicTest methodsFor: 'tests' stamp: ''!
testTreeMultipleSelection
	| browser treeNodeMorph lastTreeNodeMorph |
	browser := GLMFinder new.
	browser show: [:a | a tree beMultiple].
	window := browser openOn: ($a to: $d).
	treeNodeMorph := self treeRoots first.
	lastTreeNodeMorph := self treeRoots last.
	self send: self tree mouseUpOnItem: treeNodeMorph.
	self send: self tree mouseUpWithShift: true onItem: lastTreeNodeMorph.
	self assert: (browser panes first port: #selection) value notNil.
	self assert: (browser panes first port: #selection) value asSet equals: ($a to: $d) asSet! !

!GLMTreeMorphicTest methodsFor: 'tests' stamp: ''!
testTreeSelectionCancellation
	| browser treeNodeMorph |
	browser := GLMFinder new.
	browser show: [:a | a tree allowDeselection].
	window := browser openOn: ($a to: $d).
	treeNodeMorph := self treeRoots first.
	self send: self tree mouseUpOnItem: treeNodeMorph.
	self send: self tree mouseUpOnItem: treeNodeMorph.
	self assert: (browser panes first port: #selection) value isNil! !

!GLMTreeMorphicTest methodsFor: 'tests' stamp: ''!
testChildrenBlockTakesEntity
	| browser receivedEntity |
	browser := GLMFinder new.
	receivedEntity := nil.
	browser show: [:a | a tree
		children: [:each :entity | receivedEntity := entity. #()]].
	window := browser openOn: ($a to: $d).
	World doOneCycle.
	self repeatAssert: [receivedEntity] equals: ($a to: $d).
! !

!GLMTreeMorphicTest methodsFor: 'tests' stamp: ''!
testTreeAllowDeseletion
	| browser treeNodeMorph |	
	browser := GLMFinder new.
	browser show: [:a | a list allowDeselection].
	window := browser openOn: ($a to: $d).
	treeNodeMorph := self treeRoots first.
	self send: self tree mouseUpOnItem: treeNodeMorph.
	self send: self tree mouseUpOnItem: treeNodeMorph.
	self assert: (browser panes first port: #selection) value isNil! !

!GLMTreeMorphicTest methodsFor: 'private' stamp: ''!
tree
	^ self find: MorphTreeMorph in: window! !

!GLMTreeMorphicTest methodsFor: 'tests' stamp: ''!
testTreeWithDisplay
	| browser treeCollection |
	treeCollection := { #root1->{#child1->{} . #child2->{}} . #root2 ->{} }.
	browser := GLMTabulator new.
	browser column: #one.
	browser transmit to: #one; andShow: [ :a |
		a tree
			display: [:each | each value ];
			children: [:x | x value ] ].
	window := browser openOn: #something -> treeCollection.
	self assert: browser panes first presentations first displayValue == treeCollection! !

!GLMTreeMorphicTest methodsFor: 'tests' stamp: ''!
testTreeWithTags
	"Creates a tree and tag some nodes. Then click on a tag and see if the unmatched nodes disappear"

	| browser model oddNode lineWithNumber3 someNode secondSome |
	model := Dictionary new.
	model at: #some put: #(1 2 3 4).
	model at: #even put: #(2 6 8).
	model at: #odd put: #(3 7 9).
	browser := GLMTabulator new.
	browser column: #one.
	(browser transmit)
		to: #one;
		andShow: [ :a | 
					(a tree)
						display: [ model keys ];
						children: [ :key | 
									key isNumber
										ifFalse: [ model at: key ] ];
						tags: [ :item | 
									item isNumber
										ifTrue: [ 
											item even
												ifTrue: [ #('even') ]
												ifFalse: [ #('odd') ] ]
										ifFalse: [ #() ] ] ].
	window := browser openOn: model.
	World doOneCycle.
	oddNode := self treeRoots second.	
	
	oddNode toggleExpandedState. "Simulate a click on the node's arrow to expand the node and make sub nodes visible"

	World doOneCycle.
	lineWithNumber3 := self treeRoots third.
	(self find: SimpleButtonMorph in: lineWithNumber3) doButtonAction. "Simulate a click on the 'odd' tag to make even numbers disappear"
	
	World doOneCycle.
	someNode := self treeRoots first.
	someNode toggleExpandedState.
	World doOneCycle.
	secondSome := self find: TextMorph in: self treeRoots third.
	self assert: secondSome text asString equals: '3'! !

!GLMTreeMorphicTest methodsFor: 'tests' stamp: ''!
testTreeMultipleSelectionWithCancellation
	| browser treeNodeMorph lastTreeNodeMorph |
	browser := GLMFinder new.
	browser show: [:a | a tree beMultiple allowDeselection].
	window := browser openOn: ($a to: $d).
	treeNodeMorph := self treeRoots first.
	lastTreeNodeMorph := self treeRoots last.
	self send: self tree mouseUpOnItem: treeNodeMorph.
	self send: self tree mouseUpWithShift: true onItem: lastTreeNodeMorph.
	self send: self tree mouseUpOnItem: treeNodeMorph.
	self send: self tree mouseUpOnItem: treeNodeMorph.
	self assert: (browser panes first port: #selection) value isNil! !

!GLMTreeMorphicTest methodsFor: 'private' stamp: ''!
treeRoots
	"Returns the roots of the tree included in the current window. It looks like morphic creates new collections when the tree is refreshed which means different calls to this method may return different objects."
	^ self tree scroller submorphs! !

!GLMTreeMorphicTest methodsFor: 'tests' stamp: 'AndreiChis 3/30/2015 14:15'!
testExplicitSelectionDoesNotUpdate
	| composite |
	composite := GLMCompositePresentation new
		with: [ :c | c tree 
			allowsRecursiveSearch: false;
			children: [ :each | each  to: each + 10  ] ].
	window := composite openOn: { 1 }.
	
	composite selection: Object new.

	self assert:  self tree selectedMorph equals: nil! !

!GLMTreeMorphicTest methodsFor: 'tests' stamp: ''!
testChildrenBlock
	| browser check |
	browser := GLMFinder new.
	check := false.
	browser show: [:a | a tree
		children: [ :each | 
			check := true.
			#() ]].
	window := browser openOn: ($a to: $d).
	World doOneCycle.
	self repeatAssert: [ check ] equals: true! !

!GLMTreePresentation commentStamp: 'AndreiChis 10/3/2014 18:34'!
A GLMTreePresentation  shows the given elements within a tree. The #children block is used to compute the children of an elements. It does not guard against infinite recursion.


Instance Variables
	allExpanded:		<Object>
	children:		<Object>
	expandLevel:		<Object>
	rootsExpanded:		<Object>
	tagsBlock:		<Object>
	tagsFilterBlock:		<Object>

allExpanded
	- xxxxx

children
	- xxxxx

expandLevel
	- xxxxx

rootsExpanded
	- xxxxx

tagsBlock
	- xxxxx

tagsFilterBlock
	- xxxxx
!
!GLMTreePresentation methodsFor: 'accessing' stamp: ''!
shouldAllExpand
	^ allExpanded ifNil: [false]! !

!GLMTreePresentation methodsFor: 'accessing' stamp: ''!
children 
	 
	^children! !

!GLMTreePresentation methodsFor: 'scripting' stamp: 'AndreiChis 4/20/2014 23:04'!
tagsFilter: aBlock
	tagsFilterBlock := aBlock ! !

!GLMTreePresentation methodsFor: 'scripting' stamp: 'AndreiChis 4/20/2014 23:03'!
tagsBlock: anObject
	tagsBlock := anObject! !

!GLMTreePresentation methodsFor: 'validation' stamp: ''!
defaultValidate: anObject on: aPort
	"we only allow objects that are in the display value"
	(aPort name == #selection) ifFalse: [ ^ true ].
	self entity isNil ifTrue: [ ^ false ].
	self allDisplayedDo: [:each | each = anObject ifTrue: [ ^ true ] ].
	^ false! !

!GLMTreePresentation methodsFor: 'accessing' stamp: ''!
childrenValueOf: anObject atLevel: anInteger
	^ self children glamourValue: (
		anObject asGlamorousMultiValue, 
		self entity asGlamorousMultiValue,
		anInteger asGlamorousMultiValue,
		self asGlamorousMultiValue)! !

!GLMTreePresentation methodsFor: 'scripting' stamp: ''!
tags: aBlock

	self tagsBlock: aBlock.
	self hasTagsFilter ifFalse:[ self tagsFilter: aBlock ]! !

!GLMTreePresentation methodsFor: 'tags' stamp: ''!
computeTagsFor: aGlamourValue from: aBlock
	| value |
	
	aBlock ifNil: [ ^ OrderedCollection new ].
	value := aBlock glamourValue: aGlamourValue.
	^ value isString
		ifTrue: [ OrderedCollection with: value ]
		ifFalse: [ value asOrderedCollection ]! !

!GLMTreePresentation methodsFor: 'accessing' stamp: ''!
shouldRootsExpand
	^ rootsExpanded ifNil: [false]! !

!GLMTreePresentation methodsFor: 'accessing' stamp: ''!
shouldRootsExpand: anObject
	rootsExpanded := anObject! !

!GLMTreePresentation methodsFor: 'testing' stamp: ''!
hasTagsFilter
	^ self tagsFilterBlock notNil! !

!GLMTreePresentation methodsFor: 'accessing' stamp: ''!
allExpanded
	self shouldAllExpand: true! !

!GLMTreePresentation methodsFor: 'validation' stamp: ''!
allDisplayedDo: aBlock
	self displayValue do: [ :eachRoot | 
		self withChildrenOf: eachRoot do: aBlock ]! !

!GLMTreePresentation methodsFor: 'accessing' stamp: ''!
rootsExpanded
	self shouldRootsExpand: true! !

!GLMTreePresentation methodsFor: 'accessing' stamp: 'JanKurs 5/27/2013 14:34'!
shouldExpandToLevel: level
	^ expandLevel := level! !

!GLMTreePresentation methodsFor: 'tags' stamp: ''!
computeTagsFilterFor: aGlamourValue 

	^ self computeTagsFor: aGlamourValue from: self tagsFilterBlock! !

!GLMTreePresentation methodsFor: 'validation' stamp: ''!
withChildrenOf: anObject do: aBlock
	aBlock value: anObject.
	(self childrenValueOf: anObject) do: [ :each |
		self withChildrenOf: each do: aBlock ]! !

!GLMTreePresentation methodsFor: 'accessing' stamp: ''!
shouldAllExpand: anObject
	allExpanded := anObject! !

!GLMTreePresentation methodsFor: 'accessing' stamp: 'JanKurs 5/27/2013 14:35'!
expandLevel
	^ expandLevel! !

!GLMTreePresentation methodsFor: 'accessing' stamp: 'AndreiChis 4/20/2014 23:03'!
tagsFilterBlock
	^ tagsFilterBlock! !

!GLMTreePresentation methodsFor: 'tags' stamp: ''!
computeTagsFor: aGlamourValue 

	^ self computeTagsFor: aGlamourValue from: self tagsBlock! !

!GLMTreePresentation methodsFor: 'rendering' stamp: ''!
renderGlamorouslyOn: aRenderer	
	self registerAnnouncements.
	^ aRenderer renderTreePresentation: self! !

!GLMTreePresentation methodsFor: 'accessing' stamp: 'JanKurs 5/27/2013 14:33'!
shouldExpandToLevel
	^ expandLevel isNil not! !

!GLMTreePresentation methodsFor: 'accessing' stamp: ''!
children: anObject 
	 
	children := anObject! !

!GLMTreePresentation methodsFor: 'accessing' stamp: 'AndreiChis 4/20/2014 23:03'!
tagsBlock
	^ tagsBlock! !

!GLMTreePresentation methodsFor: 'accessing' stamp: ''!
childrenValueOf: anObject
	^ self children glamourValue: (anObject asGlamorousMultiValue, self entity asGlamorousMultiValue)! !

!GLMTreePresentation methodsFor: 'testing' stamp: ''!
hasTags
	^ self tagsBlock notNil! !

!GLMTreePresentationTest methodsFor: 'tests' stamp: 'tg 11/15/2009 17:06'!
testValidateOn
	self assert: (presentation validate: #($e $f) on: (pane port: #selection)).
	self assert: (presentation validate: $a on: (pane port: #selection)).
	self deny: (presentation validate: $h on: (pane port: #selection))! !

!GLMTreePresentationTest methodsFor: 'tests' stamp: 'tg 11/15/2009 23:53'!
setUp
	pane := GLMPane named: 'test'.
	presentation := GLMTreePresentation new.
	pane addPresentation: presentation.
	presentation entity: #(($a $b $c $d) ($e $f) ($g)).
	presentation children: [:x :i | x asString size > 1 ifTrue: [x] ifFalse: [OrderedCollection new]].
	presentation shouldValidate: true.! !

!GLMTreePresentationTest methodsFor: 'tests' stamp: 'DamienCassou 7/19/2011 21:00'!
testValidatePorts
	presentation selection: #($e $f).
	self assert: presentation selection equals: #($e $f).
	presentation selection: $a.
	self assert: presentation selection equals: $a.
	presentation selection: 'wrongSelection'.	"this should be invalid"
	self assert: presentation selection equals: $a! !

!GLMUIThemeExtraIcons commentStamp: 'TudorGirba 1/30/2011 22:55'!
This class offers a number of extra icons that work with the Glamorous Theme.!
!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousFolder
	^ Smalltalk ui icons glamorousFolder! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousInto
	^ Smalltalk ui icons glamorousInto! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'AndreiChis 2/1/2015 14:21'!
glamorousSaveToUrl 
	^ Smalltalk ui icons glamorousSaveToUrl! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousSave
	^ Smalltalk ui icons glamorousSave! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousOpenFromUrl
	^ Smalltalk ui icons glamorousOpenFromUrl! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousRemove
	^ Smalltalk ui icons glamorousRemove! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousLeft
	^ Smalltalk ui icons glamorousLeft! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousExample
	^ Smalltalk ui icons glamorousExample! !

!GLMUIThemeExtraIcons class methodsFor: 'utils' stamp: 'TudorGirba 1/7/2015 22:04'!
importIcons
	"self importIcons"
	| wantedIcons |
	self resetIcons.
	wantedIcons := #(
		'glamorousInspect'
		'glamorousExample'
		'glamorousHelp'
		'glamorousSearch'
		'glamorousAccept'
		'glamorousCancel'
		'glamorousBrowse'
		'glamorousAdd'
		'glamorousRemove'
		'glamorousTrash'
		'glamorousUp'
		'glamorousDown'
		'glamorousDropDown'
		'glamorousLeft'
		'glamorousRight'
		'glamorousEdit'
		'glamorousAlarm'
		'glamorousRedCircle'
		'glamorousGreenCircle'
		'glamorousGrayCircle'
		'glamorousGrayCircleEmpty'
		'glamorousLargeGrayCircleEmphasized'
		'glamorousUndo'
		'glamorousRedo'
		'glamorousPlay'
		'glamorousGo'
		'glamorousRestart'
		'glamorousOver'
		'glamorousInto'
		'glamorousThrough'
		'glamorousBookmark'
		'glamorousOpen'
		'glamorousSave'
		'glamorousOpenFromUrl'
		'glamorousSaveToUrl'
		'glamorousFolder'
		'glamorousRefresh'
		'glamorousSpawn'
		'glamorousBug'
		'glamorousLeftSide'
		'glamorousRightSide'
		'glamorousZoomIn'
		'glamorousZoomOut'
		'glamorousZoomToFit'
		'glamorousMore'
		"'glamourousNextParser'
		'glamourousNextProduction'
		'glamourousNextFailure'").
	(Smalltalk at:
	 #MooseScripts) 
		importIcons: wantedIcons 
		fromFolder: 'icons' 
		inClass: self 
		category: 'icons'! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousRedo
	^ Smalltalk ui icons glamorousRedo! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousSearch
	^ Smalltalk ui icons glamorousSearch! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousSpawn
	^ Smalltalk ui icons glamorousSpawn! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousRefresh
	^ Smalltalk ui icons glamorousRefresh! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/7/2014 09:42'!
glamorousClose 
	^ Smalltalk ui icons glamorousClose! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousAlarm
	^ Smalltalk ui icons glamorousAlarm! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousUp
	^ Smalltalk ui icons glamorousUp! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousLeftSide
	^ Smalltalk ui icons glamorousLeftSide! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousBug
	^ Smalltalk ui icons glamorousBug! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousMore
	^ Smalltalk ui icons glamorousMore! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousGreenCircle
	^ Smalltalk ui icons glamorousGreenCircle! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousUndo
	^ Smalltalk ui icons glamorousUndo! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousBookmark
	^ Smalltalk ui icons glamorousBookmark! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousDropDown
	^ Smalltalk ui icons glamorousDropDown! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousPlay
	^ Smalltalk ui icons glamorousPlay! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousZoomOut
	^ Smalltalk ui icons glamorousZoomOut! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousTrash
	^ Smalltalk ui icons glamorousTrash! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousZoomIn
	^ Smalltalk ui icons glamorousZoomIn! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousAdd
	^ Smalltalk ui icons glamorousAdd! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousGrayCircle
	^ Smalltalk ui icons glamorousGrayCircle! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'AndreiChis 1/23/2015 15:14'!
glamorousZoomToFit
	^ Smalltalk ui icons glamorousZoomToFit! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousGrayCircleEmpty
	^ Smalltalk ui icons glamorousGrayCircleEmpty! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousEdit
	^ Smalltalk ui icons glamorousEdit! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousHelp
	^ Smalltalk ui icons glamorousHelp! !

!GLMUIThemeExtraIcons class methodsFor: 'utils' stamp: 'TudorGirba 1/31/2011 00:16'!
resetIcons
	icons := nil! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousDown
	^ Smalltalk ui icons glamorousDown! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousRightSide
	^ Smalltalk ui icons glamorousRightSide! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousBrowse
	^ Smalltalk ui icons glamorousBrowse! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousGo
	^ Smalltalk ui icons glamorousGo! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousInspect
	^ Smalltalk ui icons glamorousInspect! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousOver
	^ Smalltalk ui icons glamorousOver! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousLargeGrayCircleEmphasized
	^ Smalltalk ui icons glamorousLargeGrayCircleEmphasized! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousRight
	^ Smalltalk ui icons glamorousRight! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousOpen
	^ Smalltalk ui icons glamorousOpen! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamourousNextFailure
	^ Smalltalk ui icons glamourousNextFailure! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamourousNextProduction
	^ Smalltalk ui icons glamourousNextProduction! !

!GLMUIThemeExtraIcons class methodsFor: 'utils' stamp: 'TudorGirba 1/31/2011 00:16'!
icons
	^ icons ifNil: [icons := Dictionary new] ! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousRestart
	^ Smalltalk ui icons glamorousRestart! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousRedCircle
	^ Smalltalk ui icons glamorousRedCircle! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousCancel
	^ Smalltalk ui icons glamorousCancel! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamourousNextParser
	^ Smalltalk ui icons glamourousNextParser! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousAccept
	^ Smalltalk ui icons glamorousAccept! !

!GLMUIThemeExtraIcons class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/5/2014 18:22'!
glamorousThrough
	^ Smalltalk ui icons glamorousThrough! !

!GLMUpdateAction commentStamp: 'TudorGirba 1/7/2011 07:30'!
GLMUpdateAction is used for controlling the updating of a presentation when an announcement. is sent by the announcerObjects.

Instance Variables:
	condition	<Boolean>
	presentation	<GLMPresentation>
	announcement	<Announcement>
	announcerObjects	<(Collection of: Objects)>
	transformation	<BlockClosure>!
!GLMUpdateAction methodsFor: 'public' stamp: 'BernardoContreras 11/12/2014 21:18'!
registerInPresentation
	self announcerObjects do: [: announcerObject |
		announcerObject notNil ifTrue: [
			(announcerObject when: self announcement send: #actOn: to: self) makeWeak.
			
			"we remember the announcer object to be able to 
			unregister from it when the presentation goes away"
			self presentation registeredAnnouncers add: announcerObject ] ]! !

!GLMUpdateAction methodsFor: 'accessing' stamp: 'tg 5/2/2010 23:50'!
announcement: anObject
	announcement := anObject! !

!GLMUpdateAction methodsFor: 'accessing' stamp: 'tg 5/2/2010 23:46'!
condition: anObject
	condition := anObject! !

!GLMUpdateAction methodsFor: 'accessing' stamp: 'tg 5/3/2010 01:18'!
transformation: anObject
	transformation := anObject! !

!GLMUpdateAction methodsFor: 'announcement handling' stamp: 'TudorGirba 2/15/2011 10:40'!
actOn: anAnnouncement
	| allowedToTrigger |
	allowedToTrigger := self condition glamourValue: (	
							anAnnouncement asGlamorousMultiValue, 
							self presentation entity asGlamorousMultiValue).
	allowedToTrigger ifTrue: [ self presentation update ]! !

!GLMUpdateAction methodsFor: 'public' stamp: 'HenrikSperreJohansen 3/12/2011 11:59'!
unregisterFromAllAnnouncements
	self announcerObjects do: [:each | 
		[each unsubscribe: self] on: Error do: [:e | e resume]] ! !

!GLMUpdateAction methodsFor: 'accessing' stamp: 'tg 5/3/2010 01:18'!
transformation
	^ transformation! !

!GLMUpdateAction methodsFor: 'initialize-release' stamp: 'tg 5/24/2010 17:19'!
initialize
	super initialize.
	condition := true! !

!GLMUpdateAction methodsFor: 'accessing' stamp: 'tg 5/2/2010 23:46'!
condition
	^ condition! !

!GLMUpdateAction methodsFor: 'accessing' stamp: 'tg 5/3/2010 00:19'!
announcerObjects 
	^ announcerObjects := self computeAnnouncerObjects ifNil: [OrderedCollection new]! !

!GLMUpdateAction methodsFor: 'public' stamp: 'tg 5/3/2010 00:12'!
computeAnnouncerObjects 
	self subclassResponsibility! !

!GLMUpdateAction methodsFor: 'copying' stamp: 'tg 5/3/2010 01:19'!
postCopy
	super postCopy.
	announcerObjects := nil! !

!GLMUpdateAction methodsFor: 'accessing' stamp: 'tg 5/2/2010 23:46'!
presentation: anObject
	presentation := anObject! !

!GLMUpdateAction methodsFor: 'accessing' stamp: 'tg 5/2/2010 23:46'!
presentation
	^ presentation! !

!GLMUpdateAction methodsFor: 'accessing' stamp: 'tg 5/2/2010 23:50'!
announcement
	^ announcement! !

!GLMUpdateInterdependentPanesTest methodsFor: 'tests' stamp: ''!
testTwoInterdependentPanesShouldUpdateTheRenderedSelectionOnTheTriggerPane

	| browser morphTwo morphOne |
	browser := GLMTabulator new.
	browser column: #one; column: #two.
	browser transmit to: #one; andShow: [:a | a list display: [:x | 1 to: x ] ].
	browser transmit from: #one; to: #two; andShow: [:a | a list display: [:x | 1 to: x ] ].
	browser transmit from: #two port: #toSelect; toOutsidePort: #toSelect.
	browser transmit fromOutsidePort: #toSelect; to: #one port: #selection.
	browser transmit fromOutsidePort: #toSelect; to: #two port: #selection.
	window := browser openOn: 100.
	((browser paneNamed: #one) port: #selection) value: 10.
	((browser paneNamed: #two) port: #toSelect) value: 5.
	self assert: ((browser paneNamed: #one) port: #selection) value equals: 5.
	self assert: ((browser paneNamed: #two) port: #selection) value equals: 5.

	World doOneCycle.

	morphOne := self findWherePresentationIs: (browser paneNamed: #one) presentations first in: window.
	self assert: morphOne notNil.
	self assert: morphOne selectedMorph notNil.
	
	morphTwo := self findWherePresentationIs: (browser paneNamed: #two) presentations first in: window.
	self assert: morphTwo notNil.
	self assert: morphTwo selectedMorph notNil! !

!GLMUpdateInterdependentPanesTest methodsFor: 'tests' stamp: 'TudorGirba 7/30/2012 07:25'!
testAllowNil
	| browser detailsMorph |
	browser := GLMTabulator new.
	browser
		column: [ :c | 
					c
						row: #one;
						row: #two ];
		column: #details.
	browser
		transmit to: #one;
		andShow: [ :a | a tree display: #(1 2 3) ].
	browser
		transmit to: #two;
		andShow: [ :a | a tree display: #(#a #b #c) ].
	browser
		transmit to: #details;
		from: #one;
		from: #two;
		andShow: [ :a | 
					(a text)
						display: [ :one :two | one asString , two asString ];
						allowNil ].
	window := browser openOn: 42.
	((browser paneNamed: #one) port: #selection) value: 2.
	detailsMorph := window submorphs last submorphs last submorphs first.
	self assert: detailsMorph getText asString equals: '2nil'.
	((browser paneNamed: #two) port: #selection) value: #c.
	detailsMorph := window submorphs last submorphs last submorphs first.
	self assert: detailsMorph getText asString equals: '2c'.
	((browser paneNamed: #one) port: #selection) value: nil.
	detailsMorph := window submorphs last submorphs last submorphs first.
	self assert: detailsMorph getText asString equals: 'nilc'! !

!GLMUpdateInterdependentPanesTest methodsFor: 'tests' stamp: ''!
testInterdependentPanesShouldUpdateTheFocusTriggerPane
	|  treeMorphThree treeMorphThree2 browser treeMorphTwo treeMorphOne |
	browser := GLMTabulator new.
	browser column: #one; column: #two; column: #three.
	(browser transmit)
		to: #one;
		andShow: [ :a | a list display: [ :x | 1 to: x ] ].
	(browser transmit)
		to: #two; from: #one;
		andShow: [ :a | a list display: [ :x | 1 to: x * 2 ] ].
	(browser transmit)
		to: #three; from: #two;
		andShow: [ :a | a list display: [ :x | 1 to: x * 3 ] ].
	browser transmit toOutsidePort: #focus; from: #three port: #focus.
	browser transmit to: #one port: #selection; fromOutsidePort: #focus; transformed: [ :x | x + 1 ].
	browser transmit to: #two port: #selection; fromOutsidePort: #focus; transformed: [ :x | x + 2 ].

	window := browser openOn: 5.
	((browser paneNamed: #one) port: #selection) value: 3.
	((browser paneNamed: #two) port: #selection) value: 6.
	treeMorphThree := self findWherePresentationIs: (browser paneNamed: #three) presentations first in: window.

	((browser paneNamed: #three) port: #selection) value: 2.
	((browser paneNamed: #three) port: #focus) value: 1.

	self assert: ((browser paneNamed: #one) port: #entity) value equals: 5.
	self assert: ((browser paneNamed: #one) port: #selection) value equals: 2.
	self assert: ((browser paneNamed: #two) port: #entity) value equals: 2.
	self assert: ((browser paneNamed: #two) port: #selection) value equals: 3.
	self assert: ((browser paneNamed: #three) port: #entity) value equals: 3.
	self assert: ((browser paneNamed: #three) port: #selection) value isNil.

	treeMorphThree2 := self findWherePresentationIs: (browser paneNamed: #three) presentations first in: window.
	self assert: treeMorphThree ~= treeMorphThree2.
	self assert: treeMorphThree2 selectedMorph isNil.

	treeMorphOne := self findWherePresentationIs: (browser paneNamed: #one) presentations first in: window.
	self assert: treeMorphOne selectedMorph notNil.
	
	treeMorphTwo := self findWherePresentationIs: (browser paneNamed: #two) presentations first in: window.
	self assert: treeMorphTwo selectedMorph notNil.
! !

!GLMUpdateInterdependentPanesTest methodsFor: 'tests' stamp: ''!
testInterdependentPanesShouldUpdateTheFocusTriggerPaneWithText
	| browser treeMorphThree treeMorphThree2 |
	browser := GLMTabulator new.
	browser
		column: #one;
		column: #two;
		column: #three.
	(browser transmit)
		to: #one;
		andShow: [ :a | a text display: [ :x | 1 to: x ] ].
	(browser transmit)
		to: #two;
		from: #one;
		andShow: [ :a | a text display: [ :x | 1 to: x * 2 ] ].
	(browser transmit)
		to: #three;
		from: #two;
		andShow: [ :a | a text display: [ :x | 1 to: x * 3 ] ].
	(browser transmit)
		toOutsidePort: #focus;
		from: #three port: #focus.
	(browser transmit)
		to: #one port: #selection;
		fromOutsidePort: #focus;
		transformed: [ :x | x + 1 ].
	(browser transmit)
		to: #two port: #selection;
		fromOutsidePort: #focus;
		transformed: [ :x | x + 2 ].
	window := browser openOn: 5.
	((browser paneNamed: #one) port: #selection) value: 3.
	((browser paneNamed: #two) port: #selection) value: 6.
	treeMorphThree := (window submorphs last submorphs at: 5) submorphs first submorphs first.
	((browser paneNamed: #three) port: #selection) value: 2.
	((browser paneNamed: #three) port: #focus) value: 1.
	self assert: ((browser paneNamed: #one) port: #entity) value equals: 5.
	self assert: ((browser paneNamed: #one) port: #selection) value equals: 2.
	self assert: ((browser paneNamed: #two) port: #entity) value equals: 2.
	self assert: ((browser paneNamed: #two) port: #selection) value equals: 3.
	self assert: ((browser paneNamed: #three) port: #entity) value equals: 3.
	self assert: ((browser paneNamed: #three) port: #selection) value isNil.
	treeMorphThree2 := (window submorphs last submorphs at: 5) submorphs first submorphs first.
	self assert: treeMorphThree ~= treeMorphThree2! !

!GLMUpdateInterdependentPanesTest methodsFor: 'tests' stamp: ''!
testOnePanesShouldUpdateTheRenderedSelectionOnTheTriggerPane

	| browser morphOne |
	browser := GLMTabulator new.
	browser column: #one.
	browser transmit to: #one; andShow: [:a | a list display: [:x | 1 to: x]].
	browser transmit from: #one port: #strongSelection; toOutsidePort: #toSelect.
	browser transmit fromOutsidePort: #toSelect; to: #one port: #selection; transformed: [:x | x + 1].
	window := browser openOn: 100.
	(browser panes first port: #strongSelection) value: 41.
	self assert: ((browser paneNamed: #one) port: #selection) value equals: 42.
	.
	morphOne := self findWherePresentationIs: (browser paneNamed: #one) presentations first in: window.
	self assert: morphOne notNil.
	self assert: morphOne selectedMorph notNil! !

!GLMUpdateMorphicTest methodsFor: 'tests' stamp: 'Nicolasanquetil 5/3/2013 15:11'!
testAnnouncerUnregistration
	self assert: announcer numberOfSubscriptions equals: 5.
	browser entity: #($a $b).
	self assert: announcer numberOfSubscriptions equals: 5.
	browser entity: #($d).
	self assert: announcer numberOfSubscriptions equals: 5.
	browser entity: #().
	self assert: announcer numberOfSubscriptions equals: 5.
	browser unregisterFromAllAnnouncements.
	self assert: announcer numberOfSubscriptions equals: 0! !

!GLMUpdateMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 3/15/2013 22:07'!
testRemove
	entity removeLast.
	announcer announce: GLMTestAnnouncement.
	self assert: listMorph model roots size equals: 2.
	self assert: treeMorph model roots size equals: 2.
	self assert: tableMorph model roots size equals: 2.
	self assert: labelMorph contents equals: '2'! !

!GLMUpdateMorphicTest methodsFor: 'tests' stamp: 'Nicolasanquetil 5/3/2013 15:03'!
testAdd
	entity add: 4.
	announcer announce: GLMTestAnnouncement.
	self assert: listMorph roots size equals: 4.
	self assert: listMorph model roots size equals: 4.
	self assert: treeMorph roots size equals: 4.
	self assert: treeMorph model roots size equals: 4.
	self assert: tableMorph roots size equals: 4.
	self assert: tableMorph model roots size equals: 4.
	self assert: labelMorph contents equals: '4'! !

!GLMUpdateMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 3/15/2013 22:07'!
testInvalidateSelection
	(browser panes first port: #selection) value: 3.
	entity removeLast.
	announcer announce: GLMTestAnnouncement.
	self assert: (browser panes first port: #selection) value isNil.
	self assert: listMorph model selection isNil! !

!GLMUpdateMorphicTest methodsFor: 'tests' stamp: ''!
testAddAndUpdateBrowserManually
	entity add: 4.
	self assert: unupdatedListMorph model roots size equals: 3.
	browser update.
	self assert: unupdatedListMorph model roots size equals: 4.
	entity add: 5.
	browser panes first presentations update.
	self assert: unupdatedListMorph model roots size equals: 5! !

!GLMUpdateMorphicTest methodsFor: 'tests' stamp: ''!
expectedFailures
	^ #(testUpdatePresentationTitle)! !

!GLMUpdateMorphicTest methodsFor: 'tests' stamp: ''!
testUpdateBrowserTitle
	browser title: 'something'.
	browser update.
	self assert: window label equals: 'something'! !

!GLMUpdateMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 3/15/2013 22:07'!
setUp
	announcer := Announcer new.
	entity := OrderedCollection with: 1 with: 2 with: 3.
	browser := GLMTabulator new.
	browser column: #one; column: #two.
	browser transmit to: #one; andShow: [ :a |
		a 
"			title: [:x | x printString ];"
			verticallyStackedArrangement.
		a list 
			title: [:x | x printString ];
			updateOn: GLMTestAnnouncement from: [ announcer ];
			shouldValidate: true.
		a tree 
			title: [:x | x printString ];
			children: #();
			updateOn: GLMTestAnnouncement from: [ announcer ];
			shouldValidate: true.
		a table
			title: [:x | x printString ];
			updateOn: GLMTestAnnouncement from: [ announcer ];
			shouldValidate: true.
		a text 
			updateOn: GLMTestAnnouncement from: [ announcer ].
		a list 
			title: 'Not updated automatically';
			shouldValidate: true.
		a label 
			display: [:x | x isEmpty ifTrue: ['#()'] ifFalse: [x last]];
			updateOn: GLMTestAnnouncement from: [ announcer ].			
			 ].
	browser transmit to: #two; from: #one; andShow: [ :a | a text].
	window := browser openOn: entity.
	listLabelMorph := 			window submorphs last submorphs second submorphs first submorphs 
									first tabSelectorMorph submorphs first submorphs first.
	listMorph := 				window submorphs last submorphs second submorphs first submorphs 
									first submorphs first submorphs first submorphs first.
	treeMorph := 				window submorphs last submorphs second submorphs first submorphs 
									second submorphs first submorphs first submorphs first.
	tableMorph := 				window submorphs last submorphs second submorphs first submorphs 
									third submorphs first submorphs first submorphs first.
	unupdatedListMorph := 	window submorphs last submorphs second submorphs first submorphs 
									fifth submorphs first submorphs first submorphs first.
	labelMorph := 				window submorphs last submorphs second submorphs first submorphs 
									last submorphs first submorphs first.! !

!GLMUpdateMorphicTest methodsFor: 'tests' stamp: ''!
testUpdatePresentationTitle
	browser panes first presentations first title: 'something'.
	browser panes first presentations first update.
	self assert: listLabelMorph contents equals: 'something'! !

!GLMValidator methodsFor: 'events' stamp: 'cyrilledelaunay 3/31/2011 13:57'!
innerPortEvent: aPortEvent 

! !

!GLMValidator methodsFor: 'accessing' stamp: 'cyrilledelaunay 4/4/2011 15:33'!
validator: aString act: aBlock populatePorts: aCollectionOfPorts

	self addButtonAction:   
			((GLMGenericAction new) 
				action: [:tmpBrowser |
					
					aCollectionOfPorts do: [:aSymbol |
						tmpBrowser explicitlyInnerPortNamed: aSymbol.  
 						].
					aBlock value: tmpBrowser.
					]; 
				title: aString; 
				yourself).
				
	! !

!GLMValidator methodsFor: 'accessing' stamp: 'cyrilledelaunay 3/31/2011 13:56'!
validator: aString populatePorts: aCollectionOfPorts

	self addButtonAction:   
			((GLMGenericAction new) 
				action: [:tmpBrowser |
					aCollectionOfPorts do: [:aSymbol |
						tmpBrowser explicitlyInnerPortNamed: aSymbol.  
 						]
					]; 
				title: aString; 
				yourself).
				
	! !

!GLMValidator methodsFor: 'accessing' stamp: 'cyrilledelaunay 3/23/2011 13:00'!
buttonActions

	^ buttonActions! !

!GLMValidator methodsFor: 'announcements' stamp: 'cyrilledelaunay 5/5/2011 12:01'!
on: anAnnouncementClass send: aSelector

	self specificAnnouncementActions at: anAnnouncementClass  put: aSelector ! !

!GLMValidator methodsFor: 'accessing' stamp: 'cyrilledelaunay 3/23/2011 13:04'!
addButtonAction: aGLMGenericAction

	self buttonActions addLast: aGLMGenericAction ! !

!GLMValidator methodsFor: 'private' stamp: 'AndreiChis 5/30/2013 21:51'!
addPaneFrom: aPort 

	self panes isEmpty ifTrue: [
		self panes addLast: (GLMPane in: self).
		self newTransmission
			addActiveOrigin: aPort; 
			destination: (self panes last port: #entity); 
			transmit
		]
	! !

!GLMValidator methodsFor: 'initialize-release' stamp: 'cyrilledelaunay 3/23/2011 13:20'!
initialize

	super initialize.
	buttonActions := OrderedCollection new! !

!GLMValidator methodsFor: 'rendering' stamp: 'TudorGirba 4/12/2011 12:44'!
renderGlamorouslyOn: aRenderer 
	^ aRenderer renderValidator: self! !

!GLMValidator methodsFor: 'accessing' stamp: 'cyrilledelaunay 4/4/2011 15:33'!
validator: aString act: aBlock 

	"will populate all ports by default at the end"
	self addButtonAction:   
			((GLMGenericAction new) 
				action: [:tmpBrowser |
					
					tmpBrowser panes first ports do: [:aPort |
						tmpBrowser explicitlyInnerPortNamed: aPort name
						].
					aBlock value: tmpBrowser.
					]; 
				title: aString; 
				yourself).
				! !

!GLMValidator methodsFor: 'announcements' stamp: 'BernardoContreras 11/14/2014 19:09'!
setSpecificAnnouncementActionsTo: aRenderer

	self specificAnnouncementActions keysAndValuesDo: [:anAnnouncementClass :aSymbol |
		self when: anAnnouncementClass send: aSymbol to: aRenderer.
		]! !

!GLMValidator methodsFor: 'events' stamp: 'cyrilledelaunay 3/30/2011 10:35'!
outerPortEvent: aPortEvent 
	
 	super outerPortEvent: aPortEvent.
	aPortEvent port name = #entityToSelect ifTrue: [
		self tryToSelectPaneFrom: aPortEvent port ].	
	aPortEvent port name = #entity ifTrue: [
		self addPaneFrom: aPortEvent port ]! !

!GLMValidator methodsFor: 'announcements' stamp: 'cyrilledelaunay 5/5/2011 12:00'!
specificAnnouncementActions

	^ specificAnnouncementActions ifNil: [specificAnnouncementActions := Dictionary new]! !

!GLMValidator methodsFor: 'private' stamp: 'AndreiChis 5/29/2013 13:39'!
addPaneFromInner: aPort 
	| newTransmission realTransmissions lastActivePresentation |
	"the lastActivePresentation is needed for knowing what presentation to show by default"
	self panes isEmpty ifFalse: [lastActivePresentation := self panes last lastActivePresentation ].
	self panes addLast: ( (GLMPane in: self) lastActivePresentation: lastActivePresentation; yourself).
	self newTransmission
		addActiveOrigin: aPort; 
		destination: (self panes last port: #entity); 
		presentations: (self presentations copy); 
		transmit. 
	realTransmissions := self transmissions collect: [:each |  
			newTransmission := GLMTransmission new ensureReplacePresentationsStrategy. 
			each activeOrigins do: [:eachPort | 
				newTransmission addActiveOrigin: (aPort pane port: eachPort name)]. 
			each passiveOrigins do: [:eachPort | 
				newTransmission addPassiveOrigin: (aPort pane port: eachPort name)]. 
			newTransmission 
				destination: (self panes last port: #entity); 
				addPresentations: (self presentations collect: #copy);
				addPresentations: (each presentations collect: #copy)] . 
	(realTransmissions select: [:each | each originatesAt: aPort]) 
		do: [:each | each transmit]. ! !

!GLMValidator methodsFor: 'events' stamp: 'DiegoLont 9/11/2013 10:05'!
explicitlyInnerPortNamed: aPortName

	aPortName = #entity ifFalse: [
		self panes first ports do: [:each | (self pane port: each name) value: each value] ]! !

!GLMVariableBindingsAccessRequest commentStamp: 'AndreiChis 3/19/2015 17:59'!
Request to perform an action on the current bindings from the editor.!
!GLMVariableBindingsAccessRequest methodsFor: 'accessing' stamp: 'AndreiChis 3/19/2015 17:02'!
action

	^ actionBlock! !

!GLMVariableBindingsAccessRequest methodsFor: 'accessing' stamp: 'AndreiChis 3/19/2015 17:02'!
action: aBlock

	actionBlock := aBlock! !

!GLMVariableBindingsChanged commentStamp: 'AndreiChis 5/6/2014 17:51'!
I am event indicating to the renderer to update its variable bindings.!
!GLMVariableBindingsChanged methodsFor: 'accessing' stamp: 'AndreiChis 2/27/2014 14:26'!
presentation
	^ presentation! !

!GLMVariableBindingsChanged methodsFor: 'accessing' stamp: 'AndreiChis 2/27/2014 14:26'!
presentation: anObject
	presentation := anObject! !

!GLMVerticalLinearLayout methodsFor: 'width' stamp: 'AliakseiSyrel 2/8/2015 18:50'!
widthChildrenDependency: aBrick
	"returns the height of aBrick when it depends on children"
	"in case of horizontal linear layout it is the height of the highest subbrick + corresponding paddings"
	^ aBrick paddingLeft + aBrick paddingRight + (((self nonFloatSubbricks: aBrick) detectMax: [ :each | each outerBounds width ])
		ifNil: [ 0 ]
		ifNotNil: [ :m | m outerBounds width ])! !

!GLMVerticalLinearLayout methodsFor: 'width' stamp: 'AliakseiSyrel 4/2/2015 15:38'!
widthParentDependency: aBrick
	
	aBrick owner ifNil: [ Exception signal: 'My width depends on parent, but it is nil' ].
	^ (aBrick owner innerBounds width * aBrick layout hPercent / 100) ceiling! !

!GLMVerticalLinearLayout methodsFor: 'width' stamp: 'AliakseiSyrel 4/2/2015 15:38'!
heightParentDependency: aBrick
	| allowedHeight |
	aBrick owner ifNil: [ Exception signal: 'My height depends on parent, but it is nil' ].
	allowedHeight := aBrick owner subbricks inject: aBrick owner innerBounds height into: [ :height :each |
		each isHeightClean ifTrue: [
			(each layout vState isOnParent not | (self hasHeightRestrictions: each))
				ifTrue: [ height - each outerBounds height ]
				ifFalse: [ height ] ]
			ifFalse: [ height ] ].
	^ (allowedHeight * aBrick layout vPercent / 100) ceiling! !

!GLMVerticalLinearLayout methodsFor: 'layout' stamp: 'AliakseiSyrel 4/2/2015 15:41'!
layout: aBrick in: newBounds

	self
		layout: aBrick
		in: newBounds
		inject: aBrick paddingLeft @ aBrick paddingTop
		into: [ :origin :each |
			each outerOrigin: origin.
			0@each outerBounds height ]! !

!GLMVerticalLinearLayout methodsFor: 'height' stamp: 'AliakseiSyrel 2/8/2015 18:50'!
heightChildrenDependency: aBrick
	"returns the height of aBrick when it depends on children"
	^ aBrick paddingTop + aBrick paddingBottom + ((self nonFloatSubbricks: aBrick) detectSum: [ :each | each outerBounds height ])! !

!GLMVerticalLinearLayout methodsFor: 'layout' stamp: 'AliakseiSyrel 2/19/2015 10:34'!
align: aBrick in: parentBrick anchorPoint: aPoint inContext: aContext
	|align|
	
	self = aContext ifTrue: [ ^ self ].
	(parentBrick subbricks size = 1) & (aContext isNil) ifTrue: [
		GLMHorizontalLinearLayout uniqueInstance align: aBrick in: parentBrick anchorPoint: aPoint inContext: self ].
	
	align := aBrick layout hAlign.
	
	align = #none ifTrue: [ ^ self ].
	align = #left ifTrue: [ ^ self ].
	align = #center ifTrue: [
		^ aBrick translateX: ((parentBrick innerBounds width - aBrick outerBounds width) / 2) asInteger ].
	align = #right ifTrue: [
		^ aBrick translateX: ((parentBrick innerBounds width - aBrick outerBounds width)) asInteger ].! !

!GLMVerticalLinearLayout methodsFor: 'converting' stamp: 'AliakseiSyrel 2/13/2015 20:09'!
asString
	^ 'vertical'! !

!GLMVerticalLinearLayout class methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/4/2015 13:20'!
reset
	"
	self reset
	"
	uniqueInstance := nil! !

!GLMVerticalLinearLayout class methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/3/2015 10:36'!
uniqueInstance
	^ uniqueInstance ifNil: [ uniqueInstance := self new ]! !

!GLMVerticalLinearLayout class methodsFor: 'cleanup' stamp: 'AndreiChis 3/24/2015 18:51'!
cleanUp

	self reset! !

!GLMWatcherMorphicTest methodsFor: 'tests' stamp: 'TudorGirba 7/30/2012 07:29'!
expectedFailures 
	^ #(testSimple testWithDynamicPresentation)
! !

!GLMWatcherMorphicTest methodsFor: 'tests' stamp: 'Nicolasanquetil 5/3/2013 15:04'!
testWithDynamicPresentation
	| browser |
	browser := GLMTabulator new.
	browser column: #one.
	browser transmit
		to: #one;
		andShow: [ :a | a list ].
	browser transmit
		from: #one;
		toWatcher;
		andShow: [ :a | a dynamic display: [ :x | GLMTextPresentation new ] ].
	window := browser openOn: (1 to: 42).
	((browser paneNamed: #one) port: #selection) value: 42.
	(Delay forMilliseconds: 1000) wait.
	self assert: (self find: PluggableTextMorph in: GLMWatcherWindow uniqueInstance) text equals: '42'! !

!GLMWatcherMorphicTest methodsFor: 'tests' stamp: 'Nicolasanquetil 5/3/2013 15:18'!
testSimple
	| browser |
	browser := GLMTabulator new.
	browser column: #one.
	browser transmit
		to: #one;
		andShow: [ :a | a list ].
	browser transmit
		from: #one;
		toWatcher;
		andShow: [ :a | a text ].
	window := browser openOn: (1 to: 42).
	((browser paneNamed: #one) port: #selection) value: 42.
	(Delay forMilliseconds: 1000) wait.
	self assert: (self find: PluggableTextMorph in: GLMWatcherWindow uniqueInstance) text equals: '42'! !

!GLMWatcherWindow commentStamp: '<historical>'!
This morph is used as support for the watcher (quick preview) behavior.

GLMWatcherWindow uniqueInstance openInWorld.
GLMWatcherWindow reset.!
!GLMWatcherWindow methodsFor: 'settings' stamp: 'TudorGirba 5/20/2012 22:51'!
activeTitleFillStyle
	"Return the active title fillStyle for the receiver."
	
	^ SolidFillStyle color: Color transparent! !

!GLMWatcherWindow methodsFor: 'accessing' stamp: 'TudorGirba 5/20/2012 01:32'!
contentsMorph
	^ contentsMorph! !

!GLMWatcherWindow methodsFor: 'settings' stamp: 'TudorGirba 5/23/2012 13:48'!
taskbarTask
	"Answer a new taskbar task for the receiver.
	Answer nil if not required."

	^nil! !

!GLMWatcherWindow methodsFor: 'settings' stamp: 'TudorGirba 5/23/2012 13:13'!
wantsExpandBox
	"Answer whether I'd like an expand box"

	^ false! !

!GLMWatcherWindow methodsFor: 'initialize' stamp: 'TudorGirba 5/20/2012 11:00'!
fastFramingOn

	^self theme settings fastDragging and: [self isFlexed not]! !

!GLMWatcherWindow methodsFor: 'accessing' stamp: 'TudorGirba 5/20/2012 01:32'!
contentsMorph: anObject
	contentsMorph := anObject! !

!GLMWatcherWindow methodsFor: 'settings' stamp: 'TudorGirba 5/20/2012 23:29'!
inactiveTitleFillStyle
	"Return the active title fillStyle for the receiver."
	
	^ SolidFillStyle color: Color transparent! !

!GLMWatcherWindow methodsFor: 'open/close' stamp: 'TudorGirba 5/19/2012 18:01'!
openInWorld
	super openInWorld.
	isOpen := true.
! !

!GLMWatcherWindow methodsFor: 'initialize' stamp: 'TudorGirba 5/20/2012 16:40'!
addContentsMorph
	self contentsMorph: GLMMorphic emptyMorph.
	self contentsMorph
		layoutFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 1) offsets: (10@10 corner: -10@(-10)));
		hResizing: #spaceFill;
		vResizing: #spaceFill.
	self addMorphBack: self contentsMorph! !

!GLMWatcherWindow methodsFor: 'initialize' stamp: 'TudorGirba 5/23/2012 13:59'!
replaceBoxes
	"Rebuild the various boxes."
	
	labelArea removeAllMorphs.
	self setLabelWidgetAllowance.
	self theme configureWatcherWindowLabelAreaFor: self.
	self setFramesForLabelArea.
	self isActive ifFalse: [labelArea passivate]! !

!GLMWatcherWindow methodsFor: 'initialize' stamp: 'TudorGirba 5/27/2012 01:41'!
initialize
	super initialize.
	self fillStyle: self defaultFillStyle.
"	self borderStyle: self defaultBorderStyle."
	isOpen := false.
	self setLabel: 'Glamorous Watcher'.
	self addCornerGrips.
	self addEdgeGrips.
	self addContentsMorph.
	process := nil.
	self
		on: Character escape
		do: [ self hide ]! !

!GLMWatcherWindow methodsFor: 'open/close' stamp: 'TudorGirba 5/12/2012 23:11'!
delete 
	super delete. 
	isOpen := false! !

!GLMWatcherWindow methodsFor: 'settings' stamp: 'TudorGirba 11/27/2014 15:36'!
activeFillStyle
	"Return the active fillStyle for the receiver."

	^ self theme watcherWindowActiveFillStyleFor: self! !

!GLMWatcherWindow methodsFor: 'settings' stamp: 'TudorGirba 5/31/2012 23:24'!
defaultBorderStyle
	^ FillStyleBorder color: (Color white darker alpha: 0.5) width: 10! !

!GLMWatcherWindow methodsFor: 'initialize' stamp: 'TudorGirba 5/20/2012 10:48'!
defaultFillStyle
	^ SolidFillStyle color: Color transparent! !

!GLMWatcherWindow methodsFor: 'open/close' stamp: 'TudorGirba 5/14/2013 08:51'!
toggleOpen 
	isOpen ifFalse: [ ^ self openInWorld ].
	self visible 
		ifTrue: [self hide] 
		ifFalse: [self show]! !

!GLMWatcherWindow methodsFor: 'accessing' stamp: 'TudorGirba 5/19/2012 18:05'!
morphicLayerNumber
	"We want this preview to be always on top"
	
	^ 10! !

!GLMWatcherWindow methodsFor: 'accessing' stamp: 'TudorGirba 5/27/2012 23:20'!
addContent: aBlockWhoseValueReturnsAMorph
	| newMorph |

	"if we are still rendering some contents for another watcher,
	we stop and replace with the current request"
	process ifNotNil: [ process terminate ].
	process := nil.
	
	process := [
		newMorph := aBlockWhoseValueReturnsAMorph value.
		WorldState addDeferredUIMessage:  [
			self contentsMorph
				removeAllMorphs;
				addMorph: newMorph fullFrame: (LayoutFrame fractions: (0@0 corner: 1@1))	
		]
	] newProcess. 
	process priority: Processor userBackgroundPriority.
	process resume! !

!GLMWatcherWindow methodsFor: 'settings' stamp: 'TudorGirba 5/23/2012 14:11'!
inactiveFillStyle
	"Return the active title fillStyle for the receiver."
	
	^ self theme watcherWindowInactiveFillStyleFor: self! !

!GLMWatcherWindow class methodsFor: 'instance creation' stamp: 'TudorGirba 5/12/2012 22:50'!
reset 
	"self reset"
	uniqueInstance := nil! !

!GLMWatcherWindow class methodsFor: 'instance creation' stamp: 'TudorGirba 5/12/2012 22:52'!
uniqueInstance 
	^ uniqueInstance ifNil: [uniqueInstance := self new]! !

!GLMWatcherWindow class methodsFor: 'instance creation' stamp: 'TudorGirba 11/16/2013 13:46'!
buildKeymapsOn: aBuilder
	<keymap>
	
	(aBuilder shortcut: #openGlamourWatcher) 
		category: #Glamour
		default: Character space command shift 
		do: [ :morph | self uniqueInstance toggleOpen ].

	aBuilder attachShortcutCategory: #Glamour to: Morph.! !

!GLMWhitespaceTheme commentStamp: '<historical>'!
The theme is developed in the context of the Glamour project, and its goal is to create a look that:
- does not look like a specific operating system.
- maximizes whitespace.
- is fast.

!!!!Installation of the theme

[[[
	PolymorphSystemSettings desktopColor: Color white.
	self defaultSettings: nil.
	self beCurrent.
	self setPreferredShoutColors
]]]

!
!GLMWhitespaceTheme methodsFor: 'growl - specific' stamp: 'TudorGirba 5/19/2013 14:09'!
growlLabelColorFor: aGrowlMorph
	^ Color black! !

!GLMWhitespaceTheme methodsFor: 'forms' stamp: 'TudorGirba 5/16/2013 22:10'!
newWindowCloseOverForm
	"Answer a new form for a window menu box."

	^ self newWindowCloseForm! !

!GLMWhitespaceTheme methodsFor: 'private' stamp: 'TudorGirba 4/16/2014 15:22'!
glamorousNoBorderFor: aMorph
	| aStyle |
	aStyle := SimpleBorder new 
			baseColor: (self glamorousLightColorFor: aMorph);
			width: 0.
	^ aStyle! !

!GLMWhitespaceTheme methodsFor: 'border-styles' stamp: 'TudorGirba 5/16/2013 22:10'!
taskbarThumbnailNormalBorderStyleFor: aWindow
	^ self buttonNormalBorderStyleFor: aWindow! !

!GLMWhitespaceTheme methodsFor: 'border-styles-scrollbars' stamp: 'TudorGirba 5/16/2013 22:10'!
scrollbarNormalThumbBorderStyleFor: aScrollbar
	"Return the normal thumb borderStyle for the given scrollbar."

	^ BorderStyle simple
		width: 0;
		baseColor: Color transparent! !

!GLMWhitespaceTheme methodsFor: 'border-styles' stamp: 'TudorGirba 5/19/2013 14:14'!
configureWindowDropShadowFor: aWindow
	aWindow hasDropShadow: false! !

!GLMWhitespaceTheme methodsFor: 'fill-styles' stamp: 'TudorGirba 5/16/2013 22:10'!
taskbarFillStyleFor: aTaskbar
	^ "self buttonNormalFillStyleFor: aTaskbar"
	SolidFillStyle color: Color transparent ! !

!GLMWhitespaceTheme methodsFor: 'forms' stamp: 'TudorGirba 12/7/2014 12:57'!
windowMaximizePassiveForm
	"Answer the form to use for passive (background) window maximize/restore buttons"

	^GLMThemeIcons windowMaximizeInactiveForm! !

!GLMWhitespaceTheme methodsFor: 'fill-styles' stamp: 'TudorGirba 5/16/2013 22:10'!
windowInactiveTitleFillStyleFor: aWindow
	"We do not want the lighting effect when the window goes inactive"
	^ SolidFillStyle color: Color transparent! !

!GLMWhitespaceTheme methodsFor: 'initialize-release' stamp: 'TudorGirba 5/16/2013 22:10'!
initialize
	"self beCurrent"

	super initialize.
	self windowActiveDropShadowStyle: #diffuse! !

!GLMWhitespaceTheme methodsFor: 'fill-styles-scrollbars' stamp: 'TudorGirba 5/16/2013 22:10'!
scrollbarNormalFillStyleFor: aScrollbar
	"Return the normal scrollbar fillStyle for the given scrollbar."
	
	^ Color transparent! !

!GLMWhitespaceTheme methodsFor: 'forms' stamp: 'TudorGirba 12/7/2014 12:57'!
radioButtonForm
	"Answer the form to use for a normal radio button."

	^ GLMThemeIcons radioButtonUnselectedForm! !

!GLMWhitespaceTheme methodsFor: 'defaults' stamp: 'TudorGirba 5/16/2013 22:10'!
buttonMinHeight
	"Answer the minumum height of a button for this theme."
	
	^24! !

!GLMWhitespaceTheme methodsFor: 'fill-styles' stamp: 'TudorGirba 9/6/2013 07:41'!
splitterPressedFillStyleFor: aSplitter
	"Return the pressed splitter fillStyle for the given splitter."
	
	^ self splitterNormalFillStyleFor: aSplitter! !

!GLMWhitespaceTheme methodsFor: 'defaults' stamp: 'TudorGirba 5/16/2013 22:10'!
buttonMinWidth
	"Answer the minumum width of a button for this theme."
	
	^24! !

!GLMWhitespaceTheme methodsFor: 'initialize-release' stamp: 'TudorGirba 5/16/2013 22:10'!
newWindowInactiveControlForm
	"Answer a new form for an inactive window control box."

	^(Form
	extent: 16@16
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4291677645 4288585374 4286085240 4284243036 4284243036 4286085240 4288585374 4291677645 0 0 0 0 0 0 0 4289572269 4285756275 4286479998 4288716960 4289835441 4289835441 4288716960 4286479998 4285756275 4289572269 0 0 0 0 0 4289506476 4284835173 4287335307 4290559164 4292598747 4293322470 4293322470 4292598747 4290559164 4287335307 4284703587 4289506476 0 0 0 4291546059 4285493103 4286414205 4288980132 4291217094 4292335575 4292598747 4292598747 4292335575 4291282887 4288980132 4286282619 4285493103 4291546059 0 0 4288980132 4285361517 4287466893 4288782753 4289835441 4290295992 4290295992 4290427578 4290164406 4289835441 4288782753 4287466893 4285361517 4288980132 0 0 4286282619 4286611584 4288059030 4288716960 4289177511 4289572269 4289835441 4289835441 4289703855 4289374890 4288782753 4288059030 4286611584 4286282619 0 0 4285164138 4287664272 4288782753 4289374890 4289835441 4290427578 4290624957 4290624957 4290559164 4290032820 4289374890 4288914339 4287664272 4285164138 0 0 4285361517 4288322202 4289703855 4290295992 4290822336 4291414473 4291677645 4291677645 4291414473 4291085508 4290427578 4289703855 4288453788 4285624689 0 0 4287072135 4288716960 4290427578 4291217094 4291677645 4292203989 4292598747 4292598747 4292335575 4291809231 4291217094 4290427578 4288716960 4287203721 0 0 4288980132 4288256409 4290624957 4291677645 4292335575 4292927712 4293256677 4293256677 4293059298 4292598747 4291809231 4290822336 4288256409 4289177511 0 0 4291677645 4287664272 4290295992 4292006610 4293059298 4293454056 4293585642 4293585642 4293454056 4293125091 4292203989 4290427578 4287730065 4291677645 0 0 4293256677 4290032820 4288124823 4291217094 4292796126 4293322470 4293717228 4293717228 4293454056 4292927712 4291677645 4288256409 4290032820 4293256677 0 0 0 4293454056 4290032820 4288322202 4289967027 4291546059 4292598747 4292664540 4291677645 4290295992 4288716960 4290032820 4293454056 0 0 0 0 0 4293322470 4292203989 4289835441 4288782753 4288322202 4288453788 4288980132 4289835441 4292335575 4293322470 0 0 0 0 0 0 0 4293059298 4293585642 4293717228 4293585642 4293585642 4293585642 4293585642 4293059298 0 0 0 0)
	offset: 0@0)! !

!GLMWhitespaceTheme methodsFor: 'private' stamp: 'TudorGirba 5/16/2013 22:10'!
glamorousLightColorFor: aButton
	^ self class lightBaseColor! !

!GLMWhitespaceTheme methodsFor: 'growl - specific' stamp: 'TudorGirba 5/19/2013 14:15'!
growlBorderColorFor: aGrowlMorph
	^ self glamorousThickBorderFor: aGrowlMorph ! !

!GLMWhitespaceTheme methodsFor: 'initialize-release' stamp: 'TudorGirba 5/16/2013 22:10'!
initializeForms
	"Initialize the receiver's image forms."

	|inactiveForm|
	super initializeForms.
	inactiveForm := self newWindowInactiveControlForm.
	self forms
		at: #windowCloseOver put: self newWindowCloseOverForm;
		at: #windowMinimizeOver put: self newWindowMinimizeOverForm;
		at: #windowMaximizeOver put: self newWindowMaximizeOverForm;
		at: #windowClosePassive put: inactiveForm;
		at: #windowMinimizePassive put: inactiveForm;
		at: #windowMaximizePassive put: inactiveForm! !

!GLMWhitespaceTheme methodsFor: 'forms' stamp: 'TudorGirba 12/7/2014 12:57'!
newCheckboxMarkerForm
	"Answer a new checkbox marker form."

	^GLMThemeIcons checkboxMarkerForm! !

!GLMWhitespaceTheme methodsFor: 'private' stamp: 'AndreiChis 10/2/2014 11:11'!
glamorousThickBorderFor: aWindow
	| aStyle desiredColor |
	"Color lightGray is the color with which SystemWindow initializes the border color.
	If it is the default, we override it with the theme specific color.
	Otherwise, we choose the desired color"
	desiredColor := 
		(aWindow borderColor isNil or: [
			aWindow borderColor isColor not or: [ "Prevent crashes for #raised or #inset borders"
				aWindow borderColor = Color lightGray]])
							ifTrue: [ self glamorousDarkBaseColorFor: aWindow ]
							ifFalse: [ aWindow borderColor ].
	aStyle := SimpleBorder new
					baseColor: desiredColor;
					width: 2.
	aWindow borderStyle: aStyle.
	^ aStyle! !

!GLMWhitespaceTheme methodsFor: 'border-styles-scrollbars' stamp: 'TudorGirba 5/16/2013 22:10'!
scrollbarThumbCornerStyleIn: aThemedMorph	
	^#square! !

!GLMWhitespaceTheme methodsFor: 'border-styles-buttons' stamp: 'TudorGirba 5/16/2013 22:10'!
buttonCornerStyleIn: aThemedMorph
	"If asked, we only allow square corners"
	
	^ #square! !

!GLMWhitespaceTheme methodsFor: 'basic-colors' stamp: 'TudorGirba 5/16/2013 22:10'!
treeLineWidth
	"Answer the width of the tree lines."

	^0! !

!GLMWhitespaceTheme methodsFor: 'fill-styles-buttons' stamp: 'TudorGirba 5/19/2013 14:06'!
buttonSelectedFillStyleFor: aButton
	"Return the normal button fillStyle for the given button."
	
	| top bottom |
	top := self glamorousLightSelectionColorFor: aButton.
	bottom := self glamorousBaseColorFor: aButton.

	^(GradientFillStyle ramp: {
			0.0->top.
			0.7->bottom.})
		origin: aButton bounds origin;
		direction: 0 @ aButton height;
		radial: false! !

!GLMWhitespaceTheme methodsFor: 'border-styles' stamp: 'TudorGirba 4/16/2014 15:22'!
textEditorNormalBorderStyleFor: aTextEditor
	"Return the normal text editor borderStyle for the given text editor."

	^ self glamorousLightBorderStyleFor: aTextEditor! !

!GLMWhitespaceTheme methodsFor: 'label-styles' stamp: 'TudorGirba 5/16/2013 22:10'!
buttonLabelForText: aTextOrString
	"Answer the label to use for the given text."
	^aTextOrString isString
		ifTrue: [(LabelMorph contents: aTextOrString) color: Color black]
		ifFalse: [super buttonLabelForText: aTextOrString]! !

!GLMWhitespaceTheme methodsFor: 'border-styles' stamp: 'TudorGirba 4/16/2014 15:22'!
groupPanelBorderStyleFor: aGroupPanel
	"Answer the normal border style for a group panel."

	^ self glamorousNoBorderFor: aGroupPanel! !

!GLMWhitespaceTheme methodsFor: 'watcher window' stamp: 'TudorGirba 5/16/2013 22:10'!
watcherWindowInactiveFillStyleFor: aWindow

	^ SolidFillStyle color: (Color veryVeryLightGray alpha: 0.6)! !

!GLMWhitespaceTheme methodsFor: 'forms' stamp: 'TudorGirba 12/7/2014 12:57'!
checkboxSelectedForm
	"Answer the form to use for a selected checkbox."

	^GLMThemeIcons checkboxSelectedForm! !

!GLMWhitespaceTheme methodsFor: 'morph creation' stamp: 'TudorGirba 5/16/2013 22:10'!
newCloseControlIn: aThemedMorph for: aModel action: aValuable help: helpText
	"Answer a button for closing things."
	
	|form msb|
	form := self windowCloseForm.
	msb := MultistateButtonMorph new extent: form extent.
	msb activeEnabledNotOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowClosePassiveForm.
	msb extent: form extent.
	msb activeDisabledNotOverUpFillStyle: (ImageFillStyle form: form).
	msb passiveEnabledNotOverUpFillStyle: (ImageFillStyle form: form).
	msb passiveDisabledNotOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowCloseOverForm.
	msb extent: form extent.
	msb
		activeEnabledOverUpFillStyle: (ImageFillStyle form: form);
		passiveEnabledOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowClosePassiveForm.
	msb
		extent: form extent;
		activeEnabledOverDownFillStyle: (ImageFillStyle form: form);
		passiveEnabledOverDownFillStyle: (ImageFillStyle form: form);
		addUpAction: aValuable;
		setBalloonText: helpText.
	^msb! !

!GLMWhitespaceTheme methodsFor: 'fill-styles' stamp: 'TudorGirba 5/16/2013 22:10'!
progressBarFillStyleFor: aProgressBar
	^ self glamorousBasePassiveBackgroundColorFor: aProgressBar! !

!GLMWhitespaceTheme methodsFor: 'fill-styles-buttons' stamp: 'TudorGirba 5/16/2013 22:10'!
tabLabelSelectedFillStyleFor: aTabLabel
	^ self buttonSelectedFillStyleFor: aTabLabel ! !

!GLMWhitespaceTheme methodsFor: 'private' stamp: 'TudorGirba 5/16/2013 22:10'!
glamorousLightSelectionColorFor: aMorph
	^ self class lightSelectionColor! !

!GLMWhitespaceTheme methodsFor: 'label-styles' stamp: 'TudorGirba 5/16/2013 22:10'!
windowMaximizeOverForm
	"Answer the form to use for mouse over window maximize buttons"

	^self forms at: #windowMaximizeOver ifAbsent: [Form extent: 16@16 depth: Display depth]! !

!GLMWhitespaceTheme methodsFor: 'fill-styles' stamp: 'TudorGirba 5/16/2013 22:10'!
dropListDisabledFillStyleFor: aDropList
	"Return the disabled fillStyle for the given drop list."
	
	^ self textEditorDisabledFillStyleFor: aDropList! !

!GLMWhitespaceTheme methodsFor: 'fill-styles' stamp: 'TudorGirba 5/16/2013 22:10'!
listDisabledFillStyleFor: aList
	"Return the disabled fillStyle for the given list."
	
	^ self textEditorDisabledFillStyleFor: aList! !

!GLMWhitespaceTheme methodsFor: 'fill-styles' stamp: 'TudorGirba 5/16/2013 22:10'!
sliderDisabledFillStyleFor: aSlider
	"Return the disabled fillStyle for the given slider."
	
	^ self textEditorDisabledFillStyleFor: aSlider! !

!GLMWhitespaceTheme methodsFor: 'forms' stamp: 'TudorGirba 5/16/2013 22:10'!
newWindowMinimizeOverForm
	"Answer a new form for a window menu box."

	^ self newWindowMinimizeForm! !

!GLMWhitespaceTheme methodsFor: 'fill-styles' stamp: 'TudorGirba 4/16/2014 17:54'!
windowActiveFillStyleFor: aWindow
	"We do not want the lighting effect when the window goes inactive"
	"^ SolidFillStyle color: (self class lightBaseColor)"
	
	^ SolidFillStyle color: (self glamorousBaseColorFor: aWindow)! !

!GLMWhitespaceTheme methodsFor: 'label-styles' stamp: 'TudorGirba 5/16/2013 22:10'!
configureWindowLabelAreaFor: aWindow
	"Configure the label area for the given window."

	|padding|
	padding := 0.
	aWindow labelArea
		addMorphBack: (Morph new extent: aWindow class borderWidth @ 0).
	aWindow hasCloseBox ifTrue: [aWindow addCloseBox. padding := padding + 1].
	aWindow hasCollapseBox ifTrue: [aWindow addCollapseBox. padding := padding + 1].
	aWindow hasExpandBox ifTrue: [aWindow addExpandBox. padding := padding + 1].
	aWindow hasMenuBox ifTrue: [padding := padding - 1].
	aWindow labelArea
		addMorphBack: (Morph new extent: aWindow class borderWidth @ 0; hResizing: #spaceFill).
	aWindow basicLabel ifNotNil: [:label | aWindow labelArea addMorphBack: label; hResizing: #shrinkWrap].
	aWindow labelArea
		addMorphBack: (Morph new extent: aWindow class borderWidth @ 0; hResizing: #spaceFill).
	padding > 0 ifTrue: [
		aWindow labelArea
			addMorphBack: (Morph new extent: (aWindow boxExtent x * padding) @ 0)].
	aWindow hasMenuBox ifTrue: [aWindow addMenuControl].
	aWindow labelArea
		addMorphBack: (Morph new extent: aWindow class borderWidth @ 0)! !

!GLMWhitespaceTheme methodsFor: 'forms' stamp: 'TudorGirba 12/7/2014 12:57'!
newWindowMenuForm
	"Answer a new form for a window menu box."

	^ GLMThemeIcons windowMenuForm! !

!GLMWhitespaceTheme methodsFor: 'accessing colors' stamp: 'TudorGirba 1/6/2015 14:37'!
borderColor 
	^ Color transparent! !

!GLMWhitespaceTheme methodsFor: 'initialize-release' stamp: 'TudorGirba 5/16/2013 22:10'!
newRadioMarkerForm
	"Answer a new checkbox marker form."

	^Form extent: 12@12 depth: 32! !

!GLMWhitespaceTheme methodsFor: 'private' stamp: 'TudorGirba 5/10/2013 21:28'!
glamorousNormalFillStyleWithBaseColor: aColor for: aMorph height: anInteger	
	| top bottom |
	top := aColor "darker".
	bottom := aColor.
	^(GradientFillStyle ramp: {
			0.0->top.
			0.7->bottom.})
		origin: aMorph bounds origin;
		direction: 0 @ anInteger;
		radial: false! !

!GLMWhitespaceTheme methodsFor: 'border-styles' stamp: 'TudorGirba 5/16/2013 22:10'!
taskbarThumbnailCornerStyleFor: aMorph
	"Answer the corner style for the taskbar thumbnail/tasklist."
	
	^#square! !

!GLMWhitespaceTheme methodsFor: 'forms' stamp: 'TudorGirba 12/7/2014 12:57'!
menuPinForm
	"Answer the form to use for the pin button of a menu."

	^ GLMThemeIcons menuPinForm! !

!GLMWhitespaceTheme methodsFor: 'fill-styles' stamp: 'TudorGirba 10/19/2013 03:21'!
morphTreeSplitterNormalFillStyleFor: aSplitter	
	^ SolidFillStyle color: Color transparent! !

!GLMWhitespaceTheme methodsFor: 'fill-styles-buttons' stamp: 'TudorGirba 5/16/2013 22:10'!
menuItemInDockingBarSelectedFillStyleFor: aMenuItem
	"Answer the selected fill style to use for the given menu item that is in a docking bar."
	^ self buttonSelectedFillStyleFor: aMenuItem! !

!GLMWhitespaceTheme methodsFor: 'forms' stamp: 'TudorGirba 12/7/2014 12:57'!
newWindowMinimizeForm
	"Answer a new form for a window minimize box."

	^ GLMThemeIcons windowMinimizeForm! !

!GLMWhitespaceTheme methodsFor: 'fill-styles-buttons' stamp: 'TudorGirba 5/16/2013 22:10'!
tabLabelNormalFillStyleFor: aTabLabel
	^ self buttonNormalFillStyleFor: aTabLabel ! !

!GLMWhitespaceTheme methodsFor: 'themers' stamp: 'TudorGirba 6/3/2014 08:22'!
rubScrolledTextMorphThemer
	^ RubScrolledTextMorphThemerForGLMWhitespaceTheme new! !

!GLMWhitespaceTheme methodsFor: 'accessing' stamp: 'TudorGirba 5/16/2013 22:10'!
windowActiveDropShadowStyle: anObject
	"Set the value of windowActiveDropShadowStyle"
	windowActiveDropShadowStyle := anObject! !

!GLMWhitespaceTheme methodsFor: 'fill-styles' stamp: 'TudorGirba 5/19/2013 21:45'!
windowActiveTitleFillStyleFor: aWindow
	^ SolidFillStyle color: (self glamorousDarkBaseColorFor: aWindow)! !

!GLMWhitespaceTheme methodsFor: 'fill-styles' stamp: 'TudorGirba 5/16/2013 22:10'!
morphTreeSplitterPressedFillStyleFor: aSplitter	
	^ self splitterPressedFillStyleFor: aSplitter! !

!GLMWhitespaceTheme methodsFor: 'fill-styles' stamp: 'TudorGirba 9/6/2013 07:39'!
splitterNormalFillStyleFor: aSplitter
	"Return the normal splitter fillStyle for the given splitter."
	
	^ self 
		glamorousNormalFillStyleFor: aSplitter 
		height: 1! !

!GLMWhitespaceTheme methodsFor: 'label-styles' stamp: 'TudorGirba 5/16/2013 22:10'!
windowMenuPassiveForm
	"Answer the form to use for passive (background) window menu buttons"

	^self newWindowMenuPassiveForm! !

!GLMWhitespaceTheme methodsFor: 'private' stamp: 'TudorGirba 5/16/2013 22:10'!
glamorousBasePassiveBackgroundColorFor: aButton
	^ self class basePassiveBackgroundColor! !

!GLMWhitespaceTheme methodsFor: 'fill-styles' stamp: 'TudorGirba 5/21/2013 21:20'!
windowEdgeNormalFillStyleFor: anEdgeGrip
	"Return the normal window edge fillStyle for the given edge grip."
	self flag: 'this is used for the long edges'.
	^ super windowEdgeNormalFillStyleFor: anEdgeGrip
	"self glamorousDarkBaseColorFor: anEdgeGrip"! !

!GLMWhitespaceTheme methodsFor: 'growl - specific' stamp: 'TudorGirba 10/24/2014 22:52'!
growlFillColorFor: aGrowlMorph
	^ Color white darker! !

!GLMWhitespaceTheme methodsFor: 'forms' stamp: 'TudorGirba 12/7/2014 12:57'!
newRadioButtonMarkerForm
	"Answer a new radio button marker form. We make it empty because we already have the selected radio button take care of the state."

	^GLMThemeIcons radioButtonMarkerForm  ! !

!GLMWhitespaceTheme methodsFor: 'border-styles-scrollbars' stamp: 'TudorGirba 5/16/2013 22:10'!
scrollbarPagingAreaCornerStyleIn: aThemedMorph	
	^#square! !

!GLMWhitespaceTheme methodsFor: 'fill-styles-scrollbars' stamp: 'TudorGirba 5/19/2013 14:41'!
scrollbarNormalThumbFillStyleFor: aScrollbar
	"Return the normal scrollbar fillStyle for the given scrollbar."
	^ self 
		glamorousVisibleFillStyleFor: aScrollbar 
		height: aScrollbar height! !

!GLMWhitespaceTheme methodsFor: 'forms' stamp: 'TudorGirba 12/7/2014 12:57'!
radioButtonSelectedForm
	"Answer the form to use for a selected radio button."

	^ GLMThemeIcons radioButtonSelectedForm ! !

!GLMWhitespaceTheme methodsFor: 'private' stamp: 'TudorGirba 5/16/2013 22:10'!
glamorousDarkBaseColorFor: aButton
	^ self class darkBaseColor! !

!GLMWhitespaceTheme methodsFor: 'forms' stamp: 'TudorGirba 12/7/2014 12:57'!
checkboxUnselectedForm
	"Answer the form to use for a selected checkbox."

	^ GLMThemeIcons checkboxUnselectedForm! !

!GLMWhitespaceTheme methodsFor: 'watcher window' stamp: 'TudorGirba 5/19/2013 21:18'!
configureWatcherWindowLabelAreaFor: aWindow
	"Configure the label area for the given Watcher window."

	|padding|
	padding := 0.
	aWindow labelArea
		addMorphBack: (Morph new extent: aWindow class borderWidth @ 0).
	aWindow hasCloseBox ifTrue: [aWindow addCloseBox. padding := padding + 1].
	aWindow labelArea
		addMorphBack: (Morph new extent: aWindow class borderWidth @ 0; hResizing: #spaceFill).
	aWindow basicLabel ifNotNil: [:label | aWindow labelArea addMorphBack: label; hResizing: #shrinkWrap].
	aWindow labelArea
		addMorphBack: (Morph new extent: aWindow class borderWidth @ 0; hResizing: #spaceFill).
	padding > 0 ifTrue: [
		aWindow labelArea
			addMorphBack: (Morph new extent: (aWindow boxExtent x * padding) @ 0)].
	aWindow labelArea
		addMorphBack: (Morph new extent: aWindow class borderWidth @ 0)! !

!GLMWhitespaceTheme methodsFor: 'fill-styles' stamp: 'TudorGirba 5/16/2013 22:10'!
separatorFillStyleFor: aSeparator
	"Return the separator fillStyle for the given separator."
	
	^ SolidFillStyle color: (self glamorousBaseColorFor: aSeparator) darker! !

!GLMWhitespaceTheme methodsFor: 'forms' stamp: 'TudorGirba 12/7/2014 12:57'!
newWindowMenuPassiveForm
	"Answer a new form for a window menu box."

	^ GLMThemeIcons windowMenuInactiveForm! !

!GLMWhitespaceTheme methodsFor: 'border-styles' stamp: 'TudorGirba 4/16/2014 15:22'!
dropListNormalBorderStyleFor: aDropList
	"Return the normal borderStyle for the given drop list"

	^ self glamorousLightBorderStyleFor: aDropList! !

!GLMWhitespaceTheme methodsFor: 'fill-styles' stamp: 'TudorGirba 5/16/2013 22:10'!
dockingBarNormalFillStyleFor: aToolDockingBar
	^ SolidFillStyle color: Color transparent! !

!GLMWhitespaceTheme methodsFor: 'defaults' stamp: 'TudorGirba 5/19/2013 21:33'!
windowShadowColor
	"Answer the window shadow color to use."

	^ Color transparent! !

!GLMWhitespaceTheme methodsFor: 'fill-styles' stamp: 'TudorGirba 5/21/2013 21:19'!
resizerGripNormalFillStyleFor: aResizer
	"Return the normal fillStyle for the given resizer.
	For the moment, answer a transparent colour for no drawing,
	non transparent to draw as normal."
	self flag: 'this is used for the edge grip'.
	^ super resizerGripNormalFillStyleFor: aResizer
	
"	aResizer 
		instVarNamed: #handleColor put: (self glamorousDarkBaseColorFor:  aResizer);
		instVarNamed: #dotColor put: Color transparent.
	
	^SolidFillStyle color: Color red"! !

!GLMWhitespaceTheme methodsFor: 'watcher window' stamp: 'TudorGirba 5/16/2013 22:10'!
watcherWindowActiveFillStyleFor: aWindow

	^ SolidFillStyle color: (Color veryVeryLightGray alpha: 0.6)! !

!GLMWhitespaceTheme methodsFor: 'growl - specific' stamp: 'TudorGirba 5/19/2013 14:09'!
growlContentsColorFor: aGrowlMorph
	^ Color black! !

!GLMWhitespaceTheme methodsFor: 'basic-colors' stamp: 'TudorGirba 5/16/2013 22:10'!
taskbarButtonLabelColorFor: aButton
	"Answer the colour for the label of the given taskbar button."

	^aButton model
		ifNil: [super taskbarButtonLabelColorFor: aButton]
		ifNotNil: [:win |
			win isActive
				ifTrue: [Color black]
				ifFalse: [Color gray darker]]! !

!GLMWhitespaceTheme methodsFor: 'private' stamp: 'TudorGirba 5/19/2013 14:39'!
glamorousVisibleFillStyleFor: aMorph height: anInteger
	"Return the normal button fillStyle for the given morph."

	^ SolidFillStyle color: (self glamorousLightColorFor: aMorph)! !

!GLMWhitespaceTheme methodsFor: 'border-styles-buttons' stamp: 'TudorGirba 5/16/2013 22:10'!
buttonSelectedBorderStyleFor: aButton
	^ self buttonNormalBorderStyleFor: aButton! !

!GLMWhitespaceTheme methodsFor: 'private' stamp: 'TudorGirba 5/16/2013 22:10'!
glamorousBaseColorFor: aButton
	^ self class baseColor
	"unfortunately, it looks like paneColor does not always return the wanted color"
	"aButton paneColorOrNil ifNil: [Color r: 200 g: 200 b: 200 range: 255]"! !

!GLMWhitespaceTheme methodsFor: 'initialize-release' stamp: 'TudorGirba 5/16/2013 22:10'!
newTreeExpandedForm
	"Answer a new form for an expanded tree item."

	^(Form
	extent: 9@9
	depth: 32
	fromArray: #( 1049135240 2290649224 2290649224 2290649224 2290649224 2290649224 2290649224 2290649224 1200130184 478709896 4169697416 4287137928 4287137928 4287137928 4287137928 4287137928 4236806280 646482056 16777215 2508753032 4287137928 4287137928 4287137928 4287137928 4287137928 2726856840 16777215 16777215 495487112 4186474632 4287137928 4287137928 4287137928 4236806280 612927624 16777215 16777215 16777215 2542307464 4287137928 4287137928 4287137928 2676525192 16777215 16777215 16777215 16777215 478709896 4169697416 4287137928 4220029064 579373192 16777215 16777215 16777215 16777215 16777215 2424866952 4287137928 2626193544 16777215 16777215 16777215 16777215 16777215 16777215 394823816 4018702472 529041544 16777215 16777215 16777215 16777215 16777215 16777215 16777215 864585864 16777215 16777215 16777215 16777215)
	offset: 0@0)! !

!GLMWhitespaceTheme methodsFor: 'fill-styles' stamp: 'TudorGirba 5/16/2013 22:10'!
progressFillStyleFor: aProgress
	"Return the progress fillStyle for the given progress morph."
	^ self windowActiveFillStyleFor: aProgress  ! !

!GLMWhitespaceTheme methodsFor: 'border-styles-buttons' stamp: 'TudorGirba 4/16/2014 15:22'!
buttonNormalBorderStyleFor: aButton
	"Return the normal button borderStyle for the given button."

	(aButton valueOfProperty: #noBorder ifAbsent: [false]) ifTrue: [
		^ SimpleBorder new width: 0; baseColor: Color transparent ].
	^ self glamorousNoBorderFor: aButton! !

!GLMWhitespaceTheme methodsFor: 'label-styles' stamp: 'TudorGirba 5/16/2013 22:10'!
createMenuBoxFor: aSystemWindow
	"Answer a button for the window menu."
	
"	^aSystemWindow createBox
		labelGraphic: (self windowMenuIconFor: aSystemWindow);
		extent: aSystemWindow boxExtent;
		actWhen: #buttonDown;
		actionSelector: #offerWindowMenu;
		setBalloonText: 'window menu' translated"
	
	|form msb|
	form := self windowMenuForm.
	msb := MultistateButtonMorph new extent: form extent.
	msb activeEnabledNotOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowMenuPassiveForm.
	msb extent: form extent.
	msb activeDisabledNotOverUpFillStyle: (ImageFillStyle form: form).
	msb passiveEnabledNotOverUpFillStyle: (ImageFillStyle form: form).
	msb passiveDisabledNotOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowMenuForm.
	msb extent: form extent.
	msb
		activeEnabledOverUpFillStyle: (ImageFillStyle form: form);
		passiveEnabledOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowMenuPassiveForm.
	msb
		extent: form extent;
		activeEnabledOverDownFillStyle: (ImageFillStyle form: form);
		passiveEnabledOverDownFillStyle: (ImageFillStyle form: form);
		addUpAction: [aSystemWindow offerWindowMenu];
		setBalloonText: 'window menu' translated;
		extent: aSystemWindow boxExtent.
	^msb! !

!GLMWhitespaceTheme methodsFor: 'private' stamp: 'TudorGirba 4/16/2014 15:22'!
glamorousLightBorderStyleFor: aTextEditor
	^ SimpleBorder new
		baseColor: (self glamorousLightColorFor: aTextEditor);
		width: 1! !

!GLMWhitespaceTheme methodsFor: 'forms' stamp: 'TudorGirba 12/7/2014 12:57'!
windowClosePassiveForm
	"Answer the form to use for passive (background) window close buttons"

	^GLMThemeIcons windowCloseInactiveForm! !

!GLMWhitespaceTheme methodsFor: 'fill-styles' stamp: 'TudorGirba 5/16/2013 22:10'!
dropListNormalFillStyleFor: aDropList
	"Return the normal fillStyle for the given drop list."
	
	^ SolidFillStyle color: Color white! !

!GLMWhitespaceTheme methodsFor: 'label-styles' stamp: 'TudorGirba 5/16/2013 22:10'!
windowMinimizeOverForm
	"Answer the form to use for mouse over window minimize buttons"

	^self forms at: #windowMinimizeOver ifAbsent: [Form extent: 16@16 depth: Display depth]! !

!GLMWhitespaceTheme methodsFor: 'forms' stamp: 'TudorGirba 12/7/2014 12:57'!
windowMinimizePassiveForm
	"Answer the form to use for passive (background) window minimize buttons"

	^GLMThemeIcons windowMinimizeInactiveForm! !

!GLMWhitespaceTheme methodsFor: 'fill-styles' stamp: 'TudorGirba 5/16/2013 22:10'!
expanderTitleNormalFillStyleFor: anExpanderTitle
	"Return the normal expander title fillStyle for the given expander title."
	
	^ self buttonNormalFillStyleFor: anExpanderTitle! !

!GLMWhitespaceTheme methodsFor: 'forms' stamp: 'TudorGirba 5/16/2013 22:10'!
newWindowMaximizeOverForm
	"Answer a new form for a window menu box."

	^ self newWindowMaximizeForm! !

!GLMWhitespaceTheme methodsFor: 'private' stamp: 'TudorGirba 5/16/2013 22:10'!
glamorousBaseSelectionColorFor: aButton
	^ self class baseSelectionColor! !

!GLMWhitespaceTheme methodsFor: 'defaults' stamp: 'TudorGirba 5/16/2013 22:10'!
dialogWindowPreferredCornerStyleFor: aDialogWindow
	"Answer the preferred corner style for the given dialog."

	^#square! !

!GLMWhitespaceTheme methodsFor: 'scrollbars' stamp: 'TudorGirba 5/19/2013 14:46'!
scrollbarArrowOfDirection: aSymbol size: finalSizeInteger color: aColor
	^ Form extent: 1@1! !

!GLMWhitespaceTheme methodsFor: 'label-styles' stamp: 'TudorGirba 5/16/2013 22:10'!
createExpandBoxFor: aSystemWindow
	"Answer a button for maximising/restoring the window."
	
	|form msb|
	form := self windowMaximizeForm.
	msb := MultistateButtonMorph new extent: form extent.
	msb activeEnabledNotOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowMaximizePassiveForm.
	msb extent: form extent.
	msb passiveEnabledNotOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowMaximizeOverForm.
	msb extent: form extent.
	msb
		activeEnabledOverUpFillStyle: (ImageFillStyle form: form);
		passiveEnabledOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowMaximizePassiveForm.
	msb
		extent: form extent;
		activeEnabledOverDownFillStyle: (ImageFillStyle form: form);
		passiveEnabledOverDownFillStyle: (ImageFillStyle form: form);
		addUpAction: [aSystemWindow expandBoxHit];
		setBalloonText: 'Expand to full screen' translated;
		extent: aSystemWindow boxExtent.
	^msb! !

!GLMWhitespaceTheme methodsFor: 'border-styles' stamp: 'TudorGirba 4/16/2014 15:22'!
listNormalBorderStyleFor: aList
	"Return the normal borderStyle for the given list"
		
	^ self glamorousNoBorderFor: aList! !

!GLMWhitespaceTheme methodsFor: 'morph creation' stamp: 'TudorGirba 5/16/2013 22:10'!
newFocusIndicatorMorphFor: aMorph
	"Answer a new focus indicator for the given morph."

	|radius|
	radius := aMorph focusIndicatorCornerRadius.
	^ BorderedMorph new
		fillStyle: Color transparent;
		borderStyle: (SimpleBorder new
			 width: 1;
			baseColor: (self glamorousBaseSelectionColorFor: aMorph));
		bounds: aMorph focusBounds! !

!GLMWhitespaceTheme methodsFor: 'border-styles' stamp: 'TudorGirba 5/19/2013 16:32'!
plainGroupPanelBorderStyleFor: aGroupPanel
	"Answer the normal border style for a plain group panel."

	^SimpleBorder new
		width: 1;
		baseColor: Color transparent! !

!GLMWhitespaceTheme methodsFor: 'border-styles' stamp: 'TudorGirba 5/21/2013 20:57'!
configureWindowBorderFor: aWindow
	^ self glamorousThickBorderFor: aWindow! !

!GLMWhitespaceTheme methodsFor: 'forms' stamp: 'TudorGirba 5/16/2013 22:10'!
checkboxForm
	"Answer the form to use for a normal checkbox."

	^self  checkboxUnselectedForm! !

!GLMWhitespaceTheme methodsFor: 'border-styles' stamp: 'TudorGirba 4/16/2014 17:52'!
tabPanelBorderStyleFor: aTabGroup
	^ GLMTabPanelBorder new 
		width: 1;
		baseColor: (self glamorousLightColorFor: aTabGroup);
		tabSelector: aTabGroup tabSelectorMorph! !

!GLMWhitespaceTheme methodsFor: 'label-styles' stamp: 'TudorGirba 5/16/2013 22:10'!
windowCloseOverForm
	"Answer the form to use for mouse over window close buttons"

	^self forms at: #windowCloseOver ifAbsent: [Form extent: 16@16 depth: Display depth]! !

!GLMWhitespaceTheme methodsFor: 'basic-colors' stamp: 'TudorGirba 5/19/2013 14:31'!
subgroupColorFrom: paneColor
	"Answer the colour for a subgroup given the pane colour."

	^ self glamorousBaseColorFor: paneColor! !

!GLMWhitespaceTheme methodsFor: 'fill-styles' stamp: 'TudorGirba 5/16/2013 22:10'!
windowInactiveFillStyleFor: aWindow
	"We do not want the lighting effect when the window goes inactive"
	^self windowActiveFillStyleFor: aWindow! !

!GLMWhitespaceTheme methodsFor: 'private' stamp: 'TudorGirba 5/20/2013 22:36'!
glamorousNormalFillStyleFor: aMorph height: anInteger
	"Return the normal button fillStyle for the given morph."

	^ SolidFillStyle color: (self glamorousLightColorFor: aMorph)! !

!GLMWhitespaceTheme methodsFor: 'forms' stamp: 'TudorGirba 12/7/2014 12:57'!
newWindowMaximizeForm
	"Answer a new form for a window maximize box."

	^ GLMThemeIcons windowMaximizeForm! !

!GLMWhitespaceTheme methodsFor: 'growl - specific' stamp: 'TudorGirba 5/16/2013 22:10'!
growlDismissHandleFor: aGrowlMorph
	| form image |
	form := self windowCloseForm.
	image := ImageMorph new.
	image image: form.
	image color: Color yellow.
	^ image! !

!GLMWhitespaceTheme methodsFor: 'fill-styles' stamp: 'TudorGirba 5/16/2013 22:10'!
progressBarProgressFillStyleFor: aProgressBar
	^ (self glamorousLightSelectionColorFor: aProgressBar)! !

!GLMWhitespaceTheme methodsFor: 'fill-styles-scrollbars' stamp: 'TudorGirba 5/19/2013 14:41'!
scrollbarNormalButtonFillStyleFor: aScrollbar
	"Return the normal scrollbar button fillStyle for the given scrollbar."
	
	^ self 
		glamorousNormalFillStyleFor: aScrollbar 
		height: aScrollbar height! !

!GLMWhitespaceTheme methodsFor: 'border-styles' stamp: 'TudorGirba 5/16/2013 22:10'!
tabLabelNormalBorderStyleFor: aTabLabel
"	^SimpleBorder new
		width: 0;
		baseColor: (self buttonBaseColorFor: aTabLabel) darker
"	^ self buttonNormalBorderStyleFor: aTabLabel! !

!GLMWhitespaceTheme methodsFor: 'fill-styles' stamp: 'TudorGirba 5/16/2013 22:10'!
textEditorDisabledFillStyleFor: aTextEditor
	"Return the disabled fillStyle for the given text editor."
	
	^self glamorousBasePassiveBackgroundColorFor: aTextEditor! !

!GLMWhitespaceTheme methodsFor: 'fill-styles-buttons' stamp: 'TudorGirba 5/16/2013 22:10'!
buttonNormalFillStyleFor: aButton
	"Return the normal button fillStyle for the given button."
	
	(aButton valueOfProperty: #noFill ifAbsent: [false]) ifTrue: [^ SolidFillStyle color: Color transparent ].
	^ self glamorousNormalFillStyleFor: aButton height: aButton height! !

!GLMWhitespaceTheme methodsFor: 'initialize-release' stamp: 'TudorGirba 5/16/2013 22:10'!
newTreeUnexpandedForm
	"Answer a new form for an unexpanded tree item."

	^(Form
	extent: 9@9
	depth: 32
	fromArray: #( 1049135240 461932680 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2324203656 4152920200 2458421384 428378248 16777215 16777215 16777215 16777215 16777215 2357758088 4287137928 4287137928 4152920200 2408089736 394823816 16777215 16777215 16777215 2391312520 4287137928 4287137928 4287137928 4287137928 4119365768 2324203656 344492168 16777215 2408089736 4287137928 4287137928 4287137928 4287137928 4287137928 4287137928 3968370824 780699784 2391312520 4287137928 4287137928 4287137928 4287137928 4236806280 2659747976 529041544 16777215 2357758088 4287137928 4287137928 4253583496 2810742920 646482056 16777215 16777215 16777215 2324203656 4253583496 2777188488 696813704 16777215 16777215 16777215 16777215 16777215 1200130184 663259272 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: 0@0)! !

!GLMWhitespaceTheme methodsFor: 'label-styles' stamp: 'TudorGirba 5/16/2013 22:10'!
createCollapseBoxFor: aSystemWindow
	"Answer a button for minimising the window."
	
	|form msb|
	form := self windowMinimizeForm.
	msb := MultistateButtonMorph new extent: form extent.
	msb activeEnabledNotOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowMinimizePassiveForm.
	msb extent: form extent.
	msb passiveEnabledNotOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowMinimizeOverForm.
	msb extent: form extent.
	msb
		activeEnabledOverUpFillStyle: (ImageFillStyle form: form);
		passiveEnabledOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowMinimizePassiveForm.
	msb
		extent: form extent;
		activeEnabledOverDownFillStyle: (ImageFillStyle form: form);
		passiveEnabledOverDownFillStyle: (ImageFillStyle form: form);
		addUpAction: [aSystemWindow collapseBoxHit];
		setBalloonText: 'Collapse this window' translated;
		extent: aSystemWindow boxExtent.
	^msb! !

!GLMWhitespaceTheme methodsFor: 'forms' stamp: 'TudorGirba 12/7/2014 12:57'!
newWindowCloseForm
	"Answer a new form for a window close box."

	^ GLMThemeIcons windowCloseForm ! !

!GLMWhitespaceTheme class methodsFor: 'private' stamp: 'TudorGirba 12/7/2014 12:57'!
importGlamorousIcons
	"utility method to import the icons necessary for the theme from the file system"
	"self importGlamorousIcons"
	| icons |
	icons := #(
		'glamorousMax'
		'glamorousMin'
		'glamorousClose'
		'glamorousMenu'
		'glamorousMaxInactive'
		'glamorousMinInactive'
		'glamorousCloseInactive'
		'glamorousMenuInactive'
		'glamorousMenuPin'
		'glamorousCheckboxSelected'
		'glamorousCheckboxUnselected'
		'glamorousRadioSelected'
		'glamorousRadioUnselected').
	self importIcons: icons fromFolder: 'icons' inClass: GLMThemeIcons category: '*glamour-morphic-theme'! !

!GLMWhitespaceTheme class methodsFor: 'accessing' stamp: 'TudorGirba 5/20/2013 06:30'!
darkBaseColor
	^ Color r: 210 g: 210 b: 210 range: 255! !

!GLMWhitespaceTheme class methodsFor: 'private' stamp: 'TudorGirba 5/16/2013 22:10'!
importIcons: icons fromFolder: aString inClass: aClass category: aCategory
	icons
		do: [:each |
			| method form |
			form := PNGReadWriter formFromFileNamed: aString, '/', each , '.png'.
			method := each , Character cr asString ,
				(aClass methodStart: each),		
				form storeString,
				aClass methodEnd.
			aClass class compile: method classified: aCategory ].
	aClass initialize! !

!GLMWhitespaceTheme class methodsFor: 'testing' stamp: 'TudorGirba 5/16/2013 22:10'!
isAbstract
	"Answer whether the receiver is considered to be abstract."

	^false! !

!GLMWhitespaceTheme class methodsFor: 'settings' stamp: 'TudorGirba 4/22/2014 14:10'!
setPreferredShoutColors
	"self setPreferredShoutColors"

	SHTextStylerST80 styleTable: 
		#(
			"(symbol color [emphasisSymbolOrArray [textStyleName [pixelHeight]]])" 
			(default 								black)
			(invalid 									red)
			(excessCode 							red)
			(comment 								(gray darker))
			(unfinishedComment 					(red muchDarker))
			(#'$' 									(red muchDarker))
			(character 								(red muchDarker))
			(integer 								(red muchDarker))
			(number 								(red muchDarker)) 
			(#- 										(red muchDarker))
			(symbol 								(magenta muchDarker)) 
			(stringSymbol 							(magenta muchDarker)) 
			(literalArray 							(magenta muchDarker))
			(string 									(magenta muchDarker) normal)
			(unfinishedString 						red normal)
			(assignment 							nil)
			(ansiAssignment 						nil)
			(literal 									nil italic)
			(keyword 								(black))
			(binary 									(black)) 
			(unary 									(black))
			(incompleteIdentifier 				(gray muchDarker))
			(incompleteKeyword 					(gray muchDarker))
			(incompleteBinary 						(gray muchDarker)) 
			(incompleteUnary 						(gray muchDarker))
			(undefinedIdentifier 					red)
			(undefinedKeyword 						red)
			(undefinedBinary 						red) 
			(undefinedUnary 						red) 
			(patternKeyword 						nil bold)
			(patternBinary 							nil bold)
			(patternUnary 							nil bold) 
			(#self 									(cyan muchDarker ))
			(#super 								(cyan muchDarker ))
			(#true 									(red muchDarker))
			(#false 									(red muchDarker))
			(#nil 									(red muchDarker))
			(#thisContext 							(cyan muchDarker ))
			(#return 								(cyan muchDarker ) bold)
			(patternArg 							(blue muchDarker)) 
			(methodArg 							(blue muchDarker))
			(blockPatternArg 						(blue muchDarker))
			(blockArg 								(blue muchDarker))
			(argument 								(blue muchDarker))
			(blockArgColon 						black)
			(leftParenthesis 						black)
			(rightParenthesis 						black)
			(leftParenthesis1 						(green muchDarker))
			(rightParenthesis1 						(green muchDarker))
			(leftParenthesis2 						(magenta muchDarker))
			(rightParenthesis2 						(magenta muchDarker))
			(leftParenthesis3 						(red muchDarker))
			(rightParenthesis3 						(red muchDarker))
			(leftParenthesis4 						(green darker))
			(rightParenthesis4 						(green darker))
			(leftParenthesis5 						(orange darker))
			(rightParenthesis5 						(orange darker))
			(leftParenthesis6 						(magenta darker))
			(rightParenthesis6 						(magenta darker))
			(leftParenthesis7 						blue)
			(rightParenthesis7 						blue)
			(blockStart 								black)
			(blockEnd 								black)
			(blockStart1 							(green muchDarker))
			(blockEnd1 								(green muchDarker))
			(blockStart2 							(magenta muchDarker))
			(blockEnd2 								(magenta muchDarker))
			(blockStart3 							(red muchDarker))
			(blockEnd3 								(red muchDarker))
			(blockStart4 							(green darker))
			(blockEnd4 								(green darker))
			(blockStart5 							(orange darker))
			(blockEnd5 								(orange darker))
			(blockStart6 							(magenta darker))
			(blockEnd6 								(magenta darker))
			(blockStart7 							blue)
			(blockEnd7 								blue) 
			(arrayStart 								black)
			(arrayEnd 								black)
			(arrayStart1 							black)
			(arrayEnd1 								black)
			(leftBrace 								black)
			(rightBrace 								black)
			(cascadeSeparator 					black)
			(statementSeparator 					black)
			(externalCallType 						black)
			(externalCallTypePointerIndicator 		black)
			(primitiveOrExternalCallStart 			black bold)
			(primitiveOrExternalCallEnd 			black bold)
			(methodTempBar 						(black))
			(blockTempBar 						(black))
			(blockArgsBar 							(black))
			(primitive 								(green muchDarker))
			(pragmaKeyword 						(green muchDarker))
			(pragmaUnary 							(green muchDarker))
			(pragmaBinary 							(green muchDarker)) 
			(externalFunctionCallingConvention 	(green muchDarker) bold)
			(module 								(green muchDarker) bold)
			(blockTempVar 						(blue muchDarker))
			(blockPatternTempVar 					(blue muchDarker))
			(instVar 								(blue muchDarker))
			(workspaceVar 							(blue muchDarker))
			(tempVar 								(blue muchDarker))
			(patternTempVar 						(blue muchDarker))
			(poolConstant 							(blue muchDarker))
			(classVar 								(blue muchDarker))
			(globalVar 								(blue muchDarker)))
! !

!GLMWhitespaceTheme class methodsFor: 'settings' stamp: 'TudorGirba 5/16/2013 22:10'!
setPreferredPreferences
	NECPreferences 
		expandPrefixes: true;
		popupShowWithShortcut: Character tab asShortcut.! !

!GLMWhitespaceTheme class methodsFor: 'installing' stamp: 'TudorGirba 2/21/2015 23:58'!
installFullTheme
	"Installs full theme: 
		this theme
		default forts
		desktop background
		completion list colors"
		
	self beCurrent.
	self setPreferredShoutColors.
	self setPreferredWorldBackground.
	NECPreferences backgroundColor: UITheme current windowColor. 
	Paragraph insertionPointColor: UITheme current caretColor.! !

!GLMWhitespaceTheme class methodsFor: 'accessing' stamp: 'TudorGirba 5/16/2013 22:10'!
lightSelectionColor
	^ Color r: 175 g: 213 b: 250 range: 255! !

!GLMWhitespaceTheme class methodsFor: 'accessing' stamp: 'TudorGirba 5/16/2013 22:10'!
basePassiveBackgroundColor
	^ Color r: 245 g: 245 b: 245 range: 255! !

!GLMWhitespaceTheme class methodsFor: 'accessing' stamp: 'TudorGirba 4/16/2014 16:19'!
baseColor
	^ Color white! !

!GLMWhitespaceTheme class methodsFor: 'accessing' stamp: 'TudorGirba 5/16/2013 22:10'!
baseSelectionColor
	^ Color r: 97 g: 163 b: 225 range: 255! !

!GLMWhitespaceTheme class methodsFor: 'accessing' stamp: 'TudorGirba 1/7/2014 15:54'!
lightBaseColor
	^ Color r: 220 g: 220 b: 220 range: 255! !

!GLMWhitespaceTheme class methodsFor: 'accessing' stamp: 'TudorGirba 11/20/2014 18:36'!
themeName
	^ 'Glamorous Whitespace'! !

!GLMWhitespaceTheme class methodsFor: 'settings' stamp: 'TudorGirba 2/21/2015 23:58'!
setPreferredWorldBackground
	"self setPreferredWorldBackground"
	PolymorphSystemSettings desktopColor: (Color r: 250 g: 250 b: 250 range: 256)! !

!GLMWhitespaceTheme class methodsFor: 'accessing' stamp: 'TudorGirba 5/19/2013 21:49'!
veryLightSelectionColor
	^ Color white darker! !

!GLMWhitespaceTheme class methodsFor: 'settings' stamp: 'TudorGirba 5/20/2013 06:34'!
newDefaultSettings
	self setPreferredPreferences.
	
	BalloonMorph setBalloonColorTo: self veryLightSelectionColor.
	^super newDefaultSettings
		menuColor: self baseColor;
		menuTitleColor: self baseColor;
		windowColor: self baseColor;
		selectionColor: self lightSelectionColor;
		menuSelectionColor: self baseSelectionColor;
		progressBarColor: self baseColor;
		standardColorsOnly: true;
		autoSelectionColor: false;
		preferRoundCorner: false;
		fadedBackgroundWindows: false;
		secondarySelectionColor: self veryLightSelectionColor;
		flatMenu: true! !

!GLMWizard commentStamp: 'TorstenBergmann 3/10/2015 22:01'!
A wizard 

Instance Variables
	cancelButtonAction:		<Object>
	currentIndex:		<Object>
	externalCancelButtonAction:		<Object>
	externalNextButtonAction:		<Object>
	externalPreviousButtonAction:		<Object>
	externalTerminateButtonAction:		<Object>
	genericStep:		<Object>
	nextButtonAction:		<Object>
	previousButtonAction:		<Object>
	specificAnnouncementActions:		<Object>
	steps:		<Object>
	stepsAndPanes:		<Object>
	stepsDictionary:		<Object>
	terminateButtonAction:		<Object>
	wizardSize:		<Object>

cancelButtonAction
	- xxxxx

currentIndex
	- xxxxx

externalCancelButtonAction
	- xxxxx

externalNextButtonAction
	- xxxxx

externalPreviousButtonAction
	- xxxxx

externalTerminateButtonAction
	- xxxxx

genericStep
	- xxxxx

nextButtonAction
	- xxxxx

previousButtonAction
	- xxxxx

specificAnnouncementActions
	- xxxxx

steps
	- xxxxx

stepsAndPanes
	- xxxxx

stepsDictionary
	- xxxxx

terminateButtonAction
	- xxxxx

wizardSize
	- xxxxx
!
!GLMWizard methodsFor: 'building internal' stamp: 'cyrilledelaunay 3/31/2011 16:17'!
forwardSign
	^ 'Next >>'! !

!GLMWizard methodsFor: 'testing' stamp: 'cyrilledelaunay 4/4/2011 13:49'!
hasUniquePane

	^ self steps size = 1 and: [self stepToUse size = 1]! !

!GLMWizard methodsFor: 'accessing' stamp: 'cyrilledelaunay 4/4/2011 14:58'!
stepsAndPanesDictionary

	^ stepsDictionary ifNil: [stepsDictionary := Dictionary new]! !

!GLMWizard methodsFor: 'building pane' stamp: 'cyrilledelaunay 4/4/2011 16:47'!
notifyAndRemoveCurrentPane

	|oldPane   tmpPanes|
	tmpPanes := self stepsAndPanes at: self currentStep ifAbsentPut: [OrderedCollection new].
	oldPane :=  tmpPanes last.
	tmpPanes removeLast.
	self announce: (GLMPaneRemoved new
							pane: oldPane;
							browser: self;
							yourself ) 
	! !

!GLMWizard methodsFor: 'accessing - buttons actions ' stamp: 'cyrilledelaunay 4/1/2011 13:58'!
externalTerminateButtonAction: aBlock

	externalTerminateButtonAction := aBlock! !

!GLMWizard methodsFor: 'accessing' stamp: 'cyrilledelaunay 4/4/2011 13:16'!
stepsDictionary

	^ stepsDictionary ifNil: [stepsDictionary := Dictionary new]! !

!GLMWizard methodsFor: 'initialize-release' stamp: 'AndreiChis 10/5/2014 22:01'!
initialize

	super initialize.! !

!GLMWizard methodsFor: 'building internal' stamp: 'cyrilledelaunay 5/24/2011 14:31'!
setLastPaneButtonsTo: aValidator

	aValidator validator:  'Cancel' act:  [:input |
		self cancelButtonAction
		].
	aValidator validator: self backSign act: [:input |
		self previousButtonAction
		].
	aValidator validator: 'Finish' act:  [:input |
		self terminateButtonAction
		].! !

!GLMWizard methodsFor: 'testing' stamp: 'cyrilledelaunay 4/4/2011 13:33'!
atBeginning

	^ self currentIndex = 1 and: [
		self stepToUse atBeginning
		]! !

!GLMWizard methodsFor: 'accessing - scripting' stamp: 'cyrilledelaunay 4/4/2011 14:23'!
genericStep

	|tmpSymbol|
	tmpSymbol := (self defaultStepName, self steps size asString) asSymbol.
	self steps add: tmpSymbol.
	^ self stepsDictionary at: tmpSymbol put: GLMWizardGenericStep new.! !

!GLMWizard methodsFor: 'events' stamp: 'cyrilledelaunay 4/12/2011 12:08'!
populateInputOfStep: aGLMWiizardStep

	self stepToUse previousStep isEmpty
		ifTrue: [
			self stepToUse input: (self pane port: #entity) value.
			]
		ifFalse: [
			(self stepToUse previousStep size = 1)
				ifTrue: [
					self stepToUse input: ((self stepsAndPanes at: self stepToUse previousStep anyOne) last port: #selection) value.
					]
				ifFalse: [
					|tmpInputs|
					tmpInputs := self stepToUse previousStep collect: [:aSymbol |
						((self stepsAndPanes at: aSymbol) last port: #selection) value
						].
					self stepToUse input: tmpInputs
					].
			].
	
			! !

!GLMWizard methodsFor: 'building internal' stamp: 'cyrilledelaunay 4/1/2011 14:04'!
backSign
	^ '<< Back'! !

!GLMWizard methodsFor: 'accessing - buttons actions ' stamp: 'cyrilledelaunay 4/1/2011 14:01'!
previousButtonAction

		self externalPreviousButtonAction value: self entity.
		self updateWhenPrevious
		! !

!GLMWizard methodsFor: 'events' stamp: 'cyrilledelaunay 4/1/2011 11:52'!
updatePane

	|tmpPane|
	self notifyAndSetAsCurrentPane: self computePane.! !

!GLMWizard methodsFor: 'accessing - buttons actions ' stamp: 'cyrilledelaunay 4/1/2011 14:24'!
terminateButtonAction

	self externalTerminateButtonAction value: self entity.
	self announce: (GLMBrowserClosed new)
		! !

!GLMWizard methodsFor: 'accessing' stamp: 'cyrilledelaunay 3/31/2011 14:56'!
currentIndex: anInteger

	currentIndex := anInteger! !

!GLMWizard methodsFor: 'accessing - buttons actions ' stamp: 'cyrilledelaunay 4/1/2011 13:58'!
onPreviousDo: aBlock

	self externalPreviousButtonAction: aBlock! !

!GLMWizard methodsFor: 'private' stamp: 'cyrilledelaunay 4/4/2011 13:48'!
stepToUse

	^ self stepsDictionary at: (self steps at: self currentIndex) 
		! !

!GLMWizard methodsFor: 'accessing - buttons actions ' stamp: 'cyrilledelaunay 4/1/2011 13:41'!
externalCancelButtonAction: aBlock

	externalCancelButtonAction := aBlock! !

!GLMWizard methodsFor: 'building pane' stamp: 'cyrilledelaunay 4/4/2011 14:35'!
computePane

	self hasUniquePane ifTrue: [^ self computePaneWith: self computeSinglePaneValidator].
	self atBeginning ifTrue: [^ self computePaneWith: self computeFirstPaneValidator].
	self atEnd ifTrue: [^ self computePaneWith: self computeLastPaneValidator].
	^( self computePaneWith: self computeMiddlePaneValidator).
	
! !

!GLMWizard methodsFor: 'accessing' stamp: 'cyrilledelaunay 4/4/2011 16:01'!
currentStep 

	^ self steps at: self currentIndex! !

!GLMWizard methodsFor: 'events' stamp: 'cyrilledelaunay 5/25/2011 10:57'!
updateBrowserTitle
	self title: self stepToUse name.
	self update! !

!GLMWizard methodsFor: 'building internal' stamp: 'cyrilledelaunay 5/24/2011 14:31'!
setSinglePaneButtonsTo: aValidator

	aValidator validator: 'Cancel' act: [:input |
		self cancelButtonAction
		].
	aValidator validator: 'Finish' act: [:input |
		self terminateButtonAction
		].
	! !

!GLMWizard methodsFor: 'building internal' stamp: 'cyrilledelaunay 4/1/2011 14:02'!
setMiddlePaneButtonsTo: aValidator

	aValidator validator: 'Cancel' act: [:input |
		self cancelButtonAction 
		].
	aValidator validator: self backSign act: [:input |
		self previousButtonAction
		].
	aValidator validator: self forwardSign act: [:input |
		self nextButtonAction
		].
	! !

!GLMWizard methodsFor: 'accessing - scripting' stamp: 'cyrilledelaunay 4/4/2011 14:22'!
step


	|tmpSymbol|
	tmpSymbol := (self defaultStepName, self steps size asString) asSymbol.
	self steps add: tmpSymbol.
	^ self stepsDictionary at: tmpSymbol put: GLMWizardStep new.! !

!GLMWizard methodsFor: 'building internal' stamp: 'cyrilledelaunay 4/1/2011 14:04'!
setFirstPaneButtonsTo: aValidator

	aValidator validator: 'Cancel' act:  [:input |
		self cancelButtonAction
		] .
	aValidator validator: self forwardSign act: [:input |
		self nextButtonAction 
		] populatePorts: #(#selection).! !

!GLMWizard methodsFor: 'building internal' stamp: 'cyrilledelaunay 3/31/2011 15:47'!
computeMiddlePaneValidator

	|tmpValidator|
	tmpValidator := self computePaneValidator.
	self setMiddlePaneButtonsTo: tmpValidator.
	^ tmpValidator  
! !

!GLMWizard methodsFor: 'accessing' stamp: 'cyrilledelaunay 4/4/2011 16:15'!
currentIndex

	^ currentIndex ifNil: [currentIndex := 1]! !

!GLMWizard methodsFor: 'building pane' stamp: 'cyrilledelaunay 5/25/2011 10:57'!
computePaneWith: aValidator
	| tmpPane |
	tmpPane := GLMPane in: self.
	tmpPane addPresentation: aValidator.
	(tmpPane port: #entity) value: self stepToUse input.
	self updateBrowserTitle.
	^ tmpPane! !

!GLMWizard methodsFor: 'building internal' stamp: 'cyrilledelaunay 3/31/2011 15:46'!
computeFirstPaneValidator

	|tmpValidator|
	tmpValidator := self computePaneValidator.
	self setFirstPaneButtonsTo: tmpValidator.
	^ tmpValidator  
! !

!GLMWizard methodsFor: 'announcements' stamp: 'cyrilledelaunay 4/1/2011 10:36'!
specificAnnouncementActions

	^ specificAnnouncementActions ifNil: [specificAnnouncementActions := Dictionary new]! !

!GLMWizard methodsFor: 'accessing - buttons actions ' stamp: 'cyrilledelaunay 4/1/2011 13:43'!
externalPreviousButtonAction: aBlock

	externalPreviousButtonAction := aBlock! !

!GLMWizard methodsFor: 'accessing - scripting' stamp: 'cyrilledelaunay 4/4/2011 14:21'!
defaultStepName

	^'default_step_name'! !

!GLMWizard methodsFor: 'accessing - scripting' stamp: 'cyrilledelaunay 4/4/2011 13:15'!
genericStep: aSymbol 

	self steps add: (aSymbol).
	^ self stepsDictionary at: aSymbol put: GLMWizardGenericStep new.! !

!GLMWizard methodsFor: 'building pane' stamp: 'cyrilledelaunay 4/4/2011 16:22'!
notifyAndSetAsCurrentPane: aGLMPane

	|oldPane   tmpPanes|
	tmpPanes := self stepsAndPanes at: self currentStep ifAbsentPut: [OrderedCollection new].
	tmpPanes removeLast.
	tmpPanes addLast: aGLMPane.
	"self panes addLast: aGLMPane. " 
	self announce: (GLMPaneReplaced 
							oldPane: oldPane 
							newPane: tmpPanes last
							fromBrowser: self ) 
	! !

!GLMWizard methodsFor: 'accessing - buttons actions ' stamp: 'cyrilledelaunay 4/1/2011 13:54'!
externalTerminateButtonAction

	^ externalTerminateButtonAction ifNil: [externalTerminateButtonAction := [:input | ]]! !

!GLMWizard methodsFor: 'accessing - buttons actions ' stamp: 'cyrilledelaunay 4/1/2011 13:55'!
externalPreviousButtonAction

	^ externalPreviousButtonAction ifNil: [externalPreviousButtonAction := [:input | ]]! !

!GLMWizard methodsFor: 'accessing' stamp: 'cyrilledelaunay 4/1/2011 12:37'!
steps

	^ steps ifNil: [steps := OrderedCollection new]! !

!GLMWizard methodsFor: 'accessing ports' stamp: 'cyrilledelaunay 4/4/2011 15:47'!
entity: anObject

	super entity: anObject.
	self updateWhenNext! !

!GLMWizard methodsFor: 'building internal' stamp: 'cyrilledelaunay 3/31/2011 15:46'!
computeLastPaneValidator

	|tmpValidator|
	tmpValidator := self computePaneValidator.
	self setLastPaneButtonsTo: tmpValidator.
	^ tmpValidator  
! !

!GLMWizard methodsFor: 'accessing - buttons actions ' stamp: 'cyrilledelaunay 5/24/2011 17:09'!
nextButtonAction

		self externalNextButtonAction value: self entity. 
		self updateWhenNext.
		! !

!GLMWizard methodsFor: 'announcements' stamp: 'BernardoContreras 11/14/2014 19:09'!
setSpecificAnnouncementActionsTo: aRenderer

	self specificAnnouncementActions keysAndValuesDo: [:anAnnouncementClass :aSymbol |
		self when: anAnnouncementClass send: aSymbol to: aRenderer.
		]! !

!GLMWizard methodsFor: 'building pane' stamp: 'DiegoLont 9/11/2013 13:46'!
notifyAndAddNewPane: aGLMPane

	(self stepsAndPanes at: self currentStep ifAbsentPut: [OrderedCollection new])
		addLast: aGLMPane.  
	self announce: (GLMPaneAdded new
							pane: aGLMPane;
							browser: self;
							yourself ) 
	! !

!GLMWizard methodsFor: 'events' stamp: 'cyrilledelaunay 5/25/2011 10:58'!
updateWhenPrevious

	|tmpPane|
	self notifyAndRemoveCurrentPane.
	self stepToUse decrementNumberOfDisplay.
	self stepToUse overBeginning 
		ifTrue: [
			
			self currentIndex: self currentIndex - 1].
	self stepToUse input: self entity.
	self notifyAndSetAsCurrentPane: (self stepsAndPanes at: self currentStep) last .
	self updateBrowserTitle.! !

!GLMWizard methodsFor: 'accessing - buttons actions ' stamp: 'cyrilledelaunay 4/1/2011 13:58'!
onTerminateDo: aBlock

	self externalTerminateButtonAction: aBlock! !

!GLMWizard methodsFor: 'accessing - scripting' stamp: 'cyrilledelaunay 4/4/2011 13:14'!
step: aSymbol 

	self steps add: (aSymbol).
	^ self stepsDictionary at: aSymbol put: GLMWizardStep new.! !

!GLMWizard methodsFor: 'accessing - buttons actions ' stamp: 'cyrilledelaunay 4/1/2011 13:58'!
onNextDo: aBlock

	self externalNextButtonAction: aBlock! !

!GLMWizard methodsFor: 'accessing - buttons actions ' stamp: 'cyrilledelaunay 4/1/2011 13:55'!
externalNextButtonAction

	^ externalNextButtonAction ifNil: [externalNextButtonAction := [:input | ]]! !

!GLMWizard methodsFor: 'testing' stamp: 'cyrilledelaunay 4/4/2011 13:32'!
atEnd

	^ self currentIndex = self steps size and: [
		self stepToUse atEnd
		]! !

!GLMWizard methodsFor: 'accessing - buttons actions ' stamp: 'cyrilledelaunay 4/1/2011 13:56'!
externalCancelButtonAction

	^ externalCancelButtonAction ifNil: [externalCancelButtonAction := [:input | ]]! !

!GLMWizard methodsFor: 'building internal' stamp: 'AndreiChis 5/30/2013 22:09'!
computePaneValidator

	|tmpPresentation tmpValidator|
	tmpPresentation := (self stepToUse presentationBlock glamourValue: self transmission transmissionStrategy presentations).
	tmpValidator := GLMValidator new.
	tmpValidator show: [:a | a custom: tmpPresentation]. 
	"tmpValidator startOn: self entity."
	^ tmpValidator 
! !

!GLMWizard methodsFor: 'accessing' stamp: 'cyrilledelaunay 4/4/2011 14:59'!
stepsAndPanes

	^ stepsAndPanes ifNil: [stepsAndPanes := Dictionary new]! !

!GLMWizard methodsFor: 'announcements' stamp: 'cyrilledelaunay 4/1/2011 10:37'!
on: anAnnouncementClass send: aSelector

	self specificAnnouncementActions at: anAnnouncementClass  put: aSelector ! !

!GLMWizard methodsFor: 'accessing - buttons actions ' stamp: 'cyrilledelaunay 4/1/2011 13:57'!
onCancelDo: aBlock

	self externalCancelButtonAction: aBlock! !

!GLMWizard methodsFor: 'private' stamp: 'AndreiChis 5/29/2013 13:39'!
addPaneFrom: aPort 
	self panes addLast: self computePane.
	self newTransmission
		addActiveOrigin: aPort; 
		destination: (self panes last port: #entity); 
		presentations: (self presentations copy); 
		transmit! !

!GLMWizard methodsFor: 'accessing - buttons actions ' stamp: 'cyrilledelaunay 4/1/2011 13:42'!
externalNextButtonAction: aBlock

	externalNextButtonAction := aBlock ! !

!GLMWizard methodsFor: 'accessing - buttons actions ' stamp: 'cyrilledelaunay 4/1/2011 14:24'!
cancelButtonAction

	self externalCancelButtonAction value: self entity.
	self announce: (GLMBrowserClosed new)		! !

!GLMWizard methodsFor: 'rendering' stamp: 'TudorGirba 4/12/2011 12:45'!
renderGlamorouslyOn: aRenderer 
	^ aRenderer renderWizard: self! !

!GLMWizard methodsFor: 'building internal' stamp: 'cyrilledelaunay 3/31/2011 17:12'!
computeSinglePaneValidator

	|tmpValidator|
	tmpValidator := self computePaneValidator.
	self setSinglePaneButtonsTo: tmpValidator.
	^ tmpValidator  
! !

!GLMWizard methodsFor: 'events' stamp: 'cyrilledelaunay 5/25/2011 10:58'!
updateWhenNext

	|tmpPane|
	self populateInputOfStep: self stepToUse.  
	self stepToUse incrementNumberOfDisplay.
	self stepToUse overEnd
		ifTrue: [
			self currentIndex: self currentIndex + 1.
			self populateInputOfStep: self stepToUse.  
			].
	
	tmpPane := self computePane.
	self notifyAndAddNewPane: self computePane.
	! !

!GLMWizard methodsFor: 'private' stamp: 'cyrilledelaunay 3/31/2011 16:08'!
valueOf: anObject

	^ anObject moValue: (self pane port: #entity) value! !

!GLMWizard class methodsFor: 'examples' stamp: 'cyrilledelaunay 4/4/2011 13:59'!
linkedStepsExample

	"self linkedStepsExample"
	| wizard |
	wizard := GLMWizard new.
	(wizard step: #step1) 
		show: [:a |
			a list
				display: [:aList |
					aList
					].
			];
		name: 'first pane'
		.
	(wizard step: #step2) 
		from: #step1; 
		show: [:a |
			a list
				display: [:aNumber |
					1 to: aNumber
					]
			];
		name: 'second pane'.
	wizard openOn: (1 to: 100).
! !

!GLMWizard class methodsFor: 'examples' stamp: 'cyrilledelaunay 4/4/2011 14:11'!
genericStepWithGenericSizeExample

	"self genericStepWithGenericSizeExample"
	| wizard |
	wizard := GLMWizard new.
	(wizard genericStep: #step)
		show: [:a | 
		a list
			display: [:aNumber | 1 to: aNumber] 
		] ;
		name: 'Wizard pane';
		size: [:aNumber | aNumber].
	wizard openOn: 4.
! !

!GLMWizard class methodsFor: 'examples' stamp: 'cyrilledelaunay 4/4/2011 13:52'!
simpleExample

	"self simpleExample"
	| wizard |
	wizard := GLMWizard new.
	(wizard genericStep: #step)
		show: [:a | 
		a list
			display: [:list | list] 
		] ;
		name: 'Wizard pane';
		size: 2.
	wizard openOn: (1 to: 100).
! !

!GLMWizardGenericStep commentStamp: 'TorstenBergmann 3/10/2015 22:01'!
A generic step in a wizard

Instance Variables
	numberOfDisplayBlock:		<Object>
	size:		<Object>

numberOfDisplayBlock
	- xxxxx

size
	- xxxxx
!
!GLMWizardGenericStep methodsFor: 'accessing' stamp: 'cyrilledelaunay 4/4/2011 12:06'!
size: aNumberOrAblock

	size := aNumberOrAblock ! !

!GLMWizardGenericStep methodsFor: 'accessing' stamp: 'cyrilledelaunay 5/24/2011 16:38'!
numberOfDisplayBlock

	^ numberOfDisplayBlock! !

!GLMWizardGenericStep methodsFor: 'accessing' stamp: 'cyrilledelaunay 5/24/2011 16:38'!
numberOfDisplayBlock: aBlock

	"this method allow the user to externally control the progression of this step. In merlin for exemple, it can be usefull to have some 'conditions' to validate before going on. If those conditions are not validated, we do not progress"
	numberOfDisplayBlock := aBlock! !

!GLMWizardGenericStep methodsFor: 'accessing' stamp: 'AndreiChis 12/4/2012 11:08'!
size

	^ size glamourValue: self input! !

!GLMWizardGenericStep methodsFor: 'accessing' stamp: 'cyrilledelaunay 5/24/2011 16:42'!
numberOfDisplay
	
	self numberOfDisplayBlock isNil 
		ifFalse: [
			^ self numberOfDisplayBlock moValue: self input
			]
		ifTrue: [
			^ super numberOfDisplay
			].
	! !

!GLMWizardGenericStep methodsFor: 'initialize-release' stamp: 'cyrilledelaunay 4/4/2011 13:51'!
initialize

	super initialize.
	size := 1! !

!GLMWizardMorphicTest methodsFor: 'tests' stamp: ''!
testClose
	| wizard |
	wizard := GLMWizard new.
	(wizard genericStep: #step) show: [:a | a text ] ; size: 2.
	window := wizard openOn: 123.
	self assert: window owner notNil.
	wizard close.
	self assert: window owner isNil! !

!GLMWizardStep commentStamp: 'TorstenBergmann 3/10/2015 22:01'!
A step in a wizard!
!GLMWizardStep methodsFor: 'accessing' stamp: 'cyrilledelaunay 4/4/2011 12:04'!
size

	^ 1! !

!GLMWrapper commentStamp: '<historical>'!
The GLMWrapper is a browser that has only one pane and that is typically used as a placeholder.

The pane takes only entity as input.!
!GLMWrapper methodsFor: 'accessing' stamp: 'TudorGirba 5/18/2012 22:28'!
defaultPane 
	^ self panes anyOne ! !

!GLMWrapper methodsFor: 'initialize-release' stamp: 'TudorGirba 5/18/2012 22:20'!
initialize
	super initialize.
	self addDefaultPane.! !

!GLMWrapper methodsFor: 'events' stamp: 'AndreiChis 5/30/2013 21:50'!
outerPortEvent: aPortEvent 
	"We only treat the #entity port, and for it we simply trigger 
	a transmission to the default pane"

	super outerPortEvent: aPortEvent.
	aPortEvent port name = #entity ifFalse: [^self].
	self newTransmission
		addActiveOrigin: (aPortEvent port); 
		destination: (self panes anyOne port: #entity); 
		transmit! !

!GLMWrapper methodsFor: 'rendering' stamp: 'TudorGirba 5/13/2012 09:37'!
renderGlamorouslyOn: aRenderer 
	^ aRenderer renderWrapper: self! !

!GLMWrapper methodsFor: 'initialize-release' stamp: 'TudorGirba 5/19/2012 09:18'!
addDefaultPane
	self addPane: (GLMPane named: #default)! !

!GLMWrapper methodsFor: 'events' stamp: 'TudorGirba 5/19/2012 09:19'!
innerPortEvent: aPortEvent 
	"We forward all inner ports to the outside world"
	aPortEvent portName = #entity ifFalse: [
		"We don't want to resend the transmission, but use a new SimpleTransmission." 
		(self pane port: aPortEvent portName) value: aPortEvent value]! !

!GLMWrapperMorphicTest methodsFor: 'tests' stamp: 'AndreHora 5/9/2013 15:39'!
testSimple
	| wrapper textMorph |
	wrapper := GLMWrapper new.
	wrapper show: [ :a | a text ].
	window := wrapper openOn: 42.
	textMorph := self findWherePresentationIs: wrapper defaultPane presentations first in: window.
	self assert: textMorph text = '42'! !

!GLMWrapperTest methodsFor: 'tests' stamp: 'Nicolasanquetil 5/3/2013 15:19'!
testDefaultPane
	| browser |
	browser := GLMWrapper new.
	self assert: browser panes size equals: 1! !

!GLMWrapperTest methodsFor: 'tests' stamp: 'Nicolasanquetil 5/3/2013 15:04'!
testPresentationsAreInstalled
	| browser |
	browser := GLMWrapper new.
	browser show: [ :a | a text ].
	browser startOn: 42.
	self assert: browser panes anyOne presentations size equals: 1.
	self assert: (browser panes anyOne presentations first isKindOf: GLMTextPresentation)! !

!GTBytecodeBrowser commentStamp: 'MarcusDenker 10/16/2014 11:28'!
This is a simple browser that displays bytecode and previews each node on the source code.

Example:
self openOn: (self>>#compose) !
!GTBytecodeBrowser methodsFor: 'building' stamp: 'MarcusDenker 10/16/2014 11:29'!
sourceIn: a
	^ a smalltalkCode 
		smalltalkClass: [ :each | each method methodClass ]; 
		display: [ :each | each sourceCode ]! !

!GTBytecodeBrowser methodsFor: 'building' stamp: 'MarcusDenker 10/14/2014 16:14'!
compose
	self title: 'Tree'.
	self tabulator with: [ :browser |
		browser
			row: #tree;
			row: #source.
		browser transmit
			to: #tree;
			andShow: [ :a | self treeIn: a ].
		browser transmit
			to: #source;
			andShow: [ :a | self sourceIn: a ].
		browser transmit
			from: #tree;
			to: #source port: #selectionInterval;
			transformed: [ :rbNode | rbNode sourceInterval ].
		browser transmit
			toOutsidePort: #selection;
			from: #tree port: #selectedNode ]! !

!GTBytecodeBrowser methodsFor: 'building' stamp: 'MarcusDenker 10/14/2014 13:45'!
treeIn: a
	^ a tree
		rootsExpanded;
		display: [ :anObject | anObject symbolicBytecodes ];
		children: [ :each | each isArray ifTrue: [each] ifFalse: #() ];
		selectionPopulate: #selectedNode
			on: $o
			entitled: 'Open'
			with: [ :tree | tree selection ];
		format: [ :each | each printString].! !

!GTCurrentSpotterExceptionHandler methodsFor: 'accessing-defaults' stamp: 'StefanReichhart 3/18/2015 12:32'!
defaultAction
	^ self class defaultValue! !

!GTCurrentSpotterExceptionHandler class methodsFor: 'accessing-defaults' stamp: 'StefanReichhart 4/1/2015 09:50'!
defaultValue
	^ nil! !

!GTCurrentSpotterExceptionHandler class methodsFor: 'evaluating' stamp: 'StefanReichhart 3/18/2015 12:42'!
value
	^ self signal! !

!GTCurrentSpotterExceptionHandler class methodsFor: 'evaluating' stamp: 'StefanReichhart 3/18/2015 12:33'!
use: anObject during: aBlock
	
	^ aBlock on: self do: [ :notification | notification resume: anObject ]! !

!GTExample commentStamp: 'AndreiChis 10/30/2014 21:35'!
This encapsulates one example.!
!GTExample methodsFor: 'presentations' stamp: 'TudorGirba 4/8/2015 11:13'!
gtDisplayOn: stream
	
	stream 
		nextPutAll: provider name;
		nextPutAll: ' example: ';
		nextPutAll: self title! !

!GTExample methodsFor: 'accessing' stamp: 'AndreiChis 10/30/2014 12:23'!
selector

	^ selector! !

!GTExample methodsFor: 'accessing' stamp: 'AndreiChis 10/30/2014 12:23'!
provider

	^ provider! !

!GTExample methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 4/8/2015 10:12'!
spotterPreviewIn: aComposite inContext: aSpotter
	^ self result spotterPreviewIn: aComposite inContext: aSpotter! !

!GTExample methodsFor: 'presentations' stamp: 'AndreiChis 10/30/2014 14:35'!
gtDisplaySourceIn: composite

	^ self methodReference gtInspectorSourceIn: composite! !

!GTExample methodsFor: 'accessing' stamp: 'AndreiChis 10/30/2014 15:07'!
parentExample: anExample

	parentExample := anExample! !

!GTExample methodsFor: 'accessing' stamp: 'AndreiChis 10/30/2014 12:26'!
methodReference

	^ (self provider class compiledMethodAt: self selector) asRingDefinition! !

!GTExample methodsFor: 'testing' stamp: 'AndreiChis 10/30/2014 14:24'!
isGTExample
	
	^ true! !

!GTExample methodsFor: 'accessing' stamp: 'AndreiChis 10/30/2014 21:45'!
result

	^ result ifNil: [ result := self hasParentExample
			ifFalse: [ self provider perform: self selector ]
			ifTrue: [ self provider perform: self selector with: parentExample result ] ]! !

!GTExample methodsFor: 'accessing' stamp: 'AndreiChis 10/30/2014 12:23'!
selector: aSymbol

	selector := aSymbol! !

!GTExample methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 4/9/2015 13:05'!
gtInspectorSourceIn: composite
	<gtInspectorPresentationOrder: 0>
	^ self gtDisplaySourceIn: composite! !

!GTExample methodsFor: 'accessing' stamp: 'AndreiChis 10/30/2014 12:23'!
provider: anObject

	provider := anObject! !

!GTExample methodsFor: 'accessing' stamp: 'AndreiChis 10/30/2014 12:20'!
title

	^ title 
		ifNil: [ self result ]
		ifNotNil: [ title ]! !

!GTExample methodsFor: 'accessing' stamp: 'TudorGirba 3/21/2015 21:46'!
title: aString
	title := aString! !

!GTExample methodsFor: 'accessing' stamp: 'AndreiChis 10/30/2014 15:39'!
childrenExamples
	
	^ self extractionStrategy 
		ifNil: [ OrderedCollection new ]
		ifNotNil: [ self extractionStrategy childrenExamplesFor: self ]! !

!GTExample methodsFor: 'accessing' stamp: 'AndreiChis 10/30/2014 15:07'!
hasParentExample

	^ parentExample notNil! !

!GTExample methodsFor: 'accessing' stamp: 'AndreiChis 10/30/2014 15:39'!
extractionStrategy: anObject
	extractionStrategy := anObject! !

!GTExample methodsFor: 'accessing' stamp: 'AndreiChis 10/30/2014 15:39'!
extractionStrategy
	^ extractionStrategy! !

!GTExample class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 4/9/2015 13:25'!
gtExampleBasic
	<gtExample>
	^ self new
		provider: self;
		selector: #gtExampleBasic! !

!GTExampleExtractionStrategy commentStamp: 'AndreiChis 10/30/2014 21:35'!
I extract and create examples from an example provider.!
!GTExampleExtractionStrategy methodsFor: 'accessing' stamp: 'AndreiChis 3/25/2015 23:54'!
exampleDependencyPragma

	^ #gtExampleFrom:! !

!GTExampleExtractionStrategy methodsFor: 'example creation' stamp: 'AndreiChis 10/31/2014 11:00'!
childrenExamplesFor: anExample

	^ ((Pragma 
		allNamed: self exampleDependencyPragma 
		in: anExample provider class) select: [ :aPragma | 
			(aPragma argumentAt: 1) = anExample selector]) 
				ifEmpty: [ #() ]
				ifNotEmpty: [ :pragmas | 
					pragmas collect: [ :each | 
						(self createExampleFromDependencyPragma: each from: anExample provider) ] ]! !

!GTExampleExtractionStrategy methodsFor: 'example creation' stamp: 'AndreiChis 10/31/2014 10:59'!
rootExamplesFor: anExampleProvider
	| pragmas |

	pragmas := self examplePragmas 
		inject: OrderedCollection new
		into: [ :result :pragma |
			result , (Pragma 
				allNamed: pragma 
				in: anExampleProvider class)].
	^ (pragmas select: [ :each | each selector isUnary ])
			ifEmpty: [ #() ]
			ifNotEmpty: [ :examplePragmas | examplePragmas collect: [ :eachPragma | 
				self createExampleForExamplePragma: eachPragma from: anExampleProvider ] ]! !

!GTExampleExtractionStrategy methodsFor: 'example creation' stamp: 'TudorGirba 3/21/2015 21:47'!
createExampleForExamplePragma: aPragma from: anExampleProvider
	| example |
	
	example := self createExampleForMethod: aPragma method asRingDefinition from: anExampleProvider.
	aPragma arguments size = 1 
		ifTrue: [ example title: (aPragma argumentAt: 1) ]
		ifFalse: [ example title: aPragma selector ].
	^ example! !

!GTExampleExtractionStrategy methodsFor: 'example creation' stamp: 'AndreiChis 10/31/2014 10:54'!
createExampleFromDependencyPragma: aPragma from: anExampleProvider

	^ self 
		createExampleForExamplePragma: (aPragma method pragmas detect: [:each | 
				self examplePragmas includes: each keyword])
		from: anExampleProvider! !

!GTExampleExtractionStrategy methodsFor: 'example creation' stamp: 'AndreiChis 10/31/2014 10:53'!
createExampleForMethod: aMethod from: anExampleProvider
	| newExample |

	newExample := self exampleClass new
		selector: aMethod selector;
		extractionStrategy: self;
		provider: anExampleProvider.
	newExample parentExample: (self parentExampleFor: newExample).
	^ newExample! !

!GTExampleExtractionStrategy methodsFor: 'accessing' stamp: 'AndreiChis 10/31/2014 10:48'!
exampleClass

	^ GTExample! !

!GTExampleExtractionStrategy methodsFor: 'example creation' stamp: 'AndreiChis 10/31/2014 11:00'!
parentExampleFor: anExample
	| dependencyPragma |
	
	dependencyPragma := anExample methodReference compiledMethod pragmas 
		detect: [ :each | each keyword = self exampleDependencyPragma ] 
		ifNone: [ nil ].

	^ dependencyPragma 
		ifNil: [ nil ]
		ifNotNil: [
			self 
				createExampleForMethod: (anExample methodReference realClass 
					compiledMethodAt: (dependencyPragma argumentAt: 1))
				from: anExample provider ].! !

!GTExampleExtractionStrategy methodsFor: 'accessing' stamp: 'AndreiChis 3/25/2015 23:54'!
examplePragmas

	^ #(gtExample gtExample:)! !

!GTExampleProvider commentStamp: 'TudorGirba 3/28/2015 23:56'!
It provides example services:
- extracts examples
- displays examples in the inspector!
!GTExampleProvider methodsFor: 'accessing' stamp: 'TudorGirba 3/28/2015 23:27'!
subject
	^ subject! !

!GTExampleProvider methodsFor: 'accessing' stamp: 'TudorGirba 3/28/2015 23:27'!
subject: anObject
	subject := anObject! !

!GTExampleProvider methodsFor: 'ui' stamp: 'TudorGirba 3/28/2015 23:52'!
gtDisplayExamplesIn: aComposite

	^ aComposite tree
		title: 'E.g.';
		when: [ self gtExamples notEmpty ];
		display: [ self gtExamples ];
		children: [ :anExample | anExample childrenExamples ];
		format: [ :anExample | anExample title ];
		send: [ :anExample | anExample result ];
		allExpanded;
		selectionPopulate: #selection 
			on: $o 
			entitled: 'Open source' 
			with: [ :list | list rawSelection methodReference ]! !

!GTExampleProvider methodsFor: 'accessing' stamp: 'TudorGirba 3/28/2015 23:28'!
gtExamples
	^ GTExampleExtractionStrategy new rootExamplesFor: self subject! !

!GTExampleProvider class methodsFor: 'instance creation' stamp: 'TudorGirba 3/28/2015 23:27'!
on: aSubject
	^ self new subject: aSubject ! !

!GTFilter methodsFor: 'private' stamp: 'StefanReichhart 2/24/2015 13:54'!
applyFilterInContext: aSpotterContext error: anException
	('[Spotter] Exception in filter <', self class name, '>: ', anException asString) logCr.
	^ self defaultItems! !

!GTFilter methodsFor: 'private-model' stamp: 'StefanReichhart 3/22/2015 22:02'!
allItems
	^ self processor allItemsIn: self context! !

!GTFilter methodsFor: 'private-model' stamp: 'StefanReichhart 2/24/2015 13:54'!
addItem: anItem
	self context addItem: anItem! !

!GTFilter methodsFor: 'public' stamp: 'StefanReichhart 3/18/2015 14:57'!
value: aSpotterContext

	^ [ self applyFilterInContext: aSpotterContext ]
		on: Error
		do: [ :exception | 
			self exceptionHandler 
				handleException: exception 
				do: [ self applyFilterInContext: aSpotterContext error: exception ] ]! !

!GTFilter methodsFor: 'accessing' stamp: 'StefanReichhart 3/23/2015 13:25'!
streamed: anObject
	streamed := anObject! !

!GTFilter methodsFor: 'private-model' stamp: 'StefanReichhart 2/24/2015 13:54'!
addItems: aCollection
	self context addItems: aCollection! !

!GTFilter methodsFor: 'accessing' stamp: 'StefanReichhart 3/23/2015 13:25'!
streamed
	^ streamed ifNil: [ streamed := self defaultStreamed ]! !

!GTFilter methodsFor: 'accessing-defaults' stamp: 'StefanReichhart 2/19/2015 17:12'!
defaultItems
	^ OrderedCollection new! !

!GTFilter methodsFor: 'private-model' stamp: 'StefanReichhart 4/1/2015 09:56'!
exceptionHandler
	self flag: 'Bloc -> overrides doesNotUnderstand discarding the current exception context'.
	^ GTCurrentSpotterExceptionHandler value ifNil: [ self context exceptionHandler ]! !

!GTFilter methodsFor: 'testing' stamp: 'StefanReichhart 2/24/2015 13:53'!
hasItems
	^ self items isEmptyOrNil not! !

!GTFilter methodsFor: 'accessing' stamp: 'StefanReichhart 2/24/2015 13:53'!
context: anObject
	context := anObject! !

!GTFilter methodsFor: 'private-model' stamp: 'StefanReichhart 3/22/2015 17:15'!
allItemsDo: aBlock
	self allItems do: aBlock! !

!GTFilter methodsFor: 'private' stamp: 'StefanReichhart 2/24/2015 13:55'!
applyFilter
	^ self items! !

!GTFilter methodsFor: 'public' stamp: 'StefanReichhart 2/24/2015 14:21'!
gtFilter
	^ self! !

!GTFilter methodsFor: 'public' stamp: 'StefanReichhart 3/22/2015 16:58'!
gtListFilter
	^ self! !

!GTFilter methodsFor: 'accessing-defaults' stamp: 'StefanReichhart 3/23/2015 13:26'!
defaultStreamed
	^ true! !

!GTFilter methodsFor: 'private-model' stamp: 'StefanReichhart 3/17/2015 15:29'!
step
	^ self context step! !

!GTFilter methodsFor: 'private-model' stamp: 'StefanReichhart 2/24/2015 18:36'!
itemsLimit
	^ self context itemsLimit! !

!GTFilter methodsFor: 'private-model' stamp: 'StefanReichhart 2/24/2015 13:53'!
processor
	^ self context processor! !

!GTFilter methodsFor: 'private' stamp: 'StefanReichhart 2/24/2015 13:54'!
applyFilterInContext: aSpotterContext
	self prepareFilterInContext: aSpotterContext.
	^ self applyFilter! !

!GTFilter methodsFor: 'accessing' stamp: 'StefanReichhart 2/24/2015 13:53'!
items: aCollection
	items := aCollection! !

!GTFilter methodsFor: 'private' stamp: 'StefanReichhart 2/24/2015 13:54'!
prepareFilterInContext: aSpotterContext
	self context: aSpotterContext.
	self items: self defaultItems.! !

!GTFilter methodsFor: 'accessing' stamp: 'StefanReichhart 2/24/2015 13:52'!
context
	^ context! !

!GTFilter methodsFor: 'accessing' stamp: 'StefanReichhart 2/24/2015 13:53'!
items
	^ items! !

!GTFilter methodsFor: 'private-model' stamp: 'StefanReichhart 3/20/2015 12:20'!
itemFilterNameFor: anItem
	^ self processor itemFilterNameFor: anItem! !

!GTFilter class methodsFor: 'public' stamp: 'StefanReichhart 2/24/2015 14:21'!
gtFilter
	^ self new! !

!GTFilter class methodsFor: 'public' stamp: 'StefanReichhart 3/22/2015 16:58'!
gtListFilter
	^ self new! !

!GTFilterAlike methodsFor: 'accessing-defaults' stamp: 'StefanReichhart 2/24/2015 18:39'!
defaultUpperThreshold
	" upper threshold: to keep a reasonably sized set of interesting matches "
	^ 0.45! !

!GTFilterAlike methodsFor: 'accessing' stamp: 'StefanReichhart 3/23/2015 15:22'!
upperThreshold
	^ upperThreshold! !

!GTFilterAlike methodsFor: 'accessing' stamp: 'StefanReichhart 2/19/2015 15:54'!
upperThreshold: anObject
	upperThreshold := anObject! !

!GTFilterAlike methodsFor: 'accessing' stamp: 'StefanReichhart 3/23/2015 15:22'!
lowerThreshold
	^ lowerThreshold! !

!GTFilterAlike methodsFor: 'accessing' stamp: 'StefanReichhart 2/19/2015 15:54'!
lowerThreshold: anObject
	lowerThreshold := anObject! !

!GTFilterAlike methodsFor: 'accessing-defaults' stamp: 'StefanReichhart 2/24/2015 18:39'!
defaultLowerThreshold
	" lower threshold: to cut off the large irrelevent chunk before sorting/filtering is appplied "
	^ 0.33! !

!GTFilterAlike methodsFor: 'private' stamp: 'StefanReichhart 3/23/2015 15:27'!
prepareFilterInContext: aSpotterContext
	super prepareFilterInContext: aSpotterContext.
	
	lowerThreshold ifNil: [ lowerThreshold := self defaultLowerThreshold ]. " performance optimization "
	upperThreshold ifNil: [ upperThreshold := self defaultUpperThreshold ]. " performance optimization "! !

!GTFilterAlike methodsFor: 'private' stamp: 'StefanReichhart 3/23/2015 15:26'!
applyFilterWithQuery
	| allItemsPrepocessed allItemsPrepocessedAndSorted alikeMatches otherMatches upper lower |
	alikeMatches := OrderedCollection  new.
	otherMatches := OrderedCollection new.	
	" calculate the <similarity> of all items and throw away everything that is below the lower threshold (irrelevant) "			
	allItemsPrepocessed := OrderedCollection streamContents: [ :allItems | 
		lower := lowerThreshold * query size.
		self allItemsDo: [ :each | 
			| weight |
			(weight :=  (self itemFilterNameFor: each) alike: query) > lower ifTrue: [
				allItems nextPut: (Array with: weight with: each) ] ] ].
	" sort all items using <similarity> "
	allItemsPrepocessedAndSorted := allItemsPrepocessed asSortedCollection: [ :a :b | a first > b first ].
	" calculate the upper threshold "
	upper := allItemsPrepocessed isEmpty 
		ifTrue: [ upperThreshold ]
		ifFalse: [ (allItemsPrepocessedAndSorted collect: [ :each | each first ]) median " try an adaptive threshold (slow if not presorted) " ].
	" stream all items based on upper and lower threshold "
	allItemsPrepocessedAndSorted do: [ :each | 
		each first >= upper 
			ifTrue: [
				alikeMatches add: each last.
				alikeMatches size > self itemsLimit ifFalse: [ 
					self addItem: each ] ]
			ifFalse:[ otherMatches add: each last ] ].
	" push less relevant matches onto the result "
	(alikeMatches size < self itemsLimit) ifTrue: [ 
		(otherMatches first: ((self itemsLimit - alikeMatches size) min: otherMatches size)) do: [ :each |
			self addItem: each ] ].
	self items: alikeMatches , otherMatches ! !

!GTFilterBlock methodsFor: 'accessing' stamp: 'StefanReichhart 2/24/2015 15:31'!
matcher
	^ matcher! !

!GTFilterBlock methodsFor: 'accessing' stamp: 'StefanReichhart 2/24/2015 15:31'!
matcher: anObject
	matcher := anObject! !

!GTFilterBlock methodsFor: 'private' stamp: 'StefanReichhart 3/23/2015 15:26'!
isMatchedItem: anItem
	^ self matcher 
		ifNotNil: [ self matcher value: anItem value: self context ]
		ifNil: [ (self itemFilterNameFor: anItem) includesSubstring: query caseSensitive: caseSensitive ]
		! !

!GTFilterFileReference methodsFor: 'accessing' stamp: 'StefanReichhart 4/1/2015 22:12'!
queryForItem: each
	self flag: 'this is an ugly hack for #queryForFileReference. The iterator will manipulate the query being used for each item'.
	^ self context cacheAt: #queryForFileReference ifAbsent: [ query ] " performance optimization "! !

!GTFilterFileReference methodsFor: 'private' stamp: 'StefanReichhart 3/22/2015 15:12'!
indexForItem: each
	^ (self queryForItem: each) isEmpty
		ifTrue: [ 1 ] " if the modified query is empty, take all items -> index = 1 "
		ifFalse: [ super indexForItem: each ]! !

!GTFilterImplementor methodsFor: 'public' stamp: 'StefanReichhart 4/1/2015 21:53'!
gtListFilter
	^ GTFilterSubstring new! !

!GTFilterImplementor methodsFor: 'private-model' stamp: 'StefanReichhart 4/1/2015 22:10'!
itemFilterNameFor: each
	self flag: 'this filter wants to filter items by #selector (speed 10x), but dive-in-category wants to filter by #printString. Most filters in dive-in-category wants to filter by #printString, but not all. Others: files, topics, help, ... ?'.
	^ each selector! !

!GTFilterImplementor class methodsFor: 'public' stamp: 'StefanReichhart 4/1/2015 21:53'!
gtListFilter
	^ GTFilterSubstring new! !

!GTFilterRegex methodsFor: 'accessing' stamp: 'StefanReichhart 2/19/2015 15:31'!
regex: anObject
	regex := anObject! !

!GTFilterRegex methodsFor: 'private' stamp: 'StefanReichhart 3/23/2015 15:27'!
prepareFilterInContext: aSpotterContext
	super prepareFilterInContext: aSpotterContext.
	
	self regex: (caseSensitive " performance optimization "
		ifTrue: [ self query asRegex ] 
		ifFalse: [ self query asRegexIgnoringCase ])! !

!GTFilterRegex methodsFor: 'private' stamp: 'StefanReichhart 3/20/2015 12:20'!
isMatchedItem: anItem
	^ self regex matches: (self itemFilterNameFor: anItem)! !

!GTFilterRegex methodsFor: 'private' stamp: 'StefanReichhart 2/24/2015 13:01'!
applyFilterInContext: aSpotterContext error: exception
	super applyFilterInContext: aSpotterContext error: exception.
	^ (GTFilterSubstrings new
		caseSensitive: self caseSensitive;
		yourself) value: aSpotterContext! !

!GTFilterRegex methodsFor: 'accessing' stamp: 'StefanReichhart 2/24/2015 13:10'!
regex
	^ regex! !

!GTFilterStringMatch methodsFor: 'private' stamp: 'StefanReichhart 3/23/2015 15:26'!
isMatchedItem: anItem
	^ query match: (self itemFilterNameFor: anItem)! !

!GTFilterSubstring methodsFor: 'private' stamp: 'StefanReichhart 3/23/2015 16:41'!
queryForItem: each
	^ query " performance optimization "! !

!GTFilterSubstring methodsFor: 'private' stamp: 'StefanReichhart 3/20/2015 17:16'!
indexForItem: each
	^ (self itemFilterNameFor: each) findString: (self queryForItem: each) startingAt: 1 caseSensitive: self caseSensitive! !

!GTFilterSubstring methodsFor: 'private' stamp: 'StefanReichhart 3/20/2015 17:15'!
applyFilterWithQuery
	| prefixMatches otherMatches |
	prefixMatches := OrderedCollection  new.
	otherMatches := OrderedCollection new.
	self allItemsDo: [ :each | 
		| index |
		index := self indexForItem: each.
		index >= 1 ifTrue: [
			index = 1 
				ifTrue: [ 
						prefixMatches add: each.
						prefixMatches size > self itemsLimit ifFalse: [ 
							self addItem: each  ] ]
				ifFalse: [ otherMatches add: each ] ] ].
	(prefixMatches size < self itemsLimit) ifTrue: [ 
		(otherMatches first: ((self itemsLimit - prefixMatches size) min: otherMatches size)) do: [ :each |
			self addItem: each ] ].
	self items: prefixMatches , otherMatches! !

!GTFilterSubstrings methodsFor: 'accessing' stamp: 'StefanReichhart 3/23/2015 15:20'!
separators
	^ separators! !

!GTFilterSubstrings methodsFor: 'accessing' stamp: 'StefanReichhart 2/19/2015 16:04'!
separators: anObject
	separators := anObject! !

!GTFilterSubstrings methodsFor: 'private' stamp: 'StefanReichhart 3/23/2015 15:27'!
prepareFilterInContext: aSpotterContext
	super prepareFilterInContext: aSpotterContext.
	
	separators ifNil: [  separators := self defaultSeparators  ]. " performance optimization "
	self query: (self query substrings: self separators) asSet asArray! !

!GTFilterSubstrings methodsFor: 'private' stamp: 'StefanReichhart 3/23/2015 15:26'!
isMatchedItem: anItem
	| itemName |
	itemName := self itemFilterNameFor: anItem.
	^ query allSatisfy: [ :fragment | 
		itemName includesSubstring: fragment caseSensitive: self caseSensitive ]! !

!GTFilterSubstrings methodsFor: 'accessing-defaults' stamp: 'StefanReichhart 2/19/2015 16:04'!
defaultSeparators
	^ ' '! !

!GTIRBrowser commentStamp: 'MarcusDenker 10/21/2014 11:04'!
This is a simple browser that displays the Opal IR and previews each instructions on the source code.

Example:
self openOn: (self>>#compose) ast ir!
!GTIRBrowser methodsFor: 'building' stamp: 'NicolaiHess 11/5/2014 14:36'!
sourceIn: a
	^ a smalltalkCode 
		smalltalkClass: [ :each | each method compiledMethod methodClass ]; 
		display: [ :each | each sourceNode source ] ! !

!GTIRBrowser methodsFor: 'building' stamp: 'MarcusDenker 10/21/2014 10:58'!
compose
	self title: 'Tree'.
	self tabulator with: [ :browser |
		browser
			row: #tree;
			row: #source.
		browser transmit
			to: #tree;
			andShow: [ :a | self treeIn: a ].
		browser transmit
			to: #source;
			andShow: [ :a | self sourceIn: a ].
		browser transmit
			from: #tree;
			to: #source port: #selectionInterval;
			transformed: [ :rbNode | rbNode sourceInterval ].
		browser transmit
			toOutsidePort: #selection;
			from: #tree port: #selectedNode ]! !

!GTIRBrowser methodsFor: 'building' stamp: 'MarcusDenker 10/21/2014 10:59'!
treeIn: a
	^ a tree
		rootsExpanded;
		display: [ :anObject | {anObject} ];
		children: [ :each | each children ];
		selectionPopulate: #selectedNode
			on: $o
			entitled: 'Open'
			with: [ :tree | tree selection ];
		format: [ :each | each printString].! !

!GTImplementorsSpotterMock1 methodsFor: 'public' stamp: 'DamienCassou 2/4/2015 12:22'!
doSomethingElse! !

!GTImplementorsSpotterMock1 methodsFor: 'public' stamp: 'DamienCassou 2/4/2015 12:37'!
something1! !

!GTImplementorsSpotterMock1 methodsFor: 'public' stamp: 'DamienCassou 2/4/2015 12:37'!
something3! !

!GTImplementorsSpotterMock1 methodsFor: 'public' stamp: 'DamienCassou 2/4/2015 12:37'!
something5! !

!GTImplementorsSpotterMock1 methodsFor: 'public' stamp: 'DamienCassou 2/4/2015 12:37'!
something2! !

!GTImplementorsSpotterMock1 methodsFor: 'public' stamp: 'DamienCassou 2/4/2015 12:22'!
doSomething! !

!GTImplementorsSpotterMock1 methodsFor: 'public' stamp: 'DamienCassou 2/4/2015 12:37'!
something4! !

!GTInspector commentStamp: 'TudorGirba 8/21/2011 16:57'!
This is meant to be used for inspecting objects. It offers multiple views and it uses a finder as a navigation. One particular feature is that you can use the evaluator tab to enter code, and evaluating it results in opening another pane to the right.

The object finder asks dynamically the object for the actual presentations that are displayed in each pane.

Example:
self openOn: Smalltalk.

Register it as a replacement for explorer:
self registerToolsOn: Smalltalk tools.!
!GTInspector methodsFor: 'context' stamp: 'AndreiChis 1/14/2015 14:20'!
shouldDisplayPresentationCreateBy: aMethod
	"Verify whether or not the presentation created by the given method should be displayed.
	If no filter is given display all presentations."
	^ self presentationFilter 
		ifNil: [ true]
		ifNotNil: [ self presentationFilter shouldDisplayPresentationCreateBy: aMethod ]! !

!GTInspector methodsFor: 'context' stamp: 'AndreiChis 1/14/2015 16:08'!
presentationFilter: aPresentationFilterStragery
	"Set a filter for limiting the number of visible presentations."
	presentationFilter := aPresentationFilterStragery! !

!GTInspector methodsFor: 'context' stamp: 'AndreiChis 12/9/2014 22:40'!
presentationFilter

	^ presentationFilter! !

!GTInspector methodsFor: 'accessing' stamp: 'AndreiChis 8/21/2014 23:37'!
previousEntity
	^ self entities reverse second! !

!GTInspector methodsFor: 'actions' stamp: 'AndreiChis 10/29/2014 14:43'!
updatePanesFor: anObject

	(self panes select: [ :each | 
		(each port: #entity) value == anObject ]) do: [ :each | each update ]! !

!GTInspector methodsFor: 'context' stamp: 'AndreiChis 1/27/2015 23:35'!
filterByMethods: aCollection
	| filter |
	
	filter := GTInspectorMethodListFilter new.
	aCollection  do: [ :aMethod |
		filter addAndSelectSignatureFor: aMethod ].
	self presentationFilter: filter
		! !

!GTInspector methodsFor: 'accessing' stamp: 'TudorGirba 3/13/2014 13:39'!
entities
	"returns the list of objects from the #entity port of each pane of the finder"
	^ self first panes collect: [ :each | 
		(each port: #entity) value ]! !

!GTInspector methodsFor: 'accessing' stamp: 'AndreiChis 1/30/2015 11:35'!
firstPresentation

	^ self panes first presentations first! !

!GTInspector methodsFor: 'actions' stamp: 'TudorGirba 8/21/2011 08:56'!
openExplorerFor: anObject
	"this method is needed for compatibility with ObjectExplorer"
	self openOn: anObject! !

!GTInspector methodsFor: 'building' stamp: 'AndreiChis 1/18/2015 21:34'!
compose
	self title: [:anObject | 'Inspector on ', (self printObjectAsAnItem: anObject)].
	self act: [:b | b update] icon: GLMUIThemeExtraIcons glamorousRefresh entitled: 'Update'.
	self act: [:b | b presentationFilter ifNotNil: [ :filter | filter changeFilterRequestFor: b] ] entitled: 'Filter presentations'.
	self pager with: [ :browser | 
		browser fixedSizePanes: self class numberOfInspectorPanes.
		browser show: [ :a :each |
			a title: [ self printObjectAsAnItem: each ].
			a dynamicActions: [ :aPresentation | 
				each gtInspectorActions asOrderedCollection ].
			a titleAction: [ :aPresentation | self closeActionFor: aPresentation ].
			a dynamic 
				display: [ :x | 
					(GLMCompositePresentation new with: [:d | 
						each 
							gtInspectorPresentationsIn: d 
							inContext: self ])
							startOn: x ] ] ].
			
	self first when: GLMPaneAdded send: #actOnPaneAdded: to: self! !

!GTInspector methodsFor: 'initialization' stamp: 'AndreiChis 1/27/2015 23:30'!
initialize
	super initialize.
	
	self presentationFilter: (GTInspectorTagFilter new
			defaultTag: #custom;
			addAndSelectTag: #basic;
			addAndSelectTag: #custom;
			addAndSelectTag: #examples)! !

!GTInspector methodsFor: 'scripting opening' stamp: 'TudorGirba 4/3/2015 12:53'!
openOn: aPage
	| window |
	window := super openOn: aPage.
	window extent: self class preferredExtent.
	window when: WindowResizing do: [ 
		(window isMinimized or: [ window isMaximized ]) ifFalse: [ 
			"we only wnat to react to real resizing,
			not to minization or maximization"
			self class setPreferredExtentIfWanted: window extent ] ].
	^ window! !

!GTInspector methodsFor: 'private' stamp: 'SvenVanCaekenberghe 10/6/2014 16:16'!
printObjectAsAnItem: anObject
	| header printString |
	header := (anObject class name first isVowel
		ifTrue: [ 'an ' ]
		ifFalse: [ 'a ' ]) , anObject class name.
	printString := (GTObjectPrinter new asTruncatedTextFrom: anObject) asString.
	^ (printString beginsWith: header)
		ifTrue: [ printString ]
		ifFalse: [ 
			String streamContents: [ :out | 
				out << header; << ' ('; << printString; << ')' ] ]! !

!GTInspector methodsFor: 'accessing' stamp: 'TudorGirba 3/17/2014 16:30'!
panes
	^ self first panes! !

!GTInspector methodsFor: 'actions' stamp: 'EstebanLorenzano 12/7/2014 09:47'!
closeActionFor: aPresentation

	^ GLMGenericAction new
			action: [ self removeLastPane ];
			icon: GLMUIThemeExtraIcons glamorousClose;
			condition: [ :currentPresentation |
				self panes size > 1 and: [ self panes last presentations = currentPresentation ] ];
			title: 'Close' ! !

!GTInspector methodsFor: 'scripting' stamp: 'AndreiChis 8/18/2014 19:32'!
showFirst: aBlock

	self first showFirst: aBlock! !

!GTInspector methodsFor: 'accessing' stamp: 'AndreiChis 8/22/2014 01:29'!
previousEntityTo: anObject
	| entities index |
	entities := self entities.
	index := entities indexOf: anObject.
	^ index < 2 
		ifTrue: [ nil ]
		ifFalse: [ entities at: index - 1 ]! !

!GTInspector methodsFor: 'callbacks' stamp: 'AndreiChis 10/5/2014 21:27'!
actOnPaneAdded: ann

	self panes size > 1 ifTrue: [ 
		(self panes before: self panes last) updateToolbar "announce: (GLMPresentationToolbarUpdated new presentation: ann presentation)" ]! !

!GTInspector methodsFor: 'actions' stamp: 'AndreiChis 10/5/2014 21:28'!
removeLastPane
	| lastPane |
	
	lastPane := self first panes last.
	self first removeLastPane.
	self first announce: (GLMPaneRemoved pane: lastPane fromBrowser: self first).
	self first panes last updateToolbar! !

!GTInspector class methodsFor: 'settings' stamp: 'TudorGirba 10/7/2012 22:46'!
numberOfInspectorPanes
	^ GTNumberOfInspectorPanes ! !

!GTInspector class methodsFor: 'settings' stamp: 'TudorGirba 3/26/2015 00:36'!
preferredExtent
	^ PreferredExtent ifNil: [ PreferredExtent := 600@400 ]! !

!GTInspector class methodsFor: 'tools registry' stamp: 'AndreiChis 8/28/2014 21:21'!
register

	self registerToolsOn: Smalltalk tools
! !

!GTInspector class methodsFor: 'class initialization' stamp: 'TudorGirba 10/7/2012 22:50'!
initialize 
	self numberOfInspectorPanes: 2! !

!GTInspector class methodsFor: 'settings' stamp: 'TudorGirba 3/26/2015 00:37'!
preferredHeight
	^ self preferredExtent y! !

!GTInspector class methodsFor: 'openning' stamp: 'TudorGirba 11/1/2013 22:16'!
inspect: anObject 
	self openOn: anObject.
	^ anObject! !

!GTInspector class methodsFor: 'tools registry' stamp: 'TudorGirba 11/1/2013 22:17'!
registerToolsOn: registry
	"self registerToolsOn: Smalltalk tools " 
	registry register: self as: #inspector
! !

!GTInspector class methodsFor: 'settings' stamp: 'AndreiChis 8/28/2014 21:46'!
settingsOn: aBuilder 
	<systemsettings>
	
	(aBuilder group: #gt)
		label: 'Glamorous Toolkit';
		with: [
			(aBuilder setting: #numberOfInspectorPanes)
				target: self; 
				label: 'Number of inspector panes';
		 		description: 'Specifies the maximum number of panes that are visible at every moment in a Glamorous Inspector.'.
			(aBuilder setting: #GTInspectorStatus)
				target: self;
				getSelector: #isGTInspectorEnabled;
				setSelector: #setGTInspectorEnabledStatus:; 
				label: 'GTInspector';
		 		description: 'Enable or disable the GTInspector.'.]! !

!GTInspector class methodsFor: 'settings' stamp: 'TudorGirba 3/26/2015 00:38'!
extentSettingsOn: aBuilder 
	<systemsettings>
	
	(aBuilder setting: #GTInspectorPreferredWidth)
		target: self;
		parent: #gt;
		getSelector: #preferredWidth;
		setSelector: #preferredWidth:; 
		label: 'Inspector width';
		description: 'The preferred width of new Inspector windows'.
	(aBuilder setting: #GTInspectorPreferredHeight)
		target: self;
		parent: #gt;
		getSelector: #preferredHeight;
		setSelector: #preferredHeight:; 
		label: 'Inspector height';
		description: 'The preferred height of new Inspector windows'.
	(aBuilder setting: #GTInspectorRememberPreferredExtent)
		target: self;
		parent: #gt;
		getSelector: #rememberPreferredExtent;
		setSelector: #rememberPreferredExtent:; 
		label: 'Remember extent of Inspector';
		description: 'Enable or disable remembering of the extent of Inspector windows on resize. When the preference is true, resizing a Inspector window will affect the preferred width and height of future Inspector windows'
! !

!GTInspector class methodsFor: 'openning' stamp: 'AndreiChis 4/16/2014 18:15'!
inspect: anObject label: aString
	self new 
		title: aString;
		openOn: anObject.
	^ anObject
! !

!GTInspector class methodsFor: 'inspecting' stamp: 'TudorGirba 3/8/2014 07:51'!
gtInspectorExtensionsIn: composite
	<gtInspectorPresentationOrder: 40>
	composite list
		title: 'Extensions';
		display: [ self inspectorExtendingMethods ];
		showOnly: 50;
		format: [ :each | each gtDisplayString ];
		filterOn: [ :text :each | each gtDisplayString includesSubstring: text caseSensitive: false ]! !

!GTInspector class methodsFor: 'settings' stamp: 'AndreiChis 8/28/2014 21:27'!
setGTInspectorEnabledStatus: aBoolean
	| oldStatus |
	
	oldStatus := self isGTInspectorEnabled.
	GTInspectorEnabledStatus := aBoolean.
	oldStatus ~= GTInspectorEnabledStatus ifTrue: [ 
		GTInspectorEnabledStatus 
			ifTrue: [ self register ]
			ifFalse: [ EyeInspector registerToolsOn: Smalltalk tools ] ]
	
	! !

!GTInspector class methodsFor: 'settings' stamp: 'TudorGirba 3/26/2015 00:37'!
preferredExtent: aPoint
	PreferredExtent := aPoint! !

!GTInspector class methodsFor: 'settings' stamp: 'TudorGirba 3/26/2015 00:37'!
preferredHeight: aHeight
	self preferredExtent setX: self preferredExtent x setY: aHeight! !

!GTInspector class methodsFor: 'inspecting' stamp: 'TudorGirba 2/7/2014 08:31'!
inspectorExtendingMethods
	^ (Object withAllSubclasses
		flatCollect: [ :each | 
			(Pragma allNamed: #gtInspectorPresentationOrder: in: each) 
				collect: [ :p | p method asRingDefinition ] ])
		sorted! !

!GTInspector class methodsFor: 'settings' stamp: 'TudorGirba 3/26/2015 00:37'!
preferredWidth: aWidth
	self preferredExtent setX: aWidth setY: self preferredExtent y! !

!GTInspector class methodsFor: 'settings' stamp: 'TudorGirba 3/26/2015 00:40'!
setPreferredExtentIfWanted: anExtent
	self rememberPreferredExtent ifTrue: [ 
		self preferredExtent: anExtent ]! !

!GTInspector class methodsFor: 'settings' stamp: 'TudorGirba 3/26/2015 00:37'!
rememberPreferredExtent
	^ RememberPreferredExtent ifNil: [ RememberPreferredExtent := true ]! !

!GTInspector class methodsFor: 'openning' stamp: 'TudorGirba 11/25/2012 22:53'!
openOn: anObject 
	^ self new openOn: anObject! !

!GTInspector class methodsFor: 'openning' stamp: 'TudorGirba 11/1/2013 22:16'!
explore: anObject 
	self openOn: anObject.
	^ anObject! !

!GTInspector class methodsFor: 'settings' stamp: 'TudorGirba 10/7/2012 22:46'!
numberOfInspectorPanes: anInteger
	GTNumberOfInspectorPanes := anInteger ! !

!GTInspector class methodsFor: 'settings' stamp: 'AndreiChis 8/29/2014 00:48'!
isGTInspectorEnabled

	^ GTInspectorEnabledStatus ifNil: [ GTInspectorEnabledStatus := Smalltalk tools inspector = self ]! !

!GTInspector class methodsFor: 'settings' stamp: 'TudorGirba 3/26/2015 00:37'!
rememberPreferredExtent: aBoolean
	^ RememberPreferredExtent := aBoolean! !

!GTInspector class methodsFor: 'openning' stamp: 'AndreiChis 10/28/2014 13:53'!
inspector: anObject

	^ self openOn: anObject! !

!GTInspector class methodsFor: 'settings' stamp: 'TudorGirba 3/26/2015 00:37'!
preferredWidth
	^ self preferredExtent x! !

!GTInspectorExamplesTest methodsFor: 'running' stamp: 'AndreiChis 3/3/2015 11:04'!
tearDown 
	windows do: [ :each | each delete ].
	windows := nil! !

!GTInspectorExamplesTest methodsFor: 'tests' stamp: 'StefanReichhart 3/27/2015 19:46'!
testGlobals
	{ Smalltalk . RBMessageNode . Trait . TClass . TBehavior . GTInspector . Object . Class . CompiledMethod } 
		do: [ :each | self checkAllPresentationsOf: each ]
		displayingProgress: 'Testing GTInspector globals (#testGlobals)'! !

!GTInspectorExamplesTest methodsFor: 'tests' stamp: 'StefanReichhart 3/27/2015 19:46'!
testAllExamples
	Object withAllSubclasses 
		do: [ :eachClass | eachClass gtExamples do: [ :exampleToTest | self checkAllPresentationsOf: exampleToTest ] ]
		displayingProgress: 'Testing GTInspector examples (#testAllExamples)'! !

!GTInspectorExamplesTest methodsFor: 'running' stamp: 'TudorGirba 1/29/2014 07:44'!
setUp 
	windows := OrderedCollection new! !

!GTInspectorExamplesTest methodsFor: 'tests' stamp: 'TudorGirba 3/21/2015 22:26'!
checkAllPresentationsOf: exampleToTest
	| browser window pragmas |
	pragmas := Pragma allNamed: #gtInspectorPresentationOrder: from: exampleToTest class to: Object.
	^ pragmas
		do: [ :eachPragma | 
			browser := GLMWrapper new.
			[browser
				show: [ :composite | 
					(eachPragma selector findTokens: $:) size = 1
						ifTrue: [ exampleToTest perform: eachPragma selector with: composite ].
					(eachPragma selector findTokens: $:) size = 2
						ifTrue: [ exampleToTest perform: eachPragma selector with: composite with: browser ] ].
			window := browser openOn: exampleToTest] 
				on: Error 
				do: [ self fail: eachPragma asString ].
			window ifNotNil: [ window delete ] ]! !

!GTInspectorMethodListFilter commentStamp: 'AndreiChis 1/27/2015 23:30'!
GTInspectorMethodListFilter implements a filtering strategy for presentations based on method signatures (method selector and class).

The filter returns true for a method if the signature of that method is selected in the filter. To be taken into account during filtering a signature must be first added to the filter and the selected. Only signatures that have been first added can be selected. !
!GTInspectorMethodListFilter methodsFor: 'accessing' stamp: 'AndreiChis 12/13/2014 11:31'!
inspectorPragmaKey

	^ #gtInspectorPresentationOrder:! !

!GTInspectorMethodListFilter methodsFor: 'callbacks' stamp: 'AndreiChis 12/13/2014 11:46'!
replaceSelectedSignaturesWith: aList in: aGTInspector

	selectedMethodSignatures := aList.
	aGTInspector update! !

!GTInspectorMethodListFilter methodsFor: 'testing' stamp: 'AndreiChis 12/13/2014 12:03'!
shouldDisplayPresentationCreateBy: aMethod

	^ selectedMethodSignatures anySatisfy: [ :aSignature | 
		aSignature first = aMethod methodClass and: [ aSignature second = aMethod selector ] ]! !

!GTInspectorMethodListFilter methodsFor: 'initialization' stamp: 'AndreiChis 12/13/2014 11:43'!
initialize
	super initialize.
	allMethodSignatures := OrderedCollection new.
	selectedMethodSignatures := OrderedCollection new.! !

!GTInspectorMethodListFilter methodsFor: 'adding' stamp: 'AndreiChis 12/13/2014 11:24'!
addSignatureFor: aMethod
	|signature|
	
	signature := self signatureFor: aMethod.
	(allMethodSignatures includes: signature) ifFalse: [ allMethodSignatures add: signature ].! !

!GTInspectorMethodListFilter methodsFor: 'accessing' stamp: 'AndreiChis 12/13/2014 12:06'!
changeFilterRequestFor: aGTInspector

	self
		openListChooseLabeled: 'All available presentations' 
		forInspector: aGTInspector
		with: allMethodSignatures 
		select: selectedMethodSignatures 
		format: [ :aSignature | self printSignature: aSignature ]
		actionSelector: #replaceSelectedSignaturesWith:in:! !

!GTInspectorMethodListFilter methodsFor: 'adding' stamp: 'AndreiChis 12/13/2014 11:46'!
addAndSelectSignatureFor: aMethod
	|signature|
	
	signature := self signatureFor: aMethod.
	(allMethodSignatures includes: signature) ifFalse: [ allMethodSignatures add: signature ].
	(selectedMethodSignatures includes: signature) ifFalse: [ selectedMethodSignatures add: signature ].
	! !

!GTInspectorMethodListFilter methodsFor: 'adding' stamp: 'AndreiChis 12/13/2014 11:28'!
addAllSignatures
	
	self allPresentationMethods do: [ :aMethod | self addSignatureFor: aMethod ] ! !

!GTInspectorMethodListFilter methodsFor: 'adding' stamp: 'AndreiChis 12/13/2014 11:33'!
addAndSelectAllSignatures
	
	self allPresentationMethods do: [ :aMethod | self addAndSelectSignatureFor: aMethod ] ! !

!GTInspectorMethodListFilter methodsFor: 'accessing' stamp: 'AndreiChis 12/13/2014 11:32'!
allPresentationMethods

	^ (PragmaCollector allSystemPragmas select: [ :pragma | 
		pragma key == self inspectorPragmaKey ]) collect: [ :aPragma | aPragma method ]! !

!GTInspectorMethodListFilter methodsFor: 'accessing' stamp: 'AndreiChis 12/13/2014 12:03'!
signatureFor: aMethod

	^ {aMethod methodClass . aMethod selector}! !

!GTInspectorMethodListFilter methodsFor: 'printing' stamp: 'AndreiChis 12/13/2014 12:06'!
printSignature: aSignature

	^ aSignature first name, '>>', aSignature second asString! !

!GTInspectorMethodListFilter class methodsFor: 'examples' stamp: 'AndreiChis 1/27/2015 23:30'!
exampleFileBrowser
	"An inspector for browsing directories and files."
	|inspector|
	
	inspector := GTInspector new.
	inspector presentationFilter: (GTInspectorMethodListFilter new
		addAndSelectSignatureFor: FileReference>>#gtInspectorStScriptIn:;
		addAndSelectSignatureFor: FileReference>>#gtInspectorPngIn:;
		addAndSelectSignatureFor: FileReference>>#gtInspectorJpegIn:;
		addAndSelectSignatureFor: FileReference>>#gtInspectorItemsIn:;
		addAndSelectSignatureFor: FileReference>>#gtInspectorGifIn:;
		addAndSelectSignatureFor: FileReference>>#gtInspectorContentsIn:;
		addAndSelectSignatureFor: FileReference>>#gtInspectorFuelIn:).
	inspector openOn: FileSystem workingDirectory.! !

!GTInspectorMethodListFilter class methodsFor: 'examples' stamp: 'AndreiChis 1/27/2015 23:30'!
exampleRawInspector
	"An inspector showing only the Raw presentation for all objects"
	|inspector|
	
	inspector := GTInspector new.
	inspector presentationFilter: (GTInspectorMethodListFilter new
		addAndSelectSignatureFor: Object>>#gtInspectorRawIn:).
	inspector openOn: Morph new.! !

!GTInspectorMethodListFilter class methodsFor: 'examples' stamp: 'AndreiChis 1/27/2015 23:30'!
exampleFullInspector
	"An inspector showing all presentations for all objects"
	|inspector|
	
	inspector := GTInspector new.
	inspector presentationFilter: (GTInspectorMethodListFilter new
		addAndSelectAllSignatures).
	inspector openOn: Morph new.! !

!GTInspectorMethodListFilter class methodsFor: 'examples' stamp: 'AndreiChis 3/6/2015 10:33'!
exampleHelpBrowser
	"An inspector for browsing Help pages.
	
	self exampleHelpBrowser
	"
	|inspector|
	
	inspector := GTInspector new.
	inspector presentationFilter: (GTInspectorMethodListFilter new
		addAndSelectSignatureFor: HelpTopic>>#gtInspectorContentsIn:;
		addAndSelectSignatureFor: HelpTopic>>#gtInspectorSubtopicsIn:).
	inspector openOn: SystemHelp asHelpTopic.! !

!GTInspectorMethodListFilter class methodsFor: 'examples' stamp: 'AndreiChis 1/27/2015 23:30'!
exampleCodeBrowser
	"An inspector showing only the Meta presentation for all objects"
	|inspector|
	
	inspector := GTInspector new.
	inspector presentationFilter: (GTInspectorMethodListFilter new
		addAndSelectSignatureFor: Object>>#gtInspectorMetaIn:).
	inspector openOn: Morph new.! !

!GTInspectorMethodListFilter class methodsFor: 'examples' stamp: 'AndreiChis 1/27/2015 23:30'!
exampleASTBrowser
	"An inspector showing a browser for navigating through AST nodes."
	|inspector|
	
	inspector := GTInspector new.
	inspector presentationFilter: (GTInspectorMethodListFilter new
		addAndSelectSignatureFor: CompiledMethod>>#gtInspectorASTIn:;
		addAndSelectSignatureFor: RBProgramNode>>#gtInspectorSourceCodeIn:).
	inspector openOn: Morph>>#initialize.! !

!GTInspectorPresentationFilter commentStamp: 'AndreiChis 1/27/2015 23:31'!
A GTInspectorPresentationFilter is the root class for filters that can limit the number if visible presentations for an object.

Subclasses need to implement  #shouldDisplayPresentationCreateBy: to indicate whether or not a give presentation should be displayed.
!
!GTInspectorPresentationFilter methodsFor: 'private' stamp: 'AndreiChis 12/13/2014 12:04'!
openListChooseLabeled: sString forInspector: aGTInspector with: allElements select: selectedElements format: aBlockOrSelector actionSelector: aSymbol
	|treeModel|
	
	treeModel := MorphTreeModel new.
	treeModel
		 beCheckList;
		 rootItems: allElements;
		 wrapBlockOrSelector: aBlockOrSelector;
		 autoMultiSelection: true.
	 (treeModel openDialogWindowIn: World title: sString selectedtems: selectedElements) ifNotNil: [ :selection | 
		self perform: aSymbol with: selection with: aGTInspector ]! !

!GTInspectorPresentationFilter methodsFor: 'accessing' stamp: 'AndreiChis 12/9/2014 22:38'!
changeFilterRequestFor: aGTInspector

	self subclassResponsibility! !

!GTInspectorPresentationFilter methodsFor: 'testing' stamp: 'AndreiChis 12/9/2014 21:27'!
shouldDisplayPresentationCreateBy: aMethod

	self subclassResponsibility! !

!GTInspectorTagFilter commentStamp: 'AndreiChis 1/27/2015 23:31'!
GTInspectorTagFilter implements a filtering strategy for presentations based on tags.

A tag is defined as the parameter of the prama <gtInspectorTag:>. A method can have one or more tags.
The filter returns true for a method if that method contains at least a tag selected in the filter. To be taken into account during filtering a tag must be first added to the filter and the selected. Only tags that have been first added can be selected.  

If a method does not define any tags the filter threats that method as having a single tag stored in the #defaultTag instance variable. The default defaultTag is #custom. The #basic tag  groups the Raw and Meta presentations. Inspect 'GTInspectorTagFilter new allPragmasWithTag' to view all pragmas creating the tags.!
!GTInspectorTagFilter methodsFor: 'adding' stamp: 'AndreiChis 1/14/2015 15:21'!
addAndSelectAllTags
	
	self allTags do: [ :aTag | self addAndSelectTag: aTag ] ! !

!GTInspectorTagFilter methodsFor: 'accessing' stamp: 'AndreiChis 12/13/2014 00:38'!
defaultTag: aSymbol

	defaultTag := aSymbol! !

!GTInspectorTagFilter methodsFor: 'accessing' stamp: 'AndreiChis 12/13/2014 11:11'!
tagPragmaKey

	^ #gtInspectorTag:! !

!GTInspectorTagFilter methodsFor: 'testing' stamp: 'AndreiChis 12/13/2014 11:03'!
shouldDisplayPresentationCreateBy: aMethod

	^ (self tagsFrom: aMethod) includesAny: selectedTags! !

!GTInspectorTagFilter methodsFor: 'accessing' stamp: 'AndreiChis 12/13/2014 11:13'!
allPragmasWithTag

	^ PragmaCollector allSystemPragmas select: [ :pragma | pragma key == self tagPragmaKey ]! !

!GTInspectorTagFilter methodsFor: 'adding' stamp: 'AndreiChis 12/13/2014 11:15'!
addAllTags
	
	self allTags do: [ :aTag | self addTag: allTags ] ! !

!GTInspectorTagFilter methodsFor: 'accessing' stamp: 'AndreiChis 12/13/2014 12:05'!
changeFilterRequestFor: aGTInspector

	self
		openListChooseLabeled: 'All available tags' 
		forInspector: aGTInspector
		with: allTags 
		select: selectedTags 
		format: #printString
		actionSelector: #replaceSelectedTagsWith:in:
! !

!GTInspectorTagFilter methodsFor: 'accessing' stamp: 'AndreiChis 1/14/2015 15:18'!
allTags

	^ (self allPragmasWithTag collect: [ :pragma | 
		pragma argumentAt: 1 ]) asSet sorted: [ :a :b | a < b ]! !

!GTInspectorTagFilter methodsFor: 'callbacks' stamp: 'AndreiChis 12/13/2014 11:40'!
replaceSelectedTagsWith: aListOfSymbols in: aGTInspector

	selectedTags := aListOfSymbols.
	aGTInspector update.! !

!GTInspectorTagFilter methodsFor: 'initialization' stamp: 'AndreiChis 12/13/2014 10:59'!
initialize
	super initialize.
	
	allTags := OrderedCollection new.
	selectedTags := OrderedCollection new.
	defaultTag := #custom! !

!GTInspectorTagFilter methodsFor: 'accessing' stamp: 'AndreiChis 12/13/2014 11:11'!
tagsFrom: aMethod

	^ (aMethod pragmas select: [ :each | each key == self tagPragmaKey ])
		ifEmpty: [ defaultTag ifNil: [ {} ] ifNotNil: [ {defaultTag} ] ]
		ifNotEmpty: [ :currentPragmas | currentPragmas collect: [ :each | each argumentAt: 1 ] ]! !

!GTInspectorTagFilter methodsFor: 'adding' stamp: 'AndreiChis 12/13/2014 11:16'!
addAndSelectTag: aSymbol

	self addTag: aSymbol.
	(selectedTags includes: aSymbol) ifFalse:  [selectedTags add: aSymbol]! !

!GTInspectorTagFilter methodsFor: 'adding' stamp: 'AndreiChis 12/13/2014 11:16'!
addTag: aSymbol

	(allTags includes: aSymbol) ifFalse:  [allTags add: aSymbol].! !

!GTInspectorTagFilter class methodsFor: 'examples' stamp: 'AndreiChis 1/27/2015 23:30'!
exampleCustomInspector
	"An inspector showing only the custom presentations for all object (excluding Raw and Meta)."
	|inspector|
	
	inspector := GTInspector new.
	inspector presentationFilter: (GTInspectorTagFilter new
		defaultTag: #custom;
		addAndSelectTag: #custom).
	inspector openOn: Morph new.! !

!GTInspectorTagFilter class methodsFor: 'examples' stamp: 'AndreiChis 1/27/2015 23:30'!
exampleFullInspector
	"An inspector showing all the available presentations for all objects."
	|inspector|
	
	inspector := GTInspector new.
	inspector presentationFilter: (GTInspectorTagFilter new
		defaultTag: #custom;
		addAndSelectTag: #custom;
		addAndSelectAllTags).
	inspector openOn: Morph new.! !

!GTInspectorTagFilter class methodsFor: 'examples' stamp: 'AndreiChis 1/27/2015 23:30'!
exampleExampleBrowser
	"A browser for viewing examples"
	|inspector|
	
	inspector := GTInspector new.
	inspector presentationFilter: (GTInspectorTagFilter new
		addAndSelectTag: #examples).
	inspector openOn: Dictionary.! !

!GTInspectorTagFilter class methodsFor: 'examples' stamp: 'AndreiChis 1/27/2015 23:30'!
exampleBasicInspector
	"An inspector showing only the basic presentations Raw and Meta for all object."
	|inspector|
	
	inspector := GTInspector new.
	inspector presentationFilter: (GTInspectorTagFilter new
		addAndSelectTag: #basic).
	inspector openOn: Morph new.! !

!GTInspectorVariableValuePairsTest methodsFor: 'object' stamp: 'TommasoDalSasso 1/30/2015 17:34'!
testArrayPairs43
	| pairs |
	
	pairs := (1 to: 43) asArray gtInspectorVariableValuePairs.
	self assert: pairs size = 42.
	(pairs collect: #key) allSatisfy: [ :e | (pairs at: e) = e ].
	
	self assert: ((pairs collect: #key) = ((1 to: 21) asOrderedCollection addAll: (23 to: 43) asOrderedCollection; yourself)).! !

!GTInspectorVariableValuePairsTest methodsFor: 'object' stamp: 'TommasoDalSasso 1/30/2015 17:21'!
testArrayPairsSmall
	| pairs |
	
	pairs := (1 to: 10) asArray gtInspectorVariableValuePairs.
	self assert: pairs size = 10.
	(pairs collect: #key) allSatisfy: [ :e | (pairs at: e) = e ].! !

!GTInspectorVariableValuePairsTest methodsFor: 'object' stamp: 'TommasoDalSasso 1/30/2015 17:33'!
testArrayPairs41
	| pairs |
	
	pairs := (1 to: 41) asArray gtInspectorVariableValuePairs.
	self assert: pairs size = 41.
	(pairs collect: #key) allSatisfy: [ :e | (pairs at: e) = e ].
	
	self assert: ((pairs collect: #key) = (1 to: 41) asOrderedCollection).! !

!GTInspectorVariableValuePairsTest methodsFor: 'object' stamp: 'TommasoDalSasso 1/30/2015 17:33'!
testArrayPairs42
	| pairs |
	
	pairs := (1 to: 42) asArray gtInspectorVariableValuePairs.
	self assert: pairs size = 42.
	(pairs collect: #key) allSatisfy: [ :e | (pairs at: e) = e ].
	
	self assert: ((pairs collect: #key) = (1 to: 42) asOrderedCollection).! !

!GTInspectorVariableValuePairsTest methodsFor: 'context' stamp: 'TommasoDalSasso 1/30/2015 18:03'!
testContextPairs
	| pairs x tempVariables indexVariables instVariables |
	
	x:=42.
	pairs := [:y| y+1+x ] asContext gtInspectorVariableValuePairs withIndexCollect: [ :e :i | i -> e].	
	
	tempVariables := pairs select: [ :e | e value key asString beginsWith: '[' ].
	indexVariables := pairs select: [ :e | e value key isInteger ].
	instVariables := pairs select: [ :e | e value key isSymbol ].
	
	self assert: (tempVariables sort last key) < (indexVariables sort first key).
	self assert: (indexVariables sort last key) < (instVariables sort first key).! !

!GTInspectorVariableValuePairsTest methodsFor: 'object' stamp: 'TommasoDalSasso 1/30/2015 17:33'!
testArrayPairsLong
	| pairs |
	
	pairs := (1 to: 100) asArray gtInspectorVariableValuePairs.
	self assert: pairs size = 42.
	(pairs collect: #key) allSatisfy: [ :e | (pairs at: e) = e ].
	
	self assert: ((pairs collect: #key) = ((1 to: 21) asOrderedCollection addAll: (80 to: 100) asOrderedCollection; yourself)).! !

!GTInspectorVariableValuePairsTest methodsFor: 'float' stamp: 'TommasoDalSasso 1/30/2015 17:39'!
testFloatPairs
	| pairs |
	
	pairs := 4.2 gtInspectorVariableValuePairs.
	self assert: pairs size = 2.
	
	self assert: (pairs first = ('1' -> 1074842828)).
	self assert: (pairs second = ('2' -> 3435973837)).! !

!GTMockSpotter methodsFor: 'accessing-defaults' stamp: 'StefanReichhart 3/12/2015 16:45'!
defaultPagerModel
	^ GLMMockPagerModel new! !

!GTMockSpotter methodsFor: 'accessing-defaults' stamp: 'StefanReichhart 3/12/2015 14:30'!
defaultStep
	^ GTMockSpotterStep new! !

!GTMockSpotter methodsFor: 'accessing-defaults' stamp: 'StefanReichhart 3/22/2015 18:32'!
defaultExceptionHandler
	^ GTSpotterDebuggingExceptionHandler new! !

!GTMockSpotterStep methodsFor: 'accessing-defaults' stamp: 'StefanReichhart 3/12/2015 12:47'!
defaultStream
	^ GTMockSpotterStream new! !

!GTMockSpotterStep methodsFor: 'accessing-defaults' stamp: 'StefanReichhart 3/12/2015 12:47'!
defaultTask
	^ GTMockSpotterTask new! !

!GTMockSpotterStream methodsFor: 'performing' stamp: 'StefanReichhart 3/12/2015 12:43'!
performSymbol: aSymbol withArguments: aCollection
	self receiver perform: aSymbol withEnoughArguments: aCollection! !

!GTMockSpotterTask methodsFor: 'public' stamp: 'StefanReichhart 3/12/2015 14:32'!
execute: aBlock withArguments: aCollection callback: callbackBlock priority: aPriority delay: anIntegerMilliseconds
	" we cannot handle asynchronous processes well in tests, so just execute is synchronously "
	aBlock valueWithPossibleArgs: aCollection.
	aCollection value.! !

!GTNullFilter methodsFor: 'public' stamp: 'StefanReichhart 3/22/2015 16:59'!
gtListFilter
	^ GTFilterSubstring new! !

!GTNullFilter methodsFor: 'private' stamp: 'StefanReichhart 3/23/2015 17:48'!
applyFilterWithQuery
	self streamed 
		ifTrue: [
			" this will be more responsive (faster) for very large collections and/or expensive filters "
			| allItems |
			self items: (allItems := OrderedCollection new).
			self allItems withIndexDo: [ :each :index |
				allItems add: each.
				index <= self itemsLimit ifTrue: [ 
					self addItem: each ] ] ]
		ifFalse: [
			" this will be much much faster for small collections and/or very quick filters " 
			self items: self allItems.
			self addItems: (self allItems first: (self itemsLimit min: self allItems size)) ]! !

!GTNullFilter class methodsFor: 'public' stamp: 'StefanReichhart 3/12/2015 18:36'!
gtListFilter
	^ GTFilterSubstring new! !

!GTObjectPrinter commentStamp: 'TudorGirba 1/18/2014 14:29'!
This is a utility class for printing objects to Text or String.!
!GTObjectPrinter methodsFor: 'printing' stamp: 'TudorGirba 12/23/2013 09:17'!
asNonTruncatedTextFrom: anObject
	^ [ Text fromString: (anObject asString replaceAll: String cr with: String space) ] 
			on: Error 
			do: [ Text string: 'error printing' attribute: TextColor red ]! !

!GTObjectPrinter methodsFor: 'printing' stamp: 'TudorGirba 9/6/2014 19:03'!
asTruncatedTextFrom: anObject
	^ [ Text fromString: (anObject gtDisplayString replaceAll: String cr with: String space) ]
		on: Error
		do: [ Text string: 'error printing' attribute: TextColor red ]! !

!GTObjectVariablesBrowser commentStamp: 'TudorGirba 8/22/2011 12:52'!
This is a helper browser for the main view in the GTInspector.

Example:
self openOn: Smalltalk!
!GTObjectVariablesBrowser methodsFor: 'private building' stamp: 'AndreiChis 1/9/2015 20:58'!
stringWithoutInitialCommentFrom: aString
	^ (aString trimLeft isEmpty not and: [ aString trimLeft first = $" ])
		ifFalse: [ aString trimBoth ]
		ifTrue: [|startIndex|
			startIndex := aString findAnySubStr: '"' startingAt: (aString indexOf: $") + 1.
			(startIndex = (aString size + 1)) ifTrue: [ "No content if a comment cannot be identified. " ^ '' ].
			(aString
				copyFrom: startIndex + 1 
				to: aString size) trimBoth ]! !

!GTObjectVariablesBrowser methodsFor: 'private building' stamp: 'TommasoDalSasso 1/30/2015 16:09'!
variableValuePairsFor: anObject

	^ anObject gtInspectorVariableValuePairs asOrderedCollection 
		yourself! !

!GTObjectVariablesBrowser methodsFor: 'building' stamp: 'TudorGirba 10/22/2014 14:39'!
compose
	self title: 'Raw'.
	self tabulator with: [ :browser |
		browser row: #variables; row: #evaluator.
		browser transmit to: #variables; andShow: [:a | 
			self variablesIn: a ].
		browser transmit to: #evaluator; andShow: [:a | 
			self evaluatorIn: a ].
		browser transmit from: #variables; toOutsidePort: #selection; transformed: [:assoc | assoc ifNotNil: [assoc value]].
		browser transmit from: #evaluator; toOutsidePort: #selection ]! !

!GTObjectVariablesBrowser methodsFor: 'private building' stamp: 'AndreiChis 4/2/2015 19:00'!
variablesIn: composite
	^ composite table
		showOnly: 50;
		shouldValidate: false;
		allowsRecursiveSearch: false;
		"wantsSteps: true;"
		children: [ :assoc | assoc key = 'self'
			ifTrue: [ #() ]
			ifFalse: [ self variableValuePairsFor: assoc value ] ];
		icon: [ :assoc | self iconFor: assoc value ];
		display: [ :anObject | (self variableValuePairsFor: anObject)
				addFirst: 'self' -> anObject;
				yourself ];
		column: 'Variable' 
			evaluated: [:assoc | '  ',(GTObjectPrinter new asNonTruncatedTextFrom: assoc key) ];
		column: 'Value' 
			evaluated: [:assoc | GTObjectPrinter new asTruncatedTextFrom: assoc value ]
			modified: [:newValue :assoc :presentation | 
				self updateInstanceVariable: assoc key from: presentation entity basedOn: newValue.
				presentation update ];
		"send: #value;"
		morphicSelectionAct: [:list | list selection value browse ] 
			icon: GLMUIThemeExtraIcons glamorousBrowse 
			on: $b 
			entitled: 'Browse';
		morphicSelectionAct: [:list | list selection value inspect ] 
			icon: GLMUIThemeExtraIcons glamorousInspect 
			on: $i 
			entitled: 'Inspect';
		selectionAct: [:list | 
			((list selection pointersToExcept: { list selection })
									reject: [ :each | each pointsOnlyWeaklyTo: list selection ]) inspect ] 
			on: $t
			entitled: 'Open pointers to'! !

!GTObjectVariablesBrowser methodsFor: 'private building' stamp: 'TudorGirba 10/17/2014 15:28'!
evaluatorIn: composite
	^ composite pharoPlayground
		doItReceiver: #yourself;
		display: [ :object | 
			String streamContents: [ :stream | 
				stream 
					nextPutAll: (self printStringOf: object);
					cr;
					nextPutAll: (GTSnippets snippetAt: object class)] ];
		onChangeOfPort: #text act: [ :text :object |
				GTSnippets 
					snippetAt: object class 
					put: (self stringWithoutInitialCommentFrom: text text asString) ];
		installGoAction;
		installDefaultSelectionActions! !

!GTObjectVariablesBrowser methodsFor: 'private building' stamp: 'AndreiChis 8/4/2014 21:26'!
iconFor: anObject
		
	^ [ (anObject iconOrThumbnailOfSize: 16)
		ifNil: [ anObject class systemIcon ] ]
			on: Error do: [ :error |
			self iconFor: anObject error: error ]! !

!GTObjectVariablesBrowser methodsFor: 'private building' stamp: 'AndreiChis 8/28/2014 19:52'!
printStringOf: anObject
	^ [(anObject printString contractTo: 200) asComment] 
			on: Error 
			do: ['"Error printing. Try self printString to debug"']! !

!GTObjectVariablesBrowser methodsFor: 'private building' stamp: 'AndreiChis 8/4/2014 21:25'!
iconFor: anEyeElement error: error
	^ Smalltalk ui icons smallWarningIcon! !

!GTObjectVariablesBrowser methodsFor: 'private building' stamp: 'MarcusDenker 1/16/2015 08:26'!
updateInstanceVariable: aSymbol from: anObject basedOn: aString
	|result|

	(anObject class hasInstVarNamed: aSymbol) 
		ifFalse: [ ^ self ].
	result := anObject class compiler
			source: aString;
			context: nil;
			receiver: anObject;
			failBlock: [ ^ self ];
			evaluate.
						
	anObject writeSlotNamed: aSymbol value: result.
	! !

!GTOpalScopeBrowser commentStamp: 'MarcusDenker 10/16/2014 11:26'!
This is a simple browser that displays the scopes that the Opal Semantic Analysis add to te rb tree and previews each node on the source code.

Example:
self openOn: (self>>#compose) ast !
!GTOpalScopeBrowser methodsFor: 'building' stamp: 'MarcusDenker 10/16/2014 11:00'!
sourceIn: a
	^ a smalltalkCode 
		smalltalkClass: [ :each | each parents first methodClass ]; 
		display: [ :each | each source ]! !

!GTOpalScopeBrowser methodsFor: 'building' stamp: 'MarcusDenker 10/16/2014 11:00'!
compose
	self title: 'Tree'.
	self tabulator with: [ :browser |
		browser
			row: #tree;
			row: #source.
		browser transmit
			to: #tree;
			andShow: [ :a | self treeIn: a ].
		browser transmit
			to: #source;
			andShow: [ :a | self sourceIn: a ].
		browser transmit
			from: #tree;
			to: #source port: #selectionInterval;
			transformed: [ :rbNode | rbNode sourceInterval ].
		browser transmit
			toOutsidePort: #selection;
			from: #tree port: #selectedNode ]! !

!GTOpalScopeBrowser methodsFor: 'building' stamp: 'MarcusDenker 10/16/2014 13:12'!
treeIn: a
	^ a tree
		rootsExpanded;
		display: [ :anObject | anObject doSemanticAnalysis;scope ];
		children: [ :each | each children ];
		selectionPopulate: #selectedNode
			on: $o
			entitled: 'Open'
			with: [ :tree | tree selection ];
		format: [ :each | each printString].! !

!GTPlayBindingDarkThemer methodsFor: 'rows' stamp: 'AliakseiSyrel 3/27/2015 13:37'!
selectedColor

	^ Color veryVeryDarkGray alpha: 0.1! !

!GTPlayBindingThemer methodsFor: 'empty-text' stamp: 'AliakseiSyrel 3/27/2015 12:24'!
emptyTextFontSize

	^ 13! !

!GTPlayBindingThemer methodsFor: 'rows' stamp: 'AliakseiSyrel 3/27/2015 12:50'!
padding

	^ 5! !

!GTPlayBindingThemer methodsFor: 'empty-text' stamp: 'AliakseiSyrel 3/27/2015 13:00'!
emptyTextColor

	^ self themer textLightColor! !

!GTPlayBindingThemer methodsFor: 'empty-text' stamp: 'AliakseiSyrel 3/27/2015 12:26'!
emptyTextPadding

	^ 15! !

!GTPlayBindingThemer methodsFor: 'rows' stamp: 'AliakseiSyrel 3/27/2015 12:49'!
borderColor

	^ self themer popupThemer borderColor! !

!GTPlayBindingThemer methodsFor: 'rows' stamp: 'AliakseiSyrel 3/27/2015 13:32'!
selectedColor

	^ Color veryVeryLightGray alpha: 0.5! !

!GTPlayBindingThemer methodsFor: 'icons' stamp: 'AliakseiSyrel 3/30/2015 13:25'!
goIcon

	^ GLMUIThemeExtraIcons glamorousGo! !

!GTPlayBindingThemer methodsFor: 'rows' stamp: 'AliakseiSyrel 3/27/2015 12:48'!
borderWidth

	^ 1! !

!GTPlayBindingThemer methodsFor: 'icons' stamp: 'AliakseiSyrel 3/27/2015 12:24'!
removeIcon

	^ GLMUIThemeExtraIcons glamorousRemove! !

!GTPlayBindingThemer methodsFor: 'icons' stamp: 'AliakseiSyrel 3/30/2015 13:12'!
inspectIcon

	^ GLMUIThemeExtraIcons glamorousInspect! !

!GTPlayBook commentStamp: 'TudorGirba 10/22/2014 07:51'!
This class holds the pages that are loaded in the image.

At class initialization time, it loads pages from the cacheDirectory and then maintains the pages in memory.!
!GTPlayBook methodsFor: 'actions' stamp: 'StefanReichhart 3/21/2015 09:37'!
addPage: aPage
	self pages addFirst: aPage! !

!GTPlayBook methodsFor: 'accessing-defaults' stamp: 'StefanReichhart 3/20/2015 22:45'!
defaultPages
	^ OrderedCollection new! !

!GTPlayBook methodsFor: 'actions' stamp: 'StefanReichhart 3/20/2015 22:48'!
addPageIfInteresting: aPage
	aPage isInteresting ifFalse: [ ^ self ].
	self addPage: aPage! !

!GTPlayBook methodsFor: 'actions' stamp: 'StefanReichhart 3/21/2015 09:48'!
removePage: aPage
	self pages remove: aPage ifAbsent: [ " ignore if aPage is not registered " ]! !

!GTPlayBook methodsFor: 'initializing' stamp: 'StefanReichhart 3/21/2015 09:36'!
initialize
	self flag: 'error handling'.
	
	self pages: self defaultPages.
	self files do: [ :each | 
		[ self pages add: (GTPlayPage fromFileReference: each) ] " bypass "
			on: Error 
			do: [ " unhandled exceptions are bad design - we should handle it somehow " ] ]! !

!GTPlayBook methodsFor: 'accessing' stamp: 'StefanReichhart 3/20/2015 22:34'!
pagesLimit
	^ pagesLimit ifNil: [ self defaultPagesLimit ]! !

!GTPlayBook methodsFor: 'accessing' stamp: 'StefanReichhart 3/20/2015 22:33'!
pagesLimit: anObject
	pagesLimit := anObject! !

!GTPlayBook methodsFor: 'accessing' stamp: 'TudorGirba 10/18/2014 21:49'!
pages: anObject
	pages := anObject! !

!GTPlayBook methodsFor: 'accessing' stamp: 'StefanReichhart 3/20/2015 22:45'!
pages
	^ pages ifNil: [ pages := self defaultPages ]! !

!GTPlayBook methodsFor: 'accessing-dynamic' stamp: 'StefanReichhart 3/20/2015 22:40'!
allFiles
	^ self class cacheDirectory files select: [ :each | 
		each extension = GTPlayPage fileExtension ]! !

!GTPlayBook methodsFor: 'accessing-dynamic' stamp: 'StefanReichhart 3/21/2015 09:38'!
allFilesSorted
	^ self allFiles sorted: [ :a :b | 
		a modificationTime > b modificationTime ]! !

!GTPlayBook methodsFor: 'accessing-dynamic' stamp: 'StefanReichhart 3/21/2015 09:36'!
files
	^ self allFilesSorted takeFirst: self pagesLimit! !

!GTPlayBook methodsFor: 'ui' stamp: 'StefanReichhart 3/21/2015 09:39'!
gtPagesIn: composite
	<gtInspectorPresentationOrder: 0>
	composite list 
		title: 'Pages';
		display: [ self pages ];
		format: #gtDisplayString;
		filterOn: [ :text :each | text match: each content ]! !

!GTPlayBook methodsFor: 'accessing-defaults' stamp: 'StefanReichhart 3/21/2015 09:47'!
defaultPagesLimit
	" page list in ui might get too long / holding too many object might decrease performance "
	^ 100! !

!GTPlayBook class methodsFor: 'accessing' stamp: 'TudorGirba 4/7/2015 23:04'!
cacheDirectory: aStringOrFileReference

	cacheDirectory := self 
							ensureDirectory: aStringOrFileReference 
							distinctFrom: self defaultCacheDirectory! !

!GTPlayBook class methodsFor: 'private' stamp: 'TudorGirba 10/19/2014 21:34'!
reset
	
	instance := nil! !

!GTPlayBook class methodsFor: 'accessing' stamp: 'TudorGirba 4/7/2015 23:17'!
stashDirectory: aStringOrFileReference

	stashDirectory := self 
							ensureDirectory: aStringOrFileReference 
							distinctFrom: self defaultStashDirectory! !

!GTPlayBook class methodsFor: 'private' stamp: 'AndreiChis 3/25/2015 16:19'!
cleanUp
	
	self reset! !

!GTPlayBook class methodsFor: 'examples' stamp: 'AndreiChis 3/26/2015 00:11'!
gtExampleEmpty
	<gtExample: 'Empty'>
	^ self new! !

!GTPlayBook class methodsFor: 'initializing' stamp: 'StefanReichhart 3/22/2015 13:43'!
initialize
	" we have to make sure the cached references are up-to-date after the image starts up "
	
	Smalltalk addToStartUpList: self! !

!GTPlayBook class methodsFor: 'accessing-defaults' stamp: 'TudorGirba 4/7/2015 22:50'!
defaultCacheDirectory
	^ 'play-cache/' asFileReference! !

!GTPlayBook class methodsFor: 'initializing' stamp: 'StefanReichhart 3/22/2015 13:43'!
startUp

	cacheDirectory := nil.! !

!GTPlayBook class methodsFor: 'accessing' stamp: 'TudorGirba 10/18/2014 21:48'!
instance
	^ instance ifNil: [ instance := self new ]! !

!GTPlayBook class methodsFor: 'private' stamp: 'TudorGirba 4/7/2015 23:04'!
resetDirectories

	cacheDirectory := nil! !

!GTPlayBook class methodsFor: 'accessing' stamp: 'TudorGirba 4/7/2015 22:49'!
cacheDirectory
	" lazy initialize the cache and always ensure its existence - especially while the image is running "
	cacheDirectory ifNil: [ cacheDirectory := self defaultCacheDirectory ].
	^ cacheDirectory ensureCreateDirectory! !

!GTPlayBook class methodsFor: 'accessing' stamp: 'TudorGirba 4/11/2015 14:18'!
customDirectory: aFileReference 
	"this is here for preserving backward compatibility with 
	older settings that relied on customDirectory instead
	of cacheDirectory"
	self cacheDirectory: aFileReference! !

!GTPlayBook class methodsFor: 'accessing' stamp: 'TudorGirba 4/7/2015 23:17'!
stashDirectory
	" lazy initialize the stash and always ensure its existence - especially while the image is running "
	stashDirectory ifNil: [ stashDirectory := self defaultStashDirectory ].
	^ stashDirectory ensureCreateDirectory! !

!GTPlayBook class methodsFor: 'initializing' stamp: 'StefanReichhart 3/22/2015 13:43'!
startUp: resuming

	cacheDirectory := nil.! !

!GTPlayBook class methodsFor: 'private' stamp: 'TudorGirba 4/7/2015 22:55'!
ensureDirectory: aStringOrFileReference distinctFrom: aDefaultDirectory
		" Ensure aStringOrFileReference is either nil or a valid file-reference object distinct from the default one.
	  Do not create any directory on disk yet - the first access to any directory will handle that.
	  #asFileReference and #absolutePath may raise anError!! "
	| fileReference |

	^ [ 
		fileReference := aStringOrFileReference asFileReference.
		^ fileReference absolutePath = aDefaultDirectory absolutePath
			ifTrue: [ nil ]
			ifFalse: [ fileReference ]
			
		" Background: The behavior of the default directory is being relative to the image. Therefore the default file-reference is relative to the image. If the image is moved/copied around the file-reference will stay relative to the image. We assume this is the expected behavior for the default directory. Therefore we prevent the user from setting that value as an absolute file-reference, since an absolute file-reference would behave differently when an image is moved/copied around. "	
		]
			on: Error
			do: [ nil ]! !

!GTPlayBook class methodsFor: 'accessing-defaults' stamp: 'TudorGirba 4/7/2015 23:17'!
defaultStashDirectory
	^ 'play-stash/' asFileReference! !

!GTPlayPage commentStamp: 'TudorGirba 10/22/2014 07:52'!
It holds one page of code. It is the model behind the Playground.

It also knows how to store itself on disk, and every time its content changes, it updates the corresponding file.!
!GTPlayPage methodsFor: 'ui' stamp: 'StefanReichhart 3/21/2015 09:44'!
gtDisplayOn: stream
	stream nextPutAll: (self contentString copyReplaceAll: String cr with: String space)! !

!GTPlayPage methodsFor: 'ui' stamp: 'TudorGirba 11/2/2014 22:14'!
gtInspectorContentIn: composite
	<gtInspectorPresentationOrder: 0>
	composite pharoPlayground 
		title: 'Content';
		display: #content;
		installGoAction;
		installDefaultSelectionActions! !

!GTPlayPage methodsFor: 'accessing' stamp: 'TudorGirba 4/7/2015 17:22'!
persistenceStrategies: anObject
	persistenceStrategies := anObject! !

!GTPlayPage methodsFor: 'accessing' stamp: 'TudorGirba 4/7/2015 22:27'!
creationTime
	^ creationTime! !

!GTPlayPage methodsFor: 'accessing' stamp: 'StefanReichhart 3/20/2015 21:49'!
creationTime: anObject
	creationTime := anObject! !

!GTPlayPage methodsFor: 'testing' stamp: 'StefanReichhart 3/21/2015 09:44'!
isInteresting
	^ self contentString trimBoth isEmpty not! !

!GTPlayPage methodsFor: 'compatibility-tools' stamp: 'StefanReichhart 3/21/2015 09:45'!
acceptContents: aStringOrtext

	self flag: #TODO. "Need support for what lies in the comment down here"
	"self fileName ifNotNil: [ self saveString: aStringOrtext toFile: self fileName ].

	acceptAction ifNotNil:[acceptAction value: aStringOrtext]."
	self saveContent: aStringOrtext.
	^ true! !

!GTPlayPage methodsFor: 'accessing-dynamic' stamp: 'StefanReichhart 3/21/2015 09:46'!
contentString
	" strange, sometimes #content is aText not aString !! "
	^ self content asString! !

!GTPlayPage methodsFor: 'accessing' stamp: 'TudorGirba 4/7/2015 17:22'!
persistenceStrategies
	^ persistenceStrategies! !

!GTPlayPage methodsFor: 'initializing' stamp: 'TudorGirba 4/9/2015 11:36'!
initialize
	super initialize.
	self content: ''.
	self creationTime: DateAndTime now.
	title := nil.
	persistenceStrategies := OrderedCollection with: (GTPlayPageCachePersistence new page: self)! !

!GTPlayPage methodsFor: 'actions' stamp: 'StefanReichhart 3/22/2015 21:28'!
publish
	(self confirm: 'Publish playground content to the cloud?')
        ifFalse: [ ^ self ].
    self content ifEmpty: [ 
        self inform: 'Nothing was published because the playground is empty'.
        ^ self ].
    Clipboard clipboardText: (publishedUrl := (GTUrlProvider new post: self contentString) asString).
    self inform: publishedUrl , ' was published and the url was copied to clipboard'! !

!GTPlayPage methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 4/9/2015 11:48'!
spotterActDefault
	| result |
	result := GTPlayground new openOn: self.
	"Spotter only sets the title without installing the stash persistency.
	This is because when openinng the Playground the changing of the text triggers a save and this implies resaving the file under a new name and this is not wanted for the named pages. 
	So, we work around that and we ensure that the stash is created after the playground is created.
	This code has to be revisited."
	self title notNil ifTrue: [ self ensureStashPersistency ].
	^ result! !

!GTPlayPage methodsFor: 'accessing-dynamic' stamp: 'AndreiChis 3/25/2015 16:49'!
title: aString
	title := aString! !

!GTPlayPage methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 1/28/2015 21:02'!
spotterPreviewCodeIn: aComposite
	<spotterPreview: 10>
	aComposite pharoMethod
		title: 'Preview';
		display: #content;
		smalltalkClass: [ nil ];
		entity: self.
		
	self flag: 'move "entity: self" somewhere else, maybe'! !

!GTPlayPage methodsFor: 'actions' stamp: 'TudorGirba 4/7/2015 22:24'!
saveContent: aStringOrText
	self content: aStringOrText.
	self save.! !

!GTPlayPage methodsFor: 'accessing-dynamic' stamp: 'TudorGirba 4/9/2015 11:36'!
title
	^ title ifNil: [ 'Page' ]! !

!GTPlayPage methodsFor: 'accessing' stamp: 'TudorGirba 4/7/2015 22:28'!
content
	^ content! !

!GTPlayPage methodsFor: 'actions' stamp: 'TudorGirba 4/4/2015 23:15'!
save
	persistenceStrategies do: [ :each | each save ]! !

!GTPlayPage methodsFor: 'accessing-dynamic' stamp: 'TudorGirba 4/8/2015 22:22'!
ensureStashPersistency
	(self persistenceStrategies noneSatisfy: [ :each | each isStash ])
		ifTrue: [ self persistenceStrategies add: (GTPlayPageStashPersistence new page: self) ]! !

!GTPlayPage methodsFor: 'accessing-dynamic' stamp: 'TudorGirba 4/9/2015 11:38'!
setTitleAndEnsureInStash: aString
	self title: aString.
	self ensureStashPersistency.
	self save! !

!GTPlayPage methodsFor: 'accessing' stamp: 'StefanReichhart 3/20/2015 22:06'!
content: aString
	content := aString! !

!GTPlayPage methodsFor: 'accessing-defaults' stamp: 'TudorGirba 4/7/2015 22:29'!
creationTimeForFileName
	^ (self creationTime asString copyReplaceAll: ':' with: '-') copyReplaceAll: '.' with: '-'! !

!GTPlayPage class methodsFor: 'instance creation' stamp: 'TudorGirba 4/7/2015 22:23'!
fromFileReference: aFileReference
	^ self new
		content: (aFileReference readStreamDo: #contents); 
		creationTime: (self creationTimeFrom: aFileReference);
		yourself! !

!GTPlayPage class methodsFor: 'instance creation' stamp: 'StefanReichhart 3/20/2015 23:43'!
creationTimeFrom: aFileReference
	^ [ self creationTimeFromString: aFileReference basenameWithoutExtension ] 
		on: Error 
		do: [ aFileReference creationTime ]! !

!GTPlayPage class methodsFor: 'instance creation' stamp: 'StefanReichhart 3/21/2015 09:50'!
creationTimeFromString: aString
	" this is really ugly, but hopefully only a temporary solution untill we come up with somthing more reliable and more beautiful "
	| subexpressions |
	subexpressions := OrderedCollection new.
	'(\d+)-(\d+)-(\d+)T(\d+)-(\d+)-(\d+)(-(\d+))?([-+]\d+)-(\d+)(-(\d+))?' asRegex 
		matchesIn: aString
		subexpressionsDo: [ :expression :expressionFragments | 
			subexpressions addAll: (expressionFragments collect: [ :each | 
				[ each squeezeOutNumber ] on: Error do: [ 0 ] ]) ].
	^ DateAndTime 
		year: subexpressions first 
		month: subexpressions second 
		day: subexpressions third 
		hour: subexpressions fourth 
		minute: subexpressions fifth 
		second: subexpressions sixth 
		nanoSecond: subexpressions eighth * 100000 " 7 == full match "
		offset: (Duration 
						days: 0 
						hours: subexpressions ninth 
						minutes: (subexpressions at: 10) 
						seconds: (subexpressions at: 12)) " 11 == full match "! !

!GTPlayPage class methodsFor: 'examples' stamp: 'AndreiChis 3/26/2015 00:11'!
gtExampleEmpty
	<gtExample: 'Empty'>
	^ self new! !

!GTPlayPage class methodsFor: 'instance creation' stamp: 'StefanReichhart 3/20/2015 18:58'!
loadFromPublishUrl: aString
	^ [ self basicLoadFromPublishUrl: aString ] 
		on: Error 
		do: [ nil ]! !

!GTPlayPage class methodsFor: 'accessing-dynamic' stamp: 'StefanReichhart 3/20/2015 22:31'!
fileExtension
	^ 'ph'! !

!GTPlayPage class methodsFor: 'instance creation' stamp: 'StefanReichhart 3/20/2015 18:59'!
loadFromPublishUrl: aString thenDo: aBlock
	| page |
	page := self loadFromPublishUrl: aString.
	page ifNotNil: [ aBlock value: page ].
	^ page! !

!GTPlayPage class methodsFor: 'private' stamp: 'TudorGirba 4/7/2015 22:27'!
basicLoadFromPublishUrl: aString
	^ GTPlayPage new 
		saveContent: (GTUrlProvider new get: aString)
		yourself! !

!GTPlayPageCachePersistence methodsFor: 'accessing' stamp: 'TudorGirba 4/7/2015 17:24'!
fileDirectory
	^ GTPlayBook cacheDirectory! !

!GTPlayPageCachePersistence methodsFor: 'accessing' stamp: 'TudorGirba 4/7/2015 22:31'!
fileName
	^ self page creationTimeForFileName, '.' , GTPlayPage fileExtension! !

!GTPlayPageFilePersistence methodsFor: 'accessing' stamp: 'TudorGirba 4/4/2015 23:49'!
fileDirectory
	^ self subclassResponsibility ! !

!GTPlayPageFilePersistence methodsFor: 'accessing-dynamic' stamp: 'TudorGirba 4/4/2015 23:11'!
fileReference
	^ self fileDirectory / self fileName! !

!GTPlayPageFilePersistence methodsFor: 'private' stamp: 'TudorGirba 4/4/2015 23:47'!
writeToFileSystem
	self fileReference writeStreamDo: [ :stream | 
		stream 
			truncate; 
			nextPutAll: self page contentString ]! !

!GTPlayPageFilePersistence methodsFor: 'private' stamp: 'TudorGirba 4/4/2015 23:41'!
deleteFromFileSystem
	self fileReference ensureDelete! !

!GTPlayPageFilePersistence methodsFor: 'accessing' stamp: 'TudorGirba 4/7/2015 22:20'!
fileName
	self subclassResponsibility! !

!GTPlayPageFilePersistence methodsFor: 'actions' stamp: 'TudorGirba 4/4/2015 23:42'!
save
	self page content isEmpty
		ifTrue: [ self deleteFromFileSystem ]
		ifFalse: [ self writeToFileSystem ]! !

!GTPlayPagePersistence methodsFor: 'accessing' stamp: 'TudorGirba 4/4/2015 23:13'!
page: anObject
	page := anObject! !

!GTPlayPagePersistence methodsFor: 'accessing' stamp: 'TudorGirba 4/4/2015 23:13'!
page
	^ page! !

!GTPlayPagePersistence methodsFor: 'testing' stamp: 'TudorGirba 4/8/2015 22:18'!
isStash
	^ false! !

!GTPlayPageStashPersistence methodsFor: 'accessing' stamp: 'TudorGirba 4/7/2015 23:18'!
fileDirectory
	^ GTPlayBook stashDirectory! !

!GTPlayPageStashPersistence methodsFor: 'accessing' stamp: 'TudorGirba 4/7/2015 22:31'!
fileName
	^ self page title, '-', self page creationTimeForFileName, '.', GTPlayPage fileExtension! !

!GTPlayPageStashPersistence methodsFor: 'testing' stamp: 'TudorGirba 4/8/2015 22:18'!
isStash
	^ true! !

!GTPlayground commentStamp: 'TudorGirba 10/22/2014 07:37'!
Playground is the correspondent of a classic Smalltalk Workspace. The problem with the name Workspace is that it implies that work should be carried out in this space, while this is not a best practice. Playground describes better the intention of providing a place in which we can quickly play with some code.

The model behind a Playground instance is a PlayPage object.

!!!!Use cases
The Playground can be used in two ways

# As a place to construct and try out code snippets.
# as an entry point into an inspection process.

In both cases, the ability of diving into objects to the right is an important feature.

!!!!Running
[ [ [ 
	self open.
 ] ] ]!
!GTPlayground methodsFor: 'building' stamp: 'TudorGirba 4/7/2015 23:59'!
codeIn: a
	^ a pharoPlayground
		title: [ :page | 
			GTPlaygroundEditableTabLabel new
				text: page title;
				when: #accepted do: [ :text | 
					page setTitleAndEnsureInStash: text asString ];
				yourself ];
		format: [ :page | page content ];
		act: [ :text :page |
				text selectionInterval: (1 to: text text size).
				text highlightEvaluateAndDo: [ :result | text selection: result ] ]
			icon: GLMUIThemeExtraIcons glamorousGo
			on: $G
			entitled: 'Do it all and go';
		installGoAction;
		installDefaultSelectionActions;
		act: [ :text :page | page publish ]
			icon: ThemeIcons current glamorousSaveToUrl
			entitled: 'Remote publish';
		addAction:
			(GLMPopupAction new
				action: [ :text :page :popup | GTPlaygroundBindingsList new
					on: self currentBindingsSorted;
					when: #bindingRemoved do: [ :binding | self removeBinding: binding ];
					when: #inspect do: [ :binding | binding value inspect ];
					when: #go do: [ :binding | text selection: binding value ];
					yourself ]; 
				icon: ThemeIcons current glamorousTable;
				title: 'Bindings';
				yourself);
		dynamicActions: [ self actionsForPreviousContents ];
		onChangeOfPort: #text act: [ :text :page | page saveContent: text text ]! !

!GTPlayground methodsFor: 'accessing-dynamic' stamp: 'AndreiChis 1/30/2015 11:35'!
inspectorPresentation

	^ self presentations first ! !

!GTPlayground methodsFor: 'accessing-dynamic' stamp: 'AliakseiSyrel 3/27/2015 12:19'!
removeBinding: anAssociation

	|bindings|
	bindings := self currentBindings copy.
	bindings removeKey: anAssociation key ifAbsent: [ ].
	self setBindings: bindings.! !

!GTPlayground methodsFor: 'building' stamp: 'TudorGirba 4/7/2015 22:34'!
actionsForPreviousContents
	^ GTPlayBook instance pages
		collect: [ :each | 
			GLMGenericAction new
				title: (each content asString contractTo: 50);
				action: [ :text | 
					text entity saveContent: each content.
					text update ];
				yourself ]! !

!GTPlayground methodsFor: 'accessing-defaults' stamp: 'AndreiChis 3/25/2015 15:41'!
defaultPlaygroundTitle
	^ 'Playground'! !

!GTPlayground methodsFor: 'actions' stamp: 'AndreiChis 3/19/2015 17:52'!
resetBindings

	^ self inspectorPresentation firstPresentation resetBindings! !

!GTPlayground methodsFor: 'accessing' stamp: 'AndreiChis 9/8/2014 23:02'!
acceptAction: anAction
	"acceptAction := anAction."! !

!GTPlayground methodsFor: 'accessing' stamp: 'AndreiChis 9/30/2014 20:46'!
acceptContents: aString

	^ (self entity acceptContents: aString)
		ifTrue: [  
			self update.
			true]! !

!GTPlayground methodsFor: 'accessing-dynamic' stamp: 'AliakseiSyrel 3/27/2015 12:08'!
currentBindingsSorted

	^ self currentBindings associations asSortedCollection: [ :first :second | first key < second key ]! !

!GTPlayground methodsFor: 'actions' stamp: 'AndreiChis 1/30/2015 11:42'!
setBindings: aDictionary

	self inspectorPresentation firstPresentation 
		variableBindings: [ aDictionary associations ];
		updateVariableBindings! !

!GTPlayground methodsFor: 'building' stamp: 'TudorGirba 4/10/2015 10:19'!
compose
	self title: self defaultPlaygroundTitle.
	self act: [:b | b update] icon: GLMUIThemeExtraIcons glamorousRefresh entitled: 'Update'.
	self custom:
			(GTInspector new
				noTitle; 
				noActions;
				showFirst: [ :composite |
					self codeIn: composite ];
				yourself);
		on: GLMBrowserClosing do: [ 
			"This is a hack for the moment.
			We need a better mechanism from Glamour to help 
			us keep the model in sync"
			self entity
					saveContent: self first panes first presentations first text.
			GTPlayBook instance addPageIfInteresting: self entity ]! !

!GTPlayground methodsFor: 'scripting opening' stamp: 'TudorGirba 4/3/2015 12:52'!
openOn: aPage
	| window |
	window := super openOn: aPage.
	window extent: self class preferredExtent.
	window when: WindowResizing do: [ 
		(window isMinimized or: [ window isMaximized ]) ifFalse: [ 
			"we only wnat to react to real resizing,
			not to minization or maximization"
			self class setPreferredExtentIfWanted: window extent ] ].
	^ window! !

!GTPlayground methodsFor: 'accessing' stamp: 'AndreiChis 1/9/2015 11:17'!
label: aString
	"Set the window label to the given string"
	self title: aString.
	self update! !

!GTPlayground methodsFor: 'accessing-dynamic' stamp: 'AndreiChis 3/19/2015 17:49'!
currentBindings 

	^ self inspectorPresentation firstPresentation currentBindings! !

!GTPlayground class methodsFor: 'tools registry' stamp: 'TudorGirba 2/11/2014 22:23'!
taskbarIcon
	"Answer the icon for the receiver in a task bar."

	^ Smalltalk ui icons iconNamed: #workspaceIcon! !

!GTPlayground class methodsFor: 'settings' stamp: 'TudorGirba 3/25/2015 22:18'!
preferredExtent
	^ PreferredExtent ifNil: [ PreferredExtent := 600@400 ]! !

!GTPlayground class methodsFor: 'settings' stamp: 'TudorGirba 3/25/2015 22:16'!
preferredExtent: aPoint
	PreferredExtent := aPoint! !

!GTPlayground class methodsFor: 'settings' stamp: 'AndreiChis 8/28/2014 21:33'!
setGTPlaygroundEnabledStatus: aBoolean
	| oldStatus |
	
	oldStatus := self isGTPlaygroundEnabled.
	GTPlaygroundEnabledStatus := aBoolean.
	oldStatus ~= GTPlaygroundEnabledStatus ifTrue: [ 
		GTPlaygroundEnabledStatus 
			ifTrue: [ self register ]
			ifFalse: [ Workspace registerToolsOn: Smalltalk tools ] ]
	
	! !

!GTPlayground class methodsFor: 'tools registry' stamp: 'AndreiChis 8/28/2014 21:33'!
register

	self registerToolsOn: Smalltalk tools! !

!GTPlayground class methodsFor: 'settings' stamp: 'TudorGirba 3/25/2015 23:05'!
preferredHeight: aHeight
	self preferredExtent setX: self preferredExtent x setY: aHeight! !

!GTPlayground class methodsFor: 'examples' stamp: 'AndreiChis 1/30/2015 12:28'!
examplePlaygroundWithBindings
	| playground wsBindings |
	wsBindings := Dictionary newFrom: { #number-> 1 }.
	playground := Smalltalk tools workspace
		openContents: 'number + 1'.
	playground
		setBindings: wsBindings.! !

!GTPlayground class methodsFor: 'compatibility-tools' stamp: 'StefanReichhart 3/20/2015 22:04'!
edit: aString label: aLabel

"Open a new playground with the given contents"
"Compatibility with the original Workspace"
"#edit: aText label: labelString accept: anAction"
"	^(Smalltalk tools workspace openLabel: labelString)
		acceptContents:  aText;
		acceptAction: anAction;
		yourself."

"Open an editor on the given string/text"
	| page |
	"self halt"

	page := GTPlayPage new
		saveContent: aString;
		title: aLabel;
		yourself.
		
	self flag: #TODO. "We need to put an equivalent to the acceptAction thing."
	^ self new openOn: page! !

!GTPlayground class methodsFor: 'compatibility-tools' stamp: 'TudorGirba 3/25/2015 22:41'!
openLabel: aLabel
	| page |

	page := GTPlayPage new
		title: aLabel;
		yourself.
	^ self openOn: page! !

!GTPlayground class methodsFor: 'settings' stamp: 'TudorGirba 3/25/2015 23:04'!
preferredWidth: aWidth
	self preferredExtent setX: aWidth setY: self preferredExtent y! !

!GTPlayground class methodsFor: 'instance creation' stamp: 'TudorGirba 3/25/2015 22:41'!
openContents: aString label: aLabel
	"Open a new playground with the given contents"

	| page |

	page := GTPlayPage new
		saveContent: aString;
		title: aLabel;
		yourself.
	^ self openOn: page! !

!GTPlayground class methodsFor: 'settings' stamp: 'TudorGirba 3/25/2015 22:54'!
setPreferredExtentIfWanted: anExtent
	self rememberPreferredExtent ifTrue: [ 
		self preferredExtent: anExtent ]! !

!GTPlayground class methodsFor: 'settings' stamp: 'AndreiChis 8/29/2014 00:39'!
isGTPlaygroundEnabled

	^ GTPlaygroundEnabledStatus ifNil: [ GTPlaygroundEnabledStatus := Smalltalk tools workspace = self ]! !

!GTPlayground class methodsFor: 'settings' stamp: 'TudorGirba 3/25/2015 23:02'!
preferredHeight
	^ self preferredExtent y! !

!GTPlayground class methodsFor: 'instance creation' stamp: 'TudorGirba 3/15/2015 21:49'!
title
	^ 'Playground'! !

!GTPlayground class methodsFor: 'settings' stamp: 'TudorGirba 3/25/2015 22:55'!
rememberPreferredExtent
	^ RememberPreferredExtent ifNil: [ RememberPreferredExtent := true ]! !

!GTPlayground class methodsFor: 'tools registry' stamp: 'TudorGirba 2/9/2014 01:10'!
registerToolsOn: registry
	"Add ourselves to registry. See [Smalltalk tools]"
	"self registerToolsOn: Smalltalk tools" 
	registry register: self as: #workspace
! !

!GTPlayground class methodsFor: 'settings' stamp: 'TudorGirba 4/7/2015 23:26'!
settingsOn: aBuilder 
	<systemsettings>
	
	(aBuilder setting: #GTPlaygroundStatus)
		target: self;
		parent: #gt;
		getSelector: #isGTPlaygroundEnabled;
		setSelector: #setGTPlaygroundEnabledStatus:; 
		label: 'GTPlayground';
		description: 'Enable or disable the GTPlayground.'.
	(aBuilder setting: #cacheDirectory)
		parent: #gt;
		type: #Directory;
		target: GTPlayBook;
		description: 'The path to the local Playground cache that stores all Playground scripts in ph files' translated;
		label: 'Local Playground cache directory'.
	(aBuilder setting: #stashDirectory)
		parent: #gt;
		type: #Directory;
		target: GTPlayBook;
		description: 'The path to the local Playground stash that stores all named Playground scripts in ph files' translated;
		label: 'Local Playground stash directory'! !

!GTPlayground class methodsFor: 'instance creation' stamp: 'TudorGirba 3/25/2015 22:41'!
open
	"self open"
	| page |
	page := GTPlayPage new.
	^ self openOn: page! !

!GTPlayground class methodsFor: 'settings' stamp: 'TudorGirba 3/26/2015 00:37'!
extentSettingsOn: aBuilder 
	<systemsettings>
	
	(aBuilder setting: #GTPlaygroundPreferredWidth)
		target: self;
		parent: #gt;
		getSelector: #preferredWidth;
		setSelector: #preferredWidth:; 
		label: 'Playground width';
		description: 'The preferred width of new Playground windows'.
	(aBuilder setting: #GTPlaygroundPreferredHeight)
		target: self;
		parent: #gt;
		getSelector: #preferredHeight;
		setSelector: #preferredHeight:; 
		label: 'Playground height';
		description: 'The preferred height of new Playground windows'.
	(aBuilder setting: #GTPlaygroundRememberPreferredExtent)
		target: self;
		parent: #gt;
		getSelector: #rememberPreferredExtent;
		setSelector: #rememberPreferredExtent:; 
		label: 'Remember extent of Playground';
		description: 'Enable or disable remembering of the extent of Playground windows on resize. When the preference is true, resizing a Playground window will affect the preferred width and height of future Playground windows'.
	


! !

!GTPlayground class methodsFor: 'instance creation' stamp: 'AndreiChis 4/1/2015 13:12'!
openContents: aString
	"Open a new playground with the given contents. aString has to be Smalltalk code. The style is applied"
	

	| page |
	
	page := GTPlayPage new
		saveContent: aString;
		yourself.
	^ self new 
		openOn: page;
		yourself! !

!GTPlayground class methodsFor: 'settings' stamp: 'TudorGirba 3/25/2015 23:02'!
rememberPreferredExtent: aBoolean
	^ RememberPreferredExtent := aBoolean! !

!GTPlayground class methodsFor: 'settings' stamp: 'TudorGirba 3/25/2015 23:02'!
preferredWidth
	^ self preferredExtent x! !

!GTPlaygroundBasicTest methodsFor: 'running' stamp: 'AndreiChis 3/3/2015 11:08'!
tearDown

	window ifNotNil: [ window delete ].
	window := nil.
	playground := nil! !

!GTPlaygroundBasicTest methodsFor: 'running' stamp: 'StefanReichhart 3/20/2015 22:03'!
testSettingBindings
	|obtainedResult|
	obtainedResult:=nil.
	window := playground openOn: (GTPlayPage new saveContent: 'number+1').
	playground 
		setBindings: { #number -> 2 } asDictionary.
	playground inspectorPresentation firstPresentation selectLine.
	
	playground inspectorPresentation firstPresentation announce: (GLMEvaluateSelection new 
		action: [ :aResult | obtainedResult := aResult ];
		makeSyncronous).
		
	self assert: obtainedResult equals: 3
	! !

!GTPlaygroundBasicTest methodsFor: 'running' stamp: 'StefanReichhart 3/20/2015 22:03'!
testAccessBindings
	|obtainedBindings expectedBindings|

	expectedBindings := Dictionary new.  
	expectedBindings add: (WorkspaceVariable key: #a value: 1).
	expectedBindings add: (WorkspaceVariable key: #b value: 2).
		
	window := playground openOn: (GTPlayPage new saveContent: 'a:=1. b:=a+1').
	playground inspectorPresentation firstPresentation selectLine.
	playground inspectorPresentation firstPresentation evaluateSelection.
		
	obtainedBindings := playground currentBindings.
		
	self assert: obtainedBindings equals: expectedBindings.
	! !

!GTPlaygroundBasicTest methodsFor: 'running' stamp: 'AndreiChis 1/30/2015 12:32'!
setUp

	playground := GTPlayground new.! !

!GTPlaygroundBasicTest methodsFor: 'running' stamp: 'StefanReichhart 3/20/2015 22:03'!
testResetBindings
	|obtainedBindings|

	window := playground openOn: (GTPlayPage new saveContent: 'number+1').
	playground 
		setBindings: { #number -> 2 } asDictionary.
		
	obtainedBindings := playground currentBindings.
	self assert: obtainedBindings size equals: 1.

	playground resetBindings.		
	
	obtainedBindings := playground currentBindings.
	self assert: obtainedBindings size equals: 0.
	! !

!GTPlaygroundBindingsList methodsFor: 'instance creation' stamp: 'AliakseiSyrel 3/30/2015 13:24'!
newBindingRow: anAssociation in: aCollection

	^ self newRow
		borderWidth: { 0 . 0 . aCollection last == anAssociation ifTrue: [ 0 ] ifFalse: [ self themer bindingThemer borderWidth ] . 0 };
		addAllBricks: {
			self newBindingLabel
				textColor: self themer textLightColor;
				text: anAssociation key.
			self newBindingLabel
				text: anAssociation value asString.
			self newInspectButtonFor: anAssociation.
			self newGoButtonFor: anAssociation.
			self newRemoveButtonFor: anAssociation };
		yourself! !

!GTPlaygroundBindingsList methodsFor: 'initialization' stamp: 'AliakseiSyrel 3/30/2015 13:22'!
initialize
	super initialize.
	
	self
		emptyBrick: self newEmptyText;
		maxHeight: 300;
		height: [ :b | b band height ];
		width: 300! !

!GTPlaygroundBindingsList methodsFor: 'instance creation' stamp: 'AliakseiSyrel 3/30/2015 12:27'!
newBindingLabel

	^ GLMLabelBrick new
		hSpaceFill: 50;
		vShrinkWrap;
		textPosition: #leftCenter;
		vAlign: #center;
		padding: { 0 . self themer bindingThemer padding }! !

!GTPlaygroundBindingsList methodsFor: 'instance creation' stamp: 'AliakseiSyrel 3/30/2015 13:24'!
newGoButtonFor: anAssociation

	^ self newActionButton
		hintTitle: 'Go';
		hintText: 'open new pane to the right';
		icon: self themer bindingThemer goIcon;
		action: [ : b | self remove. self announce: #go event: anAssociation. ]! !

!GTPlaygroundBindingsList methodsFor: 'brick-properties-events' stamp: 'AliakseiSyrel 3/30/2015 13:23'!
onThemerChanged
	super onThemerChanged.
	
	self doLayoutForce! !

!GTPlaygroundBindingsList methodsFor: 'instance creation' stamp: 'AliakseiSyrel 3/30/2015 13:19'!
newInspectButtonFor: anAssociation

	^ self newActionButton
		hintTitle: 'Inspect';
		hintText: 'will open inspector window';
		icon: self themer bindingThemer inspectIcon;
		action: [ : b | self remove. self announce: #inspect event: anAssociation. ]! !

!GTPlaygroundBindingsList methodsFor: 'actions' stamp: 'AliakseiSyrel 3/30/2015 13:19'!
remove

	(self ownerThatIsA:  GLMFoundationBrick)
		ifNotNil: [ :o | o delete ]! !

!GTPlaygroundBindingsList methodsFor: 'instance creation' stamp: 'AliakseiSyrel 3/30/2015 12:27'!
newActionButton
	|margin padding|
	margin := self themer bindingThemer padding + self themer bindingThemer borderWidth.
	padding := (margin / 2) rounded.
	
	^ GLMHintableActionButtonBrick new
		padding: padding;
		margin: {0 . padding};
		marginRight: margin;
		hShrinkWrap;
		pressedColor: self themer buttonPressedColor! !

!GTPlaygroundBindingsList methodsFor: 'instance creation' stamp: 'AliakseiSyrel 3/30/2015 13:10'!
newRemoveButtonFor: anAssociation

	^ self newActionButton
		beError;
		hintTitle: 'Remove binding';
		hintText: 'will unassign variable';
		icon: self themer bindingThemer removeIcon;
		action: [ : b |
			b owner disable.
			GLMAnimation swipeLeft
				onCompleted: [
					self announce: #bindingRemoved event: anAssociation.
					self model origin remove: anAssociation.
					self invalidate ];
				animate: b owner ]! !

!GTPlaygroundBindingsList methodsFor: 'instance creation' stamp: 'AliakseiSyrel 3/30/2015 12:26'!
newEmptyText

	^ GLMLabelBrick new
			text: 'No bindings';
			hSpaceFill;
			textPosition: #center;
			padding: self themer bindingThemer emptyTextPadding;
			textColor: self themer bindingThemer emptyTextColor;
			fontSize: self themer bindingThemer emptyTextFontSize;
			yourself! !

!GTPlaygroundBindingsList methodsFor: 'instance creation' stamp: 'AliakseiSyrel 3/30/2015 12:35'!
on: aBindingsCollection
	|model|
	model := GLMBrickListModel new
		on: aBindingsCollection.
	model
		morphAtLogic: [ :index | self newBindingRow: (model origin at: index) in: model origin ].
	self model: model! !

!GTPlaygroundBindingsList methodsFor: 'instance creation' stamp: 'AliakseiSyrel 3/30/2015 12:30'!
newRow

	^ GLMInteractableBrick new
		enable;
		selectedColor: self themer bindingThemer selectedColor;
		vShrinkWrap;
		hSpaceFill;
		padding: { self themer bindingThemer padding . 0 . self themer bindingThemer padding + self themer bindingThemer borderWidth };
		borderColor: self themer bindingThemer borderColor! !

!GTPlaygroundEditableTabLabel methodsFor: 'initialization' stamp: 'AliakseiSyrel 3/30/2015 13:01'!
initialize
	super initialize.
	
	self
		hSpaceFill;
		with: [ :label | label when: #onAccepted do: [ self announce: #accepted event: label text ] ];
		cancelOnEscape;
		cancelOnFocusLost;
		with: [ :b | b margin: { b themer focusedBorderWidth . 0 } ];
		with: [ :b | b editBrick
			hShrinkWrap;
			rubricBackgroundColor: b themer rubricBackgroundColor;
			margins: (self defaultPadding@0 corner: self defaultPadding@0) ];
		with: [ :b | b maxWidth: [ b approximateWidth + b owner hPadding] ];
		with: [ :b | b labelBrick margin: { 0 . self defaultPadding + 2. 0 . self defaultPadding } ];
		with: [ :b | b layout widthDependency: [ b owner ] ];
		with: [ :b | b editBrick layout widthDependency: [ b ] ];
		yourself ! !

!GTPlaygroundEditableTabLabel methodsFor: 'initialization' stamp: 'AliakseiSyrel 3/30/2015 13:00'!
defaultPadding

	^ 5! !

!GTSimpleMethodsBrowser commentStamp: 'TudorGirba 1/18/2014 14:29'!
This browser is used to browse the class structure of every object in the inspector.

Example:
self openOn: World!
!GTSimpleMethodsBrowser methodsFor: 'building' stamp: 'TudorGirba 12/17/2013 08:00'!
methodsIn: a
	^ a list
		display: [ :object :class | class methods collect: #asRingDefinition];
		filterOn: [ :text :each | (text , '*') match: each selector ];
		tags: [ :method | method category ];
		sorted: [ :method1 :method2 | method1 selector < method2 selector ];
		format: [ :method | method selector ];
		morphicSelectionAct: [ :list :object :class | 
			Smalltalk tools browser 
				fullOnClass: class 
				selector: list selection selector ]
			icon: GLMUIThemeExtraIcons glamorousBrowse
			on: $b
			entitled: 'Browse';
		dynamicActionsOnSelection: [ :list | self methodActionsFor: list selection ]! !

!GTSimpleMethodsBrowser methodsFor: 'building' stamp: 'TudorGirba 3/9/2014 08:59'!
compose
	self title: 'Meta'.
	self tabulator with: [ :browser |
		browser
			row: [ :r | r column: #classes; column: #methods span: 3 ];
			row: #source.
		browser transmit
			to: #classes;
			andShow: [ :a | self classesIn: a ].
		browser transmit
			to: #classes port: #selection;
			transformed: [:each | each class ].
		browser transmit
			fromOutsidePort: #entity;
			from: #classes;
			to: #methods;
			andShow: [ :a | self methodsIn: a ].
		browser transmit
			from: #methods;
			fromOutsidePort: #entity;
			to: #source;
			when: [ :method | method notNil ];
			andShow: [ :a :method :object | self sourceOf: method for: object in: a ].
		browser transmit
			toOutsidePort: #selection;
			from: #methods port: #evaluatedObject.
		browser transmit
			toOutsidePort: #selection;
			from: #source port: #evaluatedObject.
	]! !

!GTSimpleMethodsBrowser methodsFor: 'private' stamp: 'AndreiChis 1/24/2015 16:10'!
updateOuterPaneFrom: text for: method
	"this is a utility method to tell the pane surrounding the browser to update.
	The reason we do that is to support the use case of updating the GTInspector from
	the editor by modifying code directly in the Inspector."
	
	| outerPane newMethod |
	newMethod := method methodClass compile: text text notifying: nil.
	outerPane := text pane browser pane.
	outerPane browser panes do: #update.
	self
		flag:
			'This is a huge hack because of so many reasons:
				- the presentation accesses the state of the outer browser directly
				- the presentation depends on the implementation of the browser 
				It should be solved through transmissions.
				
				But, it works for now and the browser is reasonably updated'.
	^ outerPane
		withAllPanesAndPresentationsDo: [ :child | 
			(child isKindOf: self class)
				ifTrue: [ 
					((child first paneNamed: #classes) port: #selection) value: method methodClass.
					((child first paneNamed: #methods) port: #selection)
						value:
							((child first paneNamed: #methods) presentations first displayedValue detect: [ :each | each selector = newMethod ]) ] ]! !

!GTSimpleMethodsBrowser methodsFor: 'building' stamp: 'TudorGirba 12/21/2013 23:05'!
classesIn: a
	^ a list
		display: [ :object | 
			| all |
			all := OrderedCollection new.
			object class withAllSuperclassesDo: [:each | all add: each ].
			all ];
"		initialize: [ :list | list selection: list entity class ];"
		format: [ :class | class name ];
		morphicSelectionAct: [ :list | Smalltalk tools browser fullOnClass: list selection ]
			icon: GLMUIThemeExtraIcons glamorousBrowse
			on: $b
			entitled: 'Browse'! !

!GTSimpleMethodsBrowser methodsFor: 'building' stamp: 'TudorGirba 11/2/2014 22:04'!
sourceOf: method for: object in: composite
	^ composite smalltalkCode
		display: [ :m | m sourceCode ];
		smalltalkClass: [ :m | m methodClass ];
		doItReceiver: [ object ];
		selectionPopulate: #evaluatedObject
			on: $g
			entitled: 'Do it and go'
			with: [ :text | Smalltalk compiler evaluate: text selectedText for: object logged: false ];
		act: [ :text :m | self updateOuterPaneFrom: text for: method ]
			icon: GLMUIThemeExtraIcons glamorousAccept
			on: $s
			entitled: 'Accept';
		act: [ :text :m | 
			Smalltalk tools browser 
				fullOnClass: m methodClass 
				selector: m selector ]
			icon: GLMUIThemeExtraIcons glamorousBrowse
			entitled: 'Browse';
		act: [ :text :m | 
			(text pane port: #evaluatedObject) value: m ]
			icon: GLMUIThemeExtraIcons glamorousInspect
			entitled: 'Inspect'! !

!GTSimpleMethodsBrowser methodsFor: 'building' stamp: 'TudorGirba 10/3/2014 15:14'!
evaluationAction
	^ GLMGenericAction new
		action: [ :listPresentation :obj | 
					| result |
					result := obj perform: listPresentation selection selector.
					(listPresentation pane port: #evaluatedObject) value: result ];
		shortcut: $g;
		title: 'Do it and go';
		yourself! !

!GTSimpleMethodsBrowser methodsFor: 'building' stamp: 'TudorGirba 7/15/2012 18:58'!
methodActionsFor: aMethod
	^ aMethod selector isUnary
		ifTrue: [ Array with: self evaluationAction ]
		ifFalse: [ #() ]! !

!GTSimpleMethodsBrowser methodsFor: 'building' stamp: 'TudorGirba 11/24/2013 08:37'!
accumulatedSourceOf: m for: object in: composite
	composite accumulator with: [ :acc | 
		acc show: [ :a |
			a title: [ :method | method selector ].
			self sourceOf: m for: object in: a ] ]! !

!GTSimpleRBTreeBrowser commentStamp: '<historical>'!
This is a simple browser that displays the rb tree and previews each node on the source code.

Example:
self openOn: (self>>#compose) parseTree!
!GTSimpleRBTreeBrowser methodsFor: 'building' stamp: 'TudorGirba 11/29/2013 14:56'!
sourceIn: a
	^ a smalltalkCode 
		smalltalkClass: [ :each | each parents first methodClass ]; 
		display: [ :each | each source ]! !

!GTSimpleRBTreeBrowser methodsFor: 'building' stamp: 'TudorGirba 12/21/2013 23:09'!
compose
	self title: 'Tree'.
	self tabulator with: [ :browser |
		browser
			row: #tree;
			row: #source.
		browser transmit
			to: #tree;
			andShow: [ :a | self treeIn: a ].
		browser transmit
			to: #source;
			andShow: [ :a | self sourceIn: a ].
		browser transmit
			from: #tree;
			to: #source port: #selectionInterval;
			transformed: [ :rbNode | rbNode sourceInterval ].
		browser transmit
			toOutsidePort: #selection;
			from: #tree port: #selectedNode ]! !

!GTSimpleRBTreeBrowser methodsFor: 'building' stamp: 'TudorGirba 8/23/2011 01:17'!
treeIn: a
	^ a tree
		rootsExpanded;
		display: [ :anObject | {anObject} ];
		children: [ :each | each children ];
		selectionPopulate: #selectedNode
			on: $o
			entitled: 'Open'
			with: [ :tree | tree selection ];
		format: [ :each | 
					String
						streamContents: [ :stream | 
							stream
								nextPutAll: each class name;
								nextPut: $(;
								nextPutAll: ((each formattedCode truncateTo: 50) copyReplaceAll: String cr with: String space);
								nextPut: $) ] ]! !

!GTSnippets commentStamp: '<historical>'!
GTSnippets instance!
!GTSnippets methodsFor: 'accessing' stamp: 'TudorGirba 12/30/2013 23:44'!
snippetAt: anObject put: aString
	^ self snippets 
		at: anObject 
		put: aString! !

!GTSnippets methodsFor: 'accessing' stamp: 'TudorGirba 12/30/2013 23:44'!
snippetAt: anObject
	^ self snippets 
		at: anObject 
		ifAbsent: [ 'self' ]! !

!GTSnippets methodsFor: 'accessing' stamp: 'TudorGirba 5/26/2014 12:39'!
snippetAtOrEmpty: anObject
	^ self snippets 
		at: anObject 
		ifAbsent: [ '' ]! !

!GTSnippets methodsFor: 'accessing' stamp: 'TudorGirba 11/27/2013 14:59'!
snippets 
	^ snippets ifNil: [ snippets := IdentityDictionary new ]! !

!GTSnippets class methodsFor: 'accessing' stamp: 'TudorGirba 11/27/2013 15:10'!
snippetAt: anObject put: aString
	^ self instance snippetAt: anObject put: aString! !

!GTSnippets class methodsFor: 'accessing' stamp: 'TudorGirba 2/2/2014 14:05'!
reset
	instance := nil! !

!GTSnippets class methodsFor: 'accessing' stamp: 'TudorGirba 11/27/2013 15:00'!
snippetAt: anObject
	^ self instance snippetAt: anObject! !

!GTSnippets class methodsFor: 'accessing' stamp: 'TudorGirba 11/27/2013 14:55'!
instance
	^ instance ifNil: [ instance := self new ]! !

!GTSpotter commentStamp: 'TudorGirba 11/26/2014 14:06'!
This is the main model class.

It handles the steps of the search, and it handles the search text.!
!GTSpotter methodsFor: 'accessing' stamp: 'AliaskeiSyrel 11/8/2014 16:36'!
foundationOrigin: anObject
	
	foundationOrigin := anObject! !

!GTSpotter methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/27/2015 09:07'!
spotterForMetacelloConfigurationsFor: aStep
	<spotterOrder: 86>
	aStep listProcessor
			title: 'Metacello Configurations';
			allCandidates: [ 
				Smalltalk allClasses select: [ :each | 
					(each respondsTo: #isMetacelloConfig) 
						and: [ each isMetacelloConfig
							and: [ each name beginsWith: 'ConfigurationOf' ] ] ]
					thenCollect: #project ];
			itemName: [ :each | each configuration class name ];
			itemIcon: [ Smalltalk ui icons iconNamed: #configIcon ];
			filter: GTFilterSubstring;
			wantsToDisplayOnEmptyQuery: false! !

!GTSpotter methodsFor: '*GT-SpotterExtensions-Core-private' stamp: 'StefanReichhart 3/23/2015 16:35'!
evaluateExpressionInContext: aSpotterContext usingFilter: filter
	" only allow arithmethic selectors to be evaluated - otherwise this may have some severe side-effects "
	| result |
	" filter allowed selectors "
	(Number withAllSubclasses anySatisfy: [ :class |
		class selectors anySatisfy: [ :selector | 
			aSpotterContext textTrimmed includesSubstring: selector caseSensitive: true ] ]) ifFalse: [ ^ self ].
	" perform the selector "
	Smalltalk compiler 
		silentlyDo: [ result := Smalltalk compiler evaluate: aSpotterContext textTrimmed ] 
		exceptionDo: [ ^ self ].
	result isNumber ifFalse: [ ^ self ].
	filter value: result. 
	" if the result is not readable as float, append the float as well "
	(result isFraction and: [ result isInteger not ]) ifTrue: [
		filter value: result asFloat ]! !

!GTSpotter methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 4/11/2015 22:18'!
spotterForStashedPlaygroundPagesFor: aStep
	<spotterOrder: 100>
	aStep listProcessor
			allCandidates: [ 
				| stashFiles |
				stashFiles := GTPlayBook stashDirectory files 
					select: [ :each | each extension = GTPlayPage fileExtension ].
				stashFiles collect: [ :file |
					(GTPlayPage fromFileReference: file) 
						title: (file basename copyUpTo: $-) ] ];
			title: 'Playground named pages';
			itemName: [ :page | page title, ' - ', page content asString contractTo: 100 ];
			filter: GTFilterSubstring! !

!GTSpotter methodsFor: 'notifying' stamp: 'AndreiChis 3/20/2015 18:29'!
notifyDiveInCategory: aProcessor for: anEventType

	self announce: (GTSpotterDiveInCategory new 
		category: aProcessor;
		eventType: anEventType)! !

!GTSpotter methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 4/8/2015 10:30'!
spotterExamplesFor: aStep
	<spotterOrder: 40>
	aStep listProcessor
		title: 'Examples';
		filter: GTFilterSubstring item: [ :filter :context | 
			SystemNavigation default allBehaviorsDo: [ :class | class gtExamples do: filter ] ];
		wantsToDisplayOnEmptyQuery: false! !

!GTSpotter methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 4/10/2015 13:23'!
spotterHistoryFor: aStep
	<spotterOrder: 8>
	aStep listProcessor
			allCandidates: [ self history asArray select: [ :each | each isNotNil and: [ each value isNotNil ] ] ];
			title: 'History';
			itemName: [ :item | 
				item class = GTSpotterProcessorLink 
					ifTrue: [ item processor itemNameFor: item value ] " HACK: this triggers a recursion !! ... but processor is undefined for aCandidate "
					ifFalse: [ item gtDisplayString ] ];
			filter: GTFilterSubstring! !

!GTSpotter methodsFor: 'notifying' stamp: 'AliakseiSyrel 1/25/2015 19:15'!
announce: anAnnouncement
	
	self announcer announce: anAnnouncement! !

!GTSpotter methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/24/2015 14:45'!
spotterDirtyMonticelloPackagesFor: aStep
	<spotterOrder: 85>
	aStep listProcessor
			allCandidates: [ MCWorkingCopy allManagers select: #modified ];
			title: 'Dirty Monticello packages';
			itemIcon: [ Smalltalk ui icons iconNamed: #dirtyPackageIcon ];
			filter: GTFilterSubstring;
			wantsToDisplayOnEmptyQuery: true! !

!GTSpotter methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/22/2015 21:45'!
spotterForFilesFor: aStep
	<spotterOrder: 40>
	self flag: #specialFilter.
	aStep listProcessor
		title: 'Files';
		itemIcon: [ GLMUIThemeExtraIcons glamorousBrowse ];
		itemFilterName: [ :reference | reference basename ];
		filter: GTFilterFileReference item: [ :filter :context | 
			self fileReferencesBy: #files inContext: context usingFilter: filter ];
		wantsToDisplayOnEmptyQuery: false! !

!GTSpotter methodsFor: 'accessing' stamp: 'AliaskeiSyrel 11/8/2014 17:12'!
foundationOrigin
	
	^ foundationOrigin ifNil: [ foundationOrigin := self ]! !

!GTSpotter methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/24/2015 14:45'!
spotterForClassesFor: aStep
	<spotterOrder: 10>
	aStep listProcessor
			allCandidates: [ Smalltalk allClassesAndTraits ];
			title: 'Classes';
			filter: GTFilterSubstring;
			itemIcon: #systemIcon;
			wantsToDisplayOnEmptyQuery: false! !

!GTSpotter methodsFor: 'actions api' stamp: 'AliakseiSyrel 2/24/2015 12:03'!
addStep: aStepModel

	self steps add: aStepModel.
	self notifyStepAdded: aStepModel! !

!GTSpotter methodsFor: 'model access' stamp: 'AliakseiSyrel 2/8/2015 14:25'!
setText: aText from: aView

	self steps isEmpty
		"by default there are no steps, so we need to create one based on foundation origin"
		ifTrue: [ self addStep: ( self newStep origin: self foundationOrigin ) ].

	(aText asString isEmpty and: [ self text isEmpty not ])
		ifTrue: [ self currentStep process: nil ]
		ifFalse: [ self currentStep process: aText asString ].
	
	text := aText asString asText.
	^ true! !

!GTSpotter methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/15/2014 15:34'!
currentStep: aStepModel
	
	currentStep := aStepModel.
	self notifyCurrentStepChanged! !

!GTSpotter methodsFor: '*GT-SpotterExtensions-Core-private' stamp: 'StefanReichhart 4/1/2015 22:12'!
fileReferencesBy: aSelector inContext: aSpotterContext usingFilter: aBlock
	| split rootDirectory query |
	split := aSpotterContext textLowercase piecesCutWhere: [ :a :b | a = FileSystem disk delimiter ].
	split size < 1
		ifTrue: [ 
			query := aSpotterContext textLowercase.
			rootDirectory := FileSystem workingDirectory ]
		ifFalse: [ 
			(split last last = FileSystem disk delimiter)
				ifTrue: [ 
					query := ''.
					rootDirectory := aSpotterContext textLowercase asFileReference ]
				ifFalse: [ 
					query := split last.
					rootDirectory := ('' join: split allButLast) asFileReference ] ].
	rootDirectory exists ifFalse: [ ^ self ].
	self flag: 'this is an ugly hack for #queryForFileReference. This iterator has to manipulate the query in order for the filter to work properly'.
	aSpotterContext cacheAt: #queryForFileReference put: query.
	(rootDirectory perform: aSelector) do: aBlock! !

!GTSpotter methodsFor: 'actions api' stamp: 'AliakseiSyrel 11/21/2014 23:50'!
terminateProcessors

	self steps do: [ :each | each terminateProcessors ]! !

!GTSpotter methodsFor: 'accessing' stamp: 'StefanReichhart 3/17/2015 15:30'!
exceptionHandler
	^ exceptionHandler ifNil: [ exceptionHandler := self defaultExceptionHandler ]! !

!GTSpotter methodsFor: 'notifying' stamp: 'AliakseiSyrel 2/27/2015 23:17'!
notifyHideHints

	self announce: GTSpotterHideHints new! !

!GTSpotter methodsFor: 'accessing' stamp: 'StefanReichhart 3/17/2015 15:14'!
exceptionHandler: anObject
	exceptionHandler := anObject! !

!GTSpotter methodsFor: 'testing' stamp: 'AliaskeiSyrel 11/13/2014 20:41'!
isEmpty

	^ self steps isEmpty! !

!GTSpotter methodsFor: '*GT-SpotterExtensions-Core-private' stamp: 'TudorGirba 4/11/2015 22:57'!
concreteMethodsInContext: aContext usingFilter: aFilter
	" return the concrete methods described by the expression (Class >> #Selector) - evaluate it savely "
	| classAndSelectorStrings class selector |
	classAndSelectorStrings := (aContext textTrimmed splitOn: '>>') collect: [ :each | each trimBoth ].
	
	" check preconditions "
	classAndSelectorStrings size = 2 ifFalse: [ ^ self ].
	classAndSelectorStrings second size < 2 ifTrue: [ ^ self ].

	" retrieve concrete class and selector - or saerch all behaviors "
	selector := classAndSelectorStrings second first = $# 
		ifTrue: [ classAndSelectorStrings second allButFirst asSymbol ]
		ifFalse: [ classAndSelectorStrings second asSymbol ].
	
	(class := Smalltalk classNamed: classAndSelectorStrings first) ifNil: [ 
		SystemNavigation default allBehaviorsDo: [ :aClass |
			aClass methodsDo: [ :method |
				method selector = selector ifTrue: [ aFilter value: method ] ] ].
		^ self ].
	
	
	" retrieve the compiled method in the class and class hierarchy "
	class withAllSuperclassesDo: [ :aClass |
		aFilter value: ([ aClass compiledMethodAt: selector ] on: Error do: [ ^ self ]) ]! !

!GTSpotter methodsFor: 'testing' stamp: 'AliakseiSyrel 1/26/2015 15:51'!
isPreviewVisible

	^ isPreviewVisible ifNil: [ isPreviewVisible := false ]! !

!GTSpotter methodsFor: 'notifying' stamp: 'AndreiChis 3/20/2015 18:35'!
notifyActOn: anObject for: anEventType

	self announce: (GTSpotterActOn new 
		element: anObject;
		eventType: anEventType)! !

!GTSpotter methodsFor: 'notifying' stamp: 'AndreiChis 3/20/2015 19:38'!
notifySpotterExitFor: anEventType

	self announce: (GTSpotterExitAnnouncement new
		eventType: anEventType)! !

!GTSpotter methodsFor: 'accessing-defaults' stamp: 'StefanReichhart 3/12/2015 16:44'!
defaultPagerModel
	^ GLMPagerModel new! !

!GTSpotter methodsFor: 'accessing' stamp: 'TudorGirba 11/26/2014 11:33'!
currentStep
	
	^ currentStep ifNil: [ 
			self isEmpty 
				ifTrue: [ self newStep origin: self foundationOrigin ]
				ifFalse: [ currentStep := self steps last ] ]! !

!GTSpotter methodsFor: 'accessing' stamp: 'StefanReichhart 3/12/2015 16:45'!
pagerModel

	^ pagerModel ifNil: [
		pagerModel := self defaultPagerModel defaultNumberOfVisiblePages: 1.
		pagerModel announcer subscribe: GLMPagePoped send: #onPagePopped to: self.
		pagerModel ]! !

!GTSpotter methodsFor: 'accessing' stamp: 'TudorGirba 4/10/2015 13:23'!
history: aWeakCollection
	history := aWeakCollection! !

!GTSpotter methodsFor: 'notifying' stamp: 'AliakseiSyrel 2/24/2015 12:05'!
notifyStepAdded: aStep

	self announce: (GTSpotterStepAdded new stepModel: aStep)! !

!GTSpotter methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 12/17/2014 12:56'!
spotterWorldMenuFor: aStep
	<spotterOrder: 9>
	^ (World worldMenu spotterItemsFor: aStep)
		title: 'Menu'! !

!GTSpotter methodsFor: 'actions api' stamp: 'AliakseiSyrel 2/24/2015 12:01'!
hidePreview

	self isPreviewVisible ifFalse: [ ^ self ].
	isPreviewVisible := false.
	self class dontShowPreview.
	self notifyHidePreview
	! !

!GTSpotter methodsFor: 'notifying' stamp: 'AndreiChis 3/20/2015 18:42'!
notifyDiveIn: anObject for: anEventType

	self announce: (GTSpotterDiveInElement new 
		element: anObject;
		eventType: anEventType )! !

!GTSpotter methodsFor: 'actions api' stamp: 'AndreiChis 3/20/2015 19:36'!
exit

	self exitDueTo: #unknown! !

!GTSpotter methodsFor: 'accessing-convenience' stamp: 'StefanReichhart 4/1/2015 19:39'!
beDebugging
	self exceptionHandler: GTSpotterDebuggingExceptionHandler new! !

!GTSpotter methodsFor: 'notifying' stamp: 'AliakseiSyrel 2/24/2015 12:05'!
notifyHidePreview

	self announce: GTSpotterHidePreview new! !

!GTSpotter methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/22/2015 21:44'!
spotterForDirectoriesFor: aStep
	<spotterOrder: 50>
	self flag: #specialFilter.
	aStep listProcessor
		title: 'Directories';
		itemIcon: [ GLMUIThemeExtraIcons glamorousFolder ];
		itemFilterName: [ :reference | reference basename ];
		filter: GTFilterFileReference item: [ :filter :context | 
			self fileReferencesBy: #directories inContext: context usingFilter: filter ];
		wantsToDisplayOnEmptyQuery: false	! !

!GTSpotter methodsFor: 'actions api' stamp: 'TudorGirba 3/30/2015 22:27'!
shiftPressed: aBoolean

	self isShiftPressed = aBoolean ifTrue: [ ^ self ].
	
	isShiftPressed := aBoolean.
	
	SmalltalkImage current vm canHandleShiftPressed
		ifTrue: [ ^ isShiftPressed := false ].

	self isShiftPressed
		ifTrue: [ self notifyRevealHints ]
		ifFalse: [ self notifyHideHints ]

	! !

!GTSpotter methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/25/2015 08:50'!
spotterClipboardFor: aStep
	<spotterOrder: 90>
	^ aStep listProcessor
		title: 'Clipboard History';
		items: [ Clipboard default recentItems ];
		itemName: [ :item | item asString contractTo: 100 ];
		itemFilterName: [ :item | item asString ];
		filter: GTFilterSubstrings;
		actLogic: [ :item | item asString inspect ];
		wantsToDisplayOnEmptyQuery: false! !

!GTSpotter methodsFor: 'instance creation' stamp: 'StefanReichhart 3/12/2015 14:30'!
newStep

	^ self defaultStep
		spotter: self! !

!GTSpotter methodsFor: 'accessing' stamp: 'TudorGirba 11/24/2014 12:23'!
previousStep
	
	^ self steps size > 1 
		ifTrue: [ self steps reversed second ]! !

!GTSpotter methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/24/2015 14:45'!
spotterForGlobalVarsFor: aStep
	<spotterOrder: 40>
	aStep listProcessor
			allCandidates: [ Smalltalk globals associations select:[:assoc | 
			assoc value isBehavior not and:[ 
				assoc value isTrait not]] ];
			title: 'Global variables';
			itemName:[:global | global key ];
			filter: GTFilterSubstring;
			wantsToDisplayOnEmptyQuery: false! !

!GTSpotter methodsFor: 'notifying' stamp: 'AliakseiSyrel 2/24/2015 12:27'!
notifyCategorySelected: aProcessor

	self announce: (GTSpotterCategorySelected new category: aProcessor)! !

!GTSpotter methodsFor: 'inspecting' stamp: 'TudorGirba 4/10/2015 10:51'!
gtInspectorStepsIn: composite
	<gtInspectorPresentationOrder: 40>
	composite list
		title: 'Steps';
		display: [ self steps ];
		when: [ self steps notEmpty ]! !

!GTSpotter methodsFor: 'notifying' stamp: 'AliakseiSyrel 2/27/2015 23:17'!
notifyRevealHints

	self announce: GTSpotterRevealHints new! !

!GTSpotter methodsFor: 'actions api' stamp: 'TudorGirba 4/10/2015 13:23'!
historize: target

	(target = self or: [ target isNil ])
		ifFalse: [ 
			self history removeAllSuchThat: [ :each | each value = target value ] .
			self history addFirst: target ]! !

!GTSpotter methodsFor: 'event handling' stamp: 'AliakseiSyrel 2/24/2015 12:21'!
requestNextCategoryStepWith: aProcessorLink
	|collection|
	
	collection := aProcessorLink processor allFilteredCandidates
		collect: [ :each | each asSpotterCandidateLink renderingProcessor: aProcessorLink ].
		
	self requestNextStepWith: collection! !

!GTSpotter methodsFor: 'accessing' stamp: 'AliaskeiSyrel 11/13/2014 21:20'!
steps

	^ steps ifNil: [ steps := OrderedCollection new ]! !

!GTSpotter methodsFor: 'actions api' stamp: 'AliakseiSyrel 2/24/2015 12:30'!
after: afterBlock do: doBlock with: withBlock
	|value|
	value := withBlock brickValue: self.
	afterBlock brickValue: self.
	doBlock brickValue: value! !

!GTSpotter methodsFor: 'accessing' stamp: 'AliaskeiSyrel 11/13/2014 21:21'!
text

	^ text ifNil: [ text := '' asText ]! !

!GTSpotter methodsFor: 'accessing' stamp: 'TudorGirba 4/10/2015 13:23'!
history
	^ history ifNil: [ self class history ]! !

!GTSpotter methodsFor: 'notifying' stamp: 'JurajKubelka 3/6/2015 16:35'!
notifySearchFinishedFor: aString processors: aCollectionOfProcessors

	self announce: (GTSpotterSearchFinished new 
								query: aString;
								processors: aCollectionOfProcessors;
								yourself)! !

!GTSpotter methodsFor: 'notifying' stamp: 'AndreiChis 3/20/2015 19:09'!
notifyCandidateSelected: anObject for: anEventType

	self announce: (GTSpotterSelectedCandidateChanged new 
		selected: anObject;
		eventType: anEventType)! !

!GTSpotter methodsFor: 'actions api' stamp: 'AliakseiSyrel 2/24/2015 12:02'!
showPreview

	self isPreviewVisible ifTrue: [ ^ self ].
	isPreviewVisible := true.
	self class showPreview.
	self notifyShowPreview
	! !

!GTSpotter methodsFor: 'event handling' stamp: 'StefanReichhart 3/18/2015 14:23'!
handleExceptionsDuring: aBlock
	self exceptionHandler handleExceptionsDuring: aBlock! !

!GTSpotter methodsFor: 'actions api' stamp: 'AliakseiSyrel 1/26/2015 15:53'!
togglePreview

	self isPreviewVisible
		ifTrue: [ self hidePreview ]
		ifFalse: [ self showPreview ]! !

!GTSpotter methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/27/2015 09:08'!
spotterForRepositoriesFor: aStep
	<spotterOrder: 87>
	aStep listProcessor
		title: 'Monticello Repositories';
		allCandidates: [ MCRepositoryGroup default repositories ];
		itemIcon: #systemIcon;
		wantsToDisplayOnEmptyQuery: false;
		filter: GTFilterSubstring! !

!GTSpotter methodsFor: 'accessing-defaults' stamp: 'StefanReichhart 3/12/2015 14:30'!
defaultStep
	^ GTSpotterStep new! !

!GTSpotter methodsFor: 'accessing-defaults' stamp: 'StefanReichhart 3/22/2015 18:32'!
defaultExceptionHandler
	^ GTSpotterDeploymentExceptionHandler new! !

!GTSpotter methodsFor: '*GT-SpotterExtensions-Core' stamp: 'AndreiChis 3/6/2015 14:40'!
spotterForHelpTopicFor: aStep
	<spotterOrder: 200>
	aStep listProcessor 
			allCandidates: [ SystemHelp asHelpTopic gtAllSubtopics ];
			title: 'Help topics';
			itemName: [ :helpTopic | helpTopic title ];
			itemIcon: [ :helpTopic | helpTopic gtTopicIcon ];
			matchSubstrings;
			wantsToDisplayOnEmptyQuery: true! !

!GTSpotter methodsFor: 'actions api' stamp: 'AliakseiSyrel 2/24/2015 12:12'!
popStep

	"there always should be minimum one step left"
	(self steps size > 1)
		ifTrue: [
			self
				after: [ self steps removeLast ]
				do: [ :o | self notifyDiveOut: o ]
				with: self currentStep origin.
			self notifyStepPopped.
			"perform pane popping only after we scrolled to the penultimate pane, so user doesn't see blinking"
			self pagerModel
				scrollToPane: self steps size
				callback: [ self pagerModel popPane: false ] ]! !

!GTSpotter methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 4/1/2015 21:56'!
spotterImplementorsFor: aStep
	<spotterOrder: 30>
	self flag: #specialFilter.
	aStep listProcessor
		title: 'Implementors';
		filter: GTFilterImplementor item: [ :filter :context | 
			SystemNavigation default allBehaviorsDo: [ :class | class methodsDo: filter ] ];
		wantsToDisplayOnEmptyQuery: false! !

!GTSpotter methodsFor: 'notifying' stamp: 'AliakseiSyrel 2/24/2015 12:04'!
notifyCurrentStepChanged

	self announce: GTSpotterCurrentStepChanged new! !

!GTSpotter methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/24/2015 12:05'!
announcer

	^ announcer ifNil: [ announcer := Announcer new ]! !

!GTSpotter methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/19/2015 10:53'!
isShiftPressed

	^ isShiftPressed ifNil: [ isShiftPressed := false ]! !

!GTSpotter methodsFor: 'protocol' stamp: 'AliakseiSyrel 2/24/2015 12:06'!
menu

	^ nil! !

!GTSpotter methodsFor: 'accessing-convenience' stamp: 'StefanReichhart 4/1/2015 19:39'!
beDeployment
	self exceptionHandler: GTSpotterDeploymentExceptionHandler new! !

!GTSpotter methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 4/1/2015 22:13'!
spotterConcreteMethodFor: aStep
    <spotterOrder: 30>
	self flag: #specialFilter.
	^ aStep listProcessor
		title: 'Methods';
		filter: GTNullFilter item: [ :filter :context |
			self concreteMethodsInContext: context usingFilter: filter ];
		wantsToDisplayOnEmptyQuery: false! !

!GTSpotter methodsFor: 'model access' stamp: 'AliaskeiSyrel 11/13/2014 21:22'!
getText

	^ self text! !

!GTSpotter methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/24/2015 14:45'!
spotterForPackagesFor: aStep
	<spotterOrder: 20>
	aStep listProcessor
			allCandidates: [ RPackageOrganizer default packages ];
			title: 'Packages';
			itemName: [ :package | package name ];
			itemIcon: [ Smalltalk ui icons iconNamed: #packageIcon ];
			filter: GTFilterSubstring;
			wantsToDisplayOnEmptyQuery: false! !

!GTSpotter methodsFor: 'notifying' stamp: 'AliakseiSyrel 2/24/2015 12:04'!
notifyDiveOut: anObject

	self announce: (GTSpotterDiveOut new element: anObject)! !

!GTSpotter methodsFor: 'printing' stamp: 'AliakseiSyrel 2/24/2015 12:05'!
gtDisplayOn: stream

	stream nextPutAll: 'Spotter'! !

!GTSpotter methodsFor: 'event handling' stamp: 'AliakseiSyrel 2/24/2015 12:04'!
requestNextStepWith: origin

	text := ''.
	self pushStep: (self newStep origin: origin; yourself).
	self steps last process: nil! !

!GTSpotter methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/22/2015 21:39'!
spotterStfxFor: aStep
	<spotterOrder: 30>
	self flag: #specialFilter.
	^ aStep listProcessor
		title: 'ws.stfx.eu';
		filter: GTNullFilter item: [ :filter :context | 
			(context textTrimmed beginsWith: 'http://ws.stfx.eu')
				ifTrue: [ GTPlayPage loadFromPublishUrl: context textTrimmed thenDo: filter ] ]! !

!GTSpotter methodsFor: 'testing' stamp: 'TudorGirba 11/24/2014 12:23'!
hasPreviousStep

	^ self steps size > 1! !

!GTSpotter methodsFor: 'actions api' stamp: 'AliakseiSyrel 11/15/2014 15:40'!
pushStep: stepModel
	
	self addStep: stepModel.
	"updating current step"
	self currentStep: stepModel! !

!GTSpotter methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/8/2015 14:13'!
spotterForPragmasFor: aStep
	<spotterOrder: 40>
	aStep listProcessor 
			allCandidates: [ PragmaType all ];
			title: 'Pragmas';
			itemName: [ :pragma | pragma keyword ];
			filter: GTFilterSubstring;
			wantsToDisplayOnEmptyQuery: false! !

!GTSpotter methodsFor: 'actions api' stamp: 'AliakseiSyrel 2/24/2015 12:32'!
after: afterBlock do: doBlock ifTrue: conditionBlock
	|value|
	value := conditionBlock brickValue: self.
	afterBlock brickValue: self.
	value ifTrue: [ doBlock brickValue: value ]! !

!GTSpotter methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 4/7/2015 23:32'!
spotterForCachedPlaygroundPagesFor: aStep
	<spotterOrder: 100>
	aStep listProcessor
			allCandidates: [ GTPlayBook instance pages ];
			title: 'Playground cached pages';
			itemName: [ :page | page content asString contractTo: 100 ];
			filter: GTFilterSubstring! !

!GTSpotter methodsFor: 'actions api' stamp: 'AliakseiSyrel 2/18/2015 14:18'!
popUntil: aStep

	[ self steps last = aStep ]
		whileFalse: [ self popStep ]! !

!GTSpotter methodsFor: 'event handling' stamp: 'AliakseiSyrel 11/15/2014 16:21'!
onPagePopped
	
	self steps size > 0 ifTrue: [
		self currentStep: self steps last ]! !

!GTSpotter methodsFor: 'actions api' stamp: 'AndreiChis 3/20/2015 19:38'!
exitDueTo: anEventType

	self notifySpotterExitFor: anEventType! !

!GTSpotter methodsFor: 'notifying' stamp: 'StefanReichhart 2/28/2015 19:39'!
notifyContextChangedFrom: aPreviousContext to: aCurrentContext
	self announce: (GTSpotterContextChanged new
		previous: aPreviousContext;
		current: aCurrentContext;
		yourself)! !

!GTSpotter methodsFor: 'notifying' stamp: 'AliakseiSyrel 2/24/2015 12:05'!
notifyStepPopped

	self announce: GTSpotterStepPopped new! !

!GTSpotter methodsFor: 'notifying' stamp: 'AliakseiSyrel 2/24/2015 12:05'!
notifyShowPreview

	self announce: GTSpotterShowPreview new

	! !

!GTSpotter methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/22/2015 21:42'!
spotterForExpressionsFor: aStep
	<spotterOrder: 1>
	self flag: #specialFilter.
	aStep listProcessor
		title: 'Calculator';
		filter: GTNullFilter item: [ :filter :context | 
			self evaluateExpressionInContext: context usingFilter: filter ];
		wantsToDisplayOnEmptyQuery: false! !

!GTSpotter class methodsFor: 'inspecting' stamp: 'TudorGirba 11/27/2014 06:57'!
gtInspectorExtensionsIn: composite
	<gtInspectorPresentationOrder: 40>
	composite list
		title: 'Extensions';
		display: [ self spotterExtendingMethods ];
		showOnly: 50;
		format: [ :each | each gtDisplayString ];
		filterOn: [ :text :each | each gtDisplayString includesSubstring: text caseSensitive: false ]! !

!GTSpotter class methodsFor: 'testing' stamp: 'AliakseiSyrel 1/29/2015 02:53'!
isPreviewVisible

	^ isPreviewVisible ifNil: [ isPreviewVisible := false ]! !

!GTSpotter class methodsFor: 'testing' stamp: 'AndreiChis 3/18/2015 15:50'!
wasOpened

	^ wasOpened ifNil: [ false ]! !

!GTSpotter class methodsFor: 'inspecting' stamp: 'TudorGirba 11/27/2014 06:57'!
spotterExtendingMethods
	^(Object withAllSubclasses
		flatCollect: [ :each | 
			(Pragma allNamed: #spotterOrder: in: each) 
				collect: [ :p | p method asRingDefinition ] ])
		sorted! !

!GTSpotter class methodsFor: 'example' stamp: 'StefanReichhart 4/9/2015 12:01'!
gtExampleBasic
	<gtExample>
	^ self new! !

!GTSpotter class methodsFor: 'example' stamp: 'TudorGirba 4/10/2015 11:08'!
gtExampleWithOneStepFrom: aSpotter
	<gtExample>
	<gtExampleFrom: #gtExampleBasic>
	| step |
	step := GTSpotterStep new spotter: aSpotter.
	aSpotter steps add: step.
	aSpotter currentStep: step.
	^ aSpotter! !

!GTSpotter class methodsFor: 'example' stamp: 'TudorGirba 2/19/2015 23:52'!
exampleWithPreview
	^ GTSpotterMorph new
		extent: (World width / 2.5 @ (World height / 1.5)) asIntegerPoint;
		spotterModel: self new;
		showPreview;
		openCenteredInWorld! !

!GTSpotter class methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/24/2015 10:34'!
resetHistory
	"
	self resetHistory
	"
	^ history := nil! !

!GTSpotter class methodsFor: 'cleanup' stamp: 'AndreiChis 3/18/2015 15:50'!
cleanUp
    self resetHistory.
	wasOpened := false! !

!GTSpotter class methodsFor: 'accessing' stamp: 'TudorGirba 12/1/2014 23:59'!
history
	^ history ifNil: [ history := WeakOrderedCollection new ]! !

!GTSpotter class methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/29/2015 02:57'!
showPreview

	isPreviewVisible := true! !

!GTSpotter class methodsFor: 'example' stamp: 'AliakseiSyrel 1/19/2015 21:28'!
exampleMC
	"self exampleMC"
	
	^ GTSpotterMorph new
		extent: 400@500;
		doLayout;
		spotterModel: (self on: MCWorkingCopy allManagers);
		openCenteredInWorld! !

!GTSpotter class methodsFor: 'accessing' stamp: 'AndreiChis 3/18/2015 15:50'!
markOpened

	wasOpened := true! !

!GTSpotter class methodsFor: 'instance creation' stamp: 'AliaskeiSyrel 11/8/2014 16:37'!
on: anObject
	
	^ self new foundationOrigin: anObject! !

!GTSpotter class methodsFor: 'example' stamp: 'AliakseiSyrel 1/19/2015 21:28'!
exampleWorldMenu
	
	^ GTSpotterMorph new
		extent: 400@500;
		doLayout;
		spotterModel: (self on: World worldMenu);
		openCenteredInWorld! !

!GTSpotter class methodsFor: 'example' stamp: 'AliakseiSyrel 1/19/2015 21:28'!
exampleInWindow
	
	^ GTSpotterMorph new
		extent: 400@500;
		doLayout;
		spotterModel: self new;
		openInWindow! !

!GTSpotter class methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/29/2015 02:52'!
dontShowPreview

	isPreviewVisible := false! !

!GTSpotterActOn methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/24/2015 10:58'!
element
	^ element! !

!GTSpotterActOn methodsFor: 'accessing' stamp: 'AndreiChis 3/20/2015 18:34'!
eventType: anObject
	eventType := anObject! !

!GTSpotterActOn methodsFor: 'accessing' stamp: 'AndreiChis 3/20/2015 18:34'!
eventType
	^ eventType! !

!GTSpotterActOn methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/24/2015 10:58'!
element: anObject
	element := anObject! !

!GTSpotterAllCandidatesAdded methodsFor: 'accessing' stamp: 'TudorGirba 11/28/2014 11:45'!
category: anObject
	category := anObject! !

!GTSpotterAllCandidatesAdded methodsFor: 'accessing' stamp: 'TudorGirba 11/28/2014 11:45'!
category
	^ category! !

!GTSpotterAllCandidatesAdded methodsFor: 'accessing' stamp: 'TudorGirba 11/28/2014 11:45'!
candidateLinks: anObject
	candidateLinks := anObject! !

!GTSpotterAllCandidatesAdded methodsFor: 'accessing' stamp: 'TudorGirba 11/28/2014 11:45'!
candidateLinks
	^ candidateLinks! !

!GTSpotterBlockIterator methodsFor: 'accessing' stamp: 'StefanReichhart 3/20/2015 15:49'!
onDo
	^ onDo ifNil: [ onDo := [ :anItemBlock :aContext | " do nothing " ] ]! !

!GTSpotterBlockIterator methodsFor: 'accessing' stamp: 'StefanReichhart 3/20/2015 11:06'!
onDo: anObject
	onDo := anObject! !

!GTSpotterBlockIterator methodsFor: 'private' stamp: 'StefanReichhart 3/20/2015 15:47'!
itemDo: aBlock 
	self onDo 
		cull: aBlock
		cull: self context ! !

!GTSpotterBreadcrumbSeparatorRenderer methodsFor: 'rendering' stamp: 'AliakseiSyrel 1/26/2015 00:26'!
render: aBrick on: aCanvas
	super renderBackgroundColorOf: aBrick on: aCanvas.
	
	self renderArrow: aBrick on: aCanvas! !

!GTSpotterBreadcrumbSeparatorRenderer methodsFor: 'rendering' stamp: 'AliakseiSyrel 2/16/2015 14:16'!
renderArrow: aBrick on: aCanvas
	|height width hW hH aX bX cX aY bY cY a b c overdraw delta|
	
	overdraw := 2.
	delta := 1.
	height := aBrick brickBounds height.
	width := aBrick brickBounds width.
	hH := height / 4.
	hW := width / 2.
	
	aX := (((hW - hH) max: 0) min: width) floor - overdraw - delta.
	bX := (((hW + hH) max: 0) min: width) floor - delta.
	cX := aX.
	
	aY := overdraw negated.
	bY := (hH * 2) floor.
	cY := height + overdraw.
	
	a := aBrick brickBounds topLeft + (aX@aY).
	b := aBrick brickBounds topLeft + (bX@bY).
	c := aBrick brickBounds topLeft + (cX@cY).
	
	aCanvas line: a to: b width: aBrick borderWidth first color: aBrick borderColor first.
	aCanvas line: b to: c width: aBrick borderWidth first color: aBrick borderColor first! !

!GTSpotterBrickDarkThemer methodsFor: 'brick-scrollbar' stamp: 'AliakseiSyrel 1/26/2015 15:01'!
scrollbarColor

	^ Color black alpha: 0.5! !

!GTSpotterBrickDarkThemer methodsFor: 'brick-rubric' stamp: 'AliakseiSyrel 3/21/2015 21:37'!
rubricBackgroundColor

	^ self spotterThemer backgroundColor! !

!GTSpotterBrickDarkThemer methodsFor: 'brick-scrollpane' stamp: 'AliakseiSyrel 3/21/2015 21:37'!
scrollpaneBackgroundColor

	^ self spotterThemer backgroundColor! !

!GTSpotterBrickThemer methodsFor: 'brick-rubric' stamp: 'AliakseiSyrel 3/21/2015 21:35'!
rubricBackgroundColor

	^ self spotterThemer backgroundColor! !

!GTSpotterBrickThemer methodsFor: 'brick-scrollbar' stamp: 'AliakseiSyrel 1/26/2015 15:01'!
scrollbarColor

	^ Color lightGray alpha: 0.2! !

!GTSpotterBrickThemer methodsFor: 'brick-scrollpane' stamp: 'AliakseiSyrel 3/21/2015 21:34'!
scrollpaneBackgroundColor

	^ self spotterThemer backgroundColor! !

!GTSpotterCandidateAdded methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/20/2015 13:13'!
candidateLink

	^ candidateLink! !

!GTSpotterCandidateAdded methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/19/2014 00:12'!
candidate
	^ candidateLink value! !

!GTSpotterCandidateAdded methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/19/2014 00:10'!
candidateLink: anObject
	candidateLink := anObject! !

!GTSpotterCandidateAdded methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/14/2014 21:35'!
category
	^ category! !

!GTSpotterCandidateAdded methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/14/2014 21:35'!
category: anObject
	category := anObject! !

!GTSpotterCandidateLink methodsFor: 'printing' stamp: 'TudorGirba 4/10/2015 13:17'!
gtDisplayOn: stream
	stream nextPutAll: 'Candidate link: '.
	self value gtDisplayOn: stream ! !

!GTSpotterCandidateLink methodsFor: 'comparing' stamp: 'AliakseiSyrel 11/24/2014 18:10'!
> anotherCandidateLink

	^ self weight > anotherCandidateLink weight! !

!GTSpotterCandidateLink methodsFor: 'comparing' stamp: 'AliakseiSyrel 11/24/2014 18:11'!
< anotherCandidateLink

	^ self weight < anotherCandidateLink weight! !

!GTSpotterCandidateLink methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/24/2014 18:11'!
weight: anObject 

	weight := anObject! !

!GTSpotterCandidateLink methodsFor: 'accessing' stamp: 'AliakseiSyrel 12/20/2014 18:36'!
renderingProcessor

	renderingProcessorLink ifNil: [ self renderingProcessor: processorLink ].
	^ renderingProcessorLink value! !

!GTSpotterCandidateLink methodsFor: 'copying' stamp: 'AliakseiSyrel 12/20/2014 19:04'!
copy
	|link|
	link := self class value: self value.
	link privateProcessorLink: processorLink.
	link privateRenderingProcessorLink: renderingProcessorLink.
	link weight: weight.
	^ link! !

!GTSpotterCandidateLink methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/24/2014 18:32'!
processorLink
	^ processorLink! !

!GTSpotterCandidateLink methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/24/2014 18:10'!
weight

	^ weight! !

!GTSpotterCandidateLink methodsFor: 'accessing' stamp: 'AliakseiSyrel 12/11/2014 00:10'!
processor

	^ self processorLink value! !

!GTSpotterCandidateLink methodsFor: 'private' stamp: 'AliakseiSyrel 12/20/2014 18:49'!
privateRenderingProcessorLink: aLink

	renderingProcessorLink := aLink! !

!GTSpotterCandidateLink methodsFor: 'testing' stamp: 'AliakseiSyrel 3/21/2015 14:39'!
isFirst

	^ (self previousLink processorLink = self processorLink) not! !

!GTSpotterCandidateLink methodsFor: 'accessing' stamp: 'AliakseiSyrel 12/20/2014 18:29'!
processorLink: anObject

	"we set rendering processor only if one is not set. it allows to have a collection of items,
	that have different rendering processors"
	
	processorLink ifNil: [ self renderingProcessor: anObject ].
	processorLink := anObject.
	! !

!GTSpotterCandidateLink methodsFor: 'private' stamp: 'AliakseiSyrel 12/20/2014 18:49'!
privateProcessorLink: aLink

	processorLink := aLink! !

!GTSpotterCandidateLink methodsFor: 'accessing' stamp: 'AliakseiSyrel 12/20/2014 18:40'!
renderingProcessor: aProcessorLink

	renderingProcessorLink ifNil: [ renderingProcessorLink := aProcessorLink processor asSpotterProcessorLink ].
	processorLink ifNil: [ processorLink := aProcessorLink ]! !

!GTSpotterCandidateLink methodsFor: 'converting' stamp: 'AliakseiSyrel 11/24/2014 18:48'!
asSpotterCandidateLink

	^ self! !

!GTSpotterCandidateSelected methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/19/2014 15:35'!
candidateBrick
	^ candidateBrick! !

!GTSpotterCandidateSelected methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/19/2014 15:35'!
candidateBrick: anObject
	candidateBrick := anObject! !

!GTSpotterCandidateSelectedMoved methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/25/2015 19:31'!
candidateBrick
	^ candidateBrick! !

!GTSpotterCandidateSelectedMoved methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/25/2015 19:31'!
candidateBrick: anObject
	candidateBrick := anObject! !

!GTSpotterCandidatesAmountChanged methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/19/2014 23:06'!
category: anObject
	category := anObject! !

!GTSpotterCandidatesAmountChanged methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/19/2014 23:06'!
category
	^ category! !

!GTSpotterCandidatesAmountChanged methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/19/2014 23:04'!
amount
	^ amount! !

!GTSpotterCandidatesAmountChanged methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/19/2014 23:04'!
amount: anObject
	amount := anObject! !

!GTSpotterCandidatesList commentStamp: 'TudorGirba 11/26/2014 15:08'!
A model utility class that provides a way to handle the list of candidates shown in the spotter result.

The candidates are stored in a linked list.!
!GTSpotterCandidatesList methodsFor: 'private' stamp: 'AliakseiSyrel 11/24/2014 23:31'!
privateAddCandidate: aCandidateLink inNotEmpty: aProcessorLink
	
	"aCandidateLink weight
		ifNotNil: [ ^ self privateAddCandidate: aCandidateLink weightedIn: aProcessorLink ]."
	
	self candidates add: aCandidateLink afterLink: (aProcessorLink tailLink).
	aProcessorLink incrementSize.
	"updating category tail"
	aProcessorLink tailLink: aCandidateLink.
	^ aCandidateLink! !

!GTSpotterCandidatesList methodsFor: 'adding/removing' stamp: 'AliakseiSyrel 11/29/2014 14:28'!
addProcessor: aProcessor
	|processorLink|
	
	processorLink := aProcessor asSpotterProcessorLink.
	"linking processor with it's link"
	self processorLinksMap add: (aProcessor -> processorLink).
	self processors addLast: processorLink.
	
	^ processorLink! !

!GTSpotterCandidatesList methodsFor: 'candidates' stamp: 'AliakseiSyrel 11/15/2014 13:08'!
tail

	^ self candidates tail! !

!GTSpotterCandidatesList methodsFor: 'candidates' stamp: 'AliakseiSyrel 11/24/2014 20:53'!
updateCycleConnectionFor: aCandidateLink

	"if link is the last setting nextLink to head"
	(self candidates tail = aCandidateLink) ifTrue: [
		aCandidateLink nextLink: self candidates head.
		self candidates head previousLink: aCandidateLink ].
	
	"if link is the first setting previousLink to tail"
	(self candidates head = aCandidateLink) ifTrue: [
		aCandidateLink previousLink: self candidates tail.
		self candidates tail nextLink: aCandidateLink ].! !

!GTSpotterCandidatesList methodsFor: 'processors' stamp: 'AliakseiSyrel 11/24/2014 20:38'!
getProcessorLinkByCandidateLink: aCandidateLink

	^ aCandidateLink processorLink! !

!GTSpotterCandidatesList methodsFor: 'private' stamp: 'AliakseiSyrel 11/24/2014 22:54'!
privateAddCandidate: aCandidateLink weightedInNotFull: aProcessorLink
	|head tail|
	
	head := aProcessorLink headLink.
	tail := aProcessorLink tailLink.

	"fast check if we need to add it before first"
	(aCandidateLink weight > head weight)
		ifTrue: [ head := self candidates add: aCandidateLink beforeLink: head ]
		ifFalse: [
	"fast check if we need to add it after the last"
	(aCandidateLink weight > tail weight)
		ifFalse: [ tail := self candidates add: aCandidateLink afterLink: tail ]
		ifTrue: [  ] ]! !

!GTSpotterCandidatesList methodsFor: 'notifying' stamp: 'TudorGirba 11/26/2014 14:34'!
notifyAmountChanged: anInteger in: aProcessor
	
	self announcer announce: (GTSpotterCandidatesAmountChanged new amount: anInteger; category: aProcessor; yourself)! !

!GTSpotterCandidatesList methodsFor: 'candidates' stamp: 'AliakseiSyrel 11/24/2014 20:36'!
getCandidateLinks: aProcessorLink
	"returns all candidate links that belongs to a processor link"
	|list head tail current|
	
	head := aProcessorLink headLink.
	tail := aProcessorLink tailLink.
	
	list := OrderedCollection new.
	head ifNil: [ ^ list ].
	(head = tail) ifTrue: [ list add: head. ^ list ].
	
	current := head.
	
	[ current = tail ] whileFalse: [
		list add: current.
		current := current nextLink ].
	"adding last one"
	list add: current.
	
	^ list
	! !

!GTSpotterCandidatesList methodsFor: 'accessing' stamp: 'TudorGirba 11/26/2014 14:34'!
processors

	^ categories ifNil: [ categories := GTSpotterDoubleLinkedList new ].! !

!GTSpotterCandidatesList methodsFor: 'private' stamp: 'AliakseiSyrel 11/24/2014 22:36'!
privateAddCandidate: aCandidateLink weightedIn: aProcessorLink

	^ aProcessorLink isFull
		ifTrue: [ self privateAddCandidate: aCandidateLink weightedInFull: aProcessorLink ]
		ifFalse: [ self privateAddCandidate: aCandidateLink weightedInNotFull: aProcessorLink ]! !

!GTSpotterCandidatesList methodsFor: 'private' stamp: 'AliakseiSyrel 11/24/2014 22:31'!
privateAddCandidate: aCandidateLink inEmpty: aProcessorLink
	| head current |
		
	current := aProcessorLink.	"not nil"
	head := nil.						"nil"
	[ head isNil and: [ current isNotNil ]] whileTrue: [	
		current := current nextLink.	"next category"
		"head of next category if not nil break loop"
		current ifNotNil: [ head := current headLink ] ifNil: [ nil ] ].
	
	"means all next categories are empty, just add to the end"
	current
		ifNil: [ self candidates addLast: aCandidateLink ]
		ifNotNil: [ self candidates add: aCandidateLink beforeLink: head ].
		aProcessorLink
			headLink: aCandidateLink;
			tailLink: aCandidateLink.
			
		aProcessorLink incrementSize.
		
	^ aCandidateLink! !

!GTSpotterCandidatesList methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/14/2014 21:33'!
announcer
	^ announcer ifNil: [ announcer := Announcer new ]! !

!GTSpotterCandidatesList methodsFor: 'accessing' stamp: 'TudorGirba 11/26/2014 14:34'!
candidates

	^ candidates ifNil: [ candidates := GTSpotterDoubleLinkedList new ]! !

!GTSpotterCandidatesList methodsFor: 'adding/removing' stamp: 'AliakseiSyrel 11/24/2014 22:24'!
addCandidate: anObjectOrLink in: aProcessor
	"before adding candidates we need to define all categories, because their order is important"
	|processorLink candidateLink|
	
	"processorLink is DoubleLink"
	processorLink := self getProcessorLink: aProcessor.
	
	candidateLink := anObjectOrLink asSpotterCandidateLink processorLink: processorLink.
	
	"if head is nil, it means there are no candidates yet"
	candidateLink := (processorLink isEmpty)
		ifTrue: [ self privateAddCandidate: candidateLink inEmpty: processorLink ]
		ifFalse: [ self privateAddCandidate: candidateLink inNotEmpty: processorLink ].
		
	self updateCycleConnectionFor: candidateLink.
	
	self notifyCandidateAdded: candidateLink in: aProcessor.
	
	^ candidateLink
	! !

!GTSpotterCandidatesList methodsFor: 'candidates' stamp: 'AliakseiSyrel 11/14/2014 15:54'!
head

	^ self candidates head! !

!GTSpotterCandidatesList methodsFor: 'testing' stamp: 'AliakseiSyrel 11/14/2014 15:49'!
isEmpty

	^ self candidates isEmpty! !

!GTSpotterCandidatesList methodsFor: 'notifying' stamp: 'TudorGirba 11/26/2014 14:34'!
notifyCandidateAdded: aCandidateLink in: aProcessor

	self announcer announce: (GTSpotterCandidateAdded new candidateLink: aCandidateLink; category: aProcessor; yourself).! !

!GTSpotterCandidatesList methodsFor: 'adding/removing' stamp: 'AliakseiSyrel 11/29/2014 14:41'!
removeAllCandidatesOf: aProcessor
	|processorLink head tail current|
	
	processorLink := self getProcessorLink: aProcessor.
	
	(processorLink isEmpty) ifTrue: [ ^ self ].
	
	head := processorLink headLink.
	tail := processorLink tailLink.
		
	(head = tail) ifTrue: [
		self candidates removeCycledLink: head.
		processorLink clear. ].
	
	current := head.
	[ current = tail ] whileFalse: [ |nextCurrent|
		nextCurrent := current nextLink.
		self candidates removeCycledLink: current.
		current := nextCurrent ].
	
	self candidates removeCycledLink: current.
	
	processorLink clear.
	
	
	
	
	
	! !

!GTSpotterCandidatesList methodsFor: 'candidates' stamp: 'AliakseiSyrel 11/24/2014 20:35'!
getCandidateLink: aCandiate in: aProcessor
	"returns a corresponding candidateLink, that belongs to a processor"
	(self getCandidateLinks: (self getProcessorLink: aProcessor))
		do: [ :each | each value = aCandiate ifTrue: [ ^ each ] ].
	
	^ nil
	! !

!GTSpotterCandidatesList methodsFor: 'processors' stamp: 'AliakseiSyrel 11/24/2014 20:28'!
getProcessorLink: aProcessor

	^ self processorLinksMap at: aProcessor ifAbsent: [ nil ]! !

!GTSpotterCandidatesList methodsFor: 'private' stamp: 'AliakseiSyrel 11/24/2014 22:34'!
privateAddCandidate: aCandidateLink weightedInFull: aProcessorLink

	! !

!GTSpotterCandidatesList methodsFor: 'accessing' stamp: 'AliakseiSyrel 12/9/2014 13:51'!
processorLinksMap

	^ processorLinksMap ifNil: [ processorLinksMap := Dictionary new ]
	! !

!GTSpotterCandidatesList methodsFor: 'stream handling' stamp: 'TudorGirba 11/26/2014 14:34'!
onAmountChanged: anInteger in: aProcessor
	
	self announcer announce: (GTSpotterCandidatesAmountChanged new amount: anInteger; category: aProcessor; yourself)! !

!GTSpotterCandidatesList methodsFor: 'notifying' stamp: 'AliakseiSyrel 11/29/2014 14:40'!
notifyAllCandidatesRemoved

	self announcer announce: (GTSpotterAllCandidatesRemoved new)! !

!GTSpotterCandidatesList methodsFor: 'adding/removing' stamp: 'TudorGirba 11/28/2014 11:47'!
addAllCandidates: aCollection in: aProcessor
	| allLinks |
	allLinks := OrderedCollection new.
	aCollection
		do: [ :each | 
			| processorLink candidateLink |
			processorLink := self getProcessorLink: aProcessor.
			candidateLink := each asSpotterCandidateLink processorLink: processorLink.	"if head is nil, it means there are no candidates yet"
			candidateLink := processorLink isEmpty
				ifTrue: [ self privateAddCandidate: candidateLink inEmpty: processorLink ]
				ifFalse: [ self privateAddCandidate: candidateLink inNotEmpty: processorLink ].
			self updateCycleConnectionFor: candidateLink.
			allLinks add: candidateLink ].
	self announcer announce:
			(GTSpotterAllCandidatesAdded new
				candidateLinks: allLinks;
				category: aProcessor;
				yourself)! !

!GTSpotterCandidatesList methodsFor: 'processors' stamp: 'AliakseiSyrel 11/24/2014 20:52'!
previousProcessorLinkOf: aProcessorLink
	"returns previous processor link, that has more than zero candidates.
	if passed processor is the first one, will continue searching from the end"
	|current|
	aProcessorLink ifNil: [ ^ aProcessorLink ].
	
	current := aProcessorLink previousLink.
	current ifNil: [ current := self processors tail ].
	
	[ current = aProcessorLink ] whileFalse: [
		(current isEmpty) ifFalse: [ ^ current ].
		current := current previousLink.
		current ifNil: [ current := self processors tail ].
	].

	^ aProcessorLink
	! !

!GTSpotterCandidatesList methodsFor: 'processors' stamp: 'AliakseiSyrel 11/24/2014 20:52'!
nextProcessorLinkOf: aProcessorLink
	"returns next processor link, that has more than zero candidates.
	if passed processor is the last one, will continue searching from the beginning"
	|current|
	aProcessorLink ifNil: [ ^ aProcessorLink ].
	
	current := aProcessorLink nextLink.
	current ifNil: [ current := self processors head ].
	
	[ current = aProcessorLink ] whileFalse: [
		(current isEmpty) ifFalse: [ ^ current ].
		current := current nextLink.
		current ifNil: [ current := self processors head ].
	].

	^ aProcessorLink
	! !

!GTSpotterCandidatesList methodsFor: 'testing' stamp: 'AliakseiSyrel 2/25/2015 14:28'!
hasOnlyOneItem

	self isEmpty ifTrue: [ ^ self ].
	^ self head = self tail! !

!GTSpotterCandidatesList methodsFor: 'adding/removing' stamp: 'AliakseiSyrel 1/29/2015 01:39'!
removeAllCandidates

	self processors linksDo: [ :each | each clear ].
	self candidates removeAll.
	self notifyAllCandidatesRemoved! !

!GTSpotterCandidatesListProcessor commentStamp: 'TudorGirba 11/30/2014 22:12'!
This is a candidates processor that can be parameterized via blocks.!
!GTSpotterCandidatesListProcessor methodsFor: 'scripting' stamp: 'TudorGirba 11/25/2014 22:40'!
wantsToDisplayOnEmptyQuery: anObject
	wantsToDisplayOnEmptyQuery := anObject! !

!GTSpotterCandidatesListProcessor methodsFor: 'scripting' stamp: 'TudorGirba 11/17/2014 23:26'!
itemName: aBlockWithOneArgument
	itemNameBlock := aBlockWithOneArgument! !

!GTSpotterCandidatesListProcessor methodsFor: 'private' stamp: 'StefanReichhart 2/24/2015 17:04'!
doFilterInContext: aSpotterContext
	^ filterBlock gtFilter value: aSpotterContext! !

!GTSpotterCandidatesListProcessor methodsFor: 'scripting-convenience' stamp: 'StefanReichhart 2/24/2015 22:51'!
matchRegex
	self filter: GTFilterRegex! !

!GTSpotterCandidatesListProcessor methodsFor: 'compatibility' stamp: 'StefanReichhart 3/22/2015 22:03'!
candidatesLimit: anInteger
	self itemsLimit: anInteger! !

!GTSpotterCandidatesListProcessor methodsFor: 'private' stamp: 'AliakseiSyrel 11/21/2014 13:57'!
actOn: anObject for: aStep
	
	actBlock
		ifNil: [ super actOn: anObject for: aStep ]
		ifNotNil: [ actBlock cull: anObject cull: aStep ]! !

!GTSpotterCandidatesListProcessor methodsFor: 'accessing' stamp: 'StefanReichhart 3/8/2015 13:11'!
itemName
	^ itemNameBlock! !

!GTSpotterCandidatesListProcessor methodsFor: 'scripting-convenience' stamp: 'StefanReichhart 2/24/2015 22:48'!
matchSubstrings
	self filter: GTFilterSubstrings! !

!GTSpotterCandidatesListProcessor methodsFor: 'scripting' stamp: 'AliakseiSyrel 11/21/2014 13:56'!
actLogic: aBlockWithTwoArguments

	actBlock := aBlockWithTwoArguments! !

!GTSpotterCandidatesListProcessor methodsFor: 'scripting-convenience' stamp: 'StefanReichhart 2/24/2015 22:51'!
matchString
	self filter: GTFilterStringMatch! !

!GTSpotterCandidatesListProcessor methodsFor: 'scripting-convenience' stamp: 'StefanReichhart 2/24/2015 22:52'!
match: aBlockWithTwoArguments
	self filter: (GTFilterBlock new 
		matcher: aBlockWithTwoArguments;
		yourself)! !

!GTSpotterCandidatesListProcessor methodsFor: 'accessing' stamp: 'StefanReichhart 3/8/2015 13:11'!
filter
	^ filterBlock! !

!GTSpotterCandidatesListProcessor methodsFor: 'private' stamp: 'StefanReichhart 3/22/2015 22:04'!
computeAllItemsIn: aContext
	^ allCandidatesBlock cull: aContext! !

!GTSpotterCandidatesListProcessor methodsFor: 'private' stamp: 'AliakseiSyrel 11/21/2014 13:33'!
itemIconFor: anObject
	^ itemIconBlock isNil
		ifTrue: [ super itemIconFor: anObject ]
		ifFalse: [ itemIconBlock cull: anObject ]! !

!GTSpotterCandidatesListProcessor methodsFor: 'accessing' stamp: 'TudorGirba 11/26/2014 14:23'!
title
	^ title ifNil: [ super title ]! !

!GTSpotterCandidatesListProcessor methodsFor: 'scripting' stamp: 'TudorGirba 11/26/2014 14:23'!
title: aString
	title := aString! !

!GTSpotterCandidatesListProcessor methodsFor: 'scripting' stamp: 'StefanReichhart 3/20/2015 12:46'!
itemFilterName: aBlockWithOneArgument
	itemFilterNameBlock := aBlockWithOneArgument! !

!GTSpotterCandidatesListProcessor methodsFor: 'testing' stamp: 'StefanReichhart 3/22/2015 17:15'!
hasDynamicItems
	^ allCandidatesBlock hasDynamicItems! !

!GTSpotterCandidatesListProcessor methodsFor: 'accessing' stamp: 'StefanReichhart 3/30/2015 08:37'!
actLogic
	^ actBlock! !

!GTSpotterCandidatesListProcessor methodsFor: 'scripting' stamp: 'StefanReichhart 3/22/2015 22:03'!
itemsLimit: anInteger
	candidatesLimit := anInteger! !

!GTSpotterCandidatesListProcessor methodsFor: 'scripting' stamp: 'TudorGirba 11/21/2014 11:14'!
itemIcon: aBlockWithOneArgument
	itemIconBlock := aBlockWithOneArgument! !

!GTSpotterCandidatesListProcessor methodsFor: 'accessing' stamp: 'StefanReichhart 3/23/2015 11:18'!
itemIcon
	^ itemIconBlock! !

!GTSpotterCandidatesListProcessor methodsFor: 'scripting' stamp: 'StefanReichhart 3/20/2015 18:24'!
filter: aGTFilter item: aGTSpotterIterator 
	self filter: aGTFilter.
	self items: aGTSpotterIterator gtIterator.
	! !

!GTSpotterCandidatesListProcessor methodsFor: 'accessing' stamp: 'TudorGirba 11/25/2014 22:42'!
wantsToDisplayOnEmptyQuery
	^ wantsToDisplayOnEmptyQuery ifNil: [ super wantsToDisplayOnEmptyQuery ]! !

!GTSpotterCandidatesListProcessor methodsFor: 'scripting-convenience' stamp: 'StefanReichhart 2/24/2015 22:49'!
matchAlike
	self filter: GTFilterAlike! !

!GTSpotterCandidatesListProcessor methodsFor: 'compatibility' stamp: 'StefanReichhart 3/22/2015 21:54'!
allCandidates: aBlockWithOneArgument
	self items: aBlockWithOneArgument! !

!GTSpotterCandidatesListProcessor methodsFor: 'scripting-convenience' stamp: 'StefanReichhart 2/24/2015 22:45'!
matchSubstring
	self filter: GTFilterSubstring! !

!GTSpotterCandidatesListProcessor methodsFor: 'compatibility' stamp: 'StefanReichhart 3/22/2015 22:06'!
defaultCandidatesLimit
	^ self defaultItemsLimit! !

!GTSpotterCandidatesListProcessor methodsFor: 'accessing' stamp: 'StefanReichhart 3/22/2015 21:59'!
itemsLimit
	^ candidatesLimit ifNil: [ self defaultItemsLimit ]! !

!GTSpotterCandidatesListProcessor methodsFor: 'compatibility' stamp: 'StefanReichhart 2/24/2015 22:44'!
filterUsing: aFilter
	self filter: aFilter! !

!GTSpotterCandidatesListProcessor methodsFor: 'accessing-defaults' stamp: 'StefanReichhart 3/22/2015 22:00'!
defaultItemsLimit
	^ 5! !

!GTSpotterCandidatesListProcessor methodsFor: 'private' stamp: 'AliakseiSyrel 11/21/2014 13:34'!
itemNameFor: anObject
	^ itemNameBlock isNil
		ifTrue: [ super itemNameFor: anObject ]
		ifFalse: [ itemNameBlock cull: anObject ]! !

!GTSpotterCandidatesListProcessor methodsFor: 'scripting' stamp: 'StefanReichhart 3/20/2015 11:44'!
items: aBlock
	allCandidatesBlock := aBlock! !

!GTSpotterCandidatesListProcessor methodsFor: 'accessing' stamp: 'StefanReichhart 3/20/2015 12:19'!
itemFilterName
	^ itemFilterNameBlock! !

!GTSpotterCandidatesListProcessor methodsFor: 'scripting' stamp: 'StefanReichhart 3/22/2015 21:56'!
filter: aGTFilterOrBlockWithOneArgument
	filterBlock := aGTFilterOrBlockWithOneArgument ! !

!GTSpotterCandidatesListProcessor methodsFor: 'private' stamp: 'StefanReichhart 3/20/2015 12:18'!
itemFilterNameFor: anObject
	^ itemFilterNameBlock isNil
		ifTrue: [ super itemFilterNameFor: anObject ]
		ifFalse: [ itemFilterNameBlock cull: anObject ]! !

!GTSpotterCandidatesListTest methodsFor: 'as yet unclassified' stamp: 'TudorGirba 12/7/2014 13:07'!
testAddThreeCandidateA1A2A3
	|link11 link12 link13 link21 link22 link23 link31 link32 link33 category1 category2 category3|
	
	category1 := candidates addProcessor: GTSpotterA1.
	category2 := candidates addProcessor: GTSpotterA2.
	category3 := candidates addProcessor: GTSpotterA3.
	
	link11 := candidates addCandidate: 11 in: GTSpotterA1.
	link12 := candidates addCandidate: 12 in: GTSpotterA1.
	link13 := candidates addCandidate: 13 in: GTSpotterA1.
	link21 := candidates addCandidate: 21 in: GTSpotterA2.
	link22 := candidates addCandidate: 22 in: GTSpotterA2.
	link23 := candidates addCandidate: 23 in: GTSpotterA2.
	link31 := candidates addCandidate: 31 in: GTSpotterA3.
	link32 := candidates addCandidate: 32 in: GTSpotterA3.
	link33 := candidates addCandidate: 33 in: GTSpotterA3.
	
	self assert: (link11 nextLink = link12).
	self assert: (link11 previousLink = link33).
	
	self assert: (link12 nextLink = link13).
	self assert: (link12 previousLink = link11).
	
	self assert: (link13 nextLink = link21).
	self assert: (link13 previousLink = link12).
	
	self assert: (link21 nextLink = link22).
	self assert: (link21 previousLink = link13).
	
	self assert: (link22 nextLink = link23).
	self assert: (link22 previousLink = link21).
	
	self assert: (link23 nextLink = link31).
	self assert: (link23 previousLink = link22).
	
	self assert: (link31 nextLink = link32).
	self assert: (link31 previousLink = link23).
	
	self assert: (link32 nextLink = link33).
	self assert: (link32 previousLink = link31).
	
	self assert: (link33 nextLink = link11).
	self assert: (link33 previousLink = link32).
		
	self assert: (candidates head = link11).
	self assert: (candidates tail = link33).
	
	self assert: ((category1 headLink) = link11).
	self assert: ((category1 tailLink) = link13).
	
	self assert: ((category2 headLink) = link21).
	self assert: ((category2 tailLink) = link23).
	
	self assert: ((category3 headLink) = link31).
	self assert: ((category3 tailLink) = link33).! !

!GTSpotterCandidatesListTest methodsFor: 'as yet unclassified' stamp: 'TudorGirba 12/7/2014 13:10'!
testNextA1Category

	|link11 link12 link13 category1 |
	
	category1 := candidates addProcessor: GTSpotterA1.
	
	link11 := candidates addCandidate: 11 in: GTSpotterA1.
	link12 := candidates addCandidate: 12 in: GTSpotterA1.
	link13 := candidates addCandidate: 13 in: GTSpotterA1.
	
	self assert: (category1 = (candidates nextProcessorLinkOf: category1)).
	
	! !

!GTSpotterCandidatesListTest methodsFor: 'as yet unclassified' stamp: 'TudorGirba 12/7/2014 13:08'!
testAddTwoCandidateA1A2
	|link11 link12 link21 link22 category1 category2|
	
	category1 := candidates addProcessor: GTSpotterA1.
	category2 := candidates addProcessor: GTSpotterA2.
	
	link11 := candidates addCandidate: 11 in: GTSpotterA1.
	link12 := candidates addCandidate: 12 in: GTSpotterA1.
	link21 := candidates addCandidate: 21 in: GTSpotterA2.
	link22 := candidates addCandidate: 22 in: GTSpotterA2.
	
	self assert: (link11 nextLink = link12).
	self assert: (link11 previousLink = link22).
	
	self assert: (link12 nextLink = link21).
	self assert: (link12 previousLink = link11).
	
	self assert: (link21 nextLink = link22).
	self assert: (link21 previousLink = link12).
	
	self assert: (link22 nextLink = link11).
	self assert: (link22 previousLink = link21).
	
	self assert: (candidates head = link11).
	self assert: (candidates tail = link22).
	
	self assert: ((category1 headLink) = link11).
	self assert: ((category1 tailLink) = link12).
	
	self assert: ((category2 headLink) = link21).
	self assert: ((category2 tailLink) = link22).
	
	! !

!GTSpotterCandidatesListTest methodsFor: 'as yet unclassified' stamp: 'TudorGirba 12/7/2014 13:06'!
testAddOneCandidateA1A2
	|link11 link21 category1 category2|
	
	category1 := candidates addProcessor: GTSpotterA1.
	category2 := candidates addProcessor: GTSpotterA2.
	link11 := candidates addCandidate: 11 in: GTSpotterA1.
	link21 := candidates addCandidate: 21 in: GTSpotterA2.
	
	self assert: (link11 nextLink = link21).
	self assert: (link11 previousLink = link21).
	
	self assert: (link21 nextLink = link11).
	self assert: (link21 previousLink = link11).
	
	self assert: (candidates head = link11).
	self assert: (candidates tail = link21).
	
	self assert: ((category1 headLink) = link11).
	self assert: ((category1 tailLink) = link11).
	
	self assert: ((category2 headLink) = link21).
	self assert: ((category2 tailLink) = link21).
	
	! !

!GTSpotterCandidatesListTest methodsFor: 'as yet unclassified' stamp: 'TudorGirba 12/7/2014 13:07'!
testAddThreeCandidateA1
	|link1 link2 link3 category|
	
	category := candidates addProcessor: GTSpotterA1.
	link1 := candidates addCandidate: 11 in: GTSpotterA1.
	link2 := candidates addCandidate: 12 in: GTSpotterA1.
	link3 := candidates addCandidate: 13 in: GTSpotterA1.
	
	self assert: (link1 nextLink = link2).
	self assert: (link1 previousLink = link3).
	
	self assert: (link2 nextLink = link3).
	self assert: (link2 previousLink = link1).
	
	self assert: (link3 nextLink = link1).
	self assert: (link3 previousLink = link2).
	
	self assert: (candidates head = link1).
	self assert: (candidates tail = link3).
	self assert: ((category headLink) = link1).
	self assert: ((category tailLink) = link3).
	
	! !

!GTSpotterCandidatesListTest methodsFor: 'as yet unclassified' stamp: 'TudorGirba 12/7/2014 13:07'!
testAddThreeCandidateA1A2
	|link11 link12 link13 link21 link22 link23 category1 category2|
	
	category1 := candidates addProcessor: GTSpotterA1.
	category2 := candidates addProcessor: GTSpotterA2.
	
	link11 := candidates addCandidate: 11 in: GTSpotterA1.
	link12 := candidates addCandidate: 12 in: GTSpotterA1.
	link13 := candidates addCandidate: 13 in: GTSpotterA1.
	link21 := candidates addCandidate: 21 in: GTSpotterA2.
	link22 := candidates addCandidate: 22 in: GTSpotterA2.
	link23 := candidates addCandidate: 23 in: GTSpotterA2.
	
	self assert: (link11 nextLink = link12).
	self assert: (link11 previousLink = link23).
	
	self assert: (link12 nextLink = link13).
	self assert: (link12 previousLink = link11).
	
	self assert: (link13 nextLink = link21).
	self assert: (link13 previousLink = link12).
	
	self assert: (link21 nextLink = link22).
	self assert: (link21 previousLink = link13).
	
	self assert: (link22 nextLink = link23).
	self assert: (link22 previousLink = link21).
	
	self assert: (link23 nextLink = link11).
	self assert: (link23 previousLink = link22).
	
	self assert: (candidates head = link11).
	self assert: (candidates tail = link23).
	
	self assert: ((category1 headLink) = link11).
	self assert: ((category1 tailLink) = link13).
	
	self assert: ((category2 headLink) = link21).
	self assert: ((category2 tailLink) = link23).! !

!GTSpotterCandidatesListTest methodsFor: 'as yet unclassified' stamp: 'TudorGirba 12/7/2014 13:10'!
testNextA1A2EmptyCategory

	|link11 link12 link13 category1 category2|
	
	category1 := candidates addProcessor: GTSpotterA1.
	category2 := candidates addProcessor: GTSpotterA2.
	
	link11 := candidates addCandidate: 11 in: GTSpotterA1.
	link12 := candidates addCandidate: 12 in: GTSpotterA1.
	link13 := candidates addCandidate: 13 in: GTSpotterA1.
	
	self assert: (category1 = (candidates nextProcessorLinkOf: category1)).
	self assert: (category1 = (candidates nextProcessorLinkOf: category2)).
	
	! !

!GTSpotterCandidatesListTest methodsFor: 'as yet unclassified' stamp: 'TudorGirba 12/7/2014 13:06'!
testAddCategories
	|categories|
	categories := { GTSpotterA1 . GTSpotterA2 . GTSpotterA3 }.
	
	self addCategories: categories.
	self assert: (self hasCategories: categories)! !

!GTSpotterCandidatesListTest methodsFor: 'as yet unclassified' stamp: 'TudorGirba 12/7/2014 13:11'!
testPreviousA1Category

	|link11 link12 link13 category1 |
	
	category1 := candidates addProcessor: GTSpotterA1.
	
	link11 := candidates addCandidate: 11 in: GTSpotterA1.
	link12 := candidates addCandidate: 12 in: GTSpotterA1.
	link13 := candidates addCandidate: 13 in: GTSpotterA1.
	
	self assert: (category1 = (candidates previousProcessorLinkOf: category1)).
	
	! !

!GTSpotterCandidatesListTest methodsFor: 'as yet unclassified' stamp: 'TudorGirba 12/7/2014 13:10'!
testPreviousA1A2Category

	|link11 link12 link13 link21 link22 link23 category1 category2|
	
	category1 := candidates addProcessor: GTSpotterA1.
	category2 := candidates addProcessor: GTSpotterA2.
	
	link11 := candidates addCandidate: 11 in: GTSpotterA1.
	link12 := candidates addCandidate: 12 in: GTSpotterA1.
	link13 := candidates addCandidate: 13 in: GTSpotterA1.
	link21 := candidates addCandidate: 21 in: GTSpotterA2.
	link22 := candidates addCandidate: 22 in: GTSpotterA2.
	link23 := candidates addCandidate: 23 in: GTSpotterA2.
	
	self assert: (category1 = (candidates previousProcessorLinkOf: category2)).
	self assert: (category2 = (candidates previousProcessorLinkOf: category1)).
	
	! !

!GTSpotterCandidatesListTest methodsFor: 'as yet unclassified' stamp: 'TudorGirba 12/7/2014 13:06'!
testAddOneCandidateA1
	|link category|
	
	category := candidates addProcessor: GTSpotterA1.
	link := candidates addCandidate: 11 in: GTSpotterA1.
	
	self assert: (link nextLink = link).
	self assert: (link previousLink = link).
	self assert: (candidates head = link).
	self assert: (candidates tail = link).
	self assert: ((category headLink) = link).
	self assert: ((category tailLink) = link).
	
	! !

!GTSpotterCandidatesListTest methodsFor: 'running' stamp: 'TudorGirba 11/26/2014 14:34'!
setUp

	candidates := GTSpotterCandidatesList new.! !

!GTSpotterCandidatesListTest methodsFor: 'as yet unclassified' stamp: 'TudorGirba 12/7/2014 13:11'!
testRemoveCandidatesA1A2A3FromA1A2A3
	|category1 category2 category3|
	
	category1 := candidates addProcessor: GTSpotterA1.
	category2 := candidates addProcessor: GTSpotterA2.
	category3 := candidates addProcessor: GTSpotterA3.
	
	candidates addCandidate: 11 in: GTSpotterA1.
	candidates addCandidate: 12 in: GTSpotterA1.
	candidates addCandidate: 13 in: GTSpotterA1.
	candidates addCandidate: 21 in: GTSpotterA2.
	candidates addCandidate: 22 in: GTSpotterA2.
	candidates addCandidate: 23 in: GTSpotterA2.
	candidates addCandidate: 31 in: GTSpotterA3.
	candidates addCandidate: 32 in: GTSpotterA3.
	candidates addCandidate: 33 in: GTSpotterA3.
	
	candidates removeAllCandidatesOf: GTSpotterA1.
	candidates removeAllCandidatesOf: GTSpotterA3.
	candidates removeAllCandidatesOf: GTSpotterA2.
			
	self assert: (candidates head = nil).
	self assert: (candidates tail = nil).
	
	self assert: ((category1 headLink) = nil).
	self assert: ((category1 tailLink) = nil).
	
	self assert: ((category2 headLink) = nil).
	self assert: ((category2 tailLink) = nil).
	
	self assert: ((category3 headLink) = nil).
	self assert: ((category3 tailLink) = nil).! !

!GTSpotterCandidatesListTest methodsFor: 'as yet unclassified' stamp: 'TudorGirba 12/7/2014 13:09'!
testAddTwoCandidateA1A2A3
	|link11 link12 link21 link22 link31 link32 category1 category2 category3|
	
	category1 := candidates addProcessor: GTSpotterA1.
	category2 := candidates addProcessor: GTSpotterA2.
	category3 := candidates addProcessor: GTSpotterA3.
	
	link11 := candidates addCandidate: 11 in: GTSpotterA1.
	link12 := candidates addCandidate: 12 in: GTSpotterA1.
	link21 := candidates addCandidate: 21 in: GTSpotterA2.
	link22 := candidates addCandidate: 22 in: GTSpotterA2.
	link31 := candidates addCandidate: 31 in: GTSpotterA3.
	link32 := candidates addCandidate: 32 in: GTSpotterA3.
	
	self assert: (link11 nextLink = link12).
	self assert: (link11 previousLink = link32).
	
	self assert: (link12 nextLink = link21).
	self assert: (link12 previousLink = link11).
	
	self assert: (link21 nextLink = link22).
	self assert: (link21 previousLink = link12).
	
	self assert: (link22 nextLink = link31).
	self assert: (link22 previousLink = link21).
	
	self assert: (link31 nextLink = link32).
	self assert: (link31 previousLink = link22).
	
	self assert: (link32 nextLink = link11).
	self assert: (link32 previousLink = link31).
		
	self assert: (candidates head = link11).
	self assert: (candidates tail = link32).
	
	self assert: ((category1 headLink) = link11).
	self assert: ((category1 tailLink) = link12).
	
	self assert: ((category2 headLink) = link21).
	self assert: ((category2 tailLink) = link22).
	
	self assert: ((category3 headLink) = link31).
	self assert: ((category3 tailLink) = link32).! !

!GTSpotterCandidatesListTest methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 11/24/2014 20:42'!
addCategories: aCollection

	aCollection do: [ :each | candidates addProcessor: each ]! !

!GTSpotterCandidatesListTest methodsFor: 'as yet unclassified' stamp: 'TudorGirba 12/7/2014 13:07'!
testAddOneCandidateA1A2A3
	|link11 link21 link31 category1 category2 category3|
	
	category1 := candidates addProcessor: GTSpotterA1.
	category2 := candidates addProcessor: GTSpotterA2.
	category3 := candidates addProcessor: GTSpotterA3.
	
	link11 := candidates addCandidate: 11 in: GTSpotterA1.
	link21 := candidates addCandidate: 21 in: GTSpotterA2.
	link31 := candidates addCandidate: 31 in: GTSpotterA3.
	
	self assert: (link11 nextLink = link21).
	self assert: (link11 previousLink = link31).
	
	self assert: (link21 nextLink = link31).
	self assert: (link21 previousLink = link11).
	
	self assert: (link31 nextLink = link11).
	self assert: (link31 previousLink = link21).
		
	self assert: (candidates head = link11).
	self assert: (candidates tail = link31).
	
	self assert: ((category1 headLink) = link11).
	self assert: ((category1 tailLink) = link11).
	
	self assert: ((category2 headLink) = link21).
	self assert: ((category2 tailLink) = link21).
	
	self assert: ((category3 headLink) = link31).
	self assert: ((category3 tailLink) = link31).! !

!GTSpotterCandidatesListTest methodsFor: 'as yet unclassified' stamp: 'TudorGirba 12/7/2014 13:09'!
testCategoryLinkByCandidateLinkThreeA1A2A3
	|link11 link12 link13 link21 link22 link23 link31 link32 link33 category1 category2 category3|
	
	category1 := candidates addProcessor: GTSpotterA1.
	category2 := candidates addProcessor: GTSpotterA2.
	category3 := candidates addProcessor: GTSpotterA3.
	
	link11 := candidates addCandidate: 11 in: GTSpotterA1.
	link12 := candidates addCandidate: 12 in: GTSpotterA1.
	link13 := candidates addCandidate: 13 in: GTSpotterA1.
	link21 := candidates addCandidate: 21 in: GTSpotterA2.
	link22 := candidates addCandidate: 22 in: GTSpotterA2.
	link23 := candidates addCandidate: 23 in: GTSpotterA2.
	link31 := candidates addCandidate: 31 in: GTSpotterA3.
	link32 := candidates addCandidate: 32 in: GTSpotterA3.
	link33 := candidates addCandidate: 33 in: GTSpotterA3.
	
	self assert: (category1 = (candidates getProcessorLinkByCandidateLink: link11)).
	self assert: (category1 = (candidates getProcessorLinkByCandidateLink: link12)).
	self assert: (category1 = (candidates getProcessorLinkByCandidateLink: link13)).
	
	self assert: (category2 = (candidates getProcessorLinkByCandidateLink: link21)).
	self assert: (category2 = (candidates getProcessorLinkByCandidateLink: link22)).
	self assert: (category2 = (candidates getProcessorLinkByCandidateLink: link23)).
	
	self assert: (category3 = (candidates getProcessorLinkByCandidateLink: link31)).
	self assert: (category3 = (candidates getProcessorLinkByCandidateLink: link32)).
	self assert: (category3 = (candidates getProcessorLinkByCandidateLink: link33)).! !

!GTSpotterCandidatesListTest methodsFor: 'as yet unclassified' stamp: 'TudorGirba 12/7/2014 13:10'!
testNextA1A2Category

	|link11 link12 link13 link21 link22 link23 category1 category2|
	
	category1 := candidates addProcessor: GTSpotterA1.
	category2 := candidates addProcessor: GTSpotterA2.
	
	link11 := candidates addCandidate: 11 in: GTSpotterA1.
	link12 := candidates addCandidate: 12 in: GTSpotterA1.
	link13 := candidates addCandidate: 13 in: GTSpotterA1.
	link21 := candidates addCandidate: 21 in: GTSpotterA2.
	link22 := candidates addCandidate: 22 in: GTSpotterA2.
	link23 := candidates addCandidate: 23 in: GTSpotterA2.
	
	self assert: (category1 = (candidates nextProcessorLinkOf: category2)).
	self assert: (category2 = (candidates nextProcessorLinkOf: category1)).
	
	! !

!GTSpotterCandidatesListTest methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 11/24/2014 20:52'!
hasCategories: aCollection
	|counter|
	candidates processors asArray size = aCollection size ifFalse: [ ^ false ].
	counter := 1.
	candidates processors asArray
		do: [ :each | (each = (aCollection at: counter)) ifFalse: [ ^ false ] . counter := counter + 1].
	^ true! !

!GTSpotterCandidatesListTest methodsFor: 'as yet unclassified' stamp: 'TudorGirba 12/7/2014 13:08'!
testAddTwoCandidateA1
	|link1 link2 category|
	
	category := candidates addProcessor: GTSpotterA1.
	link1 := candidates addCandidate: 11 in: GTSpotterA1.
	link2 := candidates addCandidate: 12 in: GTSpotterA1.
	
	self assert: (link1 nextLink = link2).
	self assert: (link1 previousLink = link2).
	
	self assert: (link2 nextLink = link1).
	self assert: (link2 previousLink = link1).
	
	self assert: (candidates head = link1).
	self assert: (candidates tail = link2).
	self assert: ((category headLink) = link1).
	self assert: ((category tailLink) = link2).
	
	! !

!GTSpotterCandidatesListTest methodsFor: 'as yet unclassified' stamp: 'TudorGirba 12/7/2014 13:12'!
testRemoveCandidatesA1FromA1A2A3
	|link21 link22 link23 link31 link32 link33 category1 category2 category3|
	
	category1 := candidates addProcessor: GTSpotterA1.
	category2 := candidates addProcessor: GTSpotterA2.
	category3 := candidates addProcessor: GTSpotterA3.
	
	candidates addCandidate: 11 in: GTSpotterA1.
	candidates addCandidate: 12 in: GTSpotterA1.
	candidates addCandidate: 13 in: GTSpotterA1.
	link21 := candidates addCandidate: 21 in: GTSpotterA2.
	link22 := candidates addCandidate: 22 in: GTSpotterA2.
	link23 := candidates addCandidate: 23 in: GTSpotterA2.
	link31 := candidates addCandidate: 31 in: GTSpotterA3.
	link32 := candidates addCandidate: 32 in: GTSpotterA3.
	link33 := candidates addCandidate: 33 in: GTSpotterA3.
	
	candidates removeAllCandidatesOf: GTSpotterA1.
	
	self assert: (link21 nextLink = link22).
	self assert: (link21 previousLink = link33).
	
	self assert: (link22 nextLink = link23).
	self assert: (link22 previousLink = link21).
	
	self assert: (link23 nextLink = link31).
	self assert: (link23 previousLink = link22).
	
	self assert: (link31 nextLink = link32).
	self assert: (link31 previousLink = link23).
	
	self assert: (link32 nextLink = link33).
	self assert: (link32 previousLink = link31).
	
	self assert: (link33 nextLink = link21).
	self assert: (link33 previousLink = link32).
		
	self assert: (candidates head = link21).
	self assert: (candidates tail = link33).
	
	self assert: ((category1 headLink) = nil).
	self assert: ((category1 tailLink) = nil).
	
	self assert: ((category2 headLink) = link21).
	self assert: ((category2 tailLink) = link23).
	
	self assert: ((category3 headLink) = link31).
	self assert: ((category3 tailLink) = link33).! !

!GTSpotterCandidatesListTest methodsFor: 'as yet unclassified' stamp: 'TudorGirba 12/7/2014 13:12'!
testRemoveCandidatesA1A3FromA1A2A3
	|link21 link22 link23 category1 category2 category3|
	
	category1 := candidates addProcessor: GTSpotterA1.
	category2 := candidates addProcessor: GTSpotterA2.
	category3 := candidates addProcessor: GTSpotterA3.
	
	candidates addCandidate: 11 in: GTSpotterA1.
	candidates addCandidate: 12 in: GTSpotterA1.
	candidates addCandidate: 13 in: GTSpotterA1.
	link21 := candidates addCandidate: 21 in: GTSpotterA2.
	link22 := candidates addCandidate: 22 in: GTSpotterA2.
	link23 := candidates addCandidate: 23 in: GTSpotterA2.
	candidates addCandidate: 31 in: GTSpotterA3.
	candidates addCandidate: 32 in: GTSpotterA3.
	candidates addCandidate: 33 in: GTSpotterA3.
	
	candidates removeAllCandidatesOf: GTSpotterA1.
	candidates removeAllCandidatesOf: GTSpotterA3.
	
	self assert: (link21 nextLink = link22).
	self assert: (link21 previousLink = link23).
	
	self assert: (link22 nextLink = link23).
	self assert: (link22 previousLink = link21).
	
	self assert: (link23 nextLink = link21).
	self assert: (link23 previousLink = link22).
		
	self assert: (candidates head = link21).
	self assert: (candidates tail = link23).
	
	self assert: ((category1 headLink) = nil).
	self assert: ((category1 tailLink) = nil).
	
	self assert: ((category2 headLink) = link21).
	self assert: ((category2 tailLink) = link23).
	
	self assert: ((category3 headLink) = nil).
	self assert: ((category3 tailLink) = nil).! !

!GTSpotterCandidatesListTest methodsFor: 'as yet unclassified' stamp: 'TudorGirba 12/7/2014 13:08'!
testAddThreeCandidateA1A2A3Shuffled
	|link11 link12 link13 link21 link22 link23 link31 link32 link33 category1 category2 category3|
	
	category1 := candidates addProcessor: GTSpotterA1.
	category2 := candidates addProcessor: GTSpotterA2.
	category3 := candidates addProcessor: GTSpotterA3.
	
	link21 := candidates addCandidate: 21 in: GTSpotterA2.
	link22 := candidates addCandidate: 22 in: GTSpotterA2.
	link11 := candidates addCandidate: 11 in: GTSpotterA1.
	link31 := candidates addCandidate: 31 in: GTSpotterA3.
	link12 := candidates addCandidate: 12 in: GTSpotterA1.
	link32 := candidates addCandidate: 32 in: GTSpotterA3.
	link23 := candidates addCandidate: 23 in: GTSpotterA2.
	link33 := candidates addCandidate: 33 in: GTSpotterA3.
	link13 := candidates addCandidate: 13 in: GTSpotterA1.
	
	self assert: (link11 nextLink = link12).
	self assert: (link11 previousLink = link33).
	
	self assert: (link12 nextLink = link13).
	self assert: (link12 previousLink = link11).
	
	self assert: (link13 nextLink = link21).
	self assert: (link13 previousLink = link12).
	
	self assert: (link21 nextLink = link22).
	self assert: (link21 previousLink = link13).
	
	self assert: (link22 nextLink = link23).
	self assert: (link22 previousLink = link21).
	
	self assert: (link23 nextLink = link31).
	self assert: (link23 previousLink = link22).
	
	self assert: (link31 nextLink = link32).
	self assert: (link31 previousLink = link23).
	
	self assert: (link32 nextLink = link33).
	self assert: (link32 previousLink = link31).
	
	self assert: (link33 nextLink = link11).
	self assert: (link33 previousLink = link32).
		
	self assert: (candidates head = link11).
	self assert: (candidates tail = link33).
	
	self assert: ((category1 headLink) = link11).
	self assert: ((category1 tailLink) = link13).
	
	self assert: ((category2 headLink) = link21).
	self assert: ((category2 tailLink) = link23).
	
	self assert: ((category3 headLink) = link31).
	self assert: ((category3 tailLink) = link33).! !

!GTSpotterCandidatesListTest methodsFor: 'as yet unclassified' stamp: 'TudorGirba 12/7/2014 13:11'!
testPreviousA1A2EmptyCategory

	|link11 link12 link13 category1 category2|
	
	category1 := candidates addProcessor: GTSpotterA1.
	category2 := candidates addProcessor: GTSpotterA2.
	
	link11 := candidates addCandidate: 11 in: GTSpotterA1.
	link12 := candidates addCandidate: 12 in: GTSpotterA1.
	link13 := candidates addCandidate: 13 in: GTSpotterA1.
	
	self assert: (category1 = (candidates previousProcessorLinkOf: category1)).
	self assert: (category1 = (candidates previousProcessorLinkOf: category2)).
	
	! !

!GTSpotterCandidatesProcessor commentStamp: 'TudorGirba 11/30/2014 22:12'!
This processor adds the ability of computing and caching all possible candidates. It is useful when we know all candidates upfront.!
!GTSpotterCandidatesProcessor methodsFor: 'private' stamp: 'StefanReichhart 3/20/2015 11:48'!
prepareProcessorInContext: aContext
	super prepareProcessorInContext: aContext.
	
	self hasDynamicItems ifTrue: [ allCandidates := nil ]! !

!GTSpotterCandidatesProcessor methodsFor: 'accessing' stamp: 'AliaskeiSyrel 11/8/2014 09:19'!
origin

	^ origin! !

!GTSpotterCandidatesProcessor methodsFor: 'private' stamp: 'StefanReichhart 2/24/2015 17:04'!
doFilterInContext: aSpotterContext
	^ GTFilterBlock gtFilter value: aSpotterContext! !

!GTSpotterCandidatesProcessor methodsFor: 'accessing' stamp: 'AliaskeiSyrel 11/1/2014 20:13'!
origin: anObject

	origin := anObject! !

!GTSpotterCandidatesProcessor methodsFor: 'compatibility' stamp: 'StefanReichhart 3/22/2015 22:04'!
computeCandidatesIn: aContext

	^ self computeAllItemsIn: aContext! !

!GTSpotterCandidatesProcessor methodsFor: 'compatibility' stamp: 'StefanReichhart 3/22/2015 22:07'!
allCandidatesIn: aContext
	^ self allItemsIn: aContext! !

!GTSpotterCandidatesProcessor methodsFor: 'private' stamp: 'StefanReichhart 3/22/2015 22:04'!
computeAllItemsIn: aContext

	^ OrderedCollection new
	! !

!GTSpotterCandidatesProcessor methodsFor: 'private' stamp: 'TudorGirba 11/27/2014 10:42'!
itemIconFor: anObject
	^ nil! !

!GTSpotterCandidatesProcessor methodsFor: 'compatibility' stamp: 'StefanReichhart 3/22/2015 22:05'!
candidatesLimit
	^ self itemsLimit! !

!GTSpotterCandidatesProcessor methodsFor: 'private' stamp: 'TudorGirba 11/26/2014 14:34'!
render: anObject
	^ GTSpotterItemBrick new
		icon: (self itemIconFor: anObject);
		text: (self itemNameFor: anObject)! !

!GTSpotterCandidatesProcessor methodsFor: 'accessing' stamp: 'TudorGirba 11/26/2014 14:20'!
title
	^ 'undefined'! !

!GTSpotterCandidatesProcessor methodsFor: 'private' stamp: 'TudorGirba 11/26/2014 14:19'!
itemNameFor: anObject
	^ anObject gtDisplayString! !

!GTSpotterCandidatesProcessor methodsFor: 'accessing' stamp: 'StefanReichhart 3/22/2015 22:01'!
itemsLimit
	"Return the maximal number of elements that can be found during search.
	Default implementation returns infinity, so the number of element is not limited."
	^ Float infinity! !

!GTSpotterCandidatesProcessor methodsFor: 'public' stamp: 'StefanReichhart 3/22/2015 22:01'!
allItemsIn: aContext

	^ allCandidates ifNil: [ allCandidates := (self computeAllItemsIn: aContext) copy ].! !

!GTSpotterCandidatesProcessor methodsFor: 'private' stamp: 'StefanReichhart 3/20/2015 12:19'!
itemFilterNameFor: anObject
	^ self itemNameFor: anObject! !

!GTSpotterCandidatesProcessor class methodsFor: 'instance creation' stamp: 'AliaskeiSyrel 11/8/2014 11:06'!
on: anObject

	^ self new origin: anObject! !

!GTSpotterCategoryBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/29/2014 14:24'!
titleBrick: aBrick

	titleBrick := aBrick! !

!GTSpotterCategoryBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/14/2014 23:11'!
category

	^ category! !

!GTSpotterCategoryBrick methodsFor: 'accessing' stamp: 'AliaskeiSyrel 11/13/2014 20:34'!
stepModel
	^ stepModel! !

!GTSpotterCategoryBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 12/2/2014 16:00'!
setAmountVisible: visible all: all

	self titleBrick setAmountVisible: visible all: all! !

!GTSpotterCategoryBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 11/29/2014 14:54'!
on: aStepModel category: aProcessor

	self stepModel: aStepModel.
	self category: aProcessor.! !

!GTSpotterCategoryBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/14/2014 23:33'!
stepModel: anObject
	stepModel := anObject.! !

!GTSpotterCategoryBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/23/2014 18:39'!
titleBrick
	^ titleBrick! !

!GTSpotterCategoryBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/14/2014 23:14'!
category: aProcessorClass

	category := aProcessorClass! !

!GTSpotterCategorySelected methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/24/2015 11:11'!
category
	^ category! !

!GTSpotterCategorySelected methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/24/2015 11:11'!
category: anObject
	category := anObject! !

!GTSpotterCategoryTitleBrick methodsFor: 'event-handling' stamp: 'AliakseiSyrel 2/28/2015 00:59'!
onHideHints

	(self hasSubbrick: self actionbarBrick) ifFalse: [ ^ self ].
	self themer spotterThemer hintHideStyleFor: self diveInButton! !

!GTSpotterCategoryTitleBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 11/19/2014 23:28'!
newAmountBrick

	^ GLMLabelBrick new! !

!GTSpotterCategoryTitleBrick methodsFor: 'adding' stamp: 'AliakseiSyrel 3/22/2015 11:52'!
addDiveInButton
	
	diveInButton := self newActionbarButton.
	self diveInButton
		icon: self themer spotterThemer iconDiveInCategory;
		pressedColor: (self themer spotterThemer itemActionSelectedBackgroundColor alpha: 0.5);
		action: [ self stepModel diveInCategoryDueTo: #actionButton ];
		beHelp;
		hintTitle: 'Show all';
		hintText: '<cmd+shift+right>'.
		
	self pushActionButton: self diveInButton
	! !

!GTSpotterCategoryTitleBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/18/2014 23:33'!
nameBrick

	^ nameBrick! !

!GTSpotterCategoryTitleBrick methodsFor: 'brick-properties-events' stamp: 'AliakseiSyrel 3/23/2015 17:47'!
onThemerChanged
	super onThemerChanged.
	
	self themer spotterThemer categoryTitleWidgetStyleFor: self.
	self themer spotterThemer categoryAmountWidgetStyleFor: self amountBrick.
	self themer spotterThemer categoryTitleNameWidgetStyleFor: self nameBrick.! !

!GTSpotterCategoryTitleBrick methodsFor: 'actions' stamp: 'AliakseiSyrel 2/28/2015 01:02'!
toggleHints

	(self hasSubbrick: self actionbarBrick) ifFalse: [ ^ self ].
	self stepModel spotter isShiftPressed
		ifTrue: [ self onRevealHints ]
		ifFalse: [ self onHideHints ]! !

!GTSpotterCategoryTitleBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/18/2015 15:40'!
stepModel

	^ stepModel! !

!GTSpotterCategoryTitleBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/18/2015 15:26'!
actionbarBrick
	^ actionbarBrick! !

!GTSpotterCategoryTitleBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 2/18/2015 15:32'!
newActionbarButton

	^ GLMHintableActionButtonBrick new! !

!GTSpotterCategoryTitleBrick methodsFor: 'layouting' stamp: 'AliakseiSyrel 12/2/2014 00:47'!
onLayoutEvent: aLayoutEvent
	super onLayoutEvent: aLayoutEvent.
	
	(aLayoutEvent isKindOf: GLMBrickLayoutStacked) ifTrue: [ "self enable" ]! !

!GTSpotterCategoryTitleBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/18/2015 15:45'!
categoryProcessor: anObject
	categoryProcessor := anObject! !

!GTSpotterCategoryTitleBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/28/2015 00:58'!
diveInButton
	^ diveInButton! !

!GTSpotterCategoryTitleBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/30/2015 16:07'!
amountBrick: aBrick

	amountBrick ifNotNil: [self removeBrick: amountBrick].
	amountBrick := aBrick.
	
	self themer spotterThemer categoryAmountStyleFor: amountBrick.
	
	self addBrickBack: amountBrick! !

!GTSpotterCategoryTitleBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 2/18/2015 15:33'!
newActionbarBrick

	^ GLMBrick new! !

!GTSpotterCategoryTitleBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 11/18/2014 23:33'!
newNameBrick

	^ GLMLabelBrick new! !

!GTSpotterCategoryTitleBrick methodsFor: 'adding' stamp: 'AliakseiSyrel 2/28/2015 00:59'!
pushActionButton: aButton

	aButton
		width: [ :b | b icon width * 1.5 ];
		vSpaceFill.
		
	self actionbarBrick addBrickBack: aButton.
	
	self stepModel spotter isShiftPressed
		ifTrue: [ self themer spotterThemer hintRevealStyleFor: aButton ]! !

!GTSpotterCategoryTitleBrick methodsFor: 'event-handling' stamp: 'AliakseiSyrel 2/28/2015 00:58'!
onRevealHints

	(self hasSubbrick: self actionbarBrick) ifFalse: [ ^ self ].
	self themer spotterThemer hintRevealStyleFor: self diveInButton! !

!GTSpotterCategoryTitleBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 2/26/2015 00:41'!
on: aStepModel category: aProcessor

	self stepModel: aStepModel.
	self categoryProcessor: aProcessor.
	
	self nameBrick: self newNameBrick.
	self nameBrick text: aProcessor title.
			
	self amountBrick: self newAmountBrick.
	self amountBrick text: '0/0'.
	
	self actionbarBrick: self newActionbarBrick.
	self addDiveInButton.
	
	self onCandidateSelected.
	
	self nameBrick wrappedBounds markWidthDirty.
	self nameBrick label wrappedBounds markWidthDirty.
	self doLayoutForce.

	^ self! !

!GTSpotterCategoryTitleBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/30/2015 16:07'!
nameBrick: aBrick

	nameBrick ifNotNil: [self removeBrick: nameBrick].
	nameBrick := aBrick.
	
	self themer spotterThemer categoryTitleNameStyleFor: nameBrick.
	
	self addBrickBack: nameBrick! !

!GTSpotterCategoryTitleBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/18/2015 15:39'!
actionbarBrick: anObject
	actionbarBrick := anObject.

	self actionbarBrick
		vSpaceFill;
		hShrinkWrap.! !

!GTSpotterCategoryTitleBrick methodsFor: 'actions' stamp: 'AliakseiSyrel 2/18/2015 15:44'!
hideActionbar

	(self hasSubbrick: self actionbarBrick) ifTrue: [ 
		self removeBrick: self actionbarBrick ]! !

!GTSpotterCategoryTitleBrick methodsFor: 'actions' stamp: 'AliakseiSyrel 2/28/2015 01:02'!
showActionbar

	(self hasSubbrick: self actionbarBrick) ifFalse: [ 
		self addBrickBack: self actionbarBrick.
		self toggleHints ]! !

!GTSpotterCategoryTitleBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/18/2015 15:45'!
categoryProcessor
	^ categoryProcessor! !

!GTSpotterCategoryTitleBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/19/2014 23:26'!
amountBrick

	^ amountBrick! !

!GTSpotterCategoryTitleBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/18/2015 15:38'!
setAmountVisible: visible all: all

	self amountBrick text: (visible asString, '/', all asString).
	self amountBrick wrappedBounds markWidthDirty.
	self amountBrick doLayout.
	self doLayoutForce! !

!GTSpotterCategoryTitleBrick methodsFor: 'event-handling' stamp: 'AliakseiSyrel 2/25/2015 14:06'!
onCandidateSelected
	
	self stepModel selected ifNil: [ ^ self ].
	self stepModel selectedCategory = self categoryProcessor
		ifTrue: [ self showActionbar ]
		ifFalse: [ self hideActionbar ]! !

!GTSpotterCategoryTitleBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/28/2015 00:56'!
stepModel: anObject
	stepModel := anObject.
	
	self stepModel announcer weak on: GTSpotterSelectedCandidateChanged send: #onCandidateSelected to: self.
	self stepModel spotter announcer weak subscribe: GTSpotterRevealHints send: #onRevealHints to: self.
	self stepModel spotter announcer weak subscribe: GTSpotterHideHints send: #onHideHints to: self.! !

!GTSpotterContentsBrick methodsFor: 'brick-properties-events' stamp: 'AliakseiSyrel 3/21/2015 22:45'!
onThemerChanged
	super onThemerChanged.
	
	self themer spotterThemer spotterContentsWidgetStyleFor: self! !

!GTSpotterContentsBrick methodsFor: 'events-processing' stamp: 'AliakseiSyrel 11/20/2014 23:29'!
onStepAdded
	"as soon as step added I need to show drop down pane"
	self isDropDownPaneVisible ifTrue: [ ^ self ].
	
	self showDropDownPane! !

!GTSpotterContentsBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/8/2015 14:28'!
dropDownBrick: aBrick
	dropDownBrick ifNotNil: [self removeBrick: dropDownBrick].
	dropDownBrick := aBrick asBrick.
	
	dropDownBrick morph pagerModel: self spotterModel pagerModel.
	self themer spotterThemer dropDownPaneStyleFor: dropDownBrick.
	
	self addBrickBack: dropDownBrick
	"aBrick openInWindow"! !

!GTSpotterContentsBrick methodsFor: 'testing' stamp: 'AliakseiSyrel 11/20/2014 23:26'!
isDropDownPaneVisible

	^ self dropDownBrick isNotNil! !

!GTSpotterContentsBrick methodsFor: 'initialization' stamp: 'AndreiChis 3/15/2015 23:50'!
initialize
	super initialize.
		
	self headerBrick: self newHeaderBrick.
	"#GTSpotterEventRecorderSettings asClassIfPresent: [ 
		self privacyAgreementBrick: self newPrivacyAgreementBrick ]."! !

!GTSpotterContentsBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/20/2014 23:35'!
spotterModel

	^ spotterModel! !

!GTSpotterContentsBrick methodsFor: 'actions' stamp: 'AliakseiSyrel 2/8/2015 14:39'!
showDropDownPane

	self dropDownBrick: self newDropDownMorph.
	self dropDownBrick spotterModel: self spotterModel.! !

!GTSpotterContentsBrick methodsFor: 'accessing' stamp: 'TudorGirba 11/26/2014 14:34'!
spotterModel: aModel

	spotterModel := aModel.
	self headerBrick spotterModel: spotterModel.
	
	spotterModel steps isEmpty ifFalse: [ spotterModel currentStep isEmpty ifFalse: [ self showDropDownPane ] ].

	spotterModel announcer subscribe: GTSpotterStepAdded send: #onStepAdded to: self.! !

!GTSpotterContentsBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/20/2014 23:26'!
dropDownBrick
	^ dropDownBrick! !

!GTSpotterContentsBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/20/2014 23:26'!
headerBrick
	^ headerBrick! !

!GTSpotterContentsBrick methodsFor: 'instance creation' stamp: 'TudorGirba 11/26/2014 14:35'!
newDropDownMorph

	^ GTSpotterDropDownMorph new! !

!GTSpotterContentsBrick methodsFor: 'instance creation' stamp: 'TudorGirba 11/26/2014 14:34'!
newHeaderBrick

	^ GTSpotterHeaderBrick new! !

!GTSpotterContentsBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/30/2015 16:07'!
headerBrick: aBrick
	
	headerBrick ifNotNil: [self removeBrick: headerBrick].
	headerBrick := aBrick.
	
	self themer spotterThemer headerStyleFor: headerBrick.
	
	self addBrickBack: headerBrick! !

!GTSpotterContext methodsFor: 'accessing' stamp: 'StefanReichhart 2/24/2015 13:45'!
processor: anObject
	processor := anObject! !

!GTSpotterContext methodsFor: 'accessing-defaults' stamp: 'StefanReichhart 2/24/2015 10:57'!
defaultText
	^ ''! !

!GTSpotterContext methodsFor: 'public' stamp: 'StefanReichhart 3/20/2015 16:52'!
cacheAt: aSymbol put: anObject
	^ self cache at: aSymbol put: anObject! !

!GTSpotterContext methodsFor: 'accessing' stamp: 'StefanReichhart 2/24/2015 15:27'!
cache
	^ cache ifNil: [ cache := self defaultCache ]! !

!GTSpotterContext methodsFor: 'public' stamp: 'StefanReichhart 2/24/2015 13:48'!
addItem: anObject
	self stream addObject: anObject inProcessor: self processor! !

!GTSpotterContext methodsFor: 'accessing' stamp: 'StefanReichhart 2/24/2015 12:01'!
stream: anObject
	stream := anObject! !

!GTSpotterContext methodsFor: 'accessing' stamp: 'StefanReichhart 2/24/2015 15:27'!
cache: anObject
	cache := anObject! !

!GTSpotterContext methodsFor: 'public' stamp: 'StefanReichhart 2/24/2015 12:35'!
textTrimmed
	^ textTrimmed ifNil: [ textTrimmed := self defaultTextTrimmed ]! !

!GTSpotterContext methodsFor: 'accessing' stamp: 'StefanReichhart 2/24/2015 12:35'!
text
	^ text ifNil: [ text := self defaultText ]! !

!GTSpotterContext methodsFor: 'public' stamp: 'StefanReichhart 2/24/2015 15:28'!
cacheAt: aSymbol
	^ self cacheAt: aSymbol ifAbsent: [ nil ]! !

!GTSpotterContext methodsFor: 'public' stamp: 'StefanReichhart 2/24/2015 15:39'!
cacheAt: aSymbol ifAbsent: aBlock
	^ self cache at: aSymbol ifAbsent: aBlock! !

!GTSpotterContext methodsFor: 'public' stamp: 'AliakseiSyrel 2/26/2015 00:56'!
addItems: aCollection

	self stream addObjects: aCollection inProcessor: self processor! !

!GTSpotterContext methodsFor: 'accessing' stamp: 'StefanReichhart 2/24/2015 11:33'!
step: anObject
	step := anObject! !

!GTSpotterContext methodsFor: 'comparing' stamp: 'AndreiChis 2/28/2015 18:36'!
equals: aContext
	aContext ifNil: [ ^ false ].
   ^ self matches: aContext text! !

!GTSpotterContext methodsFor: 'public' stamp: 'StefanReichhart 4/1/2015 09:56'!
exceptionHandler
	self flag: 'Bloc -> overrides doesNotUnderstand discarding the current exception context'.
	^ GTCurrentSpotterExceptionHandler value ifNil: [ self step exceptionHandler ]! !

!GTSpotterContext methodsFor: 'accessing' stamp: 'StefanReichhart 2/24/2015 12:01'!
stream
	^ stream! !

!GTSpotterContext methodsFor: 'testing' stamp: 'StefanReichhart 2/24/2015 11:04'!
isEmpty
	^ self text isNil
		or: [ self text isEmpty ]! !

!GTSpotterContext methodsFor: 'public' stamp: 'StefanReichhart 2/24/2015 15:39'!
cacheAt: aSymbol ifAbsentPut: aBlock
	^ self cache at: aSymbol ifAbsentPut: aBlock! !

!GTSpotterContext methodsFor: 'accessing-defaults' stamp: 'StefanReichhart 2/24/2015 15:46'!
defaultTextLowercase
	^ self textTrimmed asLowercase! !

!GTSpotterContext methodsFor: 'accessing-defaults' stamp: 'StefanReichhart 2/24/2015 15:28'!
defaultCache
	^ IdentityDictionary new ! !

!GTSpotterContext methodsFor: 'accessing-defaults' stamp: 'StefanReichhart 2/24/2015 12:35'!
defaultTextTrimmed
	^ self text trimBoth! !

!GTSpotterContext methodsFor: 'accessing' stamp: 'StefanReichhart 2/24/2015 10:57'!
text: anObject
	text := anObject! !

!GTSpotterContext methodsFor: 'public' stamp: 'StefanReichhart 3/20/2015 16:58'!
removeCacheAt: aSymbol
	^ self cache removeKey: aSymbol ifAbsent: [ nil ]! !

!GTSpotterContext methodsFor: 'accessing-dynamic' stamp: 'StefanReichhart 3/18/2015 13:56'!
spotter
	^ self step spotter! !

!GTSpotterContext methodsFor: 'testing' stamp: 'StefanReichhart 2/24/2015 11:06'!
notEmpty
	^ self isEmpty not! !

!GTSpotterContext methodsFor: 'accessing' stamp: 'StefanReichhart 2/24/2015 11:33'!
step
	^ step! !

!GTSpotterContext methodsFor: 'public' stamp: 'StefanReichhart 3/22/2015 22:00'!
itemsLimit
	^ self processor itemsLimit! !

!GTSpotterContext methodsFor: 'accessing' stamp: 'StefanReichhart 2/24/2015 13:45'!
processor
	^ processor! !

!GTSpotterContext methodsFor: 'testing' stamp: 'StefanReichhart 2/24/2015 11:04'!
matches: aString
	^ self isEmpty not
		and: [ self text = aString ]! !

!GTSpotterContext methodsFor: 'public' stamp: 'StefanReichhart 2/24/2015 15:45'!
textLowercase
	^ textLowercase ifNil: [ textLowercase := self defaultTextLowercase ]! !

!GTSpotterContextChanged methodsFor: 'accessing' stamp: 'StefanReichhart 2/28/2015 13:42'!
current
	^ current! !

!GTSpotterContextChanged methodsFor: 'accessing-dynamic' stamp: 'AndreiChis 2/28/2015 18:41'!
currentText
	^ self current ifNil: [''] ifNotNil: [ self current text ]! !

!GTSpotterContextChanged methodsFor: 'compatibility' stamp: 'StefanReichhart 2/28/2015 13:55'!
context: aSpotterContext
	self current: aSpotterContext! !

!GTSpotterContextChanged methodsFor: 'accessing' stamp: 'StefanReichhart 2/28/2015 13:42'!
current: anObject
	current := anObject! !

!GTSpotterContextChanged methodsFor: 'accessing' stamp: 'StefanReichhart 2/28/2015 13:42'!
previous
	^ previous! !

!GTSpotterContextChanged methodsFor: 'accessing-dynamic' stamp: 'AndreiChis 2/28/2015 18:41'!
previousText
	^ self previous ifNil: ['']  ifNotNil: [ self previous text ]! !

!GTSpotterContextChanged methodsFor: 'compatibility' stamp: 'StefanReichhart 2/28/2015 13:46'!
context
	^ self current! !

!GTSpotterContextChanged methodsFor: 'compatibility' stamp: 'StefanReichhart 2/28/2015 13:47'!
text
	^ self currentText! !

!GTSpotterContextChanged methodsFor: 'accessing' stamp: 'StefanReichhart 2/28/2015 13:42'!
previous: anObject
	previous := anObject! !

!GTSpotterDebuggingExceptionHandler methodsFor: 'public' stamp: 'StefanReichhart 3/17/2015 15:36'!
handleException: anException do: aBlock
	anException pass.
	^ super handleException: anException do: aBlock.
	
	! !

!GTSpotterDebuggingExceptionHandlerMock methodsFor: 'public' stamp: 'StefanReichhart 3/22/2015 18:36'!
handleFatalException: anException
	GTSpotterExceptionsTest fatals add: anException! !

!GTSpotterDebuggingExceptionHandlerMock methodsFor: 'public' stamp: 'StefanReichhart 3/22/2015 18:36'!
handleException: anException do: aBlock
	" we don't want to perform aBlock during tests --> suppress logging to transcript "
	" we perform the #pass after we register that the exception happened - otherwise we cannot test for it later "
	GTSpotterExceptionsTest exceptions add: anException.
	anException pass! !

!GTSpotterDeploymentExceptionHandlerMock methodsFor: 'public' stamp: 'StefanReichhart 3/22/2015 18:41'!
handleFatalException: anException
	GTSpotterExceptionsTest fatals add: anException! !

!GTSpotterDeploymentExceptionHandlerMock methodsFor: 'public' stamp: 'StefanReichhart 3/22/2015 18:49'!
handleException: anException do: aBlock
	" we don't want to perform aBlock during tests --> suppress logging to transcript "
	" only register the occured exception for later testing "
	GTSpotterExceptionsTest exceptions add: anException.! !

!GTSpotterDeploymentExceptionHandlerMock5 methodsFor: 'public' stamp: 'StefanReichhart 3/22/2015 19:02'!
handleException: anException do: aBlock
	super handleException: anException do: aBlock. " we perform the block because mock5 should not raise any exception within aBlock "
	^ aBlock value! !

!GTSpotterDiveInCategory methodsFor: 'accessing' stamp: 'AndreiChis 3/20/2015 18:30'!
eventType
	^ eventType! !

!GTSpotterDiveInCategory methodsFor: 'accessing' stamp: 'AndreiChis 3/20/2015 18:30'!
eventType: anObject
	eventType := anObject! !

!GTSpotterDiveInCategory methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/24/2015 10:43'!
category
	^ category! !

!GTSpotterDiveInCategory methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/24/2015 10:43'!
category: anObject
	category := anObject! !

!GTSpotterDiveInElement methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/24/2015 10:40'!
element
	^ element! !

!GTSpotterDiveInElement methodsFor: 'accessing' stamp: 'AndreiChis 3/20/2015 18:43'!
eventType: anObject
	eventType := anObject! !

!GTSpotterDiveInElement methodsFor: 'accessing' stamp: 'AndreiChis 3/20/2015 18:43'!
eventType
	^ eventType! !

!GTSpotterDiveInElement methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/24/2015 10:40'!
element: anObject
	element := anObject! !

!GTSpotterDiveOut methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/24/2015 10:57'!
element: anObject
	element := anObject! !

!GTSpotterDiveOut methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/24/2015 10:57'!
element
	^ element! !

!GTSpotterDoubleLinkedList methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/14/2014 20:45'!
tail: aDoubleLink

	tail := aDoubleLink! !

!GTSpotterDoubleLinkedList methodsFor: 'enumerating' stamp: 'AliakseiSyrel 11/14/2014 14:48'!
linksDo: aBlock
	| current |
	current := head.
	[ current isNil ] 
		whileFalse: [ 
	 		aBlock value: current.
			current := current nextLink ]! !

!GTSpotterDoubleLinkedList methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 11/15/2014 13:59'!
removeCycledLink: link
	| predecessor successor |
	predecessor := link previousLink.
	successor := link nextLink.
	predecessor
		ifNil: [ head := successor ]
		ifNotNil: [ predecessor nextLink: successor ].
	successor
		ifNil: [ tail := predecessor ]
		ifNotNil: [ successor previousLink: predecessor ].
	link clearLinks.
	
	"I'm the only one left, clear linked list and return"
	(link = head & (link = tail)) ifTrue: [ head := nil. tail := nil. ^ link ].
	
	link = head ifTrue: [ head := successor ].
	link = tail ifTrue: [ tail := predecessor ].
	
	^ link! !

!GTSpotterDoubleLinkedList methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/14/2014 20:45'!
head: aDoubleLink

	head := aDoubleLink! !

!GTSpotterDoubleLinkedList methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/14/2014 14:48'!
head

	^ head! !

!GTSpotterDoubleLinkedList methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/14/2014 14:48'!
tail

	^ tail! !

!GTSpotterDropDownMorph methodsFor: 'initialization' stamp: 'AliakseiSyrel 11/15/2014 15:50'!
initialize
	super initialize.
	
	self showScrollBarWhenNeeded: false! !

!GTSpotterDropDownMorph methodsFor: 'event handling' stamp: 'AliakseiSyrel 12/10/2014 13:44'!
onStepAdded: ann
	"as soon as step added we need to push it"

	self pushPane: (self buildPane: ann stepModel)! !

!GTSpotterDropDownMorph methodsFor: 'building' stamp: 'AliakseiSyrel 1/30/2015 16:29'!
buildPane: aStepModel
	|pane|
	
	pane := GTSpotterResultsBrick new stepModel: aStepModel.
	self brickThemer spotterThemer resultsPaneStyleFor: pane.
	^ pane! !

!GTSpotterDropDownMorph methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/24/2014 13:29'!
spotterModel
	^ spotterModel! !

!GTSpotterDropDownMorph methodsFor: 'accessing' stamp: 'AliakseiSyrel 12/10/2014 13:45'!
spotterModel: aModel 
	spotterModel := aModel.
	
	spotterModel steps do: [ :each | self pushPane: (self buildPane: each) ].
	
	spotterModel announcer subscribe: GTSpotterStepAdded send: #onStepAdded: to: self.! !

!GTSpotterEventRecorder commentStamp: 'AndreiChis 3/2/2015 15:02'!
A GTSpotterEventRecorder provides the main functionality for recording and sending usage data in Spotter. The collection and delivery works as follows:

- the recorder registers with Spotter every time Spotter is opened ;
- as long as the setting #sendUsageData is set to false all events received by the recorder are discarded;
- the first time an event is send to the recorder and the setting#sendUsageData is set to true a delivery process is started
- as long as the setting #sendUsageData is set to true all interesting events received by the recorder are stored
- at certain intervals the delivery process collects all data, compressed it, and places a payload to a delivery queue.
- the delivery process takes the next paylod from the queue and attepts to send it to a server; on sucsess the payload is removed from the queue.
- if the setting #sendUsageData is set to false, events are no longer collected and all recorded data is removed next time the delivery process resumes.

The delivery process is not stopped by default after creation. The class size method #cleanUp stops the delivery process and removes all data that still awaits delivery.

Instance Variables
	deliveryDelay:		<Object>
	deliveryQueue:		<Object>
	mutex:		<Object>
	process:		<Object>
	recordedData:		<Object>
	shouldDeliver:		<Object>

deliveryDelay
	- xxxxx

deliveryQueue
	- xxxxx

mutex
	- xxxxx

process
	- xxxxx

recordedData
	- xxxxx

shouldDeliver
	- xxxxx
!
!GTSpotterEventRecorder methodsFor: 'delivery' stamp: 'JurajKubelka 3/29/2015 13:59'!
prepareDeliveryData
	self canSendUsageData ifFalse: [ 
		recordedData removeAll.
		deliveryQueue removeAll.
		postponedData := nil.
		^ self ].
	recordedData isEmpty ifTrue: [ ^ self ].
	GTSpotterEventRecorderSettings ensureComputerID.
	self primitivePrepareDeliveryData! !

!GTSpotterEventRecorder methodsFor: 'accessing' stamp: 'JurajKubelka 2/25/2015 12:18'!
shouldDeliver
	^ shouldDeliver ifNil: [ shouldDeliver := true ]! !

!GTSpotterEventRecorder methodsFor: 'delivery' stamp: 'JurajKubelka 2/28/2015 17:45'!
deliverNow
	"for testing purpose"
	deliveryDelay ifNotNil: [ :aDelay | aDelay delaySemaphore signal. aDelay unschedule. ]! !

!GTSpotterEventRecorder methodsFor: 'delivery' stamp: 'JurajKubelka 2/26/2015 14:36'!
deliverAndSignalProgress: aBoolean
	self 
		prepareDeliveryData;
		deliverDataAndSignalProgress: aBoolean.
! !

!GTSpotterEventRecorder methodsFor: 'delivery' stamp: 'JurajKubelka 2/26/2015 14:37'!
deliverDataAndSignalProgress: aBoolean
	deliveryQueue flush: [ :eachByteArray |
		self deliverData: eachByteArray signalProgress: aBoolean ]! !

!GTSpotterEventRecorder methodsFor: 'delivery' stamp: 'JurajKubelka 3/29/2015 13:58'!
primitivePrepareDeliveryData
	| likelyDeliveredData toBeDeliveredData toBeDeliveredAnnouncement |
	likelyDeliveredData := self newCollectionWithPostponedData.
	recordedData flush: [ :eachRecord | likelyDeliveredData addLast: eachRecord ].
	toBeDeliveredData := self postponeSomeData: likelyDeliveredData.
	toBeDeliveredAnnouncement := self serializedAnnouncementFrom: toBeDeliveredData.
	deliveryQueue nextPut: toBeDeliveredAnnouncement.! !

!GTSpotterEventRecorder methodsFor: 'delivery' stamp: 'JurajKubelka 3/29/2015 13:30'!
postponedData
	"For testing/debugging purpose."
	^ postponedData! !

!GTSpotterEventRecorder methodsFor: 'initialization' stamp: 'AndreiChis 2/27/2015 23:09'!
initialize
	super initialize.
	
	recordedData := WaitfreeQueue new.
	deliveryQueue := WaitfreeQueue new.
	mutex := Mutex new.! !

!GTSpotterEventRecorder methodsFor: 'delivery' stamp: 'JurajKubelka 2/26/2015 14:37'!
lastDataDelivery
	UIManager default informUserDuring: [ :bar |
	  	[ self deliverAndSignalProgress: true ]
	    on: HTTPProgress 
	    do: [ :progress |  
			progress isEmpty ifFalse: [ bar current: progress percentage ].
	      progress resume ] ]
! !

!GTSpotterEventRecorder methodsFor: 'delivery' stamp: 'JurajKubelka 3/29/2015 14:08'!
deliveryQueue
	"for testing purpose only"
	^ deliveryQueue! !

!GTSpotterEventRecorder methodsFor: 'delivery' stamp: 'JurajKubelka 3/29/2015 13:39'!
newCollectionWithPostponedData
	^ postponedData 
			ifNil: [ OrderedCollection new ]
			ifNotNil: [ :aCollection | postponedData := nil. aCollection ]
	! !

!GTSpotterEventRecorder methodsFor: 'testing' stamp: 'JurajKubelka 3/10/2015 07:22'!
canSendUsageData
	^ GTSpotterEventRecorderSettings sendUsageData! !

!GTSpotterEventRecorder methodsFor: 'initialization' stamp: 'JurajKubelka 3/18/2015 11:35'!
initializeDeliveryProcess
	process := [ [ self shouldDeliver ] whileTrue: [ 
						deliveryDelay := self standardDuration asDelay.
						deliveryDelay wait.
						deliveryDelay := nil.
						self shouldDeliver ifTrue: [ self deliverAndSignalProgress: false ] ] ] 
		forkAt: Processor userBackgroundPriority 
		named: self className, ' regular delivery process'! !

!GTSpotterEventRecorder methodsFor: 'events' stamp: 'JurajKubelka 3/29/2015 14:01'!
recordedData
	"For testing purpose only."
	^ recordedData! !

!GTSpotterEventRecorder methodsFor: 'accessing' stamp: 'JurajKubelka 2/26/2015 18:32'!
standardDuration
	^ 20 minutes! !

!GTSpotterEventRecorder methodsFor: 'delivery' stamp: 'JurajKubelka 2/26/2015 17:42'!
deliverData: aByteArray signalProgress: aBoolean
	^ (ZnClient new
			beOneShot;
			timeout: 5;
			signalProgress: aBoolean;
			numberOfRetries: 0;
			url: self remoteURL;
			enforceHttpSuccess: true;
			ifFail: [ :exception | deliveryQueue nextPut: aByteArray ];
			entity: (ZnByteArrayEntity bytes: aByteArray);
			put;
			response)! !

!GTSpotterEventRecorder methodsFor: 'converting' stamp: 'JurajKubelka 2/28/2015 15:43'!
materialize: aByteArray
	^ self class materialize: aByteArray! !

!GTSpotterEventRecorder methodsFor: 'converting' stamp: 'JurajKubelka 2/28/2015 15:42'!
materializedAnnouncementFrom: aByteArray 
	^ self materialize: aByteArray! !

!GTSpotterEventRecorder methodsFor: 'events' stamp: 'JurajKubelka 3/30/2015 14:23'!
buildAndStoreEventFrom: anAnnouncement withType: aClass
	self storeEvent: (aClass fromAnnouncement: anAnnouncement)

	
 	
		
! !

!GTSpotterEventRecorder methodsFor: 'events' stamp: 'AndreiChis 2/28/2015 18:17'!
recordAccouncement: anAnnouncement

	self canSendUsageData ifFalse: [ ^ self ].

	"recorderEventClassName := self eventClassNameFor: anAnnouncement class.
	(Smalltalk hasClassNamed: recorderEventClassName) ifFalse: [ ^ false ].
	self storeEvent: (recorderEventClassName asClass fromAnnouncement: anAnnouncement)"
	
	anAnnouncement class == GTSpotterActOn ifTrue: [ ^self buildAndStoreEventFrom: anAnnouncement withType: GTSpotterRecorderActOnEvent ].
	
	anAnnouncement class == GTSpotterCategorySelected ifTrue: [ ^self buildAndStoreEventFrom: anAnnouncement withType: GTSpotterRecorderCategorySelectedEvent ].
	
	anAnnouncement class == GTSpotterContextChanged ifTrue: [ ^self buildAndStoreEventFrom: anAnnouncement withType: GTSpotterRecorderContextChangedEvent ].
	
	anAnnouncement class == GTSpotterDiveInCategory ifTrue: [ ^self buildAndStoreEventFrom: anAnnouncement withType: GTSpotterRecorderDiveInCategoryEvent ].
	
	anAnnouncement class == GTSpotterDiveInElement ifTrue: [ ^self buildAndStoreEventFrom: anAnnouncement withType: GTSpotterRecorderDiveInElementEvent ].
	
	anAnnouncement class == GTSpotterDiveOut ifTrue: [ ^self buildAndStoreEventFrom: anAnnouncement withType: GTSpotterRecorderDiveOutEvent ].
	
	anAnnouncement class == GTSpotterExitAnnouncement ifTrue: [ ^self buildAndStoreEventFrom: anAnnouncement withType: GTSpotterRecorderExitAnnouncementEvent ].
	
	anAnnouncement class == GTSpotterHidePreview ifTrue: [ ^self buildAndStoreEventFrom: anAnnouncement withType: GTSpotterRecorderHidePreviewEvent ].
	
	anAnnouncement class == GTSpotterSelectedCandidateChanged ifTrue: [ ^self buildAndStoreEventFrom: anAnnouncement withType: GTSpotterRecorderSelectedCandidateChangedEvent ].
	
	anAnnouncement class == GTSpotterShowPreview ifTrue: [ ^self buildAndStoreEventFrom: anAnnouncement withType: GTSpotterRecorderShowPreviewEvent ].
	
	anAnnouncement class == GTSpotterSearchFinished ifTrue: [ ^self buildAndStoreEventFrom: anAnnouncement withType: GTSpotterRecorderSearchFinishedEvent ].
	

	
 	
		
! !

!GTSpotterEventRecorder methodsFor: 'initialization' stamp: 'JurajKubelka 2/25/2015 17:51'!
linkToSpotter: aSpotterModel

	aSpotterModel announcer weak when: Announcement send: #recordAccouncement: to: self! !

!GTSpotterEventRecorder methodsFor: 'delivery' stamp: 'JurajKubelka 2/27/2015 19:42'!
stopDelivering
	^ mutex critical: [ | oldProcess |
		shouldDeliver := false.
		deliveryDelay ifNotNil: [ :aDelay | aDelay delaySemaphore signal ].
		oldProcess := process.
		process := nil.
		oldProcess ]! !

!GTSpotterEventRecorder methodsFor: 'delivery' stamp: 'JurajKubelka 3/9/2015 11:31'!
flushRecordedData
	"For debugging purpose only. Remember that those data will not be published."
	| collection |
	collection := OrderedCollection new.
	recordedData flush: [ :eachItem | collection add: eachItem ].
	^ collection! !

!GTSpotterEventRecorder methodsFor: 'converting' stamp: 'JurajKubelka 2/26/2015 14:16'!
serializedAnnouncementFrom: oldRecordedData
	^ self serialize: (self announcementFrom: oldRecordedData)! !

!GTSpotterEventRecorder methodsFor: 'events' stamp: 'JurajKubelka 2/26/2015 20:06'!
recordSpotterOpenEvent

	self canSendUsageData ifFalse: [ ^ self ].

	self storeEvent: GTSpotterRecorderOpenEvent new! !

!GTSpotterEventRecorder methodsFor: 'converting' stamp: 'AndreiChis 3/18/2015 14:01'!
announcementFrom: oldRecordedData
	^ GTSpotterRecorderDataAnnouncement new
			data: (self serialize: oldRecordedData);
			timestamp: DateAndTime now;
			imageHash: SmalltalkImage current imageName hash;
			sessionCreationTime: SmalltalkImage current session creationTime;
			imageVersion: SystemVersion current version;
			latestUpdate: SystemVersion current highestUpdate;
			computerUUID: GTSpotterEventRecorderSettings uniqueInstance computerUUID asString;
			eventRecorderVersion: GTSpotterEventRecorder version;
			yourself! !

!GTSpotterEventRecorder methodsFor: 'converting' stamp: 'JurajKubelka 2/28/2015 15:45'!
serialize: anObject
	^ self class serialize: anObject! !

!GTSpotterEventRecorder methodsFor: 'accessing' stamp: 'AndreiChis 2/24/2015 22:01'!
eventClassNameFor: aSpotterAnnouncementClass

	^  'GTSpotterRecorder', 
		(aSpotterAnnouncementClass name 
			copyFrom: 'GTSpotter' size + 1
			to: aSpotterAnnouncementClass name size), 
		'Event'.
 	
		
! !

!GTSpotterEventRecorder methodsFor: 'events' stamp: 'AndreiChis 2/27/2015 23:15'!
storeEvent: anEvent
	recordedData nextPut: anEvent.
	mutex critical: [ 
		(process isNil or: [ process isTerminated ]) ifTrue: [ self initializeDeliveryProcess ] ]! !

!GTSpotterEventRecorder methodsFor: 'accessing' stamp: 'JurajKubelka 2/25/2015 13:17'!
remoteURL
	^ GTSpotterEventRecorderSettings url! !

!GTSpotterEventRecorder methodsFor: 'delivery' stamp: 'JurajKubelka 3/29/2015 18:43'!
postponeSomeData: aCollection 
	| lastExitIndex |
	lastExitIndex := aCollection findLast: [ :each | each isCloseSpotter ].
	lastExitIndex = aCollection size ifTrue: [ ^ aCollection ].
	postponedData := aCollection copyFrom: lastExitIndex + 1 to: aCollection size.
	^ aCollection first: lastExitIndex.! !

!GTSpotterEventRecorder class methodsFor: 'converting' stamp: 'JurajKubelka 2/28/2015 15:43'!
materialize: aByteArray
	| materializer stream gzstream materialization |
	stream := aByteArray readStream. 
	gzstream := GZipReadStream on: stream.
	materializer := FLMaterializer newDefault.
	materialization := materializer materializeFrom: gzstream.
	gzstream close.
	stream close.
	^ materialization root.! !

!GTSpotterEventRecorder class methodsFor: 'accessing' stamp: 'JurajKubelka 3/6/2015 15:04'!
instance
	"self instance"
	^ instance ifNil: [ instance := self new ]! !

!GTSpotterEventRecorder class methodsFor: 'converting' stamp: 'JurajKubelka 2/28/2015 17:43'!
serialize: anObject
	| serializer stream gzstream |
	stream := ByteArray new writeStream binary. 
	gzstream := GZipWriteStream on: stream.
	serializer := FLSerializer newDefault.
	serializer at: #recorderVersion putAdditionalObject: self version.
	serializer stream: gzstream.
	serializer serialize: anObject.
	gzstream close.
	stream close.
	^ stream contents.! !

!GTSpotterEventRecorder class methodsFor: 'converting' stamp: 'JurajKubelka 2/28/2015 17:37'!
materializeObjectsFromFile: aFileReference 
	"self materializeObjectsFromFile: './gt/events/' asFileReference allFiles any"
	^ self materialize: (aFileReference binaryReadStreamDo: #contents)! !

!GTSpotterEventRecorder class methodsFor: 'accessing' stamp: 'AndreiChis 2/20/2015 10:43'!
reset
	instance := nil! !

!GTSpotterEventRecorder class methodsFor: 'accessing' stamp: 'JurajKubelka 4/10/2015 09:50'!
version
	^ 2
	
"Changes to version 2:
	- GTSpotterRecorderEvent>>timestamp keeps DateAndTime object. 
	  Before, it was an integer as unix time.
"! !

!GTSpotterEventRecorder class methodsFor: 'converting' stamp: 'JurajKubelka 3/28/2015 16:49'!
materializeObjectsFromDirectory: aFileReference
	"self materializeObjectsFromDirectory: './gt/events/' asFileReference"
	^ aFileReference asFileReference allFiles collect: [ :eachFile |
		self materializeObjectsFromFile: eachFile ]  ! !

!GTSpotterEventRecorder class methodsFor: 'accessing' stamp: 'JurajKubelka 2/28/2015 00:45'!
cleanUp
	"Stop and remove the process for sending usage data. Delete all recorder that from the queue."
	
	instance ifNotNil: [ 
		instance stopDelivering ifNotNil: [ :aProcess | 
			[ aProcess terminate ] on: Error do: [ "ignore error" ] ].
		instance := nil ]
! !

!GTSpotterEventRecorderSettings commentStamp: 'AndreiChis 3/2/2015 15:23'!
A GTSpotterEventRecorderSettings manages  user preferences related to  sending usage data. This works as follows:  

1. First opening of an image with the recorder
- the first time an image containing this class is opened (or  this class is loaded in an image) a settings file is created in the settings folder of the current user (FileLocator preferences asFileReference).
- a UUID is generated and store d in the setting file to identfy the current computer

2. Opening an image after a settings file was created
- if this image does not already have a setting stored in an image or has a setting with a different UUID then the one of the local computer, any setting present in the image is removed.
- as a second step, if there is a default setting present in the settings file that setting is loaded and stored in the image.

3. Changing the default settings
- the default setting can only be changed from the Agreement UI accessible from the Spotter settings.

This mechanism has the following implications:
- as long as there is no default setting explicitly set a setting has to be set in every image manually
- if there is a default setting stored, whenever opening a new image without an explicit setting the default setting  is saved in the image.

Hence, changing the default setting later on will not change the existing setting in any existing images. It will only apply to new images.
Also copying an image from one computer to another resets it's settings to the default settings of the destination computer.

Instance Variables
	computerUUID:		<Object>
	sendSearchQuery:		<Object>
	sendUsageData:		<Object>
	url:		<Object>
	userAnsweredAgreement:		<Object>

computerUUID
	- xxxxx

sendSearchQuery
	- xxxxx

sendUsageData
	- xxxxx

url
	- xxxxx

userAnsweredAgreement
	- xxxxx
!
!GTSpotterEventRecorderSettings methodsFor: 'accessing' stamp: 'JurajKubelka 3/6/2015 15:00'!
secretUUID
	^ secretUUID! !

!GTSpotterEventRecorderSettings methodsFor: 'accessing' stamp: 'JurajKubelka 2/26/2015 18:39'!
computerUUID
	^ computerUUID! !

!GTSpotterEventRecorderSettings methodsFor: 'initialization' stamp: 'JurajKubelka 3/6/2015 15:00'!
initialize
	super initialize.
	computerUUID := UUID new.
	secretUUID := UUID new.! !

!GTSpotterEventRecorderSettings methodsFor: 'converting' stamp: 'JurajKubelka 2/28/2015 15:55'!
dictionary
	| dictionary |
	dictionary := Dictionary new: self class instSize.
	1 to: self class instSize do: [ :index |
		dictionary 
			at: (self class instVarNameForIndex: index)
			put: (self instVarAt: index)
	].
	^ dictionary! !

!GTSpotterEventRecorderSettings methodsFor: 'accessing' stamp: 'JurajKubelka 3/9/2015 11:25'!
secretUUID: anUUID
	secretUUID := anUUID! !

!GTSpotterEventRecorderSettings methodsFor: 'converting' stamp: 'JurajKubelka 2/28/2015 16:04'!
dictionary: aCollection 
	aCollection keysAndValuesDo: [ :key :value | | instVarIndex |
		instVarIndex := self class instVarIndexFor: key.
		instVarIndex isZero ifFalse: [ 
			self instVarAt: instVarIndex put: value
		]
	]! !

!GTSpotterEventRecorderSettings class methodsFor: 'load and saving' stamp: 'JurajKubelka 3/9/2015 11:25'!
loadPreferences
	"self loadPreferences"
	| dictionary newInstance |
	self preferences exists ifFalse: [ 
		"This is a new computer, so we define new computer UUID.
		User still has to agree about sending data if it is not has been done yet."
		^ self savePreferences ].
	[ 
		dictionary := FLMaterializer materializeFromFileNamed: self preferences.
		newInstance := self new dictionary: dictionary.
		"If UUIDs are different, it is likely different user and we should use
		localy stored settings. If the UUIDs are same, we keep settings of the image."
		newInstance computerUUID = self uniqueInstance computerUUID
			ifFalse: [ uniqueInstance := newInstance ]
			ifTrue: [ self uniqueInstance secretUUID: newInstance secretUUID ].
		self saveMissingAttributes: self uniqueInstance dictionary comparingWithOld: dictionary.
	] on: Error do: [ 
		"Preferences likely contains a different settings version, so we store the actual one.
		We should keep the preferences as stable as possible."
		self savePreferences ]! !

!GTSpotterEventRecorderSettings class methodsFor: 'load and saving' stamp: 'AndreiChis 3/18/2015 14:00'!
ensureComputerID

	self loadPreferences
	! !

!GTSpotterEventRecorderSettings class methodsFor: 'accessing' stamp: 'JurajKubelka 2/25/2015 17:04'!
reset
	"self reset"
	uniqueInstance := nil! !

!GTSpotterEventRecorderSettings class methodsFor: 'accessing' stamp: 'JurajKubelka 2/27/2015 16:08'!
url
	^ url ifNil: [ url := 'http://gc.dcc.uchile.cl.:8080/gt/events' asZnUrl ]! !

!GTSpotterEventRecorderSettings class methodsFor: 'load and saving' stamp: 'JurajKubelka 3/10/2015 10:21'!
persistSettings
	SettingBrowser new exportSettings! !

!GTSpotterEventRecorderSettings class methodsFor: 'accessing' stamp: 'JurajKubelka 3/10/2015 07:16'!
sendUsageData
	^ sendUsageData ifNil: [ sendUsageData := false ]! !

!GTSpotterEventRecorderSettings class methodsFor: 'accessing' stamp: 'JurajKubelka 3/29/2015 14:33'!
uniqueInstance
	"self uniqueInstance"
	^ uniqueInstance ifNil: [ 
			uniqueInstance := self new ].! !

!GTSpotterEventRecorderSettings class methodsFor: 'accessing' stamp: 'AndreiChis 3/18/2015 13:58'!
sendUsageData: aBoolean
	sendUsageData := aBoolean.! !

!GTSpotterEventRecorderSettings class methodsFor: 'accessing' stamp: 'JurajKubelka 2/27/2015 16:08'!
stringUrl
	^ self url asString! !

!GTSpotterEventRecorderSettings class methodsFor: 'origins' stamp: 'JurajKubelka 2/26/2015 18:40'!
preferences
	^ FileLocator preferences / 'org.pharo.gt.spotter.event.recorder.fuel' ! !

!GTSpotterEventRecorderSettings class methodsFor: 'cleanup' stamp: 'AndreiChis 3/17/2015 17:55'!
cleanUp
	"Clean announcer, unique instance, and settings."
	
	self reset.
	sendUsageData := nil.! !

!GTSpotterEventRecorderSettings class methodsFor: 'accessing' stamp: 'JurajKubelka 3/10/2015 07:16'!
url: aZnUrl
	url := aZnUrl ifNotNil: [ aZnUrl asZnUrl ].! !

!GTSpotterEventRecorderSettings class methodsFor: 'load and saving' stamp: 'JurajKubelka 2/26/2015 18:58'!
deletePreferences
	"self deletePreferences"
	[ self preferences ensureDelete ]
	on: Error do: [ "ignore" ]! !

!GTSpotterEventRecorderSettings class methodsFor: 'settings' stamp: 'AndreiChis 3/17/2015 17:07'!
settingsOnSendUsageData: aBuilder 
	<systemsettings>
	
	(aBuilder setting: #sendUsageData)
		parent: #gt;
		target: self;
		description: 'If checked, annonymous usage data is collected and regularly send to a remote server. Only information about how you use the GTools is collected (e.g., open, close, select, enter search query, dive in result). No method names, class names or any other piece of code is collected.' translated;
		label: 'Send annonymous usage data'
! !

!GTSpotterEventRecorderSettings class methodsFor: 'load and saving' stamp: 'JurajKubelka 3/9/2015 11:19'!
saveMissingAttributes: imageDictionary comparingWithOld: diskDictionary
	"It saves to the disk items that are included in imageDictionary,
	but are missing in diskDictionary. Useful when a new version of the event
	recorder adds new configuration values that should be saved too."
	| difference newDiskDictionary |
	difference := imageDictionary keys difference: diskDictionary keys.
	difference ifEmpty: [ ^ self ].
	newDiskDictionary := diskDictionary copy.
	difference do: [ :eachKey |
		newDiskDictionary at: eachKey put: (imageDictionary at: eachKey) ].
	self savePreferences: newDiskDictionary.! !

!GTSpotterEventRecorderSettings class methodsFor: 'settings' stamp: 'JurajKubelka 2/25/2015 14:38'!
settingsOnUrl: aBuilder 
	<systemsettings>
	
	(aBuilder setting: #stringUrl)
		parent: #gt;
		target: self;
		description: 'The url for the Spotter Event Recorder server.' translated;
		label: 'Spotter Event Recorder URL address'
! !

!GTSpotterEventRecorderSettings class methodsFor: 'load and saving' stamp: 'JurajKubelka 3/9/2015 11:05'!
savePreferences
	"self savePreferences"
	self savePreferences: self uniqueInstance dictionary.! !

!GTSpotterEventRecorderSettings class methodsFor: 'load and saving' stamp: 'JurajKubelka 3/9/2015 11:05'!
savePreferences: aDictionary
	"self savePreferences: Dictionary new."
	self deletePreferences.
	[ FLSerializer serialize: aDictionary toFileNamed: self preferences ]
		on: Error do: [ "ignore" ]! !

!GTSpotterEventRecorderSettings class methodsFor: 'accessing' stamp: 'JurajKubelka 2/27/2015 16:08'!
stringUrl: aUrlString
	^ self url: aUrlString! !

!GTSpotterEventRecorderTest commentStamp: '<historical>'!
A GTSpotterEventRecorderTest is a test class for testing the behavior of GTSpotterEventRecorder!
!GTSpotterEventRecorderTest methodsFor: 'tests' stamp: 'JurajKubelka 3/29/2015 14:19'!
testPostponeSomeDataOnExit
	| maybeDeliveredData toBeDeliveredData postponedData |
	self assert: recorder postponedData isNil.
	maybeDeliveredData := recorder newCollectionWithPostponedData.
	self assert: maybeDeliveredData size equals: 0.
	maybeDeliveredData 
		add: GTSpotterRecorderOpenEvent new;
		add: GTSpotterRecorderShowPreviewEvent new;
		add: GTSpotterRecorderExitAnnouncementEvent new;
		add: GTSpotterRecorderOpenEvent new;
		add: GTSpotterRecorderShowPreviewEvent new;
		add: GTSpotterRecorderExitAnnouncementEvent new;
		add: GTSpotterRecorderOpenEvent new;
		add: GTSpotterRecorderShowPreviewEvent new.
	toBeDeliveredData := recorder postponeSomeData: maybeDeliveredData.
	postponedData := recorder postponedData.
	self assert: toBeDeliveredData size equals: 6.
	self assert: postponedData size equals: 2.
	1 to: 6 do: [ :index |
		self assert: (maybeDeliveredData at: index) == (toBeDeliveredData at: index) ].
	7 to: 8 do: [ :index |
		self assert: (maybeDeliveredData at: index) == (postponedData at: index - 6) ].
	"second delivery"
	maybeDeliveredData := recorder newCollectionWithPostponedData.
	self assert: recorder postponedData isNil.
	self assert: maybeDeliveredData size equals: 2.
	1 to: 2 do: [ :index |
		self assert: (maybeDeliveredData at: index) == (postponedData at: index) ].
	self assert: recorder postponedData isNil.
	maybeDeliveredData
		add: GTSpotterRecorderExitAnnouncementEvent new.
	toBeDeliveredData := recorder postponeSomeData: maybeDeliveredData.
	postponedData := recorder postponedData.
	self assert: toBeDeliveredData size equals: 3.
	self assert: postponedData isNil.
	1 to: 3 do: [ :index |
		self assert: (maybeDeliveredData at: index) == (toBeDeliveredData at: index) ].
! !

!GTSpotterEventRecorderTest methodsFor: 'asserting' stamp: 'JurajKubelka 4/1/2015 10:37'!
assertVersion: aMethodName
	| announcement |
	announcement := recorder materialize: (self perform: aMethodName).
	self assertAnnouncement: announcement.
	checkedEvents addAll: (announcement materializedData collect: #class).! !

!GTSpotterEventRecorderTest methodsFor: 'enumerating' stamp: 'JurajKubelka 4/10/2015 09:31'!
versionsDo: aBlock
	self allPragmaVersions do: [ :eachPragmaVersion | | announcement |
		announcement := self materializePragmaVersion: eachPragmaVersion.
		aBlock cull: announcement cull: eachPragmaVersion selector.
	]! !

!GTSpotterEventRecorderTest methodsFor: 'tests' stamp: 'JurajKubelka 3/29/2015 14:16'!
testPrimitivePrepareDeliveryData
	| maybeDeliveredData  postponedData bytes announcement events |
	self assert: recorder postponedData isNil.
	maybeDeliveredData := OrderedCollection new.
	maybeDeliveredData 
		add: GTSpotterRecorderOpenEvent new;
		add: GTSpotterRecorderShowPreviewEvent new;
		add: GTSpotterRecorderExitAnnouncementEvent new;
		add: GTSpotterRecorderOpenEvent new;
		add: GTSpotterRecorderShowPreviewEvent new;
		add: GTSpotterRecorderExitAnnouncementEvent new;
		add: GTSpotterRecorderOpenEvent new;
		add: GTSpotterRecorderShowPreviewEvent new.
	maybeDeliveredData do: [ :each | recorder recordedData nextPut: each ].
	recorder primitivePrepareDeliveryData.
	postponedData := recorder postponedData.
	self assert: postponedData size equals: 2.
	7 to: 8 do: [ :index |
		self assert: (maybeDeliveredData at: index) == (postponedData at: index - 6) ].
	"second delivery"
	recorder recordedData nextPut: GTSpotterRecorderExitAnnouncementEvent new.
	recorder primitivePrepareDeliveryData.
	postponedData := recorder postponedData.
	self assert: postponedData isNil.
	self assert: recorder deliveryQueue size equals: 2.
	"first delivered data"
	bytes := recorder deliveryQueue nextOrNil.
	self assert: bytes notNil.
	announcement := recorder materialize: bytes.
	events := announcement materializedData.
	self assert: events size equals: 6.
	events withIndexDo: [ :eachEvent :index |
		self assert: (maybeDeliveredData at: index) class = eachEvent class ].
	"second delivered data"
	bytes := recorder deliveryQueue nextOrNil.
	self assert: bytes notNil.
	announcement := recorder materialize: bytes.
	events := announcement materializedData.
	self assert: events size equals: 3.
	self assert: (maybeDeliveredData at: 7) class = events first class.
	self assert: (maybeDeliveredData at: 8) class = events second class.
	self assert: events third class = GTSpotterRecorderExitAnnouncementEvent.! !

!GTSpotterEventRecorderTest methodsFor: 'asserting' stamp: 'JurajKubelka 4/1/2015 10:19'!
assertAnnouncement: announcement
	self assert: announcement notNil.
	self assert: (announcement isKindOf: GTSpotterRecorderDataAnnouncement).
	announcement materializedData do: [ :eachEvent |
		"Check that all instance variables have some value."
		1 to: eachEvent class instSize do: [ :index |
			self 
				assert: (eachEvent instVarAt: index) notNil 
				description: [ String streamContents: [ :aStream |
						aStream 
							nextPutAll: 'Instance variable called ';
							print: (eachEvent class instVarNameForIndex: index);
							nextPutAll: ' of instance ';
							nextPutAll: eachEvent className;
							nextPutAll: ' is nil.' ] ]
		]
	]! !

!GTSpotterEventRecorderTest methodsFor: 'running' stamp: 'JurajKubelka 2/28/2015 15:34'!
setUp
	super setUp.
	recorder := GTSpotterEventRecorder new.
	recorder stopDelivering.! !

!GTSpotterEventRecorderTest methodsFor: 'tests' stamp: 'JurajKubelka 3/29/2015 14:20'!
testPostponeSomeDataOnAct
	| maybeDeliveredData toBeDeliveredData postponedData |
	self assert: recorder postponedData isNil.
	maybeDeliveredData := recorder newCollectionWithPostponedData.
	self assert: maybeDeliveredData size equals: 0.
	maybeDeliveredData 
		add: GTSpotterRecorderOpenEvent new;
		add: GTSpotterRecorderShowPreviewEvent new;
		add: GTSpotterRecorderExitAnnouncementEvent new;
		add: GTSpotterRecorderOpenEvent new;
		add: GTSpotterRecorderShowPreviewEvent new;
		add: GTSpotterRecorderActOnEvent new;
		add: GTSpotterRecorderOpenEvent new;
		add: GTSpotterRecorderShowPreviewEvent new.
	toBeDeliveredData := recorder postponeSomeData: maybeDeliveredData.
	postponedData := recorder postponedData.
	self assert: toBeDeliveredData size equals: 6.
	self assert: postponedData size equals: 2.
	1 to: 6 do: [ :index |
		self assert: (maybeDeliveredData at: index) == (toBeDeliveredData at: index) ].
	7 to: 8 do: [ :index |
		self assert: (maybeDeliveredData at: index) == (postponedData at: index - 6) ].
	"second delivery"
	maybeDeliveredData := recorder newCollectionWithPostponedData.
	self assert: recorder postponedData isNil.
	self assert: maybeDeliveredData size equals: 2.
	1 to: 2 do: [ :index |
		self assert: (maybeDeliveredData at: index) == (postponedData at: index) ].
	self assert: recorder postponedData isNil.
	maybeDeliveredData
		add: GTSpotterRecorderActOnEvent new.
	toBeDeliveredData := recorder postponeSomeData: maybeDeliveredData.
	postponedData := recorder postponedData.
	self assert: toBeDeliveredData size equals: 3.
	self assert: postponedData isNil.
	1 to: 3 do: [ :index |
		self assert: (maybeDeliveredData at: index) == (toBeDeliveredData at: index) ].
! !

!GTSpotterEventRecorderTest methodsFor: 'serialized data' stamp: 'JurajKubelka 4/10/2015 09:50'!
version2
	"Automatically created by class method #storeSerializedAnnouncementIntoMethod: #version2.
	It is a serialized event recorder announcement GTSpotterRecorderDataAnnouncement.
	It contatins all instances of the recorder events."
	<spotterEventRecorderSerializedData>
	^ #[31 139 8 0 0 0 0 0 0 0 115 11 117 245 97 56 196 200 192 192 192 207 0 1 236 34 110 62 238 57 249 73 137 57 206 57 137 197 197 206 57 165 197 37 169 69 64 9 86 14 55 31 143 212 196 148 212 34 33 207 148 212 188 146 204 146 74 151 204 228 146 204 252 188 196 162 74 46 167 202 146 212 224 202 220 164 252 28 65 255 34 160 154 212 20 231 252 156 156 84 176 60 127 104 94 74 106 90 102 94 106 138 127 82 22 80 72 206 205 39 32 191 56 179 36 179 44 213 34 56 55 49 39 199 51 175 36 53 61 181 8 97 23 51 3 35 147 24 208 186 252 252 236 128 162 204 92 176 82 132 44 35 51 127 81 106 114 62 200 154 176 212 162 98 160 13 120 212 178 2 253 227 150 89 1 179 27 73 134 145 69 178 160 40 213 55 17 200 205 76 204 201 172 74 4 185 213 17 236 226 98 193 196 148 148 76 176 223 114 32 250 138 165 10 242 139 75 176 43 230 207 69 21 150 117 243 65 132 12 34 24 144 172 102 2 17 146 110 62 193 153 185 5 57 169 216 148 48 177 64 227 131 129 151 135 143 11 164 156 147 3 38 194 13 196 146 80 54 23 174 232 98 227 4 69 137 99 81 81 34 52 114 74 138 50 243 210 145 226 137 219 5 232 106 199 188 148 144 204 220 84 69 247 144 224 130 252 18 160 206 32 104 192 2 37 19 29 243 242 242 75 243 146 83 115 129 177 205 133 240 145 60 34 250 12 205 176 199 31 227 188 41 184 163 132 137 73 197 212 34 197 196 40 37 209 76 55 217 210 210 88 215 36 49 197 80 215 194 204 200 68 215 52 45 197 204 200 194 220 210 216 204 208 128 35 32 35 177 40 223 68 207 128 112 114 97 226 192 147 90 128 33 169 90 167 108 154 114 107 2 195 150 245 255 175 94 0 7 27 80 68 50 55 170 131 97 109 25 84 4 183 126 14 102 206 204 220 196 244 84 143 196 226 12 150 20 96 176 8 23 167 22 131 18 157 115 81 42 56 186 65 1 200 147 156 159 91 80 10 212 16 26 234 233 194 89 2 20 41 46 73 204 45 16 73 45 3 134 93 16 106 98 229 201 1 6 124 113 73 104 1 208 176 84 30 176 217 80 25 164 144 53 54 194 17 178 172 91 253 116 132 221 124 64 241 136 153 162 129 190 125 38 223 13 75 40 83 67 125 131 133 13 37 238 77 91 231 16 169 241 212 155 177 112 77 77 71 124 71 87 211 188 35 151 90 173 74 79 5 124 152 87 22 159 97 50 123 205 201 109 1 252 114 50 252 247 246 252 146 183 169 184 32 121 92 114 191 127 220 156 143 139 246 31 94 108 126 54 47 58 106 123 78 164 241 229 187 239 38 171 159 159 188 39 255 147 219 125 175 212 41 250 138 174 129 73 94 91 75 249 94 206 12 61 244 169 67 133 83 72 201 211 235 16 155 158 245 21 61 219 205 108 39 24 236 38 152 53 220 186 177 110 205 131 166 94 73 215 61 66 123 67 55 42 134 27 126 238 57 178 57 166 232 128 135 145 211 129 183 253 185 129 204 219 12 89 149 103 239 87 95 40 92 149 54 151 51 231 177 145 206 83 31 23 143 89 183 54 48 239 121 120 117 97 203 33 229 75 125 27 127 191 150 153 173 183 245 162 244 171 142 66 13 131 227 207 244 10 20 101 111 21 132 238 148 147 125 127 117 239 236 42 167 137 129 221 135 101 85 236 13 149 126 40 22 61 219 245 230 92 196 145 137 137 9 229 185 75 172 252 122 34 125 110 176 79 78 126 182 255 67 203 188 76 151 101 130 109 106 175 55 124 150 184 106 108 153 19 197 194 183 168 69 121 107 141 198 222 168 248 43 11 203 203 175 78 148 251 185 59 246 183 253 139 233 235 126 92 121 149 118 46 105 219 159 91 43 88 181 79 166 204 249 254 38 69 240 162 172 65 80 234 204 35 97 151 186 120 226 103 169 61 237 42 147 88 191 99 201 178 39 110 210 220 217 103 63 47 233 143 232 106 208 76 141 89 235 194 157 206 43 189 225 220 194 158 196 235 169 95 214 120 188 79 205 202 73 18 86 227 11 57 51 237 207 150 34 215 109 183 215 44 125 213 193 49 35 251 105 163 113 170 101 185 11 111 142 199 254 103 51 206 108 97 91 39 214 251 203 64 62 42 139 255 246 233 41 155 132 116 77 196 108 174 57 157 142 114 168 109 154 207 124 132 219 85 54 88 167 203 116 246 71 177 73 119 74 111 174 106 248 191 237 250 174 41 47 221 39 115 191 23 159 167 189 62 254 223 207 143 119 239 106 243 125 122 117 116 15 251 79 131 138 203 221 54 149 175 28 237 254 198 124 86 152 47 94 95 57 241 248 102 185 39 143 11 246 139 87 86 95 106 222 243 243 219 213 215 95 223 108 103 175 84 191 255 219 99 246 226 123 197 21 137 156 218 81 187 119 45 154 38 168 217 88 127 52 96 119 238 78 237 214 94 31 237 166 151 102 151 55 220 40 208 158 61 249 93 196 194 35 59 107 242 79 25 79 155 54 247 239 180 205 194 145 158 87 24 227 239 22 220 88 252 250 180 141 208 140 155 146 51 110 202 206 144 228 61 115 133 201 248 183 178 220 178 95 11 88 62 57 109 180 208 110 16 232 225 190 191 176 182 209 55 169 113 230 222 123 47 191 136 101 181 219 55 127 114 48 89 113 109 211 18 155 39 219 214 123 220 201 46 127 209 187 224 237 244 223 11 214 190 125 43 24 36 123 182 243 168 112 231 145 3 151 46 124 221 248 243 225 206 100 110 247 245 61 49 126 42 110 250 114 251 77 234 116 39 74 236 89 245 167 254 178 222 28 123 83 75 211 226 178 95 119 102 222 188 108 254 143 233 208 207 45 89 182 192 4 142 179 84 103 101 228 74 129 23 85 132 75 98 54 80 14 7 21 166 28 162 156 130 28 2 188 194 220 66 60 124 98 252 226 34 236 18 0 254 125 218 6 28 7 0 0]! !

!GTSpotterEventRecorderTest methodsFor: 'accessing' stamp: 'JurajKubelka 4/10/2015 09:27'!
materializePragmaVersion: aPragma
	^ recorder materialize: (self perform: aPragma selector).! !

!GTSpotterEventRecorderTest methodsFor: 'tests' stamp: 'JurajKubelka 2/28/2015 15:45'!
testSerializedAnnouncementFrom
	| byteArray announcement |
	byteArray := recorder serializedAnnouncementFrom: self recordedData.
	announcement := recorder materializedAnnouncementFrom: byteArray.
	self assert: announcement class equals: GTSpotterRecorderDataAnnouncement.
	self assert: announcement materializedData isCollection.
	self assert: announcement materializedData size equals: self recordedData size.! !

!GTSpotterEventRecorderTest methodsFor: 'tests' stamp: 'JurajKubelka 4/10/2015 10:33'!
testDateAndTime
	self versionsDo: [ :announcement :version |
		announcement materializedData do: [ :eachEvent | | dateAndTime |
			dateAndTime := eachEvent dateAndTime.
			self assert: dateAndTime class equals: DateAndTime ] ]! !

!GTSpotterEventRecorderTest methodsFor: 'tests' stamp: 'JurajKubelka 4/10/2015 09:31'!
testMaterializeVersions
	| versions notMaterializedEvents |
	checkedEvents := Set new.
	versions := self allPragmaVersions.
	self assert: versions notEmpty.
	versions do: [ :eachPragma |
		self assertVersion: eachPragma selector ].
	self assert: checkedEvents notEmpty.
	notMaterializedEvents := GTSpotterRecorderEvent allSubclasses 
		removeAll: checkedEvents; 
		yourself.
	self 
		assert: notMaterializedEvents isEmpty
		description: [ 
			'Some events are not tested for backward compatibility.', String cr,
			'You should create new version using method #storeSerializedAnnouncementIntoMethod:.', String cr,
			'Do not override the existing serialized versions!!'
		]! !

!GTSpotterEventRecorderTest methodsFor: 'accessing' stamp: 'JurajKubelka 4/10/2015 09:31'!
allPragmaVersions
	^ Pragma allNamed: #spotterEventRecorderSerializedData in: self class.! !

!GTSpotterEventRecorderTest methodsFor: 'accessing' stamp: 'JurajKubelka 2/28/2015 15:32'!
recordedData
	^ GTSpotterRecorderEvent allSubclasses collect: #new! !

!GTSpotterEventRecorderTest methodsFor: 'serialized data' stamp: 'JurajKubelka 4/1/2015 10:27'!
version1
	"Automatically created by class method #storeSerializedAnnouncementIntoMethod: #version1.
	It is a serialized event recorder announcement GTSpotterRecorderDataAnnouncement.
	It contatins all instances of the recorder events."
	<spotterEventRecorderSerializedData>
	^ #[31 139 8 0 0 0 0 0 0 0 115 11 117 245 97 56 196 200 192 192 192 207 0 1 236 34 110 62 238 57 249 73 137 57 206 57 137 197 197 206 57 165 197 37 169 69 64 9 86 14 55 31 143 212 196 148 212 34 33 207 148 212 188 146 204 146 74 151 204 228 146 204 252 188 196 162 74 46 167 202 146 212 224 202 220 164 252 28 65 255 34 160 154 212 20 231 252 156 156 84 176 60 127 104 94 74 106 90 102 94 106 138 127 82 22 80 72 206 205 39 32 191 56 179 36 179 44 213 34 56 55 49 39 199 51 175 36 53 61 181 8 97 23 19 3 163 24 208 182 252 252 236 128 162 204 92 176 74 132 36 35 51 127 81 106 114 62 200 150 176 212 162 98 160 5 120 212 178 2 189 227 150 89 1 179 26 73 134 145 69 178 160 40 213 55 17 200 205 76 204 201 172 74 4 57 213 17 236 224 98 193 196 148 148 76 176 215 114 32 250 138 165 10 242 139 75 176 43 230 207 69 21 150 117 243 65 4 12 34 20 144 172 102 2 17 146 110 62 193 153 185 5 57 169 216 148 48 177 64 163 131 129 135 155 151 19 164 156 131 29 38 194 5 196 146 48 54 174 216 98 227 4 197 136 99 81 81 34 52 110 74 138 50 243 210 145 162 137 219 5 232 106 199 188 148 144 204 220 84 69 247 144 224 130 252 18 160 206 32 104 192 2 37 19 29 243 242 242 75 243 146 83 115 129 145 205 133 240 145 60 34 246 12 205 176 71 31 227 188 62 220 81 194 196 196 17 144 145 88 148 111 162 103 160 98 106 145 98 98 148 146 104 166 155 108 105 105 172 107 146 152 98 168 107 97 102 100 162 107 154 150 98 102 100 97 110 105 108 102 104 64 68 106 97 228 192 99 29 11 131 106 157 148 252 233 59 27 24 246 6 255 191 122 1 28 108 64 17 163 61 42 55 24 214 231 67 69 112 235 231 96 230 204 204 77 76 79 245 72 44 206 96 73 1 6 139 112 113 106 49 40 209 57 23 165 130 163 27 20 128 60 201 249 185 5 165 64 13 161 161 158 46 156 37 64 145 226 146 196 220 2 145 212 50 96 216 5 161 38 86 158 28 96 192 23 151 132 22 0 13 75 229 1 155 13 149 65 10 89 99 35 28 33 203 186 213 79 71 216 205 7 20 143 152 41 26 232 219 38 249 110 14 104 218 152 58 37 55 252 178 129 200 241 221 59 185 122 30 205 8 19 17 16 112 172 113 99 149 255 160 58 77 180 204 207 246 113 192 135 218 109 113 17 38 190 89 147 248 158 29 255 172 252 147 211 103 247 217 115 165 115 85 159 111 137 46 174 255 121 255 78 245 228 236 249 87 101 222 134 59 94 222 210 117 77 58 120 217 91 25 161 107 46 71 148 60 56 186 91 156 152 194 217 106 111 149 245 49 84 30 200 191 110 187 64 232 244 59 198 60 207 51 26 143 238 126 122 190 142 101 251 107 115 201 149 102 59 146 14 108 150 80 20 184 173 157 126 165 185 216 231 96 182 201 254 149 43 67 111 91 166 49 121 223 105 180 189 238 222 114 101 101 11 247 131 206 245 139 194 34 2 238 73 252 174 59 179 81 126 114 231 198 130 197 135 22 30 85 210 143 111 228 126 154 192 180 122 117 65 78 141 105 129 109 138 230 20 49 102 190 248 9 191 142 116 60 152 175 113 235 85 221 158 196 64 215 121 237 143 47 120 228 207 141 224 154 49 225 241 195 174 255 239 191 116 189 85 233 244 220 100 240 100 151 196 94 177 220 227 71 235 28 18 100 130 116 190 158 94 40 185 185 216 88 208 206 214 116 134 230 234 229 247 254 215 171 175 142 250 60 187 125 121 222 129 37 191 172 94 170 159 78 210 58 27 126 41 75 185 138 49 110 237 226 172 25 109 124 33 191 94 93 9 18 140 53 184 215 187 112 225 173 105 147 15 92 74 189 119 66 96 181 224 135 169 62 107 182 206 75 234 219 192 126 92 198 74 66 47 57 41 117 141 151 242 153 168 247 219 110 62 253 80 117 215 205 229 64 217 172 230 140 217 89 251 59 170 110 4 127 228 125 158 168 61 119 77 29 27 219 105 163 13 183 68 167 253 158 178 105 194 182 73 10 211 131 34 148 25 102 77 44 16 23 200 223 154 235 179 49 227 251 93 157 229 10 165 151 164 108 27 57 221 247 206 121 30 39 57 249 221 212 123 142 42 45 91 93 210 202 211 247 244 21 110 251 115 123 239 185 201 181 220 95 37 59 107 5 132 126 58 114 94 46 78 75 40 20 50 239 214 152 59 53 236 196 206 95 182 161 207 183 173 235 249 236 24 146 41 214 117 208 101 89 222 70 139 69 179 61 239 157 241 245 123 170 182 188 120 178 241 206 147 55 239 164 44 53 113 122 101 239 20 96 107 245 96 13 171 147 129 158 209 244 115 79 203 138 180 205 51 123 242 210 215 93 221 31 195 151 197 100 184 224 186 188 78 105 103 202 178 19 127 86 236 254 95 22 249 56 159 251 172 181 90 217 147 38 185 204 117 111 195 124 139 31 30 254 116 124 234 219 171 123 217 223 191 223 91 189 35 121 150 247 250 119 251 118 254 191 102 34 30 159 125 93 254 216 105 241 215 253 102 114 246 183 107 254 125 57 121 109 185 125 101 228 132 199 19 128 165 20 206 18 151 149 145 43 5 94 140 16 46 37 217 64 185 15 84 208 113 136 114 8 114 10 240 10 115 9 241 240 137 241 139 139 176 75 0 0 84 138 255 137 183 6 0 0]! !

!GTSpotterEventRecorderTest class methodsFor: 'accessing' stamp: 'JurajKubelka 4/1/2015 09:52'!
instancesForAllEvents
	"We instantiate all events and set all instance variables."
	^ GTSpotterRecorderEvent allSubclasses collect: [ :eachEventClass | | instance |
		instance := eachEventClass new.
		1 to: eachEventClass instSize do: [ :index |
			(instance instVarAt: index) ifNil: [ | variableName |
				variableName := eachEventClass instVarNameForIndex: index.
				(instance respondsTo: variableName) ifTrue: [ instance perform: variableName ] ].
			(instance instVarAt: index) ifNil: [ 
				instance instVarAt: index put: #value ] ].
		instance
	 ]! !

!GTSpotterEventRecorderTest class methodsFor: 'accessing' stamp: 'JurajKubelka 4/10/2015 09:51'!
storeSerializedAnnouncementIntoMethod: aSymbol
	"self storeSerializedAnnouncementIntoMethod: #version2"
	| methodSource |
	methodSource := (String streamContents: [ :aStream |
		aStream 
			nextPutAll: aSymbol asString; cr; 
			tab; 
			nextPutAll: '"Automatically created by class method #storeSerializedAnnouncementIntoMethod: ';
			print: aSymbol;
			nextPut: $.;
			cr; tab;
			nextPutAll: 'It is a serialized event recorder announcement GTSpotterRecorderDataAnnouncement.';
			cr; tab;
			nextPutAll: 'It contatins all instances of the recorder events."';
			cr; tab;
			nextPutAll: '<spotterEventRecorderSerializedData>';
			cr; tab;
			nextPutAll: '^ '.
		self serializeAnnouncementWithAllEvents storeOn: aStream. ]).
	self compile: methodSource classified: 'serialized data'.! !

!GTSpotterEventRecorderTest class methodsFor: 'accessing' stamp: 'JurajKubelka 4/1/2015 09:53'!
serializeAnnouncementWithAllEvents
	"self serializeAnnouncementWithAllEvents"
	| recorder |
	recorder := GTSpotterEventRecorder new.
	recorder stopDelivering. 
	^ recorder serializedAnnouncementFrom: self instancesForAllEvents.
	! !

!GTSpotterExceptionHandler methodsFor: 'private' stamp: 'StefanReichhart 3/22/2015 18:58'!
handleFatalException: anException
	('[Spotter] Fatal Exception: ', anException asString) logCr! !

!GTSpotterExceptionHandler methodsFor: 'public' stamp: 'StefanReichhart 3/17/2015 15:42'!
handleException: anException with: anObject
	^ self handleException: anException do: [ anObject ]! !

!GTSpotterExceptionHandler methodsFor: 'handling' stamp: 'StefanReichhart 3/22/2015 18:58'!
handleExceptionsDuring: aBlock
	[ GTCurrentSpotterExceptionHandler use: self during: aBlock ] 
		on: self 
		do: [ :exception | 
			[ self handleException: exception ] " handle any exception during aBlock "
				on: Error
				do: [ :fatalException | self handleFatalException: fatalException ] ] " handle exception caused while handling an exception "! !

!GTSpotterExceptionHandler methodsFor: 'public' stamp: 'StefanReichhart 3/17/2015 16:00'!
handleException: anException do: aBlock
	^ aBlock value! !

!GTSpotterExceptionHandler methodsFor: 'public' stamp: 'StefanReichhart 3/17/2015 16:01'!
handleException: anException
	^ self handleException: anException do: [ 
		('[Spotter] Exception: ', anException asString) logCr ]! !

!GTSpotterExceptionMock1 methodsFor: 'mocks' stamp: 'StefanReichhart 3/18/2015 18:54'!
mockProcessorFor: aSpotterStep
	<spotterOrder: 1>
	AssertionFailure signal: self messageText " Exception while creating the processor "! !

!GTSpotterExceptionMock1 methodsFor: 'mocks' stamp: 'StefanReichhart 3/18/2015 13:28'!
messageText
	^ self class name! !

!GTSpotterExceptionMock2 methodsFor: 'mocks' stamp: 'StefanReichhart 3/18/2015 18:55'!
mockProcessorFor: aSpotterStep
	<spotterOrder: 1>
	aSpotterStep listProcessor
		allCandidates: [ nil ]; " Exception while collecting candidates "
		itemName: [ :item | item asString ];
		filter: GTFilterSubstring! !

!GTSpotterExceptionMock3 methodsFor: 'mocks' stamp: 'StefanReichhart 3/18/2015 18:55'!
mockProcessorFor: aSpotterStep
	<spotterOrder: 1>
	aSpotterStep listProcessor
		allCandidates: [ #( 1 2 3 ) ];
		itemName: [ :item | item / 0 ]; " Exception while serializing candidates "
		filter: GTFilterSubstring! !

!GTSpotterExceptionMock4 methodsFor: 'mocks' stamp: 'StefanReichhart 3/18/2015 18:55'!
mockProcessorFor: aSpotterStep
	<spotterOrder: 1>
	aSpotterStep listProcessor
		allCandidates: [ #( 1 2 3 ) ];
		itemName: [ :item | item asString ];
		filter: GTSpotterExceptionMock4Filter " Exception while filtering "! !

!GTSpotterExceptionMock4Filter methodsFor: 'public' stamp: 'StefanReichhart 3/18/2015 18:56'!
value: aSpotterContext
	ArithmeticError signal: 'Error while filtering' " Exception while filtering "! !

!GTSpotterExceptionMock5 methodsFor: 'mocks' stamp: 'StefanReichhart 3/22/2015 18:47'!
mockProcessorFor: aSpotterStep
	" No Exceptions expected !! "
	<spotterOrder: 1>
	self assert: GTCurrentSpotterExceptionHandler value notNil.
	self assert: GTCurrentSpotterExceptionHandler value == aSpotterStep spotter exceptionHandler. 
	aSpotterStep listProcessor
		allCandidates: [
			self assert: GTCurrentSpotterExceptionHandler value notNil.
			self assert: GTCurrentSpotterExceptionHandler value == aSpotterStep spotter exceptionHandler. 
			#( 1 2 3 ) ];
		itemName: [ :item | 
			self assert: GTCurrentSpotterExceptionHandler value notNil.
			self assert: GTCurrentSpotterExceptionHandler value == aSpotterStep spotter exceptionHandler.
			item asString ];
		filter: GTSpotterExceptionMock5Filter! !

!GTSpotterExceptionMock5Filter methodsFor: 'public' stamp: 'StefanReichhart 3/22/2015 18:47'!
value: aSpotterContext
	" No Exceptions expected !! "
	| currentExceptionHandler |
	currentExceptionHandler := GTCurrentSpotterExceptionHandler value.
	self assert: currentExceptionHandler notNil.
	self assert: currentExceptionHandler == aSpotterContext exceptionHandler.
	self assert: currentExceptionHandler == aSpotterContext step exceptionHandler.
	self assert: currentExceptionHandler == aSpotterContext spotter exceptionHandler.
	^ #( 'done' )! !

!GTSpotterExceptionsTest methodsFor: 'private' stamp: 'StefanReichhart 3/18/2015 15:39'!
shouldRaise: anErrorClass process: aString origin: anOrigin during: exceptionHandler do: aBlock
	self assertResetExceptions.

	spotter exceptionHandler: exceptionHandler.
	self assert: spotter exceptionHandler == exceptionHandler.
	
	self should: [ self process: aString origin: anOrigin ] 
		raise: anErrorClass 
		withExceptionDo: [ :exception | 
			self assert: exception class == anErrorClass.
			aBlock value: exception. ].
		
	self assert: spotter exceptionHandler == exceptionHandler.
	
	self assertException: anErrorClass! !

!GTSpotterExceptionsTest methodsFor: 'tests' stamp: 'StefanReichhart 3/22/2015 18:35'!
testDebuggingExceptionHandlerMock1
	
	self shouldRaise: AssertionFailure process: 'abc' origin: GTSpotterExceptionMock1 new do: [:e | 
		self assert: e messageText = GTSpotterExceptionMock1 name ].! !

!GTSpotterExceptionsTest methodsFor: 'private' stamp: 'StefanReichhart 3/18/2015 14:11'!
shouldRaise: anErrorClass process: aString origin: anOrigin during: exceptionHandler
	self shouldRaise: anErrorClass process: aString origin: anOrigin during: exceptionHandler do: [ :e | ]! !

!GTSpotterExceptionsTest methodsFor: 'tests' stamp: 'StefanReichhart 3/22/2015 18:35'!
testDeploymentExceptionHandlerMock3
	
	self assertResetExceptions.
	self shouldntRaise: ZeroDivide process: 'abc' origin: GTSpotterExceptionMock3 new.
	self assertException: ZeroDivide.
	
	self assertResetExceptions.
	self shouldntRaise: Error process: 'abc' origin: GTSpotterExceptionMock3 new.
	self assertException: ZeroDivide.! !

!GTSpotterExceptionsTest methodsFor: 'private' stamp: 'StefanReichhart 3/18/2015 13:13'!
process: aString origin: anOrigin
	| step |
	((step := GTSpotterStep new)
		spotter: spotter;
		origin: anOrigin;
		yourself) processContext: (step newContextForQuery: aString)! !

!GTSpotterExceptionsTest methodsFor: 'private' stamp: 'StefanReichhart 3/18/2015 15:38'!
exceptionHandler: anExceptionHandler do: aBlock
	self assertResetExceptions.
	self shouldnt: [ 
		anExceptionHandler handleExceptionsDuring: aBlock ] raise: Error.
	self assertNoExceptions.
	
	self assertResetExceptions.
	self shouldnt: [ 
		spotter exceptionHandler: anExceptionHandler.
		spotter handleExceptionsDuring: aBlock ] raise: Error.
	self assertNoExceptions.! !

!GTSpotterExceptionsTest methodsFor: 'private' stamp: 'StefanReichhart 3/18/2015 15:43'!
shouldntRaise: anError process: aString origin: anOrigin during: exceptionHandler
	spotter exceptionHandler: exceptionHandler.
	self assert: spotter exceptionHandler == exceptionHandler.
	
	self shouldnt: [ self process: aString origin: anOrigin ] raise: anError.
	
	self assert: spotter exceptionHandler == exceptionHandler.! !

!GTSpotterExceptionsTest methodsFor: 'tests' stamp: 'StefanReichhart 3/22/2015 18:35'!
testDebuggingExceptionHandlerMock2

	self shouldRaise: MessageNotUnderstood process: 'abc' origin: GTSpotterExceptionMock2 new.! !

!GTSpotterExceptionsTest methodsFor: 'tests' stamp: 'StefanReichhart 3/22/2015 18:45'!
testDebuggingExceptionHandlerMock5
	
	self assertResetExceptions.
	self shouldntRaise: AssertionFailure process: 'abc' origin: GTSpotterExceptionMock5 new during: GTSpotterDebuggingExceptionHandlerMock new.
	self assertNoExceptions.! !

!GTSpotterExceptionsTest methodsFor: 'tests' stamp: 'StefanReichhart 3/22/2015 18:35'!
testDeploymentExceptionHandlerMock1
	
	self assertResetExceptions.
	self shouldntRaise: AssertionFailure process: 'abc' origin: GTSpotterExceptionMock1 new.
	self assertException: AssertionFailure.
	
	self assertResetExceptions.
	self shouldntRaise: Error process: 'abc' origin: GTSpotterExceptionMock1 new.
	self assertException: AssertionFailure.! !

!GTSpotterExceptionsTest methodsFor: 'tests' stamp: 'StefanReichhart 3/22/2015 18:35'!
testDevelopmentHandleExceptionMock5

	self assertResetExceptions.
	self should: [ 
		[ 1 / 0 ] on: ZeroDivide do: [ :exception |
			GTSpotterDebuggingExceptionHandlerMock new 
				handleException: exception 
				do: [ self fail: 'Ups, we shouldnt have reached this statement' ] ] ] raise: ZeroDivide.
	self assertException: ZeroDivide! !

!GTSpotterExceptionsTest methodsFor: 'tests' stamp: 'StefanReichhart 3/22/2015 18:35'!
testDebuggingExceptionHandlerMock3

	self shouldRaise: ZeroDivide process: 'abc' origin: GTSpotterExceptionMock3 new.
! !

!GTSpotterExceptionsTest methodsFor: 'private' stamp: 'StefanReichhart 3/18/2015 13:30'!
shouldRaise: anError process: aString origin: anOrigin
	self shouldRaise: anError process: aString origin: anOrigin do: [ :exception | ]! !

!GTSpotterExceptionsTest methodsFor: 'tests' stamp: 'StefanReichhart 3/22/2015 18:47'!
testDeploymentExceptionHandlerDuring
	| exceptionHandler |
	
	self exceptionHandler: (exceptionHandler := GTSpotterDeploymentExceptionHandlerMock new) do: [ 
		self shouldnt: [ GTCurrentSpotterExceptionHandler value ] raise: Error.
		self assert: GTCurrentSpotterExceptionHandler value notNil.
		self assert: GTCurrentSpotterExceptionHandler value == exceptionHandler ].! !

!GTSpotterExceptionsTest methodsFor: 'private' stamp: 'StefanReichhart 3/22/2015 18:34'!
shouldRaise: anError process: aString origin: anOrigin do: aBlock
	self shouldRaise: anError process: aString origin: anOrigin during: GTSpotterDebuggingExceptionHandlerMock new do: aBlock! !

!GTSpotterExceptionsTest methodsFor: 'tests' stamp: 'StefanReichhart 3/22/2015 18:35'!
testDeploymentExceptionHandlerMock4
	
	self assertResetExceptions.
	self shouldntRaise: ArithmeticError process: 'abc' origin: GTSpotterExceptionMock4 new.
	self assertException: ArithmeticError.
	
	self assertResetExceptions.
	self shouldntRaise: Error process: 'abc' origin: GTSpotterExceptionMock4 new.
	self assertException: ArithmeticError.! !

!GTSpotterExceptionsTest methodsFor: 'private' stamp: 'StefanReichhart 3/18/2015 15:35'!
assertNoExceptions
	self assert: self class exceptions isEmpty.
	self assert: self class fatals isEmpty.! !

!GTSpotterExceptionsTest methodsFor: 'private' stamp: 'StefanReichhart 3/22/2015 18:34'!
shouldntRaise: anError process: aString origin: anOrigin
	self shouldntRaise: anError process: aString origin: anOrigin during: GTSpotterDeploymentExceptionHandlerMock new! !

!GTSpotterExceptionsTest methodsFor: 'running' stamp: 'StefanReichhart 3/22/2015 18:34'!
setUp
	super setUp.
	
	spotter := GTSpotter new.
	self class reset.! !

!GTSpotterExceptionsTest methodsFor: 'private' stamp: 'StefanReichhart 3/18/2015 15:36'!
assertException: anErrorClass
	self deny: self class exceptions isEmpty.
	self assert: (self class exceptions anySatisfy: [ :e | e class == anErrorClass ]).
	self assert: self class fatals isEmpty.! !

!GTSpotterExceptionsTest methodsFor: 'tests' stamp: 'StefanReichhart 3/22/2015 18:35'!
testDeploymentHandleException

	self assertResetExceptions.
	self shouldnt: [ 
		[ 1 / 0 ] on: ZeroDivide do: [ :exception |
			self assert: (GTSpotterDeploymentExceptionHandlerMock new handleException: exception) notNil ] ] raise: ZeroDivide.
	self assertException: ZeroDivide.! !

!GTSpotterExceptionsTest methodsFor: 'tests' stamp: 'StefanReichhart 3/22/2015 18:35'!
testDeploymentExceptionHandlerMock2
	
	self assertResetExceptions.	
	self shouldntRaise: MessageNotUnderstood process: 'abc' origin: GTSpotterExceptionMock2 new.
	self assertException: MessageNotUnderstood.
	
	self assertResetExceptions.
	self shouldntRaise: Error process: 'abc' origin: GTSpotterExceptionMock2 new.
	self assertException: MessageNotUnderstood.! !

!GTSpotterExceptionsTest methodsFor: 'tests' stamp: 'StefanReichhart 3/22/2015 18:35'!
testDeploymentHandleExceptionMock5
	
	self assertResetExceptions.
	self shouldnt: [ 
		[ 1 / 0 ] on: ZeroDivide do: [ :exception |
			self assert: (GTSpotterDeploymentExceptionHandlerMock5 new 
				handleException: exception 
				do: [ 7 ]) == 7 ] ] raise: ZeroDivide.
	self assertException: ZeroDivide! !

!GTSpotterExceptionsTest methodsFor: 'tests' stamp: 'StefanReichhart 3/22/2015 18:35'!
testDevelopmentHandleException

	self assertResetExceptions.
	self should: [
		[ 1 / 0 ] on: ZeroDivide do: [ :exception |
			GTSpotterDebuggingExceptionHandlerMock new handleException: exception ] ] raise: ZeroDivide.
	self assertException: ZeroDivide.! !

!GTSpotterExceptionsTest methodsFor: 'private' stamp: 'StefanReichhart 3/18/2015 15:37'!
assertResetExceptions
	self class reset.
	self assertNoExceptions.! !

!GTSpotterExceptionsTest methodsFor: 'tests' stamp: 'StefanReichhart 3/22/2015 18:35'!
testDebuggingExceptionHandlerMock4

	self shouldRaise: ArithmeticError process: 'abc' origin: GTSpotterExceptionMock4 new do: [:e | 
		self assert: e messageText = 'Error while filtering' ].! !

!GTSpotterExceptionsTest methodsFor: 'tests' stamp: 'StefanReichhart 3/22/2015 18:47'!
testDebuggingExceptionHandlerDuring
	| exceptionHandler |
	
	self exceptionHandler: (exceptionHandler := GTSpotterDebuggingExceptionHandlerMock new) do: [ 
		self shouldnt: [ GTCurrentSpotterExceptionHandler value ] raise: Error.
		self assert: GTCurrentSpotterExceptionHandler value notNil.
		self assert: GTCurrentSpotterExceptionHandler value == exceptionHandler ].! !

!GTSpotterExceptionsTest methodsFor: 'tests' stamp: 'StefanReichhart 3/22/2015 18:45'!
testDeploymentExceptionHandlerMock5
	
	self assertResetExceptions.
	self shouldntRaise: AssertionFailure process: 'abc' origin: GTSpotterExceptionMock5 new during: GTSpotterDeploymentExceptionHandlerMock new.
	self assertNoExceptions.! !

!GTSpotterExceptionsTest class methodsFor: 'accessing' stamp: 'StefanReichhart 3/18/2015 15:03'!
exceptions
	^ exceptions ifNil: [ exceptions := OrderedCollection new ]! !

!GTSpotterExceptionsTest class methodsFor: 'accessing' stamp: 'StefanReichhart 3/18/2015 15:33'!
fatals
	^ fatals ifNil: [ fatals := OrderedCollection new ]! !

!GTSpotterExceptionsTest class methodsFor: 'accessing' stamp: 'StefanReichhart 3/18/2015 15:33'!
reset
	exceptions := nil.
	fatals := nil.! !

!GTSpotterExitAnnouncement methodsFor: 'accessing' stamp: 'AndreiChis 3/20/2015 19:36'!
eventType: anObject
	eventType := anObject! !

!GTSpotterExitAnnouncement methodsFor: 'accessing' stamp: 'AndreiChis 3/20/2015 19:36'!
eventType
	^ eventType! !

!GTSpotterGlobalShortcut commentStamp: 'TudorGirba 11/18/2014 02:57'!
KMRepository reset!
!GTSpotterGlobalShortcut methodsFor: 'shortcuts' stamp: 'AndreiChis 3/26/2015 15:51'!
keymapToggle
	"KMRepository reset"
	<shortcut>
	^ KMKeymap
			shortcut: Character cr shift
			action: [ self class openGlobalSpotter ]! !

!GTSpotterGlobalShortcut methodsFor: 'shortcuts' stamp: 'StefanReichhart 4/1/2015 19:43'!
keymapToggleDebug
	"KMRepository reset"
	<shortcut>
	^ KMKeymap
			shortcut: Character cr shift command
			action: [ self class openGlobalSpotterDebug ]! !

!GTSpotterGlobalShortcut class methodsFor: 'cleanup' stamp: 'JurajKubelka 3/30/2015 14:17'!
reset
	
	(World findA: GTSpotterMorph) ifNotNil: [ :aSpotterMorph | aSpotterMorph spotterModel exitDueTo: #reset ]! !

!GTSpotterGlobalShortcut class methodsFor: 'accessing' stamp: 'AndreiChis 3/26/2015 15:53'!
openGlobalSpotter
	| spotterModel |
		
	self reset.
	spotterModel := GTSpotter new.
	(Smalltalk hasClassNamed: #GTSpotterEventRecorder) ifTrue: [ 
		#GTSpotterEventRecorder asClass instance 
			perform: #linkToSpotter: with: spotterModel;
			perform: #recordSpotterOpenEvent ] .
	
	GTSpotterMorph new
		extent: (World width / 2.4 @ (World height / 1.6)) asIntegerPoint;
		spotterModel: spotterModel;
		doLayout;
		openCenteredInWorld.
		
	spotterModel class markOpened.! !

!GTSpotterGlobalShortcut class methodsFor: 'testing' stamp: 'TudorGirba 11/17/2014 22:30'!
isGlobalCategory
	^ true! !

!GTSpotterGlobalShortcut class methodsFor: 'accessing' stamp: 'StefanReichhart 4/1/2015 19:50'!
openGlobalSpotterDebug

	GTSpotterMorph new
		extent: (World width / 2.25 @ (World height / 1.25)) asIntegerPoint;
		spotterModel: (GTSpotter new
			beDebugging;
			yourself);
		openInWindowLabeled: 'Spotter Debug Mode';
		showPreview! !

!GTSpotterHeaderBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 3/3/2015 11:32'!
onHideHints

	self themer spotterThemer hintHideStyleFor: self settingsButton.
	self themer spotterThemer hintHideStyleFor: self closeButton.! !

!GTSpotterHeaderBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/23/2015 17:51'!
closeButton: aBrick

	closeButton ifNotNil: [self removeBrick: closeButton].
	closeButton := aBrick.
	
	self themer spotterThemer closeButtonWidgetStyleFor: closeButton.
	self themer spotterThemer closeButtonStyleFor: closeButton.
	
	closeButton
		hintTitle: 'Close Spotter';
		hintText: '<escape>';
		action: [ self spotterModel exitDueTo: #actionButton ].
	
	self addBrickBack: closeButton! !

!GTSpotterHeaderBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/24/2014 10:29'!
searchField

	^ searchField! !

!GTSpotterHeaderBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/3/2015 11:31'!
settingsButton

	^ settingsButton! !

!GTSpotterHeaderBrick methodsFor: 'instance creation' stamp: 'TudorGirba 2/28/2015 14:52'!
newSettingsButton

	^ GLMHintableActionButtonBrick new! !

!GTSpotterHeaderBrick methodsFor: 'brick-properties-events' stamp: 'AliakseiSyrel 3/23/2015 17:51'!
onThemerChanged
	super onThemerChanged.
	
	self themer spotterThemer headerWidgetStyleFor: self.
	self themer spotterThemer closeButtonWidgetStyleFor: self closeButton.
	self themer spotterThemer searchFieldWidgetStyleFor: self searchField.
	self themer spotterThemer settingsButtonWidgetStyleFor: self settingsButton! !

!GTSpotterHeaderBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 3/3/2015 11:33'!
onRevealHints

	self themer spotterThemer hintRevealStyleFor: self settingsButton.
	self themer spotterThemer hintRevealStyleFor: self closeButton! !

!GTSpotterHeaderBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 2/13/2015 00:58'!
newCloseButton

	^ GLMHintableActionButtonBrick new! !

!GTSpotterHeaderBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/23/2015 17:50'!
settingsButton: aBrick

	settingsButton ifNotNil: [self removeBrick: settingsButton].
	settingsButton := aBrick.
	
	self themer spotterThemer settingsButtonWidgetStyleFor: settingsButton.
	self themer spotterThemer settingsButtonStyleFor: settingsButton.
	
	settingsButton
		hintTitle: 'Settings';
		hintText: 'Shows the settings UI';
		action: [ self openSettingsBrowser ].
	
	self addBrickBack: settingsButton! !

!GTSpotterHeaderBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/26/2015 16:23'!
searchField: aBrick

	searchField := aBrick.
	
	self themer spotterThemer searchFieldStyleFor: searchField.
	
	searchField morph takeKeyboardFocus.
	
	self addBrickBack: searchField! !

!GTSpotterHeaderBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 3/26/2015 17:54'!
onCurrentStepChanged

	self searchField rubric updateTextWith: self spotterModel currentStep context text.
	self searchField rubric selectFrom: self searchField rubric text size + 1 to: self searchField rubric text size! !

!GTSpotterHeaderBrick methodsFor: 'initialization' stamp: 'AndreiChis 3/4/2015 14:25'!
initialize
	super initialize.
	
	self searchField: self newSearchField.
	#GTSpotterEventRecorderSettings asClassIfPresent: [ 
		self settingsButton: self newSettingsButton ].
	self closeButton: self newCloseButton.
	! !

!GTSpotterHeaderBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/24/2014 10:15'!
spotterModel

	^ spotterModel! !

!GTSpotterHeaderBrick methodsFor: 'instance creation' stamp: 'AliaskeiSyrel 11/8/2014 17:33'!
newStepsBand

	^ GLMBrick new! !

!GTSpotterHeaderBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/3/2015 11:30'!
spotterModel: aModel 

	spotterModel := aModel.
	self searchField morph on: spotterModel.

	spotterModel announcer weak subscribe: GTSpotterCurrentStepChanged send: #onCurrentStepChanged to: self.
	
	self spotterModel announcer weak subscribe: GTSpotterRevealHints send: #onRevealHints to: self.
	self spotterModel announcer weak subscribe: GTSpotterHideHints send: #onHideHints to: self.! !

!GTSpotterHeaderBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/3/2015 11:31'!
closeButton

	^ closeButton! !

!GTSpotterHeaderBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 3/26/2015 16:23'!
newSearchField

	^ GLMRubTextFieldBrick new! !

!GTSpotterHeaderBrick methodsFor: 'accessing' stamp: 'JurajKubelka 3/30/2015 14:13'!
openSettingsBrowser
	GTSpotterPrivacyAgreementNotificationBrick openSettingsBrowser.
	self spotterModel exitDueTo: #openSettingsBrowser.! !

!GTSpotterItemActionbarBrick methodsFor: 'adding' stamp: 'AliakseiSyrel 3/22/2015 11:52'!
addActActionButton

	actOnButton := (self newActionButtonBrick
			icon: self themer spotterThemer iconAct;
			hintTitle: 'Default action';
			hintText: '<enter>';
			action: [ self owner beSelected. self stepModel actDueTo: #actionButton ];
			yourself).

	self addActionButton: actOnButton.! !

!GTSpotterItemActionbarBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/28/2015 00:13'!
candidateLink
	^ candidateLink! !

!GTSpotterItemActionbarBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 2/28/2015 00:56'!
onHideHints

	self visible ifFalse: [ ^ self ].
	self themer spotterThemer hintHideStyleFor: self diveInButton.
	self themer spotterThemer hintHideStyleFor: self actOnButton.! !

!GTSpotterItemActionbarBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 2/28/2015 00:05'!
newActionButtonBrick

	^ GLMHintableActionButtonBrick new! !

!GTSpotterItemActionbarBrick methodsFor: 'brick-properties-events' stamp: 'AliakseiSyrel 3/21/2015 22:14'!
onThemerChanged
	super onThemerChanged.
	
	self subbricks do: [ :each | self themer spotterThemer itemActionButtonWidgetStyleFor: each ]! !

!GTSpotterItemActionbarBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 2/28/2015 00:57'!
onRevealHints

	self visible ifFalse: [ ^ self ].
	self themer spotterThemer hintRevealStyleFor: self diveInButton.
	self themer spotterThemer hintRevealStyleFor: self actOnButton! !

!GTSpotterItemActionbarBrick methodsFor: 'actions' stamp: 'AliakseiSyrel 2/28/2015 00:11'!
toggleHints

	self visible ifFalse: [ ^ self ].
	self stepModel spotter isShiftPressed
		ifTrue: [ self onRevealHints ]
		ifFalse: [ self onHideHints ]! !

!GTSpotterItemActionbarBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/28/2015 00:13'!
candidate

	^ self candidateLink value! !

!GTSpotterItemActionbarBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/28/2015 00:04'!
stepModel
	^ stepModel! !

!GTSpotterItemActionbarBrick methodsFor: 'adding' stamp: 'AliakseiSyrel 3/21/2015 22:14'!
addActionButton: anActionButton

	self themer spotterThemer itemActionButtonStyleFor: anActionButton.
	self themer spotterThemer itemActionButtonWidgetStyleFor: anActionButton.
		
	self addBrickBack: anActionButton.
	
	self stepModel spotter isShiftPressed
		ifTrue: [ self themer spotterThemer hintRevealStyleFor: anActionButton ].! !

!GTSpotterItemActionbarBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/28/2015 00:13'!
candidateLink: anObject
	candidateLink := anObject! !

!GTSpotterItemActionbarBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/28/2015 00:06'!
actOnButton
	^ actOnButton! !

!GTSpotterItemActionbarBrick methodsFor: 'adding' stamp: 'AliakseiSyrel 3/22/2015 11:52'!
addDiveInActionButton
			
	(self stepModel canDiveIn: self candidate) ifTrue: [
		diveInButton := (self newActionButtonBrick
			icon: self themer spotterThemer iconDiveIn;
			hintTitle: 'Dive in';
			hintText: '<cmd+right>';
			action: [ self owner beSelected. self stepModel diveInDueTo: #actionButton ];
			yourself).
		
		self addActionButton: diveInButton ]! !

!GTSpotterItemActionbarBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/28/2015 00:08'!
stepModel: anObject
	stepModel := anObject.
	
	self stepModel spotter announcer weak subscribe: GTSpotterRevealHints send: #onRevealHints to: self.
	self stepModel spotter announcer weak subscribe: GTSpotterHideHints send: #onHideHints to: self.
	
	self
		addActActionButton;
		addDiveInActionButton! !

!GTSpotterItemActionbarBrick methodsFor: 'actions' stamp: 'AliakseiSyrel 2/28/2015 00:11'!
visible: aBoolean
	super visible: aBoolean.
	
	self toggleHints
	
	! !

!GTSpotterItemActionbarBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/28/2015 00:06'!
diveInButton
	^ diveInButton! !

!GTSpotterItemBrick methodsFor: 'brick-properties-events' stamp: 'AliakseiSyrel 3/21/2015 22:06'!
onThemerChanged
	super onThemerChanged.
	
	self themer spotterThemer itemNormalWidgetStyleFor: self! !

!GTSpotterItemBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 12/11/2014 12:37'!
check

	self showActionbar.
	super check.
	self notifySelected! !

!GTSpotterItemBrick methodsFor: 'accessing' stamp: 'AliaskeiSyrel 11/13/2014 20:28'!
stepModel

	^ stepModel! !

!GTSpotterItemBrick methodsFor: 'actions' stamp: 'AliakseiSyrel 11/27/2014 11:49'!
beSelected
	self stepModel selected: self candidateLink
	! !

!GTSpotterItemBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/30/2015 16:07'!
labelBrick: aBrick

	labelBrick ifNotNil: [self removeBrick: labelBrick].
	labelBrick := aBrick.
	
	self themer spotterThemer itemLabelStyleFor: labelBrick.
	
	self addBrickBack: labelBrick! !

!GTSpotterItemBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/27/2014 11:31'!
actionbarBrick
	^ actionbarBrick! !

!GTSpotterItemBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 10/23/2014 20:02'!
handlesMouseDown: evt
	^ true! !

!GTSpotterItemBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/30/2015 16:07'!
iconBrick: aBrick

	iconBrick ifNotNil: [self removeBrick: iconBrick].
	iconBrick := aBrick.
	
	self themer spotterThemer itemIconStyleFor: iconBrick.
	
	self addBrickBack: iconBrick! !

!GTSpotterItemBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 1/29/2015 00:21'!
onStepPopped

	
	(self stepModel spotter steps last = self stepModel) & self isChecked ifTrue: [
		self notifySelected ]! !

!GTSpotterItemBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 1/30/2015 16:07'!
initialize
	super initialize.
	self enable.
	
	self themer spotterThemer itemNormalStyleFor: self.
	
	self iconBrick: self newIconBrick.
	self labelBrick: self newLabelBrick.
	self actionbarBrick: self newActionbarBrick.! !

!GTSpotterItemBrick methodsFor: 'brick-structure-events' stamp: 'AliakseiSyrel 1/29/2015 01:34'!
onRemovedFrom: aBrick
	super onRemovedFrom: aBrick.
	
	"I must not receive any announcements as soon as i'm removed from dom"
	self stepModel ifNotNil: [
		self stepModel announcer unsubscribe: self.
		self stepModel spotter announcer unsubscribe: self  ]! !

!GTSpotterItemBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 12/1/2014 23:20'!
uncheck
	
	super uncheck.
	
	self hideActionbar! !

!GTSpotterItemBrick methodsFor: 'actions' stamp: 'StefanReichhart 2/24/2015 17:10'!
highlightQuery
	self labelBrick label highlight: self stepModel context text! !

!GTSpotterItemBrick methodsFor: 'notifying' stamp: 'AliakseiSyrel 1/25/2015 19:17'!
notifySelected

	self stepModel spotter announce: (GTSpotterCandidateSelected new candidateBrick: self)! !

!GTSpotterItemBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/19/2014 00:13'!
candidateLink

	^ candidateLink! !

!GTSpotterItemBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 11/27/2014 11:32'!
newActionbarBrick

	^ GTSpotterItemActionbarBrick new! !

!GTSpotterItemBrick methodsFor: 'instance creation' stamp: 'TudorGirba 1/27/2015 23:42'!
newLabelBrick
	self flag: 'find a better number, or at least a better place for the number :)'.

	^ GLMLabelBrick new 
		text: 'Search result with very very long name';
		paddingRight: 16! !

!GTSpotterItemBrick methodsFor: 'accessing' stamp: 'AliaskeiSyrel 10/25/2014 18:34'!
text: aString

	self labelBrick text: aString.! !

!GTSpotterItemBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/30/2015 16:07'!
actionbarBrick: aBrick

	actionbarBrick ifNotNil: [self removeBrick: actionbarBrick].
	actionbarBrick := aBrick.
	
	self themer spotterThemer itemActionbarStyleFor: aBrick.
	
	self addBrickBack: actionbarBrick! !

!GTSpotterItemBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 10/24/2014 10:27'!
newIconBrick

	^ GLMInteractableBrick new normalImage: ((Form extent: 16@16 depth: 32) fillAlpha: 0)! !

!GTSpotterItemBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/18/2014 14:26'!
labelBrick
	^ labelBrick! !

!GTSpotterItemBrick methodsFor: 'actions' stamp: 'AliakseiSyrel 2/4/2015 19:58'!
hideActionbar
		
	self actionbarBrick visible: false! !

!GTSpotterItemBrick methodsFor: 'actions' stamp: 'AliakseiSyrel 2/4/2015 19:58'!
showActionbar

	self actionbarBrick visible: true! !

!GTSpotterItemBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/28/2015 00:14'!
candidateLink: aDoubleLink 

	candidateLink := aDoubleLink.
	
	self actionbarBrick candidateLink: self candidateLink! !

!GTSpotterItemBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/24/2014 09:57'!
icon: aForm

	self iconBrick normalImage: aForm.! !

!GTSpotterItemBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/18/2014 14:26'!
iconBrick
	^ iconBrick! !

!GTSpotterItemBrick methodsFor: 'event handling' stamp: 'AndreiChis 3/20/2015 19:20'!
singleClick: evt

	self stepModel selected: self candidateLink dueTo: #singleClick! !

!GTSpotterItemBrick methodsFor: 'brick-layout-events' stamp: 'AliakseiSyrel 2/10/2015 14:30'!
onLayouted
	super onLayouted.
	
	self isChecked ifTrue: [ self stepModel spotter announce: GTSpotterCandidateSelectedMoved new ]! !

!GTSpotterItemBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 11/27/2014 12:55'!
onSelectedChanged: ann

	self checkOrUncheck! !

!GTSpotterItemBrick methodsFor: 'event handling' stamp: 'AndreiChis 1/23/2015 17:33'!
mouseDown: evt
	|selectors|
	
	self isEnabled ifFalse: [ ^ self ].
	
	selectors := Array
				with: #singleClick:
				with: #doubleClick:
				with: nil
				with: nil.
				
	evt hand
		waitForClicksOrDrag: self
		event: evt
		selectors: selectors
		threshold: 10
	! !

!GTSpotterItemBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/28/2015 00:12'!
stepModel: aModel

	stepModel := aModel.
	
	stepModel announcer weak subscribe: GTSpotterSelectedCandidateChanged send: #onSelectedChanged: to: self.
	stepModel spotter announcer weak subscribe: GTSpotterStepPopped send: #onStepPopped to: self.
	
	self actionbarBrick stepModel: aModel.
	
	self
		highlightQuery;
		checkOrUncheck.! !

!GTSpotterItemBrick methodsFor: 'event handling' stamp: 'AndreiChis 3/20/2015 19:30'!
doubleClick: evt

	self stepModel actDueTo: #doubleClick! !

!GTSpotterItemBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 11/27/2014 12:57'!
checkOrUncheck

	self stepModel selected = self candidateLink
		ifTrue: [ self isChecked ifFalse: [ self check ] ]
		ifFalse: [ self isChecked ifTrue: [ self uncheck ] ]! !

!GTSpotterIterator methodsFor: 'mimic various enumerating' stamp: 'StefanReichhart 3/22/2015 23:04'!
detect: aBlock ifNone: aBlock2
	^ self detect: aBlock ifFound: [ :each | each ] ifNone: aBlock2! !

!GTSpotterIterator methodsFor: 'mimic various enumerating' stamp: 'StefanReichhart 3/22/2015 23:02'!
detect: aBlock
	^ self detect: aBlock ifNone: [ NotFound signalFor: aBlock ]! !

!GTSpotterIterator methodsFor: 'mimic enumerating' stamp: 'StefanReichhart 3/23/2015 10:27'!
withIndexDo: aBlock
	| index |
	index := 0.
	self do: [ :each | aBlock cull: each cull: (index := index + 1) ]! !

!GTSpotterIterator methodsFor: 'mimic various enumerating' stamp: 'StefanReichhart 3/22/2015 22:59'!
reject: aBlock
	^ self reject: aBlock as: self defaultItemsClass! !

!GTSpotterIterator methodsFor: 'mimic collection' stamp: 'StefanReichhart 3/22/2015 22:39'!
asOrderedCollection
	^ self items copy " we must not expose the internal representation !! "! !

!GTSpotterIterator methodsFor: 'public' stamp: 'StefanReichhart 3/20/2015 11:19'!
gtIterator
	^ self! !

!GTSpotterIterator methodsFor: 'mimic various enumerating' stamp: 'StefanReichhart 3/22/2015 22:50'!
select: aBlock as: aCollectionClass
	| collection |
	collection := self newAs: aCollectionClass.
	self do: [ :each | 
		(aBlock value: each) 
			ifTrue: [ collection add: each ] ].
	^ collection! !

!GTSpotterIterator methodsFor: 'mimic collection' stamp: 'StefanReichhart 3/22/2015 22:29'!
first: anInteger
	^ self items copyFrom: 1 to: (self size min: (anInteger max: 0))! !

!GTSpotterIterator methodsFor: 'public' stamp: 'StefanReichhart 3/20/2015 15:18'!
value: aContext
	self context: aContext! !

!GTSpotterIterator methodsFor: 'testing' stamp: 'StefanReichhart 3/20/2015 11:48'!
hasDynamicItems
	^ true! !

!GTSpotterIterator methodsFor: 'mimic various enumerating' stamp: 'StefanReichhart 3/22/2015 22:53'!
collect: aBlock as: aCollectionClass
	| collection |
	collection := self newAs: aCollectionClass.
	self do: [ :each | 
		collection add: (aBlock value: each) ].
	^ collection! !

!GTSpotterIterator methodsFor: 'mimic collection' stamp: 'StefanReichhart 3/22/2015 22:29'!
last: anInteger
	^ self items last: (self size min: (anInteger max: 0))! !

!GTSpotterIterator methodsFor: 'accessing-defaults' stamp: 'StefanReichhart 3/22/2015 22:56'!
defaultItems
	^ self defaultItemsClass new ! !

!GTSpotterIterator methodsFor: 'mimic various enumerating' stamp: 'StefanReichhart 3/22/2015 23:00'!
anySatisfy: aBlock
	self do: [ :each | (aBlock value: each) ifTrue: [ ^ true ] ].
	^ false! !

!GTSpotterIterator methodsFor: 'private' stamp: 'StefanReichhart 3/20/2015 15:41'!
itemDo: aBlock
	self subclassResponsibility! !

!GTSpotterIterator methodsFor: 'mimic various enumerating' stamp: 'StefanReichhart 3/22/2015 22:59'!
reject: aBlock as: aCollectionClass
	| collection |
	collection := self newAs: aCollectionClass.
	self do: [ :each | 
		(aBlock value: each) 
			ifFalse: [ collection add: each ] ].
	^ collection! !

!GTSpotterIterator methodsFor: 'mimic various enumerating' stamp: 'StefanReichhart 3/22/2015 22:58'!
reject: aBlock thenDo: aBlock2
	self do: [ :each | 
		(aBlock value: each) 
			ifFalse: [ aBlock2 value: each ] ]! !

!GTSpotterIterator methodsFor: 'mimic various enumerating' stamp: 'StefanReichhart 3/22/2015 22:57'!
select: aBlock thenCollect: aBlock2
	^ self select: aBlock thenCollect: aBlock2 as: self defaultItemsClass! !

!GTSpotterIterator methodsFor: 'mimic various enumerating' stamp: 'StefanReichhart 3/22/2015 22:50'!
select: aBlock thenDo: aBlock2
	self do: [ :each | 
		(aBlock value: each) 
			ifTrue: [ aBlock2 value: each ] ]! !

!GTSpotterIterator methodsFor: 'mimic collection' stamp: 'StefanReichhart 3/20/2015 16:04'!
asArray
	^ self items asArray! !

!GTSpotterIterator methodsFor: 'accessing' stamp: 'StefanReichhart 3/22/2015 22:22'!
context: aContext
	" we assume that if the context changes, so will the result of the iterator - so we reset the internal collection "
	context := aContext.
	self reset.! !

!GTSpotterIterator methodsFor: 'mimic collection' stamp: 'StefanReichhart 3/20/2015 13:14'!
isEmpty
	^ self items isEmpty! !

!GTSpotterIterator methodsFor: 'private' stamp: 'StefanReichhart 3/22/2015 22:49'!
newAs: aCollectionClass
	^ items 
		ifNil: [ aCollectionClass new ] 
		ifNotNil: [ aCollectionClass new: self size ]! !

!GTSpotterIterator methodsFor: 'mimic collection' stamp: 'StefanReichhart 3/20/2015 12:59'!
size
	^ self items size! !

!GTSpotterIterator methodsFor: 'public' stamp: 'StefanReichhart 3/20/2015 15:18'!
cull: aContext
	self context: aContext! !

!GTSpotterIterator methodsFor: 'public' stamp: 'StefanReichhart 3/22/2015 22:22'!
reset
	items := nil.! !

!GTSpotterIterator methodsFor: 'accessing-defaults' stamp: 'StefanReichhart 3/22/2015 22:56'!
defaultItemsClass
	^ OrderedCollection ! !

!GTSpotterIterator methodsFor: 'mimic collection' stamp: 'StefanReichhart 3/22/2015 22:30'!
notEmpty
	^ self isEmpty not! !

!GTSpotterIterator methodsFor: 'mimic various enumerating' stamp: 'StefanReichhart 3/22/2015 22:57'!
select: aBlock
	^ self select: aBlock as: self defaultItemsClass! !

!GTSpotterIterator methodsFor: 'mimic collection' stamp: 'StefanReichhart 3/22/2015 22:47'!
asSet
	^ self items asSet! !

!GTSpotterIterator methodsFor: 'mimic various enumerating' stamp: 'StefanReichhart 3/22/2015 22:57'!
collect: aBlock
	^ self collect: aBlock as: self defaultItemsClass! !

!GTSpotterIterator methodsFor: 'mimic various enumerating' stamp: 'StefanReichhart 3/22/2015 23:04'!
detect: aBlock ifFound: aBlock2 ifNone: aBlock3
	self do: [ :each | aBlock value ifTrue: [ ^ aBlock2 value: each ] ].
	^ aBlock3 value! !

!GTSpotterIterator methodsFor: 'mimic enumerating' stamp: 'StefanReichhart 3/22/2015 22:57'!
do: aBlock
	" the iterator must keep an internal collection of items being iterated. This guarantees that the iteration is not done multiple times in case somebody sends multiple subsequent messages like #size, #items or #first:. This will slightly decrease performance while iterating "
	items 
		ifNotNil: [ 
			items do: aBlock ]
		ifNil: [ 
			items := self defaultItems.
			self itemDo: [ :each | 
				items add: each.
				aBlock value: each ] ]! !

!GTSpotterIterator methodsFor: 'mimic various enumerating' stamp: 'StefanReichhart 3/22/2015 23:00'!
allSatisfy: aBlock
	self do: [ :each | (aBlock value: each) ifFalse: [ ^ false ] ].
	^ true! !

!GTSpotterIterator methodsFor: 'mimic various enumerating' stamp: 'StefanReichhart 3/22/2015 22:53'!
select: aBlock thenCollect: aBlock2 as: aCollectionClass
	| collection |
	collection := self newAs: aCollectionClass.
	self select: aBlock thenDo: [ :each | 
		collection add: (aBlock2 value: each) ].
	^ collection! !

!GTSpotterIterator methodsFor: 'private' stamp: 'StefanReichhart 3/20/2015 13:14'!
items: anObject
	items := anObject! !

!GTSpotterIterator methodsFor: 'mimic various enumerating' stamp: 'StefanReichhart 3/22/2015 22:58'!
reject: aBlock thenCollect: aBlock2 as: aCollectionClass
	| collection |
	collection := self newAs: aCollectionClass.
	self reject: aBlock thenDo: [ :each | 
		collection add: (aBlock2 value: each) ].
	^ collection! !

!GTSpotterIterator methodsFor: 'mimic collection' stamp: 'StefanReichhart 3/20/2015 16:01'!
isEmptyOrNil
	^ self items isEmptyOrNil! !

!GTSpotterIterator methodsFor: 'accessing' stamp: 'StefanReichhart 3/20/2015 15:11'!
context
	^ context! !

!GTSpotterIterator methodsFor: 'private' stamp: 'StefanReichhart 3/22/2015 22:57'!
items
	^ items ifNil: [ 
		items := self defaultItems.
		self itemDo: [ :each | 
			items add: each ] ]! !

!GTSpotterIterator class methodsFor: 'accessing' stamp: 'StefanReichhart 3/20/2015 11:21'!
gtIterator
	^ self new! !

!GTSpotterMorph methodsFor: 'actions' stamp: 'StefanReichhart 3/20/2015 09:10'!
diveOut
	self spotterModelDo: [ 
		self spotterModel popStep ]! !

!GTSpotterMorph methodsFor: 'initialization' stamp: 'StephanEggermont 12/8/2014 15:11'!
outOfWorld: aWorld
	super outOfWorld: aWorld.
	self unsubscribeListeners.
	
	self spotterModel ifNotNil: [:m | m terminateProcessors].
	
	"restoring previous focus"
	focusedMorph ifNotNil: [ focusedMorph takeKeyboardFocus ]! !

!GTSpotterMorph methodsFor: 'actions' stamp: 'AliakseiSyrel 1/29/2015 16:08'!
stepScrollPageDown

	self spotterModel currentStep announcer announce: (GTSpotterScrollPageDown new)! !

!GTSpotterMorph methodsFor: 'actions' stamp: 'AliakseiSyrel 1/29/2015 16:08'!
stepScrollPageUp

	self spotterModel currentStep announcer announce: (GTSpotterScrollPageUp new)! !

!GTSpotterMorph methodsFor: 'event handling' stamp: 'AliakseiSyrel 10/23/2014 19:58'!
handlesMouseDown: evt
	^ true! !

!GTSpotterMorph methodsFor: 'actions' stamp: 'AliakseiSyrel 11/19/2014 22:00'!
selectNextCategory

	self spotterModel isEmpty
		ifFalse: [ self spotterModel currentStep selectNextCategory ]
	! !

!GTSpotterMorph methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/20/2015 00:59'!
paneBrick

	^ paneBrick! !

!GTSpotterMorph methodsFor: 'instance creation' stamp: 'AliakseiSyrel 1/20/2015 01:05'!
newPaneBrick

	^ GTSpotterPaneBrick new! !

!GTSpotterMorph methodsFor: 'private' stamp: 'StefanReichhart 3/20/2015 09:11'!
spotterModelDo: aBlock
	self spotterModel handleExceptionsDuring: aBlock! !

!GTSpotterMorph methodsFor: 'initialization' stamp: 'AndreiChis 3/18/2015 15:50'!
initialize
	super initialize.
	"setting custom brick themer for the whole spotter"
	self themer: self themer spotterThemer themer.
	
	self initializeListeners.
	self themer spotterThemer spotterStyleFor: self.
	
	self breadcrumbBrick: self newBreadcrumbBrick.
	self paneBrick: self newPaneBrick.
	#GTSpotterEventRecorderSettings asClassIfPresent: [ 
		GTSpotter wasOpened ifFalse: [ self privacyAgreementNotificationBrick: self newPrivacyAgreementNotificationBrick ] ].
	
	
	! !

!GTSpotterMorph methodsFor: 'actions' stamp: 'AliakseiSyrel 1/26/2015 15:54'!
showPreview
	
	self spotterModel showPreview! !

!GTSpotterMorph methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/24/2014 10:20'!
spotterModel

	^ spotterModel! !

!GTSpotterMorph methodsFor: 'actions' stamp: 'AliakseiSyrel 2/24/2015 10:29'!
closeSpotter

	self autoHide ifTrue: [ self delete ]! !

!GTSpotterMorph methodsFor: 'actions' stamp: 'StefanReichhart 3/22/2015 18:25'!
diveInCategoryDueTo: anEventType

	self spotterModelDo: [
		self spotterModel isEmpty
			ifFalse: [ self spotterModel currentStep isEmpty 
				ifFalse: [ self spotterModel currentStep diveInCategoryDueTo: anEventType ] ] ]! !

!GTSpotterMorph methodsFor: 'actions' stamp: 'AndreiChis 3/20/2015 19:21'!
selectPreviousCandidateDueTo: anEventType

	self spotterModel isEmpty
		ifFalse: [ self spotterModel currentStep selectPreviousDueTo: anEventType ]
	! !

!GTSpotterMorph methodsFor: 'opening' stamp: 'AliakseiSyrel 1/19/2015 20:48'!
openInWindowLabeled: aString inWorld: aWorld
	self autoHide: false.
	^ super openInWindowLabeled: aString inWorld: aWorld! !

!GTSpotterMorph methodsFor: 'actions' stamp: 'AliakseiSyrel 1/26/2015 15:54'!
togglePreview

	self spotterModel togglePreview! !

!GTSpotterMorph methodsFor: 'events-processing' stamp: 'AliakseiSyrel 10/23/2014 20:24'!
onLostFocus: event

	focusedMorph ifNil: [ focusedMorph := event morph ]! !

!GTSpotterMorph methodsFor: 'events-processing' stamp: 'AndreiChis 3/20/2015 19:40'!
handleListenEvent: anEvent
		
	anEvent type = #mouseDown ifTrue: [ 
		((self fullBoundsInWorld containsPoint: anEvent position) not and: [ self autoHide ])
			ifTrue: [ self spotterModel ifNotNil: [ :aModel | aModel exitDueTo: #mouseDown ] ] ].
		
	anEvent type = #keyDown ifTrue: [ 
		self spotterModel
			ifNotNil: [ :s | s shiftPressed: (InputEventSensor default anyModifierKeyPressed not & InputEventSensor default shiftPressed) ] ].! !

!GTSpotterMorph methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/24/2015 10:28'!
spotterModel: aSpotter

	spotterModel := aSpotter.
	
	spotterModel announcer weak subscribe: GTSpotterExitAnnouncement send: #closeSpotter to: self.
	spotterModel announcer weak subscribe: GTSpotterShowPreview send: #onShowPreview to: self.
	spotterModel announcer weak subscribe: GTSpotterHidePreview send: #onHidePreview to: self.
	
	self breadcrumbBrick spotterModel: spotterModel.
	self paneBrick spotterModel: spotterModel.
	
	spotterModel class isPreviewVisible ifTrue: [ spotterModel showPreview ].
	
	"expanding drop down pane"
	self spotterModel setText: '' from: nil.
	self spotterModel currentStep process: nil.
	
	
	! !

!GTSpotterMorph methodsFor: 'actions' stamp: 'AndreiChis 3/20/2015 19:18'!
selectNextCandidateDueTo: anEventType

	self spotterModel isEmpty
		ifFalse: [ self spotterModel currentStep selectNextDueTo: anEventType ]
	! !

!GTSpotterMorph methodsFor: 'initialization' stamp: 'AndreiChis 3/20/2015 19:40'!
initializeListeners

	self activeHand addEventListener: self.
	
	Morph announcer weak on: MorphLostFocus send: #onLostFocus: to: self.
	
	self bindKeyCombination: Character escape toAction: [ self spotterModel exitDueTo: #keyPressedEscape ].
	self bindKeyCombination: $w command toAction: [ self spotterModel exitDueTo: #keyPressedW ].
	self bindKeyCombination: $p command toAction: [ self togglePreview ].
	
	self bindKeyCombination: Character arrowUp toAction: [ self selectPreviousCandidateDueTo: #keyPressedArrowUp ].
	self bindKeyCombination: Character arrowDown toAction: [ self selectNextCandidateDueTo: #keyPressedArrowDown ].
	self bindKeyCombination: Character arrowUp command toAction: [ self selectPreviousCandidateDueTo: #keyPressedArrowUp ].
	self bindKeyCombination: Character arrowDown command toAction: [ self selectNextCandidateDueTo: #keyPressedArrowDown ].
	self bindKeyCombination: Character arrowUp shift toAction: [ self selectPreviousCandidateDueTo: #keyPressedArrowUp ].
	self bindKeyCombination: Character arrowDown shift toAction: [ self selectNextCandidateDueTo: #keyPressedArrowDown ].
	
	self bindKeyCombination: Character arrowUp command shift toAction: [ self selectPreviousCategory ].
	self bindKeyCombination: Character arrowDown command shift toAction: [ self selectNextCategory ].
	
	self bindKeyCombination: Character arrowRight command toAction: [ self diveInDueTo: #keyPressed ].
	self bindKeyCombination: Character arrowLeft command toAction: [ self diveOut ].

	self bindKeyCombination: Character arrowRight command shift toAction: [ self diveInCategoryDueTo: #keyPressed ].
	self bindKeyCombination: Character arrowLeft command shift toAction: [ self diveOut ].
	
	self bindKeyCombination: Character arrowUp alt toAction: [ self stepScrollPageUp ].
	self bindKeyCombination: Character arrowDown alt toAction: [ self stepScrollPageDown ].
	self bindKeyCombination: Character pageUp toAction: [ self stepScrollPageUp ].
	self bindKeyCombination: Character pageDown toAction: [ self stepScrollPageDown ].
	
	self 
		bindKeyCombination: Character cr asKeyCombination 
		toAction: [ self actDueTo: #keyPressed ].
		
	self 
		bindKeyCombination: $p command shift 
		toAction: [ self exportAsPNGSilently ]! !

!GTSpotterMorph methodsFor: 'events-processing' stamp: 'AliakseiSyrel 1/30/2015 16:07'!
onShowPreview

	|delta|
	self paneBrick isPreviewShown ifTrue: [ ^ self ].
	delta := (((self width * 100) / (100 - self themer spotterThemer previewWidthPercent) - self width)@0) / 2.
	self bounds: (self bounds expandBy: delta).
	self paneBrick showPreview.
	self doLayout! !

!GTSpotterMorph methodsFor: 'events-processing' stamp: 'AliakseiSyrel 2/3/2015 23:51'!
onBreadcrumbVisibilityChanged

	self changed.! !

!GTSpotterMorph methodsFor: 'actions' stamp: 'StefanReichhart 3/22/2015 18:25'!
diveInDueTo: anEventType

	self spotterModelDo: [
		self spotterModel isEmpty ifFalse: [ 
			self spotterModel currentStep isEmpty ifFalse: [ 
				self spotterModel currentStep diveInDueTo: anEventType ] ] ]! !

!GTSpotterMorph methodsFor: 'instance creation' stamp: 'TudorGirba 11/26/2014 14:34'!
newBreadcrumbBrick

	^ GTSpotterStepsBreadcrumb new! !

!GTSpotterMorph methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/30/2015 16:07'!
paneBrick: aBrick
	
	paneBrick ifNotNil: [self removeBrick: paneBrick].
	paneBrick := aBrick.
		
	self themer spotterThemer spotterPaneStyleFor: paneBrick.

	self addBrickBack: paneBrick! !

!GTSpotterMorph methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/20/2014 11:49'!
breadcrumbBrick
	
	^ breadcrumbBrick! !

!GTSpotterMorph methodsFor: 'accessing' stamp: 'AndreiChis 3/16/2015 17:19'!
privacyAgreementNotificationBrick
	^ privacyAgreementNotificationBrick! !

!GTSpotterMorph methodsFor: 'events-processing' stamp: 'AliakseiSyrel 1/30/2015 16:07'!
onHidePreview
	|delta|
	self paneBrick isPreviewShown ifFalse: [ ^ self ].
	delta := ((self width - ((self width / 100) * (100 - self themer spotterThemer previewWidthPercent)))@0) negated / 2.
	self bounds: (self bounds expandBy: delta).
	self paneBrick hidePreview.
	self doLayout! !

!GTSpotterMorph methodsFor: 'accessing-defaults' stamp: 'StefanReichhart 2/24/2015 19:57'!
defaultLabel
	^ 'Spotter'! !

!GTSpotterMorph methodsFor: 'actions' stamp: 'AliakseiSyrel 1/26/2015 15:54'!
hidePreview
	
	self spotterModel hidePreview! !

!GTSpotterMorph methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/19/2015 20:47'!
autoHide: aBoolean

	autoHide := aBoolean! !

!GTSpotterMorph methodsFor: 'accessing' stamp: 'AndreiChis 3/24/2015 18:44'!
breadcrumbBrick: aBrick

	breadcrumbBrick ifNotNil: [self removeBrick: breadcrumbBrick].
	breadcrumbBrick := aBrick.
	
	breadcrumbBrick announcer weak subscribe: GTSpotterBreadcrumbVisibilityChanged send: #onBreadcrumbVisibilityChanged to: self.
	self themer spotterThemer breadcrumbStyleFor: breadcrumbBrick.
	breadcrumbBrick width: [ self paneBrick contentsBrick width ].
	breadcrumbBrick layout widthDependency: [ self paneBrick contentsBrick ].
	self addBrickBack: breadcrumbBrick! !

!GTSpotterMorph methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/23/2015 01:18'!
privacyAgreementNotificationBrick: aBrick
	
	privacyAgreementNotificationBrick ifNotNil: [self removeBrick: privacyAgreementNotificationBrick].
	privacyAgreementNotificationBrick := aBrick.
	
	self themer spotterThemer privacyAgreementNotificationStyleFor: privacyAgreementNotificationBrick.
	privacyAgreementNotificationBrick layout widthDependency: self.
	privacyAgreementNotificationBrick width: [ self width - (self paneBrick isPreviewShown 
			ifFalse: [self themer spotterThemer previewArrowWidth - (2*self themer spotterThemer previewBorderWidth)] 
			ifTrue: [0])].
	
	self addBrickBack: privacyAgreementNotificationBrick! !

!GTSpotterMorph methodsFor: 'actions' stamp: 'AliakseiSyrel 11/19/2014 22:00'!
selectPreviousCategory

	self spotterModel isEmpty
		ifFalse: [ self spotterModel currentStep selectPreviousCategory ]
	! !

!GTSpotterMorph methodsFor: 'instance creation' stamp: 'AndreiChis 3/16/2015 17:20'!
newPrivacyAgreementNotificationBrick

	^ GTSpotterPrivacyAgreementNotificationBrick new! !

!GTSpotterMorph methodsFor: 'actions' stamp: 'StefanReichhart 3/22/2015 18:25'!
actDueTo: anEventType
	self spotterModelDo: [
		self spotterModel isEmpty ifTrue: [ ^self ].
		self spotterModel currentStep isEmpty ifTrue: [ ^ self ].
		self spotterModel currentStep actDueTo: anEventType ]! !

!GTSpotterMorph methodsFor: 'initialization' stamp: 'AliakseiSyrel 12/11/2014 11:52'!
unsubscribeListeners

	self activeHand removeEventListener: self.
	Morph announcer unsubscribe: self.! !

!GTSpotterMorph methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/19/2015 20:46'!
autoHide

	^ autoHide ifNil: [ autoHide := true ]! !

!GTSpotterPaneBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/25/2015 18:30'!
arrowBrick

	^ arrowBrick! !

!GTSpotterPaneBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 1/25/2015 18:29'!
newArrowBrick

	^ GTSpotterPreviewArrowBrick new! !

!GTSpotterPaneBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/20/2015 00:58'!
contentsBrick

	^ contentsBrick! !

!GTSpotterPaneBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/30/2015 16:07'!
previewBrick: aBrick

	previewBrick ifNotNil: [self removeBrick: aBrick].
	previewBrick := aBrick.
	
	self themer spotterThemer spotterPreviewStyleFor: previewBrick! !

!GTSpotterPaneBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 1/20/2015 00:58'!
newContentsBrick

	^ GTSpotterContentsBrick new! !

!GTSpotterPaneBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 1/25/2015 18:30'!
initialize
	super initialize.
	
	self contentsBrick: self newContentsBrick.
	self arrowBrick: self newArrowBrick.
	self previewBrick: self newPreviewBrick! !

!GTSpotterPaneBrick methodsFor: 'action' stamp: 'AliakseiSyrel 2/9/2015 22:16'!
showPreview
	
	self isPreviewShown ifTrue: [ ^ self ].
	
	self addBrickBack: self previewBrick.
	self previewBrick spotterModel ifNotNil: [
		self previewBrick updatePreviewWith: self previewBrick spotterModel currentStep selectedCandidate ].
	
	self contentsBrick hSpaceFill: (100 - self previewBrick layout hPercent).
	self changed.! !

!GTSpotterPaneBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/20/2015 01:14'!
previewBrick

	^ previewBrick! !

!GTSpotterPaneBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/25/2015 19:20'!
spotterModel: aSpotter

	self contentsBrick spotterModel: aSpotter.
	self arrowBrick spotterModel: aSpotter.
	self previewBrick spotterModel: aSpotter! !

!GTSpotterPaneBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/30/2015 16:07'!
contentsBrick: aBrick
	
	contentsBrick ifNotNil: [self removeBrick: contentsBrick].
	contentsBrick := aBrick.
		
	self themer spotterThemer spotterContentsStyleFor: contentsBrick.

	self addBrickBack: contentsBrick! !

!GTSpotterPaneBrick methodsFor: 'testing' stamp: 'AliakseiSyrel 1/25/2015 17:15'!
isPreviewShown

	^ self hasSubbrick: self previewBrick! !

!GTSpotterPaneBrick methodsFor: 'action' stamp: 'AliakseiSyrel 2/3/2015 23:52'!
hidePreview

	self isPreviewShown ifFalse: [ ^ self ].

	self removeBrick: self previewBrick.
	self contentsBrick layout hSpaceFill.
	self changed.! !

!GTSpotterPaneBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 1/20/2015 01:13'!
newPreviewBrick

	^ GTSpotterPreviewBrick new! !

!GTSpotterPaneBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/30/2015 16:07'!
arrowBrick: aBrick

	arrowBrick := aBrick.
	self themer spotterThemer spotterPreviewArrowContainerStyleFor: self arrowBrick.
	self addBrickBack: self arrowBrick! !

!GTSpotterPreviewArrowBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 3/3/2015 11:28'!
onHideHints

	self themer spotterThemer hintHideArrowStyleFor: self triangleBrick! !

!GTSpotterPreviewArrowBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/25/2015 19:37'!
selectedItemBrick
	
	^ selectedItemBrick! !

!GTSpotterPreviewArrowBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/25/2015 19:43'!
selectedItemBrick: aBrick
	
	selectedItemBrick isNil & aBrick isNotNil ifTrue: [ self showTriangle ].
	selectedItemBrick isNotNil & aBrick isNil ifTrue: [ self hideTriangle ].
	
	selectedItemBrick := aBrick! !

!GTSpotterPreviewArrowBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 2/10/2015 14:31'!
onCandidateMoved

	self moveTo: self selectedItemBrick! !

!GTSpotterPreviewArrowBrick methodsFor: 'brick-properties-events' stamp: 'AliakseiSyrel 3/21/2015 23:00'!
onThemerChanged
	super onThemerChanged.
	
	self themer spotterThemer spotterPreviewArrowWidgetStyleFor: self triangleBrick! !

!GTSpotterPreviewArrowBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 1/26/2015 15:59'!
onShowPreview

	self changed! !

!GTSpotterPreviewArrowBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 3/3/2015 11:28'!
onRevealHints

	self themer spotterThemer hintRevealArrowStyleFor: self triangleBrick! !

!GTSpotterPreviewArrowBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 1/25/2015 20:26'!
onStepAdded
	
	self selectedItemBrick: nil.
	self spotterModel steps last candidates announcer subscribe: GTSpotterAllCandidatesRemoved send: #onAllCandidatesRemoved to: self.! !

!GTSpotterPreviewArrowBrick methodsFor: 'brick-drawing' stamp: 'AliakseiSyrel 1/30/2015 16:07'!
onDraw: aCanvas
	super onDraw: aCanvas.
	
		aCanvas
			fillRectangle: ((self brickBounds withWidth: self themer spotterThemer outerBorderWidth) translateBy: (self themer scrollbarWidth + self themer scrollbarOffset + 1)@0)
			color: (self spotterModel isPreviewVisible
				ifTrue: [ self themer spotterThemer backgroundColor ]
				ifFalse: [ Color transparent ])
	
	! !

!GTSpotterPreviewArrowBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 2/13/2015 00:58'!
newTriangleBrick

	^ GLMHintableActionButtonBrick new! !

!GTSpotterPreviewArrowBrick methodsFor: 'actions' stamp: 'AliakseiSyrel 2/10/2015 14:19'!
moveTo: anItemBrick
	|itemBounds delta selfBounds|
	anItemBrick ifNil: [ ^ self ].
	
	itemBounds := anItemBrick globalBounds.
	selfBounds := self globalBounds.
	
	delta := ((itemBounds top - selfBounds top) max: 0) min: (selfBounds height - self triangleBrick height).
	self triangleBrick brickBounds top = delta ifTrue: [ ^ self ].
	
	self triangleBrick marginTop: delta.
	self triangleBrick doLayoutForce.
	self owner changed
	! !

!GTSpotterPreviewArrowBrick methodsFor: 'testing' stamp: 'AliakseiSyrel 3/24/2015 00:54'!
isTriangleVisible

	^ isTriangleVisible ifNil: [ isTriangleVisible := false ]! !

!GTSpotterPreviewArrowBrick methodsFor: 'actions' stamp: 'AliakseiSyrel 3/21/2015 23:00'!
showTriangle

	isTriangleVisible := true.
	self themer spotterThemer spotterPreviewArrowWidgetStyleFor: self triangleBrick.
	self changed! !

!GTSpotterPreviewArrowBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 1/26/2015 15:59'!
onHidePreview

	self changed! !

!GTSpotterPreviewArrowBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 1/25/2015 19:00'!
initialize
	super initialize.
	
	self triangleBrick: self newTriangleBrick! !

!GTSpotterPreviewArrowBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/25/2015 20:10'!
spotterModel

	^ spotterModel! !

!GTSpotterPreviewArrowBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/3/2015 11:26'!
spotterModel: aSpotterModel

	spotterModel := aSpotterModel.
	
	self spotterModel announcer weak subscribe: GTSpotterCandidateSelected send: #onCandidateSelected: to: self.
	self spotterModel announcer weak subscribe: GTSpotterCandidateSelectedMoved send: #onCandidateMoved to: self.
	self spotterModel announcer weak subscribe: GTSpotterStepAdded send: #onStepAdded to: self.
	self spotterModel announcer weak subscribe: GTSpotterShowPreview send: #onShowPreview to: self.
	self spotterModel announcer weak subscribe: GTSpotterHidePreview send: #onHidePreview to: self.
	
	self spotterModel announcer weak subscribe: GTSpotterRevealHints send: #onRevealHints to: self.
	self spotterModel announcer weak subscribe: GTSpotterHideHints send: #onHideHints to: self.! !

!GTSpotterPreviewArrowBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/22/2015 11:52'!
triangleBrick: aBrick

	triangleBrick := aBrick.
	self triangleBrick
		hintTitle: 'Toggle preview';
		hintText: '<cmd+p>';
		action: [ self spotterModel togglePreview ].
	self themer spotterThemer spotterPreviewArrowStyleFor: self triangleBrick.
	self addBrickBack: self triangleBrick
	! !

!GTSpotterPreviewArrowBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 2/10/2015 14:31'!
onCandidateSelected: ann

	self selectedItemBrick: ann candidateBrick.
	self moveTo: self selectedItemBrick! !

!GTSpotterPreviewArrowBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/25/2015 18:58'!
triangleBrick

	^ triangleBrick! !

!GTSpotterPreviewArrowBrick methodsFor: 'actions' stamp: 'AliakseiSyrel 3/21/2015 22:59'!
hideTriangle

	isTriangleVisible := false.
	self themer spotterThemer spotterPreviewArrowWidgetStyleFor: self triangleBrick.
	self changed! !

!GTSpotterPreviewArrowBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 1/29/2015 01:15'!
onAllCandidatesRemoved

	self selectedItemBrick: nil! !

!GTSpotterPreviewBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/21/2015 22:47'!
onThemerChanged
	super onThemerChanged.
	
	self themer spotterThemer spotterPreviewWidgetStyleFor: self! !

!GTSpotterPreviewBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 2/26/2015 08:28'!
onStepAdded

	previewObject := nil.
	self updatePreviewWithLoading! !

!GTSpotterPreviewBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/13/2015 00:52'!
asyncTask

	^ asyncTask ifNil: [ asyncTask := GLMAsyncTask new ]! !

!GTSpotterPreviewBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/17/2015 19:53'!
compositeBrick: aBrick

	self compositeBrick ifNotNil: [ self removeBrick: self compositeBrick ].
	compositeBrick := aBrick.
	self themer spotterThemer spotterPreviewCompositeStyleFor: self compositeBrick.
	self addBrickBack: self compositeBrick.
	self doLayoutForce! !

!GTSpotterPreviewBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 1/20/2015 13:21'!
onStepPopped

	self updatePreviewWith: self spotterModel steps last selectedCandidate! !

!GTSpotterPreviewBrick methodsFor: 'updating' stamp: 'AliakseiSyrel 3/24/2015 00:44'!
updatePreviewWith: anObject
	|wasNil|
	self spotterModel isPreviewVisible ifFalse: [ ^ self ].
	
	wasNil := previewObject isNil.
	previewObject = anObject ifTrue: [ ^ self ].
	previewObject := anObject.
	previewObject ifNil: [ ^ self updatePreviewWithEmpty ].
	wasNil ifTrue: [ self updatePreviewWithLoading ].
	
	self asyncTask
		execute: [ :composite :entity |
				[ entity spotterPreviewIn: composite inContext: self spotterModel ]
					on: Exception
					do: [ composite removeAllBricks ].
				 composite ]
		withArguments: { self newCompositeBrick . anObject }
		callback: [ :composite |
			self compositeBrick: composite.
			self changed ]
		priority: Processor userBackgroundPriority
		delay: 50! !

!GTSpotterPreviewBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 1/20/2015 12:50'!
initialize
	super initialize.
	
	self compositeBrick: self newCompositeBrick! !

!GTSpotterPreviewBrick methodsFor: 'updating' stamp: 'AliakseiSyrel 2/26/2015 08:28'!
updatePreviewWithLoading

	self compositeBrick: (
		GLMLabelBrick new
			text: 'Loading...';
			textPosition: #center;
			textColor: Color lightGray;
				with: [ :b | b label
				customFont;
				fontSize: 14 ])! !

!GTSpotterPreviewBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/20/2015 13:18'!
spotterModel

	^ spotterModel! !

!GTSpotterPreviewBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 1/20/2015 12:47'!
newCompositeBrick

	^ GLMCompositeBrick new! !

!GTSpotterPreviewBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/24/2015 00:42'!
spotterModel: aSpotter
	
	spotterModel := aSpotter.
	aSpotter announcer weak subscribe: GTSpotterSelectedCandidateChanged send: #onCandidateSelected: to: self.
	aSpotter announcer weak subscribe: GTSpotterStepPopped send: #onStepPopped to: self.
	aSpotter announcer weak subscribe: GTSpotterStepAdded send: #onStepAdded to: self.
	aSpotter announcer weak subscribe: GTSpotterSearchFinished send: #onSearchFinished to: self.
	
	! !

!GTSpotterPreviewBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 3/24/2015 00:44'!
onSearchFinished

	self spotterModel currentStep candidates isEmpty
		ifTrue: [ self updatePreviewWithEmpty ]! !

!GTSpotterPreviewBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/20/2015 12:45'!
compositeBrick

	^ compositeBrick! !

!GTSpotterPreviewBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 1/20/2015 13:18'!
onCandidateSelected: ann

	self updatePreviewWith: ann selected! !

!GTSpotterPreviewBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/25/2015 14:24'!
defaultNotAvailableText

	^ 'Preview is not available :('! !

!GTSpotterPreviewBrick methodsFor: 'updating' stamp: 'AliakseiSyrel 2/25/2015 14:24'!
updatePreviewWithEmpty

	self removeAllBricks.
	self asyncTask
		execute: [ | emptyBrick |
			emptyBrick := GLMLabelBrick new
				text: self defaultNotAvailableText;
				textPosition: #center;
				textColor: Color lightGray;
					with: [ :b | b label
					customFont;
					fontSize: 14 ] ]
		withArguments: {  }
		callback: [ :brick | self compositeBrick: brick ]
		priority: Processor userBackgroundPriority
		delay: 50! !

!GTSpotterPrivacyAgreementNotificationBrick methodsFor: 'accessing' stamp: 'AndreiChis 3/15/2015 23:27'!
settingsButtonBrick
	^ settingsButtonBrick! !

!GTSpotterPrivacyAgreementNotificationBrick methodsFor: 'initialization' stamp: 'AndreiChis 3/16/2015 11:52'!
initialize
	super initialize.
	
	self useHorizontalLinearLayout.
	self hSpaceFill.
	self vShrinkWrap.
	self messageBrick: self newTitleBrick.
	self settingsButtonBrick: self newButtonBrick.! !

!GTSpotterPrivacyAgreementNotificationBrick methodsFor: 'instance creation' stamp: 'AndreiChis 3/15/2015 23:11'!
newTitleBrick

	^ GLMRubTextAreaBrick new! !

!GTSpotterPrivacyAgreementNotificationBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/23/2015 01:13'!
settingsButtonBrick: anObject
	settingsButtonBrick := anObject.
	
	self settingsButtonBrick
		text: self settingsButtonLabel;
		hShrinkWrap;
		vAlign: #center;
		margin:10;
		when: #onClicked do: [ self openSettingsBrowser ].
	
	self addBrickBack: self settingsButtonBrick! !

!GTSpotterPrivacyAgreementNotificationBrick methodsFor: 'accessing' stamp: 'AndreiChis 3/16/2015 11:48'!
messageBrick: anObject

	messageBrick := anObject.
	self messageBrick
		hSpaceFill;
		margin:10;
		text: self privacyMessage.

	self addBrickBack: self messageBrick.! !

!GTSpotterPrivacyAgreementNotificationBrick methodsFor: 'instance creation' stamp: 'AndreiChis 3/15/2015 23:11'!
newButtonBrick

	^ GLMButtonBrick new! !

!GTSpotterPrivacyAgreementNotificationBrick methodsFor: 'preferences' stamp: 'AndreiChis 3/15/2015 23:11'!
sendUsageData
	| settingsClass |
	settingsClass := #GTSpotterEventRecorderSettings asClassIfAbsent: [ ^ false ].
	^ settingsClass sendUsageData! !

!GTSpotterPrivacyAgreementNotificationBrick methodsFor: 'accessing' stamp: 'AndreiChis 3/15/2015 23:24'!
messageBrick
	^ messageBrick! !

!GTSpotterPrivacyAgreementNotificationBrick methodsFor: 'accessing' stamp: 'TudorGirba 3/16/2015 15:48'!
privacyMessage

	^ self sendUsageData 
		ifTrue: [ 'You are sending anonymous usage data to help us improve Spotter. Thanks!!' ]
		ifFalse: 	['No usage data is being sent. Would you like to send anonymous usage data to help us improve Spotter?']! !

!GTSpotterPrivacyAgreementNotificationBrick methodsFor: 'accessing' stamp: 'AndreiChis 3/16/2015 00:16'!
settingsButtonLabel
	
	^ self sendUsageData 
		ifTrue: [ 'Change preferences' ]
		ifFalse: [  'Go to settings' ]! !

!GTSpotterPrivacyAgreementNotificationBrick methodsFor: 'preferences' stamp: 'AndreiChis 3/15/2015 23:11'!
sendUsageData: aBoolean
	| settingsClass |
	settingsClass := #GTSpotterEventRecorderSettings asClassIfAbsent: [ ^ self ].
	^ settingsClass sendUsageData: aBoolean! !

!GTSpotterPrivacyAgreementNotificationBrick methodsFor: 'actions' stamp: 'AndreiChis 3/18/2015 15:40'!
openSettingsBrowser
	self class openSettingsBrowser.
	self owner owner closeSpotter.! !

!GTSpotterPrivacyAgreementNotificationBrick class methodsFor: 'utils' stamp: 'AndreiChis 3/18/2015 15:37'!
openSettingsBrowser
	| settingsBrowser window node nodePath |
	settingsBrowser := SettingBrowser new 
		changePackageSet: (RPackage organizer packageNamed: 'GT-Spotter-EventRecorder') asOrderedCollection;
		yourself.
	window := settingsBrowser open.
	window position: Display extent - window extent // 2.
	settingsBrowser expandAll.
	node := settingsBrowser treeHolder nodeNamed: #sendUsageData.
	nodePath := Array 
		with: (settingsBrowser treeHolder nodeNamed: node parentName)
		with: node.
	settingsBrowser selection: (MorphTreeMorphSingleSelection new selectedNodePath: nodePath).! !

!GTSpotterPrivacyAgreementNotificationBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:36'!
exampleOpen

	(GLMBrick new
		hSpaceFill;
		vSpaceFill;
		addBrickBack: (
			self gtExample
				padding: 2;
				borderColor: Color lightGray;
				borderWidth: 2;
				margin: 10;
				hSpaceFill;
				vShrinkWrap;
				yourself);
		yourself)
			openInBrickWindow
			extent: 600@400! !

!GTSpotterPrivacyAgreementNotificationBrick class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:10'!
gtExample
	<gtExample: 'Simple agreement'>
	^ self new! !

!GTSpotterProcessor commentStamp: 'TudorGirba 11/26/2014 15:12'!
This is the abstract class that models a processor that is associated with a spotter category. It can spot items to be displayed in that category by reacting to a filter: message. !
!GTSpotterProcessor methodsFor: 'printing' stamp: 'TudorGirba 4/10/2015 10:58'!
gtDisplayOn: stream
	stream 
		nextPutAll: 'Processor: ';
		nextPutAll: self title asString! !

!GTSpotterProcessor methodsFor: 'testing' stamp: 'StefanReichhart 3/22/2015 22:15'!
shouldFilterInContext: aSpotterContext
	^ aSpotterContext notEmpty 
		or: [ self wantsToDisplayOnEmptyQuery ]! !

!GTSpotterProcessor methodsFor: 'public' stamp: 'TudorGirba 11/24/2014 23:51'!
allFilteredCandidates
	^ allFilteredCandidates ifNil: [ allFilteredCandidates := OrderedCollection new ]! !

!GTSpotterProcessor methodsFor: 'accessing' stamp: 'TudorGirba 11/26/2014 14:20'!
title
	self subclassResponsibility! !

!GTSpotterProcessor methodsFor: 'private' stamp: 'TudorGirba 11/26/2014 14:34'!
render: anObject
	^ GTSpotterItemBrick new
		icon: (nil);
		text: (anObject gtDisplayString)! !

!GTSpotterProcessor methodsFor: 'private' stamp: 'StefanReichhart 2/24/2015 17:04'!
doFilterInContext: aSpotterContext
	"override this method to:
	- add items to the stream
	- return all found items at the end"
	self subclassResponsibility! !

!GTSpotterProcessor methodsFor: 'accessing' stamp: 'TudorGirba 11/25/2014 14:19'!
wantsToDisplayOnEmptyQuery
	^ true! !

!GTSpotterProcessor methodsFor: 'public' stamp: 'StefanReichhart 3/23/2015 18:36'!
actOn: anObject for: aStep
	anObject spotterActDefault: aStep! !

!GTSpotterProcessor methodsFor: 'private' stamp: 'StefanReichhart 3/23/2015 00:25'!
basicFilterInContext: aSpotterContext
	
	self prepareProcessorInContext: aSpotterContext.
	(self shouldFilterInContext: aSpotterContext) ifTrue: [
		allFilteredCandidates := self doFilterInContext: aSpotterContext ].
	aSpotterContext stream 
		performSymbol: #onAmountChanged:in: 
		withArguments: { self allFilteredCandidates size . self }! !

!GTSpotterProcessor methodsFor: 'private' stamp: 'StefanReichhart 3/8/2015 14:38'!
prepareProcessorInContext: aContext
	allFilteredCandidates := nil! !

!GTSpotterProcessor methodsFor: 'private' stamp: 'StefanReichhart 3/18/2015 14:56'!
filterInContext: aSpotterContext
	[ self basicFilterInContext: aSpotterContext ]
		on: Error 
		do: [ :exception | 
			self exceptionHandler 
				handleException: exception 
				do: [ ('[Spotter] Exception in processor <', self title asString, '>: ', exception asString) logCr ] ]! !

!GTSpotterProcessor methodsFor: 'accessing-dynamic' stamp: 'StefanReichhart 4/1/2015 09:56'!
exceptionHandler
	self flag: 'Bloc -> overrides doesNotUnderstand discarding the current exception context'.
	^ GTCurrentSpotterExceptionHandler value ifNil: [ GTSpotterExceptionHandlerNotFound signal ]! !

!GTSpotterProcessorLink methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/24/2014 19:30'!
headLink: anObject
	headLink := anObject! !

!GTSpotterProcessorLink methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/24/2014 19:30'!
headLink
	^ headLink! !

!GTSpotterProcessorLink methodsFor: 'actions' stamp: 'AliakseiSyrel 11/24/2014 22:29'!
clear

	self
		headLink: nil;
		tailLink: nil.
		
	size := 0.! !

!GTSpotterProcessorLink methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/24/2014 22:29'!
size

	^ size ifNil: [ size := 0 ]! !

!GTSpotterProcessorLink methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/24/2014 19:30'!
tailLink
	^ tailLink! !

!GTSpotterProcessorLink methodsFor: 'testing' stamp: 'AliakseiSyrel 11/24/2014 20:29'!
isEmpty

	^ self headLink isNil! !

!GTSpotterProcessorLink methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/24/2014 18:40'!
processor

	^ self value! !

!GTSpotterProcessorLink methodsFor: 'printing' stamp: 'TudorGirba 4/10/2015 11:12'!
gtDisplayOn: stream
	stream 
		nextPutAll: 'Processor link: ';
		nextPutAll: self processor title asString! !

!GTSpotterProcessorLink methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/24/2014 19:30'!
tailLink: anObject
	tailLink := anObject! !

!GTSpotterProcessorLink methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/24/2014 18:48'!
asSpotterProcessorLink

	^ self! !

!GTSpotterProcessorLink methodsFor: 'testing' stamp: 'StefanReichhart 3/22/2015 22:00'!
isFull

	^ self size = self processor itemsLimit! !

!GTSpotterProcessorLink methodsFor: 'actions' stamp: 'AliakseiSyrel 11/24/2014 22:29'!
incrementSize

	size := self size + 1! !

!GTSpotterProcessorLink class methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/24/2014 18:41'!
from: aDoubleLink

	! !

!GTSpotterProcessorsForExamplesTest methodsFor: 'tests' stamp: 'StefanReichhart 3/27/2015 20:01'!
"protocol: tests"
testEachProcessor
	Object withAllSubclasses 
		do: [ :eachClass |
			eachClass gtExamples do: [ :exampleToTest |
				self 
					shouldnt: [
						| step |
						(step := GTSpotterStep new)
							spotter: (GTSpotter new
								exceptionHandler: GTSpotterDebuggingExceptionHandler new; " we want to know whether one of the processors is raising an exception "
								yourself);
							origin: exampleToTest result;
							processContext: (step newContextForQuery: 'a') ] 
					raise: Error ] ]
		displayingProgress: 'Testing GTSpotter examples (#testEachProcessor)'! !

!GTSpotterRecorderActOnEvent commentStamp: 'AndreiChis 2/27/2015 14:35'!
A GTSpotterRecorderActOnEvent models the action of pressing enter (or double clicking) on an element.
!
!GTSpotterRecorderActOnEvent methodsFor: 'initialization' stamp: 'JurajKubelka 3/23/2015 12:23'!
fromAnnouncement: anAnnouncement
	super fromAnnouncement: anAnnouncement.
	self infoAt: #eventType put: anAnnouncement eventType.
	self infoAt: #elementName putHashForText: anAnnouncement element asString.
	self infoAt: #elementType putHashForText: anAnnouncement element class name asString.! !

!GTSpotterRecorderActOnEvent methodsFor: 'visitor' stamp: 'JurajKubelka 4/11/2015 16:52'!
accept: aVisitor
	^ aVisitor visitActOnEvent: self! !

!GTSpotterRecorderActOnEvent methodsFor: 'testing' stamp: 'JurajKubelka 3/29/2015 18:43'!
isCloseSpotter
	^ true! !

!GTSpotterRecorderActOnEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/28/2015 23:55'!
elementName
	^ self infoAt: #elementName! !

!GTSpotterRecorderActOnEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/28/2015 23:55'!
eventType
	^ self infoAt: #eventType! !

!GTSpotterRecorderActOnEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/31/2015 10:48'!
closeActionSymbol
	^ #actOn! !

!GTSpotterRecorderActOnEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/28/2015 23:55'!
elementType
	^ self infoAt: #elementType! !

!GTSpotterRecorderCategorySelectedEvent commentStamp: 'AndreiChis 2/27/2015 14:41'!
A GTSpotterRecorderCategorySelectedEvent  models the action of  selecting a category in the search results. This event stores the name of the category and the number of results that were matched by the current query.

Instance Variables
	categoryLabel:		<Object>
	elementCount:		<Object>

categoryLabel
	- xxxxx

elementCount
	- xxxxx
!
!GTSpotterRecorderCategorySelectedEvent methodsFor: 'initialization' stamp: 'AndreiChis 2/24/2015 21:36'!
fromAnnouncement: anAnnouncement

	categoryLabel := anAnnouncement category title.
	elementCount := anAnnouncement category allFilteredCandidates size.! !

!GTSpotterRecorderCategorySelectedEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/28/2015 23:35'!
categoryLabel
	^ categoryLabel! !

!GTSpotterRecorderCategorySelectedEvent methodsFor: 'visitor' stamp: 'JurajKubelka 4/11/2015 16:52'!
accept: aVisitor
	^ aVisitor visitCategorySelectedEvent: self! !

!GTSpotterRecorderCategorySelectedEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/30/2015 17:08'!
elementCountOrZero
	^ self elementCount ifNil: [ 0 ]! !

!GTSpotterRecorderCategorySelectedEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/28/2015 23:35'!
elementCount
	^ elementCount! !

!GTSpotterRecorderCategorySelectedEvent methodsFor: 'testing' stamp: 'JurajKubelka 3/30/2015 17:41'!
isCategorySelection
	^ true! !

!GTSpotterRecorderCategorySelectedEvent methodsFor: 'gt-inspector-extension' stamp: 'JurajKubelka 3/28/2015 23:37'!
gtInspectorItems
	^ OrderedCollection new
			add: (#categoryLabel -> self categoryLabel);
			add: (#elementCount -> self elementCount);
			addAll: super gtInspectorItems;
			yourself! !

!GTSpotterRecorderContextChangedEvent commentStamp: 'AndreiChis 3/2/2015 15:29'!
A GTSpotterRecorderContextChangedEvent stores current query written in Spotter input field. This event stores the size of the query and wheather or not the current query is a refinment of a previous query.

Instance Variables
	text:		<String>

text
	- query writen in Spotter input field
!
!GTSpotterRecorderContextChangedEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/28/2015 23:38'!
currentTextInfo
	^ currentTextInfo! !

!GTSpotterRecorderContextChangedEvent methodsFor: 'initialization' stamp: 'JurajKubelka 2/28/2015 11:59'!
initialize
	super initialize.
	isRefinement := false.! !

!GTSpotterRecorderContextChangedEvent methodsFor: 'initialization' stamp: 'JurajKubelka 3/6/2015 15:28'!
fromAnnouncement: anAnnouncement

	currentTextInfo := self textInfoFrom: anAnnouncement currentText.
	anAnnouncement previousText size == 0 ifTrue: [ ^ self ].
	previousTextInfo := self textInfoFrom: anAnnouncement previousText.
	isRefinement := (anAnnouncement currentText size > anAnnouncement previousText size 
		ifTrue: [ anAnnouncement currentText beginsWith: anAnnouncement previousText]
		ifFalse: [ anAnnouncement previousText beginsWith: anAnnouncement currentText ]).! !

!GTSpotterRecorderContextChangedEvent methodsFor: 'visitor' stamp: 'JurajKubelka 4/11/2015 16:52'!
accept: aVisitor
	^ aVisitor visitContextChangedEvent: self! !

!GTSpotterRecorderContextChangedEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/28/2015 23:38'!
isRefinement
	^ isRefinement! !

!GTSpotterRecorderContextChangedEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/30/2015 12:23'!
currentTextHashes
	^ self stringHashesFor: self currentTextInfo! !

!GTSpotterRecorderContextChangedEvent methodsFor: 'accessing' stamp: 'JurajKubelka 4/10/2015 14:49'!
currentTextSizes
	^ self stringSizesFor: self currentTextInfo! !

!GTSpotterRecorderContextChangedEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/28/2015 23:38'!
previousTextInfo
	^ previousTextInfo! !

!GTSpotterRecorderContextChangedEvent methodsFor: 'testing' stamp: 'JurajKubelka 3/30/2015 11:44'!
isContextChanged
	^ self currentTextInfo notNil! !

!GTSpotterRecorderContextChangedEvent methodsFor: 'accessing' stamp: 'JurajKubelka 4/11/2015 23:46'!
currentTextSpecials
	^ self stringSpecialsFor: self currentTextInfo! !

!GTSpotterRecorderContextChangedEvent methodsFor: 'testing' stamp: 'JurajKubelka 4/11/2015 23:48'!
hasCurrentTextSpecials
	^ self currentTextSpecials includes: true! !

!GTSpotterRecorderContextChangedEvent methodsFor: 'gt-inspector-extension' stamp: 'JurajKubelka 3/28/2015 23:38'!
gtInspectorItems
	^ OrderedCollection new
			add: (#isRefinement -> self isRefinement);
			add: (#currentTextInfo -> self currentTextInfo);
			add: (#previousTextInfo -> self previousTextInfo);
			addAll: super gtInspectorItems;
			yourself! !

!GTSpotterRecorderDataAnnouncement commentStamp: 'AndreiChis 3/2/2015 15:31'!
A GTSpotterRecorderDataAnnouncement is an announcement that  groups  all  usage data  that is send over the network.  Appart from the actual recorded data in includes some meta-data about the image and the UUID of the computer.

Instance Variables
	computerUUID:		<Object>
	data:		<Object>
	imageHash:		<Object>
	imageVersion:		<Object>
	latestUpdate:		<Object>
	sessionCreationTime:		<Object>
	timestamp:		<Object>

computerUUID
	- xxxxx

data
	- xxxxx

imageHash
	- xxxxx

imageVersion
	- xxxxx

latestUpdate
	- xxxxx

sessionCreationTime
	- xxxxx

timestamp
	- xxxxx
!
!GTSpotterRecorderDataAnnouncement methodsFor: 'accessing' stamp: 'JurajKubelka 3/16/2015 16:26'!
computerUUID
	^ self at: #computerUUID! !

!GTSpotterRecorderDataAnnouncement methodsFor: 'accessing' stamp: 'JurajKubelka 3/16/2015 16:29'!
imageVersion: anObject
	self at: #imageVersion put: anObject! !

!GTSpotterRecorderDataAnnouncement methodsFor: 'accessing' stamp: 'JurajKubelka 3/16/2015 16:27'!
eventRecorderVersion
	^ self at: #eventRecorderVersion! !

!GTSpotterRecorderDataAnnouncement methodsFor: 'accessing' stamp: 'JurajKubelka 3/16/2015 16:26'!
computerUUID: anObject
	self at: #computerUUID put: anObject! !

!GTSpotterRecorderDataAnnouncement methodsFor: 'accessing' stamp: 'JurajKubelka 2/28/2015 15:44'!
materializedData
	^ self data ifNotNil: [ :aData | GTSpotterEventRecorder materialize: aData ]! !

!GTSpotterRecorderDataAnnouncement methodsFor: 'accessing' stamp: 'JurajKubelka 3/16/2015 16:30'!
latestUpdate: anObject
	self at: #latestUpdate put: anObject! !

!GTSpotterRecorderDataAnnouncement methodsFor: 'accessing' stamp: 'JurajKubelka 3/16/2015 16:25'!
at: key
	^ self dictionary at: key ifAbsent: [ nil ]! !

!GTSpotterRecorderDataAnnouncement methodsFor: 'accessing' stamp: 'JurajKubelka 3/16/2015 16:27'!
data
	^ self at: #data! !

!GTSpotterRecorderDataAnnouncement methodsFor: 'accessing' stamp: 'JurajKubelka 3/16/2015 16:30'!
timestamp: anObject
	self at: #timestamp put: anObject! !

!GTSpotterRecorderDataAnnouncement methodsFor: 'accessing' stamp: 'JurajKubelka 3/16/2015 16:29'!
imageVersion
	^ self at: #imageVersion! !

!GTSpotterRecorderDataAnnouncement methodsFor: 'accessing' stamp: 'JurajKubelka 3/16/2015 16:28'!
imageHash: anObject
	self at: #imageHash put: anObject! !

!GTSpotterRecorderDataAnnouncement methodsFor: 'updating' stamp: 'JurajKubelka 3/28/2015 17:49'!
addInfoFor: aGTSpotterRecorderEvent 
	dictionary keysAndValuesDo: [ :key :value |
		key = #data ifFalse: [ 
			aGTSpotterRecorderEvent infoAt: key put: value ] ]! !

!GTSpotterRecorderDataAnnouncement methodsFor: 'accessing' stamp: 'JurajKubelka 3/16/2015 16:28'!
imageHash
	^ self at: #imageHash! !

!GTSpotterRecorderDataAnnouncement methodsFor: 'accessing' stamp: 'JurajKubelka 3/16/2015 16:28'!
eventRecorderVersion: anObject
	self at: #eventRecorderVersion put: anObject! !

!GTSpotterRecorderDataAnnouncement methodsFor: 'accessing' stamp: 'JurajKubelka 3/16/2015 16:31'!
sessionCreationTime: anObject
	self at: #sessionCreationTime put: anObject! !

!GTSpotterRecorderDataAnnouncement methodsFor: 'gt-inspector-extension' stamp: 'JurajKubelka 3/29/2015 12:18'!
gtInspectorItems
	^ OrderedCollection withAll: self associations! !

!GTSpotterRecorderDataAnnouncement methodsFor: 'accessing' stamp: 'JurajKubelka 3/16/2015 16:27'!
data: aByteArray 
	self at: #data put: aByteArray! !

!GTSpotterRecorderDataAnnouncement methodsFor: 'accessing' stamp: 'JurajKubelka 3/16/2015 16:26'!
at: key put: value
	^ self dictionary at: key put: value! !

!GTSpotterRecorderDataAnnouncement methodsFor: 'accessing' stamp: 'JurajKubelka 3/16/2015 16:25'!
dictionary
	^ dictionary ifNil: [ dictionary := Dictionary new ]! !

!GTSpotterRecorderDataAnnouncement methodsFor: 'accessing' stamp: 'JurajKubelka 3/28/2015 17:45'!
events
	| events |
	events := self materializedData.
	events do: [ :each | self addInfoFor: each ].
	^ events! !

!GTSpotterRecorderDataAnnouncement methodsFor: 'accessing' stamp: 'JurajKubelka 3/16/2015 16:30'!
timestamp
	^ self at: #timestamp! !

!GTSpotterRecorderDataAnnouncement methodsFor: 'accessing' stamp: 'JurajKubelka 3/16/2015 16:30'!
sessionCreationTime
	^ self at: #sessionCreationTime! !

!GTSpotterRecorderDataAnnouncement methodsFor: 'gt-inspector-extension' stamp: 'JurajKubelka 3/29/2015 12:19'!
gtInspectorItemsIn: composite
	<gtInspectorPresentationOrder: -1>  
	^ (composite table)
		title: 'Info';
		display: [ :anEvent | anEvent gtInspectorItems ];
		children: [ :each | 
			(each value isDictionary) 
				ifTrue: [ each value associations ] 
				ifFalse: [ (each value isArray and: [ each value allSatisfy: #isDictionary ])
						ifTrue: [ each value collectWithIndex: [:x :i | i -> x ] ]
						ifFalse: [ #() ] ] ];
		column: 'Key' 
			evaluated: [:each | GTObjectPrinter new asTruncatedTextFrom: each key ];
		column: 'Value' 
			evaluated: [:each | GTObjectPrinter new asTruncatedTextFrom: each value ];
		showOnly: 50! !

!GTSpotterRecorderDataAnnouncement methodsFor: 'converting' stamp: 'JurajKubelka 3/29/2015 12:19'!
associations
	^ dictionary 
			ifNil: [ #() ]
			ifNotNil: [ dictionary associations ]! !

!GTSpotterRecorderDataAnnouncement methodsFor: 'accessing' stamp: 'JurajKubelka 3/16/2015 16:29'!
latestUpdate
	^ self at: #latestUpdate! !

!GTSpotterRecorderDataAnnouncement class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:01'!
gtExampleAnnouncement
	<gtExample>
	^ self new
			data: #[ 1 2 3 4 ];
			timestamp: DateAndTime now;
			imageHash: SmalltalkImage current imageName hash;
			sessionCreationTime: SmalltalkImage current session creationTime;
			imageVersion: SystemVersion current version;
			latestUpdate: SystemVersion current highestUpdate;
			computerUUID: GTSpotterEventRecorderSettings uniqueInstance computerUUID asString;
			eventRecorderVersion: GTSpotterEventRecorder version;
			yourself! !

!GTSpotterRecorderDataAnnouncement class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:01'!
gtExampleEmptyAnnouncement
	<gtExample>
	^ self new! !

!GTSpotterRecorderDiveInCategoryEvent commentStamp: 'AndreiChis 2/27/2015 14:36'!
A GTSpotterRecorderDiveInCategoryEvent  models the action of  diving in a category (list of results).
!
!GTSpotterRecorderDiveInCategoryEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/28/2015 23:54'!
categoryTitle
	^ self infoAt: #categoryTitle! !

!GTSpotterRecorderDiveInCategoryEvent methodsFor: 'initialization' stamp: 'JurajKubelka 3/23/2015 11:52'!
fromAnnouncement: anAnnouncement
	super fromAnnouncement: anAnnouncement.
	self infoAt: #eventType put: anAnnouncement eventType.
	self infoAt: #categoryTitle put: anAnnouncement category title.
	self infoAt: #allFilteredCandidates put: anAnnouncement category allFilteredCandidates size.! !

!GTSpotterRecorderDiveInCategoryEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/28/2015 23:54'!
eventType
	^ self infoAt: #eventType! !

!GTSpotterRecorderDiveInCategoryEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/28/2015 23:54'!
allFilteredCandidates
	^ self infoAt: #allFilteredCandidates! !

!GTSpotterRecorderDiveInCategoryEvent methodsFor: 'visitor' stamp: 'JurajKubelka 4/11/2015 16:53'!
accept: aVisitor
	^ aVisitor visitDiveInCategoryEvent: self! !

!GTSpotterRecorderDiveInCategoryEvent methodsFor: 'testing' stamp: 'JurajKubelka 3/29/2015 19:14'!
isDiveIn
	^ true! !

!GTSpotterRecorderDiveInElementEvent commentStamp: 'AndreiChis 2/27/2015 14:36'!
A GTSpotterRecorderDiveInElementEvent models the action of diving in a selected element.
!
!GTSpotterRecorderDiveInElementEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/28/2015 23:53'!
elementName
	^ self infoAt: #elementName! !

!GTSpotterRecorderDiveInElementEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/28/2015 23:53'!
eventType
	^ self infoAt: #eventType! !

!GTSpotterRecorderDiveInElementEvent methodsFor: 'initialization' stamp: 'JurajKubelka 3/23/2015 12:25'!
fromAnnouncement: anAnnouncement
	super fromAnnouncement: anAnnouncement.
	self infoAt: #eventType put: anAnnouncement eventType.
	self infoAt: #elementName putHashForText: anAnnouncement element asString.
	self infoAt: #elementType putHashForText: anAnnouncement element class name asString.
! !

!GTSpotterRecorderDiveInElementEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/28/2015 23:53'!
elementType
	^ self infoAt: #elementType! !

!GTSpotterRecorderDiveInElementEvent methodsFor: 'visitor' stamp: 'JurajKubelka 4/11/2015 16:53'!
accept: aVisitor
	^ aVisitor visitDiveInElementEvent: self! !

!GTSpotterRecorderDiveInElementEvent methodsFor: 'testing' stamp: 'JurajKubelka 3/29/2015 19:15'!
isDiveIn
	^ true! !

!GTSpotterRecorderDiveOutEvent commentStamp: 'AndreiChis 2/27/2015 14:37'!
A GTSpotterRecorderDiveOutEvent  models the action of  diving out a step.
!
!GTSpotterRecorderDiveOutEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/28/2015 23:55'!
elementName
	^ self infoAt: #elementName! !

!GTSpotterRecorderDiveOutEvent methodsFor: 'initialization' stamp: 'JurajKubelka 3/23/2015 12:26'!
fromAnnouncement: anAnnouncement
	super fromAnnouncement: anAnnouncement.
	self infoAt: #elementName putHashForText: anAnnouncement element asString.
	self infoAt: #elementType putHashForText: anAnnouncement element class name asString.! !

!GTSpotterRecorderDiveOutEvent methodsFor: 'testing' stamp: 'JurajKubelka 3/29/2015 19:15'!
isDiveOut
	^ true! !

!GTSpotterRecorderDiveOutEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/28/2015 23:55'!
elementType
	^ self infoAt: #elementType! !

!GTSpotterRecorderDiveOutEvent methodsFor: 'visitor' stamp: 'JurajKubelka 4/11/2015 16:53'!
accept: aVisitor
	^ aVisitor visitDiveOutEvent: self! !

!GTSpotterRecorderEvent commentStamp: 'AndreiChis 3/2/2015 15:30'!
GTSpotterRecorderEvent is the root class for representing usage data generated by Spotter. 
All events have a timestamp.!
!GTSpotterRecorderEvent methodsFor: 'testing' stamp: 'JurajKubelka 3/29/2015 18:43'!
isOpenSpotter
	^ false! !

!GTSpotterRecorderEvent methodsFor: 'accessing - announcement info' stamp: 'JurajKubelka 3/29/2015 17:33'!
computerUUID
	^ self infoAt: #computerUUID! !

!GTSpotterRecorderEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/23/2015 12:16'!
infoAt: key putHashForText: valueString 
	^ self 
		infoAt: key 
		put: (self hashForText: valueString)! !

!GTSpotterRecorderEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/23/2015 11:36'!
infoAt: key
	^ self infoAt: key ifAbsent: [ nil ]! !

!GTSpotterRecorderEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/30/2015 12:22'!
stringSizesFor: anArrayOrNil
	^ anArrayOrNil 
			ifNil: [ #() ]
			ifNotNil: [ :array | array second ]! !

!GTSpotterRecorderEvent methodsFor: 'accessing' stamp: 'JurajKubelka 4/10/2015 10:38'!
dateAndTime
	| aTimestamp |
	self infoAt: #dateAndTime ifPresent: [ :obj | ^ obj ] ifAbsent: [ "ignore" ].
	aTimestamp := self timestamp.
	aTimestamp ifNil: [ ^ aTimestamp ].
	
	aTimestamp isNumber 
		ifTrue: [ "version 1 keeps unix time"
			"We do not have information about time zone."
			^ self 
				infoAt: #dateAndTime 
				put: ((DateAndTime fromUnixTime: aTimestamp) translateTo: 0) ].
	
	"since version 2, timestamp keeps DateAndTime object."
	^ aTimestamp! !

!GTSpotterRecorderEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/23/2015 11:36'!
infoAt: key put: value
	info ifNil: [ info := Dictionary new ].
	^ info at: key put: value! !

!GTSpotterRecorderEvent methodsFor: 'testing' stamp: 'JurajKubelka 3/29/2015 18:43'!
isCloseSpotter
	^ false! !

!GTSpotterRecorderEvent methodsFor: 'private' stamp: 'JurajKubelka 4/1/2015 09:48'!
info
	"For the testing purpose only; we use it in #instancesForAllEvents.
	We want to instantiate info only when it is really necessary."
	^ info ifNil: [ info := Dictionary new ].! !

!GTSpotterRecorderEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/31/2015 10:49'!
closeActionSymbol
	^ #improper! !

!GTSpotterRecorderEvent methodsFor: 'testing' stamp: 'JurajKubelka 3/30/2015 11:41'!
isContextChanged
	^ false! !

!GTSpotterRecorderEvent methodsFor: 'testing' stamp: 'JurajKubelka 3/30/2015 14:30'!
isOpenOrCloseSpotter
	^ self isOpenSpotter or: [ self isCloseSpotter ]! !

!GTSpotterRecorderEvent methodsFor: 'testing' stamp: 'JurajKubelka 3/30/2015 11:51'!
isSearchFinished
	^ false! !

!GTSpotterRecorderEvent methodsFor: 'accessing - announcement info' stamp: 'JurajKubelka 3/29/2015 17:33'!
eventRecorderVersion
	^ self infoAt: #eventRecorderVersion! !

!GTSpotterRecorderEvent methodsFor: 'testing' stamp: 'JurajKubelka 3/29/2015 19:14'!
isDiveIn
	^ false! !

!GTSpotterRecorderEvent methodsFor: 'initialization' stamp: 'JurajKubelka 4/10/2015 09:48'!
initialize
	super initialize.
	timestamp := DateAndTime now.! !

!GTSpotterRecorderEvent methodsFor: 'testing' stamp: 'JurajKubelka 3/31/2015 12:02'!
isDive
	^ self isDiveIn or: [ self isDiveOut ]! !

!GTSpotterRecorderEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/23/2015 11:36'!
infoAt: key ifAbsent: absentBlock
	info ifNil: [ ^ absentBlock value].
	^ info at: key ifAbsent: absentBlock! !

!GTSpotterRecorderEvent methodsFor: 'accessing - announcement info' stamp: 'JurajKubelka 3/29/2015 17:32'!
announcementTimestamp
	^ self infoAt: #timestamp! !

!GTSpotterRecorderEvent methodsFor: 'visitor' stamp: 'JurajKubelka 4/11/2015 16:49'!
accept: aVisitor
	^ self subclassResponsibility! !

!GTSpotterRecorderEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/30/2015 12:19'!
stringSpecialsAt: aSymbol
	^ self 
		infoAt: aSymbol
		ifPresent: [ :array | array third ]
		ifAbsent: [ #() ]! !

!GTSpotterRecorderEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/6/2015 15:08'!
settings
	^ GTSpotterEventRecorderSettings uniqueInstance! !

!GTSpotterRecorderEvent methodsFor: 'accessing' stamp: 'JurajKubelka 4/9/2015 11:19'!
removeInfoKey: key
	^ self removeInfoKey: key ifAbsent: [ "ignore" ]! !

!GTSpotterRecorderEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/29/2015 17:32'!
eventTimestamp
	^ self timestamp! !

!GTSpotterRecorderEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/30/2015 12:18'!
stringHashesAt: aSymbol
	^ self 
		infoAt: aSymbol
		ifPresent: [ :array | array first ]
		ifAbsent: [ #() ]! !

!GTSpotterRecorderEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/23/2015 12:16'!
textInfoFrom: aString
	| strings hashes sizes specials |
	aString isNil ifTrue: [ ^ nil ].
	aString size isZero ifTrue: [ ^ nil ].
	strings := aString substrings.
	hashes := strings collect: [ :each | self hashForText: each ] as: Array.
	sizes := strings collect: #size as: Array.
	specials := strings collect: [ :each | each beginsWith: '#' ] as: Array.
	^ Array with: hashes with: sizes with: specials ! !

!GTSpotterRecorderEvent methodsFor: 'accessing - announcement info' stamp: 'JurajKubelka 3/29/2015 17:33'!
imageVersion
	^ self infoAt: #imageVersion! !

!GTSpotterRecorderEvent methodsFor: 'initialization' stamp: 'AndreiChis 2/24/2015 21:08'!
fromAnnouncement: anAnnouncement

	! !

!GTSpotterRecorderEvent methodsFor: 'testing' stamp: 'JurajKubelka 3/31/2015 11:35'!
isUserSelectionClass
	^ false! !

!GTSpotterRecorderEvent methodsFor: 'accessing' stamp: 'JurajKubelka 4/9/2015 11:18'!
removeInfoKey: key ifAbsent: absentBlock
	info ifNil: [ ^ absentBlock value].
	^ info removeKey: key ifAbsent: absentBlock! !

!GTSpotterRecorderEvent methodsFor: 'accessing - announcement info' stamp: 'JurajKubelka 3/29/2015 17:05'!
imageHash
	^ self infoAt: #imageHash! !

!GTSpotterRecorderEvent methodsFor: 'testing' stamp: 'JurajKubelka 3/29/2015 18:44'!
isHidePreview
	^ false! !

!GTSpotterRecorderEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/30/2015 12:22'!
stringSpecialsFor: anArrayOrNil
	^ anArrayOrNil 
			ifNil: [ #() ]
			ifNotNil: [ :array | array third ]! !

!GTSpotterRecorderEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/23/2015 12:14'!
hashForText: aString
	^ aString hash bitXor: self settings secretUUID hash! !

!GTSpotterRecorderEvent methodsFor: 'gt-inspector-extension' stamp: 'JurajKubelka 3/28/2015 23:34'!
gtInspectorItems
	^ OrderedCollection
		 with: (#eventTimestamp -> self timestamp) withAll: self associations! !

!GTSpotterRecorderEvent methodsFor: 'testing' stamp: 'JurajKubelka 3/29/2015 19:40'!
isUserSelection
	^ false! !

!GTSpotterRecorderEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/30/2015 12:22'!
stringHashesFor: anArrayOrNil
	^ anArrayOrNil 
			ifNil: [ #() ]
			ifNotNil: [ :array | array first ]! !

!GTSpotterRecorderEvent methodsFor: 'gt-inspector-extension' stamp: 'JurajKubelka 3/30/2015 11:47'!
gtInspectorItemsIn: composite
	<gtInspectorPresentationOrder: -1>  
	^ (composite table)
		title: 'Info';
		display: [ :anEvent | anEvent gtInspectorItems ];
		children: [ :each | 
			(each value isDictionary) 
				ifTrue: [ each value associations ] 
				ifFalse: [ (each value isArray and: [ each value allSatisfy: #isDictionary ])
						ifTrue: [ each value collectWithIndex: [:x :i | i -> x ] ]
						ifFalse: [ #() ] ] ];
		column: 'Key' 
			evaluated: [:each | GTObjectPrinter new asTruncatedTextFrom: each key ];
		column: 'Value' 
			evaluated: [:each | GTObjectPrinter new asTruncatedTextFrom: each value ];
		beMultiple;
		send: [ :selection | 
			(selection notNil and: [ selection size = 1 ]) 
				ifTrue: [ selection anyOne value ] 
				ifFalse: [ selection collect: #value ] ];
		showOnly: 50! !

!GTSpotterRecorderEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/31/2015 13:34'!
infoAt: key ifAbsentPut: putBlock
	info ifNil: [ info := Dictionary new ].
	^ info at: key ifAbsentPut: putBlock! !

!GTSpotterRecorderEvent methodsFor: 'accessing' stamp: 'JurajKubelka 4/10/2015 09:39'!
timestamp
	^ timestamp! !

!GTSpotterRecorderEvent methodsFor: 'testing' stamp: 'JurajKubelka 3/29/2015 18:44'!
isShowPreview
	^ false! !

!GTSpotterRecorderEvent methodsFor: 'accessing - announcement info' stamp: 'JurajKubelka 3/29/2015 17:33'!
sessionCreationTime
	^ self infoAt: #sessionCreationTime! !

!GTSpotterRecorderEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/30/2015 12:19'!
stringSizesAt: aSymbol
	^ self 
		infoAt: aSymbol
		ifPresent: [ :array | array second ]
		ifAbsent: [ #() ]! !

!GTSpotterRecorderEvent methodsFor: 'converting' stamp: 'JurajKubelka 3/28/2015 23:13'!
associations
	^ info 
			ifNil: [ #() ]
			ifNotNil: [ info associations ]! !

!GTSpotterRecorderEvent methodsFor: 'testing' stamp: 'JurajKubelka 3/30/2015 17:41'!
isCategorySelection
	^ false! !

!GTSpotterRecorderEvent methodsFor: 'testing' stamp: 'JurajKubelka 3/29/2015 19:14'!
isDiveOut
	^ false! !

!GTSpotterRecorderEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/30/2015 12:18'!
infoAt: key ifPresent: presentBlock ifAbsent: absentBlock
	info ifNil: [ ^ absentBlock value].
	^ info at: key ifPresent: presentBlock ifAbsent: absentBlock! !

!GTSpotterRecorderEvent methodsFor: 'accessing - announcement info' stamp: 'JurajKubelka 3/29/2015 17:33'!
latestUpdate
	^ self infoAt: #latestUpdate! !

!GTSpotterRecorderEvent class methodsFor: 'instance creation' stamp: 'StefanReichhart 4/9/2015 12:01'!
gtExampleAnySubclass
	<gtExample>
	^ self subclasses anyOne new ! !

!GTSpotterRecorderEvent class methodsFor: 'instance creation' stamp: 'AndreiChis 2/24/2015 21:08'!
fromAnnouncement: anAnnouncement

	^ self new fromAnnouncement: anAnnouncement! !

!GTSpotterRecorderExitAnnouncementEvent commentStamp: 'AndreiChis 2/27/2015 14:37'!
A GTSpotterRecorderExitAnnouncementEvent  models the action of  exiting Spotter. 

Instance Variables
	timestamp:		<Object>

timestamp
	- xxxxx
!
!GTSpotterRecorderExitAnnouncementEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/31/2015 10:49'!
closeActionSymbol
	^ self eventType! !

!GTSpotterRecorderExitAnnouncementEvent methodsFor: 'initialization' stamp: 'JurajKubelka 3/23/2015 12:04'!
fromAnnouncement: anAnnouncement
	super fromAnnouncement: anAnnouncement.
	self infoAt: #eventType put: anAnnouncement eventType.

! !

!GTSpotterRecorderExitAnnouncementEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/31/2015 12:38'!
eventType
	^ self infoAt: #eventType ifAbsent: [ #missing ]! !

!GTSpotterRecorderExitAnnouncementEvent methodsFor: 'visitor' stamp: 'JurajKubelka 4/11/2015 16:53'!
accept: aVisitor
	^ aVisitor visitExitEvent: self! !

!GTSpotterRecorderExitAnnouncementEvent methodsFor: 'testing' stamp: 'JurajKubelka 3/29/2015 18:43'!
isCloseSpotter
	^ true! !

!GTSpotterRecorderHidePreviewEvent commentStamp: 'AndreiChis 2/27/2015 14:38'!
A GTSpotterRecorderHidePreviewEvent  models the action of explicitly hidding the preview.
!
!GTSpotterRecorderHidePreviewEvent methodsFor: 'testing' stamp: 'JurajKubelka 3/29/2015 18:44'!
isHidePreview
	^ true! !

!GTSpotterRecorderHidePreviewEvent methodsFor: 'visitor' stamp: 'JurajKubelka 4/11/2015 16:53'!
accept: aVisitor
	^ aVisitor visitHidePreviewEvent: self! !

!GTSpotterRecorderOpenEvent commentStamp: 'AndreiChis 2/27/2015 14:38'!
A GTSpotterRecorderOpenEvent  models the action of  opening Spotter.

Instance Variables
	timestamp:		<Object>

timestamp
	- xxxxx
!
!GTSpotterRecorderOpenEvent methodsFor: 'testing' stamp: 'JurajKubelka 3/29/2015 18:43'!
isOpenSpotter
	^ true! !

!GTSpotterRecorderOpenEvent methodsFor: 'visitor' stamp: 'JurajKubelka 4/11/2015 16:53'!
accept: aVisitor
	^ aVisitor visitOpenEvent: self! !

!GTSpotterRecorderSearchFinishedEvent commentStamp: 'AndreiChis 3/2/2015 15:30'!
A GTSpotterRecorderSearchFinishedEvent is triggered when spotter finished a search and displayed all the results. This event stores the size of the query.
!
!GTSpotterRecorderSearchFinishedEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/30/2015 16:52'!
categories
	^ self processors 
			ifNotNil: [ :aCollection | aCollection select: #isString ]
			ifNil: [ #() ]! !

!GTSpotterRecorderSearchFinishedEvent methodsFor: 'initialization' stamp: 'JurajKubelka 3/6/2015 16:48'!
fromAnnouncement: anAnnouncement
	query := self textInfoFrom: anAnnouncement query.
	processors := (anAnnouncement processors flatCollect: [ :eachProcessor |
		Array 
			with: eachProcessor title
			with: eachProcessor allFilteredCandidates size ]) asArray! !

!GTSpotterRecorderSearchFinishedEvent methodsFor: 'visitor' stamp: 'JurajKubelka 4/11/2015 16:53'!
accept: aVisitor
	^ aVisitor visitSearchFinishedEvent: self! !

!GTSpotterRecorderSearchFinishedEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/28/2015 23:39'!
query
	^ query! !

!GTSpotterRecorderSearchFinishedEvent methodsFor: 'testing' stamp: 'JurajKubelka 3/30/2015 11:52'!
isSearchFinished
	^ self query notNil! !

!GTSpotterRecorderSearchFinishedEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/28/2015 23:39'!
processors
	^ processors! !

!GTSpotterRecorderSearchFinishedEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/30/2015 16:53'!
items
	^ self processors 
			ifNotNil: [ :aCollection | aCollection select: #isNumber ]
			ifNil: [ #() ]! !

!GTSpotterRecorderSearchFinishedEvent methodsFor: 'gt-inspector-extension' stamp: 'JurajKubelka 3/28/2015 23:40'!
gtInspectorItems
	^ OrderedCollection new
			add: (#query -> self query);
			add: (#processors -> self processors);
			addAll: super gtInspectorItems;
			yourself! !

!GTSpotterRecorderSelectedCandidateChangedEvent commentStamp: 'AndreiChis 2/28/2015 19:07'!
A GTSpotterRecorderSelectedCandidateChangedEvent models the action of  selecting an element in the search results.
!
!GTSpotterRecorderSelectedCandidateChangedEvent methodsFor: 'testing' stamp: 'JurajKubelka 3/29/2015 19:42'!
isUserSelection
	^ self eventType notNil and: [ (self eventType = #unknown) not ]! !

!GTSpotterRecorderSelectedCandidateChangedEvent methodsFor: 'testing' stamp: 'JurajKubelka 3/31/2015 11:35'!
isUserSelectionClass
	^ true! !

!GTSpotterRecorderSelectedCandidateChangedEvent methodsFor: 'initialization' stamp: 'JurajKubelka 3/23/2015 12:29'!
fromAnnouncement: anAnnouncement
	super fromAnnouncement: anAnnouncement.
	self infoAt: #eventType put: anAnnouncement eventType.
	self infoAt: #elementName putHashForText: anAnnouncement selected asString.
	self infoAt: #elementType putHashForText: anAnnouncement selected class name asString.
! !

!GTSpotterRecorderSelectedCandidateChangedEvent methodsFor: 'visitor' stamp: 'JurajKubelka 4/11/2015 16:53'!
accept: aVisitor
	^ aVisitor visitSelectedCandidateChangedEvent: self! !

!GTSpotterRecorderSelectedCandidateChangedEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/28/2015 23:56'!
elementName
	^ self infoAt: #elementName! !

!GTSpotterRecorderSelectedCandidateChangedEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/28/2015 23:56'!
eventType
	^ self infoAt: #eventType! !

!GTSpotterRecorderSelectedCandidateChangedEvent methodsFor: 'accessing' stamp: 'JurajKubelka 3/28/2015 23:56'!
elementType
	^ self infoAt: #elementType! !

!GTSpotterRecorderShowPreviewEvent commentStamp: 'AndreiChis 2/27/2015 14:39'!
A GTSpotterRecorderShowPreviewEvent models the action of explicitly closing the preview of an object.
!
!GTSpotterRecorderShowPreviewEvent methodsFor: 'visitor' stamp: 'JurajKubelka 4/11/2015 16:54'!
accept: aVisitor
	^ aVisitor visitShowPreviewEvent: self! !

!GTSpotterRecorderShowPreviewEvent methodsFor: 'testing' stamp: 'JurajKubelka 3/29/2015 18:44'!
isShowPreview
	^ true! !

!GTSpotterResultsBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 12/9/2014 13:50'!
categories

	^ categories ifNil: [ categories := Dictionary new ]! !

!GTSpotterResultsBrick methodsFor: 'adding' stamp: 'AliakseiSyrel 1/25/2015 19:16'!
buildItemFor: aCandidateLink in: aProcessor
	|itemBrick|
	itemBrick := (aCandidateLink renderingProcessor render: aCandidateLink value)
			candidateLink: aCandidateLink;
			stepModel: self stepModel;
			yourself.
	^ itemBrick
	! !

!GTSpotterResultsBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 10/25/2014 14:36'!
stepModel
	^ stepModel! !

!GTSpotterResultsBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/20/2014 00:35'!
waitingText

	^ '...'! !

!GTSpotterResultsBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 2/8/2015 16:49'!
onCandidateAdded: ann
	
	(self categoryMorphOf: ann category)
		addBrickBack: (self buildItemFor: ann candidateLink in: ann category);
		setAmountVisible: ((self categoryMorphOf: ann category) submorphs size) all: self waitingText.
	self changed.! !

!GTSpotterResultsBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 1/25/2015 20:24'!
onCandidatesAmountChanged: ann
	|categoryMorph|
	
	ann amount < 1 ifTrue: [ ^ self changed ].
	
	categoryMorph := self categoryMorphOf: ann category.
	categoryMorph ifNil: [ ^ self ].
	
	categoryMorph titleBrick setAmountVisible: (categoryMorph submorphs size) all: ann amount.
	! !

!GTSpotterResultsBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 1/25/2015 19:34'!
onScrolled

	self stepModel spotter announce: GTSpotterCandidateSelectedMoved new! !

!GTSpotterResultsBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/29/2014 14:50'!
categoryMorphOf: aProcessor

	^ self categories at: aProcessor ifAbsentPut: [ self addCategory: aProcessor ]! !

!GTSpotterResultsBrick methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/8/2015 16:37'!
initialize
	super initialize.
	self band hSpaceFill.
	self announcer weak subscribe: GLMBrickScrollPositionChanged send: #onScrolled to: self! !

!GTSpotterResultsBrick methodsFor: 'instance creation' stamp: 'AliakseiSyrel 11/29/2014 14:17'!
newTitleBrick

	^ GTSpotterCategoryTitleBrick new! !

!GTSpotterResultsBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 2/8/2015 16:48'!
onAllCandidatesAdded: ann
	|categoryMorph|
	ann candidateLinks isEmpty ifTrue: [ ^ self ].
	
	categoryMorph := self categoryMorphOf: ann category.
	categoryMorph
		addAllBricks: (ann candidateLinks collect: [ :each | self buildItemFor: each in: ann category ]).
	categoryMorph
		titleBrick setAmountVisible: (categoryMorph submorphs size) all: self waitingText.
	self changed.! !

!GTSpotterResultsBrick methodsFor: 'instance creation' stamp: 'TudorGirba 11/26/2014 14:34'!
newCategoryBrick

	^ GTSpotterCategoryBrick new! !

!GTSpotterResultsBrick methodsFor: 'brick-structure-events' stamp: 'AliakseiSyrel 1/29/2015 01:29'!
onRemovedFrom: aBrick
	super onRemovedFrom: aBrick.
	
	self stepModel spotter announcer unsubscribe: self.
	self stepModel announcer unsubscribe: self.! !

!GTSpotterResultsBrick methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/29/2015 16:07'!
stepModel: aModel
	stepModel := aModel.
	
	stepModel candidates announcer weak subscribe: GTSpotterCandidateAdded send: #onCandidateAdded: to: self.
	stepModel candidates announcer weak subscribe: GTSpotterAllCandidatesRemoved send: #onAllCandidatesRemoved to: self.
	stepModel candidates announcer weak subscribe: GTSpotterAllCandidatesAdded send: #onAllCandidatesAdded: to: self.
	stepModel candidates announcer weak subscribe: GTSpotterCandidatesAmountChanged send: #onCandidatesAmountChanged: to: self.
	stepModel announcer weak subscribe: GTSpotterScrollPageDown send: #scrollPageDown to: self.
	stepModel announcer weak subscribe: GTSpotterScrollPageUp send: #scrollPageUp to: self.
	stepModel spotter announcer weak subscribe: GTSpotterCandidateSelected send: #onCandidateSelected: to: self.! !

!GTSpotterResultsBrick methodsFor: 'event handling' stamp: 'StefanReichhart 4/10/2015 19:20'!
onCandidateSelected: ann
	self flag: 'version from march 20 - solves the empty category problem on diveout, but may have other side-effects'.
	self scrollTo: ann candidateBrick
	"
	|titleBrick|
	titleBrick := (self categoryMorphOf: ann candidateBrick candidateLink processor) subbrickBefore.
	self scrollTo: ((ann candidateBrick candidateLink isFirst and: [ titleBrick isFirstInOwner ])
		ifTrue: [ titleBrick ]
		ifFalse: [ ann candidateBrick ])
	"! !

!GTSpotterResultsBrick methodsFor: 'event handling' stamp: 'AliakseiSyrel 2/3/2015 23:52'!
onAllCandidatesRemoved
	
	self removeAllBricks.
	categories := nil.
	
	self band fullReleaseCachedState.
	self band releaseCachedState.
	self changed.
	! !

!GTSpotterResultsBrick methodsFor: 'adding' stamp: 'AliakseiSyrel 2/8/2015 16:40'!
addCategory: aProcessor
	|titleBrick categoryBrick|
	
	titleBrick := self newTitleBrick on: self stepModel category: aProcessor.
	self themer spotterThemer categoryTitleStyleFor: titleBrick.
	self addBrickBack: titleBrick.
	
	categoryBrick := (self newCategoryBrick on: self stepModel category: aProcessor) titleBrick: titleBrick.
	self themer spotterThemer categoryStyleFor: categoryBrick .
	self addBrickBack: categoryBrick.
	
	self changed.
	
	^ categoryBrick! !

!GTSpotterSearchFinished methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/27/2015 23:19'!
query
	^ query! !

!GTSpotterSearchFinished methodsFor: 'accessing' stamp: 'JurajKubelka 3/6/2015 16:36'!
processors
	^ processors! !

!GTSpotterSearchFinished methodsFor: 'accessing' stamp: 'JurajKubelka 3/6/2015 16:36'!
processors: anObject
	processors := anObject! !

!GTSpotterSearchFinished methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/27/2015 23:19'!
query: anObject
	query := anObject! !

!GTSpotterSelectedCandidateChanged methodsFor: 'accessing' stamp: 'AliaskeiSyrel 11/13/2014 20:20'!
selected
	^ selected! !

!GTSpotterSelectedCandidateChanged methodsFor: 'accessing' stamp: 'AliaskeiSyrel 11/13/2014 20:20'!
selected: anObject
	selected := anObject! !

!GTSpotterSelectedCandidateChanged methodsFor: 'accessing' stamp: 'AndreiChis 3/20/2015 19:09'!
eventType: anObject
	eventType := anObject! !

!GTSpotterSelectedCandidateChanged methodsFor: 'accessing' stamp: 'AndreiChis 3/20/2015 19:09'!
eventType
	^ eventType! !

!GTSpotterSmokeTest methodsFor: 'tests' stamp: 'AliakseiSyrel 1/30/2015 17:43'!
testOpen

	window := (GTSpotterMorph new spotterModel: GTSpotter new; showPreview; yourself) extent: 500@500; openInWorld.! !

!GTSpotterSmokeTest methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 1/30/2015 17:43'!
tearDown
	super tearDown.
	
	window ifNotNil: [ window delete ]! !

!GTSpotterSmokeTest methodsFor: 'running' stamp: 'AliakseiSyrel 1/30/2015 17:35'!
setUp
	super setUp.
	
	! !

!GTSpotterStackedLayout methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/19/2015 11:17'!
shrinkBottom: aRectangle with: aBrick

	^ aRectangle bottom: (aRectangle bottom - aBrick globalOuterBounds height)! !

!GTSpotterStackedLayout methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/19/2015 11:16'!
deltaBottom: aBrick

	^ aBrick globalOuterBounds corner y -  self allowedBounds corner y! !

!GTSpotterStackedLayout methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/19/2015 11:17'!
shrinkTop: aRectangle with: aBrick

	^ aRectangle top: (aRectangle top + aBrick globalOuterBounds height)! !

!GTSpotterStackedLayout methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/19/2015 10:48'!
allowedBounds: anObject
	allowedBounds := anObject! !

!GTSpotterStackedLayout methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/19/2015 11:15'!
decreaseZindex: aBrick

	aBrick layoutProperties zIndex: 1.! !

!GTSpotterStackedLayout methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/19/2015 11:16'!
gatherStacked: aBrick
	|list|
	
	list := DoubleLinkedList new.
	aBrick subbricks do: [ :each | each layoutProperties floating = #stack ifTrue: [ list add: each ] ].
	^ list! !

!GTSpotterStackedLayout methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/19/2015 11:16'!
deltaTop: aBrick

	^ self allowedBounds origin y - aBrick globalOuterBounds origin y! !

!GTSpotterStackedLayout methodsFor: 'testing' stamp: 'AliakseiSyrel 2/19/2015 11:16'!
isVisible: aBrick
	
	^ self allowedBounds containsRect: aBrick globalOuterBounds! !

!GTSpotterStackedLayout methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/19/2015 11:16'!
increaseZindex: aBrick

	aBrick layoutProperties zIndex: 2.! !

!GTSpotterStackedLayout methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/19/2015 10:48'!
cutAllowedBoundsBottom: aBrick

	self allowedBounds: (self shrinkBottom: self allowedBounds with: aBrick )! !

!GTSpotterStackedLayout methodsFor: 'testing' stamp: 'AliakseiSyrel 2/19/2015 11:17'!
isFullyVisible: aBrick
	
	^ self allowedBounds containsRect: aBrick globalOuterBounds! !

!GTSpotterStackedLayout methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/23/2015 14:21'!
layoutProportional: aCollection in: aBrick position: aSymbol
	| fullWidth eachWidth index |
	aCollection isEmpty ifTrue: [ ^ self ].
	
	fullWidth := aBrick innerBounds width.
	index := 0.
	aCollection inject: aBrick paddingLeft into: [ :leftOffset :each |
		|layoutBounds|
		
		self sendEvent: (GLMBrickLayoutStacked new index: (index + 1); position: aSymbol; yourself) to: each.
		
		eachWidth := ((fullWidth - leftOffset) / (aCollection size - index)) ceiling.
		
		layoutBounds := each wrappedBounds.
		index = 0
			ifTrue: [ layoutBounds width: (((each layout maxWidth brickValue: each) max: eachWidth) min: (fullWidth - leftOffset)) ]
			ifFalse: [				
				(index = (aCollection size - 1))
					ifFalse: [ layoutBounds width: (eachWidth min: (each layout maxWidth brickValue: each)) ]
					ifTrue: [ layoutBounds width: eachWidth ] ].
		
		layoutBounds translateBy: (leftOffset@0).
		each brickBounds: layoutBounds.
		index := index + 1.
		leftOffset + layoutBounds outerBounds width ]! !

!GTSpotterStackedLayout methodsFor: 'testing' stamp: 'AliakseiSyrel 2/19/2015 11:16'!
isAbove: aBrick

	^ aBrick globalOuterBounds origin <= self allowedBounds origin! !

!GTSpotterStackedLayout methodsFor: 'testing' stamp: 'AliakseiSyrel 2/19/2015 11:18'!
isFullyVisible: aBrick in: aRectangle
	
	^ aRectangle containsRect: aBrick globalOuterBounds! !

!GTSpotterStackedLayout methodsFor: 'layout' stamp: 'AliakseiSyrel 2/24/2015 11:56'!
layout: aBrick in: newBounds
	
	^ super layout: aBrick in: newBounds.
	"^ self layoutStacked: aBrick in: newBounds"! !

!GTSpotterStackedLayout methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/19/2015 11:15'!
cutAllowedBoundsTop: aBrick

	self allowedBounds: (self shrinkTop: self allowedBounds with: aBrick )! !

!GTSpotterStackedLayout methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/19/2015 10:48'!
allowedBounds
	^ allowedBounds! !

!GTSpotterStackedLayout methodsFor: 'testing' stamp: 'AliakseiSyrel 2/19/2015 11:16'!
isAbove: aBrick in: aRectangle

	^ aBrick globalOuterBounds origin <= aRectangle origin! !

!GTSpotterStackedLayout methodsFor: 'testing' stamp: 'AliakseiSyrel 2/19/2015 11:18'!
isPartiallyVisibleAbove: aBrick

	^ (self isFullyVisible: aBrick) not & (self isAbove: aBrick)! !

!GTSpotterStackedLayout methodsFor: 'testing' stamp: 'AliakseiSyrel 2/19/2015 11:18'!
isVisible: aBrick in: aRectangle
	
	^ aRectangle intersects: aBrick globalOuterBounds! !

!GTSpotterStackedLayout methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/23/2015 14:21'!
layoutStacked: aBrick in: newBounds
	| origStackedBricks stackedBricks forward stackedTopBricks stackedBottomBricks stackedTopHeight stackedBottomHeight|
	self flag: 'refactor me'.
	self allowedBounds: newBounds.
	stackedBricks := self gatherStacked: aBrick.
	origStackedBricks := DoubleLinkedList new.
	origStackedBricks addAll: stackedBricks.
	forward := true.
	
	stackedTopHeight := 0.
	stackedBottomHeight := 0.
	stackedTopBricks := OrderedCollection new.
	stackedBottomBricks := OrderedCollection new.
	
	"going from top to bottom"
	[ stackedBricks isEmpty not & forward] whileTrue: [ |brick|
		brick := stackedBricks removeFirst value.
		(self isVisible: brick) ifFalse: [
			(self isAbove: brick) ifTrue: [ |delta|
				delta := (self deltaTop: brick) - stackedTopHeight.
				brick translateX: delta negated.
				self increaseZindex: brick.
				stackedTopBricks isEmpty ifTrue: [
					stackedTopHeight := stackedTopHeight + brick globalOuterBounds height.
					self cutAllowedBoundsTop: brick ].
				stackedTopBricks add: brick.
			] ifFalse: [ forward := false. stackedBricks addFirst: brick ]
		] ifTrue: [
			(self isPartiallyVisibleAbove: brick)
				ifTrue: [ self layoutAllowedTop: brick ]
				ifFalse: [ forward := false. self decreaseZindex: brick.	stackedBricks addFirst: brick ] ] ].

	"going from bottom to top"
	[ stackedBricks isEmpty not ] whileTrue: [ |brick|
		brick := stackedBricks removeLast value.
		(self isVisible: brick) ifFalse: [ |delta|
			delta := (self deltaBottom: brick) - stackedBottomHeight.
			brick translateX: delta negated.
			self increaseZindex: brick.
			stackedBottomBricks isEmpty ifTrue: [
				stackedBottomHeight := stackedBottomHeight + brick globalOuterBounds height.
				self cutAllowedBoundsBottom: brick ].
			stackedBottomBricks add: brick.
		] ifTrue: [
			(self isFullyVisible: brick )
				ifFalse: [ self layoutAllowedBottom: brick ]
				ifTrue: [ self decreaseZindex: brick ] ] ].

	self layoutProportional: stackedTopBricks reverse in: aBrick position: #top.
	self layoutProportional: stackedBottomBricks reverse in: aBrick position: #bottom.
	
	"origStackedBricks do: [ :each | each doLayout ]."
	
	^ allowedBounds! !

!GTSpotterStackedLayout methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/19/2015 11:17'!
layoutAllowedBottom: aBrick

	self
		translate: aBrick by: (self deltaBottom: aBrick) negated;
		increaseZindex: aBrick;
		cutAllowedBoundsBottom: aBrick! !

!GTSpotterStackedLayout methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 2/19/2015 11:17'!
layoutAllowedTop: aBrick

	self
		translate: aBrick by: (self deltaTop: aBrick);
		increaseZindex: aBrick;
		cutAllowedBoundsTop: aBrick! !

!GTSpotterStep commentStamp: 'TudorGirba 11/26/2014 15:13'!
It models one step in the spotter search.

A step knows:
- the origin object 
- the active processors that handle the query, and the candidates
- the selected candidate, and
- the list of all filtered candidates

It also knows the stream through which the list of candidates is affected.

The key method is process:!
!GTSpotterStep methodsFor: 'actions' stamp: 'AndreiChis 3/20/2015 20:00'!
diveInCategory

	^ self diveInCategoryDueTo: #unknown
	! !

!GTSpotterStep methodsFor: 'accessing' stamp: 'AliakseiSyrel 3/22/2015 14:31'!
previousProcessorFrom: aCollection
	aCollection do: [ :each | 
		each asSpotterCandidateLink processor ifNotNil: [ ^ each processor ] ]. " we assume they are all identical "
	^ GTSpotterCandidatesListProcessor new
		title: 'Items';
		filter: GTFilterSubstring;
		yourself! !

!GTSpotterStep methodsFor: 'selecting' stamp: 'AliakseiSyrel 2/24/2015 11:05'!
selectFirst
	
	self candidates isEmpty ifTrue: [ ^ self ].
	self selected: self candidates head! !

!GTSpotterStep methodsFor: 'accessing' stamp: 'AliakseiSyrel 12/11/2014 12:15'!
selectedCategory

	^ self selected processor! !

!GTSpotterStep methodsFor: 'accessing' stamp: 'AliaskeiSyrel 11/8/2014 10:26'!
origin

	^ origin! !

!GTSpotterStep methodsFor: 'accessing' stamp: 'TudorGirba 11/18/2014 21:07'!
addProcessor: aProcessor

	self processors add: aProcessor! !

!GTSpotterStep methodsFor: 'private' stamp: 'StefanReichhart 3/17/2015 15:08'!
basicRelevantProcessorsProcess: aSpotterContext do: aBlock
	aSpotterContext text substrings 
		detect: [ :each | each beginsWith: '#' ]
		ifFound: [ :categoryQuery | 
			| categoryQueryPrefix |
			aSpotterContext text: (aSpotterContext text copyReplaceAll: categoryQuery with: '').
			categoryQueryPrefix := categoryQuery allButFirst asLowercase.
			self processors 
				select: [ :each | each title asLowercase beginsWith: categoryQueryPrefix ]
				thenDo: aBlock ]
		ifNone: [ 
			self processors do: aBlock ]! !

!GTSpotterStep methodsFor: 'processing' stamp: 'StefanReichhart 2/24/2015 17:06'!
newContextForQuery: aString
	^ GTSpotterContext new 
		step: self;
		stream: self stream;
		text: aString;
		yourself! !

!GTSpotterStep methodsFor: 'selecting' stamp: 'AliakseiSyrel 2/24/2015 11:06'!
selectNextCategory
	|currentCategory nextCategory|
	self selected ifNil: [ ^ self ].
	
	currentCategory := self candidates getProcessorLinkByCandidateLink: self selected.
	nextCategory := self candidates nextProcessorLinkOf: currentCategory.
	
	self selected: ((currentCategory = nextCategory)
		ifTrue: [ nextCategory tailLink ]
		ifFalse: [ nextCategory headLink ])
	
	! !

!GTSpotterStep methodsFor: 'accessing' stamp: 'StefanReichhart 3/12/2015 12:46'!
asyncTask

	^ asyncTask ifNil: [ asyncTask := self defaultTask ]! !

!GTSpotterStep methodsFor: 'selecting' stamp: 'AndreiChis 3/20/2015 19:21'!
selectPreviousDueTo: anEventType

	self selected ifNil: [ ^ self ].
	self selected: self selected previousLink dueTo: anEventType! !

!GTSpotterStep methodsFor: 'accessing' stamp: 'AliaskeiSyrel 11/8/2014 17:13'!
origin: anObject

	origin := anObject! !

!GTSpotterStep methodsFor: 'actions' stamp: 'AliakseiSyrel 11/27/2014 12:34'!
canDiveInSelectedCandidate

	^ self canDiveIn: self selectedCandidate! !

!GTSpotterStep methodsFor: 'processing' stamp: 'StefanReichhart 3/18/2015 12:58'!
process: aString
	"I do not accept empty queries or the same queries as before.
	If nil is passed, than an empty string will be processed. This approach is used to
	destinguish when user deletes last character in the search and when search field became
	empty after spawning new step"
	
	"no need to search for the same query"
	(self context matches: aString) ifTrue: [ ^ self ].
	self context: (self newContextForQuery: aString).
	
	" updating timestamp in a stream, to prevent candidates from old process being shown "
	self stream updateTimestamp.
	
	self asyncTask
		execute: [ :aCurrentContext |
			self spotter notifyContextChangedFrom: lastSearchContext to: self context.
			self processContext: aCurrentContext ]
		withArguments: { self context. }
		callback: [
			lastSearchContext := self context. 
			self spotter notifySearchFinishedFor: aString processors: self processors ]
		"added small delay before actual searching. It makes spotter faster :)"
		delay: 200! !

!GTSpotterStep methodsFor: 'actions' stamp: 'AndreiChis 3/20/2015 19:26'!
diveIn
	self diveInDueTo: #undefined! !

!GTSpotterStep methodsFor: 'actions' stamp: 'TudorGirba 12/1/2014 14:32'!
canDiveIn: aCandidate
	| newFakeStep |
	newFakeStep := self spotter newStep origin: self origin.
	aCandidate spotterProcessorsFor: newFakeStep.
	^ newFakeStep processors notEmpty! !

!GTSpotterStep methodsFor: 'actions' stamp: 'AndreiChis 3/20/2015 19:28'!
diveInCategoryDueTo: anEventType

	self spotter
		requestNextCategoryStepWith: self selected processorLink;
		notifyDiveInCategory: self selected processor for: anEventType
	! !

!GTSpotterStep methodsFor: 'accessing-defaults' stamp: 'StefanReichhart 3/12/2015 12:46'!
defaultStream
	^ GTSpotterUIThreadStream new! !

!GTSpotterStep methodsFor: 'processing' stamp: 'StefanReichhart 3/18/2015 14:52'!
processContext: aSpotterContext
	self spotter handleExceptionsDuring: [ 
		self stream removeAllCandidates.
		self relevantProcessorsProcess: aSpotterContext  ]! !

!GTSpotterStep methodsFor: 'accessing' stamp: 'TudorGirba 11/24/2014 23:21'!
processors

	^ processors ifNil: [ 
		processors := OrderedCollection new.
		self origin spotterProcessorsFor: self.
		"this is a hack. we do it here just because we need to store the
		category name in the brick after the processors have been created"
		processors do: [ :each | 				
			self candidates addProcessor: each ].
		processors ]! !

!GTSpotterStep methodsFor: 'selecting' stamp: 'AndreiChis 3/20/2015 19:19'!
selected: aDoubleLink dueTo: anEvenType
	
	self selected = aDoubleLink ifTrue: [ ^ self ].
	
	self spotter
		after: [
			selected := aDoubleLink.
			self notifySelectedCandidateChanged: selected for: anEvenType]
		do: [ self spotter notifyCategorySelected: self selected processor ]
		ifTrue: [ aDoubleLink
			ifNotNil: [ self selected
				ifNotNil: [ (self selected processor = aDoubleLink processor) not ]
				ifNil: [ true ] ]
			ifNil: [ false ] ]
	
	! !

!GTSpotterStep methodsFor: 'actions' stamp: 'AliakseiSyrel 11/30/2014 21:02'!
terminateProcessors

	self asyncTask terminate! !

!GTSpotterStep methodsFor: 'accessing-dynamic' stamp: 'StefanReichhart 3/22/2015 18:47'!
exceptionHandler
	^ GTCurrentSpotterExceptionHandler value ifNil: [ self spotter exceptionHandler ]
	" #ifNil: is necessary because the sender chain of #spotterProcessorsFor:pragma: may have multiple callees outside of the exception handler (async) ... so we have to provide a global but yet easy fallback "! !

!GTSpotterStep methodsFor: 'accessing' stamp: 'StefanReichhart 3/12/2015 12:46'!
stream

	^ stream ifNil: [
		stream := self defaultStream.
		stream
			onAddedSelector: #addCandidate:in:;
			onRemoveSelector: #removeAllCandidatesOf:;
			receiver: self candidates.
		stream ]! !

!GTSpotterStep methodsFor: 'private' stamp: 'StefanReichhart 3/17/2015 15:19'!
relevantProcessorsProcess: aSpotterContext
	[ self basicRelevantProcessorsProcess: aSpotterContext ]
		on: Error
		do: [ :exception | 
			self exceptionHandler 
				handleException: exception 
				do: [ ('[Spotter] Exception in process: ', exception asString) logCr ] ]! !

!GTSpotterStep methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/25/2015 14:29'!
candidates

	^ candidates ifNil: [
		candidates := GTSpotterCandidatesList new.
		candidates announcer weak subscribe: GTSpotterCandidateAdded do: [ self candidates hasOnlyOneItem ifTrue: [ self selectFirst ] ].
		candidates announcer weak subscribe: GTSpotterAllCandidatesAdded do: [ self selectFirst ].
		candidates announcer weak subscribe: GTSpotterAllCandidatesRemoved do: [ self selected: nil ].
		candidates ]! !

!GTSpotterStep methodsFor: 'selecting' stamp: 'AndreiChis 3/20/2015 19:19'!
selected: aDoubleLink
	
	^ self selected: aDoubleLink dueTo: #unknown
	
	! !

!GTSpotterStep methodsFor: 'testing' stamp: 'AliakseiSyrel 11/14/2014 23:51'!
isEmpty

	^ self candidates isEmpty! !

!GTSpotterStep methodsFor: 'accessing' stamp: 'AndreiChis 2/28/2015 18:27'!
context: aGTSpotterContext
	context := aGTSpotterContext! !

!GTSpotterStep methodsFor: 'accessing' stamp: 'AliaskeiSyrel 11/8/2014 10:26'!
announcer

	^ announcer ifNil: [ announcer := Announcer new ]! !

!GTSpotterStep methodsFor: 'actions' stamp: 'AndreiChis 3/20/2015 19:25'!
diveInDueTo: anEventType
	self canDiveInSelectedCandidate ifTrue: [ 
		self spotter
			historize: self selected;
			requestNextStepWith: self selectedCandidate;
			notifyDiveIn: self selectedCandidate for: anEventType ]! !

!GTSpotterStep methodsFor: 'inspecting' stamp: 'TudorGirba 4/10/2015 10:59'!
gtInspectorProcessorsIn: composite
	<gtInspectorPresentationOrder: 40>
	composite list
		title: 'Processors';
		display: [ self processors ];
		format: #gtDisplayString! !

!GTSpotterStep methodsFor: 'accessing' stamp: 'TudorGirba 11/24/2014 10:14'!
spotter: aSpotter
	spotter := aSpotter ! !

!GTSpotterStep methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/24/2015 12:13'!
spotter

	^ spotter! !

!GTSpotterStep methodsFor: 'selecting' stamp: 'AndreiChis 3/20/2015 19:20'!
selectNextDueTo: anEventType
	
	self selected ifNil: [ ^ self ].
	self selected: self selected nextLink dueTo: anEventType
	
	! !

!GTSpotterStep methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/25/2015 14:11'!
selected

	^ selected ifNil: [
		selected := (self candidates isEmpty
			ifTrue: [ ^ nil ]
			ifFalse: [ self candidates head ]).
		self notifySelectedCandidateChanged: selected.
		selected ifNotNil: [ self spotter notifyCategorySelected: self selected processor ].
		selected ]! !

!GTSpotterStep methodsFor: 'notifying' stamp: 'AndreiChis 3/20/2015 19:08'!
notifySelectedCandidateChanged: aDoubleLink
	
	^ self notifySelectedCandidateChanged: aDoubleLink for: #unknown! !

!GTSpotterStep methodsFor: 'accessing' stamp: 'AliaskeiSyrel 11/8/2014 10:27'!
processors: aCollection

	processors := aCollection! !

!GTSpotterStep methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/14/2014 16:00'!
selectedCandidate

	^ self selected
		ifNotNil: [ self selected value ]
		ifNil: [ nil ]! !

!GTSpotterStep methodsFor: 'private' stamp: 'StefanReichhart 3/17/2015 15:10'!
basicRelevantProcessorsProcess: aSpotterContext
	self basicRelevantProcessorsProcess: aSpotterContext do: [ :processor | 
		aSpotterContext processor: processor.
		processor filterInContext: aSpotterContext ]! !

!GTSpotterStep methodsFor: 'accessing-defaults' stamp: 'StefanReichhart 3/12/2015 12:46'!
defaultTask
	^ GLMAsyncTask new! !

!GTSpotterStep methodsFor: 'actions' stamp: 'AliakseiSyrel 2/24/2015 12:24'!
exit

	self spotter exit! !

!GTSpotterStep methodsFor: 'selecting' stamp: 'AliakseiSyrel 2/24/2015 11:06'!
selectPreviousCategory
	|currentCategory previousCategory|
	self selected ifNil: [ ^ self ].
	
	currentCategory := self candidates getProcessorLinkByCandidateLink: self selected.
	previousCategory := self candidates previousProcessorLinkOf: currentCategory.
	
	self selected: previousCategory headLink! !

!GTSpotterStep methodsFor: 'actions' stamp: 'AndreiChis 3/20/2015 19:31'!
actDueTo: anEventType
	self selected ifNil: [ ^ self ].
	self spotter
		historize: self selected;
		notifyActOn: self selectedCandidate for: anEventType.
	self selected processor actOn: self selectedCandidate for: self
! !

!GTSpotterStep methodsFor: 'accessing' stamp: 'TudorGirba 11/26/2014 14:34'!
listProcessor
	| processor |
	processor := GTSpotterCandidatesListProcessor new.
	self addProcessor: processor.
	^ processor! !

!GTSpotterStep methodsFor: 'accessing' stamp: 'StefanReichhart 2/24/2015 17:07'!
context

	^ context ifNil: [ context := self newContextForQuery: nil ]! !

!GTSpotterStep methodsFor: 'notifying' stamp: 'AndreiChis 3/20/2015 19:08'!
notifySelectedCandidateChanged: aDoubleLink for: anEventType
	|candidate|
	
	candidate := aDoubleLink ifNotNil: [ :o | o value ].
	self announcer announce: (GTSpotterSelectedCandidateChanged new selected: candidate).
	self spotter notifyCandidateSelected: candidate for: anEventType! !

!GTSpotterStep class methodsFor: 'example' stamp: 'TudorGirba 4/10/2015 11:05'!
gtExampleBasic
	<gtExample>
	^ self new! !

!GTSpotterStepAdded methodsFor: 'accessing' stamp: 'AliaskeiSyrel 11/6/2014 13:38'!
stepModel
	^ stepModel! !

!GTSpotterStepAdded methodsFor: 'accessing' stamp: 'AliaskeiSyrel 11/6/2014 13:38'!
stepModel: anObject
	stepModel := anObject! !

!GTSpotterStepBreadcrumbItem methodsFor: 'actions' stamp: 'AliakseiSyrel 2/18/2015 14:19'!
click: evt
	super click: evt.
	
	self stepModel spotter popUntil: self stepModel.
	^ true! !

!GTSpotterStepBreadcrumbItem methodsFor: 'brick-properties-events' stamp: 'AliakseiSyrel 3/21/2015 22:30'!
onThemerChanged
	super onThemerChanged.
	
	self themer spotterThemer breadcrumbItemLabelWidgetStyleFor: self labelBrick.
	self themer spotterThemer breadcrumbItemTriangleWidgetStyleFor: self triangleBrick! !

!GTSpotterStepBreadcrumbItem methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/18/2015 14:13'!
stepModel
	^ stepModel! !

!GTSpotterStepBreadcrumbItem methodsFor: 'instance creation' stamp: 'AliakseiSyrel 1/25/2015 14:14'!
newLabelBrick

	^ GLMLabelBrick new! !

!GTSpotterStepBreadcrumbItem methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/30/2015 16:07'!
labelBrick: aBrick

	labelBrick := aBrick.
	
	self themer spotterThemer breadcrumbItemLabelStyleFor: self labelBrick.
	self addBrickBack: self labelBrick! !

!GTSpotterStepBreadcrumbItem methodsFor: 'instance creation' stamp: 'AliakseiSyrel 1/25/2015 14:14'!
newTriangleBrick

	^ GLMBrick new! !

!GTSpotterStepBreadcrumbItem methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/26/2015 00:30'!
text: aString

	self labelBrick text: aString.
	self doLayoutForce! !

!GTSpotterStepBreadcrumbItem methodsFor: 'actions' stamp: 'AliakseiSyrel 2/18/2015 15:12'!
deselect
	
	self invalidateWith: [
		self labelBrick label customFont; beRegular ]! !

!GTSpotterStepBreadcrumbItem methodsFor: 'testing' stamp: 'AliakseiSyrel 3/21/2015 22:50'!
isTriangleVisible

	^ isTriangleVisible ifNil: [ isTriangleVisible := true ]! !

!GTSpotterStepBreadcrumbItem methodsFor: 'actions' stamp: 'AliakseiSyrel 3/21/2015 22:54'!
showTriangle

	isTriangleVisible := true.
	self themer spotterThemer breadcrumbItemTriangleWidgetStyleFor: self triangleBrick! !

!GTSpotterStepBreadcrumbItem methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/18/2015 14:19'!
initialize
	super initialize.
	
	self
		useVerticalLinearLayout;
		labelBrick: self newLabelBrick;
		triangleBrick: self newTriangleBrick;
		enable
	! !

!GTSpotterStepBreadcrumbItem methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/25/2015 13:25'!
labelBrick

	^ labelBrick! !

!GTSpotterStepBreadcrumbItem methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/18/2015 14:13'!
stepModel: anObject
	stepModel := anObject! !

!GTSpotterStepBreadcrumbItem methodsFor: 'actions' stamp: 'AliakseiSyrel 2/18/2015 15:12'!
select
	
	self invalidateWith: [
		self labelBrick label customFont; beBold ]! !

!GTSpotterStepBreadcrumbItem methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/25/2015 14:09'!
triangleBrick

	^ triangleBrick! !

!GTSpotterStepBreadcrumbItem methodsFor: 'actions' stamp: 'AliakseiSyrel 3/21/2015 22:54'!
hideTriangle

	isTriangleVisible := false.
	self themer spotterThemer breadcrumbItemTriangleWidgetStyleFor: self triangleBrick! !

!GTSpotterStepBreadcrumbItem methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/30/2015 16:07'!
triangleBrick: aBrick

	triangleBrick := aBrick.
	
	self themer spotterThemer breadcrumbItemTriangleStyleFor: self triangleBrick.
	self addBrickBack: self triangleBrick! !

!GTSpotterStepTest methodsFor: 'private' stamp: 'StefanReichhart 3/12/2015 17:12'!
basicSearch: aString
	
	" assert conditions before search "
	self flag: '#currentStep should be made more stable. This will fail for an empty, uninitialized spotter / but after multiple diveIn/diveOut it will be ok - inconsistent'.
	self assert: spotter currentStep == spotter currentStep.
	
	" backup preconditions "
	previousStep := spotter currentStep.
	previousContext := previousStep context.

	self shouldnt: [ spotter setText: aString from: nil ] raise: Error.
	
	" backup postconditions "
	currentStep := spotter currentStep.
	currentContext := spotter currentStep context.
	
	" assert conditions after search "
	self assert: previousStep == currentStep.! !

!GTSpotterStepTest methodsFor: 'tests' stamp: 'StefanReichhart 3/12/2015 16:31'!
testProcessorForImplementors
	| partialImplementors |
	self assertSearch: 'do:'.
	self assertProcessorByTitle: 'Implementors'.
	self assertProcessorNotEmpty.
	
	partialImplementors := (SystemNavigation default allImplementorsOf: #do:) collect: [ :rm | rm compiledMethod ].
	self assertProcessorIncludesAll: partialImplementors.
	self assert: currentProcessor allFilteredCandidates size > partialImplementors size.
	
	self assertSearch: 'size'.
	self assertProcessorByTitle: 'Implementors'.
	self assertProcessorNotEmpty.
	
	partialImplementors := (SystemNavigation default allImplementorsOf: #size) collect: [ :rm | rm compiledMethod ].
	self assertProcessorIncludesAll: partialImplementors.
	self assert: currentProcessor allFilteredCandidates size > partialImplementors size.! !

!GTSpotterStepTest methodsFor: 'convenience' stamp: 'StefanReichhart 3/12/2015 16:10'!
assortCandidatesSize: aNumber! !

!GTSpotterStepTest methodsFor: 'convenience' stamp: 'StefanReichhart 3/12/2015 15:41'!
assertProcessorNotEmpty
	self assert: currentProcessor notNil.
	self deny: currentProcessor allFilteredCandidates isEmpty.! !

!GTSpotterStepTest methodsFor: 'private-navigation' stamp: 'StefanReichhart 3/12/2015 15:30'!
subclassesOf: aClass filterBySubstring: aString inPackage: aPackageName
	^ (self subclassesOf: aClass inPackage: aPackageName) select: [ :each |
		each name includesSubstring: aString caseSensitive: false ]! !

!GTSpotterStepTest methodsFor: 'private-navigation' stamp: 'StefanReichhart 3/12/2015 15:49'!
senders: aSelector inPackages: anArray
	| senders |
	senders := OrderedCollection new.
	RPackageOrganizer default packages do: [ :package |
		anArray do: [ :packageName |
			package packageName = packageName ifTrue: [ 
				package methods do: [ :cm | 
					(cm refersToLiteral: aSelector) ifTrue: [ 
						senders add: cm ] ] ] ] ].
	^ senders! !

!GTSpotterStepTest methodsFor: 'private-navigation' stamp: 'StefanReichhart 3/12/2015 16:09'!
pragmas: aSelector inPackages: anArray
	| pragmas |
	pragmas := OrderedCollection new.
	RPackageOrganizer default packages do: [ :package |
		anArray do: [ :packageName |
			package packageName = packageName ifTrue: [ 
				package methods do: [ :cm | 
					cm methodClass isTrait ifFalse: [ 
						(cm pragmas 
							detect: [ :p | p keyword = aSelector ] 
							ifNone: [ nil ]) ifNotNilDo: [ :p | pragmas add: p ] ] ] ] ] ].
	^ pragmas! !

!GTSpotterStepTest methodsFor: 'tests' stamp: 'StefanReichhart 3/12/2015 17:06'!
testProcessorForPragmasThenDiveInCategory
	self testProcessorForPragmas.
	
	" diving into the category (without search) just reveals what was shown before - so this can be repeated infinitely and should return the same result each time "
	4 timesRepeat: [
		self assertDiveInCategory.
		self assertProcessorByTitle: 'Pragmas'.
		self assertProcessorNotEmpty.
		self assert: currentProcessor allFilteredCandidates size >= 1.
		self assertCandidateMatching: [ :each | each class = PragmaType and: [ each keyword = #spotterOrder: ] ]  ].
	
	4 timesRepeat: [
		self assert: currentStep context text = ''.
		self assertDiveOut ].
	
	self assert: currentStep context text = 'spotterOrder:'! !

!GTSpotterStepTest methodsFor: 'private-navigation' stamp: 'StefanReichhart 3/12/2015 16:12'!
pragmas: aSelector
	^ self pragmas: aSelector inPackages: self defaultPackages! !

!GTSpotterStepTest methodsFor: 'convenience' stamp: 'StefanReichhart 3/12/2015 15:43'!
assertDiveInCategory
	self assertDiveIn: #diveInCategory! !

!GTSpotterStepTest methodsFor: 'convenience' stamp: 'StefanReichhart 3/12/2015 15:40'!
assertProcessorByTitle: aString
	^ self assertProcessorMatching: [ :processor | processor title = aString ]! !

!GTSpotterStepTest methodsFor: 'private-navigation' stamp: 'StefanReichhart 3/12/2015 16:14'!
implementors: aSelector
	^ self implementors: aSelector inPackages: self defaultPackages! !

!GTSpotterStepTest methodsFor: 'convenience' stamp: 'StefanReichhart 3/12/2015 15:39'!
assertCandidateMatching: aBlock
	| candidates |
	self assert: currentProcessor notNil.
	
	candidates := currentProcessor allFilteredCandidates select: [ :each | aBlock value: each ].
	
	self deny: candidates isEmpty.
	self assert: candidates size = 1.
	
	currentCandidate := candidates anyOne.
	self assert: currentCandidate notNil.
	
	^ currentCandidate! !

!GTSpotterStepTest methodsFor: 'convenience' stamp: 'StefanReichhart 3/12/2015 15:39'!
assertProcessorIncludesAll: aCollection
	self assert: aCollection notEmpty.
	self assert: currentProcessor notNil.
	self assert: currentProcessor allFilteredCandidates notEmpty.
	
	aCollection do: [ :each | 
		self assert: (currentProcessor allFilteredCandidates anySatisfy: [ :candidate | 
			candidate = each ]) ]! !

!GTSpotterStepTest methodsFor: 'private-navigation' stamp: 'StefanReichhart 3/12/2015 16:21'!
pragma: aSelector of: aCompiledMethod
	^ aCompiledMethod pragmas 
		detect: [ :each | each keyword = aSelector ] 
		ifNone: [ nil ]! !

!GTSpotterStepTest methodsFor: 'private-navigation' stamp: 'StefanReichhart 3/12/2015 15:30'!
subclassesOf: aClass inPackage: aPackageName
	^ (RPackageOrganizer default packages 
		detect: [ :each | each packageName = aPackageName ] 
		ifNone: [ ^ #() ]) classes intersection: aClass withAllSubclasses! !

!GTSpotterStepTest methodsFor: 'running' stamp: 'StefanReichhart 3/12/2015 14:57'!
tearDown
	super tearDown.
	
	spotter := currentStep := currentProcessor := currentCandidate := nil! !

!GTSpotterStepTest methodsFor: 'convenience' stamp: 'StefanReichhart 3/12/2015 15:14'!
denySearch: aString
	" if the new input is the same as before we do not expect a new search to be triggered . Therefore the context should not change "
	
	"self assert: (spotter currentStep context matches: aStringOrText)."
	
	self basicSearch: aString.
	
	" assert conditions after search "
	self assert: previousContext == currentContext.
	self assert: previousContext == spotter currentStep context.
	self assert: (previousContext matches: aString).! !

!GTSpotterStepTest methodsFor: 'tests' stamp: 'StefanReichhart 3/12/2015 15:38'!
testProcessorForPragmas
	self assertSearch: 'spotterOrder:'.
	self assertProcessorByTitle: 'Pragmas'.
	self assertProcessorNotEmpty.
	self assert: currentProcessor allFilteredCandidates size >= 1.
	self assertCandidateMatching: [ :each | each class = PragmaType and: [ each keyword = #spotterOrder: ] ]  ! !

!GTSpotterStepTest methodsFor: 'tests' stamp: 'StefanReichhart 3/12/2015 17:06'!
testProcessorForPragmasThenDiveIn
	self testProcessorForPragmas.
	
	self assertDiveIn.

	self assertProcessorByTitle: 'Pragmas'.
	self assertProcessorNotEmpty.
	self assertProcessorIncludesAll: (self pragmas: #spotterOrder:).
		
	self assertProcessorByTitle: 'Senders'.
	self assertProcessorNotEmpty.
	self assertProcessorIncludesAll: (self senders: #spotterOrder:).
	
	self assertSearch: 'spotterForClassesFor:'.
	
	self assertProcessorByTitle: 'Pragmas'.
	self assertProcessorNotEmpty.
	self assertProcessorIncludes: (self pragma: #spotterOrder: of: (GTSpotter >> #spotterForClassesFor:)).
	
	self assertProcessorByTitle: 'Senders'.
	self assertProcessorNotEmpty.
	self assertProcessorIncludes: (GTSpotter >> #spotterForClassesFor:).
	
	self assertSearch: 'spotterForF'.
	
	self assertProcessorByTitle: 'Senders'.
	self assertProcessorNotEmpty.
	self assertProcessorIncludes: (GTSpotter >> #spotterForFilesFor:).
	self assertProcessorIncludes: (FileReference >> #spotterForFilesFor:).
	
	self assertDiveOut.
	
	self assert: currentStep context text = 'spotterOrder:'! !

!GTSpotterStepTest methodsFor: 'convenience' stamp: 'StefanReichhart 3/12/2015 15:37'!
assertProcessorMatching: aBlock
	| processors |
	processors := spotter currentStep processors select: [ :each | aBlock value: each ].
	
	self assert: processors notEmpty.
	self assert: processors size = 1.
	
	currentProcessor := processors anyOne.
	self assert: currentProcessor notNil.
	
	^ currentProcessor! !

!GTSpotterStepTest methodsFor: 'convenience' stamp: 'StefanReichhart 3/12/2015 15:31'!
assertSearch: aString

	" assert conditions before search "
	self deny: (spotter currentStep context matches: aString).
	
	self basicSearch: aString.
		
	" assert conditions after search "
	self deny: previousContext == currentContext.
	self deny: previousContext == spotter currentStep context.
	self assert: spotter currentStep context text asString = aString asString! !

!GTSpotterStepTest methodsFor: 'private-navigation' stamp: 'StefanReichhart 3/12/2015 16:12'!
senders: aSelector
	^ self senders: aSelector inPackages: self defaultPackages! !

!GTSpotterStepTest methodsFor: 'tests' stamp: 'StefanReichhart 3/12/2015 15:04'!
testMock
	" test the mock setup - the mock objects do exactly the same as the original implementation, but we replace the asynchronous implementation by a synchronous "
	self assert: spotter class = GTMockSpotter.
	self assert: spotter newStep class = GTMockSpotterStep.
	self assert: spotter newStep asyncTask class = GTMockSpotterTask.! !

!GTSpotterStepTest methodsFor: 'convenience' stamp: 'StefanReichhart 3/12/2015 16:18'!
assertProcessorIncludes: anObject
	self assert: anObject notNil.
	self assert: currentProcessor notNil.
	self assert: currentProcessor allFilteredCandidates notEmpty.
	
	self assert: (currentProcessor allFilteredCandidates anySatisfy: [ :candidate | candidate = anObject ])! !

!GTSpotterStepTest methodsFor: 'running' stamp: 'StefanReichhart 3/22/2015 18:14'!
"protocol: running"
setUp
	super setUp.
	
	spotter := GTMockSpotter new.
	" having an assertion within the setup is ugly, but this code has to be performed before each test begins - so we do it here instead of copy/paste-ing this line to all tests - at least it never gets forgotten when new tests are defined "
	self shouldnt: [ spotter setText: '' from: self ] raise: Error. 
	
	currentStep := currentProcessor := currentCandidate := nil! !

!GTSpotterStepTest methodsFor: 'private-navigation' stamp: 'StefanReichhart 3/12/2015 16:15'!
implementors: aSelector inPackages: anArray
	| implementors |
	implementors := OrderedCollection new.
	RPackageOrganizer default packages do: [ :package |
		anArray do: [ :packageName |
			package packageName = packageName ifTrue: [ 
				package methods do: [ :cm | 
					cm selector = implementors ifTrue: [ implementors add: cm ] ] ] ] ].
	^ implementors! !

!GTSpotterStepTest methodsFor: 'convenience' stamp: 'StefanReichhart 3/12/2015 16:48'!
assertDiveOut
	| previousStepsSize |
	" backup previous conditions "
	previousStepsSize := spotter steps size.
	previousStep := spotter currentStep.

	" perform the dive operation - like the UI would do "
	self shouldnt: [ spotter popStep ] raise: Error.
	currentStep := spotter currentStep.
	currentProcessor := currentCandidate := previousContext := currentContext := nil.
	
	self assert: spotter steps size < previousStepsSize.
	self assert: spotter steps size = (previousStepsSize - 1).
	
	self deny: (previousStepsSize > 1 and: [ previousStep = currentStep ]).
	self deny: (previousStepsSize > 1 and: [ previousStep = spotter currentStep ]).
	self assert: currentStep = spotter currentStep.! !

!GTSpotterStepTest methodsFor: 'tests' stamp: 'StefanReichhart 3/12/2015 15:32'!
testProcessorForClasses
	self assertSearch: 'Collection'.
	self assertProcessorByTitle: 'Classes'.
	self assertProcessorNotEmpty.
	self assertProcessorIncludesAll: (self subclassesOf: Collection 
														filterBySubstring: 'Collection' 
														inPackage: 'Collections-Abstract')! !

!GTSpotterStepTest methodsFor: 'private' stamp: 'StefanReichhart 3/12/2015 15:47'!
assertDiveIn: aSelector
	| previousStepsSize link |
	" backup previous conditions "
	previousStepsSize := spotter steps size.
	previousStep := spotter currentStep.

	" get and validate the link "
	link := spotter currentStep candidates getCandidateLink: currentCandidate in: currentProcessor.
	
	self assert: link notNil.
	self assert: link value == currentCandidate.
	self assert: link processor == currentProcessor.

	" set the selection - like the UI would do "
	self shouldnt: [ spotter currentStep selected: link ] raise: Error.
	self assert: spotter currentStep selected == link.
	
	" perform the dive operation - like the UI would do "
	self shouldnt: [ spotter currentStep perform: aSelector ] raise: Error.
	currentStep := spotter currentStep.
	currentProcessor := currentCandidate := previousContext := currentContext := nil.
	
	self deny: spotter steps isEmpty .
	self assert: spotter steps size > previousStepsSize.
	self assert: spotter steps size = (previousStepsSize + 1).
	
	self deny: previousStep = currentStep.
	self deny: previousStep = spotter currentStep.
	self assert: currentStep = spotter currentStep.! !

!GTSpotterStepTest methodsFor: 'convenience' stamp: 'StefanReichhart 3/12/2015 15:43'!
assertDiveIn
	self assertDiveIn: #diveIn! !

!GTSpotterStepTest methodsFor: 'private-navigation' stamp: 'StefanReichhart 3/12/2015 16:12'!
defaultPackages
	^ { 'GT-Spotter'. 'GT-SpotterExtensions-Core' }! !

!GTSpotterStepTest methodsFor: 'tests' stamp: 'StefanReichhart 3/12/2015 15:31'!
testContextChange
	
	self assertSearch: 'a'.
	self assert: previousContext text = ''.
	self denySearch: 'a'.
	
	self assertSearch: 'ab'.
	self assert: previousContext text = 'a'.
	self denySearch: 'ab'.
	
	self assertSearch: 'abc'.
	self assert: previousContext text = 'ab'.
	self denySearch: 'abc'.
	
	self assertSearch: 'ab'.
	self assert: previousContext text = 'abc'.
	self denySearch: 'ab'.
	
	self assertSearch: 'a'.
	self assert: previousContext text = 'ab'.
	self denySearch: 'a'.
	
	self assertSearch: ''.
	self assert: previousContext text = 'a'.
	
	self flag: 'because the decision for triggering a search is made in multiple places, an empty input will always trigger a search - this should be simplified - one place to make the decision GTSpotter>>#setText:from: <-> #Context>>#matches:'.
	self assertSearch: ''.
	self assertSearch: ''.
	! !

!GTSpotterStepsBreadcrumb methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/8/2015 17:40'!
band: aBrick

	band := aBrick.
	band
		useHorizontalLinearLayout;
		hShrinkWrap;
		vSpaceFill.
	
	self band data: 0.
	self addBrickBack: band.! !

!GTSpotterStepsBreadcrumb methodsFor: 'adding/removing' stamp: 'AliakseiSyrel 3/21/2015 22:27'!
addSeparator
	|separator|
	separator := self newSeparator.
	self themer spotterThemer breadcrumbSeparatorStyleFor: separator.
	self themer spotterThemer breadcrumbSeparatorWidgetStyleFor: separator.
	self band addBrickBack: separator! !

!GTSpotterStepsBreadcrumb methodsFor: 'brick-properties-events' stamp: 'AliakseiSyrel 3/21/2015 22:30'!
onThemerChanged
	super onThemerChanged.
	
	self band subbricks withIndexDo: [ :each :index | index even ifTrue: [ self themer spotterThemer breadcrumbSeparatorWidgetStyleFor: each ] ]! !

!GTSpotterStepsBreadcrumb methodsFor: 'accessing' stamp: 'AliakseiSyrel 2/18/2015 11:56'!
animation

	^ animation! !

!GTSpotterStepsBreadcrumb methodsFor: 'instance creation' stamp: 'AliakseiSyrel 11/20/2014 14:13'!
newBand

	^ GLMBrick new! !

!GTSpotterStepsBreadcrumb methodsFor: 'adding/removing' stamp: 'AliakseiSyrel 2/10/2015 13:47'!
addItem: aBrick

	aBrick width: [ :itemBrick | self calculateItemWidth: itemBrick ].
	aBrick layout widthDependency: self.
	
	self items size = 1 ifTrue: [
		self items first labelBrick paddingLeft: self themer spotterThemer breadcrumbSeparatorWidth / 2 ].
	
	self items addLast: aBrick.
	self band addBrickBack: aBrick.
	self items do: [ :b | b wrappedBounds markWidthDirty ].
	self band doLayoutForce.! !

!GTSpotterStepsBreadcrumb methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/20/2014 14:12'!
band

	^ band! !

!GTSpotterStepsBreadcrumb methodsFor: 'initialization' stamp: 'AliakseiSyrel 2/10/2015 13:31'!
initialize
	super initialize.
	
	self band: self newBand! !

!GTSpotterStepsBreadcrumb methodsFor: 'events-processing' stamp: 'AliakseiSyrel 11/20/2014 13:39'!
onStepPopped

	self pop
	! !

!GTSpotterStepsBreadcrumb methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/30/2015 16:07'!
defaultBreadcrumbHeight

	^ self themer spotterThemer breadcrumbHeight + self themer spotterThemer breadcrumbTriangleHeight! !

!GTSpotterStepsBreadcrumb methodsFor: 'adding/removing' stamp: 'AliakseiSyrel 2/17/2015 19:39'!
pop
	
	self band layoutAfter: [
		self band removeBrick: self items removeLast.
		self items size = 1 ifTrue: [
			self items first labelBrick paddingLeft: 0 ].
		self items isEmpty ifFalse: [ self popSeparator ].
		self items do: [ :b | b wrappedBounds markWidthDirty ] ].
	
	"optimization. if last item was popped we need to update root to reposition all brick,
	otherwise only I need to be updated"
	self items size = 0
		ifTrue: [ self notifyBreadcrumbVisibilityChanged ]
		ifFalse: [
			self items last showTriangle.
			self scrollToTheLastOne.
			self changed ]! !

!GTSpotterStepsBreadcrumb methodsFor: 'events-processing' stamp: 'TudorGirba 2/21/2015 22:42'!
onStepAdded: ann
	|step origin previousStep selectedCandidate|
	
	self spotterModel steps size <= 1 ifTrue: [
		^ self push: (GTSpotterStepBreadcrumbItem new
						text: self spotterModel steps first origin gtDisplayString;
						stepModel: self spotterModel steps first) ].
	
	step := ann stepModel.
	previousStep := (step spotter steps at: step spotter steps size - 1).
	selectedCandidate := previousStep selectedCandidate.
	origin := step origin.
	
	self push: (GTSpotterStepBreadcrumbItem new
		stepModel: step;
		text: ((selectedCandidate = origin)
			ifTrue: [ (previousStep selected renderingProcessor render: selectedCandidate) labelBrick text ]
			ifFalse: [ (origin isKindOf: Collection) ifTrue: [ previousStep selected processor title ] ifFalse: [ origin gtDisplayString] ]))! !

!GTSpotterStepsBreadcrumb methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/27/2015 10:58'!
spotterModel: aSpotterModel
	
	spotterModel := aSpotterModel.
	
	spotterModel announcer weak subscribe: GTSpotterStepAdded send: #onStepAdded: to: self.
	spotterModel announcer weak subscribe: GTSpotterStepPopped send: #onStepPopped to: self.! !

!GTSpotterStepsBreadcrumb methodsFor: 'adding/removing' stamp: 'AliakseiSyrel 2/17/2015 19:41'!
push: aBrick

	self themer spotterThemer breadcrumbItemStyleFor: aBrick.
	
	self band layoutAfter: [
		self items isEmpty ifFalse: [
			self items last hideTriangle.
			self addSeparator ].
		self addItem: aBrick ].
	
	"optimization. if first item was added we need to update root to reposition all bricks,
	otherwise only I need to be updated"
	self items size = 1
		ifTrue: [ self notifyBreadcrumbVisibilityChanged ]
		ifFalse: [
			self scrollToTheLastOne.
			self changed ].
	! !

!GTSpotterStepsBreadcrumb methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/20/2014 11:47'!
maxNumberOfSteps
	^ 5! !

!GTSpotterStepsBreadcrumb methodsFor: 'adding/removing' stamp: 'AliakseiSyrel 1/26/2015 00:09'!
popSeparator

	self band removeBrick: self band lastSubbrick! !

!GTSpotterStepsBreadcrumb methodsFor: 'instance creation' stamp: 'AliakseiSyrel 1/26/2015 00:22'!
newSeparator

	^ GLMBrick new! !

!GTSpotterStepsBreadcrumb methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/15/2014 20:38'!
spotterModel
	^ spotterModel! !

!GTSpotterStepsBreadcrumb methodsFor: 'geometry' stamp: 'AliakseiSyrel 2/18/2015 12:31'!
glmAnimateBrickBounds: aValue duration: anInteger callback: aBlock

	self animation ifNotNil: #terminate.
	animation := GLMAnimation new
		linear;
		duration: anInteger;
		from: self band brickBounds left;
		to: self band brickBounds left + aValue;
		onCompleted: aBlock;
		animation: [ :b :v | b changedWith: [ b translateXTo: v asInteger; data: b brickBounds left ] ];
		animate: self band! !

!GTSpotterStepsBreadcrumb methodsFor: 'geometry' stamp: 'AliakseiSyrel 2/10/2015 14:06'!
calculateItemWidth: aBrick
	|sWidth bWidth singleWidth lastWidth|
	sWidth := self themer spotterThemer breadcrumbSeparatorWidth.
	bWidth := self width.
	lastWidth := ((aBrick labelBrick approximateWidth min: (bWidth / 2)) max: ((bWidth - ((self maxNumberOfSteps - 1) * sWidth)) / self maxNumberOfSteps)) floor.
	singleWidth := ((bWidth - lastWidth - ((self maxNumberOfSteps - 1) * sWidth)) / (self maxNumberOfSteps - 1)) floor.
	
	"width of other bricks depends on the width of the last one"
	^ aBrick isLastInOwner
		ifTrue: [
			self items size >= self maxNumberOfSteps ifTrue: [ |fullWidth delta|
				fullWidth := lastWidth + ((self maxNumberOfSteps - 1) * (sWidth + singleWidth)).
				delta := bWidth - fullWidth.
				lastWidth := lastWidth + delta ].
			lastWidth ]
		ifFalse: [ singleWidth ]
	! !

!GTSpotterStepsBreadcrumb methodsFor: 'notifying' stamp: 'TudorGirba 11/26/2014 14:35'!
notifyBreadcrumbVisibilityChanged

	self announcer announce: GTSpotterBreadcrumbVisibilityChanged new! !

!GTSpotterStepsBreadcrumb methodsFor: 'testing' stamp: 'AliakseiSyrel 11/21/2014 00:55'!
isVisible

	^ self items isEmpty not! !

!GTSpotterStepsBreadcrumb methodsFor: 'brick-layout-events' stamp: 'AliakseiSyrel 2/18/2015 12:32'!
onChildrenLayouted
	super onChildrenLayouted.
	
	self band translateXTo: (self band data ifNil: [ 0 ]).
	self scrollToTheLastOne! !

!GTSpotterStepsBreadcrumb methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/20/2014 13:28'!
items

	^ items ifNil: [ items := OrderedCollection new ]! !

!GTSpotterStepsBreadcrumb methodsFor: 'geometry' stamp: 'AliakseiSyrel 2/18/2015 12:29'!
scrollToTheLastOne
	|leftDelta rightDelta delta|
	self items isEmpty ifTrue: [ ^ self ].
	
	rightDelta := self globalBounds right - self band globalBounds right.
	leftDelta := self globalBounds left - self band globalBounds left.
			
	"all visible, return"
	(leftDelta = 0  and: [ self items size <= self maxNumberOfSteps ]) ifTrue: [ ^ self ].
	
	delta := (self items size <= self maxNumberOfSteps) ifTrue: [ leftDelta ] ifFalse: [ rightDelta ].
	delta := self band brickBounds left + delta - self band data.
	
	self
		glmAnimateBrickBounds: delta
		duration: 400
		callback: nil.
	
	! !

!GTSpotterStreamMock methodsFor: 'as yet unclassified' stamp: 'DamienCassou 2/4/2015 12:28'!
initialize
	super initialize.
	objects := OrderedCollection new.! !

!GTSpotterStreamMock methodsFor: 'as yet unclassified' stamp: 'DamienCassou 2/4/2015 12:28'!
addObject: anObject inProcessor: aProcessor
	objects add: anObject! !

!GTSpotterStreamMock methodsFor: 'accessing' stamp: 'DamienCassou 2/4/2015 12:29'!
objects
	^ objects! !

!GTSpotterTest methodsFor: 'tests' stamp: 'StefanReichhart 3/22/2015 18:40'!
"protocol: tests"
testInstanceCreation
	self shouldnt: [ spotter := GTMockSpotter new ] raise: Error.
	self shouldnt: [ 
		spotter := GTMockSpotter new
			exceptionHandler: GTSpotterDebuggingExceptionHandler new;
			yourself ] raise: Error.
	
	self assert: spotter notNil.
	self assert: spotter steps isEmpty.
	self deny: spotter hasPreviousStep! !

!GTSpotterTest methodsFor: 'assertions' stamp: 'StefanReichhart 3/12/2015 09:41'!
assertText: aTextualObject do: aBlock
	| result |
	" self: emulate a view. Forget about a separate GTSpotterMockView. kiss :) "
	self shouldnt: [ result := spotter setText: aTextualObject from: self. ] raise: Error.
	
	self assert: result.
	self deny: spotter isEmpty.
	self deny: spotter steps isEmpty.
	
	self shouldnt: [ aBlock value ] raise: Error.
	
	! !

!GTSpotterTest methodsFor: 'tests' stamp: 'StefanReichhart 3/12/2015 17:12'!
testNewSpotter
	| step1 |
	self testInstanceCreation.
	
	self assert: spotter notNil.
	self assert: spotter isEmpty.
	self assert: spotter steps isEmpty.
	self deny: spotter hasPreviousStep.
	
	self shouldnt: [ step1 := spotter currentStep ] raise: Error.
	
	self flag: '#currentStep is not always cached in spotter - especially when it is a new/empty spotter. In that case #currentStep will always return a new instance of a step. The implementation would be more polymorphic, oo-style, simpler and with much less ifTrue/ifFalse if the initial-state were regarded as a step as well (as an inst-var not in the inst-var-list of #steps). Maybe use a separate type to distinguish? GTSpotterInitialStep ... '.
	"self assert: step1 == spotter currentStep"
	
	self assert: step1 notNil.
	self assert: spotter isEmpty.
	self assert: spotter steps isEmpty.! !

!GTSpotterTest methodsFor: 'assertions' stamp: 'StefanReichhart 3/12/2015 09:33'!
assertText: aTextualObject
	self assertText: aTextualObject do: nil! !

!GTSpotterTest methodsFor: 'tests' stamp: 'StefanReichhart 3/12/2015 09:45'!
testEmptyTextInput
	self testNewSpotter.
	
	self assertText: Text new do: [ self assert: spotter text isEmpty ].
	self assertText: (Text fromString: '') do: [ self assert: spotter text isEmpty ].
	self assertText: '' do: [ self assert: spotter text isEmpty ].
	self flag: 'currently: nil is converted to the string "nil"'
	"self assertText: nil do: [ self assert: spotter text isEmpty ]."! !

!GTSpotterTest methodsFor: 'tests' stamp: 'StefanReichhart 3/12/2015 09:42'!
testInitialText
	self testNewSpotter.
	
	self flag: 'is this instvar still required ? we have context'.
	self assert: spotter getText isEmptyOrNil.
	self assert: spotter text isEmptyOrNil.
! !

!GTSpotterTest methodsFor: 'tests' stamp: 'TudorGirba 4/10/2015 13:25'!
testHistorizingTheSameObjectRemovesPreviousOccurences
	| history |
	history := OrderedCollection new.
	spotter := GTSpotter new history: history.
	spotter historize: (GTSpotterCandidateLink new value: 42).
	self assert: history size = 1.
	spotter historize: (GTSpotterCandidateLink new value: 43).
	self assert: history size = 2.
	self assert: history first value = 43.
	self assert: history last value = 42.
	spotter historize: (GTSpotterCandidateLink new value: 42).
	self assert: history size = 2.
	self assert: history first value = 42.
	self assert: history last value = 43.
! !

!GTSpotterTriangleRenderer methodsFor: 'rendering' stamp: 'AliakseiSyrel 1/25/2015 13:56'!
renderTriangle: aBrick on: aCanvas with: aCollection

	aCanvas drawPolygon: aCollection color: aBrick color borderWidth: 0 borderColor: Color transparent! !

!GTSpotterTriangleRenderer methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/25/2015 13:34'!
orientation: aSymbol
	"can be #right #bottom #left #top"

	orientation := aSymbol! !

!GTSpotterTriangleRenderer methodsFor: 'mathematical functions' stamp: 'AliakseiSyrel 1/25/2015 13:48'!
findTriangleEdgeLength: anInteger

	^ 2 / 3 * (3 sqrt) * anInteger! !

!GTSpotterTriangleRenderer methodsFor: 'rendering' stamp: 'AliakseiSyrel 1/25/2015 19:05'!
renderBottomTriangle: aBrick on: aCanvas
	|a b c width height|
	
	width := aBrick brickBounds width.
	height := aBrick brickBounds height.
	
	a := aBrick brickBounds topLeft + (((width / 2 - height) max: 0) @ 0).
	b := aBrick brickBounds topLeft + (((width / 2 + height) min: width) @ 0).
	c := aBrick brickBounds bottomLeft + (width / 2 @ 0).
	
	self renderTriangle: aBrick on: aCanvas with: { a asIntegerPoint . b asIntegerPoint . c asIntegerPoint}! !

!GTSpotterTriangleRenderer methodsFor: 'rendering' stamp: 'AliakseiSyrel 1/25/2015 16:52'!
render: aBrick on: aCanvas
	
	self orientation = #right ifTrue: [ self renderRightTriangle: aBrick on: aCanvas ].
	self orientation = #bottom ifTrue: [ self renderBottomTriangle: aBrick on: aCanvas ].
	self orientation = #left ifTrue: [ self renderLeftTriangle: aBrick on: aCanvas ].
	self orientation = #top ifTrue: [ self renderTopTriangle: aBrick on: aCanvas ].! !

!GTSpotterTriangleRenderer methodsFor: 'rendering' stamp: 'AliakseiSyrel 1/25/2015 19:07'!
renderLeftTriangle: aBrick on: aCanvas
	|a b c width height|
	
	width := aBrick brickBounds width.
	height := aBrick brickBounds height.
	
	a := aBrick brickBounds topRight + (0 @ ((height / 2 - width) max: 0)).
	b := aBrick brickBounds topRight + (0 @ ((height / 2 + width) min: height)).
	c := aBrick brickBounds topLeft + (0 @ (height / 2)).
	
	self renderTriangle: aBrick on: aCanvas with: { a asIntegerPoint . b asIntegerPoint . c asIntegerPoint}! !

!GTSpotterTriangleRenderer methodsFor: 'rendering' stamp: 'AliakseiSyrel 1/30/2015 23:32'!
renderRightTriangle: aBrick on: aCanvas
	|a b c width height gap|
	
	gap := aBrick themer spotterThemer previewArrowGapHack.
	aCanvas fillRectangle: (aBrick brickBounds withWidth: gap) color: aBrick color.
	
	width := aBrick brickBounds width - gap.
	height := aBrick brickBounds height.
	
	a := aBrick brickBounds topLeft + (gap @ ((height / 2 - width) max: 0)).
	b := aBrick brickBounds topLeft + (gap @ ((height / 2 + width) min: height)).
	c := aBrick brickBounds topRight + (0 @ (height / 2)).
	
	self renderTriangle: aBrick on: aCanvas with: { a asIntegerPoint . b asIntegerPoint . c asIntegerPoint}! !

!GTSpotterTriangleRenderer methodsFor: 'accessing' stamp: 'AliakseiSyrel 1/25/2015 13:34'!
orientation
	^ orientation ifNil: [ #bottom ]! !

!GTSpotterTriangleRenderer methodsFor: 'rendering' stamp: 'AliakseiSyrel 1/25/2015 19:06'!
renderTopTriangle: aBrick on: aCanvas
	|a b c width height|
	
	width := aBrick brickBounds width.
	height := aBrick brickBounds height.
	
	a := aBrick brickBounds bottomLeft + (((width / 2 - height) max: 0) @ 0).
	b := aBrick brickBounds bottomLeft + (((width / 2 + height) min: width) @ 0).
	c := aBrick brickBounds topLeft + (width / 2 @ 0).
	
	self renderTriangle: aBrick on: aCanvas with: { a asIntegerPoint . b asIntegerPoint . c asIntegerPoint}! !

!GTSpotterUIThreadStream methodsFor: 'adding/removing' stamp: 'AliakseiSyrel 12/10/2014 22:12'!
addObjects: aCollection inProcessor: aProcessor

	self performSymbol: #addAllCandidates:in: withArguments: { aCollection . aProcessor }.
	Processor yield! !

!GTSpotterUIThreadStream methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/30/2014 22:38'!
timestamp: anObject
	timestamp := anObject! !

!GTSpotterUIThreadStream methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/14/2014 20:05'!
onAddedSelector
	^ onAddedSelector! !

!GTSpotterUIThreadStream methodsFor: 'updating' stamp: 'AliakseiSyrel 11/30/2014 22:39'!
updateTimestamp

	self timestamp: Time microsecondClockValue! !

!GTSpotterUIThreadStream methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/14/2014 20:05'!
onAddedSelector: anObject
	onAddedSelector := anObject! !

!GTSpotterUIThreadStream methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/14/2014 20:54'!
onRemoveSelector: anObject
	onRemoveSelector := anObject! !

!GTSpotterUIThreadStream methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/14/2014 20:05'!
receiver: anObject
	receiver := anObject! !

!GTSpotterUIThreadStream methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/14/2014 20:05'!
receiver
	^ receiver! !

!GTSpotterUIThreadStream methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/30/2014 22:38'!
timestamp
	^ timestamp! !

!GTSpotterUIThreadStream methodsFor: 'accessing' stamp: 'AliakseiSyrel 11/14/2014 20:54'!
onRemoveSelector
	^ onRemoveSelector! !

!GTSpotterUIThreadStream methodsFor: 'performing' stamp: 'AliakseiSyrel 11/30/2014 22:44'!
performSymbol: aSymbol withArguments: aCollection
	|time|
	"we save current timestamp here, so that defer block can check if it belongs to the correct task"
	time := self timestamp.
	"UI manages commands for us"
	Processor yield.
	"if timestamp is wrong just skip command"
	UIManager default defer: [ time = self timestamp ifTrue: [ self receiver perform: aSymbol withEnoughArguments: aCollection ] ]! !

!GTSpotterUIThreadStream methodsFor: 'adding/removing' stamp: 'AliakseiSyrel 12/10/2014 22:11'!
addObject: firstObject inProcessor: secondObject

	self performSymbol: self onAddedSelector withArguments: { firstObject. secondObject }.
	Processor yield! !

!GTSpotterUIThreadStream methodsFor: 'adding/removing' stamp: 'AliakseiSyrel 12/10/2014 22:12'!
removeAllCandidates

	self performSymbol: #removeAllCandidates withArguments: { }.
	Processor yield! !

!GTSpotterWidgetDarkThemer commentStamp: 'AliakseiSyrel 4/4/2015 17:02'!
!
!GTSpotterWidgetDarkThemer methodsFor: 'values' stamp: 'AliakseiSyrel 3/21/2015 21:37'!
backgroundColor
	"used as background color for all panes"
	^ Color r: 0.25 g: 0.25 b: 0.25! !

!GTSpotterWidgetDarkThemer methodsFor: 'values' stamp: 'AliakseiSyrel 1/23/2015 13:08'!
titleTextColor

	^ self backgroundColor muchLighter! !

!GTSpotterWidgetDarkThemer methodsFor: 'values' stamp: 'AliakseiSyrel 1/23/2015 13:13'!
searchFieldTextColor
	
	^ Color white slightlyDarker! !

!GTSpotterWidgetDarkThemer methodsFor: 'values' stamp: 'AliakseiSyrel 1/23/2015 12:59'!
borderColor
	"color that is used for border and dividers of UI parts of Spotter
	for example divider between header and results or between preview and list"
	^ self backgroundColor darker! !

!GTSpotterWidgetDarkThemer methodsFor: 'values' stamp: 'AliakseiSyrel 1/23/2015 13:20'!
itemActionSelectedBackgroundColor

	^ self itemSelectedBackgroundColor slightlyDarker! !

!GTSpotterWidgetDarkThemer methodsFor: 'values' stamp: 'AliakseiSyrel 1/23/2015 13:06'!
itemIconAlphaValue

	^ 0.5! !

!GTSpotterWidgetDarkThemer methodsFor: 'values' stamp: 'AliakseiSyrel 1/23/2015 13:09'!
itemSelectedBackgroundColor

	^ self backgroundColor slightlyDarker! !

!GTSpotterWidgetThemer commentStamp: 'TudorGirba 11/26/2014 15:15'!
This is a themer for all spotter morphs.

To customize it, it has to be subclassed and pointed to from:
ACustomTheme>>spotterWidgetThemer!
!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 3/21/2015 22:17'!
breadcrumbItemLabelStyleFor: aBrick

	aBrick
		textPosition: #center;
		padding: { 0 . self outerBorderWidth };
		vSpaceFill;
		hSpaceFill! !

!GTSpotterWidgetThemer methodsFor: 'styles-widget' stamp: 'AliakseiSyrel 3/21/2015 22:05'!
itemNormalWidgetStyleFor: aBrick

	aBrick
		normalColor: self itemNormalBackgroundColor;
		selectedColor: self itemHoveredBackgroundColor;
		checkedColor: self itemSelectedBackgroundColor! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 3/21/2015 22:46'!
spotterPreviewStyleFor: aBrick
	
	aBrick
		borderWidth: self previewBorderWidth;
		hSpaceFill: self previewWidthPercent;
		vSpaceFill;
		margin: { self headerHeight + self innerBorderWidth. 0 . 0};
		marginLeft: (self previewBorderWidth + self previewArrowWidth) negated.
	
	aBrick layout
		zIndex: 1! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 3/21/2015 21:28'!
resultsPaneStyleFor: aBrick

	aBrick
		hSpaceFill: self resultsPaneWidth;
		vSpaceFill;
		with: [ :b | b band layout: GTSpotterStackedLayout new ]! !

!GTSpotterWidgetThemer methodsFor: 'styles-widget' stamp: 'AliakseiSyrel 3/21/2015 22:12'!
headerWidgetStyleFor: aBrick

	aBrick
		color: self backgroundColor! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 1/23/2015 13:20'!
itemActionSelectedBackgroundColor

	^ self itemSelectedBackgroundColor darker! !

!GTSpotterWidgetThemer methodsFor: 'styles-widget' stamp: 'AliakseiSyrel 3/21/2015 22:16'!
breadcrumbItemLabelWidgetStyleFor: aBrick

	aBrick
		color: self breadcrumbItemBackgroundColor;
		textColor: self breadcrumbItemTextColor! !

!GTSpotterWidgetThemer methodsFor: 'styles-widget' stamp: 'AliakseiSyrel 3/21/2015 22:40'!
searchFieldWidgetStyleFor: aBrick
	
	aBrick morph
		color: Color transparent;
		textColor: self searchFieldTextColor;
		borderColor: Color transparent.
		
	aBrick morph textArea
		backgroundColor: Color transparent! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 1/25/2015 17:48'!
previewWidthPercent

	^ 40! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 10/23/2014 19:20'!
itemIconMaxWidth

	^ 50! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 2/10/2015 13:28'!
breadcrumbStyleFor: aBrick
	
	aBrick
		margin: { 0 . 0 };
		marginBottom: self breadcrumbTriangleHeight negated;
		height: self breadcrumbHeight + self breadcrumbTriangleHeight.
		
	aBrick layout
		zIndex: 2.! !

!GTSpotterWidgetThemer methodsFor: 'styles-widget' stamp: 'AliakseiSyrel 3/21/2015 22:42'!
settingsButtonWidgetStyleFor: aBrick

	aBrick
		normalImage: Smalltalk ui icons glamorousPreferences;
		pressedColor: self buttonPressedColor! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 3/21/2015 22:14'!
itemActionButtonStyleFor: aBrick

	aBrick
		width: [ (self itemHeight / 1.1) floor ];
		vSpaceFill;
		margin: #(0 1);
		padding: { 0 . self outerBorderWidth }! !

!GTSpotterWidgetThemer methodsFor: 'styles-widget' stamp: 'AliakseiSyrel 3/21/2015 22:32'!
categoryAmountWidgetStyleFor: aBrick

	aBrick
		textColor: self titleTextColor;
		color: self titleBackgroundColor! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 2/8/2015 17:41'!
spotterPaneStyleFor: aBrick
	
	aBrick
		useHorizontalLinearLayout;
		hSpaceFill;
		vSpaceFill! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 11/18/2014 23:52'!
titleMarginLeft
	^ 20! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 3/21/2015 22:12'!
headerStyleFor: aBrick

	aBrick
		hSpaceFill;
		height: self headerHeight! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 1/25/2015 23:02'!
previewArrowColor

	^ self itemSelectedBackgroundColor! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 11/27/2014 14:40'!
categoryNameMarginLeft

	^ self itemIconMaxWidth! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 2/5/2015 12:32'!
breadcrumbItemStyleFor: aBrick

	aBrick vSpaceFill! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 1/25/2015 20:18'!
previewBorderWidth

	^ self outerBorderWidth! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 10/24/2014 14:55'!
headerHeight
	"height of the header where user enters search request"
	^ 56! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'TudorGirba 11/19/2014 08:40'!
searchFieldFamilyName

	^ 'Source Sans Pro'! !

!GTSpotterWidgetThemer methodsFor: 'styles-widget' stamp: 'AliakseiSyrel 3/21/2015 22:35'!
closeButtonWidgetStyleFor: aBrick

	aBrick
		normalImage: GLMUIThemeExtraIcons glamorousClose;
		pressedColor: self buttonPressedColor! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 10/23/2014 18:03'!
innerBorderWidth
	"width of the border that separates panes in the spotter"
	^ 1! !

!GTSpotterWidgetThemer methodsFor: 'styles-widget' stamp: 'AliakseiSyrel 3/21/2015 22:34'!
categoryTitleNameWidgetStyleFor: aBrick

	aBrick
		textColor: self titleTextColor;
		color: self titleBackgroundColor
	! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'TudorGirba 12/1/2014 09:44'!
itemHoveredBackgroundColor

	^ Color transparent! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 1/25/2015 14:07'!
breadcrumbItemBackgroundColor

	^ self borderColor! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 3/21/2015 22:18'!
breadcrumbItemTriangleStyleFor: aBrick

	aBrick
		height: self breadcrumbTriangleHeight;
		hSpaceFill! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 3/21/2015 22:44'!
spotterContentsStyleFor: aBrick
	
	aBrick
		useVerticalLinearLayout;
		borderWidth: self outerBorderWidth;
		padding: self outerBorderWidth;
		hSpaceFill;
		vSpaceFill.
	
	aBrick layout
		zIndex: 2
	! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 1/26/2015 15:39'!
breadcrumbHeight

	^ 26! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'TudorGirba 2/22/2015 19:47'!
previewPaddingRight

	^ self previewPaddingLeft

! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 11/19/2014 00:16'!
itemSelectedBackgroundColor

	^ self backgroundColor darker! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'TudorGirba 3/16/2015 15:23'!
privacyAgreementIsSendingDataColor

	^ Color paleGreen! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 3/17/2015 23:20'!
previewArrowGapHack

	^ self themer scrollbarOffset + self themer scrollbarWidth + self outerBorderWidth + 2"pager bug"! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 1/27/2015 09:41'!
previewPaddingLeft

	^ self previewArrowWidth * 1.2! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 3/23/2015 17:45'!
titleTextColor

	^ self themer textLightColor! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 2/8/2015 17:43'!
spotterStyleFor: aBrick

	aBrick brickRoot useVerticalLinearLayout! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 3/21/2015 22:34'!
categoryTitleNameStyleFor: aBrick

	aBrick
		vSpaceFill;
		textPosition: #leftCenter;
		width: [ :name | (aBrick owner innerBounds width) min: ((name label textSize x) + name label hMargin) ].
	
	aBrick label
		familyName: self titleFamilyName.
	! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 1/23/2015 13:13'!
searchFieldTextColor
	
	^ Color black! !

!GTSpotterWidgetThemer methodsFor: 'icons' stamp: 'TudorGirba 2/20/2015 08:35'!
iconDiveIn

	^ Smalltalk ui icons glamorousDiveRightIcon! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 2/10/2015 14:14'!
spotterPreviewArrowContainerStyleFor: aBrick

	aBrick
		useVerticalLinearLayout;
		vSpaceFill;
		width: self previewArrowWidth;
		margin: {
			self headerHeight + self innerBorderWidth + self previewBorderWidth.
			0.
			self previewBorderWidth.
			self previewArrowGapHack negated }.
		
	aBrick layout
		zIndex: 4.! !

!GTSpotterWidgetThemer methodsFor: 'styles-widget' stamp: 'AliakseiSyrel 3/21/2015 22:54'!
breadcrumbItemTriangleWidgetStyleFor: aBrick

	aBrick
		renderer: (GTSpotterTriangleRenderer new orientation: #bottom).
		
	aBrick owner isTriangleVisible
		ifTrue:[ aBrick color: self breadcrumbItemBackgroundColor ]
		ifFalse: [ aBrick color: Color transparent ]! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 2/27/2015 21:13'!
settingsLabelTextColor

	^ Color white! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 2/27/2015 21:15'!
settingsLabelPadding

	^ 4! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 10/23/2014 19:27'!
itemNormalBackgroundColor

	^ Color transparent! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 3/21/2015 21:01'!
itemLabelStyleFor: aBrick

	aBrick label
		highlightingLogic: [ :aCanvas :aRectangle | |bounds|
			"because font calculates text width wrong"
			bounds := aRectangle translateBy: (-3@0).
			aCanvas line: bounds bottomLeft to: bounds bottomRight width: 1 color: Color lightGray ].
	
	aBrick
		hSpaceFill;
		vSpaceFill;
		marginRight: self outerBorderWidth.! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 2/10/2015 14:12'!
categoryStyleFor: aBrick

	aBrick
		marginBottom: self categoryMarginBottom;
		hSpaceFill! !

!GTSpotterWidgetThemer methodsFor: 'styles-widget' stamp: 'AliakseiSyrel 3/21/2015 22:46'!
spotterPreviewWidgetStyleFor: aBrick
	
	aBrick
		borderColor: self borderColor;
		color: self backgroundColor! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'TudorGirba 3/16/2015 15:24'!
privacyAgreementIsNotSendingDataColor

	^ Color paleRed! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 10/23/2014 19:50'!
searchFieldFontSize

	^ 15! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 3/26/2015 17:45'!
privacyAgreementNotificationStyleFor: aBrick

	| color |
	color := aBrick sendUsageData 
		ifTrue: [ self privacyAgreementIsSendingDataColor. ]
		ifFalse: [ self privacyAgreementIsNotSendingDataColor. ].
	aBrick messageBrick rubricTextFamilyName: StandardFonts defaultFont familyName.
	aBrick messageBrick rubricTextColor: Color black.
	aBrick
		color: color;
		borderColor: color darker;
		borderWidth: self outerBorderWidth;
		marginTop: 0! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 10/25/2014 10:45'!
searchFieldMarginLeft

	^ 20! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 1/25/2015 14:07'!
breadcrumbItemTextColor

	^ Color white! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 3/21/2015 22:20'!
breadcrumbSeparatorStyleFor: aBrick

	aBrick
		borderWidth: self breadcrumbSeparatorLineWidth;
		width: self breadcrumbSeparatorWidth;
		height: self breadcrumbHeight + self outerBorderWidth.! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 3/26/2015 16:26'!
searchFieldStyleFor: aBrick
	
	aBrick
		beCentered;
		hSpaceFill;
		vSpaceFill;
		withoutMargins;
		withoutAdornment;
		withoutBorder;
		beTransparent;
		withGhostText: self spotterGhostText;
		autoAccept: true;
		marginLeft: self searchFieldMarginLeft;
		rubricTextFamilyName: self searchFieldFamilyName;
		rubricTextFontSize: self searchFieldFontSize.
	
	aBrick rubric ghostTextRuler
		fontName: self searchFieldFamilyName pointSize: self searchFieldFontSize.! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'TudorGirba 3/2/2015 15:56'!
spotterGhostText

	^ 'Search'! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'TudorGirba 3/30/2015 22:27'!
hintRevealArrowStyleFor: aBrick
	
	SmalltalkImage current vm canHandleShiftPressed
		ifTrue: [ ^ self ].
	
	aBrick ifNil: [ ^ self ].
	(aBrick valueOfProperty: #brickSpotterIsReveal ifAbsent: [ false ])
		ifTrue: [ ^ self ].
	
	aBrick setProperty: #brickSpotterBackupColor toValue: aBrick color.
	aBrick setProperty: #brickSpotterIsReveal toValue: true.
	
	aBrick color: self themer popupHelpThemer backgroundColor.
	
	aBrick changed! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 11/24/2014 23:18'!
backgroundColor
	"used as background color for all panes"
	^ Color white! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 3/21/2015 21:29'!
dropDownPaneStyleFor: aBrick

	aBrick
		layoutProperties: GLMBrickLayoutProperties new;
		marginTop: self innerBorderWidth;
		vSpaceFill;
		hSpaceFill! !

!GTSpotterWidgetThemer methodsFor: 'icons' stamp: 'TudorGirba 2/20/2015 08:35'!
iconAct

	^ Smalltalk ui icons glamorousAccept! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'TudorGirba 12/1/2014 14:25'!
borderColor
	"color that is used for border and dividers of UI parts of Spotter
	for example divider between header and results or between preview and list"
	^ Color r: 180 g: 180 b: 180 range: 255! !

!GTSpotterWidgetThemer methodsFor: 'styles-widget' stamp: 'AliakseiSyrel 3/21/2015 22:28'!
breadcrumbSeparatorWidgetStyleFor: aBrick

	aBrick
		color: self breadcrumbItemBackgroundColor;
		borderColor: self breadcrumbSeparatorColor;
		renderer: GTSpotterBreadcrumbSeparatorRenderer new! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 3/17/2015 21:35'!
itemHeight

	^  16 + Smalltalk ui theme labelFont height! !

!GTSpotterWidgetThemer methodsFor: 'styles-widget' stamp: 'AliakseiSyrel 3/21/2015 23:00'!
spotterPreviewArrowWidgetStyleFor: aBrick

	aBrick owner isTriangleVisible
		ifTrue: [ aBrick color: self previewArrowColor ]
		ifFalse: [ aBrick color: Color transparent ]! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 2/4/2015 19:33'!
spotterPreviewArrowStyleFor: aBrick

	aBrick
		hSpaceFill;
		renderer: (GTSpotterTriangleRenderer new orientation: #right);
		height: [ (self previewArrowWidth - self previewArrowGapHack ) * 2 ]! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 1/25/2015 15:33'!
breadcrumbTriangleHeight

	^ 16! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 3/21/2015 22:15'!
categoryTitleStyleFor: aBrick

	aBrick
		useHorizontalLinearLayout;
		height: 30;
		hSpaceFill;
		paddingLeft: self categoryNameMarginLeft
	
	"aBrick layout
		floating: #stack;
		maxWidth: [ :title |
			aBrick hPadding + 
			(title nameBrick label textSize x )+ title amountBrick label textSize x +
			title nameBrick hPadding + title nameBrick hMargin + 
			title nameBrick label hPadding + title nameBrick label hMargin + 
			title amountBrick hMargin ]"! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 11/18/2014 23:51'!
categoryNameMarginRight

	^ 10! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'TudorGirba 2/26/2015 07:25'!
spotterPreviewCompositeStyleFor: aBrick

	aBrick
		hSpaceFill;
		vSpaceFill;
		margin: self previewBorderWidth;
		paddingLeft: self previewPaddingLeft! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 1/26/2015 00:52'!
breadcrumbSeparatorWidth

	^ (self breadcrumbHeight + self outerBorderWidth) / 2 + 4 "we need slightly more because of drawing accuracy"! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 10/25/2014 10:43'!
resultsPaneWidth
	"width in Percents of the results pane"
	^ 100"%"! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 3/21/2015 22:43'!
settingsButtonStyleFor: aBrick

	aBrick
		vSpaceFill;
		width: [ :m | m height ];
		margin: #(10 0);
		marginRight: 2! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 10/23/2014 19:38'!
titleFamilyName
	^ 'Open Sans'.! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 1/26/2015 01:02'!
breadcrumbSeparatorColor

	^ self breadcrumbItemBackgroundColor muchLighter slightlyDarker! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 3/3/2015 11:29'!
itemActionbarStyleFor: aBrick

	aBrick
		useHorizontalLinearLayout;
		hShrinkWrap;
		vSpaceFill;
		marginRight: self outerBorderWidth + 2;
		visible: false! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 3/3/2015 11:22'!
hintHideArrowStyleFor: aBrick

	aBrick ifNil: [ ^ self ].
	(aBrick valueOfProperty: #brickSpotterIsReveal ifAbsent: [ false ])
		ifFalse: [ ^ self ].
	aBrick setProperty: #brickSpotterIsReveal toValue: false.
	
	(aBrick hasProperty: #brickSpotterBackupColor)
		ifTrue: [ aBrick color: (aBrick valueOfProperty: #brickSpotterBackupColor) ].
		
	aBrick changed! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 3/21/2015 22:32'!
categoryAmountStyleFor: aBrick

	aBrick
		textPosition: #leftCenter.
	
	aBrick label
		familyName: self titleFamilyName.
	
	aBrick
		vSpaceFill;
		width: #approximateWidth;
		marginLeft: self categoryNameMarginRight.! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 2/28/2015 00:45'!
hintHideStyleFor: aBrick

	aBrick ifNil: [ ^ self ].
	(aBrick valueOfProperty: #brickSpotterIsReveal ifAbsent: [ false ])
		ifFalse: [ ^ self ].
	aBrick setProperty: #brickSpotterIsReveal toValue: false.
	
	(aBrick hasProperty: #brickSpotterBackupColor)
		ifTrue: [ aBrick color: (aBrick valueOfProperty: #brickSpotterBackupColor) ].
		
	(aBrick hasProperty: #brickSpotterBackupBorder)
		ifTrue: [ aBrick border: (aBrick valueOfProperty: #brickSpotterBackupBorder) ].
		
	aBrick changed! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 1/26/2015 00:49'!
breadcrumbSeparatorLineWidth

	^ 2! !

!GTSpotterWidgetThemer methodsFor: 'styles-widget' stamp: 'AliakseiSyrel 3/21/2015 22:13'!
itemActionButtonWidgetStyleFor: aBrick

	aBrick
		pressedColor: self itemActionSelectedBackgroundColor! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'TudorGirba 11/17/2014 22:02'!
titleBackgroundColor

	^ Color transparent! !

!GTSpotterWidgetThemer methodsFor: 'styles-widget' stamp: 'AliakseiSyrel 3/21/2015 22:44'!
spotterContentsWidgetStyleFor: aBrick
	
	aBrick
		borderColor: self borderColor;
		color: self borderColor
	! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 12/1/2014 12:02'!
categoryMarginBottom

	^ (self itemHeight * (2/3)) ceiling "pixels"! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 3/21/2015 23:16'!
categoryTitleBackgroundColor

	^ self backgroundColor alpha: 0.95! !

!GTSpotterWidgetThemer methodsFor: 'icons' stamp: 'TudorGirba 2/20/2015 08:35'!
iconDiveInCategory

	^ Smalltalk ui icons glamorousDiveAllRightIcon! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 2/16/2015 14:36'!
itemIconStyleFor: aBrick
	"icon form must already be set before styling"

	self flag: 'figure out why alpha doesn''t work'.
	aBrick
		"making icon a bit transparent"
		"normalImage: (aBrick normalImage asAlphaImageMorph alpha: self itemIconAlphaValue) imageForm;"
		width: self itemIconMaxWidth;
		vSpaceFill! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 3/21/2015 22:14'!
itemNormalStyleFor: aBrick

	aBrick
		height: [ self itemHeight ];
		hSpaceFill! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 1/25/2015 23:30'!
previewArrowWidth

	^ (self itemHeight / 2) + self previewArrowGapHack! !

!GTSpotterWidgetThemer methodsFor: 'styles-widget' stamp: 'AliakseiSyrel 3/21/2015 22:08'!
categoryTitleWidgetStyleFor: aBrick

	aBrick
		normalColor: self categoryTitleBackgroundColor! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'TudorGirba 3/30/2015 22:27'!
hintRevealStyleFor: aBrick
	
	SmalltalkImage current vm canHandleShiftPressed
		ifTrue: [ ^ self ].
	
	aBrick ifNil: [ ^ self ].
	(aBrick valueOfProperty: #brickSpotterIsReveal ifAbsent: [ false ])
		ifTrue: [ ^ self ].
	
	aBrick setProperty: #brickSpotterBackupColor toValue: aBrick color.
	aBrick setProperty: #brickSpotterBackupBorder toValue: aBrick border.
	aBrick setProperty: #brickSpotterIsReveal toValue: true.
	
	aBrick color: self themer popupHelpThemer backgroundColor.
	aBrick border: GLMBrickBorder new.
	aBrick borderColor: (self themer popupHelpThemer borderColor alpha: 0.6).
	aBrick borderWidth: self themer popupHelpThemer borderWidth.
	
	aBrick changed! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 2/27/2015 21:13'!
settingsLabelSelectedTextColor

	^ Color black! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 1/25/2015 20:18'!
outerBorderWidth
	"the width of the border around the whole spotter"
	^ 4! !

!GTSpotterWidgetThemer methodsFor: 'styles' stamp: 'AliakseiSyrel 3/23/2015 17:55'!
closeButtonStyleFor: aBrick

	aBrick
		vSpaceFill;
		width: [ :m | m height ];
		margin: 10;
		marginLeft: 0! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 10/23/2014 18:12'!
buttonPressedColor

	^ self backgroundColor darker! !

!GTSpotterWidgetThemer methodsFor: 'values' stamp: 'AliakseiSyrel 10/23/2014 19:44'!
itemIconAlphaValue

	^ 0.8! !

!GTStringFilter methodsFor: 'accessing' stamp: 'StefanReichhart 2/24/2015 12:57'!
query: anObject
	query := anObject! !

!GTStringFilter methodsFor: 'private' stamp: 'StefanReichhart 3/23/2015 17:40'!
applyFilterWithoutQuery
	" WARNING: this is not a copy of GTNullFilter>>#applyFilterWithoutQuery !!!!!! "
	self streamed 
		ifTrue: [
			" this will be more responsive (faster) for very large collections and/or expensive filters "
			| reducedItems |
			self items: (reducedItems := OrderedCollection new).
			self allItems withIndexDo: [ :each :index |
				index <= self itemsLimit ifTrue: [ 
					reducedItems add: each.
					self addItem: each ] ] ]
		ifFalse: [
			" this will be much much faster for small collections and/or very quick filters " 
			self items: (self allItems first: (self itemsLimit min: self allItems size)).
			self addItems: self items ]! !

!GTStringFilter methodsFor: 'accessing' stamp: 'StefanReichhart 3/23/2015 15:18'!
caseSensitive
	^ caseSensitive! !

!GTStringFilter methodsFor: 'accessing' stamp: 'StefanReichhart 2/24/2015 13:53'!
query
	^ query! !

!GTStringFilter methodsFor: 'private' stamp: 'StefanReichhart 2/24/2015 10:31'!
applyFilter
	self hasQuery ifFalse: [ 
		self applyFilterWithoutQuery.
		^ self allItems. " return the unfiltered items (all) - used for divein (no filtering appied) "  ].
	self applyFilterWithQuery.
	^ self items " return the filtered items only "! !

!GTStringFilter methodsFor: 'private' stamp: 'StefanReichhart 3/23/2015 15:27'!
prepareFilterInContext: aSpotterContext
	super prepareFilterInContext: aSpotterContext.
	
	caseSensitive ifNil: [ caseSensitive := self defaultCaseSensitive ]. " performance optimization "
	self query: (caseSensitive " performance optimization "
		ifTrue: [ self context textTrimmed ]
		ifFalse: [ self context textLowercase ])! !

!GTStringFilter methodsFor: 'accessing-defaults' stamp: 'StefanReichhart 2/19/2015 16:16'!
defaultCaseSensitive
	^ false! !

!GTStringFilter methodsFor: 'testing' stamp: 'StefanReichhart 2/19/2015 13:34'!
hasQuery
	^ self query isEmptyOrNil not! !

!GTStringFilter methodsFor: 'private' stamp: 'StefanReichhart 2/19/2015 15:04'!
applyFilterWithQuery
	! !

!GTStringFilter methodsFor: 'accessing' stamp: 'StefanReichhart 2/19/2015 16:16'!
caseSensitive: anObject
	caseSensitive := anObject! !

!GTUnorderedFilter methodsFor: 'private' stamp: 'StefanReichhart 3/8/2015 14:03'!
applyFilterWithQuery
	| unorderedMatchedItems |
	unorderedMatchedItems := OrderedCollection new.
	self allItemsDo: [ :each | 
		(self isMatchedItem: each)
				ifTrue: [
					unorderedMatchedItems isEmpty 
						ifTrue: [ 
							" this was done in the nil-fallback of GTSpotterCandidatesProcessor>>doFilter:on: - seems not to be harmful  "
							Processor activeProcess priority: Processor userSchedulingPriority ]. 
					unorderedMatchedItems add: each.
					unorderedMatchedItems size > self itemsLimit 
						ifTrue: [ 
							" this was done in the nil-fallback of GTSpotterCandidatesProcessor>>doFilter:on: - seems not to be harmful  "
							Processor activeProcess priority: Processor userBackgroundPriority ]
						ifFalse: [ self addItem: each ] ] ].
	self items: unorderedMatchedItems! !

!GTUnorderedFilter methodsFor: 'private' stamp: 'StefanReichhart 2/21/2015 10:28'!
isMatchedItem: anItem
	^ false! !

!GTUnprintableObjectTest commentStamp: '<historical>'!
GTUnprintableObjectTest is a test that checks that print string does not trigger an error in the inspector.!
!GTUnprintableObjectTest methodsFor: 'printing' stamp: 'TudorGirba 5/25/2012 17:13'!
printString
	"Simulate an error in printString"
	1/0! !

!GTUnprintableObjectTest methodsFor: 'tests' stamp: 'TudorGirba 5/25/2012 17:12'!
testInspectDoesNotCrash
	window := GTInspector openOn: self class new ! !

!GTUrlProvider commentStamp: 'TudorGirba 10/22/2014 07:50'!
This class was inspired from the Zinc SharedWorkspace project.

Its job is to work with a UrlProvider that can provide (via get) and store (via post) strings.!
!GTUrlProvider methodsFor: 'public' stamp: 'TudorGirba 10/22/2014 07:49'!
urlProvider
	^ urlProvider ifNil: [ urlProvider := self class urlProvider ]! !

!GTUrlProvider methodsFor: 'initialize-release' stamp: 'TudorGirba 10/22/2014 07:49'!
urlProvider: anUrlObject
	urlProvider := anUrlObject asZnUrl ! !

!GTUrlProvider methodsFor: 'private' stamp: 'TudorGirba 10/22/2014 07:47'!
httpClient
	^ ZnClient new
		systemPolicy;
		beOneShot;
		accept: ZnMimeType textPlain;
		url: self urlProvider;
		yourself! !

!GTUrlProvider methodsFor: 'public' stamp: 'TudorGirba 10/22/2014 07:53'!
post: string
	| entity client url |
	entity := ZnEntity text: string asString.
	(client := self httpClient)
		entity: entity; 
		post.
	url := client response location.
	^ url asZnUrl inContextOf: self urlProvider ! !

!GTUrlProvider methodsFor: 'public' stamp: 'TudorGirba 10/22/2014 07:50'!
get: url	
	| contents |
	contents := self httpClient get: url.
	^ String new: contents size streamContents: [ :stream |
		contents linesDo: [ :each | stream nextPutAll: each; cr ] ]! !

!GTUrlProvider class methodsFor: 'accessing' stamp: 'TudorGirba 10/22/2014 07:48'!
urlProvider
	^ urlProvider ifNil: [ urlProvider := 'http://ws.stfx.eu' asZnUrl ]! !

!GTUrlProvider class methodsFor: 'accessing' stamp: 'TudorGirba 10/22/2014 07:48'!
urlProvider: aUrlObject
	urlProvider := aUrlObject ifNotNil: [ aUrlObject asZnUrl ]! !

!GTUrlProvider class methodsFor: 'accessing' stamp: 'TudorGirba 10/22/2014 08:02'!
stringUrlProvider
	^ self urlProvider asString! !

!GTUrlProvider class methodsFor: 'accessing' stamp: 'TudorGirba 10/22/2014 08:01'!
stringUrlProvider: aString
	self urlProvider: aString! !

!GTUrlProvider class methodsFor: 'settings' stamp: 'TudorGirba 10/22/2014 08:02'!
settingsOn: aBuilder 
	<systemsettings>
	
	(aBuilder setting: #stringUrlProvider)
		parent: #gt;
		target: self;
		description: 'The url for the script sharing service like the one from http://ws.stfx.eu' translated;
		label: 'The url for the script sharing service'
! !

!GZipConstants commentStamp: '<historical>'!
This class defines magic numbers taken from the RFC1952 GZIP file format 
specification version 4.3 (1996) [1].  A class imports these constants 
as 'class variables' by including the following in its class definition: 
   poolDictionaries: 'GZipConstants' 
A method on the class side initialises the values. 

[1] http://www.ietf.org/rfc/rfc1952.txt  (Section 2.3.1 Member header 
and trailer) 
-------------8<----snip--------------- 

As an aside the following in [GzipConstants class >> initialize] does 
not match the specification for bit 5 as "reserved". 
    GZipEncryptFlag := 16r20.    "Archive is encrypted" 

I did find it defined here [2] & [3] however the FAQ [4] specifically 
says encryption is NOT part of the standard. 

This constant is only used in [GzipReadStream >> on:from:to] as... 
    (flags anyMask: GZipEncryptFlag) 
        ifTrue:[^self error:'Cannot decompress encrypted stream']. 

So perhaps its okay to leave but maybe some slight benefit from amending 
the text as follows.. 
    GZipEncryptFlag := 16r20.    "Archive is encrypted.  Not supported. 
Not part of the standard." 
    ifTrue:[^self error:'Cannot decompress encrypted stream. Encryption 
is not part of RFC1952']. 

It is a better presentation to a user if you can indicate that it is 
someone else's fault that their decompress failed, and not Pharo. 

[2] http://www.onicos.com/staff/iz/formats/gzip.html
[3] http://research.cs.wisc.edu/wpis/examples/pcca/gzip/gzip.h
[3] http://www.gzip.org/#faq15!
!GZipConstants class methodsFor: 'pool initialization' stamp: 'ar 5/18/2003 19:00'!
initialize
	"GZipConstants initialize"
	GZipMagic := 16r8B1F.		"GZIP magic number"
	GZipDeflated := 8.			"Compression method"

	GZipAsciiFlag := 16r01.		"Contents is ASCII"
	GZipContinueFlag := 16r02.	"Part of a multi-part archive"
	GZipExtraField := 16r04.		"Archive has extra fields"
	GZipNameFlag := 16r08.		"Archive has original file name"
	GZipCommentFlag := 16r10.	"Archive has comment"
	GZipEncryptFlag := 16r20.	"Archive is encrypted"
	GZipReservedFlags := 16rC0.	"Reserved" ! !

!GZipConstants class methodsFor: 'pool initialization' stamp: 'ar 5/18/2003 19:00'!
gzipMagic
	^GZipMagic! !

!GZipReadStream commentStamp: '<historical>'!
gzip is an integral part of the VM. !
!GZipReadStream methodsFor: 'crc' stamp: 'ar 2/29/2004 03:30'!
updateCrc: oldCrc from: start to: stop in: aCollection
	"Answer an updated CRC for the range of bytes in aCollection"
	^ZipWriteStream updateCrc: oldCrc from: start to: stop in: aCollection.! !

!GZipReadStream methodsFor: 'crc' stamp: 'ar 2/29/2004 04:20'!
verifyCrc
	| stored |
	stored := 0.
	0 to: 24 by: 8 do: [ :i |
		sourcePos >= sourceLimit ifTrue: [ ^ self crcError: 'No checksum (proceed to ignore)' ].
		stored := stored + (self nextByte bitShift: i) ].
	stored := stored bitXor: 16rFFFFFFFF.
	stored = crc ifFalse: [ ^ self crcError: 'Wrong checksum (proceed to ignore)' ].
	^stored! !

!GZipReadStream methodsFor: 'initialize' stamp: 'ar 2/29/2004 03:32'!
on: aCollection from: firstIndex to: lastIndex
	"Check the header of the GZIP stream."
	| method magic flags length |
	super on: aCollection from: firstIndex to: lastIndex.
	crc := 16rFFFFFFFF.
	magic := self nextBits: 16.
	(magic = GZipMagic) 
		ifFalse:[^self error:'Not a GZipped stream'].
	method := self nextBits: 8.
	(method = GZipDeflated)
		ifFalse:[^self error:'Bad compression method'].
	flags := self nextBits: 8.
	(flags anyMask: GZipEncryptFlag) 
		ifTrue:[^self error:'Cannot decompress encrypted stream'].
	(flags anyMask: GZipReservedFlags)
		ifTrue:[^self error:'Cannot decompress stream with unknown flags'].
	"Ignore stamp, extra flags, OS type"
	self nextBits: 16; nextBits: 16. "stamp"
	self nextBits: 8. "extra flags"
	self nextBits: 8. "OS type"
	(flags anyMask: GZipContinueFlag) "Number of multi-part archive - ignored"
		ifTrue:[self nextBits: 16]. 
	(flags anyMask: GZipExtraField) "Extra fields - ignored"
		ifTrue:[	length := self nextBits: 16.
				1 to: length do:[:i| self nextBits: 8]].
	(flags anyMask: GZipNameFlag) "Original file name - ignored"
		ifTrue:[[(self nextBits: 8) = 0] whileFalse].
	(flags anyMask: GZipCommentFlag) "Comment - ignored"
		ifTrue:[[(self nextBits: 8) = 0] whileFalse].
! !

!GZipReadStream class methodsFor: '*System-FileRegistry' stamp: 'CamilloBruni 2/3/2013 17:21'!
fileReaderServicesForFile: fullName suffix: suffix
	<fileService>
	| services |
	suffix = 'gz' | (suffix = '*')
		ifFalse: [ ^ #() ].
	services := OrderedCollection new.
	suffix = '*' | (fullName asLowercase endsWith: '.cs.gz') | (fullName asLowercase endsWith: '.mcs.gz')
		ifTrue: [ 
			services add: self serviceFileIn.
			(Smalltalk globals includesKey: #ChangeSorter)
				ifTrue: [ services add: self serviceFileIntoNewChangeSet ] ].
	services addAll: self services.
	^ services! !

!GZipReadStream class methodsFor: 'filein/out' stamp: 'dgd 9/21/2003 17:46'!
uncompressedFileName: fullName
	^((fullName endsWith: '.gz') and: [self confirm: ('{1}
appears to be a compressed file.
Do you want to uncompress it?' translated format:{fullName})])
		ifFalse: [fullName]
		ifTrue:[self saveContents: fullName]! !

!GZipReadStream class methodsFor: 'unzipping' stamp: 'HernanMoralesDurand 1/23/2014 10:06'!
unzip: fullFileName 
	"Unzip the contents of a gzipped file specified by its full file name to the current working directory"
	
	^ self unzip: fullFileName to: FileSystem disk workingDirectory ! !

!GZipReadStream class methodsFor: 'filein/out' stamp: 'CamilloBruni 5/4/2012 20:27'!
fileIntoNewChangeSet: fullFileName
	"FileIn the contents of a gzipped file"

	| zipped unzipped csClass |
	csClass := Smalltalk globals at: #ChangeSet ifAbsent: [ ^ self ].
	zipped := self on: (FileStream readOnlyFileNamed: fullFileName).
	unzipped := MultiByteBinaryOrTextStream with: zipped contents asString.
	unzipped reset.
	csClass 
		newChangesFromStream: unzipped 
		named: fullFileName asFileReference basename! !

!GZipReadStream class methodsFor: '*System-FileRegistry' stamp: 'tbn 8/11/2010 10:19'!
serviceViewDecompress

	^ SimpleServiceEntry 
				provider: self 
				label: 'View decompressed'
				selector: #viewContents:
				description: 'View decompressed' 
! !

!GZipReadStream class methodsFor: '*System-FileRegistry' stamp: 'sd 2/1/2002 22:16'!
services

	^ Array 
		with: self serviceViewDecompress
		with: self serviceDecompressToFile
	! !

!GZipReadStream class methodsFor: '*System-FileRegistry' stamp: 'tbn 8/11/2010 10:19'!
serviceFileIn
	"Answer a service for filing in an entire file"

	^ SimpleServiceEntry 
		provider: self 
		label: 'FileIn entire file'
		selector: #fileIn:
		description: 'File in the entire decompressed contents of the file, which is expected to contain Smalltalk code in fileout ("chunk") format'
		buttonLabel: 'Filein'

! !

!GZipReadStream class methodsFor: 'filein/out' stamp: 'StephaneDucasse 7/31/2012 23:04'!
saveContents: fullFileName
	"Save the contents of a gzipped file"
	| zipped buffer unzipped newName |
	newName := fullFileName copyUpToLast: FileSystem disk extensionDelimiter.
	unzipped := FileStream newFileNamed: newName.
	unzipped binary.
	zipped := self on: (FileStream readOnlyFileNamed: fullFileName).
	buffer := ByteArray new: 50000.
	'Extracting ' , fullFileName
		displayProgressFrom: 0
		to: zipped sourceStream size
		during: 
			[:bar | 
			[zipped atEnd]
				whileFalse: 
					[bar current: zipped sourceStream position.
					unzipped nextPutAll: (zipped nextInto: buffer)].
			zipped close.
			unzipped close].
	^ newName! !

!GZipReadStream class methodsFor: 'filein/out' stamp: 'marcus.denker 11/10/2008 10:04'!
viewContents: fullFileName
	"Open the decompressed contents of the .gz file with the given name.  This method is only required for the registering-file-list of Squeak 3.3a and beyond, but does no harm in an earlier system"

	(FileStream readOnlyFileNamed: fullFileName) ifNotNil:
		[:aStream | aStream viewGZipContents]! !

!GZipReadStream class methodsFor: 'unzipping' stamp: 'ClementBera 7/26/2013 16:16'!
unzip: fullFileName to: pathString
	"Unzip the contents of the file specified by the full path name fullFileName to the location given by pathString."
	
	| zipped buffer unzipped newName |
	newName := fullFileName copyUpToLast: FileSystem disk extensionDelimiter.
	pathString asFileReference ensureCreateDirectory.
	unzipped := FileStream newFileNamed: (pathString asFileReference / newName) fullName.
	unzipped ifNil: [self error: pathString, ' looks incorrect'].
	[ unzipped binary. 
	zipped := self on: (FileStream readOnlyFileNamed: fullFileName).
	buffer := ByteArray new: 50000.
	[zipped atEnd] whileFalse: [unzipped nextPutAll: (zipped nextInto: buffer)]]
		ensure: [
			zipped close.
			unzipped close].
	^ newName! !

!GZipReadStream class methodsFor: 'initialization' stamp: 'IgorStasenko 3/6/2011 18:53'!
unload

	Smalltalk tools fileList unregisterFileReader: self ! !

!GZipReadStream class methodsFor: 'filein/out' stamp: 'yo 8/18/2004 20:24'!
fileIn: fullFileName
	"FileIn the contents of a gzipped file"
	| zipped unzipped |
	zipped := self on: (FileStream readOnlyFileNamed: fullFileName).
	unzipped := MultiByteBinaryOrTextStream with: (zipped contents asString).
	unzipped reset.
	unzipped fileIn.
! !

!GZipReadStream class methodsFor: '*System-FileRegistry' stamp: 'tbn 8/11/2010 10:19'!
serviceFileIntoNewChangeSet
	"Answer a service for filing in an entire file"
	^ SimpleServiceEntry
		provider: self
		label: 'Install into new change set'
		selector: #fileIntoNewChangeSet:
		description: 'Install the decompressed contents of the file as a body of code in the image: create a new change set and file-in the selected file into it'
		buttonLabel: 'Install'! !

!GZipReadStream class methodsFor: '*System-FileRegistry' stamp: 'tbn 8/11/2010 10:29'!
serviceDecompressToFile

	^ FileModifyingSimpleServiceEntry 
				provider: self 
				label: 'Decompress to file'
				selector: #saveContents:
				description: 'Decompress to file'! !

!GZipWriteStream commentStamp: '<historical>'!
gzip is an integral part of the VM. !
!GZipWriteStream methodsFor: 'initialization' stamp: 'ar 12/30/1999 11:41'!
writeHeader
	"Write the GZip header"
	encoder nextBits: 16 put: GZipMagic.
	encoder nextBits: 8 put: GZipDeflated.
	encoder nextBits: 8 put: 0. "No flags"
	encoder nextBits: 32 put: 0. "no time stamp"
	encoder nextBits: 8 put: 0. "No extra flags"
	encoder nextBits: 8 put: 0. "No OS type"
! !

!GZipWriteStream methodsFor: 'initialization' stamp: 'nk 2/19/2004 08:31'!
writeFooter
	"Write some footer information for the crc"
	super writeFooter.
	0 to: 3 do:[:i| encoder nextBytePut: (crc >> (i*8) bitAnd: 255)].
	0 to: 3 do:[:i| encoder nextBytePut: (bytesWritten >> (i*8) bitAnd: 255)].! !

!GZipWriteStream class methodsFor: '*System-FileRegistry' stamp: 'CamilloBruni 2/3/2013 17:21'!
fileReaderServicesForFile: fullName suffix: suffix
	<fileService>
	"Don't offer to compress already-compressed files
	sjc 3-May 2003-added jpeg extension"

	^({ 'gz' . 'sar' . 'zip' . 'gif' . 'jpg' . 'jpeg'. 'pr'. 'png'} includes: suffix)
		ifTrue: [ #() ]
		ifFalse: [ self services ]
! !

!GZipWriteStream class methodsFor: '*System-FileRegistry' stamp: 'nk 11/26/2002 13:10'!
services
	^ { self serviceCompressFile }! !

!GZipWriteStream class methodsFor: 'initialization' stamp: 'IgorStasenko 3/6/2011 18:53'!
initialize
	Smalltalk tools fileList registerFileReader: self! !

!GZipWriteStream class methodsFor: 'initialization' stamp: 'IgorStasenko 3/6/2011 18:53'!
unload
	Smalltalk tools fileList unregisterFileReader: self! !

!GZipWriteStream class methodsFor: 'file list services' stamp: 'sw 11/30/2002 00:11'!
compressFile: fileName
	"Create a compressed file from the file of the given name"

	(FileStream readOnlyFileNamed: fileName) compressFile! !

!GZipWriteStream class methodsFor: '*System-FileRegistry' stamp: 'tbn 8/11/2010 10:33'!
serviceCompressFile

	^ FileModifyingSimpleServiceEntry 
				provider: self 
				label: 'Compress file'
				selector: #compressFile:
				description: 'Compress file using gzip compression, making a new file'! !

!GeneralScrollBar commentStamp: 'gvc 5/18/2007 13:01'!
Support for GeneralScrollPane.!
!GeneralScrollBar methodsFor: 'accessing' stamp: 'GaryChambers 11/16/2011 13:30'!
showNever
	"Set the scrollbar to be never shown."

	self showState: #never! !

!GeneralScrollBar methodsFor: 'initialization' stamp: 'GaryChambers 11/16/2011 13:29'!
initialize
	"Initialize the receiver."

	super initialize.
	self showWhenNeeded! !

!GeneralScrollBar methodsFor: 'model access' stamp: 'gvc 9/7/2006 13:45'!
setValue: newValue
	"Bypass screwed up scrollbar!!"
	
	^self perform: #setValue: withArguments: {newValue} inSuperclass: Slider! !

!GeneralScrollBar methodsFor: 'accessing' stamp: 'GaryChambers 11/16/2011 13:28'!
showsAlways
	"Answer whether the scrollbar should always be shown."

	^self showState == #always! !

!GeneralScrollBar methodsFor: 'accessing' stamp: 'GaryChambers 11/16/2011 13:29'!
showWhenNeeded
	"Set the scrollbar to be shown if needed."

	self showState: #whenNeeded! !

!GeneralScrollBar methodsFor: 'accessing' stamp: 'GaryChambers 11/16/2011 13:28'!
showsNever
	"Answer whether the scrollbar should never be shown."

	^self showState == #never! !

!GeneralScrollBar methodsFor: 'accessing' stamp: 'GaryChambers 11/16/2011 13:26'!
showState: anObject

	showState := anObject! !

!GeneralScrollBar methodsFor: 'accessing' stamp: 'GaryChambers 11/16/2011 13:26'!
showState

	^ showState! !

!GeneralScrollBar methodsFor: 'accessing' stamp: 'GaryChambers 11/16/2011 13:28'!
showsWhenNeeded
	"Answer whether the scrollbar should be shown if needed."

	^self showState == #whenNeeded! !

!GeneralScrollBar methodsFor: 'accessing' stamp: 'GaryChambers 11/16/2011 13:30'!
showAlways
	"Set the scrollbar to be always shown."

	self showState: #always! !

!GeneralScrollPane commentStamp: 'gvc 5/18/2007 13:01'!
A scroll pane that handles its contents accurately.!
!GeneralScrollPane methodsFor: 'initialize' stamp: 'gvc 9/7/2006 12:23'!
defaultColor
	"Answer the default color/fill style for the receiver."
	
	^ Color transparent! !

!GeneralScrollPane methodsFor: 'instance creation' stamp: 'MarcusDenker 7/20/2014 13:12'!
newHScrollbar
	"Answer a new horizontal scrollbar."

	^GeneralScrollBar new
		model: self;
		setValueSelector: #hScrollbarValue:! !

!GeneralScrollPane methodsFor: 'accessing' stamp: 'gvc 9/7/2006 09:40'!
scroller: anObject
	"Set the value of scroller"

	scroller := anObject! !

!GeneralScrollPane methodsFor: 'event handling' stamp: 'gvc 9/7/2006 12:16'!
keyStroke: evt
	"If pane is not empty, pass the event to the last submorph,
	assuming it is the most appropriate recipient (!!)"

	(self scrollByKeyboard: evt) ifTrue: [^self].
	self scrollTarget keyStroke: evt! !

!GeneralScrollPane methodsFor: 'instance creation' stamp: 'MarcusDenker 7/20/2014 13:12'!
newVScrollbar
	"Answer a new vertical scrollbar."

	^GeneralScrollBar new
		model: self;
		setValueSelector: #vScrollbarValue:! !

!GeneralScrollPane methodsFor: 'event handling' stamp: 'SeanDeNigris 2/10/2015 13:50'!
mouseWheel: event 
	"Handle a mouseWheel event."
	
	(self scrollTarget handlesMouseWheel: event)
		ifTrue: [^self scrollTarget mouseWheel: event]. "pass on"
	
	event isUp ifTrue: [ ^ vScrollbar scrollUp: 3 ].
	event isDown ifTrue: [ ^ vScrollbar scrollDown: 3 ].
	event isLeft  ifTrue: [ ^ hScrollbar scrollLeft: 3 ].
	event isRight  ifTrue: [ ^ hScrollbar scrollRight: 3 ].! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'gvc 7/30/2009 13:50'!
vPageDelta
	"Answer the vertical page delta."
	
	|pd tw sw|
	tw := self scrollTarget height.
	sw := self scrollBounds height.
	pd := tw - sw  max: 0.
	pd = 0 ifFalse: [pd := sw / pd].
	^pd! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'gvc 9/7/2006 13:48'!
vScrollbarInterval
	"Answer the computed size of the thumb of the vertical scrollbar."
	
	^self scrollBounds height asFloat / self scrollTarget height min: 1.0.! !

!GeneralScrollPane methodsFor: 'initialization' stamp: 'gvc 9/7/2006 10:54'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		scroller: self newScroller;
		hScrollbar: self newHScrollbar;
		vScrollbar: self newVScrollbar;
		scrollTarget: self defaultScrollTarget.
	self
		addMorph: self scroller;
		resizeScroller! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'GaryChambers 1/11/2011 13:15'!
changeScrollerTableLayout
	"Change the scroller's layout policy to a table layout."

	self scroller changeTableLayout! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'gvc 9/7/2006 09:48'!
scrollTarget
	"Answer the morph that is scrolled."
	
	^self scroller submorphs first! !

!GeneralScrollPane methodsFor: 'accessing' stamp: 'gvc 9/7/2006 10:16'!
vScrollbar: anObject
	"Set the value of vScrollbar"

	vScrollbar := anObject! !

!GeneralScrollPane methodsFor: 'geometry' stamp: 'gvc 9/7/2006 09:57'!
resizeScroller
	"Resize the scroller to fit the scroll bounds."
	
	self scroller bounds: self scrollBounds! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'GaryChambers 11/16/2011 13:33'!
vScrollbarShowNever
	"Set the vertical scrollbar to never show."
	
	self vScrollbar showNever.
	self updateScrollbars! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'GaryChambers 11/16/2011 13:33'!
vScrollbarShowWhenNeeded
	"Set the vertical scrollbar to show if needed."
	
	self vScrollbar showWhenNeeded.
	self updateScrollbars! !

!GeneralScrollPane methodsFor: 'event handling' stamp: 'gvc 9/7/2006 12:16'!
handlesKeyboard: evt
	"Yes for page up/down."
	
	^true! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'gvc 9/7/2006 13:37'!
hScrollbarInterval
	"Answer the computed size of the thumb of the horizontal scrollbar."
	
	^self scrollBounds width asFloat / self scrollTarget width min: 1.0.! !

!GeneralScrollPane methodsFor: 'accessing' stamp: 'gvc 9/7/2006 10:16'!
hScrollbar: anObject
	"Set the value of hScrollbar"

	hScrollbar := anObject! !

!GeneralScrollPane methodsFor: 'geometry' stamp: 'gvc 9/7/2006 13:47'!
vLeftoverScrollRange
	"Return the entire scrolling range minus the currently viewed area."
	
	^self scrollTarget height - self scrollBounds height max: 0
! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'gvc 9/7/2006 10:25'!
vHideScrollbar
	"Hide the vertical scrollbar."
	
	self vScrollbarShowing ifFalse: [^self].
	self removeMorph: self vScrollbar.
	self hResizeScrollbar.
	self resizeScroller! !

!GeneralScrollPane methodsFor: 'accessing' stamp: 'gvc 10/3/2008 13:06'!
scrollBarThickness
	"Answer the width or height of a scrollbar as appropriate to
	its orientation."
	
	^self theme scrollbarThickness! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'MarcusDenker 10/26/2011 14:56'!
defaultScrollTarget
	"Answer a new default scroll target."

	^ Morph new
		extent: 200@150! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'gvc 9/7/2006 10:15'!
vScrollbarShowing
	"Answer whether the vertical scrollbar is showing."
	
	^self vScrollbar owner notNil
	! !

!GeneralScrollPane methodsFor: 'events-processing' stamp: 'gvc 1/28/2008 16:49'!
handlesMouseWheel: evt
	"Do I want to receive mouseWheel events?." 

	^true! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'gvc 9/7/2006 10:28'!
hShowScrollbar
	"Show the horizontal scrollbar."
	
	self hResizeScrollbar.
	self hScrollbarShowing ifTrue: [^self].
	self privateAddMorph: self hScrollbar atIndex: 1.
	self vResizeScrollbar.
	self resizeScroller! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'gvc 10/3/2008 13:07'!
hResizeScrollbar
	"Resize the horizontal scrollbar to fit the receiver."
	
	|b|
	b := self innerBounds.
	b := b top: b bottom - self scrollBarThickness.
	self vScrollbarShowing ifTrue: [
		b := b right: b right - self scrollBarThickness].
	self hScrollbar bounds: b! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'gvc 10/3/2008 13:07'!
fitScrollTarget
	"If the scroller is bigger than the scroll target then
	resize the scroll target to fill the scroller."
	
	|extra|
	extra := 0.
	self scroller width > self scrollTarget width
		ifTrue: [self scrollTarget width: self scroller width]
		ifFalse: [extra := self scrollBarThickness].
	self scroller height - extra > self scrollTarget height
		ifTrue: [self scrollTarget height: self scroller height + extra]! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'GaryChambers 11/16/2011 13:25'!
hScrollbarNeeded
	"Return whether the horizontal scrollbar is needed."
	
	self hScrollbar showsAlways ifTrue: [^true].
	self hScrollbar showsNever ifTrue: [^false].
	^self scrollTarget width +
		(self scrollTarget height > self innerBounds height
			 ifTrue: [self scrollBarThickness] ifFalse: [0]) >
		self innerBounds width! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'GaryChambers 11/16/2011 13:33'!
hScrollbarShowAlways
	"Set the horizontal scrollbar to always show."
	
	self hScrollbar showAlways.
	self updateScrollbars! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'gvc 9/7/2006 10:25'!
hHideScrollbar
	"Hide the horizontal scrollbar."
	
	self hScrollbarShowing ifFalse: [^self].
	self removeMorph: self hScrollbar.
	self vResizeScrollbar.
	self resizeScroller! !

!GeneralScrollPane methodsFor: 'updating' stamp: 'gvc 9/7/2006 11:16'!
updateScrollbars
	"Update the visibility, dimensions and values of the scrollbars as needed."
	
	self
		vUpdateScrollbar;
		hUpdateScrollbar;
		setScrollDeltas! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'GaryChambers 11/16/2011 13:25'!
vScrollbarNeeded
	"Return whether the vertical scrollbar is needed."
	
	self vScrollbar showsAlways ifTrue: [^true].
	self vScrollbar showsNever ifTrue: [^false].
	^self scrollTarget height +
		(self scrollTarget width > self innerBounds width
			 ifTrue: [self scrollBarThickness] ifFalse: [0]) >
		self innerBounds height! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'gvc 10/3/2008 13:07'!
vResizeScrollbar
	"Resize the vertical scrollbar to fit the receiver."
	
	|b|
	b := self innerBounds.
	b := b left: b right - self scrollBarThickness.
	self hScrollbarShowing ifTrue: [
		b := b bottom: b bottom - self scrollBarThickness].
	self vScrollbar bounds: b! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'gvc 7/30/2009 13:49'!
hPageDelta
	"Answer the horizontal page delta."
	
	|pd tw sw|
	tw := self scrollTarget width.
	sw := self scrollBounds width.
	pd := tw - sw  max: 0.
	pd = 0 ifFalse: [pd := sw / pd].
	^pd! !

!GeneralScrollPane methodsFor: 'geometry' stamp: 'gvc 9/7/2006 11:16'!
setScrollDeltas
	"Set the ScrollBar deltas, value and interval, based on the current scroll pane size, offset and range."
	
	self
		hSetScrollDelta;
		vSetScrollDelta! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'GaryChambers 11/16/2011 13:33'!
hScrollbarShowWhenNeeded
	"Set the horizontal scrollbar to show if needed."
	
	self hScrollbar showWhenNeeded.
	self updateScrollbars! !

!GeneralScrollPane methodsFor: 'defaults' stamp: 'AlainPlantec 12/17/2009 14:29'!
scrollbarThickness
	"Answer the width or height of a scrollbar as appropriate to
	its orientation."
	
	^ self theme scrollbarThickness! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'GaryChambers 11/16/2011 13:32'!
hScrollbarShowNever
	"Set the horizontal scrollbar to never show."
	
	self hScrollbar showNever.
	self updateScrollbars! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'gvc 10/19/2006 10:30'!
hScrollbarValue: scrollValue
	"Set the offset of the scroller to match the 0.0-1.0 scroll value."
	
	|r|
	r := self scrollTarget width - self scrollBounds width max: 0.
	self scroller
		offset: (r * scrollValue) rounded @ self scroller offset y! !

!GeneralScrollPane methodsFor: 'accessing' stamp: 'GaryChambers 6/20/2011 13:19'!
adoptPaneColor: paneColor
	"Adopt the given pane color."
	
	super adoptPaneColor: paneColor.
	self hScrollbar adoptPaneColor: paneColor.
	self vScrollbar adoptPaneColor: paneColor! !

!GeneralScrollPane methodsFor: 'accessing' stamp: 'gvc 9/7/2006 10:16'!
hScrollbar
	"Answer the value of hScrollbar"

	^ hScrollbar! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'gvc 12/9/2008 12:06'!
hUpdateScrollbar
	"Update the visibility and dimensions of the horizontal scrollbar as needed."
	
	self hScrollbarNeeded
		ifTrue: [self
					hShowScrollbar;
					hResizeScrollbar]
		ifFalse: [self hHideScrollbar]! !

!GeneralScrollPane methodsFor: 'geometry' stamp: 'gvc 7/30/2009 13:51'!
vSetScrollDelta
	"Set the vertical scrollbar delta, value and interval, based on the current scroll bounds and offset."
	
	|pd|
	pd := self vPageDelta.
	self vScrollbar
		scrollDelta: pd / 10 
		pageDelta: pd;
		interval: self vScrollbarInterval;
		setValue: self vScrollbarValue! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'gvc 10/19/2006 10:30'!
vScrollbarValue: scrollValue
	"Set the offset of the scroller to match the 0.0-1.0 scroll value."
	
	|r|
	r := self scrollTarget height - self scrollBounds height max: 0.
	self scroller
		offset: self scroller offset x @ (r * scrollValue) rounded! !

!GeneralScrollPane methodsFor: 'layout' stamp: 'GaryChambers 9/8/2011 10:40'!
minWidth
	"Fit the width of the scroll target if hResizing is shrinkWrap."
	
	^self hResizing = #shrinkWrap
		ifTrue: [self scrollTarget minExtent x + self scrollbarThickness + 5]
		ifFalse: [super minWidth]! !

!GeneralScrollPane methodsFor: 'client list accessing' stamp: 'gvc 2/6/2008 10:19'!
scrollToShow: aRectangle
	"Scroll to include as much of aRectangle as possible, where aRectangle is in the scroller's local space."
	
	|offset|
	offset := self scroller offset.
	((aRectangle top - offset y) >= 0 and: [
		(aRectangle bottom - offset y) <= self innerBounds height])
		ifFalse: [offset := offset x @ (
					(aRectangle top min: self scrollTarget height - self innerBounds height))].
	((aRectangle left - offset x) >= 0 and: [
		(aRectangle right - offset x) <= self innerBounds width])
		ifFalse: [offset := (aRectangle left min: self scrollTarget width - self innerBounds width) @ offset y].
	offset = self scroller offset ifFalse: [
		self scroller offset: offset.
		self setScrollDeltas]! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'GaryChambers 11/16/2011 13:34'!
vScrollbarShowAlways
	"Set the vertical scrollbar to always show."
	
	self vScrollbar showAlways.
	self updateScrollbars! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'gvc 9/7/2006 10:28'!
vShowScrollbar
	"Show the vertical scrollbar."
	
	self vResizeScrollbar.
	self vScrollbarShowing ifTrue: [^self].
	self privateAddMorph: self vScrollbar atIndex: 1.
	self hResizeScrollbar.
	self resizeScroller! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'gvc 10/3/2008 13:07'!
scrollBounds
	"Return the visible scroll area taking into account whether
	the scrollbars need to be shown."
	
	|b|
	b := self innerBounds.
	self vScrollbarNeeded ifTrue: [b := b right: (b right - self scrollBarThickness)].
	self hScrollbarNeeded ifTrue: [b := b bottom: (b bottom - self scrollBarThickness)].
	^b! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'gvc 9/7/2006 10:03'!
vUpdateScrollbar
	"Update the visibility and dimensions of the vertical scrollbar as needed."
	
	self vScrollbarNeeded
		ifTrue: [self
				vShowScrollbar;
				vResizeScrollbar]
		ifFalse: [self vHideScrollbar]! !

!GeneralScrollPane methodsFor: 'geometry' stamp: 'gvc 9/8/2006 11:06'!
extent: newExtent
	"Update the receiver's extent. Hide/show the scrollbars and resize the scroller
	as neccessary."
	
	|scrollbarChange|
	bounds extent = newExtent ifTrue: [^ self].
	super extent: newExtent.
	scrollbarChange := (self vScrollbarShowing = self vScrollbarNeeded) not.
	scrollbarChange := scrollbarChange or: [(self hScrollbarShowing = self hScrollbarNeeded) not].
	self	updateScrollbars.
	scrollbarChange ifFalse: [self resizeScroller] "if there is a scrollbar change then done already"! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'gvc 9/7/2006 10:07'!
hScrollbarShowing
	"Answer whether the horizontal scrollbar is showing."
	
	^self hScrollbar owner notNil
	! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'gvc 7/30/2009 13:50'!
vScrollbarValue
	"Answer the computed vertical scrollbar value."
	
	|tw sw v|
	tw := self scrollTarget height.
	sw := self scrollBounds height.
	v := tw - sw  max: 0.
	v = 0 ifFalse: [v := self scroller offset y asFloat / v min: 1.0].
	^v! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'gvc 7/30/2009 13:49'!
hScrollbarValue
	"Answer the computed horizontal scrollbar value."
	
	|tw sw v|
	tw := self scrollTarget width.
	sw := self scrollBounds width.
	v := tw - sw  max: 0.
	v = 0 ifFalse: [v :=  self scroller offset x asFloat / v min: 1.0].
	^v! !

!GeneralScrollPane methodsFor: 'accessing' stamp: 'gvc 9/7/2006 09:40'!
scroller
	"Answer the value of scroller"

	^ scroller! !

!GeneralScrollPane methodsFor: 'layout' stamp: 'GaryChambers 1/11/2011 13:33'!
doLayoutIn: layoutBounds 
	"Compute a new layout based on the given layout bounds."

	|scrollbarChange|
	super doLayoutIn: layoutBounds.
	scrollbarChange := (self vScrollbarShowing = self vScrollbarNeeded) not.
	scrollbarChange := scrollbarChange or: [(self hScrollbarShowing = self hScrollbarNeeded) not].
	self	updateScrollbars.
	scrollbarChange ifFalse: [self resizeScroller]. "if there is a scrollbar change then done already"
	super doLayoutIn: layoutBounds
! !

!GeneralScrollPane methodsFor: 'accessing' stamp: 'gvc 9/7/2006 10:16'!
vScrollbar
	"Answer the value of vScrollbar"

	^ vScrollbar! !

!GeneralScrollPane methodsFor: 'event handling' stamp: 'gvc 7/30/2009 13:50'!
scrollByKeyboard: event 
	"If event is ctrl+up/down then scroll and answer true."
	
	|sb|
	sb := event commandKeyPressed
		ifTrue: [self hScrollbar]
		ifFalse: [self vScrollbar].
	(event keyValue = 30 or: [event keyValue = 11]) ifTrue: [
		sb scrollUp: 3.
		^true].
	(event keyValue = 31 or: [event keyValue = 12])ifTrue: [
		sb scrollDown: 3.
		^true].
	^false! !

!GeneralScrollPane methodsFor: 'layout' stamp: 'GaryChambers 9/8/2011 10:40'!
minHeight
	"Fit the width of the scroll target if vResizing is shrinkWrap."
	
	^self vResizing = #shrinkWrap
		ifTrue: [self scrollTarget minExtent y + self scrollbarThickness + 5]
		ifFalse: [super minHeight]! !

!GeneralScrollPane methodsFor: 'geometry' stamp: 'gvc 7/30/2009 13:50'!
hSetScrollDelta
	"Set the horizontal scrollbar delta, value and interval, based on the current scroll bounds and offset."
	
	|pd|
	pd := self hPageDelta.
	self hScrollbar
		scrollDelta: pd / 10 
		pageDelta: pd;
		interval: self hScrollbarInterval;
		setValue: self hScrollbarValue! !

!GeneralScrollPane methodsFor: 'instance creation' stamp: 'EstebanLorenzano 8/8/2012 15:32'!
newScroller
	"Answer a new scroller."

	^TransformWithLayoutMorph new
		color: Color transparent! !

!GeneralScrollPane methodsFor: 'scrollbars' stamp: 'gvc 9/7/2006 10:48'!
scrollTarget: aMorph
	"Set the morph that is scrolled."
	
	self scroller
		removeAllMorphs;
		addMorph: aMorph.
	self updateScrollbars! !

!GeneralScrollPane class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 3/26/2015 00:04'!
gtScrollerWithWrappingAndSpaceFilling
	"
	self gtScrollerWithWrappingAndSpaceFilling openInWindow
	"

	<gtExample>
	| scrollpane pane |
	scrollpane := GeneralScrollPane new.
	scrollpane changeScrollerTableLayout.
	pane := PanelMorph new
		changeTableLayout;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		yourself.
	scrollpane scrollTarget: pane.
	Object methods
		do: [ :each | 
			| methodLabel |
			methodLabel := Morph new
				changeTableLayout;
				wrapCentering: #center;
				hResizing: #spaceFill;
				vResizing: #spaceFill;
				color: Color lightBlue.
			methodLabel addMorphBack: (each selector asTextMorph lock).
				
			pane addMorph: methodLabel ].
	scrollpane
		hResizing: #shrinkWrap;
		height: 400.
	^ scrollpane! !

!GeneralScrollPane class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 3/26/2015 00:04'!
gtScrollerWithWrappingAndNoSpaceFilling
	"
	self gtScrollerWithWrappingAndNoSpaceFilling openInWindow
	"

	<gtExample>
	| scrollpane pane |
	scrollpane := GeneralScrollPane new.
	scrollpane changeScrollerTableLayout.
	pane := PanelMorph new
		changeTableLayout;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		yourself.
	scrollpane scrollTarget: pane.
	Object methods
		do: [ :each | 
			| methodLabel |
			methodLabel := each selector asTextMorph lock 
				backgroundColor: Color lightBlue.
				
			pane addMorph: methodLabel ].
	scrollpane
		hResizing: #shrinkWrap;
		height: 400.
	^ scrollpane! !

!Generator commentStamp: 'SeanDeNigris 3/30/2015 17:41'!
A Generator transforms callback interfaces into stream interfaces. 

When a producer algorithm provide results as callbacks (blocks) and a consumer algorithm expects streamable input, a Generator transforms one into the other. See class-side examples.

Instance Variables
	block:		<BlockClosure> The block associated with the generator.
	continue:	<MethodContext>	The continuation to return to.
	home:		<MethodContext>	The home (root) context of the activated block
	next:		<Object>		The next object to return from the Generator.
!
!Generator methodsFor: 'accessing' stamp: 'lr 2/10/2010 09:16'!
size
	"A generator does not know its size."

	^ self shouldNotImplement! !

!Generator methodsFor: 'accessing' stamp: 'ar 2/10/2010 20:54'!
close
	"Close the receiving generator and unwind its ensure-blocks."

	continue ifNotNil:[continue unwindTo: home].
	continue := block := next := nil! !

!Generator methodsFor: 'testing' stamp: 'ar 2/10/2010 21:00'!
atEnd
	"Answer whether the receiver can access any more objects."

	^ continue isNil! !

!Generator methodsFor: 'accessing' stamp: 'lr 2/10/2010 09:16'!
nextPut: anObject
	"Add anObject into the generator. A synonym to #yield: and value:."

	| previous |
	previous := next.
	next := anObject.
	continue := thisContext swapSender: continue.
	^ previous! !

!Generator methodsFor: 'accessing' stamp: 'ar 2/10/2010 20:45'!
next
	"Generate and answer the next object in the receiver."

	^ self atEnd ifFalse: [
		home swapSender: thisContext sender.
		continue := thisContext swapSender: continue
	]! !

!Generator methodsFor: 'public' stamp: 'ar 2/10/2010 20:52'!
yield: anObject 
	"Yield the next value to the consumer of the generator.
	A synonym for #nextPut:"
	^ self nextPut: anObject! !

!Generator methodsFor: 'public' stamp: 'MarcusDenker 7/24/2014 17:01'!
reset
	"Reset the generator, i.e., start it over"
	continue ifNotNil:[continue unwindTo: home].
	next := nil.
	continue := thisContext.
	self fork! !

!Generator methodsFor: 'private' stamp: 'ar 2/10/2010 20:46'!
fork
	| result |
	home := thisContext.
	block reentrant value: self.
	thisContext swapSender: continue.
	result := next.
	continue := next := home := nil.
	^ result! !

!Generator methodsFor: 'public' stamp: 'ar 2/10/2010 21:01'!
value: anObject 
	"Allows passing generators as arguments to methods expecting blocks.
	A synonym for #yield: / #nextPut:."
	^ self nextPut: anObject! !

!Generator methodsFor: 'printing' stamp: 'lr 1/8/2009 16:21'!
printOn: aStream
	aStream nextPutAll: self class name; nextPutAll: ' on: '; print: block! !

!Generator methodsFor: 'initialization' stamp: 'lr 1/8/2009 16:18'!
initializeOn: aBlock
	block := aBlock.
	self reset! !

!Generator methodsFor: 'accessing' stamp: 'lr 4/26/2009 11:50'!
contents
	"Answer the contents of this generator. Do not call this method on infinite generators."

	| stream |
	stream := (Array new: 10) writeStream.
	[ self atEnd ]
		whileFalse: [ stream nextPut: self next ].
	^ stream contents! !

!Generator methodsFor: 'accessing' stamp: 'lr 2/10/2010 09:16'!
peek
	"Answer the upcoming object of the receiver."

	^ next! !

!Generator class methodsFor: 'instance-creation' stamp: 'lr 1/8/2009 15:54'!
on: aBlock
	^ self basicNew initializeOn: aBlock! !

!Generator class methodsFor: 'examples' stamp: 'SeanDeNigris 3/30/2015 17:42'!
examplePrimes
	| generator |
	Transcript open.
	generator := Generator on: [:g| Integer primesUpTo: 100 do:[:prime| g yield: prime]].
	[generator atEnd] whileFalse:[Transcript show: generator next; cr].! !

!GeneratorTest commentStamp: 'TorstenBergmann 2/20/2014 15:29'!
SUnit tests for class Generator!
!GeneratorTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testErrorPropagation
	"Ensure that errors in the generator block are properly propagated"

	| generator |
	generator := Generator
		on: [ :g | 
			g yield: 1.
			g error: 'yo' ].
	self should: [ generator next ] raise: Error! !

!GeneratorTest methodsFor: 'testing' stamp: 'ar 2/10/2010 21:03'!
testResetUnwind
	"Just like close, just using reset"
	| generator doEnsure notEnsure |
	doEnsure := notEnsure := 0.
	[ generator := Generator on: [ :g |
		[ g yield: 1; yield: 2 ]
			ensure: [ doEnsure := doEnsure + 1 ] ].
	self assert: doEnsure = 0; assert: notEnsure = 0.
	self assert: generator peek = 1.
	self assert: doEnsure = 0; assert: notEnsure = 0.
	generator reset.
	self assert: doEnsure = 1; assert: notEnsure = 0 ]
		ensure: [ notEnsure := notEnsure + 1 ].
	self assert: doEnsure = 1; assert: notEnsure = 1! !

!GeneratorTest methodsFor: 'testing' stamp: 'lr 2/10/2010 09:02'!
testEnsure
	| generator |
	generator := Generator on: [ :g |
		[ g yield: 1; yield: 2 ]
			ensure: [ g yield: 3 ] ].
	self assert: generator upToEnd asArray = #( 1 2 3 )! !

!GeneratorTest methodsFor: 'testing' stamp: 'lr 4/26/2009 11:51'!
testContents
	| generator |
	generator := self numbersBetween: 1 and: 3.
	self assert: generator contents = #(1 2 3)! !

!GeneratorTest methodsFor: 'testing' stamp: 'lr 1/8/2009 16:33'!
testNext
	| generator |
	generator := self numbersBetween: 1 and: 3.
	self assert: generator next = 1.
	self assert: generator next = 2.
	self assert: generator next = 3.
	self assert: generator next isNil! !

!GeneratorTest methodsFor: 'testing' stamp: 'lr 1/8/2009 16:45'!
testPeek
	| generator |
	generator := self numbersBetween: 1 and: 3.
	self assert: generator peek = 1.
	self assert: generator peek = 1.
	generator next.
	self assert: generator peek = 2! !

!GeneratorTest methodsFor: 'testing' stamp: 'lr 1/8/2009 16:45'!
testEmpty
	| generator |
	generator := Generator on: [ :g | ].
	self assert: generator atEnd.
	self assert: generator peek isNil.
	self assert: generator next isNil! !

!GeneratorTest methodsFor: 'generators' stamp: 'lr 1/8/2009 16:29'!
fibonacciSequence
	"Yields an infinite sequence of fibonacci numbers."
	
	^ Generator on: [ :generator |
		| a b |
		a := 0. b := 1.
		[ a := b + (b := a).
		  generator yield: a ]
			repeat ]! !

!GeneratorTest methodsFor: 'testing' stamp: 'lr 1/8/2009 16:33'!
testAtEnd
	| generator |
	generator := self numbersBetween: 1 and: 3.
	self deny: generator atEnd.
	generator next.
	self deny: generator atEnd.
	generator next.
	self deny: generator atEnd.
	generator next.
	self assert: generator atEnd! !

!GeneratorTest methodsFor: 'testing' stamp: 'lr 1/8/2009 16:50'!
testFibonacci
	| generator |
	generator := self fibonacciSequence.
	self assert: (generator next: 10) asArray = #( 1 1 2 3 5 8 13 21 34 55 )! !

!GeneratorTest methodsFor: 'testing' stamp: 'lr 1/8/2009 16:35'!
testReset
	| generator |
	generator := self numbersBetween: 1 and: 3.
	self assert: generator next = 1.
	self assert: generator next = 2.
	generator reset.
	self assert: generator next = 1.
	self assert: generator next = 2.
	self assert: generator next = 3.
	self assert: generator next = nil.
	generator reset.
	self assert: generator next = 1! !

!GeneratorTest methodsFor: 'generators' stamp: 'lr 1/8/2009 15:49'!
numbersBetween: aStartInteger and: aStopInteger
	"Yields the nubmers between aStartInteger and aStopInteger."
	
	^ Generator on: [ :generator |
		aStartInteger to: aStopInteger 
			do: [ :value | generator yield: value ] ]! !

!GeneratorTest methodsFor: 'testing' stamp: 'lr 1/8/2009 16:46'!
testSimple
	| generator |
	generator := Generator on: [ :g | g yield: 1; yield: 2 ].
	self assert: generator upToEnd asArray = #( 1 2 )! !

!GeneratorTest methodsFor: 'testing' stamp: 'lr 2/10/2010 09:18'!
testClose
	| generator doEnsure notEnsure |
	doEnsure := notEnsure := 0.
	[ generator := Generator on: [ :g |
		[ g yield: 1; yield: 2 ]
			ensure: [ doEnsure := doEnsure + 1 ] ].
	self assert: doEnsure = 0; assert: notEnsure = 0.
	self assert: generator peek = 1.
	self assert: doEnsure = 0; assert: notEnsure = 0.
	generator close.
	self assert: doEnsure = 1; assert: notEnsure = 0 ]
		ensure: [ notEnsure := notEnsure + 1 ].
	self assert: doEnsure = 1; assert: notEnsure = 1! !

!GeneratorTest class methodsFor: 'accessing' stamp: 'lr 2/10/2010 08:34'!
packageNamesUnderTest
	^ #('Generator')! !

!GlamourousBenchmark methodsFor: 'utilities' stamp: 'TudorGirba 11/1/2013 15:49'!
defaultFinderBrowser 
	"
	self new defaultFinderBrowser openOn: 10
	"
	| finder |
	finder := GLMFinder new.
	finder show: [:a | a list
		title: 'title';
		display: [:each | 1 to: each ];
		showOnly: 50 ].

	^ finder! !

!GlamourousBenchmark methodsFor: 'utilities' stamp: 'TudorGirba 7/29/2011 18:59'!
defaultBrowser 
	| browser |
	browser := GLMTabulator new.
	browser column: #one; column: #two.

	browser transmit to: #one; andShow: [ :a |
		a list
			display: [:x | 1 to: x * 3] ].
	browser transmit to: #two; from: #one; andShow: [ :a |
		a list
			display: [:x | 1 to: x * 3] ].
	browser transmit to: #one; from: #two; andShow: [ :a |
		a list
			display: [:x | 1 to: x * 3] ].

	^ browser! !

!GlamourousBenchmark methodsFor: 'utilities' stamp: 'tg 1/23/2010 00:54'!
showOnlyFinderBrowser 
	"
	self new showOnlyFinderBrowser openOn: 10
	"
	| finder |
	finder := GLMFinder new.
	finder list
		title: 'title';
		display: [:each | 1 to: each ];
		showOnly: 50.

	^ finder! !

!GlamourousBenchmark methodsFor: 'utilities' stamp: 'Alexandre Bergel 10/23/2009 10:04'!
measureSelectionTimeForSize: size
	"
	self new measureSelectionTime 
	"
	| browser numberOfSelections time port window |
	numberOfSelections := 15.

	browser := self defaultBrowser.
	window := browser openOn: size.
	port := browser panes first ports second.
	time := Time millisecondsToRun: [ (size - numberOfSelections) to: size do: [:i | port value: i ] ].
	window delete.
	^ {size . time}! !

!GlamourousBenchmark methodsFor: 'utilities' stamp: 'Alexandre Bergel 10/23/2009 09:50'!
measureOpeningTime
	| browser numberOfOpenings time |
	numberOfOpenings := 15.

	browser := self defaultBrowser.
	time := Time millisecondsToRun: [ numberOfOpenings timesRepeat: [(browser openOn: 10) delete] ].
	^ {numberOfOpenings . time}! !

!GlamourousBenchmark methodsFor: 'utilities' stamp: 'TudorGirba 7/29/2011 18:59'!
showOnlyBrowser 
	| browser |
	browser := GLMTabulator new.
	browser column: #one; column: #two.

	browser transmit to: #one; andShow: [ :a |
		a list
			display: [:x | 1 to: x * 3];
			showOnly: 50].
	browser transmit to: #two; from: #one; andShow: [ :a |
		a list
			display: [:x | 1 to: x * 3];
			showOnly: 50].
	browser transmit to: #one; from: #two; andShow: [ :a |
		a list
			display: [:x | 1 to: x * 3];
			showOnly: 50].

	^ browser! !

!GlamourousBenchmark methodsFor: 'utilities' stamp: 'Alexandre Bergel 10/23/2009 09:57'!
measureSelectionTime
	"
	self new measureSelectionTime 
	"
	^ self measureSelectionTimeForSize: 1000! !

!GlamourousBenchmark methodsFor: 'utilities' stamp: 'lr 6/4/2010 14:50'!
measureSelectionTimeInFinderForSize: size
	"
	self new measureSelectionTimeInFinderForSize: 20 
	"
	| browser time window |

	browser := self defaultFinderBrowser.
	window := browser openOn: size.
	
	time := Time millisecondsToRun: 
			[size timesRepeat: [ (window model panes last port: #selection) value: size].].
		
	window delete.
	^ {size . time}! !

!GlobalVariable commentStamp: 'MarcusDenker 7/18/2014 10:02'!
I model Globals. I am stored as a binding in the Smalltalk globals.

The compiler forwards bytecode generation to me for accessing the variable.!
!GlobalVariable methodsFor: 'code generation' stamp: 'MarcusDenker 1/23/2015 14:29'!
emitStore: methodBuilder
	methodBuilder storeIntoLiteralVariable: self.

! !

!GlobalVariable methodsFor: 'code generation' stamp: 'MarcusDenker 7/18/2014 07:31'!
emitValue: methodBuilder
	methodBuilder pushLiteralVariable: self.! !

!GlobalVariable methodsFor: 'queries' stamp: 'MarcusDenker 7/18/2014 10:01'!
definingClass
	"The class defining the variable. For Globals, return nil"
	^nil! !

!GlobalVariable methodsFor: 'testing' stamp: 'MarcusDenker 7/18/2014 10:04'!
isGlobalVariable
	^true! !

!GlobalVariable methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 1/14/2015 14:35'!
spotterActDefault
	self value inspect! !

!GlobalVariable methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/24/2015 14:44'!
spotterReferenceFor: aStep
	<spotterOrder: 130>
	aStep listProcessor
			title: 'References';
			allCandidates: [ (SystemNavigation default allReferencesTo: self) collect: #compiledMethod ];
			itemName: [ :method | method gtDisplayString ];
			filter: GTFilterSubstring! !

!GlobalVariable methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/24/2015 14:44'!
spotterClassFor: aStep
	<spotterOrder: 50>
	aStep listProcessor
			title: 'Class';
			allCandidates: [ { self value class }];
			itemIcon: #systemIcon;
			filter: GTFilterSubstring! !

!GlobalVariable methodsFor: '*reflectivity' stamp: 'MarcusDenker 7/21/2014 16:45'!
link: aMetaLink
	| wrapper  methods |
	methods := self usingMethods.
	wrapper := self asWrapperFor: aMetaLink.
	
	Smalltalk globals removeKey: self key.
	Smalltalk globals add: wrapper.
	self value isBehavior ifTrue: [self value recompile].
	methods do: #recompile.  "recompile all methods that reference the Global"! !

!GlobalVariable class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:00'!
gtExampleSmalltalk
	<gtExample>
	^ Smalltalk globals associations detect: [:assoc | assoc key = #Smalltalk ]! !

!GlyphForm commentStamp: 'TorstenBergmann 2/4/2014 22:11'!
A specialized form for glyphs!
!GlyphForm methodsFor: 'accessing' stamp: 'tween 4/23/2006 20:54'!
advance
	^advance! !

!GlyphForm methodsFor: 'converting' stamp: 'StephaneDucasse 10/25/2013 16:16'!
asFormOfDepth: d
	| newForm |
	d = self depth ifTrue:[^self].
	newForm := self class extent: self extent depth: d.
	(BitBlt toForm: newForm)
		colorMap: (self colormapIfNeededFor: newForm);
		copy: (self boundingBox)
		from: 0@0 in: self
		fillColor: nil rule: Form over.
	newForm 
		offset: offset;
		advance:advance;
		linearAdvance: linearAdvance.
	^newForm! !

!GlyphForm methodsFor: 'accessing' stamp: 'tween 8/6/2006 21:10'!
linearAdvance
	^linearAdvance
! !

!GlyphForm methodsFor: 'accessing' stamp: 'tween 4/23/2006 20:54'!
advance: aNumber
	^advance := aNumber! !

!GlyphForm methodsFor: 'accessing' stamp: 'tween 8/6/2006 21:10'!
linearAdvance: aNumber
	^linearAdvance := aNumber! !

!GlyphRenderer commentStamp: 'TorstenBergmann 2/12/2014 22:21'!
Renderer for font glyphs!
!GlyphRenderer methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 7/12/2011 19:45'!
initForFont: aFont

	self subclassResponsibility ! !

!GlyphRenderer class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 7/12/2011 19:26'!
test

	| fnt glyph |
	
	fnt := StandardFonts defaultFont.
	fnt class == LogicalFont ifTrue: [
		fnt := fnt realFont.
		].
	fnt class ~~ FreeTypeFont ifTrue: [ self error: 'invalid font' ].
	
	glyph := self  new initPixelSize: fnt pixelSize.
	
	glyph renderGlyph: $A asUnicode face: fnt face.
	glyph renderGlyph: $B asUnicode face: fnt face.
	glyph renderGlyph: $C asUnicode face: fnt face.
	glyph renderGlyph: $+ asUnicode face: fnt face.
	
	glyph drawOn: Display at: 0@0! !

!GlyphRenderer class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 7/12/2011 19:45'!
forFont: aFont
	^ self basicNew initForFont: aFont! !

!GoBackStringMorph commentStamp: '<historical>'!
A GoBackStringMorph is a string morph which do not totally rotate but do some go and back!
!GoBackStringMorph methodsFor: 'event handling' stamp: 'CT 1/8/2013 18:25'!
mouseEnter: evt
	super mouseEnter: evt.
	frontward := true.
	index := 0.
	wait := 0! !

!GoBackStringMorph methodsFor: 'private' stamp: 'CT 1/8/2013 18:55'!
currentContentsLargeEnough
	^(self font widthOfString: self contents) <= (self ownerChain collect: [ :morph | morph extent x ]) min! !

!GoBackStringMorph methodsFor: 'stepping and presenter' stamp: 'CT 1/8/2013 18:43'!
stepAction
	wait = 0
		ifFalse: [ 
			wait := wait - 1.
			^ self ].
	frontward
		ifTrue: [ self stepFrontward ]
		ifFalse: [ self stepBackward ].
	self privateSetContents: (initialContents allButFirst: index)! !

!GoBackStringMorph methodsFor: 'stepping and presenter' stamp: 'MarcusDenker 11/22/2014 16:02'!
stepBackward
	index := index - 1.
	index = 0
		ifFalse: [ ^ self ].
	frontward := true.
	wait := 3! !

!GoBackStringMorph methodsFor: 'stepping and presenter' stamp: 'MarcusDenker 11/22/2014 16:02'!
stepFrontward
	index := index + 1.
	self currentContentsLargeEnough
		ifFalse: [ ^ self ].
	frontward := false.
	wait := 5! !

!Gofer commentStamp: 'lr 1/30/2010 14:42'!
: Gofer, a person who runs errands. Origin 1960s: from go for, i.e. go and fetch.
: ''The New Oxford American Dictionary''

!! Synopsis

Gofer is a small tool on top of Monticello that loads, updates, merges, diffs, reverts, commits, recompiles and unloads groups of Monticello packages. Contrary to existing tools Gofer makes sure that these operations are performed as clean as possible:

- Gofer treats packages from one or more repository in one operation.
- Gofer works with fixed versions or tries to find the "latest" version using a given package name.
- Gofer automatically assigns repositories to all packages, so that the other tools are ready to be used on individual packages.
- Gofer makes sure that there is only one repository instance registered for a single physical location.
- Gofer works with Monticello dependencies and uniformly treats them like the primary package.
- Gofer prefers to work with faster repositories if there is a choice.
- Gofer cleans up after Monticello, no empty class categories and no empty method protocols are to be expected.
- Gofer supports operations to sync remote and local repositories with each other.

!! Installation

Gofer is included with the latest Pharo and GemStone distributions. To update to the latest version you can use Gofer itself:

== Gofer upgrade

In case you are missing Gofer in your image, grab it from *http://source.lukas-renggli.ch/gofer.html*.

!! Description

Gofer is very simple by design, the basic useage scenario is always the same and consists of three steps:

# You specify one or more Monticello repository URLs. You can do this using the methods ==url:==, ==url:username:password:== (HTTP, FTP), ==directory:==, or ==repository:== if you need full control. You might also use the convenience methods like ==squeaksource:==, ==wiresong:==, or ==gemsource:== for well known repositories. Additionally the following settings are available:
#- Gofer implicitly declares the local package cache as a repository. To disable the local package cache use the method ==disablePackageCache==, to re-enable use ==enablePackageCache==.
#- Gofer throws an error if a repository is not reachable. To silently ignore repository erros use the message ==disableRepositoryErrors==, to re-enable use ==enableRepositoryErrors==.
# You specify one or more Monticello packages you want to work with, by adding them to the Gofer instance. Use ==version:== to add a specific version, or use ==package:== to add the "latest" version in the given repository. Furthermore there is ==package:constraint:== that allows you to further constraint the version to be loaded in a block passed in as the second argument.
# You specify one or more actions to be performed on the specified packages:

| ==load==	| Load the specified packages.
| ==update==	| Update the specified packages.
| ==merge==	| Merge the specified packages into their working copies.
| ==localChanges==	| Answer the changes between the base version and the working copy.
| ==browseLocalChanges==	| Browse the changes between the base version and the working copy.
| ==remoteChanges==	| Answer the changes between the working copy and the remote changes.
| ==browseRemoteChanges==	| Browse the changes between the working copy and the remote changes.
| ==cleanup==	| Cleans the specified packages.
| ==commit==	| Commit the modified specified packages.
| ==commit:==	| Commit the modified specified packages with the given commit message.
| ==revert==	| Revert the specified packages to the currently loaded version.
| ==recompile==	| Recompile the specified packages.
| ==reinitialize==	| Call the class side initializers on the specified packages.
| ==unload==	| Unload the specified packages.
| ==fetch==     | Download versions from remote repositories into the local cache.
| ==push==      | Upload local versions from local cache into remote repositories.

!! Example

To use Gofer to update to exact versions of the Kom Server, the 'latest' code of Seaside 2.8 and the 'latest' code of the Scriptaculous package that is committed by the author with the initials 'lr' one could evaluate:

== Gofer new
==     squeaksource: 'KomHttpServer';
==     version: 'DynamicBindings-gc.7';
==     version: 'KomServices-gc.19';
==     version: 'KomHttpServer-gc.32';
==     update.
== Gofer new
==     squeaksource: 'Seaside';
==     package: 'Seaside2.8a';
==     package: 'Scriptaculous' constraint: [ :version | version author = 'lr' ];
==     load!
!Gofer methodsFor: '*metacello-testsmc' stamp: 'dkh 6/12/2012 15:41:23.319'!
metacelloUnload
	"Unload the specified packages."
	
	^ self execute: MetacelloTestsGoferUnload! !

!Gofer methodsFor: '*metacello-testsmc' stamp: 'dkh 6/12/2012 15:41:23.319'!
metacelloCleanup
	"Cleans the specified packages."
	
	^ self execute: MetacelloTestsGoferCleanup! !

!Gofer methodsFor: 'repositories-places' stamp: 'StephaneDucasse 8/5/2013 14:20'!
squeaksource3: aProjectName
	self repository: (MCGemstoneRepository location: 'http://ss3.gemtalksystems.com/ss/' , aProjectName)! !

!Gofer methodsFor: 'repositories-places' stamp: 'lr 7/10/2009 16:27'!
impara: aString
	self url: 'http://source.impara.de/' , aString! !

!Gofer methodsFor: 'initialization' stamp: 'lr 12/13/2009 16:33'!
initialize
	self enablePackageCache; enableRepositoryErrors.
	references := OrderedCollection new.
	repositories := OrderedCollection new! !

!Gofer methodsFor: 'operations' stamp: 'lr 12/3/2009 21:06'!
push
	"Upload local versions from local cache into remote repositories."

	^ self execute: GoferPush! !

!Gofer methodsFor: 'references' stamp: 'lr 4/3/2010 09:56'!
package: aString
	"Add the package aString to the receiver. aString is a package name as it appears in the Monticello Browser, something like 'Magritte-Seaside'. Gofer will try to resolve this name to an actual version in one of the configured repositories before doing something with the package. Gofer sorts all the versions in all the repositories according to branch name (versions without a branch are preferred), version number, author name and repository priority. The top hit of this sorted list is eventually going to be loaded and used."

	references addLast: (GoferPackageReference name: aString)! !

!Gofer methodsFor: 'operations' stamp: 'CamilloBruni 9/18/2012 19:10'!
loadStable
	"Load the stable version of the previously specifed configuration."
	
	^ self loadVersion: #stable! !

!Gofer methodsFor: '*metacello-testsmc' stamp: 'dkh 6/12/2012 15:41:23.319'!
metacelloLoad
	"Load the specified packages into the image."
	
	^ self execute: MetacelloGoferLoad! !

!Gofer methodsFor: 'operations' stamp: 'CamilloBruni 9/12/2013 11:00'!
loadDevelopment
	"Load the development version of the previously specifed configuration."
	
	^ self loadVersion: #development! !

!Gofer methodsFor: 'operations' stamp: 'lr 11/10/2009 10:06'!
merge
	"Merge the specified packages into their working copies."
	
	^ self execute: GoferMerge! !

!Gofer methodsFor: 'repositories-places' stamp: 'lr 7/10/2009 16:26'!
wiresong: aString
	self url: 'http://source.wiresong.ca/' , aString! !

!Gofer methodsFor: 'references' stamp: 'lr 4/3/2010 09:52'!
version: aString
	"Add the version aString to the receiver. aString is a version name as it appears in the Monticello Repository Browser, something like 'Magritte-Seaside-lr.334'. Gofer will try to resolve this name to one of the configured repositories before loading the code."

	references addLast: (GoferVersionReference name: aString)! !

!Gofer methodsFor: 'operations' stamp: 'lr 9/18/2009 18:12'!
update
	"Update the specified packages."
	
	^ self execute: GoferUpdate! !

!Gofer methodsFor: 'repositories-options' stamp: 'lr 12/13/2009 16:32'!
disableRepositoryErrors
	"Silently swallow all repository errors."

	errorBlock := [ :error | error resume: #() ]! !

!Gofer methodsFor: 'operations' stamp: 'lr 12/30/2009 11:27'!
reinitialize
	"Calls the class side initializers on all package code."
	
	^ self execute: GoferReinitialize! !

!Gofer methodsFor: 'repositories-places' stamp: 'CamilloBruni 9/18/2012 18:27'!
smalltalkhubUser: aUserName project: aProjectName
	self repository: (MCSmalltalkhubRepository owner: aUserName project: aProjectName)! !

!Gofer methodsFor: 'operations' stamp: 'lr 8/20/2009 11:44'!
recompile
	"Recompile the specified packages."

	^ self execute: GoferRecompile! !

!Gofer methodsFor: 'repositories-options' stamp: 'SeanDeNigris 7/17/2012 15:47'!
enablePackageCache
	"Enable the use of the package-cache repository."

	packageCacheRepository := MCCacheRepository uniqueInstance.! !

!Gofer methodsFor: 'operations' stamp: 'CamilloBruni 9/18/2012 19:11'!
loadVersion: anMetacelloVersionIdentifierSymbol
	"Load the given version name"
	^ self execute: GoferMetacelloLoad do: [ :operation|
		operation version: anMetacelloVersionIdentifierSymbol ]! !

!Gofer methodsFor: 'copying' stamp: 'lr 12/13/2009 16:52'!
postCopy
	references := references copy.
	repositories := repositories copy.
	resolvedReferencesCache := nil! !

!Gofer methodsFor: 'repositories' stamp: 'MarcusDenker 7/16/2014 13:12'!
directory: aDirectoryOrString
	"Add a file-system repository at aDirectoryOrString."

	| repository |
	repository := (aDirectoryOrString isString and: [ aDirectoryOrString endsWith: '*' ])
		ifTrue: [ 
			MCSubDirectoryRepository new
				directory: aDirectoryOrString allButLast asFileReference;
				yourself ]
		ifFalse: [ 
			(MCDirectoryRepository new)
				directory:
						(aDirectoryOrString isString
								ifTrue: [ aDirectoryOrString asFileReference ]
								ifFalse: [ aDirectoryOrString ]);
				yourself ].
	self repository: repository! !

!Gofer methodsFor: 'accessing' stamp: 'lr 12/13/2009 17:17'!
allResolvedIn: aRepository
	"Answer all sorted references within aRepository. For efficiency cache the references."

	^ (resolvedReferencesCache ifNil: [ resolvedReferencesCache := Dictionary new ])
		at: aRepository ifAbsentPut: [ self basicReferencesIn: aRepository ]! !

!Gofer methodsFor: 'references' stamp: 'CamilloBruni 9/18/2012 18:52'!
configurationOf: aProjectName
	"Add a package reference to the configuration of the given project"
	references addLast: (GoferConfigurationReference name: aProjectName)! !

!Gofer methodsFor: 'operations-ui' stamp: 'lr 12/14/2009 23:51'!
browseLocalChanges
	"Browse the changes between the base version and the working copy."
	
	^ self execute: GoferBrowseLocalChanges! !

!Gofer methodsFor: 'accessing' stamp: 'lr 12/13/2009 17:14'!
resolved
	"Answer the resolved references of the receiver."

	^ self references collect: [ :each | each resolveWith: self ]! !

!Gofer methodsFor: 'operations-ui' stamp: 'lr 12/14/2009 23:51'!
browseRemoteChanges
	"Browse the changes between the working copy and the remote changes."
	
	^ self execute: GoferBrowseRemoteChanges! !

!Gofer methodsFor: 'operations' stamp: 'lr 10/3/2009 11:31'!
cleanup
	"Cleans the specified packages."
	
	^ self execute: GoferCleanup! !

!Gofer methodsFor: 'repositories-places' stamp: 'CamilloBruni 9/18/2012 18:29'!
squeaksource: aProjectName
	self repository: (MCSqueaksourceRepository location: 'http://www.squeaksource.com/' , aProjectName)! !

!Gofer methodsFor: 'private' stamp: 'lr 10/2/2009 10:11'!
execute: anOperationClass
	^ self execute: anOperationClass do: nil! !

!Gofer methodsFor: 'accessing' stamp: 'lr 12/13/2009 17:17'!
allResolved
	"Answer all sorted references within the configured repositories."
	
	| resolved |
	resolved := OrderedCollection new.
	self repositories
		do: [ :repository | resolved addAll: (self allResolvedIn: repository) ].
	^ resolved asSortedCollection asArray! !

!Gofer methodsFor: 'repositories-options' stamp: 'lr 12/13/2009 16:33'!
disablePackageCache
	"Disable the use of the package-cache repository."

	packageCacheRepository := nil! !

!Gofer methodsFor: 'repositories-places' stamp: 'lr 7/10/2009 16:25'!
renggli: aString
	self url: 'http://source.lukas-renggli.ch/' , aString! !

!Gofer methodsFor: 'accessing' stamp: 'ClementBera 7/26/2013 16:45'!
repositories
	"Answer the configured monticello repositories."

	|  result |
	result := OrderedCollection withAll: repositories.
	packageCacheRepository ifNotNil: [ result addFirst: packageCacheRepository ].
	^ result asArray! !

!Gofer methodsFor: 'operations' stamp: 'lr 8/20/2009 10:15'!
revert
	"Revert the specified packages to the currently loaded version."
	
	^ self execute: GoferRevert! !

!Gofer methodsFor: 'operations' stamp: 'SeanDeNigris 6/13/2014 17:53'!
loadBleedingEdge
	"Load the baseline of the previously specifed configuration."
	
	^ self loadVersion: #bleedingEdge! !

!Gofer methodsFor: 'operations' stamp: 'lr 11/30/2009 14:17'!
load
	"Load the specified packages into the image."
	
	^ self execute: GoferLoad! !

!Gofer methodsFor: 'private' stamp: 'lr 12/13/2009 16:28'!
basicReferencesIn: aRepository
	^ [ aRepository goferReferences asSortedCollection asArray ] 
		on: GoferRepositoryError
		do: errorBlock! !

!Gofer methodsFor: 'operations' stamp: 'lr 11/10/2009 10:07'!
unload
	"Unload the specified packages."
	
	^ self execute: GoferUnload! !

!Gofer methodsFor: 'deprecated' stamp: 'StephaneDucasse 4/25/2012 16:18'!
addPackage: aPackage

	self package: aPackage! !

!Gofer methodsFor: 'private' stamp: 'ClementBera 7/26/2013 16:44'!
execute: anOperationClass do: aBlock
	| operation |
	operation := anOperationClass on: self copy.
	aBlock ifNotNil: [ aBlock value: operation ].
	^ operation execute! !

!Gofer methodsFor: 'operations' stamp: 'lr 12/3/2009 21:06'!
fetch
	"Download versions from remote repositories into the local cache."

	^ self execute: GoferFetch! !

!Gofer methodsFor: 'operations' stamp: 'lr 11/10/2009 10:08'!
commit: aString
	"Commit the modified packages with the given commit message."

	^ self execute: GoferCommit do: [ :operation | operation message: aString ]! !

!Gofer methodsFor: 'operations' stamp: 'lr 12/14/2009 23:51'!
localChanges
	"Answer the changes between the base version and the working copy."
	
	^ self execute: GoferLocalChanges! !

!Gofer methodsFor: 'accessing' stamp: 'lr 12/13/2009 17:18'!
references
	"Answer the configured references."

	^ Array withAll: references! !

!Gofer methodsFor: 'references' stamp: 'CamilloBruni 9/18/2012 18:35'!
configuration
	"Add a default Configuration package by using the repository name.
	Assumes that there has been at least one repository set"
	^ self configurationOf: self repositories last project capitalized.! !

!Gofer methodsFor: 'operations' stamp: 'lr 12/12/2009 12:49'!
remoteChanges
	"Display the changes between the working copy and the remote changes."
	
	^ self execute: GoferRemoteChanges! !

!Gofer methodsFor: 'repositories-places' stamp: 'lr 7/10/2009 16:28'!
squeakfoundation: aString
	self url: 'http://source.squeakfoundation.org/' , aString! !

!Gofer methodsFor: 'repositories' stamp: 'lr 12/9/2009 22:17'!
url: anUrlString
	"Add anUrlString as a repository for the following package operations."

	self url: anUrlString username: String new password: String new! !

!Gofer methodsFor: 'repositories-places' stamp: 'lr 2/7/2010 15:11'!
blueplane: aString
	self url: 'http://squeaksource.blueplane.jp/' , aString! !

!Gofer methodsFor: 'repositories' stamp: 'lr 1/11/2010 10:34'!
repository: aRepository
	"Add aRepository to the repository configuration. If there is already a repository defined in the global configuration with that URL take this one instead."
	
	| repository |
	repository := MCRepositoryGroup default repositories
		detect: [ :each | each = aRepository ]
		ifNone: [ aRepository ].
	repositories addLast: repository! !

!Gofer methodsFor: 'repositories-options' stamp: 'lr 12/13/2009 16:32'!
enableRepositoryErrors
	"Throw an exception when repositories are not available."

	errorBlock := [ :error | error pass ]! !

!Gofer methodsFor: 'operations' stamp: 'lr 11/10/2009 10:08'!
commit
	"Commit the modified packages."

	^ self execute: GoferCommit! !

!Gofer methodsFor: 'references' stamp: 'lr 4/3/2010 09:56'!
package: aString constraint: aOneArgumentBlock
	"Add the package aString to the receiver, but constraint the resulting versions further with aOneArgumentBlock. For details on the package, see #package:. The following example defines various constraints: 
	
		aGofer package: 'Magritte-Seaside' constraint: [ :version |
			version author = 'lr'
				and: [ version branch = 'trial'
				and: [ version versionNumber > 120 ] ] ]"

	references addLast: (GoferConstraintReference name: aString constraint: aOneArgumentBlock)! !

!Gofer methodsFor: 'repositories-places' stamp: 'dkh 10/16/2009 10:04'!
gemsource: aString
	self url: 'http://seaside.gemstone.com/ss/' , aString! !

!Gofer methodsFor: 'repositories' stamp: 'SeanDeNigris 8/26/2012 15:44'!
url: urlString username: username password: passwordString
	"Add urlString as a repository for the following package operations."

	| repository |
	repository := urlString asUrl mcRepositoryAsUser: username withPassword: passwordString.
	self repository: repository.! !

!Gofer class methodsFor: 'private' stamp: 'BernardoContreras 9/10/2014 20:40'!
upgrade
	"Update Gofer to the latest version using itself."
	
	[ self gofer load ]
		on: Error
		do: [ :err | err retry ].
	self new unload
		unregister: (MCWorkingCopy 
			forPackage: (MCPackage named: 'Gofer')).
	self gofer recompile; cleanup! !

!Gofer class methodsFor: 'private' stamp: 'lr 1/5/2010 10:45'!
gofer
	"Create a Gofer instance of Gofer."

	^ self new
		renggli: 'gofer';
		package: 'Gofer-Core';
		package: 'Gofer-Tests';
		yourself! !

!Gofer class methodsFor: 'instance creation' stamp: 'lr 11/6/2009 10:50'!
it
	^ self new! !

!GoferApiTest commentStamp: 'TorstenBergmann 2/5/2014 09:36'!
SUnit tests for Gofer API!
!GoferApiTest methodsFor: 'testing-repositories-places' stamp: 'lr 12/13/2009 13:36'!
testSqueaksource
	gofer squeaksource: 'Seaside29'.
	self assert: gofer repositories: #('http://www.squeaksource.com/Seaside29')! !

!GoferApiTest methodsFor: 'testing-repositories' stamp: 'lr 12/13/2009 16:51'!
testHttpRepository
	gofer url: 'http://source.lukas-renggli.ch/pier' username: 'foo' password: 'bar'.
	self assert: gofer repositories: #('http://source.lukas-renggli.ch/pier').
	self assert: (gofer repositories first isKindOf: MCHttpRepository)! !

!GoferApiTest methodsFor: 'testing' stamp: 'SeanDeNigris 7/17/2012 15:48'!
testInitialRepositories
	gofer := Gofer new.
	self assert: (gofer repositories size = 1).
	self assert: (gofer repositories first isKindOf: MCCacheRepository uniqueInstance class)! !

!GoferApiTest methodsFor: 'testing-repositories-options' stamp: 'CamilloBruni 8/31/2013 20:23'!
testRepositoryErrors
	gofer
		url: 'http://pharo-project.org/page-that-will-never-ever-exist';
		repository: self monticelloRepository.
	gofer package: 'GoferFoo'.
	gofer enableRepositoryErrors.
	self should: [ gofer resolved ] raise: GoferRepositoryError.
	gofer disableRepositoryErrors.
	gofer resolved! !

!GoferApiTest methodsFor: 'testing-repositories-places' stamp: 'lr 12/13/2009 13:36'!
testRenggli
	gofer renggli: 'pier'.
	self assert: gofer repositories: #('http://source.lukas-renggli.ch/pier')! !

!GoferApiTest methodsFor: 'testing' stamp: 'lr 12/13/2009 17:40'!
testInitialReferences
	self assert: gofer references isEmpty! !

!GoferApiTest methodsFor: 'testing-repositories-options' stamp: 'SeanDeNigris 7/17/2012 15:49'!
testPackageCache
	gofer squeaksource: 'r1'; squeaksource: 'r2'.
	
	gofer enablePackageCache.
	self assert: gofer repositories: (Array with: MCCacheRepository uniqueInstance description) , #('http://www.squeaksource.com/r1' 'http://www.squeaksource.com/r2').
	
	gofer disablePackageCache.
	self assert: gofer repositories: #('http://www.squeaksource.com/r1' 'http://www.squeaksource.com/r2')! !

!GoferApiTest methodsFor: 'testing-repositories' stamp: 'CamilloBruni 5/4/2012 18:57'!
testDirectoryRepository
	gofer directory: FileSystem disk workingDirectory fullName.
	self assert: gofer repositories: (Array with: FileSystem disk workingDirectory fullName).
	self assert: (gofer repositories first isKindOf: MCDirectoryRepository)! !

!GoferApiTest methodsFor: 'testing-repositories' stamp: 'CamilloBruni 5/4/2012 19:00'!
testSubDirectoryRepository
	Smalltalk globals
		at: #MCSubDirectoryRepository
		ifPresent: [ :subDirectoryRepositoryClass | |path|
			path := (FileSystem disk workingDirectory / '*') fullName.
			gofer directory: path.
			self assert: gofer repositories: (Array with: path).
			self assert: (gofer repositories first isKindOf: subDirectoryRepositoryClass) ]! !

!GoferApiTest methodsFor: 'testing-repositories-places' stamp: 'lr 2/7/2010 15:14'!
testBlueplane
	gofer blueplane: 'SIXX'.
	self assert: gofer repositories: #('http://squeaksource.blueplane.jp/SIXX')! !

!GoferApiTest methodsFor: 'testing-references' stamp: 'lr 12/13/2009 17:27'!
testVersionReference
	gofer 
		repository: self monticelloRepository; 
		version: 'GoferFoo-lr.2'.
	self assert: (gofer resolved size = 1).
	self assert: (gofer resolved first isKindOf: GoferResolvedReference).
	self assert: (gofer resolved first packageName = 'GoferFoo').
	self assert: (gofer resolved first author = 'lr').
	self assert: (gofer resolved first branch isEmpty).
	self assert: (gofer resolved first versionNumber = 2).
	self assert: (gofer resolved first repository = self monticelloRepository)! !

!GoferApiTest methodsFor: 'testing-repositories-places' stamp: 'CamilloBruni 10/21/2012 12:47'!
testSmalltalkhub
	gofer smalltalkhubUser: 'dh83' project: 'ci'.
	self assert: gofer repositories: #('http://smalltalkhub.com/mc/dh83/ci/main/')! !

!GoferApiTest methodsFor: 'testing-repositories-places' stamp: 'lr 12/13/2009 13:36'!
testImpara
	gofer impara: 'Tweak'.
	self assert: gofer repositories: #('http://source.impara.de/Tweak')! !

!GoferApiTest methodsFor: 'testing-repositories' stamp: 'TestRunner 12/13/2009 16:51'!
testCustomRepository
	gofer repository: self monticelloRepository.
	self assert: gofer repositories: (Array with: self monticelloRepository description).
	self assert: (gofer repositories first = self monticelloRepository)! !

!GoferApiTest methodsFor: 'testing-repositories' stamp: 'SeanDeNigris 8/27/2012 10:22'!
testHttpRepositoryUseStoredCredentials

	| exampleServer registry |
	[
		exampleServer := 'http://my.cool.repo.server.com/'.
		registry := MCServerRegistry uniqueInstance.
		registry on: exampleServer beUser: 'myusername' withPassword: 'mypassword'.
		
		gofer url: exampleServer.
		
		self assert: gofer repositories: { exampleServer }.
		self assert: gofer repositories first user equals: 'myusername'
	] ensure: [
		registry removeCredentialsFor: exampleServer ].
	! !

!GoferApiTest methodsFor: 'testing-repositories-places' stamp: 'lr 12/13/2009 13:36'!
testGemsource
	gofer gemsource: 'Seaside29'.
	self assert: gofer repositories: #('http://seaside.gemstone.com/ss/Seaside29')! !

!GoferApiTest methodsFor: 'testing-repositories-places' stamp: 'lr 12/13/2009 13:36'!
testWiresong
	gofer wiresong: 'ob'.
	self assert: gofer repositories: #('http://source.wiresong.ca/ob')! !

!GoferApiTest methodsFor: 'utilities' stamp: 'CamilloBruni 10/21/2012 12:47'!
assert: aGofer repositories: anArray
	self assert: aGofer repositories size = anArray size.
	aGofer repositories with: anArray
		do: [ :first :second | 
			self assert: first description equals: second ]! !

!GoferApiTest methodsFor: 'asserting' stamp: 'SeanDeNigris 8/27/2012 11:20'!
assert: registry on: serverUrlString hasUser: nameString withPassword: passwordString 

	registry repositoryAt: serverUrlString credentialsDo: [ :user :password |
		self assert: nameString equals: user.
		self assert: passwordString equals: password ].! !

!GoferApiTest methodsFor: 'testing-references' stamp: 'lr 12/13/2009 17:27'!
testPackageReference
	gofer 
		repository: self monticelloRepository;
		package: 'GoferFoo'.
	self assert: (gofer resolved size = 1).
	self assert: (gofer resolved first isKindOf: GoferResolvedReference).
	self assert: (gofer resolved first packageName = 'GoferFoo').
	self assert: (gofer resolved first author = 'lr').
	self assert: (gofer resolved first branch isEmpty).
	self assert: (gofer resolved first versionNumber = 4).
	self assert: (gofer resolved first repository = self monticelloRepository)! !

!GoferApiTest methodsFor: 'testing-repositories' stamp: 'SeanDeNigris 8/27/2012 11:19'!
testHttpRepositoryOverrideStoredCredentials

	| exampleServer registry |
	[
		exampleServer := 'http://my.cool.repo.server.com/'.
		registry := MCServerRegistry uniqueInstance.
		registry on: exampleServer beUser: 'myusername' withPassword: 'mypassword'.
		
		gofer url: exampleServer username: 'foo' password: 'bar'..
		
		self assert: gofer repositories: { exampleServer }.
		self assert: gofer repositories first user equals: 'foo'.
		self assert: registry on: exampleServer hasUser: 'myusername' withPassword: 'mypassword'.
	] ensure: [
		registry removeCredentialsFor: exampleServer ].
	! !

!GoferApiTest methodsFor: 'testing-repositories-places' stamp: 'lr 12/13/2009 13:36'!
testSqueakfoundation
	gofer squeakfoundation: '39a'.
	self assert: gofer repositories: #('http://source.squeakfoundation.org/39a')! !

!GoferApiTest methodsFor: 'testing-references' stamp: 'lr 12/13/2009 17:25'!
testConstraintReference
	gofer 
		repository: self monticelloRepository; 
		package: 'GoferBar' constraint: [ :ref | ref branch = 'branch' ].
	self assert: (gofer resolved size = 1).
	self assert: (gofer resolved first isKindOf: GoferResolvedReference).
	self assert: (gofer resolved first packageName = 'GoferBar').
	self assert: (gofer resolved first author = 'lr').
	self assert: (gofer resolved first branch = 'branch').
	self assert: (gofer resolved first versionNumber = 2).
	self assert: (gofer resolved first repository = self monticelloRepository)! !

!GoferBrowseLocalChanges commentStamp: 'TorstenBergmann 2/5/2014 09:33'!
Browse local changes!
!GoferBrowseLocalChanges methodsFor: 'running' stamp: 'lr 12/14/2009 23:50'!
execute
	^ super execute browse! !

!GoferBrowseRemoteChanges commentStamp: 'TorstenBergmann 2/5/2014 09:33'!
Browse remote changes!
!GoferBrowseRemoteChanges methodsFor: 'running' stamp: 'lr 12/14/2009 23:50'!
execute
	^ super execute browse! !

!GoferChanges commentStamp: 'TorstenBergmann 2/5/2014 09:33'!
Handling changes!
!GoferChanges methodsFor: 'queries' stamp: 'lr 12/12/2009 13:06'!
patchsetOf: aReference
	"Answer the source snapshot of aReference."
	
	| source target |
	source := self sourceSnapshotOf: aReference.
	target := self targetSnapshotOf: aReference.
	^ target patchRelativeToBase: source! !

!GoferChanges methodsFor: 'private' stamp: 'lr 8/19/2009 14:02'!
defaultModel
	^ MCPatch operations: OrderedCollection new! !

!GoferChanges methodsFor: 'private' stamp: 'lr 12/12/2009 12:56'!
addReference: aReference
	super addReference: aReference.
	self model operations 
		addAll: (self patchsetOf: aReference) operations! !

!GoferChanges methodsFor: 'queries' stamp: 'lr 12/12/2009 12:59'!
targetSnapshotOf: aReference
	"Answer the source snapshot of aReference."
	
	self subclassResponsibility! !

!GoferChanges methodsFor: 'queries' stamp: 'lr 12/12/2009 13:00'!
sourceSnapshotOf: aReference
	"Answer the source snapshot of aReference."
	
	self subclassResponsibility! !

!GoferChanges methodsFor: 'running' stamp: 'lr 12/14/2009 23:50'!
execute
	^ self model! !

!GoferCleanup commentStamp: 'TorstenBergmann 2/5/2014 09:34'!
Cleanup working copies!
!GoferCleanup methodsFor: 'cleaning' stamp: 'lr 10/3/2009 11:37'!
cleanup: aWorkingCopy
	self cleanupCategories: aWorkingCopy.
	self cleanupProtocols: aWorkingCopy! !

!GoferCleanup methodsFor: 'cleaning' stamp: 'EstebanLorenzano 9/12/2012 13:33'!
cleanupProtocols: aWorkingCopy
	aWorkingCopy packageSet extensionClasses do: [ :class |
		(aWorkingCopy packageSet extensionCategoriesForClass: class) do: [ :category |
			(class organization listAtCategoryNamed: category) isEmpty
				ifTrue: [ class organization removeCategory: category ] ] ].
	aWorkingCopy packageSet classesAndMetaClasses do: [ :class |
		(aWorkingCopy packageSet coreCategoriesForClass: class) do: [ :category |
			(class organization listAtCategoryNamed: category) isEmpty
				ifTrue: [ class organization removeCategory: category ] ] ]! !

!GoferCleanup methodsFor: 'cleaning' stamp: 'EstebanLorenzano 9/12/2012 13:33'!
cleanupCategories: aWorkingCopy
	aWorkingCopy packageSet systemCategories do: [ :category |
		(Smalltalk organization classesInCategory: category) isEmpty
			ifTrue: [ Smalltalk organization removeSystemCategory: category ] ]! !

!GoferCleanup methodsFor: 'running' stamp: 'lr 10/3/2009 11:30'!
execute
	self workingCopies
		do: [ :each | self cleanup: each ]! !

!GoferCommit commentStamp: 'TorstenBergmann 2/5/2014 09:35'!
Commit work!
!GoferCommit methodsFor: 'accessing' stamp: 'lr 10/2/2009 10:12'!
message
	^ message! !

!GoferCommit methodsFor: 'running' stamp: 'lr 12/13/2009 19:20'!
initializeOn: aGofer
	super initializeOn: aGofer disablePackageCache! !

!GoferCommit methodsFor: 'running' stamp: 'EstebanLorenzano 9/8/2013 10:58'!
execute: aWorkingCopy
	| repositories version |
	repositories := self gofer repositories
		reject: [ :repository | (aWorkingCopy changesRelativeToRepository: repository) isEmpty ].
	repositories isEmpty
		ifTrue: [ ^ self ].
	version := [ aWorkingCopy newVersionIn: (MCRepositoryGroup withRepositories: repositories) ]
		on: MCVersionNameAndMessageRequest
		do: [ :notifcation |
			self message ifNil: [ message := notifcation outer last ].
			notifcation resume: (Array with: notifcation suggestedName with: self message) ].
	self gofer repositories
		do: [ :repository | repository storeVersion: version ]! !

!GoferCommit methodsFor: 'accessing' stamp: 'lr 10/2/2009 10:12'!
message: aString
	message := aString! !

!GoferCommit methodsFor: 'running' stamp: 'lr 12/13/2009 18:44'!
execute
	self workingCopies 
		do: [ :each | self execute: each ]! !

!GoferConfigurationReference commentStamp: '<historical>'!
A GoferPackageReference refers to the latest version of a Monticello package representing a Metacello Configuration.!
!GoferConfigurationReference methodsFor: 'accessing' stamp: 'CamilloBruni 9/18/2012 19:06'!
configurationClass
	^ Smalltalk globals at: self configurationName asSymbol! !

!GoferConfigurationReference methodsFor: 'accessing' stamp: 'CamilloBruni 9/18/2012 19:05'!
project
	^ self configurationClass project! !

!GoferConfigurationReference methodsFor: 'accessing' stamp: 'CamilloBruni 9/18/2012 19:06'!
configurationName
	^ 'ConfigurationOf', name! !

!GoferConfigurationReference methodsFor: 'accessing' stamp: 'CamilloBruni 10/21/2012 13:01'!
name
	^ self configurationName ! !

!GoferConfigurationReference methodsFor: 'accessing' stamp: 'CamilloBruni 9/18/2012 19:06'!
packageName
	^ self configurationName! !

!GoferConfigurationReference methodsFor: 'testing' stamp: 'CamilloBruni 9/18/2012 19:05'!
isConfigurationReference
	^ true! !

!GoferConstraintReference commentStamp: 'lr 1/30/2010 14:37'!
A GoferPackageReference refers to the latest version of a Monticello package satisfying an additional constraint.!
!GoferConstraintReference methodsFor: 'initialization' stamp: 'TestRunner 12/12/2009 00:18'!
initializeName: aString constraint: aBlock
	self initializeName: aString.
	constraintBlock := aBlock! !

!GoferConstraintReference methodsFor: 'private' stamp: 'lr 1/21/2010 00:17'!
matches: aResolvedReference
	^ (super matches: aResolvedReference) and: [ constraintBlock value: aResolvedReference ]! !

!GoferConstraintReference class methodsFor: 'instance creation' stamp: 'lr 12/9/2009 22:44'!
name: aString constraint: aBlock
	^ self basicNew initializeName: aString constraint: aBlock! !

!GoferFetch commentStamp: 'TorstenBergmann 2/5/2014 09:31'!
Fetch packages using Gofer!
!GoferFetch methodsFor: 'private' stamp: 'lr 11/30/2009 13:46'!
defaultModel
	^ Set new! !

!GoferFetch methodsFor: 'initialization' stamp: 'TestRunner 12/13/2009 19:56'!
initializeOn: aGofer
	super initializeOn: aGofer.
	self gofer references do: [ :reference |
		self gofer allResolved do: [ :resolved |
			((reference matches: resolved) and: [ (cacheReferences includes: resolved) not ])
				ifTrue: [ self model add: resolved ] ] ]! !

!GoferFetch methodsFor: 'running' stamp: 'lr 12/13/2009 17:22'!
execute
	self model
		do: [ :reference | self cacheRepository storeVersion: reference version ]
		displayingProgress: 'Fetching Versions'! !

!GoferLoad commentStamp: 'TorstenBergmann 2/5/2014 09:31'!
Loading for specific packages using Gofer!
!GoferLoad methodsFor: 'accessing' stamp: 'StephaneDucasse 12/30/2012 20:29'!
versions
	^ model versions! !

!GoferLoad methodsFor: 'private' stamp: 'lr 12/18/2009 12:55'!
updateCategories
	"This method makes sure that the categories are ordered in load-order and as specified in the packages."

	| categories |
	categories := OrderedCollection new.
	self versions do: [ :version |
		version snapshot definitions do: [ :definition |
			definition isOrganizationDefinition ifTrue: [
				definition categories do: [ :category |
					(categories includes: category)
						ifFalse: [ categories addLast: category ] ] ] ] ].
	(MCOrganizationDefinition categories: categories)
		postloadOver: nil! !

!GoferLoad methodsFor: 'running' stamp: 'StephaneDucasse 12/30/2012 20:28'!
execute
	self model hasVersions
		ifTrue: [ self model load ].
	self updateRepositories.
	self updateCategories! !

!GoferLoad methodsFor: 'private' stamp: 'lr 12/18/2009 12:55'!
updateRepositories
	"This code makes sure that all packages have a repository assigned, including the dependencies."

	self versions do: [ :version |
		gofer repositories do: [ :repository | 
			version workingCopy repositoryGroup
				addRepository: repository ] ]! !

!GoferLoad methodsFor: 'private' stamp: 'lr 9/3/2009 11:00'!
defaultModel
	^ MCVersionLoader new! !

!GoferLoad methodsFor: 'initialization' stamp: 'TestRunner 12/13/2009 14:49'!
initializeOn: aGofer
	super initializeOn: aGofer.
	aGofer resolved
		do: [ :each | self addResolved: each ]
		displayingProgress: 'Loading Versions'! !

!GoferLoad methodsFor: 'private' stamp: 'BernardoContreras 9/10/2014 20:41'!
addResolved: aResolvedReference
	| version |
	version := aResolvedReference version.
	(self versions includes: version)
		ifTrue: [ ^ self ].
	self versions addLast: version.
	version dependencies do: [ :dependency |
		self addResolved: ((GoferVersionReference
			name: dependency versionInfo name) resolveWith: self gofer) ]! !

!GoferLocalChanges commentStamp: 'TorstenBergmann 2/5/2014 09:33'!
Handling local changes!
!GoferLocalChanges methodsFor: 'queries' stamp: 'lr 12/12/2009 13:01'!
targetSnapshotOf: aReference
	^ aReference workingCopy package snapshot! !

!GoferLocalChanges methodsFor: 'queries' stamp: 'TestRunner 12/13/2009 18:02'!
sourceSnapshotOf: aReference
	| ancestors reference |
	ancestors := aReference workingCopy ancestry ancestors.
	ancestors isEmpty ifTrue: [ ^ MCSnapshot new ].
	reference := GoferVersionReference name: ancestors first name.
	^ (reference resolveWith: self gofer) version snapshot! !

!GoferMerge commentStamp: 'TorstenBergmann 2/5/2014 09:36'!
Merge work!
!GoferMerge methodsFor: 'private' stamp: 'lr 8/19/2009 14:01'!
defaultModel
	^ MCVersionMerger new! !

!GoferMerge methodsFor: 'running' stamp: 'CamilloBruni 9/15/2013 17:50'!
execute
	[ self model merge ]
		on: MCMergeResolutionRequest
		do: [ :request |  request autoMerge ].
	self gofer cleanup! !

!GoferMetacelloLoad commentStamp: '<historical>'!
I am a Gofer Operation that extracts a metacello configuration from the current repository and loads the given version.!
!GoferMetacelloLoad methodsFor: 'accessing' stamp: 'CamilloBruni 9/12/2013 11:04'!
configurationReference
	^ gofer references
		detect: [ :ref | ref isConfigurationReference ]
		ifNone: [ 
			gofer configuration.
			^ self configurationReference ].! !

!GoferMetacelloLoad methodsFor: 'accessing' stamp: 'CamilloBruni 9/12/2013 11:09'!
metacelloVersion
	| configuration |
	
	configuration := self configuration project.
	self version 
		ifNil: [ ^ configuration stableVersion ].
		
	"Now let's wrap Metcaello's strange behaviors of distinguishing strings and symbols"
	[ 
		"First we try to load the latest version for a given version string"
		^ (configuration latestVersion: self version)
			ifNil: [ 
				"If that doesn't work we use the default version lookup to find a version with the given name"
				configuration version: self version ] 
	] on: MetacelloVersionDoesNotExistError do: [ :error |
			^ self version = 'last'
				ifTrue: [
					"manual fallback since there is no symbolic name for lastVersion"
					configuration lastVersion ]
				ifFalse: [ 
					"symbols and strings are not equal in Meteacello..."
					configuration version: self version asSymbol ]].! !

!GoferMetacelloLoad methodsFor: 'accessing' stamp: 'CamilloBruni 9/12/2013 11:05'!
configuration
	^ self configurationReference project! !

!GoferMetacelloLoad methodsFor: 'running' stamp: 'CamilloBruni 9/18/2012 18:53'!
execute
	super execute.
	self loadConfiguration.! !

!GoferMetacelloLoad methodsFor: 'running' stamp: 'CamilloBruni 9/12/2013 10:58'!
loadConfiguration
	self metacelloVersion load! !

!GoferMetacelloLoad methodsFor: 'accessing' stamp: 'CamilloBruni 9/18/2012 18:54'!
version
	^ version! !

!GoferMetacelloLoad methodsFor: 'accessing' stamp: 'CamilloBruni 9/18/2012 19:13'!
version: aVersionStringOrSymbol 
	"A version identifiery see MetacelloProject>>#version:"
	version := aVersionStringOrSymbol! !

!GoferOperation commentStamp: 'TorstenBergmann 2/5/2014 09:30'!
Common superclass of Gofer operations!
!GoferOperation methodsFor: 'accessing' stamp: 'lr 10/3/2009 11:38'!
gofer
	"Answer the Gofer instance that triggered this operation."

	^ gofer! !

!GoferOperation methodsFor: 'initialization' stamp: 'lr 8/19/2009 14:01'!
initialize
	model := self defaultModel! !

!GoferOperation methodsFor: 'accessing' stamp: 'lr 8/20/2009 10:13'!
model
	"Answer the Monticello model of this operation."
	
	^ model! !

!GoferOperation methodsFor: 'private' stamp: 'lr 8/19/2009 14:01'!
defaultModel
	^ nil! !

!GoferOperation methodsFor: 'initialization' stamp: 'TestRunner 12/12/2009 11:09'!
initializeOn: aGofer
	gofer := aGofer.
	self initialize! !

!GoferOperation methodsFor: 'running' stamp: 'lr 8/17/2009 14:40'!
execute
	"Execute the receiving action."

	self subclassResponsibility! !

!GoferOperation class methodsFor: 'instance creation' stamp: 'lr 8/20/2009 12:01'!
on: aGofer
	^ self basicNew initializeOn: aGofer! !

!GoferOperation class methodsFor: 'instance creation' stamp: 'TestRunner 12/12/2009 11:09'!
new
	self error: 'Gofer operations can only work on Gofer instances.'! !

!GoferOperationTest commentStamp: 'TorstenBergmann 2/5/2014 09:36'!
SUnit tests for Gofer operations!
!GoferOperationTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testReinitialize
	| class |
	gofer
		package: 'GoferFoo';
		load.
	class := Smalltalk classNamed: #GoferFoo.
	class
		addClassVarNamed: #InstanceSide;
		addClassVarNamed: #ClassSide.
	class compile: 'initialize InstanceSide := true'.
	class class compile: 'initialize ClassSide := true'.
	self assert: (class classPool at: #InstanceSide) isNil.
	self assert: (class classPool at: #ClassSide) isNil.
	gofer reinitialize.
	self assert: (class classPool at: #InstanceSide) isNil.
	self assert: (class classPool at: #ClassSide)! !

!GoferOperationTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testLocalChanges
	| changes |
	gofer
		package: 'GoferBar';
		load.
	(Smalltalk globals classNamed: #GoferBar) compile: 'foo'.
	changes := gofer localChanges.
	self assert: changes operations size = 1! !

!GoferOperationTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testMerge
	| initial |
	initial := gofer copy.
	initial
		version: 'GoferBar-jf.1';
		load.
	gofer
		package: 'GoferBar';
		load.
	(Smalltalk globals classNamed: #GoferBar) compile: 'foo'.
	[ gofer merge ]
		on: ProvideAnswerNotification
		do: [ :e | e resume: true ].
	self assert: (self hasClass: #GoferBar selector: #foo)! !

!GoferOperationTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testPush
	| repository |
	gofer := Gofer new.
	gofer disablePackageCache.
	gofer repository: (repository := MCDictionaryRepository new).
	gofer package: 'GoferFoo'.
	gofer push! !

!GoferOperationTest methodsFor: 'running' stamp: 'CamilloBruni 10/21/2012 12:44'!
tearDown
	(self hasPackage: 'GoferFoo')
		ifTrue: [ Gofer new package: 'GoferFoo'; unload ].
	(self hasPackage: 'GoferBar')
		ifTrue: [ Gofer new package: 'GoferBar'; unload ].
	(self hasPackage: 'ConfigurationOfGoferFoo')
		ifTrue: [ Gofer new package: 'ConfigurationOfGoferFoo'; unload ]! !

!GoferOperationTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testCleanup
	| class |
	gofer
		package: 'GoferFoo';
		load.
	class := Smalltalk globals classNamed: #GoferFoo.
	Smalltalk globals organization addCategory: #'GoferFoo-Empty'.
	class organization addCategory: #empty.
	class class organization addCategory: #empty.
	gofer cleanup.
	self deny: (Smalltalk organization categories includes: #'GoferFoo-Empty').
	self deny: (class organization categories includes: #'GoferFoo-Empty').
	self deny: (class class organization categories includes: #'GoferFoo-Empty')! !

!GoferOperationTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testLoad
	gofer version: 'GoferFoo-lr.1'.
	gofer load.
	self assert: (self hasVersion: 'GoferFoo-lr.1').
	self assert: (self hasClass: #GoferFoo)! !

!GoferOperationTest methodsFor: 'running' stamp: 'EstebanLorenzano 9/12/2012 16:44'!
runCase
	^ "SystemAnnouncer uniqueInstance suspendAllWhile: [ "super runCase "]"! !

!GoferOperationTest methodsFor: 'utilities' stamp: 'lr 3/14/2010 21:13'!
hasClass: aSymbol selector: aSelector
	^ (Smalltalk globals classNamed: aSymbol) includesSelector: aSelector! !

!GoferOperationTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testRecompile
	gofer package: 'Gofer-Core'.
	gofer recompile! !

!GoferOperationTest methodsFor: 'utilities' stamp: 'StephaneDucasse 6/2/2012 20:31'!
allManagers

	^ MCWorkingCopy allManagers 
	! !

!GoferOperationTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testRemoteChanges
	| changes |
	gofer
		package: 'GoferBar';
		load.
	(Smalltalk globals classNamed: #GoferBar) compile: 'foo'.
	changes := gofer remoteChanges.
	self assert: changes operations size = 1! !

!GoferOperationTest methodsFor: 'running' stamp: 'lr 12/13/2009 17:49'!
setUp
	super setUp.
	gofer repository: self monticelloRepository! !

!GoferOperationTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testUpdate
	| initial |
	initial := gofer copy.
	initial
		version: 'GoferFoo-lr.1';
		load.
	gofer package: 'GoferFoo'.
	gofer update.
	self assert: (self hasVersion: 'GoferFoo-lr.4')! !

!GoferOperationTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testCommit
	| repository |
	repository := MCDictionaryRepository new.
	gofer
		package: 'GoferFoo';
		load.
	gofer := Gofer new.
	gofer disablePackageCache.
	gofer repository: repository.
	gofer package: 'GoferFoo'.
	gofer commit: 'A test commit'.
	self assert: repository allVersionInfos size = 1! !

!GoferOperationTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testUnload
	gofer
		package: 'GoferFoo';
		load.
	gofer unload.
	self deny: (self hasPackage: 'GoferFoo').
	self deny: (self hasClass: #GoferFoo)! !

!GoferOperationTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testRevert
	gofer
		package: 'GoferFoo';
		package: 'GoferBar';
		load.
	(Smalltalk globals classNamed: #GoferBar) category: 'GoferFoo'.
	gofer revert.
	self assert: (Smalltalk globals classNamed: #GoferFoo) category asSymbol = #GoferFoo.
	self assert: (Smalltalk globals classNamed: #GoferBar) category asSymbol = #GoferBar! !

!GoferOperationTest methodsFor: 'utilities' stamp: 'lr 3/14/2010 21:13'!
hasClass: aSymbol
	^ Smalltalk globals includesKey: aSymbol! !

!GoferOperationTest methodsFor: 'utilities' stamp: 'GabrielOmarCotelli 12/3/2013 17:21'!
hasVersion: aString
	^ self allManagers anySatisfy: [ :version | version ancestry ancestorString = aString ]! !

!GoferOperationTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testFetch
	gofer package: 'GoferFoo'.
	gofer fetch! !

!GoferOperationTest methodsFor: 'utilities' stamp: 'GabrielOmarCotelli 12/3/2013 17:20'!
hasPackage: aString
	^ self allManagers anySatisfy: [ :package | package packageName = aString ]! !

!GoferPackageReference commentStamp: 'lr 12/9/2009 22:47'!
A GoferPackageReference refers to the latest version of a Monticello package.!
!GoferPackageReference methodsFor: 'private' stamp: 'lr 1/21/2010 00:16'!
matches: aResolvedReference
	^ self packageName = aResolvedReference packageName! !

!GoferPackageReference methodsFor: 'accessing' stamp: 'lr 12/13/2009 17:12'!
packageName
	^ name! !

!GoferPackageReference methodsFor: '*metacello-mc' stamp: 'dkh 6/30/2012 07:52'!
metacelloPackageNameWithBranch
    "answer array with package name and package name with branch name .. no branch name"

    ^ {(self packageName).
    (self packageName)}! !

!GoferPush commentStamp: 'TorstenBergmann 2/5/2014 09:32'!
Push a version!
!GoferPush methodsFor: 'private' stamp: 'lr 11/30/2009 13:46'!
defaultModel
	^ OrderedCollection new! !

!GoferPush methodsFor: 'initialization' stamp: 'TestRunner 12/13/2009 20:08'!
initializeOn: aGofer
	super initializeOn: aGofer.
	self gofer references do: [ :reference |
		cacheReferences do: [ :resolved |
			(reference matches: resolved) ifTrue: [
				self gofer repositories do: [ :repository |
					((self gofer allResolvedIn: repository) includes: resolved)
						ifFalse: [ self model add: resolved -> repository ] ] ] ] ]! !

!GoferPush methodsFor: 'running' stamp: 'lr 12/13/2009 17:23'!
execute
	self model 
		do: [ :assocation | assocation value storeVersion: assocation key version ]
		displayingProgress: 'Pushing Versions'! !

!GoferRecompile commentStamp: 'TorstenBergmann 2/5/2014 09:36'!
Recompile!
!GoferRecompile methodsFor: 'running' stamp: 'EstebanLorenzano 9/12/2012 13:33'!
execute: aWorkingCopy
	aWorkingCopy packageSet methods
		do: [ :each | each actualClass recompile: each selector ]! !

!GoferRecompile methodsFor: 'running' stamp: 'lr 12/13/2009 19:12'!
execute
	self workingCopies
		do: [ :each | self execute: each ]! !

!GoferReference commentStamp: 'lr 1/30/2010 14:38'!
A GoferReference is an abstract superclass for various kinds of references to Monticello packages and versions.!
!GoferReference methodsFor: 'querying' stamp: 'lr 12/13/2009 17:20'!
resolveAllWith: aGofer
	"Answer a sorted collection of all resolved references within aGofer."

	^ aGofer allResolved select: [ :each | self matches: each ]! !

!GoferReference methodsFor: 'comparing' stamp: 'lr 12/12/2009 13:33'!
hash
	^ self name hash! !

!GoferReference methodsFor: 'comparing' stamp: 'lr 12/12/2009 13:33'!
= aReference
	^ self class = aReference class and: [ self name = aReference name ]! !

!GoferReference methodsFor: 'querying' stamp: 'CamilloBruni 9/5/2012 17:26'!
workingCopyIfAbsent: aBlock
	"Answer a working copy or throw an error if not present."

	^ MCWorkingCopy allManagers
		detect: [ :each | self packageName = each packageName ]
		ifNone: aBlock! !

!GoferReference methodsFor: 'printing' stamp: 'lr 12/11/2009 22:02'!
printOn: aStream
	super printOn: aStream.
	aStream nextPutAll: ' name: '; print: self name! !

!GoferReference methodsFor: 'accessing' stamp: 'lr 12/13/2009 17:09'!
packageName
	"Answer the package name."
	
	self subclassResponsibility! !

!GoferReference methodsFor: 'initialization' stamp: 'lr 12/9/2009 22:57'!
initializeName: aString
	name := aString! !

!GoferReference methodsFor: 'querying' stamp: 'CamilloBruni 9/5/2012 17:26'!
workingCopy
	"Answer a working copy or throw an error if not present."

	^ self workingCopyIfAbsent: [ self error: 'Working copy for ' , self name , ' not found' ]! !

!GoferReference methodsFor: 'private' stamp: 'lr 1/21/2010 00:16'!
matches: aResolvedReference
	"Answer true if the receiver matches aResolvedReference."

	self subclassResponsibility! !

!GoferReference methodsFor: 'querying' stamp: 'lr 12/13/2009 17:20'!
resolveWith: aGofer
	"Answer a single resolved reference with aGofer configuration, throw an error if the version can't be found.'"

	| references |
	references := self resolveAllWith: aGofer.
	^ references isEmpty
		ifTrue: [ self error: 'Unable to resolve ' , self name ]
		ifFalse: [ references last ]! !

!GoferReference methodsFor: 'accessing' stamp: 'lr 12/11/2009 22:02'!
name
	"Answer the name of this reference."
	
	^ name! !

!GoferReference methodsFor: 'testing' stamp: 'CamilloBruni 9/18/2012 19:05'!
isConfigurationReference
	^ false! !

!GoferReference class methodsFor: 'instance creation' stamp: 'lr 12/9/2009 22:42'!
name: aString
	^ self basicNew initializeName: aString! !

!GoferReference class methodsFor: 'instance creation' stamp: 'lr 12/9/2009 22:42'!
new
	self error: 'Use #name: to initialize the receiver.'! !

!GoferReferenceTest commentStamp: 'TorstenBergmann 2/5/2014 09:37'!
SUnit tests for GoferReference and subclasses!
!GoferReferenceTest methodsFor: 'testing' stamp: 'lr 2/6/2011 18:03'!
testBranchAfterAuthorIsNotABranch
	| queryReference |
	queryReference := GoferVersionReference name: 'Seaside-Core-jf.configcleanup.3'.
	self assert: queryReference packageName = 'Seaside-Core'.
	self assert: queryReference author = 'jf.configcleanup'.
	self assert: queryReference branch isEmpty.
	self assert: queryReference versionNumber = 3.
	
	queryReference := GoferVersionReference name: 'Seaside-Core-lr.configcleanup.extraspeedup.69'.
	self assert: queryReference packageName = 'Seaside-Core'.
	self assert: queryReference author = 'lr.configcleanup.extraspeedup'.
	self assert: queryReference branch isEmpty.
	self assert: queryReference versionNumber = 69.

	queryReference := GoferVersionReference name: 'Seaside-Core-lr.configcleanup42.extraspeedup.69'.
	self assert: queryReference packageName = 'Seaside-Core'.
	self assert: queryReference author = 'lr.configcleanup42.extraspeedup'.
	self assert: queryReference branch isEmpty.
	self assert: queryReference versionNumber = 69
! !

!GoferReferenceTest methodsFor: 'testing' stamp: 'lr 2/6/2011 17:47'!
testVersionShouldParseComplexName
	| queryReference |
	queryReference := GoferVersionReference name: 'Seaside2.8b5'.
	self assert: queryReference packageName = 'Seaside2'.
	self assert: queryReference author isEmpty.
	self assert: queryReference branch = '8b5'.
	self assert: queryReference versionNumber = 0.
	
	queryReference := GoferVersionReference name: 'Seaside2.8b5-avi.1'.
	self assert: queryReference packageName = 'Seaside2'.
	self assert: queryReference author = 'avi'.
	self assert: queryReference branch = '8b5'.
	self assert: queryReference versionNumber = 1.
	
	queryReference := GoferVersionReference name: 'Seaside-Core-pmm.2'.
	self assert: queryReference packageName = 'Seaside-Core'.
	self assert: queryReference author = 'pmm'.
	self assert: queryReference branch isEmpty.
	self assert: queryReference versionNumber = 2.
	
	queryReference := GoferVersionReference name: 'Seaside-Core.configcleanup-jf.3'.
	self assert: queryReference packageName = 'Seaside-Core'.
	self assert: queryReference author = 'jf'.
	self assert: queryReference branch = 'configcleanup'.
	self assert: queryReference versionNumber = 3.
	
	queryReference := GoferVersionReference name: 'Seaside-Core.configcleanup.extraspeedup-lr.69'.
	self assert: queryReference packageName = 'Seaside-Core'.
	self assert: queryReference author = 'lr'.
	self assert: queryReference branch = 'configcleanup.extraspeedup'.
	self assert: queryReference versionNumber = 69.

	queryReference := GoferVersionReference name: 'Seaside-Core.configcleanup42.extraspeedup-lr.69'.
	self assert: queryReference packageName = 'Seaside-Core'.
	self assert: queryReference author = 'lr'.
	self assert: queryReference branch = 'configcleanup42.extraspeedup'.
	self assert: queryReference versionNumber = 69
! !

!GoferReferenceTest methodsFor: 'testing-reference' stamp: 'TestRunner 12/13/2009 17:30'!
testContraintShouldFindLatestVersion
	| constraintReference reference |
	constraintReference := GoferConstraintReference 
		name: 'GoferBar'
		constraint: [ :ref | true ].
	self assert: (constraintReference resolveAllWith: gofer) size = 4.
	reference := constraintReference resolveWith: gofer.
	self assert: reference packageName = 'GoferBar'.
	self assert: reference author = 'lr'.
	self assert: reference branch isEmpty.
	self assert: reference versionNumber = 1.
	self assert: reference repository = self monticelloRepository.
	
	constraintReference := GoferConstraintReference 
		name: 'GoferBar'
		constraint: [ :ref | ref branch = 'branch' ].
	self assert: (constraintReference resolveAllWith: gofer) size = 2.
	reference := constraintReference resolveWith: gofer.
	self assert: reference packageName = 'GoferBar'.
	self assert: reference author = 'lr'.
	self assert: reference branch = 'branch'.
	self assert: reference versionNumber = 2.
	self assert: reference repository = self monticelloRepository.
	
	constraintReference  := GoferConstraintReference 
		name: 'GoferBar'
		constraint: [ :ref | ref author = 'jf' ].
	self assert: (constraintReference resolveAllWith: gofer) size = 1.
	reference := constraintReference resolveWith: gofer.
	self assert: reference packageName = 'GoferBar'.
	self assert: reference author = 'jf'.
	self assert: reference branch isEmpty.
	self assert: reference versionNumber = 1.
	self assert: reference repository = self monticelloRepository.
	
	constraintReference  := GoferConstraintReference 
		name: 'GoferBar'
		constraint: [ :ref | false ].
	self assert: (constraintReference resolveAllWith: gofer) isEmpty.
	self should: [ constraintReference resolveWith: gofer ] raise: Error.! !

!GoferReferenceTest methodsFor: 'testing-working' stamp: 'lr 1/5/2010 11:06'!
testContraintShouldFindWorkingCopy
	| constraintReference workingCopy |
	constraintReference := GoferConstraintReference 
		name: 'Gofer-Core'
		constraint: [ :reference | false ].
	workingCopy := constraintReference workingCopy.
	self assert: workingCopy packageName = 'Gofer-Core'! !

!GoferReferenceTest methodsFor: 'testing-working' stamp: 'lr 1/5/2010 11:08'!
testResolvedShouldFindWorkingCopy
	| versionReference workingCopy |
	versionReference := GoferResolvedReference name: 'Gofer-Core-lr.18' repository: self monticelloRepository.
	workingCopy := versionReference workingCopy.
	self assert: workingCopy packageName = 'Gofer-Core'! !

!GoferReferenceTest methodsFor: 'testing-reference' stamp: 'lr 12/13/2009 17:29'!
testPackageShouldFindLatestVersion
	| packageReference reference |
	packageReference := GoferPackageReference name: 'GoferFoo'.
	reference := packageReference resolveWith: gofer.
	self assert: reference packageName = 'GoferFoo'.
	self assert: reference author = 'lr'.
	self assert: reference branch isEmpty.
	self assert: reference versionNumber = 4.
	self assert: reference repository = self monticelloRepository! !

!GoferReferenceTest methodsFor: 'testing' stamp: 'lr 12/13/2009 17:27'!
testLoadableShouldSortCorrectly
	| sorted |
	sorted := self versionReferences
		collect: [ :each | each resolveWith: gofer ].
	sorted withIndexDo: [ :first :firstIndex |
		sorted withIndexDo: [ :second :secondIndex |
			firstIndex <= secondIndex
				ifTrue: [ self assert: first <= second ].
			firstIndex >= secondIndex
				ifTrue: [ self assert: second <= first ] ] ]! !

!GoferReferenceTest methodsFor: 'testing-working' stamp: 'lr 1/5/2010 11:08'!
testVersionShouldFindWorkingCopy
	| versionReference workingCopy |
	versionReference := GoferVersionReference name: 'Gofer-Core-lr.18'.
	workingCopy := versionReference workingCopy.
	self assert: workingCopy packageName = 'Gofer-Core'! !

!GoferReferenceTest methodsFor: 'testing-reference' stamp: 'lr 12/13/2009 17:28'!
testResolvedShouldFindLatestVersion
	| versionReference reference |
	versionReference := GoferResolvedReference name: 'GoferFoo-lr.2' repository: self monticelloRepository.
	reference := versionReference resolveWith: gofer.
	self assert: reference packageName = 'GoferFoo'.
	self assert: reference author = 'lr'.
	self assert: reference branch isEmpty.
	self assert: reference versionNumber = 2.
	self assert: reference repository = self monticelloRepository! !

!GoferReferenceTest methodsFor: 'testing-working' stamp: 'lr 1/5/2010 11:03'!
testPackageShouldFindWorkingCopy
	| packageReference workingCopy |
	packageReference := GoferPackageReference name: 'Gofer-Core'.
	workingCopy := packageReference workingCopy.
	self assert: workingCopy packageName = 'Gofer-Core'! !

!GoferReferenceTest methodsFor: 'running' stamp: 'lr 12/13/2009 17:53'!
setUp
	super setUp.
	gofer repository: self monticelloRepository! !

!GoferReferenceTest methodsFor: 'testing-reference' stamp: 'lr 12/13/2009 17:29'!
testVersionShouldFindLatestVersion
	| versionReference reference |
	versionReference := GoferVersionReference name: 'GoferFoo-lr.2'.
	reference := versionReference resolveWith: gofer.
	self assert: reference packageName = 'GoferFoo'.
	self assert: reference author = 'lr'.
	self assert: reference versionNumber = 2.
	self assert: reference branch isEmpty.
	self assert: reference repository = self monticelloRepository.
	
	versionReference := GoferVersionReference name: 'GoferFoo-lr.3'.
	self should: [ versionReference resolveWith: gofer ] raise: Error! !

!GoferReinitialize commentStamp: 'LaurentLaffont 2/23/2011 20:22'!
I'm a private and internal class to Gofer. I'm a command used to call the class side initializers on all package code.!
!GoferReinitialize methodsFor: 'running' stamp: 'EstebanLorenzano 9/12/2012 13:33'!
execute: aWorkingCopy
	aWorkingCopy packageSet methods do: [ :each |
		(each classIsMeta and: [ each selector = #initialize ])
			ifTrue: [ each actualClass theNonMetaClass initialize ] ]! !

!GoferReinitialize methodsFor: 'running' stamp: 'lr 12/30/2009 11:14'!
execute
	self workingCopies
		do: [ :each | self execute: each ]! !

!GoferRemoteChanges commentStamp: 'TorstenBergmann 2/5/2014 09:33'!
Handling remote changes!
!GoferRemoteChanges methodsFor: 'private' stamp: 'TestRunner 12/13/2009 19:27'!
targetSnapshotOf: aReference
	^ (aReference resolveWith: self gofer) version snapshot! !

!GoferRemoteChanges methodsFor: 'queries' stamp: 'lr 12/12/2009 13:00'!
sourceSnapshotOf: aReference
	^ aReference workingCopy package snapshot! !

!GoferRepositoryError commentStamp: 'lr 1/30/2010 14:39'!
A GoferRepositoryError is the error thrown when a repository cannot be accessed.!
!GoferRepositoryError methodsFor: 'accessing' stamp: 'lr 12/9/2009 19:14'!
repository
	^ repository! !

!GoferRepositoryError methodsFor: 'accessing' stamp: 'lr 12/9/2009 19:14'!
repository: aRepository
	repository := aRepository! !

!GoferRepositoryError methodsFor: 'private' stamp: 'lr 12/9/2009 22:32'!
isResumable
	^ true! !

!GoferRepositoryError class methodsFor: 'instance creation' stamp: 'lr 12/9/2009 19:15'!
signal: aString repository: aRepository
	^ self new repository: aRepository; signal: aString! !

!GoferResolvedReference commentStamp: 'lr 1/30/2010 14:38'!
A GoferVersionReference refers to a specific version of a Monticello package in a particular repository. This class is the only one that can actually load the version, because it is the only one knowing where to find it.!
!GoferResolvedReference methodsFor: 'accessing' stamp: 'lr 12/11/2009 22:33'!
repository
	"Answer the repository of the receiver."
	
	^ repository! !

!GoferResolvedReference methodsFor: 'initialization' stamp: 'lr 12/9/2009 22:55'!
initializeName: aString repository: aRepository
	self initializeName: aString.
	repository := aRepository! !

!GoferResolvedReference methodsFor: 'accessing' stamp: 'lr 12/13/2009 17:22'!
version
	"Answer a Monticello version of the receiver."

	^ self repository goferVersionFrom: self! !

!GoferResolvedReference methodsFor: 'actions' stamp: 'CamilloBruni 12/4/2012 19:29'!
merge
	"Merge-in the changes of this refence"
	Gofer new
		repository: self repository;
		package: package;
		version: self name;
		merge! !

!GoferResolvedReference methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
asMetacelloCachingResolvedReference

	^MetacelloCachingGoferResolvedReference name: self name repository: self repository! !

!GoferResolvedReference methodsFor: 'comparing' stamp: 'lr 3/5/2010 07:19'!
<= aResolvedReference
	"Sort versions according to:

		1. package name
		2. branch name, list versions without branch last
		3. version number
		4. author name
		5. repository priority"
	
	self packageName = aResolvedReference packageName
		ifFalse: [ ^ self packageName <= aResolvedReference packageName ].
	self branch = aResolvedReference branch ifFalse: [ 
		^ (self branch isEmpty or: [ aResolvedReference branch isEmpty ])
			ifTrue: [ self branch size > aResolvedReference branch size ]
			ifFalse: [ self branch <= aResolvedReference branch ] ].
	self versionNumber = aResolvedReference versionNumber
		ifFalse: [ ^ self versionNumber <= aResolvedReference versionNumber ].
	self author = aResolvedReference author
		ifFalse: [ ^ self author <= aResolvedReference author ].
	self repository goferPriority = aResolvedReference repository goferPriority
		ifFalse: [ ^ self repository goferPriority <= aResolvedReference repository goferPriority ].
	^ true! !

!GoferResolvedReference class methodsFor: 'instance creation' stamp: 'lr 12/9/2009 22:55'!
name: aString repository: aRepository
	^ self basicNew initializeName: aString repository: aRepository! !

!GoferResource commentStamp: 'TorstenBergmann 2/5/2014 09:30'!
SUnit test resource for Gofer testing!
!GoferResource methodsFor: 'running' stamp: 'ChristopheDemarey 8/25/2014 12:02'!
setUpMonticelloRepository
	"This method builds a fake repository with the version references from #buildReferences."
	| packages |
	
	packages := Dictionary new.
	monticelloRepository := MCDictionaryRepository new.
	versionReferences do: [ :reference |
		monticelloRepository basicStoreVersion: (MCVersion new
			setPackage:  (packages 
				at: reference packageName 
				ifAbsentPut: [ MetacelloTestsMCPackage new name: reference packageName ])
			info: (MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: #())
			snapshot: (MCSnapshot fromDefinitions: (Array
				with: (MCOrganizationDefinition categories: (Array with: reference packageName asSymbol))
				with: (MCClassDefinition name: (reference packageName copyWithout: $-) asSymbol superclassName: #Object category: reference packageName asSymbol instVarNames: #() comment: '')))
			dependencies: #()) ].! !

!GoferResource methodsFor: 'running' stamp: 'lr 2/6/2011 17:30'!
setUpVersionReferences
	"This method answers a set of Gofer references in the order they should be sorted. It includes two different packages (Gofer-Foo, Gofer-Bar), linear series of packages (Gofer-Foo-lr.1, Gofer-Foo-lr.2, Gofer-Foo-lr.4), packages with a branch (Gofer-Bar.branch-lr.1,Gofer.branch-Bar-lr.2), and packages with the same version but different authors (Gofer-Bar-jf.1, Gofer-Bar-lr.1)."

	versionReferences := OrderedCollection new.
	versionReferences
		add: (GoferVersionReference name: 'GoferBar.branch-lr.1');
		add: (GoferVersionReference name: 'GoferBar.branch-lr.2');
		add: (GoferVersionReference name: 'GoferBar-jf.1');
		add: (GoferVersionReference name: 'GoferBar-lr.1');
		add: (GoferVersionReference name: 'GoferFoo-lr.1');
		add: (GoferVersionReference name: 'GoferFoo-lr.2');
		add: (GoferVersionReference name: 'GoferFoo-lr.4')! !

!GoferResource methodsFor: 'accessing' stamp: 'lr 12/12/2009 10:37'!
versionReferences
	^ versionReferences! !

!GoferResource methodsFor: 'running' stamp: 'lr 12/13/2009 16:38'!
setUp
	super setUp.
	self
		setUpVersionReferences;
		setUpMonticelloRepository! !

!GoferResource methodsFor: 'accessing' stamp: 'lr 12/12/2009 10:37'!
monticelloRepository
	^ monticelloRepository! !

!GoferRevert commentStamp: 'TorstenBergmann 2/5/2014 09:36'!
Revert work!
!GoferRevert methodsFor: 'private' stamp: 'BernardoContreras 9/10/2014 20:41'!
referenceFor: aReference
	| ancestors |
	ancestors := aReference workingCopy ancestry ancestors.
	ancestors isEmpty ifTrue: [ ^ MCSnapshot new ].
	^ GoferVersionReference name: ancestors first name! !

!GoferRevert methodsFor: 'running' stamp: 'lr 9/19/2009 13:15'!
execute
	self workingCopies
		do: [ :each | each modified: false ].
	super execute! !

!GoferSynchronize commentStamp: 'TorstenBergmann 2/5/2014 09:31'!
Synchronize repos !
!GoferSynchronize methodsFor: 'accessing' stamp: 'SeanDeNigris 7/17/2012 15:49'!
cacheRepository
	^ MCCacheRepository uniqueInstance! !

!GoferSynchronize methodsFor: 'initialization' stamp: 'TestRunner 12/13/2009 19:54'!
initializeOn: aGofer
	super initializeOn: aGofer disablePackageCache.
	MCFileBasedRepository flushAllCaches.
	cacheReferences := self gofer allResolvedIn: self cacheRepository! !

!GoferTest commentStamp: 'TorstenBergmann 2/5/2014 09:30'!
SUnit tests for Gofer!
!GoferTest methodsFor: 'running' stamp: 'lr 12/13/2009 17:38'!
setUp
	super setUp.
	gofer := Gofer new.
	gofer disablePackageCache! !

!GoferTest methodsFor: 'accessing' stamp: 'lr 12/12/2009 10:46'!
versionReferences
	^ GoferResource current versionReferences! !

!GoferTest methodsFor: 'accessing' stamp: 'lr 12/12/2009 10:44'!
monticelloRepository
	^ GoferResource current monticelloRepository! !

!GoferTest class methodsFor: 'accessing' stamp: 'lr 12/11/2009 23:54'!
resources
	^ Array with: GoferResource! !

!GoferTest class methodsFor: 'testing' stamp: 'JorgeRessia 3/16/2010 20:23'!
isUnitTest
	^false! !

!GoferTest class methodsFor: 'testing' stamp: 'lr 10/1/2009 22:00'!
isAbstract
	^ self name = #GoferTest! !

!GoferTest class methodsFor: 'accessing' stamp: 'lr 1/5/2010 11:06'!
packageNamesUnderTest
	^ #('Gofer-Core')! !

!GoferUnload commentStamp: 'TorstenBergmann 2/5/2014 09:36'!
Unload!
!GoferUnload methodsFor: 'unloading' stamp: 'EstebanLorenzano 9/12/2012 13:33'!
unloadClasses: aWorkingCopy
	aWorkingCopy packageSet methods do: [ :each |
		(each classIsMeta and: [ each selector = #unload ])
			ifTrue: [ each actualClass theNonMetaClass unload ] ]! !

!GoferUnload methodsFor: 'unregistering' stamp: 'lr 8/19/2009 13:50'!
unregisterRepositories: aWorkingCopy
	aWorkingCopy repositoryGroup repositories allButFirst do: [ :repository |
		MCWorkingCopy allManagers do: [ :copy |
			(copy repositoryGroup includes: repository)
				ifTrue: [ ^ self ] ].
		MCRepositoryGroup default
			removeRepository: repository ]! !

!GoferUnload methodsFor: 'unregistering' stamp: 'EstebanLorenzano 9/12/2012 13:34'!
unregister: aWorkingCopy
	self unregisterWorkingCopy: aWorkingCopy.
	self unregisterRepositories: aWorkingCopy.
	self unregisterPackageSet: aWorkingCopy.
	self unregisterPackageInfo: aWorkingCopy! !

!GoferUnload methodsFor: 'running' stamp: 'lr 10/3/2009 11:45'!
execute
	self workingCopies 
		do: [ :copy | self unload: copy ].
	self model load.
	self gofer cleanup.
	self workingCopies 
		do: [ :copy | self unregister: copy ]! !

!GoferUnload methodsFor: 'private' stamp: 'lr 3/14/2010 21:13'!
defaultModel
	^ (Smalltalk globals at: #MCMultiPackageLoader ifAbsent: [ MCPackageLoader ]) new! !

!GoferUnload methodsFor: 'unloading' stamp: 'lr 10/3/2009 11:46'!
unload: aWorkingCopy
	self unloadClasses: aWorkingCopy.
	self unloadPackage: aWorkingCopy
! !

!GoferUnload methodsFor: 'unloading' stamp: 'lr 8/19/2009 14:00'!
unloadPackage: aWorkingCopy
	self model unloadPackage: aWorkingCopy package! !

!GoferUnload methodsFor: 'unregistering' stamp: 'lr 8/20/2009 11:54'!
unregisterWorkingCopy: aWorkingCopy
	aWorkingCopy unregister! !

!GoferUnload methodsFor: 'unregistering' stamp: 'EstebanLorenzano 9/12/2012 13:34'!
unregisterPackageSet: aWorkingCopy
	aWorkingCopy packageSet unregister! !

!GoferUnload methodsFor: 'unregistering' stamp: 'EstebanLorenzano 7/21/2014 13:37'!
unregisterPackageInfo: aWorkingCopy
	RPackageOrganizer default
		unregisterPackageNamed: aWorkingCopy packageName! !

!GoferUpdate commentStamp: 'TorstenBergmann 2/5/2014 09:36'!
Update!
!GoferUpdate methodsFor: 'private' stamp: 'lr 9/18/2009 18:13'!
defaultModel
	^ MCVersionLoader new! !

!GoferUpdate methodsFor: 'private' stamp: 'TestRunner 12/13/2009 18:09'!
addReference: aReference
	super addReference: aReference.
	self model addVersion: ((self referenceFor: aReference)
		 resolveWith: self gofer) version! !

!GoferUpdate methodsFor: 'private' stamp: 'TestRunner 12/13/2009 18:08'!
referenceFor: aReference
	^ aReference! !

!GoferUpdate methodsFor: 'running' stamp: 'StephaneDucasse 12/30/2012 20:28'!
execute
	self model hasVersions
		ifTrue: [ self model load ].
	self gofer cleanup! !

!GoferVersionReference commentStamp: 'lr 12/9/2009 22:50'!
A GoferVersionReference refers to a specific version of a Monticello package.!
!GoferVersionReference methodsFor: '*metacello-mc' stamp: 'dkh 07/19/2013 15:25'!
compare: aLoadableReference using: aComparisonOperator
	"Compare versions using <aComparisonOperator>. package names #= then compare based upon version number
	Branches and Author names are used in the case of a version number tie, because we need to avoid seesaw loading."
		
	self packageName = aLoadableReference packageName
		ifFalse: [ ^false ].
	self versionNumber = aLoadableReference versionNumber
		ifFalse: [ ^ self versionNumber perform: aComparisonOperator with: aLoadableReference versionNumber ].
	self branch = aLoadableReference branch 
		ifFalse: [ ^ self branch perform: aComparisonOperator with: aLoadableReference branch ].
	^ self author perform: aComparisonOperator with: aLoadableReference author! !

!GoferVersionReference methodsFor: 'accessing' stamp: 'lr 12/11/2009 22:22'!
author
	"Answer the author of the receiver."
	
	^ author! !

!GoferVersionReference methodsFor: 'accessing' stamp: 'lr 12/13/2009 17:12'!
packageName
	"Answer the package of the receiver."

	^ package! !

!GoferVersionReference methodsFor: 'initialization' stamp: 'lr 12/11/2009 22:17'!
initializeName: aString
	super initializeName: aString.
	self parseName: aString! !

!GoferVersionReference methodsFor: 'initialization' stamp: 'lr 2/6/2011 18:01'!
parseName: aString
	| basicName |
	basicName := aString last isDigit
		ifTrue: [ aString ]
		ifFalse: [ (aString copyUpToLast: $.) copyUpTo: $( ].
	package := basicName copyUpToLast: $-.
	(package includes: $.)
		ifFalse: [ branch := '' ]
		ifTrue: [
			branch := package copyAfter: $..
			package := package copyUpTo: $. ].
	author := (basicName copyAfterLast: $-) copyUpToLast: $..
	versionNumber := (basicName copyAfterLast: $-) copyAfterLast: $..
	(versionNumber notEmpty and: [ versionNumber allSatisfy: [ :each | each isDigit ] ])
		ifTrue: [ versionNumber := versionNumber asInteger ]
		ifFalse: [ versionNumber := 0 ]! !

!GoferVersionReference methodsFor: 'private' stamp: 'lr 1/21/2010 00:17'!
matches: aResolvedReference
	^ self name = aResolvedReference name! !

!GoferVersionReference methodsFor: 'accessing' stamp: 'lr 12/13/2009 17:20'!
versionNumber
	"Answer the version of the receiver."

	^ versionNumber! !

!GoferVersionReference methodsFor: 'accessing' stamp: 'lr 12/11/2009 22:23'!
branch
	"Answer the branch of the receiver."
	
	^ branch! !

!GoferVersionReference methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
metacelloPackageNameWithBranch
	"answer array with package name and package name with branch name"
	self branch isEmpty
		ifTrue: [ 
			^ {(self packageName).
			(self packageName)} ].
	^ {(self packageName).
	(self packageName , '.' , self branch)}! !

!GoferWorking commentStamp: 'TorstenBergmann 2/5/2014 09:34'!
Common superclass for workin copies in Gofer!
!GoferWorking methodsFor: 'accessing' stamp: 'lr 9/24/2009 16:55'!
workingCopies
	"Answer the working copies to be operated on."

	^ workingCopies! !

!GoferWorking methodsFor: 'initialization' stamp: 'lr 8/19/2009 13:14'!
initialize
	super initialize.
	workingCopies := OrderedCollection new! !

!GoferWorking methodsFor: 'initialization' stamp: 'lr 12/13/2009 19:16'!
initializeOn: aGofer
	super initializeOn: aGofer.
	aGofer references 
		do: [ :each | self addReference: each ]! !

!GoferWorking methodsFor: 'private' stamp: 'CamilloBruni 9/5/2012 17:27'!
addReference: aReference
	| workingCopy |
	workingCopy := aReference workingCopyIfAbsent: [ ^ self ].
	(self workingCopies includes: workingCopy)
		ifTrue: [ ^ self ].
	self workingCopies addLast: workingCopy.
	workingCopy requiredPackages do: [ :package |
		self addReference: (GoferPackageReference
			name: package name) ]! !

!GradientFillStyle commentStamp: 'efc 8/30/2005 21:44'!
A gradient fill style is a fill which interpolates smoothly between any number of colors.

Instance variables:
	colorRamp	<Array of: Association> Contains the colors and their relative positions along the fill, which is a number between zero and one.
	pixelRamp	<Bitmap>		A cached version of the colorRamp to avoid needless recomputations.
	radial		<Boolean>	If true, this fill describes a radial gradient. If false, it is a linear gradient.
	isTranslucent	<Boolean>	A (cached) flag determining if there are any translucent colors involved.

Class variables:
	PixelRampCache <LRUCache>	Recently used pixelRamps. They tend to have high temporal locality and this saves space and time.!
!GradientFillStyle methodsFor: 'private' stamp: 'nice 1/5/2010 15:59'!
computePixelRampOfSize: length
	"Compute the pixel ramp in the receiver"
	| bits lastValue ramp lastColor lastIndex lastWord |
	ramp := colorRamp asSortedCollection:[:a1 :a2| a1 key < a2 key].
	bits := Bitmap new: length.
	lastColor := ramp first value.
	lastWord := lastColor pixelWordForDepth: 32.
	lastIndex := 0.
	ramp do:[:assoc| | theta nextIndex nextColor nextWord distance step |
		nextIndex := (assoc key * length) rounded.
		nextColor := assoc value.
		nextWord := nextColor pixelWordForDepth: 32.
		distance := (nextIndex - lastIndex).
		distance = 0 ifTrue:[distance := 1].
		step := 1.0 / distance asFloat.
		theta := 0.0.
		lastIndex+1 to: nextIndex do:[:i|
			theta := theta + step.
			"The following is an open-coded version of:
				color := nextColor alphaMixed: theta with: lastColor.
				bits at: i put: (color scaledPixelValue32).
			"
			bits at: i put: (self scaledAlphaMix: theta of: lastWord with: nextWord).
		].
		lastIndex := nextIndex.
		lastColor := nextColor.
		lastWord := nextWord.
	].
	lastValue := lastColor scaledPixelValue32.
	lastIndex+1 to: length do:[:i| bits at: i put: lastValue].
	^bits! !

!GradientFillStyle methodsFor: 'accessing' stamp: 'ar 9/2/1999 14:30'!
colorRamp: anArray
	colorRamp := anArray.
	pixelRamp := nil.
	isTranslucent := nil.! !

!GradientFillStyle methodsFor: 'converting' stamp: 'ar 8/25/2001 21:02'!
asColor
	"Guess..."
	^colorRamp first value mixed: 0.5 with: colorRamp last value! !

!GradientFillStyle methodsFor: 'accessing' stamp: 'ar 11/7/1998 22:10'!
colorRamp
	^colorRamp! !

!GradientFillStyle methodsFor: 'accessing' stamp: 'ar 11/9/1998 14:06'!
pixelRamp: aBitmap
	pixelRamp := aBitmap! !

!GradientFillStyle methodsFor: 'testing' stamp: 'ar 9/2/1999 14:29'!
isTranslucent
	^isTranslucent ifNil:[isTranslucent := self checkTranslucency]! !

!GradientFillStyle methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/11/2014 10:12'!
pixelRamp
	"Compute a pixel ramp, and cache it for future accesses"

	^ pixelRamp ifNil: [
		"Ask my cache for an existing instance or to create one"
		pixelRamp := self class pixelRampCache at: colorRamp ]! !

!GradientFillStyle methodsFor: '*Morphic-Base-Balloon' stamp: 'TorstenBergmann 2/27/2015 22:47'!
changeColorOf: aMorph rampIndex: rampIndex
	| originalColor |
	originalColor := (colorRamp at: rampIndex) value.
	UIManager default theme 
		chooseColorIn: World title: 'Color' color: originalColor for: [:color |
		self changeColorAt: rampIndex  to:  color.
		aMorph changed] ! !

!GradientFillStyle methodsFor: '*Morphic-Base-Balloon' stamp: 'ar 6/18/1999 07:25'!
beLinearGradientIn: aMorph
	self radial: false.
	aMorph changed.! !

!GradientFillStyle methodsFor: '*Morphic-Base-Balloon' stamp: 'StephaneDucasse 10/26/2014 11:17'!
addFillStyleMenuItems: aMenu hand: aHand from: aMorph
	"Add the items for changing the current fill style of the receiver"
	self isRadialFill 
		ifTrue: [ aMenu add: 'linear gradient' target: self selector: #beLinearGradientIn: argument: aMorph ] 		ifFalse: [ aMenu add: 'radial gradient' target: self selector: #beRadialGradientIn: argument: aMorph ].
	aMenu addLine.
	aMenu add: 'change first color' target: self selector: #changeFirstColorIn:event: argument: aMorph.
	aMenu add: 'change second color' target: self selector: #changeSecondColorIn:event: argument: aMorph.
	aMenu addLine.
	super addFillStyleMenuItems: aMenu hand: aHand from: aMorph.! !

!GradientFillStyle methodsFor: 'accessing' stamp: 'ar 8/31/2004 11:06'!
radial
	^radial ifNil:[false]! !

!GradientFillStyle methodsFor: '*Morphic-Base-Balloon' stamp: 'dik 7/1/2010 00:45'!
changeColorAt: rampIndex to: aColor
	| ramp |
	ramp := colorRamp deepCopy.
	(ramp at: rampIndex) value: aColor.
	
	colorRamp := ramp.
	isTranslucent := nil.
	pixelRamp := nil.! !

!GradientFillStyle methodsFor: '*Morphic-Base-Balloon' stamp: 'dik 6/28/2010 00:22'!
changeFirstColorIn: aMorph event: evt.
	^self changeColorOf: aMorph rampIndex: 1! !

!GradientFillStyle methodsFor: 'accessing' stamp: 'ar 11/7/1998 22:11'!
radial: aBoolean
	radial := aBoolean! !

!GradientFillStyle methodsFor: '*Morphic-Base-Balloon' stamp: 'ar 6/18/1999 07:25'!
beRadialGradientIn: aMorph
	self radial: true.
	aMorph changed.! !

!GradientFillStyle methodsFor: 'converting' stamp: 'ar 6/4/2001 00:42'!
mixed: fraction with: aColor
	^self copy colorRamp: (colorRamp collect:[:assoc| assoc key -> (assoc value mixed: fraction with: aColor)])! !

!GradientFillStyle methodsFor: '*Morphic-Base-Balloon' stamp: 'HenrikSperreJohansen 6/11/2010 12:29'!
changeColorSelector: aSymbol hand: aHand morph: aMorph originalColor: originalColor
	"Change either the firstColor or the lastColor (depending on aSymbol).  Put up a color picker to hande it.  We always use a modal picker so that the user can adjust both colors concurrently."
	|arraySelector|
	"A bad hack, I know... but it already uses a perform which depends on only firstColor: ... / lastColor: ... being sent"
	arraySelector := (aSymbol readStream upTo: $C) asSymbol.
(	UIManager default chooseColor: (colorRamp perform: arraySelector) value)
		ifNotNil: [:nc | 
			self 
				perform: aSymbol 
				with: nc 
				with: aMorph 
				with: aHand]

! !

!GradientFillStyle methodsFor: 'comparing' stamp: 'gvc 7/24/2007 12:22'!
hash
	"Hash is implemented because #= is implemented."
	
	^super hash bitXor: self pixelRamp hash! !

!GradientFillStyle methodsFor: '*Athens-Core' stamp: 'IgorStasenko 10/11/2012 16:16'!
asAthensPaintOn: anAthensCanvas

	^ AthensMorphicGradientPaint new gradient: self.
	"^ radial ifTrue: [
		anAthensCanvas surface
			createRadialGradient: colorRamp
			center:  (anAthensCanvas pathTransform inverseTransform: origin )
			radius: direction y ]
	ifFalse: [
		anAthensCanvas surface
			createLinearGradient: colorRamp
			origin: (anAthensCanvas pathTransform inverseTransform: origin)
			corner: (anAthensCanvas pathTransform inverseTransform: origin + direction ) ]
"! !

!GradientFillStyle methodsFor: '*Morphic-Base-Balloon' stamp: 'ar 6/18/1999 09:49'!
addNewColorIn: aMorph event: evt
	^self inform:'not yet implemented'! !

!GradientFillStyle methodsFor: 'testing' stamp: 'ar 11/7/1998 22:13'!
isRadialFill
	^radial == true! !

!GradientFillStyle methodsFor: 'private' stamp: 'ar 7/11/2000 16:47'!
scaledAlphaMix: theta of: lastWord with: nextWord
	"Open-coded version of alpha mixing two 32bit pixel words and returning the scaled pixel value."
	| word0 word1 a0 a1 alpha v0 v1 vv value |
	word0 := lastWord.
	word1 := nextWord.
	"note: extract alpha first so we'll be in SmallInteger range afterwards"
	a0 := word0 bitShift: -24. a1 := word1 bitShift: -24.
	alpha := a0 + (a1 - a0 * theta) truncated.
	"Now make word0 and word1 SmallIntegers"
	word0 := word0 bitAnd: 16rFFFFFF. word1 := word1 bitAnd: 16rFFFFFF.
	"Compute first component value"
	v0 := (word0 bitAnd: 255). v1 := (word1 bitAnd: 255).
	vv := (v0 + (v1 - v0 * theta) truncated) * alpha // 255.
	value := vv.
	"Compute second component value"
	v0 := ((word0 bitShift: -8) bitAnd: 255). v1 := ((word1 bitShift: -8) bitAnd: 255).
	vv := (v0 + (v1 - v0 * theta) truncated) * alpha // 255.
	value := value bitOr: (vv bitShift: 8).
	"Compute third component value"
	v0 := ((word0 bitShift: -16) bitAnd: 255). v1 := ((word1 bitShift: -16) bitAnd: 255).
	vv := (v0 + (v1 - v0 * theta) truncated) * alpha // 255.
	value := value bitOr: (vv bitShift: 16).
	"Return result"
	^value bitOr: (alpha bitShift: 24)! !

!GradientFillStyle methodsFor: 'private' stamp: 'di 11/21/1999 20:18'!
checkTranslucency
	^colorRamp anySatisfy: [:any| any value isTranslucent]! !

!GradientFillStyle methodsFor: 'comparing' stamp: 'gvc 7/24/2007 12:22'!
= anGradientFillStyle
	"Answer whether equal."

	^super = anGradientFillStyle
		and: [self pixelRamp == anGradientFillStyle pixelRamp] "LRU should make identity equal"! !

!GradientFillStyle methodsFor: '*Morphic-Base-Balloon' stamp: 'dik 6/28/2010 00:31'!
copyWith: aColor atRamp: rampIndex
	| ramp |
	ramp := colorRamp deepCopy.
	(ramp at: rampIndex) value: aColor.
	^(self class ramp: ramp) 
			origin: self origin;
			direction: self direction;
			normal: self normal;
			radial: self radial;
			yourself! !

!GradientFillStyle methodsFor: 'testing' stamp: 'ar 11/7/1998 22:12'!
isGradientFill
	^true! !

!GradientFillStyle methodsFor: '*Morphic-Base-Balloon' stamp: 'dik 6/28/2010 00:22'!
changeSecondColorIn: aMorph event: evt
	^self changeColorOf: aMorph rampIndex: 2! !

!GradientFillStyle class methodsFor: 'cleanup' stamp: 'StephaneDucasse 3/9/2010 16:32'!
cleanUp
	"Flush caches"

	self initPixelRampCache! !

!GradientFillStyle class methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 1/12/2014 15:44'!
initPixelRampCache
	"Create an LRUCache to use for accessing pixel ramps.
	When a new pixel ramp is needed, a temporary GradientFillStyle
	is created so that it can be used to create a new pixel ramp"

	^ PixelRampCache := LRUCache new 
		maximumWeight: 32;
		factory: [ :key | 
			(GradientFillStyle new colorRamp: key) 
				computePixelRampOfSize: 512 ];
		yourself! !

!GradientFillStyle class methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 1/12/2014 15:49'!
initialize
	"GradientFillStyle initialize"
	
	self initPixelRampCache ! !

!GradientFillStyle class methodsFor: 'instance creation' stamp: 'ar 11/9/1998 14:05'!
ramp: colorRamp
	^self new colorRamp: colorRamp! !

!GradientFillStyle class methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 1/11/2014 10:11'!
pixelRampCache
	"Allow access to my cache of pixel ramps."

	^ PixelRampCache ifNil: [ self initPixelRampCache ]! !

!GradientFillStyle class methodsFor: 'instance creation' stamp: 'ar 11/26/2001 23:09'!
colors: colorArray
	"Create a gradient fill style from an array of equally spaced colors"
	^self ramp: (colorArray withIndexCollect:
		[:color :index| (index-1 asFloat / (colorArray size - 1 max: 1)) -> color]).! !

!GradientFillStyle class methodsFor: 'instance creation' stamp: 'ar 11/10/1998 19:13'!
sample
	"GradientFill sample"
	^(self ramp: { 0.0 -> Color red. 0.5 -> Color green. 1.0 -> Color blue})
		origin: 300 @ 300;
		direction: 400@0;
		normal: 0@400;
		radial: true;
	yourself! !

!GradientPaint commentStamp: '<historical>'!
I am paint which using color gradient for fills.

The gradient is defined using color ramp in range between 0 and 1
where colors can be set at certain point. The color are interpolated between defined points.

The color ramp is a collection of associations with keys - floating point values between 0 and 1
and values with Colors, for example:

{  0 -> Color white. 1 -> Color black }.

My subclasses used to define a concrete kind of gradient,
while me is an abstract class which has common properties for all gradients: color ramp.

Also, note that my subclasses representing backend-neutral gradients,
encapsulating all necessary data, which is then passed to corresponding surface factory method, like
AthensSurface>>#createLinearGradient:start:stop: , which answers backend-specific gradient paint.
I am userful in cases when user wants to define a paint without need
to have any Athens surface at hand.

Sure thing, using backend-specific gradients is preferable, if possible,
because conversion to backend-specific paint can be costly. 
Especially if gradient is statically defined (ramp values and other parameters never changing) 
and used many times during the life time of surface.

!
!GradientPaint methodsFor: 'initialize-release' stamp: 'IgorStasenko 4/12/2013 09:51'!
initialize
	super initialize.
	colorRamp := OrderedCollection new.! !

!GradientPaint methodsFor: 'accessing' stamp: 'IgorStasenko 4/12/2013 09:54'!
atStop: anOffset put: aColor

	colorRamp add: (anOffset -> aColor).
! !

!GradientPaint methodsFor: 'accessing' stamp: 'IgorStasenko 4/13/2013 09:11'!
colorRamp: aRamp
"The color ramp is a collection of associations with keys - floating point values between 0 and 1
and values with Colors, for example:

{  0 -> Color white. 1 -> Color black }.
"
	colorRamp := aRamp copy.! !

!GradientPaint methodsFor: 'accessing' stamp: 'FernandoOlivero 1/13/2012 21:11'!
colorRamp
	^ colorRamp! !

!GrafPort commentStamp: 'TorstenBergmann 2/20/2014 18:35'!
Provides extended Graphic support like translucency!
!GrafPort methodsFor: 'accessing' stamp: 'ar 5/28/2000 14:41'!
contentsOfArea: aRectangle into: aForm
	destForm 
		displayOn: aForm 
		at:  aRectangle origin
		clippingBox: (0@0 extent: aRectangle extent).
	^aForm! !

!GrafPort methodsFor: 'accessing' stamp: 'tween 4/5/2007 08:03'!
lastFontForegroundColor
	^lastFontForegroundColor! !

!GrafPort methodsFor: 'copying' stamp: 'MarcusDenker 10/21/2013 14:22'!
copyBits
	"Override copybits to do translucency if desired"

	(combinationRule between: 30 and: 31)
		ifTrue: [ self copyBitsTranslucent: (alpha ifNil: [ 255 ]) ]
		ifFalse: [ super copyBits ]! !

!GrafPort methodsFor: 'drawing support' stamp: 'ar 2/17/2000 00:31'!
stencil: stencilForm at: aPoint sourceRect: aRect
	"Paint using aColor wherever stencilForm has non-zero pixels"
	self sourceForm: stencilForm;
		destOrigin: aPoint;
		sourceRect: aRect.
	self copyBits! !

!GrafPort methodsFor: 'private' stamp: 'yo 1/8/2005 09:12'!
installStrikeFont: aStrikeFont

	^ self installStrikeFont: aStrikeFont foregroundColor: (lastFontForegroundColor ifNil: [Color black]) backgroundColor: (lastFontBackgroundColor ifNil: [Color transparent]).
! !

!GrafPort methodsFor: '*Rubric-Editing-Core' stamp: 'AlainPlantec 3/20/2013 22:39'!
rubDisplayScannerFor: para foreground: foreColor background: backColor ignoreColorChanges: shadowMode
	^ (RubDisplayScanner new text: para text textStyle: para textStyle
			foreground: foreColor background: backColor fillBlt: self
			ignoreColorChanges: shadowMode)
		setPort: self shallowCopy! !

!GrafPort methodsFor: 'private' stamp: 'yo 1/8/2005 09:13'!
lastFont

	^ lastFont.
! !

!GrafPort methodsFor: 'private' stamp: 'tween 6/8/2008 12:29'!
installStrikeFont: aStrikeFont foregroundColor: foregroundColor backgroundColor: backgroundColor
	super installStrikeFont: aStrikeFont foregroundColor: foregroundColor backgroundColor: backgroundColor.
	aStrikeFont glyphs depth = 1 ifTrue: [
		alpha := foregroundColor privateAlpha.
		"dynamically switch between blend modes to support translucent text"
		"To handle the transition from TTCFont to StrikeFont, rule 34 must be taken into account."
		alpha = 255 ifTrue:[
			combinationRule = 30 ifTrue: [combinationRule := Form over].
			combinationRule = 31 ifTrue: [combinationRule := Form paint].
			combinationRule = 34 ifTrue: [combinationRule := Form paint].
			combinationRule = 41 ifTrue: [combinationRule := Form paint]. "41 is  SPRmode"
		] ifFalse:[
			combinationRule = Form over ifTrue: [combinationRule := 30].
			combinationRule = Form paint ifTrue: [combinationRule := 31].
			combinationRule = 34 ifTrue: [combinationRule := 31].
			combinationRule = 41 ifTrue: [combinationRule := 31]. "41 is SPR mode"
		]
	].
	lastFont := aStrikeFont.
	lastFontForegroundColor := foregroundColor.
	lastFontBackgroundColor := backgroundColor.
! !

!GrafPort methodsFor: 'drawing support' stamp: 'ar 2/17/2000 01:08'!
frameRectBottom: rect height: h

	destX := rect left + 1.
	destY := rect bottom - 1.
	width := rect width - 2.
	height := 1.
	1 to: h do: [:i |
		self copyBits.
		destX := destX + 1.
		destY := destY - 1.
		width := width - 2].
! !

!GrafPort methodsFor: 'accessing' stamp: 'ar 2/17/2000 01:09'!
fillPattern: anObject
	fillPattern := anObject.
	self fillColor: anObject.! !

!GrafPort methodsFor: 'drawing support' stamp: 'ar 5/17/2000 21:20'!
fillRect: rect offset: aPoint
	"The offset is really just for stupid InfiniteForms."
	| fc |
	fillPattern class == InfiniteForm ifTrue:[
		fc := halftoneForm.
		self fillColor: nil.
		fillPattern displayOnPort: ((self clippedBy: rect) colorMap: nil) at: aPoint.
		halftoneForm := fc.
		^self].

	destX := rect left.
	destY := rect top.
	sourceX := 0.
	sourceY := 0.
	width := rect width.
	height := rect height.
	self copyBits.! !

!GrafPort methodsFor: 'drawing support' stamp: 'ar 2/17/2000 01:08'!
image: aForm at: aPoint sourceRect: sourceRect rule: rule
	"Draw the portion of the given Form defined by sourceRect at the given point using the given BitBlt combination rule."

	sourceForm := aForm.
	combinationRule := rule.
	self sourceRect: sourceRect.
	self destOrigin: aPoint.
	self copyBits! !

!GrafPort methodsFor: 'copying' stamp: 'ar 12/30/2001 20:32'!
clippedBy: aRectangle
	^ self copy clipBy: aRectangle! !

!GrafPort methodsFor: 'drawing support' stamp: 'ar 2/17/2000 14:44'!
frameRect: rect borderWidth: borderWidth
	sourceX := 0.
	sourceY := 0.
	(rect areasOutside: (rect insetBy: borderWidth)) do:
		[:edgeStrip | self destRect: edgeStrip; copyBits].
! !

!GrafPort methodsFor: 'drawing support' stamp: 'MarcusDenker 10/28/2010 14:02'!
frameOval: rect borderWidth: borderWidth
	| centerX centerY nextY yBias xBias wp outer inner nextOuterX nextInnerX |
	rect area <= 0 ifTrue: [^ self].
	height := 1.
	wp := borderWidth asPoint.
	yBias := rect height odd ifTrue: [0] ifFalse: [-1].
	xBias := rect width odd ifTrue: [1] ifFalse: [0].
	centerX := rect center x.
	centerY := rect center y.
	outer := EllipseMidpointTracer new on: rect.
	inner := EllipseMidpointTracer new on: (rect insetBy: wp).
	nextY := rect height // 2.
	1 to: (wp y min: nextY) do:[:i|
		nextOuterX := outer stepInY.
		width := (nextOuterX bitShift: 1) + xBias.
		destX := centerX - nextOuterX.
		destY := centerY - nextY.
		self copyBits.
		destY := centerY + nextY + yBias.
		self copyBits.
		nextY := nextY - 1.
	].
	[nextY > 0] whileTrue:[
		nextOuterX := outer stepInY.
		nextInnerX := inner stepInY.
		destX := centerX - nextOuterX.
		destY := centerY - nextY.
		width := nextOuterX - nextInnerX.
		self copyBits.
		destX := centerX + nextInnerX + xBias.
		self copyBits.
		destX := centerX - nextOuterX.
		destY := centerY + nextY + yBias.
		self copyBits.
		destX := centerX + nextInnerX + xBias.
		self copyBits.
		nextY := nextY - 1.
	].
	destY := centerY.
	height := 1 + yBias.
	width := wp x.
	destX := rect left.
	self copyBits.
	destX := rect right - wp x.
	self copyBits.
! !

!GrafPort methodsFor: 'drawing support' stamp: 'ar 2/16/2000 22:32'!
fillOval: rect
	| centerX centerY nextY yBias xBias outer nextOuterX |
	rect area <= 0 ifTrue: [^ self].
	height := 1.
	yBias := rect height odd ifTrue: [0] ifFalse: [-1].
	xBias := rect width odd ifTrue: [1] ifFalse: [0].
	centerX := rect center x.
	centerY := rect center y.
	outer := EllipseMidpointTracer new on: rect.
	nextY := rect height // 2.
	[nextY > 0] whileTrue:[
		nextOuterX := outer stepInY.
		width := (nextOuterX bitShift: 1) + xBias.
		destX := centerX - nextOuterX.
		destY := centerY - nextY.
		self copyBits.
		destY := centerY + nextY + yBias.
		self copyBits.
		nextY := nextY - 1.
	].
	destY := centerY.
	height := 1 + yBias.
	width := rect width.
	destX := rect left.
	self copyBits.
! !

!GrafPort methodsFor: 'drawing support' stamp: 'ar 2/17/2000 01:08'!
frameRectRight: rect width: w

	width := 1.
	height := rect height - 1.
	destX := rect right - 1.
	destY := rect top + 1.
	1 to: w do: [:i |
		self copyBits.
		destX := destX - 1.
		destY := destY + 1.
		height := height - 2].
! !

!GrafPort methodsFor: 'accessing' stamp: 'ar 2/17/2000 01:07'!
alphaBits: a
	alpha := a! !

!GrafPort methodsFor: '*Morphic-Base' stamp: 'nice 11/2/2013 17:29'!
displayScannerFor: para foreground: foreColor background: backColor ignoreColorChanges: shadowMode
	^ (BitBltDisplayScanner new text: para text textStyle: para textStyle
			foreground: foreColor background: backColor fillBlt: self
			ignoreColorChanges: shadowMode)
		setPort: self shallowCopy! !

!GrafPort methodsFor: '*FreeType-addition' stamp: 'tween 4/5/2007 08:39'!
installFreeTypeFont: aFreeTypeFont foregroundColor: foregroundColor backgroundColor: backgroundColor

	super installFreeTypeFont: aFreeTypeFont foregroundColor: foregroundColor backgroundColor: backgroundColor.
	lastFont := aFreeTypeFont.
	lastFontForegroundColor := foregroundColor.
	lastFontBackgroundColor := backgroundColor.
! !

!GrafPort methodsFor: 'drawing support' stamp: 'ar 8/8/2001 14:26'!
image: aForm at: aPoint sourceRect: sourceRect rule: rule alpha: sourceAlpha
	"Draw the portion of the given Form defined by sourceRect at the given point using the given BitBlt combination rule."

	sourceForm := aForm.
	combinationRule := rule.
	self sourceRect: sourceRect.
	self destOrigin: aPoint.
	self copyBitsTranslucent: (alpha := (sourceAlpha * 255) truncated min: 255 max: 0).! !

!GraphicFontSettings commentStamp: 'TorstenBergmann 2/12/2014 23:27'!
Settings for the fonts!
!GraphicFontSettings class methodsFor: 'fonts' stamp: 'StephaneDucasse 11/12/2014 14:06'!
resetAllFontToDefaultButton
	^ (self theme
		newButtonIn: World
		for: self
		getState: nil
		action: #resetAllFontToDefault
		arguments: {}
		getEnabled: nil
		getLabel: nil
		help: 'Force all system fonts to be the default one' translated)
		label:  (self theme
					newRowIn: World
					for:
						{(AlphaImageMorph new image: Smalltalk ui icons smallRedoIcon).
						(self theme buttonLabelForText: 'Force all' translated)});
		yourself! !

!GraphicFontSettings class methodsFor: 'fonts' stamp: 'MarcusDenker 7/16/2014 13:46'!
resetAllFontToDefault
	StandardFonts setAllStandardFontsTo: StandardFonts defaultFont.
	SettingBrowser refreshAllSettingBrowsers.
	EditorFindReplaceDialogWindow cleanUp.
	 
! !

!GraphicFontSettings class methodsFor: 'fonts' stamp: 'StephaneDucasse 11/12/2014 14:04'!
fontChoiceButtonForStyle: aSymbol label: aLabel
	| label |
	label := StringMorph 
				contents: aLabel asString 
				font: (TextStyle default fontOfPointSize: (StandardFonts pointSizeForStyleNamed: aSymbol)).
	^ (self theme 
		newButtonIn: World
		for: self
		getState: nil 
		action: #setFontsToStyleNamed:
		arguments: { aSymbol }
		getEnabled: nil
		getLabel: nil
		help: ('Change font style to ', aLabel) translated)
			label: label;
			yourself
! !

!GraphicFontSettings class methodsFor: 'fonts' stamp: 'MarcusDenker 7/16/2014 13:46'!
setFontsToStyleNamed: aSymbol
	StandardFonts setFontsToStyleNamed: aSymbol.
	SettingBrowser refreshAllSettingBrowsers.
	EditorFindReplaceDialogWindow cleanUp.! !

!GraphicFontSettings class methodsFor: 'fonts' stamp: 'StephaneDucasse 11/12/2014 14:03'!
fontSizeRow
	^ self theme newRowIn: World for: {
			self theme buttonLabelForText: 'Predefined styles: ' translated.
			self fontChoiceButtonForStyle: #small label: 'Small' translated.
			self fontChoiceButtonForStyle: #medium label: 'Medium' translated.
			self fontChoiceButtonForStyle: #large label: 'Large' translated.
			self fontChoiceButtonForStyle: #veryLarge label: 'Very large' translated.
			self fontChoiceButtonForStyle: #huge label: 'Huge' translated.
	}! !

!GraphicFontSettings class methodsFor: 'fonts' stamp: 'StephaneDucasse 11/12/2014 14:03'!
theme 
	^ Smalltalk ui theme! !

!GraphicFontSettings class methodsFor: 'fonts' stamp: 'StephaneDucasse 11/11/2014 18:41'!
standardFontsSettingsOn: aBuilder
	<systemsettings>
	(aBuilder group: #standardFonts)
		label: 'Standard fonts';
		target: StandardFonts;
		dialog: [self fontSizeRow];
		parent: #appearance;
		order: 4;
		with: [ 
			(aBuilder setting: #defaultFont)
				order: 1;
				description: 'The default text font' ;
				dialog: (MessageSend receiver: self selector: #resetAllFontToDefaultButton);
				label: 'Default'.
			(aBuilder setting: #codeFont) 
				description: 'The standard code font' ;
				label: 'Code' translated.
			(aBuilder setting: #listFont)
				description: 'The standard list font' ;
				label: 'List' translated.
			(aBuilder setting: #menuFont)
				description: 'The standard menu font' ;
				label: 'Menu' .
			(aBuilder setting: #buttonFont)
				description: 'The standard button font' ;
				label: 'Button' .
			(aBuilder setting: #windowTitleFont)
				description: 'The standard window title font' ;
				label: 'Window title' .
			(aBuilder setting: #balloonFont)
				description: 'The standard balloon-help font' ;
				label: 'Balloon-help' .
			(aBuilder setting: #haloFont)
				description: 'The morphic halo font' ;
				label: 'Morphic halo' ]
				
				! !

!GreekEnvironment commentStamp: '<historical>'!
This class provides the support for Greek.  It is here, but most of the methods are not implemented yet.
!
!GreekEnvironment class methodsFor: 'subclass responsibilities' stamp: 'cami 7/22/2013 18:26'!
systemConverterClass

	Smalltalk os isWin32
		ifTrue: [^CP1253TextConverter ].
	^ ISO88597TextConverter.
! !

!GreekEnvironment class methodsFor: 'subclass responsibilities' stamp: 'mir 7/1/2004 18:23'!
supportedLanguages
	"Return the languages that this class supports. 
	Any translations for those languages will use this class as their environment."
	
	^#('el' )! !

!GreekEnvironment class methodsFor: 'class initialization' stamp: 'StephaneDucasse 8/22/2013 14:32'!
initialize

	EncodedCharSet declareEncodedCharSet: self atIndex: 13+1.! !

!GreekEnvironment class methodsFor: 'subclass responsibilities' stamp: 'nice 5/1/2011 19:22'!
leadingChar

	^0! !

!GroupAlreadyExists commentStamp: '<historical>'!
A GroupAreadyExists is an exception raised when a group with the provided name already exists!
!GroupAlreadyExists methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/24/2013 14:34'!
groupName: anObject
	groupName := anObject! !

!GroupAlreadyExists methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/24/2013 14:34'!
groupName
	^ groupName! !

!GroupAlreadyExists class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 1/24/2013 14:35'!
groupName: groupName

	^ self new
		groupName: groupName;
		yourself! !

!GroupAnnouncer commentStamp: 'TorstenBergmann 2/4/2014 21:10'!
Announcer for group announcements!
!GroupAnnouncer class methodsFor: 'instance creation' stamp: 'NicolaiHess 9/30/2014 21:26'!
uniqueInstance
	"Answer a system annoncer."
	
	^ announcer ifNil: [ announcer := self new ]! !

!GroupAnnouncer class methodsFor: 'initialization' stamp: 'NicolaiHess 9/30/2014 21:26'!
reset
	announcer := nil.! !

!GroupCreatorTreeModel commentStamp: 'TorstenBergmann 2/4/2014 21:13'!
Tree model for group creation in Nautilus!
!GroupCreatorTreeModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 3/15/2011 13:44'!
groups

	^ self model groups! !

!GroupCreatorTreeModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/15/2011 13:39'!
model

	^ model! !

!GroupCreatorTreeModel methodsFor: 't - accessing' stamp: 'BenjaminVanRyseghem 3/15/2011 13:43'!
rootNodeClassFromItem: anItem

	^ GroupNode! !

!GroupCreatorTreeModel methodsFor: 't - accessing' stamp: 'AlainPlantec 10/18/2013 10:35'!
selection

	| list |
	list := self rootItems.
	(list notEmpty and: [ super selection isNil ])
		ifTrue: [	self hardlySelectItem: list first ].
	^ super selection! !

!GroupCreatorTreeModel methodsFor: 't - accessing' stamp: 'BenjaminVanRyseghem 9/15/2011 09:58'!
rootItems
	
	^ self groups! !

!GroupCreatorTreeModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/18/2011 15:26'!
groupsManager

	^ self model groupsManager! !

!GroupCreatorTreeModel methodsFor: 't - accessing' stamp: 'BenjaminVanRyseghem 3/15/2011 14:18'!
selection: aNode

	super selection: aNode.
	self model updateSelectedNode.! !

!GroupCreatorTreeModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/15/2011 16:50'!
hardlySelectItem: anItem

	self selectNodePath: ((self setSelectedNodeItem: anItem)collect:#complexContents)! !

!GroupCreatorTreeModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/15/2011 13:39'!
model: anObject

	model := anObject! !

!GroupCreatorTreeModel methodsFor: 't - accessing' stamp: 'BenjaminVanRyseghem 9/15/2011 16:34'!
setSelectedNodeItem: anItem

	^ self model setSelectedNodeItem: anItem! !

!GroupHolder commentStamp: '<historical>'!
A GroupsHolder is a simple object which manage a collection of groups!
!GroupHolder methodsFor: 'adding' stamp: 'BenjaminVanRyseghem 1/24/2013 14:33'!
addAGroup: aGroup

	(self includesAGroupNamed: aGroup name)
		ifTrue: [ 
			self openError: aGroup name.
			^ nil].
	self groups add: aGroup.
	GroupAnnouncer uniqueInstance announce: ( AGroupHasBeenAdded group: aGroup into: self ).! !

!GroupHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 1/24/2013 14:33'!
renameAGroup: aGroup

	| entry |
	entry := UIManager default request: 'New name of the group' initialAnswer: aGroup name title: 'Rename a group'.
	(entry isNil or: [entry isEmpty]) ifTrue: [^ aGroup].
	(self includesAGroupNamed: entry)
		ifTrue: [ ^ self openError: entry ].
	aGroup isReadOnly
		ifTrue: [ ^ self openReadOnlyError ].
	aGroup name: entry.
	GroupAnnouncer uniqueInstance announce: ( AGroupHasBeenRenamed group: aGroup from: self ).
	^ aGroup	
! !

!GroupHolder methodsFor: 'dynamic group' stamp: 'BenjaminVanRyseghem 3/2/2012 17:32'!
addAnEmptyDynamicGroupNamed: aName

	^ (self addADynamicGroupNamed: aName block: [ {} ])
			isFillable: true;
			yourself! !

!GroupHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 3/18/2011 14:37'!
includesAGroupNamed: aName

	^ self groupsNames includes: aName! !

!GroupHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 3/2/2012 17:24'!
addClasses: aCollection into: aGroup 
	
	aGroup addClasses: aCollection! !

!GroupHolder methodsFor: 'dynamic group' stamp: 'BenjaminVanRyseghem 2/27/2012 23:35'!
addADynamicGroupSilentlyNamed: entry blocks: aCollection 
	
	(self includesAGroupNamed: entry)
		ifTrue: [ ^ nil ]
		ifFalse: [ | group |
			group := self groups
						add: 
							(DynamicGroup 
								named: entry 
								blocks: aCollection).
			^ group]! !

!GroupHolder methodsFor: 'protocol' stamp: 'MarianoMartinezPeck 8/5/2012 15:56'!
removeAGroupSilently: aGroup

	| group |
	aGroup ifNil: [ ^ self ].
	 aGroup removable
		ifFalse: [ ^ self openReadOnlyError ].
	group :=  self groups remove: aGroup ifAbsent: [].
	GroupAnnouncer uniqueInstance announce: ( AGroupHasBeenRemoved group: aGroup from: self ).
	^ group! !

!GroupHolder methodsFor: 'adding' stamp: 'BenjaminVanRyseghem 3/28/2011 14:04'!
add: aCollection into: aGroup

	aGroup
		ifAllowed: [ aGroup addAll: aCollection ]
		ifNot: [ self openReadOnlyError ]! !

!GroupHolder methodsFor: 'dynamic group' stamp: 'BenjaminVanRyseghem 1/24/2013 14:32'!
addADynamicClassGroupNamed: entry block: aBlock 
	
	(self includesAGroupNamed: entry)
		ifTrue: [ 
			self openError: entry.
			^ nil]
		ifFalse: [ | group |
			group := self groups
						add: 
							(DynamicClassGroup 
								named: entry 
								block: aBlock).
								
			GroupAnnouncer uniqueInstance announce: ( AGroupHasBeenAdded group: group into: self ).
			^ group]! !

!GroupHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 3/18/2011 16:58'!
remove: aClass from: aGroup

	^ aGroup
		ifAllowed: [ aGroup remove: aClass ]
		ifNot: [ self openReadOnlyError ]! !

!GroupHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 3/18/2011 14:32'!
groupsNames

	^ self groups collect: [:group | group name ]! !

!GroupHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 3/28/2011 17:22'!
removeAGroup: aGroup

	| yesIWantToRemoveTheGroup |
	yesIWantToRemoveTheGroup := self openRemoveDialogOn: aGroup.
	yesIWantToRemoveTheGroup
		ifFalse: [ ^ nil ].
	^ self removeAGroupSilently: aGroup
! !

!GroupHolder methodsFor: 'windows' stamp: 'BenjaminVanRyseghem 3/22/2011 18:15'!
openRemoveDialogOn: aGroup

	^UIManager default confirm: ('Dou you really want to delete the group named ', aGroup name)! !

!GroupHolder methodsFor: 'dynamic group' stamp: 'BenjaminVanRyseghem 1/24/2013 14:32'!
addADynamicClassGroupNamed: entry blocks: aCollection 
	
	(self includesAGroupNamed: entry)
		ifTrue: [ 
			self openError: entry.
			^ nil]
		ifFalse: [ | group |
			group := self groups
						add: 
							(DynamicClassGroup 
								named: entry 
								blocks: aCollection).

			GroupAnnouncer uniqueInstance announce: ( AGroupHasBeenAdded group: group into: self ).
			^ group]! !

!GroupHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 8/21/2011 11:06'!
isEmpty

	^ self groups isEmpty.! !

!GroupHolder methodsFor: 'dynamic group' stamp: 'BenjaminVanRyseghem 1/24/2013 14:33'!
addADynamicGroupNamed: entry blocks: aCollection 
	
	(self includesAGroupNamed: entry)
		ifTrue: [ 
			self openError: entry.
			^ nil]
		ifFalse: [ | group |
			group := self groups
						add: 
							(DynamicGroup 
								named: entry 
								blocks: aCollection).

			GroupAnnouncer uniqueInstance announce: ( AGroupHasBeenAdded group: group into: self ).
			^ group]! !

!GroupHolder methodsFor: 'dynamic group' stamp: 'BenjaminVanRyseghem 2/27/2012 23:35'!
addADynamicClassGroupSilentlyNamed: entry blocks: aCollection 
	
	(self includesAGroupNamed: entry)
		ifTrue: [ ^ nil ]
		ifFalse: [ | group |
			group := self groups
						add: 
							(DynamicClassGroup 
								named: entry 
								blocks: aCollection).
			^ group]! !

!GroupHolder methodsFor: 'dynamic group' stamp: 'BenjaminVanRyseghem 1/24/2013 14:32'!
addADynamicGroupNamed: entry block: aBlock 
	
	(self includesAGroupNamed: entry)
		ifTrue: [ 
			self openError: entry.
			^ nil]
		ifFalse: [ | group |
			group := self groups
						add: 
							(DynamicGroup 
								named: entry 
								block: aBlock).
								
			GroupAnnouncer uniqueInstance announce: ( AGroupHasBeenAdded group: group into: self ).
			^ group]! !

!GroupHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 4/14/2011 16:00'!
includes: aGroup

	^ self groups includes: aGroup! !

!GroupHolder methodsFor: 'windows' stamp: 'BenjaminVanRyseghem 3/22/2011 18:14'!
openReadOnlyError

	UIManager default  alert: 'This group is read only' title: 'Access error'! !

!GroupHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 3/1/2012 00:55'!
removeClass: aClass from: aStaticGroup 
	
	^ aStaticGroup
		ifAllowed: [ aStaticGroup removeClass: aClass ]
		ifNot: [ self openReadOnlyError ]! !

!GroupHolder methodsFor: 'dynamic group' stamp: 'BenjaminVanRyseghem 2/27/2012 23:35'!
addADynamicGroupSilentlyNamed: entry block: aBlock 
	
	(self includesAGroupNamed: entry)
		ifTrue: [ ^ nil ]
		ifFalse: [ | group |
			group := self groups
						add: 
							(DynamicGroup 
								named: entry 
								block: aBlock).
			^ group]! !

!GroupHolder methodsFor: 'adding' stamp: 'BenjaminVanRyseghem 3/2/2012 17:16'!
createAnEmptyStaticGroup

	| entry |
	entry := UIManager default request: 'Name of the new group:' initialAnswer: '' title: 'Create a new group'.
	^ (entry isNil or: [entry isEmpty])
		ifFalse: [ self addAnEmptyDynamicGroupNamed: entry ]! !

!GroupHolder methodsFor: 'protocol' stamp: 'EstebanLorenzano 10/10/2013 13:13'!
groupNamed: aString
	^ self groups detect: [:each | each name = aString]! !

!GroupHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 3/18/2011 14:54'!
sort: aBlock

	^ groups := self groups sort: aBlock! !

!GroupHolder methodsFor: 'windows' stamp: 'BenjaminVanRyseghem 1/24/2013 14:40'!
openError: name

	(GroupAlreadyExists groupName: name) signal! !

!GroupHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 3/18/2011 15:04'!
groups

	^  groups ifNil: [ groups := OrderedCollection new ]! !

!GroupHolder methodsFor: 'dynamic group' stamp: 'BenjaminVanRyseghem 2/27/2012 23:34'!
addADynamicClassGroupSilentlyNamed: entry block: aBlock 
	
	(self includesAGroupNamed: entry)
		ifTrue: [ ^ nil ]
		ifFalse: [ | group |
			group := self groups
						add: 
							(DynamicClassGroup 
								named: entry 
								block: aBlock).
			^ group]! !

!GroupNode commentStamp: 'TorstenBergmann 2/4/2014 21:13'!
A group node in the morph tree!
!GroupNode methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/18/2011 15:29'!
rowMorphForColumn: aTreeColumn

	^ self item ifNotNil: [:i | i name asMorph] ! !

!GroupNode methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 3/15/2011 14:07'!
isGroup

	^ true! !

!GroupNode methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/18/2011 15:27'!
childrenItems

	^ self item elements! !

!GroupNode methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/15/2011 13:46'!
childNodeClassFromItem: anItem

	^ ItemNode! !

!GroupWindowMorph commentStamp: 'LaurentLaffont 7/12/2011 23:33'!
I'm a morph where you can drag windows to group them as tabs.

Try:

(GroupWindowMorph new openInWindowLabeled: 'Window organizer') extent: 400@400.!
!GroupWindowMorph methodsFor: 'services' stamp: ''!
questionWithoutCancel: aStringOrText
	"Open a question dialog."

	^self questionWithoutCancel: aStringOrText title: 'Question' translated! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newWindowFor: aModel title: titleString
	"Answer a new window morph."
	
	^self theme
		newWindowIn: self
		for: aModel
		title: titleString! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel
		help: helpText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newColorChooserFor: aModel getColor: getSel setColor: setSel help: helpText
	"Answer a color chooser with the given selectors."

	^self theme
		newColorChooserIn: self
		for: aModel
		getColor: getSel
		setColor: setSel
		getEnabled: nil
		help: helpText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newGroupbox
	"Answer a plain groupbox."

	^self theme
		newGroupboxIn: self! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newColorChooserFor: aModel getColor: getSel setColor: setSel getEnabled: enabledSel help: helpText
	"Answer a color chooser with the given selectors."

	^self theme
		newColorChooserIn: self
		for: aModel
		getColor: getSel
		setColor: setSel
		getEnabled: enabledSel
		help: helpText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newIncrementalSliderFor: aModel getValue: getSel setValue: setSel min: min max: max quantum: quantum getEnabled: enabledSel help: helpText
	"Answer an inremental slider with the given selectors."

	^self theme
		newIncrementalSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: min
		max: max
		quantum: quantum
		getEnabled: enabledSel
		help: helpText! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
deny: aStringOrText
	"Open a denial dialog."

	^self deny: aStringOrText title: 'Access Denied' translated! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newLabelGroup: labelsAndControls font: aFont labelColor: aColor
	"Answer a morph laid out with a column of labels and a column of associated controls.
	Controls having a vResizing value of #spaceFill will
	cause their row to use #spaceFill also, otherwise #shrinkWrap."

	^self theme
		newLabelGroupIn: self
		for: labelsAndControls
		font: aFont
		labelColor: aColor
! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newCloseButton
	"Answer a new close button."

	^self newCloseButtonFor: self ! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newGroupbox: aString
	"Answer a groupbox with the given label."

	^self theme
		newGroupboxIn: self
		label: aString! !

!GroupWindowMorph methodsFor: 'theme' stamp: ''!
theme
	"Answer the ui theme that provides controls."

	^ Smalltalk ui theme! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newSliderFor: aModel getValue: getSel setValue: setSel getEnabled: enabledSel help: helpText
	"Answer a slider with the given selectors."

	^self theme
		newSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: 0
		max: 1
		quantum: nil
		getEnabled: enabledSel
		help: helpText! !

!GroupWindowMorph methodsFor: 'initialization' stamp: 'IgorStasenko 12/19/2012 17:58'!
initialize
	"Add the tab group with an inital workspace."

	super initialize.
	self changeProportionalLayout.
	self tabGroup: self newTabGroup.
	self tabGroup tabSelectorMorph addDependent: self.
	self
		dropEnabled: true;
		addMorph: self tabGroup fullFrame: LayoutFrame identity.
	self tabGroup color: Color transparent.
	! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
fileOpen: title extensions: exts path: path
	"Answer the result of a file open dialog with the given title, extensions to show and path."

	^self 
		fileOpen: title
		extensions: exts
		path: path
		preview: nil! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newButtonFor: aModel getState: stateSel action: actionSel arguments: args getEnabled: enabledSel labelForm: aForm help: helpText
	"Answer a new button."

	^self theme
		newButtonIn: self for: aModel
		getState: stateSel
		action: actionSel
		arguments: args
		getEnabled: enabledSel 
		label: (AlphaImageMorph new image: aForm)
		help: helpText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newPanel
	"Answer a new panel."

	^self theme
		newPanelIn: self! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newPluggableDialogWindow: title
	"Answer a new pluggable dialog with the given content."

	^self
		newPluggableDialogWindow: title
		for: nil! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newSVSelector: aColor help: helpText
	"Answer a saturation-volume selector with the given color."

	^self theme
		newSVSelectorIn: self
		color: aColor
		help: helpText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newListFor: aModel list: listSelector selected: getSelector changeSelected: setSelector help: helpText
	"Answer a list for the given model."

	^self
		newListFor: aModel
		list: listSelector
		selected: getSelector
		changeSelected: setSelector
		getEnabled: nil
		help: helpText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newMenu
	"Answer a new menu."

	^self theme
		newMenuIn: self
		for: self! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
centeredAlert: aStringOrText title: aString configure: aBlock
	"Open an alert dialog.
	Configure the dialog with the 1 argument block
	before opening modally."

	^self theme
		centeredAlertIn: self
		text: aStringOrText
		title: aString
		configure: aBlock! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newMenuFor: aModel
	"Answer a new menu."

	^self theme
		newMenuIn: self
		for: aModel! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newBasicTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel menu: menuSelector
	"Answer a text editor for the given model."

	^self theme
		newBasicTextEditorIn: self
		for: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel
		menu: menuSelector! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newMorphDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel getEnabled: enabledSel useIndex: useIndex help: helpText
	"Answer a morph drop list for the given model."

	^self theme
		newMorphDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		useIndex: useIndex
		help: helpText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newRadioButtonFor: aModel getSelected: getSel setSelected: setSel getEnabled: enabledSel label: stringOrText help: helpText
	"Answer a checkbox (radio button appearance) with the given label."

	^self theme
		newRadioButtonIn: self
		for: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		label: stringOrText
		help: helpText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newStack: controls
	"Answer a morph laid out with a stack of controls."

	^self theme
		newStackIn: self
		for: controls! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newAlphaImage: aForm help: helpText
	"Answer an alpha image morph."

	^self theme
		newAlphaImageIn: self
		image: aForm
		help: helpText! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
chooseFont
	"Answer the result of a font selector dialog."

	^self chooseFont: nil! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newButtonFor: aModel action: actionSel getEnabled: enabledSel label: stringOrText help: helpText
	"Answer a new button."

	^self
		newButtonFor: aModel
		getState: nil
		action: actionSel
		arguments: nil
		getEnabled: enabledSel 
		label: stringOrText
		help: helpText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newBalloonHelp: aTextStringOrMorph for: aMorph corner: cornerSymbol
	"Answer a new balloon help with the given contents for aMorph
	at a given corner."

	^self theme
		newBalloonHelpIn: self
		contents: aTextStringOrMorph
		for: aMorph
		corner: cornerSymbol! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newAlphaSelector: aModel getAlpha: getSel setAlpha: setSel help: helpText
	"Answer an alpha channel selector with the given selectors."

	^self theme
		newAlphaSelectorIn: self
		for: aModel
		getAlpha: getSel
		setAlpha: setSel
		help: helpText! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
message: aStringOrText
	"Open a message dialog."

	^self message: aStringOrText title: 'Information' translated! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel menu: menuSelector
	"Answer a text editor for the given model."

	^self theme
		newTextEditorIn: self
		for: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel
		menu: menuSelector! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newBasicTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel
	"Answer a text editor for the given model."

	^self
		newBasicTextEditorFor: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel
		menu: nil! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
chooseDirectory: title path: path
	"Answer the result of a file dialog with the given title, answer a directory."

	^self theme
		chooseDirectoryIn: self
		title: title
		path: path! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
longMessage: aStringOrText title: aString
	"Open a (long) message dialog."

	^self theme
		longMessageIn: self
		text: aStringOrText
		title: aString! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newCheckboxFor: aModel getSelected: getSel setSelected: setSel getEnabled: enabledSel label: stringOrText help: helpText
	"Answer a checkbox with the given label."

	^self theme
		newCheckboxIn: self
		for: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		label: stringOrText
		help: helpText! !

!GroupWindowMorph methodsFor: 'windows' stamp: 'GaryChambers 6/9/2011 12:35'!
newTabGroup
	"Answer a new tab group."

	^(self newTabGroup: #())
		cornerStyle: #square! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel font: aFont help: helpText
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel
		font: aFont
		help: helpText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newDialogPanel
	"Answer a new main dialog panel."

	^self theme
		newDialogPanelIn: self! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
chooseColor: aColor title: title
	"Answer the result of a color selector dialog with the given title and initial colour."

	^self theme
		chooseColorIn: self
		title: title
		color: aColor! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newCheckboxFor: aModel getSelected: getSel setSelected: setSel label: stringOrText help: helpText
	"Answer a checkbox with the given label."

	^self theme
		newCheckboxIn: self
		for: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: nil
		label: stringOrText
		help: helpText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newCancelButtonFor: aModel
	"Answer a new cancel button."

	^self theme
		newCancelButtonIn: self
		for: aModel! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newButtonFor: aModel getState: stateSel action: actionSel arguments: args getEnabled: enabledSel label: stringOrText help: helpText
	"Answer a new button."

	^self theme
		newButtonIn: self for: aModel
		getState: stateSel
		action: actionSel
		arguments: args
		getEnabled: enabledSel 
		label: stringOrText
		help: helpText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newPluggableDialogWindow: title for: contentMorph
	"Answer a new pluggable dialog with the given content."

	^self theme
		newPluggableDialogWindowIn: self
		title: title
		for: contentMorph! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newOKButton
	"Answer a new OK button."

	^self newOKButtonFor: self! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newGroupbox: aString for: control
	"Answer a groupbox with the given label and control."

	^self theme
		newGroupboxIn: self
		label: aString
		for: control! !

!GroupWindowMorph methodsFor: 'layout' stamp: 'LaurentLaffont 2/16/2012 09:33'!
changePropotionalLayout
	| layout |
	((layout := self layoutPolicy) notNil and:[layout isProportionalLayout])
		ifTrue:[^self]. "already proportional layout"
	self layoutPolicy: ProportionalLayout new.
	self layoutChanged.! !

!GroupWindowMorph methodsFor: 'windows' stamp: 'StephaneDucasse 8/4/2013 17:14'!
onWindowLabelChanged: ann
	self tabGroup relabelPage: ann window with: (self tabLabelFor: ann window)  ! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newFuzzyLabelFor: aModel label: aString getEnabled: enabledSel
	"Answer a new fuzzy label."

	^self theme
		newFuzzyLabelIn: self
		for: aModel
		label: aString
		offset: 1
		alpha: 0.5
		getEnabled: enabledSel! !

!GroupWindowMorph methodsFor: 'dropping/grabbing' stamp: 'PavelKrivaenk 4/19/2012 10:23'!
wantsDroppedMorph: aMorph event: evt
  "Accept if a SystemWindow."
  
  self visible ifFalse: [^ false].
  self dropEnabled ifFalse: [^ false].
  
  (self tabGroup tabSelectorMorph bounds containsPoint: evt position) ifFalse: [^ false].
  
  ^aMorph isSystemWindow! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newYesButton
	"Answer a new Yes button."

	^self newYesButtonFor: self! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel help: helpText entryCompletion: anEntryCompletion
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel
		help: helpText
		entryCompletion: anEntryCompletion! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newEditableDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel addToList: addSel class: aClass default: defaultValue ghostText: ghostText getEnabled: enabledSel useIndex: useIndex help: helpText
	"Answer an editable drop list for the given model."

	^self theme
		newEditableDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		addToList: addSel
		class: aClass
		default: defaultValue
		ghostText: ghostText
		getEnabled: enabledSel
		useIndex: useIndex
		help: helpText! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
chooseColor
	"Answer the result of a color selector dialog ."

	^self chooseColor: Color black! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newMorphDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel help: helpText
	"Answer a morph drop list for the given model."

	^self 
		newMorphDropListFor: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: nil
		useIndex: true
		help: helpText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newListFor: aModel list: listSelector selected: getSelector changeSelected: setSelector icon: iconSelector getEnabled: enabledSel help: helpText
	"Answer a list for the given model."

	^self theme
		newListIn: self
		for: aModel
		list: listSelector
		selected: getSelector
		changeSelected: setSelector
		icon: iconSelector
		getEnabled: enabledSel
		help: helpText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newString: aStringOrText font: aFont style: aStyle
	"Answer a new embossed string."

	^self theme
		newStringIn: self
		label: aStringOrText
		font: aFont
		style: aStyle! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel 
		help: helpText! !

!GroupWindowMorph methodsFor: 'windows' stamp: 'BernardoContreras 10/4/2014 16:23'!
addWindow: aSystemWindow
  "Add an existing window to the pages."

	|tab|
	SystemWindow topWindow = aSystemWindow
		ifTrue: [SystemWindow passivateTopWindow].
	self tabGroup
		addPage: aSystemWindow configureForEmbedding
		label: (self tabLabelFor: aSystemWindow);
		selectedPageIndex: self tabGroup pages size.
	self isActive ifFalse: [self tabGroup selectedTab passivate].
	tab := self tabGroup selectedTab.
	tab
		on: #startDrag
		send: #dragTab:event:in:
		to: self
		withValue: aSystemWindow.
	aSystemWindow announcer
		when: WindowLabelled 
		send: #onWindowLabelChanged:
		to: self! !

!GroupWindowMorph methodsFor: 'layout' stamp: 'GaryChambers 6/9/2011 13:12'!
acceptDroppingMorph: aSystemWindow event: evt
	"Add the window."

	self addWindow: aSystemWindow! !

!GroupWindowMorph methodsFor: 'windows' stamp: 'StephaneDucasse 8/23/2014 19:47'!
offerWindowMenu
	"Popup the window menu. Fill from current workspace."
	
	| aMenu |
	aMenu := self buildWindowMenu.
	aMenu
		addLine;
		add: 'Grab window...'
		target: self
		selector: #grabWindow.
	aMenu lastItem icon: Smalltalk ui icons smallWindowIcon.
	self tabGroup page ifNotNil: [: page |
		page model addModelItemsToWindowMenu: aMenu].
	aMenu popUpEvent: self currentEvent in: self world! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newMorphDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel getEnabled: enabledSel help: helpText
	"Answer a morph drop list for the given model."

	^self 
		newMorphDropListFor: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		useIndex: true
		help: helpText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel getEnabled: enabledSel useIndex: useIndex help: helpText
	"Answer a drop list for the given model."

	^self theme
		newDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		useIndex: useIndex
		help: helpText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newToolbar
	"Answer a toolbar."

	^self theme
		newToolbarIn: self! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel help: helpText
	"Answer a drop list for the given model."

	^self
		newDropListFor: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: nil
		useIndex: true
		help: helpText! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
chooseFont: aFont 
	"Answer the result of a font selector dialog with the given initial font."

	^self theme
		chooseFontIn: self
		title: 'Font Selector' translated
		font: aFont! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel 
		help: helpText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newCheckboxFor: aModel getSelected: getSel setSelected: setSel getEnabled: enabledSel getLabel: labelSel help: helpText
	"Answer a checkbox with the given label."

	^self theme
		newCheckboxIn: self
		for: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		getLabel: labelSel
		help: helpText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newCloseButtonFor: aModel
	"Answer a new close button."

	^self theme
		newCloseButtonIn: self
		for: aModel! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newVerticalSeparator
	"Answer a vertical separator."

	^self theme
		newVerticalSeparatorIn: self! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
proceed: aStringOrText
	"Open a proceed dialog."

	^self proceed: aStringOrText title: 'Proceed' translated! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
fileSave: title path: path
	"Answer the result of a file save open dialog with the given title."

	^self
		fileSave: title
		extensions: nil
		path: path! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newHSVASelector: aColor help: helpText
	"Answer a hue-saturation-volume selector with the given color."

	^self theme
		newHSVASelectorIn: self
		color: aColor
		help: helpText! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
deny: aStringOrText title: aString
	"Open a denial dialog."

	^self theme
		denyIn: self
		text: aStringOrText
		title: aString! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newScrollPaneFor: aMorph
	"Answer a new scroll pane morph to scroll the given morph."
	
	^self theme
		newScrollPaneIn: self
		for: aMorph! !

!GroupWindowMorph methodsFor: 'dropping/grabbing' stamp: 'GaryChambers 6/10/2011 14:02'!
dragTab: aSystemWindow event: anEvent in: aTabLabel
	"Drag a tab. Remove the window from the organiser and place in hand."
	
	self removeWindow: aSystemWindow.
	aSystemWindow position: anEvent targetPoint.
	anEvent hand grabMorph: aSystemWindow! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newPluggableDialogWindow
	"Answer a new pluggable dialog."

	^self
		newPluggableDialogWindow: 'Dialog'! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
alert: aStringOrText title: aString configure: aBlock
	"Open an alert dialog.
	Configure the dialog with the 1 argument block
	before opening modally."

	^self theme
		alertIn: self
		text: aStringOrText
		title: aString
		configure: aBlock! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
chooseColor: aColor 
	"Answer the result of a color selector dialog with the given color."

	^self theme
		chooseColorIn: self
		title: 'Colour Selector' translated
		color: aColor! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newOKButtonFor: aModel
	"Answer a new OK button."

	^self
		newOKButtonFor: aModel
		getEnabled: nil! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newButtonLabelFor: aModel label: aString getEnabled: enabledSel
	"Answer a new button text label."

	^self theme
		newButtonLabelIn: self
		for: aModel
		label: aString
		getEnabled: enabledSel! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newCancelButton
	"Answer a new cancel button."

	^self newCancelButtonFor: self! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newString: aStringOrText style: aStyle
	"Answer a new embossed string."

	^self theme
		newStringIn: self
		label: aStringOrText
		font: self theme labelFont
		style: aStyle! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newHueSelector: aModel getHue: getSel setHue: setSel help: helpText
	"Answer a hue selector with the given selectors."

	^self theme
		newHueSelectorIn: self
		for: aModel
		getHue: getSel
		setHue: setSel
		help: helpText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newEditableDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel addToList: addSel ghostText: ghostText getEnabled: enabledSel help: helpText
	"Answer an editable drop list for the given model."

	^self theme
		newEditableDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		addToList: addSel
		class: String
		default: ''
		ghostText: ghostText
		getEnabled: enabledSel
		useIndex: false
		help: helpText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newGroupboxFor: control
	"Answer a plain groupbox with the given control."

	^self theme
		newGroupboxIn: self
		for: control! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newOverflowRowForAll: aCollectionOfMorphs
	"Answer a new overflow row morph that provides a drop down for
	the given contents that are unable to fit the bounds."
	
	^self theme
		newOverflowRowIn: self
		forAll: aCollectionOfMorphs! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newEmbeddedMenu
	"Answer a new menu."

	^self theme
		newEmbeddedMenuIn: self
		for: self! !

!GroupWindowMorph methodsFor: 'initialize' stamp: 'PeterUhnak 8/16/2014 09:15'!
defaultColor
	^ self theme windowColor lighter! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newSliderFor: aModel getValue: getSel setValue: setSel help: helpText
	"Answer a slider with the given selectors."

	^self theme
		newSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: 0
		max: 1
		quantum: nil
		getEnabled: nil
		help: helpText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newButtonFor: aModel getState: stateSel action: actionSel arguments: args getEnabled: enabledSel getLabel: labelSel help: helpText
	"Answer a new button."

	^self theme
		newButtonIn: self for: aModel
		getState: stateSel
		action: actionSel
		arguments: args
		getEnabled: enabledSel 
		getLabel: labelSel
		help: helpText! !

!GroupWindowMorph methodsFor: 'windows' stamp: 'GaryChambers 6/10/2011 14:06'!
tabLabelFor: aSystemWindow
	"Answer the tab label to use for the given page."

	^self newRow: {
		 (self newButtonLabel: (aSystemWindow labelString truncateWithElipsisTo: 40))
			setBalloonText: aSystemWindow labelString.
		 self
			newCloseControlFor: nil
			action: [self removeWindow: aSystemWindow]
			help: 'Close this tab and free the window'}! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
fileOpen: title
	"Answer the result of a file open dialog with the given title."

	^self
		fileOpen: title
		extensions: nil! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
message: aStringOrText title: aString
	"Open a message dialog."

	^self theme
		messageIn: self
		text: aStringOrText
		title: aString! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newTabGroup: labelsAndPages
	"Answer a tab group with the given tab labels associated with pages."

	^self theme
		newTabGroupIn: self
		for: labelsAndPages! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newMorphListFor: aModel list: listSelector getSelected: getSelector setSelected: setSelector getEnabled: enabledSel help: helpText
	"Answer a morph list for the given model."

	^self theme
		newMorphListIn: self
		for: aModel
		list: listSelector
		getSelected: getSelector
		setSelected: setSelector
		getEnabled: enabledSel
		help: helpText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newNoButtonFor: aModel
	"Answer a new No button."

	^self theme
		newNoButtonIn: self
		for: aModel! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel font: aFont help: helpText entryCompletion: anEntryCompletion
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel
		font: aFont
		help: helpText
		entryCompletion: anEntryCompletion
! !

!GroupWindowMorph methodsFor: 'updating' stamp: 'LaurentLaffont 7/12/2011 23:00'!
update: aSymbol with: anObject
	"Handle tab changes."

	super update: aSymbol.
	aSymbol == #selectedIndex
		ifTrue: [ |selectedPage|
				selectedPage := self tabGroup pages at: anObject ifAbsent: [nil].
				selectedPage ifNotNil: [
						selectedPage rememberKeyboardFocus: ActiveHand keyboardFocus.
						self tabGroup page ifNotNil: [self tabGroup page activate].]
				]! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newBasicTextEditorFor: aModel getText: getSel setText: setSel
	"Answer a text editor for the given model."

	^self
		newBasicTextEditorFor: aModel
		getText: getSel
		setText: setSel
		getEnabled: nil! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newImage: aForm size: aPoint
	"Answer a new image."

	^self theme
		newImageIn: self
		form: aForm
		size: aPoint! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
textEntry: aStringOrText title: aString entryText: defaultEntryText
	"Open a text entry dialog."

	^self theme
		textEntryIn: self
		text: aStringOrText
		title: aString
		entryText: defaultEntryText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newImage: aForm
	"Answer a new image."

	^self theme
		newImageIn: self
		form: aForm! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
chooseDropList: aStringOrText list: aList
	"Open a drop list chooser dialog."

	^self
		chooseDropList: aStringOrText
		title: 'Choose' translated
		list: aList! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newImageFor: aModel get: getSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newImageIn: self
		for: aModel
		get: getSel
		help: helpText! !

!GroupWindowMorph methodsFor: 'testing' stamp: 'LaurentLaffont 7/5/2011 23:37'!
isActive
	^ false! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
alert: aStringOrText title: aString
	"Open an alert dialog."

	^self
		alert: aStringOrText
		title: aString
		configure: [:d | ]! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
alert: aStringOrText
	"Open an alert dialog."

	^self alert: aStringOrText title: 'Alert' translated! !

!GroupWindowMorph methodsFor: 'accessing' stamp: 'GaryChambers 6/9/2011 12:36'!
tabGroup: anObject

	tabGroup := anObject! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
proceed: aStringOrText title: aString
	"Open a proceed dialog and answer true if not cancelled, false otherwise."

	^self theme
		proceedIn: self
		text: aStringOrText
		title: aString! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel
	"Answer a text editor for the given model."

	^self theme
		newAutoAcceptTextEditorIn: self
		for: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newBalloonHelp: aTextStringOrMorph for: aMorph
	"Answer a new balloon help with the given contents for aMorph
	at a given corner."

	^self theme
		newBalloonHelpIn: self
		contents: aTextStringOrMorph
		for: aMorph
		corner: #bottomLeft! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newTreeFor: aModel list: listSelector selected: getSelector changeSelected: setSelector
	"Answer a new tree morph."
	
	^self theme
		newTreeIn: self
		for: aModel
		list: listSelector
		selected: getSelector
		changeSelected: setSelector! !

!GroupWindowMorph methodsFor: 'windows' stamp: 'EstebanLorenzano 7/6/2012 17:51'!
removeWindow: aSystemWindow
	"Remove a window from the pages."

	aSystemWindow announcer unsubscribe: self.
	self tabGroup removePage: aSystemWindow.
	aSystemWindow configureForUnembedding.
	"self world addMorph: aSystemWindow"
	aSystemWindow delete.
	self tabGroup pages size = 0 
		ifTrue: [ self owner delete ]! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
abort: aStringOrText
	"Open an error dialog."

	^self abort: aStringOrText title: 'Error' translated! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newColorPresenterFor: aModel getColor: getSel help: helpText
	"Answer a color presenter with the given selectors."

	^self theme
		newColorPresenterIn: self
		for: aModel
		getColor: getSel
		help: helpText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newBracketSliderFor: aModel getValue: getSel setValue: setSel min: minValue max: maxValue quantum: quantum getEnabled: enabledSel help: helpText
	"Answer a bracket slider with the given selectors."

	^self theme
		newBracketSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: minValue
		max: maxValue
		quantum: quantum
		getEnabled: enabledSel
		help: helpText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newButtonFor: aModel action: actionSel label: stringOrText help: helpText
	"Answer a new button."

	^self
		newButtonFor: aModel
		getState: nil
		action: actionSel
		arguments: nil
		getEnabled: nil 
		label: stringOrText
		help: helpText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newOKButtonFor: aModel getEnabled: enabledSel
	"Answer a new OK button."

	^self theme
		newOKButtonIn: self
		for: aModel
		getEnabled: enabledSel! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newMorphListFor: aModel list: listSelector getSelected: getSelector setSelected: setSelector help: helpText
	"Answer a morph list for the given model."

	^self
		newMorphListFor: aModel
		list: listSelector
		getSelected: getSelector
		setSelected: setSelector
		getEnabled: nil
		help: helpText! !

!GroupWindowMorph methodsFor: 'testing' stamp: 'LaurentLaffont 7/12/2011 23:00'!
isWindowActive: aSystemWindow
	"Answer whether the given window is active.
	True if the receiver is active and the window is the
	current page."
	
	^ self tabGroup page == aSystemWindow and: [aSystemWindow topWindow == aSystemWindow]! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel font: aFont help: helpText
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel
		font: aFont
		help: helpText
! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newText: aStringOrText
	"Answer a new text."

	^self theme
		newTextIn: self
		text: aStringOrText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel getEnabled: enabledSel help: helpText
	"Answer a drop list for the given model."

	^self theme
		newDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		useIndex: true
		help: helpText! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
fileSave: title extensions: exts path: path
	"Answer the result of a file save dialog with the given title, extensions to show and path."

	^self theme
		fileSaveIn: self
		title: title
		extensions: exts
		path: path! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newLabelFor: aModel label: aString getEnabled: enabledSel
	"Answer a new text label."

	^self theme
		newLabelIn: self
		for: aModel
		label: aString
		getEnabled: enabledSel! !

!GroupWindowMorph methodsFor: 'accessing' stamp: 'GaryChambers 6/9/2011 12:36'!
tabGroup

	^ tabGroup! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel help: helpText entryCompletion: anEntryCompletion

	"Answer a text entry for the given model."

	^self theme
		newTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel 
		help: helpText
		entryCompletion: anEntryCompletion! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newLabel: aString
	"Answer a new text label."

	^self
		newLabelFor: nil
		label: aString
		getEnabled: nil! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel help: helpText entryCompletion: anEntryCompletion
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel
		help: helpText
		entryCompletion: anEntryCompletion! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newNoButton
	"Answer a new No button."

	^self newNoButtonFor: self! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newHSVSelector: aColor help: helpText
	"Answer a hue-saturation-volume selector with the given color."

	^self theme
		newHSVSelectorIn: self
		color: aColor
		help: helpText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel
		help: helpText! !

!GroupWindowMorph methodsFor: 'events-processing' stamp: 'GaryChambers 6/9/2011 13:19'!
handleDropMorph: anEvent
	"Handle a dropping morph."
	
	| aMorph |
	aMorph := anEvent contents.
	"Ignore whether the dropping morph wants to be dropped, just whether the receiver wants it"
	(self wantsDroppedMorph: aMorph event: anEvent)
		ifFalse: [^ self].
	anEvent wasHandled: true.
	self acceptDroppingMorph: aMorph event: anEvent.
	aMorph justDroppedInto: self event: anEvent
! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newLabelGroup: labelsAndControls
	"Answer a morph laid out with a column of labels and a column of associated controls.
	Controls having a vResizing value of #spaceFill will
	cause their row to use #spaceFill also, otherwise #shrinkWrap."

	^self theme
		newLabelGroupIn: self
		for: labelsAndControls! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newRow: controls
	"Answer a morph laid out with a row of controls."

	^self theme
		newRowIn: self
		for: controls! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newTextEditorFor: aModel getText: getSel setText: setSel
	"Answer a text editor for the given model."

	^self
		newTextEditorFor: aModel
		getText: getSel
		setText: setSel
		getEnabled: nil! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newTitle: aString for: control
	"Answer a morph laid out with a column with a title."

	^self theme
		newTitleIn: self
		label: aString
		for: control! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newExpander: aString for: aControl
	"Answer an expander with the given label and control."

	^self theme
		newExpanderIn: self
		label: aString
		forAll: {aControl}! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newMultistateButton
	"Answer a new multistate button morph.
	To be usable it needs to have fill styles assigned to various states along
	with mouse-up/down actions."
	
	^self theme
		newMultistateButtonIn: self! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newColumn: controls
	"Answer a morph laid out with a column of controls."

	^self theme
		newColumnIn: self
		for: controls! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
question: aStringOrText title: aString
	"Open a question dialog and answer true if yes,
	false if no and nil if cancelled."

	^self theme
		questionIn: self
		text: aStringOrText
		title: aString! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newGroupboxForAll: controls
	"Answer a plain groupbox with the given controls."

	^self theme
		newGroupboxIn: self
		forAll: controls! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
fileOpen: title extensions: exts path: path preview: preview
	"Answer the result of a file open dialog with the given title, extensions to show, path and preview type."

	^self theme
		fileOpenIn: self
		title: title
		extensions: exts
		path: path
		preview: preview! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newBracketSliderFor: aModel getValue: getSel setValue: setSel min: minValue max: maxValue quantum: quantum help: helpText
	"Answer a bracket slider with the given selectors."

	^self
		newBracketSliderFor: aModel
		getValue: getSel
		setValue: setSel
		min: minValue
		max: maxValue
		quantum: quantum 
		getEnabled: nil
		help: helpText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newToolDockingBar
	"Answer a tool docking bar."

	^self theme
		newToolDockingBarIn: self! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel font: aFont help: helpText entryCompletion: anEntryCompletion
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel
		font: aFont
		help: helpText
		entryCompletion: anEntryCompletion! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
textEntry: aStringOrText title: aString
	"Open a text entry dialog."

	^self
		textEntry: aStringOrText
		title: aString
		entryText: ''! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel 
	"Answer a text editor for the given model."

	^self 
		newTextEditorFor: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel
		menu: nil! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newTextEntryFor: aModel getText: getSel setText: setSel help: helpText
	"Answer a text entry for the given model."

	^self
		newTextEntryFor: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: nil 
		help: helpText! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
chooseDirectory: title 
	"Answer the result of a file dialog with the given title, answer a directory."

	^self
		chooseDirectory: title
		path: nil! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newLabelFor: aModel getLabel: labelSel getEnabled: enabledSel
	"Answer a new text label."

	^self theme
		newLabelIn: self
		for: aModel
		getLabel: labelSel
		getEnabled: enabledSel! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
fileSave: title extensions: exts
	"Answer the result of a file save dialog with the given title."

	^self
		fileSave: title
		extensions: exts
		path: nil! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newSeparator
	"Answer an horizontal separator."

	^self theme
		newSeparatorIn: self! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newExpander: aString
	"Answer an expander with the given label."

	^self theme
		newExpanderIn: self
		label: aString
		forAll: #()! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
fileSave: title
	"Answer the result of a file save dialog with the given title."

	^self
		fileSave: title
		extensions: nil
		path: nil! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newCloseControlFor: aModel action: aValuable help: helpText
	"Answer a new cancel button."

	^self theme
		newCloseControlIn: self
		for: aModel
		action: aValuable
		help: helpText! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
chooseDropList: aStringOrText title: aString list: aList
	"Open a drop list chooser dialog."

	^self theme
		chooseDropListIn: self
		text: aStringOrText
		title: aString
		list: aList! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newSliderFor: aModel getValue: getSel setValue: setSel min: min max: max quantum: quantum getEnabled: enabledSel help: helpText
	"Answer a slider with the given selectors."

	^self theme
		newSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: min
		max: max
		quantum: quantum
		getEnabled: enabledSel
		help: helpText! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
question: aStringOrText
	"Open a question dialog."

	^self question: aStringOrText title: 'Question' translated! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
textEntry: aStringOrText
	"Open a text entry dialog."

	^self textEntry: aStringOrText title: 'Entry' translated! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newListFor: aModel list: listSelector selected: getSelector changeSelected: setSelector getEnabled: enabledSel help: helpText
	"Answer a list for the given model."

	^self theme
		newListIn: self
		for: aModel
		list: listSelector
		selected: getSelector
		changeSelected: setSelector
		getEnabled: enabledSel
		help: helpText! !

!GroupWindowMorph methodsFor: 'updating' stamp: 'GaryChambers 6/10/2011 15:12'!
update: aSymbol
	"Handle tab changes."

	super update: aSymbol.
	aSymbol == #selectedIndex
		ifTrue: [self tabGroup page activate]! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newString: aStringOrText
	"Answer a new embossed string."

	^self theme
		newStringIn: self
		label: aStringOrText
		font: self theme labelFont
		style: #plain! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newExpander: aString forAll: controls
	"Answer an expander with the given label and controls."

	^self theme
		newExpanderIn: self
		label: aString
		forAll: controls! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
questionWithoutCancel: aStringOrText title: aString
	"Open a question dialog and answer true if yes,
	false if no and nil if cancelled."

	^self theme
		questionWithoutCancelIn: self
		text: aStringOrText
		title: aString! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newButtonLabel: aString
	"Answer a new button text label."

	^self
		newButtonLabelFor: nil
		label: aString
		getEnabled: nil! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newToolbar: controls
	"Answer a toolbar with the given controls."

	^self theme
		newToolbarIn: self
		for: controls! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newGroupbox: aString forAll: controls
	"Answer a groupbox with the given label and controls."

	^self theme
		newGroupboxIn: self
		label: aString
		forAll: controls! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newToolSpacer
	"Answer a tool spacer."

	^self theme
		newToolSpacerIn: self! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newFuzzyLabel: aString
	"Answer a new fuzzy label."

	^self theme
		newFuzzyLabelIn: self
		for: nil
		label: aString
		offset: 1
		alpha: 0.5
		getEnabled: nil! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newRow
	"Answer a morph laid out as a row."

	^self theme
		newRowIn: self
		for: #()! !

!GroupWindowMorph methodsFor: 'windows' stamp: 'GaryChambers 6/9/2011 12:45'!
grabWindow
	"Request an existing window from the user and add it."

	|windows choice|
	windows := self world visibleSystemWindows.
	choice := UIManager default
		chooseFrom: (windows collect: [:e | e labelString])
		values: windows
		lines: #()
		message: 'Choose a window to add to the organiser' translated
		title: 'Grab window' translated.
	choice ifNotNil: [self addWindow: choice]! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
fileOpen: title extensions: exts
	"Answer the result of a file open dialog with the given title and extensions to show."

	^self
		fileOpen: title
		extensions: exts
		path: nil! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newStack
	"Answer a morph laid out as a stack."

	^self theme
		newStackIn: self
		for: #()! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newFuzzyLabelFor: aModel label: aString offset: offset alpha: alpha getEnabled: enabledSel
	"Answer a new fuzzy label."

	^self theme
		newFuzzyLabelIn: self
		for: aModel
		label: aString
		offset: offset
		alpha: alpha
		getEnabled: enabledSel! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
chooseFileName: title extensions: exts path: path preview: preview
	"Answer the result of a file name chooser dialog with the given title, extensions
	to show, path and preview type."

	^self theme
		chooseFileNameIn: self
		title: title
		extensions: exts
		path: path
		preview: preview! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newRadioButtonFor: aModel getSelected: getSel setSelected: setSel label: stringOrText help: helpText
	"Answer a checkbox (radio button appearance) with the given label."

	^self
		newRadioButtonFor: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: nil
		label: stringOrText
		help: helpText! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newYesButtonFor: aModel
	"Answer a new yes button."

	^self theme
		newYesButtonIn: self
		for: aModel! !

!GroupWindowMorph methodsFor: 'controls' stamp: ''!
newToolbarHandle
	"Answer a toolbar handle."

	^self theme
		newToolbarHandleIn: self! !

!GroupWindowMorph methodsFor: 'services' stamp: ''!
abort: aStringOrText title: aString
	"Open an error dialog."

	^self theme
		abortIn: self
		text: aStringOrText
		title: aString! !

!GroupboxMorph commentStamp: 'gvc 5/18/2007 12:36'!
Groupbox with title with a vertical layout. Appears in a lighter colour than the owner's pane colour.!
!GroupboxMorph methodsFor: 'accessing' stamp: 'gvc 4/12/2007 10:49'!
initialColorInSystemWindow: aSystemWindow
	"Answer the colour the receiver should be when added to a SystemWindow."

	^Color transparent! !

!GroupboxMorph methodsFor: 'accessing' stamp: 'gvc 8/19/2006 16:31'!
labelMorph: anObject
	"Set the value of labelMorph"

	labelMorph := anObject! !

!GroupboxMorph methodsFor: 'geometry testing' stamp: 'gvc 8/7/2007 15:34'!
minExtent
	"Answer the minmum extent of the receiver.
	Based on label and rounding."

	^super minExtent max: self labelMorph minExtent + (8@0)! !

!GroupboxMorph methodsFor: 'instance creation' stamp: 'StephaneDucasse 9/7/2013 12:39'!
newContentMorph
	"Answer a new content morph"

	|p|
	p := PanelMorph new
		roundedCorners: self roundedCorners;
		changeTableLayout; 
		layoutInset: 4;
		cellInset: 8;
		vResizing: #spaceFill;
		hResizing: #spaceFill.
	p borderStyle: (self theme groupPanelBorderStyleFor: p).
	^p! !

!GroupboxMorph methodsFor: 'accessing' stamp: 'gvc 8/19/2006 16:31'!
contentMorph: anObject
	"Set the value of contentMorph"

	contentMorph := anObject! !

!GroupboxMorph methodsFor: 'accessing' stamp: 'MarcusDenker 12/11/2009 07:39'!
roundedCorners: anArray
	"Set the corners to round."

	super roundedCorners: anArray.
	self contentMorph ifNotNil: [:cm | cm roundedCorners: self roundedCorners]! !

!GroupboxMorph methodsFor: 'accessing' stamp: 'gvc 1/25/2008 14:39'!
selectedTab
	"Answer the label morph for compatibility with TabPanelBorder."
	
	^self labelMorph owner
		ifNotNil: [self labelMorph]! !

!GroupboxMorph methodsFor: 'accessing' stamp: 'gvc 1/25/2008 14:55'!
adoptPaneColor: paneColor
	"Pass on to the content morph."
	
	|c|
	paneColor ifNil: [^super adoptPaneColor: paneColor].
	c := self theme subgroupColorFrom: paneColor.
	super adoptPaneColor: c.
	self contentMorph borderStyle: (self theme groupPanelBorderStyleFor: self).
	self labelMorph
		color: paneColor blacker muchDarker;
		backgroundColor: c;
		borderStyle: (self theme groupLabelBorderStyleFor: self)! !

!GroupboxMorph methodsFor: 'accessing' stamp: 'gvc 9/8/2006 14:55'!
font: aFont
	"Set the label font"

	self labelMorph font: aFont! !

!GroupboxMorph methodsFor: 'accessing' stamp: 'GaryChambers 7/26/2011 10:13'!
contentFromModel
	"Answer content from the model."
	
	^self getContentSelector ifNotNil: [:s |
		self model ifNotNil: [:m | m perform: s]]! !

!GroupboxMorph methodsFor: 'instance creation' stamp: 'gvc 3/19/2010 16:21'!
newLabelMorph
	"Answer a new label morph"

	^TextMorph new
		roundedCorners: #(1 4);
		margins: (2@1 corner: 2 @ -1);
		contents: 'groupbox';
		vResizing: #shrinkWrap;
		hResizing: #shrinkWrap;
		lock! !

!GroupboxMorph methodsFor: 'initialization' stamp: 'gvc 3/19/2010 16:21'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		roundedCorners: #(2 3 4);
		borderWidth: 0;
		changeTableLayout;
		cellPositioning: #topLeft;
		cellInset: 0 @ -1;
		reverseTableCells: true;
		labelMorph: self newLabelMorph;
		contentMorph: self newContentMorph;
		addMorphBack: self contentMorph;
		addMorphBack: self labelMorph! !

!GroupboxMorph methodsFor: 'accessing' stamp: 'MarcusDenker 12/11/2009 07:39'!
paneColorOrNil
	"Answer the window's pane color or nil otherwise."

	^super paneColorOrNil ifNotNil: [:c | self theme subgroupColorFrom: c]! !

!GroupboxMorph methodsFor: 'accessing' stamp: 'gvc 1/25/2008 14:31'!
label: aString
	"Set the contents of the label morph."

	aString ifNil: [
		self roundedCorners: #(1 2 3 4).
		self labelMorph delete. ^self].
	self roundedCorners: #(2 3 4).
	self labelMorph owner ifNil: [
		self addMorph: self labelMorph].
	self labelMorph contents: aString! !

!GroupboxMorph methodsFor: 'geometry testing' stamp: 'gvc 4/24/2007 10:05'!
containsPoint: aPoint
	"Override here to check the label and content instead."
	
	^(super containsPoint: aPoint) and: [
		(self labelMorph containsPoint: aPoint) or: [
		self contentMorph containsPoint: aPoint]]! !

!GroupboxMorph methodsFor: 'accessing' stamp: 'GaryChambers 7/26/2011 10:11'!
getContentSelector: anObject

	getContentSelector := anObject! !

!GroupboxMorph methodsFor: 'updating' stamp: 'GaryChambers 7/26/2011 10:14'!
update: aSymbol
	"Replace the content if appropriate."
	
	super update: aSymbol.
	aSymbol = self getContentSelector ifTrue: [
		self contentFromModel ifNotNil: [:c | self replaceContentMorph: c]]
		! !

!GroupboxMorph methodsFor: 'adding' stamp: 'gvc 8/20/2006 11:24'!
addContentMorph: aMorph
	"Add a morph to the content."

	^self contentMorph addMorphBack: aMorph! !

!GroupboxMorph methodsFor: 'accessing' stamp: 'gvc 8/19/2006 16:31'!
contentMorph
	"Answer the value of contentMorph"

	^ contentMorph! !

!GroupboxMorph methodsFor: 'rounding' stamp: 'gvc 8/20/2006 11:47'!
cornerStyle: aSymbol
	"Pass on to list too."

	super cornerStyle: aSymbol.
	self labelMorph cornerStyle: aSymbol.
	self contentMorph cornerStyle: aSymbol! !

!GroupboxMorph methodsFor: 'accessing' stamp: 'GaryChambers 7/26/2011 10:11'!
getContentSelector

	^ getContentSelector! !

!GroupboxMorph methodsFor: 'updating' stamp: 'GaryChambers 12/7/2011 15:26'!
replaceContentMorph: aMorph
	"Replace the content."

	self contentMorph
		removeAllMorphs;
		addMorphBack: aMorph.
	self adoptPaneColor: super paneColorOrNil.
	^aMorph
		! !

!GroupboxMorph methodsFor: 'accessing' stamp: 'gvc 8/19/2006 16:31'!
labelMorph
	"Answer the value of labelMorph"

	^ labelMorph! !

!GroupboxMorph methodsFor: 'accessing' stamp: 'gvc 8/20/2006 11:26'!
label
	"Answer the contents of the label morph."

	^self labelMorph contents! !

!GroupboxMorph methodsFor: 'accessing' stamp: 'gvc 9/8/2006 14:55'!
font
	"Answer the label font"

	^self labelMorph font! !

!GroupsAlreadyExist commentStamp: '<historical>'!
A GroupsAlreadyExists is fired when a set of groups already exists

firstGroup points to a correct group which was part of the set!
!GroupsAlreadyExist methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/24/2013 18:11'!
groupName: anObject
	groupName := anObject! !

!GroupsAlreadyExist methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/24/2013 18:11'!
groupName
	^ groupName! !

!GroupsAlreadyExist class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 1/24/2013 18:11'!
groupName: groupName

	^ self new
		groupName: groupName;
		yourself! !

!GrowlMorph commentStamp: 'StephanEggermont 9/5/2014 12:12'!
A GrowlMorph is a little Morph to announce event happening. Freely inspired from the MIT Snarl developed by  Tony Garnock-Jones. 

GrowlMorph new openInWorld.

10 timesRepeat: [
	(GrowlMorph openWithLabel: 'The time' contents: DateAndTime now)
"		vanishDelay: 1000;
		resetVanishTimer".
	World doOneCycle ].

(GrowlMorph openWithLabel: 'The time' contents: DateAndTime now) 
	actionBlock: [Transcript open].!
!GrowlMorph methodsFor: 'stepping' stamp: 'StephaneDucasse 7/19/2011 19:45'!
enabled

	^ false! !

!GrowlMorph methodsFor: 'default' stamp: 'StephaneDucasse 7/16/2011 14:33'!
defaultTextStyle
	^ TextStyle actualTextStyles at: #Accuny! !

!GrowlMorph methodsFor: 'position' stamp: 'BenjaminVanRyseghem 3/2/2012 01:11'!
unoccupiedPosition

	self class position = #bottomLeft
		ifTrue: [ ^ self unoccupiedPositionBottomLeft ].
	self class position = #topRight
		ifTrue: [ ^ self unoccupiedPositionTopRight ].
	self class position = #bottomRight
		ifTrue: [ ^ self unoccupiedPositionBottomRight ].
	self class position = #topLeft
		ifTrue: [ ^ self unoccupiedPositionTopLeft ].
	^ 0@0	
	! !

!GrowlMorph methodsFor: 'initialization' stamp: 'StephaneDucasse 8/7/2011 18:10'!
initializeContentsAttributes
	contentsAttr := TextColor color: self contentsColor.
	! !

!GrowlMorph methodsFor: 'interaction' stamp: 'StephaneDucasse 7/19/2011 19:32'!
handlesMouseDown: evt
	^ actionBlock notNil or: [super handlesMouseDown: evt]! !

!GrowlMorph methodsFor: 'accessing' stamp: 'IgorStasenko 10/13/2013 18:32'!
contentsColor
	^ contentsColor ifNil: [ contentsColor := self theme growlContentsColorFor: self ]
! !

!GrowlMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/19/2012 23:34'!
backgroundColor

	^ backgroundColor ifNil: [ backgroundColor := self defaultBackgroundColor ]! !

!GrowlMorph methodsFor: 'initialization' stamp: 'TudorGirba 8/8/2011 11:32'!
createDismissHandle
	| handle |
	handle := self theme growlDismissHandleFor: self.
	handle on: #mouseUp send: #delete to: self.
	^ handle! !

!GrowlMorph methodsFor: 'internal' stamp: 'StephaneDucasse 7/19/2011 19:12'!
resetAlpha
	^ self alpha: 0.9! !

!GrowlMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 8/7/2011 17:02'!
alpha
	^ alpha
! !

!GrowlMorph methodsFor: 'initialization' stamp: 'tbn 7/10/2012 09:29'!
initialize
	super initialize.
 	self  borderStyle: BorderStyle thinGray.
	
	self setProperty: #autoFitContents toValue: false.
 
	self initializeLabelAttributes.
	self initializeContentsAttributes.
	self vanishDelay: self defaultVanishDelay.
	self label: 'A cool title' contents: 'Here an important message'.
	dismissHandle := self createDismissHandle.
	self addMorph: dismissHandle! !

!GrowlMorph methodsFor: 'position' stamp: 'BenjaminVanRyseghem 3/2/2012 01:09'!
unoccupiedPositionBottomRight

	| delta b morphs |
	delta := 0.
	TaskbarMorph showTaskbar
		ifTrue: [ delta := TaskbarMorph allInstances inject: 0 into: [:s :e | s + e height ]].
	b := (World bottomRight - (self width@ (self height +delta))) extent: self extent.
	morphs := self class allSubInstances select: [:m | m world == World].
	[self is: b saneWithRespectTo: morphs] whileFalse: [
		b := b translateBy: 0@(-10).
		b top < 0 ifTrue: [^ World bottomRight - (self width@ (self height +delta))]].
	^ b origin! !

!GrowlMorph methodsFor: 'position' stamp: 'BenjaminVanRyseghem 3/2/2012 01:11'!
unoccupiedPositionTopLeft

	| b morphs |
	b := World topLeft extent: self extent.
	morphs := self class allSubInstances select: [:m | m world == World].
	[self is: b saneWithRespectTo: morphs] whileFalse: [
		b := b translateBy: 0@10.
		b bottom > World height ifTrue: [^ World topLeft ]].
	^ b origin! !

!GrowlMorph methodsFor: 'default' stamp: 'BenjaminVanRyseghem 3/1/2012 23:35'!
defaultVanishDelay
	
	^ 1  seconds! !

!GrowlMorph methodsFor: 'position' stamp: 'BenjaminVanRyseghem 3/2/2012 01:10'!
unoccupiedPositionBottomLeft

	| delta b morphs |
	delta := 0.
	TaskbarMorph showTaskbar
		ifTrue: [ delta := TaskbarMorph allInstances inject: 0 into: [:s :e | s + e height ]].
	b := (World bottomLeft - (0@ (self height +delta))) extent: self extent.
	morphs := self class allSubInstances select: [:m | m world == World].
	[self is: b saneWithRespectTo: morphs] whileFalse: [
		b := b translateBy: 0@(-10).
		b top < 0 ifTrue: [^ World bottomLeft - (0@ (self height +delta))]].
	^ b origin! !

!GrowlMorph methodsFor: 'stepping' stamp: 'TudorGirba 10/25/2011 17:15'!
stepTime
	^ 100! !

!GrowlMorph methodsFor: 'initialization' stamp: 'StephaneDucasse 8/7/2011 18:10'!
initializeLabelAttributes
	labelAttr := TextColor color: self labelColor.
	! !

!GrowlMorph methodsFor: 'default' stamp: 'TudorGirba 8/8/2011 11:21'!
defaultBackgroundColor

	^ self theme growlFillColorFor: self! !

!GrowlMorph methodsFor: 'accessing' stamp: 'IgorStasenko 10/13/2013 18:47'!
alpha: newAlpha

	"self alpha = newAlpha ifTrue: [^ self]."
	alpha := newAlpha.
	labelAttr color: (self labelColor alpha: alpha).
	contentsAttr color: (self contentsColor alpha: alpha).
	self backgroundColor: (self nextColorStep: self backgroundColor).
	self allMorphsDo: [:m |
		m borderColor: (self nextColorStep: m borderColor).
		m color: (self nextColorStep: m color)].
	self borderColor isTransparent ifTrue: [self delete].! !

!GrowlMorph methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 3/2/2012 00:12'!
contentsAttributes
	^ { contentsAttr. TextAlignment centered. TextFontChange font2. }! !

!GrowlMorph methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 3/2/2012 00:12'!
labelAttributes
	^ { labelAttr. TextAlignment centered. TextFontChange font4. TextEmphasis bold. }! !

!GrowlMorph methodsFor: 'accessing' stamp: 'IgorStasenko 10/13/2013 18:25'!
labelColor
	^ labelColor ifNil: [ labelColor := self theme growlLabelColorFor: self ]! !

!GrowlMorph methodsFor: 'internal' stamp: 'SvenVanCaekenberghe 11/18/2013 16:21'!
resetVanishTimer

	vanishTime := DateAndTime now + self vanishDelay.
	self resetAlpha.! !

!GrowlMorph methodsFor: 'accessing' stamp: 'IgorStasenko 10/13/2013 18:45'!
contentsColor: aColor
	"when you set this contentsColor, it takes precedence over theme one. In certain case (such as for green as in SUnit) it is needed, normally you do not need it."
	contentsColor := aColor.
	contentsAttr color: aColor.
	! !

!GrowlMorph methodsFor: 'accessing' stamp: 'IgorStasenko 10/13/2013 18:43'!
labelColor: aColor
	"when you set this labelColor, it takes precedence over theme one. In certain case (such as for green as in SUnit) it is needed, normally you do not need it."
	labelColor := aColor.
	labelAttr color: self labelColor.! !

!GrowlMorph methodsFor: 'internal' stamp: 'StephaneDucasse 7/19/2011 19:27'!
openInWorld

	self position: self unoccupiedPosition.
	super openInWorld! !

!GrowlMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/1/2012 23:31'!
vanishDelay: aDuration

	vanishDelay := aDuration.
	self resetVanishTimer! !

!GrowlMorph methodsFor: 'building' stamp: 'IgorStasenko 10/13/2013 18:54'!
label: labelString contents: contentsString

	self streamDo: [ :w |
		w withAttributes: self labelAttributes do: [w nextPutAll: labelString asString; cr].
		w withAttributes: self contentsAttributes do: [w nextPutAll: contentsString asString].
		].! !

!GrowlMorph methodsFor: 'stepping' stamp: 'SvenVanCaekenberghe 11/18/2013 16:21'!
step

	(self containsPoint: ActiveHand position) ifTrue: [
		self resetAlpha.
		^ self].
	vanishTime ifNotNil: [DateAndTime now < vanishTime ifTrue: [^self]].
	self alpha: self alpha - 0.05.! !

!GrowlMorph methodsFor: 'default' stamp: 'StephaneDucasse 8/7/2011 18:18'!
minimumExtent
	^ 256@38! !

!GrowlMorph methodsFor: 'default' stamp: 'TudorGirba 8/8/2011 11:22'!
defaultBorderColor
	
	^ self theme growlBorderColorFor: self! !

!GrowlMorph methodsFor: 'stepping' stamp: 'StephaneDucasse 7/19/2011 19:03'!
wantsSteps
	^ true! !

!GrowlMorph methodsFor: 'internal' stamp: 'BenjaminVanRyseghem 3/2/2012 00:10'!
streamDo: aBlock

	self contentsWrapped: (Text streamContents: aBlock).
	self extent: self minimumExtent.
	self height: (paragraph extent y + (self borderWidth * 2) + (margins ifNil: [0] ifNotNil: [margins top + margins bottom]) + 2).

	self vanishDelay: ((((self contents size /50)seconds)+1 seconds) max: self defaultVanishDelay).! !

!GrowlMorph methodsFor: 'interaction' stamp: 'StephaneDucasse 7/19/2011 19:35'!
mouseDown: evt
	super mouseDown: evt.
	evt yellowButtonPressed ifTrue: [^ self].
	actionBlock ifNotNil: [actionBlock valueWithPossibleArgs: { self }].! !

!GrowlMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 7/19/2011 19:01'!
vanishDelay

	^ vanishDelay! !

!GrowlMorph methodsFor: 'building' stamp: 'StephaneDucasse 7/19/2011 18:56'!
contents: contentsString

	self streamDo: [ :w |
		w withAttributes: self contentsAttributes do: [w nextPutAll: contentsString asString]].! !

!GrowlMorph methodsFor: 'internal' stamp: 'StephaneDucasse 7/19/2011 19:28'!
is: rect saneWithRespectTo: morphs
	morphs do: [:m |
		(m owner notNil and: [m bounds intersects: rect]) ifTrue: [^ false]].
	^ true! !

!GrowlMorph methodsFor: 'building' stamp: 'StephaneDucasse 7/19/2011 19:38'!
actionBlock: aBlock

	actionBlock := aBlock! !

!GrowlMorph methodsFor: 'position' stamp: 'BenjaminVanRyseghem 3/2/2012 00:47'!
unoccupiedPositionTopRight

	| b morphs |
	b := (World topRight - (self width @ 0)) extent: self extent.
	morphs := self class allSubInstances select: [:m | m world == World].
	[self is: b saneWithRespectTo: morphs] whileFalse: [
		b := b translateBy: 0@10.
		b bottom > World height ifTrue: [^ (World topRight - (self width @ 0))]].
	^ b origin! !

!GrowlMorph methodsFor: 'initialization' stamp: 'StephaneDucasse 7/19/2011 19:21'!
nextColorStep: aColor
	^ aColor alpha: self alpha! !

!GrowlMorph class methodsFor: 'position' stamp: 'BenjaminVanRyseghem 3/2/2012 01:06'!
possiblePositions

	^ #( bottomRight bottomLeft topRight topLeft )! !

!GrowlMorph class methodsFor: 'instance creation' stamp: 'StephaneDucasse 7/19/2011 19:38'!
openWithLabel: aString contents: contentString
	
	^ (self label: aString contents: contentString) openInWorld! !

!GrowlMorph class methodsFor: 'position' stamp: 'tbn 3/27/2013 01:33'!
position

	^ Position ifNil: [ Position := #topRight ]! !

!GrowlMorph class methodsFor: 'settings' stamp: 'NicolaiHess 11/28/2014 11:35'!
growlSettingsOn: aBuilder
	<systemsettings>
	(aBuilder group: #growl)
		label: 'Growl' translated;  
		parent:#appearance;
		description: 'All settings concerned with the notifications popup look''n feel' translated;
		with: [
			(aBuilder pickOne: #position)
				label: 'Growl position' translated;
				target: self;
				default: #topRight;
				order: 1;
				domainValues: self growlPositionChoices.]! !

!GrowlMorph class methodsFor: 'instance creation' stamp: 'StephaneDucasse 7/19/2011 19:38'!
openWithContents: contentString
	
	^ (self contents: contentString) openInWorld! !

!GrowlMorph class methodsFor: 'instance creation' stamp: 'StephaneDucasse 7/19/2011 19:36'!
contents: contentString
	
	^ self new
		label: '' contents: contentString;
		yourself! !

!GrowlMorph class methodsFor: 'settings' stamp: 'MarcusDenker 11/4/2014 11:46'!
growlPositionChoices

	^#(topRight 'top right' 
		bottomLeft 'bottom left'
		bottomRight 'bottom right'
		topLeft 'topLeft') pairsCollect: [:a :b | b -> a]! !

!GrowlMorph class methodsFor: 'position' stamp: 'BenjaminVanRyseghem 3/2/2012 01:05'!
position: aSymbol

	(self possiblePositions includes: aSymbol) ifFalse: [ ^ self ].

	Position := aSymbol! !

!GrowlMorph class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 4/19/2012 23:36'!
openWithLabel: aString contents: contentString color: aColor
	
	^ (self label: aString contents: contentString)
			backgroundColor: aColor;
			openInWorld! !

!GrowlMorph class methodsFor: 'instance creation' stamp: 'StephaneDucasse 7/19/2011 19:17'!
label: aString contents: contentString
	
	^ self new
		label: aString contents: contentString;
		yourself! !

!GrowlMorph class methodsFor: 'instance creation' stamp: 'IgorStasenko 10/13/2013 18:33'!
openWithLabel: aString contents: contentString backgroundColor: aColor labelColor: aLabelColor
	
	^ (self label: aString contents: contentString)
			backgroundColor: aColor;
			labelColor: aLabelColor;
			contentsColor: aLabelColor; 
			openInWorld! !

!GuideTest commentStamp: 'TorstenBergmann 1/31/2014 11:43'!
Common superclass for tests of guidance through the filesystem!
!GuideTest methodsFor: 'asserting' stamp: 'cwp 11/16/2009 10:46'!
assertVisitedIs: anArray
	visited with: anArray do:
		[:entry :basename | 
		self assert: entry reference basename = basename]! !

!GuideTest methodsFor: 'visitor' stamp: 'cwp 10/29/2009 21:54'!
visitFile: aReference
	visited add: aReference.! !

!GuideTest methodsFor: 'running' stamp: 'EstebanLorenzano 4/2/2012 11:43'!
setUp
	visited := OrderedCollection new.
	filesystem := FileSystem memory.
	self setUpGreek! !

!GuideTest methodsFor: 'visitor' stamp: 'cwp 10/29/2009 21:54'!
visitDirectory: aReference
	visited add: aReference.! !

!GuideTest class methodsFor: 'testing' stamp: 'EstebanLorenzano 4/3/2012 09:43'!
isAbstract
	^ self name = #GuideTest! !

!HColorSelectorMorph commentStamp: 'gvc 5/18/2007 12:58'!
ColorComponentSelector showing a hue rainbow palette.!
!HColorSelectorMorph methodsFor: 'protocol' stamp: 'gvc 9/3/2009 13:44'!
defaultFillStyle
	"Answer the hue gradient."

	^(GradientFillStyle colors: ((0.0 to: 359.9 by: 0.1) collect: [:a | Color h: a s: 1.0 v: 1.0]))
		origin: self topLeft;
		direction: (self bounds isWide
					ifTrue: [self width@0]
					ifFalse: [0@self height])! !

!HColorSelectorMorph methodsFor: 'accessing' stamp: 'gvc 9/19/2006 14:13'!
color: aColor
	"Ignore to preserve fill style."
	! !

!HDChangeReport commentStamp: 'TorstenBergmann 2/12/2014 22:31'!
A change report!
!HDChangeReport methodsFor: 'accessing' stamp: 'lr 9/29/2010 13:27'!
resolved
	^ gofer resolved! !

!HDChangeReport methodsFor: 'generating' stamp: 'lr 9/29/2010 13:42'!
generateChangeModification: aPatch on: aStream
	aStream tab; tab; tab; nextPutAll: '<item action="change">'; nextPutAll: (self encode: (self convert: aPatch summary)); nextPutAll: '</item>'; nextPut: Character lf! !

!HDChangeReport methodsFor: 'generating' stamp: 'lr 9/29/2010 13:35'!
generateChange: aPatch on: aStream
	aPatch isAddition
		ifTrue: [ ^ self generateChangeAddition: aPatch on: aStream ].
	aPatch isModification
		ifTrue: [ ^ self generateChangeModification: aPatch on: aStream ].
	aPatch isRemoval
		ifTrue: [ ^ self generateChangeRemoval: aPatch on: aStream ]! !

!HDChangeReport methodsFor: 'generating' stamp: 'lr 9/29/2010 14:07'!
generateChangeSet: aResolvedVersion on: aStream
	| info |
	info := aResolvedVersion version info.
	aStream tab; nextPutAll: '<logentry version="'; nextPutAll: (self encode: info name); nextPutAll: '">'; nextPut: Character lf.
	aStream tab; tab; nextPutAll: '<date>'; nextPutAll: (self encode: info date yyyymmdd); space; nextPutAll: (self encode: info time print24); nextPutAll: '</date>'; nextPut: Character lf.
	aStream tab; tab; nextPutAll: '<author>'; nextPutAll: (self encode: info author); nextPutAll: '</author>'; nextPut: Character lf.
	aStream tab; tab; nextPutAll: '<msg>'; nextPutAll: (self encode: (self convert: info message)); nextPutAll: '</msg>'; nextPut: Character lf.
	"aStream tab; tab; nextPutAll: '<items>'; nextPut: Character lf.
	(self changesFor: aResolvedVersion)
		do: [ :each | self generateChange: each on: aStream ].
	aStream tab; tab; nextPutAll: '</items>'; nextPut: Character lf."
	aStream tab; nextPutAll: '</logentry>'; nextPut: Character lf! !

!HDChangeReport methodsFor: 'generating' stamp: 'lr 9/29/2010 13:42'!
generateChangeAddition: aPatch on: aStream
	aStream tab; tab; tab; nextPutAll: '<item action="add">'; nextPutAll: (self encode: (self convert: aPatch summary)); nextPutAll: '</item>'; nextPut: Character lf! !

!HDChangeReport methodsFor: 'accessing' stamp: 'lr 9/29/2010 13:42'!
changesFor: aResolvedVersion
	| references patch |
	references := gofer allResolved
		select: [ :each | each packageName = aResolvedVersion packageName ].
	patch := MCPatch 
		fromBase: (references size > 1 
			ifTrue: [ (references at: references size - 1) version snapshot ]
			ifFalse: [ MCSnapshot empty ])
		target: aResolvedVersion version snapshot.
	^ patch operations asSortedCollection! !

!HDChangeReport methodsFor: 'running' stamp: 'S 6/17/2013 13:16'!
run
	
	'changelog.xml' asFileReference ensureDelete writeStreamDo: [ :stream|
		self generateOn: stream ]! !

!HDChangeReport methodsFor: 'generating' stamp: 'lr 9/29/2010 13:29'!
generateOn: aStream
	aStream nextPutAll: '<?xml version="1.0" encoding="UTF-8"?>'; nextPut: Character lf.
	aStream nextPutAll: '<changelog>'; nextPut: Character lf.
	self resolved
		do: [ :each | self generateChangeSet: each on: aStream ].
	aStream nextPutAll: '<changelog>'! !

!HDChangeReport methodsFor: 'initialization' stamp: 'lr 9/29/2010 11:22'!
initializeOn: aCollection
	gofer := Gofer new.
	aCollection do: [ :each | gofer package: each ]! !

!HDChangeReport methodsFor: 'generating' stamp: 'lr 9/29/2010 13:41'!
generateChangeRemoval: aPatch on: aStream
	aStream tab; tab; tab; nextPutAll: '<item action="remove">'; nextPutAll: (self encode: (self convert: aPatch summary)); nextPutAll: '</item>'; nextPut: Character lf! !

!HDChangeReport class methodsFor: 'running' stamp: 'lr 9/29/2010 11:13'!
runClasses: aCollectionOfClasses named: aString
	self error: 'The change report is only runnable on packages.'! !

!HDChangeReport class methodsFor: 'running' stamp: 'lr 9/29/2010 11:14'!
runPackages: aCollectionOfStrings
	^ (self new initializeOn: aCollectionOfStrings) run! !

!HDChangeReport class methodsFor: 'running' stamp: 'lr 9/29/2010 11:14'!
runPackage: aString
	^ self runPackages: (Array with: aString)! !

!HDCoverageReport commentStamp: 'TorstenBergmann 2/12/2014 22:31'!
Hudson report for test coverage!
!HDCoverageReport methodsFor: 'private' stamp: 'EstebanLorenzano 1/25/2013 10:11'!
addTestsIn: aTestAsserter to: aSet
	(aTestAsserter isKindOf: TestSuite) ifTrue: [
		aTestAsserter tests
			do: [ :each | self addTestsIn: each to: aSet ] ].
	(aTestAsserter isKindOf: TestCase) ifTrue: [
		(aTestAsserter class respondsTo: #packageNamesUnderTest) ifTrue: [
			aTestAsserter class packageNamesUnderTest
				do: [ :each | aSet add: (RPackage organizer packageNamed: each) ] ] ].
	^ aSet! !

!HDCoverageReport methodsFor: 'generating' stamp: 'lr 7/5/2010 08:24'!
generate
	| coverage |
	covered := (wrappers select: [ :each | each hasRun ])
		collect: [ :each | each reference ].
	coverage := StandardFileStream 
		forceNewFileNamed: suite name , '-Coverage.xml'.
	[ self generateOn: coverage ]
		ensure: [ coverage close ]! !

!HDCoverageReport methodsFor: 'generating' stamp: 'lr 7/5/2010 13:30'!
generateDataOn: aStream
	| items |
	aStream tab; nextPutAll: '<data>'; nextPut: Character lf.
	aStream tab; tab; nextPutAll: '<all name="all classes">'; nextPut: Character lf.
	self
		generateType: 'class' indent: 3
		total: (items := (packages gather: [ :each | each classes ]) asSet) size
		actual: ((covered collect: [ :each | each actualClass theNonMetaClass ]) asSet
			count: [ :each | items includes: each ])
		on: aStream.
	self
		generateType: 'method' indent: 3
		total: (items := (packages gather: [ :each | each methods ]) asSet) size 
		actual: (covered count: [ :each | items includes: each ])
		on: aStream.
	packages do: [ :each | self generatePackage: each on: aStream ].
	aStream tab; tab; nextPutAll: '</all>'; nextPut: Character lf.
	aStream tab; nextPutAll: '</data>'; nextPut: Character lf! !

!HDCoverageReport methodsFor: 'generating' stamp: 'lr 7/5/2010 13:26'!
generatePackage: aPackage class: aClass on: aStream
	| items |
	aStream tab: 4; nextPutAll: '<class name="'; nextPutAll: (self encode: aClass name); nextPutAll: '">'; nextPut: Character lf.
	self
		generateType: 'class' indent: 5
		total: 1
		actual: ((covered anySatisfy: [ :each | each actualClass theNonMetaClass = aClass ])
			ifTrue: [ 1 ] ifFalse: [ 0 ])
		on: aStream.
	self
		generateType: 'method' indent: 5
		total: (items := aPackage coreMethodsForClass: aClass) size
		actual: (covered count: [ :each | items includes: each ])
		on: aStream.
	items do: [ :each | self generatePackage: each method: each on: aStream ].	
	aStream tab: 4; nextPutAll: '</class>'; nextPut: Character lf! !

!HDCoverageReport methodsFor: 'generating' stamp: 'lr 7/5/2010 13:30'!
generatePackage: aPackage on: aStream
	| items |
	aStream tab: 3; nextPutAll: '<package name="'; nextPutAll: (self encode: (aPackage packageName copyReplaceAll: '-' with: '.')); nextPutAll: '">'; nextPut: Character lf.
	self
		generateType: 'class' indent: 4
		total: (items := aPackage classes asSet) size
		actual: ((covered collect: [ :each | each actualClass theNonMetaClass ]) asSet
			count: [ :each | items includes: each ])
		on: aStream.
	self
		generateType: 'method' indent: 4
		total: (items := aPackage methods asSet) size
		actual: (covered count: [ :each | items includes: each ])
		on: aStream.
	aPackage classes 
		do: [ :class | self generatePackage: aPackage class: class on: aStream ].
	aStream tab: 3; nextPutAll: '</package>'; nextPut: Character lf! !

!HDCoverageReport methodsFor: 'generating' stamp: 'lr 7/5/2010 13:08'!
generateStatsOn: aStream
	aStream tab; nextPutAll: '<stats>'; nextPut: Character lf.
	aStream tab; tab; nextPutAll: '<packages value="'; print: (packages size); nextPutAll: '"/>'; nextPut: Character lf.
	aStream tab; tab; nextPutAll: '<classes value="'; print: (packages detectSum: [ :each | each classes size ]); nextPutAll: '"/>'; nextPut: Character lf.
	aStream tab; tab; nextPutAll: '<methods value="'; print: (packages detectSum: [ :each | each methods size ]); nextPutAll: '"/>'; nextPut: Character lf.
	aStream tab; nextPutAll: '</stats>'; nextPut: Character lf.! !

!HDCoverageReport methodsFor: 'private' stamp: 'lr 6/9/2010 10:58'!
ignoredSelectors
	^ #(packageNamesUnderTest classNamesNotUnderTest)! !

!HDCoverageReport methodsFor: 'running' stamp: 'lr 7/5/2010 08:22'!
tearDown
	wrappers do: [ :each | each uninstall ].
	super tearDown.
	self generate! !

!HDCoverageReport methodsFor: 'generating' stamp: 'lr 7/5/2010 13:09'!
generateOn: aStream
	aStream nextPutAll: '<?xml version="1.0" encoding="UTF-8"?>'; nextPut: Character lf.
	aStream nextPutAll: '<report>'; nextPut: Character lf.
	self generateStatsOn: aStream.
	self generateDataOn: aStream.
	aStream nextPutAll: '</report>'; nextPut: Character lf! !

!HDCoverageReport methodsFor: 'running' stamp: 'lr 6/9/2010 19:30'!
setUp
	super setUp.
	wrappers := ((packages := self packagesIn: suite)
		gather: [ :package | self methodsIn: package ])
		collect: [ :each | HDTestCoverage on: each ].
	wrappers do: [ :each | each install ]! !

!HDCoverageReport methodsFor: 'generating' stamp: 'CamilloBruni 7/20/2012 16:35'!
generateType: aString indent: anInteger total: totalInteger actual: actualInteger on: aStream
	aStream tab: anInteger; 
		nextPutAll: '<coverage type="'; nextPutAll: aString; 
		nextPutAll: ', %" value="'; print: (totalInteger = 0 ifTrue: [ 0 ] ifFalse: [ (100.0 * actualInteger / totalInteger) rounded ]); 
		nextPutAll: '% ('; print: actualInteger; nextPut: $/; print: totalInteger; nextPutAll: ')"/>'; 
		nextPut: Character lf! !

!HDCoverageReport methodsFor: 'private' stamp: 'CamilloBruni 8/27/2013 01:40'!
methodsIn: aPackage
	aPackage ifNil: [ ^ #() ].
	^ aPackage methods reject: [ :method | 
		(self ignoredSelectors includes: method selector)
			or: [ method compiledMethod isAbstract
			or: [ method compiledMethod refersToLiteral: #ignoreForCoverage ] ] ]! !

!HDCoverageReport methodsFor: 'private' stamp: 'lr 6/9/2010 10:51'!
packagesIn: aTestAsserter
	^ self addTestsIn: aTestAsserter to: Set new! !

!HDCoverageReport methodsFor: 'generating' stamp: 'lr 7/5/2010 13:28'!
generatePackage: aPackage method: aReference on: aStream
	| items |
	aStream tab: 5; nextPutAll: '<method name="'; nextPutAll: (self encode: aReference selector); nextPutAll: '">'; nextPut: Character lf.
	self
		generateType: 'method' indent: 6
		total: 1
		actual: ((covered includes: aReference) ifTrue: [ 1 ] ifFalse: [ 0 ])
		on: aStream.
	aStream tab: 5; nextPutAll: '</method>'; nextPut: Character lf! !

!HDLintReport commentStamp: 'TorstenBergmann 2/12/2014 22:31'!
Hudson report for lint results!
!HDLintReport methodsFor: 'generating' stamp: 'lr 7/4/2010 21:08'!
generateClass: aClass source: sourceStream on: aStream
	| offset source matching selectors |
	offset := self
		lineAndColumn: sourceStream contents
		at: sourceStream position.
	sourceStream
		nextPutAll: (source := self convert: aClass definition);
		nextPut: Character lf; nextPut: Character lf.
	(environment definesClass: aClass) ifTrue: [
		matching := rules select: [ :rule |
			(self isClassEnvironment: rule result)
				and: [ rule result includesClass: aClass ] ].
		self generateViolations: matching source: source offset: offset on: aStream ].
	(environment selectorsForClass: aClass) asSortedCollection
		do: [ :selector | self generateClass: aClass selector: selector source: sourceStream on: aStream ]! !

!HDLintReport methodsFor: 'testing' stamp: 'lr 5/15/2010 14:05'!
isSelectorEnvironment: anEnvironment
	^ #(SelectorEnvironment ParseTreeEnvironment VariableEnvironment) includes: anEnvironment class name! !

!HDLintReport methodsFor: 'generating' stamp: 'lr 7/4/2010 20:46'!
generateClass: aClass selector: aSelector source: sourceStream on: aStream
	| offset source matching |
	offset := self
		lineAndColumn: sourceStream contents
		at: sourceStream position.
	sourceStream
		nextPutAll: (source := self convert: (aClass sourceCodeAt: aSelector));
		nextPut: Character lf; nextPut: Character lf.
	matching := rules select: [ :each | 
		(self isSelectorEnvironment: each result)
			and: [ each result includesSelector: aSelector in: aClass ] ].
	self generateViolations: matching source: source offset: offset on: aStream! !

!HDLintReport methodsFor: 'generating' stamp: 'MarcusDenker 10/2/2014 12:24'!
generateClass: aClass on: aStream
	| sourceStream sourceName |
	sourceStream := WriteStream on: String new.
	sourceName := environment label , '-' , aClass name , '.st'.
	aStream tab; nextPutAll: '<file name="'; nextPutAll: (self encode: sourceName); nextPutAll: '">'; nextPut: Character lf.
	self generateClass: aClass source: sourceStream on: aStream.
	self generateClass: aClass class source: sourceStream on: aStream.
	aStream tab; nextPutAll: '</file>'; nextPut: Character lf.
	sourceName asFileReference ensureDelete writeStreamDo: [ :stream | 
		stream nextPutAll: sourceStream contents ]! !

!HDLintReport methodsFor: 'accessing' stamp: 'MarcusDenker 4/20/2013 13:36'!
rules
	^rules! !

!HDLintReport methodsFor: 'running' stamp: 'MarcusDenker 10/2/2014 12:22'!
run
	RBSmalllintChecker 
		runRule: (RBCompositeLintRule rules: rules)
		onEnvironment: environment.
		
	(environment label , '-Lint.xml') asFileReference ensureDelete writeStreamDo: [ :stream|
		 self generateOn: stream ]! !

!HDLintReport methodsFor: 'initialization' stamp: 'lr 7/4/2010 22:34'!
initializeOn: anEnvironment
	environment := anEnvironment.
	rules := (RBCompositeLintRule rulesFor: RBBasicLintRule)
		reject: [ :each | each class name endsWith: 'SpellingRule' ]! !

!HDLintReport methodsFor: 'generating' stamp: 'lr 7/4/2010 21:17'!
generateOn: aStream
	aStream nextPutAll: '<?xml version="1.0" encoding="UTF-8"?>'; nextPut: Character lf.
	aStream nextPutAll: '<checkstyle version="5.2">'; nextPut: Character lf.
	(environment allClasses asSortedCollection: [ :a :b | a name <= b name ])
		do: [ :class | self generateClass: class on: aStream ].
	aStream nextPutAll: '</checkstyle>'! !

!HDLintReport methodsFor: 'private' stamp: 'lr 5/14/2010 22:29'!
lineAndColumn: aString at: anInteger
	| line last stream |
	line := 1.
	last := 0.
	stream := aString readStream.
	[ (stream nextLine isNil or: [ anInteger <= stream position ])
		ifTrue: [ ^ line @ (anInteger - last) ].
	last := stream position.
	line := line + 1 ]
		repeat! !

!HDLintReport methodsFor: 'generating' stamp: 'lr 7/4/2010 22:35'!
generateViolations: aCollection source: aString offset: aPoint on: aStream
	aCollection do: [ :rule |
		| interval start |
		interval := (rule result selectionIntervalFor: aString)
			ifNil: [ 1 to: aString size ].
		start := self lineAndColumn: aString at: interval first.
		aStream tab; tab; nextPutAll: '<error'.
		aStream nextPutAll: ' source="'; nextPutAll: (self encode: rule class name); nextPut: $".
		aStream nextPutAll: ' message="'; nextPutAll: (self encode: rule group); nextPutAll: ' - '; nextPutAll: (self encode: rule name); nextPut: $".
		aStream nextPutAll: ' severity="'; nextPutAll: (rule
			severity = #information 
				ifTrue: [ 'info' ]
				ifFalse: [ 
					rule severity = #warning
						ifTrue: [ 'warning' ]
						ifFalse: [ 'error' ] ]); nextPut: $".
		aStream nextPutAll: ' line="'; print: aPoint x + start x; nextPut: $".
		aPoint y + start y - 1 <= 1
			ifFalse: [ aStream nextPutAll: ' column="'; print: aPoint y + start y - 1; nextPut: $" ].
		aStream nextPutAll: '/>'; nextPut: Character lf ]! !

!HDLintReport methodsFor: 'testing' stamp: 'lr 5/15/2010 14:05'!
isClassEnvironment: anEnvironment
	^ #(CategoryEnvironment ClassEnvironment VariableEnvironment) includes: anEnvironment class name! !

!HDLintReport class methodsFor: 'running' stamp: 'Anonymous 7/15/2012 13:15'!
runClasses: aCollectionOfClasses named: aString
	| classEnvironment |
	classEnvironment := RBBrowserEnvironment new
		forClasses: aCollectionOfClasses.
	classEnvironment label: aString.
	^ self runEnvironment: classEnvironment! !

!HDLintReport class methodsFor: 'running' stamp: 'lr 5/14/2010 09:20'!
runEnvironment: anEnvironment
	^ self new 
		initializeOn: anEnvironment; 
		run! !

!HDLintReport class methodsFor: 'running' stamp: 'MarcusDenker 7/15/2012 13:16'!
runPackage: aString
	| packageEnvironment |
	packageEnvironment := RBBrowserEnvironment new
		forPackageNames: (Array with: aString).
	packageEnvironment label: aString.
	^ self runEnvironment: packageEnvironment! !

!HDReport commentStamp: 'TorstenBergmann 2/12/2014 22:30'!
A Hudson report!
!HDReport methodsFor: 'private' stamp: 'lr 5/14/2010 08:36'!
encode: aString
	^ ((aString asString 
		copyReplaceAll: '&' with: '&amp;') 
		copyReplaceAll: '"' with: '&quot;') 
		copyReplaceAll: '<' with: '&lt;'! !

!HDReport methodsFor: 'private' stamp: 'lr 5/15/2010 14:27'!
convert: aString
	^ (aString asString 
		copyReplaceAll: (String with: Character cr with: Character lf) with: (String with: Character lf))
		copyReplaceAll: (String with: Character cr) with: (String with: Character lf)! !

!HDReport class methodsFor: 'running' stamp: 'lr 5/14/2010 09:17'!
runCategory: aString
	^ self runClasses: (Smalltalk organization classesInCategory: aString) named: aString! !

!HDReport class methodsFor: 'running' stamp: 'lr 5/14/2010 09:17'!
runCategories: aCollectionOfStrings
	^ aCollectionOfStrings do: [ :each | self runCategory: each ]! !

!HDReport class methodsFor: 'running' stamp: 'lr 5/14/2010 09:15'!
runClasses: aCollectionOfClasses named: aString
	self subclassResponsibility! !

!HDReport class methodsFor: 'running' stamp: 'lr 5/14/2010 09:17'!
runPackages: aCollectionOfStrings
	^ aCollectionOfStrings do: [ :each | self runPackage: each ]! !

!HDReport class methodsFor: 'running' stamp: 'lr 5/14/2010 09:16'!
runPackage: aString
	self subclassResponsibility! !

!HDTestCoverage commentStamp: 'TorstenBergmann 2/12/2014 22:32'!
Used to measure test coverage for Hudson reports!
!HDTestCoverage methodsFor: 'testing' stamp: 'lr 7/6/2010 11:16'!
hasRun
	^ hasRun! !

!HDTestCoverage methodsFor: 'private' stamp: 'lr 7/6/2010 11:16'!
doesNotUnderstand: aMessage
	^ method perform: aMessage selector withArguments: aMessage arguments! !

!HDTestCoverage methodsFor: 'actions' stamp: 'CamilloBruni 8/27/2013 01:40'!
install
	reference actualClass methodDict
		at: reference selector
		put: self.
	self flushCache! !

!HDTestCoverage methodsFor: 'accessing' stamp: 'lr 7/5/2010 08:24'!
reference
	^ reference! !

!HDTestCoverage methodsFor: 'private' stamp: 'CamilloBruni 8/27/2013 01:40'!
flushCache
	reference selector flushCache.
	method flushCache! !

!HDTestCoverage methodsFor: 'evaluation' stamp: 'lr 7/6/2010 11:15'!
run: aSelector with: anArray in: aReceiver
	self mark; uninstall.
	^ aReceiver withArgs: anArray executeMethod: method! !

!HDTestCoverage methodsFor: 'accessing' stamp: 'lr 7/5/2010 08:23'!
method
	^ method! !

!HDTestCoverage methodsFor: 'private' stamp: 'lr 7/6/2010 11:16'!
mark
	hasRun := true! !

!HDTestCoverage methodsFor: 'initialization' stamp: 'lr 7/6/2010 11:16'!
initializeOn: aMethodReference
	hasRun := false.
	reference := aMethodReference.
	method := reference compiledMethod! !

!HDTestCoverage methodsFor: 'actions' stamp: 'CamilloBruni 8/27/2013 01:40'!
uninstall
	reference actualClass methodDict
		at: reference selector
		put: method.
	self flushCache! !

!HDTestCoverage class methodsFor: 'instance creation' stamp: 'lr 6/9/2010 11:05'!
on: aMethodReference
	^ self new initializeOn: aMethodReference! !

!HDTestReport commentStamp: 'TorstenBergmann 2/12/2014 22:31'!
Hudson report for test results!
!HDTestReport methodsFor: 'private' stamp: 'CamilloBruni 11/4/2013 08:27'!
stackTraceString: err of: aTestCase
	^ String streamContents: [ :str | 
		| context |
		context := err signalerContext.
		[ context isNil or: [ context receiver == aTestCase and: [ context methodSelector == #runCase ] ] ] whileFalse: [
			str print: context; lf.
			context := context sender ] ] ! !

!HDTestReport methodsFor: 'running' stamp: 'IgorStasenko 1/6/2012 15:12'!
done
	"just close the file"
	[ progressFile close ] on: Error do: []! !

!HDTestReport methodsFor: 'running' stamp: 'AndreiChis 10/7/2013 11:59'!
serializeError: error of: aTestCase
	"We got an error from a test, let's serialize it so we can properly debug it later on..."
	| context testCaseMethodContext |
	
	context := error signalerContext.
	testCaseMethodContext := context findContextSuchThat: [ :ctx| 
		ctx receiver == aTestCase and: [ ctx methodSelector == #performTest ]].
	context := context copyTo: testCaseMethodContext.
	
	[ FuelOutStackDebugAction
		serializeTestFailureContext: context sender 		
		toFileNamed: aTestCase class name asString,'-', aTestCase selector, '.fuel'	] 
	on: Error 
	do: [:err| "simply continue..." ]

! !

!HDTestReport methodsFor: 'running' stamp: 'MaxLeske 11/6/2013 10:10'!
tearDown
	suite resources 
		do: [ :each | each reset ].
		
	stream tab; nextPutAll: '<system-out><!![CDATA[]]></system-out>'; lf.
	stream tab; nextPutAll: '<system-err><!![CDATA[]]></system-err>'; lf.
	stream nextPutAll: '</testsuite>'.
	
	stream position: suitePosition.
	stream 
		nextPutAll: ' failures="'; print: suiteFailures; 
		nextPutAll: '" errors="'; print: suiteErrors; 
		nextPutAll: '" time="'; print: suiteTime asMilliSeconds / 1000.0; 
		nextPutAll: '">'.
	stream close.
	
	progressFile 
		nextPutAll: 'finished running suite: ';
		nextPutAll: suite name;
		close! !

!HDTestReport methodsFor: 'running' stamp: 'lr 6/9/2010 20:01'!
run
	Author uniqueInstance
		ifUnknownAuthorUse: 'hudson'
		during: [ [ 
			self setUp.
			suiteTime := [ self runAll ]
				timeToRun ]
					ensure: [ self tearDown ] ]! !

!HDTestReport methodsFor: 'private' stamp: 'CamilloBruni 11/6/2013 21:33'!
beginTestCase: aTestCase runBlock: aBlock
	| time |
	progressFile 
		nextPutAll: 'starting testcase: ' ; 
		nextPutAll: aTestCase class name; 
		nextPutAll:'>>';
		nextPutAll: aTestCase selector; 
		nextPutAll: ' ... '; 
		flush.
		
	time := aBlock timeToRun.
	stream tab; 
		nextPutAll: '<testcase classname="'; 
		nextPutAll: (self encode: (aTestCase class category copyReplaceAll: '-' with: '.')); 
		nextPut: $.; nextPutAll: (self encode: aTestCase class name); 
		nextPutAll: '" name="'; nextPutAll: (self encode: aTestCase selector); 
		nextPutAll: '" time="'; print: (time asMilliSeconds / 1000.0); 
		nextPutAll: '">'; lf
	
! !

!HDTestReport methodsFor: 'private' stamp: 'CamilloBruni 11/4/2013 08:27'!
writeFailure: error stack: stack
	suiteFailures := suiteFailures + 1.
	stream tab; tab; nextPutAll: '<failure type="'.
	self writeException: error stack: stack.  
	stream	nextPutAll: '</failure>'; lf! !

!HDTestReport methodsFor: 'running' stamp: 'DamienCassou 2/20/2014 16:54'!
setUp
	progressFile nextPutAll: 'running suite: ';
		nextPutAll: suite name ; crlf; flush.
		
	stream := StandardFileStream forceNewFileNamed: suite name , '-Test.xml'.
	stream := MultiByteFileStream newFrom: stream.
	stream nextPutAll: '<?xml version="1.0" encoding="UTF-8"?>'; lf.
	stream nextPutAll: '<testsuite name="'; nextPutAll: (self encode: suite name); 
		nextPutAll: '" tests="'; print: suite tests size; nextPutAll: '">'.
	
	"Now this is ugly. We want to update the time and the number of failures and errors, but still at the same time stream a valid XML. So remember this position and add some whitespace, that we can fill later."
	suitePosition := stream position - 1.
	stream nextPutAll: (String new: 100 withAll: $ ); lf.
	
	"Initialize the test resources."
	suite resources do: [ :each |
		each isAvailable
			ifFalse: [ each signalInitializationError ] ]! !

!HDTestReport methodsFor: 'running' stamp: 'MaxLeske 11/6/2013 10:03'!
runCase: aTestCase
	| error stack  |
	self 
		beginTestCase: aTestCase
		runBlock: [ [ [ aTestCase runCase ] 
			on: Halt , Error, TestFailure
			do: [ :err |
				error := err.
			 	aTestCase isExpectedFailure ifFalse: [self serializeError: error of: aTestCase].
				stack := self stackTraceString: err of: aTestCase ]]
			on: TestSkip do: [ :err| "nothing to do..." ] ].
		
	(error isNil or: [aTestCase isExpectedFailure])  ifFalse: [
		(error isKindOf: TestFailure)
			ifTrue: [ self writeError: error stack: stack ]
			ifFalse: [ self writeFailure: error stack: stack ]].
		
	self endTestCase! !

!HDTestReport methodsFor: 'private' stamp: 'CamilloBruni 11/4/2013 08:27'!
writeError: error stack: stack
	suiteErrors := suiteErrors + 1.
	stream tab; tab; nextPutAll: '<error type="'.
	self writeException: error stack: stack.
	stream nextPutAll: '</error>'; lf! !

!HDTestReport methodsFor: 'private' stamp: 'CamilloBruni 11/4/2013 08:29'!
endTestCase
	stream tab; nextPutAll: '</testcase>'; lf.
	progressFile nextPutAll: 'finished' ; crlf; flush.
! !

!HDTestReport methodsFor: 'private' stamp: 'CamilloBruni 7/20/2012 16:53'!
writeException: error stack: stack.

	stream 
		nextPutAll: (self encode: error class name); 
		nextPutAll: '" message="'; nextPutAll: (self encode: (error messageText ifNil: [ error description ])); 
		nextPutAll: '">'; 
		nextPutAll: (self encode: stack).! !

!HDTestReport methodsFor: 'initialization' stamp: 'EstebanLorenzano 10/31/2014 17:49'!
initializeOn: aTestSuite
	suite := aTestSuite.
	suiteTime := 0 asDuration.
	suitePosition := suiteFailures := suiteErrors := 0.
	progressFile := StandardFileStream forceNewFileNamed: 'progress.log'! !

!HDTestReport methodsFor: 'running' stamp: 'JohanBrichau 10/25/2010 23:05'!
runAll
	suite tests do: [ :each | each run: self ]! !

!HDTestReport class methodsFor: 'running' stamp: 'IgorStasenko 1/6/2012 15:12'!
runSuite: aTestSuite
	^ self new 
		initializeOn: aTestSuite; 
		run;
		done! !

!HDTestReport class methodsFor: 'running' stamp: 'lr 5/14/2010 09:16'!
runClasses: aCollectionOfClasses named: aString
	| suite classes |
	suite := TestSuite named: aString.
	classes := (aCollectionOfClasses
		select: [ :each | (each includesBehavior: TestCase) and: [ each isAbstract not ] ])
			asSortedCollection: [ :a :b | a name <= b name ].
	classes isEmpty
		ifTrue: [ ^ self ].
	classes
		do: [ :each | each addToSuiteFromSelectors: suite ].
	^ self runSuite: suite! !

!HDTestReport class methodsFor: 'running' stamp: 'CamilloBruni 8/30/2013 13:37'!
runPackage: aString
	^ self runClasses: (RPackage organizer packageNamed: aString) definedClasses named: aString! !

!HMAC commentStamp: '<historical>'!
HMAC is a mechanism for message authentication using cryptographic hash functions. HMAC can be used with any iterative cryptographic hash function, e.g., MD5, SHA-1, in combination with a secret shared key.  The cryptographic strength of HMAC depends on the properties of the underlying hash function.

See RFC 2114.!
!HMAC methodsFor: 'accessing' stamp: 'len 8/3/2002 02:06'!
digestSize
	^ hash hashSize! !

!HMAC methodsFor: 'accessing' stamp: 'StephaneDucasse 10/17/2009 17:15'!
key: aByteArray 
	key := aByteArray.
	key size > hash blockSize ifTrue: [ key := hash hashMessage: key ].
	key size < hash blockSize ifTrue: [ key := key , (ByteArray new: hash blockSize - key size) ]! !

!HMAC methodsFor: 'accessing' stamp: 'len 10/16/2002 16:43'!
digestMessage: aByteArray
	^ hash hashMessage: (key bitXor: epad), (hash hashMessage: (key bitXor: ipad), aByteArray)! !

!HMAC methodsFor: 'initialization' stamp: 'StephaneDucasse 10/17/2009 17:15'!
setHash: aHash 
	hash := aHash.
	ipad := ByteArray 
		new: aHash blockSize
		withAll: 54.
	epad := ByteArray 
		new: aHash blockSize
		withAll: 92! !

!HMAC methodsFor: 'accessing' stamp: 'cmm 12/2/2006 14:57'!
destroy
	key destroy! !

!HMAC methodsFor: 'printing' stamp: 'len 8/3/2002 02:08'!
printOn: aStream
	aStream nextPutAll: 'HMAC-'; print: hash! !

!HMAC class methodsFor: 'instance creation' stamp: 'len 8/15/2002 01:42'!
on: aHashFunction
	^ self new setHash: aHashFunction! !

!HSVAColorSelectorMorph commentStamp: 'gvc 5/18/2007 12:55'!
Colour selector featuring a saturation/volume area, hue selection strip and alpha selection strip.!
!HSVAColorSelectorMorph methodsFor: 'accessing' stamp: 'gvc 9/20/2006 14:05'!
hsvMorph: anObject
	"Set the value of hsvMorph"

	hsvMorph := anObject! !

!HSVAColorSelectorMorph methodsFor: 'accessing' stamp: 'gvc 9/21/2006 13:44'!
defaultColor
	"Answer the default color/fill style for the receiver."
	
	^Color transparent
! !

!HSVAColorSelectorMorph methodsFor: 'accessing' stamp: 'gvc 9/20/2006 14:05'!
hsvMorph
	"Answer the value of hsvMorph"

	^ hsvMorph! !

!HSVAColorSelectorMorph methodsFor: 'operations' stamp: 'gvc 9/22/2006 10:11'!
newAColorMorph
	"Answer a new alpha color morph."

	^AColorSelectorMorph new
		model: self;
		hResizing: #spaceFill;
		vResizing: #rigid;
		setValueSelector: #alphaSelected:;
		extent: 24@24! !

!HSVAColorSelectorMorph methodsFor: 'operations' stamp: 'gvc 9/22/2006 11:12'!
selectedColor: aColor
	"Set the hue and sv components."

	self aMorph value: aColor alpha.
	self hsvMorph selectedColor: aColor asNontranslucentColor! !

!HSVAColorSelectorMorph methodsFor: 'accessing' stamp: 'gvc 9/22/2006 09:58'!
colorSelected: aColor
	"A color has been selected. Set the base color for the alpha channel."

	self aMorph color: aColor.
	self triggerSelectedColor! !

!HSVAColorSelectorMorph methodsFor: 'operations' stamp: 'gvc 9/21/2006 14:00'!
newHSVColorMorph
	"Answer a new hue/saturation/volume color morph."

	^HSVColorSelectorMorph new
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		when: #colorSelected send: #colorSelected: to: self! !

!HSVAColorSelectorMorph methodsFor: 'accessing' stamp: 'gvc 9/20/2006 14:05'!
aMorph: anObject
	"Set the value of aMorph"

	aMorph := anObject! !

!HSVAColorSelectorMorph methodsFor: 'initialization' stamp: 'gvc 9/21/2006 16:47'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		extent: 180@168;
		changeTableLayout;
		cellInset: 4;
		aMorph: self newAColorMorph;
		hsvMorph: self newHSVColorMorph;
		addMorphBack: self hsvMorph;
		addMorphBack: self aMorph.
	self aMorph color: self hsvMorph selectedColor! !

!HSVAColorSelectorMorph methodsFor: 'operations' stamp: 'gvc 9/22/2006 09:57'!
triggerSelectedColor
	"Trigger the event for the selected colour"

	self triggerEvent: #selectedColor with: self selectedColor! !

!HSVAColorSelectorMorph methodsFor: 'operations' stamp: 'gvc 9/21/2006 14:18'!
selectedColor
	"Answer the selected color."

	^self hsvMorph selectedColor alpha: self aMorph value! !

!HSVAColorSelectorMorph methodsFor: 'accessing' stamp: 'gvc 9/20/2006 14:05'!
aMorph
	"Answer the value of aMorph"

	^ aMorph! !

!HSVAColorSelectorMorph methodsFor: 'accessing' stamp: 'gvc 9/22/2006 09:58'!
alphaSelected: aFloat
	"The alpha has changed."

	self triggerSelectedColor! !

!HSVColorSelectorMorph commentStamp: 'gvc 5/18/2007 12:55'!
Colour selector featuring a saturation/volume area and a hue selection strip.!
!HSVColorSelectorMorph methodsFor: 'accessing' stamp: 'gvc 9/21/2006 13:30'!
hMorph
	"Answer the value of hMorph"

	^ hMorph! !

!HSVColorSelectorMorph methodsFor: 'initialization' stamp: 'gvc 9/26/2006 12:25'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		borderWidth: 0;
		changeTableLayout;
		cellInset: 4;
		listDirection: #leftToRight;
		cellPositioning: #topLeft;
		svMorph: self newSVColorMorph;
		hMorph: self newHColorMorph;
		addMorphBack: self svMorph;
		addMorphBack: self hMorph;
		extent: 192@152;
		hue: 0.5! !

!HSVColorSelectorMorph methodsFor: 'accessing' stamp: 'gvc 9/21/2006 13:44'!
defaultColor
	"Answer the default color/fill style for the receiver."
	
	^Color transparent
! !

!HSVColorSelectorMorph methodsFor: 'operations' stamp: 'gvc 9/19/2006 12:33'!
newHColorMorph
	"Answer a new hue color morph."

	^HColorSelectorMorph new
		model: self;
		setValueSelector: #hue:;
		hResizing: #rigid;
		vResizing: #spaceFill;
		extent: 36@36! !

!HSVColorSelectorMorph methodsFor: 'accessing' stamp: 'gvc 9/19/2006 12:26'!
svMorph: anObject
	"Set the value of svMorph"

	svMorph := anObject! !

!HSVColorSelectorMorph methodsFor: 'operations' stamp: 'gvc 9/21/2006 13:41'!
selectedColor
	"Answer the selected color."

	^self svMorph selectedColor! !

!HSVColorSelectorMorph methodsFor: 'operations' stamp: 'gvc 5/18/2007 12:54'!
newSVColorMorph
	"Answer a new saturation/volume color morph."

	^SVColorSelectorMorph new
		extent: 152@152;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		when: #colorSelected send: #colorSelected: to: self! !

!HSVColorSelectorMorph methodsFor: 'operations' stamp: 'gvc 9/21/2006 13:38'!
selectedColor: aColor
	"Set the hue and sv components."

	self hue: aColor hue / 360.
	self svMorph selectedColor: aColor! !

!HSVColorSelectorMorph methodsFor: 'accessing' stamp: 'gvc 9/21/2006 16:23'!
hue: aFloat
	"Set the hue in the range 0.0 - 1.0. Update the SV morph and hMorph."

	self hMorph value: aFloat.
	self svMorph color: (Color h: aFloat * 359.9 s: 1.0 v: 1.0)! !

!HSVColorSelectorMorph methodsFor: 'accessing' stamp: 'gvc 9/21/2006 13:30'!
hMorph: anObject
	"Set the value of hMorph"

	hMorph := anObject! !

!HSVColorSelectorMorph methodsFor: 'accessing' stamp: 'gvc 9/21/2006 16:28'!
colorSelected: aColor
	"A color has been selected. Make the hue match."

	"self hMorph value: aColor hue / 360.
	self svMorph basicColor: (Color h: aColor hue s: 1.0 v: 1.0)."
	self triggerEvent: #colorSelected with: aColor! !

!HSVColorSelectorMorph methodsFor: 'accessing' stamp: 'gvc 9/19/2006 12:26'!
svMorph
	"Answer the value of svMorph"

	^ svMorph! !

!HTTPEncodingTest commentStamp: 'TorstenBergmann 2/5/2014 10:13'!
SUnit tests for HTTPEncoding!
!HTTPEncodingTest methodsFor: 'tests' stamp: 'SvenVanCaekenberghe 10/27/2013 11:45'!
testEncodeForHTTP

	self assert: 'aa aa éé aa aa' urlEncoded = 'aa%20aa%20%C3%A9%C3%A9%20aa%20aa'! !

!HTTPEncodingTest methodsFor: '*Multilingual-Tests-OtherLanguages' stamp: 'SvenVanCaekenberghe 10/27/2013 11:55'!
testPercentEncodingHiragana
	| hiraA hiraO hiraAO encodedHiraA encodedHiraO encodedHiraAO |
	"Make Japanese String from unicode. see http://www.unicode.org/charts/PDF/U3040.pdf"
	hiraA := (Character value: 16r3042) asString.	"HIRAGANA LETTER A"
	hiraO := (Character value: 16r304A) asString.	"HIRAGANA LETTER O"
	hiraAO := hiraA , hiraO.	
	"Percent Encoded Japanese String"
	encodedHiraA := hiraA urlEncoded.
	self assert: encodedHiraA = '%E3%81%82'.
	encodedHiraO := hiraO urlEncoded.
	self assert: encodedHiraO = '%E3%81%8A'.
	encodedHiraAO := hiraAO urlEncoded.
	self assert: encodedHiraAO = '%E3%81%82%E3%81%8A'.	
	"without percent encoded string"
	self assert: '' urlDecoded = ''.
	self assert: 'abc' urlDecoded = 'abc'.	"latin1 character"
	"encoded latin1 string"
	self assert: '%61' urlDecoded = 'a'.
	self assert: '%61%62%63' urlDecoded = 'abc'.	
	"encoded multibyte string"
	self assert: encodedHiraA urlDecoded = hiraA.
	self assert: encodedHiraAO urlDecoded = hiraAO.	
	"mixed string"
	self assert: (encodedHiraAO , 'a') urlDecoded = (hiraAO , 'a').
	self assert: ('a' , encodedHiraA) urlDecoded = ('a' , hiraA).
	self assert: ('a' , encodedHiraA , 'b') urlDecoded = ('a' , hiraA , 'b').
	self assert: ('a' , encodedHiraA , 'b' , encodedHiraO) urlDecoded = ('a' , hiraA , 'b' , hiraO).
	self assert: (encodedHiraA , encodedHiraO , 'b' , encodedHiraA) urlDecoded = (hiraA , hiraO , 'b' , hiraA).	
	"for Seaside"
	self assert: (encodedHiraA , '+' , encodedHiraO) urlDecoded = (hiraA , ' ' , hiraO)! !

!HTTPProgress commentStamp: '<historical>'!
I am HTTPProgress, a notification to show progress when using HTTP.

I include
	- total: The total size of the download/upload (if known)
	- amount: The completed amount of the download/upload (if known)

Use #total:, #amount: or #amountLeft: to set the appropriate byte counts to indicate progress.
Use #fraction or #percentage as a value that indicates progress.
Total and amount are optional and can be nil. Test using #isEmpty.

You can try 
	HTTPProgress example.
!
!HTTPProgress methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/16/2012 18:48'!
amountLeft: byteCount
	"Set the amount that has not yet been transferred.
	Can be nil. Should be between 0 and total."

	^ total ifNotNil: [ amount := total - byteCount ]! !

!HTTPProgress methodsFor: 'accessing' stamp: 'MarcusDenker 9/29/2013 09:45'!
beComplete
	"Make me complete, i.e. indicate that all bytes were transferred."

	amount := total! !

!HTTPProgress methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/16/2012 18:37'!
amount
	"Answer the amount that has already been transferred.
	Can be nil. Should be between 0 and total."

	^ amount! !

!HTTPProgress methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/16/2012 18:45'!
isEmpty
	"Answer true if I do not contain a numerical progress indication."
  	
	^ amount isNil or: [ total isNil ]! !

!HTTPProgress methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/16/2012 18:39'!
amountLeft
	"Answer the amount that has not yet been transferred.
	Can be nil. Should be between 0 and total."

	^ self isEmpty ifFalse: [ total - amount ]! !

!HTTPProgress methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/16/2012 18:38'!
total
	"Answer the total byte count to transfer. Can be nil."

	^ total! !

!HTTPProgress methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 9/16/2012 18:46'!
printOn: stream
	"Print an extra progress percentage if available"
	
	super printOn: stream.
	self isEmpty 
		ifFalse: [ 
			stream space; print: self percentage rounded; nextPut: $% ]! !

!HTTPProgress methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/16/2012 18:47'!
total: byteCount
	"Set the total byte count to transfer"

	total := byteCount! !

!HTTPProgress methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/16/2012 18:40'!
fraction
	"Answer the fraction of total that has already been transferred.
	Can be nil. Should be between 0 and 1."
	
	^ self isEmpty ifFalse: [ amount / total ]! !

!HTTPProgress methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/16/2012 18:47'!
amount: byteCount
	"Set the amount of bytes that has already been transferred."

	amount := byteCount! !

!HTTPProgress methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/16/2012 18:52'!
isComplete
	"Answer true when I am complete, i.e. all bytes were transferred.
	When I am empty, I am also complete."

	^ amount = total! !

!HTTPProgress methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/16/2012 18:40'!
percentage
	"Answer the percentage of total that has already been transferred.
	Can be nil. Should be between 0 and 100."

	^ self isEmpty ifFalse: [ self fraction * 100 ]! !

!HTTPProgress class methodsFor: 'examples' stamp: 'SvenVanCaekenberghe 9/16/2012 20:03'!
example
	"self example"
	
 	UIManager default informUserDuring: [ :bar |
		bar label: 'Transfer Demo...'.
		1 second asDelay wait.
		[ 1 to: 20 do: [ :each |
			HTTPProgress signal: 'Transferring...' amount: each * 1024 total: 20*1024.
			(Delay forMilliseconds: 100) wait ] ]
			on: HTTPProgress 
			do: [ :progress | 
				bar label: progress printString.
				progress isEmpty ifFalse: [ bar current: progress percentage ]. 
				progress resume ] ] ! !

!HTTPProgress class methodsFor: 'exceptioninstantiator' stamp: 'SvenVanCaekenberghe 9/16/2012 20:07'!
signal: signalerText amount: amount total: total
	"Create and signal HTTPProgress with amount bytes transferred out of total.
	Use an additional signalerText."

	^ self new
		amount: amount;
		total: total;
		signal: signalerText! !

!HTTPProgress class methodsFor: 'exceptioninstantiator' stamp: 'SvenVanCaekenberghe 9/16/2012 20:06'!
signalAmount: amount total: total
	"Create and signal HTTPProgress with amount bytes transferred out of total."
	
	^ self new
		amount: amount;
		total: total;
		signal! !

!HaloMorph commentStamp: '<historical>'!
This morph provides a halo of handles for its target morph. Dragging, duplicating, rotating, and resizing to be done by mousing down on the appropriate handle. There are also handles for help and for a menu of infrequently used operations.!
!HaloMorph methodsFor: 'private' stamp: 'FernandoOlivero 9/9/2013 01:51'!
doRot: evt with: rotHandle
	"Update the rotation of my target if it is rotatable.  Keep the relevant command object up to date."

	| degrees |
	evt hand obtainHalo: self.
	degrees := (evt cursorPoint - (target pointInWorld: target referencePosition)) degrees.
	degrees := degrees - angleOffset degrees.
	degrees := degrees detentBy: 10.0 atMultiplesOf: 90.0 snap: false.
	degrees = 0.0
		ifTrue: [self setColor: Color lightBlue toHandle: rotHandle]
		ifFalse: [self setColor: Color blue toHandle: rotHandle].
	rotHandle submorphsDo:
		[:m | m color: rotHandle color contrastingForegroundColor].
	self removeAllHandlesBut: rotHandle.
	self showingDirectionHandles ifFalse:
		[self showDirectionHandles: true addHandles: false].
	self addDirectionHandles.
	target rotationDegrees: degrees.
	rotHandle position: evt cursorPoint - (rotHandle extent // 2).
! !

!HaloMorph methodsFor: 'private' stamp: 'AlainPlantec 5/7/2010 22:52'!
addHandles
	self addCircleHandles.
! !

!HaloMorph methodsFor: 'private' stamp: 'sw 1/27/2000 18:43'!
simpleFudgeOffset
	"account for the difference in basicBoxes between regular and simple handles"

	^ 0@0
! !

!HaloMorph methodsFor: 'private' stamp: 'StephaneDucasse 12/29/2011 12:37'!
addHandle: handleSpec on: eventName send: selector to: recipient 
	"Add a handle within the halo box as per the haloSpec, and set 
	it up to respond to the given event by sending the given 
	selector to the given recipient. Return the handle."
	| handle aPoint |
	aPoint := self
				positionIn: haloBox
				horizontalPlacement: handleSpec horizontalPlacement
				verticalPlacement: handleSpec verticalPlacement.
	handle := self
				addHandleAt: aPoint
				color: (Color colorFrom: handleSpec color)
				icon: handleSpec iconSymbol
				on: eventName
				send: selector
				to: recipient.
	^ handle! !

!HaloMorph methodsFor: 'private' stamp: 'FernandoOlivero 9/9/2013 01:51'!
createHandleAt: aPoint color: aColor iconName: iconName 
	| bou handle |
	bou := Rectangle center: aPoint extent: self handleSize asPoint.
	self gradientHalo
		ifTrue: [
			handle := Morph newBounds: bou color: aColor.
			handle borderWidth: 1.
			handle useRoundedCorners.
			self setColor: aColor toHandle: handle]
		ifFalse: [handle := EllipseMorph newBounds: bou color: aColor].
	""
	handle borderColor: aColor muchDarker.
	handle wantsYellowButtonMenu: false.
	""
	iconName isNil
		ifFalse: [| form | 
			form := Smalltalk ui icons iconNamed: iconName ifNone: [].
			form isNil
				ifFalse: [| image | 
					image := ImageMorph new.
					image form: form.
					image color: aColor contrastingForegroundColor.
					image lock.
					handle addMorphCentered: image]].
	""
	^ handle! !

!HaloMorph methodsFor: 'handles' stamp: 'gm 2/22/2003 13:13'!
addFontEmphHandle: haloSpec 
	(innerTarget isTextMorph) 
		ifTrue: 
			[self 
				addHandle: haloSpec
				on: #mouseDown
				send: #chooseEmphasisOrAlignment
				to: innerTarget]! !

!HaloMorph methodsFor: 'private' stamp: 'AlainPlantec 5/5/2010 13:36'!
addCircleHandles
	| box |
	target isWorldMorph ifTrue: [^ self addHandlesForWorldHalos].

	self removeAllMorphs.  "remove old handles, if any"
	self bounds: (self worldBoundsForMorph: target renderedMorph).  "update my size"
	box := self basicBox.

	target addHandlesTo: self box: box.

	self addName.
	growingOrRotating := false.
	self layoutChanged.
	self changed.
! !

!HaloMorph methodsFor: 'initialization' stamp: 'AlainPlantec 5/5/2010 13:36'!
initialize
	"initialize the state of the receiver"
	super initialize.

	growingOrRotating := false.
	self borderStyle: (SimpleBorder
		width: 2
		color: self theme settings menuSelectionColor)! !

!HaloMorph methodsFor: 'meta-actions' stamp: 'StephaneDucasse 12/29/2011 12:36'!
blueButtonDown: event
	"Transfer the halo to the next likely recipient"
	target ifNil:[^self delete].
	event hand obtainHalo: self.
	positionOffset := event position - (target point: target position in: owner).
	"wait for drags or transfer"
	event hand 
		waitForClicksOrDrag: self 
		event: event
		selectors: { #transferHalo:. nil. nil. #dragTarget:. }
		threshold: 5.! !

!HaloMorph methodsFor: 'dropping/grabbing' stamp: 'stephane.ducasse 11/8/2008 19:38'!
startDrag: evt with: dragHandle
	"Drag my target without removing it from its owner."

	self obtainHaloForEvent: evt andRemoveAllHandlesBut: dragHandle.
	positionOffset := dragHandle center - (target point: target position in: owner).! !

!HaloMorph methodsFor: 'testing' stamp: 'jm 7/16/97 06:54'!
stepTime

	^ 0  "every cycle"
! !

!HaloMorph methodsFor: 'events' stamp: 'MarcusDenker 12/2/2013 14:07'!
popUpFor: aMorph event: evt 
	"This message is sent by morphs that explicitly request the halo on a button click. Note: anEvent is in aMorphs coordinate frame."

	| hand anEvent |
	self flag: #workAround.	"We should really have some event/hand here..."
	anEvent := evt isNil 
				ifTrue: 
					[hand := aMorph world ifNotNil: [:w | w activeHand].
					hand ifNil: [hand := aMorph world primaryHand]. 
					hand lastEvent transformedBy: (aMorph transformedFrom: nil)]
				ifFalse: 
					[hand := evt hand.
					evt].
	self target: aMorph.
	hand halo: self.
	hand world addMorphFront: self.
	positionOffset := anEvent position 
				- (aMorph point: aMorph position in: owner).
	self startStepping.
	! !

!HaloMorph methodsFor: 'accessing' stamp: 'ar 8/8/2001 14:42'!
magicAlpha: alpha
	self setProperty: #magicAlpha toValue: alpha.
	self changed.! !

!HaloMorph methodsFor: 'handles' stamp: 'ar 10/25/2000 17:49'!
addRotateHandle: haloSpec
	(self addHandle: haloSpec on: #mouseDown send: #startRot:with: to: self)
		on: #mouseMove send: #doRot:with: to: self

! !

!HaloMorph methodsFor: 'private' stamp: 'di 9/26/2000 15:16'!
directionArrowLength
	^ 25! !

!HaloMorph methodsFor: 'events-processing' stamp: 'ar 10/10/2000 22:00'!
rejectsEvent: anEvent
	"Return true to reject the given event. Rejecting an event means neither the receiver nor any of it's submorphs will be given any chance to handle it."
	(super rejectsEvent: anEvent) ifTrue:[^true].
	anEvent isDropEvent ifTrue:[^true]. "never attempt to drop on halos"
	^false! !

!HaloMorph methodsFor: 'handles' stamp: 'sw 1/26/2000 16:05'!
addMenuHandle: haloSpec
	self addHandle: haloSpec on: #mouseDown send: #doMenu:with: to: self! !

!HaloMorph methodsFor: 'private' stamp: 'sw 10/28/1999 15:39'!
addSimpleHandlesForWorldHalos
	"Nothing special at present here -- just use the regular handles.  Cannot rotate or resize world"

	self addHandlesForWorldHalos
! !

!HaloMorph methodsFor: 'private' stamp: 'aoy 2/17/2003 01:27'!
showDirectionHandles: wantToShow addHandles: needHandles 
	directionArrowAnchor := wantToShow 
				ifTrue: [target referencePositionInWorld	"not nil means show"]
				ifFalse: [nil].
	needHandles ifTrue: [self addHandles] ! !

!HaloMorph methodsFor: 'stepping' stamp: 'nk 6/27/2003 12:32'!
step
	| newBounds |
	target
		ifNil: [^ self].
	newBounds := target isWorldMorph
				ifTrue: [target bounds]
				ifFalse: [self localHaloBoundsFor: target renderedMorph].
	newBounds = self bounds
		ifTrue: [^ self].
	newBounds extent = self bounds extent
		ifTrue: [^ self position: newBounds origin].
	growingOrRotating
		ifFalse: [submorphs size > 1
				ifTrue: [self addHandles]].
	"adjust halo bounds if appropriate"
	self bounds: newBounds! !

!HaloMorph methodsFor: 'private' stamp: 'marcus.denker 11/20/2008 12:24'!
doRecolor: evt with: aHandle
	"The mouse went down in the 'recolor' halo handle.  Allow the user to change the color of the innerTarget"

	evt hand obtainHalo: self.
	(aHandle containsPoint: evt cursorPoint)
		ifFalse:  "only do it if mouse still in handle on mouse up"
			[self delete.
			target addHalo: evt]
		ifTrue: [innerTarget changeColor].
			self showingDirectionHandles ifTrue: [self addHandles]! !

!HaloMorph methodsFor: 'private' stamp: 'AlainPlantec 5/7/2010 23:34'!
positionDirectionShaft: shaft
	"Position the shaft."
	| alphaRadians unitVector | 
	"Pretty crude and slow approach at present, but a stake in the ground"
	alphaRadians := target heading degreesToRadians.
	unitVector := alphaRadians sin  @ alphaRadians cos negated.
	shaft setVertices: {unitVector * 6 + directionArrowAnchor.  "6 = radius of deadeye circle"
					unitVector * self directionArrowLength + directionArrowAnchor}
! !

!HaloMorph methodsFor: 'handles' stamp: 'AlainPlantec 12/6/2009 21:14'!
addDebugHandle: handleSpec
	self class haloWithDebugHandle ifTrue:
		[self addHandle: handleSpec
			on: #mouseDown send: #doDebug:with: to: self]
! !

!HaloMorph methodsFor: 'submorphs-add/remove' stamp: 'StephaneDucasse 12/29/2011 12:51'!
delete
	"Delete the halo.  Tell the target that it no longer has the halo; accept any pending edits to the name; and then  actually delete myself"

	target ifNotNil: [target hasHalo: false].
	super delete.! !

!HaloMorph methodsFor: 'meta-actions' stamp: 'ar 9/15/2000 16:42'!
handlerForBlueButtonDown: anEvent
	"Blue button was clicked within the receiver"
	^self! !

!HaloMorph methodsFor: 'handles' stamp: 'WilliamSix 1/14/2013 19:46'!
addScaleHandle: haloSpec
	target shouldFlex ifTrue: 
		[(self addHandle: haloSpec
				on: #mouseDown send: #startScale:with: to: self)
				on: #mouseMove send: #doScale:with: to: self].
	"This or addGrowHandle:, but not both, will prevail at any one time"
! !

!HaloMorph methodsFor: 'private' stamp: 'StephaneDucasse 12/29/2011 12:52'!
endInteraction
	"Clean up after a user interaction with the a halo control"

	| m |
	(target isInWorld not or: [owner isNil]) ifTrue: [^self].
	[target isFlexMorph and: [target hasNoScaleOrRotation]] whileTrue: 
			[m := target firstSubmorph.
			target removeFlexShell.
			target := m].
	self isInWorld 
		ifTrue: 
			["make sure handles show in front, even if flex shell added"
			self comeToFront.
			self addHandles].
! !

!HaloMorph methodsFor: 'handles' stamp: 'ar 10/25/2000 17:48'!
addDragHandle: haloSpec
	(self addHandle: haloSpec on: #mouseDown send: #startDrag:with: to: self)
		on: #mouseMove send: #doDrag:with: to: self


! !

!HaloMorph methodsFor: 'private' stamp: 'dgd 9/29/2004 19:56'!
setDismissColor: evt with: dismissHandle
	"Called on mouseStillDown in the dismiss handle; set the color appropriately."

	| colorToUse |
	evt hand obtainHalo: self.
	colorToUse :=  (dismissHandle containsPoint: evt cursorPoint)
		ifFalse:
			[Color red muchLighter]
		ifTrue:
			[Color lightGray].
	self setColor: colorToUse toHandle: dismissHandle.
! !

!HaloMorph methodsFor: 'private' stamp: 'di 9/26/2000 15:25'!
showDirectionHandles: wantToShow

	self showDirectionHandles: wantToShow addHandles: true  "called from menu"
! !

!HaloMorph methodsFor: 'halos and balloon help' stamp: 'WilliamSix 1/14/2013 19:45'!
addSimpleHandlesTo: aHaloMorph box: aBox
	| aHandle |

	target isWorldMorph ifTrue: [^ self addSimpleHandlesForWorldHalos].

	self removeAllMorphs.  "remove old handles, if any"
	
	self bounds: (self worldBoundsForMorph: target renderedMorph).  "update my size"
	
	self addHandleAt: (((aBox topLeft + aBox leftCenter) // 2) + self simpleFudgeOffset) color: Color paleBuff icon: #haloMoreHandlesIcon
		on: #mouseDown send: #addFullHandles to: self.

	aHandle := self addGraphicalHandle: #rotateIcon at: aBox bottomLeft on: #mouseDown send: #startRot:with: to: self.
	aHandle on: #mouseMove send: #doRot:with: to: self.

	target shouldFlex
		ifTrue: [(self addGraphicalHandle: #scaleIcon at: aBox bottomRight  on: #mouseDown send: #startScale:with: to: self)
				on: #mouseMove send: #doScale:with: to: self]
		ifFalse: [(self addGraphicalHandle: #scaleIcon at: aBox bottomRight on: #mouseDown send: #startGrow:with: to: self)
				on: #mouseMove send: #doGrow:with: to: self].

	growingOrRotating := false.
	self layoutChanged.
	self changed.
! !

!HaloMorph methodsFor: 'private' stamp: 'StephaneDucasse 6/28/2013 11:26'!
doGrow: evt with: growHandle
	"Called while the mouse is down in the grow handle"

	| newExtent extentToUse scale |
	evt hand obtainHalo: self.
	newExtent := (target pointFromWorld: (evt cursorPoint - positionOffset)) - target topLeft.
	evt shiftPressed ifTrue: [
		scale := (newExtent x / (originalExtent x max: 1)) min:
					(newExtent y / (originalExtent y max: 1)).
		newExtent := (originalExtent x * scale) asInteger @ (originalExtent y * scale) asInteger
	].
	(newExtent x < 1 or: [newExtent y < 1 ]) ifTrue: [^ self].
	target renderedMorph setExtentFromHalo: (extentToUse := newExtent).
	growHandle position: evt cursorPoint - (growHandle extent // 2).
	self layoutChanged.
! !

!HaloMorph methodsFor: 'private' stamp: 'ar 10/8/2001 14:35'!
prepareToTrackCenterOfRotation: evt with: rotationHandle
	evt hand obtainHalo: self.
	evt shiftPressed ifTrue:[
		self removeAllHandlesBut: rotationHandle.
	] ifFalse:[
		rotationHandle setProperty: #dragByCenterOfRotation toValue: true.
		self startDrag: evt with: rotationHandle
	].
	evt hand showTemporaryCursor: Cursor blank! !

!HaloMorph methodsFor: 'drawing' stamp: 'ar 8/8/2001 15:13'!
drawSubmorphsOn: aCanvas
	| alpha |
	((alpha := self magicAlpha) = 1.0)
		ifTrue:[^super drawSubmorphsOn: aCanvas].
	^super drawSubmorphsOn: (aCanvas asAlphaBlendingCanvas: alpha)! !

!HaloMorph methodsFor: 'private' stamp: 'AlainPlantec 12/11/2009 22:50'!
handleSize
	^ 20! !

!HaloMorph methodsFor: 'handles' stamp: 'WilliamSix 1/14/2013 19:44'!
addGrowHandle: haloSpec
	target shouldFlex ifFalse: 
		[(self addHandle: haloSpec
				on: #mouseDown send: #startGrow:with: to: self)
				on: #mouseMove send: #doGrow:with: to: self]
	"This or addScaleHandle:, but not both, will prevail at any one time"
! !

!HaloMorph methodsFor: 'accessing' stamp: 'ar 8/8/2001 14:28'!
magicAlpha
	^self valueOfProperty: #magicAlpha ifAbsent:[1.0]! !

!HaloMorph methodsFor: 'handles' stamp: 'sw 1/26/2000 16:16'!
addHelpHandle: haloSpec
	target balloonText ifNotNil:
		[(self addHandle: haloSpec on: #mouseDown send: #mouseDownOnHelpHandle: to: innerTarget)
			on: #mouseUp send: #deleteBalloon to: innerTarget]
! !

!HaloMorph methodsFor: 'copying' stamp: 'tk 1/7/1999 17:37'!
veryDeepFixupWith: deepCopier
	"If target and arguments fields were weakly copied, fix them here.  If they were in the tree being copied, fix them up, otherwise point to the originals!!!!"

super veryDeepFixupWith: deepCopier.
target := deepCopier references at: target ifAbsent: [target].
innerTarget := deepCopier references at: innerTarget ifAbsent: [innerTarget].
! !

!HaloMorph methodsFor: 'handles' stamp: 'stephane.ducasse 11/8/2008 19:52'!
addDupHandle: haloSpec
	"Add the halo that offers duplication, or, when shift is down, make-sibling"

	self addHandle: haloSpec on: #mouseDown send: #doDup:with: to: self

! !

!HaloMorph methodsFor: 'updating' stamp: 'di 11/17/2001 10:56'!
changed
	"Quicker to invalidate handles individually if target is large (especially the world)"

	self extent > (200@200)
		ifTrue: [(target notNil and: [target ~~ self world]) ifTrue:
					["Invalidate 4 outer strips first, thus subsuming separate damage."
					(self fullBounds areasOutside: target bounds) do:
						[:r | self invalidRect: r]].
				self submorphsDo: [:m | m changed]]
		ifFalse: [super changed].
! !

!HaloMorph methodsFor: 'private' stamp: 'AlainPlantec 5/7/2010 22:38'!
removeAllHandlesBut: aHandle
	"Remove all handles except aHandle."
	submorphs copy do: [:m | m == aHandle ifFalse: [m delete]]
! !

!HaloMorph methodsFor: 'settings' stamp: 'AlainPlantec 12/11/2009 23:01'!
haloEnclosesFullBounds
	^ self class haloEnclosesFullBounds! !

!HaloMorph methodsFor: 'private' stamp: 'IgorStasenko 12/22/2012 03:09'!
basicBox
	| aBox minSide anExtent w |
	minSide := 4 * self handleSize.
	anExtent := ((self width + self handleSize + 8) max: minSide) @
				((self height + self handleSize + 8) max: minSide).
	aBox := Rectangle center: self center extent: anExtent.
	w := self world ifNil:[target outermostWorldMorph].
	^ w
		ifNil:
			[aBox]
		ifNotNil:
			[aBox intersect: (w viewBox insetBy: 8@8) ifNone: [self error: 'should not happen' ]]
! !

!HaloMorph methodsFor: 'private' stamp: 'ar 10/8/2001 14:33'!
setCenterOfRotation: evt with: rotationHandle
	| localPt |
	evt hand obtainHalo: self.
	evt hand showTemporaryCursor: nil.
	(rotationHandle hasProperty: #dragByCenterOfRotation) ifFalse:[
		localPt := innerTarget transformFromWorld globalPointToLocal: rotationHandle center.
		innerTarget setRotationCenterFrom: localPt.
	].
	rotationHandle removeProperty: #dragByCenterOfRotation.
	self endInteraction
! !

!HaloMorph methodsFor: 'handles' stamp: 'AlainPlantec 12/11/2009 23:45'!
addDismissHandle: handleSpec 
	"Add the dismiss handle according to the spec, unless my target resists
	dismissal "
	| dismissHandle |
	target okayToAddDismissHandle
		ifTrue: [dismissHandle := self
						addHandle: handleSpec
						on: #mouseDown
						send: #mouseDownInDimissHandle:with:
						to: self.
			dismissHandle 
				on: #mouseUp
				send: #maybeDismiss:with:
				to: self.
			dismissHandle
				on: #mouseDown
				send: #setDismissColor:with:
				to: self.
			dismissHandle
				on: #mouseMove
				send: #setDismissColor:with:
				to: self]! !

!HaloMorph methodsFor: 'private' stamp: 'StephaneDucasse 4/22/2012 16:19'!
doMenu: evt with: menuHandle
	"Ask hand to invoke the halo menu for my inner target."

	| menu |
	self obtainHaloForEvent: evt andRemoveAllHandlesBut: nil.
	target world displayWorld.
	menu := innerTarget buildHandleMenu: evt hand.
	innerTarget addTitleForHaloMenu: menu.
	menu popUpEvent: evt in: target world.
! !

!HaloMorph methodsFor: 'private' stamp: 'IgorStasenko 12/22/2012 03:09'!
basicBoxForSimpleHalos
	| w |
	w := self world ifNil:[target outermostWorldMorph].
	^ ((self worldBoundsForMorph: target topRendererOrSelf) expandBy: self handleAllowanceForIconicHalos)
			intersect: (w bounds insetBy: 8@8) ifNone: [self error: 'should not happen' ]
! !

!HaloMorph methodsFor: 'private' stamp: 'MarcusDenker 11/7/2009 17:35'!
addHandlesForWorldHalos
	"Add handles for world halos, like the man said"

	| box w |
	w := self world ifNil:[target world].
	self removeAllMorphs.  "remove old handles, if any"
	self bounds: target bounds.
	box := w bounds insetBy: 9.
	target addWorldHandlesTo: self box: box.

	self addNameBeneath: (box insetBy: (0@0 corner: 0@10)) string: innerTarget externalName.
	growingOrRotating := false.
	self layoutChanged.
	self changed.
! !

!HaloMorph methodsFor: 'private' stamp: 'sw 10/3/2001 00:21'!
mouseDownInCollapseHandle: evt with: collapseHandle
	"The mouse went down in the collapse handle; collapse the morph"

	self obtainHaloForEvent: evt andRemoveAllHandlesBut: collapseHandle.
	self setDismissColor: evt with: collapseHandle! !

!HaloMorph methodsFor: 'private' stamp: 'BenComan 4/17/2014 21:32'!
addNameBeneath: outerRectangle string: aString
	"Add a name display centered beneath the bottom of the outer rectangle. Return the handle."

	| namePosition w |
	w := self world ifNil:[target world].
	nameMorph := NameStringInHalo contents: aString font: StandardFonts haloFont.
	nameMorph wantsYellowButtonMenu: false.
	nameMorph color: Color black.
	nameMorph target: innerTarget.
	namePosition := outerRectangle bottomCenter -
		((nameMorph width // 2) @ (self handleSize negated // 2 - 1)).
	nameMorph position: (namePosition min: w viewBox bottomRight - nameMorph extent y + 2).
	self addMorph: nameMorph.
	^ nameMorph! !

!HaloMorph methodsFor: 'private' stamp: 'AlainPlantec 5/7/2010 21:29'!
startScale: evt with: scaleHandle
	"Initialize scaling of my target."

	self obtainHaloForEvent: evt andRemoveAllHandlesBut: scaleHandle.
	target prepareForScaling.
	growingOrRotating := true.
	positionOffset := 0@0.
	originalExtent := target extent
! !

!HaloMorph methodsFor: 'private' stamp: 'FernandoOlivero 9/9/2013 01:51'!
doScale: evt with: scaleHandle
	"Update the scale of my target if it is scalable."
	| newHandlePos colorToUse |
	evt hand obtainHalo: self.
	newHandlePos := evt cursorPoint - (scaleHandle extent // 2).
	target scaleToMatch: newHandlePos.
	colorToUse := target scale = 1.0
						ifTrue: [Color yellow]
						ifFalse: [Color orange].
	self setColor: colorToUse toHandle: scaleHandle.
	scaleHandle
		submorphsDo: [:m | m color: colorToUse contrastingForegroundColor].
	scaleHandle position: newHandlePos.
! !

!HaloMorph methodsFor: 'private' stamp: 'sw 1/29/2000 18:36'!
addHandleAt: aPoint color: aColor on: eventName send: selector to: recipient
	^ self addHandleAt: aPoint color: aColor icon: nil on: eventName send: selector to: recipient
! !

!HaloMorph methodsFor: 'private' stamp: 'StephaneDucasse 5/23/2013 18:35'!
addGraphicalHandleFrom: formKey at: aPoint
	"Add the supplied form as a graphical handle centered at the given point.  Return the handle."
	| handle aForm |
	aForm := Smalltalk ui icons
		iconNamed: formKey 
		ifNone: [ Smalltalk ui icons iconNamed: #solidMenuIcon ].
	handle := ImageMorph new form: aForm; bounds: (Rectangle center: aPoint extent: aForm extent).
	handle wantsYellowButtonMenu: false.
	self addMorph: handle.
	handle on: #mouseUp send: #endInteraction to: self.
	^ handle
! !

!HaloMorph methodsFor: 'private' stamp: 'sw 1/27/2000 18:42'!
handleAllowanceForIconicHalos
	^ 12! !

!HaloMorph methodsFor: 'wiw support' stamp: 'RAA 6/27/2000 19:12'!
morphicLayerNumber

	"helpful for insuring some morphs always appear in front of or behind others.
	smaller numbers are in front"

	^7		"Halos are very front-like things"! !

!HaloMorph methodsFor: 'accessing' stamp: 'jm 7/16/97 06:51'!
target

	^ target
! !

!HaloMorph methodsFor: 'initialization' stamp: 'gvc 3/17/2009 10:42'!
defaultColor
	"Answer the default color/fill style for the receiver."
	
	^Color transparent! !

!HaloMorph methodsFor: 'private' stamp: 'ar 10/8/2001 14:32'!
trackCenterOfRotation: anEvent with: rotationHandle
	(rotationHandle hasProperty: #dragByCenterOfRotation) 
		ifTrue:[^self doDrag: anEvent with: rotationHandle].
	anEvent hand obtainHalo: self.
	rotationHandle center: anEvent cursorPoint.! !

!HaloMorph methodsFor: 'geometry' stamp: 'di 9/26/2000 21:03'!
position: pos
	"Halos display imprefectly if their coordinates are non-integral
		-- especially the direction handles."

	^ super position: pos asIntegerPoint! !

!HaloMorph methodsFor: 'settings' stamp: 'AlainPlantec 12/11/2009 23:02'!
showBoundsInHalo
	^ self class showBoundsInHalo! !

!HaloMorph methodsFor: 'events' stamp: 'ar 10/10/2000 19:09'!
transferHalo: event
	"Transfer the halo to the next likely recipient"
	target ifNil:[^self delete].
	target transferHalo: (event transformedBy: (target transformedFrom: self)) from: target.! !

!HaloMorph methodsFor: 'events' stamp: 'ar 10/4/2000 19:26'!
staysUpWhenMouseIsDownIn: aMorph
	^ ((aMorph == target) or: [aMorph hasOwner: self])! !

!HaloMorph methodsFor: 'events-processing' stamp: 'ar 9/15/2000 16:54'!
containsPoint: aPoint event: anEvent
	"Blue buttons are handled by the halo"
	(anEvent isMouse and:[anEvent isMouseDown and:[anEvent blueButtonPressed]])
		ifFalse:[^super containsPoint: aPoint event: anEvent].
	^bounds containsPoint: anEvent position! !

!HaloMorph methodsFor: 'private' stamp: 'StephaneDucasse 2/9/2011 18:02'!
doDup: evt with: dupHandle
	"Ask hand to duplicate my target."

	(target isKindOf: SelectionMorph) ifTrue:
		[^ target doDup: evt fromHalo: self handle: dupHandle].

	self obtainHaloForEvent: evt andRemoveAllHandlesBut: dupHandle.
	self setTarget: (target duplicateMorph: evt).
	evt hand grabMorph: target.
	self step. "update position if necessary"
	evt hand addMouseListener: self. "Listen for the drop"! !

!HaloMorph methodsFor: 'accessing' stamp: 'sw 1/26/2000 15:36'!
haloBox: aBox
	haloBox := aBox! !

!HaloMorph methodsFor: 'handles' stamp: 'ar 1/30/2001 23:32'!
positionIn: aBox horizontalPlacement: horiz verticalPlacement: vert
	| xCoord yCoord |

	horiz == #left
		ifTrue:	[xCoord := aBox left].
	horiz == #leftCenter
		ifTrue:	[xCoord := aBox left + (aBox width // 4)].
	horiz == #center
		ifTrue:	[xCoord := (aBox left + aBox right) // 2].
	horiz == #rightCenter
		ifTrue:	[xCoord := aBox left + ((3 * aBox width) // 4)].
	horiz == #right
		ifTrue:	[xCoord := aBox right].

	vert == #top
		ifTrue:	[yCoord := aBox top].
	vert == #topCenter
		ifTrue:	[yCoord := aBox top + (aBox height // 4)].
	vert == #center
		ifTrue:	[yCoord := (aBox top + aBox bottom) // 2].
	vert == #bottomCenter
		ifTrue:	[yCoord := aBox top + ((3 * aBox height) // 4)].
	vert == #bottom
		ifTrue:	[yCoord := aBox bottom].

	^ xCoord asInteger @ yCoord asInteger! !

!HaloMorph methodsFor: 'geometry' stamp: 'PavelKrivanek 12/3/2013 14:59'!
worldBoundsForMorph: aMorph
	"Answer the rectangle to be used as the inner dimension of aMorph halos.
	Allow for showing either bounds or fullBounds, and compensate for the optional bounds rectangle."

	| r |
	r := (self haloEnclosesFullBounds)
		ifFalse: [ aMorph boundsIn: nil ]
		ifTrue: [ aMorph fullBoundsInWorld ].
	self showBoundsInHalo ifTrue: [ ^r expandBy: 2 ].
	^r! !

!HaloMorph methodsFor: 'private' stamp: 'sw 10/2/2001 22:35'!
doGrab: evt with: grabHandle
	"Ask hand to grab my target."

	self obtainHaloForEvent: evt andRemoveAllHandlesBut: grabHandle.
	evt hand grabMorph: target.
	self step. "update position if necessary"
	evt hand addMouseListener: self. "Listen for the drop"! !

!HaloMorph methodsFor: 'copying' stamp: 'GuillermoPolito 8/9/2010 21:27'!
veryDeepInner: deepCopier
	"Copy all of my instance variables.  Some need to be not copied at all, but shared.  	Warning!!!!  Every instance variable defined in this class must be handled.  We must also implement veryDeepFixupWith:.  See DeepCopier class comment."

	super veryDeepInner: deepCopier.
	"target := target.		Weakly copied"
	"innerTarget := innerTarget.		Weakly copied"
	positionOffset := positionOffset veryDeepCopyWith: deepCopier.
	angleOffset := angleOffset veryDeepCopyWith: deepCopier.
	growingOrRotating := growingOrRotating veryDeepCopyWith: deepCopier.
	directionArrowAnchor := directionArrowAnchor.
	haloBox := haloBox.
	originalExtent := originalExtent.
	nameMorph := nameMorph.
! !

!HaloMorph methodsFor: 'private' stamp: 'AlainPlantec 12/11/2009 22:49'!
setColor: aColor toHandle: aHandle 
	"private - change the color to the given handle, applying the 
	alternate look if corresponds"
	aHandle color: aColor.
	self gradientHalo
		ifTrue: [| fill | 
			fill := GradientFillStyle ramp: {0.0 -> aColor muchLighter. 1.0 -> aColor darker}.
			fill origin: aHandle topLeft.
			fill direction: aHandle extent.
			aHandle fillStyle: fill] ! !

!HaloMorph methodsFor: 'accessing' stamp: 'jm 5/7/1998 15:42'!
target: aMorph

	self setTarget: aMorph.
	target ifNotNil: [self addHandles].
! !

!HaloMorph methodsFor: 'private' stamp: 'AlainPlantec 5/7/2010 09:17'!
doDebug: evt with: menuHandle
	"Ask hand to invoke the a debugging menu for my inner target.  If shift key is down, immediately put up an inspector on the inner target"

	| menu |
	"self obtainHaloForEvent: evt andRemoveAllHandlesBut: nil."
	self world displayWorld.
	evt shiftPressed ifTrue: 
		[self delete.
		^ innerTarget inspectInMorphic: evt].

	menu := innerTarget buildDebugMenu: evt hand.
	menu addTitle: (innerTarget externalName truncateWithElipsisTo: 40).
	menu popUpEvent: evt in: self world! !

!HaloMorph methodsFor: 'accessing' stamp: 'nk 6/12/2004 21:56'!
setTarget: aMorph
	"Private!! Set the target without adding handles."

	target := aMorph topRendererOrSelf.
	innerTarget := target renderedMorph.
	innerTarget wantsDirectionHandles
		ifTrue: [self showDirectionHandles: true addHandles: false].
	target hasHalo: true.

! !

!HaloMorph methodsFor: 'private' stamp: 'ar 10/24/2000 18:41'!
doDirection: anEvent with: directionHandle
	anEvent hand obtainHalo: self.
	self removeAllHandlesBut: directionHandle! !

!HaloMorph methodsFor: 'private' stamp: 'dgd 8/28/2003 15:15'!
addGraphicalHandle: formKey at: aPoint on: eventName send: selector to: recipient
	"Add the supplied form as a graphical handle centered at the given point, and set it up to respond to the given event by sending the given selector to the given recipient.  Return the handle."
	| handle |
	handle := self addGraphicalHandleFrom: formKey at: aPoint.
	handle on: eventName send: selector to: recipient.
	handle setBalloonText: (target balloonHelpTextForHandle: handle) translated.
	^ handle
! !

!HaloMorph methodsFor: 'stepping' stamp: 'StephaneDucasse 5/27/2010 22:22'!
localHaloBoundsFor: aMorph
	"aMorph may be in the hand and perhaps not in our world"

	| r |
	r := (self worldBoundsForMorph: aMorph) truncated.
	aMorph world = self world ifFalse: [^r].
	^((self transformFromOutermostWorld) globalBoundsToLocal: r) truncated! !

!HaloMorph methodsFor: 'private' stamp: 'ar 6/12/2001 05:24'!
setDirection: anEvent with: directionHandle
	"The user has let up after having dragged the direction arrow; now set the forward direction of the actual SketchMorph accordingly"
	anEvent hand obtainHalo: self.
	target setDirectionFrom: directionHandle center.
	self endInteraction! !

!HaloMorph methodsFor: 'private' stamp: 'aoy 2/15/2003 21:10'!
maybeCollapse: evt with: collapseHandle 
	"Ask hand to collapse my target if mouse comes up in it."

	evt hand obtainHalo: self.
	self delete.
	(collapseHandle containsPoint: evt cursorPoint) 
		ifFalse: 
			[
			target addHalo: evt]
		ifTrue: 
			[
			target collapse]! !

!HaloMorph methodsFor: 'private' stamp: 'ar 10/24/2000 18:43'!
trackDirectionArrow: anEvent with: shaft
	anEvent hand obtainHalo: self.
	shaft setVertices: {directionArrowAnchor. anEvent cursorPoint}.
	self layoutChanged! !

!HaloMorph methodsFor: 'events' stamp: 'tk 7/14/2001 11:04'!
dragTarget: event
	"Begin dragging the target"
	| thePoint |
	thePoint := target point: event position - positionOffset from: owner.
	target setConstrainedPosition: thePoint hangOut: true.
	event hand newMouseFocus: self.! !

!HaloMorph methodsFor: 'private' stamp: 'dgd 9/26/2004 19:39'!
addHandleAt: aPoint color: aColor icon: iconName on: eventName send: selector to: recipient 
	"Add a handle centered at the given point with the given color, 
	and set it up to respond to the given event by sending the 
	given selector to the given recipient. Return the handle."
	| handle |
	handle := self createHandleAt: aPoint color: aColor iconName: iconName.
	self addMorph: handle.

	handle on: #mouseUp send: #endInteraction to: self.
	handle on: eventName send: selector to: recipient.
	handle setBalloonText: (target balloonHelpTextForHandle: handle) translated.

	^ handle ! !

!HaloMorph methodsFor: 'menu' stamp: 'dgd 9/20/2004 19:35'!
wantsYellowButtonMenu
	"Answer true if the receiver wants a yellow button menu"
	^ false! !

!HaloMorph methodsFor: 'private' stamp: 'AlainPlantec 5/7/2010 23:00'!
startRot: evt with: rotHandle
	"Initialize rotation of my target if it is rotatable"

	self obtainHaloForEvent: evt andRemoveAllHandlesBut: rotHandle.
	target prepareForRotating.
	growingOrRotating := true.
	angleOffset := evt cursorPoint - (target pointInWorld: target referencePosition).
	angleOffset := Point
			r: angleOffset r
			degrees: angleOffset degrees - target rotationDegrees.

! !

!HaloMorph methodsFor: 'handles' stamp: 'gm 2/22/2003 13:13'!
addFontStyleHandle: haloSpec 
	(innerTarget isTextMorph) 
		ifTrue: 
			[self 
				addHandle: haloSpec
				on: #mouseDown
				send: #chooseStyle
				to: innerTarget]! !

!HaloMorph methodsFor: 'accessing' stamp: 'dgd 9/9/2004 22:55'!
wantsToBeTopmost
	"Answer if the receiver want to be one of the topmost objects in 
	its owner"
	^ true! !

!HaloMorph methodsFor: 'private' stamp: 'StephaneDucasse 6/28/2013 11:26'!
doDrag: evt with: dragHandle
	| thePoint |
	evt hand obtainHalo: self.
	thePoint := target point: evt position - positionOffset from: owner.
	target setConstrainedPosition:  thePoint hangOut: true.
! !

!HaloMorph methodsFor: 'handles' stamp: 'MarcusDenker 11/7/2009 21:51'!
addGrabHandle: haloSpec
	"If appropriate, add the black halo handle for picking up the target"

	self addHandle: haloSpec on: #mouseDown send: #doGrab:with: to: self

! !

!HaloMorph methodsFor: 'private' stamp: 'IgorStasenko 1/2/2012 18:05'!
obtainHaloForEvent: evt andRemoveAllHandlesBut: aHandle
	"Make sure the event's hand correlates with the receiver, and remove all handles except the given one.  If nil is provided as the handles argument, the result is that all handles are removed.  Note that any pending edits to the name-string in the halo are accepted at this time."

	evt hand obtainHalo: self.
	self removeAllHandlesBut: aHandle! !

!HaloMorph methodsFor: 'handles' stamp: 'sw 12/13/2001 14:07'!
addCollapseHandle: handleSpec
	"Add the collapse handle, with all of its event handlers set up, unless the target's owner is not the world or the hand."

	| collapseHandle |
	(target owner notNil "nil happens, amazingly"
			and: [target owner isWorldOrHandMorph])
		ifFalse: [^ self].
	collapseHandle := self addHandle: handleSpec
		on: #mouseDown send: #mouseDownInCollapseHandle:with: to: self.
	collapseHandle on: #mouseUp send: #maybeCollapse:with: to: self.
	collapseHandle on: #mouseMove send: #setDismissColor:with: to: self
! !

!HaloMorph methodsFor: 'private' stamp: 'adrian_lienhard 7/19/2009 17:34'!
mouseDownInDimissHandle: evt with: dismissHandle
	evt hand obtainHalo: self.
	self removeAllHandlesBut: dismissHandle.
	self setColor: Color darkGray toHandle: dismissHandle.
! !

!HaloMorph methodsFor: 'events-processing' stamp: 'nk 6/26/2002 07:19'!
handleListenEvent: anEvent
	"We listen for possible drop events here to add back those handles after a dup/grab operation"

	(anEvent isMouse and:[anEvent isMove not]) ifFalse:[^ self]. "not interested"
	anEvent hand removeMouseListener: self. "done listening"
	(self world ifNil: [target world]) ifNil: [^ self].
	self addHandles  "and get those handles back"! !

!HaloMorph methodsFor: 'accessing' stamp: 'AlainPlantec 1/7/2010 22:09'!
borderStyle
	"Answer the border style to use for the receiver.
	Depends on the target and on some settings."
	
	^(target notNil and: [self showBoundsInHalo and: [target isWorldMorph not]])
		ifTrue: [super borderStyle]
		ifFalse: [SimpleBorder width: 0 color: Color transparent]! !

!HaloMorph methodsFor: 'event handling' stamp: 'tk 7/14/2001 11:04'!
mouseMove: evt
	"Drag our target around"
	| thePoint |
	thePoint := target point: (evt position - positionOffset) from: owner.
	target setConstrainedPosition: thePoint hangOut: true.! !

!HaloMorph methodsFor: 'geometry testing' stamp: 'StephaneDucasse 9/4/2010 13:33'!
containsPoint: aPoint 
	"This method is overridden so that, once up, the handles will stay up as long as the mouse is within the box that encloses all the handles even if it is not over any handle or over its owner."

	^ target ifNil: [super containsPoint: aPoint] ifNotNil: [false]! !

!HaloMorph methodsFor: 'private' stamp: 'dgd 4/4/2006 16:56'!
addDirectionHandles

	| centerHandle d w directionShaft patch patchColor crossHairColor |
	self showingDirectionHandles ifFalse: [^ self].

	directionArrowAnchor := (target point: target referencePosition in: self world) rounded.
	patch := target imageFormForRectangle: (Rectangle center: directionArrowAnchor extent: 3@3).
	patchColor := patch colorAt: 1@1.

	(directionShaft := LineMorph newSticky makeForwardArrow)
		borderWidth: 2; borderColor: (Color green orColorUnlike: patchColor).
	self positionDirectionShaft: directionShaft.
	self addMorphFront: directionShaft.
	directionShaft setCenteredBalloonText: 'Set forward direction' translated;
		on: #mouseDown send: #doDirection:with: to: self;
		on: #mouseMove send: #trackDirectionArrow:with: to: self;
		on: #mouseUp send: #setDirection:with: to: self.

	d := 15.  "diameter"  w := 3.  "borderWidth"
	crossHairColor := Color red orColorUnlike: patchColor.
	(centerHandle := EllipseMorph newBounds: (0@0 extent: d@d) color: Color transparent)
			borderWidth: w; borderColor: (Color blue orColorUnlike: patchColor);
			addMorph: (LineMorph from: (d//2)@w to: (d//2)@(d-w-1) color: crossHairColor width: 1) lock;
			addMorph: (LineMorph from: w@(d//2) to: (d-w-1)@(d//2) color: crossHairColor width: 1) lock;
			align: centerHandle bounds center with: directionArrowAnchor.
	centerHandle wantsYellowButtonMenu: false.
	self addMorph: centerHandle.
	centerHandle setCenteredBalloonText: 'Rotation center (hold down the shift key and drag from here to change it)' translated;
			on: #mouseDown send: #prepareToTrackCenterOfRotation:with: to: self;
			on: #mouseMove send: #trackCenterOfRotation:with: to: self;
			on: #mouseUp send: #setCenterOfRotation:with: to: self
! !

!HaloMorph methodsFor: 'private' stamp: 'MarcusDenker 11/7/2009 17:36'!
addName
	"Add a name readout at the bottom of the halo."
	self addNameBeneath: self basicBox string: target externalName
! !

!HaloMorph methodsFor: 'private' stamp: 'AlainPlantec 1/7/2010 22:09'!
addFullHandles
	self addCircleHandles! !

!HaloMorph methodsFor: 'private' stamp: 'MarcusDenker 11/7/2009 18:52'!
maybeDoDup: evt with: dupHandle
	evt hand obtainHalo: self.
	^ self doDup: evt with: dupHandle! !

!HaloMorph methodsFor: 'private' stamp: 'dgd 2/22/2003 19:04'!
showingDirectionHandles
	^directionArrowAnchor notNil! !

!HaloMorph methodsFor: 'private' stamp: 'SeanDeNigris 5/22/2012 12:22'!
maybeDismiss: evt with: dismissHandle 
	"Ask hand to dismiss my target if mouse comes up
	in it." 

	| confirmed |
	evt hand obtainHalo: self.
	(dismissHandle containsPoint: evt cursorPoint)
		ifTrue: [
			target resistsRemoval ifTrue: [
				confirmed := self confirm: 'Really throw this away?' translated.
				confirmed ifFalse: [^ self]].
			evt hand removeHalo.
			self delete.
			target dismissViaHalo]
		ifFalse: [
			self delete.
			target addHalo: evt]! !

!HaloMorph methodsFor: 'settings' stamp: 'MarcusDenker 10/26/2011 14:57'!
gradientHalo
	^ true! !

!HaloMorph methodsFor: 'private' stamp: 'AlainPlantec 5/5/2010 18:03'!
startGrow: evt with: growHandle
	"Initialize resizing of my target.  Launch a command representing it, to support Undo"

	| botRt |
	self obtainHaloForEvent: evt andRemoveAllHandlesBut: growHandle.
	botRt := target point: target bottomRight in: owner.
	positionOffset := (self world viewBox containsPoint: botRt)
		ifTrue: [evt cursorPoint - botRt]
		ifFalse: [0@0].

	originalExtent := target extent! !

!HaloMorph methodsFor: 'handles' stamp: 'gm 2/22/2003 13:13'!
addFontSizeHandle: haloSpec 
	(innerTarget isTextMorph) 
		ifTrue: 
			[self 
				addHandle: haloSpec
				on: #mouseDown
				send: #chooseFont
				to: innerTarget]! !

!HaloMorph methodsFor: 'accessing' stamp: 'jm 5/22/1998 16:28'!
innerTarget

	^ innerTarget
! !

!HaloMorph methodsFor: 'event handling' stamp: 'sw 5/21/1998 15:41'!
wantsKeyboardFocusFor: aSubmorph
	"to allow the name to be edited in the halo in the old tty way; when we morphic-text-ize the name editing, presumably this method should be removed"
	^ true! !

!HaloMorph methodsFor: 'handles' stamp: 'MarcusDenker 9/13/2013 15:55'!
addRecolorHandle: haloSpec
	"Add a recolor handle to the receiver, if appropriate"

	"since this halo now opens a more general properties panel, allow it in all cases"
	"innerTarget canSetColor ifTrue:"

	self addHandle: haloSpec on: #mouseUp send: #doRecolor:with: to: self.! !

!HaloMorph class methodsFor: 'settings' stamp: 'AlainPlantec 12/6/2009 21:07'!
haloWithDebugHandle
	^ HaloWithDebugHandle ifNil: [HaloWithDebugHandle := true]! !

!HaloMorph class methodsFor: 'halo theme' stamp: 'AlainPlantec 12/12/2009 09:43'!
allHaloSpecsFromArray: anArray
	^ anArray collect: [:quin | self haloSpecFromArray: quin]! !

!HaloMorph class methodsFor: 'halo theme' stamp: 'AlainPlantec 12/12/2009 09:55'!
currentHaloSpecifications
	^ CurrentHaloSpecifications ifNil: [self installHaloTheme: #iconicHaloSpecifications]
! !

!HaloMorph class methodsFor: 'settings' stamp: 'AlainPlantec 12/11/2009 22:58'!
haloEnclosesFullBounds: aBoolean
	HaloEnclosesFullBounds := aBoolean! !

!HaloMorph class methodsFor: 'halo theme' stamp: 'StephaneDucasse 2/19/2010 16:26'!
simpleFullHaloSpecifications
	"This method gives the specs for the 'full' handles variant when simple halos are in effect"

	"
	self installHaloTheme: #simpleFullHaloSpecifications
	will result in the standard default halos being reinstalled"
	"NB: listed below in clockwise order"

	^ #(
	"  	selector				horiz		vert			color info						icon key
		---------				------		-----------		-------------------------------		---------------"
	(addDebugHandle:		right		topCenter		(blue	veryMuchLighter)		#haloDebugIcon)
	(addDismissHandle:		left			top				(red		muchLighter)			#haloDismissIcon)
	(addRotateHandle:		left			bottom			(blue)							#haloRotIcon)
	(addMenuHandle:		leftCenter	top				(red)							#haloMenuIcon)
	(addGrabHandle:			center		top				(black)							#halograbIcon)
	(addDragHandle:			rightCenter	top				(brown)							#haloDragIcon)
	(addDupHandle:			right		top				(green)							#haloDupIcon)	
	(addHelpHandle:			center		bottom			(lightBlue)						#haloHelpIcon')
	(addGrowHandle:		right		bottom			(yellow)						#haloScaleIcon)
	(addScaleHandle:		right		bottom			(lightOrange)					#haloScaleIcon)
	(addFewerHandlesHandle:	left		topCenter		(paleBuff)						#haloFewerHandlesIcon')
	(addFontSizeHandle:		leftCenter	bottom			(lightGreen)						#haloFontSizeIcon)
	(addFontStyleHandle:		center		bottom			(lightRed)						#haloFontStyleIcon)
	(addFontEmphHandle:	rightCenter	bottom			(lightBrown darker)		  		#haloFontEmphIcon)
	(addRecolorHandle:		right		bottomCenter	(magenta darker)				#haloRecolorIcon) ) ! !

!HaloMorph class methodsFor: 'settings' stamp: 'AlainPlantec 12/11/2009 22:59'!
showBoundsInHalo: aBoolean
	ShowBoundsInHalo := aBoolean! !

!HaloMorph class methodsFor: 'halo theme' stamp: 'StephaneDucasse 2/19/2010 16:26'!
iconicHaloSpecifications
	"Answer an array that characterizes the locations, colors, icons, and selectors of the halo handles that may be used in the iconic halo scheme"

	"self installHaloTheme: #iconicHaloSpecifications"

	^ #(
	"  	selector				horiz		vert			color info						icon key
		---------				------		-----------		-------------------------------		---------------"
	(addCollapseHandle:		left			topCenter		(tan)							#haloCollapseIcon)
	(addDebugHandle:		right		topCenter		(blue	veryMuchLighter)		#haloDebugIcon)
	(addDismissHandle:		left			top				(red		muchLighter)			#haloDismissIcon)
	(addRotateHandle:		left			bottom			(blue)							#haloRotIcon)
	(addMenuHandle:		leftCenter	top				(red)							#haloMenuIcon)
	(addGrabHandle:			center		top				(black)							#haloGrabIcon)
	(addDragHandle:			rightCenter	top				(brown)							#haloDragIcon)
	(addDupHandle:			right		top				(green)							#haloDupIcon)	
	(addHelpHandle:			center		bottom			(lightBlue)						#haloHelpIcon)
	(addGrowHandle:		right		bottom			(yellow)						#haloScaleIcon)
	(addScaleHandle:		right		bottom			(lightOrange)					#haloScaleIcon)
	(addFontSizeHandle:		leftCenter	bottom			(lightGreen)						#haloFontSizeIcon)
	(addFontStyleHandle:		center		bottom			(lightRed)						#haloFontStyleIcon)
	(addFontEmphHandle:	rightCenter	bottom			(lightBrown darker)				#haloFontEmphIcon)
	(addRecolorHandle:		right		bottomCenter	(magenta darker)				#haloRecolorIcon) )
! !

!HaloMorph class methodsFor: 'settings' stamp: 'AlainPlantec 12/11/2009 22:58'!
showBoundsInHalo
	^ ShowBoundsInHalo ifNil: [ShowBoundsInHalo := false]! !

!HaloMorph class methodsFor: 'halo theme' stamp: 'AlainPlantec 12/12/2009 09:54'!
haloSpecificationsForWorld
	| desired |
	"Answer a list of HaloSpecs that describe which halos 
	are to be used on a world halo, what they should 
	look like, and where they should be situated"

	desired := #(addDebugHandle: addMenuHandle:   addHelpHandle:  addRecolorHandle:).
	^ self currentHaloSpecifications 
		select: [:spec | desired includes: spec addHandleSelector]! !

!HaloMorph class methodsFor: 'settings' stamp: 'AlainPlantec 12/6/2009 21:13'!
haloWithDebugHandle: aBoolean
	 HaloWithDebugHandle := aBoolean! !

!HaloMorph class methodsFor: 'halo theme' stamp: 'StephaneDucasse 6/4/2014 16:38'!
initialize
	"self initialize"
	
	self installHaloTheme: #iconicHaloSpecifications
! !

!HaloMorph class methodsFor: 'settings' stamp: 'AlainPlantec 12/11/2009 22:58'!
haloEnclosesFullBounds
	^ HaloEnclosesFullBounds ifNil: [HaloEnclosesFullBounds := false]! !

!HaloMorph class methodsFor: 'halo theme' stamp: 'StephaneDucasse 2/19/2010 16:26'!
classicHaloSpecifications
	"Non-iconic halos with traditional placements"

	"
	self installHaloTheme: #classicHaloSpecifications
	will result in the standard default halos being reinstalled"
	"NB: listed below in clockwise order"

		^ #(
	"  	selector				horiz		vert			color info						icon key
		---------				------		-----------		-------------------------------		---------------"
	(addMenuHandle:		left			top				(red)							none)
	(addDismissHandle:		leftCenter	top				(red		muchLighter)			#haloDismissIcon)
	(addGrabHandle:			center		top				(black)							none)
	(addDragHandle:			rightCenter	top				(brown)							none)
	(addDupHandle:			right		top				(green)							none)	
	(addDebugHandle:		right		topCenter		(blue	veryMuchLighter)		none)
	(addGrowHandle:		right		bottom			(yellow)						none)
	(addScaleHandle:		right		bottom			(lightOrange)					none)
	(addFontEmphHandle:	rightCenter	bottom			(lightBrown darker)				none)
	(addFontStyleHandle:		center		bottom			(lightRed)						none)
	(addFontSizeHandle:		leftCenter	bottom			(lightGreen)						none)

	(addRecolorHandle:		right		bottomCenter	(magenta darker)				none)

	(addRotateHandle:		left			bottom			(blue)							none))

! !

!HaloMorph class methodsFor: 'halo theme' stamp: 'AlainPlantec 12/12/2009 09:39'!
haloSpecFromArray: anArray 
	| aColor |
	aColor := Color.
	anArray fourth
		do: [:sel | aColor := aColor perform: sel].
	^ HaloSpec new
		horizontalPlacement: anArray second
		verticalPlacement: anArray third
		color: aColor
		iconSymbol: anArray fifth
		addHandleSelector: anArray first ! !

!HaloMorph class methodsFor: 'halo theme' stamp: 'AlainPlantec 12/12/2009 09:52'!
installHaloTheme: haloSpecificationsSelector
	^ CurrentHaloSpecifications := self allHaloSpecsFromArray: (self perform: haloSpecificationsSelector).
! !

!HaloMorph class methodsFor: 'halo theme' stamp: 'StephaneDucasse 2/19/2010 16:26'!
customHaloSpecifications
	"Intended for you to modify to suit your personal preference.  What is implemented in the default here is just a skeleton; in comment at the bottom of this method are some useful lines you may wish to paste in to the main body here, possibly modifying positions, colors, etc..
	Note that in this example, we include:
			Dismiss handle, at top-left
			Menu handle, at top-right
			Resize handle, at bottom-right
			Rotate handle, at bottom-left
			Drag handle, at top-center
			Recolor handle, at left-center.  (this one is NOT part of the standard formulary --
											it is included here to illustrate how to
 											add non-standard halos)
			Note that the optional handles for specialized morphs, such as Sketch, Text, PasteUp, are also included"

	^ #(
	(addDismissHandle:		left			top				(red		muchLighter)			#haloDismissIcon)
	(addMenuHandle:		right		top				(red)							#haloMenuIcon)
	(addDragHandle:			center	top					(brown)							#haloDragIcon)
	(addGrowHandle:		right		bottom			(yellow)						#haloScaleIcon)
	(addScaleHandle:		right		bottom			(lightOrange)					#haloScaleIcon)

	(addRecolorHandle:		left			center			(green muchLighter lighter)		#haloRecolorIcon)
	(addFontSizeHandle:		leftCenter	bottom			(lightGreen)						#haloFontSizeIcon)
	(addFontStyleHandle:		center		bottom			(lightRed)						#haloFontStyleIcon)
	(addFontEmphHandle:	rightCenter	bottom			(lightBrown darker)				#haloFontEmphIcon)
	(addRotateHandle:		left			bottom			(blue)							#haloRotIcon)

	(addDebugHandle:		right		topCenter		(blue	veryMuchLighter)		#haloDebugIcon) )

	"  Other useful handles...

  		selector				horiz		vert			color info						icon key
		---------				------		-----------		-------------------------------		---------------

	(addTileHandle:			left			bottomCenter	(lightBrown)					#haloTileIcon)
	(addViewHandle:			left			center			(cyan)							#haloViewIcon)
	(addGrabHandle:			center		top				(black)							#haloGrabIcon)
	(addDragHandle:			rightCenter	top				(brown)							#haloDragIcon)
	(addDupHandle:			right		top				(green)							#haloDupIcon)	
	(addHelpHandle:			center		bottom			(lightBlue)						#haloHelpIcon)
	(addFewerHandlesHandle:	left		topCenter		(paleBuff)						#haloFewerHandlesIcon)
	(addPaintBgdHandle:		right		center			(lightGray)						#haloPaintIcon)
	"
! !

!HaloSpec commentStamp: 'kfr 10/27/2003 16:23'!
Sets spec's for how handles are layed out in a halo.!
!HaloSpec methodsFor: 'accessing' stamp: 'sw 1/25/2000 18:41'!
horizontalPlacement
	^ horizontalPlacement! !

!HaloSpec methodsFor: 'actions' stamp: 'sw 1/25/2000 19:54'!
addHandleSelector
	^ addHandleSelector! !

!HaloSpec methodsFor: 'accessing' stamp: 'sw 1/25/2000 18:41'!
iconSymbol
	^ iconSymbol! !

!HaloSpec methodsFor: 'accessing' stamp: 'sw 1/25/2000 18:41'!
verticalPlacement
	^ verticalPlacement! !

!HaloSpec methodsFor: 'accessing' stamp: 'sw 1/25/2000 18:41'!
color
	^ color! !

!HaloSpec methodsFor: 'printing' stamp: 'sw 11/15/2001 16:31'!
printOn: aStream
	"Add a textual printout representing the receiver to a stream"

	super printOn: aStream.
	aStream nextPutAll: ' (', addHandleSelector asString, ' ', iconSymbol asString, ')'! !

!HaloSpec methodsFor: 'setter' stamp: 'sw 1/25/2000 19:54'!
horizontalPlacement: hp verticalPlacement: vp color: col iconSymbol: is addHandleSelector: sel
	horizontalPlacement := hp.
	verticalPlacement := vp.
	color:= col.
	iconSymbol := is asSymbol.
	addHandleSelector := sel! !

!Halt commentStamp: '<historical>'!
Halt is provided to support Object>>halt.!
!Halt methodsFor: 'accessing' stamp: 'BenComan 1/31/2015 22:50'!
signalerContext
	"specialized version to find the proper context to open the debugger on.
	This will find the first context whose method is no longer on Halt or Halt class nor is #halt method iteself."
	^ signalContext findContextSuchThat: [ :context |
		(context receiver == self 
		or: [ (context receiver == self class) 
		or: [ context methodNode hasPragmaNamed: #debuggerCompleteToSender ]]) not ]

"aContext methodNode pragmaNamed: #debuggerCompleteToSender ifPresent: [ ^ self completeTo: aContext sender ]"! !

!Halt methodsFor: 'priv handling' stamp: 'CamilloBruni 2/24/2013 20:37'!
defaultAction
	"No one has handled this error, but now give them a chance to decide how to debug it.  If none handle this either then open debugger (see UnhandedError-defaultAction)"

	^ UIManager default unhandledErrorDefaultAction: self
	"^ UnhandledError signalForException: self" ! !

!Halt class methodsFor: 'private' stamp: 'SeanDeNigris 8/29/2011 17:43'!
haltIfBlockWithCallingObject: aBlock

	 | callingObject |
	callingObject := thisContext sender sender receiver.
	(aBlock cull: callingObject)
		ifTrue: [self signal]
		ifFalse: [^ self].! !

!Halt class methodsFor: 'private' stamp: 'SeanDeNigris 8/29/2011 17:18'!
isCounting

	^ callsUntilHaltOnCount > 0.! !

!Halt class methodsFor: 'halting' stamp: 'BenComan 1/28/2015 00:20'!
once
	"To enable, use self enableHaltOnce"
	<debuggerCompleteToSender>	
	self isHaltOnceEnabled ifTrue: [
			self disableHaltOnce.
			^ self signal]! !

!Halt class methodsFor: 'private' stamp: 'SeanDeNigris 8/29/2011 17:19'!
stopCounting

	callsUntilHaltOnCount := 0.! !

!Halt class methodsFor: 'halting' stamp: 'BenComan 1/28/2015 00:19'!
halt: aString
	"backward compatible method with self halt:"
	<debuggerCompleteToSender>

	self signal: aString! !

!Halt class methodsFor: 'once-enabling/disabling' stamp: 'SeanDeNigris 8/29/2011 16:04'!
disableHaltOnce

	isHaltOnceEnabled := false.! !

!Halt class methodsFor: 'halting' stamp: 'BenComan 1/28/2015 00:20'!
ifShiftPressed
	<debuggerCompleteToSender>

	self if: [Sensor shiftPressed]! !

!Halt class methodsFor: 'private' stamp: 'SeanDeNigris 8/29/2011 17:43'!
haltIfCallChainContains: aSelector

		| cntxt |
	cntxt := thisContext.
		[cntxt sender isNil] whileFalse: [
			cntxt := cntxt sender. 
			(cntxt selector = aSelector) ifTrue: [self signal]].! !

!Halt class methodsFor: 'once-enabling/disabling' stamp: 'StephaneDucasse 11/2/2012 13:48'!
enableHaltOnce
	"self enableHaltOnce"
	isHaltOnceEnabled := true.! !

!Halt class methodsFor: 'once-enabling/disabling' stamp: 'StephaneDucasse 8/29/2011 23:20'!
isHaltOnceEnabled

	^ isHaltOnceEnabled ifNil: [isHaltOnceEnabled := false]! !

!Halt class methodsFor: 'class initialization' stamp: 'StephaneDucasse 8/29/2011 23:22'!
initialize

	isHaltOnceEnabled := false.
	callsUntilHaltOnCount := 1.! !

!Halt class methodsFor: 'halting' stamp: 'BenComan 1/28/2015 00:23'!
halt
	"backward compatible method with self halt"
	<debuggerCompleteToSender>
	
	self signal! !

!Halt class methodsFor: 'halting' stamp: 'BenComan 1/28/2015 00:20'!
now: aString
	"set a breakpoint with some explanation"
	<debuggerCompleteToSender>
	self signal: aString! !

!Halt class methodsFor: 'private' stamp: 'SeanDeNigris 8/29/2011 17:24'!
callsUntilHaltOnCount

	^ callsUntilHaltOnCount.! !

!Halt class methodsFor: 'private' stamp: 'SeanDeNigris 8/29/2011 17:24'!
callsUntilHaltOnCount: anInteger

	callsUntilHaltOnCount := anInteger.! !

!Halt class methodsFor: 'halting' stamp: 'BenComan 1/31/2015 23:18'!
if: condition
	<debuggerCompleteToSender>
	"This is the typical message to use for inserting breakpoints during 
	debugging.
	
	The argument can be one of the following:
		- a block: if the Block has one arg, the calling object is bound to that.
		- an expression
 		- a selector: Halt if found in the call chain"

	condition isSymbol ifTrue: [ ^ self haltIfCallChainContains: condition ].
	condition isBlock ifTrue: [ ^ self haltIfBlockWithCallingObject: condition].
	condition ifTrue: [self signal].! !

!Halt class methodsFor: 'halting' stamp: 'BenComan 1/28/2015 00:17'!
now
	<debuggerCompleteToSender>

	self signal.! !

!Halt class methodsFor: 'halting' stamp: 'BenComan 1/28/2015 00:20'!
onCount: anInteger 
	"Halt on the anInteger-th time through"
	<debuggerCompleteToSender>	
	| currentCount |
	currentCount := self isCounting 
		ifTrue: [ self callsUntilHaltOnCount ]
		ifFalse: [ anInteger ].
	self callsUntilHaltOnCount: currentCount - 1.
	self callsUntilHaltOnCount = 0 ifTrue: [ self signal ].! !

!HandMorph commentStamp: '<historical>'!
The cursor may be thought of as the HandMorph.  The hand's submorphs hold anything being carried by dragging.  

There is some minimal support for multiple hands in the same world.!
!HandMorph methodsFor: 'listeners' stamp: 'ar 10/26/2000 01:28'!
mouseListeners
	^mouseListeners! !

!HandMorph methodsFor: 'drawing' stamp: 'dgd 2/21/2003 22:49'!
savePatchFrom: aCanvas 
	"Save the part of the given canvas under this hand as a Form and return its bounding rectangle."

	"Details: The previously used patch Form is recycled when possible to reduce the burden on storage management."

	| damageRect myBnds |
	damageRect := myBnds := self fullBounds.
	savedPatch ifNotNil: 
			[damageRect := myBnds merge: (savedPatch offset extent: savedPatch extent)].
	(savedPatch isNil or: [savedPatch extent ~= myBnds extent]) 
		ifTrue: 
			["allocate new patch form if needed"

			savedPatch := aCanvas form allocateForm: myBnds extent].
	aCanvas contentsOfArea: (myBnds translateBy: aCanvas origin)
		into: savedPatch.
	savedPatch offset: myBnds topLeft.
	^damageRect! !

!HandMorph methodsFor: 'events-processing' stamp: 'StephaneDucasse 12/26/2011 10:49'!
showMouseFocusEvent: evt

	ShowEvents == true ifTrue: [
		| ofs| 
		ofs := (owner hands indexOf: self) - 1 * 60.
		self mouseFocus printString displayAt: (0@ofs) + (0@15)].
		! !

!HandMorph methodsFor: 'focus handling' stamp: 'nk 2/14/2004 18:44'!
mouseFocus: aMorphOrNil
	mouseFocus := aMorphOrNil! !

!HandMorph methodsFor: 'focus handling' stamp: 'ar 10/6/2000 00:09'!
releaseKeyboardFocus
	"Release the current keyboard focus unconditionally"
	self newKeyboardFocus: nil.
! !

!HandMorph methodsFor: 'selected object' stamp: 'ClementBera 7/30/2013 11:06'!
selectedObject
	"answer the selected object for the hand or nil is none"
	| halo |
	halo := self halo.
	halo ifNil: [^ nil].
	^ halo target renderedMorph! !

!HandMorph methodsFor: 'event handling' stamp: 'ar 9/25/2000 14:27'!
noticeMouseOver: aMorph event: anEvent
	mouseOverHandler ifNil:[^self].
	mouseOverHandler noticeMouseOver: aMorph event: anEvent.! !

!HandMorph methodsFor: 'initialization' stamp: 'StephaneDucasse 12/26/2011 10:18'!
initialize
	super initialize.
	self initForEvents.
	keyboardFocus := nil.
	mouseFocus := nil.
	bounds := 0@0 extent: Cursor normal extent.
	damageRecorder := DamageRecorder new.
	cachedCanvasHasHoles := false.
	temporaryCursor := temporaryCursorOffset := nil.
	self initForEvents.! !

!HandMorph methodsFor: 'paste buffer' stamp: 'ar 10/5/2000 19:11'!
pasteBuffer: aMorphOrNil
	"Set the contents of the paste buffer."
	PasteBuffer := aMorphOrNil.

! !

!HandMorph methodsFor: 'grabbing/dropping' stamp: 'ar 9/14/2000 11:22'!
dropMorphs: anEvent
	"Drop the morphs at the hands position"
	self submorphsReverseDo:[:m|
		"Drop back to front to maintain z-order"
		self dropMorph: m event: anEvent.
	].! !

!HandMorph methodsFor: 'halo handling' stamp: 'GabrielOmarCotelli 11/30/2013 16:46'!
obtainHalo: aHalo
	"Used for transfering halos between hands"

	self halo == aHalo
		ifTrue: [ ^ self ].	
	"Find former owner"
	self world hands detect: [ :hand | hand halo == aHalo ] ifFound: [ :formerOwner | formerOwner releaseHalo: aHalo ].
	self halo: aHalo! !

!HandMorph methodsFor: 'event handling' stamp: 'dgd 2/21/2003 22:43'!
cursorPoint
	"Implemented for allowing embedded worlds in an event cycle to query a hand's position and get it in its coordinates. The same can be achieved by #point:from: but this is simply much more convenient since it will look as if the hand is in the lower world."

	| pos |
	pos := self position.
	(ActiveWorld isNil or: [ActiveWorld == owner]) ifTrue: [^pos].
	^ActiveWorld point: pos from: owner! !

!HandMorph methodsFor: 'private events' stamp: 'ar 3/18/2001 01:42'!
sendFocusEvent: anEvent to: focusHolder clear: aBlock
	"Send the event to the morph currently holding the focus"
	| result w |
	w := focusHolder world ifNil:[^ aBlock value].
	w becomeActiveDuring:[
		ActiveHand := self.
		ActiveEvent := anEvent.
		result := focusHolder handleFocusEvent: 
			(anEvent transformedBy: (focusHolder transformedFrom: self)).
	].
	^result! !

!HandMorph methodsFor: 'cursor' stamp: 'ClementBera 7/30/2013 11:06'!
showTemporaryCursor: cursorOrNil hotSpotOffset: hotSpotOffset 
	"Set the temporary cursor to the given Form.
	If the argument is nil, revert to the normal hardware cursor."

	self changed.
	temporaryCursorOffset 
		ifNotNil: [bounds := bounds translateBy: temporaryCursorOffset negated].
	cursorOrNil 
		ifNil: [temporaryCursor := temporaryCursorOffset := hardwareCursor := nil]
		ifNotNil: 
			[temporaryCursor := cursorOrNil asCursorForm.
			temporaryCursorOffset := temporaryCursor offset - hotSpotOffset.
			(cursorOrNil isKindOf: Cursor) ifTrue: [hardwareCursor := cursorOrNil]].
	bounds := self cursorBounds.
	self
		layoutChanged;
		changed! !

!HandMorph methodsFor: '*SUnit-UITesting' stamp: 'GuillermoPolito 3/19/2013 19:12'!
simulateKeyStroke: aCharacterOrShortcut

	| shortcut |
	shortcut := aCharacterOrShortcut asKeyCombination.
	self handleEvent: (KeyboardEvent new
		setType: #keystroke
		buttons: shortcut modifier eventCode
		position: self position 
		keyValue: shortcut key asciiValue
		charCode: shortcut key asciiValue
		hand: self activeHand 
		stamp: DateAndTime now).! !

!HandMorph methodsFor: 'events-processing' stamp: 'BenComan 1/3/2015 12:44'!
handleEvent: anEvent
	| evt  |
	owner ifNil:[^self].
	evt := anEvent.
	
	"nil test here is for efficiency in the normal case"
	EventStats ifNotNil: [ self class logEventStats: evt ]. 
	
	evt isMouse ifTrue:[
		 "just for record, to be used by capture block" 
		lastMouseEvent := evt].

	captureBlock ifNotNil: [ ^ captureBlock value: anEvent ].
	evt isMouseOver ifTrue:[^self sendMouseEvent: evt].
	
	self showDebugEvent: evt.
	
	"Notify listeners"
	self sendListenEvent: evt to: self eventListeners.

	evt isWindowEvent ifTrue: [
		self sendEvent: evt focus: nil.
		^self mouseOverHandler processMouseOver: lastMouseEvent].
	

	evt isKeyboard ifTrue:[
		self sendListenEvent: evt to: self keyboardListeners.
		self sendKeyboardEvent: evt.
		^self mouseOverHandler processMouseOver: lastMouseEvent].

	evt isDropEvent ifTrue:[
		self sendEvent: evt focus: nil.
		^self mouseOverHandler processMouseOver: lastMouseEvent].

	evt isMouse ifTrue:[
		self sendListenEvent: evt to: self mouseListeners.
		lastMouseEvent := evt].

	"Check for pending drag or double click operations."
	mouseClickState ifNotNil:[
		(mouseClickState handleEvent: evt from: self) ifFalse:[
			"Possibly dispatched #click: or something and will not re-establish otherwise"
			^self mouseOverHandler processMouseOver: lastMouseEvent]].

	evt isMove ifTrue:[
		| pos |
		pos := evt position.
		evt isDraggingEvent ifTrue: [ 
			| treshold |
			treshold := 0.
			(self submorphs at: 1 ifAbsent: [ nil ])
				ifNotNil: [ :first | treshold := self top-first top ].
			pos y < (self class upperHandLimit+treshold) ifTrue: [ pos := pos x @ (self class upperHandLimit + treshold)] ].
		
		self position: pos.
		self sendMouseEvent: evt.
	] ifFalse:[
		"Issue a synthetic move event if we're not at the position of the event"
		(evt position = self position) ifFalse:[self moveToEvent: evt].
		"Drop submorphs on button events"
		(self hasSubmorphs) 
			ifTrue:[self dropMorphs: evt]
			ifFalse:[self sendMouseEvent: evt].
	].
	self showMouseFocusEvent: evt.
	self mouseOverHandler processMouseOver: lastMouseEvent.
! !

!HandMorph methodsFor: 'drawing' stamp: 'nk 10/24/2003 22:12'!
visible: aBoolean
	self needsToBeDrawn ifFalse: [ ^self ].
	super visible: aBoolean! !

!HandMorph methodsFor: 'focus handling' stamp: 'ClementBera 7/30/2013 11:06'!
newMouseFocus: aMorph event: event 
	aMorph ifNotNil: [targetOffset := event cursorPoint - aMorph position].
	^self newMouseFocus: aMorph! !

!HandMorph methodsFor: 'private events' stamp: 'AlainPlantec 1/7/2010 19:44'!
sendKeyboardEvent: anEvent 
	"Send the event to the morph currently holding the focus, or if none to
	the owner of the hand."
	^ self
		sendEvent: anEvent
		focus: self keyboardFocus
		clear: [self keyboardFocus: nil]! !

!HandMorph methodsFor: 'drawing' stamp: 'ClementBera 7/30/2013 11:06'!
drawOn: aCanvas 
	"Draw the hand itself (i.e., the cursor)."

	temporaryCursor 
		ifNil: [aCanvas paintImage: NormalCursor at: bounds topLeft]
		ifNotNil: [aCanvas paintImage: temporaryCursor at: bounds topLeft].
	! !

!HandMorph methodsFor: 'accessing' stamp: 'ar 10/5/2000 23:17'!
lastEvent
	^ lastMouseEvent! !

!HandMorph methodsFor: 'drop shadows' stamp: ''!
shadowOffset

	^ 6@8! !

!HandMorph methodsFor: 'focus handling' stamp: 'ar 10/26/2000 01:32'!
newMouseFocus: aMorphOrNil
	"Make the given morph the new mouse focus, canceling the previous mouse focus if any. If the argument is nil, the current mouse focus is cancelled."
	self mouseFocus: aMorphOrNil.
! !

!HandMorph methodsFor: 'private events' stamp: 'ar 3/18/2001 01:45'!
sendMouseEvent: anEvent
	"Send the event to the morph currently holding the focus, or if none to the owner of the hand."
	^self sendEvent: anEvent focus: self mouseFocus clear:[self mouseFocus: nil]! !

!HandMorph methodsFor: 'balloon help' stamp: 'ar 10/3/2000 17:15'!
spawnBalloonFor: aMorph
	aMorph showBalloon: aMorph balloonText hand: self.! !

!HandMorph methodsFor: 'accessing' stamp: 'tk 10/20/2004 15:54'!
anyButtonPressed
	^lastMouseEvent anyButtonPressed! !

!HandMorph methodsFor: 'drawing' stamp: 'StephaneDucasse 12/26/2011 10:19'!
restoreSavedPatchOn: aCanvas 
	"Clear the changed flag and restore the part of the given canvas under this hand from the previously saved patch. If necessary, handle the transition to using the hardware cursor."
	| cursor |

	hasChanged := false.
	savedPatch ifNotNil: 
			[aCanvas drawImage: savedPatch at: savedPatch offset.
			submorphs notEmpty ifTrue: [^self].
			(temporaryCursor notNil and: [hardwareCursor isNil]) ifTrue: [^self].

			"Make the transition to using hardware cursor. Clear savedPatch and
		 report one final damage rectangle to erase the image of the software cursor."
			super invalidRect: (savedPatch offset 
						extent: savedPatch extent + self shadowOffset)
				from: self.
			cursor := hardwareCursor ifNil: [Cursor normal].
			cursor isCurrent ifFalse: [cursor show].	"show hardware cursor"
			savedPatch := nil]! !

!HandMorph methodsFor: 'drawing' stamp: 'ls 4/3/2000 20:30'!
hasChanged
	"Return true if this hand has changed, either because it has moved or because some morph it is holding has changed."

	^ hasChanged ifNil: [ true ]
! !

!HandMorph methodsFor: 'accessing' stamp: ''!
targetOffset
	"Return the offset of the last mouseDown location relative to the origin of the recipient morph. During menu interactions, this is the absolute location of the mouse down event that invoked the menu."

	^ targetOffset
! !

!HandMorph methodsFor: 'accessing' stamp: 'tk 10/20/2004 15:54'!
noButtonPressed
	"Answer whether any mouse button is not being pressed."

	^self anyButtonPressed not! !

!HandMorph methodsFor: 'drawing' stamp: 'StephaneDucasse 12/26/2011 10:19'!
needsToBeDrawn
	"Return true if this hand must be drawn explicitely instead of being drawn via the hardware cursor. This is the case if it (a) it is a remote hand, (b) it is showing a temporary cursor, or (c) it is not empty and there are any visible submorphs. If using the software cursor, ensure that the hardware cursor is hidden."
	"Details:  Return true if this hand has a saved patch to ensure that is is processed by the world. This saved patch will be deleted after one final display pass when it becomes possible to start using the hardware cursor again. This trick gives us one last display cycle to allow us to remove the software cursor and shadow from the display."
	| cursor |
	(savedPatch notNil
		or: [ (submorphs anySatisfy: [ :ea | ea visible ])
			or: [ (temporaryCursor notNil and: [hardwareCursor isNil])
				]])
		ifTrue: [
			"using the software cursor; hide the hardware one"
			Cursor blank isCurrent ifFalse: [Cursor blank show].
			^ true].
	"Switch from one hardware cursor to another, if needed."
	cursor := hardwareCursor ifNil: [Cursor normal].
	cursor isCurrent ifFalse: [cursor show].
	^ false
! !

!HandMorph methodsFor: '*Morphic-Base' stamp: 'dgd 3/31/2003 18:22'!
generateDropFilesEvent: evtBuf 
	"Generate the appropriate mouse event for the given raw event buffer"

	"Note: This is still in an experimental phase and will need more work"

	| position buttons modifiers stamp numFiles dragType |
	stamp := evtBuf second.
	stamp = 0 ifTrue: [stamp := Time millisecondClockValue].
	dragType := evtBuf third.
	position := evtBuf fourth @ evtBuf fifth.
	buttons := 0.
	modifiers := evtBuf sixth.
	buttons := buttons bitOr: (modifiers bitShift: 3).
	numFiles := evtBuf seventh.
	dragType = 4 
		ifTrue: 
			["e.g., drop"

			owner borderWidth: 0.
			^DropFilesEvent new 
				setPosition: position
				contents: numFiles
				hand: self].
	"the others are currently not handled by morphs themselves"
	dragType = 1 
		ifTrue: 
			["experimental drag enter"

			owner
				borderWidth: 4;
				borderColor: owner color asColor negated].
	dragType = 2 
		ifTrue: 
			["experimental drag move"

			].
	dragType = 3 
		ifTrue: 
			["experimental drag leave"

			owner borderWidth: 0].
	^nil! !

!HandMorph methodsFor: 'focus handling' stamp: 'ar 10/6/2000 00:10'!
mouseFocus
	^mouseFocus! !

!HandMorph methodsFor: 'updating' stamp: 'jm 2/20/98 19:54'!
changed

	hasChanged := true.
! !

!HandMorph methodsFor: 'drawing' stamp: 'dgd 2/21/2003 22:49'!
updateCacheCanvas: aCanvas 
	"Update the cached image of the morphs being held by this hand."

	"Note: The following is an attempt to quickly get out if there's no change"

	| subBnds rectList nPix |
	subBnds := Rectangle merging: (submorphs collect: [:m | m fullBounds]).
	rectList := damageRecorder invalidRectsFullBounds: subBnds.
	damageRecorder reset.
	(rectList isEmpty 
		and: [cacheCanvas notNil and: [cacheCanvas extent = subBnds extent]]) 
			ifTrue: [^self].

	"Always check for real translucency -- can't be cached in a form"
	self submorphsDo: 
			[:m | 
			m wantsToBeCachedByHand 
				ifFalse: 
					[cacheCanvas := nil.
					cachedCanvasHasHoles := true.
					^self]].
	(cacheCanvas isNil or: [cacheCanvas extent ~= subBnds extent]) 
		ifTrue: 
			[cacheCanvas := (aCanvas allocateForm: subBnds extent) getCanvas.
			cacheCanvas translateBy: subBnds origin negated
				during: [:tempCanvas | self drawSubmorphsOn: tempCanvas].
			self submorphsDo: 
					[:m | 
					(m areasRemainingToFill: subBnds) isEmpty 
						ifTrue: [^cachedCanvasHasHoles := false]].
			nPix := cacheCanvas form tallyPixelValues first.
			"--> begin rounded corners hack <---"
			cachedCanvasHasHoles := (nPix = 48 
						and: [submorphs size = 1 and: [submorphs first wantsRoundedCorners]]) 
							ifTrue: [false]
							ifFalse: [nPix > 0].
			"--> end rounded corners hack <---"
			^self].

	"incrementally update the cache canvas"
	cacheCanvas translateBy: subBnds origin negated
		during: 
			[:cc | 
			rectList do: 
					[:r | 
					cc clipBy: r
						during: 
							[:c | 
							c fillColor: Color transparent.
							self drawSubmorphsOn: c]]]! !

!HandMorph methodsFor: 'meta-actions' stamp: 'ar 11/6/2000 13:07'!
copyToPasteBuffer: aMorph
	"Save this morph in the paste buffer. This is mostly useful for copying morphs between projects."
	aMorph ifNil:[^PasteBuffer := nil].
	Cursor wait showWhile:[
		PasteBuffer := aMorph topRendererOrSelf veryDeepCopy.
		PasteBuffer privateOwner: nil].

! !

!HandMorph methodsFor: 'accessing' stamp: 'wiz 12/4/2006 00:16'!
targetPoint
	"Return the new position of the target.
	I.E. return the position of the hand less 
	the original distance between hand and target position"

	^ self position - targetOffset
! !

!HandMorph methodsFor: 'paste buffer' stamp: 'ar 10/5/2000 19:10'!
pasteBuffer
	"Return the paste buffer associated with this hand"
	^ PasteBuffer! !

!HandMorph methodsFor: 'listeners' stamp: 'ar 10/26/2000 01:27'!
eventListeners: anArrayOrNil
	eventListeners := anArrayOrNil! !

!HandMorph methodsFor: 'events-processing' stamp: 'MarcusDenker 7/28/2013 13:03'!
showDebugEvent: evt

	ShowEvents == true ifTrue: [
		| ofs| 
		Display fill: (0@0 extent: 500@120) rule: Form over fillColor: Color white.
		ofs := (owner hands indexOf: self) - 1 * 60.
		evt printString displayAt: (0@ofs) + (evt isKeyboard ifTrue: [0@30] ifFalse: [0@0]).
		self keyboardFocus printString displayAt: (0@ofs)+(0@45).
		].! !

!HandMorph methodsFor: 'accessing' stamp: 'MarcusDenker 9/13/2013 16:31'!
cursorBounds

	temporaryCursor
		ifNil: [^ self position extent: NormalCursor extent]
		ifNotNil: [^ self position + temporaryCursorOffset
								extent: temporaryCursor extent]! !

!HandMorph methodsFor: 'events-processing' stamp: 'IgorStasenko 1/2/2012 18:41'!
waitButton
	self captureEventsUntil: [:evt | self anyButtonPressed ]
! !

!HandMorph methodsFor: 'change reporting' stamp: 'ar 12/30/2001 17:32'!
invalidRect: damageRect from: aMorph
	"Note that a change has occurred and record the given damage rectangle relative to the origin this hand's cache."
	hasChanged := true.
	aMorph == self ifTrue:[^self].
	damageRecorder recordInvalidRect: damageRect.
! !

!HandMorph methodsFor: 'grabbing/dropping' stamp: 'ar 10/8/2000 23:42'!
attachMorph: m
	"Position the center of the given morph under this hand, then grab it.
	This method is used to grab far away or newly created morphs."
	| delta |
	self releaseMouseFocus. "Break focus"
	delta := m bounds extent // 2.
	m position: (self position - delta).
	m formerPosition: m position.
	targetOffset := m position - self position.
	self addMorphBack: m.! !

!HandMorph methodsFor: 'accessing' stamp: 'ar 9/25/2000 14:24'!
mouseOverHandler
	^mouseOverHandler ifNil:[mouseOverHandler := MouseOverHandler new].! !

!HandMorph methodsFor: 'listeners' stamp: 'ar 10/24/2000 20:41'!
removeEventListener: anObject
	"Remove anObject from the current event listeners."
	self eventListeners: (self removeListener: anObject from: self eventListeners).! !

!HandMorph methodsFor: 'private events' stamp: 'IgorStasenko 1/22/2012 18:30'!
processEvents
	"Process user input events from the local input devices."

	| evt evtBuf type hadAny |
	ActiveEvent ifNotNil: 
			["Meaning that we were invoked from within an event response.
		Make sure z-order is up to date"

			self mouseOverHandler processMouseOver: lastMouseEvent].
	hadAny := false.
	[(evtBuf := Sensor nextEvent) isNil] whileFalse: 
			[evt := nil.	"for unknown event types"
			type := evtBuf first.
			type = EventTypeMouse ifTrue: [recentModifiers := evtBuf sixth. evt := self generateMouseEvent: evtBuf].
			type = EventTypeKeyboard 
				ifTrue: [recentModifiers := evtBuf fifth. evt := self generateKeyboardEvent: evtBuf].
			type = EventTypeDragDropFiles 
				ifTrue: [evt := self generateDropFilesEvent: evtBuf].
			type = EventTypeWindow
				ifTrue:[evt := self generateWindowEvent: evtBuf].				
			"All other events are ignored"
			(type ~= EventTypeDragDropFiles and: [evt isNil]) ifTrue: [^self].
			evt isNil 
				ifFalse: 
					["Finally, handle it"

					self handleEvent: evt.
					hadAny := true.

					"For better user feedback, return immediately after a mouse event has been processed."
					(evt isMouse and: [evt isMouseWheel not]) ifTrue: [^self]]].
	"note: if we come here we didn't have any mouse events"
	mouseClickState notNil 
		ifTrue: 
			["No mouse events during this cycle. Make sure click states time out accordingly"

			mouseClickState handleEvent: lastMouseEvent asMouseMove from: self].
	hadAny 
		ifFalse: 
			["No pending events. Make sure z-order is up to date"

			self mouseOverHandler processMouseOver: lastMouseEvent]! !

!HandMorph methodsFor: 'private events' stamp: 'PavelKrivanek 7/24/2014 11:08'!
generateMouseEvent: evtBuf 
	"Generate the appropriate mouse event for the given raw event buffer"

	| position buttons modifiers type trail stamp oldButtons evtChanged |
	#KMBuffer asClassIfPresent: [ :kmBuffer | kmBuffer uniqueInstance clearBuffer].
	evtBuf first = lastEventBuffer first 
		ifTrue: 
			["Workaround for Mac VM bug, *always* generating 3 events on clicks"

			evtChanged := false.
			3 to: evtBuf size
				do: [:i | (lastEventBuffer at: i) = (evtBuf at: i) ifFalse: [evtChanged := true]].
			evtChanged ifFalse: [^nil]].
	stamp := evtBuf second.
	stamp = 0 ifTrue: [stamp := Time millisecondClockValue].
	position := evtBuf third @ evtBuf fourth.
	buttons := evtBuf fifth.
	modifiers := evtBuf sixth.
	type := buttons = 0 
		ifTrue: 
			[lastEventBuffer fifth = 0 ifTrue: [#mouseMove] ifFalse: [#mouseUp]]
		ifFalse: 
			[lastEventBuffer fifth = 0 
						ifTrue: [#mouseDown]
						ifFalse: [#mouseMove]].
	buttons := buttons bitOr: (modifiers bitShift: 3).
	oldButtons := lastEventBuffer fifth 
				bitOr: (lastEventBuffer sixth bitShift: 3).
	lastEventBuffer := evtBuf.
	type == #mouseMove 
		ifTrue: 
			[trail := self mouseTrailFrom: evtBuf.
			^MouseMoveEvent basicNew 
				setType: type
				startPoint: (self position)
				endPoint: trail last
				trail: trail
				buttons: buttons
				hand: self
				stamp: stamp].
	^MouseButtonEvent basicNew 
		setType: type
		position: position
		which: (oldButtons bitXor: buttons)
		buttons: buttons
		hand: self
		stamp: stamp! !

!HandMorph methodsFor: 'double click support' stamp: 'ar 9/18/2000 17:16'!
resetClickState
	"Reset the double-click detection state to normal (i.e., not waiting for a double-click)."
	mouseClickState := nil.! !

!HandMorph methodsFor: 'private events' stamp: 'ar 10/26/2000 01:43'!
sendListenEvent: anEvent to: listenerGroup
	"Send the event to the given group of listeners"
	listenerGroup ifNil:[^self].
	listenerGroup do:[:listener| 
		listener ifNotNil:[listener handleListenEvent: anEvent copy]].! !

!HandMorph methodsFor: 'listeners' stamp: 'ar 10/26/2000 01:27'!
eventListeners
	^eventListeners! !

!HandMorph methodsFor: 'events-processing' stamp: 'IgorStasenko 1/2/2012 18:58'!
captureEventsUntil: aBlock
"
	Capture all input events, bypassing normal processing flow and redirect all events into block instead.
	Repeat until block will answer true.

	World activeHand captureEventsUntil: [:evt |
		evt isKeyboard and: [ evt keyCharacter = $a ] ]
"

	| release |
	
	release := false.
	
	captureBlock := [:evt | release := aBlock value: evt ].
	
	[
		[ self world doOneCycle. release ] whileFalse.
	] ensure: [
		captureBlock := nil.
	]! !

!HandMorph methodsFor: 'grabbing/dropping' stamp: 'ar 8/13/2003 11:39'!
dropMorph: aMorph event: anEvent
	"Drop the given morph which was carried by the hand"
	| event dropped |
	(anEvent isMouseUp and:[aMorph shouldDropOnMouseUp not]) ifTrue:[^self].

	"Note: For robustness in drag and drop handling we remove the morph BEFORE we drop him, but we keep his owner set to the hand. This prevents system lockups when there is a problem in drop handling (for example if there's an error in #wantsToBeDroppedInto:). THIS TECHNIQUE IS NOT RECOMMENDED FOR CASUAL USE."
	self privateRemove: aMorph.
	aMorph privateOwner: self.

	dropped := aMorph.
	(dropped hasProperty: #addedFlexAtGrab) 
		ifTrue:[dropped := aMorph removeFlexShell].
	event := DropEvent new setPosition: self position contents: dropped hand: self.
	self sendEvent: event focus: nil.
	event wasHandled ifFalse:[aMorph rejectDropMorphEvent: event].
	aMorph owner == self ifTrue:[aMorph delete].
	self mouseOverHandler processMouseOver: anEvent.! !

!HandMorph methodsFor: 'private events' stamp: 'marcus.denker 8/24/2008 21:40'!
moveToEvent: anEvent
	"Issue a mouse move event to make the receiver appear at the given position"
	self handleEvent: (MouseMoveEvent basicNew
		setType: #mouseMove 
		startPoint: self position 
		endPoint: anEvent position 
		trail: (Array with: self position with: anEvent position)
		buttons: anEvent buttons
		hand: self
		stamp: anEvent timeStamp)! !

!HandMorph methodsFor: 'focus handling' stamp: 'ar 10/6/2000 00:10'!
releaseMouseFocus
	"Release the current mouse focus unconditionally."
	self newMouseFocus: nil.! !

!HandMorph methodsFor: 'private events' stamp: 'ar 3/18/2001 01:42'!
sendEvent: anEvent focus: focusHolder clear: aBlock
	"Send the event to the morph currently holding the focus, or if none to the owner of the hand."
	| result |
	focusHolder ifNotNil:[^self sendFocusEvent: anEvent to: focusHolder clear: aBlock].
	ActiveEvent := anEvent.
	result := owner processEvent: anEvent.
	ActiveEvent := nil.
	^result! !

!HandMorph methodsFor: 'geometry' stamp: 'nk 8/20/2003 17:39'!
position: aPoint
	"Overridden to align submorph origins to the grid if gridding is on."
	| adjustedPosition delta box |
	adjustedPosition := aPoint.
	temporaryCursor ifNotNil: [adjustedPosition := adjustedPosition + temporaryCursorOffset].

	"Copied from Morph to avoid owner layoutChanged"
	"Change the position of this morph and and all of its submorphs."
	delta := adjustedPosition - bounds topLeft.
	(delta x = 0 and: [delta y = 0]) ifTrue: [^ self].  "Null change"
	box := self fullBounds.
	(delta dotProduct: delta) > 100 ifTrue:[
		"e.g., more than 10 pixels moved"
		self invalidRect: box.
		self invalidRect: (box translateBy: delta).
	] ifFalse:[
		self invalidRect: (box merge: (box translateBy: delta)).
	].
	self privateFullMoveBy: delta.
! !

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

!HandMorph methodsFor: 'halos and balloon help' stamp: 'ar 10/4/2000 13:40'!
halo
	"Return the halo associated with this hand, if any"
	^self valueOfProperty: #halo! !

!HandMorph methodsFor: 'focus handling' stamp: 'ar 10/6/2000 00:09'!
releaseAllFoci
	mouseFocus := nil.
	keyboardFocus := nil.
! !

!HandMorph methodsFor: 'halo handling' stamp: 'ar 10/24/2000 18:40'!
releaseHalo: aHalo
	"Used for transfering halos between hands"
	self removeProperty: #halo! !

!HandMorph methodsFor: 'meta-actions' stamp: 'adrian_lienhard 3/5/2009 22:44'!
grabMorph: aMorph
	"Grab the given morph (i.e., add it to this hand and remove it from its current owner) without changing its position. This is used to pick up a morph under the hand's current position, versus attachMorph: which is used to pick up a morph that may not be near this hand."
	
	| grabbed |
	aMorph = World ifTrue: [^ self].
	self releaseMouseFocus.
	grabbed := aMorph aboutToBeGrabbedBy: self.
	grabbed ifNil: [^self].
	grabbed := grabbed topRendererOrSelf.
	^self grabMorph: grabbed from: grabbed owner! !

!HandMorph methodsFor: 'focus handling' stamp: 'BenjaminVanRyseghem 7/3/2012 12:25'!
newKeyboardFocus: aMorphOrNil
	"Make the given morph the new keyboard focus, canceling the previous keyboard focus if any. If the argument is nil, the current keyboard focus is cancelled."
	| oldFocus |
	oldFocus := self keyboardFocus.
	
	self keyboardFocus: aMorphOrNil.
	oldFocus ifNotNil: [oldFocus == aMorphOrNil ifFalse: [oldFocus keyboardFocusChange: false]].
	aMorphOrNil ifNotNil: [ aMorphOrNil keyboardFocusChange: true ].
! !

!HandMorph methodsFor: 'listeners' stamp: 'dgd 2/21/2003 22:48'!
removeListener: anObject from: aListenerGroup 
	"Remove anObject from the given listener group. Return the new group."

	| listeners |
	aListenerGroup ifNil: [^nil].
	listeners := aListenerGroup.
	listeners := listeners copyWithout: anObject.
	listeners := listeners copyWithout: nil.	"obsolete entries"
	listeners isEmpty ifTrue: [listeners := nil].
	^listeners! !

!HandMorph methodsFor: 'listeners' stamp: 'ar 10/24/2000 20:43'!
addEventListener: anObject
	"Make anObject a listener for all events. All events will be reported to the object."
	self eventListeners: (self addListener: anObject to: self eventListeners)! !

!HandMorph methodsFor: 'cursor' stamp: 'di 3/6/1999 23:52'!
showTemporaryCursor: cursorOrNil
	"Set the temporary cursor to the given Form. If the argument is nil, revert to the normal cursor."

	self showTemporaryCursor: cursorOrNil hotSpotOffset: 0@0
! !

!HandMorph methodsFor: 'balloon help' stamp: 'sw 10/15/2002 20:01'!
deleteBalloonTarget: aMorph
	"Delete any existing balloon help.  This is now done unconditionally, whether or not the morph supplied is the same as the current balloon target"
	
	self balloonHelp: nil

"	| h |
	h := self balloonHelp ifNil: [^ self].
	h balloonOwner == aMorph ifTrue: [self balloonHelp: nil]"! !

!HandMorph methodsFor: 'listeners' stamp: 'ar 10/26/2000 01:27'!
mouseListeners: anArrayOrNil
	mouseListeners := anArrayOrNil! !

!HandMorph methodsFor: 'focus handling' stamp: 'ar 10/26/2000 01:30'!
keyboardFocus: aMorphOrNil
	keyboardFocus := aMorphOrNil! !

!HandMorph methodsFor: 'private events' stamp: 'AlainRastoul 3/21/2015 10:46'!
generateKeyboardEvent: evtBuf
	"Generate the appropriate mouse event for the given raw event buffer"

	| buttons modifiers type pressType stamp charCode keyValue keyEvent |
	stamp := evtBuf second.
	stamp = 0 ifTrue: [stamp := Time millisecondClockValue].
	pressType := evtBuf fourth.
	pressType = EventKeyDown
		ifTrue: [
			type := #keyDown.
			lastKeyScanCode := evtBuf third].
	pressType = EventKeyUp ifTrue: [type := #keyUp].
	pressType = EventKeyChar ifTrue: [
		type := #keystroke].
	modifiers := evtBuf fifth.
	buttons := modifiers bitShift: 3.
	keyValue := evtBuf third. 
	charCode := evtBuf sixth.

	type = #keystroke
		ifTrue: [combinedChar
			ifNil: [
				| peekedEvent |
				peekedEvent := Sensor peekEvent.
				(peekedEvent notNil
					and: [peekedEvent fourth = EventKeyDown])
					ifTrue: [
						(CombinedChar isCompositionCharacter: charCode)
							ifTrue: [
								combinedChar := CombinedChar new.
								combinedChar simpleAdd: charCode asCharacter.
								(combinedChar combinesWith: peekedEvent third asCharacter)
									ifTrue: [^nil].
								]]]
			ifNotNil: [
				(combinedChar simpleAdd: charCode asCharacter)
					ifTrue: [charCode := combinedChar combined charCode].
				combinedChar := nil]].

	self flag: #fixme.
	"This piece of code handles the creation of scrolling events. When a scroll is done by the user, the VM forwards a keystroke event with the up/down key. So we reconvert it to a MouseWheelEvent in that case."
	(type = #keystroke 
	 and: [(buttons anyMask: 16) 
	  and: [{Character arrowUp. Character arrowDown} includes: (charCode asCharacter)]])
		ifTrue: [^ MouseWheelEvent
					fromCharacter: charCode asCharacter
					position: lastMouseEvent cursorPoint
					buttons: buttons
					hand: self
					stamp: stamp].

	keyEvent := KeyboardEvent new
		setType: type
		buttons: buttons
		position: self position
		keyValue: keyValue
		charCode: charCode
		hand: self
		stamp: stamp.
	keyEvent scanCode: lastKeyScanCode.
	^keyEvent
! !

!HandMorph methodsFor: 'listeners' stamp: 'ar 10/24/2000 20:40'!
addListener: anObject to: aListenerGroup
	"Add anObject to the given listener group. Return the new group."
	| listeners |
	listeners := aListenerGroup.
	(listeners notNil and:[listeners includes: anObject]) ifFalse:[
		listeners
			ifNil:[listeners := WeakArray with: anObject]
			ifNotNil:[listeners := listeners copyWith: anObject]].
	listeners := listeners copyWithout: nil. "obsolete entries"
	^listeners! !

!HandMorph methodsFor: 'halo handling' stamp: 'dgd 4/4/2006 16:14'!
removeHalo
	"remove the receiver's halo (if any)"
	| halo |
	halo := self halo.
	halo
		ifNil: [^ self].
	halo delete.
	self removeProperty: #halo! !

!HandMorph methodsFor: 'accessing' stamp: 'sw 2/11/98 18:00'!
colorForInsets
	"Morphs being dragged by the hand use the world's color"
	^ owner colorForInsets! !

!HandMorph methodsFor: 'drawing' stamp: 'JW 7/12/2005 20:13'!
shadowForm
	"Return a 1-bit shadow of my submorphs.  Assumes submorphs is not empty"
	| bnds canvas |
	bnds := Rectangle merging: (submorphs collect: [:m | m fullBounds]).
	canvas := (Display defaultCanvasClass extent: bnds extent depth: 1) 
		asShadowDrawingCanvas: Color black.
	canvas translateBy: bnds topLeft negated
		during:[:tempCanvas| self drawSubmorphsOn: tempCanvas].
	^ canvas form offset: bnds topLeft! !

!HandMorph methodsFor: 'geometry' stamp: 'ar 3/20/2001 20:34'!
position

	^temporaryCursor
		ifNil: [bounds topLeft]
		ifNotNil: [bounds topLeft - temporaryCursorOffset]! !

!HandMorph methodsFor: 'recategorized' stamp: 'gvc 2/24/2009 10:36'!
fullDrawOn: aCanvas 
	"A HandMorph has unusual drawing requirements:
		1. the hand itself (i.e., the cursor) appears in front of its submorphs
		2. morphs being held by the hand cast a shadow on the world/morphs below
	The illusion is that the hand plucks up morphs and carries them above the world."

	"Note: This version caches an image of the morphs being held by the hand for
	 better performance. This cache is invalidated if one of those morphs changes."

	| disableCaching subBnds roundCorners rounded |
	self visible ifFalse: [^self].
	(aCanvas isVisible: self fullBounds) ifFalse: [^self].
	disableCaching := false.
	disableCaching 
		ifTrue: 
			[self nonCachingFullDrawOn: aCanvas.
			^self].
	submorphs isEmpty 
		ifTrue: 
			[cacheCanvas := nil.
			^self drawOn: aCanvas].	"just draw the hand itself"
	subBnds := Rectangle merging: (submorphs collect: [:m | m fullBounds]).
	self updateCacheCanvas: aCanvas.
	(cacheCanvas isNil 
		or: [cachedCanvasHasHoles and: [cacheCanvas depth = 1]]) 
			ifTrue: 
				["could not use caching due to translucency; do full draw"

				self nonCachingFullDrawOn: aCanvas.
				^self].

	"--> begin rounded corners hack <---"
	roundCorners := cachedCanvasHasHoles == false 
				and: [submorphs size = 1 and: [submorphs first wantsRoundedCorners]].
	roundCorners 
		ifTrue: 
			[rounded := submorphs first.
			aCanvas asShadowDrawingCanvas translateBy: self shadowOffset
				during: 
					[:shadowCanvas | 
					shadowCanvas roundCornersOf: rounded
						during: 
							[(subBnds areasOutside: (rounded boundsWithinCorners 
										translateBy: self shadowOffset negated)) 
								do: [:r | shadowCanvas fillRectangle: r color: Color black]]].
			aCanvas roundCornersOf: rounded
				during: 
					[aCanvas 
						drawImage: cacheCanvas form
						at: subBnds origin
						sourceRect: cacheCanvas form boundingBox].
			^self drawOn: aCanvas	"draw the hand itself in front of morphs"].
	"--> end rounded corners hack <---"

	"draw the shadow"
	(submorphs anySatisfy: [:m | m handlesDropShadowInHand not]) ifTrue: [
		aCanvas asShadowDrawingCanvas translateBy: self shadowOffset
		during: 
			[:shadowCanvas | 
			cachedCanvasHasHoles 
				ifTrue: 
					["Have to draw the real shadow of the form"

					shadowCanvas paintImage: cacheCanvas form at: subBnds origin]
				ifFalse: 
					["Much faster if only have to shade the edge of a solid rectangle"

					(subBnds areasOutside: (subBnds translateBy: self shadowOffset negated)) 
						do: [:r | shadowCanvas fillRectangle: r color: Color black]]]].

	"draw morphs in front of the shadow using the cached Form"
	aCanvas translucentImage: cacheCanvas form at: subBnds origin.
	self drawOn: aCanvas	"draw the hand itself in front of morphs"! !

!HandMorph methodsFor: 'layout' stamp: 'jm 2/20/98 18:55'!
fullBounds
	"Extend my bounds by the shadow offset when carrying morphs."

	| bnds |
	bnds := super fullBounds.
	submorphs isEmpty
		ifTrue: [^ bnds ]
		ifFalse: [^ bnds topLeft corner: bnds bottomRight + self shadowOffset].
! !

!HandMorph methodsFor: 'private events' stamp: 'ar 3/18/2001 01:43'!
sendEvent: anEvent focus: focusHolder
	"Send the event to the morph currently holding the focus, or if none to the owner of the hand."
	^self sendEvent: anEvent focus: focusHolder clear:[nil]! !

!HandMorph methodsFor: 'accessing' stamp: 'ar 12/22/2008 12:04'!
shiftPressed
	^lastMouseEvent shiftPressed! !

!HandMorph methodsFor: 'focus handling' stamp: 'ar 10/6/2000 00:10'!
releaseMouseFocus: aMorph
	"If the given morph had the mouse focus before, release it"
	self mouseFocus == aMorph ifTrue:[self releaseMouseFocus].! !

!HandMorph methodsFor: 'private events' stamp: 'tbn 3/12/2010 01:38'!
generateWindowEvent: evtBuf 
	"Generate the appropriate window event for the given raw event buffer"

	| evt |
	evt := WindowEvent new.
	evt setTimeStamp: evtBuf second.
	evt timeStamp = 0 ifTrue: [evt setTimeStamp: Time millisecondClockValue].
	evt action: evtBuf third.
	evt rectangle: (Rectangle origin: evtBuf fourth @ evtBuf fifth corner: evtBuf sixth @ evtBuf seventh ).
	
	^evt
! !

!HandMorph methodsFor: 'listeners' stamp: 'ar 10/24/2000 20:42'!
addMouseListener: anObject
	"Make anObject a listener for mouse events. All mouse events will be reported to the object."
	self mouseListeners: (self addListener: anObject to: self mouseListeners)! !

!HandMorph methodsFor: 'balloon help' stamp: 'MarcusDenker 10/10/2013 23:45'!
balloonHelp: aBalloonMorph
	"Return the balloon morph associated with this hand"
	self balloonHelp ifNotNil:[:oldHelp |oldHelp delete].
	aBalloonMorph
		ifNil:[self removeProperty: #balloonHelpMorph]
		ifNotNil:[self setProperty: #balloonHelpMorph toValue: aBalloonMorph]! !

!HandMorph methodsFor: 'caching' stamp: 'StephaneDucasse 12/26/2011 10:39'!
releaseCachedState
	| oo |
	super releaseCachedState.
	cacheCanvas := nil.
	oo := owner.
	self removeAllMorphs.
	self initialize.	"nuke everything"
	self privateOwner: oo.
	self releaseAllFoci.! !

!HandMorph methodsFor: 'focus handling' stamp: 'ar 10/6/2000 00:09'!
keyboardFocus 
	^ keyboardFocus! !

!HandMorph methodsFor: 'cursor' stamp: 'NS 2/17/2001 11:01'!
temporaryCursor
	^ temporaryCursor! !

!HandMorph methodsFor: 'initialization' stamp: 'nk 2/14/2004 18:28'!
interrupted
	"Something went wrong - we're about to bring up a debugger. 
	Release some stuff that could be problematic."
	self releaseAllFoci. "or else debugger might not handle clicks"
! !

!HandMorph methodsFor: 'drawing' stamp: 'nice 1/5/2010 15:59'!
nonCachingFullDrawOn: aCanvas
	
	"A HandMorph has unusual drawing requirements:
		1. the hand itself (i.e., the cursor) appears in front of its submorphs
		2. morphs being held by the hand cast a shadow on the world/morphs below
	The illusion is that the hand plucks up morphs and carries them above the world."
	"Note: This version does not cache an image of the morphs being held by the hand.
	 Thus, it is slower for complex morphs, but consumes less space."

	submorphs isEmpty ifTrue: [^ self drawOn: aCanvas].  "just draw the hand itself"
	aCanvas asShadowDrawingCanvas
		translateBy: self shadowOffset during:[:shadowCanvas| | shadowForm |
		"Note: We use a shadow form here to prevent drawing
		overlapping morphs multiple times using the transparent
		shadow color."
		shadowForm := self shadowForm.
"
shadowForm displayAt: shadowForm offset negated. Display forceToScreen: (0@0 extent: shadowForm extent).
"
		shadowCanvas paintImage: shadowForm at: shadowForm offset.  "draw shadows"
	].
	"draw morphs in front of shadows"
	self drawSubmorphsOn: aCanvas.
	self drawOn: aCanvas.  "draw the hand itself in front of morphs"
! !

!HandMorph methodsFor: 'halo handling' stamp: 'dgd 9/9/2004 22:44'!
removeHaloFromClick: anEvent on: aMorph 
	| halo |
	halo := self halo
				ifNil: [^ self].
	(halo target hasOwner: self)
		ifTrue: [^ self].
	(halo staysUpWhenMouseIsDownIn: aMorph)
		ifFalse: [self removeHalo]! !

!HandMorph methodsFor: 'grabbing/dropping' stamp: 'ar 10/5/2000 16:23'!
dropMorphs
	"Drop the morphs at the hands position"
	self dropMorphs: lastMouseEvent.! !

!HandMorph methodsFor: '*Morphic-Base' stamp: 'nk 7/26/2004 10:32'!
waitForClicksOrDrag: aMorph event: evt selectors: clickAndDragSelectors threshold: threshold

	"Wait for mouse button and movement events, informing aMorph about events interesting to it via callbacks.
	This message is typically sent to the Hand by aMorph when it first receives a mouse-down event.
	The callback methods, named in clickAndDragSelectors and passed a copy of evt, are:
		1 	(click) sent when the mouse button goes up within doubleClickTime.
		2	(doubleClick) sent when the mouse goes up, down, and up again all within DoubleClickTime.
		3	(doubleClickTimeout) sent when the mouse does not have a doubleClick within DoubleClickTime.
		4	(startDrag) sent when the mouse moves more than threshold pixels from evt's position within DoubleClickTime.
	Note that mouseMove: and mouseUp: events are not sent to aMorph until it becomes the mouse focus,
	which is typically done by aMorph in its click:, doubleClick:, or drag: methods."
	
	mouseClickState := 
		MouseClickState new
			client: aMorph 
			click: clickAndDragSelectors first 
			dblClick: clickAndDragSelectors second 
			dblClickTime: DoubleClickTime 
			dblClickTimeout: clickAndDragSelectors third
			drag: clickAndDragSelectors fourth 
			threshold: threshold 
			event: evt.
! !

!HandMorph methodsFor: 'copying' stamp: 'ar 10/6/2000 00:11'!
veryDeepCopyWith: deepCopier
	"Return self.  Do not copy hands this way."
	^ self! !

!HandMorph methodsFor: 'focus handling' stamp: 'ar 10/26/2000 01:31'!
releaseKeyboardFocus: aMorph
	"If the given morph had the keyboard focus before, release it"
	self keyboardFocus == aMorph ifTrue:[self releaseKeyboardFocus].! !

!HandMorph methodsFor: 'grabbing/dropping' stamp: 'AlainPlantec 5/7/2010 22:28'!
grabMorph: aMorph from: formerOwner 
	"Grab the given morph (i.e., add it to this hand and remove it from its
	current owner) without changing its position. This is used to pick up a
	morph under the hand's current position, versus attachMorph: which
	is used to pick up a morph that may not be near this hand."
	| grabbed offset targetPoint grabTransform fullTransform |
	self releaseMouseFocus.
	"Break focus"
	grabbed := aMorph.
	aMorph keepsTransform
		ifTrue: [grabTransform := fullTransform := IdentityTransform new]
		ifFalse: ["Compute the transform to apply to the grabbed morph"
			grabTransform := formerOwner
						ifNil: [IdentityTransform new]
						ifNotNil: [formerOwner grabTransform].
			fullTransform := formerOwner
						ifNil: [IdentityTransform new]
						ifNotNil: [formerOwner transformFrom: owner]].
	"targetPoint is point in aMorphs reference frame"
	targetPoint := fullTransform globalPointToLocal: self position.
	"but current position will be determined by grabTransform, so
	compute offset"
	offset := targetPoint
				- (grabTransform globalPointToLocal: self position).
	"apply the transform that should be used after grabbing"
	grabbed := grabbed transformedBy: grabTransform.
	grabbed == aMorph
		ifFalse: [grabbed setProperty: #addedFlexAtGrab toValue: true].
	"offset target to compensate for differences in transforms"
	grabbed position: grabbed position - offset asIntegerPoint.
	"And compute distance from hand's position" 
	targetOffset := grabbed position - self position.
	self addMorphBack: grabbed.
	grabbed justGrabbedFrom: formerOwner! !

!HandMorph methodsFor: 'classification' stamp: ''!
isHandMorph

	^ true! !

!HandMorph methodsFor: 'events-processing' stamp: 'IgorStasenko 1/2/2012 18:40'!
captureEventsWhile: aBlock
"
	Capture all input events, bypassing normal processing flow and redirect all events into block instead.
	Repeat until block will answer false.

"

	^ self captureEventsUntil: [:evt | (aBlock value: evt) not ]! !

!HandMorph methodsFor: 'halo handling' stamp: 'ar 10/4/2000 13:40'!
halo: newHalo
	"Set halo associated with this hand"
	| oldHalo |
	oldHalo := self halo.
	(oldHalo isNil or:[oldHalo == newHalo]) ifFalse:[oldHalo delete].
	newHalo
		ifNil:[self removeProperty: #halo]
		ifNotNil:[self setProperty: #halo toValue: newHalo]! !

!HandMorph methodsFor: 'private events' stamp: 'PavelKrivanek 6/21/2011 13:05'!
mouseTrailFrom: currentBuf 
  "Current event, a mouse event buffer, is about to be processed.  If there are other similar mouse events queued up, then drop them from the queue, and report the positions inbetween."

  | nextEvent trail |
  trail := (Array new: 1) writeStream.
  trail nextPut: currentBuf third @ currentBuf fourth.
  [(nextEvent := Sensor peekEvent) isNil] whileFalse: 
      [nextEvent first = currentBuf first 
        ifFalse: [^trail contents "different event type"].
      nextEvent fifth = currentBuf fifth 
        ifFalse: [^trail contents "buttons changed"].
      nextEvent sixth = currentBuf sixth 
        ifFalse: [^trail contents "modifiers changed"].
      "nextEvent is similar.  Remove it from the queue, and check the next."
      nextEvent := Sensor nextEvent.
      nextEvent 
        ifNotNil: [ trail nextPut: nextEvent third @ nextEvent fourth ]].
  ^trail contents! !

!HandMorph methodsFor: 'balloon help' stamp: 'ar 10/6/2000 00:14'!
removePendingBalloonFor: aMorph
	"Get rid of pending balloon help."
	self removeAlarm: #spawnBalloonFor:.
	self deleteBalloonTarget: aMorph.! !

!HandMorph methodsFor: 'listeners' stamp: 'ar 10/24/2000 20:41'!
removeMouseListener: anObject
	"Remove anObject from the current mouse listeners."
	self mouseListeners: (self removeListener: anObject from: self mouseListeners).! !

!HandMorph methodsFor: 'accessing' stamp: 'IgorStasenko 1/22/2012 18:24'!
anyModifierKeyPressed
	^recentModifiers anyMask: 16r0E	"cmd | opt | ctrl"! !

!HandMorph methodsFor: 'initialization' stamp: 'IgorStasenko 1/22/2012 18:19'!
initForEvents
	mouseOverHandler := nil.
	lastMouseEvent := MouseEvent basicNew setType: #mouseMove position: 0@0 buttons: 0 hand: self.
	lastEventBuffer := {1. 0. 0. 0. 0. 0. nil. nil}.
	recentModifiers := 0.
	self resetClickState.! !

!HandMorph methodsFor: 'balloon help' stamp: 'ar 10/3/2000 16:49'!
balloonHelp
	"Return the balloon morph associated with this hand"
	^self valueOfProperty: #balloonHelpMorph! !

!HandMorph methodsFor: 'listeners' stamp: 'MarcusDenker 9/13/2013 15:53'!
keyboardListeners
	^nil! !

!HandMorph methodsFor: 'balloon help' stamp: 'ar 10/3/2000 17:14'!
triggerBalloonFor: aMorph after: timeOut
	"Trigger balloon help after the given time out for some morph"
	self addAlarm: #spawnBalloonFor: with: aMorph after: timeOut.! !

!HandMorph methodsFor: 'paste buffer' stamp: 'ar 10/5/2000 19:10'!
objectToPaste
	"It may need to be sent #startRunning by the client"
	^ Cursor wait showWhile: [PasteBuffer veryDeepCopy]

	"PasteBuffer usableDuplicateIn: self world"
! !

!HandMorph class methodsFor: 'settings' stamp: 'BenComan 1/3/2015 12:13'!
logEventStatsEnabled: aBoolean
	aBoolean
		ifTrue: [ self logEventStatsStart ]
		ifFalse: [ self logEventStatsStop ].! !

!HandMorph class methodsFor: 'utilities' stamp: 'MarcusDenker 7/28/2013 13:03'!
showEvents: aBool
	"HandMorph showEvents: true"
	"HandMorph showEvents: false"
	ShowEvents := aBool.
	aBool ifFalse: [ World invalidRect: (0@0 extent: 500@120) ].! !

!HandMorph class methodsFor: 'accessing' stamp: ''!
doubleClickTime

	^ DoubleClickTime
! !

!HandMorph class methodsFor: 'events-processing' stamp: 'BenComan 1/3/2015 12:38'!
cleanUp
	"Called from ImageCleaner>>cleanUpForRelease --> SmalltalkImage>>cleanUp:except:confirming:"
	self logEventStatsStop
! !

!HandMorph class methodsFor: 'accessing' stamp: ''!
doubleClickTime: milliseconds

	DoubleClickTime := milliseconds.
! !

!HandMorph class methodsFor: 'class initialization' stamp: 'kfr 7/13/2003 14:15'!
initialize
	"HandMorph initialize"

	PasteBuffer := nil.
	DoubleClickTime := 350.
	NormalCursor := CursorWithMask normal asCursorForm.
! !

!HandMorph class methodsFor: 'settings' stamp: 'BenComan 1/3/2015 12:08'!
logEventStatsEnabled
	"self logEventStatsEnabled"
	^ EventStats isNotNil ! !

!HandMorph class methodsFor: 'events-processing' stamp: 'BenComan 1/3/2015 12:00'!
logEventStatsStart
	EventStats ifNil:[EventStats := IdentityDictionary new].! !

!HandMorph class methodsFor: 'events-processing' stamp: 'BenComan 1/3/2015 12:40'!
logEventStats: evt
	EventStats ifNotNil: [
		EventStats at: #count put: (EventStats at: #count ifAbsent:[0]) + 1.
		EventStats at: evt type put: (EventStats at: evt type ifAbsent:[0]) + 1.
		].! !

!HandMorph class methodsFor: 'settings' stamp: 'BenComan 1/4/2015 00:11'!
settingsOn: aBuilder
	<systemsettings>
	(aBuilder setting: #handMorphsLogEventStats)
		parent: #pharoSystem;
		label: 'HandMorph event statistics';
		target: self;
		selector: #logEventStatsEnabled;
		description: 'Enable/disable gathering global statistics of events handled by HandMorphs.
"HandMorph eventStats inspect"'
! !

!HandMorph class methodsFor: 'events-processing' stamp: 'BenComan 1/3/2015 12:15'!
eventStats
	^ EventStats ifNil: [ 'EventStats are disabled' ].! !

!HandMorph class methodsFor: 'utilities' stamp: 'sma 4/30/2000 10:34'!
attach: aMorph
	"Attach aMorph the current world's primary hand."

	self currentWorld primaryHand attachMorph: aMorph! !

!HandMorph class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/25/2013 17:43'!
upperHandLimit

	^ UpperHandLimit ifNil: [ UpperHandLimit := 0 ]! !

!HandMorph class methodsFor: 'events-processing' stamp: 'BenComan 1/3/2015 12:00'!
logEventStatsStop
	EventStats := nil.! !

!HandMorph class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/25/2013 17:45'!
upperHandLimit: anInteger

	UpperHandLimit := anInteger! !

!HandleMorph commentStamp: '<historical>'!
A HandleMorph provides mouse-up control behavior.!
!HandleMorph methodsFor: 'stepping and presenter' stamp: 'di 11/3/97 16:34'!
step
	pointBlock value: self center! !

!HandleMorph methodsFor: 'initialization' stamp: 'dgd 3/7/2003 14:30'!
initialize
	"initialize the state of the receiver"
	super initialize.
	""
	self extent: 8 @ 8.
	! !

!HandleMorph methodsFor: 'initialize' stamp: 'di 8/30/2000 21:48'!
forEachPointDo: aBlock lastPointDo: otherBlock
	pointBlock := aBlock.
	lastPointBlock := otherBlock! !

!HandleMorph methodsFor: 'initialize' stamp: 'di 11/3/97 16:34'!
forEachPointDo: aBlock
	pointBlock := aBlock! !

!HandleMorph methodsFor: 'event handling' stamp: 'ar 9/15/2000 23:30'!
keyStroke: evt
	"Check for cursor keys"
	| keyValue |
	owner isHandMorph ifFalse:[^self].
	keyValue := evt keyValue.
	keyValue = 28 ifTrue:[^self position: self position - (1@0)].
	keyValue = 29 ifTrue:[^self position: self position + (1@0)].
	keyValue = 30 ifTrue:[^self position: self position - (0@1)].
	keyValue = 31 ifTrue:[^self position: self position + (0@1)].
	"Special case for return"
	keyValue = 13 ifTrue:[
		"Drop the receiver and be done"
	self flag: #arNote. "Probably unnecessary"
		owner releaseKeyboardFocus: self.
		self delete].
! !

!HandleMorph methodsFor: 'testing' stamp: 'JMM 10/21/2003 18:15'!
stepTime
	"Update every hundredth of a second."
	^ 10
! !

!HandleMorph methodsFor: 'dropping/grabbing' stamp: 'dgd 9/10/2004 13:40'!
justDroppedInto: aMorph event: anEvent
	"So that when the hand drops me (into the world) I go away"
	self removeHalo.
	lastPointBlock ifNotNil: [lastPointBlock value: self center].
	self flag: #arNote. "Probably unnecessary"
	anEvent hand releaseKeyboardFocus: self.
	self changed.
	self delete.
! !

!HandleMorph methodsFor: 'stepping and presenter' stamp: 'ar 9/15/2000 23:24'!
startStepping
	"Make the receiver the keyboard focus for editing"
	super startStepping.
	"owner isHandMorph ifTrue:[owner newKeyboardFocus: self]."
self flag: #arNote. "make me #handleKeyboard:"! !

!HashAndEqualsTestCase commentStamp: 'mjr 8/20/2003 17:37'!
I am a simple TestCase that tests for correct operation of #hash and #=.

Subclasses of me need to fill my prototypes with suitable objects to be tested.!
!HashAndEqualsTestCase methodsFor: 'testing' stamp: 'mjr 8/20/2003 18:56'!
testEquality
	"Check that TextFontChanges report equality correctly"
	prototypes
		do: [:p | self
				should: [(EqualityTester with: p) result]] ! !

!HashAndEqualsTestCase methodsFor: 'testing' stamp: 'al 6/12/2008 21:58'!
testHash
	"test that TextFontChanges hash correctly"
	prototypes do: [:p |
		self should: [(HashTester with: p) result]] ! !

!HashAndEqualsTestCase methodsFor: 'running' stamp: 'stephaneducasse 2/3/2006 22:39'!
setUp
	"subclasses will add their prototypes into this collection"
	prototypes := OrderedCollection new ! !

!HashFunction commentStamp: 'TorstenBergmann 1/31/2014 10:15'!
Common superclass for hash functions!
!HashFunction methodsFor: 'accessing' stamp: 'cmm 2/20/2006 23:22'!
doubleHashMessage: aStringOrByteArray
	"SHA1 new doubleHashMessage: 'foo'"
	^ self doubleHashStream: aStringOrByteArray asByteArray readStream! !

!HashFunction methodsFor: 'accessing' stamp: 'cmm 2/20/2006 23:21'!
doubleHashStream: aStream
	^ self hashStream: ((self hashStream: aStream) asByteArray readStream)! !

!HashFunction methodsFor: 'converting' stamp: 'len 8/3/2002 02:42'!
hmac
	^ HMAC on: self! !

!HashFunction methodsFor: 'accessing' stamp: 'len 8/7/2002 16:30'!
hashMessage: aStringOrByteArray
	"MD5 new hashMessage: 'foo'"
	^ self hashStream: aStringOrByteArray asByteArray readStream! !

!HashFunction methodsFor: 'accessing' stamp: 'len 8/2/2002 02:21'!
hashStream: aStream
	^ self subclassResponsibility! !

!HashFunction methodsFor: 'accessing' stamp: 'len 8/15/2002 01:43'!
blockSize
	^ self class blockSize! !

!HashFunction methodsFor: 'accessing' stamp: 'len 8/9/2002 13:17'!
hashSize
	^ self class hashSize! !

!HashFunction class methodsFor: 'hashing' stamp: 'len 8/2/2002 02:20'!
hashMessage: aStringOrByteArray
	^ self new hashMessage: aStringOrByteArray! !

!HashFunction class methodsFor: 'hashing' stamp: 'len 8/2/2002 02:20'!
hashStream: aPositionableStream
	^ self new hashStream: aPositionableStream! !

!HashFunction class methodsFor: 'accessing' stamp: 'len 8/15/2002 01:43'!
blockSize
	^ self subclassResponsibility! !

!HashFunction class methodsFor: 'accessing' stamp: 'len 8/9/2002 13:17'!
hashSize
	^ self subclassResponsibility! !

!HashTableSizes commentStamp: 'MartinMcClure 3/18/2010 21:44'!
HashTableSizes is a helper class, used by hashedCollections to determine sizes for hash tables.

Public protocol is all class-side:

#goodSizeAtLeast: anInteger 
  answers a "good" integer greater than or equal to the given integer.

An integer is not "good" as a hash table size if it is any of:
* Not prime
* Divides 256**k +- a, for small k and a
* Close to a power of two
* Close to dividing the hashMultiply constant

See Andres Valloud's hashing book, and Knuth TAOCP vol. 3.

This class caches a table of selected good primes within the positive SmallInteger range. When this table must be rebuilt, it uses an instance to compute the table. Primes are selected to keep the table fairly small, with approximately five entries per power of two.

The cached table is ordered, and is searched with a binary search to find the closest good size >= the requested size.!
!HashTableSizes methodsFor: 'private' stamp: 'MarcusDenker 11/1/2014 16:51'!
goodPrimeForExp: exp
	"Answer the next prime integer >= 2**exp that will make a good hash table size,
	Some primes are rejected:
	* Primes close to a power of two.
	* Primes which divide 256**k +- a, for small k and a
	* Primes which are close to dividing 1664525, the hashMultiply constant
	See Andres Valloud's hashing book, and Knuth TAOCP volume 3."

	| limit |

	candidate := self firstCandidateForExp: exp.
	limit := self limitForExp: exp.
	[ self candidateIsGoodPrime ]
		whileFalse:
			[ candidate := candidate + 2.
			candidate > limit
				ifTrue: [ ^ nil ] ].
	^ candidate! !

!HashTableSizes methodsFor: 'private' stamp: 'MartinMcClure 12/27/2009 21:03'!
firstCandidateForExp: exp
	"Answer the smallest odd integer greater 2**exp."
	
	| n |
	n := (2 raisedTo: exp) rounded.
	^n odd 
		ifTrue: [n]
		ifFalse: [n + 1]! !

!HashTableSizes methodsFor: 'private' stamp: 'MartinMcClure 1/17/2010 09:43'!
candidateIsGoodPrime
	"Answer true if candidate will make a good hash table size.
	Some integers are rejected:
	* Non-primes
	* Primes which are close to dividing 1664525, the hashMultiply constant
	* Primes which divide 256**k +- a, for small k and a
	See Andres Valloud's hashing book, and Knuth TAOCP volume 3."

	candidate isPrime
		ifFalse: [ ^ false ].
	(primesToAvoid includes: candidate)
		ifTrue: [ ^ false ].
	candidate < 256
		ifTrue: [ ^ true ].	"Small primes cannot satisify divisibility constraints"
	^ valuesNotToDivide allSatisfy: [ :dividend | dividend \\ candidate ~~ 0 ]! !

!HashTableSizes methodsFor: 'initialization' stamp: 'MartinMcClure 1/17/2010 09:44'!
initialize
	"Can't use any hashed collections, if sizes is being initialized might get infinite recursion"

	goodPrimes := OrderedCollection new.	
	"Must contain a value less than any prime to avoid extra work in binary search"
	goodPrimes add: 0.
	valuesNotToDivide := OrderedCollection new.
	1 to: 8 do:
			[ :k | 
			| n |
			n := 256 raisedToInteger: k.
			-32 to: 32 do: [ :a | valuesNotToDivide add: n + a ] ].
	primesToAvoid := self primeAlmostFactorsOf: 1 hashMultiply! !

!HashTableSizes methodsFor: 'private' stamp: 'MarcusDenker 11/1/2014 16:48'!
primeAlmostFactorsOf: anInteger
	"Answer primes less than anInteger whose remainder when dividing anInteger is small"

	| factors |
	factors := OrderedCollection new.
	anInteger even ifTrue: [factors add: 2].
	3 to: anInteger // 2 + 2 by: 2 do: [:i | 
		(i isPrime and: [| remainder | 
						remainder := anInteger \\ i.
						remainder <= 1 or: [remainder = (i - 1)]])
			ifTrue: [factors add: i]].
	^factors asArray	
! !

!HashTableSizes methodsFor: 'private' stamp: 'MartinMcClure 12/27/2009 21:13'!
limitForExp: exp
	"Answer the largest integer that isn't too close to the next higher power of 2 than exp."
	
	| expLimit |
	expLimit := exp ceiling - (0.5 / self numValuesPerPower).
	^(2 raisedTo: expLimit) rounded.
	! !

!HashTableSizes methodsFor: 'private' stamp: 'MartinMcClure 1/17/2010 09:49'!
computeSizes
	"Answer an array of integers that make good hash table sizes.
	In each power of two, there are about five primes to choose from.
	Some primes are rejected:
	* Primes close to a power of two.
	* Primes which divide 256**k +- a, for small k and a
	* Primes which are close to dividing 1664525, the hashMultiply constant
	See Andres Valloud's hashing book, and Knuth TAOCP volume 3."

	| logInterval |
	logInterval := 0.5 / self numValuesPerPower.
	2 + logInterval to: 30 by: 2 * logInterval do:
			[ :exp | 
			(self goodPrimeForExp: exp)
				ifNotNil:
					[ :prime | 
					goodPrimes last ~~ prime
						ifTrue: [ goodPrimes add: prime ] ] ].
	^ goodPrimes asArray! !

!HashTableSizes methodsFor: 'private' stamp: 'MartinMcClure 12/25/2009 16:59'!
numValuesPerPower
	"Answer the number of values that should be available in the cached table of primes
	for each power-of-two range."
	
	^self class numValuesPerPower
! !

!HashTableSizes class methodsFor: 'initialize-release' stamp: 'MartinMcClure 1/17/2010 09:51'!
initialize
	"Throw away any previously-cached sizes, then compute and cache the sizes."
	"HashTableSizes initialize"
	
	sizes := nil.
	self sizes! !

!HashTableSizes class methodsFor: 'private' stamp: 'MartinMcClure 1/17/2010 09:35'!
sizes
	sizes ~~ nil
		ifFalse: [ sizes := self new computeSizes ].
	^ sizes! !

!HashTableSizes class methodsFor: 'private' stamp: 'MartinMcClure 1/17/2010 09:45'!
numValuesPerPower
	"Answer the number of values that should be available in the cached table of primes
	for each power-of-two range. A larger number allows closer sizing for pre-sized collections,
	but results in a larger table that takes longer to search."
	
	^5 "Chosen so there will be fewer than 128 primes in the sizes table"! !

!HashTableSizes class methodsFor: 'public' stamp: 'MartinMcClure 1/11/2010 22:29'!
atLeast: lowerLimit
	"Answer the next good size >= lowerlimit.
	If lowerLimit is larger than the largest known good prime,
	just make it odd."

	| primes low mid high prime |
	primes := self sizes.
	low := 1.
	high := primes size.
	lowerLimit > (primes at: high)
		ifTrue:
			[ ^ lowerLimit even
				ifTrue: [ lowerLimit + 1 ]
				ifFalse: [ lowerLimit ] ].
	[ mid := (high - low) // 2 + low.
	prime := primes at: mid.
	prime < lowerLimit
		ifTrue: [ low := mid ]
		ifFalse: [ high := mid ].
	high - low <= 1
		ifTrue: [ ^ primes at: high ] ] repeat! !

!HashTester commentStamp: 'mjr 8/20/2003 12:48'!
I provide a simple way to test the hash properties of any object.  

I am given an object that should be tested and I treat it like a prototype.  I take a copy of it when I am given it so that it can't change whilst I am holding on to it.  I can then test that multiple copies of this object all hash to the same value.!
!HashTester methodsFor: 'operation' stamp: 'stephaneducasse 2/3/2006 22:39'!
resultFor: runs 
	"Test that the hash is the same over runs and answer the result"
	| hash |
	hash := self prototype hash.
	1
		to: runs
		do: [:i | hash = self prototype hash
				ifFalse: [^ false]].
	^ true ! !

!HashTesterTest commentStamp: 'mjr 8/20/2003 12:48'!
I am a simple test case to check that HashTester works correctly!
!HashTesterTest methodsFor: 'as yet unclassified' stamp: 'mjr 8/20/2003 18:56'!
testBasicBehaviour
	self
		should: [(HashTester with: 1)
				resultFor: 100].
	self
		should: [(HashTester with: 'fred')
				resultFor: 100].
	self
		shouldnt: [(HashTester with: BadHasher new)
				resultFor: 100] ! !

!HashedCollection commentStamp: 'StephaneDucasse 11/29/2011 22:22'!
I am an abstract collection of objects that implement hash and equality in a consitent way. This means that whenever two objects are equal, their hashes have to be equal too. If two objects are equal then I can only store one of them. Hashes are expected to be integers (preferably SmallIntegers). I also expect that the objects contained by me do not change their hashes. If that happens, hash invariants have to be re-established, which can be done by #rehash.

Since I'm abstract, no instances of me should exist. My subclasses should implement #scanFor:, #fixCollisionsFrom: and #noCheckNoGrowFillFrom:.

Instance Variables
	array:		<ArrayedCollection> (typically Array or WeakArray)
	tally:		<Integer> (non-negative)

array
	- An array whose size is a prime number, it's non-nil elements are the elements of the collection, and whose nil elements are empty slots. There is always at least one nil. In fact I try to keep my "load" at 75% or less so that hashing will work well.

tally
	- The number of elements in the collection. The array size is always greater than this.

Implementation details:
I implement a hash table which uses open addressing with linear probing as the method of collision resolution. Searching for an element or a free slot for an element is done by #scanFor: which should return the index of the slot in array corresponding to it's argument. When an element is removed #fixCollisionsFrom: should rehash all elements in array between the original index of the removed element, wrapping around after the last slot until reaching an empty slot. My maximum load factor (75%) is hardcoded in #atNewIndex:put:, so it can only be changed by overriding that method. When my load factor reaches this limit I replace my array with a larger one (see #grow) ensuring that my load factor will be less than or equal to 50%. The new array is filled by #noCheckNoGrowFillFrom: which should use #scanForEmptySlotFor: instead of #scanFor: for better performance. I do not shrink.
!
!HashedCollection methodsFor: '*Fuel' stamp: 'MartinDias 6/13/2011 02:43'!
fuelAfterMaterialization

	self rehash! !

!HashedCollection methodsFor: 'private' stamp: 'HenrikSperreJohansen 9/1/2010 22:20'!
noCheckNoGrowFillFrom: anArray
	"Add the elements of anArray except nils to me assuming that I don't contain any of them, they are unique and I have more free space than they require."
	
	self subclassResponsibility! !

!HashedCollection methodsFor: 'private' stamp: 'TristanBourgois 4/30/2010 16:13'!
grow
	"Grow the elements array and reinsert the old elements"

	| oldElements |
	oldElements := array.
	array := Array new: (HashTableSizes atLeast: oldElements size * 2).
	tally := 0.
	oldElements
		do:
			[ :each | 
			each == nil
				ifFalse: [ self noCheckAdd: each ] ]! !

!HashedCollection methodsFor: 'private' stamp: 'TristanBourgois 4/30/2010 16:13'!
fullCheck
	"Keep array at least 1/4 free for decent hash behavior"
	array size - tally < (array size // 4 max: 1)
		ifTrue: [self grow]! !

!HashedCollection methodsFor: 'adding' stamp: 'HenrikSperreJohansen 9/1/2010 22:00'!
add: newObject withOccurrences: anInteger
	"Add newObject anInteger times to the receiver. Do nothing if anInteger is less than one. Answer newObject."
	
	anInteger < 1 ifTrue: [ ^newObject ].
	"I can only store an object once."
	^ self add: newObject! !

!HashedCollection methodsFor: 'initialization' stamp: 'TristanBourgois 4/30/2010 16:13'!
initialize: n
	"Initialize array to an array size of n"
	array := Array new: n.
	tally := 0! !

!HashedCollection methodsFor: 'accessing' stamp: 'TristanBourgois 4/30/2010 16:13'!
someElement
	"Deprecated. Use anyOne."

	^ self anyOne! !

!HashedCollection methodsFor: 'private' stamp: 'HenrikSperreJohansen 9/1/2010 22:43'!
scanFor: anObject
	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
	
	self subclassResponsibility! !

!HashedCollection methodsFor: 'private' stamp: 'HenrikSperreJohansen 9/1/2010 22:49'!
scanForEmptySlotFor: aKey
	"Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements."
	
	| index start |
	index := start := aKey hash \\ array size + 1.
	[ 
		(array at: index) ifNil: [ ^index ].
		(index := index \\ array size + 1) = start ] whileFalse.
	self errorNoFreeSpace! !

!HashedCollection methodsFor: 'enumerating' stamp: 'TristanBourgois 4/30/2010 16:13'!
doWithIndex: aBlock2
	"Support Set enumeration with a counter, even though not ordered"
	| index |
	index := 0.
	self do: [:item | aBlock2 value: item value: (index := index+1)]! !

!HashedCollection methodsFor: 'enumerating' stamp: 'EstebanLorenzano 8/17/2012 12:19'!
union: aCollection
	"Answer the set theoretic union of the receiver and aCollection, using the receiver's notion of equality and not side effecting the receiver at all."

	^ self copy addAll: aCollection; yourself! !

!HashedCollection methodsFor: 'private' stamp: 'TristanBourgois 4/30/2010 16:13'!
array
	^ array! !

!HashedCollection methodsFor: 'copying' stamp: 'CamilloBruni 10/2/2013 19:29'!
veryDeepCopyWith: deepCopier
	| copyOfSelf|
	copyOfSelf := super veryDeepCopyWith: deepCopier.
	"force Sets and Dictionaries to rehash"
	copyOfSelf rehash.
		^ copyOfSelf! !

!HashedCollection methodsFor: 'private' stamp: 'HenrikSperreJohansen 9/1/2010 22:06'!
fixCollisionsFrom: start
	"The element at start has been removed and replaced by nil.
	This method moves forward from there, relocating any entries
	that had been placed below due to collisions with this one."
	
	self subclassResponsibility! !

!HashedCollection methodsFor: 'private' stamp: 'HenrikSperreJohansen 9/1/2010 21:58'!
errorNoFreeSpace

	self error: 'There is no free space in this collection!!'! !

!HashedCollection methodsFor: 'accessing' stamp: 'TristanBourgois 4/30/2010 16:13'!
size
	^ tally! !

!HashedCollection methodsFor: 'accessing' stamp: 'TristanBourgois 4/30/2010 16:13'!
capacity
	"Answer the current capacity of the receiver."

	^ array size! !

!HashedCollection methodsFor: '*Monticello-Storing' stamp: 'StephaneDucasse 10/18/2010 14:54'!
comeFullyUpOnReload: smartRefStream
	"Symbols have new hashes in this image."

	self  compact.
	"^ self"
! !

!HashedCollection methodsFor: 'private' stamp: 'HenrikSperreJohansen 9/1/2010 23:21'!
rehash
	self growTo: self capacity! !

!HashedCollection methodsFor: 'private' stamp: 'TristanBourgois 4/30/2010 16:13'!
atNewIndex: index put: anObject
	array at: index put: anObject.
	tally := tally + 1.
	self fullCheck! !

!HashedCollection methodsFor: 'private' stamp: 'HenrikSperreJohansen 9/1/2010 22:24'!
compact
	"Reduce the size of array so that the load factor will be ~75%."
	
	| newCapacity |
	newCapacity := HashTableSizes atLeast: tally * 4 // 3.
	self growTo: newCapacity! !

!HashedCollection methodsFor: 'private' stamp: 'TristanBourgois 4/30/2010 16:13'!
findElementOrNil: anObject
	"Answer the index of a first slot containing either a nil (indicating an empty slot) or an element that matches the given object. Answer the index of that slot or zero. Fail if neither a match nor an empty slot is found."

	| index |

	index := self scanFor: anObject.
	index > 0 ifTrue: [^index].

	"Bad scene.  Neither have we found a matching element
	nor even an empty slot.  No hashed set is ever supposed to get
	completely full."
	self error: 'There is no free space in this set!!'.! !

!HashedCollection methodsFor: 'private' stamp: 'HenrikSperreJohansen 9/1/2010 22:20'!
growSize
	"Answer what my next higher table size should be"

	^HashTableSizes atLeast: self capacity * 3 // 2 + 2
	! !

!HashedCollection methodsFor: 'private' stamp: 'HenrikSperreJohansen 9/1/2010 22:21'!
growTo: anInteger
	"Grow the elements array and reinsert the old elements"
	
	| oldElements |
	oldElements := array.
	array := Array new: anInteger.
	self noCheckNoGrowFillFrom: oldElements! !

!HashedCollection methodsFor: 'private' stamp: 'jordidelgado 10/30/2013 16:49'!
noCheckAdd: anObject

    self subclassResponsibility! !

!HashedCollection methodsFor: 'removing' stamp: 'TristanBourgois 4/30/2010 16:13'!
removeAll
	"remove all elements from this collection.
	Preserve the capacity"
	
	self initialize: self capacity! !

!HashedCollection class methodsFor: 'instance creation' stamp: 'TristanBourgois 4/30/2010 16:13'!
new: nElements
	"Create a Set large enough to hold nElements without growing"
	^ self basicNew initialize: (self sizeFor: nElements)! !

!HashedCollection class methodsFor: 'initialization' stamp: 'StephaneDucasse 10/18/2010 14:48'!
compactAllInstances
	"Do not use #allInstancesDo: because rehash may create new instances."
	
	self allInstances do: [ :each | each compact ]! !

!HashedCollection class methodsFor: 'initialization' stamp: 'HenrikSperreJohansen 9/1/2010 22:31'!
rehashAll
	"HashedCollection rehashAll"	
		
	self allSubclassesDo: #rehashAllInstances! !

!HashedCollection class methodsFor: 'instance creation' stamp: 'HenrikSperreJohansen 9/1/2010 22:18'!
sizeFor: nElements
	"Large enough size to hold nElements with some slop (see fullCheck)"
	
	nElements < 4 ifTrue: [ ^5 ].
	^ HashTableSizes atLeast: nElements +1 * 4 // 3! !

!HashedCollection class methodsFor: 'instance creation' stamp: 'HenrikSperreJohansen 9/1/2010 22:25'!
new
	^ self basicNew
		initialize: 5! !

!HashedCollection class methodsFor: 'cleanup' stamp: 'HenrikSperreJohansen 9/1/2010 23:40'!
cleanUp: aggressive
	"Rehash all instances when cleaning aggressively"

	aggressive ifTrue: [self compactAll].
! !

!HashedCollection class methodsFor: 'instance creation' stamp: 'HenrikSperreJohansen 9/1/2010 22:27'!
newFrom: aCollection 
	"Answer an instance of me containing the same elements as aCollection."
	^self subclassResponsibility! !

!HashedCollection class methodsFor: 'initialization' stamp: 'HenrikSperreJohansen 9/1/2010 23:39'!
compactAll
	"HashedCollection rehashAll"	
		
	self allSubclassesDo: #compactAllInstances! !

!HashedCollection class methodsFor: 'initialization' stamp: 'StephaneDucasse 10/18/2010 14:49'!
rehashAllInstances
	"Do not use #allInstancesDo: because rehash may create new instances."
	
	self allInstances do: [ :each | each rehash ]! !

!Heap commentStamp: 'StephaneDucasse 10/2/2010 17:42'!
Heap implements a special data structure commonly referred to as 'heap' [ http://en.wikipedia.org/wiki/Heap_%28data_structure%29 ]

Heaps are good at handling priority queues because:
	1) greatest priority element according to the sort block will be stored in first position and thus accessed in O(1) operations
	2) worse time for inserting or removing an element is in O(log n) operations, where n is the size of the Heap
	Insertion/Removal times are more efficient than above upper bound, provided that:
		a) Elements are only removed at the beginning
		b) Elements are added with arbitrary sort order.
	3) there is no need to fully sort the Heap, which makes it more efficient than a SortedCollection

The heap can be fully sorted by sending the message #fullySort.
Worse time for fully sorting the Heap is in O(n log n) operations, but this is rarely used a feature.
Remind that the Heap does not fully sort the collection if you don't ask.
Thus don't expect #do: and other iterators to enumerate elements according to the sortBlock order.

Instance variables:
       array           <Array>         The data repository
       tally           <Integer>       The number of elements in the heap
       sortBlock       <Block|nil>     A two-argument block defining the sort order,
                                                       or nil in which case the default sort order is
                                                               [:element1 :element2| element1 <= element2]
       indexUpdateBlock        <Block|nil>
                                                       A two-argument block of the form [:data :index | ... ]
                                                       which allows an application object to keep track of its
                                                       index within the heap.  Useful for quick heap update
                                                       when object's sort value changes (for example, when an
                                                       object in a priority queue has its priority increased
                                                       by an external event, you don't want to have to search
                                                       through the whole heap to find the index before fixing
                                                      the heap).  No update occurs if nil.

The Heap can be viewed as a binary tree (every node in the tree has at most two children).
The root is stored in first slot of internal array.
The children are stored in next two slots.
The children of children in next four slots.
etc...

For a node A of index i (1 based), the two children B1 and B2 are thus stored in indices (2*i) and (2*i+1).
Of course, the children indices must be less than the tally otherwise they are considered inexistent.

The Heap does arrange to preserve the following invariant:
For any children B of a node A, A is sorted before B, in other words, (self sort: A before: B) = true
This implies that the root is always the first element according to sort order.
!
!Heap methodsFor: 'accessing' stamp: 'CamilloBruni 10/20/2012 18:23'!
sortBlock
	^ sortBlock ifNil: [ sortBlock := self defaultSortBlock ]! !

!Heap methodsFor: 'growing' stamp: 'ar 7/1/1999 04:18'!
growSize
	"Return the size by which the receiver should grow if there are no empty slots left."
	^array size max: 5! !

!Heap methodsFor: 'growing' stamp: 'ar 7/1/1999 04:17'!
grow
	"Become larger."
	self growTo: self size + self growSize.! !

!Heap methodsFor: '*Kernel-Processes' stamp: 'BenComan 11/3/2014 20:27'!
removeFirstOrNil
	"Remove the first element from the receiver"
	self isEmpty ifTrue:  [ ^nil ].
	^self privateRemoveAt: 1! !

!Heap methodsFor: 'accessing' stamp: 'ar 9/10/1999 14:08'!
reSort
	"Resort the entire heap"
	self isEmpty ifTrue:[^self].
	tally // 2 to: 1 by: -1 do:[:i| self downHeap: i].! !

!Heap methodsFor: 'private' stamp: 'StephaneDucasse 10/2/2010 17:37'!
privateReverseSort
	"Arrange to have the array sorted in reverse order.
	WARNING: this method breaks the heap invariants. It's up to the sender to restore them afterwards."
	| oldTally |
	oldTally := tally.
	[tally > 1] whileTrue:
		 [array swap: 1 with: tally.
		tally := tally - 1.
		 self downHeapSingle: 1].
	tally := oldTally! !

!Heap methodsFor: 'accessing' stamp: 'md 1/19/2006 09:56'!
first
	"Return the first element in the receiver"
	^array at: 1! !

!Heap methodsFor: 'removing' stamp: 'klub 9/14/2009 19:10'!
removeAll

	array atAllPut: nil.
	tally := 0! !

!Heap methodsFor: 'sorting' stamp: ''!
sort
	"Sort this collection into ascending order using the '<=' operator."

	self sort: [:a :b | a <= b]! !

!Heap methodsFor: 'private' stamp: 'jcg 3/8/2003 02:08'!
updateObjectIndex: index
	"If indexUpdateBlock is not nil, notify the object at index of its new position in the heap array."
	indexUpdateBlock ifNotNil: [
		indexUpdateBlock value: (array at: index) value: index]! !

!Heap methodsFor: 'sorting' stamp: ''!
isSortedBy: aBlock
	"Return true if the receiver is sorted by the given criterion."

	| lastElm elm |
	self isEmpty ifTrue: [^ true].
	lastElm := self first.
	2 to: self size do: 
		[:index | 
		elm := self at: index.
		(aBlock value: lastElm value: elm) ifFalse: [^ false].
		lastElm := elm].
	^ true! !

!Heap methodsFor: 'private' stamp: 'ar 9/15/2000 17:12'!
privateRemoveAt: index
	"Remove the element at the given index and make sure the sorting order is okay"
	| removed |
	removed := array at: index.
	array at: index put: (array at: tally).
	array at: tally put: nil.
	tally := tally - 1.
	index > tally ifFalse:[
		"Use #downHeapSingle: since only one element has been removed"
		self downHeapSingle: index].
	^removed! !

!Heap methodsFor: 'accessing' stamp: 'nice 3/26/2011 17:38'!
at: index
	"Heap are not designed to be accessed sequentially."
	
	self shouldNotImplement.! !

!Heap methodsFor: 'adding' stamp: 'jcg 3/8/2003 02:07'!
add: anObject
	"Include newObject as one of the receiver's elements. Answer newObject."
	tally = array size ifTrue:[self grow].
	array at: (tally := tally + 1) put: anObject.
	self updateObjectIndex: tally.
	self upHeap: tally.
	^anObject! !

!Heap methodsFor: 'private' stamp: 'ar 7/1/1999 04:19'!
array
	^array! !

!Heap methodsFor: 'sorting' stamp: ''!
mergeSortFrom: startIndex to: stopIndex by: aBlock
	"Sort the given range of indices using the mergesort algorithm.
	Mergesort is a worst-case O(N log N) sorting algorithm that usually
	does only half as many comparisons as heapsort or quicksort."

	"Details: recursively split the range to be sorted into two halves,
	mergesort each half, then merge the two halves together. An extra 
	copy of the data is used as temporary storage and successive merge 
	phases copy data back and forth between the receiver and this copy.
	The recursion is set up so that the final merge is performed into the
	receiver, resulting in the receiver being completely sorted."

	self size <= 1 ifTrue: [^ self].  "nothing to do"
	startIndex = stopIndex ifTrue: [^ self].
	[startIndex >= 1 and: [startIndex < stopIndex]] assert. "bad start index"
	[stopIndex <= self size] assert. "bad stop index"
	self
		mergeSortFrom: startIndex
		to: stopIndex 
		src: self copy 
		dst: self 
		by: aBlock! !

!Heap methodsFor: 'sorting' stamp: ''!
sorted
	"Return a new sequenceable collection which contains the same elements as self but its 
elements are sorted in ascending order using the #'<=' operator."
	
	^self sorted: [ :a :b| a <= b ]! !

!Heap methodsFor: 'sorting' stamp: ''!
mergeFirst: first middle: middle last: last into: dst by: aBlock
	"Private. Merge the sorted ranges [first..middle] and [middle+1..last] 
	of the receiver into the range [first..last] of dst."

	| i1 i2 val1 val2 out |
	i1 := first.
	i2 := middle + 1.
	val1 := self at: i1.
	val2 := self at: i2.
	out := first - 1.  "will be pre-incremented"

	"select 'lower' half of the elements based on comparator"
	[(i1 <= middle) and: [i2 <= last]] whileTrue:
		[(aBlock value: val1 value: val2)
			ifTrue: [dst at: (out := out + 1) put: val1.
					val1 := self at: (i1 := i1 + 1)]
			ifFalse: [dst at: (out := out + 1) put: val2.
					i2 := i2 + 1.
					i2 <= last ifTrue: [val2 := self at: i2]]].

	"copy the remaining elements"
	i1 <= middle
		ifTrue: [dst replaceFrom: out + 1 to: last with: self startingAt: i1]
		ifFalse: [dst replaceFrom: out + 1 to: last with: self startingAt: i2]! !

!Heap methodsFor: 'sorting' stamp: ''!
sorted: aSortBlockOrNil
	"Return a new sequenceable collection which contains the same elements as self but its 
elements are sorted by aSortBlockOrNil. The block should take two arguments and return true if 
the first element should preceed the second one. If aSortBlock is nil then <= is used for 
comparison."
	
	^self copy sort: aSortBlockOrNil! !

!Heap methodsFor: 'accessing' stamp: 'sma 5/12/2000 11:37'!
size
	"Answer how many elements the receiver contains."

	^ tally! !

!Heap methodsFor: 'accessing' stamp: 'stephane.ducasse 4/13/2009 21:05'!
sortBlock: aBlock
	sortBlock := aBlock.
	self reSort.! !

!Heap methodsFor: 'testing' stamp: 'ar 9/10/1999 13:03'!
isEmpty
	"Answer whether the receiver contains any elements."
	^tally = 0! !

!Heap methodsFor: 'removing' stamp: 'nice 3/26/2011 17:36'!
removeFirst
	"Remove the first element from the receiver"
	self emptyCheck.
	^self privateRemoveAt: 1! !

!Heap methodsFor: 'accessing' stamp: 'CamilloBruni 10/20/2012 18:23'!
defaultSortBlock
	^ self class defaultSortBlock! !

!Heap methodsFor: 'removing' stamp: 'ar 9/10/1999 13:04'!
remove: oldObject ifAbsent: aBlock
	"Remove oldObject as one of the receiver's elements. If several of the 
	elements are equal to oldObject, only one is removed. If no element is 
	equal to oldObject, answer the result of evaluating anExceptionBlock. 
	Otherwise, answer the argument, oldObject."
	1 to: tally do:[:i| 
		(array at: i) = oldObject ifTrue:[^self privateRemoveAt: i]].
	^aBlock value! !

!Heap methodsFor: 'private' stamp: 'jcg 3/8/2003 02:11'!
downHeap: anIndex
	"Check the heap downwards for correctness starting at anIndex.
	 Everything above (i.e. left of) anIndex is ok."
	| value k n j |
	anIndex = 0 ifTrue:[^self].
	n := tally bitShift: -1.
	k := anIndex.
	value := array at: anIndex.
	[k <= n] whileTrue:[
		j := k + k.
		"use max(j,j+1)"
		(j < tally and:[self sorts: (array at: j+1) before: (array at: j)])
				ifTrue:[ j := j + 1].
		"check if position k is ok"
		(self sorts: value before: (array at: j)) 
			ifTrue:[	"yes -> break loop"
					n := k - 1]
			ifFalse:[	"no -> make room at j by moving j-th element to k-th position"
					array at: k put: (array at: j).
					self updateObjectIndex: k.
					"and try again with j"
					k := j]].
	array at: k put: value.
	self updateObjectIndex: k.! !

!Heap methodsFor: 'sorting' stamp: ''!
mergeSortFrom: first to: last src: src dst: dst by: aBlock
	"Private. Split the range to be sorted in half, sort each half, and 
	merge the two half-ranges into dst."

	| middle |
	first = last ifTrue: [^ self].
	middle := (first + last) // 2.
	self mergeSortFrom: first to: middle src: dst dst: src by: aBlock.
	self mergeSortFrom: middle + 1 to: last src: dst dst: src by: aBlock.
	src mergeFirst: first middle: middle last: last into: dst by: aBlock! !

!Heap methodsFor: 'testing' stamp: 'ar 9/10/1999 13:03'!
sorts: element1 before: element2
	"Return true if element1 should be sorted before element2.
	This method defines the sort order in the receiver"
	^sortBlock == nil
		ifTrue:[element1 <= element2]
		ifFalse:[sortBlock value: element1 value: element2].! !

!Heap methodsFor: 'copying' stamp: 'nice 8/21/2010 15:53'!
copyEmpty
	"Answer a copy of the receiver without any of the receiver's elements."

	^self class sortBlock: sortBlock! !

!Heap methodsFor: 'sorting' stamp: ''!
isSorted
	"Return true if the receiver is sorted by the given criterion.
	Optimization for isSortedBy: [:a :b | a <= b]."

	| lastElm elm |
	self isEmpty ifTrue: [^ true].
	lastElm := self first.
	2 to: self size do: 
		[:index | 
		elm := self at: index.
		lastElm <= elm ifFalse: [^ false].
		lastElm := elm].
	^ true! !

!Heap methodsFor: 'private' stamp: 'ar 7/1/1999 04:35'!
setCollection: aCollection
	array := aCollection.
	tally := 0.! !

!Heap methodsFor: 'private' stamp: 'jcg 3/8/2003 02:11'!
downHeapSingle: anIndex
	"This version is optimized for the case when only one element in the receiver can be at a wrong position. It avoids one comparison at each node when travelling down the heap and checks the heap upwards after the element is at a bottom position. Since the probability for being at the bottom of the heap is much larger than for being somewhere in the middle this version should be faster."
	| value k n j |
	anIndex = 0 ifTrue:[^self].
	n := tally bitShift: -1.
	k := anIndex.
	value := array at: anIndex.
	[k <= n] whileTrue:[
		j := k + k.
		"use max(j,j+1)"
		(j < tally and:[self sorts: (array at: j+1) before: (array at: j)])
				ifTrue:[	j := j + 1].
		array at: k put: (array at: j).
		self updateObjectIndex: k.
		"and try again with j"
		k := j].
	array at: k put: value.
	self updateObjectIndex: k.
	self upHeap: k! !

!Heap methodsFor: 'accessing' stamp: 'nice 3/26/2011 17:38'!
at: index put: newObject
	"Heap are not designed to be accessed sequentially.
	Please consider using #add: instead."
	
	self shouldNotImplement.! !

!Heap methodsFor: 'copying' stamp: 'nice 10/5/2009 08:47'!
postCopy
	super postCopy.
	array := array copy! !

!Heap methodsFor: 'enumerating' stamp: 'nice 8/21/2010 15:40'!
collect: aBlock
	^self collect: aBlock as: Array! !

!Heap methodsFor: 'comparing' stamp: 'CamilloBruni 10/20/2012 18:17'!
= anObject
	"Heap are considered equals only if they have same sort order and same elements."

	self == anObject ifTrue: [^true].
	anObject isHeap ifFalse: [^false].
	self sortBlock = anObject sortBlock ifFalse: [^false].
	self size = anObject size ifFalse: [^false].
	^(self asArray sort: sortBlock) = (anObject asArray sort: sortBlock)! !

!Heap methodsFor: 'sorting' stamp: 'StephaneDucasse 10/2/2010 17:37'!
fullySort
	"Fully sort the heap.
	This method preserves the heap invariants and can thus be sent safely"
	self privateReverseSort.
	1 to: tally // 2 do: [:i | array swap: i with: 1 + tally - i]! !

!Heap methodsFor: 'enumerating' stamp: 'ar 9/10/1999 13:05'!
do: aBlock
	"Evaluate aBlock with each of the receiver's elements as the argument."
	1 to: tally do:[:i| aBlock value: (array at: i)]! !

!Heap methodsFor: 'private' stamp: 'jcg 3/8/2003 02:12'!
upHeap: anIndex
	"Check the heap upwards for correctness starting at anIndex.
	 Everything below anIndex is ok."
	| value k kDiv2 tmp |
	anIndex = 0 ifTrue:[^self].
	k := anIndex.
	value := array at: anIndex.
	[ (k > 1) and:[self sorts: value before: (tmp := array at: (kDiv2 := k bitShift: -1))] ] 
		whileTrue:[
			array at: k put: tmp.
			self updateObjectIndex: k.
			k := kDiv2].
	array at: k put: value.
	self updateObjectIndex: k.! !

!Heap methodsFor: 'testing' stamp: 'rhi 8/14/2003 08:51'!
isHeap

	^ true! !

!Heap methodsFor: 'sorting' stamp: ''!
sort: aSortBlock 
	"Sort this array using aSortBlock. The block should take two arguments
	and return true if the first element should preceed the second one."

	self
		mergeSortFrom: 1
		to: self size
		by: aSortBlock! !

!Heap methodsFor: 'growing' stamp: 'ar 7/1/1999 04:18'!
growTo: newSize
	"Grow to the requested size."
	| newArray |
	newArray := Array new: (newSize max: tally).
	newArray replaceFrom: 1 to: array size with: array startingAt: 1.
	array := newArray! !

!Heap methodsFor: 'private' stamp: 'ar 9/10/1999 13:18'!
setCollection: aCollection tally: newTally
	array := aCollection.
	tally := newTally.! !

!Heap methodsFor: 'growing' stamp: 'ar 7/1/1999 04:18'!
trim
	"Remove any empty slots in the receiver."
	self growTo: self size.! !

!Heap methodsFor: 'accessing' stamp: 'stephane.ducasse 4/13/2009 21:05'!
indexUpdateBlock: aBlockOrNil

	indexUpdateBlock := aBlockOrNil.

! !

!Heap class methodsFor: 'instance creation' stamp: 'ar 7/1/1999 04:20'!
new: n
	^super new setCollection: (Array new: n)! !

!Heap class methodsFor: 'instance creation' stamp: 'MarcusDenker 6/24/2013 11:12'!
withAll: aCollection sortBlock: aBlock
	"Create a new heap with all the elements from aCollection"
	^(self basicNew)
		setCollection: aCollection asArray copy tally: aCollection size;
		sortBlock: aBlock;
		yourself! !

!Heap class methodsFor: 'instance creation' stamp: 'ar 7/1/1999 04:20'!
new
	^self new: 10! !

!Heap class methodsFor: 'instance creation' stamp: 'ar 9/10/1999 14:13'!
sortBlock: aBlock
	"Create a new heap sorted by the given block"
	^self new sortBlock: aBlock! !

!Heap class methodsFor: 'accessing' stamp: 'CamilloBruni 10/20/2012 18:22'!
defaultSortBlock
	"Cache the default sort block here.
	Since the sortBlock is used to compare instances, a single instance for the default block helps us.."
	^ sortBlock ifNil: [ 
		sortBlock := [ :a :b | a <= b]]! !

!Heap class methodsFor: 'instance creation' stamp: 'ar 9/10/1999 13:23'!
withAll: aCollection
	"Create a new heap with all the elements from aCollection"
	^(self basicNew)
		setCollection: aCollection asArray copy tally: aCollection size;
		reSort;
		yourself! !

!HeapTest commentStamp: 'TorstenBergmann 2/20/2014 15:28'!
SUnit tests for heap collections!
!HeapTest methodsFor: 'tests - set arithmetic' stamp: ''!
numberOfSimilarElementsInIntersection
	^ self collection occurrencesOf: self anotherElementOrAssociationIn! !

!HeapTest methodsFor: 'tests - occurrencesOf for multipliness' stamp: ''!
testOccurrencesOfForMultipliness

| collection elem |
collection := self collectionWithEqualElements .
elem := self elementTwiceInForOccurrences .

self assert: (collection occurrencesOf: elem ) = 2.  ! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/4/2009 10:12'!
moreThan4Elements

" return a collection including at leat 4 elements"
	^ nonEmpty5ElementsWithoutDuplicate ! !

!HeapTest methodsFor: 'tests - remove' stamp: ''!
testRemoveElementReallyRemovesElement
	"self debug: #testRemoveElementReallyRemovesElement"
	| size |
	size := self nonEmptyWithoutEqualElements size.
	self nonEmptyWithoutEqualElements remove: self nonEmptyWithoutEqualElements anyOne.
	self assert: size - 1 = self nonEmptyWithoutEqualElements size! !

!HeapTest methodsFor: 'tests - converting' stamp: ''!
assertNonDuplicatedContents: aCollection whenConvertedTo: aClass 
	| result |
	result := aCollection perform: ('as' , aClass name) asSymbol.
	self assert: (result class includesBehavior: aClass).
	result do: 
		[ :each | 
		self assert: (aCollection occurrencesOf: each) = (result occurrencesOf: each) ].
	^ result! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 11:06'!
secondIndex
" return an index between 'nonEmpty' bounds that is > to 'second index' "
	^3! !

!HeapTest methodsFor: 'tests - converting' stamp: ''!
testAsIdentitySet
	"test with a collection without equal elements :"
	self 
		assertSameContents: self collectionWithoutEqualElements
		whenConvertedTo: IdentitySet.
! !

!HeapTest methodsFor: 'test - creation' stamp: ''!
testWithWithWith
	"self debug: #testWithWithWith"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom:1 to: 3 .
	aCol := self collectionClass with: (collection at:1) with: ( collection at:2 ) with: ( collection at: 3).

	1 to: 3 do: [ :i | self assert: ( aCol occurrencesOf: ( collection at: i ) ) = ( collection occurrencesOf: ( collection at: i ) ) ].! !

!HeapTest methodsFor: 'tests - adding' stamp: ''!
testTWrite
	| added collection elem |
	collection := self otherCollection  .
	elem := self element .
	added := collection  write: elem .
	
	self assert: added == elem .	"test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection  includes: elem )	.
	self assert: (collection  includes: elem ).
	
	! !

!HeapTest methodsFor: 'tests - converting' stamp: ''!
testAsSet
	| |
	"test with a collection without equal elements :"
	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: Set.
	! !

!HeapTest methodsFor: 'tests - converting' stamp: ''!
testAsByteArray
	| res |
	self integerCollectionWithoutEqualElements.
	self integerCollectionWithoutEqualElements do: [ :each | self assert: each class = SmallInteger ].
	res := true.
	self integerCollectionWithoutEqualElements
		detect: [ :each | (self integerCollectionWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false.
	self assertSameContents: self integerCollectionWithoutEqualElements whenConvertedTo: ByteArray! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 09:56'!
elementNotInForIndexAccessing
" return an element not included in 'collectionMoreThan1NoDuplicates' "
	^ elementNotIn ! !

!HeapTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionTwoSimilarElementsInIntersection
	"self debug: #testIntersectionBasic"
	| inter |
	inter := self collection intersection: (self collectionClass with: self anotherElementOrAssociationIn).
	self assert: (self collection occurrencesOf: self anotherElementOrAssociationIn) = self numberOfSimilarElementsInIntersection.
	self assert: (inter includes: self anotherElementOrAssociationIn value)! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 11:43'!
firstCollection
" return a collection that will be the first part of the concatenation"
	^nonEmpty ! !

!HeapTest methodsFor: 'parameters' stamp: 'cyrille.delaunay 3/20/2009 13:22'!
valuePutIn
	"the value that we will put in the non empty collection"
	
	^ 7! !

!HeapTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAnyNoneThere
	"self debug: #testIncludesAnyOfNoneThere'"
	
	self deny: (self nonEmpty includesAny: self empty).
	self deny: (self nonEmpty includesAny: { self elementNotIn. self anotherElementNotIn })! !

!HeapTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedArray
	| result collection |
	collection := self collectionWithSortableElements .
	result := collection  asArray sort.
	self assert: (result class includesBehavior: Array).
	self assert: result isSorted.
	self assert: result size = collection size! !

!HeapTest methodsFor: 'requirements' stamp: 'CamilloBruni 9/9/2011 12:11'!
collectionWithoutEqualElements

" return a collection not including equal elements "
	^ nonEmpty5ElementsWithoutDuplicate ! !

!HeapTest methodsFor: 'basic tests' stamp: 'nice 3/26/2011 17:50'!
testAdd
	"self run: #testAdd" 

	| heap |
	heap := Heap new.
	self assert: heap size = 0.
	heap add: 3.
	self assert: heap size = 1.
	self assert: heap isEmpty not.
	self assert: heap first = 3.
	heap add: 2.
	self assert: heap size = 2.
	self assert: heap first = 2.
	! !

!HeapTest methodsFor: 'test - creation' stamp: ''!
testWith
	"self debug: #testWith"
	
	| aCol anElement |
	anElement := self collectionMoreThan5Elements anyOne.
	aCol := self collectionClass with: anElement.
	self assert: (aCol includes: anElement).! !

!HeapTest methodsFor: 'tests - converting' stamp: ''!
testAsArray
	"self debug: #testAsArray3"
	self 
		assertSameContents: self collectionWithoutEqualElements
		whenConvertedTo: Array! !

!HeapTest methodsFor: 'tests - includes' stamp: ''!
testIncludesElementIsThere
	"self debug: #testIncludesElementIsThere"
	
	self assert: (self nonEmpty includes: self nonEmpty anyOne).! !

!HeapTest methodsFor: 'testing' stamp: 'nice 8/21/2010 16:33'!
testIfEqualIsTransitive
	"This is http://bugs.squeak.org/view.php?id=6943"

    | anArray heap1 heap2 |
    anArray := #(1 2 3).
    heap1 := Heap withAll: (1 to: 3) sortBlock: [:a :b | a < b].
    heap2 := Heap withAll: (1 to: 3) sortBlock: [:a :b | b > a].
    self
		assert: (heap1 = anArray) & (heap2 = anArray) ==> (heap1 = heap2)
		description: 'Heap equality should be transitive'! !

!HeapTest methodsFor: 'tests - copy' stamp: ''!
testCopyNotSame
	"self debug: #testCopySameClass"
	"A copy of a collection should always be of the same class as the instance it copies"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: copy  == self nonEmpty.! !

!HeapTest methodsFor: 'tests - set arithmetic' stamp: ''!
testUnionOfEmpties
	"self debug: #testUnionOfEmpties"
	
	self assert:  (self empty union: self empty) isEmpty.
	
	! !

!HeapTest methodsFor: 'tests - adding' stamp: ''!
testTWriteTwice
	| added oldSize collection elem |
	collection := self collectionWithElement .
	elem := self element .
	oldSize := collection  size.
	added := collection 
		write: elem ;
		write: elem .
	self assert: added == elem .	"test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection  includes: elem ).
	self assert: collection  size = (oldSize + 2)! !

!HeapTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifferenceWithSeparateCollection
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifferenceWithSeparateCollection"
	| res separateCol |
	
	separateCol := self collectionClass with: self anotherElementOrAssociationNotIn.
	res := self collectionWithoutEqualElements difference: separateCol.
	
	self deny: (res includes: self anotherElementOrAssociationNotIn).
	self assert: res size equals: self collectionWithoutEqualElements size.
	
	self collectionWithoutEqualElements do: [ :each|
		self assert: (res includes: each)].
	
	res := separateCol difference: self collection.
	self deny: (res includes: self collection anyOne).
	self assert: res equals: separateCol! !

!HeapTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 3/18/2009 15:07'!
collectionWithElement
	^ collectionWithElement! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 10:13'!
withEqualElements
	^ sameAtEndAndBegining ! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 11:05'!
firstIndex
" return an index between 'nonEmpty' bounds that is < to 'second index' "
	^2! !

!HeapTest methodsFor: 'tests - adding' stamp: ''!
testTAddIfNotPresentWithElementAlreadyIn

	| added oldSize collection anElement |
	collection := self collectionWithElement .
	oldSize := collection size.
	anElement := self element .
	self assert: (collection  includes: anElement ).
	
	added := collection  addIfNotPresent: anElement .
	
	self assert: added == anElement .	"test for identiy because #add: has not reason to copy its parameter."
	self assert: collection  size = oldSize! !

!HeapTest methodsFor: 'tests - adding' stamp: ''!
testTAddAll
	| added collection toBeAdded |
	collection := self collectionWithElement .
	toBeAdded := self otherCollection .
	added := collection addAll: toBeAdded .
	self assert: added == toBeAdded .	"test for identiy because #addAll: has not reason to copy its parameter."
	self assert: (collection includesAll: toBeAdded )! !

!HeapTest methodsFor: 'tests - adding' stamp: ''!
testTAddWithOccurences
	| added oldSize collection anElement |
	collection := self collectionWithElement .
	anElement := self element .
	oldSize := collection  size.
	added := collection  add: anElement withOccurrences: 5.
	
	self assert: added == anElement.	"test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection  includes: anElement).
	self assert: collection  size = (oldSize + 5)! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 15:44'!
anotherElementNotIn
" return an element different of 'elementNotIn'  not included in 'nonEmpty' "
	^ 9999! !

!HeapTest methodsFor: 'tests - remove' stamp: ''!
testRemoveIfAbsent
	"self debug: #testRemoveElementThatExists"

	| el res |
	el := self elementNotIn.
	res := self nonEmptyWithoutEqualElements remove: el ifAbsent: [ 33 ].
	self assert: res = 33! !

!HeapTest methodsFor: 'tests - remove' stamp: ''!
testRemoveElementFromEmpty
	"self debug: #testRemoveElementFromEmpty"
	self 
		should: [ self empty remove: self nonEmptyWithoutEqualElements anyOne ]
		raise: Error! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 10:26'!
collectionWithElementsToRemove
" return a collection of elements included in 'nonEmpty'  "
	^ self nonEmpty ! !

!HeapTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 3/20/2009 11:33'!
elementTwiceIn
	^elementTwiceIn! !

!HeapTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 3/20/2009 13:46'!
expectedSizeAfterReject
	"Number of even elements in #collection"
	^ expectedSizeAfterReject.! !

!HeapTest methodsFor: 'tests - adding' stamp: ''!
testTAdd
	| added collection |
	collection :=self otherCollection .
	added := collection add: self element.
	
	self assert: added == self element.	"test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection includes: self element)	.
	self assert: (self collectionWithElement includes: self element).
	
	! !

!HeapTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIncludeTest
	| anElementIn |
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self elementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self elementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self anotherElementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self anotherElementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self empty.
	self assert: self empty isEmpty! !

!HeapTest methodsFor: 'tests - including with identity' stamp: ''!
testIdentityIncludes
	" test the comportement in presence of elements 'includes' but not 'identityIncludes' "
	" can not be used by collections that can't include elements for wich copy doesn't return another instance "
	| collection anElement |
	
	collection := self collectionWithCopyNonIdentical.
	anElement := collection anyOne copy.

	self deny: (collection identityIncludes: anElement)! !

!HeapTest methodsFor: 'basic tests' stamp: 'stephane.ducasse 5/20/2009 18:11'!
testFirst
	"self run: #testFirst"
	| heap | 
	heap := Heap new.
	heap add: 5.
	heap add: 12.
	heap add: 1.
	self assert: heap first = 1.
	heap removeFirst.
	self assert: heap first = 5.! !

!HeapTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOfEmpty
	| result |
	result := self empty occurrencesOf: (self collectionWithoutEqualElements anyOne).
	self assert: result = 0! !

!HeapTest methodsFor: 'tests - includes' stamp: ''!
testIncludesElementIsNotThere
	"self debug: #testIncludesElementIsNotThere"
	
	self deny: (self nonEmpty includes: self elementNotIn).
	self assert: (self nonEmpty includes: self nonEmpty anyOne).
	self deny: (self empty includes: self elementNotIn)! !

!HeapTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 12/18/2009 13:08'!
replacementCollection
" return a collection including elements of type 'collectionOfSize5' elements'type"
^ collectionWith4Elements ! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 10:01'!
collectionWithSameAtEndAndBegining
	" return a collection with elements at end and begining equals .
(others elements of the collection are not equal to those elements)"
	^ sameAtEndAndBegining ! !

!HeapTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSetAritmeticTest
	self collection.
	self deny: self collection isEmpty.
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self anotherElementOrAssociationNotIn.
	self collection isDictionary
		ifTrue: [ self deny: (self collection associations includes: self anotherElementOrAssociationNotIn key) ]
		ifFalse: [ self deny: (self collection includes: self anotherElementOrAssociationNotIn) ].
	self collectionClass! !

!HeapTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIncludeWithIdentityTest
	| anElement |
	self collectionWithCopyNonIdentical.
	anElement := self collectionWithCopyNonIdentical anyOne.
	self deny: anElement == anElement copy! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/4/2009 10:23'!
collectionWithoutNilElements
" return a collection that doesn't includes a nil element  and that doesn't includes equal elements'"
	^ nonEmpty5ElementsWithoutDuplicate ! !

!HeapTest methodsFor: 'tests - adding' stamp: ''!
testTAddTwice
	| added oldSize collection anElement |
	collection := self collectionWithElement .
	anElement := self element .
	oldSize := collection  size.
	added := collection 
		add: anElement ;
		add: anElement .
	self assert: added == anElement .	"test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection  includes: anElement ).
	self assert: collection  size = (oldSize + 2)! !

!HeapTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:23'!
test0FixtureRequirementsOfTGrowableTest
	self empty.
	self nonEmpty.
	self element.
	self elementNotInForOccurrences.
	self assert: self empty isEmpty.
	self deny: self nonEmpty isEmpty.
	self assert: (self nonEmpty includes: self element).
	self deny: (self nonEmpty includes: self elementNotInForOccurrences)! !

!HeapTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureTConvertTest
	"a collection of number without equal elements:"

	| res |
	self collectionWithoutEqualElements.
	res := true.
	self collectionWithoutEqualElements
		detect: [ :each | (self collectionWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 10:12'!
integerCollectionWithoutEqualElements
" return a collection of integer without equal elements"
	^ nonEmpty5ElementsWithoutDuplicate ! !

!HeapTest methodsFor: 'tests - copy' stamp: ''!
testCopyEquals
	"self debug: #testCopySameClass"
	"A copy should be equivalent to the things it's a copy of"
	
	| copy | 
	copy := self nonEmpty copy.
	self assert: copy  = self nonEmpty.! !

!HeapTest methodsFor: 'testing' stamp: 'nice 3/26/2011 17:49'!
test1
	| data |

	"The first element of each array is the sort value, and the second will be updated by the heap with the index of the element within the heap."
	data :=  (1 to: 8) collect: [:i | {i*2. 0}].

	"Repeat with different data ordering."
	5 timesRepeat: [ | h |
		h := Heap new sortBlock: [:e1 :e2 | e1 first < e2 first].
		h indexUpdateBlock: [:array :index | array at: 2 put: index].

		data shuffled do: [:d | h add: d].
		data do: [:d | self should: (h asArray at: d second) == d].
	]! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 11:18'!
elementInForOccurrences
	^self nonEmpty anyOne! !

!HeapTest methodsFor: 'tests - remove' stamp: ''!
testRemoveElementThatExists
	"self debug: #testRemoveElementThatExists"

	| el res |
	el := self nonEmptyWithoutEqualElements anyOne.
	res := self nonEmptyWithoutEqualElements remove: el.
	self assert: res == el! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 14:00'!
collectionMoreThan5Elements
" return a collection including at least 5 elements"
	
	^nonEmpty5ElementsWithoutDuplicate ! !

!HeapTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWithoutAll
	"self debug: #testCopyEmptyWithoutAll"
	| res |
	res := self empty copyWithoutAll: self collectionWithElementsToRemove.
	self assert: res size = self empty size.
	self collectionWithElementsToRemove do: [ :each | self deny: (res includes: each) ]! !

!HeapTest methodsFor: 'tests - adding' stamp: ''!
testTAddIfNotPresentWithNewElement

	| added oldSize collection elem |
	collection := self otherCollection .
	oldSize := collection  size.
	elem := self element .
	self deny: (collection  includes: elem ).
	
	added := collection  addIfNotPresent: elem .
	self assert: added == elem . "test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection  size = (oldSize + 1)).

	! !

!HeapTest methodsFor: 'tests - includes' stamp: ''!
testIdentityIncludesNonSpecificComportement
	" test the same comportement than 'includes: '  "
	| collection |	
	collection := self nonEmpty  .
	
	self deny: (collection identityIncludes: self elementNotIn ).
	self assert:(collection identityIncludes: collection anyOne)
! !

!HeapTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutAll
	"self debug: #testCopyNonEmptyWithoutAll"
	| res |
	res := self nonEmpty copyWithoutAll: self collectionWithElementsToRemove.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self collectionWithElementsToRemove do: [ :each | self deny: (res includes: (each)) ].
	self nonEmpty do: 
		[ :each | 
		(self collectionWithElementsToRemove includes: each) ifFalse: [ self assert: (res includes: each) ] ]! !

!HeapTest methodsFor: 'tests - growable' stamp: 'delaunay 4/2/2009 11:53'!
testAddNonEmptyGrowsWhenNewElement
	"self debug: #testAddNonEmptyGrowsWhenNewElement"
	| oldSize |
	oldSize := self nonEmpty size.
	self deny: (self nonEmpty includes: self elementNotInForOccurrences).
	self nonEmpty add: self elementNotInForOccurrences.
	self assert: self nonEmpty size > oldSize! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 10:15'!
elementsCopyNonIdenticalWithoutEqualElements
	" return a collection that does niot incllude equal elements ( classic equality )
	all elements included are elements for which copy is not identical to the element  "
	^ floatCollection ! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 09:55'!
collectionMoreThan1NoDuplicates
	" return a collection of size > 1 without equal elements"
	^ nonEmpty5ElementsWithoutDuplicate ! !

!HeapTest methodsFor: 'basic tests' stamp: 'CamilloBruni 8/31/2013 20:23'!
testRemove
	"self run: #testRemove"

	| heap |
	heap := Heap new.
	self should: [ heap removeFirst ] raise: Error.
	heap add: 5.
	heap removeFirst.
	self assert: heap size = 0.
	heap add: 5.
	self should: [ heap removeAt: 2 ] raise: Error! !

!HeapTest methodsFor: 'tests - converting' stamp: ''!
assertNoDuplicates: aCollection whenConvertedTo: aClass 
	| result |
	result := self collectionWithEqualElements asIdentitySet.
	self assert: (result class includesBehavior: IdentitySet).
	self collectionWithEqualElements do: [ :initial | self assert: (result occurrencesOf: initial) = 1 ]! !

!HeapTest methodsFor: 'basic tests' stamp: 'nice 8/21/2010 16:11'!
testSortBlock
	"self run: #testSortBlock"

	| heap |
	heap := Heap withAll: #(1 3 5).
	self assert: heap asArray = #(1 3 5).
	
	heap sortBlock: [ :e1 :e2 | e1 >= e2 ].
	self assert: heap asArray = #(5 3 1)
! !

!HeapTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureOccurrencesForMultiplinessTest
	| cpt anElement collection |
	self collectionWithEqualElements.
	self collectionWithEqualElements.
	self elementTwiceInForOccurrences.
	anElement := self elementTwiceInForOccurrences.
	collection := self collectionWithEqualElements.
	cpt := 0.	" testing with identity check ( == ) so that identy collections can use this trait : "
	self collectionWithEqualElements
		do: [ :each | 
			each == self elementTwiceInForOccurrences
				ifTrue: [ cpt := cpt + 1 ] ].
	self assert: cpt = 2! !

!HeapTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAnyAllThere
	"self debug: #testIncludesAnyOfAllThere'"
	self deny: (self nonEmpty includesAny: self empty).
	self assert: (self nonEmpty includesAny: { self nonEmpty anyOne }).
	self assert: (self nonEmpty includesAny: self nonEmpty).! !

!HeapTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 3/18/2009 15:23'!
nonEmpty
	^nonEmpty.! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 10:28'!
elementToAdd
" return an element of type 'nonEmpy' elements'type'"
	^ elementNotIn ! !

!HeapTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCreationWithTest
	self collectionMoreThan5Elements.
	self assert: self collectionMoreThan5Elements size >= 5! !

!HeapTest methodsFor: 'requirements' stamp: ''!
collectionWithCopy
	"return a collection of type 'self collectionWIithoutEqualsElements class' containing no elements equals ( with identity equality)
	but  2 elements only equals with classic equality"
	| result collection |
	collection := OrderedCollection withAll: self elementsCopyNonIdenticalWithoutEqualElements.
	collection add: collection first copy.
	result := self elementsCopyNonIdenticalWithoutEqualElements class withAll: collection.
	^ result! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/4/2009 10:12'!
accessCollection
	^ nonEmpty5ElementsWithoutDuplicate! !

!HeapTest methodsFor: 'tests - remove' stamp: ''!
testRemoveAllFoundIn
	"self debug: #testRemoveElementThatExists"
	| el aSubCollection res |
	el := self nonEmptyWithoutEqualElements anyOne.
	aSubCollection := (self nonEmptyWithoutEqualElements copyWithout: el) copyWith: self elementNotIn.
	res := self nonEmptyWithoutEqualElements removeAllFoundIn: aSubCollection.
	self assert: self nonEmptyWithoutEqualElements size = 1.
	self nonEmptyWithoutEqualElements do: [ :each | self assert: each = el ]! !

!HeapTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureRequirementsOfTAddTest
	self collectionWithElement.
	self otherCollection.
	self element.
	self assert: (self collectionWithElement includes: self element).
	self deny: (self otherCollection includes: self element)! !

!HeapTest methodsFor: 'test - creation' stamp: ''!
testWithWith
	"self debug: #testWithWith"
	
	| aCol collection element1 element2 |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom: 1 to: 2  .
	element1 := collection at: 1.
	element2 := collection at:2.
	
	aCol := self collectionClass with: element1  with: element2 .
	self assert: (aCol occurrencesOf: element1 ) = ( collection occurrencesOf: element1).
	self assert: (aCol occurrencesOf: element2 ) = ( collection occurrencesOf: element2).
	
	! !

!HeapTest methodsFor: 'requirements' stamp: ''!
collectionWithIdentical
	"return a collection of type : 'self collectionWIithoutEqualsElements class containing two elements equals ( with identity equality)"
	| result collection anElement |
	collection := OrderedCollection withAll: self elementsCopyNonIdenticalWithoutEqualElements.
	anElement := collection first.
	collection add: anElement.
	result := self elementsCopyNonIdenticalWithoutEqualElements class withAll: collection.
	^ result! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/4/2009 10:10'!
elementInForElementAccessing
" return an element inculded in 'moreThan4Elements'"
	^ self moreThan4Elements anyOne.! !

!HeapTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureTRemoveTest
	| duplicate |
	self empty.
	self nonEmptyWithoutEqualElements.
	self deny: self nonEmptyWithoutEqualElements isEmpty.
	duplicate := true.
	self nonEmptyWithoutEqualElements
		detect: [ :each | (self nonEmptyWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ duplicate := false ].
	self assert: duplicate = false.
	self elementNotIn.
	self assert: self empty isEmpty.
	self deny: self nonEmptyWithoutEqualElements isEmpty.
	self deny: (self nonEmptyWithoutEqualElements includes: self elementNotIn)! !

!HeapTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 12/18/2009 13:08'!
sizeCollection
	"Answers a collection whose #size is 4"
	^collectionWith4Elements ! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 11:06'!
newElement
"return an element that will be put in the collection in place of another"
	^ elementNotIn ! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 10:17'!
aValue
" return a value to put into nonEmpty"
	^ self nonEmpty anyOne ! !

!HeapTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 3/18/2009 15:24'!
empty
	^empty.! !

!HeapTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWith
	"self debug: #testCopyNonEmptyWith"
	| res anElement |
	anElement := self elementToAdd .
	res := self nonEmpty copyWith: anElement.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self assert: (res includes: (anElement value)).
	self nonEmpty do: [ :each | res includes: each ]! !

!HeapTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutAllNotIncluded
	"self debug: #testCopyNonEmptyWithoutAllNotIncluded"
	| res |
	res := self nonEmpty copyWithoutAll: self collectionNotIncluded.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self nonEmpty do: [ :each | self assert: (res includes: each) ]! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 10:19'!
indexArray
" return a Collection including indexes between bounds of 'nonEmpty' "

	^ indexArray ! !

!HeapTest methodsFor: 'tests - remove' stamp: ''!
testRemoveAll
	"self debug: #testRemoveElementThatExists"
	| el aSubCollection collection res |
	collection := self nonEmptyWithoutEqualElements.
	el := collection anyOne.
	aSubCollection := collection copyWithout: el.
	res := collection removeAll: aSubCollection.
	self assert: collection size = 1.
	self nonEmptyWithoutEqualElements do: [ :each | self assert: each = el ]! !

!HeapTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 12/18/2009 13:07'!
collection
	^ collectionWith4Elements.! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 10:43'!
anotherElementOrAssociationIn
	" return an element (or an association for Dictionary ) present  in 'collection' "
	^ self collection anyOne! !

!HeapTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionEmpty
	"self debug: #testIntersectionEmpty"
	
	| inter |
	inter := self empty intersection: self empty.
	self assert: inter isEmpty. 
	inter := self empty intersection: self collection .
	self assert: inter =  self empty.
	! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/13/2009 16:06'!
collectionWithEqualElements
" return a collecition including atLeast two elements equal"

^ collectionWithDuplicateElement ! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 10:13'!
collectionWithSortableElements
" return a collection elements that can be sorte ( understanding message ' < '  or ' > ')"
	^ nonEmpty5ElementsWithoutDuplicate ! !

!HeapTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedCollectionWithSortBlock
	| result tmp |
	result := self collectionWithSortableElements  asSortedCollection: [:a :b | a > b].
	self assert: (result class includesBehavior: SortedCollection).
	result do: 
		[ :each | 
		self assert: (self collectionWithSortableElements   occurrencesOf: each) = (result occurrencesOf: each) ].
	self assert: result size = self collectionWithSortableElements  size.
	tmp:=result at: 1.
	result do: [:each| self assert: tmp>=each. tmp:=each].
	! !

!HeapTest methodsFor: 'tests - converting' stamp: ''!
assertSameContents: aCollection whenConvertedTo: aClass 
	| result |
	result := self assertNonDuplicatedContents: aCollection whenConvertedTo: aClass.
	self assert: result size = aCollection size! !

!HeapTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureTConvertAsSetForMultiplinessTest
	"a collection  with equal elements:"

	| res |
	self withEqualElements.
	res := true.
	self withEqualElements detect: [ :each | (self withEqualElements occurrencesOf: each) > 1 ] ifNone: [ res := false ].
	self assert: res = true! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 10:34'!
collectionOfSize5
" return a collection of size 5"
^ nonEmpty5ElementsWithoutDuplicate ! !

!HeapTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOfNotIn
	| result |
	result := self collectionWithoutEqualElements occurrencesOf: self elementNotInForOccurrences.
	self assert: result = 0! !

!HeapTest methodsFor: 'examples' stamp: 'md 2/12/2006 15:34'!
heapSortExample	"HeapTest new heapSortExample"
	"Sort a random collection of Floats and compare the results with
	SortedCollection (using the quick-sort algorithm) and 
	ArrayedCollection>>mergeSortFrom:to:by: (using the merge-sort algorithm)."
	| n rnd array  time sorted |
	n := 10000. "# of elements to sort"
	rnd := Random new.
	array := (1 to: n) collect:[:i| rnd next].
	"First, the heap version"
	time := Time millisecondsToRun:[
		sorted := Heap withAll: array.
		1 to: n do:[:i| sorted removeFirst].
	].
	Transcript cr; show:'Time for heap-sort: ', time printString,' msecs'.
	"The quicksort version"
	time := Time millisecondsToRun:[
		sorted := SortedCollection withAll: array.
	].
	Transcript cr; show:'Time for quick-sort: ', time printString,' msecs'.
	"The merge-sort version"
	time := Time millisecondsToRun:[
		array mergeSortFrom: 1 to: array size by: [:v1 :v2| v1 <= v2].
	].
	Transcript cr; show:'Time for merge-sort: ', time printString,' msecs'.
! !

!HeapTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifferenceWithNonNullIntersection
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifferenceWithNonNullIntersection"
	"	#(1 2 3) difference: #(2 4) 
	->  #(1 3)"
	| res overlapping |
	overlapping := self collectionClass 
		with: self anotherElementOrAssociationNotIn
		with: self anotherElementOrAssociationIn.
	res := self collection difference: overlapping.
	self deny: (res includes: self anotherElementOrAssociationIn).
	overlapping do: [ :each | self deny: (res includes: each) ]! !

!HeapTest methodsFor: 'test - creation' stamp: ''!
testWithAll
	"self debug: #testWithAll"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection .
	aCol := self collectionClass withAll: collection  .
	
	collection do: [ :each | self assert: (aCol occurrencesOf: each ) = ( collection occurrencesOf: each ) ].
	
	self assert: (aCol size = collection size ).! !

!HeapTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureOccurrencesTest
	| tmp |
	self empty.
	self assert: self empty isEmpty.
	self collectionWithoutEqualElements.
	self deny: self collectionWithoutEqualElements isEmpty.
	tmp := OrderedCollection new.
	self collectionWithoutEqualElements
		do: [ :each | 
			self deny: (tmp includes: each).
			tmp add: each ].
	self elementNotInForOccurrences.
	self deny: (self collectionWithoutEqualElements includes: self elementNotInForOccurrences)! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 10:26'!
collectionNotIncluded
" return a collection for wich each element is not included in 'nonEmpty' "
	^ collectionNotIncluded ! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 4/2/2009 11:53'!
elementNotInForOccurrences
	^ elementNotIn! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 10:43'!
anotherElementOrAssociationNotIn
	" return an element (or an association for Dictionary )not present  in 'collection' "
	^ elementNotIn ! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 11:43'!
secondCollection
" return a collection that will be the second part of the concatenation"
	^ nonEmpty5ElementsWithoutDuplicate ! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 09:57'!
elementInForIndexAccessing
" return an element included in 'collectionMoreThan1NoDuplicates' "
	^ self collectionMoreThan1NoDuplicates anyOne.! !

!HeapTest methodsFor: 'tests - as set tests' stamp: ''!
testAsIdentitySetWithEqualsElements
	| result collection |
	collection := self withEqualElements .
	result := collection asIdentitySet.
	collection do: [ :each | self assert: (result occurrencesOf: each) = 1 ].
	self assert: result class = IdentitySet.! !

!HeapTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithout
	"self debug: #testCopyNonEmptyWithout"
	
	| res anElementOfTheCollection |
	anElementOfTheCollection :=  self nonEmpty anyOne.
	res := (self nonEmpty copyWithout: anElementOfTheCollection).
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self deny: (res includes: anElementOfTheCollection).
	self nonEmpty do:
		[:each | (each = anElementOfTheCollection) 
					ifFalse: [self assert: (res includes: each)]].
	
! !

!HeapTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutNotIncluded
	"self debug: #testCopyNonEmptyWithoutNotIncluded"
	| res |
	res := self nonEmpty copyWithout: self elementToAdd.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self nonEmpty do: [ :each | self assert: (res includes: each) ]! !

!HeapTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionBasic
	"self debug: #testIntersectionBasic"
	| inter |
	inter := self collection intersection: (self collectionClass with: self anotherElementOrAssociationIn).
	self deny: inter isEmpty.
	self assert: (inter includes: self anotherElementOrAssociationIn value)! !

!HeapTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifference
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifference"
	
	| difference |
	self assert: (self collectionWithoutEqualElements difference: self collectionWithoutEqualElements) isEmpty.
	self assert: (self empty difference: self collectionWithoutEqualElements) isEmpty.
	difference := (self collectionWithoutEqualElements difference: self empty).
	self assert: difference size = self collectionWithoutEqualElements	 size.
	self collectionWithoutEqualElements do: [ :each |
		self assert: (difference includes: each)].
! !

!HeapTest methodsFor: 'tests - converting' stamp: ''!
testAsOrderedCollection
	
	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: OrderedCollection! !

!HeapTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOf
	| collection |
	collection := self collectionWithoutEqualElements .
	
	collection do: [ :each | self assert: (collection occurrencesOf: each) = 1 ].! !

!HeapTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionItself
	"self debug: #testIntersectionItself"
	
	| result |
	result :=  (self collectionWithoutEqualElements intersection: self collectionWithoutEqualElements).
	self assert: result size  = self collectionWithoutEqualElements size.
	self collectionWithoutEqualElements do: [ :each|
		self assert: (result includes: each) ].
	! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/13/2009 16:06'!
elementTwiceInForOccurrences
" return an element included exactly two time in # collectionWithEqualElements"
^ duplicateElement ! !

!HeapTest methodsFor: 'tests - fixture' stamp: ''!
test0CopyTest
	self empty.
	self assert: self empty size = 0.
	self nonEmpty.
	self assert: (self nonEmpty size = 0) not.
	self collectionWithElementsToRemove.
	self assert: (self collectionWithElementsToRemove size = 0) not.
	self collectionWithElementsToRemove do: [ :each | self assert: (self nonEmpty includes: each) ].
	self elementToAdd.
	self deny: (self nonEmpty includes: self elementToAdd).
	self collectionNotIncluded.
	self collectionNotIncluded do: [ :each | self deny: (self nonEmpty includes: each) ]! !

!HeapTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 3/20/2009 13:37'!
element
	^ element! !

!HeapTest methodsFor: 'basic tests' stamp: 'stephane.ducasse 5/20/2009 18:11'!
testHeap
	"self run: #testHeap"

	| heap | 
	heap := Heap new.
	self assert: heap isHeap.
	
	self assert: heap isEmpty.
	heap add: 1.
	self assert: heap isEmpty not
	
! !

!HeapTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 3/18/2009 15:08'!
otherCollection
	^ otherCollection! !

!HeapTest methodsFor: 'tests - remove' stamp: ''!
testRemoveAllSuchThat
	"self debug: #testRemoveElementThatExists"
	| el aSubCollection |
	el := self nonEmptyWithoutEqualElements anyOne.
	aSubCollection := self nonEmptyWithoutEqualElements copyWithout: el.
	self nonEmptyWithoutEqualElements removeAllSuchThat: [ :each | aSubCollection includes: each ].
	self assert: self nonEmptyWithoutEqualElements size = 1.
	self nonEmptyWithoutEqualElements do: [ :each | self assert: each = el ]! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 10:35'!
indexInNonEmpty
" return an index between bounds of 'nonEmpty' "

	^2! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 10:01'!
collectionWithNonIdentitySameAtEndAndBegining
	" return a collection with elements at end and begining equals only with classic equality (they are not the same object).
(others elements of the collection are not equal to those elements)"
	^ sameAtEndAndBegining ! !

!HeapTest methodsFor: 'test - remove' stamp: ''!
testRemoveElementThatExistsTwice
	"self debug: #testRemoveElementThatDoesExistsTwice"

	| size |
	size := self nonEmpty size.
	self assert: (self nonEmpty includes: self elementTwiceIn).
	self nonEmpty remove: self elementTwiceIn.
	self assert: size - 1 = self nonEmpty size.
	
	self assert: (self nonEmpty includes: self elementTwiceIn).
	self nonEmpty remove: self elementTwiceIn.
	self assert: size - 2 = self nonEmpty size! !

!HeapTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 12/18/2009 12:05'!
result
	^ collectResult.! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 15:44'!
collectionWithCopyNonIdentical
	" return a collection that include elements for which 'copy' return a different object (this is not the case of SmallInteger)"
	^ floatCollection ! !

!HeapTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedCollection

	| aCollection result |
	aCollection := self collectionWithSortableElements .
	result := aCollection asSortedCollection.
	
	self assert: (result class includesBehavior: SortedCollection).
	result do: 
		[ :each | 
		self assert: (aCollection occurrencesOf: each) = (result occurrencesOf: each) ].
	
	self assert: result size = aCollection size.! !

!HeapTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWithout
	"self debug: #testCopyEmptyWithout"
	| res |
	res := self empty copyWithout: self elementToAdd.
	self assert: res size = self empty size.
	self deny: (res includes: self elementToAdd)! !

!HeapTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testExamples
	self heapExample.
	self heapSortExample! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 10:42'!
collectionClass
" return the class to be used to create instances of the class tested"
	^ Heap! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 10:11'!
nonEmpty1Element
" return a collection of size 1 including one element"
	^ nonEmpty1Element ! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 10:53'!
nonEmptyWithoutEqualElements
" return a collection without equal elements "
	^ nonEmpty5ElementsWithoutDuplicate ! !

!HeapTest methodsFor: 'tests - set arithmetic' stamp: ''!
testUnion
	"self debug: #testUnionOfEmpties"
	
	| union |
	union := self empty union: self nonEmpty.
	self containsAll: union of: self empty andOf: self nonEmpty.
	union := self nonEmpty union: self empty.
	self containsAll: union of: self empty andOf: self nonEmpty.
	union := self collection union: self nonEmpty.
	self containsAll: union of: self collection andOf: self nonEmpty.! !

!HeapTest methodsFor: 'examples' stamp: 'md 2/12/2006 15:33'!
heapExample	"HeapTest new heapExample"
	"Create a sorted collection of numbers, remove the elements
	sequentially and add new objects randomly.
	Note: This is the kind of benchmark a heap is designed for."
	| n rnd array time sorted |
	n := 5000. "# of elements to sort"
	rnd := Random new.
	array := (1 to: n) collect:[:i| rnd next].
	"First, the heap version"
	time := Time millisecondsToRun:[
		sorted := Heap withAll: array.
		1 to: n do:[:i| 
			sorted removeFirst.
			sorted add: rnd next].
	].
	Transcript cr; show:'Time for Heap: ', time printString,' msecs'.
	"The quicksort version"
	time := Time millisecondsToRun:[
		sorted := SortedCollection withAll: array.
		1 to: n do:[:i| 
			sorted removeFirst.
			sorted add: rnd next].
	].
	Transcript cr; show:'Time for SortedCollection: ', time printString,' msecs'.
! !

!HeapTest methodsFor: 'basic tests' stamp: 'stephane.ducasse 5/20/2009 18:11'!
testDo
	"self run: #testDo" 

	| heap coll |
	heap := Heap withAll: #(1 3 5).
	coll := OrderedCollection new.
	
	heap do: [:each | coll add: each].
	
	self assert: coll = #(1 3 5) asOrderedCollection.
! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/4/2009 10:13'!
subCollectionNotIn
" return a collection for which at least one element is not included in 'moreThan4Elements' "
	^ collectionNotIncluded ! !

!HeapTest methodsFor: 'tests - as identity set' stamp: ''!
testAsIdentitySetWithoutIdentityEqualsElements
	| result collection |
	collection := self collectionWithCopy.
	result := collection asIdentitySet.
	" no elements should have been removed as no elements are equels with Identity equality"
	self assert: result size = collection size.
	collection do: 
		[ :each | 
		(collection occurrencesOf: each) = (result asOrderedCollection occurrencesOf: each) ].
	self assert: result class = IdentitySet! !

!HeapTest methodsFor: 'tests - copy' stamp: ''!
testCopySameClass
	"self debug: #testCopySameClass"
	"A copy of a collection should always be of the same class as the instance it copies"
	
	| copy | 
	copy := self empty copy.
	self assert: copy class == self empty class.! !

!HeapTest methodsFor: 'test - creation' stamp: ''!
testWithWithWithWith
	"self debug: #testWithWithWithWith"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom: 1 to: 4.
	aCol := self collectionClass with: (collection at:1) with: ( collection at:2 ) with: ( collection at: 3) with: ( collection at: 4).

	1 to: 3 do: [ :i | self assert: ( aCol occurrencesOf: ( collection at: i ) ) = ( collection occurrencesOf: ( collection at: i ) ) ].! !

!HeapTest methodsFor: 'tests - as identity set' stamp: ''!
testAsIdentitySetWithIdentityEqualsElements
	| result |
	result := self collectionWithIdentical asIdentitySet.
	" Only one element should have been removed as two elements are equals with Identity equality"
	self assert: result size = (self collectionWithIdentical size - 1).
	self collectionWithIdentical do: 
		[ :each | 
		(self collectionWithIdentical occurrencesOf: each) > 1 
			ifTrue: 
				[ "the two elements equals only with classic equality shouldn't 'have been removed"
				self assert: (result asOrderedCollection occurrencesOf: each) = 1
				" the other elements are still here" ]
			ifFalse: [ self assert: (result asOrderedCollection occurrencesOf: each) = 1 ] ].
	self assert: result class = IdentitySet! !

!HeapTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 3/20/2009 11:26'!
speciesClass
	
	^ speciesClass! !

!HeapTest methodsFor: 'tests - set arithmetic' stamp: ''!
containsAll: union of: one andOf: another
			
	self assert: (one allSatisfy: [:each | union includes: each]).
	self assert: (another allSatisfy: [:each | union includes: each])! !

!HeapTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureAsSetForIdentityMultiplinessTest
	"a collection (of elements for which copy is not identical ) without equal elements:"

	| anElement res |
	self elementsCopyNonIdenticalWithoutEqualElements.
	anElement := self elementsCopyNonIdenticalWithoutEqualElements anyOne.
	self deny: anElement copy == anElement.
	res := true.
	self elementsCopyNonIdenticalWithoutEqualElements
		detect: [ :each | (self elementsCopyNonIdenticalWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false! !

!HeapTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 3/20/2009 11:19'!
expectedElementByDetect
	"Returns the first even element of #collection"
	^ expectedElementByDetect.
	
	! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 11:09'!
replacementCollectionSameSize
" return a collection of size (secondIndex - firstIndex + 1)"
	^subCollection ! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/4/2009 10:15'!
elementNotIn
	^ elementNotIn ! !

!HeapTest methodsFor: 'running' stamp: 'cyrille.delaunay 12/18/2009 13:07'!
setUp
	element := 33.
	elementNotIn := 666.
	elementTwiceIn := 3.
	expectedSizeAfterReject := 1.
	expectedElementByDetect := -2.
	nonEmpty5ElementsWithoutDuplicate := Heap
		new 
		add: 2;
		add: 98;
		add: 4;
		add: 25;
		add: 1;
		yourself.
	collectionWithElement := Heap new.
	{  4. 5. 6. 2. 1. 1. (self element)  } do: [ :nb | collectionWithElement add: nb ].
	collectionWith4Elements := Heap
		new
		add: 1;
		add: -2;
		add: 3;
		add: 1;
		yourself.
	otherCollection := Heap new
		add: 1;
		add: 20;
		add: 30;
		yourself.
	empty := Heap new.
	nonEmpty := Heap
		new
		add: self valuePutIn;
		add: self element;
		add: self elementTwiceIn;
		add: self elementTwiceIn;
		yourself.
	collectionNotIncluded := Heap new
		add: elementNotIn;
		add: elementNotIn;
		yourself.
	doWithoutNumber := 3.
	collectResult := collectionWith4Elements collect: [ :each | each + 1 ].
	speciesClass := Heap.
	sameAtEndAndBegining := Heap new add: 1.5 ;  add: 1.5 copy ; yourself.
	nonEmpty1Element := Heap new add: 5 ; yourself.
	floatCollection := Heap new add: 2.5 ; add: 5.5 ; add:4.2 ; yourself.
	indexArray := #( 1 3).
	subCollection := Heap new.
	duplicateElement := 1.
	collectionWithDuplicateElement := Heap new add: duplicateElement ; add: duplicateElement ; add:4 ; yourself.
	self firstIndex to: self secondIndex do: [:each | subCollection add: elementNotIn  ].		
! !

!HeapTest methodsFor: 'tests - growable' stamp: ''!
testAddEmptyGrows
	"self debug: #testAddEmptyGrows"
	
	| oldSize |
	oldSize := self empty size.
	self empty add: self element.
	self assert: (self empty size) = (oldSize + 1).! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 10:07'!
moreThan3Elements
	" return a collection including atLeast 3 elements"
	^ nonEmpty5ElementsWithoutDuplicate ! !

!HeapTest methodsFor: 'test - creation' stamp: ''!
testWithWithWithWithWith
	"self debug: #testWithWithWithWithWith"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom: 1 to: 5 .
	aCol := self collectionClass with: (collection at:1) with: ( collection at:2 ) with: ( collection at: 3) with: (collection at: 4 ) with: ( collection at: 5 ).

	1 to: 3 do: [ :i | self assert: ( aCol occurrencesOf: ( collection at: i ) ) = ( collection occurrencesOf: ( collection at: i ) ) ].! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/4/2009 10:11'!
elementNotInForElementAccessing
" return an element not included in 'moreThan4Elements' "
	^ elementNotIn ! !

!HeapTest methodsFor: 'tests - as set tests' stamp: ''!
testAsSetWithEqualsElements
	| result |
	result := self withEqualElements asSet.
	self withEqualElements do: [ :each | self assert: (result occurrencesOf: each) = 1 ].
	self assert: result class = Set! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 10:44'!
nonEmptyMoreThan1Element
" return a collection that don't includes equal elements'" 
	^nonEmpty5ElementsWithoutDuplicate .! !

!HeapTest methodsFor: 'tests - converting' stamp: ''!
testAsBag

	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: Bag! !

!HeapTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAllNoneThere
	"self debug: #testIncludesAllOfNoneThere'"
	self deny: (self empty includesAll: self nonEmpty ).
	self deny: (self nonEmpty includesAll: { self elementNotIn. self anotherElementNotIn })! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 10:39'!
indexInForCollectionWithoutDuplicates
" return an index between 'collectionWithoutEqualsElements'  bounds"
	^ 2! !

!HeapTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureConverAsSortedTest
	self collectionWithSortableElements.
	self deny: self collectionWithSortableElements isEmpty! !

!HeapTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWith
	"self debug: #testCopyWith"
	| res anElement |
	anElement := self elementToAdd.
	res := self empty copyWith: anElement.
	self assert: res size = (self empty size + 1).
	self assert: (res includes: (anElement value))! !

!HeapTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 11:01'!
collectionWith5Elements
" return a collection of size 5 including 5 elements"
^ nonEmpty5ElementsWithoutDuplicate ! !

!HeapTest methodsFor: 'tests - remove' stamp: ''!
testRemoveAllError
	"self debug: #testRemoveElementThatExists"
	| el aSubCollection |
	el := self elementNotIn.
	aSubCollection := self nonEmptyWithoutEqualElements copyWith: el.
	self 
		should: [ | res | res := self nonEmptyWithoutEqualElements removeAll: aSubCollection ]
		raise: Error! !

!HelpAPIDocumentation commentStamp: 'tbn 4/30/2010 15:12'!
This class represents the browsable package API help for the help system.

Instance Variables
!
!HelpAPIDocumentation class methodsFor: 'accessing' stamp: 'tbn 3/29/2010 14:50'!
bookName
	^'API Documentation'! !

!HelpAPIDocumentation class methodsFor: 'defaults' stamp: 'tbn 3/11/2010 23:57'!
builder
	^PackageAPIHelpBuilder! !

!HelpAPIDocumentation class methodsFor: 'accessing' stamp: 'StephanEggermont 12/9/2013 19:59'!
helpPackages
	^#('HelpSystem-Core-Model' 'HelpSystem-Core-Utilities' 'HelpSystem-Core-UI')! !

!HelpBrowser commentStamp: 'tbn 3/8/2010 09:33'!
A HelpBrowser is used to display a hierarchy of help topics and their contents.

Instance Variables
	rootTopic: 		<HelpTopic>
	window:			<StandardWindow>	 
	treeMorph:		<PluggableTreeMorph>
	contentMorph:		<Morph>			

rootTopic
	- xxxxx

window
	- xxxxx

treeMorph 
	- xxxxx

contentMorph 
	- xxxxx

!
!HelpBrowser methodsFor: 'ui' stamp: 'SvenVanCaekenberghe 4/30/2014 15:30'!
shoutMorphFillMenu: aMenu
	^ aMenu addAllFrom: self menu! !

!HelpBrowser methodsFor: 'ui' stamp: 'tbn 2/12/2010 12:57'!
close
	window notNil ifTrue: [window delete]! !

!HelpBrowser methodsFor: 'accessing' stamp: 'tbn 3/6/2010 00:11'!
rootTopic: aHelpTopic

	rootTopic := aHelpTopic. 
	self refresh ! !

!HelpBrowser methodsFor: 'ui' stamp: 'SvenVanCaekenberghe 3/27/2015 13:46'!
menu
	^ MenuMorph new
		add: 'do it (d)' selector: #doIt;
		add: 'print it (p)' selector: #printIt;
		add: 'inspect it (p)' selector: #inspectIt;
		yourself! !

!HelpBrowser methodsFor: 'defaults' stamp: 'tbn 4/30/2010 12:39'!
defaultViewerClass	 
	^PluggableTextMorph! !

!HelpBrowser methodsFor: 'actions' stamp: 'SvenVanCaekenberghe 4/30/2014 15:02'!
next
	treeMorph setSelectionIndex: treeMorph getSelectionIndex + 1! !

!HelpBrowser methodsFor: 'actions' stamp: 'AlexandreBergel 4/29/2011 21:05'!
refresh
	| helpTopic items |
	helpTopic := self helpTopic.
	window setLabel: helpTopic title.
	items := helpTopic subtopics collect: [ :each | HelpTopicListItemWrapper with: each ].
	treeMorph list: items.
	contentMorph setText: helpTopic contents! !

!HelpBrowser methodsFor: 'ui' stamp: 'SvenVanCaekenberghe 4/30/2014 15:30'!
initWindow 
	| toolbar dock|
	window := (Smalltalk at: #StandardWindow) new.
	window model: self.
	
	window title: 'Help Browser'.
	toolbar := window newToolbar: {window
			newButtonFor: self
			getState: nil
			action: #refresh
			arguments: nil
			getEnabled: nil
			labelForm: (HelpIcons iconNamed: #refreshIcon)
			help: 'Refresh' translated.
			}.
			
	dock := window newToolDockingBar.	
	dock addMorphBack: toolbar.
	window
			addMorph: dock
			fullFrame: ( (0@0 corner: 1@0) asLayoutFrame bottomOffset: dock minExtent y).
	"Tree"
	treeMorph := PluggableTreeMorph new.
	treeMorph model: self; setSelectedSelector: #onItemClicked:.
	window 
		addMorph: treeMorph 
		fullFrame: ((0@0 corner: 0.3@1) asLayoutFrame topOffset: dock minExtent y).

	"Text"
	contentMorph := self defaultViewerClass on: self 
			text: nil accept: nil
			readSelection: nil menu: #shoutMorphFillMenu:.
	window 
		addMorph: contentMorph 
		fullFrame: ((0.3@0 corner: 1@1) asLayoutFrame topOffset: dock minExtent y).
	 	! !

!HelpBrowser methodsFor: 'initialization' stamp: 'tbn 3/5/2010 23:39'!
initialize 
	super initialize. 
	self initWindow.
 ! !

!HelpBrowser methodsFor: 'accessing' stamp: 'tbn 3/5/2010 22:56'!
rootTopic
	^rootTopic! !

!HelpBrowser methodsFor: 'ui' stamp: 'tbn 3/3/2010 23:32'!
open	
 	"Open the receivers window" 

	self refresh.	
	window openInWorld.
	 ! !

!HelpBrowser methodsFor: 'events' stamp: 'SvenVanCaekenberghe 4/30/2014 15:08'!
onItemClicked: anItem
	anItem ifNil: [ ^ contentMorph setText: rootTopic asHelpTopic contents ].
	contentMorph setText: anItem contents.
	contentMorph setSelection: (1 to: 0)! !

!HelpBrowser methodsFor: 'actions' stamp: 'AlexandreBergel 4/29/2011 21:05'!
helpTopic
	^ helpTopicCache ifNil: [ helpTopicCache := rootTopic asHelpTopic ]! !

!HelpBrowser methodsFor: 'actions' stamp: 'SvenVanCaekenberghe 4/30/2014 15:03'!
previous
	treeMorph setSelectionIndex: (treeMorph getSelectionIndex - 1 max: 1)! !

!HelpBrowser methodsFor: '*Shout-Styling' stamp: 'AlainPantec 2/23/2012 08:30'!
shoutAboutToStyle: aPluggableShoutMorphOrView 
	^ (self rootTopic respondsTo: #canHaveSyntaxHighlighting)
				and: [self rootTopic canHaveSyntaxHighlighting]! !

!HelpBrowser class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'tbn 5/20/2010 11:47'!
taskbarIcon
	"Answer the icon for the receiver in a task bar."

	^HelpIcons iconNamed: #bookIcon! !

!HelpBrowser class methodsFor: 'accessing' stamp: 'ClementBera 7/26/2013 16:17'!
defaultHelpBrowser
	^ DefaultHelpBrowser ifNil: [DefaultHelpBrowser := self]
	! !

!HelpBrowser class methodsFor: 'world menu' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
menuCommandOn: aBuilder 
	<worldMenu> 
	(aBuilder item: #'Help Browser')
		parent: #Help;
		action: [self open]; 
		icon: Smalltalk ui icons smallHelpIcon! !

!HelpBrowser class methodsFor: 'instance creation' stamp: 'tbn 9/20/2010 09:36'!
openOn: aHelpTopic
	"Open the receiver on the given help topic or any other object that can be transformed into
	 a help topic by sending #asHelpTopic."
	
	^(self defaultHelpBrowser new)
		rootTopic: aHelpTopic;
		open;
		yourself! !

!HelpBrowser class methodsFor: 'instance creation' stamp: 'tbn 5/3/2010 18:37'!
open
	^self openOn: SystemHelp! !

!HelpBrowser class methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
theme
	^ Smalltalk ui theme ! !

!HelpBrowser class methodsFor: 'accessing' stamp: 'tbn 5/3/2010 18:42'!
defaultHelpBrowser: aClass
	"Use a new help browser implementation"
	
	DefaultHelpBrowser := aClass
	! !

!HelpBrowserTest commentStamp: 'TorstenBergmann 2/4/2014 21:18'!
SUnit tests for the help browser!
!HelpBrowserTest methodsFor: 'testing' stamp: 'tbn 5/3/2010 20:22'!
testDefaultHelpBrowser
	
	| current replacement instance |
	current := self defaultTestClass defaultHelpBrowser.
	replacement := AdvancedHelpBrowserDummy.
	[
	  self defaultTestClass defaultHelpBrowser: replacement.
	  self assert: self defaultTestClass defaultHelpBrowser == replacement.
 
	  instance := self defaultTestClass open.
	  self assert: instance rootTopic notNil.
	  self assert: instance isOpen.
	] ensure: [ self defaultTestClass defaultHelpBrowser: current ]
	 ! !

!HelpBrowserTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:33'!
testOpen
	|browser|
	browser := self defaultTestClass open.
	World doOneCycleNow. 
	browser close 


		! !

!HelpBrowserTest methodsFor: 'accessing' stamp: 'tbn 5/3/2010 19:35'!
defaultTestClass
	^HelpBrowser! !

!HelpBrowserTest methodsFor: 'testing' stamp: 'tbn 5/3/2010 19:28'!
testDefaultHelpBrowserIsReplacable
	
	| current replacement instance |
	"save the one that is registered"
	current := self defaultTestClass defaultHelpBrowser.
	replacement := AdvancedHelpBrowserDummy.
	[
	  self defaultTestClass defaultHelpBrowser: replacement.
	  self assert: self defaultTestClass defaultHelpBrowser == replacement.	  
	  instance := self defaultTestClass open.
	  
	] ensure: [
		self defaultTestClass defaultHelpBrowser: current
	]
	 ! !

!HelpBrowserTest methodsFor: 'testing' stamp: 'tbn 5/3/2010 18:43'!
testLazyDefaultHelpBrowser
	
	self assert: self defaultTestClass defaultHelpBrowser notNil! !

!HelpBuilder commentStamp: 'tbn 2/12/2010 14:54'!
This is an utility class that builds the books for a help system.

Instance Variables
	rootTopics:		<OrderedCollection>

rootTopics
	- a collection of books 
!
!HelpBuilder methodsFor: 'initialization' stamp: 'tbn 3/5/2010 23:12'!
initialize 
	"Initializes the receiver"
	
	super initialize.
	topicToBuild := self topicClass new.
	 ! !

!HelpBuilder methodsFor: 'accessing' stamp: 'tbn 2/12/2010 14:53'!
rootToBuildFrom: anObject
	rootToBuildFrom := anObject! !

!HelpBuilder methodsFor: 'building' stamp: 'tbn 3/3/2010 22:55'!
build
	self subclassResponsibility 
! !

!HelpBuilder methodsFor: 'accessing' stamp: 'tbn 3/5/2010 23:15'!
topicToBuild
	^topicToBuild! !

!HelpBuilder methodsFor: 'private accessing' stamp: 'tbn 3/5/2010 23:13'!
topicClass
	^HelpTopic! !

!HelpBuilder class methodsFor: 'building' stamp: 'tbn 3/5/2010 23:25'!
buildHelpTopicFrom: aHelpTopicDescription
	"Start building from the given help topic description"
	
	^(self new)
		rootToBuildFrom: aHelpTopicDescription;
		build;
		topicToBuild ! !

!HelpHowToHelpTopics commentStamp: 'TorstenBergmann 2/4/2014 21:17'!
Explains help topics!
!HelpHowToHelpTopics class methodsFor: 'accessing' stamp: 'tbn 3/29/2010 14:47'!
bookName
	^'Implementation'! !

!HelpHowToHelpTopics class methodsFor: 'accessing' stamp: 'tbn 3/29/2010 19:21'!
pages
	^#(overview page1 page2 page3 page4 page5)! !

!HelpHowToHelpTopics class methodsFor: 'pages' stamp: 'tbn 3/29/2010 15:01'!
page4
	^HelpTopic 
		title: '4. Own help objects'
		contents:	
	'You can open this help browser directly on an instance of HelpTopic, but it is more common to open it on any object that understands the message #asHelpTopic.

So you can write for instance:

   HelpBrowser openOn: Integer

opening a short API help/system reference on the Integer class.
The above expression is the short form for:

   HelpBrowser openOn: (SystemReference forClass: Integer)

If you want you can include the subclasses:

   HelpBrowser openOn: (SystemReference hierarchyFor: Integer)

or even methods

   HelpBrowser openOn: (SystemReference hierarchyWithMethodsFor: Integer)

You can browse the whole system reference documentation using:

    HelpBrowser openOn: SystemReference

But these are only a few examples what we can extract from the 
system. 

However - the major goal is NOT an API browser, the idea is to 
provide a simple architecture to provide browsable help contents 
depending on the context. For instance it should also be possible
to use the help system to provide end user help on any commercial
application that is written with the Smalltalk system.


' ! !

!HelpHowToHelpTopics class methodsFor: 'pages' stamp: 'tbn 3/29/2010 19:23'!
page5
	^HelpTopic 
		title: '5. Help sources'
		contents:	
	'Since the underlying model is very simple you can easily fill it with nearly any information from different sources. Try this:

|topic day url sub|
topic := HelpTopic named: ''Last week on Squeak IRC''.
0 to: 7 do: [:index |
	day := (Date today subtractDays: index) printFormat: #(3 2 1 $. 1 2 2).
	url := ''http://tunes.org/~nef/logs/squeak/'' , day.
	sub := HelpTopic 
			title: day contents: (HTTPLoader default retrieveContentsFor: url) contents.
	topic addSubtopic: sub.
].
HelpBrowser openOn: topic

 
 

' ! !

!HelpHowToHelpTopics class methodsFor: 'pages' stamp: 'tbn 3/29/2010 14:10'!
page3
	^HelpTopic 
		title: '3. Adding icons'
		contents: 'If you dont like the default icon you can add own custom icons to the topics. See the class HelpIcons for more details.
		
		|root sub1 sub2|
		root := HelpTopic 
			title: ''My first topic''
			contents: ''A simple topic of interest''.		
		sub1 := HelpTopic 
			title: ''My first subtopic''
			contents: ''First subsection''.		
		sub2 := HelpTopic 		     
			title: ''My second subtopic''
			 icon: (HelpIcons iconNamed: #packageIcon)
			contents: ''Second subsection''.		
		root 
			addSubtopic: sub1; 
			addSubtopic: sub2.
		HelpBrowser openOn: root
		
		'! !

!HelpHowToHelpTopics class methodsFor: 'pages' stamp: 'tbn 3/29/2010 14:03'!
page2
	^HelpTopic 
		title: '2. Forming a hierarchy'
		contents: 'To form a hierarchy we just have to add new subtopics on our root topic.
		
		|root sub1 sub2|
		root := HelpTopic 
			title: ''My first topic''
			contents: ''A simple topic of interest''.		
		sub1 := HelpTopic 
			title: ''My first subtopic''
			contents: ''First subsection''.		
		sub2 := HelpTopic 
			title: ''My second subtopic''
			contents: ''Second subsection''.		
		root 
			addSubtopic: sub1; 
			addSubtopic: sub2.
		HelpBrowser openOn: root
		
		'! !

!HelpHowToHelpTopics class methodsFor: 'pages' stamp: 'tbn 3/29/2010 14:59'!
overview
	^HelpTopic 
		title: 'Overview'
		contents:	
	'THE IMPLEMENTATION

The help system typically consists of help books including one or more pages. A book or page is therefore a "topic of interest"  providing contents for help to a user. A topic has a title and an icon and is able to have subtopics forming a hierarchy of topics. This simple model is reflected in the class HelpTopic.

Since this model forms a hierarchical structure of help topics there is a browser with a tree to display the help contents. This browser is implemented in class HelpBrowser.

You can open this browser programmatically using:

   HelpBrowser open
' ! !

!HelpHowToHelpTopics class methodsFor: 'pages' stamp: 'tbn 3/29/2010 14:03'!
page1
	^HelpTopic 
		title: '1. Simple help topics'
		contents: 'The help browser usually operates on a hierarchy of help topics with one help topic at the root level. Evaluate the following expression in a workspace to contruct a simple help topic and open it as a root topic in the help browser.
		
		|root|
		root := HelpTopic 
			title: ''My first topic''
			contents: ''A simple topic of interest''.					
		
		HelpBrowser openOn: root
		
		
Note that the help browser displays the contents of our topic in the right page and uses the topics title as the title for the help browser window.	
		'! !

!HelpHowToHelpTopicsFromCode commentStamp: 'TorstenBergmann 2/4/2014 21:17'!
How to create help topics from code!
!HelpHowToHelpTopicsFromCode class methodsFor: 'pages' stamp: 'tbn 9/30/2010 23:54'!
step7
	^HelpTopic
		title: 'Step 7 - Tips and Tricks'
		contents:
	'STEP 7 - TIPS AND TRICKS

Tip1:
          If you implement the #pages method you can also 
          use the name of a custom help class that should be 
          integrated between the specific pages:
 
              #pages
                   ^(firstPage MyAppTutorial secondPage)

Tip2:
          You can easily edit the help contents of a page by 
          using the #edit: message. For our example just evaluate:

			MyAppHelp edit: #firstPage
			
	     This will open a workspace with the help contents and 
	     when you accept it it will be saved back to the help 
	     method defining the topic.		  
		

'
! !

!HelpHowToHelpTopicsFromCode class methodsFor: 'pages' stamp: 'tbn 3/5/2010 21:36'!
step1
	^HelpTopic 
		title: 'Step 1 - Create a class for the book'
		contents:
		'STEP 1 - CREATE A CLASS FOR THE BOOK
		
There is a predefined class CustomHelp which you have to subclass for a custom help book to show up as a book in the Help browser:
	
  CustomHelp subclass: #MyAppHelp
    	instanceVariableNames: ''''
	  classVariableNames: ''''
	  poolDictionaries: ''''
	  category: ''MyApp-Help'' 

Class methods on this class can reflect pages and if you want to provide nested help books just subclass your own help class to form a hierarchy. Any new subclass of MyAppHelp will then be a new book in your hierarchy.

The class category used should end with "-Help" so it is easy to recognize that it includes the help support of your project.'
! !

!HelpHowToHelpTopicsFromCode class methodsFor: 'accessing' stamp: 'tbn 3/29/2010 14:06'!
bookName
	^'Custom help from code'! !

!HelpHowToHelpTopicsFromCode class methodsFor: 'pages' stamp: 'tbn 9/30/2010 23:48'!
step6
	^HelpTopic
		title: 'Step 6 - Add more structure'
		contents:
	'STEP 6 - ADD MORE STRUCTURE

If you add a new subclass to your custom help class and repeating step 2 to 4 you can
profide new substructures (subbooks) since the help books are mapped to the 
class hierarchy. Example:
 
MyAppHelp subclass: #MyAppTutorial
    	instanceVariableNames: ''''
	  classVariableNames: ''''
	  poolDictionaries: ''''
	  category: ''MyApp-Help'' 

then implement a #bookName, the pages and a #pages method as before on this new 
class and reopen the help browser. 		
'
! !

!HelpHowToHelpTopicsFromCode class methodsFor: 'pages' stamp: 'tbn 3/28/2010 22:56'!
step5
	^HelpTopic
		title: 'Step 5 - Test your help'
		contents:
	'STEP 5 - TEST YOUR HELP
	
By using 
      
       HelpBrowser open

 
'
! !

!HelpHowToHelpTopicsFromCode class methodsFor: 'accessing' stamp: 'tbn 9/30/2010 23:46'!
pages
	^#(overview step1 step2 step3 step4 step5 step6 step7)! !

!HelpHowToHelpTopicsFromCode class methodsFor: 'pages' stamp: 'tbn 3/5/2010 21:36'!
step2
	^HelpTopic
		title: 'Step 2 - Provide a book name'
		contents:
	'STEP 2 - PROVIDE A BOOK NAME
	
Now implement the class method #bookName to return the name of your help book.

   bookName
	    ^''My App help''
	
By implementing this method the system knows how you would like to name your book and uses the given string as a label in the HelpBrowser later.'
! !

!HelpHowToHelpTopicsFromCode class methodsFor: 'pages' stamp: 'tbn 3/29/2010 13:52'!
overview
	^HelpTopic
		title: 'Overview'
		contents:	
	'OVERVIEW
	
The help system allows you to provide own books and help texts. You can open the help browser on any object that is able to understand #asHelpTopic.

This method returns the root node of the displayed topic hierarchy:

      HelpBrowser openOn: myObject

Typically the object does not convert itself to a help topic structure, usually it dispatches to a builder (see HelpBuilder and subclasses) who does all this. 
	
A much more convenient and reproducable way is to implement custom help classes. This allows you to implement and manage your help texts using the standard development and code management tools. These custom help classes are subclasses of "CustomHelp" and are automatically included into the standard help browser. '! !

!HelpHowToHelpTopicsFromCode class methodsFor: 'pages' stamp: 'tbn 3/5/2010 21:41'!
step4
	^HelpTopic
		title: 'Step 4 - Defining the page order'
		contents:
	'STEP 4 - DEFINING THE PAGE ORDER 

By implementing the class method #pages you return a collection of method selectors to define the order in which the pages appear in your book: 

     pages
     	    ^#(firstPage secondPage)

'
! !

!HelpHowToHelpTopicsFromCode class methodsFor: 'pages' stamp: 'tbn 3/29/2010 13:41'!
step3
	^HelpTopic
		title: 'Step 3 - Implement pages using methods'
		contents:
	'STEP 3 - IMPLEMENT PAGES USING METHODS 

Implement a page by defining a method that returns an instance of HelpPage defining a page title and a help text displayed in the help browser. 

     firstPage
     	    ^HelpTopic
	           title: ''First Page'' 
                 contents: ''Hello world''

Define a new method for each page of your book. Please group the pages in a method category called "pages".
You can also define an icon for the specific page:

     secondPage
     	    ^HelpTopic
	           title: ''Second Page'' 
    	           icon: (HelpIcons iconNamed: #packageIcon)
                 contents: ''More to come''


Note: 
=====
Later we may add support for better help contents than just plain text (markup descriptions, active morphs, ...)  '
! !

!HelpIcons commentStamp: 'tbn 3/8/2010 09:29'!
This class is used to store help icons for the help browser. 

Typically one implements a method returning a 12x12 Form instance which
should not be called directly.

Since the class provides an internal icon cache (so the icons can be reused without 
creating too many new instances) the icons should be accessed using the #iconNamed: 
message with the method selector as argument.

To create a form from an icon file stored on disk you can use the following code:

   | image stream |
	image := ColorForm fromFileNamed: '/path/to/icon.png'.
	stream := WriteStream with: String new.
	image storeOn: stream.
	stream contents inspect.!
!HelpIcons class methodsFor: 'accessing' stamp: 'ClementBera 7/26/2013 16:17'!
icons
	^ Icons ifNil: [Icons := Dictionary new]! !

!HelpIcons class methodsFor: 'private icons' stamp: 'tbn 3/3/2010 00:47'!
refreshIcon
	^(Form
		extent: 16@16
		depth: 32
		fromArray: #( 0 0 0 0 0 0 0 895969127 526080859 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1884706390 4168710521 2288675434 271330348 0 0 0 0 0 0 0 0 0 828465505 2609087363 3615917702 4269439610 4285887861 4285624689 3899156584 1766607948 67569415 0 0 0 0 0 50529027 2306242166 4237069452 4286940549 4286611584 4286282619 4285887861 4285558896 4285229931 4268189543 2235514687 0 0 0 0 0 2590862701 4287598479 4287269514 4270097540 3329652342 3312217196 4285887861 4285558896 3345179491 1011567435 0 0 0 0 0 1263423054 4287532686 4287532686 3867378563 1096835168 0 1885166941 3681579120 1549227863 50923785 0 0 0 0 0 0 3061545851 4287795858 4236937866 811951461 0 0 641547581 137441585 0 0 0 0 0 0 0 34936085 4102720138 4287795858 3011016824 0 0 0 0 0 0 0 0 0 0 0 0 272317243 4287861651 4287795858 2489607268 0 0 0 0 0 0 0 0 68095759 0 0 0 204682035 4287730065 4287795858 2658432116 0 0 0 0 0 0 0 34014983 3965146967 4283979864 3125694030 0 0 3767044232 4287795858 3884287365 137244206 0 0 0 0 0 0 1129863256 4284769380 4284506208 2739423304 0 0 2189459584 4287795858 4287532686 2541123190 16843009 0 0 0 0 305805882 3597166696 4284703587 4250885983 910114623 0 0 273698896 3834218889 4287532686 4287335307 3094442353 1094532413 101255433 286199567 1582124365 3731318631 4284966759 4284703587 2689946965 0 0 0 0 879126118 3985082247 4287269514 4286940549 4286611584 4285624689 4285558896 4285624689 4285229931 4284966759 3227212635 220998700 0 0 0 0 0 509698401 2977659771 4286743170 4286545791 4286282619 4285887861 4285558896 4100417383 2170116441 103295016 0 0 0 0 0 0 0 0 575820370 1734895720 2121298032 2037017194 1448564567 255013683 0 0 0 0 0)
	offset: 0@0)! !

!HelpIcons class methodsFor: 'utilities' stamp: 'TorstenBergmann 3/6/2015 11:21'!
reset
	<script>
	
	Icons := nil
	 ! !

!HelpIcons class methodsFor: 'private icons' stamp: 'TorstenBergmann 3/6/2015 11:20'!
bookIcon
	^(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4288385385 4290755234 0 0 0 0 0 0 0 0 0 0 0 0 0 4288254059 4287348987 4287348987 4288253802 4290755234 0 0 0 0 0 0 0 0 0 0 4287925870 4287217401 4287282937 4287217401 4287217401 4287217401 4288056940 4290755234 0 0 0 0 0 0 0 4287597424 4287085559 4287085814 4287662961 4288057197 4287085558 4287085558 4287085559 4287085814 4287860078 4290755234 0 0 0 0 4287334516 4286888179 4286888179 4286677882 4294967295 4294967295 4288122733 4288385386 4286888179 4286888179 4286888179 4287597424 4290755234 0 0 4286940790 4286690544 4286690799 4286690543 4286283647 4286677882 4294967295 4294967295 4288122477 4286625007 4286625007 4287334771 4287348987 4287334772 0 4286677882 4286493164 4286492908 4286427628 4286492907 4286427627 4286427371 4286677882 4287203189 4286427628 4286493164 4287006582 4287282938 4287348987 4287006326 4287666075 4286481019 4286091173 4286229992 4286229992 4286229992 4286229992 4286295528 4286229992 4286229992 4286229992 4286743673 4287020021 4287151607 4284521179 4286743673 0 4292272358 4286415228 4286415484 4286091173 4286032612 4286032613 4286097893 4286032613 4286032612 4286415483 4286756592 4286888179 4284586456 4286481020 0 4286218110 4294967295 4294835967 4292272358 4287666075 4286152575 4286091173 4285900770 4285900770 4286152831 4286361834 4286559214 4284782545 4286152574 0 0 0 4285889921 4290231744 4294508031 4294179839 4292272358 4287666075 4285889921 4287469467 4286032613 4286229992 4285109705 4285890177 0 0 0 0 0 0 4285692804 4290231744 4293786111 4293523711 4292272358 4285627268 4285966563 4285305536 4285693060 0 0 0 0 0 0 0 0 0 4285430406 4290231744 4293261311 4285430150 4285567416 4285430405 0 0 0 0 0 0 0 0 0 0 0 0 4285298824 4285629335 4285298823 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: (0@0))! !

!HelpIcons class methodsFor: 'accessing' stamp: 'tbn 2/12/2010 15:54'!
iconNamed: aSymbol

	^self icons at: aSymbol ifAbsentPut: [self perform: aSymbol]! !

!HelpIcons class methodsFor: 'private icons' stamp: 'tbn 3/6/2010 01:23'!
packageIcon
	^(Form
	extent: 12@12
	depth: 32
	fromArray: #( 0 0 0 0 1075649821 3744937783 3208395836 807016986 0 0 0 0 0 0 537857807 2939368243 4283256141 4284045657 4284572001 4284111450 2671524924 269488144 0 0 0 2150575919 4014820685 4284111450 4284374622 4284769380 4285098345 4285295724 4286216826 4017057647 1883456323 0 1076505130 4283848278 4284769380 4284966759 4285624689 4285690482 4285887861 4286611584 4287269514 4287861651 4287269514 1074597133 1076965681 4283914071 4283848278 4285953654 4286216826 4286414205 4286940549 4287466893 4287335307 4286808963 4286743170 1074399754 1077163060 4284637794 4284045657 4284835173 4285887861 4287269514 4287335307 4286282619 4286216826 4286874756 4287006342 1074465547 1077294646 4284835173 4284703587 4285361517 4285624689 4286414205 4285624689 4286085240 4286677377 4287269514 4287401100 1074465547 1077426232 4285098345 4285032552 4286019447 4285822068 4286743170 4286348412 4286677377 4287203721 4287730065 4287795858 1074531340 1077492025 4285229931 4285427310 4286808963 4286216826 4287137928 4287072135 4287401100 4287795858 4288256409 4288190616 1074531340 269356558 2672051268 4285493103 4287598479 4286940549 4287532686 4287795858 4287993237 4288387995 4287006342 2404668500 268501249 0 0 1075912993 3479726184 4287598479 4287927444 4288453788 4287993237 2943118444 539371046 0 0 0 0 0 0 1615086660 4017781370 3749148535 1078347334 0 0 0 0)
	offset: 0@0)! !

!HelpIcons class methodsFor: 'private icons' stamp: 'tbn 2/12/2010 14:18'!
pageIcon
	^(Form
	extent: 12@12
	depth: 32
	fromArray: #( 0 221196079 1366981242 1366915449 1366915449 1366849656 1366783863 1128876361 33554432 0 0 0 0 726552142 4294309365 4294243572 4294111986 4294046193 4293914607 4292861919 2843705215 319885585 0 0 0 726551886 4294177779 4294111986 4293980400 4293914607 4293848814 4293717228 4292138196 3734147730 269619730 0 0 726486349 4294046193 4293980400 4293914607 4293783021 4293717228 4293585642 4293454056 4291085508 639705377 0 0 726420557 4293980400 4293848814 4293783021 4293651435 4293585642 4293519849 4293388263 4292993505 640034342 0 0 726420556 4293848814 4293717228 4293651435 4293585642 4293454056 4293388263 4293256677 4293190884 623322919 0 0 726354764 4293717228 4293651435 4293519849 4293454056 4293322470 4293256677 4293125091 4293059298 623257126 0 0 726354507 4293585642 4293519849 4293388263 4293322470 4293190884 4293125091 4293059298 4292993505 623191333 0 0 726288970 4293454056 4293388263 4293256677 4293190884 4293125091 4292993505 4292993505 4292993505 623191333 0 0 726223178 4293322470 4293256677 4293190884 4293059298 4292993505 4292993505 4292993505 4292993505 623191333 0 0 726223177 4293256677 4293125091 4293059298 4292993505 4292993505 4292993505 4292993505 4292993505 623191333 0 0 490092087 3080033685 3079967892 3079967892 3079967892 3079967892 3079967892 3079967892 3079967892 454629657 0)
	offset: 0@0)! !

!HelpIcons class methodsFor: 'private icons' stamp: 'tbn 3/3/2010 23:53'!
blankIcon
	^Form extent: 12 @ 1 depth:8! !

!HelpIconsTest commentStamp: 'TorstenBergmann 2/4/2014 21:19'!
SUnit tests for the icons used in the help system!
!HelpIconsTest methodsFor: 'testing' stamp: 'tbn 3/3/2010 00:50'!
testIconCaching
	 
	| first second |
	#(bookIcon pageIcon refreshIcon) do: [:iconSymbol |
		first := self defaultTestClass iconNamed: iconSymbol.
		second := self defaultTestClass iconNamed: iconSymbol.	
		self assert: first notNil.
		self assert: first == second.
	]
	! !

!HelpIconsTest methodsFor: 'accessing' stamp: 'tbn 2/12/2010 14:23'!
defaultTestClass 
	^HelpIcons! !

!HelpOnHelp commentStamp: 'tbn 2/12/2010 14:27'!
Welcome to Pharo Smalltalk Help System!
!HelpOnHelp class methodsFor: 'accessing' stamp: 'tbn 2/19/2010 14:21'!
bookName
	^'Help on Help'! !

!HelpOnHelp class methodsFor: 'accessing' stamp: 'tbn 10/1/2010 00:27'!
pages
	^#(introduction HelpHowToHelpTopics HelpAPIDocumentation)! !

!HelpOnHelp class methodsFor: 'pages' stamp: 'hjh 4/21/2010 16:59'!
introduction
	"This method was automatically generated. Edit it using:"
	"HelpOnHelp edit: #introduction"
	^HelpTopic
		title: 'Introduction'
		contents: 
'WELCOME TO THE HELP SYSTEM

The help system is a simple user interface to display help contents to the user. It can be accessed from the world menu using "Tools" -> "Help Browser" or by evaluating ''HelpBrowser open'' in a workspace.

There is a predefined mechanism allowing you to have help contents stored as source code using methods in specific help provider classes. This allows to manage the help texts using the standard development tools. But this is only one possible representation.

Yes, this is a good solution.
!!' readStream nextChunkText! !

!HelpOnHelp class methodsFor: 'accessing' stamp: 'tbn 3/5/2010 23:56'!
key
	^'HelpOnHelp'! !

!HelpTopic commentStamp: 'tbn 3/29/2010 14:53'!
A HelpTopic provides content information that can be used as a help to the user.
It can be labeled with a title, identified using an (optional) unique key and marked 
with an (optional) icon.

Help topics form a hierarchy since any topic is able to have zero or more
subtopics. 


Instance Variables
	contents:		<Object>      The help topic contents
	icon:			<Form|nil>	   An optional icon for the topic
	key:			<String|nil>    An optional unique key
	subtopics:	      <Collection>  A collection of subtopics
	title:			<String>        The title

contents
	- The help topic contents - typically containing the help topics information

icon
	- An optional icon for the topic

key
	- An optional unique key which can be used to identify the topic. 

subtopics
	- A collection of subtopics. 
	  By default the subtopics are not sorted, so the insertion order is used. 
	  If necessary it is possible to sort the subtopics by title.

title
	- A meaninful title for the help topic
!
!HelpTopic methodsFor: '*GT-SpotterExtensions-Core' stamp: 'AndreiChis 3/6/2015 14:31'!
spotterPreviewSubtopicsHelpIn: aComposite
	<spotterPreview: 15>

	aComposite list
		title: [ self title ];
		display: #yourself;
		format: [ :aHelpTopic | GTSpotterItemBrick new 
				text: aHelpTopic title;
				icon: aHelpTopic gtTopicIcon;
				disable ];
		styled: [ :brick | brick ];
		entity: self subtopics.
		
	self flag: 'move "entity: self" somewhere else, maybe'! !

!HelpTopic methodsFor: 'accessing' stamp: 'tbn 3/6/2010 00:20'!
key: aUniqueKey
	"Sets a unique key identifying the receiver in the help system"	
		
	key := aUniqueKey ! !

!HelpTopic methodsFor: 'operating' stamp: 'tbn 3/8/2010 09:12'!
sortSubtopicsByTitle
	"Sort the subtopics by title"
	
	subtopics := SortedCollection withAll: self subtopics  ! !

!HelpTopic methodsFor: '*GT-SpotterExtensions-Core' stamp: 'AndreiChis 3/6/2015 14:38'!
gtBreadcrumbTitle
	|breadcrumbTitle currentHelpTopic|
	
	currentHelpTopic := self.	
	breadcrumbTitle:= currentHelpTopic title.
	[ currentHelpTopic owner notNil and: [currentHelpTopic owner owner notNil ] ] whileTrue: [ 
		currentHelpTopic := currentHelpTopic owner.
		breadcrumbTitle := breadcrumbTitle , ' > ', currentHelpTopic title  ].
	^ breadcrumbTitle ! !

!HelpTopic methodsFor: '*GT-SpotterExtensions-Core' stamp: 'AndreiChis 3/6/2015 14:11'!
gtAllSubtopics
	 ^ self subtopics flatCollect: [:aTopic |
		aTopic asOrderedCollection, aTopic gtAllSubtopics ]
		 ! !

!HelpTopic methodsFor: 'initialization' stamp: 'tbn 3/8/2010 08:44'!
initialize 
	"Initializes the receiver"
	
	super initialize.
	self title: self defaultTitle.
	self contents: ''.
	self key: '' ! !

!HelpTopic methodsFor: 'accessing' stamp: 'tbn 3/6/2010 00:22'!
title
	"Returns the receivers title"
	
	^ title! !

!HelpTopic methodsFor: 'accessing' stamp: 'tbn 3/6/2010 00:22'!
title: anObject
	"Sets the receivers title"
	
	title := anObject! !

!HelpTopic methodsFor: '*GT-SpotterExtensions-Core' stamp: 'AndreiChis 3/6/2015 14:31'!
gtTopicIcon
	^ (HelpIcons iconNamed: (self hasSubtopics
		 ifTrue: [#bookIcon] 
	    ifFalse: [#pageIcon]))! !

!HelpTopic methodsFor: 'accessing' stamp: 'ClementBera 7/29/2013 15:06'!
subtopics 
	"Returns the receivers list of subtopics"
	
	^ subtopics ifNil: [subtopics := OrderedCollection new]! !

!HelpTopic methodsFor: 'accessing' stamp: 'tbn 3/6/2010 00:20'!
key 	
	"Returns a unique key identifying the receiver in the help system"	
		
	^key! !

!HelpTopic methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/22/2015 21:40'!
spotterForHelpTopicFor: aStep
	<spotterOrder: 200>
	self flag: 'filter for multiple items like #title + #contents (combined by OR)'.
	self flag: #specialFilter.
	aStep listProcessor 
		title: 'Help contents';
		items: [ self subtopics ];
		itemName: [ :helpTopic | helpTopic title ];
		itemIcon: [ :helpTopic | helpTopic gtTopicIcon ];
		itemFilterName: [ :helpTopic | helpTopic contents asString ]; " the filter should only scan the contents / maybe title too ? "
		filter: GTFilterSubstrings;
		wantsToDisplayOnEmptyQuery: true! !

!HelpTopic methodsFor: '*GT-Inspector' stamp: 'AndreiChis 3/6/2015 10:35'!
gtDisplayOn: stream
	^ stream nextPutAll: self title! !

!HelpTopic methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TorstenBergmann 3/6/2015 09:50'!
gtInspectorActionOpenHelpBrowser
	<gtInspectorAction>
	
	^ GLMGenericAction new
		action: [ HelpBrowser openOn: self ];
		icon: (HelpIcons iconNamed:#bookIcon);
		title: 'Browse'! !

!HelpTopic methodsFor: 'accessing' stamp: 'kilonalios 9/22/2013 17:31'!
addSubtopic: aTopic
	"Adds the given topic to the receivers collection of subtopics, and set this object as owner of the subtopic"
	
	self subtopics add: aTopic.
	aTopic owner: self.
	^aTopic! !

!HelpTopic methodsFor: 'testing' stamp: 'tbn 3/6/2010 00:23'!
hasSubtopics 
	"Returns true if the receiver has subtopics, false otherwise"
	
	^self subtopics notEmpty ! !

!HelpTopic methodsFor: 'conversion' stamp: 'tbn 3/8/2010 09:09'!
asHelpTopic 
	"Converts the receiver to a help topic"
	
	^self! !

!HelpTopic methodsFor: 'defaults' stamp: 'tbn 3/5/2010 21:31'!
defaultTitle
	"Returns the receivers default title"
	
	^'Unnamed Topic'
	! !

!HelpTopic methodsFor: 'accessing' stamp: 'tbn 3/6/2010 00:20'!
icon: aSymbol
	"Sets the receivers icon"
	
	icon := aSymbol ! !

!HelpTopic methodsFor: 'accessing' stamp: 'kilonalios 9/22/2013 17:30'!
owner
	"an ownder is a HelpTopic that uses the current HelptTopic as subtopic"
^ owner! !

!HelpTopic methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 3/6/2015 10:36'!
gtInspectorContentsIn: composite
	<gtInspectorPresentationOrder: 40>
	
	composite text
		title: 'Contents';
		display: [ self contents ];
		when: [ self contents notEmpty  ] ! !

!HelpTopic methodsFor: '*GT-SpotterExtensions-Core' stamp: 'AndreiChis 3/6/2015 12:58'!
spotterPreviewContentHelpIn: aComposite
	<spotterPreview: 10>
	
	self hasSubtopics ifTrue: [ ^ self ].
	aComposite text
		title: [ self title ];
		display: [:aHelpTopic | 
			aHelpTopic contents];
		entity: self.
		
	self flag: 'move "entity: self" somewhere else, maybe'! !

!HelpTopic methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 3/6/2015 10:28'!
gtInspectorSubtopicsIn: composite
	<gtInspectorPresentationOrder: 50>

	composite tree
		shouldValidate: false;
		title: 'Subtopics';
		display: [ self subtopics ];
		children: [ :each | each subtopics ];
		when: [ self hasSubtopics ];
		format: #title! !

!HelpTopic methodsFor: 'accessing' stamp: 'kilonalios 9/22/2013 17:43'!
subtopics: aCollection 
	"Sets the receivers subtopics"
	
	aCollection do: [ :topic|  topic owner: self  ].
	subtopics := aCollection.! !

!HelpTopic methodsFor: 'accessing' stamp: 'kilonalios 9/22/2013 17:56'!
owner: topic
	"an owner is a HelpTopic that uses the current HelptTopic as subtopic"
owner := topic! !

!HelpTopic methodsFor: 'accessing' stamp: 'tbn 3/6/2010 00:19'!
contents: anObject
	"Sets the receivers contents to the given object" 
		
	contents := anObject! !

!HelpTopic methodsFor: 'accessing' stamp: 'tbn 3/6/2010 00:19'!
contents
	"Returns the receivers contents"
	
	^ contents! !

!HelpTopic methodsFor: 'comparing' stamp: 'tbn 3/8/2010 09:11'!
<= anotherHelpTopic
	"Use sorting by title as the default sort order"
	
	^self title <= anotherHelpTopic title ! !

!HelpTopic methodsFor: 'accessing' stamp: 'tbn 3/6/2010 00:19'!
icon 
 	"Returns the receivers icon"
	
	^icon! !

!HelpTopic class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:00'!
gtExampleSingleTopic
	<gtExample>
	
	^ HelpTopic new
		title: 'ExampleTopic';
		contents: 'I am an example topic'
		! !

!HelpTopic class methodsFor: 'instance creation' stamp: 'tbn 3/29/2010 13:16'!
title: aTitle contents: aText
	"Create a new instance with given title and content"
	
	^(self new)
		title: aTitle;
		contents: aText;
		yourself.
		! !

!HelpTopic class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:01'!
gtExampleComposedTopic
	<gtExample>
	|rootTopic|
	
	rootTopic := HelpTopic new
		title: 'ExampleTopic';
		contents: 'I am an example topic'.
	rootTopic addSubtopic: (HelpTopic new
		title: 'Subtopic1';
		contents: 'I am an subtopic topic').
	rootTopic addSubtopic: (HelpTopic new
		title: 'Subtopic2').
		
	^ rootTopic
		! !

!HelpTopic class methodsFor: 'instance creation' stamp: 'tbn 3/29/2010 13:16'!
title: aTitle icon: anIcon contents: aText
	"Create a new instance with given title, icon and content"
	
	^(self new)
		title: aTitle;
		icon: anIcon;
		contents: aText;
		yourself.
		! !

!HelpTopic class methodsFor: 'instance creation' stamp: 'tbn 3/29/2010 13:16'!
named: aString
	"Create a new instance with given title and empty contents"
	
	^(self new)
		title: aString;
		yourself! !

!HelpTopicListItemWrapper commentStamp: 'tbn 3/8/2010 09:30'!
This class implements a list item wrapper for help topics.

Instance Variables
!
!HelpTopicListItemWrapper methodsFor: 'accessing' stamp: 'tbn 3/8/2010 17:25'!
asString
	"Returns a string used as a label"
	
	^item title! !

!HelpTopicListItemWrapper methodsFor: 'accessing' stamp: 'tbn 3/8/2010 17:26'!
balloonText
	"Returns a string used for fly by help"
	
	^self item title! !

!HelpTopicListItemWrapper methodsFor: 'accessing' stamp: 'tbn 3/8/2010 17:26'!
contents
	"Returns subnodes (if any)"
	
 	item hasSubtopics ifFalse: [^#()].	
	^(item subtopics) collect: [ :each | 
		HelpTopicListItemWrapper with: each
	].
! !

!HelpTopicListItemWrapper methodsFor: 'accessing' stamp: 'tbn 3/5/2010 22:55'!
icon
	"Either return the icon for the given topic"
	
	| symbol |
	item icon notNil ifTrue: [^item icon].
	symbol := item hasSubtopics 
					 ifTrue: [#bookIcon] 
			  		 ifFalse: [#pageIcon].
	^HelpIcons iconNamed: symbol! !

!HelpTopicListItemWrapperTest commentStamp: 'TorstenBergmann 2/4/2014 21:19'!
SUnit tests for class HelpTopicListItemWrapper!
!HelpTopicListItemWrapperTest methodsFor: 'testing' stamp: 'tbn 3/5/2010 21:46'!
testDisplayLabel
	|instance|
	instance := self defaultTestClass with: (HelpTopic named: 'My Topic').
	self assert: instance asString = 'My Topic'
	! !

!HelpTopicListItemWrapperTest methodsFor: 'accessing' stamp: 'tbn 2/12/2010 13:16'!
defaultTestClass 
	^HelpTopicListItemWrapper 
	! !

!HelpTopicTest commentStamp: 'TorstenBergmann 2/4/2014 21:19'!
SUnit tests for HelpTopic class!
!HelpTopicTest methodsFor: 'testing' stamp: 'tbn 3/6/2010 00:07'!
testInitialization

	self assert: topic title = 'Unnamed Topic'.
	self assert: topic key isEmpty.
	self assert: topic contents isEmpty ! !

!HelpTopicTest methodsFor: 'testing' stamp: 'tbn 3/6/2010 00:06'!
testInstanceCreation

	|instance|
	instance := self defaultTestClass named: 'My Topic'.
	self assert: instance title = 'My Topic'.
! !

!HelpTopicTest methodsFor: 'accessing' stamp: 'tbn 3/5/2010 21:47'!
defaultTestClass
	^HelpTopic ! !

!HelpTopicTest methodsFor: 'testing' stamp: 'kilonalios 9/22/2013 17:56'!
testSubtopicOwnership
"Test that when a subtopic is added to a topic then owner of the subtopic is the topic"
	|subtopic owner|
	owner := self defaultTestClass named:  'I am the owner'.
	subtopic := self defaultTestClass named: 'I am the subtopic'.
	
	owner addSubtopic: subtopic.
	
	self assert: (subtopic owner == owner).
! !

!HelpTopicTest methodsFor: 'testing' stamp: 'tbn 3/6/2010 00:06'!
testSortOrder

	|a b c sorted |
	a := self defaultTestClass named: 'A'.
	b := self defaultTestClass named: 'B'.
	c := self defaultTestClass named: 'C'.
	sorted := (OrderedCollection with: b with: c with: a) asSortedCollection.
	self assert: sorted first = a.
	self assert: sorted last = c.
	! !

!HelpTopicTest methodsFor: 'testing' stamp: 'tbn 3/8/2010 16:44'!
testAddingSubtopic

	|subtopic returned|
	subtopic := self defaultTestClass named: 'Subtopic'.
	returned := topic addSubtopic: subtopic.
	self assert: returned == subtopic.
	self assert: (topic subtopics includes: subtopic) ! !

!HelpTopicTest methodsFor: 'running' stamp: 'tbn 3/5/2010 21:49'!
setUp
	super setUp.
	topic := self defaultTestClass new.! !

!HiddenInstanceVariableSlot commentStamp: 'JurajKubelka 3/4/2015 20:15'!
I am a hidden instance variable.

I work just like any other ivar, but I am not shown when asking for the #slots of a class.

The idea is that virtual slots can use hidden non-virtual slots to store their state. Example are PropertySlot, BooleanSlot...!
!HiddenInstanceVariableSlot methodsFor: 'testing' stamp: 'MarcusDenker 1/26/2015 14:05'!
isVisible
	^ false! !

!HistoryCollection commentStamp: 'BenjaminVanRyseghem 3/17/2011 13:41'!
I'm a data structure used to store an history.

My behavior is
	- I store Associations (anElement -> anInteger), where anElement is the element to store and anInteger the number of times it has been added. (as a Dictionary)
	- I only store once each element (as a Set).
	- I have a max size. If I add an element and have reached the max size, I remove the less seen element.
	- I store element in the chronological order (as an OrderedCollection)!
!HistoryCollection methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 3/17/2011 13:49'!
size

	^ storage size! !

!HistoryCollection methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 3/17/2011 14:03'!
oldest

	^ storage last key! !

!HistoryCollection methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 3/17/2011 14:00'!
lessSeen

	| min |
	min := storage first.
	2 to: storage size do: [:index || each |
		each := storage at: index.
		(each value < min value)
			ifTrue: [ min := each]].
	^ min key! !

!HistoryCollection methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 3/17/2011 13:37'!
includes: anElement

	^ storage anySatisfy: [:association | association key = anElement ]! !

!HistoryCollection methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/17/2011 13:32'!
maxSize: anInteger

	maxSize := anInteger! !

!HistoryCollection methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 3/17/2011 13:47'!
initialize

	super initialize.
	maxSize := 5.
	storage := OrderedCollection new: maxSize.! !

!HistoryCollection methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 3/17/2011 13:38'!
identityIncludes: anElement

	^ storage anySatisfy: [:association | association key == anElement ]! !

!HistoryCollection methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 3/18/2011 15:33'!
elements
	
	^ storage collect: [:each | each key ]! !

!HistoryCollection methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 3/17/2011 13:43'!
at: anElement

	^ storage detect: [:each | each key = anElement]! !

!HistoryCollection methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 3/17/2011 13:37'!
add: anElement

	| count |
	count := 0.
	(self includes: anElement)
		ifTrue: [ | association |
			association := self remove: anElement.
			count := association value ].
	self size = self maxSize
		ifTrue: [	self removeLast ].

	^ storage addFirst: (anElement -> (count+1))! !

!HistoryCollection methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/17/2011 13:31'!
maxSize

	^ maxSize! !

!HistoryCollection methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 3/17/2011 14:05'!
mostSeen

	| max |
	max := storage first.
	2 to: storage size do: [:index || each |
		each := storage at: index.
		(each value > max value)
			ifTrue: [ max := each]].
	^ max key! !

!HistoryCollection methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 3/17/2011 13:49'!
remove: anElement

	| association |
	association := self at: anElement.
	^ storage remove: association.
	! !

!HistoryCollection methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 3/17/2011 13:54'!
removeLast
	" I remove the less seen one, in case of equality, I remove the latest one "


	| min reversedStorage |
	reversedStorage := storage reverse.
	min := reversedStorage first.
	2 to: storage size do: [:index || each |
		each := reversedStorage at: index.
		(each value < min value)
			ifTrue: [ min := each ]].
	storage remove: min! !

!HistoryCollection methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 3/17/2011 14:03'!
youngest

	^ storage first key! !

!HistoryCollection methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/14/2012 15:48'!
mostViewedElements
	
	^ (storage copy sort: [:a :b | a value >= b value]) collect: [:each | each key ]! !

!HistoryCollection class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 3/17/2011 13:47'!
maxSize: anInteger

	^ self new maxSize: anInteger! !

!HistoryIterator commentStamp: 'AlainPlantec 12/14/2010 23:40'!
A HistoryIterator holds an UndoRedoGroup in order to store an history of commands with the possibility of undoing and redoing. The iterator cursor is represented by the index inst var. Index always contains the position of the command that can be currently undone. So, undo decrease index and redo increase index. When a new record is stored, then, index contains the newly added record position.
See HistoryIteratorTest for examples.

Instance Variables
	index:		<Integer>
	maxSize:		<Integer>
	plugged:		<Boolean>
	recorder:		<UndoRedoGroup>

index
	- the iterator cursor

maxSize
	- the maximum number of records that can be added in the root group.

plugged
	- if false, then adding of command is not allowed. Useful to prevent bad history recording recurssions (record while undoing or redoing).

recorder
	- The root of the history tree which records undo/redo commands
!
!HistoryIterator methodsFor: 'accessing' stamp: 'AlainPlantec 12/14/2010 19:06'!
last
	^ self recorder last! !

!HistoryIterator methodsFor: 'accessing' stamp: 'AlainPlantec 12/14/2010 19:08'!
first
	^ self recorder first! !

!HistoryIterator methodsFor: 'accessing' stamp: 'AlainPlantec 12/14/2010 12:54'!
next
	"next item in history"
	^ self hasNext
		ifTrue: [ index := self index + 1.
			self current]! !

!HistoryIterator methodsFor: 'adding' stamp: 'AlainPlantec 12/14/2010 18:52'!
addItem: anHistoryItem
	| result |
	self isPlugged ifFalse: [^ false].
	self recorder removeLast: (self size - self index).
	result := self recorder addItem: anHistoryItem.
	self updateIndex.
	^ result! !

!HistoryIterator methodsFor: 'compatibility' stamp: 'AlainPlantec 12/14/2010 12:54'!
closeRecordGroup
	^ self closeGroup! !

!HistoryIterator methodsFor: 'accessing' stamp: 'AlainPlantec 12/14/2010 13:01'!
nextList
	"return 'next' items sublist "
	^ self recorder copyFrom: self index + 1 to: self size! !

!HistoryIterator methodsFor: 'accessing' stamp: 'AlainPlantec 12/14/2010 18:54'!
maxSize: anInteger
	maxSize := anInteger! !

!HistoryIterator methodsFor: 'undo-undo' stamp: 'AlainPlantec 12/14/2010 22:27'!
doAndAddRecord: anUndoRedoRecord
	| result |
	result := anUndoRedoRecord do.
	self addItem: anUndoRedoRecord.
	^ result! !

!HistoryIterator methodsFor: 'accessing' stamp: 'AlainPlantec 12/14/2010 14:37'!
recorder
	^ recorder ifNil: [recorder := UndoRedoGroup new]! !

!HistoryIterator methodsFor: 'undo-undo' stamp: 'AlainPlantec 12/14/2010 13:03'!
redo
	self unplugWhile: [
		self hasNext ifFalse: [^false].
		self next redo].
	^ true! !

!HistoryIterator methodsFor: 'removing' stamp: 'AlainPlantec 12/14/2010 19:58'!
removeAt: anIndex
	self recorder removeAt: anIndex! !

!HistoryIterator methodsFor: 'adding' stamp: 'AlainPlantec 12/14/2010 12:54'!
addRecord: anItem
	^ self addItem: anItem
! !

!HistoryIterator methodsFor: 'accessing' stamp: 'AlainPlantec 12/14/2010 19:03'!
at: anInteger
	^ self recorder at: anInteger! !

!HistoryIterator methodsFor: 'accessing' stamp: 'AlainPlantec 12/14/2010 18:46'!
maxSize
	^ maxSize ifNil: [maxSize := self defaultMaximumSize]! !

!HistoryIterator methodsFor: 'undo-undo' stamp: 'AlainPlantec 12/14/2010 12:54'!
unplugWhile: aBlock
	| wasPlugged |
	wasPlugged := self isPlugged.
	plugged := false.
	aBlock ensure: [ plugged := wasPlugged ]! !

!HistoryIterator methodsFor: 'accessing' stamp: 'AlainPlantec 12/14/2010 12:54'!
index
	^ index ifNil: [index := self size]! !

!HistoryIterator methodsFor: 'grouping' stamp: 'AlainPlantec 12/14/2010 18:52'!
openGroup
	self recorder openGroup.
	self updateIndex.
! !

!HistoryIterator methodsFor: 'grouping' stamp: 'MarcusDenker 5/31/2011 15:33'!
groupFrom: firstIdx to: secondIdx
	| group |
	group := UndoRedoGroup new.
	firstIdx to: (secondIdx min: index) do: [:i | group addItem: (self at:i)].
	group close.
	group 
		isEmpty ifTrue: [^ self].
	firstIdx + 1 to: (secondIdx min: index) do: [:i | self removeAt: i].
	self at: firstIdx put: group.
	index := index - group size + 1.! !

!HistoryIterator methodsFor: 'testing' stamp: 'AlainPlantec 12/14/2010 12:54'!
isPlugged
	^ plugged ifNil: [plugged := true]! !

!HistoryIterator methodsFor: 'accessing' stamp: 'AlainPlantec 12/14/2010 13:00'!
size
	^ self recorder size! !

!HistoryIterator methodsFor: 'testing' stamp: 'AlainPlantec 12/14/2010 12:58'!
hasNext
	"is there an item after current index"
	^ self recorder size - self index > 0! !

!HistoryIterator methodsFor: 'removing' stamp: 'AlainPlantec 12/14/2010 18:51'!
removeFirst
	self recorder removeFirst! !

!HistoryIterator methodsFor: 'compatibility' stamp: 'AlainPlantec 12/14/2010 12:54'!
openRecordGroup
	^ self openGroup! !

!HistoryIterator methodsFor: 'adding' stamp: 'AlainPlantec 12/14/2010 18:51'!
updateIndex
	self size <= self maxSize
		ifFalse: [self removeFirst].
	index := self size.
! !

!HistoryIterator methodsFor: 'accessing' stamp: 'AlainPlantec 12/14/2010 13:02'!
reset
	self recorder reset.
	index := nil.! !

!HistoryIterator methodsFor: 'undo-undo' stamp: 'AlainPlantec 12/14/2010 13:03'!
undo
	self unplugWhile: [
		self current ifNotNil: [:curr | curr undo].
		self previous].
	^ true! !

!HistoryIterator methodsFor: 'undo-undo' stamp: 'AlainPlantec 12/14/2010 22:28'!
redoArray: doArray undoArray: undoArray
	self addItem: (UndoRedoRecord redoArray: doArray undoArray: undoArray)! !

!HistoryIterator methodsFor: 'grouping' stamp: 'AlainPlantec 12/14/2010 14:33'!
closeGroup
	self recorder closeGroup
! !

!HistoryIterator methodsFor: 'accessing' stamp: 'AlainPlantec 12/14/2010 19:59'!
at: anInteger put: anItem
	self recorder at: anInteger put: anItem! !

!HistoryIterator methodsFor: 'undo-undo' stamp: 'AlainPlantec 12/14/2010 18:31'!
do
	^ self redo! !

!HistoryIterator methodsFor: 'testing' stamp: 'AlainPlantec 12/14/2010 12:54'!
hasPrevious
	"is there an item before current index"
	^ self index > 0! !

!HistoryIterator methodsFor: 'accessing' stamp: 'AlainPlantec 12/14/2010 12:54'!
previous
	"previous item in history"
	^ self hasPrevious
		ifTrue: [index := self index - 1.
			self current]! !

!HistoryIterator methodsFor: 'undo-undo' stamp: 'AlainPlantec 12/14/2010 22:27'!
redo: doMessageSend undo: undoMessageSend
	self addItem: (UndoRedoRecord redo: doMessageSend undo: undoMessageSend)! !

!HistoryIterator methodsFor: 'accessing' stamp: 'AlainPlantec 12/14/2010 13:01'!
previousList
	"return 'prev' items sublist"
	^ self recorder copyFrom: 1 to: self index - 1! !

!HistoryIterator methodsFor: 'accessing' stamp: 'AlainPlantec 12/14/2010 13:00'!
current
	^ (self index <= self size and: [self index > 0])
		ifTrue: [self recorder at: self index]! !

!HistoryIterator methodsFor: 'accessing' stamp: 'AlainPlantec 12/14/2010 18:49'!
defaultMaximumSize
	"unlimited by default"
	^ 999999999! !

!HistoryIteratorTest methodsFor: 'testing' stamp: 'AlainPlantec 12/14/2010 23:42'!
testUndo2

	| aCollection |
	aCollection := OrderedCollection newFrom: {1. 2. 3}.

	historyList doAndAddRecord: (
		UndoRedoRecord
			do: (MessageSend receiver: aCollection selector: #removeLast )
			undo: (MessageSend receiver: aCollection selector: #addLast: argument: aCollection last)).

	historyList undo.

	self assert: aCollection size = 3.	
	self assert: aCollection last = 3.! !

!HistoryIteratorTest methodsFor: 'testing' stamp: 'AlainPlantec 12/14/2010 23:01'!
testUndo1

	| aCollection |
	aCollection := OrderedCollection new.

	historyList doAndAddRecord: (
		UndoRedoRecord
			do: (MessageSend receiver: aCollection selector: #addLast: argument: 1)
			undo: (MessageSend receiver: aCollection selector: #removeLast)).

	historyList undo.

	self assert: aCollection size = 0.! !

!HistoryIteratorTest methodsFor: 'testing' stamp: 'AlainPlantec 12/14/2010 23:43'!
testGroupedUndo2
	"test of grouping history entries by #openGroup and #closeGroup"
	| aCollection |
	aCollection := OrderedCollection newFrom: {1. 2. 3}.

	historyList openGroup.
	historyList doAndAddRecord: (
		UndoRedoRecord
			do: (MessageSend receiver: aCollection selector: #removeLast )
			undo: (MessageSend receiver: aCollection selector: #addLast: argument: aCollection last)).

	historyList doAndAddRecord: (
		UndoRedoRecord
			do: (MessageSend receiver: aCollection selector: #removeLast )
			undo: (MessageSend receiver: aCollection selector: #addLast: argument: aCollection last)).
	historyList closeGroup.

	"the historyList should have grouped the two commands and placed this group in the undoHistory"
	self assert: ((historyList size = 1) and: [historyList last isKindOf: UndoRedoGroup]).

	historyList undo.
	"both UndoRecords in the group should have been made undone"
	self assert: ((aCollection last = 3) and: [aCollection second = 2]).! !

!HistoryIteratorTest methodsFor: 'testing' stamp: 'AlainPlantec 12/14/2010 23:01'!
testGrouping
	| aCollection |
	aCollection := OrderedCollection new.

	historyList openGroup.
	self assert: historyList size = 1.
	self assert: (historyList at: 1) isComposite.
	self assert: (historyList at: 1) opened.
	historyList doAndAddRecord: (
		UndoRedoRecord
			do: (MessageSend receiver: aCollection selector: #addLast: argument: 1)
			undo: (MessageSend receiver: aCollection selector: #removeLast)).
	historyList doAndAddRecord: (
		UndoRedoRecord
			do: (MessageSend receiver: aCollection selector: #addLast: argument: 2)
			undo: (MessageSend receiver: aCollection selector: #removeLast)).
	self assert: historyList size = 1.
	self assert: (historyList at: 1) size = 2.
	historyList closeGroup.
	self assert: (historyList at: 1) closed.
	self assert: aCollection size = 2.
	self assert: aCollection first = 1.
	self assert: aCollection last = 2.
	historyList undo.
	self assert: aCollection isEmpty
! !

!HistoryIteratorTest methodsFor: 'testing' stamp: 'AlainPlantec 12/14/2010 23:43'!
testGroupedUndo1
	"test of grouping history entries afterwards by #groupFrom:to:"
	| aCollection |
	aCollection := OrderedCollection newFrom: {1. 2. 3}.

	historyList doAndAddRecord: (
		UndoRedoRecord
			do: (MessageSend receiver: aCollection selector: #removeLast )
			undo: (MessageSend receiver: aCollection selector: #addLast: argument: aCollection last)).

	historyList doAndAddRecord: (
		UndoRedoRecord
			do: (MessageSend receiver: aCollection selector: #removeLast )
			undo: (MessageSend receiver: aCollection selector: #addLast: argument: aCollection last)).

	historyList groupFrom: 1 to: 2.
	historyList undo.

	self assert: ((aCollection last = 3) and: [aCollection second = 2]).! !

!HistoryIteratorTest methodsFor: 'running' stamp: 'AlainPlantec 12/14/2010 23:38'!
setUp
	historyList := HistoryIterator new.! !

!HistoryIteratorTest methodsFor: 'testing' stamp: 'AlainPlantec 12/14/2010 23:01'!
testMaxSize

	| aCollection |
	aCollection := OrderedCollection newFrom: {1. 2. 3}.
	historyList maxSize: 5.

	10 timesRepeat: [
		historyList doAndAddRecord: (
			UndoRedoRecord
				do: (MessageSend receiver: aCollection selector: #size)
				undo: (MessageSend receiver: aCollection selector: #size)).
	].

	self assert: historyList size = 5.! !

!HistoryLeaf commentStamp: 'AlainPlantec 12/14/2010 23:06'!
This class represents the abstract leaf structure of items stored in History tree. Composite nodes of such trees are made of HistoryNode instances. For a particular use, this class need to be subclassed. See for example UndoRedoRecord!
!HistoryLeaf methodsFor: 'testing' stamp: 'AlainPlantec 12/13/2010 13:04'!
isComposite
	^ false! !

!HistoryLeaf methodsFor: 'adding' stamp: 'AlainPlantec 12/13/2010 13:07'!
addItem: anHistoryItem 
	^ false! !

!HistoryLeaf methodsFor: 'testing' stamp: 'AlainPlantec 12/13/2010 11:54'!
opened
	^ false! !

!HistoryNode commentStamp: 'AlainPlantec 12/15/2010 00:04'!
A HistoryNode is composite node of an history tree. It is made to contain some other HistoryNode or HistoryLeaf instances.
A subnode is added with #addItem:
In order to add and feed a new subtree, one can use openGroup which add a new HistoryNode. When openGroup is sent to an HistoryNode named H, then a new group G is added and all subsequent sent of #addItem: or of #openGroup to H will update the new node G until G is closed by a closeGroup. 

As examples:
---------------
H := HistoryNode new.
H addItem: (i1 := HistoryLeaf new).
---------------
gives:
H
	i1

---------------
H := HistoryNode new.
H openGroup. "add a new group named g1"
H addItem: (i1 := HistoryLeaf new).
H addItem: (i2 := HistoryLeaf new).
--------------
gives:
H
	g1
		i1
		i2

--------------
H := HistoryNode new.
H openGroup. "add a new group named g1"
H openGroup. "add a new group named g2"
H addItem: (i1 := HistoryLeaf new).
H addItem: (i2 := HistoryLeaf new).
--------------
gives:
H
	g1
		g2
			i1
			i2
			
--------------
H := HistoryNode new.
H openGroup. "add a new group named g1"
H openGroup. "add a new group named g2"
H addItem: (i1 := HistoryLeaf new).
H closeGroup. "close g2"
H addItem: (i2 := HistoryLeaf new).
H closeGroup. "close g1"
H addItem: (i3 := HistoryLeaf new).
--------------
gives:
H
	g1
		g2
			i1
		i2
	i3
	
Also se HistoryNodeTest.


Instance Variables
	history:		<OrderedCollection>
	opened:		<Boolean>

history
	- The list of subnodes (HistoryLeaf or HistoryNode instances)

opened
	- true if the node is opened for adding
!
!HistoryNode methodsFor: 'copying' stamp: 'AlainPlantec 12/14/2010 13:06'!
copyFrom: start to: stop
	^ self history copyFrom: start to: stop! !

!HistoryNode methodsFor: 'accessing' stamp: 'AlainPlantec 12/14/2010 19:08'!
last
	^ self history last! !

!HistoryNode methodsFor: 'accessing' stamp: 'AlainPlantec 12/12/2010 19:03'!
size
	^ self history size! !

!HistoryNode methodsFor: 'opening-closing' stamp: 'AlainPlantec 12/13/2010 11:53'!
close
	opened := false! !

!HistoryNode methodsFor: 'testing' stamp: 'AlainPlantec 12/13/2010 15:59'!
isEmpty
	^ self history isEmpty! !

!HistoryNode methodsFor: 'accessing' stamp: 'AlainPlantec 12/14/2010 19:08'!
first
	^ self history first! !

!HistoryNode methodsFor: 'private ' stamp: 'AlainPlantec 12/12/2010 19:06'!
removeFirst
	self history removeFirst! !

!HistoryNode methodsFor: 'testing' stamp: 'AlainPlantec 12/13/2010 13:04'!
isComposite
	^ true! !

!HistoryNode methodsFor: 'adding' stamp: 'AlainPlantec 12/14/2010 18:49'!
addItem: anHistoryItem 
	self current notNil
		ifTrue: [(self current addItem: anHistoryItem)
				ifTrue: [^ true]].
	self opened
		ifTrue: [self history add: anHistoryItem.
			^ true].
	^ false! !

!HistoryNode methodsFor: 'opening-closing' stamp: 'AlainPlantec 12/13/2010 22:00'!
reset
	history := nil.
	opened := true! !

!HistoryNode methodsFor: 'accessing' stamp: 'AlainPlantec 12/12/2010 18:37'!
history
	^ history ifNil: [history := OrderedCollection new] ! !

!HistoryNode methodsFor: 'accessing' stamp: 'AlainPlantec 12/13/2010 10:39'!
groupClass
	^ self class! !

!HistoryNode methodsFor: 'opening-closing' stamp: 'AlainPlantec 1/5/2011 09:36'!
closeGroup
	(self current notNil
			and: [self current isComposite
				and: [self current opened]])
		ifTrue: [self current closeGroup]
		ifFalse: [self close]! !

!HistoryNode methodsFor: 'accessing' stamp: 'AlainPlantec 12/14/2010 19:42'!
at: aPosition put: anItem
	self history at: aPosition put: anItem! !

!HistoryNode methodsFor: 'accessing' stamp: 'AlainPlantec 12/12/2010 19:01'!
at: aPosition
	^ self history at: aPosition! !

!HistoryNode methodsFor: 'testing' stamp: 'AlainPlantec 12/13/2010 11:54'!
opened
	^ opened ifNil: [opened := true]! !

!HistoryNode methodsFor: 'removing' stamp: 'AlainPlantec 12/14/2010 19:57'!
removeAt: anIndex
	self history removeAt: anIndex! !

!HistoryNode methodsFor: 'removing' stamp: 'AlainPlantec 12/14/2010 12:56'!
removeLast
	self history removeLast! !

!HistoryNode methodsFor: 'opening-closing' stamp: 'AlainPlantec 12/13/2010 11:53'!
open
	opened := true! !

!HistoryNode methodsFor: 'removing' stamp: 'AlainPlantec 12/14/2010 12:59'!
removeLast: count
	self history removeLast: count! !

!HistoryNode methodsFor: 'accessing' stamp: 'AlainPlantec 12/13/2010 15:05'!
current
	^ self history isEmpty
		ifFalse: [self history last] ! !

!HistoryNode methodsFor: 'testing' stamp: 'AlainPlantec 12/14/2010 19:04'!
closed
	^ self opened not! !

!HistoryNode methodsFor: 'opening-closing' stamp: 'AlainPlantec 12/13/2010 13:07'!
openGroup
	^ self addItem: self groupClass new! !

!HistoryNodeTest methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 12/14/2010 13:23'!
testOneGroup
	| h i c i2 i3 i4 | 
	h := HistoryNode new.
	h addItem: (i := HistoryLeaf new).
	self assert: h size = 1.
	self assert: (h at: 1) = i.
	h openGroup.
	self assert: h size = 2.
	self assert: (h at: 1) = i.
	self assert: (c := h at: 2) isComposite.
	self assert: c isEmpty.
	h addItem: (i2 := HistoryLeaf new).
	self assert: h size = 2.
	self assert: c size = 1.
	self assert: c current = i2.
	h closeGroup.
	h addItem: (i3 := HistoryLeaf new).
	self assert: h size = 3.
	self assert: (h at: 3) = i3.
	h closeGroup.
	h addItem: (i4 := HistoryLeaf new).
	self assert: h size = 3.
	

	
	
! !

!HistoryNodeTest methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 12/14/2010 13:21'!
testEmptyHistory
	| h |
	h := HistoryNode new.
	self assert: h size = 0.
	self assert: h current isNil! !

!HistoryNodeTest methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 12/14/2010 13:22'!
testOneItem
	| h i |
	h := HistoryNode new.
	h addItem: (i := HistoryLeaf new).
	self assert: h size = 1.
	self assert: h current = i! !

!HistoryNodeTest methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 1/5/2011 09:31'!
testTwoConsecutiveCloseGroup
	| h i grp1 grp2  i2 i3 i4 | 
	h := HistoryNode new.
	h addItem: (i := HistoryLeaf new).
	self assert: h size = 1.
	self assert: (h at: 1) = i.
	h openGroup.
	self assert: h size = 2.
	grp1 := h at: 2.
	h openGroup.
	self assert: h size = 2.
	self assert: grp1 size = 1.
	grp2 := grp1 at: 1.
	self assert: grp2 size = 0.
	h closeGroup.
	h closeGroup.
	h addItem: (i3 := HistoryLeaf new).
	self assert: h size = 3.
	self assert: h current = i3.
	

	
	
! !

!HistoryNodeTest methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 12/14/2010 13:23'!
testTwoGroups
	| h i grp1 grp2  i2 i3 i4 | 
	h := HistoryNode new.
	h addItem: (i := HistoryLeaf new).
	self assert: h size = 1.
	self assert: (h at: 1) = i.
	h openGroup.
	self assert: h size = 2.
	grp1 := h at: 2.
	h openGroup.
	self assert: h size = 2.
	self assert: grp1 size = 1.
	grp2 := grp1 at: 1.
	self assert: grp2 size = 0.
	h addItem: (i2 := HistoryLeaf new).
	self assert: grp2 size = 1.
	h closeGroup.
	h addItem: (i2 := HistoryLeaf new).
	self assert: grp2 size = 1.
	self assert: grp1 size = 2.
	self assert: grp1 current = i2.
	h closeGroup.
	h addItem: (i3 := HistoryLeaf new).
	self assert: grp2 size = 1.
	self assert: grp1 size = 2.
	self assert: h size = 3.
	self assert: h current = i3.
	

	
	
! !

!HistoryNodeTest methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 12/14/2010 13:23'!
testGroup
	| h i |
	h := HistoryNode new.
	h addItem: (i := HistoryLeaf new).
	self assert: h size = 1.
	self assert: (h at: 1) = i.
	h openGroup.
	self assert: h size = 2.
	self assert: (h at: 1) = i.
	self assert: (h at: 2) isComposite.
! !

!HistoryNodeTest methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 12/14/2010 13:23'!
testReset
	| h i |
	h := HistoryNode new.
	h addItem: (i := HistoryLeaf new).
	self assert: h current = i.
	self assert: h size = 1.
	h reset.
	self assert: h size = 0.! !

!HistoryNodeTest methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 12/14/2010 13:22'!
testClose
	| h i |
	h := HistoryNode new.
	h close.
	h addItem: (i := HistoryLeaf new).
	h open.
 	h addItem: i.
	self assert: h current = i! !

!HowToMakeYourOwnTutorial commentStamp: 'CamilloBruni 2/22/2014 18:44'!
I'm a Pharo tutorial which teach to create a Pharo tutorial. Open me with

PharoTutorial goOn: HowToMakeYourOwnTutorial.!
!HowToMakeYourOwnTutorial methodsFor: 'lessons' stamp: 'CamilloBruni 2/22/2014 18:45'!
implementTutorial
	^ Lesson 
title: 'Implement tutorial method'
lesson: 
'"Finally implement the tutorial method to return an Array of your lesson factory methods:"

HowToDebug compile:
''tutorial
	^ #(
#useSelfHalt
#examineStackTrace
#changeReturnValue
)''
classified: ''tutorial''.


PharoTutorial next.'.! !

!HowToMakeYourOwnTutorial methodsFor: 'lessons' stamp: 'CamilloBruni 2/22/2014 18:45'!
createLessonFactoryMethods
	^ Lesson 
title: 'Lesson factory methods'
lesson: 
'"Next, create category ''lessons'' and add a method per lesson.

Each method must return a Lesson object.

Your can use Lesson class>>title:lesson: to create Lesson object."

HowToDebug compile:
''useSelfHalt
	^ Lesson
title: ''''self halt''''
lesson: 
''''"Put self halt. in the method you want to debug."

PharoTutorial next.''''''
classified: ''lessons''.

HowToDebug compile:
''examineStackTrace
	^ Lesson
title: ''''self halt''''
lesson: 
''''"Look at PharoDebug.log."

PharoTutorial next.''''''
classified: ''lessons''.

HowToDebug compile:
''changeReturnValue
	^ Lesson
title: ''''Change return value''''
lesson: 
''''"Easy in the debugger !!"''''''
classified: ''lessons''.

PharoTutorial next.'.! !

!HowToMakeYourOwnTutorial methodsFor: 'lessons' stamp: 'CamilloBruni 2/22/2014 18:45'!
runYourTutorial
	^ Lesson 
title: 'Run your tutorial'
lesson: 
'"You can run your fresh new tutorial like this:" 

PharoTutorial goOn: HowToDebug.'.! !

!HowToMakeYourOwnTutorial methodsFor: 'tutorial' stamp: 'LaurentLaffont 1/21/2010 21:45'!
tutorial 
	^ #(
subclassAbstractTutorial
createLessonFactoryMethods
implementTutorial
runYourTutorial
)! !

!HowToMakeYourOwnTutorial methodsFor: 'lessons' stamp: 'CamilloBruni 2/22/2014 18:45'!
subclassAbstractTutorial
	^ Lesson 
title: 'AbstractTutorial'
lesson: 
'"Here are the steps to create your own Pharo tutorial. 

First, create a subclass of AbstractTutorial. For example:"

AbstractTutorial subclass: #HowToDebug
	instanceVariableNames: ''''
	classVariableNames: ''''
	poolDictionaries: ''''
	category: ''PharoTutorial''.
	
PharoTutorial next.'! !

!HowToMakeYourOwnTutorialTest commentStamp: 'TorstenBergmann 2/12/2014 22:50'!
Tests for HowToMakeYourOwnTutorial!
!HowToMakeYourOwnTutorialTest methodsFor: 'tests' stamp: ''!
testLessonAtReturnsCorrespondingLesson
	| answer |
	1 to: (self testedTutorial tutorial size) do: [:index|
		answer := self testedTutorial lessonAt: index.
		self assert: (answer isKindOf: Lesson)
	]
	! !

!HowToMakeYourOwnTutorialTest methodsFor: 'tests' stamp: 'LaurentLaffont 2/1/2010 22:04'!
testedTutorial
	"Returns an instance of an AbstractTutorial subclass"
	^ HowToMakeYourOwnTutorial new! !

!HowToMakeYourOwnTutorialTest methodsFor: 'tests' stamp: ''!
testNotEmpty
	self assert: self testedTutorial tutorial notEmpty.! !

!HowToMakeYourOwnTutorialTest methodsFor: 'tests' stamp: ''!
testEachSelectorReturnsALesson
	| answer |
	self testedTutorial tutorial do: [:aSelector|
		answer := (self testedTutorial perform: aSelector).
		self assert: (answer isKindOf: Lesson).
	]! !

!HowToMakeYourOwnTutorialTest methodsFor: 'tests' stamp: 'LaurentLaffont 2/1/2010 22:05'!
testEachSelectorExists
	self testedTutorial tutorial do: [:aSelector|
		self assert: (self testedTutorial respondsTo: aSelector) 
	]! !

!HowToMakeYourOwnTutorialTest methodsFor: 'tests' stamp: ''!
testSizeReturnsNumberOfSelectors
	self assert: (self testedTutorial tutorial size) equals: self testedTutorial size.! !

!IRAccess commentStamp: '<historical>'!
IRAccess models all bytecodes that read or write variables or self/super/thisContext!
!IRBlockReturnTop commentStamp: 'MarcusDenker 8/11/2014 10:16'!
I model the bytecode for block returns.!
!IRBlockReturnTop methodsFor: 'testing' stamp: 'md 10/8/2004 16:04'!
isBlockReturnTop

	^true.! !

!IRBlockReturnTop methodsFor: 'accessing' stamp: 'MarcusDenker 6/19/2012 13:50'!
successorSequences
	"sent to last instruction in sequence which is expected to be a jump and return instruction"

	^  { successor }! !

!IRBlockReturnTop methodsFor: 'accessing' stamp: 'ClementBera 10/27/2014 10:54'!
successor
	^ successor! !

!IRBlockReturnTop methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 13:32'!
accept: aVisitor
	^ aVisitor visitBlockReturnTop: self! !

!IRBlockReturnTop methodsFor: 'accessing' stamp: 'MarcusDenker 6/19/2012 13:50'!
successor: anObject

	successor := anObject. ! !

!IRBuilder commentStamp: '<historical>'!
I provide a simple interface for constructing an IRMethod.  For example, to create an ir method that compares first instVar to first arg and returns 'yes' or 'no' (same example as in BytecodeGenerator), do:

	IRBuilder new
		numArgs: 1;
		addTemps: #(a z);
		pushReceiver;
		pushInstVar: 1;
		pushTemp: #a;
		send: #>;
		jumpAheadTo: #else if: false;
		pushLiteral: 'yes';
		returnTop;
		jumpAheadTarget: #else;
		pushLiteral: 'no';
		returnTop;
		ir

Sending #compiledMethod to an ir method will generate its compiledMethod.  Sending #methodNode to it will decompile to its parse tree.
!
!IRBuilder methodsFor: 'initialize' stamp: 'jb 4/2/2010 11:32'!
addTemp: tempKey
	
	self addTemps: {tempKey}! !

!IRBuilder methodsFor: 'private' stamp: 'MarcusDenker 6/13/2012 14:13'!
startNewSequence
	"End current instruction sequence and start a new sequence to add instructions to.  If ending block just falls through to new block then add an explicit jump to it so they stay linked"

	| newSequence | 
	currentSequence ifEmpty: [^ self].	"block is still empty, continue using it"
	newSequence := IRSequence orderNumber: currentSequence orderNumber + 1.
	newSequence method: ir.

	currentSequence last isJumpOrReturn
		ifFalse: [ self add: (IRJump new destination: newSequence)].
	self currentScope isPushClosureCopy ifTrue: [self currentScope lastBlockSequence: currentSequence].
	currentSequence := newSequence.
! !

!IRBuilder methodsFor: 'scopes' stamp: 'JorgeRessia 5/20/2010 09:58'!
popScope
	currentScope pop.! !

!IRBuilder methodsFor: 'instructions' stamp: 'jre 9/29/2009 15:39'!
pushConsArray: size

	self add: (IRInstruction pushConsArray: size)! !

!IRBuilder methodsFor: 'initialization' stamp: 'MarcusDenker 6/13/2012 14:12'!
initialize
	ir := IRMethod new.
	jumpAheadStacks := IdentityDictionary new.
	jumpBackTargetStacks := IdentityDictionary new.
	sourceMapNodes := OrderedCollection new.	"stack"
	currentScope := Stack new.
	self pushScope: ir.
	
	"Leave an empty sequence up front (guaranteed not to be in loop)"
	ir startSequence: ((IRSequence orderNumber: 0) method:ir).
	currentSequence := (IRSequence orderNumber: 1) method:ir.
	ir startSequence add:
		(IRJump new
			destination: currentSequence;
			bytecodeIndex: sourceMapByteIndex;
			yourself).
! !

!IRBuilder methodsFor: 'accessing' stamp: 'md 7/10/2005 22:37'!
properties: aDict
	ir properties: aDict! !

!IRBuilder methodsFor: 'instructions' stamp: 'MarcusDenker 8/19/2010 16:12'!
pushInstVar: index

	self add: (IRInstruction pushInstVar: index).! !

!IRBuilder methodsFor: 'instructions' stamp: 'MarcusDenker 6/13/2012 14:19'!
storeTemp: aSymbol

	^self add: (IRInstruction storeTemp: aSymbol)! !

!IRBuilder methodsFor: 'mapping' stamp: 'ajh 3/13/2003 13:17'!
mapToByteIndex: index
	"decompiling"

	sourceMapByteIndex := index! !

!IRBuilder methodsFor: 'instructions' stamp: 'MarcusDenker 6/13/2012 14:18'!
storeIntoLiteralVariable: name
	
	^self add: (IRInstruction storeIntoLiteralVariable: name)! !

!IRBuilder methodsFor: 'instructions' stamp: 'md 4/21/2005 12:06'!
pushThisContext

	self add: (IRInstruction pushThisContext)! !

!IRBuilder methodsFor: 'instructions' stamp: 'ajh 3/10/2003 01:09'!
pushDup

	self add: IRInstruction pushDup! !

!IRBuilder methodsFor: 'instructions' stamp: 'JorgeRessia 5/20/2010 07:25'!
returnTop

	self add: IRInstruction returnTop.
	self startNewSequence.
! !

!IRBuilder methodsFor: 'scopes' stamp: 'MarcusDenker 4/13/2010 14:20'!
currentScope 
	^currentScope top! !

!IRBuilder methodsFor: 'instructions' stamp: 'MarcusDenker 8/18/2010 19:55'!
pushLiteral: object

	self add: (IRInstruction pushLiteral: object)! !

!IRBuilder methodsFor: 'instructions' stamp: 'ajh 3/10/2003 01:09'!
popTop

	self add: IRInstruction popTop! !

!IRBuilder methodsFor: 'instructions' stamp: 'ToonVerwaest 3/27/2011 17:17'!
jumpAheadTarget: labelSymbol
	"Pop latest jumpAheadTo: with this labelSymbol and have it point to this new instruction sequence"

	| jumpInstr |
	self startNewSequence.
	jumpInstr := (jumpAheadStacks at: labelSymbol ifAbsent: [
			self error: 'Missing jumpAheadTo: ', labelSymbol printString]) removeLast.
	jumpInstr destination: currentSequence.
! !

!IRBuilder methodsFor: 'instructions' stamp: 'MarcusDenker 6/15/2012 10:37'!
pushClosureCopyCopiedValues: copiedValuesNames args: args jumpTo: aJumpLabel
	
	|  irInstruction |
	
	irInstruction := IRInstruction pushClosureCopyCopiedValues: copiedValuesNames args: args.
	self add: irInstruction.
	(jumpAheadStacks at: aJumpLabel ifAbsentPut: [OrderedCollection new]) addLast: irInstruction.
	self startNewSequence.
	irInstruction blockSequence: currentSequence.
	self pushScope:  irInstruction.
	self addTemps: args.
	self addTemps: copiedValuesNames.


	^irInstruction! !

!IRBuilder methodsFor: 'instructions' stamp: 'MarcusDenker 12/14/2012 11:51'!
pushTemp: aSelector

	^ self add: (IRInstruction pushTemp: aSelector)! !

!IRBuilder methodsFor: 'initialize' stamp: 'MarcusDenker 5/14/2013 10:07'!
compilationContext: aCompilationContext
	ir compilationContext: aCompilationContext! !

!IRBuilder methodsFor: 'instructions' stamp: 'MarcusDenker 6/13/2012 14:19'!
storeRemoteTemp: name inVector: nameOfVector

	^self add: (IRInstruction storeRemoteTemp: name inVectorAt: nameOfVector)! !

!IRBuilder methodsFor: 'mapping' stamp: 'MarcusDenker 8/20/2010 08:07'!
sourceByteIndex

	^ sourceMapByteIndex! !

!IRBuilder methodsFor: 'initialize' stamp: 'MarcusDenker 5/19/2011 13:49'!
createTempVectorNamed: name withVars: anArray
	
	"self addVectorTemps: anArray."
	self addTemp: name.
	self add: (IRInstruction createTempVectorNamed: name withVars: anArray).
! !

!IRBuilder methodsFor: 'instructions' stamp: 'md 4/21/2005 11:38'!
pushReceiver

	self add: (IRInstruction pushReceiver)! !

!IRBuilder methodsFor: 'results' stamp: 'MarcusDenker 11/6/2014 15:43'!
ir

	^ ir optimize! !

!IRBuilder methodsFor: 'instructions' stamp: 'JB 8/1/2010 14:56'!
jumpAheadTo: labelSymbol
	"Jump to the sequence that will be created when jumpAheadTarget: labelSymbol is sent to self.  This is and its corresponding target is only good for one use.  Other jumpAheadTo: with the same label will be put on a stack and superceed existing ones until its jumpAheadTarget: is called."

	"jumpAheadTarget: label will pop this and replace destination with its basic block"

	(jumpAheadStacks at: labelSymbol ifAbsentPut: [OrderedCollection new])
		addLast: (self add: IRJump new).
	self startNewSequence.
! !

!IRBuilder methodsFor: 'instructions' stamp: 'MarcusDenker 6/19/2012 13:19'!
jumpBackTo: labelSymbol
	"Pop last remembered position with this label and write an unconditional jump to it"

	| sequence jump |
	sequence := (jumpBackTargetStacks at: labelSymbol ifAbsent: [self error: 'Missing jumpBackTarget: ', labelSymbol printString]) removeLast.
	jump := IRJump new destination: sequence.
	self add: jump.
	self startNewSequence.
	jump successor: currentSequence.
	! !

!IRBuilder methodsFor: 'scopes' stamp: 'MarcusDenker 8/18/2010 19:55'!
pushScope: anIRBlockOrMethod

	currentScope push: anIRBlockOrMethod! !

!IRBuilder methodsFor: 'instructions' stamp: 'MarcusDenker 12/14/2012 10:43'!
blockReturnTop
	| retInst |
	
	retInst := IRInstruction blockReturnTop.
	self add: retInst.
	self startNewSequence.
	retInst  successor: currentSequence.
	self popScope.! !

!IRBuilder methodsFor: 'initialize' stamp: 'ClementBera 7/16/2014 15:03'!
addLiteral: aLiteral
	"Add this literal at the end of the literal array if there is space left"
	aLiteral ifNil: [ ^ self ].
	ir addAdditionalLiteral: aLiteral.! !

!IRBuilder methodsFor: 'instructions' stamp: 'MarcusDenker 6/13/2012 14:18'!
storeInstVar: name

	^self add: (IRInstruction storeInstVar: name).! !

!IRBuilder methodsFor: 'initialize' stamp: 'MarcusDenker 1/23/2014 17:17'!
addTemps: newKeys
	| i offset |
	offset := self currentScope tempMap size.
	i := 1.
	newKeys do: [:key |
		self  currentScope tempMap at: key ifAbsentPut: [i:=i+1.offset + i - 1].
	].
! !

!IRBuilder methodsFor: 'instructions' stamp: 'MarcusDenker 6/13/2012 14:19'!
send: selector toSuperOf: behavior

	^self add: (IRInstruction send: selector toSuperOf: behavior)! !

!IRBuilder methodsFor: 'accessing' stamp: 'MarcusDenker 5/14/2013 17:10'!
irPrimitive: primNode

	ir irPrimitive: primNode! !

!IRBuilder methodsFor: 'private' stamp: 'ToonVerwaest 3/31/2011 13:17'!
add: instr
	
	"Associate instr with current parse node or byte range"
	instr sourceNode: self sourceNode.
	instr bytecodeIndex: self sourceByteIndex.
	^ currentSequence add: instr! !

!IRBuilder methodsFor: 'initialize' stamp: 'MarcusDenker 6/6/2012 13:38'!
additionalLiterals:  literals
	"Add this literal at the end of the literal array if there is space left"
	ir addAdditionalLiterals: literals.! !

!IRBuilder methodsFor: 'instructions' stamp: 'MarcusDenker 6/13/2012 14:17'!
pushRemoteTemp: name inVector: nameOfVector

	^self add: (IRInstruction pushRemoteTemp: name inVectorAt: nameOfVector)! !

!IRBuilder methodsFor: 'mapping' stamp: 'ajh 6/22/2003 14:25'!
popMap

	sourceMapNodes removeLast! !

!IRBuilder methodsFor: 'mapping' stamp: 'MarcusDenker 11/19/2012 17:14'!
sourceNode
	^ sourceMapNodes
		ifEmpty: [nil]
		ifNotEmpty: [sourceMapNodes last]! !

!IRBuilder methodsFor: 'instructions' stamp: 'jre 9/29/2009 15:39'!
pushNewArray: size

	self add: (IRInstruction pushNewArray: size)! !

!IRBuilder methodsFor: 'mapping' stamp: 'ajh 6/22/2003 14:45'!
mapToNode: object
	"new instructions will be associated with object"

	sourceMapNodes addLast: object! !

!IRBuilder methodsFor: 'instructions' stamp: 'MarcusDenker 10/12/2010 12:19'!
addBlockReturnTopIfRequired
	"If the current sequence is empty this means that there was a returntop before 
	then since there is no more stmts we do not need a blockreturntop"
	
	"cant we optimize this away later? Then the frontend can always just add a return...."
	
	| predecessors |
	self flag: 'cant we do this automatically.... frontend always adds return, we ignore it if there is a ret method before?'.
	
	predecessors := ir predecessorsOf: currentSequence.
	(currentSequence isEmpty and: [(predecessors isEmpty) or: [((ir predecessorsOf: currentSequence) 
								anySatisfy: [:each | (each last isBlockReturnTop not) and: [(each last isReturn) 
												or: [(each size > 1) and: [(each at: each size -1) isReturn] ]]])] ])
							ifTrue: [self popScope]
							ifFalse: [self blockReturnTop ]! !

!IRBuilder methodsFor: 'initialize' stamp: 'MarcusDenker 11/19/2012 17:16'!
numArgs: anInteger
	ir numArgs: anInteger.
	ir sourceNode: self sourceNode.! !

!IRBuilder methodsFor: 'instructions' stamp: 'ajh 6/22/2003 14:44'!
jumpBackTarget: labelSymbol
	"Remember this basic block for a future jumpBackTo: labelSymbol.  Stack up remembered targets with same name and remove them from stack for each jumpBackTo: called with same name."

	self startNewSequence.
	(jumpBackTargetStacks at: labelSymbol ifAbsentPut: [OrderedCollection new])
		addLast: currentSequence.
! !

!IRBuilder methodsFor: 'accessing' stamp: 'MarcusDenker 5/18/2013 17:37'!
compilationContext
	^ir compilationContext ! !

!IRBuilder methodsFor: 'instructions' stamp: 'ajh 6/22/2003 14:44'!
jumpAheadTo: labelSymbol if: boolean
	"Conditional jump to the sequence that will be created when jumpAheadTarget: labelSymbol is sent to self.  This and its corresponding target is only good for one use.  Other jumpAheadTo:... with the same label will be put on a stack and superceed existing ones until its jumpAheadTarget: is called."

	| instr |
	"jumpAheadTarget: label will pop this and replace destination with its basic block"
	(jumpAheadStacks at: labelSymbol ifAbsentPut: [OrderedCollection new])
		addLast: (instr := self add: (IRJumpIf new boolean: boolean)).
	self startNewSequence.
	instr otherwise: currentSequence.
! !

!IRBuilder methodsFor: 'instructions' stamp: 'MarcusDenker 8/18/2010 19:55'!
pushLiteralVariable: object

	self add: (IRInstruction pushLiteralVariable: object)! !

!IRBuilder methodsFor: 'decompiling' stamp: 'ajh 3/21/2003 01:48'!
testJumpAheadTarget: label

	jumpAheadStacks at: label ifPresent: [:stack |
		[stack isEmpty] whileFalse: [self jumpAheadTarget: label]
	]! !

!IRBuilder methodsFor: 'initialize' stamp: 'JorgeRessia 5/6/2010 11:04'!
addPragma: aPragma
	^ir addPragma: aPragma! !

!IRBuilder methodsFor: 'instructions' stamp: 'MarcusDenker 6/13/2012 14:19'!
send: selector

	^self add: (IRInstruction send: selector)! !

!IRBuilder methodsFor: 'decompiling' stamp: 'ajh 6/22/2003 14:44'!
addJumpBackTarget: label to: sequence

	(jumpBackTargetStacks at: label ifAbsentPut: [OrderedCollection new])
		addLast: sequence! !

!IRBuilder class methodsFor: 'builder api' stamp: 'MarcusDenker 7/9/2013 16:07'!
buildMethod: aBlock
	^(self buildIR: aBlock) compiledMethod! !

!IRBuilder class methodsFor: 'builder api' stamp: 'MarcusDenker 7/9/2013 16:09'!
buildIR: aBlock
	^(aBlock value: self new) ir.! !

!IRBuilderTest methodsFor: 'testing' stamp: 'MarcusDenker 8/18/2010 18:52'!
testLiteralBoolean

	| iRMethod aCompiledMethod |
	iRMethod := IRBuilder new
		pushLiteral: true; 	
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
	self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() )).
	^iRMethod.

	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'JB 8/19/2010 16:45'!
testLiteralVariableClass

	| iRMethod aCompiledMethod |
	iRMethod := IRBuilder new
		pushLiteralVariable: Object binding;	
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = Object).
	^iRMethod

	! !

!IRBuilderTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 9/3/2010 14:12'!
testRemoteTempShadowed

	| iRMethod aCompiledMethod |
	iRMethod := IRBuilder new
		addTemps: #(a);  "we have one real temp"
		pushLiteral: 1;
		storeTemp: #a;
		popTop;
		pushClosureCopyCopiedValues: #() args: #() jumpTo: #block;
			addTemps: #(a);
			pushTemp: #a;                                                                                             "a shadows the outer one"
			send: #isNil;
	     	 	blockReturnTop;
		jumpAheadTarget: #block;	
		send: #value;
		returnTop;
		ir.
	
	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
	self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = true).
	^iRMethod
	! !

!IRBuilderTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 8/27/2010 13:22'!
testPushClosureCopyOneCopiedArg

	| iRMethod aCompiledMethod |
	iRMethod := IRBuilder new
		addTemps: #(c a);
		pushReceiver;
		pushLiteral: 1;
		storeTemp: #a;
		popTop;
		pushClosureCopyCopiedValues: #(a) args: #(d) jumpTo: #block;
		pushTemp: #a;
		pushTemp: #d;
		send: #+;
		blockReturnTop;
		jumpAheadTarget: #block;	
		pushLiteral: 1;
		send: #value:;
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2).
	^iRMethod
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'JB 8/19/2010 16:46'!
testPushSelf

	| iRMethod aCompiledMethod |
	iRMethod := IRBuilder new
		pushReceiver;
		send: #class;
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.


	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) == UndefinedObject).
	^iRMethod
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'MarcusDenker 8/25/2010 14:22'!
testStorePopIntoVariable

	| iRMethod aCompiledMethod  |
	iRMethod := IRBuilder new
		pushLiteral: 4;
		storeIntoLiteralVariable: (self class bindingOf: #TestToPush);
		popTop;
		pushLiteralVariable: (self class bindingOf: #TestToPush);
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.


	self assert: (aCompiledMethod isKindOf: CompiledMethod).
      aCompiledMethod valueWithReceiver: nil arguments: #().
	self assert: (self class testToPush = 4).
	self class testToPush: nil.
	^iRMethod
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'JB 8/19/2010 16:45'!
testLiteralVariableClassVariable

	| iRMethod aCompiledMethod |
	iRMethod := IRBuilder new
		pushLiteralVariable: (DateAndTime bindingOf: #LocalTimeZone); 	
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = DateAndTime localTimeZone).
	^iRMethod
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'JB 8/19/2010 16:49'!
testPushNewArray

	| iRMethod aCompiledMethod receiver |
	iRMethod := IRBuilder new

		pushNewArray: 1;
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.
	
	receiver :=  (5@8).

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
	self assert: ((aCompiledMethod valueWithReceiver: receiver arguments: #()) first isNil).
	^iRMethod
! !

!IRBuilderTest methodsFor: 'testing' stamp: 'MarcusDenker 8/25/2010 14:25'!
testStoreIvar

	| iRMethod aCompiledMethod  |
	iRMethod := IRBuilder new
		pushLiteral: 34;
		storeInstVar: 2;
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
 	self assert: ((aCompiledMethod valueWithReceiver: self arguments: #() ) = 34).
	^iRMethod
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'JB 8/19/2010 16:54'!
testStoreIntoVariable

	| iRMethod aCompiledMethod  |
	iRMethod := IRBuilder new
		pushLiteral: 4;
		storeIntoLiteralVariable: (self class bindingOf: #TestToPush);
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.


	self assert: (aCompiledMethod isKindOf: CompiledMethod).
      aCompiledMethod valueWithReceiver: nil arguments: #().
	self assert: (self class testToPush = 4).
	self class testToPush: nil.
	^iRMethod
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'MarcusDenker 11/11/2011 15:40'!
testLiteralVariableGlobale

	| iRMethod aCompiledMethod |
	iRMethod := IRBuilder new
		pushLiteralVariable: (Smalltalk globals associationAt: #Smalltalk);	
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = Smalltalk).
	^iRMethod

	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'MarcusDenker 8/18/2010 19:00'!
testReturnTop

	| iRMethod aCompiledMethod |
	iRMethod := IRBuilder new
		pushLiteral: false;
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
	self deny: (aCompiledMethod valueWithReceiver: nil arguments: #()).
	^iRMethod
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'MarcusDenker 9/14/2013 17:31'!
testSendSuper

	| iRMethod aCompiledMethod  |
	iRMethod := IRBuilder new
		pushReceiver;
		send: #isThisEverCalled toSuperOf: self class;
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.


	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self should: [(aCompiledMethod valueWithReceiver: (self class new) arguments: #())] raise: Error.
	^iRMethod
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'MarcusDenker 8/18/2010 19:01'!
testPopTop

	| iRMethod aCompiledMethod |
	iRMethod := IRBuilder new
		pushReceiver;
		pushLiteral: false;
		popTop;
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
	self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) isNil).
	^iRMethod
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'JB 8/19/2010 16:48'!
testInstVar

	| iRMethod aCompiledMethod  |
	iRMethod := IRBuilder new
		pushInstVar: 1;
		pushInstVar: 2;
		send: #+;
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
 	self assert: ((aCompiledMethod valueWithReceiver: (3@4) arguments: #() ) = 7).
	^iRMethod
	
	! !

!IRBuilderTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 8/27/2010 10:38'!
testPushClosureCopyNoCopiedArgNamed

	| iRMethod aCompiledMethod |
	iRMethod := IRBuilder new
		pushReceiver;
		pushClosureCopyCopiedValues: #() args: #(d) jumpTo: #block;
		pushLiteral: 1;
		pushTemp: #d;
		send: #+;
	      blockReturnTop;
		jumpAheadTarget: #block;	
		pushLiteral: 1;
		send: #value:;
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
	self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2).
	^iRMethod
	! !

!IRBuilderTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 8/27/2010 13:22'!
testPushClosureCopyNoCopied

	| iRMethod aCompiledMethod |
	iRMethod := IRBuilder new
		pushReceiver;
		pushClosureCopyCopiedValues: #() args: #() jumpTo: #block;
		pushLiteral: 1;
		pushLiteral: 2;
		send: #+;
	      blockReturnTop;
		jumpAheadTarget: #block;	
		send: #value;
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
	self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = 3).
	^iRMethod
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'MarcusDenker 8/18/2010 18:58'!
testLiteralArray

	| iRMethod aCompiledMethod |
	iRMethod := IRBuilder new
		pushLiteral: #(test 4 you); 	
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
	self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = #(test 4 you)).
	^iRMethod

	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'JB 8/19/2010 16:45'!
testLiteralNil

	| iRMethod aCompiledMethod |
	iRMethod := IRBuilder new
		pushLiteral: nil; 	
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: 4 arguments: #() ) isNil).
	^iRMethod
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'MarcusDenker 8/18/2010 19:49'!
testJumpBackTo

	| iRMethod aCompiledMethod |
	iRMethod := IRBuilder new
		pushReceiver;
		pushLiteral: false;
		jumpBackTarget: #begin;
		jumpAheadTo: #end if: true;
		pushLiteral: true;
		jumpBackTo: #begin;
		jumpAheadTarget: #end;	
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
	self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) isNil).
	^iRMethod.
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'MarcusDenker 8/20/2010 22:46'!
testJumpAheadTo

	| iRMethod aCompiledMethod iRBuilder |
	iRBuilder := IRBuilder new.
	iRMethod := iRBuilder
		pushLiteral: 2;
		pushLiteral: 1;
		send: #+;
		jumpAheadTo: #end;
		pushLiteral: 3;
		jumpAheadTarget: #end;	
		returnTop;
		ir.


	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
	self assert: (aCompiledMethod valueWithReceiver: nil arguments: #())  = 3.
	^iRMethod
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'JB 8/19/2010 16:49'!
testPushConsArray

	| iRMethod aCompiledMethod receiver |
	iRMethod := IRBuilder new
		pushReceiver;
		pushConsArray: 1;
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.
	
	receiver :=  (5@8).

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
	self assert: ((aCompiledMethod valueWithReceiver: receiver arguments: #()) first == receiver).
	^iRMethod
! !

!IRBuilderTest methodsFor: 'testing' stamp: 'MarcusDenker 7/9/2013 16:08'!
testDup

	| iRMethod aCompiledMethod |
	iRMethod := IRBuilder buildIR: [ : builder | 
		builder pushLiteral: 3;
		pushDup;
		send: #=;
		returnTop].

	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
  	self assert: (aCompiledMethod valueWithReceiver: nil arguments: #() ).
	^iRMethod
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'JB 8/19/2010 16:45'!
testLiteralString

	| iRMethod aCompiledMethod |
	iRMethod := IRBuilder new
		pushLiteral: 'hello'; 	
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = 'hello').
	^iRMethod

	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'JB 8/19/2010 16:49'!
testPushConsArray2

	| iRMethod aCompiledMethod receiver |
	iRMethod := IRBuilder new
		pushLiteral: 'hi!!';
		pushConsArray: 1;
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.
	
	receiver :=  (5@8).

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
	self assert: (((aCompiledMethod valueWithReceiver: receiver arguments: #()))= #('hi!!')).
	^iRMethod
! !

!IRBuilderTest methodsFor: 'testing - builder' stamp: 'MarcusDenker 7/9/2013 16:10'!
testBuildMethod
	|  aCompiledMethod |
	
	aCompiledMethod := IRBuilder buildMethod: [ : builder | 
		builder pushLiteral: 3;
		pushDup;
		send: #=;
		returnTop].

	self assert: (aCompiledMethod isKindOf: CompiledMethod).! !

!IRBuilderTest methodsFor: 'testing' stamp: 'MarcusDenker 6/17/2013 12:51'!
testLiteralCharacter

	| iRMethod aCompiledMethod |
	iRMethod := IRBuilder new
		pushLiteral: $e; 	
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
	self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = $e).
	^iRMethod

	! !

!IRBuilderTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 8/27/2010 13:21'!
testPushClosureCopyOneCopiedTemp

	| iRMethod aCompiledMethod |
	iRMethod := IRBuilder new
		addTemps: #(c a);
		pushReceiver;
		pushLiteral: 1;
		storeTemp: #a;
		popTop;
		pushClosureCopyCopiedValues: #(a) args: #() jumpTo: #block;
		addTemps: #(d);  "the temp"
		pushTemp: #a;
		pushLiteral: 1;
		send: #+;
		storeTemp:  #d;
		popTop;
		pushTemp: #d;
		blockReturnTop;
		jumpAheadTarget: #block;	
		send: #value;
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2).
	^iRMethod
	! !

!IRBuilderTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 8/27/2010 13:22'!
testPushClosureCopyNoCopiedArg

	| iRMethod aCompiledMethod |
	iRMethod := IRBuilder new
		pushReceiver;
		pushClosureCopyCopiedValues: #() args: #(d) jumpTo: #block;
		pushLiteral: 1;
		pushTemp: #d;
		send: #+;
	      blockReturnTop;
		jumpAheadTarget: #block;	
		pushLiteral: 1;
		send: #value:;
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
	self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2).
	^iRMethod
	! !

!IRBuilderTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 8/27/2010 13:22'!
testPushClosureCopyOneCopied

	| iRMethod aCompiledMethod |
	iRMethod := IRBuilder new
		addTemps: #(c a);
		pushReceiver;
		pushLiteral: 1;
		storeTemp: #a;
		popTop;
		pushClosureCopyCopiedValues: #(a) args: #() jumpTo: #block;
		pushTemp: #a;
		blockReturnTop;
		jumpAheadTarget: #block;	
		send: #value;
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = 1).
	^iRMethod! !

!IRBuilderTest methodsFor: 'testing' stamp: 'MarcusDenker 7/5/2013 15:41'!
testLiteralInteger

	| iRMethod aCompiledMethod |
	iRMethod := IRBuilder new
		pushLiteral: 2; 	
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
	self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2).
	^iRMethod

	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'JB 8/19/2010 16:45'!
testLiteralSymbol

	| iRMethod aCompiledMethod |
	iRMethod := IRBuilder new
		pushLiteral: #you; 	
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = #you).
	^iRMethod

	! !

!IRBuilderTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 8/27/2010 13:21'!
testRemoteTempNested

	| iRMethod aCompiledMethod |

		iRMethod := IRBuilder new
		addTemps: #(a);  "we have one real temp"
		createTempVectorNamed:#methodVector withVars: #(b);      "b we know will be written to, so make a tempvector entry" 
		pushLiteral: 1;
		storeTemp: #a;
		popTop;
		pushClosureCopyCopiedValues: #(methodVector a) args: #() jumpTo: #block;
		createTempVectorNamed:#blockVector withVars: #(f);    
			pushTemp: #a;                                                                                             "a is just read, so we copy it to the block"
				pushClosureCopyCopiedValues: #(methodVector) args: #() jumpTo: #block2;
				pushLiteral: 1;
				storeRemoteTemp: #b inVector: #methodVector;							      "f comes from tempvetor, as we do write to it"
				blockReturnTop;		
				jumpAheadTarget: #block2;	
			send: #value;
			send: #+;
			storeRemoteTemp: #b inVector: #methodVector;							      "b comes from tempvetor, as we do write to it"
	     	 	blockReturnTop;
			
		jumpAheadTarget: #block;	
		send: #value;
		pushRemoteTemp: #b inVector: #methodVector;				
		returnTop;
		ir.
	
	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
	self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #()) = 2).
	^iRMethod
	! !

!IRBuilderTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 8/27/2010 13:20'!
testRemoteTemp

	| iRMethod aCompiledMethod |
	iRMethod := IRBuilder new
		addTemps: #(a c);  "we have one real temp"
		createTempVectorNamed:#methodVector withVars: #(b);      "b we know will be written to, so make a tempvector entry" 
		pushLiteral: 1;
		storeTemp: #a;
		popTop;
		pushClosureCopyCopiedValues: #(#a #c #methodVector) args: #() jumpTo: #block;
			pushTemp: #a;                                                                                             "a is just read, so we copy it to the block"
			pushLiteral: 1;
			send: #+;
			storeRemoteTemp: #b inVector: #methodVector;							      "b comes from tempvetor, as we do write to it"
			popTop;
	     	 	blockReturnTop;
		jumpAheadTarget: #block;	
		send: #value;
		pushRemoteTemp: #b inVector: #methodVector;				
		returnTop;
		ir.
	
	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
	self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2).
	^iRMethod
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'MarcusDenker 8/18/2010 18:58'!
testLiteralFloat

	| iRMethod aCompiledMethod |
	iRMethod := IRBuilder new
		pushLiteral: 2.0; 	
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
 	self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) closeTo: 2.0).
	^iRMethod

	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'JB 8/19/2010 16:47'!
testPushTempTemp

	| iRMethod aCompiledMethod  |
	iRMethod := IRBuilder new
		addTemps: #(a);
		pushTemp: #a;
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.


	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: 5 arguments: #() ) isNil).
	^iRMethod
	! !

!IRBuilderTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 8/27/2010 13:25'!
testPushClosureCopyOneCopiedTempArg

	| iRMethod aCompiledMethod |
	iRMethod := IRBuilder new
		addTemps: #(c a);
		pushReceiver;
		pushLiteral: 1;
		storeTemp: #a;
		popTop;
		pushClosureCopyCopiedValues: #(a) args: #(e) jumpTo: #block;
		addTemps: #(d);  "the temp"
		pushTemp: #a;
		pushTemp: #e;
		send: #+;
		storeTemp:  #d;
		popTop;
		pushTemp: #d;
		blockReturnTop;
		jumpAheadTarget: #block;	
		pushLiteral: 1;
		send: #value:;
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2).
	^iRMethod
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'MarcusDenker 6/19/2012 14:57'!
testJumpAheadToIf

	| iRMethod aCompiledMethod |
	
	iRMethod := IRBuilder new
		pushReceiver;
		pushLiteral: true;
		jumpAheadTo: #end if: true;
		returnTop;
		jumpAheadTarget: #end;	
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
 	self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) isNil).
	^iRMethod.
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'JB 8/19/2010 16:46'!
testPushTempArgument

	| iRMethod aCompiledMethod  |
	iRMethod := IRBuilder new
		numArgs: 2;
		addTemps: #(a b);
		pushTemp: #a;
		pushTemp: #b;
		send: #+;
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.


	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #(2 8) ) = 10).
	^iRMethod
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'MarcusDenker 8/20/2010 22:42'!
testPushThisContext

	| iRMethod aCompiledMethod  |
	iRMethod := IRBuilder new
		pushThisContext;
		send: #receiver;
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
	self assert: ((aCompiledMethod valueWithReceiver: 5 arguments: #() ) = 5).
	^iRMethod
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'MarcusDenker 7/4/2011 16:59'!
testReturnInstVar

	| iRMethod aCompiledMethod  |
	iRMethod := IRBuilder new
		pushInstVar: 1;
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
 	self assert: ((aCompiledMethod valueWithReceiver: (3@4) arguments: #() ) = 3).
	^iRMethod
	
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'MarcusDenker 8/25/2010 14:25'!
testStorePopIvar

	| iRMethod aCompiledMethod  |
	iRMethod := IRBuilder new
		pushLiteral: 34;
		storeInstVar: 2;
		popTop;
		pushInstVar: 2;
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
 	self assert: ((aCompiledMethod valueWithReceiver: self arguments: #() ) = 34).
	^iRMethod
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'MarcusDenker 8/18/2010 19:00'!
testStoreTemp

	| iRMethod aCompiledMethod  |
	iRMethod := IRBuilder new
		addTemps: #(a);
		pushLiteral: 34;
		storeTemp: #a;
		popTop;
		pushTemp: #a;
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
 	self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = 34).
	^iRMethod
	! !

!IRBuilderTest class methodsFor: 'accessing' stamp: 'ms 7/12/2006 18:43'!
testToPush
	^TestToPush! !

!IRBuilderTest class methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 5/13/2013 14:47'!
compilerClass
	^ OpalCompiler! !

!IRBuilderTest class methodsFor: 'accessing' stamp: 'ms 7/12/2006 18:43'!
testToPush: anObject

	TestToPush := anObject! !

!IRBytecodeDecompiler commentStamp: 'ajh 3/25/2003 00:26'!
I interpret bytecode instructions, sending the appropriate instruction messages to my IRBuilder, resulting in an IRMethod.!
!IRBytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ToonVerwaest 3/28/2011 18:21'!
pushConstant: value
	irBuilder pushLiteral: value! !

!IRBytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ToonVerwaest 3/24/2011 23:10'!
storeIntoReceiverVariable: offset
	irBuilder storeInstVar: offset + 1.
! !

!IRBytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ToonVerwaest 3/24/2011 23:10'!
storeIntoTemporaryVariable: offset
	irBuilder storeTemp: (self scope tempAt: offset)! !

!IRBytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'MarcusDenker 6/8/2012 13:50'!
blockReturnTop
	self popScope.
	irBuilder blockReturnTop.! !

!IRBytecodeDecompiler methodsFor: 'private' stamp: 'MarcusDenker 4/29/2013 17:39'!
methodClass
	^ instructionStream  method methodClass! !

!IRBytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ToonVerwaest 3/24/2011 23:09'!
popIntoLiteralVariable: offset
	self storeIntoLiteralVariable: offset.
	self doPop.! !

!IRBytecodeDecompiler methodsFor: 'scope' stamp: 'ToonVerwaest 3/31/2011 14:54'!
popScope
	| scope tempIndex |
	scope := self scope.
	
	irBuilder addTemps: scope temps.
	
	" Remap your own temp vectors "
	scope ownTempVectors do: [ :tempVector |
		irBuilder
			remapTemp: (scope -> tempVector index)
			toRemote: tempVector ].
	
	" Remap the copied values "
	tempIndex := scope numArgs.
	scope copiedValues do: [ :copiedValue |
		irBuilder
			remapTemp: (scope -> tempIndex)
			toRemote: copiedValue.
		tempIndex := tempIndex + 1. ].
	
	^ scopeStack pop! !

!IRBytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'MarcusDenker 11/11/2011 15:51'!
send: selector super: superFlag numArgs: numArgs
	superFlag
		ifTrue: [irBuilder send: selector toSuperOf: self methodClass]
		ifFalse: [irBuilder send: selector]! !

!IRBytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ToonVerwaest 3/24/2011 23:08'!
jump: dist if: bool
	| index |
	index := instructionStream pc + dist .

	dist >= 0 ifTrue: [
		"conditional jump forward"
		^ irBuilder jumpAheadTo: index if: bool ].

	self error: 'Should not do this'! !

!IRBytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'MarcusDenker 6/13/2012 13:23'!
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize 
	| closureEnd copiedValues |
	copiedValues := irBuilder removeLast: numCopied.
	self pushScope: copiedValues numArgs: numArgs.
	closureEnd := instructionStream pc + blockSize.
	
	irBuilder
		pushClosureCopyCopiedValues: copiedValues
		args: self scope args
		jumpTo: closureEnd.! !

!IRBytecodeDecompiler methodsFor: 'quick methods' stamp: 'ClementBera 1/28/2015 09:24'!
quickMethod

	instructionStream method primitive = 256 ifTrue: [
		^ self methodReturnReceiver
	]. 
	instructionStream method isReturnSpecial ifTrue: [
		^ self methodReturnConstant: (instructionStream method encoderClass specialLiterals at: instructionStream method primitive - 256)
	].
	instructionStream method isReturnField ifTrue: [
		self pushReceiverVariable: instructionStream method returnField.
		^ self methodReturnTop
	].
	self error: 'quick method inconsistency'! !

!IRBytecodeDecompiler methodsFor: 'scope' stamp: 'MarcusDenker 7/16/2012 16:05'!
pushScope: copiedValues numArgs: numArgs
	|scope |
	scope := IRBytecodeScope new numArgs: numArgs.
	scopeStack push: scope.
	scope copiedValues: copiedValues.! !

!IRBytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ToonVerwaest 3/24/2011 23:10'!
storeIntoLiteralVariable: value
	irBuilder storeIntoLiteralVariable: value! !

!IRBytecodeDecompiler methodsFor: 'scope' stamp: 'ToonVerwaest 3/24/2011 21:17'!
scope
	^ scopeStack top! !

!IRBytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'MarcusDenker 7/16/2012 16:06'!
pushNewArrayOfSize: size
	newTempVector := IRRemoteArray new size: size! !

!IRBytecodeDecompiler methodsFor: 'private' stamp: 'ToonVerwaest 3/24/2011 23:22'!
checkIfJumpTarget
	irBuilder testJumpAheadTarget: instructionStream pc! !

!IRBytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ToonVerwaest 3/24/2011 23:08'!
doPop
	irBuilder popTop! !

!IRBytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ToonVerwaest 3/27/2011 01:29'!
pushTemporaryVariable: offset
	irBuilder pushTemp: (self scope tempAt: offset)! !

!IRBytecodeDecompiler methodsFor: 'public access' stamp: 'MarcusDenker 10/3/2014 14:53'!
decompile: aCompiledMethod
	instructionStream := InstructionStream on: aCompiledMethod.
	irBuilder := IRReconstructor new.
	scopeStack := Stack new.
	self pushScope: #() numArgs: aCompiledMethod numArgs.
	irBuilder irPrimitive: aCompiledMethod irPrimitive.
	
	aCompiledMethod hasProperties ifTrue: [irBuilder properties: aCompiledMethod properties copy].
	irBuilder numArgs: aCompiledMethod numArgs.
	irBuilder addTemps: self scope args.
	aCompiledMethod isQuick
		ifTrue: [self quickMethod]
		ifFalse: [self interpret].
	self popScope.
	"just add all literals of the compiledMethod as additional literals.
	 duplicates will be filtered out, but we keep the optimized ones"
	irBuilder additionalLiterals: (aCompiledMethod literals allButLast: 2).
	"when compiling methods of context classes, force long form for iVar access by getting the correct context"
	irBuilder compilationContext: aCompiledMethod methodClass compiler compilationContext.
	^ irBuilder ir.! !

!IRBytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'MarcusDenker 6/13/2012 13:33'!
methodReturnTop
	irBuilder isLastClosureInstruction
		ifTrue: [
			self popScope.
			irBuilder fixPushNilsForTemps.
			irBuilder returnTop.
			irBuilder popScope. ]
		ifFalse: [ irBuilder returnTop ]! !

!IRBytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ToonVerwaest 3/24/2011 23:09'!
popIntoReceiverVariable: offset
	self storeIntoReceiverVariable: offset.
	self doPop.! !

!IRBytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ToonVerwaest 3/24/2011 23:09'!
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
	self storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex.
	self doPop.
	! !

!IRBytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'MarcusDenker 6/19/2012 11:41'!
jump: dist
	| index seq instr newSeq seqs |
	index := instructionStream pc + dist .

	dist >= 0 ifTrue: [
		"jump forward"
		^ irBuilder jumpAheadTo: index ].
	"jump to the jump instuction itself"
	dist >= -2 ifTrue: 
		[	irBuilder jumpBackTarget: index.
			irBuilder jumpBackTo: index.
		^self].
	"jump backward"
	seqs := irBuilder ir allSequences.
	seq := seqs findLast: [:s | s notEmpty and: [s first bytecodeIndex <= index]].
	seq := seqs at: seq.
	seq first bytecodeIndex = index
		ifTrue: [ newSeq := seq ]
		ifFalse: [
			instr := seq detect: [:i | (seq after: i) bytecodeIndex = index].
			newSeq := seq splitAfter: instr ].
	irBuilder addJumpBackTarget: index to: newSeq.
	"if we have split the currentSequence of the irBuilder, make sure to set it
	to the newSeq".	
	irBuilder currentSequence = seq ifTrue: [irBuilder currentSequence: newSeq].
	irBuilder jumpBackTo: index.

! !

!IRBytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ToonVerwaest 3/24/2011 23:09'!
pushConsArrayWithElements: numElements 
	irBuilder pushConsArray: numElements
! !

!IRBytecodeDecompiler methodsFor: 'quick methods' stamp: 'ToonVerwaest 3/24/2011 23:08'!
methodReturnConstant: value
	self pushConstant: value.
	self methodReturnTop.! !

!IRBytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ToonVerwaest 3/24/2011 23:09'!
pushActiveContext
	irBuilder pushThisContext! !

!IRBytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ToonVerwaest 3/25/2011 17:13'!
storeIntoRemoteTemp: remoteIndex inVectorAt: tempIndex 
	|  remoteArray remoteTempName |
	remoteArray := self scope tempAt: tempIndex.
	remoteTempName := self scope tempAt: remoteIndex inRemote: remoteArray.	
	irBuilder storeRemoteTemp: remoteTempName inVector: remoteArray.
	! !

!IRBytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'MarcusDenker 6/13/2012 17:07'!
interpret
	| endPC |
	endPC := instructionStream method endPC.
	[instructionStream pc > endPC ] 
		whileFalse: [
			self checkIfJumpTarget.
			irBuilder mapToByteIndex: instructionStream pc.
			instructionStream interpretNextInstructionFor: self.]! !

!IRBytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ToonVerwaest 3/24/2011 23:10'!
pushReceiverVariable: offset
	irBuilder pushInstVar: offset + 1.
! !

!IRBytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ToonVerwaest 3/28/2011 18:19'!
pushLiteralVariable: assoc
	irBuilder pushLiteralVariable: assoc.! !

!IRBytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ToonVerwaest 3/25/2011 17:13'!
pushRemoteTemp: remoteIndex inVectorAt: tempIndex 
	|  remoteArray remoteTempName |
	remoteArray := self scope tempAt: tempIndex.
	remoteTempName := self scope tempAt: remoteIndex inRemote: remoteArray.
	irBuilder pushRemoteTemp: remoteTempName inVector: remoteArray.! !

!IRBytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ToonVerwaest 3/24/2011 23:09'!
pushReceiver
	irBuilder pushReceiver! !

!IRBytecodeDecompiler methodsFor: 'quick methods' stamp: 'MarcusDenker 6/19/2012 11:48'!
methodReturnReceiver
	self pushReceiver.
	self methodReturnTop.! !

!IRBytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ToonVerwaest 3/24/2011 15:40'!
doDup
	irBuilder pushDup! !

!IRBytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ToonVerwaest 3/27/2011 15:25'!
popIntoTemporaryVariable: offset
	newTempVector
		ifNil: [
			self storeIntoTemporaryVariable: offset.
			self doPop. ]
		ifNotNil: [
			self scope newTempVector: newTempVector at: offset.
			" Keep offset for remapping in popScope "
			newTempVector index: offset.
			irBuilder createTempVectorNamed: newTempVector withVars: newTempVector.
			newTempVector := nil ]! !

!IRBytecodeGenerator commentStamp: 'ClementBera 1/27/2015 13:07'!
Handles the byte code generation of jumps, literals and similar things. Byte code independent. The encoder is bytecode dependent.

I generate bytecodes in response to 'instructions' messages being sent to me.  I rewrite jumps at the end so their jump offsets are correct (see #bytecodes).  For example, to create a compiled method that compares first instVar to first arg and returns 'yes' or 'no' (same example as in IRBuilder), do:

	BytecodeGenerator new
		numArgs: 1;
		pushInstVar: 1;
		pushTemp: 1;
		send: #>;
		if: false goto: #else;
		pushLiteral: 'yes';
		returnTop;
		label: #else;
		pushLiteral: 'no';
		returnTop;
		compiledMethod

You can send #ir to the compiledMethod to decompile to its IRMethod, and you can send #methodNode to either to decompile to its parse tree.


Instance Variables
	additionalLiterals:		<OCLiteralSet> Those are literals evaluated for effect and optimized control flow messages selectors used in the method in order to be able to do sendersOf: on these literals with success.
	bytes:		<OrderedCollection of bytes> current sequence of bytecodes being written 
	encoder:		<BytecodeEncoder> Set the one you need depending on which bytecode set you want to use.
	forceLongForm:		<Boolean> true if instance variable access requires a long form (typically, Context access)
		
	Following inst vars are used to map bytecode pc to IR instruction	
	instrMap:		<OrderedCollection>
	instrMaps:		<IdentityDictionary of OrderedCollection>
			
	lastLiteral:		<Behavior> Basically in the case you would compile without annotating the method with its class and its selector, this literal is used to enforce the method class to be a literal to allow super sends.
	lastSpecialReturn:		<Message> used to generate quick returns
	literals:		<OCLiteralList> literals of the methods
	numArgs:		<Smi> number of arguments of the method
	numberOfTemps:		<Smi> number of temps of the method
	primNumber:		<Smi> primitive number (or 0)
	properties:		<AdditionalMethodState | nil> used to hold the additional method state (pragmas for examples)
			
	Following inst vars are used to correctly map the jumps (See #initialize for extra information)
	orderSeq:		<OrderedCollection> Reverse map of seq order
	seqBytes:		<IdentityDictionary>
	seqOrder:		<IdentityDictionary>
	jumps:		<IdentityDictionary>
	currentSeqId:		<Object>
	currentSeqNum:		<Smi>
			
	stack:		<Stack> simulated stack. Only simulates the depth of the stack. Store its maximum value in stacks instance variable.
	stacks:		<IdentityDictionary (seqId -> stackCount)> used to find out the maximum depth of the method and therefore set the largeFrameBit!
!IRBytecodeGenerator methodsFor: 'results' stamp: 'ClementBera 1/16/2015 15:32'!
bytecodes
	| stream |
	self updateJumpOffsets.
	stream := (ByteArray new: 100) writeStream.  
	orderSeq do: [ :seqId | 
			(instrMaps at: seqId) do: [ :assoc | assoc key bytecodeIndex: stream position + assoc value	"instr" ].
			stream nextPutAll: (seqBytes at: seqId) ].
	^ stream contents! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/23/2015 14:22'!
returnReceiver
	bytes ifEmpty: [ lastSpecialReturn := Message selector: #returnReceiver].
	encoder genReturnReceiver.
! !

!IRBytecodeGenerator methodsFor: 'private' stamp: 'ClementBera 1/16/2015 15:29'!
addLastLiteral: object
	lastLiteral ifNil: [ ^ lastLiteral := object ].
	((lastLiteral literalEqual: object)
		or: [ 
			"case of metaclass, they have no unique association"
			(lastLiteral isKindOf: Association) and: [ lastLiteral key isNil ] ])
		ifFalse: [ self error: 'there can only be one last literal' ]! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/23/2015 14:01'!
pushConsArray: size
	stack push.
	stack pop: size.
	encoder genPushConsArray: size! !

!IRBytecodeGenerator methodsFor: 'initialize' stamp: 'cb 1/27/2015 13:32'!
initialize

	super initialize.

	encoder := self encoderClass new.
	encoder stream: self.
	
	primNumber := 0.
	
	literals := OCLiteralList new.
	"The following dicts are keyed by sequence id given by client in label: (and gotos)."
	seqOrder := IdentityDictionary new.  "seqId -> seq order num"
	seqBytes := IdentityDictionary new.  "seqId -> seq bytecodes"
	jumps := IdentityDictionary new.  "seqId -> last jump instr"
	instrMaps := IdentityDictionary new.  "seqId -> (clientInstr -> bytecode pos)"
	stacks := IdentityDictionary new.  "seqId -> stackCount"
	numArgs := 0.
	currentSeqNum := 0.
	orderSeq := OrderedCollection new.  "reverse map of seqOrder"
	additionalLiterals := OCLiteralSet new.
	forceLongForm := false.
	"starting label in case one is not provided by client"
	self label: self newDummySeqId.
	

	! !

!IRBytecodeGenerator methodsFor: 'accessing' stamp: 'ClementBera 1/16/2015 15:32'!
properties: propDict
	properties := propDict.! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/23/2015 14:57'!
pushInstVar: instVarIndex
	stack push.
	forceLongForm
		ifTrue: [ encoder genPushInstVarLong: instVarIndex - 1 ]
		ifFalse: [ encoder genPushInstVar: instVarIndex - 1 ]! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/23/2015 15:14'!
jump: distance if: condition
	distance = 0
		ifTrue: [ ^ encoder genPop ].
	condition
		ifTrue: [ encoder genBranchPopTrue: distance ]
		ifFalse: [ encoder genBranchPopFalse: distance ]
		! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/23/2015 15:06'!
storeTemp: index
	encoder genStoreTemp: index - 1! !

!IRBytecodeGenerator methodsFor: 'private' stamp: 'ClementBera 1/16/2015 15:29'!
pragmas: aCollection
	aCollection do: [:each | self addPragma: each]! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/23/2015 15:47'!
storeIntoLiteralVariable: object 
	encoder genStoreLiteralVar: (self literalIndexOf: object). ! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/23/2015 15:28'!
storeRemoteTemp: tempIndex inVectorAt: tempVectorIndex 
	encoder genStoreRemoteTemp: tempIndex - 1 inVectorAt: tempVectorIndex - 1! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'ClementBera 1/16/2015 15:32'!
label: seqId
	lastSpecialReturn := nil.
	currentSeqId := seqId.
	currentSeqNum := currentSeqNum + 1.
	seqOrder at: seqId put: currentSeqNum.
	orderSeq at: currentSeqNum ifAbsentPut: [seqId].
	bytes := seqBytes at: seqId ifAbsentPut: [OrderedCollection new].
	jumps at: seqId ifAbsentPut: [nil].
	instrMap := instrMaps at: seqId ifAbsentPut: [OrderedCollection new].
	stack := stacks at: currentSeqId ifAbsentPut: [IRStackCount new]
	! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/19/2015 17:23'!
pushThisContext

	stack push.
	encoder genPushThisContext ! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/23/2015 14:10'!
pushDup
	stack push.
	encoder genDup! !

!IRBytecodeGenerator methodsFor: 'private' stamp: 'ClementBera 1/16/2015 15:29'!
updateJump: seqId
	"Recalculate final jump bytecodes.  Return true if jump bytecodes SIZE has changed, otherwise return false"
	| pair s1 |
	pair := jumps at: seqId.
	pair ifNil: [^ false].  "no jump, a return"
	bytes := seqBytes  at: seqId.
	s1 := bytes size.
	bytes removeLast: (bytes size - pair first).
	pair last sendTo: self.
	^ s1 ~= bytes size.! !

!IRBytecodeGenerator methodsFor: 'accessing' stamp: 'ClementBera 1/16/2015 15:32'!
properties
	^ properties! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/16/2015 16:11'!
returnTop
	stack pop.
	encoder genReturnTop! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/20/2015 15:33'!
jumpForward: distance

	distance = 0 ifTrue: [^ self].  
	encoder genJump: distance.
! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/23/2015 15:36'!
jumpBackward: distance

	encoder genJumpLong: distance negated - self encoderClass backJumpBytecodeSize! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/23/2015 14:46'!
pushLiteral: object
	stack push.
	"identity includes else 0.0 = 0 whereas it's a Float" 
	(self encoderClass specialLiterals identityIncludes: object) ifTrue: [ 
		^ encoder genPushSpecialLiteral: object ].
	encoder genPushLiteral: (self literalIndexOf: object)
! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/23/2015 15:05'!
storePopTemp: index
	stack pop. 
	encoder genStorePopTemp: index - 1! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/20/2015 15:24'!
popTop
	stack pop.
	encoder genPop! !

!IRBytecodeGenerator methodsFor: 'results' stamp: 'ClementBera 1/16/2015 15:32'!
compiledMethod

	^ self compiledMethodWith: CompiledMethodTrailer empty! !

!IRBytecodeGenerator methodsFor: 'private' stamp: 'ClementBera 1/16/2015 15:29'!
updateJumpOffsets
	[ orderSeq 
		inject: false 
		into: [ :changed :seqId | (self updateJump: seqId) or: [ changed ]] 
	] whileTrue! !

!IRBytecodeGenerator methodsFor: 'accessing' stamp: 'ClementBera 1/27/2015 16:38'!
encoderClass: class
	encoderClass := class  ! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/23/2015 15:50'!
storePopIntoLiteralVariable: assoc

	encoder genStorePopLiteralVar: (self literalIndexOf: assoc).
	stack pop! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/23/2015 15:06'!
pushTemp: index
	stack push.
	encoder genPushTemp: index - 1! !

!IRBytecodeGenerator methodsFor: 'private' stamp: 'ClementBera 1/16/2015 15:29'!
from: fromSeqId goto: toSeqId

	| distance from to |
	from := seqOrder at: fromSeqId.
	to := seqOrder at: toSeqId ifAbsent: [^ self].
	from + 1 = to ifTrue: [^ self].  "fall through, no jump needed"

	from < to ifTrue: [ "jump forward"
		distance := (from + 1 to: to - 1) inject: 0 into: [:size :i | 
				size + (seqBytes at: (orderSeq at: i)) size].
		self jumpForward: distance.
	] ifFalse: [ "jump backward"
		distance := ((to to: from - 1) inject: 0 into: [:size :i |
				size + (seqBytes at: (orderSeq at: i)) size])
			+ bytes size.
		self jumpBackward: distance.
	].
! !

!IRBytecodeGenerator methodsFor: 'accessing' stamp: 'KevinLanvin 1/16/2015 16:13'!
primNum
	^ primNumber ! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/23/2015 15:27'!
pushRemoteTemp: tempIndex inVectorAt: tempVectorIndex
	stack push.
	encoder genPushRemoteTemp: tempIndex - 1 inVectorAt: tempVectorIndex - 1! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/23/2015 14:39'!
pushNClosureTemps: n
	n = 0 ifTrue: [ ^ self ].
	encoder genPushNClosureTemps: n.! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/19/2015 17:24'!
pushReceiver
	stack push.
	encoder genPushReceiver ! !

!IRBytecodeGenerator methodsFor: 'results' stamp: 'ClementBera 1/16/2015 15:32'!
literals
	literals := literals asArray.	"Put the optimized selectors in literals so as to browse senders more easily"
	additionalLiterals := additionalLiterals asArray reject: [ :e | literals hasLiteral: e ].
	additionalLiterals isEmpty
		ifFalse: [ 
			"Use one entry per literal if enough room, else make anArray"
			literals := literals size + additionalLiterals size + 2 > 255
				ifTrue: [ literals copyWith: additionalLiterals ]
				ifFalse: [ literals , additionalLiterals ] ].
	(literals anySatisfy: [ :each | each isMethodProperties ])
		ifFalse: [ literals := literals copyWith: nil ].
	^ lastLiteral ifNil: [ literals copyWith: nil ] ifNotNil: [ literals copyWith: lastLiteral ]! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/23/2015 13:43'!
closureFrom: fromSeqId to: toSeqId copyNumCopiedValues: numCopied numArgs: numArgs2
	| distance from to |
	from := seqOrder at: fromSeqId.
	to := seqOrder at: toSeqId ifAbsent: [ ^ self ].	"not done yet"
	distance := (from + 1 to: to - 1) inject: 0 into: [ :size :i | size + (seqBytes at: (orderSeq at: i)) size ].
	encoder genPushClosureCopyNumCopiedValues: numCopied numArgs: numArgs2 jumpSize: distance. ! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/23/2015 15:03'!
blockReturnTop
	encoder genReturnTopToCaller
! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/23/2015 14:25'!
returnConstant: constant
	bytes ifEmpty: [ lastSpecialReturn := Message selector: #returnConstant: argument: constant ].
	(#(nil true false) includes: constant) ifTrue: 
		[ ^ encoder genReturnSpecialLiteral:constant ].
	self pushLiteral: constant.
	self returnTop! !

!IRBytecodeGenerator methodsFor: 'private' stamp: 'ClementBera 1/27/2015 15:50'!
quickMethodPrim

	| index |
	self numArgs = 0 ifFalse: [^ 0].
	lastSpecialReturn ifNil: [^ 0].
	(seqBytes  size <= 2) ifFalse: [^ 0].
	"this is for ruling out the case in which the structure is the same as a quick return
	but with and invalid special literal."
	((literals size = 1) and: [ (self encoderClass specialLiterals identityIncludes: literals first) not and: [ lastSpecialReturn selector = #returnConstant: ] ] )
		ifTrue: [^ 0].
	lastSpecialReturn selector == #returnReceiver 
		ifTrue: [^256].
	lastSpecialReturn selector == #returnConstant:
		 ifTrue: [^(index := self encoderClass specialLiterals identityIndexOf: lastSpecialReturn argument) > 0
					ifTrue: [256 + index] ifFalse: [0]].
	lastSpecialReturn selector == #returnInstVar: 
		ifTrue: [^forceLongForm 
					ifTrue: [0]  "when compiling long bytecodes for Contexts, do not do quick return either"
					ifFalse: [263 + lastSpecialReturn argument]]
	! !

!IRBytecodeGenerator methodsFor: 'private' stamp: 'ClementBera 1/16/2015 15:29'!
addLiteral: object
	literals add: object.
	^ literals identityIndexOf: object! !

!IRBytecodeGenerator methodsFor: 'results' stamp: 'ClementBera 2/24/2015 16:21'!
spurVMHeader: literalsSize
	^ (CompiledMethod headerFlagForEncoder: self encoderClass) +
		(self numArgs bitShift: 24) +
		( self numTemps bitShift: 18) +
		literalsSize +
		(self hasPrimitive asBit bitShift: 16)! !

!IRBytecodeGenerator methodsFor: 'results' stamp: 'ClementBera 1/16/2015 15:32'!
addProperties: cm
	"set the properties of cm according to properties saved"
	properties ifNotNil: [
		cm penultimateLiteral: properties.
		properties  method: cm.
		properties  pragmas do: [:each | each method: cm] ].! !

!IRBytecodeGenerator methodsFor: 'mapping' stamp: 'ClementBera 1/16/2015 15:29'!
mapBytesTo: instr
	"Associate the current byte offset with instr. We fix this later to have the correct offset,
	see #bytecodes"

	instrMap add: instr -> bytes size! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/23/2015 15:53'!
storeInstVar: index 
	forceLongForm 
		ifTrue: [ encoder genStoreInstVarLong: index - 1 ]
		ifFalse: [ encoder genStoreInstVar: index - 1 ]! !

!IRBytecodeGenerator methodsFor: 'private' stamp: 'ClementBera 1/16/2015 15:29'!
from: fromSeqId if: bool goto: toSeqId otherwise: otherwiseSeqId

	| distance from to otherwise |
	from := seqOrder at: fromSeqId.
	to := seqOrder at: toSeqId ifAbsent: [^ self jump: 0 if: bool].  "not done yet"
	otherwise := seqOrder at: otherwiseSeqId ifAbsent: [^ self jump: 0 if: bool].  "not done yet"
	from < to ifFalse: [self error].
	from + 1 = otherwise ifFalse: [self error].
	distance := (from + 1 to: to - 1)
		inject: 0
		into: [:size :i | size + (seqBytes at: (orderSeq at: i)) size].
	self jump: distance if: bool.
! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/19/2015 14:56'!
if: bool goto: seqId
	| otherwiseSeqId |
	otherwiseSeqId := self newDummySeqId.
	self if: bool goto: seqId otherwise: otherwiseSeqId.
	self label: otherwiseSeqId! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/23/2015 15:44'!
send: selector toSuperOf: behavior

	| index nArgs |
	nArgs := selector numArgs.
	stack pop: nArgs.

	self addLastLiteral: behavior binding.  
	index := self literalIndexOf: selector.
	encoder genSendSuper: index numArgs: nArgs
! !

!IRBytecodeGenerator methodsFor: 'initialize' stamp: 'ClementBera 1/16/2015 15:27'!
irPrimitive: anIrPrimitive
	literals isEmpty ifFalse: [self error: 'init prim before adding instructions'].
	anIrPrimitive spec ifNotNil: [literals add: anIrPrimitive spec].
	primNumber := anIrPrimitive num.
	primNumber = 0 ifTrue: [ ^ self ].
	self encoderClass callPrimitiveCode ifNil: [ ^ self ].
	encoder genCallPrimitive: primNumber! !

!IRBytecodeGenerator methodsFor: 'results' stamp: 'ClementBera 1/27/2015 15:09'!
compiledMethodWith: trailer
	| lits header |
	lits := self literals.
	header := Smalltalk vm isSpur ifTrue: [ self spurVMHeader: lits size ] ifFalse: [ self v3VMHeader: lits size ].
	^ self compiledMethodWith: trailer header: header literals: lits! !

!IRBytecodeGenerator methodsFor: 'accessing' stamp: 'ClementBera 1/16/2015 15:32'!
additionalLiterals: aSet
	additionalLiterals := aSet.
	! !

!IRBytecodeGenerator methodsFor: 'accessing' stamp: 'ClementBera 1/27/2015 16:38'!
encoderClass
	^ encoderClass  ! !

!IRBytecodeGenerator methodsFor: 'results' stamp: 'ClementBera 1/27/2015 15:08'!
compiledMethodWith: trailer header: header literals: lits
	| cm |
	cm := trailer createMethod: self bytecodes size class: CompiledMethod header: header.
	(WriteStream with: cm)
		position: cm initialPC - 1;
		nextPutAll: self bytecodes.
	lits withIndexDo: [:obj :i | cm literalAt: i put: obj].
	cm needsFrameSize: self stackFrameSize.
	
	self addProperties: cm.
	^ cm! !

!IRBytecodeGenerator methodsFor: 'results' stamp: 'ClementBera 1/27/2015 15:03'!
hasPrimitive
	^ primNumber > 0! !

!IRBytecodeGenerator methodsFor: 'results' stamp: 'ClementBera 1/27/2015 15:47'!
v3VMHeader: literalsSize
	| header primBits endPrimNumber |
	self encoderClass isAlternateBytecodeSet ifTrue: [ self error: 'SistaV1 non supported in non spur VM'].
	endPrimNumber := self endPrimNumber.
	primBits := endPrimNumber <= 16r1FF
		ifTrue: [endPrimNumber]
		ifFalse: ["For now the high bit of primitive no. is in the 29th bit of header"
				(endPrimNumber bitAnd: 16r1FF) + ((endPrimNumber bitAnd: 16r200) bitShift: 19)].
	header := (self numArgs bitShift: 24) +
				(self numTemps bitShift: 18) +
				(literalsSize bitShift: 9) +
				primBits.
	^ header! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/23/2015 13:59'!
pushNewArray: size
	stack push.
	encoder genPushNewArray: size! !

!IRBytecodeGenerator methodsFor: 'accessing' stamp: 'ClementBera 1/16/2015 15:32'!
numTemps: anInteger

	numberOfTemps := anInteger! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/23/2015 14:02'!
returnInstVar: index 
	bytes ifEmpty: [
		lastSpecialReturn := Message selector: #returnInstVar: argument: index].
	self pushInstVar: index.
	self returnTop.
! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/19/2015 14:56'!
goto: seqId
	stacks at: seqId put: (stack linkTo: (stacks at: seqId ifAbsentPut: [ nil ])).
	self
		saveLastJump:
			(Message
				selector: #from:goto:
				arguments:
					{currentSeqId.
					seqId}).
	self from: currentSeqId goto: seqId! !

!IRBytecodeGenerator methodsFor: 'private' stamp: 'ClementBera 1/16/2015 15:29'!
nextPut: byte

	bytes add: byte! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/23/2015 14:57'!
storePopInstVar: index 
	stack pop.
	forceLongForm 
		ifTrue: [ encoder genStorePopInstVarLong: index - 1 ]
		ifFalse: [ encoder genStorePopInstVar: index - 1 ]! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/19/2015 14:55'!
if: bool goto: seqId1 otherwise: seqId2
	stack pop.
	stacks at: seqId1 put: (stack linkTo: (stacks at: seqId1 ifAbsentPut: [ nil ])).
	stacks at: seqId2 put: (stack linkTo: (stacks at: seqId2 ifAbsentPut: [ nil ])).
	self
		saveLastJump:
			(Message
				selector: #from:if:goto:otherwise:
				arguments:
					{currentSeqId.
					bool.
					seqId1.
					seqId2}).
	self
		from: currentSeqId
		if: bool
		goto: seqId1
		otherwise: seqId2! !

!IRBytecodeGenerator methodsFor: 'accessing' stamp: 'ClementBera 1/16/2015 15:32'!
forceLongForm: aBoolean
	forceLongForm := aBoolean! !

!IRBytecodeGenerator methodsFor: 'accessing' stamp: 'ClementBera 1/16/2015 15:32'!
numArgs: n

	numArgs := n! !

!IRBytecodeGenerator methodsFor: 'private' stamp: 'KevinLanvin 1/23/2015 14:21'!
literalIndexOf: object

	| index |
	
	(index := literals literalIndexOf: object ifAbsent: 0) > 0 ifFalse: [
		index := self addLiteral: object].
	
	"conversion from 1 based to 0 based"
	^ index - 1! !

!IRBytecodeGenerator methodsFor: 'results' stamp: 'ClementBera 1/16/2015 15:32'!
stackFrameSize
	^ (stacks collect: [:s | s length]) max! !

!IRBytecodeGenerator methodsFor: 'private' stamp: 'ClementBera 1/16/2015 15:29'!
saveLastJump: message
	jumps at: currentSeqId put: {bytes size. message}.
 ! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/19/2015 14:55'!
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs2 to: toSeqId
	| blockSeqId |
	blockSeqId := self newDummySeqId.
	stack pop: numCopied.
	stacks at: blockSeqId put: (stack linkTo: (stacks at: blockSeqId ifAbsentPut: [ nil ])).
	stack push.
	stacks at: toSeqId put: (stack linkTo: (stacks at: toSeqId ifAbsentPut: [ nil ])).
	self
		saveLastJump:
			(Message
				selector: #closureFrom:to:copyNumCopiedValues:numArgs:
				arguments:
					{currentSeqId.
					toSeqId.
					numCopied.
					numArgs2}).
	self
		closureFrom: currentSeqId
		to: toSeqId
		copyNumCopiedValues: numCopied
		numArgs: numArgs2.
	self label: blockSeqId! !

!IRBytecodeGenerator methodsFor: 'accessing' stamp: 'ClementBera 1/16/2015 15:32'!
numArgs

	^ numArgs! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/23/2015 15:28'!
storePopRemoteTemp: tempIndex inVectorAt: tempVectorIndex 
	stack pop.
	encoder genStorePopRemoteTemp: tempIndex - 1 inVectorAt: tempVectorIndex - 1! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/23/2015 15:50'!
pushLiteralVariable: object 
	stack push.
	encoder genPushLiteralVar: (self literalIndexOf: object).! !

!IRBytecodeGenerator methodsFor: 'accessing' stamp: 'ClementBera 1/16/2015 15:32'!
numTemps

	^ numberOfTemps! !

!IRBytecodeGenerator methodsFor: 'private' stamp: 'ClementBera 1/16/2015 15:29'!
newDummySeqId

	^ Object new! !

!IRBytecodeGenerator methodsFor: 'results' stamp: 'ClementBera 1/27/2015 15:17'!
endPrimNumber
	^ primNumber > 0
			ifTrue: [ primNumber ]
			ifFalse: [ self quickMethodPrim ]! !

!IRBytecodeGenerator methodsFor: 'private' stamp: 'ClementBera 1/16/2015 15:29'!
addPragma: aPragma
	properties ifNil: [ properties := AdditionalMethodState new ].
	properties := properties copyWith: aPragma. 

	
	! !

!IRBytecodeGenerator methodsFor: 'instructions' stamp: 'KevinLanvin 1/23/2015 14:07'!
send: selector
	| nArgs |
	nArgs := selector numArgs.
	stack pop: nArgs.
	(self encoderClass specialSelectors includes: selector)
		ifTrue: [ ^ encoder genSendSpecial: (self encoderClass specialSelectors indexOf: selector) numArgs: nArgs ].
	encoder genSend: (self literalIndexOf: selector) numArgs: nArgs! !

!IRBytecodeGenerator class methodsFor: 'instance creation' stamp: 'ClementBera 1/28/2015 09:26'!
newWithEncoderClass: class
	^ self basicNew 
		encoderClass: class;
		initialize;
		yourself! !

!IRBytecodeScope commentStamp: '<historical>'!
I am an internal class used by the  decompiler to recreat variable information!
!IRBytecodeScope methodsFor: 'accessing' stamp: 'ToonVerwaest 3/27/2011 14:55'!
ownTempVectors
	^ ownTempVectors! !

!IRBytecodeScope methodsFor: 'accessing' stamp: 'ToonVerwaest 3/27/2011 16:21'!
tempAt: zeroBasedIndex
	temps := temps max: zeroBasedIndex + 1.
	^ self -> zeroBasedIndex! !

!IRBytecodeScope methodsFor: 'initialization' stamp: 'ToonVerwaest 3/27/2011 14:49'!
initialize
	temps := 0.
	ownTempVectors := OrderedCollection new! !

!IRBytecodeScope methodsFor: 'accessing' stamp: 'ToonVerwaest 3/31/2011 14:59'!
temps
	| result tempOffset numTemps |
	tempOffset := copiedValues size + numArgs.
	numTemps := temps - tempOffset.
	result := Array new: numTemps.
	tempOffset := tempOffset - 1.
	1 to: numTemps do: [ :idx | result at: idx put: self -> (tempOffset + idx)  ].
	ownTempVectors do: [ :tempVector | result at: tempVector index - tempOffset put: tempVector ].
	^ result! !

!IRBytecodeScope methodsFor: 'accessing' stamp: 'ToonVerwaest 3/27/2011 13:08'!
numArgs
	^ numArgs! !

!IRBytecodeScope methodsFor: 'accessing' stamp: 'ToonVerwaest 3/27/2011 13:43'!
args
	| args |
	args := Array new: numArgs.
	1 to: numArgs do: [ :idx | args at: idx put: self -> (idx - 1)].
	^ args! !

!IRBytecodeScope methodsFor: 'accessing' stamp: 'ToonVerwaest 3/27/2011 12:37'!
tempAt: remoteIndex inRemote: remoteArray
	^ remoteIndex! !

!IRBytecodeScope methodsFor: 'accessing' stamp: 'ToonVerwaest 3/27/2011 14:48'!
copiedValues: someCopiedValues
	copiedValues := someCopiedValues! !

!IRBytecodeScope methodsFor: 'accessing' stamp: 'ToonVerwaest 3/27/2011 14:52'!
copiedValues
	^ copiedValues! !

!IRBytecodeScope methodsFor: 'accessing' stamp: 'ToonVerwaest 3/27/2011 13:45'!
numArgs: anInteger
	numArgs := anInteger.
	temps := temps max: numArgs! !

!IRBytecodeScope methodsFor: 'accessing' stamp: 'ToonVerwaest 3/27/2011 14:51'!
newTempVector: aTempVector at: offset
	ownTempVectors add: aTempVector.
	self tempAt: offset! !

!IRFix commentStamp: 'ClementBera 10/27/2014 10:59'!
Fix the IR nodes.

Transforms:

store, pop => popInto
some returns => quick returns!
!IRFix methodsFor: 'private' stamp: 'ClementBer 10/14/2014 16:40'!
convertStorePop: assoc forSeq: seq 
	| store pop |
	store := assoc key.
	pop := assoc value.
	seq replaceNode: store withNode: (store popIntoNode sourceNode: store sourceNode).
	seq remove: pop.! !

!IRFix methodsFor: 'initialize' stamp: 'ClementBer 10/14/2014 16:21'!
initialize

	super initialize.

	storePopToFix := OrderedCollection new.
	retToFix := OrderedCollection new.! !

!IRFix methodsFor: 'private' stamp: 'ClementBer 10/14/2014 16:40'!
convertRet: assoc forSeq: seq 
	| push ret |
	push := assoc key.
	ret := assoc value.
	seq replaceNode: push withNode: (push quickRetNode sourceNode: ret sourceNode).
	seq remove: ret.! !

!IRFix methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 15:57'!
visitInstruction: instr
	self visitNode: instr.
	prevInstr := instr.! !

!IRFix methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:18'!
visitPop: pop
	prevInstr ifNil: [ ^ self ].
	prevInstr isStore ifFalse: [ ^ self ].
	"store then pop, however, cannot remove instr while iterating over the collection"
	storePopToFix add: prevInstr -> pop.
	
	! !

!IRFix methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:19'!
visitSequence: instructionSequence
	prevInstr := nil.
	storePopToFix reset.
	retToFix reset.
	super visitSequence: instructionSequence.
	retToFix do: [ :each | self convertRet: each forSeq: instructionSequence ].
	storePopToFix do: [ :each | self convertStorePop: each forSeq: instructionSequence ]! !

!IRFix methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:19'!
visitReturn: ret
	prevInstr ifNil: [ ^ self ].
	prevInstr canBeQuickReturn ifFalse: [ ^ self ].
	retToFix add: prevInstr -> ret.! !

!IRInstVarAccess commentStamp: '<historical>'!
I am a bytecode accessing an instance variable. As such, I have an index.!
!IRInstVarAccess methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 13:23'!
isInstVarAccess
	^ true! !

!IRInstVarAccess methodsFor: 'accessing' stamp: 'ClementBer 10/14/2014 13:23'!
index: anInteger
	index := anInteger! !

!IRInstVarAccess methodsFor: 'accessing' stamp: 'ClementBer 10/14/2014 13:23'!
index
	^ index! !

!IRInstruction commentStamp: '<historical>'!
I am an instruction in the IR (intermediate representation) language.  The IR serves as the intermediary between the Smalltalk language and the bytecode language.  It is easier to optimize and translate to/from this language than it is to optimize/translate directly from Smalltalk to bytecodes.  The IR is generic and simple consisting of just twelve instructions.  They are:

	goto: labelNum
	if: boolean goto: labelNum1 otherwise: labelNum2
	label: labelNum
	popTop
	pushDup
	pushLiteral: object
	pushTemp: name
	blockReturn
	returnTop
	send: selector
	send: selector toSuperOf: behavior
	storeTemp: name

Each instruction is reified as an instance of one of my subclasses and grouped by basic block (IRSequence) into an IRMethod.  IRInterpreter visits each instruction in a IRMethod responding to the above instruction messages sent to it.
!
!IRInstruction methodsFor: 'adding' stamp: 'md 7/9/2005 22:41'!
addInstructionsBefore: aCollection
	sequence addInstructions: aCollection before: self.! !

!IRInstruction methodsFor: 'testing' stamp: 'md 2/26/2005 16:22'!
isSelf
	^false! !

!IRInstruction methodsFor: 'testing' stamp: 'MarcusDenker 12/19/2012 08:07'!
isBlockReturnTop

	^false ! !

!IRInstruction methodsFor: 'testing' stamp: 'MarcusDenker 12/19/2012 08:07'!
isReturn

	^ false ! !

!IRInstruction methodsFor: 'testing' stamp: 'MarcusDenker 9/20/2013 13:26'!
isPushLiteral: valueTest

	^ false! !

!IRInstruction methodsFor: 'adding' stamp: 'md 7/9/2005 22:41'!
addInstructionsAfter: aCollection
	sequence addInstructions: aCollection after: self.! !

!IRInstruction methodsFor: 'mapping' stamp: 'ajh 3/13/2003 13:07'!
bytecodeIndex

	^ bytecodeIndex! !

!IRInstruction methodsFor: 'mapping' stamp: 'ajh 3/13/2003 13:14'!
bytecodeIndex: index

	bytecodeIndex := index! !

!IRInstruction methodsFor: 'testing' stamp: 'MarcusDenker 12/14/2012 11:52'!
isIf

	^ false ! !

!IRInstruction methodsFor: 'replacing' stamp: 'ClementBera 7/26/2013 15:48'!
replaceWith: aNode
	sequence ifNil: [self error: 'This node doesn''t have a sequence'].
	sequence replaceNode: self withNode: aNode! !

!IRInstruction methodsFor: 'testing' stamp: 'MarcusDenker 8/13/2010 14:25'!
isRead
	^false! !

!IRInstruction methodsFor: 'replacing' stamp: 'ClementBera 7/26/2013 15:48'!
replaceWithInstructions: aCollection 

	sequence ifNil: [self error: 'This node doesn''t have a sequence'].
	sequence replaceNode: self withNodes: aCollection! !

!IRInstruction methodsFor: 'inspector' stamp: 'MarcusDenker 10/21/2014 10:44'!
children
	^#()! !

!IRInstruction methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 13:17'!
accept: aVisitor
	self subclassResponsibility! !

!IRInstruction methodsFor: 'testing' stamp: 'md 2/22/2005 11:28'!
isTemp
	^false! !

!IRInstruction methodsFor: 'testing' stamp: ''!
isPushClosureCopy
	^false! !

!IRInstruction methodsFor: 'printing' stamp: 'MarcusDenker 10/21/2014 11:09'!
printOn: aStream
	IRPrinterV2 new
			stream: aStream;
			visitNode: self! !

!IRInstruction methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 15:55'!
canBeQuickReturn
	^ false! !

!IRInstruction methodsFor: 'mapping' stamp: 'ajh 3/6/2003 14:32'!
sourceNode

	^ sourceNode
	! !

!IRInstruction methodsFor: 'testing' stamp: 'MarcusDenker 12/19/2012 08:05'!
isGoto
	"is unconditional jump"
	
	^ false ! !

!IRInstruction methodsFor: 'accessing' stamp: 'md 7/9/2005 22:38'!
sequence
	^sequence! !

!IRInstruction methodsFor: 'inspector' stamp: 'MarcusDenker 10/21/2014 10:45'!
sourceInterval
	^self sourceNode sourceInterval! !

!IRInstruction methodsFor: '*OpalTools' stamp: 'MarcusDenker 10/22/2014 10:23'!
gtInspectorTreeIn: composite
	<gtInspectorPresentationOrder: 30> 
	^composite tree
		rootsExpanded;
		title: 'SourceNode';
		display: [ :anObject | {anObject sourceNode} ];
		children: [ :each | each children ];
		selectionPopulate: #selectedNode
			on: $o
			entitled: 'Open'
			with: [ :tree | tree selection ];
		format: [ :each | 
					String
						streamContents: [ :stream | 
							stream
								nextPutAll: each class name;
								nextPut: $(;
								nextPutAll: ((each formattedCode truncateTo: 50) copyReplaceAll: String cr with: String space);
								nextPut: $) ] ]! !

!IRInstruction methodsFor: 'testing' stamp: 'md 10/4/2005 16:52'!
isLiteralVariable
	^false! !

!IRInstruction methodsFor: 'accessing' stamp: 'md 7/9/2005 22:42'!
method
	^sequence method.! !

!IRInstruction methodsFor: '*OpalTools' stamp: 'MarcusDenker 10/21/2014 11:07'!
gtInspectorSourceCodeIn: composite
	<gtInspectorPresentationOrder: 30> 

	^ composite smalltalkCode 
		title: 'Source code';
		display: [ self method sourceNode source];
		smalltalkClass: [  self method sourceNode methodClass ]; 
		initialize: [ :presentation | 
			presentation selectionInterval: self sourceInterval ];
		act: [ self method compiledMethod browse ] icon: GLMUIThemeExtraIcons glamorousBrowse entitled: 'Browse'! !

!IRInstruction methodsFor: 'replacing' stamp: 'md 10/11/2004 15:56'!
replaceNode: aNode withNode: anotherNode 
	self error: 'I don''t store other nodes'! !

!IRInstruction methodsFor: 'testing' stamp: 'MarcusDenker 12/19/2012 08:05'!
isSend
	^false.! !

!IRInstruction methodsFor: 'accessing' stamp: 'MarcusDenker 8/8/2011 13:29'!
nonBodySuccessorSequences
	^self successorSequences! !

!IRInstruction methodsFor: 'testing' stamp: 'MarcusDenker 8/13/2010 14:26'!
isStore
	^false! !

!IRInstruction methodsFor: 'mapping' stamp: 'md 9/1/2005 21:18'!
bytecodeOffset
	| startpc |
	startpc := self method compiledMethod initialPC.
	self bytecodeIndex ifNil: [^startpc].
	^self bytecodeIndex + startpc - 1.! !

!IRInstruction methodsFor: 'accessing' stamp: 'md 7/9/2005 22:39'!
sequence: aSeq
	sequence := aSeq! !

!IRInstruction methodsFor: 'replacing' stamp: 'ClementBera 7/26/2013 15:48'!
delete
	sequence ifNil: [self error: 'This node doesn''t have a sequence'].
	sequence remove: self.! !

!IRInstruction methodsFor: 'testing' stamp: 'MarcusDenker 9/20/2013 15:14'!
isPushLiteral
	^false! !

!IRInstruction methodsFor: 'testing' stamp: 'MarcusDenker 12/14/2012 11:51'!
isTempVector
	^false! !

!IRInstruction methodsFor: 'mapping' stamp: 'ajh 3/6/2003 14:32'!
sourceNode: parseNode

	sourceNode := parseNode
	! !

!IRInstruction methodsFor: 'testing' stamp: 'ajh 3/10/2003 16:13'!
isJumpOrReturn

	^ self isJump or: [self isReturn]! !

!IRInstruction methodsFor: 'accessing' stamp: 'MarcusDenker 12/14/2012 11:51'!
successorSequences
	"sent to last instruction in sequence which is expected to be a jump and return instruction"

	^ #()! !

!IRInstruction methodsFor: 'testing' stamp: 'MarcusDenker 12/19/2012 08:07'!
isJump
	"goto or if"

	^false ! !

!IRInstruction methodsFor: 'testing' stamp: 'MarcusDenker 8/18/2010 20:11'!
isInstVarAccess

	^false.! !

!IRInstruction methodsFor: 'testing' stamp: 'MarcusDenker 12/14/2012 11:52'!
isPop

	^ false! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'MarcusDenker 8/13/2010 13:43'!
pushDup

	^ IRPushDup new! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'MarcusDenker 8/27/2010 13:28'!
pushClosureCopyCopiedValues: copiedValues args: arguments
	^IRPushClosureCopy new
			copiedValues: copiedValues;
			arguments: arguments;
			yourself.! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'ajh 3/10/2003 01:08'!
send: selector

	^ IRSend new
		selector: selector! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'ClementBer 10/14/2014 15:10'!
pushThisContext
	^ IRPushThisContext new! !

!IRInstruction class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 18:33'!
gtExamplePushReciever
	<gtExample>
	^ (self class >> #gtExamplePushReciever) ast ir startSequence sequence first! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'MarcusDenker 4/15/2010 15:22'!
returnTop

	^ IRReturn new! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'MarcusDenker 8/13/2010 13:23'!
pushLiteral: object

	^ IRPushLiteral new
		literal: object! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'ClementBer 10/14/2014 13:23'!
storeInstVar: index
	^ IRStoreInstVar new 
		index: index; 
		yourself
	! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'jorgeRessia 10/11/2009 19:44'!
popTop
	^ IRPop new! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'MarcusDenker 8/19/2010 15:03'!
pushConsArray: aSize 
	^IRPushArray new
		size: aSize;
		cons: true;
		yourself.! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'MarcusDenker 8/12/2010 14:31'!
send: selector toSuperOf: behavior

	behavior ifNil: [self error: 'super of nil does not exist'].
	^ IRSend new
		selector: selector;
		superOf: behavior;
		yourself.! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'ClementBer 10/14/2014 13:23'!
pushInstVar: index

	^ IRPushInstVar new 
			index:  index; 
			yourself! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'ClementBer 10/14/2014 13:24'!
pushTemp: aName
	aName = 'self' ifTrue: [self error: 'use pushReceiver'].
	^ IRPushTemp new
		name: aName;
		yourself! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'ClementBer 10/14/2014 13:25'!
storeTemp: aName
	^ IRStoreTemp new
		name: aName;
		yourself
! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'ClementBer 10/14/2014 13:24'!
pushLiteralVariable: object

	^ IRPushLiteralVariable new
		association: object;
		yourself
	 ! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'ClementBer 10/14/2014 13:25'!
pushRemoteTemp: aName inVectorAt: nameOfVector
	^ IRPushRemoteTemp new
		name: aName;
		tempVectorName: nameOfVector;
		yourself.! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'ClementBer 10/14/2014 13:24'!
storeIntoLiteralVariable: object

	^ IRStoreLiteralVariable new
		association: object;
		yourself! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'MarcusDenker 8/19/2010 08:21'!
createTempVectorNamed: aTempVectorName withVars: anArray  

	^ IRTempVector new
		name: aTempVectorName;
		vars: anArray;
		yourself.! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'ClementBer 10/14/2014 13:27'!
pushReceiver
	^ IRPushReceiver new! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'ClementBer 10/14/2014 13:25'!
storeRemoteTemp: aName inVectorAt: nameOfVector
	^ IRStoreRemoteTemp new
		name: aName;
		tempVectorName: nameOfVector;
		yourself.! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'MarcusDenker 8/19/2010 15:03'!
pushNewArray: aSize
	
	^IRPushArray new
		size: aSize;
		cons: false;
		yourself.! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'JorgeRessia 5/6/2010 16:33'!
blockReturnTop
	^ IRBlockReturnTop new
		! !

!IRJump commentStamp: 'ajh 3/24/2003 23:56'!
Instruction "goto: labelNum"!
!IRJump methodsFor: 'accessing' stamp: 'MarcusDenker 4/23/2013 15:48'!
successor
	^successor! !

!IRJump methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 13:38'!
accept: aVisitor
	^ aVisitor visitJump: self! !

!IRJump methodsFor: 'accessing' stamp: 'MarcusDenker 6/19/2012 13:57'!
successorSequences

	^ {destination. successor} ! !

!IRJump methodsFor: 'testing' stamp: 'ajh 3/11/2003 00:22'!
isJump
	"goto or if"

	^ true! !

!IRJump methodsFor: 'accessing' stamp: 'ajh 3/10/2003 23:08'!
destination

	^ destination! !

!IRJump methodsFor: 'accessing' stamp: 'JorgeRessia 5/19/2010 11:17'!
destination: aSequence
	destination := aSequence! !

!IRJump methodsFor: 'testing' stamp: 'MarcusDenker 12/14/2012 11:51'!
isGoto
	"is unconditional jump"

	^ true! !

!IRJump methodsFor: 'accessing' stamp: 'MarcusDenker 6/19/2012 13:18'!
successor: succ
	successor := succ! !

!IRJumpIf commentStamp: 'ajh 3/24/2003 23:56'!
Instruction "if: boolean goto: labelNum1 otherwise: labelNum2"!
!IRJumpIf methodsFor: 'acessing' stamp: 'MarcusDenker 8/8/2011 13:30'!
nonBodySuccessorSequences

	^ {destination}! !

!IRJumpIf methodsFor: 'acessing' stamp: 'pmm 2/2/2007 18:05'!
otherwise: aSequence

	otherwise := aSequence! !

!IRJumpIf methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 13:32'!
accept: aVisitor
	^ aVisitor visitJumpIf: self! !

!IRJumpIf methodsFor: 'acessing' stamp: 'ajh 3/10/2003 00:43'!
boolean

	^ boolean! !

!IRJumpIf methodsFor: 'acessing' stamp: 'ajh 3/11/2003 00:02'!
successorSequences

	^ {destination. otherwise}! !

!IRJumpIf methodsFor: 'acessing' stamp: 'ajh 3/10/2003 00:43'!
otherwise

	^ otherwise! !

!IRJumpIf methodsFor: 'acessing' stamp: 'MarcusDenker 4/23/2013 16:53'!
nextBytecodeOffsetAfterJump
	"check if we are in ifTrue:ifFalse: / ifFalse:ifTrue: or in ifTrue: / ifFalse: and answers the next byte code offset"

	^destination last isJump 
		ifTrue: [ destination last destination first bytecodeOffset ]
		ifFalse: [ 
			self flag: #FIXME. "it does not work in case of multiple byte code instruction in the optimized block"
			(destination sequence at: (destination size - 1)) bytecodeOffset ]! !

!IRJumpIf methodsFor: 'testing' stamp: 'ajh 3/11/2003 00:21'!
isIf

	^ true! !

!IRJumpIf methodsFor: 'testing' stamp: 'ajh 3/11/2003 00:19'!
isGoto
	"is unconditional jump"

	^ false! !

!IRJumpIf methodsFor: 'acessing' stamp: 'ajh 3/10/2003 00:43'!
boolean: bool

	boolean := bool! !

!IRLiteralVariableAccess commentStamp: '<historical>'!
LiteralVariables are 

-> Globals
-> Pool access
-> Class Var access!
!IRLiteralVariableAccess methodsFor: 'testing' stamp: 'md 10/4/2005 16:45'!
isLiteralVariable
	^true! !

!IRLiteralVariableAccess methodsFor: 'accessing' stamp: 'md 7/9/2005 21:14'!
association: anAssociation
	association := anAssociation! !

!IRLiteralVariableAccess methodsFor: 'accessing' stamp: 'MarcusDenker 8/4/2011 14:05'!
name
	^association key! !

!IRLiteralVariableAccess methodsFor: 'accessing' stamp: 'MarcusDenker 6/6/2012 12:33'!
association 
	^association! !

!IRMethod commentStamp: 'ajh 5/23/2003 11:08'!
I am a method in the IR (intermediate representation) language consisting of IRInstructions grouped by IRSequence (basic block).  The IRSequences form a control graph (therefore I only have to hold onto the starting sequence).  #compiledMethod will convert me to a CompiledMethod.  #methodNode will convert me back to a parse tree.
!
!IRMethod methodsFor: 'enumerating' stamp: 'md 6/10/2005 16:07'!
allInstructions
	" return irNodes as a flat collection "

	| irInstructions |
	irInstructions := OrderedCollection new.
	startSequence withAllSuccessorsDo: [:seq | seq do: [:bc | irInstructions add: bc]].
	^irInstructions! !

!IRMethod methodsFor: 'inlining' stamp: 'md 7/14/2005 12:31'!
addInstructionsBefore: aCollection

	(self startSequence nextSequence first) addInstructionsBefore: aCollection.
	! !

!IRMethod methodsFor: 'inlining' stamp: 'md 9/12/2005 12:00'!
removeReturn
	self allSequences last removeLast.! !

!IRMethod methodsFor: 'optimizing' stamp: 'ClementBera 7/16/2014 11:27'!
optimize
	self removeEmptyStart.
	self compilationContext optionOptimizeIR ifFalse: [^self].
	self absorbJumpsToSingleInstrs.
	
	"This last two optimizations works but the problem 
	when you absorb conditional jumps 
	is that and: / or: chained generate explicitely 
	constant conditional jumps to tip the JIt and the 
	decompiler that they are and: or: and not conditions/loops
	
	self absorbConstantConditionalJumps.
	self absorbJumpsToSingleInstrs"! !

!IRMethod methodsFor: 'enumerating' stamp: 'md 6/13/2005 10:41'!
allInstructionsMatching: aBlock
	" return irNodes as a flat collection "

	| irInstructions |
	irInstructions := OrderedCollection new.
	startSequence withAllSuccessorsDo: [:seq | seq do: [:bc | (aBlock value: bc) ifTrue: [irInstructions add: bc]]].
	^irInstructions! !

!IRMethod methodsFor: 'inspector' stamp: 'MarcusDenker 10/21/2014 10:56'!
children
	^self startSequence withAllSuccessors! !

!IRMethod methodsFor: 'optimizing' stamp: 'ClementBera 2/28/2014 10:24'!
removeEmptyStart

	 (startSequence size = 1 and: [ startSequence last isPushClosureCopy not ]) ifTrue: [
        "startSeq is just unconditional jump, forget it"
        startSequence := startSequence last destination].
! !

!IRMethod methodsFor: 'accessing' stamp: 'MarcusDenker 6/6/2012 13:38'!
addAdditionalLiterals: literals 
	additionalLiterals :=  literals! !

!IRMethod methodsFor: 'initialization' stamp: 'MarcusDenker 5/15/2013 11:12'!
initialize

	irPrimitive := IRPrimitive null.
	tempMap := Dictionary new.
	pragmas := OrderedCollection new.
	additionalLiterals := OCLiteralSet new.
	numArgs := 0.! !

!IRMethod methodsFor: 'accessing' stamp: 'md 7/10/2005 22:06'!
properties: propDict
	properties := propDict.! !

!IRMethod methodsFor: 'initialize' stamp: 'md 7/9/2005 22:36'!
startSequence: irSequence

	startSequence := irSequence.
	irSequence method: self.! !

!IRMethod methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:23'!
accept: aVisitor
	^ aVisitor visitMethod: self! !

!IRMethod methodsFor: 'printing' stamp: 'ClementBer 10/14/2014 14:22'!
longPrintOn: stream

	IRPrinterV2 new
		stream: stream;
		visitNode: self! !

!IRMethod methodsFor: 'enumerating' stamp: 'MarcusDenker 12/13/2012 17:39'!
firstInstructionMatching: aBlock
	" return irNodes as a flat collection "

	startSequence withAllSuccessorsDo: [:seq | seq do: [:bc | (aBlock value: bc) ifTrue: [^bc]]].
	^nil! !

!IRMethod methodsFor: '*OpalTools' stamp: 'MarcusDenker 10/21/2014 10:57'!
gtInspectorBytecodeIn: composite
	<gtInspectorPresentationOrder: 40> 
	composite text 
		title: 'Bytecode';
		display: [ self compiledMethod symbolic ]! !

!IRMethod methodsFor: '*OpalTools' stamp: 'MarcusDenker 10/21/2014 11:00'!
gtInspectorTreeIn: composite
	<gtInspectorPresentationOrder: 30> 
	^ (GTIRBrowser new treeIn: composite)
		title: 'IR'! !

!IRMethod methodsFor: 'accessing' stamp: 'JorgeRessia 5/20/2010 10:15'!
predecessorsOf: aSequence
	| predecessors |
	predecessors := OrderedCollection new.
	self allSequences do: [:each | (each successorSequences includes: aSequence) ifTrue: [predecessors add: each]].
	^predecessors! !

!IRMethod methodsFor: 'accessing' stamp: 'md 7/10/2005 22:06'!
properties
	^properties! !

!IRMethod methodsFor: 'decompiling' stamp: 'MarcusDenker 8/8/2011 13:42'!
instructionsForDecompiling
	"return all instructions, but skip the block bodies, as the decompiler
	recurses over blocks"
	
	^startSequence instructionsForDecompiling allButFirst.! !

!IRMethod methodsFor: 'testing' stamp: 'md 6/21/2005 13:56'!
isSend
	^false.! !

!IRMethod methodsFor: 'translating' stamp: 'MarcusDenker 8/11/2010 17:06'!
compiledMethod

	^ self compiledMethodWith: CompiledMethodTrailer empty! !

!IRMethod methodsFor: 'accessing' stamp: 'MarcusDenker 7/22/2013 16:09'!
forceLongForm
	compilationContext ifNil: [ ^ false ].
	^compilationContext optionLongIvarAccessBytecodes
		! !

!IRMethod methodsFor: 'translating' stamp: 'ClementBer 10/14/2014 14:22'!
generate: trailer
	
	| irTranslator |
      irTranslator := IRTranslatorV2 new
		compilationContext: compilationContext;
		trailer: trailer;
		visitNode: self;
		pragmas: pragmas;
		yourself.
	compiledMethod := irTranslator compiledMethod.
	self sourceNode 
		ifNotNil: [ 
			compiledMethod classBinding: self sourceNode methodClass binding.
			compiledMethod selector: self sourceNode selector ]
		ifNil: [ 
			compiledMethod classBinding: UndefinedObject binding.
			compiledMethod selector: #UndefinedMethod ].
	^ compiledMethod! !

!IRMethod methodsFor: 'accessing' stamp: 'MarcusDenker 11/19/2012 17:12'!
sourceNode: aNode
	sourceNode := aNode! !

!IRMethod methodsFor: 'accessing' stamp: 'MarcusDenker 5/13/2013 13:57'!
compilationContext: aCompilationContext
	compilationContext := aCompilationContext! !

!IRMethod methodsFor: 'accessing' stamp: 'md 11/15/2004 17:08'!
ir
	^self.! !

!IRMethod methodsFor: 'enumerating' stamp: 'jb 3/29/2010 18:04'!
allSequences
	^ startSequence withAllSuccessors! !

!IRMethod methodsFor: 'debugging' stamp: 'ClementBera 7/22/2013 16:45'!
instructionForPC: aPC

	self compiledMethod. "generates the compiledMethod and optimize the ir. 
	Removes the side-effect of optimizing the IR while looking for instruction, 
	which results in incorrect found instruction"
	
	0 to: -3 by: -1 do: [ :off |
		(self firstInstructionMatching: [:ir | ir bytecodeOffset = (aPC - off) ]) ifNotNil: [:it |^it]]
	! !

!IRMethod methodsFor: 'accessing' stamp: 'MarcusDenker 4/13/2010 14:47'!
tempKeys

	^ tempMap keys! !

!IRMethod methodsFor: 'inlining' stamp: 'md 9/11/2005 18:52'!
addInstructionsAfter: aCollection
	| returningSeqs  lastInstr |
	aCollection ifEmpty: [^self].
	returningSeqs := self allSequences select: [:each | each last isReturn].
	lastInstr := returningSeqs last last.
	lastInstr addInstructionsBefore: aCollection.
	! !

!IRMethod methodsFor: 'optimizing' stamp: 'ajh 3/10/2003 15:45'!
absorbJumpsToSingleInstrs

	startSequence absorbJumpToSingleInstr: IdentitySet new! !

!IRMethod methodsFor: 'optimizing' stamp: 'ajh 3/10/2003 15:45'!
absorbConstantConditionalJumps

	startSequence absorbConstantConditionalJumps: IdentitySet new! !

!IRMethod methodsFor: 'translating' stamp: 'MarcusDenker 12/17/2012 14:25'!
compiledMethodWith: trailer

	^compiledMethod 
		ifNil: [self generate: trailer ]
		ifNotNil: [compiledMethod]! !

!IRMethod methodsFor: 'accessing' stamp: 'MarcusDenker 5/15/2013 08:29'!
irPrimitive: aPrimitiveNode

	irPrimitive := aPrimitiveNode! !

!IRMethod methodsFor: 'accessing' stamp: 'ajh 3/10/2003 17:53'!
startSequence

	^ startSequence! !

!IRMethod methodsFor: 'testing' stamp: 'JorgeRessia 5/13/2010 11:18'!
isPushClosureCopy
	^false.! !

!IRMethod methodsFor: 'testing' stamp: 'ToonVerwaest 3/27/2011 17:45'!
hasTempVector: aSymbol
	startSequence withAllSuccessorsDo: [ :seq | (seq hasTempVector: aSymbol) ifTrue: [ ^ true ]].
	^ false! !

!IRMethod methodsFor: 'accessing' stamp: 'MarcusDenker 5/13/2011 13:56'!
additionalLiterals
	^additionalLiterals! !

!IRMethod methodsFor: 'accessing' stamp: 'MarcusDenker 11/19/2012 17:11'!
sourceNode
	^sourceNode! !

!IRMethod methodsFor: 'accessing' stamp: 'MarcusDenker 11/6/2014 14:53'!
sourceInterval
	^self sourceNode sourceInterval! !

!IRMethod methodsFor: 'enumerating' stamp: 'MarcusDenker 12/18/2012 14:28'!
tempVectorNamed: aName
	
	^self firstInstructionMatching: [:ir | ir isTempVector and:  [ir name = aName ] ]! !

!IRMethod methodsFor: 'enumerating' stamp: 'MarcusDenker 8/13/2010 14:11'!
allTempAccessInstructions
	^self allInstructionsMatching: [:bc | bc isTemp].! !

!IRMethod methodsFor: 'translating' stamp: 'MarcusDenker 12/17/2012 14:24'!
generate
	^self generate: CompiledMethodTrailer empty! !

!IRMethod methodsFor: 'scoping' stamp: 'MarcusDenker 8/18/2010 14:54'!
indexForVarNamed: aName

	^tempMap at: aName! !

!IRMethod methodsFor: 'accessing' stamp: 'md 6/16/2005 15:02'!
method
	^self.! !

!IRMethod methodsFor: '*OpalTools' stamp: 'MarcusDenker 10/21/2014 10:57'!
gtInspectorSourceCodeIn: composite 
	<gtInspectorPresentationOrder: 40>
	self sourceNode gtInspectorSourceCodeIn: composite! !

!IRMethod methodsFor: 'accessing' stamp: 'MarcusDenker 5/15/2013 08:29'!
irPrimitive

	^ irPrimitive! !

!IRMethod methodsFor: 'accessing' stamp: 'MarcusDenker 8/18/2010 19:03'!
numArgs: anInteger

	numArgs := anInteger! !

!IRMethod methodsFor: 'accessing' stamp: 'ClementBera 5/23/2013 11:09'!
compilationContext
	^ compilationContext ifNil: [ 
		"only happens when decompiling or using stand-alone"
		compilationContext := CompilationContext default]! !

!IRMethod methodsFor: '*OpalTools' stamp: 'MarcusDenker 10/21/2014 10:57'!
gtInspectorIrIn: composite
	<gtInspectorPresentationOrder: 35> 
	composite text 
		title: 'Symbolic';
		display: [ :anObject || string |
				string := anObject longPrintString.
				string copyFrom: 2 to: string size ]! !

!IRMethod methodsFor: 'accessing' stamp: 'MarcusDenker 8/18/2010 19:03'!
numArgs

	^ numArgs! !

!IRMethod methodsFor: 'accessing' stamp: 'MarcusDenker 5/13/2011 13:42'!
addAdditionalLiteral: aLiteral
	additionalLiterals add: aLiteral! !

!IRMethod methodsFor: 'accessing' stamp: 'JorgeRessia 5/6/2010 11:07'!
addPragma: aPragma
	
	pragmas add: aPragma.! !

!IRMethod methodsFor: 'accessing' stamp: 'JorgeRessia 4/16/2010 11:34'!
tempMap
	^ tempMap! !

!IRMethod class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 17:33'!
gtExampleNewMethod
	<gtExample>
	^ IRBuilder new 
		addTemps: #(a);
		pushReceiver;
		pushLiteral: 1;
		storeTemp: #a;
		ir! !

!IRMethod class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 17:33'!
gtExampleThisMethod
	<gtExample>
	^ (self class >> #gtExampleThisMethod) ast ir! !

!IRPop commentStamp: 'ajh 3/24/2003 23:57'!
Instruction "popTop"!
!IRPop methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 13:32'!
accept: aVisitor
	^ aVisitor visitPop: self! !

!IRPop methodsFor: 'testing' stamp: 'ms 7/10/2007 14:12'!
isPop
	^true! !

!IRPopIntoInstVar commentStamp: 'ClementBer 10/14/2014 14:47'!
Pop into instance variable.!
!IRPopIntoInstVar methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 13:32'!
accept: aVisitor
	^ aVisitor visitPopIntoInstVar: self! !

!IRPopIntoLiteralVariable commentStamp: 'ClementBer 10/14/2014 14:48'!
pop into literal variable!
!IRPopIntoLiteralVariable methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 13:32'!
accept: aVisitor
	^ aVisitor visitPopIntoLiteralVariable: self! !

!IRPopIntoRemoteTemp commentStamp: 'ClementBer 10/14/2014 14:48'!
pop into remote temp!
!IRPopIntoRemoteTemp methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 13:32'!
accept: aVisitor
	^ aVisitor visitPopIntoRemoteTemp: self! !

!IRPopIntoTemp commentStamp: 'ClementBer 10/14/2014 14:48'!
pop into temp!
!IRPopIntoTemp methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 13:32'!
accept: aVisitor
	^ aVisitor visitPopIntoTemp: self! !

!IRPrimitive commentStamp: 'ajh 3/24/2003 21:35'!
I represent a primitive.  I am more than just a number if I am a named primitive.

Structure:

 num	<Integer>	Primitive number.
 spec	<Object>		Stored in first literal when num is 117 or 120.
!
!IRPrimitive methodsFor: 'accessing' stamp: 'ajh 7/14/2001 12:23'!
num: n

	primitiveNum := n! !

!IRPrimitive methodsFor: 'accessing' stamp: 'ajh 7/14/2001 12:30'!
spec: literal

	spec := literal! !

!IRPrimitive methodsFor: 'printing' stamp: 'ajh 3/12/2003 12:26'!
printOn: aStream

	aStream nextPutAll: 'primitive '; print: primitiveNum! !

!IRPrimitive methodsFor: 'printing' stamp: 'ajh 3/19/2003 22:02'!
sourceText

	^ String streamContents: [:stream |
		self printPrimitiveOn: stream]! !

!IRPrimitive methodsFor: 'accessing' stamp: 'MarcusDenker 8/12/2010 15:54'!
initializeFrom: aPragmaNode

	primitiveNum := 0.
	spec := Array 
		with: (aPragmaNode arguments second) name
		with: (aPragmaNode arguments first) name
		with: 0 with: 0.
! !

!IRPrimitive methodsFor: 'accessing' stamp: 'ajh 7/14/2001 12:37'!
num

	^ primitiveNum! !

!IRPrimitive methodsFor: 'accessing' stamp: 'ajh 7/14/2001 12:37'!
spec

	^ spec! !

!IRPrimitive methodsFor: 'printing' stamp: 'MarcusDenker 8/13/2010 11:39'!
printPrimitiveOn: aStream
	"Print the primitive on aStream"

	| primIndex primDecl |
	primIndex := primitiveNum.
	primIndex = 0
		ifTrue: [ ^ self ].
	primIndex = 120
		ifTrue: [ 
			"External call spec"
			^ aStream print: spec ].
	aStream nextPutAll: '<primitive: '.
	primIndex = 117
		ifTrue: [ 
			primDecl := spec.
			aStream
				nextPut: $';
				nextPutAll: primDecl second;
				nextPut: $'.
			primDecl first
				ifNotNil: [ 
					aStream
						nextPutAll: ' module: ';
						nextPut: $';
						nextPutAll: primDecl first;
						nextPut: $' ] ]
		ifFalse: [ aStream print: primIndex ].
	aStream nextPut: $>.
	(primIndex ~= 117 and: [ primIndex ~= 120 ])
		ifTrue: [ 
			Smalltalk
				at: #Interpreter
				ifPresent: [ :cls | 
					aStream
						nextPutAll: ' "';
						nextPutAll: ((cls classPool at: #PrimitiveTable) at: primIndex + 1);
						nextPutAll: '" ' ] ]! !

!IRPrimitive class methodsFor: 'instance creation' stamp: 'ajh 7/14/2001 12:47'!
null

	^ self new num: 0! !

!IRPrimitive class methodsFor: 'initialization' stamp: 'JorgeRessia 1/10/2010 11:28'!
from: aPragmaNode

	^ self new initializeFrom: aPragmaNode! !

!IRPrinterTest methodsFor: 'testing' stamp: 'ClementBera 10/15/2014 17:06'!
testReturnTop
	| ir |
	ir := IRBuilderTest new testReturnTop.
	self assert: ir longPrintString =  '
label: 1
returnLiteral: false
'! !

!IRPrinterTest methodsFor: 'testing' stamp: 'MarcusDenker 7/16/2012 16:07'!
testPushTempArgument
	| ir |
	ir := IRBuilderTest new testPushTempArgument.
	self assert: ir longPrintString = '
label: 1
pushTemp: #a
pushTemp: #b
send: #+
returnTop
'! !

!IRPrinterTest methodsFor: 'testing' stamp: 'MarcusDenker 7/16/2012 16:07'!
testJumpBackTo
	| ir |
	ir := IRBuilderTest new testJumpBackTo.
	self assert: ir longPrintString =  '
label: 1
pushReceiver
pushLiteral: false
goto: 2

label: 2
if: true goto: 4 else: 3

label: 3
pushLiteral: true
goto: 2

label: 4
returnTop
'! !

!IRPrinterTest methodsFor: 'testing' stamp: 'MarcusDenker 7/16/2012 16:07'!
testJumpAheadTo
	| ir |
	ir := IRBuilderTest new testJumpAheadTo.
	self assert: ir longPrintString =  '
label: 1
pushLiteral: 2
pushLiteral: 1
send: #+
goto: 2

label: 2
returnTop
'! !

!IRPrinterTest methodsFor: 'testing' stamp: 'MarcusDenker 7/16/2012 16:07'!
testLiteralVariableClass
	| ir |
	ir := IRBuilderTest new testLiteralVariableClass.
	self assert: ir longPrintString =  '
label: 1
pushLiteralVariable: Object
returnTop
'! !

!IRPrinterTest methodsFor: 'testing' stamp: 'MarcusDenker 7/16/2012 16:07'!
testDup
	| ir |
	ir := IRBuilderTest new testDup.
	self assert: ir longPrintString = '
label: 1
pushLiteral: 3
pushDup
send: #=
returnTop
'! !

!IRPrinterTest methodsFor: 'testing' stamp: 'MarcusDenker 7/16/2012 16:07'!
testPushConsArray
	| ir |
	ir := IRBuilderTest new testPushConsArray.
	self assert: ir longPrintString =  '
label: 1
pushReceiver
pushConsArray: 1
returnTop
'! !

!IRPrinterTest methodsFor: 'testing' stamp: 'MarcusDenker 7/16/2012 16:07'!
testPopTop
	| ir |
	ir := IRBuilderTest new testPopTop.
	self assert: ir longPrintString =  '
label: 1
pushReceiver
pushLiteral: false
popTop
returnTop
'! !

!IRPrinterTest methodsFor: 'testing' stamp: 'MarcusDenker 7/16/2012 16:07'!
testPushSelf
	| ir |
	ir := IRBuilderTest new testPushSelf.
	self assert: ir longPrintString =  '
label: 1
pushReceiver
send: #class
returnTop
'! !

!IRPrinterTest methodsFor: 'testing' stamp: 'MarcusDenker 7/16/2012 16:07'!
testPushNewArray
	| ir |
	ir := IRBuilderTest new testPushNewArray.
	self assert: ir longPrintString  =  '
label: 1
pushNewArray: 1
returnTop
'! !

!IRPrinterTest methodsFor: 'testing' stamp: 'ClementBera 10/15/2014 17:06'!
testRemoteTempNested
	| ir |
	ir := IRBuilderTest new testRemoteTempNested.
	self assert: ir longPrintString =   '
label: 1
createTempVectorNamed: #methodVector withVars: #(#b)
pushLiteral: 1
popIntoTemp: #a
pushClosureCopyCopiedValues: #(#methodVector #a) args: #()

label: 2
createTempVectorNamed: #blockVector withVars: #(#f)
pushTemp: #a
pushClosureCopyCopiedValues: #(#methodVector) args: #()

label: 3
pushLiteral: 1
storeRemoteTemp: #b inVector: #methodVector
blockReturnTop

label: 4
send: #value
send: #+
storeRemoteTemp: #b inVector: #methodVector
blockReturnTop

label: 5
send: #value
pushRemoteTemp: #b inVector: #methodVector
returnTop
'! !

!IRPrinterTest methodsFor: 'testing' stamp: 'ClementBera 10/15/2014 17:05'!
testRemoteTemp
	| ir |
	ir := IRBuilderTest new testRemoteTemp.
	self assert: ir longPrintString  =  '
label: 1
createTempVectorNamed: #methodVector withVars: #(#b)
pushLiteral: 1
popIntoTemp: #a
pushClosureCopyCopiedValues: #(#a #c #methodVector) args: #()

label: 2
pushTemp: #a
pushLiteral: 1
send: #+
popIntoRemoteTemp: #b inVector: #methodVector
blockReturnTop

label: 3
send: #value
pushRemoteTemp: #b inVector: #methodVector
returnTop
'! !

!IRPrinterTest methodsFor: 'testing' stamp: 'MarcusDenker 7/16/2012 16:07'!
testPushThisContext
	| ir |
	ir := IRBuilderTest new testPushThisContext.
	self assert: ir longPrintString =  '
label: 1
pushThisContext
send: #receiver
returnTop
'! !

!IRPrinterTest methodsFor: 'testing' stamp: 'MarcusDenker 7/16/2012 16:07'!
testStoreIntoVariable
	| ir |
	ir := IRBuilderTest new testStoreIntoVariable.
	self assert: ir longPrintString =  '
label: 1
pushLiteral: 4
storeLiteralVariable: TestToPush
returnTop
'! !

!IRPrinterTest methodsFor: 'testing' stamp: 'MarcusDenker 7/16/2012 16:12'!
testSendSuper
	| ir |
	ir := IRBuilderTest new testSendSuper.
	self assert: ir longPrintString =  '
label: 1
pushReceiver
send: #isThisEverCalled toSuperOf: IRBuilderTest
returnTop
'! !

!IRPrinterTest methodsFor: 'testing' stamp: 'MarcusDenker 7/16/2012 16:07'!
testPushTempTemp
	| ir |
	ir := IRBuilderTest new testPushTempTemp.
	self assert: ir longPrintString =  '
label: 1
pushTemp: #a
returnTop
'! !

!IRPrinterTest methodsFor: 'testing' stamp: 'MarcusDenker 7/16/2012 16:07'!
testJumpAheadToIf
	| ir |
	ir := IRBuilderTest new testJumpAheadToIf.
	self assert: ir longPrintString =  '
label: 1
pushReceiver
pushLiteral: true
if: true goto: 3 else: 2

label: 2
returnTop

label: 3
returnTop
'! !

!IRPrinterTest methodsFor: 'testing' stamp: 'MarcusDenker 7/16/2012 16:07'!
testInstVar
	| ir |
	ir := IRBuilderTest new testInstVar.
	self assert: ir longPrintString = 
 '
label: 1
pushInstVar: 1
pushInstVar: 2
send: #+
returnTop
'! !

!IRPrinterTest methodsFor: 'testing' stamp: 'ClementBera 10/15/2014 17:06'!
testStoreTemp
	| ir |
	ir := IRBuilderTest new testStoreTemp.
	self assert: ir longPrintString = '
label: 1
pushLiteral: 34
popIntoTemp: #a
pushTemp: #a
returnTop
'! !

!IRPrinterTest methodsFor: 'testing' stamp: 'ClementBera 10/15/2014 17:16'!
testLiteralArray
	| ir |
	ir := IRBuilderTest new testLiteralArray.  
	self assert: ir longPrintString =  '
label: 1
returnLiteral: #(#test 4 #you)
'! !

!IRPrinterTest methodsFor: 'testing' stamp: 'MarcusDenker 7/16/2012 16:07'!
testPushClosureCopyNoCopied
	| ir |
	ir := IRBuilderTest new testPushClosureCopyNoCopied.
	self assert: ir longPrintString =  '
label: 1
pushReceiver
pushClosureCopyCopiedValues: #() args: #()

label: 2
pushLiteral: 1
pushLiteral: 2
send: #+
blockReturnTop

label: 3
send: #value
returnTop
'! !

!IRPrinterV2 commentStamp: 'ClementBer 10/14/2014 14:16'!
I interpret IRMethod instructions and write them out to a print stream.!
!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:18'!
visitPushRemoteTemp: remoteTemp

	stream nextPutAll: 'pushRemoteTemp: '.
	remoteTemp name printOn: stream..
	stream nextPutAll: ' inVector: '.
	remoteTemp tempVectorName printOn: stream! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:12'!
visitBlockReturnTop: blockReturnTop

	stream nextPutAll: 'blockReturnTop'.

! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:17'!
visitPushDup: dup
	
	stream nextPutAll: 'pushDup'


! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:23'!
visitPopIntoTemp: tmp

	stream nextPutAll: 'popIntoTemp: '.
	tmp name printOn: stream.


! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:18'!
visitPushInstVar: instVar
	
	stream nextPutAll: 'pushInstVar: '.
	instVar index printOn: stream.
! !

!IRPrinterV2 methodsFor: 'private' stamp: 'ClementBer 10/14/2014 14:21'!
stream: stringWriteStream

	stream := stringWriteStream! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 15:49'!
visitSequence: instructionSequence
	self label: instructionSequence orderNumber.
	super visitSequence: instructionSequence
! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:23'!
visitReturnInstVar: instVar
	stream nextPutAll: 'returnInstVar: '.
   instVar index printOn: stream.! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:21'!
visitStoreRemoteTemp: remoteTemp
	stream nextPutAll: 'storeRemoteTemp: '.
	remoteTemp name printOn: stream..
	stream nextPutAll: ' inVector: '.
	remoteTemp tempVectorName printOn: stream.! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:21'!
visitStoreLiteralVariable: var

	| object |
	object := var association.
	stream nextPutAll: 'storeLiteralVariable: '.
	object isVariableBinding ifTrue: [^ stream nextPutAll: object key].
	object printOn: stream.! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:22'!
visitPopIntoLiteralVariable: litVar
	
	| object |
	object := litVar association.
	stream nextPutAll: 'popIntoLiteralVariable: '.
	object isVariableBinding ifTrue: [^ stream nextPutAll: object key].
	object printOn: stream.! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:32'!
visitPushLiteralVariable: var
	
	| object |
	object := var association.
	stream nextPutAll: 'pushLiteralVariable: '.
	object isVariableBinding ifTrue: [^ stream nextPutAll: object key].
	object printOn: stream.! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:16'!
visitPop: pop

	stream nextPutAll: 'popTop'
! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:20'!
visitStoreInstVar: instVar
	stream nextPutAll: 'storeInstVar: '.
   instVar index printOn: stream.! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:13'!
visitJump: jump

	stream nextPutAll: 'goto: '.
	jump destination orderNumber printOn: stream.
! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'MarcusDenker 10/21/2014 10:55'!
visitPushClosureCopy: closure

	stream nextPutAll: 'pushClosureCopyCopiedValues: '.
	stream nextPutAll: closure copiedValues printString .
	stream nextPutAll: ' args: '.
	stream nextPutAll: closure arguments printString.
! !

!IRPrinterV2 methodsFor: 'private' stamp: 'ClementBer 10/14/2014 14:15'!
label: seqNum

	"add tab and cr since this does not get called within interpretInstruction:"
	stream cr.  "extra cr just to space out sequences"
	stream nextPutAll: 'label: '.
	seqNum printOn: stream.
	stream cr.
! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:30'!
visitPushReceiver: receiver

	stream nextPutAll: 'pushReceiver'


! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:13'!
visitJumpIf: jumpIf

	stream nextPutAll: 'if: '.
	jumpIf boolean printOn: stream.
	stream nextPutAll: ' goto: '.
	jumpIf destination orderNumber printOn: stream.
	stream nextPutAll: ' else: '.
	jumpIf otherwise orderNumber printOn: stream.
! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:23'!
visitPopIntoRemoteTemp: remoteTemp

	stream nextPutAll: 'popIntoRemoteTemp: '.
	remoteTemp name printOn: stream..
	stream nextPutAll: ' inVector: '.
	remoteTemp tempVectorName printOn: stream! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:41'!
visitStoreTemp: tmp

   	stream nextPutAll: 'storeTemp: '.
	tmp name printOn: stream.
 ! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:19'!
visitSend: send

	send superOf
		ifNil: [ stream nextPutAll: 'send: '.
			send selector printOn: stream. ]
		ifNotNil: [ :behavior | stream nextPutAll: 'send: '.
			send selector printOn: stream.
			stream nextPutAll: ' toSuperOf: '.
			behavior printOn: stream ]

! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:23'!
visitReturnLiteral: lit

	| object |
	object := lit literal.
	stream nextPutAll: 'returnLiteral: '.
	object isVariableBinding ifTrue: [^ stream nextPutAll: object key].
	object printOn: stream.
! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:22'!
visitPopIntoInstVar: instVar
	
	stream nextPutAll: 'popIntoInstVar: '.
	instVar index printOn: stream.
! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:17'!
visitPushArray: array
	
	array cons 
		ifTrue: [  
			stream nextPutAll: 'pushConsArray: ' ]
		ifFalse: [
			stream nextPutAll: 'pushNewArray: ' ].
	array size printOn: stream. 
! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:41'!
visitPushTemp: tmp

	stream nextPutAll: 'pushTemp: '.
	tmp name printOn: stream.


! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:20'!
visitInstruction: aNode
	super visitNode: aNode.
	stream cr.! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:24'!
visitReturnReceiver: receiver

	stream nextPutAll: 'returnReceiver'


! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:19'!
visitPushThisContext: ctxt

	stream nextPutAll: 'pushThisContext'
! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:13'!
visitTempVector: tempVector

	stream nextPutAll: 'createTempVectorNamed: '.
	tempVector name printOn: stream.
	stream nextPutAll: ' withVars: '.
	stream nextPutAll: tempVector vars printString.
	
	! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:19'!
visitReturn: ret
	
	stream nextPutAll: 'returnTop'.

! !

!IRPrinterV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:34'!
visitPushLiteral: lit

	| object |
	object := lit literal.
	stream nextPutAll: 'pushLiteral: '.
	object isVariableBinding ifTrue: [^ stream nextPutAll: object key].
	object printOn: stream.
! !

!IRPushArray commentStamp: 'MarcusDenker 8/11/2014 10:16'!
I model the pushArray bytecode.

Used for setting up the temp vectors and for the brace array construct: { }.!
!IRPushArray methodsFor: 'initializing' stamp: 'MarcusDenker 8/13/2010 13:32'!
size: aSmallInteger 
	size := aSmallInteger! !

!IRPushArray methodsFor: 'initialization' stamp: 'MarcusDenker 8/13/2010 13:31'!
initialize
	size := 0.
	cons := false.
	! !

!IRPushArray methodsFor: 'as yet unclassified' stamp: 'ClementBer 10/14/2014 14:28'!
cons
	^ cons! !

!IRPushArray methodsFor: 'initializing' stamp: 'ClementBer 10/14/2014 13:42'!
size 
	^ size! !

!IRPushArray methodsFor: 'initializing' stamp: 'MarcusDenker 8/13/2010 13:33'!
cons: aBool
	cons := aBool.! !

!IRPushArray methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 13:32'!
accept: aVisitor
	^ aVisitor visitPushArray: self! !

!IRPushClosureCopy commentStamp: 'MarcusDenker 8/11/2014 10:15'!
Instruction push closure copy bytecode

I am modelled as a Jump as the bytecode of the block is inlined into the method, with the execution jumping over these embedded bytecodes. 

!
!IRPushClosureCopy methodsFor: 'accessing' stamp: 'jb 3/29/2010 13:38'!
blockSequence 
^blockSequence! !

!IRPushClosureCopy methodsFor: 'scoping' stamp: 'MarcusDenker 8/18/2010 14:55'!
indexForVarNamed: aName

	^tempMap at: aName! !

!IRPushClosureCopy methodsFor: 'accessing' stamp: 'JorgeRessia 5/19/2010 11:23'!
lastBlockSequence: aSequence
	lastBlockSequence := aSequence! !

!IRPushClosureCopy methodsFor: 'accessing' stamp: 'MarcusDenker 8/19/2010 15:00'!
copiedValues: anArray 
	copiedValues := anArray.! !

!IRPushClosureCopy methodsFor: 'accessing' stamp: 'MarcusDenker 4/13/2010 14:52'!
tempKeys
	^tempMap keys ! !

!IRPushClosureCopy methodsFor: 'testing' stamp: 'MarcusDenker 8/19/2010 10:34'!
tempVectorName
	self blockSequence do:[:irNode | irNode isTempVector ifTrue:[^irNode name]].
	^nil.! !

!IRPushClosureCopy methodsFor: 'private' stamp: 'NicolaiHess 10/26/2014 01:16'!
blockHasTempVector: aSymbol
	^ blockSequence hasTempVector: aSymbol! !

!IRPushClosureCopy methodsFor: 'accessing' stamp: 'ToonVerwaest 3/26/2011 19:26'!
copiedValues
	^ copiedValues! !

!IRPushClosureCopy methodsFor: 'accessing' stamp: 'MarcusDenker 8/27/2010 13:28'!
arguments: anArray
	arguments := anArray! !

!IRPushClosureCopy methodsFor: 'accessing' stamp: 'MarcusDenker 10/14/2010 15:27'!
definedTemps

	^self tempMap keys copyWithoutAll: (arguments, copiedValues).! !

!IRPushClosureCopy methodsFor: 'accessing' stamp: 'MarcusDenker 8/8/2011 13:30'!
nonBodySuccessorSequences

	^ {destination}! !

!IRPushClosureCopy methodsFor: 'accessing' stamp: 'MarcusDenker 8/19/2010 15:00'!
numArgs: aSmallInteger 
	numArgs := aSmallInteger! !

!IRPushClosureCopy methodsFor: 'initialization' stamp: 'MarcusDenker 5/19/2011 14:55'!
initialize
	super initialize.
	tempMap := Dictionary new.
	! !

!IRPushClosureCopy methodsFor: 'accessing' stamp: 'JorgeRessia 5/19/2010 11:23'!
lastBlockSequence 
	^lastBlockSequence! !

!IRPushClosureCopy methodsFor: 'private' stamp: 'NicolaiHess 10/26/2014 01:19'!
sequenceHasTempVector: aSymbol
	^ sequence hasTempVector: aSymbol! !

!IRPushClosureCopy methodsFor: 'accessing' stamp: 'jb 4/2/2010 16:27'!
blockSequence: anIRSequence 
	blockSequence := anIRSequence! !

!IRPushClosureCopy methodsFor: 'accessing' stamp: 'jorgeRessia 10/1/2009 16:31'!
numArgs
	^numArgs! !

!IRPushClosureCopy methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 13:32'!
accept: aVisitor
	^ aVisitor visitPushClosureCopy: self! !

!IRPushClosureCopy methodsFor: 'testing' stamp: 'JorgeRessia 12/25/2009 20:44'!
isPushClosureCopy
	^true! !

!IRPushClosureCopy methodsFor: 'testing' stamp: 'NicolaiHess 10/26/2014 01:15'!
hasTempVector: aSymbol
	^ (blockSequence hasTempVector: aSymbol) or:[sequence hasTempVector: aSymbol]! !

!IRPushClosureCopy methodsFor: 'accessing' stamp: 'jb 3/31/2010 11:32'!
successorSequences

	^ {destination. blockSequence} ! !

!IRPushClosureCopy methodsFor: 'accessing' stamp: 'MarcusDenker 8/27/2010 13:28'!
arguments
	^arguments! !

!IRPushClosureCopy methodsFor: 'accessing' stamp: 'jb 8/26/2010 17:01'!
tempMap
	^tempMap! !

!IRPushClosureCopy methodsFor: 'accessing' stamp: 'NicolaiHess 10/26/2014 01:17'!
tempVectorNamed: aName
    (self blockHasTempVector: aName)
        ifTrue: [ ^ blockSequence tempVectorNamed: aName ].
    (self sequenceHasTempVector: aName)
                ifTrue: [ ^ sequence tempVectorNamed: aName ].
    ^ nil! !

!IRPushDup commentStamp: 'ajh 3/24/2003 23:56'!
Instruction "pushDup"!
!IRPushDup methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 13:32'!
accept: aVisitor
	^ aVisitor visitPushDup: self! !

!IRPushInstVar commentStamp: 'ClementBer 10/14/2014 14:47'!
push inst var!
!IRPushInstVar methodsFor: 'accessing' stamp: 'ClementBer 10/14/2014 16:00'!
quickRetNode
	^ IRReturnInstVar new
		index: index;
		yourself! !

!IRPushInstVar methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 13:32'!
accept: aVisitor
	^ aVisitor visitPushInstVar: self! !

!IRPushInstVar methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 15:55'!
canBeQuickReturn
	^ true! !

!IRPushLiteral commentStamp: 'ajh 3/24/2003 23:56'!
Instruction "pushLiteral: object"!
!IRPushLiteral methodsFor: 'testing' stamp: 'MarcusDenker 9/20/2013 13:26'!
isPushLiteral

	^ true! !

!IRPushLiteral methodsFor: 'accessing' stamp: 'ClementBer 10/14/2014 16:00'!
quickRetNode
	^ IRReturnLiteral new
		literal: literal;
		yourself! !

!IRPushLiteral methodsFor: 'accessing' stamp: 'MarcusDenker 8/13/2010 13:23'!
literal: object

	literal := object! !

!IRPushLiteral methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 13:32'!
accept: aVisitor
	^ aVisitor visitPushLiteral: self! !

!IRPushLiteral methodsFor: 'testing' stamp: 'MarcusDenker 9/20/2013 13:26'!
isPushLiteral: valueTest
	^ valueTest value: literal! !

!IRPushLiteral methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 15:55'!
canBeQuickReturn
	^ true! !

!IRPushLiteral methodsFor: 'accessing' stamp: 'MarcusDenker 8/13/2010 13:23'!
literal

	^ literal! !

!IRPushLiteralVariable commentStamp: 'ClementBer 10/14/2014 14:48'!
push literal variable!
!IRPushLiteralVariable methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 13:32'!
accept: aVisitor
	^ aVisitor visitPushLiteralVariable: self! !

!IRPushReceiver commentStamp: '<historical>'!
I am modelling the push self bytecode!
!IRPushReceiver methodsFor: 'accessing' stamp: 'ClementBer 10/14/2014 16:00'!
quickRetNode
	^ IRReturnReceiver new
	! !

!IRPushReceiver methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 15:55'!
canBeQuickReturn
	^ true! !

!IRPushReceiver methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 13:32'!
accept: aVisitor
	^ aVisitor visitPushReceiver: self! !

!IRPushReceiver methodsFor: 'testing' stamp: 'JorgeRessia 4/29/2010 17:06'!
isSelf
	^true! !

!IRPushRemoteTemp commentStamp: 'ClementBer 10/14/2014 14:48'!
push remote temp!
!IRPushRemoteTemp methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 13:32'!
accept: aVisitor
	^ aVisitor visitPushRemoteTemp: self! !

!IRPushTemp commentStamp: 'ClementBer 10/14/2014 14:48'!
push temp!
!IRPushTemp methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 13:32'!
accept: aVisitor
	^ aVisitor visitPushTemp: self! !

!IRPushThisContext commentStamp: 'MarcusDenker 8/11/2014 10:14'!
I model push thisContext bytecode!
!IRPushThisContext methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 13:32'!
accept: aVisitor
	^ aVisitor visitPushThisContext: self! !

!IRReconstructor commentStamp: '<historical>'!
I am a specialized IRBuilder for the decompiler!
!IRReconstructor methodsFor: 'accessors' stamp: 'MarcusDenker 6/8/2012 15:25'!
currentSequence: aSeq
	currentSequence := aSeq! !

!IRReconstructor methodsFor: 'remapping' stamp: 'ToonVerwaest 3/27/2011 15:19'!
rememberReference: anInstruction to: name in: dictionary
	(dictionary at: name ifAbsentPut: [ OrderedCollection new ])
		add: anInstruction! !

!IRReconstructor methodsFor: 'removing' stamp: 'MarcusDenker 6/8/2012 13:53'!
fixPushNilsForTemps
	" There are pushConstant: nil in the beginning of the blocksequence for all of the defined temps.
	  We got these pushConstant: nil in. Now our closure will generate them again, meaning we will double
	  the number of pushConstant: nil in the final block. To avoid this, we strip the ones we got in from the IR.  "

	| blocksequence |
	blocksequence := self currentScope blockSequence sequence.
	self currentScope definedTemps do: [ :temp | blocksequence removeFirst ]. 
	! !

!IRReconstructor methodsFor: 'remapping' stamp: 'ToonVerwaest 3/27/2011 15:22'!
remapTemp: aTemp toRemote: aRemote
	(temps removeKey: aTemp ifAbsent: [ #() ])
		do: [ :tempAccess |
			tempAccess name: aRemote.
			self rememberReference: tempAccess to: aRemote in: temps ].
		
	(remoteTemps removeKey: aTemp ifAbsent: [ #() ])
		do: [ :tempAccess |
			tempAccess tempVectorName: aRemote.
			self rememberReference: tempAccess to: aRemote in: remoteTemps. ].

	(closureCopiedValues removeKey: aTemp ifAbsent: [ #() ])
		do: [ :aClosureAndIndex | |closure index|
			closure := aClosureAndIndex key.
			index := aClosureAndIndex value.
			closure copiedValues at: index put: aRemote.
			closure tempMap at: aRemote put: (closure tempMap removeKey: aTemp).
			self rememberReference: aClosureAndIndex to: aRemote in: closureCopiedValues. ].! !

!IRReconstructor methodsFor: 'initialization' stamp: 'ToonVerwaest 3/28/2011 00:05'!
initialize
	temps := Dictionary new.
	remoteTemps := Dictionary new.
	closureCopiedValues := Dictionary new.
	sourceMapByteIndex := 0.
	super initialize.! !

!IRReconstructor methodsFor: 'instructions' stamp: 'MarcusDenker 6/8/2012 13:46'!
pushClosureCopyCopiedValues: copiedValuesNames args: args jumpTo: aJumpLabel
	| anInstruction |
	anInstruction := super pushClosureCopyCopiedValues: copiedValuesNames args: args jumpTo: aJumpLabel.
	"remove pushed nils of local temps"
	anInstruction copiedValues withIndexDo: [ :aValue :index |
		self rememberReference: anInstruction -> index to: aValue in: closureCopiedValues ]! !

!IRReconstructor methodsFor: 'instructions' stamp: 'ToonVerwaest 3/27/2011 15:18'!
pushRemoteTemp: name inVector: nameOfVector
	| anInstruction |
	anInstruction := super pushRemoteTemp: name inVector: nameOfVector.
	self rememberReference: anInstruction to: nameOfVector in: remoteTemps.! !

!IRReconstructor methodsFor: 'instructions' stamp: 'ToonVerwaest 3/27/2011 15:20'!
pushTemp: aSelector
	| anInstruction |
	anInstruction := super pushTemp: aSelector.
	self rememberReference: anInstruction to: aSelector in: temps.! !

!IRReconstructor methodsFor: 'testing' stamp: 'MarcusDenker 5/12/2011 13:40'!
isLastClosureInstruction
	| nextJumps |
	nextJumps := jumpAheadStacks at: sourceMapByteIndex + 1 ifAbsent: [ ^ false ].
	^ nextJumps anySatisfy: [ :anOrigin | anOrigin = self currentScope ]! !

!IRReconstructor methodsFor: 'instructions' stamp: 'ToonVerwaest 3/27/2011 15:20'!
storeTemp: aSelector
	| anInstruction |
	anInstruction := super storeTemp: aSelector.
	self rememberReference: anInstruction to: aSelector in: temps.! !

!IRReconstructor methodsFor: 'initialize' stamp: 'MarcusDenker 5/19/2011 13:50'!
createTempVectorNamed: name withVars: anArray
	" Don't add the temp yet, we only know it's index at the end of the block or method "
	"self addVectorTemps: anArray".
	" Update the byte index to point before the pushing of the new vector "
	sourceMapByteIndex := sourceMapByteIndex - 2.
	self add: (IRInstruction createTempVectorNamed: name withVars: anArray)! !

!IRReconstructor methodsFor: 'removing' stamp: 'ToonVerwaest 3/27/2011 18:09'!
removeLast: n
	" Make the address of the instruction be the address of the first removed instruction. "
	sourceMapByteIndex := sourceMapByteIndex - n.
	^ (currentSequence removeLast: n) collect: [ :node |
		node isTemp ifFalse: [ self error: 'Should only remove temp accesses!!' ].
		node name ]! !

!IRReconstructor methodsFor: 'accessors' stamp: 'MarcusDenker 6/8/2012 15:24'!
currentSequence
	^currentSequence ! !

!IRReconstructor methodsFor: 'instructions' stamp: 'MarcusDenker 5/19/2011 14:21'!
storeRemoteTemp: name inVector: nameOfVector
	| anInstruction |
	anInstruction := super storeRemoteTemp: name inVector: nameOfVector.
	self rememberReference: anInstruction to: nameOfVector in: remoteTemps.! !

!IRReconstructor methodsFor: 'instructions' stamp: 'MarcusDenker 6/8/2012 13:53'!
blockReturnTop
	self fixPushNilsForTemps.
	^ super blockReturnTop! !

!IRRemoteArray commentStamp: '<historical>'!
I model the TempVector for the decompiler!
!IRRemoteArray methodsFor: 'enumerating' stamp: 'MarcusDenker 5/19/2011 14:27'!
indexOf: anInteger
	^anInteger + 1.! !

!IRRemoteArray methodsFor: 'accessing' stamp: 'ToonVerwaest 3/26/2011 19:13'!
size: aSize
	size := aSize! !

!IRRemoteArray methodsFor: 'accessing' stamp: 'ToonVerwaest 3/26/2011 19:15'!
size
	^ size! !

!IRRemoteArray methodsFor: 'enumerating' stamp: 'ToonVerwaest 3/27/2011 12:46'!
do: aBlock
	1 to: size do: [ :idx | aBlock value: (idx - 1) ]! !

!IRRemoteArray methodsFor: 'accessing' stamp: 'ToonVerwaest 3/27/2011 12:39'!
index: anIndex
	index := anIndex! !

!IRRemoteArray methodsFor: 'accessing' stamp: 'ToonVerwaest 3/27/2011 14:59'!
index
	^ index! !

!IRRemoteTempAccess commentStamp: 'MarcusDenker 8/11/2014 10:14'!
I model the pushRemoteTemporary Bytecode!
!IRRemoteTempAccess methodsFor: 'testing' stamp: 'ToonVerwaest 3/26/2011 18:50'!
isRemoteTemp
	^ true! !

!IRRemoteTempAccess methodsFor: 'accessing' stamp: 'ToonVerwaest 3/26/2011 18:48'!
tempVectorName
	^ tempVectorName! !

!IRRemoteTempAccess methodsFor: 'accessing' stamp: 'MarcusDenker 8/18/2010 15:31'!
tempVectorName: anObject
	tempVectorName := anObject! !

!IRReturn commentStamp: '<historical>'!
Instruction "returnTop"!
!IRReturn methodsFor: 'testing' stamp: 'ajh 3/10/2003 16:10'!
isReturn

	^ true! !

!IRReturn methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 13:49'!
accept: aVisitor
	^ aVisitor visitReturn: self! !

!IRReturn methodsFor: 'accessing' stamp: 'MarcusDenker 8/8/2011 13:47'!
nonBodySuccessorSequences
	^#()! !

!IRReturnInstVar commentStamp: 'ClementBer 10/14/2014 15:23'!
specific node when returning an inst var!
!IRReturnInstVar methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:10'!
accept: aVisitor
	^ aVisitor visitReturnInstVar: self! !

!IRReturnInstVar methodsFor: 'accessing' stamp: 'ClementBer 10/14/2014 15:58'!
index: anObject
	index := anObject! !

!IRReturnInstVar methodsFor: 'accessing' stamp: 'ClementBer 10/14/2014 15:58'!
index
	^ index! !

!IRReturnLiteral commentStamp: 'ClementBer 10/14/2014 14:48'!
specific node when returning a constant!
!IRReturnLiteral methodsFor: 'accessing' stamp: 'ClementBer 10/14/2014 15:58'!
literal: anObject
	literal := anObject! !

!IRReturnLiteral methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:10'!
accept: aVisitor
	^ aVisitor visitReturnLiteral: self! !

!IRReturnLiteral methodsFor: 'accessing' stamp: 'ClementBer 10/14/2014 15:58'!
literal
	^ literal! !

!IRReturnReceiver commentStamp: 'ClementBer 10/14/2014 15:23'!
specific node when returning self!
!IRReturnReceiver methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:10'!
accept: aVisitor
	^ aVisitor visitReturnReceiver: self! !

!IRSend commentStamp: 'ajh 3/24/2003 23:57'!
Instruction "send: selector" or "send: selector toSuperOf: behavior"!
!IRSend methodsFor: 'accessing' stamp: 'md 6/23/2005 13:45'!
selector
	^selector! !

!IRSend methodsFor: 'testing' stamp: 'md 10/10/2005 17:37'!
isSuperSend
    ^superOf notNil! !

!IRSend methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 13:32'!
accept: aVisitor
	^ aVisitor visitSend: self! !

!IRSend methodsFor: 'accessing' stamp: 'ajh 3/10/2003 00:45'!
superOf: behavior

	superOf := behavior! !

!IRSend methodsFor: 'accessing' stamp: 'ClementBer 10/14/2014 14:24'!
superOf

	^ superOf ! !

!IRSend methodsFor: 'testing' stamp: 'md 11/12/2004 15:57'!
isSend
	^true.! !

!IRSend methodsFor: 'accessing' stamp: 'ajh 3/10/2003 00:44'!
selector: symbol

	selector := symbol! !

!IRSequence commentStamp: '<historical>'!
A sequence is corresponds to a block in the control flow graph.!
!IRSequence methodsFor: 'accessing' stamp: 'md 7/14/2005 12:23'!
last
	^sequence last! !

!IRSequence methodsFor: 'adding' stamp: 'dr 9/11/2005 15:35'!
addAll: aCollection
	^sequence addAll: aCollection! !

!IRSequence methodsFor: 'inspector' stamp: 'MarcusDenker 10/21/2014 11:01'!
children
	^sequence! !

!IRSequence methodsFor: 'adding' stamp: 'md 7/14/2005 11:57'!
addInstructions: aCollection after: anInstruction
	
	^aCollection reverseDo: [:instr | self add: instr after: anInstruction].! !

!IRSequence methodsFor: 'adding' stamp: 'dr 9/10/2005 20:57'!
addLast: anInstruction
	^self add: anInstruction.! !

!IRSequence methodsFor: 'accessing' stamp: 'md 9/29/2005 11:25'!
after: o
	^sequence after: o! !

!IRSequence methodsFor: 'initialization' stamp: 'jb 4/1/2010 13:48'!
initialize
	sequence := OrderedCollection new.! !

!IRSequence methodsFor: 'optimizing' stamp: 'md 5/17/2013 16:49'!
absorbJumpToSingleInstr: alreadySeen
	"Collapse jumps to single return instructions into caller"

	| seqs seq |
	(alreadySeen includes: self) ifTrue: [^ self].
	alreadySeen add: self.
	[ (seqs := self successorSequences) size = 1  "unconditional jump..." 
	   and: [((seq := seqs first) size = 1)  "...to single instruction..."
	    and: [seq successorSequences size < 2
		and: [self last isBlockReturnTop not
		  and: [((seq sequence size = 1) and: [(seq sequence first isBlockReturnTop) or: [seq sequence first isReturn]]) not]]]]"...but don't collapse conditional jumps so their otherwiseSequences can stay right after them"
	] whileTrue: [ "replace goto with single instruction"
		self removeLast.
		seq do: [:instr |  self add: instr copy].
	].

	seqs do: [:instrs | instrs ifNotNil: [:i | i absorbJumpToSingleInstr: alreadySeen]].
! !

!IRSequence methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:23'!
accept: aVisitor
	^ aVisitor visitSequence: self! !

!IRSequence methodsFor: 'printing' stamp: 'ClementBer 10/14/2014 16:52'!
longPrintOn: stream

	[IRPrinterV2 new
		stream: stream;
		visitNode: self
	] onDNU: #orderNumber do: [:ex | ex resume: ex receiver]! !

!IRSequence methodsFor: 'manipulating' stamp: 'ToonVerwaest 3/27/2011 17:20'!
splitAfter: instruction

	| newSeq index next |
	next := self nextSequence.
	next := next
		ifNil: [self orderNumber + 1]
		ifNotNil: [(next orderNumber + self orderNumber) / 2].
	newSeq := self class new orderNumber: next.
	newSeq method: self method.
	"Split after instruction"
	index := sequence indexOf: instruction.
	(sequence last: sequence size - index) do: [:instr | newSeq add: instr].
	sequence := sequence first: index.
	self flag: 'The jump inherits the bytecode index from the instruction where it was split. Check if this value is correct.'.
	self add: (IRJump new destination: newSeq; bytecodeIndex: (instruction bytecodeIndex + 1)).
	^ newSeq! !

!IRSequence methodsFor: '*OpalTools' stamp: 'MarcusDenker 10/22/2014 10:27'!
gtInspectorTreeIn: composite
	<gtInspectorPresentationOrder: 30> 
	^composite tree
		rootsExpanded;
		title: 'SourceNode';
		display: [ :anObject | {anObject sourceNode} ];
		children: [ :each | each children ];
		selectionPopulate: #selectedNode
			on: $o
			entitled: 'Open'
			with: [ :tree | tree selection ];
		format: [ :each | each printString ]! !

!IRSequence methodsFor: 'removing' stamp: 'dr 9/10/2005 21:03'!
removeFirst
	^sequence removeFirst.! !

!IRSequence methodsFor: 'testing' stamp: 'md 7/14/2005 12:23'!
isEmpty
	^sequence isEmpty! !

!IRSequence methodsFor: 'successor sequences' stamp: 'md 7/14/2005 11:59'!
withAllSuccessorsDo: block
	"Iterate over me and all my successors only once"

	self withAllSuccessorsDo: block alreadySeen: IdentitySet new! !

!IRSequence methodsFor: 'optimizing' stamp: 'MarcusDenker 9/20/2013 15:18'!
absorbConstantConditionalJumps: alreadySeen
	"Collapse sequences that look like:
			[if] goto s1
			...
		 s1:	pushConst: true/false
			goto s2
		 s2:	if true/false goto s3 else s4
	into:
			[if] goto s3/s4

	These sequences are produced by and:/or: messages"

	| seq bool if |
	(alreadySeen includes: self) ifTrue: [^ self].
	alreadySeen add: self.

	[(seq := self successorSequences) notEmpty  "not return"
	  and: [(seq := seq first "destination") size = 2
	   and: [(seq first isPushLiteral: [:obj | (bool := obj) isKindOf: Boolean])
	    and: [seq last isGoto
	     and: [(if := seq last destination first) isIf]]]]
	] whileTrue: [ "absorb"
		self last destination: (bool == if boolean
			ifTrue: [if destination]
			ifFalse: [if otherwise]).
	].

	self successorSequences do: [:instrs | instrs ifNotNil: [:i | i absorbConstantConditionalJumps: alreadySeen]].

! !

!IRSequence methodsFor: 'successor sequences' stamp: 'MarcusDenker 8/8/2011 13:42'!
instructionsForDecompiling

	| irInstructions |
	irInstructions := OrderedCollection new.
	self withNonBodySuccessorsDo: [:seq | seq do: [:bc | irInstructions add: bc]].
	^irInstructions
	! !

!IRSequence methodsFor: 'replacing' stamp: 'ClementBer 10/14/2014 15:44'!
replaceNode: aNode withNode: anotherNode 

	| index |
	index := sequence indexOf: aNode ifAbsent: [ self error ].
	sequence at: index put: (anotherNode sequence: self).! !

!IRSequence methodsFor: 'copying' stamp: 'dr 9/10/2005 20:59'!
, otherCollection 
	^sequence, otherCollection! !

!IRSequence methodsFor: 'replacing' stamp: 'md 7/14/2005 12:01'!
replaceNode: aNode withNodes: aCollection 

	self addInstructions: aCollection before: aNode.
	sequence remove: aNode ifAbsent: [self error].! !

!IRSequence methodsFor: 'successor sequences' stamp: 'md 7/14/2005 11:58'!
nextSequence

	| sequences i |
	sequences := self withAllSuccessors.
	i := sequences findFirst: [:seq | seq orderNumber = self orderNumber].
	(i = 0 or: [i = sequences size]) ifTrue: [^ nil].
	^ sequences at: i + 1! !

!IRSequence methodsFor: 'enumerating' stamp: 'md 7/14/2005 12:28'!
reverseDo: aBlock
	^sequence reverseDo: aBlock.! !

!IRSequence methodsFor: 'successor sequences' stamp: 'md 7/14/2005 11:59'!
withAllSuccessors
	"Return me and all my successors sorted by sequence orderNumber"

	| list |
	list := OrderedCollection new: 20.
	self withAllSuccessorsDo: [:seq | list add: seq].
	^ list asSortedCollection: [:x :y | x orderNumber <= y orderNumber]! !

!IRSequence methodsFor: 'enumerating' stamp: 'MarcusDenker 8/19/2010 08:39'!
contains: aBlock
	^sequence contains: aBlock.! !

!IRSequence methodsFor: 'accessing' stamp: 'md 7/14/2005 12:00'!
method: aIRMethod

	method := aIRMethod! !

!IRSequence methodsFor: 'enumerating' stamp: 'dr 9/10/2005 21:02'!
detect: aBlock
	^sequence detect: aBlock! !

!IRSequence methodsFor: 'accessing' stamp: 'md 7/14/2005 12:31'!
first
	^sequence first! !

!IRSequence methodsFor: 'successor sequences' stamp: 'md 7/14/2005 11:59'!
withAllSuccessorsDo: block alreadySeen: set
	"Iterate over me and all my successors only once"

	(set includes: self) ifTrue: [^ self].
	set add: self.
	block value: self.
	self successorSequences do: [:seq |
		seq ifNotNil: [seq withAllSuccessorsDo: block alreadySeen: set]].
! !

!IRSequence methodsFor: 'testing' stamp: 'md 7/14/2005 12:30'!
ifEmpty: aBlock
	^sequence ifEmpty: aBlock! !

!IRSequence methodsFor: 'adding' stamp: 'md 7/14/2005 11:57'!
add: instr after: another

	sequence add: instr after: another.
	instr sequence: self.
	^instr.! !

!IRSequence methodsFor: 'accessing' stamp: 'dr 9/10/2005 21:01'!
at: index
	^sequence at: index! !

!IRSequence methodsFor: 'adding' stamp: 'md 7/14/2005 11:57'!
add: anInstruction

	sequence add: anInstruction.
	anInstruction sequence: self.
	^anInstruction.! !

!IRSequence methodsFor: 'printing' stamp: 'md 7/14/2005 12:00'!
printOn: stream

	stream nextPutAll: 'an '.
	self class printOn: stream.
	stream space.
	stream nextPut: $(.
	self orderNumber printOn: stream.
	stream nextPut: $).
! !

!IRSequence methodsFor: 'testing' stamp: 'MarcusDenker 8/19/2010 15:30'!
hasTempVector: aSymbol
	^sequence anySatisfy: [:irNode | irNode isTempVector and: [irNode name = aSymbol]].! !

!IRSequence methodsFor: 'adding' stamp: 'md 7/14/2005 11:58'!
add: instr before: another
	sequence add: instr before: another.
	instr sequence: self.
	^instr.! !

!IRSequence methodsFor: 'inspector' stamp: 'MarcusDenker 10/22/2014 10:28'!
sourceNode
	"we should do better here"
	^RBSequenceNode new.! !

!IRSequence methodsFor: 'accessing' stamp: 'md 7/14/2005 12:32'!
sequence
	^sequence! !

!IRSequence methodsFor: 'accessing' stamp: 'MarcusDenker 12/20/2012 14:21'!
tempVectorNamed: aSymbol
	^sequence detect: [:irNode | irNode isTempVector and: [irNode name = aSymbol]].! !

!IRSequence methodsFor: 'inspector' stamp: 'MarcusDenker 10/21/2014 11:05'!
sourceInterval
	^self sequence first sourceInterval first to: self sequence last sourceInterval last! !

!IRSequence methodsFor: 'successor sequences' stamp: 'md 7/14/2005 11:58'!
instructionsDo: aBlock

	^self withAllSuccessorsDo: [:seq | seq do: aBlock].! !

!IRSequence methodsFor: 'accessing' stamp: 'md 7/14/2005 12:25'!
size
	^sequence size.! !

!IRSequence methodsFor: 'accessing' stamp: 'md 7/14/2005 12:00'!
method

	^method! !

!IRSequence methodsFor: 'adding' stamp: 'md 7/14/2005 12:29'!
addInstructions: aCollection before: anInstruction

	aCollection do: [:instr | self add: instr before: anInstruction].! !

!IRSequence methodsFor: '*OpalTools' stamp: 'MarcusDenker 10/21/2014 11:01'!
gtInspectorSourceCodeIn: composite
	<gtInspectorPresentationOrder: 30> 

	^ composite smalltalkCode 
		title: 'Source code';
		display: [ self method sourceNode source];
		smalltalkClass: [  self method sourceNode methodClass ]; 
		initialize: [ :presentation | 
			presentation selectionInterval: self sourceInterval ];
		act: [ self method compiledMethod browse ] icon: GLMUIThemeExtraIcons glamorousBrowse entitled: 'Browse'! !

!IRSequence methodsFor: 'accessing' stamp: 'md 7/14/2005 12:00'!
orderNumber
	"Sequences are sorted by this number"

	^ orderNumber! !

!IRSequence methodsFor: 'adding' stamp: 'md 9/28/2005 17:55'!
addAllFirst: aCollection
	^sequence addAllFirst: aCollection.! !

!IRSequence methodsFor: 'successor sequences' stamp: 'MarcusDenker 8/8/2011 13:31'!
nonBodySuccessorSequences

	sequence isEmpty ifTrue: [^ #()].
	^ sequence last nonBodySuccessorSequences! !

!IRSequence methodsFor: 'testing' stamp: 'dr 9/10/2005 20:55'!
notEmpty
	^sequence notEmpty! !

!IRSequence methodsFor: 'accessing' stamp: 'JorgeRessia 6/19/2010 08:20'!
orderNumber: num
	"Sequences are sorted by this number"
	orderNumber := num.! !

!IRSequence methodsFor: 'testing' stamp: 'md 7/14/2005 12:30'!
ifNotEmpty: aBlock
	^sequence ifNotEmpty: aBlock! !

!IRSequence methodsFor: 'enumerating' stamp: 'md 7/14/2005 12:28'!
select: aBlock
	^sequence select: aBlock.! !

!IRSequence methodsFor: 'successor sequences' stamp: 'MarcusDenker 8/8/2011 13:27'!
withNonBodySuccessorsDo: block
	"Iterate over me and all my successors only once"

	self withNonBodySuccessorsDo: block alreadySeen: IdentitySet new! !

!IRSequence methodsFor: 'enumerating' stamp: 'md 7/14/2005 12:24'!
do: aBlock
	^sequence do: aBlock.! !

!IRSequence methodsFor: 'removing' stamp: 'md 7/14/2005 12:25'!
removeLast
	^sequence removeLast.! !

!IRSequence methodsFor: 'replacing' stamp: 'md 7/14/2005 12:00'!
remove: aNode
	aNode sequence: nil.
	sequence remove: aNode ifAbsent: [self error].! !

!IRSequence methodsFor: 'successor sequences' stamp: 'MarcusDenker 8/8/2011 13:28'!
withNonBodySuccessorsDo: block alreadySeen: set
	"Iterate over me and all my successors only once"

	(set includes: self) ifTrue: [^ self].
	set add: self.
	block value: self.
	self nonBodySuccessorSequences do: [:seq |
		seq ifNotNil: [seq withNonBodySuccessorsDo: block alreadySeen: set]].
! !

!IRSequence methodsFor: 'adding' stamp: 'md 7/14/2005 11:58'!
addInstructions: aCollection
	
	^aCollection do: [:instr | self add: instr].! !

!IRSequence methodsFor: 'successor sequences' stamp: 'md 7/14/2005 11:59'!
successorSequences

	sequence isEmpty ifTrue: [^ #()].
	^ sequence last successorSequences! !

!IRSequence methodsFor: 'removing' stamp: 'ToonVerwaest 3/26/2011 14:40'!
removeLast: n
	^sequence removeLast: n.! !

!IRSequence class methodsFor: 'instance creation' stamp: 'MarcusDenker 6/13/2012 14:11'!
orderNumber: aNumber
	^self new orderNumber: aNumber! !

!IRSequence class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 17:38'!
gtExampleSequence
	<gtExample>
	^ (self class >> #gtExampleSequence) ast ir startSequence! !

!IRStackCount commentStamp: 'ajh 3/25/2003 00:34'!
This keeps track of the stack count for the BytecodeGenerator.!
!IRStackCount methodsFor: 'comparing' stamp: 'ajh 3/13/2003 01:51'!
hash

	^ position hash bitXor: (length hash bitXor: start hash)! !

!IRStackCount methodsFor: 'affecting' stamp: 'MarcusDenker 6/19/2012 10:07'!
pop: n

	(position := position - n) < 0 
		ifTrue: [self error: 'stack underflow in bytecode generator']! !

!IRStackCount methodsFor: 'results' stamp: 'ajh 3/13/2003 01:32'!
size

	^length! !

!IRStackCount methodsFor: 'results' stamp: 'MarcusDenker 6/19/2012 15:13'!
linkTo: stackOrNil

	stackOrNil ifNil: [^ self class startAt: self position].
	^ self position = stackOrNil start
		ifTrue: [stackOrNil]
		ifFalse: [self error: 'stack out of sync in bytecode generator']! !

!IRStackCount methodsFor: 'initialize' stamp: 'ajh 3/13/2003 01:48'!
startAt: pos

	start := position := length := pos! !

!IRStackCount methodsFor: 'affecting' stamp: 'jorgeRessia 11/3/2009 16:54'!
push
	^ self push: 1! !

!IRStackCount methodsFor: 'comparing' stamp: 'ajh 3/13/2003 01:39'!
= other

	^ self class == other class 
	  and: [start = other start
	  and: [position = other position
	  and: [length = other size]]]! !

!IRStackCount methodsFor: 'affecting' stamp: 'jorgeRessia 11/3/2009 16:56'!
pop

	^ self pop: 1! !

!IRStackCount methodsFor: 'printing' stamp: 'ajh 3/13/2003 01:38'!
printOn: aStream
	
	super printOn: aStream.
	aStream
		nextPutAll: ' start '; print: start;
		nextPutAll: ' stop '; print: position;
		nextPutAll: ' max '; print: length.
! !

!IRStackCount methodsFor: 'results' stamp: 'ajh 3/13/2003 01:32'!
position

	^position! !

!IRStackCount methodsFor: 'affecting' stamp: 'jorgeRessia 11/3/2009 16:59'!
push: n
	(position := position + n) > length 
		ifTrue: [length := position]! !

!IRStackCount methodsFor: 'results' stamp: 'ajh 3/13/2003 01:32'!
length

	^length! !

!IRStackCount methodsFor: 'results' stamp: 'ajh 3/13/2003 01:36'!
start

	^ start! !

!IRStackCount class methodsFor: 'instance creation' stamp: 'MarcusDenker 8/13/2010 15:26'!
startAt: pos

	^ self new startAt: pos! !

!IRStackCount class methodsFor: 'instance creation' stamp: 'ajh 3/13/2003 01:49'!
new

	^ super new startAt: 0! !

!IRStoreInstVar commentStamp: 'ClementBer 10/14/2014 14:47'!
store inst var!
!IRStoreInstVar methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 15:36'!
isStore
	^ true! !

!IRStoreInstVar methodsFor: 'accessing' stamp: 'ClementBer 10/14/2014 15:45'!
popIntoNode
	^ IRPopIntoInstVar new
		index: index; 
		yourself! !

!IRStoreInstVar methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 13:32'!
accept: aVisitor
	^ aVisitor visitStoreInstVar: self! !

!IRStoreLiteralVariable commentStamp: 'ClementBer 10/14/2014 14:48'!
store literal variable!
!IRStoreLiteralVariable methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 15:36'!
isStore
	^ true! !

!IRStoreLiteralVariable methodsFor: 'accessing' stamp: 'ClementBer 10/14/2014 15:46'!
popIntoNode
	^ IRPopIntoLiteralVariable new
		association: association;
		yourself! !

!IRStoreLiteralVariable methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 13:32'!
accept: aVisitor
	^ aVisitor visitStoreLiteralVariable: self! !

!IRStoreRemoteTemp commentStamp: 'ClementBer 10/14/2014 14:48'!
store remote temp!
!IRStoreRemoteTemp methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 15:37'!
isStore
	^ true! !

!IRStoreRemoteTemp methodsFor: 'accessing' stamp: 'ClementBer 10/14/2014 15:47'!
popIntoNode
	^ IRPopIntoRemoteTemp new
		name: name;
		tempVectorName: tempVectorName;
		yourself! !

!IRStoreRemoteTemp methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 13:32'!
accept: aVisitor
	^ aVisitor visitStoreRemoteTemp: self! !

!IRStoreTemp commentStamp: 'ClementBer 10/14/2014 14:48'!
store temp!
!IRStoreTemp methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 15:37'!
isStore
	^ true! !

!IRStoreTemp methodsFor: 'accessing' stamp: 'ClementBer 10/14/2014 15:46'!
popIntoNode
	^ IRPopIntoTemp new
		name: name;
		yourself! !

!IRStoreTemp methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 13:32'!
accept: aVisitor
	^ aVisitor visitStoreTemp: self! !

!IRTempAccess commentStamp: '<historical>'!
I model the pushTemporary Bytecode!
!IRTempAccess methodsFor: 'testing' stamp: 'ToonVerwaest 3/26/2011 18:52'!
isRemoteTemp
	^ false! !

!IRTempAccess methodsFor: 'accessing' stamp: 'ClementBer 10/14/2014 13:27'!
name: aString
	name := aString! !

!IRTempAccess methodsFor: 'accessing' stamp: 'ClementBer 10/14/2014 13:27'!
name

	^name! !

!IRTempAccess methodsFor: 'testing' stamp: 'md 2/22/2005 11:28'!
isTemp
	^true.! !

!IRTempVector commentStamp: 'MarcusDenker 8/11/2014 10:17'!
I model the tempVector.

The tempvector is an array that stores all escaping variables of a block that are written to from outside.!
!IRTempVector methodsFor: 'initialization' stamp: 'MarcusDenker 8/19/2010 01:09'!
initialize 
	vars := Dictionary new! !

!IRTempVector methodsFor: 'accessing' stamp: 'MarcusDenker 8/19/2010 01:05'!
name: anObject
	name := anObject! !

!IRTempVector methodsFor: 'accessing' stamp: 'ClementBer 10/14/2014 13:37'!
vars
	^ vars! !

!IRTempVector methodsFor: 'testing' stamp: 'MarcusDenker 8/19/2010 08:36'!
isTempVector
	^true! !

!IRTempVector methodsFor: 'accessing' stamp: 'MarcusDenker 5/19/2011 13:26'!
indexForVarNamed: aName
	^vars indexOf: aName
! !

!IRTempVector methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 13:32'!
accept: aVisitor
	^ aVisitor visitTempVector: self! !

!IRTempVector methodsFor: 'accessing' stamp: 'MarcusDenker 8/19/2010 08:13'!
vars: anObject
	vars := anObject.! !

!IRTempVector methodsFor: 'accessing' stamp: 'MarcusDenker 8/19/2010 01:06'!
name
	^ name! !

!IRTransformTest methodsFor: 'testing - adding' stamp: 'MarcusDenker 8/18/2010 18:59'!
testAddBefore
	
	| iRMethod aCompiledMethod ret |

	iRMethod := IRBuilder new
		pushLiteral: 1;				
		returnTop;
		ir.

	(iRMethod allSequences last) last delete.
	(iRMethod allSequences last) last delete.

	ret :=  (IRInstruction returnTop).

	(iRMethod allSequences last)
			add: ret.

	(iRMethod allSequences last)
			add: (IRInstruction pushLiteral: 2) before: ret.

	aCompiledMethod := iRMethod compiledMethod.
	self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2].
! !

!IRTransformTest methodsFor: 'testing - adding' stamp: 'MarcusDenker 8/18/2010 18:54'!
testAdd
	
	| iRMethod aCompiledMethod |

	iRMethod := IRBuilder new
		pushLiteral: 1;				
		returnTop;
		ir.

	(iRMethod allSequences last) last delete.
	(iRMethod allSequences last) last delete.

	(iRMethod allSequences last)
			add: (IRInstruction pushLiteral: 2).

	(iRMethod allSequences last)
			add: (IRInstruction returnTop).

	aCompiledMethod := iRMethod compiledMethod.
	self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2].
! !

!IRTransformTest methodsFor: 'testing - adding' stamp: 'MarcusDenker 11/6/2014 15:47'!
testAddIntructionsBeforeFromLList
	
	| iRMethod aCompiledMethod push llist col |

	iRMethod := IRBuilder new
		pushLiteral: 1;				
		returnTop;
		ir.

	push := (iRMethod allSequences last) at: 1 .

	llist := LinkedList new.
	llist add: (IRInstruction pushLiteral: 2).
	llist add: (IRInstruction returnTop).

	col := llist asOrderedCollection.

	(iRMethod allSequences last)
			addInstructions:  col before: push.

	aCompiledMethod := iRMethod compiledMethod.
	self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2].
! !

!IRTransformTest methodsFor: 'testing - adding' stamp: 'MarcusDenker 8/18/2010 18:52'!
testReplace
	| iRMethod aCompiledMethod |
	
	iRMethod := IRBuilder new
		pushLiteral: 1;				
		returnTop;
		ir.
	
	(iRMethod allSequences last first) 
			replaceWith: (IRInstruction pushLiteral: 2).

	aCompiledMethod := iRMethod compiledMethod.
	self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2].
! !

!IRTransformTest methodsFor: 'testing - enumeration' stamp: 'MarcusDenker 7/16/2012 16:07'!
testAllInstructions
		| ir |

		ir := IRBuilderTest new testPushTempTemp.
		self assert: ir allInstructions last isReturn.! !

!IRTransformTest methodsFor: 'testing - adding' stamp: 'MarcusDenker 11/6/2014 15:47'!
testAddIntructionsBefore
	
	| iRMethod aCompiledMethod push |

	iRMethod := IRBuilder new
		pushLiteral: 1;				
		returnTop;
		ir.

	push := (iRMethod allSequences last) first.

	(iRMethod allSequences last)
			addInstructions: {(IRInstruction pushLiteral: 2). (IRInstruction returnTop)} before: push.

	aCompiledMethod := iRMethod compiledMethod.
	self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2].
! !

!IRTransformTest methodsFor: 'testing - enumeration' stamp: 'MarcusDenker 7/16/2012 16:07'!
testAllTempAccessInstructions
		| ir |

		ir := IRBuilderTest new testPushTempTemp.
		self assert: ir allTempAccessInstructions size = 1.! !

!IRTransformTest methodsFor: 'testing - adding' stamp: 'MarcusDenker 8/18/2010 18:59'!
testAddIntructions
	
	| iRMethod aCompiledMethod |

	iRMethod := IRBuilder new
		pushLiteral: 1;				
		returnTop;
		ir.

	(iRMethod allSequences last) last delete.
	(iRMethod allSequences last) last delete.

	(iRMethod allSequences last)
			addInstructions: {(IRInstruction pushLiteral: 2). (IRInstruction returnTop)}.

	aCompiledMethod := iRMethod compiledMethod.
	self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2].
! !

!IRTransformTest methodsFor: 'testing - adding' stamp: 'MarcusDenker 8/18/2010 18:52'!
testReplaceInstr
	
	| iRMethod aCompiledMethod |

	iRMethod := IRBuilder new
		pushLiteral: 1;				
		returnTop;
		ir.
	
	(iRMethod allSequences last first) 
			replaceWithInstructions: {(IRInstruction pushLiteral: 2)}.

	aCompiledMethod := iRMethod compiledMethod.
	self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2].
! !

!IRTransformTest methodsFor: 'testing - adding' stamp: 'MarcusDenker 9/20/2013 15:18'!
testDelete
	
	| iRMethod aCompiledMethod |

	iRMethod := IRBuilder new
		pushLiteral: 1;				
		pushLiteral: 2;	
		returnTop;
		ir.

	((iRMethod allSequences last) 
		detect: [:each | each isPushLiteral: [:c | c == 2]]) delete.
			

	aCompiledMethod := iRMethod compiledMethod.
	self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 1].
! !

!IRTranslatorV2 commentStamp: 'ClementBer 10/14/2014 13:34'!
I visit IRMethod instructions, sending the appropriate bytecode messages to my BytecodeGenerator (gen). !
!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBera 10/15/2014 17:02'!
visitPushRemoteTemp: remoteTemp
	| tempIndex tempVectorIndex tempVector |

	tempVector := tempVectorStack detect: [:each | each name = remoteTemp tempVectorName].
	tempVectorIndex := tempVector indexForVarNamed: remoteTemp name.
	tempIndex := self currentScope indexForVarNamed: remoteTemp tempVectorName.

	gen pushRemoteTemp: tempVectorIndex inVectorAt: tempIndex
! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBera 10/27/2014 10:35'!
visitBlockReturnTop: blockReturnTop

	gen blockReturnTop
! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'MarcusDenker 11/6/2014 15:41'!
visitMethod: anIr
	IRFix new visitNode: anIr.
	self pushScope: anIr.
	gen irPrimitive: anIr irPrimitive.
	gen numArgs: anIr numArgs.
	gen properties: anIr properties.
	gen numTemps: (anIr tempMap size).
	gen additionalLiterals: anIr additionalLiterals.
	gen forceLongForm: anIr forceLongForm.
	self visitSequences: anIr allSequences.

! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:25'!
visitPopIntoTemp: tmp

   	gen storePopTemp: (self currentScope indexForVarNamed: tmp name)! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBera 10/15/2014 17:02'!
visitPushDup: dup
	
	gen pushDup


! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:13'!
visitPushInstVar: instVar
	
	gen pushInstVar: instVar index
! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBera 10/27/2014 10:35'!
visitSequence: instructionSequence
	self currentScope isPushClosureCopy ifTrue: [ 
		self currentScope destination = instructionSequence ifTrue: [ self popScope ] ].
	self label: instructionSequence orderNumber.
	super visitSequence: instructionSequence
! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBera 10/27/2014 10:36'!
visitReturnInstVar: instVar

	gen returnInstVar: instVar index! !

!IRTranslatorV2 methodsFor: 'private' stamp: 'ClementBer 10/14/2014 13:40'!
popScope

	currentScope size = 1 ifFalse: [currentScope pop]
! !

!IRTranslatorV2 methodsFor: 'initialize' stamp: 'ClementBera 1/28/2015 09:27'!
initialize
	gen := self compilationContext bytecodeGeneratorClass newWithEncoderClass: self compilationContext encoderClass.
	trailer := CompiledMethodTrailer empty.
	currentScope := Stack new.
	tempVectorStack := Stack new.
! !

!IRTranslatorV2 methodsFor: 'results' stamp: 'ClementBer 10/14/2014 13:57'!
compiledMethodWith: aTrailer

	^ gen compiledMethodWith: aTrailer! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:15'!
visitStoreRemoteTemp: remoteTemp
	| tempIndex tempVectorIndex tempVector |

	tempVector := tempVectorStack detect: [:each | each name = remoteTemp tempVectorName].
	tempVectorIndex := tempVector indexForVarNamed: remoteTemp name.
	tempIndex := self currentScope indexForVarNamed: remoteTemp tempVectorName.

	gen storeRemoteTemp: tempVectorIndex inVectorAt: tempIndex! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:14'!
visitStoreLiteralVariable: var

	gen storeIntoLiteralVariable: var association! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:08'!
visitPopIntoLiteralVariable: var

	gen storePopIntoLiteralVariable: var association! !

!IRTranslatorV2 methodsFor: 'private' stamp: 'ClementBer 10/14/2014 14:25'!
pragmas: aCollection
	gen pragmas: aCollection! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBera 10/15/2014 17:02'!
visitPop: pop

	gen popTop

! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:14'!
visitPushLiteralVariable: var

	gen pushLiteralVariable: var association! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBera 10/15/2014 17:01'!
visitJump: jump

	gen goto: jump destination orderNumber
! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBera 10/15/2014 17:02'!
visitPushClosureCopy: closure

	closure copiedValues do: [:name | 
		gen pushTemp: (self currentScope indexForVarNamed: name).
		gen mapBytesTo: closure ].

	gen pushClosureCopyNumCopiedValues: closure copiedValues size 
			numArgs: closure arguments size 
			to: closure destination orderNumber.
	self pushScope: closure.
	gen pushNClosureTemps: closure definedTemps size

! !

!IRTranslatorV2 methodsFor: 'private' stamp: 'ClementBer 10/14/2014 16:17'!
label: seqNum

	gen label: seqNum.
	
! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:14'!
visitPushReceiver: receiver

	gen pushReceiver


! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBera 10/15/2014 17:01'!
visitJumpIf: jumpIf

	gen 
		if: jumpIf boolean 
		goto: jumpIf destination orderNumber 
		otherwise: jumpIf otherwise orderNumber
! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:10'!
visitPopIntoRemoteTemp: remoteTemp
	| tempIndex tempVectorIndex tempVector |

	tempVector := tempVectorStack detect: [ :each | each name = remoteTemp tempVectorName ].
	tempVectorIndex := tempVector indexForVarNamed: remoteTemp name.
	tempIndex := self currentScope indexForVarNamed: remoteTemp tempVectorName.

	gen storePopRemoteTemp: tempVectorIndex inVectorAt: tempIndex! !

!IRTranslatorV2 methodsFor: 'initialize' stamp: 'ClementBer 10/14/2014 13:35'!
trailer: aTrailer

	trailer := aTrailer! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:14'!
visitStoreInstVar: instVar
	gen storeInstVar: instVar index! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:15'!
visitStoreTemp: tmp

   	gen storeTemp: (self currentScope indexForVarNamed: tmp name)! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBera 10/15/2014 17:03'!
visitSend: send

	send superOf
		ifNil: [ gen send: send selector ]
		ifNotNil: [ :behavior | gen send: send selector toSuperOf: behavior ]
! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBera 10/27/2014 10:36'!
visitReturnLiteral: lit

	gen returnConstant: lit literal
! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:06'!
visitPopIntoInstVar: instVar
	gen storePopInstVar: instVar index! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBera 10/15/2014 17:02'!
visitPushArray: array

	array cons 
		ifTrue: [  
			gen pushConsArray: array size ]
		ifFalse: [
			gen pushNewArray: array size ]! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 15:50'!
visitSequences:  irSequences
	irSequences withIndexDo: [ :seq :i | seq orderNumber: i].
	self visitNodes: irSequences.
! !

!IRTranslatorV2 methodsFor: 'private' stamp: 'ClementBer 10/14/2014 13:56'!
currentScope 
	^currentScope top! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBera 10/15/2014 17:02'!
visitPushTemp: tmp

	gen pushTemp: (self currentScope indexForVarNamed: tmp name)



! !

!IRTranslatorV2 methodsFor: 'accessing' stamp: 'ClementBer 10/14/2014 13:35'!
compilationContext
	^ compilationContext ifNil: [ compilationContext := CompilationContext default ]! !

!IRTranslatorV2 methodsFor: 'results' stamp: 'ClementBer 10/14/2014 13:57'!
compiledMethod
	^ gen compiledMethodWith: trailer! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBera 10/15/2014 17:01'!
visitInstruction: instr
	self visitNode: instr.
	gen mapBytesTo: instr.! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBera 10/27/2014 10:36'!
visitReturnReceiver: rec

	gen returnReceiver


! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:14'!
visitPushThisContext: ctxt

	gen pushThisContext

! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBera 10/15/2014 17:03'!
visitTempVector: tempVector

	tempVectorStack push: tempVector.
	gen pushNewArray: tempVector vars size. 
	gen storePopTemp: (self currentScope indexForVarNamed: tempVector name)! !

!IRTranslatorV2 methodsFor: 'accessing' stamp: 'ClementBer 10/14/2014 13:35'!
compilationContext: aContext
	compilationContext := aContext! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBera 10/27/2014 10:36'!
visitReturn: ret
	
	gen returnTop


! !

!IRTranslatorV2 methodsFor: 'private' stamp: 'ClementBer 10/14/2014 13:47'!
pushScope: anIRBlockOrMethod

	currentScope push: anIRBlockOrMethod! !

!IRTranslatorV2 methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:13'!
visitPushLiteral: lit

	gen pushLiteral: lit literal! !

!IRVisitor commentStamp: 'ClementBer 10/14/2014 13:58'!
I visit an IRMethod instructions and write them out to a print stream.!
!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:09'!
visitPushRemoteTemp: pushRemoteTemp! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:09'!
visitBlockReturnTop: blockReturnTop! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 15:48'!
visitMethod: method
	self visitNodes: method allSequences.! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:08'!
visitPopIntoTemp: tmp! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:09'!
visitPushDup: pushDup! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:09'!
visitPushInstVar: pushInstVar! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 15:49'!
visitSequence: sequence
	sequence do: [ :instr | self visitInstruction: instr].! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:11'!
visitReturnInstVar: instVar! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:09'!
visitStoreRemoteTemp: storeRemoteTemp! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:09'!
visitStoreLiteralVariable: storeLiteralVariable! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:07'!
visitPopIntoLiteralVariable: litVar! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:09'!
visitPushLiteralVariable: pushLiteralVariable! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:09'!
visitPop: pop! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:09'!
visitStoreInstVar: storeInstVar! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:09'!
visitJump: jump! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:09'!
visitPushClosureCopy: pushClosureCopy! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:29'!
visitPushReceiver: receiver! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 13:55'!
visitNodes: col
	col do: [ :each | self visitNode: each ]! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:09'!
visitJumpIf: jumpIf! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:09'!
visitPopIntoRemoteTemp: remoteTemp! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:09'!
visitStoreTemp: storeTemp! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:09'!
visitSend: send! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:12'!
visitReturnLiteral: lit! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:06'!
visitPopIntoInstVar: instVar! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:09'!
visitPushArray: pushArray! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 13:55'!
visitNode: elem
	^ elem accept: self! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:09'!
visitPushTemp: pushTemp! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBera 10/15/2014 17:11'!
visitInstruction: instr
	 ! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 16:12'!
visitReturnReceiver: rec! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:09'!
visitPushThisContext: pushThisContext! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:09'!
visitTempVector: tempVector! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:09'!
visitReturn: return! !

!IRVisitor methodsFor: 'visiting' stamp: 'ClementBer 10/14/2014 14:09'!
visitPushLiteral: pushLiteral! !

!IRVisitorTest methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 14:43'!
testReturnTop
	| ir |
	ir := IRBuilderTest new testReturnTop.
	self interpret: ir! !

!IRVisitorTest methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 14:43'!
testPushTempArgument
	| ir |
	ir := IRBuilderTest new testPushTempArgument.
	self interpret: ir! !

!IRVisitorTest methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 14:43'!
testJumpBackTo
	| ir |
	ir := IRBuilderTest new testJumpBackTo.
	self interpret: ir! !

!IRVisitorTest methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 14:43'!
testJumpAheadTo
	| ir |
	ir := IRBuilderTest new testJumpAheadTo.
	self interpret: ir! !

!IRVisitorTest methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 14:43'!
testLiteralVariableClass
	| ir |
	ir := IRBuilderTest new testLiteralVariableClass.
	self interpret: ir! !

!IRVisitorTest methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 14:43'!
testDup
	| ir |
	ir := IRBuilderTest new testDup.
	self interpret: ir! !

!IRVisitorTest methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 14:43'!
testPushConsArray
	| ir |
	ir := IRBuilderTest new testPushConsArray.
	self interpret: ir! !

!IRVisitorTest methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 14:43'!
testPopTop
	| ir |
	ir := IRBuilderTest new testPopTop.
	self interpret: ir! !

!IRVisitorTest methodsFor: 'helper' stamp: 'ClementBer 10/14/2014 14:44'!
interpret: ir
	IRVisitor new visitNode: ir! !

!IRVisitorTest methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 14:43'!
testPushSelf
	| ir |
	ir := IRBuilderTest new testPushSelf.
	self interpret: ir! !

!IRVisitorTest methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 14:43'!
testPushNewArray
	| ir |
	ir := IRBuilderTest new testPushNewArray.
	self interpret: ir! !

!IRVisitorTest methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 14:43'!
testRemoteTempNested
	| ir |
	ir := IRBuilderTest new testRemoteTempNested.
	self interpret: ir! !

!IRVisitorTest methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 14:43'!
testRemoteTemp
	| ir |
	ir := IRBuilderTest new testRemoteTemp.
	self interpret: ir! !

!IRVisitorTest methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 14:43'!
testPushThisContext
	| ir |
	ir := IRBuilderTest new testPushThisContext.
	self interpret: ir! !

!IRVisitorTest methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 14:43'!
testStoreIntoVariable
	| ir |
	ir := IRBuilderTest new testStoreIntoVariable.
	self interpret: ir! !

!IRVisitorTest methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 14:43'!
testSendSuper
	| ir |
	ir := IRBuilderTest new testSendSuper.
	self interpret: ir! !

!IRVisitorTest methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 14:43'!
testPushTempTemp
	| ir |
	ir := IRBuilderTest new testPushTempTemp.
	self interpret: ir! !

!IRVisitorTest methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 14:43'!
testJumpAheadToIf
	| ir |
	ir := IRBuilderTest new testJumpAheadToIf.
	self interpret: ir! !

!IRVisitorTest methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 14:43'!
testInstVar
	| ir |
	ir := IRBuilderTest new testInstVar.
	self interpret: ir! !

!IRVisitorTest methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 14:43'!
testStoreTemp
	| ir |
	ir := IRBuilderTest new testStoreTemp.
	self interpret: ir! !

!IRVisitorTest methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 14:43'!
testLiteralArray
	| ir |
	ir := IRBuilderTest new testLiteralArray.
	self interpret: ir! !

!IRVisitorTest methodsFor: 'testing' stamp: 'ClementBer 10/14/2014 14:43'!
testPushClosureCopyNoCopied
	| ir |
	ir := IRBuilderTest new testPushClosureCopyNoCopied.
	self interpret: ir! !

!ISO885915TextConverter commentStamp: '<historical>'!
Text converter for ISO 8859-15.  An international encoding used in Western Europe, similar to ISO 8859-1 but adds the Euro symbol and drops others like one quarter.!
!ISO885915TextConverter class methodsFor: 'initialization' stamp: 'pmm 8/16/2010 10:58'!
initialize
	self initializeTables! !

!ISO885915TextConverter class methodsFor: 'accessing' stamp: 'pmm 8/16/2010 10:30'!
languageEnvironment
	^Latin9Environment! !

!ISO885915TextConverter class methodsFor: 'accessing' stamp: 'pmm 8/16/2010 10:30'!
encodingNames 

	^ #('iso-8859-15') copy
! !

!ISO885915TextConverter class methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 3/7/2012 21:38'!
byteToUnicodeSpec
	"ByteTextConverter generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/ISO8859/8859-15.TXT'"

	^ #(
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	16r00A0 16r00A1 16r00A2 16r00A3 16r20AC 16r00A5 16r0160 16r00A7 
	16r0161 16r00A9 16r00AA 16r00AB 16r00AC 16r00AD 16r00AE 16r00AF 
	16r00B0 16r00B1 16r00B2 16r00B3 16r017D 16r00B5 16r00B6 16r00B7 
	16r017E 16r00B9 16r00BA 16r00BB 16r0152 16r0153 16r0178 16r00BF 
	16r00C0 16r00C1 16r00C2 16r00C3 16r00C4 16r00C5 16r00C6 16r00C7 
	16r00C8 16r00C9 16r00CA 16r00CB 16r00CC 16r00CD 16r00CE 16r00CF 
	16r00D0 16r00D1 16r00D2 16r00D3 16r00D4 16r00D5 16r00D6 16r00D7 
	16r00D8 16r00D9 16r00DA 16r00DB 16r00DC 16r00DD 16r00DE 16r00DF 
	16r00E0 16r00E1 16r00E2 16r00E3 16r00E4 16r00E5 16r00E6 16r00E7 
	16r00E8 16r00E9 16r00EA 16r00EB 16r00EC 16r00ED 16r00EE 16r00EF 
	16r00F0 16r00F1 16r00F2 16r00F3 16r00F4 16r00F5 16r00F6 16r00F7 
	16r00F8 16r00F9 16r00FA 16r00FB 16r00FC 16r00FD 16r00FE 16r00FF )! !

!ISO88592TextConverter commentStamp: '<historical>'!
Text converter for ISO 8859-2.  An international encoding used in Eastern Europe.!
!ISO88592TextConverter class methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 3/7/2012 21:46'!
initialize
	self initializeTables! !

!ISO88592TextConverter class methodsFor: 'accessing' stamp: 'michael.rueger 2/2/2009 18:48'!
languageEnvironment
	^Latin2Environment! !

!ISO88592TextConverter class methodsFor: 'utilities' stamp: 'yo 1/18/2005 09:17'!
encodingNames 

	^ #('iso-8859-2') copy
! !

!ISO88592TextConverter class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 3/7/2012 21:39'!
byteToUnicodeSpec
	"ByteTextConverter generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/ISO8859/8859-2.TXT'"

	^ #(
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	16r00A0 16r0104 16r02D8 16r0141 16r00A4 16r013D 16r015A 16r00A7 
	16r00A8 16r0160 16r015E 16r0164 16r0179 16r00AD 16r017D 16r017B 
	16r00B0 16r0105 16r02DB 16r0142 16r00B4 16r013E 16r015B 16r02C7 
	16r00B8 16r0161 16r015F 16r0165 16r017A 16r02DD 16r017E 16r017C 
	16r0154 16r00C1 16r00C2 16r0102 16r00C4 16r0139 16r0106 16r00C7 
	16r010C 16r00C9 16r0118 16r00CB 16r011A 16r00CD 16r00CE 16r010E 
	16r0110 16r0143 16r0147 16r00D3 16r00D4 16r0150 16r00D6 16r00D7 
	16r0158 16r016E 16r00DA 16r0170 16r00DC 16r00DD 16r0162 16r00DF 
	16r0155 16r00E1 16r00E2 16r0103 16r00E4 16r013A 16r0107 16r00E7 
	16r010D 16r00E9 16r0119 16r00EB 16r011B 16r00ED 16r00EE 16r010F 
	16r0111 16r0144 16r0148 16r00F3 16r00F4 16r0151 16r00F6 16r00F7 
	16r0159 16r016F 16r00FA 16r0171 16r00FC 16r00FD 16r0163 16r02D9 )! !

!ISO88597TextConverter commentStamp: '<historical>'!
Text converter for ISO 8859-7.  An international encoding used for Greek. !
!ISO88597TextConverter class methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 3/7/2012 21:46'!
initialize
	self initializeTables! !

!ISO88597TextConverter class methodsFor: 'accessing' stamp: 'michael.rueger 2/2/2009 18:49'!
languageEnvironment
	^GreekEnvironment! !

!ISO88597TextConverter class methodsFor: 'utilities' stamp: 'yo 2/10/2004 06:32'!
encodingNames 

	^ #('iso-8859-7' 'greek-iso-8859-8bit') copy
! !

!ISO88597TextConverter class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 3/7/2012 21:39'!
byteToUnicodeSpec
	"ByteTextConverter generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/ISO8859/8859-7.TXT'"

	^ #(
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	16r00A0 16r2018 16r2019 16r00A3 16r20AC 16r20AF 16r00A6 16r00A7 
	16r00A8 16r00A9 16r037A 16r00AB 16r00AC 16r00AD nil 16r2015 
	16r00B0 16r00B1 16r00B2 16r00B3 16r0384 16r0385 16r0386 16r00B7 
	16r0388 16r0389 16r038A 16r00BB 16r038C 16r00BD 16r038E 16r038F 
	16r0390 16r0391 16r0392 16r0393 16r0394 16r0395 16r0396 16r0397 
	16r0398 16r0399 16r039A 16r039B 16r039C 16r039D 16r039E 16r039F 
	16r03A0 16r03A1 nil 16r03A3 16r03A4 16r03A5 16r03A6 16r03A7 
	16r03A8 16r03A9 16r03AA 16r03AB 16r03AC 16r03AD 16r03AE 16r03AF 
	16r03B0 16r03B1 16r03B2 16r03B3 16r03B4 16r03B5 16r03B6 16r03B7 
	16r03B8 16r03B9 16r03BA 16r03BB 16r03BC 16r03BD 16r03BE 16r03BF 
	16r03C0 16r03C1 16r03C2 16r03C3 16r03C4 16r03C5 16r03C6 16r03C7 
	16r03C8 16r03C9 16r03CA 16r03CB 16r03CC 16r03CD 16r03CE nil )! !

!ISOLanguageDefinition commentStamp: 'StephaneDucasse 9/13/2014 21:04'!
The language definitions from International Organization for Standardization.

You can obtain the list of the all the ISOCountries and languages.!
!ISOLanguageDefinition methodsFor: 'accessing' stamp: 'StephaneDucasse 9/13/2014 21:02'!
language
	^ language! !

!ISOLanguageDefinition methodsFor: 'accessing' stamp: 'mir 6/30/2004 15:54'!
iso2: aString
	iso2 := aString ifEmpty: [nil] ifNotEmpty: [aString]! !

!ISOLanguageDefinition methodsFor: 'accessing' stamp: 'mir 7/1/2004 18:21'!
iso3
	^iso3 ifNil: ['']! !

!ISOLanguageDefinition methodsFor: 'accessing' stamp: 'mir 8/15/2003 13:40'!
language: aString
	language := aString! !

!ISOLanguageDefinition methodsFor: 'accessing' stamp: 'mir 6/30/2004 15:54'!
iso3Alternate: aString
	iso3Alternate := aString ifEmpty: [nil] ifNotEmpty: [aString]! !

!ISOLanguageDefinition methodsFor: 'accessing' stamp: 'mir 7/1/2004 18:20'!
iso2
	^iso2 ifNil: [self iso3]! !

!ISOLanguageDefinition methodsFor: 'accessing' stamp: 'mir 6/30/2004 15:54'!
iso3: aString
	iso3 := aString ifEmpty: [nil] ifNotEmpty: [aString]! !

!ISOLanguageDefinition methodsFor: 'accessing' stamp: 'mir 6/30/2004 15:47'!
iso3Alternate
	^iso3Alternate ifNil: ['']! !

!ISOLanguageDefinition class methodsFor: 'private - ISO 3166' stamp: 'StephaneDucasse 9/13/2014 21:04'!
initISO3LanguageTable
	"self  initISO3LanguageTable"
	
	^ self readISOLanguagesFrom: self isoLanguages readStream.
	! !

!ISOLanguageDefinition class methodsFor: 'private - ISO 3166' stamp: 'StephaneDucasse 9/13/2014 21:05'!
iso3166Codes
	"http://www.unicode.org/onlinedat/countries.html"

^'ÅLAND ISLANDS
AX


 
 
 
 
AFGHANISTAN
AF
AFG
004
 
 
 
 
ALBANIA
AL
ALB
008
CTRY_ALBANIA
355
 
 
ALGERIA
DZ
DZA
012
CTRY_ALGERIA
213
verArabic
16
AMERICAN SAMOA
AS
ASM
016
 
 
 
 
ANDORRA
AD
AND
020
 
 
 
 
ANGOLA
AO
AGO
024
 
 
 
 
ANGUILLA
AI
AIA
660
 
 
 
 
ANTARCTICA
AQ
ATA
010
 
 
 
 
ANTIGUA AND BARBUDA
AG
ATG
028
 
 
 
 
ARGENTINA
AR
ARG
032
CTRY_ARGENTINA
54
 
 
ARMENIA
AM
ARM
051
CTRY_ARMENIA
374
verArmenian
84
ARUBA
AW
ABW
533
 
 
 
 
AUSTRALIA
AU
AUS
036
CTRY_AUSTRALIA
61
verAustralia
15
AUSTRIA
AT
AUT
040
CTRY_AUSTRIA
43
verAustria
92
AZERBAIJAN
AZ
AZE
031
CTRY_AZERBAIJAN
994
 
 
BAHAMAS
BS
BHS
044
 
 
 
 
BAHRAIN
BH
BHR
048
CTRY_BAHRAIN
973
 
 
BANGLADESH
BD
BGD
050
 
 
verBengali
60
BARBADOS
BB
BRB
052
 
 
 
 
BELARUS
BY
BLR
112
CTRY_BELARUS
375
 
 
BELGIUM
BE
BEL
056
CTRY_BELGIUM
32
verFrBelgium, verFlemish
98
BELIZE
BZ
BLZ
084
CTRY_BELIZE
501
 
 
BENIN
BJ
BEN
204
 
 
 
 
BERMUDA
BM
BMU
060
 
 
 
 
BHUTAN
BT
BTN
064
 
 
verBhutan
83
BOLIVIA
BO
BOL
068
CTRY_BOLIVIA
591
 
 
BOSNIA AND HERZEGOVINA
BA
BIH
070
 
 
 
 
BOTSWANA
BW
BWA
072
 
 
 
 
BOUVET ISLAND
BV
BVT
074
 
 
 
 
BRAZIL
BR
BRA
076
CTRY_BRAZIL
55
verBrazil
71
BRITISH INDIAN OCEAN TERRITORY
IO
IOT
086
 
 
 
 
BRUNEI DARUSSALAM
BN
BRN
096
CTRY_BRUNEI_DARUSSALAM
673
 
 
BULGARIA
BG
BGR
100
CTRY_BULGARIA
359
verBulgaria 
72
BURKINA FASO
BF
BFA
854
 
 
 
 
BURUNDI
BI
BDI
108
 
 
 
 
CAMBODIA
KH
KHM
116
 
 
 
 
CAMEROON
CM
CMR
120
 
 
 
 
CANADA
CA
CAN
124
CTRY_CANADA
2
verFrCanada, verEndCanada
82
CAPE VERDE
CV
CPV
132
 
 
 
 
CAYMAN ISLANDS
KY
CYM
136
 
 
 
 
CENTRAL AFRICAN REPUBLIC
CF
CAF
140
 
 
 
 
CHAD
TD
TCD
148
 
 
 
 
CHILE
CL
CHL
152
CTRY_CHILE
56
 
 
CHINA
CN
CHN
156
CTRY_PRCHINA
86
verChina
52
CHRISTMAS ISLAND
CX
CXR
162
 
 
 
 
COCOS (KEELING) ISLANDS
CC
CCK
166
 
 
 
 
COLOMBIA
CO
COL
170
CTRY_COLOMBIA
57
 
 
COMOROS
KM
COM
174
 
 
 
 
CONGO
CG
COG
178
 
 
 
 
CONGO, THE DEMOCRATIC REPUBLIC OF THE
CD


 
 
 
 
COOK ISLANDS
CK
COK
184
 
 
 
 
COSTA RICA
CR
CRI
188
CTRY_COSTA_RICA
506
 
 
COTE D''IVOIRE
CI
CIV
384
 
 
 
 
CROATIA (local name: Hrvatska)
HR
HRV
191
CTRY_CROATIA
385
verCroatia, verYugoCroatian
68 (c), 25 (y)
CUBA
CU
CUB
192
 
 
 
 
CYPRUS
CY
CYP
196
 
 
verCyprus
23
CZECH REPUBLIC
CZ
CZE
203
CTRY_CZECH
420
verCzech 
56
DENMARK
DK
DNK
208
CTRY_DENMARK
45
verDenmark(da), verFaeroeIsl(fo)
9(da), 47(fo)
DJIBOUTI
DJ
DJI
262
 
 
 
 
DOMINICA
DM
DMA
212
 
 
 
 
DOMINICAN REPUBLIC
DO
DOM
214
CTRY_DOMINICAN_REPUBLIC
1
 
 
EAST TIMOR
TL
TLS
626
 
 
 
 
ECUADOR
EC
ECU
218
CTRY_ECUADOR
593
 
 
EGYPT
EG
EGY
818
CTRY_EGYPT
20
verArabic
16
EL SALVADOR
SV
SLV
222
CTRY_EL_SALVADOR
503
 
 
EQUATORIAL GUINEA
GQ
GNQ
226
 
 
 
 
ERITREA
ER
ERI
232
 
 
 
 
ESTONIA
EE
EST
233
CTRY_ESTONIA
372
verEstonia
44
ETHIOPIA
ET
ETH
210
 
 
 
 
FALKLAND ISLANDS (MALVINAS)
FK
FLK
238
 
 
 
 
FAROE ISLANDS
FO
FRO
234
CTRY_FAEROE_ISLANDS
298
 
 
FIJI
FJ
FJI
242
 
 
 
 
FINLAND
FI
FIN
246
CTRY_FINLAND
358
verFinland
17
FRANCE
FR
FRA
250
CTRY_FRANCE
33
verFrance
1
FRANCE, METROPOLITAN
FX
FXX
249
 
 
 
 
FRENCH GUIANA
GF
GUF
254
 
 
 
 
FRENCH POLYNESIA
PF
PYF
258
 
 
 
 
FRENCH SOUTHERN TERRITORIES
TF
ATF
260
 
 
 
 
GABON
GA
GAB
266
 
 
 
 
GAMBIA
GM
GMB
270
 
 
 
 
GEORGIA
GE
GEO
268
CTRY_GEORGIA
995
verGeorgian
85
GERMANY
DE
DEU
276
CTRY_GERMANY
49
verGermany
3
GHANA
GH
GHA
288
 
 
 
 
GIBRALTAR
GI
GIB
292
 
 
 
 
GREECE
GR
GRC
300
CTRY_GREECE
30
verGreece, verGreecePoly
20, 40
GREENLAND
GL
GRL
304
 
 
verGreenland
107
GRENADA
GD
GRD
308
 
 
 
 
GUADELOUPE
GP
GLP
312
 
 
 
 
GUAM
GU
GUM
316
 
 
 
 
GUATEMALA
GT
GTM
320
CTRY_GUATEMALA
502
 
 
GUINEA
GN
GIN
324
 
 
 
 
GUINEA-BISSAU
GW
GNB
624
 
 
 
 
GUYANA
GY
GUY
328
 
 
 
 
HAITI
HT
HTI
332
 
 
 
 
HEARD ISLAND & MCDONALD ISLANDS
HM
HMD
334
 
 
 
 
HONDURAS
HN
HND
340
CTRY_HONDURAS
504
 
 
HONG KONG
HK
HKG
344
CTRY_HONG_KONG
852
 
 
HUNGARY
HU
HUN
348
CTRY_HUNGARY
36
verHungary
43
ICELAND
IS
ISL
352
CTRY_ICELAND
354
verIceland
21
INDIA
IN
IND
356
CTRY_INDIA
91
verIndiaHindi(hi)
33
INDONESIA
ID
IDN
360
CTRY_INDONESIA
62
 
 
IRAN, ISLAMIC REPUBLIC OF
IR
IRN
364
CTRY_IRAN
981
verIran
48
IRAQ
IQ
IRQ
368
CTRY_IRAQ
964
verArabic
16
IRELAND
IE
IRL
372
CTRY_IRELAND
353
verIreland
50
ISRAEL
IL
ISR
376
CTRY_ISRAEL
972
verIsrael
13
ITALY
IT
ITA
380
CTRY_ITALY
39
verItaly
4
JAMAICA
JM
JAM
388
CTRY_JAMAICA
1
 
 
JAPAN
JP
JPN
392
CTRY_JAPAN
81
verJapan
14
JORDAN
JO
JOR
400
CTRY_JORDAN
962
 
 
KAZAKHSTAN
KZ
KAZ
398
CTRY_KAZAKSTAN
7
 
 
KENYA
KE
KEN
404
CTRY_KENYA
254
 
 
KIRIBATI
KI
KIR
296
 
 
 
 
KOREA, DEMOCRATIC PEOPLE''S REPUBLIC OF
KP
PRK
408
 
 
verKorea
51
KOREA, REPUBLIC OF
KR
KOR
410
CTRY_SOUTH_KOREA
82
verKorea
 
KUWAIT
KW
KWT
414
CTRY_KUWAIT
965
 
 
KYRGYZSTAN
KG
KGZ
417
CTRY_KYRGYZSTAN
996
 
 
LAO PEOPLE''S DEMOCRATIC REPUBLIC
LA
LAO
418
 
 
 
 
LATVIA
LV
LVA
428
CTRY_LATVIA
371
verLatvia
45
LEBANON
LB
LBN
422
CTRY_LEBANON
961
 
 
LESOTHO
LS
LSO
426
 
 
 
 
LIBERIA
LR
LBR
430
 
 
 
 
LIBYAN ARAB JAMAHIRIYA
LY
LBY
434
CTRY_LIBYA
218
verArabic
16
LIECHTENSTEIN
LI
LIE
438
CTRY_LIECHTENSTEIN
41
 
 
LITHUANIA
LT
LTU
440
CTRY_LITHUANIA
370
verLithuania
41
LUXEMBOURG
LU
LUX
442
CTRY_LUXEMBOURG
352
verFrBelgiumLux
6
MACAU
MO
MAC
446
CTRY_MACAU
853
 
 
MACEDONIA, THE FORMER YUGOSLAV REPUBLIC OF
MK
MKD
807
CTRY_MACEDONIA
389
verMacedonian
 
MADAGASCAR
MG
MDG
450
 
 
 
 
MALAWI
MW
MWI
454
 
 
 
 
MALAYSIA
MY
MYS
458
CTRY_MALAYSIA
60
 
 
MALDIVES
MV
MDV
462
CTRY_MALDIVES
960
 
 
MALI
ML
MLI
466
 
 
 
 
MALTA
MT
MLT
470
 
 
verMalta
22
MARSHALL ISLANDS
MH
MHL
584
 
 
 
 
MARTINIQUE
MQ
MTQ
474
 
 
 
 
MAURITANIA
MR
MRT
478
 
 
 
 
MAURITIUS
MU
MUS
480
 
 
 
 
MAYOTTE
YT
MYT
175
 
 
 
 
MEXICO
MX
MEX
484
CTRY_MEXICO
52
 
 
MICRONESIA, FEDERATED STATES OF
FM
FSM
583
 
 
 
 
MOLDOVA, REPUBLIC OF
MD
MDA
498
 
 
 
 
MONACO
MC
MCO
492
CTRY_MONACO
33
 
 
MONGOLIA
MN
MNG
496
CTRY_MONGOLIA
976
 
 
MONTSERRAT
MS
MSR
500
 
 
 
 
MOROCCO
MA
MAR
504
CTRY_MOROCCO
212
verArabic
16
MOZAMBIQUE
MZ
MOZ
508
 
 
 
 
MYANMAR
MM
MMR
104
 
 
 
 
NAMIBIA
NA
NAM
516
 
 
 
 
NAURU
NR
NRU
520
 
 
 
 
NEPAL
NP
NPL
524
 
 
verNepal
106
NETHERLANDS
NL
NLD
528
CTRY_NETHERLANDS
31
verNetherlands
5
NETHERLANDS ANTILLES
AN
ANT
530
 
 
 
 
NEW CALEDONIA
NC
NCL
540
 
 
 
 
NEW ZEALAND
NZ
NZL
554
CTRY_NEW_ZEALAND
64
 
 
NICARAGUA
NI
NIC
558
CTRY_NICARAGUA
505
 
 
NIGER
NE
NER
562
 
 
 
 
NIGERIA
NG
NGA
566
 
 
 
 
NIUE
NU
NIU
570
 
 
 
 
NORFOLK ISLAND
NF
NFK
574
 
 
 
 
NORTHERN MARIANA ISLANDS
MP
MNP
580
 
 
 
 
NORWAY
NO
NOR
578
CTRY_NORWAY
47
verNorway
12
OMAN
OM
OMN
512
CTRY_OMAN
968
 
 
PAKISTAN
PK
PAK
586
CTRY_PAKISTAN
92
verPakistanUrdu, verPunjabi
34 (U), 95 (P)
PALAU
PW
PLW
585
 
 
 
 
PANAMA
PA
PAN
591
CTRY_PANAMA
507
 
 
PALESTINIAN TERRITORY, OCCUPIED
PS




 
 
PAPUA NEW GUINEA
PG
PNG
598
 
 
 
 
PARAGUAY
PY
PRY
600
CTRY_PARAGUAY
595
 
 
PERU
PE
PER
604
CTRY_PERU
51
 
 
PHILIPPINES
PH
PHL
608
CTRY_PHILIPPINES
63
 
 
PITCAIRN
PN
PCN
612
 
 
 
 
POLAND
PL
POL
616
CTRY_POLAND
48
verPoland
42
PORTUGAL
PT
PRT
620
CTRY_PORTUGAL
351
verPortugal
10
PUERTO RICO
PR
PRI
630
CTRY_PUERTO_RICO
1
 
 
QATAR
QA
QAT
634
CTRY_QATAR
974
 
 
REUNION
RE
REU
638
 
 
 
 
ROMANIA
RO
ROU*
642
CTRY_ROMANIA
40
verRomania
39
RUSSIAN FEDERATION
RU
RUS
643
CTRY_RUSSIA
7
verRussia
49
RWANDA
RW
RWA
646
 
 
 
 
SAINT KITTS AND NEVIS
KN
KNA
659
 
 
 
 
SAINT LUCIA
LC
LCA
662
 
 
 
 
SAINT VINCENT AND THE GRENADINES
VC
VCT
670
 
 
 
 
SAMOA
WS
WSM
882
 
 
 
 
SAN MARINO
SM
SMR
674
 
 
 
 
SAO TOME AND PRINCIPE
ST
STP
678
 
 
 
 
SAUDI ARABIA
SA
SAU
682
CTRY_SAUDI_ARABIA
966
verArabic
16
SENEGAL
SN
SEN
686
 
 
 
 
SERBIA AND MONTENEGRO
CS
 
 
CTRY_SERBIA
381
 
 
SEYCHELLES
SC
SYC
690
 
 
 
 
SIERRA LEONE
SL
SLE
694
 
 
 
 
SINGAPORE
SG
SGP
702
CTRY_SINGAPORE
65
verSingapore
100
SLOVAKIA (Slovak Republic)
SK
SVK
703
CTRY_SLOVAK
421
verSlovak
57 
SLOVENIA
SI
SVN
705
CTRY_SLOVENIA
386
verSlovenian
66
SOLOMON ISLANDS
SB
SLB
90
 
 
 
 
SOMALIA
SO
SOM
706
 
 
 
 
SOUTH AFRICA
ZA
ZAF
710
CTRY_SOUTH_AFRICA
27
 
 
SOUTH GEORGIA AND THE SOUTH SANDWICH ISLANDS
GS




 
 
SPAIN
ES
ESP
724
CTRY_SPAIN
34
verSpain
8
SRI LANKA
LK
LKA
144
 
 
 
 
SAINT HELENA
SH
SHN
654
 
 
 
 
SAINT PIERRE AND MIQUELON
PM
SPM
666
 
 
 
 
SUDAN
SD
SDN
736
 
 
 
 
SURINAME
SR
SUR
740
 
 
 
 
SVALBARD AND JAN MAYEN ISLANDS
SJ
SJM
744
 
 
 
 
SWAZILAND
SZ
SWZ
748
 
 
 
 
SWEDEN
SE
SWE
752
CTRY_SWEDEN
46
verSweden
7
SWITZERLAND
CH
CHE
756
CTRY_SWITZERLAND
41
verFrSwiss(fr), verGrSwiss(de)
18(fr), 19(de)
SYRIAN ARAB REPUBLIC
SY
SYR
760
CTRY_SYRIA
963
 
 
TAIWAN, PROVINCE OF CHINA
TW
TWN
158
CTRY_TAIWAN
886
verTaiwan
53
TAJIKISTAN
TJ
TJK
762
 
 
 
 
TANZANIA, UNITED REPUBLIC OF
TZ
TZA
834
 
 
 
 
TATARSTAN


 
CTRY_TATARSTAN
7
 
 
THAILAND
TH
THA
764
CTRY_THAILAND
66
verThailand
54
TIMOR-LESTE
TL


 
 
 
 
TOGO
TG
TGO
768
 
 
 
 
TOKELAU
TK
TKL
772
 
 
 
 
TONGA
TO
TON
776
 
 
verTonga
88
TRINIDAD AND TOBAGO
TT
TTO
780
CTRY_TRINIDAD_Y_TOBAGO
1
 
 
TUNISIA
TN
TUN
788
CTRY_TUNISIA
216
verArabic
16
TURKEY
TR
TUR
792
CTRY_TURKEY
90
verTurkey
24
TURKMENISTAN
TM
TKM
795
 
 
 
 
TURKS AND CAICOS ISLANDS
TC
TCA
796
 
 
 
 
TUVALU
TV
TUV
798
 
 
 
 
UGANDA
UG
UGA
800
 
 
 
 
UKRAINE
UA
UKR
804
CTRY_UKRAINE
380
verUkraine 
62
UNITED ARAB EMIRATES
AE
ARE
784
CTRY_UAE
971
 
 
UNITED KINGDOM
GB
GBR
826
CTRY_UNITED_KINGDOM
44
verBritain
2
UNITED STATES
US
USA
840
CTRY_UNITED_STATES
1
verUS
0
UNITED STATES MINOR OUTLYING ISLANDS
UM
UMI
581
 
 
 
 
URUGUAY
UY
URY
858
CTRY_URUGUAY
598
 
 
UZBEKISTAN
UZ
UZB
860
CTRY_UZBEKISTAN
7
 
 
VANUATU
VU
VUT
548
 
 
 
 
VATICAN CITY STATE (HOLY SEE)
VA
VAT
336
 
 
 
 
VENEZUELA
VE
VEN
862
CTRY_VENEZUELA
58
 
 
VIET NAM
VN
VNM
704
CTRY_VIET_NAM
84
verVietnam
 
VIRGIN ISLANDS (BRITISH)
VG
VGB
92
 
 
 
 
VIRGIN ISLANDS (U.S.)
VI
VIR
850
 
 
 
 
WALLIS AND FUTUNA ISLANDS
WF
WLF
876
 
 
 
 
WESTERN SAHARA
EH
ESH
732
 
 
 
 
YEMEN
YE
YEM
887
CTRY_YEMEN
967
 
 
YUGOSLAVIA
YU
YUG
891
 
 
 
 
ZAIRE
ZR
ZAR
180
 
 
 
 
ZAMBIA
ZM
ZMB
894
 
 
 
 
ZIMBABWE
ZW
ZWE
716
CTRY_ZIMBABWE
263
 
 
'! !

!ISOLanguageDefinition class methodsFor: 'private' stamp: 'yo 12/3/2004 17:46'!
isoLanguages
	"ISO 639: 3-letter codes"
	^'abk	ab	Abkhazian
ace		Achinese
ach		Acoli
ada		Adangme
aar	aa	Afar
afh		Afrihili
afr	af	Afrikaans
afa		Afro-Asiatic (Other)
aka		Akan
akk		Akkadian
alb/sqi	sq	Albanian
ale		Aleut
alg		Algonquian languages
tut		Altaic (Other)
amh	am	Amharic
apa		Apache languages
ara	ar	Arabic
arc		Aramaic
arp		Arapaho
arn		Araucanian
arw		Arawak
arm/hye	hy	Armenian
art		Artificial (Other)
asm	as	Assamese
ath		Athapascan languages
map		Austronesian (Other)
ava		Avaric
ave		Avestan
awa		Awadhi
aym	ay	Aymara
aze	az	Azerbaijani
nah		Aztec
ban		Balinese
bat		Baltic (Other)
bal		Baluchi
bam		Bambara
bai		Bamileke languages
bad		Banda
bnt		Bantu (Other)
bas		Basa
bak	ba	Bashkir
baq/eus	eu	Basque
bej		Beja
bem		Bemba
ben	bn	Bengali
ber		Berber (Other)
bho		Bhojpuri
bih	bh	Bihari
bik		Bikol
bin		Bini
bis	bi	Bislama
bra		Braj
bre	be	Breton
bug		Buginese
bul	bg	Bulgarian
bua		Buriat
bur/mya	my	Burmese
bel	be	Byelorussian
cad		Caddo
car		Carib
cat	ca	Catalan
cau		Caucasian (Other)
ceb		Cebuano
cel		Celtic (Other)
cai		Central American Indian (Other)
chg		Chagatai
cha		Chamorro
che		Chechen
chr		Cherokee
chy		Cheyenne
chb		Chibcha
chi/zho	zh	Chinese
chn		Chinook jargon
cho		Choctaw
chu		Church Slavic
chv		Chuvash
cop		Coptic
cor		Cornish
cos	co	Corsican
cre		Cree
mus		Creek
crp		Creoles and Pidgins (Other)
cpe		Creoles and Pidgins, English-based (Other)
cpf		Creoles and Pidgins, French-based (Other)
cpp		Creoles and Pidgins, Portuguese-based (Other)
cus		Cushitic (Other)
	hr	Croatian
ces/cze	cs	Czech
dak		Dakota
dan	da	Danish
del		Delaware
din		Dinka
div		Divehi
doi		Dogri
dra		Dravidian (Other)
dua		Duala
dut/nla	nl	Dutch
dum		Dutch, Middle (ca. 1050-1350)
dyu		Dyula
dzo	dz	Dzongkha
efi		Efik
egy		Egyptian (Ancient)
eka		Ekajuk
elx		Elamite
eng	en	English
enm		English, Middle (ca. 1100-1500)
ang		English, Old (ca. 450-1100)
esk		Eskimo (Other)
epo	eo	Esperanto
est	et	Estonian
ewe		Ewe
ewo		Ewondo
fan		Fang
fat		Fanti
fao	fo	Faroese
fij	fj	Fijian
fin	fi	Finnish
fiu		Finno-Ugrian (Other)
fon		Fon
fra/fre	fr	French
frm		French, Middle (ca. 1400-1600)
fro		French, Old (842- ca. 1400)
fry	fy	Frisian
ful		Fulah
gaa		Ga
gae/gdh		Gaelic (Scots)
glg	gl	Gallegan
lug		Ganda
gay		Gayo
gez		Geez
geo/kat	ka	Georgian
deu/ger	de	German
gmh		German, Middle High (ca. 1050-1500)
goh		German, Old High (ca. 750-1050)
gem		Germanic (Other)
gil		Gilbertese
gon		Gondi
got		Gothic
grb		Grebo
grc		Greek, Ancient (to 1453)
ell/gre	el	Greek, Modern (1453-)
kal	kl	Greenlandic
grn	gn	Guarani
guj	gu	Gujarati
hai		Haida
hau	ha	Hausa
haw		Hawaiian
heb	he	Hebrew
her		Herero
hil		Hiligaynon
him		Himachali
hin	hi	Hindi
hmo		Hiri Motu
hun	hu	Hungarian
hup		Hupa
iba		Iban
ice/isl	is	Icelandic
ibo		Igbo
ijo		Ijo
ilo		Iloko
inc		Indic (Other)
ine		Indo-European (Other)
ind	id	Indonesian
ina	ia	Interlingua (International Auxiliary language Association)
ine		 Interlingue
iku	iu	Inuktitut
ipk	ik	Inupiak
ira		Iranian (Other)
gai/iri	ga	Irish
sga		Irish, Old (to 900)
mga		Irish, Middle (900 - 1200)
iro		Iroquoian languages
ita	it	Italian
jpn	ja	Japanese
jav/jaw	jv/jw Javanese
jrb		Judeo-Arabic
jpr		Judeo-Persian
kab		Kabyle
kac		Kachin
kam		Kamba
kan	kn	Kannada
kau		Kanuri
kaa		Kara-Kalpak
kar		Karen
kas	ks	Kashmiri
kaw		Kawi
kaz	kk	Kazakh
kha		Khasi
khm	km	Khmer
khi		Khoisan (Other)
kho		Khotanese
kik		Kikuyu
kin	rw	Kinyarwanda
kir	ky	Kirghiz
kom		Komi
kon		Kongo
kok		Konkani
kor	ko	Korean
kpe		Kpelle
kro		Kru
kua		Kuanyama
kum		Kumyk
kur	ku	Kurdish
kru		Kurukh
kus		Kusaie
kut		Kutenai
lad		Ladino
lah		Lahnda
lam		Lamba
oci	oc	Langue d''Oc (post 1500)
lao	lo	Lao
lat	la	Latin
lav	lv	Latvian
ltz		Letzeburgesch
lez		Lezghian
lin	ln	Lingala
lit	lt	Lithuanian
loz		Lozi
lub		Luba-Katanga
lui		Luiseno
lun		Lunda
luo		Luo (Kenya and Tanzania)
mac/mak	mk	Macedonian
mad		Madurese
mag		Magahi
mai		Maithili
mak		Makasar
mlg	mg	Malagasy
may/msa	ms	Malay
mal		Malayalam
mlt	ml	Maltese
man		Mandingo
mni		Manipuri
mno		Manobo languages
max		Manx
mao/mri	mi	Maori
mar	mr	Marathi
chm		Mari
mah		Marshall
mwr		Marwari
mas		Masai
myn		Mayan languages
men		Mende
mic		Micmac
min		Minangkabau
mis		Miscellaneous (Other)
moh		Mohawk
mol	mo	Moldavian
mkh		Mon-Kmer (Other)
lol		Mongo
mon	mn	Mongolian
mos		Mossi
mul		Multiple languages
mun		Munda languages
nau	na	Nauru
nav		Navajo
nde		Ndebele, North
nbl		Ndebele, South
ndo		Ndongo
nep	ne	Nepali
new		Newari
nic		Niger-Kordofanian (Other)
ssa		Nilo-Saharan (Other)
niu		Niuean
non		Norse, Old
nai		North American Indian (Other)
nor	no	Norwegian
nno		Norwegian (Nynorsk)
nub		Nubian languages
nym		Nyamwezi
nya		Nyanja
nyn		Nyankole
nyo		Nyoro
nzi		Nzima
oji		Ojibwa
ori	or	Oriya
orm	om	Oromo
osa		Osage
oss		Ossetic
oto		Otomian languages
pal		Pahlavi
pau		Palauan
pli		Pali
pam		Pampanga
pag		Pangasinan
pan	pa	Panjabi
pap		Papiamento
paa		Papuan-Australian (Other)
fas/per	fa	Persian
peo		Persian, Old (ca 600 - 400 B.C.)
phn		Phoenician
pol	pl	Polish
pon		Ponape
por	pt	Portuguese
pra		Prakrit languages
pro		Provencal, Old (to 1500)
pus	ps	Pushto
que	qu	Quechua
roh	rm	Rhaeto-Romance
raj		Rajasthani
rar		Rarotongan
roa		Romance (Other)
ron/rum	ro	Romanian
rom		Romany
run	rn	Rundi
rus	ru	Russian
sal		Salishan languages
sam		Samaritan Aramaic
smi		Sami languages
smo	sm	Samoan
sad		Sandawe
sag	sg	Sango
san	sa	Sanskrit
srd		Sardinian
sco		Scots
sel		Selkup
sem		Semitic (Other)
	sr	Serbian
scr	sh	Serbo-Croatian
srr		Serer
shn		Shan
sna	sn	Shona
sid		Sidamo
bla		Siksika
snd	sd	Sindhi
sin	si	Singhalese
sit		Sino-Tibetan (Other)
sio		Siouan languages
sla		Slavic (Other)
ssw	ss	Siswant
slk/slo	sk	Slovak
slv	sl	Slovenian
sog		Sogdian
som	so	Somali
son		Songhai
wen		Sorbian languages
nso		Sotho, Northern
sot	st	Sotho, Southern
sai		South American Indian (Other)
esl/spa	es	Spanish
suk		Sukuma
sux		Sumerian
sun	su	Sudanese
sus		Susu
swa	sw	Swahili
ssw		Swazi
sve/swe	sv	Swedish
syr		Syriac
tgl	tl	Tagalog
tah		Tahitian
tgk	tg	Tajik
tmh		Tamashek
tam	ta	Tamil
tat	tt	Tatar
tel	te	Telugu
ter		Tereno
tha	th	Thai
bod/tib	bo	Tibetan
tig		Tigre
tir	ti	Tigrinya
tem		Timne
tiv		Tivi
tli		Tlingit
tog	to	Tonga (Nyasa)
ton		Tonga (Tonga Islands)
tru		Truk
tsi		Tsimshian
tso	ts	Tsonga
tsn	tn	Tswana
tum		Tumbuka
tur	tr	Turkish
ota		Turkish, Ottoman (1500 - 1928)
tuk	tk	Turkmen
tyv		Tuvinian
twi	tw	Twi
uga		Ugaritic
uig	ug	Uighur
ukr	uk	Ukrainian
umb		Umbundu
und		Undetermined
urd	ur	Urdu
uzb	uz	Uzbek
vai		Vai
ven		Venda
vie	vi	Vietnamese
vol	vo	Volapük
vot		Votic
wak		Wakashan languages
wal		Walamo
war		Waray
was		Washo
cym/wel	cy	Welsh
wol	wo	Wolof
xho	xh	Xhosa
sah		Yakut
yao		Yao
yap		Yap
yid	yi	Yiddish
yor	yo	Yoruba
zap		Zapotec
zen		Zenaga
zha	za	Zhuang
zul	zu	Zulu
zun		Zuni'! !

!ISOLanguageDefinition class methodsFor: 'private - ISO 2' stamp: 'StephaneDucasse 9/13/2014 21:04'!
iso2Countries
	"self iso2Countries"
	"ISO2Countries := nil. ISO3Countries := nil"

	ISO2Countries ifNil: [self initISOCountries].
	^ISO2Countries! !

!ISOLanguageDefinition class methodsFor: 'accessing' stamp: 'mir 7/1/2004 18:06'!
iso3LanguageDefinition: aString
	^self iso3LanguageTable at: aString! !

!ISOLanguageDefinition class methodsFor: 'private - ISO 3' stamp: 'StephaneDucasse 9/13/2014 21:05'!
iso3Countries
	"self iso3Countries"
	"ISO2Countries := nil. ISO3Countries := nil"

	ISO3Countries ifNil: [self initISOCountries].
	^ISO3Countries! !

!ISOLanguageDefinition class methodsFor: 'accessing' stamp: 'mir 7/1/2004 18:06'!
iso2LanguageDefinition: aString
	^self iso2LanguageTable at: aString! !

!ISOLanguageDefinition class methodsFor: 'private - ISO 3' stamp: 'StephaneDucasse 9/13/2014 21:05'!
iso3LanguageTable
	"self iso3LanguageTable"

	^ISO3Table ifNil: [ISO3Table := self initISO3LanguageTable]! !

!ISOLanguageDefinition class methodsFor: 'initialization' stamp: 'StephaneDucasse 9/13/2014 21:02'!
initialize
	"self initialize"

	ISO3Table := nil.
	ISO2Table := nil! !

!ISOLanguageDefinition class methodsFor: 'private' stamp: 'StephaneDucasse 9/13/2014 21:03'!
initISOCountries
	"self initISOCountries"
	| iso3166Table |
	iso3166Table := self buildIso3166CodesTables.
	ISO2Countries := Dictionary new.
	ISO3Countries := Dictionary new.
	iso3166Table do: [:entry | 
		ISO2Countries at: (entry at: 2) put: (entry at: 1).
		ISO3Countries at: (entry at: 3) put: (entry at: 1)].
	! !

!ISOLanguageDefinition class methodsFor: 'private - ISO 3166' stamp: 'mir 9/1/2005 14:06'!
buildIso3166CodesTables
	"ISOLanguageDefinition buildIso3166CodesTables"
	| rawdata stream country isoa2 isoa3 unNumeric macName macCode windowsName windowsCode empty table |
	rawdata := self iso3166Codes.
	table := OrderedCollection new: 200. 
	stream := rawdata readStream.
	empty := 160 asCharacter asString.
	[stream atEnd] whileFalse: 
		[country := stream nextLine.
		isoa2 := stream nextLine.
		isoa3 := stream nextLine.
		unNumeric := stream nextLine.
		windowsName := stream nextLine.
		windowsName = empty ifTrue: [windowsName := nil].
		windowsCode := stream nextLine. 
		windowsCode = empty ifTrue: [windowsCode := nil].
		macName := stream nextLine.
		macName = empty ifTrue: [macName := nil].
		macCode := stream nextLine.
		macCode = empty ifTrue: [macCode := nil].
		table add: { country.  isoa2. isoa3.  unNumeric. windowsName.  windowsCode.  macName. macCode. }].
	^table! !

!ISOLanguageDefinition class methodsFor: 'private' stamp: 'StephaneDucasse 9/13/2014 21:03'!
readISOLanguagesFrom: stream
	"self readISOLanguagesFrom: self isoLanguages readStream "
	| languages language code3 index line |
	languages := Dictionary new.
	[stream atEnd
		or: [(line := stream nextLine readStream) atEnd]]
		whileFalse: [
			language := self new.
			code3 := line upTo: Character tab.
			(index := code3 indexOf: $/) > 0
				ifTrue: [
					language iso3: (code3 copyFrom: 1 to: index-1).
					language iso3Alternate: (code3 copyFrom: index+1 to: code3 size)]
				ifFalse: [language iso3: code3].
			language
				iso2: (line upTo: Character tab);
				language: line upToEnd.
			languages at: language iso3 put: language].
	^languages! !

!ISOLanguageDefinition class methodsFor: 'private - ISO 2' stamp: 'StephaneDucasse 9/13/2014 21:05'!
iso2LanguageTable
	"self iso2LanguageTable"

	ISO2Table ifNotNil: [^ISO2Table].
	ISO2Table := Dictionary new: self iso3LanguageTable basicSize.
	self iso3LanguageTable do: [:entry |
		ISO2Table at: entry iso2 put: entry].
	^ISO2Table! !

!ISOLanguageDefinitionTest methodsFor: 'tests' stamp: 'TorstenBergmann 9/16/2014 15:13'!
testISO2LanguageDefinition

	self 
		assert: (ISOLanguageDefinition iso2LanguageDefinition: 'de') language = 'German';
		assert: (ISOLanguageDefinition iso2LanguageDefinition: 'fr') language = 'French'! !

!ISOLanguageDefinitionTest methodsFor: 'tests' stamp: 'TorstenBergmann 9/16/2014 15:14'!
testISO3LanguageDefinition

	self 
		assert: (ISOLanguageDefinition iso3LanguageDefinition: 'deu') language = 'German';
		assert: (ISOLanguageDefinition iso3LanguageDefinition: 'fra') language = 'French'! !

!IVsAndClassVarNamesConflictTest commentStamp: 'TorstenBergmann 2/5/2014 08:36'!
SUnit tests to tests conflicts for instance variables and class variable names!
!IVsAndClassVarNamesConflictTest methodsFor: 'tests' stamp: 'MaxLeske 9/30/2014 21:25'!
testOneCanProceedWhenIntroducingClasseVariablesBeginingWithLowerCaseCharacters
	| class |
	[ 
		class := classFactory
			newSubclassOf: classFactory defaultSuperclass
			instanceVariableNames: 'a BVarName'
			classVariableNames: ''
	]
		on: Exception
		do: [ :ex | ex resume ].
	self assert: (Smalltalk keys includes: class name)! !

!IVsAndClassVarNamesConflictTest methodsFor: 'tests' stamp: 'MaxLeske 9/30/2014 21:25'!
testOneCanProceedWhenIntroducingCapitalizedInstanceVariables
	| class |
	[ 
		class := classFactory
			newSubclassOf: classFactory defaultSuperclass
			instanceVariableNames: 'X Y'
			classVariableNames: ''
	]
		on: Exception
		do: [ :ex | ex resume ].
	self assert: (Smalltalk keys includes: class name)! !

!IVsAndClassVarNamesConflictTest methodsFor: 'running' stamp: 'MaxLeske 9/30/2014 21:18'!
tearDown
	super tearDown.
	classFactory cleanUp! !

!IVsAndClassVarNamesConflictTest methodsFor: 'running' stamp: 'MaxLeske 9/30/2014 21:19'!
setUp
	super setUp.
	classFactory := ClassFactoryForTestCase new! !

!IconListModel commentStamp: '<historical>'!
An IconListModel is a spec model for icon list!
!IconListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
getIconFor: anItem

	^ iconHolder value cull: anItem cull: self! !

!IconListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:20'!
icons: aBlock
	"<api: #block getter: #icon registration: #whenIconsChanged: >"
	"Set a block which takes an item as argument and returns the icon to display in the list"
	iconHolder value: aBlock! !

!IconListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:03'!
icons
	"<api: #inspect>"
	"Return the block which takes an item as argument and returns the icon to display in the list"
	
	^ iconHolder value! !

!IconListModel methodsFor: 'initialization' stamp: 'DucasseStephane 9/10/2014 09:59'!
initialize

	super initialize.

	iconHolder := [:item | nil ] asValueHolder.! !

!IconListModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:34'!
whenIconsChanged: aBlock 
	
	iconHolder whenChangedDo: aBlock 

! !

!IconListModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/1/2013 13:38'!
defaultSpec
	<spec: #default>
	
	^ #(IconListAdapter
		adapt: #(model))! !

!IconListModel class methodsFor: 'example' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
example

	self new
		icons: [:e | Smalltalk ui icons forwardIcon ];
		items: (1 to: 10) asArray;
		openWithSpec! !

!IconListModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/13/2014 15:21'!
adapterName

	^ #IconListAdapter! !

!IconSetChanged commentStamp: '<historical>'!
I'm announced when an IconSet has been changed. !
!IconicButton commentStamp: '<historical>'!
A "Simple Button" in which the appearance is provided by a Form.!
!IconicButton methodsFor: 'accessing' stamp: 'YuriyTymchuk 12/20/2013 15:13'!
graphicalMorph

	^ graphicalMorph! !

!IconicButton methodsFor: 'accessing' stamp: 'sw 11/29/1999 20:56'!
shedSelvedge
	self extent: (self extent - (6@6))! !

!IconicButton methodsFor: 'initialization' stamp: 'ar 12/15/2001 14:43'!
buttonSetup
	self actWhen: #buttonUp.
	self cornerStyle: #rounded.
	self borderNormal.
	self on: #mouseEnter send: #borderRaised to: self.
	self on: #mouseLeave send: #borderNormal to: self.
	self on: #mouseLeaveDragging send: #borderNormal to: self.
	self on: #mouseDown send: #borderInset to: self.
	self on: #mouseUp send: #borderRaised to: self.! !

!IconicButton methodsFor: 'mouse events' stamp: 'gvc 5/29/2007 10:55'!
handlesMouseOver: anEvent
	"Answer true, otherwise what is all that
	#mouseEnter:/#mouseLeave: stuff about?"

	^true! !

!IconicButton methodsFor: 'initialization' stamp: 'sw 11/29/1999 20:52'!
initialize
	super initialize.
	self useSquareCorners! !

!IconicButton methodsFor: 'accessing' stamp: 'StephaneDucasse 5/17/2012 16:33'!
defaultGraphics

	^  DefaultGraphics ! !

!IconicButton methodsFor: 'mouse events' stamp: 'gvc 6/23/2008 17:19'!
mouseOverBorderStyle
	"Answer the border style to use whilst the mouse
	is over the receiver."

	^self valueOfProperty: #mouseOverBorderStyle ifAbsent: [BorderStyle thinGray]! !

!IconicButton methodsFor: 'accessing' stamp: 'ar 12/12/2001 01:38'!
borderInset
	self borderStyle: (BorderStyle inset width: 2).! !

!IconicButton methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 8/23/2011 14:31'!
interactSelector

	 ^ #interact! !

!IconicButton methodsFor: 'initialization' stamp: 'ar 12/18/2001 21:22'!
stationarySetup

	self actWhen: #startDrag.
	self cornerStyle: #rounded.
	self borderNormal.
	self on: #mouseEnter send: #borderThick to: self.
	self on: #mouseDown send: nil to: nil.
	self on: #mouseLeave send: #borderNormal to: self.
	self on: #mouseLeaveDragging send: #borderNormal to: self.
	self on: #mouseUp send: #borderThick to: self.! !

!IconicButton methodsFor: 'geometry' stamp: 'MarcusDenker 11/23/2010 14:58'!
extent: newExtent
	"Update the graphic position to keep centered."
	
	super extent: newExtent.
	graphicalMorph ifNotNil: [graphicalMorph position: self center - (graphicalMorph extent // 2)]! !

!IconicButton methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 8/23/2011 15:04'!
update: aSelector
	
	aSelector = self interactSelector
		ifTrue: [ ^ self doButtonAction ].
		
	super update: aSelector! !

!IconicButton methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/12/2011 17:08'!
extraBorder

	^ 6! !

!IconicButton methodsFor: 'initialization' stamp: 'StephaneDucasse 5/17/2012 16:36'!
setDefaultLabel
	self labelGraphic: self class defaultGraphics! !

!IconicButton methodsFor: 'accessing' stamp: 'StephaneDucasse 5/23/2013 18:06'!
labelGraphic

	^ graphicalMorph form! !

!IconicButton methodsFor: 'mouse events' stamp: 'gvc 6/23/2008 17:19'!
mouseOverBorderStyle: aBorderStyle
	"Set the border style to use whilst the mouse
	is over the receiver."

	self setProperty: #mouseOverBorderStyle toValue: aBorderStyle! !

!IconicButton methodsFor: 'mouse events' stamp: 'MarcusDenker 9/18/2014 15:24'!
mouseEnter: evt
	"Remember the old border style."
	
	oldBorderStyle:= self borderStyle.
	self borderStyle: self mouseOverBorderStyle! !

!IconicButton methodsFor: 'initialization' stamp: 'ar 12/17/2001 21:17'!
borderThick
	self borderStyle: (BorderStyle width: 2 color: self raisedColor twiceDarker).! !

!IconicButton methodsFor: 'accessing' stamp: 'StephaneDucasse 5/23/2013 18:35'!
labelGraphic: aForm
	"Changed to look for any image morph rather than just a sketch."
	
	graphicalMorph ifNotNil: [graphicalMorph delete].
	graphicalMorph := ImageMorph new form: aForm.
	self extent: graphicalMorph extent + (self borderWidth + self extraBorder).
	graphicalMorph position: self center - (graphicalMorph extent // 2).
	self addMorph: graphicalMorph.
	graphicalMorph lock! !

!IconicButton methodsFor: 'accessing' stamp: 'sw 9/28/1999 14:11'!
labelFromString: aString
	"Make an iconic label from aString"

	self labelGraphic: (StringMorph contents: aString) imageForm
! !

!IconicButton methodsFor: 'mouse events' stamp: 'MarcusDenker 7/8/2014 20:05'!
mouseDown: evt
	"Partial workaraound for broken MouseOverHandler.
	Remove the border on mouse down if mouse focus has changed."

	super mouseDown: evt.
	(actWhen == #buttonDown and: [ evt hand mouseFocus ~= self ])
		ifTrue: [ self mouseLeave: evt ]! !

!IconicButton methodsFor: 'initialization' stamp: 'ar 12/12/2001 01:38'!
borderNormal
	self borderStyle: (BorderStyle width: 2 color: Color transparent).! !

!IconicButton methodsFor: 'menu' stamp: 'sw 9/28/1999 20:42'!
addLabelItemsTo: aCustomMenu hand: aHandMorph
	"don't do the inherited behavior, since there is no textual label in this case"! !

!IconicButton methodsFor: 'accessing' stamp: 'ar 12/12/2001 01:41'!
borderRaised
	self borderStyle: (BorderStyle raised width: 2).! !

!IconicButton methodsFor: 'mouse events' stamp: 'MarcusDenker 9/18/2014 15:27'!
mouseLeave: evt
	"Reinstate the old border style."

	oldBorderStyle ifNil: [^self borderNormal].
	self borderStyle: oldBorderStyle. 
	oldBorderStyle := nil.
		! !

!IconicButton methodsFor: 'accessing' stamp: ''!
graphicalMorph: aMorph
	self addMorph: aMorph.
	aMorph lock.! !

!IconicButton class methodsFor: 'initialize' stamp: 'StephaneDucasse 5/17/2012 16:33'!
initialize
	"self initialize"
	
	DefaultGraphics := self defaultGraphics! !

!IconicButton class methodsFor: 'initialize' stamp: 'StephaneDucasse 5/17/2012 16:40'!
defaultGraphics

	^ DefaultGraphics ifNil: [ DefaultGraphics := (Form extent: 20 @ 1 depth: 8)].! !

!IconicButtonStateHolder commentStamp: '<historical>'!
An IconicButtonStateHolder is a state holder for Iconic button.

Since Nautilus cache the icon, I do not want to keep pointers to the iconic button's target.
I use this state holder for the storage!
!IconicButtonStateHolder methodsFor: 'accessing' stamp: ''!
actionSelector: anObject
	actionSelector := anObject! !

!IconicButtonStateHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/14/2012 15:23'!
asIconTargetting: newTarget

	^self asIcon
		target: newTarget;
		yourself! !

!IconicButtonStateHolder methodsFor: 'accessing' stamp: ''!
extent: anObject
	extent := anObject! !

!IconicButtonStateHolder methodsFor: 'accessing' stamp: ''!
labelGraphic
	^ labelGraphic! !

!IconicButtonStateHolder methodsFor: 'accessing' stamp: 'CamilloBruni 5/7/2013 23:29'!
arguments: aCollection
	arguments := WeakArray withAll: aCollection! !

!IconicButtonStateHolder methodsFor: 'accessing' stamp: ''!
color: anObject
	color := anObject! !

!IconicButtonStateHolder methodsFor: 'accessing' stamp: ''!
extent
	^ extent! !

!IconicButtonStateHolder methodsFor: 'accessing' stamp: ''!
labelGraphic: anObject
	labelGraphic := anObject! !

!IconicButtonStateHolder methodsFor: 'accessing' stamp: ''!
helpText: anObject
	helpText := anObject! !

!IconicButtonStateHolder methodsFor: 'accessing' stamp: ''!
borderWidth: anObject
	borderWidth := anObject! !

!IconicButtonStateHolder methodsFor: 'accessing' stamp: ''!
color
	^ color! !

!IconicButtonStateHolder methodsFor: 'accessing' stamp: ''!
actionSelector
	^ actionSelector! !

!IconicButtonStateHolder methodsFor: 'protocol' stamp: 'CamilloBruni 5/7/2013 23:29'!
asIcon

	^ IconicButton new 
		target: self target;
		actionSelector: self actionSelector;
		arguments: self arguments;
		labelGraphic: self labelGraphic;
		color: self color;
		helpText: self helpText;
		extent: self extent;
		borderWidth: self borderWidth! !

!IconicButtonStateHolder methodsFor: 'accessing' stamp: ''!
borderWidth
	^ borderWidth! !

!IconicButtonStateHolder methodsFor: 'accessing' stamp: 'CamilloBruni 5/7/2013 23:29'!
arguments
	"convert arguments back from a WeakArray"
	^ Array withAll: arguments! !

!IconicButtonStateHolder methodsFor: 'protocol' stamp: 'CamilloBruni 5/7/2013 23:29'!
forIcon: icon

	self 
		target: icon target;
		actionSelector: icon actionSelector;
		arguments: icon arguments;
		labelGraphic: icon labelGraphic;
		color: icon color;
		helpText: icon helpText;
		extent: icon extent;
		borderWidth: icon borderWidth! !

!IconicButtonStateHolder methodsFor: 'accessing' stamp: ''!
helpText
	^ helpText! !

!IconicButtonStateHolder methodsFor: 'accessing' stamp: 'CamilloBruni 5/7/2013 23:26'!
target
	^ target first! !

!IconicButtonStateHolder methodsFor: 'accessing' stamp: 'CamilloBruni 5/7/2013 23:26'!
target: anObject
	target := WeakArray with: anObject! !

!IconicButtonStateHolder class methodsFor: 'instance creation' stamp: ''!
forIcon: icon

	^ self new
		forIcon: icon;
		yourself	! !

!IconicButtonStateHolder class methodsFor: 'instance creation' stamp: 'CamilloBruni 5/7/2013 23:24'!
forNautilus: icon

	^ self new
		forIcon: icon;
		yourself	! !

!IconicListItem commentStamp: 'StephaneDucasse 7/16/2014 22:25'!
I am a wrapper used to display a morph with ahead an icon.

Here is the way to use me

IconicListItem new
	icon: ThemeIcons current smallOkIcon asMorph;
	morph: 'Accept' asMorph;
	yourself;
	openInWorld!
!IconicListItem methodsFor: 'accessing' stamp: 'StephaneDucasse 5/31/2013 17:41'!
morph: anObject
	
	morph ifNotNil: [ self removeMorph: morph ].
	morph := anObject.
	morph ifNotNil: [ "since the text can be removed" 
		self addMorphBack: morph.
		self adjustLayoutBounds]
	! !

!IconicListItem methodsFor: 't-rotating' stamp: ''!
forwardDirection: newDirection
	"Set the receiver's forward direction (in eToy terms)"
	self setProperty: #forwardDirection toValue: newDirection.! !

!IconicListItem methodsFor: 't-rotating' stamp: ''!
heading
	"Return the receiver's heading"
	^ self owner 
		ifNil: [self forwardDirection]
		ifNotNil: [self forwardDirection + self owner degreesOfFlex]! !

!IconicListItem methodsFor: 't-rotating' stamp: ''!
forwardDirection
	"Return the receiver's forward direction (in eToy terms)"
	^self valueOfProperty: #forwardDirection ifAbsent:[0.0]! !

!IconicListItem methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/7/2011 15:19'!
originalObject: anObject
	
	originalObject := anObject! !

!IconicListItem methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/6/2013 23:25'!
morph
	^ morph! !

!IconicListItem methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/20/2014 12:55'!
icon: anObject

	icon ifNotNil: [ self removeMorph: icon ].
	
	icon := anObject asAlphaImageMorph.
	anObject ifNotNil: [ "since the text can be removed" 
		self addMorphFront: icon.
		self adjustLayoutBounds]
	! !

!IconicListItem methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 23:05'!
initialize

	super initialize.

	self 	
		changeTableLayout;
		listDirection: #leftToRight;
		cellPositioning: #center;
		cellInset: 2;
		borderWidth: 0;
		color: Color transparent;
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap;
		extent: 20@16.! !

!IconicListItem methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/7/2011 15:19'!
originalObject

	^ originalObject! !

!IconicListItem methodsFor: 't-rotating' stamp: ''!
prepareForRotating
	"If I require a flex shell to rotate,
	then wrap it in one and return it.
	Polygons, eg, may override to do nothing."

	^ self addFlexShell! !

!IconicListItem methodsFor: 't-rotating' stamp: ''!
setDirectionFrom: aPoint
	| delta degrees |
	delta := (self transformFromWorld globalPointToLocal: aPoint) - self referencePosition.
	degrees := delta degrees + 90.0.
	self forwardDirection: (degrees \\ 360) rounded.
! !

!IconicListItem methodsFor: 't-rotating' stamp: ''!
rotationDegrees: degrees	
	"redefined in all morphs which are using myself"! !

!IconicListItem methodsFor: 'accessing' stamp: 'StephaneDucasse 5/31/2013 17:44'!
enabled: aBoolean

	self submorphs do: [ :each |
			each enabled: aBoolean ].! !

!IconicListItem methodsFor: 't-rotating' stamp: ''!
rotationDegrees
	"Default implementation."

	^ 0.0
! !

!IconicListItem methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/6/2013 23:26'!
icon
	^ icon! !

!IconicListItem class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 2/18/2014 22:37'!
text: aText icon: form
	| morph |
	
	aText ifNotNil: [ morph := aText asMorph 
		lock;
		yourself ].

	^ self new
		morph:	morph;
		icon: form;
		yourself! !

!IdentifierChooserMorph commentStamp: 'AlainPlantec 11/29/2010 10:50'!
An IdentifierChooserMorph is a menu builder which takes a list of labels as input and build/popup  a menu for them. The morph could be made of one menu in one column for all labels of of several menus in a scrollabe row. The action which is performed when a menu item is selected is also parametrized (see examples below).
The morph can take the keyboard focus and then, up, down, left and right arrows can be used to choose a menu item.
It is the responsibility of the user of this morph to decide when and how the keyboard focus is token.
The design is widely inpired from PopupChoiceDialogWindow.

example 1
A very simple example with three label. The nil value will be represented as a menu line in the resulting morph.
(IdentifierChooserMorph 
		labels: {'aaaaaa'. 'bbbbbbb'. nil. 'cccccccc'}
		chooseBlock: [ :chosen | UIManager default inform: (chosen, (' has been chosen' translated))])
			open
			
example 2
The same except that a color is specified		
(IdentifierChooserMorph 
		labels: {'aaaaaa'. 'bbbbbbb'. nil. 'cccccccc'}
		chooseBlock: [ :chosen | UIManager default inform: (chosen, (' has been chosen' translated))])
			baseColor: Color white;
			open

example 3
Allows the presentation of one menu (one column) vith two fixed labels followed by the list of all classes.
(IdentifierChooserMorph 
		labels: ({'aaaaaa'. 'bbbbbbb'}, { nil }, (Object allSubclasses collect: [:c | c theNonMetaClass  name]) asSet asArray sort)
		chooseBlock: [ :chosen | (Smalltalk globals at: chosen asSymbol) ifNotNil: [:c | c browse] ]) 
			oneMenuOfWidth: 300;
			baseColor: Color white;
			open

Instance Variables
	baseColor:		<Color>
	choiceMenus:		<Array>
	choicesMorph:		<AlignmentMorph>
	chooseBlock:		<Block>
	labels:		<Array>
	maxLines:		<Integer>
	requestor:		<Morph>
	scrollPaneWidth:		<Integer>

baseColor
	- The color used for the menu items and the receiver

choiceMenus
	- The array of EmbeddedMenuMorph

choicesMorph
	- The AlignmentMorph which contains all menus

chooseBlock
	- A block with one argument which is evaluated when a menu item is selected. The argument takes the chosen label as argument

labels
	- The array of labels 

maxLines
	- If not nil, gives the maximum number of lines for one menu

requestor
	- if not nil, a Morph from which the receiver is built

scrollPaneWidth
	- The maximum width of the scrollPane, this contraints the width of the receiver.
!
!IdentifierChooserMorph methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 9/8/2013 17:59'!
selectFirstItem
	"Select the first item in the embedded menus"

	self choiceMenus first selectItem:  self choiceMenuItems first event: nil.
	self takeKeyboardFocus.! !

!IdentifierChooserMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/21/2010 13:41'!
labels
	"Answer the value of labels"

	^ labels! !

!IdentifierChooserMorph methodsFor: 'event handling' stamp: 'AlainPlantec 11/21/2010 13:41'!
switchToPreviousColumn
	"Give the previous embedded menu keyboard focus."

	self switchToOtherColumn: [:prevIdx | 
		prevIdx =  1
			ifTrue: [self choiceMenus size]
			ifFalse: [prevIdx - 1]]
! !

!IdentifierChooserMorph methodsFor: 'ui-building' stamp: 'AlainPlantec 11/26/2010 09:54'!
forcesHeight: aHeight
	| sp |
	(sp := self scrollPane) minHeight: aHeight.
	sp height: sp minHeight.
 	self height: sp height. ! !

!IdentifierChooserMorph methodsFor: 'ui-building' stamp: 'AlainPlantec 11/29/2010 09:01'!
newContentMorph
	"Answer a new content morph."

	| sp choices |
	self choicesMorph: (choices := self newChoicesMorph).
	sp := (self newScrollPaneFor: choices)
		color: Color transparent;
		scrollTarget: choices;
		hResizing: #spaceFill;
		vResizing: #spaceFill.
	sp
		minWidth: (scrollPaneWidth ifNil: [(choicesMorph width min: (Display width // 2) - 50) + sp scrollBarThickness]);
		minHeight: (choicesMorph height min: (Display height // 3)).
	choicesMorph width > sp minWidth
		ifTrue: [sp minHeight: sp minHeight + sp scrollBarThickness].
	^ sp! !

!IdentifierChooserMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/26/2010 09:33'!
allowedArea
	^ self class allowedArea! !

!IdentifierChooserMorph methodsFor: 'action' stamp: 'AlainPlantec 11/26/2010 16:54'!
close
	self delete.
! !

!IdentifierChooserMorph methodsFor: 'action' stamp: 'AlainPlantec 11/26/2010 18:22'!
choose: index
	"Set the given choice and ok."
	| chosen |
	chosen := index > 0 ifTrue: [self labels at: index] ifFalse: [nil].
	chooseBlock value: chosen.
	self close.
	requestor ifNotNil: [requestor takeKeyboardFocus]
! !

!IdentifierChooserMorph methodsFor: 'event handling' stamp: 'AlainPlantec 11/26/2010 16:55'!
keyStroke: anEvent
	anEvent keyCharacter = Character escape 
		ifTrue: [self close. 
			requestor 
				ifNotNil: [requestor takeKeyboardFocus]. 
				^true].
	anEvent keyCharacter = Character arrowUp ifTrue: [self selectPreviousItem. ^true].
	anEvent keyCharacter = Character arrowDown ifTrue: [self selectNextItem. ^true].
	anEvent keyCharacter = Character arrowLeft ifTrue: [self switchToPreviousColumn. ^true].
	anEvent keyCharacter = Character arrowRight ifTrue: [self switchToNextColumn. ^true].
	(anEvent keyCharacter ~= Character cr 
		and: [anEvent keyCharacter < Character space]) ifTrue: [^false]. "ignore pageup/down etc."
	(anEvent keyCharacter = Character space or: [ anEvent keyCharacter = Character cr]) 
		ifTrue: [ ^self processEnter: anEvent ].
	^false! !

!IdentifierChooserMorph methodsFor: 'event handling' stamp: 'AlainPlantec 11/21/2010 13:41'!
switchToNextColumn
	"Give the next embedded menu keyboard focus."

	self switchToOtherColumn: [:prevIdx | 
		prevIdx =  self choiceMenus size
				ifTrue: [1]
				ifFalse: [prevIdx + 1]]
! !

!IdentifierChooserMorph methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
theme
		^ Smalltalk ui theme ! !

!IdentifierChooserMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/21/2010 18:59'!
choicesMorph: aMorph
	choicesMorph := aMorph! !

!IdentifierChooserMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/21/2010 14:02'!
chooseBlock: aBlock
	chooseBlock := aBlock! !

!IdentifierChooserMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/29/2010 09:12'!
defaultBaseColor
	^ Color transparent! !

!IdentifierChooserMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/29/2010 09:22'!
baseColor
	^ baseColor ifNil: [baseColor := self defaultBaseColor]! !

!IdentifierChooserMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/26/2010 16:54'!
requestor
	^ requestor! !

!IdentifierChooserMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/21/2010 13:41'!
choiceMenuItems
	"Answer the value of choiceMenus"

	^ Array streamContents: [:strm | self choiceMenus  do: [:menu | strm nextPutAll: menu menuItems]].
! !

!IdentifierChooserMorph methodsFor: 'event handling' stamp: 'AlainPlantec 11/24/2010 21:44'!
selectNextItem
	"Select the next item in the embedded menus"

	| idx next |
	self choiceMenus 
		do: [:embeddedMenu | embeddedMenu menuItems 
			do: [:mi | ((mi isKindOf: MenuItemMorph)  and: [mi isSelected])
				ifTrue: [idx := embeddedMenu menuItems indexOf: mi.
					idx = embeddedMenu menuItems size
						ifTrue: [idx := 0].
					idx := idx + 1. 
					[(embeddedMenu menuItems at: idx) isKindOf: MenuItemMorph]
						whileFalse: [idx := idx+ 1].
					next := embeddedMenu menuItems at: idx.
					self activeHand newKeyboardFocus: self.
					self scrollPane ifNotNil: [:sp | sp scrollToShow: next bounds].
					^ embeddedMenu selectItem: next event: nil]]].
	self selectFirstItem! !

!IdentifierChooserMorph methodsFor: 'event handling' stamp: 'AlainPlantec 11/21/2010 13:41'!
selectLastItem
	"Select the last item in the embedded menus"

	self choiceMenus last selectItem:  self choiceMenuItems last event: nil.
	self activeHand newKeyboardFocus: self.
! !

!IdentifierChooserMorph methodsFor: 'initialization' stamp: 'StephaneDucasse 9/7/2013 12:39'!
initialize
	super initialize.
	self borderWidth: 1.
	self layoutInset: 0.
	self changeTableLayout.
	self hResizing: #shrinkWrap.
	self vResizing: #shrinkWrap.
	self color: self defaultBaseColor.
! !

!IdentifierChooserMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/26/2010 09:00'!
listHeight
	"Answer the height for the list."

	^ choicesMorph height! !

!IdentifierChooserMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/21/2010 13:41'!
choiceMenus
	"Answer the value of choiceMenus"

	^ choiceMenus! !

!IdentifierChooserMorph methodsFor: 'ui-building' stamp: 'AlainPlantec 11/29/2010 09:08'!
setColor: aColor
	self color: aColor.
	self choiceMenus 
		ifNotNil: [:menus | menus 
			do: [:cm | cm color: aColor]]! !

!IdentifierChooserMorph methodsFor: 'ui-building' stamp: 'AlainPlantec 11/21/2010 22:04'!
newMenu 
	^ self theme
		newEmbeddedMenuIn: self
		for: self! !

!IdentifierChooserMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/29/2010 09:23'!
baseColor: aColor
	baseColor := aColor.
	self setColor: aColor! !

!IdentifierChooserMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/21/2010 16:32'!
maxLines: anInteger
	maxLines := anInteger! !

!IdentifierChooserMorph methodsFor: 'event handling' stamp: 'AlainPlantec 11/24/2010 21:44'!
selectPreviousItem
	"Select the previous item in the embedded menus"

	| idx previous |
	self choiceMenus 
		do: [:embeddedMenu | embeddedMenu menuItems 
			do: [:mi | ((mi isKindOf: MenuItemMorph)  and: [mi isSelected])
				ifTrue: [idx := embeddedMenu menuItems indexOf: mi.
					idx = 1
						ifTrue: [idx := embeddedMenu menuItems size + 1].
					idx := idx - 1. 
					[(embeddedMenu menuItems at: idx) isKindOf: MenuItemMorph]
						whileFalse: [idx := idx- 1].
					previous := embeddedMenu menuItems at: idx.
					self scrollPane ifNotNil: [:sp | sp scrollToShow: previous bounds].
					^ embeddedMenu selectItem: previous event: nil]]].
	self selectFirstItem.
! !

!IdentifierChooserMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/26/2010 16:32'!
requestor: aTextMorph
	requestor := aTextMorph! !

!IdentifierChooserMorph methodsFor: 'event handling' stamp: 'AlainPlantec 11/21/2010 13:41'!
processEnter: anEvent
	self choiceMenus do: [:embeddedMenu | 
		embeddedMenu selectedItem ifNotNil: [:item |
			item invokeWithEvent: anEvent.
			^true ] ].
	^false! !

!IdentifierChooserMorph methodsFor: 'event handling' stamp: 'AlainPlantec 11/21/2010 13:41'!
handlesKeyboard: evt
	"True when either the filter morph doesn't have the focus and the key
	is a text key or backspace or no menus have the focus and is up or down arrow."
	^(super handlesKeyboard: evt) or: [
		(self hasKeyboardFocus)
			ifTrue: [	evt keyCharacter = Character escape
						or: [evt keyCharacter = Character cr
						or: [evt keyCharacter = Character arrowLeft
						or: [evt keyCharacter = Character arrowRight
						or: [evt keyCharacter = Character arrowUp
						or: [evt keyCharacter = Character arrowDown]]]]]]
			ifFalse: [	evt keyCharacter = Character escape
						or: [evt keyCharacter = Character arrowUp
						or: [evt keyCharacter = Character arrowDown
						or: [evt keyCharacter = Character arrowLeft
						or: [evt keyCharacter = Character arrowRight]]]]]]! !

!IdentifierChooserMorph methodsFor: 'ui-building' stamp: 'AlainPlantec 11/27/2010 12:41'!
oneMenuOfWidth: anInteger
	self maxLines: 999999999.
	scrollPaneWidth := anInteger.
! !

!IdentifierChooserMorph methodsFor: 'ui-building' stamp: 'AlainPlantec 11/25/2010 09:24'!
newChoicesMorph
	"Answer a row of columns of buttons and separators based on the model."

	| answer morphs str  |
	answer := self newRow
		cellPositioning: #topLeft;
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap.
	self labels ifEmpty: [^answer].
	self labels first isNil
		ifTrue: [self labels: self labels allButFirst].
	self labels ifEmpty: [^answer].
	self labels last isNil
		ifTrue: [self labels: self labels allButLast].
	self labels ifEmpty: [^answer].
	morphs := OrderedCollection new.
	1 to: self labels size do: [:i |
		morphs add: (self newChoiceButtonFor: i)].
	str := morphs readStream.
	[str atEnd] whileFalse: [
		answer
			addMorphBack: (self newMenuWith: (str next: self maxLines));
			addMorphBack: self newVerticalSeparator].
	answer removeMorph: answer submorphs last.
	answer submorphs last hResizing: #spaceFill.
	scrollPaneWidth ifNotNil: [answer hResizing: #spaceFill. answer submorphs last hResizing: #rigid. answer submorphs last width: scrollPaneWidth].
	self choiceMenus: (answer submorphs select: [:m| m isKindOf: MenuMorph]).
	^answer! !

!IdentifierChooserMorph methodsFor: 'ui-building' stamp: 'AlainPlantec 11/21/2010 13:41'!
newVerticalSeparator

	^ SeparatorMorph new
		fillStyle: Color transparent;
		borderStyle: (BorderStyle inset baseColor: Color gray; width: 1);
		extent: 1@1;
		vResizing: #spaceFill! !

!IdentifierChooserMorph methodsFor: 'event handling' stamp: 'AlainPlantec 11/29/2010 10:53'!
activate: evt
	"Backstop."
	! !

!IdentifierChooserMorph methodsFor: 'ui-building' stamp: 'AlainPlantec 11/21/2010 13:41'!
newRow
	^ AlignmentMorph new
		listDirection: #leftToRight;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		extent: 1@1;
		borderWidth: 0;
		color: Color transparent.
! !

!IdentifierChooserMorph methodsFor: 'ui-building' stamp: 'AlainPlantec 11/21/2010 13:41'!
newScrollPaneFor: aMorph
	^ self theme
		newScrollPaneIn: self
		for: aMorph! !

!IdentifierChooserMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/26/2010 09:01'!
listMorph
	"Answer the height for the list."

	^ choicesMorph! !

!IdentifierChooserMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/21/2010 13:41'!
choiceMenus: anObject
	"Set the value of choiceMenus"

	choiceMenus := anObject! !

!IdentifierChooserMorph methodsFor: 'ui-building' stamp: 'AlainPlantec 11/29/2010 09:26'!
newMenuWith: menuItems
	"Answer menu with the given morphs."

	| menu |
	menu := self newMenu.
	menu cornerStyle: #square.
	menuItems do: [:m | menu addMenuItem: m].
	menu
		borderWidth: 0;
		color: self baseColor;
		borderColor:  Color transparent;
		stayUp: true;
		beSticky;
		removeDropShadow;
		popUpOwner: (MenuItemMorph new privateOwner: self).
	^ menu! !

!IdentifierChooserMorph methodsFor: 'ui-building' stamp: 'AlainPlantec 11/29/2010 09:24'!
newChoiceButtonFor: index
	"Answer a new choice button."
	^ (self labels at: index) 
		ifNotNil: [:v | (ToggleMenuItemMorph new
			contents: v asText;
			target: self;
			selector: #choose:;
			arguments: {index})
			cornerStyle: #square;
			hResizing: #spaceFill]
		ifNil: [MenuLineMorph new]
		! !

!IdentifierChooserMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/21/2010 16:31'!
maxLines
	^ maxLines ifNil: [maxLines := 6]! !

!IdentifierChooserMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/29/2010 10:55'!
labels: aCollectionOfString
	"Set the value of labels"
	labels := aCollectionOfString! !

!IdentifierChooserMorph methodsFor: 'ui-building' stamp: 'AlainPlantec 11/29/2010 09:24'!
open
	self addMorph: self newContentMorph.
	self openInWorld.
! !

!IdentifierChooserMorph methodsFor: 'ui-building' stamp: 'AlainPlantec 11/21/2010 13:41'!
scrollPane
	"Answer the scroll pane."

	^self findDeeplyA: GeneralScrollPane! !

!IdentifierChooserMorph methodsFor: 'event handling' stamp: 'AlainPlantec 11/21/2010 13:41'!
deleteIfPopUp: evt
	"For compatibility with MenuMorph."! !

!IdentifierChooserMorph methodsFor: 'event handling' stamp: 'AlainPlantec 11/24/2010 21:36'!
switchToOtherColumn: aBlock
	"Give the next embedded menu keyboard focus. 
	The next menu indice is computed by the argument"

	| menuWithFocus idx menu sub subIdx |
	(self choiceMenus isNil or: [self choiceMenus isEmpty]) 
		ifTrue: [^self].
	menuWithFocus := self choiceMenus
		detect: [:m | m menuItems 
			anySatisfy: [:sm | 
				((sm isKindOf: MenuItemMorph)  and: [sm isSelected]) 
					ifTrue: [sub := sm]. 
				sm isSelected]]
		ifNone: [].
	self choiceMenus do: [:embeddedMenu | embeddedMenu selectItem: nil event: nil].
	menuWithFocus isNil
		ifTrue: [self selectFirstItem]
		ifFalse: [
			idx := aBlock value: (self choiceMenus indexOf: menuWithFocus).
			menu := (self choiceMenus at: idx).
			subIdx := sub ifNil: [1] ifNotNil: [(menuWithFocus menuItems indexOf: sub) min: menu menuItems size].
			menu selectItem: (menu menuItems at: subIdx) event: nil.
			self scrollPane ifNotNil: [:sp | sp scrollToShow: menu bounds]].
	self activeHand newKeyboardFocus: self.! !

!IdentifierChooserMorph class methodsFor: 'instance creation' stamp: 'StephaneDucasse 9/30/2014 12:12'!
example

	(self 
		labels: #('aaa' 'bbb' 'ccc') 
		chooseBlock:  [ :currText | currText matches: '*bb'])
	openInWorld! !

!IdentifierChooserMorph class methodsFor: 'accessing' stamp: 'IgorStasenko 12/22/2012 03:24'!
allowedArea
	"The area allowed for the building and positioning of the morph"
	| allowedArea |
	allowedArea := Display usableArea.
	allowedArea := allowedArea intersect: World visibleClearArea ifNone: [ 0@0 corner: 0@0 "not sure about this"].
	^allowedArea! !

!IdentifierChooserMorph class methodsFor: 'instance creation' stamp: 'AlainPlantec 11/29/2010 10:51'!
labels: aCollection chooseBlock: aBlock
	"return a new chooser or nil"
	^ aCollection isEmpty
		ifFalse: [ self new chooseBlock: aBlock; labels: aCollection; yourself].
! !

!IdentityBag commentStamp: '<historical>'!
Like a Bag, except that items are compared with #== instead of #= .

See the comment of IdentitySet for more information.
!
!IdentityBag methodsFor: 'converting' stamp: 'nice 12/18/2009 12:02'!
asSet
	^contents keys asIdentitySet! !

!IdentityBag class methodsFor: 'instance creation' stamp: 'nk 3/17/2001 09:53'!
contentsClass
	^IdentityDictionary! !

!IdentityBagTest commentStamp: 'TorstenBergmann 2/20/2014 15:20'!
SUnit tests for identity bags!
!IdentityBagTest methodsFor: 'requirements' stamp: 'damienpollet 1/9/2009 18:28'!
speciesClass
	^ IdentityBag! !

!IdentityBagTest methodsFor: 'tests' stamp: 'stephane.ducasse 5/20/2009 18:03'!
testIdentity
	"self run:#testIdentity" 
	"self debug:#testIdentity"
	| bag identityBag aString anOtherString |
	
	aString := 'hello'.
	anOtherString := aString copy.
	
	self assert: (aString = anOtherString).
	self assert: (aString == anOtherString) not.

	bag := Bag new.
	bag add: aString.
	bag add: aString.
	bag add: anOtherString.
	self assert: (bag occurrencesOf: aString) = 3.
	self assert: (bag occurrencesOf: anOtherString) = 3.
	
	identityBag := IdentityBag new.
	identityBag add: aString.
	identityBag add: aString.
	identityBag add: anOtherString.
	
	self assert: (identityBag occurrencesOf: aString) = 2.
	self assert: (identityBag occurrencesOf: anOtherString) = 1.



! !

!IdentityBagTest methodsFor: 'requirements' stamp: 'delaunay 5/13/2009 14:02'!
identityCollectionWithElementsCopyNotIdentical
"Returns a collection including elements for which #copy doesn't return the same object."
	^ identityBagNonEmptyNoDuplicate5Elements ifNil: [ 
	identityBagNonEmptyNoDuplicate5Elements := IdentityBag new add: 2.5 ; add: 1.5  ;add: 5.5 ; yourself ]! !

!IdentityBagTest methodsFor: 'tests - converting' stamp: 'delaunay 4/30/2009 12:02'!
testAsSetWithEqualsElements
	| t1 |
	t1 := self withEqualElements asSet.
	self withEqualElements
		do: [:t2 | self assert: (t1 occurrencesOf: t2)
					= 1].
	self assert: t1 class = IdentitySet! !

!IdentityBagTest methodsFor: 'requirements' stamp: 'delaunay 4/30/2009 11:20'!
elementToCopy
	^ elementToCopy ifNil: [ elementToCopy := 'element to copy' ]! !

!IdentityBagTest methodsFor: 'requirements' stamp: 'delaunay 4/30/2009 11:20'!
equalNotIdenticalElement
	^ equalNotIdenticalElement ifNil: [ equalNotIdenticalElement := self elementToCopy copy ]! !

!IdentityBagTest methodsFor: 'tests - identity adding' stamp: 'delaunay 4/30/2009 11:19'!
testIdentityAdd
	| added oldSize |
	oldSize := self collection size.
	self collection add: self elementToCopy .
	self deny: (self collection includes: self equalNotIdenticalElement).
	
	added := self collection add: self equalNotIdenticalElement.
	self assert: added == self equalNotIdenticalElement.
	self assert: (self collection includes: self equalNotIdenticalElement)! !

!IdentityDictionary commentStamp: 'ls 06/15/02 22:35'!
Like a Dictionary, except that keys are compared with #== instead of #= .

See the comment of IdentitySet for more information.!
!IdentityDictionary methodsFor: 'private' stamp: 'MartinMcClure 1/16/2010 18:19'!
scanFor: anObject
	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
	| finish start element |
	finish := array size.
	start := (anObject identityHash \\ finish) + 1.

	"Search from (hash mod size) to the end."
	start to: finish do:
		[:index | ((element := array at: index) == nil or: [element key == anObject])
			ifTrue: [^ index ]].

	"Search from 1 to where we started."
	1 to: start-1 do:
		[:index | ((element := array at: index) == nil or: [element key == anObject])
			ifTrue: [^ index ]].

	^ 0  "No match AND no empty slot"! !

!IdentityDictionary methodsFor: 'private' stamp: 'di 12/1/1999 20:54'!
keyAtValue: value ifAbsent: exceptionBlock
	"Answer the key that is the external name for the argument, value. If 
	there is none, answer the result of evaluating exceptionBlock."
 
	self associationsDo: 
		[:association | value == association value ifTrue: [^ association key]].
	^ exceptionBlock value! !

!IdentityDictionary methodsFor: 'private' stamp: 'HenrikSperreJohansen 9/1/2010 22:50'!
scanForEmptySlotFor: aKey
	"Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements."
	
	| index start |
	index := start := aKey identityHash \\ array size + 1.
	[ 
		(array at: index) ifNil: [ ^index ].
		(index := index \\ array size + 1) = start ] whileFalse.
	self errorNoFreeSpace! !

!IdentityDictionaryTest commentStamp: 'TorstenBergmann 2/20/2014 15:20'!
SUnit tests for identity dictionaries!
!IdentityDictionaryTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 6/29/2009 11:41'!
classToBeTested

	^ IdentityDictionary! !

!IdentityDictionaryTest methodsFor: 'tests - identity' stamp: 'cyrille.delaunay 6/29/2009 13:21'!
testIdentity
	| dict key |
	dict := self classToBeTested new.
	key := 'key'.
	dict at: key put: 2.5.
	 
	
	self assert: (dict includesKey: key).
	self deny: (dict includesKey: key copy).
	
"	dict at: 1 put: 'djdh'.
	dict at: 'sksl' put: 1.0.
	self deny: (dict includesKey: 1.0) .
	self assert: (dict includes: 1)"
! !

!IdentityDictionaryTest class methodsFor: 'building suites' stamp: 'cyrille.delaunay 6/29/2009 11:41'!
shouldInheritSelectors

^true! !

!IdentityMorphTreeListManager commentStamp: '<historical>'!
An IdentityMorphTreeListManager is a MorphTreeListManager which always check for identity between items
!
!IdentityMorphTreeListManager methodsFor: 'accessing' stamp: ''!
nodeMorphsWithAllNodeItems: aNodeItemList

	^ self allNodeMorphs select: [:m | aNodeItemList identityIncludes: m complexContents withoutListWrapper]! !

!IdentityMorphTreeMorph commentStamp: '<historical>'!
An IdentityMorphTreeMorph is a MorphTreeMorph which always check for identity between items
!
!IdentityMorphTreeMorph methodsFor: 'accessing' stamp: ''!
listManager: aManager

	listManager := aManager! !

!IdentityMorphTreeMorph methodsFor: 'expanding-collapsing' stamp: ''!
notExpandedFormForMorph: aMorph

	^ ((self selectedMorphList identityIncludes: aMorph) and: [self theme selectionColor luminance < 0.6])
		ifTrue: [self theme whiteTreeUnexpandedForm]
		ifFalse: [self theme treeUnexpandedForm]! !

!IdentityMorphTreeMorph methodsFor: 'expanding-collapsing' stamp: ''!
expandedFormForMorph: aMorph
	"Answer the form to use for expanded items."
	
	^ ((self selectedMorphList identityIncludes: aMorph) and: [self theme selectionColor luminance < 0.6])
		ifTrue: [self theme whiteTreeExpandedForm]
		ifFalse: [self theme treeExpandedForm]! !

!IdentityNewValueHolder commentStamp: 'BenjaminVanRyseghem 1/23/2014 15:19'!
I am a special because I announce changes only if the new value set is different from the current value.!
!IdentityNewValueHolder methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/23/2014 12:09'!
value: anObject

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

!IdentitySet commentStamp: 'sw 1/14/2003 22:35'!
The same as a Set, except that items are compared using #== instead of #=.

Almost any class named IdentityFoo is the same as Foo except for the way items are compared.  In Foo, #= is used, while in IdentityFoo, #== is used.  That is, identity collections will treat items as the same only if they have the same identity.

For example, note that copies of a string are equal:

	('abc' copy) = ('abc' copy)

but they are not identitcal:

	('abc' copy) == ('abc' copy)

A regular Set will only include equal objects once:

	| aSet |
	aSet := Set new.
	aSet add: 'abc' copy.
	aSet add: 'abc' copy.
	aSet


An IdentitySet will include multiple equal objects if they are not identical:

	| aSet |
	aSet := IdentitySet new.
	aSet add: 'abc' copy.
	aSet add: 'abc' copy.
	aSet
!
!IdentitySet methodsFor: 'converting' stamp: 'ar 9/22/2000 10:13'!
asIdentitySet
	^self! !

!IdentitySet methodsFor: '*Fuel' stamp: 'm 3/9/2014 21:27'!
fuelReplacement
	| copy |
	copy := self copyEmpty addAll: self.
	^ (self size ~= copy size)
		ifTrue: [ copy ]
		ifFalse: [ self ]! !

!IdentitySet methodsFor: 'private' stamp: 'IgorStasenko 5/30/2011 18:23'!
scanFor: anObject
	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."

	| index start hash |
	hash := anObject identityHash.
	index := start := hash \\ array size + 1.
	[ 
		| element |
		((element := array at: index) == nil or: [ element enclosedSetElement == anObject ])
			ifTrue: [ ^index ].
		(index := index \\ array size + 1) = start ] whileFalse.
	self errorNoFreeSpace! !

!IdentitySet methodsFor: 'private' stamp: 'HenrikSperreJohansen 9/1/2010 22:50'!
scanForEmptySlotFor: aKey
	"Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements."
	
	| index start |
	index := start := aKey identityHash \\ array size + 1.
	[ 
		(array at: index) ifNil: [ ^index ].
		(index := index \\ array size + 1) = start ] whileFalse.
	self errorNoFreeSpace! !

!IdentitySetTest commentStamp: 'TorstenBergmann 2/20/2014 15:28'!
SUnit tests for identity sets!
!IdentitySetTest methodsFor: 'requirements' stamp: 'CamilloBruni 7/3/2013 12:59'!
classToBeTested

	^ IdentitySet! !

!IdentitySetTest methodsFor: 'tests - identity' stamp: 'cyrille.delaunay 6/29/2009 11:18'!
testIdentity
	"self run:#testIdentity" 
	"self debug:#testIdentity"
	| identitySet aString anOtherString |
	
	aString := 'hello'.
	anOtherString := aString copy.
	
	self assert: (aString = anOtherString).
	self assert: (aString == anOtherString) not.

	
	identitySet := self classToBeTested  new.
	identitySet add: aString.

	
	self assert: (identitySet occurrencesOf: aString) = 1.
	self assert: (identitySet occurrencesOf: anOtherString) = 0.
	

	self assert: (identitySet includes: aString).
	self deny: (identitySet includes: anOtherString) = 0.! !

!IdentitySetTest methodsFor: 'requirements' stamp: 'delaunay 5/13/2009 14:05'!
identityCollectionWithElementsCopyNotIdentical
" return a collection including elements for which #copy return a new object "
	^ floatCollection ifNil: [ floatCollection := IdentitySet new add: 2.5 ; add: 4.5 ; add:5.5 ; yourself ].! !

!IdentitySetTest methodsFor: 'tests - identity' stamp: 'StephaneDucasse 12/29/2011 14:31'!
testGrowWithNil
	"self run: #testGrowWithNil"
	"This test covers that grow take into account that nil are wrapped elements of sets"
	| set |
	set := IdentitySet new.
	set add: nil.
	set grow.
	self assert: (set includes: nil)! !

!IdentitySetTest class methodsFor: 'building suites' stamp: 'cyrille.delaunay 6/29/2009 10:51'!
shouldInheritSelectors

^true! !

!IdentityTransform commentStamp: 'TorstenBergmann 2/12/2014 22:28'!
Identity transformation!
!IdentityTransform methodsFor: 'transforming rects' stamp: 'ar 9/11/2000 21:20'!
localBoundsToGlobal: aRectangle
	"Transform aRectangle from local coordinates into global coordinates"
	^aRectangle! !

!IdentityTransform methodsFor: 'testing' stamp: 'ar 9/11/2000 21:18'!
isIdentity
	"Return true if the receiver is the identity transform; that is, if applying to a point returns the point itself."
	^true! !

!IdentityTransform methodsFor: 'accessing' stamp: 'di 9/29/2000 09:04'!
angle
	^ 0.0! !

!IdentityTransform methodsFor: 'accessing' stamp: 'ar 4/19/2001 06:01'!
offset
	^0@0! !

!IdentityTransform methodsFor: 'transforming points' stamp: 'ar 9/11/2000 21:20'!
localPointToGlobal: aPoint
	"Transform aPoint from local coordinates into global coordinates"
	^aPoint! !

!IdentityTransform methodsFor: 'transforming rects' stamp: 'ar 9/11/2000 21:21'!
sourceQuadFor: aRectangle
	^ aRectangle innerCorners! !

!IdentityTransform methodsFor: 'transforming points' stamp: 'ar 9/11/2000 21:20'!
localPointsToGlobal: inArray
	"Transform all the points of inArray from local into global coordinates"
	^inArray! !

!IdentityTransform methodsFor: 'initialize' stamp: 'ar 9/11/2000 21:18'!
setIdentity
	"I *am* the identity transform"
	^self! !

!IdentityTransform methodsFor: 'composing' stamp: 'ar 9/11/2000 21:27'!
composedWith: aTransform
	^aTransform! !

!IdentityTransform methodsFor: 'testing' stamp: 'ar 9/11/2000 21:19'!
isPureTranslation
	"Return true if the receiver specifies no rotation or scaling."
	^true! !

!IdentityTransform methodsFor: 'composing' stamp: 'ar 9/11/2000 21:19'!
composedWithLocal: aTransformation
	^aTransformation! !

!IdentityTransform methodsFor: 'transforming points' stamp: 'gh 10/22/2001 13:24'!
invertBoundsRect: aRectangle
	"Return a rectangle whose coordinates have been transformed
	from local back to global coordinates. Since I am the identity matrix
	no transformation is made."

	^aRectangle
! !

!IdentityTransform methodsFor: 'transforming points' stamp: 'ar 9/11/2000 21:20'!
globalPointsToLocal: inArray
	"Transform all the points of inArray from global into local coordinates"
	^inArray! !

!IdentityTransform methodsFor: 'transforming rects' stamp: 'ar 9/11/2000 21:20'!
globalBoundsToLocal: aRectangle
	"Transform aRectangle from global coordinates into local coordinates"
	^aRectangle! !

!IdentityTransform methodsFor: 'accessing' stamp: 'ar 9/11/2000 21:18'!
inverseTransformation
	"Return the inverse transformation of the receiver"
	^self! !

!IdentityTransform methodsFor: 'composing' stamp: 'ar 9/11/2000 21:19'!
composedWithGlobal: aTransformation
	^aTransformation! !

!IdentityTransform methodsFor: 'transforming points' stamp: 'ar 9/11/2000 21:19'!
globalPointToLocal: aPoint
	"Transform aPoint from global coordinates into local coordinates"
	^aPoint! !

!IdentityTransform methodsFor: 'converting' stamp: 'ar 9/11/2000 21:21'!
asMatrixTransform2x3
	"Represent the receiver as a 2x3 matrix transformation"
	^MatrixTransform2x3 identity! !

!IdentityTransform class methodsFor: 'initialization' stamp: 'lr 7/4/2009 10:42'!
initialize
	"IdentityTransform initialize"
	Default := self basicNew! !

!IdentityTransform class methodsFor: 'instance creation' stamp: 'ar 9/11/2000 21:24'!
new
	"There can be only one"
	^Default! !

!IllegalName commentStamp: 'TorstenBergmann 1/31/2014 11:34'!
I am raised on an attempt to use an illegal file name
!
!IllegalName methodsFor: 'accessing' stamp: 'DamienPollet 2/28/2011 17:08'!
name
	^ name! !

!IllegalName methodsFor: 'initialization' stamp: 'DamienPollet 2/28/2011 17:08'!
initializeWithName: aName
	name := aName.
	self messageText: aName! !

!IllegalName class methodsFor: 'instance creation' stamp: 'DamienPollet 2/28/2011 17:03'!
signalWith: aName
	^ (self name: aName) signal! !

!IllegalName class methodsFor: 'instance creation' stamp: 'DamienPollet 2/28/2011 17:04'!
name: aName
	^ self basicNew initializeWithName: aName! !

!IllegalResumeAttempt commentStamp: '<historical>'!
This class is private to the EHS implementation.  An instance of it is signaled whenever an attempt is made to resume from an exception which answers false to #isResumable.!
!IllegalResumeAttempt methodsFor: 'comment' stamp: 'ajh 2/1/2003 00:57'!
isResumable
	
	^ false! !

!IllegalResumeAttempt methodsFor: 'comment' stamp: 'tfei 6/2/1999 14:59'!
readMe

	"Never handle this exception!!"! !

!IllegalResumeAttempt methodsFor: 'comment' stamp: 'ajh 9/4/2002 19:24'!
defaultAction
	"No one has handled this error, but now give them a chance to decide how to debug it.  If none handle this either then open debugger (see UnhandedError-defaultAction)"

	UnhandledError signalForException: self! !

!ImageCleaner commentStamp: 'TorstenBergmann 2/4/2014 20:43'!
Used for cleaning the image!
!ImageCleaner methodsFor: 'cleaning' stamp: 'BenComan 11/3/2014 20:51'!
cleanUpMethods
	"Make sure that all methods in use are restarted"
	"self new cleanUpMethods"

	WeakArray restartFinalizationProcess.
	WorldState allInstancesDo: [ :ws | ws convertAlarms; cleanStepList; resetWorldMenu].
	WorldState allInstancesDo: [ :ws | ws instVarNamed: 'menuBuilder' put: nil ].
	ProcessBrowser initialize.
	Delay restartTimerEventLoop.! !

!ImageCleaner methodsFor: 'cleaning' stamp: 'MarcusDenker 6/24/2013 12:42'!
cleanUpProcesses

    (Process allInstances
               reject: [ :p |
                       {(InputEventFetcher default fetcherProcess).
                       (Processor activeProcess).
                       (WeakArray runningFinalizationProcess).
                      (Processor backgroundProcess).
                       (SmalltalkImage current lowSpaceWatcherProcess).
                       (UIManager default uiProcess).
                       (Delay schedulingProcess)} includes: p ])
               do: [ :p |
                       p suspend; terminate ]
! !

!ImageCleaner methodsFor: 'cleaning' stamp: 'MarcusDenker 1/31/2014 16:28'!
examplePackages
	^RPackageOrganizer default  packageNames select: [ :each | each endsWith: 'Examples' ]! !

!ImageCleaner methodsFor: 'api' stamp: 'MarcusDenker 9/25/2014 14:48'!
cleanUpForRelease
	"self new cleanUpForRelease"

	Author fullName: 'Mr.Cleaner'.
	self cleanUpMethods.
	
	FreeTypeFontProvider current initialize.
	EmbeddedFreeTypeFontInstaller initialize.
	SystemNavigation new
		allObjectsDo: [ :each | 
			(each respondsTo: #releaseCachedState)
				ifTrue: [ each releaseCachedState ] ].
	
	"Remove empty categories, which are not in MC packages, because MC does
	not do this (this script does not make packages dirty)"
	Smalltalk organization removeEmptyCategories.
	Smalltalk
		allClassesAndTraitsDo: [ :class |
			[ :each |
				each
					removeEmptyCategories;
					sortCategories ]
						value: class organization;
						value: class class organization ].
	Smalltalk organization sortCategories.
	Smalltalk garbageCollect.
	Smalltalk cleanOutUndeclared. 
	Smalltalk fixObsoleteReferences.
	Smalltalk cleanUp: true except: #() confirming: false.	
	Author reset! !

!ImageCleaner methodsFor: 'cleaning' stamp: 'MarcusDenker 1/31/2014 16:37'!
packagesForCleanUpInProduction
	"A list of packages who will be unloaded when going to production.
	 WARNING, ORDER IS IMPORTANT"
	
	^#(
	"Manifest & Critics Browser"
	'Manifest-Core'
	'Manifest-CriticBrowser'
	'Manifest-Tests'
	'Manifest-Resources-Tests'
	"Metacello"
	'Metacello-ToolBox'
	'Metacello-MC'
	'Metacello-Platform'
	'Metacello-Core'
	'Metacello-Base'
	'Metacello-ProfStef'
	'Metacello-Tutorial'
	'Metacello-TestsCore'
	'Metacello-TestsMC'
	'Metacello-TestsMCCore'
	'Metacello-TestsMCResources'
	'Metacello-TestsPharo20MC'
	'Metacello-TestsPlatform'
	'Metacello-TestsTutorial'

	)
! !

!ImageCleaner methodsFor: 'api' stamp: 'MarcusDenker 3/2/2015 17:29'!
cleanUpForProduction
	"self new cleanUpForProduction"
	"delete logo"	
	PolymorphSystemSettings showDesktopLogo: false.

	self packagesForCleanUpInProduction do: [ :each | (MCPackage named: each) unload ].	
	self helpPackages do: [ :each | (MCPackage named: each) unload ].	
	self testPackages do: [ :each | (MCPackage named: each) unload ].
	self examplePackages do: [ :each | (MCPackage named: each) unload ].
	(MCPackage named: 'ScriptLoader40') unload.	
		
		
	(MCPackage named: 'MonticelloMocks') unload.	
	(MCPackage named: 'ToolsTest') unload.	
	(MCPackage named: 'Announcements-Tests-Core') unload.	
	(MCPackage named: 'AST-Tests-Core') unload.	
	(MCPackage named: 'AST-Interpreter-Test') unload.	
	(MCPackage named: 'Ring-Tests-Containers') unload.	
	(MCPackage named: 'Ring-Tests-Kernel') unload.	
	(MCPackage named: 'Ring-Tests-Monticello') unload.	
	(MCPackage named: 'Regex-Tests-Core') unload.	
	(MCPackage named: 'Refactoring-Tests-Changes') unload.	
	(MCPackage named: 'Refactoring-Tests-Core') unload.	
	(MCPackage named: 'Refactoring-Tests-Critics') unload.	
	(MCPackage named: 'Refactoring-Tests-Environment') unload.	
	(MCPackage named: 'FileSystem-Tests-Core') unload.	
	(MCPackage named: 'FileSystem-Tests-Disk') unload.	
	(MCPackage named: 'FileSystem-Tests-Memory') unload.		
			
	(MCPackage named: 'GT-Tests-Inspector') unload.		
	(MCPackage named: 'Glamour-Tests-Core') unload.		
	(MCPackage named: 'Glamour-Tests-Morphic') unload.		
	(MCPackage named: 'Glamour-Tests-Resources') unload.		
	(MCPackage named: 'Glamour-Tests-Rubric') unload.		
			
	(MCPackage named: 'Versionner-Core-Model') unload.
	(MCPackage named: 'Versionner-Core-DependenciesModel') unload.		
	(MCPackage named: 'Versionner-Core-Announcements') unload.	
	(MCPackage named: 'Versionner-Core-Commands') unload.	
	(MCPackage named: 'Versionner-Spec-Browser') unload.				
	(MCPackage named: 'Versionner-Tests-Core-Commands') unload.	
	(MCPackage named: 'Versionner-Tests-Core-DependenciesModel') unload.	
	(MCPackage named: 'Versionner-Tests-Core-Model') unload.			
	(MCPackage named: 'Versionner-Tests-Resources') unload.												
	
	self cleanUpForRelease.
	! !

!ImageCleaner methodsFor: 'cleaning' stamp: 'MarcusDenker 1/30/2014 15:28'!
helpPackages
	^RPackageOrganizer default  packageNames select: [ :each | each endsWith: '-Help' ]! !

!ImageCleaner methodsFor: 'cleaning' stamp: 'MarcusDenker 1/31/2014 16:39'!
testPackages
	^(RPackageOrganizer default  packageNames select: [ :each | each endsWith: 'Tests' ]) copyWithout: 'ReleaseTests'! !

!ImageCleaner class methodsFor: 'instance creation' stamp: 'MarcusDenker 11/16/2012 17:01'!
cleanUpForProduction
	self new cleanUpForProduction! !

!ImageCleaner class methodsFor: 'instance creation' stamp: 'MarcusDenker 11/16/2012 17:01'!
cleanUpForRelease
	self new cleanUpForRelease! !

!ImageCleanerCommandLineHandler commentStamp: 'MarcusDenker 1/25/2014 13:04'!
Usage: clean [ --release ]
	--release        do #cleanUpForRelease
	--production   do #cleanUpForProduction
	
Documentation:
	This allows to run the ImageCleaner from the commandLine.
	With no special option it runs Smalltalk cleanUp: true.

Usage:
	pharo Pharo.image clean
	pharo Pharo.image clean --release!
!ImageCleanerCommandLineHandler methodsFor: 'activation' stamp: 'MarcusDenker 1/25/2014 13:03'!
activate
	self activateHelp
		ifTrue: [  ^ self ].
	self cleanUpImage.
	Smalltalk snapshot: true andQuit: true.! !

!ImageCleanerCommandLineHandler methodsFor: 'actions' stamp: 'MarcusDenker 1/25/2014 13:03'!
cleanUpImage
	(self hasOption: 'release')
		ifTrue: [^ImageCleaner cleanUpForRelease].
	(self hasOption: 'production')	
		ifTrue: [ ^ImageCleaner cleanUpForProduction].
	Smalltalk cleanUp: true except: #() confirming: false.	! !

!ImageCleanerCommandLineHandler class methodsFor: 'accessing' stamp: 'MarcusDenker 1/25/2014 13:05'!
description
	^ 'Run image cleanup'! !

!ImageCleanerCommandLineHandler class methodsFor: 'accessing' stamp: 'MarcusDenker 1/25/2014 12:49'!
commandName
	^ 'clean'! !

!ImageFillStyle commentStamp: 'gvc 9/23/2008 11:55'!
Simple fillstyle that draws a (potentially translucent) form at the specified origin. Direction and normal are unused.!
!ImageFillStyle methodsFor: 'accessing' stamp: 'gvc 3/26/2008 19:18'!
form
	"Answer the value of form"

	^ form! !

!ImageFillStyle methodsFor: 'comparing' stamp: 'gvc 12/8/2008 18:53'!
hash
	"Hash is implemented because #= is implemented."
	
	^super hash bitXor: self form hash! !

!ImageFillStyle methodsFor: 'converting' stamp: 'gvc 3/2/2010 17:16'!
asColor
	"Answer transparent, no other reasonable interpretation."
	
	^Color transparent! !

!ImageFillStyle methodsFor: 'accessing' stamp: 'gvc 10/3/2008 11:57'!
extent: anObject
	"Set the value of extent"

	extent := anObject! !

!ImageFillStyle methodsFor: 'accessing' stamp: 'gvc 10/3/2008 11:57'!
extent
	"Answer the value of extent"

	^ extent! !

!ImageFillStyle methodsFor: 'accessing' stamp: 'gvc 1/28/2009 17:40'!
offset
	"Answer the value of offset"

	^ offset! !

!ImageFillStyle methodsFor: 'initialization' stamp: 'gvc 1/28/2009 17:40'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		origin: 0@0;
		offset: 0@0! !

!ImageFillStyle methodsFor: 'comparing' stamp: 'gvc 12/8/2008 18:54'!
= anOrientedFillStyle
	"Answer whether equal."

	^super = anOrientedFillStyle
		and: [self form = anOrientedFillStyle form]! !

!ImageFillStyle methodsFor: 'accessing' stamp: 'gvc 1/28/2009 17:40'!
offset: anObject
	"Set the value of offset"

	offset := anObject! !

!ImageFillStyle methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/28/2009 17:40'!
fillRectangle: aRectangle on: aCanvas
	"Fill the given rectangle on the given canvas with the receiver."
	
	self extent
		ifNil: [aCanvas
				translucentImage: self form
				at: self origin]
		ifNotNil: [aCanvas clipBy: (self origin + self offset extent: self extent) during: [:c |
					c
						translucentImage: self form
						at: self origin]]! !

!ImageFillStyle methodsFor: 'accessing' stamp: 'gvc 10/21/2008 15:51'!
form: aForm
	"Set the value of form"

	form := aForm.
	self direction: aForm extent! !

!ImageFillStyle methodsFor: '*Athens-Core' stamp: 'IgorStasenko 10/12/2012 03:28'!
asAthensPaintOn: anAthensCanvas

	^ (anAthensCanvas cacheAt: self ifAbsentPut: [
		anAthensCanvas surface
		createFormPaint: form ])
		origin: origin;
		direction: (form width@0)
! !

!ImageFillStyle class methodsFor: 'as yet unclassified' stamp: 'gvc 3/26/2008 19:17'!
form: aForm
	"Answer a new instance of the receiver with the given form."

	^self new form: aForm! !

!ImageModel commentStamp: '<historical>'!
An ImageModel is a spec model for images!
!ImageModel methodsFor: 'api' stamp: 'StephaneDucasse 2/27/2015 21:38'!
image: aForm
	"<api: #image getter: #image>"
	"Set the form of the imagemorph"
	
	imageHolder value: aForm! !

!ImageModel methodsFor: 'api-valueHolder' stamp: 'StephaneDucasse 2/27/2015 21:40'!
actionHolder
	"To be able to register action when the action is changed."
	^ actionHolder! !

!ImageModel methodsFor: 'initialization' stamp: 'StephaneDucasse 2/27/2015 21:40'!
initialize
	super initialize.
	imageHolder := nil asValueHolder.
	actionHolder := [] asValueHolder. 
	imageHolder whenChangedDo: [ self changed: #getImage ].! !

!ImageModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:06'!
image
	"<api: #inspect>"

	^ imageHolder value! !

!ImageModel methodsFor: 'api-valueHolder' stamp: 'StephaneDucasse 2/27/2015 21:39'!
imageHolder
	"To be able to register action when the image is changed."
	^ imageHolder! !

!ImageModel methodsFor: 'api' stamp: 'StephaneDucasse 2/27/2015 21:39'!
action
	"<api: #inspect>"

	^ actionHolder value! !

!ImageModel methodsFor: '*Deprecated40' stamp: 'StephaneDucasse 2/27/2015 21:37'!
whenImageChanged: aBlock
	"Set a block to performed when the image is changed"
	self deprecated: 'Instead of using aModel whenImageChanged: aBlock, use aModel imageHolder whenChangedDo: aBlock.'.
	imageHolder whenChangedDo: aBlock! !

!ImageModel methodsFor: 'api' stamp: 'StephaneDucasse 2/27/2015 21:39'!
action: aBlock
	"Set the action of the image"
	"<api: #block getter: #action>"
	actionHolder value: aBlock! !

!ImageModel methodsFor: '*Deprecated40' stamp: 'StephaneDucasse 2/27/2015 21:43'!
whenActionChanged: aBlock
	"Set a block to performed when the action is changed"
	self deprecated: 'Instead of using aModel whenActionChanged: aBlock, use aModel actionHolder whenChangedDo: aBlock.'.
	action whenChangedDo: aBlock! !

!ImageModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 11/3/2013 23:03'!
defaultSpec
	<spec>
	
	^ #(ImageAdapter
		adapt: #(model))! !

!ImageModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/13/2014 15:21'!
adapterName

	^ #ImageAdapter! !

!ImageMorph commentStamp: 'efc 3/7/2003 17:48'!
ImageMorph is a morph that displays a picture (Form). My extent is determined by the extent of my form.

Use #image: to set my picture.

Structure:
 instance var		Type 		Description
 image				Form		The Form to use when drawing

Code examples:
	ImageMorph new openInWorld; grabFromScreen

	(Form fromFileNamed: 'myGraphicsFileName') asMorph openInWorld

Relationship to SketchMorph: ImageMorph should be favored over SketchMorph, a parallel, legacy class -- see the Swiki FAQ for details ( http://minnow.cc.gatech.edu/squeak/1372 ). 
!
!ImageMorph methodsFor: 'testing' stamp: 'StephaneDucasse 5/23/2013 17:21'!
wantsRecolorHandle
	^ image notNil and: [image depth = 1]! !

!ImageMorph methodsFor: 't-rotating' stamp: ''!
forwardDirection: newDirection
	"Set the receiver's forward direction (in eToy terms)"
	self setProperty: #forwardDirection toValue: newDirection.! !

!ImageMorph methodsFor: '*glamour-morphic-widgets' stamp: 'cyrilledelaunay 6/6/2011 16:02'!
setOptimalResizing
	self hResizing: #rigid.
	self vResizing: #rigid! !

!ImageMorph methodsFor: 'testing' stamp: 'WilliamSix 1/14/2013 19:44'!
shouldFlex
	^ true.! !

!ImageMorph methodsFor: 'menu commands' stamp: 'StephaneDucasse 5/23/2013 18:36'!
readFromFile
	| fileName |
	fileName := UIManager default
		request: 'Please enter the image file name' translated
		initialAnswer: 'fileName'.
	fileName isEmptyOrNil ifTrue: [^ self].
	self form: (Form fromFileNamed: fileName).
! !

!ImageMorph methodsFor: 'caching' stamp: ''!
releaseCachedState

	super releaseCachedState.
	image hibernate.
! !

!ImageMorph methodsFor: 'geometry' stamp: 'gvc 9/25/2006 15:45'!
adoptPaneColor: paneColor
	"Change our border color too."
	
	super adoptPaneColor: paneColor.
	paneColor ifNil: [^self].
	self borderStyle baseColor: paneColor twiceDarker! !

!ImageMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 5/23/2013 17:18'!
color: aColor
	"Set the color.
	Change to a ColorForm here if depth 1."
	
	super color: aColor.
    (image depth = 1 and: [aColor isColor]) ifTrue: [
		image isColorForm ifFalse: [
			image := ColorForm mappingWhiteToTransparentFrom: image].
			image colors: {Color transparent. aColor}.
			self changed]! !

!ImageMorph methodsFor: 't-rotating' stamp: ''!
forwardDirection
	"Return the receiver's forward direction (in eToy terms)"
	^self valueOfProperty: #forwardDirection ifAbsent:[0.0]! !

!ImageMorph methodsFor: 'initialization' stamp: 'StephaneDucasse 5/23/2013 17:28'!
initialize

	super initialize.
	self form: self defaultImage.
! !

!ImageMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 5/23/2013 17:22'!
borderWidth: bw

	| newExtent |
	newExtent := 2 * bw + image extent.
	bounds extent = newExtent ifFalse: [super extent: newExtent].
	super borderWidth: bw! !

!ImageMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 5/23/2013 17:22'!
isOpaque: aBool
	"Mark the receiver as being completely opaque or not"
	
	aBool == false
		ifTrue: [self removeProperty: #isOpaque]
		ifFalse: [self setProperty: #isOpaque toValue: aBool].
	self changed! !

!ImageMorph methodsFor: 'menu' stamp: 'ar 11/7/2000 14:57'!
changeOpacity
	self isOpaque: self isOpaque not! !

!ImageMorph methodsFor: 'other' stamp: 'StephaneDucasse 5/23/2013 18:06'!
imageExport
	
	^ self form bits asArray! !

!ImageMorph methodsFor: 't-rotating' stamp: ''!
setDirectionFrom: aPoint
	| delta degrees |
	delta := (self transformFromWorld globalPointToLocal: aPoint) - self referencePosition.
	degrees := delta degrees + 90.0.
	self forwardDirection: (degrees \\ 360) rounded.
! !

!ImageMorph methodsFor: 't-rotating' stamp: ''!
rotationDegrees: degrees	
	"redefined in all morphs which are using myself"! !

!ImageMorph methodsFor: 'accessing' stamp: 'gvc 8/27/2009 11:56'!
borderStyle: newStyle
	"Set the extent to include border width."
	
	| newExtent |
	self borderStyle = newStyle ifTrue: [^self].
	newExtent := 2 * newStyle width + image extent.
	bounds extent = newExtent ifFalse: [super extent: newExtent].
	super borderStyle: newStyle! !

!ImageMorph methodsFor: 't-rotating' stamp: ''!
prepareForRotating
	"If I require a flex shell to rotate,
	then wrap it in one and return it.
	Polygons, eg, may override to do nothing."

	^ self addFlexShell! !

!ImageMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 5/23/2013 17:22'!
isOpaque
	"Return true if the receiver is marked as being completely opaque"
	
	^ self
		valueOfProperty: #isOpaque
		ifAbsent: [false]! !

!ImageMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 5/23/2013 18:32'!
image: anImage 
	
	image := anImage. 
	super extent: (2 * self borderWidth) asPoint + image extent.
	self changed! !

!ImageMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 5/23/2013 17:20'!
form
	^ image
! !

!ImageMorph methodsFor: 'geometry' stamp: 'BenjaminVanRyseghem 10/17/2013 18:08'!
extent: aPoint
	"Do nothing; my extent is determined by my image Form."
		
	self triggerEvent: #extent with: aPoint! !

!ImageMorph methodsFor: 'menu' stamp: 'StephaneDucasse 4/22/2012 16:48'!
opacityString
	^ (self isOpaque) -> 'opaque' translated! !

!ImageMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/6/2015 19:46'!
drawOnAthensCanvas: aCanvas
	
	| cached style|
	
	cached := aCanvas cacheAt: image ifAbsentPut: [
		image asAthensPaintOn: aCanvas.
		].
	
	aCanvas setPaint: cached.
		
		aCanvas paintTransform restoreAfter: [
			aCanvas paintTransform translateBy: self innerBounds origin "negated".
		
			aCanvas drawShape: self innerBounds.
		].
	(style := self borderStyle) ifNotNil: [
		aCanvas setStrokePaint: style.
		aCanvas drawShape: bounds]	
! !

!ImageMorph methodsFor: 'menus' stamp: 'StephaneDucasse 10/27/2014 20:19'!
addCustomMenuItems: aMenu hand: aHand
	super addCustomMenuItems: aMenu hand: aHand.
	aMenu addUpdating: #opacityString selector: #changeOpacity! !

!ImageMorph methodsFor: 'drawing' stamp: 'StephaneDucasse 5/23/2013 17:19'!
drawOn: aCanvas
	"Draw the border after the image."
	
	| style |
	self isOpaque
		ifTrue: [aCanvas drawImage: image at: self innerBounds origin]
		ifFalse: [aCanvas translucentImage: image at: self innerBounds origin].
	(style := self borderStyle) ifNotNil: [style frameRectangle: bounds on: aCanvas]! !

!ImageMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 5/23/2013 17:20'!
withSnapshotBorder
	self 
		borderStyle:
			((ComplexBorder style: #complexFramed)
				color: (Color r: 0.613 g: 1.0 b: 0.516);
				width: 1;
				yourself)! !

!ImageMorph methodsFor: 'menu commands' stamp: 'StephaneDucasse 5/23/2013 18:35'!
grabFromScreen

	self form: Form fromUser.
! !

!ImageMorph methodsFor: 't-rotating' stamp: ''!
heading
	"Return the receiver's heading"
	^ self owner 
		ifNil: [self forwardDirection]
		ifNotNil: [self forwardDirection + self owner degreesOfFlex]! !

!ImageMorph methodsFor: 'testing' stamp: 'StephaneDucasse 12/5/2009 21:08'!
areasRemainingToFill: aRectangle

	^self isOpaque
		ifTrue: [aRectangle areasOutside: self bounds]
		ifFalse: [Array with: aRectangle]! !

!ImageMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 5/23/2013 18:33'!
form: aForm
	image := aForm. 
	super extent: (2 * self borderWidth) asPoint + image extent.
	self changed! !

!ImageMorph methodsFor: '*Spec-Inspector' stamp: 'BenjaminVanRyseghem 10/17/2013 18:10'!
resize: newSize

	self form: (image scaledToSize: newSize)! !

!ImageMorph methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 09:36'!
defaultImage
	"Answer the default image for the receiver."

	^ DefaultForm! !

!ImageMorph methodsFor: 't-rotating' stamp: ''!
rotationDegrees
	"Default implementation."

	^ 0.0
! !

!ImageMorph class methodsFor: 'accessing' stamp: 'ar 6/25/1999 11:59'!
defaultForm
	^DefaultForm! !

!ImageMorph class methodsFor: 'instance creation' stamp: 'StephaneDucasse 3/3/2010 15:16'!
fromStream: aStream

	^self withForm: (ImageReadWriter formFromStream: aStream)! !

!ImageMorph class methodsFor: 'initialization' stamp: 'AlainPlantec 10/17/2009 18:03'!
initialize
	"ImageMorph initialize"

	| h p d |
	DefaultForm := (Form extent: 80@40 depth: 16).
	h := DefaultForm height // 2.
	0 to: h - 1 do: [:i |
		p := (i * 2)@i.
		d := i asFloat / h asFloat.
		DefaultForm fill:
			(p corner: DefaultForm extent - p)
			fillColor: (Color r: d g: 0.5 b: 1.0 - d)].
! !

!ImageMorph class methodsFor: 'instance creation' stamp: 'AlainPlantec 11/29/2009 21:34'!
fromString: aString 
	"Create a new ImageMorph which displays the input string in the standard button font"

	^ self fromString: aString font: StandardFonts buttonFont! !

!ImageMorph class methodsFor: 'instance creation' stamp: 'StephaneDucasse 5/23/2013 18:23'!
fromString: aString font: aFont
	"Create a new ImageMorph showing the given string in the given font"

	^ self new form: (StringMorph contents: aString font: aFont) imageForm! !

!ImageMorph class methodsFor: 'instance creation' stamp: 'StephaneDucasse 5/23/2013 18:23'!
withForm: aForm

	^ self new form: aForm ; yourself! !

!ImagePreviewMorph commentStamp: 'gvc 5/18/2007 12:51'!
Displays an image scaled to a fixed size along with a label describing the original dimensions.!
!ImagePreviewMorph methodsFor: 'accessing' stamp: 'gvc 10/9/2006 14:25'!
imageMorph: anObject
	"Set the value of imageMorph"

	imageMorph := anObject! !

!ImagePreviewMorph methodsFor: 'initialization' stamp: 'gvc 10/9/2006 14:42'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		changeTableLayout;
		color: Color transparent;
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap;
		cellInset: 16;
		imageMorph: self newImageMorph;
		textMorph: self newTextMorph;
		addMorphBack: self imageMorph;
		addMorphBack: self textMorph! !

!ImagePreviewMorph methodsFor: 'accessing' stamp: 'gvc 10/9/2006 14:25'!
imageMorph
	"Answer the value of imageMorph"

	^ imageMorph! !

!ImagePreviewMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/9/2006 14:42'!
newImageMorph
	"Answer a new image morph."

	^AlphaImageMorph new
		borderStyle: (BorderStyle inset width: 1);
		color: Color white;
		alpha: 1.0! !

!ImagePreviewMorph methodsFor: 'accessing' stamp: 'gvc 10/9/2006 14:25'!
textMorph
	"Answer the value of textMorph"

	^ textMorph! !

!ImagePreviewMorph methodsFor: 'accessing' stamp: 'gvc 10/9/2006 14:25'!
textMorph: anObject
	"Set the value of textMorph"

	textMorph := anObject! !

!ImagePreviewMorph methodsFor: 'as yet unclassified' stamp: 'gvc 7/30/2009 13:59'!
defaultImageFormOfSize: aPoint
	"Answer a default preview image form."

	^(defaultImageForm isNil or: [defaultImageForm extent ~= aPoint])
		ifTrue: [defaultImageForm := Form extent: aPoint]
		ifFalse: [defaultImageForm]! !

!ImagePreviewMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/9/2006 14:33'!
cornerStyle: aSymbol
	"Pass on to selector and content too."

	super cornerStyle: aSymbol.
	self imageMorph cornerStyle: aSymbol! !

!ImagePreviewMorph methodsFor: 'as yet unclassified' stamp: 'gvc 5/1/2007 12:38'!
image: form size: imageSize
	"Set the image and update the description."
	
	form
		ifNil: [self imageMorph
				image: (self defaultImageFormOfSize: imageSize).
			self textMorph
				contents: '']
	ifNotNil: [self imageMorph
				image: form
				size: imageSize.
			self textMorph
				contents: ('{1} x {2} pixels' translated
							format: {form width asString. form height asString})]
	! !

!ImagePreviewMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/9/2006 14:34'!
newTextMorph
	"Answer a new text morph."

	^StringMorph contents: ''! !

!ImageReadWriter commentStamp: '<historical>'!
Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved.

I am an abstract class to provide for encoding and/or decoding an image on a stream.

Instance Variables:
	stream		<ReadStream | WriteStream>	stream for image storages

Class Variables:
	ImageNotStoredSignal		<Signal>	image not stored error signal
	MagicNumberErrorSignal		<Signal>	magic number error signal

Subclasses must implement the following messages:
	accessing
		nextImage
		nextPutImage:
	testing
		canUnderstand         (added tao 10/26/97)!
!ImageReadWriter methodsFor: 'stream access' stamp: ''!
skip: anInteger

	^stream skip: anInteger! !

!ImageReadWriter methodsFor: 'stream access' stamp: 'sd 1/30/2004 15:18'!
close
	
	stream close! !

!ImageReadWriter methodsFor: 'private' stamp: 'lr 7/4/2009 10:42'!
changePadOfBits: bits width: width height: height depth: depth from: oldPad to: newPad 
	"Change padding size of bits."
	| srcRowByteSize dstRowByteSize newBits srcRowBase rowEndOffset |
	(#(8 16 32 ) includes: oldPad) ifFalse: [ ^ self error: 'Invalid pad: ' , oldPad printString ].
	(#(8 16 32 ) includes: newPad) ifFalse: [ ^ self error: 'Invalid pad: ' , newPad printString ].
	srcRowByteSize := (width * depth + oldPad - 1) // oldPad * (oldPad / 8).
	srcRowByteSize * height = bits size ifFalse: [ ^ self error: 'Incorrect bitmap array size.' ].
	dstRowByteSize := (width * depth + newPad - 1) // newPad * (newPad / 8).
	newBits := ByteArray new: dstRowByteSize * height.
	srcRowBase := 1.
	rowEndOffset := dstRowByteSize - 1.
	1 
		to: newBits size
		by: dstRowByteSize
		do: 
			[ :dstRowBase | 
			newBits 
				replaceFrom: dstRowBase
				to: dstRowBase + rowEndOffset
				with: bits
				startingAt: srcRowBase.
			srcRowBase := srcRowBase + srcRowByteSize ].
	^ newBits! !

!ImageReadWriter methodsFor: 'stream access' stamp: ''!
next

	^stream next! !

!ImageReadWriter methodsFor: 'stream access' stamp: ''!
position: anInteger

	^stream position: anInteger! !

!ImageReadWriter methodsFor: 'stream access' stamp: 'tao 10/23/97 18:00'!
peekFor: aValue

	^stream peekFor: aValue! !

!ImageReadWriter methodsFor: 'accessing' stamp: ''!
nextImage
	"Dencoding an image on stream and answer the image."

	^self subclassResponsibility! !

!ImageReadWriter methodsFor: 'stream access' stamp: ''!
nextPutAll: aByteArray

	^stream nextPutAll: aByteArray! !

!ImageReadWriter methodsFor: 'private' stamp: 'lr 7/4/2009 10:42'!
on: aStream 
	(stream := aStream) reset.
	stream binary
	"Note that 'reset' makes a file be text.  Must do this after."! !

!ImageReadWriter methodsFor: 'stream access' stamp: ''!
cr

	^stream nextPut: Character cr asInteger! !

!ImageReadWriter methodsFor: 'stream access' stamp: ''!
tab

	^stream nextPut: Character tab asInteger! !

!ImageReadWriter methodsFor: 'stream access' stamp: ''!
lf
	"PPM and PBM are used LF as CR."

	^stream nextPut: Character lf asInteger! !

!ImageReadWriter methodsFor: 'accessing' stamp: ''!
nextPutImage: anImage
	"Encoding anImage on stream."

	^self subclassResponsibility! !

!ImageReadWriter methodsFor: 'stream access' stamp: ''!
atEnd

	^stream atEnd! !

!ImageReadWriter methodsFor: 'stream access' stamp: ''!
nextPut: aByte

	^stream nextPut: aByte! !

!ImageReadWriter methodsFor: 'stream access' stamp: ''!
size

	^stream size! !

!ImageReadWriter methodsFor: 'stream access' stamp: ''!
next: size

	^stream next: size! !

!ImageReadWriter methodsFor: 'stream access' stamp: ''!
space

	^stream nextPut: Character space asInteger! !

!ImageReadWriter methodsFor: 'stream access' stamp: ''!
nextLongPut: a32BitW
	"Write out a 32-bit integer as 32 bits."

	stream nextPut: ((a32BitW bitShift: -24) bitAnd: 16rFF).
	stream nextPut: ((a32BitW bitShift: -16) bitAnd: 16rFF).
	stream nextPut: ((a32BitW bitShift: -8) bitAnd: 16rFF).
	stream nextPut: (a32BitW bitAnd: 16rFF).
	^a32BitW! !

!ImageReadWriter methodsFor: 'stream access' stamp: ''!
nextWord
	"Read a 16-bit quantity from the input stream."

	^(stream next bitShift: 8) + stream next! !

!ImageReadWriter methodsFor: 'private' stamp: 'lr 7/4/2009 10:42'!
unpackBits: bits depthTo8From: depth with: width height: height pad: pad 
	"Unpack bits of depth 1, 2, or 4 image to it of depth 8 image."
	| bitMask pixelInByte bitsWidth upBitsWidth stopWidth trailingSize upBits bitIndex upBitIndex val |
	(#(1 2 4 ) includes: depth) ifFalse: [ ^ self error: 'depth must be 1, 2, or 4' ].
	(#(8 16 32 ) includes: pad) ifFalse: [ ^ self error: 'pad must be 8, 16, or 32' ].
	bitMask := (1 bitShift: depth) - 1.
	pixelInByte := 8 / depth.
	bitsWidth := (width * depth + pad - 1) // pad * (pad / 8).
	upBitsWidth := (width * 8 + pad - 1) // pad * (pad / 8).
	stopWidth := (width * depth + 7) // 8.
	trailingSize := width - ((stopWidth - 1) * pixelInByte).
	upBits := ByteArray new: upBitsWidth * height.
	1 
		to: height
		do: 
			[ :i | 
			bitIndex := (i - 1) * bitsWidth.
			upBitIndex := (i - 1) * upBitsWidth.
			1 
				to: stopWidth - 1
				do: 
					[ :j | 
					val := bits at: (bitIndex := bitIndex + 1).
					upBitIndex := upBitIndex + pixelInByte.
					1 
						to: pixelInByte
						do: 
							[ :k | 
							upBits 
								at: upBitIndex - k + 1
								put: (val bitAnd: bitMask).
							val := val bitShift: depth negated ] ].
			val := (bits at: (bitIndex := bitIndex + 1)) bitShift: depth negated * (pixelInByte - trailingSize).
			upBitIndex := upBitIndex + trailingSize.
			1 
				to: trailingSize
				do: 
					[ :k | 
					upBits 
						at: upBitIndex - k + 1
						put: (val bitAnd: bitMask).
					val := val bitShift: depth negated ] ].
	^ upBits! !

!ImageReadWriter methodsFor: 'stream access' stamp: ''!
position

	^stream position! !

!ImageReadWriter methodsFor: 'private' stamp: 'lr 7/4/2009 10:42'!
hasMagicNumber: aByteArray 
	| position |
	position := stream position.
	(stream size - position >= aByteArray size and: [ (stream next: aByteArray size) = aByteArray ]) ifTrue: [ ^ true ].
	stream position: position.
	^ false! !

!ImageReadWriter methodsFor: 'stream access' stamp: ''!
nextLong
	"Read a 32-bit quantity from the input stream."

	^(stream next bitShift: 24) + (stream next bitShift: 16) +
		(stream next bitShift: 8) + stream next! !

!ImageReadWriter methodsFor: 'stream access' stamp: ''!
contents

	^stream contents! !

!ImageReadWriter methodsFor: 'testing' stamp: 'tao 10/27/97 09:26'!
understandsImageFormat
	"Test to see if the image stream format is understood by this decoder.
	This should be implemented in each subclass of ImageReadWriter so that
	a proper decoder can be selected without ImageReadWriter having to know
	about all possible image file types."

	^ false! !

!ImageReadWriter methodsFor: 'stream access' stamp: ''!
nextWordPut: a16BitW
	"Write out a 16-bit integer as 16 bits."

	stream nextPut: ((a16BitW bitShift: -8) bitAnd: 16rFF).
	stream nextPut: (a16BitW bitAnd: 16rFF).
	^a16BitW! !

!ImageReadWriter class methodsFor: 'image reading/writing' stamp: 'lr 7/4/2009 10:42'!
allTypicalFileExtensions
	"Answer a collection of file extensions (lowercase) which files that my subclasses can read might commonly have"
	"ImageReadWriter allTypicalFileExtensions"
	| extensions |
	extensions := Set new.
	self allSubclassesDo: [ :cls | extensions addAll: cls typicalFileExtensions ].
	^ extensions! !

!ImageReadWriter class methodsFor: 'image reading/writing' stamp: 'lr 7/4/2009 10:42'!
putForm: aForm onFileNamed: fileName 
	"Store the given form on a file of the given name."
	| writer |
	writer := self on: (FileStream newFileNamed: fileName) binary.
	Cursor write showWhile: [ writer nextPutImage: aForm ].
	writer close! !

!ImageReadWriter class methodsFor: 'image reading/writing' stamp: 'lr 7/4/2009 10:42'!
formFromStream: aBinaryStream 
	"Answer a ColorForm stored on the given stream.  closes the stream"
	| reader readerClass form |
	readerClass := self withAllSubclasses 
		detect: [ :subclass | subclass understandsImageFormat: aBinaryStream ]
		ifNone: 
			[ aBinaryStream close.
			^ self error: 'image format not recognized' ].
	reader := readerClass new on: aBinaryStream reset.
	Cursor read showWhile: 
		[ form := reader nextImage.
		reader close ].
	^ form! !

!ImageReadWriter class methodsFor: 'image reading/writing' stamp: 'lr 7/4/2009 10:42'!
putForm: aForm onStream: aWriteStream 
	"Store the given form on a file of the given name."
	| writer |
	writer := self on: aWriteStream.
	Cursor write showWhile: [ writer nextPutImage: aForm ].
	writer close! !

!ImageReadWriter class methodsFor: 'image reading/writing' stamp: 'lr 7/4/2009 10:42'!
formFromFileNamed: fileName 
	"Answer a ColorForm stored on the file with the given name."
	| stream |
	stream := FileStream readOnlyFileNamed: fileName.
	^ self formFromStream: stream! !

!ImageReadWriter class methodsFor: 'image reading/writing' stamp: 'ar 3/1/2006 22:59'!
understandsImageFormat: aStream 
	^[(self new on: aStream) understandsImageFormat] on: Error do:[:ex| ex return: false]! !

!ImageReadWriter class methodsFor: 'instance creation' stamp: ''!
on: aStream
	"Answer an instance of the receiver for encoding and/or decoding images on the given."

	^ self new on: aStream
! !

!ImageReadWriter class methodsFor: 'image reading/writing' stamp: 'nk 7/16/2003 17:55'!
typicalFileExtensions
	"Answer a collection of file extensions (lowercase) which files that I can read might commonly have"
	^#()! !

!InMidstOfFileinNotification commentStamp: '<historical>'!
I am a Hack.  I am a notification used to know if the the current process is in the middle of a FileIn.  But I am used everywhere.  Probably I should be removed, but not now.!
!InMidstOfFileinNotification methodsFor: 'exceptiondescription' stamp: 'RAA 5/28/2001 17:07'!
defaultAction

	self resume: false! !

!IncompatibleLayoutConflict commentStamp: '<historical>'!
I am an error raised when extending a class with an incompatible layout.!
!IncompatibleLayoutConflict methodsFor: 'accessing' stamp: 'ToonVerwaest 3/21/2011 01:28'!
layout: anObject
	layout := anObject! !

!IncompatibleLayoutConflict methodsFor: 'accessing' stamp: 'ToonVerwaest 3/21/2011 01:30'!
messageText
	^ 'Class with ', layout class name, ' cannot be extended as ', subType! !

!IncompatibleLayoutConflict methodsFor: 'accessing' stamp: 'ToonVerwaest 3/21/2011 01:28'!
subType: anObject
	subType := anObject! !

!IncompatibleLayoutConflict methodsFor: 'accessing' stamp: 'ToonVerwaest 3/21/2011 01:28'!
layout
	^ layout! !

!IncompatibleLayoutConflict methodsFor: 'accessing' stamp: 'ToonVerwaest 3/21/2011 01:28'!
subType
	^ subType! !

!IncrementalSliderMorph methodsFor: 'accessing' stamp: 'gvc 9/2/2009 13:57'!
getValueSelector
	"Answer the value of getValueSelector"

	^ getValueSelector! !

!IncrementalSliderMorph methodsFor: 'accessing' stamp: 'gvc 9/2/2009 14:18'!
sliderMorph: anObject
	"Set the value of sliderMorph"

	sliderMorph := anObject! !

!IncrementalSliderMorph methodsFor: 'API' stamp: 'gvc 9/2/2009 14:56'!
decrement
	"Decrement the value."

	self value: self value - self quantum! !

!IncrementalSliderMorph methodsFor: 'accessing' stamp: 'GaryChambers 12/7/2011 14:12'!
minExtent
	"Must answer a fixed small size here to
	allow auto orientation to work."
	
	|superMin|
	superMin := super minExtent.
	^(24 max: superMin x) @ (24 max: superMin y)! !

!IncrementalSliderMorph methodsFor: 'accessing' stamp: 'MarcusDenker 12/11/2009 09:34'!
enabled
	"Answer whether the receiver is enabled for user input."

	^self sliderMorph
		ifNil: [super enabled]
		ifNotNil: [:sm | sm enabled]! !

!IncrementalSliderMorph methodsFor: 'accessing' stamp: 'gvc 9/2/2009 14:31'!
max
	"Answer the max value."

	^(self sliderMorph ifNil: [^0]) max! !

!IncrementalSliderMorph methodsFor: 'testing' stamp: 'gvc 9/2/2009 14:35'!
notAtMax
	"Answer whether the value is not at the maximum,"

	^self value < self max! !

!IncrementalSliderMorph methodsFor: 'updating' stamp: 'gvc 9/2/2009 15:19'!
updateOrientation: aPoint
	"Set the layout for the new extent."

	|butts|
	butts := self buttons.
	aPoint x >= aPoint y
		ifTrue: [self listDirection: #leftToRight.
				butts first
					roundedCorners: #(1 2);
					hResizing: #rigid;
					vResizing: #spaceFill;
					width: aPoint y;
					label: (self newButtonLabel: #left ofSize: aPoint y // 2).
				butts last
					roundedCorners: #(3 4);
					hResizing: #rigid;
					vResizing: #spaceFill;
					width: aPoint y;
					label: (self newButtonLabel: #right ofSize: aPoint y // 2)]
		ifFalse: [self listDirection: #topToBottom.
				butts first
					roundedCorners: #(1 4);
					hResizing: #spaceFill;
					vResizing: #rigid;
					height: aPoint x;
					label: (self newButtonLabel: #top ofSize: aPoint x // 2).
				butts last
					roundedCorners: #(2 3);
					hResizing: #spaceFill;
					vResizing: #rigid;
					height: aPoint x;
					label: (self newButtonLabel: #bottom ofSize: aPoint x // 2)]! !

!IncrementalSliderMorph methodsFor: 'building' stamp: 'FernandoOlivero 4/12/2011 09:47'!
newDecrementButton
	"Answer a new decrement button."

	^(self theme builder
		newButtonFor: self
		action: #decrement
		getEnabled: #minEnabled
		label: (self newButtonLabel: #left ofSize: 24)
		help: nil)
		vResizing: #spaceFill;
		width: 64;
		roundedCorners: #(1 2);
		setProperty: #wantsKeyboardFocusNavigation toValue: false;
		on: #mouseStillDown send: #decrement to: self! !

!IncrementalSliderMorph methodsFor: 'accessing' stamp: 'gvc 9/2/2009 13:57'!
setValueSelector: anObject
	"Set the value of setValueSelector"

	setValueSelector := anObject! !

!IncrementalSliderMorph methodsFor: 'initialization' stamp: 'gvc 9/3/2009 13:54'!
defaultSliderFillStyle
	"Answer the hue gradient."

	^(GradientFillStyle colors: {Color white. Color black})
		origin: self topLeft;
		direction: (self bounds isWide
					ifTrue: [self width@0]
					ifFalse: [0@self height])! !

!IncrementalSliderMorph methodsFor: 'accessing' stamp: 'gvc 9/2/2009 14:56'!
increment
	"Increment the value."

	self value: self value + self quantum! !

!IncrementalSliderMorph methodsFor: 'accessing' stamp: 'gvc 9/2/2009 13:57'!
getValueSelector: anObject
	"Set the value of getValueSelector"

	getValueSelector := anObject! !

!IncrementalSliderMorph methodsFor: 'accessing' stamp: 'gvc 9/8/2009 13:17'!
value: aNumber
	"Set the slider value."

	(self sliderMorph ifNil: [^self]) scaledValue: aNumber.
	self model ifNotNil: [
		self setValueSelector ifNotNil: [
			self model perform: self setValueSelector with: self sliderMorph scaledValue]].
	self changed: #minEnabled; changed: #maxEnabled! !

!IncrementalSliderMorph methodsFor: 'accessing' stamp: 'gvc 9/4/2009 16:15'!
value
	"Answer the slider value."

	^self getValueSelector
		ifNil: [(self sliderMorph ifNil: [^0]) scaledValue]
		ifNotNil: [self model
					ifNil: [(self sliderMorph ifNil: [^0]) scaledValue]
					ifNotNil: [self model perform: self getValueSelector]]! !

!IncrementalSliderMorph methodsFor: 'initialization' stamp: 'gvc 9/2/2009 14:22'!
initialize
	"Initialize the receiver."

	super initialize.
	self sliderMorph: self newSliderMorph.
	self
		changeTableLayout;
		listDirection: #leftToRight;
		cellInset: 0;
		borderWidth: 0;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		borderColor: Color transparent;
		addMorphBack: self newDecrementButton;
		addMorphBack: self sliderMorph;
		addMorphBack: self newIncrementButton! !

!IncrementalSliderMorph methodsFor: 'accessing' stamp: 'gvc 9/2/2009 13:57'!
setValueSelector
	"Answer the value of setValueSelector"

	^ setValueSelector! !

!IncrementalSliderMorph methodsFor: 'accessing' stamp: 'gvc 9/2/2009 14:31'!
quantum
	"Answer the quantum value."

	^(self sliderMorph ifNil: [^0]) quantum! !

!IncrementalSliderMorph methodsFor: 'testing' stamp: 'gvc 9/8/2009 13:13'!
maxEnabled
	"Answer whether the maximum button should be enabled."

	^self enabled and: [self notAtMax]! !

!IncrementalSliderMorph methodsFor: 'building' stamp: 'FernandoOlivero 4/12/2011 09:47'!
newIncrementButton
	"Answer a new increment button."

	^(self theme builder
		newButtonFor: self
		action: #increment
		getEnabled: #maxEnabled
		label: (self newButtonLabel: #right ofSize: 24)
		help: nil)
		vResizing: #spaceFill;
		width: 64;
		roundedCorners: #(3 4);
		setProperty: #wantsKeyboardFocusNavigation toValue: false;
		on: #mouseStillDown send: #increment to: self! !

!IncrementalSliderMorph methodsFor: 'testing' stamp: 'gvc 9/8/2009 13:13'!
minEnabled
	"Answer whether the minimum button should be enabled."

	^self enabled and: [self notAtMin]! !

!IncrementalSliderMorph methodsFor: 'building' stamp: 'StephaneDucasse 5/23/2013 18:38'!
newButtonLabel: direction ofSize: size
	"Answer a new label for an inc/dec button."

	^AlphaImageMorph new
		image: (ScrollBar
				arrowOfDirection: direction
				size: size
				color: self paneColor darker)! !

!IncrementalSliderMorph methodsFor: 'accessing' stamp: 'gvc 9/2/2009 14:55'!
quantum: aNumber
	"Set the quantum value."

	(self sliderMorph ifNil: [^self]) quantum: aNumber! !

!IncrementalSliderMorph methodsFor: 'accessing' stamp: 'MarcusDenker 12/11/2009 07:39'!
enabled: aBoolean
	"Set whether the receiver is enabled for user input."

	self sliderMorph ifNotNil: [:sm | sm enabled: aBoolean].
	self
		changed: #enabled;
		changed: #minEnabled;
		changed: #maxEnabled! !

!IncrementalSliderMorph methodsFor: 'accessing' stamp: 'gvc 9/2/2009 14:45'!
buttons
	"Answer the buttons."

	^{self firstSubmorph. self lastSubmorph}! !

!IncrementalSliderMorph methodsFor: 'updating' stamp: 'gvc 9/8/2009 13:24'!
update: aSymbol
	"Update the value."
	
	super update: aSymbol.
	aSymbol = self getValueSelector
		ifTrue: [^self updateValue].
	aSymbol = self getEnabledSelector
		ifTrue: [^self updateEnabled]! !

!IncrementalSliderMorph methodsFor: 'geometry' stamp: 'gvc 9/2/2009 15:17'!
extent: aPoint
	"Set the button width to match the height."

	self extent = aPoint ifTrue: [^self].
	super extent: aPoint.
	self updateOrientation: aPoint! !

!IncrementalSliderMorph methodsFor: 'testing' stamp: 'gvc 9/2/2009 14:35'!
notAtMin
	"Answer whether the value is not at the minimum,"

	^self value > self min! !

!IncrementalSliderMorph methodsFor: 'updating' stamp: 'gvc 9/8/2009 13:26'!
updateEnabled
	"Update the enablement state."

	self model ifNotNil: [
		self getEnabledSelector ifNotNil: [
			self enabled: (self model perform: self getEnabledSelector)]]! !

!IncrementalSliderMorph methodsFor: 'accessing' stamp: 'gvc 9/2/2009 14:55'!
min: aNumber
	"Set the min value."

	(self sliderMorph ifNil: [^self]) min: aNumber! !

!IncrementalSliderMorph methodsFor: 'accessing' stamp: 'gvc 9/2/2009 14:31'!
min
	"Answer the min value."

	^(self sliderMorph ifNil: [^0]) min! !

!IncrementalSliderMorph methodsFor: 'accessing' stamp: 'gvc 9/2/2009 14:55'!
max: aNumber
	"Set the max value."

	(self sliderMorph ifNil: [^self]) max: aNumber! !

!IncrementalSliderMorph methodsFor: 'accessing' stamp: 'gvc 9/10/2009 13:37'!
getEnabledSelector
	"Answer the value of getEnabledSelector"

	^ getEnabledSelector! !

!IncrementalSliderMorph methodsFor: 'initialization' stamp: 'gvc 9/2/2009 14:02'!
on: anObject getValue: getSel setValue: setSel
	"Use the given selectors as the interface."

	self
		model: anObject;
		getValueSelector: getSel;
		setValueSelector: setSel;
		updateValue! !

!IncrementalSliderMorph methodsFor: 'protocol' stamp: 'MarcusDenker 12/11/2009 07:39'!
updateValue
	"Update the value."
	
	self model ifNotNil: [
		self getValueSelector ifNotNil: [
			self sliderMorph ifNotNil: [:sm |
				sm scaledValue: self value.
			self changed: #minEnabled; changed: #maxEnabled]]]! !

!IncrementalSliderMorph methodsFor: 'building' stamp: 'FernandoOlivero 4/12/2011 09:47'!
newSliderMorph
	"Answer a new morph for the slider."

	|slider|
	slider := self theme builder
		newBracketSliderFor: self
		getValue: #value
		setValue: #value:
		min: 0
		max: 100
		quantum: 1
		getEnabled: #enabled
		help: nil.
	slider fillStyle: self defaultSliderFillStyle.
	^slider! !

!IncrementalSliderMorph methodsFor: 'accessing' stamp: 'gvc 9/2/2009 14:18'!
sliderMorph
	"Answer the value of sliderMorph"

	^ sliderMorph! !

!IncrementalSliderMorph methodsFor: 'accessing' stamp: 'gvc 9/10/2009 13:37'!
getEnabledSelector: aSymbol
	"Set the value of getEnabledSelector"

	getEnabledSelector := aSymbol.
	self updateEnabled! !

!IncrementalSliderMorph class methodsFor: 'as yet unclassified' stamp: 'gvc 9/2/2009 14:02'!
on: anObject getValue: getSel setValue: setSel
	"Answer a new instance of the receiver with
	the given selectors as the interface."

	^self new
		on: anObject
		getValue: getSel
		setValue: setSel! !

!IncrementalSliderMorph class methodsFor: 'as yet unclassified' stamp: 'gvc 9/2/2009 14:01'!
on: anObject getValue: getSel setValue: setSel min: min max: max quantum: quantum
	"Answer a new instance of the receiver with
	the given selectors as the interface."

	^self new
		min: min;
		max: max;
		quantum: quantum;
		on: anObject
		getValue: getSel
		setValue: setSel! !

!IndentingListItemMorph commentStamp: 'AlainPlantec 1/7/2010 22:16'!
An IndentingListItemMorph is a StringMorph that draws itself with an optional toggle at its left, as part of the display of the SimpleHierarchicalListMorph.

It will also display lines around the toggle depending on UITheme settings

Instance variables:

indentLevel <SmallInteger> 	the indent level, from 0 at the root and increasing by 1 at each level of the hierarchy.

isExpanded <Boolean>		true if this item is expanded (showing its children)

complexContents <ListItemWrapper>	an adapter wrapping my represented item that can answer its children, etc.
	
firstChild <IndentingListItemMorph|nil>	my first child, or nil if none
	
container <SimpleHierarchicalListMorph>	my container
	
nextSibling <IndentingListItemMorph|nil>	the next item in the linked list of siblings, or nil if none.

Contributed by Bob Arning as part of the ObjectExplorer package.
Don't blame him if it's not perfect.  We wanted to get it out for people to play with.!
!IndentingListItemMorph methodsFor: 'private' stamp: 'RAA 7/11/1998 14:25'!
withSiblingsDo: aBlock

	| node |
	node := self.
	[node isNil] whileFalse: [
		aBlock value: node.
		node := node nextSibling
	].! !

!IndentingListItemMorph methodsFor: 'accessing' stamp: 'dgd 9/25/2004 22:25'!
hasIcon
	"Answer whether the receiver has an icon."
	^ icon notNil! !

!IndentingListItemMorph methodsFor: 'accessing' stamp: 'panda 4/28/2000 15:30'!
children
	| children |
	children := OrderedCollection new.
	self childrenDo: [:each | children add: each].
	^children! !

!IndentingListItemMorph methodsFor: 'converting' stamp: 'RAA 3/31/1999 12:13'!
withoutListWrapper

	^complexContents withoutListWrapper! !

!IndentingListItemMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 7/30/2009 13:56'!
outerBounds
	"Return the 'outer' bounds of the receiver, e.g., the bounds that need to be invalidated when the receiver changes."
	
	|box|
	box := super outerBounds.
	container ifNil: [^box].
	^box left: (box left min: self selectionFrame left)! !

!IndentingListItemMorph methodsFor: '*Polymorph-Widgets' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
theme
	"Answer the ui theme that provides controls.
	Done directly here to avoid performance hit of
	looking up in window."

	^ Smalltalk ui theme ! !

!IndentingListItemMorph methodsFor: 'drawing' stamp: 'nk 3/8/2004 11:43'!
drawLinesOn: aCanvas lineColor: lineColor 
	| hasToggle |
	hasToggle := self hasToggle.
	"Draw line from toggle to text"
	self drawLineToggleToTextOn: aCanvas lineColor: lineColor hasToggle: hasToggle.

	"Draw the line from my toggle to the nextSibling's toggle"
	self nextSibling ifNotNil: [ self drawLinesToNextSiblingOn: aCanvas lineColor: lineColor hasToggle: hasToggle ].

	"If I have children and am expanded, draw a line to my first child"
	(self firstChild notNil and: [ self isExpanded ])
		ifTrue: [ self drawLinesToFirstChildOn: aCanvas lineColor: lineColor]! !

!IndentingListItemMorph methodsFor: 'private' stamp: 'CarloTeixeira 7/2/2010 23:44'!
findExactPathMatchIn: anArray 
	self
		withSiblingsDo: [:each | (each complexContents asString = anArray first
					or: [anArray first isNil])
				ifTrue: [^ each]].
	^ nil! !

!IndentingListItemMorph methodsFor: 'initialization' stamp: 'dgd 2/14/2003 20:42'!
initialize
"initialize the state of the receiver"
	super initialize.
""
	indentLevel := 0.
	isExpanded := false! !

!IndentingListItemMorph methodsFor: 'accessing' stamp: 'RAA 7/30/2000 19:15'!
indentLevel

	^indentLevel! !

!IndentingListItemMorph methodsFor: 'enumeration' stamp: 'panda 4/28/2000 15:29'!
childrenDo: aBlock

	firstChild ifNotNil: [
		firstChild withSiblingsDo: [ :aNode | aBlock value: aNode].
	]! !

!IndentingListItemMorph methodsFor: 'drawing' stamp: 'MarcusDenker 1/23/2011 09:19'!
drawLinesToFirstChildOn: aCanvas lineColor: lineColor
	"Draw line from me to first child.
	Don't bother if the first child has a toggle.."

	| vLineX vLineTop vLineBottom childBounds childCenter myTheme |
	self firstChild hasToggle
		ifTrue: [ ^ self ].
	childBounds := self firstChild toggleBounds.
	childCenter := childBounds center.
	vLineX := childCenter x.
	vLineTop := bounds bottom.
	vLineBottom := self firstChild hasToggle
		ifTrue: [ childCenter y - (childBounds height // 2) + 1 ]
		ifFalse: [ childCenter y - 2 ].
	myTheme := self theme.
	aCanvas
		frameRectangle: (vLineX @ vLineTop corner: (vLineX + 1) @ vLineBottom)
		width: myTheme treeLineWidth
		colors: (myTheme treeLineColorsFrom: lineColor)
		dashes: myTheme treeLineDashes! !

!IndentingListItemMorph methodsFor: 'accessing' stamp: 'bf 2/9/2004 10:55'!
userString
	"Add leading tabs to my userString"
	^ (String new: indentLevel withAll: Character tab), super userString
! !

!IndentingListItemMorph methodsFor: 'search' stamp: 'BenjaminVanRyseghem 5/31/2011 15:36'!
searchingString
	" string used to detect research "

	^ self contents asString! !

!IndentingListItemMorph methodsFor: 'private-container protocol' stamp: 'MarcusDenker 1/23/2011 09:19'!
toggleExpandedState

	isExpanded := isExpanded not.
	self refreshExpandedState.! !

!IndentingListItemMorph methodsFor: 'private' stamp: 'CarloTeixeira 7/2/2010 23:46'!
findSimilarPathMatchIn: anArray 
	self
		withSiblingsDo: [:each | (each complexContents asString sameAs: anArray first)
				ifTrue: [^ each]].
	^ nil! !

!IndentingListItemMorph methodsFor: 'accessing' stamp: 'RAA 7/31/1998 00:30'!
isExpanded

	^isExpanded! !

!IndentingListItemMorph methodsFor: 'drawing' stamp: 'AlainPlantec 2/11/2011 15:05'!
drawToggleOn: aCanvas in: aRectangle

	| aForm centeringOffset |
	complexContents hasContents ifFalse: [^self].
	aForm := isExpanded 
		ifTrue: [container expandedFormForMorph: self]
		ifFalse: [container notExpandedFormForMorph: self].
	centeringOffset := ((aRectangle height - aForm extent y) / 2.0) truncated.
	^aCanvas 
		translucentImage: aForm 
		at: (aRectangle topLeft translateBy: 0 @ centeringOffset).
! !

!IndentingListItemMorph methodsFor: 'private-container protocol' stamp: 'RAA 6/21/1999 14:54'!
recursiveAddTo: aCollection

	firstChild ifNotNil: [
		firstChild withSiblingsDo: [ :aNode | aNode recursiveAddTo: aCollection].
	].
	aCollection add: self
	! !

!IndentingListItemMorph methodsFor: 'drawing' stamp: 'EstebanLorenzano 5/1/2014 10:49'!
drawOn: aCanvas 
	| tRect sRect columnScanner colorToUse columnLeft |
	tRect := self toggleRectangle.
	sRect := bounds withLeft: tRect right + 4.

	self 
		drawToggleOn: aCanvas
		in: tRect.
	colorToUse := complexContents preferredColor ifNil: [ self theme textColor ].
	icon isNil ifFalse: 
		[ aCanvas 
			translucentImage: icon
			at: sRect left @ (self top + ((self height - icon height) // 2)).
		sRect := sRect left: sRect left + icon width + 2 ].
	(container columns isNil or: [ (contents asString indexOf: Character tab) = 0 ]) 
		ifTrue: 
			[ sRect := sRect top: (sRect top + sRect bottom - self fontToUse height) // 2.
			contents
				treeRenderOn: aCanvas 
				bounds: sRect 
				color: colorToUse 
				font: self fontToUse 
				from: self ]
		ifFalse: 
			[ columnLeft := sRect left.
			columnScanner := contents asString readStream.
			container columns do: 
				[ :width | | columnData columnRect | 
				columnRect := columnLeft @ sRect top extent: width @ sRect height.
				columnData := columnScanner upTo: Character tab.
				columnData isEmpty ifFalse: 
					[ aCanvas 
						drawString: columnData
						in: columnRect
						font: self fontToUse
						color: colorToUse ].
				columnLeft := columnRect right + 5 ] ]! !

!IndentingListItemMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/17/2015 12:37'!
drawOnAthensCanvas: anAthensCanvas
	self drawOnCanvasWrapperFor: anAthensCanvas! !

!IndentingListItemMorph methodsFor: '*Polymorph-Widgets' stamp: 'ThierryGoubier 9/21/2012 14:32'!
measureContents
	"Round up in case fractional."

	| f iconWidth |
	f := self fontToUse.
	iconWidth := self hasIcon
				ifTrue: [self icon width + 2]
				ifFalse: [0].
	^ ((13 * indentLevel + 15 + iconWidth + (contents widthToDisplayInTree: self) max: self minimumWidth)
		@ ((contents heightToDisplayInTree: self) max: f height) + (self layoutInset * 2)) ceiling! !

!IndentingListItemMorph methodsFor: 'accessing' stamp: 'RAA 3/31/1999 17:44'!
canExpand

	^complexContents hasContents! !

!IndentingListItemMorph methodsFor: 'accessing' stamp: 'RAA 7/21/2000 11:00'!
balloonText

	^complexContents balloonText ifNil: [super balloonText]! !

!IndentingListItemMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 6/10/2012 20:25'!
isFirstItem
	"I have no idea why the owner of the list can get nil but it happens when the packages are published with the Monticello Browser."
	
	^ (owner ~= nil) and: [owner submorphs first == self]! !

!IndentingListItemMorph methodsFor: 'halos and balloon help' stamp: 'IgorStasenko 12/22/2012 02:55'!
boundsForBalloon

	"some morphs have bounds that are way too big"
	container ifNil: [^super boundsForBalloon].
	^self boundsInWorld intersect: container boundsInWorld ifNone: [self boundsInWorld ]! !

!IndentingListItemMorph methodsFor: 'private-container protocol' stamp: 'CarloTeixeira 7/2/2010 23:54'!
openPath: anArray 
	| found |
	anArray isEmpty
		ifTrue: [^ container setSelectedMorph: nil].
	found := self findPathIn: anArray.
	found
		ifNil: [^ container setSelectedMorph: nil].
	found isExpanded
		ifTrue: [found refreshExpandedState]
		ifFalse: [found toggleExpandedState].
	container adjustSubmorphPositions.
	found changed.
	anArray size = 1
		ifTrue: [^ container setSelectedMorph: found].
	^ found firstChild
		ifNil: [container setSelectedMorph: nil]
		ifNotNil: [found firstChild openPath: anArray allButFirst]! !

!IndentingListItemMorph methodsFor: 'accessing' stamp: 'dgd 9/25/2004 22:27'!
icon
	"answer the receiver's icon"
	^ icon! !

!IndentingListItemMorph methodsFor: 'initialization' stamp: 'ThierryGoubier 9/21/2012 14:21'!
initWithContents: anObject prior: priorMorph forList: hostList indentLevel: newLevel

	container := hostList.
	complexContents := anObject.
	indentLevel := newLevel.
	self initWithContents: anObject asString font: StandardFonts listFont emphasis: nil.
	isExpanded := false.
 	nextSibling := firstChild := nil.
	priorMorph ifNotNil: [
		priorMorph nextSibling: self.
	].
	icon := anObject icon.
	self extent: self minWidth @ self minHeight! !

!IndentingListItemMorph methodsFor: 'accessing' stamp: 'RAA 8/1/1998 01:05'!
nextSibling: anotherMorph

	nextSibling := anotherMorph! !

!IndentingListItemMorph methodsFor: 'private-container protocol' stamp: 'CarloTeixeira 7/2/2010 23:11'!
refreshExpandedState

 	| newChildren toDelete c |
	toDelete := OrderedCollection new.
	firstChild ifNotNil: [
		firstChild withSiblingsDo: [ :aNode | aNode recursiveAddTo: toDelete].
	].
	container noteRemovalOfAll: toDelete.
	(isExpanded and: [complexContents hasContents]) ifFalse: [
		^self changed
	].
	(c := complexContents contents) isEmpty ifTrue: [^self changed].
	newChildren := container 
		addSubmorphsAfter: self 
		fromCollection: c 
		allowSorting: true.
	firstChild := newChildren first.
! !

!IndentingListItemMorph methodsFor: 'private-container protocol' stamp: 'RAA 8/3/1999 09:47'!
highlight

	complexContents highlightingColor ifNotNil: [self color: complexContents highlightingColor].
	self changed.
	
! !

!IndentingListItemMorph methodsFor: 'accessing' stamp: 'RAA 7/31/1998 00:48'!
isExpanded: aBoolean

	isExpanded := aBoolean! !

!IndentingListItemMorph methodsFor: 'private' stamp: 'nk 2/19/2004 18:29'!
hasToggle
	^ complexContents hasContents! !

!IndentingListItemMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 5/23/2007 10:47'!
changed
	"Need to invalidate the selection frame."

	container ifNil: [^super changed].
	self invalidRect: self selectionFrame.
	super changed! !

!IndentingListItemMorph methodsFor: 'accessing' stamp: 'RAA 7/11/1998 12:15'!
nextSibling

	^nextSibling! !

!IndentingListItemMorph methodsFor: 'private' stamp: 'nk 12/5/2002 15:16'!
toggleBounds
	^self toggleRectangle! !

!IndentingListItemMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 7/30/2009 13:56'!
lastChild
	"Answer the last child."

	|c|
	c := self firstChild ifNil: [^nil].
	[c nextSibling isNil] whileFalse: [c := c nextSibling].
	^c! !

!IndentingListItemMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/24/2012 22:44'!
minWidth
	"Fixed to work such that guessed width is unnecessary in
	#adjustSubmorphPositions."

	| iconWidth |
	iconWidth := self hasIcon
				ifTrue: [self icon width + 2]
				ifFalse: [0].
	^(13 * indentLevel + 15 + (contents widthToDisplayInTree: self)
		+ iconWidth) max: super minWidth! !

!IndentingListItemMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 9/12/2006 15:34'!
drawMouseDownHighlightOn: aCanvas
	"Draw with a dotted border."
	
	|frame|
	self highlightedForMouseDown ifTrue: [
		container ifNil: [^super drawMouseDownHighlightOn: aCanvas].
		frame := self selectionFrame.
		aCanvas 
			frameRectangle: frame
			width: 1
			colors: {container mouseDownHighlightColor. Color transparent}
			 dashes: #(1 1)]! !

!IndentingListItemMorph methodsFor: 'drawing' stamp: 'gvc 7/30/2009 13:55'!
drawLineToggleToTextOn: aCanvas lineColor: lineColor hasToggle: hasToggle
	"If I am not the only item in my container, draw the line between:
		- my toggle (if any) or my left edge (if no toggle)
		- and my text left edge.
	Only draw now if no toggle."

	| myBounds myCenter hLineY hLineLeft myTheme|
	self isSoleItem ifTrue: [ ^self ].
	self hasToggle ifTrue: [^self].
	myBounds := self toggleBounds.
	myCenter := myBounds center.
	hLineY := myCenter y - 1.
	hLineLeft := myCenter x.
	"Draw line from toggle to text. Use optimised form since vertical."
	myTheme := self theme.
	aCanvas
		frameRectangle: (hLineLeft @ hLineY corner: myBounds right + 3 @ (hLineY + 1))
		width: myTheme treeLineWidth
		colors: (myTheme treeLineColorsFrom: lineColor)
		dashes: myTheme treeLineDashes! !

!IndentingListItemMorph methodsFor: 'mouse events' stamp: 'ar 3/17/2001 17:32'!
inToggleArea: aPoint

	^self toggleRectangle containsPoint: aPoint! !

!IndentingListItemMorph methodsFor: 'drag and drop' stamp: 'nk 6/12/2004 16:49'!
acceptDroppingMorph: toDrop event: evt
	complexContents acceptDroppingObject: toDrop complexContents.
	toDrop delete.
	self highlightForDrop: false.! !

!IndentingListItemMorph methodsFor: 'action' stamp: 'gvc 4/25/2007 19:42'!
toggleRectangle

	| h |
	h := bounds height.
	^(bounds left + (13 * indentLevel)) @ bounds top extent: 9@h! !

!IndentingListItemMorph methodsFor: 'private-container protocol' stamp: 'RAA 7/30/2000 19:49'!
addChildrenForList: hostList addingTo: morphList withExpandedItems: expandedItems

	firstChild ifNotNil: [
		firstChild withSiblingsDo: [ :aNode | aNode delete].
	].
	firstChild := nil.
	complexContents hasContents ifFalse: [^self].
	firstChild := hostList 
		addMorphsTo: morphList
		from: complexContents contents 
		allowSorting: true
		withExpandedItems: expandedItems
		atLevel: indentLevel + 1.
	! !

!IndentingListItemMorph methodsFor: 'private' stamp: 'CarloTeixeira 7/2/2010 23:53'!
findPathIn: anArray 
	| found |
	found := self findExactPathMatchIn: anArray.
	found
		ifNil: ["try again with no case sensitivity"
			found := self findSimilarPathMatchIn: anArray].
	^ found! !

!IndentingListItemMorph methodsFor: 'accessing' stamp: 'nk 3/8/2004 09:15'!
isSoleItem
	^self isFirstItem and: [ owner submorphs size = 1 ]! !

!IndentingListItemMorph methodsFor: 'private-container protocol' stamp: 'RAA 4/2/1999 18:02'!
recursiveDelete

	firstChild ifNotNil: [
		firstChild withSiblingsDo: [ :aNode | aNode recursiveDelete].
	].
	self delete
	! !

!IndentingListItemMorph methodsFor: 'drawing' stamp: 'gvc 7/30/2009 13:55'!
drawLinesToNextSiblingOn: aCanvas lineColor: lineColor hasToggle: hasToggle
	"Draw line from me to next sibling"
	
	| myBounds nextSibBounds vLineX myCenter vLineTop vLineBottom myTheme|
	myBounds := self toggleBounds.
	nextSibBounds := self nextSibling toggleBounds.
	myCenter := myBounds center.
	vLineX := myCenter x.
	vLineTop := myCenter y + 1.
	vLineBottom := nextSibBounds center y - 1.
	"Draw line from me to next sibling"
	myTheme := self theme.
	aCanvas
		frameRectangle: (vLineX @ vLineTop corner: vLineX + 1 @ vLineBottom)
		width: myTheme treeLineWidth
		colors: (myTheme treeLineColorsFrom: lineColor)
		dashes: myTheme treeLineDashes! !

!IndentingListItemMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 9/12/2006 15:34'!
selectionFrame
	"Answer the selection frame rectangle."

	|frame|
	frame := self bounds: self bounds in: container.
	frame := self
		bounds: ((frame left: container innerBounds left) right: container innerBounds right)
		from: container.
	^frame! !

!IndentingListItemMorph methodsFor: 'private-container protocol' stamp: 'RAA 7/11/1998 14:34'!
complexContents

	^complexContents! !

!IndentingListItemMorph methodsFor: 'accessing' stamp: 'RAA 8/2/1999 16:48'!
firstChild

	^firstChild! !

!IndentingListItemMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/24/2012 23:31'!
minHeight
	"Answer the minimum height of the receiver."
	
	| iconHeight |
	iconHeight := self hasIcon
				ifTrue: [self icon height + 2]
				ifFalse: [0].
	^(( self contents heightToDisplayInTree: self) max: iconHeight) max: super minHeight! !

!IndentingListItemMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 11/15/2007 14:26'!
openItemPath: anArray
	"Open a path based on wrapper item equivalence. Generally more specific
	than #openPath: (string based)."
	
	| found |
	anArray isEmpty
		ifTrue: [^ container setSelectedMorph: nil].
	found := nil.
	self
		withSiblingsDo: [:each | found
				ifNil: [(each complexContents withoutListWrapper == anArray first
							or: [anArray first isNil])
						ifTrue: [found := each]]].
	found
		ifNotNil: [found isExpanded
				ifFalse: [found toggleExpandedState.
					container adjustSubmorphPositions].
			found changed.
			anArray size = 1
				ifTrue: [^ container setSelectedMorph: found].
			^ found firstChild
				ifNil: [container setSelectedMorph: nil]
				ifNotNil: [found firstChild openItemPath: anArray allButFirst]].
	^container setSelectedMorph: nil! !

!IndentingListItemMorph methodsFor: 'drawing' stamp: 'EstebanLorenzano 4/29/2014 16:00'!
unhighlight
	complexContents highlightingColor ifNotNil: [ self color: self theme textColor ].
	self changed.
	
	
! !

!IndexedEyeElement commentStamp: '<historical>'!
I am an eye element for indexable fields. (at:)!
!IndexedEyeElement methodsFor: 'action' stamp: 'ClementBera 4/30/2013 15:53'!
save: aValue
	self host at: self index put: aValue! !

!IndexedEyeElement methodsFor: 'accessing' stamp: 'ClementBera 4/30/2013 15:54'!
value
	^ self host at: self index! !

!IndexedEyeElement methodsFor: 'accessing' stamp: 'ClementBera 4/30/2013 15:53'!
accessorCode
	^ '(self at: ', self index asString, ')'! !

!IndexedSlot commentStamp: 'MarcusDenker 1/22/2015 17:41'!
By default each Slot corresponds to an instance variable and vice versa. Hence there is a Slot for each instance variable.

!
!IndexedSlot methodsFor: 'comparing' stamp: 'MarcusDenker 1/22/2015 18:46'!
hash
	^ (self species hash bitXor: self name hash) bitXor: (self index ifNil: [ 0 ])! !

!IndexedSlot methodsFor: 'comparing' stamp: 'MarcusDenker 1/22/2015 17:36'!
= other
	self == other
		ifTrue: [ ^ true ].
	^ ((self species == other species) 
			and: [ index = other index ])
			and: [ name = other name ]! !

!IndexedSlot methodsFor: 'meta-object-protocol' stamp: 'MarcusDenker 1/22/2015 17:36'!
write: aValue to: anObject
	^ anObject instVarAt: index put: aValue.! !

!IndexedSlot methodsFor: 'accessing' stamp: 'MarcusDenker 1/22/2015 17:35'!
index: anIndex
	index := anIndex! !

!IndexedSlot methodsFor: 'meta-object-protocol' stamp: 'MarcusDenker 1/22/2015 17:48'!
isVirtual
	"virtual slots do not take up space in the object and have size = 0"
	^false! !

!IndexedSlot methodsFor: 'meta-object-protocol' stamp: 'MarcusDenker 1/22/2015 17:36'!
read: anObject
	^ anObject instVarAt: index! !

!IndexedSlot methodsFor: 'accessing' stamp: 'MarcusDenker 1/22/2015 17:35'!
index
	^ index! !

!InexactFloatPrintPolicy commentStamp: '<historical>'!
I am InexactFloatPrintPolicy.

Through FloatPrintPolicy and double dispatch I force Float>>#printOn:base: to dynamically use the faster but potentially less accurate way to print Floats using Float>>#absPrintOn:base:!
!InexactFloatPrintPolicy methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 2/8/2013 15:48'!
absPrint: float on: stream base: base
	"Doube dispatch to the faster but potentially less accurate way to print"

	^ float absPrintInexactlyOn: stream base: base ! !

!InfiniteForm commentStamp: '<historical>'!
I represent a Form obtained by replicating a pattern form indefinitely in all directions.!
!InfiniteForm methodsFor: 'fillstyle protocol' stamp: 'ar 7/2/1999 14:54'!
isBitmapFill
	^true! !

!InfiniteForm methodsFor: 'accessing' stamp: 'mjg 7/9/2001 14:12'!
asColor
	^ patternForm dominantColor! !

!InfiniteForm methodsFor: 'fillstyle protocol' stamp: 'ar 7/2/1999 14:56'!
direction
	^patternForm width @ 0! !

!InfiniteForm methodsFor: 'accessing' stamp: ''!
offset 
	"Refer to the comment in DisplayObject|offset."

	^0 @ 0! !

!InfiniteForm methodsFor: 'accessing' stamp: ''!
asForm
	^ patternForm! !

!InfiniteForm methodsFor: 'fillstyle protocol' stamp: 'ar 7/2/1999 14:56'!
origin
	^0@0! !

!InfiniteForm methodsFor: 'fillstyle protocol' stamp: 'ar 9/2/1999 14:32'!
isTranslucent
	"Return true since the bitmap may be translucent and we don't really want to check"
	^true! !

!InfiniteForm methodsFor: 'fillstyle protocol' stamp: 'bolot 9/15/1999 10:13'!
bitPatternForDepth: suspectedDepth
	^ patternForm! !

!InfiniteForm methodsFor: 'fillstyle protocol' stamp: 'ar 7/2/1999 14:57'!
normal
	^0 @ patternForm height! !

!InfiniteForm methodsFor: 'fillstyle protocol' stamp: 'ar 7/2/1999 14:56'!
origin: aPoint
	"Ignored"
! !

!InfiniteForm methodsFor: 'as yet unclassified' stamp: 'RAA 6/1/2000 10:50'!
addFillStyleMenuItems: aMenu hand: aHand from: aMorph
	"Add the items for changing the current fill style of the receiver"

	"prevents a walkback when control menu is built for morph with me as color"! !

!InfiniteForm methodsFor: 'displaying' stamp: 'StephaneDucasse 10/25/2013 16:16'!
displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger fillColor: aForm
	"This is the real display message, but it doesn't get used until the new
	display protocol is installed."
	| targetBox patternBox bb |
	(patternForm isForm) ifFalse:
		[^ aDisplayMedium fill: clipRectangle rule: ruleInteger fillColor: patternForm].

	"Do it iteratively"
	targetBox := aDisplayMedium boundingBox intersect: clipRectangle ifNone: [ ^ self ].
	patternBox := patternForm boundingBox.
	bb := BitBlt destForm: aDisplayMedium sourceForm: patternForm fillColor: aForm
		combinationRule: ruleInteger destOrigin: 0@0 sourceOrigin: 0@0
		extent: patternBox extent clipRect: clipRectangle.
	bb colorMap:
		(patternForm colormapIfNeededFor: aDisplayMedium).
	(targetBox left truncateTo: patternBox width)
		to: targetBox right - 1 by: patternBox width do:
		[:x |
		(targetBox top truncateTo: patternBox height)
			to: targetBox bottom - 1 by: patternBox height do:
			[:y |
			bb destOrigin: x@y; copyBits]]! !

!InfiniteForm methodsFor: 'display box access' stamp: ''!
computeBoundingBox 
	"Refer to the comment in DisplayObject|computeBoundingBox."

	^0 @ 0 corner: SmallInteger maxVal @ SmallInteger maxVal! !

!InfiniteForm methodsFor: 'fillstyle protocol' stamp: 'ar 7/2/1999 14:54'!
isSolidFill
	^false! !

!InfiniteForm methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/6/2015 18:09'!
asAthensPaintOn: canvas
	^ (canvas surface createFormPaint: self asForm)
		repeat;
		origin: self origin;
		direction: self direction;
		yourself! !

!InfiniteForm methodsFor: 'testing' stamp: 'JuanVuletich 10/12/2010 12:44'!
mightBeTranslucent
	"Return true since the bitmap may be translucent and we don't really want to check"
	^true! !

!InfiniteForm methodsFor: 'fillstyle protocol' stamp: 'ar 7/2/1999 14:54'!
form
	"Bitmap fills respond to #form"
	^patternForm! !

!InfiniteForm methodsFor: 'displaying' stamp: 'nk 4/17/2004 19:48'!
displayOnPort: aPort offsetBy: offset

	| targetBox patternBox savedMap top left |

	"this version tries to get the form aligned where the user wants it and not just aligned with the cliprect"

	(patternForm isForm) ifFalse: [
		"patternForm is a Pattern or Color; just use it as a mask for BitBlt"
		^ aPort fill: aPort clipRect fillColor: patternForm rule: Form over].

	"do it iteratively"
	targetBox := aPort clipRect.
	patternBox := patternForm boundingBox.
	savedMap := aPort colorMap.
	aPort sourceForm: patternForm;
		fillColor: nil;
		combinationRule: Form paint;
		sourceRect: (0@0 extent: patternBox extent);
		colorMap: (patternForm colormapIfNeededFor: aPort destForm).
	top := (targetBox top truncateTo: patternBox height) + offset y.
	left :=  (targetBox left truncateTo: patternBox width) + offset x.

	left to: (targetBox right - 1) by: patternBox width do:
		[:x | top to: (targetBox bottom - 1) by: patternBox height do:
			[:y | aPort destOrigin: x@y; copyBits]].
	aPort colorMap: savedMap.
! !

!InfiniteForm methodsFor: 'private' stamp: ''!
form: aForm

	patternForm := aForm! !

!InfiniteForm methodsFor: 'displaying' stamp: 'sw 2/16/98 03:42'!
colorForInsets
	^ Color transparent! !

!InfiniteForm methodsFor: 'accessing' stamp: 'di 9/2/97 20:21'!
dominantColor
	^ patternForm dominantColor! !

!InfiniteForm methodsFor: 'fillstyle protocol' stamp: 'ar 7/2/1999 14:59'!
isOrientedFill
	^true! !

!InfiniteForm methodsFor: 'displaying' stamp: 'ar 8/16/2001 12:47'!
raisedColor
	^ Color transparent! !

!InfiniteForm methodsFor: 'fillstyle protocol' stamp: 'ar 7/2/1999 14:54'!
isGradientFill
	^false! !

!InfiniteForm methodsFor: 'fillstyle protocol' stamp: 'ar 7/2/1999 14:55'!
isTiled
	"Return true if the receiver should be drawn as a tiled pattern"
	^true! !

!InfiniteForm methodsFor: 'displaying' stamp: 'nk 4/17/2004 19:48'!
displayOnPort: aPort at: offset

	| targetBox patternBox savedMap top left |

	self flag: #bob.

	"this *may* not get called at the moment. I have been trying to figure out the right way for this to work and am using #displayOnPort:offsetBy: as my current offering - Bob"

	(patternForm isForm) ifFalse: [
		"patternForm is a Pattern or Color; just use it as a mask for BitBlt"
		^ aPort fill: aPort clipRect fillColor: patternForm rule: Form over].

	"do it iteratively"
	targetBox := aPort clipRect.
	patternBox := patternForm boundingBox.
	savedMap := aPort colorMap.
	aPort sourceForm: patternForm;
		fillColor: nil;
		combinationRule: Form paint;
		sourceRect: (0@0 extent: patternBox extent);
		colorMap: (patternForm colormapIfNeededFor: aPort destForm).
	top := (targetBox top truncateTo: patternBox height) "- (offset y \\ patternBox height)".
	left :=  (targetBox left truncateTo: patternBox width) "- (offset x \\ patternBox width)".
	left to: (targetBox right - 1) by: patternBox width do:
		[:x | top to: (targetBox bottom - 1) by: patternBox height do:
			[:y | aPort destOrigin: x@y; copyBits]].
	aPort colorMap: savedMap.
! !

!InfiniteForm methodsFor: '*Polymorph-Widgets' stamp: 'gvc 3/21/2008 16:37'!
fillRectangle: aRectangle on: aCanvas
	"Fill the given rectangle on the given canvas with the receiver."
	
	aCanvas fillRectangle: aRectangle basicFillStyle: self! !

!InfiniteForm class methodsFor: 'instance creation' stamp: ''!
with: aForm 
	"Answer an instance of me whose pattern form is the argument, aForm."

	^self new form: aForm! !

!InflateStream commentStamp: 'MarcusDenker 2/14/2010 22:29'!
This class implements the Inflate decompression algorithm as defined by RFC1951 and used in PKZip, GZip and ZLib (and many, many more). It is a variant of the LZ77 compression algorithm described in

[LZ77] Ziv J., Lempel A., "A Universal Algorithm for Sequential Data Compression", IEEE Transactions on Information Theory", Vol. 23, No. 3, pp. 337-343.

[RFC1951] Deutsch. P, "DEFLATE Compressed Data Format Specification version 1.3"

For more information see the above mentioned RFC 1951 which can for instance be found at

	http://www.leo.org/pub/comp/doc/standards/rfc/index.html

Huffman Tree Implementation Notes:
===========================================
The huffman tree used for decoding literal, distance and length codes in the inflate algorithm has been encoded in a single Array. The tree is made up of subsequent tables storing all entries at the current bit depth. Each entry in the table (e.g., a 32bit Integer value) is either a leaf or a non-leaf node. Leaf nodes store the immediate value in its low 16 bits whereas non-leaf nodes store the offset of the subtable in its low 16bits. The high 8 bits of non-leaf nodes contain the number of additional bits needed for the sub table (the high 8 bits of leaf-nodes are always zero). The first entry in each table is always a non-leaf node indicating how many bits we need to fetch initially. We can thus travel down the tree as follows (written in sort-of-pseudocode the actual implementation can be seen in InflateStream>>decodeValueFrom:):

	table := initialTable.
	bitsNeeded := high 8 bits of (table at: 1).		"Determine initial bits"
	table := initialTable + (low 16 bits of (table at: 1)). "Determine start of first real table"
	[bits := fetch next bitsNeeded bits.			"Grab the bits"
	value := table at: bits.						"Lookup the value"
	value has high 8 bit set] whileTrue:[		"Check if it's leaf"
		table := initialTable + (low 16 bits of value).	"No - compute new sub table start"
		bitsNeeded := high 8 bit of value].		"Compute additional number of bits needed"
	^value
!
!InflateStream methodsFor: 'bit access' stamp: 'ar 12/5/1998 14:54'!
nextByte
	^source byteAt: (sourcePos := sourcePos + 1)! !

!InflateStream methodsFor: 'inflating' stamp: 'ar 12/3/1998 20:49'!
proceedDynamicBlock
	self decompressBlock: litTable with: distTable! !

!InflateStream methodsFor: 'crc' stamp: 'ar 2/29/2004 04:04'!
crcError: aString
	^CRCError signal: aString! !

!InflateStream methodsFor: 'accessing' stamp: 'ar 12/21/1999 23:52'!
sourcePosition
	^sourcePos! !

!InflateStream methodsFor: 'accessing' stamp: 'ar 12/23/1999 15:31'!
close
	sourceStream ifNotNil:[sourceStream close].! !

!InflateStream methodsFor: 'accessing' stamp: 'tk 2/4/2000 10:26'!
contents

	^ self upToEnd! !

!InflateStream methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 12/16/2011 10:25'!
next: n into: buffer startingAt: startIndex
	"Read n objects into the given collection. 
	Return aCollection or a partial copy if less than
	n elements have been read."
	| c numRead count |
	n = 0 ifTrue: [ ^buffer ].
	numRead := 0.
	["Force decompression if necessary"
	(c := self next) == nil 
		ifTrue:[^buffer copyFrom: 1 to: startIndex+numRead-1].
	"Store the first value which provoked decompression"
	buffer at: startIndex + numRead put: c.
	numRead := numRead + 1.
	"After collection has been filled copy as many objects as possible"
	count := (readLimit - position) min: (n - numRead).
	buffer 
		replaceFrom: startIndex + numRead 
		to: startIndex + numRead + count - 1 
		with: collection 
		startingAt: position+1.
	position := position + count.
	numRead := numRead + count.
	numRead = n] whileFalse.
	^buffer! !

!InflateStream methodsFor: 'accessing' stamp: 'ar 12/22/1999 01:29'!
next
	"Answer the next decompressed object in the Stream represented by the
	receiver."

	<primitive: 65>
	position >= readLimit
		ifTrue: [^self pastEndRead]
		ifFalse: [^collection at: (position := position + 1)]! !

!InflateStream methodsFor: 'accessing' stamp: 'ar 12/21/1999 23:54'!
sourceLimit
	^sourceLimit! !

!InflateStream methodsFor: 'accessing' stamp: 'PeterHugossonMiller 9/3/2009 10:00'!
upToEnd
	"Answer a subcollection from the current access position through the last element of the receiver."

	| newStream buffer |
	buffer := collection species new: 1000.
	newStream := (collection species new: 100) writeStream.
	[self atEnd] whileFalse: [newStream nextPutAll: (self nextInto: buffer)].
	^ newStream contents! !

!InflateStream methodsFor: 'bit access' stamp: 'ar 12/4/1998 02:00'!
nextBits: n
	| bits |
	[bitPos < n] whileTrue:[
		bitBuf := bitBuf + (self nextByte bitShift: bitPos).
		bitPos := bitPos + 8].
	bits := bitBuf bitAnd: (1 bitShift: n)-1.
	bitBuf := bitBuf bitShift: 0 - n.
	bitPos := bitPos - n.
	^bits! !

!InflateStream methodsFor: 'private' stamp: 'ar 12/23/1999 15:17'!
moveContentsToFront
	"Move the decoded contents of the receiver to the front so that we have enough space for decoding more data."
	| delta |
	readLimit > 32768 ifTrue:[
		delta := readLimit - 32767.
		collection 
			replaceFrom: 1 
			to: collection size - delta + 1 
			with: collection 
			startingAt: delta.
		position := position - delta + 1.
		readLimit := readLimit - delta + 1].! !

!InflateStream methodsFor: 'inflating' stamp: 'ar 12/3/1998 20:49'!
proceedFixedBlock
	self decompressBlock: litTable with: distTable! !

!InflateStream methodsFor: 'huffman trees' stamp: 'jannik.laval 5/1/2010 17:03'!
createHuffmanTables: values counts: counts from: minBits to: maxBits
	"Create the actual tables"
	| table tableStart tableSize tableEnd 
	valueIndex tableStack numValues deltaBits maxEntries
	lastTable lastTableStart tableIndex lastTableIndex |

	table := WordArray new: ((4 bitShift: minBits) max: 16).

	"Create the first entry - this is a dummy.
	It gives us information about how many bits to fetch initially."
	table at: 1 put: (minBits bitShift: 24) + 2. "First actual table starts at index 2"

	"Create the first table from scratch."
	tableStart := 2. "See above"
	tableSize := 1 bitShift: minBits.
	tableEnd := tableStart + tableSize.
	"Store the terminal symbols"
	valueIndex := (counts at: minBits+1).
	tableIndex := 0.
	1 to: valueIndex do:[:i|
		table at: tableStart + tableIndex put: (values at: i).
		tableIndex := self increment: tableIndex bits: minBits].
	"Fill up remaining entries with invalid entries"
	tableStack := OrderedCollection new: 10. "Should be more than enough"
	tableStack addLast: 
		(Array 
			with: minBits	"Number of bits (e.g., depth) for this table"
			with: tableStart	"Start of table"
			with: tableIndex "Next index in table"
			with: minBits	"Number of delta bits encoded in table"
			with: tableSize - valueIndex "Entries remaining in table").
	"Go to next value index"
	valueIndex := valueIndex + 1.
	"Walk over remaining bit lengths and create new subtables"
	minBits+1 to: maxBits do:[:bits|
		numValues := counts at: bits+1.
		[numValues > 0] whileTrue:["Create a new subtable"
			lastTable := tableStack last.
			lastTableStart := lastTable at: 2.
			lastTableIndex := lastTable at: 3.
			deltaBits := bits - (lastTable at: 1).
			"Make up a table of deltaBits size"
			tableSize := 1 bitShift: deltaBits.
			tableStart := tableEnd.
			tableEnd := tableEnd + tableSize.
			[tableEnd > table size ]
				whileTrue:[table := self growHuffmanTable: table].
			"Connect to last table"
			[(table at: lastTableStart + lastTableIndex) = 0] assert."Entry must be unused"
			table at: lastTableStart + lastTableIndex put: (deltaBits bitShift: 24) + tableStart.
			lastTable at: 3 put: (self increment: lastTableIndex bits: (lastTable at: 4)).
			lastTable at: 5 put: (lastTable at: 5) - 1.
			[(lastTable at: 5) >= 0] assert. "Don't exceed tableSize"
			"Store terminal values"
			maxEntries := numValues min: tableSize.
			tableIndex := 0.
			1 to: maxEntries do:[:i|
				table at: tableStart + tableIndex put: (values at: valueIndex).
				valueIndex := valueIndex + 1.
				numValues := numValues - 1.
				tableIndex := self increment: tableIndex bits: deltaBits].
			"Check if we have filled up the current table completely"
			maxEntries = tableSize ifTrue:[
				"Table has been filled. Back up to the last table with space left."
				[tableStack isEmpty not and:[(tableStack last at: 5) = 0]]
						whileTrue:[tableStack removeLast].
			] ifFalse:[
				"Table not yet filled. Put it back on the stack."
				tableStack addLast:
					(Array
						with: bits		"Nr. of bits in this table"
						with: tableStart	"Start of table"
						with: tableIndex "Index in table"
						with: deltaBits	"delta bits of table"
						with: tableSize - maxEntries "Unused entries in table").
			].
		].
	].
	 ^table copyFrom: 1 to: tableEnd-1! !

!InflateStream methodsFor: 'inflating' stamp: 'ar 12/27/1999 13:49'!
processStoredBlock
	| chkSum length |
	"Skip to byte boundary"
	self nextBits: (bitPos bitAnd: 7).
	length := self nextBits: 16.
	chkSum := self nextBits: 16.
	(chkSum bitXor: 16rFFFF) = length
		ifFalse:[^self error:'Bad block length'].
	litTable := nil.
	distTable := length.
	state := state bitOr: BlockProceedBit.
	^self proceedStoredBlock! !

!InflateStream methodsFor: 'huffman trees' stamp: 'ar 12/4/1998 01:48'!
increment: value bits: nBits
	"Increment a value of nBits length.
	The fast decompressor will do this differently"
	^value+1! !

!InflateStream methodsFor: 'huffman trees' stamp: 'ar 12/4/1998 01:50'!
literalLengthMap
	"This is used by the fast decompressor"
	^nil! !

!InflateStream methodsFor: 'inflating' stamp: 'ar 12/4/1998 02:24'!
decodeValueFrom: table
	"Decode the next value in the receiver using the given huffman table."
	| bits bitsNeeded tableIndex value |
	bitsNeeded := (table at: 1) bitShift: -24.	"Initial bits needed"
	tableIndex := 2.							"First real table"
	[bits := self nextSingleBits: bitsNeeded.	"Get bits"
	value := table at: (tableIndex + bits).		"Lookup entry in table"
	(value bitAnd: 16r3F000000) = 0] 			"Check if it is a non-leaf node"
		whileFalse:["Fetch sub table"
			tableIndex := value bitAnd: 16rFFFF.	"Table offset in low 16 bit"
			bitsNeeded := (value bitShift: -24) bitAnd: 255. "Additional bits in high 8 bit"
			bitsNeeded > MaxBits ifTrue:[^self error:'Invalid huffman table entry']].
	^value! !

!InflateStream methodsFor: 'inflating' stamp: 'ar 12/27/1999 13:49'!
proceedStoredBlock
	"Proceed decompressing a stored (e.g., uncompressed) block"
	| length decoded |
	"Literal table must be nil for a stored block"
	litTable == nil ifFalse:[^self error:'Bad state'].
	length := distTable.
	[length > 0 and:[readLimit < collection size and:[sourcePos < sourceLimit]]] 
		whileTrue:[
			collection at: (readLimit := readLimit + 1) put: 
				(source at: (sourcePos := sourcePos + 1)).
			length := length - 1].
	length = 0 ifTrue:[state := state bitAnd: StateNoMoreData].
	decoded := length - distTable.
	distTable := length.
	^decoded! !

!InflateStream methodsFor: 'initialize' stamp: 'ls 1/2/2001 11:44'!
on: aCollectionOrStream
	aCollectionOrStream isStream 
		ifTrue:[	aCollectionOrStream binary.
				sourceStream := aCollectionOrStream.
				self getFirstBuffer]
		ifFalse:[source := aCollectionOrStream].
	^self on: source from: 1 to: source size.! !

!InflateStream methodsFor: 'private' stamp: 'ar 12/23/1999 15:15'!
getFirstBuffer
	"Get the first source buffer after initialization has been done"
	sourceStream == nil ifTrue:[^self].
	source := sourceStream next: 1 << 16. "This is more than enough..."
	sourceLimit := source size.! !

!InflateStream methodsFor: 'private' stamp: 'ar 12/3/1998 17:32'!
getNextBlock
	^self nextBits: 3! !

!InflateStream methodsFor: 'huffman trees' stamp: 'ar 12/4/1998 02:25'!
decodeDynamicTable: nItems from: aHuffmanTable
	"Decode the code length of the literal/length and distance table
	in a block compressed with dynamic huffman trees"
	| values index value repCount theValue |
	values := Array new: nItems.
	index := 1.
	theValue := 0.
	[index <= nItems] whileTrue:[
		value := self decodeValueFrom: aHuffmanTable.
		value < 16 ifTrue:[
			"Immediate values"
			theValue := value.
			values at: index put: value.
			index := index+1.
		] ifFalse:[
			"Repeated values"
			value = 16 ifTrue:[
				"Repeat last value"
				repCount := (self nextBits: 2) + 3.
			] ifFalse:[
				"Repeat zero value"
				theValue := 0.
				value = 17 
					ifTrue:[repCount := (self nextBits: 3) + 3]
					ifFalse:[value = 18 
								ifTrue:[repCount := (self nextBits: 7) + 11]
								ifFalse:[^self error:'Invalid bits tree value']]].
			0 to: repCount-1 do:[:i| values at: index+i put: theValue].
			index := index + repCount].
	].
	^values! !

!InflateStream methodsFor: 'crc' stamp: 'ar 2/29/2004 03:49'!
updateCrc: oldCrc from: start to: stop in: aCollection
	"Answer an updated CRC for the range of bytes in aCollection.
	Subclasses can implement the appropriate means for the check sum they wish to use."
	^oldCrc! !

!InflateStream methodsFor: 'accessing' stamp: 'ar 12/3/1998 16:19'!
size
	"This is a compressed stream - we don't know the size beforehand"
	^self shouldNotImplement! !

!InflateStream methodsFor: 'bit access' stamp: 'ar 12/4/1998 02:01'!
nextSingleBits: n
	| out |
	out := 0.
	1 to: n do:[:i| out := (out bitShift: 1) + (self nextBits: 1)].
	^out! !

!InflateStream methodsFor: 'testing' stamp: 'marcus.denker 9/14/2008 18:57'!
atEnd
	"Note: It is possible that we have a few bits left,
	representing just the EOB marker. To check for
	this we must force decompression of the next
	block if at end of data."
	super atEnd ifFalse:[^false]. "Primitive test"
	(position >= readLimit and:[state = StateNoMoreData]) ifTrue:[^true].
	"Force decompression, by calling #next. Since #moveContentsToFront
	will never move data to the beginning of the buffer it is safe to
	skip back the read position afterwards"
	self next ifNil: [^true].
	position := position - 1.
	^false! !

!InflateStream methodsFor: 'huffman trees' stamp: 'ar 12/21/1999 22:59'!
computeHuffmanValues: aCollection counts: counts from: minBits to: maxBits
	"Assign numerical values to all codes.
	Note: The values are stored according to the bit length"
	| offsets values baseOffset codeLength |
	offsets := Array new: maxBits.
	offsets atAllPut: 0.
	baseOffset := 1.
	minBits to: maxBits do:[:bits|
		offsets at: bits put: baseOffset.
		baseOffset := baseOffset + (counts at: bits+1)].
	values := WordArray new: aCollection size.
	1 to: aCollection size do:[:i|
		codeLength := aCollection at: i.
		codeLength > 0 ifTrue:[
			baseOffset := offsets at: codeLength.
			values at: baseOffset put: i-1.
			offsets at: codeLength put: baseOffset + 1]].
	^values! !

!InflateStream methodsFor: 'bit access' stamp: 'ar 12/27/1999 13:47'!
bitPosition
	"Return the current bit position of the source"
	sourceStream == nil
		ifTrue:[^sourcePos * 8 + bitPos]
		ifFalse:[^sourceStream position + sourcePos * 8 + bitPos]! !

!InflateStream methodsFor: 'crc' stamp: 'ar 2/29/2004 04:22'!
verifyCrc
	"Verify the crc checksum in the input"! !

!InflateStream methodsFor: 'initialize' stamp: 'ar 12/3/1998 16:32'!
reset
	"Position zero - nothing decoded yet"
	position := readLimit := 0.
	sourcePos := 0.
	bitBuf := bitPos := 0.
	state := 0.! !

!InflateStream methodsFor: 'accessing' stamp: 'nk 3/7/2004 18:45'!
next: anInteger 
	"Answer the next anInteger elements of my collection.  overriden for simplicity"
	| newArray |

	"try to do it the fast way"
	position + anInteger < readLimit ifTrue: [
		newArray := collection copyFrom: position + 1 to: position + anInteger.
		position := position + anInteger.
		^newArray
	].

	"oh, well..."
	newArray := collection species new: anInteger.
	1 to: anInteger do: [:index | newArray at: index put: (self next ifNil: [ ^newArray copyFrom: 1 to: index - 1]) ].
	^newArray! !

!InflateStream methodsFor: 'huffman trees' stamp: 'ar 12/3/1998 13:16'!
growHuffmanTable: table
	| newTable |
	newTable := table species new: table size * 2.
	newTable replaceFrom: 1 to: table size with: table startingAt: 1.
	^newTable! !

!InflateStream methodsFor: 'huffman trees' stamp: 'ar 12/4/1998 02:27'!
huffmanTableFrom: aCollection mappedBy: valueMap
	"Create a new huffman table from the given code lengths.
	Map the actual values by valueMap if it is given.
	See the class comment for a documentation of the huffman
	tables used in this decompressor."
	| counts  values table minBits maxBits |
	minBits := MaxBits + 1.
	maxBits := 0.
	"Count the occurences of each code length and compute minBits and maxBits"
	counts := Array new: MaxBits+1.
	counts atAllPut: 0.
	aCollection do:[:length| 
		length > 0 ifTrue:[
			length < minBits ifTrue:[minBits := length].
			length > maxBits ifTrue:[maxBits := length].
			counts at: length+1 put: (counts at: length+1)+1]].
	maxBits = 0 ifTrue:[^nil]. "Empty huffman table"

	"Assign numerical values to all codes."
	values := self computeHuffmanValues: aCollection counts: counts from: minBits to: maxBits.

	"Map the values if requested"
	self mapValues: values by: valueMap.

	"Create the actual tables"
	table := self createHuffmanTables: values counts: counts from: minBits to: maxBits.

	^table! !

!InflateStream methodsFor: 'private' stamp: 'ar 12/23/1999 15:27'!
moveSourceToFront
	"Move the encoded contents of the receiver to the front so that we have enough space for decoding more data."
	(sourceStream == nil or:[sourceStream atEnd]) ifTrue:[^self].
	sourcePos > 10000 ifTrue:[
		source 
			replaceFrom: 1 
			to: source size - sourcePos
			with: source 
			startingAt: sourcePos + 1.
		source := sourceStream 
			next: sourcePos 
			into: source 
			startingAt: source size - sourcePos + 1.
		sourcePos := 0.
		sourceLimit := source size].! !

!InflateStream methodsFor: 'inflating' stamp: 'ar 3/15/1999 15:38'!
decompressBlock: llTable with: dTable
	"Process the compressed data in the block.
	llTable is the huffman table for literal/length codes
	and dTable is the huffman table for distance codes."
	| value extra length distance oldPos oldBits oldBitPos |
	[readLimit < collection size and:[sourcePos <= sourceLimit]] whileTrue:[
		"Back up stuff if we're running out of space"
		oldBits := bitBuf.
		oldBitPos := bitPos.
		oldPos := sourcePos.
		value := self decodeValueFrom: llTable.
		value < 256 ifTrue:[ "A literal"
			collection byteAt: (readLimit := readLimit + 1) put: value.
		] ifFalse:["length/distance or end of block"
			value = 256 ifTrue:["End of block"
				state := state bitAnd: StateNoMoreData.
				^self].
			"Compute the actual length value (including possible extra bits)"
			extra := #(0 0 0 0 0 0 0 0 1 1 1 1 2 2 2 2 3 3 3 3 4 4 4 4 5 5 5 5 0) at: value - 256.
			length := #(3 4 5 6 7 8 9 10 11 13 15 17 19 23 27 31 35 43 51 59 67 83 99 115 131 163 195 227 258) at: value - 256.
			extra > 0 ifTrue:[length := length + (self nextBits: extra)].
			"Compute the distance value"
			value := self decodeValueFrom: dTable.
			extra := #(0 0 0 0 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9 10 10 11 11 12 12 13 13) at: value+1.
			distance := #(1 2 3 4 5 7 9 13 17 25 33 49 65 97 129 193 257 385 513 769
						1025 1537 2049 3073 4097 6145 8193 12289 16385 24577) at: value+1.
			extra > 0 ifTrue:[distance := distance + (self nextBits: extra)].
			(readLimit + length >= collection size) ifTrue:[
				bitBuf := oldBits.
				bitPos := oldBitPos.
				sourcePos := oldPos.
				^self].
			collection 
					replaceFrom: readLimit+1 
					to: readLimit + length + 1 
					with: collection 
					startingAt: readLimit - distance + 1.
			readLimit := readLimit + length.
		].
	].! !

!InflateStream methodsFor: 'huffman trees' stamp: 'ClementBera 7/26/2013 16:47'!
mapValues: values by: valueMap
	| oldValue |
	valueMap ifNil: [^values].
	1 to: values size do:[:i|
		oldValue := values at: i.
		"Note: there may be nil values if not all values are used"
		oldValue 
			ifNil: [^values]
			ifNotNil: [values at: i put: (valueMap at: oldValue+1)]].
! !

!InflateStream methodsFor: 'inflating' stamp: 'ar 12/4/1998 01:46'!
processDynamicBlock
	| nLit nDist nLen codeLength lengthTable bits |
	nLit := (self nextBits: 5) + 257.
	nDist := (self nextBits: 5) + 1.
	nLen := (self nextBits: 4) + 4.
	codeLength := Array new: 19.
	codeLength atAllPut: 0.
	1 to: nLen do:[:i|
		bits := #(16 17 18 0 8 7 9 6 10 5 11 4 12 3 13 2 14 1 15) at: i.
		codeLength at: bits+1 put: (self nextBits: 3).
	].
	lengthTable := self huffmanTableFrom: codeLength mappedBy: nil.
	"RFC 1951: In other words, all code lengths form a single sequence..."
	codeLength := self decodeDynamicTable: nLit+nDist from: lengthTable.
	litTable := self 
				huffmanTableFrom: (codeLength copyFrom: 1 to: nLit)
				mappedBy: self literalLengthMap.
	distTable := self 
				huffmanTableFrom: (codeLength copyFrom: nLit+1 to: codeLength size)
				mappedBy: self distanceMap.
	state := state bitOr: BlockProceedBit.
	self proceedDynamicBlock.! !

!InflateStream methodsFor: 'initialize' stamp: 'ar 12/23/1999 15:35'!
on: aCollection from: firstIndex to: lastIndex
	bitBuf := bitPos := 0.
	"The decompression buffer has a size of at 64k,
	since we may have distances up to 32k back and
	repetitions of at most 32k length forward"
	collection := aCollection species new: 1 << 16.
	readLimit := 0. "Not yet initialized"
	position := 0.
	source := aCollection.
	sourceLimit := lastIndex.
	sourcePos := firstIndex-1.
	state := StateNewBlock.! !

!InflateStream methodsFor: 'private' stamp: 'ar 12/4/1998 02:03'!
decompressAll
	"Profile the decompression speed"
	[self atEnd] whileFalse:[
		position := readLimit.
		self next "Provokes decompression"
	].! !

!InflateStream methodsFor: 'accessing' stamp: 'PeterHugossonMiller 9/3/2009 10:00'!
upTo: anObject 
	"Answer a subcollection from the current access position to the 
	occurrence (if any, but not inclusive) of anObject in the receiver. If 
	anObject is not in the collection, answer the entire rest of the receiver."
	| newStream element |
	newStream := (collection species new: 100) writeStream.
	[self atEnd or: [(element := self next) = anObject]]
		whileFalse: [newStream nextPut: element].
	^newStream contents! !

!InflateStream methodsFor: 'accessing' stamp: 'ar 12/23/1999 15:31'!
sourceStream
	^sourceStream! !

!InflateStream methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 12/16/2011 10:26'!
readInto: buffer startingAt: startIndex count: n
	"Read n objects into the given collection. 
	Return number of elements that have been read."
	| c numRead count |
	n = 0 ifTrue: [ ^n ].
	numRead := 0.
	["Force decompression if necessary"
	(c := self next) == nil 
		ifTrue: [^numRead].
	"Store the first value which provoked decompression"
	buffer at: startIndex + numRead put: c.
	numRead := numRead + 1.
	"After collection has been filled copy as many objects as possible"
	count := (readLimit - position) min: (n - numRead).
	buffer 
		replaceFrom: startIndex + numRead 
		to: startIndex + numRead + count - 1 
		with: collection 
		startingAt: position+1.
	position := position + count.
	numRead := numRead + count.
	numRead = n] whileFalse.
	^n! !

!InflateStream methodsFor: 'huffman trees' stamp: 'ar 12/4/1998 01:51'!
distanceMap
	"This is used by the fast decompressor"
	^nil! !

!InflateStream methodsFor: 'private' stamp: 'ar 2/29/2004 04:18'!
pastEndRead
	"A client has attempted to read beyond the read limit.
	Check in what state we currently are and perform
	the appropriate action"
	| blockType bp oldLimit |
	state = StateNoMoreData ifTrue:[^nil]. "Get out early if possible"
	"Check if we can move decoded data to front"
	self moveContentsToFront.
	"Check if we can fetch more source data"
	self moveSourceToFront.
	state = StateNewBlock ifTrue:[state := self getNextBlock].
	blockType := state bitShift: -1.
	bp := self bitPosition.
	oldLimit := readLimit.
	self perform: (BlockTypes at: blockType+1).
	"Note: if bit position hasn't advanced then nothing has been decoded."
	bp = self bitPosition 
		ifTrue:[^self primitiveFailed].
	"Update crc for the decoded contents"
	readLimit > oldLimit 
		ifTrue:[crc := self updateCrc: crc from: oldLimit+1 to: readLimit in: collection].
	state = StateNoMoreData ifTrue:[self verifyCrc].
	^self next! !

!InflateStream methodsFor: 'inflating' stamp: 'ar 12/4/1998 19:13'!
processFixedBlock
	litTable := self 
				huffmanTableFrom: FixedLitCodes
				mappedBy: self literalLengthMap.
	distTable := self 
				huffmanTableFrom: FixedDistCodes
				mappedBy: self distanceMap.
	state := state bitOr: BlockProceedBit.
	self proceedFixedBlock.! !

!InflateStream class methodsFor: 'initialization' stamp: 'stephane.ducasse 6/14/2009 22:47'!
initialize
	"InflateStream initialize"
	MaxBits := 16.
	StateNewBlock := 0.
	StateNoMoreData := 1.
	BlockProceedBit := 8.
	BlockTypes := #(	processStoredBlock	"New block in stored format"
					processFixedBlock	"New block with fixed huffman tables"
					processDynamicBlock	"New block with dynamic huffman tables"
					errorBadBlock		"Bad block format"
					proceedStoredBlock	"Continue block in stored format"
					proceedFixedBlock	"Continue block in fixed format"
					proceedDynamicBlock	"Continue block in dynamic format"
					errorBadBlock		"Bad block format").
	"Initialize fixed block values"
	FixedLitCodes := 	((1 to: 144) collect:[:i| 8]),
					((145 to: 256) collect:[:i| 9]),
					((257 to: 280) collect:[:i| 7]),
					((281 to: 288) collect:[:i| 8]).
	FixedDistCodes := ((1 to: 32) collect:[:i| 5]).! !

!InlineTextDiffBuilder methodsFor: 'as yet unclassified' stamp: 'gvc 9/2/2008 16:10'!
split: aString
	"Answer the split 'lines' by splitting on whitespace."
	
	|str lines sep|
	lines := OrderedCollection new.
	sep := Character separators, '^()[]{}''"`;.'.
	str := aString readStream.
	[str atEnd] whileFalse: [
		lines add: (str upToAny: sep).
		str atEnd ifFalse: [
			str skip: -1.
			lines add: str next asString]].
	^lines! !

!InputEventFetcher commentStamp: 'michael.rueger 4/22/2009 11:59'!
EventFetcher is responsible for fetching the raw VM events and forward them to the registered event handlers. Event fetching is done in a high priority process, so even with other processes (e.g. the Morphic UI process) being busy events will still be fetched.

Instance Variables
	inputSemaphore:		<Semaphore>
	eventHandlers		<OrderedCollection>
	fetcherProcess		<Process>

inputSemaphore
	- a semaphore registered with the VM to signal availability of an event. Currently not supported on all platforms.

eventHandlers
	- registered event handlers. Event buffers are cloned before sent to each handler.

fetcherProcess
	- a process that fetches the events from the VM. Either polling (InputEventPollingFetcher) or waiting on the inputSemaphore.



Event format:
The current event format is very simple. Each event is recorded into an 8 element array. All events must provide some SmallInteger ID (the first field in the event buffer) and a time stamp (the second field in the event buffer), so that the difference between the time stamp of an event and the current time can be reported.

Currently, the following events are defined:

Null event
=============
The Null event is returned when the ST side asks for more events but no more events are available.
Structure:
[1]		- event type 0
[2-8]	- unused

Mouse event structure
==========================
Mouse events are generated when mouse input is detected.
Structure:
[1]	- event type 1
[2]	- time stamp
[3]	- mouse x position
[4]	- mouse y position
[5]	- button state; bitfield with the following entries:
		1	-	yellow (e.g., right) button
		2	-	blue (e.g., middle) button
		4	-	red (e.g., left) button
		[all other bits are currently undefined]
[6]	- modifier keys; bitfield with the following entries:
		1	-	shift key
		2	-	ctrl key
		4	-	(Mac specific) option key
		8	-	Cmd/Alt key
		[all other bits are currently undefined]
[7]	- reserved.
[8]	- reserved.

Keyboard events
====================
Keyboard events are generated when keyboard input is detected.
[1]	- event type 2
[2]	- time stamp
[3]	- character code
		For now the character code is in Mac Roman encoding.
[4]	- press state; integer with the following meaning
		0	-	character
		1	-	key press (down)
		2	- 	key release (up)
[5]	- modifier keys (same as in mouse events)
[6]	- reserved.
[7]	- reserved.
[8]	- reserved.
!
!InputEventFetcher methodsFor: 'initialize-release' stamp: 'michael.rueger 4/22/2009 11:33'!
terminateEventLoop
	"Terminate the event loop process. Terminate the old process if any."
	"InputEventFetcher default terminateEventLoop"

	fetcherProcess ifNotNil: [fetcherProcess terminate]! !

!InputEventFetcher methodsFor: 'initialize-release' stamp: 'michael.rueger 4/22/2009 11:34'!
shutDown
	self terminateEventLoop.
	inputSemaphore ifNotNil: [Smalltalk unregisterExternalObject: inputSemaphore]! !

!InputEventFetcher methodsFor: 'private' stamp: 'mir 8/14/2008 16:00'!
eventHandlers
	^eventHandlers ifNil: [eventHandlers := OrderedCollection new]! !

!InputEventFetcher methodsFor: 'handlers' stamp: 'mir 8/13/2008 16:29'!
unregisterHandler: handler
	self eventHandlers remove: handler ifAbsent: []! !

!InputEventFetcher methodsFor: 'private events' stamp: 'mir 8/14/2008 15:43'!
primInterruptSemaphore: aSemaphore 
	"Primitive. Install the argument as the semaphore to be signalled whenever the user presses the interrupt key. The semaphore will be signaled once each time the interrupt key is pressed."

	<primitive: 134>
	^self primitiveFailed
"Note: This primitive was marked obsolete but is still used and actually quite useful. It could bre replace with a check in the event loop though, without a need for the now obsolete event tickler as event fetching isn't bound to the Morphic loop."! !

!InputEventFetcher methodsFor: 'events' stamp: 'mir 11/19/2008 19:40'!
signalEvent: eventBuffer
	"Signal the event buffer to all registered event handlers.
	Handlers need make sure to copy the buffer or extract the data otherwise, as the buffer will be reused."

	self eventHandlers do: [:handler |
		handler handleEvent: eventBuffer]! !

!InputEventFetcher methodsFor: 'initialize-release' stamp: 'CamilloBruni 10/14/2013 22:25'!
startUp
	inputSemaphore := Semaphore new.
	self primSetInputSemaphore: (Smalltalk registerExternalObject: inputSemaphore).
	inputSemaphore consumeAllSignals.
	self installEventLoop! !

!InputEventFetcher methodsFor: 'private events' stamp: 'mir 8/14/2008 15:57'!
primSetInputSemaphore: semaIndex
	"Set the input semaphore the VM should use for asynchronously signaling the availability of events. Primitive. Optional."
	<primitive: 93>
	^nil! !

!InputEventFetcher methodsFor: 'accessing' stamp: 'StephaneDucasse 5/18/2012 18:01'!
fetcherProcess 
	^ fetcherProcess ! !

!InputEventFetcher methodsFor: 'initialize-release' stamp: 'CamilloBruni 8/21/2013 19:15'!
installEventLoop
	"Initialize the event loop process. Terminate the old process if any."
	"InputEventFetcher default installEventLoop"

	self terminateEventLoop..
	fetcherProcess := [self eventLoop] forkAt: Processor lowIOPriority.
	fetcherProcess name: 'Input Event Fetcher Process'! !

!InputEventFetcher methodsFor: 'private' stamp: 'StephaneDucasse 11/8/2010 18:39'!
primGetNextEvent: array
	"Store the next OS event available into the provided array.
	Essential."
	<primitive: 94>
	 array at: 1 put: EventTypeNone.
     ^nil
	! !

!InputEventFetcher methodsFor: 'events' stamp: 'IgorStasenko 11/22/2008 20:20'!
waitForInput
	inputSemaphore wait.! !

!InputEventFetcher methodsFor: 'handlers' stamp: 'mir 8/13/2008 16:29'!
registerHandler: handler
	self eventHandlers add: handler! !

!InputEventFetcher methodsFor: 'events' stamp: 'IgorStasenko 11/22/2008 20:23'!
eventLoop
	"Fetch pending raw events from the VM.
	 This method is run at high priority."
	| eventBuffer |

	eventBuffer := Array new: 8.
	
	[true] whileTrue: [
		| type window |
		self waitForInput.

		[self primGetNextEvent: eventBuffer.
		type := eventBuffer at: 1.
		type = EventTypeNone]
			whileFalse: [
				"Patch up the window index in case we don't get one"
				window := eventBuffer at: 8.
				(window isNil
					or: [window isZero])
					ifTrue: [eventBuffer at: 8 put: 1].	
						
				self signalEvent: eventBuffer]]! !

!InputEventFetcher class methodsFor: 'class initialization' stamp: 'michael.rueger 4/24/2009 13:23'!
deinstall
	"InputEventFetcher deinstall"

	Default
		ifNotNil: [
			Default shutDown.
			Smalltalk removeFromStartUpList: Default class.
			Smalltalk removeFromShutDownList: Default class.
			Default := nil].
	Smalltalk removeFromStartUpList: self.
	Smalltalk removeFromShutDownList: self! !

!InputEventFetcher class methodsFor: 'accessing' stamp: 'MarcusDenker 2/24/2012 13:30'!
default
	"InputEventFetcher default"

	^Default ifNil: [Default := InputEventFetcher new]! !

!InputEventFetcher class methodsFor: 'system startup' stamp: 'mir 8/14/2008 15:21'!
shutDown
	"InputEventFetcher shutDown"
	
	self default shutDown! !

!InputEventFetcher class methodsFor: 'class initialization' stamp: 'michael.rueger 4/24/2009 13:20'!
install
	"InputEventFetcher install"

	Smalltalk addToStartUpList: self after: Cursor.
	Smalltalk addToShutDownList: self after: Form.

	Default := self new.
	Default startUp
! !

!InputEventFetcher class methodsFor: 'system startup' stamp: 'mir 8/13/2008 14:25'!
startUp
	"InputEventFetcher startUp"
	
	self default startUp! !

!InputEventHandler commentStamp: 'michael.rueger 4/22/2009 11:56'!
An InputEventHandler is the abstract superclass for all input event handlers.
Subclasses need to implement handleEvent:.

Instance Variables
	eventFetcher:		<InputEventFetcher>

eventFetcher
	- the event fetcher I'm registered with and receiving my events from.
!
!InputEventHandler methodsFor: 'initialize-release' stamp: 'FernandoOlivero 11/25/2012 20:24'!
unregister
	eventFetcher ifNotNil: [
			eventFetcher unregisterHandler: self.
			eventFetcher := nil. ]! !

!InputEventHandler methodsFor: 'events' stamp: 'mir 8/13/2008 19:35'!
handleEvent: eventBuffer
	self subclassResponsibility! !

!InputEventHandler methodsFor: 'events' stamp: 'JuanVuletich 11/1/2010 15:48'!
flushEvents! !

!InputEventHandler methodsFor: 'initialize-release' stamp: 'mir 8/13/2008 16:27'!
registerIn: anEventFetcher
	eventFetcher := anEventFetcher.
	eventFetcher registerHandler: self! !

!InputEventHandler methodsFor: 'events' stamp: 'ThierryGoubier 7/5/2013 16:17'!
isKbdEvent: bufEvt
	^ bufEvt first = EventTypeKeyboard and: [ bufEvt fourth = EventKeyChar ]! !

!InputEventSensor commentStamp: 'michael.rueger 4/22/2009 11:59'!
An InputEventSensor is a replacement for the old Morphic EventSensor framework.
It updates its state when events are received so that all state based users of Sensor (e.g., Sensor keyboard, Sensor leftShiftDown, Sensor mouseButtons) will work exactly as before. The usage of these funtions is discouraged. 

Instance variables:
	mouseButtons <Integer>	- mouse button state as replacement for primMouseButtons
	mousePosition <Point>	- mouse position as replacement for primMousePt
	eventQueue <SharedQueue>	- an optional event queue for event driven applications
	modifiers		<Integer>	- modifier states

Class variables:

	ButtonDecodeTable

	KeyDecodeTable
!
!InputEventSensor methodsFor: 'tablet' stamp: 'jm 4/13/1999 11:02'!
tabletExtent
	"Answer the full tablet extent in tablet coordinates."

	| params |
	params := self primTabletGetParameters: 1.
	params ifNil: [^ self error: 'no tablet available'].
	^ (params at: 1)@(params at: 2)
! !

!InputEventSensor methodsFor: 'private' stamp: 'ar 2/2/2001 15:09'!
primTabletRead: cursorIndex
	"Answer the pen tablet data for the cursor having the given index. Answer nil if there is no pen tablet. The data is:
	1. index of the cursor to which this data applies
	2. timestamp of the last state chance for this cursor
	3., 4., and 5. x, y, and z coordinates of the cursor (z is typically 0)
	6. and 7. xTilt and yTilt of the cursor; (signed)
	8. type of cursor (0 = unknown, 1 = pen, 2 = puck, 3 = eraser)
	9. cursor buttons
	10. cursor pressure, downward
	11. cursor pressure, tangential
	12. flags"

	<primitive: 'primitiveReadTablet' module: 'JoystickTabletPlugin'>
	self primitiveFailed
! !

!InputEventSensor methodsFor: 'initialize-release' stamp: 'mir 8/14/2008 15:18'!
shutDown! !

!InputEventSensor methodsFor: 'mouse' stamp: 'nk 3/17/2004 07:02'!
noButtonPressed
	"Answer whether any mouse button is not being pressed."

	^self anyButtonPressed not
! !

!InputEventSensor methodsFor: 'events' stamp: 'mir 11/19/2008 12:44'!
flushAllButDandDEvents! !

!InputEventSensor methodsFor: 'private events' stamp: 'AdrianLienhard 10/19/2009 15:56'!
nextKeyboardEvent
	"Allows for use of old Sensor protocol to get at the keyboard,
	as when running kbdTest or the InterpreterSimulator in Morphic"

	| evtBuf |
	evtBuf := eventQueue findFirst: [:buf | self isKbdEvent: buf].
	self flushNonKbdEvents.
	^evtBuf! !

!InputEventSensor methodsFor: 'private' stamp: 'ar 2/2/2001 15:09'!
primTabletGetParameters: cursorIndex
	"Answer the pen tablet parameters. For parameters that differ from cursor to cursor, answer those associated with the cursor having the given index. Answer nil if there is no pen tablet. The parameters are:
	1. tablet width, in tablet units
	2. tablet height, in tablet units
	3. number of tablet units per inch
	4. number of cursors (pens, pucks, etc; some tablets have more than one)
	5. this cursor index
	6. and 7. x scale and x offset for scaling tablet coordintes (e.g., to fit the screen)
	8. and 9. y scale and y offset for scaling tablet coordintes  (e.g., to fit the screen)
	10. number of pressure levels
	11. presure threshold needed close pen tip switch 
	12. number of pen tilt angles"

	<primitive: 'primitiveGetTabletParameters' module: 'JoystickTabletPlugin'>
	^ nil
! !

!InputEventSensor methodsFor: 'tablet' stamp: 'jm 4/10/1999 23:03'!
tabletTimestamp
	"Answer the time (in tablet clock ticks) at which the tablet's primary pen last changed state. This can be used in polling loops; if this timestamp hasn't changed, then the pen state hasn't changed either."

	| data |
	data := self primTabletRead: 1.  "state of first/primary pen"
	^ data at: 2
! !

!InputEventSensor methodsFor: 'mouse' stamp: 'mir 11/19/2008 21:15'!
redButtonPressed
	"Answer true if only the red mouse button is being pressed.
	This is the first mouse button, usually the left one."

	^(self mouseButtons bitAnd: 7) = 4
! !

!InputEventSensor methodsFor: 'events' stamp: 'JuanVuletich 10/10/2010 22:56'!
someEventInQueue
	^eventQueue isEmpty not! !

!InputEventSensor methodsFor: 'private events' stamp: 'michael.rueger 4/22/2009 12:59'!
modifiers
	"modifier keys; bitfield with the following entries:
		1	-	shift key
		2	-	ctrl key
		4	-	(Mac specific) option key
		8	-	Cmd/Alt key"

	"Fetch the next event if any to update state.
	Makes sure that the old polling methods consume events"

"	self nextEvent."
	

	^modifiers! !

!InputEventSensor methodsFor: 'keyboard' stamp: 'mir 8/13/2008 20:06'!
flushKeyboard
	"Remove all characters from the keyboard buffer."

	[self keyboardPressed]
		whileTrue: [self keyboard]! !

!InputEventSensor methodsFor: 'initialization' stamp: 'StephaneDucasse 3/16/2012 20:27'!
initialize
        "Initialize the receiver"
        super initialize.
        eventQueue := WaitfreeQueue new.
        mouseButtons := 0.
        mousePosition := 0 @ 0.
        modifiers := 0! !

!InputEventSensor methodsFor: 'tablet' stamp: 'jm 4/13/1999 11:12'!
tabletPoint
	"Answer the current position of the first tablet pointing device (pen, puck, or eraser) in tablet coordinates."

	| data |
	data := self primTabletRead: 1.  "state of first/primary pen"
	^ (data at: 3) @ (data at: 4)
! !

!InputEventSensor methodsFor: 'initialize-release' stamp: 'MichaelRueger 10/18/2009 12:56'!
startUp
	self initialize! !

!InputEventSensor methodsFor: 'private events' stamp: 'michael.rueger 4/9/2009 15:02'!
characterForEvent: evtBuf

	| keycode |
	evtBuf ifNil: [^nil].
	keycode := evtBuf sixth.
	^keycode
		ifNotNil: [Unicode value: keycode]! !

!InputEventSensor methodsFor: 'events' stamp: 'MarcusDenker 1/26/2010 09:40'!
peekEvent
	"Look ahead at the next event."
	| nextEvent |
	nextEvent := eventQueue peek.
	^((nextEvent notNil) and: [(nextEvent at: 1) ~= EventTypeMenu])
		ifTrue: [self processEvent: nextEvent]! !

!InputEventSensor methodsFor: 'keyboard' stamp: 'mir 8/14/2008 14:02'!
keyboard
	"Answer the next character from the keyboard."

	^self characterForEvent: self nextKeyboardEvent! !

!InputEventSensor methodsFor: 'events' stamp: 'IgorStasenko 4/15/2011 11:57'!
nextEvent
	"Return the next event from the receiver."
	| evt |

	evt := eventQueue nextOrNil.
	^ evt ifNotNil: [ self processEvent: evt ]
! !

!InputEventSensor methodsFor: 'cursor' stamp: 'michael.rueger 5/25/2009 13:45'!
cursorPoint
	"Answer a Point indicating the cursor location."

	"Fetch the next event if any to update state.
	Makes sure that the old polling methods consume events
	self nextEvent."

	^ mousePosition! !

!InputEventSensor methodsFor: 'keyboard' stamp: 'mir 8/14/2008 14:06'!
keyboardPressed
	"Answer true if keystrokes are available."

	^self peekKeyboardEvent notNil! !

!InputEventSensor methodsFor: 'modifier keys' stamp: 'mir 11/19/2008 21:09'!
controlKeyPressed
	"Answer whether the control key on the keyboard is being held down."

	^self modifiers anyMask: 16r02! !

!InputEventSensor methodsFor: 'events' stamp: 'pmm 3/13/2010 11:31'!
handleEvent: evt

	self queueEvent: evt shallowCopy! !

!InputEventSensor methodsFor: 'tablet' stamp: 'jm 4/10/1999 22:14'!
hasTablet
	"Answer true if there is a pen tablet available on this computer."

	^ (self primTabletGetParameters: 1) notNil
! !

!InputEventSensor methodsFor: 'private events' stamp: 'GuillermoPolito 4/22/2012 16:59'!
processEvent: evt 
	"Process a single event. This method is run at high priority."
	| type |
		
	type := evt at: 1.

	"Treat menu events first"
	type = EventTypeMenu
		ifTrue: [
			self processMenuEvent: evt.
			^nil].

	"Tackle mouse events first"
	type = EventTypeMouse
		ifTrue: [
			"Transmogrify the button state according to the platform's button map definition"
			evt at: 5 put: (ButtonDecodeTable at: (evt at: 5) + 1).
			"Map the mouse buttons depending on modifiers"
			evt at: 5 put: (self mapButtons: (evt at: 5) modifiers: (evt at: 6)).

			"Update state for polling calls"
			mousePosition := (evt at: 3) @ (evt at: 4).
			modifiers := evt at: 6.
			mouseButtons := evt at: 5.

			^evt].
	
	
	"Finally keyboard"
	type = EventTypeKeyboard
		ifTrue: [
			"Update state for polling calls"
			modifiers := evt at: 5. 
			^evt].
				
	"Handle all events other than Keyborad or Mouse."
	^evt.
	! !

!InputEventSensor methodsFor: 'mouse' stamp: 'nk 3/17/2004 07:22'!
waitButtonOrKeyboard
	"Wait for the user to press either any mouse button or any key. 
	Answer the current cursor location or nil if a keypress occured."

	| delay |
	delay := Delay forMilliseconds: 50.
	[self anyButtonPressed]
		whileFalse: [delay wait.
			self keyboardPressed
				ifTrue: [^ nil]].
	^ self cursorPoint
! !

!InputEventSensor methodsFor: 'private events' stamp: 'mir 11/19/2008 19:42'!
queueEvent: evt
	"Queue the given event in the event queue"
	eventQueue nextPut: evt! !

!InputEventSensor methodsFor: 'mouse' stamp: 'nk 3/17/2004 07:22'!
waitButton
	"Wait for the user to press any mouse button and then answer with the 
	current location of the cursor."

	| delay |
	delay := Delay forMilliseconds: 50.
	[self anyButtonPressed] whileFalse: [ delay wait ].
	^self cursorPoint
! !

!InputEventSensor methodsFor: 'private events' stamp: 'AdrianLienhard 6/7/2010 10:47'!
processMenuEvent: evt
	| handler localCopyOfEvt |

	Smalltalk globals at: #HostSystemMenus ifPresent: [ :menus |		
		localCopyOfEvt := evt shallowCopy.
		handler := (menus
			defaultMenuBarForWindowIndex: (localCopyOfEvt at: 8))
			getHandlerForMenu: (localCopyOfEvt at: 3) item: (localCopyOfEvt at: 4).
		handler handler value: localCopyOfEvt ]! !

!InputEventSensor methodsFor: 'events' stamp: 'JuanVuletich 11/1/2010 15:47'!
flushEvents
	eventQueue ifNotNil:[eventQueue flush]! !

!InputEventSensor methodsFor: 'private events' stamp: 'michael.rueger 5/25/2009 13:45'!
mouseButtons
	"button state; bitfield with the following entries:
		1	-	yellow (e.g., right) button
		2	-	blue (e.g., middle) button
		4	-	red (e.g., left) button
		[all other bits are currently undefined]"

	"Fetch the next event if any to update state.
	Makes sure that the old polling methods consume events"
	self nextEvent.
	
	^mouseButtons! !

!InputEventSensor methodsFor: 'joystick' stamp: ''!
joystickXY: index

	| inputWord x y |
	inputWord := self primReadJoystick: index.
	x := (inputWord bitAnd: 16r7FF) - 16r400.
	y := ((inputWord bitShift: -11) bitAnd: 16r7FF) - 16r400.
	^ x@y
	! !

!InputEventSensor methodsFor: 'private events' stamp: 'mir 8/14/2008 13:37'!
peekKeyboardEvent
	"Allows for use of old Sensor protocol to get at the keyboard,
	as when running kbdTest or the InterpreterSimulator in Morphic"

	^eventQueue findFirst: [:buf | self isKbdEvent: buf]! !

!InputEventSensor methodsFor: 'mouse' stamp: 'mir 11/19/2008 21:15'!
yellowButtonPressed
	"Answer whether only the yellow mouse button is being pressed. 
	This is the second mouse button or option+click on the Mac."

	^(self mouseButtons bitAnd: 7) = 2
! !

!InputEventSensor methodsFor: 'modifier keys' stamp: 'michael.rueger 6/10/2009 13:36'!
commandKeyPressed
	"Answer whether the command key on the keyboard is being held down."

	^self modifiers anyMask: 16r08! !

!InputEventSensor methodsFor: 'private' stamp: 'ar 2/2/2001 15:09'!
primReadJoystick: index
	"Return the joystick input word for the joystick with the given index in the range [1..16]. Returns zero if the index does not correspond to a currently installed joystick."

	<primitive: 'primitiveReadJoystick' module: 'JoystickTabletPlugin'>
	^ 0

	! !

!InputEventSensor methodsFor: 'private events' stamp: 'MarcusDenker 6/24/2013 11:18'!
mapButtons: buttons modifiers: anInteger
	"Map the buttons to yellow or blue based on the given modifiers.
	If only the red button is pressed, then map
		Ctrl-RedButton -> BlueButton.
		Cmd-RedButton -> YellowButton.
	"
	(buttons = RedButtonBit)
		ifFalse:[^buttons].
	(anInteger allMask: CtrlKeyBit) 
		ifTrue:[^BlueButtonBit].
	(anInteger allMask: CommandKeyBit) 
		ifTrue:[^YellowButtonBit].
	^buttons! !

!InputEventSensor methodsFor: 'mouse' stamp: ''!
waitClickButton
	"Wait for the user to click (press and then release) any mouse button and 
	then answer with the current location of the cursor."

	self waitButton.
	^self waitNoButton! !

!InputEventSensor methodsFor: 'keyboard' stamp: 'mir 8/14/2008 14:03'!
keyboardPeek
	"Answer the next character in the keyboard buffer without removing it, or nil if it is empty."

	^ self characterForEvent: self peekKeyboardEvent! !

!InputEventSensor methodsFor: 'tablet' stamp: 'jm 4/12/1999 13:05'!
tabletPressure
	"Answer the current pressure of the first tablet pointing device (pen, puck, or eraser), a number between 0.0 (no pressure) and 1.0 (max pressure)"

	| params data |
	params := self primTabletGetParameters: 1.
	params ifNil: [^ self].
	data := self primTabletRead: 1.  "state of first/primary pen"
	^ (data at: 10) asFloat / ((params at: 10) - 1)
! !

!InputEventSensor methodsFor: 'mouse' stamp: 'mir 11/19/2008 21:07'!
blueButtonPressed
	"Answer whether only the blue mouse button is being pressed. 
	This is the third mouse button or cmd+click on the Mac."

	^(self mouseButtons bitAnd: 7) = 1
! !

!InputEventSensor methodsFor: 'joystick' stamp: ''!
joystickOn: index

	^ (((self primReadJoystick: index) bitShift: -27) bitAnd: 1) ~= 0
	! !

!InputEventSensor methodsFor: 'mouse' stamp: 'mir 11/19/2008 22:28'!
anyButtonPressed
	"Answer whether at least one mouse button is currently being pressed."

	^self mouseButtons anyMask: 7! !

!InputEventSensor methodsFor: 'mouse' stamp: 'nk 3/17/2004 07:25'!
waitNoButton
	"Wait for the user to release any mouse button and then answer the current location of the cursor."

	| delay |
	delay := Delay forMilliseconds: 50.
	[self anyButtonPressed] whileTrue: [ delay wait].
	^self cursorPoint
! !

!InputEventSensor methodsFor: 'modifier keys' stamp: 'mir 11/19/2008 21:07'!
anyModifierKeyPressed
	"ignore, however, the shift keys 'cause that's not REALLY a command key"

	^self modifiers anyMask: 16r0E	"cmd | opt | ctrl"! !

!InputEventSensor methodsFor: 'joystick' stamp: ''!
joystickButtons: index

	^ ((self primReadJoystick: index) bitShift: -22) bitAnd: 16r71F
	! !

!InputEventSensor methodsFor: 'private events' stamp: 'nice 4/20/2009 22:48'!
flushNonKbdEvents
	eventQueue ifNil: [^ self].
	eventQueue flushAllSuchThat:
		[:buf | (self isKbdEvent: buf) not]! !

!InputEventSensor methodsFor: 'modifier keys' stamp: 'mir 11/19/2008 21:16'!
shiftPressed
	"Answer whether the shift key on the keyboard is being held down."

	^self modifiers anyMask: 16r01
! !

!InputEventSensor class methodsFor: 'class initialization' stamp: 'AlainPlantec 1/7/2010 22:16'!
installMouseDecodeTable
	"Create a decode table that swaps the lowest-order 2 bits"
	ButtonDecodeTable := self swapMouseButtons
				ifTrue: [ByteArray withAll:
							((0 to: 255) collect: [:ea |
								((ea bitAnd: 1) << 1
									bitOr: (ea bitAnd: 2) >> 1)
										bitOr: (ea bitAnd: 16rFC) ])]
				ifFalse: [ByteArray
						withAll: (0 to: 255)]! !

!InputEventSensor class methodsFor: 'system startup' stamp: 'nk 6/21/2004 10:36'!
shutDown
	self default shutDown.! !

!InputEventSensor class methodsFor: 'class initialization' stamp: 'nk 7/11/2002 07:41'!
defaultCrossPlatformKeys
	"Answer a list of key letters that are used for common editing operations
	on different platforms."
	^{ $c . $x . $v . $a . $s . $f . $g . $z }
! !

!InputEventSensor class methodsFor: 'public' stamp: ''!
default
	"Answer the default system InputEventSensor, Sensor."

	^ Sensor! !

!InputEventSensor class methodsFor: 'system startup' stamp: 'GuillermoPolito 4/22/2012 17:00'!
startUp
	
	self installMouseDecodeTable.
	self default startUp! !

!InputEventSensor class methodsFor: 'settings' stamp: 'MarcusDenker 7/26/2013 11:21'!
swapMouseButtons
	^ Smalltalk os isWindows not! !

!InputEventSensor class methodsFor: 'class initialization' stamp: 'MarcusDenker 2/24/2012 13:33'!
installEventSensorFramework: fetcherClass
	"Installs the new sensor framework."

	| newSensor |
	"Do some extra cleanup"
	Smalltalk removeFromShutDownList: InputEventFetcher.
	Smalltalk removeFromStartUpList: InputEventFetcher.

	InputEventFetcher deinstall.

	newSensor := self new.
	fetcherClass install.
	newSensor registerIn: InputEventFetcher default.
	
	"Shut down old sensor"
	Sensor shutDown.
	Smalltalk removeFromShutDownList: Sensor class.
	Smalltalk removeFromStartUpList: Sensor class.
	

	"Note: We must use #become: here to replace all references to the old sensor with the new one, since Sensor is referenced from all the existing controllers."
	Sensor becomeForward: newSensor. "done"

	"Register the interrupt handler"
	UserInterruptHandler new registerIn: InputEventFetcher default.

	Smalltalk addToStartUpList: Sensor class after: fetcherClass.
	Smalltalk addToShutDownList: Sensor class after: Form.

	"Project spawnNewProcessAndTerminateOld: true"! !

!InputEventSensor class methodsFor: 'class initialization' stamp: 'michael.rueger 4/22/2009 11:48'!
installEventSensorFramework
	"Installs the new sensor framework."
	"InputEventSensor installEventSensorFramework"

	self installEventSensorFramework: InputEventFetcher! !

!InputWidget commentStamp: 'SeanDeNigris 1/23/2014 11:40'!
I am a generic widget far a user to enter a string

Example (printMe):
	self example inspect.!
!InputWidget methodsFor: 'api' stamp: 'BenjaminVanRyseghem 4/26/2013 13:51'!
ghostText: aString

	input ghostText: aString! !

!InputWidget methodsFor: 'actions' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
ok

	input accept.
	^ okAction value value! !

!InputWidget methodsFor: 'api' stamp: 'BenjaminVanRyseghem 4/26/2013 14:16'!
triggerOkAction

	self window 
		ifNotNil: [ :w | w triggerOkAction ]! !

!InputWidget methodsFor: 'initialization' stamp: 'TorstenBergmann 3/4/2015 21:56'!
initializeWidgets

	self instantiateModels: #(
		input 	TextInputFieldModel
		label	LabelModel ).
			
	input
		ghostText: 'input';
		acceptBlock: [ self triggerOkAction ];
		entryCompletion: nil;
		acceptOnCR: true.
		
	label label: 'label'! !

!InputWidget methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 4/26/2013 13:49'!
initializeDialogWindow: aWindow

	aWindow okAction: [ self ok ]! !

!InputWidget methodsFor: 'initialization' stamp: 'DucasseStephane 9/10/2014 09:59'!
initialize

	okAction := [ ] asValueHolder.
	value := '' asValueHolder.
	title := 'Title' asValueHolder.
	
	super initialize.! !

!InputWidget methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
value

	^ value value! !

!InputWidget methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
initializePresenter

	input whenTextIsAccepted: [:text |
		self ok == false
			ifFalse: [ value value: text ] ].
		
	title whenChangedDo: [ self updateTitle ]! !

!InputWidget methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/26/2013 13:56'!
label
	^ label! !

!InputWidget methodsFor: 'api-events' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
title

	^ title value! !

!InputWidget methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
title: aString

	title value: aString! !

!InputWidget methodsFor: 'api-events' stamp: 'BenjaminVanRyseghem 4/26/2013 13:54'!
whenValueChanged: aBlock

	value whenChangedDo: aBlock! !

!InputWidget methodsFor: 'api' stamp: 'TorstenBergmann 3/4/2015 21:56'!
label: aString

	label label: aString.! !

!InputWidget methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/26/2013 13:56'!
input
	^ input! !

!InputWidget methodsFor: 'api' stamp: 'BenjaminVanRyseghem 4/26/2013 13:57'!
initialExtent

	^ 250@125! !

!InputWidget class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 4/26/2013 13:56'!
defaultSpec
	<spec>
	
	^ SpecLayout composed
		newRow: #label bottom: 0.5;
		newRow: #input top: 0.5;
		yourself! !

!InputWidget class methodsFor: 'example' stamp: 'SeanDeNigris 1/23/2014 11:43'!
example
	"self example inspect"

	| widget |	
	widget := self new.
	widget
		title: 'Name';
		label: 'What''s your name?';
		ghostText: 'John Doe'.
	widget openDialogWithSpec modalRelativeTo: self currentWorld.
	^ widget value! !

!InputWidget class methodsFor: 'example' stamp: 'SeanDeNigris 1/23/2014 11:37'!
example2
	"self example2"
	
	| widget buttonModel buttonWindow |
	buttonModel := ButtonModel new.
	buttonWindow := buttonModel openWithSpec.
	widget := InputWidget new.
	widget
		title: 'Label?';
		label: 'Enter a button label';
		ghostText: 'Ok'.
	widget openDialogWithSpec modalRelativeTo: buttonWindow.
	buttonModel label: widget value! !

!InsetBorder commentStamp: 'kfr 10/27/2003 09:32'!
see BorderedMorph!
!InsetBorder methodsFor: 'accessing' stamp: 'ar 8/25/2001 17:51'!
style
	^#inset! !

!InsetBorder methodsFor: 'color tracking' stamp: 'ar 8/25/2001 18:17'!
trackColorFrom: aMorph
	baseColor ifNil:[self color: aMorph insetColor].! !

!InsetBorder methodsFor: 'accessing' stamp: 'ar 11/26/2001 15:23'!
colorsAtCorners
	| c c14 c23 |
	c := self color.
	c14 := c lighter. c23 := c darker.
	^Array with: c23 with: c14 with: c14 with: c23.! !

!InsetBorder methodsFor: 'accessing' stamp: 'gvc 1/31/2007 13:41'!
bottomRightColor
	"Changed from direct access to color since, if nil,
	self color is transparent."
	
	^width = 1 
		ifTrue: [self color twiceLighter]
		ifFalse: [self color lighter]! !

!InsetBorder methodsFor: 'accessing' stamp: 'gvc 1/31/2007 13:41'!
topLeftColor
	"Changed from direct access to color since, if nil,
	self color is transparent."
	
	^width = 1 
		ifTrue: [self color twiceDarker]
		ifFalse: [self color darker]! !

!InspectorNavigator commentStamp: '<historical>'!
This a wrapper around inspectors for diving. It is used in the case where the inspector is dynamically replaced by another inspector. For example, EyeCollectionInspector would be replaced by EyeIntegerInspector.!
!InspectorNavigator methodsFor: 'initialization' stamp: 'CamilloBruni 10/15/2013 17:21'!
initializeShortcuts
	self bindKeyCombination: $[ command toAction: [ self inspectPrevious ].
	self bindKeyCombination: $] command toAction: [ self inspectNext ].

	self bindKeyCombination: $[ shift command toAction: [ self usePreviousInspectorType ].
	self bindKeyCombination: $] shift command toAction: [ self useNextInspectorType ].

	self bindKeyCombination: $0 command toAction: [ self useBasicInspector ].
	self bindKeyCombination: $0 shift command toAction: [ self useDefaultInspector ].
	
	"code duplication? yes, but still easier than capturing arguments ;)"
	self bindKeyCombination: $1 command toAction: [ self useInspectorAt: 1 ].
	self bindKeyCombination: $2 command toAction: [ self useInspectorAt: 2 ].
	self bindKeyCombination: $3 command toAction: [ self useInspectorAt: 3 ].
	self bindKeyCombination: $4 command toAction: [ self useInspectorAt: 4 ].
	self bindKeyCombination: $5 command toAction: [ self useInspectorAt: 5 ].
	self bindKeyCombination: $6 command toAction: [ self useInspectorAt: 6 ].
	self bindKeyCombination: $7 command toAction: [ self useInspectorAt: 7 ].
	self bindKeyCombination: $8 command toAction: [ self useInspectorAt: 8 ].
	self bindKeyCombination: $9 command toAction: [ self useInspectorAt: 9 ].! !

!InspectorNavigator methodsFor: 'accessing' stamp: 'CamilloBruni 5/2/2013 21:15'!
object
	^ self inspector object! !

!InspectorNavigator methodsFor: 'history' stamp: 'CamilloBruni 9/20/2013 22:07'!
pushHistory
	history add: self inspector.
	self toolbar update.! !

!InspectorNavigator methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
basicInspector: anEyeInspector
	inspector value 
		ifNotNil: [ :inspect | 
			inspect owner: nil ].
	inspector value: anEyeInspector.
	
	anEyeInspector 
		owner: self;
		ownerChanged.! !

!InspectorNavigator methodsFor: 'actions' stamp: 'CamilloBruni 9/20/2013 22:07'!
inspectPrevious
	history hasPrevious
		ifFalse: [ ^ self ].
	self inspectHistoryItem: history previous! !

!InspectorNavigator methodsFor: 'accessing' stamp: 'StephaneDucasse 3/7/2014 11:34'!
defaultWindowModelClass
	| stdout |
	FileStream stdout wantsLineEndConversion: true; converter.
	stdout := VTermOutputDriver stdout.
	stdout nextPutAll: self class name.
	stdout cr.
	^ TickingWindowModel ! !

!InspectorNavigator methodsFor: 'actions' stamp: 'CamilloBruni 9/20/2013 21:54'!
useBasicInspector
	self inspectorType: EyeBasicInspector! !

!InspectorNavigator methodsFor: 'accessing' stamp: 'CamilloBruni 9/20/2013 21:48'!
previousInspectorType
	| index types |
	types := self inspectorTypes.
	index := types 
		indexOf: self inspectorType
		ifAbsent: [ ^ types first ].
	^types atWrap: index - 1.! !

!InspectorNavigator methodsFor: 'accessing' stamp: 'CamilloBruni 9/20/2013 19:31'!
inspectorType
	^ self inspector class! !

!InspectorNavigator methodsFor: 'accessing' stamp: 'CamilloBruni 9/18/2013 22:22'!
history
	^ history! !

!InspectorNavigator methodsFor: 'initialization' stamp: 'BernardoContreras 9/27/2014 15:45'!
initialize

	super initialize.
	
	history := NavigationHistory new.
	inspector := nil asValueHolder.
	
	self initializeShortcuts.
	inspector whenChangedDo: [ :new :old | 
		self updateInspectorFrom: old ].
	self announcer
		when: WidgetBuilt send: #setRefreshedToTrue to: self.
	
	canBeRefreshed := false.
	self whenWindowChanged: [ :w |
		w whenClosedDo: [ self inspector close ] ].! !

!InspectorNavigator methodsFor: 'accessing' stamp: 'CamilloBruni 5/2/2013 21:27'!
selectedObject
	^ self inspector selectedObject! !

!InspectorNavigator methodsFor: 'accessing' stamp: 'ClementBera 5/2/2013 11:43'!
title
	^ self inspector title! !

!InspectorNavigator methodsFor: 'actions' stamp: 'CamilloBruni 11/25/2013 17:00'!
inspect: anObject
	| oldInspectorType |
	oldInspectorType := self inspectorType.
	self 
		inspector: (EyeInspector inspector: anObject);
		inspectorType: oldInspectorType.
! !

!InspectorNavigator methodsFor: 'accessing' stamp: 'CamilloBruni 9/18/2013 22:16'!
toolbar: anObject 
	toolbar := anObject ! !

!InspectorNavigator methodsFor: 'accessing' stamp: 'CamilloBruni 5/2/2013 21:17'!
selectedIndex: anInteger
	self inspector selectedIndex: anInteger! !

!InspectorNavigator methodsFor: 'initialization' stamp: 'StephaneDucasse 3/7/2014 11:07'!
stepTime
	^ 1500! !

!InspectorNavigator methodsFor: 'actions' stamp: 'MarcusDenker 9/28/2013 15:31'!
useTreeInspector
	self inspectorType: EyeTreeInspector! !

!InspectorNavigator methodsFor: 'updating' stamp: 'ClementBera 7/3/2013 13:04'!
takeKeyboardFocus
	^ self inspector takeKeyboardFocus! !

!InspectorNavigator methodsFor: 'accessing' stamp: 'CamilloBruni 5/2/2013 00:37'!
canBeRefreshed
	^ canBeRefreshed! !

!InspectorNavigator methodsFor: 'initialization' stamp: 'ClementBera 8/13/2013 11:11'!
initialExtent
	^ self inspector initialExtent
	! !

!InspectorNavigator methodsFor: 'accessing' stamp: 'CamilloBruni 5/2/2013 21:15'!
selectedIndex
	^ self inspector selectedIndex! !

!InspectorNavigator methodsFor: 'accessing' stamp: 'CamilloBruni 9/20/2013 20:12'!
taskbarIcon
	^ self inspector 
		ifNil: [ super taskbarIcon ]
		ifNotNil: [ :anInspector | anInspector taskbarIcon ]! !

!InspectorNavigator methodsFor: 'actions' stamp: 'ClementBera 5/3/2013 14:59'!
diveInto: anObject
	self inspect: anObject.! !

!InspectorNavigator methodsFor: 'accessing' stamp: 'CamilloBruni 5/2/2013 00:37'!
canBeRefreshed: anObject
	canBeRefreshed := anObject! !

!InspectorNavigator methodsFor: 'actions' stamp: 'CamilloBruni 9/20/2013 22:16'!
inspectNext
	history hasNext
		ifFalse: [ ^ self ].
	self inspectHistoryItem: history next! !

!InspectorNavigator methodsFor: 'accessing' stamp: 'CamilloBruni 9/18/2013 22:16'!
toolbar
	^ toolbar! !

!InspectorNavigator methodsFor: 'actions' stamp: 'BenjaminVanRyseghem 11/8/2013 17:55'!
diveIntoSelectedObject
	self inspector diveIntoSelectedObject! !

!InspectorNavigator methodsFor: 'history' stamp: 'CamilloBruni 9/20/2013 22:08'!
inspectHistoryItem: historyItem
	"self inspect: historyItem key .
	self selectedIndex: historyItem value."
	self inspector: historyItem key! !

!InspectorNavigator methodsFor: 'actions' stamp: 'CamilloBruni 9/20/2013 22:03'!
useInspectorAt: index
	"choose an inspector at the given index from the given inspectorTypes.
	If the index is out of bounds, simply crop it to the neares value"
	| types |
	types := self inspectorTypes.
	self inspectorType: (types at: (index min: types size max: 1))! !

!InspectorNavigator methodsFor: 'initialization' stamp: 'CamilloBruni 9/20/2013 20:26'!
initializeWidgets

	
	toolbar := self instantiate: EyeInspectorToolBar.! !

!InspectorNavigator methodsFor: 'actions' stamp: 'CamilloBruni 9/20/2013 19:34'!
usePreviousInspectorType
	self inspectorType: self previousInspectorType! !

!InspectorNavigator methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
inspector
	^ inspector value! !

!InspectorNavigator methodsFor: 'actions' stamp: 'CamilloBruni 9/20/2013 21:54'!
useDefaultInspector
	self inspectorType: self object class inspectorClass! !

!InspectorNavigator methodsFor: 'accessing' stamp: 'BenComan 3/18/2014 02:13'!
inspectorType: anInspectorClass
	"Use a new inspector type. Instantiate the given inspector class and replace the current view"
	| oldScriptAreaTextModel |
	
	oldScriptAreaTextModel := self inspector text.
	
	anInspectorClass = self inspector class
		ifTrue: [  ^ self ].
	anInspectorClass isNil
		ifTrue: [ ^ self ].
		
	(self inspectorTypes includes: anInspectorClass)
		ifFalse: [ ^ self ].
		
	self basicInspector: (anInspectorClass new 
		inspect: self object;
		yourself).

	self inspector text 
		text: oldScriptAreaTextModel getText;
		setSelection: oldScriptAreaTextModel getSelection.

	history replaceCurrentWith: self inspector.
	self toolbar update.! !

!InspectorNavigator methodsFor: 'accessing' stamp: 'CamilloBruni 9/20/2013 21:47'!
nextInspectorType
	| index types |
	types := self inspectorTypes.
	index := types 
		indexOf: self inspectorType
		ifAbsent: [ ^ types first ].
	^types atWrap: index + 1.! !

!InspectorNavigator methodsFor: 'updating' stamp: 'CamilloBruni 9/20/2013 20:38'!
updateInspectorFrom: oldInspector

	self updateTitle.
	self inspector ifNil: [ ^ self ].

	self canBeRefreshed ifFalse: [ ^ self ].

	self needRebuild: false.

	self buildWithSpec: oldInspector spec selector.
	
	oldInspector close. "kill the update process"! !

!InspectorNavigator methodsFor: 'initialization' stamp: 'StephaneDucasse 3/7/2014 11:07'!
step
	self inspector step.! !

!InspectorNavigator methodsFor: 'private' stamp: 'StephaneDucasse 8/4/2013 16:54'!
setRefreshedToTrue
	"introduced because we should not use weak announcer with on:do:."
	
	canBeRefreshed := true! !

!InspectorNavigator methodsFor: 'actions' stamp: 'CamilloBruni 9/20/2013 19:34'!
useNextInspectorType
	self inspectorType: self nextInspectorType! !

!InspectorNavigator methodsFor: 'menu' stamp: 'NicolaiHess 2/15/2014 23:59'!
customMenuActions
	^ [:aMenu :currentGroup |
		currentGroup addItem: [ :item |
			item
				name: 'Dive Into' translated;
				action: [ self diveIntoSelectedObject  ];
				shortcut: $d command mac | $d alt win | $d alt unix].
	
		(history hasPrevious or: [ history hasNext ])
			ifTrue: [ 
				aMenu addGroup: [ :aGroup |
					history hasPrevious ifTrue: [ 
						aGroup addItem: [ :item |
							item
								name: 'Back' translated;
								action: [ self inspectPrevious ];
								shortcut: $[ command mac | $[ alt win | $[ alt unix ] ].
							
					history hasNext ifTrue: [ 
						aGroup addItem: [ :item |
							item
								name: 'Forward' translated;
								action: [ self inspectNext ];
								shortcut: $] command mac | $] alt win |  $] alt unix  ] ] ] ] ]! !

!InspectorNavigator methodsFor: 'accessing' stamp: 'CamilloBruni 9/20/2013 19:32'!
inspectorTypes
	^ self inspector variants! !

!InspectorNavigator methodsFor: 'accessing' stamp: 'CamilloBruni 9/20/2013 22:31'!
inspector: anEyeInspector
	self basicInspector: anEyeInspector.
	self pushHistory.! !

!InspectorNavigator class methodsFor: 'instance creation' stamp: 'ClementBera 5/2/2013 11:43'!
openInspector: inspector

	^ self new
		inspector: inspector;
		openWithSpec: #inspectorSpec;
		yourself! !

!InspectorNavigator class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 11/8/2013 16:56'!
debuggerSpec
	<spec: #default>
	
	^ SpecLayout composed
		newRow: #toolbar height: self toolbarHeight;
		add: #inspector withSpec: #debuggerSpec top: self toolbarHeight;
		yourself! !

!InspectorNavigator class methodsFor: 'instance creation' stamp: 'MarcusDenker 9/28/2013 15:58'!
openExplorer: inspector

	^ (self openInspector: inspector) useTreeInspector! !

!InspectorNavigator class methodsFor: 'instance creation' stamp: 'cb 6/25/2013 13:39'!
inspect: anObject
	^ self openInspector: anObject inspector! !

!InspectorNavigator class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 11/8/2013 16:57'!
inspectorSpec
	<spec>
	
	^ SpecLayout composed
		newColumn: [ :c | 
			c 
				add: #toolbar height: self toolbarHeight;
				add: #inspector withSpec: #inspectorSpec ];
		yourself! !

!InstVarRefLocator commentStamp: 'md 4/8/2003 12:50'!
My job is to scan bytecodes for instance variable references.

BlockContext allInstances collect: [ :x |
	{x. x hasInstVarRef}
].!
!InstVarRefLocator methodsFor: 'instruction decoding' stamp: 'RAA 1/5/2001 08:46'!
popIntoReceiverVariable: offset 

	bingo := true! !

!InstVarRefLocator methodsFor: 'instruction decoding' stamp: 'RAA 1/5/2001 08:46'!
pushReceiverVariable: offset

	bingo := true! !

!InstVarRefLocator methodsFor: 'instruction decoding' stamp: 'RAA 1/5/2001 08:46'!
storeIntoReceiverVariable: offset 

	bingo := true! !

!InstVarRefLocator methodsFor: 'initialize-release' stamp: 'md 4/8/2003 11:35'!
interpretNextInstructionUsing: aScanner 
	
	bingo := false.
	aScanner interpretNextInstructionFor: self.
	^bingo! !

!InstVarRefLocatorTest commentStamp: '<historical>'!
This is the unit test for the class InstVarRefLocator. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see: 
	- http://www.c2.com/cgi/wiki?UnitTest
	- there is a chapter in the PharoByExample book (http://pharobyexample.org)
	- the sunit class category!
!InstVarRefLocatorTest methodsFor: 'examples' stamp: 'sd 6/5/2005 08:27'!
example1
	| ff |
	(1 < 2) ifTrue: [tt ifNotNil: [ff := 'hallo']].
	^ ff.! !

!InstVarRefLocatorTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:23'!
testInstructions
	Object methods
		do: [ :method | 
			| scanner printer end |
			scanner := InstructionStream on: method.
			printer := InstVarRefLocator new.
			end := scanner method endPC.
			[ scanner pc <= end ] whileTrue: [ printer interpretNextInstructionUsing: scanner ] ]! !

!InstVarRefLocatorTest methodsFor: 'tests' stamp: 'md 4/8/2003 12:42'!
testExample2
	| method |

	method := self class compiledMethodAt: #example2.
	self deny: (self hasInstVarRef: method).! !

!InstVarRefLocatorTest methodsFor: 'tests' stamp: 'md 4/8/2003 12:42'!
testExample1
	| method |

	method := self class compiledMethodAt: #example1.
	self assert: (self hasInstVarRef: method).! !

!InstVarRefLocatorTest methodsFor: 'private' stamp: 'md 4/8/2003 12:39'!
hasInstVarRef: aMethod
	"Answer whether the receiver references an instance variable."

	| scanner end printer |

	scanner := InstructionStream on: aMethod.
	printer := InstVarRefLocator new.
	end := scanner method endPC.

	[scanner pc <= end] whileTrue: [
		(printer interpretNextInstructionUsing: scanner) ifTrue: [^true].
	].
	^false! !

!InstVarRefLocatorTest methodsFor: 'examples' stamp: 'md 4/8/2003 12:31'!
example2
	| ff|	
	ff := 1.
	(1 < 2) ifTrue: [ff ifNotNil: [ff := 'hallo']].
	^ ff.! !

!InstanceModification commentStamp: '<historical>'!
I collect and provide the information to migrate instances when a class changed.!
!InstanceModification methodsFor: 'installing' stamp: 'ToonVerwaest 3/28/2011 17:14'!
installModifiedSlot: modifiedSlot
	modificationMap at: modifiedSlot newFieldIndex put: modifiedSlot! !

!InstanceModification methodsFor: 'installing' stamp: 'ToonVerwaest 3/28/2011 17:14'!
installRemovedSlot: removedSlot
	" ignore "! !

!InstanceModification methodsFor: 'installing' stamp: 'ToonVerwaest 3/28/2011 17:13'!
installAddedSlot: addedSlot
	modificationMap at: addedSlot newFieldIndex put: addedSlot! !

!InstanceVariableEyeElement commentStamp: '<historical>'!
I am an eye element for instance variables.!
!InstanceVariableEyeElement methodsFor: 'action' stamp: 'ClementBera 4/30/2013 11:45'!
referencesToInstanceVariable
	"Open a browser on all references to the selected instance variable, if that's what currently selected."

	^ self systemNavigation browseAllAccessesTo: self instVarName from: self hostClass! !

!InstanceVariableEyeElement methodsFor: 'action' stamp: 'ClementBera 4/30/2013 11:43'!
save: aValue
	self host instVarNamed: self instVarName put: aValue! !

!InstanceVariableEyeElement methodsFor: 'accessing' stamp: 'MarcusDenker 7/2/2014 17:37'!
value
	^ self host readSlotNamed: self instVarName! !

!InstanceVariableEyeElement methodsFor: 'accessing' stamp: 'ClementBera 4/30/2013 11:41'!
instVarName: aString
	instVarName := aString! !

!InstanceVariableEyeElement methodsFor: 'menu' stamp: 'ClementBera 4/30/2013 13:05'!
accessorCode
	^ self instVarName! !

!InstanceVariableEyeElement methodsFor: 'accessing' stamp: 'ClementBera 4/30/2013 11:41'!
instVarName
	^ instVarName! !

!InstanceVariableEyeElement methodsFor: 'menu' stamp: 'TudorGirba 11/14/2013 22:17'!
customSubMenu: aMenu
	
	aMenu addGroup: [ :aGroup | 
		aGroup 
			addItem: [:anItem | 
				anItem 
					name: 'List Methods Using "', self instVarName, '"';
					action: [ self referencesToInstanceVariable] ];
			addItem: [:anItem | 
				anItem 
					name: 'List Methods Storing into "', self instVarName, '"';
					action: [ self storingsIntoInstanceVariable].
			].
		]! !

!InstanceVariableEyeElement methodsFor: 'accessing' stamp: 'ClementBera 4/30/2013 11:41'!
label
	^ self instVarName! !

!InstanceVariableEyeElement methodsFor: 'action' stamp: 'ClementBera 4/30/2013 11:46'!
storingsIntoInstanceVariable

	^ self systemNavigation browseAllStoresInto: self instVarName from: self hostClass! !

!InstanceVariableEyeElement methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 3/30/2014 13:10'!
= anObject
	^ super = anObject and: [ instVarName = anObject instVarName ]! !

!InstanceVariableEyeElement methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 4/1/2014 09:54'!
hash
	^ super hash bitXor: instVarName hash! !

!InstanceVariableEyeElement class methodsFor: 'instance creation' stamp: 'ClementBera 4/30/2013 11:40'!
host: anObject instVarName: aString
	^ (self host: anObject) instVarName: aString! !

!InstanceVariableNode commentStamp: 'TorstenBergmann 1/31/2014 11:19'!
I am a parse tree leaf representing an instance variable.!
!InstanceVariableNode methodsFor: 'initialize-release' stamp: 'eem 5/13/2008 10:17'!
name: varName index: varIndex
	^self name: varName index: varIndex-1 type: LdInstType! !

!InstanceVariableNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 18:08'!
emitCodeForStore: stack encoder: encoder
	encoder genStoreInstVar: index! !

!InstanceVariableNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 18:07'!
sizeCodeForStorePop: encoder
	^encoder sizeStorePopInstVar: index! !

!InstanceVariableNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 18:08'!
emitCodeForValue: stack encoder: encoder
	stack push: 1.
	^encoder genPushInstVar: index! !

!InstanceVariableNode methodsFor: 'visiting' stamp: 'eem 9/6/2009 12:34'!
accept: aVisitor
	^aVisitor visitInstanceVariableNode: self! !

!InstanceVariableNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 17:57'!
sizeCodeForStore: encoder
	^encoder sizeStoreInstVar: index! !

!InstanceVariableNode methodsFor: 'code generation' stamp: 'eem 5/15/2008 10:05'!
emitCodeForStorePop: stack encoder: encoder
	encoder genStorePopInstVar: index.
	stack pop: 1! !

!InstanceVariableNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 17:53'!
sizeCodeForValue: encoder
	^encoder sizePushInstVar: index! !

!InstanceVariableSlot commentStamp: 'MarcusDenker 1/22/2015 17:43'!
I add some special behavior: 
	-  I override bytecode generation to generate ivar read and write bytecodes
	- I print the definition as #name !
!InstanceVariableSlot methodsFor: 'testing' stamp: 'MarcusDenker 1/22/2015 18:46'!
isSpecial
	"I am just a backward compatible ivar slot. Note: my subclasses are special"
	^(self class = InstanceVariableSlot) not! !

!InstanceVariableSlot methodsFor: 'code generation' stamp: 'MarcusDenker 6/25/2014 16:43'!
emitStore: methodBuilder

	methodBuilder storeInstVar: index! !

!InstanceVariableSlot methodsFor: 'code generation' stamp: 'MarcusDenker 6/25/2014 16:43'!
emitValue: methodBuilder

	methodBuilder pushInstVar: index.
! !

!InstanceVariableSlot methodsFor: 'queries' stamp: 'MarcusDenker 2/13/2015 16:11'!
usingMethods
	"All methods that read or write the slot, we can do it here without having to use the AST"
	^self definingClass 
		ifNil: [ #() ]
		ifNotNil: [ :definingClass | definingClass withAllSubclasses flatCollect: [:class |  
		(class whichSelectorsAccess: self name) collect: [:sel | 
			class compiledMethodAt: sel ]]]! !

!InstanceVariableSlot methodsFor: 'printing' stamp: 'MarcusDenker 1/23/2015 14:39'!
definitionString
	"non special globals are defined by the symbol"
	^self isSpecial
		ifTrue: [super definitionString]
		ifFalse: [self name printString]
! !

!InstanceVariableSlot class methodsFor: 'cleanup' stamp: 'MarcusDenker 7/2/2014 14:20'!
resetIvarSlots
	"when the Ivar slots need to be re-created (e.g. due to changes in the layout of the class),
	 this method re-creates for every ivar a ivar slot"
	"to be removed later when the system is in a stable state"

	| block |
	block := [ :class | 
	class instVarNames
		withIndexDo: [ :ivarName :index | 
			class layout slotScope
				at: index
				put:
					((InstanceVariableSlot named: ivarName asSymbol)
						index: index + class superclass allInstVarNames size;
						yourself) ] ].
	Smalltalk allClasses
		do: [ :class | 
			block value: class.
			block value: class classSide ]! !

!InstructionClient commentStamp: 'md 4/8/2003 12:50'!
My job is to make it easier to implement clients for InstructionStream. See InstVarRefLocator
as an example. !
!InstructionClient methodsFor: 'instruction decoding' stamp: 'ClementBera 12/28/2014 17:33'!
trap
	"send the class trap message to the current context."
! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'md 4/8/2003 13:02'!
blockReturnTop
	"Return Top Of Stack bytecode."

! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'md 4/8/2003 13:03'!
pushConstant: value
	"Push Constant, value, on Top Of Stack bytecode."
! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'ClementBera 12/28/2014 17:51'!
pushActiveProcess
	"Push Active Process On Top Of Its Own Stack bytecode."
	! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'md 4/8/2003 13:04'!
storeIntoTemporaryVariable: offset 
	"Store Top Of Stack Into Temporary Variable Of Method bytecode."
! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'ClementBera 12/28/2014 17:56'!
pushClosureTemps: numTemps
	"push on stack nil numTemps times for the closure temps"! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'md 4/8/2003 13:04'!
storeIntoReceiverVariable: offset 
	"Store Top Of Stack Into Instance Variable Of Method bytecode."
! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'md 4/8/2003 13:03'!
pushReceiver
	"Push Active Context's Receiver on Top Of Stack bytecode."
! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'md 4/8/2003 13:03'!
popIntoTemporaryVariable: offset 
	"Remove Top Of Stack And Store Into Temporary Variable bytecode."
! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'md 4/8/2003 13:03'!
popIntoLiteralVariable: anAssociation 
	"Remove Top Of Stack And Store Into Literal Variable bytecode."
! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'md 4/8/2003 13:04'!
send: selector super: supered numArgs: numberArguments
	"Send Message With Selector, selector, bytecode. The argument, 
	supered, indicates whether the receiver of the message is specified with 
	'super' in the source method. The arguments of the message are found in 
	the top numArguments locations on the stack and the receiver just 
	below them."
! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'md 4/8/2003 13:02'!
jump: offset if: condition 
	"Conditional Jump bytecode."

! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'eem 5/31/2008 13:49'!
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
	"Push Closure bytecode."
! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'ClementBera 12/28/2014 17:32'!
trapIfNotInstanceOf: behaviorOrArrayOfBehavior 
	"If the top of stack is not an instance of either the argument, or, if the
	argument is an Array,
	any of the elements of the argument, send the class trap message
	to the current context."
! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'md 4/8/2003 13:04'!
storeIntoLiteralVariable: anAssociation 
	"Store Top Of Stack Into Literal Variable Of Method bytecode."
! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'eem 5/31/2008 13:50'!
pushNewArrayOfSize: numElements 
	"Push New Array of size numElements bytecode."
! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'md 4/8/2003 13:02'!
doPop
	"Remove Top Of Stack bytecode."
! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'md 4/8/2003 13:04'!
pushTemporaryVariable: offset
	"Push Contents Of Temporary Variable Whose Index Is the 
	argument, offset, On Top Of Stack bytecode."
! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'ClementBera 12/28/2014 17:32'!
blockReturnConstant: value 
	"Return Constant From Block bytecode."! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'md 4/8/2003 13:03'!
methodReturnTop
	"Return Top Of Stack bytecode."
! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'md 4/8/2003 13:03'!
popIntoReceiverVariable: offset 
	"Remove Top Of Stack And Store Into Instance Variable bytecode."
! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'eem 5/31/2008 13:51'!
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
	"Remove Top Of Stack And Store Into Offset of Temp Vector bytecode."! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'md 4/8/2003 13:02'!
jump: offset
	"Unconditional Jump bytecode."

! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'eem 6/16/2008 14:26'!
pushConsArrayWithElements: numElements
	"Push Cons Array of size numElements popping numElements items from the stack into the array bytecode."
! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'md 4/8/2003 13:03'!
pushActiveContext
	"Push Active Context On Top Of Its Own Stack bytecode."
! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'md 4/8/2003 13:02'!
methodReturnConstant: value 
	"Return Constant bytecode."
! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'eem 5/31/2008 13:52'!
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
	"Store Top Of Stack And Store Into Offset of Temp Vector bytecode."! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'md 4/8/2003 13:03'!
pushReceiverVariable: offset
	"Push Contents Of the Receiver's Instance Variable Whose Index 
	is the argument, offset, On Top Of Stack bytecode."
! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'md 4/8/2003 13:03'!
pushLiteralVariable: anAssociation
	"Push Contents Of anAssociation On Top Of Stack bytecode."
! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'eem 5/31/2008 13:54'!
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
	"Push Contents at Offset in Temp Vector bytecode."! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'md 4/8/2003 13:02'!
doDup
	"Duplicate Top Of Stack bytecode."

! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'md 4/8/2003 13:02'!
methodReturnReceiver
	"Return Self bytecode."
! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'ClementBera 10/23/2014 10:00'!
callPrimitive: primNumber
	"executes a primitive.
	Can be an inlined primitive (primNumber >= (1 << 15)) 
	or a regular primitive."! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'ClementBera 2/25/2015 14:56'!
unusedBytecode
		"an unused bytecode is encountered"! !

!InstructionClientTest commentStamp: '<historical>'!
This is the unit test for the class InstructionClient. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see: 
	- http://www.c2.com/cgi/wiki?UnitTest
	- there is a chapter in the PharoByExample book (http://pharobyexample.org)
	- the sunit class category!
!InstructionClientTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:23'!
testInstructions
	"just interpret all of methods of Object"

	| client |
	client := InstructionClient new.
	Object methods
		do: [ :method | 
			| scanner |
			scanner := InstructionStream on: method.
			[ scanner pc <= method endPC ] whileTrue: [ scanner interpretNextInstructionFor: client ] ]! !

!InstructionStream commentStamp: '<historical>'!
Instance variables:
	sender: <Context|nil> context that invoked this context
	pc: <SmallInteger> (pc = program counter) offset of the bytecode instruction currently executed

My instances can interpret the byte-encoded Smalltalk instruction set. They maintain a program counter (pc) for streaming through CompiledMethods. My subclasses are Contexts, which inherit this capability. They store the return pointer in the instance variable sender, and the current position in their method in the instance variable pc. For other users, sender can hold a method to be similarly interpreted. The unclean re-use of sender to hold the method was to avoid a trivial subclass for the stand-alone scanning function.!
!InstructionStream methodsFor: 'scanning' stamp: 'eem 6/4/2008 10:58'!
addSelectorTo: set 
	"If this instruction is a send, add its selector to set."

	| selectorOrSelf |
	(selectorOrSelf := self selectorToSendOrSelf) == self ifFalse:
		[set add: selectorOrSelf]! !

!InstructionStream methodsFor: 'testing' stamp: 'ClementBera 12/29/2014 12:17'!
willJump
	"unconditionally"

	^ self method encoderClass isJumpAt: pc in: self method
	! !

!InstructionStream methodsFor: 'testing' stamp: 'ClementBera 12/29/2014 12:16'!
willCreateBlock
	"next bytecode is a block creation"

	^ self method encoderClass isCreateBlockAt: pc in: self method! !

!InstructionStream methodsFor: 'scanning' stamp: 'eem 6/5/2008 10:07'!
previousPc

	^self method pcPreviousTo: pc! !

!InstructionStream methodsFor: 'testing' stamp: 'ClementBera 12/29/2014 12:21'!
willReturn
	"Answer whether the next bytecode is a return."

	^ self method encoderClass isReturnAt: pc in: self method! !

!InstructionStream methodsFor: 'testing' stamp: 'ClementBera 12/29/2014 12:24'!
willStorePop
	"Answer whether the next bytecode is a store-pop."

	^ self method encoderClass isStorePopAt: pc in: self method! !

!InstructionStream methodsFor: 'decoding' stamp: 'ClementBera 12/28/2014 18:11'!
interpretJump
	^ self method encoderClass interpretJumpIn: self
! !

!InstructionStream methodsFor: 'scanning' stamp: ''!
pc
	"Answer the index of the next bytecode."

	^pc! !

!InstructionStream methodsFor: 'private' stamp: 'CamilloBruni 7/17/2013 22:02'!
pc: anInteger

	pc := anInteger! !

!InstructionStream methodsFor: 'scanning' stamp: 'eem 6/16/2008 09:52'!
firstByte
	"Answer the first byte of the current bytecode."

	^self method at: pc! !

!InstructionStream methodsFor: 'scanning' stamp: 'eem 6/16/2008 09:53'!
fourthByte
	"Answer the fourth byte of the current bytecode."

	^self method at: pc + 3! !

!InstructionStream methodsFor: 'scanning' stamp: 'StephaneDucasse 12/22/2010 17:23'!
followingBytecode
	"Answer the bytecode of the following bytecode (different to nextByte)."

	^self method at: self followingPc! !

!InstructionStream methodsFor: 'decoding' stamp: 'ClementBEra 4/2/2015 09:44'!
interpretNext3ByteSistaV1Instruction: bytecode for: client extA: extA extB: extB startPC: startPC
	"Send to the argument, client, a message that specifies the next instruction.
	 This method handles the three-byte codes.
	 For a table of the bytecode set, see EncoderForSistaV1's class comment."

	| method byte2 byte3 |
	method := self method.
	byte2 := method at: pc.
	byte3 := method at: pc + 1.
	pc := pc + 2.
	"we search the bytecodes by what we expect to be the static frequency."
	bytecode = 248 ifTrue:
		[^client callPrimitive: byte2 + (byte3 bitShift: 8)].
	bytecode = 250 ifTrue:
		["**	250  11111010  eeiiikkk  jjjjjjjj  Push Closure Num Copied iii (+ExtA//16*8) Num Args kkk (+ ExtA\\16*8) BlockSize jjjjjjjj (+ExtB*256). ee = num extensions"
		 ^client
			pushClosureCopyNumCopiedValues: ((byte2 bitShift: -3) bitAnd: 7) + (extA // 16 bitShift: 3)
			numArgs: (byte2 bitAnd: 7) + (extA \\ 16 bitShift: 3)
			blockSize: byte3 + (extB bitShift: 8)].
	bytecode = 251 ifTrue:
		[^client pushRemoteTemp: byte2 inVectorAt: byte3].
	bytecode = 252 ifTrue:
		[^client storeIntoRemoteTemp: byte2 inVectorAt: byte3].
	bytecode = 253 ifTrue:
		[^client popIntoRemoteTemp: byte2 inVectorAt: byte3].
	"249		11111001 	xxxxxxxx	syyyyyyy	Reserved for Push Float"
	"254-255	1111111 i	xxxxxxxx	yyyyyyyy	UNASSIGNED"
	^self unusedBytecode: client at: startPC! !

!InstructionStream methodsFor: 'scanning' stamp: 'StephaneDucasse 12/22/2010 17:23'!
scanFor: scanBlock
	"Answer the index of the first bytecode for which scanBlock
	 answers true when supplied with that bytecode."

	| method end byte |
	method := self method.
	end := method endPC.
	[pc <= end] whileTrue: 
		[(scanBlock value: (byte := method at: pc)) ifTrue:
			[^true].
		 pc := self nextPc: byte].
	^false! !

!InstructionStream methodsFor: 'decoding' stamp: 'ClementBera 12/28/2014 18:13'!
interpretNextInstructionFor: client 
	"Send to the argument, client, a message that specifies the type of the 
	next instruction."
	^ self method encoderClass interpretNextInstructionFor: client  in: self! !

!InstructionStream methodsFor: 'decoding' stamp: 'ClementBEra 4/2/2015 09:45'!
interpretNextSistaV1InstructionFor: client
	"Send to the argument, client, a message that specifies the next instruction."

	| byte div16 offset method extA extB savedPC |
	method := self method.
	"For a table of the bytecode set, see EncoderForSistaV1's class comment."
	"consume and compute any extensions first."
	extA := extB := 0.
	savedPC := pc.
	[byte := self method at: pc.
	 pc := pc + 1.
	 byte >= 16rE0 and: [byte <= 16rE1]] whileTrue:
		[| extByte |
		 extByte := self method at: pc.
		 pc := pc + 1.
		 byte = 16rE0
			ifTrue:
				[extA := (extA bitShift: 8) + extByte]
			ifFalse:
				[extB := (extB = 0 and: [extByte > 127])
							ifTrue: [extByte - 256]
							ifFalse: [(extB bitShift: 8) + extByte]]].
	div16 := byte // 16.
	offset := byte \\ 16.
	"We do an inline quasi-binary search on each of the possible 16 values of div16"
	div16 < 11 ifTrue:
		[div16 < 6 ifTrue:
			[div16 < 4 ifTrue:
				[div16 < 2 ifTrue:
					[div16 = 0 ifTrue:
						 [^client pushReceiverVariable: offset].
					^client pushLiteralVariable: (method literalAt: offset + 1)]. "div16 = 1"
				 ^client pushConstant: (method literalAt: byte \\ 32 + 1)].
			 div16 = 4 ifTrue:
				[offset < 12 ifTrue:
					[^client pushTemporaryVariable: offset].
				 offset = 12 ifTrue:
					[^client pushReceiver].
				 offset = 13 ifTrue:
					[^client pushConstant: true].
				 offset = 14 ifTrue:
					[^client pushConstant: false].
				 offset = 15 ifTrue:
					[^client pushConstant: nil]].
			"div16 = 5"
			 offset < 2 ifTrue:
				[^client pushConstant: offset].
			 offset = 2 ifTrue:
				[^self interpretSistaV1ExtendedPush: extB for: client].
			 offset = 3 ifTrue:
				[^client doDup].
			
			 offset = 8 ifTrue:
				[^client methodReturnReceiver].
			 offset = 9 ifTrue:
				[^client methodReturnConstant: true].
			 offset = 10 ifTrue:
				[^client methodReturnConstant: false].
			 offset = 11 ifTrue:
				[^client methodReturnConstant: nil].
			 offset = 12 ifTrue:
				[^client methodReturnTop].
			 offset = 13 ifTrue:
				[^client blockReturnConstant: nil].
			 offset = 14 ifTrue:
				[^client blockReturnTop].
			 offset = 15 ifTrue:
				[^client doNop].
			 ^self unusedBytecode: client at: savedPC].
		"short sends"
		div16 = 6 ifTrue:
			[^client
				send: (Smalltalk specialSelectorAt: offset + 1)
				super: false
				numArgs: (Smalltalk specialNargsAt: offset + 1)].
		 div16 = 7 ifTrue:
			[^client
				send: (Smalltalk specialSelectorAt: offset + 17)
				super: false
				numArgs: (Smalltalk specialNargsAt: offset + 17)].
		^client
			send: (method literalAt: offset + 1)
			super: false
			numArgs: div16 - 8].
	"div16 >= 11; bytecode >= 176"
	div16 < 14 ifTrue:
		[div16 = 11 ifTrue:
			[offset < 8 ifTrue:
				[^client jump: offset + 1].
			 ^client jump: offset - 7 if: true].
		 div16 = 12 ifTrue:
			[offset < 8 ifTrue:
				[^client jump: offset + 1 if: false].
			 ^client popIntoReceiverVariable: offset - 8].
		 "div16 = 13"
		 offset < 8 ifTrue:
		 	[^client popIntoTemporaryVariable: offset].
		 offset = 8 ifTrue: [ ^ client doPop ].
		 ^self unusedBytecode: client at: savedPC].
	"2 byte and 3 byte codes"
	byte < 248 ifTrue:
		[^self interpretNext2ByteSistaV1Instruction: byte for: client extA: extA extB: extB startPC: savedPC].
	^self interpretNext3ByteSistaV1Instruction: byte for: client extA: extA extB: extB startPC: savedPC! !

!InstructionStream methodsFor: 'decoding' stamp: 'ClementBera 12/28/2014 17:36'!
interpretSistaV1Jump
	"If the instruction at pc is an unconditional jump, interpret it, advancing
	the pc,
	and answering the jump distance. Otherwise answer nil."
	"176-183	10110 iii				Jump iii + 1 (i.e., 1 through 8)
	*	225/16rE1	11100001	sbbbbbbb	Extend B (Ext B = Ext B prev *
	256 + Ext B)
	*	237		11101101	iiiiiiii		Jump #iiiiiiii (+ Extend B * 256, where
	bbbbbbbb = sddddddd, e.g. -32768 = i=0, a=0, s=1)"
	| method byte nextpc extB |
	method := self method.
	"consume and compute any extension first."
	extB := 0.
	nextpc := pc.
	"must not advance pc unless this is a jump."
	[byte := self method at: nextpc.
	nextpc := nextpc + 1.
	byte = 225]
		whileTrue: [| extByte |
			extByte := self method at: nextpc.
			nextpc := nextpc + 1.
			extB := (extB = 0
							and: [extByte > 127])
						ifTrue: [extByte - 256]
						ifFalse: [(extB bitShift: 8)
								+ extByte]].
	(byte between: 176 and: 183)
		ifTrue: [pc := nextpc.
			^ byte - 191].
	byte = 237
		ifTrue: [byte := method at: nextpc.
			pc := nextpc + 1.
			^ (extB bitShift: 8)
				+ byte].
	^ nil
! !

!InstructionStream methodsFor: 'scanning' stamp: 'ClementBera 12/29/2014 11:55'!
skipBackBeforeJump
	"Assuming that the receiver is positioned just after a jump, skip back one or two bytes,
	 depending on the size of the previous jump instruction."
	| scanner client prevPc |
	scanner := InstructionStream on: self method.
	client := InstructionClient new.
	[scanner pc < pc] whileTrue:
		[prevPc := scanner pc.
		 scanner interpretNextInstructionFor: client].
	scanner pc: prevPc.
	(scanner willJumpIfTrue or: [scanner willJumpIfFalse]) ifFalse:
		[self error: 'Where''s the jump??'].
	self jump: prevPc - pc! !

!InstructionStream methodsFor: 'testing' stamp: 'ClementBera 12/29/2014 12:18'!
willJumpIfFalse
	"Answer whether the next bytecode is a jump-if-false."

	^ self method encoderClass isBranchIfFalseAt: pc in: self method! !

!InstructionStream methodsFor: 'decoding' stamp: 'ClementBera 12/28/2014 17:36'!
interpretSistaV1ExtendedPush: extB for: client 
	"Implement the extended push for non-zero extensions."
	"*	82			01010010			Push thisContext, (then Extend B = 1 => push
	thisProcess) "
	extB = 0
		ifTrue: [^ client pushActiveContext].
	extB = 1
		ifTrue: [^ client pushActiveProcess].
	self error: 'undefined extended push'
! !

!InstructionStream methodsFor: 'decoding' stamp: 'ClementBera 12/28/2014 18:03'!
interpretV3PlusClosureExtension: offset in: method for: client
	| type offset2 byte2 byte3 byte4 |
	offset <= 6 ifTrue: 
		["Extended op codes 128-134"
		byte2 := method at: pc. pc := pc + 1.
		offset <= 2 ifTrue:
			["128-130:  extended pushes and pops"
			type := byte2 // 64.
			offset2 := byte2 \\ 64.
			offset = 0 ifTrue: 
				[type = 0 ifTrue: [^client pushReceiverVariable: offset2].
				type = 1 ifTrue: [^client pushTemporaryVariable: offset2].
				type = 2  ifTrue: [^client pushConstant: (method literalAt: offset2 + 1)].
				type = 3 ifTrue: [^client pushLiteralVariable: (method literalAt: offset2 + 1)]].
			offset = 1 ifTrue: 
				[type = 0 ifTrue: [^client storeIntoReceiverVariable: offset2].
				type = 1 ifTrue: [^client storeIntoTemporaryVariable: offset2].
				type = 2 ifTrue: [self error: 'illegalStore'].
				type = 3 ifTrue: [^client storeIntoLiteralVariable: (method literalAt: offset2 + 1)]].
			offset = 2 ifTrue: 
				[type = 0 ifTrue: [^client popIntoReceiverVariable: offset2].
				type = 1 ifTrue: [^client popIntoTemporaryVariable: offset2].
				type = 2 ifTrue: [self error: 'illegalStore'].
				type = 3  ifTrue: [^client popIntoLiteralVariable: (method literalAt: offset2 + 1)]]].
		"131-134: extended sends"
		offset = 3 ifTrue:  "Single extended send"
			[^client send: (method literalAt: byte2 \\ 32 + 1)
					super: false numArgs: byte2 // 32].
		offset = 4 ifTrue:    "Double extended do-anything"
			[byte3 := method at: pc. pc := pc + 1.
			type := byte2 // 32.
			type = 0 ifTrue: [^client send: (method literalAt: byte3 + 1)
									super: false numArgs: byte2 \\ 32].
			type = 1 ifTrue: [^client send: (method literalAt: byte3 + 1)
									super: true numArgs: byte2 \\ 32].
			type = 2 ifTrue: [^client pushReceiverVariable: byte3].
			type = 3 ifTrue: [^client pushConstant: (method literalAt: byte3 + 1)].
			type = 4 ifTrue: [^client pushLiteralVariable: (method literalAt: byte3 + 1)].
			type = 5 ifTrue: [^client storeIntoReceiverVariable: byte3].
			type = 6 ifTrue: [^client popIntoReceiverVariable: byte3].
			type = 7 ifTrue: [^client storeIntoLiteralVariable: (method literalAt: byte3 + 1)]].
		offset = 5 ifTrue:  "Single extended send to super"
			[^client send: (method literalAt: byte2 \\ 32 + 1)
					super: true numArgs: byte2 // 32].
		offset = 6 ifTrue:   "Second extended send"
			[^client send: (method literalAt: byte2 \\ 64 + 1)
					super: false numArgs: byte2 // 64]].
	offset = 7 ifTrue: [^client doPop].
	offset = 8 ifTrue: [^client doDup].
	offset = 9 ifTrue: [^client pushActiveContext].
	byte2 := method at: pc. pc := pc + 1.
	offset = 10 ifTrue:
		[^byte2 < 128
			ifTrue: [client pushNewArrayOfSize: byte2]
			ifFalse: [client pushConsArrayWithElements: byte2 - 128]].
	byte3 := method at: pc.  pc := pc + 1.
	offset = 11 ifTrue: [^client callPrimitive: byte2 + (byte3 * 256) ].
	offset = 12 ifTrue: [^client pushRemoteTemp: byte2 inVectorAt: byte3].
	offset = 13 ifTrue: [^client storeIntoRemoteTemp: byte2 inVectorAt: byte3].
	offset = 14 ifTrue: [^client popIntoRemoteTemp: byte2 inVectorAt: byte3].
	"offset = 15"
	byte4 := method at: pc.  pc := pc + 1.
	^client
		pushClosureCopyNumCopiedValues: (byte2 bitShift: -4)
		numArgs: (byte2 bitAnd: 16rF)
		blockSize: (byte3 * 256) + byte4! !

!InstructionStream methodsFor: 'decoding' stamp: 'ClementBera 2/25/2015 14:56'!
unusedBytecode: client at: startPC
	^ client unusedBytecode! !

!InstructionStream methodsFor: 'debugger access' stamp: 'eem 6/5/2008 10:45'!
debuggerMap
	^self method debuggerMap! !

!InstructionStream methodsFor: 'scanning' stamp: 'eem 6/16/2008 09:52'!
secondByte
	"Answer the second byte of the current bytecode."

	^self method at: pc + 1! !

!InstructionStream methodsFor: 'scanning' stamp: 'StephaneDucasse 12/22/2010 17:24'!
followingPc
	"Answer the pc of the following bytecode."

	^self nextPc: (self method at: pc)! !

!InstructionStream methodsFor: 'scanning' stamp: 'ajh 7/18/2003 21:32'!
nextInstruction
	"Return the next bytecode instruction as a message that an InstructionClient would understand.  This advances the pc by one instruction."

	^ self interpretNextInstructionFor: MessageCatcher new! !

!InstructionStream methodsFor: 'testing' stamp: 'ClementBera 12/29/2014 12:22'!
willSend
	"Answer whether the next bytecode is a message-send."

	^ self method encoderClass isSendAt: pc in: self method! !

!InstructionStream methodsFor: 'decoding' stamp: 'ajh 7/29/2001 20:45'!
atEnd

	^ pc > self method endPC! !

!InstructionStream methodsFor: 'scanning' stamp: ''!
method
	"Answer the compiled method that supplies the receiver's bytecodes."

	^sender		"method access when used alone (not as part of a context)"! !

!InstructionStream methodsFor: 'testing' stamp: 'ClementBera 12/29/2014 11:57'!
willBlockReturn

	^ self method encoderClass isBlockReturnAt: pc in: self method! !

!InstructionStream methodsFor: 'testing' stamp: 'ClementBera 12/29/2014 12:20'!
willJustPop

	^ self method encoderClass isJustPopAt: pc in: self method! !

!InstructionStream methodsFor: 'testing' stamp: 'ClementBera 12/29/2014 12:23'!
willStore
	"Answer whether the next bytecode is a store or store-pop"

	^ self method encoderClass isStoreAt: pc in: self method! !

!InstructionStream methodsFor: 'scanning' stamp: ''!
followingByte
	"Answer the next bytecode."

	^self method at: pc + 1! !

!InstructionStream methodsFor: 'private' stamp: ''!
method: method pc: startpc

	sender := method. 
	"allows this class to stand alone as a method scanner"
	pc := startpc! !

!InstructionStream methodsFor: 'decoding' stamp: 'ClementBera 12/28/2014 17:36'!
interpretSistaV1JumpIfCond
	"If the instruction at pc is a conditional jump, interpret it, advancing
	the pc,
	and answering the jump distance. Otherwise answer nil."
	"184-191	10111 iii				Pop and Jump 0n True iii +1 (i.e., 1 through 8)
	192-199	11000 iii				Pop and Jump 0n False iii +1 (i.e., 1 through 8)
	*	225/E1		11100001	sbbbbbbb	Extend B (Ext B = Ext B prev * 256
	+ Ext B)
	*	238		11101110	iiiiiiii		Pop and Jump 0n True #iiiiiiii (+ Extend B *
	256, where Extend B >= 0)
	*	239		11101111	iiiiiiii		Pop and Jump 0n False #iiiiiiii (+ Extend B *
	256, where Extend B >= 0)"
	| method byte nextpc extB |
	method := self method.
	"consume and compute any extension first."
	extB := 0.
	nextpc := pc.
	"must not advance pc unless this is a jump."
	[byte := self method at: nextpc.
	nextpc := nextpc + 1.
	byte = 225]
		whileTrue: [| extByte |
			extByte := self method at: nextpc.
			nextpc := nextpc + 1.
			extB := (extB = 0
							and: [extByte > 127])
						ifTrue: [extByte - 256]
						ifFalse: [(extB bitShift: 8)
								+ extByte]].
	(byte between: 184 and: 199)
		ifTrue: [pc := nextpc.
			^ (byte bitAnd: 7)
				+ 1].
	(byte between: 238 and: 239)
		ifTrue: [byte := method at: nextpc.
			pc := nextpc + 1.
			^ (extB bitShift: 8)
				+ byte].
	^ nil
! !

!InstructionStream methodsFor: 'decoding' stamp: 'ClementBEra 4/2/2015 09:44'!
interpretNext2ByteSistaV1Instruction: bytecode for: client extA: extA extB: extB startPC: startPC
	"Send to the argument, client, a message that specifies the next instruction.
	 This method handles the two-byte codes.
	 For a table of the bytecode set, see EncoderForV1's class comment."

	| byte method |
	method := self method.
	byte := self method at: pc.
	pc := pc + 1.
	"We do an inline quasi-binary search on bytecode"
	bytecode < 234 ifTrue: "pushes"
		[bytecode < 231 ifTrue:
			[bytecode < 229 ifTrue:
				[| literal |
				 bytecode = 226 ifTrue:
					[^client pushReceiverVariable: (extA bitShift: 8) + byte].
				 literal := method literalAt: (extA bitShift: 8) + byte + 1.
				 bytecode = 227 ifTrue:
					[^client pushLiteralVariable: literal].
				 ^client pushConstant: literal].
			bytecode = 229 ifTrue:
				[^client pushTemporaryVariable: byte]. 
			^client pushClosureTemps: byte]. 
		bytecode = 231 ifTrue:
			[^byte < 128
				ifTrue: [client pushNewArrayOfSize: byte]
				ifFalse: [client pushConsArrayWithElements: byte - 128]].
		bytecode = 232 ifTrue:
			[^client pushConstant: (extB bitShift: 8) + byte].
		^client pushConstant: (Character value: (extB bitShift: 8) + byte)].
	bytecode < 240 ifTrue: "sends, trap and jump"
		[bytecode < 236 ifTrue: "sends"
			[^client
				send: (method literalAt: (extA bitShift: 5) + (byte // 8) + 1)
				super: bytecode = 235
				numArgs: (extB bitShift: 3) + (byte \\ 8)].
		 bytecode = 236 ifTrue:
			[^client trapIfNotInstanceOf: (method literalAt: (extA bitShift: 8) + byte + 1)].
		bytecode = 237 ifTrue:
			[^client jump: (extB bitShift: 8) + byte].
		 ^client jump: (extB bitShift: 8) + byte if: bytecode = 238].
	bytecode < 243 ifTrue:
		[bytecode = 240 ifTrue:
			[^client popIntoReceiverVariable: (extA bitShift: 8) + byte].
		 bytecode = 241 ifTrue:
			[^client popIntoLiteralVariable: (method literalAt: (extA bitShift: 8) + byte + 1)].
		 ^client popIntoTemporaryVariable: byte].
	bytecode = 243 ifTrue:
		[^client storeIntoReceiverVariable: (extA bitShift: 8) + byte].
	bytecode = 244 ifTrue:
		[^client storeIntoLiteralVariable: (method literalAt: (extA bitShift: 8) + byte + 1)].
	bytecode = 245 ifTrue:
		[^client storeIntoTemporaryVariable: byte].
	"246-247	1111011 i	xxxxxxxx	UNASSIGNED"
	^self unusedBytecode: client at: startPC! !

!InstructionStream methodsFor: 'testing' stamp: 'ClementBera 12/29/2014 12:19'!
willJumpIfTrue 
	"Answer whether the next bytecode is a jump-if-true."
 
	^ self method encoderClass isBranchIfTrueAt: pc in: self method! !

!InstructionStream methodsFor: 'decoding' stamp: 'MarcusDenker 6/13/2012 17:03'!
interpret
	| endPC |
	endPC := self method endPC.
	[pc > endPC] whileFalse: [self interpretNextInstructionFor: self]! !

!InstructionStream methodsFor: 'scanning' stamp: 'ClementBera 12/29/2014 11:50'!
selectorToSendOrSelf
	"If this instruction is a send, answer the selector, otherwise answer self."
 
	^ self method encoderClass selectorToSendOrItselfFor: self in: self method at: pc ! !

!InstructionStream methodsFor: 'scanning' stamp: 'eem 6/16/2008 09:52'!
thirdByte
	"Answer the third byte of the current bytecode."

	^self method at: pc + 2! !

!InstructionStream methodsFor: 'scanning' stamp: 'CamilloBruni 7/17/2013 22:03'!
peekInstruction
	"Return the next bytecode instruction as a message that an InstructionClient would understand.  The pc remains unchanged."

	| currentPc instruction |
	currentPc := self pc.
	instruction := self nextInstruction.
	self pc: currentPc.
	^ instruction! !

!InstructionStream methodsFor: 'decoding' stamp: 'ClementBera 2/25/2015 14:58'!
interpretNextV3PlusClosureInstructionFor: client 
	"Send to the argument, client, a message that specifies the type of the 
	next instruction."

	| byte type offset method |
	method := self method.  
	byte := method at: pc.
	type := byte // 16.  
	offset := byte \\ 16.   
	pc := pc+1.
	"We do an inline binary search on each of the possible 16 values of type:
	The old, cleaner but slowe code is retained as a comment below"
	type < 8
	ifTrue: [type < 4
				ifTrue: [type < 2
						ifTrue: [type < 1
								ifTrue: ["type = 0"
									^ client pushReceiverVariable: offset]
								ifFalse: ["type = 1"
									^ client pushTemporaryVariable: offset]]
						ifFalse: [type < 3
								ifTrue: ["type = 2"
									^ client
										pushConstant: (method literalAt: offset + 1)]
								ifFalse: ["type = 3"
									^ client
										pushConstant: (method literalAt: offset + 17)]]]
				ifFalse: [type < 6
						ifTrue: [type < 5
								ifTrue: ["type = 4"
									^ client
										pushLiteralVariable: (method literalAt: offset + 1)]
								ifFalse: ["type = 5"
									^ client
										pushLiteralVariable: (method literalAt: offset + 17)]]
						ifFalse: [type < 7
								ifTrue: ["type = 6"
									offset < 8
										ifTrue: [^ client popIntoReceiverVariable: offset]
										ifFalse: [^ client popIntoTemporaryVariable: offset - 8]]
								ifFalse: ["type = 7"
									offset = 0
										ifTrue: [^ client pushReceiver].
									offset < 8
										ifTrue: [^ client
												pushConstant: (SpecialConstants at: offset)].
									offset = 8
										ifTrue: [^ client methodReturnReceiver].
									offset < 12
										ifTrue: [^ client
												methodReturnConstant: (SpecialConstants at: offset - 8)].
									offset = 12
										ifTrue: [^ client methodReturnTop].
									offset = 13
										ifTrue: [^ client blockReturnTop].
									offset > 13
										ifTrue: [^ self unusedBytecode: client at: pc - 1 ]]]]]
		ifFalse: [type < 12
				ifTrue: [type < 10
						ifTrue: [type < 9
								ifTrue: ["type = 8"
									^ self
										interpretV3PlusClosureExtension: offset 
										in: method 
										for: client]
								ifFalse: ["type = 9 (short jumps)"
									offset < 8
										ifTrue: [^ client jump: offset + 1].
									^ client jump: offset - 8 + 1 if: false]]
						ifFalse: [type < 11
								ifTrue: ["type = 10 (long jumps)"
									byte := method at: pc.
									pc := pc + 1.
									offset < 8
										ifTrue: [^ client jump: offset - 4 * 256 + byte].
									^ client jump: (offset bitAnd: 3)
											* 256 + byte if: offset < 12]
								ifFalse: ["type = 11"
									^ client
										send: (Smalltalk specialSelectorAt: offset + 1)
										super: false
										numArgs: (Smalltalk specialNargsAt: offset + 1)]]]
				ifFalse: [type = 12
						ifTrue: [^ client
								send: (Smalltalk specialSelectorAt: offset + 17)
								super: false
								numArgs: (Smalltalk specialNargsAt: offset + 17)]
						ifFalse: ["type = 13, 14 or 15"
							^ client
								send: (method literalAt: offset + 1)
								super: false
								numArgs: type - 13]]].


"    old code 
	type=0 ifTrue: [^client pushReceiverVariable: offset].
	type=1 ifTrue: [^client pushTemporaryVariable: offset].
	type=2 ifTrue: [^client pushConstant: (method literalAt: offset+1)].
	type=3 ifTrue: [^client pushConstant: (method literalAt: offset+17)].
	type=4 ifTrue: [^client pushLiteralVariable: (method literalAt: offset+1)].
	type=5 ifTrue: [^client pushLiteralVariable: (method literalAt: offset+17)].
	type=6 
		ifTrue: [offset<8
					ifTrue: [^client popIntoReceiverVariable: offset]
					ifFalse: [^client popIntoTemporaryVariable: offset-8]].
	type=7
		ifTrue: [offset=0 ifTrue: [^client pushReceiver].
				offset<8 ifTrue: [^client pushConstant: (SpecialConstants at: offset)].
				offset=8 ifTrue: [^client methodReturnReceiver].
				offset<12 ifTrue: [^client methodReturnConstant: 
												(SpecialConstants at: offset-8)].
				offset=12 ifTrue: [^client methodReturnTop].
				offset=13 ifTrue: [^client blockReturnTop].
				offset>13 ifTrue: [^self error: 'unusedBytecode']].
	type=8 ifTrue: [^self interpretExtension: offset in: method for: client].
	type=9
		ifTrue:  short jumps
			[offset<8 ifTrue: [^client jump: offset+1].
			^client jump: offset-8+1 if: false].
	type=10 
		ifTrue:  long jumps
			[byte:= method at: pc.  pc:= pc+1.
			offset<8 ifTrue: [^client jump: offset-4*256 + byte].
			^client jump: (offset bitAnd: 3)*256 + byte if: offset<12].
	type=11 
		ifTrue: 
			[^client 
				send: (Smalltalk specialSelectorAt: offset+1) 
				super: false
				numArgs: (Smalltalk specialNargsAt: offset+1)].
	type=12 
		ifTrue: 
			[^client 
				send: (Smalltalk specialSelectorAt: offset+17) 
				super: false
				numArgs: (Smalltalk specialNargsAt: offset+17)].
	type>12
		ifTrue: 
			[^client send: (method literalAt: offset+1) 
					super: false
					numArgs: type-13]"! !

!InstructionStream methodsFor: 'decoding' stamp: 'ClementBera 12/28/2014 18:05'!
interpretV3PlusClosureJump

	| byte |
	byte := self method at: pc.
	(byte between: 144 and: 151) ifTrue:
		[pc := pc + 1. ^byte - 143].
	(byte between: 160 and: 167) ifTrue:
		[pc := pc + 2. ^(byte - 164) * 256 + (self method at: pc - 1)].
	^nil! !

!InstructionStream methodsFor: 'scanning' stamp: ''!
nextByte
	"Answer the next bytecode."

	^self method at: pc! !

!InstructionStream methodsFor: 'private' stamp: 'ClementBera 12/29/2014 11:33'!
nextPc: currentByte
	"Answer the pc of the next bytecode following the current one, given the current bytecode.."

	^ pc + (self method encoderClass bytecodeSize: currentByte)! !

!InstructionStream methodsFor: 'decoding' stamp: 'ClementBera 12/28/2014 18:05'!
interpretV3PlusClosureJumpIfCond

	| byte |
	byte := self method at: pc.
	(byte between: 152 and: 159) ifTrue:
		[pc := pc + 1. ^byte - 151].
	(byte between: 168 and: 175) ifTrue:
		[pc := pc + 2. ^(byte bitAnd: 3) * 256 + (self method at: pc - 1)].
	^nil! !

!InstructionStream methodsFor: 'decoding' stamp: 'ClementBera 12/28/2014 18:13'!
interpretJumpIfCond
	^ self method encoderClass interpretJumpIfCondIn: self
! !

!InstructionStream class methodsFor: 'class initialization' stamp: ''!
initialize
	"Initialize an array of special constants returned by single-bytecode returns."

	SpecialConstants := 
		(Array with: true with: false with: nil)
			, (Array with: -1 with: 0 with: 1 with: 2)	
	"InstructionStream initialize."
! !

!InstructionStream class methodsFor: 'instance creation' stamp: ''!
on: method 
	"Answer an instance of me on the argument, method."

	^self new method: method pc: method initialPC! !

!InstructionStream class methodsFor: 'testing' stamp: 'eem 6/19/2008 10:00'!
isContextClass
	^false! !

!InstructionStream class methodsFor: 'compiling' stamp: 'MarcusDenker 6/9/2014 16:41'!
instVarNamesAndOffsetsDo: aBinaryBlock
	"This is part of the interface between the compiler and a class's instance or field names.
	 We override here to arrange that the compiler will use MaybeContextInstanceVariableNodes
	 for instances variables of Context or any of its superclasses and subclasses.  The
	 convention to make the compiler use the special nodes is to use negative indices"

	| superInstSize |
	(self withAllSubclasses noneSatisfy: [:class|class isContextClass]) ifTrue:
		[^super instVarNamesAndOffsetsDo: aBinaryBlock].
	(superInstSize := superclass notNil ifTrue: [superclass instSize] ifFalse: [0]) > 0 ifTrue:
		[superclass instVarNamesAndOffsetsDo: aBinaryBlock].
	1 to: self instSize - superInstSize do:
		[:i| aBinaryBlock value: (instanceVariables at: i) value: (i + superInstSize) negated]! !

!InstructionStream class methodsFor: '*OpalCompiler-Core' stamp: 'MarcusDenker 7/22/2013 16:09'!
compiler
	"The JIT compiler needs to trap all reads to instance variables of contexts. As this check is costly, it is only done
	in the long form of the bytecodes, which are not used often. In this hierarchy we force the compiler to alwasy generate
	long bytecodes"
	^super compiler options: #(+ optionLongIvarAccessBytecodes)! !

!Integer commentStamp: '<historical>'!
I am a common abstract superclass for all Integer implementations. My implementation subclasses are SmallInteger, LargePositiveInteger, and LargeNegativeInteger.
	
Integer division consists of:
	/	exact division, answers a fraction if result is not a whole integer
	//	answers an Integer, rounded towards negative infinity
	\\	is modulo rounded towards negative infinity
	quo: truncated division, rounded towards zero!
!Integer methodsFor: 'private' stamp: ''!
copyto: x
	| stop |
	stop := self digitLength min: x digitLength.
	^ x replaceFrom: 1 to: stop with: self startingAt: 1! !

!Integer methodsFor: 'enumerating' stamp: ''!
timesRepeat: aBlock 
	"Evaluate the argument, aBlock, the number of times represented by the 
	receiver."

	| count |
	count := 1.
	[count <= self]
		whileTrue: 
			[aBlock value.
			count := count + 1]! !

!Integer methodsFor: '*AsmJit-Extension' stamp: ''!
asAJOperand

	"Convert receiver into operand: a signed immediate"
	^ AJImmediate new ivalue: self! !

!Integer methodsFor: 'printing-numerative' stamp: 'CamilloBruni 10/21/2012 14:48'!
printOn: aStream base: base length: minimum padded: zeroFlag
	| prefix |
	
	prefix := self negative ifTrue: ['-'] ifFalse: [ '' ].
	
	self print: (self abs printStringBase: base) on: aStream prefix: prefix length: minimum padded: zeroFlag
! !

!Integer methodsFor: '*AsmJit-Extension' stamp: ''!
asUImm

	"Convert integer value into an unsigned immediate operand"
	^ AJImmediate new uvalue: self! !

!Integer methodsFor: 'mathematical functions' stamp: 'nice 3/13/2014 02:56'!
nthRoot: aPositiveInteger
	"Answer the nth root of the receiver.
	Answer an Integer if root is exactly this Integer, else answer the Float nearest the exact root."

	| guess p |

	guess := self nthRootRounded: aPositiveInteger.
	(guess raisedTo: aPositiveInteger) = self
		ifTrue: [ ^ guess ].

	p := Float precision - guess highBitOfMagnitude.
	p < 0 ifTrue: [ ^ guess asFloat ].

	guess := self << (p * aPositiveInteger) nthRootRounded: aPositiveInteger.
	^(guess / (1 << p)) asFloat! !

!Integer methodsFor: 'comparing' stamp: 'nice 3/28/2006 23:38'!
< aNumber
	aNumber isInteger ifTrue:
		[self negative == aNumber negative
			ifTrue: [self negative
						ifTrue: [^ (self digitCompare: aNumber) > 0]
						ifFalse: [^ (self digitCompare: aNumber) < 0]]
			ifFalse: [^ self negative]].
	^ aNumber adaptToInteger: self andCompare: #<! !

!Integer methodsFor: 'bit manipulation' stamp: 'sr 3/13/2000 17:47'!
bitXor: n 
	"Answer an Integer whose bits are the logical XOR of the receiver's bits  
	and those of the argument, n."
	| norm |
	<primitive: 'primDigitBitXor' module:'LargeIntegers'>
	norm := n normalize.
	^ self
		digitLogic: norm
		op: #bitXor:
		length: (self digitLength max: norm digitLength)! !

!Integer methodsFor: '*AsmJit-Extension' stamp: ''!
isByte
	^ self >= 0 and: [ self <= 255 ]! !

!Integer methodsFor: 'testing' stamp: 'StephaneDucasse 12/1/2009 14:38'!
sqrtFloor
	"Return the integer part of the square root of self"

	| guess guessSquared delta |
	guess := 1 bitShift: self highBit + 1 // 2.
	[
		guessSquared := guess * guess.
		delta := guessSquared - self // (guess bitShift: 1).
		delta = 0 ] whileFalse: [
			guess := guess - delta ].
	guessSquared = self ifFalse: [ guess := guess - 1 ].
	^guess! !

!Integer methodsFor: 'printing' stamp: 'CamilloBruni 10/21/2012 14:46'!
printOn: aStream showingDecimalPlaces: placesDesired
	"Same as super, but provides a faster implementation because fraction part and rounding are trivial."
	
	self printOn: aStream base: 10.
	
	placesDesired <= 0 ifTrue: [ ^ self ].
	
	aStream nextPut: $..
	placesDesired timesRepeat: [ aStream nextPut: $0 ]! !

!Integer methodsFor: 'mathematical functions' stamp: 'di 4/22/1998 14:45'!
factorial
	"Answer the factorial of the receiver."

	self = 0 ifTrue: [^ 1].
	self > 0 ifTrue: [^ self * (self - 1) factorial].
	self error: 'Not valid for negative integers'! !

!Integer methodsFor: 'printing' stamp: 'nice 6/17/2011 04:10'!
numberOfDigitsInBase: b 
	"Return how many digits are necessary to print this number in base b.
	This does not count any place for minus sign, radix prefix or whatever.
	Note that this algorithm may cost a few operations on LargeInteger."

	| nDigits q total |
	self negative ifTrue: [^self negated numberOfDigitsInBase: b].
	self < b ifTrue: [^1].
	b isPowerOfTwo ifTrue: [^self highBit + b highBit - 2 quo: b highBit - 1].
	
	"A conversion from base 2 to base b has to be performed.
	This algorithm avoids Float computations like (self log: b) floor + 1,
	1) because they are inexact
	2) because LargeInteger might overflow
	3) because this algorithm might be cheaper than conversion"

	q := self.
	total := 0.
	["Make an initial nDigits guess that is lower than or equal to required number of digits"
	nDigits := b = 10
		ifTrue: [((q highBit - 1) * 1233 >> 12) + 1. "This is because (2 log)/(10 log)*4096 is slightly greater than 1233"]
		ifFalse: [q highBit quo: b highBit].
	total := total + nDigits.
	
	"See how many digits remains above these first nDigits guess"
	(q := q quo: (b raisedToInteger: nDigits)) < b] whileFalse.
	^q = 0
		ifTrue: [total]
		ifFalse: [total + 1]! !

!Integer methodsFor: 'arithmetic' stamp: 'CamilloBruni 8/1/2012 15:57'!
// aNumber 
	| q |
	aNumber = 0 ifTrue: [^ (ZeroDivide dividend: self) signal"<- Chg"].
	self = 0 ifTrue: [^ 0].
	q := self quo: aNumber.
	"Refer to the comment in Number|//."
	(q negative
		ifTrue: [q * aNumber ~= self]
		ifFalse: [q = 0 and: [self negative ~= aNumber negative]])
		ifTrue: [^ q - 1"Truncate towards minus infinity."]
		ifFalse: [^ q]! !

!Integer methodsFor: 'arithmetic' stamp: 'bf 9/25/2008 15:13'!
\\\ anInteger 
	"a modulo method for use in DSA. Be careful if you try to use this elsewhere."

	^self \\ anInteger! !

!Integer methodsFor: '*AsmJit-Extension' stamp: ''!
asImm32

	"Convert integer value into a signed immediate operand"
	^ AJImmediate new ivalue: self; size: 4! !

!Integer methodsFor: 'private' stamp: 'sr 6/8/2000 01:28'!
digitDiv: arg neg: ng 
	"Answer with an array of (quotient, remainder)."
	| quo rem ql d div dh dnh dl qhi qlo j l hi lo r3 a t |
	<primitive: 'primDigitDivNegative' module:'LargeIntegers'>
	arg = 0 ifTrue: [^ (ZeroDivide dividend: self) signal].
	"TFEI added this line"
	l := self digitLength - arg digitLength + 1.
	l <= 0 ifTrue: [^ Array with: 0 with: self].
	"shortcut against #highBit"
	d := 8 - arg lastDigit highBitOfPositiveReceiver.
	div := arg digitLshift: d.
	div := div growto: div digitLength + 1.
	"shifts so high order word is >=128"
	rem := self digitLshift: d.
	rem digitLength = self digitLength ifTrue: [rem := rem growto: self digitLength + 1].
	"makes a copy and shifts"
	quo := Integer new: l neg: ng.
	dl := div digitLength - 1.
	"Last actual byte of data"
	ql := l.
	dh := div digitAt: dl.
	dnh := dl = 1
				ifTrue: [0]
				ifFalse: [div digitAt: dl - 1].
	1 to: ql do: 
		[:k | 
		"maintain quo*arg+rem=self"
		"Estimate rem/div by dividing the leading to bytes of rem by dh."
		"The estimate is q = qhi*16+qlo, where qhi and qlo are nibbles."
		j := rem digitLength + 1 - k.
		"r1 := rem digitAt: j."
		(rem digitAt: j)
			= dh
			ifTrue: [qhi := qlo := 15
				"i.e. q=255"]
			ifFalse: 
				["Compute q = (r1,r2)//dh, t = (r1,r2)\\dh.  
				Note that r1,r2 are bytes, not nibbles.  
				Be careful not to generate intermediate results exceeding 13  
				bits."
				"r2 := (rem digitAt: j - 1)."
				t := ((rem digitAt: j)
							bitShift: 4)
							+ ((rem digitAt: j - 1)
									bitShift: -4).
				qhi := t // dh.
				t := (t \\ dh bitShift: 4)
							+ ((rem digitAt: j - 1)
									bitAnd: 15).
				qlo := t // dh.
				t := t \\ dh.
				"Next compute (hi,lo) := q*dnh"
				hi := qhi * dnh.
				lo := qlo * dnh + ((hi bitAnd: 15)
								bitShift: 4).
				hi := (hi bitShift: -4)
							+ (lo bitShift: -8).
				lo := lo bitAnd: 255.
				"Correct overestimate of q.  
				Max of 2 iterations through loop -- see Knuth vol. 2"
				r3 := j < 3
							ifTrue: [0]
							ifFalse: [rem digitAt: j - 2].
				[(t < hi
					or: [t = hi and: [r3 < lo]])
					and: 
						["i.e. (t,r3) < (hi,lo)"
						qlo := qlo - 1.
						lo := lo - dnh.
						lo < 0
							ifTrue: 
								[hi := hi - 1.
								lo := lo + 256].
						hi >= dh]]
					whileTrue: [hi := hi - dh].
				qlo < 0
					ifTrue: 
						[qhi := qhi - 1.
						qlo := qlo + 16]].
		"Subtract q*div from rem"
		l := j - dl.
		a := 0.
		1 to: div digitLength do: 
			[:i | 
			hi := (div digitAt: i)
						* qhi.
			lo := a + (rem digitAt: l) - ((hi bitAnd: 15)
							bitShift: 4) - ((div digitAt: i)
							* qlo).
			rem digitAt: l put: lo - (lo // 256 * 256).
			"sign-tolerant form of (lo bitAnd: 255)"
			a := lo // 256 - (hi bitShift: -4).
			l := l + 1].
		a < 0
			ifTrue: 
				["Add div back into rem, decrease q by 1"
				qlo := qlo - 1.
				l := j - dl.
				a := 0.
				1 to: div digitLength do: 
					[:i | 
					a := (a bitShift: -8)
								+ (rem digitAt: l) + (div digitAt: i).
					rem digitAt: l put: (a bitAnd: 255).
					l := l + 1]].
		quo digitAt: quo digitLength + 1 - k put: (qhi bitShift: 4)
				+ qlo].
	rem := rem
				digitRshift: d
				bytes: 0
				lookfirst: dl.
	^ Array with: quo with: rem! !

!Integer methodsFor: '*AsmJit-Extension' stamp: ''!
asQuadWord
	^ self asTwosComplement: 16rFFFFFFFFFFFFFFFF! !

!Integer methodsFor: '*Keymapping-KeyCombinations' stamp: 'GuillermoPolito 6/28/2013 13:03'!
asShortcut
	^ self asKeyCombination! !

!Integer methodsFor: '*Graphics-Primitives' stamp: 'ar 10/31/1998 23:04'!
asColorOfDepth: d
	"Return a color value representing the receiver as color of the given depth"
	^Color colorFromPixelValue: self depth: d! !

!Integer methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
metacelloIntegerLessThanSelf: anInteger

	^anInteger < self! !

!Integer methodsFor: 'converting' stamp: 'ls 5/26/1998 20:53'!
asHexDigit
	^'0123456789ABCDEF' at: self+1! !

!Integer methodsFor: '*AsmJit-Extension' stamp: ''!
asUImm32

	"Convert integer value into an unsigned immediate operand"
	^ AJImmediate new uvalue: self; size: 4! !

!Integer methodsFor: 'converting-arrays' stamp: 'PeterHugossonMiller 9/3/2009 10:00'!
asArray

	| stream |
	stream := Array new writeStream.
	self digitLength to: 1 by: -1 do: [:digitIndex |
		stream nextPut: (self digitAt: digitIndex)].
	^ stream contents
! !

!Integer methodsFor: 'private' stamp: 'StephaneDucasse 2/12/2012 14:57'!
montgomeryTimes: a modulo: m mInvModB: mInv
	"Answer the result of a Montgomery multiplication
	self * a * (256 raisedTo: m digitLength) inv \\ m
	NOTE: it is assumed that:
	self digitLength <= m digitLength
	a digitLength <= m digitLength
	mInv * m \\ 256 = (-1 \\ 256) = 255 (this implies m odd)
	
	Answer nil in case of absent plugin or other failure."
	
	<primitive: 'primMontgomeryTimesModulo' module:'LargeIntegers'>
	^nil! !

!Integer methodsFor: 'truncation and round off' stamp: 'lr 11/4/2003 12:14'!
atRandom
	"Answer a random integer from 1 to self.  This implementation uses a
	shared generator. Heavy users should their own implementation or use
	Interval>atRandom: directly."

	self = 0 ifTrue: [ ^0 ].
	self < 0 ifTrue: [ ^self negated atRandom negated ].
	^Collection mutexForPicking critical: [
		self atRandom: Collection randomForPicking ]! !

!Integer methodsFor: 'comparing' stamp: 'nice 1/4/2009 17:35'!
>= aNumber
	aNumber isInteger ifTrue:
		[self negative == aNumber negative
			ifTrue: [self negative
						ifTrue: [^(self digitCompare: aNumber) <= 0]
						ifFalse: [^(self digitCompare: aNumber) >= 0]]
			ifFalse: [^ aNumber negative]].
	^ aNumber adaptToInteger: self andCompare: #>=! !

!Integer methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
metacelloVersionComponentLessThan: aMetacelloVersonComponent

	^aMetacelloVersonComponent metacelloIntegerLessThanSelf: self! !

!Integer methodsFor: '*Keymapping-KeyCombinations' stamp: 'CamilloBruni 3/18/2011 23:14'!
shift
	^ KMModifier shift + self! !

!Integer methodsFor: 'truncation and round off' stamp: ''!
normalize 
	"SmallInts OK; LgInts override"
	^ self! !

!Integer methodsFor: 'converting' stamp: 'brp 5/13/2003 10:12'!
asYear

 	^ Year year: self  ! !

!Integer methodsFor: 'bit manipulation' stamp: 'nice 3/21/2008 21:47'!
bitAt: anInteger
	"Answer 1 if the bit at position anInteger is set to 1, 0 otherwise.
	self is considered an infinite sequence of bits, so anInteger can be any strictly positive integer.
	Bit at position 1 is the least significant bit.
	Negative numbers are in two-complements.
	
	This is a naive implementation that can be refined in subclass for speed"
	
	^(self bitShift: 1 - anInteger) bitAnd: 1! !

!Integer methodsFor: 'arithmetic' stamp: ''!
alignedTo: anInteger
	"Answer the smallest number not less than receiver that is a multiple of anInteger."

	^(self+anInteger-1//anInteger)*anInteger

"5 alignedTo: 2"
"12 alignedTo: 3"! !

!Integer methodsFor: 'benchmarks' stamp: 'di 4/11/1999 11:20'!
benchmark  "Handy bytecode-heavy benchmark"
	"(500000 // time to run) = approx bytecodes per second"
	"5000000 // (Time millisecondsToRun: [10 benchmark]) * 1000"
	"3059000 on a Mac 8100/100"
    | size flags prime k count |
    size := 8190.
    1 to: self do:
        [:iter |
        count := 0.
        flags := (Array new: size) atAllPut: true.
        1 to: size do:
            [:i | (flags at: i) ifTrue:
                [prime := i+1.
                k := i + prime.
                [k <= size] whileTrue:
                    [flags at: k put: false.
                    k := k + prime].
                count := count + 1]]].
    ^ count! !

!Integer methodsFor: 'accessing' stamp: 'CamilloBruni 10/21/2012 14:07'!
decimalDigitAt: anExponent
	^ self digitAt: anExponent base: 10! !

!Integer methodsFor: 'converting-arrays' stamp: 'StephaneDucasse 10/17/2009 17:15'!
asByteArrayOfSize: aSize 
	"Answer a ByteArray of aSize with my value, most-significant byte first."
	| answer digitPos |
	aSize < self digitLength ifTrue: [ self error: 'number to large for byte array' ].
	answer := ByteArray new: aSize.
	digitPos := 1.
	aSize 
		to: aSize - self digitLength + 1
		by: -1
		do: 
			[ :pos | 
			answer 
				at: pos
				put: (self digitAt: digitPos).
			digitPos := digitPos + 1 ].
	^ answer! !

!Integer methodsFor: 'system primitives' stamp: ''!
replaceFrom: start to: stop with: replacement startingAt: repStart
	| j |  "Catches failure if LgInt replace primitive fails"
	j := repStart.
	start to: stop do:
		[:i |
		self digitAt: i put: (replacement digitAt: j).
		j := j+1]! !

!Integer methodsFor: 'private' stamp: ''!
digitRshift: anInteger bytes: b lookfirst: a 
	 "Shift right 8*b+anInteger bits, 0<=n<8.
	Discard all digits beyond a, and all zeroes at or below a."
	| n x r f m digit count i |
	n := 0 - anInteger.
	x := 0.
	f := n + 8.
	i := a.
	m := 255 bitShift: 0 - f.
	digit := self digitAt: i.
	[((digit bitShift: n) bitOr: x) = 0 and: [i ~= 1]] whileTrue:
		[x := digit bitShift: f "Can't exceed 8 bits".
		i := i - 1.
		digit := self digitAt: i].
	i <= b ifTrue: [^Integer new: 0 neg: self negative].  "All bits lost"
	r := Integer new: i - b neg: self negative.
	count := i.
	x := (self digitAt: b + 1) bitShift: n.
	b + 1 to: count do:
		[:j | digit := self digitAt: j + 1.
		r digitAt: j - b put: (((digit bitAnd: m) bitShift: f) bitOr: x) 
			"Avoid values > 8 bits".
		x := digit bitShift: n].
	^r! !

!Integer methodsFor: 'bit manipulation' stamp: ''!
bitInvert32
	"Answer the 32-bit complement of the receiver."

	^ self bitXor: 16rFFFFFFFF! !

!Integer methodsFor: 'printing-numerative' stamp: 'nice 2/15/2008 21:44'!
printOn: aStream base: b nDigits: n 
	"Append a representation of this number in base b on aStream using nDigits.
	self must be positive."

	self subclassResponsibility! !

!Integer methodsFor: 'private' stamp: 'sr 1/23/2000 05:43'!
digitCompare: arg 
	"Compare the magnitude of self with that of arg.   
	Return a code of 1, 0, -1 for self >, = , < arg"
	| len arglen argDigit selfDigit |
	<primitive: 'primDigitCompare' module:'LargeIntegers'>
	len := self digitLength.
	(arglen := arg digitLength) ~= len
		ifTrue: [arglen > len
				ifTrue: [^ -1]
				ifFalse: [^ 1]].
	[len > 0]
		whileTrue: 
			[(argDigit := arg digitAt: len) ~= (selfDigit := self digitAt: len)
				ifTrue: [argDigit < selfDigit
						ifTrue: [^ 1]
						ifFalse: [^ -1]].
			len := len - 1].
	^ 0! !

!Integer methodsFor: 'arithmetic' stamp: 'nice 3/15/2014 16:24'!
reciprocalModulo: n
	"Answer an integer x such that (self * x) \\ n = 1, x > 0, x < n.
	Raise an error if there is no such integer.
	The algorithm is a non extended euclidean modular inversion called NINV.
	It is described in this article:
		'Using an RSA Accelerator for Modular Inversion'
	by Martin Seysen. See http://www.iacr.org/archive/ches2005/017.pdf"

	| u v f fPlusN b result result2 |
	((self <= 0) or: [n <= 0]) ifTrue: [self error: 'self and n must be greater than zero'].
	self >= n ifTrue: [self error: 'self must be < n'].

	b := n highBit + 1.
	f := 1 bitShift: b.
	v := (self bitShift: b) + 1.
	u := n bitShift: b.
	fPlusN := f + n.
	[v >= fPlusN] whileTrue:
		[v := u \\ (u := v)].
	result := v - f.
	(result2 := result + n) > 0
		ifFalse: [self error: 'no inverse'].
	^result positive
		ifTrue: [result]
		ifFalse: [result2]! !

!Integer methodsFor: 'private' stamp: 'nice 3/15/2014 16:25'!
slidingLeftRightRaisedTo: n modulo: m
	"Private - compute (self raisedTo: n) \\ m,
	Note: this method has to be fast because it is generally used with large integers in cryptography.
	It thus operate on exponent bits from left to right by packets with a sliding window rather than bit by bit (see below)."
	
	| pow j k w index oddPowersOfSelf square |
	
	"Precompute powers of self for odd bit patterns xxxx1 up to length w + 1.
	The width w is chosen with respect to the total bit length of n,
	such that each bit pattern will on average be encoutered P times in the whole bit sequence of n.
	This costs (2 raisedTo: w) multiplications, but more will be saved later (see below)."
	k := n highBit.
	w := (k highBit - 1 >> 1 min: 16) max: 1.
	oddPowersOfSelf := Array new: 1 << w.
	oddPowersOfSelf at: 1 put: (pow := self).
	square := self * self \\ m.
	2 to: oddPowersOfSelf size do: [:i | pow := oddPowersOfSelf at: i put: pow * square \\ m].
	
	"Now exponentiate by searching precomputed bit patterns with a sliding window"
	pow := 1.
	[k > 0]
		whileTrue:
			[pow := pow * pow \\ m.
			"Skip bits set to zero (the sliding window)"
			(n bitAt: k) = 0
				ifFalse:
					["Find longest odd bit pattern up to window length (w + 1)"
					j := k - w max: 1.
					[j < k and: [(n bitAt: j) = 0]] whileTrue: [j := j + 1].
					"We found an odd bit pattern of length k-j+1;
					perform the square powers for each bit
					(same cost as bitwise algorithm);
					compute the index of this bit pattern in the precomputed powers."
					index := 0.
					[k > j] whileTrue:
						[pow := pow * pow \\ m.
						index := index << 1 + (n bitAt: k).
						k := k - 1].
					"Perform a single multiplication for the whole bit pattern.
					This saves up to (k-j) multiplications versus a naive algorithm operating bit by bit"
					pow := pow * (oddPowersOfSelf at: index + 1) \\ m].
			k := k - 1].
	^pow normalize! !

!Integer methodsFor: '*Keymapping-KeyCombinations' stamp: 'GuillermoPolito 5/31/2011 18:26'!
command
	^ KMModifier command + self! !

!Integer methodsFor: 'converting-arrays' stamp: 'PeterHugossonMiller 9/3/2009 10:01'!
asByteArray

	| stream |
	stream := ByteArray new writeStream.
	self digitLength to: 1 by: -1 do: [:digitIndex |
		stream nextPut: (self digitAt: digitIndex)].
	^ stream contents
! !

!Integer methodsFor: '*metacello-core' stamp: 'dkh 6/21/2012 20:47'!
metacelloSemanticVersionComponentLessThan: aMetacelloVersonComponent
    ^ aMetacelloVersonComponent metacelloSemanticIntegerLessThanSelf: self! !

!Integer methodsFor: 'bit manipulation' stamp: 'sr 6/9/2000 10:09'!
bitShift: shiftCount 
	"Answer an Integer whose value (in twos-complement representation) is  
	the receiver's value (in twos-complement representation) shifted left by 
	the number of bits indicated by the argument. Negative arguments  
	shift right. Zeros are shifted in from the right in left shifts."
	| magnitudeShift |
	magnitudeShift := self bitShiftMagnitude: shiftCount.
	^ ((self negative and: [shiftCount negative])
		and: [self anyBitOfMagnitudeFrom: 1 to: shiftCount negated])
		ifTrue: [magnitudeShift - 1]
		ifFalse: [magnitudeShift]! !

!Integer methodsFor: 'printing' stamp: 'tk 4/1/2002 11:30'!
asWords
	"SmallInteger maxVal asWords"
	| mils minus three num answer milCount |
	self = 0 ifTrue: [^'zero'].
	mils := #('' ' thousand' ' million' ' billion' ' trillion' ' quadrillion' ' quintillion' ' sextillion' ' septillion' ' octillion' ' nonillion' ' decillion' ' undecillion' ' duodecillion' ' tredecillion' ' quattuordecillion' ' quindecillion' ' sexdecillion' ' septendecillion' ' octodecillion' ' novemdecillion' ' vigintillion').
	num := self.
	minus := ''.
	self < 0 ifTrue: [
		minus := 'negative '.
		num := num negated.
	].
	answer := String new.
	milCount := 1.
	[num > 0] whileTrue: [
		three := (num \\ 1000) threeDigitName.
		num := num // 1000.
		three isEmpty ifFalse: [
			answer isEmpty ifFalse: [
				answer := ', ',answer
			].
			answer := three,(mils at: milCount),answer.
		].
		milCount := milCount + 1.
	].
	^minus,answer! !

!Integer methodsFor: 'testing' stamp: 'StephaneDucasse 11/1/2009 22:37'!
isMostLikelyPrime
	"See isProbablyPrimeWithK:andQ: for the algoritm description."
	| k q |
	self <= 1 ifTrue: [^self error: 'operation undefined'].
	self even ifTrue: [^self = 2].
	k := 1.

	q := self - 1 bitShift: -1.
	[q odd] whileFalse: 
			[q := q bitShift: -1.
			k := k + 1].
	
	25 timesRepeat: [(self isProbablyPrimeWithK: k andQ: q) ifFalse: [^false]].
	^true! !

!Integer methodsFor: 'arithmetic' stamp: 'nice 3/11/2013 08:12'!
+ aNumber
	"Refer to the comment in Number + "
	aNumber isInteger ifTrue:
		[self negative == aNumber negative
			ifTrue: [^ (self digitAdd: aNumber) normalize]
			ifFalse: [^ self digitSubtract: aNumber]].
	aNumber isFraction ifTrue:
		[^Fraction numerator: self * aNumber denominator + aNumber numerator denominator: aNumber denominator].
	^ aNumber adaptToInteger: self andSend: #+! !

!Integer methodsFor: 'bit manipulation' stamp: 'adrian-lienhard 5/18/2009 20:35'!
<< shiftAmount
	"left shift"
	
	shiftAmount < 0 ifTrue: [self error: 'negative arg'].
	^ self bitShift: shiftAmount! !

!Integer methodsFor: 'converting' stamp: ''!
asInteger
	"Answer with the receiver itself."

	^self

! !

!Integer methodsFor: '*FileSystem-Core' stamp: 'CamilloBruni 7/10/2012 22:12'!
humanReadableSIByteSize
	^ String streamContents: [ :s|
		self humanReadableSIByteSizeOn: s ]! !

!Integer methodsFor: 'mathematical functions' stamp: 'nice 3/11/2014 01:55'!
nthRootRounded: aPositiveInteger
	"Answer the integer nearest the nth root of the receiver."
	| guess |
	self = 0 ifTrue: [^0].
	self negative
		ifTrue:
			[aPositiveInteger even ifTrue: [ ArithmeticError signal: 'Negative numbers don''t have even roots.' ].
			^(self negated nthRootRounded: aPositiveInteger) negated].
	guess := self nthRootTruncated: aPositiveInteger.
	^self * 2 > ((guess + 1 raisedTo: aPositiveInteger) + (guess raisedTo: aPositiveInteger))
		ifTrue: [guess + 1]
		ifFalse: [guess]! !

!Integer methodsFor: 'printing' stamp: 'nice 2/15/2008 21:49'!
printString
	"For Integer, prefer the stream version to the string version for efficiency"
	
	^String streamContents: [:str | self printOn: str base: 10]! !

!Integer methodsFor: 'testing' stamp: 'StephaneDucasse 2/4/2012 16:58'!
isPrime
	"Answer true if the receiver is a prime number. See isProbablyPrime for a probabilistic
	implementation that is much faster for large integers, and that is correct to an extremely
	high statistical level of confidence (effectively deterministic)."
	
	self <= 1 ifTrue: [ ^false ].
	self even ifTrue: [ ^self = 2].
	3 to: self sqrtFloor by: 2 do: [ :each |
		self \\ each = 0 ifTrue: [ ^false ] ].
	^true! !

!Integer methodsFor: 'printing' stamp: 'nice 2/15/2008 21:49'!
printOn: aStream
	^self printOn: aStream base: 10! !

!Integer methodsFor: 'bit manipulation' stamp: 'StephaneDucasse 2/19/2010 15:14'!
bitAt: anInteger put: value
	"Answer a new Integer that has the bit of rank anInteger set to value.
	The bit value should be 0 or 1, otherwise raise an Error.
	The bits are indexed starting at 1 for the least significant bit.
	For negative integers, operate on 2-complement representation."
	
	| b |
	b := self bitAt: anInteger.
	b = value ifTrue: [^self].
	0 = value ifTrue: [^self bitAnd: (1 bitShift: anInteger - 1) bitInvert].
	1 = value ifTrue: [^self bitOr: (1 bitShift: anInteger - 1)].
	self error: 'bit value should be 0 or 1'! !

!Integer methodsFor: 'converting' stamp: 'nice 2/13/2010 22:46'!
asScaledDecimal
	"The number of significant digits of the answer is the same as the number of decimal digits in the receiver."
	^ ScaledDecimal newFromNumber: self scale: 0! !

!Integer methodsFor: 'printing' stamp: 'CamilloBruni 10/21/2012 13:52'!
printPaddedWith: aCharacter to: anInteger base: aRadix 
	"Answer the string containing the ASCII representation of the receiver 
	padded on the left with aCharacter to be at least anInteger characters."
	| aStream padding digits |
	
	aStream := (String new: 10) writeStream.
	self
		printOn: aStream
		base: aRadix
		showRadix: false.
	digits := aStream contents.
	padding := anInteger - digits size.
	padding > 0 ifFalse: [^ digits].
	^ ((String new: padding) atAllPut: aCharacter;
	 yourself) , digits! !

!Integer methodsFor: 'printing-numerative' stamp: 'StephaneDucasse 7/31/2010 19:45'!
printStringHex
	"returns the hex digit part of the integer when printed in hexadecimal format.
	30 printStringHex 
		'1E'
	30 hex
		 '16r1E' "
		
	^self printStringBase: 16! !

!Integer methodsFor: 'printing-numerative' stamp: 'CamilloBruni 10/21/2012 14:47'!
storeStringBase: base length: minimum padded: zeroFlag
	^String streamContents: [:s| 
		self storeOn: s base: base length: minimum padded: zeroFlag ]! !

!Integer methodsFor: 'printing-numerative' stamp: 'PeterHugossonMiller 9/3/2009 10:01'!
printStringRoman
	| stream integer |
	stream := String new writeStream.
	integer := self negative ifTrue: [stream nextPut: $-. self negated] ifFalse: [self].
	integer // 1000 timesRepeat: [stream nextPut: $M].
	integer
		romanDigits: 'MDC' for: 100 on: stream;
		romanDigits: 'CLX' for: 10 on: stream;
		romanDigits: 'XVI' for: 1 on: stream.
	^stream contents! !

!Integer methodsFor: 'accessing' stamp: 'CamilloBruni 10/21/2012 14:24'!
decimalDigitLength
	^ self numberOfDigitsInBase: 10! !

!Integer methodsFor: 'printing' stamp: 'CamilloBruni 10/21/2012 13:59'!
printWithCommasOn: aStream
	"123456789 asStringWithCommas"
	"-123456789 asStringWithCommas"
	^ self printSeparatedBy: $, every: 3 signed: false on: aStream! !

!Integer methodsFor: 'bit manipulation' stamp: 'CamilloBruni 3/27/2012 17:18'!
| aNumber
	^ self bitOr: aNumber! !

!Integer methodsFor: 'truncation and round off' stamp: 'HenrikSperreJohansen 1/19/2012 11:41'!
asLargerPowerOfTwo
	"Convert the receiver into a power of two which is not less than the receiver"
	^self isPowerOfTwo
		ifTrue:[self]
		ifFalse:[self > 0 ifTrue: [	1 bitShift: (self highBit)]
						ifFalse: [DomainError signal: 'Value outside (0 , infinity)' from: 0]]! !

!Integer methodsFor: 'printing' stamp: 'CamilloBruni 10/21/2012 13:51'!
printStringRadix: baseInteger 
	"Return a string containing a sequence of characters that represents the 
	numeric value of the receiver in the radix specified by the argument.  
	If the receiver is negative, a minus sign ('-') is prepended to the 
	sequence of characters. 
	The result is undefined if baseInteger less than 2 or greater than 36."
	
	| tempString |
	
	baseInteger = 10
		ifTrue: [
			tempString := self storeStringBase: baseInteger.
			self negative
				ifTrue: [^ '-10r' , (tempString copyFrom: 2 to: tempString size)]
				ifFalse: [^ '10r' , tempString]].
			
	^ self storeStringBase: baseInteger! !

!Integer methodsFor: 'mathematical functions' stamp: 'nice 10/29/2011 15:00'!
sqrt
	"Answer the square root of the receiver."

	| selfAsFloat floatResult guess |
	selfAsFloat := self asFloat.
	floatResult := selfAsFloat sqrt.

	floatResult isInfinite ifFalse: [
		guess := floatResult truncated.

		"If got an exact answer, answer it. Otherwise answer float approximate answer."
		guess squared = self
			ifTrue: [ ^ guess ]].

	"In this case, maybe it failed because we are such a big integer that the Float method becomes
	inexact, even if we are a whole square number. So, try the slower but more general method"
	selfAsFloat >= Float maxExactInteger asFloat squared
		ifTrue: [
			guess := self sqrtFloor.
			guess squared = self ifTrue: [
				^guess ].
			
			"Nothing else can be done. No exact answer means answer must be a Float.
			Answer the best we have which is the rounded sqrt."
			guess := (self * 4) sqrtFloor.
			^(guess // 2 + (guess \\ 2)) asFloat].

	"We need an approximate result"
	^floatResult! !

!Integer methodsFor: 'bit manipulation' stamp: ''!
anyMask: mask 
	"Treat the argument as a bit mask. Answer whether any of the bits that 
	are 1 in the argument are 1 in the receiver."

	^0 ~= (self bitAnd: mask)! !

!Integer methodsFor: 'printing' stamp: ''!
isLiteral

	^true! !

!Integer methodsFor: 'bit manipulation' stamp: 'sr 6/9/2000 14:02'!
bitShiftMagnitude: shiftCount 
	"Answer an Integer whose value (in magnitude representation) is  
	the receiver's value (in magnitude representation) shifted left by  
	the number of bits indicated by the argument. Negative arguments
	shift right. Zeros are shifted in from the right in left shifts."
	| rShift |
	<primitive: 'primDigitBitShiftMagnitude' module:'LargeIntegers'>
	shiftCount >= 0 ifTrue: [^ self digitLshift: shiftCount].
	rShift := 0 - shiftCount.
	^ (self
		digitRshift: (rShift bitAnd: 7)
		bytes: (rShift bitShift: -3)
		lookfirst: self digitLength) normalize! !

!Integer methodsFor: '*Files' stamp: 'cmm 2/15/2010 15:52'!
asBytesDescription
	"Answer a terse, easily-readable representation of this Integer reprsenting a number of bytes.  Useful for file-browsers."
	| suffixes |
	suffixes := { 'k'"ilobytes". 'M'"egabytes". 'G'"igabytes". 'T'"erabytes". 'P'"etabytes". 'E'"xabytes". 'Z'"ettabytes". 'Y'"ottabytes"}.
	suffixes size to: 1 by: -1 do:
		[ : index |  | units |
		units := 1000 raisedTo: index.
		self > units ifTrue: [ ^ ((self / units) asFloat roundTo: 0.01) asString, (suffixes at: index) ] ].
	^ self asString! !

!Integer methodsFor: 'accessing' stamp: 'CamilloBruni 10/21/2012 14:30'!
digitAt: anExponent base: base
	^ self // (base raisedToInteger: anExponent - 1) \\ base! !

!Integer methodsFor: 'benchmarks' stamp: 'adrian-lienhard 5/18/2009 20:33'!
tinyBenchmarks
	"Report the results of running the two tiny Squeak benchmarks.
	ar 9/10/1999: Adjusted to run at least 1 sec to get more stable results"
	"0 tinyBenchmarks"
	"On a 292 MHz G3 Mac: 22727272 bytecodes/sec; 984169 sends/sec"
	"On a 400 MHz PII/Win98:  18028169 bytecodes/sec; 1081272 sends/sec"
	| t1 t2 r n1 n2 |
	n1 := 1.
	[t1 := Time millisecondsToRun: [n1 benchmark].
	t1 < 1000] whileTrue:[n1 := n1 * 2]. "Note: #benchmark's runtime is about O(n)"

	n2 := 28.
	[t2 := Time millisecondsToRun: [r := n2 benchFib].
	t2 < 1000] whileTrue:[n2 := n2 + 1]. "Note: #benchFib's runtime is about O(n^2)."

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

!Integer methodsFor: 'printing' stamp: 'MPW 1/1/1901 00:14'!
destinationBuffer:digitLength
  digitLength <= 1
		ifTrue: [self]
		ifFalse: [LargePositiveInteger new: digitLength].! !

!Integer methodsFor: 'bit manipulation' stamp: 'sr 6/8/2000 01:55'!
highBitOfMagnitude
	"Answer the index of the high order bit of the magnitude of the  
	receiver, or zero if the receiver is zero."
	^ self subclassResponsibility! !

!Integer methodsFor: '*Keymapping-KeyCombinations' stamp: 'GuillermoPolito 3/19/2013 20:28'!
asKeyCombination
	^ KMSingleKeyCombination from: self asCharacter! !

!Integer methodsFor: 'printing-numerative' stamp: 'laza 3/29/2004 13:36'!
storeOn: aStream base: base
	"Print a representation of the receiver on the stream
	<aStream> in base <base> where
	2 <= <baseInteger> <= 16. If <base> is other than 10
	it is written first separated by $r followed by the number
	like for example: 16rFCE2"

	| integer |
	integer := self negative
		ifTrue: [aStream nextPut: $-. self negated]
		ifFalse: [self].
	base = 10 ifFalse: [aStream nextPutAll: base printString; nextPut: $r].
	aStream nextPutAll: (integer printStringBase: base).
! !

!Integer methodsFor: 'printing' stamp: 'CamilloBruni 10/21/2012 13:50'!
asStringWithCommasSigned
	"123456789 asStringWithCommasSigned"
	"-123456789 asStringWithCommasSigned"
	^ String streamContents: [:stream | 
		self printWithCommasSignedOn: stream ]! !

!Integer methodsFor: 'comparing' stamp: 'nice 3/28/2006 23:41'!
= aNumber
	aNumber isNumber ifFalse: [^ false].
	aNumber isInteger ifTrue:
		[aNumber negative == self negative
			ifTrue: [^ (self digitCompare: aNumber) = 0]
			ifFalse: [^ false]].
	^ aNumber adaptToInteger: self andCompare: #=! !

!Integer methodsFor: 'printing' stamp: 'MPW 1/1/1901 00:16'!
digitBuffer:digitLength
  ^Array new:digitLength*8.! !

!Integer methodsFor: 'private' stamp: 'StephaneDucasse 2/12/2012 14:57'!
montgomeryRaisedTo: n times: y modulo: m mInvModB: mInv
	"Private - do a Montgomery exponentiation of self modulo m.
	The operation is equivalent to (self/y raisedTo: n)*y \\ m,
	with y is (256 raisedTo: m digitLength),
	with (m bitAnd: 255) * mInv \\ 256 = 255."
	
	| pow j k w index oddPowersOfSelf square |
	
	"Precompute powers of self for odd bit patterns xxxx1 up to length w + 1.
	The width w is chosen with respect to the total bit length of n,
	such that each bit pattern will on average be encoutered P times in the whole bit sequence of n.
	This costs (2 raisedTo: w) multiplications, but more will be saved later (see below)."
	k := n highBit.
	w := (k highBit - 1 >> 1 min: 16) max: 1.
	oddPowersOfSelf := Array new: 1 << w.
	oddPowersOfSelf at: 1 put: (pow := self).
	square := self montgomeryTimes: self modulo: m mInvModB: mInv.
	2 to: oddPowersOfSelf size do: [:i | pow := oddPowersOfSelf at: i put: (pow montgomeryTimes: square modulo: m mInvModB: mInv)].
	
	"Now exponentiate by searching precomputed bit patterns with a sliding window"
	pow := y.
	[k > 0]
		whileTrue:
			[pow := pow montgomeryTimes: pow modulo: m mInvModB: mInv.
			"Skip bits set to zero (the sliding window)"
			(n bitAt: k) = 0
				ifFalse:
					["Find longest odd bit pattern up to window length (w + 1)"
					j := k - w max: 1.
					[j < k and: [(n bitAt: j) = 0]] whileTrue: [j := j + 1].
					"We found a bit pattern of length k-j+1;
					perform the square powers for each bit
					(same cost as bitwise algorithm);
					compute the index of this bit pattern in the precomputed powers."
					index := 0.
					[k > j] whileTrue:
						[pow := pow montgomeryTimes: pow modulo: m mInvModB: mInv.
						index := index << 1 + (n bitAt: k).
						k := k - 1].
					"Perform a single multiplication for the whole bit pattern.
					This saves up to (k-j) multiplications versus a naive algorithm operating bit by bit"
					pow := pow montgomeryTimes: (oddPowersOfSelf at: index + 1) modulo: m mInvModB: mInv].
			k := k - 1].
	^pow! !

!Integer methodsFor: 'bit manipulation' stamp: ''!
noMask: mask 
	"Treat the argument as a bit mask. Answer whether none of the bits that 
	are 1 in the argument are 1 in the receiver."

	^0 = (self bitAnd: mask)! !

!Integer methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 3/5/2014 22:15'!
printSeparatedBy: aDelimiter every: offset signed: printSigned base: base on: aStream
	| digits |
	digits := self abs printStringBase: base.
	
	self sign = -1 
		ifTrue: [ aStream nextPut: $- ] 
		ifFalse: [ printSigned ifTrue: [ aStream nextPut: $+ ] ].
	
	1 to: digits size do: [ :i | 
		aStream nextPut: (digits at: i).
		(i < digits size and: [ (i - digits size) \\ offset = 0 ])
			ifTrue: [ aStream nextPut: aDelimiter ] ]! !

!Integer methodsFor: '*FileSystem-Core' stamp: 'CamilloBruni 7/10/2012 22:26'!
humanReadableSIByteSizeOn: s
	| exponent base |
	"Print a string with an SI binary unit represation of myself."
	base := 1000.
	self < base
		ifTrue: [ ^ s print: self; space; nextPut: $B ].
	exponent := (self log / base log) asInteger.
	(self / (base ** exponent)) printOn: s showingDecimalPlaces: 2.
	s 
		space;
		nextPut: ('kMGTPE' at: exponent);
		nextPut: $B.! !

!Integer methodsFor: '*AsmJit-Extension' stamp: ''!
asDoubleWord
	^ self asTwosComplement: 16rFFFFFFFF! !

!Integer methodsFor: 'private' stamp: 'sr 6/8/2000 01:30'!
digitLshift: shiftCount 
	| carry rShift mask len result digit byteShift bitShift highBit |
	(highBit := self highBitOfMagnitude) = 0 ifTrue: [^ 0].
	len := highBit + shiftCount + 7 // 8.
	result := Integer new: len neg: self negative.
	byteShift := shiftCount // 8.
	bitShift := shiftCount \\ 8.
	bitShift = 0 ifTrue: ["Fast version for byte-aligned shifts"
		^ result
			replaceFrom: byteShift + 1
			to: len
			with: self
			startingAt: 1].
	carry := 0.
	rShift := bitShift - 8.
	mask := 255 bitShift: 0 - bitShift.
	1 to: byteShift do: [:i | result digitAt: i put: 0].
	1 to: len - byteShift do: 
		[:i | 
		digit := self digitAt: i.
		result digitAt: i + byteShift put: (((digit bitAnd: mask)
				bitShift: bitShift)
				bitOr: carry).
		carry := digit bitShift: rShift].
	^ result! !

!Integer methodsFor: 'arithmetic' stamp: 'di 11/6/1998 13:59'!
* aNumber
	"Refer to the comment in Number * " 
	aNumber isInteger ifTrue:
		[^ self digitMultiply: aNumber 
					neg: self negative ~~ aNumber negative].
	^ aNumber adaptToInteger: self andSend: #*! !

!Integer methodsFor: 'bit manipulation' stamp: ''!
allMask: mask 
	"Treat the argument as a bit mask. Answer whether all of the bits that 
	are 1 in the argument are 1 in the receiver."

	^mask = (self bitAnd: mask)! !

!Integer methodsFor: 'system primitives' stamp: 'tk 3/24/1999 20:26'!
lastDigit
	"Answer the last digit of the integer base 256.  LargePositiveInteger uses bytes of base two number, and each is a 'digit'."

	^self digitAt: self digitLength! !

!Integer methodsFor: 'mathematical functions' stamp: 'StephaneDucasse 2/12/2012 14:56'!
raisedTo: n modulo: m
	"Answer the modular exponential.
	Note: this implementation is optimized for case of large integers raised to large powers."
	| a s mInv |
	n = 0 ifTrue: [^1].
	(self >= m or: [self < 0]) ifTrue: [^self \\ m raisedTo: n modulo: m].
	n < 0 ifTrue: [^(self reciprocalModulo: m) raisedTo: n negated modulo: m].
	(n < 4096 or: [m even])
		ifTrue:
			["Overhead of Montgomery method might cost more than naive divisions, use naive"
			^self slidingLeftRightRaisedTo: n modulo: m].
	
	mInv := 256 - ((m bitAnd: 255) reciprocalModulo: 256).
 
	"Initialize the result to R=256 raisedTo: m digitLength"
	a := (1 bitShift: m digitLength*8) \\ m.
	
	"Montgomerize self (multiply by R)"
	(s := self montgomeryTimes: (a*a \\ m) modulo: m mInvModB: mInv)
		ifNil:
			["No Montgomery primitive available ? fallback to naive divisions"
			^self slidingLeftRightRaisedTo: n modulo: m].

	"Exponentiate self*R"
	a := s montgomeryRaisedTo: n times: a modulo: m mInvModB: mInv.

	"Demontgomerize the result (divide by R)"
	^a montgomeryTimes: 1 modulo: m mInvModB: mInv! !

!Integer methodsFor: 'comparing' stamp: 'nice 1/4/2009 17:35'!
<= aNumber
	aNumber isInteger ifTrue:
		[self negative == aNumber negative
			ifTrue: [self negative
						ifTrue: [^ (self digitCompare: aNumber) >= 0]
						ifFalse: [^ (self digitCompare: aNumber) <= 0]]
			ifFalse: [^ self negative]].
	^ aNumber adaptToInteger: self andCompare: #<=! !

!Integer methodsFor: 'bit manipulation' stamp: 'di 4/30/1998 10:32'!
bitClear: aMask 
	"Answer an Integer equal to the receiver, except with all bits cleared that are set in aMask."

	^ (self bitOr: aMask) - aMask! !

!Integer methodsFor: 'testing' stamp: 'HenrikSperreJohansen 1/18/2012 12:51'!
isPowerOfTwo
	"Return true if the receiver is an integral power of two."
	^ self ~= 0 and: [(self bitAnd: self-1) = 0]! !

!Integer methodsFor: 'truncation and round off' stamp: 'HenrikSperreJohansen 1/19/2012 11:39'!
asSmallerPowerOfTwo
	"Convert the receiver into a power of two which is not larger than the receiver"
	^self isPowerOfTwo
		ifTrue:[self]
		ifFalse:[self > 0 ifTrue: [	1 bitShift: (self highBit - 1)]
						ifFalse: [DomainError signal: 'Value outside (0 , infinity)' from: 0]]! !

!Integer methodsFor: 'printing' stamp: 'stephane.ducasse 4/13/2009 14:15'!
numberOfDigits
	"Return how many digits are necessary to print this number in base 10.
	This does not count any place for minus sign, radix prefix or whatever."

	^ self numberOfDigitsInBase: 10 
! !

!Integer methodsFor: '*Kernel-Chronology' stamp: 'CamilloBruni 6/22/2012 21:42'!
asSeconds
	^ Duration seconds: self! !

!Integer methodsFor: 'truncation and round off' stamp: ''!
ceiling 
	"Refer to the comment in Number|ceiling."! !

!Integer methodsFor: 'printing-numerative' stamp: 'laza 3/29/2004 18:14'!
printStringBase: base length: minimum padded: zeroFlag
	^String streamContents: [:s| self printOn: s base: base length: minimum padded: zeroFlag]! !

!Integer methodsFor: 'mathematical functions' stamp: 'CamilloBruni 7/13/2012 17:45'!
take: kk
	"Return the number of combinations of (self) elements taken kk at a time.  
	For 6 take 3, this is 6*5*4 / (1*2*3).  Zero outside of Pascal's triangle.  Use a trick to go faster."
	" 6 take: 3  "

	| num denom |
	kk < 0 ifTrue: [^ 0].
	kk > self ifTrue: [^ 0].
	num := 1.
	self to: (kk max: self-kk) + 1 by: -1 do: [:factor | num := num * factor].
	denom := 1.
	1 to: (kk min: self-kk) do: [:factor | denom := denom * factor].
	^ num // denom! !

!Integer methodsFor: 'accessing' stamp: 'nice 9/7/2011 21:47'!
denominator
	"Let an Integer be polymorphic to a Fraction. See #isFraction."
	^1! !

!Integer methodsFor: '*AsmJit-Extension' stamp: ''!
asImm16

	"Convert integer value into a signed immediate word operand "
	^ AJImmediate new ivalue: self; size: 2! !

!Integer methodsFor: 'truncation and round off' stamp: 'sma 5/12/2000 12:35'!
atRandom: aGenerator
	"Answer a random integer from 1 to self picked from aGenerator."

	^ aGenerator nextInt: self! !

!Integer methodsFor: 'converting' stamp: 'nice 9/7/2011 22:03'!
adaptToFraction: rcvr andSend: selector
	"If I am involved in arithmetic with a Fraction, convert me to a Fraction."
	^ rcvr perform: selector with: (Fraction numerator: self denominator: 1)! !

!Integer methodsFor: 'filter streaming' stamp: 'MarcusDenker 7/15/2012 15:47'!
putOn: aStream

	(aStream isBinary ifTrue: [ self asByteArray ] ifFalse: [ self asString]) putOn: aStream
	! !

!Integer methodsFor: '*AsmJit-Extension' stamp: ''!
asTwosComplement: mask
	"return the two's completemented cropped version.
	Example for a byte value:
		-5 asTwosComplement: 16rFF "
	| bound |
	bound := (mask + 1).
	
	self * 2 >= bound 
		ifTrue: [Error signal: self printString , ' too big for signed ', mask highBit printString,  'bit value'].
		 
	(self >= 0)
		ifTrue: [ ^ self bitAnd: mask ].
		
	self * 2 < bound negated 
		ifTrue: [Error signal: self printString , ' too small for signed ', mask highBit printString, 'bit value'].
		
	^ (self + mask + 1) bitAnd: mask! !

!Integer methodsFor: 'converting' stamp: 'CamilloBruni 10/21/2012 14:09'!
asCharacterDigit
	"Answer the Character whose string representation is the receiver."
	^Character digitValue: self! !

!Integer methodsFor: 'printing' stamp: 'CamilloBruni 10/21/2012 14:04'!
asStringWithCommas
	"123456789 asStringWithCommas"
	"-123456789 asStringWithCommas"
	^ String streamContents: [:stream | 
		self printWithCommasOn: stream ]! !

!Integer methodsFor: '*AsmJit-Extension' stamp: ''!
asByte
	^ self asTwosComplement: 16rFF! !

!Integer methodsFor: '*metacello-core' stamp: 'dkh 6/21/2012 20:44'!
metacelloSemanticIntegerLessThanSelf: anInteger
    ^ anInteger < self! !

!Integer methodsFor: '*AsmJit-Extension' stamp: 'CamilloBruni 5/14/2012 17:18'!
bin
	"Print the receiver as hex, prefixed with 2r."
	^self storeStringBase: 2! !

!Integer methodsFor: '*GT-InspectorExtensions-Core' stamp: 'SvenVanCaekenberghe 10/3/2014 14:45'!
gtInspectorIntegerIn: composite
	<gtInspectorPresentationOrder: 30>
	^ composite table
		title: 'Integer';
		display: [ | associations |
			associations :=	{
					'decimal' -> self printString.
					'hex' -> self printStringHex.
					'octal' -> (self printStringBase: 8).
					'binary' -> (self printStringBase: 2)} asOrderedCollection.
			(self between: 0 and: 16r10FFFF)
				ifTrue: [ associations add: 'character' -> self asCharacter ].
			associations ];
		column: 'Key' evaluated: #key;
		column: 'Value' evaluated: [ :each | each value printString ];
		send: #value! !

!Integer methodsFor: '*AsmJit-Extension' stamp: ''!
asUImm16

	"Convert integer value into an unsigned immediate operand"
	^ AJImmediate new uvalue: self; size: 2! !

!Integer methodsFor: 'bit manipulation' stamp: 'IgorStasenko 12/28/2012 15:10'!
& aNumber
	^ self bitAnd: aNumber! !

!Integer methodsFor: 'printing' stamp: 'CamilloBruni 10/21/2012 13:52'!
printOn: outputStream base: baseInteger showRadix: flagBoolean 
	"Write a sequence of characters that describes the receiver in radix 
	baseInteger with optional radix specifier. 
	The result is undefined if baseInteger less than 2 or greater than 36."
	
	| tempString startPos |

	tempString := self printStringRadix: baseInteger.
	flagBoolean 
		ifTrue: [ ^ outputStream nextPutAll: tempString ].
		
	startPos := (tempString indexOf: $r ifAbsent: [ self error: 'radix indicator not found.' ]) + 1.
	self negative ifTrue: [ outputStream nextPut: $-] .
	outputStream nextPutAll: (tempString copyFrom: startPos to: tempString size)! !

!Integer methodsFor: 'mathematical functions' stamp: 'nice 10/19/2011 20:21'!
nthRootTruncated: aPositiveInteger
	"Answer the integer part of the nth root of the receiver."
	| guess guessToTheNthMinusOne delta |
	self = 0 ifTrue: [^0].
	self negative
		ifTrue:
			[aPositiveInteger even ifTrue: [ ArithmeticError signal: 'Negative numbers don''t have even roots.' ].
			^(self negated nthRootTruncated: aPositiveInteger) negated].
	guess := 1 bitShift: self highBitOfMagnitude + aPositiveInteger - 1 // aPositiveInteger.
	[
		guessToTheNthMinusOne := guess raisedTo: aPositiveInteger - 1.
		delta := (guess * guessToTheNthMinusOne - self) // (guessToTheNthMinusOne * aPositiveInteger).
		delta = 0 ] whileFalse:
			[ guess := guess - delta ].
	( (guess := guess - 1) raisedTo: aPositiveInteger) > self  ifTrue:
			[ guess := guess - 1 ].
	^guess! !

!Integer methodsFor: '*AsmJit-Extension' stamp: ''!
printAsOperandOn: aStream
	aStream print: self.! !

!Integer methodsFor: 'converting' stamp: 'nice 9/7/2011 22:21'!
asFraction
	"Answer a Fraction that represents the value of the receiver.
	Since an Integer already behaves as a special kind of Fraction, no conversion is required, see #isFraction."

	^self! !

!Integer methodsFor: 'converting' stamp: 'ar 4/9/2005 22:31'!
asCharacter
	"Answer the Character whose value is the receiver."
	^Character value: self! !

!Integer methodsFor: 'bit manipulation' stamp: 'sr 3/13/2000 17:47'!
bitAnd: n 
	"Answer an Integer whose bits are the logical AND of the receiver's bits  
	and those of the argument, n."
	| norm |
	<primitive: 'primDigitBitAnd' module:'LargeIntegers'>
	norm := n normalize.
	^ self
		digitLogic: norm
		op: #bitAnd:
		length: (self digitLength max: norm digitLength)! !

!Integer methodsFor: 'private' stamp: 'laza 3/29/2004 18:16'!
print: positiveNumberString on: aStream prefix: prefix length: minimum padded: zeroFlag
	| padLength |
	padLength := minimum - positiveNumberString size - prefix size.
	padLength > 0
		ifTrue: [zeroFlag
				ifTrue: [aStream nextPutAll: prefix; nextPutAll: (String new: padLength withAll: $0)]
				ifFalse: [aStream nextPutAll: (String new: padLength withAll: Character space); nextPutAll: prefix]]
		ifFalse: [aStream nextPutAll: prefix].
	aStream nextPutAll: positiveNumberString
	! !

!Integer methodsFor: 'truncation and round off' stamp: 'ar 6/9/2000 18:56'!
asPowerOfTwo
	"Convert the receiver into a power of two"
	^self asSmallerPowerOfTwo! !

!Integer methodsFor: '*AsmJit-Extension' stamp: ''!
asImm8

	"Convert integer value into a signed immediate operand"
	^ AJImmediate new ivalue: self; size: 1! !

!Integer methodsFor: 'private' stamp: 'nice 1/26/2008 02:12'!
digitLogic: arg op: op length: len 
	| i result neg1 neg2 rneg z1 z2 rz b1 b2 b |
	neg1 := self negative.
	neg2 := arg negative.
	rneg := ((neg1
				ifTrue: [-1]
				ifFalse: [0])
				perform: op
				with: (neg2
						ifTrue: [-1]
						ifFalse: [0]))
				< 0.
	result := Integer new: len neg: rneg.
	rz := z1 := z2 := true.
	i := 0.
	[(i := i + 1) <= len
		or: ["mind a carry on result that might go past len digits"
			rneg and: [rz
				and: [result := result growby: 1.
					true]]]]
		whileTrue: [b1 := self digitAt: i.
			neg1
				ifTrue: [b1 := z1
								ifTrue: [b1 = 0
										ifTrue: [0]
										ifFalse: [z1 := false.
											256 - b1]]
								ifFalse: [255 - b1]].
			b2 := arg digitAt: i.
			neg2
				ifTrue: [b2 := z2
								ifTrue: [b2 = 0
										ifTrue: [0]
										ifFalse: [z2 := false.
											256 - b2]]
								ifFalse: [255 - b2]].
			b := b1 perform: op with: b2.
			result
				digitAt: i
				put: (rneg
						ifTrue: [rz
								ifTrue: [b = 0
										ifTrue: [0]
										ifFalse: [rz := false.
											256 - b]]
								ifFalse: [255 - b]]
						ifFalse: [b])].
	^ result normalize! !

!Integer methodsFor: 'mathematical functions' stamp: 'LC 6/17/1998 19:22'!
gcd: anInteger
	"See Knuth, Vol 2, 4.5.2, Algorithm L"
	"Initialize"
	| higher u v k uHat vHat a b c d vPrime vPrimePrime q t |
	higher := SmallInteger maxVal highBit.
	u := self abs max: (v := anInteger abs).
	v := self abs min: v.
	[v class == SmallInteger]
		whileFalse: 
			[(uHat := u bitShift: (k := higher - u highBit)) class == SmallInteger
				ifFalse: 
					[k := k - 1.
					uHat := uHat bitShift: -1].
			vHat := v bitShift: k.
			a := 1.
			b := 0.
			c := 0.
			d := 1.
			"Test quotient"
			[(vPrime := vHat + d) ~= 0
				and: [(vPrimePrime := vHat + c) ~= 0 and: [(q := uHat + a // vPrimePrime) = (uHat + b // vPrime)]]]
				whileTrue: 
					["Emulate Euclid"
					c := a - (q * (a := c)).
					d := b - (q * (b := d)).
					vHat := uHat - (q * (uHat := vHat))].
			"Multiprecision step"
			b = 0
				ifTrue: 
					[v := u rem: (u := v)]
				ifFalse: 
					[t := u * a + (v * b).
					v := u * c + (v * d).
					u := t]].
	^ v gcd: u! !

!Integer methodsFor: 'testing' stamp: ''!
isInteger
	"True for all subclasses of Integer."

	^ true! !

!Integer methodsFor: 'bit manipulation' stamp: 'jm 2/19/98 12:11'!
lowBit
	"Answer the index of the low order bit of this number."
	| index |
	self = 0 ifTrue: [ ^ 0 ].
	index := 1.
	[ (self digitAt: index) = 0 ]
		whileTrue:
			[ index := index + 1 ].
	^ (self digitAt: index) lowBit + (8 * (index - 1))! !

!Integer methodsFor: 'printing-numerative' stamp: 'laza 3/29/2004 18:21'!
printStringLength: minimal
	^self printStringLength: minimal padded: false
! !

!Integer methodsFor: 'testing' stamp: 'nice 9/7/2011 22:20'!
isFraction
	"Each Integer is considered as a special kind of Fraction with self as numerator and a unit denominator.
	Rationale: A Fraction with a unit denominator will be automatically reduced to an Integer.
	Hence Integer has to be polymorphic to Fraction."
	^true! !

!Integer methodsFor: '*AsmJit-Extension' stamp: ''!
asUImm8

	"Convert integer value into an unsigned immediate operand"
	^ AJImmediate new uvalue: self; size: 1! !

!Integer methodsFor: '*Keymapping-KeyCombinations' stamp: 'CamilloBruni 3/18/2011 23:14'!
ctrl
	^ KMModifier ctrl + self! !

!Integer methodsFor: 'private' stamp: ''!
growby: n

	^self growto: self digitLength + n! !

!Integer methodsFor: 'mathematical functions' stamp: 'es 5/25/2005 11:04'!
raisedToInteger: exp modulo: m
	(exp = 0) ifTrue: [^ 1].
	exp even
		ifTrue: [^ (self raisedToInteger: (exp // 2) modulo: m) squared \\ m]
		ifFalse: [^ (self * (self raisedToInteger: (exp - 1) modulo: m)) \\ m].! !

!Integer methodsFor: 'accessing' stamp: 'CamilloBruni 7/13/2012 18:09'!
primeFactors
	"Return all primeFactors of myself"
	"( 106260 primeFactors fold: [ :a :b | a * b ]) = 106260"
	
	^ Array streamContents: [ :s | self primeFactorsOn: s ]! !

!Integer methodsFor: 'truncation and round off' stamp: ''!
rounded 
	"Refer to the comment in Number|rounded."! !

!Integer methodsFor: 'arithmetic' stamp: 'nice 1/9/2013 01:35'!
/ aNumber
	"Refer to the comment in Number / "
	| quoRem |
	aNumber isInteger ifTrue:
		[quoRem := self digitDiv: aNumber neg: self negative ~~ aNumber negative.
		(quoRem at: 2) = 0
			ifTrue: [^ (quoRem at: 1) normalize]
			ifFalse: [^ (Fraction numerator: self denominator: aNumber) reduced]].
	^ aNumber adaptToInteger: self andSend: #/! !

!Integer methodsFor: '*metacello-core' stamp: 'dkh 6/21/2012 20:44'!
metacelloSemanticStringLessThanSelf: aString
    "string version components are always '<' integer component"

    ^ true! !

!Integer methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
metacelloStringLessThanSelf: aString
	"string version components are always '<' integer component"
	
	^true! !

!Integer methodsFor: 'private' stamp: 'sma 5/20/2000 17:00'!
romanDigits: digits for: base on: aStream
	| n |
	n := self \\ (base * 10) // base.
	n = 9 ifTrue: [^ aStream nextPut: digits last; nextPut: digits first].
	n = 4 ifTrue: [^ aStream nextPut: digits last; nextPut: digits second].
	n > 4 ifTrue: [aStream nextPut: digits second].
	n \\ 5 timesRepeat: [aStream nextPut: digits last]! !

!Integer methodsFor: 'arithmetic' stamp: 'nice 1/9/2013 01:35'!
quo: aNumber 
	"Refer to the comment in Number quo: "
	| ng quo |
	aNumber isInteger ifTrue: 
		[ng := self negative == aNumber negative == false.
		quo := (self digitDiv: aNumber neg: ng) at: 1.
		^ quo normalize].
	^ aNumber adaptToInteger: self andSend: #quo:! !

!Integer methodsFor: 'bit manipulation' stamp: 'sr 3/13/2000 17:47'!
bitOr: n 
	"Answer an Integer whose bits are the logical OR of the receiver's bits  
	and those of the argument, n."
	| norm |
	<primitive: 'primDigitBitOr' module:'LargeIntegers'>
	norm := n normalize.
	^ self
		digitLogic: norm
		op: #bitOr:
		length: (self digitLength max: norm digitLength)! !

!Integer methodsFor: 'bit manipulation' stamp: 'sr 11/29/2000 14:32'!
anyBitOfMagnitudeFrom: start to: stopArg 
	"Tests for any magnitude bits in the interval from start to stopArg."
	"Primitive fixed in LargeIntegers v1.2. If you have an earlier version 
	comment out the primitive call (using this ST method then)."
	| magnitude firstDigitIx lastDigitIx rightShift leftShift stop |
	<primitive: 'primAnyBitFromTo' module:'LargeIntegers'>
	start < 1 | (stopArg < 1)
		ifTrue: [^ self error: 'out of range'].
	magnitude := self abs.
	stop := stopArg min: magnitude highBit.
	start > stop
		ifTrue: [^ false].
	firstDigitIx := start - 1 // 8 + 1.
	lastDigitIx := stop - 1 // 8 + 1.
	rightShift := (start - 1 \\ 8) negated.
	leftShift := 7 - (stop - 1 \\ 8).
	firstDigitIx = lastDigitIx
		ifTrue: [| digit mask | 
			mask := (255 bitShift: rightShift negated)
						bitAnd: (255 bitShift: leftShift negated).
			digit := magnitude digitAt: firstDigitIx.
			^ (digit bitAnd: mask)
				~= 0].
	((magnitude digitAt: firstDigitIx)
			bitShift: rightShift)
			~= 0
		ifTrue: [^ true].
	firstDigitIx + 1
		to: lastDigitIx - 1
		do: [:ix | (magnitude digitAt: ix)
					~= 0
				ifTrue: [^ true]].
	(((magnitude digitAt: lastDigitIx)
			bitShift: leftShift)
			bitAnd: 255)
			~= 0
		ifTrue: [^ true].
	^ false! !

!Integer methodsFor: 'printing-numerative' stamp: 'laza 3/29/2004 18:16'!
storeOn: aStream base: base length: minimum padded: zeroFlag
	| prefix |
	prefix := self negative ifTrue: ['-'] ifFalse: [String new].
	base = 10 ifFalse: [prefix := prefix, base printString, 'r'].
	self print: (self abs printStringBase: base) on: aStream prefix: prefix length: minimum padded: zeroFlag
! !

!Integer methodsFor: 'arithmetic' stamp: 'jannik.laval 5/1/2010 17:03'!
crossSumBase: aBase
	|aResult|
	"Precondition"
	[aBase isInteger and: [aBase >=2]] assert.

	self < 0 ifTrue: [^self negated crossSumBase: aBase].
	self < aBase ifTrue: [^ self].
	aResult := self \\ aBase + (self // aBase crossSumBase: aBase).

	"Postcondition
	E.g. 18 crossSumBase: 10 -> 9 => 18\\(10-1) = 0"
	[((aResult \\ (aBase - 1) = 0)) = ((self \\ (aBase - 1)) =0)] assert.
	^aResult! !

!Integer methodsFor: 'converting' stamp: 'StephaneDucasse 7/21/2010 17:39'!
hex
	"Print the receiver as hex, prefixed with 16r.  DO NOT CHANGE THIS!!  The Cog VMMaker depends on this.
	 Consider using any of
		printStringHex
		printStringBase: 16
		printStringBase: 16 length: 8 padded: true
		storeStringHex
		storeStringBase: 16
		storeStringBase: 16 length: 11 padded: true"
	^self storeStringBase: 16! !

!Integer methodsFor: 'benchmarks' stamp: 'jm 11/20/1998 07:06'!
benchFib  "Handy send-heavy benchmark"
	"(result // seconds to run) = approx calls per second"
	" | r t |
	  t := Time millisecondsToRun: [r := 26 benchFib].
	  (r * 1000) // t"
	"138000 on a Mac 8100/100"
	^ self < 2
		ifTrue: [1] 
		ifFalse: [(self-1) benchFib + (self-2) benchFib + 1]
! !

!Integer methodsFor: '*Keymapping-KeyCombinations' stamp: 'CamilloBruni 3/18/2011 23:14'!
alt
	^ KMModifier alt + self! !

!Integer methodsFor: '*Keymapping-KeyCombinations' stamp: 'GuillermoPolito 3/19/2013 20:26'!
control
	^ KMModifier ctrl + self! !

!Integer methodsFor: 'truncation and round off' stamp: ''!
floor 
	"Refer to the comment in Number|floor."! !

!Integer methodsFor: 'arithmetic' stamp: 'nice 3/11/2013 08:12'!
- aNumber
	"Refer to the comment in Number - "
	aNumber isInteger ifTrue:
		[self negative == aNumber negative
			ifTrue: [^ self digitSubtract: aNumber]
			ifFalse: [^ (self digitAdd: aNumber) normalize]].
	aNumber isFraction ifTrue:
		[^Fraction numerator: self * aNumber denominator - aNumber numerator denominator: aNumber denominator].
	^ aNumber adaptToInteger: self andSend: #-! !

!Integer methodsFor: 'printing-numerative' stamp: 'laza 3/29/2004 13:35'!
radix: base 
	^ self printStringBase: base! !

!Integer methodsFor: 'bit manipulation' stamp: 'tak 9/25/2008 15:17'!
bitInvert
	"Answer an Integer whose bits are the logical negation of the receiver's bits.
	Numbers are interpreted as having 2's-complement representation."

	^ -1 - self.! !

!Integer methodsFor: 'printing' stamp: 'CamilloBruni 10/21/2012 14:00'!
printWithCommasSignedOn: aStream
	"123456789 asStringWithCommasSigned"
	"-123456789 asStringWithCommasSigned"
	^ self printSeparatedBy: $, every: 3 signed: true on: aStream! !

!Integer methodsFor: 'private' stamp: 'sr 1/23/2000 05:46'!
digitMultiply: arg neg: ng 
	| prod prodLen carry digit k ab |
	<primitive: 'primDigitMultiplyNegative' module:'LargeIntegers'>
	(arg digitLength = 1 and: [(arg digitAt: 1)
			= 0])
		ifTrue: [^ 0].
	(self digitLength = 1 and: [(self digitAt: 1)
			= 0])
		ifTrue: [^ 0].
	prodLen := self digitLength + arg digitLength.
	prod := Integer new: prodLen neg: ng.
	"prod starts out all zero"
	1 to: self digitLength do: [:i | (digit := self digitAt: i) ~= 0
			ifTrue: 
				[k := i.
				carry := 0.
				"Loop invariant: 0<=carry<=0377, k=i+j-1"
				1 to: arg digitLength do: 
					[:j | 
					ab := (arg digitAt: j)
								* digit + carry + (prod digitAt: k).
					carry := ab bitShift: -8.
					prod digitAt: k put: (ab bitAnd: 255).
					k := k + 1].
				prod digitAt: k put: carry]].
	^ prod normalize! !

!Integer methodsFor: 'truncation and round off' stamp: ''!
truncated 
	"Refer to the comment in Number|truncated."! !

!Integer methodsFor: 'testing' stamp: 'StephaneDucasse 2/4/2012 17:01'!
isProbablyPrimeWithK: k andQ: q 
	"Algorithm P, probabilistic primality test, from
	Knuth, Donald E. 'The Art of Computer Programming', Vol 2,
	Third Edition, section 4.5.4, page 395, P1-P5 refer to Knuth description..
	Note that this is a Miller Rabin test which may answer false positives (known as pseudoprimes) for at most 1/4 of the possible bases x."

	| x j y minusOne |
	"P1"
	x := (self - 2) atRandom + 1.
	"P2"
	j := 0.
	y := x raisedTo: q modulo: self.
	minusOne := self - 1.
	
	["P3"
	y = 1 ifTrue: [^j = 0].
	y = minusOne ifTrue: [^true].
	"P4"
	(j := j + 1) < k]
		whileTrue:
			[y := y squared \\ self].
	"P5"
	^false! !

!Integer methodsFor: 'mathematical functions' stamp: ''!
lcm: n 
	"Answer the least common multiple of the receiver and n."

	^self // (self gcd: n) * n! !

!Integer methodsFor: 'printing' stamp: 'CamilloBruni 10/21/2012 13:48'!
asTwoCharacterString
	"Answer a two-character string representing the receiver, with leading zero if required.  Intended for use with integers in the range 0 to 99, but plausible replies given for other values too
	Examples:
		2 asTwoCharacterString
		11 asTwoCharacterString
		1943 asTwoCharacterString
		0 asTwoCharacterString
		-2 asTwoCharacterString
		-234 asTwoCharacterString "

	^ (self >= 0 and: [self < 10])
		ifTrue:	['0', self printString]
		ifFalse:	[self printString copyFrom: 1 to: 2]! !

!Integer methodsFor: 'bit manipulation' stamp: 'NicolasCellier 7/29/2011 23:28'!
bitStringLength

      ^self digitLength * 8
           	"make sure positive integer bitString always begins with 0"
           + (self positive ifTrue: [1] ifFalse: [0])! !

!Integer methodsFor: '*AsmJit-Extension' stamp: ''!
asWord
	^ self asTwosComplement: 16rFFFF! !

!Integer methodsFor: 'comparing' stamp: 'nice 3/28/2006 23:38'!
> aNumber
	aNumber isInteger ifTrue:
		[self negative == aNumber negative
			ifTrue: [self negative
						ifTrue: [^(self digitCompare: aNumber) < 0]
						ifFalse: [^(self digitCompare: aNumber) > 0]]
			ifFalse: [^ aNumber negative]].
	^ aNumber adaptToInteger: self andCompare: #>! !

!Integer methodsFor: 'testing' stamp: 'StephaneDucasse 2/4/2012 17:01'!
isProbablyPrime
	"See isProbablyPrimeWithK:andQ: for the algoritm description."
	
	| k q |
	self <= 1 ifTrue: [ ^false ].
	self even ifTrue: [ ^self = 2 ].
	"Factor self into (2 raisedTo: k) * q + 1, where q odd"
	q := self bitShift: -1.
	k := q lowBit.
	q := q bitShift: 1 - k.
	"Repeat the probabilistic until false (the probability of false negative is null) or until probability is very low."
	25 timesRepeat: [ (self isProbablyPrimeWithK: k andQ: q) ifFalse: [ ^false ] ].
	"The probability of false positive after 25 iterations is less than (1/4 raisedTo: 25) < 1.0e-15"
	^true! !

!Integer methodsFor: 'private' stamp: ''!
growto: n

	^self copyto: (self species new: n)! !

!Integer methodsFor: 'accessing' stamp: 'nice 9/7/2011 21:47'!
numerator
	"Let an Integer be polymorphic to a Fraction. See #isFraction."
	^self! !

!Integer methodsFor: 'printing-numerative' stamp: 'laza 3/29/2004 18:20'!
printStringLength: minimal padded: zeroFlag
	^self printStringBase: 10 length: minimal padded: zeroFlag! !

!Integer methodsFor: 'private' stamp: 'sr 1/23/2000 05:41'!
digitAdd: arg 
	| len arglen accum sum |
	<primitive: 'primDigitAdd' module:'LargeIntegers'>
	accum := 0.
	(len := self digitLength) < (arglen := arg digitLength) ifTrue: [len := arglen].
	"Open code max: for speed"
	sum := Integer new: len neg: self negative.
	1 to: len do: 
		[:i | 
		accum := (accum bitShift: -8)
					+ (self digitAt: i) + (arg digitAt: i).
		sum digitAt: i put: (accum bitAnd: 255)].
	accum > 255
		ifTrue: 
			[sum := sum growby: 1.
			sum at: sum digitLength put: (accum bitShift: -8)].
	^ sum! !

!Integer methodsFor: 'bit manipulation' stamp: 'NicolasCellier 7/29/2011 23:35'!
bitString
	"Returns a string representing the receiver in binary form"
	"2 bitString 
		'0000000000000000000000000000010'
	
	-1 bitString	 
		'1111111111111111111111111111111'
	
	-2 bitString 
		'1111111111111111111111111111110'
	"

      ^(self bitStringLength to: 1 by: -1) 
		collect: [:i | Character value: $0 charCode + (self bitAt: i)] as: String! !

!Integer methodsFor: '*NativeBoost-Core' stamp: 'Igor.Stasenko 4/28/2010 12:19'!
asNBExternalType: gen
	"integer value in callout argument description aray are pushed directly on stack
	
	#( 100 )  - an integer value argument = 100
	"
	^ NBFFIConst value: (self )! !

!Integer methodsFor: 'printing' stamp: 'CamilloBruni 10/21/2012 13:52'!
printPaddedWith: aCharacter to: anInteger 
	"Answer the string containing the ASCII representation of the receiver 
	padded on the left with aCharacter to be at least anInteger characters."
	
	^ self
		printPaddedWith: aCharacter
		to: anInteger
		base: 10! !

!Integer methodsFor: 'printing-numerative' stamp: 'laza 3/29/2004 10:58'!
storeStringHex
	^self storeStringBase: 16! !

!Integer methodsFor: 'printing-numerative' stamp: 'laza 3/29/2004 18:20'!
printStringPadded: minimal
	^self printStringLength: minimal padded: true
! !

!Integer methodsFor: 'printing' stamp: 'CamilloBruni 10/21/2012 14:43'!
printSeparatedBy: aDelimiter every: offset signed: printSigned on: aStream
	^ self printSeparatedBy: aDelimiter every: offset signed: printSigned base: 10 on: aStream! !

!Integer methodsFor: 'accessing' stamp: 'CamilloBruni 7/13/2012 18:06'!
primeFactorsOn: aStream
	"Recursively calculate the primefactors of myself and put the factors into the given stream"
	self = 1 
		ifTrue: [ ^ self ].
		
	self even ifTrue: [
		aStream nextPut: 2.
		^ (self / 2) primeFactorsOn: aStream ].
	
	3 to: self sqrtFloor by: 2 do: [ :each |
		self \\ each = 0 
			ifTrue: [ 
				aStream nextPut: each.
				^ (self / each) primeFactorsOn: aStream ]].
	
	aStream nextPut: self.! !

!Integer methodsFor: 'testing' stamp: ''!
even 
	"Refer to the comment in Number|even."

	^((self digitAt: 1) bitAnd: 1) = 0! !

!Integer methodsFor: 'bit manipulation' stamp: 'adrian-lienhard 5/18/2009 20:34'!
>> shiftAmount
	"right shift"
	
	shiftAmount < 0 ifTrue: [self error: 'negative arg'].
	^ self bitShift: 0 - shiftAmount! !

!Integer methodsFor: 'truncation and round off' stamp: 'GuillermoPolito 6/22/2012 14:49'!
round: numberOfWishedDecimal
	^self! !

!Integer methodsFor: 'private' stamp: 'StephaneDucasse 3/5/2010 14:47'!
digitSubtract: arg 
	| smaller larger z sum sl al ng |
	<primitive: 'primDigitSubtract' module:'LargeIntegers'>
	sl := self digitLength.
	al := arg digitLength.
	(sl = al
		ifTrue: 
			[[(self digitAt: sl)
				= (arg digitAt: sl) and: [sl > 1]]
				whileTrue: [sl := sl - 1].
			al := sl.
			(self digitAt: sl)
				< (arg digitAt: sl)]
		ifFalse: [sl < al])
		ifTrue: 
			[larger := arg.
			smaller := self.
			ng := self negative == false.
			sl := al]
		ifFalse: 
			[larger := self.
			smaller := arg.
			ng := self negative].
	sum := Integer new: sl neg: ng.
	z := 0.
	"Loop invariant is -1<=z<=1"
	1 to: sl do: 
		[:i | 
		z := z + (larger digitAt: i) - (smaller digitAt: i).
		sum digitAt: i put: z - (z // 256 * 256).
		"sign-tolerant form of (z bitAnd: 255)"
		z := z // 256].
	^ sum normalize! !

!Integer methodsFor: 'bit manipulation' stamp: 'sr 6/8/2000 02:13'!
highBit
	"Answer the index of the high order bit of the receiver, or zero if the  
	receiver is zero. Raise an error if the receiver is negative, since  
	negative integers are defined to have an infinite number of leading 1's 
	in 2's-complement arithmetic. Use >>highBitOfMagnitude if you want to  
	get the highest bit of the magnitude."

	^ self subclassResponsibility! !

!Integer methodsFor: '*AsmJit-Extension' stamp: ''!
asImm

	"Convert integer value into a signed immediate operand"
	^ AJImmediate new ivalue: self! !

!Integer class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:00'!
gtExample42
	<gtExample>
	^ 42! !

!Integer class methodsFor: '*AST-Core-Parser' stamp: 'nice 3/15/2008 00:36'!
readFrom: aStringOrStream 
	"Answer a new Integer as described on the stream, aStream.
	Embedded radix specifiers not allowed - use Number readFrom: for that."
	^self readFrom: aStringOrStream base: 10! !

!Integer class methodsFor: 'instance creation' stamp: 'tk 4/20/1999 14:18'!
basicNew

	self == Integer ifTrue: [
		^ self error: 'Integer is an abstract class.  Make a concrete subclass.'].
	^ super basicNew! !

!Integer class methodsFor: 'prime numbers' stamp: 'ar 10/6/2001 02:38'!
largePrimesUpTo: max do: aBlock
	"Evaluate aBlock with all primes up to maxValue.
	The Algorithm is adapted from http://www.rsok.com/~jrm/printprimes.html
	It encodes prime numbers much more compactly than #primesUpTo: 
	38.5 integer per byte (2310 numbers per 60 byte) allow for some fun large primes.
	(all primes up to SmallInteger maxVal can be computed within ~27MB of memory;
	the regular #primesUpTo: would require 4 *GIGA*bytes).
	Note: The algorithm could be re-written to produce the first primes (which require
	the longest time to sieve) faster but only at the cost of clarity."

	| limit flags maskBitIndex bitIndex maskBit byteIndex index primesUpTo2310 indexLimit |
	limit := max asInteger - 1.
	indexLimit := max sqrt truncated + 1.
	"Create the array of flags."
	flags := ByteArray new: (limit + 2309) // 2310 * 60 + 60.
	flags atAllPut: 16rFF. "set all to true"

	"Compute the primes up to 2310"
	primesUpTo2310 := self primesUpTo: 2310.

	"Create a mapping from 2310 integers to 480 bits (60 byte)"
	maskBitIndex := Array new: 2310.
	bitIndex := -1. "for pre-increment"
	maskBitIndex at: 1 put: (bitIndex := bitIndex + 1).
	maskBitIndex at: 2 put: (bitIndex := bitIndex + 1).

	1 to: 5 do:[:i| aBlock value: (primesUpTo2310 at: i)].

	index := 6.
	2 to: 2309 do:[:n|
		[(primesUpTo2310 at: index) < n] 
			whileTrue:[index := index + 1].
		n = (primesUpTo2310 at: index) ifTrue:[
			maskBitIndex at: n+1 put: (bitIndex := bitIndex + 1).
		] ifFalse:[
			"if modulo any of the prime factors of 2310, then could not be prime"
			(n \\ 2 = 0 or:[n \\ 3 = 0 or:[n \\ 5 = 0 or:[n \\ 7 = 0 or:[n \\ 11 = 0]]]]) 
				ifTrue:[maskBitIndex at: n+1 put: 0]
				ifFalse:[maskBitIndex at: n+1 put: (bitIndex := bitIndex + 1)].
		].
	].

	"Now the real work begins...
	Start with 13 since multiples of 2,3,5,7,11 are handled by the storage method;
	increment by 2 for odd numbers only."
	13 to: limit by: 2 do:[:n|
		(maskBit := maskBitIndex at: (n \\ 2310 + 1)) = 0 ifFalse:["not a multiple of 2,3,5,7,11"
			byteIndex := n // 2310 * 60 + (maskBit-1 bitShift: -3) + 1.
			bitIndex := 1 bitShift: (maskBit bitAnd: 7).
			((flags at: byteIndex) bitAnd: bitIndex) = 0 ifFalse:["not marked -- n is prime"
				aBlock value: n.
				"Start with n*n since any integer < n has already been sieved 
				(e.g., any multiple of n with a number k < n has been cleared 
				when k was sieved); add 2 * i to avoid even numbers and
				mark all multiples of this prime. Note: n < indexLimit below
				limits running into LargeInts -- nothing more."
				n < indexLimit ifTrue:[
					index := n * n.
					(index bitAnd: 1) = 0 ifTrue:[index := index + n].
					[index <= limit] whileTrue:[
						(maskBit := maskBitIndex at: (index \\ 2310 + 1)) = 0 ifFalse:[
							byteIndex := (index // 2310 * 60) + (maskBit-1 bitShift: -3) + 1.
							maskBit := 255 - (1 bitShift: (maskBit bitAnd: 7)).
							flags at: byteIndex put: ((flags at: byteIndex) bitAnd: maskBit).
						].
						index := index + (2 * n)].
				].
			].
		].
	].
! !

!Integer class methodsFor: '*Tools-Debugger' stamp: 'SeanDeNigris 5/28/2013 17:51'!
canonicalArgumentName

	^ 'anInteger'.! !

!Integer class methodsFor: '*Spec-Inspector' stamp: 'cb 6/25/2013 13:43'!
inspectorClass
	^ EyeIntegerInspector! !

!Integer class methodsFor: 'instance creation' stamp: 'bf 2/2/2004 00:23'!
byte1: byte1 byte2: byte2 byte3: byte3 byte4: byte4 
	"Depending on high-order byte copy directly into a LargeInteger,
	or build up a SmallInteger by shifting"
	| value |
	byte4 < 16r40 ifTrue:
		[^ (byte4 bitShift: 24)
		 + (byte3 bitShift: 16)
		 + (byte2 bitShift: 8)
		 + byte1].
	value := LargePositiveInteger new: 4.
	value digitAt: 4 put: byte4.
	value digitAt: 3 put: byte3.
	value digitAt: 2 put: byte2.
	value digitAt: 1 put: byte1.
	^ value! !

!Integer class methodsFor: 'prime numbers' stamp: 'ar 10/6/2001 19:34'!
largePrimesUpTo: maxValue
	"Compute and return all the prime numbers up to maxValue"
	^Array streamContents:[:s| self largePrimesUpTo: maxValue do:[:prime| s nextPut: prime]]! !

!Integer class methodsFor: 'prime numbers' stamp: 'ar 10/6/2001 19:33'!
primesUpTo: max
	"Return a list of prime integers up to the given integer."
	"Integer primesUpTo: 100"
	^Array streamContents:[:s| self primesUpTo: max do:[:prime| s nextPut: prime]]! !

!Integer class methodsFor: 'class initialization' stamp: 'MarcusDenker 2/1/2012 10:59'!
initialize	"Integer initialize"
	"Ensure we have the right compact class index"

	"LPI has been a compact class forever - just ensure basic correctness"
	(LargePositiveInteger indexIfCompact = 5) ifFalse:[
		(Smalltalk compactClassesArray at: 5)
			ifNil:[LargePositiveInteger becomeCompactSimplyAt: 5]
			ifNotNil:[self error: 'Unexpected compact class setup']].

	(LargeNegativeInteger indexIfCompact = 4) ifFalse:[
		(Smalltalk compactClassesArray at: 4)
			ifNil:[LargeNegativeInteger becomeCompactSimplyAt: 4]
			ifNotNil:[self error: 'Unexpected compact class setup']].
! !

!Integer class methodsFor: 'instance creation' stamp: ''!
new: length neg: neg
	"Answer an instance of a large integer whose size is length. neg is a flag 
	determining whether the integer is negative or not."

	neg 
		ifTrue: [^LargeNegativeInteger new: length]
		ifFalse: [^LargePositiveInteger new: length]! !

!Integer class methodsFor: 'instance creation' stamp: 'tk 4/18/1999 22:01'!
new

	self == Integer ifTrue: [
		^ self error: 'Integer is an abstract class.  Make a concrete subclass.'].
	^ super new! !

!Integer class methodsFor: 'compatibility' stamp: 'laza 10/16/2004 14:34'!
readFrom: aStream radix: radix
	^self readFrom: aStream base: radix! !

!Integer class methodsFor: '*AST-Core-Parser' stamp: 'YuriyTymchuk 10/29/2013 11:10'!
readFrom: aStringOrStream ifFail: aBlock
	"Answer an instance of one of the concrete subclasses if Integer. 
	Initial minus sign accepted.
	Imbedded radix specifiers not allowed;  use Number 
	class readFrom: for that.
	Execute aBlock if there are no digits."

	^(NumberParser on: aStringOrStream) nextIntegerBase: 10 ifFail: aBlock! !

!Integer class methodsFor: '*AST-Core-Parser' stamp: 'YuriyTymchuk 10/29/2013 11:10'!
readFrom: aStringOrStream base: base 
	"Answer an instance of one of the concrete subclasses if Integer. 
	Initial minus sign accepted, and bases > 10 use letters A-Z.
	Imbedded radix specifiers not allowed;  use Number 
	class readFrom: for that.
	Raise an Error if there are no digits.
	If stringOrStream dos not start with a valid number description, answer 0 for backward compatibility. This is not clever and should better be changed."

	^(NumberParser on: aStringOrStream) nextIntegerBase: base! !

!Integer class methodsFor: 'prime numbers' stamp: 'md 2/13/2006 14:38'!
primesUpTo: max do: aBlock
	"Compute aBlock with all prime integers up to the given integer."
	"Integer primesUpTo: 100"

	| limit flags prime k |
	limit := max asInteger - 1.
	"Fall back into #largePrimesUpTo:do: if we'd require more than 100k of memory; 
	the alternative will only requre 1/154th of the amount we need here and is almost as fast."
	limit > 25000 ifTrue:[^self largePrimesUpTo: max do: aBlock].
	flags := (Array new: limit) atAllPut: true.
	1 to: limit - 1 do: [:i |
		(flags at: i) ifTrue: [
			prime := i + 1.
			k := i + prime.
			[k <= limit] whileTrue: [
				flags at: k put: false.
				k := k + prime].
			aBlock value: prime]].
! !

!IntegerArray commentStamp: '<historical>'!
IntegerArrays store 32bit signed Integer values.
Negative values are stored as 2's complement.!
!IntegerArray methodsFor: 'private' stamp: 'ar 3/3/2001 23:34'!
primFill: aPositiveInteger
	"Fill the receiver, an indexable bytes or words object, with the given positive integer. The range of possible fill values is [0..255] for byte arrays and [0..(2^32 - 1)] for word arrays."

	<primitive: 145>
	self errorImproperStore.! !

!IntegerArray methodsFor: 'converting' stamp: 'ar 10/10/1998 16:18'!
asIntegerArray
	^self! !

!IntegerArray methodsFor: 'accessing' stamp: 'ar 3/3/2001 22:40'!
at: index put: anInteger
	| word |
	<primitive: 166>
	anInteger < 0
		ifTrue:["word := 16r100000000 + anInteger"
				word := (anInteger + 1) negated bitInvert32]
		ifFalse:[word := anInteger].
	self  basicAt: index put: word.
	^anInteger! !

!IntegerArray methodsFor: 'accessing' stamp: 'ar 3/3/2001 22:40'!
at: index
	| word |
	<primitive: 165>
	word := self basicAt: index.
	word < 16r3FFFFFFF ifTrue:[^word]. "Avoid LargeInteger computations"
	^word >= 16r80000000	"Negative?!!"
		ifTrue:["word - 16r100000000"
				(word bitInvert32 + 1) negated]
		ifFalse:[word]! !

!IntegerArray methodsFor: 'accessing' stamp: 'ar 11/2/1998 12:19'!
defaultElement
	"Return the default element of the receiver"
	^0! !

!IntegerArray methodsFor: 'accessing' stamp: 'ar 3/3/2001 23:34'!
atAllPut: anInteger
	| word |
	anInteger < 0
		ifTrue:["word := 16r100000000 + anInteger"
				word := (anInteger + 1) negated bitInvert32]
		ifFalse:[word := anInteger].
	self primFill: word.! !

!IntegerArrayTest commentStamp: 'TorstenBergmann 2/20/2014 15:29'!
SUnit tests for integer arrays!
!IntegerArrayTest methodsFor: 'testing' stamp: 'HilaireFernandes 3/29/2010 21:54'!
testAt
	| array |
	array := IntegerArray new: 5 withAll: 2.
	self assert: (array at: 3) = 2.
	
	array at: 3 put: 5.
	self assert: (array at: 3) = 5
! !

!IntegerArrayTest methodsFor: 'testing' stamp: 'HilaireFernandes 3/29/2010 21:58'!
testPutNegative
	| array |
	array := IntegerArray new: 2.
	array at: 2 put: -1000.
	self assert: (array at: 2) = -1000! !

!IntegerArrayTest methodsFor: 'testing' stamp: 'HilaireFernandes 3/29/2010 21:59'!
testPutAllNegative
	| array |
	array := IntegerArray new: 2.
	array  atAllPut: -1000.
	self assert: (array at: 2) = -1000! !

!IntegerDigitLogicTest commentStamp: 'TorstenBergmann 2/5/2014 08:37'!
SUnit test to test digit logic of integers!
!IntegerDigitLogicTest methodsFor: 'tests' stamp: 'hmm 1/7/2002 21:12'!
testNBitAndNNegatedEqualsN
	"Verify that (n bitAnd: n negated) = n for single bits"
	| n |
	1 to: 100 do: [:i | n := 1 bitShift: i.
				self assert: (n bitAnd: n negated) = n]! !

!IntegerDigitLogicTest methodsFor: 'tests' stamp: 'hmm 1/7/2002 21:12'!
testAndSingleBitWithMinusOne
	"And a single bit with -1 and test for same value"
	1 to: 100 do: [:i | self assert: ((1 bitShift: i) bitAnd: -1) = (1 bitShift: i)].! !

!IntegerDigitLogicTest methodsFor: 'tests' stamp: 'hmm 1/7/2002 21:13'!
testShiftMinusOne1LeftThenRight
	"Shift -1 left then right and test for 1"
	1 to: 100 do: [:i | self assert: ((-1 bitShift: i) bitShift: i negated) = -1].
! !

!IntegerDigitLogicTest methodsFor: 'tests' stamp: 'hmm 1/7/2002 21:12'!
testNNegatedEqualsNComplementedPlusOne
	"Verify that n negated = (n complemented + 1) for single bits"
	| n |
	1 to: 100 do: [:i | n := 1 bitShift: i.
				self assert: n negated = ((n bitXor: -1) + 1)]! !

!IntegerDigitLogicTest methodsFor: 'tests' stamp: 'hmm 1/7/2002 21:12'!
testShiftOneLeftThenRight
	"Shift 1 bit left then right and test for 1"
	1 to: 100 do: [:i | self assert: ((1 bitShift: i) bitShift: i negated) = 1].
! !

!IntegerDigitLogicTest methodsFor: 'tests' stamp: 'hmm 1/7/2002 21:13'!
testMixedSignDigitLogic
	"Verify that mixed sign logic with large integers works."
	self assert: (-2 bitAnd: 16rFFFFFFFF) = 16rFFFFFFFE! !

!IntegerDigitLogicTest methodsFor: 'tests' stamp: 'StephaneDucasse 2/11/2010 21:06'!
testLargeShift
	"A sanity check for LargeInteger bitShifts"
	"self debug: #testLargeShift"
	| suite |
	suite := #(     "some numbers on 64 bits or less"
               '101101011101001100110111110110011101101101000001110110011'
               '1101101001100010011001101110100000111011011010100011101100'
               '101101101011110011001100110011011101011001111000100011101000'
               '10101101101000101001111111111100101101011001011000100011100000'
               '1000101010101001111011101010111001011111110011110001000110000000'
               '1100101010101000010011101000110010111110110011110000000000000001' ).
	"65 bits or less"
	suite := suite , (suite collect: [:e | '1' , e reversed ]).
	"129 bits or less"
	suite := suite , (suite collect: [:e | e ,e ]).
	suite do: [:bits | | num ls rs |
		num := Integer readFrom: bits readStream base: 2.
		0 to: bits size-1 do: [:shift |
			ls := (num bitShift: shift) printStringBase: 2.
			rs := (num bitShift: 0-shift) printStringBase: 2.
			self assert: ls = (bits , (String new: shift withAll: $0)).
			self assert: rs = (bits copyFrom: 1 to: bits size - shift).]]! !

!IntegerTest commentStamp: 'TorstenBergmann 2/5/2014 08:37'!
SUnit tests for integers!
!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'SeanDeNigris 5/16/2012 20:52'!
testLowBit

	| suite |
	"Simple examples"
	self assert: (2r1011 lowBit) equals: 1.
	self assert: (2r1010 lowBit) equals: 2.
	self assert: (2r000000 lowBit) equals: 0.
	
	suite := (0 to: 1024) asArray , #(16rFDFD 16rFFFF 16r1000 16r1000000 16r1000001 16r70000000 16r7AFAFAFA ) , {SmallInteger maxVal . SmallInteger maxVal+1}.
	suite := suite , (suite collect: [:e | e raisedTo: 20]).
	
	suite do: [:anInteger |
		| lowBit |
		lowBit := (anInteger respondsTo: #bitAt:)
			ifTrue: [(1 to: anInteger highBit) detect: [:bitIndex | (anInteger bitAt: bitIndex) ~= 0] ifNone: [0]]
			ifFalse: [(1 to: anInteger highBit) detect: [:bitIndex | (anInteger bitAnd: (1 bitShift: bitIndex-1)) ~= 0] ifNone: [0]].
		self assert: anInteger lowBit = lowBit.
		self assert: anInteger negated lowBit = lowBit].! !

!IntegerTest methodsFor: 'tests - printing' stamp: 'SvenVanCaekenberghe 3/5/2014 22:17'!
testAsStringWithCommas
	self assert: 123456789 asStringWithCommas equals: '123,456,789'.
	self assert: -123456789 asStringWithCommas equals: '-123,456,789'! !

!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'SeanDeNigris 5/16/2012 20:21'!
testBitAnd

	self assert: (2r1100 bitAnd: 2r1010) equals: 2r1000.
	self assert: (2r1100 & 2r1010) equals: 2r1000.
	self assert: (-2 bitAnd: 16rFFFFFFFF) equals: 16rFFFFFFFE.
	self assert: (-2 & 16rFFFFFFFF) equals: 16rFFFFFFFE.! !

!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/13/2011 21:46'!
testSqrtErrorConditions
	"
	IntegerTest new testSqrtErrorConditions
	"

	self should: [ -1 sqrt ] raise: ArithmeticError! !

!IntegerTest methodsFor: 'testing - arithmetic' stamp: 'nice 9/6/2010 21:48'!
testReciprocalModulo
	1 to: 512 do: [:a |
		a + 1 to: 512 do: [:b |
			| c |
			(a gcd: b) = 1
				ifTrue:
					[c := a reciprocalModulo: b.
					self assert: (a * c) \\ b = 1]
				ifFalse: [self should: [ a reciprocalModulo: b ] raise: Error]]].! !

!IntegerTest methodsFor: 'tests - basic' stamp: 'HenrikSperreJohansen 1/19/2012 15:57'!
testAsSmallerPowerOfTwo
"Invalid input testing"
	"LargeNegativeIntegers"
	self should: [(2 raisedTo: 80) negated asSmallerPowerOfTwo] raise: DomainError.
	"Negative SmallIntegers"
	self should: [-1 asSmallerPowerOfTwo] raise: DomainError.
	"0"
	self should: [0 asSmallerPowerOfTwo] raise: DomainError.
"Valid inputs"
	"Small integers"
	self assert: 1 asSmallerPowerOfTwo equals: 1.
	self assert: 2 asSmallerPowerOfTwo equals: 2.
	self assert: 3 asSmallerPowerOfTwo equals: 2.
	self assert: 4 asSmallerPowerOfTwo equals: 4.
	self assert: 5 asSmallerPowerOfTwo equals: 4.
	"Large integers"
	self assert: ((2 raisedTo: 80) +1) asSmallerPowerOfTwo equals: (2 raisedTo: 80).
	self assert: (2 raisedTo: 80) asSmallerPowerOfTwo equals: (2 raisedTo: 80).
	self assert: ((2 raisedTo: 80) - 1) asSmallerPowerOfTwo equals: (2 raisedTo: 80 - 1)! !

!IntegerTest methodsFor: 'tests - printing' stamp: 'laza 3/30/2004 14:20'!
testNegativeIntegerPrinting
	"self run: #testnegativeIntegerPrinting"

	self assert: (-2 printStringBase: 2) = '-10'.
	self assert: (-2 radix: 2) = '-10'.
	self assert: -2 printStringHex = '-2'.
	self assert: (-2 storeStringBase: 2) = '-2r10'.
	self assert: -2 storeStringHex = '-16r2'.
	self assert: (-21 printStringBase: 3) = '-210'.
	self assert: (-21 radix: 3) = '-210'.
	self assert: -21 printStringHex = '-15'.
	self assert: (-21 storeStringBase: 3) = '-3r210'.
	self assert: -21 storeStringHex = '-16r15'.
	self assert: (-228 printStringBase: 4) = '-3210'.
	self assert: (-228 radix: 4) = '-3210'.
	self assert: -228 printStringHex = '-E4'.
	self assert: (-228 storeStringBase: 4) = '-4r3210'.
	self assert: -228 storeStringHex = '-16rE4'.
	self assert: (-2930 printStringBase: 5) = '-43210'.
	self assert: (-2930 radix: 5) = '-43210'.
	self assert: -2930 printStringHex = '-B72'.
	self assert: (-2930 storeStringBase: 5) = '-5r43210'.
	self assert: -2930 storeStringHex = '-16rB72'.
	self assert: (-44790 printStringBase: 6) = '-543210'.
	self assert: (-44790 radix: 6) = '-543210'.
	self assert: -44790 printStringHex = '-AEF6'.
	self assert: (-44790 storeStringBase: 6) = '-6r543210'.
	self assert: -44790 storeStringHex = '-16rAEF6'.
	self assert: (-800667 printStringBase: 7) = '-6543210'.
	self assert: (-800667 radix: 7) = '-6543210'.
	self assert: -800667 printStringHex = '-C379B'.
	self assert: (-800667 storeStringBase: 7) = '-7r6543210'.
	self assert: -800667 storeStringHex = '-16rC379B'.
	self assert: (-16434824 printStringBase: 8) = '-76543210'.
	self assert: (-16434824 radix: 8) = '-76543210'.
	self assert: -16434824 printStringHex = '-FAC688'.
	self assert: (-16434824 storeStringBase: 8) = '-8r76543210'.
	self assert: -16434824 storeStringHex = '-16rFAC688'.
	self assert: (-381367044 printStringBase: 9) = '-876543210'.
	self assert: (-381367044 radix: 9) = '-876543210'.
	self assert: -381367044 printStringHex = '-16BB3304'.
	self assert: (-381367044 storeStringBase: 9) = '-9r876543210'.
	self assert: -381367044 storeStringHex = '-16r16BB3304'.
	self assert: (-9876543210 printStringBase: 10) = '-9876543210'.
	self assert: (-9876543210 radix: 10) = '-9876543210'.
	self assert: -9876543210 printStringHex = '-24CB016EA'.
	self assert: (-9876543210 storeStringBase: 10) = '-9876543210'.
	self assert: -9876543210 storeStringHex = '-16r24CB016EA'.
	self assert: (-282458553905 printStringBase: 11) = '-A9876543210'.
	self assert: (-282458553905 radix: 11) = '-A9876543210'.
	self assert: -282458553905 printStringHex = '-41C3D77E31'.
	self assert: (-282458553905 storeStringBase: 11) = '-11rA9876543210'.
	self assert: -282458553905 storeStringHex = '-16r41C3D77E31'.
	self assert: (-8842413667692 printStringBase: 12) = '-BA9876543210'.
	self assert: (-8842413667692 radix: 12) = '-BA9876543210'.
	self assert: -8842413667692 printStringHex = '-80AC8ECF56C'.
	self assert: (-8842413667692 storeStringBase: 12) = '-12rBA9876543210'.
	self assert: -8842413667692 storeStringHex = '-16r80AC8ECF56C'.
	self assert: (-300771807240918 printStringBase: 13) = '-CBA9876543210'.
	self assert: (-300771807240918 radix: 13) = '-CBA9876543210'.
	self assert: -300771807240918 printStringHex = '-1118CE4BAA2D6'.
	self assert: (-300771807240918 storeStringBase: 13) = '-13rCBA9876543210'.
	self assert: -300771807240918 storeStringHex = '-16r1118CE4BAA2D6'.
	self assert: (-11046255305880158 printStringBase: 14) = '-DCBA9876543210'.
	self assert: (-11046255305880158 radix: 14) = '-DCBA9876543210'.
	self assert: -11046255305880158 printStringHex = '-273E82BB9AF25E'.
	self assert: (-11046255305880158 storeStringBase: 14) = '-14rDCBA9876543210'.
	self assert: -11046255305880158 storeStringHex = '-16r273E82BB9AF25E'.
	self assert: (-435659737878916215 printStringBase: 15) = '-EDCBA9876543210'.
	self assert: (-435659737878916215 radix: 15) = '-EDCBA9876543210'.
	self assert: -435659737878916215 printStringHex = '-60BC6392F366C77'.
	self assert: (-435659737878916215 storeStringBase: 15) = '-15rEDCBA9876543210'.
	self assert: -435659737878916215 storeStringHex = '-16r60BC6392F366C77'.
	self assert: (-18364758544493064720 printStringBase: 16) = '-FEDCBA9876543210'.
	self assert: (-18364758544493064720 radix: 16) = '-FEDCBA9876543210'.
	self assert: -18364758544493064720 printStringHex = '-FEDCBA9876543210'.
	self assert: (-18364758544493064720 storeStringBase: 16) = '-16rFEDCBA9876543210'.
	self assert: -18364758544493064720 storeStringHex = '-16rFEDCBA9876543210'.
	self assert: (-824008854613343261192 printStringBase: 17) = '-GFEDCBA9876543210'.
	self assert: (-824008854613343261192 radix: 17) = '-GFEDCBA9876543210'.
	self assert: -824008854613343261192 printStringHex = '-2CAB6B877C1CD2D208'.
	self assert: (-824008854613343261192 storeStringBase: 17) = '-17rGFEDCBA9876543210'.
	self assert: -824008854613343261192 storeStringHex = '-16r2CAB6B877C1CD2D208'.
	self assert: (-39210261334551566857170 printStringBase: 18) = '-HGFEDCBA9876543210'.
	self assert: (-39210261334551566857170 radix: 18) = '-HGFEDCBA9876543210'.
	self assert: -39210261334551566857170 printStringHex = '-84D97AFCAE81415B3D2'.
	self assert: (-39210261334551566857170 storeStringBase: 18) = '-18rHGFEDCBA9876543210'.
	self assert: -39210261334551566857170 storeStringHex = '-16r84D97AFCAE81415B3D2'.
	self assert: (-1972313422155189164466189 printStringBase: 19) = '-IHGFEDCBA9876543210'.
	self assert: (-1972313422155189164466189 radix: 19) = '-IHGFEDCBA9876543210'.
	self assert: -1972313422155189164466189 printStringHex = '-1A1A75329C5C6FC00600D'.
	self assert: (-1972313422155189164466189 storeStringBase: 19) = '-19rIHGFEDCBA9876543210'.
	self assert: -1972313422155189164466189 storeStringHex = '-16r1A1A75329C5C6FC00600D'.
	self assert: (-104567135734072022160664820 printStringBase: 20) = '-JIHGFEDCBA9876543210'.
	self assert: (-104567135734072022160664820 radix: 20) = '-JIHGFEDCBA9876543210'.
	self assert: -104567135734072022160664820 printStringHex = '-567EF3C9636D242A8C68F4'.
	self assert: (-104567135734072022160664820 storeStringBase: 20) = '-20rJIHGFEDCBA9876543210'.
	self assert: -104567135734072022160664820 storeStringHex = '-16r567EF3C9636D242A8C68F4'.
	self assert: (-5827980550840017565077671610 printStringBase: 21) = '-KJIHGFEDCBA9876543210'.
	self assert: (-5827980550840017565077671610 radix: 21) = '-KJIHGFEDCBA9876543210'.
	self assert: -5827980550840017565077671610 printStringHex = '-12D4CAE2B8A09BCFDBE30EBA'.
	self assert: (-5827980550840017565077671610 storeStringBase: 21) = '-21rKJIHGFEDCBA9876543210'.
	self assert: -5827980550840017565077671610 storeStringHex = '-16r12D4CAE2B8A09BCFDBE30EBA'.
	self assert: (-340653664490377789692799452102 printStringBase: 22) = '-LKJIHGFEDCBA9876543210'.
	self assert: (-340653664490377789692799452102 radix: 22) = '-LKJIHGFEDCBA9876543210'.
	self assert: -340653664490377789692799452102 printStringHex = '-44CB61B5B47E1A5D8F88583C6'.
	self assert: (-340653664490377789692799452102 storeStringBase: 22) = '-22rLKJIHGFEDCBA9876543210'.
	self assert: -340653664490377789692799452102 storeStringHex = '-16r44CB61B5B47E1A5D8F88583C6'.
	self assert: (-20837326537038308910317109288851 printStringBase: 23) = '-MLKJIHGFEDCBA9876543210'.
	self assert: (-20837326537038308910317109288851 radix: 23) = '-MLKJIHGFEDCBA9876543210'.
	self assert: -20837326537038308910317109288851 printStringHex = '-1070108876456E0EF115B389F93'.
	self assert: (-20837326537038308910317109288851 storeStringBase: 23) = '-23rMLKJIHGFEDCBA9876543210'.
	self assert: -20837326537038308910317109288851 storeStringHex = '-16r1070108876456E0EF115B389F93'.
	self assert: (-1331214537196502869015340298036888 printStringBase: 24) = '-NMLKJIHGFEDCBA9876543210'.
	self assert: (-1331214537196502869015340298036888 radix: 24) = '-NMLKJIHGFEDCBA9876543210'.
	self assert: -1331214537196502869015340298036888 printStringHex = '-41A24A285154B026B6ED206C6698'.
	self assert: (-1331214537196502869015340298036888 storeStringBase: 24) = '-24rNMLKJIHGFEDCBA9876543210'.
	self assert: -1331214537196502869015340298036888 storeStringHex = '-16r41A24A285154B026B6ED206C6698'.
	self assert: (-88663644327703473714387251271141900 printStringBase: 25) = '-ONMLKJIHGFEDCBA9876543210'.
	self assert: (-88663644327703473714387251271141900 radix: 25) = '-ONMLKJIHGFEDCBA9876543210'.
	self assert: -88663644327703473714387251271141900 printStringHex = '-111374860A2C6CEBE5999630398A0C'.
	self assert: (-88663644327703473714387251271141900 storeStringBase: 25) = '-25rONMLKJIHGFEDCBA9876543210'.
	self assert: -88663644327703473714387251271141900 storeStringHex = '-16r111374860A2C6CEBE5999630398A0C'.
	self assert: (-6146269788878825859099399609538763450 printStringBase: 26) = '-PONMLKJIHGFEDCBA9876543210'.
	self assert: (-6146269788878825859099399609538763450 radix: 26) = '-PONMLKJIHGFEDCBA9876543210'.
	self assert: -6146269788878825859099399609538763450 printStringHex = '-49FBA7F30B0F48BD14E6A99BD8ADABA'.
	self assert: (-6146269788878825859099399609538763450 storeStringBase: 26) = '-26rPONMLKJIHGFEDCBA9876543210'.
	self assert: -6146269788878825859099399609538763450 storeStringHex = '-16r49FBA7F30B0F48BD14E6A99BD8ADABA'.
	self assert: (-442770531899482980347734468443677777577 printStringBase: 27) = '-QPONMLKJIHGFEDCBA9876543210'.
	self assert: (-442770531899482980347734468443677777577 radix: 27) = '-QPONMLKJIHGFEDCBA9876543210'.
	self assert: -442770531899482980347734468443677777577 printStringHex = '-14D1A80A997343640C1145A073731DEA9'.
	self assert: (-442770531899482980347734468443677777577 storeStringBase: 27) = '-27rQPONMLKJIHGFEDCBA9876543210'.
	self assert: -442770531899482980347734468443677777577 storeStringHex = '-16r14D1A80A997343640C1145A073731DEA9'.
	self assert: (-33100056003358651440264672384704297711484 printStringBase: 28) = '-RQPONMLKJIHGFEDCBA9876543210'.
	self assert: (-33100056003358651440264672384704297711484 radix: 28) = '-RQPONMLKJIHGFEDCBA9876543210'.
	self assert: -33100056003358651440264672384704297711484 printStringHex = '-6145B6E6DACFA25D0E936F51D25932377C'.
	self assert: (-33100056003358651440264672384704297711484 storeStringBase: 28) = '-28rRQPONMLKJIHGFEDCBA9876543210'.
	self assert: -33100056003358651440264672384704297711484 storeStringHex = '-16r6145B6E6DACFA25D0E936F51D25932377C'.
	self assert: (-2564411043271974895869785066497940850811934 printStringBase: 29) = '-SRQPONMLKJIHGFEDCBA9876543210'.
	self assert: (-2564411043271974895869785066497940850811934 radix: 29) = '-SRQPONMLKJIHGFEDCBA9876543210'.
	self assert: -2564411043271974895869785066497940850811934 printStringHex = '-1D702071CBA4A1597D4DD37E95EFAC79241E'.
	self assert: (-2564411043271974895869785066497940850811934 storeStringBase: 29) = '-29rSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: -2564411043271974895869785066497940850811934 storeStringHex = '-16r1D702071CBA4A1597D4DD37E95EFAC79241E'.
	self assert: (-205646315052919334126040428061831153388822830 printStringBase: 30) = '-TSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: (-205646315052919334126040428061831153388822830 radix: 30) = '-TSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: -205646315052919334126040428061831153388822830 printStringHex = '-938B4343B54B550989989D02998718FFB212E'.
	self assert: (-205646315052919334126040428061831153388822830 storeStringBase: 30) = '-30rTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: -205646315052919334126040428061831153388822830 storeStringHex = '-16r938B4343B54B550989989D02998718FFB212E'.
	self assert: (-17050208381689099029767742314582582184093573615 printStringBase: 31) = '-UTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: (-17050208381689099029767742314582582184093573615 radix: 31) = '-UTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: -17050208381689099029767742314582582184093573615 printStringHex = '-2FC8ECB1521BA16D24A69E976D53873E2C661EF'.
	self assert: (-17050208381689099029767742314582582184093573615 storeStringBase: 31) = '-31rUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: -17050208381689099029767742314582582184093573615 storeStringHex = '-16r2FC8ECB1521BA16D24A69E976D53873E2C661EF'.
	self assert: (-1459980823972598128486511383358617792788444579872 printStringBase: 32) = '-VUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: (-1459980823972598128486511383358617792788444579872 radix: 32) = '-VUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: -1459980823972598128486511383358617792788444579872 printStringHex = '-FFBBCDEB38BDAB49CA307B9AC5A928398A418820'.
	self assert: (-1459980823972598128486511383358617792788444579872 storeStringBase: 32) = '-32rVUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: -1459980823972598128486511383358617792788444579872 storeStringHex = '-16rFFBBCDEB38BDAB49CA307B9AC5A928398A418820'.
	self assert: (-128983956064237823710866404905431464703849549412368 printStringBase: 33) = '-WVUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: (-128983956064237823710866404905431464703849549412368 radix: 33) = '-WVUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: -128983956064237823710866404905431464703849549412368 printStringHex = '-584120A0328DE272AB055A8AA003CE4A559F223810'.
	self assert: (-128983956064237823710866404905431464703849549412368 storeStringBase: 33) = '-33rWVUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: -128983956064237823710866404905431464703849549412368 storeStringHex = '-16r584120A0328DE272AB055A8AA003CE4A559F223810'.
	self assert: (-11745843093701610854378775891116314824081102660800418 printStringBase: 34) = '-XWVUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: (-11745843093701610854378775891116314824081102660800418 radix: 34) = '-XWVUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: -11745843093701610854378775891116314824081102660800418 printStringHex = '-1F64D4FC76000F7B92CF0CD5D0F350139AB9F25D8FA2'.
	self assert: (-11745843093701610854378775891116314824081102660800418 storeStringBase: 34) = '-34rXWVUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: -11745843093701610854378775891116314824081102660800418 storeStringHex = '-16r1F64D4FC76000F7B92CF0CD5D0F350139AB9F25D8FA2'.
	self assert: (-1101553773143634726491620528194292510495517905608180485 printStringBase: 35) = '-YXWVUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: (-1101553773143634726491620528194292510495517905608180485 radix: 35) = '-YXWVUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: -1101553773143634726491620528194292510495517905608180485 printStringHex = '-B8031AD55AD1FAA89E07A271CA1ED2F420415D1570305'.
	self assert: (-1101553773143634726491620528194292510495517905608180485 storeStringBase: 35) = '-35rYXWVUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: -1101553773143634726491620528194292510495517905608180485 storeStringHex = '-16rB8031AD55AD1FAA89E07A271CA1ED2F420415D1570305'.
	self assert: (-106300512100105327644605138221229898724869759421181854980 printStringBase: 36) = '-ZYXWVUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: (-106300512100105327644605138221229898724869759421181854980 radix: 36) = '-ZYXWVUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: -106300512100105327644605138221229898724869759421181854980 printStringHex = '-455D441E55A37239AB4C303189576071AF5578FFCA80504'.
	self assert: (-106300512100105327644605138221229898724869759421181854980 storeStringBase: 36) = '-36rZYXWVUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: -106300512100105327644605138221229898724869759421181854980 storeStringHex = '-16r455D441E55A37239AB4C303189576071AF5578FFCA80504'.! !

!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/13/2011 21:46'!
testExactRaisedTo
	"
	IntegerTest new testExactRaisedTo
	"
	self assert: (4 raisedTo: 1/2) classAndValueEquals: 2.
	self assert: (9 raisedTo: 1/2) classAndValueEquals: 3.
	self assert: (9 raisedTo: -1/2) classAndValueEquals: 1/3.
	self assert: (-1 raisedTo: 1/3) classAndValueEquals: -1.
	#( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) do: [ :i |
		self assert: (i squared raisedTo: 1/2) classAndValueEquals: i.
		self assert: (i negated squared raisedTo: 1/2) classAndValueEquals: i ].

	self assert: (8 raisedTo: 1/3) classAndValueEquals: 2.
	self assert: (27 raisedTo: 1/3) classAndValueEquals: 3.
	#( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) do: [ :i |
		self assert: ((i raisedTo: 3) raisedTo: 1/3) classAndValueEquals: i.
		self assert: ((i negated raisedTo: 3) raisedTo: 1/3) classAndValueEquals: i negated ].

	self assert: (4 raisedTo: 3/2) classAndValueEquals: 8.
	self assert: (8 raisedTo: 2/3) classAndValueEquals: 4.
	self assert: (8 raisedTo: -2/3) classAndValueEquals: 1/4.
	#( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) do: [ :i |
		self assert: ((i raisedTo: 3) raisedTo: 2/3) classAndValueEquals: i*i.
		self assert: ((i raisedTo: 2) raisedTo: 3/2) classAndValueEquals: i*i*i.
		self assert: ((i negated raisedTo: 3) raisedTo: 2/3) classAndValueEquals: i*i.
		self assert: ((i negated raisedTo: 2) raisedTo: 3/2) classAndValueEquals: i*i*i ].

	self assert: (32 raisedTo: 3/5) classAndValueEquals: 8.
	self assert: (8 raisedTo: 5/3) classAndValueEquals: 32.
	#( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) do: [ :i |
		self assert: ((i raisedTo: 5) raisedTo: 3/5) classAndValueEquals: i*i*i.
		self assert: ((i raisedTo: 3) raisedTo: 5/3) classAndValueEquals: i*i*i*i*i.
		self assert: ((i negated raisedTo: 5) raisedTo: 3/5) classAndValueEquals: (i*i*i) negated.
		self assert: ((i negated raisedTo: 3) raisedTo: 5/3) classAndValueEquals: (i*i*i*i*i) negated.

		self assert: ((i raisedTo: -5) raisedTo: 3/5) classAndValueEquals: 1/(i*i*i).
		self assert: ((i raisedTo: -3) raisedTo: 5/3) classAndValueEquals: 1/(i*i*i*i*i).
		self assert: ((i negated raisedTo: -5) raisedTo: 3/5) classAndValueEquals: -1/(i*i*i).
		self assert: ((i negated raisedTo: -3) raisedTo: 5/3) classAndValueEquals: -1/(i*i*i*i*i).

		self assert: ((i raisedTo: 5) raisedTo: -3/5) classAndValueEquals: 1/(i*i*i).
		self assert: ((i raisedTo: 3) raisedTo: -5/3) classAndValueEquals: 1/(i*i*i*i*i).
		self assert: ((i negated raisedTo: 5) raisedTo: -3/5) classAndValueEquals: -1/(i*i*i).
		self assert: ((i negated raisedTo: 3) raisedTo: -5/3) classAndValueEquals: -1/(i*i*i*i*i).

		"No exact result => Float result"
		self assert: ((i raisedTo: 3) +1 raisedTo: 5/3) isFloat.
		self assert: ((i negated raisedTo: 3) -1 raisedTo: 5/3) isFloat ].! !

!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'sd 6/5/2005 08:44'!
testTwoComplementRightShift
	"self run: #testTwoComplementRightShift"

	| large small |
	small := 2 << 16.
	large := 2 << 32.	
	self assert: ((small negated bitShift: -1) ~= ((small + 1) negated bitShift: -1)
		== ((large negated bitShift: -1) ~= ((large + 1) negated bitShift: -1))).
		
     self assert: ((small bitShift: -1) ~= (small + 1 bitShift: -1)
		== ((large bitShift: -1) ~= (large + 1 bitShift: -1))).! !

!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'SeanDeNigris 5/16/2012 20:37'!
testBitClear

	self assert: (2r1111 bitClear: 2r1000) equals: 2r0111.
	self assert: (2r1111 bitClear: 2r0100) equals: 2r1011.
	self assert: (2r1111 bitClear: 2r0010) equals: 2r1101.
	self assert: (2r1111 bitClear: 2r0001) equals: 2r1110.! !

!IntegerTest methodsFor: 'tests - instance creation' stamp: 'sd 6/5/2005 08:48'!
testCreationFromBytes2
 	"self run: #testCreationFromBytes2"

	"it is illegal for a LargeInteger to be less than SmallInteger maxVal." 
	"here we test that Integer>>byte!!byte2:byte3:byte4: resconstructs (SmallInteger maxVal + 1) as an instance of LargePositiveInteger. "
	| maxSmallInt hexString byte1 byte2 byte3 byte4 builtInteger |
	maxSmallInt := SmallInteger maxVal.
	hexString := (maxSmallInt + 1) printStringHex.
	self assert: hexString size = 8.
	byte4 := Number readFrom: (hexString copyFrom: 1 to: 2) base: 16.
	byte3 := Number readFrom: (hexString copyFrom: 3 to: 4) base: 16.
	byte2 := Number readFrom: (hexString copyFrom: 5 to: 6) base: 16.
	byte1 := Number readFrom: (hexString copyFrom: 7 to: 8) base: 16.
	builtInteger := Integer byte1: byte1 byte2: byte2 byte3: byte3 byte4: byte4.
	self assert: builtInteger = (maxSmallInt + 1).
	self deny: builtInteger class = SmallInteger
! !

!IntegerTest methodsFor: 'tests - basic' stamp: 'HenrikSperreJohansen 1/19/2012 15:56'!
testAsLargerPowerOfTwo
"Invalid input testing"
	"LargeNegativeIntegers"
	self should: [(2 raisedTo: 80) negated asLargerPowerOfTwo] raise: DomainError.
	"Negative SmallIntegers"
	self should: [-1 asLargerPowerOfTwo] raise: DomainError.
	"0"
	self should: [0 asLargerPowerOfTwo] raise: DomainError.
"Valid inputs"
	"Small integers"
	self assert: 1 asLargerPowerOfTwo equals: 1.
	self assert: 2 asLargerPowerOfTwo equals: 2.
	self assert: 3 asLargerPowerOfTwo equals: 4.
	self assert: 4 asLargerPowerOfTwo equals: 4.
	self assert: 5 asLargerPowerOfTwo equals: 8.
	"Large integers"
	self assert: ((2 raisedTo: 80) +1) asLargerPowerOfTwo equals: (2 raisedTo: 80 +1).
	self assert: (2 raisedTo: 80) asLargerPowerOfTwo equals: (2 raisedTo: 80).
	self assert: ((2 raisedTo: 80) - 1) asLargerPowerOfTwo equals: (2 raisedTo: 80)! !

!IntegerTest methodsFor: 'tests - printing' stamp: 'StephaneDucasse 7/21/2010 18:01'!
testPrintStringHex
	"self run: #testPrintStringHex"
	self assert: 0 printStringHex = '0'.
	self assert: 12 printStringHex = 'C'.
	self assert: 1234 printStringHex = '4D2'.! !

!IntegerTest methodsFor: 'tests - instance creation' stamp: 'sd 6/5/2005 08:49'!
testCreationFromBytes3
	"self run: #testCreationFromBytes3"

	"it is illegal for a LargeInteger to be less than SmallInteger maxVal." 
	"here we test that Integer>>byte!!byte2:byte3:byte4: resconstructs (SmallInteger maxVal - 1) as an instance of SmallInteger. "
	| maxSmallInt hexString byte1 byte2 byte3 byte4 
    builtInteger |
	maxSmallInt := SmallInteger maxVal.
	hexString := (maxSmallInt - 1) printStringHex.
	self assert: hexString size = 8.
	byte4 := Number readFrom: (hexString copyFrom: 1 to: 2) base: 16.
	byte3 := Number readFrom: (hexString copyFrom: 3 to: 4) base: 16.
	byte2 := Number readFrom: (hexString copyFrom: 5 to: 6) base: 16.
	byte1 := Number readFrom: (hexString copyFrom: 7 to: 8) base: 16.
	builtInteger := Integer byte1: byte1 byte2: byte2 byte3: byte3 byte4: byte4.
	self assert: builtInteger = (maxSmallInt - 1).
	self assert: builtInteger class = SmallInteger
! !

!IntegerTest methodsFor: 'tests - benchmarks' stamp: 'sd 6/5/2005 08:37'!
testBenchFib

	self assert: (0 benchFib = 1).
	self assert: (1 benchFib = 1).
	self assert: (2 benchFib = 3).
	! !

!IntegerTest methodsFor: 'tests - basic' stamp: 'nice 1/25/2008 22:51'!
testIsPowerOfTwoM6873
	"This is a non regression test for http://bugs.squeak.org/view.php?id=6873"

	self deny: ((1 to: 80) anySatisfy: [:n | (2 raisedTo: n) negated isPowerOfTwo])
		description: 'A negative integer cannot be a power of two'.! !

!IntegerTest methodsFor: 'tests - basic' stamp: 'md 2/12/2006 14:36'!
testPrimesUpTo

	| primes nn|
	primes := Integer primesUpTo: 100.
	self assert: primes = #(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97).
	
	"upTo: semantics means 'non-inclusive'"
	primes := Integer primesUpTo: 5.
	self assert: primes = #(2 3).
	
	"this test is green for nn>25000, see #testLargePrimesUpTo"
	nn := 5. 
	self deny: (Integer primesUpTo: nn) last = nn.
	self assert: (Integer primesUpTo: nn + 1) last  = nn.! !

!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'nice 1/26/2008 02:22'!
testTwoComplementBitLogicWithCarry
	"This is non regression test for http://bugs.squeak.org/view.php?id=6874"
	
	"By property of two complement, following operation is:
	...111110000 this is -16
	...111101111 this is -16-1
	...111100000 this is -32, the result of bitAnd: on two complement
	
	This test used to fail with n=31 39 47.... because of bug 6874"
	
	self assert: ((2 to: 80) allSatisfy: [:n | ((2 raisedTo: n) negated bitAnd: (2 raisedTo: n) negated - 1) = (2 raisedTo: n + 1) negated]).! !

!IntegerTest methodsFor: 'tests - printing' stamp: 'StephaneDucasse 7/21/2010 18:02'!
testIntegerHex
	| result |
	result := 15 asInteger hex.
	self assert: result = '16rF'.
	result := 0 asInteger hex.
	self assert: result = '16r0'.
	result := 255 asInteger hex.
	self assert: result = '16rFF'.
	result := 90 asInteger hex.
	self assert: result = '16r5A'! !

!IntegerTest methodsFor: 'tests - instance creation' stamp: 'GuillermoPolito 8/24/2010 19:10'!
testIntegerReadsOkFromStream
	self assert: (Integer readFrom: '123' readStream) = 123.
	self assert: (Integer readFrom: '-123' readStream) = -123.
	self assert: (Integer readFrom: 'a3' readStream base: 16) = 163.
	self assert: (Integer readFrom: '-a3' readStream base: 16) = -163.
	
	self assert: (Integer readFrom: '3a' readStream base: 10) = 3.! !

!IntegerTest methodsFor: 'tests - printing' stamp: 'fbs 2/9/2006 08:48'!
testPrintOnBaseShowRadix
	| s |
	s := ReadWriteStream on: ''.
	123 printOn: s base: 10 showRadix: false.
	self assert: (s contents = '123').
	
	s := ReadWriteStream on: ''.
	123 printOn: s base: 10 showRadix: true.
	self assert: (s contents = '10r123').
	
	s := ReadWriteStream on: ''.
	123 printOn: s base: 8 showRadix: false.
	self assert: (s contents = '173').
	
	s := ReadWriteStream on: ''.
	123 printOn: s base: 8 showRadix: true.
	self assert: (s contents = '8r173').! !

!IntegerTest methodsFor: 'tests - instance creation' stamp: 'GuillermoPolito 8/24/2010 19:08'!
testIntegerReadsOkFromString
	self assert: (Integer readFrom: '123') = 123.
	self assert: (Integer readFrom: '-123') = -123.
	self assert: (Integer readFrom: 'a3' base: 16) = 163.
	self assert: (Integer readFrom: '-a3' base: 16) = -163.! !

!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'CamilloBruni 8/31/2013 20:23'!
testDegreeSin
	"self run: #testDegreeSin"

	45 degreeSin.	"Following tests use approximate equality, because sine are generally evaluated using inexact Floating point arithmetic"
	self assert: (45 degreeSin squared - (1 / 2)) abs <= Float epsilon.
	self assert: (30 degreeSin - (1 / 2)) abs <= Float epsilon.
	self assert: (-30 degreeSin + (1 / 2)) abs <= Float epsilon.
	-360 to: 360 do: [ :i | self assert: (i degreeSin closeTo: i degreesToRadians sin) ].	"Following tests use strict equality which is a requested property of degreeSin"
	-10 to: 10 do: [ :k | 
		self assert: (k * 360 + 90) degreeSin - 1 = 0.
		self assert: (k * 360 - 90) degreeSin + 1 = 0.
		self assert: (k * 360 + 180) degreeSin = 0.
		self assert: (k * 360) degreeSin = 0 ]! !

!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'nice 6/12/2010 00:37'!
testLog
	self assert: (100 log closeTo: 2).
	self assert: ((2 raisedTo: Float emax + 3) log closeTo: 2 log*(Float emax + 3)) description: 'Integer>>log should not overflow'! !

!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/19/2011 22:59'!
testBigReceiverInexactNthRoot
	"
	IntegerTest new testBigReceiverInexactNthRoot
	"

	"Inexact 3rd root (not a whole cube number), so a Float must be answered.
	However, receiver is too big for Float arithmethic."
	| bigNum result |
	bigNum := (100 factorial raisedTo: 3) + 1.		"Add 1 so it is not a whole cube"
	self assert: bigNum asFloat isInfinite.			"Otherwise, we chose a bad sample"
	result := bigNum nthRoot: 3.
	self assert: result class == Float.
	self deny: result isInfinite.
	self assert: result = 100 factorial asFloat.		"No other float is closer. See following line"
	self assert: 100 factorial asFloat = (100 factorial+1) asFloat! !

!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'nice 10/19/2011 21:03'!
testNthRootTruncated
	<timeout:  5 "seconds">
	| tooBigToBeAFloat large |
	tooBigToBeAFloat := 1 << 2000.
	self assert: (tooBigToBeAFloat nthRootTruncated: 100) equals: 1 << 20.
	self assert: (tooBigToBeAFloat + 1 nthRootTruncated: 100) equals: 1 << 20.
	self assert: (tooBigToBeAFloat - 1 nthRootTruncated: 100) equals: 1 << 20 - 1.
	
	large := -3 raisedTo: 255.
	self assert: (large nthRootTruncated: 17) equals: (-3 raisedTo: 15).
	self assert: (large + 11 nthRootTruncated: 17) equals: (-3 raisedTo: 15) + 1.
	self assert: (large - 11 nthRootTruncated: 17) equals: (-3 raisedTo: 15).
	
	2 to: 10 do: [:thePower |
		1 to: 10000 do: [:n |
			| theTruncatedRoot |
			theTruncatedRoot := n nthRootTruncated: thePower.
			self assert: (theTruncatedRoot raisedTo: thePower) <= n.
			self assert: (theTruncatedRoot + 1 raisedTo: thePower) > n]]! !

!IntegerTest methodsFor: 'test - rounding' stamp: 'GuillermoPolito 6/22/2012 14:52'!
testRounding
        "
        self debug: #testRounding
        "

        self assert: (5 round: 2) equals: 5! !

!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'SeanDeNigris 5/16/2012 21:08'!
testBitLogic  
	"This little suite of tests is designed to verify correct operation of most of Pharo's bit manipulation code, including two's complement representation of negative values.  It was written in a hurry and is probably lacking several important checks."
	"self run: #testBitLogic"
	
	| n |
	"Shift 1 bit left then right and test for 1"
	1 to: 100 do: [:i | self assert: ((1 bitShift: i) bitShift: i negated) = 1].

	"Shift -1 left then right and test for 1"
	1 to: 100 do: [:i | self assert: ((-1 bitShift: i) bitShift: i negated) = -1].

	"And a single bit with -1 and test for same value"
	1 to: 100 do: [:i | self assert: ((1 bitShift: i) bitAnd: -1) = (1 bitShift: i)].

	"Verify that (n bitAnd: n negated) = n for single bits"
	1 to: 100 do: [:i |  n := 1 bitShift: i. self assert: (n bitAnd: n negated) = n].

	"Verify that n negated = (n complemented + 1) for single bits"
	1 to: 100 do: [:i | 
					n := 1 bitShift: i. 
					self assert: n negated = ((n bitXor: -1) + 1)].

	"Verify that (n + n complemented) = -1 for single bits"
	1 to: 100 do: [:i | 
					n := 1 bitShift: i.
					self assert: (n + (n bitXor: -1)) = -1].

	"Verify that n negated = (n complemented +1) for single bits"
	1 to: 100 do: [:i | 
					n := 1 bitShift: i.
					self assert: n negated = ((n bitXor: -1) + 1)].! !

!IntegerTest methodsFor: 'testing - arithmetic' stamp: 'mga 5/11/2006 15:41'!
testCrossSumBase
	"self run: #testCrossSumBase"

	self assert: (
		((-20 to: 20) collect: [:each | each crossSumBase: 10]) asArray = 
		#(2 10 9 8 7 6 5 4 3 2 1 9 8 7 6 5 4 3 2 1 0 1 2 3 4 5 6 7 8 9 1 2 3 4 5 6 7 8 9 10 2)).
	self assert: (
		((-20 to: 20) collect: [:each | each crossSumBase: 2]) asArray = 
		#(2 3 2 2 1 4 3 3 2 3 2 2 1 3 2 2 1 2 1 1 0 1 1 2 1 2 2 3 1 2 2 3 2 3 3 4 1 2 2 3 2)).
	self should: [10 crossSumBase: 1] raise: AssertionFailure! !

!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'SeanDeNigris 5/16/2012 21:09'!
testHighBit

	| suite |
	self assert: (2r1110 highBit) equals: 4.
	self assert: (2r0110 highBit) equals: 3.
	self assert: (2r0000 highBit) equals: 0.
	
	suite := (0 to: 1024) asArray , #(16rFDFD 16rFFFF 16r1000 16r1000000 16r1000001 16r70000000 16r7AFAFAFA ) , {SmallInteger maxVal . SmallInteger maxVal+1}.
	suite := suite , (suite collect: [:e | e raisedTo: 20]).
	
	suite do: [:anInteger |
		| highBit shifted |
		highBit := 0.
		shifted := 1.
		[shifted > anInteger] whileFalse: [highBit := highBit+1. shifted := shifted bitShift: 1].
		self assert: anInteger highBit = highBit].! !

!IntegerTest methodsFor: 'tests - instance creation' stamp: 'GuillermoPolito 8/24/2010 19:14'!
testIntegerReadsNotOkFromStream
	self should: [Integer readFrom: 'a23' readStream] raise: Error.
	self should: [Integer readFrom: '-a23' readStream] raise: Error.
	self should: [Integer readFrom: 'a3' readStream base: 8] raise: Error.
	self should: [Integer readFrom: '-a3' readStream base: 8] raise: Error.! !

!IntegerTest methodsFor: 'tests - basic' stamp: 'md 2/12/2006 14:40'!
testIsPrime

	"The following tests should return 'true'"
	self assert: 17 isPrime.
	self assert: 78901 isPrime.
	self assert: 104729 isPrime.
	self assert: 15485863 isPrime.
	self assert: 2038074743 isPrime.
	self assert: 29996224275833 isPrime.
	
	"The following tests should return 'false' (first 5 are Carmichael integers)"
	self deny: 561 isPrime.
	self deny: 2821 isPrime.
	self deny: 6601 isPrime.
	self deny: 10585 isPrime.
	self deny: 15841 isPrime.
	self deny: 256 isPrime.
	self deny: 29996224275831 isPrime.! !

!IntegerTest methodsFor: 'tests - printing' stamp: 'laza 3/29/2004 18:16'!
testIntegerPadding
	"self run: #testIntegerPadding"

	self assert: (1 printStringBase: 10 length: 0 padded: false) = '1'.
	self assert: (1 printStringBase: 10 length: 1 padded: false) = '1'.
	self assert: (1 printStringBase: 10 length: 2 padded: false) = ' 1'.
	self assert: (1024 printStringBase: 10 length: 19 padded: false) = '               1024'.
	self assert: (1024 printStringBase: 10 length: -1 padded: false) = '1024'.
	self assert: (1024 printStringBase: 10 length: 5 padded: false) =  ' 1024'.
	self assert: (-1024 printStringBase: 10 length: 5 padded: false) =   '-1024'.
	self assert: (-1024 printStringBase: 10 length: 19 padded: false) =  '              -1024'.

	self assert: (1 printStringBase: 10 length: 0 padded: true) = '1'.
	self assert: (1 printStringBase: 10 length: 1 padded: true) = '1'.
	self assert: (1 printStringBase: 10 length: 2 padded: true) = '01'.
	self assert: (1024 printStringBase: 10 length: 19 padded: true) = '0000000000000001024'.
	self assert: (1024 printStringBase: 10 length: -1 padded: true) = '1024'.
	self assert: (1024 printStringBase: 10 length: 5 padded: true) =  '01024'.
	self assert: (-1024 printStringBase: 10 length: 5 padded: true) =   '-1024'.
	self assert: (-1024 printStringBase: 10 length: 19 padded: true) =  '-000000000000001024'.

	self assert: (1 printStringBase: 16 length: 0 padded: false) = '1'.
	self assert: (1 printStringBase: 16 length: 1 padded: false) = '1'.
	self assert: (1 printStringBase: 16 length: 2 padded: false) = ' 1'.
	self assert: (2047 printStringBase: 16 length: 19 padded: false) =  '                7FF'.
	self assert: (2047 printStringBase: 16 length: -1 padded: false) =  '7FF'.
	self assert: (2047 printStringBase: 16 length: 4 padded: false) =  ' 7FF'.
	self assert: (-2047 printStringBase: 16 length: 4 padded: false) = '-7FF'.
	self assert: (-2047 printStringBase: 16 length: 19 padded: false) =  '               -7FF'.

	self assert: (1 printStringBase: 16 length: 0 padded: true) = '1'.
	self assert: (1 printStringBase: 16 length: 1 padded: true) = '1'.
	self assert: (1 printStringBase: 16 length: 2 padded: true) = '01'.
	self assert: (2047 printStringBase: 16 length: 19 padded: true) =  '00000000000000007FF'.
	self assert: (2047 printStringBase: 16 length: -1 padded: true) =  '7FF'.
	self assert: (2047 printStringBase: 16 length: 4 padded: true) =  '07FF'.
	self assert: (-2047 printStringBase: 16 length: 4 padded: true) = '-7FF'.
	self assert: (-2047 printStringBase: 16 length: 19 padded: true) =  '-0000000000000007FF'.

	self assert: (1 storeStringBase: 10 length: 0 padded: false) = '1'.
	self assert: (1 storeStringBase: 10 length: 1 padded: false) = '1'.
	self assert: (1 storeStringBase: 10 length: 2 padded: false) = ' 1'.
	self assert: (1024 storeStringBase: 10 length: 19 padded: false) = '               1024'.
	self assert: (1024 storeStringBase: 10 length: -1 padded: false) = '1024'.
	self assert: (1024 storeStringBase: 10 length: 5 padded: false) =  ' 1024'.
	self assert: (-1024 storeStringBase: 10 length: 5 padded: false) =   '-1024'.
	self assert: (-1024 storeStringBase: 10 length: 19 padded: false) =  '              -1024'.

	self assert: (1 storeStringBase: 10 length: 0 padded: true) = '1'.
	self assert: (1 storeStringBase: 10 length: 1 padded: true) = '1'.
	self assert: (1 storeStringBase: 10 length: 2 padded: true) = '01'.
	self assert: (1024 storeStringBase: 10 length: 19 padded: true) = '0000000000000001024'.
	self assert: (1024 storeStringBase: 10 length: -1 padded: true) = '1024'.
	self assert: (1024 storeStringBase: 10 length: 5 padded: true) =  '01024'.
	self assert: (-1024 storeStringBase: 10 length: 5 padded: true) =   '-1024'.
	self assert: (-1024 storeStringBase: 10 length: 19 padded: true) =  '-000000000000001024'.

	self assert: (1 storeStringBase: 16 length: 0 padded: false) = '16r1'.
	self assert: (1 storeStringBase: 16 length: 4 padded: false) = '16r1'.
	self assert: (1 storeStringBase: 16 length: 5 padded: false) = ' 16r1'.
	self assert: (2047 storeStringBase: 16 length: 19 padded: false) =  '             16r7FF'.
	self assert: (2047 storeStringBase: 16 length: -1 padded: false) =  '16r7FF'.
	self assert: (2047 storeStringBase: 16 length: 7 padded: false) =  ' 16r7FF'.
	self assert: (-2047 storeStringBase: 16 length: 7 padded: false) = '-16r7FF'.
	self assert: (-2047 storeStringBase: 16 length: 19 padded: false) =  '            -16r7FF'.

	self assert: (1 storeStringBase: 16 length: 0 padded: true) = '16r1'.
	self assert: (1 storeStringBase: 16 length: 4 padded: true) = '16r1'.
	self assert: (1 storeStringBase: 16 length: 5 padded: true) = '16r01'.
	self assert: (2047 storeStringBase: 16 length: 19 padded: true) =  '16r00000000000007FF'.
	self assert: (2047 storeStringBase: 16 length: -1 padded: true) =  '16r7FF'.
	self assert: (2047 storeStringBase: 16 length: 7 padded: true) =  '16r07FF'.
	self assert: (-2047 storeStringBase: 16 length: 7 padded: true) = '-16r7FF'.
	self assert: (-2047 storeStringBase: 16 length: 19 padded: true) =  '-16r0000000000007FF'.
! !

!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'SeanDeNigris 5/16/2012 20:26'!
testBitShift

	self assert: 2r11 << 2 equals: 2r1100.
	self assert: (2r11 bitShift: 2) equals: 2r1100.
	self assert: 2r1011 >> 2 equals: 2r10.
	self assert: (2r1011 bitShift: -2) equals: 2r10.! !

!IntegerTest methodsFor: 'tests - printing' stamp: 'SvenVanCaekenberghe 3/5/2014 22:16'!
testPrintSeparatedByEverySignedOn
	| printer |
	printer := [ :integer :printSigned | 
		String streamContents: [ :stream | 
			integer
				printSeparatedBy: $.
				every: 3
				signed: printSigned
				on: stream ] ].
	self assert: (printer value: 123456789 value: false) equals: '123.456.789'.
	self assert: (printer value: -123456789 value: false) equals: '-123.456.789'.
	self assert: (printer value: 123456789 value: true) equals: '+123.456.789'.
	self assert: (printer value: -123456789 value: true) equals: '-123.456.789'! !

!IntegerTest methodsFor: 'tests - basic' stamp: 'md 2/12/2006 14:36'!
testLargePrimesUpTo

	| nn | 
	nn := (2 raisedTo: 17) - 1. 
	self deny: (Integer primesUpTo: nn) last = nn.
	self assert: (Integer primesUpTo: nn + 1) last  = nn.
	
	
! !

!IntegerTest methodsFor: 'tests - printing' stamp: 'laza 3/30/2004 09:23'!
testRomanPrinting
	self assert: 0 printStringRoman = ''. "No symbol for zero"
	self assert: 1 printStringRoman = 'I'.
	self assert: 2 printStringRoman = 'II'.
	self assert: 3 printStringRoman = 'III'.
	self assert: 4 printStringRoman = 'IV'.
	self assert: 5 printStringRoman = 'V'.
	self assert: 6 printStringRoman = 'VI'.
	self assert: 7 printStringRoman = 'VII'.
	self assert: 8 printStringRoman = 'VIII'.
	self assert: 9 printStringRoman = 'IX'.
	self assert: 10 printStringRoman = 'X'.
	self assert: 23 printStringRoman = 'XXIII'.
	self assert: 36 printStringRoman = 'XXXVI'.
	self assert: 49 printStringRoman = 'XLIX'.
	self assert: 62 printStringRoman = 'LXII'.
	self assert: 75 printStringRoman = 'LXXV'.
	self assert: 88 printStringRoman = 'LXXXVIII'.
	self assert: 99 printStringRoman = 'XCIX'.
	self assert: 100 printStringRoman = 'C'.
	self assert: 101 printStringRoman = 'CI'.
	self assert: 196 printStringRoman = 'CXCVI'.
	self assert: 197 printStringRoman = 'CXCVII'.
	self assert: 198 printStringRoman = 'CXCVIII'.
	self assert: 293 printStringRoman = 'CCXCIII'.
	self assert: 294 printStringRoman = 'CCXCIV'.
	self assert: 295 printStringRoman = 'CCXCV'.
	self assert: 390 printStringRoman = 'CCCXC'.
	self assert: 391 printStringRoman = 'CCCXCI'.
	self assert: 392 printStringRoman = 'CCCXCII'.
	self assert: 487 printStringRoman = 'CDLXXXVII'.
	self assert: 488 printStringRoman = 'CDLXXXVIII'.
	self assert: 489 printStringRoman = 'CDLXXXIX'.
	self assert: 584 printStringRoman = 'DLXXXIV'.
	self assert: 585 printStringRoman = 'DLXXXV'.
	self assert: 586 printStringRoman = 'DLXXXVI'.
	self assert: 681 printStringRoman = 'DCLXXXI'.
	self assert: 682 printStringRoman = 'DCLXXXII'.
	self assert: 683 printStringRoman = 'DCLXXXIII'.
	self assert: 778 printStringRoman = 'DCCLXXVIII'.
	self assert: 779 printStringRoman = 'DCCLXXIX'.
	self assert: 780 printStringRoman = 'DCCLXXX'.
	self assert: 875 printStringRoman = 'DCCCLXXV'.
	self assert: 876 printStringRoman = 'DCCCLXXVI'.
	self assert: 877 printStringRoman = 'DCCCLXXVII'.
	self assert: 972 printStringRoman = 'CMLXXII'.
	self assert: 973 printStringRoman = 'CMLXXIII'.
	self assert: 974 printStringRoman = 'CMLXXIV'.
	self assert: 1069 printStringRoman = 'MLXIX'.
	self assert: 1070 printStringRoman = 'MLXX'.
	self assert: 1071 printStringRoman = 'MLXXI'.
	self assert: 1166 printStringRoman = 'MCLXVI'.
	self assert: 1167 printStringRoman = 'MCLXVII'.
	self assert: 1168 printStringRoman = 'MCLXVIII'.
	self assert: 1263 printStringRoman = 'MCCLXIII'.
	self assert: 1264 printStringRoman = 'MCCLXIV'.
	self assert: 1265 printStringRoman = 'MCCLXV'.
	self assert: 1360 printStringRoman = 'MCCCLX'.
	self assert: 1361 printStringRoman = 'MCCCLXI'.
	self assert: 1362 printStringRoman = 'MCCCLXII'.
	self assert: 1457 printStringRoman = 'MCDLVII'.
	self assert: 1458 printStringRoman = 'MCDLVIII'.
	self assert: 1459 printStringRoman = 'MCDLIX'.
	self assert: 1554 printStringRoman = 'MDLIV'.
	self assert: 1555 printStringRoman = 'MDLV'.
	self assert: 1556 printStringRoman = 'MDLVI'.
	self assert: 1651 printStringRoman = 'MDCLI'.
	self assert: 1652 printStringRoman = 'MDCLII'.
	self assert: 1653 printStringRoman = 'MDCLIII'.
	self assert: 1748 printStringRoman = 'MDCCXLVIII'.
	self assert: 1749 printStringRoman = 'MDCCXLIX'.
	self assert: 1750 printStringRoman = 'MDCCL'.
	self assert: 1845 printStringRoman = 'MDCCCXLV'.
	self assert: 1846 printStringRoman = 'MDCCCXLVI'.
	self assert: 1847 printStringRoman = 'MDCCCXLVII'.
	self assert: 1942 printStringRoman = 'MCMXLII'.
	self assert: 1943 printStringRoman = 'MCMXLIII'.
	self assert: 1944 printStringRoman = 'MCMXLIV'.
	self assert: 2004 printStringRoman = 'MMIV'.

	self assert: -1 printStringRoman = '-I'.
	self assert: -2 printStringRoman = '-II'.
	self assert: -3 printStringRoman = '-III'.
	self assert: -4 printStringRoman = '-IV'.
	self assert: -5 printStringRoman = '-V'.
	self assert: -6 printStringRoman = '-VI'.
	self assert: -7 printStringRoman = '-VII'.
	self assert: -8 printStringRoman = '-VIII'.
	self assert: -9 printStringRoman = '-IX'.
	self assert: -10 printStringRoman = '-X'.
! !

!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'nice 10/29/2011 15:13'!
testBigReceiverInexactSqrt
	"
	IntegerTest new testBigReceiverInexactSqrt
	"

	"Inexact 3rd root (not a whole cube number), so a Float must be answered.
	However, receiver is too big for Float arithmethic."
	| bigNum result |
	bigNum := 100 factorial squared + 1.		"Add 1 so it is not a whole square"
	self assert: bigNum asFloat isInfinite.			"Otherwise, we chose a bad sample"
	result := bigNum sqrt.
	self assert: result class == Float.
	self deny: result isInfinite.
	self assert: result = 100 factorial asFloat.		"No other float is closer. See following lines"
	self assert: (result successor asFraction squared - bigNum) abs >= (result asFraction squared - bigNum) abs.
	self assert: (result predecessor asFraction squared - bigNum) abs >= (result asFraction squared - bigNum) abs.! !

!IntegerTest methodsFor: 'tests - instance creation' stamp: 'JohanBrichau 8/26/2010 14:21'!
testReadFromWithError
	"Ensure that a string that does not represent an integer raises an error."
	
	self should: [Integer readFrom: 'invalid'] raise: Error
! !

!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'CamilloBruni 8/31/2013 20:23'!
testDegreeCos
	"self run: #testDegreeCos"

	45 degreeCos.	"Following tests use approximate equality, because cosine are generally evaluated using inexact Floating point arithmetic"
	self assert: (45 degreeCos squared - (1 / 2)) abs <= Float epsilon.
	self assert: (60 degreeCos - (1 / 2)) abs <= Float epsilon.
	self assert: (120 degreeCos + (1 / 2)) abs <= Float epsilon.
	-360 to: 360 do: [ :i | self assert: (i degreeCos closeTo: i degreesToRadians cos) ].	"Following tests use strict equality which is a requested property of degreeCos"
	-10 to: 10 do: [ :k | 
		self assert: (k * 360 + 90) degreeCos = 0.
		self assert: (k * 360 - 90) degreeCos = 0.
		self assert: (k * 360 + 180) degreeCos + 1 = 0.
		self assert: (k * 360) degreeCos - 1 = 0 ]! !

!IntegerTest methodsFor: 'private' stamp: 'jmv 10/11/2011 08:14'!
assert: a classAndValueEquals: b
	self assert: a class = b class.
	self assert: a = b! !

!IntegerTest methodsFor: 'tests - printing' stamp: 'nice 2/15/2008 22:23'!
testNumberOfDigits
	
	2 to: 32 do: [:b |
		1 to: 1000//b do: [:n |
			| bRaisedToN |
			bRaisedToN := b raisedTo: n.
			self assert: (bRaisedToN - 1 numberOfDigitsInBase: b) = n.
			self assert: (bRaisedToN numberOfDigitsInBase: b) = (n+1).
			self assert: (bRaisedToN + 1 numberOfDigitsInBase: b) = (n+1).
			
			self assert: (bRaisedToN negated + 1 numberOfDigitsInBase: b) = n.
			self assert: (bRaisedToN negated numberOfDigitsInBase: b) = (n+1).
			self assert: (bRaisedToN negated - 1 numberOfDigitsInBase: b) = (n+1).]].
! !

!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'nice 12/11/2012 19:53'!
testFloorLog
	self assert: (100 floorLog: 10) = 2.
	self assert: (((2 raisedTo: Float emax + 3) floorLog: 10) = (2 log*(Float emax + 3)) floor) description: 'Integer>>floorLog: should not overflow'! !

!IntegerTest methodsFor: 'tests - instance creation' stamp: 'nice 4/28/2012 16:48'!
testReadFrom
	"Ensure remaining characters in a stream are not lost when parsing an integer."
	| rs i s |
	rs := '123s could be confused with a ScaledDecimal' readStream.
	i := Integer readFrom: rs.
	self assert: i = 123.
	s := rs upToEnd.
	self assert: 's could be confused with a ScaledDecimal' = s.
	rs := '123.s could be confused with a ScaledDecimal' readStream.
	i := Integer readFrom: rs.
	self assert: i = 123.
	s := rs upToEnd.
	self assert: '.s could be confused with a ScaledDecimal' = s! !

!IntegerTest methodsFor: 'tests - instance creation' stamp: 'sd 6/5/2005 08:46'!
testDifferentBases
	"self run: #testDifferentBases"
	"| value |
	2 to: 36 do: [:each|
		value := 0.
		1 to: each-1 do: [:n| value := value + (n * (each raisedToInteger: n))].
		value := value negated.
		Transcript tab; show: 'self assert: (', value printString, ' printStringBase: ', each printString, ') = ''', (value printStringBase: each), '''.'; cr.
		Transcript tab; show: 'self assert: (', value printString, ' radix: ', each printString, ') = ''', (value radix: each), '''.'; cr.
		Transcript tab; show: 'self assert: ', value printString, ' printStringHex = ''', (value printStringBase: 16), '''.'; cr.
		Transcript tab; show: 'self assert: (', value printString, ' storeStringBase: ', each printString, ') = ''', (value storeStringBase: each), '''.'; cr.
		Transcript tab; show: 'self assert: ', value printString, ' storeStringHex = ''', (value storeStringBase: 16), '''.'; cr.


].
	"

	self assert: 2r10 = 2.
	self assert: 3r210 = 21.
	self assert: 4r3210 = 228.
	self assert: 5r43210 = 2930.
	self assert: 6r543210 = 44790.
	self assert: 7r6543210 = 800667.
	self assert: 8r76543210 = 16434824.
	self assert: 9r876543210 = 381367044.
	self assert: 10r9876543210 = 9876543210.
	self assert: 11rA9876543210 = 282458553905.
	self assert: 12rBA9876543210 = 8842413667692.
	self assert: 13rCBA9876543210 = 300771807240918.
	self assert: 14rDCBA9876543210 = 11046255305880158.
	self assert: 15rEDCBA9876543210 = 435659737878916215.
	self assert: 16rFEDCBA9876543210 = 18364758544493064720.
	self assert: 17rGFEDCBA9876543210 = 824008854613343261192.
	self assert: 18rHGFEDCBA9876543210 = 39210261334551566857170.
	self assert: 19rIHGFEDCBA9876543210 = 1972313422155189164466189.
	self assert: 20rJIHGFEDCBA9876543210 = 104567135734072022160664820.
	self assert: 21rKJIHGFEDCBA9876543210 = 5827980550840017565077671610.
	self assert: 22rLKJIHGFEDCBA9876543210 = 340653664490377789692799452102.
	self assert: 23rMLKJIHGFEDCBA9876543210 = 20837326537038308910317109288851.
	self assert: 24rNMLKJIHGFEDCBA9876543210 = 1331214537196502869015340298036888.
	self assert: 25rONMLKJIHGFEDCBA9876543210 = 88663644327703473714387251271141900.
	self assert: 26rPONMLKJIHGFEDCBA9876543210 = 6146269788878825859099399609538763450.
	self assert: 27rQPONMLKJIHGFEDCBA9876543210 = 442770531899482980347734468443677777577.
	self assert: 28rRQPONMLKJIHGFEDCBA9876543210 = 33100056003358651440264672384704297711484.
	self assert: 29rSRQPONMLKJIHGFEDCBA9876543210 = 2564411043271974895869785066497940850811934.
	self assert: 30rTSRQPONMLKJIHGFEDCBA9876543210 = 205646315052919334126040428061831153388822830.
	self assert: 31rUTSRQPONMLKJIHGFEDCBA9876543210 = 17050208381689099029767742314582582184093573615.
	self assert: 32rVUTSRQPONMLKJIHGFEDCBA9876543210 = 1459980823972598128486511383358617792788444579872.
	self assert: 33rWVUTSRQPONMLKJIHGFEDCBA9876543210 = 128983956064237823710866404905431464703849549412368.
	self assert: 34rXWVUTSRQPONMLKJIHGFEDCBA9876543210 = 11745843093701610854378775891116314824081102660800418.
	self assert: 35rYXWVUTSRQPONMLKJIHGFEDCBA9876543210 = 1101553773143634726491620528194292510495517905608180485.
	self assert: 36rZYXWVUTSRQPONMLKJIHGFEDCBA9876543210 = 106300512100105327644605138221229898724869759421181854980.

	self assert: -2r10 = -2.
	self assert: -3r210 = -21.
	self assert: -4r3210 = -228.
	self assert: -5r43210 = -2930.
	self assert: -6r543210 = -44790.
	self assert: -7r6543210 = -800667.
	self assert: -8r76543210 = -16434824.
	self assert: -9r876543210 = -381367044.
	self assert: -10r9876543210 = -9876543210.
	self assert: -11rA9876543210 = -282458553905.
	self assert: -12rBA9876543210 = -8842413667692.
	self assert: -13rCBA9876543210 = -300771807240918.
	self assert: -14rDCBA9876543210 = -11046255305880158.
	self assert: -15rEDCBA9876543210 = -435659737878916215.
	self assert: -16rFEDCBA9876543210 = -18364758544493064720.
	self assert: -17rGFEDCBA9876543210 = -824008854613343261192.
	self assert: -18rHGFEDCBA9876543210 = -39210261334551566857170.
	self assert: -19rIHGFEDCBA9876543210 = -1972313422155189164466189.
	self assert: -20rJIHGFEDCBA9876543210 = -104567135734072022160664820.
	self assert: -21rKJIHGFEDCBA9876543210 = -5827980550840017565077671610.
	self assert: -22rLKJIHGFEDCBA9876543210 = -340653664490377789692799452102.
	self assert: -23rMLKJIHGFEDCBA9876543210 = -20837326537038308910317109288851.
	self assert: -24rNMLKJIHGFEDCBA9876543210 = -1331214537196502869015340298036888.
	self assert: -25rONMLKJIHGFEDCBA9876543210 = -88663644327703473714387251271141900.
	self assert: -26rPONMLKJIHGFEDCBA9876543210 = -6146269788878825859099399609538763450.
	self assert: -27rQPONMLKJIHGFEDCBA9876543210 = -442770531899482980347734468443677777577.
	self assert: -28rRQPONMLKJIHGFEDCBA9876543210 = -33100056003358651440264672384704297711484.
	self assert: -29rSRQPONMLKJIHGFEDCBA9876543210 = -2564411043271974895869785066497940850811934.
	self assert: -30rTSRQPONMLKJIHGFEDCBA9876543210 = -205646315052919334126040428061831153388822830.
	self assert: -31rUTSRQPONMLKJIHGFEDCBA9876543210 = -17050208381689099029767742314582582184093573615.
	self assert: -32rVUTSRQPONMLKJIHGFEDCBA9876543210 = -1459980823972598128486511383358617792788444579872.
	self assert: -33rWVUTSRQPONMLKJIHGFEDCBA9876543210 = -128983956064237823710866404905431464703849549412368.
	self assert: -34rXWVUTSRQPONMLKJIHGFEDCBA9876543210 = -11745843093701610854378775891116314824081102660800418.
	self assert: -35rYXWVUTSRQPONMLKJIHGFEDCBA9876543210 = -1101553773143634726491620528194292510495517905608180485.
	self assert: -36rZYXWVUTSRQPONMLKJIHGFEDCBA9876543210 = -106300512100105327644605138221229898724869759421181854980.! !

!IntegerTest methodsFor: 'tests - printing' stamp: 'laza 3/30/2004 11:52'!
testPositiveIntegerPrinting
	"self run: #testPositiveIntegerPrinting"

	self assert: 0 printString = '0'.
	self assert: 0 printStringHex = '0'.
	self assert: 0 storeStringHex = '16r0'.

	self assert: (2 printStringBase: 2) = '10'.
	self assert: (2 radix: 2) = '10'.
	self assert: 2 printStringHex = '2'.
	self assert: (2 storeStringBase: 2) = '2r10'.
	self assert: 2 storeStringHex = '16r2'.
	self assert: (21 printStringBase: 3) = '210'.
	self assert: (21 radix: 3) = '210'.
	self assert: 21 printStringHex = '15'.
	self assert: (21 storeStringBase: 3) = '3r210'.
	self assert: 21 storeStringHex = '16r15'.
	self assert: (228 printStringBase: 4) = '3210'.
	self assert: (228 radix: 4) = '3210'.
	self assert: 228 printStringHex = 'E4'.
	self assert: (228 storeStringBase: 4) = '4r3210'.
	self assert: 228 storeStringHex = '16rE4'.
	self assert: (2930 printStringBase: 5) = '43210'.
	self assert: (2930 radix: 5) = '43210'.
	self assert: 2930 printStringHex = 'B72'.
	self assert: (2930 storeStringBase: 5) = '5r43210'.
	self assert: 2930 storeStringHex = '16rB72'.
	self assert: (44790 printStringBase: 6) = '543210'.
	self assert: (44790 radix: 6) = '543210'.
	self assert: 44790 printStringHex = 'AEF6'.
	self assert: (44790 storeStringBase: 6) = '6r543210'.
	self assert: 44790 storeStringHex = '16rAEF6'.
	self assert: (800667 printStringBase: 7) = '6543210'.
	self assert: (800667 radix: 7) = '6543210'.
	self assert: 800667 printStringHex = 'C379B'.
	self assert: (800667 storeStringBase: 7) = '7r6543210'.
	self assert: 800667 storeStringHex = '16rC379B'.
	self assert: (16434824 printStringBase: 8) = '76543210'.
	self assert: (16434824 radix: 8) = '76543210'.
	self assert: 16434824 printStringHex = 'FAC688'.
	self assert: (16434824 storeStringBase: 8) = '8r76543210'.
	self assert: 16434824 storeStringHex = '16rFAC688'.
	self assert: (381367044 printStringBase: 9) = '876543210'.
	self assert: (381367044 radix: 9) = '876543210'.
	self assert: 381367044 printStringHex = '16BB3304'.
	self assert: (381367044 storeStringBase: 9) = '9r876543210'.
	self assert: 381367044 storeStringHex = '16r16BB3304'.
	self assert: (9876543210 printStringBase: 10) = '9876543210'.
	self assert: (9876543210 radix: 10) = '9876543210'.
	self assert: 9876543210 printStringHex = '24CB016EA'.
	self assert: (9876543210 storeStringBase: 10) = '9876543210'.
	self assert: 9876543210 storeStringHex = '16r24CB016EA'.
	self assert: (282458553905 printStringBase: 11) = 'A9876543210'.
	self assert: (282458553905 radix: 11) = 'A9876543210'.
	self assert: 282458553905 printStringHex = '41C3D77E31'.
	self assert: (282458553905 storeStringBase: 11) = '11rA9876543210'.
	self assert: 282458553905 storeStringHex = '16r41C3D77E31'.
	self assert: (8842413667692 printStringBase: 12) = 'BA9876543210'.
	self assert: (8842413667692 radix: 12) = 'BA9876543210'.
	self assert: 8842413667692 printStringHex = '80AC8ECF56C'.
	self assert: (8842413667692 storeStringBase: 12) = '12rBA9876543210'.
	self assert: 8842413667692 storeStringHex = '16r80AC8ECF56C'.
	self assert: (300771807240918 printStringBase: 13) = 'CBA9876543210'.
	self assert: (300771807240918 radix: 13) = 'CBA9876543210'.
	self assert: 300771807240918 printStringHex = '1118CE4BAA2D6'.
	self assert: (300771807240918 storeStringBase: 13) = '13rCBA9876543210'.
	self assert: 300771807240918 storeStringHex = '16r1118CE4BAA2D6'.
	self assert: (11046255305880158 printStringBase: 14) = 'DCBA9876543210'.
	self assert: (11046255305880158 radix: 14) = 'DCBA9876543210'.
	self assert: 11046255305880158 printStringHex = '273E82BB9AF25E'.
	self assert: (11046255305880158 storeStringBase: 14) = '14rDCBA9876543210'.
	self assert: 11046255305880158 storeStringHex = '16r273E82BB9AF25E'.
	self assert: (435659737878916215 printStringBase: 15) = 'EDCBA9876543210'.
	self assert: (435659737878916215 radix: 15) = 'EDCBA9876543210'.
	self assert: 435659737878916215 printStringHex = '60BC6392F366C77'.
	self assert: (435659737878916215 storeStringBase: 15) = '15rEDCBA9876543210'.
	self assert: 435659737878916215 storeStringHex = '16r60BC6392F366C77'.
	self assert: (18364758544493064720 printStringBase: 16) = 'FEDCBA9876543210'.
	self assert: (18364758544493064720 radix: 16) = 'FEDCBA9876543210'.
	self assert: 18364758544493064720 printStringHex = 'FEDCBA9876543210'.
	self assert: (18364758544493064720 storeStringBase: 16) = '16rFEDCBA9876543210'.
	self assert: 18364758544493064720 storeStringHex = '16rFEDCBA9876543210'.
	self assert: (824008854613343261192 printStringBase: 17) = 'GFEDCBA9876543210'.
	self assert: (824008854613343261192 radix: 17) = 'GFEDCBA9876543210'.
	self assert: 824008854613343261192 printStringHex = '2CAB6B877C1CD2D208'.
	self assert: (824008854613343261192 storeStringBase: 17) = '17rGFEDCBA9876543210'.
	self assert: 824008854613343261192 storeStringHex = '16r2CAB6B877C1CD2D208'.
	self assert: (39210261334551566857170 printStringBase: 18) = 'HGFEDCBA9876543210'.
	self assert: (39210261334551566857170 radix: 18) = 'HGFEDCBA9876543210'.
	self assert: 39210261334551566857170 printStringHex = '84D97AFCAE81415B3D2'.
	self assert: (39210261334551566857170 storeStringBase: 18) = '18rHGFEDCBA9876543210'.
	self assert: 39210261334551566857170 storeStringHex = '16r84D97AFCAE81415B3D2'.
	self assert: (1972313422155189164466189 printStringBase: 19) = 'IHGFEDCBA9876543210'.
	self assert: (1972313422155189164466189 radix: 19) = 'IHGFEDCBA9876543210'.
	self assert: 1972313422155189164466189 printStringHex = '1A1A75329C5C6FC00600D'.
	self assert: (1972313422155189164466189 storeStringBase: 19) = '19rIHGFEDCBA9876543210'.
	self assert: 1972313422155189164466189 storeStringHex = '16r1A1A75329C5C6FC00600D'.
	self assert: (104567135734072022160664820 printStringBase: 20) = 'JIHGFEDCBA9876543210'.
	self assert: (104567135734072022160664820 radix: 20) = 'JIHGFEDCBA9876543210'.
	self assert: 104567135734072022160664820 printStringHex = '567EF3C9636D242A8C68F4'.
	self assert: (104567135734072022160664820 storeStringBase: 20) = '20rJIHGFEDCBA9876543210'.
	self assert: 104567135734072022160664820 storeStringHex = '16r567EF3C9636D242A8C68F4'.
	self assert: (5827980550840017565077671610 printStringBase: 21) = 'KJIHGFEDCBA9876543210'.
	self assert: (5827980550840017565077671610 radix: 21) = 'KJIHGFEDCBA9876543210'.
	self assert: 5827980550840017565077671610 printStringHex = '12D4CAE2B8A09BCFDBE30EBA'.
	self assert: (5827980550840017565077671610 storeStringBase: 21) = '21rKJIHGFEDCBA9876543210'.
	self assert: 5827980550840017565077671610 storeStringHex = '16r12D4CAE2B8A09BCFDBE30EBA'.
	self assert: (340653664490377789692799452102 printStringBase: 22) = 'LKJIHGFEDCBA9876543210'.
	self assert: (340653664490377789692799452102 radix: 22) = 'LKJIHGFEDCBA9876543210'.
	self assert: 340653664490377789692799452102 printStringHex = '44CB61B5B47E1A5D8F88583C6'.
	self assert: (340653664490377789692799452102 storeStringBase: 22) = '22rLKJIHGFEDCBA9876543210'.
	self assert: 340653664490377789692799452102 storeStringHex = '16r44CB61B5B47E1A5D8F88583C6'.
	self assert: (20837326537038308910317109288851 printStringBase: 23) = 'MLKJIHGFEDCBA9876543210'.
	self assert: (20837326537038308910317109288851 radix: 23) = 'MLKJIHGFEDCBA9876543210'.
	self assert: 20837326537038308910317109288851 printStringHex = '1070108876456E0EF115B389F93'.
	self assert: (20837326537038308910317109288851 storeStringBase: 23) = '23rMLKJIHGFEDCBA9876543210'.
	self assert: 20837326537038308910317109288851 storeStringHex = '16r1070108876456E0EF115B389F93'.
	self assert: (1331214537196502869015340298036888 printStringBase: 24) = 'NMLKJIHGFEDCBA9876543210'.
	self assert: (1331214537196502869015340298036888 radix: 24) = 'NMLKJIHGFEDCBA9876543210'.
	self assert: 1331214537196502869015340298036888 printStringHex = '41A24A285154B026B6ED206C6698'.
	self assert: (1331214537196502869015340298036888 storeStringBase: 24) = '24rNMLKJIHGFEDCBA9876543210'.
	self assert: 1331214537196502869015340298036888 storeStringHex = '16r41A24A285154B026B6ED206C6698'.
	self assert: (88663644327703473714387251271141900 printStringBase: 25) = 'ONMLKJIHGFEDCBA9876543210'.
	self assert: (88663644327703473714387251271141900 radix: 25) = 'ONMLKJIHGFEDCBA9876543210'.
	self assert: 88663644327703473714387251271141900 printStringHex = '111374860A2C6CEBE5999630398A0C'.
	self assert: (88663644327703473714387251271141900 storeStringBase: 25) = '25rONMLKJIHGFEDCBA9876543210'.
	self assert: 88663644327703473714387251271141900 storeStringHex = '16r111374860A2C6CEBE5999630398A0C'.
	self assert: (6146269788878825859099399609538763450 printStringBase: 26) = 'PONMLKJIHGFEDCBA9876543210'.
	self assert: (6146269788878825859099399609538763450 radix: 26) = 'PONMLKJIHGFEDCBA9876543210'.
	self assert: 6146269788878825859099399609538763450 printStringHex = '49FBA7F30B0F48BD14E6A99BD8ADABA'.
	self assert: (6146269788878825859099399609538763450 storeStringBase: 26) = '26rPONMLKJIHGFEDCBA9876543210'.
	self assert: 6146269788878825859099399609538763450 storeStringHex = '16r49FBA7F30B0F48BD14E6A99BD8ADABA'.
	self assert: (442770531899482980347734468443677777577 printStringBase: 27) = 'QPONMLKJIHGFEDCBA9876543210'.
	self assert: (442770531899482980347734468443677777577 radix: 27) = 'QPONMLKJIHGFEDCBA9876543210'.
	self assert: 442770531899482980347734468443677777577 printStringHex = '14D1A80A997343640C1145A073731DEA9'.
	self assert: (442770531899482980347734468443677777577 storeStringBase: 27) = '27rQPONMLKJIHGFEDCBA9876543210'.
	self assert: 442770531899482980347734468443677777577 storeStringHex = '16r14D1A80A997343640C1145A073731DEA9'.
	self assert: (33100056003358651440264672384704297711484 printStringBase: 28) = 'RQPONMLKJIHGFEDCBA9876543210'.
	self assert: (33100056003358651440264672384704297711484 radix: 28) = 'RQPONMLKJIHGFEDCBA9876543210'.
	self assert: 33100056003358651440264672384704297711484 printStringHex = '6145B6E6DACFA25D0E936F51D25932377C'.
	self assert: (33100056003358651440264672384704297711484 storeStringBase: 28) = '28rRQPONMLKJIHGFEDCBA9876543210'.
	self assert: 33100056003358651440264672384704297711484 storeStringHex = '16r6145B6E6DACFA25D0E936F51D25932377C'.
	self assert: (2564411043271974895869785066497940850811934 printStringBase: 29) = 'SRQPONMLKJIHGFEDCBA9876543210'.
	self assert: (2564411043271974895869785066497940850811934 radix: 29) = 'SRQPONMLKJIHGFEDCBA9876543210'.
	self assert: 2564411043271974895869785066497940850811934 printStringHex = '1D702071CBA4A1597D4DD37E95EFAC79241E'.
	self assert: (2564411043271974895869785066497940850811934 storeStringBase: 29) = '29rSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: 2564411043271974895869785066497940850811934 storeStringHex = '16r1D702071CBA4A1597D4DD37E95EFAC79241E'.
	self assert: (205646315052919334126040428061831153388822830 printStringBase: 30) = 'TSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: (205646315052919334126040428061831153388822830 radix: 30) = 'TSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: 205646315052919334126040428061831153388822830 printStringHex = '938B4343B54B550989989D02998718FFB212E'.
	self assert: (205646315052919334126040428061831153388822830 storeStringBase: 30) = '30rTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: 205646315052919334126040428061831153388822830 storeStringHex = '16r938B4343B54B550989989D02998718FFB212E'.
	self assert: (17050208381689099029767742314582582184093573615 printStringBase: 31) = 'UTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: (17050208381689099029767742314582582184093573615 radix: 31) = 'UTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: 17050208381689099029767742314582582184093573615 printStringHex = '2FC8ECB1521BA16D24A69E976D53873E2C661EF'.
	self assert: (17050208381689099029767742314582582184093573615 storeStringBase: 31) = '31rUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: 17050208381689099029767742314582582184093573615 storeStringHex = '16r2FC8ECB1521BA16D24A69E976D53873E2C661EF'.
	self assert: (1459980823972598128486511383358617792788444579872 printStringBase: 32) = 'VUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: (1459980823972598128486511383358617792788444579872 radix: 32) = 'VUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: 1459980823972598128486511383358617792788444579872 printStringHex = 'FFBBCDEB38BDAB49CA307B9AC5A928398A418820'.
	self assert: (1459980823972598128486511383358617792788444579872 storeStringBase: 32) = '32rVUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: 1459980823972598128486511383358617792788444579872 storeStringHex = '16rFFBBCDEB38BDAB49CA307B9AC5A928398A418820'.
	self assert: (128983956064237823710866404905431464703849549412368 printStringBase: 33) = 'WVUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: (128983956064237823710866404905431464703849549412368 radix: 33) = 'WVUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: 128983956064237823710866404905431464703849549412368 printStringHex = '584120A0328DE272AB055A8AA003CE4A559F223810'.
	self assert: (128983956064237823710866404905431464703849549412368 storeStringBase: 33) = '33rWVUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: 128983956064237823710866404905431464703849549412368 storeStringHex = '16r584120A0328DE272AB055A8AA003CE4A559F223810'.
	self assert: (11745843093701610854378775891116314824081102660800418 printStringBase: 34) = 'XWVUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: (11745843093701610854378775891116314824081102660800418 radix: 34) = 'XWVUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: 11745843093701610854378775891116314824081102660800418 printStringHex = '1F64D4FC76000F7B92CF0CD5D0F350139AB9F25D8FA2'.
	self assert: (11745843093701610854378775891116314824081102660800418 storeStringBase: 34) = '34rXWVUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: 11745843093701610854378775891116314824081102660800418 storeStringHex = '16r1F64D4FC76000F7B92CF0CD5D0F350139AB9F25D8FA2'.
	self assert: (1101553773143634726491620528194292510495517905608180485 printStringBase: 35) = 'YXWVUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: (1101553773143634726491620528194292510495517905608180485 radix: 35) = 'YXWVUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: 1101553773143634726491620528194292510495517905608180485 printStringHex = 'B8031AD55AD1FAA89E07A271CA1ED2F420415D1570305'.
	self assert: (1101553773143634726491620528194292510495517905608180485 storeStringBase: 35) = '35rYXWVUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: 1101553773143634726491620528194292510495517905608180485 storeStringHex = '16rB8031AD55AD1FAA89E07A271CA1ED2F420415D1570305'.
	self assert: (106300512100105327644605138221229898724869759421181854980 printStringBase: 36) = 'ZYXWVUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: (106300512100105327644605138221229898724869759421181854980 radix: 36) = 'ZYXWVUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: 106300512100105327644605138221229898724869759421181854980 printStringHex = '455D441E55A37239AB4C303189576071AF5578FFCA80504'.
	self assert: (106300512100105327644605138221229898724869759421181854980 storeStringBase: 36) = '36rZYXWVUTSRQPONMLKJIHGFEDCBA9876543210'.
	self assert: 106300512100105327644605138221229898724869759421181854980 storeStringHex = '16r455D441E55A37239AB4C303189576071AF5578FFCA80504'.! !

!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'nice 5/28/2010 21:28'!
testLn
	self assert: (100 ln closeTo: 10 ln*2).
	self assert: ((2 raisedTo: Float emax + 3) ln closeTo: 2 ln*(Float emax + 3)) description: 'Integer>>ln should not overflow'! !

!IntegerTest methodsFor: 'tests - printing' stamp: 'nice 2/15/2008 22:31'!
testPrintStringBase
	
	2 to: 32 do: [:b |
		1 to: 1000//b do: [:n |
			| bRaisedToN |
			bRaisedToN := b raisedTo: n.
			self assert: (bRaisedToN - 1 printStringBase: b) = (String new: n withAll: (Character digitValue: b-1)).
			self assert: (bRaisedToN printStringBase: b) = ('1' , (String new: n withAll: $0)).
			
			self assert: (bRaisedToN negated + 1 printStringBase: b) = ('-' , (String new: n withAll: (Character digitValue: b-1))).
			self assert: (bRaisedToN negated printStringBase: b) = ('-1' , (String new: n withAll: $0))]].
! !

!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'nice 7/8/2008 02:44'!
testHighBitOfMagnitude
	| suite |

	suite := (0 to: 1024) asArray , #(16rFDFD 16rFFFF 16r1000 16r1000000 16r1000001 16r70000000 16r7AFAFAFA ) , {SmallInteger maxVal . SmallInteger maxVal+1}.
	suite := suite , (suite collect: [:e | e raisedTo: 20]).
	
	suite do: [:anInteger |
		| highBit shifted |
		highBit := 0.
		shifted := 1.
		[shifted > anInteger] whileFalse: [highBit := highBit+1. shifted := shifted bitShift: 1].
		self assert: anInteger highBitOfMagnitude = highBit.
		self assert: anInteger negated highBitOfMagnitude = highBit].! !

!IntegerTest methodsFor: 'tests - instance creation' stamp: 'StephaneDucasse 5/28/2011 13:40'!
testStringAsNumber
	"This covers parsing in Number>>readFrom:
	Trailing decimal points should be ignored."

	self assert: ('123' asNumber = 123).
	self assert: ('-123' asNumber = -123).
	self assert: ('123.' asNumber = 123).
	self assert: ('-123.' asNumber = -123).
	self assert: ('123This is not to be read' asNumber = 123).
	self assert: ('123s could be confused with a ScaledDecimal' asNumber = 123).
	self assert: ('123e could be confused with a Float' asNumber = 123).
! !

!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/13/2011 21:45'!
testRaisedToErrorConditions
	"
	IntegerTest new testRaisedToErrorConditions
	"

	self should: [ -2 raisedTo: 1/4 ] raise: ArithmeticError.
	self should: [ -2 raisedTo: 1.24 ] raise: ArithmeticError.! !

!IntegerTest methodsFor: 'tests - basic' stamp: 'StephaneDucasse 12/1/2009 14:40'!
testIsPrime2

	"Not primes:"
	#(-100 -5 -3 -2 -1 0 1) do: [ :each |
		self deny: each isPrime ].

	"The following tests should return 'true'"
	#(17 78901 104729 15485863 2038074743) do: [ :each |
		self assert: each isPrime ].
	
	"The following tests should return 'false' (first 5 are Carmichael integers)"
	#(561 2821 6601 10585 15841 256 29996224275831) do: [ :each |
		self deny: each isPrime ].! !

!IntegerTest methodsFor: 'tests - basic' stamp: 'ul 11/25/2009 02:49'!
testIsProbablyPrime

	"Not primes:"
	#(-100 -5 -3 -2 -1 0 1) do: [ :each |
		self deny: each isProbablyPrime ].

	"The following tests should return 'true'"
	#(17 78901 104729 15485863 2038074743 29996224275833) do: [ :each |
		self assert: each isProbablyPrime ].
	
	"The following tests should return 'false' (first 5 are Carmichael integers)"
	#(561 2821 6601 10585 15841 256 29996224275831) do: [ :each |
		self deny: each isProbablyPrime ].! !

!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'SeanDeNigris 5/16/2012 20:17'!
testBitAt
	| trials bitSequence2 |

	self assert: (2r10 bitAt: 1) equals: 0.
	self assert: (2r10 bitAt: 2) equals: 1.
	
	self
		assert: ((1 to: 100) allSatisfy: [:i | (0 bitAt: i) = 0])
		description: 'all bits of zero are set to zero'.
	
	self
		assert: ((1 to: 100) allSatisfy: [:i | (-1 bitAt: i) = 1])
		description: 'In two complements, all bits of -1 are set to 1'.
		
	
	trials := #(
		'2r10010011'
		'2r11100100'
		'2r10000000'
		'2r0000101011011001'
		'2r1000101011011001'
		'2r0101010101011000'
		'2r0010011110110010'
		'2r0010011000000000'
		'2r00100111101100101000101011011001'
		'2r01110010011110110010100110101101'
		'2r10101011101011001010000010110110'
		'2r10101000000000000000000000000000'
		'2r0010101110101001110010100000101101100010011110110010100010101100'
		'2r1010101110101100101000001011011000100111101100101000101011011001'
		'2r1010101110101000000000000000000000000000000000000000000000000000').
	trials do: [:bitSequence | | aNumber |
		aNumber := Number readFrom: bitSequence.
		bitSequence2 := (bitSequence size - 2 to: 1 by: -1) inject: '2r' into: [:string :i | string copyWith: (Character digitValue: (aNumber bitAt: i))].
		self assert: bitSequence2 = bitSequence].
	
	trials do: [:bitSequence | | bitInvert |
		bitInvert := -1 - (Number readFrom: bitSequence).
		bitSequence2 := (bitSequence size - 2 to: 1 by: -1) inject: '2r' into: [:string :i | string copyWith: (Character digitValue: 1 - (bitInvert bitAt: i))].
		self assert: bitSequence2 = bitSequence description: '-1-x is similar to a bitInvert operation in two complement']! !

!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'CamilloBruni 8/31/2013 20:23'!
testNthRoot
	1 << 2000 nthRoot: 100.
	self assert: (1 << 2000 nthRoot: 100) equals: 1 << 20! !

!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'ul 11/25/2009 03:01'!
testSqrtFloor

	#(-1234567890123 -10 -5 -1) do: [ :each |
		self should: [ each sqrtFloor ] raise: Error ].
	#(
		0 1 2 3 4 5 10 16 30 160479924 386234481 501619156 524723498 580855366 766098594 834165249 1020363860 1042083924 1049218924
		1459774772895569 3050005981408238 4856589481837079 5650488387708463 7831037396100244) do: [ :each |
			self assert: each asFloat sqrt floor = each sqrtFloor ]
		! !

!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'nice 3/12/2014 00:16'!
testNthRootExactness
	| inexactRoots largeExactPowersOf6 |
	largeExactPowersOf6 := (2 to: 100) collect: [:k | k raisedTo: 66].
	inexactRoots := largeExactPowersOf6 reject: [:e | (e nthRoot: 6) isInteger].
	self assert: inexactRoots isEmpty description: 'Failed to find the exact 6th root of these numbers'! !

!IntegerTest methodsFor: 'tests - basic' stamp: 'HenrikSperreJohansen 1/19/2012 16:02'!
testIsPowerOfTwo
	"LargeNegativeIntegers"
	self deny: (2 raisedTo: 80) negated isPowerOfTwo.
	"Negative SmallIntegers"
	self deny: (-1 isPowerOfTwo).
	" 0, incase implementation has forgotten edge case"
	self deny: (0 isPowerOfTwo).
	"Positive SmallIntegers"
	self assert: (1 isPowerOfTwo).
	self assert: (2 isPowerOfTwo).
	self deny:  (3 isPowerOfTwo).
	self assert: (4 isPowerOfTwo).
	self deny: (5 isPowerOfTwo).
	" LargePositiveIntegers"
	self deny: ((2 raisedTo: 80) - 1) isPowerOfTwo.
	self assert: (2 raisedTo: 80) isPowerOfTwo.
	self deny: ((2 raisedTo: 80) + 1) isPowerOfTwo! !

!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'SeanDeNigris 5/16/2012 20:34'!
testBitMask

	self assert: (2r11 allMask: 2r11).
	self deny: (2r10 allMask: 2r11).
	self deny: (2r01 allMask: 2r11).
	
	self assert: (2r10 anyMask: 2r11).
	self assert: (2r01 anyMask: 2r11).
	self deny: (2r00 anyMask: 2r11).! !

!IntegerTest methodsFor: 'tests - instance creation' stamp: 'StephaneDucasse 6/9/2012 22:58'!
testNew
	self should: [Integer new] raise: self defaultTestError. ! !

!IntegerTest methodsFor: 'tests - printing' stamp: 'al 7/21/2008 22:36'!
testBadBase
	"This used to get into an endless loop.
	See Pharo #114"
	
	self should: [2 printStringBase: 1] raise: Error.! !

!IntegerTest methodsFor: 'tests - basic' stamp: 'sd 6/5/2005 08:45'!
testIsInteger

	self assert: (0 isInteger).
	! !

!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'SeanDeNigris 5/16/2012 20:42'!
testBitXor

	self assert: (2r1100 bitXor: 2r1010) equals: 2r0110.! !

!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'SeanDeNigris 5/16/2012 20:20'!
testBitOr

	self assert: (2r0101 | 2r1010) equals: 2r1111.
	self assert: (2r0101 bitOr: 2r1010) equals: 2r1111.! !

!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'SeanDeNigris 5/16/2012 20:41'!
testBitString
	"self debug: #testBitString"
	
	self assert: 2 bitString = '0000000000000000000000000000010'.
	self assert: -1 bitString	= '1111111111111111111111111111111'.
	self assert: -2 bitString = '1111111111111111111111111111110'.
	self assert: 2 bitStringLength = 31. 
		"32 minus 1 for immediate encoding = 31 = 30 for number + 1 for sign"
	self assert: 2 bitStringLength = (SmallInteger maxVal highBit + 1).! !

!IntegerTest methodsFor: 'tests - basic' stamp: 'md 4/21/2003 16:17'!
testEven
	
	self deny: (1073741825 even).
	self assert: (1073741824  even).
	! !

!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/11/2011 22:09'!
testExactSqrt
	"
	IntegerTest new testExactSqrt
	"
	self assert: 4 sqrt classAndValueEquals: 2.
	self assert: 9 sqrt classAndValueEquals: 3.
	self assert: Float maxExactInteger squared sqrt classAndValueEquals: Float maxExactInteger.
	self assert: (Float maxExactInteger+1) squared sqrt classAndValueEquals: Float maxExactInteger+1.
	#( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) do: [ :i |
		self assert: i squared sqrt classAndValueEquals: i ]! !

!IntegerTest methodsFor: 'tests - instance creation' stamp: 'GuillermoPolito 8/24/2010 19:06'!
testIntegerReadsNotOkFromString
	self should: [Integer readFrom: 'aaa'] raise: Error.
	self should: [Integer readFrom: '-aaa'] raise: Error.
	self should: [Integer readFrom: 'a3' base: 8] raise: Error.! !

!IntegerTest methodsFor: 'tests - instance creation' stamp: 'sd 6/5/2005 08:48'!
testCreationFromBytes1
	"self run: #testCreationFromBytes1"
	"it is illegal for a LargeInteger to be less than SmallInteger maxVal." 
	"here we test that Integer>>byte!!byte2:byte3:byte4: resconstructs SmallInteger maxVal as an instance of SmallInteger. "
  
	| maxSmallInt hexString byte1 byte2 byte3 byte4 
	builtInteger |
	maxSmallInt := SmallInteger maxVal.
	hexString := maxSmallInt printStringHex.
	self assert: hexString size = 8.
	byte4 := Number readFrom: (hexString copyFrom: 1 to: 2) base: 16.
	byte3 := Number readFrom: (hexString copyFrom: 3 to: 4) base: 16.
	byte2 := Number readFrom: (hexString copyFrom: 5 to: 6) base: 16.
	byte1 := Number readFrom: (hexString copyFrom: 7 to: 8) base: 16.
	builtInteger := Integer byte1: byte1 byte2: byte2 byte3: byte3 byte4: byte4.
	self assert: builtInteger = maxSmallInt.
	self assert: builtInteger class = SmallInteger
! !

!IntegerTest methodsFor: 'tests - printing' stamp: 'StephaneDucasse 7/31/2010 19:47'!
testHex
	self assert: 0 hex =  '16r0'.
	self assert: 12 hex =  '16rC'.
	self assert: 1234 hex =  '16r4D2'.! !

!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/13/2011 09:09'!
testNthRootErrorConditions
	"
	IntegerTest new testExactRaisedToErrorConditions
	"

	self should: [ -2 nthRoot: 1/4 ] raise: ArithmeticError.
	self should: [ -2 nthRoot: 1.24 ] raise: ArithmeticError.! !

!InteractiveResolver commentStamp: 'cwp 11/18/2009 11:56'!
I resolve origins by consulting the user. I maintain a cache of the user's responses.!
!InteractiveResolver methodsFor: 'resolving' stamp: 'cwp 10/27/2009 10:12'!
resolve: origin
	^ cache at: origin ifAbsent: [self unknownOrigin: origin]
	
! !

!InteractiveResolver methodsFor: 'resolving' stamp: 'EstebanLorenzano 4/2/2012 11:38'!
unknownOrigin: origin
	| reference |
	^ (next ifNotNil: [next resolve: origin]) ifNil: 
			[reference := ResolutionRequest for: origin.
			reference ifNotNil: [cache at: origin put: reference]]! !

!InteractiveResolver methodsFor: 'initialization' stamp: 'cwp 10/27/2009 10:29'!
initialize
	self flushLocalCache! !

!InteractiveResolver methodsFor: 'accessing' stamp: 'cwp 10/27/2009 10:29'!
flushLocalCache
	cache := IdentityDictionary new! !

!InteractiveResolverTest commentStamp: 'TorstenBergmann 1/31/2014 11:36'!
SUnit tests for InteractiveResolver!
!InteractiveResolverTest methodsFor: 'running' stamp: 'EstebanLorenzano 4/2/2012 11:38'!
createResolver
	^ InteractiveResolver new! !

!InteractiveResolverTest methodsFor: 'accessing' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
home
	^ FileLocator imageDirectory resolve! !

!InteractiveResolverTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:23'!
testCached
	[ resolver resolve: #home ]
		on: ResolutionRequest
		do: [ :req | req resume: self home ].
	self assertOriginResolves: #home! !

!InteractiveResolverTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:38'!
testNew
	[self assertOriginResolves: #home]
		on: ResolutionRequest
		do: [:req | req resume: self home].
	! !

!InternetConfiguration commentStamp: 'LaurentLaffont 6/8/2011 22:17'!
I read several parameters related to the default web browser network preferences, through the InternetConfigPlugin VM module.

For example, to get the default path where downloaded files should be placed:

InternetConfiguration getDownloadPath.

Seems to work only on MacOSX!
!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 9/26/2001 17:11'!
getGopherHost
	"Return the default Gopher server"
	"InternetConfiguration getGopherHost"

	^self primitiveGetStringKeyedBy: 'GopherHost'
! !

!InternetConfiguration class methodsFor: 'tests' stamp: 'JMM 10/5/2001 11:23'!
useSocks
	"Return true if UseSocks"
	"InternetConfiguration useSocks"

	^(self primitiveGetStringKeyedBy: 'UseSocks') = '1'
! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 9/26/2001 17:17'!
getNTPHost
	"Return the  Network Time Protocol (NTP)"
	"InternetConfiguration getNTPHost"

	^self primitiveGetStringKeyedBy: 'NTPHost'
! !

!InternetConfiguration class methodsFor: 'system startup' stamp: 'cami 7/22/2013 18:24'!
shutDown
	Smalltalk os isMacOS
		ifTrue: [ NetworkSystemSettings useHTTPProxy: false ]
	
! !

!InternetConfiguration class methodsFor: 'tests' stamp: 'JMM 9/26/2001 19:42'!
usePassiveFTP
	"Return true if UsePassiveFTP"
	"InternetConfiguration usePassiveFTP"

	^(self primitiveGetStringKeyedBy: 'UsePassiveFTP') = '1'
! !

!InternetConfiguration class methodsFor: 'tests' stamp: 'JMM 10/5/2001 11:23'!
useFTPProxy
	"Return true if UseFTPProxy"
	"InternetConfiguration useFTPProxy"

	^(self primitiveGetStringKeyedBy: 'UseFTPProxy') = '1'
! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 9/26/2001 17:17'!
getNewsAuthUsername
	"Return the user name for authorised news servers"
	"InternetConfiguration getNewsAuthUsername"

	^self primitiveGetStringKeyedBy: 'NewsAuthUsername'
! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 10/5/2001 10:54'!
getNoProxyDomains
	"Return a comma seperated string of domains not to proxy"
	"InternetConfiguration getNoProxyDomains"

	^self primitiveGetStringKeyedBy: 'NoProxyDomains'
! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 9/26/2001 17:11'!
getGopherProxy
	"Return the  Gopher proxy"
	"InternetConfiguration getGopherProxy"

	^self primitiveGetStringKeyedBy: 'GopherProxy'
! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 9/26/2001 19:44'!
getWWWHomePage
	"Return the WWW home page url"
	"InternetConfiguration getWWWHomePage"

	^self primitiveGetStringKeyedBy: 'WWWHomePage'
! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 10/3/2001 14:02'!
getFTPProxyPassword
	"Return the FTP proxy password"
	"InternetConfiguration getFTPProxyPassword"

	^self primitiveGetStringKeyedBy: 'FTPProxyPassword'
! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 9/26/2001 17:10'!
getFingerHost
	"Return the default finger server"
	"InternetConfiguration getFingerHost"

	^self primitiveGetStringKeyedBy: 'FingerHost'
! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 9/26/2001 17:05'!
getArchiePreferred
	"Return the preferred Archie server"
	"InternetConfiguration getArchiePreferred"

	^self primitiveGetStringKeyedBy: 'ArchiePreferred'
! !

!InternetConfiguration class methodsFor: 'initialization' stamp: 'md 2/24/2006 15:22'!
initialize
	"self initialize"
	Smalltalk addToStartUpList: self.
	Smalltalk addToShutDownList: self.! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 9/26/2001 17:31'!
getDownloadPath
	"Return the download path"
	"InternetConfiguration getDownloadPath"

	^self primitiveGetStringKeyedBy: 'DownLoadPath'
! !

!InternetConfiguration class methodsFor: 'system startup' stamp: 'cami 7/22/2013 18:24'!
startUp
	Smalltalk os isMacOS 
		ifTrue: [
			self useHTTPProxy 
				ifTrue: [
					(self getHTTPProxyHost findTokens: ':') ifNotEmpty: [ :p |
			 			NetworkSystemSettings 
							httpProxyServer: p first; 
							httpProxyPort: p second asInteger; 
							useHTTPProxy: true ] ]
				ifFalse: [
					NetworkSystemSettings useHTTPProxy: false ] ]! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 9/26/2001 20:07'!
getMailAccount
	"Return the mail account user@host.domain"
	"InternetConfiguration getMailAccount"

	^self primitiveGetStringKeyedBy: 'MailAccount'
! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 10/3/2001 14:31'!
getMailPassword 
	"Return the mail account Password "
	"InternetConfiguration getMailPassword "

	^self primitiveGetStringKeyedBy: 'MailPassword'
! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 9/26/2001 17:23'!
getWhoisHost
	"Return the WhoisHost server"
	"InternetConfiguration getWhoisHost"

	^self primitiveGetStringKeyedBy: 'WhoisHost'
! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 9/26/2001 17:14'!
getLDAPSearchbase
	"Return the LDAP thing"
	"InternetConfiguration getLDAPSearchbase"

	^self primitiveGetStringKeyedBy: 'LDAPSearchbase'
! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 9/26/2001 17:19'!
getSMTPHost
	"Return the SMTP server"
	"InternetConfiguration getSMTPHost"

	^self primitiveGetStringKeyedBy: 'SMTPHost'
! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 9/26/2001 17:15'!
getLDAPServer
	"Return the LDAP server"
	"InternetConfiguration getLDAPServer"

	^self primitiveGetStringKeyedBy: 'LDAPServer'
! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 9/26/2001 20:04'!
getRealName
	"Return the RealName"
	"InternetConfiguration getRealName"

	^self primitiveGetStringKeyedBy: 'RealName'
! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 9/26/2001 19:36'!
getOrganization
	"Return the Organization"
	"InternetConfiguration getOrganization"

	^self primitiveGetStringKeyedBy: 'Organization'
! !

!InternetConfiguration class methodsFor: 'tests' stamp: 'JMM 9/26/2001 19:41'!
useHTTPProxy
	"Return true if UseHTTPProxy"
	"InternetConfiguration useHTTPProxy"

	^(self primitiveGetStringKeyedBy: 'UseHTTPProxy') = '1'
! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 9/26/2001 17:09'!
getFTPProxyAccount
	"Return the second level FTP proxy authorisation"
	"InternetConfiguration getFTPProxyAccount"

	^self primitiveGetStringKeyedBy: 'FTPProxyAccount'
! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 10/3/2001 14:04'!
getNewsAuthPassword
	"Return the Password for the authorised news servers"
	"InternetConfiguration getNewsAuthPassword"

	^self primitiveGetStringKeyedBy: 'NewsAuthPassword'
! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 9/26/2001 17:19'!
getSocksHost
	"Return the Socks server"
	"InternetConfiguration getSocksHost"

	^self primitiveGetStringKeyedBy: 'SocksHost'
! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 9/26/2001 17:07'!
getEmail
	"Return the  email address of user"
	"InternetConfiguration getEmail"

	^self primitiveGetStringKeyedBy: 'Email'
! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 9/26/2001 17:20'!
getTelnetHost
	"Return the TelnetHost server"
	"InternetConfiguration getTelnetHost"

	^self primitiveGetStringKeyedBy: 'TelnetHost'
! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 9/26/2001 20:00'!
getFTPProxyHost
	"Return the FTP proxy host"
	"InternetConfiguration getFTPProxyHost"

	^self primitiveGetStringKeyedBy: 'FTPProxyHost'
! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 9/26/2001 19:44'!
getWAISGateway
	"Return the wais gateway"
	"InternetConfiguration getWAISGateway"

	^self primitiveGetStringKeyedBy: 'WAISGateway'
! !

!InternetConfiguration class methodsFor: 'tests' stamp: 'JMM 10/5/2001 11:23'!
useGopherProxy
	"Return true if UseGopherProxy"
	"InternetConfiguration useGopherProxy"

	^(self primitiveGetStringKeyedBy: 'UseGopherProxy') = '1'
! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 10/5/2001 23:45'!
getMacintoshFileTypeAndCreatorFrom: aFileName
	"Return the application type and application signature for the file
	 for the macintosh file system based on the file ending, the file does not need to exist
	failure to find a signature based on the file ending, or because of primitive failure turns nil"
	"InternetConfiguration getMacintoshFileTypeAndCreatorFrom: 'test.jpg'"
	| string |

	string := self primitiveGetMacintoshFileTypeAndCreatorFrom: aFileName.
	string = '********' ifTrue: [^nil].
	^Array with: (string first: 4) with: (string last: 4)
! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 9/26/2001 17:16'!
getNNTPHost
	"Return the NNTP server"
	"InternetConfiguration getNNTPHost"

	^self primitiveGetStringKeyedBy: 'NNTPHost'
! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 9/26/2001 19:37'!
getPhHost
	"Return the PhHost server"
	"InternetConfiguration getPhHost"

	^self primitiveGetStringKeyedBy: 'PhHost'
! !

!InternetConfiguration class methodsFor: 'system primitives' stamp: 'JMM 9/26/2001 16:31'!
primitiveGetStringKeyedBy: aKey
	<primitive: 'primitiveGetStringKeyedBy' module: 'InternetConfigPlugin'>
	^String new.
! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 9/26/2001 17:08'!
getFTPHost
	"Return the FTPHost"
	"InternetConfiguration getFTPHost"

	^self primitiveGetStringKeyedBy: 'FTPHost'
! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 9/26/2001 17:14'!
getIRCHost
	"Return the Internet Relay Chat server"
	"InternetConfiguration getIRCHost"

	^self primitiveGetStringKeyedBy: 'IRCHost'
! !

!InternetConfiguration class methodsFor: 'system primitives' stamp: 'JMM 10/5/2001 23:44'!
primitiveGetMacintoshFileTypeAndCreatorFrom: aFileName
	<primitive: 'primitiveGetMacintoshFileTypeAndCreatorFrom' module: 'InternetConfigPlugin'>
	^'********' copy ! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 9/26/2001 17:10'!
getFTPProxyUser
	"Return the first level FTP proxy authorisation"
	"InternetConfiguration getFTPProxyUser"

	^self primitiveGetStringKeyedBy: 'FTPProxyUser'
! !

!InternetConfiguration class methodsFor: 'lookups' stamp: 'JMM 9/26/2001 17:14'!
getHTTPProxyHost
	"Return the http proxy for this client."
	"InternetConfiguration getHTTPProxyHost"

	^self primitiveGetStringKeyedBy: 'HTTPProxyHost'
! !

!InterpolatedGradientFillStyle commentStamp: 'gvc 5/18/2007 12:49'!
Gradient fill style that uses proper alpha-aware interpolation.!
!InterpolatedGradientFillStyle methodsFor: 'as yet unclassified' stamp: 'gvc 5/18/2007 12:48'!
interpolatedAlphaMix: ratio of: rgba1 and: rgba2
	"Answer a proper interpolated value between two RGBA color words.
	Theta is 0..1.."

	| a1 a2 ra ira rgb1 rgb2 alpha br1 br2 bg1 bg2 bb1 bb2 result |
	a1 := rgba1 bitShift: -24. a2 := rgba2 bitShift: -24.
	alpha := ratio * (a2 - a1) + a1.
	ra := ratio * alpha.
	ira := (1.0 - ratio) * alpha.
	rgb1 := rgba1 bitAnd: 16rFFFFFF. rgb2 := rgba2 bitAnd: 16rFFFFFF.
	br1 := (rgb1 bitAnd: 255). br2 := (rgb2 bitAnd: 255).
	bg1 := ((rgb1 bitShift:  -8) bitAnd: 255). bg2 := ((rgb2 bitShift: -8) bitAnd: 255).
	bb1 := ((rgb1 bitShift: -16) bitAnd: 255). bb2 := ((rgb2 bitShift: -16) bitAnd: 255).
	result :=  (ra * br2 + (ira * br1)) rounded // 255.
	result :=  result bitOr: ((ra * bg2 + (ira * bg1)) rounded // 255 bitShift: 8).
	result :=  result bitOr: ((ra * bb2 + (ira * bb1)) rounded // 255 bitShift: 16).
	^result bitOr: (alpha rounded bitShift: 24)! !

!InterpolatedGradientFillStyle methodsFor: 'private' stamp: 'FernandoOlivero 9/9/2013 19:33'!
pixelWord32Of: aColor 
	"Returns an integer representing the bits that appear in a single pixel of this color in a Form of depth 32.
	Transparency: The pixel value zero is reserved for transparent. For depths greater than 8, black maps to the darkest possible blue.
	Just a little quicker if we are dealing with RGBA colors at 32 bit depth."
	| val rgb |
	rgb := aColor privateRGB .
	"eight bits per component; top 8 bits set to all ones (opaque alpha)"
	val := LargePositiveInteger new: 4.
	val at: 3 put: ((rgb bitShift: -22) bitAnd: 16rFF).
	val at: 2 put: ((rgb bitShift: -12) bitAnd: 16rFF).
	val at: 1 put: ((rgb bitShift: -2) bitAnd: 16rFF).
	val = 0 ifTrue: [val at: 1 put: 1].  "closest non-transparent black"
	val at: 4 put: self alpha.  "opaque alpha"
	^val
! !

!InterpolatedGradientFillStyle methodsFor: 'as yet unclassified' stamp: 'FernandoOlivero 9/9/2013 19:33'!
computePixelRampOfSize: length
	"Compute the pixel ramp in the receiver."
	
	| bits ramp lastColor lastIndex lastWord |
	ramp := colorRamp asSortedCollection:[:a1 :a2| a1 key < a2 key].
	bits := Bitmap new: length.
	lastColor := ramp first value.
	lastWord := self pixelWord32Of: lastColor .
	lastIndex := 0.
	ramp do:[:assoc| | distance nextColor theta nextWord nextIndex step |
		nextIndex := (assoc key * length) rounded.
		nextColor := assoc value.
		nextWord := nextColor pixelWord32.
		distance := nextIndex - lastIndex.
		distance = 0 ifTrue: [distance := 1].
		step := 1.0 / distance.
		theta := 0.0.
		lastIndex+1 to: nextIndex do: [:i|
			theta := theta + step.
			bits at: i put: (self interpolatedAlphaMix: theta of: lastWord and: nextWord)].
		lastIndex := nextIndex.
		lastColor := nextColor.
		lastWord := nextWord].
	lastIndex+1 to: length do: [:i| bits at: i put: lastWord].
	^bits! !

!Interval commentStamp: '<historical>'!
I represent a finite arithmetic progression.!
!Interval methodsFor: 'accessing' stamp: ''!
last 
	"Refer to the comment in SequenceableCollection|last."

	^stop - (stop - start \\ step)! !

!Interval methodsFor: 'private' stamp: ''!
species

	^Array! !

!Interval methodsFor: 'private' stamp: ''!
setFrom: startInteger to: stopInteger by: stepInteger

	start := startInteger.
	stop := stopInteger.
	step := stepInteger! !

!Interval methodsFor: 'accessing' stamp: ''!
first 
	"Refer to the comment in SequenceableCollection|first."

	^start! !

!Interval methodsFor: 'testing' stamp: 'di 12/6/1999 11:00'!
rangeIncludes: aNumber
	"Return true if the number lies in the interval between start and stop."

	step >= 0
		ifTrue: [^ aNumber between: start and: stop]
		ifFalse: [^ aNumber between: stop and: start]
! !

!Interval methodsFor: 'accessing' stamp: 'StephaneDucasse 2/20/2010 22:54'!
anyOne
	"This message will fail for an empty Interval, super would not.
	(2 to: 1) anyOne should fail because empty."

	^self at: 1! !

!Interval methodsFor: 'arithmetic' stamp: 'ajh 3/13/2003 15:45'!
+ number

	^ start + number to: stop + number by: step! !

!Interval methodsFor: 'accessing' stamp: ''!
increment
	"Answer the receiver's interval increment."

	^step! !

!Interval methodsFor: 'arithmetic' stamp: 'ajh 3/13/2003 15:46'!
- number

	^ start - number to: stop - number by: step! !

!Interval methodsFor: 'accessing' stamp: ''!
at: anInteger 
	"Answer the anInteger'th element."

	(anInteger >= 1 and: [anInteger <= self size])
		ifTrue: [^start + (step * (anInteger - 1))]
		ifFalse: [self errorSubscriptBounds: anInteger]! !

!Interval methodsFor: 'printing' stamp: 'sma 6/1/2000 09:50'!
printOn: aStream
	aStream nextPut: $(;
	 print: start;
	 nextPutAll: ' to: ';
	 print: stop.
	step ~= 1 ifTrue: [aStream nextPutAll: ' by: '; print: step].
	aStream nextPut: $)! !

!Interval methodsFor: 'adding' stamp: ''!
add: newObject 
	"Adding to an Interval is not allowed."

	self shouldNotImplement! !

!Interval methodsFor: 'enumerating' stamp: 'dtl 5/31/2003 16:45'!
permutationsDo: aBlock
	"Repeatly value aBlock with a single copy of the receiver. Reorder the copy
	so that aBlock is presented all (self size factorial) possible permutations."
	"(1 to: 4) permutationsDo: [:each | Transcript cr; show: each printString]"

	self asArray permutationsDo: aBlock
! !

!Interval methodsFor: 'sorting' stamp: 'DamienCassou 8/27/2013 21:00'!
sorted
	^ self increment >= 0
		ifTrue: [ self copy ]
		ifFalse: [ self last to: self first by: self increment negated ]! !

!Interval methodsFor: 'sorting' stamp: 'DamienCassou 8/27/2013 21:00'!
sorted: aSortBlockOrNil
	"Return a new sequenceable collection which contains the same elements as self but its elements are sorted by aSortBlockOrNil. The block should take two arguments and return true if the first element should preceed the second one. If aSortBlock is nil then <= is used for comparison. We convert the interval to an array because intervals can't be changed."
	
	^self asArray sort: aSortBlockOrNil! !

!Interval methodsFor: 'comparing' stamp: ''!
hash
	"Hash is reimplemented because = is implemented."

	^(((start hash bitShift: 2)
		bitOr: stop hash)
		bitShift: 1)
		bitOr: self size! !

!Interval methodsFor: 'accessing' stamp: 'sma 5/12/2000 11:38'!
size
	"Answer how many elements the receiver contains."

	step < 0
		ifTrue: [start < stop
				ifTrue: [^ 0]
				ifFalse: [^ stop - start // step + 1]]
		ifFalse: [stop < start
				ifTrue: [^ 0]
				ifFalse: [^ stop - start // step + 1]]! !

!Interval methodsFor: 'accessing' stamp: 'Alexandre Bergel 12/23/2009 18:52'!
indexOf: anElement startingAt: startIndex ifAbsent: exceptionBlock
	"startIndex is an positive integer, the collection index where the search is started."
	"during the computation of val , floats are only used when the receiver contains floats"

	| index val |
	(self rangeIncludes: anElement)
		ifFalse: [^ exceptionBlock value].
	val := anElement - self first / self increment.
	val isFloat
		ifTrue: [(val - val rounded) abs * 100000000 < 1
					ifTrue: [index := val rounded + 1]
					ifFalse: [^ exceptionBlock value]]
		ifFalse: [val isInteger
					ifTrue: [index := val + 1]
					ifFalse: [^ exceptionBlock value]].
	"finally, the value of startIndex comes into play:"
	^ (index between: startIndex and: self size)
		ifTrue: [index]
		ifFalse: [exceptionBlock value]! !

!Interval methodsFor: 'printing' stamp: 'CamilloBruni 4/11/2011 15:08'!
storeOn: aStream 
	aStream nextPut: $(;
	 	store: start;
	 	nextPutAll: ' to: ';
	 	store: stop.
	step ~= 1 ifTrue: [aStream nextPutAll: ' by: '; store: step].
	aStream nextPut: $)! !

!Interval methodsFor: 'testing' stamp: 'rhi 8/12/2003 09:52'!
isInterval

	^ true! !

!Interval methodsFor: 'accessing' stamp: 'stp 8/19/2000 23:52'!
extent 
	"Answer the max - min of the receiver interval."
	"(10 to: 50) extent"

	^stop - start! !

!Interval methodsFor: 'comparing' stamp: 'rhi 8/14/2003 10:08'!
= anObject

	^ self == anObject
		ifTrue: [true]
		ifFalse: [anObject isInterval
			ifTrue: [start = anObject first
				and: [step = anObject increment
					and: [self last = anObject last]]]
			ifFalse: [super = anObject]]! !

!Interval methodsFor: 'enumerating' stamp: ''!
collect: aBlock
	| nextValue result |
	result := self species new: self size.
	nextValue := start.
	1 to: result size do:
		[:i |
		result at: i put: (aBlock value: nextValue).
		nextValue := nextValue + step].
	^ result! !

!Interval methodsFor: 'accessing' stamp: ''!
at: anInteger put: anObject 
	"Storing into an Interval is not allowed."

	self error: 'you can not store into an interval'! !

!Interval methodsFor: 'removing' stamp: ''!
remove: newObject 
	"Removing from an Interval is not allowed."

	self error: 'elements cannot be removed from an Interval'! !

!Interval methodsFor: 'enumerating' stamp: 'Alexandre Bergel 12/23/2009 18:53'!
do: aBlock
	"Evaluate aBlock for each value of the interval.
	Implementation note: instead of repeatedly incrementing the value
		aValue := aValue + step.
	until stop is reached,
	We prefer to recompute value from start
		aValue := start + (index * step).
	This is better for floating points accuracy, while not degrading Integer and Fraction speed too much.
	Moreover, this is consistent with methods #at: and #size"

	| aValue index size |
	index := 0.
	size := self size.
	[index < size]
		whileTrue: [aValue := start + (index * step).
			index := index + 1.
			aBlock value: aValue]! !

!Interval methodsFor: 'enumerating' stamp: 'nice 4/30/2007 18:28'!
reverseDo: aBlock 
	"Evaluate aBlock for each element of my interval, in reverse order.
	Implementation notes: see do: for an explanation on loop detail"

	| aValue index |
	index := self size.
	[index > 0]
		whileTrue: [
			index := index - 1.
			aValue := start + (index * step).
			aBlock value: aValue]! !

!Interval methodsFor: 'self evaluating' stamp: 'sd 7/31/2005 22:03'!
isSelfEvaluating
	^ self class == Interval! !

!Interval class methodsFor: 'instance creation' stamp: ''!
from: startInteger to: stopInteger 
	"Answer an instance of me, starting at startNumber, ending at 
	stopNumber, and with an interval increment of 1."

	^self new
		setFrom: startInteger
		to: stopInteger
		by: 1! !

!Interval class methodsFor: 'accessing' stamp: 'CamilloBruni 9/5/2011 15:37'!
streamSpecies
	^ Array! !

!Interval class methodsFor: 'instance creation' stamp: 'StephaneDucasse 12/18/2009 11:59'!
new
	"Primitive. Create and answer with a new instance of the receiver
	(a class) with no indexable fields. Fail if the class is indexable. Override
	SequenceableCollection new. Essential. See Object documentation
	whatIsAPrimitive."

	<primitive: 70>
	self isVariable ifTrue: [ ^ self new: 0 ].
	"space must be low"
	OutOfMemory signal.
	^ self new  "retry if user proceeds"
! !

!Interval class methodsFor: 'instance creation' stamp: 'nice 3/27/2008 00:17'!
newFrom: aCollection 
	"Answer an instance of me containing the same elements as aCollection."

    | newInterval n |

    (n := aCollection size) <= 1 ifTrue: [
		n = 0 ifTrue: [^self from: 1 to: 0].
		^self from: aCollection first to: aCollection last].
    	newInterval := self from: aCollection first to: aCollection last
	by: (aCollection last - aCollection first) // (n - 1).
	aCollection ~= newInterval
		ifTrue: [
			"Give a second chance, because progression might be arithmetic, but = answer false"
			(newInterval hasEqualElements: aCollection) ifFalse: [
				self error: 'The argument is not an arithmetic progression']].
	^newInterval

"	Interval newFrom: {1. 2. 3}
	{33. 5. -23} as: Interval
	{33. 5. -22} as: Interval    (an error)
	(-4 to: -12 by: -1) as: Interval
	#(2 4 6) asByteArray as: Interval.
"! !

!Interval class methodsFor: 'instance creation' stamp: ''!
from: startInteger to: stopInteger by: stepInteger 
	"Answer an instance of me, starting at startNumber, ending at 
	stopNumber, and with an interval increment of stepNumber."

	^self new
		setFrom: startInteger
		to: stopInteger
		by: stepInteger! !

!IntervalTest commentStamp: 'TorstenBergmann 2/20/2014 15:28'!
SUnit tests for intervals!
!IntervalTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButLast
	"self debug: #testAllButLast"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButLast.
	self deny: abf last = col last.
	self assert: abf size + 1 = col size! !

!IntervalTest methodsFor: 'tests' stamp: 'stephane.ducasse 1/16/2009 21:06'!
testCollectThenSelectLocal
	| letters vowels |
	letters := 'abcdefghijklmnopqrstuvwxyz'.
	vowels := (1 to: 26) collect: [:index | letters at: index] thenSelect: [:char | char isVowel].
	self assert: (vowels hasEqualElements: 'aeiou').! !

!IntervalTest methodsFor: 'tests - begins ends with' stamp: ''!
testsEndsWith
	
	self assert: (self nonEmpty endsWith: self nonEmpty copyWithoutFirst).
	self assert: (self nonEmpty endsWith: self nonEmpty).
	self deny: (self nonEmpty endsWith: (self nonEmpty copyWith: self nonEmpty first)).! !

!IntervalTest methodsFor: 'tests - copying with replacement' stamp: ''!
testCopyReplaceAllWith1Occurence
	| result  firstIndexesOfOccurrence index endPartIndexResult endPartIndexCollection |
	
	result := self collectionWith1TimeSubcollection  copyReplaceAll: self oldSubCollection with: self replacementCollection .
	
	"detecting indexes of olSubCollection"
	firstIndexesOfOccurrence  := self firstIndexesOf: self oldSubCollection in: self collectionWith1TimeSubcollection .
	index:= firstIndexesOfOccurrence at: 1.
	
	"verify content of 'result' : "
	"first part of 'result'' : '"

	1 to: (index -1) do: 
		[
		:i |  
		self assert: (self collectionWith1TimeSubcollection  at:i)=(result at: i)
		].

	" middle part containing replacementCollection : "
	
	index to: (index + self replacementCollection size-1) do: 
		[
		:i |
		self assert: ( result at: i )=(self replacementCollection at: ( i - index + 1 ))
		].
	
	" end part :"
	
	endPartIndexResult :=  index + self replacementCollection  size .
	endPartIndexCollection :=   index + self oldSubCollection size  .
	
	1 to: (result size - endPartIndexResult - 1 ) do:
		[ 
		:i |
		self assert: (result at: ( endPartIndexResult + i - 1 ) ) = (self collectionWith1TimeSubcollection  at: ( endPartIndexCollection + i - 1 ) ).
		].
	
	
	! !

!IntervalTest methodsFor: 'tests - equality' stamp: ''!
testHasEqualElementsOfIdenticalCollectionObjects
	"self debug: #testHasEqualElementsOfIdenticalCollectionObjects"
	
	self assert: (self empty hasEqualElements: self empty). 
	self assert: (self nonEmpty hasEqualElements: self nonEmpty). 
	! !

!IntervalTest methodsFor: 'tests - index access' stamp: ''!
testLastIndexOf
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection lastIndexOf: element) = 1.
	self assert: (collection lastIndexOf: self elementNotInForIndexAccessing) = 0! !

!IntervalTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyWithReplacementTest
	self replacementCollection.
	self oldSubCollection.
	self collectionWith1TimeSubcollection.
	self assert: (self howMany: self oldSubCollection in: self collectionWith1TimeSubcollection) = 1! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 10:51'!
moreThan4Elements

" return a collection including at leat 4 elements"
	^ nonEmpty ! !

!IntervalTest methodsFor: 'tests - subcollections access' stamp: ''!
testFirstNElements
	"self debug: #testFirstNElements"
	| result |
	result := self moreThan3Elements first: self moreThan3Elements size - 1.
	1 
		to: result size
		do: [ :i | self assert: (result at: i) = (self moreThan3Elements at: i) ].
	self assert: result size = (self moreThan3Elements size - 1).
	self 
		should: [ self moreThan3Elements first: self moreThan3Elements size + 1 ]
		raise: Error! !

!IntervalTest methodsFor: 'tests - fixture' stamp: ''!
test0TStructuralEqualityTest
	self empty.
	self nonEmpty.
	self assert: self empty isEmpty.
	self deny: self nonEmpty isEmpty! !

!IntervalTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithoutFirst

	| result |
	result := self nonEmpty copyWithoutFirst.
	
	self assert: result size = (self nonEmpty size - 1).
	
	1 to: result size do:
		[:i |
		self assert: (result at: i)= (self nonEmpty at: (i + 1))].! !

!IntervalTest methodsFor: 'tests' stamp: 'md 10/12/2003 20:13'!
testEquals2

	self assert: (3 to: 5) = #(3 4 5).
	self deny: (3 to: 5) = #(3 5).
	self deny: (3 to: 5) = #().

	self assert: #(3 4 5) = (3 to: 5).
	self deny: #(3 5) = (3 to: 5).
	self deny: #() = (3 to: 5).! !

!IntervalTest methodsFor: 'tests - element accessing' stamp: ''!
testBefore
	"self debug: #testBefore"
	self assert: (self moreThan4Elements before: (self moreThan4Elements at: 2)) = (self moreThan4Elements at: 1).
	self 
		should: [ self moreThan4Elements before: (self moreThan4Elements at: 1) ]
		raise: Error.
	self 
		should: [ self moreThan4Elements before: 66 ]
		raise: Error! !

!IntervalTest methodsFor: 'tests' stamp: 'Alexandre Bergel 12/23/2009 18:47'!
testInfiniteLoopBug6456
	"This is a non regression test against mantis bug #6456.
	Some Float interval size was not consistent with do: loop.
	Some Float Interval used to do: infinite loops"

	| x interval counter size |
	x := (1.0 timesTwoPower: Float precision). "Note: x+1 = x due to inexact arithmetic"
	interval := x to: x+4.
	size := interval size.
	counter := 0.
	interval do: [:each | self assert: (counter := counter + 1) <= size]
! !

!IntervalTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAnyNoneThere
	"self debug: #testIncludesAnyOfNoneThere'"
	
	self deny: (self nonEmpty includesAny: self empty).
	self deny: (self nonEmpty includesAny: { self elementNotIn. self anotherElementNotIn })! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/15/2009 14:10'!
collectionOfFloat
	^collectionOfFloat ! !

!IntervalTest methodsFor: 'requirements' stamp: 'CamilloBruni 9/9/2011 12:11'!
collectionWithoutEqualElements
	^ nonEmpty ! !

!IntervalTest methodsFor: 'tests' stamp: 'zz 12/5/2005 18:23'!
testAdd
	self assert: (1 to: 10)
			+ 5
			= (6 to: 15)! !

!IntervalTest methodsFor: 'tests - converting' stamp: ''!
testAsArray
	"self debug: #testAsArray3"
	self 
		assertSameContents: self collectionWithoutEqualElements
		whenConvertedTo: Array! !

!IntervalTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedArray
	| result collection |
	collection := self collectionWithSortableElements .
	result := collection  asArray sort.
	self assert: (result class includesBehavior: Array).
	self assert: result isSorted.
	self assert: result size = collection size! !

!IntervalTest methodsFor: 'requirements' stamp: 'DamienCassou 8/27/2013 20:58'!
unsortedCollection
" retur a collection that is not yat sorted"
	^ (10 to: 1 by: -2)! !

!IntervalTest methodsFor: 'tests - copy' stamp: ''!
testCopyNotSame
	"self debug: #testCopySameClass"
	"A copy of a collection should always be of the same class as the instance it copies"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: copy  == self nonEmpty.! !

!IntervalTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindFirst

	| element result |
	element := self nonEmptyMoreThan1Element   at:1.
	 result:=self nonEmptyMoreThan1Element  findFirst: [:each | each =element].
	
	self assert: result=1. ! !

!IntervalTest methodsFor: 'requirements' stamp: 'damienpollet 1/29/2009 18:58'!
firstOdd
	"Returns the first odd number of #collection"
	^ -5! !

!IntervalTest methodsFor: 'tests' stamp: 'md 10/12/2003 20:13'!
testEquals3

	self assert: (3 to: 5 by: 2) first = (3 to: 6 by: 2) first.
	self assert: (3 to: 5 by: 2) last = (3 to: 6 by: 2) last.
	self assert: (3 to: 5 by: 2) = (3 to: 6 by: 2).! !

!IntervalTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithIndexCollect
	
	| result index collection |
	index := 0.
	collection := self nonEmptyMoreThan1Element .
	result := collection  withIndexCollect: [:each :i | 
		self assert: i = (index := index + 1).	
		self assert: i = (collection  indexOf: each) .
		each] . 
	
	1 to: result size do:[: i | self assert: (result at:i)= (collection at: i)].
	self assert: result size = collection size.! !

!IntervalTest methodsFor: 'tests - printing' stamp: ''!
testPrintElementsOn

	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printElementsOn: aStream .
	allElementsAsString:=(result findBetweenSubStrs: ' ' ).
	1 to: allElementsAsString size do:
		[:i | 
		self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString).
			].! !

!IntervalTest methodsFor: 'tests - begins ends with' stamp: ''!
testsEndsWithEmpty
	
	self deny: (self nonEmpty endsWith: self empty).
	self deny: (self empty endsWith: self nonEmpty).
	! !

!IntervalTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithSequenceable

	| result index element |
	index := self indexInNonEmpty .
	element := self nonEmpty at: index.
	result := self nonEmpty copyWith: (element ).
	
	self assert: result size = (self nonEmpty size + 1).
	self assert: result last = element .
	
	1 to: (result size - 1) do:
	[ :i |
	self assert: (result at: i) = ( self nonEmpty at: ( i  ))].! !

!IntervalTest methodsFor: 'tests - concatenation' stamp: ''!
testConcatenationWithEmpty
	| result |
	result:= self empty,self secondCollection .
	
	1 to: self secondCollection size do:
		[:i | 
		self assert: (self secondCollection at:i)= (result at:i).
		].
	"size : "
	self assert: result size = ( self secondCollection size).! !

!IntervalTest methodsFor: 'requirements' stamp: 'stephane.ducasse 11/21/2008 15:39'!
anotherElementNotIn
	^ 42! !

!IntervalTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIterateSequencedReadableTest

	| res |
	
	self nonEmptyMoreThan1Element.
	self assert: self nonEmptyMoreThan1Element  size > 1.
	
	
	self empty.
	self assert: self empty isEmpty .
	
	res := true.
	self nonEmptyMoreThan1Element    
	detect: [ :each | (self nonEmptyMoreThan1Element    occurrencesOf: each) > 1 ]
	ifNone: [ res := false ].
	self assert: res = false.! !

!IntervalTest methodsFor: 'tests' stamp: 'zz 12/5/2005 18:28'!
testMinus
	self assert: (1 to: 10)
			- 5
			= (-4 to: 5)! !

!IntervalTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterLastEmpty

	| delim emptyStream |
	delim := ', '.
	emptyStream := ReadWriteStream on: ''.
	self empty asStringOn: emptyStream delimiter: delim last:'and'.
	self assert: emptyStream contents = ''.
! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/17/2009 14:44'!
collectionWith1TimeSubcollection
	^ collectionWithSubCollection ! !

!IntervalTest methodsFor: 'tests - element accessing' stamp: ''!
testAtOutOfBounds
	"self debug: #testAtOutOfBounds"
	self 
		should: [ self moreThan4Elements at: self moreThan4Elements size + 1 ]
		raise: Error.
	self 
		should: [ self moreThan4Elements at: -1 ]
		raise: Error! !

!IntervalTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOfEmpty
	| result |
	result := self empty occurrencesOf: (self collectionWithoutEqualElements anyOne).
	self assert: result = 0! !

!IntervalTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyEmpty
	"self debug: #testCopyEmpty"
	
	| copy | 
	copy := self empty copy.
	self assert: copy isEmpty.! !

!IntervalTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithCollect
	
	| result firstCollection secondCollection index  |

	firstCollection := self nonEmptyMoreThan1Element.
	secondCollection := firstCollection copy.
	index := 0.
	
	result := firstCollection  with: secondCollection collect:
		[:a :b |
		( index := index + 1).
		self assert: (firstCollection at: index) equals:  a. 
		self assert: (secondCollection at: index) equals:  b.
		b].
	
	1 to: result size do:[: i | self assert: (result at:i)= (secondCollection  at: i)].
	self assert: result size = secondCollection  size.! !

!IntervalTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:34'!
testNewFrom

	self assert: ( (Interval newFrom: (1 to: 1)) = (1 to: 1)).
	self assert: ( (Interval newFrom: #(1)) = (1 to: 1)).
	self assert: ( (Interval newFrom: #()) =  ( 1 to: 0)).! !

!IntervalTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterLastOne

	| delim oneItemStream result |
	
	delim := ', '.
	result:=''.
	oneItemStream := ReadWriteStream on: result.
	self nonEmpty1Element  asStringOn: oneItemStream delimiter: delim last: 'and'.
	oneItemStream do:[:each | self assert: each = (self nonEmpty1Element first asString)].
	

	! !

!IntervalTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIncludeWithIdentityTest
	| anElement |
	self collectionWithCopyNonIdentical.
	anElement := self collectionWithCopyNonIdentical anyOne.
	self deny: anElement == anElement copy! !

!IntervalTest methodsFor: 'tests - printing' stamp: ''!
testPrintOnDelimiter
	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printOn: aStream delimiter: ', ' .
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString).
			].! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/15/2009 14:22'!
elementInCollectionOfFloat
	^ collectionOfFloat anyOne! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/23/2009 11:28'!
collectionWithoutNilElements
" return a collection that doesn't includes a nil element  and that doesn't includes equal elements'"
	^ collectionWithoutNil ! !

!IntervalTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureTConvertTest
	"a collection of number without equal elements:"

	| res |
	self collectionWithoutEqualElements.
	res := true.
	self collectionWithoutEqualElements
		detect: [ :each | (self collectionWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false! !

!IntervalTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterMore

	| delim multiItemStream result index |
	"delim := ', '.
	multiItemStream := '' readWrite.
	self oneTwoThreeItemCol asStringOn: multiItemStream delimiter: ', '.
	self assert: multiItemStream contents = '1, 2, 3'."
	
	delim := ', '.
	result:=''.
	multiItemStream := ReadWriteStream on:result.
	self nonEmpty  asStringOn: multiItemStream delimiter: ', '.
	
	index:=1.
	(result findBetweenSubStrs: ', ' )do:
		[:each |
		self assert: each= ((self nonEmpty at:index)asString).
		index:=index+1
		].! !

!IntervalTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testDetectSequenced
" testing that detect keep the first element returning true for sequenceable collections "

	| element result |
	element := self nonEmptyMoreThan1Element   at:1.
	result:=self nonEmptyMoreThan1Element  detect: [:each | each notNil ].
	self assert: result = element. ! !

!IntervalTest methodsFor: 'tests - includes' stamp: ''!
testIdentityIncludesNonSpecificComportement
	" test the same comportement than 'includes: '  "
	| collection |	
	collection := self nonEmpty  .
	
	self deny: (collection identityIncludes: self elementNotIn ).
	self assert:(collection identityIncludes: collection anyOne)
! !

!IntervalTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureAsStringCommaAndDelimiterTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty.
	self nonEmpty1Element.
	self assert: self nonEmpty1Element size = 1! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/23/2009 15:15'!
collectionMoreThan1NoDuplicates
	" return a collection of size 5 without equal elements"
	^ nonEmpty ! !

!IntervalTest methodsFor: 'as yet unclassified' stamp: ''!
testSorted
	| result tmp unsorted |
	unsorted := self unsortedCollection.
	result := unsorted sorted.
	self deny: unsorted == result.
	tmp := result at: 1.
	result
		do: [ :each | 
			self assert: each >= tmp.
			tmp := each ]! !

!IntervalTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAnyAllThere
	"self debug: #testIncludesAnyOfAllThere'"
	self deny: (self nonEmpty includesAny: self empty).
	self assert: (self nonEmpty includesAny: { self nonEmpty anyOne }).
	self assert: (self nonEmpty includesAny: self nonEmpty).! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/17/2009 15:27'!
elementToAdd
	^ elementNotIn ! !

!IntervalTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testPairsDo
	| index |
	index:=1.
	
	self nonEmptyMoreThan1Element  pairsDo: 
		[:each1 :each2 | 
		self assert:(self nonEmptyMoreThan1Element at:index)=each1.
		self assert:(self nonEmptyMoreThan1Element at:(index+1))=each2.
		index:=index+2].
	
	self nonEmptyMoreThan1Element size odd
		ifTrue:[self assert: index=self nonEmptyMoreThan1Element size]
		ifFalse:[self assert: index=(self nonEmptyMoreThan1Element size+1)].! !

!IntervalTest methodsFor: 'tests - subcollections access' stamp: ''!
testLastNElements
	"self debug: #testLastNElements"
	| result |
	result := self moreThan3Elements last: self moreThan3Elements size - 1.
	1 
		to: result size
		do: [ :i | self assert: (result at: i) = (self moreThan3Elements at: i + 1) ].
	self assert: result size = (self moreThan3Elements size - 1).
	self 
		should: [ self moreThan3Elements last: self moreThan3Elements size + 1 ]
		raise: Error! !

!IntervalTest methodsFor: 'requirements' stamp: 'damiencassou 1/27/2009 17:21'!
accessCollection
	^ -2 to: 14 by: 4! !

!IntervalTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testCollectFromTo
	
	| result |
	result:=self nonEmptyMoreThan1Element 
		collect: [ :each | each ]
		from: 1
		to: (self nonEmptyMoreThan1Element size - 1).
		
	1 to: result size
		do: [ :i | self assert: (self nonEmptyMoreThan1Element at: i) = (result at: i) ].
	self assert: result size = (self nonEmptyMoreThan1Element size - 1)! !

!IntervalTest methodsFor: 'tests - printing' stamp: ''!
testPrintNameOn

	| aStream result |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printNameOn: aStream .
	Transcript show: result asString.
	self nonEmpty class name first isVowel
		ifTrue:[ self assert: aStream contents =('an ',self nonEmpty class name ) ]
		ifFalse:[self assert: aStream contents =('a ',self nonEmpty class name)].! !

!IntervalTest methodsFor: 'tests' stamp: 'MarcusDenker 5/2/2013 11:33'!
testIntervalStoreOn
	"this is a test for http://bugs.squeak.org/view.php?id=4378"
	
	| interval1 interval2 |
	interval1 := 0 to: 1 by: 0.5s1 squared.
	interval2 := self class compiler evaluate: interval1 storeString.
	self assert: interval1 size = interval2 size! !

!IntervalTest methodsFor: 'tests' stamp: 'zz 12/5/2005 18:11'!
testIsEvaluating
	self assert: (1 to: 10) isSelfEvaluating.
	self assert: (1 to: 10 by: 2) isSelfEvaluating! !

!IntervalTest methodsFor: 'test - equality' stamp: ''!
testEqualSignIsTrueForNonIdenticalButEqualCollections
	"self debug: #testEqualSignIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty = self empty copy). 
	self assert: (self empty copy = self empty).
	self assert: (self empty copy = self empty copy).
		
	self assert: (self nonEmpty = self nonEmpty copy). 
	self assert: (self nonEmpty copy = self nonEmpty).
	self assert: (self nonEmpty copy = self nonEmpty copy).! !

!IntervalTest methodsFor: 'tests - fixture' stamp: ''!
test0SortingArrayedTest
	| tmp sorted |
	" an unsorted collection of number "
	self unsortedCollection.
	self unsortedCollection do: [ :each | each isNumber ].
	sorted := true.
	self unsortedCollection
		pairsDo: [ :each1 :each2 | 
			each2 < each1
				ifTrue: [ sorted := false ] ].
	self assert: sorted = false.	" a collection of number sorted in an ascending order"
	self sortedInAscendingOrderCollection.
	self sortedInAscendingOrderCollection do: [ :each | each isNumber ].
	tmp := self sortedInAscendingOrderCollection at: 1.
	self sortedInAscendingOrderCollection
		do: [ :each | 
			self assert: each >= tmp.
			tmp := each ]! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 14:40'!
elementInForElementAccessing
" return an element inculded in 'accessCollection '"
	^ self accessCollection anyOne! !

!IntervalTest methodsFor: 'tests - copying with replacement' stamp: ''!
testCopyReplaceFromToWithInsertion
	| result  indexOfSubcollection |
	
	indexOfSubcollection := (self firstIndexesOf: self oldSubCollection  in:  self collectionWith1TimeSubcollection) at: 1. 
	
	result := self collectionWith1TimeSubcollection  copyReplaceFrom: indexOfSubcollection  to: ( indexOfSubcollection - 1 ) with: self replacementCollection .
	
	"verify content of 'result' : "
	"first part of 'result'' : '"
	
	1 to: (indexOfSubcollection -1) do: 
		[
		:i | 
		self assert: (self collectionWith1TimeSubcollection  at:i)=(result at: i)
		].
	
	" middle part containing replacementCollection : "
	indexOfSubcollection  to: (indexOfSubcollection  + self replacementCollection size-1) do: 
		[
		:i |
		self assert: ( result at: i )=(self replacementCollection at: ( i - indexOfSubcollection +1 ))
		].
	
	" end part :"
	(indexOfSubcollection  + self replacementCollection size) to: (result size) do:
		[:i|
		self assert: (result at: i)=(self collectionWith1TimeSubcollection  at: (i-self replacementCollection size))].
	
	" verify size: "	
	self assert: result size=(self collectionWith1TimeSubcollection  size + self replacementCollection size).
	

	

	
	! !

!IntervalTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsCommaStringMore

	"self assert: self oneTwoThreeItemCol asCommaString = '1, 2, 3'.
	self assert: self oneTwoThreeItemCol asCommaStringAnd = '1, 2 and 3'
"

	| result resultAnd index allElementsAsString |
	result:= self nonEmpty asCommaString .
	resultAnd:= self nonEmpty asCommaStringAnd .
 
	index := 1.
	(result findBetweenSubStrs: ',' )do:
		[:each |
		index = 1
			ifTrue: [self assert: each= ((self nonEmpty at:index)asString)]
			ifFalse: [self assert: each= (' ',(self nonEmpty at:index) asString)].
		index:=index+1
		].
	
	"verifying esultAnd :"
	allElementsAsString:=(resultAnd findBetweenSubStrs: ',' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size )
			ifTrue: [
			i = 1
				ifTrue:[self assert: (allElementsAsString at:i)=((self nonEmpty at:i) asString)]
				ifFalse:[self assert: (allElementsAsString at:i)=(' ',(self nonEmpty at:i) asString)]
				].
		i=(allElementsAsString size)
			ifTrue:[ 
			i = 1
				ifTrue:[self assert: (allElementsAsString at:i)=( (self nonEmpty at:i ) asString ,' and ', (self nonEmpty at: ( i + 1) ) asString )]
				ifFalse:[self assert: (allElementsAsString at:i)=( ' ' , (self nonEmpty at:i ) asString ,' and ', (self nonEmpty at: ( i + 1) ) asString )]
				].
		
		
			].! !

!IntervalTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWith
	"self debug: #testCopyNonEmptyWith"
	| res anElement |
	anElement := self elementToAdd .
	res := self nonEmpty copyWith: anElement.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self assert: (res includes: (anElement value)).
	self nonEmpty do: [ :each | res includes: each ]! !

!IntervalTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfterLastEmpty
	| result |
	result := self empty copyAfterLast: self collectionWithoutEqualElements first.
	self assert: result isEmpty.! !

!IntervalTest methodsFor: 'tests' stamp: 'nice 2/3/2008 21:35'!
testIndexOfBug6455
	"This test is about mantis bug http://bugs.squeak.org/view.php?id=6455
	It should work as long as Fuzzy inclusion test feature for Interval of Float is maintained.
	This is a case when tested element is near ones of actual value, but by default.
	Code used to work only in the case of close numbers by excess..."
	
	self assert: ((0 to: Float pi by: Float pi / 100) indexOf: Float pi * (3/100)) = 4! !

!IntervalTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutAllNotIncluded
	"self debug: #testCopyNonEmptyWithoutAllNotIncluded"
	| res |
	res := self nonEmpty copyWithoutAll: self collectionNotIncluded.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self nonEmpty do: [ :each | self assert: (res includes: each) ]! !

!IntervalTest methodsFor: 'tests' stamp: 'nice 2/3/2008 21:43'!
testInclusionBug6455
	"This test is about mantis bug http://bugs.squeak.org/view.php?id=6455
	It should work as long as Fuzzy inclusion test feature for Interval of Float is maintained.
	This is a case when tested element is near ones of actual value, but by default.
	Code used to work only in the case of close numbers by excess..."
	
	self assert: ((0 to: Float pi by: Float pi / 100) includes: Float pi * (3/100))! !

!IntervalTest methodsFor: 'requirements' stamp: 'damienpollet 1/29/2009 18:59'!
doWithoutNumber

	^ 6! !

!IntervalTest methodsFor: 'tests - index access' stamp: ''!
testIdentityIndexOfIAbsent
	| collection element |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			identityIndexOf: element
			ifAbsent: [ 0 ]) = 1.
	self assert: (collection 
			identityIndexOf: self elementNotInForIndexAccessing
			ifAbsent: [ 55 ]) = 55! !

!IntervalTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfSubCollectionStartingAt
	"self debug: #testIndexOfIfAbsent"
	| subcollection index collection |
	collection := self collectionMoreThan1NoDuplicates.
	subcollection := self collectionMoreThan1NoDuplicates.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 1.
	self assert: index = 1.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 2.
	self assert: index = 0! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/24/2009 10:25'!
collectionWithSortableElements
" return a collection elements that can be sorte ( understanding message ' < '  or ' > ')"
	^ self nonEmpty ! !

!IntervalTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedCollectionWithSortBlock
	| result tmp |
	result := self collectionWithSortableElements  asSortedCollection: [:a :b | a > b].
	self assert: (result class includesBehavior: SortedCollection).
	result do: 
		[ :each | 
		self assert: (self collectionWithSortableElements   occurrencesOf: each) = (result occurrencesOf: each) ].
	self assert: result size = self collectionWithSortableElements  size.
	tmp:=result at: 1.
	result do: [:each| self assert: tmp>=each. tmp:=each].
	! !

!IntervalTest methodsFor: 'tests' stamp: 'zz 12/7/2005 13:29'!
testIsInterval
	self assert: (1 to: 10) isInterval.
	self assert: (1 to: 10 by: 2) isInterval! !

!IntervalTest methodsFor: 'tests - sorting' stamp: ''!
testSortedUsingBlock
	| result tmp |
	result := self unsortedCollection sorted:  [:a :b | a>b]..
	tmp := result at: 1.
	result do:
		[:each | self assert: each<=tmp. tmp:= each. ].! !

!IntervalTest methodsFor: 'tests - index access' stamp: ''!
testIdentityIndexOf
	"self debug: #testIdentityIndexOf"
	| collection element |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection identityIndexOf: element) = (collection indexOf: element)! !

!IntervalTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureOccurrencesTest
	| tmp |
	self empty.
	self assert: self empty isEmpty.
	self collectionWithoutEqualElements.
	self deny: self collectionWithoutEqualElements isEmpty.
	tmp := OrderedCollection new.
	self collectionWithoutEqualElements
		do: [ :each | 
			self deny: (tmp includes: each).
			tmp add: each ].
	self elementNotInForOccurrences.
	self deny: (self collectionWithoutEqualElements includes: self elementNotInForOccurrences)! !

!IntervalTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIndexAccessTest
	| res collection element |
	self collectionMoreThan1NoDuplicates.
	self assert: self collectionMoreThan1NoDuplicates size > 1.
	res := true.
	self collectionMoreThan1NoDuplicates
		detect: [ :each | (self collectionMoreThan1NoDuplicates occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false.
	self elementInForIndexAccessing.
	self
		assert: ((collection := self collectionMoreThan1NoDuplicates) includes: (element := self elementInForIndexAccessing)).
	self elementNotInForIndexAccessing.
	self deny: (self collectionMoreThan1NoDuplicates includes: self elementNotInForIndexAccessing)! !

!IntervalTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyCreatesNewObject
	"self debug: #testCopyCreatesNewObject"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: self nonEmpty == copy.
	! !

!IntervalTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithDo
	
	| firstCollection secondCollection index |

	firstCollection := self nonEmptyMoreThan1Element.
	secondCollection := firstCollection copy.
	index := 0.
	
	firstCollection  with: secondCollection do:
		[:a :b |
		( index := index + 1).
		self assert: (firstCollection at: index) equals:  a. 
		self assert: (secondCollection at: index) equals:  b.]
	
	! !

!IntervalTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testAllButFirstDo
	
	| result |
	result:= OrderedCollection  new.
	
	self nonEmptyMoreThan1Element  allButFirstDo: [:each | result add: each].
	
	1 to: (result size) do:
		[:i|
		self assert: (self nonEmptyMoreThan1Element  at:(i +1))=(result at:i)].
	
	self assert: result size=(self nonEmptyMoreThan1Element  size-1).! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/15/2009 14:56'!
secondCollection
	^anotherCollection ! !

!IntervalTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithDoError
	
	self should: [self nonEmptyMoreThan1Element with: self empty do:[:a :b | ]] raise: Error.! !

!IntervalTest methodsFor: 'requirements' stamp: 'DamienCassou 8/27/2013 20:58'!
sortedInAscendingOrderCollection
" return a collection sorted in an acsending order"
	^ anotherCollection! !

!IntervalTest methodsFor: 'tests - indexable access' stamp: 'delaunay 4/10/2009 16:20'!
testAtWrap
	"self debug: #testAt"
	"
	self assert: (self accessCollection at: 1) = 1.
	self assert: (self accessCollection at: 2) = 2.
	"
	| index |
	index := self accessCollection indexOf: self elementInForIndexAccessing.
	self assert: (self accessCollection atWrap: index) = self elementInForIndexAccessing.
	self assert: (self accessCollection atWrap: index + self accessCollection size) = self elementInForIndexAccessing.
	self assert: (self accessCollection atWrap: index - self accessCollection size) = self elementInForIndexAccessing.
	self assert: (self accessCollection atWrap: 1 + self accessCollection size) = (self accessCollection at: 1)! !

!IntervalTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithout
	"self debug: #testCopyNonEmptyWithout"
	
	| res anElementOfTheCollection |
	anElementOfTheCollection :=  self nonEmpty anyOne.
	res := (self nonEmpty copyWithout: anElementOfTheCollection).
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self deny: (res includes: anElementOfTheCollection).
	self nonEmpty do:
		[:each | (each = anElementOfTheCollection) 
					ifFalse: [self assert: (res includes: each)]].
	
! !

!IntervalTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutNotIncluded
	"self debug: #testCopyNonEmptyWithoutNotIncluded"
	| res |
	res := self nonEmpty copyWithout: self elementToAdd.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self nonEmpty do: [ :each | self assert: (res includes: each) ]! !

!IntervalTest methodsFor: 'tests - concatenation' stamp: ''!
testConcatenation
	| result index |
	result:= self firstCollection,self secondCollection .
	"first part : "
	index := 1.
	self firstCollection do: 
		[:each | 
		self assert: (self firstCollection at: index)=each.
		index := index+1.].
	"second part : "
	1 to: self secondCollection size do:
		[:i | 
		self assert: (self secondCollection at:i)= (result at:index).
		index:=index+1].
	"size : "
	self assert: result size = (self firstCollection size + self secondCollection size).! !

!IntervalTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testKeysAndValuesDo
	"| result |
	result:= OrderedCollection new.
	
	self nonEmptyMoreThan1Element  keysAndValuesDo: 
		[:i :value|
		result add: (value+i)].
	
	1 to: result size do:
		[:i|
		self assert: (result at:i)=((self nonEmptyMoreThan1Element at:i)+i)]"
	|  indexes elements |
	indexes:= OrderedCollection new.
	elements := OrderedCollection new.
	
	self nonEmptyMoreThan1Element  keysAndValuesDo: 
		[:i :value|
		indexes  add: (i).
		elements add: value].
	
	(1 to: self nonEmptyMoreThan1Element size )do:
		[ :i |
		self assert: (indexes at: i) = i.
		self assert: (elements at: i) = (self nonEmptyMoreThan1Element at: i).	
		].
	
	self assert: indexes size = elements size. 
	self assert: indexes size = self nonEmptyMoreThan1Element size . 
	
	! !

!IntervalTest methodsFor: 'tests' stamp: 'apb 4/22/2007 12:39'!
testUnevenDo
	| s i |
	s := OrderedCollection new.
	i := 10 to: 20 by: 3.
	i
		do: [:each | s addLast: each].
	self
		assert: (s hasEqualElements: i)! !

!IntervalTest methodsFor: 'tests - converting' stamp: ''!
testAsOrderedCollection
	
	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: OrderedCollection! !

!IntervalTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOf
	| collection |
	collection := self collectionWithoutEqualElements .
	
	collection do: [ :each | self assert: (collection occurrencesOf: each) = 1 ].! !

!IntervalTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:23'!
test0CopyTest
	self empty.
	self assert: self empty size = 0.
	self nonEmpty.
	self assert: (self nonEmpty size = 0) not.
	self collectionWithElementsToRemove.
	self assert: (self collectionWithElementsToRemove size = 0) not.
	self elementToAdd.
	self collectionNotIncluded.
	self collectionNotIncluded do: [ :each | self deny: (self nonEmpty includes: each) ]! !

!IntervalTest methodsFor: 'tests - streaming' stamp: ''!
testStreamContentsProtocol
	| result index |
	result:= self collectionClass << [ :s|
		s 
			nextPutAll: self firstCollection;
			nextPutAll: self secondCollection ].
	self assert: result equals: self firstCollection, self secondCollection.! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/17/2009 15:02'!
indexInNonEmpty
	^2.! !

!IntervalTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSequencedConcatenationTest
	self empty.
	self assert: self empty isEmpty.
	self firstCollection.
	self secondCollection! !

!IntervalTest methodsFor: 'tests - begins ends with' stamp: ''!
testsBeginsWithEmpty
	
	self deny: (self nonEmpty beginsWith:(self empty)).
	self deny: (self empty beginsWith:(self nonEmpty )).
! !

!IntervalTest methodsFor: 'tests - equality' stamp: ''!
testHasEqualElements
	"self debug: #testHasEqualElements"

	self deny: (self empty hasEqualElements: self nonEmpty).
	self deny: (self nonEmpty hasEqualElements: self nonEmpty asSet). 
	self deny: (self nonEmpty reversed hasEqualElements: self nonEmpty).
	self deny: (self nonEmpty hasEqualElements: self nonEmpty reversed).! !

!IntervalTest methodsFor: 'requirements' stamp: 'damienpollet 1/29/2009 18:57'!
result
	^ {SmallInteger . SmallInteger . SmallInteger . SmallInteger . SmallInteger . SmallInteger}! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 10:22'!
collectionWithCopyNonIdentical
	" return a collection that include elements for which 'copy' return a different object (this is not the case of SmallInteger)"
	^ collectionOfFloat! !

!IntervalTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWithout
	"self debug: #testCopyEmptyWithout"
	| res |
	res := self empty copyWithout: self elementToAdd.
	self assert: res size = self empty size.
	self deny: (res includes: self elementToAdd)! !

!IntervalTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedCollection

	| aCollection result |
	aCollection := self collectionWithSortableElements .
	result := aCollection asSortedCollection.
	
	self assert: (result class includesBehavior: SortedCollection).
	result do: 
		[ :each | 
		self assert: (aCollection occurrencesOf: each) = (result occurrencesOf: each) ].
	
	self assert: result size = aCollection size.! !

!IntervalTest methodsFor: 'tests - begins ends with' stamp: ''!
testsBeginsWith
	
	self assert: (self nonEmpty beginsWith:(self nonEmpty copyUpTo: self nonEmpty last)).
	self assert: (self nonEmpty beginsWith:(self nonEmpty )).
	self deny: (self nonEmpty beginsWith:(self nonEmpty copyWith:self nonEmpty first)).! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/15/2009 16:36'!
collectionClass

	^ Interval! !

!IntervalTest methodsFor: 'tests' stamp: 'md 10/12/2003 20:13'!
testEquals4

	self assert: (3 to: 5 by: 2) = #(3 5).
	self deny: (3 to: 5 by: 2) = #(3 4 5).
	self deny: (3 to: 5 by: 2) = #().

	self assert: #(3 5) = (3 to: 5 by: 2).
	self deny: #(3 4 5) = (3 to: 5 by: 2).
	self deny: #() = (3 to: 5 by: 2).! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/15/2009 15:00'!
nonEmpty1Element

	^ nonEmpty1Element  ! !

!IntervalTest methodsFor: 'tests - fixture' stamp: ''!
test0TSequencedStructuralEqualityTest
	self nonEmpty at: 1	"Ensures #nonEmpty is sequenceable"! !

!IntervalTest methodsFor: 'tests - copying with replacement' stamp: ''!
testCopyReplaceFromToWith
	| result  indexOfSubcollection lastIndexOfOldSubcollection lastIndexOfReplacementCollection |
	
	indexOfSubcollection := (self firstIndexesOf: self oldSubCollection  in:  self collectionWith1TimeSubcollection) at: 1. 
	lastIndexOfOldSubcollection := indexOfSubcollection + self oldSubCollection size -1.
	lastIndexOfReplacementCollection := indexOfSubcollection + self replacementCollection  size -1.
	
	result := self collectionWith1TimeSubcollection  copyReplaceFrom: indexOfSubcollection  to: lastIndexOfOldSubcollection   with: self replacementCollection .
	
	"verify content of 'result' : "
	"first part of 'result'  "
	
	1 to: (indexOfSubcollection  - 1) do: 
		[ 
		:i | 
		self assert: (self collectionWith1TimeSubcollection  at:i) = (result at: i)
		].
	
	" middle part containing replacementCollection : "
	
	(indexOfSubcollection ) to: ( lastIndexOfReplacementCollection  ) do: 
		[
		:i |
		self assert: (result at: i)=(self replacementCollection at: (i - indexOfSubcollection +1))
		].
	
	" end part :"
	1 to: (result size - lastIndexOfReplacementCollection   ) do:
		[ 
		:i |
		self assert: (result at: ( lastIndexOfReplacementCollection  + i  ) ) = (self collectionWith1TimeSubcollection  at: ( lastIndexOfOldSubcollection  + i  ) ).
		].
	
	
	

	
	! !

!IntervalTest methodsFor: 'tests' stamp: 'apb 4/22/2007 12:34'!
testDo
	| s i |
	s := OrderedCollection new.
	i := (10 to: 20).
	i do: [ :each | s addLast: each].
	self assert: (s hasEqualElements: i)! !

!IntervalTest methodsFor: 'tests - equality' stamp: ''!
testHasEqualElementsIsTrueForNonIdenticalButEqualCollections
	"self debug: #testHasEqualElementsIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty hasEqualElements: self empty copy). 
	self assert: (self empty copy hasEqualElements: self empty).
	self assert: (self empty copy hasEqualElements: self empty copy).
		
	self assert: (self nonEmpty hasEqualElements: self nonEmpty copy). 
	self assert: (self nonEmpty copy hasEqualElements: self nonEmpty).
	self assert: (self nonEmpty copy hasEqualElements: self nonEmpty copy).! !

!IntervalTest methodsFor: 'test - equality' stamp: ''!
testEqualSign
	"self debug: #testEqualSign"

	self deny: (self empty = self nonEmpty).! !

!IntervalTest methodsFor: 'requirements' stamp: 'damienpollet 1/29/2009 18:57'!
firstEven
	"Returns the first even number of #collection"
	^ -2! !

!IntervalTest methodsFor: 'tests' stamp: 'zz 12/5/2005 18:20'!
testRangeIncludes
	self
		assert: ((1 to: 10)
				rangeIncludes: 3).
	self
		assert: ((1 to: 10 by: 2)
				rangeIncludes: 3).
	self
		deny: ((1 to: 10)
				rangeIncludes: 0).
	self
		deny: ((1 to: 10)
				rangeIncludes: 11).
	self
		deny: ((1 to: 10 by: 2)
				rangeIncludes: 0).
	self
		deny: ((1 to: 10 by: 2)
				rangeIncludes: 11)! !

!IntervalTest methodsFor: 'tests - copy' stamp: ''!
testCopySameClass
	"self debug: #testCopySameClass"
	"A copy of a collection should always be of the same class as the instance it copies"
	
	| copy | 
	copy := self empty copy.
	self assert: copy class == self empty class.! !

!IntervalTest methodsFor: 'tests - element accessing' stamp: ''!
testAfter
	"self debug: #testAfter"
	self assert: (self moreThan4Elements after: (self moreThan4Elements at: 1)) = (self moreThan4Elements at: 2).
	self 
		should: 
			[ self moreThan4Elements after: (self moreThan4Elements at: self moreThan4Elements size) ]
		raise: Error.
	self 
		should: [ self moreThan4Elements after: self elementNotInForElementAccessing ]
		raise: Error! !

!IntervalTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButFirstNElements
	"self debug: #testAllButFirst"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButFirst: 2.
	1 
		to: abf size
		do: [ :i | self assert: (abf at: i) = (col at: i + 2) ].
	self assert: abf size + 2 = col size! !

!IntervalTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfter
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyAfter: (collection  at:index ).
	
	"verifying content: "
	(1) to: result size do: 
		[:i |
		self assert: (collection   at:(i + index ))=(result at: (i))].

	"verify size: "
	self assert: result size = (collection   size - index).! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/17/2009 14:44'!
oldSubCollection
	^ subCollection ! !

!IntervalTest methodsFor: 'tests - sorting' stamp: ''!
testIsSortedBy
	self assert: (self sortedInAscendingOrderCollection isSortedBy: [:a :b | a<b]).
	self deny: (self sortedInAscendingOrderCollection isSortedBy: [:a :b | a>b]).
! !

!IntervalTest methodsFor: 'tests - fixture' stamp: ''!
test0FixturePrintTest
	self nonEmpty! !

!IntervalTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testReverseWithDo
	
	| firstCollection secondCollection index |

	firstCollection := self nonEmptyMoreThan1Element.
	secondCollection := firstCollection copy.
	index := firstCollection size.
	
	firstCollection  reverseWith: secondCollection do:
		[:a :b |
	
		self assert: (firstCollection at: index) equals:  a. 
		self assert: (secondCollection at: index) equals:  b.
			( index := index - 1).]
	
	
	! !

!IntervalTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyFromTo
	| result  index collection |
	collection := self collectionWithoutEqualElements .
	index :=self indexInForCollectionWithoutDuplicates .
	result := collection   copyFrom: index  to: collection  size .
	
	"verify content of 'result' : "
	1 to: result size do:
		[:i | 
		self assert: (result at:i)=(collection  at: (i + index - 1))].
	
	"verify size of 'result' : "
	self assert: result size = (collection  size - index + 1).! !

!IntervalTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAllNoneThere
	"self debug: #testIncludesAllOfNoneThere'"
	self deny: (self empty includesAll: self nonEmpty ).
	self deny: (self nonEmpty includesAll: { self elementNotIn. self anotherElementNotIn })! !

!IntervalTest methodsFor: 'tests' stamp: 'apb 4/22/2007 12:36'!
testReverseUnevenDo
	| s i |
	s := OrderedCollection new.
	i := 10 to: 20 by: 3.
	i
		reverseDo: [:each | s addFirst: each].
	self
		assert: (s hasEqualElements: i)! !

!IntervalTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfStartingAt
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			indexOf: element
			startingAt: 2
			ifAbsent: [ 99 ]) = 99.
	self assert: (collection 
			indexOf: element
			startingAt: 1
			ifAbsent: [ 99 ]) = 1.
	self assert: (collection 
			indexOf: self elementNotInForIndexAccessing
			startingAt: 1
			ifAbsent: [ 99 ]) = 99! !

!IntervalTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testKeysAndValuesDoEmpty
	| result |
	result:= OrderedCollection new.
	
	self empty  keysAndValuesDo: 
		[:i :value|
		result add: (value+i)].
	
	self assert: result isEmpty .! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 14:43'!
elementNotInForElementAccessing
" return an element not included in 'accessCollection' "
	^ elementNotIn ! !

!IntervalTest methodsFor: 'tests - printing' stamp: ''!
testPrintOnDelimiterLast

	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printOn: aStream delimiter: ', ' last: 'and'.
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 )
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString)].
		i=(allElementsAsString size-1)
			ifTrue:[ self deny: (allElementsAsString at:i)=('and')asString].
		i=(allElementsAsString size)
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:(i-1))asString)].
			].! !

!IntervalTest methodsFor: 'tests - converting' stamp: ''!
testAsBag

	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: Bag! !

!IntervalTest methodsFor: 'tests - fixture' stamp: ''!
howMany: aSubCollection in: collection
" return an integer representing how many time 'subCollection'  appears in 'collection'  "
	| tmp nTime |
	tmp := collection.
	nTime:= 0.
	
	[tmp isEmpty ]whileFalse:
		[
		(tmp beginsWith: aSubCollection)
			ifTrue: [ 	
				nTime := nTime + 1.
				1 to: aSubCollection size do: [:i | tmp := tmp copyWithoutFirst.]
				]
			ifFalse: [tmp := tmp copyWithoutFirst.]
		 ].
	
	^ nTime.
	! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/17/2009 15:14'!
indexInForCollectionWithoutDuplicates
	^ 2.! !

!IntervalTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWith
	"self debug: #testCopyWith"
	| res anElement |
	anElement := self elementToAdd.
	res := self empty copyWith: anElement.
	self assert: res size = (self empty size + 1).
	self assert: (res includes: (anElement value))! !

!IntervalTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureConverAsSortedTest
	self collectionWithSortableElements.
	self deny: self collectionWithSortableElements isEmpty! !

!IntervalTest methodsFor: 'tests - printing' stamp: ''!
testStoreOn
" for the moment work only for collection that include simple elements such that Integer"

"| string str result cuttedResult index elementsAsStringExpected elementsAsStringObtained tmp |
string := ''.
str := ReadWriteStream  on: string.
elementsAsStringExpected := OrderedCollection new.
elementsAsStringObtained := OrderedCollection new.
self nonEmpty do: [ :each | elementsAsStringExpected  add: each asString].

self nonEmpty storeOn: str.
result := str contents .
cuttedResult := ( result findBetweenSubStrs: ';' ).

index := 1.

cuttedResult do:
	[ :each |
	index = 1 
		ifTrue: [ self assert: (each beginsWith: ( tmp := '((' , self nonEmpty class asString , ' new) add: '           )).
				tmp := each copyFrom: ( tmp size + 1) to: ( each size ).
				elementsAsStringObtained add: tmp.
				index := index + 1. ]
		ifFalse:  [ 
		 index < cuttedResult size
			ifTrue:[self assert: (each beginsWith: ( tmp:=  ' add: '   )).
				tmp := each copyFrom: ( tmp size + 1) to: ( each size ).
				elementsAsStringObtained add: tmp.
					index := index + 1.]
			ifFalse: [self assert: ( each = ' yourself)' ) ].
			]
	
	].


	elementsAsStringExpected do: [ :each | self assert: (elementsAsStringExpected occurrencesOf: each ) = ( elementsAsStringObtained occurrencesOf: each) ]"

! !

!IntervalTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfStartingAtIfAbsent
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			indexOf: element
			startingAt: 2
			ifAbsent: [ 99 ]) = 99.
	self assert: (collection 
			indexOf: element
			startingAt: 1
			ifAbsent: [ 99 ]) = 1.
	self assert: (collection 
			indexOf: self elementNotInForIndexAccessing
			startingAt: 1
			ifAbsent: [ 99 ]) = 99! !

!IntervalTest methodsFor: 'tests' stamp: 'zz 12/5/2005 18:03'!
testOtherNewFrom

	self assert: (Interval newFrom: #(1 2 3 )) = (1 to: 3).
	self assert: (Interval newFrom: #(33  5 -23 )) = (33 to: -23 by: -28).
	self should: [(Interval newFrom: #(33  5 -22 ))] raise: Error.
	self assert: (#(33  5 -23) as: Interval) = (33 to: -23 by: -28).
	self should: [( #(33  5 -22 ) as: Interval)] raise: Error.
	
	self assert: ( (-4 to: -12 by: -1) as: Interval) = (-4 to: -12 by: -1).
	self assert: ( Interval newFrom: (1 to: 1)) = (1 to: 1).
	self assert: ( Interval newFrom: (1 to: 0)) = (1 to: 0).
	self assert: (#(1) as: Interval) = (1 to: 1).
	self assert: (#() as: Interval) = (1 to: 0).! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/17/2009 15:04'!
integerCollection
	^ nonEmpty ! !

!IntervalTest methodsFor: 'tests - element accessing' stamp: ''!
testAtAll
	"self debug: #testAtAll"
	"	self flag: #theCollectionshouldbe102030intheFixture.
	
	self assert: (self accessCollection atAll: #(2 1)) first = self accessCollection second.
	self assert: (self accessCollection atAll: #(2)) first = self accessCollection second."
	| result |
	result := self moreThan4Elements atAll: #(2 1 2 ).
	self assert: (result at: 1) = (self moreThan4Elements at: 2).
	self assert: (result at: 2) = (self moreThan4Elements at: 1).
	self assert: (result at: 3) = (self moreThan4Elements at: 2).
	self assert: (self moreThan4Elements atAll: #()) = self moreThan4Elements species new! !

!IntervalTest methodsFor: 'tests - indexable access' stamp: 'delaunay 4/6/2009 15:25'!
testAllButLastElements
	"self debug: #testAllButFirst"
	| abf col |
	col := self accessCollection.
	abf := col allButLast: 2.
	1 
		to: abf size
		do: [ :i | self assert: (abf at: i) = (col at: i) ].
	self assert: abf size + 2 = col size! !

!IntervalTest methodsFor: 'tests - converting' stamp: ''!
assertNonDuplicatedContents: aCollection whenConvertedTo: aClass 
	| result |
	result := aCollection perform: ('as' , aClass name) asSymbol.
	self assert: (result class includesBehavior: aClass).
	result do: 
		[ :each | 
		self assert: (aCollection occurrencesOf: each) = (result occurrencesOf: each) ].
	^ result! !

!IntervalTest methodsFor: 'tests - copying same contents' stamp: ''!
testShallowCopy
	| result |
	result := self nonEmpty shallowCopy .
	
	"verify content of 'result: '"
	1 to: self nonEmpty size do:
		[:i | self assert: ((result at:i)=(self nonEmpty at:i))].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!IntervalTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfIfAbsent
	"self debug: #testIndexOfIfAbsent"
	| collection |
	collection := self collectionMoreThan1NoDuplicates.
	self assert: (collection 
			indexOf: collection first
			ifAbsent: [ 33 ]) = 1.
	self assert: (collection 
			indexOf: self elementNotInForIndexAccessing
			ifAbsent: [ 33 ]) = 33! !

!IntervalTest methodsFor: 'tests - streaming' stamp: ''!
testStreamContentsSized
	| result |
	result:= self collectionClass new: 1 streamContents: [ :s|
		s 
			nextPutAll: self firstCollection;
			nextPutAll: self secondCollection ].
	self assert: result equals: self firstCollection, self secondCollection.
	
	result:= self collectionClass new: 1000 streamContents: [ :s|
		s 
			nextPutAll: self firstCollection;
			nextPutAll: self secondCollection ].
	self assert: result equals: self firstCollection, self secondCollection.! !

!IntervalTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyPartOfSequenceableTest
	self collectionWithoutEqualElements.
	self collectionWithoutEqualElements
		do: [ :each | self assert: (self collectionWithoutEqualElements occurrencesOf: each) = 1 ].
	self indexInForCollectionWithoutDuplicates.
	self
		assert:
			(self indexInForCollectionWithoutDuplicates > 0 & self indexInForCollectionWithoutDuplicates)
				< self collectionWithoutEqualElements size.
	self empty.
	self assert: self empty isEmpty! !

!IntervalTest methodsFor: 'tests - converting' stamp: ''!
testAsIdentitySet
	"test with a collection without equal elements :"
	self 
		assertSameContents: self collectionWithoutEqualElements
		whenConvertedTo: IdentitySet.
! !

!IntervalTest methodsFor: 'tests - converting' stamp: ''!
testAsByteArray
	| res |
	self integerCollectionWithoutEqualElements.
	self integerCollectionWithoutEqualElements do: [ :each | self assert: each class = SmallInteger ].
	res := true.
	self integerCollectionWithoutEqualElements
		detect: [ :each | (self integerCollectionWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false.
	self assertSameContents: self integerCollectionWithoutEqualElements whenConvertedTo: ByteArray! !

!IntervalTest methodsFor: 'tests - converting' stamp: ''!
testAsSet
	| |
	"test with a collection without equal elements :"
	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: Set.
	! !

!IntervalTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyWithOrWithoutSpecificElementsTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self indexInNonEmpty.
	self assert: self indexInNonEmpty > 0.
	self assert: self indexInNonEmpty <= self nonEmpty size! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/15/2009 09:48'!
elementNotInForIndexAccessing

	^elementNotIn ! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/15/2009 14:55'!
firstCollection
	^ nonEmpty.! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/15/2009 09:51'!
collectionInForIncluding
	^ nonEmpty copyWithout: (self nonEmpty last).! !

!IntervalTest methodsFor: 'tests - includes' stamp: ''!
testIncludesElementIsThere
	"self debug: #testIncludesElementIsThere"
	
	self assert: (self nonEmpty includes: self nonEmpty anyOne).! !

!IntervalTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:34'!
testAsInterval
	"This is the same as newFrom:"
	"self run: #testAsIntervaltestAsInterval"
	self assert: (#(1 2 3) as: Interval) = (1 to: 3).
	self assert: (#(33 5 -23) as: Interval) = (33 to: -23 by: -28).
	self assert: (#[2 4 6] as: Interval) = (2 to: 6 by: 2).

	self should: [#(33 5 -22) as: Interval]
		raise: Error
		description: 'This is not an arithmetic progression'
! !

!IntervalTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfSubCollectionStartingAtIfAbsent
	"self debug: #testIndexOfIfAbsent"
	| index absent subcollection collection |
	collection := self collectionMoreThan1NoDuplicates.
	subcollection := self collectionMoreThan1NoDuplicates.
	absent := false.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 1
		ifAbsent: [ absent := true ].
	self assert: absent = false.
	absent := false.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 2
		ifAbsent: [ absent := true ].
	self assert: absent = true! !

!IntervalTest methodsFor: 'tests - element accessing' stamp: ''!
testAtLastError
	"self debug: #testAtLast"
	self 
		should: [ self moreThan4Elements atLast: self moreThan4Elements size + 1 ]
		raise: Error! !

!IntervalTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpToLastEmpty
	| result |
	result := self empty copyUpToLast: self collectionWithoutEqualElements first.
	self assert: result isEmpty.! !

!IntervalTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpToLast
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyUpToLast: (collection  at:index).
	
	"verify content of 'result' :"
	1 to: result size do: [:i| self assert: (collection   at:i)=(result at:i)].
	
	"verify size of 'result' :"
	self assert: result size = (index-1).! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/15/2009 15:03'!
elementInForIndexAccess
	^ self accessCollection  anyOne! !

!IntervalTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCloneTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!IntervalTest methodsFor: 'tests - printing' stamp: ''!
testPrintOn
	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printOn: aStream .
	allElementsAsString:=(result findBetweenSubStrs: ' ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i=1
			ifTrue:[
			self accessCollection class name first isVowel 
				ifTrue:[self assert: (allElementsAsString at:i)='an' ]
				ifFalse:[self assert: (allElementsAsString at:i)='a'].].
		i=2
			ifTrue:[self assert: (allElementsAsString at:i)=self accessCollection class name].
		i>2
			ifTrue:[self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString).].	
			].! !

!IntervalTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpTo
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyUpTo: (collection  at:index).
	
	"verify content of 'result' :"
	1 to: result size do: [:i| self assert: (collection   at:i)=(result at:i)].
	
	"verify size of 'result' :"
	self assert: result size = (index-1).
	! !

!IntervalTest methodsFor: 'tests' stamp: 'Alexandre Bergel 12/23/2009 18:46'!
testInclusion
	"Non regression test for another bug of fuzzy inclusion"
	self deny: ((1.0 to: 3.0 by: 1.0 successor) includes: 3.0) description: 'The last element of this Interval is closed to 2'! !

!IntervalTest methodsFor: 'tests' stamp: 'zz 12/7/2005 13:29'!
testLast

self assert: (1 to:10) last = 10.
self assert: (1 to:10 by:2) last = 9 ! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/17/2009 15:32'!
collectionWithElementsToRemove
	
	^ subCollectionInNonEmpty .! !

!IntervalTest methodsFor: 'tests - copying same contents' stamp: ''!
testReversed
	| result |
	result := self nonEmpty reversed .
	
	"verify content of 'result: '"
	1 to:  result size do:
		[:i | self assert: ((result at:i)=(self nonEmpty at:(self nonEmpty size-i+1)))].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!IntervalTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterLastMore

	| delim multiItemStream result last allElementsAsString |
	
	delim := ', '.
	last := 'and'.
	result:=''.
	multiItemStream := ReadWriteStream on:result.
	self nonEmpty  asStringOn: multiItemStream delimiter: ', ' last: last.
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 )
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString)].
		i=(allElementsAsString size-1)
			ifTrue:[ self deny: (allElementsAsString at:i)=(last)asString].
		i=(allElementsAsString size)
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:(i-1))asString)].
			].
	
! !

!IntervalTest methodsFor: 'requirements' stamp: 'damienpollet 1/29/2009 19:01'!
expectedSizeAfterReject
	"Number of even elements in #collection"
	^ 3! !

!IntervalTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIncludeTest
	| anElementIn |
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self elementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self elementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self anotherElementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self anotherElementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self empty.
	self assert: self empty isEmpty! !

!IntervalTest methodsFor: 'tests - includes' stamp: 'CamilloBruni 8/31/2013 20:23'!
testIdentityIncludes
	" test the comportement in presence of elements 'includes' but not 'identityIncludes' "

	" can not be used by collections that can't include elements for wich copy doesn't return another instance "

	| collection element |
	self collectionWithCopyNonIdentical.
	collection := self collectionWithCopyNonIdentical.
	element := collection anyOne copy.	"self assert: (collection includes: element)."
	self deny: (collection identityIncludes: element)! !

!IntervalTest methodsFor: 'tests - includes' stamp: 'delaunay 4/2/2009 11:53'!
testIncludesElementIsNotThere
	"self debug: #testIncludesElementIsNotThere"
	self deny: (self nonEmpty includes: self elementNotInForOccurrences).
	self assert: (self nonEmpty includes: self nonEmpty anyOne).
	self deny: (self empty includes: self elementNotInForOccurrences)! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/17/2009 14:45'!
replacementCollection
	^ 5 to: 7.! !

!IntervalTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithoutIndex
	| result index |
	index := self indexInNonEmpty .
	result := self nonEmpty copyWithoutIndex: index .
	
	"verify content of 'result:'"
	1 to: result size do:
		[:i | 
		i<( index ) ifTrue: [self assert: ((result at:i )= (self nonEmpty at:i))].
		i>=( index ) ifTrue: [self assert: (result at:i )= (self nonEmpty at:(i+1))]].
	
	"verify size of result : "
	self assert: result size=(self nonEmpty size -1).! !

!IntervalTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfterEmpty
	| result |
	result := self empty copyAfter: self collectionWithoutEqualElements first.
	self assert: result isEmpty.
	! !

!IntervalTest methodsFor: 'tests' stamp: 'apb 4/22/2007 12:35'!
testReverseDo
	| s i |
	s := OrderedCollection new.
	i := 10 to: 20.
	i
		reverseDo: [:each | s addFirst: each].
	self
		assert: (s hasEqualElements: i)! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 10:31'!
integerCollectionWithoutEqualElements
	^ 1 to: 23.! !

!IntervalTest methodsFor: 'tests - copy' stamp: ''!
testCopyEquals
	"self debug: #testCopySameClass"
	"A copy should be equivalent to the things it's a copy of"
	
	| copy | 
	copy := self nonEmpty copy.
	self assert: copy  = self nonEmpty.! !

!IntervalTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWithoutAll
	"self debug: #testCopyEmptyWithoutAll"
	| res |
	res := self empty copyWithoutAll: self collectionWithElementsToRemove.
	self assert: res size = self empty size.
	self collectionWithElementsToRemove do: [ :each | self deny: (res includes: each) ]! !

!IntervalTest methodsFor: 'tests - element accessing' stamp: ''!
testAtPin
	"self debug: #testAtPin"
	self assert: (self moreThan4Elements atPin: 2) = self moreThan4Elements second.
	self assert: (self moreThan4Elements atPin: 99) = self moreThan4Elements last.
	self assert: (self moreThan4Elements atPin: -99) = self moreThan4Elements first! !

!IntervalTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutAll
	"self debug: #testCopyNonEmptyWithoutAll"
	| res |
	res := self nonEmpty copyWithoutAll: self collectionWithElementsToRemove.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self collectionWithElementsToRemove do: [ :each | self deny: (res includes: (each)) ].
	self nonEmpty do: 
		[ :each | 
		(self collectionWithElementsToRemove includes: each) ifFalse: [ self assert: (res includes: each) ] ]! !

!IntervalTest methodsFor: 'tests - element accessing' stamp: ''!
testAtLastIfAbsent
	"self debug: #testAtLastIfAbsent"
	self assert: (self moreThan4Elements 
			atLast: 1
			ifAbsent: [ nil ]) = self moreThan4Elements last.
	self assert: (self moreThan4Elements 
			atLast: self moreThan4Elements size + 1
			ifAbsent: [ 222 ]) = 222! !

!IntervalTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfterLast
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyAfterLast: (collection  at:index ).
	
	"verifying content: "
	(1) to: result size do: 
		[:i |
		self assert: (collection   at:(i + index ))=(result at: (i))].

	"verify size: "
	self assert: result size = (collection   size - index).! !

!IntervalTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButLastNElements
	"self debug: #testAllButFirst"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButLast: 2.
	1 
		to: abf size
		do: [ :i | self assert: (abf at: i) = (col at: i) ].
	self assert: abf size + 2 = col size! !

!IntervalTest methodsFor: 'tests' stamp: 'nice 4/29/2007 21:35'!
testIndexOfBug1602
	"This test is by german morales.
	It is about mantis bug 1602"
	
	self should: ((1 to: 5 by: 1) indexOf: 2.5) = 0. "obvious"
	self should: ((100000000000000 to: 500000000000000 by: 100000000000000)
 		  indexOf: 250000000000000) = 0. "same as above with 14 zeros appended"! !

!IntervalTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindFirstNotIn

	| result |
	
	 result:=self empty findFirst: [:each | true].
	
	self assert: result=0. ! !

!IntervalTest methodsFor: 'tests - element accessing' stamp: ''!
testAfterIfAbsent
	"self debug: #testAfterIfAbsent"
	self assert: (self moreThan4Elements 
			after: (self moreThan4Elements at: 1)
			ifAbsent: [ 33 ]) = (self moreThan4Elements at: 2).
	self assert: (self moreThan4Elements 
			after: (self moreThan4Elements at: self moreThan4Elements size)
			ifAbsent: [ 33 ]) = 33.
	self assert: (self moreThan4Elements 
			after: self elementNotInForElementAccessing
			ifAbsent: [ 33 ]) = 33! !

!IntervalTest methodsFor: 'tests - converting' stamp: ''!
assertNoDuplicates: aCollection whenConvertedTo: aClass 
	| result |
	result := self collectionWithEqualElements asIdentitySet.
	self assert: (result class includesBehavior: IdentitySet).
	self collectionWithEqualElements do: [ :initial | self assert: (result occurrencesOf: initial) = 1 ]! !

!IntervalTest methodsFor: 'test - equality' stamp: ''!
testEqualSignIsTrueForEmptyButNonIdenticalCollections
	"self debug: #testEqualSignIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty = self empty copy). 
	self assert: (self empty copy = self empty).
	self assert: (self empty copy = self empty copy).
		
! !

!IntervalTest methodsFor: 'tests - copying with or without' stamp: ''!
testForceToPaddingWith

	| result element |
	element := self nonEmpty at: self indexInNonEmpty .
	result := self nonEmpty forceTo: (self nonEmpty size+2) paddingWith: ( element ).
	
	"verify content of 'result' : "
	1 to: self nonEmpty  size do:
		[:i | self assert: ( self nonEmpty at: i ) = ( result at:(i) ). ].
	
	(result size - 1) to: result size do:
		[:i | self assert: ( result at:i ) = ( element ) ].

	"verify size of 'result' :"
	self assert: result size = (self nonEmpty size + 2).! !

!IntervalTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsCommaStringEmpty

	self assert: self empty asCommaString = ''.
	self assert: self empty asCommaStringAnd = ''.
	
! !

!IntervalTest methodsFor: 'requirements' stamp: 'stephane.ducasse 10/5/2008 13:08'!
nonEmpty

	^ nonEmpty! !

!IntervalTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindLast

	| element result |
	element := self nonEmptyMoreThan1Element  at:self nonEmptyMoreThan1Element  size.
	 result:=self nonEmptyMoreThan1Element  findLast: [:each | each =element].
	
	self assert: result=self nonEmptyMoreThan1Element  size. ! !

!IntervalTest methodsFor: 'tests - streaming' stamp: ''!
testNewStreamContentsReturnsCollectionOfCorrectSize
	| result item originalSize |
	originalSize := 10.
	item := self firstCollection first.
	result := self collectionClass
		new: originalSize
		streamContents: [ :stream | 
			1 to: originalSize + 1 do: [ :each | stream nextPut: item ].
			stream position: originalSize ].
	self assert: result size equals: originalSize! !

!IntervalTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyNonEmpty
	"self debug: #testCopyNonEmpty"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: copy isEmpty.
	self assert: copy size = self nonEmpty size.
	self nonEmpty do: 
		[:each | copy includes: each]! !

!IntervalTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testReverseDoEmpty
	| result |
	result:= OrderedCollection new.
	self empty reverseDo: [: each | result add: each].
	
	self assert: result isEmpty .! !

!IntervalTest methodsFor: 'tests - element accessing' stamp: ''!
testFirstSecondThird
	"self debug: #testFirstSecondThird"
	self assert: self moreThan4Elements first = (self moreThan4Elements at: 1).
	self assert: self moreThan4Elements second = (self moreThan4Elements at: 2).
	self assert: self moreThan4Elements third = (self moreThan4Elements at: 3).
	self assert: self moreThan4Elements fourth = (self moreThan4Elements at: 4)! !

!IntervalTest methodsFor: 'tests - copying with or without' stamp: ''!
testForceToPaddingStartWith

	| result element |
	element := self nonEmpty at: self indexInNonEmpty .
	result := self nonEmpty forceTo: (self nonEmpty size+2) paddingStartWith: ( element ).
	
	"verify content of 'result' : "
	1 to: 2   do:
		[:i | self assert: ( element ) = ( result at:(i) ) ].
	
	3 to: result size do:
		[:i | self assert: ( result at:i ) = ( self nonEmpty at:(i-2) ) ].

	"verify size of 'result' :"
	self assert: result size = (self nonEmpty size + 2).! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 10:07'!
sizeCollection
	"Answers a collection whose #size is 4"
	^ 1 to: 4.! !

!IntervalTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithFirst

	| index element result |
	index:= self indexInNonEmpty .
	element:= self nonEmpty at: index.
	
	result := self nonEmpty copyWithFirst: element.	
	
	self assert: result size = (self nonEmpty size + 1).
	self assert: result first = element .
	
	2 to: result size do:
	[ :i |
	self assert: (result at: i) = ( self nonEmpty at: ( i - 1 ))].! !

!IntervalTest methodsFor: 'requirements' stamp: 'stephane.ducasse 10/5/2008 13:08'!
empty

	^ empty
! !

!IntervalTest methodsFor: 'tests - element accessing' stamp: ''!
testAtLast
	"self debug: #testAtLast"
	| index |
	self assert: (self moreThan4Elements atLast: 1) = self moreThan4Elements last.
	"tmp:=1.
	self do:
		[:each | 
		each =self elementInForIndexAccessing 
			ifTrue:[index:=tmp].
		tmp:=tmp+1]."
	index := self moreThan4Elements indexOf: self elementInForElementAccessing.
	self assert: (self moreThan4Elements atLast: index) = (self moreThan4Elements at: self moreThan4Elements size - index + 1)! !

!IntervalTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterEmpty

	| delim emptyStream |
	delim := ', '.
	emptyStream := ReadWriteStream on: ''.
	self empty asStringOn: emptyStream delimiter: delim.
	self assert: emptyStream contents = ''.
! !

!IntervalTest methodsFor: 'requirements' stamp: 'damienpollet 1/29/2009 18:55'!
collection
	^ nonEmpty! !

!IntervalTest methodsFor: 'tests - sorting' stamp: ''!
testIsSorted
	self assert: self sortedInAscendingOrderCollection isSorted.
	self deny: self unsortedCollection isSorted! !

!IntervalTest methodsFor: 'tests - element accessing' stamp: ''!
testAtRandom
	| result |
	result := self nonEmpty atRandom .
	self assert: (self nonEmpty includes: result).! !

!IntervalTest methodsFor: 'tests - converting' stamp: ''!
assertSameContents: aCollection whenConvertedTo: aClass 
	| result |
	result := self assertNonDuplicatedContents: aCollection whenConvertedTo: aClass.
	self assert: result size = aCollection size! !

!IntervalTest methodsFor: 'tests - equality' stamp: ''!
testEqualSignForSequenceableCollections
	"self debug: #testEqualSign"

	self deny: (self nonEmpty = self nonEmpty asSet). 
	self deny: (self nonEmpty reversed = self nonEmpty).
	self deny: (self nonEmpty = self nonEmpty reversed).! !

!IntervalTest methodsFor: 'tests - streaming' stamp: ''!
testStreamContents
	| result index |
	result:= self collectionClass streamContents: [ :s|
		s 
			nextPutAll: self firstCollection;
			nextPutAll: self secondCollection ].
	self assert: result equals: self firstCollection, self secondCollection.! !

!IntervalTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOfNotIn
	| result |
	result := self collectionWithoutEqualElements occurrencesOf: self elementNotInForOccurrences.
	self assert: result = 0! !

!IntervalTest methodsFor: 'tests' stamp: 'sd 6/5/2005 09:17'!
testNumericTypes

	(3 asNumber) to: 5 = #(3 4 5).
	
	3.0 to: 5.0 = #(3.0 4.0 5.0).
	3.0 to: 5.0 by: 0.5 = #(3.0 3.5 4.0 4.5 5.0).
	
	3/1 to: 5/1 = #(3 4 5).
	1/2 to: 5/2 by: 1/2 = #(1/2 1 3/2 2 5/2).! !

!IntervalTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureBeginsEndsWithTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self assert: self nonEmpty size > 1.
	self empty.
	self assert: self empty isEmpty! !

!IntervalTest methodsFor: 'tests - element accessing' stamp: ''!
testAtIfAbsent
	"self debug: #testAt"
	| absent |
	absent := false.
	self moreThan4Elements 
		at: self moreThan4Elements size + 1
		ifAbsent: [ absent := true ].
	self assert: absent = true.
	absent := false.
	self moreThan4Elements 
		at: self moreThan4Elements size
		ifAbsent: [ absent := true ].
	self assert: absent = false! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/17/2009 15:35'!
collectionNotIncluded
	^ (nonEmpty last + 1) to: (nonEmpty last +5)! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/2/2009 11:53'!
elementNotInForOccurrences
	^ 9! !

!IntervalTest methodsFor: 'test - equality' stamp: ''!
testEqualSignOfIdenticalCollectionObjects
	"self debug: #testEqualSignOfIdenticalCollectionObjects"
	
	self assert: (self empty = self empty). 
	self assert: (self nonEmpty = self nonEmpty). 
	! !

!IntervalTest methodsFor: 'tests - index access' stamp: ''!
testIndexOf
	"self debug: #testIndexOf"
	| tmp index collection |
	collection := self collectionMoreThan1NoDuplicates.
	tmp := collection size.
	collection reverseDo: 
		[ :each | 
		each = self elementInForIndexAccessing ifTrue: [ index := tmp ].
		tmp := tmp - 1 ].
	self assert: (collection indexOf: self elementInForIndexAccessing) = index! !

!IntervalTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:23'!
test0IndexAccessingTest
	self accessCollection.
	self assert: self accessCollection size = 5.
	self subCollectionNotIn.
	self subCollectionNotIn detect: [ :each | (self accessCollection includes: each) not ] ifNone: [ self assert: false ].
	self elementNotInForIndexAccessing.
	self deny: (self accessCollection includes: self elementNotInForIndexAccessing).
	self elementInForIndexAccessing.
	self assert: (self accessCollection includes: self elementInForIndexAccessing).
	self collectionOfFloat.
	self collectionOfFloat do: [ :each | self deny: each class = SmallInteger ]! !

!IntervalTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSubcollectionAccessTest
	self moreThan3Elements.
	self assert: self moreThan3Elements size > 2! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/15/2009 09:48'!
elementInForIndexAccessing

	^ elementIn ! !

!IntervalTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSequencedElementAccessTest
	self moreThan4Elements.
	self assert: self moreThan4Elements size >= 4.
	self subCollectionNotIn.
	self subCollectionNotIn detect: [ :each | (self moreThan4Elements includes: each) not ] ifNone: [ self assert: false ].
	self elementNotInForElementAccessing.
	self deny: (self moreThan4Elements includes: self elementNotInForElementAccessing).
	self elementInForElementAccessing.
	self assert: (self moreThan4Elements includes: self elementInForElementAccessing)! !

!IntervalTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButFirst
	"self debug: #testAllButFirst"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButFirst.
	self deny: abf first = col first.
	self assert: abf size + 1 = col size! !

!IntervalTest methodsFor: 'tests - indexable access' stamp: 'delaunay 4/6/2009 15:24'!
testAllButFirstElements
	"self debug: #testAllButFirst"
	| abf col |
	col := self accessCollection.
	abf := col allButFirst: 2.
	1 
		to: abf size
		do: [ :i | self assert: (abf at: i) = (col at: i + 2) ].
	self assert: abf size + 2 = col size! !

!IntervalTest methodsFor: 'tests' stamp: 'nice 4/29/2007 21:34'!
testInclusionBug1603
	"This test is by german morales.
	It is about mantis bug 1603"
	
	self shouldnt: ((1 to: 5 by: 1) includes: 2.5). "obvious"
	self shouldnt: ((100000000000000 to: 500000000000000 by: 100000000000000)
 		  includes: 250000000000000). "same as above with 14 zeros appended"! !

!IntervalTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testAllButLastDo
	
	| result |
	result:= OrderedCollection  new.
	
	self nonEmptyMoreThan1Element  allButLastDo: [:each | result add: each].
	
	1 to: (result size) do:
		[:i|
		self assert: (self nonEmptyMoreThan1Element  at:(i ))=(result at:i)].
	
	self assert: result size=(self nonEmptyMoreThan1Element  size-1).! !

!IntervalTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:34'!
testEquals

	self assert: (3 to: 5) = #(3 4 5).
	self deny: (3 to: 5) = #(3 5).
	self deny: (3 to: 5) = #().

	self assert: #(3 4 5) = (3 to: 5).
	self deny: #(3 5) = (3 to: 5).
	self deny: #() = (3 to: 5).! !

!IntervalTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testPairsCollect
	
	| index result |
	index:=0.
	
	result:=self nonEmptyMoreThan1Element  pairsCollect: 
		[:each1 :each2 | 
		self assert: ( self nonEmptyMoreThan1Element indexOf: each2 ) = (index := index + 2).
		(self nonEmptyMoreThan1Element indexOf: each2) = ((self nonEmptyMoreThan1Element indexOf: each1) + 1).
		].
	
	result do: 
		[:each | self assert: each = true].
	
! !

!IntervalTest methodsFor: 'tests - copying same contents' stamp: ''!
testShallowCopyEmpty
	| result |
	result := self empty shallowCopy .
	self assert: result isEmpty .! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/15/2009 09:52'!
subCollectionNotIn

	^subCollectionNotIn ! !

!IntervalTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithIndexDo
	
	"| result |
	result:=Array new: self nonEmptyMoreThan1Element size.
	self nonEmptyMoreThan1Element  withIndexDo: [:each :i | result at:i put:(each+i)].
	
	1 to: result size do:[: i | self assert: (result at:i)= ((self nonEmptyMoreThan1Element at: i) + i)]"
	|  indexes elements |
	indexes:= OrderedCollection new.
	elements := OrderedCollection new.
	
	self nonEmptyMoreThan1Element  withIndexDo: 
		[:value :i  |
		indexes  add: (i).
		elements add: value].
	
	(1 to: self nonEmptyMoreThan1Element size )do:
		[ :i |
		self assert: (indexes at: i) = i.
		self assert: (elements at: i) = (self nonEmptyMoreThan1Element at: i).	
		].
	
	self assert: indexes size = elements size. 
	self assert: indexes size = self nonEmptyMoreThan1Element size . 
	! !

!IntervalTest methodsFor: 'tests - copying same contents' stamp: ''!
testReverse

	| result |
	result := self nonEmpty reversed.	
	"verify content of 'result: '"
	1 to: result size do:
		[:i | self assert: ((result at: i) 
			= (self nonEmpty at: (self nonEmpty size - i + 1)))].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!IntervalTest methodsFor: 'tests - element accessing' stamp: ''!
testBeforeIfAbsent
	"self debug: #testBefore"
	self assert: (self moreThan4Elements 
			before: (self moreThan4Elements at: 1)
			ifAbsent: [ 99 ]) = 99.
	self assert: (self moreThan4Elements 
			before: (self moreThan4Elements at: 2)
			ifAbsent: [ 99 ]) = (self moreThan4Elements at: 1)! !

!IntervalTest methodsFor: 'tests' stamp: 'nice 4/19/2011 00:43'!
testPermutationsDo

	| i oc |
	i := (1.234 to: 4.234).
	oc := OrderedCollection new.
	i permutationsDo: [:e | oc add: e].
	self assert: (oc size = i size factorial).
	^ oc! !

!IntervalTest methodsFor: 'tests' stamp: 'zz 12/5/2005 18:08'!
testExtent
	self assert: (1 to: 10) extent = 9.
	self assert: (1 to: 10 by: 2) extent = 9.
	self assert: (1 to:-1) extent = -2! !

!IntervalTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpToEmpty
	| result |
	result := self empty copyUpTo: self collectionWithoutEqualElements first.
	self assert: result isEmpty.
	! !

!IntervalTest methodsFor: 'requirements' stamp: 'damiencassou 1/27/2009 17:25'!
speciesClass
	
	^ Array! !

!IntervalTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindLastNotIn

	| result |
	
	 result:=self empty findFirst: [:each | true].
	
	self assert: result=0. ! !

!IntervalTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsCommaStringOne
	
	"self assert: self oneItemCol asCommaString = '1'.
	self assert: self oneItemCol asCommaStringAnd = '1'."

	self assert: self nonEmpty1Element  asCommaString = (self nonEmpty1Element first asString).
	self assert: self nonEmpty1Element  asCommaStringAnd = (self nonEmpty1Element first asString).
	! !

!IntervalTest methodsFor: 'tests' stamp: ''!
testInvalid
	"empty, impossible ranges"
	self assert: (1 to: 0) = #().
	self assert: (1 to: -1) = #().
	self assert: (-1 to: -2) = #().
	self assert: (1 to: 5 by: -1) = #().
	
	"always contains only start value."
	self assert: (1 to: 1) = #(1).
	self assert: (1 to: 5 by: 10) = #(1).
	self assert: (1 to: 0 by: -2) = #(1).
! !

!IntervalTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopySameContentsTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!IntervalTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFromToDo
	
	| result |
	result:= OrderedCollection  new.
	
	self nonEmptyMoreThan1Element  from: 1 to: (self nonEmptyMoreThan1Element  size -1) do: [:each | result add: each].
	
	1 to: (self nonEmptyMoreThan1Element  size -1) do:
		[:i|
		self assert: (self nonEmptyMoreThan1Element  at:i )=(result at:i)].
	self assert: result size=(self nonEmptyMoreThan1Element  size-1).! !

!IntervalTest methodsFor: 'tests' stamp: 'zz 12/5/2005 18:15'!
testAt
	self assert: ((1 to: 10)
			at: 1)
			= 1.
	self assert: ((1 to: 10)
			at: 3)
			= 3.
	self assert: ((1 to: 10 by: 2)
			at: 1)
			= 1.
	self assert: ((1 to: 10 by: 2)
			at: 3)
			= 5! !

!IntervalTest methodsFor: 'setup' stamp: 'cyrille.delaunay 12/18/2009 11:56'!
setUp

	empty := (1 to: 0).
	one := (1 to:1).
	nonEmpty := -5 to: 10 by: 3.
	subCollectionInNonEmpty := -2 to: 4 by: 3.
	nonEmpty1Element:= 1to:1.
	anotherCollection:= 2 to: 15.
	collectionWithoutNil := 1 to: 3.
	collectResult := { SmallInteger. SmallInteger. SmallInteger.}.
	elementIn :=-2.
	elementNotIn:= 12.
	subCollectionNotIn:= -2 to: 1.
	collectionOfFloat := 1.5 to: 7.5 by: 1.
	subCollection := 2 to: 8.
	collectionWithSubCollection := 1 to: 10.! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/15/2009 09:48'!
elementNotIn
	^elementNotIn! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 10:51'!
moreThan3Elements
	" return a collection including atLeast 3 elements"
	^ nonEmpty ! !

!IntervalTest methodsFor: 'tests - element accessing' stamp: ''!
testMiddle
	"self debug: #testMiddle"
	self assert: self moreThan4Elements middle = (self moreThan4Elements at: self moreThan4Elements size // 2 + 1)! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/15/2009 14:46'!
nonEmptyMoreThan1Element
	^nonEmpty .! !

!IntervalTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterOne

	| delim oneItemStream result |
	"delim := ', '.
	oneItemStream := '' readWrite.
	self oneItemCol asStringOn: oneItemStream delimiter: delim.
	self assert: oneItemStream contents = '1'."
	
	delim := ', '.
	result:=''.
	oneItemStream := ReadWriteStream on: result.
	self nonEmpty1Element  asStringOn: oneItemStream delimiter: delim.
	oneItemStream do:[:each | self assert: each = (self nonEmpty1Element first asString)].
	

	! !

!IntervalTest methodsFor: 'requirements' stamp: 'delaunay 4/15/2009 09:47'!
elementInForIncludesTest

	^ elementIn ! !

!IntervalTest methodsFor: 'tests - index access' stamp: ''!
testLastIndexOfIfAbsent
	"self debug: #testIndexOfIfAbsent"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			lastIndexOf: element
			ifAbsent: [ 99 ]) = 1.
	self assert: (collection 
			lastIndexOf: self elementNotInForIndexAccessing
			ifAbsent: [ 99 ]) = 99! !

!IntervalTest methodsFor: 'tests - index access' stamp: ''!
testLastIndexOfStartingAt
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection last.
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size
			ifAbsent: [ 99 ]) = collection size.
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size - 1
			ifAbsent: [ 99 ]) = 99.
	self assert: (collection 
			lastIndexOf: self elementNotInForIndexAccessing
			startingAt: collection size
			ifAbsent: [ 99 ]) = 99! !

!IntervalTest methodsFor: 'tests - copying with replacement' stamp: ''!
firstIndexesOf: aSubCollection in: collection
" return an OrderedCollection with the first indexes of the occurrences of subCollection in  collection "
	| tmp result currentIndex |
	tmp:= collection.
	result:= OrderedCollection new.
	currentIndex := 1.
	
	[tmp isEmpty ]whileFalse:
		[
		(tmp beginsWith: aSubCollection)
			ifTrue: [ 	
				result add: currentIndex.
				1 to: aSubCollection size do: 
					[:i | 
					tmp := tmp copyWithoutFirst.
					currentIndex := currentIndex + 1]
				]
			ifFalse: [
				tmp := tmp copyWithoutFirst.
				currentIndex := currentIndex +1.
				]
		 ].
	
	^ result.
	! !

!IntervalTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithCollectError
	self should: [self nonEmptyMoreThan1Element with: self empty collect:[:a :b | ]] raise: Error.! !

!InvalidGlobalName commentStamp: '<historical>'!
I am a warning signaled when trying to build a class with invalid name.!
!InvalidGlobalName class methodsFor: 'signalling' stamp: 'MartinDias 7/24/2013 13:56'!
signal: aMessage for: aName
	self signal: aName asString, ': ', aMessage ! !

!InvalidPackageName commentStamp: 'MarcusDenker 10/9/2014 17:29'!
I am a warning signaled when trying to build a class were the category is empty!
!InvalidSlotName commentStamp: '<historical>'!
I am signaled when the name of a Slot is an invalid variable name.!
!InvalidSlotName class methodsFor: 'signalling' stamp: 'MartinDias 7/24/2013 13:40'!
signalFor: aSymbol
	self signal: aSymbol asString, ' is an invalid name for a slot'! !

!InvalidSocketStatusException commentStamp: 'mir 5/12/2003 18:15'!
Signals if an operation on a Socket found it in a state invalid for that operation.
!
!InvalidSuperclass commentStamp: '<historical>'!
I am a warning signaled when trying to build a class with an invalid superclass.!
!InvalidSuperclass class methodsFor: 'signalling' stamp: 'MartinDias 7/25/2013 14:16'!
signal: aMessage for: anObject
	self signal: anObject asString, ': ', aMessage ! !

!ItemNode commentStamp: 'TorstenBergmann 2/4/2014 21:14'!
An item in the group UI!
!ItemNode methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 3/15/2011 14:07'!
isGroup

	^ false! !

!ItemNode methodsFor: 'testing' stamp: 'MarcusDenker 7/25/2014 20:43'!
rowMorphForColumn: aTreeColumn

	^ self item ifNotNil: [:i | i printString asMorph] ! !

!JISX0208 commentStamp: 'yo 10/19/2004 19:52'!
This class represents the domestic character encoding called JIS X 0208 used for Japanese.!
!JISX0208 class methodsFor: 'class methods' stamp: 'yo 7/21/2004 18:36'!
unicodeLeadingChar

	^ JapaneseEnvironment leadingChar.
! !

!JISX0208 class methodsFor: 'class methods' stamp: 'StephaneDucasse 8/22/2013 14:27'!
initialize
	"self initialize"
	
	EncodedCharSet declareEncodedCharSet: self atIndex: 1+1.
	EncodedCharSet declareEncodedCharSet: self atIndex: 4+1.

	compoundTextSequence := String streamContents: 
		[ :s | 
		s nextPut: (Character value: 27).
		s nextPut: $$.
		s nextPut: $B ]! !

!JISX0208 class methodsFor: 'class methods' stamp: 'yo 10/14/2003 10:19'!
ucsTable

	^ UCSTable jisx0208Table.
! !

!JISX0208 class methodsFor: 'accessing - displaying' stamp: 'yo 3/18/2003 11:11'!
isBreakableAt: index in: text

	| prev |
	index = 1 ifTrue: [^ false].
	prev := text at: index - 1.
	prev leadingChar ~= 1 ifTrue: [^ true].
	^ false
! !

!JISX0208 class methodsFor: 'character classification' stamp: 'yo 8/6/2003 05:30'!
isLetter: char

	| value leading |

	leading := char leadingChar.
	value := char charCode.

	leading = 0 ifTrue: [^ super isLetter: char].

	value := value // 94 + 1.
	^ 1 <= value and: [value < 84].
! !

!JISX0208 class methodsFor: 'class methods' stamp: 'yo 9/4/2002 22:52'!
printingDirection

	^ #right.
! !

!JISX0208 class methodsFor: 'class methods' stamp: 'Alexandre.Bergel 11/20/2008 11:17'!
compoundTextSequence
	^ compoundTextSequence! !

!JISX0208 class methodsFor: 'class methods' stamp: 'Alexandre.Bergel 11/20/2008 11:17'!
nextPutValue: ascii toStream: aStream withShiftSequenceIfNeededForTextConverterState: state 
	| c1 c2 |
	state charSize: 2.
	state g0Leading ~= self leadingChar ifTrue: 
		[ state g0Leading: self leadingChar.
		state g0Size: 2.
		aStream basicNextPutAll: compoundTextSequence ].
	c1 := ascii // 94 + 33.
	c2 := ascii \\ 94 + 33.
	^ aStream
		basicNextPut: (Character value: c1);
		basicNextPut: (Character value: c2)! !

!JISX0208 class methodsFor: 'class methods' stamp: 'yo 9/2/2002 17:38'!
leadingChar

	^ 1.
! !

!JISX0208 class methodsFor: 'class methods' stamp: 'ar 4/12/2005 17:34'!
stringFromKutenArray: anArray

	| s |
	s := WideString new: anArray size.
	1 to: anArray size do: [:i |
		s at: i put: (self charAtKuten: (anArray at: i)).
	].
	^s.
! !

!JISX0208 class methodsFor: 'class methods' stamp: 'ar 4/9/2005 22:31'!
charAtKuten: anInteger

	| a b |
	a := anInteger \\ 100.
	b := anInteger // 100.
	(a > 94) | (b > 94) ifTrue: [
		self error: 'character code is not valid'.
	].
	^ Character leadingChar: self leadingChar code: ((b - 1) * 94) + a - 1.
! !

!JPEGColorComponent commentStamp: '<historical>'!
I represent a single component of color in JPEG YCbCr color space.  I can accept a list of blocks in my component from the current MCU, then stream the samples from this block for use in color conversion.  I also store the running DC sample value for my component, used by the Huffman decoder.

The following layout is fixed for the JPEG primitives to work:
	currentX 		<SmallInteger>
	currentY 		<SmallInteger>
	hSampleFactor 	<SmallInteger>
	vSampleFactor 	<SmallInteger>
	mcuBlocks 		<Array of: <IntegerArray of: DCTSize2 * Integer>>
	widthInBlocks 	<SmallInteger>
	heightInBlocks 	<SmallInteger>
	dctSize 			<SmallInteger>
	mcuWidth 		<SmallInteger>
	mcuHeight 		<SmallInteger>
	priorDCValue 	<SmallInteger>
!
!JPEGColorComponent methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
id: anObject 
	id := anObject! !

!JPEGColorComponent methodsFor: 'accessing' stamp: 'tao 10/23/97 12:21'!
dcTableIndex

	^dcTableIndex! !

!JPEGColorComponent methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
dcTableIndex: anInteger 
	dcTableIndex := anInteger! !

!JPEGColorComponent methodsFor: 'accessing' stamp: 'tao 10/23/97 12:21'!
acTableIndex

	^acTableIndex! !

!JPEGColorComponent methodsFor: 'sample streaming' stamp: 'lr 7/4/2009 10:42'!
initializeSampleStreamBlocks: aCollection 
	mcuBlocks := aCollection.
	self resetSampleStream! !

!JPEGColorComponent methodsFor: 'accessing' stamp: 'tao 10/23/97 12:43'!
qTableIndex
	^qTableIndex! !

!JPEGColorComponent methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
mcuWidth: mw mcuHeight: mh dctSize: ds 
	mcuWidth := mw.
	mcuHeight := mh.
	dctSize := ds.
	hSampleFactor := mcuWidth // widthInBlocks.
	vSampleFactor := mcuHeight // heightInBlocks! !

!JPEGColorComponent methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
updateDCValue: aNumber 
	priorDCValue := priorDCValue + aNumber.
	^ priorDCValue! !

!JPEGColorComponent methodsFor: 'accessing' stamp: 'tao 10/23/97 12:09'!
id

	^id! !

!JPEGColorComponent methodsFor: 'accessing' stamp: 'tao 10/23/97 12:11'!
heightInBlocks

	^heightInBlocks! !

!JPEGColorComponent methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
priorDCValue: aNumber 
	priorDCValue := aNumber! !

!JPEGColorComponent methodsFor: 'accessing' stamp: 'tao 10/23/97 12:11'!
widthInBlocks

	^widthInBlocks! !

!JPEGColorComponent methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
widthInBlocks: anInteger 
	widthInBlocks := anInteger! !

!JPEGColorComponent methodsFor: 'accessing' stamp: 'tao 10/23/97 12:18'!
totalMcuBlocks

	^ heightInBlocks * widthInBlocks! !

!JPEGColorComponent methodsFor: 'sample streaming' stamp: 'lr 7/4/2009 10:42'!
nextSample
	| dx dy blockIndex sampleIndex sample |
	dx := currentX // hSampleFactor.
	dy := currentY // vSampleFactor.
	blockIndex := dy // dctSize * widthInBlocks + (dx // dctSize) + 1.
	sampleIndex := dy \\ dctSize * dctSize + (dx \\ dctSize) + 1.
	sample := (mcuBlocks at: blockIndex) at: sampleIndex.
	currentX := currentX + 1.
	currentX < (mcuWidth * dctSize) ifFalse: 
		[ currentX := 0.
		currentY := currentY + 1 ].
	^ sample! !

!JPEGColorComponent methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
qTableIndex: anInteger 
	qTableIndex := anInteger! !

!JPEGColorComponent methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
heightInBlocks: anInteger 
	heightInBlocks := anInteger! !

!JPEGColorComponent methodsFor: 'sample streaming' stamp: 'lr 7/4/2009 10:42'!
resetSampleStream
	currentX := 0.
	currentY := 0! !

!JPEGColorComponent methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
acTableIndex: anInteger 
	acTableIndex := anInteger! !

!JPEGHuffmanTable commentStamp: '<historical>'!
I represent the table of values used to decode Huffman entropy-encoded bitstreams.  From the JFIF file header entropy values, I build a derived table of codes and values for faster decoding.!
!JPEGHuffmanTable methodsFor: 'accessing' stamp: 'tao 10/21/97 23:31'!
lookaheadBits
	^lookaheadBits! !

!JPEGHuffmanTable methodsFor: 'accessing' stamp: 'tao 10/21/97 23:38'!
lookaheadSymbol
	^lookaheadSymbol! !

!JPEGHuffmanTable methodsFor: 'computation' stamp: 'tao 10/21/97 22:44'!
valueForCode: code length: length

	^ values at: ((valptr at: length) + code - (mincode at: length))! !

!JPEGHuffmanTable methodsFor: 'accessing' stamp: 'tao 10/21/97 23:59'!
maxcode
	^maxcode! !

!JPEGHuffmanTable methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
bits: anObject 
	bits := anObject! !

!JPEGHuffmanTable methodsFor: 'computation' stamp: 'lr 7/4/2009 10:42'!
makeDerivedTables
	| huffSize huffCode code si index lookbits |
	mincode := Array new: 16.
	maxcode := Array new: 17.
	valptr := Array new: 17.
	huffSize := OrderedCollection new.
	1 
		to: 16
		do: 
			[ :l | 
			1 
				to: (bits at: l)
				do: [ :i | huffSize add: l ] ].
	huffSize add: 0.
	code := 0.
	huffCode := Array new: huffSize size.
	si := huffSize at: 1.
	index := 1.
	[ (huffSize at: index) ~= 0 ] whileTrue: 
		[ [ (huffSize at: index) = si ] whileTrue: 
			[ huffCode 
				at: index
				put: code.
			index := index + 1.
			code := code + 1 ].
		code := code << 1.
		si := si + 1 ].
	index := 1.
	1 
		to: 16
		do: 
			[ :l | 
			(bits at: l) ~= 0 
				ifTrue: 
					[ valptr 
						at: l
						put: index.
					mincode 
						at: l
						put: (huffCode at: index).
					index := index + (bits at: l).
					maxcode 
						at: l
						put: (huffCode at: index - 1) ]
				ifFalse: 
					[ maxcode 
						at: l
						put: -1 ] ].
	maxcode 
		at: 17
		put: 1048575.
	lookaheadBits := (Array new: 1 << Lookahead) atAllPut: 0.
	lookaheadSymbol := Array new: 1 << Lookahead.
	index := 1.
	1 
		to: Lookahead
		do: 
			[ :l | 
			1 
				to: (bits at: l)
				do: 
					[ :i | 
					lookbits := ((huffCode at: index) << (Lookahead - l)) + 1.
					(1 << (Lookahead - l) 
						to: 1
						by: -1) do: 
						[ :ctr | 
						lookaheadBits 
							at: lookbits
							put: l.
						lookaheadSymbol 
							at: lookbits
							put: (values at: index).
						lookbits := lookbits + 1 ].
					index := index + 1 ] ]! !

!JPEGHuffmanTable methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
values: anObject 
	values := anObject! !

!JPEGHuffmanTable class methodsFor: 'initialization' stamp: 'stephane.ducasse 6/14/2009 22:52'!
initialize

	Lookahead := 8.
	BitBufferSize := 16! !

!JPEGHuffmanTable class methodsFor: 'constants' stamp: 'tao 10/21/97 22:15'!
lookahead

	^ Lookahead! !

!JPEGReadStream commentStamp: '<historical>'!
Encapsulates huffman encoded access to JPEG data.

The following layout is fixed for the JPEG primitives to work:

	collection	<ByteArray | String>
	position		<SmallInteger>
	readLimit	<SmallInteger>
	bitBuffer	<SmallInteger>
	bitsInBuffer	<SmallInteger>!
!JPEGReadStream methodsFor: 'huffman trees' stamp: 'jannik.laval 5/1/2010 17:04'!
createHuffmanTables: values counts: counts from: minBits to: maxBits 
	"Create the actual tables"
	| table tableStart tableSize tableEnd valueIndex tableStack numValues deltaBits maxEntries lastTable lastTableStart tableIndex lastTableIndex |
	table := WordArray new: ((4 bitShift: minBits) max: 16).

	"Create the first entry - this is a dummy.
	It gives us information about how many bits to fetch initially."
	table 
		at: 1
		put: (minBits bitShift: 24) + 2.	"First actual table starts at index 2"

	"Create the first table from scratch."
	tableStart := 2.	"See above"
	tableSize := 1 bitShift: minBits.
	tableEnd := tableStart + tableSize.
	"Store the terminal symbols"
	valueIndex := counts at: minBits + 1.
	tableIndex := 0.
	1 
		to: valueIndex
		do: 
			[ :i | 
			table 
				at: tableStart + tableIndex
				put: (values at: i).
			tableIndex := tableIndex + 1 ].
	"Fill up remaining entries with invalid entries"
	tableStack := OrderedCollection new: 10.	"Should be more than enough"
	tableStack addLast: (Array 
			with: minBits
			with: tableStart
			with: tableIndex
			with: minBits
			with: tableSize - valueIndex).	"Number of bits (e.g., depth) for this table"	"Start of table"	"Next index in table"	"Number of delta bits encoded in table"	"Entries remaining in table"
	"Go to next value index"
	valueIndex := valueIndex + 1.
	"Walk over remaining bit lengths and create new subtables"
	minBits + 1 
		to: maxBits
		do: 
			[ :bits | 
			numValues := counts at: bits + 1.
			[ numValues > 0 ] whileTrue: 
				[ "Create a new subtable"
				lastTable := tableStack last.
				lastTableStart := lastTable at: 2.
				lastTableIndex := lastTable at: 3.
				deltaBits := bits - (lastTable at: 1).
				"Make up a table of deltaBits size"
				tableSize := 1 bitShift: deltaBits.
				tableStart := tableEnd.
				tableEnd := tableEnd + tableSize.
				[ tableEnd > table size ] whileTrue: [ table := self growHuffmanTable: table ].
				"Connect to last table"
				[ (table at: lastTableStart + lastTableIndex) = 0 ] assert.	"Entry must be unused"
				table 
					at: lastTableStart + lastTableIndex
					put: (deltaBits bitShift: 24) + tableStart.
				lastTable 
					at: 3
					put: lastTableIndex + 1.
				lastTable 
					at: 5
					put: (lastTable at: 5) - 1.
				[ (lastTable at: 5) >= 0 ] assert.	"Don't exceed tableSize"
				"Store terminal values"
				maxEntries := numValues min: tableSize.
				tableIndex := 0.
				1 
					to: maxEntries
					do: 
						[ :i | 
						table 
							at: tableStart + tableIndex
							put: (values at: valueIndex).
						valueIndex := valueIndex + 1.
						numValues := numValues - 1.
						tableIndex := tableIndex + 1 ].
				"Check if we have filled up the current table completely"
				maxEntries = tableSize 
					ifTrue: 
						[ "Table has been filled. Back up to the last table with space left."
						[ tableStack isEmpty not and: [ (tableStack last at: 5) = 0 ] ] whileTrue: [ tableStack removeLast ] ]
					ifFalse: 
						[ "Table not yet filled. Put it back on the stack."
						tableStack addLast: (Array 
								with: bits
								with: tableStart
								with: tableIndex
								with: deltaBits
								with: tableSize - maxEntries)	"Nr. of bits in this table"	"Start of table"	"Index in table"	"delta bits of table"	"Unused entries in table" ] ] ].
	^ table 
		copyFrom: 1
		to: tableEnd - 1! !

!JPEGReadStream methodsFor: 'accessing' stamp: 'ar 3/6/2001 12:35'!
nextBytes: n
	^(self next: n) asByteArray! !

!JPEGReadStream methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
fillBuffer
	| byte |
	[ bitsInBuffer <= 16 ] whileTrue: 
		[ byte := self next.
		(byte = 255 and: [ (self peekFor: 0) not ]) ifTrue: 
			[ self position: self position - 1.
			^ 0 ].
		bitBuffer := (bitBuffer bitShift: 8) bitOr: byte.
		bitsInBuffer := bitsInBuffer + 8 ].
	^ bitsInBuffer! !

!JPEGReadStream methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
resetBitBuffer
	bitBuffer := 0.
	bitsInBuffer := 0! !

!JPEGReadStream methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
getBits: requestedBits 
	| value |
	requestedBits > bitsInBuffer ifTrue: 
		[ self fillBuffer.
		requestedBits > bitsInBuffer ifTrue: [ self error: 'not enough bits available to decode' ] ].
	value := bitBuffer bitShift: requestedBits - bitsInBuffer.
	bitBuffer := bitBuffer bitAnd: (1 bitShift: bitsInBuffer - requestedBits) - 1.
	bitsInBuffer := bitsInBuffer - requestedBits.
	^ value! !

!JPEGReadStream methodsFor: 'huffman trees' stamp: 'lr 7/4/2009 10:42'!
decodeValueFrom: table 
	"Decode the next value in the receiver using the given huffman table."
	| bits bitsNeeded tableIndex value |
	bitsNeeded := (table at: 1) bitShift: -24.	"Initial bits needed"
	tableIndex := 2.	"First real table"
	
	[ bits := self getBits: bitsNeeded.	"Get bits"
	value := table at: tableIndex + bits.	"Lookup entry in table"
	(value bitAnd: 1056964608) = 0	"Check if it is a non-leaf node" ] whileFalse: 
		[ "Fetch sub table"
		tableIndex := value bitAnd: 65535.	"Table offset in low 16 bit"
		bitsNeeded := (value bitShift: -24) bitAnd: 255.	"Additional bits in high 8 bit"
		bitsNeeded > MaxBits ifTrue: [ ^ self error: 'Invalid huffman table entry' ] ].
	^ value! !

!JPEGReadStream methodsFor: 'accessing' stamp: 'ar 3/4/2001 17:40'!
reset
	super reset.
	self resetBitBuffer! !

!JPEGReadStream methodsFor: 'huffman trees' stamp: 'lr 7/4/2009 10:42'!
growHuffmanTable: table 
	| newTable |
	newTable := table species new: table size * 2.
	newTable 
		replaceFrom: 1
		to: table size
		with: table
		startingAt: 1.
	^ newTable! !

!JPEGReadStream methodsFor: 'accessing' stamp: 'ar 3/6/2001 12:34'!
nextByte
	^self next asInteger! !

!JPEGReadStream methodsFor: 'huffman trees' stamp: 'lr 7/4/2009 10:42'!
buildLookupTable: values counts: counts 
	| min max |
	min := max := nil.
	1 
		to: counts size
		do: 
			[ :i | 
			(counts at: i) = 0 ifFalse: 
				[ min ifNil: [ min := i - 1 ].
				max := i ] ].
	^ self 
		createHuffmanTables: values
		counts: {  0  } , counts
		from: min + 1
		to: max! !

!JPEGReadStream class methodsFor: 'initialization' stamp: 'lr 7/4/2009 10:42'!
initialize
	"JPEGReadStream initialize"
	MaxBits := 16! !

!JPEGReadWriter commentStamp: '<historical>'!
I am a subclass of ImageReadWriter that understands JFIF file streams, and can decode JPEG images.
This code is based upon the Independent Joint Photographic Experts Group (IJPEG) software, originally written in C by Tom Lane, Philip Gladstone, Luis Ortiz, Jim Boucher, Lee Crocker, Julian Minguillon, George Phillips, Davide Rossi, Ge' Weijers, and other members of the Independent JPEG Group.

!
!JPEGReadWriter methodsFor: 'marker parsing' stamp: 'lr 7/4/2009 10:42'!
parseStartOfScan
	| length n id value dcNum acNum comp |
	length := self nextWord.
	n := self next.
	length ~= (n * 2 + 6) | (n < 1) ifTrue: [ self error: 'SOS length is incorrect' ].
	currentComponents := Array new: n.
	1 
		to: n
		do: 
			[ :i | 
			id := self next.
			value := self next.
			dcNum := value >> 4 bitAnd: 15.
			acNum := value bitAnd: 15.
			comp := components detect: [ :c | c id = id ].
			comp
				dcTableIndex: dcNum + 1;
				acTableIndex: acNum + 1.
			currentComponents 
				at: i
				put: comp ].
	ss := self next.
	se := self next.
	value := self next.
	ah := value >> 4 bitAnd: 15.
	al := value bitAnd: 15.
	self initialSOSSetup.
	self perScanSetup.
	sosSeen := true! !

!JPEGReadWriter methodsFor: 'colorspace conversion' stamp: 'ar 3/4/2001 21:36'!
primColorConvertIntYCbCrMCU
	self primColorConvertYCbCrMCU: currentComponents
			bits: mcuImageBuffer bits
			residuals: residuals
			ditherMask: ditherMask.! !

!JPEGReadWriter methodsFor: 'marker parsing' stamp: 'lr 7/4/2009 10:42'!
parseHuffmanTable
	| length markerStart index bits count huffVal isACTable hTable |
	markerStart := self position.
	length := self nextWord.
	[ self position - markerStart >= length ] whileFalse: 
		[ index := self next.
		isACTable := (index bitAnd: 16) ~= 0.
		index := (index bitAnd: 15) + 1.
		index > HuffmanTableSize ifTrue: 
			[ self error: 'image has more than ' , HuffmanTableSize printString , ' quantization tables' ].
		bits := self next: 16.
		count := bits sum.
		(count > 256 or: [ count > (length - (self position - markerStart)) ]) ifTrue: [ self error: 'Huffman Table count is incorrect' ].
		huffVal := self next: count.
		hTable := stream 
			buildLookupTable: huffVal
			counts: bits.
		isACTable 
			ifTrue: 
				[ self hACTable 
					at: index
					put: hTable ]
			ifFalse: 
				[ self hDCTable 
					at: index
					put: hTable ] ]! !

!JPEGReadWriter methodsFor: 'marker parsing' stamp: 'tao 10/24/97 17:32'!
parseNOP

	"don't need to do anything, here"! !

!JPEGReadWriter methodsFor: 'colorspace conversion' stamp: 'tao 10/26/97 15:43'!
sampleFloatRangeLimit: aNumber

	^ (aNumber rounded max: 0) min: MaxSample! !

!JPEGReadWriter methodsFor: 'dct' stamp: 'lr 7/4/2009 10:42'!
idctBlockInt: anArray qt: qt 
	| ws anACTerm dcval z1 z2 z3 z4 z5 t0 t1 t2 t3 t10 t11 t12 t13 shift |
	ws := Array new: DCTSize2.

	"Pass 1: process columns from anArray, store into work array"
	shift := 1 bitShift: ConstBits - Pass1Bits.
	1 
		to: DCTSize
		do: 
			[ :i | 
			anACTerm := nil.
			1 
				to: DCTSize - 1
				do: 
					[ :row | 
					anACTerm ifNil: [ (anArray at: row * DCTSize + i) = 0 ifFalse: [ anACTerm := row ] ] ].
			anACTerm == nil 
				ifTrue: 
					[ dcval := (anArray at: i) * (qt at: 1) bitShift: Pass1Bits.
					0 
						to: DCTSize - 1
						do: 
							[ :j | 
							ws 
								at: j * DCTSize + i
								put: dcval ] ]
				ifFalse: 
					[ z2 := (anArray at: DCTSize * 2 + i) * (qt at: DCTSize * 2 + i).
					z3 := (anArray at: DCTSize * 6 + i) * (qt at: DCTSize * 6 + i).
					z1 := (z2 + z3) * FIXn0n541196100.
					t2 := z1 + (z3 * FIXn1n847759065 negated).
					t3 := z1 + (z2 * FIXn0n765366865).
					z2 := (anArray at: i) * (qt at: i).
					z3 := (anArray at: DCTSize * 4 + i) * (qt at: DCTSize * 4 + i).
					t0 := z2 + z3 bitShift: ConstBits.
					t1 := z2 - z3 bitShift: ConstBits.
					t10 := t0 + t3.
					t13 := t0 - t3.
					t11 := t1 + t2.
					t12 := t1 - t2.
					t0 := (anArray at: DCTSize * 7 + i) * (qt at: DCTSize * 7 + i).
					t1 := (anArray at: DCTSize * 5 + i) * (qt at: DCTSize * 5 + i).
					t2 := (anArray at: DCTSize * 3 + i) * (qt at: DCTSize * 3 + i).
					t3 := (anArray at: DCTSize + i) * (qt at: DCTSize + i).
					z1 := t0 + t3.
					z2 := t1 + t2.
					z3 := t0 + t2.
					z4 := t1 + t3.
					z5 := (z3 + z4) * FIXn1n175875602.
					t0 := t0 * FIXn0n298631336.
					t1 := t1 * FIXn2n053119869.
					t2 := t2 * FIXn3n072711026.
					t3 := t3 * FIXn1n501321110.
					z1 := z1 * FIXn0n899976223 negated.
					z2 := z2 * FIXn2n562915447 negated.
					z3 := z3 * FIXn1n961570560 negated.
					z4 := z4 * FIXn0n390180644 negated.
					z3 := z3 + z5.
					z4 := z4 + z5.
					t0 := t0 + z1 + z3.
					t1 := t1 + z2 + z4.
					t2 := t2 + z2 + z3.
					t3 := t3 + z1 + z4.
					ws 
						at: i
						put: t10 + t3 >> (ConstBits - Pass1Bits).
					ws 
						at: DCTSize * 7 + i
						put: (t10 - t3) // shift.
					ws 
						at: DCTSize * 1 + i
						put: (t11 + t2) // shift.
					ws 
						at: DCTSize * 6 + i
						put: (t11 - t2) // shift.
					ws 
						at: DCTSize * 2 + i
						put: (t12 + t1) // shift.
					ws 
						at: DCTSize * 5 + i
						put: (t12 - t1) // shift.
					ws 
						at: DCTSize * 3 + i
						put: (t13 + t0) // shift.
					ws 
						at: DCTSize * 4 + i
						put: (t13 - t0) // shift ] ].

	"Pass 2: process rows from work array, store back into anArray"
	shift := 1 bitShift: ConstBits + Pass1Bits + 3.
	0 
		to: DCTSize2 - DCTSize
		by: DCTSize
		do: 
			[ :i | 
			z2 := ws at: i + 3.
			z3 := ws at: i + 7.
			z1 := (z2 + z3) * FIXn0n541196100.
			t2 := z1 + (z3 * FIXn1n847759065 negated).
			t3 := z1 + (z2 * FIXn0n765366865).
			t0 := (ws at: i + 1) + (ws at: i + 5) bitShift: ConstBits.
			t1 := (ws at: i + 1) - (ws at: i + 5) bitShift: ConstBits.
			t10 := t0 + t3.
			t13 := t0 - t3.
			t11 := t1 + t2.
			t12 := t1 - t2.
			t0 := ws at: i + 8.
			t1 := ws at: i + 6.
			t2 := ws at: i + 4.
			t3 := ws at: i + 2.
			z1 := t0 + t3.
			z2 := t1 + t2.
			z3 := t0 + t2.
			z4 := t1 + t3.
			z5 := (z3 + z4) * FIXn1n175875602.
			t0 := t0 * FIXn0n298631336.
			t1 := t1 * FIXn2n053119869.
			t2 := t2 * FIXn3n072711026.
			t3 := t3 * FIXn1n501321110.
			z1 := z1 * FIXn0n899976223 negated.
			z2 := z2 * FIXn2n562915447 negated.
			z3 := z3 * FIXn1n961570560 negated.
			z4 := z4 * FIXn0n390180644 negated.
			z3 := z3 + z5.
			z4 := z4 + z5.
			t0 := t0 + z1 + z3.
			t1 := t1 + z2 + z4.
			t2 := t2 + z2 + z3.
			t3 := t3 + z1 + z4.
			anArray 
				at: i + 1
				put: (self sampleRangeLimit: (t10 + t3) // shift + SampleOffset).
			anArray 
				at: i + 8
				put: (self sampleRangeLimit: (t10 - t3) // shift + SampleOffset).
			anArray 
				at: i + 2
				put: (self sampleRangeLimit: (t11 + t2) // shift + SampleOffset).
			anArray 
				at: i + 7
				put: (self sampleRangeLimit: (t11 - t2) // shift + SampleOffset).
			anArray 
				at: i + 3
				put: (self sampleRangeLimit: (t12 + t1) // shift + SampleOffset).
			anArray 
				at: i + 6
				put: (self sampleRangeLimit: (t12 - t1) // shift + SampleOffset).
			anArray 
				at: i + 4
				put: (self sampleRangeLimit: (t13 + t0) // shift + SampleOffset).
			anArray 
				at: i + 5
				put: (self sampleRangeLimit: (t13 - t0) // shift + SampleOffset) ]! !

!JPEGReadWriter methodsFor: 'colorspace conversion' stamp: 'ar 3/7/2001 01:02'!
colorConvertMCU

	^ currentComponents size = 3
		ifTrue:
			[self useFloatingPoint
				ifTrue: [self colorConvertFloatYCbCrMCU]
				ifFalse: [self primColorConvertYCbCrMCU: currentComponents
								bits: mcuImageBuffer bits
								residuals: residuals
								ditherMask: ditherMask.]]
		ifFalse: [self primColorConvertGrayscaleMCU]! !

!JPEGReadWriter methodsFor: 'huffman encoding' stamp: 'ar 3/4/2001 17:27'!
getBits: requestedBits
	^stream getBits: requestedBits! !

!JPEGReadWriter methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
qTable
	qTable ifNil: [ qTable := Array new: QuantizationTableSize ].
	^ qTable! !

!JPEGReadWriter methodsFor: 'private' stamp: 'lr 7/4/2009 10:42'!
on: aStream 
	super on: aStream.
	stream := JPEGReadStream on: stream upToEnd! !

!JPEGReadWriter methodsFor: 'public access' stamp: 'StephaneDucasse 10/25/2013 16:17'!
nextImageDitheredToDepth: depth 
	| form xStep yStep x y bb |
	ditherMask := DitherMasks 
		at: depth
		ifAbsent: [ self error: 'can only dither to display depths' ].
	residuals := WordArray new: 3.
	sosSeen := false.
	self parseFirstMarker.
	[ sosSeen ] whileFalse: [ self parseNextMarker ].
	form := Form 
		extent: width @ height
		depth: depth.
	bb := BitBlt toForm: form.
	bb sourceForm: mcuImageBuffer.
	bb colorMap: (mcuImageBuffer colormapIfNeededFor: form).
	bb sourceRect: mcuImageBuffer boundingBox.
	bb combinationRule: Form over.
	xStep := mcuWidth * DCTSize.
	yStep := mcuHeight * DCTSize.
	y := 0.
	1 
		to: mcuRowsInScan
		do: 
			[ :row | 
			x := 0.
			1 
				to: mcusPerRow
				do: 
					[ :col | 
					self decodeMCU.
					self idctMCU.
					self colorConvertMCU.
					bb
						destX: x;
						destY: y;
						copyBits.
					x := x + xStep ].
			y := y + yStep ].
	^ form! !

!JPEGReadWriter methodsFor: 'colorspace conversion' stamp: 'ar 3/15/2001 18:11'!
primColorConvertGrayscaleMCU: componentArray bits: bits residuals: residualArray ditherMask: mask
	<primitive: 'primitiveColorConvertGrayscaleMCU' module: 'JPEGReaderPlugin'>
	"JPEGReaderPlugin doPrimitive: #primitiveColorConvertGrayscaleMCU."
	^self colorConvertGrayscaleMCU! !

!JPEGReadWriter methodsFor: 'huffman encoding' stamp: 'lr 7/4/2009 10:42'!
processRestart
	stream resetBitBuffer.
	self parseNextMarker.
	currentComponents do: [ :c | c priorDCValue: 0 ].
	restartsToGo := restartInterval! !

!JPEGReadWriter methodsFor: 'marker parsing' stamp: 'lr 7/4/2009 10:42'!
perScanSetup
	mcusPerRow := (width / (mcuWidth * DCTSize)) ceiling.
	mcuRowsInScan := (height / (mcuHeight * DCTSize)) ceiling.
	(currentComponents size = 3 or: [ currentComponents size = 1 ]) ifFalse: [ self error: 'JPEG color space not recognized' ].
	mcuMembership := OrderedCollection new.
	currentComponents withIndexDo: 
		[ :c :i | 
		c priorDCValue: 0.
		mcuMembership addAll: ((1 to: c totalMcuBlocks) collect: [ :b | i ]) ].
	mcuMembership := mcuMembership asArray.
	mcuSampleBuffer := (1 to: mcuMembership size) collect: [ :i | IntegerArray new: DCTSize2 ].
	currentComponents withIndexDo: 
		[ :c :i | 
		c initializeSampleStreamBlocks: ((1 to: mcuMembership size) 
				select: [ :j | i = (mcuMembership at: j) ]
				thenCollect: [ :j | mcuSampleBuffer at: j ]) ].
	mcuImageBuffer := Form 
		extent: mcuWidth @ mcuHeight * DCTSize
		depth: 32.
	restartsToGo := restartInterval! !

!JPEGReadWriter methodsFor: 'colorspace conversion' stamp: 'di 9/15/1998 14:30'!
sampleRangeLimit: aNumber

	aNumber < 0 ifTrue: [^ 0].
	aNumber > MaxSample ifTrue: [^ MaxSample].
	^ aNumber! !

!JPEGReadWriter methodsFor: 'colorspace conversion' stamp: 'lr 7/4/2009 10:42'!
colorConvertFloatYCbCrMCU
	| ySampleStream crSampleStream cbSampleStream y cb cr red green blue bits |
	ySampleStream := currentComponents at: 1.
	cbSampleStream := currentComponents at: 2.
	crSampleStream := currentComponents at: 3.
	ySampleStream resetSampleStream.
	cbSampleStream resetSampleStream.
	crSampleStream resetSampleStream.
	bits := mcuImageBuffer bits.
	1 
		to: bits size
		do: 
			[ :i | 
			y := ySampleStream nextSample.
			cb := cbSampleStream nextSample - FloatSampleOffset.
			cr := crSampleStream nextSample - FloatSampleOffset.
			red := self sampleFloatRangeLimit: y + (1.402 * cr).
			green := self sampleFloatRangeLimit: y - (0.34414 * cb) - (0.71414 * cr).
			blue := self sampleFloatRangeLimit: y + (1.772 * cb).
			bits 
				at: i
				put: 4278190080 + (red << 16) + (green << 8) + blue ]! !

!JPEGReadWriter methodsFor: 'testing' stamp: 'ar 3/4/2001 00:50'!
understandsImageFormat
	"Answer true if the image stream format is understood by this decoder."
	self next = 16rFF ifFalse: [^ false].
	self next = 16rD8 ifFalse: [^ false].
	^ true
! !

!JPEGReadWriter methodsFor: 'dct' stamp: 'ar 3/4/2001 21:35'!
primIdctInt: anArray qt: qt
	<primitive: 'primitiveIdctInt' module: 'JPEGReaderPlugin'>
	^self idctBlockInt: anArray qt: qt! !

!JPEGReadWriter methodsFor: 'marker parsing' stamp: 'lr 7/4/2009 10:42'!
initialSOSSetup
	mcuWidth := (components detectMax: [ :c | c widthInBlocks ]) widthInBlocks.
	mcuHeight := (components detectMax: [ :c | c heightInBlocks ]) heightInBlocks.
	components do: 
		[ :c | 
		c 
			mcuWidth: mcuWidth
			mcuHeight: mcuHeight
			dctSize: DCTSize ].
	stream resetBitBuffer! !

!JPEGReadWriter methodsFor: 'colorspace conversion' stamp: 'ar 3/4/2001 22:19'!
primColorConvertGrayscaleMCU
	self primColorConvertGrayscaleMCU: (currentComponents at: 1)
			bits: mcuImageBuffer bits
			residuals: residuals
			ditherMask: ditherMask.! !

!JPEGReadWriter methodsFor: 'colorspace conversion' stamp: 'lr 7/4/2009 10:42'!
colorConvertIntYCbCrMCU
	| ySampleStream crSampleStream cbSampleStream y cb cr red green blue bits |
	ySampleStream := currentComponents at: 1.
	cbSampleStream := currentComponents at: 2.
	crSampleStream := currentComponents at: 3.
	ySampleStream resetSampleStream.
	cbSampleStream resetSampleStream.
	crSampleStream resetSampleStream.
	bits := mcuImageBuffer bits.
	1 
		to: bits size
		do: 
			[ :i | 
			y := ySampleStream nextSample.
			cb := cbSampleStream nextSample - SampleOffset.
			cr := crSampleStream nextSample - SampleOffset.
			red := y + (FIXn1n40200 * cr // 65536) + (residuals at: 1).
			red > MaxSample 
				ifTrue: [ red := MaxSample ]
				ifFalse: [ red < 0 ifTrue: [ red := 0 ] ].
			residuals 
				at: 1
				put: (red bitAnd: ditherMask).
			red := red bitAnd: MaxSample - ditherMask.
			red < 1 ifTrue: [ red := 1 ].
			green := y - (FIXn0n34414 * cb // 65536) - (FIXn0n71414 * cr // 65536) + (residuals at: 2).
			green > MaxSample 
				ifTrue: [ green := MaxSample ]
				ifFalse: [ green < 0 ifTrue: [ green := 0 ] ].
			residuals 
				at: 2
				put: (green bitAnd: ditherMask).
			green := green bitAnd: MaxSample - ditherMask.
			green < 1 ifTrue: [ green := 1 ].
			blue := y + (FIXn1n77200 * cb // 65536) + (residuals at: 3).
			blue > MaxSample 
				ifTrue: [ blue := MaxSample ]
				ifFalse: [ blue < 0 ifTrue: [ blue := 0 ] ].
			residuals 
				at: 3
				put: (blue bitAnd: ditherMask).
			blue := blue bitAnd: MaxSample - ditherMask.
			blue < 1 ifTrue: [ blue := 1 ].
			bits 
				at: i
				put: 4278190080 + (red bitShift: 16) + (green bitShift: 8) + blue ]! !

!JPEGReadWriter methodsFor: 'marker parsing' stamp: 'lr 7/4/2009 10:42'!
parseStartOfFile
	| length markerStart value n |
	markerStart := self position.
	length := self nextWord.
	dataPrecision := self next.
	dataPrecision = 8 ifFalse: 
		[ self error: 'cannot handle ' , dataPrecision printString , '-bit components' ].
	height := self nextWord.
	width := self nextWord.
	n := self next.
	height = 0 | (width = 0) | (n = 0) ifTrue: [ self error: 'empty image' ].
	length - (self position - markerStart) ~= (n * 3) ifTrue: [ self error: 'component length is incorrect' ].
	components := Array new: n.
	1 
		to: components size
		do: 
			[ :i | 
			components 
				at: i
				put: (JPEGColorComponent new
						id: self next;
						widthInBlocks: ((value := self next) >> 4 bitAnd: 15);
						heightInBlocks: (value bitAnd: 15);
						qTableIndex: self next + 1)
			"heightInBlocks: (((value := self next) >> 4) bitAnd: 16r0F);
					widthInBlocks: (value bitAnd: 16r0F);" ]! !

!JPEGReadWriter methodsFor: 'public access' stamp: 'tao 9/18/1998 08:53'!
nextImage

	^ self nextImageDitheredToDepth: Display depth
! !

!JPEGReadWriter methodsFor: 'marker parsing' stamp: 'lr 7/4/2009 10:42'!
parseNextMarker
	"Parse the next marker of the stream"
	| byte discardedBytes |
	discardedBytes := 0.
	[ (byte := self next) = 255 ] whileFalse: [ discardedBytes := discardedBytes + 1 ].
	
	[ [ (byte := self next) = 255 ] whileTrue.
	byte = 0 ] whileTrue: [ discardedBytes := discardedBytes + 2 ].
	discardedBytes > 0 ifTrue: 
		[ "notifyWithLabel: 'warning: extraneous data discarded'"
		self ].
	self perform: (JFIFMarkerParser 
			at: byte
			ifAbsent: 
				[ (self okToIgnoreMarker: byte) 
					ifTrue: [ #skipMarker ]
					ifFalse: [ self error: 'marker ' , byte printStringHex , ' cannot be handled' ] ])! !

!JPEGReadWriter methodsFor: 'dct' stamp: 'lr 7/4/2009 10:42'!
idctBlockFloat: anArray component: aColorComponent 
	| t0 t1 t2 t3 t4 t5 t6 t7 t10 t11 t12 t13 z5 z10 z11 z12 z13 qt ws |
	qt := self qTable at: aColorComponent qTableIndex.
	ws := Array new: DCTSize2.

	"Pass 1: process columns from input, store into work array"
	1 
		to: DCTSize
		do: 
			[ :i | 
			t0 := (anArray at: i) * (qt at: i).
			t1 := (anArray at: DCTSize * 2 + i) * (qt at: DCTSize * 2 + i).
			t2 := (anArray at: DCTSize * 4 + i) * (qt at: DCTSize * 4 + i).
			t3 := (anArray at: DCTSize * 6 + i) * (qt at: DCTSize * 6 + i).
			t10 := t0 + t2.
			t11 := t0 - t2.
			t13 := t1 + t3.
			t12 := (t1 - t3) * DCTK1 - t13.
			t0 := t10 + t13.
			t3 := t10 - t13.
			t1 := t11 + t12.
			t2 := t11 - t12.
			t4 := (anArray at: DCTSize + i) * (qt at: DCTSize + i).
			t5 := (anArray at: DCTSize * 3 + i) * (qt at: DCTSize * 3 + i).
			t6 := (anArray at: DCTSize * 5 + i) * (qt at: DCTSize * 5 + i).
			t7 := (anArray at: DCTSize * 7 + i) * (qt at: DCTSize * 7 + i).
			z13 := t6 + t5.
			z10 := t6 - t5.
			z11 := t4 + t7.
			z12 := t4 - t7.
			t7 := z11 + z13.
			t11 := (z11 - z13) * DCTK1.
			z5 := (z10 + z12) * DCTK2.
			t10 := DCTK3 * z12 - z5.
			t12 := DCTK4 * z10 + z5.
			t6 := t12 - t7.
			t5 := t11 - t6.
			t4 := t10 + t5.
			ws 
				at: i
				put: t0 + t7.
			ws 
				at: DCTSize * 7 + i
				put: t0 - t7.
			ws 
				at: DCTSize + i
				put: t1 + t6.
			ws 
				at: DCTSize * 6 + i
				put: t1 - t6.
			ws 
				at: DCTSize * 2 + i
				put: t2 + t5.
			ws 
				at: DCTSize * 5 + i
				put: t2 - t5.
			ws 
				at: DCTSize * 4 + i
				put: t3 + t4.
			ws 
				at: DCTSize * 3 + i
				put: t3 - t4 ].

	"Pass 2: process rows from the workspace"
	(0 
		to: DCTSize2 - DCTSize
		by: DCTSize) do: 
		[ :i | 
		t10 := (ws at: i + 1) + (ws at: i + 5).
		t11 := (ws at: i + 1) - (ws at: i + 5).
		t13 := (ws at: i + 3) + (ws at: i + 7).
		t12 := ((ws at: i + 3) - (ws at: i + 7)) * DCTK1 - t13.
		t0 := t10 + t13.
		t3 := t10 - t13.
		t1 := t11 + t12.
		t2 := t11 - t12.
		z13 := (ws at: i + 6) + (ws at: i + 4).
		z10 := (ws at: i + 6) - (ws at: i + 4).
		z11 := (ws at: i + 2) + (ws at: i + 8).
		z12 := (ws at: i + 2) - (ws at: i + 8).
		t7 := z11 + z13.
		t11 := (z11 - z13) * DCTK1.
		z5 := (z10 + z12) * DCTK2.
		t10 := DCTK3 * z12 - z5.
		t12 := DCTK4 * z10 + z5.
		t6 := t12 - t7.
		t5 := t11 - t6.
		t4 := t10 + t5.

		"final output stage: scale down by a factor of 8 and range-limit"
		anArray 
			at: i + 1
			put: (self dctFloatRangeLimit: t0 + t7).
		anArray 
			at: i + 8
			put: (self dctFloatRangeLimit: t0 - t7).
		anArray 
			at: i + 2
			put: (self dctFloatRangeLimit: t1 + t6).
		anArray 
			at: i + 7
			put: (self dctFloatRangeLimit: t1 - t6).
		anArray 
			at: i + 3
			put: (self dctFloatRangeLimit: t2 + t5).
		anArray 
			at: i + 6
			put: (self dctFloatRangeLimit: t2 - t5).
		anArray 
			at: i + 5
			put: (self dctFloatRangeLimit: t3 + t4).
		anArray 
			at: i + 4
			put: (self dctFloatRangeLimit: t3 - t4) ]! !

!JPEGReadWriter methodsFor: 'error handling' stamp: 'tao 10/19/97 12:25'!
notSupported: aString

	self error: aString , ' is not currently supported'! !

!JPEGReadWriter methodsFor: 'preferences' stamp: 'tao 10/26/97 22:09'!
useFloatingPoint

	^ false! !

!JPEGReadWriter methodsFor: 'huffman encoding' stamp: 'ar 3/4/2001 21:32'!
primDecodeBlockInto: sampleBuffer component: comp dcTable: dcTable acTable: acTable stream: jpegStream
	<primitive: 'primitiveDecodeMCU' module: 'JPEGReaderPlugin'>
	^self decodeBlockInto: sampleBuffer component: comp dcTable: dcTable acTable: acTable! !

!JPEGReadWriter methodsFor: 'marker parsing' stamp: 'lr 7/4/2009 10:42'!
skipMarker
	| length markerStart |
	markerStart := self position.
	length := self nextWord.
	self next: length - (self position - markerStart)! !

!JPEGReadWriter methodsFor: 'colorspace conversion' stamp: 'lr 7/4/2009 10:42'!
colorConvertGrayscaleMCU
	| ySampleStream y bits |
	ySampleStream := currentComponents at: 1.
	ySampleStream resetSampleStream.
	bits := mcuImageBuffer bits.
	1 
		to: bits size
		do: 
			[ :i | 
			y := ySampleStream nextSample + (residuals at: 2).
			y > MaxSample ifTrue: [ y := MaxSample ].
			residuals 
				at: 2
				put: (y bitAnd: ditherMask).
			y := y bitAnd: MaxSample - ditherMask.
			y < 1 ifTrue: [ y := 1 ].
			bits 
				at: i
				put: 4278190080 + (y << 16) + (y << 8) + y ]! !

!JPEGReadWriter methodsFor: 'dct' stamp: 'ar 3/4/2001 21:35'!
idctBlockInt: anArray component: aColorComponent
	^self idctBlockInt: anArray qt: (self qTable at: aColorComponent qTableIndex)! !

!JPEGReadWriter methodsFor: 'marker parsing' stamp: 'lr 7/4/2009 10:42'!
parseStartOfInput
	restartInterval := 0.
	densityUnit := 0.
	xDensity := 1.
	yDensity := 1! !

!JPEGReadWriter methodsFor: 'public access' stamp: 'MarcusDenker 9/24/2014 14:33'!
nextPutImage: aForm
	self error: 'JPEGReadWriter supports decoding, for encoding, look at PluginBasedJPEGReadWriter'! !

!JPEGReadWriter methodsFor: 'dct' stamp: 'tao 10/26/97 15:16'!
dctFloatRangeLimit: value

	^ (value / 8.0) + FloatSampleOffset.! !

!JPEGReadWriter methodsFor: 'marker parsing' stamp: 'lr 7/4/2009 10:42'!
parseDecoderRestartInterval
	| length |
	length := self nextWord.
	length = 4 ifFalse: [ self error: 'DRI length incorrect' ].
	restartInterval := self nextWord! !

!JPEGReadWriter methodsFor: 'huffman encoding' stamp: 'lr 7/4/2009 10:42'!
decodeMCU
	| comp ci |
	(restartInterval ~= 0 and: [ restartsToGo = 0 ]) ifTrue: [ self processRestart ].
	1 
		to: mcuMembership size
		do: 
			[ :i | 
			ci := mcuMembership at: i.
			comp := currentComponents at: ci.
			self 
				primDecodeBlockInto: (mcuSampleBuffer at: i)
				component: comp
				dcTable: (hDCTable at: comp dcTableIndex)
				acTable: (hACTable at: comp acTableIndex)
				stream: stream ].
	restartsToGo := restartsToGo - 1! !

!JPEGReadWriter methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
hDCTable
	hDCTable ifNil: [ hDCTable := Array new: HuffmanTableSize ].
	^ hDCTable! !

!JPEGReadWriter methodsFor: 'marker parsing' stamp: 'lr 7/4/2009 10:42'!
parseAPPn
	| length buffer thumbnailLength markerStart |
	markerStart := self position.
	length := self nextWord.
	buffer := self next: 4.
	buffer asString = 'JFIF' ifFalse: 
		[ "Skip APPs that we're not interested in"
		stream next: length - 6.
		^ self ].
	self next.
	majorVersion := self next.
	minorVersion := self next.
	densityUnit := self next.
	xDensity := self nextWord.
	yDensity := self nextWord.
	thumbnailLength := self next * self next * 3.
	length := length - (self position - markerStart).
	length = thumbnailLength ifFalse: [ self error: 'APP0 thumbnail length is incorrect.' ].
	self next: length! !

!JPEGReadWriter methodsFor: 'dct' stamp: 'lr 7/4/2009 10:42'!
scaleQuantizationTable: table 
	| index |
	index := 1.
	1 
		to: DCTSize
		do: 
			[ :row | 
			1 
				to: DCTSize
				do: 
					[ :col | 
					table 
						at: index
						put: ((table at: index) * (QTableScaleFactor at: row) * (QTableScaleFactor at: col)) rounded.
					index := index + 1 ] ].
	^ table! !

!JPEGReadWriter methodsFor: 'dct' stamp: 'ar 3/4/2001 21:37'!
primIdctBlockInt: anArray component: aColorComponent
	^self primIdctInt: anArray qt: (self qTable at: aColorComponent qTableIndex)! !

!JPEGReadWriter methodsFor: 'public access' stamp: 'lr 7/4/2009 10:42'!
setStream: aStream 
	"Feed it in from an existing source"
	stream := JPEGReadStream on: aStream upToEnd! !

!JPEGReadWriter methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
hACTable
	hACTable ifNil: [ hACTable := Array new: HuffmanTableSize ].
	^ hACTable! !

!JPEGReadWriter methodsFor: 'marker parsing' stamp: 'mir 6/13/2001 13:06'!
okToIgnoreMarker: aMarker

	^ (((16rE0 to: 16rEF) includes: aMarker) "unhandled APPn markers"
		or: [aMarker = 16rDC or: [aMarker = 16rFE]]) "DNL or COM markers"
		or: [aMarker = 16r99] "Whatever that is"! !

!JPEGReadWriter methodsFor: 'huffman encoding' stamp: 'lr 7/4/2009 10:42'!
decodeBlockInto: anArray component: aColorComponent dcTable: huffmanDC acTable: huffmanAC 
	| byte i zeroCount |
	byte := stream decodeValueFrom: huffmanDC.
	byte ~= 0 ifTrue: 
		[ byte := self 
			scaleAndSignExtend: (self getBits: byte)
			inFieldWidth: byte ].
	byte := aColorComponent updateDCValue: byte.
	anArray atAllPut: 0.
	anArray 
		at: 1
		put: byte.
	i := 2.
	[ i <= DCTSize2 ] whileTrue: 
		[ byte := stream decodeValueFrom: huffmanAC.
		zeroCount := byte >> 4.
		byte := byte bitAnd: 15.
		byte ~= 0 
			ifTrue: 
				[ i := i + zeroCount.
				byte := self 
					scaleAndSignExtend: (self getBits: byte)
					inFieldWidth: byte.
				anArray 
					at: (JPEGNaturalOrder at: i)
					put: byte ]
			ifFalse: 
				[ zeroCount = 15 
					ifTrue: [ i := i + zeroCount ]
					ifFalse: [ ^ self ] ].
		i := i + 1 ]! !

!JPEGReadWriter methodsFor: 'colorspace conversion' stamp: 'ar 3/4/2001 21:36'!
primColorConvertYCbCrMCU: componentArray bits: bits residuals: residualArray ditherMask: mask
	<primitive: 'primitiveColorConvertMCU' module: 'JPEGReaderPlugin'>
	^self colorConvertIntYCbCrMCU! !

!JPEGReadWriter methodsFor: 'marker parsing' stamp: 'lr 7/4/2009 10:42'!
parseQuantizationTable
	| length markerStart n prec value table |
	markerStart := self position.
	length := self nextWord.
	[ self position - markerStart >= length ] whileFalse: 
		[ value := self next.
		n := (value bitAnd: 15) + 1.
		prec := value >> 4 > 0.
		n > QuantizationTableSize ifTrue: 
			[ self error: 'image has more than ' , QuantizationTableSize printString , ' quantization tables' ].
		table := IntegerArray new: DCTSize2.
		1 
			to: DCTSize2
			do: 
				[ :i | 
				value := prec 
					ifTrue: [ self nextWord ]
					ifFalse: [ self next ].
				table 
					at: (JPEGNaturalOrder at: i)
					put: value ].
		self useFloatingPoint ifTrue: [ self scaleQuantizationTable: table ].
		self qTable 
			at: n
			put: table ]! !

!JPEGReadWriter methodsFor: 'dct' stamp: 'lr 7/4/2009 10:42'!
idctMCU
	| comp fp ci |
	fp := self useFloatingPoint.
	1 
		to: mcuMembership size
		do: 
			[ :i | 
			ci := mcuMembership at: i.
			comp := currentComponents at: ci.
			fp 
				ifTrue: 
					[ self 
						idctBlockFloat: (mcuSampleBuffer at: i)
						component: comp ]
				ifFalse: 
					[ self 
						primIdctInt: (mcuSampleBuffer at: i)
						qt: (qTable at: comp qTableIndex) ] ]! !

!JPEGReadWriter methodsFor: 'huffman encoding' stamp: 'ar 3/4/2001 01:17'!
scaleAndSignExtend: aNumber inFieldWidth: w

	aNumber < (1 bitShift: (w - 1))
		ifTrue: [^aNumber - (1 bitShift: w) + 1]
		ifFalse: [^aNumber]! !

!JPEGReadWriter methodsFor: 'marker parsing' stamp: 'lr 7/4/2009 10:42'!
parseFirstMarker
	| marker |
	self next = 255 ifFalse: [ self error: 'JFIF marker expected' ].
	marker := self next.
	marker = 217 ifTrue: [ ^ self	"halt: 'EOI encountered.'" ].
	marker = 216 ifFalse: [ self error: 'SOI marker expected' ].
	self parseStartOfInput! !

!JPEGReadWriter class methodsFor: 'image reading/writing' stamp: 'nk 7/16/2003 17:56'!
typicalFileExtensions
	"Answer a collection of file extensions (lowercase) which files that I can read might commonly have"
	^#('jpg' 'jpeg')! !

!JPEGReadWriter class methodsFor: 'initialization' stamp: 'lr 7/4/2009 10:42'!
initialize
	"JPEGReadWriter initialize"
	"general constants"
	DCTSize := 8.
	MaxSample := (2 raisedToInteger: DCTSize) - 1.
	SampleOffset := MaxSample // 2.
	FloatSampleOffset := SampleOffset asFloat.
	DCTSize2 := DCTSize squared.
	QuantizationTableSize := 4.
	HuffmanTableSize := 4.

	"floating-point Inverse Discrete Cosine Transform (IDCT) constants"
	ConstBits := 13.
	Pass1Bits := 2.
	DCTK1 := 2 sqrt.
	DCTK2 := 1.847759065.
	DCTK3 := 1.0823922.
	DCTK4 := -2.61312593.
	Pass1Div := 1 bitShift: ConstBits - Pass1Bits.
	Pass2Div := 1 bitShift: ConstBits + Pass1Bits + 3.

	"fixed-point Inverse Discrete Cosine Transform (IDCT) constants"
	FIXn0n298631336 := 2446.
	FIXn0n390180644 := 3196.
	FIXn0n541196100 := 4433.
	FIXn0n765366865 := 6270.
	FIXn0n899976223 := 7373.
	FIXn1n175875602 := 9633.
	FIXn1n501321110 := 12299.
	FIXn1n847759065 := 15137.
	FIXn1n961570560 := 16069.
	FIXn2n053119869 := 16819.
	FIXn2n562915447 := 20995.
	FIXn3n072711026 := 25172.

	"fixed-point color conversion constants"
	FIXn0n34414 := 22554.
	FIXn0n71414 := 46802.
	FIXn1n40200 := 91881.
	FIXn1n77200 := 116130.

	"reordering table from JPEG zig-zag order"
	JPEGNaturalOrder := #(
		1
		2
		9
		17
		10
		3
		4
		11
		18
		25
		33
		26
		19
		12
		5
		6
		13
		20
		27
		34
		41
		49
		42
		35
		28
		21
		14
		7
		8
		15
		22
		29
		36
		43
		50
		57
		58
		51
		44
		37
		30
		23
		16
		24
		31
		38
		45
		52
		59
		60
		53
		46
		39
		32
		40
		47
		54
		61
		62
		55
		48
		56
		63
		64
	).

	"scale factors for the values in the Quantization Tables"
	QTableScaleFactor := (0 to: DCTSize - 1) collect: 
		[ :k | 
		k = 0 
			ifTrue: [ 1.0 ]
			ifFalse: [ (k * Float pi / 16) cos * 2 sqrt ] ].

	"dithering masks"
	(DitherMasks := Dictionary new)
		add: 0 -> 0;
		add: 1 -> 127;
		add: 2 -> 63;
		add: 4 -> 63;
		add: 8 -> 31;
		add: 16 -> 7;
		add: 32 -> 0.

	"dictionary of marker parsers"
	(JFIFMarkerParser := Dictionary new)
		add: 1 -> #parseNOP;
		add: 192 -> #parseStartOfFile;
		add: 196 -> #parseHuffmanTable;
		addAll: ((208 to: 215) collect: 
				[ :m | 
				Association 
					key: m
					value: #parseNOP ]);
		add: 216 -> #parseStartOfInput;
		add: 217 -> #parseEndOfInput;
		add: 218 -> #parseStartOfScan;
		add: 219 -> #parseQuantizationTable;
		add: 221 -> #parseDecoderRestartInterval;
		add: 224 -> #parseAPPn;
		add: 225 -> #parseAPPn! !

!JPEGReadWriter class methodsFor: 'image reading/writing' stamp: 'MarianoMartinezPeck 3/24/2010 21:13'!
understandsImageFormat: aStream
	(PluginBasedJPEGReadWriter understandsImageFormat: aStream) ifTrue:[^false].
	aStream reset.
	aStream next = 16rFF ifFalse: [^ false].
	aStream next = 16rD8 ifFalse: [^ false].
	^true! !

!JapaneseEnvironment commentStamp: '<historical>'!
This class provides the Japanese support.  Since it has been used most other than default 'latin-1' languages, this tends to be a good place to look at when you want to know what a typical subclass of LanguageEnvironment should do.
!
!JapaneseEnvironment class methodsFor: 'subclass responsibilities' stamp: 'cami 7/22/2013 18:25'!
systemConverterClass
	| encoding |

	Smalltalk os isWin32 
		ifTrue: [^ShiftJISTextConverter].
	Smalltalk os isMacOS
		ifTrue: [^UTF8TextConverter].
	Smalltalk os isUnix
		ifTrue: 
			[encoding := X11Encoding encoding.
			encoding ifNil: [^EUCJPTextConverter].
			(encoding = 'utf-8') 
				ifTrue: [^UTF8TextConverter].				
			(encoding = 'shiftjis' or: [ encoding = 'sjis' ]) 
				ifTrue: [^ShiftJISTextConverter].				
			^EUCJPTextConverter].
	^UTF8TextConverter! !

!JapaneseEnvironment class methodsFor: 'language methods' stamp: 'ar 4/9/2005 22:31'!
fromJISX0208String: aString

	^ aString collect: [:each | Character leadingChar: JapaneseEnvironment leadingChar code: (each asUnicode)].
! !

!JapaneseEnvironment class methodsFor: 'subclass responsibilities' stamp: 'mir 7/21/2004 19:09'!
supportedLanguages
	"Return the languages that this class supports. 
	Any translations for those languages will use this class as their environment."
	
	^#('ja' 'ja-etoys' )! !

!JapaneseEnvironment class methodsFor: 'class initialization' stamp: 'StephaneDucasse 8/22/2013 14:29'!
initialize
	EncodedCharSet declareEncodedCharSet: self atIndex: 5+1.! !

!JapaneseEnvironment class methodsFor: 'language methods' stamp: 'yo 3/17/2004 21:54'!
scanSelector

	^ #scanJapaneseCharactersFrom:to:in:rightX:stopConditions:kern:
! !

!JapaneseEnvironment class methodsFor: 'rendering support' stamp: 'yo 3/18/2005 08:00'!
isBreakableAt: index in: text

	| prev |
	index = 1 ifTrue: [^ false].
	prev := text at: index - 1.
	prev leadingChar ~= JapaneseEnvironment leadingChar ifTrue: [^ true].
	^ (('、。，．・：；？！゛゜´｀¨＾―‐／\〜‖｜…‥’”）〕］｝〉》」』】°′″℃' includes: (text at: index)) or: ['‘“（〔［｛〈《「『【°′″℃＠§' includes: prev]) not.
!]lang[(177 11 1 1 1 4 1 16 1 3 36 11 1 4 25)0,5,0,5,0,5,0,5,0,5,0,5,0,5,0! !

!JapaneseEnvironment class methodsFor: 'language methods' stamp: 'yo 3/16/2004 14:49'!
traditionalCharsetClass

	^ JISX0208.
! !

!JapaneseEnvironment class methodsFor: 'subclass responsibilities' stamp: 'yo 3/17/2004 21:55'!
leadingChar

	^ 5.
! !

!JapaneseEnvironment class methodsFor: 'language methods' stamp: 'tpr 10/3/2013 12:56'!
scanMultibyteCharactersFrom: startIndex to: stopIndex in: aWideString with: aCharacterScanner rightX: rightX font: aFont
	"scanning multibyte Japanese strings"
	^aFont scanMultibyteJapaneseCharactersFrom: startIndex to: stopIndex in: aWideString with: aCharacterScanner rightX: rightX! !

!Job commentStamp: '<historical>'!
A Job is a task to run and potentially notified to the user.  

 [:job | job title: 'Let us get started'.
	1to: 10 do: 
		[:each | 
			JobProgress progress: (0.1 * each); title: 'Youpi ', each printString .
			(Delay forMilliseconds: 100) wait. 
			] ]  asJob run!
!Job methodsFor: 'private' stamp: 'SeanDeNigris 8/29/2012 15:54'!
parent: aJob 

	parent := aJob.! !

!Job methodsFor: 'compatibility' stamp: 'SeanDeNigris 8/29/2012 14:37'!
decrement

	self currentValue: self currentValue - 1.! !

!Job methodsFor: 'notification-handling' stamp: 'CamilloBruni 9/1/2012 12:55'!
handleJobProgress: notification
	notification title ifNotNil: [ 
		title := notification title ].
	notification progress ifNotNil: [ 
		self basicProgress: notification progress ].
	self announceChange.! !

!Job methodsFor: 'private' stamp: 'SeanDeNigris 8/29/2012 15:53'!
addChild: aJob

	children add: aJob.
	aJob parent: self.! !

!Job methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 13:46'!
max
	
	^ max! !

!Job methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 15:11'!
children

	^ children copy.! !

!Job methodsFor: 'private' stamp: 'CamilloBruni 8/30/2012 17:37'!
cleanupAfterRunning
	isRunning := false.
	process := nil.
	self announce: JobEnd.
	parent ifNotNil: [ :job | job removeChild: self ].! !

!Job methodsFor: 'accessing' stamp: 'StephanEggermont 9/3/2013 15:57'!
announce: anAnnouncementClass

	| announcement |
	announcement := anAnnouncementClass on: self.
	self announcer announce: announcement.! !

!Job methodsFor: 'private' stamp: 'SeanDeNigris 8/29/2012 15:54'!
removeChild: aJob 

	children remove: aJob.! !

!Job methodsFor: 'compatibility' stamp: 'SeanDeNigris 8/29/2012 14:37'!
increment

	self currentValue: self currentValue + 1.! !

!Job methodsFor: 'compatibility' stamp: 'SeanDeNigris 8/29/2012 14:36'!
value

	^ self currentValue.! !

!Job methodsFor: 'compatibility' stamp: 'SeanDeNigris 8/29/2012 14:33'!
value: aNumber

	self currentValue: aNumber.! !

!Job methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 13:46'!
title
	
	^ title! !

!Job methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 16:11'!
title: anObject
	
	title := anObject.
	self announceChange.! !

!Job methodsFor: 'initialization' stamp: 'CamilloBruni 8/31/2012 09:32'!
initialize

	super initialize.
	min := 0.
	max := 100.
	currentValue := 0.
	title := ''.
	isRunning := false.
	children := OrderedCollection new.! !

!Job methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2012 09:22'!
isRunning
	^ isRunning! !

!Job methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 13:46'!
currentValue
	
	^ currentValue! !

!Job methodsFor: 'progress' stamp: 'CamilloBruni 9/1/2012 12:55'!
progress: aNormalizedFloat
	"Set the progress: 0.0 - 1.0"
	self basicProgress: aNormalizedFloat.
	self announceChange.! !

!Job methodsFor: 'progress' stamp: 'ChristopheDemarey 4/12/2013 13:53'!
progress
	"Avoid negative progress and divideByZero."
	^ min >= max ifTrue: [ 1 ] ifFalse: [ (currentValue - min) / (max - min) ]! !

!Job methodsFor: 'accessing' stamp: 'CamilloBruni 9/1/2012 13:08'!
migrateProgressWhileUpdatingBounds: aBlockChangingBounds
	"Keep the progress value consistent while we change min / max"
	| progress |
	progress := self progress.
	aBlockChangingBounds value.
	self progress: progress.! !

!Job methodsFor: 'compatibility' stamp: 'SeanDeNigris 8/29/2012 14:34'!
label: aString 

	self title: aString.! !

!Job methodsFor: 'notification-handling' stamp: 'TorstenBergmann 1/23/2015 11:39'!
handleJobStart: aJobStartNotification

	self addChild: aJobStartNotification job.! !

!Job methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 16:10'!
announceChange

	isRunning ifFalse: [ ^ self ].
	self announce: JobChange.! !

!Job methodsFor: 'progress' stamp: 'TorstenBergmann 1/23/2015 11:39'!
announcer

	^ self class jobAnnouncer! !

!Job methodsFor: 'compatibility' stamp: 'SeanDeNigris 8/29/2012 14:12'!
current: aNumber

	self currentValue: aNumber.! !

!Job methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 13:46'!
block
	
	^ block! !

!Job methodsFor: 'private' stamp: 'CamilloBruni 9/1/2012 12:55'!
basicProgress: aNormalizedFloat
	"Set the progress: 0.0 - 1.0 without triggering an update"
	currentValue := (min + ((max - min) * aNormalizedFloat))! !

!Job methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 16:11'!
currentValue: aNumber
	
	currentValue := aNumber.
	self announceChange.! !

!Job methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 13:46'!
min
	
	^ min! !

!Job methodsFor: 'accessing' stamp: 'CamilloBruni 9/1/2012 13:04'!
max: aNumber
	self migrateProgressWhileUpdatingBounds: [ max := aNumber ].! !

!Job methodsFor: 'accessing' stamp: 'CamilloBruni 9/1/2012 13:05'!
min: aNumber
	self migrateProgressWhileUpdatingBounds: [ min := aNumber ].
	self announceChange.! !

!Job methodsFor: 'private' stamp: 'SeanDeNigris 8/29/2012 13:42'!
block: aBlock
	
	block := aBlock.! !

!Job methodsFor: 'running' stamp: 'CamilloBruni 10/9/2012 14:22'!
run

	| result |
	[
		self prepareForRunning.
		[ result := block cull: self ]
			on: JobNotification
			do: [ :notification | notification handle: self ]]
		ensure: [ self cleanupAfterRunning ].
	
	^ result.! !

!Job methodsFor: 'compatibility' stamp: 'SeanDeNigris 8/29/2012 14:35'!
label

	^ self title.! !

!Job methodsFor: 'debugging' stamp: 'CamilloBruni 8/31/2012 09:23'!
debug
	^ process debug! !

!Job methodsFor: 'compatibility' stamp: 'SeanDeNigris 8/29/2012 14:36'!
current

	^ self currentValue.! !

!Job methodsFor: 'private' stamp: 'CamilloBruni 10/5/2012 17:07'!
prepareForRunning

	isRunning := true.
	JobStartNotification on: self.
	process := Processor activeProcess.
	self announce: JobStart.! !

!Job class methodsFor: 'examples' stamp: 'TorstenBergmann 9/5/2014 14:56'!
example2
	"Job example2"
	[[ :job| 
		job max: 10.
		1 to: 10 do: [ :i|
			job title: 'Fib ', i asString.
			"do some hard work"
			40 benchFib.
			"update the job progress"
			job currentValue: i ]
	] asJob run] fork.! !

!Job class methodsFor: 'announcing' stamp: 'TorstenBergmann 1/23/2015 11:38'!
jobAnnouncer
	"Answers the announcer for job announcements"
	
	^ jobAnnouncer 
			ifNil: [ jobAnnouncer := Announcer new ]! !

!Job class methodsFor: 'examples' stamp: 'TorstenBergmann 9/5/2014 15:02'!
example
	"Job example"
	[ :job| 
		job title: 'Simulating some progress for 1 Second'. 
		1 second asDelay wait. "simulate some work".
		job currentValue: 50.
		1 second asDelay wait. "simulate some more work". 
		job currentValue: 100.
		1 second asDelay wait. "simulate some more work". 
	] asJob run.! !

!Job class methodsFor: 'instance creation' stamp: 'TorstenBergmann 1/23/2015 11:37'!
block: aBlock

	^(self new)
		block: aBlock;
		yourself! !

!Job class methodsFor: 'accessing' stamp: 'MartinDias 11/26/2013 17:10'!
current
	"Answer the current job or nil if none."

	^ JobDetector signal! !

!Job class methodsFor: 'examples' stamp: 'CamilloBruni 8/30/2012 17:39'!
exampleDebug
	"Job exampleDebug"
	| aJob |
	aJob := [ :job| 
		"Set some job properties"
		job 
			title: 'aTitle';
			max: 10.
		1 to: 10 do: [ :i|
			job title: 'Fib ', i asString.
			"do some hard work"
			40 benchFib.
			"update the job progress"
			job currentValue: i. ]
	] asJob.
	
	"run a different thread to interrupt the job"
	[ aJob run ] forkAt: Processor userBackgroundPriority.
	1 second asDelay wait. "wait for the job to start properly"
	aJob debug
	! !

!JobChange commentStamp: '<historical>'!
A JobChange is an announcement for a job change. To get notify

SystemAnnouncer uniqueInstance 
	on: JobChange send: #XXX to: whoever.!
!JobChange methodsFor: 'accessing' stamp: 'CamilloBruni 9/1/2012 13:16'!
min
	^ job min! !

!JobChange methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 14:17'!
job
	
	^ job! !

!JobChange methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 14:17'!
job: anObject
	
	job := anObject! !

!JobChange methodsFor: 'accessing' stamp: 'CamilloBruni 9/1/2012 13:16'!
title
	^ job title! !

!JobChange methodsFor: 'accessing' stamp: 'CamilloBruni 9/1/2012 13:16'!
max
	^ job max! !

!JobChange methodsFor: 'accessing' stamp: 'CamilloBruni 9/1/2012 13:16'!
progress
	^ job progress! !

!JobChange class methodsFor: 'instance creation' stamp: 'SeanDeNigris 8/29/2012 14:38'!
on: aJob 

	^ self new job: aJob.! !

!JobDetector commentStamp: '<historical>'!
I am a notification for getting the current job, if there is one. 

Usage: 

JobDetector signal.

The result is nil when there is not a current job.!
!JobDetector methodsFor: 'handling' stamp: 'MartinDias 11/26/2013 15:33'!
handle: aJob 
	self resume: aJob! !

!JobEnd commentStamp: '<historical>'!
A JobChange is an announcement for a job end.

A JobChange is an announcement for a job change. To get notify

SystemAnnouncer uniqueInstance 
	on: JobEnd send: #XXX to: whoever.!
!JobEnd methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 14:08'!
job
	
	^ job! !

!JobEnd methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 14:08'!
job: anObject
	
	job := anObject! !

!JobEnd class methodsFor: 'instance creation' stamp: 'SeanDeNigris 8/29/2012 14:38'!
on: aJob 

	^ self new job: aJob.! !

!JobNotification commentStamp: '<historical>'!
A JobNotification class is an abstract class representing the root of JobNotification.!
!JobNotification methodsFor: 'handling' stamp: 'CamilloBruni 9/1/2012 12:48'!
handle: aJob
	self subclassResponsibility! !

!JobProgress commentStamp: '<historical>'!
A JobProgress is a notification to announce job progress. 

For example:

[:job | job title: 'Let us get started'.
	1to: 10 do: 
		[:each | 
			JobProgress progress: 0.1* each ; title: 'Youpi ', each printString .
			(Delay forMilliseconds: 100) wait. 
			] ]  asJob run!
!JobProgress methodsFor: 'handling' stamp: 'CamilloBruni 9/1/2012 12:52'!
handle: aJob
	aJob handleJobProgress: self.
	self resume.! !

!JobProgress methodsFor: 'accessing' stamp: 'CamilloBruni 9/1/2012 12:51'!
title
	
	^ title! !

!JobProgress methodsFor: 'accessing' stamp: 'CamilloBruni 9/1/2012 12:51'!
title: anObject
	
	title := anObject! !

!JobProgress methodsFor: 'accessing' stamp: 'CamilloBruni 9/1/2012 12:51'!
progress: anObject
	
	progress := anObject! !

!JobProgress methodsFor: 'accessing' stamp: 'CamilloBruni 9/1/2012 12:51'!
progress
	
	^ progress! !

!JobProgress class methodsFor: 'instance-creation' stamp: 'CamilloBruni 9/1/2012 12:51'!
title: aTitleString progress: aNormalizedNumber 
	self new 	
		title: aTitleString;
		progress: aNormalizedNumber;
		signal.! !

!JobProgress class methodsFor: 'instance-creation' stamp: 'CamilloBruni 9/1/2012 12:51'!
title: aTitleString 
	self new 	
		title: aTitleString;
		signal.! !

!JobProgress class methodsFor: 'instance-creation' stamp: 'CamilloBruni 9/1/2012 12:51'!
progress: aNormalizedNumber 
	self new 
		progress: aNormalizedNumber;
		signal.! !

!JobProgressBarMorph commentStamp: '<historical>'!
A JobProgressBarMorph is a progress bar with a title and a icon to stop update.

JobProgressBarMorph new openInWorld!
!JobProgressBarMorph methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 8/30/2012 19:04'!
increment
	^ progressBar increment! !

!JobProgressBarMorph methodsFor: 'initialization' stamp: 'CamilloBruni 9/14/2013 16:41'!
initialize
	super initialize.
	progressBar := ProgressBarMorph new.
	progressBar hResizing: #spaceFill.
	button := Smalltalk ui icons stopIcon asMorph.
	self extent: 200@20.
	self
		color: Color transparent;
		layoutPolicy: TableLayout new;
		listDirection: #leftToRight;
		cellPositioning: #leftCenter;
		cellInset: 3;
		listCentering: #center;
		hResizing: #spaceFill;
		vResizing: #shrinkWrap.
	
	self 
		addMorphBack: progressBar;
		addMorphBack: button.! !

!JobProgressBarMorph methodsFor: 'evaluating' stamp: 'CamilloBruni 8/30/2012 19:04'!
value
	^ progressBar value! !

!JobProgressBarMorph methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 8/30/2012 19:04'!
decrement
	^ progressBar decrement! !

!JobProgressBarMorph methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 8/30/2012 19:04'!
value: aNumber
	^ progressBar value: aNumber! !

!JobProgressBarMorph methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 9/1/2012 13:18'!
progress: aNormalizedNumber
	^ progressBar value: aNormalizedNumber * 100! !

!JobProgressBarMorph methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 9/1/2012 13:18'!
progress
	^ progressBar value / 100! !

!JobProgressMorph commentStamp: '<historical>'!
I combine a progress title and a JobPorgressBarMorph to a visual representation of a Job.

Usually I am contained in the global instance of the SystemProgressMorph!
!JobProgressMorph methodsFor: 'private' stamp: 'MarcusDenker 9/13/2013 16:18'!
updateLayout

	labelMorph contents isEmpty
		ifFalse: [ self addMorphBack: labelMorph].
	self addMorphBack: bar.! !

!JobProgressMorph methodsFor: 'API' stamp: 'SeanDeNigris 5/14/2012 19:49'!
decrement

	bar decrement.! !

!JobProgressMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 2/19/2013 15:29'!
close

	SystemProgressMorph uniqueInstance close: self.
	self removeDependent: SystemProgressMorph uniqueInstance.! !

!JobProgressMorph methodsFor: 'private' stamp: 'SeanDeNigris 5/23/2012 00:22'!
forceRefreshOnNextChange

	lastRefresh := 0.! !

!JobProgressMorph methodsFor: 'private' stamp: 'Sd 11/30/2012 21:42'!
result

	^ result! !

!JobProgressMorph methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 2/19/2013 16:13'!
changed

	| msRefreshRate isTimeForRefresh |
	msRefreshRate := 60 "roughly 16 times per second".
	isTimeForRefresh := Time millisecondClockValue - self lastRefresh >= msRefreshRate.
	(self isInWorld and: [ isTimeForRefresh ]) ifTrue: [ 
		super changed ].! !

!JobProgressMorph methodsFor: 'API' stamp: 'SeanDeNigris 5/14/2012 19:49'!
increment

	bar increment.! !

!JobProgressMorph methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 23:05'!
initialize

	super initialize.

	self addDependent: SystemProgressMorph uniqueInstance.! !

!JobProgressMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/19/2013 15:34'!
lastRefresh
	^ lastRefresh ifNil: [  lastRefresh := 0 ]! !

!JobProgressMorph methodsFor: 'private' stamp: 'SeanDeNigris 5/14/2012 15:09'!
start: aNumber

	startValue := aNumber.! !

!JobProgressMorph methodsFor: 'API' stamp: 'BenjaminVanRyseghem 3/1/2013 17:52'!
progress: aNormalizedNumber
	bar progress = aNormalizedNumber
		ifFalse: [ 
			bar progress: aNormalizedNumber.
			self changed: #progressValue ].! !

!JobProgressMorph methodsFor: 'API' stamp: 'CamilloBruni 9/1/2012 13:19'!
progress

	^ bar progress! !

!JobProgressMorph methodsFor: 'API' stamp: 'BenjaminVanRyseghem 3/1/2013 17:47'!
label: aString

	self label isEmpty ifTrue: [ 
		aString isEmptyOrNil 
			ifTrue: [ ^self ].
		self removeAllMorphs.
		self labelMorph contents: aString.
		self updateLayout.
		self changed: #width ].
	
	self labelMorph contents = aString
		ifFalse: [ 
			self labelMorph contents: aString.
			aString isEmptyOrNil 
				ifTrue: [ self removeMorph: self labelMorph ].
			self changed: #width ].
		
	self changed: #width! !

!JobProgressMorph methodsFor: 'API' stamp: 'SeanDeNigris 6/20/2012 23:24'!
current: aNumber

	bar value: aNumber.
	self changed.! !

!JobProgressMorph methodsFor: 'private' stamp: 'Sd 11/30/2012 21:42'!
max: aNumber
 
	endValue := aNumber! !

!JobProgressMorph methodsFor: 'private' stamp: 'StephaneDucasse 5/20/2012 19:39'!
startAt: aNumber
 
	startValue := aNumber.! !

!JobProgressMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 2/19/2013 16:04'!
refresh

	lastRefresh := Time millisecondClockValue.	
	self width: (labelMorph width) + 25.! !

!JobProgressMorph methodsFor: 'private' stamp: 'SeanDeNigris 5/14/2012 15:23'!
labelMorph

	^ labelMorph.! !

!JobProgressMorph methodsFor: 'accessing' stamp: 'CamilloBruni 8/30/2012 19:27'!
job: aJob
	job := aJob! !

!JobProgressMorph methodsFor: 'API' stamp: 'SeanDeNigris 5/22/2012 20:18'!
label
	
	^ self labelMorph contents.! !

!JobProgressMorph methodsFor: 'private' stamp: 'SeanDeNigris 5/23/2012 00:40'!
do: aBlock

	self changed. "We may be in the UI thread, so this will give us a change to dsiplay ourselves before the block starts"
	^ [ aBlock value: self ] ensure: [ self close ].! !

!JobProgressMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 2/19/2013 15:34'!
initializeJob: aJob

	super initialize.
	
	lock := Semaphore forMutualExclusion.
	job := aJob.
	hasResult := false.
	lastRefresh := 0.
	
	self
		color: Color transparent;
		layoutPolicy: TableLayout new;
		listDirection: #topToBottom;
		cellPositioning: #leftCenter;
		listCentering: #center;
		hResizing: #spaceFill;
		vResizing: #shrinkWrap.
		
	labelMorph := StringMorph 
		contents: job title 
		font: StandardFonts defaultFont.
	bar := JobProgressBarMorph new.
	bar 
		on: #mouseUp send: #debug to: self;
		hResizing: #spaceFill.
	self updateLayout.! !

!JobProgressMorph methodsFor: 'action' stamp: 'CamilloBruni 8/31/2012 09:21'!
debug
	job isRunning ifTrue: [ job debug ].! !

!JobProgressMorph methodsFor: 'API' stamp: 'SeanDeNigris 5/14/2012 19:48'!
current

	^ bar value.! !

!JobProgressMorph methodsFor: 'API' stamp: 'SeanDeNigris 5/23/2012 00:25'!
beComplete

	self close.! !

!JobProgressMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 2/19/2013 15:35'!
result: anObject
	lock critical: [ 
		hasResult := true.
		result := anObject ].! !

!JobProgressMorph class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/30/2012 19:31'!
job: aJob
	^ self new initializeJob: aJob! !

!JobStart commentStamp: '<historical>'!
A JobStart is announcement announcing the start of a job execution.

SystemAnnouncer uniqueInstance 
	on: JobStart send: #XXX to: whoever.!
!JobStart methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 13:56'!
job
	
	^ job! !

!JobStart methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 13:56'!
job: anObject
	
	job := anObject! !

!JobStart class methodsFor: 'instance creation' stamp: 'SeanDeNigris 8/29/2012 14:38'!
on: aJob 

	^ self new job: aJob.! !

!JobStartNotification commentStamp: '<historical>'!
A JobStartNotification is the first notification raised when a job start.!
!JobStartNotification methodsFor: 'accessing' stamp: 'CamilloBruni 8/31/2012 11:00'!
job: anObject
	
	job := anObject! !

!JobStartNotification methodsFor: 'handling' stamp: 'CamilloBruni 9/1/2012 12:52'!
handle: aJob
	aJob handleJobStart: self.
	self resume.! !

!JobStartNotification methodsFor: 'accessing' stamp: 'CamilloBruni 8/31/2012 11:00'!
job
	
	^ job! !

!JobStartNotification class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/31/2012 11:00'!
on: aJob

	^ (self new job: aJob) signal.! !

!JobTest commentStamp: 'TorstenBergmann 2/5/2014 08:39'!
SUnit tests for Job class!
!JobTest methodsFor: 'tests' stamp: 'CamilloBruni 9/1/2012 13:00'!
testProgressNotification
	| wasRun |
	wasRun := false.
	[ :job | 
		"job precondition"
		self assert: job title equals: ''.
		self assert: job progress equals: 0.
		
		JobProgress title: 'foo' progress: 0.5.
		self assert: job title equals: 'foo'.
		self assert: job progress equals: 0.5.
		
		wasRun := true ] asJob run.	
	self assert: wasRun.! !

!JobTest methodsFor: 'tests' stamp: 'CamilloBruni 9/1/2012 13:00'!
testProgressNotificationChildJob
	
	| wasRun |
	
	wasRun := false.
	
	[ :job | 
		"job precondition"
		self assert: job title equals: ''.
		self assert: job progress equals: 0.
		[ :job2 | 
			"job2 precondition"
			self assert: job2 title equals: ''.
			self assert: job2 progress equals: 0.
			"signal a JobProgress which will only affect the inner job"
			JobProgress title: 'foo' progress: 0.5.
			self assert: job2 title equals: 'foo'.
			self assert: job2 progress equals: 0.5.
			"outer job is not touched"
			self assert: job title equals: ''.
			self assert: job progress equals: 0.
		
			wasRun := true ] asJob run.
	
		self assert: job children isEmpty ] asJob run.
	
	self assert: wasRun.! !

!JobTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2012 09:32'!
testProgressChangeByCurrentValue
	| job |
	job := Job new.
	job min: 1; max: 11.
	self assert: job progress equals: 0.0.
	job currentValue: 6.
	self assert: job progress equals: 0.5.
	job currentValue: 11.
	self assert: job progress equals: 1.0.! !

!JobTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2012 09:32'!
testProgress
	| job |
	job := Job new.
	self assert: job progress equals: 0.0.
	job min: 0; max: 1.
	self assert: job progress equals: 0.0.
	job currentValue: 1.
	self assert: job progress equals: 1.0.! !

!JobTest methodsFor: 'tests' stamp: 'PavelKrivanek 11/13/2012 10:29'!
tearDown

	Smalltalk globals at: #SystemProgressMorph ifPresent: [:spm | 
		spm uniqueInstance bars do: [ :e | e close ]] ! !

!JobTest methodsFor: 'tests' stamp: 'CamilloBruni 8/30/2012 17:44'!
testChildJob
	
	| wasRun |
	
	wasRun := false.
	
	[ :job | 
	
		[ :job2 | 
			self assert: job children size = 1.
			self assert: job children first = job2.
			wasRun := true ] asJob run.
	
		self assert: job children isEmpty ] asJob run.
	
	self assert: wasRun.! !

!JobTest methodsFor: 'tests' stamp: 'CamilloBruni 9/1/2012 12:56'!
testSingleJob

	| wasRun |
	wasRun := false.
	[ :job | 
		self assert: job children isEmpty.
		wasRun := true ] asJob run.	
	self assert: wasRun.! !

!JoinSection methodsFor: 'accessing' stamp: 'gvc 11/1/2006 14:19'!
dst: anObject
	"Set the value of dst"

	dst := anObject! !

!JoinSection methodsFor: 'as yet unclassified' stamp: 'BenjaminVanRyseghem 11/25/2012 04:07'!
newHighlight
	"Anwser a new highlight."

	^TextHighlightByBounds new
		borderWidth: 1;
		borderColor: self borderColor;
		fillWidth: true! !

!JoinSection methodsFor: 'accessing' stamp: 'gvc 11/1/2006 14:19'!
dstOffset: aPoint
	"Set the dst offset."

	self dst offset:  aPoint.
	self updateShape! !

!JoinSection methodsFor: 'accessing' stamp: 'gvc 11/1/2006 14:19'!
src
	"Answer the value of src"

	^ src! !

!JoinSection methodsFor: 'as yet unclassified' stamp: 'gvc 11/1/2006 14:22'!
borderColorToUse
	"Answer the border color to use."
	
	^self borderColor! !

!JoinSection methodsFor: 'as yet unclassified' stamp: 'gvc 11/1/2006 14:19'!
wantsClick
	"Don't if we are transparent for now."

	^(self src color isTransparent and: [self dst color isTransparent]) not! !

!JoinSection methodsFor: 'accessing' stamp: 'gvc 11/1/2006 14:19'!
srcOffset: aPoint
	"Set the src offset"

	self src offset:  aPoint.
	self updateShape! !

!JoinSection methodsFor: 'as yet unclassified' stamp: 'gvc 11/1/2006 14:17'!
clicked
	"The receiver or a highlight was clicked."

	self wantsClick ifFalse: [^false].
	^true! !

!JoinSection methodsFor: 'accessing' stamp: 'gvc 11/1/2006 14:19'!
dstRange: anInterval
	"Set the dst range."

	self dst range: anInterval.
	self updateShape! !

!JoinSection methodsFor: 'accessing' stamp: 'gvc 11/1/2006 14:19'!
src: anObject
	"Set the value of src"

	src := anObject! !

!JoinSection methodsFor: 'initialization' stamp: 'gvc 11/1/2006 14:20'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		src: JoinSide new;
		dst: JoinSide new;
		shape: Polygon new;
		width: 0;
		borderWidth: 0;
		borderColor: Color transparent;
		type: #modification! !

!JoinSection methodsFor: 'accessing' stamp: 'gvc 11/1/2006 14:19'!
dstLineRange: anInterval
	"Set the dst lineRange."

	self dst lineRange: anInterval! !

!JoinSection methodsFor: 'accessing' stamp: 'gvc 11/1/2006 14:16'!
borderWidth: anInteger
	"Set the value of borderWidth"

	borderWidth := anInteger.
	self src highlight notNil ifTrue: [
		self src highlight borderWidth: anInteger].
	self dst highlight notNil ifTrue: [
		self dst highlight borderWidth: anInteger]! !

!JoinSection methodsFor: 'accessing' stamp: 'gvc 11/1/2006 14:16'!
borderColor
	"Answer the value of borderColor"

	^ borderColor! !

!JoinSection methodsFor: 'as yet unclassified' stamp: 'BenjaminVanRyseghem 11/25/2012 04:08'!
addHighlightsFrom: srcBlock to: dstBlock to: aCollection color: aColor
	"Add the highlights required for the given character blocks
	of a paragraph. May be up to three highlights depending
	on the line spans."
	
	srcBlock textLine = dstBlock textLine
		ifTrue: [aCollection add: (TextHighlightByBounds new
				color: aColor;
				bounds: (srcBlock topLeft corner: dstBlock bottomRight))]
		ifFalse: [aCollection
					add: (TextHighlightByBounds new
							color: aColor;
							bounds: (srcBlock topLeft corner: srcBlock textLine bottomRight));
					add: (TextHighlightByBounds new
							fillWidth: true;
							color: aColor;
							bounds: (srcBlock bottomLeft corner: dstBlock topRight));
					add: (TextHighlightByBounds new
							color: aColor;
							bounds: (dstBlock textLine topLeft corner: dstBlock bottomRight))]! !

!JoinSection methodsFor: 'accessing' stamp: 'gvc 11/1/2006 14:16'!
borderWidth
	"Answer the value of borderWidth"

	^ borderWidth! !

!JoinSection methodsFor: 'accessing' stamp: 'gvc 11/1/2006 14:19'!
type
	"Answer the value of type"

	^ type! !

!JoinSection methodsFor: 'accessing' stamp: 'gvc 11/1/2006 14:19'!
type: anObject
	"Set the value of type"

	type := anObject! !

!JoinSection methodsFor: 'as yet unclassified' stamp: 'gvc 11/1/2006 14:18'!
containsPoint: aPoint
	"Answer whether the receiver contains the given point."

	^self shape containsPoint: aPoint! !

!JoinSection methodsFor: 'accessing' stamp: 'gvc 11/1/2006 14:21'!
width: anObject
	"Set the value of width"

	width := anObject.
	self updateShape! !

!JoinSection methodsFor: 'as yet unclassified' stamp: 'gvc 11/1/2006 14:23'!
drawOn: aCanvas
	"Draw the join on the given canvas."
	
	|v bc|
	(self src color isTransparent and: [self dst color isTransparent])
		ifTrue: [^self].
	v := self shape vertices.
	aCanvas
		drawPolygon: v
		fillStyle: (self fillStyleFor: self shape bounds).
	(self borderWidth > 0 and: [self borderColor isTransparent not]) ifTrue: [
		bc := self borderColorToUse.
		aCanvas
			line: v first + (0@self borderWidth // 2)
			to: v second + (-1@self borderWidth // 2)
			width: self borderWidth
			color: bc;
			line: v third - (1@(self borderWidth // 2))
			to: v fourth - (0@(self borderWidth // 2))
			width: self borderWidth
			color: bc]! !

!JoinSection methodsFor: 'accessing' stamp: 'gvc 11/1/2006 14:19'!
dstColor: aColor
	"Set the dst color"

	self dst color: aColor! !

!JoinSection methodsFor: 'accessing' stamp: 'gvc 11/1/2006 14:21'!
width
	"Answer the value of width"

	^ width! !

!JoinSection methodsFor: 'as yet unclassified' stamp: 'gvc 11/1/2006 14:18'!
createHighlightsFrom: srcPara to: dstPara
	"Create and store the src and dst highlights.
	Use the given paragraphs to determine inline
	diffs."

	|s d si di  srcText dstText diffs i sb eb line|
	self createHighlights.
	self src lineRange notEmpty
		ifTrue: [ line := srcPara lines at: self src lineRange first.
				si := line first.
				line := srcPara lines at: self src lineRange last.
				srcText := srcPara string copyFrom: si to: line last]
		ifFalse: [srcText := ''].
	self dst lineRange notEmpty
		ifTrue: [line := dstPara lines at: self dst lineRange first.
				di := line first.
				line := dstPara lines at: self dst lineRange last.
				dstText := dstPara string copyFrom: di to: line last]
		ifFalse: [dstText := ''].
	self src text: srcText.
	self dst text: dstText.
	self type = #modification ifFalse: [^self].
	s := self src highlights.
	d := self dst highlights.
	diffs := (InlineTextDiffBuilder from: srcText to: dstText)
		buildPatchSequence
			aggregateRuns: [:e | e key].
	diffs do: [:c |
		c first key = #match
			ifTrue: [c do: [:a |
					si := si + a value size.
					di := di + a value size]].
		c first key = #insert
			ifTrue: [i := di.
					c do: [:a | di := di + a value size].
					sb := dstPara characterBlockForIndex: i.
					eb := dstPara characterBlockForIndex: di - 1.
					self addHighlightsFrom: sb to: eb to: d color: (Color green alpha: 0.3)].
		c first key = #remove
			ifTrue: [i := si.
					c do: [:a | si := si + a value size].
					sb := srcPara characterBlockForIndex: i.
					eb := srcPara characterBlockForIndex: si - 1.
					self addHighlightsFrom: sb to: eb to: s color: (Color red alpha: 0.3)]]! !

!JoinSection methodsFor: 'accessing' stamp: 'gvc 11/1/2006 14:19'!
srcLineRange: anInterval
	"Set the src lneRange."

	self src lineRange: anInterval! !

!JoinSection methodsFor: 'as yet unclassified' stamp: 'gvc 11/1/2006 14:24'!
drawMapOn: aCanvas in: rect scale: scale
	"Draw the join on the given canvas scaled into the given rectangle."
	
	self type = #match ifTrue: [^self].
	aCanvas
		frameAndFillRectangle: (rect left @ (((self dst range first max: 0) * scale) truncated + rect top)
						corner: (rect right @ ((self dst range last * scale) truncated + rect top)))
		fillColor: (self fillStyleFor: rect)
		borderWidth: 1
		borderColor: self borderColorToUse! !

!JoinSection methodsFor: 'accessing' stamp: 'gvc 11/1/2006 14:19'!
srcRange: anInterval
	"Set the  src range"

	self src range: anInterval.
	self updateShape! !

!JoinSection methodsFor: 'as yet unclassified' stamp: 'gvc 11/1/2006 14:19'!
fillStyleFor: rect
	"Answer the fillStyle to use for the given rectangle."
	
	^self src color = self dst color
		ifTrue: [self src color]
		ifFalse: [(GradientFillStyle ramp: {0.0 -> self src color. 1.0 -> self dst color})
				direction: rect width@0;
				origin: rect topLeft]! !

!JoinSection methodsFor: 'accessing' stamp: 'gvc 11/1/2006 14:28'!
updateHighlights
	"Update the highlight border colors."

	|bc|
	(self src isNil or: [self dst isNil]) ifTrue: [^self].
	bc := self borderColorToUse.
	self src highlight notNil ifTrue: [
		self src highlight borderColor: bc].
	self dst highlight notNil ifTrue: [
		self dst highlight borderColor: bc]! !

!JoinSection methodsFor: 'accessing' stamp: 'gvc 11/1/2006 14:19'!
shape
	"Answer the value of shape"

	^ shape! !

!JoinSection methodsFor: 'accessing' stamp: 'gvc 11/1/2006 14:19'!
shape: anObject
	"Set the value of shape"

	shape := anObject! !

!JoinSection methodsFor: 'accessing' stamp: 'gvc 11/1/2006 14:19'!
dst
	"Answer the value of dst"

	^ dst! !

!JoinSection methodsFor: 'accessing' stamp: 'gvc 11/1/2006 14:16'!
borderColor: aColor
	"Set the value of borderColor"

	borderColor := aColor.
	self updateHighlights! !

!JoinSection methodsFor: 'as yet unclassified' stamp: 'gvc 11/1/2006 14:18'!
createHighlights
	"Create and store the src and dst highlights."

	|s d|
	s := OrderedCollection new.
	d := OrderedCollection new.
	s add: (self newHighlight
			color: self src color;
			borderWidth: self borderWidth;
			bounds: (0@self src range first corner: 0@(self src range last + 1));
			borderSides: #(top left bottom)).
	d add: (self newHighlight
			color: self dst color;
			borderWidth: self borderWidth;
			bounds: (0@self dst range first corner: 0@(self dst range last + 1));
			borderSides: #(top right bottom)).
	self src highlights: s.
	self dst highlights: d! !

!JoinSection methodsFor: 'accessing' stamp: 'gvc 11/1/2006 14:19'!
srcColor: aColor
	"Set the src color."

	self src color: aColor! !

!JoinSection methodsFor: 'as yet unclassified' stamp: 'gvc 11/1/2006 14:19'!
updateShape
	"Update the receiver's shape."

	(self src range isNil or: [self dst range isNil]) ifTrue: [^self].
	self shape: (Polygon vertices:
		{(0@ self src range first) + self src offset. (self width @ self dst range first) + self dst offset.
		(self width @ self dst range last) + self dst offset. (0@self src range last) + self src offset})! !

!JoinSide methodsFor: 'accessing' stamp: 'gvc 11/1/2006 10:41'!
lineRange
	"Answer the value of lineRange"

	^ lineRange! !

!JoinSide methodsFor: 'accessing' stamp: 'gvc 11/1/2006 10:41'!
offset
	"Answer the value of offset"

	^ offset! !

!JoinSide methodsFor: 'as yet unclassified' stamp: 'gvc 11/1/2006 10:58'!
highlight
	"Answer the primary highlight."

	^(self highlights ifEmpty: [^nil]) first! !

!JoinSide methodsFor: 'accessing' stamp: 'gvc 11/1/2006 11:09'!
text: anObject
	"Set the value of text"

	text := anObject! !

!JoinSide methodsFor: 'accessing' stamp: 'gvc 11/1/2006 10:41'!
color: anObject
	"Set the value of color"

	color := anObject! !

!JoinSide methodsFor: 'accessing' stamp: 'gvc 11/1/2006 10:41'!
lineRange: anObject
	"Set the value of lineRange"

	lineRange := anObject! !

!JoinSide methodsFor: 'accessing' stamp: 'gvc 11/1/2006 10:41'!
highlights
	"Answer the value of highlights"

	^ highlights! !

!JoinSide methodsFor: 'accessing' stamp: 'gvc 11/1/2006 11:09'!
text
	"Answer the value of text"

	^ text! !

!JoinSide methodsFor: 'initialization' stamp: 'gvc 11/1/2006 11:09'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		highlights: #();
		offset: 0@0;
		range: (1 to: 1);
		lineRange: (1 to: 0);
		color: Color yellow;
		text: ''! !

!JoinSide methodsFor: 'accessing' stamp: 'gvc 11/1/2006 10:41'!
range
	"Answer the value of range"

	^ range! !

!JoinSide methodsFor: 'accessing' stamp: 'gvc 11/1/2006 10:41'!
range: anObject
	"Set the value of range"

	range := anObject! !

!JoinSide methodsFor: 'accessing' stamp: 'gvc 11/1/2006 10:41'!
color
	"Answer the value of color"

	^ color! !

!JoinSide methodsFor: 'accessing' stamp: 'gvc 11/1/2006 10:41'!
offset: anObject
	"Set the value of offset"

	offset := anObject! !

!JoinSide methodsFor: 'accessing' stamp: 'gvc 11/1/2006 10:41'!
highlights: anObject
	"Set the value of highlights"

	highlights := anObject! !

!KMAltModifier commentStamp: '<historical>'!
I represent the Alt key modifier. Look at my superclass for a more detailed explanaition.!
!KMAltModifier methodsFor: 'matching' stamp: 'CamilloBruni 3/19/2011 20:50'!
matchesEvent: aKeyboardEvent
	^ aKeyboardEvent altKeyPressed! !

!KMAltModifier methodsFor: 'initialization' stamp: 'CamilloBruni 3/20/2011 23:54'!
initialize
	super initialize.
	identifier := #a.
	name := 'Alt'.! !

!KMAltModifier methodsFor: 'accessing' stamp: 'BenComan 2/23/2014 01:40'!
eventCode
	^64 ! !

!KMBuffer commentStamp: '<historical>'!
I am a buffer of keyboard events. I am checked against key combinations to see if there is a match.

I am cleared when the current morph loses focus or when a full match announcement is given.!
!KMBuffer methodsFor: 'adding' stamp: 'BenjaminVanRyseghem 7/3/2012 15:43'!
addEvent: anEvent

	buffer add: anEvent.
	currentEvent := anEvent.! !

!KMBuffer methodsFor: 'clearing' stamp: 'BenjaminVanRyseghem 7/3/2012 15:38'!
clearBuffer

	currentEvent := nil.
	buffer removeAll.! !

!KMBuffer methodsFor: 'initialization' stamp: 'GuillermoPolito 6/24/2012 12:03'!
initialize
	buffer := OrderedCollection new.! !

!KMBuffer methodsFor: 'accessing' stamp: 'GuillermoPolito 6/24/2012 12:08'!
buffer
	^buffer! !

!KMBuffer methodsFor: 'matching' stamp: 'BenjaminVanRyseghem 7/3/2012 14:55'!
completeMatch

	currentEvent ifNotNil:[ currentEvent wasHandled: true ].
	self clearBuffer.! !

!KMBuffer methodsFor: 'matching' stamp: 'BenjaminVanRyseghem 7/3/2012 15:45'!
partialMatch

	KMLog log: 'Partial match: ', currentEvent printString.
	currentEvent ifNotNil:[ currentEvent wasHandled: true ].! !

!KMBuffer class methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 6/24/2012 12:31'!
uniqueInstance: aBuffer
	uniqueInstance := aBuffer.! !

!KMBuffer class methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 6/24/2012 12:02'!
uniqueInstance
	^uniqueInstance ifNil: [ uniqueInstance := self new ].! !

!KMBuffer class methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 6/24/2012 12:02'!
resetUniqueInstance
	uniqueInstance := nil! !

!KMBuilder commentStamp: '<historical>'!
I am a keymap builder that is used when configuring keymappings by pragmas.

Send me the #shortcut: message with a keymap name, so I give you a specific builder to build a keymap.

You can also tell me to install a category as global.!
!KMBuilder methodsFor: 'keymap-building' stamp: 'GuillermoPolito 10/21/2011 01:26'!
shortcut: aKeymapName
	^KMKeymapBuilder 
		for: aKeymapName
		platform: platform! !

!KMBuilder methodsFor: 'accessing' stamp: 'GuillermoPolito 10/21/2011 00:12'!
platform: aPlatform
	platform := aPlatform! !

!KMBuilder methodsFor: 'keymap-building' stamp: 'GuillermoPolito 5/3/2013 15:49'!
setAsGlobalCategory: aGlobalCategory

	KMRepository default setAsGlobalCategory: aGlobalCategory! !

!KMBuilder class methodsFor: 'instance creation' stamp: 'GuillermoPolito 10/21/2011 00:08'!
keymap
	^self keymap: #all! !

!KMBuilder class methodsFor: 'instance creation' stamp: 'GuillermoPolito 10/21/2011 01:15'!
keymap: aPlatform
	(#( all Unix MacOSX Windows ) includes: aPlatform) ifFalse: [ self error: aPlatform, ' is not a valid platform' ].
	^self new
		platform: aPlatform;
		yourself! !

!KMCatcherMorph commentStamp: '<historical>'!
I am a morph that captures keymappings, so they can be used for configuration/customization, or debugging.!
!KMCatcherMorph methodsFor: 'event handling' stamp: 'StephaneDucasse 10/27/2014 09:34'!
showContextMenu
	| menu |
	menu := MenuMorph new defaultTarget: self.
	
	edited 
		ifTrue: [
			menu add: 'accept' selector: #accept.
			menu add: 'clear' selector: #clear.
			menu add: 'cancel' selector: #cancel.
			].
		
	menu popUpInWorld! !

!KMCatcherMorph methodsFor: 'event handling' stamp: 'GuillermoPolito 1/20/2011 00:50'!
clear
	self keystrokes removeAll.
	self showKeystrokes.! !

!KMCatcherMorph methodsFor: 'event handling' stamp: 'CamilloBruni 3/19/2011 00:09'!
handlesKeyboard: event
	^ focused! !

!KMCatcherMorph methodsFor: 'accessing' stamp: 'GuillermoPolito 1/20/2011 00:02'!
setMessage: aMessage 
	labelMorph contents: aMessage! !

!KMCatcherMorph methodsFor: 'event handling' stamp: 'GuillermoPolito 1/24/2011 00:53'!
keyStroke: aKeyStroke 
	edited := true.
	self keystrokes add: aKeyStroke.
	self showKeystrokes.! !

!KMCatcherMorph methodsFor: 'api' stamp: 'CamilloBruni 3/18/2011 23:11'!
cancel
	edited
		ifFalse: [ ^ self ].
	self keystrokes: OrderedCollection new.
	self showInitialShortcut.
	self initializeKeystrokes! !

!KMCatcherMorph methodsFor: 'halos and balloon help' stamp: 'CamilloBruni 3/18/2011 23:11'!
wantsBalloon
	^ true! !

!KMCatcherMorph methodsFor: 'drawing' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
drawOn: aCanvas
	"Indicate unaccepted edits, conflicts etc."

	super drawOn: aCanvas. 
	focused ifTrue: [
		Smalltalk ui theme drawTextAdornmentFor: self color: Color orange on: aCanvas]! !

!KMCatcherMorph methodsFor: 'initialization' stamp: 'CamilloBruni 3/20/2011 23:49'!
showInitialShortcut
	self setMessage: initialShortcut asString.! !

!KMCatcherMorph methodsFor: 'event handling' stamp: 'CamilloBruni 3/18/2011 23:11'!
allowsKeymapping
	^ false! !

!KMCatcherMorph methodsFor: 'event handling' stamp: 'CamilloBruni 3/19/2011 00:09'!
handlesMouseDown: event
	^ true! !

!KMCatcherMorph methodsFor: 'api' stamp: 'GuillermoPolito 3/19/2013 19:12'!
shortcut
	| theKeystrokes |
	theKeystrokes := self keystrokes.
	theKeystrokes 
		ifEmpty: [ ^ KMNoShortcut new ].
		
	^ theKeystrokes allButFirst 
		inject: theKeystrokes first asKeyCombination 
		into: [ :acum :each | 
			acum , each asKeyCombination ]! !

!KMCatcherMorph methodsFor: 'api' stamp: 'GuillermoPolito 1/20/2011 01:28'!
keystrokes: someKeystrokes
	keystrokes := someKeystrokes.
	self showKeystrokes.! !

!KMCatcherMorph methodsFor: 'event handling' stamp: 'GuillermoPolito 5/31/2011 12:42'!
keymapSetting: aSetting
	keymapSetting := aSetting.
	self initialShortcut: keymapSetting shortcut.! !

!KMCatcherMorph methodsFor: 'accessing' stamp: 'CamilloBruni 3/18/2011 23:11'!
balloonText
	^ 'Click to edit shortcut.  Right click to open context menu.'! !

!KMCatcherMorph methodsFor: 'api' stamp: 'GuillermoPolito 1/24/2011 01:31'!
accept
	| shortcut |
	shortcut := self shortcut.
	keymapSetting accept: shortcut.
	self initialShortcut: shortcut.
	edited := false.! !

!KMCatcherMorph methodsFor: 'api' stamp: 'CamilloBruni 3/20/2011 23:41'!
shortcutString
	| shortcut |
	self keystrokes 
		ifEmpty: [ ^ '' ].
	shortcut := self shortcut.
	^ shortcut asString! !

!KMCatcherMorph methodsFor: 'private' stamp: 'GuillermoPolito 1/24/2011 00:57'!
showKeystrokes
	self setMessage: self shortcutString.! !

!KMCatcherMorph methodsFor: 'event handling' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
keyboardFocusChange: aBoolean
	super keyboardFocusChange: aBoolean.
	focused := aBoolean.
	focused
		ifTrue: [ self color: (Smalltalk ui theme textEditorNormalFillStyleFor: self) ]
		ifFalse: [ self color: (Smalltalk ui theme textEditorDisabledFillStyleFor: self) ].
	^ true! !

!KMCatcherMorph methodsFor: 'initialization' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
initialize
	super initialize.
	self layoutPolicy: TableLayout new.
	self listCentering: #center.
	self width: 300.
	self height: 25.
	self color: (Smalltalk ui theme textEditorDisabledFillStyleFor: self).
	self borderStyle: (Smalltalk ui theme textEditorDisabledBorderStyleFor: self).
	
	labelMorph := StringMorph contents: ''.
	self addMorph: (labelMorph).
	
	edited := false.
	focused := false.
	self initializeKeystrokes.
	! !

!KMCatcherMorph methodsFor: 'api' stamp: 'CamilloBruni 3/18/2011 23:11'!
keystrokes
	^ keystrokes! !

!KMCatcherMorph methodsFor: 'event handling' stamp: 'CamilloBruni 3/19/2011 00:07'!
mouseDown: event 
	super mouseDown: event.
	event yellowButtonPressed 
		ifTrue: [ self showContextMenu ]
		ifFalse: [ World activeHand newKeyboardFocus: self ]! !

!KMCatcherMorph methodsFor: 'initialization' stamp: 'GuillermoPolito 1/24/2011 01:26'!
initializeKeystrokes
	keystrokes := OrderedCollection new.! !

!KMCatcherMorph methodsFor: 'initialization' stamp: 'GuillermoPolito 1/24/2011 01:26'!
initialShortcut: aShortcut
	initialShortcut := aShortcut.
	self showInitialShortcut.
	self initializeKeystrokes.! !

!KMCatcherMorph class methodsFor: 'instance creation' stamp: 'CamilloBruni 3/18/2011 23:11'!
for: aModel
	^ (self new)
		keymapSetting: aModel;
		yourself! !

!KMCategory commentStamp: 'GuillermoPolito 12/14/2010 21:32'!
I am a keymap category.  I represent a set of keymaps that can be attached to a morph, so morphs can share my keymaps.!
!KMCategory methodsFor: 'accessing' stamp: 'GuillermoPolito 1/21/2012 20:50'!
entriesAt: aPlatform
	platforms ifNil: [ platforms := Dictionary new ].
	^platforms at: aPlatform ifAbsentPut: [ KMStorage new ].! !

!KMCategory methodsFor: 'initialize-release' stamp: 'MarcusDenker 9/11/2013 13:29'!
buildKeymapOnMethod: method

	self addKeymapEntry: (self perform: method selector)! !

!KMCategory methodsFor: 'testing' stamp: 'GuillermoPolito 10/21/2011 00:37'!
matchesCompletely: aString
	^ self keymaps anySatisfy: [ :entry | 
		entry matchesCompletely: aString ]! !

!KMCategory methodsFor: 'accessing' stamp: 'GuillermoPolito 1/21/2012 21:02'!
keymaps
	^self allEntries keymaps! !

!KMCategory methodsFor: 'binding' stamp: 'BenjaminVanRyseghem 1/12/2014 22:38'!
keymapForShortcut: aShortcut

	^ self allEntries keymapForShortcut: aShortcut! !

!KMCategory methodsFor: 'associating' stamp: 'GuillermoPolito 1/21/2012 20:57'!
keymapNamed: aKeymapEntryName
	^self allEntries keymapNamed: aKeymapEntryName! !

!KMCategory methodsFor: 'associating' stamp: 'GuillermoPolito 10/21/2011 00:40'!
allEntries
	^self commonEntries, self platformEntries! !

!KMCategory methodsFor: 'binding' stamp: 'MarcusDenker 9/11/2013 13:07'!
bindToObject: anObject andMorph: aMorph
	
	^ KMCategoryBinding target: anObject morph: aMorph category: self.! !

!KMCategory methodsFor: 'initialize-release' stamp: 'MarcusDenker 9/11/2013 13:21'!
initialize

	super initialize.
	self class methods
		select: [ :m | m isShortcutDeclaration ]
		thenDo: [ :m | self buildKeymapOnMethod: m ]! !

!KMCategory methodsFor: 'associating' stamp: 'GuillermoPolito 1/21/2012 20:58'!
keymapNamed: aKeymapEntryName at: aPlatform
	^(self entriesAt: aPlatform) keymapNamed: aKeymapEntryName! !

!KMCategory methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 1/20/2014 08:20'!
gtDisplayOn: stream
	^ stream nextPutAll: self name asString! !

!KMCategory methodsFor: 'associating' stamp: 'GuillermoPolito 1/21/2012 20:56'!
hasKeymapNamed: aKeymapEntryName
	^self allEntries hasKeymapNamed: aKeymapEntryName! !

!KMCategory methodsFor: 'associating' stamp: 'cami 7/22/2013 18:33'!
platformEntries
	^self entriesAt: Smalltalk os platformFamily! !

!KMCategory methodsFor: 'associating' stamp: 'GuillermoPolito 10/21/2011 00:23'!
commonEntries
	^self entriesAt: #all! !

!KMCategory methodsFor: 'associating' stamp: 'GuillermoPolito 1/21/2012 20:55'!
addKeymapEntry: aKeymapEntry 
	self commonEntries add: aKeymapEntry.! !

!KMCategory methodsFor: 'accessing' stamp: 'CamilloBruni 3/18/2011 23:11'!
categoryName
	^ name! !

!KMCategory methodsFor: 'associating' stamp: 'BenjaminVanRyseghem 1/12/2014 22:50'!
removeKeymapEntry: aKeymapEntry

	[ self commonEntries remove: aKeymapEntry ] 
	on: Error
	do: [ self platformEntries remove: aKeymapEntry ]! !

!KMCategory methodsFor: 'associating' stamp: 'GuillermoPolito 1/21/2012 20:57'!
hasKeymapNamed: aKeymapEntryName at: aPlatform
	^ (self entriesAt: aPlatform) hasKeymapNamed: aKeymapEntryName! !

!KMCategory methodsFor: 'accessing' stamp: 'GuillermoPolito 12/14/2010 00:58'!
name: aCategorySymbol 
	name := aCategorySymbol ! !

!KMCategory methodsFor: 'associating' stamp: 'GuillermoPolito 1/21/2012 20:55'!
addKeymapEntry: aKeymapEntry at: aPlatform
	(self entriesAt: aPlatform) add: aKeymapEntry! !

!KMCategory methodsFor: 'testing' stamp: 'GuillermoPolito 10/21/2011 00:37'!
matches: aString
	^ self keymaps anySatisfy: [ :entry | 
		entry matches: aString ]! !

!KMCategory methodsFor: 'binding' stamp: 'MarcusDenker 9/11/2013 13:26'!
installAsGlobalCategory

	KMRepository default setAsGlobalCategory: self! !

!KMCategory methodsFor: 'accessing' stamp: 'CamilloBruni 3/18/2011 23:11'!
name
	^ name! !

!KMCategory methodsFor: 'matching' stamp: 'GuillermoPolito 10/20/2011 15:55'!
onMatchWith: anEventBuffer notify: aMatchListener andDo: aBlock
	self keymaps do: [ :entry | 
		entry onMatchWith: anEventBuffer 
			notify: aMatchListener 
			andDo: aBlock ].! !

!KMCategory methodsFor: 'binding' stamp: 'MarcusDenker 9/11/2013 13:10'!
asKmCategoryIn: aKmRepository

	"Maybe we should validate we exist in the repository?"
	^ self! !

!KMCategory methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 2/9/2014 22:05'!
gtInspectorMappingsIn: composite
	<gtInspectorPresentationOrder: 40>
	composite list
		title: 'Keys';
		display: [ self allEntries keymaps ];
		filterOn: [ :text :each | each gtDisplayString includesSubstring: text caseSensitive: false ];
		format: #gtDisplayString;
		when: [ self allEntries keymaps notEmpty ]! !

!KMCategory class methodsFor: 'instance creation' stamp: 'CamilloBruni 3/18/2011 23:11'!
named: aCategorySymbol
	^ (self new)
		name: aCategorySymbol;
		yourself! !

!KMCategory class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 15:56'!
gtExampleEmptyCategory
	<gtExample>
	^ self named: 'Empty Example'! !

!KMCategory class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 16:16'!
gtExampleCategoryWithEntry
	<gtExample>
	^ (self named: '1 Entry') 
		addKeymapEntry: (KMKeymap 
								named: #FooBar 
								shortcut: $a asKeyCombination
								action: [ ]);
		yourself! !

!KMCategoryBinding commentStamp: '<historical>'!
I am the reification of the relation morph<->category, created when a morph gets attached a category of shortcuts.!
!KMCategoryBinding methodsFor: 'accessing' stamp: 'GuillermoPolito 10/20/2011 18:37'!
category: aCategory
	category := aCategory! !

!KMCategoryBinding methodsFor: 'accessing' stamp: 'GuillermoPolito 10/20/2011 19:05'!
morph: aMorph
	morph := aMorph! !

!KMCategoryBinding methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/20/2012 19:19'!
category

	^ category! !

!KMCategoryBinding methodsFor: 'iterating' stamp: 'GuillermoPolito 5/3/2013 17:49'!
nextForKmChain: aKMDispatchChain
	^self target! !

!KMCategoryBinding methodsFor: 'binding' stamp: 'BenjaminVanRyseghem 1/12/2014 22:36'!
keymapForShortcut: aKey
	
	^ category keymapForShortcut: aKey! !

!KMCategoryBinding methodsFor: 'matching' stamp: 'GuillermoPolito 10/20/2011 18:53'!
noMatch
	"do nothing"
	! !

!KMCategoryBinding methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/20/2012 19:19'!
morph

	^ morph! !

!KMCategoryBinding methodsFor: 'printing' stamp: 'SeanDeNigris 7/17/2012 09:04'!
printOn: aStream

	aStream
		nextPutAll: 'aKMCategoryTarget(';
		nextPutAll: (category name ifNil: 'nil' ifNotNil: [ :n | n printString ]);
		nextPutAll: ')'.! !

!KMCategoryBinding methodsFor: 'matching' stamp: 'BenjaminVanRyseghem 7/3/2012 14:47'!
verifyMatchWith: anEventBuffer notifying: aListener thenDoing: anAction
	self flag: #fixme. "ugly hack with array of listeners"
	category 
		onMatchWith:  anEventBuffer
		notify: { self . aListener } " first we have to tell the dispatcher "
		andDo: anAction! !

!KMCategoryBinding methodsFor: 'matching' stamp: 'GuillermoPolito 10/20/2011 18:53'!
partialMatch
	"do nothing"
	! !

!KMCategoryBinding methodsFor: 'matching' stamp: 'GuillermoPolito 5/4/2013 15:40'!
completeMatch: aKeymap buffer: aBuffer
	KMLog log: 'Complete match: ', aKeymap printString.
	KMBuffer uniqueInstance completeMatch.
	aKeymap action cull: target value cull: morph cull: aBuffer first.
! !

!KMCategoryBinding methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/20/2012 19:19'!
target

	^ target! !

!KMCategoryBinding methodsFor: 'accessing' stamp: 'GuillermoPolito 10/20/2011 18:37'!
target: aTarget
	target := aTarget! !

!KMCategoryBinding class methodsFor: 'instance creation' stamp: 'GuillermoPolito 10/20/2011 19:05'!
target: aTarget morph: aMorph category: aCategory
	^self new
		target: aTarget;
		category: aCategory;
		morph: aMorph;
		yourself! !

!KMCategoryTarget commentStamp: '<historical>'!
I am the reification of the relation morph<->category, created when a morph gets attached a category of shortcuts.!
!KMCategoryTarget methodsFor: 'accessing' stamp: 'MarcusDenker 9/12/2013 09:53'!
morph

	^ morph! !

!KMCategoryTarget methodsFor: 'accessing' stamp: 'MarcusDenker 9/12/2013 09:53'!
morph: aMorph
	morph := aMorph! !

!KMCategoryTarget methodsFor: 'accessing' stamp: 'MarcusDenker 9/12/2013 09:53'!
category: aCategory
	category := aCategory! !

!KMCategoryTarget methodsFor: 'accessing' stamp: 'MarcusDenker 9/12/2013 09:53'!
category

	^ category! !

!KMCategoryTarget methodsFor: 'matching' stamp: 'MarcusDenker 9/12/2013 09:53'!
verifyMatchWith: anEventBuffer notifying: aListener thenDoing: anAction
	self flag: #fixme. "ugly hack with array of listeners"
	category 
		onMatchWith:  anEventBuffer
		notify: { self . aListener } " first we have to tell the dispatcher "
		andDo: anAction! !

!KMCategoryTarget methodsFor: 'matching' stamp: 'MarcusDenker 9/12/2013 09:53'!
partialMatch
	"do nothing"
	! !

!KMCategoryTarget methodsFor: 'printing' stamp: 'MarcusDenker 9/12/2013 09:53'!
printOn: aStream

	aStream
		nextPutAll: 'aKMCategoryTarget(';
		nextPutAll: (category name ifNil: 'nil' ifNotNil: [ :n | n printString ]);
		nextPutAll: ')'.! !

!KMCategoryTarget methodsFor: 'iterating' stamp: 'MarcusDenker 9/12/2013 09:53'!
nextForKmChain: aKMDispatchChain
	^self target! !

!KMCategoryTarget methodsFor: 'matching' stamp: 'MarcusDenker 9/12/2013 09:53'!
completeMatch: aKeymap buffer: aBuffer
	KMLog log: 'Complete match: ', aKeymap printString.
	KMBuffer uniqueInstance completeMatch.
	aKeymap action cull: target value cull: morph cull: aBuffer first.
! !

!KMCategoryTarget methodsFor: 'accessing' stamp: 'MarcusDenker 9/12/2013 09:53'!
target

	^ target! !

!KMCategoryTarget methodsFor: 'matching' stamp: 'MarcusDenker 9/12/2013 09:53'!
noMatch
	"do nothing"
	! !

!KMCategoryTarget methodsFor: 'accessing' stamp: 'MarcusDenker 9/12/2013 09:53'!
target: aTarget
	target := aTarget! !

!KMCategoryTarget class methodsFor: 'instance creation' stamp: 'MarcusDenker 9/12/2013 09:53'!
target: aTarget morph: aMorph category: aCategory
	^self new
		target: aTarget;
		category: aCategory;
		morph: aMorph;
		yourself! !

!KMCategoryTest methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 3/18/2011 23:11'!
categoryContainer
	^ KMFactory keymapContainer! !

!KMCategoryTest methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 9/12/2013 10:03'!
testAddKeymapToCategory
	| categoryToAdd entry |
	categoryToAdd := KMCategory named: #TestCategory.
	entry := KMKeymap named: #Foo shortcut: $a asKeyCombination, $b asKeyCombination, $c asKeyCombination action: [ "nothing" ].

	self assert: (categoryToAdd allEntries) size = 0.
	categoryToAdd addKeymapEntry: entry.
	self assert: (categoryToAdd allEntries) size = 1.! !

!KMCategoryTest methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 9/12/2013 10:03'!
testCreateUnexistentCategory
	| categoryToAdd |
	categoryToAdd := KMCategory named: #TestCategory.
	
	self assert: self categoryContainer categories size = 0.
	self categoryContainer addCategory: categoryToAdd.
	self assert: self categoryContainer categories size = 1.
	self assert: (self categoryContainer includesCategory: categoryToAdd).! !

!KMCategoryTest methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 3/13/2011 17:33'!
testCreateExistentCategoryFails
	| categoryToAdd |
	categoryToAdd := #TestCategory.
	
	self assert: self categoryContainer categories size = 0.
	self categoryContainer addCategory: categoryToAdd.
	self assert: self categoryContainer categories size = 1.
	self should: [self categoryContainer addCategory: categoryToAdd] raise: Error.! !

!KMCombinationTests methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 9/24/2012 11:07'!
testCombinationOfSimpleShortcuts
	| shortcut otherShortcut combination |
	shortcut := $a command.
	otherShortcut := $b ctrl.
	
	combination := shortcut | otherShortcut.
	
	self assert: (combination includes: shortcut).
	self assert: (combination includes: otherShortcut).
	
	self assert: ((combination collect: #platform) allSatisfy: [ :p | p = #all ]).! !

!KMCombinationTests methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 9/24/2012 11:16'!
testWindowsDependentShortcut
	| shortcut |
	shortcut := $a ctrl win.
	
	self assert: (shortcut shortcut = $a ctrl).
	
	self assert: shortcut platform equals: #Windows.! !

!KMCombinationTests methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 9/24/2012 11:06'!
testShortcutIsSimpleCombination
	| shortcut |
	shortcut := $a command.
	self assert: (shortcut includes: shortcut).
	self assert: shortcut shortcut equals: shortcut.! !

!KMCombinationTests methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 9/24/2012 11:17'!
testUnixDependentShortcut
	| shortcut |
	shortcut := $a ctrl unix.
	
	self assert: (shortcut shortcut = $a ctrl).
	
	self assert: shortcut platform equals: #Unix.! !

!KMCombinationTests methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 9/24/2012 11:11'!
testPlatformDependentShortcut
	| shortcut |
	shortcut := $a ctrl win.
	
	self assert: (shortcut shortcut = $a ctrl).
	
	self assert: shortcut platform equals: #Windows.! !

!KMCombinationTests methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 9/24/2012 11:22'!
testMacDependentShortcut
	| shortcut |
	shortcut := $a ctrl mac.
	
	self assert: (shortcut shortcut = $a ctrl).
	
	self assert: shortcut platform equals: #MacOSX.! !

!KMCombinationTests methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 9/24/2012 11:34'!
testCombinationSeveralShortcuts
	| shortcut platforms |
	platforms := Set new.
	
	shortcut := $a command mac | $a ctrl win | $a ctrl unix | $a alt.
	shortcut combinationsDo: [ :c | platforms add: c platform ].
	self assert: (platforms includes: #MacOSX).
	self assert: (platforms includes: #Windows).
	self assert: (platforms includes: #Unix).
	self assert: (platforms includes: #all).! !

!KMCommandModifier commentStamp: '<historical>'!
I represent the default modifier key for the current platform, late bound to Meta or Ctrl key modifier depending on the platform.!
!KMCommandModifier methodsFor: 'printing' stamp: 'CamilloBruni 2/19/2014 14:11'!
symbol
	^ self delegatedModifier symbol! !

!KMCommandModifier methodsFor: 'initialization' stamp: 'NicolasPetton 2/13/2014 16:55'!
initialize
	super initialize.
	identifier := #k.
	name := 'Cmd'! !

!KMCommandModifier methodsFor: 'matching' stamp: 'NicolasPetton 12/6/2013 15:54'!
matchesEvent: aKeyboardEvent
	^ self delegatedModifier matchesEvent: aKeyboardEvent ! !

!KMCommandModifier methodsFor: 'accessing' stamp: 'BenComan 2/22/2014 12:24'!
eventCode
	^ self delegatedModifier eventCode! !

!KMCommandModifier methodsFor: 'private' stamp: 'NicolasPetton 12/6/2013 15:52'!
delegatedModifier
	^ OSPlatform current defaultModifier ! !

!KMCompleteMatch commentStamp: '<historical>'!
I am an announcement raised when there is a full match between the key buffer and a shortcut.!
!KMCompleteMatch methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/3/2012 12:55'!
event
	^ event! !

!KMCompleteMatch methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/3/2012 12:55'!
event: anObject
	event := anObject! !

!KMCompleteMatch methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/3/2012 14:43'!
source: anObject
	source := anObject! !

!KMCompleteMatch methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/3/2012 14:43'!
source
	^ source! !

!KMCompleteMatch class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 7/3/2012 14:43'!
event: event from: source

	^ self new
		event: event;
		source: source;
		yourself! !

!KMComposedModifier commentStamp: '<historical>'!
I represent a composed key modifier. I contain a collection of modifiers that should match with a keyboard event.

Look at my superclass for a more detailed explanaition.!
!KMComposedModifier methodsFor: 'printing' stamp: 'BenjaminVanRyseghem 11/1/2013 17:09'!
symbol
	^ String streamContents: [ :stream | 
		self modifiers do: [ :e | 
			stream << e symbol ] ]! !

!KMComposedModifier methodsFor: 'combining' stamp: 'GuillermoPolito 5/31/2011 18:26'!
command
	modifiers add: KMModifier command! !

!KMComposedModifier methodsFor: 'comparing' stamp: 'GuillermoPolito 5/1/2012 12:26'!
hash
	^ modifiers hash! !

!KMComposedModifier methodsFor: 'combining' stamp: 'GuillermoPolito 3/19/2013 20:16'!
control
	modifiers add: KMModifier ctrl! !

!KMComposedModifier methodsFor: 'accessing' stamp: 'CamilloBruni 3/20/2011 23:59'!
updateIdentifier
	identifier := String streamContents: [ :aStream|
			modifiers do: [ :modifier| 
				aStream << modifier identifier]].
	identifier := identifier asSymbol! !

!KMComposedModifier methodsFor: 'combining' stamp: 'CamilloBruni 3/19/2011 21:20'!
alt
	modifiers add: KMModifier alt! !

!KMComposedModifier methodsFor: 'combining' stamp: 'CamilloBruni 3/20/2011 23:57'!
modifiedBy: modifier
	modifiers add: modifier.
	self updateIdentifier.! !

!KMComposedModifier methodsFor: 'combining' stamp: 'CamilloBruni 3/19/2011 21:21'!
shift
	modifiers add: KMModifier shift! !

!KMComposedModifier methodsFor: 'accessing' stamp: 'CamilloBruni 3/19/2011 21:23'!
modifiers
	^ modifiers! !

!KMComposedModifier methodsFor: 'combining' stamp: 'GuillermoPolito 3/19/2013 19:12'!
+ modified
	^ modified asKeyCombination modifiedBy: self! !

!KMComposedModifier methodsFor: 'initialization' stamp: 'GuillermoPolito 2/14/2014 15:54'!
initialize
	super initialize.
	modifiers := OrderedCollection new.! !

!KMComposedModifier methodsFor: 'matching' stamp: 'CamilloBruni 3/19/2011 21:18'!
matchesEvent: aKeyboardEvent
	^ modifiers allSatisfy: [:modifier|
		modifier matchesEvent: aKeyboardEvent]! !

!KMComposedModifier methodsFor: 'comparing' stamp: 'GuillermoPolito 2/14/2014 15:56'!
= aShortcut
	(aShortcut isKindOf: self class)
		ifFalse: [^ false].
	^ (aShortcut modifiers includesAll: modifiers) and: [ modifiers includesAll: aShortcut modifiers ]! !

!KMComposedModifier methodsFor: 'printing' stamp: 'CamilloBruni 3/20/2011 23:47'!
printOn: aStream
	modifiers
		do: [ :modifier| modifier printOn: aStream ]
		separatedBy: [ aStream << ' + ' ].! !

!KMComposedModifier methodsFor: 'combining' stamp: 'GuillermoPolito 3/19/2013 20:16'!
ctrl
	self control! !

!KMCtrlModifier commentStamp: '<historical>'!
I represent the Ctrl key modifier. Look at my superclass for a more detailed explanaition.!
!KMCtrlModifier methodsFor: 'matching' stamp: 'CamilloBruni 3/19/2011 20:50'!
matchesEvent: aKeyboardEvent
	^ aKeyboardEvent controlKeyPressed! !

!KMCtrlModifier methodsFor: 'initialization' stamp: 'GuillermoPolito 4/9/2011 23:52'!
initialize
	super initialize.
	identifier := #c.
	name := 'Ctrl'.! !

!KMCtrlModifier methodsFor: 'accessing' stamp: 'BenComan 2/22/2014 12:24'!
eventCode
	^16! !

!KMDescription commentStamp: '<historical>'!
A KMDescription is a window showing the description of shortcuts for a specified set of symbols reprensenting KMCategories!
!KMDescription methodsFor: 'accessing' stamp: 'GuillermoPolito 5/1/2012 12:26'!
categories
	
	^ categories! !

!KMDescription methodsFor: 'accessing' stamp: 'NicolaiHess 12/11/2013 21:23'!
shortcutList
	
	^ shortcutList! !

!KMDescription methodsFor: 'initialization' stamp: 'NicolaiHess 12/11/2013 22:47'!
updateShortcutList
	| cat items |
	cat := categories value at: self categoryList selectedIndex.
	items := (cat entriesAt: #all) keymaps collect: [ :e | collectingBlock value: e ].
	shortcutList items: (items sorted: sortingBlock)! !

!KMDescription methodsFor: 'accessing' stamp: 'NicolaiHess 12/11/2013 21:23'!
orderingList
	
	^ orderingList! !

!KMDescription methodsFor: 'initialization' stamp: 'NicolaiHess 12/11/2013 22:46'!
initCategoryList: aCollection
	categoryList emptyList.
	aCollection do: [ :cat | categoryList addItemLabeled: cat name do: [ self updateShortcutList ] ]! !

!KMDescription methodsFor: 'initialization' stamp: 'NicolaiHess 12/11/2013 22:44'!
initializeWidgets

	self instantiateModels: #(
		categoryList DropListModel
		shortcutList MultiColumnListModel
		okToolbar OkToolbar
		orderingList DropListModel ).
	
	orderingList 
		addItemLabeled:'shortcut	:	description' 
			do: [self collectShortcutDescription.
				 self updateShortcutList];
		addItemLabeled:'description	:	shortcut' 
			do: [self collectDescriptionShortcut.
				 self updateShortcutList].
	
	shortcutList 
		displayBlock: [ :e | e ];
		allowToSelect: false.

	okToolbar okButton
			label: 'Close';
			state: false! !

!KMDescription methodsFor: 'initialization' stamp: 'NicolaiHess 12/11/2013 22:45'!
collectDescriptionShortcut
	collectingBlock := [ :e | {(e description asString) . ':' . (e shortcut asString)} ]! !

!KMDescription methodsFor: 'api' stamp: 'NicolaiHess 12/11/2013 22:40'!
categories: aCollectionOfSymbols
	| cats |
	
	cats := aCollectionOfSymbols collect: [:e | KMRepository default categoryForName: e].
	categories value: cats.
	self updateShortcutList! !

!KMDescription methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 8/3/2012 16:09'!
okToolbar
	
	^ okToolbar! !

!KMDescription methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 1/24/2014 16:07'!
initialize

	categories := nil asValueHolder.
	sortingBlock := [:a :b | a first < b first ].
	super initialize.
      self collectShortcutDescription
! !

!KMDescription methodsFor: 'initialization' stamp: 'NicolaiHess 12/11/2013 22:41'!
initializePresenter
		
	categories whenChangedDo: [:col | self initCategoryList:col ].
	okToolbar okAction: [ self delete ].! !

!KMDescription methodsFor: 'accessing' stamp: 'NicolaiHess 12/11/2013 21:23'!
categoryList
	
	^ categoryList! !

!KMDescription methodsFor: 'initialization' stamp: 'NicolaiHess 12/11/2013 22:46'!
collectShortcutDescription
	collectingBlock := [:e | {e shortcut asString. ':'. e description asString} ]! !

!KMDescription methodsFor: 'private' stamp: 'BenjaminVanRyseghem 4/6/2012 15:49'!
initialExtent

	^  (600@350)! !

!KMDescription class methodsFor: 'specs' stamp: 'NicolaiHess 12/11/2013 21:22'!
defaultSpec
	<spec>
	
	^ SpecLayout composed
		newColumn: [:c | 
			c 
				newRow: [:r | 
					r 
						add: #categoryList;
						add: #orderingList ] height: 25;
				add: #shortcutList;
				add: #okToolbar height: 25 ]! !

!KMDescription class methodsFor: 'example' stamp: 'BenjaminVanRyseghem 4/6/2012 17:23'!
example

	| d |
	d := KMDescription new.
	d categories: #(GlobalShortcuts MonticelloShortcuts TextEditor).
	d openWithSpec! !

!KMDescription class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 4/6/2012 15:46'!
title

	^ 'Shortcuts description'! !

!KMDispatchChain commentStamp: '<historical>'!
I am an object that controls the dispatch order of keymaps given a hierarchy of morphs.
!
!KMDispatchChain methodsFor: 'initialize-release' stamp: 'GuillermoPolito 5/3/2013 16:14'!
target: aTarget
	target := aTarget! !

!KMDispatchChain methodsFor: 'initialize-release' stamp: 'GuillermoPolito 5/4/2013 16:13'!
startOn: anInitialTarget
	initialTarget := anInitialTarget.! !

!KMDispatchChain methodsFor: 'iterating' stamp: 'GuillermoPolito 5/4/2013 16:12'!
do: aBlock
	| currentTarget |
	currentTarget := initialTarget.
	[ currentTarget isNil ]
		whileFalse: [
			aBlock value: currentTarget.
			currentTarget := currentTarget nextForKmChain: self.
		]! !

!KMDispatchChain methodsFor: 'iterating' stamp: 'GuillermoPolito 5/3/2013 16:57'!
target
	^target! !

!KMDispatchChain methodsFor: 'dispatching' stamp: 'GuillermoPolito 5/4/2013 15:48'!
dispatch: aKeyboardEvent
	self do: [ :targetToDispatch |
		targetToDispatch dispatch: KMBuffer uniqueInstance buffer copy.
		aKeyboardEvent wasHandled ifTrue: [ ^self ].
	].
	"This should be a noMatch event"
	aKeyboardEvent wasHandled ifFalse: [ KMBuffer uniqueInstance clearBuffer ]! !

!KMDispatchChain methodsFor: 'initialize-release' stamp: 'GuillermoPolito 5/3/2013 17:45'!
dispatcher: aDispatcher
	dispatcher := aDispatcher.
	self target: dispatcher target.! !

!KMDispatchChain class methodsFor: 'instance creation' stamp: 'GuillermoPolito 5/3/2013 17:52'!
from: anInitialTarget andDispatcher: aDispatcher
	^self new
			dispatcher: aDispatcher;
			startOn: anInitialTarget;
			yourself! !

!KMDispatchChainTest methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 9/11/2013 14:47'!
testTargetDoesNotIterateTheNil
	| chain |
	chain := KMDispatchChain from: (KmGlobalDispatcher new) andDispatcher: (KMDispatcher new).
	chain do: [ :target | self assert: target notNil ].! !

!KMDispatchChainTest methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 5/3/2013 17:53'!
testPassesOnTheTarget
	| chain dispatcher passed |
	dispatcher := KMDispatcher target: Morph new.
	passed := false.
	chain := KMDispatchChain from: (KmGlobalDispatcher new) andDispatcher: dispatcher.
	chain do: [ :t | t == dispatcher target ifTrue: [ passed := true ] ].
	self assert: passed! !

!KMDispatchChainTest methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 5/3/2013 17:51'!
testGlobalIsFirst
	| chain first |
	first := nil.
	chain := KMDispatchChain from: (KmGlobalDispatcher new) andDispatcher: (KMDispatcher new).
	chain do: [ :target | first ifNil: [ first := target ] ].
	self assert: first isGlobalDispatcher.! !

!KMDispatcher commentStamp: 'GuillermoPolito 12/24/2010 19:00'!
I'm an object that saves a buffer of keyevents for the morph I'm attached.
I am the one that dispatches the single and multiple shortcuts.
If the morph has a keymap that matches the keyboard event, I tell the keymap event to execute with the morph I'm attached.!
!KMDispatcher methodsFor: 'building' stamp: 'GuillermoPolito 5/4/2013 16:00'!
attachCategory: aCategory
	self attachCategory: aCategory targetting: morph! !

!KMDispatcher methodsFor: 'dispatching' stamp: 'BenjaminVanRyseghem 7/3/2012 14:47'!
dispatch: anEventBuffer
	| association match |
	self keymapObservers do: [ :aTarget | 
		"nice hack to stop in the first listener"
		aTarget 
			verifyMatchWith: anEventBuffer 
			notifying: self
			thenDoing: [ ^self ] ].
	self noMatch! !

!KMDispatcher methodsFor: 'building' stamp: 'BenjaminVanRyseghem 1/12/2014 22:40'!
removeKeyCombination: aShortcut
	| keymap removalTarget |

	removalTarget := self directKeymaps.
	
	keymap := self keymapForShortcut: aShortcut.
	keymap ifNil: [ 
		self targets do: [ :e | (e keymapForShortcut: aShortcut) 
			ifNotNil: [ :s | 
				removalTarget := e category.
				keymap := s ] ] ].
	keymap ifNil: [ ^ self ].
	
	removalTarget removeKeymapEntry: keymap! !

!KMDispatcher methodsFor: 'building' stamp: 'BenjaminVanRyseghem 11/12/2013 16:09'!
keymapForShortcut: aShortcut

	^ self directKeymaps keymapForShortcut: aShortcut! !

!KMDispatcher methodsFor: 'match' stamp: 'GuillermoPolito 6/24/2012 12:12'!
noMatch! !

!KMDispatcher methodsFor: 'building' stamp: 'MarcusDenker 9/11/2013 13:07'!
attachCategory: aCategoryName onProperty: aProperty
	self targets add: (KMCategoryBinding 
						target: [ morph perform: aProperty ] 
						morph: morph 
						category: (KMRepository default categoryForName: aCategoryName) )! !

!KMDispatcher methodsFor: 'building' stamp: 'BenjaminVanRyseghem 2/20/2012 22:41'!
detachKeymapCategory: aCategoryName

	self detachKeymapCategory: aCategoryName targetting: morph! !

!KMDispatcher methodsFor: 'dispatching' stamp: 'MarcusDenker 9/11/2013 13:07'!
perInstanceTarget
	^KMCategoryBinding target: morph morph: morph category: self directKeymaps.! !

!KMDispatcher methodsFor: 'initialize' stamp: 'ThierryGoubier 9/14/2012 15:24'!
resetTargets
    targets := nil! !

!KMDispatcher methodsFor: 'building' stamp: 'GabrielOmarCotelli 12/3/2013 17:23'!
detachKeymapCategory: aCategoryName targetting: anObject
	self targets
		detect: [ :tgt | tgt target = anObject and: [ tgt category name = aCategoryName ] ]
		ifFound: [ :categoryTarget | self targets remove: categoryTarget ]
		ifNone: [ self error: 'Category ' , aCategoryName , ' is not attached to ' , morph asString ]! !

!KMDispatcher methodsFor: 'dispatching' stamp: 'GuillermoPolito 10/20/2011 18:20'!
targets
	^targets ifNil: [ targets := Set new ]! !

!KMDispatcher methodsFor: 'match' stamp: 'ThierryGoubier 9/13/2012 22:08'!
completeMatch: aKeymapEntry buffer: aBuffer
	KMLog log:  morph printString, ' Complete match: ', aKeymapEntry printString.
	KMBuffer uniqueInstance completeMatch.
	self announcer announce: (KMCompleteMatch event: currentEvent from: self).! !

!KMDispatcher methodsFor: 'building' stamp: 'GuillermoPolito 8/5/2013 10:21'!
bindKeyCombination: aShortcut toAction: anAction
	self directKeymaps 
		addKeymapEntry: (KMKeymap
			shortcut: aShortcut 
			action: anAction)! !

!KMDispatcher methodsFor: 'dispatching' stamp: 'MarcusDenker 9/12/2013 10:03'!
directKeymaps
	^directKeymaps ifNil: [ directKeymaps := KMCategory new ]! !

!KMDispatcher methodsFor: 'testing' stamp: 'EstebanLorenzano 2/19/2013 14:42'!
includesKeymapCategory: aCategoryName 

	^self includesKeymapCategory: aCategoryName targetting: morph! !

!KMDispatcher methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/3/2012 14:55'!
target: aTarget
	target := aTarget.
	morph := target morph.
	"self announcer weak
		on: MorphLostFocus send: #clearBuffer to: KMBuffer uniqueInstance."! !

!KMDispatcher methodsFor: 'testing' stamp: 'EstebanLorenzano 2/19/2013 14:41'!
includesKeymapCategory: aCategoryName targetting: anObject

	^self targets anySatisfy: [ :tgt | 
		tgt target = anObject and: [ tgt category name = aCategoryName ] ]
		! !

!KMDispatcher methodsFor: 'match' stamp: 'BenjaminVanRyseghem 7/3/2012 12:50'!
announcer

	^ self target announcer! !

!KMDispatcher methodsFor: 'match' stamp: 'GuillermoPolito 6/24/2012 12:19'!
buffer
	^ KMBuffer uniqueInstance buffer! !

!KMDispatcher methodsFor: 'dispatching' stamp: 'GuillermoPolito 5/4/2013 15:40'!
dispatchKeystroke: aKeyEvent

	| chain |
	KMLog log: aKeyEvent printString, String cr.

	KMBuffer uniqueInstance addEvent: aKeyEvent.

	chain := KMDispatchChain from: (KmGlobalDispatcher new dispatcher: self; yourself) andDispatcher: self.
	chain dispatch: aKeyEvent.! !

!KMDispatcher methodsFor: 'building' stamp: 'BenjaminVanRyseghem 2/20/2012 19:36'!
detachAllKeymapCategories

	self targets removeAll! !

!KMDispatcher methodsFor: 'initialize' stamp: 'ThierryGoubier 9/14/2012 15:35'!
reset
	self resetTargets.
	self resetPerInstanceTarget! !

!KMDispatcher methodsFor: 'initialize' stamp: 'ThierryGoubier 9/14/2012 15:35'!
resetPerInstanceTarget
	directKeymaps := nil! !

!KMDispatcher methodsFor: 'dispatching' stamp: 'GuillermoPolito 5/3/2013 17:20'!
dispatch: anEventBuffer inCategories: categories

	(self keymapObserversForCategories: categories) do: [ :aTarget | 
		"nice hack to stop in the first listener"
		aTarget 
			verifyMatchWith: anEventBuffer 
			notifying: self
			thenDoing: [ ^self ] ].
	self noMatch! !

!KMDispatcher methodsFor: 'dispatching' stamp: 'MarcusDenker 9/11/2013 13:07'!
keymapObserversForCategories: categories

	^categories collect: [ :cat | KMCategoryBinding 
									target: target realTarget 
									morph: target morph 
									category: cat ].! !

!KMDispatcher methodsFor: 'dispatching' stamp: 'GuillermoPolito 5/4/2013 16:37'!
keymapObservers
	| o |
	o := OrderedCollection with: self perInstanceTarget.
	o addAll: self targets.
	^ o! !

!KMDispatcher methodsFor: 'building' stamp: 'MarcusDenker 9/11/2013 13:07'!
attachCategory: aCategory targetting: anObject
	
	|  category categoryTarget |
	category := aCategory asKmCategoryIn: KMRepository default.
	categoryTarget := category bindToObject: anObject andMorph: morph.
	self targets add: categoryTarget.! !

!KMDispatcher methodsFor: 'match' stamp: 'BenjaminVanRyseghem 7/3/2012 17:52'!
partialMatch
	| event |
	KMBuffer uniqueInstance partialMatch.
	event := KMBuffer uniqueInstance currentEvent.
	event isKeyboard not ifTrue: [ event := nil ].
	self announcer announce: (KMPartialMatch event: event from: self).! !

!KMDispatcher methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 1/27/2015 20:59'!
gtInspectorMappingsIn: composite
	<gtInspectorPresentationOrder: 40>
	composite table 
		title: 'Keys';
		display: [ 
			((self targets collect: #category)
				add: self directKeymaps;
				yourself)
				flatCollect: [ :category | 
					category allEntries keymaps collect: [ :key | key -> category ] ]
				 ];
		filterOn: [ :text :each | each gtDisplayString includesSubstring: text caseSensitive: false ];
		column: 'Shortcut' evaluated: [ :assoc | assoc key shortcut gtDisplayString ] width: 120;
		column: 'Action' evaluated: [ :assoc | assoc key action gtDisplayString ];
		column: 'Description' evaluated: [ :assoc | assoc key description ];
		column: 'Category' evaluated: [ :assoc | '' ] tags: [ :assoc | assoc value name ifNil: [ #() ] ifNotNil: [ { assoc value name }]];
		send: #key! !

!KMDispatcher methodsFor: 'accessing' stamp: 'CamilloBruni 3/18/2011 23:11'!
target
	^ target! !

!KMDispatcher class methodsFor: 'instance creation' stamp: 'GuillermoPolito 5/30/2011 01:26'!
target: aTarget
	^ self target: #yourself morph: aTarget! !

!KMDispatcher class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 16:55'!
gtExampleEmptyDispatcher
	<gtExample: 'Empty dispatcher'>
	^ self new! !

!KMDispatcher class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 16:12'!
gtExampleDispatcherWithTargetAndShortcuts
	<gtExample: 'Dispatcher with target and shortcuts'>
	^ BorderedMorph new kmDispatcher! !

!KMDispatcher class methodsFor: 'instance creation' stamp: 'GuillermoPolito 5/31/2011 11:02'!
target: aTargetSelector morph: aMorph
	^ (self new)
		target: (KMTarget for: aTargetSelector in: aMorph);
		yourself! !

!KMDispatcher class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 16:56'!
gtExampleDispatcherWithTarget
	<gtExample: 'Dispatcher with target'>
	^ self target: Morph new! !

!KMDispatcherTestCase methodsFor: 'tests' stamp: 'MarcusDenker 9/12/2013 10:03'!
testDetach

	| category1 category2 morph attachedCategories |
	category1 := KMCategory named: #TestBlah.
	category2 := KMCategory named: #TestAnother.
	morph := BorderedMorph new.
	KMRepository default addCategory: category1.
	KMRepository default addCategory: category2.
	morph kmDispatcher reset.
	morph attachKeymapCategory: #TestBlah.
	morph attachKeymapCategory: #TestAnother.
	morph kmDispatcher targets size = 2 ifFalse: [ self error: 'should have one category attached' ].

	morph detachKeymapCategory: #TestBlah.	
	attachedCategories := morph kmDispatcher targets collect: [ :e | e category name ].
	self assert: attachedCategories asArray equals: { #TestAnother }.

	self should: [ morph detachKeymapCategory: #NonExistent ] raise: Error.! !

!KMDispatcherTestCase methodsFor: 'tests' stamp: 'CamilloBruni 3/18/2011 23:11'!
keymapContainer
	^ KMRepository default! !

!KMDispatcherTestCase methodsFor: 'tests' stamp: 'MarcusDenker 9/12/2013 10:03'!
testBuffering
	| morph flag category event1 event2 event3|
	category := KMCategory named: #TestBlah.
	KMRepository default addCategory: category.
	
	morph := BorderedMorph new.
	morph kmDispatcher reset.
	flag := false.

	category addKeymapEntry: (KMKeymap named: #Foo shortcut: $a asKeyCombination, $b asKeyCombination, $c asKeyCombination action: [flag := true]).
	category addKeymapEntry: (KMKeymap named: #Bar shortcut: $p asKeyCombination, $p asKeyCombination action: []).
	morph attachKeymapCategory: #TestBlah.

	event1 := self eventKey: $a.
	morph kmDispatcher
		dispatchKeystroke: event1.
	self assert: morph kmDispatcher buffer size equals: 1.
	self assert: morph kmDispatcher buffer first equals: event1.
	
	event2 := self eventKey: $b.
	morph kmDispatcher
		dispatchKeystroke: event2.
	self assert: morph kmDispatcher buffer size = 2.
	self assert: morph kmDispatcher buffer first = event1.
	self assert: morph kmDispatcher buffer second = event2.
	
	event3 := self eventKey: $c.
	morph kmDispatcher
		dispatchKeystroke: event3.
	self assert: morph kmDispatcher buffer isEmpty.
	
	self assert: flag.! !

!KMDispatcherTestCase methodsFor: 'tests' stamp: 'MarcusDenker 9/12/2013 10:03'!
testNoStaggeredTrigger
	"Once a key sequence is recognized by a keymapper, all other  
	keymappers should clear their buffers"
	| bm1 bm2 flag1 flag2 category otherCategory bufferBefore |
	
	category := KMCategory named: #TestBlah.
	otherCategory := KMCategory named: #TestFoo.
	
	KMRepository default addCategory: category.
	KMRepository default addCategory: otherCategory.
	
	bm1 := BorderedMorph new.
	bm1 attachKeymapCategory: category.
	
	flag1 := false.
	category addKeymapEntry: ( KMKeymap named: #Foo shortcut: $a asKeyCombination, $b asKeyCombination, $c asKeyCombination action: [flag1 := true]).

	bm2 := Morph new.
	bm2 attachKeymapCategory: otherCategory.
	flag2 := false.

	otherCategory addKeymapEntry: (KMKeymap named: #Bar shortcut: $a asKeyCombination, $b asKeyCombination action:  [flag2 := true]).
	bm1 addMorphBack: bm2.
	bufferBefore := bm2 kmDispatcher buffer copy.
	{self eventKey: $a. self eventKey: $b. self eventKey: $c}
		do: [:e | bm2 dispatchKeystrokeForEvent: e].
	flag1 ifTrue: [ bufferBefore inspect ].
	self deny: flag1.
	self assert: flag2.! !

!KMDispatcherTestCase methodsFor: 'tests' stamp: 'MarcusDenker 9/12/2013 10:03'!
testNoMultiTrigger
	| bm1 bm2 flag1 flag2 category otherCategory |
	category := KMCategory named: #TestBlah.
	otherCategory := KMCategory named: #TestFoo.
	KMRepository default addCategory: category.
	KMRepository default addCategory: otherCategory.
	
	bm1 := BorderedMorph new.
	bm1 attachKeymapCategory: #TestBlah.
	flag1 := false.

	category addKeymapEntry: (KMKeymap named: #Foo shortcut: $a asKeyCombination, $b asKeyCombination, $c asKeyCombination action: [flag1 := true]).
	bm2 := KMMockMorph new.
	bm2 attachKeymapCategory: #TestFoo.
	
	flag2 := false.

	otherCategory addKeymapEntry: (KMKeymap named: #Bar shortcut: $a asKeyCombination, $b asKeyCombination, $c asKeyCombination action: [flag2 := true]).
	bm1 addMorphBack: bm2.
	
	{self eventKey: $a. self eventKey: $b. self eventKey: $c}
		do: [:e | bm2 dispatchKeystrokeForEvent: e].
	self deny: flag1.
	self assert: flag2.! !

!KMDispatcherTestCase class methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 3/18/2011 23:11'!
keymapEventBuilderClass
	^ KMFactory keymapEventBuilder! !

!KMFactory commentStamp: 'GuillermoPolito 2/24/2011 23:43'!
I am a class used to access some of the main classes of Keymapping. See my class side to have an idea of what can I give you.!
!KMFactory class methodsFor: 'accessing' stamp: 'CamilloBruni 3/18/2011 23:11'!
keymapContainer
	^ KMRepository default! !

!KMKeyCombination commentStamp: '<historical>'!
I'm an abstract class representing a key combination. I'm can represent several cases of key presses:

- simple key presses: pressing a single key, as a letter or number, or others like tab or space
- modified key presses: a simple key + a modifier like shift or alt
- option key presses: a list of key presses where only one of them should be valid
- chained shortcuts: a sequence of shortcuts

My more important protocols are:

- matching: contains methods to control if a key combination is equals to other or matches a sequence of keyboard events
- combining: defines simple ways to combine shorcut objects, like chaining them or modifying them

For more information, look at my subclasses.!
!KMKeyCombination methodsFor: '*Spec-Core' stamp: 'BenjaminVanRyseghem 1/10/2014 20:32'!
currentCharacter

	^ ''! !

!KMKeyCombination methodsFor: 'combining' stamp: 'GuillermoPolito 3/15/2013 03:06'!
| aShortcut
	^KMKeyCombinationChoice withShortcuts: { self . aShortcut }! !

!KMKeyCombination methodsFor: 'comparing' stamp: 'CamilloBruni 3/18/2011 23:11'!
hash
	^ self species hash! !

!KMKeyCombination methodsFor: 'iterating' stamp: 'GuillermoPolito 9/24/2012 11:40'!
combinationsDo: aBlock
	aBlock value: self! !

!KMKeyCombination methodsFor: 'keymap building' stamp: 'GuillermoPolito 4/6/2012 13:49'!
named: keymapName do: anActionBlock withDescription: aDescription
	^ KMKeymap
		named: keymapName
		shortcut: self
		action: anActionBlock
		description: aDescription! !

!KMKeyCombination methodsFor: 'printing' stamp: 'BenjaminVanRyseghem 2/19/2014 11:45'!
prettyPrintOn: aStream

	aStream << self shortcut modifier symbol.
	self shortcut character printOn: aStream! !

!KMKeyCombination methodsFor: 'matching' stamp: 'BenjaminVanRyseghem 11/1/2013 16:12'!
matchesCompletely: aKeyboardEvent
	^ self = aKeyboardEvent asKeyCombination! !

!KMKeyCombination methodsFor: 'combining' stamp: 'GuillermoPolito 3/15/2013 03:07'!
mac
	^KMPlatformSpecificKeyCombination with: self onPlatform: #MacOSX! !

!KMKeyCombination methodsFor: 'converting' stamp: 'GuillermoPolito 3/19/2013 19:12'!
asKeyCombination
	^self! !

!KMKeyCombination methodsFor: 'combining' stamp: 'GuillermoPolito 3/19/2013 19:12'!
, aShortcut
	^ KMKeyCombinationSequence first: self next: aShortcut asKeyCombination! !

!KMKeyCombination methodsFor: 'accessing' stamp: 'GuillermoPolito 9/24/2012 10:59'!
shortcut
	^self! !

!KMKeyCombination methodsFor: 'accessing' stamp: 'GuillermoPolito 9/24/2012 11:10'!
platform
	^#all! !

!KMKeyCombination methodsFor: 'matching' stamp: 'GuillermoPolito 9/24/2012 11:04'!
includes: aShortcut
	^self = aShortcut! !

!KMKeyCombination methodsFor: 'keymap building' stamp: 'CamilloBruni 3/18/2011 23:11'!
value: aBuilder
	^ self! !

!KMKeyCombination methodsFor: 'comparing' stamp: 'CamilloBruni 3/18/2011 23:11'!
= aShortcut
	^ aShortcut isKindOf: self species! !

!KMKeyCombination methodsFor: 'keymap building' stamp: 'GuillermoPolito 4/6/2012 13:26'!
named: keymapName do: anActionBlock
	^ KMKeymap
		named: keymapName
		shortcut: self
		action: anActionBlock! !

!KMKeyCombination methodsFor: 'converting' stamp: 'GuillermoPolito 6/28/2013 13:03'!
asShortcut
	^ self asKeyCombination! !

!KMKeyCombination methodsFor: 'matching' stamp: 'GuillermoPolito 10/20/2011 16:42'!
matches: anEventBuffer
	^ self matchesCompletely: anEventBuffer first! !

!KMKeyCombination methodsFor: 'combining' stamp: 'GuillermoPolito 3/15/2013 03:07'!
win
	^KMPlatformSpecificKeyCombination with: self onPlatform: #Windows! !

!KMKeyCombination methodsFor: 'combining' stamp: 'GuillermoPolito 3/15/2013 03:07'!
unix
	^KMPlatformSpecificKeyCombination with: self onPlatform: #Unix! !

!KMKeyCombination class methodsFor: 'instance creation' stamp: 'SeanDeNigris 1/22/2014 19:47'!
fromKeyboardEvent: evt
	| modifier control command shift alt |
	control := evt controlKeyPressed.
	command := evt commandKeyPressed.
	shift := evt shiftPressed.
	alt := evt altKeyPressed.
	(shift | command | control | alt)
		ifFalse: [^ KMSingleKeyCombination from: evt keyCharacter ].
	modifier := KMNoShortcut new.
	control
		ifTrue: [ modifier := modifier + KMModifier ctrl ].
	command
		ifTrue: [ modifier := modifier + KMModifier command ].
	shift
		ifTrue: [ modifier := modifier + KMModifier shift ].
	alt
		ifTrue: [ modifier := modifier + KMModifier alt ].
	^ modifier + evt modifiedCharacter! !

!KMKeyCombinationChoice commentStamp: '<historical>'!
I representing a choice between key combinations.

A keyboard event will match with me when any of my key combinations matches with it.!
!KMKeyCombinationChoice methodsFor: '*Spec-Core' stamp: 'BenjaminVanRyseghem 12/11/2013 15:03'!
currentCharacter
	| candidates |
	
	candidates := shortcuts 
		collect: [ :each | each currentCharacter ] 
		thenSelect: [ :each | each isNotNil ].
		
	^ candidates 
		ifEmpty: [ nil ]
		ifNotEmpty: [ candidates first ]! !

!KMKeyCombinationChoice methodsFor: 'combining' stamp: 'GuillermoPolito 3/15/2013 03:06'!
| aShortcut
	^KMKeyCombinationChoice withShortcuts: (shortcuts copyWith: aShortcut)! !

!KMKeyCombinationChoice methodsFor: 'printing' stamp: 'BenjaminVanRyseghem 2/19/2014 11:57'!
prettyPrintOn: aStream

	(shortcuts select:[ :e | e platform = Smalltalk os platformFamily or: [ e platform = #all ] ])
		do: [ :e | e prettyPrintOn: aStream ]
		separatedBy: [ aStream << ' | ' ]! !

!KMKeyCombinationChoice methodsFor: 'iterating' stamp: 'GuillermoPolito 9/24/2012 11:41'!
combinationsDo: aBlock
	^shortcuts do: aBlock! !

!KMKeyCombinationChoice methodsFor: 'comparing' stamp: 'BenjaminVanRyseghem 5/7/2013 18:25'!
= another

	^ shortcuts anySatisfy: [ :each | another = each ]! !

!KMKeyCombinationChoice methodsFor: 'iterating' stamp: 'GuillermoPolito 9/24/2012 11:42'!
collect: aBlock
	^shortcuts collect: aBlock! !

!KMKeyCombinationChoice methodsFor: 'matching' stamp: 'BenjaminVanRyseghem 11/1/2013 16:12'!
matchesCompletely: anEventBuffer
	
	^ shortcuts anySatisfy: [ :each | each matchesCompletely: anEventBuffer ]! !

!KMKeyCombinationChoice methodsFor: 'matching' stamp: 'BenjaminVanRyseghem 5/7/2013 18:26'!
matches: anEventBuffer
	
	^ shortcuts anySatisfy: [ :each | each matches: anEventBuffer ]! !

!KMKeyCombinationChoice methodsFor: 'accessing' stamp: 'GuillermoPolito 9/24/2012 11:37'!
shortcuts: someShortcuts
	shortcuts := someShortcuts! !

!KMKeyCombinationChoice methodsFor: 'matching' stamp: 'GuillermoPolito 9/24/2012 11:40'!
includes: aShortcut
	^shortcuts includes: aShortcut! !

!KMKeyCombinationChoice class methodsFor: 'instance creation' stamp: 'GuillermoPolito 9/24/2012 11:38'!
withShortcuts: someShortcuts
	^self new
			shortcuts: someShortcuts;
			yourself! !

!KMKeyCombinationSequence commentStamp: '<historical>'!
I represent a sequence of key combinations.

In order to have a match between me and a user's key presses, all user events must match all of my inner shortcuts in the same exact order.

To create a sequence of key combinations use the #, message. Like for example:

$a command , $b shift!
!KMKeyCombinationSequence methodsFor: 'printing' stamp: 'BenjaminVanRyseghem 2/19/2014 11:51'!
prettyPrintOn: aStream

	shortcuts 
		do: [ :e | e prettyPrintOn: aStream ]
		separatedBy: [ aStream << ' + ' ]! !

!KMKeyCombinationSequence methodsFor: 'matching' stamp: 'GuillermoPolito 3/19/2013 19:46'!
beginsWith: aShortcut 
	
	^ self sequence first = aShortcut ! !

!KMKeyCombinationSequence methodsFor: 'comparing' stamp: 'CamilloBruni 3/18/2011 23:11'!
hash
	^ shortcuts hash! !

!KMKeyCombinationSequence methodsFor: 'accessing' stamp: 'GuillermoPolito 12/24/2010 22:39'!
first: aShortcut
	self addShortcut: aShortcut! !

!KMKeyCombinationSequence methodsFor: 'accessing' stamp: 'GuillermoPolito 3/19/2013 19:46'!
addShortcut: aShortcut
	self sequence add: aShortcut! !

!KMKeyCombinationSequence methodsFor: 'comparing' stamp: 'GuillermoPolito 3/19/2013 19:46'!
= aShortcut
	^ super = aShortcut and: [ shortcuts = aShortcut sequence ]! !

!KMKeyCombinationSequence methodsFor: 'printing' stamp: 'CamilloBruni 3/20/2011 23:44'!
printOn: aStream
	shortcuts 
		do: [ :shortcut| shortcut printOn: aStream]
		separatedBy: [ aStream nextPutAll: ' , '].! !

!KMKeyCombinationSequence methodsFor: 'matching' stamp: 'GuillermoPolito 3/19/2013 19:12'!
matches: anEventBuffer
	|maxIndex|
	maxIndex := anEventBuffer size min: shortcuts size.
	1 to: maxIndex do: [:index|
		((shortcuts at: index) = (anEventBuffer at: index) asKeyCombination)
			ifFalse: [ ^ false]].
	^ true.! !

!KMKeyCombinationSequence methodsFor: 'accessing' stamp: 'GuillermoPolito 3/15/2011 00:42'!
next: aShortcut
	self addShortcut: aShortcut! !

!KMKeyCombinationSequence methodsFor: 'combining' stamp: 'GuillermoPolito 3/19/2013 19:12'!
, aShortcut
	self addShortcut: aShortcut asKeyCombination.! !

!KMKeyCombinationSequence methodsFor: 'accessing' stamp: 'GuillermoPolito 3/19/2013 19:46'!
sequence
	^ shortcuts ifNil: [ shortcuts := OrderedCollection new ]! !

!KMKeyCombinationSequence methodsFor: 'combining' stamp: 'GuillermoPolito 3/19/2013 19:46'!
+ aCharacter 
	| last |
	last := self sequence last.
	self sequence removeLast.
	self addShortcut: last + aCharacter.! !

!KMKeyCombinationSequence class methodsFor: 'instance creation' stamp: 'CamilloBruni 3/18/2011 23:11'!
first: aShortcut next: anotherShortcut
	^ (self new)
		first: aShortcut;
		next: anotherShortcut;
		yourself! !

!KMKeymap commentStamp: 'GuillermoPolito 12/14/2010 21:33'!
I am the real keymap.  I have an action to evaluate when my keymap sequence is pressed.!
!KMKeymap methodsFor: 'accessing' stamp: 'GuillermoPolito 4/6/2012 13:28'!
description
	^description ifNil: [ '' ]! !

!KMKeymap methodsFor: 'accessing' stamp: 'GuillermoPolito 11/6/2011 10:17'!
shortcutHasChangedBy: aShortcut
	self defaultShortcut = self shortcut ifTrue: [ self shortcut: aShortcut ].
	self defaultShortcut: aShortcut! !

!KMKeymap methodsFor: 'executing' stamp: 'GuillermoPolito 10/20/2011 18:58'!
executeActionTargetting: target
	^ self action cull: target cull: target! !

!KMKeymap methodsFor: 'matching' stamp: 'BenjaminVanRyseghem 11/1/2013 16:11'!
matchesCompletely: aShortcut
	^ self shortcut matchesCompletely: aShortcut! !

!KMKeymap methodsFor: 'accessing' stamp: 'GuillermoPolito 9/12/2011 17:32'!
hasName
	^name notNil! !

!KMKeymap methodsFor: 'accessing' stamp: 'GuillermoPolito 10/18/2011 20:49'!
defaultShortcut: aShortcut
	defaultShortcut := aShortcut.! !

!KMKeymap methodsFor: 'matching' stamp: 'BenjaminVanRyseghem 7/3/2012 12:57'!
notifyCompleteMatchTo: aListener buffer: aBuffer
	| listeners |
	aListener isCollection ifTrue: [ listeners := aListener ] ifFalse: [ listeners := { aListener } ].
	listeners do: [ :l | l completeMatch: self buffer: aBuffer ].! !

!KMKeymap methodsFor: 'accessing' stamp: 'CamilloBruni 3/18/2011 23:11'!
action
	^ action! !

!KMKeymap methodsFor: 'accessing' stamp: 'GuillermoPolito 4/6/2012 13:28'!
description: aDescription
	description := aDescription asString! !

!KMKeymap methodsFor: 'printing' stamp: 'GuillermoPolito 5/31/2011 12:50'!
printOn: aStream
	aStream 
		nextPutAll: self name printString;
		nextPutAll: ' on ';
		nextPutAll: self shortcut printString;
		nextPutAll: ' do ' ;
		nextPutAll: self action printString;
		cr.    ! !

!KMKeymap methodsFor: 'accessing' stamp: 'CamilloBruni 3/18/2011 23:11'!
key
	^ name! !

!KMKeymap methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 1/10/2014 07:07'!
gtDisplayOn: aStream
	aStream 
		nextPutAll: self name gtDisplayString;
		nextPutAll: ' on ';
		nextPutAll: self shortcut gtDisplayString;
		nextPutAll: ' do ' ;
		nextPutAll: self action gtDisplayString! !

!KMKeymap methodsFor: 'comparing' stamp: 'GuillermoPolito 9/12/2011 17:49'!
hash
	^action hash bitXor: (shortcut hash bitXor: name hash)! !

!KMKeymap methodsFor: 'enabling/disabling' stamp: 'SeanDeNigris 7/8/2012 23:14'!
disable

	self shortcut: KMNoShortcut new.! !

!KMKeymap methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 7/20/2014 22:11'!
gtInspectorSourceCodeIn: composite
	<gtInspectorPresentationOrder: 30> 

	^ self action gtInspectorSourceCodeIn: composite! !

!KMKeymap methodsFor: 'accessing' stamp: 'GuillermoPolito 3/14/2011 02:54'!
shortcut: aShortcut
	shortcut := aShortcut.! !

!KMKeymap methodsFor: 'enabling/disabling' stamp: 'SeanDeNigris 7/8/2012 23:27'!
reset

	self shortcut: self defaultShortcut.! !

!KMKeymap methodsFor: 'accessing' stamp: 'CamilloBruni 3/18/2011 23:35'!
action: anAction
	action := anAction! !

!KMKeymap methodsFor: 'matching' stamp: 'GuillermoPolito 10/20/2011 18:56'!
notifyPartialMatchTo: aListener
	| listeners |
	aListener isCollection ifTrue: [ listeners := aListener ] ifFalse: [ { aListener } ].
	listeners do: [ :l | l partialMatch ].! !

!KMKeymap methodsFor: 'accessing' stamp: 'CamilloBruni 3/18/2011 23:11'!
shortcut
	^ shortcut! !

!KMKeymap methodsFor: 'comparing' stamp: 'MarianoMartinezPeck 5/30/2012 17:12'!
= aKeymap
	self == aKeymap
		ifTrue: [ ^ true ].
	self species = aKeymap species
		ifFalse: [ ^ false ].
	^action = aKeymap action and: [ shortcut = aKeymap shortcut and: [ name = aKeymap name ] ]! !

!KMKeymap methodsFor: 'accessing' stamp: 'GuillermoPolito 12/26/2010 22:14'!
name: aName
	name := aName! !

!KMKeymap methodsFor: 'accessing' stamp: 'GuillermoPolito 10/18/2011 20:49'!
defaultShortcut
	^defaultShortcut! !

!KMKeymap methodsFor: 'matching' stamp: 'BenjaminVanRyseghem 7/3/2012 13:42'!
matches: anEventBuffer

	^ anEventBuffer
		ifEmpty: [ false ]
		ifNotEmpty: [ self shortcut matches: anEventBuffer ]! !

!KMKeymap methodsFor: 'accessing' stamp: 'CamilloBruni 3/18/2011 23:11'!
name
	^ name! !

!KMKeymap methodsFor: 'matching' stamp: 'GuillermoPolito 10/20/2011 19:11'!
onMatchWith: anEventBuffer notify: aMatchListener andDo: anAction
	(self matches: anEventBuffer)
			ifTrue: [ 
				(self matchesCompletely: anEventBuffer)
					ifTrue: [ self notifyCompleteMatchTo: aMatchListener buffer: anEventBuffer ]
					ifFalse: [ self notifyPartialMatchTo: aMatchListener ].
					anAction value.
				] ! !

!KMKeymap class methodsFor: 'instance creation' stamp: 'GuillermoPolito 4/6/2012 13:27'!
named: keymapName shortcut: aShortcut action: anAction description: aDescription
	^ (self new)
		name: keymapName;
		defaultShortcut: aShortcut;
		shortcut: aShortcut;
		action: anAction;
		description: aDescription;
		yourself! !

!KMKeymap class methodsFor: 'instance creation' stamp: 'GuillermoPolito 1/21/2012 21:34'!
shortcut: aShortcut action: anAction
	^ (self new)
		defaultShortcut: aShortcut;
		shortcut: aShortcut;
		action: anAction;
		yourself! !

!KMKeymap class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 16:56'!
gtExampleKeymapA
	<gtExample: 'Keymap: a'>
	^ self 
		named: #a 
		shortcut: $a asKeyCombination
		action: [ ]! !

!KMKeymap class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 16:56'!
gtExampleKeymapFOO
	<gtExample: 'Keymap: FOO'>
	^ self 
		named: #Foo
		shortcut: $F asKeyCombination, $O asKeyCombination, $O asKeyCombination
		action: [ ]! !

!KMKeymap class methodsFor: 'instance creation' stamp: 'GuillermoPolito 10/18/2011 20:49'!
named: keymapName shortcut: aShortcut action: anAction
	^ (self new)
		name: keymapName;
		defaultShortcut: aShortcut;
		shortcut: aShortcut;
		action: anAction;
		yourself! !

!KMKeymapBuilder commentStamp: '<historical>'!
I am a specific builder to configure one shortcut.!
!KMKeymapBuilder methodsFor: 'building' stamp: 'GuillermoPolito 9/24/2012 11:53'!
category: aCategoryName shortcut: aShortcutCombination do: actionBlock description: aDescription
	"actionBlock - can take 3 optional arguments: target, morph, and keyboard event"
	aShortcutCombination combinationsDo: [ :combination |
		KMRepository default
			initializeKeymap: shortcutName
			executingOn: combination shortcut
			doing: actionBlock
			inCategory: aCategoryName
			platform: combination platform
			description: aDescription
	]! !

!KMKeymapBuilder methodsFor: 'accessing' stamp: 'GuillermoPolito 5/31/2011 11:57'!
shortcutName: aShortcutName
	shortcutName := aShortcutName! !

!KMKeymapBuilder methodsFor: 'building' stamp: 'GuillermoPolito 9/24/2012 11:43'!
category: aCategoryName shortcut: aShortcutCombination do: actionBlock
	"actionBlock - can take 3 optional arguments: target, morph, and keyboard event"
	aShortcutCombination combinationsDo: [ :combination |
		KMRepository default
			initializeKeymap: shortcutName
			executingOn: combination shortcut
			doing: actionBlock
			inCategory: aCategoryName
			platform: combination platform
	]! !

!KMKeymapBuilder methodsFor: 'building' stamp: 'GuillermoPolito 4/6/2012 13:23'!
category: aCategoryName default: aShortcut do: anAction description: aDescription
	KMRepository default
		initializeKeymap: shortcutName
		executingOn: aShortcut
		doing: anAction
		inCategory: aCategoryName
		platform: platform
		description: aDescription! !

!KMKeymapBuilder methodsFor: 'building' stamp: 'SeanDeNigris 7/11/2012 09:51'!
category: aCategoryName default: aShortcut do: actionBlock
	"actionBlock - can take 3 optional arguments: target, morph, and keyboard event"

	KMRepository default
		initializeKeymap: shortcutName
		executingOn: aShortcut
		doing: actionBlock
		inCategory: aCategoryName
		platform: platform! !

!KMKeymapBuilder methodsFor: 'accessing' stamp: 'GuillermoPolito 10/21/2011 01:26'!
platform: aPlatform
	platform := aPlatform! !

!KMKeymapBuilder class methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 10/21/2011 00:14'!
for: aShortcutName platform: aPlatform
	^self new 
		shortcutName: aShortcutName;
		platform: aPlatform;
		yourself! !

!KMKeymapTest methodsFor: 'tests' stamp: 'MarcusDenker 9/12/2013 10:03'!
testExecute
	| bm km flag category |
	category := KMCategory named: #TestFoo.
	KMRepository default addCategory: category.
	bm := KMMockMorph new.
	bm attachKeymapCategory: #TestFoo.
	flag := false.
	category
		addKeymapEntry:
			(KMKeymap named: #Foo shortcut: $a asKeyCombination , $b asKeyCombination , $c asKeyCombination action: [ flag := true ]).
	category addKeymapEntry: (KMKeymap named: #Bar shortcut: $p asKeyCombination , $p asKeyCombination action: [  ]).
	{(self eventKey: $a).
	(self eventKey: $b).
	(self eventKey: $c)} do: [ :e | bm dispatchKeystrokeForEvent: e ].
	self assert: flag! !

!KMKeymapTest methodsFor: 'tests' stamp: 'MarcusDenker 9/12/2013 10:03'!
testMatching
	| category blockAction a b c p|
	
	a := self eventKey: $a.
	b := self eventKey: $b.
	c := self eventKey: $c.
	p := self eventKey: $p.
	
	blockAction := [self error: 'error'].
	
	category := KMCategory named: #testCategory.
	category addKeymapEntry:  (KMKeymap named: #Foo shortcut: $a asKeyCombination, $b asKeyCombination, $c asKeyCombination action: blockAction).
	category addKeymapEntry:  (KMKeymap named: #Fum shortcut: $p asKeyCombination, $p asKeyCombination action: blockAction).

	self assert: (category matches: {a}).
	self deny: (category matches: {b}).
	self assert: (category matches: {a. b}).
	self assert: (category matchesCompletely: {a. b. c}).
	self assert: (category matches: {p}).
	self assert: (category matchesCompletely: {p. p.}).
	self deny: (category matches: {a. p. p}).
	self deny: (category matches: {self eventKey: $l. self eventKey: $m. self eventKey: $n. self eventKey: $o}).! !

!KMKeymapTest methodsFor: 'tests' stamp: 'DeboraFortini 12/13/2011 17:23'!
keymapContainer
	^ KMRepository default! !

!KMKeymapTest class methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 3/18/2011 23:11'!
keymapEventBuilderClass
	^ KMFactory keymapEventBuilder! !

!KMLog commentStamp: '<historical>'!
I am a simple log utility that can be enabled by sending the #setDebug and disabled by using #removeDebug. I trace the keymapping events.!
!KMLog class methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 11/1/2011 17:51'!
removeDebug
	debug := false! !

!KMLog class methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 11/1/2011 17:50'!
log: aMessage
	(debug notNil and: [ debug ]) ifTrue: [ Transcript show: aMessage ]! !

!KMLog class methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 11/1/2011 17:51'!
setDebug
	debug := true! !

!KMMetaModifier commentStamp: '<historical>'!
I represent the Meta or Command key modifier. Look at my superclass for a more detailed explanaition.!
!KMMetaModifier methodsFor: 'initialization' stamp: 'NicolasPetton 12/6/2013 15:51'!
initialize
	super initialize.
	identifier := #m.
	name := 'Meta'.! !

!KMMetaModifier methodsFor: 'matching' stamp: 'cami 7/22/2013 18:28'!
matchesEvent: aKeyboardEvent
	self flag: #todo. "Command in windows and linux platforms is 'meta' key and do not have any sense (for the 
	 environment, right now). In the future we need to create a KMMetaModifier to handle properly this, and 
	 keep command as a mac-specific key"
	(Smalltalk os isUnix or: [ Smalltalk os isWin32 ])
		ifTrue: [ ^ aKeyboardEvent controlKeyPressed ].		 

	^ aKeyboardEvent commandKeyPressed! !

!KMMetaModifier methodsFor: 'accessing' stamp: 'SeanDeNigris 11/22/2011 18:53'!
eventCode

	^ 64.! !

!KMMockMorph commentStamp: '<historical>'!
I am a morph used for mock reasons.!
!KMModifiedKeyCombination commentStamp: '<historical>'!
I represent key combinations combining a single key + a modifier.

The modifier could be a single modifier key (look at my subclasses) or a combination of them. For example, valid modified key combinations could be:

- shift + a
- ctrl + shift + c

To create a modified key combinations use the #command, #alt, #control or #shift messages. Like for example:

$a command
$b shift
$1 control
$z alt!
!KMModifiedKeyCombination methodsFor: '*Spec-Core' stamp: 'BenjaminVanRyseghem 12/11/2013 14:58'!
currentCharacter
	
	^ self character key! !

!KMModifiedKeyCombination methodsFor: 'combining' stamp: 'GuillermoPolito 5/31/2011 18:26'!
command
	^ self modifiedBy: KMModifier command! !

!KMModifiedKeyCombination methodsFor: 'matching' stamp: 'BenjaminVanRyseghem 7/3/2012 15:59'!
beginsWith: aKMShortcut 

	^ self = aKMShortcut ! !

!KMModifiedKeyCombination methodsFor: 'comparing' stamp: 'CamilloBruni 3/18/2011 23:11'!
hash
	^ character hash + modifier hash! !

!KMModifiedKeyCombination methodsFor: 'combining' stamp: 'GuillermoPolito 3/19/2013 20:12'!
control
	^ self modifiedBy: KMModifier ctrl! !

!KMModifiedKeyCombination methodsFor: 'accessing' stamp: 'CamilloBruni 3/18/2011 23:11'!
character
	^ character! !

!KMModifiedKeyCombination methodsFor: 'accessing' stamp: 'GuillermoPolito 12/24/2010 22:31'!
modifier: aModifier
	modifier := aModifier! !

!KMModifiedKeyCombination methodsFor: 'combining' stamp: 'CamilloBruni 3/19/2011 21:19'!
alt
	^ self modifiedBy: KMModifier alt! !

!KMModifiedKeyCombination methodsFor: 'combining' stamp: 'GuillermoPolito 5/3/2013 14:51'!
modifiedBy: aModifier
	^self character asKeyCombination modifiedBy: modifier + aModifier.! !

!KMModifiedKeyCombination methodsFor: 'accessing' stamp: 'CamilloBruni 3/18/2011 23:11'!
modifier
	^ modifier! !

!KMModifiedKeyCombination methodsFor: 'combining' stamp: 'CamilloBruni 3/18/2011 23:11'!
shift
	^ self modifiedBy: KMModifier shift! !

!KMModifiedKeyCombination methodsFor: 'matching' stamp: 'GuillermoPolito 10/20/2011 15:51'!
matchesEvent: aKeyboardEvent
	^ (self modifier matchesEvent: aKeyboardEvent) 
		and: [self character matchesEvent: aKeyboardEvent]! !

!KMModifiedKeyCombination methodsFor: 'comparing' stamp: 'NicolasPetton 12/6/2013 16:21'!
= aShortcut
	super = aShortcut
		ifFalse: [ ^ false ]. 
	 modifier = aShortcut modifier
		ifFalse: [ ^ false ].
	aShortcut character = character
		ifFalse: [ ^ false ].
	^ true! !

!KMModifiedKeyCombination methodsFor: 'printing' stamp: 'CamilloBruni 3/20/2011 23:45'!
printOn: aStream
	modifier printOn: aStream.
	aStream << ' + '.
	character printOn: aStream.! !

!KMModifiedKeyCombination methodsFor: 'combining' stamp: 'GuillermoPolito 3/19/2013 20:12'!
ctrl
	^ self control! !

!KMModifiedKeyCombination methodsFor: 'accessing' stamp: 'GuillermoPolito 12/25/2010 14:22'!
character: aCharacter 
	character := aCharacter.! !

!KMModifiedKeyCombination methodsFor: 'accessing' stamp: 'SeanDeNigris 11/22/2011 18:39'!
key

	^ self character key.! !

!KMModifiedKeyCombination class methodsFor: 'instance creation' stamp: 'CamilloBruni 3/18/2011 23:11'!
modifier: aModifier character: aCharacter
	^ (self new)
		modifier: aModifier;
		character: aCharacter;
		yourself! !

!KMModifier commentStamp: '<historical>'!
I'm an abstract class representing a key modifier. A modifier is a key that is pressed to modify the value of a following key. For example, valid modifiers are Alt, Ctrl, Cmd (only for macosx), Shift. Additionally, I could be a composed modifier, combining several of the named above. For example, I could have a value of Alt + Ctrl.!
!KMModifier methodsFor: 'accessing' stamp: 'CamilloBruni 3/20/2011 23:54'!
identifier
	^ identifier! !

!KMModifier methodsFor: 'matching' stamp: 'CamilloBruni 3/19/2011 20:50'!
matchesEvent: aKeyboardEvent
	self subclassResponsibility! !

!KMModifier methodsFor: 'comparing' stamp: 'CamilloBruni 3/20/2011 23:54'!
hash
	^ identifier hash bitXor: name hash! !

!KMModifier methodsFor: 'comparing' stamp: 'CamilloBruni 3/20/2011 23:58'!
= aShortcut
	super = aShortcut
		ifFalse: [ ^ false ]. 
	aShortcut identifier = identifier 
		ifFalse: [ ^ false ].
	^ true! !

!KMModifier methodsFor: 'printing' stamp: 'GuillermoPolito 8/10/2014 13:25'!
symbol
	^ '⌘'! !

!KMModifier methodsFor: 'accessing' stamp: 'SeanDeNigris 11/22/2011 19:00'!
eventCode
	"No modifiers"
	
	^ 0.! !

!KMModifier methodsFor: 'printing' stamp: 'CamilloBruni 3/20/2011 23:54'!
printOn: aStream
	aStream << name! !

!KMModifier methodsFor: 'matching' stamp: 'CamilloBruni 3/19/2011 20:49'!
matches: aKeyboardEvent
	self shouldNotImplement! !

!KMModifier methodsFor: 'combining' stamp: 'CamilloBruni 3/19/2011 21:16'!
modifiedBy: modifier
	^ KMComposedModifier new
		modifiedBy: modifier;
		modifiedBy: self;
		yourself! !

!KMModifier methodsFor: 'accessing' stamp: 'CamilloBruni 3/20/2011 23:54'!
name
	^ name! !

!KMModifier methodsFor: 'combining' stamp: 'GuillermoPolito 3/19/2013 19:12'!
+ modifier
	^ modifier asKeyCombination modifiedBy: self! !

!KMModifier class methodsFor: 'instance creation' stamp: 'CamilloBruni 9/15/2013 19:49'!
meta
	^ KMMetaModifier new! !

!KMModifier class methodsFor: 'instance creation' stamp: 'NicolasPetton 12/6/2013 15:56'!
command
	^ KMCommandModifier new! !

!KMModifier class methodsFor: 'instance creation' stamp: 'CamilloBruni 3/18/2011 23:11'!
alt
	^ KMAltModifier new! !

!KMModifier class methodsFor: 'instance creation' stamp: 'GuillermoPolito 3/19/2013 20:19'!
control
	^ KMCtrlModifier new! !

!KMModifier class methodsFor: 'instance creation' stamp: 'CamilloBruni 3/18/2011 23:11'!
shift
	^ KMShiftModifier new! !

!KMModifier class methodsFor: 'instance creation' stamp: 'CamilloBruni 3/18/2011 23:11'!
ctrl
	^ KMCtrlModifier new! !

!KMNoKeymap commentStamp: 'GuillermoPolito 2/24/2011 23:43'!
I am a Null object representing the absence of a Keymap.!
!KMNoKeymap methodsFor: 'accessing' stamp: 'CamilloBruni 3/18/2011 23:11'!
shortcut
	^ KMNoShortcut new! !

!KMNoModifier commentStamp: 'GuillermoPolito 8/10/2014 13:24'!
I represent the absense of a key modifier. I fulfill the role of a null pattern, having as default no printing and not matching.!
!KMNoModifier methodsFor: 'initialization' stamp: 'GuillermoPolito 8/10/2014 13:25'!
initialize
	super initialize.
	identifier := #''.
	name := ''.! !

!KMNoShortcut commentStamp: '<historical>'!
I do not match with any keyboard event.

I respond to the Null object pattern, since I represent the inexistance of a key combination.!
!KMNoShortcut methodsFor: 'matching' stamp: 'CamilloBruni 3/20/2011 23:50'!
matches: anEventBuffer
	^ false! !

!KMNoShortcut methodsFor: 'combining' stamp: 'CamilloBruni 3/18/2011 23:11'!
, aShortcut
	^ aShortcut! !

!KMNoShortcut methodsFor: 'printing' stamp: 'CamilloBruni 3/20/2011 23:41'!
printOn: aStream! !

!KMNoShortcut methodsFor: 'matching' stamp: 'CamilloBruni 3/20/2011 23:50'!
matchesCompletely: anEventBuffer
	^ false! !

!KMNoShortcut methodsFor: 'combining' stamp: 'CamilloBruni 3/18/2011 23:11'!
+ aKMModifier
	^ aKMModifier! !

!KMPartialMatch commentStamp: '<historical>'!
A KMPartialMatch is an announcement raised when a partial match is completed!
!KMPartialMatch methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/3/2012 12:52'!
event
	^ event! !

!KMPartialMatch methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/3/2012 12:52'!
event: anObject
	event := anObject! !

!KMPartialMatch methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/3/2012 14:42'!
source: anObject
	source := anObject! !

!KMPartialMatch methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/3/2012 14:42'!
source
	^ source! !

!KMPartialMatch class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 7/3/2012 14:42'!
event: event from: source

	^ self new
		event: event;
		source: source;
		yourself! !

!KMPerInstanceTests methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 1/21/2012 21:37'!
testAddMoreThanOneHandler
	| flag morph |
	flag := 0.
	morph := KMMockMorph new.
	morph on: $i do: [ flag := flag + 1 ].
	morph on: $j do: [ flag := flag + 6 ].
	{ self eventKey: $i. self eventKey: $j }
		do: [:e | morph dispatchKeystrokeForEvent: e].
	self assert: flag equals: 7.! !

!KMPlatformSpecificKeyCombination commentStamp: '<historical>'!
I represent a platform specific key combination, one that should only be launched for a particular platform such as windows, unix or mac.

I'm a sort of decorator of a key combination.!
!KMPlatformSpecificKeyCombination methodsFor: '*Spec-Core' stamp: 'BenjaminVanRyseghem 12/11/2013 15:04'!
currentCharacter

	^ (self platform = #all or: [ self platform = OSPlatform current platformFamily ])
		ifTrue: [ self shortcut currentCharacter ]
		ifFalse: [ nil ]! !

!KMPlatformSpecificKeyCombination methodsFor: 'combining' stamp: 'GuillermoPolito 3/15/2013 03:06'!
| aShortcut
	^KMKeyCombinationChoice withShortcuts: { self . aShortcut }! !

!KMPlatformSpecificKeyCombination methodsFor: 'printing' stamp: 'BenjaminVanRyseghem 2/19/2014 11:55'!
prettyPrintOn: aStream

	self platform = #MacOSX
		ifTrue: [ shortcut prettyPrintOn: aStream ]
		ifFalse: [ shortcut printOn: aStream ]! !

!KMPlatformSpecificKeyCombination methodsFor: 'iterating' stamp: 'GuillermoPolito 9/24/2012 11:40'!
combinationsDo: aBlock
	aBlock value: self! !

!KMPlatformSpecificKeyCombination methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 11/1/2013 16:13'!
matchesCompletely: aCollection

	self platform == Smalltalk os platformFamily ifFalse: [ ^ false ].	
	^ self shortcut matchesCompletely: aCollection! !

!KMPlatformSpecificKeyCombination methodsFor: 'accessing' stamp: 'GuillermoPolito 9/24/2012 11:13'!
shortcut: aShortcut
	shortcut := aShortcut! !

!KMPlatformSpecificKeyCombination methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 11/1/2013 16:13'!
matches: aCollection

	self platform == Smalltalk os platformFamily ifFalse: [ ^ false ].	
	^ self shortcut matches: aCollection! !

!KMPlatformSpecificKeyCombination methodsFor: 'accessing' stamp: 'GuillermoPolito 9/24/2012 11:14'!
shortcut
	^shortcut! !

!KMPlatformSpecificKeyCombination methodsFor: 'accessing' stamp: 'GuillermoPolito 9/24/2012 11:15'!
platform
	^platform! !

!KMPlatformSpecificKeyCombination methodsFor: 'accessing' stamp: 'GuillermoPolito 9/24/2012 11:14'!
platform: aPlatform
	platform := aPlatform! !

!KMPlatformSpecificKeyCombination class methodsFor: 'instance creation' stamp: 'GuillermoPolito 9/24/2012 11:14'!
with: aShortcut onPlatform: aPlatform
	^self new
			shortcut: aShortcut;
			platform: aPlatform;
			yourself! !

!KMPragmaKeymapBuilder commentStamp: '<historical>'!
I am a singleton object, subscribed to system events, to listen to the creation of methods marked with the <keymap> and keymap:> pragmas.

When I listen one of those events, I reinitialize the KMRepository default instance and reload it with all declared keymaps.!
!KMPragmaKeymapBuilder methodsFor: 'registrations handling' stamp: 'BenjaminVanRyseghem 4/7/2012 23:14'!
collectRegistrations
	| menu |
	menu := PragmaMenuAndShortcutRegistration model: self.
	
	self pragmaCollector
		do: [:prg | prg methodClass theNonMetaClass 
				perform: prg selector
				with: (menu 
						platform: prg arguments;
						yourself) ].
	
	self interpretRegistration: menu! !

!KMPragmaKeymapBuilder methodsFor: 'initialization' stamp: 'GuillermoPolito 12/17/2010 00:58'!
initialize
	super initialize.
	pragmaKeywords := OrderedCollection new.
	! !

!KMPragmaKeymapBuilder methodsFor: 'accessing' stamp: 'GuillermoPolito 12/17/2010 00:46'!
model
	^ model! !

!KMPragmaKeymapBuilder methodsFor: 'accessing' stamp: 'GuillermoPolito 12/17/2010 00:46'!
builder
	^ self! !

!KMPragmaKeymapBuilder methodsFor: 'accessing' stamp: 'GuillermoPolito 12/17/2010 00:46'!
itemReceiver
	^ model! !

!KMPragmaKeymapBuilder methodsFor: 'private' stamp: 'GuillermoPolito 9/24/2012 11:57'!
interpretRegistration: aRegistration
	
	aRegistration items do: [:item || node |
		node := KMKeymapBuilder 
					for: item shortcut
					platform: item platform.
		item help 
			ifNil: [
				node
					category: item category
					shortcut: item default
					do: item action ]
			ifNotNil:[ 
				node
					category: item category
					shortcut: item default
					do: item action
					description: item help ]]! !

!KMPragmaKeymapBuilder methodsFor: 'initialize-release' stamp: 'GuillermoPolito 1/27/2011 18:10'!
reset
	pragmaCollector := nil.
	"KeymapManager default: KeymapManager new."
	self collectRegistrations.! !

!KMPragmaKeymapBuilder methodsFor: 'accessing' stamp: 'GuillermoPolito 10/21/2011 00:04'!
pragmaKeywords
	"Returns the pragmas keyword used to select pragmas (see #pragmaCollector)"
	^  self class pragmas! !

!KMPragmaKeymapBuilder methodsFor: 'registrations handling' stamp: 'GuillermoPolito 10/21/2011 00:00'!
pragmaCollector
	"Return an up-to-date pragmaCollector which contains all pragmas which keyword is self pragmaKeyword"
	^ pragmaCollector 
		ifNil: [pragmaCollector:= (PragmaCollector filter: [:prg | (self pragmaKeywords includes: prg keyword) and: [prg selector numArgs = 1]]).
			(self pragmaKeywords notNil and: [self pragmaKeywords notEmpty])  ifTrue: [pragmaCollector reset].
			pragmaCollector whenChangedSend: #reset to: self.
			pragmaCollector]! !

!KMPragmaKeymapBuilder methodsFor: 'accessing' stamp: 'GuillermoPolito 12/17/2010 00:46'!
model: anObject
	model := anObject! !

!KMPragmaKeymapBuilder methodsFor: 'initialize-release' stamp: 'GuillermoPolito 5/4/2012 23:00'!
release
	self pragmaCollector unsubscribe: self.
	self pragmaCollector announcer initialize. "Hack because the announcer is not garbage collected."
	pragmaCollector := nil.
	model := nil.
	super release
	! !

!KMPragmaKeymapBuilder class methodsFor: 'system-events' stamp: 'BernardoContreras 10/7/2014 18:24'!
registerInterestToSystemAnnouncement
	<systemEventRegistration>
	SystemAnnouncer uniqueInstance 
		unsubscribe: self;
		when: MethodAdded, MethodModified, MethodRemoved 
			send: #event: 
			to: self.! !

!KMPragmaKeymapBuilder class methodsFor: 'instance creation' stamp: 'GuillermoPolito 10/20/2011 23:55'!
pragmas
	^#(#keymap #keymap:)! !

!KMPragmaKeymapBuilder class methodsFor: 'instance creation' stamp: 'GuillermoPolito 7/31/2012 12:00'!
initialize
	"KMPragmaKeymapBuilder initialize"
	self uniqueInstance reset.! !

!KMPragmaKeymapBuilder class methodsFor: 'private' stamp: 'CamilleTeruel 9/4/2014 16:30'!
event: anEvent
	anEvent method ifNil: [ ^self ].
	((anEvent method pragmas collect: #keyword) includesAnyOf: self pragmas )
		ifTrue: [ self uniqueInstance reset ]! !

!KMPragmaKeymapBuilder class methodsFor: 'instance creation' stamp: 'GuillermoPolito 10/20/2011 23:59'!
uniqueInstance
	^UniqueInstace ifNil: [ UniqueInstace := self new ]! !

!KMPragmaKeymapBuilder class methodsFor: 'instance creation' stamp: 'CamilleTeruel 7/29/2012 18:45'!
release
	SystemAnnouncer uniqueInstance unsubscribe: self.
	self uniqueInstance release! !

!KMRepository commentStamp: 'GuillermoPolito 12/14/2010 21:37'!
I have a singleton instance which can be accessed by executing the following:
"self default"

I am currently a god object to be refactored =D.!
!KMRepository methodsFor: 'accessing' stamp: 'CamilloBruni 3/18/2011 23:11'!
categories
	^ categories ifNil: [ categories := Dictionary new ]! !

!KMRepository methodsFor: 'accessing' stamp: 'CamilloBruni 3/18/2011 23:11'!
keymapNamed: aKeymapName inCategory: aKeymapCategory
	^ (self categoryForName: aKeymapCategory) keymapNamed: aKeymapName! !

!KMRepository methodsFor: 'accessing' stamp: 'GuillermoPolito 3/19/2013 19:12'!
initializeKeymap: shortcutName executingOn: shortcut doing: action inCategory: categoryName platform: aPlatform description: aDescription
	| category entry |
	category := self ensureCategoryByName: categoryName.
	(category hasKeymapNamed: shortcutName at: aPlatform) not
		ifTrue: [
			entry := shortcut asKeyCombination named: shortcutName do: action withDescription: aDescription.
			category addKeymapEntry: entry at: aPlatform.
			]
		ifFalse:[
			entry := category keymapNamed: shortcutName at: aPlatform.
			entry shortcutHasChangedBy: shortcut asKeyCombination.
			entry action: action.
			entry description: aDescription
			]! !

!KMRepository methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 7/20/2014 21:53'!
gtInspectorGlobalsIn: composite
	<gtInspectorPresentationOrder: 40>
	composite table 
		title: 'Global keys';
		display: [ 
			self globalCategories
				flatCollect: [ :category | 
					category allEntries keymaps collect: [ :key | key -> category ] ]
				 ];
		filterOn: [ :text :each | each gtDisplayString includesSubstring: text caseSensitive: false ];
		column: 'Shortcut' evaluated: [ :assoc | assoc key shortcut gtDisplayString ] width: 120;
		column: 'Description' evaluated: [ :assoc | assoc key description ];
		column: 'Action' evaluated: [ :assoc | assoc key action gtDisplayString ];
		column: 'Category' evaluated: [ :assoc | '' ] tags: [ :assoc | assoc value name ifNil: [ #() ] ifNotNil: [ { assoc value name }]];
		send: #key! !

!KMRepository methodsFor: 'testing' stamp: 'CamilloBruni 3/18/2011 23:11'!
includesCategory: aCategory
	^ self categories includes: aCategory! !

!KMRepository methodsFor: 'global' stamp: 'GuillermoPolito 5/3/2013 15:55'!
globalCategories
	^globalCategories ifNil: [ globalCategories := OrderedCollection new ]! !

!KMRepository methodsFor: 'accessing' stamp: 'CamilloBruni 3/18/2011 23:11'!
categoryHolders
	^ categoryHolders ifNil: [ categoryHolders := Dictionary new ]! !

!KMRepository methodsFor: 'keymaps' stamp: 'GuillermoPolito 3/13/2011 17:58'!
attachCategoryName: aCategorySymbol to: aClass 
	self attach: (self ensureCategoryByName: aCategorySymbol) to: aClass.! !

!KMRepository methodsFor: 'accessing' stamp: 'MarcusDenker 9/12/2013 10:03'!
ensureCategoryByName: aCategorySymbol
	| category |
	(self includesCategoryNamed: aCategorySymbol)
		ifFalse: [ 
			category := KMCategory named: aCategorySymbol.
			self addCategory: category ]
		ifTrue: [ category := self categoryForName: aCategorySymbol ].
	^ category! !

!KMRepository methodsFor: 'keymaps' stamp: 'GuillermoPolito 12/26/2010 22:05'!
attach: aCategory to: aClass
	(self categoryHolders includesKey: aClass) 
		ifFalse: [ self categoryHolders at: aClass put: Set new ].
	
	(self categoryHolders at: aClass) add: aCategory! !

!KMRepository methodsFor: 'accessing' stamp: 'GuillermoPolito 4/6/2012 13:25'!
initializeKeymap: shortcutName executingOn: shortcut doing: action inCategory: categoryName platform: aPlatform
	^self initializeKeymap: shortcutName executingOn: shortcut doing: action inCategory: categoryName platform: aPlatform description: ''! !

!KMRepository methodsFor: 'accessing' stamp: 'MarcusDenker 9/12/2013 10:03'!
categoryForName: aCategorySymbol
	^ self categories at: aCategorySymbol ifAbsentPut: [ KMCategory named: aCategorySymbol ]! !

!KMRepository methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 1/27/2015 20:59'!
gtInspectorMappingsIn: composite
	<gtInspectorPresentationOrder: 40>
	composite table 
		title: 'Keys';
		display: [ 
			self categories values
				flatCollect: [ :category | 
					category allEntries keymaps collect: [ :key | key -> category ] ]
				 ];
		filterOn: [ :text :each | each gtDisplayString includesSubstring: text caseSensitive: false ];
		column: 'Shortcut' evaluated: [ :assoc | assoc key shortcut gtDisplayString ] width: 120;
		column: 'Action' evaluated: [ :assoc | assoc key action gtDisplayString ];
		column: 'Description' evaluated: [ :assoc | assoc key description ];
		column: 'Category' evaluated: [ :assoc | '' ] tags: [ :assoc | assoc value name ifNil: [ #() ] ifNotNil: [ { assoc value name }]];
		send: #key! !

!KMRepository methodsFor: 'testing' stamp: 'CamilloBruni 3/18/2011 23:11'!
includesCategoryNamed: aCategorySymbol
	^ self categories includesKey: aCategorySymbol! !

!KMRepository methodsFor: 'associating' stamp: 'GuillermoPolito 12/15/2010 01:59'!
addCategory: aCategory
	(self includesCategory: aCategory)
		ifTrue: [ self error: 'a Category named ' , aCategory name, ' already exists.' ].
	self categories at: aCategory name put: aCategory.! !

!KMRepository methodsFor: 'global' stamp: 'GuillermoPolito 5/3/2013 15:58'!
setAsGlobalCategory: aGlobalCategory
	| category |
	category := aGlobalCategory asKmCategoryIn: self.
	(self globalCategories includes: category)
		ifFalse: [ self globalCategories add: category ]! !

!KMRepository class methodsFor: 'instance creation' stamp: 'MarcusDenker 9/12/2013 10:03'!
reset
	"Do not reset KMDispatchers instances, it may make the image unusable or force the user to close all the windows."
	
	"TODO: a better reset, allowing the KMDispatcher instances to reload all named, updated, keymaps from the resetted KMRepository."

	World setProperty: #kmDispatcher toValue: nil.
	self default: self new.
	KMCategory allSubclasses
		select: [ :c | c isGlobalCategory ]
		thenDo: [ :c | c new installAsGlobalCategory ].
	KMPragmaKeymapBuilder uniqueInstance reset.! !

!KMRepository class methodsFor: 'instance creation' stamp: 'CamilloBruni 3/18/2011 23:11'!
default
	^ Singleton ifNil: [ Singleton := self new ]! !

!KMRepository class methodsFor: 'instance creation' stamp: 'CamilloBruni 3/18/2011 23:11'!
default: aDefault
	^ Singleton := aDefault! !

!KMRepository class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 3/26/2015 00:05'!
gtExampleDefault
	<gtExample>
	^ self default! !

!KMRepository class methodsFor: 'cleanup' stamp: 'MarcusDenker 10/11/2013 12:31'!
cleanUp
	self reset! !

!KMShiftModifier commentStamp: '<historical>'!
I represent the Shift key modifier. Look at my superclass for a more detailed explanaition.!
!KMShiftModifier methodsFor: 'matching' stamp: 'GuillermoPolito 10/20/2011 15:50'!
matchesEvent: aKeyboardEvent
	^ aKeyboardEvent shiftPressed! !

!KMShiftModifier methodsFor: 'initialization' stamp: 'CamilloBruni 3/20/2011 23:55'!
initialize
	super initialize.
	identifier := #s.
	name := 'Shift'.! !

!KMShiftModifier methodsFor: 'accessing' stamp: 'BenComan 2/23/2014 01:29'!
eventCode
	^8! !

!KMShortcutDeclaration commentStamp: '<historical>'!
I represent a shortcut declaration for the settings pharo framework.!
!KMShortcutDeclaration methodsFor: 'accessing' stamp: 'GuillermoPolito 5/31/2011 13:54'!
shortcutName
	^shortcutName! !

!KMShortcutDeclaration methodsFor: 'accessing' stamp: 'GuillermoPolito 5/31/2011 13:54'!
shortcutName: aShortcutName
	shortcutName := aShortcutName! !

!KMShortcutDeclaration methodsFor: 'accessing' stamp: 'GuillermoPolito 10/18/2011 20:58'!
realValue: aShortcut
	self realValue accept: aShortcut.! !

!KMShortcutDeclaration methodsFor: 'accessing' stamp: 'GuillermoPolito 5/31/2011 12:27'!
categoryName: aCategoryName
	categoryName := aCategoryName! !

!KMShortcutDeclaration methodsFor: 'accessing' stamp: 'GuillermoPolito 5/31/2011 12:27'!
categoryName
	^categoryName! !

!KMShortcutDeclaration methodsFor: 'accessing' stamp: 'GuillermoPolito 9/12/2011 17:45'!
realValue
	"Answer the value of realValue"

	^ declaration
		ifNil: [
			declaration := KMShortcutSetting for: self shortcutName in: self categoryName]! !

!KMShortcutDeclaration methodsFor: 'accessing' stamp: 'GuillermoPolito 10/18/2011 20:52'!
defaultValue
	^self realValue defaultShortcut! !

!KMShortcutHandler commentStamp: '<historical>'!
I am a shortcut handler that installs keymappings in the system.!
!KMShortcutHandler methodsFor: 'shortcut-handling' stamp: 'GuillermoPolito 11/7/2013 16:52'!
handleKeystroke: aKeystrokeEvent inMorph: aMorph

	aMorph handleKeystrokeWithKeymappings: aKeystrokeEvent! !

!KMShortcutSetting commentStamp: '<historical>'!
I represent a shortcut setting. I relate a keymap with its default shortcut and its current shortcut, so it can be mutated.!
!KMShortcutSetting methodsFor: 'accessing' stamp: 'GuillermoPolito 1/20/2011 00:55'!
category: aCategory
	category := aCategory! !

!KMShortcutSetting methodsFor: 'accessing' stamp: 'GuillermoPolito 5/31/2011 12:43'!
keymap
	^ KMFactory keymapContainer keymapNamed: shortcutName inCategory: category! !

!KMShortcutSetting methodsFor: 'setting' stamp: 'GuillermoPolito 1/24/2011 01:13'!
accept: aShortcut 
	self keymap shortcut: aShortcut! !

!KMShortcutSetting methodsFor: 'accessing' stamp: 'GuillermoPolito 10/18/2011 20:52'!
defaultShortcut
	^ self keymap defaultShortcut! !

!KMShortcutSetting methodsFor: 'accessing' stamp: 'CamilloBruni 3/18/2011 23:11'!
keystrokes
	^ self keymap shortcut! !

!KMShortcutSetting methodsFor: 'accessing' stamp: 'GuillermoPolito 1/24/2011 22:02'!
action: anActionBlock
	action := anActionBlock! !

!KMShortcutSetting methodsFor: 'accessing' stamp: 'CamilloBruni 3/18/2011 23:11'!
shortcut
	^ self keymap shortcut! !

!KMShortcutSetting methodsFor: 'accessing' stamp: 'GuillermoPolito 5/31/2011 12:46'!
shortcutName: aShortcutName
	shortcutName := aShortcutName! !

!KMShortcutSetting class methodsFor: 'as yet unclassified' stamp: 'EstebanLorenzano 5/10/2013 09:24'!
settingInputWidgetForNode: aSettingNode
	| catcherMorph theme |
	theme := UITheme builder.
	catcherMorph := KMCatcherMorph for: aSettingNode realValue.
	^ theme newRow: {catcherMorph}! !

!KMShortcutSetting class methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 3/18/2011 23:11'!
for: aShortcutName in: aCategory
	^ (self new)
		shortcutName: aShortcutName;
		category: aCategory;
		yourself! !

!KMShortcutTest methodsFor: 'tests' stamp: 'GuillermoPolito 3/19/2013 19:12'!
testSingleShortcutsMatch
	|a one home |
	a := self eventKey: $a.
	one := self eventKey: 1 asCharacter.
	home := self eventKey: Character home.
	
	self assert: ($a asKeyCombination matches: {a}).
	self assert: (1 asKeyCombination matches: {one}).
	self assert: (Character home asKeyCombination matches: {home}).
	
	self deny: ($b asKeyCombination matches: {a}).
	
	self assert: ($a asKeyCombination matchesCompletely: {a}).
	self assert: (1 asKeyCombination matchesCompletely: {one}).! !

!KMShortcutTest methodsFor: 'tests' stamp: 'BenComan 2/23/2014 01:40'!
testEventCodes
	self assert: $s command modifier eventCode 
		 equals: OSPlatform current defaultModifier eventCode ! !

!KMShortcutTest methodsFor: 'tests' stamp: 'CamilloBruni 3/21/2011 21:56'!
testTripleChainShortcutSucceds
	^ self assert: ($e ctrl , $e ctrl , $d ctrl) = ($e ctrl , $e ctrl , $d ctrl)! !

!KMShortcutTest methodsFor: 'tests' stamp: 'CamilloBruni 3/21/2011 21:56'!
testChainIntegerSucceds
	^ self assert: ($e ctrl , 1) = ($e ctrl , 1)! !

!KMShortcutTest methodsFor: 'tests' stamp: 'CamilloBruni 3/21/2011 21:56'!
testChainSimpleCharsSucceds
	^ self assert: ($e ctrl , $e) = ($e ctrl , $e)! !

!KMShortcutTest methodsFor: 'tests' stamp: 'GuillermoPolito 1/21/2012 20:39'!
testCmdShiftSucceds
	^ self assert: ($1 shift ctrl matches: {self eventKey: $1 alt: false ctrl: true command: false shift: true})! !

!KMShortcutTest methodsFor: 'tests' stamp: 'CamilloBruni 3/21/2011 21:56'!
testCmdIntegerSucceds
	^ self assert: 1 ctrl = 1 ctrl! !

!KMShortcutTest methodsFor: 'tests' stamp: 'CamilloBruni 3/21/2011 21:56'!
testBadComposedCmdShortcutFails
	^ self should: [ KMModifier ctrl ctrl ] raise: Error! !

!KMShortcutTest methodsFor: 'tests' stamp: 'CamilloBruni 3/21/2011 21:56'!
testComplexChainMatches
	|eCtrl eShift e f|
	
	f := self eventKey: $f.
	eCtrl := self eventKey: $e ctrl: true.
	eShift := self eventKey: $e shift: true.
		
	self assert: (($e ctrl, $e shift, $f) matches: {eCtrl}).
	self assert: (($e ctrl, $e shift, $f) matches: {eCtrl. eShift}).
	self assert: (($e ctrl, $e shift, $f) matches: {eCtrl. eShift. f}).

	self deny: (($e ctrl, $e shift, $f) matchesCompletely: {eCtrl}).
	self deny: (($e ctrl, $e shift, $f) matchesCompletely: {eCtrl. eShift}).
	self assert: (($e ctrl, $e shift, $f) matchesCompletely: {eCtrl. eShift. f}).! !

!KMShortcutTest methodsFor: 'tests' stamp: 'CamilloBruni 3/21/2011 21:56'!
testCmdKeySucceds
	^ self assert: $e ctrl = $e ctrl! !

!KMShortcutTest methodsFor: 'tests' stamp: 'CamilloBruni 3/21/2011 21:56'!
testChainShortcutSucceds
	^ self assert: ($e ctrl , $e ctrl) = ($e ctrl , $e ctrl)! !

!KMShortcutTest methodsFor: 'tests' stamp: 'CamilloBruni 3/21/2011 21:56'!
testSimpleChainMatches
	|e eCtrl |
	e := self eventKey: $e.
	eCtrl := self eventKey: $e ctrl: true.
	
	self assert: (($e ctrl, $e) matches: {eCtrl}).
	self assert: ($e ctrl matches: {eCtrl. e}).
	
	self deny: (($e ctrl, $e) matches: {eCtrl. self eventKey: $a}).
	self deny: ($e ctrl matches: {e}).! !

!KMShortcutTest methodsFor: 'tests' stamp: 'GuillermoPolito 1/21/2012 20:39'!
testModifiedShortcutsMatch
	|a oneShift oneCommand oneCommandShift|
	
	a := self eventKey: $a ctrl: true.
	oneShift := self eventKey: $1 shift: true.
	oneCommand := self eventKey: $1 command: true.
	oneCommandShift := self eventKey: $1 alt: false ctrl: false command: true shift: true.
	
	self assert: ($a ctrl matches: {a}).
	self assert: ($1 shift matches: {oneShift}).
	self assert: ($1 command matches: {oneCommand}).
	self assert: ($1 command shift matches: {oneCommandShift}).
	
	self deny: ($a ctrl matches: {self eventKey: $a command: true}).
	
	self deny: ($i command shift matches: {self eventKey: $i command: true}).
	self assert: ($i ctrl shift matches: {self eventKey: $i alt: false ctrl: true command: false shift: true}).
	self deny: ($i ctrl matches: {self eventKey: $i alt: false ctrl: true command: false shift: true}).
	
	self assert: ($a ctrl matchesCompletely: {a}).
	self assert: ($1 shift matchesCompletely: {oneShift}).
	self assert: ($1 command matchesCompletely: {oneCommand}).
	self assert: ($1 command shift matchesCompletely: {oneCommandShift}).! !

!KMShortcutTest methodsFor: 'tests' stamp: 'GuillermoPolito 2/14/2014 15:54'!
testAsString
	self assert: $a ctrl asString = 'Ctrl + A'.
	self assert: $b command asString = 'Cmd + B'.
	self assert: $c shift asString = 'Shift + C'.
	self assert: $d alt asString = 'Alt + D'.
	self assert: $e ctrl command asString =  (KMCtrlModifier new asString ,' + ' , KMCommandModifier new asString,' + E').
	
	
! !

!KMShortcutTest methodsFor: 'tests' stamp: 'CamilloBruni 3/21/2011 21:56'!
testShiftKeySucceds
	^ self assert: $e shift = $e shift! !

!KMShortcutTest methodsFor: 'tests' stamp: 'GuillermoPolito 3/19/2013 20:28'!
testCreation
	self assert: ($e asKeyCombination isKindOf: KMSingleKeyCombination).
	self assert: ($e ctrl isKindOf: KMModifiedKeyCombination).
	self assert: ($e ctrl alt shift command isKindOf: KMModifiedKeyCombination).! !

!KMSingleKeyCombination commentStamp: '<historical>'!
I represent a single key press, the simplest key combination.

I match with a keyboard event when that event key is the same as me and the key event is not modified.

To create a single key combination use the #asShortcut message. Like for example:

$a asShortcut!
!KMSingleKeyCombination methodsFor: '*Spec-Core' stamp: 'BenjaminVanRyseghem 1/10/2014 20:31'!
currentCharacter

	^ key! !

!KMSingleKeyCombination methodsFor: 'matching' stamp: 'DeboraFortini 10/18/2011 19:40'!
matchesEvent: aKeyboardEvent
	^ self key asLowercase = aKeyboardEvent modifiedCharacter asLowercase! !

!KMSingleKeyCombination methodsFor: 'comparing' stamp: 'CamilloBruni 3/18/2011 23:11'!
hash
	^ key hash! !

!KMSingleKeyCombination methodsFor: 'accessing' stamp: 'GuillermoPolito 12/25/2010 14:21'!
key: aKeyString
	key := aKeyString.! !

!KMSingleKeyCombination methodsFor: 'comparing' stamp: 'GuillermoPolito 10/20/2011 16:30'!
= aShortcut
	^ super = aShortcut and: [ aShortcut key sameAs: key ]! !

!KMSingleKeyCombination methodsFor: 'printing' stamp: 'CamilloBruni 9/15/2013 21:18'!
printOn: aStream
	aStream nextPutAll: self name asUppercase.! !

!KMSingleKeyCombination methodsFor: 'printing' stamp: 'GuillermoPolito 8/10/2014 13:36'!
prettyPrintOn: aStream

	self printOn: aStream! !

!KMSingleKeyCombination methodsFor: 'combining' stamp: 'GuillermoPolito 3/15/2013 02:52'!
modifiedBy: aModifier
	^ KMModifiedKeyCombination modifier: aModifier character: self! !

!KMSingleKeyCombination methodsFor: 'accessing' stamp: 'GuillermoPolito 8/10/2014 13:25'!
modifier

	^ KMNoModifier new.! !

!KMSingleKeyCombination methodsFor: 'accessing' stamp: 'CamilloBruni 3/18/2011 23:11'!
key
	^ key! !

!KMSingleKeyCombination methodsFor: 'accessing' stamp: 'CamilloBruni 9/15/2013 20:19'!
name
	^ self key asString! !

!KMSingleKeyCombination class methodsFor: 'accessing' stamp: 'CamilloBruni 9/15/2013 20:26'!
specialKeys
	^specialKeys
		ifNil: [ specialKeys :=
				{1->'home'.
				3->'enter'.
				4->'end'.
				8->'backspace'.
				9-> 'tab'.
				11->'page up'.
				12->'page down'.
				27->'escape'.
				28->'left arrow'.
				29->'right arrow'.
				30->'up arrow'.
				31->'down arrow'.
				127->'delete'
				} asDictionary.]! !

!KMSingleKeyCombination class methodsFor: 'instance creation' stamp: 'CamilloBruni 9/15/2013 21:14'!
from: aCharacterOrInteger
	| aCharacter |
	aCharacter := aCharacterOrInteger asCharacter.
	
	KMUntypeableSingleKeyCombination 
		ifSpecialKey: aCharacter do: [ :keyCombination | ^ keyCombination ]. 
	
	^ self new
		key: aCharacter;
		yourself! !

!KMStorage commentStamp: '<historical>'!
I am a storage of shortcuts. I store and provide facilities to access named and annonimous shortcuts.!
!KMStorage methodsFor: 'accessing' stamp: 'GuillermoPolito 1/21/2012 20:57'!
keymapNamed: aKmName
	^namedRegistry at: aKmName! !

!KMStorage methodsFor: 'accessing' stamp: 'GuillermoPolito 1/21/2012 20:56'!
hasKeymapNamed: aKmName
	^namedRegistry includesKey: aKmName! !

!KMStorage methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 11/12/2013 16:19'!
initialize
	anonymousRegistry := Set new.
	namedRegistry := Dictionary new.! !

!KMStorage methodsFor: 'accessing' stamp: 'GuillermoPolito 1/21/2012 21:01'!
size
	^self keymaps size! !

!KMStorage methodsFor: 'accessing' stamp: 'GuillermoPolito 1/21/2012 20:52'!
addAll: keymaps
	keymaps do: [ :km | self add: km ].! !

!KMStorage methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/12/2013 16:19'!
add: aKeymap
	aKeymap hasName
		ifTrue: [ namedRegistry at: aKeymap name put: aKeymap ]
		ifFalse: [ anonymousRegistry add: aKeymap ].! !

!KMStorage methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/12/2013 16:19'!
remove: aKeymap
	aKeymap hasName
		ifTrue: [ namedRegistry removeKey: aKeymap name ]
		ifFalse: [ anonymousRegistry remove: aKeymap ].! !

!KMStorage methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/12/2013 16:19'!
keymaps
	^anonymousRegistry , namedRegistry values! !

!KMStorage methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/12/2013 16:19'!
keymapForShortcut: aShortcut

	^ namedRegistry
		detect: [ :keymap | keymap shortcut = aShortcut ]
		ifNone: [ 
			anonymousRegistry
				detect: [ :keymap | keymap shortcut = aShortcut ]
				ifNone: [ nil ] ]! !

!KMStorage methodsFor: 'accessing' stamp: 'GuillermoPolito 1/21/2012 21:02'!
, aKMStorage
	^self class new
		addAll: self keymaps;
		addAll: aKMStorage keymaps.! !

!KMTarget commentStamp: 'GuillermoPolito 2/24/2011 23:44'!
I am the reification of the Keymap target.  I am the one that receives the actions.!
!KMTarget methodsFor: 'accessing' stamp: 'GuillermoPolito 5/31/2011 11:18'!
targetSelector
	^targetSelector ifNil: [ #yourself ]! !

!KMTarget methodsFor: 'accessing' stamp: 'GuillermoPolito 5/29/2011 23:50'!
morph: aMorph
	morph := aMorph! !

!KMTarget methodsFor: 'accessing' stamp: 'GuillermoPolito 5/31/2011 11:10'!
targetSelector: aTargetSelector
	targetSelector := aTargetSelector! !

!KMTarget methodsFor: 'accessing' stamp: 'GuillermoPolito 10/20/2011 19:07'!
morph
	^morph! !

!KMTarget methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/3/2012 12:51'!
announcer

	^ self morph announcer! !

!KMTarget methodsFor: 'accessing' stamp: 'GuillermoPolito 5/4/2013 16:21'!
dispatch: buffer

	morph kmDispatcher dispatch: buffer! !

!KMTarget methodsFor: 'accessing' stamp: 'GuillermoPolito 6/24/2012 12:42'!
ownerTarget
	morph owner ifNil: [ ^nil ].
	^morph owner kmDispatcher target.! !

!KMTarget methodsFor: 'iterating' stamp: 'GuillermoPolito 5/3/2013 17:10'!
nextForKmChain: aKMDispatchChain 
	^self ownerTarget! !

!KMTarget methodsFor: 'accessing' stamp: 'GuillermoPolito 5/31/2011 11:15'!
realTarget
	^morph perform: self targetSelector! !

!KMTarget class methodsFor: 'instance creation' stamp: 'GuillermoPolito 5/31/2011 11:11'!
for: aTarget in: aMorph
	^ (self new)
		targetSelector: aTarget;
		morph: aMorph;
		yourself! !

!KMUntypeableSingleKeyCombination commentStamp: '<historical>'!
I am an abstract class for all single key combinations that correspond to characters that cannot be typed directly.!
!KMUntypeableSingleKeyCombination methodsFor: 'printing' stamp: 'CamilloBruni 9/15/2013 21:03'!
symbol
	"I return the visual symbol for this shortcut.
	For instance for the Arrow Up key I contain a string with an arrow up key symbol: ↑ and now the Character arrowUp."
	^ symbol! !

!KMUntypeableSingleKeyCombination methodsFor: 'accessing' stamp: 'CamilloBruni 9/15/2013 21:04'!
name: aString
	name := aString! !

!KMUntypeableSingleKeyCombination methodsFor: 'accessing' stamp: 'CamilloBruni 9/15/2013 21:02'!
name
	^ name! !

!KMUntypeableSingleKeyCombination methodsFor: 'printing' stamp: 'CamilloBruni 9/15/2013 21:07'!
printOn: aStream
	aStream nextPutAll:self name asUppercase.! !

!KMUntypeableSingleKeyCombination methodsFor: 'accessing' stamp: 'CamilloBruni 9/15/2013 21:04'!
symbol: aString
	
	symbol := aString! !

!KMUntypeableSingleKeyCombination class methodsFor: 'instance creation' stamp: 'CamilloBruni 9/15/2013 21:01'!
backspace
	^ self
		key: Character backspace
		name: 'Backspace'
		symbol: '⌫'! !

!KMUntypeableSingleKeyCombination class methodsFor: 'instance creation' stamp: 'CamilloBruni 9/15/2013 21:01'!
enter
	^ self
		key: Character enter
		name: 'Enter'
		symbol: '↩'! !

!KMUntypeableSingleKeyCombination class methodsFor: 'instance creation' stamp: 'CamilloBruni 9/15/2013 21:01'!
escape
	^ self
		key: Character escape
		name: 'Escape'
		symbol: '⎋'! !

!KMUntypeableSingleKeyCombination class methodsFor: 'instance creation' stamp: 'CamilloBruni 9/15/2013 21:01'!
arrowDown
	^ self
		key: Character arrowDown
		name: 'Down Arrow'
		symbol: '↓'! !

!KMUntypeableSingleKeyCombination class methodsFor: 'instance creation' stamp: 'CamilloBruni 9/15/2013 21:01'!
end
	^ self
		key: Character end
		name: 'End'
		symbol: '↘'! !

!KMUntypeableSingleKeyCombination class methodsFor: 'instance creation' stamp: 'CamilloBruni 9/15/2013 21:01'!
pageUp
	^ self
		key: Character pageUp
		name: 'Page Up'
		symbol: '⇞'! !

!KMUntypeableSingleKeyCombination class methodsFor: 'instance creation' stamp: 'CamilloBruni 9/15/2013 21:04'!
key: aCharacter name: aString symbol: aVisualString
	^ self new
		key: aCharacter;
		name: aString;
		symbol: aVisualString;
		yourself! !

!KMUntypeableSingleKeyCombination class methodsFor: 'instance creation' stamp: 'CamilloBruni 9/15/2013 21:01'!
arrowLeft
	^ self
		key: Character arrowLeft
		name: 'Left Arrow'
		symbol: '←'! !

!KMUntypeableSingleKeyCombination class methodsFor: 'initialization' stamp: 'CamilloBruni 9/16/2013 00:22'!
newSpecialKeys
	"Build a new dictionary that maps untypable characters to symbols for instacation creation methods on this class."
	| dictionary |
	dictionary := Dictionary new.
	 #(home enter end backspace tab pageUp pageDown escape arrowLeft arrowRight arrowUp arrowDown delete)
		do: [  :symbol |
			dictionary at: (Character perform: symbol) put: symbol ].
	^ dictionary! !

!KMUntypeableSingleKeyCombination class methodsFor: 'instance creation' stamp: 'CamilloBruni 9/15/2013 21:01'!
delete
	^ self
		key: Character delete
		name: 'Delete'
		symbol: '⌦'! !

!KMUntypeableSingleKeyCombination class methodsFor: 'instance creation' stamp: 'CamilloBruni 9/15/2013 21:01'!
arrowUp
	^ self
		key: Character arrowUp
		name: 'Up Arrow'
		symbol: '↑'! !

!KMUntypeableSingleKeyCombination class methodsFor: 'instance creation' stamp: 'CamilloBruni 9/15/2013 21:06'!
home
	^ self
		key: Character home
		name: 'Home'
		symbol: '↖'! !

!KMUntypeableSingleKeyCombination class methodsFor: 'accessing' stamp: 'CamilloBruni 9/15/2013 21:10'!
specialKeys
	^specialKeys
		ifNil: [ 
			specialKeys := self newSpecialKeys ]! !

!KMUntypeableSingleKeyCombination class methodsFor: 'instance creation' stamp: 'CamilloBruni 9/15/2013 21:06'!
pageDown
	^ self
		key: Character pageDown
		name: 'Page Down'
		symbol: '⇟'! !

!KMUntypeableSingleKeyCombination class methodsFor: 'instance creation' stamp: 'CamilloBruni 9/15/2013 21:01'!
arrowRight
	^ self
		key: Character arrowRight
		name: 'Right Arrow'
		symbol: '→'! !

!KMUntypeableSingleKeyCombination class methodsFor: 'testing' stamp: 'CamilloBruni 9/15/2013 21:14'!
ifSpecialKey: aCharacter do: aBlock
	"Lookup if aCharacter needs to be handled by me, if so use one of the instance creation function for creating the corresponding KeyCombination."
	 self specialKeys at: aCharacter ifPresent: [ :symbol |
		aBlock value: (self perform: symbol) ]! !

!KMUntypeableSingleKeyCombination class methodsFor: 'instance creation' stamp: 'CamilloBruni 9/15/2013 21:01'!
tab
	^ self
		key: Character tab
		name: 'Tab'
		symbol: '⇥'! !

!KOI8RTextConverter commentStamp: '<historical>'!
A KOI8RTextConverter class is used to convert cyrillic inputs.!
!KOI8RTextConverter class methodsFor: 'as yet unclassified' stamp: ''!
initialize
	self initializeTables! !

!KOI8RTextConverter class methodsFor: 'accessing' stamp: 'michael.rueger 2/2/2009 18:53'!
languageEnvironment
	^RussianEnvironment! !

!KOI8RTextConverter class methodsFor: 'accessing' stamp: 'yo 12/11/2007 10:59'!
encodingNames 

	^ #('koi8-r') copy
! !

!KOI8RTextConverter class methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 3/7/2012 21:40'!
byteToUnicodeSpec
	"ByteTextConverter generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/VENDORS/MISC/KOI8-R.TXT'"

	^ #(
	16r2500 16r2502 16r250C 16r2510 16r2514 16r2518 16r251C 16r2524 
	16r252C 16r2534 16r253C 16r2580 16r2584 16r2588 16r258C 16r2590 
	16r2591 16r2592 16r2593 16r2320 16r25A0 16r2219 16r221A 16r2248 
	16r2264 16r2265 16r00A0 16r2321 16r00B0 16r00B2 16r00B7 16r00F7 
	16r2550 16r2551 16r2552 16r0451 16r2553 16r2554 16r2555 16r2556 
	16r2557 16r2558 16r2559 16r255A 16r255B 16r255C 16r255D 16r255E 
	16r255F 16r2560 16r2561 16r0401 16r2562 16r2563 16r2564 16r2565 
	16r2566 16r2567 16r2568 16r2569 16r256A 16r256B 16r256C 16r00A9 
	16r044E 16r0430 16r0431 16r0446 16r0434 16r0435 16r0444 16r0433 
	16r0445 16r0438 16r0439 16r043A 16r043B 16r043C 16r043D 16r043E 
	16r043F 16r044F 16r0440 16r0441 16r0442 16r0443 16r0436 16r0432 
	16r044C 16r044B 16r0437 16r0448 16r044D 16r0449 16r0447 16r044A 
	16r042E 16r0410 16r0411 16r0426 16r0414 16r0415 16r0424 16r0413 
	16r0425 16r0418 16r0419 16r041A 16r041B 16r041C 16r041D 16r041E 
	16r041F 16r042F 16r0420 16r0421 16r0422 16r0423 16r0416 16r0412 
	16r042C 16r042B 16r0417 16r0428 16r042D 16r0429 16r0427 16r042A )! !

!KSX1001 commentStamp: 'yo 10/19/2004 19:53'!
This class represents the domestic character encoding called KS X 1001 used for Korean.!
!KSX1001 class methodsFor: 'character classification' stamp: 'yo 8/6/2003 05:30'!
isLetter: char

	| value leading |

	leading := char leadingChar.
	value := char charCode.

	leading = 0 ifTrue: [^ super isLetter: char].

	value := value // 94 + 1.
	^ 1 <= value and: [value < 84].
! !

!KSX1001 class methodsFor: 'class methods' stamp: 'StephaneDucasse 8/22/2013 14:31'!
initialize
	"KSX1001 initialize"
	
	EncodedCharSet declareEncodedCharSet: self atIndex: 3+1.
	EncodedCharSet declareEncodedCharSet: self atIndex: 12+1.
	compoundTextSequence := String streamContents: 
		[ :stream | 
		stream nextPut: Character escape.
		stream nextPut: $$.
		stream nextPut: $(.
		stream nextPut: $C ]! !

!KSX1001 class methodsFor: 'class methods' stamp: 'Alexandre.Bergel 11/20/2008 11:17'!
compoundTextSequence
	^ compoundTextSequence! !

!KSX1001 class methodsFor: 'class methods' stamp: 'Alexandre.Bergel 11/20/2008 11:17'!
nextPutValue: ascii toStream: aStream withShiftSequenceIfNeededForTextConverterState: state 
	| c1 c2 |
	state charSize: 2.
	state g0Leading ~= self leadingChar ifTrue: 
		[ state g0Leading: self leadingChar.
		state g0Size: 2.
		aStream basicNextPutAll: compoundTextSequence ].
	c1 := ascii // 94 + 33.
	c2 := ascii \\ 94 + 33.
	^ aStream
		basicNextPut: (Character value: c1);
		basicNextPut: (Character value: c2)! !

!KSX1001 class methodsFor: 'class methods' stamp: 'yo 10/22/2002 19:49'!
leadingChar

	^ 3.
! !

!KSX1001 class methodsFor: 'class methods' stamp: 'yo 10/14/2003 10:19'!
ucsTable

	^ UCSTable ksx1001Table.
! !

!KernelClassesFilter commentStamp: 'TorstenBergmann 1/31/2014 11:30'!
A filter for kernel classes!
!KernelClassesFilter methodsFor: 'private' stamp: 'ClementBera 5/27/2014 13:49'!
kernelClassesToExclude
	^ {Boolean.
	True.
	False.
	BlockClosure.
	Context.
	Array.
	OrderedCollection.
	Set.
	IdentitySet.
	Dictionary.
	IdentityDictionary.
	Class.
	Metaclass.
	Behavior.
	SmallInteger.
	Float.
	Error.
	Exception.
	UndefinedObject.
	MessageSend}! !

!KernelClassesFilter methodsFor: 'initialization' stamp: 'AndreiChis 9/30/2013 14:00'!
initialize
	
	super initialize.
	kernelClasses := self kernelClassesToExclude asOrderedCollection.
	kernelClasses := kernelClasses 
		addAll: (kernelClasses collect: #class);
		yourself
	! !

!KernelClassesFilter methodsFor: 'testing' stamp: 'AndreiChis 9/30/2013 11:12'!
shouldDisplay: aContext
	^ (kernelClasses includes: aContext receiver class) not! !

!Key commentStamp: '<historical>'!
I represent a keyboard Key. I am mapped from the platform specific keycodes into a common keycode base, by using my class side methods.!
!Key methodsFor: 'initialize-release' stamp: 'GuillermoPolito 5/4/2013 20:02'!
withValue: aValue
	self withValue: aValue andName: self class unknownKeyName! !

!Key methodsFor: 'initialize-release' stamp: 'GuillermoPolito 4/10/2013 16:18'!
withValue: aValue andName: aName
	value := aValue.
	name := aName! !

!Key methodsFor: 'testing' stamp: 'GuillermoPolito 5/4/2013 20:03'!
isUnkownKey
	 ^self name == self class unknownKeyName! !

!Key methodsFor: 'printing' stamp: 'GuillermoPolito 5/4/2013 20:04'!
printOn: aStream
	aStream
		nextPutAll: 'Key ';
		nextPutAll: name;
		nextPutAll: ' code: (';
		nextPutAll: value asString;
		nextPutAll: ')'.! !

!Key methodsFor: 'accessing' stamp: 'GuillermoPolito 4/10/2013 16:18'!
name
	^name! !

!Key class methodsFor: 'windows' stamp: 'GuillermoPolito 5/4/2013 12:58'!
initializeWindowsVirtualKeyTable
	WindowsVirtualKeyTable := Dictionary new.
	WindowsVirtualKeyTable
		at: 16r0d put: (self value: 16rff0d); " kVK_Return                    = 0x24"
		at: 16r09 put: (self value: 16rff09); "  kVK_Tab                       = 0x30"
		at: 16r20 put: (self value: 16rff80); "  kVK_Space                     = 0x31"
		at: 16r2e put: (self value: 16rffff); "  kVK_Delete                    = 0x33"
		at: 16r1b put: (self value: 16rff1b); "  kVK_Escape                    = 0x35"
		at: 16r5B put: (self value: 16rff08); "  kVK_Command                   = 0x37"
		at: 16r5c put: (self value: 16rffe7); "  kVK_Command                   = 0x37"
		at: 16r10 put: (self value: 16rffe1); "  kVK_Shift                     = 0x38"
		at: 16r14 put: (self value: 16rffe5); "  kVK_CapsLock                  = 0x39"
		at: 16r12 put: (self value: 16rffe9); "  kVK_Option                    = 0x3A"
		at: 16r11 put: (self value: 16rffe3); "  kVK_Control                   = 0x3B"
		at: 16ra0 put: (self value: 16rffe2); "  kVK_RightShift                = 0x3C"
		at: 16ra5 put: (self value: 16rffea); "  kVK_RightOption               = 0x3D"
		at: 16ra3 put: (self value: 16rffe4); "  kVK_RightControl              = 0x3E"
		at: -1 put: (self value: 16r08f6); "  kVK_Function                  = 0x3F"
		at: 16raf put: (self value: 16r48); "  kVK_VolumeUp                  = 0x48"  "Not mapped"
		at: 16rae put: (self value: 16r49); "  kVK_VolumeDown                = 0x49" "Not mapped"
		at: 16rad put: (self value: 16r4A); "  kVK_Mute                      = 0x4A" "Not mapped"
		at: 16r70 put: (self value: 16rffbe); "  kVK_F1                        = 0x7A"
		at: 16r71 put: (self value: 16rffbf); "  kVK_F2                        = 0x78"
		at: 16r72 put: (self value: 16rffc0); "  kVK_F3                        = 0x63"
		at: 16r73 put: (self value: 16rffc1); "  kVK_F4                        = 0x76"
		at: 16r74 put: (self value: 16rffc2); "  kVK_F5                        = 0x60"
		at: 16r75 put: (self value: 16rffc3); "  kVK_F6                        = 0x61"
		at: 16r76 put: (self value: 16rffc4); "  kVK_F7                        = 0x62"
		at: 16r77 put: (self value: 16rffc5); "  kVK_F8                        = 0x64"
		at: 16r78 put: (self value: 16rffc6); "  kVK_F9                        = 0x65"
		at: 16r79 put: (self value: 16rffc8); "  kVK_F11                       = 0x67"
		at: 16r7a put: (self value: 16rffc7); "  kVK_F10                       = 0x6D"
		at: 16r7b put: (self value: 16rffc9); "  kVK_F12                       = 0x6F"
		at: 16r2f put: (self value: 16r72); "  kVK_Help                      = 0x72" "Not mapped"
		at: 16r24 put: (self value: 16rff50); "  kVK_Home                      = 0x73"
		at: 16r21 put: (self value: 16rff55); "  kVK_PageUp                    = 0x74"
		at: 16r2e put: (self value: 16rffff); "  kVK_ForwardDelete             = 0x75"
		at: 16r23 put: (self value: 16rff57); "  kVK_End                       = 0x77"
		at: 16r22 put: (self value: 16rff56); "  kVK_PageDown                  = 0x79"
		at: 16r1c put: (self value: 16rff96); "  kVK_LeftArrow                 = 0x7B"
		at: 16r1d put: (self value: 16rff98); "  kVK_RightArrow                = 0x7C"
		at: 16r1f put: (self value: 16rff99); "  kVK_DownArrow                 = 0x7D"
		at: 16r1e put: (self value: 16rff97); "  kVK_UpArrow                   = 0x7E"
		at: 16r41 put: (self value: 16r41); "kVK_ANSI_A                    = 0x00"
		at: 16r42 put: (self value: 16r42); "  kVK_ANSI_B                    = 0x0B"
		at: 16r43 put: (self value: 16r43); "  kVK_ANSI_C                    = 0x08"
		at: 16r44 put: (self value: 16r44); "  kVK_ANSI_D                    = 0x02"
		at: 16r45 put: (self value: 16r45); "  kVK_ANSI_E                    = 0x0E"
		at: 16r46 put: (self value: 16r46); "  kVK_ANSI_F                    = 0x03"
		at: 16r47 put: (self value: 16r47); "  kVK_ANSI_G                    = 0x05"
		at: 16r48 put: (self value: 16r48); "  kVK_ANSI_H                    = 0x04"
		at: 16r49 put: (self value: 16r49); "  kVK_ANSI_I                    = 0x22"
		at: 16r4a put: (self value: 16r4a); "  kVK_ANSI_J                    = 0x26"
		at: 16r4b put: (self value: 16r4b); "  kVK_ANSI_K                    = 0x28"
		at: 16r4c put: (self value: 16r4c); "  kVK_ANSI_L                    = 0x25"
		at: 16r4d put: (self value: 16r4d); "  kVK_ANSI_M                    = 0x2E"
		at: 16r4e put: (self value: 16r4e); "  kVK_ANSI_N                    = 0x2D"
		at: 16r4f put: (self value: 16r4f); "  kVK_ANSI_O                    = 0x1F"
		at: 16r50 put: (self value: 16r50); "  kVK_ANSI_P                    = 0x23"
		at: 16r51 put: (self value: 16r51); "  kVK_ANSI_Q                    = 0x0C"
		at: 16r52 put: (self value: 16r52); "  kVK_ANSI_R                    = 0x0F"
		at: 16r53 put: (self value: 16r53); "  kVK_ANSI_S                    = 0x01"
		at: 16r54 put: (self value: 16r54); "  kVK_ANSI_T                    = 0x11"
		at: 16r55 put: (self value: 16r55); "  kVK_ANSI_U                    = 0x20"
		at: 16r56 put: (self value: 16r56); "  kVK_ANSI_V                    = 0x09"
		at: 16r57 put: (self value: 16r57); "  kVK_ANSI_W                    = 0x0D"
		at: 16r58 put: (self value: 16r58); "  kVK_ANSI_X                    = 0x07"
		at: 16r59 put: (self value: 16r59); "  kVK_ANSI_Y                    = 0x10"
		at: 16r5a put: (self value: 16r5a); "  kVK_ANSI_Z                    = 0x06"
		
		at: $0 asciiValue put: (self value: 16r30); "  kVK_ANSI_0                    = 0x1D"
		at: $1 asciiValue put: (self value: 16r31); "  kVK_ANSI_1                    = 0x12"
		at: $2 asciiValue put: (self value: 16r32); "  kVK_ANSI_2                    = 0x13"
		at: $3 asciiValue put: (self value: 16r33); "  kVK_ANSI_3                    = 0x14"
		at: $4 asciiValue put: (self value: 16r34); "  kVK_ANSI_4                    = 0x15"
		at: $5 asciiValue put: (self value: 16r35); "  kVK_ANSI_5                    = 0x17"
		at: $6 asciiValue put: (self value: 16r36); "  kVK_ANSI_6                    = 0x16"
		at: $7 asciiValue put: (self value: 16r37); "  kVK_ANSI_7                    = 0x1A"
		at: $8 asciiValue put: (self value: 16r38); "  kVK_ANSI_8                    = 0x1C"
		at: $9 asciiValue put: (self value: 16r39); "  kVK_ANSI_9                    = 0x19"

		at: 16rbd put: (self value: 16r2d); "  kVK_ANSI_Minus                = 0x1B"
		at: $= asciiValue put: (self value: 16r3d); "  kVK_ANSI_Equal                = 0x18"
		at: 16rdb put: (self value: 16r5b); "  kVK_ANSI_LeftBracket          = 0x21"
		at: 16rdd put: (self value: 16r5d); "  kVK_ANSI_RightBracket         = 0x1E"
		at: 1 put: (self value: 16r27); "  kVK_ANSI_Quote                = 0x27"
		at: 16rba put: (self value: 16r3b); "  kVK_ANSI_Semicolon            = 0x29"
		at: 16rbf put: (self value: 16r5c); "  kVK_ANSI_Backslash            = 0x2A"
		at: 16rbc put: (self value: 16r2c); "  kVK_ANSI_Comma                = 0x2B"
		at: 16rdc put: (self value: 16r2f); "  kVK_ANSI_Slash                = 0x2C"
		at: 16rbe put: (self value: 16r2e); "  kVK_ANSI_Period               = 0x2F"
		at: 16rc0 put: (self value: 16r60); "  kVK_ANSI_Grave                = 0x32"
		at: 16r6e put: (self value: 16rffae); "  kVK_ANSI_KeypadDecimal        = 0x41"
		at: 16r6a put: (self value: 16rffaa); "  kVK_ANSI_KeypadMultiply       = 0x43"
		at: 16r6b put: (self value: 16rffab); "  kVK_ANSI_KeypadPlus           = 0x45"
		at: 16r0c put: (self value: 16r47); "  kVK_ANSI_KeypadClear          = 0x47" "Not mapped"
		at: 16r6f put: (self value: 16rffaf); "  kVK_ANSI_KeypadDivide         = 0x4B"
		at: 16r0d put: (self value: 16rff8d); "  kVK_ANSI_KeypadEnter          = 0x4C"
		at: 16r6d put: (self value: 16rffad); "  kVK_ANSI_KeypadMinus          = 0x4E"
		at: 1 put: (self value: 16rffbd); "  kVK_ANSI_KeypadEquals         = 0x51"
		at: 16r60 put: (self value: 16rffb0); "  kVK_ANSI_Keypad0              = 0x52"
		at: 16r61 put: (self value: 16rffb1); "  kVK_ANSI_Keypad1              = 0x53"
		at: 16r62 put: (self value: 16rffb2); "  kVK_ANSI_Keypad2              = 0x54"
		at: 16r63 put: (self value: 16rffb3); "  kVK_ANSI_Keypad3              = 0x55"
		at: 16r64 put: (self value: 16rffb4); "  kVK_ANSI_Keypad4              = 0x56"
		at: 16r65 put: (self value: 16rffb5); "  kVK_ANSI_Keypad5              = 0x57"
		at: 16r66 put: (self value: 16rffb6); "  kVK_ANSI_Keypad6              = 0x58"
		at: 16r67 put: (self value: 16rffb7); "  kVK_ANSI_Keypad7              = 0x59"
		at: 16r68 put: (self value: 16rffb8); "  kVK_ANSI_Keypad8              = 0x5B"
		at: 16r69 put: (self value: 16rffb9) "  kVK_ANSI_Keypad9              = 0x5C"! !

!Key class methodsFor: 'macos' stamp: 'GuillermoPolito 4/10/2013 15:41'!
macOSVirtualKeyTable
	MacosVirtualKeyTable ifNil: [ self initializeMacOSVirtualKeyTable. ].
	^MacosVirtualKeyTable! !

!Key class methodsFor: 'unix' stamp: 'GuillermoPolito 4/12/2013 17:45'!
unixVirtualKeyTable
	^KeyTable! !

!Key class methodsFor: 'class initialization' stamp: 'GuillermoPolito 5/4/2013 12:53'!
initialize
	self
		initializeKeyTable;
		initializeMacOSVirtualKeyTable;
		initializeUnixVirtualKeyTable;
		initializeWindowsVirtualKeyTable! !

!Key class methodsFor: 'unknownKeys' stamp: 'GuillermoPolito 5/4/2013 20:02'!
unknownKeyName
	^#Unknown! !

!Key class methodsFor: 'instance creation' stamp: 'GuillermoPolito 4/10/2013 16:19'!
value: aKeyValue
	^KeyTable at: aKeyValue! !

!Key class methodsFor: 'unix' stamp: 'GuillermoPolito 5/5/2013 12:06'!
valueForUnixPlatform: aKeyValue

	^self unixVirtualKeyTable at: aKeyValue ifAbsent: [ (self basicNew withValue: aKeyValue) ] ! !

!Key class methodsFor: 'windows' stamp: 'GuillermoPolito 5/4/2013 11:33'!
valueForWindowsPlatform: aKeyCode

	^self windowsVirtualKeyTable at: aKeyCode ifAbsent: [ (self basicNew withValue: aKeyCode andName: #Unknown) ] ! !

!Key class methodsFor: 'unix' stamp: 'GuillermoPolito 4/12/2013 16:29'!
initializeUnixVirtualKeyTable
	UnixVirtualKeyTable := Dictionary new.
	UnixVirtualKeyTable
		at: Character cr asciiValue put: (self value: 16rff0d); " kVK_Return                    = 0x24"
		at: Character tab asciiValue put: (self value: 16rff09); "  kVK_Tab                       = 0x30"
		at: Character space asciiValue put: (self value: 16rff80); "  kVK_Space                     = 0x31"
		at: Character delete asciiValue put: (self value: 16rffff); "  kVK_Delete                    = 0x33"
		at: Character escape asciiValue put: (self value: 16rff1b); "  kVK_Escape                    = 0x35"
		at: 8 put: (self value: 16rff08); "  kVK_Command                   = 0x37"
		at: -1 put: (self value: 16rffe7); "  kVK_Command                   = 0x37"
		at: 255 put: (self value: 16rffe1); "  kVK_Shift                     = 0x38"
		at: -1 put: (self value: 16rffe5); "  kVK_CapsLock                  = 0x39"
		at: 247 put: (self value: 16rffe9); "  kVK_Option                    = 0x3A"
		at: 251 put: (self value: 16rffe3); "  kVK_Control                   = 0x3B"
		at: 254 put: (self value: 16rffe2); "  kVK_RightShift                = 0x3C"
		at: -1 put: (self value: 16rffea); "  kVK_RightOption               = 0x3D"
		at: -1 put: (self value: 16rffe4); "  kVK_RightControl              = 0x3E"
		at: -1 put: (self value: 16r08f6); "  kVK_Function                  = 0x3F"
		at: -1 put: (self value: 16r48); "  kVK_VolumeUp                  = 0x48"  "Not mapped"
		at: -1 put: (self value: 16r49); "  kVK_VolumeDown                = 0x49" "Not mapped"
		at: -1 put: (self value: 16r4A); "  kVK_Mute                      = 0x4A" "Not mapped"
		at: -1 put: (self value: 16rffbe); "  kVK_F1                        = 0x7A"
		at: -1 put: (self value: 16rffbf); "  kVK_F2                        = 0x78"
		at: -1 put: (self value: 16rffc0); "  kVK_F3                        = 0x63"
		at: -1 put: (self value: 16rffc1); "  kVK_F4                        = 0x76"
		at: -1 put: (self value: 16rffc2); "  kVK_F5                        = 0x60"
		at: -1 put: (self value: 16rffc3); "  kVK_F6                        = 0x61"
		at: -1 put: (self value: 16rffc4); "  kVK_F7                        = 0x62"
		at: -1 put: (self value: 16rffc5); "  kVK_F8                        = 0x64"
		at: -1 put: (self value: 16rffc6); "  kVK_F9                        = 0x65"
		at: -1 put: (self value: 16rffc8); "  kVK_F11                       = 0x67"
		at: -1 put: (self value: 16rffc7); "  kVK_F10                       = 0x6D"
		at: -1 put: (self value: 16rffc9); "  kVK_F12                       = 0x6F"
		at: -1 put: (self value: 16r72); "  kVK_Help                      = 0x72" "Not mapped"
		at: Character home asciiValue put: (self value: 16rff50); "  kVK_Home                      = 0x73"
		at: Character pageUp asciiValue put: (self value: 16rff55); "  kVK_PageUp                    = 0x74"
		at: Character delete asciiValue put: (self value: 16rffff); "  kVK_ForwardDelete             = 0x75"
		at: Character end asciiValue put: (self value: 16rff57); "  kVK_End                       = 0x77"
		at: Character pageDown asciiValue put: (self value: 16rff56); "  kVK_PageDown                  = 0x79"
		at: Character arrowLeft asciiValue put: (self value: 16rff96); "  kVK_LeftArrow                 = 0x7B"
		at: Character arrowRight asciiValue put: (self value: 16rff98); "  kVK_RightArrow                = 0x7C"
		at: Character arrowDown asciiValue put: (self value: 16rff99); "  kVK_DownArrow                 = 0x7D"
		at: Character arrowUp asciiValue put: (self value: 16rff97); "  kVK_UpArrow                   = 0x7E"
		at: $a asciiValue put: (self value: 16r41); "kVK_ANSI_A                    = 0x00"
		at: $b asciiValue put: (self value: 16r42); "  kVK_ANSI_B                    = 0x0B"
		at: $c asciiValue put: (self value: 16r43); "  kVK_ANSI_C                    = 0x08"
		at: $d asciiValue put: (self value: 16r44); "  kVK_ANSI_D                    = 0x02"
		at: $e asciiValue put: (self value: 16r45); "  kVK_ANSI_E                    = 0x0E"
		at: $f asciiValue put: (self value: 16r46); "  kVK_ANSI_F                    = 0x03"
		at: $g asciiValue put: (self value: 16r47); "  kVK_ANSI_G                    = 0x05"
		at: $h asciiValue put: (self value: 16r48); "  kVK_ANSI_H                    = 0x04"
		at: $i asciiValue put: (self value: 16r49); "  kVK_ANSI_I                    = 0x22"
		at: $j asciiValue put: (self value: 16r4a); "  kVK_ANSI_J                    = 0x26"
		at: $k asciiValue put: (self value: 16r4b); "  kVK_ANSI_K                    = 0x28"
		at: $l asciiValue put: (self value: 16r4c); "  kVK_ANSI_L                    = 0x25"
		at: $m asciiValue put: (self value: 16r4d); "  kVK_ANSI_M                    = 0x2E"
		at: $n asciiValue put: (self value: 16r4e); "  kVK_ANSI_N                    = 0x2D"
		at: $o asciiValue put: (self value: 16r4f); "  kVK_ANSI_O                    = 0x1F"
		at: $p asciiValue put: (self value: 16r50); "  kVK_ANSI_P                    = 0x23"
		at: $q asciiValue put: (self value: 16r51); "  kVK_ANSI_Q                    = 0x0C"
		at: $r asciiValue put: (self value: 16r52); "  kVK_ANSI_R                    = 0x0F"
		at: $s asciiValue put: (self value: 16r53); "  kVK_ANSI_S                    = 0x01"
		at: $t asciiValue put: (self value: 16r54); "  kVK_ANSI_T                    = 0x11"
		at: $u asciiValue put: (self value: 16r55); "  kVK_ANSI_U                    = 0x20"
		at: $v asciiValue put: (self value: 16r56); "  kVK_ANSI_V                    = 0x09"
		at: $w asciiValue put: (self value: 16r57); "  kVK_ANSI_W                    = 0x0D"
		at: $x asciiValue put: (self value: 16r58); "  kVK_ANSI_X                    = 0x07"
		at: $y asciiValue put: (self value: 16r59); "  kVK_ANSI_Y                    = 0x10"
		at: $z asciiValue put: (self value: 16r5a); "  kVK_ANSI_Z                    = 0x06"
		
		at: $0 asciiValue put: (self value: 16r30); "  kVK_ANSI_0                    = 0x1D"
		at: $1 asciiValue put: (self value: 16r31); "  kVK_ANSI_1                    = 0x12"
		at: $2 asciiValue put: (self value: 16r32); "  kVK_ANSI_2                    = 0x13"
		at: $3 asciiValue put: (self value: 16r33); "  kVK_ANSI_3                    = 0x14"
		at: $4 asciiValue put: (self value: 16r34); "  kVK_ANSI_4                    = 0x15"
		at: $5 asciiValue put: (self value: 16r35); "  kVK_ANSI_5                    = 0x17"
		at: $6 asciiValue put: (self value: 16r36); "  kVK_ANSI_6                    = 0x16"
		at: $7 asciiValue put: (self value: 16r37); "  kVK_ANSI_7                    = 0x1A"
		at: $8 asciiValue put: (self value: 16r38); "  kVK_ANSI_8                    = 0x1C"
		at: $9 asciiValue put: (self value: 16r39); "  kVK_ANSI_9                    = 0x19"

		at: $- asciiValue put: (self value: 16r2d); "  kVK_ANSI_Minus                = 0x1B"
		at: $= asciiValue put: (self value: 16r3d); "  kVK_ANSI_Equal                = 0x18"
		at: $[ asciiValue put: (self value: 16r5b); "  kVK_ANSI_LeftBracket          = 0x21"
		at: $] asciiValue put: (self value: 16r5d); "  kVK_ANSI_RightBracket         = 0x1E"
		at: $' asciiValue put: (self value: 16r27); "  kVK_ANSI_Quote                = 0x27"
		at: $; asciiValue put: (self value: 16r3b); "  kVK_ANSI_Semicolon            = 0x29"
		at: $/ asciiValue put: (self value: 16r5c); "  kVK_ANSI_Backslash            = 0x2A"
		at: $, asciiValue put: (self value: 16r2c); "  kVK_ANSI_Comma                = 0x2B"
		at: $\ asciiValue put: (self value: 16r2f); "  kVK_ANSI_Slash                = 0x2C"
		at: $. asciiValue put: (self value: 16r2e); "  kVK_ANSI_Period               = 0x2F"
		at: $` asciiValue put: (self value: 16r60); "  kVK_ANSI_Grave                = 0x32"
		at: 1 put: (self value: 16rffae); "  kVK_ANSI_KeypadDecimal        = 0x41"
		at: 1 put: (self value: 16rffaa); "  kVK_ANSI_KeypadMultiply       = 0x43"
		at: 1 put: (self value: 16rffab); "  kVK_ANSI_KeypadPlus           = 0x45"
		at: 1 put: (self value: 16r47); "  kVK_ANSI_KeypadClear          = 0x47" "Not mapped"
		at: 1 put: (self value: 16rffaf); "  kVK_ANSI_KeypadDivide         = 0x4B"
		at: 1 put: (self value: 16rff8d); "  kVK_ANSI_KeypadEnter          = 0x4C"
		at: 1 put: (self value: 16rffad); "  kVK_ANSI_KeypadMinus          = 0x4E"
		at: 1 put: (self value: 16rffbd); "  kVK_ANSI_KeypadEquals         = 0x51"
		at: 1 put: (self value: 16rffb0); "  kVK_ANSI_Keypad0              = 0x52"
		at: 1 put: (self value: 16rffb1); "  kVK_ANSI_Keypad1              = 0x53"
		at: 1 put: (self value: 16rffb2); "  kVK_ANSI_Keypad2              = 0x54"
		at: 1 put: (self value: 16rffb3); "  kVK_ANSI_Keypad3              = 0x55"
		at: 1 put: (self value: 16rffb4); "  kVK_ANSI_Keypad4              = 0x56"
		at: 1 put: (self value: 16rffb5); "  kVK_ANSI_Keypad5              = 0x57"
		at: 1 put: (self value: 16rffb6); "  kVK_ANSI_Keypad6              = 0x58"
		at: 1 put: (self value: 16rffb7); "  kVK_ANSI_Keypad7              = 0x59"
		at: 1 put: (self value: 16rffb8); "  kVK_ANSI_Keypad8              = 0x5B"
		at: 1 put: (self value: 16rffb9) "  kVK_ANSI_Keypad9              = 0x5C"! !

!Key class methodsFor: 'key table' stamp: 'GuillermoPolito 4/12/2013 19:57'!
initializeKeyTable
	KeyTable := Dictionary new.
	#(
		16r08f6 Function "XK_function"
		16rff08 BackSpace "XK_BackSpace"
		16rff09 Tab "XK_Tab"
		16rff0a Linefeed "XK_Linefeed"
		16rff0b Clear "XK_Clear"
		16rff0d Return "XK_Return"
		16rff13 Pause "XK_Pause"
		16rff14 Scroll_Lock "XK_Scroll_Lock"
		16rff15 Sys_Req "XK_Sys_Req"
		16rff1b Escape "XK_Escape"
		16rffff Delete "XK_Delete"
		16rff50 Home "XK_Home"
		16rff51 Left "XK_Left"
		16rff52 Up "XK_Up"
		16rff53 Right "XK_Right"
		16rff54 Down "XK_Down"
		16rfe03 Level3Shift "XK_ISO_Level3_Shift"
		16r00a1 ExclamationDown "XK_exclamdown"
		16r00bf QuestionDown "XK_questiondown"
		16r00f1 NTilde "XK_ntilde"
		16r00d1 CapitalNTilde "XK_ntilde"
		16r00ba Masculine "XK_masculine"
		16r00e7 CCedilla "XK_ccedilla"
		16r00c7 CapitalCCedilla "XK_ccedilla"
		16r00aa FeminineOrdinal "XK_ordfeminine"
		16r00b7 MiddlePoint "XK_periodcentered"
		"16rff55 Prior ""XK_Prior"
		16rff55 Page_Up "XK_Page_Up"
		"16rff56 Next" "XK_Next"
		16rff56 Page_Down "XK_Page_Down"
		16rff57 End "XK_End"
		16rff58 Begin "XK_Begin"
		16rff80 KP_Space "XK_KP_Space"
		16rff89 KP_Tab "XK_KP_Tab"
		16rff8d KP_Enter "XK_KP_Enter"
		16rff91 KP_F1 "XK_KP_F1"
		16rff92 KP_F2 "XK_KP_F2"
		16rff93 KP_F3 "XK_KP_F3"
		16rff94 KP_F4 "XK_KP_F4"
		16rff95 KP_Home "XK_KP_Home"
		16rff96 KP_Left "XK_KP_Left"
		16rff97 KP_Up "XK_KP_Up"
		16rff98 KP_Right "XK_KP_Right"
		16rff99 KP_Down "XK_KP_Down"
		16rff9a KP_Prior "XK_KP_Prior"
		16rff9a KP_Page_Up "XK_KP_Page_Up"
		16rff9b KP_Next "XK_KP_Next"
		16rff9b KP_Page_Down "XK_KP_Page_Down"
		16rff9c KP_End "XK_KP_End"
		16rff9d KP_Begin "XK_KP_Begin"
		16rff9e KP_Insert "XK_KP_Insert"
		16rff9f KP_Delete "XK_KP_Delete"
		16rffbd KP_Equal "XK_KP_Equal"
		16rffaa KP_Multiply "XK_KP_Multiply"
		16rffab KP_Add "XK_KP_Add"
		16rffac KP_Separator "XK_KP_Separator"
		16rffad KP_Subtract "XK_KP_Subtract"
		16rffae KP_Decimal "XK_KP_Decimal"
		16rffaf KP_Divide "XK_KP_Divide"
		16rffb0 KP_0 "XK_KP_0"
		16rffb1 KP_1 "XK_KP_1"
		16rffb2 KP_2 "XK_KP_2"
		16rffb3 KP_3 "XK_KP_3"
		16rffb4 KP_4 "XK_KP_4"
		16rffb5 KP_5 "XK_KP_5"
		16rffb6 KP_6 "XK_KP_6"
		16rffb7 KP_7 "XK_KP_7"
		16rffb8 KP_8 "XK_KP_8"
		16rffb9 KP_9 "XK_KP_9"
		16rffbe F1 "XK_F1"
		16rffbf F2 "XK_F2"
		16rffc0 F3 "XK_F3"
		16rffc1 F4 "XK_F4"
		16rffc2 F5 "XK_F5"
		16rffc3 F6 "XK_F6"
		16rffc4 F7 "XK_F7"
		16rffc5 F8 "XK_F8"
		16rffc6 F9 "XK_F9"
		16rffc7 F10 "XK_F10"
		16rffc8 F11 "XK_F11"
		16rffc9 F12 "XK_F12"
		16rffe1 Shift_L "XK_Shift_L"
		16rffe2 Shift_R "XK_Shift_R"
		16rffe3 Control_L "XK_Control_L"
		16rffe4 Control_R "XK_Control_R"
		16rffe5 Caps_Lock "XK_Caps_Lock"
		16rffe6 Shift_Lock "XK_Shift_Lock"
		16rffe7 Meta_L "XK_Meta_L"
		16rffe8 Meta_R "XK_Meta_R"
		16rffe9 Alt_L "XK_Alt_L"
		16rffea Alt_R "XK_Alt_R"
		16rffeb Super_L "XK_Super_L"
		16rffec Super_R "XK_Super_R"
		16rffed Hyper_L "XK_Hyper_L"
		16rffee Hyper_R "XK_Hyper_R"
		16rfe50 dead_grave "XK_dead_grave"
		16rfe51 dead_acute "XK_dead_acute"
		16rfe52 dead_circumflex "XK_dead_circumflex"
		16rfe53 dead_tilde "XK_dead_tilde"
		16rfe53 dead_perispomeni "XK_dead_perispomeni"
		16rfe54 dead_macron "XK_dead_macron"
		16rfe55 dead_breve "XK_dead_breve"
		16rfe56 dead_abovedot "XK_dead_abovedot"
		16rfe57 dead_diaeresis "XK_dead_diaeresis"
		16rfe58 dead_abovering "XK_dead_abovering"
		16rfe59 dead_doubleacute "XK_dead_doubleacute"
		16rfe5a dead_caron "XK_dead_caron"
		16rfe5b dead_cedilla "XK_dead_cedilla"
		16rfe5c dead_ogonek "XK_dead_ogonek"
		16rfe5d dead_iota "XK_dead_iota"
		16rfe5e dead_voiced_sound "XK_dead_voiced_sound"
		16rfe5f dead_semivoiced_sound "XK_dead_semivoiced_sound"
		16rfe60 dead_belowdot "XK_dead_belowdot"
		16rfe61 dead_hook "XK_dead_hook"
		16rfe62 dead_horn "XK_dead_horn"
		16rfe63 dead_stroke "XK_dead_stroke"
		16rfe64 dead_abovecomma "XK_dead_abovecomma"
		16rfe64 dead_psili "XK_dead_psili"
		16rfe65 dead_abovereversedcomma "XK_dead_abovereversedcomma"
		16rfe65 dead_dasia "XK_dead_dasia"
		16rfe66 dead_doublegrave "XK_dead_doublegrave"
		16rfe67 dead_belowring "XK_dead_belowring"
		16rfe68 dead_belowmacron "XK_dead_belowmacron"
		16rfe69 dead_belowcircumflex "XK_dead_belowcircumflex"
		16rfe6a dead_belowtilde "XK_dead_belowtilde"
		16rfe6b dead_belowbreve "XK_dead_belowbreve"
		16rfe6c dead_belowdiaeresis "XK_dead_belowdiaeresis"
		16rfe6d dead_invertedbreve "XK_dead_invertedbreve"
		16rfe6e dead_belowcomma "XK_dead_belowcomma"
		16rfe6f dead_currency "XK_dead_currency"
		16r0020 space "XK_space"
		16r0021 exclam "XK_exclam"
		16r0022 quotedbl "XK_quotedbl"
		16r0023 numbersign "XK_numbersign"
		16r0024 dollar "XK_dollar"
		16r0025 percent "XK_percent"
		16r0026 ampersand "XK_ampersand"
		16r0027 apostrophe "XK_apostrophe"
		"16r0027 quoteright" "XK_quoteright"
		16r0028 parenleft "XK_parenleft"
		16r0029 parenright "XK_parenright"
		16r002a asterisk "XK_asterisk"
		16r002b plus "XK_plus"
		16r002c comma "XK_comma"
		16r002d minus "XK_minus"
		16r002e period "XK_period"
		16r002f slash "XK_slash"
		16r0030 zero "XK_0"
		16r0031 one "XK_1"
		16r0032 two "XK_2"
		16r0033 three "XK_3"
		16r0034 four "XK_4"
		16r0035 five "XK_5"
		16r0036 six "XK_6"
		16r0037 seven "XK_7"
		16r0038 eight "XK_8"
		16r0039 nine "XK_9"
		16r003a colon "XK_colon"
		16r003b semicolon "XK_semicolon"
		16r003c less "XK_less"
		16r003d equal "XK_equal"
		16r003e greater "XK_greater"
		16r003f question "XK_question"
		16r0040 at "XK_at"
		16r0041 A "XK_A"
		16r0042 B "XK_B"
		16r0043 C "XK_C"
		16r0044 D "XK_D"
		16r0045 E "XK_E"
		16r0046 F "XK_F"
		16r0047 G "XK_G"
		16r0048 H "XK_H"
		16r0049 I "XK_I"
		16r004a J "XK_J"
		16r004b K "XK_K"
		16r004c L "XK_L"
		16r004d M "XK_M"
		16r004e N "XK_N"
		16r004f O "XK_O"
		16r0050 P "XK_P"
		16r0051 Q "XK_Q"
		16r0052 R "XK_R"
		16r0053 S "XK_S"
		16r0054 T "XK_T"
		16r0055 U "XK_U"
		16r0056 V "XK_V"
		16r0057 W "XK_W"
		16r0058 X "XK_X"
		16r0059 Y "XK_Y"
		16r005a Z "XK_Z"
		16r005b bracketleft "XK_bracketleft"
		16r005c backslash "XK_backslash"
		16r005d bracketright "XK_bracketright"
		16r005e asciicircum "XK_asciicircum"
		16r005f underscore "XK_underscore"
		16r0060 grave "XK_grave"
		"16r0060 quoteleft" "XK_quoteleft"
		16r0061 a "XK_a"
		16r0062 b "XK_b"
		16r0063 c "XK_c"
		16r0064 d "XK_d"
		16r0065 e "XK_e"
		16r0066 f "XK_f"
		16r0067 g "XK_g"
		16r0068 h "XK_h"
		16r0069 i "XK_i"
		16r006a j "XK_j"
		16r006b k "XK_k"
		16r006c l "XK_l"
		16r006d m "XK_m"
		16r006e n "XK_n"
		16r006f o "XK_o"
		16r0070 p "XK_p"
		16r0071 q "XK_q"
		16r0072 r "XK_r"
		16r0073 s "XK_s"
		16r0074 t "XK_t"
		16r0075 u "XK_u"
		16r0076 v "XK_v"
		16r0077 w "XK_w"
		16r0078 x "XK_x"
		16r0079 y "XK_y"
		16r007a z "XK_z"
		16r007b braceleft "XK_braceleft"
		16r007c bar "XK_bar"
		16r007d braceright "XK_braceright"
		16r007e asciitilde "XK_asciitilde")
			pairsDo: [ :keyCode :keyname | KeyTable at: keyCode put: (self basicNew withValue: keyCode andName: keyname asUppercase) ].! !

!Key class methodsFor: 'macos' stamp: 'GuillermoPolito 5/5/2013 12:06'!
valueForMacOSXPlatform: aKeyValue

	^self macOSVirtualKeyTable at: aKeyValue ifAbsent: [ (self basicNew withValue: aKeyValue andName: #Unknown) ] ! !

!Key class methodsFor: 'windows' stamp: 'GuillermoPolito 5/4/2013 11:33'!
windowsVirtualKeyTable

	WindowsVirtualKeyTable ifNil: [ self initializeWindowsVirtualKeyTable. ].
	^WindowsVirtualKeyTable! !

!Key class methodsFor: 'macos' stamp: 'GuillermoPolito 4/10/2013 17:17'!
initializeMacOSVirtualKeyTable
	MacosVirtualKeyTable := Dictionary new.
	MacosVirtualKeyTable
		at: 16r24 put: (self value: 16rff0d); " kVK_Return                    = 0x24"
		at: 16r30 put: (self value: 16rff09); "  kVK_Tab                       = 0x30"
		at: 16r31 put: (self value: 16rff80); "  kVK_Space                     = 0x31"
		at: 16r33 put: (self value: 16rffff); "  kVK_Delete                    = 0x33"
		at: 16r35 put: (self value: 16rff1b); "  kVK_Escape                    = 0x35"
		at: 16r37 put: (self value: 16rffe7); "  kVK_Command                   = 0x37"
		at: 16r38 put: (self value: 16rffe1); "  kVK_Shift                     = 0x38"
		at: 16r39 put: (self value: 16rffe5); "  kVK_CapsLock                  = 0x39"
		at: 16r3A put: (self value: 16rffe9); "  kVK_Option                    = 0x3A"
		at: 16r3B put: (self value: 16rffe3); "  kVK_Control                   = 0x3B"
		at: 16r3C put: (self value: 16rffe2); "  kVK_RightShift                = 0x3C"
		at: 16r3D put: (self value: 16rffea); "  kVK_RightOption               = 0x3D"
		at: 16r3E put: (self value: 16rffe4); "  kVK_RightControl              = 0x3E"
		at: 16r3F put: (self value: 16r08f6); "  kVK_Function                  = 0x3F"
		at: 16r48 put: (self value: 16r48); "  kVK_VolumeUp                  = 0x48"  "Not mapped"
		at: 16r49 put: (self value: 16r49); "  kVK_VolumeDown                = 0x49" "Not mapped"
		at: 16r4A put: (self value: 16r4A); "  kVK_Mute                      = 0x4A" "Not mapped"
		at: 16r7A put: (self value: 16rffbe); "  kVK_F1                        = 0x7A"
		at: 16r78 put: (self value: 16rffbf); "  kVK_F2                        = 0x78"
		at: 16r63 put: (self value: 16rffc0); "  kVK_F3                        = 0x63"
		at: 16r76 put: (self value: 16rffc1); "  kVK_F4                        = 0x76"
		at: 16r60 put: (self value: 16rffc2); "  kVK_F5                        = 0x60"
		at: 16r61 put: (self value: 16rffc3); "  kVK_F6                        = 0x61"
		at: 16r62 put: (self value: 16rffc4); "  kVK_F7                        = 0x62"
		at: 16r64 put: (self value: 16rffc5); "  kVK_F8                        = 0x64"
		at: 16r65 put: (self value: 16rffc6); "  kVK_F9                        = 0x65"
		at: 16r67 put: (self value: 16rffc8); "  kVK_F11                       = 0x67"
		at: 16r6D put: (self value: 16rffc7); "  kVK_F10                       = 0x6D"
		at: 16r6F put: (self value: 16rffc9); "  kVK_F12                       = 0x6F"
		at: 16r72 put: (self value: 16r72); "  kVK_Help                      = 0x72" "Not mapped"
		at: 16r73 put: (self value: 16rff50); "  kVK_Home                      = 0x73"
		at: 16r74 put: (self value: 16rff55); "  kVK_PageUp                    = 0x74"
		at: 16r75 put: (self value: 16rffff); "  kVK_ForwardDelete             = 0x75"
		at: 16r77 put: (self value: 16rff57); "  kVK_End                       = 0x77"
		at: 16r79 put: (self value: 16rff56); "  kVK_PageDown                  = 0x79"
		at: 16r7B put: (self value: 16rff96); "  kVK_LeftArrow                 = 0x7B"
		at: 16r7C put: (self value: 16rff98); "  kVK_RightArrow                = 0x7C"
		at: 16r7D put: (self value: 16rff99); "  kVK_DownArrow                 = 0x7D"
		at: 16r7E put: (self value: 16rff97); "  kVK_UpArrow                   = 0x7E"
		at: 16r00 put: (self value: 16r41); "kVK_ANSI_A                    = 0x00"
		at: 16r0B put: (self value: 16r42); "  kVK_ANSI_B                    = 0x0B"
		at: 16r08 put: (self value: 16r43); "  kVK_ANSI_C                    = 0x08"
		at: 16r02 put: (self value: 16r44); "  kVK_ANSI_D                    = 0x02"
		at: 16r0E put: (self value: 16r45); "  kVK_ANSI_E                    = 0x0E"
		at: 16r03 put: (self value: 16r46); "  kVK_ANSI_F                    = 0x03"
		at: 16r05 put: (self value: 16r47); "  kVK_ANSI_G                    = 0x05"
		at: 16r04 put: (self value: 16r48); "  kVK_ANSI_H                    = 0x04"
		at: 16r22 put: (self value: 16r49); "  kVK_ANSI_I                    = 0x22"
		at: 16r26 put: (self value: 16r4a); "  kVK_ANSI_J                    = 0x26"
		at: 16r28 put: (self value: 16r4b); "  kVK_ANSI_K                    = 0x28"
		at: 16r25 put: (self value: 16r4c); "  kVK_ANSI_L                    = 0x25"
		at: 16r2E put: (self value: 16r4d); "  kVK_ANSI_M                    = 0x2E"
		at: 16r2D put: (self value: 16r4e); "  kVK_ANSI_N                    = 0x2D"
		at: 16r1F put: (self value: 16r4f); "  kVK_ANSI_O                    = 0x1F"
		at: 16r23 put: (self value: 16r50); "  kVK_ANSI_P                    = 0x23"
		at: 16r0C put: (self value: 16r51); "  kVK_ANSI_Q                    = 0x0C"
		at: 16r0F put: (self value: 16r52); "  kVK_ANSI_R                    = 0x0F"
		at: 16r01 put: (self value: 16r53); "  kVK_ANSI_S                    = 0x01"
		at: 16r11 put: (self value: 16r54); "  kVK_ANSI_T                    = 0x11"
		at: 16r20 put: (self value: 16r55); "  kVK_ANSI_U                    = 0x20"
		at: 16r09 put: (self value: 16r56); "  kVK_ANSI_V                    = 0x09"
		at: 16r0D put: (self value: 16r57); "  kVK_ANSI_W                    = 0x0D"
		at: 16r07 put: (self value: 16r58); "  kVK_ANSI_X                    = 0x07"
		at: 16r10 put: (self value: 16r59); "  kVK_ANSI_Y                    = 0x10"
		at: 16r06 put: (self value: 16r5a); "  kVK_ANSI_Z                    = 0x06"
		
		at: 16r1D put: (self value: 16r30); "  kVK_ANSI_0                    = 0x1D"
		at: 16r12 put: (self value: 16r31); "  kVK_ANSI_1                    = 0x12"
		at: 16r13 put: (self value: 16r32); "  kVK_ANSI_2                    = 0x13"
		at: 16r14 put: (self value: 16r33); "  kVK_ANSI_3                    = 0x14"
		at: 16r15 put: (self value: 16r34); "  kVK_ANSI_4                    = 0x15"
		at: 16r17 put: (self value: 16r35); "  kVK_ANSI_5                    = 0x17"
		at: 16r16 put: (self value: 16r36); "  kVK_ANSI_6                    = 0x16"
		at: 16r1A put: (self value: 16r37); "  kVK_ANSI_7                    = 0x1A"
		at: 16r1C put: (self value: 16r38); "  kVK_ANSI_8                    = 0x1C"
		at: 16r19 put: (self value: 16r39); "  kVK_ANSI_9                    = 0x19"

		at: 16r1B put: (self value: 16r2d); "  kVK_ANSI_Minus                = 0x1B"
		at: 16r18 put: (self value: 16r3d); "  kVK_ANSI_Equal                = 0x18"
		at: 16r21 put: (self value: 16r5b); "  kVK_ANSI_LeftBracket          = 0x21"
		at: 16r1E put: (self value: 16r5d); "  kVK_ANSI_RightBracket         = 0x1E"
		at: 16r27 put: (self value: 16r27); "  kVK_ANSI_Quote                = 0x27"
		at: 16r29 put: (self value: 16r3b); "  kVK_ANSI_Semicolon            = 0x29"
		at: 16r2A put: (self value: 16r5c); "  kVK_ANSI_Backslash            = 0x2A"
		at: 16r2B put: (self value: 16r2c); "  kVK_ANSI_Comma                = 0x2B"
		at: 16r2C put: (self value: 16r2f); "  kVK_ANSI_Slash                = 0x2C"
		at: 16r2F put: (self value: 16r2e); "  kVK_ANSI_Period               = 0x2F"
		at: 16r32 put: (self value: 16r60); "  kVK_ANSI_Grave                = 0x32"
		at: 16r41 put: (self value: 16rffae); "  kVK_ANSI_KeypadDecimal        = 0x41"
		at: 16r43 put: (self value: 16rffaa); "  kVK_ANSI_KeypadMultiply       = 0x43"
		at: 16r45 put: (self value: 16rffab); "  kVK_ANSI_KeypadPlus           = 0x45"
		at: 16r47 put: (self value: 16r47); "  kVK_ANSI_KeypadClear          = 0x47" "Not mapped"
		at: 16r4B put: (self value: 16rffaf); "  kVK_ANSI_KeypadDivide         = 0x4B"
		at: 16r4C put: (self value: 16rff8d); "  kVK_ANSI_KeypadEnter          = 0x4C"
		at: 16r4E put: (self value: 16rffad); "  kVK_ANSI_KeypadMinus          = 0x4E"
		at: 16r51 put: (self value: 16rffbd); "  kVK_ANSI_KeypadEquals         = 0x51"
		at: 16r52 put: (self value: 16rffb0); "  kVK_ANSI_Keypad0              = 0x52"
		at: 16r53 put: (self value: 16rffb1); "  kVK_ANSI_Keypad1              = 0x53"
		at: 16r54 put: (self value: 16rffb2); "  kVK_ANSI_Keypad2              = 0x54"
		at: 16r55 put: (self value: 16rffb3); "  kVK_ANSI_Keypad3              = 0x55"
		at: 16r56 put: (self value: 16rffb4); "  kVK_ANSI_Keypad4              = 0x56"
		at: 16r57 put: (self value: 16rffb5); "  kVK_ANSI_Keypad5              = 0x57"
		at: 16r58 put: (self value: 16rffb6); "  kVK_ANSI_Keypad6              = 0x58"
		at: 16r59 put: (self value: 16rffb7); "  kVK_ANSI_Keypad7              = 0x59"
		at: 16r5B put: (self value: 16rffb8); "  kVK_ANSI_Keypad8              = 0x5B"
		at: 16r5C put: (self value: 16rffb9) "  kVK_ANSI_Keypad9              = 0x5C"! !

!KeyChain commentStamp: '<historical>'!
A KeyChain is a holder for username/password.
It can be queried by the system to prevent the user to be forced to set his or her password each time.

keys have this structure:

|- group1 (by example squeaksource) 	-> (username -> password)
|- group2 (by example smalltalkhub) 		-> (username -> password)!
!KeyChain methodsFor: 'encryption' stamp: 'CamilloBruni 7/17/2013 23:40'!
reEncryptKeysBased: aFormerBase

	groups associations do: [:assoc || oldUsernamePassword string |
				oldUsernamePassword := groups at: assoc key.
				string := encryptorDecryptor decrypt: oldUsernamePassword password base: aFormerBase.
				groups at: assoc key put: ( UsernamePassword username: oldUsernamePassword username password: (self encryptPassword: string) )]! !

!KeyChain methodsFor: 'protocol' stamp: 'MarcusDenker 10/10/2013 14:02'!
setPassword: aPassword
	| oldPassword |
	(password isNil or: [ self isUnlocked ])
		ifFalse: [ ^ self ].
	oldPassword := password.
	aPassword ifNil: [ password := nil ] ifNotNil: [ password := encryptor encrypt: aPassword ].	"Since the passwords are encoded using the password, if you change the password, you have to re-encrypt the passwords"
	self reEncryptKeysBased: oldPassword! !

!KeyChain methodsFor: 'protocol' stamp: 'CamilloBruni 7/17/2013 23:40'!
userNamePasswordFor: aGroup

	^ self isUnlocked
		ifTrue: [ | oldUsernamePassword |
			oldUsernamePassword := groups at: aGroup ifAbsent: [ ^ nil ].
			UsernamePassword username: oldUsernamePassword username password: (self decryptPassword: (oldUsernamePassword password)) ]! !

!KeyChain methodsFor: 'encryption' stamp: 'BenjaminVanRyseghem 5/6/2012 22:10'!
encryptPassword: aString

	^ encryptorDecryptor encrypt: aString base: password! !

!KeyChain methodsFor: 'protocol' stamp: 'CamilloBruni 7/17/2013 23:36'!
lock

	nextLockTime := DateAndTime new! !

!KeyChain methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 23:40'!
initialize
	super initialize.

	groups := IdentityDictionary new.
	encryptor := SHA1Ecryptor new.
	encryptorDecryptor := DummyEcryptorDecryptor new.
	
	self lock. ! !

!KeyChain methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/9/2012 13:16'!
username: aString

	username := aString ! !

!KeyChain methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/11/2012 18:04'!
isLocked

	^ true! !

!KeyChain methodsFor: 'protocol' stamp: 'CamilloBruni 7/17/2013 23:40'!
removeUserNamePasswordFor: aGroup

	^ self isUnlocked
		ifTrue: [ groups removeKey: aGroup ]! !

!KeyChain methodsFor: 'protocol' stamp: 'CamilloBruni 7/17/2013 23:40'!
setUserName: user password: pass forGroup: group

	self isUnlocked
		ifTrue: [ 
			groups 
				at: group 
				put: (UsernamePassword 
							username: user 
							password: (self encryptPassword: pass)).
			^ true ].
	^ false! !

!KeyChain methodsFor: 'private' stamp: 'BenjaminVanRyseghem 5/9/2012 16:19'!
maxAttemptsNumber

	^ 3! !

!KeyChain methodsFor: 'private' stamp: 'CamilloBruni 7/17/2013 23:40'!
passwordFor: aUserName

	^ self isUnlocked
		ifTrue: [ self decryptPassword: (groups at: aUserName) ]! !

!KeyChain methodsFor: 'protocol' stamp: 'CamilloBruni 7/17/2013 23:40'!
setUserName: user password: pass forGroup: group withUnlockPassword: aString

	(encryptor encrypt: aString) = password 
		ifTrue: [ groups 
					at: group 
					put: (UsernamePassword 
								username: user 
								password: (self encryptPassword: pass)).
								
				^ true ].
	^ false! !

!KeyChain methodsFor: 'private-UI' stamp: 'CamilloBruni 7/17/2013 23:40'!
bindings

	^ groups! !

!KeyChain methodsFor: 'private' stamp: 'BenjaminVanRyseghem 5/9/2012 16:20'!
isUnlocked

	^ self isUnlocked: 0! !

!KeyChain methodsFor: 'private' stamp: 'CamilloBruni 7/17/2013 23:37'!
timeBetweenUnlocks

	^ timeBetweenUnlocks ifNil: [ self defaultTimeBetweenUnlocks ]! !

!KeyChain methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/11/2012 16:37'!
unlock

	^ self isUnlocked ! !

!KeyChain methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/9/2012 13:16'!
username

	^ username! !

!KeyChain methodsFor: 'private' stamp: 'BenjaminVanRyseghem 5/6/2012 23:35'!
defaultTimeBetweenUnlocks
	" 5 minutes "
	
	^ Duration minutes: 5! !

!KeyChain methodsFor: 'protocol' stamp: 'CamilloBruni 7/17/2013 23:40'!
setUserNamePassword: usernamePassword forGroup: group

	self isUnlocked
		ifTrue: [ 
			groups 
				at: group 
				put: usernamePassword.
			^ true ].
	^ false! !

!KeyChain methodsFor: 'private' stamp: 'PavelKrivanek 7/8/2014 15:57'!
askPasswordForKeyChain: attempt
	| string |
	
	password ifNil: [ 
		^ nextLockTime := DateAndTime new + self timeBetweenUnlocks ].
	string := (UIManager default requestPassword: 'Password for the keychain for ', username asString ,' (', (self maxAttemptsNumber - attempt) asString ,' tries left)').
	string ifNil: [ ^ self ].		
	(encryptor encrypt: string) = password 
		ifFalse: [ self logCr: (encryptor encrypt: string). self logCr: password. ^ self ].

	 nextLockTime := DateAndTime new + self timeBetweenUnlocks.! !

!KeyChain methodsFor: 'encryption' stamp: 'BenjaminVanRyseghem 5/6/2012 22:26'!
decryptPassword: aString

	^ encryptorDecryptor decrypt: aString base: password! !

!KeyChain methodsFor: 'private' stamp: 'CamilloBruni 7/17/2013 23:37'!
timeBetweenUnlocks: aDuration

	timeBetweenUnlocks := aDuration! !

!KeyChain methodsFor: 'protocol' stamp: 'MarcusDenker 10/10/2013 14:02'!
setEncryptorDecryptor: anEncryptorDecryptor
	| oldDecryptor |
	self isUnlocked
		ifFalse: [ ^ self ].
	oldDecryptor := encryptorDecryptor.
	encryptorDecryptor := anEncryptorDecryptor.
	groups associations
		do: [ :assoc | 
			| oldUsernamePassword string |
			oldUsernamePassword := groups at: assoc key.
			string := oldDecryptor decrypt: oldUsernamePassword password base: password.
			groups
				at: assoc key
				put: (UsernamePassword username: oldUsernamePassword username password: (self encryptPassword: string)) ]! !

!KeyChain methodsFor: 'private' stamp: 'CamilloBruni 7/17/2013 23:38'!
isUnlocked: attempt

	nextLockTime > DateAndTime now
		ifTrue: [ ^ true ].
	attempt = self maxAttemptsNumber 
		ifTrue: [ ^ false ].
	self askPasswordForKeyChain: attempt.
	^ self isUnlocked: (attempt + 1).! !

!KeyChain methodsFor: 'protocol' stamp: 'CamilloBruni 7/17/2013 23:40'!
groups

	^ groups keys! !

!KeyNotFound commentStamp: 'SvenVanCaekenberghe 4/19/2011 19:41'!
I am KeyNotFound, an exception indicating that a key was not found in a Dictionary.!
!KeyNotFound methodsFor: 'accessing' stamp: 'MarcusDenker 11/1/2014 16:50'!
key
	^ self object! !

!KeyNotFound methodsFor: 'private' stamp: 'MarianoMartinezPeck 5/27/2011 16:38'!
standardMessageText
	"Generate a standard textual description"
	
	^ String streamContents: [ :stream |
		stream << 'key '.
		stream print: self object.
		stream << ' not found in '.
		stream print: self collection class ]! !

!KeyNotFound methodsFor: 'accessing' stamp: 'MarcusDenker 11/1/2014 16:50'!
key: aKey
	self object: aKey! !

!KeyPrinterMorph commentStamp: '<historical>'!
I am a morph that prints the keys in the keyboard events.

KeyPrinterMorph new openInWorld!
!KeyPrinterMorph methodsFor: 'event handling' stamp: 'GuillermoPolito 5/4/2013 12:46'!
mouseDown: event 
	super mouseDown: event.
	World activeHand newKeyboardFocus: self! !

!KeyPrinterMorph methodsFor: 'initialize' stamp: 'GuillermoPolito 5/4/2013 12:53'!
openInWorld
	self  openInWindowLabeled: 'KeyPrinter'! !

!KeyPrinterMorph methodsFor: 'event handling' stamp: 'GuillermoPolito 5/4/2013 12:20'!
handlesKeyboard: evt
	^ true! !

!KeyPrinterMorph methodsFor: 'event handling' stamp: 'GuillermoPolito 5/4/2013 12:47'!
handlesMouseDown: evt
	^ true! !

!KeyPrinterMorph methodsFor: 'event handling' stamp: 'GuillermoPolito 5/4/2013 12:50'!
keyDown: anEvent
	UIManager default inform: anEvent key asString.! !

!KeyboardEvent commentStamp: '<historical>'!
I am a keyboard event. I contain the char code of the event pressed, the modifiers pressed, and the keycode of the key pressed.!
!KeyboardEvent methodsFor: 'testing' stamp: 'DenisKudryashov 7/20/2013 17:29'!
hasSpecialCTRLKeyValue
"
	4 - Character end
	1 - Character home
"

	^ self controlKeyPressed and: [ keyValue <= 26 & (keyValue ~= 4) & (keyValue ~= 1) ]! !

!KeyboardEvent methodsFor: '*Polymorph-Widgets' stamp: 'SeanDeNigris 1/23/2014 11:53'!
isWindowNavigation

	^ TaskListMorph isNavigationEvent: self.! !

!KeyboardEvent methodsFor: 'dispatching' stamp: 'ar 9/15/2000 21:13'!
sentTo: anObject
	"Dispatch the receiver into anObject"
	type == #keystroke ifTrue:[^anObject handleKeystroke: self].
	type == #keyDown ifTrue:[^anObject handleKeyDown: self].
	type == #keyUp ifTrue:[^anObject handleKeyUp: self].
	^super sentTo: anObject.! !

!KeyboardEvent methodsFor: 'keyboard' stamp: 'nk 10/13/2004 10:43'!
keyString
	"Answer the string value for this keystroke. This is defined only for keystroke events."

	^ String streamContents: [ :s | self printKeyStringOn: s ]! !

!KeyboardEvent methodsFor: 'testing' stamp: 'ar 9/13/2000 15:49'!
isKeyboard
	^true! !

!KeyboardEvent methodsFor: 'initialize' stamp: 'michael.rueger 2/24/2009 14:08'!
scanCode: anInt
	scanCode := anInt! !

!KeyboardEvent methodsFor: 'testing' stamp: 'ar 9/13/2000 15:49'!
isKeystroke
	^self type == #keystroke! !

!KeyboardEvent methodsFor: 'testing' stamp: 'ar 10/9/2000 00:43'!
isMouseMove
	^false! !

!KeyboardEvent methodsFor: 'printing' stamp: 'nk 10/13/2004 10:42'!
printOn: aStream
	"Print the receiver on a stream"

	aStream nextPut: $[.
	aStream nextPutAll: type; nextPutAll: ' '''.
	self printKeyStringOn: aStream.
	aStream nextPut: $'.
	aStream nextPut: $]! !

!KeyboardEvent methodsFor: 'testing' stamp: 'SeanDeNigris 1/29/2013 11:22'!
isUserInterrupt

	^ UserInterruptHandler cmdDotEnabled and: [ self keyCharacter = $. and: [ self commandKeyPressed ] ].
	! !

!KeyboardEvent methodsFor: '*Keymapping-KeyCombinations' stamp: 'GuillermoPolito 6/28/2013 13:03'!
asShortcut
	^ self asKeyCombination! !

!KeyboardEvent methodsFor: 'keyboard' stamp: 'cami 7/22/2013 18:27'!
key
	^Smalltalk os keyForValue: keyValue! !

!KeyboardEvent methodsFor: 'keyboard' stamp: 'michael.rueger 3/11/2009 11:21'!
keyCharacter
	"Answer the character corresponding this keystroke. This is defined only for keystroke events."

	^Unicode value: charCode! !

!KeyboardEvent methodsFor: 'keyboard' stamp: 'ar 9/13/2000 15:51'!
keyValue
	"Answer the ascii value for this keystroke. This is defined only for keystroke events."

	^ keyValue! !

!KeyboardEvent methodsFor: 'private' stamp: 'ar 10/5/2000 23:54'!
setType: aSymbol buttons: anInteger position: pos keyValue: aValue hand: aHand stamp: stamp
	type := aSymbol.
	buttons := anInteger.
	position := pos.
	keyValue := aValue.
	source := aHand.
	wasHandled := false.
	timeStamp := stamp.! !

!KeyboardEvent methodsFor: 'testing' stamp: 'ar 9/13/2000 15:49'!
isKeyDown
	^self type == #keyDown! !

!KeyboardEvent methodsFor: 'comparing' stamp: 'ar 9/13/2000 15:50'!
hash
	^buttons hash + keyValue hash
! !

!KeyboardEvent methodsFor: 'printing' stamp: 'SeanDeNigris 1/15/2014 15:24'!
storeOn: aStream

	aStream nextPutAll: type.
	aStream space.
	self timeStamp storeOn: aStream.
	aStream space.
	position x asInteger storeOn: aStream.
	aStream space.
	position y asInteger storeOn: aStream.
	aStream space.
	buttons storeOn: aStream.
	aStream space.
	keyValue storeOn: aStream.
	aStream space.
	charCode storeOn: aStream.
	aStream space.
	scanCode storeOn: aStream.! !

!KeyboardEvent methodsFor: '*Keymapping-KeyCombinations' stamp: 'GuillermoPolito 3/19/2013 19:12'!
asKeyCombination
	^ KMKeyCombination fromKeyboardEvent: self! !

!KeyboardEvent methodsFor: 'printing' stamp: 'DenisKudryashov 7/20/2013 17:32'!
printKeyStringOn: aStream
	"Print a readable string representing the receiver on a given stream"

	| kc inBrackets firstBracket keyString |
	kc := self keyCharacter.
	inBrackets := false.
	firstBracket := [ inBrackets ifFalse: [ aStream nextPut: $<. inBrackets := true ]].
	self controlKeyPressed ifTrue: [ 	firstBracket value. aStream nextPutAll: 'Ctrl-' ].
	self commandKeyPressed ifTrue: [ firstBracket value. aStream nextPutAll: 'Cmd-' ].
	(buttons anyMask: 32) ifTrue: [ firstBracket value. aStream nextPutAll: 'Opt-' ].
	(self shiftPressed and: [ keyValue between: 1 and: 31 ])
		ifTrue: [ firstBracket value. aStream nextPutAll: 'Shift-' ].

	self hasSpecialCTRLKeyValue
			ifTrue:
				[aStream nextPut: (keyValue + $a asciiValue - 1) asCharacter]
			ifFalse: 
				[keyString := (kc caseOf: {
					[ Character space ] -> [ ' ' ].
					[ Character tab ] -> [ 'tab' ].
					[ Character cr ] -> [ 'cr' ].
					[ Character lf ] -> [ 'lf' ].
					[ Character enter ] -> [ 'enter' ].

					[ Character backspace ] -> [ 'backspace' ].
					[ Character delete ] -> [ 'delete' ].

					[ Character escape ] -> [ 'escape' ].

					[ Character arrowDown ] -> [ 'down' ].
					[ Character arrowUp ] -> [ 'up' ].
					[ Character arrowLeft ] -> [ 'left' ].
					[ Character arrowRight ] -> [ 'right' ].

					[ Character end ] -> [ 'end' ].
					[ Character home ] -> [ 'home' ].
					[ Character pageDown ] -> [ 'pageDown' ].
					[ Character pageUp ] -> [ 'pageUp' ].

					[ Character euro ] -> [ 'euro' ].
					[ Character insert ] -> [ 'insert' ].

				} otherwise: [ String with: kc ]).
				keyString size > 1 ifTrue: [ firstBracket value ].
				aStream nextPutAll: keyString].

	inBrackets ifTrue: [aStream nextPut: $> ]! !

!KeyboardEvent methodsFor: 'keyboard' stamp: 'michael.rueger 2/25/2009 22:19'!
scanCode
	^scanCode! !

!KeyboardEvent methodsFor: 'comparing' stamp: 'ar 10/24/2000 17:44'!
= aMorphicEvent
	super = aMorphicEvent ifFalse:[^false].
	buttons = aMorphicEvent buttons ifFalse: [^ false].
	keyValue = aMorphicEvent keyValue ifFalse: [^ false].
	^ true
! !

!KeyboardEvent methodsFor: 'private' stamp: 'michael.rueger 2/23/2009 11:49'!
setType: aSymbol buttons: anInteger position: pos keyValue: aValue charCode: anInt hand: aHand stamp: stamp
	type := aSymbol.
	buttons := anInteger.
	position := pos.
	keyValue := aValue.
	charCode := anInt.
	source := aHand.
	wasHandled := false.
	timeStamp := stamp.! !

!KeyboardEvent methodsFor: '*Keymapping-KeyCombinations' stamp: 'DenisKudryashov 7/20/2013 17:28'!
modifiedCharacter
    self flag: #hack.
    "Hack me.  When Ctrl is pressed, the key ascii value is not right and we have to do something ugly"
    ^(self hasSpecialCTRLKeyValue and: [ (#(MacOSX Windows) includes: Smalltalk os current platformFamily) ])
        ifTrue: [ (self keyValue + $a asciiValue - 1) asCharacter ]    
        ifFalse: [ self keyCharacter ]! !

!KeyboardEvent methodsFor: 'testing' stamp: 'ar 9/13/2000 15:49'!
isKeyUp
	^self type == #keyUp! !

!KeyedTree commentStamp: '<historical>'!
Provides path based access to elements contained in the receiver and any subtrees.

Example:

(KeyedTree new
	at: 1 put: 'One';
	at: 2 put: 'Two';
	at: 'Tree' put: (KeyedTree new
					at: $a put: 'Tree-A';
					at: $b put: 'Tree-B';
					yourself);
	yourself) atPath: #('Tree' $b)!
!KeyedTree methodsFor: 'printing' stamp: 'nice 1/5/2010 15:59'!
putFormattedTextOn: aStream withDescriptions: aKeyedTree level: indentLevel indentString: aString
	"Place a print of the receiver and associated description on the given stream with the given indentation level."

	
	(self keys asSortedCollection: self sortBlock) do: [:k | | v |
		indentLevel timesRepeat: [aStream nextPutAll: aString].
		aStream nextPutAll: k printString.
		v := self at: k.
		(v isKindOf: self class)
			ifTrue: [aStream cr.
					v
						putFormattedTextOn: aStream
						withDescriptions: (aKeyedTree at: k ifAbsent: [self class new])
						level: indentLevel + 1
						indentString: aString]
			ifFalse: [aStream
						nextPutAll: ' : ';
						nextPutAll: v printString;
						tab; tab;
						nextPutAll: (aKeyedTree at: k ifAbsent: ['nondescript']) printString.
					aStream cr]]! !

!KeyedTree methodsFor: 'accessing' stamp: 'gvc 2/1/2006 11:01'!
atPath: anArray ifAbsentPut: aBlock
	"Answer the element referenced by the given key path.
	Answer the value of aBlock if not found after creating its path."

	|element|
	anArray isEmpty
		ifTrue: [^self].
	element := self.
	anArray allButLastDo: [:key |
		element := element at: key ifAbsentPut: [self species new]].
	^element at: anArray last ifAbsentPut: aBlock! !

!KeyedTree methodsFor: 'accessing' stamp: 'gvc 2/1/2006 11:00'!
atPath: anArray put: aBlock
	"Answer the value of aBlock after creating its path."

	|element|
	anArray isEmpty
		ifTrue: [^self].
	element := self.
	anArray allButLastDo: [:key |
		element := element at: key ifAbsentPut: [self species new]].
	^element at: anArray last put: aBlock! !

!KeyedTree methodsFor: 'printing' stamp: 'gvc 1/17/2008 16:06'!
formattedText
	"Answer a string or text representing the receiver with indentation and, possibly, markup."

	|str|
	str := String new writeStream.
	self putFormattedTextOn: str level: 0 indentString: '  '.
	^str contents! !

!KeyedTree methodsFor: 'removing' stamp: 'gvc 10/20/2005 18:53'!
removePath: anArray ifAbsent: aBlock
	"Remove and answer the element referenced by the given path.
	Answer the value of aBlock if not found."

	|element|
	anArray isEmpty
		ifTrue: [^self].
	element := self.
	anArray allButLastDo: [:key |
		element := element at: key ifAbsent: [^aBlock value]].
	^element removeKey: anArray last ifAbsent: aBlock	! !

!KeyedTree methodsFor: 'accessing' stamp: 'gvc 12/15/2005 13:57'!
allKeys
	"Answer an ordered collection of the keys of the receiver and any subtrees.
		Please no circular references!!"

	|answer|
	answer := OrderedCollection new.
	answer addAll: self keys.
	self subtrees do: [:t |
		answer addAll: t allKeys].
	^answer! !

!KeyedTree methodsFor: 'accessing' stamp: 'gvc 2/1/2006 11:01'!
atPath: anArray ifAbsent: aBlock
	"Answer the element referenced by the given key path.
	Answer the value of aBlock if not found."

	|element|
	element := self.
	anArray do: [:key |
		element := element at: key ifAbsent: [^aBlock value]].
	^element! !

!KeyedTree methodsFor: 'accessing' stamp: 'gvc 12/15/2005 13:54'!
subtrees
	"Answer the subtrees of the receiver."

	^(self select: [:v | v isKindOf: KeyedTree]) values! !

!KeyedTree methodsFor: 'printing' stamp: 'nice 1/5/2010 15:59'!
putFormattedTextOn: aStream level: indentLevel indentString: aString
	"Place a description of the receiver on the given stream with the given indentation level."

	
	(self keys asSortedCollection: self sortBlock) do: [:k | | v |
		indentLevel timesRepeat: [aStream nextPutAll: aString].
		aStream nextPutAll: k printString.
		v := self at: k.
		(v isKindOf: self class)
			ifTrue: [aStream cr.
					v putFormattedTextOn: aStream level: indentLevel + 1 indentString: aString]
			ifFalse: [aStream
						nextPutAll: ' : ';
						nextPutAll: v printString.
					aStream cr]]! !

!KeyedTree methodsFor: 'copying' stamp: 'nice 1/13/2010 21:46'!
postCopy
	"Must copy the associations, or later store will affect both the
		original and the copy.
	Copy any subtrees too!!"

	array := array collect: [:assoc |
			assoc ifNil: [nil]
				ifNotNil: [Association
							key: assoc key
							value: ((assoc value isKindOf: KeyedTree)
									ifTrue: [assoc value copy]
									ifFalse: [assoc value])]]! !

!KeyedTree methodsFor: 'printing' stamp: 'gvc 1/17/2008 16:23'!
formattedTextWithDescriptions: aKeyedTree
	"Answer a string or text representing the receiver with indentation and, possibly, markup.
	Descriptions of each item are taken from the given tree with
	the same key structure as the receiver."
	
	|str|
	str := String new writeStream.
	self putFormattedTextOn: str withDescriptions: aKeyedTree level: 0 indentString: '  '.
	^str contents! !

!KeyedTree methodsFor: 'adding' stamp: 'MarcusDenker 11/1/2014 16:53'!
merge: aKeyedTree
	"Merge the given tree into the receiver, overwriting or extending elements as needed."

	aKeyedTree keysAndValuesDo: [ :k :v | 
			| subtree |
			(v isKindOf: KeyedTree)
				ifTrue: [ 
					subtree := self at: k ifAbsentPut: [ v species new ].
					(subtree isKindOf: KeyedTree)
						ifFalse: [ subtree := self at: k put: v species new ].
					subtree merge: v ]
				ifFalse: [ self at: k put: v ] ]! !

!KeyedTree methodsFor: 'accessing' stamp: 'CamilloBruni 4/11/2011 13:30'!
atPath: anArray
	"Answer the element referenced by the give key path.
	Signal an error if not found."

	^self atPath: anArray ifAbsent: [self errorKeyNotFound: anArray]! !

!KeyedTree methodsFor: 'accessing' stamp: 'gvc 1/17/2008 15:37'!
sortBlock
	"Answer the block to sort tree keys with."

	^[:a :b | [a <= b] on: Error do: [a class name <= b class name]]! !

!KeyedTree methodsFor: 'removing' stamp: 'CamilloBruni 4/11/2011 13:31'!
removePath: anArray
	"Remove and answer the element referenced by the given path.
	Signal an error if not found."

	^self removePath: anArray ifAbsent: [self errorKeyNotFound: anArray]! !

!KeyedTreeTest commentStamp: 'TorstenBergmann 2/20/2014 15:29'!
SUnit tests for keyed trees!
!KeyedTreeTest methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 6/9/2012 22:57'!
testAtPathPut
	"Test the at path put method for success and failure modes."

	|tree t2|
	tree := KeyedTree new
		at: 1 put: (KeyedTree new
					at: #two put: 'One-Two';
					at: #three put: 'One-Three';
					yourself);
		at: 2 put: 'Two';
		yourself.
	self should: [(tree atPath: #(1 two) put: #new) = #new].
	self should: [(tree atPath: #(1 two)) = #new].
	self should: [(tree atPath: #(1 three) put: (t2 := KeyedTree new)) = t2].
	self should: [(tree atPath: #(1 three $1) put: #anotherNew) = #anotherNew].
	self should: [(tree atPath: #(1 three $1)) = #anotherNew].
	self should: [tree atPath: #(2 4) put: [#new]] raise: self defaultTestError.
	self should: [(tree atPath: #(1 four one) put: #anotherNew) = #anotherNew].
	self should: [(tree atPath: #(1 four one)) = #anotherNew].! !

!KeyedTreeTest methodsFor: 'as yet unclassified' stamp: 'gvc 4/18/2006 14:35'!
testRemovePathIfAbsent
	"Test the remove path if absent method for success and failure modes."

	|tree|
	tree := KeyedTree new
		at: 1 put: (KeyedTree new
					at: #two put: 'One-Two';
					at: #three put: 'One-Three';
					yourself);
		at: 2 put: 'Two';
		yourself.
	self should: [(tree removePath: #(4) ifAbsent: [#none]) = #none].
	self should: [(tree removePath: #(1 2 3 4) ifAbsent: [#none]) = #none].
	self should: [(tree removePath: #(1 two) ifAbsent: [#none]) = 'One-Two'].
	self should: [(tree atPath: #(1 two) ifAbsent: []) = nil].
	self should: [(tree removePath: #(2) ifAbsent: [#none]) = 'Two'].
	self should: [(tree atPath: #(2) ifAbsent: []) = nil].! !

!KeyedTreeTest methodsFor: 'as yet unclassified' stamp: 'gvc 7/30/2009 18:37'!
testMerge
	"Test the merge method for success and failure modes."

	|t1 t2 m|
	t1 := KeyedTree new
		at: 1 put: (KeyedTree new
					at: #1 put: '1-1';
					at: #2 put: '1-2';
					at: #3 put: (KeyedTree new
								at: 1 put: '1-3-1';
								at: 2 put: '1-3-2';
								yourself);
					yourself);
		at: 2 put: '2';
		yourself.
	t2 := KeyedTree new
		at: 1 put: (KeyedTree new
					at: #1 put: (KeyedTree new
								at: 1 put: '1-1-1';
								at: 2 put: '1-1-2';
								yourself);
					at: #2 put: '1-2*';
					yourself);
		at: 3 put: '3';
		yourself.
	m := t1 merge: t2.
	self should: [(m at: 2) = '2'].
	self should: [(m at: 3) = '3'].
	self should: [(m atPath: #(1 2)) = '1-2*'].
	self should: [(m atPath: #(1 1 1)) = '1-1-1'].
	self should: [(m atPath: #(1 1 2)) = '1-1-2'].
	self should: [(m atPath: #(1 3 1)) = '1-3-1'].
	self should: [(m atPath: #(1 3 2)) = '1-3-2'].! !

!KeyedTreeTest methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 6/9/2012 22:57'!
testAtPathIfAbsentPut
	"Test the at path if absent put method for success and failure modes."

	|tree t2|
	tree := KeyedTree new
		at: 1 put: (t2 := KeyedTree new
					at: #two put: 'One-Two';
					at: #three put: 'One-Three';
					yourself);
		at: 2 put: 'Two';
		yourself.
	self should: [(tree atPath: #(1) ifAbsentPut: [#new]) = t2].
	self should: [(tree atPath: #(1 two) ifAbsentPut: [#new]) = 'One-Two'].
	self should: [(tree atPath: #(1 three) ifAbsentPut: [#new]) = 'One-Three'].
	self should: [(tree atPath: #(2) ifAbsentPut: [#new]) = 'Two'].
	self should: [tree atPath: #(2 4) ifAbsentPut: [#new]] raise: self defaultTestError.
	self should: [tree atPath: #(1 two three) ifAbsentPut: [#new]] raise: self defaultTestError.
	self should: [(tree atPath: #(1 four one) ifAbsentPut: [#anotherNew]) = #anotherNew].
	self should: [(tree atPath: #(1 four one)) = #anotherNew].
	self should: [(tree atPath: #(3) ifAbsentPut: [#yetAnotherNew]) = #yetAnotherNew].
	self should: [(tree atPath: #(3)) = #yetAnotherNew].! !

!KeyedTreeTest methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 6/9/2012 22:57'!
testRemovePath
	"Test the remove path method for success and failure modes."

	|tree|
	tree := KeyedTree new
		at: 1 put: (KeyedTree new
					at: #two put: 'One-Two';
					at: #three put: 'One-Three';
					yourself);
		at: 2 put: 'Two';
		yourself.
	self should: [tree removePath: #(4)] raise: self defaultTestError.
	self should: [tree removePath: #(1 one)] raise: self defaultTestError.
	self should: [(tree removePath: #(1 two)) = 'One-Two'].
	self should: [(tree atPath: #(1 two) ifAbsent: []) = nil].
	self should: [(tree removePath: #(2)) = 'Two'].
	self should: [(tree atPath: #(2) ifAbsent: []) = nil].! !

!KeyedTreeTest methodsFor: 'as yet unclassified' stamp: 'gvc 1/22/2010 13:52'!
testSubtrees
	"Test the subtrees method for success and failure modes."

	|t1 t2 t3 t4|
	t1 := KeyedTree new
		at: 1 put: (t2 := KeyedTree new
					at: #1 put: '1-1';
					at: #2 put: '1-2';
					at: #3 put: (t3 := KeyedTree new
								at: 1 put: '1-3-1';
								at: 2 put: '1-3-2';
								yourself);
					yourself);
		at: 2 put: '2';
		at: 3 put: (t4 := KeyedTree new
					at: 1 put: '1-3-1';
					at: 2 put: '1-3-2';
					yourself);
		yourself.
	self should: [t1 subtrees = {t2. t4}].
	self should: [(t1 at: 1) subtrees = {t3}].! !

!KeyedTreeTest methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 6/9/2012 22:58'!
testAtPathIfAbsent
	"Test the at path if absent method for success and failure modes."

	|tree t2|
	tree := KeyedTree new
		at: 1 put: (t2 := KeyedTree new
					at: #two put: 'One-Two';
					at: #three put: 'One-Three';
					yourself);
		at: 2 put: 'Two';
		yourself.
	self should: [(tree atPath: #(1) ifAbsent: []) = t2].
	self should: [(tree atPath: #(1 two) ifAbsent: []) = 'One-Two'].
	self should: [(tree atPath: #(1 three) ifAbsent: []) = 'One-Three'].
	self should: [(tree atPath: #(2) ifAbsent: []) = 'Two'].
	self should: [(tree atPath: #(2 4) ifAbsent: [#missing]) = #missing].
	self should: [(tree atPath: #(1 two three) ifAbsent: [#missing]) = #missing] raise: self defaultTestError.
	self should: [(tree atPath: #(3) ifAbsent: [#missing]) = #missing].! !

!KeyedTreeTest methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 6/9/2012 22:58'!
testAtPath
	"Test the at path method for success and failure modes."

	|tree t2|
	tree := KeyedTree new
		at: 1 put: (t2 := KeyedTree new
					at: #two put: 'One-Two';
					at: #three put: 'One-Three';
					yourself);
		at: 2 put: 'Two';
		yourself.
	self should: [(tree atPath: #(1)) = t2].
	self should: [(tree atPath: #(1 two)) = 'One-Two'].
	self should: [(tree atPath: #(1 three)) = 'One-Three'].
	self should: [(tree atPath: #(2)) = 'Two'].
	self should: [tree atPath: #(2 4)] raise: self defaultTestError.
	self should: [tree atPath: #(1 two three)] raise: self defaultTestError.
	self should: [tree atPath: #(3)] raise: self defaultTestError.! !

!KeyedTreeTest methodsFor: 'as yet unclassified' stamp: 'gvc 1/22/2010 13:52'!
testCopy
	"Test the copy method for success and failure modes."

	|c tree t2 t3|
	tree := KeyedTree new
		at: 1 put: (t2 := KeyedTree new
					at: #two put: 'One-Two';
					at: #three put: 'One-Three';
					at: #four put: (t3 := KeyedTree new);
					yourself);
		at: 2 put: 'Two';
		yourself.
	c := tree copy.
	self should: [c = tree].
	self shouldnt: [c == tree].
	self should: [(c at: 1) = t2].
	self shouldnt: [(c at: 1) == t2].
	self should: [(c atPath: #(1 four)) = t3].
	self shouldnt: [(c atPath: #(1 four)) == t3].! !

!KeymapBrowser commentStamp: 'NicolaiHess 2/16/2015 14:58'!
A KeymapBrowser  shows a list of all defined keymappings.
It shows a filterable list of keymap shortcuts,  name and categories.
Use the context menu to browse the method that defines the shortcut.!
!KeymapBrowser methodsFor: 'private' stamp: 'NicolaiHess 2/16/2015 22:37'!
inspectActionOfSelectedShortcut
	| selection action   |
	selection := self kmTable selectedItem.
	selection ifNil: [ ^ self ].
	action := selection realValue keymap.
	action ifNil: [ ^ self ].
	action inspect! !

!KeymapBrowser methodsFor: 'private' stamp: 'NicolaiHess 2/16/2015 22:42'!
menu: aMenu shifted: aBoolean
	(aMenu add: 'Refresh' target: self selector: #collectAllShortcuts) 
	icon: Smalltalk ui icons smallUpdateIcon.
	self kmTable selectedItem ifNil:[^ aMenu].
	(aMenu add: 'Browse Definition' target: self selector: #browseDefinitionOfSelectedShortcut)
	icon: Smalltalk ui icons smallSystemBrowserIcon.
	(aMenu add: 'Inspect Action' target: self selector: #inspectActionOfSelectedShortcut)
	icon: Smalltalk ui icons smallInspectItIcon.
	^ aMenu! !

!KeymapBrowser methodsFor: 'accessing' stamp: 'NicolaiHess 2/16/2015 09:51'!
clearFilterButton
	^ clearFilterButton! !

!KeymapBrowser methodsFor: 'accessing' stamp: 'NicolaiHess 2/16/2015 09:51'!
filterField: anObject
	filterField := anObject! !

!KeymapBrowser methodsFor: 'private' stamp: 'NicolaiHess 2/24/2015 00:05'!
setFilter: aFilterText
	aFilterText isEmpty
		ifTrue: [ self kmTable resetFilteringBlock ]
		ifFalse: [ self kmTable
				filteringBlock: [ :items | items select: [ :item | 
						(self wrapItem: item) anySatisfy: [ :s | s includesSubstring: aFilterText caseSensitive: false ] ] ] ]! !

!KeymapBrowser methodsFor: 'private' stamp: 'NicolaiHess 2/16/2015 12:22'!
browseDefinitionOfSelectedShortcut
	| selection action class selector |
	selection := self kmTable selectedItem.
	selection ifNil: [ ^ self ].
	action := selection realValue keymap action.
	action ifNil: [ ^ self ].
	class := action method methodClass.
	selector := action method selector.
	Smalltalk tools browser fullOnClass: class selector: selector highlight: selection shortcutName! !

!KeymapBrowser methodsFor: 'accessing' stamp: 'NicolaiHess 2/16/2015 09:51'!
clearFilterButton: anObject
	clearFilterButton := anObject! !

!KeymapBrowser methodsFor: 'accessing' stamp: 'NicolaiHess 2/16/2015 09:51'!
filterField
	^ filterField! !

!KeymapBrowser methodsFor: 'initialization' stamp: 'NicolaiHess 2/24/2015 00:05'!
initializeWidgets
	self title: self class name.
	kmTable := self newMultiColumnList.
	kmTable displayBlock: [ :item | self wrapItem: item ].
	kmTable sortingBlock: [ :a :b | a categoryName < b categoryName ].
	kmTable menu: [ :m :s| self menu:m shifted:s].
	filterField := self newTextInput.
	filterField removeEntryCompletion.
	filterField ghostText: 'Filter'.
	filterField autoAccept: true.
	clearFilterButton := self newButton.
	clearFilterButton icon: Smalltalk ui icons smallCancelIcon.
	clearFilterButton enabled:false.
	self collectAllShortcuts! !

!KeymapBrowser methodsFor: 'accessing' stamp: 'NicolaiHess 2/16/2015 09:51'!
kmTable: anObject
	kmTable := anObject! !

!KeymapBrowser methodsFor: 'initialization' stamp: 'NicolaiHess 2/16/2015 14:52'!
initializePresenter
	filterField
		whenTextChanged: [ :text | 
			clearFilterButton enabled: text isEmpty not.
			self setFilter: text ].
	clearFilterButton action: [ filterField text: '' ].
! !

!KeymapBrowser methodsFor: 'private' stamp: 'NicolaiHess 2/16/2015 15:11'!
collectAllShortcuts
	| collection |
	collection := OrderedCollection new.
	KMRepository default categories
		do: [ :cat | 
			cat keymaps
				do: [ :keymapping | 
					collection
						add:
							(KMShortcutDeclaration new
								shortcutName: keymapping name;
								categoryName: cat name;
								yourself) ] ].
	self kmTable items: collection.! !

!KeymapBrowser methodsFor: 'accessing' stamp: 'NicolaiHess 2/16/2015 09:51'!
kmTable
	^ kmTable! !

!KeymapBrowser methodsFor: 'private' stamp: 'NicolaiHess 2/16/2015 10:53'!
wrapItem: aKMShortcutDeclaration
	| name categorie |
	name := aKMShortcutDeclaration shortcutName.
	categorie := aKMShortcutDeclaration categoryName.
	^ {aKMShortcutDeclaration realValue shortcut asString . name.
	categorie}! !

!KeymapBrowser methodsFor: 'protocol' stamp: 'NicolaiHess 2/16/2015 14:54'!
initialExtent
	^ 600@300! !

!KeymapBrowser class methodsFor: 'specs' stamp: 'NicolaiHess 2/16/2015 14:50'!
defaultSpec
	<spec>
	^ SpecLayout composed
		newColumn: [ :c | c newRow: [ :r | 
							r
								add: #filterField;
								add: #clearFilterButton width: 25 ]
						height: self toolbarHeight.
					c newRow: [ :r | r add: #kmTable ] ];
		yourself! !

!KeymapBrowser class methodsFor: 'system menu' stamp: 'NicolaiHess 2/16/2015 16:47'!
keymapBrowserMenuOn: aBuilder 
	"I build a menu"
	<worldMenu>
	(aBuilder item: #'Keymap Browser')
		parent: #System;
		order: 4;
		action: [ self new openWithSpec ];
		help: 'List all know shortcuts and Keymapping categories'.! !

!KeymapBuilderTest methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 3/19/2013 19:12'!
testAddKeymapCreatesShortcut
	KMRepository default
		initializeKeymap: #test
		executingOn: $r ctrl, $r asKeyCombination, $r asKeyCombination
		doing: [ :receiver | "nothing" ]
		inCategory: #Testing
		platform: #all.
	
	self assert: (KMRepository default categoryForName: #Testing ) allEntries size = 1.! !

!KeymapBuilderTest methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 3/19/2013 19:12'!
testAddKeymapCreatesCategory
	self assert: KMRepository default categories isEmpty.
	
	KMRepository default
		initializeKeymap: #test
		executingOn: $r ctrl, $r asKeyCombination, $r asKeyCombination
		doing: [ :receiver | "nothing" ]
		inCategory: #Testing
		platform: #all.
	
	self assert: (KMRepository default includesCategoryNamed: #Testing).
	self assert: KMRepository default categories size = 1.! !

!KeymapBuilderTest methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 3/19/2013 19:12'!
testAttachKeymapAndExecuteExecutes
	| executed morphToTest |
	executed := false.
	
	KMFactory keymapContainer
		initializeKeymap: #test
		executingOn: $a asKeyCombination, $a asKeyCombination, $a asKeyCombination
		doing: [ :receiver | executed := true ]
		inCategory: #Testing
		platform: #all.

"	KMFactory keymapContainer attachCategoryName: #Testing to: KMMockMorph."
	
	morphToTest := KMMockMorph new.
	morphToTest attachKeymapCategory: #Testing.
	
	{self eventKey: $a. self eventKey: $a. self eventKey: $a}
		do: [:e | morphToTest dispatchKeystrokeForEvent: e].
		
	self assert: executed.! !

!KeymapBuilderTest class methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 3/18/2011 23:11'!
keymapEventBuilderClass
	^ KMFactory keymapEventBuilder! !

!KmGlobalDispatcher commentStamp: '<historical>'!
I am a dispatcher that dispatches the global keymappings.!
!KmGlobalDispatcher methodsFor: 'testing' stamp: 'GuillermoPolito 5/3/2013 16:59'!
isGlobalDispatcher
	^true! !

!KmGlobalDispatcher methodsFor: 'dispatching' stamp: 'GuillermoPolito 5/3/2013 17:46'!
dispatch: anEventBuffer
	dispatcher
		dispatch: anEventBuffer
		inCategories: KMRepository default globalCategories
! !

!KmGlobalDispatcher methodsFor: 'iterating' stamp: 'GuillermoPolito 5/3/2013 16:57'!
nextForKmChain: aKMDispatchChain 
	^aKMDispatchChain target! !

!KmGlobalDispatcher methodsFor: 'initialize-release' stamp: 'GuillermoPolito 5/3/2013 17:22'!
dispatcher: aDispatcher
	dispatcher := aDispatcher! !

!Komit commentStamp: '<historical>'!
I am a representation of a commit.

I am abstracted from Monticello to be able to be reused with other frameworks!
!Komit methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/26/2013 20:23'!
commitOn: aSubmitter

	aSubmitter commitKomit: self! !

!KomitClass commentStamp: '<historical>'!
I am encapsulating a class and the operations which has been append to it.

I implement a flyweight DP!
!KomitClass methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 22:04'!
definition
	^ definition! !

!KomitClass methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/24/2013 21:41'!
definitions

	^ definitions ifNil: [ definitions := (self operations
		select: [ :each | each isClassPatch ]
		thenCollect: [ :each | each koDefinition ]) sorted ]! !

!KomitClass methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/21/2013 14:43'!
addOperation: anOperation

	operations add: anOperation! !

!KomitClass methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/21/2013 22:03'!
operations
	
	^ (definition
		ifNil: [ operations ]
		ifNotNil: [ {definition}, operations asOrderedCollection ]) asOrderedCollection! !

!KomitClass methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/21/2013 21:58'!
addClassDefinition: aMCRemoval 

	self definition: aMCRemoval! !

!KomitClass methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 21:58'!
definition: aMCRemoval 
	
	definition := aMCRemoval! !

!KomitClass methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/24/2013 21:41'!
methods

	^ methods ifNil: [ methods := (self operations 
		select: [ :each | each isMethodPatch ]
		thenCollect: [ :each | each koMethod ]) sorted ]! !

!KomitClass methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 14:23'!
trackedClass
	^ trackedClass! !

!KomitClass methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/21/2013 22:05'!
koDestinationText

	^ self isDirty
		ifTrue: [ self definition koDestinationText ]
		ifFalse: [ '' ]! !

!KomitClass methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 12/7/2013 10:56'!
isKomitClass

	^ true! !

!KomitClass methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/26/2013 10:21'!
koSourceText

	^ self isDirty
		ifFalse: [ 'No changes' ]
		ifTrue: [ self definition koSourceText ]! !

!KomitClass methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/22/2013 16:43'!
addOrganizationDefinition: aMCModification 
	
	self addOperation: aMCModification! !

!KomitClass methodsFor: 'initialize' stamp: 'BenjaminVanRyseghem 11/21/2013 20:55'!
initialize

	super initialize.

	operations := Set new! !

!KomitClass methodsFor: 'printing' stamp: 'BenjaminVanRyseghem 11/21/2013 14:57'!
printOn: aStream

	super printOn: aStream.
	aStream << '[ '.
	self trackedClass printOn: aStream.
	aStream << ' ]'.! !

!KomitClass methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 14:23'!
trackedClass: anObject
	trackedClass := anObject! !

!KomitClass methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/27/2013 13:51'!
flush
	super flush.
	
	definition := nil.
	operations removeAll.
	methods ifNotNil: [ :m | m do: [ :e | e flush ] ].
	methods := nil.
	definitions ifNotNil: [ :d | d do: [ :e | e flush ] ].
	definitions := nil! !

!KomitClass methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/21/2013 21:59'!
addMethodDefinition: aMCAddition

	self addOperation: aMCAddition! !

!KomitClass methodsFor: 'comparing' stamp: 'BenjaminVanRyseghem 11/24/2013 21:25'!
<= aKomitObject 

	^ self class name <= aKomitObject class name! !

!KomitClass class methodsFor: 'initialize' stamp: 'BenjaminVanRyseghem 11/27/2013 15:17'!
initialize

	classes := Dictionary new.! !

!KomitClass class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 11/21/2013 14:48'!
new

	self shouldNotImplement! !

!KomitClass class methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/21/2013 15:35'!
resetCache

	classes removeAll! !

!KomitClass class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 11/21/2013 14:48'!
trackedClass: trackedClass

	^ classes 
		at: trackedClass name
		ifAbsentPut: [ super new 
			trackedClass: trackedClass;
			yourself ]! !

!KomitClass class methodsFor: 'instance creation' stamp: 'NicolaiHess 4/8/2014 20:06'!
trackedClass: trackedClass forExtension: aCategory

	^ classes 
		at: trackedClass name, aCategory
		ifAbsentPut: [ super new 
			trackedClass: trackedClass;
			yourself ]! !

!KomitClassNode commentStamp: '<historical>'!
I am a node in the Komit tree representing a class!
!KomitClassNode methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/24/2013 14:22'!
getDefinitions

	^ self content definitions! !

!KomitClassNode methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 11/24/2013 21:28'!
initialize	
	super initialize.
	
	self whenSelectedChanged: [ :aBoolean |
		self parentNode ifNotNil: [ :parent | parent checkChildren ].
		self ifNotSilentDo: [
			aBoolean
				ifTrue: [ self selectAllChildren ]
				ifFalse: [ self unselectAllChildren ] ] ].
		
	self whenContentChanged: [ :c || childrenNode |
		self hasContentToShow: c isDirty.
		childrenNode := self getDefinitions 
			collect: [ :each | KomitDefinitionNode new
				content: each;
				yourself ].
			childrenNode addAll: (self getMethods
				collect: [ :each | KomitMethodNode new
					content: each;
					yourself ]).
		self children: [ childrenNode ] ]! !

!KomitClassNode methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/21/2013 21:41'!
label

	^ self content trackedClass! !

!KomitClassNode methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/24/2013 14:21'!
getMethods

	^ self content methods! !

!KomitClassNode methodsFor: 'printing' stamp: 'BenjaminVanRyseghem 11/21/2013 14:58'!
printOn: aStream

	super printOn: aStream.
	aStream << '[ '.
	self content trackedClass printOn: aStream.
	aStream << ' ]'.! !

!KomitClassNode methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/26/2013 15:40'!
icon
	
	self content added ifTrue: [ ^ self class addedClassIcon ].
	self content modified ifTrue: [ ^ self class modifiedClassIcon ].
	self content removed ifTrue: [ ^ self class deletedClassIcon ].
	
	^ self class defaultClassIcon! !

!KomitClassNode class methodsFor: 'icons' stamp: 'BenjaminVanRyseghem 11/26/2013 17:22'!
modifiedClassIcon

	^ modifiedClassIcon ifNil: [ 
		modifiedClassIcon :=  (self defaultClassIcon asFormOfDepth: 32)
			mergeBottomRightWith: (Form 
				fromBinaryStream: (Base64MimeConverter 
					mimeDecodeToBytes: Smalltalk ui icons overlayModificationIconContents readStream)) ].! !

!KomitClassNode class methodsFor: 'icons' stamp: 'BenjaminVanRyseghem 11/26/2013 17:22'!
deletedClassIcon

	^ deletedClassIcon ifNil: [ 
		deletedClassIcon :=  (self defaultClassIcon asFormOfDepth: 32)
			mergeBottomRightWith: (Form 
				fromBinaryStream: (Base64MimeConverter 
					mimeDecodeToBytes: Smalltalk ui icons overlayRemoveIconContents readStream))  ].! !

!KomitClassNode class methodsFor: 'icons' stamp: 'BenjaminVanRyseghem 11/26/2013 15:33'!
defaultClassIcon

	^ Smalltalk ui icons classIcon! !

!KomitClassNode class methodsFor: 'icons' stamp: 'BenjaminVanRyseghem 11/26/2013 17:22'!
addedClassIcon

	^ addedClassIcon ifNil: [
		addedClassIcon := (self defaultClassIcon asFormOfDepth: 32)
			mergeBottomRightWith: (Form 
				fromBinaryStream: (Base64MimeConverter 
					mimeDecodeToBytes: Smalltalk ui icons overlayAddIconContents readStream)) ].! !

!KomitDefinition commentStamp: '<historical>'!
Iam a komit object representing a change in a class definition!
!KomitDefinition methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 21:09'!
operation
	^ operation! !

!KomitDefinition methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 16:33'!
definition
	^ definition! !

!KomitDefinition methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/21/2013 22:06'!
koSourceText

	^ self operation koSourceText! !

!KomitDefinition methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/21/2013 17:50'!
operation: anOperation
 
	operation := anOperation! !

!KomitDefinition methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 16:32'!
definition: anObject
	
	definition := anObject! !

!KomitDefinition methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 11/21/2013 22:36'!
isDefinition

	^ true! !

!KomitDefinition methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 11/23/2013 21:36'!
isCommitable

	^ true! !

!KomitDefinition methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/21/2013 22:07'!
koDestinationText
	
	^ self operation koDestinationText! !

!KomitDefinition methodsFor: 'comparing' stamp: 'BenjaminVanRyseghem 11/24/2013 21:26'!
<= aKomitObject 

	^ self definition <= aKomitObject definition! !

!KomitDefinition class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 11/26/2013 14:28'!
definition: definition

	^ definitions
		at: definition className
		ifAbsentPut: [ 
			super new
				definition: definition;
				yourself ]! !

!KomitDefinition class methodsFor: 'class initialization' stamp: 'BenjaminVanRyseghem 11/26/2013 14:29'!
initialize

	definitions := Dictionary new! !

!KomitDefinition class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 11/26/2013 14:29'!
new

	self shouldNotImplement! !

!KomitDefinitionNode commentStamp: '<historical>'!
I am a node wrapping a KomitDefinition!
!KomitDefinitionNode methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/21/2013 15:31'!
label

	^ 'Class Definition'! !

!KomitDirectoryRemote commentStamp: '<historical>'!
I encapsulate a gemstone repository!
!KomitDirectoryRemote methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/30/2013 20:34'!
label
	
	^ self remote directory basename! !

!KomitDirectoryRemote class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/4/2013 10:16'!
icon

	^ 'DIR'! !

!KomitGemstoneRemote commentStamp: '<historical>'!
I encapsulate a gemstone repository!
!KomitGemstoneRemote methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/23/2013 13:24'!
label
	| url |
	url := self remote location splitOn: '/'.
	
	^ String streamContents: [ :stream | stream << (url at: 5) ]! !

!KomitGemstoneRemote class methodsFor: 'private-icons' stamp: 'BenjaminVanRyseghem 12/4/2013 09:54'!
iconContents

	^ #(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 79642688 0 0 0 0 0 0 0 0 0 0 0 0 181154611 2260611104 3871289375 4273942303 3804180256 1975529505 67065173 0 0 0 0 0 0 0 0 0 2579378208 3955175455 1992175648 1086271520 2512400417 4290653983 2277453600 0 0 0 0 0 0 0 0 1237332255 4290653983 1690251297 0 0 0 3351195424 3988664095 0 0 0 90596966 2154326120 3714541415 4133971815 3630655335 2053727846 784086828 50299008 0 0 0 3334418464 3720228639 0 0 0 2271635046 4184237670 2305189478 1667721063 3026609766 4284900966 2238212200 0 0 33554431 1354706976 4290653983 2411671584 0 0 0 3731252838 2875680615 0 0 0 3563480678 3882313575 0 2461937439 3837669407 4290653983 2646486816 114644267 0 0 0 3311822438 4050085735 1281910888 0 0 493513322 610953834 97268531 3351195424 4273942303 4257099551 1321283873 0 0 0 0 912812136 4016465510 4284900966 3412551527 1248290663 0 0 0 0 566310439 3586011167 4189990688 398997281 0 0 0 0 375941224 2288478055 4066797158 4284900966 2355521126 0 0 0 0 1824468769 4290653983 1404973346 0 325806955 1567123560 661219689 0 0 342255206 3816119900 4201145957 309424497 0 0 0 1371549471 4290653983 1153380642 0 577333609 4284900966 2187748966 0 0 0 3684320829 4284900966 1147758953 0 0 0 3049140256 4072615712 280965152 0 61516458 3563480678 4117128806 1550280551 443313260 1181116006 3714867809 4285358945 2864460580 935211808 801321249 2797482016 4290653983 1707094049 0 0 0 610953834 2607179366 3848693350 4284900966 4251412327 3395708518 2141536822 4005506847 4290653983 4290653983 3904778016 1488924960 0 0 0 0 0 0 0 627533671 174483046 0 0 67065173 600126244 549400608 0 0 0 0 0)! !

!KomitHttpRemote commentStamp: '<historical>'!
I encapsulate a gemstone repository!
!KomitHttpRemote methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/30/2013 22:23'!
label
	
	^ self remote location! !

!KomitHttpRemote class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/4/2013 10:01'!
icon

	^ 'HTTP'! !

!KomitLeaf commentStamp: '<historical>'!
I am an abstract class for tree leaves!
!KomitLeaf methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 11/24/2013 13:46'!
initialize

	super initialize.
	
	self children: [ #() ].
	self hasContentToShow: true.
	self whenSelectedChanged: [ :aBoolean | self parentNode ifNotNil: [ :parent | parent checkChildren ] ]! !

!KomitLeaf methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/24/2013 21:09'!
icon
	
	self content added ifTrue: [ ^ Smalltalk ui icons changeAddIcon ].
	self content modified ifTrue: [ ^ Smalltalk ui icons changeUpdateIcon ].
	self content removed ifTrue: [ ^ Smalltalk ui icons changeRemoveIcon ].
	
	^ nil! !

!KomitMethod commentStamp: '<historical>'!
Iam a komit object representing a change in a method!
!KomitMethod methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 21:09'!
operation
	^ operation! !

!KomitMethod methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 11/21/2013 22:36'!
isMethod

	^ true! !

!KomitMethod methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 14:24'!
method: anObject
	method := anObject! !

!KomitMethod methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 16:25'!
selector

	^ self method selector! !

!KomitMethod methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/21/2013 21:16'!
koSourceText
	
	^ self operation koSourceText! !

!KomitMethod methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/22/2013 12:45'!
printOn: aStream

	super printOn: aStream.
	aStream << '[ '.
	self method selector printOn: aStream.
	aStream << ' ]'.! !

!KomitMethod methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/21/2013 17:50'!
operation: anOperation

	operation := anOperation! !

!KomitMethod methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 14:24'!
method
	^ method! !

!KomitMethod methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 11/23/2013 21:36'!
isCommitable

	^ true! !

!KomitMethod methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/21/2013 21:10'!
koDestinationText
	^ operation koDestinationText! !

!KomitMethod methodsFor: 'comparing' stamp: 'BenjaminVanRyseghem 11/24/2013 21:26'!
<= aKomitObject 

	^ self method selector <= aKomitObject method selector! !

!KomitMethod class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 11/25/2013 18:18'!
method: aMethod
	
	^ methods 
		at: aMethod actualClass name, '>>', aMethod selector
		ifAbsentPut: [ 
			super new
				method: aMethod;
				yourself ]! !

!KomitMethod class methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 11/25/2013 18:19'!
initialize
	
	methods := Dictionary new! !

!KomitMethod class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 11/25/2013 18:18'!
new
	self shouldNotImplement! !

!KomitMethodNode commentStamp: '<historical>'!
I am a node in the Komit tree representing a method!
!KomitMethodNode methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/21/2013 15:31'!
label

	^ self content selector! !

!KomitNewSlice commentStamp: '<historical>'!
I am a dummy object used to commit code in a new slice!
!KomitNewSlice methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/23/2013 13:27'!
label

	^ 'New Slice'! !

!KomitNewSlice methodsFor: 'accessing' stamp: 'NicolaiHess 6/12/2014 14:09'!
remote
	
	^ MCRepositoryGroup default repositories 
		detect: [ :e | e description = 'http://smalltalkhub.com/mc/Pharo/Pharo40Inbox/main/' ]
		ifNone: [ MCRepositoryGroup default repositories detect: [ :e | e description = 'http://smalltalkhub.com/mc/Pharo/Pharo40Inbox/main' ] ]! !

!KomitNewSlice methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/26/2013 21:28'!
komitOn: aKomitterUI

	^ aKomitterUI newSliceFor: self! !

!KomitNewSlice class methodsFor: 'private-icons' stamp: 'BenjaminVanRyseghem 12/4/2013 10:14'!
iconContents

	^ #(16777215 16777215 16777215 16777215 16777215 16777215 16777215 878481328 810847151 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777471 2675025349 4104046044 4273657575 4291485933 4273066469 3699684559 3027544004 2204605626 16777215 16777215 16777215 16777215 16777215 16777215 640645537 3160776898 4291354861 4291551726 3716264913 1012173739 16842751 16777215 16777215 978750380 2791414974 945196721 16777215 16777215 16777215 575769519 3329075401 4291289326 4290697962 2422513602 16777215 16777215 16777215 16777215 2320916567 3293601369 1147495763 3261834695 591956145 16777215 87254681 2574034116 4290304235 4290829548 2909316038 16777215 16777215 16777215 16777215 16777215 3555413791 4293216286 1559121695 222005936 3177291716 16842751 1110802091 4069573343 4290304235 4136681693 16842751 16777215 16777215 16777215 16777215 848892954 4288287511 4288352789 3349352981 16777215 2203227323 1951108536 1428453544 4288531431 4289713129 2674238409 16777215 16777215 16777215 16777215 127018020 1905009714 4287374383 4287439661 3381535020 831332138 103514282 2032959408 2435022259 4280453833 4282291914 826181037 16777215 16777215 16777215 16777215 16777215 2222863945 4286460999 4286526278 3699388996 394603587 16777215 1345290158 2770699192 4280388554 4279993794 253917098 16777215 16777215 16777215 16777215 16777215 745424483 4050666847 2473673822 325796689 16777215 16777215 1630043569 2804254141 4280388553 4279993794 388067238 16777215 16777215 16777215 16777215 16777215 1415665785 1063343477 426136186 2623886196 16777215 16777215 1176598699 2217050553 4263742667 4279861952 1596030389 16777215 16777215 16777215 16777215 16777215 190668194 2119525776 4065748366 3109512589 16777215 87254681 891452845 1277526197 3643182280 4279861952 3709699264 16777215 16777215 16777215 16777215 16777215 2353363113 3947329448 1766421925 71336127 87254681 404780458 50353578 16777215 2166720189 4279993539 4279598522 1981644726 16777215 16777215 16777215 16777215 2386069696 272662719 557222849 2788788160 1496416955 270565551 16777215 16777215 354711978 3877800390 4279466936 4229135544 924875698 16777215 16777215 16777215 959224536 2821429464 4213937877 3878195147 1646691773 16777215 16777215 16777215 16777215 321419694 3189736897 4279335349 4262557877 3374088124 1898086840 1579517631 4213805262 4179593413 3961752264 1294172342 16842751 16777215 16777215 16777215 16777215 16777215 16777215 908099249 3004989113 3726147258 4145380537 4145709502 3843784892 2552266682 757235120 16777215 16777215 16777215 16777215)! !

!KomitNode commentStamp: '<historical>'!
I am an abstract class representing a node in the tree!
!KomitNode methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 3/14/2014 12:11'!
initialize

	silent := false.
	super initialize.
	
	self whenSelectedChanged: [ :aBoolean | self content selected: aBoolean ].
	self whenIsExpandedChanged: [ :aBoolean | self content expanded: aBoolean ].
	
	self whenContentChanged: [ :c |
		self silentWhile: [ self selected: c selected ].
		self isExpanded: c expanded ].

	self hasChildren: [ self children value isEmptyOrNil not ]! !

!KomitNode methodsFor: 'comparing' stamp: 'BenjaminVanRyseghem 12/7/2013 10:51'!
hash

	^ self content hash! !

!KomitNode methodsFor: 'comparing' stamp: 'BenjaminVanRyseghem 11/25/2013 16:49'!
= anotherNode

	^ self species = anotherNode species
		and: [ self content = anotherNode content ]! !

!KomitNode methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/24/2013 20:36'!
label

	self subclassResponsibility! !

!KomitNode methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/22/2013 13:30'!
checkChildren
	
	self silentWhile: [
		(self children value allSatisfy: [ :e | e selected ])
			ifTrue: [ self selected: true ]
			ifFalse: [ self selected: false ] ]! !

!KomitNode methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/24/2013 14:11'!
ifNotSilentDo: aBlock

	silent ifFalse: aBlock! !

!KomitNode methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/22/2013 13:30'!
silentWhile: aBlock
	| oldSilent |
	
	oldSilent := silent.
	silent := true.
	aBlock value.
	silent := oldSilent! !

!KomitNode methodsFor: 'comparing' stamp: 'BenjaminVanRyseghem 11/24/2013 21:25'!
<= aKomitNode 

	^ self content <= aKomitNode content! !

!KomitNode methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/24/2013 20:37'!
icon

	self subclassResponsibility! !

!KomitObject commentStamp: '<historical>'!
I am an abstract super class keeping track of the state of the object (added/modified/removed)!
!KomitObject methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 11/21/2013 22:35'!
isMethod

	^ false! !

!KomitObject methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 14:24'!
added: anObject
	added := anObject! !

!KomitObject methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/24/2013 13:17'!
selected: anObject
	selected := anObject! !

!KomitObject methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 11/23/2013 21:35'!
isCommitable

	^ false! !

!KomitObject methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 11/21/2013 22:35'!
isPackage

	^ false! !

!KomitObject methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 14:24'!
removed: anObject
	removed := anObject! !

!KomitObject methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 12/7/2013 10:56'!
isKomitClass

	^ false! !

!KomitObject methodsFor: 'initialize' stamp: 'BenjaminVanRyseghem 11/26/2013 14:27'!
initialize

	super initialize.

	added := false.
	modified := false.
	removed := false.
	
	selected := true.
	expanded := false! !

!KomitObject methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/24/2013 13:40'!
expanded
	^ expanded! !

!KomitObject methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 14:24'!
modified: anObject
	modified := anObject! !

!KomitObject methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 14:24'!
added
	^ added! !

!KomitObject methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 11/21/2013 22:35'!
isDefinition

	^ false! !

!KomitObject methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 14:24'!
modified
	^ modified! !

!KomitObject methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/24/2013 13:40'!
expanded: anObject
	expanded := anObject! !

!KomitObject methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/27/2013 13:46'!
flush
	
	added := false.
	modified := false.
	removed := false.! !

!KomitObject methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 14:24'!
removed
	^ removed! !

!KomitObject methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 11/21/2013 21:46'!
isDirty

	^ self added or: [ self modified or: [ self removed ] ]! !

!KomitObject methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/24/2013 13:17'!
selected
	^ selected! !

!KomitObject methodsFor: 'comparing' stamp: 'BenjaminVanRyseghem 11/24/2013 21:25'!
<= aKomitObject 

	^ self subclassResponsibility! !

!KomitPackage commentStamp: '<historical>'!
I am a simple object used to cache the patch in order to save a bit of time!
!KomitPackage methodsFor: 'comparing' stamp: 'BenjaminVanRyseghem 12/7/2013 10:51'!
hash

	^ self package hash! !

!KomitPackage methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 11/22/2013 16:48'!
isEmpty

	^ self package isEmpty! !

!KomitPackage methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/27/2013 16:50'!
isFullyCommited
	^ isFullyCommited! !

!KomitPackage methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/22/2013 16:14'!
remotes

	^ self package remotes! !

!KomitPackage methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 11/21/2013 22:36'!
isPackage

	^ true! !

!KomitPackage methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/27/2013 16:32'!
classes

	^ classes ifNil: [ | result p |
		p := self patch.
		p
			ifNil: [ #() ] 
			ifNotNil: [ 
				result := p operations 
					collect: [ :each | each koClass ]
					thenSelect: [ :each | each notNil ].
				classes := result asSet asOrderedCollection ] ]! !

!KomitPackage methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/21/2013 22:26'!
koDestinationText
	^ ''! !

!KomitPackage methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/26/2013 10:22'!
koSourceText
	^ 'No changes'! !

!KomitPackage methodsFor: 'initialize' stamp: 'BenjaminVanRyseghem 12/9/2013 18:19'!
initialize

	super initialize.

	expanded := true.
	isFullyCommited := true.! !

!KomitPackage methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/27/2013 16:50'!
isFullyCommited: anObject
	isFullyCommited := anObject! !

!KomitPackage methodsFor: 'comparing' stamp: 'BenjaminVanRyseghem 11/24/2013 19:55'!
= another

	^ self species = another species and: [ self package = another package ]! !

!KomitPackage methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/27/2013 16:24'!
package: aPackage

	package := aPackage.
	self retrievePatch! !

!KomitPackage methodsFor: 'printing' stamp: 'BenjaminVanRyseghem 11/21/2013 14:13'!
printOn: aStream

	super printOn: aStream.
	aStream << '[ '.
	self package name printOn: aStream.
	aStream << ' ]'.! !

!KomitPackage methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 14:01'!
package
	^ package! !

!KomitPackage methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/9/2013 18:29'!
retrievePatch
	
	dataRetriever ifNotNil: [ dataRetriever release ].
	dataRetriever := DataRetriever for: [ self package patch ].! !

!KomitPackage methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 12/9/2013 18:20'!
flush
	super flush.
	
	classes ifNotNil: [ classes do: [ :each | each flush ] ].
	classes := nil.
	isFullyCommited := true.
	self retrievePatch! !

!KomitPackage methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/9/2013 18:29'!
patch
	
	^ dataRetriever data! !

!KomitPackage methodsFor: 'comparing' stamp: 'BenjaminVanRyseghem 11/24/2013 21:27'!
<= aKomitObject 

	^ self package name <= aKomitObject package name! !

!KomitPackage class methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 11/25/2013 17:34'!
initialize

	packages := Dictionary new! !

!KomitPackage class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 11/27/2013 13:42'!
removePackage: package

	(packages 
		removeKey: package package name
		ifAbsent: [ ^ self ]) flush! !

!KomitPackage class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 11/25/2013 17:36'!
new

	self shouldNotImplement! !

!KomitPackage class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 11/25/2013 17:35'!
package: package

	^ packages 
		at: package name 
		ifAbsentPut: [
			super new
				package: package;
				yourself ]! !

!KomitPackageNode commentStamp: '<historical>'!
I am a node in the Komit tree representing a package!
!KomitPackageNode methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 3/14/2014 12:06'!
initialize

	super initialize.
	
	self icon: Smalltalk ui icons dirtyPackageIcon.
	self whenSelectedChanged: [ :aBoolean |
		self ifNotSilentDo: [
			aBoolean
				ifTrue: [ self selectAllChildren ]
				ifFalse: [ self unselectAllChildren ] ] ].
		
	self whenContentChanged: [ :c || childrenNode |
		childrenNode := self getClasses 
			collect: [ :each | KomitClassNode new
				content: each;
				yourself ].
		self children: [ childrenNode ] ].
	
	self hasChildren: [ self isEmpty not ]! !

!KomitPackageNode methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/24/2013 14:17'!
getClasses

	^ self content classes! !

!KomitPackageNode methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/24/2013 21:06'!
label

	^ self content package name! !

!KomitPackageNode methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 11/21/2013 15:55'!
isEmpty

	^ self content patch operations isEmpty! !

!KomitPackageNode methodsFor: 'printing' stamp: 'BenjaminVanRyseghem 11/21/2013 14:13'!
printOn: aStream

	super printOn: aStream.
	aStream << '[ '.
	self content package name printOn: aStream.
	aStream << ' ]'.! !

!KomitPackageNode methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/26/2013 15:41'!
icon

	^ Smalltalk ui icons dirtyPackageIcon! !

!KomitPatch commentStamp: '<historical>'!
I am a simple wrapper for patches!
!KomitPatch methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/26/2013 12:58'!
operations

	^ patch operations! !

!KomitPatch methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/26/2013 12:51'!
base: anObject
	base := anObject! !

!KomitPatch methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/26/2013 13:40'!
base
	^ base ifNil: [ MCSnapshot empty ]! !

!KomitPatch methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/26/2013 12:51'!
patch: anObject
	patch := anObject! !

!KomitPatch methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/26/2013 12:51'!
patch
	^ patch! !

!KomitPatch class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 11/26/2013 12:51'!
base: base patch: patch

	^ self new
		base: base;
		patch: patch;
		yourself! !

!KomitRemote commentStamp: '<historical>'!
I am an abstract class representing a remote repository!
!KomitRemote methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 12/4/2013 09:59'!
icon

	^ self class icon! !

!KomitRemote methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 12/4/2013 13:04'!
password: aString

	self remote password: aString! !

!KomitRemote methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/23/2013 11:58'!
remote: anObject
	remote := anObject! !

!KomitRemote methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/23/2013 12:05'!
label

	^ ''! !

!KomitRemote methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 12/4/2013 13:04'!
username: aString 
	
	self remote user: aString! !

!KomitRemote methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/23/2013 11:58'!
remote
	^ remote! !

!KomitRemote methodsFor: 'as yet unclassified ' stamp: 'BenjaminVanRyseghem 12/4/2013 12:58'!
password
	
	^ self remote password! !

!KomitRemote methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 12/4/2013 12:59'!
username
	
	^ self remote user! !

!KomitRemote methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/26/2013 21:28'!
komitOn: aKomitterUI

	^ aKomitterUI newKomitFor: self! !

!KomitRemote class methodsFor: 'private-icons' stamp: 'BenjaminVanRyseghem 12/4/2013 10:59'!
iconContents

	^ nil! !

!KomitRemote class methodsFor: 'icon' stamp: 'BenjaminVanRyseghem 12/4/2013 09:53'!
icon
	self == KomitRemote ifTrue: [ ^ nil ].

	^ icon ifNil: [ icon := Pharo3UIThemeIcons form16x16FromContents: self iconContents ]! !

!KomitSliceUI commentStamp: '<historical>'!
I am a UI used to retrieve a Slice title using its issue number!
!KomitSliceUI methodsFor: 'initialization' stamp: 'EstebanLorenzano 4/2/2015 11:32'!
initializeWidgets

	issueNumber := self newTextInput.
	titleWidget := self newTextInput.
	loadingWidget := self instantiate: LoadingThenOk.

	titleWidget
		enabled: false;
		ghostText: 'Title'.
		
	issueNumber ghostText: 'Issue number'.

	issueNumber 
		autoAccept: true;
		acceptBlock: [ :text |
			fork ifNotNil: [ fork terminate ].
			loadingWidget loading.
			self valid: false.
			fork := [ | response |
				response := ZnEasy client
				url: 'http://tracker.pharo.org/issues/name/', text asString;
				get;
				response.
				self setTitleFrom: response ] fork ].
	self focusOrder
		add: issueNumber! !

!KomitSliceUI methodsFor: 'initialization' stamp: 'DamienCassou 12/9/2013 14:31'!
initializeDialogWindow: aWindow

	valid whenChangedDo: [ :b | aWindow toolbar okButton enabled: b ].
	aWindow toolbar okButton enabled: false.
	issueNumber 
		bindKeyCombination: Character cr control unix | $m control mac
		toAction: [ self valid ifTrue: [ aWindow triggerOkAction ] ]! !

!KomitSliceUI methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/26/2013 23:16'!
valid: aBoolean

	valid value: aBoolean! !

!KomitSliceUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/26/2013 22:51'!
titleWidget
	^ titleWidget! !

!KomitSliceUI methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 1/24/2014 16:07'!
initialize

	super initialize.

	valid := false asValueHolder! !

!KomitSliceUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/26/2013 22:51'!
issueNumber
	^ issueNumber! !

!KomitSliceUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/26/2013 22:51'!
loadingWidget
	^ loadingWidget! !

!KomitSliceUI methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/27/2013 00:10'!
title

	^ 'Retrieve Slice title'! !

!KomitSliceUI methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/27/2013 13:05'!
issueNumberText

	^ issueNumber text! !

!KomitSliceUI methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 11/26/2013 22:59'!
encodeTitle: aTitle
	| allowedCharacters |
	
	allowedCharacters := ($A to: $Z)
				, ($a to: $z)
				, ($0 to: $9)
				, (Array with: $-).
	^ String streamContents: [ :stream | 			
		aTitle
			do: [ :character | (' 	_' includes: character)
				ifTrue: [ stream << '-' ]
				ifFalse: [ (allowedCharacters includes: character)
						ifTrue: [ stream << character ] ] ] ]! !

!KomitSliceUI methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/26/2013 23:16'!
valid

	^ valid value! !

!KomitSliceUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/26/2013 23:44'!
setTitleFrom: aZnResponse

	aZnResponse isError
		ifTrue: [ 
			titleWidget text: 'Error !!'.
			loadingWidget error ]
		ifFalse: [ 
			titleWidget text: (self encodeTitle: aZnResponse entity string).
			self valid: true.
			loadingWidget ok ]! !

!KomitSliceUI methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/27/2013 13:06'!
titleText

	^ titleWidget text! !

!KomitSliceUI methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/26/2013 23:45'!
initialExtent

	^ 600@100! !

!KomitSliceUI class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 11/27/2013 12:50'!
defaultSpec
	<spec: #default>
	
	^ SpecLayout composed
		newColumn: [ :col |
			col
				newRow: [ :row |
					row
						add: #loadingWidget width: self inputTextHeight;
						add: #issueNumber width: 90;
						add: #titleWidget ] height: self inputTextHeight;
				newRow: [ :row | ] ];
		yourself! !

!KomitSmalltalkhubRemote commentStamp: '<historical>'!
I encapsulate a repository stored on smalltalkhub!
!KomitSmalltalkhubRemote methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/23/2013 13:02'!
label
	| url |
	url := self remote location splitOn: '/'.
	
	^ String streamContents: [ :stream | stream << (url at: 6) << ' / ' << (url at: 5) ]! !

!KomitSmalltalkhubRemote class methodsFor: 'private-icons' stamp: 'BenjaminVanRyseghem 12/4/2013 10:14'!
iconContents

	^ #(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1337895822 3032592019 3972116374 4273842831 4022184072 3149833600 2106947668 50331392 0 0 0 0 531995755 2444926324 3686507133 4240221573 4290488201 4290685839 4290751632 4289698684 4288645481 4288578915 4289433963 4256536684 3837236839 2763494759 1018927462 0 3483597388 3937110112 4223245688 4290290046 4289895290 4288711276 4288974446 4289763703 4290421119 4290223480 4290288499 4290287725 4222324583 4068371018 4100083764 0 3533994827 4121066061 4121066060 4153109577 4170282839 4240286852 4290421118 4290684289 4290618237 4239431797 4102649431 4219235923 4284698929 4284830516 4116466476 0 3483729487 4189625722 4154884950 4154620491 4137777226 4104091212 4070144090 4070739057 4218775116 4284567861 4287661166 4290688939 4286147148 4285027894 3932180015 0 3399975248 4276543704 4241737137 4240945814 4189098089 4137909582 4086787651 4068962130 4284041774 4284896566 4291412920 4293453796 4290162076 4285225272 3646901294 0 3316154448 4276543446 4239429735 4258711991 4240682642 4259700438 4104090952 4068633164 4284567603 4285488704 4293454052 4293651176 4287660134 4285159478 3462286637 0 3232466517 4293123279 4256799860 4275555516 4222190677 4276280532 4137776970 4018498635 4284830771 4285356857 4292202696 4290490527 4288713597 4285093686 3361623341 0 3348789069 4276017097 4273907073 4275621052 4239034200 4276280532 4154620491 4018761292 4285027637 4285751100 4290293146 4293255900 4286737999 4285028150 3277473834 0 3281418061 4291871661 4292529854 4275489465 4239100249 4276280531 4154752591 4018761547 4285356600 4286014015 4292400332 4289568906 4290886575 4285028150 3377611305 33554432 3281088585 4289497949 4290156907 4275555513 4274763934 4293123540 4205149777 4102516555 4285553979 4285816891 4290161561 4293585125 4286673494 4284764980 3377216551 134217728 2204585011 4187519313 4289563743 4290222449 4289761381 4290882447 4272127057 4269827653 4285553979 4286870097 4293519588 4287265888 4285027896 4182851883 2134388254 33554432 335544320 1056964608 3075752747 4170281545 4289168469 4288905041 4288575564 4286473282 4285816895 4288120942 4287660391 4150086703 2804688407 1006632960 301989888 0 0 100663296 419430400 1124073472 2604346396 4035142719 4271666505 4269104443 4285291066 4015408939 2350848015 1006632960 369098752 67108864 0 0 0 0 0 67108864 335544320 973078528 2049318161 3243130149 1829768199 855638016 268435456 67108864 0 0 0)! !

!KomitSqueakSourceRemote commentStamp: '<historical>'!
I encapsulate a repository stored on squeaksource!
!KomitSqueakSourceRemote methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/23/2013 13:18'!
label
	| url |
	url := self remote location splitOn: '/'.
	
	^ String streamContents: [ :stream | stream << (url at: 4) ]! !

!KomitSqueakSourceRemote class methodsFor: 'private-icons' stamp: 'BenjaminVanRyseghem 12/4/2013 09:59'!
iconContents

	^ #(0 0 0 0 660364380 2203934045 3076283484 3931987293 3931987293 3076283484 2203934045 660364380 0 0 0 0 0 0 41975936 1968987228 4167065437 4286082392 4286936149 4287658835 4287658835 4286936149 4286082392 4167065437 1968987228 41975936 0 0 0 41975936 3109837916 4285228378 4287593043 4291076186 4291667804 4292127581 4292127837 4291667547 4291075931 4287593043 4285228378 3093126493 41975936 0 0 1968987228 4285228378 4271275346 4292062301 4293442400 4293381010 4292462761 4292397224 4293381010 4293507938 4292127837 4271275346 4285228378 1968987228 0 660364380 4167065437 4285883460 4283909670 4289762912 4294102666 4293774990 4293840784 4293840528 4293774991 4294037386 4290091618 4283778341 4286014789 4167065437 660364380 2220711261 4286082392 4286736698 4292524663 4286278471 4292591497 4294104990 4294104734 4294038942 4294104989 4292657289 4286804044 4292984698 4286473784 4286082392 2203934045 3076283484 4289039195 4289366087 4290749037 4293578128 4288712299 4294104995 4294104995 4294104995 4294104995 4288778091 4293577873 4290880621 4289300551 4289039195 3076283484 3931987293 4290945116 4292918906 4287461972 4294104477 4293776288 4284832325 4291671690 4292395154 4284634947 4293184153 4294104222 4287527764 4292853371 4290945115 3931987293 3931987293 4291273566 4294036614 4289829483 4294104737 4292263568 4280427042 4287857765 4289238385 4280887593 4290750848 4294038944 4289829228 4294036869 4291339356 3931987293 3076283484 4289762398 4292261495 4289434727 4286936408 4287397215 4287528544 4292460946 4292263568 4288843885 4289830520 4288580969 4290749812 4293510785 4289762398 3076283484 2203934045 4287791196 4288381524 4286015047 4285884492 4284108861 4285161032 4285884495 4284569153 4285095495 4283845946 4284897858 4286015303 4287264076 4287791196 2203934045 660364380 4167196765 4288709192 4291078000 4286278732 4290487932 4291408776 4294104995 4294104995 4289896312 4288580457 4285817928 4289434209 4288051780 4167197021 660364380 0 1968987228 4286280028 4277193860 4294037644 4294103702 4294038685 4294104993 4294170273 4294104221 4294038422 4294037389 4277259651 4286280029 1968987228 0 0 41975936 3109837916 4286411357 4292853630 4294037129 4294037902 4294103699 4294103186 4294103439 4294102922 4292853374 4286411357 3093126493 41975936 0 0 0 41975936 1968987228 4167262557 4288645727 4291079032 4293050753 4293051009 4291144311 4288645727 4167262557 1968987228 41975936 0 0 0 0 0 0 660364380 2203934045 3076283484 3931987293 3931987293 3076283484 2203934045 660364380 0 0 0 0)! !

!KomitStagingArea commentStamp: '<historical>'!
I encapsulate the context just before a commit.!
!KomitStagingArea methodsFor: 'initialize' stamp: 'BenjaminVanRyseghem 11/22/2013 16:30'!
initialize

	super initialize.

	packages := OrderedCollection new.! !

!KomitStagingArea methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/24/2013 19:58'!
isCurrent

	^ self == self class current! !

!KomitStagingArea methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/23/2013 23:34'!
remotesFor: aCollection
	| result |
	
	result := aCollection first remotes.
	aCollection allButFirst do: [ :each |
		result := result intersection: each remotes ].
	
	^ result collect: [ :each | each koRemote ]! !

!KomitStagingArea methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/23/2013 21:00'!
remotes
	| result |
	
	result := packages first remotes.
	packages allButFirst do: [ :each |
		result := result intersection: each remotes ].
	
	^ result collect: [ :each | each koRemote ]! !

!KomitStagingArea methodsFor: 'adding/removing' stamp: 'BenjaminVanRyseghem 11/26/2013 10:29'!
removePackage: aKomitPackage

	self packages 	
		remove: aKomitPackage! !

!KomitStagingArea methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/24/2013 14:19'!
packages

	^ packages copy! !

!KomitStagingArea methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/24/2013 19:45'!
packages: aCollection

	packages := aCollection asOrderedCollection! !

!KomitStagingArea methodsFor: 'adding/removing' stamp: 'BenjaminVanRyseghem 11/24/2013 19:45'!
addPackage: aPackage

	(packages includes: aPackage)
		ifFalse: [ packages add: aPackage ]! !

!KomitStagingArea class methodsFor: 'instance creation' stamp: 'ChristopheDemarey 1/9/2014 15:05'!
currentFilteredBy: aFilterBlock

	^ current ifNil: [ 
		| dirtyPackages |
		
		dirtyPackages := MCWorkingCopy allManagers 
			select: [ :workingCopy | workingCopy needsSaving and: (aFilterBlock cull: workingCopy) ] 
			thenCollect: [ :workingCopy | 
				(KomitPackage package: workingCopy package)
					flush;
					yourself ].
		
		current := super new
			packages: dirtyPackages;
			yourself ]! !

!KomitStagingArea class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 11/25/2013 17:38'!
new

	self shouldNotImplement! !

!KomitStagingArea class methodsFor: 'instance creation' stamp: 'ChristopheDemarey 1/9/2014 15:05'!
current

	^ self currentFilteredBy: [ true ]! !

!KomitStagingArea class methodsFor: 'release' stamp: 'BenjaminVanRyseghem 11/24/2013 19:58'!
resetCurrent

	current := nil! !

!KomitTreeBuilder commentStamp: '<historical>'!
I am builder class used to generate the tree nodes for a package or for all the dirty packages!
!KomitTreeBuilder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/23/2013 11:55'!
buildRootForPackage: aPackage

	^ KomitPackageNode new
		content: aPackage;
		yourself! !

!KomitTreeBuilder class methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/25/2013 17:53'!
rootsForStagingArea: aStagingArea

	^ aStagingArea packages 
		collect: [ :each | self buildRootForPackage: each ]
		thenSelect: [:each | each isEmpty not ]! !

!KomitTreeBuilder class methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/22/2013 16:48'!
buildRootForPackage: aKOPackage

	^ self new
		buildRootForPackage: aKOPackage! !

!KomitableObject commentStamp: '<historical>'!
I represent any commitable object, mainly a simple commit or a slice!
!KomitableObject methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/26/2013 20:29'!
timestamp: anObject
	timestamp := anObject! !

!KomitableObject methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/27/2013 13:02'!
commitToMonticello

	Komitter resetLastMessage.
	KomitStagingArea resetCurrent.

	MCKomitSubmitter new
		submitCommit: self! !

!KomitableObject methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/26/2013 20:29'!
remote: anObject
	remote := anObject! !

!KomitableObject methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/26/2013 20:29'!
message: anObject
	message := anObject! !

!KomitableObject methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/26/2013 21:08'!
repository
	
	^ self remote remote! !

!KomitableObject methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/26/2013 20:29'!
author: anObject
	author := anObject! !

!KomitableObject methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/26/2013 20:29'!
entities
	^ entities! !

!KomitableObject methodsFor: 'initialize' stamp: 'BenjaminVanRyseghem 11/26/2013 20:29'!
initialize

	super initialize.

	author := Author fullName.
	
	entities := Dictionary new.
	unselectedEntities := Dictionary new.
	
	message := ''.
	timestamp := DateAndTime now.! !

!KomitableObject methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/26/2013 20:29'!
entities: aDictionary

	entities := aDictionary! !

!KomitableObject methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/26/2013 20:29'!
unselectedEntities: anObject
	unselectedEntities := anObject! !

!KomitableObject methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/26/2013 20:29'!
author
	^ author! !

!KomitableObject methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/26/2013 20:29'!
timestamp
	^ timestamp! !

!KomitableObject methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/26/2013 20:29'!
message
	^ message! !

!KomitableObject methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/26/2013 20:29'!
remote
	^ remote! !

!KomitableObject methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/26/2013 20:29'!
unselectedEntities
	^ unselectedEntities! !

!Komitter commentStamp: '<historical>'!
I am the entry point of this project.

A classic inkoation is

| s k |

s := KomitStagingArea forDirtyPackages.
k := Komitter new.
k stagingArea: s.
k open.

k lastCommit  !
!Komitter methodsFor: 'announcement' stamp: 'BenjaminVanRyseghem 11/25/2013 17:15'!
classMoved: anAnnouncement
	self stagingArea isCurrent ifFalse: [ ^ self ].! !

!Komitter methodsFor: 'opening' stamp: 'BenjaminVanRyseghem 12/4/2013 17:06'!
openAndDo: aBlock
	
	self stagingArea packages
		ifEmpty: [ ^ self inform: 'No changes to commit' ].

	view ifNil: [ view := KomitterUI new
		model: self;
		yourself ].
	
	view openDialogWithSpec
		okAction: [ | valid |
			valid := view validate.
			valid ifTrue: [ self lastCommit: view komit ].
			aBlock value.
			valid ];
		cancelAction: [ 
			self lastCommit: nil.
			view cancel ];
		centered! !

!Komitter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/24/2013 19:27'!
remotesFor: aCollection

	^ (self stagingArea remotesFor: aCollection) asOrderedCollection
		add: self newSlice;
		yourself! !

!Komitter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/23/2013 20:53'!
remotes

	^ self stagingArea remotes asOrderedCollection
		add: self newSlice;
		yourself! !

!Komitter methodsFor: 'announcement' stamp: 'BenjaminVanRyseghem 11/25/2013 17:15'!
methodMoved: anAnnouncement
	self stagingArea isCurrent ifFalse: [ ^ self ].! !

!Komitter methodsFor: 'opening' stamp: 'BenjaminVanRyseghem 12/4/2013 17:06'!
openAndCommitToMonticello

	self openAndDo: [ self lastCommit ifNotNil: [ self lastCommit commitToMonticello ]]! !

!Komitter methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/23/2013 20:53'!
newSlice

	^ KomitNewSlice new! !

!Komitter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/23/2013 20:35'!
stagingArea: anObject

	stagingArea value: anObject! !

!Komitter methodsFor: 'announcement' stamp: 'BenjaminVanRyseghem 11/25/2013 17:15'!
methodRemoved: anAnnouncement
	self stagingArea isCurrent ifFalse: [ ^ self ].! !

!Komitter methodsFor: 'initialize' stamp: 'BenjaminVanRyseghem 1/24/2014 16:07'!
initialize

	super initialize.

	stagingArea := nil asValueHolder.
	lastCommit := nil asValueHolder.
	
	"self registerToAnnouncements"! !

!Komitter methodsFor: 'announcement' stamp: 'BenjaminVanRyseghem 11/25/2013 17:15'!
methodModified: anAnnouncement	
	self stagingArea isCurrent ifFalse: [ ^ self ].! !

!Komitter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/27/2013 13:00'!
lastMessage

	^ self class lastMessage! !

!Komitter methodsFor: 'announcement' stamp: 'BenjaminVanRyseghem 11/25/2013 17:15'!
classRemoved: anAnnouncement
	self stagingArea isCurrent ifFalse: [ ^ self ].! !

!Komitter methodsFor: 'announcement' stamp: 'BernardoContreras 10/9/2014 19:36'!
registerToAnnouncements

	SystemAnnouncer uniqueInstance weak	
		when: MCPackageModified send: #mcPackageModified: to: self;
		when: ClassAdded, ClassModifiedClassDefinition, ClassRenamed, ClassCommented send: #classModified: to: self;
		when: ClassRepackaged send: #classMoved: to: self;
		when: ClassRemoved send: #classRemoved: to: self;
		when: MethodAdded, MethodModified, MethodRecategorized send: #methodModified: to: self;
		when: MethodRepackaged send: #methodMoved: to: self;
		when: MethodRemoved send: #methodRemoved: to: self! !

!Komitter methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/23/2013 22:10'!
lastCommit

	^ lastCommit value! !

!Komitter methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/23/2013 22:10'!
lastCommit: aKomit

	lastCommit value: aKomit! !

!Komitter methodsFor: 'announcement' stamp: 'BenjaminVanRyseghem 11/25/2013 16:45'!
mcPackageModified: anAnnoucement
	| package |
	self stagingArea isCurrent ifFalse: [ ^ self ].
	
	package := anAnnoucement package koPackage.
	
	package patch isEmpty
		ifTrue: [ self stagingArea removePackage: package ]
		ifFalse: [ self stagingArea addPackage: package ].
	
	view ifNil: [ ^ self ].
	
	package patch isEmpty
		ifTrue: [ view removeRoot: package ]
		ifFalse: [ view addRoot: package ]! !

!Komitter methodsFor: 'announcement' stamp: 'BenjaminVanRyseghem 11/25/2013 17:15'!
classModified: anAnnouncement
	self stagingArea isCurrent ifFalse: [ ^ self ].! !

!Komitter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/4/2013 17:57'!
stagingArea

	^ stagingArea value ! !

!Komitter class methodsFor: 'icon' stamp: 'EstebanLorenzano 12/13/2013 14:45'!
taskbarIcon

	^ Smalltalk ui icons komitterIcon! !

!Komitter class methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/27/2013 12:59'!
lastMessage: aString

	lastMessage := aString! !

!Komitter class methodsFor: 'world menu' stamp: 'BenjaminVanRyseghem 12/4/2013 18:14'!
initialize

	World 
	bindKeyCombination: $k command
	toAction: [ self openAndCommitToMonticello ]! !

!Komitter class methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/27/2013 12:59'!
lastMessage

	^ lastMessage ifNil: [ MCSaveVersionDialog previousMessages first ]! !

!Komitter class methodsFor: 'protocol' stamp: 'ChristopheDemarey 1/9/2014 15:23'!
openAndCommitToMonticelloWorkingCopiesFilteredBy: aFilterBlock
	| stagingArea |

	KomitStagingArea resetCurrent.
	stagingArea := KomitStagingArea currentFilteredBy: aFilterBlock.
	^ self new
		stagingArea: stagingArea;
		openAndCommitToMonticello;
		yourself! !

!Komitter class methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 12/4/2013 18:13'!
openAndCommitToMonticello

	KomitStagingArea resetCurrent.
	^ self new
		stagingArea: KomitStagingArea current;
		openAndCommitToMonticello;
		yourself! !

!Komitter class methodsFor: 'world menu' stamp: 'TorstenBergmann 2/12/2014 09:24'!
komitterMenuOn: aBuilder
	<worldMenu>
	
	(aBuilder item: #Komitter)
		action: [ self openAndCommitToMonticello ];
		order: 0.29;
		parent: #Tools;
		help: 'Cherry pick what you commit';
		icon: self taskbarIcon.
	aBuilder withSeparatorAfter.	! !

!Komitter class methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/27/2013 12:59'!
resetLastMessage

	lastMessage := nil! !

!KomitterManager commentStamp: '<historical>'!
I am used to temporarily store a version for a package while a cherry-picked slice is committed!
!KomitterManager methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 12/6/2013 21:18'!
reset

	versions := Dictionary new! !

!KomitterManager methodsFor: 'initialize' stamp: 'BenjaminVanRyseghem 12/6/2013 21:17'!
initialize

	super initialize.

	versions := Dictionary new.! !

!KomitterManager methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 12/6/2013 21:16'!
versionFor: aPackage

	^ versions 
		at: aPackage! !

!KomitterManager methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 12/6/2013 21:16'!
storeVersion: aVersion for: aPackage

	versions 
		at: aPackage
		put: aVersion! !

!KomitterManager class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/6/2013 21:15'!
current

	^ instance ifNil: [ instance := super new ]! !

!KomitterManager class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 12/6/2013 21:15'!
new

	^ self shouldNotImplement! !

!KomitterUI commentStamp: '<historical>'!
I am a new UI to help Pharo coder to save their code with a finer granularity that a whole package!
!KomitterUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/22/2013 17:26'!
checkCommit
	^ checkCommit! !

!KomitterUI methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/26/2013 20:21'!
validate

	self commitableEntities 
		ifEmpty: [ 
			tree takeKeyboardFocus.
			self inform: 'The selection should contain commitable entities'.
			^ false ].
		
	message accept.
	
	^ true! !

!KomitterUI methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/27/2013 15:28'!
cancel

	message accept.
	Komitter lastMessage: message text! !

!KomitterUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/26/2013 10:27'!
commitMessage

	^ commitMessage! !

!KomitterUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/22/2013 16:58'!
remotes

	^ remotes! !

!KomitterUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/26/2013 12:28'!
uncommittedCommitableEntitied
	| map |
	
	map := Dictionary new.
	
	tree roots 
		select: [ :e | e isPartialMatch ]
		thenDo: [ :e || nodes | 
			nodes := e allUnselectedItems
				collect: [ :each | each content ]
				thenSelect: [ :each | each isCommitable ].
			nodes ifNotEmpty: [ map at: e content put: nodes ] ].

	^ map! !

!KomitterUI methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 11/26/2013 20:14'!
populateRemotes
	
	remotes 
		items: self model remotes asOrderedCollection;
		displayBlock: [ :each | each label ];
		iconHolder: [ :each | each icon ]! !

!KomitterUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/30/2013 19:27'!
manageRemotes
	^ manageRemotes! !

!KomitterUI methodsFor: 'private-icons' stamp: 'BenjaminVanRyseghem 11/30/2013 19:26'!
historyIcon

	^ self class historyIcon! !

!KomitterUI methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 11/26/2013 10:16'!
populateTreeFor: newModel
	| roots |
	
	roots := (KomitTreeBuilder rootsForStagingArea: newModel stagingArea) asOrderedCollection sorted.
	
	tree loading: false.
	tree 
		beCheckList;
		roots: roots;
		expandAll;
		collapseAll;
		expandRoots.
		
	self initializeLatelyPresenter.
	canCommit value: true.! !

!KomitterUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/26/2013 10:27'!
previousMessages

	^ previousMessages! !

!KomitterUI methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 1/24/2014 16:07'!
initialize

	model := nil asValueHolder.
	canCommit := false asValueHolder.
	
	super initialize.
	model
		whenChangedDo: [ :m | 
			[ self populateTreeFor: m ] fork.
			message text: m lastMessage.
			self populateRemotes ]! !

!KomitterUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/27/2013 15:29'!
chooseFromPreviousMessages
	| list index |
	
	list := MCSaveVersionDialog previousMessages collect: [:s | s truncateWithElipsisTo: 80 ].
	list ifEmpty: [ 
		UIManager default inform: 'No previous log message was entered'. 
		^ self ].
	
	index := UIManager default chooseFrom: list.
	
	"no comment was selected"
	index isZero ifTrue: [ ^ self ].

	message 
		text: (MCSaveVersionDialog previousMessages at: index);
		takeKeyboardFocus! !

!KomitterUI methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/24/2013 15:16'!
title

	^ 'Commit changes'! !

!KomitterUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/26/2013 10:27'!
message

	^ message! !

!KomitterUI methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 11/23/2013 23:39'!
populateRemotesFor: aCollection
	
	remotes 
		items: (self model remotesFor: aCollection) asOrderedCollection;
		displayBlock: [ :each | each label ];
		iconHolder: [ :each | each icon ]! !

!KomitterUI methodsFor: 'api' stamp: 'ChristopheDemarey 3/9/2015 15:38'!
initialExtent

	^ (980@740)! !

!KomitterUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/22/2013 14:39'!
authorName
	^ authorName! !

!KomitterUI methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/26/2013 21:25'!
komit
	"Gather all the data and create a Komit object out of them"
	
	^ remotes selectedItem komitOn: self! !

!KomitterUI methodsFor: 'private-icons' stamp: 'BenjaminVanRyseghem 11/30/2013 19:40'!
manageRemotesIcon

	^ self class manageRemotesIcon! !

!KomitterUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/23/2013 23:40'!
updateRemotes
	| roots |
	
	roots := tree roots 
		select: [ :e | e isPartialMatch ]
		thenCollect: [ :e | e content ].
		
	roots
		ifEmpty: [ self populateRemotes ]
		ifNotEmpty: [ self populateRemotesFor: roots ]! !

!KomitterUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/21/2013 21:16'!
leftTextFor: aKOObject

	aKOObject ifNil: [ ^ '' ].
	^ aKOObject koSourceText! !

!KomitterUI methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/26/2013 21:26'!
newKomitFor: aRemote
	"Gather all the data and create a Komit object out of them"
	
	^ Komit new
		message: message text;
		author: author text;
		timestamp: DateAndTime now;
		entities: self commitableEntities;
		unselectedEntities: self uncommittedCommitableEntitied;
		remote: aRemote;
		yourself! !

!KomitterUI methodsFor: 'initialization' stamp: 'DamienCassou 12/9/2013 14:31'!
initializeDialogWindow: aWindow

	self bindKeyCombination: (Character cr control unix | $m control mac) toAction: [ aWindow triggerOkAction ].

	aWindow toolbar okButton enabled: canCommit value.

	canCommit whenChangedDo: [ :b | aWindow toolbar okButton enabled: b ].
	
	self focusOrder
		removeAll;
		add: message;
		add: remotes;
		add: aWindow toolbar;
		add: tree;
		add: previousMessages! !

!KomitterUI methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 12/6/2013 20:38'!
initializeWidgets

	tree := self instantiate: TreeWithLoading.
	diff := self instantiate: DiffModel.
	message := self newText.
	author := self newTextInput.
	authorName := self newLabel.
	commitMessage := self newLabel.
	remotes := self newDropList.
	remoteLabel := self newLabel.
	checkCommit := self newCheckBox.
	previousMessages := self newButton.
	manageRemotes := self newButton.
	
	tree 
		removeOnlyLastSelected: true;
		autoMultiSelection: true;
		columns: { TreeColumnModel new
			displayBlock: [:node | node label ] }.
			
	diff
		showOptions: false;
		leftText: 'No selection for diff'.

	authorName label: 'Author:'.
	commitMessage label: 'Commit message:'.
	remoteLabel label: 'Remote:'.
	
	checkCommit
		label: 'Check Lint rules (NOT YET WORKING)';
		labelClickable: true;
		state: false;
		enabled: false.	
		
	author 
		text: Author fullNamePerSe;
		autoAccept: true.
		
	previousMessages
		icon: self historyIcon;
		action: [ self chooseFromPreviousMessages ];
		bindKeyCombination: Character space asKeyCombination 
		toAction: [ previousMessages action value ];
		help: 'Previous messages'.
		
	message
		bindKeyCombination: Character tab asKeyCombination
		toAction: [ self giveFocusToNextFrom: message ];
		bindKeyCombination: Character tab shift
		toAction: [ self giveFocusToPreviousFrom: message ];
		wantsVisualFeedback: false.
	
	manageRemotes
		icon: self manageRemotesIcon;
		action: [ self openRemoteManager ];
		help: 'Open the remotes manager'.
	
	self whenBuiltDo: [ 
		checkCommit labelOnLeft.
		diff showOnlySource: true.
		message selectAll.
		self updateRemotes ].! !

!KomitterUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/26/2013 10:27'!
remoteLabel

	^ remoteLabel! !

!KomitterUI methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 12/7/2013 10:56'!
initializeLatelyPresenter
	
	tree whenHighlightedItemChanged: [ :node || item |
		item := node 
			ifNil: [ nil ]
			ifNotNil: [ node content ].
		diff
			leftText: (self leftTextFor: item);
			rightText: (self rightTextFor: item).
		(item isNil or: [ item added ])
			ifTrue: [ diff showOnlyDestination: true ]
			ifFalse: [
		( item removed or: [ item isPackage or: [ (item isKomitClass and: [ item isDirty not ]) ] ] )
			ifTrue: [ diff showOnlySource: true ]
			ifFalse: [ diff showBoth ] ] ].
	
	tree whenSelectedItemsChanged: [ self updateRemotes ]! !

!KomitterUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/27/2013 16:57'!
commitableEntities
	| map |
	
	map := Dictionary new.
	
	tree roots do: [ :e || nodes | 
		e content isFullyCommited: e selected.
		nodes := e allSelectedItems
			collect: [ :each | each content ]
			thenSelect: [ :each | each isCommitable ].
		nodes ifNotEmpty: [ map at: e content put: nodes ] ].

	^ map! !

!KomitterUI methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/21/2013 15:40'!
roots: aCollection

	tree roots: aCollection! !

!KomitterUI methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/26/2013 21:26'!
newSliceFor: aRemote
	"Gather all the data and create a Komit object out of them"
	
	^ Slice new
		message: message text;
		author: author text;
		timestamp: DateAndTime now;
		entities: self commitableEntities;
		unselectedEntities: self uncommittedCommitableEntitied;
		remote: aRemote;
		yourself! !

!KomitterUI methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/23/2013 20:33'!
model

	^ model value! !

!KomitterUI methodsFor: 'private' stamp: 'ChristopheDemarey 1/8/2014 16:53'!
openRemoteManager
	| view |
	
	view := PackageRemotesManager new packages: (tree roots collect: [ :e | self remoteNodeFor: e ]).
	view openDialogWithSpec
		centered;
		modalRelativeTo: self window! !

!KomitterUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/22/2013 14:33'!
author
	^ author! !

!KomitterUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 15:39'!
tree
	^ tree! !

!KomitterUI methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/24/2013 21:23'!
addRoot: aPackage
	| aPackageNode |
	
	aPackageNode := KomitTreeBuilder buildRootForPackage: aPackage.
	
	tree roots: (tree roots
		add: aPackageNode;
		sorted)! !

!KomitterUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/6/2013 18:40'!
remoteNodeFor: e

	^ TreeNodeModel new
		content: e content package workingCopy! !

!KomitterUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 17:15'!
diff
	^ diff! !

!KomitterUI methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/26/2013 10:26'!
removeRoot: aKomitPackage
	| roots highlight |
	
	highlight := tree highlightedItem.
	
	roots := tree roots.
	roots
		remove: (KomitPackageNode new
			content: aKomitPackage;
			yourself).
		
	tree roots: roots.
	highlight takeHighlight! !

!KomitterUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/21/2013 21:10'!
rightTextFor: aKOObject

	aKOObject ifNil: [ ^ '' ].
	^ aKOObject koDestinationText! !

!KomitterUI methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/23/2013 20:37'!
model: aModel

	model value: aModel! !

!KomitterUI class methodsFor: 'specs' stamp: 'ChristopheDemarey 3/9/2015 15:39'!
defaultSpec
	<spec: #default>

	^ SpecLayout composed
		newRow: [ :topHalf |
			topHalf
				add: #tree;
				addVSplitter;
				newColumn: [ :c ] width: 4;
				newColumn: [ :commitInfoColumn |
					commitInfoColumn
						newRow: [ :commitRow | 
							commitRow 
								add: #commitMessage;
								add: #previousMessages width: self buttonHeight
						] height: self buttonHeight;
						add: #message;
						newRow: [ :authorRow |
							authorRow 
								add: #authorName width: 50;
								add: #author
						] height: self inputTextHeight +4 ;
						newRow: [ :repoRow |
							repoRow 
								add: #remoteLabel width: 50;
								add: #remotes;
								add: #manageRemotes width: self buttonHeight
						] height: self buttonHeight
				]
		] bottom: 0.5;
		addHSplitter;
		newRow: [ :row | row add: #diff ] top: 0.5;
		yourself! !

!KomitterUI class methodsFor: 'icons' stamp: 'BenjaminVanRyseghem 11/27/2013 17:32'!
taskbarIcon

	^ Komitter taskbarIcon! !

!KomitterUI class methodsFor: 'private-icons' stamp: 'BenjaminVanRyseghem 11/25/2013 20:13'!
historyIconData

	^ #(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4286673726 4286673726 4286673726 4286673726 4286673726 0 0 0 4278217148 4278217148 4278217148 4278217148 4286673726 4286673726 0 0 4288516712 4294967295 4294967295 4294967295 4294967295 4286673726 4286673726 4278217148 4286104319 4286104319 4286104319 4278217148 4294967295 4288516712 4284839308 0 4288516712 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4278217148 4286104319 4286104319 4286104319 4278217148 4294967295 4288516712 4284839308 0 4288253803 4294967295 4291942109 4291482074 4294967295 4294967295 4294967295 4278217148 4286104319 4286104319 4286104319 4278217148 4294967295 4288253803 4284839308 0 4287925358 4294967295 4294967295 4294967295 4290759126 4290759126 4294967295 4278217148 4286038527 4286038527 4286039039 4278217148 4294967295 4287925358 4284707465 0 4287465586 4294705151 4291942109 4291482074 4294705151 4294705151 4294705151 4278216120 4285971967 4285971967 4285971967 4278216633 4294705151 4287465586 4284444294 0 4287005814 4294376959 4294376959 4294376959 4290759126 4290759126 4294376959 4278215349 4285840127 4285840127 4285840127 4278215862 4294376959 4287005814 4284115330 0 4286480763 4294114047 4291942109 4291482074 4294114047 4294114047 4294114047 4278214064 4285708287 4285643519 4285708799 4278214319 4294114047 4286480763 4283786365 0 4286086271 4293785343 4293785343 4293785343 4290759126 4290759126 4293785343 4278213034 4285641983 4285641983 4285641983 4278213034 4293785343 4286086271 4283391608 0 4285626499 4293522687 4293522687 4293522687 4293522687 4293522687 4293522687 4278211492 4285444351 4285378815 4285378815 4278212003 4293457151 4285626499 4283062642 0 4285298055 4285298055 4285298055 4285298055 4285298055 4293325311 4293325311 4278210466 4285116671 4285116671 4285181951 4278210465 4285298055 4285298055 4282733421 0 0 4282207077 4282207077 4282207077 4285035401 4285035401 4285035401 4278209949 4284918783 4284786943 4284787455 4278209949 4282141286 4282207077 4282207078 0 0 0 0 0 4282141542 4282009699 4282009699 4278209949 4284721919 4278209949 4284525311 4278209949 0 0 0 0 0 0 0 0 0 0 0 4278209949 4278209949 0 4278209949 4278209949 0 0 0 0 0 0 0 0 0 0 0 0 4278209949 0 0 4278209949 0 0 0)! !

!KomitterUI class methodsFor: 'private-icons' stamp: 'BenjaminVanRyseghem 11/30/2013 19:39'!
manageRemotesData

	^ #(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4289496358 4289430823 0 0 0 0 0 0 0 0 0 0 0 0 0 4288970530 4294967295 4294957713 4289035810 0 0 0 0 0 0 0 0 4290811960 4290811960 4292065140 4288509724 4294832859 4294957713 4291666516 4289035810 0 0 0 0 0 0 0 4290549045 4294967295 4294957713 4287918102 4294832859 4294957713 4291666516 4287983638 0 0 0 0 0 0 0 4290285617 4294832859 4294957713 4287523346 4294832859 4294957713 4291666516 4287523089 0 0 0 0 0 0 0 4289956651 4294832859 4294957713 4291473003 4287194382 4294957713 4291666516 4287194382 4290811960 0 0 0 0 0 0 4289561893 4294832859 4294957713 4289562149 0 0 4287194382 4287194382 4294832859 4288706584 0 0 0 0 0 4289232928 4294832859 4294957713 4290946659 0 0 0 4290811960 4294832859 4294957713 4288706584 0 0 0 0 0 4288903963 4294957713 4289496358 4289430823 0 0 4290482995 4294832859 4294957713 4288706584 0 0 0 0 0 0 4290617694 4288970530 4294967295 4294957713 4289035810 4290022444 4294832859 4294957713 4288706584 0 0 0 0 0 0 0 4288509724 4294832859 4294957713 4291666516 4289035810 4294832859 4294957713 4288706584 0 0 0 0 0 0 0 4287918102 4294832859 4294957713 4291666516 4287983638 4294832859 4294957713 4288706584 0 0 0 0 0 0 0 4287523346 4294832859 4294957713 4291666516 4287523089 4288706584 4288706584 4288706584 0 0 0 0 0 0 0 0 4287194382 4294957713 4291666516 4287194382 0 0 0 0 0 0 0 0 0 0 0 0 0 4287194382 4287194382 0 0 0 0 0 0 0 0 0 0 0 0)! !

!KomitterUI class methodsFor: 'icons' stamp: 'BenjaminVanRyseghem 11/30/2013 19:40'!
manageRemotesIcon

	^ manageRemotesIcon ifNil: [ manageRemotesIcon := Pharo3UIThemeIcons form16x16FromContents: self manageRemotesData ]! !

!KomitterUI class methodsFor: 'icons' stamp: 'EstebanLorenzano 12/13/2013 14:45'!
historyIcon

	^ Smalltalk ui icons historyIcon ! !

!KonamiCodePlugin commentStamp: 'StephaneDucasse 10/30/2014 07:38'!
This plugin implements a little joke for konami players. A KonamiCodePlugin is a plugin which runs an action when the Konami code is entered. !
!KonamiCodePlugin methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 5/12/2011 17:22'!
initialize

	super initialize.
	lastKeystrokeTime := 0.
	! !

!KonamiCodePlugin methodsFor: 'announcement' stamp: 'MarcusDenker 11/22/2014 16:02'!
keyPressed: ann
	| aChar milliSeconds slowKeyStroke |
	aChar := ann key keyCharacter.
	milliSeconds := Time millisecondClockValue.
	slowKeyStroke := milliSeconds - lastKeystrokeTime > 500.
	lastKeystrokeTime := milliSeconds.
	lastKeystrokes := slowKeyStroke
		ifTrue: [ aChar asLowercase asString ]
		ifFalse: [ lastKeystrokes , aChar asLowercase asString ].	"forget previous keystrokes and search in following elements"	"append quick keystrokes but don't move selection if it still matches"	"Get rid of blanks and style used in some lists"
	lastKeystrokes = self konamiCode
		ifTrue: [ self openKonamiCode ]! !

!KonamiCodePlugin methodsFor: 'private' stamp: 'vincentBlondeau 12/12/2014 13:35'!
konamiCode

	| stream |
	^ code ifNil: [
			stream := '' writeStream.
			{ Character arrowUp. Character arrowUp. Character arrowDown. Character arrowDown. Character arrowLeft. Character arrowRight. Character arrowLeft. Character arrowRight. $b. $a } do: [:char | 
				stream << char asLowercase asString ].
		code := stream contents ]  ! !

!KonamiCodePlugin methodsFor: 'private' stamp: 'CamilleTeruel 12/6/2013 14:53'!
openKonamiCode


	[ 15 timesRepeat: [ 
		self inform: 'Congratulations: you found the Konami code!!!!!!!!!!'.
		(Delay forMilliseconds: 50) wait.
		]] fork.
! !

!KoreanEnvironment commentStamp: '<historical>'!
This class provides the Korean support.  Unfortunately, we haven't tested this yet.  We did have a working version in previous implementations, but not this new implementation. But as soon as we find somebody who understand the language, probably we can make it work in two days or so, as we have done for Czech support.!
!KoreanEnvironment class methodsFor: 'subclass responsibilities' stamp: 'cami 7/22/2013 18:25'!
systemConverterClass
	| encoding |
	Smalltalk os isWin32 
		ifTrue: [^EUCKRTextConverter].
	Smalltalk os isMacOS
		ifTrue: [^UTF8TextConverter].
	Smalltalk os isUnix 
		ifTrue: [encoding := X11Encoding encoding.
			encoding ifNil: [^EUCKRTextConverter].
			(encoding = 'utf-8') 
				ifTrue: [^UTF8TextConverter].							
			^EUCKRTextConverter].
	^UTF8TextConverter! !

!KoreanEnvironment class methodsFor: 'subclass responsibilities' stamp: 'mir 7/1/2004 18:42'!
supportedLanguages
	"Return the languages that this class supports. 
	Any translations for those languages will use this class as their environment."
	^#('ko' )! !

!KoreanEnvironment class methodsFor: 'class initialization' stamp: 'StephaneDucasse 8/22/2013 14:30'!
initialize

	EncodedCharSet declareEncodedCharSet: self atIndex: 7+1.! !

!KoreanEnvironment class methodsFor: 'subclass responsibilities' stamp: 'janggoon 11/4/2008 22:11'!
leadingChar
	
	^ 7! !

!KoreanEnvironment class methodsFor: 'language methods' stamp: 'yo 3/16/2004 14:50'!
traditionalCharsetClass

	^ KSX1001.
! !

!LIFOQueue commentStamp: 'Igor.Stasenko 10/16/2010 03:58'!
This is a thread-safe LIFO (last-in-first-out) queue (also known as stack) implementation,
 based on atomic operations.
!
!LIFOQueue methodsFor: 'initialization' stamp: 'Igor.Stasenko 10/16/2010 03:37'!
initialize
	| dummy |
	dummy := self newItem.
	dummy next: nil; object: dummy.
	head := dummy.! !

!LIFOQueue methodsFor: 'accessing' stamp: 'Igor.Stasenko 10/16/2010 04:39'!
nextIfNone: aBlock
	| dummy tail |

	dummy := self newItem.
	dummy object: dummy.

	tail := head.
	head := dummy.

	"skip over dummies"
	[ tail object == tail ] whileTrue: [ 
		[ tail isCircular ] whileTrue: [ self yield ].
		(tail := tail next) ifNil: [ 
			dummy next: nil. 
			dummy == head ifTrue: [ self signalNoMoreItems].
			^ aBlock value ] ].

	dummy next: tail next.

	^ tail object
	! !

!LIFOQueue methodsFor: 'stack-compliant protocol' stamp: 'Igor.Stasenko 10/16/2010 04:02'!
pop

	^ self nextIfNone: [ self errorEmptyStack ]! !

!LIFOQueue methodsFor: 'stack-compliant protocol' stamp: 'Igor.Stasenko 10/16/2010 04:03'!
errorEmptyStack
	self error: 'this stack is empty'! !

!LIFOQueue methodsFor: 'accessing' stamp: 'Igor.Stasenko 10/16/2010 04:39'!
next
	| dummy tail |

	dummy := self newItem.
	dummy object: dummy.

	"this is atomic"
	tail := head.
	head := dummy.

	"skip over dummies"
	[ tail object == tail ] whileTrue: [ 
		[ tail isCircular ] whileTrue: [ self yield ].
		(tail := tail next) ifNil: [  | result |
			"queue is empty. block until new items appear"
			head == dummy ifTrue: [ self signalNoMoreItems ].
			[ head == dummy ] whileTrue: [ self waitForNewItems ].
			dummy next: nil. 
			result := self next.
			^ result ] ].

	dummy next: tail next.

	^ tail object
	! !

!LIFOQueue methodsFor: 'accessing' stamp: 'Igor.Stasenko 10/16/2010 04:42'!
nextPut: anObject
	
	| newItem oldHead |

	newItem := self newItem.
	newItem object: anObject.

	"this is atomic"
	oldHead := head.
	head := newItem.
	
	newItem next: oldHead.
	
	self signalAddedNewItem.
	^ anObject! !

!LIFOQueue methodsFor: 'accessing' stamp: 'Igor.Stasenko 10/16/2010 04:34'!
fastPeek
	"Answer a top-most value without removing it from queue.
	Answer nil, if queue is empty or currently blocked by other process,
	which reading from queue"
	
	| item result |
	item := head.
	
	[ (result := item object) == item ] whileTrue: [ 
		item isCircular ifTrue: [ ^ nil ].
		(item := item next) ifNil: [ ^ nil ] ].
	
	^ result! !

!LIFOQueue methodsFor: 'stack-compliant protocol' stamp: 'Igor.Stasenko 10/16/2010 04:01'!
push: anObject
	^ self nextPut: anObject! !

!LIFOQueue methodsFor: 'accessing' stamp: 'Igor.Stasenko 10/16/2010 03:51'!
nextOrNil
	^ self nextIfNone: [ nil ]! !

!LIFOQueue methodsFor: 'accessing' stamp: 'Igor.Stasenko 10/16/2010 04:38'!
peek
	"answer a top-most value without removing it,  or nil, if queue is empty.
	May block if there's another process reading from queue"
	
	| item result |
	item := head.
	
	[ (result := item object) == item ] whileTrue: [ 
		[ item isCircular ] whileTrue: [ self yield ].
		(item := item next) ifNil: [ ^ nil ] ].
	
	^ result! !

!LIFOQueueTests commentStamp: 'TorstenBergmann 2/20/2014 15:30'!
SUnit tests for LIFO queues!
!LIFOQueueTests methodsFor: 'testing' stamp: 'Igor.Stasenko 10/16/2010 04:46'!
testBasics
	| q |
	q := self newQueue.
	
	q nextPut: 5.
	
	self assert: q next = 5.
	
	q nextPut: 10.
	
	self assert: q nextOrNil = 10.
	
	self assert: q nextOrNil == nil! !

!LIFOQueueTests methodsFor: 'testing' stamp: 'Igor.Stasenko 10/16/2010 04:46'!
testHeavyContention
	"run 10 threads, pushing new values to queue,
	and 10 threads pullung values from queue,
	at random priorities"
	
	| q sema prio pusher feeder
		feeders r crit done count |

	r := Random new.
	q := self newQueue.
	feeders := OrderedCollection new.
	count := 0.
	sema := Semaphore new.
	crit := Semaphore forMutualExclusion.
	done := Semaphore new.
	
	prio := Processor activePriority.
	pusher := [ sema wait. 1 to: 100 do: [:i | q nextPut: i ]. ].
	feeder := [ sema wait. 
		[ q nextOrNil ifNotNil: [ crit critical: [count := count + 1 ]]. Processor yield. count < 1000 ] whileTrue. done signal ].
	
	10 timesRepeat: [
		| proc |
		proc := pusher newProcess priority: prio + (r next * 10) asInteger.
		proc resume.
		"run feeders at lower priority, otherwise they won't give a chance pushers to complete,
		because queue doesn't blocks the process"
		proc := feeder newProcess priority: prio + (r next * 10) asInteger  - 10.
		feeders add: proc. 
		proc resume.		
	].

	" let them run "
	20 timesRepeat: [ sema signal ].
	Processor yield.
	
	done waitTimeoutSeconds: 10.
	 
	feeders do: [:ea | ea terminate ].
	self assert: (count = 1000 ).
	self assert: q nextOrNil == nil! !

!LIFOQueueTests methodsFor: 'testing' stamp: 'Igor.Stasenko 10/16/2010 04:44'!
testContention1
	"here is a test case that breaks the standard SharedQueue from Squeak 3.8"

	| q r1 r2 |
	q := self newQueue.
	q nextPut: 10.
	q nextPut: 5.

	self should: [ q nextOrNil = 5 ].

	[ r1 := q next ] fork.
	[ r2 := q next ] fork.
	Processor  yield.   "let the above two threads block"
	
	q nextPut: 10.
	Processor yield.

	self should: [ r1 = 10 ].
	self should: [ r2 = 10 ].
	self should: [ q nextOrNil = nil ].
! !

!LIFOQueueTests methodsFor: 'instance creation' stamp: 'Igor.Stasenko 10/16/2010 04:41'!
newQueue

	^ LIFOQueue new! !

!LRUCache commentStamp: '<historical>'!
I am LRUCache.
I am a Cache.

I am a limited cache that evicts the least recently used entries. My implementation is properly O(1).

Implementation Notes

The key/value pairs in the cache are held as Associations in a DoubleLinkedList, lruList, ordered from least to most recently used.

The keyIndex Dictionary maps from each key to the actual DoubleLink inside lruList holding the matching key/value pair.

New pairs are added at the end of the list.

In case of a hit, a pair gets promoted to the end of the list (most recently used).

In case of a full cache, the first pair of the list gets evicted (least recently used).

See #validateInvariantWith: where the relationship between the 2 datastructures is checked.!
!LRUCache methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/9/2015 14:46'!
at: key ifAbsentPut: block
	"If key is present in the cache, return the associated value.
	This is a hit and makes that key/value pair the most recently used.
	If key is absent, use block to compute a new value and cache it.
	Block can optionally take one argument, the key. 
	This is a miss and will create a new key/value pair entry.
	Furthermore this could result in the least recently used key/value pair 
	being removed when the specified maximum cache weight is exceeded."

	self critical: [ | association |
		association := keyIndex
			associationAt: key
			ifAbsent: [ | value |
				value := block cull: key.
				"Sadly we have to check the presence of key again 
				in case of the block execution already added the entry"
				keyIndex 
					associationAt: key 
					ifAbsent: [
						association := self newAssociationKey: key value: value.
						^ self handleMiss: association ] ].
		^ self handleHit: association ]! !

!LRUCache methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/10/2013 16:40'!
addWeight: value 
	weight add: value.
	[ weight isBelowMaximum ]
		whileFalse: [ 
			self isEmpty
				ifTrue: [ self error: 'Weight of single value being added exceeds maximum' ]
				ifFalse: [ self evict ] ]! !

!LRUCache methodsFor: 'accessing - statistics' stamp: 'SvenVanCaekenberghe 11/29/2013 21:15'!
size
	"Return the count of items currently present."
	
	^ keyIndex size! !

!LRUCache methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/29/2013 21:22'!
isEmpty
	"Return true when the receiver contains no entries."
	
	^ keyIndex isEmpty! !

!LRUCache methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/5/2013 17:46'!
promote: link
	lruList removeLink: link.
	lruList addLast: link! !

!LRUCache methodsFor: 'private' stamp: 'SvenVanCaekenberghe 2/2/2015 10:42'!
validateInvariantWith: assertable
	"The keyIndex maps keys to double linked list nodes that hold 
	a key value association, whose key must match the index key"
	keyIndex keysAndValuesDo: [ :key :link |
		assertable assert: link value key = key ].
	"When iterating over all key value pairs, each key lookup up
	through the index should see the correct key and value in 
	the double linked list node"
	self keysAndValuesDo: [ :key :value |
		| link |
		link := keyIndex at: key.
		assertable assert: link value value = value.
		assertable assert: link value key = key ].
	"When iterating over all keys, each key can be present only once"
	Set new in: [ :keysSeen |
		self keysAndValuesDo: [ :key :value |
			assertable assert: (keysSeen includes: key) not.
			keysSeen add: key ] ]! !

!LRUCache methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/5/2013 17:45'!
handleMiss: association
	| link |
	statistics addMiss.
	self addWeight: association value.
	link := lruList addLast: association.
	keyIndex at: association key put: link.
	^ association value! !

!LRUCache methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 12/16/2013 20:10'!
initialize
	super initialize.
	keyIndex := Dictionary new.
	lruList := DoubleLinkedList new! !

!LRUCache methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/5/2013 18:16'!
handleHit: association
	| link |
	statistics addHit.
	link := association value.
	self promote: link.
	^ link value value! !

!LRUCache methodsFor: 'removing' stamp: 'SvenVanCaekenberghe 12/9/2013 22:23'!
removeKey: key ifAbsent: block
	"If I currently cache key, remove the entry.
	Execute block when key is currently absent.
	Return the removed value."
	
	^ self critical: [
		(self includesKey: key)
			ifTrue: [ | link value |
				link := keyIndex removeKey: key.
				lruList removeLink: link.
				value := link value value.
				weight remove: value.
				value ]
			ifFalse: block ]! !

!LRUCache methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/9/2015 14:46'!
at: key put: value
	"Populate me by storing value for key. Return value. 
	This is neither a hit nor a miss. Statistics remain unchanged.
	Overwrite if already present without promotion. 
	This could result in the least recently used key/value pair 
	being removed when the specified maximum cache weight is exceeded."
	
	self critical: [ | association link |
		association := keyIndex
			associationAt: key
			ifAbsent: [
				association := self newAssociationKey: key value: value.
				self addWeight: value.
				link := lruList addLast: association.
				keyIndex at: key put: link.
				^ value ].
		link := association value.
		weight remove: link value value.
		self addWeight: value.
		link value value: value.
		^ value ]! !

!LRUCache methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/5/2013 17:35'!
evict
	| link value |
	link := lruList removeFirst.
	value := link value.
	weight remove: value value.
	keyIndex removeKey: value key! !

!LRUCache methodsFor: 'enumerating' stamp: 'SvenVanCaekenberghe 12/5/2013 17:35'!
keysAndValuesDo: block
	"Execute block with each key and value present in me.
	This will be from least to most recently used."
	
	lruList do: [ :link |
		block 
			value: link key 
			value: link value ]! !

!LRUCache methodsFor: '*System-CachingTests' stamp: 'BenComan 11/21/2014 09:25'!
testSupportGetCachedAssociations
	| result |
	result := OrderedCollection new.
	self keysAndValuesDo: [ :key :value |
		result add: (key -> value)
		].
	^result asArray.! !

!LRUCache methodsFor: 'private' stamp: 'SvenVanCaekenberghe 2/9/2015 14:45'!
newAssociationKey: key value: value
	^ Association key: key value: value! !

!LRUCache methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/29/2013 21:03'!
includesKey: key
	"Return true when the receiver has a value cached for key."
	
	^ keyIndex includesKey: key! !

!LRUCache methodsFor: 'removing' stamp: 'SvenVanCaekenberghe 12/9/2013 22:22'!
removeAll
	"Remove all key/value pairs that I currently hold,
	effectiley resetting me, but not my statistics."
	
	self critical: [
		lruList removeAll.
		keyIndex removeAll.
		weight reset ]! !

!LRUCacheTests commentStamp: '<historical>'!
I am NeoLRUCacheTests.
!
!LRUCacheTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:32'!
testFixedAccess
	| cache data keys |
	(cache := self newCache)
		maximumWeight: 4.
	data := (1 to: 16) collect: #asWords.
	data do: [ :each |
		cache at: each ifAbsentPut: [ each ] ].
	cache validateInvariantWith: self.
	self assert: cache size equals: 4.
	(#(14 15) collect: #asWords) do: [ :each |
		cache at: each ifAbsentPut: [ each ] ].
	self assert: cache size equals: 4.
	cache validateInvariantWith: self.	
	keys := data select: [ :each | cache includesKey: each ].
	keys do: [ :each | cache at: each ifAbsentPut: [ self fail ] ].
	self assert: cache hits >= 4.
	cache validateInvariantWith: self! !

!LRUCacheTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:32'!
testFactoryStyle
	| cache factory |
	cache := self newCache.
	cache maximumWeight: 5.
	factory := [ :key | key * 2 ].
	#( 1 2 3 4 1 5 6 7 8 1 ) do: [ :each |
		 cache at: each ifAbsentPut: factory ].
	self assert: cache size equals: 5.
	self assert: cache hits equals: 2.
	cache validateInvariantWith: self! !

!LRUCacheTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:32'!
testOne
	| cache |
	cache := self newCache.
	cache at: #foo ifAbsentPut: [ 100 ].
	self assert: (cache includesKey: #foo).
	self deny: cache isEmpty.
	self assert: cache size equals: 1.
	self assert: cache totalWeight equals: 1.
	self assert: cache hits isZero.
	self assert: cache misses equals: 1.
	self assert: cache hitRatio isZero.
	self deny: (cache includesKey: #bar).
	cache validateInvariantWith: self! !

!LRUCacheTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:33'!
testOneHitTwice
	| cache value |
	cache := self newCache.
	cache at: #foo ifAbsentPut: [ 100 ].
	value := cache at: #foo ifAbsentPut: [ self fail ].
	self assert: value equals: 100.
	value := cache at: #foo ifAbsentPut: [ self fail ].
	self assert: value equals: 100.
	self assert: cache hitRatio equals: 2/3.
	cache validateInvariantWith: self! !

!LRUCacheTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/6/2015 10:46'!
testPopulate
	| cache data |
	cache := self newCache.
	cache at: #foo put: 1.
	self assert: cache hits isZero.
	self assert: cache misses isZero.
	self assert: cache size equals: 1.
	self assert: (cache at: #foo) equals: 1.
	cache at: #foo put: 2.
	self assert: cache size equals: 1.
	self assert: (cache at: #foo) equals: 2.
	cache := self newCache.
	data := { #x->1. #y->2. #z->3 } asDictionary.
	cache addAll: data.
	self assert: cache hits isZero.
	self assert: cache misses isZero.
	self assert: cache size equals: 3.
	data keysAndValuesDo: [ :key :value |
		self assert: (cache at: key) equals: value ]! !

!LRUCacheTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:33'!
testRandomAccess
	| cache data random keys |
	(cache := self newCache)
		maximumWeight: 4.
	data := (1 to: 16) collect: #asWords.
	data do: [ :each |
		cache at: each ifAbsentPut: [ each ] ].
	cache validateInvariantWith: self.
	self assert: cache size equals: 4.
	random := data shuffled.
	random do: [ :each |
		cache at: each ifAbsentPut: [ each ] ].
	self assert: cache size equals: 4.
	cache validateInvariantWith: self.	
	keys := data select: [ :each | cache includesKey: each ].
	keys do: [ :each | cache at: each ifAbsentPut: [ self fail ] ].
	self assert: cache hits >= 4.
	cache validateInvariantWith: self! !

!LRUCacheTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:33'!
testTen
	| cache |
	cache := self newCache.
	1 to: 10 do: [ :each |
		cache at: each asWords ifAbsentPut: [ each ] ].
	self assert: cache size equals: 10.
	1 to: 10 do: [ :each |
		self assert: (cache includesKey: each asWords) ].
	1 to: 10 do: [ :each |
		self 
			assert: (cache at: each asWords ifAbsentPut: [ self fail ]) 
			equals: each ].
	self assert: cache hitRatio equals: 1/2.
	cache validateInvariantWith: self! !

!LRUCacheTests methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/16/2013 20:11'!
newCache
	^ LRUCache new! !

!LRUCacheTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/11/2013 15:38'!
testTenThreadSafe
	| cache |
	cache := self newCache.
	cache beThreadSafe.
	1 to: 10 do: [ :each |
		cache at: each asWords ifAbsentPut: [ each ] ].
	self assert: cache size equals: 10.
	1 to: 10 do: [ :each |
		self 
			assert: (cache at: each asWords ifAbsentPut: [ self fail ]) 
			equals: each ].
	self assert: cache hitRatio equals: 1/2.
	cache validateInvariantWith: self! !

!LRUCacheTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:32'!
testCustomWeight
	| cache |
	(cache := self newCache)
		computeWeight: #sizeInMemory;
		maximumWeight: 64.
	cache at: 1 ifAbsentPut: [ ByteArray new: 1 ].
	self assert: cache totalWeight equals: (ByteArray new: 1) sizeInMemory.
	2 to: 10 do: [ :each | 
		cache at: each ifAbsentPut: [ ByteArray new: each ] ].
	self assert: cache size equals: 3.
	self 
		assert: cache totalWeight 
		equals: ((8 to: 10) collect: [ :each | (ByteArray new: each) sizeInMemory ]) sum.
	self assert: (cache at: 10 ifAbsentPut: [ self fail ]) equals: (ByteArray new: 10).
	self deny: (cache includesKey: 1)! !

!LRUCacheTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:33'!
testPrimeFactors
	"[ self run: #testPrimeFactors ] bench."
	
	| cache data |
	cache := self newCache.
	cache maximumWeight: 512.
	cache factory: [ :key | key ].
	data := Array streamContents: [ :out |
		1 to: 4096 do: [ :each |
			each primeFactorsOn: out.
			out nextPut: each ] ].
	data := data collect: [ :each | each asWords ].
	data do: [ :each | cache at: each ].
	self assert: cache totalWeight equals: 512.
	self assert: cache hitRatio > (7/10).
	cache validateInvariantWith: self! !

!LRUCacheTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:32'!
testEviction
	| cache |
	cache := self newCache.
	cache maximumWeight: 16.
	1 to: 20 do: [ :each |
		cache at: each asWords ifAbsentPut: [ each ] ].
	self assert: cache size equals: 16.
	self assert: cache totalWeight equals: 16.
	5 to: 20 do: [ :each |
		self assert: (cache includesKey: each asWords).
		self 
			assert: (cache at: each asWords ifAbsentPut: [ self fail ]) 
			equals: each ].
	cache validateInvariantWith: self! !

!LRUCacheTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:32'!
test6k
	| cache |
	(cache := self newCache)
		maximumWeight: 600.
	1 to: 6000 do: [ :each |
		cache at: each ifAbsentPut: [ each * 2 ] ].
	self assert: cache size equals: 600.
	self assert: (cache includesKey: 5401).
	self deny: (cache includesKey: 5400).
	cache validateInvariantWith: self! !

!LRUCacheTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:33'!
testRemoveAll
	| cache |
	cache := self newCache.
	1 to: 10 do: [ :each | 
		cache at: each ifAbsentPut: [ each ] ].
	cache removeAll.
	self assert: cache isEmpty.
	self assert: cache size isZero.
	self assert: cache totalWeight isZero.
	self assert: cache misses equals: 10.
	self assert: cache hits isZero.
	self deny: (cache includesKey: #1).
	cache keysAndValuesDo: [ :key :value | self fail ].
	cache validateInvariantWith: self! !

!LRUCacheTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:33'!
testRemoveOneOfThree
	| cache |
	cache := self newCache.
	cache at: #x ifAbsentPut: [ 100 ].
	cache at: #y ifAbsentPut: [ 200 ].
	cache at: #z ifAbsentPut: [ 300 ].
	cache removeKey: #y.
	self assert: cache size equals: 2.
	self assert: cache totalWeight equals: 2.
	self assert: (cache at: #x ifAbsentPut: [ self fail ]) equals: 100.
	self deny: (cache includesKey: #y).
	self assert: (cache at: #z ifAbsentPut: [ self fail ]) equals: 300.
	cache validateInvariantWith: self! !

!LRUCacheTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:34'!
testThreeHitSameOne
	| cache |
	cache := self newCache.
	cache at: #x ifAbsentPut: [ 100 ].
	cache at: #y ifAbsentPut: [ 200 ].
	cache at: #z ifAbsentPut: [ 300 ].
	self assert: (cache at: #x ifAbsentPut: [ self fail ]) equals: 100.
	self assert: (cache at: #y ifAbsentPut: [ self fail ]) equals: 200.
	self assert: (cache at: #z ifAbsentPut: [ self fail ]) equals: 300.
	3 timesRepeat: [ 	
		self assert: (cache at: #x ifAbsentPut: [ self fail ]) equals: 100 ].
	self assert: cache hits equals: 6.
	cache validateInvariantWith: self! !

!LRUCacheTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/2/2015 10:41'!
testAdditionInIfAbsentPut
	| cache |
	cache := self newCache.
	cache at: #foo ifAbsentPut: [ 100 ].
	self assert: (cache at: #foo ifAbsentPut: [ self fail ]) equals: 100.
	"Add an entry for bar in the block computing the value to add"
	cache at: #bar ifAbsentPut: [ cache at: #bar ifAbsentPut: [ 200 ] ].
	self assert: (cache at: #bar ifAbsentPut: [ self fail ]) equals: 200.
	cache validateInvariantWith: self! !

!LRUCacheTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:33'!
testRemoveOne
	| cache |
	cache := self newCache.
	cache at: #foo ifAbsentPut: [ 100 ].
	cache removeKey: #foo.
	self assert: cache isEmpty.
	self assert: cache size isZero.
	self assert: cache totalWeight isZero.
	self deny: (cache includesKey: #foo).
	cache validateInvariantWith: self! !

!LRUCacheTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:34'!
testTwo
	| cache |
	cache := self newCache.
	cache at: #foo ifAbsentPut: [ 100 ].
	cache at: #bar ifAbsentPut: [ 200 ].
	self assert: (cache at: #foo ifAbsentPut: [ self fail ]) equals: 100.
	self assert: (cache at: #bar ifAbsentPut: [ self fail ]) equals: 200.
	self assert: cache hitRatio equals: 2/4.
	self assert: (cache at: #bar ifAbsentPut: [ self fail ]) equals: 200.
	self assert: (cache at: #foo ifAbsentPut: [ self fail ]) equals: 100.
	self assert: cache hitRatio equals: 4/6.
	cache validateInvariantWith: self! !

!LRUCacheTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:34'!
testThree
	| cache |
	cache := self newCache.
	cache at: #x ifAbsentPut: [ 100 ].
	cache at: #y ifAbsentPut: [ 200 ].
	cache at: #z ifAbsentPut: [ 300 ].
	self assert: (cache at: #x ifAbsentPut: [ self fail ]) equals: 100.
	self assert: (cache at: #y ifAbsentPut: [ self fail ]) equals: 200.
	self assert: (cache at: #z ifAbsentPut: [ self fail ]) equals: 300.
	self assert: cache hitRatio equals: 3/6.
	self assert: (cache at: #z ifAbsentPut: [ self fail ]) equals: 300.
	self assert: (cache at: #y ifAbsentPut: [ self fail ]) equals: 200.
	self assert: (cache at: #x ifAbsentPut: [ self fail ]) equals: 100.
	self assert: cache hitRatio equals: 6/9.
	cache validateInvariantWith: self! !

!LRUCacheTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:32'!
testEnumeration
	| cache data keys values |
	cache := self newCache.
	data := Dictionary new.
	1 to: 10 do: [ :each | data at: each asWords put: each ].
	data keysAndValuesDo: [ :key :value |
		cache at: key ifAbsentPut: [ value ] ].
	keys := Array new writeStream.
	values := Array new writeStream.
	cache keysAndValuesDo: [ :key :value |
		self assert: (data at: key) equals: value.
		keys nextPut: key.
		values nextPut: value ].
	self assert: keys contents asSet equals: data keys asSet.
	self assert: values contents asSet equals: data values asSet.
	cache validateInvariantWith: self! !

!LRUCacheTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/4/2015 13:45'!
testAt
	| cache |
	cache := self newCache.
	self should: [ cache at: #foo ] raise: KeyNotFound.
	cache at: #foo ifAbsentPut: [ 100 ].
	self assert: (cache at: #foo) equals: 100.
	cache removeKey: #foo.
	self should: [ cache at: #foo ] raise: KeyNotFound! !

!LRUCacheTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:32'!
testFactory
	| cache |
	cache := self newCache.
	cache maximumWeight: 5.
	cache factory: [ :key | key * 2 ].
	#( 1 2 3 4 1 5 6 7 8 1 ) do: [ :each |
		 cache at: each ].
	self assert: cache size equals: 5.
	self assert: cache hits equals: 2.
	cache validateInvariantWith: self! !

!LRUCacheTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:32'!
testEmpty
	| emptyCache |
	emptyCache := self newCache.
	self assert: emptyCache isEmpty.
	self assert: emptyCache size isZero.
	self assert: emptyCache hits isZero.
	self assert: emptyCache misses isZero.
	self assert: emptyCache hitRatio isZero.
	self assert: emptyCache totalWeight isZero.
	self deny: (emptyCache includesKey: #foo).
	emptyCache keysAndValuesDo: [ :key :value | self fail ]! !

!LRUCacheTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:31'!
test5kClasses
	| cache data |
	(cache := self newCache)
		maximumWeight: 1024.
	data := Object allSubclasses first: 5*1024.
	data do: [ :each |
		cache at: each name ifAbsentPut: [ each ] ].
	cache validateInvariantWith: self.
	self assert: cache size equals: 1024.
	data shuffled do: [ :each |
		cache at: each name ifAbsentPut: [ each ] ].
	self assert: cache size equals: 1024.
	cache validateInvariantWith: self.	
	data 
		select: [ :each | cache includesKey: each name ]
		thenDo: [ :each | cache at: each name ifAbsentPut: [ self fail ] ].
	self assert: cache hits >= 1024.
	cache validateInvariantWith: self! !

!LRUCacheTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/2/2013 16:33'!
testOneHit
	| cache value |
	cache := self newCache.
	cache at: #foo ifAbsentPut: [ 100 ].
	self assert: (cache includesKey: #foo).
	self assert: cache hits equals: 0.
	self assert: cache misses equals: 1.
	value := cache at: #foo ifAbsentPut: [ self fail ].
	self assert: value equals: 100.
	self assert: cache hits equals: 1.
	self assert: cache misses equals: 1.
	cache validateInvariantWith: self
	! !

!LRUCacheTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/11/2013 15:46'!
testFibonacci
	"After an idea by Jan Vrany.
	Recursively enter the cache and its access protection"
	
	| fibCache |
	fibCache := self newCache.
	fibCache 
		maximumWeight: 32;
		beThreadSafe;
		factory: [ :key |
			key < 2
				ifTrue: [ key ]
				ifFalse: [ (fibCache at: key - 1) + (fibCache at: key - 2) ] ].
	self assert: (fibCache at: 40) equals: 102334155! !

!LabelClicked commentStamp: '<historical>'!
I am an announcement raised when someone click on the label of a CheckboxMorph!
!LabelClicked methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/21/2013 23:32'!
stateChanged
	^ stateChanged! !

!LabelClicked methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/21/2013 23:32'!
source
	^ source! !

!LabelClicked methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/21/2013 23:32'!
source: anObject
	source := anObject! !

!LabelClicked methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/21/2013 23:32'!
stateChanged: anObject
	stateChanged := anObject! !

!LabelClicked class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 2/21/2013 23:32'!
source: source stateChanged: stateChanged

	^ self new
		source: source;
		stateChanged: stateChanged;
		yourself! !

!LabelModel commentStamp: '<historical>'!
A LabelModel is a spec model for Labels!
!LabelModel methodsFor: 'initialization' stamp: 'StephaneDucasse 3/3/2015 21:14'!
initialize
	super initialize.
	labelHolder := '' asValueHolder.
	enabledHolder := true asValueHolder.
	labelHolder whenChangedDo: [ self changed: #getText ].! !

!LabelModel methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 1/24/2014 17:58'!
defaultColor

	^ Color black! !

!LabelModel methodsFor: '*Deprecated40' stamp: 'StephaneDucasse 2/27/2015 21:44'!
whenLabelChanged: aBlock
	"Set a block to performed when the text is changed"
	self deprecated: 'Instead of using aModel whenLabelChanged: aBlock, use aModel labelHolder whenChangedDo: aBlock.'.
	labelHolder whenChangedDo: aBlock! !

!LabelModel methodsFor: 'api' stamp: 'StephaneDucasse 2/27/2015 21:42'!
label
	"<api: #inspect>"

	^ labelHolder value! !

!LabelModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 1/4/2014 18:06'!
emphasis: anInteger 
	
	self changed: #emphasis: with: { anInteger }! !

!LabelModel methodsFor: 'api-valueHolder' stamp: 'StephaneDucasse 2/27/2015 21:44'!
labelHolder
	"To register actions to be done when the label changes."
	^ labelHolder! !

!LabelModel methodsFor: '*Deprecated40' stamp: 'StephaneDucasse 3/9/2015 21:51'!
text: aText
	self deprecated: 'Use label: instead.'.	
	self label: aText! !

!LabelModel methodsFor: 'api' stamp: 'StephaneDucasse 2/27/2015 21:43'!
label: aText
	"<api: #string getter: #label>"
	"Set the text of the label"
	
	labelHolder value: aText! !

!LabelModel methodsFor: '*Deprecated40' stamp: 'StephaneDucasse 2/27/2015 21:45'!
text
	self deprecated: 'Use label: instead.'.
	^ self label! !

!LabelModel methodsFor: '*Deprecated40' stamp: 'StephaneDucasse 2/27/2015 21:44'!
whenTextChanged: aBlock
	self deprecated: 'Instead of using aModel whenTextChanged: aBlock, use aModel labelHolder whenChangedDo: aBlock.'.
	self whenLabelChanged: aBlock! !

!LabelModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/1/2013 13:38'!
defaultSpec
	<spec>
	
	^ #(LabelAdapter
		adapt: #(model))! !

!LabelModel class methodsFor: 'specs' stamp: ''!
title

	^ 'Label Morph'! !

!LabelModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/13/2014 15:21'!
adapterName

	^ #LabelAdapter! !

!LabelMorph commentStamp: 'gvc 5/18/2007 12:48'!
String morph with enablement support. When disabled the text will appear inset.!
!LabelMorph methodsFor: 'as yet unclassified' stamp: 'EstebanLorenzano 4/29/2014 16:00'!
initialColorInSystemWindow: aSystemWindow
	^ self theme textColor! !

!LabelMorph methodsFor: 'accessing' stamp: 'gvc 1/16/2007 15:28'!
enabled
	"Answer the value of enabled"

	^enabled! !

!LabelMorph methodsFor: 'accessing' stamp: 'gvc 8/2/2007 16:43'!
disabledStyle
	"Answer the value of disabledStyle"

	^ disabledStyle! !

!LabelMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/22/2013 14:12'!
disabledStyle: anObject
	"Set the value of disabledStyle"

	disabledStyle := anObject.
	self changed! !

!LabelMorph methodsFor: 'accessing' stamp: 'gvc 7/30/2010 13:37'!
getTextSelector: aSymbol

	getTextSelector := aSymbol.
	self updateText! !

!LabelMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/23/2014 16:18'!
adoptPaneColor: aColor! !

!LabelMorph methodsFor: 'initialization' stamp: 'gvc 8/2/2007 16:44'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		disabledStyle: #plain;
		enabled: true! !

!LabelMorph methodsFor: 'protocol' stamp: 'gvc 8/2/2007 16:35'!
enable
	"Enable the receiver."
	
	self enabled: true! !

!LabelMorph methodsFor: 'layout' stamp: 'gvc 10/26/2007 21:15'!
minWidth
	"Answer the minmum width of the receiver.
	Based on font and contents."

	^self valueOfProperty: #minWidth ifAbsent: [self measureContents x] "allow override"! !

!LabelMorph methodsFor: 'accessing' stamp: 'gvc 3/2/2010 17:23'!
enabled: aBoolean
	"Set the value of enabled"

	enabled == aBoolean ifFalse: [
		enabled := aBoolean.
		self
			changed: #enabled;
			changed]! !

!LabelMorph methodsFor: 'accessing' stamp: 'gvc 7/30/2010 13:25'!
getTextSelector

	^ getTextSelector! !

!LabelMorph methodsFor: 'updating' stamp: 'gvc 7/30/2010 13:25'!
update: aSymbol 
	"Refer to the comment in View|update:."

	aSymbol == self getEnabledSelector ifTrue:
		[self updateEnabled.
		^ self].
	aSymbol == self getTextSelector ifTrue:
		[self updateText.
		^ self]! !

!LabelMorph methodsFor: 'initialization' stamp: 'gvc 8/2/2007 16:51'!
initWithContents: aString font: aFont emphasis: emphasisCode
	"Grrr, why do they do basicNew?"
	
	super initWithContents: aString font: aFont emphasis: emphasisCode.
	self
		disabledStyle: #plain;
		enabled: true! !

!LabelMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/23/2015 13:48'!
drawOnAthensCanvas: aCanvas
	"Draw based on enablement."

	| pc |
	pc := self owner
		ifNil: [ self paneColor ]
		ifNotNil: [ 
			self owner color isTransparent
				ifTrue: [ self owner paneColor ]
				ifFalse: [ self owner color ] ].
	aCanvas
		clipBy: self bounds
		during: [ 
			aCanvas pathTransform
				restoreAfter: [ 
					aCanvas pathTransform translateX: self left Y: self top + self fontToUse ascent.
					aCanvas
						setFont: self fontToUse;
						setPaint:
								(self enabled
										ifTrue: [ self color ]
										ifFalse: [ pc muchDarker ]);
						drawString: self contents ] ]! !

!LabelMorph methodsFor: 'protocol' stamp: 'gvc 8/2/2007 16:35'!
disable
	"Disable the receiver."
	
	self enabled: false! !

!LabelMorph methodsFor: 'protocol' stamp: 'gvc 3/4/2010 15:16'!
interactionState: aSymbol
	"Backstop here to prevent 'legacy' color handling being applied from
	pluggable buttons."! !

!LabelMorph methodsFor: 'updating' stamp: 'gvc 9/8/2009 13:25'!
updateEnabled
	"Update the enablement state."

	self model ifNotNil: [
		self getEnabledSelector ifNotNil: [
			self enabled: (self model perform: self getEnabledSelector)]]! !

!LabelMorph methodsFor: 'drawing' stamp: 'GaryChambers 12/21/2011 12:15'!
drawOn: aCanvas
	"Draw based on enablement."
	
	self enabled
		ifTrue: [aCanvas
					drawString: self contents
					in: self bounds
					font: self fontToUse
					color: self color]
		ifFalse: [|c|
				c := self theme labelDisabledColorFor: self.
				self disabledStyle == #inset ifTrue: [
					aCanvas
						drawString: self contents
						in: (self bounds translateBy: 1)
						font: self fontToUse
						color: c muchLighter].
				aCanvas
					drawString: self contents
					in: self bounds
					font: self fontToUse
					color: c]! !

!LabelMorph methodsFor: 'accessing' stamp: 'gvc 1/16/2007 15:28'!
getEnabledSelector
	"Answer the value of getEnabledSelector"

	^ getEnabledSelector! !

!LabelMorph methodsFor: 'accessing' stamp: 'gvc 1/16/2007 15:52'!
model
	"Answer the value of model"

	^model! !

!LabelMorph methodsFor: 'update' stamp: 'gvc 7/30/2010 13:26'!
updateText
	"Update the text contents."

	self model ifNotNil: [
		self getTextSelector ifNotNil: [
			self contents: (self model perform: self getTextSelector)]]! !

!LabelMorph methodsFor: 'compatibility' stamp: 'BenjaminVanRyseghem 7/13/2012 02:18'!
isMorphicModel
	^true! !

!LabelMorph methodsFor: 'layout' stamp: 'gvc 6/15/2007 13:17'!
minHeight
	"Answer the receiver's minimum height.
	based on font height."
	
	^self fontToUse height rounded max: super minHeight! !

!LabelMorph methodsFor: 'accessing' stamp: 'gvc 1/16/2007 15:54'!
model: anObject
	"Set my model and make me me a dependent of the given object."

	model ifNotNil: [model removeDependent: self].
	anObject ifNotNil: [anObject addDependent: self].
	model := anObject! !

!LabelMorph methodsFor: 'accessing' stamp: 'gvc 1/16/2007 15:27'!
getEnabledSelector: anObject
	"Set the value of getEnabledSelector"

	getEnabledSelector := anObject.
	self updateEnabled! !

!LabelMorph class methodsFor: 'instance creation' stamp: 'StephaneDucasse 10/5/2014 14:34'!
newLabel: aString
	"Answer a new text label morph."

	^self
		newLabelFor: nil
		label: aString
		getEnabled: nil! !

!LabelMorph class methodsFor: 'examples' stamp: 'StephaneDucasse 10/5/2014 14:40'!
example
	<exampleWidget>
	"self example"
	
	^ self newLabel: 'A Label'.! !

!LabelMorph class methodsFor: 'examples' stamp: 'StephaneDucasse 10/5/2014 14:41'!
exampleDisable
	<exampleWidget>
	"self exampleDisable"
	
	^ (self newLabel: 'A Label' ) disable! !

!LabelMorph class methodsFor: 'instance creation' stamp: 'StephaneDucasse 10/5/2014 14:35'!
newLabelFor: aModel label: aString getEnabled: enabledSel
	"Answer a new text label whose model is aModel"

	^ ( self contents: aString font: self labelFont )
		model: aModel;
		getEnabledSelector: enabledSel! !

!LabelMorph class methodsFor: 'instance creation' stamp: 'StephaneDucasse 10/5/2014 14:31'!
labelFont
	"in the future should access an instance variable"
		
	^StandardFonts defaultFont! !

!LanguageEnvironment commentStamp: '<historical>'!
The name multilingualized suggests that you can use multiple language at one time.  This is true, of course, but the system still how to manage the primary language; that provides the interpretation of data going out or coming in from outside world. It also provides how to render strings, as there rendering rule could be different in one language to another, even if the code points in a string is the same.

  Originally, LanguageEnvironment and its subclasses only has class side methods.  After merged with Diego's Babel work, it now has instance side methods.  Since this historical reason, the class side and instance side are not related well.

  When we talk about the interface with the outside of the Squeak world, there are three different "channels"; the keyboard input, clipboard output and input, and filename.  On a not-to-uncommon system such as a Unix system localized to Japan, all of these three can have (and does have) different encodings.  So we need to manage them separately.  Note that the encoding in a file can be anything.  While it is nice to provide a suggested guess for this 'default system file content encoding', it is not critical.

  Rendering support is limited basic L-to-R rendering so far.  But you can provide different line-wrap rule, at least.
!
!LanguageEnvironment methodsFor: 'accessing' stamp: 'mir 7/15/2004 15:31'!
localeID
	^id! !

!LanguageEnvironment methodsFor: 'accessing' stamp: 'mir 7/15/2004 15:32'!
isoCountry
	^self localeID isoCountry! !

!LanguageEnvironment methodsFor: 'accessing' stamp: 'mir 7/15/2004 15:32'!
isoLanguage
	^self localeID isoLanguage! !

!LanguageEnvironment methodsFor: 'accessing' stamp: 'mir 7/15/2004 18:55'!
leadingChar
	^self class leadingChar! !

!LanguageEnvironment methodsFor: 'initialization' stamp: 'mir 7/15/2004 15:31'!
localeID: anID
	id := anID! !

!LanguageEnvironment class methodsFor: 'accessing' stamp: 'yo 3/17/2004 15:24'!
canBeGlobalVarInitial: char

	^ Unicode canBeGlobalVarInitial: char.
! !

!LanguageEnvironment class methodsFor: 'accessing' stamp: 'yo 12/2/2004 16:13'!
isCharset

	^ false.
! !

!LanguageEnvironment class methodsFor: 'initialization' stamp: 'mir 7/21/2004 19:10'!
resetKnownEnvironments
	"LanguageEnvironment resetKnownEnvironments"

	KnownEnvironments := nil! !

!LanguageEnvironment class methodsFor: 'private' stamp: 'nice 1/5/2010 15:59'!
initKnownEnvironments
	"LanguageEnvironment initKnownEnvironments"

	| known |
	known := Dictionary new.
	self allSubclassesDo: [:subClass | 
		subClass supportedLanguages do: [:language | | env id | 
			env := subClass new.
			id := LocaleID isoString: language.
			env localeID: id.
			known at: id put: env]].
	^known! !

!LanguageEnvironment class methodsFor: 'language methods' stamp: 'tpr 10/3/2013 12:56'!
scanMultibyteCharactersFrom: startIndex to: stopIndex in: aWideString with: aCharacterScanner rightX: rightX font: aFont
	"the default for scanning multibyte characters- other more specific encodings may do something else"
	^aFont scanMultibyteCharactersFrom: startIndex to: stopIndex in: aWideString with: aCharacterScanner rightX: rightX! !

!LanguageEnvironment class methodsFor: 'initialization' stamp: 'GuillermoPolito 6/27/2012 12:41'!
initialize
	"LanguageEnvironment initialize"

	Smalltalk addToStartUpList: LanguageEnvironment
! !

!LanguageEnvironment class methodsFor: 'class initialization' stamp: 'GuillermoPolito 6/27/2012 12:41'!
startUp

	self clearDefault.! !

!LanguageEnvironment class methodsFor: 'accessing' stamp: 'yo 3/17/2004 15:25'!
isLetter: char

	^ Unicode isLetter: char.
! !

!LanguageEnvironment class methodsFor: 'accessing' stamp: 'yo 3/17/2004 15:24'!
canBeNonGlobalVarInitial: char

	^ Unicode canBeNonGlobalVarInitial: char.
! !

!LanguageEnvironment class methodsFor: 'subclass responsibilities' stamp: 'yo 3/17/2004 15:10'!
systemConverterClass

	self subclassResponsibility.
	^ Latin1TextConverter.
! !

!LanguageEnvironment class methodsFor: 'initialization' stamp: 'CamilloBruni 8/24/2012 18:05'!
clearDefault
	SystemConverter := nil.
	FileNameConverter := nil.
! !

!LanguageEnvironment class methodsFor: 'subclass responsibilities' stamp: 'michael.rueger 2/5/2009 17:23'!
fileNameConverterClass

	^UTF8TextConverter! !

!LanguageEnvironment class methodsFor: 'accessing' stamp: 'yo 7/28/2004 21:34'!
currentPlatform

	^ Locale currentPlatform languageEnvironment.
! !

!LanguageEnvironment class methodsFor: 'accessing' stamp: 'yo 3/17/2004 15:25'!
isUppercase: char

	^ Unicode isUppercase: char.
! !

!LanguageEnvironment class methodsFor: 'rendering support' stamp: 'yo 3/17/2004 21:54'!
isBreakableAt: index in: text

	| char |
	char := text at: index.
	char = Character space ifTrue: [^ true].
	char = Character cr ifTrue: [^ true].
	^ false.
! !

!LanguageEnvironment class methodsFor: 'accessing' stamp: 'yo 3/17/2004 15:24'!
isDigit: char

	^ Unicode isDigit: char.
! !

!LanguageEnvironment class methodsFor: 'subclass responsibilities' stamp: 'yo 3/17/2004 15:11'!
leadingChar

	self subclassResponsibility.
	^ 0.
! !

!LanguageEnvironment class methodsFor: 'public query' stamp: 'CamilloBruni 8/24/2012 18:05'!
defaultFileNameConverter
	FileNameConverter
		ifNil: [FileNameConverter := self currentPlatform class fileNameConverterClass new].
	^ FileNameConverter! !

!LanguageEnvironment class methodsFor: 'accessing' stamp: 'michael.rueger 3/15/2009 11:45'!
localeID: localeID
	self knownEnvironments at: localeID ifPresent: [:value | ^value].
	^self knownEnvironments
		at: (LocaleID isoLanguage: localeID isoLanguage)
		ifAbsent: [self localeID: (LocaleID isoLanguage: 'en')]! !

!LanguageEnvironment class methodsFor: 'accessing' stamp: 'yo 3/17/2004 15:25'!
isLowercase: char

	^ Unicode isLowercase: char.
! !

!LanguageEnvironment class methodsFor: 'subclass responsibilities' stamp: 'mir 7/1/2004 17:59'!
supportedLanguages
	"Return the languages that this class supports. 
	Any translations for those languages will use this class as their environment."
	self subclassResponsibility! !

!LanguageEnvironment class methodsFor: 'class initialization' stamp: 'mir 7/15/2004 16:13'!
localeChanged
	self startUp! !

!LanguageEnvironment class methodsFor: 'accessing' stamp: 'StephaneDucasse 2/13/2010 12:14'!
digitValueOf: char
	"Answer 0-9 if the receiver is $0-$9, 10-35 if it is $A-$Z, and < 0
	otherwise. This is used to parse literal numbers of radix 2-36."

	^ Unicode digitValueOf: char.! !

!LanguageEnvironment class methodsFor: 'language methods' stamp: 'yo 1/18/2005 15:56'!
scanSelector

	^ #scanMultiCharactersFrom:to:in:rightX:stopConditions:kern:
! !

!LanguageEnvironment class methodsFor: 'public query' stamp: 'StephaneDucasse 8/2/2013 22:36'!
defaultSystemConverter
	SystemConverter
		ifNil: [ SystemConverter := self currentPlatform class systemConverterClass new ].
	^ SystemConverter! !

!LanguageEnvironment class methodsFor: 'private' stamp: 'mir 7/15/2004 15:45'!
knownEnvironments
	"LanguageEnvironment knownEnvironments"
	"KnownEnvironments := nil"

	^KnownEnvironments ifNil: [KnownEnvironments := self initKnownEnvironments]! !

!LargeInteger commentStamp: '<historical>'!
I represent integers of more than 30 bits.  These values are beyond the range of SmallInteger, and are encoded here as an array of 8-bit digits. !
!LargeInteger methodsFor: 'printing' stamp: 'ClementBera 7/24/2013 17:04'!
printOn: aStream base: b nDigits: n
	"Append a representation of this number in base b on aStream using n digits.
	In order to reduce cost of LargePositiveInteger ops, split the number of digts approximatily in two
	Should be invoked with: 0 <= self < (b raisedToInteger: n)"
	
	| halfPower half head tail |
	n <= 1 ifTrue: [
		n <= 0 ifTrue: [self error: 'Number of digits n should be > 0'].
		
		"Note: this is to stop an infinite loop if one ever attempts to print with a huge base
		This can happen because choice was to not hardcode any limit for base b
		We let Character>>#digitValue: fail"
		^aStream nextPut: (Character digitValue: self)].
	halfPower := n bitShift: -1.
	half := b raisedToInteger: halfPower.
	head := self quo: half.
	tail := self - (head * half).
	head printOn: aStream base: b nDigits: n - halfPower.
	tail printOn: aStream base: b nDigits: halfPower! !

!LargeInteger methodsFor: 'system primitives' stamp: 'ClementBera 7/24/2013 17:04'!
digitAt: index 
	"Primitive. Answer the value of an indexable field in the receiver.   LargePositiveInteger uses bytes of base two number, and each is a 'digit' base 256.  Fail if the argument (the index) is not an Integer or is out of bounds. Essential.  See Object documentation whatIsAPrimitive."

	<primitive: 60>
	self digitLength < index
		ifTrue: [^0]
		ifFalse: [^super at: index]! !

!LargeInteger methodsFor: 'arithmetic' stamp: 'ClementBera 7/24/2013 17:04'!
rem: aNumber 
	"Remainder defined in terms of quo:. See super rem:.
	This is defined only to speed up case of large integers."

	<primitive: 20>
	 aNumber isInteger
		ifTrue:
			[| ng rem |
			ng := self negative == aNumber negative == false.
			rem := (self digitDiv: aNumber neg: ng) at: 2.
			^ rem normalize].
	^super rem: aNumber! !

!LargeInteger methodsFor: 'arithmetic' stamp: 'ClementBera 7/24/2013 17:04'!
quo: anInteger 
	"Primitive. Divide the receiver by the argument and return the result.
	Round the result down towards zero to make it a whole integer. Fail if
	the argument is 0. Fail if either the argument or the result is not a
	SmallInteger or a LargePositiveInteger less than 2-to-the-30th (1073741824). Optional. See
	Object documentation whatIsAPrimitive."

	<primitive: 33>
	^super quo: anInteger! !

!LargeInteger methodsFor: 'converting' stamp: 'ClementBera 7/24/2013 17:04'!
as31BitSmallInt
	"This is only for 31 bit numbers.  Keep my 31 bits the same, but put them in a small int.  The small int will be negative since my 31st bit is 1.  We know my 31st bit is 1 because otherwise I would already be a positive small int."

	self highBit = 31 ifFalse: [self error: 'more than 31 bits can not fit in a SmallInteger'].

	^ self - 16r80000000! !

!LargeInteger methodsFor: 'system primitives' stamp: 'ClementBera 7/24/2013 17:04'!
digitAt: index put: value 
	"Primitive. Store the second argument (value) in the indexable field of 
	the receiver indicated by index. Fail if the value is negative or is larger 
	than 255. Fail if the index is not an Integer or is out of bounds. Answer 
	the value that was stored. Essential. See Object documentation 
	whatIsAPrimitive."

	<primitive: 61>
	^super at: index put: value! !

!LargeInteger methodsFor: 'comparing' stamp: 'ClementBera 7/24/2013 17:03'!
< anInteger 
	"Primitive. Compare the receiver with the argument and answer true if
	the receiver is less than the argument. Otherwise answer false. Fail if the
	argument is not a SmallInteger or a LargePositiveInteger less than 2-to-the-30th (1073741824).
	Optional. See Object documentation whatIsAPrimitive."

	<primitive: 23>
	^super < anInteger! !

!LargeInteger methodsFor: 'converting' stamp: 'ClementBera 7/24/2013 17:04'!
withAtLeastNDigits: desiredLength

	| new |

	self size >= desiredLength ifTrue: [^self].
	new := self class new: desiredLength.
	new
		replaceFrom: 1 
		to: self size 
		with: self 
		startingAt: 1.
	^new! !

!LargeInteger methodsFor: 'arithmetic' stamp: 'ClementBera 7/24/2013 17:03'!
+ anInteger 
	"Primitive. Add the receiver to the argument and answer with an
	Integer result. Fail if either the argument or the result is not a
	SmallInteger or a LargePositiveInteger less than 2-to-the-30th (1073741824). Optional. See
	Object documentation whatIsAPrimitive."

	<primitive: 21>
	^super + anInteger! !

!LargeInteger methodsFor: 'arithmetic' stamp: 'ClementBera 7/24/2013 17:03'!
- anInteger 
	"Primitive. Subtract the argument from the receiver and answer with an
	Integer result. Fail if either the argument or the result is not a
	SmallInteger or a LargePositiveInteger less than 2-to-the-30th (1073741824). Optional. See
	Object documentation whatIsAPrimitive."

	<primitive: 22>
	^super - anInteger! !

!LargeInteger methodsFor: 'arithmetic' stamp: 'ClementBera 7/24/2013 17:03'!
\\ aNumber 
	"Primitive. Take the receiver modulo the argument. The result is the
	remainder rounded towards negative infinity, of the receiver divided
	by the argument. Fail if the argument is 0. Fail if either the argument
	or the result is not a SmallInteger or a LargePositiveInteger less than
	2-to-the-30th (1073741824). Optional. See Object documentation whatIsAPrimitive."

	<primitive: 31>
	aNumber isInteger
		ifTrue:
			[| neg qr q r |
			neg := self negative == aNumber negative == false.
			qr := self digitDiv: aNumber neg: neg.
			q := qr first normalize.
			r := qr last normalize.
			^(q negative
				ifTrue: [r isZero not]
				ifFalse: [q isZero and: [neg]])
					ifTrue: [r + aNumber]
					ifFalse: [r]].
	^super \\ aNumber
	! !

!LargeInteger methodsFor: 'testing' stamp: 'ClementBera 7/24/2013 17:04'!
isPrime
	"Answer true if the receiver is a prime number. Use a probabilistic implementation	 that
	is much faster for large integers, and that is correct to an extremely high statistical
	level of confidence (effectively deterministic)."

	^ self isProbablyPrime! !

!LargeInteger methodsFor: 'arithmetic' stamp: 'ClementBera 7/24/2013 17:03'!
// anInteger 
	"Primitive. Divide the receiver by the argument and return the result.
	Round the result down towards negative infinity to make it a whole
	integer. Fail if the argument is 0. Fail if either the argument or the
	result is not a SmallInteger or a LargePositiveInteger less than 2-to-the-30th (1073741824).
	Optional. See Object documentation whatIsAPrimitive. "

	<primitive: 32>
	^super // anInteger! !

!LargeInteger methodsFor: 'arithmetic' stamp: 'ClementBera 7/24/2013 17:03'!
\\\ anInteger 
	"a faster modulo method for use in DSA. Be careful if you try to use this elsewhere"

	^(self digitDiv: anInteger neg: false) second! !

!LargeInteger methodsFor: 'bit manipulation' stamp: 'ClementBera 7/24/2013 17:04'!
hashMultiply
	"Truncate to 28 bits and try again"

	^(self bitAnd: 16rFFFFFFF) hashMultiply! !

!LargeInteger methodsFor: 'comparing' stamp: 'ClementBera 7/24/2013 17:03'!
> anInteger 
	"Primitive. Compare the receiver with the argument and answer true if
	the receiver is greater than the argument. Otherwise answer false. Fail if
	the argument is not a SmallInteger or a LargePositiveInteger less than
	2-to-the-30th (1073741824). Optional. See Object documentation whatIsAPrimitive."

	<primitive: 24>
	^super > anInteger! !

!LargeInteger methodsFor: 'comparing' stamp: 'ClementBera 7/24/2013 17:04'!
hash

	^ByteArray
		hashBytes: self
		startingWith: self species hash! !

!LargeInteger methodsFor: 'testing' stamp: 'ClementBera 7/24/2013 17:04'!
isLarge
	^true! !

!LargeInteger methodsFor: 'system primitives' stamp: 'ClementBera 7/24/2013 17:04'!
digitLength
	"Primitive. Answer the number of indexable fields in the receiver. This 
	value is the same as the largest legal subscript. Essential. See Object 
	documentation whatIsAPrimitive."

	<primitive: 62>
	self primitiveFailed! !

!LargeInteger methodsFor: 'comparing' stamp: 'ClementBera 7/24/2013 17:03'!
>= anInteger 
	"Primitive. Compare the receiver with the argument and answer true if
	the receiver is greater than or equal to the argument. Otherwise answer
	false. Fail if the argument is not a SmallInteger or a LargePositiveInteger
	less than 2-to-the-30th (1073741824). Optional. See Object documentation whatIsAPrimitive."

	<primitive: 26>
	^super >= anInteger! !

!LargeInteger methodsFor: 'bit manipulation' stamp: 'ClementBera 7/24/2013 17:04'!
highBitOfMagnitude
	"Answer the index of the high order bit of the magnitude of the  
	receiver, or zero if the receiver is zero.  
	This method is used for LargeNegativeIntegers as well,  
	since LargeIntegers are sign/magnitude."
	| realLength lastDigit |
	realLength := self digitLength.
	[(lastDigit := self digitAt: realLength) = 0]
		whileTrue: [(realLength := realLength - 1) = 0 ifTrue: [^ 0]].
	^ lastDigit highBitOfPositiveReceiver + (8 * (realLength - 1))! !

!LargeInteger methodsFor: 'converting' stamp: 'ClementBera 7/24/2013 17:09'!
asFloat
	"Answer a Float that best approximates the value of the receiver.
	This algorithm is optimized to process only the significant digits of a LargeInteger.
	And it does honour IEEE 754 round to nearest even mode in case of excess precision (see details below)."
	
	"How numbers are rounded in IEEE 754 default rounding mode:
	A shift is applied so that the highest 53 bits are placed before the floating point to form a mantissa.
	The trailing bits form the fraction part placed after the floating point.
	This fractional number must be rounded to the nearest integer.
	If fraction part is 2r0.1, exactly between two consecutive integers, there is a tie.
	The nearest even integer is chosen in this case.
	Examples (First 52bits of mantissa are omitted for brevity):
	2r0.00001 is rounded downward to 2r0
	2r1.00001 is rounded downward to 2r1
	2r0.1 is a tie and rounded to 2r0 (nearest even)
	2r1.1 is a tie and rounded to 2r10 (nearest even)
	2r0.10001 is rounded upward to 2r1
	2r1.10001 is rounded upward to 2r10
	Thus, if the next bit after floating point is 0, the mantissa is left unchanged.
	If next bit after floating point is 1, an odd mantissa is always rounded upper.
	An even mantissa is rounded upper only if the fraction part is not a tie."
	
	"Algorihm details:
	The floating point hardware can perform the rounding correctly with several excess bits as long as there is a single inexact operation.
	This can be obtained by splitting the mantissa plus excess bits in two part with less bits than Float precision.
	Note 1: the inexact flag in floating point hardware must not be trusted because in some cases the operations would be exact but would not take into account some bits that were truncated before the Floating point operations.
	Note 2: the floating point hardware is presumed configured in default rounding mode."
	
	| mantissa shift excess result n |

	"Check how many bits excess the maximum precision of a Float mantissa."
	excess := self highBitOfMagnitude - Float precision.
	excess > 7
		ifTrue:
			["Remove the excess bits but seven."
			mantissa := self bitShiftMagnitude: 7 - excess.
			shift := excess - 7.
			"An even mantissa with a single excess bit immediately following would be truncated.
			But this would not be correct if above shift has truncated some extra bits.
			Check this case, and round excess bits upper manually."
			((mantissa digitAt: 1) = 2r01000000 and: [self anyBitOfMagnitudeFrom: 1 to: shift])
				ifTrue: [mantissa := mantissa + 1]]
		ifFalse:
			[mantissa := self.
			shift := 0].

	"There will be a single inexact round off at last iteration"
	result := (mantissa digitAt: (n := mantissa digitLength)) asFloat.
	[(n := n - 1) > 0] whileTrue: [
		result := 256.0 * result + (mantissa digitAt: n) asFloat].
	^result timesTwoPower: shift.! !

!LargeInteger methodsFor: 'system primitives' stamp: 'ClementBera 7/24/2013 17:04'!
replaceFrom: start to: stop with: replacement startingAt: repStart 
	"Primitive. This destructively replaces elements from start to stop in the receiver starting at index, repStart, in the collection, replacement. Answer the receiver. Range checks are performed in the primitive only. Optional. See Object documentation whatIsAPrimitive."
	<primitive: 105>
	^ super replaceFrom: start to: stop with: replacement startingAt: repStart! !

!LargeInteger methodsFor: 'mathematical functions' stamp: 'ClementBera 7/24/2013 17:04'!
mightBeASquare
	"In base 16, a square number can end only with 0,1,4 or 9 and
	- in case 0, only 0,1,4,9 can precede it,
	- in case 4, only even numbers can precede it.
	See http://en.wikipedia.org/wiki/Square_number
	So, in hex, the last byte must be one of:
		00
		10
		40
		90
		x1
		e4
		x9
	where x is any hex digit and e is any even digit
	Also, the receiver must be an aven power of two."
	| lsb |
	lsb := self digitAt: 1.
	^(lsb = 0 and: [ self lowBit odd ])	"00 (and even power of 2)"
		or: [ lsb = 16r40				"40"
		or: [ (lsb bitAnd: 16r7) = 1		"any|1 or any|9"
		or: [ (lsb bitAnd: 16r1F) = 4		"even|4"
		or: [ (lsb bitAnd: 16r7F) = 16 ]]]]	"10 or 90"! !

!LargeInteger methodsFor: 'arithmetic' stamp: 'ClementBera 7/24/2013 17:03'!
* anInteger 
	"Primitive. Multiply the receiver by the argument and answer with an
	Integer result. Fail if either the argument or the result is not a
	SmallInteger or a LargePositiveInteger less than 2-to-the-30th (1073741824). Optional. See
	Object documentation whatIsAPrimitive. "

	<primitive: 29>
	^super * anInteger! !

!LargeInteger methodsFor: 'arithmetic' stamp: 'ClementBera 7/24/2013 17:03'!
/ anInteger 
	"Primitive. Divide the receiver by the argument and answer with the
	result if the division is exact. Fail if the result is not a whole integer.
	Fail if the argument is 0. Fail if either the argument or the result is not
	a SmallInteger or a LargePositiveInteger less than 2-to-the-30th (1073741824). Optional. See
	Object documentation whatIsAPrimitive. "

	<primitive: 30>
	^super / anInteger! !

!LargeInteger methodsFor: 'comparing' stamp: 'ClementBera 7/24/2013 17:03'!
<= anInteger 
	"Primitive. Compare the receiver with the argument and answer true if
	the receiver is less than or equal to the argument. Otherwise answer false.
	Fail if the argument is not a SmallInteger or a LargePositiveInteger less
	than 2-to-the-30th (1073741824). Optional. See Object documentation whatIsAPrimitive."

	<primitive: 25>
	^super <= anInteger! !

!LargeNegativeInteger commentStamp: '<historical>'!
Just like LargePositiveInteger, but represents a negative number.!
!LargeNegativeInteger methodsFor: 'testing' stamp: 'di 4/23/1998 11:03'!
strictlyPositive
	"Answer whether the receiver is mathematically positive."

	^ false! !

!LargeNegativeInteger methodsFor: 'mathematical functions' stamp: 'nice 7/15/2011 14:06'!
ln
	^DomainError signal: 'ln is only defined for x > 0' from: 0! !

!LargeNegativeInteger methodsFor: 'mathematical functions' stamp: 'jmv 10/13/2011 21:40'!
sqrt
	"Answer the square root of the receiver."
	^ DomainError signal: 'sqrt undefined for number less than zero.'! !

!LargeNegativeInteger methodsFor: 'mathematical functions' stamp: 'nice 7/15/2011 14:06'!
log
	^DomainError signal: 'log is only defined for x > 0' from: 0! !

!LargeNegativeInteger methodsFor: 'arithmetic' stamp: ''!
negated
	^ self copyto: (LargePositiveInteger new: self digitLength)! !

!LargeNegativeInteger methodsFor: 'testing' stamp: 'jm 3/27/98 06:19'!
sign
	"Optimization. Answer -1 since receiver is less than 0."

	^ -1
! !

!LargeNegativeInteger methodsFor: 'testing' stamp: 'di 4/23/1998 11:18'!
negative
	"Answer whether the receiver is mathematically negative."

	^ true! !

!LargeNegativeInteger methodsFor: '*Fuel' stamp: 'MaxLeske 2/17/2014 20:40'!
fuelAccept: aGeneralMapper
	^ self >= -4294967295
		ifTrue: [ aGeneralMapper mapAndTraceByClusterName: self to: FLNegative32SmallIntegerCluster ]
		ifFalse: [ aGeneralMapper visitBytesObject: self]! !

!LargeNegativeInteger methodsFor: 'testing' stamp: 'di 4/23/1998 11:00'!
positive
	"Answer whether the receiver is positive or equal to 0. (ST-80 protocol).
	See also strictlyPositive"

	^ false! !

!LargeNegativeInteger methodsFor: 'bit manipulation' stamp: 'nice 3/21/2008 01:02'!
bitAt: anInteger
	"super would not work because we have to pretend we are in two-complement.
	this has to be tricky..."
	
	| digitIndex bitIndex i |
	digitIndex := anInteger - 1 // 8 + 1.
	digitIndex > self digitLength ifTrue: [^1].
	bitIndex := anInteger - 1 \\ 8 + 1.

	i := 1.
	[i = digitIndex
		ifTrue:
			["evaluate two complement (bitInvert + 1) on the digit :
			(if digitIndex > 1, we must still add 1 due to the carry).
			but x bitInvert is -1-x, bitInvert+1 is just x negated..."
			^(self digitAt: digitIndex) negated bitAt: bitIndex].
	(self digitAt: i) = 0]
		whileTrue: [
			"two complement (bitInvert + 1) raises a carry:
			0 bitInvert -> 2r11111111.  2r11111111 + 1 -> 0 with carry...
			Thus we must inquire one digit forward"
			i := i + 1].
	
	"We escaped the while loop, because there is no more carry.
	Do a simple bitInvert without a carry"
	^1 - ((self digitAt: digitIndex) bitAt: bitIndex)! !

!LargeNegativeInteger methodsFor: 'converting' stamp: 'nice 1/1/2013 15:42'!
asFloat
	^super asFloat negated! !

!LargeNegativeInteger methodsFor: 'converting' stamp: 'ar 5/17/2000 16:10'!
normalize
	"Check for leading zeroes and return shortened copy if so"
	| sLen val len oldLen minVal |
	<primitive: 'primNormalizeNegative' module:'LargeIntegers'>
	"First establish len = significant length"
	len := oldLen := self digitLength.
	[len = 0 ifTrue: [^0].
	(self digitAt: len) = 0]
		whileTrue: [len := len - 1].

	"Now check if in SmallInteger range"
	sLen := 4  "SmallInteger minVal digitLength".
	len <= sLen ifTrue:
		[minVal := SmallInteger minVal.
		(len < sLen
			or: [(self digitAt: sLen) < minVal lastDigit])
			ifTrue: ["If high digit less, then can be small"
					val := 0.
					len to: 1 by: -1 do:
						[:i | val := (val *256) - (self digitAt: i)].
					^ val].
		1 to: sLen do:  "If all digits same, then = minVal"
			[:i | (self digitAt: i) = (minVal digitAt: i)
					ifFalse: ["Not so; return self shortened"
							len < oldLen
								ifTrue: [^ self growto: len]
								ifFalse: [^ self]]].
		^ minVal].

	"Return self, or a shortened copy"
	len < oldLen
		ifTrue: [^ self growto: len]
		ifFalse: [^ self]! !

!LargeNegativeInteger methodsFor: 'arithmetic' stamp: ''!
abs
	^ self negated! !

!LargeNegativeInteger methodsFor: 'bit manipulation' stamp: 'sr 6/8/2000 02:10'!
highBit
	"Answer the index of the high order bit of the receiver, or zero if the  
	receiver is zero. Raise an error if the receiver is negative, since  
	negative integers are defined to have an infinite number of leading 1's 
	in 2's-complement arithmetic. Use >>highBitOfMagnitude if you want to  
	get the highest bit of the magnitude."

	^ self shouldNotImplement! !

!LargeNegativeInteger methodsFor: 'printing' stamp: 'nice 2/15/2008 21:47'!
printOn: aStream base: b
	"Append a representation of this number in base b on aStream."
	
	aStream nextPut: $-.
	self abs printOn: aStream base: b! !

!LargeNegativeIntegerTest commentStamp: 'TorstenBergmann 2/5/2014 08:40'!
SUnit tests for large negative integers!
!LargeNegativeIntegerTest methodsFor: 'tests' stamp: 'StephaneDucasse 5/28/2011 13:52'!
testEmptyTemplate
	"Check that an uninitialized instance behaves reasonably."

	| i |
	i := LargeNegativeInteger new: 4.
	self assert: i size = 4.
	self assert: i printString = '-0'.
	self assert: i normalize = 0! !

!LargePositiveInteger commentStamp: '<historical>'!
I represent positive integers of more than 30 bits (ie, >= 1073741824).  These values are beyond the range of SmallInteger, and are encoded here as an array of 8-bit digits.  Care must be taken, when new values are computed, that any result that COULD BE a SmallInteger IS a SmallInteger (see normalize).

Note that the bit manipulation primitives, bitAnd:, bitShift:, etc., = and ~= run without failure (and therefore fast) if the value fits in 32 bits.  This is a great help to the simulator.!
!LargePositiveInteger methodsFor: 'testing' stamp: 'di 4/23/1998 11:02'!
strictlyPositive
	"Answer whether the receiver is mathematically positive."

	^ true! !

!LargePositiveInteger methodsFor: 'mathematical functions' stamp: 'nice 7/15/2011 14:06'!
ln
	"This function is defined because super ln might overflow."
	| res h |
	res := super ln.
	res isFinite ifTrue: [^res].
	h := self highBit.
	^2 ln * h + (self / (1 << h)) asFloat ln! !

!LargePositiveInteger methodsFor: 'mathematical functions' stamp: 'nice 10/29/2011 15:07'!
sqrt
	"If we know for sure no exact solution exists, then just answer the cheap float approximation without wasting time."
	| selfAsFloat |
	self mightBeASquare
		ifFalse:
			[selfAsFloat := self asFloat.
			selfAsFloat isFinite ifTrue: [^self asFloat sqrt ]].

	"If some exact solution might exist, or self asFloat isInfinite, call potentially expensive super"
	^super sqrt! !

!LargePositiveInteger methodsFor: 'mathematical functions' stamp: 'nice 7/15/2011 14:05'!
log
	"This function is defined because super log might overflow."
	| res h |
	res := super log.
	res isFinite ifTrue: [^res].
	h := self highBit.
	^2 log * h + (self / (1 << h)) asFloat log! !

!LargePositiveInteger methodsFor: 'testing' stamp: 'jm 3/27/98 06:19'!
sign
	"Optimization. Answer 1 since receiver is greater than 0."

	^ 1
! !

!LargePositiveInteger methodsFor: 'arithmetic' stamp: ''!
negated 
	^ (self copyto: (LargeNegativeInteger new: self digitLength))
		normalize  "Need to normalize to catch SmallInteger minVal"! !

!LargePositiveInteger methodsFor: '*Fuel' stamp: 'MarianoMartinezPeck 6/11/2012 22:47'!
fuelAccept: aGeneralMapper
	^ self <= 4294967295 
		ifTrue: [ aGeneralMapper  mapAndTraceByClusterName: self to: FLPositive32SmallIntegerCluster ]
		ifFalse: [ aGeneralMapper visitBytesObject: self]! !

!LargePositiveInteger methodsFor: 'testing' stamp: 'di 4/23/1998 11:18'!
negative
	"Answer whether the receiver is mathematically negative."

	^ false! !

!LargePositiveInteger methodsFor: 'testing' stamp: 'di 4/23/1998 11:00'!
positive
	"Answer whether the receiver is positive or equal to 0. (ST-80 protocol).
	See also strictlyPositive"

	^ true! !

!LargePositiveInteger methodsFor: 'converting' stamp: 'ar 5/17/2000 16:09'!
normalize
	"Check for leading zeroes and return shortened copy if so"
	| sLen val len oldLen |
	<primitive: 'primNormalizePositive' module:'LargeIntegers'>
	"First establish len = significant length"
	len := oldLen := self digitLength.
	[len = 0 ifTrue: [^0].
	(self digitAt: len) = 0]
		whileTrue: [len := len - 1].

	"Now check if in SmallInteger range"
	sLen := SmallInteger maxVal digitLength.
	(len <= sLen
		and: [(self digitAt: sLen) <= (SmallInteger maxVal digitAt: sLen)])
		ifTrue: ["If so, return its SmallInt value"
				val := 0.
				len to: 1 by: -1 do:
					[:i | val := (val *256) + (self digitAt: i)].
				^ val].

	"Return self, or a shortened copy"
	len < oldLen
		ifTrue: [^ self growto: len]
		ifFalse: [^ self]! !

!LargePositiveInteger methodsFor: 'bit manipulation' stamp: 'nice 3/21/2008 00:09'!
bitAt: anInteger
	"Optimize super algorithm to avoid long bit operations.
	Instead work on digits which are known to be SmallInteger and fast.
	Note that this algorithm does not work for negative integers."
	
	| digitIndex bitIndex |
	digitIndex := anInteger - 1 // 8 + 1.
	digitIndex > self digitLength ifTrue: [^0].
	bitIndex := anInteger - 1 \\ 8 + 1.
	^(self digitAt: digitIndex) bitAt: bitIndex! !

!LargePositiveInteger methodsFor: 'arithmetic' stamp: ''!
abs! !

!LargePositiveInteger methodsFor: 'bit manipulation' stamp: 'sr 6/8/2000 02:11'!
highBit
	"Answer the index of the high order bit of the receiver, or zero if the  
	receiver is zero. Raise an error if the receiver is negative, since  
	negative integers are defined to have an infinite number of leading 1's 
	in 2's-complement arithmetic. Use >>highBitOfMagnitude if you want to  
	get the highest bit of the magnitude."
	^ self highBitOfMagnitude! !

!LargePositiveInteger methodsFor: 'printing' stamp: 'CamilloBruni 10/21/2012 14:33'!
printOn: aStream base: b
	"Append a representation of this number in base b on aStream.
	In order to reduce cost of LargePositiveInteger ops, split the number in approximately two equal parts in number of digits."
	
	| halfDigits halfPower head tail nDigitsUnderestimate |
	"Don't engage any arithmetic if not normalized"
	(self digitLength = 0 or: [(self digitAt: self digitLength) = 0]) 
		ifTrue: [ ^self normalize printOn: aStream base: b ].
	
	nDigitsUnderestimate := b = 10
		ifTrue: [((self highBit - 1) * 1233 >> 12) + 1. "This is because (2 log)/(10 log)*4096 is slightly greater than 1233"]
		ifFalse: [self highBit quo: b highBit].
		
	"splitting digits with a whole power of two is more efficient"
	halfDigits := 1 bitShift: nDigitsUnderestimate highBit - 2.
	
	halfDigits <= 1
		ifTrue: ["Hmmm, this could happen only in case of a huge base b... Let lower level fail"
			^self printOn: aStream base: b nDigits: (self numberOfDigitsInBase: b)].
	
	"Separate in two halves, head and tail"
	halfPower := b raisedToInteger: halfDigits.
	head := self quo: halfPower.
	tail := self - (head * halfPower).
	
	"print head"
	head printOn: aStream base: b.
	
	"print tail without the overhead to count the digits"
	tail printOn: aStream base: b nDigits: halfDigits! !

!LargePositiveIntegerTest commentStamp: 'TorstenBergmann 2/5/2014 08:40'!
SUnit tests for large positive integers!
!LargePositiveIntegerTest methodsFor: 'tests' stamp: 'md 3/17/2003 15:20'!
testBitShift

	"Check bitShift from and back to SmallInts"
	
	1 to: 257 do: [:i | self should: [((i bitShift: i) bitShift: 0-i) == i]].! !

!LargePositiveIntegerTest methodsFor: 'tests' stamp: 'StephaneDucasse 5/28/2011 13:34'!
testEmptyTemplate

	"Check that an uninitialized instance behaves reasonably."

	| i |
	i := LargePositiveInteger new: 4.
	self assert: i size = 4.
	self assert: i printString = '0'.
	self assert: i normalize = 0! !

!LargePositiveIntegerTest methodsFor: 'tests' stamp: 'sd 6/5/2005 08:52'!
testMultDicAddSub
	"self run: #testMultDicAddSub"

	| n f f1 |	
	n := 100.
	f := 100 factorial.
	f1 := f*(n+1).
	n timesRepeat: [f1 := f1 - f].
	self assert: (f1 = f). 

	n timesRepeat: [f1 := f1 + f].
	self assert: (f1 // f = (n+1)). 
	self assert: (f1 negated = (Number readFrom: '-' , f1 printString)).! !

!LargePositiveIntegerTest methodsFor: 'tests' stamp: 'nice 3/21/2014 21:57'!
testLargeSqrtFloor
	"This test fails if a careless implementation naivly factors out the power of two (remove the trailing zeroes up to lowBit).
	This was the case in a previous implementation, so this is a non regression test."

	| large root |
	large := (SmallInteger maxVal << 100 + 1) << 100.
	root := large sqrtFloor.
	self assert: root squared <= large.
	 self assert: (root+1) squared > large.! !

!LargePositiveIntegerTest methodsFor: 'tests' stamp: 'sd 6/5/2005 08:53'!
testNormalize
	"self run: #testNormalize"
	"Check normalization and conversion to/from SmallInts"

	self assert: ((SmallInteger maxVal + 1 - 1) == SmallInteger maxVal).
	self assert: (SmallInteger maxVal + 3 - 6) == (SmallInteger maxVal-3).
	self should: ((SmallInteger minVal - 1 + 1) == SmallInteger minVal).
	self assert: (SmallInteger minVal - 3 + 6) == (SmallInteger minVal+3).! !

!Latin1 commentStamp: 'yo 10/19/2004 19:53'!
This class represents the domestic character encoding called ISO-8859-1, also known as Latin-1 used for Most of the Western European Languages.!
!Latin1 class methodsFor: 'private' stamp: 'Alexandre.Bergel 11/20/2008 11:10'!
nextPutRightHalfValue: ascii toStream: aStream withShiftSequenceIfNeededForTextConverterState: state 
	state charSize: 1.
	state g1Leading: 0.
	state g1Size: 1.
	aStream basicNextPutAll: rightHalfSequence.
	aStream basicNextPut: (Character value: ascii)! !

!Latin1 class methodsFor: 'class methods' stamp: 'Alexandre.Bergel 11/20/2008 11:17'!
initialize
	"
	self initialize
"
	compoundTextSequence := String streamContents: 
		[ :s | 
		s nextPut: (Character value: 27).
		s nextPut: $(.
		s nextPut: $B ].
	rightHalfSequence := String streamContents: 
		[ :s | 
		s nextPut: (Character value: 27).
		s nextPut: $-.
		s nextPut: $A ]! !

!Latin1 class methodsFor: 'class methods' stamp: 'Alexandre.Bergel 11/20/2008 11:17'!
emitSequenceToResetStateIfNeededOn: aStream forState: state 
	state g0Leading ~= 0 ifTrue: 
		[ state charSize: 1.
		state g0Leading: 0.
		state g0Size: 1.
		aStream basicNextPutAll: compoundTextSequence ]

	"Actually, G1 state should go back to ISO-8859-1, too."! !

!Latin1 class methodsFor: 'accessing - displaying' stamp: 'nice 11/16/2009 15:36'!
isBreakableAt: index in: text

	| char |
	char := text at: index.
	char = Character space ifTrue: [^ true].
	char = Character cr ifTrue: [^ true].
	char = Character lf ifTrue: [^ true].
	^ false.
! !

!Latin1 class methodsFor: 'character classification' stamp: 'yo 8/28/2004 10:41'!
isLetter: char
	"Answer whether the receiver is a letter."

	^ Unicode isLetter: char.

! !

!Latin1 class methodsFor: 'accessing - displaying' stamp: 'yo 8/18/2003 17:32'!
printingDirection

	^ #right.
! !

!Latin1 class methodsFor: 'class methods' stamp: 'Alexandre.Bergel 11/20/2008 11:17'!
nextPutValue: ascii toStream: aStream withShiftSequenceIfNeededForTextConverterState: state 
	(ascii <= 127 and: [ state g0Leading ~= 0 ]) ifTrue: 
		[ state charSize: 1.
		state g0Leading: 0.
		state g0Size: 1.
		aStream basicNextPutAll: compoundTextSequence.
		aStream basicNextPut: (Character value: ascii).
		^ self ].
	((128 <= ascii and: [ ascii <= 255 ]) and: [ state g1Leading ~= 0 ]) ifTrue: 
		[ ^ self 
			nextPutRightHalfValue: ascii
			toStream: aStream
			withShiftSequenceIfNeededForTextConverterState: state ].
	aStream basicNextPut: (Character value: ascii).
	^ self! !

!Latin1 class methodsFor: 'class methods' stamp: 'yo 8/18/2003 17:32'!
leadingChar

	^ 0.
! !

!Latin1Environment commentStamp: '<historical>'!
This class provides the support for the languages in 'Latin-1' category.  Although we could have different language environments for different languages in the category, so far nobody seriously needed it.
!
!Latin1Environment class methodsFor: 'subclass responsibilities' stamp: 'cami 7/22/2013 18:25'!
systemConverterClass
	Smalltalk os isWin32
		ifTrue: [^ UTF8TextConverter].
 	Smalltalk os isMacOSX
		ifTrue: [ ^ UTF8TextConverter ].
	Smalltalk os isMacOS
		ifTrue: [^MacRomanTextConverter].
       Smalltalk os isUnix
              ifTrue: [^ UTF8TextConverter].
       ^ Latin1TextConverter ! !

!Latin1Environment class methodsFor: 'language methods' stamp: 'yo 1/24/2005 10:00'!
nextPutRightHalfValue: ascii toStream: aStream withShiftSequenceIfNeededForTextConverterState: state

	^ self traditionalCharsetClass nextPutRightHalfValue: ascii toStream: aStream withShiftSequenceIfNeededForTextConverterState: state.
! !

!Latin1Environment class methodsFor: 'subclass responsibilities' stamp: 'yo 2/24/2005 20:41'!
supportedLanguages
	"Return the languages that this class supports. 
	Any translations for those languages will use this class as their environment."
	
	^#('fr' 'es' 'ca' 'eu' 'pt' 'it' 'sq' 'rm' 'nl' 'de' 'da' 'sv' 'no' 'fi' 'fo' 'is' 'ga' 'gd' 'en' 'af' 'sw')! !

!Latin1Environment class methodsFor: 'language methods' stamp: 'yo 1/24/2005 10:00'!
nextPutValue: ascii toStream: aStream withShiftSequenceIfNeededForTextConverterState: state

	^ self traditionalCharsetClass nextPutValue: ascii toStream: aStream withShiftSequenceIfNeededForTextConverterState: state.! !

!Latin1Environment class methodsFor: 'subclass responsibilities' stamp: 'yo 3/17/2004 15:07'!
leadingChar

	^ 0.
! !

!Latin1Environment class methodsFor: 'language methods' stamp: 'yo 1/24/2005 09:59'!
traditionalCharsetClass

	^ Latin1.
! !

!Latin1TextConverter commentStamp: '<historical>'!
Text converter for ISO 8859-1.  An international encoding used in Western Europe.!
!Latin1TextConverter methodsFor: 'conversion' stamp: 'michael.rueger 2/5/2009 14:20'!
unicodeToByte: unicodeChar

	^unicodeChar charCode < 256
		ifTrue: [unicodeChar]
		ifFalse: [0 asCharacter]! !

!Latin1TextConverter methodsFor: 'conversion' stamp: 'michael.rueger 2/5/2009 14:20'!
byteToUnicode: char

	^char! !

!Latin1TextConverter class methodsFor: 'class initialization' stamp: 'SvenVanCaekenberghe 3/7/2012 23:17'!
initializeTables
	"Overwritten to be a noop for Latin1,
	we don't use #byteToUnicodeSpec although we should"! !

!Latin1TextConverter class methodsFor: 'accessing' stamp: 'michael.rueger 2/2/2009 19:31'!
languageEnvironment
	^Latin1Environment! !

!Latin1TextConverter class methodsFor: 'accessing' stamp: 'tbn 1/17/2011 13:04'!
encodingNames 

	^ #('latin-1' 'latin1' 'iso-8859-1') copy.
! !

!Latin1TextConverter class methodsFor: 'accessing' stamp: ''!
byteToUnicodeSpec
	"ByteTextConverter generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/ISO8859/8859-1.TXT'"

	^ #(
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	16r00A0 16r00A1 16r00A2 16r00A3 16r00A4 16r00A5 16r00A6 16r00A7 
	16r00A8 16r00A9 16r00AA 16r00AB 16r00AC 16r00AD 16r00AE 16r00AF 
	16r00B0 16r00B1 16r00B2 16r00B3 16r00B4 16r00B5 16r00B6 16r00B7 
	16r00B8 16r00B9 16r00BA 16r00BB 16r00BC 16r00BD 16r00BE 16r00BF 
	16r00C0 16r00C1 16r00C2 16r00C3 16r00C4 16r00C5 16r00C6 16r00C7 
	16r00C8 16r00C9 16r00CA 16r00CB 16r00CC 16r00CD 16r00CE 16r00CF 
	16r00D0 16r00D1 16r00D2 16r00D3 16r00D4 16r00D5 16r00D6 16r00D7 
	16r00D8 16r00D9 16r00DA 16r00DB 16r00DC 16r00DD 16r00DE 16r00DF 
	16r00E0 16r00E1 16r00E2 16r00E3 16r00E4 16r00E5 16r00E6 16r00E7 
	16r00E8 16r00E9 16r00EA 16r00EB 16r00EC 16r00ED 16r00EE 16r00EF 
	16r00F0 16r00F1 16r00F2 16r00F3 16r00F4 16r00F5 16r00F6 16r00F7 
	16r00F8 16r00F9 16r00FA 16r00FB 16r00FC 16r00FD 16r00FE 16r00FF )! !

!Latin2Environment commentStamp: '<historical>'!
This class provides the support for the languages in 'Latin-2' category.  Although we could have different language environments for different languages in the category, so far nobody seriously needed it.

  I (Yoshiki) don't have good knowledge in these language, so when Pavel Krivanek volunteered to implement the detail, it was a good test to see how flexible my m17n framework was.  There are a few glitches, but with several email conversations over a few days, we managed to make it work relatively painlessly.  I thought this went well.

  There seem that some source of headache, as Windows doesn't exactly use Latin-2 encoded characters, but a little modified version called 'code page 1250'.  Similar to Japanese support, the encode interpreters are swapped based on the type of platform it is running on.

!
!Latin2Environment class methodsFor: 'subclass responsibilities' stamp: 'cami 7/22/2013 18:28'!
systemConverterClass

	Smalltalk os isWin32 
		ifTrue: [^CP1250TextConverter ].

	^ ISO88592TextConverter.
! !

!Latin2Environment class methodsFor: 'subclass responsibilities' stamp: 'yo 1/19/2005 09:16'!
supportedLanguages
	"Return the languages that this class supports. 
	Any translations for those languages will use this class as their environment."
	
	^#('cs' 'hu' 'ro' 'hr' 'sk' 'sl')  "Sorbian languages don't have two char code?"
! !

!Latin2Environment class methodsFor: 'class initialization' stamp: 'StephaneDucasse 8/22/2013 14:32'!
initialize


	EncodedCharSet declareEncodedCharSet: self atIndex: 14+1.! !

!Latin2Environment class methodsFor: 'subclass responsibilities' stamp: 'nice 5/1/2011 19:22'!
leadingChar

	^0! !

!Latin9Environment commentStamp: '<historical>'!
This class provides the support for the languages in 'Latin-9' category.!
!Latin9Environment class methodsFor: 'subclass responsibilities' stamp: 'cami 7/22/2013 18:28'!
systemConverterClass

	Smalltalk os isWin32 
		ifTrue: [^CP1252TextConverter ].

	^ ISO885915TextConverter.
! !

!Latin9Environment class methodsFor: 'subclass responsibilities' stamp: 'pmm 8/16/2010 10:27'!
supportedLanguages
	"Return the languages that this class supports. 
	Any translations for those languages will use this class as their environment."
	
	^#('fr' 'es' 'ca' 'eu' 'pt' 'it' 'sq' 'rm' 'nl' 'de' 'da' 'sv' 'no' 'fi' 'fo' 'is' 'ga' 'gd' 'en' 'af' 'sw')! !

!Latin9Environment class methodsFor: 'class initialization' stamp: 'StephaneDucasse 8/22/2013 14:33'!
initialize

	EncodedCharSet declareEncodedCharSet: self atIndex: 17+1.! !

!Latin9Environment class methodsFor: 'subclass responsibilities' stamp: 'nice 5/1/2011 19:22'!
leadingChar

	^0! !

!LayoutAbstractScope commentStamp: '<historical>'!
Layout scopes reify how classes extend the layout of their superclass.!
!LayoutAbstractScope methodsFor: 'enumerating' stamp: 'MarcusDenker 7/20/2014 15:57'!
indexOf: anElement
	"Answer the index of the first occurrence of anElement within the  
	receiver. If the receiver does not contain anElement, answer 0."

	^ self indexOf: anElement ifAbsent: 0! !

!LayoutAbstractScope methodsFor: 'enumerating' stamp: 'MarcusDenker 7/20/2014 19:05'!
indexOf: anElement ifAbsent: exceptionBlock
	"Answer the index of the first occurence of anElement within the  
	receiver. If the receiver does not contain anElement, answer the 
	result of evaluating the argument, exceptionBlock."

	1 to: self size do:
		[:index |
		(self at: index) = anElement ifTrue: [^ index]].
	^ exceptionBlock value! !

!LayoutAbstractScope methodsFor: 'comparing' stamp: 'MartinDias 4/12/2013 13:29'!
hash
	^ self class hash! !

!LayoutAbstractScope methodsFor: 'accessing' stamp: 'ToonVerwaest 4/1/2011 14:04'!
atName: aName ifAbsent: aBlock
	self allSlotsDo: [ :slot | 
		slot name == aName ifTrue: [ ^ slot ]].
	^ aBlock value! !

!LayoutAbstractScope methodsFor: 'reshaping' stamp: 'MartinDias 4/4/2013 20:40'!
rebase: originalScope to: newScope
	self error: 'Should not happen'! !

!LayoutAbstractScope methodsFor: 'enumerating' stamp: 'ToonVerwaest 4/2/2011 14:27'!
allSlotsDo: aBlock
	self subclassResponsibility! !

!LayoutAbstractScope methodsFor: 'accessing' stamp: 'CamilloBruni 4/6/2011 14:25'!
ownFieldSize
	self subclassResponsibility! !

!LayoutAbstractScope methodsFor: 'accessing' stamp: 'CamilloBruni 4/4/2011 13:03'!
atName: aName
	^ self atName: aName ifAbsent: [ SlotNotFound signalForName: aName ].! !

!LayoutAbstractScope methodsFor: 'enumerating' stamp: 'CamilloBruni 4/4/2011 14:30'!
allSlotsReverseDo: aBlock
	self subclassResponsibility! !

!LayoutAbstractScope methodsFor: 'extending' stamp: 'MarcusDenker 1/19/2015 15:42'!
extend: someSlots as: type
	| scope fieldIndex currentParentScope nextParentScope |
	scope := type new: someSlots size.
	fieldIndex := self firstFieldIndex.
	currentParentScope := self.
	
	someSlots withIndexDo: [ :slot :slotIndex | |realSlot|
		realSlot := slot asSlot.
		nextParentScope := realSlot parentScopeFor: currentParentScope.
		nextParentScope == currentParentScope
			ifFalse: [
				currentParentScope := nextParentScope.
				fieldIndex := fieldIndex + currentParentScope ownFieldSize].
		realSlot isVirtual ifFalse: [realSlot index: fieldIndex].
		fieldIndex := fieldIndex + realSlot size.
		scope at: slotIndex put: realSlot ].
	
	scope parentScope: currentParentScope.
	^ scope! !

!LayoutAbstractScope methodsFor: 'testing' stamp: 'ToonVerwaest 4/2/2011 14:29'!
hasFields
	self subclassResponsibility! !

!LayoutAbstractScope methodsFor: 'accessing' stamp: 'MartinDias 2/10/2015 16:56'!
atName: aName ifFound: foundBlock ifNone: exceptionBlock
	self allSlotsDo: [ :slot | 
		slot name == aName ifTrue: [ ^ foundBlock cull: slot ]].
	^ exceptionBlock value
	! !

!LayoutAbstractScope methodsFor: 'testing' stamp: 'ToonVerwaest 4/2/2011 14:29'!
hasSlots
	self subclassResponsibility! !

!LayoutAbstractScope methodsFor: 'testing' stamp: 'CamilleTeruel 9/22/2014 14:28'!
ifNotEmpty: aBlock
	self subclassResponsibility! !

!LayoutAbstractScope methodsFor: 'comparing' stamp: 'MartinDias 4/12/2013 13:29'!
= other
	^ self class = other class! !

!LayoutAbstractScope methodsFor: 'extending' stamp: 'ToonVerwaest 4/2/2011 14:25'!
extend: someSlots
	^ self extend: someSlots as: LayoutClassScope! !

!LayoutAbstractScope methodsFor: 'accessing' stamp: 'ToonVerwaest 4/2/2011 14:27'!
fieldSize
	self subclassResponsibility! !

!LayoutAbstractScope methodsFor: 'accessing' stamp: 'MarcusDenker 6/24/2014 17:45'!
visibleSlotNames
	^self visibleSlots collect: [:each | each name ]! !

!LayoutAbstractScope methodsFor: 'enumerating' stamp: 'CamilloBruni 4/4/2011 18:31'!
withParentScopesDo: aBlock
	self subclassResponsibility! !

!LayoutAbstractScope methodsFor: 'flattening' stamp: 'ToonVerwaest 4/2/2011 14:28'!
flatten
	self subclassResponsibility! !

!LayoutAbstractScope methodsFor: 'extending' stamp: 'CamilloBruni 7/17/2013 13:49'!
extend
	^ self extend: { }! !

!LayoutAbstractScope methodsFor: 'accessing' stamp: 'ToonVerwaest 4/2/2011 18:33'!
firstFieldIndex
	^ self fieldSize + 1! !

!LayoutAbstractScope methodsFor: 'accessing' stamp: 'MarcusDenker 6/24/2014 17:45'!
visibleSlots
	self subclassResponsibility! !

!LayoutCell commentStamp: '<historical>'!
I am used in table layouts to hold temporary values while the layout is being computed.

Instance variables:
	target 		<Morph>		The morph contained in this cell
	cellSize 		<Point>		The size of the cell
	extraSpace 	<nil | Point>	Additional space to add after this cell
	nextCell 	<nil | LayoutCell>	The next cell in the arrangement.

Implementation note:
Both, cellSize and extraSpace contains points where
	x - represents the primary table direction
	y - represents the secondary table direction
!
!LayoutCell methodsFor: 'accessing' stamp: 'ls 8/5/2004 16:48'!
hSpaceFill
	^self flags anyMask: 1! !

!LayoutCell methodsFor: 'accessing' stamp: 'ar 11/10/2000 17:09'!
extraSpace
	^extraSpace ifNil:[0@0]! !

!LayoutCell methodsFor: 'accessing' stamp: 'dgd 2/22/2003 14:09'!
size
	| n cell |
	n := 0.
	cell := self.
	[cell isNil] whileFalse: 
			[n := n + 1.
			cell := cell nextCell].
	^n! !

!LayoutCell methodsFor: 'accessing' stamp: 'ar 10/28/2000 18:12'!
cellSize: aPoint
	cellSize := aPoint! !

!LayoutCell methodsFor: 'accessing' stamp: 'ls 8/5/2004 16:48'!
hSpaceFill: aBool
	flags := aBool ifTrue:[self flags bitOr: 1] ifFalse:[self flags bitClear: 1].
! !

!LayoutCell methodsFor: 'accessing' stamp: 'ar 10/28/2000 18:12'!
nextCell
	^nextCell! !

!LayoutCell methodsFor: 'accessing' stamp: 'ls 8/5/2004 16:47'!
vSpaceFill
	^self flags anyMask: 2! !

!LayoutCell methodsFor: 'accessing' stamp: 'ar 10/28/2000 18:12'!
cellSize
	^cellSize! !

!LayoutCell methodsFor: 'accessing' stamp: 'ar 10/28/2000 18:12'!
nextCell: aCell
	nextCell := aCell! !

!LayoutCell methodsFor: 'accessing' stamp: 'ls 8/5/2004 16:48'!
vSpaceFill: aBool
	flags := aBool ifTrue:[self flags bitOr: 2] ifFalse:[self flags bitClear: 2].
! !

!LayoutCell methodsFor: 'collection' stamp: 'ar 10/28/2000 18:58'!
do: aBlock
	aBlock value: self.
	nextCell ifNotNil:[nextCell do: aBlock].! !

!LayoutCell methodsFor: 'accessing' stamp: 'ar 10/28/2000 21:30'!
extraSpace: aPoint
	extraSpace := aPoint! !

!LayoutCell methodsFor: 'collection' stamp: 'ar 10/28/2000 21:27'!
inject: thisValue into: binaryBlock 
	"Accumulate a running value associated with evaluating the argument, 
	binaryBlock, with the current value of the argument, thisValue, and the 
	receiver as block arguments. For instance, to sum the numeric elements 
	of a collection, aCollection inject: 0 into: [:subTotal :next | subTotal + 
	next]."

	| nextValue |
	nextValue := thisValue.
	self do: [:each | nextValue := binaryBlock value: nextValue value: each].
	^nextValue! !

!LayoutCell methodsFor: 'accessing' stamp: 'ls 8/5/2004 16:47'!
flags
	^flags ifNil: [ 0 ]! !

!LayoutCell methodsFor: 'accessing' stamp: 'ar 11/2/2000 17:15'!
addExtraSpace: aPoint
	extraSpace 
		ifNil:[extraSpace := aPoint]
		ifNotNil:[extraSpace := extraSpace + aPoint]! !

!LayoutCell methodsFor: 'accessing' stamp: 'ar 10/28/2000 18:11'!
target
	^target! !

!LayoutCell methodsFor: 'accessing' stamp: 'ar 10/28/2000 18:12'!
target: newTarget
	target := newTarget! !

!LayoutClassScope commentStamp: '<historical>'!
I am layout scope for classes.!
!LayoutClassScope methodsFor: 'comparing' stamp: 'MartinDias 4/12/2013 13:34'!
hash
	| hash |
	hash := super hash.
	1 to: self size do: [ :i | 
		hash := (hash + (self at: i) hash) hashMultiply].
	^ hash bitXor: self parentScope hash.! !

!LayoutClassScope methodsFor: 'reshaping' stamp: 'MarcusDenker 1/19/2015 15:43'!
rebase: originalScope to: newScope
	| newParent result fieldIndex |
	newParent := parentScope == originalScope
		ifTrue: [ newScope ]
		ifFalse: [ parentScope rebase: originalScope to: newScope ].
		
	result := self copy.
	result parentScope: newParent.
	
	fieldIndex := newParent firstFieldIndex.
	result do: [ :slot | 
		slot isVirtual ifFalse: [slot index: fieldIndex].
		fieldIndex := fieldIndex + slot size ].
	
	^ result
	! !

!LayoutClassScope methodsFor: 'enumerating' stamp: 'ToonVerwaest 4/1/2011 02:11'!
allSlotsDo: aBlock
	parentScope allSlotsDo: aBlock.
	self do: aBlock! !

!LayoutClassScope methodsFor: 'accessing' stamp: 'CamilloBruni 4/6/2011 14:26'!
ownFieldSize
	|result|
	result := 0.
	self do: [ :slot | result := result + slot size ].
	^ result! !

!LayoutClassScope methodsFor: 'testing' stamp: 'CamilloBruni 4/4/2011 12:48'!
hasFields
	self do: [ :slot | 
		slot size > 0 
			ifTrue: [ ^ true ]].
	^ parentScope hasFields! !

!LayoutClassScope methodsFor: 'enumerating' stamp: 'CamilloBruni 4/4/2011 14:30'!
allSlotsReverseDo: aBlock
	self reverseDo: aBlock.
	parentScope allSlotsReverseDo: aBlock.! !

!LayoutClassScope methodsFor: 'accessing' stamp: 'MartinDias 4/12/2013 13:35'!
parentScope: aLayoutScope
	parentScope := aLayoutScope! !

!LayoutClassScope methodsFor: 'enumerating' stamp: 'CamilloBruni 10/16/2011 20:08'!
withIndexDo: elementAndIndexBlock 
	"Just like with:do: except that the iteration index supplies the second argument to the block."
	1 to: self size do:
		[:index |
		elementAndIndexBlock
			value: (self at: index)
			value: index]! !

!LayoutClassScope methodsFor: 'accessing' stamp: 'MarcusDenker 6/25/2014 13:00'!
slots
	| result |
	result := OrderedCollection new.
	self do: [ :slot |  result add: slot].
	^ result asArray! !

!LayoutClassScope methodsFor: 'testing' stamp: 'CamilloBruni 4/4/2011 12:48'!
hasSlots
	self size > 0 
		ifTrue: [ ^ true ].
	^ parentScope hasSlots! !

!LayoutClassScope methodsFor: 'testing' stamp: 'CamilleTeruel 9/22/2014 14:29'!
ifNotEmpty: aBlock
	"This scope is not empty so we evaluate the block"
	aBlock value: self! !

!LayoutClassScope methodsFor: 'comparing' stamp: 'MartinDias 4/12/2013 13:31'!
= other
	super = other
		ifFalse: [ ^ false ].
	
	self size = other size
		ifFalse: [ ^ false ].
	
	1 to: self size do:  [ :index|
		(self at: index) = (other at: index)
			ifFalse: [ ^ false ]].
	
	^ self parentScope = other parentScope.! !

!LayoutClassScope methodsFor: 'enumerating' stamp: 'ToonVerwaest 4/1/2011 02:10'!
do: aBlock
	1 to: self size do: [ :index |
		aBlock value: (self at: index) ]! !

!LayoutClassScope methodsFor: 'accessing' stamp: 'CamilloBruni 4/6/2011 14:25'!
fieldSize
	^ parentScope fieldSize + self ownFieldSize.! !

!LayoutClassScope methodsFor: 'copying' stamp: 'ToonVerwaest 4/2/2011 18:26'!
postCopy
	parentScope := parentScope copy.
	1 to: self size do: [ :index | 
		self at: index put: (self at: index) copy ]! !

!LayoutClassScope methodsFor: 'enumerating' stamp: 'CamilloBruni 4/4/2011 14:49'!
reverseDo: aBlock
	|size|
	size := self size.
	1 to: size do: [ :index |
		aBlock value: (self at: (1 + size - index)) ]! !

!LayoutClassScope methodsFor: 'flattening' stamp: 'ToonVerwaest 4/1/2011 01:56'!
flatten
	| result |
	result := parentScope flatten.
	result addAll: self.
	^ result! !

!LayoutClassScope methodsFor: 'enumerating' stamp: 'CamilloBruni 4/4/2011 18:31'!
withParentScopesDo: aBlock
	aBlock value: self.
	parentScope withParentScopesDo: aBlock.! !

!LayoutClassScope methodsFor: 'printing' stamp: 'MartinDias 9/5/2013 15:49'!
printOn: aStream
	
	super printOn: aStream.
	self allVisibleSlots printElementsOn: aStream.! !

!LayoutClassScope methodsFor: 'accessing' stamp: 'MarcusDenker 6/24/2014 17:24'!
visibleSlots
	| result |
	result := OrderedCollection new.
	self do: [ :slot | 
		slot isVisible 
			ifTrue: [ result add: slot ]].
	^ result asArray! !

!LayoutClassScope methodsFor: 'accessing' stamp: 'MartinDias 4/12/2013 13:48'!
parentScope
	^ parentScope! !

!LayoutClassScope methodsFor: 'accessing' stamp: 'CamilloBruni 4/4/2011 12:48'!
allVisibleSlots
	| result |
	result := parentScope allVisibleSlots.
	self do: [ :slot | 
		slot isVisible 
			ifTrue: [ result add: slot ]].
	^ result! !

!LayoutClassScope methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 1/22/2015 22:24'!
slotsDictionary
	| result |
	result := Dictionary new.
	self allSlotsDo: [ :slot |  result at: slot name put: slot].
	^ result! !

!LayoutEmptyScope commentStamp: '<historical>'!
I am the last layout scope in a scope chain.!
!LayoutEmptyScope methodsFor: 'testing' stamp: 'ToonVerwaest 4/2/2011 14:33'!
hasSlots
	^ false! !

!LayoutEmptyScope methodsFor: 'testing' stamp: 'CamilleTeruel 9/22/2014 14:27'!
ifNotEmpty: aBlock
	"This scope is empty so we do nothing"! !

!LayoutEmptyScope methodsFor: 'accessing' stamp: 'ToonVerwaest 4/2/2011 14:31'!
fieldSize
	^ 0! !

!LayoutEmptyScope methodsFor: 'enumerating' stamp: 'CamilloBruni 4/4/2011 18:31'!
withParentScopesDo: aBlock
	aBlock value: self.! !

!LayoutEmptyScope methodsFor: 'enumerating' stamp: 'ToonVerwaest 4/2/2011 14:32'!
allSlotsDo: aBlock! !

!LayoutEmptyScope methodsFor: 'accessing' stamp: 'CamilloBruni 4/6/2011 14:26'!
ownFieldSize
	^ 0! !

!LayoutEmptyScope methodsFor: 'testing' stamp: 'ToonVerwaest 4/2/2011 14:33'!
hasFields
	^ false! !

!LayoutEmptyScope methodsFor: 'enumerating' stamp: 'CamilloBruni 4/4/2011 14:30'!
allSlotsReverseDo: aBlock! !

!LayoutEmptyScope methodsFor: 'flattening' stamp: 'ToonVerwaest 4/2/2011 14:32'!
flatten
	^ OrderedCollection new! !

!LayoutEmptyScope methodsFor: 'accessing' stamp: 'ToonVerwaest 4/2/2011 19:08'!
allVisibleSlots
	^ OrderedCollection new! !

!LayoutEmptyScope methodsFor: 'accessing' stamp: 'MarcusDenker 6/24/2014 17:46'!
visibleSlots
	^ #()! !

!LayoutEmptyScope class methodsFor: 'accessing' stamp: 'ToonVerwaest 4/1/2011 01:31'!
instance
	^ instance ifNil: [ instance := self new ]! !

!LayoutFrame commentStamp: '<historical>'!
I define a transformation frame relative to some rectangle. I'm basic data structure used for graphics.


Instance variables:
	leftFraction 
	topFraction 
	rightFraction 
	bottomFraction 	<Float>		The fractional distance (between 0 and 1) to place the morph in its owner's bounds
	leftOffset 
	topOffset 
	rightOffset 
	bottomOffset 	<Integer>	Fixed pixel offset to apply after fractional positioning (e.g., "10 pixel right of the center of the owner")!
!LayoutFrame methodsFor: 'accessing' stamp: 'ar 10/23/2000 19:35'!
bottomOffset
	^bottomOffset! !

!LayoutFrame methodsFor: 'accessing' stamp: 'ar 10/23/2000 19:35'!
bottomFraction
	^bottomFraction! !

!LayoutFrame methodsFor: 'accessing' stamp: 'ar 10/23/2000 19:36'!
rightOffset
	^rightOffset! !

!LayoutFrame methodsFor: 'accessing' stamp: 'ar 10/23/2000 19:36'!
topFraction
	^topFraction! !

!LayoutFrame methodsFor: 'accessing' stamp: 'ar 10/23/2000 19:35'!
leftFraction: aNumber offset: anInteger

	leftFraction := aNumber.
	leftOffset := anInteger! !

!LayoutFrame methodsFor: 'objects from disk' stamp: 'StephaneDucasse 12/24/2012 16:52'!
negateBottomRightOffsets

	bottomOffset := bottomOffset negated.
	rightOffset := rightOffset negated.

! !

!LayoutFrame methodsFor: 'accessing' stamp: 'IgorStasenko 12/18/2012 16:50'!
bottomRightOffset: aPoint

	bottomOffset := aPoint y.
	rightOffset := aPoint x.! !

!LayoutFrame methodsFor: 'accessing' stamp: 'ar 10/23/2000 19:35'!
bottomOffset: anInteger
	bottomOffset := anInteger! !

!LayoutFrame methodsFor: 'initialization' stamp: 'IgorStasenko 12/18/2012 16:58'!
initialize
	"initialize defaults:
	 - all offsets are zero
	 - fraction frame is maximum"
	leftOffset := rightOffset := topOffset := bottomOffset := 0.
	
	leftFraction := topFraction := 0.
	rightFraction := bottomFraction := 1.! !

!LayoutFrame methodsFor: 'accessing' stamp: 'ar 10/23/2000 19:36'!
rightOffset: anInteger
	rightOffset := anInteger! !

!LayoutFrame methodsFor: 'printing' stamp: 'BenjaminVanRyseghem 1/15/2013 11:08'!
printOn: aStream

	super printOn: aStream.
	aStream nextPutAll: ' ( '.
	aStream
		print: self leftFraction @ self topFraction; 
		nextPutAll: ' + ';
		print: self leftOffset  @ self topOffset ;
		nextPutAll: 'px corner: ';
		print: self rightFraction @ self bottomFraction; 
		nextPutAll: ' + ';
		print: self rightOffset  @ self bottomOffset ;
		nextPutAll: 'px ) '! !

!LayoutFrame methodsFor: 'converting' stamp: 'StephaneDucasse 12/21/2012 13:52'!
asLayoutFrame
	 ^self! !

!LayoutFrame methodsFor: 'accessing' stamp: 'ar 10/23/2000 19:37'!
topOffset: anInteger
	topOffset := anInteger! !

!LayoutFrame methodsFor: 'accessing' stamp: 'IgorStasenko 12/18/2012 16:50'!
topLeftOffset: aPoint

	topOffset := aPoint y.
	leftOffset := aPoint x.! !

!LayoutFrame methodsFor: 'accessing' stamp: 'StephaneDucasse 12/21/2012 13:14'!
fromArray: anArray
	| str |
	str := anArray readStream.
	
	#( leftFraction: topFraction: rightFraction: bottomFraction: leftOffset: topOffset: rightOffset: bottomOffset: ) do: [:sel |
		str next ifNil: [ ^ self ] ifNotNil: [:value | self perform: sel with: value ]	
	 ]! !

!LayoutFrame methodsFor: 'accessing' stamp: 'ar 10/23/2000 19:35'!
bottomFraction: aNumber
	bottomFraction := aNumber! !

!LayoutFrame methodsFor: 'transforming' stamp: 'Sd 8/2/2014 16:11'!
transform: outerReferenceRectangle
	"Answer a new rectangle which transformed by receiver relative to outerReferenceRectangle.
	If it is not possible to place a outerReferenceRectangle *inside*  this reference rectangle, then result will be zero-width (or zero-height) rectangle. Basically you transform to obtain a subrectangle area inside the reference rectangle"
	
	|  left right top bottom |
	left := (outerReferenceRectangle left + (outerReferenceRectangle width * leftFraction) + leftOffset) rounded asInteger.
	right := (outerReferenceRectangle right - (outerReferenceRectangle width * (1 - rightFraction)) + rightOffset) rounded asInteger.
	top:= (outerReferenceRectangle top + (outerReferenceRectangle height * topFraction) + topOffset ) rounded asInteger.
	bottom:= (outerReferenceRectangle bottom - (outerReferenceRectangle height * (1 - bottomFraction)) + bottomOffset) rounded asInteger. 
	
	right < left ifTrue: [ right := left ].
	bottom < top ifTrue: [ bottom := top ].
	
	^ Rectangle left: left right: right top: top bottom: bottom! !

!LayoutFrame methodsFor: 'accessing' stamp: 'ar 10/23/2000 19:35'!
bottomFraction: aNumber offset: anInteger

	bottomFraction := aNumber.
	bottomOffset := anInteger! !

!LayoutFrame methodsFor: 'accessing' stamp: 'ar 10/23/2000 19:35'!
leftOffset
	^leftOffset! !

!LayoutFrame methodsFor: '*Spec-MorphicAdapters' stamp: 'BenjaminVanRyseghem 4/1/2014 12:55'!
isHorizontallyResizeable

	^ self rightFraction ~= self leftFraction! !

!LayoutFrame methodsFor: 'accessing' stamp: 'ar 10/23/2000 19:36'!
leftOffset: anInteger
	leftOffset := anInteger! !

!LayoutFrame methodsFor: 'accessing' stamp: 'ar 10/23/2000 19:37'!
topFraction: aNumber offset: anInteger

	topFraction := aNumber.
	topOffset := anInteger! !

!LayoutFrame methodsFor: 'converting' stamp: 'StephaneDucasse 12/24/2012 17:03'!
asArray
	 
	^ { leftFraction . 
		topFraction .
		rightFraction .
		bottomFraction .	
		leftOffset .
		topOffset .
		rightOffset .
		bottomOffset } ! !

!LayoutFrame methodsFor: 'accessing' stamp: ''!
fractions: fractionsOrNil offsets: offsetsOrNil

	| fractions offsets |

	fractions := fractionsOrNil ifNil: [0@0 extent: 0@0].
	offsets := offsetsOrNil ifNil: [0@0 extent: 0@0].
	
	^self
		topFraction: fractions top offset: offsets top;
		leftFraction: fractions left offset: offsets left;
		bottomFraction: fractions bottom offset: offsets bottom;
		rightFraction: fractions right offset: offsets right
! !

!LayoutFrame methodsFor: '*Spec-Core' stamp: 'BenjaminVanRyseghem 1/15/2013 11:32'!
generateSpec

	^ self asArray generateSpec! !

!LayoutFrame methodsFor: 'accessing' stamp: 'StephaneDucasse 12/27/2012 22:44'!
fractionRectangle
	"Return a rectangle representing the fraction part of layout frame: i.e left@top corner: right@bottom"
	
	^ leftFraction @ topFraction corner: rightFraction @ bottomFraction ! !

!LayoutFrame methodsFor: 'accessing' stamp: 'bvr 6/1/2012 15:43'!
fractions: fractionsOrNil

	^ self fractions: fractionsOrNil offsets: nil! !

!LayoutFrame methodsFor: 'accessing' stamp: 'ar 10/23/2000 19:36'!
topFraction: aNumber
	topFraction := aNumber! !

!LayoutFrame methodsFor: 'testing' stamp: 'StephaneDucasse 12/27/2012 18:30'!
hasNoOffsets

	^ leftOffset = 0 and: [rightOffset = 0  and: [ topOffset = 0 and: [ bottomOffset = 0 ]]].
	! !

!LayoutFrame methodsFor: 'layout' stamp: 'StephaneDucasse 5/31/2013 16:19'!
center: targetMorph with: anotherMorph
	"Change the receiver to center the targetMorph with anotherMorph. 
	Note the targetMorph is the morph on which the receiver will be applied.
	anotherMorph is often the morph containing the targetMorph. 
	"
	
	self topOffset: (anotherMorph height - targetMorph height) // 2.
	self leftOffset: (anotherMorph width - targetMorph width) // 2.
	! !

!LayoutFrame methodsFor: 'accessing' stamp: 'ar 10/23/2000 19:36'!
rightFraction
	^rightFraction! !

!LayoutFrame methodsFor: '*Polymorph-Widgets-override' stamp: 'StephaneDucasse 12/24/2012 16:56'!
minExtentFrom: minExtent
	"Return the minimal extent the given bounds can be represented in."
	
	| width height widthProp heightProp |
	"calculate proportional area. bottom/right offsets extend in +ve direction."
	width := minExtent x + leftOffset - rightOffset.
	height := minExtent y + topOffset - bottomOffset.
	"calculate the effective proportion"
	widthProp := rightFraction - leftFraction.
	heightProp := bottomFraction - topFraction.
	"if the proportions are 0 then the minima cannot be determined and
	minExtent cannot be respected."
	width := widthProp = 0
		ifTrue: [0]
		ifFalse: [width / widthProp].
	height := heightProp = 0
		ifTrue: [0]
		ifFalse: [height / heightProp].
	^width truncated @ height truncated! !

!LayoutFrame methodsFor: 'accessing' stamp: 'ar 10/23/2000 19:35'!
leftFraction: aNumber
	leftFraction := aNumber! !

!LayoutFrame methodsFor: 'accessing' stamp: 'ar 10/23/2000 19:37'!
topOffset
	^topOffset! !

!LayoutFrame methodsFor: 'layout' stamp: 'StephaneDucasse 12/21/2012 18:43'!
layout: oldBounds in: newBounds
	"Return the proportional rectangle insetting the given bounds"

	^ self transform: newBounds ! !

!LayoutFrame methodsFor: 'printing' stamp: 'StephaneDucasse 12/24/2012 18:26'!
isSelfEvaluating
	^ false! !

!LayoutFrame methodsFor: 'accessing' stamp: 'ar 10/23/2000 19:35'!
leftFraction
	^leftFraction! !

!LayoutFrame methodsFor: 'accessing' stamp: 'ar 10/23/2000 19:36'!
rightFraction: aNumber offset: anInteger

	rightFraction := aNumber.
	rightOffset := anInteger! !

!LayoutFrame methodsFor: '*Spec-MorphicAdapters' stamp: 'BenjaminVanRyseghem 4/1/2014 12:55'!
isVerticallyResizeable

	^ self bottomFraction ~= self topFraction! !

!LayoutFrame methodsFor: 'accessing' stamp: 'ar 10/23/2000 19:36'!
rightFraction: aNumber
	rightFraction := aNumber! !

!LayoutFrame class methodsFor: 'instance creation' stamp: 'StephaneDucasse 12/19/2012 15:56'!
identity
	"by default a layout frame is initialized to represent the identity transformation"
	^ self new! !

!LayoutFrame class methodsFor: 'instance creation' stamp: 'ar 2/5/2002 20:06'!
offsets: offsetsOrNil
	^self fractions: nil offsets: offsetsOrNil! !

!LayoutFrame class methodsFor: 'instance creation' stamp: 'ar 2/5/2002 00:07'!
fractions: fractionsOrNil
	^self fractions: fractionsOrNil offsets: nil! !

!LayoutFrame class methodsFor: 'instance creation' stamp: 'RAA 1/8/2001 21:22'!
fractions: fractionsOrNil offsets: offsetsOrNil

	| fractions offsets |

	fractions := fractionsOrNil ifNil: [0@0 extent: 0@0].
	offsets := offsetsOrNil ifNil: [0@0 extent: 0@0].
	^self new
		topFraction: fractions top offset: offsets top;
		leftFraction: fractions left offset: offsets left;
		bottomFraction: fractions bottom offset: offsets bottom;
		rightFraction: fractions right offset: offsets right
! !

!LayoutFrameTest commentStamp: 'TorstenBergmann 9/5/2014 17:07'!
SUnit tests for class LayoutFrame!
!LayoutFrameTest methodsFor: 'tests - conversion' stamp: 'BenjaminVanRyseghem 1/15/2013 11:14'!
testAsLayoutFrame
	| frame |
	
	frame := #(0.66 0.5 1 0.77 1 2 3 25) asLayoutFrame.
	self assert: frame leftFraction equals: 0.66.
	self assert: frame topFraction equals: 0.5.
	self assert: frame leftOffset equals: 1.
	self assert: frame topOffset equals: 2.
	
	self assert: frame rightFraction equals: 1.
	self assert: frame bottomFraction equals: 0.77.
	self assert: frame rightOffset equals: 3.
	self assert: frame bottomOffset equals: 25.! !

!LayoutFrameTest methodsFor: 'tests' stamp: 'StephaneDucasse 12/21/2012 11:23'!
testLeftTopAligned
	| lf rectangle |
	lf := LayoutFrame new
		leftOffset: 10;
		topOffset: 10;
		rightFraction: 0 offset: 60;
		bottomFraction: 0 offset: 25;
		yourself.
	rectangle := lf layout: nil in: (50@10 corner: 150@70).
	self assert: (60@20 corner: 110@35) = rectangle! !

!LayoutFrameTest methodsFor: 'tests' stamp: 'Sd 8/2/2014 16:15'!
testTransformReturnASubArea
	"the transform: operation is transforming a layoutFrame relatively to the reference rectangle: basically you transform to obtain a subrectangle area inside the reference rectangle"

	| lf rectangle refRectangle |
	lf := LayoutFrame new
			leftOffset: 10;
			topOffset: 10;
			rightOffset: -10;
			bottomOffset: -10;
			yourself.
	refRectangle := 0@0 extent: 100@200.
	rectangle := lf transform: refRectangle.
	self assert: rectangle width = 80.
	self assert: rectangle height = 180.! !

!LayoutFrameTest methodsFor: 'tests' stamp: 'StephaneDucasse 4/28/2010 22:18'!
testRightBottomQuadrant
	| lf rectangle |
	lf := LayoutFrame new
			leftFraction: 1/2 offset: 1;
			topFraction: 1/2 offset: 1;
			rightFraction: 1 offset: -2;
			bottomFraction: 1 offset: -2;
			yourself.
	rectangle := lf layout: nil in: (50@10 corner: 150@70).
	self assert: (101@41 corner: 148@68) = rectangle! !

!LayoutFrameTest methodsFor: 'tests' stamp: 'Sd 8/2/2014 16:10'!
testTransform
	"the transform: operation is transforming a layoutFrame relatively to the reference rectangle: basically you transform to obtain a subrectangle area inside the reference rectangle"

	| lf rectangle |
	lf := LayoutFrame new
			leftOffset: 10;
			topOffset: 10;
			rightOffset: -10;
			bottomOffset: -10;
			yourself.
	rectangle := lf layout: nil in: (50@10 corner: 150@70).
	self assert: (60@20 corner: 140@60) = rectangle! !

!LayoutFrameTest methodsFor: 'tests' stamp: 'StephaneDucasse 12/21/2012 11:24'!
testSpaceFill
	| lf rectangle |
	lf := LayoutFrame identity.
	rectangle := lf layout: nil in: (50@10 corner: 150@70).
	self assert: (50@10 corner: 150@70) = rectangle! !

!LayoutFrameTest methodsFor: 'tests' stamp: 'Sd 8/2/2014 16:14'!
testTransformReturnEmptyRectangleWhenNotPossibleToPlace
	"the transform: operation is transforming a layoutFrame relatively to the reference rectangle: basically you transform to obtain a subrectangle area inside the reference rectangle"

	| lf rectangle refRectangle |
	lf := LayoutFrame new
			leftOffset: 10;
			topOffset: 10;
			rightOffset: -10;
			bottomOffset: -10;
			yourself.
	refRectangle := 0@0 extent: 10@10.
	rectangle := lf transform: refRectangle.
	self assert: rectangle width = 0.
	self assert: rectangle height = 0.! !

!LayoutFrameTest methodsFor: 'tests' stamp: 'StephaneDucasse 12/21/2012 11:23'!
testInset
	| lf rectangle |
	lf := LayoutFrame new
			leftOffset: 10;
			topOffset: 10;
			rightOffset: -10;
			bottomOffset: -10;
			yourself.
	rectangle := lf layout: nil in: (50@10 corner: 150@70).
	self assert: (60@20 corner: 140@60) = rectangle! !

!LayoutPolicy commentStamp: '<historical>'!
A LayoutPolicy defines how submorphs of some morph should be arranged. Subclasses of the receiver define concrete layout policies.!
!LayoutPolicy methodsFor: 'layout' stamp: 'ar 10/31/2000 19:59'!
minExtentOf: aMorph in: newBounds
	"Return the minimal size aMorph's children would require given the new bounds"
	^0@0! !

!LayoutPolicy methodsFor: 'testing' stamp: 'ar 10/29/2000 01:28'!
isTableLayout
	^false! !

!LayoutPolicy methodsFor: 'layout' stamp: 'ar 10/28/2000 19:12'!
layout: aMorph in: newBounds
	"Compute the layout for the given morph based on the new bounds"
! !

!LayoutPolicy methodsFor: 'testing' stamp: 'ar 10/29/2000 01:28'!
isProportionalLayout
	^false! !

!LayoutPolicy methodsFor: 'utilities' stamp: 'ar 10/29/2000 17:31'!
indexForInserting: aMorph at: aPoint in: someMorph
	"Return the insertion index based on the layout strategy defined for some morph. Used for drop insertion."
	^1 "front-most"! !

!LayoutPolicy methodsFor: 'layout' stamp: 'ar 1/27/2001 14:39'!
flushLayoutCache
	"Flush any cached information associated with the receiver"! !

!LayoutProperties commentStamp: '<historical>'!
This class provides a compact bit encoding for the most commonly used layout properties.!
!LayoutProperties methodsFor: 'table defaults' stamp: 'ar 11/13/2000 20:00'!
maxCellSize
	^SmallInteger maxVal! !

!LayoutProperties methodsFor: 'table defaults' stamp: 'ar 11/13/2000 20:00'!
reverseTableCells
	^false! !

!LayoutProperties methodsFor: 'table defaults' stamp: 'ar 11/14/2000 16:38'!
layoutInset
	^0! !

!LayoutProperties methodsFor: 'table defaults' stamp: 'ar 11/13/2000 19:59'!
listDirection
	"Default"
	^#topToBottom! !

!LayoutProperties methodsFor: 'converting' stamp: 'ar 11/14/2000 17:52'!
asTableLayoutProperties
	^(TableLayoutProperties new)
		hResizing: self hResizing;
		vResizing: self vResizing;
		disableTableLayout: self disableTableLayout;
		yourself! !

!LayoutProperties methodsFor: 'accessing' stamp: 'ar 11/14/2000 17:51'!
hResizing: aSymbol
	hResizing := aSymbol! !

!LayoutProperties methodsFor: 'testing' stamp: 'ar 11/13/2000 18:34'!
includesTableProperties
	^false! !

!LayoutProperties methodsFor: 'accessing' stamp: 'ar 11/14/2000 17:51'!
hResizing
	^hResizing! !

!LayoutProperties methodsFor: 'table defaults' stamp: 'ar 11/13/2000 19:58'!
listCentering
	"Default"
	^#topLeft! !

!LayoutProperties methodsFor: 'table defaults' stamp: 'ar 11/13/2000 19:59'!
listSpacing
	"Default"
	^#none! !

!LayoutProperties methodsFor: 'accessing' stamp: 'ar 11/14/2000 17:52'!
vResizing: aSymbol
	vResizing := aSymbol! !

!LayoutProperties methodsFor: 'accessing' stamp: 'ar 11/14/2000 17:51'!
disableTableLayout: aBool
	disableLayout := aBool! !

!LayoutProperties methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 10:00'!
initialize
	super initialize.
	hResizing := vResizing := #rigid.
	disableLayout := false.! !

!LayoutProperties methodsFor: 'table defaults' stamp: 'ar 11/14/2000 17:50'!
cellPositioning
	^#center! !

!LayoutProperties methodsFor: 'accessing' stamp: 'ar 11/14/2000 17:51'!
vResizing
	^vResizing! !

!LayoutProperties methodsFor: 'table defaults' stamp: 'ar 11/13/2000 19:55'!
cellSpacing
	"Default"
	^#none! !

!LayoutProperties methodsFor: 'table defaults' stamp: 'ar 11/13/2000 19:53'!
cellInset
	"Default"
	^0! !

!LayoutProperties methodsFor: 'table defaults' stamp: 'ar 11/13/2000 20:02'!
wrapCentering
	^#topLeft! !

!LayoutProperties methodsFor: 'table defaults' stamp: 'ar 11/13/2000 20:02'!
wrapDirection
	^#none! !

!LayoutProperties methodsFor: 'initialize' stamp: 'ar 11/14/2000 17:56'!
initializeFrom: defaultProvider
	"Initialize the receiver from a default provider"
	self hResizing: defaultProvider hResizing.
	self vResizing: defaultProvider vResizing.
	self disableTableLayout: defaultProvider disableTableLayout.! !

!LayoutProperties methodsFor: 'accessing' stamp: 'ar 11/14/2000 17:51'!
disableTableLayout
	^disableLayout! !

!LayoutProperties methodsFor: 'table defaults' stamp: 'ar 11/13/2000 20:00'!
minCellSize
	^0! !

!LayoutProperties methodsFor: 'table defaults' stamp: 'ar 11/13/2000 20:01'!
rubberBandCells
	^false! !

!LazyClassListExample commentStamp: 'AlainPlantec 1/17/2010 08:28'!
LazyClassListExample new openOn: Object
!
!LazyClassListExample methodsFor: 'accessing' stamp: 'AlainPlantec 1/15/2010 13:59'!
treeMorphClass
	^ LazyMorphTreeMorph ! !

!LazyClassListExample class methodsFor: 'examples' stamp: 'TorstenBergmann 9/30/2014 20:10'!
example

	^LazyClassListExample new openOn: Object
! !

!LazyListMorph commentStamp: 'efc 8/6/2005 11:34'!
The morph that displays the list in a PluggableListMorph.  It is "lazy" because it will only request the list items that it actually needs to display.

I will cache the maximum width of my items in maxWidth to avoid this potentially expensive and frequent computation.!
!LazyListMorph methodsFor: 'drawing' stamp: 'MarcusDenker 9/13/2013 16:19'!
drawSelectionOn: aCanvas
	"Draw the selection background."
	
	selectedRow ifNil: [ ^self ].
	selectedRow = 0 ifTrue: [ ^self ].
	self drawBackgroundForSelectedRow: selectedRow on: aCanvas
! !

!LazyListMorph methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 9/1/2011 10:39'!
drawBackgroundForRow: row on: aCanvas color: aColor
	| frame  |
	"shade the background darker, if this row is selected"
 	frame := self selectionFrameForRow: row.
	aCanvas
		fillRectangle: frame
		color: aColor! !

!LazyListMorph methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 9/1/2011 10:40'!
drawBackgroundForSelectedRow: row on: aCanvas

	self drawBackgroundForRow: row on: aCanvas color: listSource selectionColorToUse! !

!LazyListMorph methodsFor: 'list access' stamp: 'BenjaminVanRyseghem 2/12/2012 00:23'!
item: index
	"return the index-th item, using the 'listItems' cache"
	| newItem itemWidth |
	(index between: 1 and: listItems size)
		ifFalse: [ "there should have been an update, but there wasn't!!"  ^self getListItem: index].
	(listItems at: index) ifNil: [ 
		newItem := self getListItem: index.
		"Update the width cache."
		maxWidth ifNotNil:[
			itemWidth := newItem widthToDisplayInList: self.
			itemWidth > maxWidth ifTrue:[
				maxWidth := itemWidth.
				self adjustWidth.
			]].
		listItems at: index put: newItem ].
	^listItems at: index! !

!LazyListMorph methodsFor: 'row management' stamp: 'BenjaminVanRyseghem 2/12/2012 00:23'!
hUnadjustedScrollRange
"Ok, this is a bit messed up. We need to return the width of the widest item in the list. If we grab every item in the list, it defeats the purpose of LazyListMorph. If we don't, then we don't know the size. 

This is a compromise -- find the widest of the first 30 items, then double it, This width will be updated as new items are installed, so it will always be correct for the visible items. If you know a better way, please chime in."

	| itemsToCheck item index |
	"Check for a cached value"
	maxWidth ifNotNil:[^maxWidth].

	listItems isEmpty ifTrue: [^0]. "don't set maxWidth if empty do will be recomputed when there are some items"
	"Compute from scratch"
	itemsToCheck := 30 min: (listItems size).
	maxWidth := 0. 

	"Check the first few items to get a representative sample of the rest of the list."
	index := 1.
	[index < itemsToCheck] whileTrue:
		[ item := self getListItem: index. "Be careful not to actually install this item"
		maxWidth := maxWidth max: (item widthToDisplayInList: self).
		index:= index + 1.
		].

	"Add some initial fudge if we didn't check all the items."
	(itemsToCheck < listItems size) ifTrue:[maxWidth := maxWidth*2].

	^maxWidth
! !

!LazyListMorph methodsFor: 'drawing' stamp: 'ls 7/5/2000 18:04'!
font: newFont
	font := (newFont ifNil: [ TextStyle default defaultFont ]).
	self adjustHeight.
	self changed.! !

!LazyListMorph methodsFor: 'initialization' stamp: 'EstebanLorenzano 5/15/2014 17:37'!
initialize
	super initialize.
	self color: self theme textColor.
	font := StandardFonts listFont.
	listItems := #().
	selectedRow := nil.
	selectedRows := PluggableSet integerSet.
	self adjustHeight.! !

!LazyListMorph methodsFor: 'row management' stamp: 'EstebanLorenzano 4/29/2014 17:03'!
colorForRow: row 
	"Answer the color for the row text."
	^ (self isRowSelected: row )
		ifTrue: [ self theme selectionTextColor ]
		ifFalse: [ self color ]! !

!LazyListMorph methodsFor: 'row management' stamp: 'gvc 7/24/2007 11:45'!
selectRow: index
	"Select the index-th row."
	
	selectedRows add: index.
	self invalidRect: (self selectionFrameForRow: index)! !

!LazyListMorph methodsFor: 'list management' stamp: 'ls 10/20/2001 00:09'!
rowAtLocation: aPoint
	"return the number of the row at aPoint"
	| y |
	y := aPoint y.
	y < self top ifTrue: [ ^ 1 ].
	^((y - self top // (font height)) + 1) min: listItems size max: 0! !

!LazyListMorph methodsFor: 'list management' stamp: 'ThierryGoubier 9/24/2012 15:50'!
drawBoundsForRow: row
	"calculate the bounds that row should be drawn at.  This might be outside our bounds!!"

	| topLeft drawBounds item width height |
	item := [ self getListItem: row ]
		on: SubscriptOutOfBounds
		do: [ :ex | self getListItem: (row min: self getListSize) ].
	height := item heightToDisplayInList: self.
	width := item widthToDisplayInList: self.
	topLeft := self topLeft x @ (self topLeft y + ((row - 1) * height)).
	drawBounds := topLeft extent: width @ height.
	^ drawBounds! !

!LazyListMorph methodsFor: 'accessing' stamp: 'bf 4/21/2005 15:58'!
userString
	"Do I have a text string to be searched on?"

	^ String streamContents: [:strm |
		1 to: self getListSize do: [:i |
			strm nextPutAll: (self getListItem: i); cr]]! !

!LazyListMorph methodsFor: 'accessing' stamp: 'gvc 7/24/2007 13:06'!
mouseDownRow: anInteger
	"Set the row that should have mouse down highlighting or nil if none."

	anInteger = self mouseDownRow ifTrue: [^self].
	self mouseDownRowFrameChanged.
	self setProperty: #mouseDownRow toValue: anInteger.
	self mouseDownRowFrameChanged! !

!LazyListMorph methodsFor: 'list access' stamp: 'MarcusDenker 10/3/2013 23:38'!
getListSize
	"return the number of items in the list"
	^listSource 
		ifNil: [ 0 ]
		ifNotNil: [ :source | source getListSize]
		
	! !

!LazyListMorph methodsFor: 'row management' stamp: 'IgorStasenko 2/19/2013 14:28'!
selectionFrameForRow: row
	"Answer the selection frame rectangle."

	|frame| 
	frame := self drawBoundsForRow: row.
	frame := frame intersect: self bounds .
	frame := self bounds: frame in: listSource.
	frame := self
		bounds: ((frame left: listSource innerBounds left) right: listSource innerBounds right)
		from: listSource.
	^frame! !

!LazyListMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/6/2015 18:12'!
athensDrawBackgroundForRow: row on: aCanvas color: aColor

	aCanvas setPaint: aColor.
	aCanvas drawShape: (self selectionFrameForRow: row)! !

!LazyListMorph methodsFor: 'drawing' stamp: 'ls 5/17/2001 21:57'!
topVisibleRowForCanvas: aCanvas
        "return the top visible row in aCanvas's clip rectangle"
        ^self rowAtLocation: aCanvas clipRect topLeft.
! !

!LazyListMorph methodsFor: 'row management' stamp: 'MarcusDenker 9/13/2013 16:19'!
display: item atRow: row on: aCanvas
	"Display the given item at the given row on the given
	canvas."

	| itemColor backgroundColor drawBounds |
	drawBounds := self drawBoundsForRow: row.
	itemColor := self colorForRow: row.
	backgroundColor := self backgroundColorForRow: row.
	item
		listRenderOn: aCanvas
		atRow: row
		bounds: drawBounds
		color: itemColor
		backgroundColor: backgroundColor 
		from: self.
		
	row = self mouseDownRow
		ifTrue: [ 
			aCanvas
				frameRectangle: (self selectionFrameForRow: row)
				width: 1
				colors: {itemColor. (Color transparent)}
				dashes: #(1 1) ]! !

!LazyListMorph methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 9/1/2011 10:39'!
drawBackgroundForSearchedRow: row on: aCanvas
	
	self drawBackgroundForRow: row on: aCanvas color: listSource secondarySelectionColor! !

!LazyListMorph methodsFor: 'drawing' stamp: 'ls 5/15/2001 22:13'!
adjustHeight
	"private.  Adjust our height to match the length of the underlying list"
	self height: (listItems size max: 1) * font height
! !

!LazyListMorph methodsFor: 'drawing' stamp: 'MarcusDenker 7/8/2014 20:08'!
drawOn: aCanvas 
	listItems isEmpty
		ifTrue: [^ self].
		
	aCanvas fillRectangle: aCanvas clipRect color: (self theme listNormalFillStyleFor: self).
		
	"self drawSelectionOn: aCanvas."
	(self topVisibleRowForCanvas: aCanvas)
		to: (self bottomVisibleRowForCanvas: aCanvas) 
		do: [:row | 
			
			(listSource itemSelectedAmongMultiple: row)
				ifTrue: [ self drawBackgroundForSelectedRow: row on: aCanvas]
				ifFalse: [
					(listSource searchedElement = row)
						ifTrue: [ self drawBackgroundForSearchedRow: row on: aCanvas]
						ifFalse: [
							(listSource backgroundColorFor: row)
								ifNotNil: [:col |
									self drawBackgroundForRow: row on: aCanvas color: col ]]].
						
			selectedRow = row ifTrue: [ self drawSelectionOn: aCanvas ].
			(listSource separatorAfterARow: row) ifTrue: [ self drawSeparatorAfter: row on: aCanvas ].
			self
				display: (self item: row)
				atRow: row
				on: aCanvas].
		
	listSource potentialDropRow > 0
		ifTrue: [self highlightPotentialDropRow: listSource potentialDropRow on: aCanvas]! !

!LazyListMorph methodsFor: 'row management' stamp: 'EstebanLorenzano 5/14/2014 15:16'!
backgroundColorForRow: row 
	"Answer the color for the row text."
	^ (self isRowSelected: row )
		ifTrue: [ listSource selectionColorToUse ]
		ifFalse: [ self theme backgroundColor ]! !

!LazyListMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/15/2015 21:39'!
drawOnAthensCanvas: aCanvas
	listItems isEmpty
		ifTrue: [^ self].
	"self drawSelectionOn: aCanvas."
	1 to: listItems size do: [:row |
		(listSource itemSelectedAmongMultiple: row)
			ifTrue: [ self athensDrawBackgroundForSelectedRow: row on: aCanvas]
			ifFalse: [
				(listSource searchedElement = row)
					ifTrue: [ self athensDrawBackgroundForSearchedRow: row on: aCanvas]
					ifFalse: [
						(listSource backgroundColorFor: row)
							ifNotNil: [:col |
								self athensDrawBackgroundForRow: row on: aCanvas color: col ]]].
					
			selectedRow = row ifTrue: [ self athensDrawSelectionOn: aCanvas ].
			(listSource separatorAfterARow: row) ifTrue: [ self athensDrawSeparatorAfter: row on: aCanvas ].
			self
				athensDisplay: (self item: row)
				atRow: row
				on: aCanvas].
		
	listSource potentialDropRow > 0
		ifTrue: [self athensHighlightPotentialDropRow: listSource potentialDropRow on: aCanvas]! !

!LazyListMorph methodsFor: 'drawing' stamp: 'sps 3/9/2004 17:06'!
adjustWidth
	"private.  Adjust our height to match the length of the underlying list"
	self width: ((listSource width max: self hUnadjustedScrollRange) + 20). 
! !

!LazyListMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/15/2015 21:25'!
athensHighlightPotentialDropRow: row on: anAthensCanvas
	| drawBounds |
	drawBounds := self drawBoundsForRow: row.
	drawBounds := drawBounds intersect: self bounds ifNone: [ ^ self ].
	anAthensCanvas setStrokePaint: Color blue.
	anAthensCanvas drawShape: drawBounds! !

!LazyListMorph methodsFor: 'initialization' stamp: 'ls 5/15/2001 22:12'!
listSource: aListSource
	"set the source of list items -- typically a PluggableListMorph"
	listSource := aListSource.
	self listChanged! !

!LazyListMorph methodsFor: 'drawing' stamp: 'IgorStasenko 12/22/2012 03:07'!
drawBackgroundForPotentialDrop: row on: aCanvas
	| selectionDrawBounds |
	"shade the background darker, if this row is a potential drop target"

	selectionDrawBounds := self drawBoundsForRow: row.
	selectionDrawBounds := selectionDrawBounds intersect: self bounds ifNone: [^ self ].
	aCanvas fillRectangle: selectionDrawBounds color:  self color muchLighter darker! !

!LazyListMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 2/26/2015 22:08'!
athensDisplay: item atRow: row on: aCanvas
	"Display the given item at the given row on the given
	canvas."

	| c backgroundColor drawBounds |

	drawBounds := self drawBoundsForRow: row.
	c := self colorForRow: row.
	backgroundColor := self backgroundColorForRow: row.
	aCanvas
		morphicDrawString: item asString
		at: drawBounds topLeft
		font: self font
		color: c.
	row = self mouseDownRow
		ifTrue: [ 
			(aCanvas setStrokePaint: c)
				width: 1;
				dashes: {1} offset: 0.
			aCanvas drawShape: (self selectionFrameForRow: row) ]! !

!LazyListMorph methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 9/16/2011 17:06'!
drawSeparatorAfter: aRow on: aCanvas

	| frame rectangle height separatorColor |
	height := listSource separatorSize.
	separatorColor := listSource separatorColor.
	frame := self selectionFrameForRow: aRow.
	rectangle := (frame left@(frame bottom - height)) corner: (frame right@frame bottom).
	aCanvas fillRectangle: rectangle color:  separatorColor! !

!LazyListMorph methodsFor: 'row management' stamp: 'gvc 7/30/2009 14:04'!
mouseDownRowFrameChanged
	"Invalidate frame of the current mouse down row if any."
	
	|frame row|
	row := self mouseDownRow ifNil: [ ^self ].
	frame := self selectionFrameForRow: row.
	self invalidRect: frame! !

!LazyListMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/15/2015 21:46'!
athensDrawSelectionOn: anAthensCanvas 
	
	selectedRow ifNil: [ ^self ].
	selectedRow = 0 ifTrue: [ ^self ].
	self athensDrawBackgroundForSelectedRow: selectedRow on: anAthensCanvas 
! !

!LazyListMorph methodsFor: 'drawing' stamp: 'IgorStasenko 12/22/2012 03:07'!
highlightPotentialDropRow: row  on: aCanvas
	| drawBounds  |
	drawBounds := self drawBoundsForRow: row.
	drawBounds := drawBounds intersect: self bounds ifNone: [ ^ self ].
	aCanvas frameRectangle: drawBounds color: Color blue! !

!LazyListMorph methodsFor: 'accessing' stamp: 'gvc 9/12/2006 11:21'!
mouseDownRow
	"Answer the row that should have mouse down highlighting if any."

	^self valueOfProperty: #mouseDownRow! !

!LazyListMorph methodsFor: 'row management' stamp: 'GuillermoPolito 8/17/2012 15:01'!
selectionFrameChanged
	"Invalidate frame of the current selection if any."
	
	| frame |
	selectedRow ifNil: [ ^self ].
	selectedRow = 0 ifTrue: [ ^self ].
	(selectedRow > self getListSize) ifTrue: [ ^self ].
	frame := self selectionFrameForRow: selectedRow.
	self invalidRect: frame! !

!LazyListMorph methodsFor: 'row management' stamp: 'gvc 7/24/2007 11:46'!
selectedRow: index
	"Select the index-th row.  if nil, remove the current selection."
	
	selectedRow ifNotNil: [self selectionFrameChanged].
	selectedRow := index.
	selectedRow ifNotNil: [self selectionFrameChanged]! !

!LazyListMorph methodsFor: 'row management' stamp: 'gvc 7/24/2007 11:46'!
unselectRow: index
	"Unselect the index-th row."
	
	selectedRows remove: index ifAbsent: [^self].
	self invalidRect: (self selectionFrameForRow: index)! !

!LazyListMorph methodsFor: '*Athens-Morphic' stamp: 'IgorStasenko 10/9/2012 19:03'!
athensDrawBackgroundForSelectedRow: row on: aCanvas 

	aCanvas setPaint: listSource selectionColorToUse.
	aCanvas drawShape: (self selectionFrameForRow: row)! !

!LazyListMorph methodsFor: 'drawing' stamp: 'ls 7/5/2000 18:37'!
font
	"return the font used for drawing.  The response is never nil"
	^font! !

!LazyListMorph methodsFor: 'row management' stamp: 'AlainPlantec 2/11/2011 13:05'!
isRowSelected: row 
	"Answer true if the arg row is selected"
	^ ((selectedRow notNil
				and: [row = selectedRow])
			or: [listSource itemSelectedAmongMultiple: row])
! !

!LazyListMorph methodsFor: 'row management' stamp: 'BenjaminVanRyseghem 2/28/2012 05:28'!
listChanged
	"set newList to be the list of strings to display"
	listItems := Array new: self getListSize withAll: nil.
	self removeAllMorphs.
	selectedRow := nil.
	selectedRows := PluggableSet integerSet.
	maxWidth := nil. "recompute"
	self adjustHeight.
	self adjustWidth.
	self changed.
! !

!LazyListMorph methodsFor: '*Athens-Morphic' stamp: 'IgorStasenko 10/9/2012 19:04'!
athensDrawBackgroundForSearchedRow: row on: aCanvas 

	aCanvas setPaint: listSource  secondarySelectionColor.
	aCanvas drawShape: (self selectionFrameForRow: row)! !

!LazyListMorph methodsFor: 'list access' stamp: 'ls 8/19/2001 14:07'!
getListItem: index
	"grab a list item directly from the model"
	^listSource getListItem: index! !

!LazyListMorph methodsFor: 'drawing' stamp: 'ls 5/17/2001 21:57'!
bottomVisibleRowForCanvas: aCanvas
        "return the bottom visible row in aCanvas's clip rectangle"
        ^self rowAtLocation: aCanvas clipRect bottomLeft.
! !

!LazyListMorph methodsFor: 'list management' stamp: 'ls 7/7/2000 10:38'!
selectedRow
	"return the currently selected row, or nil if none is selected"
	^selectedRow! !

!LazyMorphListMorph commentStamp: 'gvc 5/18/2007 12:47'!
Support for morph lists in PluggableMorphListMorph.!
!LazyMorphListMorph methodsFor: 'as yet unclassified' stamp: 'gvc 9/12/2006 15:14'!
display: item  atRow: row on: aCanvas
	"Display the given item at the given row on the given canvas."
	
	|c frame|
	row = self mouseDownRow ifFalse: [^self].
	frame := self selectionFrameForRow: row.
	c := self colorForRow: row.
	aCanvas 
		frameRectangle: frame
		width: 1
		colors: {c. Color transparent}
		 dashes: #(1 1)! !

!LazyMorphListMorph methodsFor: 'as yet unclassified' stamp: 'gvc 5/3/2006 13:38'!
adjustHeight
	"private.  Adjust our height to match the length of the underlying list.
	Automatic with table layout."
! !

!LazyMorphListMorph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 12/22/2012 03:05'!
drawSubmorphsOn: aCanvas 
	"Display submorphs back to front"

	| drawBlock|
	submorphs isEmpty ifTrue: [^self].
	drawBlock := [:canvas | | i |
		(self topVisibleRowForCanvas: aCanvas) to: (self bottomVisibleRowForCanvas: aCanvas) do: [ :row |
			i := self item: row.
			canvas fullDrawMorph: i]].
	self clipSubmorphs 
		ifTrue: [aCanvas clipBy: (aCanvas clipRect intersect: self clippingBounds ifNone: [ ^ self ]) during: drawBlock]
		ifFalse: [drawBlock value: aCanvas]! !

!LazyMorphListMorph methodsFor: 'as yet unclassified' stamp: 'gvc 6/13/2006 11:12'!
adjustWidth
	"private.  Adjust our height to match the length of the underlying list"
	
	self width: (listSource innerBounds width max: self hUnadjustedScrollRange). ! !

!LazyMorphListMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/22/2015 22:53'!
drawSubmorphsOnAthensCanvas: anAthensCanvas 
	"Display submorphs back to front"

	| drawBlock|
	submorphs isEmpty ifTrue: [^self].
	drawBlock := [:canvas | | i |
		(self topVisibleRowForCanvas: anAthensCanvas) to: (self bottomVisibleRowForCanvas: anAthensCanvas) do: [ :row |
			i := self item: row.
			canvas fullDrawMorph: i]].
	self clipSubmorphs 
		ifTrue: [anAthensCanvas clipBy: (anAthensCanvas clipRect intersect: self clippingBounds ifNone: [ ^ self ]) during: drawBlock]
		ifFalse: [drawBlock value: anAthensCanvas]! !

!LazyMorphListMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/15/2015 21:42'!
athensDisplay: item atRow: row on: aCanvas
	"Display the given item at the given row on the given canvas."

	row = self mouseDownRow
		ifTrue: [ 
			(aCanvas setStrokePaint: (self colorForRow: row))
				width: 1;
				dashes: {1} offset: 0.
			aCanvas drawShape: (self selectionFrameForRow: row) ]! !

!LazyMorphListMorph methodsFor: 'as yet unclassified' stamp: 'BenjaminVanRyseghem 2/12/2012 00:24'!
hUnadjustedScrollRange
	"Answer the width of the widest item."

	maxWidth ifNotNil:[^maxWidth].
	listItems isEmpty ifTrue: [^0].
	maxWidth := 0.
	listItems do: [:each |
		each ifNotNil: [maxWidth := maxWidth max: (each widthToDisplayInList: self)]].
	^maxWidth
! !

!LazyMorphListMorph methodsFor: 'initialization' stamp: 'gvc 6/13/2006 10:44'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		changeTableLayout;
		cellPositioning: #topLeft;
		cellInset: 2;
		vResizing: #shrinkWrap;
		hResizing: #rigid! !

!LazyMorphListMorph methodsFor: 'as yet unclassified' stamp: 'gvc 5/3/2006 12:24'!
selectRow: index
	"select the index-th row"
	selectedRows add: index.
	self invalidRect: (self drawBoundsForRow: index)! !

!LazyMorphListMorph methodsFor: 'as yet unclassified' stamp: 'gvc 5/3/2006 13:36'!
rowAtLocation: aPoint
	"return the number of the row at aPoint"

	| y |
	y := aPoint y.
	y < self top ifTrue: [ ^ 1 ].
	listItems with: (1 to: listItems size) do: [:i :row |
		(y < i bottom) ifTrue: [^row]].
	^listItems size! !

!LazyMorphListMorph methodsFor: 'as yet unclassified' stamp: 'GabrielOmarCotelli 11/30/2013 16:49'!
userString
	"Do I have a text string to be searched on?"

	^ String
		streamContents: [ :stream | 
			1 to: self getListSize do: [ :i | 
				(self getListItem: i) submorphs detect: [ :morph | morph userString notNil ] ifFound: [ :morph | stream nextPutAll: morph userString ].
				stream cr ] ]! !

!LazyMorphListMorph methodsFor: 'as yet unclassified' stamp: 'gvc 5/3/2006 16:08'!
drawBoundsForRow: row
	"Calculate the bounds that row should be drawn at.  This might be outside our bounds!!"
	
	(row between: 1 and: listItems size)
		ifFalse: [^0@0 corner: 0@0].
	^(listItems at: row) bounds! !

!LazyMorphListMorph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 12/22/2012 03:05'!
selectionFrameForRow: row
	"Answer the selection frame rectangle."

	|frame|
	frame := self drawBoundsForRow: row.
	frame := frame expandBy: (self cellInset // 2).
	self cellInset odd ifTrue: [frame := frame bottom: frame bottom + 1].
	frame := frame intersect: self bounds ifNone: [ self error: 'should not happen' ].
	frame := self bounds: frame in: listSource.
	frame := self
		bounds: ((frame left: listSource innerBounds left) right: listSource innerBounds right)
		from: listSource.
	^frame! !

!LazyMorphListMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/20/2009 16:56'!
listChanged
	"set newList to be the list of strings to display"
	listItems := (1 to: self getListSize) collect: [:i |
		self getListItem: i].
	self removeAllMorphs.
	self extent: 0@0.
	listItems do: [:i | self addMorphBack: i].
	selectedRow := nil.
	selectedRows := PluggableSet integerSet.
	maxWidth := nil. "recompute"
	self
		adjustHeight;
		adjustWidth.
	listItems do: [:i | i layoutChanged].
	self changed.
! !

!LazyMorphTreeMorph commentStamp: '<historical>'!
I am a MorphTreeMorph, but I only render the rows lazily as they appear on screen. 

Caveat: There is no rendering in the background. This means that if a row takes too long to render, you can experience a shorter or longer freeze when scrolling.!
!LazyMorphTreeMorph methodsFor: 'lazy tree' stamp: 'AlainPlantec 11/15/2009 21:57'!
indentingItemClass
	
	^ LazyMorphTreeNodeMorph! !

!LazyMorphTreeMorph methodsFor: 'initialize - release' stamp: 'tg 11/16/2009 02:26'!
lazyIncrement: anInteger
	lazyIncrement := anInteger ! !

!LazyMorphTreeMorph methodsFor: 'initialize - release' stamp: 'AlainPlantec 11/19/2009 17:31'!
buildRowMorphsFrom: aNodeMorph
	self buildRowMorphsFrom: aNodeMorph increment: self lazyIncrement.
! !

!LazyMorphTreeMorph methodsFor: 'initialize - release' stamp: 'AlainPlantec 10/9/2011 00:09'!
adjustSubmorphPositionsFrom: start to: stop
	"Fixed to not require setting item widths to 9999."
	
	| subs p |
	subs := self allNodeMorphs.
	p := (subs at: start) position.
	start to: subs size do: [:idx | | each h |
		each := subs at: idx.
		h := each height.
		each bounds: (p extent: each width@h).
		p := p + (0@h)].
! !

!LazyMorphTreeMorph methodsFor: 'initialize - release' stamp: 'AlainPlantec 10/9/2011 00:10'!
buildRowMorphsFromIndex: startIndex to: stopIndex
	| rowMorphsWidths subs |
	subs := self allNodeMorphs.
	rowMorphsWidths := self rowMorphsWidths.
	startIndex to: stopIndex
		do: [:p | (subs at: p) buildRowMorph; updateColumnMorphsWidthWith: rowMorphsWidths].
	self setScrollDeltas.
	self adjustSubmorphPositionsFrom: startIndex to: stopIndex.
	self setScrollDeltas.
	startIndex to: stopIndex do: [:pos | (subs at: pos) drawable: true].
! !

!LazyMorphTreeMorph methodsFor: 'initialize - release' stamp: 'AlainPlantec 10/9/2011 00:09'!
buildRowMorphsFrom: aNodeMorph increment: anIncrement
	
	Cursor wait 
		showWhile: [ | subs idx max |
			subs := self allNodeMorphs.
			idx :=  aNodeMorph index.
			max := (idx + anIncrement) min: subs size.
			self buildRowMorphsFromIndex: idx to: max].! !

!LazyMorphTreeMorph methodsFor: 'initialize - release' stamp: 'AlainPlantec 2/6/2010 13:42'!
lazyIncrement
	^ lazyIncrement ifNil: [ lazyIncrement := 20 ] ! !

!LazyMorphTreeNodeMorph commentStamp: 'TorstenBergmann 9/5/2014 15:29'!
A node for "lazy drawing" in a morphic based tree!
!LazyMorphTreeNodeMorph methodsFor: 'initialization' stamp: 'AlainPlantec 11/15/2009 23:01'!
initialize
	super initialize.
	drawable := false! !

!LazyMorphTreeNodeMorph methodsFor: 'initialization' stamp: 'AlainPlantec 11/15/2009 22:09'!
initRow! !

!LazyMorphTreeNodeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/19/2009 16:50'!
drawSubmorphsOn: aCanvas
	drawable ifFalse: [^ self].
	super drawSubmorphsOn: aCanvas.
! !

!LazyMorphTreeNodeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/20/2009 07:27'!
drawOn: aCanvas
	drawable
		ifFalse: [container buildRowMorphsFrom: self]
		ifTrue: [super drawOn: aCanvas]
! !

!LazyMorphTreeNodeMorph methodsFor: 'drawing' stamp: 'AlainPlantec 11/19/2009 18:33'!
drawable
	^ drawable ifNil: [false]
! !

!LazyMorphTreeNodeMorph methodsFor: 'drawing' stamp: 'AlainPlantec 11/16/2009 10:20'!
drawable: aBoolean
	drawable := aBoolean.
! !

!LazyTabGroupMorph methodsFor: 'private' stamp: 'TudorGirba 1/28/2011 20:38'!
newHeaderMorph
	^ (self theme 
			newRowIn: self theme
			for: {self tabSelectorMorph . self toolbarMorph}) cellInset: 0; cellPositioning: #bottomCenter; borderWidth: 0! !

!LazyTabGroupMorph methodsFor: 'accessing' stamp: 'AliakseiSyrel 9/9/2014 12:46'!
headerMorph: anObject
	headerMorph := anObject.
	
	headerMorph clipSubmorphs: true.! !

!LazyTabGroupMorph methodsFor: 'accessing' stamp: 'TudorGirba 7/23/2011 20:14'!
announcer
	^ announcer ifNil: [announcer := GLMAnnouncer new]! !

!LazyTabGroupMorph methodsFor: 'accessing' stamp: 'TudorGirba 1/28/2011 00:33'!
toolbarMorph
	^ toolbarMorph! !

!LazyTabGroupMorph methodsFor: 'accessing' stamp: 'AliakseiSyrel 9/9/2014 12:46'!
toolbarMorph: anObject
	toolbarMorph := anObject.! !

!LazyTabGroupMorph methodsFor: 'private' stamp: 'TudorGirba 1/22/2011 21:03'!
pageAt: index
	^ (self pages at: index ) actualPageMorph! !

!LazyTabGroupMorph methodsFor: 'accessing' stamp: 'TudorGirba 1/28/2011 01:25'!
headerMorph
	^ headerMorph! !

!LazyTabGroupMorph methodsFor: 'private' stamp: 'AndreiChis 3/24/2015 14:36'!
updatePageIndex: index
	"Change to the given page index, update the toolbar and send the announcement"

	| p oldPage |
	
	index = 0 ifTrue: [^ self].
	oldPage := self tabSelectorMorph selectedTab.
	p := self pageMorph.
	p isNil
		ifTrue: [
			self contentMorph addMorph: (self pageAt: index).]
		ifFalse: [|pageBounds|
			pageBounds := self pageMorph bounds.
			self contentMorph replaceSubmorph: p by: (self pageAt: index).
			self flag: 'Without setting here the bounds the pange moves a few pizels when refreshing the inspector'.
			self pageMorph bounds: pageBounds.
			self pageMorph layoutChanged ].
		
	((self pages at: index) toolbar notNil and: [(self pages at: index) toolbar hasSubmorphs])
		ifTrue: [
			self toolbarMorph hasSubmorphs
				ifFalse: [self toolbarMorph addMorph: (self pages at: index) toolbar ]
				ifTrue: [self toolbarMorph 
								replaceSubmorph: self toolbarMorph submorphs first 
								by: (self pages at: index) toolbar ]]
		ifFalse: [self toolbarMorph removeAllMorphs ].
		
	self headerMorph layoutChanged.
	self pageMorph layoutChanged.
	self adoptPaneColor: (self owner ifNil: [self]) paneColor.
	(self tabSelectorMorph tabs at: index) font:  self tabSelectorMorph font.
	self announcer announce: (LazyTabPageChanged new tabs: self; page: (self pages at: index); oldPage: oldPage; pageIndex: index)! !

!LazyTabGroupMorph methodsFor: 'adding' stamp: 'AliakseiSyrel 3/22/2015 11:52'!
addLazyPage: aBlock label: aStringOrMorph toolbar: aToolbar collapsable: aBoolean
	| newPage label |
	newPage := LazyTabPage new.
	newPage
		lazyPageMorphCreation: aBlock; 
		labelMorph: aStringOrMorph; 
		toolbar: aToolbar.
	label := self 
			buildLabelFrom: aStringOrMorph 
			withAction: (aBoolean 
				ifTrue: [GLMActionButtonBrick new
					action: [self removePage: newPage];
					icon: self theme windowCloseForm ]
				ifFalse: [nil]).
	self 
		addPage: newPage
		label: label.
	! !

!LazyTabGroupMorph methodsFor: 'private' stamp: 'TudorGirba 1/28/2011 20:36'!
newToolbarMorph
	^ PanelMorph new
		fillStyle: (SolidFillStyle color: Color transparent);
		borderStyle: (BorderStyle width: 0);
		vResizing: #spaceFill;
		hResizing: #shrinkWrap;
		cellPositioning: #center;
		changeTableLayout;
		cellInset: 0;
		yourself ! !

!LazyTabGroupMorph methodsFor: 'adding' stamp: 'AndreiChis 10/7/2014 11:52'!
addLazyPage: aBlock label: aStringOrMorph toolbar: aToolbar action: anActionMorphOrNil
	| newPage label |
	newPage := LazyTabPage new.
	newPage
		lazyPageMorphCreation: aBlock; 
		labelMorph: aStringOrMorph; 
		toolbar: aToolbar.
	label := self 
			buildLabelFrom: aStringOrMorph 
			withAction: anActionMorphOrNil.
	self 
		addPage: newPage
		label: label! !

!LazyTabGroupMorph methodsFor: 'private' stamp: 'AliakseiSyrel 3/21/2015 23:39'!
buildLabelFrom: aStringOrMorph withAction: aBrick
	| label innerLabel |

	innerLabel := aStringOrMorph isMorph
		ifTrue: [aStringOrMorph]
		ifFalse: [
			|container labelMorph|
			container := GLMBrick new.
			labelMorph := GLMLabelBrick new
				text: aStringOrMorph;
				textColor: container themer textSecondaryColor;
			 	hSpaceFill;
			 	vSpaceFill;
				marginLeft: 5.
			container
				addBrickBack: labelMorph;
				hSpaceFill;
				vSpaceFill.
			
			container maxWidth: [ 5 + labelMorph approximateWidth + (aBrick ifNotNil: [ :b | b normalImage width * 1.5 ] ifNil: [ 0 ])].
			container ].
		
	label := aBrick
			ifNil: [ innerLabel ]
			ifNotNil: [ aBrick vSpaceFill; width: (aBrick normalImage width * 1.5). innerLabel addBrickBack: aBrick. innerLabel ].
					
	^ label! !

!LazyTabGroupMorph methodsFor: 'as yet unclassified' stamp: 'AliakseiSyrel 3/24/2015 13:44'!
newTabSelectorMorph
	"Answer a new tab selector morph"

	^ GLMTabSelectorBrick new
		minHeight: self theme buttonMinHeight;
		hSpaceFill;
		vResizing: #shrinkWrap! !

!LazyTabGroupMorph methodsFor: 'as yet unclassified' stamp: 'AndreiChis 10/7/2014 11:50'!
updatePageAtIndex: anInteger withLabel: aStringOrMorph toolbar: aToolbar action: anActionMorph
	
	(self pages at: anInteger)
			toolbar: aToolbar.
	self 
		relabelPage: (self pages at: anInteger)
		with: (self 
			buildLabelFrom: aStringOrMorph 
			withAction: anActionMorph).
	self updatePageIndex: anInteger.
! !

!LazyTabGroupMorph methodsFor: 'private' stamp: 'TudorGirba 7/23/2011 20:33'!
removePage: aPage
	| removedPageIndex |
	removedPageIndex := self pages indexOf: aPage.
	self announcer suspendAllWhile: [ super removePage: aPage ].
	self announcer announce: 
		(LazyTabPageRemoved new 
			tabs: self; 
			page: aPage; 
			pageIndex: removedPageIndex;
			newIndex: self tabSelectorMorph selectedIndex).
	self pages isEmpty 
		ifTrue: [ self contentMorph removeAllMorphs ]! !

!LazyTabGroupMorph methodsFor: 'adding' stamp: 'TudorGirba 1/22/2011 21:01'!
addLazyPage: aBlock label: aStringOrMorph
	self addLazyPage: aBlock label: aStringOrMorph toolbar: nil! !

!LazyTabGroupMorph methodsFor: 'initialization' stamp: 'AliakseiSyrel 9/4/2014 13:26'!
initialize
	"Initialize the receiver."

	super initialize.
	self removeMorph: self contentMorph;
		removeMorph: self tabSelectorMorph;  
		toolbarMorph: self newToolbarMorph;
		headerMorph: self newHeaderMorph;
		addMorph: self headerMorph;
		addMorph: self contentMorph.
	
"	self
		borderWidth: 0;
		changeTableLayout;
		cellPositioning: #topLeft;
		cellInset: 0 @ -1;
		reverseTableCells: true;
		pageMorphs: OrderedCollection new;
		tabSelectorMorph: self newTabSelectorMorph;
		contentMorph: self newContentMorph;
		addMorph: self tabSelectorMorph;
		addMorph: self contentMorph.
	self tabSelectorMorph addDependent: self"! !

!LazyTabGroupMorph methodsFor: 'private' stamp: 'TudorGirba 1/23/2011 00:23'!
removePageIndex: anInteger
	self removePage: (self pages at: anInteger)! !

!LazyTabGroupMorph methodsFor: 'adding' stamp: 'TudorGirba 1/22/2011 22:03'!
addLazyPage: aBlock label: aStringOrMorph toolbar: aToolbar
	self addLazyPage: aBlock label: aStringOrMorph toolbar: aToolbar collapsable: false! !

!LazyTabGroupTest methodsFor: 'tests' stamp: ''!
testPageRemovedAnnouncement
	| announcement |
	announcement := 0.
	tabs announcer when: LazyTabPageRemoved do: [ :ann | announcement := announcement + 1 ].
	tabs announcer when: LazyTabPageChanged do: [ :ann | announcement := announcement + 1 ].
	tabs removePage: tabs pages first.
	self assert: announcement equals: 1! !

!LazyTabGroupTest methodsFor: 'tests' stamp: ''!
testPageChangedAnnouncement
	| announcement page |
	announcement := 0.
	tabs announcer
		when: LazyTabPageChanged
		do: [ :ann | 
			announcement := announcement + 1.
			page := ann page ].
	tabs selectedPageIndex: 1.
	self assert: announcement equals: 1.
	self assert: (page isKindOf: LazyTabPage)! !

!LazyTabGroupTest methodsFor: 'tests' stamp: ''!
testRemovePage
	tabs removePage: tabs pages first.
	self assert: tabs pages size equals: 1! !

!LazyTabGroupTest methodsFor: 'tests' stamp: ''!
testRemoveAllPages
	tabs removePage: tabs pages first.
	tabs removePage: tabs pages first.
	self assert: tabs pages isEmpty.
	self assert: tabs contentMorph submorphs isEmpty! !

!LazyTabGroupTest methodsFor: 'setup - tear down' stamp: ''!
tearDown
	window ifNotNil: [window delete]! !

!LazyTabGroupTest methodsFor: 'tests' stamp: ''!
testSimpleCreation
	self assert: tabs pages size equals: 2! !

!LazyTabGroupTest methodsFor: 'tests' stamp: ''!
testIsRendered
	self assert: tabs pages first isRendered not.
	tabs selectedPageIndex: 1.
	self assert: tabs pages first isRendered.
	self assert: tabs pages second isRendered not! !

!LazyTabGroupTest methodsFor: 'setup - tear down' stamp: 'AliakseiSyrel 10/18/2014 16:13'!
setUp
	tabs := LazyTabGroupMorph new.
	tabs addLazyPage: (PanelMorph new fillStyle: (SolidFillStyle color: Color red)) label: 'one'.
	tabs addLazyPage: (PanelMorph new fillStyle: (SolidFillStyle color: Color yellow)) label: (GLMLabelBrick new text: 'two').
	window := tabs openInWindow.
! !

!LazyTabPage methodsFor: 'accessing' stamp: 'TudorGirba 1/22/2011 17:49'!
actualPageMorph: anObject
	actualPageMorph := anObject! !

!LazyTabPage methodsFor: 'accessing' stamp: 'TudorGirba 1/22/2011 17:49'!
labelMorph: anObject
	labelMorph := anObject! !

!LazyTabPage methodsFor: 'accessing' stamp: 'TudorGirba 1/22/2011 20:50'!
toolbar
	^ toolbar! !

!LazyTabPage methodsFor: 'testing' stamp: 'TudorGirba 1/22/2011 22:26'!
isRendered
	^ actualPageMorph notNil! !

!LazyTabPage methodsFor: 'accessing' stamp: 'TudorGirba 1/22/2011 17:49'!
labelMorph
	^ labelMorph! !

!LazyTabPage methodsFor: 'accessing' stamp: 'TudorGirba 1/22/2011 18:11'!
lazyPageMorphCreation: anObject
	lazyPageMorphCreation := anObject! !

!LazyTabPage methodsFor: 'accessing' stamp: 'TudorGirba 1/22/2011 20:50'!
toolbar: anObject
	toolbar := anObject! !

!LazyTabPage methodsFor: 'accessing' stamp: 'TudorGirba 1/22/2011 18:11'!
lazyPageMorphCreation
	^ lazyPageMorphCreation! !

!LazyTabPage methodsFor: 'accessing' stamp: 'TudorGirba 4/4/2011 00:56'!
actualPageMorph
	^ actualPageMorph ifNil: 
		[actualPageMorph := 
			self lazyPageMorphCreation value
				hResizing: #spaceFill;
				vResizing: #spaceFill;
				yourself]! !

!LazyTabPageAnnouncement methodsFor: 'accessing' stamp: 'TudorGirba 1/22/2011 23:07'!
page: anObject
	page := anObject! !

!LazyTabPageAnnouncement methodsFor: 'accessing' stamp: 'TudorGirba 1/22/2011 23:07'!
tabs: anObject
	tabs := anObject! !

!LazyTabPageAnnouncement methodsFor: 'accessing' stamp: 'TudorGirba 1/22/2011 23:07'!
page
	^ page! !

!LazyTabPageAnnouncement methodsFor: 'accessing' stamp: 'TudorGirba 1/23/2011 00:23'!
pageIndex
	^ pageIndex! !

!LazyTabPageAnnouncement methodsFor: 'accessing' stamp: 'TudorGirba 1/23/2011 00:23'!
pageIndex: anObject
	pageIndex := anObject! !

!LazyTabPageAnnouncement methodsFor: 'accessing' stamp: 'TudorGirba 1/22/2011 23:07'!
tabs
	^ tabs! !

!LazyTabPageChanged methodsFor: 'accessing' stamp: 'TudorGirba 1/22/2011 23:07'!
oldPage
	^ oldPage! !

!LazyTabPageChanged methodsFor: 'accessing' stamp: 'TudorGirba 1/22/2011 23:07'!
oldPage: anObject
	oldPage := anObject! !

!LazyTabPageRemoved methodsFor: 'accessing' stamp: 'TudorGirba 7/23/2011 20:33'!
newIndex: anObject
	newIndex := anObject! !

!LazyTabPageRemoved methodsFor: 'accessing' stamp: 'TudorGirba 7/23/2011 20:20'!
newIndex
	^ newIndex! !

!LeafNode commentStamp: '<historical>'!
I represent a leaf node of the compiler parse tree. I am abstract.
	
Types (defined in class ParseNode):
	1 LdInstType (which uses class VariableNode)
	2 LdTempType (which uses class VariableNode)
	3 LdLitType (which uses class LiteralNode)
	4 LdLitIndType (which uses class VariableNode)
	5 SendType (which uses class SelectorNode).

Note that Squeak departs slightly from the Blue Book bytecode spec.

In order to allow access to more than 63 literals and instance variables,
bytecode 132 has been redefined as DoubleExtendedDoAnything:
		byte2				byte3			Operation
(hi 3 bits)  (lo 5 bits)
	0		nargs			lit index			Send Literal Message 0-255
	1		nargs			lit index			Super-Send Lit Msg 0-255
	2		ignored			rcvr index		Push Receiver Variable 0-255
	3		ignored			lit index			Push Literal Constant 0-255
	4		ignored			lit index			Push Literal Variable 0-255
	5		ignored			rcvr index		Store Receiver Variable 0-255
	6		ignored			rcvr index		Store-pop Receiver Variable 0-255
	7		ignored			lit index			Store Literal Variable 0-255

	This has allowed bytecode 134 also to be redefined as a second extended send
	that can access literals up to 64 for nargs up to 3 without needing three bytes.
	It is just like 131, except that the extension byte is aallllll instead of aaalllll,
	where aaa are bits of argument count, and lll are bits of literal index.!
!LeafNode methodsFor: 'code generation' stamp: 'ab 7/6/2004 17:39'!
code

	^ code! !

!LeafNode methodsFor: 'initialize-release' stamp: 'eem 5/14/2008 15:56'!
key: object index: i type: type

	key := object.
	code := (self code: i type: type).
	index := i! !

!LeafNode methodsFor: 'initialize-release' stamp: 'ar 3/26/2004 15:44'!
name: ignored key: object code: byte

	key := object.
	code := byte! !

!LeafNode methodsFor: 'code generation (closures)' stamp: 'eem 6/16/2008 09:32'!
analyseTempsWithin: scopeBlock "<BlockNode>" rootNode: rootNode "<MethodNode>" assignmentPools: assignmentPools "<Dictionary>"
	"This is a no-op except in TempVariableNode"
	^self! !

!LeafNode methodsFor: 'copying' stamp: 'eem 5/14/2008 11:25'!
veryDeepFixupWith: deepCopier
	"If fields were weakly copied, fix them here.  If they were in the tree being copied, fix them up, otherwise point to the originals!!!!"

super veryDeepFixupWith: deepCopier.
key := (deepCopier references at: key ifAbsent: [key]).
! !

!LeafNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 14:52'!
emitCodeForEffect: stack encoder: encoder

	^self! !

!LeafNode methodsFor: 'code generation' stamp: 'eem 5/20/2008 15:24'!
sizeCodeForLoad: encoder
	"Default is to do nothing.
	 Subclasses may need to override."
	^0! !

!LeafNode methodsFor: 'code generation' stamp: 'eem 5/19/2008 15:10'!
sizeCodeForValue: encoder
	self subclassResponsibility! !

!LeafNode methodsFor: 'initialize-release' stamp: 'ar 3/26/2004 15:44'!
key: object code: byte

	key := object.
	code := byte! !

!LeafNode methodsFor: 'code generation' stamp: 'eem 5/20/2008 15:25'!
emitCodeForLoad: stack encoder: encoder
	"Default is to do nothing.
	 Subclasses may need to override."! !

!LeafNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 15:57'!
reserve: encoder 
	"If this is a yet unused literal of type -code, reserve it."

	code < 0 ifTrue: [code := self code: (index := encoder litIndex: key) type: 0 - code]! !

!LeafNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 14:52'!
sizeCodeForEffect: encoder

	^0! !

!LeafNode methodsFor: 'copying' stamp: 'eem 7/12/2008 17:24'!
veryDeepInner: deepCopier
	"Copy all of my instance variables.  Some need to be not copied at all, but shared.  	Warning!!!!  Every instance variable defined in this class must be handled.  We must also implement veryDeepFixupWith:.  See DeepCopier class comment."

super veryDeepInner: deepCopier.
"key := key.		Weakly copied"
code := code veryDeepCopyWith: deepCopier.
index := index veryDeepCopyWith: deepCopier.
! !

!LeafNode methodsFor: 'accessing' stamp: ''!
key

	^key! !

!LeafNode methodsFor: 'private' stamp: 'ClementBera 7/26/2013 16:48'!
code: argIndex type: type

	argIndex ifNil: [^type negated].
	(CodeLimits at: type) > argIndex 
		ifTrue: [^(CodeBases at: type) + argIndex].
	^type * 256 + argIndex! !

!LegacyWeakSubscription commentStamp: 'IgorStasenko 3/12/2011 21:37'!
I am a subclass which work when VM does not supports finalization lists.
I am about 3 times slower when it comes to finalizing items!
!LegacyWeakSubscription methodsFor: 'finalization' stamp: 'IgorStasenko 3/12/2011 18:19'!
register
	self weakRegistry 
		add: self subscriber executor: self! !

!LegacyWeakSubscription methodsFor: 'finalization' stamp: 'MarcusDenker 10/10/2013 23:38'!
unregister

	self subscriber ifNotNil: [:sub |  self weakRegistry remove: sub ]
		! !

!LegacyWeakSubscription methodsFor: 'converting' stamp: 'IgorStasenko 3/12/2011 18:32'!
makeStrong

	| sub |
	sub := self subscriber.
	sub ifNil: [ ^ self error: 'Subscriber is nil, cannot make strong subscription' ].
	
	self unregister.

	^ self becomeForward: (AnnouncementSubscription new
		announcer: announcer;
		action: action asMessageSend;
		subscriber: sub;
		announcementClass: announcementClass)
! !

!LegacyWeakSubscription methodsFor: 'accessing' stamp: 'IgorStasenko 3/12/2011 20:01'!
subscriber: anObject

	self subscriber ifNotNil: [ self error: 'subscriber already set' ].
	self basicAt: 1 put: anObject.
	self register! !

!LegacyWeakSubscription methodsFor: 'finalization' stamp: 'IgorStasenko 3/12/2011 14:16'!
weakRegistry
	^ WeakRegistry default! !

!Lesson commentStamp: 'LaurentLaffont 1/15/2010 10:25'!
See class side messages #welcome, #doingVSPrinting....
!
!Lesson methodsFor: 'accessing' stamp: 'LaurentLaffont 1/15/2010 09:25'!
lesson
	^ lesson ifNil: [lesson := '']! !

!Lesson methodsFor: 'accessing' stamp: 'LaurentLaffont 1/15/2010 09:25'!
lesson: aString
	lesson := aString! !

!Lesson methodsFor: 'accessing' stamp: 'LaurentLaffont 1/15/2010 09:25'!
title
	^ title ifNil: [title := '']! !

!Lesson methodsFor: 'printing' stamp: 'LaurentLaffont 2/15/2011 22:46'!
printOn: aStream
	super printOn: aStream.  
	aStream 
		nextPutAll: '(';
		nextPutAll: self title;
		nextPutAll: ')'.    ! !

!Lesson methodsFor: 'accessing' stamp: 'LaurentLaffont 1/15/2010 09:25'!
title: aString
	title := aString! !

!Lesson class methodsFor: 'instance creation' stamp: 'LaurentLaffont 1/15/2010 09:27'!
title: aStringForTitle lesson: aStringForLesson
	^ self new title: aStringForTitle; lesson: aStringForLesson; yourself.! !

!LessonTestInstanciation commentStamp: 'TorstenBergmann 2/12/2014 22:50'!
SUnit tests for lessons!
!LessonTestInstanciation methodsFor: 'tests' stamp: 'LaurentLaffont 1/21/2010 15:12'!
testNewLessonHaveEmptyStringForTitleLesson
	| newLesson  |
	newLesson := Lesson new.
	self assert: newLesson title equals: ''.
	self assert: newLesson lesson equals: ''.! !

!LessonTestInstanciation methodsFor: 'tests' stamp: 'CamilloBruni 2/22/2014 19:02'!
testTitleLessonCreation
	| firstLesson secondLesson |
	firstLesson := Lesson title: 'First lesson' lesson: 'Pharo rules!!'.
	secondLesson := Lesson title: 'Second lesson' lesson: 'PharoTutorial is cool'.
	
	self assert: firstLesson title equals: 'First lesson'.
	self assert: firstLesson lesson equals: 'Pharo rules!!'.
	
	self assert: secondLesson title equals: 'Second lesson'.
	self assert: secondLesson lesson equals: 'PharoTutorial is cool'.! !

!LessonView commentStamp: 'LaurentLaffont 1/15/2010 10:24'!
A LessonView displays a Lesson instance!
!LessonView methodsFor: 'gui' stamp: 'LaurentLaffont 1/21/2010 21:00'!
shoutMorphFillMenu: aMenu
	^ aMenu addAllFrom: self menu! !

!LessonView methodsFor: 'accessing' stamp: 'LaurentLaffont 1/21/2010 21:02'!
window 
	^ window ifNil: [self open. window]! !

!LessonView methodsFor: 'accessing' stamp: 'LaurentLaffont 1/21/2010 20:58'!
shoutMorph
	^ shoutMorph ifNil: [self open. shoutMorph]! !

!LessonView methodsFor: 'gui' stamp: 'LaurentLaffont 1/21/2010 21:01'!
close
	self window delete.! !

!LessonView methodsFor: 'gui' stamp: 'SvenVanCaekenberghe 3/27/2015 13:46'!
menu
	^ MenuMorph new
		add: 'do it (d)' selector: #doIt;
		add: 'print it (p)' selector: #printIt;
		add: 'inspect it (p)' selector: #inspectIt;
		yourself! !

!LessonView methodsFor: 'gui' stamp: 'EstebanLorenzano 7/31/2013 11:16'!
showLesson: aLesson withTitle: aString
	self window setLabel: aString.
	self shoutMorph 
		selectFrom: 0 to: 0;
		setText: aLesson lesson.
	(World systemWindows includes: self window) ifFalse: [self window openInWorld]
	! !

!LessonView methodsFor: 'gui' stamp: 'AlainPlantec 8/28/2011 13:54'!
open	
	shoutMorph  := PluggableTextMorph 
		on: self 
		text: nil
		accept: nil
		readSelection: nil 
		menu: #shoutMorphFillMenu:.
	shoutMorph
		setText: ''.
	window  := SystemWindow labelled: 'PrStef lesson'.
	window addMorph: shoutMorph  frame: (0@0 corner: 1@1).
	window openInWorld.! !

!LessonView methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 4/30/2014 16:12'!
isOpenInWindow
	^ World systemWindows includes: window! !

!LessonView methodsFor: 'accessing' stamp: 'LaurentLaffont 2/26/2012 14:13'!
shoutAboutToStyle: aPluggableShoutMorphOrView
	^ true! !

!LessonView methodsFor: 'accessing' stamp: 'LaurentLaffont 1/21/2010 21:06'!
text
	^ self shoutMorph text asString! !

!LimitedWriteStream commentStamp: '<historical>'!
A LimitedWriteStream is a specialized WriteStream that has a maximum size of the collection it streams over. When this limit is reached a special limitBlock is executed. This can for example be used to "bail out" of lengthy streaming operations before they have finished.  For a simple example take a look at the universal Object printString.

The message SequenceableCollection class streamContents:limitedTo: creates a LimitedWriteStream. In this case it prevents very large (or possibly recursive) object structures to "overdo" their textual representation. !
!LimitedWriteStream methodsFor: 'as yet unclassified' stamp: 'di 6/20/97 09:07'!
setLimit: sizeLimit limitBlock: aBlock
	"Limit the numer of elements this stream will write..."
	limit := sizeLimit.
	"Execute this (typically ^ contents) when that limit is exceded"
	limitBlock := aBlock! !

!LimitedWriteStream methodsFor: 'private' stamp: 'di 10/28/2001 12:49'!
pastEndPut: anObject
	collection size >= limit ifTrue: [limitBlock value].  "Exceptional return"
	^ super pastEndPut: anObject! !

!LimitedWriteStream methodsFor: 'accessing' stamp: 'LukasRenggli 5/8/2010 18:41'!
nextPut: anObject 
	"Ensure that the limit is not exceeded"

	position >= limit ifTrue: [limitBlock value]
		ifFalse: [ super nextPut: anObject ].
	^ anObject
! !

!LimitedWriteStream methodsFor: 'accessing' stamp: 'LukasRenggli 5/8/2010 18:42'!
nextPutAll: aCollection

	| newEnd |
	collection class == aCollection class 
		ifFalse: [ ^ super nextPutAll: aCollection ].

	newEnd := position + aCollection size.
	newEnd > limit ifTrue: [
		super nextPutAll: (aCollection copyFrom: 1 to: (limit - position max: 0)).
		limitBlock value.
		^ aCollection
	].
	newEnd > writeLimit ifTrue: [
		self growTo: newEnd + 10
	].

	collection replaceFrom: position+1 to: newEnd  with: aCollection startingAt: 1.
	position := newEnd.
	
	^ aCollection! !

!LimitingLineStreamWrapper commentStamp: '<historical>'!
I'm a wrapper for a stream optimized for line-by-line access using #nextLine. My instances can be nested.

I read one line ahead. Reading terminates when the stream ends, or if the limitingBlock evaluated with the line answers true. To skip the delimiting line for further reading use #skipThisLine.

Character-based reading (#next) is permitted, too. Send #updatePosition when switching from line-based reading.

See examples at the class side.

--bf 2/19/1999 12:52!
!LimitingLineStreamWrapper methodsFor: 'accessing' stamp: 'bf 11/24/1998 14:09'!
nextLine

	| thisLine |
	self atEnd ifTrue: [^nil].
	thisLine := line.
	line := stream nextLine.
	^thisLine
! !

!LimitingLineStreamWrapper methodsFor: 'testing' stamp: 'bf 11/13/1998 16:55'!
atEnd

	^line isNil or: [limitingBlock value: line]! !

!LimitingLineStreamWrapper methodsFor: 'stream protocol' stamp: 'bf 11/13/1998 17:00'!
close
	^stream close! !

!LimitingLineStreamWrapper methodsFor: 'accessing' stamp: 'ClementBera 7/26/2013 16:48'!
next
	"Provide character-based access"

	position ifNil: [^nil].
	position < line size ifTrue: [^line at: (position := position + 1)].
	line := stream nextLine.
	self updatePosition.
	^ Character cr! !

!LimitingLineStreamWrapper methodsFor: 'accessing' stamp: 'bf 11/13/1998 13:08'!
lastLineRead
	"Return line last read. At stream end, this is the boundary line or nil"

	^ line! !

!LimitingLineStreamWrapper methodsFor: 'accessing' stamp: 'bf 11/24/1998 14:25'!
delimiter: aString
	"Set limitBlock to check for a delimiting string. Be unlimiting if nil"

	self limitingBlock: (aString caseOf: {
		[nil] -> [[:aLine | false]].
		[''] -> [[:aLine | aLine size = 0]]
	} otherwise: [[:aLine | aLine beginsWith: aString]])
! !

!LimitingLineStreamWrapper methodsFor: 'accessing' stamp: 'bf 2/19/1999 11:45'!
linesUpToEnd

	| elements ln |
	elements := OrderedCollection new.
	[(ln := self nextLine) isNil] whileFalse: [ 
		elements add: ln].
	^elements! !

!LimitingLineStreamWrapper methodsFor: 'accessing' stamp: 'bf 11/24/1998 14:37'!
updatePosition
	"Call this before doing character-based access"

	position := self atEnd ifFalse: [0]! !

!LimitingLineStreamWrapper methodsFor: 'printing' stamp: 'bf 11/24/1998 13:39'!
printOn: aStream

	super printOn: aStream.
	aStream nextPutAll: ' on '.
	stream printOn: aStream! !

!LimitingLineStreamWrapper methodsFor: 'accessing' stamp: 'bf 11/24/1998 16:53'!
skipThisLine

	line := stream nextLine.
	self updatePosition.
! !

!LimitingLineStreamWrapper methodsFor: 'accessing' stamp: 'bf 11/13/1998 13:04'!
peekLine

	self atEnd ifTrue: [^nil].
	^ line! !

!LimitingLineStreamWrapper methodsFor: 'accessing' stamp: 'nice 1/5/2010 15:59'!
upToEnd

	
	^String streamContents: [:strm | | ln |
		[(ln := self nextLine) isNil] whileFalse: [ 
			strm nextPutAll: ln; cr]]! !

!LimitingLineStreamWrapper methodsFor: 'private' stamp: 'bf 11/24/1998 14:30'!
setStream: aStream delimiter: aString

	stream := aStream.
	line := stream nextLine.
	self delimiter: aString.	"sets position"
! !

!LimitingLineStreamWrapper methodsFor: 'accessing' stamp: 'stephane.ducasse 4/13/2009 21:08'!
limitingBlock: aBlock
	"The limitingBlock is evaluated with a line to check if this line terminates the stream"

	limitingBlock := aBlock.
	self updatePosition! !

!LimitingLineStreamWrapper class methodsFor: 'examples' stamp: 'MarcusDenker 9/12/2014 13:03'!
example1
	"LimitingLineStreamWrapper example1"
	"Separate chunks of text delimited by a special string"
	| inStream msgStream messages |
	inStream := self exampleStream.
	msgStream := self on: inStream delimiter: 'From '.
	messages := OrderedCollection new.
	[inStream atEnd] whileFalse: [
		msgStream skipThisLine.
		messages add: msgStream upToEnd].
	^messages
			! !

!LimitingLineStreamWrapper class methodsFor: 'instance creation' stamp: 'bf 11/24/1998 14:31'!
on: aStream delimiter: aString

	^self new setStream: aStream delimiter: aString
! !

!LimitingLineStreamWrapper class methodsFor: 'examples' stamp: 'damiencassou 5/30/2008 11:45'!
exampleStream
	^ 'From me@somewhere
From: me
To: you
Subject: Test

Test

From you@elsewhere
From: you
To: me
Subject: Re: test

okay
' readStream! !

!LimitingLineStreamWrapper class methodsFor: 'examples' stamp: 'MarcusDenker 9/12/2014 13:03'!
example2
	"LimitingLineStreamWrapper example2"
	"Demo nesting wrappers - get header lines from some messages"
	| inStream msgStream headers headerStream |
	inStream := self exampleStream.
	msgStream := self on: inStream delimiter: 'From '.
	headers := OrderedCollection new.
	[inStream atEnd] whileFalse: [
		msgStream skipThisLine. "Skip From"
		headerStream := self on: msgStream delimiter: ''.
		headers add: headerStream linesUpToEnd.
		[msgStream nextLine isNil] whileFalse. "Skip Body"
	].
	^headers
			! !

!LineMorph commentStamp: '<historical>'!
This is really only a shell for creating single-segment straight-line Shapes.!
!LineMorph class methodsFor: 'instance creation' stamp: 'di 8/20/2000 12:16'!
new
	^ self from: 0@0 to: 50@50 color: Color black width: 2! !

!LineMorph class methodsFor: 'instance creation' stamp: 'SeanDeNigris 9/17/2010 16:13'!
from: startPoint to: endPoint color: lineColor width: lineWidth

	^ self vertices: {startPoint. endPoint}
			color: Color black borderWidth: lineWidth borderColor: lineColor! !

!LineSegment commentStamp: '<historical>'!
This class represents a straight line segment between two points

Instance variables:
	start	<Point>	start point of the line
	end		<Point>	end point of the line
!
!LineSegment methodsFor: 'accessing' stamp: 'ar 6/7/2003 00:10'!
end: aPoint
	end := aPoint! !

!LineSegment methodsFor: 'accessing' stamp: 'ar 11/2/1998 12:12'!
bounds
	"Return the bounds containing the receiver"
	^(start min: end) corner: (start max: end)! !

!LineSegment methodsFor: 'accessing' stamp: 'ar 5/23/2001 19:11'!
direction
	^end - start! !

!LineSegment methodsFor: 'initialize' stamp: 'ar 11/2/1998 12:12'!
from: startPoint to: endPoint
	"Initialize the receiver"
	start := startPoint.
	end := endPoint.! !

!LineSegment methodsFor: 'converting' stamp: 'ar 11/2/1998 12:11'!
asBezier2Segment
	"Represent the receiver as quadratic bezier segment"
	^Bezier2Segment from: start to: end! !

!LineSegment methodsFor: 'vector functions' stamp: 'ar 11/2/1998 12:09'!
tangentAtStart
	"Return the tangent for the last point"
	^(end - start)! !

!LineSegment methodsFor: 'converting' stamp: 'ar 11/2/1998 12:11'!
asLineSegment
	"Represent the receiver as a straight line segment"
	^self! !

!LineSegment methodsFor: 'testing' stamp: 'ar 11/2/1998 12:08'!
isStraight
	"Return true if the receiver represents a straight line"
	^true! !

!LineSegment methodsFor: 'converting' stamp: 'ar 6/8/2003 15:38'!
asBezier2Segments: error
	"Demote a cubic bezier to a set of approximating quadratic beziers."
	| pts |
	pts := self asBezier2Points: error.
	^(1 to: pts size by: 3) collect:[:i| 
		Bezier2Segment from: (pts at: i) via: (pts at: i+1) to: (pts at: i+2)].
! !

!LineSegment methodsFor: 'bezier clipping' stamp: 'ar 6/8/2003 00:06'!
bezierClipCurve: aCurve
	^self bezierClipCurve: aCurve epsilon: 1! !

!LineSegment methodsFor: 'converting' stamp: 'ar 6/7/2003 00:08'!
reversed
	^self class controlPoints: self controlPoints reversed! !

!LineSegment methodsFor: 'testing' stamp: 'ar 11/2/1998 12:12'!
hasZeroLength
	"Return true if the receiver has zero length"
	^start = end! !

!LineSegment methodsFor: 'vector functions' stamp: 'ar 11/2/1998 12:09'!
tangentAtEnd
	"Return the tangent for the last point"
	^(end - start)! !

!LineSegment methodsFor: 'vector functions' stamp: 'pmm 3/13/2010 11:31'!
curveFrom: parameter1 to: parameter2
	"Create a new segment like the receiver but starting/ending at the given parametric values"
	| delta |
	delta := end - start.
	^self shallowCopy from: delta * parameter1 + start to: delta * parameter2 + start! !

!LineSegment methodsFor: 'accessing' stamp: 'ar 11/2/1998 12:12'!
start
	"Return the start point"
	^start! !

!LineSegment methodsFor: 'printing' stamp: 'ar 11/2/1998 12:13'!
printOn: aStream
	"Print the receiver on aStream"
	aStream 
		nextPutAll: self class name;
		nextPutAll:' from: ';
		print: start;
		nextPutAll: ' to: ';
		print: end;
		space.! !

!LineSegment methodsFor: 'bezier clipping' stamp: 'ar 6/8/2003 00:19'!
bezierClipCurve: aCurve epsilon: eps
	"Compute the intersection of the receiver (a line) with the given curve using bezier clipping."
	| tMin tMax clip newCurve |
	clip := self bezierClipInterval: aCurve.
	clip ifNil:[^#()]. "no overlap"
	tMin := clip at: 1.
	tMax := clip at: 2.
	newCurve := aCurve curveFrom: tMin to: tMax.
	newCurve length < eps ifTrue:[^Array with: (aCurve valueAt: tMin + tMax * 0.5)].
	(tMin < 0.001 and:[tMax > 0.999]) ifTrue:[
		"Need to split aCurve before proceeding"
		| curve1 curve2 |
		curve1 := aCurve curveFrom: 0.0 to: 0.5.
		curve2 := aCurve curveFrom: 0.5 to: 1.0.
		^(curve1 bezierClipCurve: self epsilon: eps),
			(curve2 bezierClipCurve: self epsilon: eps).
	].
	^newCurve bezierClipCurve: self epsilon: eps.! !

!LineSegment methodsFor: 'vector functions' stamp: 'ar 11/2/1998 12:08'!
length
	"Return the length of the receiver"
	^start dist: end! !

!LineSegment methodsFor: 'vector functions' stamp: 'ar 6/7/2003 00:08'!
controlPoints
	^{start. end}! !

!LineSegment methodsFor: 'vector functions' stamp: 'ar 11/2/1998 12:08'!
lineSegmentsDo: aBlock
	"Evaluate aBlock with the receiver's line segments"
	aBlock value: start value: end! !

!LineSegment methodsFor: 'vector functions' stamp: 'ar 11/2/1998 12:10'!
valueAtStart
	"Evaluate the receiver at it's start point (e.g., self valueAtEnd = (self valueAt: 0.0))"
	^start! !

!LineSegment methodsFor: 'vector functions' stamp: 'ar 6/7/2003 23:39'!
controlPointsDo: aBlock
	aBlock value: start; value: end! !

!LineSegment methodsFor: 'vector functions' stamp: 'ar 6/7/2003 00:15'!
asBezier2Curves: err
	^Array with: self! !

!LineSegment methodsFor: 'vector functions' stamp: 'ar 11/2/1998 12:09'!
tangentAt: parameter
	"Return the tangent at the given parametric value along the receiver"
	^end - start! !

!LineSegment methodsFor: 'converting' stamp: 'ar 6/7/2003 20:57'!
asTangentSegment
	^LineSegment from: end-start to: end-start! !

!LineSegment methodsFor: 'initialize' stamp: 'ar 6/7/2003 00:09'!
initializeFrom: controlPoints
	controlPoints size = 2 ifFalse:[self error:'Wrong number of control points'].
	start := controlPoints at: 1.
	end := controlPoints at: 2.! !

!LineSegment methodsFor: 'private' stamp: 'ar 6/7/2003 21:00'!
debugDrawAt: offset
	| canvas |
	canvas := Display getCanvas.
	canvas translateBy: offset during:[:aCanvas|
		self lineSegmentsDo:[:p1 :p2|
			aCanvas line: p1 rounded to: p2 rounded width: 1 color: Color black.
		].
	].! !

!LineSegment methodsFor: 'accessing' stamp: 'ar 6/7/2003 00:10'!
start: aPoint
	start := aPoint! !

!LineSegment methodsFor: 'converting' stamp: 'ar 6/8/2003 04:19'!
asBezier2Points: error
	^Array with: start with: start with: end! !

!LineSegment methodsFor: 'vector functions' stamp: 'ar 6/8/2003 00:54'!
tangentAtMid
	"Return the tangent for the last point"
	^(end - start)! !

!LineSegment methodsFor: 'vector functions' stamp: 'ar 6/7/2003 17:21'!
lineSegments: steps do: aBlock
	"Evaluate aBlock with the receiver's line segments"
	aBlock value: start value: end! !

!LineSegment methodsFor: 'intersection' stamp: 'nk 12/27/2003 13:00'!
roundTo: quantum
	start := start roundTo: quantum.
	end := end roundTo: quantum.! !

!LineSegment methodsFor: 'vector functions' stamp: 'ar 11/2/1998 12:10'!
valueAtEnd
	"Evaluate the receiver at it's end point (e.g., self valueAtEnd = (self valueAt: 1.0))"
	^end! !

!LineSegment methodsFor: 'accessing' stamp: 'ar 11/2/1998 12:12'!
end
	"Return the end point"
	^end! !

!LineSegment methodsFor: 'private' stamp: 'ar 6/7/2003 21:00'!
debugDraw
	^self debugDrawAt: 0@0.! !

!LineSegment methodsFor: 'vector functions' stamp: 'ar 5/23/2001 18:27'!
sideOfPoint: aPoint
	"Return the side of the receiver this point is on. The method returns
		-1: if aPoint is left
		 0: if aPoint is on
		+1: if a point is right
	of the receiver."
	| dx dy px py |
	dx := end x - start x.
	dy := end y - start y.
	px := aPoint x - start x.
	py := aPoint y - start y.
	^((dx * py) - (px * dy)) sign
"
	(LineSegment from: 0@0 to: 100@0) sideOfPoint: 50@-50.
	(LineSegment from: 0@0 to: 100@0) sideOfPoint: 50@50.
	(LineSegment from: 0@0 to: 100@0) sideOfPoint: 50@0.
"
! !

!LineSegment methodsFor: 'testing' stamp: 'ar 11/2/1998 12:07'!
isLineSegment
	"Return true if the receiver is a line segment"
	^true! !

!LineSegment methodsFor: 'converting' stamp: 'ar 11/2/1998 12:11'!
asIntegerSegment
	"Convert the receiver into integer representation"
	^self species from: start asIntegerPoint to: end asIntegerPoint! !

!LineSegment methodsFor: 'intersection' stamp: 'nk 3/29/2002 22:30'!
intersectionWith: anotherSegment
	"Copied from LineIntersections>>intersectFrom:to:with:to:"
	| det deltaPt alpha beta pt1Dir pt2Dir |
	pt1Dir := end - start.
	pt2Dir := anotherSegment end - anotherSegment start.
	det := (pt1Dir x * pt2Dir y) - (pt1Dir y * pt2Dir x).
	deltaPt := anotherSegment start - start.
	alpha := (deltaPt x * pt2Dir y) - (deltaPt y * pt2Dir x).
	beta := (deltaPt x * pt1Dir y) - (deltaPt y * pt1Dir x).
	det = 0 ifTrue:[^nil]. "no intersection"
	alpha * det < 0 ifTrue:[^nil].
	beta * det < 0 ifTrue:[^nil].
	det > 0 
		ifTrue:[(alpha > det or:[beta > det]) ifTrue:[^nil]]
		ifFalse:[(alpha < det or:[beta < det]) ifTrue:[^nil]].
	"And compute intersection"
	^start + (alpha * pt1Dir / (det@det))! !

!LineSegment methodsFor: 'bezier clipping' stamp: 'nice 1/5/2010 15:59'!
bezierClipInterval: aCurve
	"Compute the new bezier clip interval for the argument,
	based on the fat line (the direction aligned bounding box) of the receiver.
	Note: This could be modified so that multiple clip intervals are returned.
	The idea is that for a distance curve like

			x		x
	tMax----	--\-----/---\-------
				x		x
	tMin-------------------------

	all the intersections intervals with tMin/tMax are reported, therefore
	minimizing the iteration count. As it is, the process will slowly iterate
	against tMax and then the curve will be split.
	"
	| nrm tStep pts eps inside tValue tMin tMax last lastV lastT lastInside next nextV nextT nextInside vMin vMax |
	eps := 0.00001.					"distance epsilon"
	nrm := (start y - end y) @ (end x - start x). "normal direction for (end-start)"

	"Map receiver's control point into fat line; compute vMin and vMax"
	vMin := vMax := nil.
	self controlPointsDo:[:pt| | vValue |
		vValue := (nrm x * pt x) + (nrm y * pt y). "nrm dotProduct: pt."
		vMin == nil	ifTrue:[	vMin := vMax := vValue]
					ifFalse:[vValue < vMin ifTrue:[vMin := vValue].
							vValue > vMax ifTrue:[vMax := vValue]]].
	"Map the argument into fat line; compute tMin, tMax for clip"
	tStep := 1.0 / aCurve degree.
	pts := aCurve controlPoints.
	last := pts at: pts size.
	lastV := (nrm x * last x) + (nrm y * last y). "nrm dotProduct: last."
	lastT := 1.0.
	lastInside := lastV+eps < vMin ifTrue:[-1] ifFalse:[lastV-eps > vMax ifTrue:[1] ifFalse:[0]].

	"Now compute new minimal and maximal clip boundaries"
	inside := false.	"assume we're completely outside"
	tMin := 2.0. tMax := -1.0. 	"clip interval"
	1 to: pts size do:[:i|
		next := pts at: i.
		nextV := (nrm x * next x) + (nrm y * next y). "nrm dotProduct: next."
		false ifTrue:[
			(nextV - vMin / (vMax - vMin)) printString displayAt: 0@ (i-1*20)].
		nextT := i-1 * tStep.
		nextInside := nextV+eps < vMin ifTrue:[-1] ifFalse:[nextV-eps > vMax ifTrue:[1] ifFalse:[0]].
		nextInside = 0 ifTrue:[
			inside := true.
			tValue := nextT.
			tValue < tMin ifTrue:[tMin := tValue].
			tValue > tMax ifTrue:[tMax := tValue].
		].
		lastInside = nextInside ifFalse:["At least one clip boundary"
			inside := true.
			"See if one is below vMin"
			(lastInside + nextInside <= 0) ifTrue:[
				tValue := lastT + ((nextT - lastT) * (vMin - lastV) / (nextV - lastV)).
				tValue < tMin ifTrue:[tMin := tValue].
				tValue > tMax ifTrue:[tMax := tValue].
			].
			"See if one is above vMax"
			(lastInside + nextInside >= 0) ifTrue:[
				tValue := lastT + ((nextT - lastT) * (vMax - lastV) / (nextV - lastV)).
				tValue < tMin ifTrue:[tMin := tValue].
				tValue > tMax ifTrue:[tMax := tValue].
			].
		].
		last := next.
		lastT := nextT.
		lastV := nextV.
		lastInside := nextInside.
	].
	inside
		ifTrue:[^Array with: tMin with: tMax]
		ifFalse:[^nil]! !

!LineSegment methodsFor: 'accessing' stamp: 'ar 6/8/2003 00:07'!
degree
	^1! !

!LineSegment methodsFor: 'testing' stamp: 'ar 11/2/1998 12:07'!
isBezier2Segment
	"Return true if the receiver is a quadratic bezier segment"
	^false! !

!LineSegment methodsFor: 'testing' stamp: 'ar 6/8/2003 01:03'!
isArcSegment
	"Answer whether I approximate an arc segment reasonably well"
	| mid v1 v2 d1 d2 center |
	start = end ifTrue:[^false].
	mid := self valueAt: 0.5.
	v1 := (start + mid) * 0.5.
	v2 := (mid + end) * 0.5.
	d1 := mid - start. d1 := d1 y @ d1 x negated.
	d2 := end - mid.  d2 := d2 y @ d2 x negated.

	center := LineSegment
		intersectFrom: v1 with: d1 to: v2 with: d2.

	"Now see if the tangents are 'reasonably close' to the circle"
	d1 := (start - center) normalized dotProduct: self tangentAtStart normalized.
	d1 abs > 0.02 ifTrue:[^false].
	d1 := (end - center) normalized dotProduct: self tangentAtEnd normalized.
	d1 abs > 0.02 ifTrue:[^false].
	d1 := (mid - center) normalized dotProduct: self tangentAtMid normalized.
	d1 abs > 0.02 ifTrue:[^false].

	^true! !

!LineSegment methodsFor: 'vector functions' stamp: 'ar 11/2/1998 12:09'!
valueAt: parameter
	"Evaluate the receiver at the given parametric value"
	^start + (end - start * parameter)! !

!LineSegment class methodsFor: 'geometry' stamp: 'nk 8/19/2003 17:17'!
fromPoints: pts
	^self from: pts first to: pts third via: pts second! !

!LineSegment class methodsFor: 'instance creation' stamp: 'ar 11/1/1998 21:10'!
from: startPoint to: endPoint
	^self new from: startPoint to: endPoint! !

!LineSegment class methodsFor: 'utilities' stamp: 'ar 6/8/2003 00:49'!
intersectFrom: startPt with: startDir to: endPt with: endDir
	"Compute the intersection of two lines, e.g., compute alpha and beta for
		startPt + (alpha * startDir) = endPt + (beta * endDir).
	Reformulating this yields
		(alpha * startDir) - (beta * endDir) = endPt - startPt.
	or
		(alpha * startDir) + (-beta * endDir) = endPt - startPt.
	or
		(alpha * startDir x) + (-beta * endDir x) = endPt x - startPt x.
		(alpha * startDir y) + (-beta * endDir y) = endPt y - startPt y.
	which is trivial to solve using Cramer's rule. Note that since
	we're really only interested in the intersection point we need only
	one of alpha or beta since the resulting intersection point can be
	computed based on either one."
	| det deltaPt alpha |
	det := (startDir x * endDir y) - (startDir y * endDir x).
	det = 0.0 ifTrue:[^nil]. "There's no solution for it"
	deltaPt := endPt - startPt.
	alpha := (deltaPt x * endDir y) - (deltaPt y * endDir x).
	alpha := alpha / det.
	"And compute intersection"
	^startPt + (alpha * startDir)! !

!LineSegment class methodsFor: 'geometry' stamp: 'nk 8/19/2003 17:15'!
from: startPoint to: endPoint via: via
	(startPoint = via or: [ endPoint = via ]) ifTrue: [ ^self new from: startPoint to: endPoint ].
	^Bezier2Segment from: startPoint to: endPoint via: via! !

!LineSegment class methodsFor: 'instance creation' stamp: 'ar 6/7/2003 00:09'!
controlPoints: anArray
	"Create a new instance of the receiver from the given control points"
	anArray size = 2 ifTrue:[^LineSegment new initializeFrom: anArray].
	anArray size = 3 ifTrue:[^Bezier2Segment new initializeFrom: anArray].
	anArray size = 4 ifTrue:[^Bezier3Segment new initializeFrom: anArray].
	self error:'Unsupported'.! !

!LinearGradientPaint commentStamp: '<historical>'!
I represent a linear gradient paint.
My start and stop points defining 
the position and direction of gradient fill 
in user space coordinates,
so that the ramp color at 0 maps to starting point
and ramp color at 1 maps to stop point of linear gradient.



Also check the comment of my superclass to know better how and when you can use me.
!
!LinearGradientPaint methodsFor: 'accessing' stamp: 'IgorStasenko 4/12/2013 09:56'!
start: anObject
	
	start := anObject! !

!LinearGradientPaint methodsFor: 'accessing' stamp: 'FernandoOlivero 1/13/2012 23:10'!
stop

	^ stop! !

!LinearGradientPaint methodsFor: 'accessing' stamp: 'IgorStasenko 4/12/2013 09:56'!
stop: anObject
	
	stop := anObject! !

!LinearGradientPaint methodsFor: 'accessing' stamp: 'FernandoOlivero 1/13/2012 23:10'!
start

	^ start! !

!LinearGradientPaint methodsFor: 'converting' stamp: 'IgorStasenko 4/12/2013 10:14'!
asAthensPaintOn: aCanvas
	^ aCanvas surface
			createLinearGradient: self colorRamp
				start: self start 
				stop: self stop! !

!LinearGradientPaint class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 4/12/2013 09:56'!
from: aStartPoint  to: aStopPoint
	| p |
	p := self new.
	p initializeFrom: aStartPoint  to: aStopPoint.
	^ p! !

!Link commentStamp: '<historical>'!
An instance of me is a simple record of a pointer to another Link. I am an abstract class; my concrete subclasses, for example, Process, can be stored in a LinkedList structure.!
!Link methodsFor: 'converting' stamp: 'HenrikSperreJohansen 10/18/2009 15:59'!
asLink
	^self! !

!Link methodsFor: 'accessing' stamp: ''!
nextLink: aLink 
	"Store the argument, aLink, as the link to which the receiver refers. 
	Answer aLink."

	^nextLink := aLink! !

!Link methodsFor: 'accessing' stamp: ''!
nextLink
	"Answer the link to which the receiver points."

	^nextLink! !

!Link class methodsFor: 'instance creation' stamp: 'apb 10/3/2000 15:55'!
nextLink: aLink 
	"Answer an instance of me referring to the argument, aLink."

	^self new nextLink: aLink; yourself! !

!LinkWrapper commentStamp: 'MarcusDenker 7/21/2014 10:07'!
I am a special Slot that allows slots to be annotated with Reflectivity meta links.

I hold on to a Reflectivity Link. This specifies the Meta Object, selector to call, argumens and controll (#after, #before)

Code generation then if forwarded to the original Slot.


|link |
link :=  MetaLink new 
	metaObject:  Halt;
	selector: #now.

(TT slotNamed: #t) link: link.

TT new t!
!LinkWrapper methodsFor: 'accessing' stamp: 'MarcusDenker 6/27/2014 10:51'!
slot: anObject
	
	slot := anObject! !

!LinkWrapper methodsFor: 'forwarded' stamp: 'MarcusDenker 7/20/2014 15:34'!
hash
	^slot hash! !

!LinkWrapper methodsFor: 'accessing' stamp: 'MarcusDenker 6/27/2014 10:51'!
link
	
	^ link! !

!LinkWrapper methodsFor: 'forwarded' stamp: 'MarcusDenker 7/20/2014 15:34'!
size
	^slot size! !

!LinkWrapper methodsFor: 'forwarded' stamp: 'MarcusDenker 7/20/2014 15:33'!
parentScopeFor: aScope
	^slot parentScopeFor: aScope! !

!LinkWrapper methodsFor: 'forwarded' stamp: 'MarcusDenker 7/20/2014 15:34'!
isSpecial
	^slot isSpecial! !

!LinkWrapper methodsFor: 'forwarded' stamp: 'MarcusDenker 1/18/2015 20:04'!
isVirtual
	^slot isVirtual! !

!LinkWrapper methodsFor: 'accessing' stamp: 'MarcusDenker 7/2/2014 17:44'!
setClass: aClass
	class := aClass! !

!LinkWrapper methodsFor: 'forwarded' stamp: 'MarcusDenker 1/18/2015 20:13'!
doesNotUnderstand: aMessage
	^ slot perform: aMessage selector withArguments: aMessage arguments! !

!LinkWrapper methodsFor: 'forwarded' stamp: 'MarcusDenker 7/20/2014 15:34'!
= aSlot
	^slot = aSlot! !

!LinkWrapper methodsFor: 'accessing' stamp: 'MarcusDenker 6/27/2014 10:51'!
slot
	
	^ slot! !

!LinkWrapper methodsFor: 'emitting' stamp: 'MarcusDenker 2/13/2015 16:11'!
emitValue: aMethodBuilder
	self flag: 'to be completed, now just before link with no params'.
	aMethodBuilder
		pushLiteral: link metaObject;
		send: link selector;
		popTop.

	slot emitValue: aMethodBuilder.
	! !

!LinkWrapper methodsFor: 'forwarded' stamp: 'MarcusDenker 7/20/2014 15:33'!
index:	anInteger
	^slot index: anInteger! !

!LinkWrapper methodsFor: 'forwarded' stamp: 'MarcusDenker 7/20/2014 15:33'!
name: aName
	^slot name: aName! !

!LinkWrapper methodsFor: 'forwarded' stamp: 'MarcusDenker 7/20/2014 15:34'!
isVisible
	^slot isVisible! !

!LinkWrapper methodsFor: 'accessing' stamp: 'MarcusDenker 7/14/2014 09:25'!
setLink: anObject
	
	link := anObject! !

!LinkWrapper methodsFor: 'forwarded' stamp: 'MarcusDenker 7/20/2014 15:33'!
name
	^slot name! !

!LinkWrapper methodsFor: 'installation' stamp: 'MarcusDenker 3/3/2015 11:21'!
uninstall
	| slotIndex |
	slotIndex := self definingClass layout slotScope indexOf: self.
	self definingClass layout slotScope at: slotIndex + 1 put: self slot.	
	self slot usingMethods do: #recompile.
! !

!LinkWrapper methodsFor: 'forwarded' stamp: 'MarcusDenker 7/20/2014 15:59'!
index
	^slot index! !

!LinkWrapperGlobal commentStamp: 'MarcusDenker 7/21/2014 15:39'!
I am a special Slot that allows slots to be annotated with Reflectivity meta links.

|link |
link :=  MetaLink new 
	metaObject:  Halt;
	selector: #now.

(TT classVariableNamed: #T) link: link.
!
!LinkWrapperGlobal methodsFor: 'accessing' stamp: 'MarcusDenker 7/21/2014 15:16'!
wrappedVariable: aLiteralVariable
	
	wrappedVariable := aLiteralVariable! !

!LinkWrapperGlobal methodsFor: 'code generation' stamp: 'MarcusDenker 7/21/2014 15:27'!
emitValue: aMethodBuilder
	self flag: 'to be completed, now just before link with no params'.
	aMethodBuilder
		pushLiteral: link metaObject;
		send: link selector.

	wrappedVariable emitValue: aMethodBuilder.
	! !

!LinkWrapperGlobal methodsFor: 'accessing' stamp: 'MarcusDenker 7/21/2014 15:16'!
wrappedVariable
	
	^wrappedVariable! !

!LinkWrapperGlobal methodsFor: 'accessing' stamp: 'MarcusDenker 7/21/2014 13:22'!
setLink: anObject
	
	link := anObject! !

!LinkedList commentStamp: 'HenrikSperreJohansen 10/18/2009 16:09'!
A LinkedList is a sequential collection of objects where adjecent objects are linked by pointer. Using the message sequence addFirst:/removeLast causes the receiver to behave as a stack; using addLast:/removeFirst causes the receiver to behave as a queue.

A LinkedList can be used to hold two different kinds of objecs: 
  (a) Objects inheriting frm Link
  (b) Any objects.

If you attempt to add any object into a LinkedList that is not a Link, it will automatically be wrapped by a ValueLink. A LinkedList therefore behaves very much like any collection, except that certain calls such as atIndex: are linear rather than constant time.!
!LinkedList methodsFor: 'removing' stamp: 'nice 1/10/2009 00:23'!
removeAll
	"Implementation note: this has to be fast"

	firstLink := lastLink := nil! !

!LinkedList methodsFor: 'enumerating' stamp: 'HenrikSperreJohansen 10/19/2009 11:03'!
linksDo: aBlock

	| aLink |
	aLink := firstLink.
	[aLink == nil ] whileFalse:
		[
		aBlock value: aLink.
		aLink := aLink nextLink]! !

!LinkedList methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 10/18/2009 17:20'!
last
	"Answer the last link. Create an error notification if the receiver is 
	empty."


	^self lastLink value! !

!LinkedList methodsFor: 'enumerating' stamp: 'ajh 8/6/2002 16:39'!
species

	^ Array! !

!LinkedList methodsFor: 'private' stamp: 'HenrikSperreJohansen 10/18/2009 17:43'!
linkOf: anObject ifAbsent: errorBlock 
	
	self
		linksDo: [:el | el value = anObject
				ifTrue: [^ el]].
	^ errorBlock value! !

!LinkedList methodsFor: 'removing' stamp: 'HenrikSperreJohansen 10/18/2009 17:43'!
removeLink: aLink
	^self removeLink: aLink ifAbsent: [self error: 'no such method!!']! !

!LinkedList methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 10/18/2009 17:20'!
first
	"Answer the first link. Create an error notification if the receiver is 
	empty."
^self firstLink value! !

!LinkedList methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 3/21/2013 13:02'!
at: index putLink: aLink 
	| previousLink nextLink |
	"Please don't put a link which is already in the list, or you will create an infinite loop"
	(self validIndex: index)
		ifFalse: [^ self errorOutOfBounds].
	index = 1
		ifTrue: [aLink nextLink: self firstLink nextLink.
			firstLink := aLink.
			aLink nextLink ifNil: [lastLink := aLink].
			^ aLink].
	previousLink := self linkAt: index - 1.
	nextLink := previousLink nextLink nextLink.
	
	nextLink ifNil: [
		aLink nextLink: self lastLink
	] ifNotNil: [
		aLink nextLink: nextLink.
	].

	previousLink nextLink: aLink.

	nextLink ifNil: [
		lastLink := aLink.
		aLink nextLink: nil.
	].

	^ aLink! !

!LinkedList methodsFor: 'copying' stamp: 'HenrikSperreJohansen 10/18/2009 13:02'!
copyWithout: oldElement
	|newInst| 
	newInst := self class new.
	self do: [:each | each = oldElement ifFalse: [newInst add: each]].
	^newInst! !

!LinkedList methodsFor: 'adding' stamp: 'HenrikSperreJohansen 10/18/2009 16:58'!
addLast: aLinkOrObject
	"Add aLink to the end of the receiver's list. Answer aLink."
	|aLink|
	aLink := aLinkOrObject asLink.
	self isEmpty
		ifTrue: [firstLink := aLink]
		ifFalse: [lastLink nextLink: aLink].
	lastLink := aLink.
	^aLink! !

!LinkedList methodsFor: 'private' stamp: 'HenrikSperreJohansen 10/19/2009 11:58'!
validIndex: index
	 ^index > 0
			and: [index <= self size]! !

!LinkedList methodsFor: 'private' stamp: 'HenrikSperreJohansen 10/18/2009 17:40'!
linkOf: anObject 
	^ self
		linkOf: anObject
		ifAbsent: [self error: 'No such element']! !

!LinkedList methodsFor: 'adding' stamp: 'BernardoContreras 9/9/2014 19:47'!
add: link after: otherLinkOrObject
	"Add otherLink  after link in the list. Answer aLink."

	| otherLink |
	otherLink := self linkAt: (self indexOf: otherLinkOrObject).
	^ self add: link afterLink: otherLink! !

!LinkedList methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 10/18/2009 15:36'!
at: index

	^(self linkAt: index) value! !

!LinkedList methodsFor: 'adding' stamp: 'HenrikSperreJohansen 10/18/2009 14:58'!
add: aLinkOrObject
	"Add aLink to the end of the receiver's list. Answer aLink."

	^self addLast: aLinkOrObject! !

!LinkedList methodsFor: 'removing' stamp: 'HenrikSperreJohansen 10/18/2009 18:33'!
removeLink: aLink ifAbsent: aBlock  
	"Remove aLink from the receiver. If it is not there, answer the result of
	evaluating aBlock."

	| tempLink |
	aLink == firstLink
		ifTrue: [firstLink := aLink nextLink.
				aLink == lastLink
					ifTrue: [lastLink := nil]]
		ifFalse: [tempLink := firstLink.
				[tempLink == nil ifTrue: [^aBlock value].
				 tempLink nextLink == aLink]
					whileFalse: [tempLink := tempLink nextLink].
				tempLink nextLink: aLink nextLink.
				aLink == lastLink
					ifTrue: [lastLink := tempLink]].
	"Not nilling the link enables us to delete while iterating"
	"aLink nextLink: nil."
	^aLink! !

!LinkedList methodsFor: 'private' stamp: 'HenrikSperreJohansen 10/18/2009 17:08'!
linkAt: index ifAbsent: errorBlock

	| i |
	i := 0.
	self linksDo: [:link |
		(i := i + 1) = index ifTrue: [^ link]].
	^ errorBlock value! !

!LinkedList methodsFor: 'adding' stamp: 'BernardoContreras 9/9/2014 19:47'!
add: link before: otherLinkOrObject
	"Add otherLink  after link in the list. Answer aLink."

	| otherLink |
	otherLink := self linkAt: (self indexOf: otherLinkOrObject).
	^ self add: link beforeLink: otherLink! !

!LinkedList methodsFor: 'enumerating' stamp: 'BernardoContreras 2/28/2015 12:59'!
collect: collectBlock thenSelect: selectBlock
	"Optimized version of SequenceableCollection>>#collect:#thenSelect:"

	| newCollection newElement |
	newCollection := self class new.
	self
		do: [ :each | 
			newElement := collectBlock value: each.
			(selectBlock value: newElement)
				ifTrue: [ newCollection add: newElement ] ].
	^ newCollection! !

!LinkedList methodsFor: 'copying' stamp: 'HenrikSperreJohansen 10/19/2009 15:09'!
copyWith: newElement
	^self copy add: newElement; yourself! !

!LinkedList methodsFor: 'adding' stamp: 'HenrikSperreJohansen 10/18/2009 16:37'!
add: aLinkOrObject beforeLink: otherLink

	| currentLink|

	firstLink == otherLink ifTrue: [^ self addFirst: aLinkOrObject].
	
	currentLink := firstLink.
	[currentLink == nil] whileFalse: [
		currentLink nextLink == otherLink ifTrue: [
			| aLink |
			aLink := aLinkOrObject asLink.
			aLink nextLink: currentLink nextLink.
			currentLink nextLink: aLink.
			^ aLink
		].
		 currentLink := currentLink nextLink.
	].
	^ self errorNotFound: otherLink! !

!LinkedList methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 10/19/2009 14:42'!
swap: ix1 with: ix2
	"Reimplemented, super would create an infinite loop"
	| minIx maxIx link1Prev link2Prev link1 link2 link1Next link2Next newLink2Next |
	((self validIndex: ix1) and: [self validIndex: ix2])	ifFalse: [^ self errorOutOfBounds].
	
	"Get edge case out of the way"
	ix1 = ix2 ifTrue: [^ self ].
	
	"Sort indexes to make boundary-checks easier" 
	minIx := ix1 min: ix2.
	maxIx := ix2 max: ix1.
	
	link1Prev := (minIx = 1) ifFalse: [self linkAt: minIx -1].
	link1 := link1Prev ifNotNil: [ link1Prev nextLink]
				ifNil: [self linkAt: minIx].
	link1Next := link1 nextLink.
	link2Prev := self linkAt: maxIx -1.
	link2 := link2Prev nextLink.
	link2Next := link2 nextLink.
	
	"Link at start being swapped"
	link1 = firstLink ifTrue: [firstLink := link2.] ifFalse: [link1Prev nextLink: link2].
	"Link at end being swapped"
	link2 = lastLink ifTrue: [lastLink := link1] ifFalse: [].
	"Links  being swapped adjacent"
	newLink2Next := (link1 nextLink = link2) ifTrue: [link1] ifFalse: [link2Prev nextLink: link1.
		link1Next].
	link1 nextLink: link2Next.
	link2 nextLink: newLink2Next.
	! !

!LinkedList methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 10/18/2009 17:20'!
firstLink
	"Answer the first link. Create an error notification if the receiver is 
	empty."

	self emptyCheck.
	^firstLink ! !

!LinkedList methodsFor: 'removing' stamp: 'MarcusDenker 3/5/2010 16:54'!
removeFirst
	"Remove the first element and answer it. If the receiver is empty, create 
	an error notification."

	| oldLink |
	self emptyCheck.
	oldLink := firstLink.
	firstLink == lastLink
		ifTrue: [firstLink := nil. lastLink := nil]
		ifFalse: [firstLink := oldLink nextLink].
	oldLink nextLink: nil.
	^oldLink value! !

!LinkedList methodsFor: 'testing' stamp: 'marcus.denker 9/14/2008 18:58'!
isEmpty

	^firstLink isNil! !

!LinkedList methodsFor: 'private' stamp: 'HenrikSperreJohansen 10/18/2009 17:09'!
indexOf: anElement startingAt: start ifAbsent: exceptionBlock
	"Answer the index of the first occurence of anElement after start
	within the receiver. If the receiver does not contain anElement, 
	answer the 	result of evaluating the argument, exceptionBlock."
			
	|currentLink index|		
	currentLink := self linkAt: start ifAbsent: [nil].
	index := start.
	[currentLink isNil ] 
		whileFalse: [currentLink value = anElement value ifTrue: [^index].
					currentLink := currentLink nextLink.
					index := index +1].
	^exceptionBlock value! !

!LinkedList methodsFor: 'accessing' stamp: 'MaxLeske 9/16/2014 10:10'!
size
	"Answer how many elements the receiver contains."

	| tally |
	tally := 0.
	self do: [:each | tally := tally + 1].
	^ tally! !

!LinkedList methodsFor: 'removing' stamp: 'slave 01/17/2011 12:59'!
remove: aLinkOrObject ifAbsent: aBlock 
	"Remove aLink from the receiver. If it is not there, answer the result of evaluating aBlock."
	
	| link |
	link := self linkOf: aLinkOrObject ifAbsent: [^aBlock value].
	self removeLink: link ifAbsent: [^aBlock value].
	^aLinkOrObject! !

!LinkedList methodsFor: 'adding' stamp: 'HenrikSperreJohansen 10/18/2009 17:09'!
addFirst: aLinkOrObject 
	"Add aLink to the beginning of the receiver's list. Answer aLink."
	|aLink|
	aLink := aLinkOrObject asLink.
	self isEmpty ifTrue: [lastLink := aLink].
	aLink nextLink: firstLink.
	firstLink := aLink.
	^aLink! !

!LinkedList methodsFor: 'enumerating' stamp: 'BernardoContreras 2/25/2015 23:16'!
select: selectBlock thenCollect: collectBlock
	"Optimized version of SequenceableCollection>>#select:thenCollect:"

	| newCollection |
	newCollection := self class new.
	self
		do: [ :each | 
			(selectBlock value: each)
				ifTrue: [ newCollection add: (collectBlock value: each) ] ].
	^ newCollection! !

!LinkedList methodsFor: 'private' stamp: 'HenrikSperreJohansen 10/18/2009 17:11'!
linkAt: index

	^self linkAt: index ifAbsent: [ self errorSubscriptBounds: index]! !

!LinkedList methodsFor: 'enumerating' stamp: 'CamilloBruni 10/20/2012 21:54'!
select: aBlock 
	"Reimplemennt #select: for speedup on linked lists. 
	The super implemention accesses the linkes by index, thus causing an O(n^2)"
	
	| newCollection |
	newCollection := self class new.
	self do: [ :each | 
		(aBlock value: each) 
			ifTrue: [ newCollection add: each ]].
	^newCollection! !

!LinkedList methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 10/19/2009 10:53'!
at: index put: anObject

	^self at: index putLink: (self linkOf: anObject ifAbsent: [anObject asLink])! !

!LinkedList methodsFor: 'enumerating' stamp: 'HenrikSperreJohansen 10/18/2009 15:48'!
do: aBlock

	| aLink |
	aLink := firstLink.
	[aLink == nil] whileFalse:
		[aBlock value: aLink value.
		 aLink := aLink nextLink]! !

!LinkedList methodsFor: 'removing' stamp: 'MarcusDenker 3/5/2010 16:54'!
removeLast
	"Remove the receiver's last element and answer it. If the receiver is 
	empty, create an error notification."

	| oldLink aLink |
	self emptyCheck.
	oldLink := lastLink.
	firstLink == lastLink
		ifTrue: [firstLink := nil. lastLink := nil]
		ifFalse: [aLink := firstLink.
				[aLink nextLink == oldLink] whileFalse:
					[aLink := aLink nextLink].
				 aLink nextLink: nil.
				 lastLink := aLink].
	oldLink nextLink: nil.
	^oldLink value! !

!LinkedList methodsFor: 'copying' stamp: 'ClementBera 7/26/2013 16:58'!
postCopy
	| aLink |
	super postCopy.
	firstLink ifNotNil: [
		aLink := firstLink := firstLink copy.
		[aLink nextLink isNil] whileFalse: [aLink nextLink: (aLink := aLink nextLink copy)].
		lastLink := aLink].! !

!LinkedList methodsFor: 'adding' stamp: 'HenrikSperreJohansen 10/18/2009 16:39'!
add: aLinkOrObject afterLink: otherLink

	"Add otherLink  after link in the list. Answer aLink."

	| savedLink aLink |
	lastLink == otherLink ifTrue: [^ self addLast: aLinkOrObject].
	savedLink := otherLink nextLink.
	aLink := aLinkOrObject asLink.
	otherLink nextLink: aLink.
	aLink nextLink:  savedLink.
	^aLink.! !

!LinkedList methodsFor: 'enumerating' stamp: 'AlainPlantec 10/12/2011 19:41'!
collect: aBlock 
	"Evaluate aBlock with each of the receiver's elements as the argument.  
	Collect the resulting values into a collection like the receiver. Answer  
	the new collection."

	| aLink newCollection |
	newCollection := self class new.
	aLink := firstLink.
	[aLink == nil] whileFalse:
		[newCollection add: (aBlock value: aLink value).
		 aLink := aLink nextLink].
	^ newCollection! !

!LinkedList methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 10/18/2009 17:19'!
lastLink
	"Answer the last link. Create an error notification if the receiver is 
	empty."

	self emptyCheck.
	^lastLink! !

!LinkedList methodsFor: 'removing' stamp: 'HenrikSperreJohansen 10/18/2009 18:10'!
removeAllSuchThat: aBlock 
	"Evaluate aBlock for each element and remove all that elements from
	the receiver for that aBlock evaluates to true.  For LinkedLists, it's safe to use do:."

	self do: [:each | (aBlock value: each) ifTrue: [self remove: each]]! !

!LinkedList class methodsFor: 'instance creation' stamp: 'HenrikSperreJohansen 10/19/2009 15:03'!
new: anInt
	"LinkedList don't need capacity"
	^self new! !

!LinkedList class methodsFor: 'stream creation' stamp: 'CamilloBruni 9/5/2011 15:34'!
new: size streamContents: aBlock
	^ self withAll: (super new: size streamContents: aBlock)! !

!LinkedList class methodsFor: 'accessing' stamp: 'CamilloBruni 9/5/2011 15:38'!
streamSpecies
	^ Array! !

!LinkedList class methodsFor: 'instance creation' stamp: 'nice 2/8/2012 21:23'!
newFrom: aCollection
	"Answer an instance with same elements as aCollection."
	^self new
		addAll: aCollection;
		yourself! !

!LinkedListTest commentStamp: 'mk 8/3/2005 11:55'!
A set of test cases which thoroughly test functionality of the LinkedList class.!
!LinkedListTest methodsFor: 'tests - remove' stamp: ''!
testRemoveAllError
	"self debug: #testRemoveElementThatExists"
	| el aSubCollection |
	el := self elementNotIn.
	aSubCollection := self nonEmptyWithoutEqualElements copyWith: el.
	self 
		should: [ | res | res := self nonEmptyWithoutEqualElements removeAll: aSubCollection ]
		raise: Error! !

!LinkedListTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButLast
	"self debug: #testAllButLast"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButLast.
	self deny: abf last = col last.
	self assert: abf size + 1 = col size! !

!LinkedListTest methodsFor: 'tests - begins ends with' stamp: ''!
testsEndsWith
	
	self assert: (self nonEmpty endsWith: self nonEmpty copyWithoutFirst).
	self assert: (self nonEmpty endsWith: self nonEmpty).
	self deny: (self nonEmpty endsWith: (self nonEmpty copyWith: self nonEmpty first)).! !

!LinkedListTest methodsFor: 'tests - copying with replacement' stamp: ''!
testCopyReplaceAllWith1Occurence
	| result  firstIndexesOfOccurrence index endPartIndexResult endPartIndexCollection |
	
	result := self collectionWith1TimeSubcollection  copyReplaceAll: self oldSubCollection with: self replacementCollection .
	
	"detecting indexes of olSubCollection"
	firstIndexesOfOccurrence  := self firstIndexesOf: self oldSubCollection in: self collectionWith1TimeSubcollection .
	index:= firstIndexesOfOccurrence at: 1.
	
	"verify content of 'result' : "
	"first part of 'result'' : '"

	1 to: (index -1) do: 
		[
		:i |  
		self assert: (self collectionWith1TimeSubcollection  at:i)=(result at: i)
		].

	" middle part containing replacementCollection : "
	
	index to: (index + self replacementCollection size-1) do: 
		[
		:i |
		self assert: ( result at: i )=(self replacementCollection at: ( i - index + 1 ))
		].
	
	" end part :"
	
	endPartIndexResult :=  index + self replacementCollection  size .
	endPartIndexCollection :=   index + self oldSubCollection size  .
	
	1 to: (result size - endPartIndexResult - 1 ) do:
		[ 
		:i |
		self assert: (result at: ( endPartIndexResult + i - 1 ) ) = (self collectionWith1TimeSubcollection  at: ( endPartIndexCollection + i - 1 ) ).
		].
	
	
	! !

!LinkedListTest methodsFor: 'tests - index access' stamp: ''!
testLastIndexOf
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection lastIndexOf: element) = 1.
	self assert: (collection lastIndexOf: self elementNotInForIndexAccessing) = 0! !

!LinkedListTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyWithReplacementTest
	self replacementCollection.
	self oldSubCollection.
	self collectionWith1TimeSubcollection.
	self assert: (self howMany: self oldSubCollection in: self collectionWith1TimeSubcollection) = 1! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 10:52'!
moreThan4Elements

" return a collection including at leat 4 elements"
	^ collectionWithoutEqualElements ! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testReject

	| res element |
	res := self collectionWithoutNilElements reject: [:each | each notNil not].
	self assert: res size = self collectionWithoutNilElements size.
	
	element := self collectionWithoutNilElements anyOne.
	res := self collectionWithoutNilElements  reject: [:each | each = element].
	self assert: res size = (self collectionWithoutNilElements size - 1).
	
	
	! !

!LinkedListTest methodsFor: 'tests - subcollections access' stamp: ''!
testFirstNElements
	"self debug: #testFirstNElements"
	| result |
	result := self moreThan3Elements first: self moreThan3Elements size - 1.
	1 
		to: result size
		do: [ :i | self assert: (result at: i) = (self moreThan3Elements at: i) ].
	self assert: result size = (self moreThan3Elements size - 1).
	self 
		should: [ self moreThan3Elements first: self moreThan3Elements size + 1 ]
		raise: Error! !

!LinkedListTest methodsFor: 'tests - adding' stamp: ''!
testTWrite
	| added collection elem |
	collection := self otherCollection  .
	elem := self element .
	added := collection  write: elem .
	
	self assert: added == elem .	"test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection  includes: elem )	.
	self assert: (collection  includes: elem ).
	
	! !

!LinkedListTest methodsFor: 'tests - fixture' stamp: ''!
test0TStructuralEqualityTest
	self empty.
	self nonEmpty.
	self assert: self empty isEmpty.
	self deny: self nonEmpty isEmpty! !

!LinkedListTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithoutFirst

	| result |
	result := self nonEmpty copyWithoutFirst.
	
	self assert: result size = (self nonEmpty size - 1).
	
	1 to: result size do:
		[:i |
		self assert: (result at: i)= (self nonEmpty at: (i + 1))].! !

!LinkedListTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionTwoSimilarElementsInIntersection
	"self debug: #testIntersectionBasic"
	| inter |
	inter := self collection intersection: (self collectionClass with: self anotherElementOrAssociationIn).
	self assert: (self collection occurrencesOf: self anotherElementOrAssociationIn) = self numberOfSimilarElementsInIntersection.
	self assert: (inter includes: self anotherElementOrAssociationIn value)! !

!LinkedListTest methodsFor: 'tests - element accessing' stamp: ''!
testBefore
	"self debug: #testBefore"
	self assert: (self moreThan4Elements before: (self moreThan4Elements at: 2)) = (self moreThan4Elements at: 1).
	self 
		should: [ self moreThan4Elements before: (self moreThan4Elements at: 1) ]
		raise: Error.
	self 
		should: [ self moreThan4Elements before: 66 ]
		raise: Error! !

!LinkedListTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAnyNoneThere
	"self debug: #testIncludesAnyOfNoneThere'"
	
	self deny: (self nonEmpty includesAny: self empty).
	self deny: (self nonEmpty includesAny: { self elementNotIn. self anotherElementNotIn })! !

!LinkedListTest methodsFor: 'testing' stamp: 'mk 8/3/2005 12:04'!
test03addFirst
	self assert: list isEmpty.
	
	list addFirst: link1.
	self assert: list size = 1.
	self assert: list first = link1.
	
	list addFirst: link2.
	self assert: list size = 2.
	self assert: list first = link2.
	self assert: list second = link1.
	
	list addFirst: link3.
	self assert: list size = 3.
	self assert: list first = link3.
	self assert: list second = link2.
	self assert: list third = link1.
	
	list addFirst: link4.
	self assert: list size = 4.
	self assert: list first = link4.
	self assert: list second = link3.
	self assert: list third = link2.
	self assert: list fourth = link1! !

!LinkedListTest methodsFor: 'requirements' stamp: 'CamilloBruni 9/9/2011 12:11'!
collectionWithoutEqualElements

" return a collection not including equal elements "
	^collectionWithoutEqualElements ! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testAllSatisfyEmpty

	self assert: ( self empty allSatisfy: [:each | false]).
	! !

!LinkedListTest methodsFor: 'tests - converting' stamp: ''!
testAsArray
	"self debug: #testAsArray3"
	self 
		assertSameContents: self collectionWithoutEqualElements
		whenConvertedTo: Array! !

!LinkedListTest methodsFor: 'tests - copy' stamp: ''!
testCopyNotSame
	"self debug: #testCopySameClass"
	"A copy of a collection should always be of the same class as the instance it copies"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: copy  == self nonEmpty.! !

!LinkedListTest methodsFor: 'tests - set arithmetic' stamp: ''!
testUnionOfEmpties
	"self debug: #testUnionOfEmpties"
	
	self assert:  (self empty union: self empty) isEmpty.
	
	! !

!LinkedListTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindFirst

	| element result |
	element := self nonEmptyMoreThan1Element   at:1.
	 result:=self nonEmptyMoreThan1Element  findFirst: [:each | each =element].
	
	self assert: result=1. ! !

!LinkedListTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithIndexCollect
	
	| result index collection |
	index := 0.
	collection := self nonEmptyMoreThan1Element .
	result := collection  withIndexCollect: [:each :i | 
		self assert: i = (index := index + 1).	
		self assert: i = (collection  indexOf: each) .
		each] . 
	
	1 to: result size do:[: i | self assert: (result at:i)= (collection at: i)].
	self assert: result size = collection size.! !

!LinkedListTest methodsFor: 'tests - adding' stamp: ''!
testTAddAll
	| added collection toBeAdded |
	collection := self collectionWithElement .
	toBeAdded := self otherCollection .
	added := collection addAll: toBeAdded .
	self assert: added == toBeAdded .	"test for identiy because #addAll: has not reason to copy its parameter."
	self assert: (collection includesAll: toBeAdded )! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testDoSeparatedBy
	| string expectedString beforeFirst |
	
	string := ''.
	self collectionWithoutNilElements  
		do: [ :each | string := string , each asString ]
		separatedBy: [ string := string , '|' ].
		
	expectedString := ''.
	beforeFirst := true.
	self collectionWithoutNilElements  do: 
		[ :each | 
		beforeFirst = true 
			ifTrue: [ beforeFirst := false ]
			ifFalse: [ expectedString := expectedString , '|' ].
		expectedString := expectedString , each asString ].
	self assert: expectedString = string! !

!LinkedListTest methodsFor: 'tests - printing' stamp: ''!
testPrintElementsOn

	| aStream result allElementsAsString tmp |
	result:=''.
	aStream:= ReadWriteStream on: result.
	tmp:= OrderedCollection new.
	self nonEmpty do: [:each | tmp add: each asString].
	
	self nonEmpty printElementsOn: aStream .
	allElementsAsString:=(result findBetweenSubStrs: ' ' ).
	1 to: allElementsAsString size do:
		[:i | 
		self assert: (tmp occurrencesOf:(allElementsAsString at:i))=(allElementsAsString  occurrencesOf:(allElementsAsString at:i)).
			].! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testSelectThenCollect

	| result index selectIndex pivot |
	
	index := 0.
	selectIndex := 0.
	pivot := self collectionWithoutNilElements anyOne.
	
	result := self collectionWithoutNilElements 
		select: [ :each | 
			selectIndex := selectIndex + 1.
			"reject the first element"
			selectIndex > 1 ]
		thenCollect: [ :each | 
			self assert: each notNil.
			index := index + 1.
			pivot ].
			
	self assert: result ~= self collectionWithoutNilElements.
	self assert: selectIndex equals: self collectionWithoutNilElements size.
	self assert: index equals: self collectionWithoutNilElements size - 1.
	
	self assert: (self collectionWithoutNilElements occurrencesOf: pivot) equals: 1.
	"should be > 1 for standard collection and = 1 for those that do not allow exact duplicates"
	self assert: (result occurrencesOf: pivot) >= 1.
	 ! !

!LinkedListTest methodsFor: 'testing' stamp: 'mk 8/3/2005 12:10'!
test07addAfter
	self assert: list isEmpty.
	
	list add: link1.
	self assert: list size = 1.
	self assert: list first == link1.
	
	list add: link2 after: link1.
	self assert: list size = 2.
	self assert: list first == link1.
	self assert: list second == link2.
	
	list add: link3 after: link1.
	self assert: list size = 3.
	self assert: list first == link1.
	self assert: list second == link3.
	self assert: list third == link2.
	
	list add: link4 after: link1.
	self assert: list size = 4.
	self assert: list first == link1.
	self assert: list second == link4.
	self assert: list third == link3.
	self assert: list fourth == link2! !

!LinkedListTest methodsFor: 'accessing' stamp: 'md 10/14/2004 10:47'!
n: number
	n := number.
	! !

!LinkedListTest methodsFor: 'testing' stamp: 'mk 8/3/2005 12:05'!
test04addBefore
	self assert: list isEmpty.
	
	list add: link1.
	self assert: list size = 1.
	self assert: list first == link1.
	
	list add: link2 before: link1.
	self assert: list size = 2.
	self assert: list first == link2.
	self assert: list second == link1.
	
	list add: link3 before: link1.
	self assert: list size = 3.
	self assert: list first == link2.
	self assert: list second == link3.
	self assert: list third == link1.
	
	list add: link4 before: link1.
	self assert: list size = 4.
	self assert: list first == link2.
	self assert: list second == link3.
	self assert: list third == link4.
	self assert: list fourth == link1! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 4/24/2009 11:52'!
anotherElementNotIn
" return an element included  in 'collection' "
	^ elementNotIn ! !

!LinkedListTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithSequenceable

	| result index element |
	index := self indexInNonEmpty .
	element := self nonEmpty at: index.
	result := self nonEmpty copyWith: (element ).
	
	self assert: result size = (self nonEmpty size + 1).
	self assert: result last = element .
	
	1 to: (result size - 1) do:
	[ :i |
	self assert: (result at: i) = ( self nonEmpty at: ( i  ))].! !

!LinkedListTest methodsFor: 'tests - begins ends with' stamp: ''!
testsEndsWithEmpty
	
	self deny: (self nonEmpty endsWith: self empty).
	self deny: (self empty endsWith: self nonEmpty).
	! !

!LinkedListTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIterateSequencedReadableTest

	| res |
	
	self nonEmptyMoreThan1Element.
	self assert: self nonEmptyMoreThan1Element  size > 1.
	
	
	self empty.
	self assert: self empty isEmpty .
	
	res := true.
	self nonEmptyMoreThan1Element    
	detect: [ :each | (self nonEmptyMoreThan1Element    occurrencesOf: each) > 1 ]
	ifNone: [ res := false ].
	self assert: res = false.! !

!LinkedListTest methodsFor: 'tests - remove' stamp: ''!
testRemoveIfAbsent
	"self debug: #testRemoveElementThatExists"

	| el res |
	el := self elementNotIn.
	res := self nonEmptyWithoutEqualElements remove: el ifAbsent: [ 33 ].
	self assert: res = 33! !

!LinkedListTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterLastEmpty

	| delim emptyStream |
	delim := ', '.
	emptyStream := ReadWriteStream on: ''.
	self empty asStringOn: emptyStream delimiter: delim last:'and'.
	self assert: emptyStream contents = ''.
! !

!LinkedListTest methodsFor: 'testing' stamp: 'mk 8/3/2005 12:10'!
test10removeFirst
	list add: link1.
	list add: link2.
	list add: link3.
	list add: link4.
	
	self assert: list size = 4.
	self assert: list first == link1.
	self assert: list second == link2.
	self assert: list third == link3.
	self assert: list fourth == link4.
	
	list removeFirst.
	self assert: list size = 3.
	self assert: list first == link2.
	self assert: list second == link3.
	self assert: list third == link4.
	
	list removeFirst.
	self assert: list size = 2.
	self assert: list first == link3.
	self assert: list second == link4.
	
	list removeFirst.
	self assert: list size = 1.
	self assert: list first == link4.
	
	list removeFirst.
	self assert: list isEmpty! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 4/24/2009 11:37'!
collectionWith1TimeSubcollection
" return a collection including 'oldSubCollection'  only one time "
	^ self oldSubCollection ! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testSelectNoneThenDo
	| result |
	
	result := self collectionWithoutNilElements 
		select: [ :each | each isNil ] 
		thenDo: [ self fail ].
	
	self assert: result equals: self collectionWithoutNilElements! !

!LinkedListTest methodsFor: 'tests - element accessing' stamp: ''!
testAtOutOfBounds
	"self debug: #testAtOutOfBounds"
	self 
		should: [ self moreThan4Elements at: self moreThan4Elements size + 1 ]
		raise: Error.
	self 
		should: [ self moreThan4Elements at: -1 ]
		raise: Error! !

!LinkedListTest methodsFor: 'tests - empty' stamp: ''!
testIsEmpty

	self assert: (self empty isEmpty).
	self deny: (self nonEmpty isEmpty).! !

!LinkedListTest methodsFor: 'testing' stamp: 'mk 8/3/2005 12:04'!
test02addLast
	self assert: list isEmpty.
	
	list addLast: link1.
	self assert: list size = 1.
	self assert: list first = link1.
	
	list addLast: link2.
	self assert: list size = 2.
	self assert: list first = link1.
	self assert: list second = link2.
	
	list addLast: link3.
	self assert: list size = 3.
	self assert: list first = link1.
	self assert: list second = link2.
	self assert: list third = link3.
	
	list addLast: link4.
	self assert: list size = 4.
	self assert: list first = link1.
	self assert: list second = link2.
	self assert: list third = link3.
	self assert: list fourth = link4! !

!LinkedListTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOfEmpty
	| result |
	result := self empty occurrencesOf: (self collectionWithoutEqualElements anyOne).
	self assert: result = 0! !

!LinkedListTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithCollect
	
	| result firstCollection secondCollection index  |

	firstCollection := self nonEmptyMoreThan1Element.
	secondCollection := firstCollection copy.
	index := 0.
	
	result := firstCollection  with: secondCollection collect:
		[:a :b |
		( index := index + 1).
		self assert: (firstCollection at: index) equals:  a. 
		self assert: (secondCollection at: index) equals:  b.
		b].
	
	1 to: result size do:[: i | self assert: (result at:i)= (secondCollection  at: i)].
	self assert: result size = secondCollection  size.! !

!LinkedListTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterLastOne

	| delim oneItemStream result |
	
	delim := ', '.
	result:=''.
	oneItemStream := ReadWriteStream on: result.
	self nonEmpty1Element  asStringOn: oneItemStream delimiter: delim last: 'and'.
	oneItemStream do:[:each | self assert: each = (self nonEmpty1Element first asString)].
	

	! !

!LinkedListTest methodsFor: 'tests - empty' stamp: ''!
testIfEmpty

	self nonEmpty ifEmpty: [ self assert: false] .
	self empty ifEmpty: [ self assert: true] .
	

	! !

!LinkedListTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSetAritmeticTest
	self collection.
	self deny: self collection isEmpty.
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self anotherElementOrAssociationNotIn.
	self collection isDictionary
		ifTrue: [ self deny: (self collection associations includes: self anotherElementOrAssociationNotIn key) ]
		ifFalse: [ self deny: (self collection includes: self anotherElementOrAssociationNotIn) ].
	self collectionClass! !

!LinkedListTest methodsFor: 'tests - printing' stamp: ''!
testPrintOnDelimiter
	| aStream result allElementsAsString tmp |
	result:=''.
	aStream:= ReadWriteStream on: result.
	tmp:= OrderedCollection new.
	self nonEmpty do: [:each | tmp add: each asString].
	
	
	
	self nonEmpty printOn: aStream delimiter: ', ' .
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		self assert: (tmp occurrencesOf:(allElementsAsString at:i))=(allElementsAsString  occurrencesOf:(allElementsAsString at:i))
			].! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 4/22/2009 17:07'!
collectionWithoutNilElements
" return a collection that doesn't includes a nil element "
	^collectionWithoutNil ! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testDetect

	| res element |
	element := self collectionWithoutNilElements anyOne .
	 
	res := self collectionWithoutNilElements  detect: [:each | each = element].
	self assert: (res  = element).

	
	! !

!LinkedListTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIncludeWithIdentityTest
	| anElement |
	self collectionWithCopyNonIdentical.
	anElement := self collectionWithCopyNonIdentical anyOne.
	self deny: anElement == anElement copy! !

!LinkedListTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureTConvertTest
	"a collection of number without equal elements:"

	| res |
	self collectionWithoutEqualElements.
	res := true.
	self collectionWithoutEqualElements
		detect: [ :each | (self collectionWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false! !

!LinkedListTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterMore

	| delim multiItemStream result index |
	"delim := ', '.
	multiItemStream := '' readWrite.
	self oneTwoThreeItemCol asStringOn: multiItemStream delimiter: ', '.
	self assert: multiItemStream contents = '1, 2, 3'."
	
	delim := ', '.
	result:=''.
	multiItemStream := ReadWriteStream on:result.
	self nonEmpty  asStringOn: multiItemStream delimiter: ', '.
	
	index:=1.
	(result findBetweenSubStrs: ', ' )do:
		[:each |
		self assert: each= ((self nonEmpty at:index)asString).
		index:=index+1
		].! !

!LinkedListTest methodsFor: 'tests - remove' stamp: ''!
testRemoveElementThatExists
	"self debug: #testRemoveElementThatExists"

	| el res |
	el := self nonEmptyWithoutEqualElements anyOne.
	res := self nonEmptyWithoutEqualElements remove: el.
	self assert: res == el! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testSelectNoneThenCollect
	| result |
	
	result := self collectionWithoutNilElements 
		select: [ :each | each isNil ] 
		thenCollect: [ :each| self fail ].
	
	self assert: result isEmpty! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testAnySastify

	| element |
	" when all elements satisty the condition, should return true :"
	self assert: ( self collectionWithoutNilElements anySatisfy: [:each | each notNil ]).
	
	" when only one element satisfy the condition, should return true :"
	element := self collectionWithoutNilElements anyOne.
	self assert: ( self collectionWithoutNilElements  anySatisfy: [:each | (each = element)  ]   ).
	
	" when all elements don't satisty the condition, should return false :"
	self deny: ( self collectionWithoutNilElements anySatisfy: [:each | (each notNil) not ]).
! !

!LinkedListTest methodsFor: 'tests - includes' stamp: ''!
testIdentityIncludesNonSpecificComportement
	" test the same comportement than 'includes: '  "
	| collection |	
	collection := self nonEmpty  .
	
	self deny: (collection identityIncludes: self elementNotIn ).
	self assert:(collection identityIncludes: collection anyOne)
! !

!LinkedListTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testDetectSequenced
" testing that detect keep the first element returning true for sequenceable collections "

	| element result |
	element := self nonEmptyMoreThan1Element   at:1.
	result:=self nonEmptyMoreThan1Element  detect: [:each | each notNil ].
	self assert: result = element. ! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testDo2
	"dc: Bad test, it assumes that a new instance of #speciesClass allows addition with #add:. This is not the case of Interval for which species is Array."
	"res := self speciesClass new.  
	self collection do: [:each | res add: each class].
	self assert: res = self result. "
	| collection cptElementsViewed cptElementsIn |
	collection := self collectionWithoutNilElements.
	cptElementsViewed := 0.
	cptElementsIn := OrderedCollection new.
	collection do: 
		[ :each | 
		cptElementsViewed := cptElementsViewed + 1.
		" #do doesn't iterate with the same objects than those in the collection for FloatArray( I don' t know why ) . That's why I use #includes: and not #identityIncludes:  '"
		(collection includes: each) ifTrue: [
			" the collection used doesn't include equal elements. Therefore each element viewed should not have been viewed before "
			( cptElementsIn includes: each ) ifFalse: [ cptElementsIn add: each ] .
			]. 
		].
	self assert: cptElementsViewed = collection size.
	self assert: cptElementsIn size  = collection size.
	
	! !

!LinkedListTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureAsStringCommaAndDelimiterTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty.
	self nonEmpty1Element.
	self assert: self nonEmpty1Element size = 1! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 4/23/2009 15:14'!
collectionMoreThan1NoDuplicates
	" return a collection of size 5 without equal elements"
	^ collectionWithoutEqualElements! !

!LinkedListTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAnyAllThere
	"self debug: #testIncludesAnyOfAllThere'"
	self deny: (self nonEmpty includesAny: self empty).
	self assert: (self nonEmpty includesAny: { self nonEmpty anyOne }).
	self assert: (self nonEmpty includesAny: self nonEmpty).! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testNoneSatisfyEmpty

	self assert: ( self empty noneSatisfy: [:each | false]).
	! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testSelect

	| result element |
	result := self collectionWithoutNilElements select: [ :each | each notNil].
	self assert: result size equals: self collectionWithoutNilElements size.
	
	element := self collectionWithoutNilElements anyOne.
	result := self collectionWithoutNilElements select: [ :each | (each = element) not].
	self assert: result size equals: (self collectionWithoutNilElements size - 1).
	! !

!LinkedListTest methodsFor: 'requirements' stamp: 'HenrikSperreJohansen 10/19/2009 14:48'!
elementToAdd
" return an element of type 'nonEmpy' elements'type'"
	^ ValueLink value: 77! !

!LinkedListTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testPairsDo
	| index |
	index:=1.
	
	self nonEmptyMoreThan1Element  pairsDo: 
		[:each1 :each2 | 
		self assert:(self nonEmptyMoreThan1Element at:index)=each1.
		self assert:(self nonEmptyMoreThan1Element at:(index+1))=each2.
		index:=index+2].
	
	self nonEmptyMoreThan1Element size odd
		ifTrue:[self assert: index=self nonEmptyMoreThan1Element size]
		ifFalse:[self assert: index=(self nonEmptyMoreThan1Element size+1)].! !

!LinkedListTest methodsFor: 'tests - subcollections access' stamp: ''!
testLastNElements
	"self debug: #testLastNElements"
	| result |
	result := self moreThan3Elements last: self moreThan3Elements size - 1.
	1 
		to: result size
		do: [ :i | self assert: (result at: i) = (self moreThan3Elements at: i + 1) ].
	self assert: result size = (self moreThan3Elements size - 1).
	self 
		should: [ self moreThan3Elements last: self moreThan3Elements size + 1 ]
		raise: Error! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 4/23/2009 16:46'!
accessCollection
	^collectionWithoutEqualElements ! !

!LinkedListTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testCollectFromTo
	
	| result |
	result:=self nonEmptyMoreThan1Element 
		collect: [ :each | each ]
		from: 1
		to: (self nonEmptyMoreThan1Element size - 1).
		
	1 to: result size
		do: [ :i | self assert: (self nonEmptyMoreThan1Element at: i) = (result at: i) ].
	self assert: result size = (self nonEmptyMoreThan1Element size - 1)! !

!LinkedListTest methodsFor: 'tests - printing' stamp: ''!
testPrintNameOn

	| aStream result |
	result:=''.
	aStream:= ReadWriteStream on: result.
	self nonEmpty printNameOn: aStream.
	self nonEmpty class name first isVowel
		ifTrue:[ self assert: aStream contents =('an ',self nonEmpty class name ) ]
		ifFalse:[self assert: aStream contents =('a ',self nonEmpty class name)].! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testSelectOnEmpty

	self assert: (self empty select: [:e | self fail]) isEmpty
	! !

!LinkedListTest methodsFor: 'test - equality' stamp: ''!
testEqualSignIsTrueForNonIdenticalButEqualCollections
	"self debug: #testEqualSignIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty = self empty copy). 
	self assert: (self empty copy = self empty).
	self assert: (self empty copy = self empty copy).
		
	self assert: (self nonEmpty = self nonEmpty copy). 
	self assert: (self nonEmpty copy = self nonEmpty).
	self assert: (self nonEmpty copy = self nonEmpty copy).! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 4/23/2009 16:46'!
elementInForElementAccessing
" return an element inculded in 'accessCollection '"
	^ elementIn ! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testSelectThenCollectOnEmpty

	self assert: (self empty select: [:e | self fail ] thenCollect: [ self fail ]) isEmpty! !

!LinkedListTest methodsFor: 'tests - copying with replacement' stamp: ''!
testCopyReplaceFromToWithInsertion
	| result  indexOfSubcollection |
	
	indexOfSubcollection := (self firstIndexesOf: self oldSubCollection  in:  self collectionWith1TimeSubcollection) at: 1. 
	
	result := self collectionWith1TimeSubcollection  copyReplaceFrom: indexOfSubcollection  to: ( indexOfSubcollection - 1 ) with: self replacementCollection .
	
	"verify content of 'result' : "
	"first part of 'result'' : '"
	
	1 to: (indexOfSubcollection -1) do: 
		[
		:i | 
		self assert: (self collectionWith1TimeSubcollection  at:i)=(result at: i)
		].
	
	" middle part containing replacementCollection : "
	indexOfSubcollection  to: (indexOfSubcollection  + self replacementCollection size-1) do: 
		[
		:i |
		self assert: ( result at: i )=(self replacementCollection at: ( i - indexOfSubcollection +1 ))
		].
	
	" end part :"
	(indexOfSubcollection  + self replacementCollection size) to: (result size) do:
		[:i|
		self assert: (result at: i)=(self collectionWith1TimeSubcollection  at: (i-self replacementCollection size))].
	
	" verify size: "	
	self assert: result size=(self collectionWith1TimeSubcollection  size + self replacementCollection size).
	

	

	
	! !

!LinkedListTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsCommaStringMore

	"self assert: self oneTwoThreeItemCol asCommaString = '1, 2, 3'.
	self assert: self oneTwoThreeItemCol asCommaStringAnd = '1, 2 and 3'
"

	| result resultAnd index allElementsAsString |
	result:= self nonEmpty asCommaString .
	resultAnd:= self nonEmpty asCommaStringAnd .
 
	index := 1.
	(result findBetweenSubStrs: ',' )do:
		[:each |
		index = 1
			ifTrue: [self assert: each= ((self nonEmpty at:index)asString)]
			ifFalse: [self assert: each= (' ',(self nonEmpty at:index) asString)].
		index:=index+1
		].
	
	"verifying esultAnd :"
	allElementsAsString:=(resultAnd findBetweenSubStrs: ',' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size )
			ifTrue: [
			i = 1
				ifTrue:[self assert: (allElementsAsString at:i)=((self nonEmpty at:i) asString)]
				ifFalse:[self assert: (allElementsAsString at:i)=(' ',(self nonEmpty at:i) asString)]
				].
		i=(allElementsAsString size)
			ifTrue:[ 
			i = 1
				ifTrue:[self assert: (allElementsAsString at:i)=( (self nonEmpty at:i ) asString ,' and ', (self nonEmpty at: ( i + 1) ) asString )]
				ifFalse:[self assert: (allElementsAsString at:i)=( ' ' , (self nonEmpty at:i ) asString ,' and ', (self nonEmpty at: ( i + 1) ) asString )]
				].
		
		
			].! !

!LinkedListTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWith
	"self debug: #testCopyNonEmptyWith"
	| res anElement |
	anElement := self elementToAdd .
	res := self nonEmpty copyWith: anElement.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self assert: (res includes: (anElement value)).
	self nonEmpty do: [ :each | res includes: each ]! !

!LinkedListTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfterLastEmpty
	| result |
	result := self empty copyAfterLast: self collectionWithoutEqualElements first.
	self assert: result isEmpty.! !

!LinkedListTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutAllNotIncluded
	"self debug: #testCopyNonEmptyWithoutAllNotIncluded"
	| res |
	res := self nonEmpty copyWithoutAll: self collectionNotIncluded.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self nonEmpty do: [ :each | self assert: (res includes: each) ]! !

!LinkedListTest methodsFor: 'tests - index access' stamp: ''!
testIdentityIndexOfIAbsent
	| collection element |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			identityIndexOf: element
			ifAbsent: [ 0 ]) = 1.
	self assert: (collection 
			identityIndexOf: self elementNotInForIndexAccessing
			ifAbsent: [ 55 ]) = 55! !

!LinkedListTest methodsFor: 'testing' stamp: 'nice 9/14/2009 20:57'!
testRemoveAll
	| list2 |
	list add: link1.
	list add: link2.
	list add: link3.
	list add: link4.
	list2 := list copy.
	list removeAll.
	
	self assert: list size = 0.
	self assert: list2 size = 4 description: 'the copy has not been modified'! !

!LinkedListTest methodsFor: 'accessing' stamp: 'md 10/14/2004 10:47'!
n
	^n! !

!LinkedListTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfSubCollectionStartingAt
	"self debug: #testIndexOfIfAbsent"
	| subcollection index collection |
	collection := self collectionMoreThan1NoDuplicates.
	subcollection := self collectionMoreThan1NoDuplicates.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 1.
	self assert: index = 1.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 2.
	self assert: index = 0! !

!LinkedListTest methodsFor: 'testing' stamp: 'zz 12/7/2005 19:08'!
test22addAll
	| link5 link6 link7 link8 listToBeAdded |
	link5 := Link new.
	link6 := Link new.
	link7 := Link new.
	link8 := Link new.
	
	list
		add: link1;
		add: link2;
		add: link3;
		add: link4.
		
	listToBeAdded := LinkedList new.
	listToBeAdded
		add: link5;
		add: link6;
		add: link7;
		add: link8.
		
	list addAll: listToBeAdded.
	
	self should: [(list at: 1) == link1].
	self should: [(list at: 2) == link2].
	self should: [(list at: 3) == link3].
	self should: [(list at: 4) == link4].
	self should: [(list at: 5) == link5].
	self should: [(list at: 6) == link6].
	self should: [(list at: 7) == link7].
	self should: [(list at: 8) == link8].! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 14:14'!
collectionWithSortableElements
	" return a collection only including elements that can be sorted (understanding '<' )"
	^ collection5Elements ! !

!LinkedListTest methodsFor: 'tests - index access' stamp: ''!
testIdentityIndexOf
	"self debug: #testIdentityIndexOf"
	| collection element |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection identityIndexOf: element) = (collection indexOf: element)! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testBasicCollectEmpty

	| res |
	res := self empty collect: [:each | each class].
	self assert: res isEmpty
	! !

!LinkedListTest methodsFor: 'tests - swap' stamp: 'CamilloBruni 11/2/2012 15:58'!
testSwapBasic
	|aList|
	aList := LinkedList with: 5 with: 4 with: 3 with: 2 with: 1.
	
	aList swap: 2 with: 4.
	self assert: (aList at: 2) equals: 2.
	self assert: (aList at: 4) equals: 4.
! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testRejectThenCollect

	| result index selectIndex pivot |
	
	index := 0.
	selectIndex := 0.
	pivot := self collectionWithoutNilElements anyOne.
	
	result := self collectionWithoutNilElements 
		reject: [ :each | 
			selectIndex := selectIndex + 1.
			"reject the first element"
			selectIndex = 1 ]
		thenCollect: [ :each | 
			self assert: each notNil.
			index := index + 1.
			pivot ].
			
	self assert: result ~= self collectionWithoutNilElements.
	self assert: selectIndex equals: self collectionWithoutNilElements size.
	self assert: index equals: self collectionWithoutNilElements size - 1.
	
	self assert: (self collectionWithoutNilElements occurrencesOf: pivot) equals: 1.
	"should be > 1 for standard collection and = 1 for those that do not allow exact duplicates"
	self assert: (result occurrencesOf: pivot) >= 1.
	 ! !

!LinkedListTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureOccurrencesTest
	| tmp |
	self empty.
	self assert: self empty isEmpty.
	self collectionWithoutEqualElements.
	self deny: self collectionWithoutEqualElements isEmpty.
	tmp := OrderedCollection new.
	self collectionWithoutEqualElements
		do: [ :each | 
			self deny: (tmp includes: each).
			tmp add: each ].
	self elementNotInForOccurrences.
	self deny: (self collectionWithoutEqualElements includes: self elementNotInForOccurrences)! !

!LinkedListTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:23'!
test0FixtureIndexAccessTest
	| res |
	self collectionMoreThan1NoDuplicates.
	self assert: self collectionMoreThan1NoDuplicates size = 5.
	res := true.
	self collectionMoreThan1NoDuplicates
		detect: [ :each | (self collectionMoreThan1NoDuplicates occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false.
	self elementInForIndexAccessing.
	self assert: (self collectionMoreThan1NoDuplicates includes: self elementInForIndexAccessing).
	self elementNotInForIndexAccessing.
	self deny: (self collectionMoreThan1NoDuplicates includes: self elementNotInForIndexAccessing)! !

!LinkedListTest methodsFor: 'tests - swap' stamp: 'CamilloBruni 11/2/2012 15:58'!
testSwapAdjacentStart
	|aList|
	aList := LinkedList with: 5 with: 4 with: 3 with: 2 with: 1.
	
	aList swap: 1 with: 2.
	self assert: (aList at: 1) equals: 4.
	self assert: (aList at: 2) equals: 5.
	self assert: aList first equals: 4.! !

!LinkedListTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithDo
	
	| firstCollection secondCollection index |

	firstCollection := self nonEmptyMoreThan1Element.
	secondCollection := firstCollection copy.
	index := 0.
	
	firstCollection  with: secondCollection do:
		[:a :b |
		( index := index + 1).
		self assert: (firstCollection at: index) equals:  a. 
		self assert: (secondCollection at: index) equals:  b.]
	
	! !

!LinkedListTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testAllButFirstDo
	
	| result |
	result:= OrderedCollection  new.
	
	self nonEmptyMoreThan1Element  allButFirstDo: [:each | result add: each].
	
	1 to: (result size) do:
		[:i|
		self assert: (self nonEmptyMoreThan1Element  at:(i +1))=(result at:i)].
	
	self assert: result size=(self nonEmptyMoreThan1Element  size-1).! !

!LinkedListTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithDoError
	
	self should: [self nonEmptyMoreThan1Element with: self empty do:[:a :b | ]] raise: Error.! !

!LinkedListTest methodsFor: 'tests - element accessing' stamp: ''!
testAtWrap
	"self debug: #testAt"
	"
	self assert: (self accessCollection at: 1) = 1.
	self assert: (self accessCollection at: 2) = 2.
	"
	| index |
	index := self moreThan4Elements indexOf: self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: index) = self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: index + self moreThan4Elements size) = self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: index - self moreThan4Elements size) = self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: 1 + self moreThan4Elements size) = (self moreThan4Elements at: 1)! !

!LinkedListTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithout
	"self debug: #testCopyNonEmptyWithout"
	
	| res anElementOfTheCollection |
	anElementOfTheCollection :=  self nonEmpty anyOne.
	res := (self nonEmpty copyWithout: anElementOfTheCollection).
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self deny: (res includes: anElementOfTheCollection).
	self nonEmpty do:
		[:each | (each = anElementOfTheCollection) 
					ifFalse: [self assert: (res includes: each)]].
	
! !

!LinkedListTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutNotIncluded
	"self debug: #testCopyNonEmptyWithoutNotIncluded"
	| res |
	res := self nonEmpty copyWithout: self elementToAdd.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self nonEmpty do: [ :each | self assert: (res includes: each) ]! !

!LinkedListTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureEmptyTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testDoWithout
	"self debug: #testDoWithout"
	
	| res element collection |
	collection := self collectionWithoutNilElements .	
	res := OrderedCollection new.  
	element := self collectionWithoutNilElements anyOne .
	collection  do: [:each | res add: each] without: element  .
	" verifying result :"
	self assert: res size = (collection  size - (collection  occurrencesOf: element)).
	res do: [:each | self assert: (collection occurrencesOf: each) = ( res occurrencesOf: each ) ].
	! !

!LinkedListTest methodsFor: 'accessing' stamp: 'md 10/14/2004 10:46'!
nextLink: aLink
	nextLink := aLink! !

!LinkedListTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testKeysAndValuesDo
	"| result |
	result:= OrderedCollection new.
	
	self nonEmptyMoreThan1Element  keysAndValuesDo: 
		[:i :value|
		result add: (value+i)].
	
	1 to: result size do:
		[:i|
		self assert: (result at:i)=((self nonEmptyMoreThan1Element at:i)+i)]"
	|  indexes elements |
	indexes:= OrderedCollection new.
	elements := OrderedCollection new.
	
	self nonEmptyMoreThan1Element  keysAndValuesDo: 
		[:i :value|
		indexes  add: (i).
		elements add: value].
	
	(1 to: self nonEmptyMoreThan1Element size )do:
		[ :i |
		self assert: (indexes at: i) = i.
		self assert: (elements at: i) = (self nonEmptyMoreThan1Element at: i).	
		].
	
	self assert: indexes size = elements size. 
	self assert: indexes size = self nonEmptyMoreThan1Element size . 
	
	! !

!LinkedListTest methodsFor: 'testing' stamp: 'mk 8/3/2005 12:09'!
test08addAfter
	| l first |
	l := LinkedList new.
	first := self class new n: 1.
	
	l add: first.
	l add: (self class new n: 3).

	self assert: (l collect:[:e | e n]) asArray  = #(1 3).
	
	l add: (self class new n: 2) after: first.

	self assert: (l collect:[:e | e n]) asArray  = #(1 2 3).! !

!LinkedListTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionItself
	"self debug: #testIntersectionItself"
	
	| result |
	result :=  (self collectionWithoutEqualElements intersection: self collectionWithoutEqualElements).
	self assert: result size  = self collectionWithoutEqualElements size.
	self collectionWithoutEqualElements do: [ :each|
		self assert: (result includes: each) ].
	! !

!LinkedListTest methodsFor: 'tests - converting' stamp: ''!
testAsOrderedCollection
	
	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: OrderedCollection! !

!LinkedListTest methodsFor: 'tests - fixture' stamp: ''!
test0CopyTest
	self empty.
	self assert: self empty size = 0.
	self nonEmpty.
	self assert: (self nonEmpty size = 0) not.
	self collectionWithElementsToRemove.
	self assert: (self collectionWithElementsToRemove size = 0) not.
	self collectionWithElementsToRemove do: [ :each | self assert: (self nonEmpty includes: each) ].
	self elementToAdd.
	self deny: (self nonEmpty includes: self elementToAdd).
	self collectionNotIncluded.
	self collectionNotIncluded do: [ :each | self deny: (self nonEmpty includes: each) ]! !

!LinkedListTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOf
	| collection |
	collection := self collectionWithoutEqualElements .
	
	collection do: [ :each | self assert: (collection occurrencesOf: each) = 1 ].! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testSumNumbers
	|result|
	result:= self collectionWithoutNilElements 
		sumNumbers: [ :ele | ele notNil ifTrue: [ 1 ] ifFalse: [ 0 ]].
	
	self assert: self collectionWithoutNilElements size = result! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 4/24/2009 11:09'!
indexInNonEmpty
" return an index between bounds of 'nonEmpty' "

	^ self nonEmpty size! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testAllSatisfy

	| element |
	" when all element  satisfy the condition, should return true : "
	self assert: ( self collectionWithoutNilElements  allSatisfy: [:each | (each notNil) ] ).
	
	" when all element don't satisfy the condition, should return false : "
	self deny: ( self collectionWithoutNilElements  allSatisfy: [:each | (each notNil) not ] ).
	
	" when only one element doesn't satisfy the condition' should return false'"
	element := self collectionWithoutNilElements anyOne.
	self deny: ( self collectionWithoutNilElements  allSatisfy: [:each | (each = element) not] ).! !

!LinkedListTest methodsFor: 'tests - begins ends with' stamp: ''!
testsBeginsWithEmpty
	
	self deny: (self nonEmpty beginsWith:(self empty)).
	self deny: (self empty beginsWith:(self nonEmpty )).
! !

!LinkedListTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 12/18/2009 12:05'!
result
	"Returns a collection of the classes of elements in #collection"
	 ^ collectResult! !

!LinkedListTest methodsFor: 'testing' stamp: 'mk 8/3/2005 12:11'!
test12remove
	list add: link1.
	list add: link2.
	list add: link3.
	list add: link4.
	
	self assert: list size = 4.
	self assert: list first == link1.
	self assert: list second == link2.
	self assert: list third == link3.
	self assert: list fourth == link4.
	
	list remove: link3.
	self assert: list size = 3.
	self assert: list first == link1.
	self assert: list second == link2.
	self assert: list third == link4.
	
	list remove: link2.
	self assert: list size = 2.
	self assert: list first == link1.
	self assert: list second == link4.
	
	list remove: link1.
	self assert: list size = 1.
	self assert: list first == link4.
	
	list remove: link4.
	self assert: list isEmpty! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 10:22'!
collectionWithCopyNonIdentical
	" return a collection that include elements for which 'copy' return a different object (this is not the case of SmallInteger)"
	^ collectionWithoutEqualElements! !

!LinkedListTest methodsFor: 'tests - begins ends with' stamp: ''!
testsBeginsWith
	
	self assert: (self nonEmpty beginsWith:(self nonEmpty copyUpTo: self nonEmpty last)).
	self assert: (self nonEmpty beginsWith:(self nonEmpty )).
	self deny: (self nonEmpty beginsWith:(self nonEmpty copyWith:self nonEmpty first)).! !

!LinkedListTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWithout
	"self debug: #testCopyEmptyWithout"
	| res |
	res := self empty copyWithout: self elementToAdd.
	self assert: res size = self empty size.
	self deny: (res includes: self elementToAdd)! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 4/24/2009 11:49'!
collectionClass
" return the class to be used to create instances of the class tested"
	^ LinkedList! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 4/23/2009 14:14'!
nonEmpty1Element
" return a collection of size 1 including one element"
	^ nonEmpty1Element ! !

!LinkedListTest methodsFor: 'test - equality' stamp: ''!
testEqualSign
	"self debug: #testEqualSign"

	self deny: (self empty = self nonEmpty).! !

!LinkedListTest methodsFor: 'tests - set arithmetic' stamp: ''!
testUnion
	"self debug: #testUnionOfEmpties"
	
	| union |
	union := self empty union: self nonEmpty.
	self containsAll: union of: self empty andOf: self nonEmpty.
	union := self nonEmpty union: self empty.
	self containsAll: union of: self empty andOf: self nonEmpty.
	union := self collection union: self nonEmpty.
	self containsAll: union of: self collection andOf: self nonEmpty.! !

!LinkedListTest methodsFor: 'tests - copying with replacement' stamp: ''!
testCopyReplaceFromToWith
	| result  indexOfSubcollection lastIndexOfOldSubcollection lastIndexOfReplacementCollection |
	
	indexOfSubcollection := (self firstIndexesOf: self oldSubCollection  in:  self collectionWith1TimeSubcollection) at: 1. 
	lastIndexOfOldSubcollection := indexOfSubcollection + self oldSubCollection size -1.
	lastIndexOfReplacementCollection := indexOfSubcollection + self replacementCollection  size -1.
	
	result := self collectionWith1TimeSubcollection  copyReplaceFrom: indexOfSubcollection  to: lastIndexOfOldSubcollection   with: self replacementCollection .
	
	"verify content of 'result' : "
	"first part of 'result'  "
	
	1 to: (indexOfSubcollection  - 1) do: 
		[ 
		:i | 
		self assert: (self collectionWith1TimeSubcollection  at:i) = (result at: i)
		].
	
	" middle part containing replacementCollection : "
	
	(indexOfSubcollection ) to: ( lastIndexOfReplacementCollection  ) do: 
		[
		:i |
		self assert: (result at: i)=(self replacementCollection at: (i - indexOfSubcollection +1))
		].
	
	" end part :"
	1 to: (result size - lastIndexOfReplacementCollection   ) do:
		[ 
		:i |
		self assert: (result at: ( lastIndexOfReplacementCollection  + i  ) ) = (self collectionWith1TimeSubcollection  at: ( lastIndexOfOldSubcollection  + i  ) ).
		].
	
	
	

	
	! !

!LinkedListTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testDo! !

!LinkedListTest methodsFor: 'testing' stamp: 'mk 8/3/2005 12:05'!
test06addAfter
	self assert: list isEmpty.
	
	list add: link1.
	self assert: list size = 1.
	self assert: list first == link1.
	
	list add: link2 after: link1.
	self assert: list size = 2.
	self assert: list first == link1.
	self assert: list second == link2.
	
	list add: link3 after: link2.
	self assert: list size = 3.
	self assert: list first == link1.
	self assert: list second == link2.
	self assert: list third == link3.
	
	list add: link4 after: link3.
	self assert: list size = 4.
	self assert: list first == link1.
	self assert: list second == link2.
	self assert: list third == link3.
	self assert: list fourth == link4! !

!LinkedListTest methodsFor: 'tests - copying same contents' stamp: ''!
testShuffled
	| result |
	result := self nonEmpty shuffled .
	
	"verify content of 'result: '"
	result do: [:each | self assert: (self nonEmpty occurrencesOf: each)=(result occurrencesOf: each)].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!LinkedListTest methodsFor: 'tests - copy' stamp: ''!
testCopySameClass
	"self debug: #testCopySameClass"
	"A copy of a collection should always be of the same class as the instance it copies"
	
	| copy | 
	copy := self empty copy.
	self assert: copy class == self empty class.! !

!LinkedListTest methodsFor: 'tests - element accessing' stamp: ''!
testAfter
	"self debug: #testAfter"
	self assert: (self moreThan4Elements after: (self moreThan4Elements at: 1)) = (self moreThan4Elements at: 2).
	self 
		should: 
			[ self moreThan4Elements after: (self moreThan4Elements at: self moreThan4Elements size) ]
		raise: Error.
	self 
		should: [ self moreThan4Elements after: self elementNotInForElementAccessing ]
		raise: Error! !

!LinkedListTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfter
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyAfter: (collection  at:index ).
	
	"verifying content: "
	(1) to: result size do: 
		[:i |
		self assert: (collection   at:(i + index ))=(result at: (i))].

	"verify size: "
	self assert: result size = (collection   size - index).! !

!LinkedListTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButFirstNElements
	"self debug: #testAllButFirst"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButFirst: 2.
	1 
		to: abf size
		do: [ :i | self assert: (abf at: i) = (col at: i + 2) ].
	self assert: abf size + 2 = col size! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 4/24/2009 11:36'!
oldSubCollection
" return a subCollection included in collectionWith1TimeSubcollection .
ex :   subCollection := #( 2 3 4) and collectionWith1TimeSubcollection := #(1 2 3 4 5)"
	^ self nonEmpty ! !

!LinkedListTest methodsFor: 'tests - fixture' stamp: ''!
test0FixturePrintTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty! !

!LinkedListTest methodsFor: 'tests - empty' stamp: ''!
testIfEmptyifNotEmpty

	self assert: (self empty ifEmpty: [true] ifNotEmpty: [false]).
	self assert: (self nonEmpty ifEmpty: [false] ifNotEmpty: [true]).
	! !

!LinkedListTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testReverseWithDo
	
	| firstCollection secondCollection index |

	firstCollection := self nonEmptyMoreThan1Element.
	secondCollection := firstCollection copy.
	index := firstCollection size.
	
	firstCollection  reverseWith: secondCollection do:
		[:a :b |
	
		self assert: (firstCollection at: index) equals:  a. 
		self assert: (secondCollection at: index) equals:  b.
			( index := index - 1).]
	
	
	! !

!LinkedListTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyFromTo
	| result  index collection |
	collection := self collectionWithoutEqualElements .
	index :=self indexInForCollectionWithoutDuplicates .
	result := collection   copyFrom: index  to: collection  size .
	
	"verify content of 'result' : "
	1 to: result size do:
		[:i | 
		self assert: (result at:i)=(collection  at: (i + index - 1))].
	
	"verify size of 'result' : "
	self assert: result size = (collection  size - index + 1).! !

!LinkedListTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAllNoneThere
	"self debug: #testIncludesAllOfNoneThere'"
	self deny: (self empty includesAll: self nonEmpty ).
	self deny: (self nonEmpty includesAll: { self elementNotIn. self anotherElementNotIn })! !

!LinkedListTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfStartingAt
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			indexOf: element
			startingAt: 2
			ifAbsent: [ 99 ]) = 99.
	self assert: (collection 
			indexOf: element
			startingAt: 1
			ifAbsent: [ 99 ]) = 1.
	self assert: (collection 
			indexOf: self elementNotInForIndexAccessing
			startingAt: 1
			ifAbsent: [ 99 ]) = 99! !

!LinkedListTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testKeysAndValuesDoEmpty
	| result |
	result:= OrderedCollection new.
	
	self empty  keysAndValuesDo: 
		[:i :value|
		result add: (value+i)].
	
	self assert: result isEmpty .! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 4/23/2009 16:46'!
elementNotInForElementAccessing
" return an element not included in 'accessCollection' "
	^ elementNotIn ! !

!LinkedListTest methodsFor: 'tests - printing' stamp: ''!
testPrintOnDelimiterLast

	| aStream result allElementsAsString tmp |
	result:=''.
	aStream:= ReadWriteStream on: result.
	tmp:= OrderedCollection new.
	self nonEmpty do: [:each | tmp add: each asString].
	
	self nonEmpty printOn: aStream delimiter: ', ' last: 'and'.
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 )
			ifTrue: [self assert: (tmp occurrencesOf: (allElementsAsString at:i))=(allElementsAsString  occurrencesOf: (allElementsAsString at:i))].
		i=(allElementsAsString size-1)
			ifTrue:[ self deny: (allElementsAsString at:i)=('and')asString].
		i=(allElementsAsString size)
			ifTrue: [self assert: (tmp occurrencesOf: (allElementsAsString at:i))=(allElementsAsString  occurrencesOf: (allElementsAsString at:i))].
			].! !

!LinkedListTest methodsFor: 'tests - converting' stamp: ''!
testAsBag

	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: Bag! !

!LinkedListTest methodsFor: 'tests - fixture' stamp: ''!
howMany: aSubCollection in: collection
" return an integer representing how many time 'subCollection'  appears in 'collection'  "
	| tmp nTime |
	tmp := collection.
	nTime:= 0.
	
	[tmp isEmpty ]whileFalse:
		[
		(tmp beginsWith: aSubCollection)
			ifTrue: [ 	
				nTime := nTime + 1.
				1 to: aSubCollection size do: [:i | tmp := tmp copyWithoutFirst.]
				]
			ifFalse: [tmp := tmp copyWithoutFirst.]
		 ].
	
	^ nTime.
	! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 4/24/2009 10:55'!
indexInForCollectionWithoutDuplicates
" return an index between 'collectionWithoutEqualsElements'  bounds"
	^ 2! !

!LinkedListTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWith
	"self debug: #testCopyWith"
	| res anElement |
	anElement := self elementToAdd.
	res := self empty copyWith: anElement.
	self assert: res size = (self empty size + 1).
	self assert: (res includes: (anElement value))! !

!LinkedListTest methodsFor: 'tests - creating' stamp: 'nice 2/8/2012 21:41'!
testCreateAs
	"Test that a LinkedList can be created by sending message #as: to another collection.
	Implementation note: this method is generic for sequenceable collection and should be traitified."
	| anotherCollection aLinkedList |
	anotherCollection := 1 to: 10.
	aLinkedList := anotherCollection as: LinkedList.
	self assert: (aLinkedList isMemberOf: LinkedList).
	self assert: aLinkedList size equals: anotherCollection size.
	aLinkedList with: anotherCollection do: [:nextElementOfLinkedList :nextElementOfAnotherCollection |
		self assert: nextElementOfLinkedList equals: nextElementOfAnotherCollection]! !

!LinkedListTest methodsFor: 'tests - printing' stamp: ''!
testStoreOn
" for the moment work only for collection that include simple elements such that Integer"

"| string str result cuttedResult index elementsAsStringExpected elementsAsStringObtained tmp |
string := ''.
str := ReadWriteStream  on: string.
elementsAsStringExpected := OrderedCollection new.
elementsAsStringObtained := OrderedCollection new.
self nonEmpty do: [ :each | elementsAsStringExpected  add: each asString].

self nonEmpty storeOn: str.
result := str contents .
cuttedResult := ( result findBetweenSubStrs: ';' ).

index := 1.

cuttedResult do:
	[ :each |
	index = 1 
		ifTrue: [ self assert: (each beginsWith: ( tmp := '((' , self nonEmpty class asString , ' new) add: '           )).
				tmp := each copyFrom: ( tmp size + 1) to: ( each size ).
				elementsAsStringObtained add: tmp.
				index := index + 1. ]
		ifFalse:  [ 
		 index < cuttedResult size
			ifTrue:[self assert: (each beginsWith: ( tmp:=  ' add: '   )).
				tmp := each copyFrom: ( tmp size + 1) to: ( each size ).
				elementsAsStringObtained add: tmp.
					index := index + 1.]
			ifFalse: [self assert: ( each = ' yourself)' ) ].
			]
	
	].


	elementsAsStringExpected do: [ :each | self assert: (elementsAsStringExpected occurrencesOf: each ) = ( elementsAsStringObtained occurrencesOf: each) ]"

! !

!LinkedListTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfStartingAtIfAbsent
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			indexOf: element
			startingAt: 2
			ifAbsent: [ 99 ]) = 99.
	self assert: (collection 
			indexOf: element
			startingAt: 1
			ifAbsent: [ 99 ]) = 1.
	self assert: (collection 
			indexOf: self elementNotInForIndexAccessing
			startingAt: 1
			ifAbsent: [ 99 ]) = 99! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testRejectThenDo

	| result index rejectIndex |
	
	index := 0.
	rejectIndex := 0.
	
	result := self collectionWithoutNilElements 
		reject: [ :each | 
			rejectIndex := rejectIndex + 1.
			"reject the first element"
			rejectIndex = 1 ]
		thenDo: [ :each | 
			self assert: each notNil.
			index := index + 1]	.
			
	self assert: result equals: self collectionWithoutNilElements.
	self assert: rejectIndex equals: self collectionWithoutNilElements size.
	self assert: index equals: self collectionWithoutNilElements size - 1.
	 ! !

!LinkedListTest methodsFor: 'tests - set arithmetic' stamp: ''!
numberOfSimilarElementsInIntersection
	^ self collection occurrencesOf: self anotherElementOrAssociationIn! !

!LinkedListTest methodsFor: 'tests - element accessing' stamp: ''!
testAtAll
	"self debug: #testAtAll"
	"	self flag: #theCollectionshouldbe102030intheFixture.
	
	self assert: (self accessCollection atAll: #(2 1)) first = self accessCollection second.
	self assert: (self accessCollection atAll: #(2)) first = self accessCollection second."
	| result |
	result := self moreThan4Elements atAll: #(2 1 2 ).
	self assert: (result at: 1) = (self moreThan4Elements at: 2).
	self assert: (result at: 2) = (self moreThan4Elements at: 1).
	self assert: (result at: 3) = (self moreThan4Elements at: 2).
	self assert: (self moreThan4Elements atAll: #()) = self moreThan4Elements species new! !

!LinkedListTest methodsFor: 'tests - remove' stamp: ''!
testRemoveElementReallyRemovesElement
	"self debug: #testRemoveElementReallyRemovesElement"
	| size |
	size := self nonEmptyWithoutEqualElements size.
	self nonEmptyWithoutEqualElements remove: self nonEmptyWithoutEqualElements anyOne.
	self assert: size - 1 = self nonEmptyWithoutEqualElements size! !

!LinkedListTest methodsFor: 'tests - converting' stamp: ''!
assertNonDuplicatedContents: aCollection whenConvertedTo: aClass 
	| result |
	result := aCollection perform: ('as' , aClass name) asSymbol.
	self assert: (result class includesBehavior: aClass).
	result do: 
		[ :each | 
		self assert: (aCollection occurrencesOf: each) = (result occurrencesOf: each) ].
	^ result! !

!LinkedListTest methodsFor: 'tests - copying same contents' stamp: ''!
testShallowCopy
	| result |
	result := self nonEmpty shallowCopy .
	
	"verify content of 'result: '"
	1 to: self nonEmpty size do:
		[:i | self assert: ((result at:i)=(self nonEmpty at:i))].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!LinkedListTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfIfAbsent
	"self debug: #testIndexOfIfAbsent"
	| collection |
	collection := self collectionMoreThan1NoDuplicates.
	self assert: (collection 
			indexOf: collection first
			ifAbsent: [ 33 ]) = 1.
	self assert: (collection 
			indexOf: self elementNotInForIndexAccessing
			ifAbsent: [ 33 ]) = 33! !

!LinkedListTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyPartOfSequenceableTest
	self collectionWithoutEqualElements.
	self collectionWithoutEqualElements
		do: [ :each | self assert: (self collectionWithoutEqualElements occurrencesOf: each) = 1 ].
	self indexInForCollectionWithoutDuplicates.
	self
		assert:
			(self indexInForCollectionWithoutDuplicates > 0 & self indexInForCollectionWithoutDuplicates)
				< self collectionWithoutEqualElements size.
	self empty.
	self assert: self empty isEmpty! !

!LinkedListTest methodsFor: 'tests - converting' stamp: ''!
testAsIdentitySet
	"test with a collection without equal elements :"
	self 
		assertSameContents: self collectionWithoutEqualElements
		whenConvertedTo: IdentitySet.
! !

!LinkedListTest methodsFor: 'tests - converting' stamp: ''!
testAsSet
	| |
	"test with a collection without equal elements :"
	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: Set.
	! !

!LinkedListTest methodsFor: 'tests - empty' stamp: ''!
testIfNotEmpty

	self empty ifNotEmpty: [self assert: false].
	self nonEmpty ifNotEmpty: [self assert: true].
	self assert: (self nonEmpty ifNotEmpty: [:s | s ]) = self nonEmpty
	! !

!LinkedListTest methodsFor: 'tests' stamp: 'nice 7/28/2008 22:27'!
testAddAfterLast2
	"LinkedListTest new testAddAfterLast2"

	| l first second third fourth |
	l := LinkedList new.
	first := self class new n: 1.
	second := self class new n: 2.
	third := self class new n: 3.
	fourth :=self class new n: 4.
	l addLast: first.
	l addLast: second.
	self assert: (l collect:[:e | e n]) asArray  = #(1 2). 
	l add: third after: second.
	self assert: (l collect:[:e | e n]) asArray  = #(1 2 3).
	l addLast: fourth.
	self assert: (l collect:[:e | e n]) asArray  = #(1 2 3 4).! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 4/23/2009 15:10'!
elementNotInForIndexAccessing
" return an element not included in 'accessCollection' "
	^ elementNotIn ! !

!LinkedListTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyWithOrWithoutSpecificElementsTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self indexInNonEmpty.
	self assert: self indexInNonEmpty > 0.
	self assert: self indexInNonEmpty <= self nonEmpty size! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testBasicCollect

	| res index |
	index := 0.
	res := self collectionWithoutNilElements collect: [ :each | 
		index := index + 1.
		each ].
	
	res do: [ :each | 
		self assert: (self collectionWithoutNilElements occurrencesOf: each) = (res occurrencesOf: each)].
	self assert: index equals: self collectionWithoutNilElements size.
	 ! !

!LinkedListTest methodsFor: 'tests - empty' stamp: ''!
testIsEmptyOrNil

	self assert: (self empty isEmptyOrNil).
	self deny: (self nonEmpty isEmptyOrNil).! !

!LinkedListTest methodsFor: 'tests - includes' stamp: ''!
testIncludesElementIsThere
	"self debug: #testIncludesElementIsThere"
	
	self assert: (self nonEmpty includes: self nonEmpty anyOne).! !

!LinkedListTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifferenceWithSeparateCollection
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifferenceWithSeparateCollection"
	| res separateCol |
	
	separateCol := self collectionClass with: self anotherElementOrAssociationNotIn.
	res := self collectionWithoutEqualElements difference: separateCol.
	
	self deny: (res includes: self anotherElementOrAssociationNotIn).
	self assert: res size equals: self collectionWithoutEqualElements size.
	
	self collectionWithoutEqualElements do: [ :each|
		self assert: (res includes: each)].
	
	res := separateCol difference: self collection.
	self deny: (res includes: self collection anyOne).
	self assert: res equals: separateCol! !

!LinkedListTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfSubCollectionStartingAtIfAbsent
	"self debug: #testIndexOfIfAbsent"
	| index absent subcollection collection |
	collection := self collectionMoreThan1NoDuplicates.
	subcollection := self collectionMoreThan1NoDuplicates.
	absent := false.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 1
		ifAbsent: [ absent := true ].
	self assert: absent = false.
	absent := false.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 2
		ifAbsent: [ absent := true ].
	self assert: absent = true! !

!LinkedListTest methodsFor: 'requirements' stamp: 'damienpollet 1/29/2009 16:14'!
collectionWithElement
	"Returns a collection that already includes what is returned by #element."
	^ self collection! !

!LinkedListTest methodsFor: 'tests - element accessing' stamp: ''!
testAtLastError
	"self debug: #testAtLast"
	self 
		should: [ self moreThan4Elements atLast: self moreThan4Elements size + 1 ]
		raise: Error! !

!LinkedListTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpToLastEmpty
	| result |
	result := self empty copyUpToLast: self collectionWithoutEqualElements first.
	self assert: result isEmpty.! !

!LinkedListTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpToLast
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyUpToLast: (collection  at:index).
	
	"verify content of 'result' :"
	1 to: result size do: [:i| self assert: (collection   at:i)=(result at:i)].
	
	"verify size of 'result' :"
	self assert: result size = (index-1).! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testRejectThenCollectEmpty

	self assert: (self empty reject: [:e | self fail ] thenCollect: [ :each| self fail ]) isEmpty! !

!LinkedListTest methodsFor: 'tests - adding' stamp: ''!
testTAddIfNotPresentWithElementAlreadyIn

	| added oldSize collection anElement |
	collection := self collectionWithElement .
	oldSize := collection size.
	anElement := self element .
	self assert: (collection  includes: anElement ).
	
	added := collection  addIfNotPresent: anElement .
	
	self assert: added == anElement .	"test for identiy because #add: has not reason to copy its parameter."
	self assert: collection  size = oldSize! !

!LinkedListTest methodsFor: 'tests - printing' stamp: ''!
testPrintOn
	| aStream result allElementsAsString tmp |
	result:=''.
	aStream:= ReadWriteStream on: result.
	tmp:= OrderedCollection new.
	self nonEmpty do: [:each | tmp add: each asString].
	
	self nonEmpty printOn: aStream .
	allElementsAsString:=(result findBetweenSubStrs: ' ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i=1
			ifTrue:[
			self accessCollection class name first isVowel 
				ifTrue:[self assert: (allElementsAsString at:i)='an' ]
				ifFalse:[self assert: (allElementsAsString at:i)='a'].].
		i=2
			ifTrue:[self assert: (allElementsAsString at:i)=self accessCollection class name].
		i>2
			ifTrue:[self assert: (tmp occurrencesOf:(allElementsAsString at:i))=(allElementsAsString  occurrencesOf:(allElementsAsString at:i)).].	
			].! !

!LinkedListTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpTo
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyUpTo: (collection  at:index).
	
	"verify content of 'result' :"
	1 to: result size do: [:i| self assert: (collection   at:i)=(result at:i)].
	
	"verify size of 'result' :"
	self assert: result size = (index-1).
	! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testRejectThenDoOnEmpty

	self assert: (self empty reject: [:e | self fail ] thenDo: [ self fail ]) isEmpty! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testSelectThenDoOnEmpty

	self assert: (self empty select: [:e | self fail ] thenDo: [ self fail ]) isEmpty! !

!LinkedListTest methodsFor: 'tests - remove' stamp: ''!
testRemoveElementFromEmpty
	"self debug: #testRemoveElementFromEmpty"
	self 
		should: [ self empty remove: self nonEmptyWithoutEqualElements anyOne ]
		raise: Error! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 4/24/2009 11:17'!
collectionWithElementsToRemove
" return a collection of elements included in 'nonEmpty'  "
	^ self nonEmpty ! !

!LinkedListTest methodsFor: 'tests - copying same contents' stamp: ''!
testReversed
	| result |
	result := self nonEmpty reversed .
	
	"verify content of 'result: '"
	1 to:  result size do:
		[:i | self assert: ((result at:i)=(self nonEmpty at:(self nonEmpty size-i+1)))].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!LinkedListTest methodsFor: 'tests - element accessing' stamp: ''!
testLast
	"self debug: #testLast"
	self assert: self moreThan4Elements last = (self moreThan4Elements at: self moreThan4Elements size)! !

!LinkedListTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterLastMore

	| delim multiItemStream result last allElementsAsString |
	
	delim := ', '.
	last := 'and'.
	result:=''.
	multiItemStream := ReadWriteStream on:result.
	self nonEmpty  asStringOn: multiItemStream delimiter: ', ' last: last.
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 )
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString)].
		i=(allElementsAsString size-1)
			ifTrue:[ self deny: (allElementsAsString at:i)=(last)asString].
		i=(allElementsAsString size)
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:(i-1))asString)].
			].
	
! !

!LinkedListTest methodsFor: 'testing' stamp: 'mk 8/3/2005 12:10'!
test11removeLast
	list add: link1.
	list add: link2.
	list add: link3.
	list add: link4.
	
	self assert: list size = 4.
	self assert: list first == link1.
	self assert: list second == link2.
	self assert: list third == link3.
	self assert: list fourth == link4.
	
	list removeLast.
	self assert: list size = 3.
	self assert: list first == link1.
	self assert: list second == link2.
	self assert: list third == link3.
	
	list removeLast.
	self assert: list size = 2.
	self assert: list first == link1.
	self assert: list second == link2.
	
	list removeLast.
	self assert: list size = 1.
	self assert: list first == link1.
	
	list removeFirst.
	self assert: list isEmpty! !

!LinkedListTest methodsFor: 'tests - adding' stamp: 'damien.pollet 10/31/2008 23:16'!
testTAdd

	| added |
	added := self otherCollection add: self element.
	self assert: added = self element. "equality or identity ?"
	self assert: (self otherCollection includes: self element).

	! !

!LinkedListTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIncludeTest
	| anElementIn |
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self elementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self elementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self anotherElementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self anotherElementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self empty.
	self assert: self empty isEmpty! !

!LinkedListTest methodsFor: 'tests - includes' stamp: 'CamilloBruni 8/31/2013 20:23'!
testIdentityIncludes
	" test the comportement in presence of elements 'includes' but not 'identityIncludes' "

	" can not be used by collections that can't include elements for wich copy doesn't return another instance "

	| collection element |
	self collectionWithCopyNonIdentical.
	collection := self collectionWithCopyNonIdentical.
	element := collection anyOne copy.	"self assert: (collection includes: element)."
	self deny: (collection identityIncludes: element)! !

!LinkedListTest methodsFor: 'tests - empty' stamp: ''!
testIfNotEmptyifEmpty

	self assert: (self empty ifNotEmpty: [false] ifEmpty: [true]).
	self assert: (self nonEmpty ifNotEmpty: [true] ifEmpty: [false]).
	! !

!LinkedListTest methodsFor: 'tests - includes' stamp: ''!
testIncludesElementIsNotThere
	"self debug: #testIncludesElementIsNotThere"
	
	self deny: (self nonEmpty includes: self elementNotIn).
	self assert: (self nonEmpty includes: self nonEmpty anyOne).
	self deny: (self empty includes: self elementNotIn)! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 4/24/2009 11:36'!
replacementCollection
" return a collection that will be used to replace 'oldSubcollection' in ' collectionWith1TimeSubcollection'  " 
	^ collectionWithoutNil ! !

!LinkedListTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithoutIndex
	| result index |
	index := self indexInNonEmpty .
	result := self nonEmpty copyWithoutIndex: index .
	
	"verify content of 'result:'"
	1 to: result size do:
		[:i | 
		i<( index ) ifTrue: [self assert: ((result at:i )= (self nonEmpty at:i))].
		i>=( index ) ifTrue: [self assert: (result at:i )= (self nonEmpty at:(i+1))]].
	
	"verify size of result : "
	self assert: result size=(self nonEmpty size -1).! !

!LinkedListTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfterEmpty
	| result |
	result := self empty copyAfter: self collectionWithoutEqualElements first.
	self assert: result isEmpty.
	! !

!LinkedListTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testReverseDo
	| result |
	result:= OrderedCollection new.
	self nonEmpty reverseDo: [: each | result add: each].
	
	1 to: result size do:
		[:i|
		self assert: (result at: i)=(self nonEmpty at:(self nonEmpty size-i+1))].! !

!LinkedListTest methodsFor: 'tests - copy' stamp: ''!
testCopyEquals
	"self debug: #testCopySameClass"
	"A copy should be equivalent to the things it's a copy of"
	
	| copy | 
	copy := self nonEmpty copy.
	self assert: copy  = self nonEmpty.! !

!LinkedListTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWithoutAll
	"self debug: #testCopyEmptyWithoutAll"
	| res |
	res := self empty copyWithoutAll: self collectionWithElementsToRemove.
	self assert: res size = self empty size.
	self collectionWithElementsToRemove do: [ :each | self deny: (res includes: each) ]! !

!LinkedListTest methodsFor: 'tests' stamp: 'sd 6/5/2005 09:20'!
testAddAfterLast

	| l last |
	l := LinkedList new.
	last := self class new n: 2.
	l add: (self class new n: 1).
	l add: last.
	self assert: (l collect:[:e | e n]) asArray  = #(1 2). 
	l add: (self class new n: 3) after: last.
	self assert: (l collect:[:e | e n]) asArray  = #(1 2 3).! !

!LinkedListTest methodsFor: 'tests - adding' stamp: ''!
testTAddIfNotPresentWithNewElement

	| added oldSize collection elem |
	collection := self otherCollection .
	oldSize := collection  size.
	elem := self element .
	self deny: (collection  includes: elem ).
	
	added := collection  addIfNotPresent: elem .
	self assert: added == elem . "test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection  size = (oldSize + 1)).

	! !

!LinkedListTest methodsFor: 'tests - element accessing' stamp: ''!
testAtPin
	"self debug: #testAtPin"
	self assert: (self moreThan4Elements atPin: 2) = self moreThan4Elements second.
	self assert: (self moreThan4Elements atPin: 99) = self moreThan4Elements last.
	self assert: (self moreThan4Elements atPin: -99) = self moreThan4Elements first! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testCollectThenSelectOnEmpty

	self assert: (self empty collect: [:e | self fail] thenSelect: [:e | self fail ]) isEmpty! !

!LinkedListTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutAll
	"self debug: #testCopyNonEmptyWithoutAll"
	| res |
	res := self nonEmpty copyWithoutAll: self collectionWithElementsToRemove.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self collectionWithElementsToRemove do: [ :each | self deny: (res includes: (each)) ].
	self nonEmpty do: 
		[ :each | 
		(self collectionWithElementsToRemove includes: each) ifFalse: [ self assert: (res includes: each) ] ]! !

!LinkedListTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfterLast
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyAfterLast: (collection  at:index ).
	
	"verifying content: "
	(1) to: result size do: 
		[:i |
		self assert: (collection   at:(i + index ))=(result at: (i))].

	"verify size: "
	self assert: result size = (collection   size - index).! !

!LinkedListTest methodsFor: 'tests - element accessing' stamp: ''!
testAtLastIfAbsent
	"self debug: #testAtLastIfAbsent"
	self assert: (self moreThan4Elements 
			atLast: 1
			ifAbsent: [ nil ]) = self moreThan4Elements last.
	self assert: (self moreThan4Elements 
			atLast: self moreThan4Elements size + 1
			ifAbsent: [ 222 ]) = 222! !

!LinkedListTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButLastNElements
	"self debug: #testAllButFirst"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButLast: 2.
	1 
		to: abf size
		do: [ :i | self assert: (abf at: i) = (col at: i) ].
	self assert: abf size + 2 = col size! !

!LinkedListTest methodsFor: 'test - fixture' stamp: ''!
test0FixtureIterateTest
	| res |
	self collectionWithoutNilElements.
	self assert: (self collectionWithoutNilElements occurrencesOf: nil) = 0.
	res := true.
	self collectionWithoutNilElements
		detect: [ :each | (self collectionWithoutNilElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testNoneSatisfy

	| element |
	self assert: ( self collectionWithoutNilElements  noneSatisfy: [:each | each notNil not ] ).
	element := self collectionWithoutNilElements anyOne.
	self deny: ( self collectionWithoutNilElements  noneSatisfy: [:each | (each = element)not ] ).! !

!LinkedListTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindFirstNotIn

	| result |
	
	 result:=self empty findFirst: [:each | true].
	
	self assert: result=0. ! !

!LinkedListTest methodsFor: 'tests - element accessing' stamp: ''!
testAfterIfAbsent
	"self debug: #testAfterIfAbsent"
	self assert: (self moreThan4Elements 
			after: (self moreThan4Elements at: 1)
			ifAbsent: [ 33 ]) = (self moreThan4Elements at: 2).
	self assert: (self moreThan4Elements 
			after: (self moreThan4Elements at: self moreThan4Elements size)
			ifAbsent: [ 33 ]) = 33.
	self assert: (self moreThan4Elements 
			after: self elementNotInForElementAccessing
			ifAbsent: [ 33 ]) = 33! !

!LinkedListTest methodsFor: 'tests - converting' stamp: ''!
assertNoDuplicates: aCollection whenConvertedTo: aClass 
	| result |
	result := self collectionWithEqualElements asIdentitySet.
	self assert: (result class includesBehavior: IdentitySet).
	self collectionWithEqualElements do: [ :initial | self assert: (result occurrencesOf: initial) = 1 ]! !

!LinkedListTest methodsFor: 'tests - copying with or without' stamp: ''!
testForceToPaddingWith

	| result element |
	element := self nonEmpty at: self indexInNonEmpty .
	result := self nonEmpty forceTo: (self nonEmpty size+2) paddingWith: ( element ).
	
	"verify content of 'result' : "
	1 to: self nonEmpty  size do:
		[:i | self assert: ( self nonEmpty at: i ) = ( result at:(i) ). ].
	
	(result size - 1) to: result size do:
		[:i | self assert: ( result at:i ) = ( element ) ].

	"verify size of 'result' :"
	self assert: result size = (self nonEmpty size + 2).! !

!LinkedListTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsCommaStringEmpty

	self assert: self empty asCommaString = ''.
	self assert: self empty asCommaStringAnd = ''.
	
! !

!LinkedListTest methodsFor: 'testing' stamp: 'mk 8/3/2005 12:13'!
test14removeIfAbsent
	list add: link1.
	
	self assert: list size = 1.
	self assert: list first == link1.
	
	list remove: link1.
	self assert: list isEmpty.
	
	[list remove: link1]
		on: Error
		do: [^ self].
		
	"The execution should not get here. If yes, something went wrong."
	self assert: false! !

!LinkedListTest methodsFor: 'requirements' stamp: 'HenrikSperreJohansen 10/19/2009 14:58'!
nonEmpty
	^ nonEmpty ifNil: [nonEmpty := LinkedList with: 5 with: 4 with: 3 with: 2 with: 1 with: self element]! !

!LinkedListTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindLast

	| element result |
	element := self nonEmptyMoreThan1Element  at:self nonEmptyMoreThan1Element  size.
	 result:=self nonEmptyMoreThan1Element  findLast: [:each | each =element].
	
	self assert: result=self nonEmptyMoreThan1Element  size. ! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testBasicCollectThenDo

	| result index |
	index := 0.
	result := self collectionWithoutNilElements 
		collect: [ :each | nil ]
		thenDo: [ :each | 
			self assert: each isNil.
			index := index + 1]	.
			
	self assert: result equals: self collectionWithoutNilElements.
	self assert: index equals: self collectionWithoutNilElements size.
	 ! !

!LinkedListTest methodsFor: 'tests - sequenceable' stamp: 'CamilloBruni 8/31/2013 20:23'!
testAtPut
	| ll |
	ll := LinkedList new.
	ll add: 1.
	ll at: 1 put: 2.
	self assert: (ll at: 1) equals: 2! !

!LinkedListTest methodsFor: 'tests - remove' stamp: ''!
testRemoveAllFoundIn
	"self debug: #testRemoveElementThatExists"
	| el aSubCollection res |
	el := self nonEmptyWithoutEqualElements anyOne.
	aSubCollection := (self nonEmptyWithoutEqualElements copyWithout: el) copyWith: self elementNotIn.
	res := self nonEmptyWithoutEqualElements removeAllFoundIn: aSubCollection.
	self assert: self nonEmptyWithoutEqualElements size = 1.
	self nonEmptyWithoutEqualElements do: [ :each | self assert: each = el ]! !

!LinkedListTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureRequirementsOfTAddTest
	self collectionWithElement.
	self otherCollection.
	self element.
	self assert: (self collectionWithElement includes: self element).
	self deny: (self otherCollection includes: self element)! !

!LinkedListTest methodsFor: 'testing' stamp: 'mk 8/3/2005 12:05'!
test05addBefore
	self assert: list isEmpty.
	
	list add: link1.
	self assert: list size = 1.
	self assert: list first == link1.
	
	list add: link2 before: link1.
	self assert: list size = 2.
	self assert: list first == link2.
	self assert: list second == link1.
	
	list add: link3 before: link2.
	self assert: list size = 3.
	self assert: list first == link3.
	self assert: list second == link2.
	self assert: list third == link1.
	
	list add: link4 before: link3.
	self assert: list size = 4.
	self assert: list first == link4.
	self assert: list second == link3.
	self assert: list third == link2.
	self assert: list fourth == link1! !

!LinkedListTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testReverseDoEmpty
	| result |
	result:= OrderedCollection new.
	self empty reverseDo: [: each | result add: each].
	
	self assert: result isEmpty .! !

!LinkedListTest methodsFor: 'tests - element accessing' stamp: ''!
testFirstSecondThird
	"self debug: #testFirstSecondThird"
	self assert: self moreThan4Elements first = (self moreThan4Elements at: 1).
	self assert: self moreThan4Elements second = (self moreThan4Elements at: 2).
	self assert: self moreThan4Elements third = (self moreThan4Elements at: 3).
	self assert: self moreThan4Elements fourth = (self moreThan4Elements at: 4)! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testCollectOnEmpty
	self assert: (self empty collect: [:e | self fail]) isEmpty! !

!LinkedListTest methodsFor: 'tests - copying with or without' stamp: ''!
testForceToPaddingStartWith

	| result element |
	element := self nonEmpty at: self indexInNonEmpty .
	result := self nonEmpty forceTo: (self nonEmpty size+2) paddingStartWith: ( element ).
	
	"verify content of 'result' : "
	1 to: 2   do:
		[:i | self assert: ( element ) = ( result at:(i) ) ].
	
	3 to: result size do:
		[:i | self assert: ( result at:i ) = ( self nonEmpty at:(i-2) ) ].

	"verify size of 'result' :"
	self assert: result size = (self nonEmpty size + 2).! !

!LinkedListTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureTRemoveTest
	| duplicate |
	self empty.
	self nonEmptyWithoutEqualElements.
	self deny: self nonEmptyWithoutEqualElements isEmpty.
	duplicate := true.
	self nonEmptyWithoutEqualElements
		detect: [ :each | (self nonEmptyWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ duplicate := false ].
	self assert: duplicate = false.
	self elementNotIn.
	self assert: self empty isEmpty.
	self deny: self nonEmptyWithoutEqualElements isEmpty.
	self deny: (self nonEmptyWithoutEqualElements includes: self elementNotIn)! !

!LinkedListTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithFirst

	| index element result |
	index:= self indexInNonEmpty .
	element:= self nonEmpty at: index.
	
	result := self nonEmpty copyWithFirst: element.	
	
	self assert: result size = (self nonEmpty size + 1).
	self assert: result first = element .
	
	2 to: result size do:
	[ :i |
	self assert: (result at: i) = ( self nonEmpty at: ( i - 1 ))].! !

!LinkedListTest methodsFor: 'tests - empty' stamp: 'damien.pollet 10/31/2008 14:36'!
empty
	^ list! !

!LinkedListTest methodsFor: 'tests - element accessing' stamp: ''!
testAtLast
	"self debug: #testAtLast"
	| index |
	self assert: (self moreThan4Elements atLast: 1) = self moreThan4Elements last.
	"tmp:=1.
	self do:
		[:each | 
		each =self elementInForIndexAccessing 
			ifTrue:[index:=tmp].
		tmp:=tmp+1]."
	index := self moreThan4Elements indexOf: self elementInForElementAccessing.
	self assert: (self moreThan4Elements atLast: index) = (self moreThan4Elements at: self moreThan4Elements size - index + 1)! !

!LinkedListTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterEmpty

	| delim emptyStream |
	delim := ', '.
	emptyStream := ReadWriteStream on: ''.
	self empty asStringOn: emptyStream delimiter: delim.
	self assert: emptyStream contents = ''.
! !

!LinkedListTest methodsFor: 'requirements' stamp: 'damienpollet 1/29/2009 19:10'!
collection
	^ self nonEmpty! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 12:03'!
anotherElementOrAssociationIn
	" return an element (or an association for Dictionary ) present  in 'collection' "
	^ self collection anyOne! !

!LinkedListTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionEmpty
	"self debug: #testIntersectionEmpty"
	
	| inter |
	inter := self empty intersection: self empty.
	self assert: inter isEmpty. 
	inter := self empty intersection: self collection .
	self assert: inter =  self empty.
	! !

!LinkedListTest methodsFor: 'tests - swap' stamp: 'CamilloBruni 11/2/2012 15:58'!
testSwapStartAndEnd
	|aList|
	aList := LinkedList with: 5 with: 4 with: 3 with: 2 with: 1.
	
	aList swap: 1 with: 5.
	self assert: (aList at: 1) equals: 1.
	self assert: (aList at: 5) equals: 5.
	self assert: aList first equals: 1.
	self assert: aList last equals: 5.! !

!LinkedListTest methodsFor: 'tests - element accessing' stamp: ''!
testAtRandom
	| result |
	result := self nonEmpty atRandom .
	self assert: (self nonEmpty includes: result).! !

!LinkedListTest methodsFor: 'tests - converting' stamp: ''!
assertSameContents: aCollection whenConvertedTo: aClass 
	| result |
	result := self assertNonDuplicatedContents: aCollection whenConvertedTo: aClass.
	self assert: result size = aCollection size! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testInjectInto
	|result|
	result:= self collectionWithoutNilElements 
		inject: 0
		into: [:inj :ele | ele notNil ifTrue: [ inj + 1 ]].
	
	self assert: self collectionWithoutNilElements size = result .! !

!LinkedListTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOfNotIn
	| result |
	result := self collectionWithoutEqualElements occurrencesOf: self elementNotInForOccurrences.
	self assert: result = 0! !

!LinkedListTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureBeginsEndsWithTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self assert: self nonEmpty size > 1.
	self empty.
	self assert: self empty isEmpty! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testRejectEmpty

	| res |
	res := self empty reject: [:each | each odd].
	self assert: res size = self empty size
	! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testCollectThenDoOnEmpty

	self assert: (self empty collect: [:e | self fail] thenDo: [ self fail ]) isEmpty! !

!LinkedListTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifferenceWithNonNullIntersection
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifferenceWithNonNullIntersection"
	"	#(1 2 3) difference: #(2 4) 
	->  #(1 3)"
	| res overlapping |
	overlapping := self collectionClass 
		with: self anotherElementOrAssociationNotIn
		with: self anotherElementOrAssociationIn.
	res := self collection difference: overlapping.
	self deny: (res includes: self anotherElementOrAssociationIn).
	overlapping do: [ :each | self deny: (res includes: each) ]! !

!LinkedListTest methodsFor: 'tests - element accessing' stamp: ''!
testAtIfAbsent
	"self debug: #testAt"
	| absent |
	absent := false.
	self moreThan4Elements 
		at: self moreThan4Elements size + 1
		ifAbsent: [ absent := true ].
	self assert: absent = true.
	absent := false.
	self moreThan4Elements 
		at: self moreThan4Elements size
		ifAbsent: [ absent := true ].
	self assert: absent = false! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 4/24/2009 11:17'!
collectionNotIncluded
" return a collection for wich each element is not included in 'nonEmpty' "
	^ collectionWithoutNil ! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 5/13/2009 16:07'!
elementNotInForOccurrences
" return an element notIncluded in #collectionWithoutEqualElements"
	^ elementNotIn ! !

!LinkedListTest methodsFor: 'tests - swap' stamp: 'CamilloBruni 11/2/2012 15:59'!
testSwapAdjacent
	|aList|
	aList := LinkedList with: 5 with: 4 with: 3 with: 2 with: 1.
	
	aList swap: 3 with: 4.
	self assert: (aList at: 3) equals: 2.
	self assert: (aList at: 4) equals: 3.! !

!LinkedListTest methodsFor: 'test - equality' stamp: ''!
testEqualSignOfIdenticalCollectionObjects
	"self debug: #testEqualSignOfIdenticalCollectionObjects"
	
	self assert: (self empty = self empty). 
	self assert: (self nonEmpty = self nonEmpty). 
	! !

!LinkedListTest methodsFor: 'tests - index access' stamp: ''!
testIndexOf
	"self debug: #testIndexOf"
	| tmp index collection |
	collection := self collectionMoreThan1NoDuplicates.
	tmp := collection size.
	collection reverseDo: 
		[ :each | 
		each = self elementInForIndexAccessing ifTrue: [ index := tmp ].
		tmp := tmp - 1 ].
	self assert: (collection indexOf: self elementInForIndexAccessing) = index! !

!LinkedListTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSubcollectionAccessTest
	self moreThan3Elements.
	self assert: self moreThan3Elements size > 2! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 12:04'!
anotherElementOrAssociationNotIn
	" return an element (or an association for Dictionary )not present  in 'collection' "
	^ elementNotIn ! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 4/23/2009 16:27'!
elementInForIndexAccessing
" return an element included in 'accessCollection' "
	^ elementIn ! !

!LinkedListTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSequencedElementAccessTest
	self moreThan4Elements.
	self assert: self moreThan4Elements size >= 4.
	self subCollectionNotIn.
	self subCollectionNotIn detect: [ :each | (self moreThan4Elements includes: each) not ] ifNone: [ self assert: false ].
	self elementNotInForElementAccessing.
	self deny: (self moreThan4Elements includes: self elementNotInForElementAccessing).
	self elementInForElementAccessing.
	self assert: (self moreThan4Elements includes: self elementInForElementAccessing)! !

!LinkedListTest methodsFor: 'tests - sequenceable' stamp: 'CamilloBruni 8/31/2013 20:23'!
testAtPutOutsideBounds
	| ll |
	ll := LinkedList new.
	self should: [ ll at: 1 put: 1 ] raise: SubscriptOutOfBounds! !

!LinkedListTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionBasic
	"self debug: #testIntersectionBasic"
	| inter |
	inter := self collection intersection: (self collectionClass with: self anotherElementOrAssociationIn).
	self deny: inter isEmpty.
	self assert: (inter includes: self anotherElementOrAssociationIn value)! !

!LinkedListTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifference
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifference"
	
	| difference |
	self assert: (self collectionWithoutEqualElements difference: self collectionWithoutEqualElements) isEmpty.
	self assert: (self empty difference: self collectionWithoutEqualElements) isEmpty.
	difference := (self collectionWithoutEqualElements difference: self empty).
	self assert: difference size = self collectionWithoutEqualElements	 size.
	self collectionWithoutEqualElements do: [ :each |
		self assert: (difference includes: each)].
! !

!LinkedListTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButFirst
	"self debug: #testAllButFirst"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButFirst.
	self deny: abf first = col first.
	self assert: abf size + 1 = col size! !

!LinkedListTest methodsFor: 'tests - swap' stamp: 'CamilloBruni 11/2/2012 15:59'!
testSwapAdjacentEnd
	|aList|
	aList := LinkedList with: 5 with: 4 with: 3 with: 2 with: 1.
	
	aList swap: 4 with: 5.
	self assert: (aList at: 4) equals: 1.
	self assert: (aList at: 5) equals: 2.
	self assert: aList last equals: 2.! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testSelectThenDo

	| result index selectIndex |
	
	index := 0.
	selectIndex := 0.
	
	result := self collectionWithoutNilElements 
		select: [ :each | 
			selectIndex := selectIndex + 1.
			"reject the first element"
			selectIndex > 1 ]
		thenDo: [ :each | 
			self assert: each notNil.
			index := index + 1]	.
			
	self assert: result equals: self collectionWithoutNilElements.
	self assert: selectIndex equals: self collectionWithoutNilElements size.
	self assert: index equals: self collectionWithoutNilElements size - 1.
	 ! !

!LinkedListTest methodsFor: 'requirements' stamp: 'HenrikSperreJohansen 10/19/2009 14:48'!
element
	^ link ifNil: [link := ValueLink value: 42. "so that we can recognize this link"]! !

!LinkedListTest methodsFor: 'tests - empty' stamp: ''!
testNotEmpty

	self assert: (self nonEmpty  notEmpty).
	self deny: (self empty notEmpty).! !

!LinkedListTest methodsFor: 'requirements' stamp: 'damienpollet 1/29/2009 16:22'!
otherCollection
	^ otherList ifNil: [otherList := LinkedList with: Link new with: Link new]! !

!LinkedListTest methodsFor: 'tests - remove' stamp: ''!
testRemoveAllSuchThat
	"self debug: #testRemoveElementThatExists"
	| el aSubCollection |
	el := self nonEmptyWithoutEqualElements anyOne.
	aSubCollection := self nonEmptyWithoutEqualElements copyWithout: el.
	self nonEmptyWithoutEqualElements removeAllSuchThat: [ :each | aSubCollection includes: each ].
	self assert: self nonEmptyWithoutEqualElements size = 1.
	self nonEmptyWithoutEqualElements do: [ :each | self assert: each = el ]! !

!LinkedListTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testAllButLastDo
	
	| result |
	result:= OrderedCollection  new.
	
	self nonEmptyMoreThan1Element  allButLastDo: [:each | result add: each].
	
	1 to: (result size) do:
		[:i|
		self assert: (self nonEmptyMoreThan1Element  at:(i ))=(result at:i)].
	
	self assert: result size=(self nonEmptyMoreThan1Element  size-1).! !

!LinkedListTest methodsFor: 'tests' stamp: 'sd 6/5/2005 09:20'!
testAddAfter

	| l first |
	l := LinkedList new.
	first := self class new n: 1.
	
	l add: first.
	l add: (self class new n: 3).
	self assert: (l collect:[:e | e n]) asArray  = #(1 3).
	l add: (self class new n: 2) after: first.
	self assert: (l collect:[:e | e n]) asArray  = #(1 2 3).! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 11:30'!
nonEmptyWithoutEqualElements
" return a collection without equal elements "
	^ collectionWithoutEqualElements ! !

!LinkedListTest methodsFor: 'testing' stamp: 'mk 8/3/2005 12:12'!
test13remove
	list add: link1.
	list add: link2.
	list add: link3.
	list add: link4.
	
	self assert: list size = 4.
	self assert: list first == link1.
	self assert: list second == link2.
	self assert: list third == link3.
	self assert: list fourth == link4.
	
	list remove: link1.
	self assert: list size = 3.
	self assert: list first == link2.
	self assert: list second == link3.
	self assert: list third == link4.
	
	list remove: link4.
	self assert: list size = 2.
	self assert: list first == link2.
	self assert: list second == link3.
	
	list remove: link2.
	self assert: list size = 1.
	self assert: list first == link3.
	
	list remove: link3.
	self assert: list isEmpty! !

!LinkedListTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testPairsCollect
	
	| index result |
	index:=0.
	
	result:=self nonEmptyMoreThan1Element  pairsCollect: 
		[:each1 :each2 | 
		self assert: ( self nonEmptyMoreThan1Element indexOf: each2 ) = (index := index + 2).
		(self nonEmptyMoreThan1Element indexOf: each2) = ((self nonEmptyMoreThan1Element indexOf: each1) + 1).
		].
	
	result do: 
		[:each | self assert: each = true].
	
! !

!LinkedListTest methodsFor: 'tests - copying same contents' stamp: ''!
testShallowCopyEmpty
	| result |
	result := self empty shallowCopy .
	self assert: result isEmpty .! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testRejectNoReject

	| res |
	res := self collectionWithoutNilElements  reject: [:each | each notNil not].
	self assert: res size = self collectionWithoutNilElements size.
	! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 4/23/2009 16:47'!
subCollectionNotIn
" return a collection for which at least one element is not included in 'accessCollection' "
	^ collectionWithoutNil ! !

!LinkedListTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithIndexDo
	
	"| result |
	result:=Array new: self nonEmptyMoreThan1Element size.
	self nonEmptyMoreThan1Element  withIndexDo: [:each :i | result at:i put:(each+i)].
	
	1 to: result size do:[: i | self assert: (result at:i)= ((self nonEmptyMoreThan1Element at: i) + i)]"
	|  indexes elements |
	indexes:= OrderedCollection new.
	elements := OrderedCollection new.
	
	self nonEmptyMoreThan1Element  withIndexDo: 
		[:value :i  |
		indexes  add: (i).
		elements add: value].
	
	(1 to: self nonEmptyMoreThan1Element size )do:
		[ :i |
		self assert: (indexes at: i) = i.
		self assert: (elements at: i) = (self nonEmptyMoreThan1Element at: i).	
		].
	
	self assert: indexes size = elements size. 
	self assert: indexes size = self nonEmptyMoreThan1Element size . 
	! !

!LinkedListTest methodsFor: 'tests - copying same contents' stamp: ''!
testReverse

	| result |
	result := self nonEmpty reversed.	
	"verify content of 'result: '"
	1 to: result size do:
		[:i | self assert: ((result at: i) 
			= (self nonEmpty at: (self nonEmpty size - i + 1)))].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!LinkedListTest methodsFor: 'tests - element accessing' stamp: ''!
testBeforeIfAbsent
	"self debug: #testBefore"
	self assert: (self moreThan4Elements 
			before: (self moreThan4Elements at: 1)
			ifAbsent: [ 99 ]) = 99.
	self assert: (self moreThan4Elements 
			before: (self moreThan4Elements at: 2)
			ifAbsent: [ 99 ]) = (self moreThan4Elements at: 1)! !

!LinkedListTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpToEmpty
	| result |
	result := self empty copyUpTo: self collectionWithoutEqualElements first.
	self assert: result isEmpty.
	! !

!LinkedListTest methodsFor: 'testing' stamp: 'mk 8/3/2005 12:09'!
test09addAfter
	| l last |
	l := LinkedList new.
	last := self class new n: 2.
	l add: (self class new n: 1).
	l add: last.
	
	self assert: (l collect:[:e | e n]) asArray  = #(1 2).
	 
	l add: (self class new n: 3) after: last.

	self assert: (l collect:[:e | e n]) asArray  = #(1 2 3).! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 4/22/2009 15:32'!
speciesClass
	
	^LinkedList! !

!LinkedListTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindLastNotIn

	| result |
	
	 result:=self empty findFirst: [:each | true].
	
	self assert: result=0. ! !

!LinkedListTest methodsFor: 'tests - set arithmetic' stamp: ''!
containsAll: union of: one andOf: another
			
	self assert: (one allSatisfy: [:each | union includes: each]).
	self assert: (another allSatisfy: [:each | union includes: each])! !

!LinkedListTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopySameContentsTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!LinkedListTest methodsFor: 'running' stamp: 'damien.pollet 10/31/2008 14:48'!
tearDown
	list := nil.
	link1 := nil.
	link2 := nil.
	link3 := nil.
	link4 := nil.
	
	link := nil.
	nonEmpty := nil.
	otherList := nil.
	
	^ super tearDown! !

!LinkedListTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsCommaStringOne
	
	"self assert: self oneItemCol asCommaString = '1'.
	self assert: self oneItemCol asCommaStringAnd = '1'."

	self assert: self nonEmpty1Element  asCommaString = (self nonEmpty1Element first asString).
	self assert: self nonEmpty1Element  asCommaStringAnd = (self nonEmpty1Element first asString).
	! !

!LinkedListTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFromToDo
	
	| result |
	result:= OrderedCollection  new.
	
	self nonEmptyMoreThan1Element  from: 1 to: (self nonEmptyMoreThan1Element  size -1) do: [:each | result add: each].
	
	1 to: (self nonEmptyMoreThan1Element  size -1) do:
		[:i|
		self assert: (self nonEmptyMoreThan1Element  at:i )=(result at:i)].
	self assert: result size=(self nonEmptyMoreThan1Element  size-1).! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testRejectAllThenDo
	| result |
	
	result := self collectionWithoutNilElements 
		reject: [ :each | each notNil ] 
		thenDo: [ :each | self fail ].
	
	self assert: result equals: self collectionWithoutNilElements! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 4/22/2009 15:31'!
elementNotIn
	^ Link new! !

!LinkedListTest methodsFor: 'running' stamp: 'MarcusDenker 2/24/2010 22:59'!
setUp
	
	super setUp.
	list := LinkedList new.
	link1 := 133.
	link2 := 'test'.
	link3 := $h.
	link4 := Set new.
	elementNotIn := Link new.
	collectionWithoutNil := LinkedList new add: link1; add: link2 ; add: link3; yourself.
	elementIn := 'thisElementIsIncluded'.
	collectionWithoutEqualElements := LinkedList new add: elementIn ; add: 'pewpew' ; add: 'normal links'; add: 'are no fun!!' ;add: $x ;yourself.
	collection5Elements := collectionWithoutEqualElements .
	
	"sameAtendAndBegining := LinkedList new add: Link new; add: Link new ; add: Link new; yourself."
	link := ValueLink value: 42.
	nonEmpty1Element :=  LinkedList new add: Link new; yourself.
	 "so that we can recognize this link"
	"nonEmpty := LinkedList with: link with: Link new."
	"otherList := LinkedList with: Link new with: Link new."
! !

!LinkedListTest methodsFor: 'testing' stamp: 'mk 8/3/2005 12:04'!
test01add
	self assert: list isEmpty.
	list add: link1.
	self assert: list size = 1.
	self assert: list first = link1.
	
	list add: link2.
	self assert: list size = 2.
	self assert: list first = link1.
	self assert: list second = link2.
	
	list add: link3.
	self assert: list size = 3.
	self assert: list first = link1.
	self assert: list second = link2.
	self assert: list third = link3.
	
	list add: link4.
	self assert: list size = 4.
	self assert: list first = link1.
	self assert: list second = link2.
	self assert: list third = link3.
	self assert: list fourth = link4! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 10:52'!
moreThan3Elements
	" return a collection including atLeast 3 elements"
	^ collectionWithoutEqualElements ! !

!LinkedListTest methodsFor: 'tests - element accessing' stamp: ''!
testMiddle
	"self debug: #testMiddle"
	self assert: self moreThan4Elements middle = (self moreThan4Elements at: self moreThan4Elements size // 2 + 1)! !

!LinkedListTest methodsFor: 'tests - element accessing' stamp: ''!
testAt
	"self debug: #testAt"
	"
	self assert: (self accessCollection at: 1) = 1.
	self assert: (self accessCollection at: 2) = 2.
	"
	| index |
	index := self moreThan4Elements indexOf: self elementInForElementAccessing.
	self assert: (self moreThan4Elements at: index) = self elementInForElementAccessing! !

!LinkedListTest methodsFor: 'requirements' stamp: 'delaunay 4/23/2009 14:09'!
nonEmptyMoreThan1Element
" return a collection that don't includes equl elements'" 
	^collectionWithoutNil ! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testDetectIfNone

	| res element |
	res := self collectionWithoutNilElements  detect: [:each | each notNil not] ifNone: [100].
	self assert: res  = 100.
	
	element := self collectionWithoutNilElements anyOne.
	res := self collectionWithoutNilElements  detect: [:each | each = element] ifNone: [100].
	self assert: res  = element.

	
	! !

!LinkedListTest methodsFor: 'tests - iterating' stamp: ''!
testRejectAllThenCollect
	| result |
	
	result := self collectionWithoutNilElements 
		reject: [ :each | each notNil ] 
		thenCollect: [ :each| self fail ].
	
	self assert: result isEmpty! !

!LinkedListTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterOne

	| delim oneItemStream result |
	"delim := ', '.
	oneItemStream := '' readWrite.
	self oneItemCol asStringOn: oneItemStream delimiter: delim.
	self assert: oneItemStream contents = '1'."
	
	delim := ', '.
	result:=''.
	oneItemStream := ReadWriteStream on: result.
	self nonEmpty1Element  asStringOn: oneItemStream delimiter: delim.
	oneItemStream do:[:each | self assert: each = (self nonEmpty1Element first asString)].
	

	! !

!LinkedListTest methodsFor: 'accessing' stamp: 'md 10/14/2004 10:46'!
nextLink
	^nextLink! !

!LinkedListTest methodsFor: 'tests - copying with replacement' stamp: ''!
firstIndexesOf: aSubCollection in: collection
" return an OrderedCollection with the first indexes of the occurrences of subCollection in  collection "
	| tmp result currentIndex |
	tmp:= collection.
	result:= OrderedCollection new.
	currentIndex := 1.
	
	[tmp isEmpty ]whileFalse:
		[
		(tmp beginsWith: aSubCollection)
			ifTrue: [ 	
				result add: currentIndex.
				1 to: aSubCollection size do: 
					[:i | 
					tmp := tmp copyWithoutFirst.
					currentIndex := currentIndex + 1]
				]
			ifFalse: [
				tmp := tmp copyWithoutFirst.
				currentIndex := currentIndex +1.
				]
		 ].
	
	^ result.
	! !

!LinkedListTest methodsFor: 'tests - index access' stamp: ''!
testLastIndexOfIfAbsent
	"self debug: #testIndexOfIfAbsent"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			lastIndexOf: element
			ifAbsent: [ 99 ]) = 1.
	self assert: (collection 
			lastIndexOf: self elementNotInForIndexAccessing
			ifAbsent: [ 99 ]) = 99! !

!LinkedListTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithCollectError
	self should: [self nonEmptyMoreThan1Element with: self empty collect:[:a :b | ]] raise: Error.! !

!LinkedListTest methodsFor: 'tests - index access' stamp: ''!
testLastIndexOfStartingAt
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection last.
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size
			ifAbsent: [ 99 ]) = collection size.
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size - 1
			ifAbsent: [ 99 ]) = 99.
	self assert: (collection 
			lastIndexOf: self elementNotInForIndexAccessing
			startingAt: collection size
			ifAbsent: [ 99 ]) = 99! !

!ListComposableModelTest commentStamp: '<historical>'!
testing ListComposableModel!
!ListComposableModelTest methodsFor: 'tests' stamp: 'BenjaminVanRyseghem 9/25/2013 18:24'!
testWhenListChangedOldContents
	"access to old and new contents in whenListChanged."

	| list oldL newL ok |
	list := ListModel new.
	oldL := #(1 2).
	newL := #(1 2 3).
	list items: oldL.
	list
		whenListChanged: [ :aList :anOldList | 
			self assert: oldL = anOldList.
			self assert: newL = aList ].
	list listItems.	"Call listItems to set the cache"
	list items: #(1 2 3)! !

!ListComposableModelTest methodsFor: 'tests' stamp: 'BenjaminVanRyseghem 9/25/2013 18:24'!
testWhenListChanged
	"Two stages list changed notification."

	50
		timesRepeat: [ 
			| list ok |
			list := ListModel new.
			list items: #(1 2).
			list whenListChanged: [ :aList | ok := aList = list listItems ].
			list listItems.	"Call listItems to set the cache"
			list items: #(1 2 3).
			self assert: ok ]! !

!ListDialogWindow commentStamp: '<historical>'!
A ListDialogWindow is a dialog window used to search an element into a list.
A text field is provided to on the fly reduce the field or search!
!ListDialogWindow methodsFor: 'morphic protocol' stamp: 'AlainPlantec 7/9/2013 11:19'!
updateList
	"update the displayed list in a separate thread to avoid UI blocking"
	
	"if there is already a background thread running for the new list discard it"
	listCreationProcess ifNotNil: [
		listCreationProcess terminate].
	
	"no pattern given => empty list"
	pattern ifNil: [ ^ list :=#() ].
	
	"fork off a possibly costly list calculation"
	listCreationProcess := [
		list := listBlock value: pattern.
		"make sure the ui is updated in a synchronized manner"
		self defer: [self listChanged]] fork.! !

!ListDialogWindow methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/10/2013 16:52'!
acceptNewEntry

	^ acceptNewEntry! !

!ListDialogWindow methodsFor: 'accessing' stamp: 'CamilloBruni 9/16/2013 00:48'!
answer
	^ answer! !

!ListDialogWindow methodsFor: 'actions' stamp: 'JurajKubelka 11/11/2013 15:41'!
ok

	(acceptNewEntry and: [ list isEmpty ]) ifTrue: [ 
		self answer: self searchString ].
	
	self answer ifNil: [ self searchAccept: self searchString ].
	
	self 
		cancelled: false;
		delete! !

!ListDialogWindow methodsFor: 'button behavior' stamp: 'BenjaminVanRyseghem 6/26/2012 23:02'!
browseBlock

	^ browseBlock! !

!ListDialogWindow methodsFor: 'actions' stamp: 'IgorStasenko 12/20/2012 14:56'!
newContentMorph
	| panel  |
	panel := PanelMorph new.
	panel layoutPolicy: ProportionalLayout new;
		layoutInset: 0;
		hResizing: #spaceFill;
		vResizing: #spaceFill.					
	panel addMorph: self buildListMorph
			fullFrame: (LayoutFrame identity bottomOffset: -33).
	panel addMorph: self buildSearchMorph
			fullFrame: ((0@1 corner: 1@1) asLayoutFrame topOffset: -30).
	^ panel! !

!ListDialogWindow methodsFor: 'actions' stamp: 'BenjaminVanRyseghem 6/26/2012 23:01'!
cancel

	self answer: nil.
	super cancel! !

!ListDialogWindow methodsFor: 'events' stamp: 'MarcusDenker 7/9/2014 21:38'!
searchKeystroke: event
	
	searchMorph content ifNil: [ ^ false ].
	
	(event keyCharacter = Character arrowDown )
		ifTrue: [ ^ self searchKeystrokeDown ].
		
	(event keyCharacter = Character arrowUp)
		ifTrue: [ ^ self searchKeystrokeUp ].
	! !

!ListDialogWindow methodsFor: 'protocol' stamp: 'ChristopheDemarey 8/29/2013 13:15'!
initialFilter: aString
	searchMorph content: aString.! !

!ListDialogWindow methodsFor: 'item creation' stamp: 'BenjaminVanRyseghem 6/26/2012 23:01'!
buildBrowseButton

	^ (PluggableButtonMorph
		on: self
		getState: #state
		action: #browseAction)
		label: 'Browse';
		yourself! !

!ListDialogWindow methodsFor: 'events' stamp: 'CamilloBruni 8/15/2011 22:47'!
listKeystroke: event
	event keyCharacter = Character arrowUp 
		ifTrue: [ ^ self listKeystrokeUp ].
		
	event keyCharacter = Character arrowDown 
		ifTrue: [ ^ self listKeystrokeDown ].! !

!ListDialogWindow methodsFor: 'open/close' stamp: 'BenjaminVanRyseghem 9/8/2013 16:23'!
initialAnswer: aString

	searchMorph content: aString.! !

!ListDialogWindow methodsFor: 'actions' stamp: 'SvenVanCaekenberghe 2/1/2014 20:25'!
doubleClickOk
	self listIndex ~= 0
		ifTrue: [ self ok ]! !

!ListDialogWindow methodsFor: 'display' stamp: 'BenjaminVanRyseghem 6/26/2012 22:56'!
displayItem: anItem

	^ self displayBlock cull: anItem cull: self! !

!ListDialogWindow methodsFor: 'events' stamp: 'BenjaminVanRyseghem 6/26/2012 22:34'!
listKeystrokeUp
	listIndex = 1 
		ifTrue: [ 
			self listIndex: 0.
			self giveFocusToSearch.
			^ true].
	^ false.! !

!ListDialogWindow methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 9/10/2013 16:50'!
initialize

	list := #().
	listIndex := 0.
	isResizeable := true.
	listBlock := [ :regex| #() ].
	displayBlock := [:e | e printString ].
	browseBlock :=  [:tmp | tmp browse ].
	pattern := '.' asRegexIgnoringCase.
	acceptNewEntry := false.
	
	super initialize.
! !

!ListDialogWindow methodsFor: 'protocol' stamp: 'CamilloBruni 9/16/2013 01:07'!
accept: anItem
	self answer: anItem.
	self ok.! !

!ListDialogWindow methodsFor: 'private' stamp: 'CamilloBruni 8/11/2011 05:55'!
no
	"overwrite de default"! !

!ListDialogWindow methodsFor: 'morphic protocol' stamp: 'CamilloBruni 8/11/2011 14:50'!
listIndex: aNumber
	listIndex := aNumber.
	self answer: (list at: listIndex ifAbsent: [ nil ]).
	self changed: #listIndex.! !

!ListDialogWindow methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/28/2012 15:50'!
getList: aSymbolOrBlockWithOneArgument
	aSymbolOrBlockWithOneArgument isBlock
		ifTrue: [ listBlock := aSymbolOrBlockWithOneArgument. ^ self updateList ].
	aSymbolOrBlockWithOneArgument isSymbol 
		ifTrue: [ 
			listBlock := [ :regex| model perform: aSymbolOrBlockWithOneArgument with: regex].
			^ self updateList].
	Error signal: 'invalid argument'.! !

!ListDialogWindow methodsFor: 'actions' stamp: 'BenjaminVanRyseghem 6/26/2012 23:01'!
newButtons
	"Answer new buttons as appropriate."

	^{self newOKButton isDefault: true. self buildBrowseButton. self newCancelButton}! !

!ListDialogWindow methodsFor: 'morphic protocol' stamp: 'CamilloBruni 8/11/2011 05:32'!
list
	^ list! !

!ListDialogWindow methodsFor: 'instance creation' stamp: 'ChristopheDemarey 11/27/2013 15:35'!
chooseFromOwner: aMorph

	aMorph openModal: self.
	^ self answer! !

!ListDialogWindow methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/18/2012 18:12'!
answer: anObject
	answer := anObject! !

!ListDialogWindow methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/10/2013 16:52'!
acceptNewEntry: aBoolean

	acceptNewEntry := aBoolean! !

!ListDialogWindow methodsFor: 'open/close' stamp: 'CamilloBruni 8/11/2011 03:30'!
initialExtent
	^ 300 @ 400! !

!ListDialogWindow methodsFor: 'accessing' stamp: 'CamilloBruni 9/16/2013 01:07'!
searchString
	^ searchMorph searchString! !

!ListDialogWindow methodsFor: 'private' stamp: 'CamilloBruni 8/11/2011 05:55'!
yes
	"overwrite de default"! !

!ListDialogWindow methodsFor: 'button behavior' stamp: 'GabrielOmarCotelli 11/30/2013 17:01'!
browseAction
	| aString tmp block |
	aString := searchMorph content.
	list detect: [ :item | (self displayItem: item) = aString ] ifFound: [ :item | self accept: item ].
	tmp := answer.
	block := self browseBlock.
	[ block value: tmp ] fork.
	self cancel! !

!ListDialogWindow methodsFor: 'items creation' stamp: 'CamilloBruni 8/11/2011 06:47'!
buildSearchMorph
	^ searchMorph := SearchMorph new
			model: self;
			acceptSelector: #searchAccept:;
			updateSelector: #searchUpdate:;
			searchList: self class searchList;
			keystrokeSelector: #searchKeystroke:
			yourself.	
	! !

!ListDialogWindow methodsFor: 'morphic protocol' stamp: 'BenjaminVanRyseghem 6/28/2012 15:49'!
searchUpdate: aString

	pattern := '.' asRegexIgnoringCase.
	
	aString isEmptyOrNil ifFalse: [
		pattern := [aString asRegexIgnoringCase] on: RegexSyntaxError do: [ aString ]].
	
	self updateList.! !

!ListDialogWindow methodsFor: 'morphic protocol' stamp: 'NicolaiHess 2/22/2014 00:53'!
searchAccept: aString
	self searchUpdate: aString.
	list detect: [ :item | (self displayItem: item) = aString ] ifFound: [ :item | ^ self accept: item ].
	acceptNewEntry
		ifTrue: [ ^ self accept: aString ]
		ifFalse: [ 
			list size = 1
				ifTrue: [ ^ self accept: list first ] ].
	list ifNotEmpty: [ ^ self giveFocusToList ]! !

!ListDialogWindow methodsFor: 'morphic protocol' stamp: 'CamilloBruni 8/11/2011 08:02'!
listIndex
	^ listIndex ! !

!ListDialogWindow methodsFor: 'events' stamp: 'BenjaminVanRyseghem 6/26/2012 22:34'!
listKeystrokeDown
	listIndex = list size
		ifTrue: [ 
			self listIndex: 0.
			self giveFocusToSearch.
			^ true].
	^ false.! !

!ListDialogWindow methodsFor: 'focus handling' stamp: 'BenjaminVanRyseghem 6/26/2012 22:34'!
giveFocusToSearch
	searchMorph takeKeyboardFocus.! !

!ListDialogWindow methodsFor: 'display' stamp: 'BenjaminVanRyseghem 6/26/2012 22:55'!
displayBlock: aBlock

	displayBlock := aBlock! !

!ListDialogWindow methodsFor: 'focus handling' stamp: 'BenjaminVanRyseghem 6/26/2012 22:34'!
giveFocusToList
	list ifEmpty: [ ^ self giveFocusToSearch].
	
	self listIndex: (( listIndex max: 1 ) min: list size).
	listMorph takeKeyboardFocus.! !

!ListDialogWindow methodsFor: 'events' stamp: 'BenjaminVanRyseghem 6/26/2012 22:34'!
searchKeystrokeDown
	|interval|
	interval := searchMorph selectionInterval .
	((interval last == searchMorph content size)
	and: [ interval last < interval first ])
		ifFalse: [ ^ false ].
		
	self giveFocusToList.
	^ true! !

!ListDialogWindow methodsFor: 'items creation' stamp: 'SvenVanCaekenberghe 2/1/2014 20:25'!
buildListMorph
	^ listMorph := PluggableListMorph new
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		on: self
			list: #list
			selected: #listIndex
			changeSelected: #listIndex:
			menu: nil
			keystroke: nil;
		keystrokeSelector: #listKeystroke:;
		doubleClickSelector: #doubleClickOk;
		wrapSelector: #displayItem:;
		yourself! !

!ListDialogWindow methodsFor: 'events' stamp: 'BenjaminVanRyseghem 6/26/2012 22:34'!
searchKeystrokeUp
	(searchMorph selectionInterval last == 0)
		ifFalse: [ ^ false ].
		
	self listIndex: list size.
	self giveFocusToList.
	^ true! !

!ListDialogWindow methodsFor: 'button behavior' stamp: 'BenjaminVanRyseghem 6/26/2012 23:01'!
state

	^ false! !

!ListDialogWindow methodsFor: 'display' stamp: 'BenjaminVanRyseghem 6/26/2012 22:55'!
displayBlock

	^ displayBlock! !

!ListDialogWindow methodsFor: 'focus handling' stamp: 'CamilloBruni 8/11/2011 06:13'!
defaultFocusMorph

	^ searchMorph! !

!ListDialogWindow methodsFor: 'morphic protocol' stamp: 'CamilloBruni 8/11/2011 05:34'!
listChanged
	self changed: #list.! !

!ListDialogWindow methodsFor: 'button behavior' stamp: 'BenjaminVanRyseghem 6/26/2012 23:02'!
browseBlock: aBlock

	browseBlock := aBlock! !

!ListDialogWindow class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 6/26/2012 23:40'!
chooseFromOwner: aMorph

	^ self new chooseFromOwner: aMorph! !

!ListDialogWindow class methodsFor: 'accessing' stamp: 'CamilloBruni 8/11/2011 05:34'!
searchList
	^ searchList ifNil: [ searchList := OrderedCollection new ]! !

!ListItemWrapper commentStamp: '<historical>'!
Contributed by Bob Arning as part of the ObjectExplorer package.
!
!ListItemWrapper methodsFor: 'accessing' stamp: 'EstebanLorenzano 4/29/2014 14:39'!
highlightingColor
	^ self theme selectionColor! !

!ListItemWrapper methodsFor: 'accessing' stamp: 'dgd 9/26/2004 18:22'!
icon
	"Answer a form to be used as icon"
	^ nil! !

!ListItemWrapper methodsFor: 'testing' stamp: 'GabrielOmarCotelli 11/30/2013 16:42'!
hasEquivalentIn: aCollection
	^ aCollection anySatisfy: [ :each | each withoutListWrapper = item withoutListWrapper ]! !

!ListItemWrapper methodsFor: 'dropping/grabbing' stamp: 'RAA 3/30/1999 18:13'!
acceptDroppingObject: anotherItem

	^item acceptDroppingObject: anotherItem! !

!ListItemWrapper methodsFor: 'converting' stamp: 'RAA 3/31/1999 12:13'!
withoutListWrapper

	^item withoutListWrapper! !

!ListItemWrapper methodsFor: 'dropping/grabbing' stamp: 'RAA 4/4/1999 17:58'!
sendSettingMessageTo: aModel

	aModel 
		perform: (self settingSelector ifNil: [^self])
		with: self withoutListWrapper
! !

!ListItemWrapper methodsFor: 'accessing' stamp: 'MarcusDenker 2/19/2010 17:32'!
item: newItem
	item := newItem! !

!ListItemWrapper methodsFor: 'testing' stamp: 'RAA 3/31/1999 16:24'!
handlesMouseOver: evt

	^false! !

!ListItemWrapper methodsFor: 'accessing' stamp: 'RAA 3/31/1999 21:31'!
settingSelector

	^nil! !

!ListItemWrapper methodsFor: 'accessing' stamp: 'RAA 3/30/1999 18:27'!
setItem: anObject

	item := anObject! !

!ListItemWrapper methodsFor: 'accessing' stamp: 'RAA 7/21/2000 10:59'!
balloonText

	^nil! !

!ListItemWrapper methodsFor: 'accessing' stamp: 'gvc 10/26/2006 11:11'!
model
	"Answer the model. It is useful!!"
	
	^model! !

!ListItemWrapper methodsFor: 'accessing' stamp: 'gvc 8/23/2006 15:53'!
item
	"Answer the item. It is useful!!"
	
	^item! !

!ListItemWrapper methodsFor: 'testing' stamp: 'RAA 3/31/1999 12:25'!
canBeDragged

	^true! !

!ListItemWrapper methodsFor: 'testing' stamp: 'RAA 3/31/1999 16:32'!
wantsDroppedObject: anotherItem

	^false! !

!ListItemWrapper methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/3/2013 10:59'!
setItemFromBlock: aBlock

	self setItem: aBlock value! !

!ListItemWrapper methodsFor: 'accessing' stamp: 'RAA 3/31/1999 16:44'!
setItem: anObject model: aModel

	item := anObject.
	model := aModel.! !

!ListItemWrapper methodsFor: 'accessing' stamp: 'RAA 4/1/1999 20:09'!
hasContents

	^self contents isEmpty not! !

!ListItemWrapper methodsFor: 'accessing' stamp: 'AlainPlantec 12/16/2009 21:59'!
preferredColor
	^ nil! !

!ListItemWrapper methodsFor: 'accessing' stamp: 'RAA 3/31/1999 16:32'!
contents

	^Array new! !

!ListItemWrapper methodsFor: 'converting' stamp: 'RAA 3/30/1999 18:17'!
asString

	^item asString! !

!ListItemWrapper class methodsFor: 'as yet unclassified' stamp: 'RAA 3/31/1999 16:44'!
with: anObject model: aModel

	^self new setItem: anObject model: aModel! !

!ListItemWrapper class methodsFor: 'as yet unclassified' stamp: 'RAA 3/30/1999 18:28'!
with: anObject

	^self new setItem: anObject! !

!ListModel commentStamp: 'StephaneDucasse 3/3/2015 21:16'!
A ListComposableModel is an applicative model which handle a basic list.

| t |
t := ListModel new.
t openWithSpec.
t items: (Smalltalk allClasses).

self example

| t |
t := ListModel new.
t openWithSpec.
t sortingBlock: [:a :b| a name > b name].
t items: (Smalltalk allClasses).


| t |
t := ListModel new.
t openWithSpec.
t filteringBlock: [:col | col select: [:each | each name beginsWith: 'Zn']].
t sortingBlock: [:a :b| a name > b name].
t items: (Smalltalk allClasses).
!
!ListModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/25/2013 18:28'!
listElementAt: anIndex
	"Return the item at index _anIndex_"
	
	^ self listItems at: anIndex ifAbsent: [ nil ]! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:05'!
resetSelection
	"<api: #do>"
	"Unselect every items"

	selectionHolder reset.
	multiSelectionHolder removeAll! !

!ListModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:33'!
whenAllowToSelectChanged: aBlock
	"Set a block to value when the value of allowToSelect has changed"
	
	allowToSelect whenChangedDo: aBlock! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:23'!
backgroundColorBlock: aBlock
	"<api: #block getter: #backgroundColorBlock registration: #whenBackgroundColorBlockChanged:>"
	"Set the block used to compute an item background"

	backgroundColorBlock value: aBlock! !

!ListModel methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 1/10/2014 09:52'!
registerEvents

	listHolder whenChangedDo: [ self refreshListItems ].
	filteringBlockHolder whenChangedDo: [ self refreshListItems ].
	selectionHolder index whenChangedDo: [ self changed: #getIndex ].
	multiSelection whenChangedDo: [ :b | self changed: { #setMultipleSelection: . b } ].
	wrapBlockHolder whenChangedDo:[ self changed: #listElementAt: ].
	backgroundColorBlock whenChangedDo: [ self refreshListItems ].
	autoDeselect whenChangedDo: [ :boolean | self changed: #autoDeselect: with: { boolean }].
	sortingBlockHolder
		whenChangedDo: [ 
			listHolder value: (listHolder value sorted: sortingBlockHolder value).
			self changed: #listElementAt: ].
! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:52'!
setSelectedIndex: anIndex
	"<api: #integer min: 0 max: #listSize getter: #selectedIndex registration: #whenSelectionIndexChanged:>"
	"Set the index of the item you want to be selected"
	| idx selection |
	
	self allowToSelect ifFalse: [ ^ self ].
	self okToChange ifFalse: [ ^ self ].
	
	idx := anIndex min: self listSize.
	selection := self 
					listElementAt: idx 
					ifAbsent: [ idx := 0.
								nil ].

	selectionHolder index value: idx.
	selectionHolder selection value: selection.! !

!ListModel methodsFor: 'api-events' stamp: 'johanfabry 3/11/2015 16:01'!
whenSelectionChanged: aBlock
	"Set a block to value when the selection of the list has changed"

	"The method should be used only if you are interested in the fact that there was a change, without caring about what has changed
	If you are interested in the items, use whenSelectedItemChanged:
	If you are interested in the index, use whenSelectionIndexChanged:"

	selectionHolder whenChangedDo: aBlock.
	multiSelectionHolder whenChangedDo: aBlock.! !

!ListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 1/6/2014 16:05'!
backgroundColorFor: anItem at: index

	^ self backgroundColorBlock cull: anItem cull: index! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:50'!
autoDeselect: aBoolean
	"<api: #boolean getter: #autoDeselect registration: #whenAutoSelectChanged:>"
	"Set if the list items can be selected again"

	autoDeselect value: aBoolean! !

!ListModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:33'!
whenMultiSelectionChanged: aBlock
	"Set a block to value when the multiSelection value has changed"
	
	multiSelection whenChangedDo: aBlock! !

!ListModel methodsFor: 'initialization' stamp: 'DucasseStephane 9/10/2014 09:59'!
initialize
	super initialize.
	
	selectionHolder := Object selectionReactiveVariable.
	listHolder := Array new asValueHolder.
	sortingBlockHolder := self defaultSortingBlock asValueHolder.
	filteringBlockHolder := self defaultFilteringBlock asValueHolder.
	wrapBlockHolder := [ :object | object asStringOrText ] asValueHolder.
	menuHolder := [ :menu :shifted | nil ] asValueHolder.
	multiSelectionHolder := IdentityDictionary new asValueHolder.
	multiSelection := false asValueHolder.
	allowToSelect := true asValueHolder.
	backgroundColorBlock := [ :item :index | Smalltalk ui theme backgroundColor ] asValueHolder.
	autoDeselect := true asValueHolder.
	listAnnouncer := Announcer new.
	self registerEvents.

	self
		bindKeyCombination: Character space
		toAction: [ self clickOnSelectedItem ]! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:15'!
allowToSelect
	"<api: #inspect>"
	"Return whether the list items can be selected or not"

	^ allowToSelect value! !

!ListModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
wrapItem: anObject index: index
	"Return the item _anObject_ wrapped"

	^ wrapBlockHolder value cull: anObject cull: index! !

!ListModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 17:03'!
whenListChanged: aBlock
	"Specify a block to value after the contents of the list has changed"
	"Basically when you set a new list of items"
	"<api: #event>"
	| block |
	block := [ :announcement :ann | 
	aBlock
		cull: announcement newValue
		cull: announcement oldValue
		cull: announcement
		cull: ann ].
	
	listAnnouncer
		when: ValueChanged
		do: block! !

!ListModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:33'!
whenSelectedItemChanged: aBlock
	"Set a block to value when the select item is changed"
	
	selectionHolder selection whenChangedDo: aBlock! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:54'!
allowToSelect: aBoolean
	"<api: #boolean getter: #allowToSelect registration: #whenAllowToSelectChanged:>"
	"Set if the list items can be selected or not"

	allowToSelect value: aBoolean.
	aBoolean 
		ifFalse: [ self resetSelection ].! !

!ListModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:33'!
whenAutoDeselectChanged: aBlock
	"Set a block to value when the value of autoDeselect has changed"
	
	autoDeselect whenChangedDo: aBlock! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:03'!
selectedIndex
	"<api: #inspect>"
	"Return the index of the selected item
	In the case of a multiple selection list, it returns the last selected item"

	^ self getIndex! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:18'!
filteringBlock
	"<api: #inspect>"
	"Return the filtering of the items"
	
	^ filteringBlockHolder value! !

!ListModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/25/2013 18:28'!
getSelectionStateFor: anIndex
	"Return the current state of the item -if selected or not - in a multiple selection list"
	"Answer true if the item at index _anIndex_ is selected"
	
	^ (multiSelectionHolder at: anIndex ifAbsent: [ ^ false ]) == true! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:15'!
backgroundColorBlock
	"<api: #inspect>"
	"Return the block use to compute the background color for each item"

	^ backgroundColorBlock value! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:21'!
filteringBlock: aBlock
	"<api: #block getter: #filteringBlock registration: #whenFilteringBlockChanged:>"
	"To set the filtering of the items"
	
	filteringBlockHolder value: aBlock! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:18'!
selectedItems
	"<api: #inspect>"
	"Return all the selected items in the case of a multiple selection list"

	^ multiSelectionHolder keys select: [:index | multiSelectionHolder at: index ] thenCollect: [:index | self listElementAt: index ]! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:57'!
sortingBlock
	"<api: #inspect>"
	"Return the ordering of the items"
	
	^ sortingBlockHolder value! !

!ListModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 10/17/2013 16:07'!
setIndex: anIndex
	"Set the index of the selected item when you click on an item"

	self allowToSelect ifFalse: [ ^ self ].
	self okToChange ifFalse: [ ^ self ].
	selectionHolder index value: anIndex.
	selectionHolder selection value: (self listElementAt: anIndex).! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:52'!
setSelectedItem: anItem
	"<api: #st getter: #selectedItem registration: #whenSelectedItemChanged:>"
	"Set the item you want to be selected"
	| index |

	self okToChange ifFalse: [ ^ self ].
	index := self listItems identityIndexOf: anItem ifAbsent: [ ^ self ].
	selectionHolder index value: index.
	selectionHolder selection value: anItem! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:18'!
resetSortingBlock
	"<api: #do>"
	"Reset the sortering block with the default value which consists in not sorting"

	sortingBlockHolder value: self defaultSortingBlock! !

!ListModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:34'!
whenSortingBlockChanged: aBlock
	"Set a block to value when the sorting block has changed"
	
	sortingBlockHolder whenChangedDo: aBlock! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:13'!
autoDeselect
	"<api: #inspect>"
	"Return whether the list items can be selected if it's already the selected item"
	"If true, clicking again on the selected item will unselect it"

	^ autoDeselect value! !

!ListModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:33'!
whenDisplayBlockChanged: aBlock
	"Set a block to value when the filtering block has changed"
	
	wrapBlockHolder whenChangedDo: aBlock! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:54'!
sortingBlock: aBlock
	"<api: #block getter: #sortingBlock registration: #whenSortingBlockChanged:>"
	"To set the ordering of the items"
	
	sortingBlockHolder value: aBlock! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:47'!
items: aList
	"Set the items of the list.
	aList is a collection of your domain specific items.
	Use a two stages notification (issue 7420)."

	"<api: #st getter: #listItems registration: #whenListChanged:>"
	| oldContents |
	oldContents := listHolder value.
	listHolder value: (aList sorted: sortingBlockHolder value).
	listAnnouncer announce: (ValueChanged oldValue: oldContents newValue: listHolder value)! !

!ListModel methodsFor: 'private' stamp: 'StephaneDucasse 5/17/2012 18:04'!
selectedItemHolder

	^ selectionHolder selection! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:19'!
beSingleSelection
	"<api: #do>"
	"Make list selection single"

	self multiSelection: false! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:49'!
multiSelection: aBoolean
	"<api: #boolean getter: #multiSelection registration: #whenMultiSelectionChanged:>"
	"Make the list seelction become multiple if aBoolean is true.
	Otherwise set the selection as single"
	
	multiSelection value: aBoolean.
	! !

!ListModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 5/7/2012 13:23'!
refreshListItems

	listItemsCache := nil.
	^ self changed: #listElementAt:! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:17'!
updateList
	"<api: #do>"
	"Refresh the list"
	
	self changed: #listElementAt:.
	self resetSelection! !

!ListModel methodsFor: 'initialization' stamp: 'StephaneDucasse 4/17/2012 19:15'!
defaultSortingBlock 
	^ [:a :b | true]! !

!ListModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:33'!
whenFilteringBlockChanged: aBlock
	"Set a block to value when the filtering block block has changed"
	
	filteringBlockHolder whenChangedDo: aBlock! !

!ListModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 2/8/2013 14:23'!
clickOnSelectedItem
	| item |
	
	item := self selectedItem.
	^ (item notNil and: [ item respondsTo: #click ])
		ifTrue: [ ^ item click ]! !

!ListModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:33'!
whenMenuChanged: aBlock
	"Set a block to value when the menu block has changed"
	
	menuHolder whenChangedDo: aBlock! !

!ListModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/25/2013 18:29'!
resetListSelection
	"Reset the selection manager for multiple selection lists"
	
	multiSelectionHolder removeAll! !

!ListModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/25/2013 18:28'!
listElementAt: anIndex ifAbsent: aBlock	
	"Return the item at index _anIndex_"
	
	^ self listItems at: anIndex ifAbsent: aBlock! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:15'!
beMultipleSelection
	"<api: #do>"
	"Make list selection multiple"

	self multiSelection: true! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:19'!
menu: aBlock
	"<api: #block getter: #menu registration: #whenMenuChanged:>"
	"Set the block used to defined the menu"
	
	menuHolder value: aBlock! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:15'!
resetFilteringBlock
	"<api: #do>"
	"Reset the filtering block with the default value which consists in showing everything"

	filteringBlockHolder value: self defaultFilteringBlock! !

!ListModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/25/2013 18:29'!
setSelectionStateFor: anIndex at: aBoolean
	"Set the selection state of the item at index _anIndex_ in the case of multiple selection list"

	self allowToSelect ifFalse: [ ^ self ].
	^ multiSelectionHolder at: anIndex put: aBoolean! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:17'!
selectedItem
	"<api: #inspect>"
	"Return the selected item.
	In the case of a multiple selection list, it returns the last selected item"
	
	^ self selectedItemHolder value! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:02'!
selectedIndexes
	"<api: #inspect>"
	"Return the indexes of selected items on the case of a multiple selection list"
	
	^ multiSelectionHolder keys select: [:index | multiSelectionHolder at: index ]! !

!ListModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
menu: aMenu shifted: aBoolean
	"Build the menu when you right click on an item"

	^ menuHolder value cull: aMenu cull: aBoolean! !

!ListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
getList

	^ listHolder value! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:01'!
menu
	"<api: #inspect>"
	"Return the block used to defined the menu"
	
	^ menuHolder value! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:48'!
displayBlock: aBlock
	"<api: #block getter:#displayBlock registration: #whenDisplayBlockChanged:>"
	"Set the one argument block used to wrap your domain specific items.
	The block should return something that can be displayed in a list - like a String or a Text"
	
	wrapBlockHolder value: aBlock! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:56'!
listItems
	"<api: #inspect>"
	"Return the items of the list. They are your domain specific items"
	
	^ listItemsCache ifNil: [ listItemsCache :=  filteringBlockHolder value value: listHolder value ]
	! !

!ListModel methodsFor: 'initialization' stamp: 'SD 4/19/2012 15:26'!
defaultFilteringBlock 
	^ [:col | col]! !

!ListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
getIndex
	"Return the index of the selected item"
	
	^  selectionHolder index value! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:02'!
listSize
	"<api: #inspect>"
	"Return the size of the list"
	
	^ self listItems size! !

!ListModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:33'!
whenBackgroundColorBlockChanged: aBlock
	"Set a block to value when the backgroundColorBlock has changed"
	
	backgroundColorBlock whenChangedDo: aBlock! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:13'!
displayBlock
	"<api: #inspect>"
	"Return the one argument block used to wrap your domain specific items.
	The block should return something that can be displayed in a list - like a String or a Text"
	
	^ wrapBlockHolder value! !

!ListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:04'!
multiSelection
	"<api: #inspect>"
	"Return true if the list has a multiple selection.
	False if the list has a single selection"
	
	^ multiSelection value! !

!ListModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:34'!
whenSelectionIndexChanged: aBlock
	"Set a block to value when the selection index has changed"
	
	selectionHolder index whenChangedDo: aBlock! !

!ListModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/1/2013 13:38'!
defaultSpec
	<spec: #default>
	
	^ #(ListAdapter
		adapt: #(model))! !

!ListModel class methodsFor: 'example' stamp: 'StephaneDucasse 5/17/2012 18:02'!
example
	| instance |

	instance := self new.
	instance openWithSpec.
	instance items: (Smalltalk allClasses).! !

!ListModel class methodsFor: 'specs' stamp: ''!
title

	^ 'List'! !

!ListModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/13/2014 15:21'!
adapterName

	^ #ListAdapter! !

!ListSelectionModel commentStamp: '<historical>'!
A ListSelectionModel is a basic example to show multi selection on lists

| l |
l := ListSelectionModel new.
l openWithSpec!
!ListSelectionModel methodsFor: 'initialization' stamp: 'CamilloBruni 9/22/2013 21:36'!
initializeWidgets

	listModel := self newList.
	textModel1 := self newText.
	textModel2 := self newText.
	
	listModel beMultipleSelection.
	
	listModel items: Smalltalk allClasses.! !

!ListSelectionModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/9/2012 17:07'!
textModel1

	^ textModel1! !

!ListSelectionModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/9/2012 17:06'!
listModel

	^ listModel! !

!ListSelectionModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/9/2012 17:07'!
textModel2

	^ textModel2! !

!ListSelectionModel methodsFor: 'update' stamp: 'AlainPlantec 7/9/2013 11:19'!
updateText
	"update the displayed list in a separate thread to avoid UI blocking"
	
	"if there is already a background thread running for the new list discard it"
	textRefreshingProcess ifNotNil: [
		textRefreshingProcess terminate].
	
	"fork off a possibly costly list calculation"
	textRefreshingProcess := [
		| indexes items |
		indexes := listModel selectedIndexes sort collect: [:i | i printString ].
		indexes :=  (indexes joinUsing: '; ').
		items := listModel selectedItems collect: [:i | i printString ].
		items := (items sort joinUsing: '; ').
		UIManager default defer: [
			textModel1 text: indexes.
			textModel2 text: items]] fork.! !

!ListSelectionModel methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 6/12/2012 19:27'!
initializePresenter 

	listModel whenSelectionChanged: [ self updateText ]! !

!ListSelectionModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/1/2013 15:10'!
defaultSpec

	^ SpecLayout composed
		newColumn: [ :column |
			column 
				add: #listModel;
				newRow: [ :row |
					row
						add: #textModel1;
						add: #textModel2 ] ];
		yourself! !

!ListSelectionModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/1/2013 15:07'!
bottomSpec

	^ SpecLayout composed
		newRow: [ :row |
			row
				add: #textModel1;
				add: #textModel2 ];
		yourself! !

!LiteralDictionary commentStamp: '<historical>'!
A LiteralDictionary, like an IdentityDictionary, has a special test for equality.  In this case it is simple equality between objects of like class.  This allows equal Float or String literals to be shared without the possibility of erroneously sharing, say, 1 and 1.0!
!LiteralDictionary methodsFor: 'internal' stamp: 'md 10/5/2005 15:43'!
scanFor: anObject
	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
	| element start finish |
	finish := array size.
	start := (anObject hash \\ finish) + 1.

	"Search from (hash mod size) to the end."
	start to: finish do:
		[:index | ((element := array at: index) == nil
					or: [self literalEquality: element key and: anObject])
					ifTrue: [^ index ]].

	"Search from 1 to where we started."
	1 to: start-1 do:
		[:index | ((element := array at: index) == nil
					or: [self literalEquality: element key and: anObject])
					ifTrue: [^ index ]].

	^ 0  "No match AND no empty slot"! !

!LiteralDictionary methodsFor: 'testing' stamp: 'nice 8/28/2008 19:26'!
literalEquality: x and: y
	"Check if two literals should be considered equal and reduced to a single literal.
	Delegate this task to the literal themselves, they are aware of their peculiarities and know how to behave."
	
	^ x literalEqual: y
! !

!LiteralDictionaryTest commentStamp: 'TorstenBergmann 2/20/2014 15:21'!
SUnit tests for literal dictionaries!
!LiteralDictionaryTest methodsFor: 'tests - literal specific behavior' stamp: 'cyrille.delaunay 7/17/2009 11:17'!
testIncludesWithEqualElementFromDifferentClasses

| dict |
dict := self classToBeTested new.

dict at: 1 put: 'element1'.
dict at: #key put: 1.0.

self deny: (dict includesKey: 1.0).
self assert: (dict includes: 1)! !

!LiteralDictionaryTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 6/29/2009 12:57'!
classToBeTested

^ LiteralDictionary! !

!LiteralDictionaryTest methodsFor: 'problems' stamp: 'cyrille.delaunay 7/17/2009 11:17'!
testUnCategorizedMethods
"this test doesn't pass :"
	| categories slips  |
	categories := self categoriesForClass: self targetClass.
	slips := categories select: [:each | each = #'as yet unclassified'].
	self should: [slips isEmpty].	! !

!LiteralDictionaryTest class methodsFor: 'building suites' stamp: 'cyrille.delaunay 6/29/2009 12:58'!
shouldInheritSelectors

^true! !

!LiteralNode commentStamp: '<historical>'!
I am a parse tree leaf representing a literal string or number.!
!LiteralNode methodsFor: 'testing' stamp: ''!
isConstantNumber
	^ key isNumber! !

!LiteralNode methodsFor: 'testing' stamp: ''!
isSpecialConstant
	^ code between: LdTrue and: LdMinus1+3! !

!LiteralNode methodsFor: 'initialize-release' stamp: 'eem 5/14/2008 09:30'!
name: literal key: object index: i type: type
	"For compatibility with Encoder>>name:key:class:type:set:"
	^self key: object index: i type: type! !

!LiteralNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 16:19'!
emitCodeForValue: stack encoder: encoder
	stack push: 1.
	(encoder
		if: code
		isSpecialLiteralForPush:
			[:specialLiteral|
			 encoder genPushSpecialLiteral: specialLiteral])
		ifFalse:
			[encoder genPushLiteral: index]! !

!LiteralNode methodsFor: 'visiting' stamp: 'eem 9/6/2009 12:34'!
accept: aVisitor
	^aVisitor visitLiteralNode: self! !

!LiteralNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 17:03'!
sizeCodeForValue: encoder
	self reserve: encoder.
	(encoder
		if: code
		isSpecialLiteralForPush:
			[:specialLiteral|
			 ^encoder sizePushSpecialLiteral: specialLiteral])
		ifFalse:
			[^encoder sizePushLiteral: index]! !

!LiteralNode methodsFor: 'testing' stamp: 'MarcusDenker 9/20/2013 13:27'!
isLiteralNode

	^ true! !

!LiteralNode methodsFor: 'testing' stamp: ''!
literalValue

	^key! !

!LiteralNode methodsFor: 'printing' stamp: 'ClementBera 7/26/2013 16:48'!
printOn: aStream indent: level

	key isVariableBinding
		ifTrue:
			[key key 
				ifNil:
					[aStream nextPutAll: '###'; nextPutAll: key value soleInstance name]
				ifNotNil:
					[aStream nextPutAll: '##'; nextPutAll: key key]]
		ifFalse:
			[key storeOn: aStream]! !

!LiteralVariable commentStamp: 'MarcusDenker 7/29/2014 16:32'!
I am abstract. Subclasses of me model meta objects for global variables (Class, Global, Pool), called "Literal Variables" in Smalltalk.

I am just a subclass of Association, modeling the binding of the global in either the Smalltalk globals, Undeclared or classPools.


When chaning emit* methods, do not forget to recompile exisiting code:

aGlobal usingMethods do: #recompile 

***NOTE***
When moving binding from Undeclared, we change the class of that binding to either ClassVariable or GlobalVariable.

==> when we use Global subclasses, we will either need to restrict adding variables or add a slow path where we create a new binding and update all users. But this can be done later.!
!LiteralVariable methodsFor: 'code generation' stamp: 'MarcusDenker 3/4/2015 17:53'!
emitStore: aMethodBuilder
	| tempName |
	tempName := Object new.
	aMethodBuilder
		addTemp: tempName;
		storeTemp: tempName;
		popTop;
		pushLiteral: self;
		pushTemp: tempName;
		send: #write:! !

!LiteralVariable methodsFor: 'queries' stamp: 'MarcusDenker 7/13/2014 13:29'!
definingClass
	"The class defining the variable. For Globals, return nil"
	^Smalltalk globals allClasses detect: [ :class | class hasClassVariable: self ] ifNone: [ nil ]! !

!LiteralVariable methodsFor: 'meta-object-protocol' stamp: 'MarcusDenker 7/3/2014 16:13'!
write: anObject
	^self value: anObject! !

!LiteralVariable methodsFor: 'testing' stamp: 'MarcusDenker 7/13/2014 14:53'!
isSpecial
	"I am more than just a backward compatible Global"
	^true! !

!LiteralVariable methodsFor: '*reflectivity' stamp: 'MarcusDenker 7/21/2014 13:21'!
link: aMetaLink
	self subclassResponsibility! !

!LiteralVariable methodsFor: 'queries' stamp: 'MarcusDenker 7/13/2014 13:14'!
usingMethods
	^SystemNavigation new allReferencesTo: self! !

!LiteralVariable methodsFor: '*OpalTools' stamp: 'MarcusDenker 12/3/2014 09:16'!
gtInspectorUsersIn: composite
	<gtInspectorPresentationOrder: 30>
	| users |
	users := self usingMethods.
	composite list 
		title: 'Users';
		display: [ users];
		when: [ users notEmpty ];
		showOnly: 30! !

!LiteralVariable methodsFor: 'converting' stamp: 'MarcusDenker 1/16/2015 18:06'!
asClassVariable	
	^self! !

!LiteralVariable methodsFor: 'accessing' stamp: 'MarcusDenker 7/10/2014 16:40'!
name: aString 
	self key: aString asSymbol! !

!LiteralVariable methodsFor: 'code generation' stamp: 'MarcusDenker 7/3/2014 16:48'!
emitValue: aMethodBuilder
	aMethodBuilder
		pushLiteral: self;
		send: #read! !

!LiteralVariable methodsFor: 'meta-object-protocol' stamp: 'MarcusDenker 7/3/2014 16:13'!
read
	^self value! !

!LiteralVariable methodsFor: 'testing' stamp: 'MarcusDenker 7/18/2014 10:03'!
isGlobalVariable
	^false! !

!LiteralVariable methodsFor: '*reflectivity' stamp: 'MarcusDenker 7/21/2014 16:44'!
asWrapperFor: aLink
	^LinkWrapperGlobal new
		key: self key;
		value: self value;
		setLink: aLink;
		wrappedVariable: self.! !

!LiteralVariable methodsFor: 'printing' stamp: 'MarcusDenker 1/7/2015 10:41'!
definitionString
	^String streamContents: [:aStream | aStream << '#' << self name << ' => '; << self class name].! !

!LiteralVariable methodsFor: 'testing' stamp: 'MarcusDenker 7/18/2014 10:03'!
isClassVariable
	^false! !

!LiteralVariable methodsFor: 'testing' stamp: 'MarcusDenker 7/17/2014 17:03'!
isSelfEvaluating
	^ self key isSelfEvaluating and: [self value isSelfEvaluating]! !

!LiteralVariable class methodsFor: 'validating' stamp: 'MarcusDenker 7/11/2014 18:40'!
checkValidName: aString 
	"aString first canBeGlobalVarInitial
		ifFalse: [InvalidGlobalName signal: 'Class name does not start with a valid Global Var Initial' for: aString]"! !

!LiteralVariable class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 17:20'!
gtExampleUniqueLiteralVariable
	<gtExample>
	^ self named: #thisLiteralVariableNameIsProbablyNotTakenYet! !

!LiteralVariable class methodsFor: 'instance creation' stamp: 'MarcusDenker 7/10/2014 16:41'!
named: aSymbol 
	self checkValidName: aSymbol.
	^ self new
		name: aSymbol;
		yourself! !

!LiteralVariableNode commentStamp: 'TorstenBergmann 1/31/2014 11:19'!
I am a parse tree leaf representing a literal variable.!
!LiteralVariableNode methodsFor: 'code generation' stamp: 'eem 5/15/2008 10:43'!
emitCodeForStore: stack encoder: encoder
	writeNode ifNil: [^encoder genStoreLiteralVar: index].
	"THIS IS WRONG!!!! THE VALUE IS LOST FROM THE STACK!!!!
	 The various value: methods on Association ReadOnlyVariableBinding
	 etc _do not_ return the value assigned; they return the receiver."
	"Should generate something more like
		push expr
		push lit
		push temp (index of expr)
		send value:
		pop
	or use e.g. valueForStore:"
	self flag: #bogus.
	writeNode
		emitCode: stack
		args: 1
		encoder: encoder
		super: false! !

!LiteralVariableNode methodsFor: 'code generation' stamp: 'FirstnameLastname 12/11/2009 13:22'!
sizeCodeForStorePop: encoder
	self reserve: encoder.
	^encoder sizeStorePopLiteralVar: index! !

!LiteralVariableNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 18:11'!
emitCodeForValue: stack encoder: encoder
	stack push: 1.
	^encoder genPushLiteralVar: index! !

!LiteralVariableNode methodsFor: 'visiting' stamp: 'eem 9/6/2009 12:34'!
accept: aVisitor
	^aVisitor visitLiteralVariableNode: self! !

!LiteralVariableNode methodsFor: 'code generation' stamp: 'FirstnameLastname 12/11/2009 13:21'!
sizeCodeForStore: encoder
	self reserve: encoder.
	^encoder sizeStoreLiteralVar: index
	! !

!LiteralVariableNode methodsFor: 'code generation' stamp: 'eem 5/15/2008 10:09'!
emitCodeForStorePop: stack encoder: encoder
	writeNode ifNil:
		[stack pop: 1.
		 ^encoder genStorePopLiteralVar: index].
	self emitCodeForStore: stack encoder: encoder.
	encoder genPop.
	stack pop: 1.! !

!LiteralVariableNode methodsFor: 'code generation' stamp: 'nice 4/11/2011 15:15'!
sizeCodeForLoad: encoder
	self reserve: encoder.
	^writeNode ifNil: [0] ifNotNil: [encoder sizePushLiteral: index]! !

!LiteralVariableNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 17:03'!
sizeCodeForValue: encoder
	self reserve: encoder.
	^encoder sizePushLiteralVar: index! !

!LiteralVariableNode methodsFor: 'code generation' stamp: 'eem 5/15/2008 09:44'!
emitCodeForLoad: stack encoder: encoder
	writeNode ifNotNil:
		[encoder genPushLiteral: index.
		 stack push: 1]! !

!LoadUpdatesCommandLineHandler commentStamp: '<historical>'!
Usage: update [ --force ] [ --from-file=<updateFile> ]
	--force        Continue loading updates with errors
	--from-file    Use a local <updateFile> instead of http://updates.pharo.org
	<updateFile>   An update file containing a cr-separated list of urls to .cs files
	
Documentation:
	The update the image to the latest version.

Usage:
	pharo Pharo.image update
	pharo Pharo.image update --from-file=udpates.list!
!LoadUpdatesCommandLineHandler methodsFor: 'actions' stamp: 'CamilloBruni 1/14/2013 16:12'!
loadUpdatesFromFile
	^ self loadUpdatesFromFile: (self optionAt: 'from-file') asFileReference ! !

!LoadUpdatesCommandLineHandler methodsFor: 'actions' stamp: 'CamilloBruni 10/26/2013 21:52'!
loadUpdates
	[ 
		(self hasOption: 'from-file')
			ifTrue:  [ self loadUpdatesFromFile ]
			ifFalse: [ self loadUpdates ].
	] on: UpdateFileNotLoaded do: [ 
		self shouldForce
			ifFalse: [ self exitFailure ]]! !

!LoadUpdatesCommandLineHandler methodsFor: 'actions' stamp: 'MarcusDenker 1/2/2014 10:38'!
loadUpdatesFromFile: updatesFile
	updatesFile exists
		ifFalse: [ ^ self exitFailure: (updatesFile fullName, ' does not exist!!') ].
	
	UpdateStreamer new updateFromFile: updatesFile.
! !

!LoadUpdatesCommandLineHandler methodsFor: 'testing' stamp: 'CamilloBruni 10/26/2013 21:36'!
shouldForce
	^ self hasOption: 'force'! !

!LoadUpdatesCommandLineHandler methodsFor: 'activation' stamp: 'CamilloBruni 10/26/2013 21:30'!
activate
	self activateHelp
		ifTrue: [  ^ self ].

	self loadUpdates.

	Smalltalk snapshot: true andQuit: true.! !

!LoadUpdatesCommandLineHandler methodsFor: 'actions' stamp: 'MarcusDenker 1/2/2014 10:38'!
loadDefaultUpdates
	UpdateStreamer new updateFromServer.! !

!LoadUpdatesCommandLineHandler class methodsFor: 'accessing' stamp: 'CamilloBruni 2/6/2013 18:16'!
description
	^ 'Load updates'! !

!LoadUpdatesCommandLineHandler class methodsFor: 'accessing' stamp: 'MarcusDenker 11/7/2012 13:57'!
commandName
	^ 'update'! !

!Loader commentStamp: 'LaurentLaffont 3/4/2011 22:44'!
I'm an abstract class which collect some infos about package and system (versions, dirty).
#currentChangedPackages instance method and #currentMajorVersionNumber class are missing and provided by my wellknown subclass ScriptLoader (see ScriptLoader comment).


Stef: This is a class that was extracted from scriptLoader because I want to slowly get in place a loader infrastructure based on Metacello.!
!Loader methodsFor: 'private' stamp: 'StephaneDucasse 9/10/2010 17:51'!
markPackagesBeforeNewCodeIsLoaded
	"Use this method to keep a log of all the packages that were loaded before loading new code. This will help the system to perform a diff and know after what to publish."
	
	"self new markPackagesBeforeNewCodeIsLoaded"
	
	PackagesBeforeLastLoad := self currentVersionsToBeSaved! !

!Loader methodsFor: 'initialization' stamp: 'StephaneDucasse 9/10/2010 17:49'!
initialize
	super initialize.
	PackagesBeforeLastLoad ifNil: [ PackagesBeforeLastLoad := Set new ]! !

!Loader methodsFor: 'private' stamp: 'EstebanLorenzano 8/26/2014 16:57'!
packagesNotToSavePatternNames
	^ { self theScriptLoaderPackageName, '.*'.
		'SLICE.*'.
		'Slice.*'.
		'slice.*'.
		}! !

!Loader methodsFor: 'elementary steps' stamp: 'StephaneDucasse 9/10/2010 17:51'!
diffPackages
	"return a list of packages that are new. They can be dirty or not."
	"self new diffPackages"
	 
	| diff |
	diff := Set new.
	self currentVersionsToBeSaved do: [:each |
		(PackagesBeforeLastLoad includes: each) ifFalse: [diff add: each]].
	^ diff
	! !

!Loader methodsFor: 'accessing' stamp: 'StephaneDucasse 9/10/2010 17:34'!
currentMajorVersionNumberWithoutDot
	"self new currentMajorVersionNumberWithoutDot"
	^ self class currentMajorVersionNumber asString copyWithout: $.! !

!Loader methodsFor: 'compute' stamp: 'EstebanLorenzano 8/25/2014 16:21'!
currentVersionsToBeSaved
	"self new currentVersionsToBeSaved"
	
	^ self allCurrentVersions reject: [ :each |
		self packagesNotToSavePatternNames
			anySatisfy: [ :p | each matchesRegex: p ] ]! !

!Loader methodsFor: 'compute' stamp: 'StephaneDucasse 9/10/2010 17:51'!
currentChangedPackages
	"self new currentChangedPackages" 
	
	^  self currentPackages select: [:each |
		each needsSaving or: [
			(PackagesBeforeLastLoad includes: each ancestry ancestorString) not ] ]! !

!Loader methodsFor: 'private' stamp: 'StephaneDucasse 9/10/2010 17:51'!
resetPackagesBeforeLastLoad
	PackagesBeforeLastLoad := Set new! !

!Loader methodsFor: 'accessing' stamp: 'StephaneDucasse 9/10/2010 17:34'!
currentMajorVersionNumber

	^ self class currentMajorVersionNumber ! !

!Loader methodsFor: 'private' stamp: 'EstebanLorenzano 8/25/2014 13:43'!
theScriptLoaderPackageName
	^ 'ScriptLoader',  self currentMajorVersionNumberWithoutDot ! !

!Loader methodsFor: 'mc related utils' stamp: 'StephaneDucasse 9/10/2010 17:41'!
allCurrentVersions
	"self new allCurrentVersions"
	
	| copies names |
	copies := MCWorkingCopy allManagers asSortedCollection:
		[ :a :b | a package name <= b package name ].
	names := copies collect:
		[:ea |  ea ancestry ancestorString ].
	^ names reject: #isEmpty! !

!Loader class methodsFor: 'private' stamp: 'S 6/17/2013 13:26'!
waitingCacheFolder
	^ self packageToBeTestedFolderName asFileReference 
		ensureCreateDirectory;
		yourself

	! !

!Loader class methodsFor: 'private' stamp: 'StephaneDucasse 9/10/2010 17:22'!
packageToBeTestedFolderName

	^ 'packages-to-be-tested'! !

!LoadingMorph commentStamp: '<historical>'!
I am a special iamge morph used to be displayed as an icon for loading!
!LoadingMorph methodsFor: 'stepping and presenter' stamp: 'BenjaminVanRyseghem 11/24/2013 20:58'!
step

	self isStepping ifFalse: [ ^ self ].
	
	self applyState: currentState nextState.! !

!LoadingMorph methodsFor: 'stepping' stamp: 'BenjaminVanRyseghem 11/26/2013 22:29'!
stepTime

	^ currentState stepTime! !

!LoadingMorph methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/26/2013 22:31'!
applyState: aState

	currentState = aState ifTrue: [ ^ self ].
	currentState := aState.
	self image: aState image! !

!LoadingMorphState commentStamp: '<historical>'!
I am the abstract super class of the loading morph state.

They are used as state in a state machine for the order of the icons in the rotating animation!
!LoadingMorphState methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/24/2013 20:47'!
nextState

	^ self subclassResponsibility! !

!LoadingMorphState methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/26/2013 22:30'!
stepTime

	self subclassResponsibility! !

!LoadingMorphState methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/24/2013 20:50'!
image

	^ self class image! !

!LoadingMorphState class methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/24/2013 20:51'!
imageData

	^ self subclassResponsibility! !

!LoadingMorphState class methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/26/2013 22:43'!
formFromContents: aByteArray
	| size |
	
	size := self size.
	^ Form
		extent: size@size
		depth: 32
		fromArray: aByteArray 
		offset: 0@0! !

!LoadingMorphState class methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/25/2013 15:43'!
image

	^ image ifNil: [ image := self formFromContents: self imageData ]! !

!LoadingState commentStamp: '<historical>'!
I am the state used while loading!
!LoadingState methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/26/2013 23:18'!
image

	^ LoadingMorph new 
		applyState: SmallCogInitialState new;
		yourself! !

!LoadingThenOk commentStamp: '<historical>'!
Small widget displaying a small cog turning while loading, then a ok tick when loading is done!
!LoadingThenOk methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/26/2013 23:20'!
ok

	self state: OkState new! !

!LoadingThenOk methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/26/2013 23:20'!
state: anObject

	state value: anObject! !

!LoadingThenOk methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 1/24/2014 16:07'!
initialize

	super initialize.

	state := ErrorState new asValueHolder.
	
	state whenChangedDo: [ :s | self rebuildForState: s ]! !

!LoadingThenOk methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/26/2013 23:37'!
newSpec

	^ SpecLayout composed
		add: #currentImage;
		yourself! !

!LoadingThenOk methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/26/2013 23:20'!
state

	^ state value! !

!LoadingThenOk methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/26/2013 23:38'!
currentImage

	^ self state image asSpecAdapter! !

!LoadingThenOk methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/26/2013 23:20'!
loading

	self state: LoadingState new! !

!LoadingThenOk methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 11/26/2013 22:35'!
initializeWidgets! !

!LoadingThenOk methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/26/2013 23:38'!
rebuildForState: aState

	self needRebuild: false.
	self buildWithSpecLayout: self newSpec.

	self focusOrder removeAll! !

!LoadingThenOk methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/26/2013 23:20'!
error

	self state: ErrorState new! !

!LoadingThenOk class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 11/26/2013 23:24'!
defaultSpec

	^ SpecLayout composed
		add: #currentImage;
		yourself! !

!LoadingThenOkState commentStamp: '<historical>'!
I am an abstract class representing the state of the LoadingThenOk widget

the different states are: ok, error, loading.

I must define an image used to render the state!
!LoadingThenOkState methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/26/2013 23:18'!
image

	^ self subclassResponsibility! !

!LocalTimeZone commentStamp: '<historical>'!
I am the local time zone which will use the system's current time offset dynamically.

This is the default timezone.!
!LocalTimeZone methodsFor: 'converting' stamp: 'CamilloBruni 8/24/2013 00:08'!
asFixedTimeZone
	"Convert this dynamic timezone to one with a fixed offset."
	^ TimeZone
		offset: self offset
		name: 'Fixed Local Time'
		abbreviation: self abbreviation! !

!LocalTimeZone methodsFor: 'accessing' stamp: 'CamilloBruni 8/24/2013 00:03'!
abbreviation
	^ String streamContents: [ :s |
		s nextPutAll: 'LT'; print: self offset hours; nextPut: $:.
		s nextPutAll: (self offset minutes printPaddedWith: $0 to: 2) ].! !

!LocalTimeZone methodsFor: 'accessing' stamp: 'CamilloBruni 8/23/2013 23:57'!
name
	^ 'Local Time'! !

!LocalTimeZone methodsFor: 'accessing' stamp: 'CamilloBruni 8/23/2013 23:58'!
offset
	^ self primOffset minutes! !

!LocalTimeZone methodsFor: 'primitives' stamp: 'CamilloBruni 8/23/2013 23:59'!
primOffset
	"The offset from UTC in minutes, with positive offsets being towards the east.
	(San Francisco is in UTC -07*60 and Paris is in UTC +02*60 (daylight savings is not in effect)."
	<primitive:'primitiveTimezoneOffset' module: 'LocalePlugin'>
	^ 0! !

!Locale commentStamp: '<historical>'!
Main comment stating the purpose of this class and relevant relationship to other classes.



	http://www.w3.org/WAI/ER/IG/ert/iso639.htm
	http://www.oasis-open.org/cover/iso639a.html
	See also
	http://oss.software.ibm.com/cvs/icu/~checkout~/icuhtml/design/language_code_issues.html
	http://www.w3.org/Protocols/rfc2616/rfc2616-sec3.html#sec3.10
	
ISO 3166
http://mitglied.lycos.de/buran/knowhow/codes/locales/
!
!Locale methodsFor: 'accessing' stamp: 'mir 7/15/2004 14:55'!
localeID
	^id! !

!Locale methodsFor: 'system primitives' stamp: 'tpr 6/2/2005 13:43'!
primMeasurement
	"Returns boolean denoting metric(true) or imperial(false)."
	<primitive:'primitiveMeasurementMetric' module: 'LocalePlugin'>
	^true
! !

!Locale methodsFor: 'system primitives' stamp: 'jannik.laval 2/4/2010 15:11'!
primShortDateFormat
	"Returns the short date format
	d day, m month, y year,
	double symbol is null padded, single not padded (m=6, mm=06)
	dddd weekday
	mmmm month name"
	<primitive:'primitiveShortDateFormat' module: 'LocalePlugin'>
	^'m/d/yy'
! !

!Locale methodsFor: 'system primitives' stamp: 'tpr 6/2/2005 13:44'!
primVMOffsetToUTC
	"Returns the offset in minutes between the VM and UTC.
	If the VM does not support UTC times, this is 0.
	Also gives us backward compatibility with old VMs as the primitive will fail and we then can return 0."
	<primitive:'primitiveVMOffsetToUTC' module: 'LocalePlugin'>
	^0! !

!Locale methodsFor: 'accessing' stamp: 'mir 7/15/2004 12:41'!
isoLocale
	"<language>-<country>"
	^self isoCountry
		ifNil: [self isoLanguage]
		ifNotNil: [self isoLanguage , '-' , self isoCountry]! !

!Locale methodsFor: 'system primitives' stamp: 'tpr 6/2/2005 13:42'!
primDigitGrouping
	"Returns string with e.g. '.' or ',' (thousands etc)"
	<primitive:'primitiveDigitGroupingSymbol' module: 'LocalePlugin'>
	^','! !

!Locale methodsFor: 'private' stamp: 'StephaneDucasse 5/28/2011 13:45'!
fetchISO2Language
	"Locale current fetchISO2Language"
	| lang isoLang |
	lang := self primLanguage.
	lang ifNil: [^nil].
	lang := lang copyUpTo: 0 asCharacter.
	lang size = 2
		ifTrue: [^lang].
	isoLang := ISOLanguageDefinition iso3LanguageDefinition: lang.
	^isoLang
		ifNil: [nil]
		ifNotNil: [isoLang iso2]! !

!Locale methodsFor: 'accessing' stamp: 'nk 8/31/2004 09:39'!
isoCountry
	^self localeID isoCountry! !

!Locale methodsFor: 'system primitives' stamp: 'tpr 6/1/2005 18:48'!
primDST
	"Returns boolean if DST  (daylight saving time) is active or not"
	<primitive:'primitiveDaylightSavings' module: 'LocalePlugin'>
	^false! !

!Locale methodsFor: 'accessing' stamp: 'nk 8/31/2004 09:39'!
isoLanguage
	^self localeID isoLanguage! !

!Locale methodsFor: 'accessing' stamp: 'mir 8/31/2005 17:03'!
determineLocale
	self localeID: self determineLocaleID! !

!Locale methodsFor: 'accessing' stamp: 'mir 7/15/2004 14:55'!
localeID: anID
	id := anID! !

!Locale methodsFor: 'system primitives' stamp: 'jannik.laval 2/4/2010 15:08'!
primTimezone
	"The offset from UTC in minutes, with positive offsets being towards the east.
	(San Francisco is in UTC -07*60 and Paris is in UTC +02*60 (daylight savings is not in effect)."
	<primitive:'primitiveTimezoneOffset' module: 'LocalePlugin'>
	^0! !

!Locale methodsFor: 'system primitives' stamp: 'jannik.laval 2/4/2010 15:09'!
primCountry
	"Returns string with country tag according to ISO 639"
	<primitive: 'primitiveCountry' module: 'LocalePlugin'>
	^'FR'! !

!Locale methodsFor: 'accessing' stamp: 'mir 7/15/2004 15:52'!
languageEnvironment
	^LanguageEnvironment localeID: self localeID! !

!Locale methodsFor: 'accessing' stamp: 'CamilloBruni 11/6/2013 21:23'!
determineLocaleID
	"Locale current determineLocaleID"
	| langCode isoLang countryCode isoCountry |
	langCode := self fetchISO2Language.
	isoLang := langCode
		ifNil: [^self localeID]
		ifNotNil: [langCode].
	countryCode := self primCountry copyUpTo: 0 asCharacter.
	isoCountry := countryCode
		ifNil: [^LocaleID isoLanguage: isoLang]
		ifNotNil: [countryCode].
	^LocaleID isoLanguage: isoLang isoCountry: isoCountry! !

!Locale methodsFor: 'system primitives' stamp: 'tpr 6/1/2005 18:47'!
primCurrencySymbol
	"Returns string with currency symbol"
	<primitive: 'primitiveCurrencySymbol' module:'LocalePlugin'>
	^'$'! !

!Locale methodsFor: 'system primitives' stamp: 'tpr 6/2/2005 13:42'!
primDecimalSymbol
	"Returns string with e.g. '.' or ','"
	<primitive:'primitiveDecimalSymbol' module: 'LocalePlugin'>
	^'.'! !

!Locale methodsFor: 'system primitives' stamp: 'jannik.laval 2/4/2010 15:09'!
primLongDateFormat
	"Returns the long date format
	d day, m month, y year,
	double symbol is null padded, single not padded (m=6, mm=06)
	dddd weekday
	mmmm month name"
	<primitive:'primitiveLongDateFormat' module: 'LocalePlugin'>
	^'dddd, mmmm d, yyyy'
! !

!Locale methodsFor: 'system primitives' stamp: 'jannik.laval 2/4/2010 15:07'!
primLanguage
	"returns string with language tag according to ISO 639"
	<primitive:'primitiveLanguage' module: 'LocalePlugin'>
	^'en'! !

!Locale methodsFor: 'system primitives' stamp: 'jannik.laval 2/4/2010 15:11'!
primTimeFormat
	"Returns string time format
	Format is made up of 
	h hour (h 12, H 24), m minute, s seconds, x (am/pm String)
	double symbol is null padded, single not padded (h=6, hh=06)"
	<primitive:'primitiveTimeFormat' module: 'LocalePlugin'>
	^'h:mmx'
! !

!Locale methodsFor: 'system primitives' stamp: 'tpr 6/1/2005 18:45'!
primCurrencyNotation
	"Returns boolean if symbol is pre- (true) or post-fix (false)"
	<primitive: 'primitiveCurrencyNotation' module: 'LocalePlugin'>
	^true! !

!Locale methodsFor: 'printing' stamp: 'tak 8/4/2005 15:18'!
printOn: aStream 
	super printOn: aStream.
	aStream nextPutAll: '(' , id printString , ')'! !

!Locale class methodsFor: 'system startup' stamp: 'CamilloBruni 8/24/2013 00:09'!
localTimeZone
	^ LocalTimeZone new! !

!Locale class methodsFor: 'settings' stamp: 'AlainPlantec 12/11/2009 10:59'!
activated
	^ Activated ifNil: [Activated := false]! !

!Locale class methodsFor: 'private' stamp: 'mir 7/28/2005 00:24'!
determineCurrentLocale
	"For now just return the default locale.
	A smarter way would be to determine the current platforms default locale."
	"Locale determineCurrentLocale"

	^self new determineLocale! !

!Locale class methodsFor: '*Deprecated40' stamp: 'TorstenBergmann 9/16/2014 15:44'!
addLocalChangedListener: anObjectOrClass
	self deprecated: 'Use Locale with announcements (see LocaleChanged)'.
	
	self localeChangedListeners add: anObjectOrClass! !

!Locale class methodsFor: 'platform specific' stamp: 'cami 7/22/2013 18:28'!
defaultEncodingName: languageSymbol 
	| encodings platformName osVersion |
	platformName := Smalltalk os platformName.
	osVersion := Smalltalk os version.
	encodings := self platformEncodings at: languageSymbol
				ifAbsent: [self platformEncodings at: #default].
	encodings at: platformName ifPresent: [:encoding | ^encoding].
	encodings at: platformName , ' ' , osVersion
		ifPresent: [:encoding | ^encoding].
	^encodings at: #default! !

!Locale class methodsFor: 'accessing' stamp: 'mir 7/15/2004 19:07'!
switchToID: localeID
	"Locale switchToID: (LocaleID isoLanguage: 'de') "

	self switchTo: (Locale localeID: localeID)! !

!Locale class methodsFor: 'initialization' stamp: 'MarcusDenker 1/24/2010 11:07'!
initializePlatformEncodings
	"Locale initializePlatformEncodings"

	| platform |
	PlatformEncodings ifNil: [ PlatformEncodings := Dictionary new ].

	platform := PlatformEncodings at: 'default' ifAbsentPut: Dictionary new.
	platform
		at: 'default' put: 'iso8859-1';
		at: 'Win32 CE' put: 'utf-8'.

	platform := PlatformEncodings at: 'ja' ifAbsentPut: Dictionary new.
	platform
		at: 'default' put: 'shift-jis';
		at: 'unix' put: 'euc-jp';
		at: 'Win32 CE' put: 'utf-8'.
		
	platform := PlatformEncodings at: 'ko' ifAbsentPut: Dictionary new.
	platform
		at: 'default' put: 'euc-kr';
		at: 'Win32 CE' put: 'utf-8'.

	platform := PlatformEncodings at: 'zh' ifAbsentPut: Dictionary new.
	platform
		at: 'default' put: 'gb2312';
		at: 'unix' put: 'euc-cn';
		at: 'Win32 CE' put: 'utf-8'.
! !

!Locale class methodsFor: 'private' stamp: 'mir 7/15/2004 19:44'!
initKnownLocales
	| locales |
	locales := Dictionary new.

	"Init the locales for which we have translations"
	NaturalLanguageTranslator availableLanguageLocaleIDs do: [:id |
		locales at: id put: (Locale new localeID: id)].
	^locales! !

!Locale class methodsFor: 'initialization' stamp: 'AlainPlantec 1/5/2010 12:24'!
initialize
	"Locale initialize"
	Smalltalk addToStartUpList: Locale.
! !

!Locale class methodsFor: 'accessing' stamp: 'HilaireFernandes 5/6/2010 21:31'!
stringForLanguageNameIs: localeID 
	"Answer a string for a menu determining whether the given  
	symbol is the project's natural language"
	^ (self current localeID = localeID
		ifTrue: ['<yes>']
		ifFalse: ['<no>'])
		, localeID displayLanguage! !

!Locale class methodsFor: 'settings' stamp: 'AlainPlantec 12/11/2009 10:59'!
activated: aBoolean
	Activated := aBoolean! !

!Locale class methodsFor: '*Deprecated40' stamp: 'TorstenBergmann 9/16/2014 15:43'!
localeChangedListeners
	self deprecated: 'Use Locale with announcements (see LocaleChanged)'.
	
	^LocaleChangeListeners ifNil: [LocaleChangeListeners := OrderedCollection new]! !

!Locale class methodsFor: 'system startup' stamp: 'CamilloBruni 7/17/2012 15:55'!
startUp: resuming
	| newID |
	resuming ifFalse: [^self].
	DateAndTime localTimeZone: self localTimeZone.
	(self activated)
		ifTrue: [
			newID := self current determineLocaleID.
			newID ~= LocaleID current
				ifTrue: [self switchToID: newID]]! !

!Locale class methodsFor: 'private' stamp: 'mir 7/15/2004 16:44'!
knownLocales
	"KnownLocales := nil"
	^KnownLocales ifNil: [KnownLocales := self initKnownLocales]! !

!Locale class methodsFor: 'initialization' stamp: 'nk 8/29/2004 13:20'!
platformEncodings
	PlatformEncodings isEmptyOrNil ifTrue: [ self initializePlatformEncodings ].
	^PlatformEncodings
! !

!Locale class methodsFor: 'accessing' stamp: 'yo 7/28/2004 20:32'!
currentPlatform
	"CurrentPlatform := nil"
	CurrentPlatform ifNil: [CurrentPlatform := self determineCurrentLocale].
	^CurrentPlatform! !

!Locale class methodsFor: '*Deprecated40' stamp: 'TorstenBergmann 9/16/2014 14:17'!
isoLocale: aString
	self deprecated: 'There was no sender of this method in Pharo 4.0'! !

!Locale class methodsFor: 'accessing' stamp: 'mir 7/15/2004 14:31'!
isoLanguage: isoLanguage isoCountry: isoCountry
	^self localeID: (LocaleID  isoLanguage: isoLanguage isoCountry: isoCountry)! !

!Locale class methodsFor: 'accessing' stamp: 'mir 7/13/2004 00:24'!
languageSymbol: languageSymbol
	"Locale languageSymbol: #Deutsch"

	^self isoLanguage: (LanguageSymbols at: languageSymbol)! !

!Locale class methodsFor: 'announcing' stamp: 'TorstenBergmann 9/16/2014 15:42'!
localeAnnouncer
	^localeAnnouncer ifNil: [ localeAnnouncer := Announcer new ]! !

!Locale class methodsFor: 'accessing' stamp: 'mir 7/15/2004 14:30'!
localeID: id
	^self knownLocales at: id ifAbsentPut: [Locale new localeID: id]! !

!Locale class methodsFor: 'accessing' stamp: 'tak 10/18/2005 22:33'!
currentPlatform: locale during: aBlock 
	"Alter current language platform during a block"
	| backupPlatform |
	backupPlatform := self currentPlatform.
	[self currentPlatform: locale.
	aBlock value]
		ensure: [self currentPlatform: backupPlatform]! !

!Locale class methodsFor: 'accessing' stamp: 'TorstenBergmann 9/16/2014 15:45'!
switchTo: locale 
	"Locale switchTo: Locale isoLanguage: 'de'"
	Current localeID = locale localeID
		ifFalse: [
			|announcement|
			announcement := LocaleChanged from: Current to: locale.
			Current := locale.
			CurrentPlatform := locale.
			self localeAnnouncer announce: announcement ]! !

!Locale class methodsFor: 'accessing' stamp: 'mir 7/15/2004 14:20'!
isoLanguage: isoLanguage
	^self isoLanguage: isoLanguage isoCountry: nil! !

!Locale class methodsFor: '*Deprecated40' stamp: 'TorstenBergmann 9/16/2014 15:43'!
localeChanged

	self deprecated: 'Use Locale with announcements (see LocaleChanged)'! !

!Locale class methodsFor: 'accessing' stamp: 'yo 7/28/2004 20:39'!
currentPlatform: locale
	CurrentPlatform := locale.
	LanguageEnvironment startUp.
! !

!Locale class methodsFor: 'accessing' stamp: 'mir 8/31/2005 17:36'!
current
	"Current := nil"
	Current ifNil: [
		Current := self determineCurrentLocale.
		"Transcript show: 'Current locale: ' , Current localeID asString; cr"].
	^Current! !

!LocaleAnnouncementTests methodsFor: 'running' stamp: 'TorstenBergmann 9/16/2014 16:01'!
tearDown

	Locale localeAnnouncer unsubscribe: self.
	Locale classVarNamed: 'Current' put: saveCurrent.
	super tearDown! !

!LocaleAnnouncementTests methodsFor: 'events' stamp: 'TorstenBergmann 9/16/2014 16:04'!
localeWasChanged: anAnnouncement

	catchedAnnouncement := anAnnouncement ! !

!LocaleAnnouncementTests methodsFor: 'private accessing' stamp: 'TorstenBergmann 9/16/2014 16:02'!
frenchLocale
	^ Locale isoLanguage: 'fr'! !

!LocaleAnnouncementTests methodsFor: 'running' stamp: 'TorstenBergmann 9/16/2014 16:00'!
setUp

	super setUp.
	saveCurrent := Locale current.
	Locale localeAnnouncer when: LocaleChanged send: #localeWasChanged: to: self! !

!LocaleAnnouncementTests methodsFor: 'tests' stamp: 'TorstenBergmann 9/16/2014 16:07'!
testLocaleChangeAnnouncement
	|current|
	current := Locale current.
	catchedAnnouncement := nil.
	"this should trigger the announcement"
	Locale switchTo: self frenchLocale.
	
	self 
		assert: catchedAnnouncement notNil;
		assert: catchedAnnouncement oldLocale = current;
		assert: catchedAnnouncement newLocale = self frenchLocale! !

!LocaleChanged commentStamp: 'TorstenBergmann 9/16/2014 14:24'!
Announce that a locale was changed!
!LocaleChanged methodsFor: 'accessing' stamp: 'TorstenBergmann 9/16/2014 15:53'!
newLocale: anObject
	newLocale := anObject! !

!LocaleChanged methodsFor: 'accessing' stamp: 'TorstenBergmann 9/16/2014 15:54'!
oldLocale: anObject
	oldLocale := anObject! !

!LocaleChanged methodsFor: 'accessing' stamp: 'TorstenBergmann 9/16/2014 15:53'!
newLocale
	^ newLocale! !

!LocaleChanged methodsFor: 'accessing' stamp: 'TorstenBergmann 9/16/2014 15:54'!
oldLocale
	^ oldLocale! !

!LocaleChanged class methodsFor: 'instance creation' stamp: 'TorstenBergmann 9/16/2014 15:54'!
from: oldLocale to: newLocale

	^(self new)
		oldLocale: oldLocale;
		newLocale: newLocale;
		yourself! !

!LocaleChangedTest methodsFor: 'tests' stamp: 'TorstenBergmann 9/16/2014 15:55'!
testInstanceCreation
	| instance |
	instance := LocaleChanged from: self englishLocale to: self germanLocale.
	
	self 
		assert: instance oldLocale = self englishLocale;
		assert: instance newLocale = self germanLocale 
	! !

!LocaleChangedTest methodsFor: 'private accessing' stamp: 'TorstenBergmann 9/16/2014 15:53'!
germanLocale
	^ Locale isoLanguage: 'de'! !

!LocaleChangedTest methodsFor: 'private accessing' stamp: 'TorstenBergmann 9/16/2014 15:53'!
englishLocale
	^ Locale isoLanguage: 'en'! !

!LocaleID commentStamp: 'TorstenBergmann 1/31/2014 10:08'!
The ID for localization!
!LocaleID methodsFor: 'comparing' stamp: 'mir 7/15/2004 14:23'!
hash
	^self isoLanguage hash bitXor: self isoCountry hash! !

!LocaleID methodsFor: 'testing' stamp: 'mir 7/15/2004 14:34'!
hasParent
	^self isoCountry notNil! !

!LocaleID methodsFor: 'initialize' stamp: 'mir 7/15/2004 12:44'!
isoLanguage: langString isoCountry: countryStringOrNil
	isoLanguage := langString.
	isoCountry := countryStringOrNil! !

!LocaleID methodsFor: 'printing' stamp: 'tak 11/15/2004 12:45'!
storeOn: aStream 
	aStream nextPut: $(.
	aStream nextPutAll: self class name.
	aStream nextPutAll: ' isoString: '.
	aStream nextPutAll: '''' , self printString , ''''.
	aStream nextPut: $).
! !

!LocaleID methodsFor: 'accessing' stamp: 'mir 7/15/2004 12:43'!
isoCountry
	^isoCountry! !

!LocaleID methodsFor: 'accessing' stamp: 'mir 7/15/2004 12:43'!
isoLanguage
	^isoLanguage! !

!LocaleID methodsFor: 'accessing' stamp: 'mir 7/21/2004 19:17'!
isoString
	^self asString! !

!LocaleID methodsFor: 'comparing' stamp: 'mir 7/15/2004 14:23'!
= anotherObject
	self class == anotherObject class
		ifFalse: [^false].
	^self isoLanguage = anotherObject isoLanguage
		and: [self isoCountry = anotherObject isoCountry]! !

!LocaleID methodsFor: 'accessing' stamp: 'mir 9/1/2005 14:17'!
displayCountry
	^(ISOLanguageDefinition iso2Countries at: self isoCountry asUppercase ifAbsent: [ self isoCountry ]) ! !

!LocaleID methodsFor: 'printing' stamp: 'mir 7/15/2004 12:45'!
printOn: stream
	"<language>-<country>"
	stream nextPutAll: self isoLanguage.
	self isoCountry
		ifNotNil: [stream nextPut: $-; nextPutAll: self isoCountry]! !

!LocaleID methodsFor: 'accessing' stamp: 'mir 7/15/2004 14:34'!
parent
	^self class isoLanguage: self isoLanguage! !

!LocaleID methodsFor: 'accessing' stamp: 'tak 3/23/2006 12:26'!
displayLanguage
	| language |
	language := (ISOLanguageDefinition iso2LanguageTable
				at: self isoLanguage
				ifAbsent: [^ self isoLanguage]) language.
	^ self isoCountry
		ifNil: [language]
		ifNotNil: [language , ' (' , self displayCountry , ')']! !

!LocaleID methodsFor: 'printing' stamp: 'tak 8/6/2007 12:16'!
posixName
	"(LocaleID isoString: 'es-MX') posixName"
	"(LocaleID isoString: 'es') posixName"
	"language[_territory]"
	^ self isoCountry
		ifNil: [self isoLanguage]
		ifNotNil: [self isoLanguage , '_' , self isoCountry]! !

!LocaleID class methodsFor: '*Deprecated40' stamp: 'TorstenBergmann 9/16/2014 14:18'!
previous
	self deprecated: 'There was no sender of this method in Pharo 4.0'.
	^Locale previous localeID! !

!LocaleID class methodsFor: 'instance creation' stamp: 'mir 7/21/2004 13:59'!
isoString: isoString
	"Parse the isoString (<language>-<country>) into its components and return the matching LocaleID"
	"LocaleID isoString: 'en' "
	"LocaleID isoString: 'en-us' "

	| parts language country |
	parts := isoString findTokens: #($- ).
	language := parts first.
	parts size > 1
		ifTrue: [country := parts second].
	^self isoLanguage: language isoCountry: country! !

!LocaleID class methodsFor: 'instance creation' stamp: 'mir 7/15/2004 14:35'!
isoLanguage: langString
	^self isoLanguage: langString isoCountry: nil! !

!LocaleID class methodsFor: 'instance creation' stamp: 'HilaireFernandes 4/30/2010 18:00'!
posixName: aString 
	^ self
		isoString: (aString copyReplaceAll: '_' with: '-')! !

!LocaleID class methodsFor: 'instance creation' stamp: 'mir 7/15/2004 12:46'!
isoLanguage: langString isoCountry: countryStringOrNil
	^self new isoLanguage: langString isoCountry: countryStringOrNil! !

!LocaleID class methodsFor: 'accessing' stamp: 'mir 7/15/2004 15:09'!
current
	^Locale current localeID! !

!LocaleIDTest commentStamp: 'TorstenBergmann 9/16/2014 14:32'!
A unit test class for class LocaleID!
!LocaleIDTest methodsFor: 'tests' stamp: 'TorstenBergmann 9/16/2014 14:10'!
testInstanceCreationWithISOLanguageAndCountry

	|locale|
	locale := LocaleID isoLanguage: 'zh' isoCountry: 'CN'.
	self 
		assert: locale isoLanguage = 'zh';
		assert: locale isoCountry = 'CN'! !

!LocaleIDTest methodsFor: 'tests' stamp: 'TorstenBergmann 9/16/2014 14:10'!
testHashing

	self assert: self germanLocaleID hash = self germanLocaleID hash.
	self assert: self frenchLocaleID hash = self frenchLocaleID hash.	
! !

!LocaleIDTest methodsFor: 'tests' stamp: 'TorstenBergmann 9/16/2014 14:10'!
testInstanceCreationWithISOLanguage

	|germanLocale|
	germanLocale := LocaleID isoLanguage: 'de'.
	self assert: germanLocale isoLanguage = 'de'! !

!LocaleIDTest methodsFor: 'tests' stamp: 'TorstenBergmann 9/16/2014 14:10'!
testPosixNameConversion

	| locale |
	locale := LocaleID posixName: 'en_us'.
	self 
		assert: locale isoLanguage = 'en';
		assert: locale isoCountry = 'us'! !

!LocaleIDTest methodsFor: 'tests' stamp: 'TorstenBergmann 9/16/2014 14:09'!
testFromSingleISOString

	| locale |
	locale := LocaleID isoString: 'en'.
	self 
		assert: locale isoLanguage = 'en';
		assert: locale isoCountry isNil! !

!LocaleIDTest methodsFor: 'tests' stamp: 'TorstenBergmann 9/16/2014 14:09'!
testCurrent

	self assert: LocaleID current notNil! !

!LocaleIDTest methodsFor: 'tests - test data' stamp: 'TorstenBergmann 9/16/2014 14:09'!
germanLocaleID

	^LocaleID isoLanguage: 'de'! !

!LocaleIDTest methodsFor: 'tests' stamp: 'TorstenBergmann 9/16/2014 14:09'!
testFromISOString

	| locale |
	locale := LocaleID isoString: 'en-us'.
	self 
		assert: locale isoLanguage = 'en';
		assert: locale isoCountry = 'us'! !

!LocaleIDTest methodsFor: 'tests' stamp: 'TorstenBergmann 9/16/2014 14:10'!
testPrintString

	| locale |
	locale := LocaleID isoString: 'en-us'.	
	self assert: locale printString = 'en-us'
! !

!LocaleIDTest methodsFor: 'tests' stamp: 'TorstenBergmann 9/16/2014 14:09'!
testComparision

	self deny: self germanLocaleID = self frenchLocaleID.
	self assert: self germanLocaleID = self germanLocaleID.	! !

!LocaleIDTest methodsFor: 'tests - test data' stamp: 'TorstenBergmann 9/16/2014 14:09'!
frenchLocaleID

	^LocaleID isoLanguage: 'fr'! !

!LocaleTest commentStamp: 'TorstenBergmann 9/16/2014 14:32'!
A unit test class for class Locale!
!LocaleTest methodsFor: 'tests' stamp: 'TorstenBergmann 9/16/2014 14:15'!
testAccessLocaleID

	self assert: Locale current localeID notNil! !

!LocaleTest methodsFor: 'tests' stamp: 'TorstenBergmann 9/16/2014 14:15'!
testCurrent

	self assert: Locale current notNil
	! !

!LockableTab commentStamp: '<historical>'!
I am a tab which can be locked/unlocked with according action and icon!
!LockableTab methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/4/2013 15:49'!
showCloseIcon

	closeIcon show! !

!LockableTab methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/4/2013 15:42'!
closeable: anObject

	closeable := anObject.
	anObject 
		ifTrue: [ self setUnlockedIcon ]
		ifFalse: [ self setLockedIcon ]! !

!LockableTab methodsFor: 'private' stamp: 'BenjaminVanRyseghem 6/4/2013 15:42'!
setLockedIcon

	closeIcon image: self class lockedIcon.! !

!LockableTab methodsFor: 'private' stamp: 'BenjaminVanRyseghem 6/4/2013 15:42'!
setUnlockedIcon

	closeIcon image: self class closeIcon.! !

!LockableTab class methodsFor: 'icons' stamp: 'BenjaminVanRyseghem 6/8/2013 15:54'!
lockedIcon

	^ Icons
		at: #lockedIcon
		ifAbsentPut: [ self lockedIconContents ]! !

!LockableTab class methodsFor: 'icons-contents' stamp: 'BenjaminVanRyseghem 6/8/2013 15:54'!
lockedIconContents

	^ Form
		extent: 12@12
		depth: 32
		fromArray: #(0 0 0 807082779 3175894092 4235885178 4235885178 3159116876 807082779 0 0 0 0 0 1107296256 4286545791 4290164406 3801519766 3801519766 4290230199 4286545791 1107296256 0 0 0 0 3578020932 4290295992 2284991026 335741699 335741699 2285122612 4290361785 3578020932 0 0 0 301989888 3899288170 4019755160 738197504 0 0 738197504 4019228816 3900011893 301989888 0 33554432 1478500384 4100746348 4137458844 2436709693 2035898713 2035898713 2436907072 4135814019 4102325380 1478171419 33554432 234881024 3429723501 4291611852 4292532954 4292072403 4292072403 4292072403 4292072403 4292401368 4291809231 3429723501 234881024 251658240 3480120942 4291546059 4292138196 4292269782 4292006610 4292006610 4292269782 4292138196 4291546059 3480120942 251658240 251658240 3479857770 4290559164 4291217094 4291743438 4285493103 4285493103 4291743438 4291282887 4290559164 3479857770 251658240 251658240 3479726184 4290098613 4290756543 4291151301 4286743170 4286743170 4291151301 4290756543 4290230199 3479726184 251658240 251658240 3479660391 4289967027 4290624957 4290822336 4289703855 4289703855 4290822336 4290624957 4290032820 3479726184 251658240 268435456 3530057832 4290230199 4290888129 4290888129 4291019715 4291019715 4290888129 4290888129 4290230199 3530123625 268435456 150994944 2939631415 4283979864 4284308829 4284374622 4284374622 4284374622 4284374622 4284308829 4284045657 2939697208 150994944)
		offset: 0@0! !

!LogicalFont commentStamp: 'LaurentLaffont 6/8/2011 22:20'!
I describe a font.!
!LogicalFont methodsFor: 'forwarded to realFont' stamp: 'tween 3/16/2007 13:37'!
ascent
	^self realFont ascent! !

!LogicalFont methodsFor: 'forwarded to realFont' stamp: 'tween 3/16/2007 14:12'!
displayUnderlineOn: aGrafPort from: aPoint to: aPoint3 
	^self realFont displayUnderlineOn: aGrafPort from: aPoint to: aPoint3 ! !

!LogicalFont methodsFor: 'accessing' stamp: 'tween 3/16/2007 15:57'!
setEmphasis: code

	emphasis := code! !

!LogicalFont methodsFor: 'accessing' stamp: 'tween 8/17/2007 00:27'!
stretchValue: anObject
	"Set the value of stretchValue"

	stretchValue := anObject! !

!LogicalFont methodsFor: 'forwarded to realFont' stamp: 'tween 3/28/2007 14:56'!
widthOfString: aString
	^self realFont widthOfString: aString! !

!LogicalFont methodsFor: '*Athens-Text' stamp: 'IgorStasenko 6/11/2012 02:17'!
getGlyphWidth: aCharacter 
	^ self realFont getGlyphWidth: aCharacter! !

!LogicalFont methodsFor: 'initialize-release' stamp: 'tween 3/16/2007 17:42'!
initialize: aFont

	familyName := aFont familyName.
	emphasis := aFont emphasis.! !

!LogicalFont methodsFor: 'forwarded to realFont' stamp: 'tween 3/16/2007 13:33'!
height
	^self realFont height! !

!LogicalFont methodsFor: 'accessing' stamp: 'tween 8/18/2007 16:34'!
forceItalicOrOblique
	self slantValue = 0 ifTrue:[slantValue := 1]! !

!LogicalFont methodsFor: '*Athens-Text' stamp: 'IgorStasenko 6/11/2012 02:17'!
getPreciseHeight
	^ self realFont getPreciseHeight! !

!LogicalFont methodsFor: 'forwarded to realFont' stamp: 'tween 3/21/2007 09:16'!
kerningLeft: leftChar right: rightChar
	^self realFont kerningLeft: leftChar right: rightChar! !

!LogicalFont methodsFor: 'accessing' stamp: 'tween 3/16/2007 13:58'!
pointSize: aNumber
	pointSize := aNumber! !

!LogicalFont methodsFor: '*Athens-Text' stamp: 'IgorStasenko 6/11/2012 02:16'!
getPreciseAscent
	^ self realFont getPreciseAscent! !

!LogicalFont methodsFor: '*Athens-Text' stamp: 'IgorStasenko 6/11/2012 02:17'!
glyphRendererOn: anAthensBalloonSurface 
	^ self realFont glyphRendererOn: anAthensBalloonSurface! !

!LogicalFont methodsFor: 'derivatives' stamp: 'tween 3/16/2007 15:44'!
derivativeFont: newFont
	"add aFont as derivative, answer new basefont"
	(self isRegular and: [newFont isRegular not]) ifTrue: [
		self derivativeFontsAt: newFont emphasis put: newFont.
		^self].
	"new font is base, copy everything over"
	self isRegular
		ifFalse: [newFont derivativeFontsAt: self emphasis put: self].
	self derivativeFonts do: [:f |
		newFont derivativeFontsAt: f emphasis put: f].
	derivatives := nil.
	^newFont! !

!LogicalFont methodsFor: 'private' stamp: 'AlainPlantec 9/13/2011 21:08'!
findRealFont
	"for now just get a strike"
	"^((TextStyle named: StrikeFont defaultFontKey) fontOfPointSize: pointSize)
		emphasized: emphasis"
	^LogicalFontManager current bestFontFor: self! !

!LogicalFont methodsFor: 'forwarded to realFont' stamp: 'tween 3/29/2007 13:43'!
hasDistinctGlyphsForAll: asciiString
	
	^self realFont hasDistinctGlyphsForAll: asciiString! !

!LogicalFont methodsFor: 'testing' stamp: 'tween 9/29/2007 10:57'!
isItalic
	^self isItalicOrOblique! !

!LogicalFont methodsFor: 'forwarded to realFont' stamp: 'nice 10/29/2013 04:33'!
xTable
	"Provided only for accelerating text scanning thru primitive 103 - see super."
	^self realFont xTable! !

!LogicalFont methodsFor: '*system-settings-browser' stamp: 'alain.plantec 3/19/2009 10:02'!
settingStoreOn: aStream 
	aStream nextPut: $(.
	aStream nextPutAll: self class name.
	aStream nextPut: Character space.
	aStream nextPutAll: 'familyName: '.
	self familyName settingStoreOn: aStream.
	aStream nextPut: Character space.
	aStream nextPutAll: 'fallbackFamilyNames: '.
	self fallbackFamilyNames settingStoreOn: aStream.
	aStream nextPut: Character space.
	aStream nextPutAll: 'pointSize: '.
	self pointSize settingStoreOn: aStream.
	aStream nextPut: Character space.
	aStream nextPutAll: 'stretchValue: '.
	self stretchValue settingStoreOn: aStream.
	aStream nextPut: Character space.
	aStream nextPutAll: 'weightValue: '.
	self weightValue settingStoreOn: aStream.
	aStream nextPut: Character space.
	aStream nextPutAll: 'slantValue: '.
	self slantValue settingStoreOn: aStream.
	aStream nextPut: $)! !

!LogicalFont methodsFor: 'emphasis' stamp: 'MarcusDenker 7/25/2014 09:37'!
emphasized: code
	| validCode newWeight newSlant answer validCodeMask |
	"we only handle bold and italic here since underline/strikeout are drawn separately"
	validCodeMask := self class squeakWeightBold bitOr: self class squeakSlantItalic.
	validCode := code bitAnd: validCodeMask.
	validCode = 0
		ifTrue: [ ^ self ].
	newWeight := (validCode anyMask: self class squeakWeightBold)
		ifTrue: [ self class weightBold max: weightValue ]
		ifFalse: [ weightValue ].
	newSlant := ((validCode anyMask: self class squeakSlantItalic) and: [ self isItalicOrOblique not ])
		ifTrue: [ self class slantItalic ]
		ifFalse: [ slantValue ].
	(weightValue = newWeight and: [ slantValue = newSlant ])
		ifTrue: [ ^ self ].
	(weightValue ~= newWeight and: [ slantValue ~= newSlant ])
		ifTrue: [ boldItalicDerivative ifNotNil: [ ^ boldItalicDerivative ] ]
		ifFalse: [ 
			weightValue ~= newWeight
				ifTrue: [ boldDerivative ifNotNil: [ ^ boldDerivative ] ].
			slantValue ~= newSlant
				ifTrue: [ italicDerivative ifNotNil: [ ^ italicDerivative ] ] ].
	answer := self class
		familyName: familyName
		fallbackFamilyNames: fallbackFamilyNames
		pointSize: pointSize
		stretchValue: stretchValue
		weightValue: newWeight
		slantValue: newSlant.
	(weightValue ~= newWeight and: [ slantValue ~= newSlant ])
		ifTrue: [ ^ boldItalicDerivative := answer ].
	weightValue ~= newWeight
		ifTrue: [ ^ boldDerivative := answer ].
	slantValue ~= newSlant
		ifTrue: [ ^ italicDerivative := answer ].
	^ answer! !

!LogicalFont methodsFor: 'accessing' stamp: 'tween 3/17/2007 10:49'!
clearRealFont
	realFont := nil! !

!LogicalFont methodsFor: 'accessing' stamp: 'tween 3/16/2007 16:25'!
familyName
	^familyName! !

!LogicalFont methodsFor: 'emphasis' stamp: 'tween 9/22/2007 12:41'!
emphasis: code
	
	^self emphasized: code! !

!LogicalFont methodsFor: '*Athens-Text' stamp: 'IgorStasenko 6/11/2012 02:16'!
getPreciseDescent
	^ self realFont getPreciseDescent! !

!LogicalFont methodsFor: 'accessing' stamp: 'tween 8/17/2007 00:27'!
slantValue: anObject
	"Set the value of slantValue"

	slantValue := anObject! !

!LogicalFont methodsFor: 'forwarded to realFont' stamp: 'tween 3/29/2007 14:04'!
isSymbolFont
	
	^self realFont isSymbolFont! !

!LogicalFont methodsFor: 'forwarded to realFont' stamp: 'tween 3/16/2007 14:02'!
baseKern
	^self realFont baseKern! !

!LogicalFont methodsFor: 'accessing' stamp: 'tween 3/16/2007 13:57'!
familyName: aString
	familyName := aString! !

!LogicalFont methodsFor: 'accessing' stamp: 'tween 8/27/2007 11:38'!
familyNames
	"Answer an array containing the receiver's familyName
	followed by any fallbackFamilyNames"
	|answer|
	answer := {familyName}.
	fallbackFamilyNames ifNotNil:[
		answer := answer, fallbackFamilyNames].
	^answer! !

!LogicalFont methodsFor: 'forwarded to realFont' stamp: 'tween 3/29/2007 13:29'!
hasGlyphsForAll: asciiString
	
	^self realFont hasGlyphsForAll: asciiString! !

!LogicalFont methodsFor: 'forwarded to realFont' stamp: 'tween 4/2/2007 22:12'!
widthAndKernedWidthOfLeft: leftCharacter right: rightCharacterOrNil into: aTwoElementArray
	^self realFont widthAndKernedWidthOfLeft: leftCharacter right: rightCharacterOrNil into: aTwoElementArray! !

!LogicalFont methodsFor: 'accessing' stamp: 'tween 3/16/2007 17:39'!
familySizeFace
	"should have default in AbstractFont"
	^{self familyName. self pointSize. self emphasis}! !

!LogicalFont methodsFor: 'forwarded to realFont' stamp: 'tween 4/6/2007 12:58'!
isSubPixelPositioned
	"Answer true if the receiver is currently using subpixel positioned
	glyphs, false otherwise. This affects how padded space sizes are calculated
	when composing text. 
	Currently, only FreeTypeFonts are subPixelPositioned, and only when not
	Hinted"
	
	^self realFont isSubPixelPositioned! !

!LogicalFont methodsFor: 'forwarded to realFont' stamp: 'tween 3/16/2007 14:03'!
widthOf: anObject
	^self realFont widthOf: anObject! !

!LogicalFont methodsFor: 'forwarded to realFont' stamp: 'tween 3/16/2007 13:38'!
descent
	^self realFont descent! !

!LogicalFont methodsFor: 'forwarded to realFont' stamp: 'tween 3/28/2007 14:52'!
widthOfString: aString from: startIndex to: stopIndex
	^self realFont widthOfString: aString from: startIndex to: stopIndex! !

!LogicalFont methodsFor: 'testing' stamp: 'tween 9/29/2007 10:56'!
isBold
	^self isBoldOrBolder! !

!LogicalFont methodsFor: '*Text-Scanning' stamp: 'nice 10/29/2013 04:33'!
scanByteCharactersFrom: startIndex to: stopIndex in: aByteString with: aCharacterScanner rightX: rightX
	"scan a single byte character string"
	^self realFont scanByteCharactersFrom: startIndex to: stopIndex in: aByteString with: aCharacterScanner rightX: rightX! !

!LogicalFont methodsFor: 'forwarded to realFont' stamp: 'tween 3/16/2007 13:38'!
isTTCFont
	^self realFont isTTCFont! !

!LogicalFont methodsFor: 'emphasis' stamp: 'tween 9/29/2007 12:48'!
emphasis
	"Answer the squeak emphasis code for the receiver.
	1=bold, 2=italic, 3=bold-italic etc"
	| answer |
	answer := 0.
	self isBoldOrBolder ifTrue:[answer := answer + self class squeakWeightBold].
	self isItalicOrOblique ifTrue:[answer := answer + self class squeakSlantItalic].
	^answer! !

!LogicalFont methodsFor: 'accessing' stamp: 'tween 8/18/2007 21:47'!
forceNotItalic
	"leave oblique style in place"
	slantValue = 1 ifTrue:[slantValue := 0].! !

!LogicalFont methodsFor: 'accessing' stamp: 'tween 3/16/2007 16:21'!
maxAscii
	"???
	what to do if realFont happens to be a StrikeFontSet?"
	^SmallInteger maxVal! !

!LogicalFont methodsFor: 'forwarded to realFont' stamp: 'tween 3/16/2007 16:03'!
displayString: aString on: aDisplayContext from: startIndex to: stopIndex at: aPoint kern: kernDelta
	^self realFont displayString: aString on: aDisplayContext from: startIndex to: stopIndex at: aPoint kern: kernDelta! !

!LogicalFont methodsFor: 'testing' stamp: 'tween 3/16/2007 15:48'!
isRegular
	^emphasis = 0! !

!LogicalFont methodsFor: 'accessing' stamp: 'tween 8/18/2007 17:04'!
forceNotBold
	"anything other than bold (700) is not changed.
	we only remove boldness that can be put back with 
	a TextAttribute bold."
	
	self weightValue = 700 
		ifTrue:[weightValue := 400].! !

!LogicalFont methodsFor: 'forwarded to realFont' stamp: 'MarcusDenker 7/9/2012 21:45'!
fontArray
	| real | 
	real := self realFont.
	^real isFontSet 
		ifTrue: [real fontArray] 
		ifFalse: [{self}]! !

!LogicalFont methodsFor: 'forwarded to realFont' stamp: 'tween 3/16/2007 14:04'!
installOn: a foregroundColor: b backgroundColor: c
	^self realFont installOn: a foregroundColor: b backgroundColor: c! !

!LogicalFont methodsFor: 'emphasis' stamp: 'tween 3/16/2007 15:59'!
emphasisString
	^AbstractFont emphasisStringFor: emphasis! !

!LogicalFont methodsFor: 'accessing' stamp: 'tween 8/27/2007 11:19'!
fallbackFamilyNames: aSequencableCollection
	fallbackFamilyNames := aSequencableCollection! !

!LogicalFont methodsFor: 'testing' stamp: 'tween 9/29/2007 10:47'!
isItalicOrOblique
	slantValue ifNil:[slantValue := 0].
	^slantValue = 1 or:[slantValue = 2]! !

!LogicalFont methodsFor: 'printing' stamp: 'MarcusDenker 7/25/2014 09:38'!
printOn: aStream
	super printOn: aStream.
	aStream
		cr;
		nextPutAll: ' familyName: ';
		nextPutAll: familyName asString;
		cr;
		nextPutAll: ' emphasis: ';
		nextPutAll: emphasis asString;
		cr;
		nextPutAll: ' pointSize: ';
		nextPutAll: pointSize asString;
		cr;
		nextPutAll: ' realFont: ';
		nextPutAll: realFont asString;
		nextPutAll: ' weight: ';
		nextPutAll: weightValue asString;
		nextPutAll: ' stretch: ';
		nextPutAll: stretchValue asString;
		nextPutAll: ' slant: ';
		nextPutAll: slantValue asString! !

!LogicalFont methodsFor: 'accessing' stamp: 'tween 8/18/2007 19:49'!
realFont
	^realFont ifNil:[realFont := self findRealFont]! !

!LogicalFont methodsFor: 'accessing' stamp: 'tween 8/27/2007 11:18'!
fallbackFamilyNames
	^fallbackFamilyNames! !

!LogicalFont methodsFor: 'derivatives' stamp: 'tween 3/16/2007 15:46'!
derivativeFonts

	derivatives ifNil: [^ #()].
	^derivatives copyWithout: nil! !

!LogicalFont methodsFor: 'accessing' stamp: 'tween 8/18/2007 19:46'!
weightValue
	"Answer the value of weightValue"

	^ weightValue ifNil:[weightValue := 400]! !

!LogicalFont methodsFor: 'forwarded to realFont' stamp: 'tween 3/16/2007 14:11'!
displayString: aWideString on: aGrafPort from: aSmallInteger to: aSmallInteger4 at: aPoint kern: aSmallInteger6 baselineY: aSmallInteger7 
	^self realFont displayString: aWideString on: aGrafPort from: aSmallInteger to: aSmallInteger4 at: aPoint kern: aSmallInteger6 baselineY: aSmallInteger7 ! !

!LogicalFont methodsFor: '*Text-Scanning' stamp: 'nice 10/29/2013 04:33'!
scanMultibyteCharactersFrom: startIndex to: stopIndex in: aWideString with: aCharacterScanner rightX: rightX
	"scan a multibyte character string"
	^self realFont scanMultibyteCharactersFrom: startIndex to: stopIndex in: aWideString with: aCharacterScanner rightX: rightX! !

!LogicalFont methodsFor: 'accessing' stamp: 'tween 8/18/2007 16:32'!
forceBold
	weightValue := (self weightValue max: 700).! !

!LogicalFont methodsFor: 'forwarded to realFont' stamp: 'tween 3/16/2007 14:02'!
descentKern
	^self realFont descentKern! !

!LogicalFont methodsFor: 'accessing' stamp: 'tween 8/18/2007 19:46'!
stretchValue
	"Answer the value of stretchValue"

	^ stretchValue ifNil:[stretchValue := 5]! !

!LogicalFont methodsFor: 'derivatives' stamp: 'tween 3/16/2007 17:43'!
derivativeFont: newFont mainFont: ignore
	self derivativeFont: newFont! !

!LogicalFont methodsFor: 'testing' stamp: 'tween 9/29/2007 10:48'!
isBoldOrBolder
	^(weightValue ifNil:[400]) >= 700! !

!LogicalFont methodsFor: 'printing' stamp: 'BenjaminVanRyseghem 12/20/2012 13:36'!
storeOn: aStream

	aStream 
		nextPutAll: 'LogicalFont';
		nextPutAll: '
		familyName: '; nextPutAll: self familyName printString ;
		nextPutAll: '
		pointSize: '; nextPutAll: self pointSize asString;
		nextPutAll: '
		stretchValue: '; nextPutAll: self stretchValue asString;
		nextPutAll: '
		weightValue: '; nextPutAll: self weightValue asString;
		nextPutAll: '
		slantValue: '; nextPutAll: self slantValue asString.! !

!LogicalFont methodsFor: 'forwarded to realFont' stamp: 'tween 3/16/2007 14:13'!
displayStrikeoutOn: aGrafPort from: aPoint to: aPoint3 
	^self realFont displayStrikeoutOn: aGrafPort from: aPoint to: aPoint3 ! !

!LogicalFont methodsFor: 'forwarded to realFont' stamp: 'tween 3/31/2007 17:13'!
linearWidthOf: aCharacter
	^self realFont linearWidthOf: aCharacter! !

!LogicalFont methodsFor: 'accessing' stamp: 'tween 8/17/2007 00:27'!
weightValue: anObject
	"Set the value of weightValue"

	weightValue := anObject! !

!LogicalFont methodsFor: 'derivatives' stamp: 'tween 3/16/2007 15:44'!
derivativeFontsAt: index put: aFont

	derivatives ifNil:[derivatives := Array new: 32].
	derivatives at: index put: aFont! !

!LogicalFont methodsFor: 'forwarded to realFont' stamp: 'nice 10/29/2013 04:32'!
characterToGlyphMap
	"Provided only for accelerating text scanning thru primitive 103 - see super."
	^self realFont characterToGlyphMap! !

!LogicalFont methodsFor: '*system-settings-browser' stamp: 'MarcusDenker 11/1/2014 08:36'!
withSizeIncrementedBy: anInteger
	^ self class 
		familyName: self familyName 
		fallbackFamilyNames: self fallbackFamilyNames
		pointSize: self pointSize + anInteger
		stretchValue: self stretchValue
		weightValue: self weightValue
		slantValue: self slantValue ! !

!LogicalFont methodsFor: 'forwarded to realFont' stamp: 'tween 4/5/2007 08:30'!
characterFormAt: aCharacter
	^self realFont characterFormAt: aCharacter! !

!LogicalFont methodsFor: 'accessing' stamp: 'tween 8/18/2007 19:46'!
slantValue
	"Answer the value of slantValue"

	^ slantValue ifNil:[slantValue := 0]! !

!LogicalFont methodsFor: 'accessing' stamp: 'tween 3/16/2007 16:07'!
pointSize
	^pointSize! !

!LogicalFont methodsFor: '*Athens-Text' stamp: 'IgorStasenko 11/20/2013 14:12'!
asFreetypeFont
	^ self realFont asFreetypeFont! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:59'!
slantOblique
	^2! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 12:42'!
squeakWeightBold
	^1! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:52'!
weightLight
	^300! !

!LogicalFont class methodsFor: 'class initialization' stamp: 'tween 3/17/2007 10:50'!
initialize
	"
	self initialize.
	"
	Smalltalk addToShutDownList: self.  "should it be at a particular place in the list?"! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:51'!
weightThin
	^100! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:54'!
stretchCompressed
	^2! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:49'!
weightUltraThin
	^100! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:55'!
stretchSemiExpanded
	^6! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:55'!
stretchSemiExtended
	^6! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:55'!
stretchWide
	^6! !

!LogicalFont class methodsFor: 'instance creation' stamp: 'tween 8/27/2007 11:26'!
familyName: familyName pointSize: pointSize 
	
	^self familyName: familyName fallbackFamilyNames: nil pointSize: pointSize stretchValue: 5 weightValue: 400 slantValue: 0! !

!LogicalFont class methodsFor: 'instance creation' stamp: 'tween 8/27/2007 11:28'!
familyName: familyName fallbackFamilyNames: fallbackFamilyNames pointSize: pointSize 
	
	^self familyName: familyName fallbackFamilyNames: fallbackFamilyNames pointSize: pointSize stretchValue: 5 weightValue: 400 slantValue: 0! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:59'!
slantUpright
	^0! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 12:42'!
squeakSlantItalic
	^2! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:53'!
stretchUltraCompressed
	^1! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:50'!
weightExtraBold
	^800! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 12:00'!
slantKursiv
	^1! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:56'!
stretchExpanded
	^7! !

!LogicalFont class methodsFor: 'shutdown' stamp: 'tween 4/3/2007 16:19'!
shutDown: quitting 

	self  allSubInstances do: [:i | i clearRealFont].! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:58'!
slantNormal
	^0! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:51'!
weightExtraBlack
	^950! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:50'!
weightUltraBold
	^800! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:56'!
stretchUltraExpanded
	^9! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:52'!
weightNord
	^900! !

!LogicalFont class methodsFor: 'instance creation' stamp: 'tween 8/27/2007 11:24'!
familyName: familyName fallbackFamilyNames: fallbackFamilyNames pointSize: pointSize stretchValue: stretch weightValue: weight slantValue: slant

	"^self all asArray"
	"^(self all collect:[:each | each]) asArray"
	^self all
		detect:[:each |
			each familyName = familyName and:[
			each fallbackFamilyNames = fallbackFamilyNames and:[
			each pointSize = pointSize and:[
			each weightValue = weight and:[
			each stretchValue = stretch and:[
			each slantValue = slant]]]]]]
		ifNone:[
			self  new
				familyName: familyName; 
				fallbackFamilyNames: fallbackFamilyNames;
				pointSize: pointSize; 
				weightValue:weight;
				stretchValue: stretch;
				slantValue: slant;
				yourself]! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:52'!
weightMedium
	^500! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:59'!
slantBackslanted
	^2! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:58'!
slantRegular
	^0! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:58'!
slantRoman
	^0! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:56'!
stretchCondensed
	^3! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:54'!
stretchExtraCondensed
	^2! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:51'!
weightBold
	^700! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:49'!
weightExtraThin
	^100! !

!LogicalFont class methodsFor: 'accessing' stamp: 'tween 8/11/2007 01:22'!
all
	^all ifNil:[
		all := WeakSet new
			addAll: self allInstances;
			yourself]! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:59'!
slantSlanted
	^2! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:55'!
stretchExtraExpanded
	^8! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:51'!
weightUltraBlack
	^950! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:54'!
stretchNarrow
	^4! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:52'!
weightHeavy
	^900! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:57'!
stretchRegular
	^5! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:50'!
weightUltraLight
	^200! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:57'!
stretchExtended
	^7! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:58'!
slantBook
	^0! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:59'!
slantInclined
	^2! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 12:00'!
slantItalic
	^1! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 12:41'!
squeakStretchCondensed
	^8! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:55'!
stretchSemiCondensed
	^4! !

!LogicalFont class methodsFor: 'instance creation' stamp: 'tween 8/27/2007 11:24'!
familyName: familyName pointSize: pointSize stretchValue: stretch weightValue: weight slantValue: slant

	^self familyName: familyName fallbackFamilyNames: nil pointSize: pointSize stretchValue: stretch weightValue: weight slantValue: slant! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:55'!
stretchExtraExtended
	^8! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:49'!
weightExtraLight
	^200! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:55'!
stretchCompact
	^4! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:52'!
weightBlack
	^900! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:53'!
weightUltra
	^800! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:53'!
stretchUltraCondensed
	^1! !

!LogicalFont class methodsFor: 'instance creation' stamp: 'tween 8/11/2007 01:23'!
new
	
	^self all add: super new! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 12:00'!
slantCursive
	^1! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:56'!
stretchUltraExtended
	^9! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:57'!
weightRegular
	^400! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:52'!
weightDemi
	^600! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:50'!
weightDemiBold
	^600! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:50'!
weightSemiBold
	^600! !

!LogicalFont class methodsFor: 'emphasis values' stamp: 'tween 9/29/2007 11:53'!
stretchExtraCompressed
	^1! !

!LogicalFontManager commentStamp: 'LaurentLaffont 6/8/2011 22:20'!
I reference all font families available in the  system.

For example:

LogicalFontManager current allFamilies.

FreeTypeFontSelectorDialogWindow new open.
!
!LogicalFontManager methodsFor: 'accessing' stamp: 'tween 9/29/2007 09:14'!
addFontProvider: aFontProvider

	fontProviders addLast: aFontProvider
	! !

!LogicalFontManager methodsFor: 'font lookup' stamp: 'tween 8/18/2007 10:42'!
bestFontFor: aLogicalFont
	"look up best font from the receivers fontProviders"
	
	^self bestFontFor: aLogicalFont whenFindingAlternativeIgnoreAll: Set new
! !

!LogicalFontManager methodsFor: 'font lookup' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
bestFontFor: aLogicalFont whenFindingAlternativeIgnoreAll: ignoreSet
	"look up best real font from the receivers fontProviders.
	If we can't find a font, then answer an alternative real font.
	
	ignoreSet contains the LogicalFonts that we have already attempted to
	get an alternative real font from. We ignore those on each iteration so that we don't 
	recurse forever"
	| textStyle font |
	
	aLogicalFont familyNames do:[:familyName |
		fontProviders do:[:p | | answer |
			(answer := p fontFor: aLogicalFont familyName: familyName)
				ifNotNil:[^answer]].
		textStyle := TextStyle named: familyName.
		textStyle ifNotNil:[
			font := textStyle fontOfPointSize: aLogicalFont pointSize.
			font ifNotNil:[^font emphasized: aLogicalFont emphasis]]].
	"not found, so use the default TextStyle"
	textStyle := TextStyle default.
	textStyle ifNotNil:[
		font := textStyle fontOfPointSize: aLogicalFont pointSize.
		(font isKindOf: LogicalFont) ifFalse:[^font emphasized: aLogicalFont emphasis].
		(ignoreSet includes: font)
			ifFalse:[
				ignoreSet add: font.  "remember that we have visited font so that we don't loop forever"
				"try again using the default TextStyle's logicalFont"
				^self bestFontFor: font whenFindingAlternativeIgnoreAll: ignoreSet]].
	"Neither the family, nor any of the fallback families, is available. 
	Any non-LogicalFont will do as a fallback"
	(TextSharedInformation select: [:each | each isKindOf: TextStyle]) 
		do:[:ts | 
			((font := ts fontOfPointSize: aLogicalFont pointSize) isKindOf: LogicalFont)
				ifFalse:[^font emphasized:  aLogicalFont emphasis]].
	"There are no non-logical fonts in TextSharedInformation - let it fail by answering nil"
	^nil
	
			
! !

!LogicalFontManager methodsFor: 'initialization' stamp: 'tween 3/14/2007 22:56'!
initialize
	super initialize.
	fontProviders := OrderedCollection new: 10
	! !

!LogicalFontManager methodsFor: 'font families' stamp: 'GabrielOmarCotelli 12/3/2013 17:24'!
allFamilies
	"answer an Array containing all the font families from the receiver's fontProviders,
	together with any TextStyle font families, sorted by family name"

	| answer textStyleFamilies |
	answer := Set new.
	fontProviders do: [ :each | answer addAll: each families ].
	textStyleFamilies := TextStyle knownTextStylesWithoutDefault
		collect: [ :textStyleName | 
			TextStyleAsFontFamily new
				textStyle: (TextStyle named: textStyleName);
				familyName: textStyleName;
				yourself ].	"reject any textStyles whose defaultFont also appears as a fontFamily"
	textStyleFamilies := textStyleFamilies
		reject: [ :textStyleFamily | 
			| textStyleFamilyName |
			textStyleFamilyName := textStyleFamily textStyle defaultFont familyName.
			answer anySatisfy: [ :fontFamily | fontFamily familyName = textStyleFamilyName ] ].
	answer addAll: textStyleFamilies.
	^ (answer asSortedCollection: [ :a :b | a familyName <= b familyName ]) asArray! !

!LogicalFontManager methodsFor: '*FontInfrastructure-Tests' stamp: 'JurajKubelka 9/15/2014 17:42'!
identityIncludesFontProvider: aFreeTypeFontProvider 
	^ fontProviders identityIncludes: aFreeTypeFontProvider! !

!LogicalFontManager class methodsFor: 'accessing' stamp: 'AlainPlantec 9/17/2011 16:52'!
unload
	current ifNotNil: [current initialize].
	current := nil.
! !

!LogicalFontManager class methodsFor: 'accessing' stamp: 'tween 3/17/2007 13:53'!
current
	"
	current := nil.
	self current
	"
	^current ifNil:[current := self defaultCurrent]! !

!LogicalFontManager class methodsFor: 'instance creation' stamp: 'tween 9/8/2007 14:45'!
defaultCurrent
	^self new
		addFontProvider: FreeTypeFontProvider current;
		yourself! !

!LogicalFontManagerTest commentStamp: '<historical>'!
A LogicalFontManagerTest is a test class for testing the behavior of LogicalFontManager!
!LogicalFontManagerTest methodsFor: 'tests' stamp: 'JurajKubelka 9/17/2014 11:20'!
testHasCurrentFreeTypeFontProvider
	"If it fails, LogicalFontManager unload should be called."
	self assert: (LogicalFontManager current identityIncludesFontProvider: self currentProviderOrError)
	! !

!LogicalFontManagerTest methodsFor: 'accessing' stamp: 'JurajKubelka 9/17/2014 11:20'!
currentProviderOrError
	| provider |
	provider := FreeTypeFontProvider readSlotNamed: #current.
	self assert: provider notNil.
	^ provider! !

!LoginFailedException commentStamp: 'mir 5/12/2003 17:57'!
Exception for signaling login failures of protocol clients.
!
!LoginFailedException methodsFor: 'exceptiondescription' stamp: 'mir 2/15/2002 13:10'!
isResumable
	"Resumable so we can give the user another chance to login"

	^true! !

!LongMessageDialogWindow commentStamp: 'gvc 9/23/2008 11:36'!
Dialog window displaying a message with a single OK button. Escape/return will close. Icon is a themed information icon.
Handles long messages through use of a text editor with potential for scrolling.!
!LongMessageDialogWindow methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 8/27/2011 01:13'!
newTextMorph
	"Answer a new text editor morph."

	|tm|
	tm := (self
		newTextEditorFor: self
		getText: #entryText
		setText: #entryText:
		getEnabled: nil)
			styled: false;
			minWidth: Display width // 4;
			minHeight: Display height // 4;
			disable.
	^tm! !

!LongMessageDialogWindow methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 1/3/2011 08:14'!
isResizeable
	"Answer whether we are not we can be resized."

	^true! !

!LongMessageDialogWindow methodsFor: 'accessing' stamp: 'gvc 4/15/2008 22:11'!
entryText
	"Answer the value of entryText"

	^ entryText! !

!LongMessageDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 4/15/2008 22:52'!
newContentMorph
	"Answer a new content morph."

	self iconMorph: self newIconMorph.
	self textMorph: self newTextMorph.
	^self newGroupboxFor: (
		(self newRow: {self iconMorph. self textMorph})
			cellPositioning: #top;
			vResizing: #spaceFill)! !

!LongMessageDialogWindow methodsFor: 'accessing' stamp: 'gvc 4/15/2008 22:50'!
entryText: anObject
	"Set the value of entryText"

	entryText := anObject.
	self changed: #entryText! !

!LongMessageDialogWindow methodsFor: 'accessing' stamp: 'gvc 4/15/2008 22:11'!
text: aStringOrText
	"Set the text."
	
	|t|
	t := aStringOrText isString
		ifTrue: [aStringOrText asText addAttribute: (TextFontReference toFont: self textFont); yourself]
		ifFalse: [aStringOrText].
	self entryText: t! !

!LongTestCase commentStamp: 'DamirLaurent 5/2/2011 22:17'!
I'm a TestCase which takes time to run. I can be disabled using #doNotRunLongTestCases and enabled again using #runLongTestCases.

Tests that are long should be subclasses of myself.

I also provide a setting for the SettingsBrowser!
!LongTestCase class methodsFor: 'initialization' stamp: 'DamirLaurent 5/2/2011 21:32'!
initialize

	self runLongTestCases! !

!LongTestCase class methodsFor: 'accessing' stamp: 'DamirLaurent 5/2/2011 21:33'!
shouldRun
	"Return whether long tests should be run or not"
	
	RunLongTestCases ifNil: [self runLongTestCases].
	^ RunLongTestCases ! !

!LongTestCase class methodsFor: 'testing' stamp: 'md 2/22/2006 14:21'!
isAbstract
	"Override to true if a TestCase subclass is Abstract and should not have
	TestCase instances built from it"

	^self name = #LongTestCase
			! !

!LongTestCase class methodsFor: 'accessing' stamp: 'StephaneDucasse 10/18/2010 12:21'!
shouldRun: aBoolean
	"Set whether long tests should be run or not"
	
	RunLongTestCases := aBoolean! !

!LongTestCase class methodsFor: 'settings' stamp: 'StephaneDucasse 11/11/2014 18:42'!
runLongTestsSettingOn: aBuilder
	<systemsettings>
	
	(aBuilder setting: #shouldRun)
		target: self;
		parent: #pharoSystem ;
		label: 'Run Long Tests' ;
		description: 'Whether to run long SUnit TestCase. Tests which take long time to run should be subclasses of LongTestCase.'! !

!LongTestCase class methodsFor: 'accessing' stamp: 'StephaneDucasse 10/18/2010 14:02'!
allTestSelectors
	self shouldRun ifTrue: [
		^super testSelectors].
	^#().! !

!LongTestCase class methodsFor: 'accessing' stamp: 'StephaneDucasse 10/18/2010 12:21'!
doNotRunLongTestCases
	"Tells the system that long tests should not be run"
	
	self shouldRun: false! !

!LongTestCase class methodsFor: 'instance creation' stamp: 'StephaneDucasse 10/18/2010 14:02'!
buildSuite

	| suite |
	suite := self suiteClass new.
	self shouldRun ifTrue: [
		self addToSuiteFromSelectors: suite].
	^suite! !

!LongTestCase class methodsFor: 'accessing' stamp: 'StephaneDucasse 10/18/2010 12:21'!
runLongTestCases
	"Tell the system that long tests should be run"
	
	self shouldRun: true.! !

!LongTestCaseTest methodsFor: 'setup' stamp: 'StephaneDucasse 10/18/2010 12:20'!
tearDown

	LongTestCase shouldRun: longTestCaseSettingValue! !

!LongTestCaseTest methodsFor: 'testing' stamp: 'md 12/5/2004 21:28'!
testLongTestCaseRun
	"self debug: #testLongTestCaseRun"
	"self run: #testLongTestCaseRun"

	LongTestCase runLongTestCases.
	LongTestCaseTestUnderTest markAsNotRun.
	self deny: LongTestCaseTestUnderTest hasRun.
	LongTestCaseTestUnderTest suite run.
	self assert: LongTestCaseTestUnderTest hasRun.
	LongTestCase doNotRunLongTestCases.

	! !

!LongTestCaseTest methodsFor: 'setup' stamp: 'StephaneDucasse 10/18/2010 12:19'!
setUp

	longTestCaseSettingValue := LongTestCase shouldRun! !

!LongTestCaseTest methodsFor: 'testing' stamp: 'StephaneDucasse 10/18/2010 14:02'!
testLongTestCaseDoNotRun
	"self debug: #testLongTestCaseDoNotRun"
	"self run: #testLongTestCaseDoNotRun"

	LongTestCase doNotRunLongTestCases.
	LongTestCaseTestUnderTest markAsNotRun.
	self deny: LongTestCaseTestUnderTest hasRun.
	LongTestCaseTestUnderTest suite run.
	self deny: LongTestCaseTestUnderTest hasRun.


	! !

!LongTestCaseTestUnderTest methodsFor: 'testing' stamp: 'md 11/14/2004 21:30'!
testWhenRunMarkTestedToTrue


	RunStatus := true.! !

!LongTestCaseTestUnderTest class methodsFor: 'accessing' stamp: 'md 11/14/2004 21:37'!
markAsNotRun

	^ RunStatus := false! !

!LongTestCaseTestUnderTest class methodsFor: 'accessing' stamp: 'sd 9/25/2004 14:02'!
hasRun

	^ RunStatus! !

!LookupKey commentStamp: '<historical>'!
I represent a key for looking up entries in a data structure. Subclasses of me, such as Association, typically represent dictionary entries.!
!LookupKey methodsFor: 'accessing' stamp: ''!
key: anObject 
	"Store the argument, anObject, as the lookup key of the receiver."

	key := anObject! !

!LookupKey methodsFor: 'comparing' stamp: ''!
hash
	"Hash is reimplemented because = is implemented."

	^key hash! !

!LookupKey methodsFor: 'comparing' stamp: ''!
= aLookupKey

	self species = aLookupKey species
		ifTrue: [^key = aLookupKey key]
		ifFalse: [^false]! !

!LookupKey methodsFor: 'testing' stamp: 'ar 8/14/2001 22:39'!
isVariableBinding
	"Return true if I represent a literal variable binding"
	^true! !

!LookupKey methodsFor: 'accessing' stamp: 'ajh 9/12/2002 12:04'!
canAssign

	^ true! !

!LookupKey methodsFor: 'printing' stamp: ''!
printOn: aStream

	key printOn: aStream! !

!LookupKey methodsFor: 'testing' stamp: 'ar 8/14/2003 01:52'!
isSpecialReadBinding
	"Return true if this variable binding is read protected, e.g., should not be accessed primitively but rather by sending #value messages"
	^false! !

!LookupKey methodsFor: 'comparing' stamp: ''!
< aLookupKey 
	"Refer to the comment in Magnitude|<."

	^key < aLookupKey key! !

!LookupKey methodsFor: 'accessing' stamp: ''!
key
	"Answer the lookup key of the receiver."

	^key! !

!LookupKey methodsFor: 'accessing' stamp: 'ajh 3/24/2003 21:14'!
name

	^ self key isString
		ifTrue: [self key]
		ifFalse: [self key printString]! !

!LookupKey class methodsFor: 'instance creation' stamp: 'md 6/29/2005 16:34'!
key: aKey 
	"Answer an instance of me with the argument as the lookup up."

	^self basicNew key: aKey! !

!MBAbstractInfoList commentStamp: '<historical>'!
A MBAbstractInfoList is an abstraction used to hold information on groups, packages and projects.

Instance Variables
	groups:		a list of groups (MBGroupInfo instances)
	infoList:		<Object>
	packages:		<Object>
	projects:		<Object>
!
!MBAbstractInfoList methodsFor: 'accessing-computed' stamp: 'ChristopheDemarey 8/28/2012 14:31'!
projects
	"Return the list of dependent packages for the last baseline"

	| projectSpecs |
	projects
		ifNotNil: [ ^ projects ].
	projects := OrderedCollection new.
	self versionForInfoList ifNil: [ ^ projects ].
	projectSpecs := self versionForInfoList projects.
	projectSpecs := projectSpecs asSortedCollection: [ :a :b | a name <= b name ].
	projects
		addAll:
			(projectSpecs
				collect: [ :prjSpec | 
					(MBProjectInfo named: prjSpec name packageName: prjSpec projectPackage name spec: prjSpec)
						configurationInfo: self configurationInfo;
						yourself ]).
	^ projects! !

!MBAbstractInfoList methodsFor: 'updating' stamp: 'dkh 03/14/2011 07:17'!
fullRecalculate

	self recalculate! !

!MBAbstractInfoList methodsFor: 'private' stamp: 'dkh 3/2/2011 20:03'!
calculateInfoList

	^self subclassResponsibility ! !

!MBAbstractInfoList methodsFor: 'updating' stamp: 'dkh 4/12/2011 10:54'!
interestedInPackage: operation
	"potential currentVersion change"
	
	self fullRecalculate.
	^true! !

!MBAbstractInfoList methodsFor: 'updating' stamp: 'dkh 3/2/2011 20:14'!
interestedInPackageNamed: packageName
	packages notNil
		ifTrue: [ 
			(self packages detect: [ :info | info interestedInPackageNamed: packageName ] ifNone: [  ]) notNil
				ifTrue: [ ^ true ] ].
	^ false! !

!MBAbstractInfoList methodsFor: 'updating' stamp: 'dkh 3/10/2011 18:30'!
recalculate

	text := groups := validationResult := validationIcon := projects:= packages := nil.
	infoList == nil ifTrue: [ ^self ].
	self announcer announce: (MBInfoListChanged changed: self).
	infoList := nil! !

!MBAbstractInfoList methodsFor: 'accessing-computed' stamp: 'AlexandreBergel 8/2/2011 16:37'!
packages
	"Return the list of dependent packages for the last baseline"

	| packageSpecs |
	packages ~~ nil
		ifTrue: [ ^ packages ].
	self versionForInfoList ifNil: [ ^ #() ].
	packages := OrderedCollection new.
	packageSpecs := self versionForInfoList packages.
	packageSpecs := packageSpecs asSortedCollection: [ :a :b | a name <= b name ].
	packages
		addAll:
			(packageSpecs
				collect: [ :pkgSpec | 
					| packageName |
					(packageName := pkgSpec getFile) ifNil: [ packageName := pkgSpec name asString ].
					(MBPackageInfo named: packageName packageName: pkgSpec name asString spec: pkgSpec)
						configurationInfo: self configurationInfo;
						yourself ]).
	^ packages! !

!MBAbstractInfoList methodsFor: 'accessing-computed' stamp: 'AlexandreBergel 1/17/2012 17:34'!
infos
	"Return the list of info that are displayed"
	^self infoList! !

!MBAbstractInfoList methodsFor: 'updating' stamp: 'dkh 4/12/2011 10:46'!
recalculateIfInterestedInPackageNamed: packageName for: operation
	"keep projects separate, since I'm the only one interested in projects."
	(self interestedInPackageNamed: packageName)
		ifTrue: [ ^self interestedInPackage: operation ].
	projects notNil
		ifTrue: [ 
			(self projects detect: [ :info | info interestedInPackageNamed: packageName ] ifNone: [  ]) notNil
				ifTrue: [ ^self interestedInPackage: operation ] ].
	^false! !

!MBAbstractInfoList methodsFor: 'accessing-computed' stamp: 'dkh 3/2/2011 20:29'!
versionForInfoList

	^self subclassResponsibility ! !

!MBAbstractInfoList methodsFor: 'accessing-computed' stamp: 'dkh 3/10/2011 16:00'!
infoList
	infoList ~~ nil ifTrue: [ ^infoList ].
	^ infoList := self calculateInfoList! !

!MBAbstractInfoList methodsFor: 'testing' stamp: 'dkh 3/9/2011 22:15'!
isDirty
	^ self packages anySatisfy: [:each | each isDirty ]! !

!MBAbstractInfoList methodsFor: 'accessing-computed' stamp: 'dkh 3/6/2011 15:34'!
groups
	"Return the list of groups for the configuration"

	| groupSpecs |
	groups ~~ nil
		ifTrue: [ ^ groups ].
	groups := OrderedCollection new.
	self versionForInfoList ifNil: [ ^ groups ].
	groupSpecs := self versionForInfoList groups.
	groupSpecs := groupSpecs asSortedCollection: [ :a :b | a name <= b name ].
	groups
		addAll:
			(groupSpecs
				collect: [ :grpSpec | 
					(MBGroupInfo spec: grpSpec)
						configurationInfo: self configurationInfo;
						yourself ]).
	^ groups! !

!MBAbstractInfoList methodsFor: 'initialize-release' stamp: 'TorstenBergmann 1/22/2015 09:28'!
release

	packages := projects := groups := infoList := nil.
	super release.	! !

!MBAbstractPackageCommand commentStamp: '<historical>'!
For grouping package commands!
!MBAbstractPackageInfo commentStamp: '<historical>'!
A MBAbstractPackageInfo is an abstraction to represent both project and packages.

Instance Variables
	packageName:		name of the package
	workingCopy:		a MCWorkingCopy representing the version of the package in memory
!
!MBAbstractPackageInfo methodsFor: 'commands' stamp: 'ChristopheDemarey 9/17/2013 15:32'!
cmdOpenRepositoryCommand
	<command>
	^ VSOpenRepositoryCommand! !

!MBAbstractPackageInfo methodsFor: 'accessing' stamp: 'AlexandreBergel 3/5/2011 22:57'!
classForBrowsing
	self subclassResponsibility ! !

!MBAbstractPackageInfo methodsFor: 'commands' stamp: 'dkh 3/4/2011 05:00'!
cmdBrowse
	<command>
	^ MBBrowsePackageCommand! !

!MBAbstractPackageInfo methodsFor: 'accessing' stamp: 'dkh 2/23/2011 19:02'!
packageName

	^packageName! !

!MBAbstractPackageInfo methodsFor: 'commands' stamp: 'dkh 3/20/2011 10:36'!
cmdBrowsePackageChanges
	<command>
	^ MBPackageChangesCommand
	! !

!MBAbstractPackageInfo methodsFor: 'accessing' stamp: 'dkh 2/27/2011 15:37'!
workingCopy
	| pkg |
	workingCopy ~~ nil ifTrue: [ ^workingCopy ].
	pkg := MCPackage named: self packageName.
	pkg  hasWorkingCopy ifFalse: [ ^nil ].
	^workingCopy := pkg workingCopy! !

!MBAbstractPackageInfo methodsFor: 'accessing' stamp: 'dkh 2/23/2011 19:02'!
packageName: aString

	packageName := aString! !

!MBAbstractPackageInfo methodsFor: 'testing' stamp: 'DaleHenrichs 2/23/2011 17:29'!
isDirty
	| wc |
	wc := self workingCopy.
	wc ifNil: [ ^false ].
	^wc needsSaving! !

!MBAbstractPackageInfo class methodsFor: 'instance creation' stamp: 'AlexandreBergel 3/5/2011 21:57'!
named: infoName packageName: packageName spec: aMetacelloSpec
	"Create an instance of myself named infoName for the package named packageName"

	| answer |
	self assert: [ packageName isString ].
	self assert: [ packageName isSymbol not ].
	
	answer := super new.
	answer name: infoName.
	answer packageName: packageName.
	answer spec: aMetacelloSpec.
	^ answer! !

!MBAbstractPackageInfo class methodsFor: 'instance creation' stamp: 'dkh 2/27/2011 15:32'!
named: infoName

	^self named: infoName packageName: infoName spec: nil! !

!MBAbstractPackageInfo class methodsFor: 'instance creation' stamp: 'AlexandreBergel 1/16/2011 01:05'!
new
	self error: 'Please, use #named: to create an instance'! !

!MBAbstractTest commentStamp: 'TorstenBergmann 2/20/2014 14:13'!
Common superclass for test for Versionner!
!MBAbstractTest methodsFor: 'accessing' stamp: 'dkh 2/23/2011 15:19'!
configurationName

	^'ConfigurationOfDummyConfiguration'! !

!MBAbstractTest methodsFor: 'util' stamp: 'dkh 2/23/2011 15:17'!
removeClassIfExist: aSymbol
	Smalltalk globals at: aSymbol ifPresent: [ :cls | cls removeFromSystem ]! !

!MBAbstractTest methodsFor: 'running' stamp: 'dkh 2/23/2011 15:24'!
tearDown
	super tearDown.
	configuration := nil.
	self removeClassIfExist: self configurationName asSymbol
! !

!MBAbstractTest methodsFor: 'running' stamp: 'dkh 2/23/2011 21:17'!
setUp

	(Smalltalk globals includesKey: self configurationName asSymbol) 
		ifFalse: [ 
			MetacelloToolBox configurationNamed: self configurationName.
				(Smalltalk globals at: self configurationName asSymbol) compile: 'baseline10: spec 
        <version: ''1.0-baseline''>
        
        spec for: #common do: [
                spec blessing: #baseline.
                spec repository: ''http://www.squeaksource.com/Versionner''.
		    spec package: ''Collections-Streams''.
                ].'.

			(Smalltalk globals at: self configurationName asSymbol) compile: 'default: spec 
        <version: ''default''>
        
        spec for: #common do: [
                spec blessing: #baseline.
                spec repository: ''http://www.squeaksource.com/Versionner''.
		    spec package: ''Collections-Streams''.
                ].'.
			].
		
	configuration := (Smalltalk globals at: self configurationName asSymbol) 
! !

!MBAbstractTest class methodsFor: 'testing' stamp: 'topa 4/15/2011 09:50'!
isAbstract
	"Override to true if a TestCase subclass is Abstract and should not have
	TestCase instances built from it"
	
	^ self name = #MBAbstractTest! !

!MBAbstractVersionInfo commentStamp: 'TorstenBergmann 2/20/2014 14:12'!
Abstract info for a version in Versionner!
!MBAbstractVersionInfo methodsFor: 'accessing' stamp: 'dkh 3/5/2011 17:56'!
currentVersion

	^self configurationInfo currentVersion! !

!MBAbstractVersionInfo methodsFor: 'testing' stamp: 'dkh 3/1/2011 21:08'!
hasValidationIssues
	validationResult == nil ifTrue: [ ^false ].
	^validationResult notEmpty! !

!MBAbstractVersionInfo methodsFor: 'private' stamp: 'ChristopheDemarey 11/13/2013 13:33'!
calculateInfoList
	| answer list cvs cv |
	answer := OrderedCollection new.
	cvs := ''.
	(cv := self versionForInfoList) 
		ifNil:  [cvs := cv versionString, ' '].
	(list := self projects) 
		ifNotEmpty: [ 
			answer add: (MBLabelInfo new name: ' -- ', cvs, 'projects --').
			answer addAll: list.
			answer add: (MBLabelInfo new name: '') ].
	(list := self packages)
		ifNotEmpty: [ 
			answer add: (MBLabelInfo new name: ' -- ', cvs, 'packages --').
			answer addAll: list.
			answer add: (MBLabelInfo new name: '') ].
	(list := self groups)
	 		ifNotEmpty: [
			answer add: (MBLabelInfo new name: ' -- ', cvs, 'groups --').
			answer addAll: list ].
	^ answer! !

!MBAbstractVersionInfo methodsFor: 'accessing' stamp: 'dkh 3/5/2011 17:50'!
configurationInfo
	^ configurationInfo! !

!MBAbstractVersionInfo methodsFor: 'accessing' stamp: 'dkh 3/2/2011 16:44'!
validate
	validationResult == nil
		ifTrue: [ 
			validationIcon := nil.
			validationResult := MetacelloToolBox validateProject: self project version: self version versionString ].
	^ validationResult! !

!MBAbstractVersionInfo methodsFor: 'commands' stamp: 'ChristopheDemarey 10/24/2013 17:57'!
cmdRemove
	<command>
	^ VSRemoveCommand! !

!MBAbstractVersionInfo methodsFor: 'accessing' stamp: 'ChristopheDemarey 2/11/2014 15:54'!
configurationBasename
	^ self configurationClass name configurationBaseName! !

!MBAbstractVersionInfo methodsFor: 'accessing' stamp: 'dkh 3/2/2011 16:42'!
project
	"Answer the MetacelloProject associated with the receiver."
	
	^self version project! !

!MBAbstractVersionInfo methodsFor: 'accessing' stamp: 'dkh 2/23/2011 12:57'!
version
	^ version! !

!MBAbstractVersionInfo methodsFor: 'testing' stamp: 'dkh 3/2/2011 16:43'!
isStable
	^ (self project hasVersion: #stable) and: [ 
		(self project version: #stable) = self version ]! !

!MBAbstractVersionInfo methodsFor: 'testing' stamp: 'dkh 3/2/2011 16:43'!
isBleedingEdge
	^  (self project hasVersion: #bleedingEdge) and: [
		(self project version: #bleedingEdge) = self version ]! !

!MBAbstractVersionInfo methodsFor: 'commands' stamp: 'ChristopheDemarey 10/24/2013 17:57'!
cmdLoad
	<command>
	^ VSLoadCommand! !

!MBAbstractVersionInfo methodsFor: 'accessing' stamp: 'dkh 3/5/2011 17:55'!
configurationClass
	^ self configurationInfo configurationClass! !

!MBAbstractVersionInfo methodsFor: 'accessing' stamp: 'dkh 3/19/2011 10:42'!
versionString
	^ self version versionString! !

!MBAbstractVersionInfo methodsFor: 'accessing-computed' stamp: 'dkh 3/2/2011 20:29'!
versionForInfoList

	^self version ! !

!MBAbstractVersionInfo methodsFor: 'commands' stamp: 'ChristopheDemarey 10/24/2013 17:49'!
cmdBrowse
	<command>
	^ VSBrowseVersionCommand! !

!MBAbstractVersionInfo methodsFor: 'accessing' stamp: 'dkh 3/5/2011 17:50'!
configurationInfo: anObject
	configurationInfo := anObject! !

!MBAbstractVersionInfo methodsFor: 'testing' stamp: 'dkh 3/2/2011 16:44'!
isDevelopment
	^  (self project hasVersion: #development) and: [
		(self project version: #development) = self version ]! !

!MBAbstractVersionInfo methodsFor: 'testing' stamp: 'JuanPabloSandovalAlcocer 1/8/2012 18:10'!
isCurrentVersion
	|cv|
	(cv := self currentVersion) ~~ nil
		ifTrue: [ 
			cv = self version
				ifTrue: [^ true]].
	^false.! !

!MBAbstractVersionInfo methodsFor: 'printing' stamp: 'dkh 3/6/2011 15:15'!
printOn: aStream
	| cv |
	(cv := self currentVersion) ~~ nil
		ifTrue: [ 
			cv = self version
				ifTrue: [ aStream nextPutAll: ' @ ' ] ].
	super printOn: aStream.
! !

!MBAbstractVersionInfo methodsFor: 'accessing' stamp: 'dkh 2/23/2011 14:13'!
version: aMetacelloVersion

	version := aMetacelloVersion.
	self name: aMetacelloVersion versionString.
	
! !

!MBAbstractVersionInfo class methodsFor: 'instance creation' stamp: 'dkh 3/6/2011 15:32'!
version: aMetacelloVersion

	^ super new 
		version: aMetacelloVersion;
		yourself! !

!MBAbstractVersionInfo class methodsFor: 'instance creation' stamp: 'AlexandreBergel 3/1/2011 08:49'!
new
	self error: 'Please use version:browser: or version: instead'! !

!MBAbstractVersionInfoTest commentStamp: 'TorstenBergmann 2/20/2014 14:20'!
Abstract superclass for version info tests for Versionner!
!MBAbstractVersionInfoTest class methodsFor: 'testing' stamp: 'topa 4/15/2011 14:58'!
isAbstract
	"Override to true if a TestCase subclass is Abstract and should not have
	TestCase instances built from it"
	
	^ self name = #MBAbstractVersionInfoTest! !

!MBAddConfigurationCommand commentStamp: 'TorstenBergmann 2/20/2014 14:09'!
Command to add a configuration in Versionner!
!MBAddConfigurationCommand methodsFor: 'private' stamp: 'dkh 3/4/2011 16:21'!
workingCopies
	^ MCWorkingCopy allManagers asSortedCollection: [ :a :b | a name <= b name]! !

!MBAddConfigurationCommand methodsFor: 'private' stamp: 'ChristopheDemarey 10/18/2012 11:01'!
collectPackages: addedPackages andProjects: addedConfigurations pattern: patternString repository: repository
	| packagePattern package |
	packagePattern := self  uiManager
		request: 'Please enter a pattern to filter package names that will be candidates to add to configuration'
		initialAnswer: patternString.
	packagePattern ifNil: [ ^ self ].
	[ 
	| packageNames workingCopies |
	packageNames := OrderedCollection new.
	workingCopies := OrderedCollection new.
	self workingCopies
		do: [ :pkg | 
			((packagePattern match: pkg package name) and: [ (addedPackages includes: pkg package name) not ])
				ifTrue: [ 
					packageNames add: pkg package name.
					workingCopies add: pkg ] ].
	package := self uiManager
		chooseFrom: packageNames
		values: workingCopies
		title: 'Add dependent package (cancel to stop)'.
	package
		ifNotNil: [ 
			(package package name beginsWith: 'ConfigurationOf')
				ifTrue: [ addedConfigurations add: package package name ]
				ifFalse: [ addedPackages add: package package name ].
			package ancestry ancestors isEmpty
				ifTrue: [ 
					(self uiManager
						confirm:
							'The package: ' , package package name printString , ' has not been committed yet. Would you like to commit it into the '
								, repository description printString, ' repository?')
						ifTrue: [ 
							package repositoryGroup repositories size <= 1
								ifTrue: [ package repositoryGroup addRepository: repository ].
							package currentVersionInfo ] ] ].
	package notNil ] whileTrue.
	(addedPackages isEmpty and: [ addedConfigurations isEmpty ])
		ifTrue: [ self uiManager inform: 'No package or configuration added. No baseline has been created' ]! !

!MBAddConfigurationCommand methodsFor: 'private' stamp: 'ChristopheDemarey 10/18/2012 11:32'!
repositoryFor: projectName
	| repositories repository |
	repositories := self repositories
		select: [ :repo | (repo description beginsWith: 'http:') and: [ repo description endsWith: projectName ] ].
	repository := nil.
	(repositories anySatisfy: [ :http | http description = ('http://www.squeaksource.com/' , projectName) ])
		ifFalse: [ 
			(self uiManager confirm: 'Would you like to use http://www.squeaksource.com/' , projectName , ', for your project?')
				ifTrue: [ ^ MCHttpRepository location: 'http://www.squeaksource.com/' , projectName user: '' password: '' ] ].
	repository isNil
		ifTrue: [ 
			repository := repositories isEmpty
				ifTrue: [ self chooseRepositoryFromList: self repositories ]
				ifFalse: [ self chooseRepositoryFromList: repositories , self repositories ] ].
	^ repository! !

!MBAddConfigurationCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 10/18/2012 11:00'!
askForClassName
	^ self uiManager
		request: 'Name of the new Metacello configuration (e.g., ConfigurationOfYourSoftware)' translated
		initialAnswer: 'ConfigurationOf'! !

!MBAddConfigurationCommand methodsFor: 'documentation' stamp: 'dkh 3/4/2011 16:25'!
documentation
	^ 'Create a new configuration. Prompt for packages and dependent projects. Create a baseline version and an initial development version'! !

!MBAddConfigurationCommand methodsFor: 'accessing' stamp: 'dkh 4/7/2011 21:52'!
title
	^ 'add configuration'! !

!MBAddConfigurationCommand methodsFor: 'execute' stamp: 'TesterBob 10/11/2012 17:09'!
executeAddBaselineForConfigurationNamed: aConfigurationClassName repositoryDescription: repositoryDescription versionString: versionString packages: packageNames configurations: configurationNames
	| baselineVersionString |
	baselineVersionString := versionString , '-baseline'.
	MetacelloToolBox
		createBaseline: baselineVersionString
			for: aConfigurationClassName
			repository: repositoryDescription
			requiredProjects: configurationNames
			packages: packageNames
			repositories: { aConfigurationClassName, repositoryDescription }
			dependencies: {}
			groups: {('default' -> packageNames)};
		createDevelopment: versionString
			for: aConfigurationClassName
			importFromBaseline: baselineVersionString
			description: ''! !

!MBAddConfigurationCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 2/11/2014 15:55'!
execute
	| configurationClassName versionNumber addedPackages addedConfigurations repository projectName mcPackage workingCopy configInfo|
	configurationClassName := self askForClassName.
	configurationClassName ifNil: [ ^ self ].
	Smalltalk globals
		at: configurationClassName asSymbol
		ifPresent: [ :ex | ^ self error: 'Class ' , configurationClassName printString , ' already exist' ].
	projectName := configurationClassName name configurationBaseName.
	(repository := self repositoryFor: projectName) ifNil: [ ^ self ].

	versionNumber := self uiManager request: 'Enter initial version number' 
										     initialAnswer: '1.0'.
	versionNumber ifNil: [ ^ self ].
	addedPackages := OrderedCollection new.
	addedConfigurations := OrderedCollection new.
	
	self collectPackages: addedPackages
		 andProjects: addedConfigurations 
		 pattern: projectName , '*' 
		 repository: repository.
	self
		executeAddBaselineForConfigurationNamed: configurationClassName
		repositoryDescription: repository description
		versionString: versionNumber
		packages: addedPackages
		configurations: addedConfigurations.
	
	mcPackage := MCPackage named: configurationClassName.
	workingCopy := mcPackage workingCopy.
	workingCopy repositoryGroup addRepository: repository.
	"after all save configuration"
	configInfo := (MBConfigurationInfo 
						configurationClass: (Smalltalk globals at: (configurationClassName asSymbol)))
						configurationRoot: (MBConfigurationRoot current);
						yourself.
	"fixing"
	(MBSaveConfigurationCommand 
				target: configInfo 
				for: requestor) executeWithMessage: 'Creating ConfigurationOf', projectName.
	! !

!MBAddConfigurationCommand methodsFor: 'ordering' stamp: 'dkh 4/7/2011 22:20'!
order

	^'20'! !

!MBAddConfigurationCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 10/11/2012 17:21'!
executeAddBaselineForConfigurationNamed: aConfigurationClassName repositoryDescription: repositoryDescription versionString: versionString packages: packageNames configurations: configurationNames repositories: repositories
	| baselineVersionString |
	baselineVersionString := versionString , '-baseline'.
	MetacelloToolBox
		createBaseline: baselineVersionString
			for: aConfigurationClassName
			repository: repositoryDescription
			requiredProjects: configurationNames
			packages: packageNames
			repositories: repositories
			dependencies: {}
			groups: {('default' -> packageNames)};
		createDevelopment: versionString
			for: aConfigurationClassName
			importFromBaseline: baselineVersionString
			description: ''! !

!MBAddConfigurationCommandTest methodsFor: 'as yet unclassified' stamp: 'AlexandreBergel 3/27/2011 23:36'!
testExecute
	| t v |
	t := false.
	command := MBAddConfigurationCommand target: self for: nil.
	[[command execute] valueSupplyingAnswer: self configurationName  ] 
		on: Error do: [:ex | 
			t := ex messageText = 'Class #ConfigurationOfMetacello_Command_Tests already exist' ].
	self assert: t.
	
	v := 10000 atRandom.
	self should: [[command execute] valueSupplyingAnswers: 
		{{'Name of the new Metacello configuration (e.g., ConfigurationOfYourSoftware)'  . self configurationName, v asString  } .
		  {'Enter initial version number' . '1.0'} ".
		  {'Would you like to use http://www.squeaksource.com/Metacello_Command_Tests2, for your project?' . true}"
		}] raise: Exception.
		
	self deny: (Smalltalk globals includesKey: (self configurationName, v asString) asSymbol ).
! !

!MBAddRepositoryCommand commentStamp: 'TorstenBergmann 2/20/2014 14:09'!
Command to add a repository in Versionner!
!MBAddRepositoryCommand methodsFor: 'documentation' stamp: 'dkh 4/8/2011 11:44'!
documentation
	^ 'Add a Monticello repository to the default repository group.'! !

!MBAddRepositoryCommand methodsFor: 'accessing' stamp: 'dkh 4/8/2011 11:45'!
title
	^ 'add repository'! !

!MBAddRepositoryCommand methodsFor: 'as yet unclassified' stamp: 'ChristopheDemarey 10/19/2012 11:20'!
newRepository
	"Create a new monticello repository"
	| types index |
	types := MCRepository allConcreteSubclasses asArray.
	index := self uiManager chooseFrom: (types collect: [:ea | ea description])
				title: 'Repository type:'.
	^ index = 0 ifFalse: [(types at: index) perform: #morphicConfigure]! !

!MBAddRepositoryCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 10/19/2012 11:21'!
execute

	self newRepository ifNotNil:
		[:repos | MCRepositoryGroup default addRepository: repos ].


	! !

!MBAnnouncement commentStamp: 'TorstenBergmann 2/20/2014 14:04'!
Common superclass for Versionner announcements!
!MBAnnouncement methodsFor: 'accessing' stamp: 'dkh 03/12/2011 02:09'!
configurationInfo

	^nil! !

!MBBaselineInfo commentStamp: '<historical>'!
A MBBaselineInfo holds information on a baselinf of a configuration.

!
!MBBaselineInfo methodsFor: 'printing' stamp: 'DaleHenrichs 2/24/2011 18:23'!
printOn: aStream
	super printOn: aStream.
	self isBleedingEdge 
		ifTrue: [ aStream nextPutAll: ' #bleedingEdge' ].! !

!MBBaselineInfo methodsFor: 'commands' stamp: 'dkh 3/4/2011 04:59'!
cmdCopyBaseline
	<command>
	^ MBCopyBaselineCommand! !

!MBBaselineInfo class methodsFor: 'accessing' stamp: 'dkh 4/10/2011 19:56'!
helpLabel

	^'Baseline'! !

!MBBaselineInfoTest commentStamp: 'TorstenBergmann 2/20/2014 14:19'!
SUnit tests for MBBaselineInfo in Versionner!
!MBBaselineInfoTest methodsFor: 'tests' stamp: 'DaleHenrichs 03/08/2011 13:49'!
testCopyBaseline
	| configurationInfo baselineInfo |
	configurationInfo := MBConfigurationInfo configurationClass: configuration.
	baselineInfo := configurationInfo baselines detect: [:inf | inf version versionString = '1.0-baseline'].
	self assert: (baselineInfo isKindOf: MBBaselineInfo).

	[  (MBCopyBaselineCommand target: baselineInfo for: browser) copyBaselineWithNumber: '1.1'] 
		valueSupplyingAnswer: 'this is my comment'.
 
	self assert: (configuration compiledMethodAt: #baseline11: ifAbsent: []) notNil.
	self assert: (configuration sourceCodeAt: #baseline11:) =   'baseline11: spec
	<version: ''1.1-baseline''>

	spec for: #''common'' do: [
		spec blessing: #''baseline''.
		spec description: ''this is my comment''.
		spec repository: ''http://www.squeaksource.com/Versionner''.
		spec package: ''Collections-Streams''. ].
'! !

!MBBaselineInfoTest methodsFor: 'running' stamp: 'dkh 4/18/2011 20:22'!
expectedFailures 
	true ifTrue: [ ^#() ].
	^ #(#testcalculateInfoList)! !

!MBBaselineInfoTest methodsFor: 'tests' stamp: 'ChristopheDemarey 8/31/2012 17:45'!
testcalculateInfoList

	"Doesn't work!!
	 Need to use a real configuration with all information "
	"info := (MBBaselineInfo version: (MBVersionInfo version: (MetacelloMCVersion fromString: '1.0-baseline')))
		configurationInfo: (MBConfigurationInfo configurationClass: configuration).
		
	info calculateInfoList"! !

!MBBaselineInfoTest methodsFor: 'tests' stamp: 'dkh 3/19/2011 10:42'!
testInstantiation
	|  configurationInfo baseline |

	self should: [ MBBaselineInfo new ] raise: Error.
	self 
		shouldnt: [	configurationInfo := MBConfigurationInfo configurationClass: configuration.
	baseline := configurationInfo baselines detect: [:inf | inf version versionString = '1.0-baseline'].
] 
		raise: Error.
	
	self assert: (baseline versionString = '1.0-baseline').
	self assert: (info configurationInfo configurationClass == (Smalltalk at: #ConfigurationOfDummyConfiguration))! !

!MBBaselineInfoTest methodsFor: 'running' stamp: 'dkh 3/6/2011 20:33'!
setUp
	| configurationInfo |
	super setUp.
	configurationInfo := MBConfigurationInfo configurationClass: configuration.
	info := configurationInfo baselines detect: [:inf | inf version versionString = '1.0-baseline']
! !

!MBBrowsePackageCommand commentStamp: 'TorstenBergmann 2/20/2014 14:05'!
Command to browse a package in versionner!
!MBBrowsePackageCommand methodsFor: 'accessing' stamp: 'dkh 3/2/2011 14:05'!
title
	^ 'browse'! !

!MBBrowsePackageCommand methodsFor: 'execute' stamp: 'dkh 3/2/2011 14:07'!
execute
	target classForBrowsing browse! !

!MBBrowsePackageCommand methodsFor: 'documentation' stamp: 'dkh 3/2/2011 14:05'!
documentation
	^ 'Open a system browser on the selected project configuration or package.'! !

!MBCheckpointDevCommand commentStamp: 'TorstenBergmann 2/20/2014 14:10'!
Command for a check point in Versionner!
!MBCheckpointDevCommand methodsFor: 'execute' stamp: 'AlexandreBergel 4/15/2011 10:22'!
executeWithMessage: message
	| configClass |
	configClass := self configurationClass.
	self checkUserInRepositoryOfPackage: configClass name asString.
	MetacelloToolBox saveModifiedPackagesAndConfigurationIn: configClass description: message.
! !

!MBCheckpointDevCommand methodsFor: 'documentation' stamp: 'dkh 3/5/2011 13:45'!
documentation
	^ 'Save modified packages in their respective repository, update the configuration and save a version of the configuration in it''s repository.'! !

!MBCheckpointDevCommand methodsFor: 'ordering' stamp: 'dkh 4/7/2011 22:20'!
order

	^'50'! !

!MBCheckpointDevCommand methodsFor: 'accessing' stamp: 'dkh 3/5/2011 13:44'!
title
	^ 'checkpoint dev'! !

!MBCheckpointDevCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 2/11/2014 15:55'!
execute
	| message configClass |
	configClass := self configurationClass.
	message := self uiManager
		multilineRequest:
			'Enter commit message for ' , (configClass name configurationBaseName) , ' '
				, (target project version: #development) versionString
		initialAnswer: (target project version: #development) versionString, ' ():'.
	message == nil
		ifTrue: [ ^ self ].
	self executeWithMessage: message
! !

!MBCommand commentStamp: '<historical>'!
MBCommand is a command design pattern for capturing actions.!
!MBCommand methodsFor: 'versions' stamp: 'ChristopheDemarey 11/6/2012 16:15'!
compiledMethodForVersion: aMetacelloVersion

	| toolbox pragma |
	toolbox := MetacelloToolBox new project: aMetacelloVersion project.
	pragma := (toolbox constructor extractAllVersionPragmas at: aMetacelloVersion versionString ifAbsent: [ ^ nil ]) first.
	^pragma method! !

!MBCommand methodsFor: 'accessing' stamp: 'dkh 3/4/2011 06:16'!
targetNode
	^ targetNode! !

!MBCommand methodsFor: 'changes' stamp: 'ChristopheDemarey 10/19/2012 11:06'!
findChangesBetween: versionSnapshot toLabel: toLabel and: ancestorVersionSnapshot fromLabel: fromLabel
	"View changes between 2 versions."
	| patch |
	
	patch := versionSnapshot patchRelativeToBase: ancestorVersionSnapshot.
	patch isNil ifTrue: [^ self].
	patch isEmpty
		ifTrue: [
			self uiManager inform: 'No changes' ]
		ifFalse: [
			self
				viewChanges: patch
				from: fromLabel
				to: toLabel
				title: 'Changes between ', fromLabel, ' and ', toLabel   ]! !

!MBCommand methodsFor: 'repositories' stamp: 'DaleHenrichs 03/07/2011 15:59'!
checkUserInRepositoryOfPackage: packageName
	"Try to find the http repository of packageName. If it does not find one, then add one and ask for the username and password"

	| repo |
	(repo := self repositoryOfPackageNamed: packageName) ifNil: [ ^nil ].
	self checkUserInRepository: repo.
	^repo! !

!MBCommand methodsFor: 'repositories' stamp: 'dkh 4/17/2011 13:11'!
configurationReferencesFrom: aRepository

	| map |
	map := Dictionary new.
	aRepository goferReferences do: [ :ref | 
		(ref packageName beginsWith: 'ConfigurationOf')
			ifTrue: [ | nameWithBranch |
				nameWithBranch := ref metacelloPackageNameWithBranch at: 2.
				(map at: nameWithBranch ifAbsent: [map at: nameWithBranch put: OrderedCollection new]) add: ref ]].
	^map! !

!MBCommand methodsFor: 'initialize-release' stamp: 'ChristopheDemarey 11/13/2013 13:22'!
initialize
	super initialize.
! !

!MBCommand methodsFor: 'repositories' stamp: 'dkh 3/5/2011 15:57'!
repositories
	^MCRepositoryGroup default repositories! !

!MBCommand methodsFor: 'accessing' stamp: 'ChristopheDemarey 10/18/2012 10:46'!
title
	^ 'Abstract Command'! !

!MBCommand methodsFor: 'versions' stamp: 'ChristopheDemarey 10/18/2012 17:38'!
browseVersionHistory
	"Used to browse version history of a Configuration package or a package"
	
	target workingCopy ancestors isEmpty
		ifTrue: [ ^ self ].
	(MCVersionHistoryBrowser new ancestry: target workingCopy ancestors first) perform: #show! !

!MBCommand methodsFor: 'utility' stamp: 'dkh 3/4/2011 05:21'!
on: anObject for: aRequestor
	^ self class on: anObject for: aRequestor! !

!MBCommand methodsFor: 'documentation' stamp: 'dkh 4/10/2011 19:14'!
helpDocumentation
	^self documentation! !

!MBCommand methodsFor: 'changes' stamp: 'ChristopheDemarey 10/19/2012 11:13'!
findChangesFor: workingCopy relativeToRepository: repository
	| patch fromDescription |
	repository isNil
		ifTrue: [ ^ self ].
	patch := workingCopy changesRelativeToRepository: repository.
	patch isNil
		ifTrue: [ ^ self ].
	patch isEmpty
		ifTrue: [ 
			workingCopy modified: false.
			self uiManager inform: 'No changes' ]
		ifFalse: [ 
			workingCopy modified: true.
			fromDescription := workingCopy packageName , ' (' , workingCopy ancestry ancestorString , ')'.
			self
				viewChanges: patch
				from: fromDescription
				to: ('Modified {1}' translated format: {(workingCopy description)}) 
				title: ('Changes to {1}' translated format: {fromDescription}) ]! !

!MBCommand methodsFor: 'accessing' stamp: 'dkh 3/6/2011 16:08'!
requestor: aRequestor

	requestor := aRequestor ! !

!MBCommand methodsFor: 'utility' stamp: 'ChristopheDemarey 10/18/2012 11:02'!
selectRepositoryFromWorkingCopy: workingCopy
	| repos repo |
	repos := workingCopy repositoryGroup repositories.
	repos size = 0
		ifTrue: [ ^ self uiManager  inform: 'No repositories associated with ' , target name printString ].
	repo := repos size = 1
		ifTrue: [ repos first ]
		ifFalse: [ 
			self uiManager 
				chooseFrom: (repos collect: [ :r | r description ])
				values: repos
				title: 'Please choose which repository to use for diff' ].
	^ repo! !

!MBCommand methodsFor: 'utility' stamp: 'ChristopheDemarey 10/18/2012 10:57'!
uiManager

	^ UIManager default! !

!MBCommand methodsFor: 'accessing' stamp: 'fds 2/26/2011 20:01'!
target: anObject
	target := anObject! !

!MBCommand methodsFor: 'utility' stamp: 'ChristopheDemarey 10/18/2012 11:01'!
chooseRepositoryFromList: repos
	"Return the repository of the configuration. Create one (using UI) if necessary"

	repos size > 1
		ifTrue: [ 
			^ self uiManager
				chooseFrom: (repos collect: [ :repo | repo description ])
				values: repos
				title: 'Select repository' ].
	^ repos first! !

!MBCommand methodsFor: 'repositories' stamp: 'ChristopheDemarey 10/18/2012 15:17'!
pickRepositoryFrom: repositories title: title
	| index |
	index := self uiManager chooseFrom: (repositories collect: [ :ea | ea description ]) title: title.
	^ index = 0
		ifFalse: [ repositories at: index ] ! !

!MBCommand methodsFor: 'repositories' stamp: 'ChristopheDemarey 2/11/2014 15:54'!
repositoryOfPackageNamed: packageName
	"Return the repository of the configuration. Create one (using UI) if necessary"

	| mcPackage workingCopy repositories repository repositoryIndex username password |
	mcPackage := MCPackage named: packageName.
	workingCopy := mcPackage workingCopy.
	repositories := workingCopy repositoryGroup repositories reject: [ :rep | rep == MCCacheRepository default ].
	repositories
		ifEmpty: [ 
			| projectName answer squeakSourceURL |
			projectName := self configurationClass name configurationBaseName.
			squeakSourceURL := 'http://www.squeaksource.com/' , projectName.
			answer := self uiManager
				confirm: 'No repository associated with your project. Do you want to add ' , squeakSourceURL.
			answer
				ifFalse: [ 
					self uiManager  inform: 'Add a http repository with Monticello browser'.
					^ nil ].
			repository := MCHttpRepository location: squeakSourceURL user: '' password: ''.
			repository user isEmpty
				ifTrue: [ username := self username ].
			repository password isEmpty
				ifTrue: [ password := self password ].
			workingCopy repositoryGroup
				addRepository: (repository := MCHttpRepository location: squeakSourceURL user: username password: password) ].
	repositories size > 1
		ifTrue: [ 
			repositoryIndex := self uiManager chooseFrom: (repositories collect: #printString).
			repositoryIndex = 0
				ifTrue: [ ^ nil ].
			repository := repositories at: repositoryIndex ].
	repositories size = 1
		ifTrue: [ repository := repositories first ].
	^ repository! !

!MBCommand methodsFor: 'accessing-computed' stamp: 'ChristopheDemarey 2/11/2014 15:54'!
projectName
	^ self configurationClass name configurationBaseName! !

!MBCommand methodsFor: 'repositories' stamp: 'ChristopheDemarey 10/18/2012 11:32'!
password
	| password |
	password := target configurationRoot password. 
	password ifNotNil: [ ^ password ].
	password := self uiManager requestPassword: 'enter your Monticello password for '.
	target configurationRoot password: password.
	^ password! !

!MBCommand methodsFor: 'ordering' stamp: 'fds 2/26/2011 10:46'!
order
	^ self title! !

!MBCommand methodsFor: 'versions' stamp: 'ChristopheDemarey 10/18/2012 11:32'!
askForVersionNumber
	"Return a new version number as a string"

	| latestVersion newVersion versions |
	newVersion := (versions := target configurationInfo versions) isEmpty
		ifTrue: [ '1.0' ]
		ifFalse: [ 
			latestVersion := versions first version.
			latestVersion versionNumber copy incrementMinorVersionNumber printString ].
	^ self uiManager  request: 'enter new version number' initialAnswer: newVersion! !

!MBCommand methodsFor: 'repositories' stamp: 'ChristopheDemarey 10/18/2012 11:32'!
username
	| username |
	username := target configurationRoot username. 
	username ifNotNil: [ ^ username ].
	username := self uiManager request: 'enter your Monticello username (login)'.
	target configurationRoot username: username.
	^ username! !

!MBCommand methodsFor: 'changes' stamp: 'ChristopheDemarey 10/19/2012 11:05'!
viewChanges: patch from: fromDescription to: toDescription title: title
	"Open a browser on the given patch."

	^ ( PSMCPatchMorph forPatch:  patch)
			fromDescription: fromDescription;
			toDescription:  toDescription;
			newWindow;
			title: title;
			open ! !

!MBCommand methodsFor: 'repositories' stamp: 'dkh 3/5/2011 16:02'!
pickRepository
	^ self pickRepositoryFrom: self repositories.
! !

!MBCommand methodsFor: 'accessing-computed' stamp: 'ChristopheDemarey 8/23/2013 18:44'!
configurationClass
	^ target! !

!MBCommand methodsFor: 'documentation' stamp: 'fds 2/26/2011 10:48'!
documentation
	self subclassResponsibility! !

!MBCommand methodsFor: 'repositories' stamp: 'ChristopheDemarey 10/18/2012 11:32'!
checkUserInRepository: repository
	"Try to find the http repository of packageName. If it does not find one, then add one and ask for the username and password"

	| answerUser |
	(repository isKindOf: MCHttpRepository ) ifFalse: [ ^self ].
	repository user
		ifEmpty: [ 
			answerUser := self uiManager confirm: 'No user defined. Do you want to add one? '.
			answerUser
				ifTrue: [ 
					repository user: self username.
					repository password: self password ] ]! !

!MBCommand methodsFor: 'repositories' stamp: 'ChristopheDemarey 10/18/2012 15:42'!
pickRepositoryFrom: repositories

	^self pickRepositoryFrom: repositories title: 'Choose repository'! !

!MBCommand methodsFor: 'execute' stamp: 'fds 2/26/2011 19:45'!
execute
	self subclassResponsibility ! !

!MBCommand methodsFor: 'accessing' stamp: 'fds 2/26/2011 20:01'!
target
	^ target! !

!MBCommand methodsFor: 'accessing' stamp: 'dkh 3/4/2011 06:16'!
targetNode: anObject
	targetNode := anObject! !

!MBCommand class methodsFor: 'testing' stamp: 'dkh 3/5/2011 17:06'!
isOBCommand

	^true! !

!MBCommand class methodsFor: 'util' stamp: 'ChristopheDemarey 10/18/2012 11:20'!
newCommand
	" 
	MBCommand newCommand
	"
	| command baseName newCommandName receiverClassIndex clss title documentation |
	baseName :=  self uiManager request: 'Enter the base name (''MB'' and ''Command'' will be automatically added'.
	baseName ifNil: [ ^ self ].
	
	clss := MBCommand subclasses.
	receiverClassIndex := self uiManager chooseFrom: (clss collect: #name).
	receiverClassIndex isZero ifTrue: [ ^ self ].
	
	newCommandName := 'MB', baseName, 'Command'.
	command := 
		(clss at: receiverClassIndex) 
			subclass: newCommandName asSymbol 
			instanceVariableNames: '' 
			classVariableNames: '' 
			poolDictionaries: '' 
			category: self category.
	
	documentation := self uiManager request: 'Enter the documentation'.
	documentation ifNil: [ ^ self ].
	 command compile: 'documentation
	^ ''', documentation, '''' classified: 'documentation'.

	 command compile: 'execute
	self subclassResponsibility ' classified: 'execute'.
	
	title := self uiManager request: 'Enter the command title'.
	title ifNil: [ ^ self ].
	 command compile: 'title
	^ ''', title, '''' classified: 'accessing'.
	
	clss := MBInfo allSubclasses.
	receiverClassIndex := self uiManager chooseFrom: (clss collect: #name).
	receiverClassIndex isZero ifTrue: [ ^ self ].
	(clss at: receiverClassIndex) compile: 'cmd', baseName, '
	^ ', newCommandName classified: 'commands'! !

!MBCommand class methodsFor: 'instance creation' stamp: 'dkh 3/6/2011 16:07'!
target: target for: requestor
	^ self new
		target: target;
		requestor: requestor;
		yourself! !

!MBCommand class methodsFor: 'testing' stamp: 'dkh 3/5/2011 17:06'!
isMorphicCommand

	^true! !

!MBCommandMetacelloTests methodsFor: 'tests' stamp: 'ChristopheDemarey 10/24/2013 17:57'!
testRemoveVersionCmd02
	"Remove a bleedingEdge version that is imported ... should abort the operation"

	| configName class configurationRoot configInfo versionInfo cmd versionString |
	configName := 'ConfigurationOfMBFooIssue117'.
	self tearDownPackages addAll: {configName}.
	gofer version: 'ConfigurationOfMBFooIssue117-dkh.1'.
	gofer load.
	class := Smalltalk at: configName asSymbol.
	versionString := (class project version: #bleedingEdge) versionString.
	configurationRoot := MBConfigurationRoot new.
	configurationRoot register.
	configInfo := configurationRoot configurationInfoFor: class.
	versionInfo := configInfo baselines detect: [ :each | each versionString = versionString ].
	cmd := VSRemoveCommand target: versionInfo for: self.
	[ cmd execute ]
		valueSupplyingAnswers:
			{{'*is imported by another version*'.
			true}}.
	self assert: versionString = (class project version: #bleedingEdge) versionString! !

!MBCommandMetacelloTests methodsFor: 'tests' stamp: 'dkh 3/19/2011 10:10'!
testUsernamePassword
	
	| cmd configInfo |
	gofer version: 'ConfigurationOfMBFooTests-dkh.1'.
	gofer load.
	self tearDownPackages add: 'ConfigurationOfMBFooTests'.
	configInfo := (MBConfigurationInfo configurationClass: (Smalltalk at: #'ConfigurationOfMBFooTests'))
		configurationRoot: MBConfigurationRoot new.
	cmd := MBSaveConfigurationCommand target: configInfo for: self.
	[cmd username] valueSupplyingAnswer: 'ab'.
	[cmd password] valueSupplyingAnswer: 'foobar'.
	
	self assert: cmd username = 'ab'.
	self assert: cmd password = 'foobar'.! !

!MBCommandMetacelloTests methodsFor: 'tests' stamp: 'dkh 3/19/2011 10:37'!
testAddConfigurationCmd

	| versionString packageNames projectNames project version packages projects |
	self tearDownPackages addAll: #('ConfigurationOfMBFooTests' 'MBFooCommandTestA' 'MBFooCommandTestB'). "must be BEFORE the load"
	gofer version: 'MBFooCommandTestA-dkh.1'.
	gofer version: 'MBFooCommandTestB-dkh.1'.
	gofer version: 'ConfigurationOfMBFooTests-dkh.1'.
	gofer load.
	versionString := '1.0'.
	packageNames := #('MBFooCommandTestA' 'MBFooCommandTestB').
	projectNames := #('ConfigurationOfMBFooTests').
	MBAddConfigurationCommand new
		executeAddBaselineForConfigurationNamed: self configurationName
		repositoryDescription: 'dictionary://', self repositoryName asString
		versionString: versionString
		packages: packageNames
		configurations: projectNames.
	project := (Smalltalk at: self configurationName asSymbol) project.
	version := project version: versionString, '-baseline'.
	packages := version packages.
	self assert: packages size == 2.
	packages do: [:pkg |
		self assert: (packageNames includes: pkg name)].
	projects := version projects.
	projects do: [:prj |
		self assert: (projectNames includes: prj name)].
! !

!MBCommandMetacelloTests methodsFor: 'tests' stamp: 'ChristopheDemarey 10/24/2013 17:57'!
testRemoveVersionCmd04
	"Remove a bleedingEdge version with no imports"

	| configName class configurationRoot configInfo versionInfo cmd versionString |
	configName := 'ConfigurationOfMBFooIssue117'.
	self tearDownPackages addAll: {configName}.
	gofer version: 'ConfigurationOfMBFooIssue117-dkh.3'.
	gofer load.
	class := Smalltalk at: configName asSymbol.
	versionString := (class project version: #bleedingEdge) versionString.
	self assert: versionString = '2.0-baseline'.
	configurationRoot := MBConfigurationRoot new.
	configurationRoot register.
	configInfo := configurationRoot configurationInfoFor: class.
	versionInfo := configInfo baselines detect: [ :each | each versionString = versionString ].
	cmd := VSRemoveCommand target: versionInfo for: self.
	[ cmd execute ]
		valueSupplyingAnswers:
			{{'Are you sure you want to remove*'.
			true}}.
	self should: [ class project version: #bleedingEdge ] raise: MetacelloSymbolicVersionNotDefinedError.
	self should: [ class project version: versionString ] raise: MetacelloVersionDoesNotExistError! !

!MBCommandMetacelloTests methodsFor: 'tests' stamp: 'ChristopheDemarey 10/24/2013 17:57'!
testRemoveVersionCmd01
	"Issue 117: Removing a version does not update the #development/#stable symbolic versions."

	| configName class configurationRoot configInfo versionInfo cmd |
	configName := 'ConfigurationOfMBFooIssue117'.
	self tearDownPackages addAll: {configName}.
	gofer version: 'ConfigurationOfMBFooIssue117-dkh.1'.
	gofer load.
	class := Smalltalk at: configName asSymbol.
	self assert: (class project version: #development) versionString = '1.0'.
	self assert: (class project version: #stable) versionString = '1.0'.
	configurationRoot := MBConfigurationRoot new.
	configurationRoot register.
	configInfo := configurationRoot configurationInfoFor: class.
	versionInfo := configInfo versions detect: [ :each | each versionString = '1.0' ].
	cmd := VSRemoveCommand target: versionInfo for: self.
	[ cmd execute ]
		valueSupplyingAnswers:
			{{'Are you sure you want to remove*'.
			true}}.
	self should: [ class project version: #development ] raise: MetacelloSymbolicVersionNotDefinedError.
	self should: [ class project version: #stable ] raise: MetacelloSymbolicVersionNotDefinedError.
	self should: [ class project version: '1.0' ] raise: MetacelloVersionDoesNotExistError! !

!MBCommandMetacelloTests methodsFor: 'tests' stamp: 'dkh 3/20/2011 12:45'!
testConfigurationChanges! !

!MBCommandMetacelloTests methodsFor: 'tests' stamp: 'ChristopheDemarey 10/24/2013 17:57'!
testRemoveVersionCmd03
	"Remove a bleedingEdge version with no imports"

	| configName class configurationRoot configInfo versionInfo cmd versionString |
	configName := 'ConfigurationOfMBFooIssue117'.
	self tearDownPackages addAll: {configName}.
	gofer version: 'ConfigurationOfMBFooIssue117-dkh.2'.
	gofer load.
	class := Smalltalk at: configName asSymbol.
	versionString := (class project version: #bleedingEdge) versionString.
	self assert: versionString = '2.0-baseline'.
	configurationRoot := MBConfigurationRoot new.
	configurationRoot register.
	configInfo := configurationRoot configurationInfoFor: class.
	versionInfo := configInfo baselines detect: [ :each | each versionString = versionString ].
	cmd := VSRemoveCommand target: versionInfo for: self.
	[ cmd execute ]
		valueSupplyingAnswers:
			{{'Are you sure you want to remove*'.
			true}}.
	self assert: (class project version: #bleedingEdge) versionString = '1.0-baseline'.
	self should: [ class project version: versionString ] raise: MetacelloVersionDoesNotExistError! !

!MBCommandTests methodsFor: 'running' stamp: 'dkh 3/19/2011 10:08'!
hasPackage: aString
	| package |
	package := MCWorkingCopy allManagers
		detect: [ :each | each packageName = aString ]
		ifNone: [ nil ].
	^ package notNil! !

!MBCommandTests methodsFor: 'running' stamp: 'dkh 3/19/2011 10:54'!
tearDown
	gofer := Gofer new.
	self tearDownPackages do: [:pkgName | (self hasPackage: pkgName) ifTrue: [ gofer package: pkgName ]].
	gofer references notEmpty ifTrue: [ gofer unload ].

	Smalltalk removeKey: self repositoryName ifAbsent: [  ].
	Smalltalk removeKey: #'MB_Foo_Test_Repository' ifAbsent: [].
	
	Smalltalk at: self configurationName ifPresent: [:cls | cls removeFromSystem ].

	MetacelloPlatform current authorName: authorName.! !

!MBCommandTests methodsFor: 'running' stamp: 'ChristopheDemarey 11/21/2013 14:06'!
runCase
	| original |
	original := MetacelloPlatform current bypassGoferLoadUpdateCategories.
	^ [ 	MetacelloPlatform current bypassGoferLoadUpdateCategories: true.
		[ super runCase ]
			ensure: [ MetacelloPlatform current bypassGoferLoadUpdateCategories: original ] ]! !

!MBCommandTests methodsFor: 'accessing' stamp: 'dkh 3/19/2011 10:04'!
tearDownPackages

	tearDownPackages ifNil: [ tearDownPackages := OrderedCollection new ].
	^tearDownPackages! !

!MBCommandTests methodsFor: 'private' stamp: 'TesterBob 3/20/2011 13:21'!
configurationName

	^#'ConfigurationOfMetacello_Command_Tests'! !

!MBCommandTests methodsFor: 'running' stamp: 'dkh 3/19/2011 10:16'!
setUp

	| repo |
	super setUp.
	gofer := Gofer new.
	gofer disablePackageCache.
	repo := MBMonticelloPackagesResource current monticelloRepository.
	gofer repository: repo.
	Smalltalk at: #'MB_Foo_Test_Repository' put: repo.

	repo := MCDictionaryRepository new.
	repo description: 'dictionary://', self repositoryName asString.
	Smalltalk at: self repositoryName put: repo.

	authorName := MetacelloPlatform current authorName.
	MetacelloPlatform current authorName: 'TesterBob'.
! !

!MBCommandTests methodsFor: 'private' stamp: 'dkh 3/19/2011 10:13'!
repositoryName

	^#'Metacello_Dev_Cycle_Repository'! !

!MBConfigurationBranchTest commentStamp: 'TorstenBergmann 2/20/2014 14:16'!
SUnit tests for configuration branches in Versionner!
!MBConfigurationBranchTest methodsFor: 'running' stamp: 'dkh 4/17/2011 12:28'!
tearDown
	configurationRoot ifNotNil: [ configurationRoot unregister ].
	Smalltalk removeKey: #'MB_Foo_Test_Repository' ifAbsent: [].
	gofer := Gofer new.
	self tearDownPackages do: [:pkgName | (self hasPackage: pkgName) ifTrue: [ gofer package: pkgName ]].
	gofer references notEmpty ifTrue: [ gofer unload ].
! !

!MBConfigurationBranchTest methodsFor: 'tests' stamp: 'dkh 4/17/2011 13:13'!
test002ConfigurationReferences
	"Make sure that the project and project branches show up in configuration references (for load configuration command)"

	| referenceMap |
	referenceMap := MBLoadConfigurationCommand new configurationReferencesFrom: MBMonticelloPackagesResource current monticelloRepository.
	self assert: (referenceMap keys includes: 'ConfigurationOfMBBranchTests.branch')! !

!MBConfigurationBranchTest methodsFor: 'tests' stamp: 'dkh 4/17/2011 12:48'!
test0010BasicLoad
	"
		- make sure that the configuration can be loaded without error
		- make sure that version 1.0 can be loaded without error"
	
	configurationRoot unregister.
	self assert: (Smalltalk at: #ConfigurationOfMBBranchTests ifAbsent: []) isNil.
	gofer version: 'ConfigurationOfMBBranchTests-dkh.1'.
	gofer load.
	((Smalltalk at: #ConfigurationOfMBBranchTests) project version: '1.0') load.
	self assert: (Smalltalk at: #MBFooTestA ifAbsent: []) notNil
! !

!MBConfigurationBranchTest methodsFor: 'running' stamp: 'dkh 4/17/2011 12:53'!
tearDownPackages

	^#('MBFooTests' 'ConfigurationOfMBBranchTests')! !

!MBConfigurationBranchTest methodsFor: 'tests' stamp: 'dkh 4/17/2011 12:48'!
test0011BasicLoad
	"
		- make sure that the branch configuration can be loaded without error
		- make sure that version 1.0 can be loaded without error"
	
	configurationRoot unregister.
	self assert: (Smalltalk at: #ConfigurationOfMBBranchTests ifAbsent: []) isNil.
	gofer version: 'ConfigurationOfMBBranchTests.branch-dkh.2'.
	gofer load.
	((Smalltalk at: #ConfigurationOfMBBranchTests) project version: '1.0') load.
	self assert: (Smalltalk at: #MBFooTestA ifAbsent: []) notNil
! !

!MBConfigurationBranchTest methodsFor: 'running' stamp: 'dkh 4/17/2011 12:28'!
setUp

	| repo |
	super setUp.
	gofer := Gofer new.
	gofer disablePackageCache.
	repo := MBMonticelloPackagesResource current monticelloRepository.
	gofer repository: repo.
	Smalltalk at: #'MB_Foo_Test_Repository' put: repo.
	configurationRoot := MBConfigurationRoot new.
	configurationRoot register.
	! !

!MBConfigurationBranchTest methodsFor: 'running' stamp: 'dkh 4/17/2011 12:41'!
hasPackage: aString
	| package |
	package := MCWorkingCopy allManagers
		detect: [ :each | each packageName = aString ]
		ifNone: [ nil ].
	^ package notNil! !

!MBConfigurationChangesCommand commentStamp: 'TorstenBergmann 2/20/2014 14:07'!
Command to browse changes on a configuration in versionner!
!MBConfigurationChangesCommand methodsFor: 'accessing' stamp: 'dkh 3/20/2011 16:13'!
title
	^ 'changes'! !

!MBConfigurationChangesCommand methodsFor: 'execute' stamp: 'dkh 3/20/2011 12:50'!
execute
	"View the changes made in the working copy."
	
	| wc repo |
	wc := target workingCopy.
	(repo := self selectRepositoryFromWorkingCopy: wc) ifNil: [ ^self ].
	self findChangesFor: wc relativeToRepository: repo! !

!MBConfigurationChangesCommand methodsFor: 'documentation' stamp: 'dkh 3/20/2011 14:02'!
documentation
	^ 'View changes for selected configuration against version in selected repository.'! !

!MBConfigurationInfo commentStamp: '<historical>'!
A MBConfigurationInfo holds information on a specific configuration, i.e. on the ConfigurationOf class of a project.

Instance Variables
	baselines:		list of baselines (MBBaseLineInfo instances) of this configuration.
	branch:			??
	configurationClass:	the configuration class (ConfigurationOf instance).
	configurationRoot:		a link to the root object with all configurations.
	currentVersion:		??
	trimVersionLists:		true if ??
	versions:			list of versions (MBVersionInfo instances) of this configuration.
	workingCopy:	the Metacello working copy
!
!MBConfigurationInfo methodsFor: 'accessing' stamp: 'dkh 3/6/2011 15:33'!
baselinesFor: aMetacelloProject
	"Return the list of  BaselineInfo for the configuration class passed as parameter"

	"The returned collection is ordered. Labeled baselines are first, numbered baselines are last"

	| existingBaselines numberedBaselines labeledBaselines |
	existingBaselines := aMetacelloProject versions select: [ :vrsn | vrsn blessing == #baseline ].
	existingBaselines := existingBaselines
		collect: [ :vrsn | 
			(MBBaselineInfo version: vrsn)
				configurationInfo: self;
				yourself ].
	numberedBaselines := existingBaselines select: [ :bInfo | ($0 to: $9) includes: bInfo name first ].
	labeledBaselines := existingBaselines copyWithoutAll: numberedBaselines.
	^ labeledBaselines asArray , numberedBaselines asArray reversed! !

!MBConfigurationInfo methodsFor: 'accessing' stamp: 'dkh 3/6/2011 14:50'!
configurationRoot
	^ configurationRoot! !

!MBConfigurationInfo methodsFor: 'accessing-computed' stamp: 'ChristopheDemarey 12/11/2012 11:23'!
currentVersion
	"Return the currentVersion of the configuration ... nil if not loaded."

	currentVersion == #notLoaded
		ifTrue: [ ^ nil ].
	(currentVersion notNil and: [ currentVersion ~~ #recalculate])
		ifTrue: [ ^ currentVersion ].
	packages := projects := groups := text := nil.
	self configurationRoot ifNil: [  ^ currentVersion ].
	(currentVersion := self project currentVersion)
		ifNil: [ 
			currentVersion := #notLoaded.
			self configurationRoot announcer announce: (MBConfigurationInfoChanged changed: self).
			^ nil ].
	self configurationRoot announcer announce: (MBConfigurationInfoChanged changed: self).
	^ currentVersion! !

!MBConfigurationInfo methodsFor: 'actions' stamp: 'dkh 2/27/2011 20:26'!
validate
	validationResult == nil
		ifTrue: [ 
			validationIcon := nil.
			validationResult := MetacelloToolBox validateConfiguration: self configurationClass ].
	^ validationResult! !

!MBConfigurationInfo methodsFor: 'accessing' stamp: 'dkh 2/27/2011 15:28'!
workingCopy
	| pkg |
	workingCopy ~~ nil ifTrue: [ ^workingCopy ].
	pkg := MCPackage named: self configurationClass category asString.
	pkg  hasWorkingCopy ifFalse: [ ^nil ].
	^workingCopy := pkg workingCopy! !

!MBConfigurationInfo methodsFor: 'accessing' stamp: 'dkh 3/10/2011 11:25'!
project
	"Answer the MetacelloProject associated with the receiver."

	^ self configurationClass project! !

!MBConfigurationInfo methodsFor: 'accessing' stamp: 'dkh 4/7/2011 23:57'!
branch

	branch ifNil: [ branch := self extractBranchFrom: self workingCopy ].
	^branch! !

!MBConfigurationInfo methodsFor: 'commands' stamp: 'JuanPabloSandovalAlcocer 6/30/2012 18:07'!
cmdSaveConfiguration
	<command>
	^ MBSaveConfigurationCommand! !

!MBConfigurationInfo methodsFor: 'updating' stamp: 'dkh 4/12/2011 10:51'!
recalculateIfInterestedInPackageNamed: packageName for: operation
	| recalculate |
	recalculate := super recalculateIfInterestedInPackageNamed: packageName for: operation.
	(recalculate not and: [ baselines notNil ])
		ifTrue: [ 
			(self baselines detect: [ :info | info recalculateIfInterestedInPackageNamed: packageName for: operation ] ifNone: [  ])
				ifNotNil: [ recalculate := true ] ].
	(recalculate not and: [ versions notNil ])
		ifTrue: [ 
			(self versions detect: [ :info | info recalculateIfInterestedInPackageNamed: packageName for: operation ] ifNone: [  ])
				ifNotNil: [ recalculate := true ] ].
	(recalculate and: [ operation ~~ #modified ])
		ifTrue: [ 
			currentVersion == #notLoaded
				ifTrue: [ currentVersion := nil ].
			self fullRecalculate ]! !

!MBConfigurationInfo methodsFor: 'accessing' stamp: 'ChristopheDemarey 9/17/2013 18:18'!
repositories
	"Return the repositories associated with the configuration."
	| mcPackage |
	
	(mcPackage := self project projectPackage)
		ifNil: [ ^nil ].
	^ mcPackage workingCopy
		ifNil: [ nil ]
		ifNotNilDo: [ :wc | wc repositoryGroup repositories ]! !

!MBConfigurationInfo methodsFor: 'accessing-computed' stamp: 'dkh 3/2/2011 20:29'!
versionForInfoList

	^self currentVersion ! !

!MBConfigurationInfo methodsFor: 'commands' stamp: 'ChristopheDemarey 9/17/2013 15:32'!
cmdOpenRepository
	<command>
	^ VSOpenRepositoryCommand! !

!MBConfigurationInfo methodsFor: 'printing' stamp: 'ChristopheDemarey 11/6/2012 15:28'!
printOn: aStream
	| cv nameString wc refString branchString |
	[self name
		ifNil: [ 
			aStream nextPutAll: ''.
			^ self ].
	nameString := self name configurationBaseName.
	(refString := self extractPackageSignatureFrom: (wc := self workingCopy)) notEmpty
		ifTrue: [ refString := '(' , refString , ')' ].
	(branchString := self branch) notEmpty
		ifTrue: [ nameString := nameString, '.', branchString ].
	self isDirty
		ifTrue: [ aStream nextPutAll: '* ' ].
	aStream nextPutAll: nameString.
	(cv := self currentVersion) notNil
		ifTrue: [ aStream nextPutAll: ' ' , cv versionString ].
	aStream nextPutAll: refString.] on:Error do:[].! !

!MBConfigurationInfo methodsFor: 'commands' stamp: 'ChristopheDemarey 9/17/2013 11:37'!
cmdValidateConfiguration
	<command>
	^ VSValidateConfigurationCommand! !

!MBConfigurationInfo methodsFor: 'testing' stamp: 'JPSA 4/20/2012 21:22'!
isDirty
	| wc |
	^ [super isDirty or: [ (wc := self workingCopy) notNil and: [ wc needsSaving ]]] on:Error do:[false].! !

!MBConfigurationInfo methodsFor: 'testing' stamp: 'dkh 3/9/2011 16:30'!
currentVersionMismatch
	^ (self projects anySatisfy: [ :each | each currentVersionMismatch ])
		or: [ self packages anySatisfy: [ :each | each currentVersionMismatch ] ]! !

!MBConfigurationInfo methodsFor: 'accessing' stamp: 'dkh 3/1/2011 21:15'!
trimVersionLists: aBool

	trimVersionLists := aBool! !

!MBConfigurationInfo methodsFor: 'testing' stamp: 'ChristopheDemarey 12/5/2013 09:42'!
hasVersion: aVersionString
 	[ self project version: aVersionString ]
		on: MetacelloSymbolicVersionDoesNotExistError
		do:  [ ^ false ].
	^ true! !

!MBConfigurationInfo methodsFor: 'private' stamp: 'dkh 3/2/2011 08:07'!
trimVersionInfos: versionInfos

	| trimmed count marker cv |
	self trimVersionLists ifFalse: [ ^versionInfos ].
	versionInfos size <= 10 ifTrue: [ ^versionInfos ].
	trimmed := (versionInfos copyFrom: 1 to: 5) asOrderedCollection.
	marker := count := 0.
	cv := self currentVersion.
	 6 to: versionInfos size do: [:index | | info |
		info := versionInfos at: index.
		info isStable | info isBleedingEdge | info isDevelopment | info hasValidationIssues | (cv = info version)
			ifTrue: [ 
				count - 1 >= marker ifTrue: [ trimmed add:( MBLabelInfo new name: '..') ].
				trimmed add: info.
				marker := count. ].
		count := count + 1 ].
	count - 1 >= marker ifTrue: [ trimmed add:( MBLabelInfo new name: '..') ].
	^trimmed! !

!MBConfigurationInfo methodsFor: 'initialize-release' stamp: 'TorstenBergmann 1/22/2015 09:28'!
release

	baselines := versions := nil.
	super release.	! !

!MBConfigurationInfo methodsFor: 'utils' stamp: 'dkh 4/7/2011 23:49'!
extractBranchFrom: aWorkingCopy
	| ref |
	(aWorkingCopy isNil or: [ aWorkingCopy ancestors isEmpty ])
		ifTrue: [ ^ '' ].
	ref := GoferVersionReference name: aWorkingCopy ancestors first name.
	^ ref branch! !

!MBConfigurationInfo methodsFor: 'updating' stamp: 'dkh 4/12/2011 10:43'!
recalculateIfInterestedInConfigurationInfo: configInfo for: operation

	projects ifNil: [ ^self ].
	self projects detect: [ :info | info interestedInConfigurationInfo: configInfo ] ifNone: [ ^self ].
	infoList := text := projects := nil.
	self configurationRoot announcer announce: (MBConfigurationInfoChanged changed: self)! !

!MBConfigurationInfo methodsFor: 'updating' stamp: 'dkh 3/14/2011 11:10'!
fullRecalculate

	super fullRecalculate.
	(currentVersion == #recalculate or: [ currentVersion isNil ]) ifTrue: [^self ].
	currentVersion := #recalculate.
! !

!MBConfigurationInfo methodsFor: 'private' stamp: 'dkh 3/18/2011 18:42'!
calculateInfoList
	| answer list cvs cv |
	answer := OrderedCollection new.
	[self project ifNil: [ ^answer ]] on: Error do: [:ex | ^answer ].
	answer add: (MBLabelInfo new name: ' -- baselines --').
	answer addAll: (self trimVersionInfos: self baselines).
	answer add: (MBLabelInfo new name: '').
	answer add: (MBLabelInfo new name: ' -- versions --').
	answer addAll: (self trimVersionInfos: self versions).
	answer add: (MBLabelInfo new name: '').
	cvs := ''.
	(cv := self currentVersion) ~~ nil
		ifTrue:  [cvs := cv versionString, ' '].
	(list := self projects) notEmpty
		ifTrue: [ 
			answer add: (MBLabelInfo new name: ' -- ', cvs, 'projects --').
			answer addAll: list.
			answer add: (MBLabelInfo new name: '') ].
	(list := self packages) notEmpty
		ifTrue: [ 
			answer add: (MBLabelInfo new name: ' -- ', cvs, 'packages --').
			answer addAll: list.
			answer add: (MBLabelInfo new name: '') ].
	(list := self groups) notEmpty
		ifTrue: [ 
			answer add: (MBLabelInfo new name: ' -- ', cvs, 'groups --').
			answer addAll: list].
	^ answer! !

!MBConfigurationInfo methodsFor: 'accessing' stamp: 'dkh 3/5/2011 18:03'!
configurationInfo

	^self ! !

!MBConfigurationInfo methodsFor: 'commands' stamp: 'ChristopheDemarey 2/14/2014 18:01'!
cmdCatalogAdder
	<command>
	^ VSCatalogAdderCommand! !

!MBConfigurationInfo methodsFor: 'accessing' stamp: 'dkh 3/6/2011 14:50'!
configurationRoot: anObject
	configurationRoot := anObject! !

!MBConfigurationInfo methodsFor: 'updating' stamp: 'dkh 4/7/2011 23:58'!
recalculate
	branch := workingCopy := baselines := versions := nil.
	super recalculate.
	self configurationRoot announcer announce: (MBConfigurationInfoChanged changed: self).
! !

!MBConfigurationInfo methodsFor: 'accessing' stamp: 'dkh 4/8/2011 16:14'!
version

	^self currentVersion! !

!MBConfigurationInfo methodsFor: 'updating' stamp: 'ChristopheDemarey 3/28/2014 14:18'!
recalculateSilently
	branch := workingCopy := baselines := versions := nil.
	super recalculate.
! !

!MBConfigurationInfo methodsFor: 'actions' stamp: 'dkh 3/6/2011 14:56'!
validateFull

	infoList := baselines := versions := nil.
	(self baselines, self versions) do: [:version | version validateFull ].
	^super validateFull.
! !

!MBConfigurationInfo methodsFor: 'commands' stamp: 'ChristopheDemarey 9/17/2013 15:30'!
cmdBrowseConfiguration
	<command>
	^ VSBrowseConfigurationCommand! !

!MBConfigurationInfo methodsFor: 'commands' stamp: 'ChristopheDemarey 9/17/2013 15:28'!
cmdUnloadConfiguration
	<command>
	^ VSUnloadConfigurationCommand! !

!MBConfigurationInfo methodsFor: 'accessing' stamp: 'ChristopheDemarey 10/18/2012 10:49'!
configurationClass
	"Returns the class configurationOfXXX associted to the configuration info (wrapper for the UI)"

	^ configurationClass! !

!MBConfigurationInfo methodsFor: 'accessing-computed' stamp: 'ChristopheDemarey 3/6/2013 18:09'!
versions
	"Return the versions of the configuration"
	| versionList devVersionString |
	
	versions ifNotNil: [ versions ifNotEmpty: [ ^ versions ] ].
	versionList := self project map values.
	devVersionString := self project symbolicVersionMap at: #development ifAbsent: [ '' ].
	versionList reject: [ :vrsn | (vrsn blessing == #baseline and: [(vrsn name == devVersionString) not]) or: [ vrsn blessing == #broken ] ].
	
	versions := (versionList asArray sort: [:a :b | a > b ])
		collect: [ :vrsn | 
			(MBVersionInfo version: vrsn)
				configurationInfo: self;
				yourself ].
	^ versions! !

!MBConfigurationInfo methodsFor: 'accessing-computed' stamp: 'dkh 4/7/2011 23:58'!
currentVersion: aVersion

	currentVersion  := aVersion.
	branch := baselines := versions := infoList := packages := projects := groups := text := nil.
	self configurationRoot announcer announce: (MBConfigurationInfoChanged changed: self).
	self announcer announce: (MBInfoListChanged changed: self).
! !

!MBConfigurationInfo methodsFor: 'commands' stamp: 'ChristopheDemarey 10/25/2013 17:53'!
cmdUpdateFromItsRepository
	<command>
	^ VSUpdateFromItsRepositoryCommand! !

!MBConfigurationInfo methodsFor: 'accessing' stamp: 'dkh 3/1/2011 21:15'!
trimVersionLists

	trimVersionLists == nil ifTrue: [ trimVersionLists := true ].
	^trimVersionLists! !

!MBConfigurationInfo methodsFor: 'converting' stamp: 'dkh 4/5/2011 16:41'!
buildStringOrText
	| string cv specVersion attributes wc |
	attributes := OrderedCollection new.
	[ string := super buildStringOrText ]
		on: Error
		do: [ :ex | 
			attributes add: TextEmphasis struckOut.
			^ Text string: self name asString attributes: attributes ].
	((wc := self workingCopy) notNil and: [ wc needsSaving ])
		ifTrue: [ attributes add: TextEmphasis underlined ].
	self currentVersion. "prime the pump"
	currentVersion == #notLoaded
		ifTrue: [ 
			attributes notEmpty
				ifTrue: [ ^ Text string: string attributes: attributes ].
			^ string ].
	super isDirty | self currentVersionMismatch
		ifTrue: [ attributes add: TextEmphasis bold ].
	self currentVersion versionStatus == #somethingLoaded
		ifTrue: [ attributes add: TextColor red ].
	attributes notEmpty
		ifTrue: [ ^ Text string: string attributes: attributes ].
	^ string! !

!MBConfigurationInfo methodsFor: 'accessing-computed' stamp: 'ChristopheDemarey 1/13/2014 14:34'!
baselines 
	baselines ifNotNil: [ ^baselines ].
	baselines := self baselinesFor: self project.
	^baselines ! !

!MBConfigurationInfo methodsFor: 'updating' stamp: 'dkh 03/12/2011 02:24'!
configurationClassModified

	self fullRecalculate ! !

!MBConfigurationInfo methodsFor: 'accessing' stamp: 'dkh 2/23/2011 14:19'!
configurationClass: aConfigurationClass
	configurationClass := aConfigurationClass.
	self name: configurationClass name asString! !

!MBConfigurationInfo class methodsFor: 'accessing' stamp: 'dkh 4/10/2011 19:56'!
helpLabel

	^'Configuration'! !

!MBConfigurationInfo class methodsFor: 'instance creation' stamp: 'AlexandreBergel 1/16/2011 21:13'!
new
	self error: 'Please, use #configuration: to instantiate ', self name printString! !

!MBConfigurationInfo class methodsFor: 'instance creation' stamp: 'AlexandreBergel 1/16/2011 21:14'!
configurationClass: aConfiguration
	^ super new 
		configurationClass: aConfiguration;
		yourself! !

!MBConfigurationInfoChanged commentStamp: 'TorstenBergmann 2/20/2014 14:05'!
A configuration info changed!
!MBConfigurationInfoChanged methodsFor: 'accessing' stamp: 'dkh 3/10/2011 12:55'!
configurationInfo
	^ configurationInfo! !

!MBConfigurationInfoChanged methodsFor: 'accessing' stamp: 'JuanPabloSandovalAlcocer 3/27/2012 10:51'!
configurationInfo: anObject
	configurationInfo := anObject 
	! !

!MBConfigurationInfoChanged class methodsFor: 'instance creation' stamp: 'dkh 3/10/2011 12:56'!
changed: aConfigurationInfo

	^(self new) 
		configurationInfo: aConfigurationInfo;
		yourself! !

!MBConfigurationInfoCommand commentStamp: 'TorstenBergmann 2/20/2014 14:07'!
Common superclass for commands on configuration infos in Versionner!
!MBConfigurationInfoCommand methodsFor: 'ui' stamp: 'ChristopheDemarey 10/18/2012 11:43'!
showExecuteWhile: aBlock

	^Cursor execute showWhile:  aBlock! !

!MBConfigurationInfoCreated commentStamp: 'TorstenBergmann 2/20/2014 14:05'!
A configuration info was created!
!MBConfigurationInfoDeleted commentStamp: 'TorstenBergmann 2/20/2014 14:05'!
A configuration info was deleted!
!MBConfigurationInfoTest commentStamp: 'TorstenBergmann 2/20/2014 14:19'!
SUnit tests for MBConfigurationInfo in Versionner!
!MBConfigurationInfoTest methodsFor: 'tests' stamp: 'ChristopheDemarey 3/19/2015 22:29'!
testInitialization
	| configClass conf |
	self 
		should: [ MBConfigurationInfo new ]
		raise: Error.
	configClass := Smalltalk globals at: #ConfigurationOfVersionner.
	self
		shouldnt: [ conf := MBConfigurationInfo configurationClass: configClass ]
		raise: Error.
	self 
		assert: conf name 
		equals: 'ConfigurationOfVersionner'! !

!MBConfigurationInfoTest methodsFor: 'tests' stamp: 'ChristopheDemarey 1/13/2014 10:26'!
testDefaultVersion
	
	self assert: (configuration selectors select: [ :s | s beginsWith: 'baseline']) size + 1 
		equals:	info baselines size
! !

!MBConfigurationInfoTest methodsFor: 'tests' stamp: 'dkh 3/6/2011 14:56'!
testBaselines

	"+1 is for the default: baseline"
	self assert: info baselines size = ((configuration selectors select: [ :s | s beginsWith: 'baseline']) size + 1).
! !

!MBConfigurationInfoTest methodsFor: 'running' stamp: 'dkh 3/4/2011 14:13'!
setUp
	super setUp.

	info := MBConfigurationInfo configurationClass: configuration.
! !

!MBConfigurationPackageHistoryCommand commentStamp: 'TorstenBergmann 2/20/2014 14:07'!
Command to browse package history for configurations in versionner!
!MBConfigurationPackageHistoryCommand methodsFor: 'accessing' stamp: 'dkh 3/20/2011 14:16'!
title
	^ 'history'! !

!MBConfigurationPackageHistoryCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 10/18/2012 17:39'!
execute
	self browseVersionHistory! !

!MBConfigurationPackageHistoryCommand methodsFor: 'documentation' stamp: 'dkh 3/20/2011 14:17'!
documentation
	^ 'view package history'! !

!MBConfigurationRoot commentStamp: '<historical>'!
MB stands for Metacello Borwser.
MBConfigurationRoot is the root object holding information on all available configurations in the image.

Instance Variables
	announcer:		<Object>
	configurations:	a collection of MBConfigurationInfo.
	password:		<Object>
	username:		<Object>
!
!MBConfigurationRoot methodsFor: 'accessing' stamp: 'dkh 3/5/2011 15:33'!
configurationClasses
	^ MetacelloToolBox configurationClasses! !

!MBConfigurationRoot methodsFor: 'accessing' stamp: 'dkh 3/10/2011 12:37'!
announcer

	^announcer ! !

!MBConfigurationRoot methodsFor: 'updating' stamp: 'ChristopheDemarey 1/2/2013 17:33'!
unregister
	"Unregister from the dependent object. Typically used when closing the browser"
	
	SystemAnnouncer uniqueInstance unsubscribe: self.
	MCWorkingCopy removeDependent: self.
! !

!MBConfigurationRoot methodsFor: 'updating' stamp: 'dkh 4/7/2011 23:42'!
update: anArrayOrSymbol
	"A package has been modified (loaded, removed, or updated). Find out if any configurations are managing the package.
	Update events are coming from MCWorkingCopy."

	| packageName operation |
	anArrayOrSymbol isArray
		ifFalse: [ ^ self ].
	operation := anArrayOrSymbol at: 1.
	operation == #modified
		ifTrue: [ packageName := (anArrayOrSymbol at: 2) packageName ].
	operation == #registered
		ifTrue: [ packageName := (anArrayOrSymbol at: 2) name ].
	operation == #unregistered
		ifTrue: [ packageName := (anArrayOrSymbol at: 2) name ].
	(packageName beginsWith: 'ConfigurationOf')
		ifTrue: [ 
			| wc info |
			operation ~~ #modified
				ifTrue: [ ^ self ].	"only interested in modified"
			wc := anArrayOrSymbol at: 2.
			wc modified
				ifTrue: [ ^ self ].	"only interested in transtion from modified to not modified"
			(info := self configurationInfoFor: (Smalltalk at: packageName asSymbol ifAbsent: [ ^ self ])) isNil
				ifTrue: [ ^ self ].	
			"removed and added packages handled by the add/removal of the class"
			info configurationClassModified.
			^ self ].
	self configurations do: [ :info | info recalculateIfInterestedInPackageNamed: packageName for: operation ]! !

!MBConfigurationRoot methodsFor: 'accessing' stamp: 'dkh 3/6/2011 14:51'!
configurations
	configurations
		ifNil: [ 
			configurations := (self configurationClasses
				collect: [ :cls | 
					(MBConfigurationInfo configurationClass: cls)
						configurationRoot: self;
						yourself ]) asSortedCollection: [ :a :b | a name <= b name ] ].
	^ configurations! !

!MBConfigurationRoot methodsFor: 'actions' stamp: 'dkh 3/10/2011 14:46'!
removeConfigurationInfo: aConfigurationInfo

	aConfigurationInfo release.
	self configurations remove: aConfigurationInfo ifAbsent: [].
	self announcer announce: MBConfigurationInfoDeleted! !

!MBConfigurationRoot methodsFor: 'updating' stamp: 'ChristopheDemarey 1/2/2013 17:31'!
classAdded: anEvent

	(anEvent classAdded name asString beginsWith: 'ConfigurationOf')
		ifTrue: [ self respondToEventFor: anEvent classAdded withOperation: #added ]! !

!MBConfigurationRoot methodsFor: 'updating' stamp: 'BernardoContreras 11/3/2014 21:41'!
register
	"Set up dependencies"
	
	SystemAnnouncer uniqueInstance weak
		when: ClassAdded send: #classAdded: to: self;
		when: ClassModifiedClassDefinition,
			ClassCommented,
			ClassRenamed, 
			ClassReorganized,
			ClassRenamed send: #classModified: to: self;
		when: ClassRemoved send: #classRemoved: to: self;		
		when: MethodAdded,
			MethodModified ,
			MethodRemoved send: #methodModified: to: self.
					
	MCWorkingCopy addDependent: self.
! !

!MBConfigurationRoot methodsFor: 'accessing' stamp: 'dkh 3/5/2011 15:34'!
password
	^ password! !

!MBConfigurationRoot methodsFor: 'updating' stamp: 'dkh 4/9/2011 21:00'!
respondToEventFor: aConfigurationClass withOperation: operation
	"Events generated by SystemChangeNotifier and involve edits to the configuration itself."

	| info |
	operation == #added
		ifTrue: [ ^self addConfigurationInfoFor: aConfigurationClass ].
	(info := self configurationInfoFor: aConfigurationClass) isNil
		ifTrue: [ ^ self ].
	operation == #removed
		ifTrue: [ ^self removeConfigurationInfo: info ].
	"operation == #modified...configuration specs potentially modified"
	info configurationClassModified.
	self configurations do: [ :configInfo | configInfo recalculateIfInterestedInConfigurationInfo: info for: operation ]! !

!MBConfigurationRoot methodsFor: 'accessing' stamp: 'dkh 3/5/2011 15:35'!
username
	^ username! !

!MBConfigurationRoot methodsFor: 'initialize-release' stamp: 'dkh 3/10/2011 12:37'!
initialize

	super initialize .
	announcer := Announcer new! !

!MBConfigurationRoot methodsFor: 'updating' stamp: 'ChristopheDemarey 1/17/2013 10:46'!
methodModified: anEvent

	(anEvent methodAffected class name asString beginsWith: 'ConfigurationOf')
		ifTrue: [  self respondToEventFor: anEvent methodAffected withOperation: #modified ]! !

!MBConfigurationRoot methodsFor: 'accessing' stamp: 'dkh 3/5/2011 15:34'!
password: anObject
	password := anObject! !

!MBConfigurationRoot methodsFor: 'accessing' stamp: 'dkh 3/5/2011 15:35'!
username: anObject
	username := anObject! !

!MBConfigurationRoot methodsFor: 'accessing' stamp: 'dkh 4/9/2011 18:26'!
configurationInfoFor: aConfigurationClass

	self configurations do: [:info | info configurationClass == aConfigurationClass theNonMetaClass  ifTrue: [ ^info ]].
	^nil! !

!MBConfigurationRoot methodsFor: 'actions' stamp: 'dkh 3/10/2011 12:49'!
addConfigurationInfoFor: aConfigurationClass
	(self configurationInfoFor: aConfigurationClass) notNil
		ifTrue: [ ^ self ].
	self configurations
		add:
			((MBConfigurationInfo configurationClass: aConfigurationClass)
				configurationRoot: self;
				yourself).
	self announcer announce: MBConfigurationInfoCreated! !

!MBConfigurationRoot methodsFor: 'updating' stamp: 'ChristopheDemarey 8/28/2012 14:49'!
categoryModified: anEvent
	"(anEvent itemClass name asString beginsWith: 'ConfigurationOf')
		ifTrue: [  self respondToEventFor: anEvent itemClass withOperation: #modified ]"
	| configName configClass configInfo |
	self flag: 'update only needed configurations'.
	"configName := 'ConfigurationOf' , (anEvent item).
	configClass := Smalltalk at: (configName asSymbol).
	configClass ifNotNilDo: [ 
		configInfo := self configurationInfoFor: configClass.
		configInfo fullRecalculate ]."
	self configurations do: [:config | config fullRecalculate ].! !

!MBConfigurationRoot methodsFor: 'updating' stamp: 'ChristopheDemarey 1/2/2013 17:31'!
classRemoved: anEvent

	(anEvent classRemoved name asString beginsWith: 'ConfigurationOf')
		ifTrue: [ self respondToEventFor: anEvent classRemoved withOperation: #removed ]! !

!MBConfigurationRoot methodsFor: 'updating' stamp: 'ChristopheDemarey 1/2/2013 17:31'!
classModified: anEvent

	(anEvent classAffected name asString beginsWith: 'ConfigurationOf')
		ifTrue: [ self respondToEventFor: anEvent classAffected withOperation: #modified ]! !

!MBConfigurationRoot class methodsFor: 'accessing' stamp: 'JuanPabloSandovalAlcocer 6/30/2012 23:11'!
current
	"singleton pattern"
	Current ifNil: [ 
		Current := self new.
		Current register ].
	^Current ! !

!MBConfigurationRoot class methodsFor: 'accessing' stamp: 'dkh 3/10/2011 18:22'!
reset
	"self reset"
	| c |
	Current ifNil: [ ^self ].
	c := Current.
	Current := nil.
	c unregister.
! !

!MBConfigurationRootTest commentStamp: 'TorstenBergmann 2/20/2014 14:16'!
SUnit tests for configurations in Versionner!
!MBConfigurationRootTest methodsFor: 'tests' stamp: 'BernardoContreras 11/5/2014 20:48'!
test0021ConfigurationInfoCreated
	| createdValuable configClassName configInfoCreated configInfoChanged changedValuable configInfoDeleted deletedValuable |
	configInfoDeleted := configInfoChanged := configInfoCreated := false.
	createdValuable := [ :ann | configInfoCreated := true ].
	changedValuable := [ :ann | configInfoChanged := true ].
	deletedValuable := [ :ann | configInfoDeleted := true ].
	[ 
		configurationRoot announcer when: MBConfigurationInfoCreated do: createdValuable.
		configurationRoot announcer when: MBConfigurationInfoChanged do: changedValuable.
		configurationRoot announcer when: MBConfigurationInfoDeleted do: deletedValuable.
		configClassName := #ConfigurationOfMBFooTests.

		"load configuration"
		gofer version: 'ConfigurationOfMBFooTests-dkh.1'.
		gofer load.

		self assert: configInfoCreated.
		self assert: configInfoChanged.
		self deny: configInfoDeleted.
	 ] 
			ensure: [ configurationRoot announcer 
					unsubscribe: createdValuable;
					unsubscribe: deletedValuable;
					unsubscribe: changedValuable   ].
! !

!MBConfigurationRootTest methodsFor: 'tests' stamp: 'ChristopheDemarey 8/28/2012 13:58'!
test0070BasicVersionLoad
	"Seventh test:
	 	- load configuration dkh.3
		- load version 1.0.
		- validate package, baselines and versions state
		- load version 1.2
		- validate new package, baselines and versions state"
	| configClass configClassName configInfo expected infos |
	gofer version: 'ConfigurationOfMBFooTests-dkh.3'.
	gofer load.
	configClassName := #ConfigurationOfMBFooTests.
	self assert: (configClass := Smalltalk at: configClassName ifAbsent: []) notNil.
	configInfo := configurationRoot configurationInfoFor: configClass.
	self assert: configInfo printString = 'MBFooTests(dkh.3)'.
	self assert: configInfo currentVersion isNil.

	"load version 1.0"
	((Smalltalk at: #ConfigurationOfMBFooTests) project version: '1.0') load.
	self assert: configInfo printString = 'MBFooTests 1.0(dkh.3)'.
	self assert: configInfo currentVersion versionString = '1.0'.
	self assert: configInfo printString = 'MBFooTests 1.0(dkh.3)'.
	"baselines"
	infos := configInfo baselines.
	self assert: infos size = 1.
	expected := #('1.0-baseline #bleedingEdge').
	1 to: infos size do: [:index | | info |
		info := infos at: index.
		self assert: info printString = (expected at: index)].
	"versions"
	infos := configInfo versions.
	self assert: infos size = 3.
	expected := #('1.2' '1.1' ' @ 1.0 #stable').
	1 to: infos size do: [:index | | info |
		info := infos at: index.
		self assert: info printString = (expected at: index)].
	"packages"
	infos := configInfo packages.
	self assert: infos size = 1.
	expected := #('MBFooTests-dkh.1').
	1 to: infos size do: [:index | | info |
		info := infos at: index.
		self assert: info printString = (expected at: index)].

	"load version 1.2"
	((Smalltalk at: #ConfigurationOfMBFooTests) project version: '1.2')  load.
	self assert: configInfo printString = 'MBFooTests 1.2(dkh.3)'.
	"baselines"
	infos := configInfo baselines.
	self assert: infos size = 1.
	expected := #('1.0-baseline #bleedingEdge').
	1 to: infos size do: [:index | | info |
		info := infos at: index.
		self assert: info printString = (expected at: index)].
	"versions"
	infos := configInfo versions.
	self assert: infos size = 3.
	expected := #(' @ 1.2' '1.1' '1.0 #stable').
	1 to: infos size do: [:index | | info |
		info := infos at: index.
		self assert: info printString = (expected at: index)].
	"packages"
	infos := configInfo packages.
	self assert: infos size = 1.
	expected := #('MBFooTests-dkh.3').
	1 to: infos size do: [:index | | info |
		info := infos at: index.
		self assert: info printString = (expected at: index)].
! !

!MBConfigurationRootTest methodsFor: 'tests' stamp: 'BernardoContreras 11/5/2014 20:53'!
test0082ConfigurationInfoChanged

	| configInfoDeleted configInfoChanged configInfoCreated createdValuable changedValuable deletedValuable configClassName configClass configInfo |
	configInfoDeleted := configInfoChanged := configInfoCreated := false.
	createdValuable := [ :ann | configInfoCreated := true ].
	changedValuable := [ :ann | configInfoChanged := true ].
	deletedValuable := [ :ann | configInfoDeleted := true ].
	[ 
		configurationRoot announcer when: MBConfigurationInfoCreated do: createdValuable.
		configurationRoot announcer when: MBConfigurationInfoChanged do: changedValuable.
		configurationRoot announcer when: MBConfigurationInfoDeleted do: deletedValuable.

		"load configuration"
		gofer version: 'ConfigurationOfMBFooTests-dkh.3'.
		gofer load.

		self assert: configInfoCreated.
		self assert: configInfoChanged.
		self deny: configInfoDeleted.
		configInfoDeleted := configInfoChanged := configInfoCreated := false.

		configClassName := #ConfigurationOfMBFooTests.
		configClass := Smalltalk at: configClassName ifAbsent: [].
		configInfo := configurationRoot configurationInfoFor: configClass.

		"load version 1.2"
		((Smalltalk at: #ConfigurationOfMBFooTests) project version: '1.2')  load.

		self deny: configInfoCreated.
		self assert: configInfoChanged.
		self deny: configInfoDeleted.
		configInfoDeleted := configInfoChanged := configInfoCreated := false.

		self assert: configInfo currentVersion versionString = '1.2'.
		configInfo packages. "prime the pump"

		"modify class in MBFooTests project"
		(Smalltalk at: #MBFooTestA)
			compile: 'bar ^self' classified: 'mod'.

		self deny: configInfoCreated.
		self assert: configInfoChanged.
		self deny: configInfoDeleted.
		configInfoDeleted := configInfoChanged := configInfoCreated := false.
	 ] 
			ensure: [ configurationRoot announcer 
					unsubscribe: createdValuable;
					unsubscribe: deletedValuable;
					unsubscribe: changedValuable   ].
! !

!MBConfigurationRootTest methodsFor: 'tests' stamp: 'ChristopheDemarey 11/27/2013 12:34'!
expectedFailures 
	^ #(
		test0021ConfigurationInfoCreated
		test0030BasicVersionLoad 
		test0031ConfigurationInfoChanged
		test0040BasicVersionLoad
		test0050BasicVersionLoad
		test0060BasicVersionLoad
		test0061ConfigurationInfoChanged
		test0062InfoListChanged
		test0070BasicVersionLoad
		test0080BasicVersionLoad
		test0081BasicVersionLoad
		test0082ConfigurationInfoChanged
		test0083InfoListChanged
		test0090BasicVersionLoad
		test0091PackageMismatch
		test0101ConfigurationInfoDeleted
		test0120ConfigPackageSave
	) ! !

!MBConfigurationRootTest methodsFor: 'tests' stamp: 'ChristopheDemarey 8/28/2012 13:34'!
test0040BasicVersionLoad
	"Fourth test:
	 	- load configuration dkh.1
		- send currentVersion to configInfo ... which record currentVersion
		- load version 1.0 and currentVersion should be updated to reflect fact that pacakges loaded."
	| configClass configClassName configInfo |
	gofer version: 'ConfigurationOfMBFooTests-dkh.1'.
	gofer load.
	configClassName := #ConfigurationOfMBFooTests.
	self assert: (configClass := Smalltalk at: configClassName ifAbsent: []) notNil.
	configInfo := configurationRoot configurationInfoFor: configClass.
	self assert: configInfo printString = 'MBFooTests(dkh.1)'.
	self assert: configInfo currentVersion isNil.

	"load version 1.0"
	((Smalltalk at: #ConfigurationOfMBFooTests) project version: '1.0') load.
	self assert: configInfo printString = 'MBFooTests 1.0(dkh.1)'.
	self assert: configInfo currentVersion versionString = '1.0'. 
	self assert: configInfo printString = 'MBFooTests 1.0(dkh.1)'.
! !

!MBConfigurationRootTest methodsFor: 'tests' stamp: 'BernardoContreras 11/5/2014 20:48'!
test0062InfoListChanged
	| infoListChanged changedValuable configClassName configClass configInfo |
	infoListChanged := false.
	changedValuable := [ :ann | infoListChanged := true ].
	[ 
		configurationRoot announcer when: MBInfoListChanged do: changedValuable.

		"load configuration"
		configClassName := #ConfigurationOfMBFooTests.
		gofer version: 'ConfigurationOfMBFooTests-dkh.3'.
		gofer load.

		self deny: infoListChanged.
		infoListChanged := false.

		configClassName := #ConfigurationOfMBFooTests.
		configClass := Smalltalk at: configClassName ifAbsent: [].
		configInfo := configurationRoot configurationInfoFor: configClass.

		"load 1.0"
		((Smalltalk at: #ConfigurationOfMBFooTests) project version: '1.0') load.

		self deny: infoListChanged.
		infoListChanged := false.

		self assert: configInfo currentVersion versionString = '1.0'.
		configInfo infoList. "prime the pump"

		"load 1.2"
		((Smalltalk at: #ConfigurationOfMBFooTests) project version: '1.2') load.

		self assert: infoListChanged.
	 ] 
			ensure: [ configurationRoot announcer unsubscribe: changedValuable   ].
! !

!MBConfigurationRootTest methodsFor: 'tests' stamp: 'BernardoContreras 11/5/2014 20:47'!
test0111InfoListChanged
	| infoListChanged changedValuable configClassName configClass configInfo unloadGofer |
	infoListChanged := false.
	changedValuable := [ :ann | infoListChanged := true ].
	[ 
		configurationRoot announcer when: MBInfoListChanged do: changedValuable.

		"load configuration"
		gofer version: 'ConfigurationOfMBFooTests-dkh.3'.
		gofer load.

		self deny: infoListChanged.
		infoListChanged := false.

		configClassName := #ConfigurationOfMBFooTests.
		configClass := Smalltalk at: configClassName ifAbsent: [].
		configInfo := configurationRoot configurationInfoFor: configClass.

		"load version 1.2"
		((Smalltalk at: #ConfigurationOfMBFooTests) project version: '1.2')  load.

		self deny: infoListChanged.
		infoListChanged := false.

		self assert: configInfo currentVersion versionString = '1.2'.
		configInfo infoList. "prime the pump"

		"unload MBFooTests-dkh.3"
		unloadGofer := Gofer new.
		unloadGofer disablePackageCache.
		unloadGofer version: 'MBFooTests-dkh.3'.
		[ unloadGofer unload ] on: Warning do: [:ex | ex resume ].

		self assert: infoListChanged.
	 ] 
			ensure: [ configurationRoot announcer unsubscribe: changedValuable   ].

! !

!MBConfigurationRootTest methodsFor: 'tests' stamp: 'ChristopheDemarey 8/31/2012 17:51'!
test0050BasicVersionLoad
	"Fifth test:
	 	- load configuration dkh.2(no events when loading version 1.1!!)
		- send currentVersion to configInfo ... which record currentVersion
		- load version 1.0 and currentVersion should be updated to reflect fact that pacakges loaded.
		- load version 1.1 and verify"
	| configClass configClassName configInfo |
	gofer version: 'ConfigurationOfMBFooTests-dkh.2'.
	gofer load.
	configClassName := #ConfigurationOfMBFooTests.
	self assert: (configClass := Smalltalk at: configClassName ifAbsent: []) notNil.
	configInfo := configurationRoot configurationInfoFor: configClass.
	self assert: configInfo printString = 'MBFooTests(dkh.2)'.
	self assert: configInfo currentVersion isNil.

	"load version 1.0"
	((Smalltalk at: #ConfigurationOfMBFooTests) project version: '1.0') load.
	self assert: configInfo printString = 'MBFooTests 1.0(dkh.2)'.
	self assert: configInfo currentVersion versionString = '1.0'.
	self assert: configInfo printString = 'MBFooTests 1.0(dkh.2)'.

	"load version 1.1"
	((Smalltalk at: #ConfigurationOfMBFooTests) project version: '1.1')  load.
	self flag: '...NOTE dkh.2 is identical to dkh.1and no events generated on load'.
	self assert: configInfo printString = 'MBFooTests 1.0(dkh.2)'.
! !

!MBConfigurationRootTest methodsFor: 'tests' stamp: 'BernardoContreras 11/5/2014 20:50'!
test0101ConfigurationInfoDeleted
	| createdValuable configClassName configInfoCreated configInfoChanged changedValuable configInfoDeleted deletedValuable configClass configInfo |
	configInfoDeleted := configInfoChanged := configInfoCreated := false.
	createdValuable := [ :ann | configInfoCreated := true ].
	changedValuable := [ :ann | configInfoChanged := true ].
	deletedValuable := [ :ann | configInfoDeleted := true ].
	[ 
		configurationRoot announcer when: MBConfigurationInfoCreated do: createdValuable.
		configurationRoot announcer when: MBConfigurationInfoChanged do: changedValuable.
		configurationRoot announcer when: MBConfigurationInfoDeleted do: deletedValuable.
		configClassName := #ConfigurationOfMBFooTests.

		"load configuration"
		gofer version: 'ConfigurationOfMBFooTests-dkh.1'.
		gofer load.

		self assert: configInfoCreated.
		self assert: configInfoChanged.
		self deny: configInfoDeleted.
		configInfoDeleted := configInfoChanged := configInfoCreated := false.

		configClassName := #ConfigurationOfMBFooTests.
		self assert: (configClass := Smalltalk at: configClassName ifAbsent: []) notNil.
		configInfo := configurationRoot configurationInfoFor: configClass.
		self assert: configInfo printString = 'MBFooTests(dkh.1)'.

		"unload dkh.3"
		gofer unload.

		self deny: configInfoCreated.
		self assert: configInfoChanged.
		self assert: configInfoDeleted.
		configInfoDeleted := configInfoChanged := configInfoCreated := false.
		self assert: (configurationRoot configurations includes: configInfo) not.

	 ] 
			ensure: [ configurationRoot announcer 
					unsubscribe: createdValuable;
					unsubscribe: deletedValuable;
					unsubscribe: changedValuable   ].
! !

!MBConfigurationRootTest methodsFor: 'tests' stamp: 'ChristopheDemarey 8/28/2012 14:05'!
test0100BasicConfigurationUnload
	"10:
	 	- load configuration dkh.3
		- unload configuration"

	"load dkh.3"
	| configClassName configClass configInfo |
	gofer version: 'ConfigurationOfMBFooTests-dkh.3'.
	gofer load.

	configClassName := #ConfigurationOfMBFooTests.
	self assert: (configClass := Smalltalk at: configClassName ifAbsent: []) notNil.
	configInfo := configurationRoot configurationInfoFor: configClass.
	self assert: configInfo printString = 'MBFooTests(dkh.3)'.

	"unload dkh.3"
	gofer unload.

	self assert: (configurationRoot configurations includes: configInfo) not.
! !

!MBConfigurationRootTest methodsFor: 'running' stamp: 'dkh 3/9/2011 17:28'!
tearDown
	configurationRoot ifNotNil: [ configurationRoot unregister ].
	Smalltalk removeKey: #'MB_Foo_Test_Repository' ifAbsent: [].
	gofer := Gofer new.
	self tearDownPackages do: [:pkgName | (self hasPackage: pkgName) ifTrue: [ gofer package: pkgName ]].
	gofer references notEmpty ifTrue: [ gofer unload ].
! !

!MBConfigurationRootTest methodsFor: 'tests' stamp: 'ChristopheDemarey 8/31/2012 17:56'!
test0090BasicVersionLoad
	"9:
	 	- load configuration dkh.3
		- load version 1.2
		- edit class
		- verify state
		- revert MBFooTests-dkh.3
		- validate"
	| configClass configClassName configInfo expected infos revertGofer |
	gofer version: 'ConfigurationOfMBFooTests-dkh.3'.
	gofer load.
	configClassName := #ConfigurationOfMBFooTests.
	self assert: (configClass := Smalltalk at: configClassName ifAbsent: []) notNil.
	configInfo := configurationRoot configurationInfoFor: configClass.
	self assert: configInfo printString = 'MBFooTests(dkh.3)'.
	self assert: configInfo currentVersion isNil.

	"load version 1.2"
	((Smalltalk at: #ConfigurationOfMBFooTests) project version: '1.2')  load.
	self assert: (configInfo printString) = 'MBFooTests 1.2(dkh.3)'.
	self assert: configInfo currentVersion versionString = '1.2'.

	"modify class in MBFooTests project"
	(Smalltalk at: #MBFooTestA)
		compile: 'bar ^self' classified: 'mod'.

	self assert: (configInfo printString) = '* MBFooTests 1.2(dkh.3)'.
	self assert: configInfo asStringOrText isText.
	"packages"
	infos := configInfo packages.
	self assert: infos size = 1.
	expected := #('* MBFooTests-dkh.3').
	1 to: infos size do: [:index | | info |
		info := infos at: index.
		self assert: info printString = (expected at: index).
		self assert: info asStringOrText isText].

	"revert MBFooTests-dkh.3"
	revertGofer := Gofer new.
	revertGofer disablePackageCache.
	gofer repositories do: [ :repo | revertGofer repository: repo ].
	revertGofer version: 'MBFooTests-dkh.3'.
	[ revertGofer load ] on: Warning do: [:ex | ex resume ].

	self assert: (configInfo printString) = '* MBFooTests 1.2(dkh.3)'.
	self assert: ((configInfo asStringOrText isString) or: (configInfo asStringOrText isText)).
	"packages"
	infos := configInfo packages.
	self assert: infos size = 1.
	expected := #('* MBFooTests-dkh.3').
	1 to: infos size do: [:index | | info |
		info := infos at: index.
		self assert: info printString = (expected at: index).
		self assert: ((info asStringOrText isString) or: (info asStringOrText isText))].
! !

!MBConfigurationRootTest methodsFor: 'tests' stamp: 'dkh 3/10/2011 08:08'!
test0010BasicLoad
	"First test: 
		- make sure that the configuration can be loaded without error
		- make sure that version 1.0 can be loaded without error"
	
	configurationRoot unregister.
	self assert: (Smalltalk at: #ConfigurationOfMBFooTests ifAbsent: []) isNil.
	gofer version: 'ConfigurationOfMBFooTests-dkh.1'.
	gofer load.
	((Smalltalk at: #ConfigurationOfMBFooTests) project version: '1.0') load.
	self assert: (Smalltalk at: #MBFooTestA ifAbsent: []) notNil
! !

!MBConfigurationRootTest methodsFor: 'scenarios' stamp: 'dkh 3/18/2011 19:00'!
scenariosForTests
	"
	1. select a configuration, then unload the configuration ... in OB you gtt an error because the 
		project was undefined .... simulate by creating a ConfigurationOf class that is not a real configuration
	2. add new configuration should associate the chosen repository with the configuration, too...maybe 
		addConfigurationTest should check this
	3. add new configuration then do checkpoing dev and note that dirty * is still on the label in the browser
	"! !

!MBConfigurationRootTest methodsFor: 'tests' stamp: 'BernardoContreras 11/5/2014 20:52'!
test0031ConfigurationInfoChanged
	"If you don't touch the currentVersion of a configurationInfo, then no changed event is signaled on load."
	| createdValuable configClassName configInfoCreated configInfoChanged changedValuable configInfoDeleted deletedValuable |
	configInfoDeleted := configInfoChanged := configInfoCreated := false.
	createdValuable := [ :ann | configInfoCreated := true ].
	changedValuable := [ :ann | configInfoChanged := true ].
	deletedValuable := [ :ann | configInfoDeleted := true ].
	[ 
		configurationRoot announcer when: MBConfigurationInfoCreated do: createdValuable.
		configurationRoot announcer when: MBConfigurationInfoChanged do: changedValuable.
		configurationRoot announcer when: MBConfigurationInfoDeleted do: deletedValuable.

		"load configuration"
		configClassName := #ConfigurationOfMBFooTests.
		gofer version: 'ConfigurationOfMBFooTests-dkh.1'.
		gofer load.

		self assert: configInfoCreated.
		self assert: configInfoChanged.
		self deny: configInfoDeleted.
		configInfoDeleted := configInfoChanged := configInfoCreated := false.

		"load 1.0"
		((Smalltalk at: #ConfigurationOfMBFooTests) project version: '1.0') load.

		self deny: configInfoCreated.
		self assert: configInfoChanged.
		self deny: configInfoDeleted.
	 ] 
			ensure: [ configurationRoot announcer 
					unsubscribe: createdValuable;
					unsubscribe: deletedValuable;
					unsubscribe: changedValuable   ].
! !

!MBConfigurationRootTest methodsFor: 'tests' stamp: 'BernardoContreras 11/5/2014 20:50'!
test0083InfoListChanged
	| infoListChanged changedValuable configClassName configClass configInfo |
	infoListChanged := false.
	changedValuable := [ :ann | infoListChanged := true ].
	[ 
		configurationRoot announcer when: MBInfoListChanged do: changedValuable.

		"load configuration"
		configClassName := #ConfigurationOfMBFooTests.
		gofer version: 'ConfigurationOfMBFooTests-dkh.3'.
		gofer load.

		self deny: infoListChanged.
		infoListChanged := false.

		configClassName := #ConfigurationOfMBFooTests.
		configClass := Smalltalk at: configClassName ifAbsent: [].
		configInfo := configurationRoot configurationInfoFor: configClass.

		"load 1.2"
		((Smalltalk at: #ConfigurationOfMBFooTests) project version: '1.2') load.

		self deny: infoListChanged.
		infoListChanged := false.

		self assert: configInfo currentVersion versionString = '1.2'.
		configInfo infoList. "prime the pump"

		"modify class in MBFooTests project"
		(Smalltalk at: #MBFooTestA)
			compile: 'bar ^self' classified: 'mod'.

		self assert: infoListChanged.
	 ] 
			ensure: [ configurationRoot announcer unsubscribe: changedValuable   ].
! !

!MBConfigurationRootTest methodsFor: 'running' stamp: 'dkh 3/9/2011 17:24'!
setUp

	| repo |
	super setUp.
	gofer := Gofer new.
	gofer disablePackageCache.
	repo := MBMonticelloPackagesResource current monticelloRepository.
	gofer repository: repo.
	Smalltalk at: #'MB_Foo_Test_Repository' put: repo.
	configurationRoot := MBConfigurationRoot new.
	configurationRoot register.
	! !

!MBConfigurationRootTest methodsFor: 'tests' stamp: 'ChristopheDemarey 8/28/2012 13:57'!
test0060BasicVersionLoad
	"Sixth test:
	 	- load configuration dkh.3
		- send currentVersion to configInfo ... which record currentVersion
		- load version 1.0 and currentVersion should be updated to reflect fact that pacakges loaded.
		- load version 1.2 and verify"
	| configClass configClassName configInfo |
	gofer version: 'ConfigurationOfMBFooTests-dkh.3'.
	gofer load.
	configClassName := #ConfigurationOfMBFooTests.
	self assert: (configClass := Smalltalk at: configClassName ifAbsent: []) notNil.
	configInfo := configurationRoot configurationInfoFor: configClass.
	self assert: configInfo printString = 'MBFooTests(dkh.3)'.
	self assert: configInfo currentVersion isNil.

	"load version 1.0"
	((Smalltalk at: #ConfigurationOfMBFooTests) project version: '1.0') load.
	self assert: configInfo printString = 'MBFooTests 1.0(dkh.3)'.
	self assert: configInfo currentVersion versionString = '1.0'.
	self assert: configInfo printString = 'MBFooTests 1.0(dkh.3)'.


	"load version 1.2"
	((Smalltalk at: #ConfigurationOfMBFooTests) project version: '1.2')  load.
	self assert: configInfo printString = 'MBFooTests 1.2(dkh.3)'.
! !

!MBConfigurationRootTest methodsFor: 'tests' stamp: 'ChristopheDemarey 8/27/2012 15:48'!
test0030BasicVersionLoad
	"Third test: 
		- load configuration version dkh.1
		- verfy that the target data structures are as expected
		- load version 1.0
		- check that that expected changes to the data structures occur ... in this case that the package is loaded"
	
	| configClass configClassName configInfo versions versionInfo packages packageInfo text x |
	gofer version: 'ConfigurationOfMBFooTests-dkh.1'.
	gofer load.
	configClassName := #ConfigurationOfMBFooTests.
	self assert: (configClass := Smalltalk at: configClassName ifAbsent: []) notNil.
	configInfo := configurationRoot configurationInfoFor: configClass.
	self assert: configInfo printString = 'MBFooTests(dkh.1)'.
	text := configInfo asStringOrText.
	self assert: text isString.
	self assert: text  = 'MBFooTests(dkh.1)'.
	versions := configInfo versions.
	self assert: versions size = 1.
	versionInfo := versions first.
	packages := versionInfo packages.
	self assert: packages size = 1.
	packageInfo := packages first.
	self assert: packageInfo workingCopy isNil.
	self assert: packageInfo printString = 'MBFooTests ---'.
	text := packageInfo asStringOrText.
	self assert: text isString.
	self assert: text  = 'MBFooTests ---'.

	"load version 1.0"
	((Smalltalk at: #ConfigurationOfMBFooTests) project version: '1.0') load.
	self assert: configInfo printString = 'MBFooTests 1.0(dkh.1)'.
	self assert: configInfo currentVersion versionString = '1.0'. 
	self assert: configInfo printString = 'MBFooTests 1.0(dkh.1)'.
	text := configInfo asStringOrText.
	self assert: text isString.
	self assert: text  = 'MBFooTests 1.0(dkh.1)'.
	versions := configInfo versions.
	self assert: versions size = 1.
	"reacquire the packageInfo instance, since the old instance is not valid"
	versionInfo := versions first.
	packages := versionInfo packages.
	self assert: packages size = 1.
	packageInfo := packages first.
	self assert: packageInfo workingCopy notNil.
	self assert: packageInfo printString = 'MBFooTests-dkh.1'.
	text := packageInfo asStringOrText.
	self assert: text isString.
	self assert: text  = 'MBFooTests-dkh.1'.
! !

!MBConfigurationRootTest methodsFor: 'tests' stamp: 'ChristopheDemarey 8/28/2012 13:59'!
test0081BasicVersionLoad
	"8.1:
	 	- load configuration dkh.3
		- load version 1.2
		- validate package and configInfo state
		- edit class
		- validate #recalculate variant for currentVersion"
	| configClass configClassName configInfo expected infos|
	gofer version: 'ConfigurationOfMBFooTests-dkh.3'.
	gofer load.
	configClassName := #ConfigurationOfMBFooTests.
	self assert: (configClass := Smalltalk at: configClassName ifAbsent: []) notNil.
	configInfo := configurationRoot configurationInfoFor: configClass.
	self assert: configInfo printString = 'MBFooTests(dkh.3)'.
	self assert: configInfo currentVersion isNil.
	self assert: configInfo asStringOrText  = 'MBFooTests(dkh.3)'.
 
	"load version 1.2"
	((Smalltalk at: #ConfigurationOfMBFooTests) project version: '1.2')  load.
	self assert: configInfo printString = 'MBFooTests 1.2(dkh.3)'. 
	self assert: configInfo currentVersion versionString = '1.2'. 
	self assert: configInfo printString = 'MBFooTests 1.2(dkh.3)'.
	self assert: configInfo asStringOrText  = 'MBFooTests 1.2(dkh.3)'.
	
	"modify class in MBFooTests project"
	(Smalltalk at: #MBFooTestA)
		compile: 'bar ^self' classified: 'mod'.

	self assert: configInfo printString = '* MBFooTests 1.2(dkh.3)'. 
	self assert: configInfo asStringOrText  = '* MBFooTests 1.2(dkh.3)'.
! !

!MBConfigurationRootTest methodsFor: 'tests' stamp: 'ChristopheDemarey 8/28/2012 14:09'!
test0110BasicPackageUnload

	"load dkh.3"
	| configClassName configClass configInfo unloadGofer infos |
	gofer version: 'ConfigurationOfMBFooTests-dkh.3'.
	gofer load.

	configClassName := #ConfigurationOfMBFooTests.
	self assert: (configClass := Smalltalk at: configClassName ifAbsent: []) notNil.
	configInfo := configurationRoot configurationInfoFor: configClass.
	self assert: configInfo printString = 'MBFooTests(dkh.3)'.

	"load version 1.2"
	((Smalltalk at: #ConfigurationOfMBFooTests) project version: '1.2')  load.

	"unload MBFooTests-dkh.3"
	unloadGofer := Gofer new.
	unloadGofer disablePackageCache.
	unloadGofer version: 'MBFooTests-dkh.3'.
	[ unloadGofer unload ] on: Warning do: [:ex | ex resume ].

	self assert: (configInfo printString) = 'MBFooTests(dkh.3)'.
	self assert: configInfo asStringOrText isString.
	"packages"
	infos := configInfo packages.
	self assert: infos size = 0.
! !

!MBConfigurationRootTest methodsFor: 'running' stamp: 'dkh 3/9/2011 17:34'!
tearDownPackages

	^#('MBFooTests' 'ConfigurationOfMBFooTests')! !

!MBConfigurationRootTest methodsFor: 'tests' stamp: 'BernardoContreras 11/5/2014 20:53'!
test0061ConfigurationInfoChanged
	"Touch the currentVersion of a configurationInfo, expect a changed event on load"
	| createdValuable configClassName configInfoCreated configInfoChanged changedValuable configInfoDeleted deletedValuable configInfo configClass |
	configInfoDeleted := configInfoChanged := configInfoCreated := false.
	createdValuable := [ :ann | configInfoCreated := true ].
	changedValuable := [ :ann | configInfoChanged := true ].
	deletedValuable := [ :ann | configInfoDeleted := true ].
	[ 
		configurationRoot announcer when: MBConfigurationInfoCreated do: createdValuable.
		configurationRoot announcer when: MBConfigurationInfoChanged do: changedValuable.
		configurationRoot announcer when: MBConfigurationInfoDeleted do: deletedValuable.

		"load configuration"
		configClassName := #ConfigurationOfMBFooTests.
		gofer version: 'ConfigurationOfMBFooTests-dkh.3'.
		gofer load.

		self assert: configInfoCreated.
		self assert: configInfoChanged.
		self deny: configInfoDeleted.
		configInfoDeleted := configInfoChanged := configInfoCreated := false.

		configClassName := #ConfigurationOfMBFooTests.
		configClass := Smalltalk at: configClassName ifAbsent: [].
		configInfo := configurationRoot configurationInfoFor: configClass.

		"load 1.0"
		((Smalltalk at: #ConfigurationOfMBFooTests) project version: '1.0') load.

		self deny: configInfoCreated.
		self assert: configInfoChanged.
		self deny: configInfoDeleted.
		configInfoDeleted := configInfoChanged := configInfoCreated := false.

		self assert: configInfo currentVersion versionString = '1.0'.
		configInfo packages. "prime the pump"

		"load 1.2"
		((Smalltalk at: #ConfigurationOfMBFooTests) project version: '1.2') load.

		self deny: configInfoCreated.
		self assert: configInfoChanged.
		self deny: configInfoDeleted.
	 ] 
			ensure: [ configurationRoot announcer 
					unsubscribe: createdValuable;
					unsubscribe: deletedValuable;
					unsubscribe: changedValuable   ].
! !

!MBConfigurationRootTest methodsFor: 'tests' stamp: 'ChristopheDemarey 8/28/2012 14:09'!
test0120ConfigPackageSave
	"Issue 125 test
	 	- load configuration dkh.3
		- load version 1.2
		- modify configuration and validate
		- save configuration package and validate"
	| configClass configClassName configInfo expected infos suggestedName signature |
	"load configuration dkh.3"
	gofer version: 'ConfigurationOfMBFooTests-dkh.3'.
	gofer load.
	configClassName := #ConfigurationOfMBFooTests.
	self assert: (configClass := Smalltalk at: configClassName ifAbsent: []) notNil.
	configInfo := configurationRoot configurationInfoFor: configClass.

	"load version 1.2"
	((Smalltalk at: #ConfigurationOfMBFooTests) project version: '1.2')  load.
	self assert: configInfo workingCopy notNil. 
	
	self assert: configInfo printString = 'MBFooTests 1.2(dkh.3)'.
	self assert: configInfo currentVersion versionString = '1.2'.
	self assert: configInfo printString = 'MBFooTests 1.2(dkh.3)'.
	self assert: configInfo asStringOrText isString.
	
	"modify class in ConfigurationOfMBFooTests class"
	(Smalltalk at: #ConfigurationOfMBFooTests)
		compile: 'bar ^self' classified: 'mod'.

	self assert: configInfo printString = '* MBFooTests 1.2(dkh.3)'.
	self assert: configInfo asStringOrText isText.

	"save the configuraiton package"
	[ Gofer new
		disablePackageCache;
		repository: (MCDictionaryRepository new);
		package: configClassName asString;
		commit ] 
			on: MCVersionNameAndMessageRequest
			do: [:ex |  
				suggestedName := ex suggestedName.
				ex resume: { suggestedName.  'commit comment'}].

	signature := suggestedName copyAfterLast: $-.
	self assert: configInfo printString = ('MBFooTests 1.2(', signature, ')').
	self assert: configInfo asStringOrText isString.
! !

!MBConfigurationRootTest methodsFor: 'tests' stamp: 'ChristopheDemarey 11/22/2013 11:14'!
test0020BasicConfigurationLoad
	"Second test:
		- load configuration version dkh.1
		- verify that config info added to root
		- validate that all of the data structures are correct .... based on the configuration. "
	| configClassName configClass configInfo baselines versions info packages text |
	configClassName := #ConfigurationOfMBFooTests.
	self assert: (Smalltalk at: configClassName ifAbsent: []) isNil.
	gofer version: 'ConfigurationOfMBFooTests-dkh.1'.
	gofer load.
	self assert: (configClass := Smalltalk at: configClassName ifAbsent: []) notNil.
	"configuration"
	configInfo := configurationRoot configurationInfoFor: configClass.
	self assert: configInfo notNil.  
	self assert: configInfo configurationClass == configClass.
	self assert: configInfo isDirty not.
	self assert: configInfo currentVersion isNil.
	self assert: configInfo name = configClassName asString.
	self assert: configInfo validate isEmpty.
	self assert: configInfo projects isEmpty.
	self assert: configInfo packages isEmpty.
	self assert: configInfo groups isEmpty.
	self assert: configInfo printString = 'MBFooTests(dkh.1)'.
	text := configInfo asStringOrText.
	self assert: text isString.
	self assert: text  = 'MBFooTests(dkh.1)'.
	baselines := configInfo baselines.
	self assert: baselines size = 1.
	"baseline"
	info := baselines first.
	self assert: info version blessing == #baseline.
	self assert: info version versionString = '1.0-baseline'.
	self assert: info isDirty not.
	self assert: info validate isEmpty.
	self assert: info projects isEmpty.
	self assert: info groups isEmpty.
	packages := info packages.
	self assert: packages size = 1.
	info := packages first.
	self assert: info isDirty not.
	self assert: info packageName = 'MBFooTests'.
	self assert: (info spec isKindOf: MetacelloPackageSpec). 
	self assert: info spec file = 'MBFooTests'. 
	versions := configInfo versions.
	self assert: versions size = 2.
	"version"
	info := versions first.
	self assert: info version blessing == #release.
	self assert: info version versionString = '1.0'.
	self assert: info isDirty not.
	self assert: info validate isEmpty.
	self assert: info projects isEmpty.
	self assert: info groups isEmpty.
	packages := info packages.
	self assert: packages size = 1.
	info := packages first.
	self assert: info isDirty not.
	self assert: info packageName = 'MBFooTests'.
	self assert: (info spec isKindOf: MetacelloPackageSpec). 
	self assert: info spec file = 'MBFooTests-dkh.1'. 
! !

!MBConfigurationRootTest methodsFor: 'tests' stamp: 'ChristopheDemarey 8/28/2012 13:59'!
test0080BasicVersionLoad
	"Eighth test:
	 	- load configuration dkh.3
		- load version 1.2
		- validate package and configInfo state
		- edit class and validate"
	| configClass configClassName configInfo expected infos x |
	gofer version: 'ConfigurationOfMBFooTests-dkh.3'.
	gofer load.
	configClassName := #ConfigurationOfMBFooTests.
	self assert: (configClass := Smalltalk at: configClassName ifAbsent: []) notNil.
	configInfo := configurationRoot configurationInfoFor: configClass.
	self assert: configInfo printString = 'MBFooTests(dkh.3)'.
	self assert: configInfo currentVersion isNil.

	"load version 1.2"
	((Smalltalk at: #ConfigurationOfMBFooTests) project version: '1.2')  load.
	self assert: configInfo printString = 'MBFooTests 1.2(dkh.3)'.
	self assert: configInfo currentVersion versionString = '1.2'.
	self assert: configInfo printString = 'MBFooTests 1.2(dkh.3)'.
	self assert: configInfo asStringOrText isString.
	"versions"
	infos := configInfo versions.
	self assert: infos size = 3.
	expected := #(' @ 1.2' '1.1' '1.0 #stable').
	1 to: infos size do: [:index | | info |
		info := infos at: index.
		self assert: info printString = (expected at: index)].
	"packages"
	infos := configInfo packages.
	self assert: infos size = 1.
	expected := #('MBFooTests-dkh.3').
	1 to: infos size do: [:index | | info |
		info := infos at: index.
		self assert: info printString = (expected at: index).
		self assert: info asStringOrText isString ].
	
	"modify class in MBFooTests project"
	(Smalltalk at: #MBFooTestA)
		compile: 'bar ^self' classified: 'mod'.

	self assert: (x := configInfo printString) = '* MBFooTests 1.2(dkh.3)'.
	self assert: configInfo asStringOrText isText.
	"packages"
	infos := configInfo packages.
	self assert: infos size = 1.
	expected := #('* MBFooTests-dkh.3').
	1 to: infos size do: [:index | | info |
		info := infos at: index.
		self assert: info printString = (expected at: index).
		self assert: info asStringOrText isText].
! !

!MBConfigurationRootTest methodsFor: 'tests' stamp: 'BernardoContreras 11/5/2014 20:51'!
test0032InfoListChanged

	| infoListChanged changedValuable |
	infoListChanged := false.
	changedValuable := [ :ann | infoListChanged := true ].
	[ 
		configurationRoot announcer when: MBInfoListChanged do: changedValuable.

		"load configuration"
		gofer version: 'ConfigurationOfMBFooTests-dkh.1'.
		gofer load.

		self deny: infoListChanged.
		infoListChanged := false.

		"load 1.0"
		((Smalltalk at: #ConfigurationOfMBFooTests) project version: '1.0') load.

		self deny: infoListChanged.
	 ] 
			ensure: [ configurationRoot announcer unsubscribe: changedValuable   ].
! !

!MBConfigurationRootTest methodsFor: 'tests' stamp: 'ChristopheDemarey 8/28/2012 14:05'!
test0091PackageMismatch
	"
	 	- load configuration dkh.3
		- load version 1.2
		- validate package printString
		- load MBFooTests-dkh.4
		- validate package printString
	"
	| configClass configClassName configInfo expected infos revertGofer |
	gofer version: 'ConfigurationOfMBFooTests-dkh.3'.
	gofer load.
	configClassName := #ConfigurationOfMBFooTests.
	configClass := Smalltalk at: configClassName ifAbsent: [].
	configInfo := configurationRoot configurationInfoFor: configClass.

	"load version 1.1"
	((Smalltalk at: #ConfigurationOfMBFooTests) project version: '1.2')  load.
	self assert: (configInfo printString) = 'MBFooTests 1.2(dkh.3)'.
	self assert: configInfo currentVersion versionString = '1.2'.

	"packages"
	infos := configInfo packages.
	self assert: infos size = 1.
	expected := #('MBFooTests-dkh.3').
	1 to: infos size do: [:index | | info |
		info := infos at: index.
		self assert: info printString = (expected at: index).
		self assert: info asStringOrText isString].

	"load MBFooTests-dkh.4"
	gofer version: 'MBFooTests-dkh.4'.
	gofer load.

	"packages"
	infos := configInfo packages.
	self assert: infos size = 1.
	expected := #('MBFooTests-dkh.3[dkh.4]').
	1 to: infos size do: [:index | | info |
		info := infos at: index.
		self assert: info printString = (expected at: index).
		self assert: info asStringOrText isText].
! !

!MBConfigurationRootTest methodsFor: 'running' stamp: 'dkh 4/17/2011 14:50'!
hasPackage: aString
	| package |
	package := MCWorkingCopy allManagers
		detect: [ :each | each packageName = aString ]
		ifNone: [ nil ].
	^ package notNil! !

!MBCopyBaselineCommand commentStamp: 'TorstenBergmann 2/20/2014 14:11'!
Command to copy a baseline in Versionner!
!MBCopyBaselineCommand methodsFor: 'documentation' stamp: 'fds 2/26/2011 19:48'!
documentation
	^ 'Copy the selected baseline under a new name'! !

!MBCopyBaselineCommand methodsFor: 'accessing' stamp: 'dkh 3/20/2011 16:16'!
title
	^ 'copy baseline'! !

!MBCopyBaselineCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 10/18/2012 11:32'!
copyBaselineWithNumber: baselineNumberAsString
	"Copy myself into a new baseline, with a different number"

	| sourceCode newSource newNumber newSelector comment |
	self 
		assert: [ baselineNumberAsString ~= target versionString ] 
		description: 'Cannot assign the same baseline number than me to my copy'.
		
	self 
		assert: [ (baselineNumberAsString endsWith: 'baseline') not ] 
		description: 'The baseline number cannot end with "-baseline". It will be automatically added.'.

	comment := self uiManager request: 'Enter a comment for the new baseline'.
	MetacelloToolBox 
		createBaseline: baselineNumberAsString, '-baseline' 
		for: target configurationBasename 
		from: target versionString 
		description: comment.! !

!MBCopyBaselineCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 10/18/2012 11:32'!
execute

	| answer |
	answer := self uiManager request: 'give a new baseline number (the prefix "-baseline" will be added)'.
	answer ifNil: [ ^ self ].

	self copyBaselineWithNumber: answer

! !

!MBDevCycleCommands commentStamp: 'TorstenBergmann 2/20/2014 14:09'!
Common superclass for Versionner commands related to the development cycle!
!MBGroupInfo commentStamp: '<historical>'!
A MBGroupInfo holds information on a group defintiion.

Instance Variables
	groupContents:		an array with group contents as literals .
!
!MBGroupInfo methodsFor: 'accessing' stamp: 'AlexandreBergel 3/27/2011 12:11'!
groupContentsIfLoaded

	| version loadedPackageNames groupPackageNames |
	groupContents ~~ nil ifTrue: [ ^groupContents ].
	groupContents := #().
	self configurationInfo ifNil: [ ^ groupContents ].
	(version := self configurationInfo currentVersion) ifNil: [ ^groupContents ].
	loadedPackageNames := version defaultPackageNamesToLoad: #().
	loadedPackageNames remove: 'default' ifAbsent: [].
	groupPackageNames := (version packagesForSpecNamed: self name) collect: [:spc | spc name ].
	groupPackageNames do: [:nm | (loadedPackageNames includes: nm) ifFalse: [ ^groupContents ] ].
	^groupContents := self spec includes! !

!MBGroupInfo methodsFor: 'accessing' stamp: 'dkh 3/1/2011 11:51'!
name: aName

	self shouldNotImplement! !

!MBGroupInfo methodsFor: 'accessing' stamp: 'dkh 3/1/2011 11:51'!
name
	^ self spec name! !

!MBGroupInfo methodsFor: '*versionner-spec-browser' stamp: 'TesterBob 10/5/2012 17:31'!
accept: aVisitor
	^ aVisitor visitGroup: self.! !

!MBGroupInfo methodsFor: 'printing' stamp: 'dkh 3/1/2011 20:03'!
printOn: aStream
	| loadedPackageNames |
	super printOn: aStream.
	(loadedPackageNames := self groupContentsIfLoaded) isEmpty
		ifTrue: [ aStream nextPutAll: ' ---' ]
		ifFalse: [ 
			aStream nextPutAll: ' [ '.
			loadedPackageNames do: [:pkgName | aStream nextPutAll: pkgName, ' '  ].
			aStream nextPut: $] ].! !

!MBGroupInfo methodsFor: 'accessing' stamp: 'dkh 3/2/2011 21:42'!
typeLabel

	^'group'! !

!MBGroupInfo class methodsFor: 'accessing' stamp: 'dkh 4/10/2011 19:57'!
helpLabel

	^'Group'! !

!MBGroupInfoTest commentStamp: 'TorstenBergmann 2/20/2014 14:17'!
SUnit tests for MBGroupInfo in Versionner!
!MBGroupInfoTest methodsFor: 'tests' stamp: 'AlexandreBergel 3/27/2011 12:11'!
testPrintOn
	| str | 
	self shouldnt: [str := MBGroupInfo new printString] raise: Error.
	self assert: (str = 'nil ---').
	
! !

!MBGroupInfoTest methodsFor: 'tests' stamp: 'AlexandreBergel 3/27/2011 12:11'!
testgroupContentsIfLoaded

	self assert: MBGroupInfo new groupContentsIfLoaded isEmpty! !

!MBHelpCommand commentStamp: 'TorstenBergmann 2/20/2014 14:10'!
Command to open help for Versionner!
!MBHelpCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 10/18/2012 11:32'!
workspaceHelp
	| helpText |
	helpText := '"Versionner is a graphical tool to manage the dependencies and the version of your software. It is a complete replacement of the Monticello browser and acts as a facade for Metacello. You can use Versionner in a number of different scenarios.
	
**1-Creating a new configuration**
Press the button ''+Configuration'' and enter the name of your configuration. An initial baseline will also be produced. Your configuration and the new baseline will be listed on the left hand side of the browser. 

**2-Load a configuration**
The first button of the browser is for loading a configuration from its corresponding SqueakSource project. For example, entering ''Pharo'' will try to load ''ConfigurationOfPharo'' from the ''Pharo'' squeaksource project.

**3-Add a new baseline**
A baseline defines the dependencies of your software, including the list of dependent configurations, and the list of packages that defines your applications. Selecting ''Add Baseline'' by right clicking on an existing baseline will first ask you about your squeaksource username and password will be requested.  You then need to enter the version of your baseline (e.g., 0.1).
The final step is to add the dependent packages. 

**4-Add a new version**
A version defines the version of each packages used by your last baseline. At each change in your source code, you need to create a new version. Pressing ''save all and add development version'' by right clicking in a baseline or version may be the option you want to use. Versionner will try to guess what is the following number you need to use. 
Each unsaved dependent package is then saved. You need to enter a comment for the individual saved package. The configuration itself is then saved. At that stage, all your code is stored in squeaksource.

**5-Reviewing recent changes**
It may be useful to review your change, for example when you want to enter a comment when creating a version. At the bottom of the right hand side panel, you have the list of dependent packages. Modified packages will be designed with a ''*''. Right click on a package to see the difference with the last version stored in the squeaksource project. You can compare a package from the stable version of the software, or from the last commit made on squeaksource.

**6-Load a baseline or a version**
Simply right click on it and press ''load''

**7-Updating a configuration**
In case of concurrent development, you may have to update your configuration. Right-click on the configuration, and press the corresponding menu entry.

**8-Contact**
Feedback are welcome. Send them to the pharo mailing list, or directly to the author alexandrebergel@me.com
"
'.
	self uiManager edit: helpText label: 'Versionner Help'! !

!MBHelpCommand methodsFor: 'documentation' stamp: 'dkh 4/6/2011 15:10'!
documentation
	^ 'Open the help window'! !

!MBHelpCommand methodsFor: 'ordering' stamp: 'dkh 4/7/2011 22:20'!
order

	^'80'! !

!MBHelpCommand methodsFor: 'accessing' stamp: 'dkh 4/6/2011 15:11'!
title
	^ 'help'! !

!MBHelpCommand methodsFor: 'execute' stamp: 'dkh 4/10/2011 21:20'!
execute
	Smalltalk at: #HelpBrowser ifPresent: [ :class | ^class openOn: (Smalltalk at: #VersionnerHelp) ].
	self workspaceHelp! !

!MBInfo commentStamp: 'TorstenBergmann 2/20/2014 14:11'!
Common superclass for Versionner infos!
!MBInfo methodsFor: 'accessing' stamp: 'dkh 3/10/2011 12:37'!
announcer 

	^self configurationRoot announcer! !

!MBInfo methodsFor: 'accessing' stamp: 'dkh 3/6/2011 14:54'!
configurationRoot

	^self configurationInfo configurationRoot! !

!MBInfo methodsFor: 'accessing' stamp: 'ChristopheDemarey 10/18/2012 10:50'!
validate
	"Returns by default an empty collection of problems"
	
	^#()! !

!MBInfo methodsFor: 'testing' stamp: 'dkh 2/27/2011 16:53'!
interestedInPackageNamed: packageName

	^false! !

!MBInfo methodsFor: 'accessing' stamp: 'dkh 3/6/2011 14:53'!
configurationInfo

	^self subclassResponsibility ! !

!MBInfo methodsFor: 'accessing' stamp: 'dkh 3/2/2011 16:39'!
project
	"Answer the MetacelloProject associated with the receiver."
	
	^nil! !

!MBInfo methodsFor: 'accessing' stamp: 'dkh 3/7/2011 21:45'!
text: anObject
	text := anObject! !

!MBInfo methodsFor: 'accessing' stamp: 'dkh 3/7/2011 21:47'!
text
	text ifNil: [ text := self buildStringOrText ].
	^text! !

!MBInfo methodsFor: 'actions' stamp: 'dkh 2/26/2011 11:46'!
clearValidationIcon

	validationIcon := nil! !

!MBInfo methodsFor: 'accessing' stamp: 'dkh 2/26/2011 16:17'!
browseValidationResults

	self validate explore! !

!MBInfo methodsFor: 'converting' stamp: 'dkh 3/7/2011 21:47'!
asStringOrText

	^self text! !

!MBInfo methodsFor: 'utils' stamp: 'dkh 3/4/2011 12:40'!
repositories
	"Return the repositories associated with the receiver."

	^#()! !

!MBInfo methodsFor: 'accessing' stamp: 'AlexandreBergel 1/1/2011 13:14'!
name: aName
	name := aName! !

!MBInfo methodsFor: 'actions' stamp: 'dkh 2/27/2011 20:45'!
validateFull

	self  validationResult: nil.
	^self validate! !

!MBInfo methodsFor: 'printing' stamp: 'AlexandreBergel 1/1/2011 14:14'!
printOn: aStream
	self name ifNil: [ aStream nextPutAll: '' . ^ self ].
	aStream nextPutAll: self name! !

!MBInfo methodsFor: 'accessing' stamp: 'dkh 2/27/2011 19:56'!
validationResult: anObject

	validationResult := anObject! !

!MBInfo methodsFor: 'commands' stamp: 'dkh 2/28/2011 16:40'!
commands
	^ (self class allSelectors select:
		[ :k | k beginsWith: 'cmd'  ]) collect: [ :k | self perform: k ]! !

!MBInfo methodsFor: 'utils' stamp: 'dkh 3/20/2011 09:40'!
extractPackageSignatureFrom: aWorkingCopy
	| ref |
	(aWorkingCopy isNil or: [ aWorkingCopy ancestors isEmpty ])
		ifTrue: [ ^ '' ].
	ref := GoferVersionReference name: aWorkingCopy ancestors first name.
	^ ref author , '.' , ref versionNumber asString! !

!MBInfo methodsFor: 'testing' stamp: 'AlexandreBergel 1/1/2011 15:08'!
isDirty
	^ false! !

!MBInfo methodsFor: 'accessing' stamp: 'dkh 3/7/2011 21:48'!
buildStringOrText
	^self printString! !

!MBInfo methodsFor: 'accessing' stamp: 'AlexandreBergel 1/1/2011 13:14'!
name
	^ name! !

!MBInfo class methodsFor: 'accessing' stamp: 'dkh 4/10/2011 19:55'!
helpLabel

	self subclassResponsibility! !

!MBInfo class methodsFor: 'accessing' stamp: 'dkh 2/27/2011 19:57'!
validateAll: aBool

	ValidateAll := aBool! !

!MBInfo class methodsFor: 'accessing' stamp: 'dkh 2/27/2011 19:57'!
validateAll

	ValidateAll == nil ifTrue: [ ValidateAll := false ].
	^ValidateAll! !

!MBInfoListChanged commentStamp: 'TorstenBergmann 2/20/2014 14:05'!
The info list changed!
!MBInfoListChanged methodsFor: 'accessing' stamp: 'dkh 3/10/2011 18:29'!
configurationInfo
	^ configurationInfo! !

!MBInfoListChanged methodsFor: 'accessing' stamp: 'dkh 3/10/2011 18:29'!
configurationInfo: anObject
	configurationInfo := anObject! !

!MBInfoListChanged class methodsFor: 'instance creation' stamp: 'dkh 3/10/2011 18:29'!
changed: aConfigurationInfo

	^(self new) 
		configurationInfo: aConfigurationInfo;
		yourself! !

!MBInfoTest commentStamp: 'TorstenBergmann 2/20/2014 14:13'!
Common SUnit tests for MBInfo!
!MBInfoTest methodsFor: 'tests' stamp: 'dkh 3/2/2011 07:58'!
testIsDirty
	"info is not dirty per default"
	self deny: MBInfo new isDirty! !

!MBInfoTest methodsFor: 'tests' stamp: 'dkh 3/4/2011 14:15'!
testName
	| info |
	info := MBInfo new.
	self assert: (info name isNil).

	info name: 'foobar'.
	self assert: (info name = 'foobar').
	self assert: (info printString = 'foobar').

! !

!MBInspectConfigurationCommand commentStamp: 'TorstenBergmann 2/20/2014 14:08'!
Command to inspect a configuration in versionner!
!MBInspectConfigurationCommand methodsFor: 'accessing' stamp: 'fds 2/27/2011 10:47'!
title
	^ 'inspect'! !

!MBInspectConfigurationCommand methodsFor: 'execute' stamp: 'fds 2/27/2011 10:47'!
execute
	target inspect! !

!MBInspectConfigurationCommand methodsFor: 'documentation' stamp: 'fds 2/27/2011 10:47'!
documentation
	^ 'Open a Smalltalk inspector on the Configuration.'! !

!MBLabelInfo commentStamp: 'TorstenBergmann 2/20/2014 14:12'!
A label info!
!MBLabelInfo methodsFor: 'accessing' stamp: 'dkh 2/27/2011 20:02'!
validationIcon

	^nil! !

!MBLabelInfo methodsFor: 'accessing' stamp: 'dkh 3/6/2011 19:25'!
validationIconSymbol

	^#blank! !

!MBLabelInfo methodsFor: 'accessing' stamp: 'dkh 2/26/2011 18:30'!
validate

	^nil! !

!MBLoadConfigurationCommand commentStamp: 'TorstenBergmann 2/20/2014 14:10'!
Command to load a configuration in Versionner!
!MBLoadConfigurationCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 11/6/2012 15:29'!
execute
	| projectRepository configRef configurationInfo versionInfos versionInfo version configRefMap configNames configName |
	projectRepository := self askForProjectName.
	projectRepository ifNil: [ ^ self ].
	configRefMap := self configurationReferencesFrom: projectRepository.
	
	configRefMap isEmpty
		ifTrue: [ ^ self inform: 'No configurations found in the project repository ' , projectRepository description printString ].
	configNames := configRefMap keys asSortedCollection asArray.
	configName := self uiManager 
		chooseFrom: (configNames collect: [ :name | name configurationBaseName])
		values: configNames
		title: 'Select the desired project'.
	configName ifNil: [ ^ self ].
	
	configRef := (configRefMap at: configName) asSortedCollection asArray last.
	Gofer new
		repository: projectRepository;
		version: configRef name;
		load! !

!MBLoadConfigurationCommand methodsFor: 'documentation' stamp: 'dkh 3/5/2011 15:27'!
documentation
	^ 'Load configuration from a repository'! !

!MBLoadConfigurationCommand methodsFor: 'ordering' stamp: 'dkh 4/7/2011 22:20'!
order

	^'10'! !

!MBLoadConfigurationCommand methodsFor: 'accessing' stamp: 'dkh 3/5/2011 15:26'!
title
	^ 'load configuration'! !

!MBLoadConfigurationCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 10/18/2012 15:43'!
askForProjectName
	^ self pickRepositoryFrom: self repositories title: 'Choose the repository where project is located'! !

!MBLoadConfigurationCommandTest methodsFor: 'tests' stamp: 'dkh 3/20/2011 14:15'!
testExecute 
	| block clsName |
	block := [(MBLoadConfigurationCommand target: nil) execute].
	clsName := 'ConfigurationOfHomeSweetHome'.
	
	Smalltalk globals at: clsName ifPresent: [ :cls | (Smalltalk globals at: clsName) removeFromSystem ].
	self should: 
		[block valueSupplyingAnswers: {
			{'Name of the new Metacello configuration (e.g., ConfigurationOfYourSoftware)'  . clsName} . 
			{'Would you like to use http://www.squeaksource.com/HomeSweetHome, for your project?' . true} .
			{'Enter initial version number' . '1.0'} }] raise: Exception
! !

!MBLoadPackageCommand commentStamp: 'TorstenBergmann 2/20/2014 14:06'!
Command to load a package in versionner!
!MBLoadPackageCommand methodsFor: 'accessing' stamp: 'dkh 3/20/2011 16:15'!
title
	^ 'load ', target typeLabel! !

!MBLoadPackageCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 10/18/2012 11:32'!
execute
	| answer |
	answer := self uiManager confirm: 'Are you sure you want to load using ', target packageName.
	answer ifTrue:  [ | version |
		version := target configurationInfo currentVersion.
		version load: version defaultPackageNamesToLoad, { target packageName } ]! !

!MBLoadPackageCommand methodsFor: 'documentation' stamp: 'dkh 2/28/2011 11:53'!
documentation
	^ 'Perform a project load using the specified package or project as the load list.'! !

!MBLoadProjectFromArchiveCommand commentStamp: 'TorstenBergmann 2/20/2014 14:08'!
Command to load project from archive in versionner!
!MBLoadProjectFromArchiveCommand methodsFor: 'documentation' stamp: 'dkh 4/7/2011 19:54'!
documentation 
	^ 'Load project from an archive.'! !

!MBLoadProjectFromArchiveCommand methodsFor: 'ordering' stamp: 'dkh 4/7/2011 22:23'!
order

	^'01'! !

!MBLoadProjectFromArchiveCommand methodsFor: 'accessing' stamp: 'dkh 4/7/2011 19:55'!
title
	^ 'load archive version'! !

!MBLoadProjectFromArchiveCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 11/6/2012 15:29'!
execute
	| archiveRepository configRef configurationInfo versionInfos versionInfo version configRefMap configNames configName |
	archiveRepository := self pickRepositoryFrom: self repositories title: 'Choose the archive repository'.
	archiveRepository ifNil: [ ^ self ].
	configRefMap := self configurationReferencesFrom: archiveRepository.
	configRefMap isEmpty
		ifTrue: [ ^ self inform: 'No configurations found in the archive repository ' , archiveRepository description printString ].
	configNames := configRefMap keys.
	configName := self uiManager
		chooseFrom: (configNames collect: [ :name | name configurationBaseName])
		values: configNames
		title: 'Select the desired project'.
	configName ifNil: [ ^ self ].
	configRef := (configRefMap at: configName) asSortedCollection asArray last.
	(Gofer new)
		repository: archiveRepository;
		version: configRef name;
		load.
	configurationInfo := (MBConfigurationInfo configurationClass: (Smalltalk globals at: configRef packageName asSymbol))
		configurationRoot: MBConfigurationRoot new;
		trimVersionLists: false;
		currentVersion: #notLoaded;
		yourself.
	versionInfos := configurationInfo versions.
	versionInfo := self uiManager
		chooseFrom: (versionInfos collect: [ :vrsn | vrsn printString ])
		values: versionInfos
		title: 'Select the desired version'.
	versionInfo ifNil: [ ^ self ].
	version := versionInfo version.
	version repositoryOverrides: {archiveRepository}.
	version load: version defaultPackageNamesToLoad! !

!MBMonticelloPackagesResource commentStamp: 'TorstenBergmann 2/20/2014 14:16'!
A test resource for test purposes for Versionner!
!MBMonticelloPackagesResource methodsFor: 'ConfigurationOfMBBranchTest' stamp: 'dkh 4/17/2011 12:26'!
setUpConfigurationOfMBBranchTest
	"self reset"  
	| versionInfo |
	versionInfo := self setUpConfigurationOfMBBranchTest1.
	versionInfo := self setUpConfigurationOfMBBranchTest2: { versionInfo }.
! !

!MBMonticelloPackagesResource methodsFor: 'accessing' stamp: 'dkh 3/9/2011 16:56'!
monticelloRepository
	^ monticelloRepository! !

!MBMonticelloPackagesResource methodsFor: 'running' stamp: 'dkh 3/9/2011 16:59'!
setUpMonticelloRepository
	"This method builds a fake repository with the version references from #buildReferences."
	"self reset"

	monticelloRepository := MCDictionaryRepository new.
! !

!MBMonticelloPackagesResource methodsFor: 'accessing' stamp: 'dkh 3/9/2011 17:39'!
project
	"self reset"

	| constructor project |
	"Construct Metacello project"
	project := MetacelloMCProject new.
	"Allow for customization of #projectAttributes"
	project projectAttributes: (Smalltalk at: #MBMonticelloPackagesResource) projectAttributes.
	MetacelloVersionConstructor on: self project: project.
	project loader: 
		((project loaderClass new)
			shouldDisablePackageCache: true;
			yourself).
	project loadType: #linear.
	^project
! !

!MBMonticelloPackagesResource methodsFor: 'ConfigurationOfMBBranchTest' stamp: 'ChristopheDemarey 2/8/2013 17:40'!
setUpConfigurationOfMBBranchTest2: ancestors
	"self reset"
	| reference className definitionArray versionInfo  |
	reference := GoferVersionReference name: 'ConfigurationOfMBBranchTests.branch-dkh.2'.
	className := reference packageName asSymbol.
	definitionArray := {
					MCOrganizationDefinition categories: (Array with: reference packageName).
					MCClassDefinition name: className superclassName: #Object category: className instVarNames: #() comment: ''.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'isMetacelloConfig'
						category: 'cat'
						timeStamp: ''
						source: (self class class sourceCodeAt: #isMetacelloConfig) asString.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: (self class class sourceCodeAt: #project) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #project) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'symbolicVersionDevelopmentNotDefinedMBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #symbolicVersionDevelopmentNotDefinedMBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline10MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #baseline10MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'version10MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #version10MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'version11MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #version11MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'symbolicVersionStable11MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #symbolicVersionStable11MBFooTest:) asString.
				}.
	monticelloRepository basicStoreVersion: (MCVersion new
		setPackage:  (MCPackage new name: reference packageName)
		info: (versionInfo := MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: ancestors)
		snapshot: (MCSnapshot fromDefinitions: definitionArray)
		dependencies: #()).
	^versionInfo! !

!MBMonticelloPackagesResource methodsFor: 'command tests' stamp: 'dkh 3/19/2011 14:40'!
symbolicVersionBleedingEdge20baselineMBFooTest: spec
	"self reset"
	<symbolicVersion: #'bleedingEdge'>

	spec for: #'common' version: '2.0-baseline'.! !

!MBMonticelloPackagesResource methodsFor: 'ConfigurationOfMBFooTest' stamp: 'dkh 3/10/2011 06:06'!
version12MBFooTest: spec
	"self reset"
	<version: '1.2' imports: #('1.0-baseline')>

	spec for: #'common' do: [
		spec blessing: #release.
		spec package: 'MBFooTests' with: 'MBFooTests-dkh.3'
].
! !

!MBMonticelloPackagesResource methodsFor: 'ConfigurationOfMBFooTest' stamp: 'ChristopheDemarey 2/8/2013 17:40'!
setUpConfigurationOfMBFooTest1
	"self reset"
	| reference className definitionArray versionInfo  |
	reference := GoferVersionReference name: 'ConfigurationOfMBFooTests-dkh.1'.
	className := reference packageName asSymbol.
	definitionArray := {
					MCOrganizationDefinition categories: (Array with: reference packageName).
					MCClassDefinition name: className superclassName: #Object category: className instVarNames: #() comment: ''.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'isMetacelloConfig'
						category: 'cat'
						timeStamp: ''
						source: (self class class sourceCodeAt: #isMetacelloConfig) asString.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: (self class class sourceCodeAt: #project) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #project) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'symbolicVersionDevelopmentNotDefinedMBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #symbolicVersionDevelopmentNotDefinedMBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline10MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #baseline10MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'version10MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #version10MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'symbolicVersionStable10MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #symbolicVersionStable10MBFooTest:) asString.
				}.
	monticelloRepository basicStoreVersion: (MCVersion new
		setPackage:  (MCPackage new name: reference packageName)
		info: (versionInfo := MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: #())
		snapshot: (MCSnapshot fromDefinitions: definitionArray)
		dependencies: #()).
	^versionInfo! !

!MBMonticelloPackagesResource methodsFor: 'command tests' stamp: 'ChristopheDemarey 2/8/2013 17:40'!
setUpConfigurationOfMBFooIssue117dkh3: ancestors
	"self reset"
	| reference className definitionArray versionInfo  |
	reference := GoferVersionReference name: 'ConfigurationOfMBFooIssue117-dkh.3'.
	className := reference packageName asSymbol.
	definitionArray := {
					MCOrganizationDefinition categories: (Array with: reference packageName).
					MCClassDefinition name: className superclassName: #Object category: className instVarNames: #() comment: ''.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'isMetacelloConfig'
						category: 'cat'
						timeStamp: ''
						source: (self class class sourceCodeAt: #isMetacelloConfig) asString.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: (self class class sourceCodeAt: #project) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #project) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'symbolicVersionBleedingEdge20baselineMBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #symbolicVersionBleedingEdge20baselineMBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline10MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #baseline10MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'symbolicVersionStable10MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #symbolicVersionStable10MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline20MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #baseline20MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline30MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #baseline30MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'version10MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #version10MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'version11MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #version11MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'symbolicVersionStable10MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #symbolicVersionStable10MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'version12MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #version12MBFooTest:) asString.
				}.
	monticelloRepository basicStoreVersion: (MCVersion new
		setPackage:  (MCPackage new name: reference packageName)
		info: (versionInfo := MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: ancestors)
		snapshot: (MCSnapshot fromDefinitions: definitionArray)
		dependencies: #()).
	^versionInfo! !

!MBMonticelloPackagesResource methodsFor: 'ConfigurationOfMBFooTest' stamp: 'dkh 3/9/2011 18:51'!
version10MBFooTest: spec
	"self reset"
	<version: '1.0' imports: #('1.0-baseline')>

	spec for: #'common' do: [
		spec blessing: #release.
		spec package: 'MBFooTests' with: 'MBFooTests-dkh.1'
].
! !

!MBMonticelloPackagesResource methodsFor: 'ConfigurationOfMBFooTest' stamp: 'dkh 3/10/2011 06:09'!
setUpConfigurationOfMBFooTest
	"self reset"  
	| versionInfo |
	versionInfo := self setUpConfigurationOfMBFooTest1.
	versionInfo := self setUpConfigurationOfMBFooTest2: { versionInfo }.
	versionInfo := self setUpConfigurationOfMBFooTest3: { versionInfo }.
! !

!MBMonticelloPackagesResource methodsFor: 'running' stamp: 'dkh 3/9/2011 16:56'!
setUpPackageClassDefs: classDefArray named: pName ancestors: ancestors
	"self reset"
	
	^self setUpPackageClassDefs: classDefArray methodDefs: #() named: pName ancestors: ancestors
! !

!MBMonticelloPackagesResource methodsFor: 'command tests' stamp: 'dkh 3/19/2011 14:41'!
baseline30MBFooTest: spec 
	"self reset"
	<version: '3.0-baseline'>
	
	spec for: #common do: [
		spec repository: 'dictionary://MB_Foo_Test_Repository'.
		spec blessing: #baseline.
		spec
			package: 'MBFooTests';
			yourself ].
! !

!MBMonticelloPackagesResource methodsFor: 'command tests' stamp: 'dkh 3/19/2011 10:32'!
symbolicVersionDevelopment10MBFooTest: spec
	"self reset"
	<symbolicVersion: #'development'>

	spec for: #'common' version: '1.0'.! !

!MBMonticelloPackagesResource methodsFor: 'ConfigurationOfMBFooTest' stamp: 'dkh 3/10/2011 05:40'!
symbolicVersionStable11MBFooTest: spec
	"self reset"
	<symbolicVersion: #'stable'>

	spec for: #'common' version: '1.1'.! !

!MBMonticelloPackagesResource methodsFor: 'command tests' stamp: 'ChristopheDemarey 2/8/2013 17:40'!
setUpConfigurationOfMBFooIssue117dkh1: ancestors
	"self reset"
	| reference className definitionArray versionInfo  |
	reference := GoferVersionReference name: 'ConfigurationOfMBFooIssue117-dkh.1'.
	className := reference packageName asSymbol.
	definitionArray := {
					MCOrganizationDefinition categories: (Array with: reference packageName).
					MCClassDefinition name: className superclassName: #Object category: className instVarNames: #() comment: ''.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'isMetacelloConfig'
						category: 'cat'
						timeStamp: ''
						source: (self class class sourceCodeAt: #isMetacelloConfig) asString.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: (self class class sourceCodeAt: #project) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #project) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'symbolicVersionDevelopment10MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #symbolicVersionDevelopment10MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline10MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #baseline10MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'version10MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #version10MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'version11MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #version11MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'symbolicVersionStable10MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #symbolicVersionStable10MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'version12MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #version12MBFooTest:) asString.
				}.
	monticelloRepository basicStoreVersion: (MCVersion new
		setPackage:  (MCPackage new name: reference packageName)
		info: (versionInfo := MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: ancestors)
		snapshot: (MCSnapshot fromDefinitions: definitionArray)
		dependencies: #()).
	^versionInfo! !

!MBMonticelloPackagesResource methodsFor: 'command tests' stamp: 'dkh 3/19/2011 14:28'!
baseline20MBFooTest: spec 
	"self reset"
	<version: '2.0-baseline'>
	
	spec for: #common do: [
		spec repository: 'dictionary://MB_Foo_Test_Repository'.
		spec blessing: #baseline.
		spec
			package: 'MBFooTests';
			yourself ].
! !

!MBMonticelloPackagesResource methodsFor: 'ConfigurationOfMBBranchTest' stamp: 'ChristopheDemarey 2/8/2013 17:39'!
setUpConfigurationOfMBBranchTest1
	"self reset"
	| reference className definitionArray versionInfo  |
	reference := GoferVersionReference name: 'ConfigurationOfMBBranchTests-dkh.1'.
	className := reference packageName asSymbol.
	definitionArray := {
					MCOrganizationDefinition categories: (Array with: reference packageName).
					MCClassDefinition name: className superclassName: #Object category: className instVarNames: #() comment: ''.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'isMetacelloConfig'
						category: 'cat'
						timeStamp: ''
						source: (self class class sourceCodeAt: #isMetacelloConfig) asString.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: (self class class sourceCodeAt: #project) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #project) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'symbolicVersionDevelopmentNotDefinedMBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #symbolicVersionDevelopmentNotDefinedMBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline10MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #baseline10MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'version10MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #version10MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'symbolicVersionStable10MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #symbolicVersionStable10MBFooTest:) asString.
				}.
	monticelloRepository basicStoreVersion: (MCVersion new
		setPackage:  (MCPackage new name: reference packageName)
		info: (versionInfo := MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: #())
		snapshot: (MCSnapshot fromDefinitions: definitionArray)
		dependencies: #()).
	^versionInfo! !

!MBMonticelloPackagesResource methodsFor: 'command tests' stamp: 'dkh 3/19/2011 09:56'!
setUpPackagesMBCommandFooTests
	"self reset"
	
	self
		setUpPackageClassDefs: { #Object. #MBFooCommandTestA. #(). #(). #(). }
		methodDefs: #()
		named: 'MBFooCommandTestA-dkh.1'
		ancestors: #().
	self
		setUpPackageClassDefs: { #Object. #MBFooCommandTestB. #(). #(). #(). }
		methodDefs: #()
		named: 'MBFooCommandTestB-dkh.1'
		ancestors: #().
! !

!MBMonticelloPackagesResource methodsFor: 'running' stamp: 'dkh 4/17/2011 12:27'!
setUp
	"self reset"

	super setUp.
	self
		setUpMonticelloRepository;
		setUpPackagesMBFooTests;
		setUpConfigurationOfMBFooTest;
		setUpPackagesMBCommandFooTests;
		setUpConfigurationOfMBFooIssue117;
		setUpConfigurationOfMBBranchTest! !

!MBMonticelloPackagesResource methodsFor: 'ConfigurationOfMBFooTest' stamp: 'dkh 3/10/2011 05:41'!
symbolicVersionDevelopmentNotDefinedMBFooTest: spec
	"self reset"
	<symbolicVersion: #'development'>

	spec for: #'common' version: #'notDefined'.! !

!MBMonticelloPackagesResource methodsFor: 'ConfigurationOfMBFooTest' stamp: 'ChristopheDemarey 2/8/2013 17:40'!
setUpConfigurationOfMBFooTest2: ancestors
	"self reset"
	| reference className definitionArray versionInfo  |
	reference := GoferVersionReference name: 'ConfigurationOfMBFooTests-dkh.2'.
	className := reference packageName asSymbol.
	definitionArray := {
					MCOrganizationDefinition categories: (Array with: reference packageName).
					MCClassDefinition name: className superclassName: #Object category: className instVarNames: #() comment: ''.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'isMetacelloConfig'
						category: 'cat'
						timeStamp: ''
						source: (self class class sourceCodeAt: #isMetacelloConfig) asString.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: (self class class sourceCodeAt: #project) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #project) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'symbolicVersionDevelopmentNotDefinedMBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #symbolicVersionDevelopmentNotDefinedMBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline10MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #baseline10MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'version10MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #version10MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'version11MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #version11MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'symbolicVersionStable11MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #symbolicVersionStable11MBFooTest:) asString.
				}.
	monticelloRepository basicStoreVersion: (MCVersion new
		setPackage:  (MCPackage new name: reference packageName)
		info: (versionInfo := MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: ancestors)
		snapshot: (MCSnapshot fromDefinitions: definitionArray)
		dependencies: #()).
	^versionInfo! !

!MBMonticelloPackagesResource methodsFor: 'ConfigurationOfMBFooTest' stamp: 'dkh 3/9/2011 23:16'!
version11MBFooTest: spec
	"self reset"
	<version: '1.1' imports: #('1.0-baseline')>

	spec for: #'common' do: [
		spec blessing: #release.
		spec package: 'MBFooTests' with: 'MBFooTests-dkh.2'
].
! !

!MBMonticelloPackagesResource methodsFor: 'ConfigurationOfMBFooTest' stamp: 'ChristopheDemarey 2/8/2013 17:40'!
setUpConfigurationOfMBFooTest3: ancestors
	"self reset"
	| reference className definitionArray versionInfo  |
	reference := GoferVersionReference name: 'ConfigurationOfMBFooTests-dkh.3'.
	className := reference packageName asSymbol.
	definitionArray := {
					MCOrganizationDefinition categories: (Array with: reference packageName).
					MCClassDefinition name: className superclassName: #Object category: className instVarNames: #() comment: ''.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'isMetacelloConfig'
						category: 'cat'
						timeStamp: ''
						source: (self class class sourceCodeAt: #isMetacelloConfig) asString.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: (self class class sourceCodeAt: #project) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #project) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'symbolicVersionDevelopmentNotDefinedMBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #symbolicVersionDevelopmentNotDefinedMBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline10MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #baseline10MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'version10MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #version10MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'version11MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #version11MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'symbolicVersionStable10MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #symbolicVersionStable10MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'version12MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #version12MBFooTest:) asString.
				}.
	monticelloRepository basicStoreVersion: (MCVersion new
		setPackage:  (MCPackage new name: reference packageName)
		info: (versionInfo := MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: ancestors)
		snapshot: (MCSnapshot fromDefinitions: definitionArray)
		dependencies: #()).
	^versionInfo! !

!MBMonticelloPackagesResource methodsFor: 'ConfigurationOfMBFooTest' stamp: 'dkh 3/10/2011 05:40'!
symbolicVersionStable10MBFooTest: spec
	"self reset"
	<symbolicVersion: #'stable'>

	spec for: #'common' version: '1.0'.! !

!MBMonticelloPackagesResource methodsFor: 'running' stamp: 'EstebanLorenzano 2/12/2013 17:27'!
setUpPackageClassDefs: classDefArray methodDefs: methodDefArray named: packageName ancestors: ancestors
	"self reset"
	
	| definitions superclassName className ivNames cvNames civNames versionInfo methodSelector methodSource basePackageName authorName |
	definitions := OrderedCollection new.
	basePackageName := packageName copyUpToLast: $-.
	authorName := (packageName copyAfterLast: $-) copyUpTo: $..
	1 to: classDefArray size by: 5 do: [:index |
		superclassName := (classDefArray at: index) asSymbol.
		className := (classDefArray at: index + 1) asSymbol.
		ivNames := (classDefArray at: index + 2).
		cvNames := (classDefArray at: index + 3).
		civNames := (classDefArray at: index + 4).
		
		definitions add: (MCOrganizationDefinition categories: (Array with: basePackageName)).
		definitions add: (MCClassDefinition 
			name: className 
			superclassName: superclassName 
			category: basePackageName 
			instVarNames: ivNames 
			classVarNames: cvNames
			poolDictionaryNames: #()
			classInstVarNames: civNames
			comment: '').
		(cvNames, ivNames) do: [:ivName | 
			definitions addAll: {
					MCMethodDefinition 
						className: className asString
						selector: ivName asSymbol
						category: 'cat'
						timeStamp: ''
						source: ivName, ' ^', ivName.
					MCMethodDefinition 
						className: className asString
						selector: (ivName, ':') asSymbol
						category: 'cat'
						timeStamp: ''
						source: ivName, ':  anObject ', ivName, ' := anObject'.
				} ].
		civNames do: [:ivName | 
			definitions addAll: {
					MCMethodDefinition 
						className: className asString
						selector: ivName asSymbol
						category: 'cat'
						timeStamp: ''
						source: ivName, ' ^self class ', ivName.
					MCMethodDefinition 
						className: className asString
						selector: (ivName, ':') asSymbol
						category: 'cat'
						timeStamp: ''
						source: ivName, ':  anObject self class ', ivName, ': anObject'.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: ivName asSymbol
						category: 'cat'
						timeStamp: ''
						source: ivName, ' ^', ivName.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: (ivName, ':') asSymbol
						category: 'cat'
						timeStamp: ''
						source: ivName, ':  anObject ', ivName, ' := anObject'.
				} ].
		ivNames do: [:ivName|
			definitions add: 
					(MCMethodDefinition 
						className: className asString
						selector: #sampleValue
						category: 'cat'
						timeStamp: ''
						source: 'sampleValue ^#''', ivName, '''') ].
		].
	1 to: methodDefArray size by: 3 do: [:index |
		className := (methodDefArray at: index) asSymbol.
		methodSelector := (methodDefArray at: index + 1) asSymbol.
		methodSource := (methodDefArray at: index + 2).
		definitions add: 
					(MCMethodDefinition 
						className: className asString
						selector: methodSelector
						category: ('*', packageName) asString
						timeStamp: ''
						source: methodSource).
		].
	monticelloRepository basicStoreVersion: (MCVersion new
		setPackage:  (MCPackage new name: basePackageName)
		info: (versionInfo := MCVersionInfo
				name: packageName
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: authorName
				ancestors: ancestors)
		snapshot: (MCSnapshot fromDefinitions: definitions asArray)
		dependencies: #()).
	^versionInfo
! !

!MBMonticelloPackagesResource methodsFor: 'command tests' stamp: 'ChristopheDemarey 2/8/2013 17:40'!
setUpConfigurationOfMBFooIssue117dkh2: ancestors
	"self reset"
	| reference className definitionArray versionInfo  |
	reference := GoferVersionReference name: 'ConfigurationOfMBFooIssue117-dkh.2'.
	className := reference packageName asSymbol.
	definitionArray := {
					MCOrganizationDefinition categories: (Array with: reference packageName).
					MCClassDefinition name: className superclassName: #Object category: className instVarNames: #() comment: ''.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'isMetacelloConfig'
						category: 'cat'
						timeStamp: ''
						source: (self class class sourceCodeAt: #isMetacelloConfig) asString.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: (self class class sourceCodeAt: #project) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #project) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'symbolicVersionDevelopment10MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #symbolicVersionDevelopment10MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline10MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #baseline10MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline20MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #baseline20MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'version10MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #version10MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'version11MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #version11MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'symbolicVersionStable10MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #symbolicVersionStable10MBFooTest:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'version12MBFooTest:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #version12MBFooTest:) asString.
				}.
	monticelloRepository basicStoreVersion: (MCVersion new
		setPackage:  (MCPackage new name: reference packageName)
		info: (versionInfo := MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: ancestors)
		snapshot: (MCSnapshot fromDefinitions: definitionArray)
		dependencies: #()).
	^versionInfo! !

!MBMonticelloPackagesResource methodsFor: 'command tests' stamp: 'dkh 3/23/2011 10:43'!
setUpConfigurationOfMBFooIssue117

	"self reset"  
	| versionInfo |
	versionInfo := self setUpConfigurationOfMBFooIssue117dkh1: #().
	versionInfo := self setUpConfigurationOfMBFooIssue117dkh2: #().
	versionInfo := self setUpConfigurationOfMBFooIssue117dkh3: #().
! !

!MBMonticelloPackagesResource methodsFor: 'ConfigurationOfMBFooTest' stamp: 'dkh 3/20/2011 10:09'!
setUpPackagesMBFooTests
	"self reset"
	
	| versionInfo |
	versionInfo := self
		setUpPackageClassDefs: { #Object. #MBFooTestA. #(). #(). #(). }
		methodDefs: #()
		named: 'MBFooTests-dkh.1'
		ancestors: #().
	versionInfo := self 
		setUpPackageClassDefs: { #Object. #MBFooTestA. #(). #(). #(). }
		methodDefs: #()
		named: 'MBFooTests-dkh.2'
		ancestors: {versionInfo} .
	versionInfo := self 
		setUpPackageClassDefs: { #Object. #MBFooTestA. #(). #(). #(). }
		methodDefs: #(MBFooTestA foo 'foo ^self')
		named: 'MBFooTests-dkh.3'
		ancestors: {versionInfo} .
	versionInfo := self 
		setUpPackageClassDefs: { #Object. #MBFooTestA. #(). #(). #(). }
		methodDefs: #()
		named: 'MBFooTests-dkh.4'
		ancestors: {versionInfo} .
! !

!MBMonticelloPackagesResource methodsFor: 'ConfigurationOfMBFooTest' stamp: 'dkh 3/9/2011 18:51'!
baseline10MBFooTest: spec 
	"self reset"
	<version: '1.0-baseline'>
	
	spec for: #common do: [
		spec repository: 'dictionary://MB_Foo_Test_Repository'.
		spec blessing: #baseline.
		spec
			package: 'MBFooTests';
			yourself ].
! !

!MBMonticelloPackagesResource class methodsFor: 'accessing' stamp: 'dkh 3/10/2011 07:29'!
isMetacelloConfig
	"Answer true and the Metacello tools will operate on you"
	
	^true! !

!MBMonticelloPackagesResource class methodsFor: 'accessing' stamp: 'dkh 3/9/2011 17:17'!
projectAttributes

	^#()! !

!MBMonticelloPackagesResource class methodsFor: 'accessing' stamp: 'dkh 3/9/2011 17:18'!
project

	^self new project! !

!MBPackageChangesCommand commentStamp: 'TorstenBergmann 2/20/2014 14:06'!
Command to browse package changes in versionner!
!MBPackageChangesCommand methodsFor: 'utility' stamp: 'ChristopheDemarey 10/18/2012 11:32'!
selectRepositoryOrSymbolicVersion: workingCopy
	| project symbolicVersions repos list values |
	project := target spec project.
	symbolicVersions := project symbolicVersionSymbols select: [ :each | project hasVersion: each ].
	repos := workingCopy repositoryGroup repositories.
	list := (symbolicVersions collect: [:each | each printString]), (repos collect: [ :r | r description ]).
	values := symbolicVersions, repos.
	^self uiManager
		chooseFrom: list
		values: values
		lines: {symbolicVersions  size}
		title: 'Please choose which symbolic version or repository'.
! !

!MBPackageChangesCommand methodsFor: 'documentation' stamp: 'dkh 3/20/2011 14:01'!
documentation
	^ 'View changes to the package ancestor in the selected repository or the corresponding package version in the selected symbolic version.'! !

!MBPackageChangesCommand methodsFor: 'accessing' stamp: 'dkh 3/20/2011 16:41'!
title
	^ 'changes'! !

!MBPackageChangesCommand methodsFor: 'private' stamp: 'ChristopheDemarey 10/18/2012 11:32'!
changesForSymbolicVersion: symbolicVersion workingCopy: wc
	| repository info ancestorVersion ref gofer resolved version packageSpec packageName ancestorVersionInfo |
	(repository := self selectRepositoryFromWorkingCopy: wc) ifNil: [ ^ self ].
	info := target configurationInfo.
	version := info project version: symbolicVersion.
	packageSpec := version
		packageNamed: wc packageName
		ifAbsent: [ ^ self uiManager inform: 'No package to compare ', target name, ' to in version' , symbolicVersion printString ].
	packageName := packageSpec file.
	ref := ((gofer := Gofer new)
		repository: repository;
		version: packageName) references first.
	(resolved := ref resolveAllWith: gofer) isEmpty
		ifTrue: [ 
			ref := ((gofer := Gofer new)
				repository: repository;
				package: packageName) references first.
			resolved := ref resolveAllWith: gofer ].
	ancestorVersionInfo := repository versionInfoFromVersionNamed: resolved last name.
	ancestorVersion := repository versionWithInfo: ancestorVersionInfo.
	self
		findChangesBetween: wc package snapshot
		toLabel: wc ancestry ancestorString , ' (' , info currentVersion versionString , ')'
		and: ancestorVersion snapshot
		fromLabel: ancestorVersion info name , ' (' , symbolicVersion printString , ' )'! !

!MBPackageChangesCommand methodsFor: 'execute' stamp: 'dkh 3/20/2011 12:50'!
execute
	"View the changes made in the working copy."

	| wc repositoryOrSymbolicVersion |
	wc := target spec workingCopy ifNil: [ ^ self ].
	wc ancestors isEmpty
		ifTrue: [ ^ self ].
	(repositoryOrSymbolicVersion := self selectRepositoryOrSymbolicVersion: wc) ifNil: [ ^ self ].
	repositoryOrSymbolicVersion isSymbol
		ifTrue: [ self changesForSymbolicVersion: repositoryOrSymbolicVersion workingCopy: wc]
		ifFalse: [ self findChangesFor: wc relativeToRepository: repositoryOrSymbolicVersion ]! !

!MBPackageHistoryCommand commentStamp: 'TorstenBergmann 2/20/2014 14:06'!
Command to browse package history in versionner!
!MBPackageHistoryCommand methodsFor: 'accessing' stamp: 'dkh 3/20/2011 14:03'!
title
	^ 'history'! !

!MBPackageHistoryCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 10/18/2012 17:39'!
execute

	self browseVersionHistory! !

!MBPackageHistoryCommand methodsFor: 'documentation' stamp: 'dkh 3/20/2011 14:04'!
documentation
	^ 'view package history'! !

!MBPackageInfo commentStamp: 'TorstenBergmann 2/20/2014 14:12'!
Infos about a package!
!MBPackageInfo methodsFor: 'commands' stamp: 'DaleHenrichs 03/07/2011 15:36'!
cmdSavePackage
	<command>
	^ MBSavePackageCommand! !

!MBPackageInfo methodsFor: 'accessing' stamp: 'dkh 3/2/2011 14:11'!
classForBrowsing

	^self workingCopy packageInfo classes anyOne! !

!MBPackageInfo methodsFor: 'commands' stamp: 'DaleHenrichs 03/07/2011 15:47'!
cmdRevertPackage
	<command>
	^ MBRevertPackageCommand! !

!MBPackageInfo methodsFor: 'testing' stamp: 'dkh 3/9/2011 21:49'!
interestedInPackageNamed: aString

	^aString beginsWith: self packageName! !

!MBPackageInfo methodsFor: 'as yet unclassified' stamp: 'JuanPabloSandovalAlcocer 1/4/2012 15:15'!
cmdLoad
	<command>
	^ MBLoadPackageCommand.! !

!MBPackageInfo methodsFor: 'as yet unclassified' stamp: 'JuanPabloSandovalAlcocer 1/8/2012 17:50'!
versions
	""
	|wc v|
	(wc := self workingCopy) isNil
                   ifTrue: [ ^ #() ].
      ^ (wc ancestry breadthFirstAncestors) collect: [ : vi| vi].! !

!MBPackageInfo methodsFor: 'utils' stamp: 'dkh 3/16/2011 06:03'!
repositories
	"Return the repositories associated with the package."

	^self spec workingCopy repositoryGroup repositories! !

!MBPackageInfo methodsFor: 'as yet unclassified' stamp: 'JuanPabloSandovalAlcocer 1/4/2012 14:04'!
mbPacakgeName
	| string wc loadedPkgName attributes |
	string := ''.
	(wc := self workingCopy) isNil
		ifTrue: [ ^ string ].
	attributes := OrderedCollection new.
	wc ancestry ancestors notEmpty
		ifTrue: [ 
			loadedPkgName := wc ancestry ancestors first name.
			loadedPkgName = self name
				ifFalse: [ 
					(self compareWorkingCopyNamed: loadedPkgName using: #<=)
						ifTrue: [ attributes add: TextColor red ].
					attributes add: TextEmphasis bold ]].
	self isDirty
		ifTrue: [ attributes add: TextEmphasis underlined ].
	attributes notEmpty 
		ifTrue: [ ^ Text string: string attributes: attributes ].
	^ string! !

!MBPackageInfo methodsFor: 'printing' stamp: 'JuanPabloSandovalAlcocer 1/1/2012 22:57'!
printOn: aStream
	| wc |
	self isDirty
		ifTrue: [ aStream nextPutAll: '* ' ].
	(wc := self workingCopy) isNil
		ifTrue: [ 
			aStream
				nextPutAll: self packageName;
				nextPutAll: ' ---' ]
		ifFalse: [ 
			wc ancestry ancestors notEmpty
				ifTrue: [ 
					| loadedPkgName refString |
					loadedPkgName := wc ancestry ancestors first name.
					(refString := self extractPackageSignatureFrom: wc) notEmpty
						ifTrue: [ refString := '[' , refString , ']' ].
					loadedPkgName = self name
						ifTrue: [ aStream nextPutAll: self name ]
						ifFalse: [ 
							(self compareWorkingCopyNamed: loadedPkgName using: #<=)
								ifTrue: [ refString := Text string: refString attributes: TextColor red ].
							aStream
								nextPutAll: self name;
								nextPutAll: refString ] ] ]! !

!MBPackageInfo methodsFor: 'accessing' stamp: 'AlexandreBergel 2/24/2011 14:52'!
basePackageName
	^ self packageName copyUpToLast: #-! !

!MBPackageInfo methodsFor: 'commands' stamp: 'dkh 3/20/2011 16:38'!
cmdBrowsePackageHistory
	<command>
	^ MBPackageHistoryCommand
	! !

!MBPackageInfo methodsFor: 'converting' stamp: 'DaleHenrichs 03/09/2011 11:03'!
buildStringOrText
	| string wc loadedPkgName attributes |
	string := super buildStringOrText.
	(wc := self workingCopy) isNil
		ifTrue: [ ^ string ].
	attributes := OrderedCollection new.
	wc ancestry ancestors notEmpty
		ifTrue: [ 
			loadedPkgName := wc ancestry ancestors first name.
			loadedPkgName = self name
				ifFalse: [ 
					(self compareWorkingCopyNamed: loadedPkgName using: #<=)
						ifTrue: [ attributes add: TextColor red ].
					attributes add: TextEmphasis bold ]].
	self isDirty
		ifTrue: [ attributes add: TextEmphasis underlined ].
	attributes notEmpty 
		ifTrue: [ ^ Text string: string attributes: attributes ].
	^ string! !

!MBPackageInfo methodsFor: 'testing' stamp: 'dkh 3/3/2011 07:57'!
compareWorkingCopyNamed: wcName using: comarisonOperator
	| fileRef wcRef |
	fileRef := GoferResolvedReference name: self spec file.
	wcRef := GoferResolvedReference name: wcName.
	^ wcRef compare: fileRef using: comarisonOperator! !

!MBPackageInfo methodsFor: 'testing' stamp: 'DaleHenrichs 03/09/2011 17:05'!
currentVersionMismatch
           | wc loadedPkgName |
           (wc := self workingCopy) isNil
                   ifTrue: [ ^ false ].
           wc ancestry ancestors isEmpty
                   ifTrue: [ ^ false ].
           loadedPkgName := wc ancestry ancestors first name.
           loadedPkgName = self name
                   ifTrue: [ ^false ].
            ^ true
! !

!MBPackageInfo methodsFor: 'accessing' stamp: 'dkh 3/2/2011 21:42'!
typeLabel

	^'package'! !

!MBPackageInfo class methodsFor: 'accessing' stamp: 'dkh 4/10/2011 19:56'!
helpLabel

	^'Package'! !

!MBPackageInfoTest commentStamp: 'TorstenBergmann 2/20/2014 14:17'!
SUnit tests for MBPackageInfo in Versionner!
!MBPackageInfoTest methodsFor: 'tests' stamp: 'dkh 2/23/2011 21:22'!
testPrintOn
	self assert: (package printString =  'FooBarZork ---').! !

!MBPackageInfoTest methodsFor: 'tests' stamp: 'EstebanLorenzano 7/21/2014 13:44'!
testWorkingCopy

	|  workingCopy |
	self assert: (RPackageOrganizer default packageNamed: 'FooBarZork' ifAbsent: []) isNil.	
	package := MBPackageInfo named: 'FooBarZork'.
	workingCopy := package workingCopy.
	"creating a packageInfo for a package that is not currently loaded can create problems. see Metacello Issue 113"
	self assert: workingCopy isNil.
! !

!MBPackageInfoTest methodsFor: 'tests' stamp: 'ChristopheDemarey 2/28/2014 18:20'!
testIsDirty
	"This test is likely to be bogus ... cannot just create a package for packages that don'e exist. see Metacello Issue 113"
	
	| cls |
	self deny: (package isDirty).
	self assert: (package printString =  'FooBarZork ---').
	
	"We create a class"		
	self deny: (Smalltalk includesKey: #TMPClass).
	cls := Object subclass: #TMPClass
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: 'FooBarZork'.
		
	self assert: (package isDirty).
	"self assert: (package printString =  'FooBarZork ---')."

	(Smalltalk includesKey: #TMPClass)
		ifTrue: [ (Smalltalk at: #TMPClass) removeFromSystem ].
! !

!MBPackageInfoTest methodsFor: 'tests' stamp: 'dkh 3/2/2011 08:03'!
testInstantiation
	self should: [ MBPackageInfo new ] raise: Error.

	self should: [ MBPackageInfo named: #'FooBar' ] raise: AssertionFailure.
	self shouldnt: [ MBPackageInfo named: 'FooBar' ] raise: Error.! !

!MBPackageInfoTest methodsFor: 'running' stamp: 'EstebanLorenzano 7/21/2014 13:45'!
setUp
"	(Smalltalk includesKey: #TMPClass)
		ifTrue: [ (Smalltalk at: #TMPClass) removeFromSystem ].
"		
"	Smalltalk organization removeCategory: 'FooBarZork'."
	(MCPackage named: 'FooBarZork') unload.
	RPackageOrganizer default unregisterPackageNamed: 'FooBarZork'.

	package := MBPackageInfo named: 'FooBarZork'.! !

!MBPackageInfoTest methodsFor: 'running' stamp: 'AlexandreBergel 1/16/2011 21:06'!
tearDown
"	(Smalltalk includesKey: #TMPClass)
		ifTrue: [ (Smalltalk at: #TMPClass) removeFromSystem ].
"! !

!MBProjectInfo commentStamp: 'TorstenBergmann 2/20/2014 14:12'!
Infos about a project!
!MBProjectInfo methodsFor: 'accessing' stamp: 'dkh 2/26/2011 16:23'!
validateIfAbsent: absentBlock

	^MetacelloToolBox validateConfiguration: (Smalltalk 
		at: self packageName asSymbol 
		ifAbsent: absentBlock).
! !

!MBProjectInfo methodsFor: 'utils' stamp: 'dkh 3/16/2011 06:04'!
repositories
	"Return the repositories associated with the configuration for the project."

	^self spec projectPackage workingCopy repositoryGroup repositories! !

!MBProjectInfo methodsFor: 'accessing' stamp: 'dkh 3/6/2011 15:21'!
currentVersion
	currentVersion == nil
		ifTrue: [ 
			| projectClass version info |
			(projectClass := self spec projectClass) == nil
				ifTrue: [ 
					currentVersion := ''.
					^ currentVersion ].
			(info := self configurationRoot configurationInfoFor: projectClass) == nil
				ifTrue: [ 
					currentVersion := ''.
					^ currentVersion ].
			(currentVersion := info currentVersion) == nil
				ifTrue: [ 
					currentVersion := ''.
					^ currentVersion ].
			currentVersion := currentVersion versionString ].
	^ currentVersion! !

!MBProjectInfo methodsFor: 'accessing' stamp: 'dkh 3/2/2011 14:08'!
classForBrowsing

	^self spec projectClass! !

!MBProjectInfo methodsFor: 'testing' stamp: 'dkh 3/6/2011 15:15'!
interestedInPackageNamed: aString
	| projectClass version info |
	(projectClass := self spec projectClass) == nil
		ifTrue: [ ^ false ].
	(aString beginsWith: projectClass name asString)
		ifTrue: [ ^ true ].
	(info := self configurationRoot configurationInfoFor: projectClass) == nil
		ifTrue: [ ^ false ].
	^ info interestedInPackageNamed: aString! !

!MBProjectInfo methodsFor: 'accessing' stamp: 'dkh 2/27/2011 20:26'!
validate
	validationResult == nil
		ifTrue: [ 
			validationIcon := nil.
			validationResult := self validateIfAbsent: [ #() ] ].
	^ validationResult! !

!MBProjectInfo methodsFor: 'testing' stamp: 'dkh 4/9/2011 21:05'!
interestedInConfigurationInfo: configInfo
	| projectClass |
	(projectClass := self spec projectClass) == nil
		ifTrue: [ ^ false ].
	^(self configurationRoot configurationInfoFor: projectClass) name = configInfo name
! !

!MBProjectInfo methodsFor: 'printing' stamp: 'dkh 3/3/2011 08:39'!
printOn: aStream
	| cv specVersion |
	self isDirty
		ifTrue: [ aStream nextPutAll: '* ' ].
	super printOn: aStream.
	(cv := self currentVersion) isEmpty
		ifTrue: [ aStream nextPutAll: ' ---' ]
		ifFalse: [ 
			(specVersion := self spec versionOrNil) ~~ nil
				ifTrue: [ 
					aStream nextPutAll: ' ' , specVersion versionString.
					cv asMetacelloVersionNumber = specVersion versionNumber
						ifFalse: [ aStream nextPutAll: ' [' , cv , ']' ] ] ]! !

!MBProjectInfo methodsFor: 'accessing' stamp: 'dkh 2/23/2011 20:46'!
currentVersion: anObject

	currentVersion := anObject! !

!MBProjectInfo methodsFor: 'testing' stamp: 'DaleHenrichs 03/07/2011 12:32'!
currentVersionMismatch
	| cv specVersion |
	(cv := self currentVersion) notEmpty
		ifTrue: [ 
			(specVersion := self spec versionOrNil) ~~ nil
				ifTrue: [^ cv asMetacelloVersionNumber ~= specVersion versionNumber ]].
	^false! !

!MBProjectInfo methodsFor: 'converting' stamp: 'dkh 3/7/2011 21:53'!
buildStringOrText
	| string cv projectClass info attributes specVersion |
	string := super buildStringOrText.
	attributes := OrderedCollection new.
	self isDirty
		ifTrue: [ attributes add: TextEmphasis underlined ].
	(((projectClass := self spec projectClass) isNil or: [ (cv := self currentVersion) isEmpty ])
		or: [ (specVersion := self spec versionOrNil) isNil ])
		ifTrue: [ 
			attributes notEmpty
				ifTrue: [ ^ Text string: string attributes: attributes ].
			^ string ].
	self currentVersionMismatch
		ifTrue: [ attributes add: TextEmphasis bold ].
	specVersion versionStatus == #somethingLoaded
		ifTrue: [ attributes add: TextColor red ].
	attributes notEmpty
		ifTrue: [ ^ Text string: string attributes: attributes ].
	^ string! !

!MBProjectInfo methodsFor: 'accessing' stamp: 'dkh 3/2/2011 21:42'!
typeLabel

	^'project'! !

!MBProjectInfo class methodsFor: 'accessing' stamp: 'dkh 4/10/2011 19:56'!
helpLabel

	^'Project'! !

!MBRevertPackageCommand commentStamp: 'TorstenBergmann 2/20/2014 14:06'!
Command to revert a package in versionner!
!MBRevertPackageCommand methodsFor: 'documentation' stamp: 'DaleHenrichs 03/07/2011 15:43'!
documentation
	^ 'Revert the changes that have been made to this package.'! !

!MBRevertPackageCommand methodsFor: 'accessing' stamp: 'DaleHenrichs 03/07/2011 15:43'!
title
	^ 'revert'! !

!MBRevertPackageCommand methodsFor: 'private' stamp: 'ChristopheDemarey 10/18/2012 11:03'!
pickAncestorVersionInfo
	| ancestors |
	ancestors := target workingCopy ancestry breadthFirstAncestors.
	^self uiManager 
		chooseFrom: (ancestors collect: [:ea | ea name])
		values: ancestors
		title: 'Package:' 
! !

!MBRevertPackageCommand methodsFor: 'execute' stamp: 'DaleHenrichs 03/07/2011 15:46'!
execute

	self pickAncestorVersionInfo ifNotNilDo: [:info |
		(target workingCopy repositoryGroup versionWithInfo: info
			ifNone: [^self inform: 'No repository found for ', info name]
		) load].
! !

!MBSaveConfigurationCommand commentStamp: 'TorstenBergmann 2/20/2014 14:08'!
Command to load a configuration in versionner!
!MBSaveConfigurationCommand methodsFor: 'execute' stamp: 'JuanPabloSandovalAlcocer 7/11/2012 13:35'!
executeWithMessage: message
	"execute with message"
	self checkUserInRepositoryOfPackage: self configurationClass name asString.
	MetacelloToolBox 
		saveConfigurationPackageFor: self configurationClass name asString 
		description: message! !

!MBSaveConfigurationCommand methodsFor: 'documentation' stamp: 'dkh 3/20/2011 16:14'!
documentation
	^ 'Save the configuration in its repository. Note that the dependents projects and defined packages are not saved. Use ''checkpoint dev'' command to save packages.'! !

!MBSaveConfigurationCommand methodsFor: 'accessing' stamp: 'AlexandreBergel 4/15/2011 09:26'!
title
	^ 'save configuration'! !

!MBSaveConfigurationCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 10/18/2012 11:32'!
execute
	| message |
	message := self uiManager multilineRequest: 'Enter commit message' initialAnswer: ''.
	message == nil
		ifTrue: [ ^ self ].
	self executeWithMessage: message! !

!MBSavePackageCommand commentStamp: 'TorstenBergmann 2/20/2014 14:06'!
Command to save a package in versionner!
!MBSavePackageCommand methodsFor: 'accessing' stamp: 'DaleHenrichs 03/07/2011 15:33'!
title
	^ 'save'! !

!MBSavePackageCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 8/23/2013 17:04'!
execute
	| message repo gofer |
	message := self uiManager multilineRequest: 'Enter commit message' initialAnswer: ''.
	message == nil
		ifTrue: [ ^ self ].
	repo := self checkUserInRepositoryOfPackage: target spec name.
	gofer := Gofer new.
	gofer disablePackageCache.
	gofer repository: repo.
	gofer package: target spec name.
	gofer commit: message! !

!MBSavePackageCommand methodsFor: 'documentation' stamp: 'DaleHenrichs 03/07/2011 15:33'!
documentation
	^ 'Save a new version of the mcz for the given repository in its repository.'! !

!MBSetUserCommand commentStamp: 'TorstenBergmann 2/20/2014 14:08'!
Command to bset the user in Versionner!
!MBSetUserCommand methodsFor: 'as yet unclassified' stamp: 'AlexandreBergel 3/28/2011 09:27'!
title
	^ 'set user and password'! !

!MBSetUserCommand methodsFor: 'as yet unclassified' stamp: 'dkh 4/5/2011 21:22'!
execute
	target configurationRoot username: nil.
	target configurationRoot password: nil.
	self username.
	self password.! !

!MBSetUserCommand methodsFor: 'as yet unclassified' stamp: 'AlexandreBergel 3/28/2011 09:27'!
documentation
	^ 'Set the user and password used when saving and loading packages and configurations.'! !

!MBSpecInfo commentStamp: '<historical>'!
A MBSpecInfo holds information on Metacello specifications.

Instance Variables
	configurationInfo:		the object holding information on the whole configuration.
	spec:		the specification of this object (a MetacelloSpec).
!
!MBSpecInfo methodsFor: 'commands' stamp: 'dkh 3/4/2011 05:00'!
cmdLoadSpecCommand
	<command>
	^ MBLoadPackageCommand! !

!MBSpecInfo methodsFor: 'accessing' stamp: 'dkh 3/1/2011 11:47'!
validate

	^nil! !

!MBSpecInfo methodsFor: 'accessing' stamp: 'dkh 3/5/2011 18:05'!
configurationInfo
	^ configurationInfo! !

!MBSpecInfo methodsFor: 'accessing' stamp: 'dkh 3/2/2011 16:43'!
project
	"Answer the MetacelloProject associated with the receiver."
	
	^self spec project! !

!MBSpecInfo methodsFor: 'accessing' stamp: 'dkh 3/1/2011 11:47'!
validationIcon

	^nil! !

!MBSpecInfo methodsFor: 'accessing' stamp: 'dkh 3/1/2011 11:46'!
spec: aMetacelloSpec

	spec := aMetacelloSpec ! !

!MBSpecInfo methodsFor: 'accessing' stamp: 'dkh 3/5/2011 18:05'!
configurationInfo: anObject
	configurationInfo := anObject! !

!MBSpecInfo methodsFor: 'accessing' stamp: 'dkh 3/1/2011 11:57'!
packageName

	^self name! !

!MBSpecInfo methodsFor: 'accessing' stamp: 'dkh 3/6/2011 19:25'!
validationIconSymbol

	^#blank! !

!MBSpecInfo methodsFor: 'testing' stamp: 'JuanPabloSandovalAlcocer 1/1/2012 23:22'!
isDirty
	| wc |
	wc := self workingCopy.
	wc ifNil: [ ^false ].
	^wc needsSaving! !

!MBSpecInfo methodsFor: 'testing' stamp: 'DaleHenrichs 03/07/2011 12:38'!
currentVersionMismatch

	^false! !

!MBSpecInfo methodsFor: 'accessing' stamp: 'dkh 3/1/2011 11:46'!
spec

	^spec! !

!MBSpecInfo methodsFor: 'accessing' stamp: 'dkh 3/2/2011 21:41'!
typeLabel

	^''! !

!MBSpecInfo class methodsFor: 'instance creation' stamp: 'DaleHenrichs 03/05/2011 11:15'!
spec: aMetacelloSpec
	"Create an instance of myself with the given spec"

	^(super new) spec: aMetacelloSpec! !

!MBSpecInfoTest commentStamp: 'TorstenBergmann 2/20/2014 14:17'!
SUnit tests for MBSpecInfo in Versionner!
!MBSpecInfoTest class methodsFor: 'testing' stamp: 'topa 4/15/2011 09:50'!
isAbstract
	"Override to true if a TestCase subclass is Abstract and should not have
	TestCase instances built from it"
	
	^ self name = #MBSpecInfoTest! !

!MBValidateAllConfigurationCommand commentStamp: 'TorstenBergmann 2/20/2014 14:09'!
Command to validate all configurations in versionner!
!MBValidateAllConfigurationCommand methodsFor: 'accessing' stamp: 'dkh 3/2/2011 08:38'!
title
	^ 'validate all configurations'! !

!MBValidateAllConfigurationCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 10/18/2012 11:44'!
execute
	self showExecuteWhile: [ target configurationRoot configurations doWithIndex: [ :info :index | info validateFull ] ]! !

!MBValidateAllConfigurationCommand methodsFor: 'documentation' stamp: 'dkh 2/28/2011 20:48'!
documentation
	^ 'Validate all configuration.'! !

!MBVersionCommand commentStamp: 'TorstenBergmann 2/20/2014 14:11'!
Superclass for commands on versions!
!MBVersionInfo commentStamp: 'TorstenBergmann 2/20/2014 14:12'!
A version info!
!MBVersionInfo methodsFor: 'commands' stamp: 'ChristopheDemarey 11/13/2013 13:18'!
cmdSetDescription
	<command>
	^ VSSetDescriptionCommand! !

!MBVersionInfo methodsFor: 'commands' stamp: 'ChristopheDemarey 11/20/2013 17:48'!
cmdReleaseDevelopmentVersion
	<command>
	^ VSReleaseDevelopmentVersionCommand! !

!MBVersionInfo methodsFor: 'printing' stamp: 'dkh 2/24/2011 15:33'!
printOn: aStream
	super printOn: aStream.
	self isDevelopment 
		ifTrue: [ 
			aStream nextPutAll: ' #development'.
			^self ].
	self isStable
		ifTrue: [ aStream nextPutAll: ' #stable' ].! !

!MBVersionInfo class methodsFor: 'accessing' stamp: 'dkh 4/10/2011 19:56'!
helpLabel

	^'Version'! !

!MCAddition commentStamp: '<historical>'!
A MCAddition represents the operation to add an entity to a snapshot. !
!MCAddition methodsFor: 'accessing' stamp: 'cwp 11/27/2002 09:32'!
definition
	^ definition! !

!MCAddition methodsFor: 'accessing' stamp: 'ab 7/18/2003 16:45'!
fromSource
	^ ''! !

!MCAddition methodsFor: 'accessing' stamp: 'LucasGiudice 9/14/2013 15:02'!
toSource
	^ definition diffSource! !

!MCAddition methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/21/2013 15:33'!
selector

	^ definition selector! !

!MCAddition methodsFor: 'accessing' stamp: 'ab 6/1/2003 13:09'!
targetDefinition
	^ definition! !

!MCAddition methodsFor: 'testing' stamp: 'nk 2/25/2005 17:28'!
isClassPatch
	^definition isClassDefinition! !

!MCAddition methodsFor: 'accessing' stamp: 'nk 2/23/2005 18:17'!
targetClass
	^definition actualClass ! !

!MCAddition methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/21/2013 15:10'!
isMethodPatch

	^ definition isMethodDefinition! !

!MCAddition methodsFor: 'testing' stamp: 'cwp 11/28/2002 07:22'!
isAddition
	^ true! !

!MCAddition methodsFor: '*Komitter-UI' stamp: 'NicolaiHess 4/8/2014 20:02'!
koClass
	| klass |
	klass := definition koClass.
	klass ifNil: [ ^ nil ].
	definition addOperation: self on: klass.
	self isClassPatch
		ifTrue: [ klass added: true ].
	^ klass! !

!MCAddition methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/28/2011 15:25'!
summary

	^ definition summary! !

!MCAddition methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/26/2013 14:42'!
koDefinition
	
	^ (KomitDefinition definition: self definition)
		operation: self;
		added: true;
		yourself! !

!MCAddition methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/21/2013 21:19'!
koDestinationText
	
	^ definition koDestinationText! !

!MCAddition methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/21/2013 21:21'!
koSourceText
	
	^ ''! !

!MCAddition methodsFor: 'accessing' stamp: 'nk 2/23/2005 18:39'!
sourceString
	^(self toSource asText)
		addAttribute: TextColor red;
		yourself! !

!MCAddition methodsFor: 'accessing' stamp: 'StephaneDucasse 6/24/2011 14:53'!
basicApplyTo: anObject
	anObject addDefinition: definition! !

!MCAddition methodsFor: 'accessing' stamp: 'ab 8/22/2003 02:26'!
inverse
	^ MCRemoval of: definition! !

!MCAddition methodsFor: 'initializing' stamp: 'stephaneducasse 2/4/2006 20:47'!
intializeWithDefinition: aDefinition
	definition := aDefinition! !

!MCAddition methodsFor: 'accessing' stamp: 'ab 6/1/2003 13:09'!
baseDefinition
	^ nil! !

!MCAddition methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/25/2013 18:21'!
koMethod
	
	^ (KomitMethod method: self definition)
		operation: self;
		added: true;
		yourself! !

!MCAddition class methodsFor: 'instance-creation' stamp: 'cwp 11/27/2002 10:03'!
of: aDefinition
	^ self new intializeWithDefinition: aDefinition! !

!MCAncestry commentStamp: '<historical>'!
Abstract superclass of records of ancestry.!
!MCAncestry methodsFor: 'ancestry' stamp: 'avi 9/17/2005 16:03'!
withBreadthFirstAncestors
	^ (Array with: self), self breadthFirstAncestors! !

!MCAncestry methodsFor: 'ancestry' stamp: 'avi 2/12/2004 20:57'!
ancestorString
	^ String streamContents:
		[:s | self ancestors do: [:ea | s nextPutAll: ea name] separatedBy: [s nextPutAll: ', ']]! !

!MCAncestry methodsFor: 'ancestry' stamp: 'bf 12/22/2004 21:55'!
ancestorsDoWhileTrue: aBlock
	self ancestors do:
		[:ea |
		(aBlock value: ea) ifTrue: 
			[ea ancestorsDoWhileTrue: aBlock]]! !

!MCAncestry methodsFor: 'ancestry' stamp: 'avi 9/14/2004 15:21'!
stepChildrenString
	^ String streamContents:
		[:s | self stepChildren do: [:ea | s nextPutAll: ea name] separatedBy: [s nextPutAll: ', ']]! !

!MCAncestry methodsFor: 'ancestry' stamp: 'jrp 7/12/2004 08:16'!
hasAncestor: aVersionInfo alreadySeen: aList
	(aList includes: self) ifTrue: [^ false].
	aList add: self.

	^ self = aVersionInfo or: [self ancestors anySatisfy: [:ea | ea hasAncestor: aVersionInfo alreadySeen: aList]]
! !

!MCAncestry methodsFor: 'ancestry' stamp: 'stephaneducasse 2/4/2006 20:47'!
breadthFirstAncestorsDo: aBlock
	| seen todo next |
	seen := Set with: self.
	todo := OrderedCollection with: self.
	[todo isEmpty] whileFalse:
		[next := todo removeFirst.
		next ancestors do:
			[:ea |
			(seen includes: ea) ifFalse:
				[aBlock value: ea.
				seen add: ea.
				todo add: ea]]]! !

!MCAncestry methodsFor: 'ancestry' stamp: 'stephaneducasse 2/4/2006 20:47'!
commonAncestorsWith: aVersionInfo

	| sharedAncestors mergedOrder sorter |
	sorter := MCVersionSorter new
						addVersionInfo: self;
						addVersionInfo: aVersionInfo.
	mergedOrder := sorter sortedVersionInfos.
	sharedAncestors := (sorter allAncestorsOf: self) intersection: (sorter allAncestorsOf: aVersionInfo).
	^ mergedOrder select: [:ea | sharedAncestors includes: ea]! !

!MCAncestry methodsFor: 'ancestry' stamp: 'avi 2/12/2004 20:57'!
allAncestorsOnPathTo: aVersionInfo
	^ MCFilteredVersionSorter new
		target: aVersionInfo;
		addAllVersionInfos: self ancestors;
		sortedVersionInfos! !

!MCAncestry methodsFor: 'ancestry' stamp: 'avi 2/12/2004 20:57'!
ancestors
	^ ancestors ifNil: [#()]! !

!MCAncestry methodsFor: 'ancestry' stamp: 'nice 1/5/2010 15:59'!
topologicalAncestors
	
	^ Array streamContents:
		[:s | | f frontier |
		frontier := MCFrontier frontierOn: self.
		[f := frontier frontier.
		s nextPutAll: f.
		frontier removeAll: f.
		f isEmpty] whileFalse] ! !

!MCAncestry methodsFor: 'ancestry' stamp: 'avi 2/12/2004 20:57'!
allAncestorsDo: aBlock
	self ancestors do:
		[:ea |
		aBlock value: ea.
		ea allAncestorsDo: aBlock]! !

!MCAncestry methodsFor: 'ancestry' stamp: 'bp 11/21/2010 18:33'!
ancestorStringWithout: packageName
	^ String streamContents:
		[:s | self ancestors do: [:ea | s nextPutAll: (ea nameWithout: packageName)] separatedBy: [s nextPutAll: ', ']]! !

!MCAncestry methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 10:02'!
initialize
	super initialize.
	ancestors := #().
	stepChildren := #()! !

!MCAncestry methodsFor: 'ancestry' stamp: 'avi 9/17/2005 16:03'!
breadthFirstAncestors
	^ Array streamContents: [:s | self breadthFirstAncestorsDo: [:ea | s nextPut: ea]]! !

!MCAncestry methodsFor: 'ancestry' stamp: 'stephaneducasse 2/4/2006 20:47'!
commonAncestorWith: aNode
	| commonAncestors |
	commonAncestors := self commonAncestorsWith: aNode.
	^ commonAncestors at: 1 ifAbsent: [nil]! !

!MCAncestry methodsFor: 'ancestry' stamp: 'jrp 7/12/2004 08:16'!
hasAncestor: aVersionInfo
	^ self
		hasAncestor: aVersionInfo
		alreadySeen: OrderedCollection new! !

!MCAncestry methodsFor: 'ancestry' stamp: 'avi 2/12/2004 20:58'!
isRelatedTo: aVersionInfo
	^ aVersionInfo timeStamp < self timeStamp
		ifTrue: [self hasAncestor: aVersionInfo]
		ifFalse: [aVersionInfo hasAncestor: self]! !

!MCAncestry methodsFor: 'ancestry' stamp: 'avi 9/11/2004 15:08'!
stepChildren
	^ stepChildren ifNil: [#()]! !

!MCAncestryTest methodsFor: 'tests' stamp: 'jf 8/16/2003 20:45'!
testLinearPath
	self assertPathTo: #b1 is: #(b3 b2)! !

!MCAncestryTest methodsFor: 'tests' stamp: 'jf 8/16/2003 20:42'!
testPathToMissingAncestor
	self assert: (self tree allAncestorsOnPathTo: MCVersionInfo new) isEmpty! !

!MCAncestryTest methodsFor: 'building' stamp: 'jf 8/16/2003 21:21'!
tree
	^ self treeFrom:
		#(c1
			((e2
				((e1
					((a1
						(('00')))))))
			(a2
				((a1
					(('00')))))
			(b3
				((b2
					((b1
						((b0
							(('00')))))))
				(a1
					(('00')))))
			(d1)))! !

!MCAncestryTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:47'!
testDescendants
	| c1 a1 b3 q1 q2 c2 |
	c1 := self tree.
	a1 := self treeFrom: #(a1 (('00'))).
	b3 := self treeFrom: #(b3
				((b2
					((b1
						((b0
							(('00')))))))
				(a1
					(('00'))))).
	q1 := MCWorkingAncestry new addAncestor: a1.
	q2 := MCWorkingAncestry new addAncestor: q1.
	self assert: (q2 commonAncestorWith: b3) = a1.
	self assert: (b3 commonAncestorWith: q2) = a1.
	self assert: (q2 commonAncestorWith: c1) = a1.
	self assert: (c1 commonAncestorWith: q2) = a1.
	q1 addStepChild: c1.
	self assert: (q2 commonAncestorWith: c1) = q1.
	self assert: (c1 commonAncestorWith: q2) = q1.
	c2 := MCWorkingAncestry new addAncestor: c1.
	self assert: (q2 commonAncestorWith: c2) = q1.
	self assert: (c2 commonAncestorWith: q2) = q1.
! !

!MCAncestryTest methodsFor: 'building' stamp: 'marcus.denker 11/10/2008 10:04'!
versionForName: name in: tree
	(tree name = name) ifTrue: [^ tree].
	
	tree ancestors do: [:ea | (self versionForName: name in: ea) ifNotNil: [:v | ^ v]].
	
	^ nil! !

!MCAncestryTest methodsFor: 'asserting' stamp: 'stephaneducasse 2/4/2006 20:47'!
assertCommonAncestorOf: leftName and: rightName in: options in: tree
	| left right ancestor |
	left := self versionForName: leftName in: tree.
	right := self versionForName: rightName in: tree.
	
	ancestor := left commonAncestorWith: right.
	
	self assert: (options includes: ancestor name)! !

!MCAncestryTest methodsFor: 'asserting' stamp: 'jf 8/16/2003 23:42'!
assertPathTo: aSymbol is: anArray
	self
		assertNamesOf: (self tree allAncestorsOnPathTo: (self treeFrom: {aSymbol}))
		are: anArray! !

!MCAncestryTest methodsFor: 'building' stamp: 'jf 8/16/2003 22:55'!
twoPersonTree
	^ self treeFrom:
		#(c1
			((a4
				((a1)
				(b3
					((b2
						((a1)))))))
			(b5
				((b2
					((a1)))))))! !

!MCAncestryTest methodsFor: 'asserting' stamp: 'avi 9/17/2005 21:09'!
assertCommonAncestorOf: leftName and: rightName is: ancestorName in: tree
	self assertCommonAncestorOf: leftName and: rightName in: (Array with: ancestorName) in: tree! !

!MCAncestryTest methodsFor: 'asserting' stamp: 'stephaneducasse 2/4/2006 20:47'!
assertNamesOf: versionInfoCollection are: nameArray
	| names |
	names := versionInfoCollection collect: [:ea | ea name].
	
	self assert: names asArray = nameArray! !

!MCAncestryTest methodsFor: 'tests' stamp: 'avi 9/17/2005 21:08'!
testCommonAncestors
	self assertCommonAncestorOf: #a2 and: #e2 is: #a1 in: self tree.
	self assertCommonAncestorOf: #e2 and: #b3 is: #a1 in: self tree.
	self assertCommonAncestorOf: #b2 and: #e2 is: #'00' in: self tree.
	
	self assertCommonAncestorOf: #a4 and: #b5 in: #(b2 a1) in: self twoPersonTree.
	self assertCommonAncestorOf: #b5 and: #b3 is: #b2 in: self twoPersonTree.
	self assertCommonAncestorOf: #b2 and: #a4 is: #b2 in: self twoPersonTree.
	self assertCommonAncestorOf: #b2 and: #b2 is: #b2 in: self twoPersonTree.
	self assertCommonAncestorOf: #b2 and: #a1 is: #a1 in: self twoPersonTree.
	self assertCommonAncestorOf: #a1 and: #b2 is: #a1 in: self twoPersonTree.! !

!MCCacheRepository commentStamp: '<historical>'!
I am a special monticello directory-based repository that is used for the global monticello cache.

Most other repositories will first query the default cache repository for existing files before handling the request by themselves. For instance an http repository will first check if the file is in the caceh before doing a "slow" download.!
!MCCacheRepository methodsFor: 'interface' stamp: 'CamilloBruni 4/20/2012 18:10'!
versionWithInfo: aVersionInfo ifAbsent: errorBlock
	(self allFileNamesForVersionNamed: aVersionInfo name) do: [:fileName | | version |
			version := self versionFromFileNamed: fileName.
			version info = aVersionInfo ifTrue: [^ version]].
	^ errorBlock value! !

!MCCacheRepository methodsFor: 'utility' stamp: 'CamilloBruni 7/6/2012 16:20'!
disable
	cacheEnabled := false.! !

!MCCacheRepository methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
cacheForPackage: aPackage
	packageCaches ifNil: [packageCaches := Dictionary new].
	^ packageCaches at: aPackage ifAbsentPut: [MCPackageCache new]! !

!MCCacheRepository methodsFor: 'accessing' stamp: 'avi 1/22/2004 18:29'!
rescan
	self newFileNames do:
		[:ea |
		self versionReaderForFileNamed: ea do:
			[:reader |
			(self cacheForPackage: reader package)
				recordVersionInfo: reader info
				forFileNamed: ea.
			self seenFileNames add: ea]]
		displayingProgress: 'Scanning cache...'! !

!MCCacheRepository methodsFor: 'instance-creation' stamp: 'avi 1/22/2004 18:15'!
newFileNames 
	^ self allFileNames difference: self seenFileNames! !

!MCCacheRepository methodsFor: 'utility' stamp: 'CamilloBruni 7/6/2012 16:20'!
disableCacheDuring: aBlock
	self disable.
	aBlock ensure: [ self enable ].! !

!MCCacheRepository methodsFor: 'initialization' stamp: 'CamilloBruni 7/6/2012 16:20'!
initialize
	cacheEnabled := true.
	super initialize.! !

!MCCacheRepository methodsFor: '*Komitter-Models' stamp: 'ChristopheDemarey 4/1/2014 17:35'!
isCache
	"This is a bit hackish but we want to exclude the package cache which does not seem to be instance of a dedicated class"
	
	^ (self description includesSubstring: 'package-cache')! !

!MCCacheRepository methodsFor: 'accessing' stamp: 'CamilloBruni 7/6/2012 16:13'!
versionInfoForFileNamed: aString
	^ self infoCache 
		at: aString 
		ifAbsentPut: [ self versionReaderForFileNamed: aString do: [:r | r info]]! !

!MCCacheRepository methodsFor: 'utility' stamp: 'CamilloBruni 7/6/2012 16:20'!
enable
	cacheEnabled := true! !

!MCCacheRepository methodsFor: 'accessing' stamp: 'avi 1/22/2004 15:13'!
packageForFileNamed: aString
	^ self packageCache at: aString ifAbsentPut: [self versionReaderForFileNamed: aString do: [:r | r package]]! !

!MCCacheRepository methodsFor: 'storing' stamp: 'StephaneDucasse 8/17/2012 16:22'!
basicStoreVersion: aVersion
	"we store a version if it is cacheable and we don't have the file already"
	
	(aVersion isCacheable and: [(self includesFileNamed: aVersion fileName) not])
		ifTrue: [super basicStoreVersion: aVersion]
! !

!MCCacheRepository methodsFor: 'private' stamp: 'CamilloBruni 2/28/2012 20:10'!
loadVersionFromFileNamed: aString
	
	^ self versionReaderForFileNamed: aString do: [:r | r version]! !

!MCCacheRepository methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
seenFileNames
	^ seenFiles ifNil: [seenFiles := OrderedCollection new]! !

!MCCacheRepository methodsFor: 'storing' stamp: 'SeanDeNigris 2/26/2015 14:12'!
storeVersion: aVersion
	cacheEnabled == true ifFalse: [ ^ self ].
	^ super storeVersion: aVersion.! !

!MCCacheRepository class methodsFor: 'utility' stamp: 'SeanDeNigris 7/17/2012 15:34'!
disableCacheDuring: aBlock
	self uniqueInstance disableCacheDuring: aBlock! !

!MCCacheRepository class methodsFor: 'initialize-release' stamp: 'SeanDeNigris 7/17/2012 15:36'!
initialize
	self resetIfInvalid! !

!MCCacheRepository class methodsFor: 'accessing' stamp: 'avi 10/9/2003 12:56'!
description
	^ nil! !

!MCCacheRepository class methodsFor: 'private' stamp: 'SeanDeNigris 7/17/2012 15:36'!
resetIfInvalid
	"Reset if invalid"

	default notNil and: [default directory exists ifFalse: [default := nil]]! !

!MCCacheRepository class methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 7/24/2012 10:50'!
default
	"This should be deleted as soon as Metacello is fixed"
	self flag: #toBeDeleted.			
	^ self uniqueInstance ! !

!MCCacheRepository class methodsFor: 'accessing settings' stamp: 'SeanDeNigris 7/17/2012 15:20'!
cacheDirectory: directory
	"directory - can be an absolutePathString (to interface with the settings framework), or aFileReference"
 
	default := self new directory: directory asFileReference.! !

!MCCacheRepository class methodsFor: 'accessing settings' stamp: 'SeanDeNigris 7/17/2012 15:34'!
cacheDirectory
	^self uniqueInstance directory asAbsolute
	! !

!MCCacheRepository class methodsFor: 'defaults' stamp: 'DamienCassou 12/20/2013 12:57'!
defaultDirectory
	| directories |
	directories := {('package-cache' asFileReference).	(FileLocator temp).	(FileLocator home)}.
	directories
		do: [ :directory | 
			[ ^ directory ensureCreateDirectory; yourself ]
				on: Error do: [ "ignore and try the next directory" ] ].
	Error signal: 'Can''t create a package-cache'! !

!MCCacheRepository class methodsFor: 'accessing' stamp: 'SeanDeNigris 7/17/2012 15:38'!
uniqueInstance
	self resetIfInvalid.
	^ default ifNil: [default := self new directory: self defaultDirectory]! !

!MCChangeNotificationTest methodsFor: 'running' stamp: 'GuillermoPolito 8/24/2012 14:25'!
setUp

       "FIXME: Unregister Monticellomocks if it got created in another test
       (for example MCMethodDefinitionTest may create it implicitly).
       This avoids a nasty failure of MCChangeNotificationTest due to
       some inconsistency about the package info registered with it.
       If Monticellomocks was created earlier it will contain a 'regular'
       PackageInfo instance but the test requires it to be an MCMockPackageInfo"
"       MCWorkingCopy registry
               removeKey: (MCPackage new name: 'MonticelloMocks')
               ifAbsent:[].
       PackageOrganizer default unregisterPackageNamed: 'MonticelloMocks'."

       workingCopy := MCWorkingCopy forPackage: self mockPackage.! !

!MCChangeNotificationTest methodsFor: 'events' stamp: 'TheIntegrator 9/5/2014 17:14'!
modifiedEventFor: aSelector ofClass: aClass
	| method |
	method := aClass compiledMethodAt: aSelector.
	^ MethodModified 
		methodChangedFrom: method
		to: method
		oldProtocol: nil
! !

!MCChangeNotificationTest methodsFor: 'tests' stamp: 'bf 5/20/2005 19:54'!
testCoreMethodModified
	| event |
	workingCopy modified: false.
	event := self modifiedEventFor: #one ofClass: self mockClassA.
	MCWorkingCopy methodModified: event.
	self assert: workingCopy modified! !

!MCChangeNotificationTest methodsFor: 'tests' stamp: 'bf 5/20/2005 17:00'!
testForeignMethodModified
	| event |
	workingCopy modified: false.
	event := self modifiedEventFor: #foreignMethod ofClass: self class.
	MCWorkingCopy methodModified: event.
	self deny: workingCopy modified! !

!MCChangeNotificationTest methodsFor: 'tests' stamp: 'EstebanLorenzano 9/12/2012 13:34'!
testExtMethodModified
	| event mref |
	workingCopy modified: false.
	mref := workingCopy packageSet extensionMethods first.
	event := self modifiedEventFor: mref selector ofClass: mref actualClass.
	MCWorkingCopy methodModified: event.
	self assert: workingCopy modified! !

!MCChangeNotificationTest methodsFor: 'private' stamp: 'bf 5/20/2005 16:19'!
foreignMethod
	"see testForeignMethodModified"! !

!MCChangeSelectionRequest commentStamp: 'TorstenBergmann 2/5/2014 13:45'!
Notify about a change selection request!
!MCChangeSelectionRequest methodsFor: '*MonticelloGUI' stamp: 'avi 9/14/2004 15:01'!
defaultAction
	^ (MCChangeSelector new patch: patch; label: label) showModally! !

!MCChangeSelectionRequest methodsFor: 'accessing' stamp: 'avi 9/14/2004 15:02'!
label
	^ label! !

!MCChangeSelectionRequest methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
patch: aPatch
	patch := aPatch! !

!MCChangeSelectionRequest methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
label: aString
	label := aString! !

!MCChangeSelectionRequest methodsFor: 'accessing' stamp: 'avi 9/11/2004 15:12'!
patch
	^ patch! !

!MCChangeSelector commentStamp: 'TorstenBergmann 2/20/2014 15:52'!
Monticello selector for changes!
!MCChangeSelector methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
kept
	^ kept ifNil: [kept := Set new]! !

!MCChangeSelector methodsFor: 'morphic ui' stamp: 'avi 9/11/2004 16:07'!
buttonSpecs
	^ #((Select select 'Select these changes')
		 (Cancel cancel 'Cancel the operation')
		)! !

!MCChangeSelector methodsFor: 'actions' stamp: 'avi 9/11/2004 16:26'!
cancel
	self answer: nil! !

!MCChangeSelector methodsFor: 'selection' stamp: 'stephaneducasse 2/4/2006 20:47'!
selectNone
	kept := Set new.
	self changed: #list! !

!MCChangeSelector methodsFor: 'morphic ui' stamp: 'avi 9/14/2004 15:01'!
defaultLabel
	^ 'Change Selector'! !

!MCChangeSelector methodsFor: 'multi-selection' stamp: 'avi 9/11/2004 16:22'!
listSelectionAt: aNumber
	^ self kept includes: (self items at: aNumber)! !

!MCChangeSelector methodsFor: 'morphic ui' stamp: 'MarcusDenker 3/25/2013 13:06'!
widgetSpecs
	 ^#(
		((buttonRow) (0 0 1 0) (0 0 0 30))
		((multiListMorph:selection:listSelection:menu: list selection listSelectionAt: methodListMenu:) (0 0 1 0.4) (0 30 0 0))
		((buttonRow: #(('Select All' selectAll 'select all changes') ('Select None' selectNone 'select no changes'))) (0 0.4 1 0.4) (0 0 0 30))
		((textMorph: text) (0 0.4 1 1) (0 30 0 0))
		)

	! !

!MCChangeSelector methodsFor: 'multi-selection' stamp: 'stephaneducasse 2/4/2006 20:47'!
listSelectionAt: aNumber put: aBoolean
	| item |
	item := self items at: aNumber.
	aBoolean
		ifTrue: [self kept add: item ]
		ifFalse: [self kept remove: item ifAbsent: []]! !

!MCChangeSelector methodsFor: 'emulating' stamp: 'avi 9/11/2004 16:26'!
select
	self answer: (MCPatch operations: kept)! !

!MCChangeSelector methodsFor: 'selection' stamp: 'avi 9/14/2004 15:00'!
selectAll
	kept addAll: self items.
	self changed: #list! !

!MCClassDefinition commentStamp: '<historical>'!
A MCClassDefinition represents a class.!
!MCClassDefinition methodsFor: 'printing' stamp: 'cwp 7/7/2003 23:35'!
instanceVariablesString
	^ self stringForVariablesOfType: #isInstanceVariable! !

!MCClassDefinition methodsFor: 'accessing' stamp: 'ab 11/13/2002 17:41'!
superclassName
	^ superclassName! !

!MCClassDefinition methodsFor: 'accessing' stamp: 'ab 12/5/2002 21:24'!
description
	^ Array with: name
! !

!MCClassDefinition methodsFor: 'printing' stamp: 'al 3/28/2006 23:42'!
printDefinitionOn: stream
		stream 
			nextPutAll: self superclassName;
			nextPutAll: self kindOfSubclass;
			nextPut: $# ;
			nextPutAll: self className;
			cr; tab.
		self hasTraitComposition ifTrue: [
			stream 
				nextPutAll: 'uses: ';
		 		nextPutAll: self traitCompositionString;
				cr; tab ].
		stream
			nextPutAll: 'instanceVariableNames: ';
			store: self instanceVariablesString;
			cr; tab;
			nextPutAll: 'classVariableNames: ';
			store: self classVariablesString;
			cr; tab;
			nextPutAll: 'poolDictionaries: ';
			store: self sharedPoolsString;
			cr; tab;
			nextPutAll: 'category: ';
			store: self category asString! !

!MCClassDefinition methodsFor: 'comparing' stamp: 'StephaneDucasse 2/11/2012 09:14'!
requirements
	^superclassName == #nil
		ifTrue: [self poolDictionaries]
		ifFalse: [(Array with: superclassName), self poolDictionaries]! !

!MCClassDefinition methodsFor: 'testing' stamp: 'cwp 8/2/2003 02:54'!
hasClassInstanceVariables
	^ (self selectVariables: #isClassInstanceVariable) isEmpty not! !

!MCClassDefinition methodsFor: 'accessing' stamp: 'cwp 7/7/2003 23:33'!
instVarNames
	^ self selectVariables: #isInstanceVariable! !

!MCClassDefinition methodsFor: 'printing' stamp: 'MarcusDenker 1/22/2015 14:49'!
instanceVariables
	^self hasComplexVariables 
		ifTrue: [self variablesOfType: #isInstanceVariable]
		ifFalse: [self instanceVariablesString asSlotCollection]! !

!MCClassDefinition methodsFor: 'accessing' stamp: 'ab 1/15/2003 13:42'!
comment
	^ comment! !

!MCClassDefinition methodsFor: 'installing' stamp: 'eem 4/30/2009 16:47'!
stringForSortedVariablesOfType: aSymbol
	^ String streamContents:
		[:stream |
		(self selectVariables: aSymbol) asSortedCollection
			do: [:ea | stream nextPutAll: ea]
			separatedBy: [stream space]]! !

!MCClassDefinition methodsFor: 'installing' stamp: 'cwp 2/3/2004 21:35'!
stringForVariablesOfType: aSymbol
	^ String streamContents:
		[:stream |
		(self selectVariables: aSymbol) 
			do: [:ea | stream nextPutAll: ea]
			separatedBy: [stream space]]! !

!MCClassDefinition methodsFor: 'installing' stamp: 'MarcusDenker 1/9/2015 10:57'!
hasComplexVariables
	"this checks if any ivar or class var is using more than just standard definitions.
	Complex vars are encoded with a string that starts with a # or one that has a space"
	
	^self variables anySatisfy: [:var | (var name beginsWith:'#') or: [ var name includes: Character space ]]! !

!MCClassDefinition methodsFor: 'visiting' stamp: 'al 10/9/2005 19:33'!
accept: aVisitor
	aVisitor visitClassDefinition: self.
	(self hasClassInstanceVariables or: [self hasClassTraitComposition])
		ifTrue: [aVisitor visitMetaclassDefinition: self].
! !

!MCClassDefinition methodsFor: 'testing' stamp: 'al 10/9/2005 21:59'!
hasClassTraitComposition
	^self classTraitCompositionString ~= '{}'! !

!MCClassDefinition methodsFor: 'accessing' stamp: 'cwp 7/7/2003 23:28'!
selectVariables: aSelector
	^ variables select: [:v | v perform: aSelector] thenCollect: [:v | v name]! !

!MCClassDefinition methodsFor: 'printing' stamp: 'cwp 11/24/2002 22:16'!
kindOfSubclass
	type = #normal ifTrue: [^ ' subclass: '].
	type = #words ifTrue: [^ ' variableWordSubclass: '].
	type = #variable ifTrue: [^ ' variableSubclass: '].
	type = #bytes ifTrue: [^ ' variableByteSubclass: '].
	type = #weak ifTrue: [^ ' weakSubclass: ' ].
	type = #compiledMethod ifTrue: [^ ' variableByteSubclass: ' ].
	self error: 'Unrecognized class type'! !

!MCClassDefinition methodsFor: 'annotations' stamp: 'StephaneDucasse 12/30/2012 18:04'!
printAnnotations: requests on: aStream
	"Add a string for an annotation pane, trying to fulfill the browser annotationRequests"

	requests do: [ :aRequest |
		aRequest == #requirements ifTrue: [
			self requirements do: [ :req | aStream nextPutAll: req ] separatedBy: [ aStream space ]]
	] separatedBy: [ aStream space ].! !

!MCClassDefinition methodsFor: 'accessing' stamp: 'al 10/9/2005 21:55'!
traitCompositionString
	^self traitComposition ifNil: ['{}'].! !

!MCClassDefinition methodsFor: 'installing' stamp: 'MarcusDenker 1/9/2015 12:47'!
variablesOfType: aSymbol
	"version for complex vars, { definition . definition }"
	^(((self selectVariables: aSymbol) collect: [:each | Smalltalk evaluate: each])) asArray.
		! !

!MCClassDefinition methodsFor: 'printing' stamp: 'gvc 1/14/2009 13:41'!
printClassDefinitionOn: stream
	"Print a class-side definition of the receiver on the given stream.
	Class instance variables and class traits."
	
		stream
			nextPutAll: self className;
			nextPutAll: ' class';
			cr; tab.
		self hasClassTraitComposition ifTrue: [
			stream 
				nextPutAll: 'uses: ';
		 		nextPutAll: self classTraitCompositionString;
				cr; tab ].
		stream
			nextPutAll: 'instanceVariableNames: ';
			store: self classInstanceVariablesString! !

!MCClassDefinition methodsFor: 'comparing' stamp: 'ab 5/24/2003 14:12'!
provisions
	^ Array with: name! !

!MCClassDefinition methodsFor: 'accessing' stamp: 'cwp 11/24/2002 06:23'!
category
	^ category! !

!MCClassDefinition methodsFor: 'accessing' stamp: 'ab 7/19/2003 18:00'!
sortKey
	^ self className! !

!MCClassDefinition methodsFor: 'accessing' stamp: 'cwp 7/7/2003 23:32'!
classInstVarNames
	^ self selectVariables: #isClassInstanceVariable! !

!MCClassDefinition methodsFor: 'accessing' stamp: 'MarcusDenker 1/17/2015 16:08'!
classTraitCompositionCompiled
		^(Smalltalk compiler evaluate: self classTraitCompositionString) asTraitComposition ! !

!MCClassDefinition methodsFor: 'accessing' stamp: 'bf 8/29/2006 11:45'!
sortedVariables
	"sort variables for comparison purposes"

	| sorted |
	sorted := variables select: [:var | var isOrderDependend].
	sorted addAll: ((variables reject: [:var | var isOrderDependend])
		asSortedCollection: [:a :b | a name <= b name]).
	^sorted! !

!MCClassDefinition methodsFor: 'printing' stamp: 'cwp 7/7/2003 23:35'!
classInstanceVariablesString
	^ self stringForVariablesOfType: #isClassInstanceVariable! !

!MCClassDefinition methodsFor: 'printing' stamp: 'MarcusDenker 1/22/2015 14:52'!
classInstanceVariables
	^self hasComplexVariables 
		ifTrue: [ self variablesOfType: #isClassInstanceVariable]
		ifFalse: [self classInstanceVariablesString asSlotCollection]! !

!MCClassDefinition methodsFor: '*Ring-Monticello' stamp: 'MarcusDenker 7/30/2014 21:35'!
asRingDefinition
	| ring |

	ring:= (RGClassDefinition named:  self className)
		category: self category;
		superclassName: self superclassName;  
		traitCompositionSource: self traitCompositionString;
		addInstanceVariables: self instVarNames;
		addClassVariables: self classVarNames;
		addSharedPools: self poolDictionaries;
		comment: self comment;
		stamp: self commentStamp;
		definitionSource: self definitionString;
		withMetaclass.
	ring theMetaClass 
		traitCompositionSource: self classTraitCompositionString;
		addInstanceVariables: self classInstVarNames;
		definitionSource: self classDefinitionString.
	^ring! !

!MCClassDefinition methodsFor: 'testing' stamp: 'ab 5/24/2003 13:49'!
isCodeDefinition
	^ true! !

!MCClassDefinition methodsFor: 'accessing' stamp: 'cwp 7/7/2003 23:53'!
poolDictionaries
	^ self selectVariables: #isPoolImport! !

!MCClassDefinition methodsFor: 'testing' stamp: 'al 10/9/2005 20:13'!
hasComment
	^ comment isEmptyOrNil not! !

!MCClassDefinition methodsFor: 'printing' stamp: 'BernardoContreras 3/8/2015 19:34'!
classVariables
	^self hasComplexVariables 
		ifTrue: [self sortedVariablesOfType: #isClassVariable ]
		ifFalse: [(self classVariablesString substrings: ' ') collect: [:x | x asSymbol => ClassVariable]].
! !

!MCClassDefinition methodsFor: 'testing' stamp: 'al 3/29/2006 00:27'!
hasTraitComposition
	^self traitCompositionString ~= '{}'! !

!MCClassDefinition methodsFor: 'testing' stamp: 'ab 12/4/2002 21:52'!
isClassDefinition
	^ true! !

!MCClassDefinition methodsFor: 'initializing' stamp: 'NicoPaez 10/1/2010 10:41'!
defaultCommentStamp
	^ String new

	"The version below avoids stomping on stamps already in the image

	^ (Smalltalk globals at: name ifPresent: [:c | c organization commentStamp])
		ifNil: ['']
	"
! !

!MCClassDefinition methodsFor: 'printing' stamp: 'eem 4/30/2009 16:47'!
classVariablesString
	^ self stringForSortedVariablesOfType: #isClassVariable! !

!MCClassDefinition methodsFor: '*Komitter-UI' stamp: 'NicolaiHess 4/8/2014 20:01'!
koClass
	self className ifNil: [ ^ nil ] ifNotNil: [ :cname | ^ KomitClass trackedClass: cname ]! !

!MCClassDefinition methodsFor: 'accessing' stamp: 'lr 3/14/2010 21:13'!
actualClass
	^ Smalltalk globals classNamed: self className! !

!MCClassDefinition methodsFor: 'initializing' stamp: 'cwp 7/7/2003 23:19'!
addVariables: aCollection ofType: aClass
	variables addAll: (aCollection collect: [:var | aClass name: var asString]).! !

!MCClassDefinition methodsFor: 'initializing' stamp: 'bf 8/12/2009 10:55'!
initializeWithName: nameString
superclassName: superclassString
traitComposition: traitCompositionString
classTraitComposition: classTraitCompositionString
category: categoryString 
instVarNames: ivarArray
classVarNames: cvarArray
poolDictionaryNames: poolArray
classInstVarNames: civarArray
type: typeSymbol
comment: commentString
commentStamp: stampStringOrNil
	name := nameString asSymbol.
	superclassName := superclassString ifNil: ['nil'] ifNotNil: [superclassString asSymbol].
	traitComposition := traitCompositionString.
	classTraitComposition := classTraitCompositionString.
	category := categoryString.
	name = #CompiledMethod ifTrue: [type := #compiledMethod] ifFalse: [type := typeSymbol].
	comment := commentString withSqueakLineEndings.
	commentStamp := stampStringOrNil ifNil: [self defaultCommentStamp].
	variables := OrderedCollection  new.
	self addVariables: ivarArray ofType: MCInstanceVariableDefinition.
	self addVariables: cvarArray asSortedCollection ofType: MCClassVariableDefinition.
	self addVariables: poolArray asSortedCollection ofType: MCPoolImportDefinition.
	self addVariables: civarArray ofType: MCClassInstanceVariableDefinition.! !

!MCClassDefinition methodsFor: 'printing' stamp: 'cwp 7/10/2003 01:29'!
source
	^ self definitionString! !

!MCClassDefinition methodsFor: 'accessing' stamp: 'nice 10/20/2009 22:03'!
classVarNames
	^(self selectVariables: #isClassVariable) asArray sort! !

!MCClassDefinition methodsFor: 'installing' stamp: 'MarcusDenker 1/25/2015 09:15'!
load
	self createClass! !

!MCClassDefinition methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/21/2013 21:57'!
addOperation: aMCRemoval on: aKOClass

	aKOClass addClassDefinition: aMCRemoval! !

!MCClassDefinition methodsFor: 'installing' stamp: 'NicoPaez 10/1/2010 10:21'!
unload
	Smalltalk globals removeClassNamed: name! !

!MCClassDefinition methodsFor: 'accessing' stamp: 'cwp 11/24/2002 22:35'!
type
	^ type! !

!MCClassDefinition methodsFor: 'accessing' stamp: 'cwp 11/25/2002 06:51'!
variables
	^ variables! !

!MCClassDefinition methodsFor: 'installing' stamp: 'MarcusDenker 1/25/2015 09:14'!
createClass
	| superClass |
	superClass := superclassName == #nil ifFalse:
						[ Smalltalk globals at: superclassName ].
	^[PharoClassInstaller make: [ :builder | 
		builder
			superclass: superClass;
			name: name;
			layoutClass: (superClass classBuilder layoutForType: type);
			slots: self instanceVariables;
			sharedVariables: self classVariables;
			sharedPools: self sharedPoolsString;
			classSlots: self classInstanceVariables;
			traitComposition: self traitCompositionCompiled;
			classTraitComposition: self classTraitCompositionCompiled;
			comment: comment stamp: commentStamp;
			category: category;
			environment:  superClass environment]] on: Warning, DuplicatedVariableError do: [:ex| ex resume].
	


! !

!MCClassDefinition methodsFor: 'accessing' stamp: 'al 10/9/2005 20:16'!
traitComposition
	^traitComposition! !

!MCClassDefinition methodsFor: 'installing' stamp: 'MarcusDenker 1/13/2015 11:37'!
sortedVariablesOfType: aSymbol
	"version for complex vars, { definition . definition }"
	^(((self selectVariables: aSymbol) asSortedCollection collect: [:each | Smalltalk evaluate: each])) asArray.
		! !

!MCClassDefinition methodsFor: 'printing' stamp: 'lr 3/20/2010 21:23'!
printMetaDefinitionOn: stream
	stream 
		nextPutAll: self className;
		nextPutAll: ' class'; cr; tab.
	self hasClassTraitComposition ifTrue: [
		stream
			nextPutAll: 'uses: ';
			nextPutAll: self classTraitCompositionString;
			cr; tab ].
	stream
		nextPutAll: ' instanceVariableNames: '; 
		store: self classInstanceVariablesString! !

!MCClassDefinition methodsFor: 'comparing' stamp: 'stephaneducasse 2/4/2006 20:47'!
hash
	| hash |
	hash := String stringHash: name initialHash: 0.
	hash := String stringHash: superclassName initialHash: hash.
	hash := String stringHash: self traitCompositionString initialHash: hash.
	hash := String stringHash: self classTraitComposition asString initialHash: hash.
	hash := String stringHash: (category ifNil: ['']) initialHash: hash.
	hash := String stringHash: type initialHash: hash.
	variables do: [
		:v |
		hash := String stringHash: v name initialHash: hash.
	].
	^ hash! !

!MCClassDefinition methodsFor: 'accessing' stamp: 'MarcusDenker 1/17/2015 16:08'!
traitCompositionCompiled
	^(Smalltalk compiler evaluate: self traitCompositionString) asTraitComposition ! !

!MCClassDefinition methodsFor: 'accessing' stamp: 'ab 11/13/2002 01:52'!
className
	^ name! !

!MCClassDefinition methodsFor: 'accessing' stamp: 'cwp 8/10/2003 16:40'!
commentStamp
	^ commentStamp! !

!MCClassDefinition methodsFor: 'printing' stamp: 'ab 11/16/2002 17:33'!
summary
	^ name! !

!MCClassDefinition methodsFor: 'initializing' stamp: 'bf 8/12/2009 10:55'!
initializeWithName: nameString
superclassName: superclassString
category: categoryString 
instVarNames: ivarArray
classVarNames: cvarArray
poolDictionaryNames: poolArray
classInstVarNames: civarArray
type: typeSymbol
comment: commentString
commentStamp: stampStringOrNil
	name := nameString asSymbol.
	superclassName := superclassString ifNil: ['nil'] ifNotNil: [superclassString asSymbol].
	category := categoryString.
	name = #CompiledMethod ifTrue: [type := #compiledMethod] ifFalse: [type := typeSymbol].
	comment := commentString withSqueakLineEndings.
	commentStamp := stampStringOrNil ifNil: [self defaultCommentStamp].
	variables := OrderedCollection  new.
	self addVariables: ivarArray ofType: MCInstanceVariableDefinition.
	self addVariables: cvarArray asSortedCollection ofType: MCClassVariableDefinition.
	self addVariables: poolArray asSortedCollection ofType: MCPoolImportDefinition.
	self addVariables: civarArray ofType: MCClassInstanceVariableDefinition.! !

!MCClassDefinition methodsFor: 'comparing' stamp: 'nice 10/31/2009 13:11'!
= aDefinition
	^(super = aDefinition)
		and: [superclassName = aDefinition superclassName
		and: [self traitCompositionString = aDefinition traitCompositionString
		and: [self classTraitCompositionString = aDefinition classTraitCompositionString
		and: [category = aDefinition category
		and: [type = aDefinition type
		and: [self sortedVariables = aDefinition sortedVariables
		and: [comment = aDefinition comment]]]]]]]! !

!MCClassDefinition methodsFor: 'printing' stamp: 'eem 4/30/2009 16:47'!
sharedPoolsString
	^ self stringForSortedVariablesOfType: #isPoolImport! !

!MCClassDefinition methodsFor: 'printing' stamp: 'cwp 8/2/2003 02:03'!
definitionString
	^ String streamContents: [:stream | self printDefinitionOn: stream]! !

!MCClassDefinition methodsFor: 'storing' stamp: 'al 7/4/2006 10:14'!
storeDataOn: aDataStream
	| instVarSize |
	instVarSize := (self hasTraitComposition or: [ self hasClassTraitComposition ])
		ifTrue: [ self class instSize ]
		ifFalse: [ self class instSize - 2 ].
	aDataStream
		beginInstance: self class
		size: instVarSize.
	1 to: instVarSize do: [ :index |
		aDataStream nextPut: (self instVarAt: index) ].! !

!MCClassDefinition methodsFor: 'accessing' stamp: 'al 10/9/2005 21:55'!
classTraitCompositionString
	^self classTraitComposition ifNil: ['{}'].! !

!MCClassDefinition methodsFor: 'accessing' stamp: 'al 10/9/2005 20:07'!
classTraitComposition
	^classTraitComposition! !

!MCClassDefinition methodsFor: 'accessing' stamp: 'gvc 1/14/2009 13:41'!
classDefinitionString
	"Answer a string describing the class-side definition."
	
	^String streamContents: [:stream | self printClassDefinitionOn: stream]! !

!MCClassDefinition class methodsFor: 'obsolete' stamp: 'ab 4/1/2003 01:22'!
name: nameString
superclassName: superclassString
category: categoryString 
instVarNames: ivarArray
classVarNames: cvarArray
poolDictionaryNames: poolArray
classInstVarNames: civarArray
comment: commentString
	^ self	name: nameString
			superclassName: superclassString
			category: categoryString 
			instVarNames: ivarArray
			classVarNames: cvarArray
			poolDictionaryNames: poolArray
			classInstVarNames: civarArray
			type: #normal
			comment: commentString
! !

!MCClassDefinition class methodsFor: 'obsolete' stamp: 'ab 4/1/2003 01:22'!
name: nameString
superclassName: superclassString
category: categoryString 
instVarNames: ivarArray
comment: commentString
	^ self	name: nameString
			superclassName: superclassString
			category: categoryString 
			instVarNames: ivarArray
			classVarNames: #()
			poolDictionaryNames: #()
			classInstVarNames: #()
			comment: commentString
! !

!MCClassDefinition class methodsFor: 'instance creation' stamp: 'al 10/9/2005 19:16'!
name: nameString
superclassName: superclassString
category: categoryString 
instVarNames: ivarArray
classVarNames: cvarArray
poolDictionaryNames: poolArray
classInstVarNames: civarArray
type: typeSymbol
comment: commentString
commentStamp: stampString
	^ self instanceLike:
		(self new initializeWithName: nameString
					superclassName: superclassString
					traitComposition: '{}'
					classTraitComposition: '{}'
					category: categoryString 
					instVarNames: ivarArray
					classVarNames: cvarArray
					poolDictionaryNames: poolArray
					classInstVarNames: civarArray
					type: typeSymbol
					comment: commentString
					commentStamp: stampString)! !

!MCClassDefinition class methodsFor: 'obsolete' stamp: 'cwp 8/10/2003 16:33'!
name: nameString
superclassName: superclassString
category: categoryString 
instVarNames: ivarArray
classVarNames: cvarArray
poolDictionaryNames: poolArray
classInstVarNames: civarArray
type: typeSymbol
comment: commentString
	^ self 
		name: nameString
		superclassName: superclassString
		category: categoryString 
		instVarNames: ivarArray
		classVarNames: cvarArray
		poolDictionaryNames: poolArray
		classInstVarNames: civarArray
		type: typeSymbol
		comment: commentString
		commentStamp: nil! !

!MCClassDefinition class methodsFor: 'instance creation' stamp: 'al 10/10/2005 13:58'!
name: nameString
superclassName: superclassString
traitComposition: traitCompositionString
classTraitComposition: classTraitCompositionString
category: categoryString 
instVarNames: ivarArray
classVarNames: cvarArray
poolDictionaryNames: poolArray
classInstVarNames: civarArray
type: typeSymbol
comment: commentString
commentStamp: stampString
	
	^ self instanceLike:
		(self new initializeWithName: nameString
					superclassName: superclassString
					traitComposition: traitCompositionString
					classTraitComposition: classTraitCompositionString
					category: categoryString 
					instVarNames: ivarArray
					classVarNames: cvarArray
					poolDictionaryNames: poolArray
					classInstVarNames: civarArray
					type: typeSymbol
					comment: commentString
					commentStamp: stampString)! !

!MCClassDefinitionTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:23'!
testValidTraitComposition
	"Related to http://code.google.com/p/pharo/issues/detail?id=2148"

	| d className cls |
	className := 'MCMockClassC'.
	d := MCClassDefinition
		name: className
		superclassName: 'Object'
		traitComposition: '{Trait1}'
		classTraitComposition: '{}'
		category: self mockCategoryName
		instVarNames: #()
		classVarNames: #()
		poolDictionaryNames: #()
		classInstVarNames: #()
		type: #normal
		comment: (self commentForClass: className)
		commentStamp: (self commentStampForClass: className).
	d load.
	self assert: (Smalltalk hasClassNamed: 'MCMockClassC').
	cls := Smalltalk at: #MCMockClassC.
	self assert: (cls includesSelector: #c1).
	self assert: ((Smalltalk at: #MCMockClassC) traitComposition allTraits includes: Trait1)! !

!MCClassDefinitionTest methodsFor: 'running' stamp: 'Alexandre Bergel 5/22/2010 11:23'!
tearDown
	Smalltalk globals at: #MCMockClassC ifPresent: [ :c | c removeFromSystem ]! !

!MCClassDefinitionTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:47'!
testDefinitionString
	| d |
	d := self mockClassA asClassDefinition.
	self assert: d definitionString = self mockClassA definition.! !

!MCClassDefinitionTest methodsFor: 'tests' stamp: 'ClementBera 5/27/2014 13:49'!
testKindOfSubclass
	| classes |
	classes := {self mockClassA. String. Context. WeakArray. Float}.
	classes do: [:c | | d |
		d :=  c asClassDefinition.
		self assert: d kindOfSubclass = c kindOfSubclass.
	].! !

!MCClassDefinitionTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:23'!
testValidTraitComposition4
	"Related to http://code.google.com/p/pharo/issues/detail?id=2598"

	| d className cls |
	className := 'MCMockClassC'.
	d := MCClassDefinition
		name: className
		superclassName: 'Object'
		traitComposition: 'Trait1 - {#c1}'
		classTraitComposition: '{}'
		category: self mockCategoryName
		instVarNames: #()
		classVarNames: #()
		poolDictionaryNames: #()
		classInstVarNames: #()
		type: #normal
		comment: (self commentForClass: className)
		commentStamp: (self commentStampForClass: className).
	d load.
	self assert: (Smalltalk hasClassNamed: 'MCMockClassC').
	cls := Smalltalk at: #MCMockClassC.
	self assert: (cls selectors includesAllOf: {#c}).
	self deny: (cls selectors includesAnyOf: {#c1})! !

!MCClassDefinitionTest methodsFor: 'private' stamp: 'cwp 8/10/2003 17:17'!
creationMessage
	^ MessageSend
		receiver: MCClassDefinition
		selector: #name:superclassName:category:instVarNames:classVarNames:poolDictionaryNames:classInstVarNames:type:comment:commentStamp:! !

!MCClassDefinitionTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:47'!
testEquals
	| a b |
	a := self mockClass: 'ClassA' super: 'SuperA'.
	b := self mockClass: 'ClassA' super: 'SuperA'.
	self assert: a = b! !

!MCClassDefinitionTest methodsFor: 'running' stamp: 'Alexandre Bergel 5/22/2010 11:23'!
setUp
	Smalltalk globals at: #MCMockClassC ifPresent: [ :c | c removeFromSystem ]! !

!MCClassDefinitionTest methodsFor: 'tests' stamp: 'Alexandre Bergel 5/22/2010 11:22'!
testCannotLoad
	| d |
	self deny: (Smalltalk hasClassNamed: 'MCMockClassC').
	d :=  self mockClass: 'MCMockClassC' super: 'NotAnObject'.
	self should: [d load] raise: Error.
	self deny: (Smalltalk hasClassNamed: 'MCMockClassC').! !

!MCClassDefinitionTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:23'!
testValidTraitComposition2
	"Related to http://code.google.com/p/pharo/issues/detail?id=2148"

	| d className cls |
	className := 'MCMockClassC'.
	d := MCClassDefinition
		name: className
		superclassName: 'Object'
		traitComposition: 'Trait1'
		classTraitComposition: '{}'
		category: self mockCategoryName
		instVarNames: #()
		classVarNames: #()
		poolDictionaryNames: #()
		classInstVarNames: #()
		type: #normal
		comment: (self commentForClass: className)
		commentStamp: (self commentStampForClass: className).
	d load.
	self assert: (Smalltalk hasClassNamed: 'MCMockClassC').
	cls := Smalltalk at: #MCMockClassC.
	self assert: (cls includesSelector: #c1).
	self assert: ((Smalltalk at: #MCMockClassC) traitComposition allTraits includes: Trait1)! !

!MCClassDefinitionTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:23'!
testValidTraitComposition3
	"Related to http://code.google.com/p/pharo/issues/detail?id=2148"

	| d className cls |
	className := 'MCMockClassC'.
	d := MCClassDefinition
		name: className
		superclassName: 'Object'
		traitComposition: 'Trait1 + Trait2'
		classTraitComposition: '{}'
		category: self mockCategoryName
		instVarNames: #()
		classVarNames: #()
		poolDictionaryNames: #()
		classInstVarNames: #()
		type: #normal
		comment: (self commentForClass: className)
		commentStamp: (self commentStampForClass: className).
	d load.
	self assert: (Smalltalk hasClassNamed: 'MCMockClassC').
	cls := Smalltalk at: #MCMockClassC.
	self assert: (cls includesSelector: #c1).
	self assert: (cls includesSelector: #c2).
	self assert: ((Smalltalk at: #MCMockClassC) traitComposition allTraits includes: Trait1).
	self assert: ((Smalltalk at: #MCMockClassC) traitComposition allTraits includes: Trait2)! !

!MCClassDefinitionTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:47'!
testEqualsSensitivity
	| message a b defA args defB |
	message := self creationMessage.
	a := #(ClassA SuperA CategoryA #(iVarA) #(CVarA) #(PoolA) #(ciVarA)
			typeA 'A comment' 'A').
	b := #(ClassB SuperB CategoryB #(iVarB) #(CVarB) #(PoolB) #(ciVarB)
			typeB 'B comment' 'B').
	
	defA := message valueWithArguments: a.
	1 to: 8 do: [:index |
				args := a copy.
				args at: index put: (b at: index).
				defB := message valueWithArguments: args.
				self deny: defA = defB.]! !

!MCClassDefinitionTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:47'!
testComparison
	| d1 d2 d3 d4 |
	d1 := self mockClass: 'A' super: 'X'.
	d2 := self mockClass: 'A' super: 'Y'.
	d3 := self mockClass: 'B' super: 'X'.
	d4 := self mockClass: 'B' super: 'X'.
	
	self assert: (d1 isRevisionOf: d2).
	self deny: (d1 isSameRevisionAs: d2).

	self assert: (d3 isRevisionOf: d4).
	self assert: (d3 isSameRevisionAs: d4).
	
	self deny: (d1 isRevisionOf: d3).
	self deny: (d4 isRevisionOf: d2).! !

!MCClassDefinitionTest methodsFor: 'private' stamp: 'cwp 8/10/2003 01:20'!
classAComment
	^ self class classAComment! !

!MCClassDefinitionTest methodsFor: 'tests' stamp: 'pavel.krivanek 10/14/2010 16:35'!
testCreation
	| d |
	d :=  self mockClassA asClassDefinition.
	self assert: d className = #MCMockClassA.
	self assert: d superclassName = #MCMock.
	self assert: d type = #normal.
	self assert: d category = self mockCategoryName.
	self assert: d instVarNames asArray = #('ivar').
	self assert: d classVarNames asArray = #('CVar' 'InitializationOrder').
	self assert: d classInstVarNames asArray = #().
	self assert: d comment isString.
	self assert: d comment = self classAComment.
	self assert: d commentStamp = self mockClassA organization commentStamp! !

!MCClassDefinitionTest methodsFor: 'tests' stamp: 'lr 3/14/2010 21:13'!
testLoadAndUnload
	| d c |
	d := self mockClass: 'MCMockClassC' super: 'Object'.
	d load.
	self assert: (Smalltalk hasClassNamed: 'MCMockClassC').
	c := Smalltalk globals classNamed: 'MCMockClassC'.
	self assert: (c isKindOf: Class).
	self assert: c superclass = Object.
	self assert: c instVarNames isEmpty.
	self assert: c classVarNames isEmpty.
	self assert: c sharedPools isEmpty.
	self assert: c category = self mockCategoryName.
	self assert: c organization classComment = (self commentForClass: 'MCMockClassC').
	self assert: c organization commentStamp = (self commentStampForClass: 'MCMockClassC').
	d unload.
	self deny: (Smalltalk hasClassNamed: 'MCMockClassC')! !

!MCClassDefinitionTest class methodsFor: 'as yet unclassified' stamp: 'lr 3/14/2010 21:13'!
restoreClassAComment
	Smalltalk globals
		at: #MCMockClassA
		ifPresent: [ :a | a classComment: self classAComment stamp: self classACommentStamp ]! !

!MCClassDefinitionTest class methodsFor: 'as yet unclassified' stamp: 'cwp 8/10/2003 17:59'!
classACommentStamp
	^  'cwp 8/10/2003 16:43'! !

!MCClassDefinitionTest class methodsFor: 'as yet unclassified' stamp: 'cwp 8/10/2003 01:20'!
classAComment
	^ 'This is a mock class. The Monticello tests manipulated it to simulate a developer modifying code in the image.'! !

!MCClassInstanceVariableDefinition commentStamp: '<historical>'!
A MCClassInstanceVariableDefinition represents a class instance variable.!
!MCClassInstanceVariableDefinition methodsFor: 'testing' stamp: 'cwp 7/7/2003 23:31'!
isClassInstanceVariable
	^ true! !

!MCClassInstanceVariableDefinition class methodsFor: 'accessing' stamp: 'cwp 7/7/2003 22:59'!
type
	^ #classInstance! !

!MCClassTraitDefinition commentStamp: 'TorstenBergmann 2/5/2014 13:45'!
A class trait definition!
!MCClassTraitDefinition methodsFor: 'accessing' stamp: 'al 6/5/2006 14:04'!
hash
	| hash |
	hash := String stringHash: baseTrait initialHash: 0.
	hash := String stringHash: self classTraitCompositionString initialHash: hash.
	^hash
! !

!MCClassTraitDefinition methodsFor: 'accessing' stamp: 'al 10/9/2005 20:24'!
description
	^Array
		with: baseTrait
		with: classTraitComposition! !

!MCClassTraitDefinition methodsFor: 'printing' stamp: 'CamilleTeruel 5/13/2013 18:05'!
printDefinitionOn: stream
	stream
		nextPutAll: self baseTrait;
		nextPutAll: ' classTrait';
		cr;
		tab;
		nextPutAll: 'uses: ';
		nextPutAll: self classTraitCompositionString! !

!MCClassTraitDefinition methodsFor: 'accessing' stamp: 'al 10/9/2005 20:24'!
requirements
	^Array with: baseTrait! !

!MCClassTraitDefinition methodsFor: 'accessing' stamp: 'al 10/9/2005 20:25'!
sortKey
	^ self baseTrait name , '.classTrait'! !

!MCClassTraitDefinition methodsFor: 'accessing' stamp: 'MarcusDenker 10/29/2010 11:30'!
category
	^ category ifNil: [(Smalltalk classOrTraitNamed: self baseTrait)
							ifNotNil: [:bTrait | bTrait category]
							ifNil: [self error: 'Can''t detect the category']] ! !

!MCClassTraitDefinition methodsFor: 'initialization' stamp: 'damiencassou 7/30/2009 12:12'!
initializeWithBaseTraitName: aTraitName classTraitComposition: aString category: aCategoryString
	baseTrait := aTraitName.
	classTraitComposition := aString.
	category := aCategoryString! !

!MCClassTraitDefinition methodsFor: 'testing' stamp: 'adrian-lienhard 5/11/2009 16:47'!
isClassDefinition
	"Traits are treated the same like classes."
	
	^ true! !

!MCClassTraitDefinition methodsFor: 'accessing' stamp: 'al 12/15/2005 11:31'!
className
	^self baseTrait! !

!MCClassTraitDefinition methodsFor: 'initialization' stamp: 'stephaneducasse 2/4/2006 20:47'!
initializeWithBaseTraitName: aTraitName classTraitComposition: aString
	baseTrait := aTraitName.
	classTraitComposition := aString.! !

!MCClassTraitDefinition methodsFor: 'accessing' stamp: 'al 10/9/2005 20:25'!
summary
	^self baseTrait , ' classTrait'
! !

!MCClassTraitDefinition methodsFor: 'accessing' stamp: 'al 10/9/2005 20:23'!
baseTrait
	^baseTrait
! !

!MCClassTraitDefinition methodsFor: 'comparing' stamp: 'SebastianTleye 7/12/2013 13:48'!
= aDefinition
	^ (super = aDefinition)
		and: [baseTrait = aDefinition baseTrait
		and: [self classTraitCompositionString = aDefinition classTraitCompositionString]]

! !

!MCClassTraitDefinition methodsFor: 'accessing' stamp: 'al 10/9/2005 20:25'!
source
	^self definitionString! !

!MCClassTraitDefinition methodsFor: 'visiting' stamp: 'al 10/9/2005 20:23'!
accept: aVisitor
	^ aVisitor visitClassTraitDefinition: self.! !

!MCClassTraitDefinition methodsFor: '*Ring-Monticello' stamp: 'MarcusDenker 7/30/2014 21:38'!
asRingDefinition

	^(RGMetatraitDefinition named:  baseTrait)
		traitCompositionSource: self classTraitCompositionString;
		definitionSource: self definitionString;
		yourself! !

!MCClassTraitDefinition methodsFor: 'accessing' stamp: 'al 10/9/2005 21:59'!
definitionString
	^self baseTrait , ' classTrait
	uses: ' , self classTraitCompositionString.
! !

!MCClassTraitDefinition methodsFor: 'installing' stamp: 'MarcusDenker 5/2/2013 11:34'!
load	
	self class compiler evaluate: self definitionString! !

!MCClassTraitDefinition methodsFor: 'accessing' stamp: 'al 10/9/2005 20:23'!
classTraitComposition
	^classTraitComposition

! !

!MCClassTraitDefinition methodsFor: 'accessing' stamp: 'al 10/10/2005 10:12'!
classTraitCompositionString
	^self classTraitComposition ifNil: ['{}'].

! !

!MCClassTraitDefinition methodsFor: '*Ring-Monticello' stamp: 'VeronicaUquillas 7/20/2011 15:56'!
classDefinitionString

	^self definitionString! !

!MCClassTraitDefinition class methodsFor: 'instance creation' stamp: 'damiencassou 7/30/2009 12:32'!
baseTraitName: aString classTraitComposition: classTraitCompositionString
	^ self baseTraitName: aString classTraitComposition: classTraitCompositionString category: nil! !

!MCClassTraitDefinition class methodsFor: 'instance creation' stamp: 'damiencassou 7/30/2009 12:11'!
baseTraitName: aString classTraitComposition: classTraitCompositionString category: aCategoryString
	^self instanceLike: (
		self new
			initializeWithBaseTraitName: aString
			classTraitComposition: classTraitCompositionString
			category: aCategoryString).! !

!MCClassTraitParser commentStamp: '<historical>'!
MCClassTraitParser identifies classTrait. !
!MCClassTraitParser methodsFor: 'actions' stamp: 'MarcusDenker 5/18/2013 15:44'!
addDefinitionsTo: aCollection
	| tokens  definition traitCompositionString |
	tokens := source parseLiterals.
	traitCompositionString := (source readStream
		match: 'uses:';
		upToEnd) trimBoth.
	definition := MCClassTraitDefinition
		baseTraitName: (tokens at: 1) 
		classTraitComposition: traitCompositionString.
	aCollection add: definition
! !

!MCClassTraitParser class methodsFor: 'factory identification hook' stamp: 'al 10/9/2005 20:43'!
pattern
	^ '*classTrait*uses:*'! !

!MCClassVariableDefinition commentStamp: '<historical>'!
A MCClassVariableDefinition represent a class variable.!
!MCClassVariableDefinition methodsFor: 'testing' stamp: 'cwp 7/7/2003 23:32'!
isClassVariable
	^ true! !

!MCClassVariableDefinition methodsFor: 'testing' stamp: 'bf 8/29/2006 11:41'!
isOrderDependend
	^false! !

!MCClassVariableDefinition class methodsFor: 'accessing' stamp: 'cwp 7/7/2003 22:58'!
type
	^ #class! !

!MCCodeTool commentStamp: 'nk 11/10/2003 22:00'!
MCCodeTool is an abstract superclass for those Monticello browsers that display code.
It contains copies of the various CodeHolder methods that perform the various menu operations in the method list.
!
!MCCodeTool methodsFor: 'subclassresponsibility' stamp: 'nk 11/10/2003 22:02'!
selectedClass
	"Answer the class that is selected, or nil"
	self subclassResponsibility! !

!MCCodeTool methodsFor: 'menus' stamp: 'MarcusDenker 10/13/2013 07:57'!
browseSendersOfMessages
	"Present a menu of the currently selected message, as well as all messages sent by it.  Open a message set browser of all senders of the selector chosen."

	self systemNavigation browseAllSendersOf: (self selectedMessageName ifNil: [ ^nil ])! !

!MCCodeTool methodsFor: 'menus' stamp: 'MarcusDenker 6/28/2014 11:28'!
browseVersions
	"Create and schedule a message set browser on all versions of the 
	currently selected message selector."
	
	Smalltalk tools versionBrowser  
		browseVersionsForClass:  self selectedClassOrMetaClass 
		selector: self selectedMessageName
		! !

!MCCodeTool methodsFor: 'menus' stamp: 'MarcusDenker 2/16/2010 16:30'!
classHierarchy
	"Create and schedule a class list browser on the receiver's hierarchy."

	self systemNavigation 
		browseHierarchy: self selectedClassOrMetaClass
		selector: self selectedMessageName	"OK if nil"! !

!MCCodeTool methodsFor: 'menus' stamp: 'nk 11/10/2003 21:26'!
browseMessages
	"Present a menu of the currently selected message, as well as all messages sent by it.  Open a message set browser of all implementors of the selector chosen."

	self systemNavigation browseAllImplementorsOf: (self selectedMessageName ifNil: [ ^nil ])! !

!MCCodeTool methodsFor: 'menus' stamp: 'MarcusDenker 7/13/2012 23:51'!
methodListKey: aKeystroke from: aListMorph 
	aKeystroke caseOf: {
		[$b] -> [self browseMethodFull].
		[$h] -> [self classHierarchy].
		[$o] -> [self fileOutMessage].
		[$c] -> [self copySelector].
		[$n] -> [self browseSendersOfMessages].
		[$m] -> [self browseMessages].
		[$i] -> [self methodHierarchy].
		[$v] -> [self browseVersions]}
		 otherwise: []! !

!MCCodeTool methodsFor: 'menus' stamp: 'StephaneDucasse 10/27/2014 09:34'!
methodListMenu: aMenu
	"Build the menu for the selected method, if any."
	
	self selectedMessageName 
		ifNil: [ items notEmpty ifTrue: [aMenu add: 'FileOut (o)'	selector: #fileOutMessage]]
		ifNotNil: [
			aMenu addList:#(
				('Browse full (b)' 						browseMethodFull)
				('Browse hierarchy (h)'					classHierarchy)
				-
				('FileOut (o)'							fileOutMessage)
				('Copy selector (c)'						copySelector)).
			aMenu addList: #(
				-
				('Browse senders (n)'						browseSendersOfMessages)
				('Browse implementors (m)'					browseMessages)
				('Inheritance (i)'						methodHierarchy)
				('Versions (v)'							browseVersions)) ].
	^ aMenu
! !

!MCCodeTool methodsFor: 'menus' stamp: 'IgorStasenko 3/6/2011 18:55'!
browseMethodFull
	"Create and schedule a full Browser and then select the current class and message."

	| myClass |
	(myClass := self selectedClassOrMetaClass) ifNotNil:
		[Smalltalk tools browser fullOnClass: myClass selector: self selectedMessageName]! !

!MCCodeTool methodsFor: 'menus' stamp: 'StephaneDucasse 7/11/2010 23:05'!
fileOutMessage
	"Put a description of the selected message on a file"

	| fileName |
	self selectedMessageName ifNotNil:
		[Cursor write showWhile:
			[self selectedClassOrMetaClass fileOutMethod: self selectedMessageName].
		 ^self].
	items isEmpty ifTrue:
		[^self].
	fileName := UIManager default request: 'File out on which file?' initialAnswer: 'methods'.
	Cursor write showWhile:
		[| internalStream |
		internalStream := WriteStream on: (String new: 1000).
		internalStream header; timeStamp.
		items do:
			[:patchOp|
			patchOp definition isMethodDefinition ifTrue:
				[(patchOp definition actualClass notNil
				  and: [patchOp definition actualClass includesSelector: patchOp definition selector])
					ifTrue:
						[patchOp definition actualClass
							printMethodChunk: patchOp definition selector
							withPreamble: true
							on: internalStream
							moveSource: false
							toFile: nil]
					ifFalse:
						[internalStream nextChunkPut: patchOp definition className, ' removeSelector: ', patchOp definition selector printString]].
			patchOp definition isClassDefinition ifTrue:
				[patchOp definition actualClass
					ifNotNil:
						[internalStream nextChunkPut: patchOp definition actualClass definition.
						 patchOp definition comment ifNotNil:
							[patchOp definition actualClass organization
								putCommentOnFile: internalStream
								numbered: 1
								moveSource: false
								forClass: patchOp definition actualClass]]
					ifNil:
						[internalStream nextChunkPut: patchOp definition className, ' removeFromSystem']]].
		FileStream writeSourceCodeFrom: internalStream baseName: fileName isSt: true]! !

!MCCodeTool methodsFor: 'subclassresponsibility' stamp: 'nk 11/10/2003 22:02'!
selectedMessageCategoryName
	"Answer the method category of the method that is selected, or nil"
	self subclassResponsibility! !

!MCCodeTool methodsFor: 'subclassresponsibility' stamp: 'nk 11/10/2003 22:02'!
selectedClassOrMetaClass
	"Answer the class that is selected, or nil"
	self subclassResponsibility! !

!MCCodeTool methodsFor: 'subclassresponsibility' stamp: 'nk 11/10/2003 22:02'!
selectedMessageName
	"Answer the name of the selected message"
	self subclassResponsibility! !

!MCCodeTool methodsFor: 'menus' stamp: 'MarcusDenker 10/13/2012 18:06'!
classListMenu: aMenu 

	^aMenu addList: #(
		-
		('Browse full (b)'			browseMethodFull)
		('Browse hierarchy (h)'		classHierarchy)
		-
		('Show hierarchy'			methodHierarchy))! !

!MCCodeTool methodsFor: 'menus' stamp: 'stephaneducasse 2/4/2006 20:47'!
copySelector
	"Copy the selected selector to the clipboard"

	| selector |
	(selector := self selectedMessageName) ifNotNil:
		[Clipboard clipboardText: selector asString]! !

!MCCodeTool methodsFor: 'menus' stamp: 'nk 7/30/2004 17:56'!
methodHierarchy
	"Create and schedule a method browser on the hierarchy of implementors."

	self systemNavigation methodHierarchyBrowserForClass: self selectedClassOrMetaClass
		selector: self selectedMessageName! !

!MCConfiguration commentStamp: 'StephaneDucasse 11/29/2011 22:23'!
An MCConfiguration specifies the configuration of a set of related Monticello packages. It maintains an ordered list of package versions and a list of repositories in which the packages may be found.

An MCConfiguration may be filed out for storage as an array specification, and new instances can be created from a stored array specification.
!
!MCConfiguration methodsFor: 'faking' stamp: 'bf 3/24/2005 01:19'!
changes
	^MCPatch operations: #()! !

!MCConfiguration methodsFor: 'updating' stamp: 'bf 5/23/2005 17:43'!
updateFromImage
	self dependencies: (self dependencies collect: [:dep |
		dep package hasWorkingCopy
			ifTrue: [
				dep package workingCopy in: [:wc |
					MCVersionDependency package: wc package info: wc ancestors first]]
			ifFalse: [dep]]).
! !

!MCConfiguration methodsFor: 'accessing' stamp: 'bf 3/21/2005 18:40'!
dependencies: aCollection
	dependencies := aCollection! !

!MCConfiguration methodsFor: 'private' stamp: 'bf 6/9/2005 16:07'!
logError: aString
	self log
		cr; nextPutAll: 'ERROR: ';
		nextPutAll: aString; cr;
		flush.
! !

!MCConfiguration methodsFor: 'private' stamp: 'MarcusDenker 10/10/2013 23:26'!
versionNamed: verName for: aDependency from: repo

	| baseName fileName ver |
	(repo filterFileNames: repo cachedFileNames forVersionNamed: verName) ifNotEmpty: [:cachedNames |
		fileName := cachedNames anyOne.
		ProgressNotification signal: '' extra: 'Using cached ', fileName.
		ver := repo versionFromFileNamed: fileName].
	ver ifNil: [
		baseName := self diffBaseFor: aDependency.
		(baseName notNil and: [baseName ~= verName and: [repo includesVersionNamed: baseName]]) ifTrue: [
			fileName := (MCDiffyVersion nameForVer: verName base: baseName), '.mcd'.
			ProgressNotification signal: '' extra: 'Downloading ', fileName.
			ver := repo versionFromFileNamed: fileName]].
	ver ifNil: [
		fileName := verName, '.mcz'.
		ProgressNotification signal: '' extra: 'Downloading ', fileName.
		ver := repo versionFromFileNamed: fileName].
	^ver! !

!MCConfiguration methodsFor: 'private' stamp: 'bf 3/20/2006 19:10'!
mergeVersionsSilently: aCollection

	^self suppressMergeDialogWhile: [self mergeVersions: aCollection]! !

!MCConfiguration methodsFor: '*MonticelloGUI' stamp: 'BenjaminVanRyseghem 2/8/2012 17:09'!
browse

	^ (MCConfigurationBrowser new configuration: self) show! !

!MCConfiguration methodsFor: 'initialization' stamp: 'ar 5/27/2005 17:28'!
initialize
	super initialize.
	log := DefaultLog.! !

!MCConfiguration methodsFor: 'actions' stamp: 'bf 3/22/2005 10:51'!
fileOutOn: aStream
	self writerClass fileOut: self on: aStream! !

!MCConfiguration methodsFor: 'accessing' stamp: 'bf 3/23/2005 17:35'!
repositories
	^repositories ifNil: [repositories := OrderedCollection new]! !

!MCConfiguration methodsFor: 'accessing' stamp: 'ar 4/28/2005 11:55'!
log: aStream
	log := aStream.! !

!MCConfiguration methodsFor: 'accessing' stamp: 'bf 3/22/2005 18:22'!
fileName
	^ self name, '.', self writerClass extension
! !

!MCConfiguration methodsFor: 'actions' stamp: 'bf 3/17/2006 15:55'!
load
	"install all the versions in this configuration, even if this means to downgrade a package"

	| versions |
	versions := OrderedCollection new.

	self depsSatisfying: [:dep | dep isCurrent not]
		versionDo: [:ver | versions add: ver]
		displayingProgress: 'finding packages'.

	^self loadVersions: versions! !

!MCConfiguration methodsFor: 'updating' stamp: 'StephaneDucasse 2/20/2010 23:07'!
updateFromRepositories
	| oldInfos newNames sortedNames newDeps |
	oldInfos := self dependencies collect: [:dep | dep versionInfo].
	newNames := Dictionary new.
	self repositories
		do: [ :repo | 
			ProgressNotification signal: '' extra: 'Checking ', repo description.
			(repo possiblyNewerVersionsOfAnyOf: oldInfos)
				do: [:newName | newNames at: newName put: repo]]
		displayingProgress: 'Searching new versions'.

	sortedNames := newNames keys asSortedCollection:
		[:a :b | a numericSuffix > b numericSuffix].

	newDeps := OrderedCollection new.
	self dependencies do: [:dep |
		| newName |
		newName := sortedNames
			detect: [:each | (each copyUpToLast: $-) = dep package name]
			ifNone: [nil].
		newDeps add: (newName
			ifNil: [dep]
			ifNotNil: [
				| repo ver  |
				repo := newNames at: newName.
				ver := self versionNamed: newName for: dep from: repo.
				ver ifNil: [dep]
					ifNotNil: [MCVersionDependency package: ver package info: ver info]
			])
	] displayingProgress: 'downloading new versions'.

	self dependencies: newDeps.
! !

!MCConfiguration methodsFor: 'actions' stamp: 'bf 3/16/2006 17:41'!
merge
	"merge in all the versions in this configuration"

	| versions |
	versions := OrderedCollection new.

	self depsSatisfying: [:dep | dep isFulfilledByAncestors not]
		versionDo: [:ver | versions add: ver]
		displayingProgress: 'finding packages'.

	^self mergeVersions: versions! !

!MCConfiguration methodsFor: 'private' stamp: 'MarcusDenker 10/10/2013 23:26'!
depsSatisfying: selectBlock versionDo: verBlock displayingProgress: progressString
	| repoMap count |
	repoMap := Dictionary new.
	self repositories do: [:repo |
		MCRepositoryGroup default addRepository: repo.
		repo allVersionNames
			ifEmpty: [self logWarning: 'cannot read from ', repo description]
			ifNotEmpty: [:all | all do: [:ver | repoMap at: ver put: repo]]].

	count := 0.
	self dependencies do: [:dep |
		| ver repo |
		ver := dep versionInfo name.
		repo := repoMap 
					at: ver 
					ifAbsent: 
						[self logError: 'Version ', ver, ' not found in any repository'.
						self logError: 'Aborting'.
						^count].
		(selectBlock value: dep) 
			ifTrue: [| new |
					new := self versionNamed: ver for: dep from: repo.
					new ifNil: 
							[self logError: 'Could not download version ', ver, ' from ', repo description.
							self logError: 'Aborting'.
							^count]
						ifNotNil: 
							[ self logUpdate: dep package with: new.
							ProgressNotification signal: '' extra: 'Installing ', ver.
							verBlock value: new.
							count := count + 1]].
		dep package workingCopy repositoryGroup addRepository: repo.
	] displayingProgress: progressString.
	^count! !

!MCConfiguration methodsFor: 'private' stamp: 'bf 3/16/2006 19:07'!
loadVersions: aCollection

	| loader |
	aCollection isEmpty ifTrue: [^0].
	loader := MCVersionLoader new.
	aCollection do: [:each | loader addVersion: each].
	loader loadWithNameLike: self nameForChangeset.
	^ aCollection size! !

!MCConfiguration methodsFor: 'private' stamp: 'bf 6/9/2005 15:59'!
logUpdate: aPackage with: aVersion
	self log
		cr; nextPutAll: '========== ', aVersion info name, ' =========='; cr;
		cr; nextPutAll: aVersion info message asString; cr;
		flush.

	aPackage hasWorkingCopy ifFalse: [^self].

	aPackage workingCopy ancestors do: [:each |
		(aVersion info hasAncestor: each)
			ifTrue: [(aVersion info allAncestorsOnPathTo: each)
				do: [:ver | self log cr; nextPutAll: '>>> ', ver name, ' <<<'; cr;
							nextPutAll: ver message; cr; flush]]]! !

!MCConfiguration methodsFor: 'private' stamp: 'CamilloBruni 9/15/2013 17:58'!
suppressMergeDialogWhile: aBlock
	^aBlock 
		on: MCMergeResolutionRequest
		do: [:request | request autoMerge ]! !

!MCConfiguration methodsFor: 'accessing' stamp: 'bf 6/9/2005 15:58'!
log
	^log ifNil: [Transcript]! !

!MCConfiguration methodsFor: 'accessing' stamp: 'bf 3/22/2005 10:50'!
writerClass
	^ MCMcmWriter ! !

!MCConfiguration methodsFor: 'actions' stamp: 'bf 3/17/2006 16:17'!
upgradeByLoading
	"this differs from #load only in that newer versions in the image are not downgraded"

	| versions |
	versions := OrderedCollection new.

	self depsSatisfying: [:dep | dep isFulfilledByAncestors not]
		versionDo: [:ver | versions add: ver]
		displayingProgress: 'finding packages'.

	^self loadVersions: versions
! !

!MCConfiguration methodsFor: 'actions' stamp: 'bf 3/20/2006 19:10'!
upgradeByMerging
	| versions |
	versions := OrderedCollection new.

	self depsSatisfying: [:dep | dep isFulfilledByAncestors not]
		versionDo: [:ver | versions add: ver]
		displayingProgress: 'finding packages'.

	^(versions noneSatisfy: [:ver | self mustMerge: ver])
		ifTrue: [self loadVersions: versions]
		ifFalse: [self mergeVersionsSilently: versions].
! !

!MCConfiguration methodsFor: 'accessing' stamp: 'bf 3/23/2005 00:44'!
summary
	^String streamContents: [:stream |
		self dependencies
			do: [:ea | stream nextPutAll: ea versionInfo name; cr ]]! !

!MCConfiguration methodsFor: 'testing' stamp: 'bf 3/22/2005 22:56'!
isCacheable
	^false! !

!MCConfiguration methodsFor: 'actions' stamp: 'AlainPlantec 12/17/2009 22:59'!
upgrade
	^self class upgradeIsMerge
		ifTrue: [self upgradeByMerging]
		ifFalse: [self upgradeByLoading]! !

!MCConfiguration methodsFor: 'accessing' stamp: 'bf 3/23/2005 17:36'!
repositories: aCollection
	repositories := aCollection! !

!MCConfiguration methodsFor: 'private' stamp: 'bf 3/16/2006 19:07'!
mergeVersions: aCollection

	| merger |
	aCollection isEmpty ifTrue: [^0].
	merger := MCVersionMerger new.
	aCollection do: [:each | merger addVersion: each].
	merger mergeWithNameLike: self nameForChangeset.
	^ aCollection size! !

!MCConfiguration methodsFor: 'accessing' stamp: 'bf 3/22/2005 18:23'!
name: aString
	name := aString! !

!MCConfiguration methodsFor: 'private' stamp: 'bf 6/9/2005 16:08'!
logWarning: aString
	self log
		cr; nextPutAll: 'WARNING: ';
		nextPutAll: aString; cr;
		flush.
! !

!MCConfiguration methodsFor: 'private' stamp: 'bf 5/23/2005 14:47'!
mustMerge: aVersion
	"answer true if we have to do a full merge and false if we can simply load instead"
	
	| pkg wc current |
	(pkg := aVersion package) hasWorkingCopy ifFalse: [^false "no wc -> load"].
	(wc := pkg workingCopy) modified ifTrue: [^true "modified -> merge"].
	wc ancestors isEmpty ifTrue: [^true "no ancestor info -> merge"].
	current := wc ancestors first.
	(aVersion info hasAncestor: current) ifTrue: [^false "direct descendant of wc -> load"].
	"new branch -> merge"
	^true! !

!MCConfiguration methodsFor: 'copying' stamp: 'bf 11/26/2005 20:22'!
postCopy
	dependencies := dependencies shallowCopy.
	repositories := repositories shallowCopy.! !

!MCConfiguration methodsFor: 'faking' stamp: 'bf 3/24/2005 01:17'!
info
	^MCVersionInfo new! !

!MCConfiguration methodsFor: 'private' stamp: 'bf 3/16/2006 19:07'!
nameForChangeset
	^self name ifNil: [self class name]! !

!MCConfiguration methodsFor: 'accessing' stamp: 'bf 3/22/2005 18:23'!
name
	^name! !

!MCConfiguration methodsFor: 'accessing' stamp: 'bf 3/21/2005 16:32'!
dependencies
	^dependencies ifNil: [dependencies := OrderedCollection new]! !

!MCConfiguration methodsFor: 'private' stamp: 'bf 6/9/2005 11:26'!
diffBaseFor: aDependency
	| wc |
	aDependency package hasWorkingCopy ifFalse: [^nil].
	wc := aDependency package workingCopy.
	wc ancestors ifEmpty: [^nil].
	^wc ancestors first name! !

!MCConfiguration class methodsFor: 'settings' stamp: 'AlainPlantec 12/17/2009 22:58'!
upgradeIsMerge
	^ UpgradeIsMerge ifNil: [UpgradeIsMerge := false]! !

!MCConfiguration class methodsFor: 'converting' stamp: 'bf 3/24/2005 01:51'!
repositoryToArray: aRepository
	^ {aRepository description}! !

!MCConfiguration class methodsFor: 'converting' stamp: 'bf 3/24/2005 01:44'!
dependencyToArray: aDependency
	^ {
		aDependency package name . 
		aDependency versionInfo name . 
		aDependency versionInfo id asString }! !

!MCConfiguration class methodsFor: 'converting' stamp: 'bf 3/24/2005 01:43'!
dependencyFromArray: anArray
	^MCVersionDependency
		package: (MCPackage named: anArray first)
		info: (
			MCVersionInfo
			name: anArray second
			id: (UUID fromString: anArray third)
			message: nil
			date: nil
			time: nil
			author: nil
			ancestors: nil)! !

!MCConfiguration class methodsFor: 'utilities' stamp: 'bf 6/13/2006 15:47'!
whatChangedFrom: oldConfig to: newConfig on: aStream
	"MCConfiguration
		whatChangedFrom:  ReleaseBuilderPloppDeveloper config20060201PloppBeta
		to:  ReleaseBuilderPloppDeveloper config20060215premaster" 

	| oldDeps |
	oldDeps := Dictionary new.
	oldConfig dependencies do: [:old | oldDeps at: old package put: old].

	newConfig dependencies do: [:new | | old |
		old := oldDeps removeKey: new package ifAbsent: [nil].
		old ifNotNil: [old := old versionInfo].
		self changesIn: new package from: old to: new versionInfo on: aStream.
	].

	oldDeps do: [:old |
		self changesIn: old package from: old versionInfo to: nil on: aStream.
	].
! !

!MCConfiguration class methodsFor: 'settings' stamp: 'AlainPlantec 12/17/2009 22:58'!
upgradeIsMerge: aBoolean
	UpgradeIsMerge := aBoolean! !

!MCConfiguration class methodsFor: 'converting' stamp: 'bf 6/9/2005 14:25'!
repositoryFromArray: anArray
	^ MCRepositoryGroup default repositories
		detect: [:repo | repo description = anArray first]
		ifNone: [
			MCHttpRepository
				location: anArray first
				user: ''
				password: '']! !

!MCConfiguration class methodsFor: 'utilities' stamp: 'bf 9/6/2006 19:39'!
changesIn: aPackage from: oldInfo to: newInfo on: aStream
	| printBlock newVersion |
	(newInfo = oldInfo)
		ifTrue: [^self].
	aStream cr; nextPutAll: '----------------- ', aPackage name, ' ------------------'; cr.

	newInfo 
		ifNil: [^aStream cr; nextPutAll: 'REMOVED'; cr].

	oldInfo 
		ifNil: [^aStream cr; nextPutAll: 'ADDED'; cr].

	"get actual version for full ancestry"
	newVersion := MCRepositoryGroup default versionWithInfo: newInfo.

	printBlock := [:ver | 
		aStream cr; 
			nextPutAll: (ver name copyAfterLast: $-);
			nextPutAll:  ' (', (ver date printFormat: #(1 2 0 $. 1 1 2)), ', '.
		ver time print24: true showSeconds: false on: aStream.
		aStream nextPutAll: ')'; cr; 
			nextPutAll: ver message; cr].

	(newVersion info hasAncestor: oldInfo)
		ifTrue: [(newVersion info allAncestorsOnPathTo: oldInfo)
			reverseDo: printBlock].
	newVersion info in: printBlock.
	aStream flush! !

!MCConfiguration class methodsFor: 'instance creation' stamp: 'bf 3/24/2005 01:51'!
fromArray: anArray
	| configuration |
	configuration := self new.
	anArray pairsDo: [:key :value |
		key = #repository
			ifTrue: [configuration repositories add: (self repositoryFromArray: value)].
		key = #dependency
			ifTrue: [configuration dependencies add: (self dependencyFromArray: value)].
	].
	^configuration! !

!MCConfiguration class methodsFor: 'accessing' stamp: 'ar 5/27/2005 17:27'!
defaultLog
	"Answer the default configuration log"
	^DefaultLog! !

!MCConfiguration class methodsFor: 'utilities' stamp: 'bf 6/13/2006 15:46'!
whatChangedFrom: oldConfig to: newConfig
	"MCConfiguration
		whatChangedFrom: ReleaseBuilderPloppDeveloper config20060201PloppBeta
		to:  ReleaseBuilderPloppDeveloper config20060215premaster" 

	self whatChangedFrom: oldConfig to: newConfig on: Transcript.
	Transcript flush.! !

!MCConfiguration class methodsFor: 'accessing' stamp: 'ar 5/27/2005 17:27'!
defaultLog: aStream
	"Set the default configuration log"
	DefaultLog := aStream.! !

!MCConfigurationBrowser commentStamp: 'StephaneDucasse 11/29/2011 22:23'!
A MCConfigurationBrowser displays an MCConfiguration, and edits the configuration to add or remove package dependencies and repository specifications. It allows a configuration to be stored in a repository or posted to an update stream.!
!MCConfigurationBrowser methodsFor: 'description' stamp: 'marcus.denker 11/10/2008 10:04'!
description
	self selectedDependency ifNotNil: [:dep | ^ ('Package: ', dep package name, String cr,
		dep versionInfo summary) asText].
	self selectedRepository ifNotNil: [:repo | ^repo creationTemplate
		ifNotNil: [repo creationTemplate asText]
		ifNil: [repo asCreationTemplate asText addAttribute: TextColor red]].
	^ ''
! !

!MCConfigurationBrowser methodsFor: 'testing' stamp: 'bf 3/23/2005 20:45'!
canRemove
	^self index > 0! !

!MCConfigurationBrowser methodsFor: 'morphic ui' stamp: 'MarcusDenker 12/11/2009 07:39'!
pickConfig
	self pickRepository ifNotNil: [:repo |
		| configs index |
		configs := Cursor wait showWhile: [
			repo allFileNames
				select: [:ea | MCMcmReader canReadFileNamed: ea]
				thenCollect: [:ea | ea copyUpToLast: $.]].
		configs isEmpty ifTrue: [^self inform: 'no configs found in ', repo description].
		configs := configs asSortedCollection: [:a :b |
			(a copyAfterLast: $.) asNumber > (b copyAfterLast: $.) asNumber].
		index := UIManager default chooseFrom: configs title: 'config:' translated.
		index = 0 ifFalse: [^Cursor wait showWhile: [
			repo versionFromFileNamed: (configs at: index), '.', MCMcmReader extension]]].
	^nil! !

!MCConfigurationBrowser methodsFor: 'actions' stamp: 'StephaneDucasse 10/27/2014 09:34'!
installMenu

	| menu |
	menu := UIManager default newMenuIn: self for: self.
	menu add: 'load packages' selector: #load.
	menu add: 'merge packages' selector: #merge.
	menu add: 'upgrade packages' selector: #upgrade.
	menu popUpInWorld.! !

!MCConfigurationBrowser methodsFor: 'testing' stamp: 'bf 3/21/2005 17:15'!
includesPackage: aPackage
	^self dependencies anySatisfy: [:each | each package = aPackage]! !

!MCConfigurationBrowser methodsFor: 'morphic ui' stamp: 'MarcusDenker 5/7/2012 13:17'!
buttonSpecs
	^ #(('Add' addDependency 'Add a dependency')
		('Update' updateMenu 'Update dependencies')
		('Install' installMenu 'Load/Merge/Upgrade into image')
		('Up' up 'Move item up in list' canMoveUp)
		('Down' down 'Move item down in list' canMoveDown)
		('Remove' remove 'Remove item' canRemove)
		('Migrate' migrate 'Migrate all packages to a repository')
		('Store' store 'store configuration')
		)! !

!MCConfigurationBrowser methodsFor: 'dependencies' stamp: 'bf 4/19/2005 17:35'!
checkMissing
	| missing |
	missing := (self dependencies collect: [:ea | ea versionInfo name]) asSet.

	self repositories
		do: [:repo |
			repo allVersionNames
				do: [:found | missing remove: found ifAbsent: []]]
		displayingProgress: 'searching versions'.

	^missing isEmpty or: [
		self selectDependency: missing anyOne.
		self confirm: (String streamContents: [:strm |
			strm nextPutAll: 'No repository found for'; cr.
			missing do: [:r | strm nextPutAll: r; cr].
			strm nextPutAll: 'Do you still want to store?'])]
	! !

!MCConfigurationBrowser methodsFor: 'selection' stamp: 'bf 3/23/2005 17:57'!
repositoryIndex
	^repositoryIndex ifNil: [0]! !

!MCConfigurationBrowser methodsFor: 'description' stamp: 'marcus.denker 11/10/2008 10:04'!
description: aText

	self selectedRepository ifNotNil: [:repo | 
		| new | 
		new := MCRepository readFrom: aText asString.
		(new class = repo class 
			and: [new description = repo description])
				ifTrue: [
					repo creationTemplate: aText asString.
					self changed: #description]
				ifFalse: [
					self inform: 'This does not match the previous definition!!'
				]
	].

! !

!MCConfigurationBrowser methodsFor: 'actions' stamp: 'bf 4/19/2005 17:42'!
merge
	self configuration merge.
	self changed: #dependencyList; changed: #description
! !

!MCConfigurationBrowser methodsFor: 'selection' stamp: 'bf 3/23/2005 20:51'!
list
	self dependencyIndex > 0 ifTrue: [^self dependencies].
	self repositoryIndex > 0 ifTrue: [^self repositories].
	^#()! !

!MCConfigurationBrowser methodsFor: 'actions' stamp: 'marcus.denker 11/10/2008 10:04'!
store
	(self checkRepositories and: [self checkDependencies]) ifFalse: [^self].
	self pickName ifNotNil: [:name |
		self configuration name: name.
		self pickRepository ifNotNil: [:repo |
			repo storeVersion: self configuration]].! !

!MCConfigurationBrowser methodsFor: 'morphic ui' stamp: 'tbn 7/6/2010 17:05'!
dependencyMenu: aMenu
	self fillMenu: aMenu fromSpecs: #(('Change log...' showChangeLog)).
	self fillMenu: aMenu fromSpecs: #(('Add dependency...' addDependency)).
	self selectedDependency ifNotNil: [
		self fillMenu: aMenu fromSpecs: #(('Remove dependency...' remove))].
	^aMenu
! !

!MCConfigurationBrowser methodsFor: 'selection' stamp: 'bf 3/23/2005 21:00'!
updateIndex
	self index > 0 ifTrue: [self index: (self index min: self maxIndex)]! !

!MCConfigurationBrowser methodsFor: 'repositories' stamp: 'bf 3/24/2005 00:45'!
checkRepositories
	| bad |
	bad := self repositories reject: [:repo | repo isKindOf: MCHttpRepository].
	^bad isEmpty or: [
		self selectRepository: bad first.
		self inform: (String streamContents: [:strm |
			strm nextPutAll: 'Please remove these repositories:'; cr.
			bad do: [:r | strm nextPutAll: r description; cr].
			strm nextPutAll: '(only HTTP repositories are supported)']).
		false].
! !

!MCConfigurationBrowser methodsFor: 'selection' stamp: 'bf 3/23/2005 20:52'!
maxIndex
	^ self list size! !

!MCConfigurationBrowser methodsFor: 'actions' stamp: 'StephaneDucasse 10/27/2014 09:34'!
loadMenu

	| menu |
	menu := UIManager default newMenuIn: self for: self.
	menu add: 'update from image' selector: #updateFromImage.
	menu add: 'update from repositories' selector: #updateFromRepositories.
	menu popUpInWorld.
! !

!MCConfigurationBrowser methodsFor: 'selection' stamp: 'bf 5/27/2005 19:55'!
dependencyIndex: anInteger
	dependencyIndex := anInteger.
	dependencyIndex > 0
		ifTrue: [self repositoryIndex: 0].
	self changed: #dependencyIndex; changed: #description.
	self changedButtons.! !

!MCConfigurationBrowser methodsFor: 'dependencies' stamp: 'bf 1/10/2006 17:58'!
dependencyList
	^self dependencies collect: [:dep | 
		Text string: (dep isCurrent
				ifTrue: [dep versionInfo name]
				ifFalse: [':: ', dep versionInfo name])
			attributes: (Array streamContents: [:attr |
				dep isFulfilledByAncestors
					ifFalse: [attr nextPut: TextEmphasis bold]
					ifTrue: [dep isCurrent ifFalse: [attr nextPut: TextEmphasis italic]].
			])]
! !

!MCConfigurationBrowser methodsFor: 'actions' stamp: 'bf 3/23/2005 22:08'!
add
	(self pickWorkingCopiesSatisfying: [:each | (self includesPackage: each package) not])
		do: [:wc |
			wc ancestors isEmpty
				ifTrue: [self inform: 'You must save ', wc packageName, ' first!!
Skipping this package']
				ifFalse: [
					self dependencies add: (MCVersionDependency
						package: wc package
						info: wc ancestors first)]].
	self changed: #dependencyList; changed: #description! !

!MCConfigurationBrowser methodsFor: 'morphic ui' stamp: 'tbn 7/6/2010 17:05'!
repositoryMenu: aMenu
	^self fillMenu: aMenu fromSpecs: #(
		('Add repository...' addRepository)
	)! !

!MCConfigurationBrowser methodsFor: 'actions' stamp: 'MarcusDenker 7/9/2014 15:59'!
down
	self canMoveDown
		ifFalse: [ ^ self ].
	self list swap: self index with: self index + 1.
	self index: self index + 1.
	self changedList! !

!MCConfigurationBrowser methodsFor: 'actions' stamp: 'bf 4/19/2005 17:43'!
upgrade
	self configuration upgrade.
	self changed: #dependencyList; changed: #description
! !

!MCConfigurationBrowser methodsFor: 'morphic ui' stamp: 'bf 3/23/2005 21:11'!
pickRepository
	^self pickRepositorySatisfying: [:ea | true]
! !

!MCConfigurationBrowser methodsFor: 'accessing' stamp: 'bf 3/23/2005 21:15'!
repositories: aCollection
	^self configuration repositories: aCollection
! !

!MCConfigurationBrowser methodsFor: 'actions' stamp: 'MarcusDenker 7/9/2014 15:59'!
remove
	self canRemove
		ifFalse: [ ^ self ].
	self list removeAt: self index.
	self changedList.
	self updateIndex! !

!MCConfigurationBrowser methodsFor: 'selection' stamp: 'bf 5/27/2005 19:54'!
changedButtons
	self changed: #canMoveDown.
	self changed: #canMoveUp.
	self changed: #canRemove.! !

!MCConfigurationBrowser methodsFor: 'selection' stamp: 'bf 3/23/2005 21:00'!
index: anInteger
	self dependencyIndex > 0 ifTrue: [^self dependencyIndex: anInteger].
	self repositoryIndex > 0 ifTrue: [^self repositoryIndex: anInteger].
	anInteger > 0 ifTrue: [self error: 'cannot select']! !

!MCConfigurationBrowser methodsFor: 'repositories' stamp: 'bf 3/24/2005 00:47'!
checkRepositoryTemplates
	"unused for now - we only do HTTP"
	| bad |
	bad := self repositories select: [:repo | repo creationTemplate isNil].
	^bad isEmpty or: [
		self selectRepository: bad first.
		self inform: (String streamContents: [:strm |
			strm nextPutAll: 'Creation template missing for'; cr.
			bad do: [:r | strm nextPutAll: r description; cr].
			strm nextPutAll: 'Please fill in the details first!!']).
		false].
! !

!MCConfigurationBrowser methodsFor: 'morphic ui' stamp: 'DamienCassou 9/29/2009 13:00'!
pickName
	| name |
	name := UIManager default
		request: ('Name' translated, ' (.', self configuration writerClass extension, ' will be appended' translated, '):')
		initialAnswer: (self configuration name ifNil: ['']).
	^ name isEmptyOrNil ifFalse: [name]! !

!MCConfigurationBrowser methodsFor: 'selection' stamp: 'CamilloBruni 8/3/2011 14:50'!
changedList
	self dependencyIndex > 0 ifTrue: [ ^ self changed: #dependencyList ].
	self repositoryIndex > 0 ifTrue: [ ^ self repositoryListChanged ].
	self error: 'nothing selected'! !

!MCConfigurationBrowser methodsFor: 'morphic ui' stamp: 'StephaneDucasse 6/2/2012 20:34'!
pickWorkingCopiesSatisfying: aBlock 
	| copies item |
	copies := (self allManagers select: aBlock)
				asSortedCollection: [:a :b | a packageName <= b packageName].
	item := UIManager default
				chooseFrom: ({'match ...' translated} , (copies
						collect: [:ea | ea packageName]))
				lines: #(1 )
				title: 'Package:' translated. 
	item = 1
		ifTrue: [| pattern | 
			pattern := UIManager default request: 'Packages matching:' translated initialAnswer: '*'.
			^ pattern isEmptyOrNil
				ifTrue: [#()]
				ifFalse: [(pattern includes: $*)
						ifFalse: [pattern := '*' , pattern , '*'].
					copies
						select: [:ea | pattern match: ea packageName]]].
	^ item = 0
		ifTrue: [#()]
		ifFalse: [{copies at: item - 1}]! !

!MCConfigurationBrowser methodsFor: 'repositories' stamp: 'CamilloBruni 8/3/2011 14:49'!
addRepository
	(self pickRepositorySatisfying: [:ea | (self repositories includes: ea) not])
		ifNotNil: [:repo |
			(repo isKindOf: MCHttpRepository)
				ifFalse: [^self inform: 'Only HTTP repositories are supported'].
			self repositories add: repo.
			self repositoryListChanged.
		]! !

!MCConfigurationBrowser methodsFor: 'updating' stamp: 'bf 5/23/2005 17:44'!
updateFromImage
	self configuration updateFromImage.
	self changed: #dependencyList; changed: #description
! !

!MCConfigurationBrowser methodsFor: 'actions' stamp: 'StephaneDucasse 10/27/2014 09:34'!
updateMenu

	| menu |
	menu := UIManager default
				 newMenuIn: self for: self.
	menu add: 'update from image' selector: #updateFromImage.
	menu add: 'update from repositories' selector: #updateFromRepositories.
	menu popUpInWorld.! !

!MCConfigurationBrowser methodsFor: 'dependencies' stamp: 'bf 4/19/2005 17:36'!
checkDependencies
	^self checkModified and: [self checkMissing]! !

!MCConfigurationBrowser methodsFor: 'selection' stamp: 'bf 3/23/2005 23:15'!
selectRepository: aRepository
	self repositoryIndex: (self repositories indexOf: aRepository)! !

!MCConfigurationBrowser methodsFor: 'morphic ui' stamp: 'bf 4/19/2005 16:51'!
defaultExtent
	^ 350@500! !

!MCConfigurationBrowser methodsFor: 'accessing' stamp: 'bf 4/19/2005 16:02'!
dependencies: aCollection
	self configuration dependencies: aCollection.
	self changed: #dependencyList; changed: #description
! !

!MCConfigurationBrowser methodsFor: 'selection' stamp: 'bf 5/27/2005 19:55'!
repositoryIndex: anInteger
	repositoryIndex := anInteger.
	repositoryIndex > 0
		ifTrue: [self dependencyIndex: 0].
	self changed: #repositoryIndex; changed: #description.
	self changedButtons.! !

!MCConfigurationBrowser methodsFor: 'accessing' stamp: 'bf 3/21/2005 14:56'!
configuration: aConfiguration
	configuration := aConfiguration! !

!MCConfigurationBrowser methodsFor: 'repositories' stamp: 'bf 3/23/2005 21:15'!
repositoryList
	^self repositories collect: [:ea | ea description]
! !

!MCConfigurationBrowser methodsFor: 'accessing' stamp: 'bf 3/23/2005 17:41'!
repositories
	^ self configuration repositories! !

!MCConfigurationBrowser methodsFor: 'testing' stamp: 'bf 3/23/2005 20:44'!
canMoveDown
	^self index between: 1 and: self maxIndex - 1 ! !

!MCConfigurationBrowser methodsFor: 'actions' stamp: 'bf 4/19/2005 17:42'!
load
	self configuration load.
	self changed: #dependencyList; changed: #description
! !

!MCConfigurationBrowser methodsFor: 'dependencies' stamp: 'marcus.denker 11/10/2008 10:04'!
selectedPackage
	^ self selectedDependency ifNotNil: [:dep | dep package]! !

!MCConfigurationBrowser methodsFor: 'morphic ui' stamp: 'bf 3/23/2005 22:01'!
widgetSpecs
	^ #(
		((buttonRow) (0 0 1 0) (0 0 0 30))
		((listMorph:selection:menu: dependencyList dependencyIndex dependencyMenu:) (0 0 1 1) (0 30 0 -180))
		((listMorph:selection:menu: repositoryList repositoryIndex repositoryMenu:) (0 1 1 1) (0 -180 0 -120))
		((textMorph: description) (0 1 1 1) (0 -120 0 0))
	 	)! !

!MCConfigurationBrowser methodsFor: 'updating' stamp: 'bf 5/23/2005 17:44'!
updateFromRepositories
	self configuration updateFromRepositories.
	self changed: #dependencyList; changed: #description
! !

!MCConfigurationBrowser methodsFor: 'actions' stamp: 'MarcusDenker 12/11/2009 07:39'!
showChangeLog
	self pickConfig ifNotNil: [:oldConfig |
		Transcript dependents isEmpty
			ifTrue: [Transcript open]
			ifFalse: [Transcript dependents do: [:ea | 
				ea isSystemWindow ifTrue: [ea activate]]].
		Cursor wait showWhile: [
			MCConfiguration whatChangedFrom: oldConfig to: configuration on: Transcript.
			Transcript flush]]! !

!MCConfigurationBrowser methodsFor: 'selection' stamp: 'bf 3/23/2005 20:43'!
index
	^self dependencyIndex max: self repositoryIndex! !

!MCConfigurationBrowser methodsFor: 'dependencies' stamp: 'bf 3/23/2005 22:08'!
addDependency
	(self pickWorkingCopiesSatisfying: [:each | (self includesPackage: each package) not])
		do: [:wc |
			wc ancestors isEmpty
				ifTrue: [self inform: 'You must save ', wc packageName, ' first!!
Skipping this package']
				ifFalse: [
					self dependencies add: (MCVersionDependency
						package: wc package
						info: wc ancestors first)]].
	self changed: #dependencyList; changed: #description! !

!MCConfigurationBrowser methodsFor: 'dependencies' stamp: 'bf 4/19/2005 17:37'!
checkModified
	| modified |
	modified := self dependencies select: [:dep |
		dep isFulfilled and: [dep package workingCopy modified]].
	
	^modified isEmpty or: [
		self selectDependency: modified anyOne.
		self confirm: (String streamContents: [:strm |
			strm nextPutAll: 'These packages are modified:'; cr.
			modified do: [:dep | strm nextPutAll: dep package name; cr].
			strm nextPutAll: 'Do you still want to store?'])]
	! !

!MCConfigurationBrowser methodsFor: 'selection' stamp: 'bf 3/23/2005 23:16'!
selectDependency: aDependency
	self dependencyIndex: (self dependencies indexOf: aDependency)! !

!MCConfigurationBrowser methodsFor: 'selection' stamp: 'bf 3/23/2005 17:56'!
dependencyIndex
	^dependencyIndex ifNil: [0]! !

!MCConfigurationBrowser methodsFor: 'accessing' stamp: 'bf 3/21/2005 16:03'!
configuration
	^configuration ifNil: [configuration := MCConfiguration new]! !

!MCConfigurationBrowser methodsFor: 'actions' stamp: 'MarcusDenker 7/9/2014 15:59'!
up
	self canMoveUp
		ifFalse: [ ^ self ].
	self list swap: self index with: self index - 1.
	self index: self index - 1.
	self changedList! !

!MCConfigurationBrowser methodsFor: 'repositories' stamp: 'bf 3/23/2005 17:58'!
selectedRepository
	^ self repositories at: self repositoryIndex ifAbsent: []! !

!MCConfigurationBrowser methodsFor: 'actions' stamp: 'MarcusDenker 12/11/2009 07:39'!
migrate
	"copy all packageversions in this cofiguration to a repository"
	| versions |
	versions := OrderedCollection new.

	configuration depsSatisfying: [:dep | dep isFulfilledByAncestors not]
		versionDo: [:ver | versions add: ver]
		displayingProgress: 'finding packages'.

	self pickRepository ifNotNil: [:aRepository |
		versions do: [:eachVersion |
			Transcript cr; show: '',aRepository,' storeVersion: ', eachVersion.
			aRepository storeVersion: eachVersion
		]
	]
! !

!MCConfigurationBrowser methodsFor: 'dependencies' stamp: 'bf 3/23/2005 17:56'!
selectedDependency
	^ self dependencies at: self dependencyIndex ifAbsent: []! !

!MCConfigurationBrowser methodsFor: 'morphic ui' stamp: 'alain.plantec 2/6/2009 11:06'!
pickRepositorySatisfying: aBlock
	| index list |
	list := MCRepositoryGroup default repositories select: aBlock.
	index := (UIManager default chooseFrom: (list collect: [:ea | ea description]) title: 'Repository:' translated).
	^ index = 0 ifFalse: [list at: index]! !

!MCConfigurationBrowser methodsFor: 'testing' stamp: 'bf 3/23/2005 20:44'!
canMoveUp
	^self index > 1! !

!MCConfigurationBrowser methodsFor: 'accessing' stamp: 'bf 3/21/2005 16:35'!
dependencies
	^self configuration dependencies
! !

!MCConfigurationBrowser class methodsFor: 'opening' stamp: 'bf 3/21/2005 19:50'!
open
	^self new show! !

!MCCredentialsRequest commentStamp: '<historical>'!
I am used to prompt in a UI indepentent way for a username and a password.
If the user successfully entered the two strings I return an MCServerCredential if not I return nil.!
!MCCredentialsRequest methodsFor: 'accessing' stamp: 'CamilloBruni 4/11/2013 17:36'!
userMessagePrompt
	^ 'Please enter a username for ', self url asString! !

!MCCredentialsRequest methodsFor: 'accessing' stamp: 'CamilloBruni 4/11/2013 17:35'!
url: anObject
	url := anObject! !

!MCCredentialsRequest methodsFor: 'exceptiondescription' stamp: 'CamilloBruni 4/11/2013 17:49'!
defaultAction
	
	username := UIManager default
			request: self userMessagePrompt
			initialAnswer: self username
			title: 'User' translated.
	(username isNil or: [ username isEmpty ])
		ifTrue: [ ^ nil ].
	password := UIManager default
			requestPassword: self passwordMessagePrompt.
	^ MCServerCredentials user: username password: password! !

!MCCredentialsRequest methodsFor: 'accessing' stamp: 'CamilloBruni 4/11/2013 17:48'!
password: anObject
	password := anObject! !

!MCCredentialsRequest methodsFor: 'accessing' stamp: 'CamilloBruni 4/11/2013 17:48'!
username: anObject
	username := anObject! !

!MCCredentialsRequest methodsFor: 'accessing' stamp: 'CamilloBruni 4/11/2013 17:35'!
url
	^ url! !

!MCCredentialsRequest methodsFor: 'accessing' stamp: 'CamilloBruni 4/11/2013 17:48'!
password
	^ password! !

!MCCredentialsRequest methodsFor: 'accessing' stamp: 'CamilloBruni 4/11/2013 17:36'!
passwordMessagePrompt
	^ 'Please enter a password for ', self url asString! !

!MCCredentialsRequest methodsFor: 'accessing' stamp: 'CamilloBruni 4/11/2013 17:48'!
username
	^ username! !

!MCCredentialsRequest class methodsFor: 'signalling' stamp: 'CamilloBruni 4/11/2013 17:49'!
signalUrl: aUrl username: username password: password
	^ self new 
		url: aUrl;
		username: username;
		password: password;
		signal! !

!MCCredentialsRequest class methodsFor: 'signalling' stamp: 'CamilloBruni 4/11/2013 17:35'!
signalUrl: aUrl
	^ self new 
		url: aUrl;
		signal! !

!MCDataStream commentStamp: '<historical>'!
This is the save-to-disk facility. A DataStream can store one or more objects in a persistent form.

To handle objects with sharing and cycles, you must use a
ReferenceStream instead of a DataStream.  (Or SmartRefStream.)  ReferenceStream is typically
faster and produces smaller files because it doesn't repeatedly write the same Symbols.

Here is the way to use DataStream and ReferenceStream:
	rr := ReferenceStream fileNamed: 'test.obj'.
	rr nextPut: <your object>.
	rr close.

To get it back:
	rr := ReferenceStream fileNamed: 'test.obj'.
	<your object> := rr next.
	rr close.

Each object to be stored has two opportunities to control what gets stored.  On the high level, objectToStoreOnDataStream allows you to substitute another object on the way out.  The low level hook is storeDataOn:. The read-in counterparts to these messages are comeFullyUpOnReload and (class) readDataFrom:size:. See these methods for more information about externalizing and internalizing.

NOTE: A DataStream should be treated as a write-stream for writing.  It is a read-stream for reading.  It is not a ReadWriteStream.
!
!MCDataStream methodsFor: 'other' stamp: ''!
byteStream
	^ byteStream! !

!MCDataStream methodsFor: 'other' stamp: 'tk 8/18/1998 08:59'!
setStream: aStream reading: isReading
	"PRIVATE -- Initialization method."

	aStream binary.
	basePos := aStream position.	"Remember where we start.  Earlier part of file contains a class or method file-in.  Allow that to be edited.  We don't deal in absolute file locations."
	byteStream := aStream.! !

!MCDataStream methodsFor: 'write and read' stamp: 'tk 6/8/1998 21:03'!
readString

	| str |
	byteStream ascii.
	str := byteStream nextString.
	byteStream binary.
	^ str
! !

!MCDataStream methodsFor: 'write and read' stamp: ''!
writeFloat: aFloat
	"PRIVATE -- Write the contents of a Float.
	  We support 8-byte Floats here."

	byteStream nextNumber: 4 put: (aFloat at: 1).
	byteStream nextNumber: 4 put: (aFloat at: 2).
! !

!MCDataStream methodsFor: 'write and read' stamp: 'jm 7/31/97 16:16'!
writeRectangle: anObject
    "Write the contents of a Rectangle.  See if it can be a compact Rectangle (type=15).  Rectangles with values outside +/- 2047 were stored as normal objects (type=9).  17:22 tk"

	| ok right bottom top left acc |
	ok := true.
	(right := anObject right) > 2047 ifTrue: [ok := false].
	right < -2048 ifTrue: [ok := false].
	(bottom := anObject bottom) > 2047 ifTrue: [ok := false].
	bottom < -2048 ifTrue: [ok := false].
	(top := anObject top) > 2047 ifTrue: [ok := false].
	top < -2048 ifTrue: [ok := false].
	(left := anObject left) > 2047 ifTrue: [ok := false].
	left < -2048 ifTrue: [ok := false].
	ok := ok & left isInteger & right isInteger & top isInteger & bottom isInteger.

	ok ifFalse: [
		byteStream skip: -1; nextPut: 9; skip: 0. "rewrite type to be normal instance"
	    ^ anObject storeDataOn: self].

	acc := ((left bitAnd: 16rFFF) bitShift: 12) + (top bitAnd: 16rFFF).
	byteStream nextNumber: 3 put: acc.
	acc := ((right bitAnd: 16rFFF) bitShift: 12) + (bottom bitAnd: 16rFFF).
	byteStream nextNumber: 3 put: acc.! !

!MCDataStream methodsFor: 'write and read' stamp: 'lr 3/14/2010 21:13'!
readWordLike
	| refPosn aSymbol newClass anObject |
	"Can be used by any class that is bits and not bytes (WordArray, Bitmap, SoundBuffer, etc)."
	refPosn := self getCurrentReference.
	aSymbol := self next.
	newClass := Smalltalk globals at: aSymbol asSymbol.
	anObject := newClass newFromStream: byteStream.	"Size is number of long words."
	self setCurrentReference: refPosn.	"before returning to next"
	^ anObject! !

!MCDataStream methodsFor: 'write and read' stamp: '6/9/97 08:32 tk'!
readArray
	"PRIVATE -- Read the contents of an Array.
	 We must do beginReference: here after instantiating the Array
	 but before reading its contents, in case the contents reference
	 the Array. beginReference: will be sent again when we return to
	 next, but that's ok as long as we save and restore the current
	 reference position over recursive calls to next."
	| count array refPosn |

	count := byteStream nextNumber: 4.

	refPosn := self beginReference: (array := Array new: count).		"relative pos"
	1 to: count do: [:i |
		array at: i put: self next].
	self setCurrentReference: refPosn.		"relative pos"
	^ array! !

!MCDataStream methodsFor: 'write and read' stamp: ' 
	6/9/97'!
objectAt: anInteger
	"PRIVATE -- Read & return the object at a given stream position.  08:18 tk  anInteger is a relative file position. "
	| savedPosn anObject refPosn |

	savedPosn := byteStream position.	"absolute"
	refPosn := self getCurrentReference.	"relative position"

	byteStream position: anInteger + basePos.	"was relative"
	anObject := self next.

	self setCurrentReference: refPosn.	"relative position"
	byteStream position: savedPosn.		"absolute"
	^ anObject! !

!MCDataStream methodsFor: 'write and read' stamp: ''!
readBitmap
	"PRIVATE -- Read the contents of a Bitmap."

	^ Bitmap newFromStream: byteStream
	"Note that the reader knows that the size is in long words, but the data is in bytes."! !

!MCDataStream methodsFor: 'write and read' stamp: ''!
writeFalse: aFalse
    "PRIVATE -- Write the contents of a False."! !

!MCDataStream methodsFor: 'write and read' stamp: ''!
setCurrentReference: refPosn
    "PRIVATE -- Set currentReference to refPosn.
     Noop here. Cf. ReferenceStream."! !

!MCDataStream methodsFor: 'write and read' stamp: 'tk 6/8/1998 21:23'!
writeStringOld: aString
	"PRIVATE -- Write the contents of a String."

	| length |
	aString size < 16384 
		ifTrue: [
			(length := aString size) < 192
				ifTrue: [byteStream nextPut: length]
				ifFalse: 
					[byteStream nextPut: (length // 256 + 192).
					byteStream nextPut: (length \\ 256)].
			aString do: [:char | byteStream nextPut: char asciiValue]]
		ifFalse: [self writeByteArray: aString].	"takes more space"! !

!MCDataStream methodsFor: 'write and read' stamp: ''!
getCurrentReference
    "PRIVATE -- Return the currentReference posn.
     Overridden by ReferenceStream."

    ^ 0! !

!MCDataStream methodsFor: 'write and read' stamp: ''!
readFloat
	"PRIVATE -- Read the contents of a Float.
	 This is the fast way to read a Float.
	 We support 8-byte Floats here.  Non-IEEE"

	| new |
	new := Float new: 2.		"To get an instance"
	new at: 1 put: (byteStream nextNumber: 4).
	new at: 2 put: (byteStream nextNumber: 4).
	^ new! !

!MCDataStream methodsFor: 'write and read' stamp: 'tk 3/4/1999 22:58'!
readUser
	"Reconstruct both the private class and the instance.  Still used??"

	^ self readInstance.		"Will create new unique class"
! !

!MCDataStream methodsFor: 'write and read' stamp: 'MarianoMartinezPeck 6/5/2012 15:31'!
readClass
	^ self error: 'Classes cannot be materialized with DataStream'! !

!MCDataStream methodsFor: 'write and read' stamp: ''!
readNil
    "PRIVATE -- Read the contents of an UndefinedObject."

    ^ nil! !

!MCDataStream methodsFor: 'write and read' stamp: 'yo 12/3/2004 17:12'!
beginReference: anObject
    "We're starting to read anObject. Remember it and its reference
     position (if we care; ReferenceStream cares). Answer the
     reference position."

    ^ 0! !

!MCDataStream methodsFor: 'other' stamp: ''!
reset
    "Reset the stream."

    byteStream reset! !

!MCDataStream methodsFor: 'other' stamp: ''!
next: anInteger
    "Answer an Array of the next anInteger objects in the stream."
    | array |

    array := Array new: anInteger.
    1 to: anInteger do: [:i |
        array at: i put: self next].
    ^ array! !

!MCDataStream methodsFor: 'write and read' stamp: 'tk 1/24/2000 23:20'!
readWordArray
	"PRIVATE -- Read the contents of a WordArray."

	^ WordArray newFromStream: byteStream
	"Size is number of long words."! !

!MCDataStream methodsFor: 'other' stamp: 'CamilloBruni 8/1/2012 16:05'!
errorWriteReference: anInteger
    "PRIVATE -- Raise an error because this case of nextPut:'s perform:
     shouldn't be called."

    self error: 'This should never be called'! !

!MCDataStream methodsFor: 'write and read' stamp: ''!
writeInstance: anObject
    "PRIVATE -- Write the contents of an arbitrary instance."

    ^ anObject storeDataOn: self! !

!MCDataStream methodsFor: 'write and read' stamp: 'CamilloBruni 8/1/2012 16:18'!
writeUser: anObject
    "Write the contents of an arbitrary User instance (and its devoted class)."

	"If anObject is an instance of a unique user class, will lie and say it has a generic class"
    ^ anObject storeDataOn: self! !

!MCDataStream methodsFor: 'write and read' stamp: 'jm 8/19/1998 17:00'!
readByteArray
	"PRIVATE -- Read the contents of a ByteArray."

	| count |
	count := byteStream nextNumber: 4.
	^ byteStream next: count  "assume stream is in binary mode"
! !

!MCDataStream methodsFor: 'write and read' stamp: 'lr 3/14/2010 21:13'!
readMethod
	"PRIVATE -- Read the contents of an arbitrary instance.
	 ASSUMES: readDataFrom:size: sends me beginReference: after it
	   instantiates the new object but before reading nested objects.
	 NOTE: We must restore the current reference position after
	   recursive calls to next.
	Let the instance, not the class read the data.  "

	| instSize refPosn newClass className xxHeader nLits byteCodeSizePlusTrailer newMethod lits |
	instSize := (byteStream nextNumber: 4) - 1.
	refPosn := self getCurrentReference.
	className := self next.
	newClass := Smalltalk globals at: className asSymbol.
	xxHeader := self next.	"nArgs := (xxHeader >> 24) bitAnd: 16rF."	"nTemps := (xxHeader >> 18) bitAnd: 16r3F."	"largeBit := (xxHeader >> 17) bitAnd: 1."
	nLits := xxHeader >> 9 bitAnd: 16rFF.	"primBits := ((xxHeader >> 19) bitAnd: 16r600) + (xxHeader bitAnd: 16r1FF)."
	byteCodeSizePlusTrailer := instSize - newClass instSize - ((nLits + 1) * 4).	"0"
	newMethod := newClass newMethod: byteCodeSizePlusTrailer header: xxHeader.
	self setCurrentReference: refPosn.	"before readDataFrom:size:"
	self beginReference: newMethod.
	lits := newMethod numLiterals + 1.	"counting header"
	2 to: lits do: [ :ii | newMethod objectAt: ii put: self next ].
	lits * 4 + 1 to: newMethod basicSize do: [ :ii | newMethod basicAt: ii put: byteStream next ].	"Get raw bytes directly from the file"
	self setCurrentReference: refPosn.	"before returning to next"
	^ newMethod! !

!MCDataStream methodsFor: 'other' stamp: 'tk 3/5/2002 09:51'!
nextAndClose
	"Speedy way to grab one object.  Only use when we are inside an object binary file.  Do not use for the start of a SmartRefStream mixed code-and-object file."

	| obj |
	obj := self next.
	self close.
	^ obj! !

!MCDataStream methodsFor: 'write and read' stamp: ''!
writeArray: anArray
	"PRIVATE -- Write the contents of an Array."

	byteStream nextNumber: 4 put: anArray size.
	self nextPutAll: anArray.! !

!MCDataStream methodsFor: 'other' stamp: 'tk 5/29/97'!
rootObject
	"Return the object at the root of the tree we are filing out.  "

	^ topCall! !

!MCDataStream methodsFor: 'write and read' stamp: 'tk 6/8/1998 21:27'!
readStringOld

   ^ byteStream nextStringOld! !

!MCDataStream methodsFor: 'write and read' stamp: 'tk 7/12/1998 13:32'!
readShortRef
	"Read an object reference from two bytes only.  Original object must be in first 65536 bytes of the file.  Relative to start of data.  vacantRef not a possibility."

	^ self objectAt: (byteStream nextNumber: 2)! !

!MCDataStream methodsFor: 'write and read' stamp: 'tk 1/5/2000 11:47'!
readReference
	"Read the contents of an object reference. (Cf. outputReference:)  File is not now positioned at this object."
	| referencePosition |

	^ (referencePosition := (byteStream nextNumber: 4)) = self vacantRef	"relative"
		ifTrue:  [nil]
		ifFalse: [self objectAt: referencePosition]		"relative pos"! !

!MCDataStream methodsFor: 'write and read' stamp: 'tk 6/8/1998 21:06'!
writeByteArray: aByteArray
	"PRIVATE -- Write the contents of a ByteArray."

	byteStream nextNumber: 4 put: aByteArray size.
	"May have to convert types here..."
	byteStream nextPutAll: aByteArray.! !

!MCDataStream methodsFor: 'other' stamp: ''!
close
	"Close the stream."

	| bytes |
	byteStream closed 
		ifFalse: [
			bytes := byteStream position.
			byteStream close]
		ifTrue: [bytes := 'unknown'].
	^ bytes! !

!MCDataStream methodsFor: 'write and read' stamp: ''!
readTrue
    "PRIVATE -- Read the contents of a True."

    ^ true! !

!MCDataStream methodsFor: 'write and read' stamp: 'MarcusDenker 10/5/2013 19:13'!
next
	"Answer the next object in the stream."
	| type selector anObject isARefType internalObject |

	type := byteStream next.
	type ifNil: [
		byteStream close.	"clean up"
		byteStream position = 0 
			ifTrue: [self error: 'The file did not exist in this directory'] 
			ifFalse: [self error: 'Unexpected end of object file'].
		^ nil].
	type = 0 ifTrue: [
		byteStream close.	"clean up"
		self error: 'Expected start of object, but found 0'.
		^ nil].
	isARefType := self noteCurrentReference: type.
	selector := #(readNil readTrue readFalse readInteger	"<-4"
			readStringOld readSymbol readByteArray		"<-7"
			readArray readInstance readReference readBitmap	"<-11"
			readClass readUser readFloat readRectangle readShortInst 	"<-16"
			readString readWordArray foo 	"foo is a replacement for readWordArrayForSegment<-19"
			readWordLike readMethod "<-21") at: type.
	selector = 0 ifTrue: [
			byteStream close. 
			self error: 'file is more recent than this system'. ^ nil].
	anObject := self perform: selector. "A method that recursively
		calls next (readArray, readInstance, objectAt:) must save &
		restore the current reference position."
	isARefType ifTrue: [self beginReference: anObject].

		"After reading the externalObject, internalize it.
		 #readReference is a special case. Either:
		   (1) We actually have to read the object, recursively calling
			   next, which internalizes the object.
		   (2) We just read a reference to an object already read and
			   thus already interalized.
		 Either way, we must not re-internalize the object here."
	selector == #readReference ifTrue: [^ anObject].
	internalObject := anObject comeFullyUpOnReload: self.
	internalObject == String ifTrue:[
		"This is a hack to figure out if we're loading a String class 
		that really should be a ByteString. Note that these days this
		will no longer be necessary since we use #withClassVersion:
		for constructing the global thus using a different classVersion
		will perfectly do the trick."
		((anObject globalObjectName == #String)
			and:[anObject constructorSelector == #yourself]) ifTrue:[
				internalObject := ByteString]].
	^ self maybeBeginReference: internalObject! !

!MCDataStream methodsFor: 'write and read' stamp: 'TestRunner 1/21/2010 21:58'!
writeSymbol: aSymbol
    "PRIVATE -- Write the contents of a Symbol."

    self writeString: aSymbol! !

!MCDataStream methodsFor: 'write and read' stamp: 'yo 12/3/2004 17:25'!
noteCurrentReference: typeID
    "PRIVATE -- If we support references for type typeID, remember
     the current byteStream position so we can add the next object to
     the 'objects' dictionary, and return true. Else return false.
     This method is here to be overridden by ReferenceStream"

    ^ false! !

!MCDataStream methodsFor: 'write and read' stamp: ''!
writeTrue: aTrue
    "PRIVATE -- Write the contents of a True."! !

!MCDataStream methodsFor: 'write and read' stamp: 'tk 6/8/1998 20:57'!
writeString: aString
	"PRIVATE -- Write the contents of a String."

	byteStream nextStringPut: aString.! !

!MCDataStream methodsFor: 'write and read' stamp: ''!
readInteger
    "PRIVATE -- Read the contents of a SmallInteger."

    ^ byteStream nextInt32	"signed!!!!!!"! !

!MCDataStream methodsFor: 'write and read' stamp: '6/9/97 08:14 tk'!
beginInstance: aClass size: anInteger
	"This is for use by storeDataOn: methods.
	 Cf. Object>>storeDataOn:."

		"Addition of 1 seems to make extra work, since readInstance
		has to compensate.  Here for historical reasons dating back
		to Kent Beck's original implementation in late 1988.

		In ReferenceStream, class is just 5 bytes for shared symbol.

		SmartRefStream puts out the names and number of class's instances variables for checking."

	byteStream nextNumber: 4 put: anInteger + 1.

	self nextPut: aClass name! !

!MCDataStream methodsFor: 'write and read' stamp: ''!
nextPutAll: aCollection
    "Write each of the objects in aCollection to the
     receiver stream. Answer aCollection."

    ^ aCollection do: [:each | self nextPut: each]! !

!MCDataStream methodsFor: 'write and read' stamp: 'tk 3/13/98 22:16'!
objectIfBlocked: anObject
	"We don't do any blocking"

	^ anObject! !

!MCDataStream methodsFor: 'write and read' stamp: ' 6/9/97'!
readRectangle
    "Read a compact Rectangle.  Rectangles with values outside +/- 2047 were stored as normal objects (type=9).  They will not come here.  17:22 tk"

	"Encoding is four 12-bit signed numbers.  48 bits in next 6 bytes.  17:24 tk"
	| acc left top right bottom |
	acc := byteStream nextNumber: 3.
	left := acc bitShift: -12.
	(left bitAnd: 16r800) ~= 0 ifTrue: [left := left - 16r1000].	"sign"
	top := acc bitAnd: 16rFFF.
	(top bitAnd: 16r800) ~= 0 ifTrue: [top := top - 16r1000].	"sign"

	acc := byteStream nextNumber: 3.
	right := acc bitShift: -12.
	(right bitAnd: 16r800) ~= 0 ifTrue: [right := right - 16r1000].	"sign"
	bottom := acc bitAnd: 16rFFF.
	(bottom bitAnd: 16r800) ~= 0 ifTrue: [bottom := bottom - 16r1000].	"sign"
	
    ^ Rectangle left: left right: right top: top bottom: bottom
! !

!MCDataStream methodsFor: 'write and read' stamp: 'tk 4/8/1999 13:11'!
maybeBeginReference: internalObject
	"Do nothing.  See ReferenceStream|maybeBeginReference:"

	^ internalObject! !

!MCDataStream methodsFor: 'write and read' stamp: 'TestRunner 1/21/2010 21:44'!
readSymbol
    "PRIVATE -- Read the contents of a Symbol."
    ^ self readString asSymbol! !

!MCDataStream methodsFor: 'other' stamp: 'tk 7/12/1998 13:16'!
vacantRef
	"Answer the magic 32-bit constant we use ***ON DISK*** as a stream 'reference
	 position' to identify a reference that's not yet filled in. This must be a
	 value that won't be used as an ordinary reference. Cf. outputReference: and
	 readReference. -- 
	 NOTE: We could use a different type ID for vacant-refs rather than writing
		object-references with a magic value. (The type ID and value are
		overwritten by ordinary object-references when weak refs are fullfilled.)"

	^ SmallInteger maxVal! !

!MCDataStream methodsFor: 'write and read' stamp: 'tk 6/8/1998 21:07'!
writeBitmap: aBitmap
	"PRIVATE -- Write the contents of a Bitmap."

	aBitmap writeOn: byteStream
	"Note that this calls (byteStream nextPutAll: aBitmap) which knows enough to put 4-byte quantities on the stream!!  Reader must know that size is in long words."! !

!MCDataStream methodsFor: 'other' stamp: ''!
size
    "Answer the stream's size."

    ^ byteStream size! !

!MCDataStream methodsFor: 'write and read' stamp: 'tk 2/20/1999 23:02'!
typeIDFor: anObject
	"Return the typeID for anObject's class.  This is where the tangle of objects is clipped to stop everything from going out.  
	Classes can control their instance variables by defining objectToStoreOnDataStream.
	Any object in blockers is not written out.  See ReferenceStream.objectIfBlocked: and DataStream nextPut:.
	Morphs do not write their owners.  See Morph.storeDataOn:   Each morph tells itself to 'prepareToBeSaved' before writing out."
	
	^ TypeMap at: anObject class ifAbsent: [9 "instance of any normal class"]	
"See DataStream initialize.  nil=1. true=2. false=3. a SmallInteger=4. (a String was 5). a Symbol=6.  a ByteArray=7. an Array=8. other = 9.  a Bitmap=11. a Metaclass=12. a Float=14.  a Rectangle=15. any instance that can have a short header=16.  a String=17 (new format). a WordArray=18."! !

!MCDataStream methodsFor: 'other' stamp: ''!
atEnd
    "Answer true if the stream is at the end."

    ^ byteStream atEnd! !

!MCDataStream methodsFor: 'write and read' stamp: 'MarcusDenker 7/14/2012 01:31'!
nextPut: anObject
	"Write anObject to the receiver stream. Answer anObject."
	| typeID selector objectToStore |

	typeID := self typeIDFor: anObject.
	(self tryToPutReference: anObject typeID: typeID)
		ifTrue: [^ anObject].

	objectToStore := (self objectIfBlocked: anObject).
	objectToStore == anObject ifFalse: [typeID := self typeIDFor: objectToStore].

	byteStream nextPut: typeID.
	selector := #(writeNil: writeTrue: writeFalse: writeInteger: 
		writeStringOld: writeSymbol: writeByteArray:
		writeArray: writeInstance: errorWriteReference: writeBitmap:
		writeClass: writeUser: writeFloat: writeRectangle: == "<-16 short inst" 
		writeString: writeBitmap: writeBitmap: writeWordLike: 
		writeInstance: "CompiledMethod") at: typeID.
	self perform: selector with: objectToStore.

	^ anObject! !

!MCDataStream methodsFor: 'write and read' stamp: 'lr 3/14/2010 21:13'!
readInstance
	"PRIVATE -- Read the contents of an arbitrary instance.
	 ASSUMES: readDataFrom:size: sends me beginReference: after it
	   instantiates the new object but before reading nested objects.
	 NOTE: We must restore the current reference position after
	   recursive calls to next.
	Let the instance, not the class read the data.  "

	| instSize aSymbol refPosn anObject newClass |
	instSize := (byteStream nextNumber: 4) - 1.
	refPosn := self getCurrentReference.
	aSymbol := self next.
	newClass := Smalltalk globals at: aSymbol asSymbol.
	anObject := newClass isVariable
		ifFalse: [ newClass basicNew ]
		ifTrue: [ newClass basicNew: instSize - newClass instSize ].	"Create object here"
	self setCurrentReference: refPosn.	"before readDataFrom:size:"
	anObject := anObject readDataFrom: self size: instSize.
	self setCurrentReference: refPosn.	"before returning to next"
	^ anObject! !

!MCDataStream methodsFor: 'write and read' stamp: ''!
writeInteger: anInteger
	"PRIVATE -- Write the contents of a SmallInteger."

	byteStream nextInt32Put: anInteger	"signed!!!!!!!!!!"! !

!MCDataStream methodsFor: 'write and read' stamp: 'MarianoMartinezPeck 6/5/2012 15:32'!
writeClass: aClass
    ^ self error: 'Classes cannot be serialized with DataStream'! !

!MCDataStream methodsFor: 'write and read' stamp: '6/9/97 08:46 tk'!
outputReference: referencePosn
	"PRIVATE -- Output a reference to the object at integer stream position referencePosn (relative to basePos). To output a weak reference to an object not yet written, supply (self vacantRef) for referencePosn."

	byteStream nextPut: 10. "reference typeID"
	byteStream nextNumber: 4 put: referencePosn	"relative position"! !

!MCDataStream methodsFor: 'write and read' stamp: ''!
readFalse
    "PRIVATE -- Read the contents of a False."

    ^ false! !

!MCDataStream methodsFor: 'other' stamp: '6/9/97 08:03 di'!
setStream: aStream
	"PRIVATE -- Initialization method."

	aStream binary.
	basePos := aStream position.	"Remember where we start.  Earlier part of file contains a class or method file-in.  Allow that to be edited.  We don't deal in absolute file locations."
	byteStream := aStream.! !

!MCDataStream methodsFor: 'write and read' stamp: 'yo 12/3/2004 16:59'!
tryToPutReference: anObject typeID: typeID
    "PRIVATE -- If we support references for type typeID, and if
       anObject already appears in my output stream, then put a
       reference to the place where anObject already appears. If we
       support references for typeID but didn't already put anObject,
       then associate the current stream position with anObject in
       case one wants to nextPut: it again.
     Return true after putting a reference; false if the object still
       needs to be put.
     For DataStream this is trivial. ReferenceStream overrides this."

    ^ false! !

!MCDataStream methodsFor: 'write and read' stamp: 'tk 2/5/2000 21:53'!
writeWordLike: aWordArray
	"Note that we put the class name before the size."

	self nextPut: aWordArray class name.
	aWordArray writeOn: byteStream
	"Note that this calls (byteStream nextPutAll: aBitmap) which knows enough to put 4-byte quantities on the stream!!  Reader must know that size is in long words or double-bytes."! !

!MCDataStream methodsFor: 'write and read' stamp: ''!
writeNil: anUndefinedObject
    "PRIVATE -- Write the contents of an UndefinedObject."! !

!MCDataStream methodsFor: 'other' stamp: 'CamilloBruni 8/1/2012 16:06'!
flush
    "Guarantee that any writes to me are actually recorded on disk."

    ^ byteStream flush! !

!MCDataStream methodsFor: 'other' stamp: 'tk 5/29/97'!
rootObject: anObject
	"Return the object at the root of the tree we are filing out.  "

	topCall := anObject! !

!MCDataStream methodsFor: 'other' stamp: 'nk 3/12/2004 21:56'!
contents
	^byteStream contents! !

!MCDataStream methodsFor: 'write and read' stamp: 'lr 3/14/2010 21:13'!
readShortInst
	"Read the contents of an arbitrary instance that has a short header.
	 ASSUMES: readDataFrom:size: sends me beginReference: after it
	   instantiates the new object but before reading nested objects.
	 NOTE: We must restore the current reference position after
	   recursive calls to next.
	Let the instance, not the class read the data.  "

	| instSize aSymbol refPosn anObject newClass |
	instSize := byteStream next - 1.	"one byte of size"
	refPosn := self getCurrentReference.
	aSymbol := self readShortRef.	"class symbol in two bytes of file pos"
	newClass := Smalltalk globals at: aSymbol asSymbol.
	anObject := newClass isVariable
		ifFalse: [ newClass basicNew ]
		ifTrue: [ newClass basicNew: instSize - newClass instSize ].	"Create object here"
	self setCurrentReference: refPosn.	"before readDataFrom:size:"
	anObject := anObject readDataFrom: self size: instSize.
	self setCurrentReference: refPosn.	"before returning to next"
	^ anObject! !

!MCDataStream class methodsFor: 'instance creation' stamp: 'CarloTeixeira 2/26/2012 00:19'!
fileNamed: fileName do: aBlock
	"Returns the result of aBlock."
	
	^ self detectFile: [ self fileNamed: fileName ] do: aBlock! !

!MCDataStream class methodsFor: 'instance creation' stamp: 'MicheleLanza 10/23/2010 10:36'!
oldFileNamed: aString
	"Here is the way to use DataStream and ReferenceStream:

	|rr |
	rr := ReferenceStream oldFileNamed: 'test.obj'.
	^ rr nextAndClose.
"

	| strm ff |
	ff := FileStream oldFileOrNoneNamed: aString.
	ff ifNil: [^ nil].
	strm := self on: (ff binary).
	^ strm! !

!MCDataStream class methodsFor: 'initialize-release' stamp: 'CamilloBruni 11/5/2013 17:13'!
initialize
	"TypeMap maps Smalltalk classes to type ID numbers which identify the data stream primitive formats.  nextPut: writes these IDs to the data stream.  NOTE: Changing these type ID numbers will invalidate all extant data stream files.  Adding new ones is OK.  
	Classes named here have special formats in the file.  If such a class has a subclass, it will use type 9 and write correctly.  It will just be slow.  (Later write the class name in the special format, then subclasses can use the type also.)
	 See nextPut:, next, typeIDFor:, & ReferenceStream>>isAReferenceType:"

	"MCDataStream initialize"

	| refTypes t |
	refTypes := OrderedCollection new.
	t := TypeMap := WeakKeyDictionary new: 80.	"sparse for fast hashing"
	t at: UndefinedObject put: 1.
	refTypes add: 0.
	t at: True put: 2.
	refTypes add: 0.
	t at: False put: 3.
	refTypes add: 0.
	t at: SmallInteger put: 4.
	refTypes add: 0.
	t at: ByteString put: 5.
	refTypes add: 1.
	t at: ByteSymbol put: 6.
	refTypes add: 1.
	t at: ByteArray put: 7.
	refTypes add: 1.
	t at: Array put: 8.
	refTypes add: 1.	"(type ID 9 is for arbitrary instances of any class, cf. typeIDFor:)"
	refTypes add: 1.	"(type ID 10 is for references, cf. ReferenceStream>>tryToPutReference:)"
	refTypes add: 0.
	t at: Bitmap put: 11.
	refTypes add: 1.
	t at: Metaclass put: 12.
	refTypes add: 0.	"Type ID 13 is used for HyperSqueak User classes that must be reconstructed."
	refTypes add: 1.
	t at: Float put: 14.
	refTypes add: 1.
	t at: Rectangle put: 15.
	refTypes add: 1.	"Allow compact Rects."	"type ID 16 is an instance with short header.  See beginInstance:size:"
	refTypes add: 1.
	self flag: #ByteArray.
	t at: ByteString put: 17.
	refTypes add: 1.	"new String format, 1 or 4 bytes of length"
	t at: WordArray put: 18.
	refTypes add: 1.	"bitmap-like"
	Smalltalk globals
		at: #SoundBuffer
		ifPresent: [ :class | 
			t at: class put: 20. ].
	refTypes add: 1.	"And all other word arrays, both 
		16-bit and 32-bit.  See methods in ArrayedCollection.  Overridden in SoundBuffer."
	t at: CompiledMethod put: 21.
	refTypes add: 1.	"special creation method"	"t at:  put: 22.  refTypes add: 0."
	Smalltalk do: [ :cls | cls isBehavior ifTrue: [ 
							cls isPointers not & cls isVariable & cls isWords
								ifTrue: [ (t includesKey: cls)
										ifFalse: [ t at: cls put: 20 ] ] ] ]! !

!MCDataStream class methodsFor: 'instance creation' stamp: 'di 2/15/98 14:03'!
new
	^ self basicNew! !

!MCDataStream class methodsFor: 'instance creation' stamp: 'MicheleLanza 10/23/2010 10:36'!
fileNamed: aString
	"Here is the way to use DataStream and ReferenceStream:

| rr |
rr := ReferenceStream fileNamed: 'test.obj'.
rr nextPut: 'Zork'.
rr close.
"

	| strm |
	strm := self on: (FileStream fileNamed: aString).		"will be binary"
	strm byteStream setFileTypeToObject.
		"Type and Creator not to be text, so can attach correctly to an email msg"
	^ strm! !

!MCDataStream class methodsFor: 'instance creation' stamp: 'MicheleLanza 10/23/2010 10:39'!
readOnlyFileNamed:  aString
	"Here is the way to use DataStream and ReferenceStream:
	
	|rr|
	rr := ReferenceStream fileNamed: 'test.obj'.
	rr nextPut: 'Zork'.
	rr close.
"

	| strm |
	strm := self on: (FileStream readOnlyFileNamed:   aString).		"will be binary"
	strm byteStream setFileTypeToObject.
		"Type and Creator not to be text, so can attach correctly to an email msg"
	^ strm! !

!MCDataStream class methodsFor: 'instance creation' stamp: 'MicheleLanza 10/23/2010 10:37'!
newFileNamed: aString
	"Here is the way to use DataStream and ReferenceStream:
	|rr|
	rr := ReferenceStream fileNamed: 'test.obj'.
	rr nextPut: 'Zork'.
	rr close.
"

	| strm |
	strm :=  self on: (FileStream newFileNamed: aString).		"will be binary"
	strm byteStream setFileTypeToObject.
		"Type and Creator not to be text, so can attach correctly to an email msg"
	^ strm! !

!MCDataStream class methodsFor: 'instance creation' stamp: 'CarloTeixeira 2/26/2012 00:18'!
detectFile: aBlock do: anotherBlock

	^aBlock value
		ifNil: [nil]
      	ifNotNil: [:file| [anotherBlock value: file] ensure: [file close]]! !

!MCDataStream class methodsFor: 'instance creation' stamp: 'RAA 7/28/2000 08:38'!
streamedRepresentationOf: anObject

	| file |
	file := (RWBinaryOrTextStream on: (ByteArray new: 5000)).
	file binary.
	(self on: file) nextPut: anObject.
	^file contents! !

!MCDataStream class methodsFor: 'instance creation' stamp: 'di 6/24/97 00:18'!
on: aStream
	"Open a new DataStream onto a low-level I/O stream."

	^ self basicNew setStream: aStream
		"aStream binary is in setStream:"
! !

!MCDataStream class methodsFor: 'instance creation' stamp: 'RAA 7/28/2000 08:33'!
unStream: aString

	^(self on: ((RWBinaryOrTextStream with: aString) reset; binary)) next! !

!MCDataStream class methodsFor: 'cleanup' stamp: 'StephaneDucasse 3/9/2010 16:24'!
cleanUp
	"Re-initialize DataStream to avoid hanging onto obsolete classes"

	self initialize! !

!MCDataStreamTest methodsFor: 'testing' stamp: 'MarianoMartinezPeck 6/17/2012 12:37'!
baseStreamType
	^ MCDataStream! !

!MCDefinition commentStamp: '<historical>'!
A MCDefinition is the root of inheritance of entities representing code. !
!MCDefinition methodsFor: 'comparing' stamp: 'damiencassou 11/27/2008 18:15'!
isRevisionOf: aDefinition
	^ (aDefinition isKindOf: MCDefinition) and: [aDefinition description = self description]! !

!MCDefinition methodsFor: 'comparing' stamp: 'ab 7/19/2003 18:14'!
description
	self subclassResponsibility! !

!MCDefinition methodsFor: 'accessing' stamp: 'ab 5/24/2003 14:12'!
requirements
	^ #()! !

!MCDefinition methodsFor: 'testing' stamp: 'ab 12/4/2002 21:51'!
isClassDefinition
	^false! !

!MCDefinition methodsFor: 'installing' stamp: 'avi 2/17/2004 13:19'!
loadOver: aDefinition
	self load
	! !

!MCDefinition methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/21/2013 21:11'!
koDestinationText
	
	^ self source! !

!MCDefinition methodsFor: 'accessing' stamp: 'gvc 12/12/2008 16:18'!
actualClass
	"Since the targetClass call on a patch operation will fail
	otherwise."
	
	^nil! !

!MCDefinition methodsFor: 'accessing' stamp: 'CamilloBruni 9/18/2013 14:21'!
source
	^ self subclassResponsibility.! !

!MCDefinition methodsFor: 'installing' stamp: 'AdrianLienhard 1/21/2010 22:14'!
addMethodAdditionTo: aCollection
	self load! !

!MCDefinition methodsFor: 'printing' stamp: 'ab 7/18/2003 19:43'!
printOn: aStream
	super printOn: aStream.
	aStream nextPutAll: '(', self summary, ')'! !

!MCDefinition methodsFor: 'installing' stamp: 'ab 7/18/2003 21:31'!
load
	! !

!MCDefinition methodsFor: 'accessing' stamp: 'gvc 4/1/2009 12:14'!
fullClassName
	"Answer the className by default."
	
	^self className! !

!MCDefinition methodsFor: 'installing' stamp: 'ab 11/14/2002 00:08'!
unload! !

!MCDefinition methodsFor: 'comparing' stamp: 'ab 7/19/2003 18:25'!
isSameRevisionAs: aDefinition
	^ self = aDefinition! !

!MCDefinition methodsFor: 'annotations' stamp: 'StephaneDucasse 12/30/2012 18:04'!
printAnnotations: requests on: aStream
	"Add a string for an annotation pane, trying to fulfill the browser annotationRequests."

	aStream nextPutAll: 'not yet implemented'! !

!MCDefinition methodsFor: 'accessing' stamp: 'GuillermoPolito 8/21/2014 17:17'!
definition

	^ self! !

!MCDefinition methodsFor: 'accessing' stamp: 'ab 5/24/2003 14:12'!
provisions
	^ #()! !

!MCDefinition methodsFor: 'comparing' stamp: 'ab 7/19/2003 18:14'!
hash
	^ self description hash! !

!MCDefinition methodsFor: 'installing' stamp: 'avi 2/17/2004 13:19'!
postloadOver: aDefinition
	self postload! !

!MCDefinition methodsFor: 'comparing' stamp: 'ab 7/19/2003 18:04'!
sortKey
	self subclassResponsibility ! !

!MCDefinition methodsFor: 'testing' stamp: 'bf 11/12/2004 14:46'!
isClassDefinitionExtension
	"Answer true if this definition extends the regular class definition"
	^false! !

!MCDefinition methodsFor: 'accessing' stamp: 'gvc 4/1/2009 12:11'!
className
	"Answer the class name here or nil if not applicable."
	
	^nil! !

!MCDefinition methodsFor: 'testing' stamp: 'bf 8/12/2009 22:55'!
isScriptDefinition
	^false! !

!MCDefinition methodsFor: 'installing' stamp: 'ab 7/18/2003 19:48'!
postload! !

!MCDefinition methodsFor: 'printing' stamp: 'ab 7/19/2003 18:23'!
summary
	self subclassResponsibility ! !

!MCDefinition methodsFor: 'testing' stamp: 'cwp 7/11/2003 01:32'!
isOrganizationDefinition
	^false! !

!MCDefinition methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/21/2013 21:17'!
koSourceText

	^ self source! !

!MCDefinition methodsFor: 'comparing' stamp: 'nice 10/31/2009 13:08'!
= aDefinition
	^(aDefinition isKindOf: MCDefinition) and: [self isRevisionOf: aDefinition]! !

!MCDefinition methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 12/22/2013 16:28'!
fullTimeStamp
	^ DateAndTime current! !

!MCDefinition methodsFor: 'printing' stamp: 'StephaneDucasse 8/17/2012 16:31'!
summarySuffixOver: previousDefinition
	^self source = previousDefinition source
		ifTrue: [ ' (source same but rev changed)' ]
		ifFalse: [ ' (changed)' ]! !

!MCDefinition methodsFor: 'testing' stamp: 'ab 12/4/2002 21:51'!
isMethodDefinition
	^false! !

!MCDefinition methodsFor: 'accessing' stamp: 'CamilloBruni 9/18/2013 14:21'!
diffSource
	^ self source! !

!MCDefinition methodsFor: 'comparing' stamp: 'ab 7/19/2003 17:59'!
<= other
	^ self sortKey <= other sortKey! !

!MCDefinition class methodsFor: 'cleanup' stamp: 'stephaneducasse 2/4/2006 20:47'!
clearInstances
	WeakArray removeWeakDependent: Instances.
	Instances := nil! !

!MCDefinition class methodsFor: 'instance creation' stamp: 'CamilloBruni 2/22/2014 21:10'!
instanceLike: aDefinition
	Instances ifNil: [ Instances := WeakSet new ].
	InstancesWriteLock ifNil: [ InstancesWriteLock := Semaphore forMutualExclusion ].
	^ (Instances like: aDefinition) 
		ifNil: [
			InstancesWriteLock critical: [ Instances add: aDefinition ]]! !

!MCDefinition class methodsFor: 'cleanup' stamp: 'StephaneDucasse 3/9/2010 16:33'!
cleanUp
	"Flush caches"

	self clearInstances.! !

!MCDefinitionIndex commentStamp: 'LaurentLaffont 3/31/2011 21:06'!
I'm a simple container of MCDefinitions which can be added or removed.!
!MCDefinitionIndex methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 10:02'!
initialize
	super initialize.
	definitions := Dictionary new! !

!MCDefinitionIndex methodsFor: 'accessing' stamp: 'ab 6/2/2003 00:42'!
definitions
	^ definitions values! !

!MCDefinitionIndex methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
definitionLike: aDefinition ifPresent: foundBlock ifAbsent: errorBlock
	| definition |
	definition := definitions at: aDefinition description ifAbsent: [].
	^ definition
		ifNil: errorBlock
		ifNotNil: [foundBlock value: definition]! !

!MCDefinitionIndex methodsFor: 'adding' stamp: 'ab 6/2/2003 00:38'!
addAll: aCollection
	aCollection do: [:ea | self add: ea]! !

!MCDefinitionIndex methodsFor: 'adding' stamp: 'StephaneDucasse 5/6/2010 08:52'!
add: aDefinition
	^ definitions at: aDefinition description put: aDefinition! !

!MCDefinitionIndex methodsFor: 'removing' stamp: 'ab 6/2/2003 00:40'!
remove: aDefinition
	definitions removeKey: aDefinition description ifAbsent: []! !

!MCDefinitionIndex class methodsFor: 'instance-creation' stamp: 'ab 6/2/2003 01:29'!
definitions: aCollection
	^ self new addAll: aCollection! !

!MCDependencySorter commentStamp: '<historical>'!
A MCDependencySorter computes the dependencies to a set of entities.!
!MCDependencySorter methodsFor: 'private' stamp: 'stephaneducasse 2/4/2006 20:47'!
addProvision: anObject
	| newlySatisfied |
	provided add: anObject.
	newlySatisfied := required removeKey: anObject ifAbsent: [#()].
	self addAll: newlySatisfied.! !

!MCDependencySorter methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
itemsWithMissingRequirements
	| items |
	items := Set new.
	required do: [:ea | items addAll: ea].
	^ items
! !

!MCDependencySorter methodsFor: 'building' stamp: 'bf 11/12/2004 14:50'!
addAll: aCollection
	aCollection asArray sort do: [:ea | self add: ea]! !

!MCDependencySorter methodsFor: 'private' stamp: 'ab 5/22/2003 23:24'!
itemsRequiring: anObject
	^ required at: anObject ifAbsentPut: [Set new]! !

!MCDependencySorter methodsFor: 'building' stamp: 'avi 10/7/2004 22:47'!
addExternalProvisions: aCollection
	(aCollection intersection: self externalRequirements)
		do: [:ea | self addProvision: ea]! !

!MCDependencySorter methodsFor: 'private' stamp: 'ab 5/22/2003 23:23'!
addRequirements: aCollection for: anObject
	aCollection do: [:ea | self addRequirement: ea for: anObject]! !

!MCDependencySorter methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 10:02'!
initialize
	super initialize.
	provided := Set new.
	required := Dictionary new.
	orderedItems := OrderedCollection new.! !

!MCDependencySorter methodsFor: 'sorting' stamp: 'ab 5/22/2003 23:25'!
orderedItems
	^ orderedItems! !

!MCDependencySorter methodsFor: 'private' stamp: 'ab 5/22/2003 23:24'!
addRequirement: reqObject for: itemObject
	(self itemsRequiring: reqObject) add: itemObject! !

!MCDependencySorter methodsFor: 'private' stamp: 'ab 5/22/2003 23:15'!
addToOrder: anItem
	orderedItems add: anItem.
	anItem provisions do: [:ea | self addProvision: ea].! !

!MCDependencySorter methodsFor: 'building' stamp: 'StephaneDucasse 5/6/2010 08:52'!
add: anItem
	| requirements |
	requirements := self unresolvedRequirementsFor: anItem.
	requirements isEmpty
		ifTrue: [self addToOrder: anItem]
		ifFalse: [self addRequirements: requirements for: anItem].
	^ anItem! !

!MCDependencySorter methodsFor: 'accessing' stamp: 'dvf 9/8/2004 00:49'!
externalRequirements
	| unloaded providedByUnloaded |
	unloaded := self itemsWithMissingRequirements.
	providedByUnloaded := (unloaded gather: [:e | e provisions]) asSet.
	^ required keys reject: [:ea | providedByUnloaded includes: ea ]! !

!MCDependencySorter methodsFor: 'private' stamp: 'ab 5/22/2003 23:22'!
unresolvedRequirementsFor: anItem
	^ anItem requirements difference: provided! !

!MCDependencySorter class methodsFor: 'instance-creation' stamp: 'ab 5/23/2003 14:17'!
items: aCollection
	^ self new addAll: aCollection! !

!MCDependencySorter class methodsFor: 'public' stamp: 'stephaneducasse 2/4/2006 20:47'!
sortItems: aCollection
	| sorter |
	sorter := self items: aCollection.
	sorter externalRequirements do: [:req  | sorter addProvision: req].
	^ sorter orderedItems.! !

!MCDependencySorterTest methodsFor: 'asserting' stamp: 'avi 10/7/2004 22:32'!
assertItems: anArray orderAs: depOrder withRequired: missingDeps toLoad: unloadableItems
	self assertItems: anArray orderAs: depOrder withRequired: missingDeps  toLoad: unloadableItems  extraProvisions: #()! !

!MCDependencySorterTest methodsFor: 'asserting' stamp: 'stephaneducasse 2/4/2006 20:47'!
assertItems: anArray orderAs: depOrder withRequired: missingDeps toLoad: unloadableItems extraProvisions: provisions
	| order sorter items missing unloadable |
	items := anArray collect: [:ea | self itemWithSpec: ea].
	sorter := MCDependencySorter items: items.
	sorter addExternalProvisions: provisions.
	order := (sorter orderedItems collect: [:ea | ea name]) asArray.
	self assert: order = depOrder.
	missing := sorter externalRequirements.
	self assert: missing asSet = missingDeps asSet.
	unloadable := (sorter itemsWithMissingRequirements collect: [:ea | ea name]) asArray.
	self assert: unloadable asSet = unloadableItems asSet! !

!MCDependencySorterTest methodsFor: 'building' stamp: 'ab 5/24/2003 14:08'!
itemWithSpec: anArray
	^ MCMockDependentItem new
		name: anArray first;
		provides: anArray second;
		requires: anArray third! !

!MCDependencySorterTest methodsFor: 'tests' stamp: 'ab 5/25/2003 01:11'!
testCascadingUnresolved
	self assertItems: #(
		(a (x) (z))
		(b () (x))
		(c () ()))
	orderAs: #(c)
	withRequired: #(z)
	toLoad: #(a b)	! !

!MCDependencySorterTest methodsFor: 'tests' stamp: 'ab 5/25/2003 01:12'!
testSimpleUnresolved
	self assertItems: #(
		(a () (z)))
	orderAs: #()
	withRequired: #(z)
	toLoad: #(a)
		! !

!MCDependencySorterTest methodsFor: 'tests' stamp: 'avi 10/7/2004 22:35'!
testExtraProvisions
	self assertItems:
		#((a (x) (z))
		(b () (x)))
	orderAs: #(a b)
	withRequired: #()
	toLoad: #()	
	extraProvisions: #(x z)! !

!MCDependencySorterTest methodsFor: 'tests' stamp: 'ab 5/25/2003 01:11'!
testSimpleOrdering
	self assertItems: #((a (x) ())
								 (c () (y))
								 (b (y) (x)))
		orderAs: #(a b c)
		withRequired: #()
		toLoad: #()! !

!MCDependencySorterTest methodsFor: 'tests' stamp: 'avi 10/7/2004 22:12'!
testUnusedAlternateProvider
	self assertItems: #(
		(a (x) (z))
		(b () (x))
		(c (x) ()))
	orderAs: #(c b)
	withRequired: #(z)
	toLoad: #(a)	! !

!MCDependencySorterTest methodsFor: 'tests' stamp: 'ab 5/25/2003 01:11'!
testCycle
	self assertItems: #(
		(a (x) (y))
		(b (y) (x)))
	orderAs: #()
	withRequired: #()
	toLoad: #(a b)	! !

!MCDependencySorterTest methodsFor: 'tests' stamp: 'ab 5/25/2003 01:11'!
testMultiRequirementOrdering
	self assertItems: #(
		(a (x) (z))
		(b (y) ())
		(c (z) ())
		(d () (x y z)))
		orderAs: #(b c a d)
		withRequired: #()
		toLoad: #()! !

!MCDependencySorterTest class methodsFor: 'testing' stamp: 'JorgeRessia 3/16/2010 20:26'!
isUnitTest
	^false! !

!MCDependentsWrapper commentStamp: 'TorstenBergmann 2/20/2014 15:53'!
Specialized list item wrapper for dependents!
!MCDependentsWrapper methodsFor: 'comparing' stamp: 'c 8/10/2010 22:15'!
hash
	^ (self item package name hash * 37) + self model hash 
! !

!MCDependentsWrapper methodsFor: 'comparing' stamp: 'c 8/10/2010 22:24'!
= anMCDependentsWrapper

	self class = anMCDependentsWrapper class ifFalse: [^ false].
	^ (self item package name = anMCDependentsWrapper item package name) and: [self model = anMCDependentsWrapper model].
! !

!MCDependentsWrapper methodsFor: 'accessing' stamp: 'ar 2/14/2004 02:31'!
hasContents
	^item requiredPackages isEmpty not! !

!MCDependentsWrapper methodsFor: 'accessing' stamp: 'avi 9/10/2004 17:54'!
contents
	| list workingCopies |
	workingCopies := model unsortedWorkingCopies.
	list := item requiredPackages collect: 
					[:each | 
					workingCopies detect: [:wc | wc package = each] ifNone: [nil]]
				thenSelect: [:x | x notNil].
	^list collect: [:each | self class with: each model: model]! !

!MCDependentsWrapper methodsFor: 'converting' stamp: 'ar 2/14/2004 02:31'!
asString
	^item description! !

!MCDictionaryRepository commentStamp: 'TorstenBergmann 2/5/2014 13:55'!
A dictionary repository (in nemory)!
!MCDictionaryRepository methodsFor: 'accessing' stamp: 'GabrielOmarCotelli 12/3/2013 17:30'!
closestAncestorVersionFor: anAncestry ifNone: errorBlock
	^ anAncestry breadthFirstAncestors
		detect: [ :ea | self includesVersionWithInfo: ea ]
		ifFound: [ :info | self versionWithInfo: info ]
		ifNone: errorBlock! !

!MCDictionaryRepository methodsFor: 'accessing' stamp: 'ab 7/26/2003 02:47'!
description

	^ description ifNil: ['cache']! !

!MCDictionaryRepository methodsFor: '*MonticelloGUI' stamp: 'ar 8/6/2009 18:24'!
morphicOpen: aWorkingCopy
	| names index infos |
	infos := self sortedVersionInfos.
	infos isEmpty ifTrue: [^ self inform: 'No versions'].
	names := infos collect: [:ea | ea name].
	index := UIManager default chooseFrom: names title: 'Open version:'.
	index = 0 ifFalse: [(self versionWithInfo: (infos at: index)) open]! !

!MCDictionaryRepository methodsFor: 'interface' stamp: 'ab 8/16/2003 18:22'!
versionWithInfo: aVersionInfo ifAbsent: errorBlock
	^ dict at: aVersionInfo ifAbsent: errorBlock! !

!MCDictionaryRepository methodsFor: 'testing' stamp: 'ab 8/21/2003 19:49'!
includesVersionWithInfo: aVersionInfo
	^ dict includesKey: aVersionInfo! !

!MCDictionaryRepository methodsFor: '*gofer-core-accessing' stamp: 'TestRunner 12/12/2009 11:12'!
goferReferences
	^ self allVersionInfos collect: [ :each | GoferResolvedReference name: each name repository: self ]! !

!MCDictionaryRepository methodsFor: '*gofer-core-accessing' stamp: 'lr 12/11/2009 22:31'!
goferPriority
	^ 10! !

!MCDictionaryRepository methodsFor: 'accessing' stamp: 'ab 8/20/2003 21:04'!
allVersionInfos
	^ dict values collect: [:ea | ea info]! !

!MCDictionaryRepository methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 10:02'!
initialize

	super initialize.
	dict := Dictionary new.
! !

!MCDictionaryRepository methodsFor: 'accessing' stamp: 'ab 7/26/2003 02:47'!
dictionary

	^ dict! !

!MCDictionaryRepository methodsFor: 'comparing' stamp: 'ab 8/21/2003 12:56'!
= other
	^ self == other! !

!MCDictionaryRepository methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
description: aString

	description := aString ! !

!MCDictionaryRepository methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
dictionary: aDictionary

	dict := aDictionary! !

!MCDictionaryRepository methodsFor: 'storing' stamp: 'avi 8/26/2004 14:20'!
basicStoreVersion: aVersion
	dict at: aVersion info put: aVersion! !

!MCDictionaryRepository methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
sortedVersionInfos
	| sorter |
	sorter := MCVersionSorter new.
	self allVersionInfos do: [:ea | sorter addVersionInfo: ea].
	^ sorter sortedVersionInfos
! !

!MCDictionaryRepository methodsFor: 'interface' stamp: 'ab 7/21/2003 23:39'!
includesVersionNamed: aString
	^ dict anySatisfy: [:ea | ea info name = aString]! !

!MCDictionaryRepository methodsFor: '*gofer-core-accessing' stamp: 'TestRunner 12/13/2009 14:57'!
goferVersionFrom: aVersionReference
	^ self dictionary detect: [ :version | version info name = aVersionReference name ]! !

!MCDictionaryRepository methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
asRepositorySpecFor: aMetacelloMCProject

	| desc |
	desc := self description.
	desc ifNil: [ desc := 'dictionary://Metacello_Dictionary' ].
	^(aMetacelloMCProject repositorySpec)
		description:  desc;
	 	type: 'dictionary';
		yourself! !

!MCDictionaryRepository methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
versionInfoFromVersionNamed: aString

	| versions |
	versions := self dictionary values select: [:version | version info name beginsWith: aString ].
	versions isEmpty ifTrue: [ ^ nil ].
	versions := versions asSortedCollection: [ :a :b |
		([ (a info name copyAfterLast: $.) asNumber ] on: Error do: [:ex | ex return: 0 ]) <= 
			([ (b info name copyAfterLast: $.) asNumber ] on: Error do: [:ex | ex return: 0 ]) ].
	^ versions last info! !

!MCDictionaryRepositoryTest methodsFor: 'utility' stamp: 'ab 7/19/2003 16:06'!
deleteNode: aNode
	dict removeKey: aNode! !

!MCDictionaryRepositoryTest methodsFor: 'actions' stamp: 'ab 8/16/2003 17:53'!
addVersion: aVersion
	dict at: aVersion info put: aVersion! !

!MCDictionaryRepositoryTest methodsFor: 'utility' stamp: 'stephaneducasse 2/4/2006 20:47'!
dictionary
	^ dict ifNil: [dict := Dictionary new]! !

!MCDictionaryRepositoryTest methodsFor: 'running' stamp: 'stephaneducasse 2/4/2006 20:47'!
setUp
	repository :=  MCDictionaryRepository new dictionary: self dictionary! !

!MCDiffyVersion commentStamp: 'TorstenBergmann 2/6/2014 08:08'!
A diffy version!
!MCDiffyVersion methodsFor: 'initialize-release' stamp: 'stephaneducasse 2/4/2006 20:47'!
initializeWithPackage: aPackage info: aVersionInfo dependencies: aCollection baseInfo: baseVersionInfo patch: aPatch
	patch := aPatch.
	base := baseVersionInfo.
	super initializeWithPackage: aPackage info: aVersionInfo snapshot: nil dependencies: aCollection.
! !

!MCDiffyVersion methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
snapshot
	^ snapshot ifNil: [snapshot := MCPatcher apply: patch to: self baseSnapshot]! !

!MCDiffyVersion methodsFor: 'accessing' stamp: 'bf 5/30/2005 17:39'!
fileName
	^ (self class nameForVer: info name base: base name), '.', self writerClass extension! !

!MCDiffyVersion methodsFor: 'accessing' stamp: 'avi 2/13/2004 23:17'!
writerClass
	^ MCMcdWriter ! !

!MCDiffyVersion methodsFor: 'operations' stamp: 'CamilloBrui 7/8/2011 12:28'!
baseSnapshot
       | baseVersion |
       baseVersion := self workingCopy repositoryGroup versionWithInfo: base.
       baseVersion ifNil: [ self error: 'Missing snapshot: ', self baseInfo name].
       ^ baseVersion snapshot! !

!MCDiffyVersion methodsFor: 'accessing' stamp: 'avi 2/13/2004 23:17'!
baseInfo
	^ base! !

!MCDiffyVersion methodsFor: 'accessing' stamp: 'avi 2/13/2004 23:17'!
patch
	^ patch! !

!MCDiffyVersion methodsFor: 'testing' stamp: 'avi 2/13/2004 23:24'!
isDiffy
	^ true! !

!MCDiffyVersion methodsFor: 'accessing' stamp: 'avi 2/19/2004 22:03'!
summary
	^ '(Diff against ', self baseInfo name, ')', String cr, super summary! !

!MCDiffyVersion methodsFor: 'testing' stamp: 'bf 5/23/2005 15:42'!
canOptimizeLoading
	"Answer wether I can provide a patch for the working copy without the usual diff pass"
	^ package hasWorkingCopy
		and: [package workingCopy modified not
			and: [package workingCopy ancestors includes: self baseInfo]]! !

!MCDiffyVersion class methodsFor: 'name utilities' stamp: 'bf 5/30/2005 17:39'!
nameForVer: versionName base: baseName
	| baseId |
	baseId := (versionName copyUpToLast: $.) = (baseName copyUpToLast: $.)
		ifTrue: [baseName copyAfterLast: $.]
		ifFalse: [(versionName copyUpToLast: $-) = (baseName copyUpToLast: $-)
			ifTrue: [baseName copyAfterLast: $-]
			ifFalse: ['@', baseName]].
	^ versionName, '(', baseId, ')'! !

!MCDiffyVersion class methodsFor: 'name utilities' stamp: 'bf 5/30/2005 18:58'!
canonicalNameFor: aFileName
	^(self nameForVer: (self verNameFrom: aFileName)
		base: (self baseNameFrom: aFileName))
			, '.', MCMcdReader extension
! !

!MCDiffyVersion class methodsFor: 'name utilities' stamp: 'bf 5/30/2005 18:19'!
verNameFrom: diffName
	^diffName copyUpTo: $(! !

!MCDiffyVersion class methodsFor: 'instance creation' stamp: 'avi 2/13/2004 23:06'!
package: aPackage info: aVersionInfo snapshot: aSnapshot dependencies: aCollection baseVersion: aVersion
	^ self 
		package: aPackage
		info: aVersionInfo
		dependencies: aCollection
		baseInfo: aVersion info
		patch: (aSnapshot patchRelativeToBase: aVersion snapshot)! !

!MCDiffyVersion class methodsFor: 'instance creation' stamp: 'avi 2/13/2004 23:07'!
package: aPackage info: aVersionInfo dependencies: aCollection baseInfo: baseVersionInfo patch:
aPatch
	^ self basicNew initializeWithPackage: aPackage info: aVersionInfo dependencies: aCollection baseInfo: baseVersionInfo patch:
aPatch! !

!MCDiffyVersion class methodsFor: 'name utilities' stamp: 'bf 5/30/2005 18:45'!
baseNameFrom: diffName
	| baseId verName |
	baseId := (diffName copyAfter: $() copyUpTo: $).
	baseId ifEmpty: [^baseId].
	(baseId beginsWith: '@')
		ifTrue: [^baseId copyAfter: $@].
	verName := self verNameFrom: diffName.
	^(baseId includes: $.)
		ifTrue: [(verName copyUpToLast: $-), '-', baseId]
		ifFalse: [(verName copyUpToLast: $.), '.', baseId]
! !

!MCDirectoryRepository commentStamp: 'TorstenBergmann 2/5/2014 13:55'!
A metacello repository in a directory !
!MCDirectoryRepository methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/17/2015 15:51'!
gtDisplayOn: aStream
	aStream nextPutAll: self description! !

!MCDirectoryRepository methodsFor: 'comparing' stamp: 'CamilloBruni 5/24/2012 09:36'!
hash
	^ directory hash! !

!MCDirectoryRepository methodsFor: 'accessing' stamp: 'CamilloBruni 5/4/2012 19:04'!
description
	^ directory fullName! !

!MCDirectoryRepository methodsFor: 'testing' stamp: 'SeanDeNigris 6/18/2012 15:58'!
includesFileNamed: aString
	"HACK: speed up the cache hits"
	^ (directory / aString) exists.! !

!MCDirectoryRepository methodsFor: '*Komitter-Models' stamp: 'SeanDeNigris 2/9/2014 00:12'!
koRemote
	
	^ KomitDirectoryRemote new
		remote: self;
		yourself! !

!MCDirectoryRepository methodsFor: 'i/o' stamp: 'StephaneDucasse 6/17/2013 14:11'!
writeStreamForFileNamed: aString replace: shouldReplace do: aBlock

	| file |
	file := directory / aString.

	shouldReplace ifTrue: [ file ensureDelete ].

	file writeStreamDo:  [ :stream | 
		aBlock value: stream ].! !

!MCDirectoryRepository methodsFor: 'accessing' stamp: 'ab 7/6/2003 17:49'!
directory
	^ directory! !

!MCDirectoryRepository methodsFor: '*MonticelloGUI' stamp: 'GuillermoPolito 5/3/2013 12:06'!
openAndEditTemplateCopy
	^self class morphicConfigure! !

!MCDirectoryRepository methodsFor: '*gofer-core-accessing' stamp: 'lr 12/11/2009 22:32'!
goferPriority
	^ 5! !

!MCDirectoryRepository methodsFor: 'accessing' stamp: 'CamilloBruni 2/28/2012 20:08'!
allFileNamesForVersionNamed: aString
	"avoid slow default implementation and directly check for existing files"
	|extensions|
	extensions := MCReader concreteSubclasses collect: [ :class| class extension ].
	^ extensions 
		collect: [ :extension| aString , '.', extension ]
		thenSelect: [ :fileName| self includesFileNamed: fileName ]! !

!MCDirectoryRepository methodsFor: 'initialization' stamp: 'CamilloBruni 5/4/2012 21:35'!
initialize
	super initialize.
	directory := FileSystem workingDirectory! !

!MCDirectoryRepository methodsFor: 'interface' stamp: 'StephaneDucasse 6/17/2012 18:51'!
loadAllFileNames
	^ (directory entries sort: [:a :b | a modificationTime >= b modificationTime]) collect: [:ea | ea basename]! !

!MCDirectoryRepository methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
directory: aDirectory
	directory := aDirectory! !

!MCDirectoryRepository methodsFor: 'testing' stamp: 'CamilloBruni 2/28/2012 20:08'!
includesVersionNamed: aString
	"avoid slow default implementation and directly check for existing files"
	^ (self allFileNamesForVersionNamed: aString) isEmpty not! !

!MCDirectoryRepository methodsFor: 'testing' stamp: 'nk 11/2/2003 10:55'!
isValid
	^directory exists! !

!MCDirectoryRepository methodsFor: 'i/o' stamp: 'SeanDeNigris 6/29/2012 15:49'!
readStreamForFileNamed: aString do: aBlock
	| val |
	directory / aString readStreamDo: [ :stream|
		val := aBlock value: stream ].
	^ val! !

!MCDirectoryRepository methodsFor: '*metacello-mc' stamp: 'dkh 02/25/2013 16:13'!
asRepositorySpecFor: aMetacelloMCProject
  ""

  ^ directory asRepositorySpecFor: aMetacelloMCProject! !

!MCDirectoryRepository class methodsFor: 'accessing' stamp: 'ab 7/24/2003 21:20'!
description
	^ 'directory'! !

!MCDirectoryRepository class methodsFor: 'accessing' stamp: 'SeanDeNigris 4/21/2010 14:38'!
defaultDirectoryName: aDirectoryName
	DefaultDirectoryName := aDirectoryName.! !

!MCDirectoryRepository class methodsFor: 'instance creation' stamp: 'SeanDeNigris 7/12/2012 08:45'!
morphicConfigure
	^ (UIManager default chooseDirectoryFrom: self defaultDirectoryName asFileReference) ifNotNil:
		[:directory |
		self new directory: directory]! !

!MCDirectoryRepository class methodsFor: 'accessing' stamp: 'CamilloBruni 5/4/2012 21:35'!
defaultDirectoryName
	^ DefaultDirectoryName ifNil: [
		DefaultDirectoryName :=  FileSystem workingDirectory fullName].! !

!MCDirectoryRepositoryTest methodsFor: 'actions' stamp: 'GuillermoPolito 7/3/2012 10:25'!
addVersion: aVersion
	| file |
	file := (directory / aVersion fileName) asFileReference writeStream.
	aVersion fileOutOn: file.
	file close.! !

!MCDirectoryRepositoryTest methodsFor: 'accessing' stamp: 'S 6/17/2013 13:26'!
directory
	directory ifNil:
		[directory := 'mctest' asFileReference.
		directory ensureCreateDirectory].
	^ directory! !

!MCDirectoryRepositoryTest methodsFor: 'running' stamp: 'CamilloBruni 7/6/2012 16:08'!
tearDown
	self directory deleteAll.
	! !

!MCDirectoryRepositoryTest methodsFor: 'running' stamp: 'stephaneducasse 2/4/2006 20:47'!
setUp
	repository := MCDirectoryRepository new directory: self directory! !

!MCDoItParser commentStamp: '<historical>'!
A MCDoItParser is a simple 'parser' which understand the addDefinitionsTo: message. Each parser can use the source
and add definitions to the list of entities that is passed to them.

MCDoitParser invokes automatically its subclasses to parse the correct source.

Each Doit entities (entities which are defined as doits) extend this entry point to add specific behavior.!
!MCDoItParser methodsFor: 'accessing' stamp: 'avi 3/10/2004 12:40'!
source
	^ source! !

!MCDoItParser methodsFor: 'actions' stamp: 'avi 3/10/2004 12:40'!
addDefinitionsTo: aCollection
	self subclassResponsibility ! !

!MCDoItParser methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
source: aString
	source := aString! !

!MCDoItParser class methodsFor: 'factory identification hook' stamp: 'StephaneDucasse 12/30/2012 18:01'!
pattern
	"return a pattern matching expression to identify the parser corresponding to the expression.
	Subclasses should specialize it."

	^ nil! !

!MCDoItParser class methodsFor: 'instance creation' stamp: 'marcus.denker 11/10/2008 10:04'!
forDoit: aString
	^ (self subclassForDoit: aString) ifNotNil: [:c | c new source: aString]! !

!MCDoItParser class methodsFor: 'testing' stamp: 'avi 3/10/2004 12:51'!
isAbstract
	^ self pattern isNil! !

!MCDoItParser class methodsFor: 'instance creation' stamp: 'avi 3/10/2004 12:30'!
subclassForDoit: aString
	^ self concreteSubclasses detect: [:ea | ea pattern match: aString] ifNone: []! !

!MCDoItParser class methodsFor: 'private' stamp: 'avi 3/10/2004 12:29'!
concreteSubclasses
	^ self allSubclasses reject: [:c | c isAbstract]! !

!MCFileBasedRepository commentStamp: 'TorstenBergmann 2/5/2014 13:55'!
A file based metacello repository!
!MCFileBasedRepository methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
cache
	^ cache ifNil: [cache := Dictionary new]! !

!MCFileBasedRepository methodsFor: 'accessing' stamp: 'ab 8/21/2003 20:01'!
allFileNamesForVersionNamed: aString
	^ self filterFileNames: self readableFileNames forVersionNamed: aString! !

!MCFileBasedRepository methodsFor: 'accessing' stamp: 'avi 9/17/2005 18:37'!
versionInfoFromFileNamed: aString
	self cache at: aString ifPresent: [:v | ^ v info].
	^ self loadVersionInfoFromFileNamed: aString! !

!MCFileBasedRepository methodsFor: 'interface' stamp: 'CamilloBruni 3/2/2012 13:03'!
loadAllFileNames
	self subclassResponsibility! !

!MCFileBasedRepository methodsFor: 'adding' stamp: 'ChristopheDemarey 8/22/2013 15:26'!
addVersionInformationExtractedFrom: readableFileName to: versions
	| name |
	name := (readableFileName copyUpToLast: $.) copyUpTo: $(.
	name last isDigit
		ifTrue: [ 
			versions
				add:
					{(name copyUpToLast: $-).	"pkg name"
					((name copyAfterLast: $-) copyUpTo: $.).	"user"
					(((name copyAfterLast: $-) copyAfter: $.) asInteger ifNil: [ 0 ]).	"version"
					readableFileName }]! !

!MCFileBasedRepository methodsFor: 'testing' stamp: 'stephaneducasse 2/4/2006 20:47'!
canReadFileNamed: aString
	| reader |
	reader := MCVersionReader readerClassForFileNamed: aString.
	^ reader notNil! !

!MCFileBasedRepository methodsFor: 'accessing' stamp: 'CamilloBruni 11/6/2013 21:55'!
allFileNamesOrCache
	cacheFileNames == true ifFalse: [ ^ self allFileNames ].
	^ allFileNames ifNil: [
			allFileNames := self allFileNames]! !

!MCFileBasedRepository methodsFor: 'storing' stamp: 'stephaneducasse 2/4/2006 20:47'!
basicStoreVersion: aVersion
	self
		writeStreamForFileNamed: aVersion fileName
		do: [:s | aVersion fileOutOn: s].
	aVersion isCacheable ifTrue: [
		cache ifNil: [cache := Dictionary new].
		cache at: aVersion fileName put: aVersion].
! !

!MCFileBasedRepository methodsFor: 'accessing' stamp: 'bf 5/30/2005 22:52'!
versionNameFromFileName: aString
	^ (aString copyUpToLast: $.) copyUpTo: $(! !

!MCFileBasedRepository methodsFor: 'storing' stamp: 'avi 10/31/2003 14:32'!
writeStreamForFileNamed: aString do: aBlock
	^ self writeStreamForFileNamed: aString replace: false do: aBlock! !

!MCFileBasedRepository methodsFor: 'testing' stamp: 'ab 8/21/2003 00:36'!
includesVersionNamed: aString
	^ self allVersionNames includes: aString! !

!MCFileBasedRepository methodsFor: 'accessing' stamp: 'ab 8/21/2003 00:40'!
allVersionNames
	^ self readableFileNames collect: [:ea | self versionNameFromFileName: ea]! !

!MCFileBasedRepository methodsFor: 'notifying' stamp: 'CamilloBruni 1/26/2012 19:50'!
notifyList
	(self includesFileNamed: 'notify') ifFalse: [^ #()].
	^ self readStreamForFileNamed: 'notify' do:
		[:s | s upToEnd  lines]! !

!MCFileBasedRepository methodsFor: 'private' stamp: 'SeanDeNigris 7/17/2012 15:50'!
loadVersionFromFileNamed: aString

	(MCCacheRepository uniqueInstance includesFileNamed: aString)
		ifTrue: [ ^ MCCacheRepository uniqueInstance loadVersionFromFileNamed: aString].
	
	^ self versionReaderForFileNamed: aString do: [:r | r version]! !

!MCFileBasedRepository methodsFor: 'caching' stamp: 'bf 6/9/2005 15:47'!
cachedFileNames
	^cache == nil
		ifTrue: [#()]
		ifFalse: [cache keys]! !

!MCFileBasedRepository methodsFor: 'caching' stamp: 'CamilloBruni 4/20/2012 18:14'!
maxCacheSize
	^ 512! !

!MCFileBasedRepository methodsFor: 'accessing' stamp: 'avi 9/17/2005 16:40'!
closestAncestorVersionFor: anAncestry ifNone: errorBlock
	^ self cacheAllFileNamesDuring:
		[super closestAncestorVersionFor: anAncestry ifNone: errorBlock]! !

!MCFileBasedRepository methodsFor: 'loading' stamp: 'avi 9/17/2005 18:37'!
loadVersionInfoFromFileNamed: aString
	^ self versionReaderForFileNamed: aString do: [:r | r info]
	! !

!MCFileBasedRepository methodsFor: 'testing' stamp: 'CamilloBruni 1/26/2012 19:49'!
includesFileNamed: aString
	"slow default implementation"
	^ self allFileNames includes: aString! !

!MCFileBasedRepository methodsFor: 'accessing' stamp: 'SebastianTleye 7/3/2014 10:32'!
readableFileNames
	| all cached new emptyFilenamelength |
	"<hyphenated-package-name>.<dotted.branch.tag>-<initials>.<count>.mcz"
	emptyFilenamelength := 'P-i.c.mcz' size.
	all := self allFileNames.	"from repository"
		
	all := all reject: [ :each |  each size < emptyFilenamelength].
		"first stupid way to filter first level broken files. Ideally we should 
		remove any files not following the naming pattern: PackageName-author.number[(branch)].mcz"
	
	"Another stupid way to remove filename when using filetree repositories."
	all := all reject: [ :each | each beginsWith: '.filetree' ].
	
	cached := self cachedFileNames.	"in memory"
	new := all difference: cached.
	^ (cached asArray, new)
		select: [:ea | self canReadFileNamed: ea]! !

!MCFileBasedRepository methodsFor: '*MonticelloGUI' stamp: 'avi 2/28/2004 18:32'!
morphicOpen: aWorkingCopy
	(MCFileRepositoryInspector repository: self workingCopy: aWorkingCopy)
		show! !

!MCFileBasedRepository methodsFor: 'interface' stamp: 'SeanDeNigris 7/17/2012 15:40'!
versionWithInfo: aVersionInfo ifAbsent: errorBlock
	"get a version for the given versionInfo. always query first the packageCache and only then try to load the version from the remote location"
	^ MCCacheRepository uniqueInstance
		versionWithInfo: aVersionInfo 
		ifAbsent: [
			(self allFileNamesForVersionNamed: aVersionInfo name) do:
				[:fileName | | version |
				version := self versionFromFileNamed: fileName.
				version info = aVersionInfo ifTrue: [^ version]].
			^ errorBlock value].! !

!MCFileBasedRepository methodsFor: 'caching' stamp: 'CamilloBruni 3/2/2012 13:01'!
cacheAllFileNamesDuring: aBlock
	cacheFileNames == true ifTrue: [ ^ aBlock value ].
	allFileNames := nil.
	cacheFileNames := true.	
	^ aBlock ensure: [
		allFileNames := nil.
		cacheFileNames := false]! !

!MCFileBasedRepository methodsFor: 'accessing' stamp: 'bf 3/11/2005 18:01'!
possiblyNewerVersionsOfAnyOf: someVersions
	| pkgs |
	pkgs := Dictionary new.

	someVersions do: [:aVersionInfo |
		pkgs at: (aVersionInfo name copyUpToLast: $-)
			put: (aVersionInfo name copyAfterLast: $.) asNumber].

	^[self allVersionNames select: [:each |
		(pkgs at: (each copyUpToLast: $-) ifPresent: [:verNumber |
			verNumber < (each copyAfterLast: $.) asNumber
				or: [verNumber = (each copyAfterLast: $.) asNumber
					and: [someVersions noneSatisfy: [:v | v name = each]]]]) == true]
	] on: Error do: [:ex | ex return: #()]! !

!MCFileBasedRepository methodsFor: 'caching' stamp: 'avi 9/18/2005 22:43'!
resizeCache: aDictionary
	[aDictionary size <= self maxCacheSize] whileFalse:
		[aDictionary removeKey: aDictionary keys atRandom]! !

!MCFileBasedRepository methodsFor: '*monticellofiletree-core' stamp: 'dkh 4/5/2012 11:15:15'!
packageDescriptionsFromReadableFileNames
	^ self readableFileNames
		collect: [ :each | 
			| name |
			name := (each copyUpToLast: $.) copyUpTo: $(.
			name last isDigit
				ifFalse: [ 
					{name.
					''.
					''.
					each} ]
				ifTrue: [ 
					| packageName author versionNumber |
					packageName := name copyUpToLast: $-.
					author := (name copyAfterLast: $-) copyUpTo: $..
					versionNumber := ((name copyAfterLast: $-) copyAfter: $.) asInteger ifNil: [ 0 ].
					{packageName.
					author.
					versionNumber.
					each} ] ]! !

!MCFileBasedRepository methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 1/8/2014 14:42'!
location
	^ self description! !

!MCFileBasedRepository methodsFor: 'actions' stamp: 'marcus.denker 11/10/2008 10:04'!
versionReaderForFileNamed: aString do: aBlock
	^ self
		readStreamForFileNamed: aString
		do: [:s |
			(MCVersionReader readerClassForFileNamed: aString) ifNotNil:
				[:class | aBlock value: (class on: s fileName: aString)]]
! !

!MCFileBasedRepository methodsFor: '*gofer-core-accessing' stamp: 'SeanDeNigris 8/29/2012 09:38'!
goferReferences
	| versionNames |
	versionNames := [ self allVersionNames ]
		on: MCRepositoryError
		do: [ :error | ^ GoferRepositoryError signal: error messageText repository: self ].
	^ versionNames collect: [ :each | GoferResolvedReference name: each repository: self ]! !

!MCFileBasedRepository methodsFor: '*monticellofiletree-core' stamp: 'dkh 4/5/2012 11:15:15'!
retrieveVersionsWithPackageNames: packageNames
	| packageDescriptions |
	packageDescriptions := self packageDescriptionsFromReadableFileNames.
	packageNames addAll: (packageDescriptions collect: [ :packageDescription | packageDescription first ]).
	^ packageDescriptions select: [ :each | (each at: 3) isNumber ]! !

!MCFileBasedRepository methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
versionInfoFromVersionNamed: aString

	| versions |
	versions := self allVersionNames
		select: [ :each | each beginsWith: aString ].
	versions isEmpty ifTrue: [ ^ nil ].
	versions := versions asSortedCollection: [ :a :b |
		([ (a copyAfterLast: $.) asNumber ] on: Error do: [:ex | ex return: 0 ]) <= 
			([ (b copyAfterLast: $.) asNumber ] on: Error do: [:ex | ex return: 0 ]) ].
	^ self versionInfoFromFileNamed: versions last , '.mcz'
! !

!MCFileBasedRepository methodsFor: 'private' stamp: 'stephaneducasse 2/4/2006 20:47'!
flushCache
	cache := nil! !

!MCFileBasedRepository methodsFor: 'accessing' stamp: 'ChristopheDemarey 8/22/2013 15:24'!
versionsWithPackageNames
	| versions |
	versions := OrderedCollection new.
	self readableFileNames
		do: [ :each | 
		      self addVersionInformationExtractedFrom: each to: versions ].
	^ versions! !

!MCFileBasedRepository methodsFor: 'accessing' stamp: 'ab 8/21/2003 20:01'!
filterFileNames: aCollection forVersionNamed: aString
	^ aCollection select: [:ea | (self versionNameFromFileName: ea) = aString] ! !

!MCFileBasedRepository methodsFor: '*gofer-core-accessing' stamp: 'lr 12/12/2009 11:29'!
goferVersionFrom: aVersionReference
	^ self loadVersionFromFileNamed: aVersionReference name , '.mcz'! !

!MCFileBasedRepository methodsFor: 'accessing' stamp: 'CamilloBruni 4/20/2012 17:57'!
allFileNames
	cacheFileNames == true ifFalse: [ ^ self loadAllFileNames ].
	^ allFileNames ifNil: [
			allFileNames := self loadAllFileNames]! !

!MCFileBasedRepository methodsFor: 'accessing' stamp: 'CamilloBruni 4/21/2012 18:01'!
versionFromFileNamed: aString
	| v |
	v := self cache
			 at: aString 
			 ifAbsent: [ self loadVersionFromFileNamed: aString ].
	self resizeCache: cache.
	(v notNil and: [v isCacheable]) ifTrue: [cache at: aString put: v].
	^ v! !

!MCFileBasedRepository methodsFor: 'storing' stamp: 'SeanDeNigris 2/26/2015 14:11'!
storeVersion: aVersion

	(self includesFileNamed: aVersion fileName) ifTrue: [ ^ self ].
	^ super storeVersion: aVersion.! !

!MCFileBasedRepository class methodsFor: 'cleanup' stamp: 'StephaneDucasse 3/9/2010 16:33'!
cleanUp
	"Flush caches"

	self flushAllCaches.! !

!MCFileBasedRepository class methodsFor: 'settings' stamp: 'StephaneDucasse 11/11/2014 18:42'!
monticelloSettingsOn: aBuilder  
	<systemsettings>  
	(aBuilder group: #monticello)
		label: 'Monticello';
		description: 'All Monticello settings';
		with: [ 
			(aBuilder setting: #defaultDirectoryName)
				type: #Directory;
				target: MCDirectoryRepository;
				description: 'The path of a directory where you want to start out when choosing local repository locations' ;
				label: 'Default local repository directory'.
			(aBuilder setting: #cacheDirectory)
				type: #Directory;
				target: MCCacheRepository;
				description: 'The path of the local repository cache';
				label: 'Local cache directory'.	
				
				].! !

!MCFileBasedRepository class methodsFor: 'actions' stamp: 'avi 2/3/2005 00:43'!
flushAllCaches
	self allSubInstancesDo: [:ea | ea flushCache]! !

!MCFileInTest methodsFor: 'testing' stamp: 'cwp 8/10/2003 02:08'!
alterInitialState
	self mockClassA touchCVar! !

!MCFileInTest methodsFor: 'testing' stamp: 'stephaneducasse 2/4/2006 20:47'!
assertInitializersCalled
	| cvar |
	cvar := self mockClassA cVar.
	self assert: cvar = #initialized! !

!MCFileInTest methodsFor: 'testing' stamp: 'pavel.krivanek 10/14/2010 15:41'!
assertSuccessfulLoadWith: aBlock
	stream reset.
	aBlock value.
	self assertNoChange.
	self assertInitializersCalled.
	self assertInitializersOrder! !

!MCFileInTest methodsFor: 'running' stamp: 'MarianoMartinezPeck 6/17/2012 12:37'!
tearDown
	(diff isNil or: [diff isEmpty not])
		 ifTrue: [expected updatePackage: self mockPackage].
	MCDataStream initialize! !

!MCFileInTest methodsFor: 'testing' stamp: 'avi 2/17/2004 03:21'!
assertFileOutFrom: writerClass canBeFiledInWith: aBlock
	(writerClass on: stream) writeSnapshot: self mockSnapshot.
	self alterInitialState.
	self assertSuccessfulLoadWith: aBlock.
	self mockPackage unload.
	self assertSuccessfulLoadWith: aBlock.
! !

!MCFileInTest methodsFor: 'asserting' stamp: 'stephaneducasse 2/4/2006 20:47'!
assertNoChange
	| actual |
	actual := MCSnapshotResource takeSnapshot.
	diff := actual patchRelativeToBase: expected.
	self assert: diff isEmpty! !

!MCFileInTest methodsFor: 'testing' stamp: 'GuillermoPolito 8/24/2012 15:06'!
testStWriter
	"self debug: #testStWriter"
	self
		assertFileOutFrom: MCStWriter
		canBeFiledInWith: [ CodeImporter evaluateReadStream: stream readStream].
! !

!MCFileInTest methodsFor: 'testing' stamp: 'pavel.krivanek 10/14/2010 15:40'!
assertInitializersOrder

	| initializationOrder |
	initializationOrder := self mockClassA initializationOrder.
	self assert: initializationOrder = 2.	
! !

!MCFileInTest methodsFor: 'running' stamp: 'stephaneducasse 2/4/2006 20:47'!
setUp
	expected := self mockSnapshot.
	stream := RWBinaryOrTextStream on: String new.! !

!MCFileRepositoryInspector commentStamp: 'LaurentLaffont 2/5/2011 17:35'!
I'm a monticello tool composed of three panes to browse repositories and the packages they contain. You get an instance of me when you click on a repository in Monticello browser and press open. 

My left pane presents the packages, my right one their versions and the bottom one the commit log of the selected package versions.

I underline the packages you already loaded, and highlight the ones you don't have updated to the last version. I also highlight the versions you did not load yet.

Example: I can browse packages of PharoInbox with:
(MCFileRepositoryInspector 
	repository: (MCHttpRepository
					location: 'http://www.squeaksource.com/PharoInbox'
					user: ''
					password: '')
	workingCopy: nil) show.
	
COTDC - S.Ducasse, G.Polito, L.Laffont!
!MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'EstebanLorenzano 4/10/2015 16:51'!
versionHighlightEmphasis: aString
	"Appearence. This code attempts to show the following:
		- a currently loaded version of the package: underlined.
		- a version of a not loaded package: bold.
		- a newer version of a loaded package: bold.
		- a version not in the ancestry of the currently loaded and
		selected package: bold.
	All those tests are made on the version name and number, not the package
	UUID, so they are not reliable. The least reliable test is the 'newer' check.
	"

	| versionName packageName |
	versionName := (aString copyUpToLast: $.) copyUpTo: $(.
	packageName := versionName copyUpToLast: $-.
	(packageName includes: $.) ifTrue: [ packageName := packageName copyUpTo: $. ].
	
	(loaded includes: versionName) ifTrue: [ ^ TextEmphasis underlined ].
	selectedPackage = packageName ifTrue: [ 
		self selectedPackageAncestors
			ifNotNil: [ 
				(selectedPackageAncestors includes: versionName)
					ifTrue: [ ^ TextEmphasis normal ]
					ifFalse: [ ^ TextEmphasis bold ] ] ].
	(newer includes: aString) ifTrue: [ ^ TextEmphasis bold ].
	(loadedPackages includes: packageName) ifFalse: [ ^ TextEmphasis bold ].
	^ TextEmphasis normal! !

!MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'lr 9/26/2003 20:18'!
versionSelection
	^self versionList indexOf: selectedVersion! !

!MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'stephaneducasse 2/4/2006 20:47'!
versionInfo
	^ versionInfo ifNil: [versionInfo := repository versionInfoFromFileNamed: selectedVersion]! !

!MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'ThierryGoubier 4/1/2015 14:13'!
packageSelection: aNumber
	"Track a package change to have the ancestors list loaded."

	"selectedPackage is the selected package name :("

	selectedPackage := aNumber isZero
		ifFalse: [ (self packageList at: aNumber) asString ].
	selectedPackageAncestors := nil.
	self versionSelection: 0.
	self
		changed: #packageSelection;
		changed: #versionList! !

!MCFileRepositoryInspector methodsFor: 'accessing' stamp: 'ThierryGoubier 4/1/2015 14:13'!
selectedPackageAncestors
	selectedPackageAncestors
		ifNil: [ 
			selectedPackage
				ifNotNil: [ 
					(MCWorkingCopy registry at: (MCPackage named: selectedPackage) ifAbsent: [  ])
						ifNotNil: [ :aWorkingCopy | selectedPackageAncestors := aWorkingCopy allAncestors collect: #name ] ] ].
	^ selectedPackageAncestors! !

!MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'stephaneducasse 2/4/2006 20:47'!
versionSelection: aNumber
	aNumber isZero 
		ifTrue: [ selectedVersion := version := versionInfo := nil ]
		ifFalse: [ 
			selectedVersion := (self versionList at: aNumber) asString.
			version := versionInfo := nil].
	self changed: #versionSelection; changed: #summary; changed: #hasVersion! !

!MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'Lr 12/9/2010 17:25'!
defaultExtent
	^ 640 @ 480! !

!MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'BenComan 4/7/2014 23:19'!
packageSearchAccept: string
	| aString |

	aString := string ifNil: [ '' ].
	packagePattern = aString asLowercase ifTrue: [ ^ self ].
	packagePattern :=  aString asLowercase.

   	self packageListUpdate.! !

!MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'CamilloBruni 3/13/2012 18:42'!
packageSearchField
	^ SearchMorph new
		model: self;
		setIndexSelector: #packageSearchAccept:;
		updateSelector: #packageSearchAccept:;
		searchList: self class packageSearchList;
		yourself! !

!MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'BenjaminVanRyseghem 12/6/2013 13:17'!
versionSearchAccept: string
	| aString |

	aString := string ifNil: [ '' ].
	versionPattern = aString asLowercase ifTrue: [ ^ self ].
	versionPattern := aString asLowercase.

	versionProcess ifNotNil: [ versionProcess terminate ].
	versionProcess := [ self changed: #versionList ] fork.! !

!MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'lr 9/26/2003 17:25'!
packageListMenu: aMenu
	^aMenu! !

!MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'PhilippeBack 5/9/2014 16:56'!
packageSelection
	^self packageList ifNotNil: [
			^ self packageList indexOf: selectedPackage
	]! !

!MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'avi 9/17/2005 17:21'!
hasVersion
	^ selectedVersion notNil! !

!MCFileRepositoryInspector methodsFor: 'initialization' stamp: 'ThierryGoubier 3/19/2015 23:05'!
initialize
	super initialize.
	loaded := Set new.
	loadedPackages := Set new.
	versionPattern := ''.
	packagePattern := ''.
	packageList := #()! !

!MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'CamilloBruni 6/8/2010 23:40'!
buttonSpecs
	^#(('Refresh' refresh 'refresh the version-list')
		(Save saveChanges 'Save the local changes')) , super buttonSpecs! !

!MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'EstebanLorenzano 3/30/2015 16:08'!
packageListUpdate
	| result packages |	
	
	"Within fork, make no changes to object state until end with assignment wrapped by #defer:"
	
	packageListUpdateProcess ifNotNil: [ packageListUpdateProcess terminate ].	
	packageListUpdateProcess := 
	[	versions ifNotNil: 
		[	result := Set new: versions size.
			versions do: [ :each | result add: each first ].
			
			"sort loaded packages first, then alphabetically"
			packages := Set new: loaded size.
			loaded do: [ :each |
				packages add: (each copyUpToLast: $-). ].
			
			result := result asArray sort: [ :a :b |
				| loadedA loadedB |
				loadedA := packages includes: a.
				loadedB := packages includes: b.
				loadedA = loadedB 
					ifTrue: [ a < b ]
					ifFalse: [ loadedA ] ].
	
			packagePattern ifNotEmpty: [
				result := result select: [ :package|  package name asLowercase includesSubstring: packagePattern ]].
			 
			UIManager default defer:
			[	packageList := result.
				self changed: #packageList.
				self changed: #versionList.
			]
		]
	] fork.! !

!MCFileRepositoryInspector methodsFor: 'actions' stamp: 'MarcusDenker 7/9/2014 15:59'!
load
	self hasVersion
		ifFalse: [ ^ self ].
	self version isCacheable
		ifTrue: [ version workingCopy repositoryGroup addRepository: repository ].
	super load.
	self refresh! !

!MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'TorstenBergmann 11/4/2014 18:41'!
widgetSpecs
	| searchBarOffset |
	
	searchBarOffset := 30 + StandardFonts defaultFont height + 10..
	
	^{ {{#buttonRow}.            {0. 0. 1. 0}.     {0. 0. 0. 30}}.
		
		{{#packageSearchField}.   {0. 0. 0.5. 0}.   {0. 30. 0. searchBarOffset}}.
		{{#listMorph:selection:menu:icon: . #packageList . #packageSelection . #packageListMenu: . #packageIcon:}.{0. 0. 0.5. 0.6}. {0. searchBarOffset+3. 0. 0}}.
		
		{{#versionSearchField}.   {0.5. 0. 1. 0}.   {0. 30. 0. searchBarOffset}}.
		{{#listMorph:. #version}. {0.5. 0. 1. 0.6}. {0. searchBarOffset+3. 0. 0.}}.
		
		{{#textMorph:. #summary}. {0. 0.6. 1. 1}.   {0. 0. 0. 0.}}}! !

!MCFileRepositoryInspector methodsFor: 'actions' stamp: 'bf 11/16/2004 11:56'!
merge
	super merge.
	self refresh.
! !

!MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'EstebanLorenzano 3/26/2015 15:35'!
versionHighlight: aString

	^ Text
		string: aString
		attribute: (self versionHighlightEmphasis: aString)! !

!MCFileRepositoryInspector methodsFor: 'accessing' stamp: 'BenComan 4/7/2014 23:18'!
packageList
	^ packageList ! !

!MCFileRepositoryInspector methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/5/2013 18:17'!
setRepository: aFileBasedRepository workingCopy: aWorkingCopy
	order := self class order.
	repository := aFileBasedRepository.
	
	aWorkingCopy
		ifNil: [ selectedPackage := self packageList isEmpty ifFalse: [self packageList first asString]]
		ifNotNil: [ selectedPackage := aWorkingCopy ancestry ancestorString copyUpToLast: $-.
			selectedPackage ifEmpty: [
				selectedPackage := aWorkingCopy package name ]]. 
	
	[ self refresh.
	MCWorkingCopy addDependent: self.] fork.
! !

!MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'tbn 7/6/2010 17:06'!
orderSpecs
	^{
		'Unchanged' -> nil.
		'Order by package' -> [ :x :y | x first <= y first ].
		'Order by author' -> [ :x :y | x second <= y second ].
		'Order by version-string' -> [ :x :y | x third <= y third ].
		'Order by version-number' -> [ :x :y | x third asNumber >= y third asNumber ].
		'Order by filename' -> [ :x :y | x fourth <= y fourth ].
	}! !

!MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'MarcusDenker 7/9/2014 16:00'!
version
	^ version ifNil:
		[Cursor wait showWhile:
			[version := repository versionFromFileNamed: selectedVersion]]! !

!MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'EstebanLorenzano 9/8/2013 11:00'!
saveChanges
	| currentRepository workingCopy |
	
	currentRepository := repository. "This can be changed elsewhere while processing"
	workingCopy := MCWorkingCopy forPackage: (MCPackage new name: selectedPackage).
	(workingCopy newVersionIn: currentRepository) ifNotNil: [:v |
		(MCVersionInspector new version: v) show.
		Cursor wait showWhile: [currentRepository storeVersion: v].
		MCCacheRepository uniqueInstance cacheAllFileNamesDuring: 
			[currentRepository cacheAllFileNamesDuring: 
				[v allAvailableDependenciesDo:
					[:dep |
					(currentRepository includesVersionNamed: dep info name)
						ifFalse: [currentRepository storeVersion: dep]]]]]! !

!MCFileRepositoryInspector methodsFor: 'private' stamp: 'EstebanLorenzano 4/13/2015 14:50'!
refresh
	loadedPackages := Set new.
	versions := repository retrieveVersionsWithPackageNames: Set new.
	newer := Set new.
	loaded := Set new.

	MCWorkingCopy allManagers do: [ :eachManager | 
		| latestVersions |
		loadedPackages add: eachManager packageName.
		eachManager ancestors do: [ :each | loaded add: each name ].
		latestVersions := versions select: [ :each | each first beginsWith: eachManager packageName ].
		latestVersions do: [ :eachVersion | 
			| maxVersionWithAncestors |
			maxVersionWithAncestors := eachManager ancestors max: #versionNumber.
			eachManager ancestors do: [ :eachAncestor |			 
				(maxVersionWithAncestors < eachVersion third
				or: [ 
					eachAncestor versionNumber = eachVersion third 
					and: [ eachAncestor author ~= eachVersion second ] ])
				ifTrue: [ newer add: eachVersion last ] ] ] ].
	
	self packageListUpdate! !

!MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'stephaneducasse 2/4/2006 20:47'!
order: anInteger
	self class order: (order := anInteger).
	self changed: #versionList.! !

!MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'TudorGirba 3/6/2015 10:10'!
packageIcon: aPackage
 	|p|	 
	newer ifNil: [newer := #()].
	(loaded anySatisfy: [:each | (each beginsWith: aPackage, '-') ])
		ifFalse: [ ^Smalltalk ui icons emptyPackageIcon ].

	"If newer collection includes our package it means we have an older mcz version loaded"
	(newer anySatisfy: [:each | each beginsWith: aPackage, '-']) 
		ifTrue: [ ^Smalltalk ui icons newerPackagesAvailableIcon ].

	p := RPackageOrganizer default packageNamed: aPackage ifAbsent: [nil].  
	p ifNil: [ ^Smalltalk ui icons emptyPackageIcon ]. 
		
	^p isDirty ifFalse: [ Smalltalk ui icons packageIcon]
			    ifTrue: [ Smalltalk ui icons dirtyPackageIcon ]	
! !

!MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'lr 9/26/2003 20:06'!
defaultLabel
	^'Repository: ' , repository description! !

!MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'CamilloBruni 3/13/2012 18:41'!
versionSearchField
	^ SearchMorph new
		model: self;
		setIndexSelector: #versionSearchAccept:;
		updateSelector: #versionSearchAccept:;
		searchList: self class versionSearchList;
		yourself! !

!MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'lr 9/26/2003 21:07'!
versionListMenu: aMenu
	1 to: self orderSpecs size do: [ :index |
		aMenu addUpdating: #orderString: target: self selector: #order: argumentList: { index } ].
	^aMenu! !

!MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'BenjaminVanRyseghem 12/5/2013 16:24'!
versionList
	| result sortBlock |
	result := selectedPackage 
		ifNil: [ versions ifNil: [ ^ #() ]]
		ifNotNil: [ (versions ifNil: [ ^ #() ]) select: [ :each | selectedPackage = each first ] ].
	sortBlock := (self orderSpecs at: order) value.
	sortBlock ifNotNil: [
		result := result asSortedCollection: [:a :b | [sortBlock value: a value: b] on: Error do: [true]]].
	
	versionPattern ifNotEmpty: [
		result := result select: [ :package| package fourth asLowercase includesSubstring: versionPattern ]].
					
	^ result collect: [ :each | self versionHighlight: each fourth ]! !

!MCFileRepositoryInspector methodsFor: 'morphic ui' stamp: 'lr 9/26/2003 21:07'!
orderString: anIndex
	^String streamContents: [ :stream |
		order = anIndex
			ifTrue: [ stream nextPutAll: '<yes>' ]
			ifFalse: [ stream nextPutAll: '<no>' ].
		stream nextPutAll: (self orderSpecs at: anIndex) key ]! !

!MCFileRepositoryInspector class methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 8/4/2011 14:24'!
versionSearchList
	^ versionSearchList ifNil: [ versionSearchList := OrderedCollection new]. ! !

!MCFileRepositoryInspector class methodsFor: 'as yet unclassified' stamp: 'ClementBera 7/26/2013 16:18'!
order
	^ Order ifNil: [ Order := 5 ]! !

!MCFileRepositoryInspector class methodsFor: 'as yet unclassified' stamp: 'stephaneducasse 2/4/2006 20:47'!
order: anInteger
	Order := anInteger! !

!MCFileRepositoryInspector class methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 8/4/2011 14:24'!
packageSearchList
	^ packageSearchList ifNil: [ packageSearchList := OrderedCollection new]. ! !

!MCFileRepositoryInspector class methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 4/24/2012 14:52'!
repository: aFileBasedRepository workingCopy: aWorkingCopy
	^self new
		setRepository: aFileBasedRepository workingCopy: aWorkingCopy;
		yourself! !

!MCFileTreeAbstractReader commentStamp: 'TorstenBergmann 2/20/2014 15:54'!
Abstract reader superclass for FileTree!
!MCFileTreeAbstractReader methodsFor: 'accessing' stamp: 'dkh 2/16/2012 14:49:00'!
basicVersion
	^ (MCVersion new)
		setPackage: self package
			info: self info
			snapshot: self snapshot
			dependencies: self dependencies;
		yourself! !

!MCFileTreeAbstractReader methodsFor: 'testing' stamp: 'dkh 8/10/2012 05:44'!
hasMonticelloMetadata
    ^ (self fileUtils
        directoryExists:
            (self fileUtils directoryFromPath: MCFileTreeStCypressWriter monticelloMetaDirName relativeTo: packageDirectory))
        or: [ 
            (self fileUtils filePathExists: 'version' relativeTo: packageDirectory)
                and: [ self fileUtils filePathExists: 'package' relativeTo: packageDirectory ] ]! !

!MCFileTreeAbstractReader methodsFor: 'testing' stamp: 'dkh 3/1/2012 10:11'!
noMethodMetaData
    ^ self packageProperties at: 'noMethodMetaData' ifAbsent: [ false ]! !

!MCFileTreeAbstractReader methodsFor: 'accessing' stamp: 'dkh 4/4/2012 17:43'!
monticelloMetaDirName
    ^ self class monticelloMetaDirName! !

!MCFileTreeAbstractReader methodsFor: 'utilities' stamp: 'dkh 8/10/2012 07:39'!
definitionFromFile: directoryEntry inDirectory: aDirectory
    | defs reader |
    directoryEntry ifNil: [ ^ nil ].
    self fileUtils
        readStreamFor: directoryEntry name
        in: aDirectory
        do: [ :fileStream | 
            | methodDefinition |
            reader := MCStReader on: fileStream.
            (defs := reader definitions) size <= 1
                ifFalse: [ self error: 'we should be writing exactly 1 definition per file' ] ].
    defs size = 0
        ifTrue: [ ^ nil ].
    ^ defs first! !

!MCFileTreeAbstractReader methodsFor: 'utilities' stamp: 'dkh 8/10/2012 07:43'!
parseMember: fileName
    | directory tokens |
    directory := self fileUtils directoryFromPath: self monticelloMetaDirName relativeTo: packageDirectory.
    self fileUtils readStreamFor: fileName in: directory do: [ :fileStream | tokens := self scanner scan: fileStream ].
    ^ self associate: tokens! !

!MCFileTreeAbstractReader methodsFor: 'utilities' stamp: 'dkh 8/10/2012 07:18'!
loadDependencies
    | dependencyDir directoryPath |
    directoryPath := self monticelloMetaDirName , self fileUtils pathNameDelimiter asString , 'dependencies'.
    dependencyDir := self fileUtils directoryFromPath: directoryPath relativeTo: packageDirectory.
    (self fileUtils directoryExists: dependencyDir)
        ifFalse: [ ^ dependencies := #() ].
    dependencies := OrderedCollection new.
    dependencyDir entries
        do: [ :entry | 
            dependencies
                add:
                    (MCVersionDependency
                        package: (MCPackage named: entry name)
                        info:
                            (self extractInfoFrom: (self parseMember: 'dependencies' , self fileUtils pathNameDelimiter asString , entry name))) ].
    dependencies := dependencies asArray! !

!MCFileTreeAbstractReader methodsFor: 'accessing' stamp: 'dkh 3/1/2012 11:56'!
packageProperties
    packageProperties
        ifNil: [ 
            packageProperties := Dictionary new.
            (packageDirectory entries detect: [ :entry | entry name = '.filetree' ] ifNone: [  ])
                ifNotNil: [ :configEntry | 
                    configEntry
                        readStreamDo: [ :fileStream | 
                            | jsonObject structureVersion |
                            [ 
                            (jsonObject := MCFileTreeJsonParser parseStream: fileStream) isFloat
                                ifTrue: [ 
                                    "
							0.0 - original structure
							0.1 - separate files for method metaData (timestamp) and source
							0.2 - no method metaData file"
                                    packageProperties := Dictionary new.
                                    structureVersion := jsonObject printShowingDecimalPlaces: 1.
                                    packageProperties at: 'noMethodMetaData' put: structureVersion = '0.2'.
                                    packageProperties at: 'separateMethodMetaAndSource' put: structureVersion = '0.1' ]
                                ifFalse: [ 
                                    packageProperties := jsonObject.
                                    ((packageProperties at: 'noMethodMetaData' ifAbsent: [ false ])
                                        and: [ packageProperties at: 'separateMethodMetaAndSource' ifAbsent: [ false ] ])
                                        ifTrue: [ self error: 'noMethodMetaData and separateMethodMetaAndSource cannot both be true' ] ] ]
                                on: Error
                                do: [ :ex | 
                                    Transcript
                                        cr;
                                        show:
                                                'Error reading package properties (.filetree): ' , packageDirectory pathName , ' :: ' , ex description ] ] ] ].
    ^ packageProperties! !

!MCFileTreeAbstractReader methodsFor: 'utilities' stamp: 'dkh 3/1/2012 12:09'!
addClassAndMethodDefinitionsFromDirectory: aDirectory
    self subclassResponsibility! !

!MCFileTreeAbstractReader methodsFor: 'testing' stamp: 'dkh 3/1/2012 10:10'!
separateMethodMetaAndSource
    ^ self packageProperties at: 'separateMethodMetaAndSource' ifAbsent: [ false ]! !

!MCFileTreeAbstractReader methodsFor: 'utilities' stamp: 'dkh 8/10/2012 14:00'!
addClassAndMethodDefinitionsFromDirectoryEntries: entries
    | timestamp |
    self noMethodMetaData
        ifTrue: [ timestamp := self info author , ' ' , self info date mmddyyyy , ' ' , self info time print24 ].
    entries
        do: [ :element | 
            element isDirectory
                ifTrue: [ 
                    | directory |
                    directory := self fileUtils directoryFromEntry: element.
                    ((self separateMethodMetaAndSource or: [ self noMethodMetaData ])
                        ifTrue: [ directory entries select: [ :entry | entry name endsWith: '.st' ] ]
                        ifFalse: [ directory entries ])
                        do: [ :file | 
                            | definition |
                            (definition := self definitionFromFile: file inDirectory: directory)
                                ifNotNil: [ 
                                    definition isMethodDefinition
                                        ifTrue: [ 
                                            self separateMethodMetaAndSource
                                                ifTrue: [ 
                                                    directory
                                                        fileNamed: definition selector asString , '.meta'
                                                        do: [ :fileStream | definition setTimeStamp: (Author fixStamp: fileStream contents) ] ].
                                            self noMethodMetaData
                                                ifTrue: [ definition setTimeStamp: timestamp ] ].
                                    definitions add: definition ] ] ] ]! !

!MCFileTreeAbstractReader methodsFor: 'utilities' stamp: 'dkh 3/1/2012 12:07'!
loadDefinitions
    | entries |
    definitions := OrderedCollection new.
    entries := packageDirectory entries.
    self
        addDefinitionFromFile: (entries detect: [ :entry | entry name beginsWith: 'categories' ] ifNone: [  ])
            inDirectory: packageDirectory;
        addClassAndMethodDefinitionsFromDirectory: packageDirectory;
        addDefinitionFromFile: (entries detect: [ :entry | entry name beginsWith: 'initializers' ] ifNone: [  ])
            inDirectory: packageDirectory! !

!MCFileTreeAbstractReader methodsFor: 'accessing' stamp: 'dkh 8/10/2012 05:46'!
packageDirectory: aDirectoryName
    packageDirectory := self fileUtils directoryFromPath: aDirectoryName relativeTo: stream! !

!MCFileTreeAbstractReader methodsFor: 'utilities' stamp: 'dkh 2/16/2012 14:49:00'!
addDefinitionFromFile: directoryEntry inDirectory: aDirectory
    (self definitionFromFile: directoryEntry inDirectory: aDirectory) ifNotNil: [ :def | definitions add: def ]! !

!MCFileTreeAbstractReader methodsFor: 'accessing' stamp: 'dkh 8/10/2012 05:39'!
fileUtils
    ^ MCFileTreeFileUtils current! !

!MCFileTreeAbstractReader class methodsFor: 'reading' stamp: 'dkh 2/16/2012 14:49:00'!
on: s fileName: f
	^ (self on: s)
		packageDirectory: f;
		yourself! !

!MCFileTreeAbstractReader class methodsFor: 'accessing' stamp: 'dkh 4/4/2012 17:43'!
monticelloMetaDirName
    ^ '.'! !

!MCFileTreeAbstractStWriter commentStamp: 'TorstenBergmann 2/20/2014 15:56'!
Abstract superclass for FileTree writers!
!MCFileTreeAbstractStWriter methodsFor: 'visiting' stamp: 'dkh 4/5/2012 11:15:15'!
visitClassDefinition: definition
    self subclassResponsibility! !

!MCFileTreeAbstractStWriter methodsFor: 'initialize-release' stamp: 'dkh 4/5/2012 11:15:15'!
writeDefinitions: aCollection
    "the correct initialization order is unknown if some classes are missing in the image"

    self writeBasicDefinitions: aCollection! !

!MCFileTreeAbstractStWriter methodsFor: 'writing' stamp: 'topa 7/22/2013 13:26'!
writeClassTraitDefinition: definition
    stWriter visitClassTraitDefinition: definition.
! !

!MCFileTreeAbstractStWriter methodsFor: 'private' stamp: 'dkh 4/5/2012 11:15:15'!
directoryForDirectoryNamed: directoryNameOrPath
    ^ directoryNameOrPath = '.'
        ifTrue: [ stream packageFileDirectory ]
        ifFalse: [ stream subPackageFileDirectoryFor: directoryNameOrPath ]! !

!MCFileTreeAbstractStWriter methodsFor: 'private' stamp: 'dkh 4/5/2012 11:15:15'!
monticelloMetaDirName
    ^ self class monticelloMetaDirName! !

!MCFileTreeAbstractStWriter methodsFor: 'private' stamp: 'dkh 07/07/2013 22:12'!
repository
  ^ stream repository! !

!MCFileTreeAbstractStWriter methodsFor: 'visiting' stamp: 'dkh 4/5/2012 11:15:15'!
visitMetaclassDefinition: definition
    "handled by class definition"

! !

!MCFileTreeAbstractStWriter methodsFor: 'visiting' stamp: 'dkh 4/5/2012 11:15:15'!
visitMethodDefinition: definition
    self subclassResponsibility! !

!MCFileTreeAbstractStWriter methodsFor: 'visiting' stamp: 'dkh 4/5/2012 11:15:15'!
visitOrganizationDefinition: defintion
    self
        writeInDirectoryName: self monticelloMetaDirName
        fileName: 'categories'
        extension: '.st'
        visit: [ defintion categories do: [ :cat | stWriter writeCategory: cat ] ]! !

!MCFileTreeAbstractStWriter methodsFor: 'initialize-release' stamp: 'dkh 4/5/2012 11:15:15'!
writeInitializers
    self
        writeInDirectoryName: self monticelloMetaDirName
        fileName: 'initializers'
        extension: '.st'
        visit: [ 
            stWriter
                writePresentInitializers;
                writeAbsentInitializers ]! !

!MCFileTreeAbstractStWriter methodsFor: 'initialize-release' stamp: 'dkh 4/5/2012 11:15:15'!
writePropertiesFile
    self
        writeInDirectoryName: '.'
        fileName: ''
        extension: '.filetree'
        visit: [ stWriter writeProperties ]! !

!MCFileTreeAbstractStWriter methodsFor: 'initialize-release' stamp: 'topa 7/22/2013 00:13'!
initialize
    stWriter := MCFileTreePackageStructureStWriter new
        initializers: (initializers := Set new);
        yourself.
    orderedClassNames := OrderedCollection new.
    orderedTraitNames := OrderedCollection new.! !

!MCFileTreeAbstractStWriter methodsFor: 'private' stamp: 'dkh 4/5/2012 11:15:15'!
setFileStream: file
    stWriter stream: file! !

!MCFileTreeAbstractStWriter methodsFor: 'writing' stamp: 'dkh 4/5/2012 11:15:15'!
writeMethodDefinition: definition
    stWriter visitMethodDefinition: definition! !

!MCFileTreeAbstractStWriter methodsFor: 'visiting' stamp: 'topa 7/22/2013 00:05'!
visitTraitDefinition: definition
    self subclassResponsibility! !

!MCFileTreeAbstractStWriter methodsFor: 'writing' stamp: 'topa 7/22/2013 13:55'!
writeClassDefinition: definition
    stWriter writeClassDefinition: definition.
    (definition hasClassInstanceVariables or: [definition hasClassTraitComposition])
        ifTrue: [ stWriter writeMetaclassDefinition: definition ].
    definition hasComment
        ifTrue: [ stWriter writeClassComment: definition ]! !

!MCFileTreeAbstractStWriter methodsFor: 'private' stamp: 'dkh 4/5/2012 11:15:15'!
fileNameForSelector: selector
    ^ (selector == #'/'
        ifTrue: [ 'encoded slash' ]
        ifFalse: [ 
            (selector includes: $/)
                ifTrue: [ 'encoded' , selector copyReplaceAll: '/' with: ' slash ' ]
                ifFalse: [ selector ] ]) asString! !

!MCFileTreeAbstractStWriter methodsFor: 'visiting' stamp: 'dkh 07/07/2013 19:32:57'!
visitScriptDefinition: definition
    self flag: #'skippedForNow'! !

!MCFileTreeAbstractStWriter methodsFor: 'visiting' stamp: 'dkh 04/07/2012 10:32'!
writeInDirectoryName: directoryNameOrPath fileName: fileName extension: ext visit: visitBlock
    | directory |
    directory := self directoryForDirectoryNamed: directoryNameOrPath.
    self fileUtils
        writeStreamFor: fileName , ext
        in: directory
        do: [ :fileStream | 
            fileStream lineEndConvention: #'lf'.
            self setFileStream: fileStream.
            visitBlock value ]! !

!MCFileTreeAbstractStWriter methodsFor: 'visiting' stamp: 'topa 7/22/2013 14:35'!
visitClassTraitDefinition: definition
    self subclassResponsibility! !

!MCFileTreeAbstractStWriter methodsFor: 'initialize-release' stamp: 'dkh 4/5/2012 11:15:15'!
writeBasicDefinitions: aCollection
    "the correct initialization order is unknown if some classes are missing in the image"

    self writePropertiesFile.
    stWriter acceptVisitor: self forDefinitions: aCollection.
    self writeInitializers! !

!MCFileTreeAbstractStWriter methodsFor: 'writing' stamp: 'topa 7/22/2013 00:16'!
writeTraitDefinition: definition
    stWriter writeClassDefinition: definition.
    definition hasComment 
        ifTrue: [stWriter writeClassComment: definition].! !

!MCFileTreeAbstractStWriter methodsFor: 'accessing' stamp: 'dkh 08/10/2012 02:55:31'!
fileUtils
    ^ MCFileTreeFileUtils current! !

!MCFileTreeAbstractStWriter class methodsFor: 'accessing' stamp: 'dkh 4/5/2012 11:15:15'!
monticelloMetaDirName
    ^ '.'! !

!MCFileTreeAbstractStWriter class methodsFor: 'accessing' stamp: 'dkh 4/5/2012 11:15:15'!
readerClass
	^ MCStReader! !

!MCFileTreeAbstractStWriter class methodsFor: 'writing' stamp: 'dkh 4/5/2012 11:15:15'!
on: aStream
    MCFileTreePackageStructureStWriter useCypressWriter
        ifTrue: [ ^ MCFileTreeStCypressWriter new stream: aStream ].
    ^ (MCFileTreePackageStructureStWriter useSnapShotWriter
        ifTrue: [ MCFileTreeStSnapshotWriter ]
        ifFalse: [ MCFileTreeStWriter ]) new stream: aStream! !

!MCFileTreeFileSystemUtils commentStamp: 'TorstenBergmann 2/20/2014 15:54'!
Utility class!
!MCFileTreeFileSystemUtils class methodsFor: 'utilities' stamp: 'dkh 8/8/2012 21:48'!
directoryExists: aDirectory
    ^ aDirectory isDirectory! !

!MCFileTreeFileSystemUtils class methodsFor: 'utilities' stamp: 'dkh 8/10/2012 06:47'!
directoryName: aDirectory
    ^ aDirectory basename! !

!MCFileTreeFileSystemUtils class methodsFor: 'utilities' stamp: 'dkh 8/9/2012 15:38'!
resolvePath: path in: aDirectory
    ^ aDirectory resolveString: path! !

!MCFileTreeFileSystemUtils class methodsFor: 'utilities' stamp: 'dkh 8/8/2012 19:19'!
pathNameDelimiter
    ^ DiskStore activeClass delimiter! !

!MCFileTreeFileSystemUtils class methodsFor: 'utilities' stamp: 'dkh 8/10/2012 13:47'!
directoryFromEntry: directoryEntry
    ^ directoryEntry asFileReference! !

!MCFileTreeFileSystemUtils class methodsFor: 'utilities' stamp: 'dkh 8/10/2012 05:14'!
directoryFromPath: directoryPath relativeTo: aDirectory
    ^ aDirectory resolveString: directoryPath! !

!MCFileTreeFileSystemUtils class methodsFor: 'utilities' stamp: 'dkh 8/9/2012 09:46'!
writeStreamFor: filePath in: aDirectory do: aBlock
    (aDirectory resolveString: filePath) writeStreamDo: aBlock! !

!MCFileTreeFileSystemUtils class methodsFor: 'utilities' stamp: 'dkh 8/10/2012 06:31'!
readStreamFor: filePath in: aDirectory do: aBlock
    "temporary hack for Pharo-1.4"

    ^ (aDirectory resolveString: filePath)
        readStreamDo: [ :fileStream | 
            | stream |
            stream := ReadStream on: fileStream contents asString.
            stream reset.
            aBlock value: stream ]! !

!MCFileTreeFileSystemUtils class methodsFor: 'utilities' stamp: 'ChristopheDemarey 7/22/2013 11:48'!
ensureFilePathExists: fileNameOrPath relativeTo: aDirectory
    (aDirectory resolveString: fileNameOrPath) parent ensureCreateDirectory! !

!MCFileTreeFileSystemUtils class methodsFor: 'utilities' stamp: 'dkh 8/8/2012 22:12'!
deleteAll: aDirectory
    ^ aDirectory deleteAll! !

!MCFileTreeFileSystemUtils class methodsFor: 'initialization' stamp: 'dkh 8/9/2012 08:29'!
initialize
    "self initialize"

    self install! !

!MCFileTreeFileSystemUtils class methodsFor: 'utilities' stamp: 'dkh 8/9/2012 09:33'!
parentDirectoryOf: aDirectory
    ^ aDirectory parent! !

!MCFileTreeFileSystemUtils class methodsFor: 'utilities' stamp: 'dkh 8/8/2012 22:09'!
default
    ^ DiskStore activeClass createDefault defaultWorkingDirectory asFileReference! !

!MCFileTreeFileSystemUtils class methodsFor: 'utilities' stamp: 'dkh 8/9/2012 15:43'!
filePathExists: filePath relativeTo: aDirectory
    ^ (aDirectory resolveString: filePath) isFile! !

!MCFileTreeFileSystemUtils class methodsFor: 'utilities' stamp: 'dkh 8/10/2012 09:29'!
directoryFromPath: directoryPath
    ^ (AbsolutePath from: directoryPath delimiter: self pathNameDelimiter) asFileReference! !

!MCFileTreeFileSystemUtils class methodsFor: 'utilities' stamp: 'dkh 8/10/2012 07:50'!
directoryPathString: aDirectory
    ^ aDirectory pathString! !

!MCFileTreeFileSystemUtils class methodsFor: 'utilities' stamp: 'ChristopheDemarey 7/22/2013 11:48'!
ensureDirectoryExists: aDirectory
    aDirectory ensureCreateDirectory! !

!MCFileTreeFileUtils commentStamp: 'TorstenBergmann 2/20/2014 15:59'!
Utility class for file access!
!MCFileTreeFileUtils class methodsFor: 'utilities' stamp: 'dkh 8/10/2012 09:59'!
directoryExists: aDirectory
    self subclassResponsibility! !

!MCFileTreeFileUtils class methodsFor: 'utilities' stamp: 'dkh 8/10/2012 09:59'!
directoryName: aDirectory
    self subclassResponsibility! !

!MCFileTreeFileUtils class methodsFor: 'utilities' stamp: 'dkh 8/10/2012 10:00'!
resolvePath: path in: aDirectory
    self subclassResponsibility! !

!MCFileTreeFileUtils class methodsFor: 'utilities' stamp: 'dkh 8/9/2012 09:15'!
buildPathFrom: pathCollection
    ^ String
        streamContents: [ :stream | pathCollection do: [ :element | stream nextPutAll: element ] separatedBy: [ stream nextPut: self pathNameDelimiter ] ]! !

!MCFileTreeFileUtils class methodsFor: 'utilities' stamp: 'dkh 8/10/2012 10:00'!
pathNameDelimiter
    self subclassResponsibility! !

!MCFileTreeFileUtils class methodsFor: 'utilities' stamp: 'dkh 8/10/2012 09:59'!
directoryFromPath: directoryPath relativeTo: aDirectory
    self subclassResponsibility! !

!MCFileTreeFileUtils class methodsFor: 'utilities' stamp: 'dkh 8/10/2012 10:00'!
writeStreamFor: filePath in: aDirectory do: aBlock
    self subclassResponsibility! !

!MCFileTreeFileUtils class methodsFor: 'utilities' stamp: 'dkh 8/10/2012 10:00'!
readStreamFor: filePath in: aDirectory do: aBlock
    self subclassResponsibility! !

!MCFileTreeFileUtils class methodsFor: 'utilities' stamp: 'dkh 8/10/2012 09:59'!
ensureFilePathExists: fileNameOrPath relativeTo: aDirectory
    self subclassResponsibility! !

!MCFileTreeFileUtils class methodsFor: 'utilities' stamp: 'dkh 8/10/2012 09:59'!
deleteAll: aDirectory
    self subclassResponsibility! !

!MCFileTreeFileUtils class methodsFor: 'utilities' stamp: 'dkh 8/10/2012 10:00'!
parentDirectoryOf: aDirectory
    self subclassResponsibility! !

!MCFileTreeFileUtils class methodsFor: 'utilities' stamp: 'dkh 8/10/2012 09:59'!
default
    self subclassResponsibility! !

!MCFileTreeFileUtils class methodsFor: 'initialization' stamp: 'dkh 8/8/2012 22:37'!
install
    Current := self! !

!MCFileTreeFileUtils class methodsFor: 'utilities' stamp: 'dkh 8/10/2012 10:00'!
filePathExists: filePath relativeTo: aDirectory
    self subclassResponsibility! !

!MCFileTreeFileUtils class methodsFor: 'utilities' stamp: 'dkh 8/10/2012 09:59'!
ensureDirectoryExists: aDirectory
    self subclassResponsibility! !

!MCFileTreeFileUtils class methodsFor: 'utilities' stamp: 'dkh 8/10/2012 09:59'!
directoryPathString: aDirectory
    self subclassResponsibility! !

!MCFileTreeFileUtils class methodsFor: 'utilities' stamp: 'dkh 8/10/2012 09:59'!
directoryFromPath: directoryPath
    self subclassResponsibility! !

!MCFileTreeFileUtils class methodsFor: 'accessing' stamp: 'dkh 8/8/2012 22:36'!
current
    ^ Current! !

!MCFileTreeJsonParser commentStamp: 'TorstenBergmann 2/20/2014 15:59'!
JSON parser!
!MCFileTreeJsonParser methodsFor: 'creating' stamp: 'dkh 2/16/2012 14:39:25'!
createString: aString
	"Create a string literal. Subclasses might want to refine this implementation."

	^ aString! !

!MCFileTreeJsonParser methodsFor: 'adding' stamp: 'dkh 2/16/2012 14:39:25'!
addValue: anObject to: aCollection
	"Add anObject to aCollection. Subclasses might want to refine this implementation."

	^ aCollection copyWith: anObject! !

!MCFileTreeJsonParser methodsFor: 'creating' stamp: 'dkh 2/16/2012 14:39:25'!
createTrue
	"Create the true literal. Subclasses might want to refine this implementation."

	^ true! !

!MCFileTreeJsonParser methodsFor: 'parsing' stamp: 'dkh 2/16/2012 14:39:25'!
parseValue
	| char |
	stream atEnd ifFalse: [ 
		char := stream peek.
		char = ${
			ifTrue: [ ^ self parseObject ].
		char = $[
			ifTrue: [ ^ self parseArray ].
		char = $"
			ifTrue: [ ^ self parseString ].
		(char = $- or: [ char between: $0 and: $9 ])
			ifTrue: [ ^ self parseNumber ].
		(self match: 'true')
			ifTrue: [ ^ self createTrue ].
		(self match: 'false')
			ifTrue: [ ^ self createFalse ].
		(self match: 'null')
			ifTrue: [ ^ self createNull ] ].
	self error: 'invalid input'! !

!MCFileTreeJsonParser methodsFor: 'creating' stamp: 'dkh 2/16/2012 14:39:25'!
createObject
	"Create an empty object. Subclasses might want to refine this implementation."
	
	^ Dictionary new! !

!MCFileTreeJsonParser methodsFor: 'private' stamp: 'dkh 2/16/2012 14:39:25'!
match: aString
	"Tries to match aString, consume input and answer true if successful."
	
	| position |
	position := stream position.
	aString do: [ :each |
		(stream atEnd or: [ stream next ~= each ]) ifTrue: [ 
			stream position: position.
			^ false ] ].
	self whitespace.
	^ true! !

!MCFileTreeJsonParser methodsFor: 'parsing' stamp: 'dkh 2/16/2012 14:39:25'!
parseObject
	| result |
	self expect: '{'.
	result := self createObject.
	(self match: '}')
		ifTrue: [ ^ result ].
	[ stream atEnd ] whileFalse: [
		result := self
			addProperty: self parseProperty
			to: result.
		(self match: '}')
			ifTrue: [ ^ result ].
		self expect: ',' ].
	self error: 'end of object expected'! !

!MCFileTreeJsonParser methodsFor: 'parsing-internal' stamp: 'dkh 2/16/2012 14:39:25'!
parseNumber
	| negated number |
	negated := stream peek = $-.
	negated ifTrue: [ stream next ].
	number := self parseNumberInteger.
	(stream peek = $.) ifTrue: [
		stream next. 
		number := number + self parseNumberFraction ].
	(stream peek = $e or: [ stream peek = $E ]) ifTrue: [
		stream next.
		number := number * self parseNumberExponent ].
	negated ifTrue: [ number := number negated ].
	^ self whitespace; createNumber: number! !

!MCFileTreeJsonParser methodsFor: 'parsing-internal' stamp: 'dkh 4/6/2012 15:56:14'!
parseNumberInteger
    | number |
    number := 0.
    [ stream atEnd not and: [ stream peek isDigit ] ] whileTrue: [ number := 10 * number + (stream next charCode - 48) ].
    ^ number! !

!MCFileTreeJsonParser methodsFor: 'parsing-internal' stamp: 'dkh 4/6/2012 15:56:14'!
parseNumberFraction
    | number power |
    number := 0.
    power := 1.0.
    [ stream atEnd not and: [ stream peek isDigit ] ]
        whileTrue: [ 
            number := 10 * number + (stream next charCode - 48).
            power := power * 10.0 ].
    ^ number / power! !

!MCFileTreeJsonParser methodsFor: 'parsing-internal' stamp: 'dkh 4/6/2012 15:56:14'!
parseCharacterHexDigit
    | digit |
    stream atEnd
        ifFalse: [ 
            digit := stream next charCode.
            (digit between: 48 and: 57)
                ifTrue: [ ^ digit - 48 ].	"$0"	"$9"
            (digit between: 65 and: 70)
                ifTrue: [ ^ digit - 55 ].	"$A"	"$F"
            (digit between: 97 and: 102)
                ifTrue: [ ^ digit - 87 ]	"$a"	"$f" ].
    self error: 'hex-digit expected'! !

!MCFileTreeJsonParser methodsFor: 'creating' stamp: 'dkh 2/16/2012 14:39:25'!
createArray
	"Create an empty collection. Subclasses might want to refine this implementation."

	^ Array new! !

!MCFileTreeJsonParser methodsFor: 'parsing-internal' stamp: 'dkh 2/16/2012 14:39:25'!
parseCharacterHex
	| value |
	value := self parseCharacterHexDigit.
	3 timesRepeat: [ value := (value << 4) + self parseCharacterHexDigit ].
	^ Character codePoint: value! !

!MCFileTreeJsonParser methodsFor: 'parsing' stamp: 'dkh 2/16/2012 14:39:25'!
parse
	| result |
	result := self whitespace; parseValue.
	stream atEnd
		ifFalse: [ self error: 'end of input expected' ].
	^ result! !

!MCFileTreeJsonParser methodsFor: 'creating' stamp: 'dkh 2/16/2012 14:39:25'!
createFalse
	"Create the false literal. Subclasses might want to refine this implementation."
	
	^ false! !

!MCFileTreeJsonParser methodsFor: 'parsing-internal' stamp: 'dkh 2/16/2012 14:39:25'!
parseString
	| result |
	self expect: '"'.
	result := WriteStream on: String new.
	[ stream atEnd or: [ stream peek = $" ] ] 
		whileFalse: [ result nextPut: self parseCharacter ].
	^ self expect: '"'; createString: result contents! !

!MCFileTreeJsonParser methodsFor: 'adding' stamp: 'dkh 2/16/2012 14:39:25'!
addProperty: anAssociation to: anObject
	"Add the property anAssociation described with key and value to anObject. Subclasses might want to refine this implementation."
	
	^ anObject 
		add: anAssociation;
		yourself! !

!MCFileTreeJsonParser methodsFor: 'private' stamp: 'dkh 2/16/2012 14:39:25'!
whitespace
	"Strip whitespaces from the input stream."

	[ stream atEnd not and: [ stream peek isSeparator ] ]
		whileTrue: [ stream next ]! !

!MCFileTreeJsonParser methodsFor: 'parsing-internal' stamp: 'dkh 2/16/2012 14:39:25'!
parseCharacter
	| char |
	(char := stream next) = $\ 
		ifFalse: [ ^ char ].
	(char := stream next) = $" 
		ifTrue: [ ^ char ].
	char = $\
		ifTrue: [ ^ char ].
	char = $/
		ifTrue: [ ^ char ].
	char = $b
		ifTrue: [ ^ Character backspace ].
	char = $f
		ifTrue: [ ^ Character newPage ].
	char = $n
		ifTrue: [ ^ Character lf ].
	char = $r
		ifTrue: [ ^ Character cr ].
	char = $t
		ifTrue: [ ^ Character tab ].
	char = $u
		ifTrue: [ ^ self parseCharacterHex ].
	self error: 'invalid escape character \' , (String with: char)! !

!MCFileTreeJsonParser methodsFor: 'creating' stamp: 'dkh 2/16/2012 14:39:25'!
createNull
	"Create the null literal. Subclasses might want to refine this implementation."

	^ nil! !

!MCFileTreeJsonParser methodsFor: 'private' stamp: 'dkh 2/16/2012 14:39:25'!
expect: aString
	"Expects aString and consume input, throw an error otherwise."

	^ (self match: aString) ifFalse: [ self error: aString , ' expected' ]! !

!MCFileTreeJsonParser methodsFor: 'parsing-internal' stamp: 'dkh 4/6/2012 15:56:14'!
parseNumberExponent
    | number negated |
    number := 0.
    negated := stream peek = $-.
    (negated or: [ stream peek = $+ ])
        ifTrue: [ stream next ].
    [ stream atEnd not and: [ stream peek isDigit ] ] whileTrue: [ number := 10 * number + (stream next charCode - 48) ].
    negated
        ifTrue: [ number := number negated ].
    ^ 10 raisedTo: number! !

!MCFileTreeJsonParser methodsFor: 'creating' stamp: 'dkh 2/16/2012 14:39:25'!
createProperty: aKey with: aValue
	"Create an empty attribute value pair. Subclasses might want to refine this implementation."
	
	^ aKey -> aValue! !

!MCFileTreeJsonParser methodsFor: 'parsing-internal' stamp: 'dkh 2/16/2012 14:39:25'!
parseProperty
	| name value |
	name := self parseString.
	self expect: ':'.
	value := self parseValue.
	^ self createProperty: name with: value.! !

!MCFileTreeJsonParser methodsFor: 'parsing' stamp: 'dkh 2/16/2012 14:39:25'!
parseArray
	| result |
	self expect: '['.
	result := self createArray.
	(self match: ']')
		ifTrue: [ ^ result ].
	[ stream atEnd ] whileFalse: [
		result := self
			addValue: self parseValue
			to: result.
		(self match: ']') 
			ifTrue: [ ^ result ].
		self expect: ',' ].
	self error: 'end of array expected'! !

!MCFileTreeJsonParser methodsFor: 'initialization' stamp: 'dkh 2/16/2012 14:39:25'!
initializeOn: aStream
	self initialize.
	stream := aStream! !

!MCFileTreeJsonParser methodsFor: 'creating' stamp: 'dkh 2/16/2012 14:39:25'!
createNumber: aString
	"Create a number literal. Subclasses might want to refine this implementation."

	^ aString asNumber! !

!MCFileTreeJsonParser class methodsFor: 'accessing' stamp: 'dkh 2/16/2012 14:39:25'!
parse: aString
	^ self parseStream: aString readStream! !

!MCFileTreeJsonParser class methodsFor: 'instance creation' stamp: 'dkh 2/16/2012 14:39:25'!
on: aStream
	^ self basicNew initializeOn: aStream! !

!MCFileTreeJsonParser class methodsFor: 'instance creation' stamp: 'dkh 2/16/2012 14:39:25'!
new
	self error: 'Instantiate the parser with a stream.'! !

!MCFileTreeJsonParser class methodsFor: 'accessing' stamp: 'dkh 2/16/2012 14:39:25'!
parseStream: aStream
	^ (self on: aStream) parse! !

!MCFileTreePackageStructureStWriter commentStamp: 'TorstenBergmann 2/20/2014 15:59'!
Writer for a package structure!
!MCFileTreePackageStructureStWriter methodsFor: 'visiting' stamp: 'dkh 2/29/2012 13:46'!
acceptVisitor: aVisitor forDefinitions: aCollection
	(MCDependencySorter sortItems: aCollection)
		do: [ :ea | ea accept: aVisitor ]
		displayingProgress: 'Writing definitions...'! !

!MCFileTreePackageStructureStWriter methodsFor: 'accessing' stamp: 'dkh 2/29/2012 13:45'!
initializers: aCollection
	initializers := aCollection! !

!MCFileTreePackageStructureStWriter methodsFor: 'accessing' stamp: 'dkh 2/29/2012 13:46'!
presentInitializers
	^ initializers select: [ :each | Smalltalk hasClassNamed: each key ]! !

!MCFileTreePackageStructureStWriter methodsFor: 'writing' stamp: 'dkh 2/29/2012 13:42'!
writeDefinitions: aCollection
	"the correct initialization order is unknown if some classes are missing in the image"

	initializers := Set new.
	self
		acceptVisitor: self forDefinitions: aCollection;
		writePresentInitializers;
		writeAbsentInitializers! !

!MCFileTreePackageStructureStWriter methodsFor: 'writing' stamp: 'dkh 2/29/2012 13:45'!
writePresentInitializers
	| orderedClasses presentInitializers |
	presentInitializers := self presentInitializers.
	orderedClasses := (Class
		superclassOrder: (presentInitializers collect: [ :each | Smalltalk classOrTraitNamed: each key ]))
		collect: [ :each | each name ].
	orderedClasses
		do: [ :className | stream nextPutAll: (presentInitializers detect: [ :each | each key = className ]) value contents ]! !

!MCFileTreePackageStructureStWriter methodsFor: 'writing' stamp: 'dkh 2/29/2012 13:45'!
writeAbsentInitializers
	(self absentInitializers asSortedCollection: [ :a :b | a key <= b key ])
		do: [ :association | stream nextPutAll: association value contents ]! !

!MCFileTreePackageStructureStWriter methodsFor: 'writing' stamp: 'dkh 2/29/2012 14:48'!
writeClassDefinition: definition
    self chunkContents: [ :s | definition printDefinitionOn: s ]! !

!MCFileTreePackageStructureStWriter methodsFor: 'writing' stamp: 'dkh 2/16/2012 14:49:00'!
writeMethodPreamble: definition
    stream
        cr;
        nextPut: $!!;
        nextPutAll: definition fullClassName;
        nextPutAll: ' methodsFor: ';
        nextPutAll: definition category asString printString;
        nextPutAll: '!!';
        cr! !

!MCFileTreePackageStructureStWriter methodsFor: 'writing' stamp: 'dkh 3/1/2012 14:21'!
writeProperties
    stream
        nextPut: ${;
        cr;
        nextPutAll: '    "noMethodMetaData" : true,';
        cr;
        nextPutAll: '    "separateMethodMetaAndSource" : false';
        cr;
        nextPut: $};
        cr! !

!MCFileTreePackageStructureStWriter methodsFor: 'accessing' stamp: 'dkh 2/29/2012 13:46'!
absentInitializers
	^ initializers reject: [ :each | Smalltalk hasClassNamed: each key ]! !

!MCFileTreePackageStructureStWriter class methodsFor: 'accessing' stamp: 'dkh 3/1/2012 10:30'!
useSnapShotWriter
    ^ MCFileTreeRepository defaultPackageExtension = '.pkg'! !

!MCFileTreePackageStructureStWriter class methodsFor: 'accessing' stamp: 'dkh 4/5/2012 10:37'!
useCypressWriter
    "MCFileTreeRepository defaultPackageExtension:'.package'"

    "MCFileTreeRepository defaultPackageExtension:'.pkg'"

    ^ true! !

!MCFileTreeRepository commentStamp: 'TorstenBergmann 2/20/2014 16:23'!
A file tree repository!
!MCFileTreeRepository methodsFor: 'actions' stamp: 'dkh 6/16/2012 09:02'!
fileDirectoryOn: directoryPath
    ^ self fileUtils directoryFromPath: directoryPath relativeTo: self directory! !

!MCFileTreeRepository methodsFor: 'accessing' stamp: 'dkh 8/10/2012 14:55:31.237'!
fileUtils
    ^ MCFileTreeFileUtils current! !

!MCFileTreeRepository methodsFor: 'descriptions' stamp: 'dkh 2/16/2012 14:49:00'!
description
    ^ self class description , super description! !

!MCFileTreeRepository methodsFor: 'accessing' stamp: 'dkh 07/10/2013 11:43:55'!
defaultRepositoryProperties
  ^ Dictionary new
    at: 'packageExtension' put: self class defaultPackageExtension;
    at: 'propertyFileExtension' put: self propertyFileExtension;
    yourself! !

!MCFileTreeRepository methodsFor: 'private' stamp: 'dkh 07/10/2013 11:43:55'!
propertyFileExtension: propertyFileExtension
  self class validatePropertyFileExtension: propertyFileExtension.
  self repositoryProperties
    at: 'propertyFileExtension'
    put: propertyFileExtension.
  self writeRepositoryProperties! !

!MCFileTreeRepository methodsFor: 'actions' stamp: 'dkh 8/10/2012 07:56'!
versionInfoForPackageDirectory: packageDirectory
    ^ ((MCReader readerClassForFileNamed: (self fileUtils directoryName: packageDirectory))
        on: (self fileUtils parentDirectoryOf: packageDirectory)
        fileName: (self fileUtils directoryName: packageDirectory))
        loadVersionInfo;
        info! !

!MCFileTreeRepository methodsFor: 'accessing' stamp: 'dkh 07/08/2013 10:59:46'!
allFileNamesForVersionNamed: aString
	^ self filterFileNames: self readableFileNames forVersionNamed: aString! !

!MCFileTreeRepository methodsFor: 'accessing' stamp: 'dkh 8/10/2012 07:54'!
repositoryProperties
  repositoryProperties
    ifNil: [ 
      repositoryProperties := Dictionary new.
      (self fileUtils directoryExists: directory)
        ifFalse: [ 
          self
            error:
              'filetree:// repository '
                ,
                  (self fileUtils directoryPathString: self directory) printString
                , ' does not exist.' ].
      (self directory entries
        detect: [ :entry | entry name = '.filetree' ]
        ifNone: [  ])
        ifNil: [ 
          repositoryProperties := self defaultRepositoryProperties.
          self writeRepositoryProperties ]
        ifNotNil: [ :configEntry | 
          configEntry
            readStreamDo: [ :fileStream | repositoryProperties := MCFileTreeJsonParser parseStream: fileStream ] ] ].
  ^ repositoryProperties! !

!MCFileTreeRepository methodsFor: 'accessing' stamp: 'dkh 07/08/2013 10:59:46'!
versionInfoFromFileNamed: aString
	^ self loadVersionInfoFromFileNamed: aString! !

!MCFileTreeRepository methodsFor: 'testing' stamp: 'dkh 2/29/2012 10:15'!
canReadFileNamed: aString
    ^ (aString endsWith: self packageExtension)
        or: [ 
            (aString endsWith: '.tree')
                or: [ 
                    "Cypress format"
                    aString endsWith: '.package' ] ]! !

!MCFileTreeRepository methodsFor: '*metacello-filetree' stamp: 'dkh 5/16/2012 21:21:27'!
metacelloProjectClassFor: aScriptEngine
    aScriptEngine versionString isEmptyOrNil
        ifFalse: [ 
            "If we have a version in the script, then a BaselineOf is not being referenced...use a MetacelloMCProject
	    	 see https://github.com/dalehenrich/metacello-work/issues/7"
            ^ super metacelloProjectClassFor: aScriptEngine ].
    ^ MetacelloMCBaselineProject! !

!MCFileTreeRepository methodsFor: 'accessing' stamp: 'dkh 2/16/2012 14:49:00'!
readonly
    readonly ifNil: [ readonly := false ].
    ^ readonly! !

!MCFileTreeRepository methodsFor: 'storing' stamp: 'dkh 4/5/2012 10:33'!
basicStoreVersion: aVersion
  self readonly
    ifTrue: [ 
      ^ self
        error:
          'The filetree repository: ' , self description printString
            , ' was created read only.' ].
  MCFileTreeWriter fileOut: aVersion on: self! !

!MCFileTreeRepository methodsFor: 'accessing' stamp: 'dkh 2/16/2012 14:49:00'!
versionNameFromFileName: aString
	| description |
	description := self packageDescriptionFromPackageDirectory: (self fileDirectoryOn: aString).
	^ description first , '-' , description second , '.' , description third printString! !

!MCFileTreeRepository methodsFor: 'actions' stamp: 'dkh 6/27/2012 20:14'!
packageDescriptionFromPackageDirectory: packageDirectory
    | filename info extension |
    filename := self fileUtils current directoryName: packageDirectory.
    extension := filename copyFrom: (filename lastIndexOf: $.) to: filename size.
    ^ ((self packageExtension ~= '.package'
        and: [ 
            (self fileUtils filePathExists: 'version' relativeTo: packageDirectory)
                and: [ self fileUtils filePathExists: 'package' relativeTo: packageDirectory ] ])
        or: [ 
            | dir |
            dir := self fileUtils
                directoryFromPath: MCFileTreeStCypressWriter monticelloMetaDirName
                relativeTo: packageDirectory.
            self fileUtils directoryExists: dir ])
        ifTrue: [ 
            info := self versionInfoForPackageDirectory: packageDirectory.
            self parseName: info name extension: extension ]
        ifFalse: [ 
            {(filename copyFrom: 1 to: (filename lastIndexOf: $.) - 1).
            'cypress'.
            1.
            filename} ]! !

!MCFileTreeRepository methodsFor: 'actions' stamp: 'dkh 2/16/2012 14:49:00'!
packageDescriptionsFromReadableFileNames
    ^ ((self readableFileNames collect: [ :fileName | self fileDirectoryOn: fileName ])
        select: [ :packageDirectory | self fileUtils directoryExists: packageDirectory ])
        collect: [ :packageDirectory | self packageDescriptionFromPackageDirectory: packageDirectory ]! !

!MCFileTreeRepository methodsFor: 'i/o' stamp: 'dkh 2/16/2012 14:49:00'!
readStreamForFileNamed: aString do: aBlock
    ^ aBlock value: self directory! !

!MCFileTreeRepository methodsFor: 'caching' stamp: 'dkh 2/16/2012 14:49:00'!
cachedFileNames
	^ #()! !

!MCFileTreeRepository methodsFor: 'accessing' stamp: 'dkh 2/16/2012 14:49:00'!
readonly: anObject
	readonly := anObject! !

!MCFileTreeRepository methodsFor: 'interface' stamp: 'dkh 07/08/2013 10:59:46'!
versionWithInfo: aVersionInfo ifAbsent: errorBlock
	(self allFileNamesForVersionNamed: aVersionInfo name)
		ifNotEmpty: [ :aCollection | ^ self versionFromFileNamed: aCollection first ].
	^ errorBlock value! !

!MCFileTreeRepository methodsFor: 'i/o' stamp: 'dkh 2/16/2012 14:49:00'!
writeStreamForFileNamed: aString replace: aBoolean do: aBlock
	self error: 'we do not open a single stream, but write multiple files'! !

!MCFileTreeRepository methodsFor: 'private' stamp: 'dkh 8/10/2012 09:44'!
writeRepositoryProperties
  self fileUtils
    writeStreamFor: '.filetree'
    in: self directory
    do: [ :fileStream | 
      | keyCount propertyCount |
      repositoryProperties
        ifNil: [ repositoryProperties := self defaultRepositoryProperties ].
      keyCount := repositoryProperties size.
      propertyCount := 0.
      fileStream lineEndConvention: #'lf'.
      fileStream nextPutAll: '{'.
      repositoryProperties
        keysAndValuesDo: [ :propertyName :propertyValue | 
          propertyCount := propertyCount + 1.
          fileStream
            nextPut: $";
            nextPutAll: propertyName asString;
            nextPutAll: '" : "';
            nextPutAll: propertyValue asString;
            nextPut: $";
            yourself.
          propertyCount < keyCount
            ifTrue: [ 
              fileStream
                nextPutAll: ',';
                cr ] ].
      fileStream nextPutAll: ' }' ]
! !

!MCFileTreeRepository methodsFor: 'private' stamp: 'dkh 07/10/2013 11:43:55'!
propertyFileExtension
  ^ self repositoryProperties
    at: 'propertyFileExtension'
    ifAbsent: [ self class defaultPropertyFileExtension ]! !

!MCFileTreeRepository methodsFor: '*metacello-mc' stamp: 'EstebanLorenzano 2/19/2015 16:50'!
versionInfoFromVersionNamed: aString
	^ self versionInfoForPackageDirectory: (self fileDirectoryOn: (aString, self packageExtension))! !

!MCFileTreeRepository methodsFor: 'private' stamp: 'dkh 2/29/2012 11:39'!
parseName: aString extension: extension
    ^ self class parseName: aString extension: extension! !

!MCFileTreeRepository methodsFor: '*Komitter-Models' stamp: 'BenjaminVanRyseghem 1/5/2014 15:46'!
isRemote
	^ true! !

!MCFileTreeRepository methodsFor: 'accessing' stamp: 'dkh 3/7/2012 17:09:47'!
directory: aDirectory
  super directory: aDirectory.
  repositoryProperties := nil.	"force properties to be reloaded from new location"
  self repositoryProperties	"NOW"! !

!MCFileTreeRepository methodsFor: 'private' stamp: 'dkh 07/10/2013 11:43:55'!
flushCache
  "force properties to be reread ... if the directory exists, otherwise let nature
   take it's course"

  super flushCache.
  directory
    ifNotNil: [ 
      (MCFileTreeFileUtils current directoryExists: directory)
        ifTrue: [ 
          repositoryProperties := nil.
          self repositoryProperties ] ]! !

!MCFileTreeRepository methodsFor: 'private' stamp: 'dkh 2/29/2012 10:11'!
packageExtension
  ^ self repositoryProperties
    at: 'packageExtension'
    ifAbsent: [ self class defaultPackageExtension ]! !

!MCFileTreeRepository methodsFor: '*gofer-core-accessing' stamp: 'dkh 07/08/2013 10:59:46'!
goferVersionFrom: aVersionReference
    "until we no longer find .tree directories in the wild"

    ((self readableFileNames collect: [ :fileName | self fileDirectoryOn: fileName ])
        select: [ :packageDirectory | self fileUtils directoryExists: packageDirectory ])
        collect: [ :packageDirectory | 
            (self versionInfoForPackageDirectory: packageDirectory) name = aVersionReference name
                ifTrue: [ ^ self loadVersionFromFileNamed: (self fileUtils directoryName: packageDirectory) ] ].
    ^ nil! !

!MCFileTreeRepository methodsFor: 'accessing' stamp: 'dkh 07/08/2013 10:59:46'!
filterFileNames: aCollection forVersionNamed: aString
	^ aCollection select: [:ea | (self versionNameFromFileName: ea) = aString]! !

!MCFileTreeRepository methodsFor: 'accessing' stamp: 'dkh 2/16/2012 14:49:00'!
asRepositorySpecFor: aMetacelloMCProject
    ^ aMetacelloMCProject repositorySpec
        description: self description;
        type: 'filetree';
        yourself! !

!MCFileTreeRepository methodsFor: 'accessing' stamp: 'dkh 07/08/2013 10:59:46'!
versionFromFileNamed: aString
	^ self loadVersionFromFileNamed: aString! !

!MCFileTreeRepository methodsFor: 'accessing' stamp: 'dkh 07/08/2013 10:59:46'!
allFileNames
    ^ (self directory entries select: [ :entry | entry isDirectory and: [ self canReadFileNamed: entry name ] ])
        collect: [ :entry | entry name ]! !

!MCFileTreeRepository class methodsFor: 'accessing' stamp: 'dkh 07/10/2013 11:43:55'!
validatePropertyFileExtension: aString
  "see Issue #90: https://github.com/dalehenrich/filetree/issues/90"

  (#('.json' '.ston') includes: aString)
    ifFalse: [ self error: 'Unsupported property file extension: ' , aString printString ]! !

!MCFileTreeRepository class methodsFor: 'instance creation' stamp: 'dkh 2/16/2012 14:49:00'!
description
    ^ 'filetree://'! !

!MCFileTreeRepository class methodsFor: 'accessing' stamp: 'dkh 07/10/2013 11:43:55'!
defaultPropertyFileExtension
  defaultPropertyFileExtension
    ifNil: [ defaultPropertyFileExtension := '.json' ].
  ^ defaultPropertyFileExtension! !

!MCFileTreeRepository class methodsFor: 'accessing' stamp: 'dkh 07/10/2013 11:43:55'!
defaultPropertyFileExtension: aString
  "self defaultPropertyFileExtension:'.ston'"

  self validatePropertyFileExtension: aString.
  defaultPropertyFileExtension := aString! !

!MCFileTreeRepository class methodsFor: 'utility' stamp: 'dkh 2/16/2012 14:49:00'!
parseName: aString extension: extension
    "picked up from GoferVersionReference>>parseName:"

    | info basicName package branch author versionNumber packageName |
    basicName := aString last isDigit
        ifTrue: [ aString ]
        ifFalse: [ (aString copyUpToLast: $.) copyUpTo: $( ].
    package := basicName copyUpToLast: $-.
    (package includes: $.)
        ifFalse: [ branch := '' ]
        ifTrue: [ 
            branch := '.' , (package copyAfter: $.).
            package := package copyUpTo: $. ].
    author := (basicName copyAfterLast: $-) copyUpToLast: $..
    versionNumber := (basicName copyAfterLast: $-) copyAfterLast: $..
    (versionNumber notEmpty and: [ versionNumber allSatisfy: [ :each | each isDigit ] ])
        ifTrue: [ versionNumber := versionNumber asNumber ]
        ifFalse: [ versionNumber := 0 ].
    packageName := package , branch.
    ^ {packageName.
    author.
    versionNumber.
    (packageName , extension)}! !

!MCFileTreeRepository class methodsFor: 'utility' stamp: 'dkh 2/29/2012 09:40:37'!
parseName: aString
    ^ self parseName: aString extension: self defaultPackageExtension! !

!MCFileTreeRepository class methodsFor: 'accessing' stamp: 'dkh 4/4/2012 14:36'!
defaultPackageExtension: aString
    ".tree and .pkg are the only two formats supported at the moment"

    "self defaultPackageExtension:'.package'"

    (#('.tree' '.pkg' '.package') includes: aString)
        ifFalse: [ self error: 'Unsupported package extension: ' , aString printString ].
    defaultPackageExtension := aString! !

!MCFileTreeRepository class methodsFor: 'accessing' stamp: 'dkh 4/4/2012 14:27'!
defaultPackageExtension
    ".tree, .pkg, .package are the only formats supported at the moment:
	.tree         - original structure
	.pkg          - snapshot structure
	.package - cypress structure"

    defaultPackageExtension
        ifNil: [ 
            defaultPackageExtension := MCFileTreePackageStructureStWriter useCypressWriter
                ifTrue: [ '.package' ]
                ifFalse: [ '.pkg' ] ].
    ^ defaultPackageExtension! !

!MCFileTreeStCypressReader commentStamp: 'TorstenBergmann 2/20/2014 15:57'!
Reader for Cypress format

see https://github.com/CampSmalltalk/Cypress!
!MCFileTreeStCypressReader methodsFor: 'utilities' stamp: 'dkh 8/10/2012 14:00'!
addExtensionClassAndMethodDefinitionsFromEntry: classEntry
    | classDirectory classPropertiesDict methodPropertiesDict entries |
    classDirectory := self fileUtils directoryFromEntry: classEntry.
    ((entries := classDirectory entries) detect: [ :entry | self isPropertyFile: entry] ifNone: [  ])
        ifNotNil: [ :propertyEntry | propertyEntry readStreamDo: [ :fileStream | classPropertiesDict := MCFileTreeJsonParser parseStream: fileStream ] ].
    methodPropertiesDict := Dictionary new.
    (entries detect: [ :entry | self isMethodPropertyFile: entry] ifNone: [  ])
        ifNotNil: [ :propertyEntry | 
            propertyEntry
                readStreamDo: [ :fileStream | 
                    "Issue 33: https://github.com/dalehenrich/filetree/issues/33"
                    methodPropertiesDict := MCFileTreeJsonParser parseStream: fileStream ] ].
    self
        addMethodDefinitionsForClass: (classPropertiesDict at: 'name')
        methodProperties: methodPropertiesDict
        in: entries! !

!MCFileTreeStCypressReader methodsFor: 'accessing' stamp: 'dkh 6/27/2012 20:19'!
basicVersion
    self hasMonticelloMetadata
        ifTrue: [ ^ super basicVersion ].
    ^ MCVersion new
        setPackage: self package
            info: self info
            snapshot: self snapshot
            dependencies: #();
        yourself! !

!MCFileTreeStCypressReader methodsFor: 'utilities' stamp: 'topa 7/22/2013 14:41'!
addTraitAndMethodDefinitionsFromEntry: classEntry
    | classDirectory classPropertiesDict classComment entries methodPropertiesDict |
    classDirectory := self fileUtils directoryFromEntry: classEntry.
    ((entries := classDirectory entries) detect: [:entry | self isPropertyFile: entry] ifNone: [  ])
        ifNotNil: [ :propertyEntry | propertyEntry readStreamDo: [ :fileStream | classPropertiesDict := MCFileTreeJsonParser parseStream: fileStream ] ].
    (entries detect: [ :entry | entry name = 'README.md' ] ifNone: [  ])
        ifNotNil: [ :commentEntry | commentEntry readStreamDo: [ :fileStream | classComment := fileStream contents ] ]
        ifNil: [ classComment := '' ].
    methodPropertiesDict := Dictionary new.
    (entries detect: [ :entry | self isMethodPropertyFile: entry] ifNone: [  ])
        ifNotNil: [ :propertyEntry | 
            propertyEntry
                readStreamDo: [ :fileStream | 
                    "Issue 33: https://github.com/dalehenrich/filetree/issues/33"
                    methodPropertiesDict := MCFileTreeJsonParser parseStream: fileStream ] ].
    self addTraitDefinitionFrom: classPropertiesDict comment: classComment withSqueakLineEndings.
    self
        addMethodDefinitionsForClass: (classPropertiesDict at: 'name')
        methodProperties: methodPropertiesDict
        in: entries! !

!MCFileTreeStCypressReader methodsFor: 'utilities' stamp: 'dkh 8/10/2012 13:48'!
addClassAndMethodDefinitionsFromEntry: classEntry
    | classDirectory classPropertiesDict classComment entries methodPropertiesDict |
    classDirectory := self fileUtils directoryFromEntry: classEntry.
    ((entries := classDirectory entries) detect: [:entry | self isPropertyFile: entry] ifNone: [  ])
        ifNotNil: [ :propertyEntry | propertyEntry readStreamDo: [ :fileStream | classPropertiesDict := MCFileTreeJsonParser parseStream: fileStream ] ].
    (entries detect: [ :entry | entry name = 'README.md' ] ifNone: [  ])
        ifNotNil: [ :commentEntry | commentEntry readStreamDo: [ :fileStream | classComment := fileStream contents ] ].
    methodPropertiesDict := Dictionary new.
    (entries detect: [ :entry | self isMethodPropertyFile: entry] ifNone: [  ])
        ifNotNil: [ :propertyEntry | 
            propertyEntry
                readStreamDo: [ :fileStream | 
                    "Issue 33: https://github.com/dalehenrich/filetree/issues/33"
                    methodPropertiesDict := MCFileTreeJsonParser parseStream: fileStream ] ].
    self addClassDefinitionFrom: classPropertiesDict comment: classComment withSqueakLineEndings.
    self
        addMethodDefinitionsForClass: (classPropertiesDict at: 'name')
        methodProperties: methodPropertiesDict
        in: entries! !

!MCFileTreeStCypressReader methodsFor: 'private' stamp: 'dkh 6/16/2013 12:47:20'!
isPropertyFile: entry
	^ entry name = 'properties.ston' or: [ entry name = 'properties.json']! !

!MCFileTreeStCypressReader methodsFor: 'utilities' stamp: 'ChristopheDemarey 5/31/2013 23:28'!
methodSelectorFor: source
    ^ Object compilerClass new parseSelector: source
! !

!MCFileTreeStCypressReader methodsFor: 'utilities' stamp: 'topa 7/22/2013 15:15'!
addTraitDefinitionFrom: traitPropertiesDict comment: traitComment
    definitions
        add:
            (MCTraitDefinition
                name: (traitPropertiesDict at: 'name')
                traitComposition: (traitPropertiesDict at: 'traitcomposition' ifAbsent: [ '{}' ])
                category: (traitPropertiesDict at: 'category' ifAbsent: [ self packageNameFromPackageDirectory ])
                comment: traitComment
                commentStamp: (traitPropertiesDict at: 'commentStamp' ifAbsent: [ '' ])).
    traitPropertiesDict at: 'classtraitcomposition' ifPresent: [:classTraitComposition |
        definitions
             add:
                (MCClassTraitDefinition
                    baseTraitName: (traitPropertiesDict at: 'name')
                    classTraitComposition: classTraitComposition)].! !

!MCFileTreeStCypressReader methodsFor: 'utilities' stamp: 'dkh 6/27/2012 14:18'!
addClassDefinitionFrom: classPropertiesDict comment: classComment
    definitions
        add:
            (MCClassDefinition
                name: (classPropertiesDict at: 'name')
                superclassName: (classPropertiesDict at: 'super')
                traitComposition: (classPropertiesDict at: 'traitcomposition' ifAbsent: [ '{}' ])
                classTraitComposition: (classPropertiesDict at: 'classtraitcomposition' ifAbsent: [ '{}' ])
                category: (classPropertiesDict at: 'category' ifAbsent: [ self packageNameFromPackageDirectory ])
                instVarNames: (classPropertiesDict at: 'instvars' ifAbsent: [ #() ])
                classVarNames: (classPropertiesDict at: 'classvars' ifAbsent: [ #() ])
                poolDictionaryNames: (classPropertiesDict at: 'pools' ifAbsent: [ #() ])
                classInstVarNames: (classPropertiesDict at: 'classinstvars' ifAbsent: [ #() ])
                type: (classPropertiesDict at: 'type' ifAbsent: [ 'normal' ]) asSymbol
                comment: classComment
                commentStamp: (classPropertiesDict at: 'commentStamp' ifAbsent: [ '' ]))! !

!MCFileTreeStCypressReader methodsFor: 'utilities' stamp: 'dkh 8/10/2012 14:01'!
addMethodDefinitionsForClass: className methodProperties: methodProperties in: entries
    entries
        do: [ :entry | 
            | classIsMeta |
            classIsMeta := false.
            entry name = 'class'
                ifTrue: [ classIsMeta := true ].
            (entry name = 'instance' or: [ entry name = 'class' ])
                ifTrue: [ 
                    ((self fileUtils directoryFromEntry: entry) entries select: [ :each | each name endsWith: '.st' ])
                        do: [ :methodEntry | 
                            methodEntry
                                readStreamDo: [ :fileStream | 
                                    | category source timestamp selector |
                                    category := fileStream nextLine.
                                    source := fileStream upToEnd.
                                    selector := self methodSelectorFor: source.
                                    timestamp := methodProperties
                                        at:
                                            (classIsMeta
                                                ifTrue: [ 'class' ]
                                                ifFalse: [ 'instance' ])
                                        ifPresent: [ :map | map at: selector asString ifAbsent: [  ] ].	"Issue 33: https://github.com/dalehenrich/filetree/issues/33"
                                    timestamp
                                        ifNil: [ timestamp := self info author , ' ' , self info date mmddyyyy , ' ' , self info time print24 ].
                                    definitions
                                        add:
                                            (MCMethodDefinition
                                                className: className
                                                classIsMeta: classIsMeta
                                                selector: selector
                                                category: category
                                                timeStamp: timestamp
                                                source: source) ] ] ] ]! !

!MCFileTreeStCypressReader methodsFor: 'utilities' stamp: 'topa 7/22/2013 01:41'!
addClassAndMethodDefinitionsFromDirectory: aDirectory
    aDirectory entries
        do: [ :entry | 
            (entry name endsWith: '.trait')
                ifTrue: [ self addTraitAndMethodDefinitionsFromEntry: entry ].
            (entry name endsWith: '.class')
                ifTrue: [ self addClassAndMethodDefinitionsFromEntry: entry ].
            (entry name endsWith: '.extension')
                ifTrue: [ self addExtensionClassAndMethodDefinitionsFromEntry: entry ] ]! !

!MCFileTreeStCypressReader methodsFor: 'accessing' stamp: 'dkh 8/10/2012 14:55'!
packageNameFromPackageDirectory
    | filename |
    filename := self fileUtils directoryName: packageDirectory.
    ^ filename copyFrom: 1 to: (filename lastIndexOf: $.) - 1! !

!MCFileTreeStCypressReader methodsFor: 'accessing' stamp: '08/08/2013 15:01'!
loadVersionInfo
  self hasMonticelloMetadata
    ifTrue: [ ^ info := self extractInfoFrom: (self parseMember: 'version') ].
  info := MCVersionInfo
    name: self packageNameFromPackageDirectory , '-cypress.1'
    id: UUID new
    message: 'fabricated from a Cypress format repository'
    date: Date today
    time: Time now
    author: ''
    ancestors: #()
    stepChildren: #()
! !

!MCFileTreeStCypressReader methodsFor: 'accessing' stamp: 'dkh 6/27/2012 20:21'!
loadPackage
    self hasMonticelloMetadata
        ifTrue: [ ^ super loadPackage ].
    package := MCPackage named: self packageNameFromPackageDirectory! !

!MCFileTreeStCypressReader methodsFor: 'utilities' stamp: 'dkh 5/23/2013 21:05'!
loadDefinitions
    | entries directory |
    definitions := OrderedCollection new.
    directory := self fileUtils directoryFromPath: self monticelloMetaDirName relativeTo: packageDirectory.
    (self fileUtils directoryExists: directory)
        ifTrue: [ 
            		entries := directory entries.
            		self
                			addDefinitionFromFile: (entries detect: [ :entry | entry name beginsWith: 'categories' ] ifNone: [  ])
                			inDirectory: directory ]
	ifFalse: [definitions add: (MCOrganizationDefinition categories: {self packageNameFromPackageDirectory }) ].
    self addClassAndMethodDefinitionsFromDirectory: packageDirectory.
    (self fileUtils directoryExists: directory)
        ifTrue: [ 
            self
                addDefinitionFromFile: (entries detect: [ :entry | entry name beginsWith: 'initializers' ] ifNone: [  ])
                inDirectory: directory ]! !

!MCFileTreeStCypressReader methodsFor: 'private' stamp: 'dkh 6/16/2013 12:47:20'!
isMethodPropertyFile: entry
	^ entry name = 'methodProperties.ston' or: [ entry name = 'methodProperties.json']! !

!MCFileTreeStCypressReader class methodsFor: 'accessing' stamp: 'dkh 4/4/2012 14:19'!
extension
    ^ 'package'! !

!MCFileTreeStCypressReader class methodsFor: 'accessing' stamp: 'dkh 4/4/2012 17:44'!
monticelloMetaDirName
    ^ MCFileTreeStCypressWriter monticelloMetaDirName! !

!MCFileTreeStCypressWriter commentStamp: 'TorstenBergmann 2/20/2014 15:57'!
Writer for Cypress format 

see https://github.com/CampSmalltalk/Cypress!
!MCFileTreeStCypressWriter methodsFor: 'writing' stamp: 'dkh 07/07/2013 22:13'!
writeClassDefinition: definition to: classPath
  self
    writeInDirectoryName: classPath
    fileName: 'README'
    extension: '.md'
    visit: [ self writeClassComment: definition ].
  self
    writeInDirectoryName: classPath
    fileName: 'properties'
    extension: self propertyFileExtension
    visit: [ self writeClassDefinition: definition ].
  self
    writeInDirectoryName: classPath
    fileName: 'methodProperties'
    extension: self propertyFileExtension
    visit: [ 
      self
        writeMethodProperties:
          (self methodDefinitions at: definition className ifAbsent: [ #() ]) ]! !

!MCFileTreeStCypressWriter methodsFor: 'initialize-release' stamp: '08/08/2013 16:08'!
writeDefinitions: aCollection
  | classDirExtension extensionClasses extensionMethodDefinitions extensionMethodMap methodHolders |
  self writeBasicDefinitions: aCollection.
  extensionClasses := OrderedCollection new.
  extensionMethodDefinitions := OrderedCollection new.
  methodHolders := self classDefinitions, self traitDefinitions.
  self methodDefinitions
    keysAndValuesDo: [ :className :extensionMethods | 
      methodHolders
        at: className
        ifAbsent: [ 
          extensionClasses add: className.
          extensionMethodDefinitions addAll: extensionMethods ] ].
  extensionClasses
    do: [ :className | self methodDefinitions removeKey: className ].
    self writeMethodHolderDefinitions: self traitDefinitions extension: '.trait' to: '' do: [ :definition :classPath |
	self writeTraitDefinition: definition to: classPath. ].
  self
    writeMethodHolderDefinitions: self classDefinitions
    extension: '.class'
    to: ''
    do: [ :definition :classPath | self writeClassDefinition: definition to: classPath ].
  classDirExtension := '.extension'.
  extensionMethodMap := Dictionary new.
  extensionMethodDefinitions
    do: [ :methodDefinition | 
      | classPath methodPath |
      (extensionMethodMap
        at: methodDefinition className
        ifAbsent: [ extensionMethodMap at: methodDefinition className put: OrderedCollection new ])
        add: methodDefinition.
      classPath := methodDefinition className , classDirExtension
        , self fileUtils pathNameDelimiter asString.
      self writeExtensionClassDefinition: methodDefinition to: classPath ].
  extensionMethodMap
    keysAndValuesDo: [ :className :classMethodDefinitions | 
      | classPath filenameMetaMap |
      filenameMetaMap := self fileNameMapFor: classMethodDefinitions.
      classMethodDefinitions
        do: [ :methodDefinition | 
          | filename methodPath |
          filename := (filenameMetaMap at: methodDefinition classIsMeta)
            at: methodDefinition selector.
          classPath := methodDefinition className , classDirExtension
            , self fileUtils pathNameDelimiter asString.
          methodPath := classPath
            ,
              (methodDefinition classIsMeta
                ifTrue: [ 'class' ]
                ifFalse: [ 'instance' ])
            , self fileUtils pathNameDelimiter asString.
          self
            writeMethodDefinition: methodDefinition
            to: methodPath
            filename: filename ].
      classPath := className , classDirExtension
        , self fileUtils pathNameDelimiter asString.
      self
        writeInDirectoryName: classPath
        fileName: 'methodProperties'
        extension: self propertyFileExtension
        visit: [ self writeMethodProperties: classMethodDefinitions ] ]
! !

!MCFileTreeStCypressWriter methodsFor: 'writing' stamp: 'dkh 07/18/2013 16:34'!
writeMethodDefinition: methodDefinition to: methodPath filename: filename
  self
    writeInDirectoryName: methodPath
    fileName: filename
    extension: '.st'
    visit: [ self writeMethodDefinition: methodDefinition ]! !

!MCFileTreeStCypressWriter methodsFor: 'initialize-release' stamp: 'dkh 07/07/2013 22:14'!
writePropertiesFile
  | properties |
  properties := Dictionary new.
  properties at: 'noMethodMetaData' put: true.
  properties at: 'separateMethodMetaAndSource' put: false.
  properties at: 'useCypressPropertiesFile' put: true.
  self
    writeInDirectoryName: '.'
    fileName: ''
    extension: '.filetree'
    visit: [ properties writeCypressJsonOn: fileStream ].
  self
    writeInDirectoryName: '.'
    fileName: 'properties'
    extension: self propertyFileExtension
    visit: [ Dictionary new writeCypressJsonOn: fileStream ]! !

!MCFileTreeStCypressWriter methodsFor: 'private' stamp: 'ChristopheDemarey 8/28/2013 13:50'!
fileNameMapFor: aMethodDefinitionCollection
  "https://github.com/dalehenrich/filetree/issues/92"

  "answer a dictionary that maps each definition selector to a filename that is guaranteed unique on case insensitive file systems.
  Segregate instance and class side methods. Key is true for class method map, false for instance method map"

  | map filenameMetaMap |
  map := Dictionary new.
  aMethodDefinitionCollection
    do: [ :mDef | 
      | sel col metaKey methMap |
      "sort into bins by lowercase selector. "
      metaKey := mDef classIsMeta.
      methMap := map
        at: metaKey
        ifAbsent: [ map at: metaKey put: Dictionary new ].
      sel := mDef selector asLowercase.
      col := methMap
        at: sel
        ifAbsent: [ methMap at: sel put: OrderedCollection new ].
      col add: mDef ].
  filenameMetaMap := Dictionary new.
  map
    keysAndValuesDo: [ :metaKey :methMap | 
      | filenameMap |
      filenameMap := filenameMetaMap
        at: metaKey
        ifAbsent: [ filenameMetaMap at: metaKey put: Dictionary new ].
      methMap values
        do: [ :col | 
          | selector sortedCol |
          col size = 1
            ifTrue: [ 
              | def |
              "no need to distinguish filename"
              def := col at: 1.
              filenameMap
                at: def selector
                put: (self fileNameForSelector: def selector) ]
            ifFalse: [ 
              "tack on postfix to guarantee  file names are uniique on case insensitive file systems"
              sortedCol := col sorted: [ :a :b | a name <= b name ].
              (1 to: sortedCol size) do: [ :index | 
                | def filename |
                def := sortedCol at: index.
                filename := self fileNameForSelector: def selector.
                filename := filename , '..' , index printString.
                filenameMap at: def selector put: filename ] ] ] ].
  ^ filenameMetaMap! !

!MCFileTreeStCypressWriter methodsFor: 'writing' stamp: 'dkh 03/22/2013 11:30'!
writeClassComment: definition
    fileStream nextPutAll: definition comment withUnixLineEndings! !

!MCFileTreeStCypressWriter methodsFor: 'writing' stamp: 'dkh 07/18/2013 17:01'!
writeMethodDefinition: methodDefinition to: methodPath
  self shouldNotImplement! !

!MCFileTreeStCypressWriter methodsFor: 'initialize-release' stamp: 'dkh 07/07/2013 22:15'!
propertyFileExtension
  ^ self repository propertyFileExtension! !

!MCFileTreeStCypressWriter methodsFor: 'private' stamp: 'dkh 4/4/2012 14:01'!
setFileStream: aStream
    super setFileStream: aStream.
    fileStream := aStream! !

!MCFileTreeStCypressWriter methodsFor: 'writing' stamp: 'dkh 03/22/2013 11:30'!
writeMethodDefinition: definition
    fileStream
        nextPutAll: definition category;
        lf;
        nextPutAll: definition source withUnixLineEndings! !

!MCFileTreeStCypressWriter methodsFor: 'writing' stamp: 'dkh 03/22/2013 13:51'!
writeClassDefinition: definition
    | properties |
    properties := Dictionary new.
    properties at: 'name' put: definition className.
    properties at: 'super' put: definition superclassName.
    definition traitCompositionString
        ifNotNil: [ :property | 
            "Issue #48: https://github.com/dalehenrich/filetree/issues/48"
            property ~= '{}'
                ifTrue: [ properties at: 'traitcomposition' put: property ] ].
    definition classTraitCompositionString
        ifNotNil: [ :property | 
            "Issue #48: https://github.com/dalehenrich/filetree/issues/48"
            property ~= '{}'
                ifTrue: [ properties at: 'classtraitcomposition' put: property ] ].
    properties at: 'category' put: definition category.
    properties at: 'instvars' put: definition instVarNames asArray.
    properties at: 'classvars' put: definition classVarNames asArray.
    properties at: 'pools' put: definition poolDictionaries asArray.
    properties at: 'classinstvars' put: definition classInstVarNames asArray.
    properties at: 'type' put: definition type asString.
    properties at: 'commentStamp' put: definition commentStamp.
    properties writeCypressJsonOn: fileStream! !

!MCFileTreeStCypressWriter methodsFor: 'writing' stamp: 'dkh 07/07/2013 22:14'!
writeExtensionClassDefinition: definition to: classPath
  self
    writeInDirectoryName: classPath
    fileName: 'properties'
    extension: self propertyFileExtension
    visit: [ self writeExtensionClassDefinition: definition ]! !

!MCFileTreeStCypressWriter methodsFor: 'private' stamp: 'dkh 02/13/2013 17:04'!
fileNameForSelector: selector
  ^ selector last = $:
    ifTrue: [ 
      selector
        collect: [ :each | 
          each = $:
            ifTrue: [ $. ]
            ifFalse: [ each ] ] ]
    ifFalse: [ 
      (self class specials includes: selector first)
        ifFalse: [ selector ]
        ifTrue: [ 
          | output specials |
          specials := self class specials.
          output := String new writeStream.
          output nextPut: $^.
          selector
            do: [ :each | 
              output
                nextPutAll:
                  ((specials includes: each)
                    ifTrue: [ specials at: each ]
                    ifFalse: [ each asString ]) ]
            separatedBy: [ output nextPut: $. ].
          output contents ] ]! !

!MCFileTreeStCypressWriter methodsFor: 'initialize-release' stamp: 'dkh 6/12/2012 17:33:23'!
writeMethodProperties: classMethodDefinitions
    "Issue 33: https://github.com/dalehenrich/filetree/issues/33"

    | properties classMethodsMap instanceMethodMap |
    properties := Dictionary new.
    properties at: 'class' put: (classMethodsMap := Dictionary new).
    properties at: 'instance' put: (instanceMethodMap := Dictionary new).
    classMethodDefinitions
        do: [ :methodDefinition | 
            (methodDefinition classIsMeta
                ifTrue: [ classMethodsMap ]
                ifFalse: [ instanceMethodMap ]) at: methodDefinition selector asString put: methodDefinition timeStamp ].
    properties writeCypressJsonOn: fileStream! !

!MCFileTreeStCypressWriter methodsFor: 'writing' stamp: 'dkh 4/4/2012 17:52'!
writeExtensionClassDefinition: definition
    | properties |
    properties := Dictionary new.
    properties at: 'name' put: definition className.
    properties writeCypressJsonOn: fileStream! !

!MCFileTreeStCypressWriter methodsFor: 'writing' stamp: 'topa 7/22/2013 14:54'!
writeTraitDefinition: definition
    | properties compositionString |
    properties := Dictionary new.
    properties at: 'name' put: definition className.
    definition traitCompositionString
        ifNotNil: [ :property | 
            property ~= '{}'
                ifTrue: [ properties at: 'traitcomposition' put: property ] ].
    " handle the classTrait case "
    compositionString := self classTraitDefinitions at: definition className ifPresent: [:classTraitDefinition |
	classTraitDefinition classTraitCompositionString ].
    compositionString ifNil: [ compositionString := definition classTraitCompositionString ].
    compositionString~= '{}'
                ifTrue: [ properties at: 'classtraitcomposition' put: compositionString ] .
    properties at: 'category' put: definition category.
    properties at: 'commentStamp' put: definition commentStamp.
    properties writeCypressJsonOn: fileStream! !

!MCFileTreeStCypressWriter methodsFor: 'writing' stamp: 'topa 7/22/2013 14:47'!
writeTraitDefinition: definition to: classPath
  self
    writeInDirectoryName: classPath
    fileName: 'README'
    extension: '.md'
    visit: [ self writeClassComment: definition ].
  self
    writeInDirectoryName: classPath
    fileName: 'properties'
    extension: self propertyFileExtension
    visit: [ self writeTraitDefinition: definition ].
  self
    writeInDirectoryName: classPath
    fileName: 'methodProperties'
    extension: self propertyFileExtension
    visit: [ 
      self
        writeMethodProperties:
          (self methodDefinitions at: definition className ifAbsent: [ #() ]) ]! !

!MCFileTreeStCypressWriter class methodsFor: 'accessing' stamp: 'dkh 4/4/2012 11:27'!
specials
    ^ specials ifNil: [ specials := self initializeSpecials ]! !

!MCFileTreeStCypressWriter class methodsFor: 'accessing' stamp: 'dkh 4/4/2012 15:05'!
monticelloMetaDirName
    ^ 'monticello.meta'! !

!MCFileTreeStCypressWriter class methodsFor: 'initialization' stamp: 'dkh 07/07/2013 15:42:23'!
initialize
    "self initialize"

    "force initialization of specials ..."

    specials := nil! !

!MCFileTreeStCypressWriter class methodsFor: 'private' stamp: 'PeterMcLain 10/02/2012 14:47'!
initializeSpecials
    | map |
    map := Dictionary new.
    map
        at: $+ put: 'plus';
        at: $- put: 'minus';
        at: $= put: 'equals';
        at: $< put: 'less';
        at: $> put: 'more';
        at: $% put: 'percent';
        at: $& put: 'and';
        at: $| put: 'pipe';
        at: $* put: 'star';
        at: $/ put: 'slash';
        at: $\ put: 'backslash';
        at: $~ put: 'tilde';
        at: $? put: 'wat';
        at: $, put: 'comma';
        at: $@ put: 'at'.
    map keys do: [ :key | map at: (map at: key) put: key ].
    ^ map
! !

!MCFileTreeStReader commentStamp: 'TorstenBergmann 2/20/2014 15:58'!
A reader for Smalltalk code!
!MCFileTreeStReader methodsFor: 'utilities' stamp: 'dkh 3/1/2012 12:18'!
addClassAndMethodDefinitionsFromDirectory: aDirectory
    self addClassAndMethodDefinitionsFromDirectoryEntries: aDirectory entries! !

!MCFileTreeStReader class methodsFor: 'accessing' stamp: 'dkh 3/1/2012 12:04'!
extension
	^ 'tree'! !

!MCFileTreeStSnapshotReader commentStamp: 'TorstenBergmann 2/20/2014 15:55'!
Snapshot reader!
!MCFileTreeStSnapshotReader methodsFor: 'utilities' stamp: 'dkh 8/10/2012 14:03'!
addClassAndMethodDefinitionsFromDirectory: aDirectory
    | snapshot classes entries extensions |
    snapshot := self fileUtils directoryFromPath: 'snapshot' relativeTo: aDirectory.
    classes := self fileUtils directoryFromPath: 'classes' relativeTo: snapshot.
    (self fileUtils directoryExists: classes)
        ifTrue: [ 
            self addClassAndMethodDefinitionsFromDirectoryEntries: (entries := classes entries).	"load .st files from subdirectories (*.class) of snapshot/classes ... class defintions"
            entries
                do: [ :classDirectoryEntry | 
                    | classDirectory |
                    classDirectory := self fileUtils directoryFromEntry: classDirectoryEntry.
                    self addClassAndMethodDefinitionsFromDirectoryEntries: classDirectory entries	"load .st files from subdirectories (class or instance) of snapshot/classes/*.class ... method definitions" ] ].
    extensions := self fileUtils directoryFromPath: 'extensions' relativeTo: snapshot.
    (self fileUtils directoryExists: extensions)
        ifTrue: [ 
            extensions entries
                do: [ :classDirectoryEntry | 
                    | classDirectory |
                    classDirectory := self fileUtils directoryFromEntry: classDirectoryEntry.
                    self addClassAndMethodDefinitionsFromDirectoryEntries: classDirectory entries	"load .st files from subdirectories (class or instance) of snapshot/extensions/*.class ... method definitions" ] ]! !

!MCFileTreeStSnapshotReader class methodsFor: 'accessing' stamp: 'dkh 3/1/2012 12:06'!
extension
    ^ 'pkg'! !

!MCFileTreeStSnapshotWriter commentStamp: 'TorstenBergmann 2/20/2014 15:57'!
Snapshot writer!
!MCFileTreeStSnapshotWriter methodsFor: 'accessing' stamp: 'dkh 08/08/2013 19:02:56'!
classTraitDefinitions
    classTraitDefinitions ifNil: [ classTraitDefinitions := Dictionary new ].
    ^ classTraitDefinitions! !

!MCFileTreeStSnapshotWriter methodsFor: 'visiting' stamp: 'dkh 4/5/2012 11:15:15'!
visitClassDefinition: definition
    orderedClassNames add: definition className.
    self classDefinitions at: definition className put: definition! !

!MCFileTreeStSnapshotWriter methodsFor: 'writing' stamp: 'dkh 4/5/2012 11:15:15'!
writeClassDefinition: definition to: classPath
    self
        writeInDirectoryName: classPath
        fileName: definition className
        extension: '.st'
        visit: [ self writeClassDefinition: definition ]! !

!MCFileTreeStSnapshotWriter methodsFor: 'initialize-release' stamp: 'dkh 08/08/2013 18:34'!
writeDefinitions: aCollection
  | basePath extensionClasses extensionMethodDefinitions methodHolders |
  self writeBasicDefinitions: aCollection.
  basePath := 'snapshot' , self fileUtils pathNameDelimiter asString , 'classes'
    , self fileUtils pathNameDelimiter asString.
  extensionClasses := OrderedCollection new.
  extensionMethodDefinitions := OrderedCollection new.
  methodHolders := self classDefinitions, self traitDefinitions.
  self methodDefinitions
    keysAndValuesDo: [ :className :extensionMethods | 
      methodHolders
        at: className
        ifAbsent: [ 
          extensionClasses add: className.
          extensionMethodDefinitions addAll: extensionMethods ] ].
  extensionClasses
    do: [ :className | self methodDefinitions removeKey: className ].
    self writeMethodHolderDefinitions: self traitDefinitions extension: '.trait' to: basePath do: [ :definition :classPath |
	self writeTraitDefinition: definition to: classPath.
	self classTraitDefinitions at: definition className ifPresent: [:classTraitDefinition |
		self writeClassTraitDefinition: classTraitDefinition to: classPath ] ].
  self
    writeMethodHolderDefinitions: self classDefinitions
    extension: '.class'
    to: basePath
    do: [ :definition :classPath | self writeClassDefinition: definition to: classPath ].
  basePath := 'snapshot' , self fileUtils pathNameDelimiter asString
    , 'extensions' , self fileUtils pathNameDelimiter asString.
  extensionMethodDefinitions
    do: [ :methodDefinition | 
      | methodPath |
      methodPath := basePath , methodDefinition className , '.class'
        , self fileUtils pathNameDelimiter asString
        ,
          (methodDefinition classIsMeta
            ifTrue: [ 'class' ]
            ifFalse: [ 'instance' ])
        , self fileUtils pathNameDelimiter asString.
      self writeMethodDefinition: methodDefinition to: methodPath ]
! !

!MCFileTreeStSnapshotWriter methodsFor: 'as yet unclassified' stamp: 'topa 7/22/2013 13:54'!
writeMethodHolderDefinitions: aCollection extension: extension to: basePath do: aBlock
  aCollection
    keysAndValuesDo: [ :className :definition | 
      | classPath instanceMethodPath classMethodPath filenameMetaMap theMethodDefinitions |
      classPath := basePath , definition className , extension
        , self fileUtils pathNameDelimiter asString.
      aBlock value: definition value: classPath.
      instanceMethodPath := classPath , 'instance'
        , self fileUtils pathNameDelimiter asString.
      classMethodPath := classPath , 'class'
        , self fileUtils pathNameDelimiter asString.
      theMethodDefinitions := self methodDefinitions
        at: className
        ifAbsent: [ #() ].
      filenameMetaMap := self fileNameMapFor: theMethodDefinitions.
      theMethodDefinitions
        do: [ :methodDefinition | 
          | filename |
          filename := (filenameMetaMap at: methodDefinition classIsMeta)
            at: methodDefinition selector.
          methodDefinition classIsMeta
            ifTrue: [ 
              self
                writeMethodDefinition: methodDefinition
                to: classMethodPath
                filename: filename ]
            ifFalse: [ 
              self
                writeMethodDefinition: methodDefinition
                to: instanceMethodPath
                filename: filename ] ] ]
! !

!MCFileTreeStSnapshotWriter methodsFor: 'visiting' stamp: 'dkh 4/5/2012 11:15:15'!
visitMethodDefinition: definition
    (self methodDefinitions
        at: definition className
        ifAbsent: [ self methodDefinitions at: definition className put: OrderedCollection new ]) add: definition! !

!MCFileTreeStSnapshotWriter methodsFor: 'writing' stamp: 'dkh 4/5/2012 11:15:15'!
writeMethodDefinition: methodDefinition to: methodPath
    | filename |
    filename := self fileNameForSelector: methodDefinition selector.
    self
        writeInDirectoryName: methodPath
        fileName: filename
        extension: '.st'
        visit: [ self writeMethodDefinition: methodDefinition ]! !

!MCFileTreeStSnapshotWriter methodsFor: 'accessing' stamp: 'dkh 08/08/2013 19:02:56'!
traitDefinitions
    traitDefinitions ifNil: [ traitDefinitions := Dictionary new ].
    ^ traitDefinitions! !

!MCFileTreeStSnapshotWriter methodsFor: 'writing' stamp: 'dkh 08/08/2013 19:02:56'!
writeClassTraitDefinition: definition to: traitPath
    self
        writeInDirectoryName: traitPath
        fileName: definition className, '_classTrait'
        extension: '.st'
        visit: [ self writeClassTraitDefinition: definition ]! !

!MCFileTreeStSnapshotWriter methodsFor: 'visiting' stamp: 'dkh 08/08/2013 19:02:56'!
visitTraitDefinition: definition
    orderedTraitNames add: definition className.
    self traitDefinitions at: definition className put: definition! !

!MCFileTreeStSnapshotWriter methodsFor: 'accessing' stamp: 'dkh 4/5/2012 11:15:15'!
methodDefinitions
    methodDefinitions ifNil: [ methodDefinitions := Dictionary new ].
    ^ methodDefinitions! !

!MCFileTreeStSnapshotWriter methodsFor: 'visiting' stamp: 'dkh 08/08/2013 19:02:56'!
visitClassTraitDefinition: definition
    orderedTraitNames add: definition className, ' classTrait'.
    self classTraitDefinitions at: definition className put: definition! !

!MCFileTreeStSnapshotWriter methodsFor: 'accessing' stamp: 'dkh 4/5/2012 11:15:15'!
classDefinitions
    classDefinitions ifNil: [ classDefinitions := Dictionary new ].
    ^ classDefinitions! !

!MCFileTreeStSnapshotWriter methodsFor: 'writing' stamp: 'dkh 08/08/2013 19:02:56'!
writeTraitDefinition: definition to: traitPath
    self
        writeInDirectoryName: traitPath
        fileName: definition className
        extension: '.st'
        visit: [ self writeTraitDefinition: definition ]! !

!MCFileTreeStWriter commentStamp: 'TorstenBergmann 2/20/2014 15:58'!
A writer for Smalltalk code!
!MCFileTreeStWriter methodsFor: 'visiting' stamp: 'dkh 2/29/2012 14:55'!
visitMethodDefinition: definition
    | filename directoryname |
    directoryname := definition classIsMeta
        ifTrue: [ definition className , '_class' ]
        ifFalse: [ definition className ].
    filename := self fileNameForSelector: definition selector.
    self
        writeInDirectoryName: directoryname
        fileName: filename
        extension: '.st'
        visit: [ self writeMethodDefinition: definition ]! !

!MCFileTreeStWriter methodsFor: 'visiting' stamp: 'dkh 2/29/2012 14:52'!
visitClassDefinition: definition
    orderedClassNames add: definition className.
    self
        writeInDirectoryName: definition className
        fileName: definition className
        extension: '.st'
        visit: [ self writeClassDefinition: definition ]! !

!MCFileTreeStWriter methodsFor: 'visiting' stamp: 'topa 7/22/2013 13:36'!
visitClassTraitDefinition: definition
    orderedTraitNames add: definition className, ' classTrait'.
    self
        writeInDirectoryName: definition className
        fileName: definition className, '_classTrait'
        extension: '.st'
        visit: [ self writeClassTraitDefinition: definition ]! !

!MCFileTreeStWriter methodsFor: 'visiting' stamp: 'topa 7/22/2013 01:12'!
visitTraitDefinition: definition
    orderedTraitNames add: definition className.
    self
        writeInDirectoryName: definition className
        fileName: definition className
        extension: '.st'
        visit: [ self writeTraitDefinition: definition ]! !

!MCFileTreeVersionInfoWriter commentStamp: 'TorstenBergmann 2/20/2014 16:23'!
Write for the version info!
!MCFileTreeVersionInfoWriter methodsFor: 'serialization' stamp: 'dkh 5/23/2013 21:16'!
writeVersionInfo: aVersionInfo
	(self isWritten: aVersionInfo)
		ifTrue: [^ stream nextPutAll: '(id '; print: aVersionInfo id asString; nextPut: $) ].
	stream nextPut: $(.
	#(name message id date time author) do: [:sel | 
		stream 
			nextPutAll: sel; space;
			print: (((aVersionInfo perform: sel) ifNil: ['']) asString  ); space ].
	stream nextPutAll: 'ancestors ('.
	aVersionInfo ancestors do: [:ea | self writeVersionInfo: ea].
	stream nextPutAll: ') stepChildren ('.
	aVersionInfo stepChildren do: [:ea | self writeVersionInfo: ea].
	stream nextPutAll: '))'.
	
	self wrote: aVersionInfo! !

!MCFileTreeWriter commentStamp: 'TorstenBergmann 2/20/2014 16:23'!
Writer for the file tree!
!MCFileTreeWriter methodsFor: 'writing' stamp: 'dkh 8/10/2012 07:14'!
packageFileDirectory
    packageFileDirectory
        ifNil: [ packageFileDirectory := self fileUtils directoryFromPath: directory relativeTo: stream directory ].
    ^ packageFileDirectory! !

!MCFileTreeWriter methodsFor: 'visiting' stamp: 'dkh 2/16/2012 14:49:00'!
writeSnapshot: aSnapshot
	(self snapshotWriterClass on: self) writeDefinitions: aSnapshot definitions! !

!MCFileTreeWriter methodsFor: 'visiting' stamp: 'dkh 8/10/2012 14:01'!
initializePackageFileDirectoryCache
    cachedPackageFileDirectoryEntries := Dictionary new.
    self packageFileDirectory entries
        do: [ :entry | 
            entry isDirectory
                ifTrue: [ cachedPackageFileDirectoryEntries at: entry name put: (self fileUtils directoryFromEntry: entry) ] ]! !

!MCFileTreeWriter methodsFor: 'visiting' stamp: 'dkh 8/10/2012 14:51'!
writeVersion: aVersion
    | members |
    directory := (members := MCFileTreeRepository parseName: aVersion info name) last.
    self deleteExistingPackageStructureFor: members.
    self fileUtils ensureDirectoryExists: self packageFileDirectory.
    self initializePackageFileDirectoryCache.
    super writeVersion: aVersion! !

!MCFileTreeWriter methodsFor: 'writing' stamp: 'dkh 07/07/2013 22:10'!
repository
  ^ stream! !

!MCFileTreeWriter methodsFor: 'writing' stamp: 'dkh 8/10/2012 05:26'!
addString: string at: fileNameOrPath
    "fileNameOrPath may have one or two elements"

    | utils fullPath path |
    utils := MCFileTreeFileUtils current.
    path := MCFileTreePackageStructureStWriter useCypressWriter
        ifTrue: [ 
            fullPath := utils
                buildPathFrom:
                    {(MCFileTreeStCypressWriter monticelloMetaDirName).
                    fileNameOrPath}.
            utils ensureFilePathExists: fullPath relativeTo: self packageFileDirectory.
            fullPath ]
        ifFalse: [ fileNameOrPath ].
    string isEmpty
        ifFalse: [ utils writeStreamFor: path in: self packageFileDirectory do: [ :file | file nextPutAll: string ] ]! !

!MCFileTreeWriter methodsFor: 'visiting' stamp: 'dkh 8/10/2012 07:16'!
subPackageFileDirectoryFor: directoryNameOrPath
    ^ cachedPackageFileDirectoryEntries
        at: directoryNameOrPath
        ifAbsentPut: [ 
            | dir |
            dir := self fileUtils directoryFromPath: directoryNameOrPath relativeTo: self packageFileDirectory.
            self fileUtils ensureDirectoryExists: dir.
            dir ]! !

!MCFileTreeWriter methodsFor: 'visiting' stamp: 'dkh 8/10/2012 07:12'!
deleteExistingPackageStructureFor: members
    "destroy .tree and .pkg directory structure .. otherwise it won't be pretty"

    | alternateDirName alternateDir packageDirectoryName |
    (self fileUtils directoryExists: self packageFileDirectory)
        ifTrue: [ self fileUtils deleteAll: self packageFileDirectory ].
    packageDirectoryName := self fileUtils directoryName: self packageFileDirectory.
    alternateDirName := (packageDirectoryName endsWith: '.pkg')
        ifTrue: [ members first , '.tree' ]
        ifFalse: [ 
            (packageDirectoryName endsWith: '.tree')
                ifTrue: [ members first , '.pkg' ]
                ifFalse: [ 
                    (packageDirectoryName endsWith: '.package')
                        ifTrue: [ members first , '.pkg' ] ] ].
    alternateDirName
        ifNotNil: [ 
            alternateDir := self fileUtils directoryFromPath: alternateDirName relativeTo: stream directory.
            (self fileUtils directoryExists: alternateDir)
                ifTrue: [ self fileUtils deleteAll: alternateDir ] ]! !

!MCFileTreeWriter methodsFor: 'serializing' stamp: 'dkh 07/07/2013 15:42:23'!
serializeVersionInfo: aVersionInfo
	infoWriter ifNil: [infoWriter := MCFileTreeVersionInfoWriter new].
	^ String streamContents: [:s |
		infoWriter stream: s.
		infoWriter writeVersionInfo: aVersionInfo]! !

!MCFileTreeWriter methodsFor: 'writing' stamp: 'dkh 2/16/2012 14:49:00'!
flush
	! !

!MCFileTreeWriter methodsFor: 'accessing' stamp: 'dkh 2/29/2012 13:59'!
snapshotWriterClass
	^ MCFileTreeAbstractStWriter! !

!MCFileTreeWriter methodsFor: 'writing' stamp: 'ChristopheDemarey 8/21/2013 16:56'!
addString: string at: fileNameOrPath encodedTo: ignored
    "fileNameOrPath may have one or two elements"
    "encodeTo: arg, because FileTree uses UTF8 by default"

    | utils fullPath path |
    utils := MCFileTreeFileUtils current.
    path := MCFileTreePackageStructureStWriter useCypressWriter
        ifTrue: [ 
            fullPath := utils
                buildPathFrom:
                    {(MCFileTreeStCypressWriter monticelloMetaDirName).
                    fileNameOrPath}.
            utils ensureFilePathExists: fullPath relativeTo: self packageFileDirectory.
            fullPath ]
        ifFalse: [ fileNameOrPath ].
    string isEmpty
        ifFalse: [ utils writeStreamFor: path in: self packageFileDirectory do: [ :file | file nextPutAll: string ] ]! !

!MCFileTreeWriter methodsFor: 'accessing' stamp: 'dkh 8/10/2012 07:05'!
fileUtils
    ^ MCFileTreeFileUtils current! !

!MCFileTreeWriter class methodsFor: 'accessing' stamp: 'dkh 3/1/2012 13:09'!
readerClass
    "don't expect this message to be sent"

    self shouldNotImplement! !

!MCFilteredVersionSorter commentStamp: 'TorstenBergmann 2/6/2014 08:10'!
Sort filtered versions !
!MCFilteredVersionSorter methodsFor: 'adding' stamp: 'bf 5/28/2005 01:14'!
addVersionInfo: aVersionInfo
	(aVersionInfo hasAncestor: target)
		ifTrue: [super addVersionInfo: aVersionInfo]
! !

!MCFilteredVersionSorter methodsFor: 'private' stamp: 'MarianoMartinezPeck 12/25/2009 23:08'!
processVersionInfo: aVersionInfo
	| success |
	aVersionInfo = target ifTrue: [^ true].
	(aVersionInfo hasAncestor: target) ifFalse: [^false].
	self pushLayer.
	success := (self knownAncestorsOf: aVersionInfo) anySatisfy:
				[:ea | self processVersionInfo: ea].
	self popLayer.
	success ifTrue: [self addToCurrentLayer: aVersionInfo].
	^ success	! !

!MCFilteredVersionSorter methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
target: aVersionInfo
	target := aVersionInfo! !

!MCFrontier commentStamp: 'TorstenBergmann 2/5/2014 13:49'!
Utility class!
!MCFrontier methodsFor: 'initialization' stamp: 'avi 9/17/2005 22:11'!
frontier: f bag: remaining
	frontier := f asOrderedCollection.
	bag := remaining! !

!MCFrontier methodsFor: 'advancing' stamp: 'avi 9/17/2005 22:02'!
removeAll: collection
	collection do: [ :n | self remove: n]! !

!MCFrontier methodsFor: 'advancing' stamp: 'avi 9/17/2005 22:13'!
remove: aVersionInfo
	frontier remove: aVersionInfo.
	aVersionInfo ancestors  do:
		[ :ancestor |
			bag remove: ancestor.
			(bag occurrencesOf: ancestor) = 0
				ifTrue: [frontier add: ancestor]].
	^aVersionInfo! !

!MCFrontier methodsFor: 'accessing' stamp: 'avi 9/17/2005 22:02'!
frontier
	^frontier! !

!MCFrontier class methodsFor: 'instance creation' stamp: 'stephaneducasse 2/4/2006 20:47'!
frontierOnAll: aCollection
	| remaining  allVersions |
	remaining := Bag new.
	allVersions := (aCollection gather: [:ea | ea withBreadthFirstAncestors]) asSet.
	allVersions do: [:ea | remaining addAll: ea ancestors].
	^self new frontier: aCollection bag: remaining! !

!MCFrontier class methodsFor: 'instance creation' stamp: 'avi 9/17/2005 22:07'!
frontierOn: aVersionInfo and: otherVersionInfo
	^ self frontierOnAll: (Array with: aVersionInfo with: otherVersionInfo)! !

!MCFrontier class methodsFor: 'instance creation' stamp: 'avi 9/17/2005 22:07'!
frontierOn: aVersionInfo
	^ self frontierOnAll: (Array with: aVersionInfo)! !

!MCFtpRepository commentStamp: '<historical>'!
I am an monticello repository implementation for the FTP protocol.!
!MCFtpRepository methodsFor: 'required' stamp: 'MarcusDenker 9/24/2014 15:34'!
description
	^ 'ftp://', host, '/', directory! !

!MCFtpRepository methodsFor: 'required' stamp: 'stephaneducasse 2/4/2006 20:47'!
writeStreamForFileNamed: aString replace: ignoreBoolean do: aBlock
	| stream |
	stream := RWBinaryOrTextStream on: String new.
	aBlock value: stream.
	self clientDo:
		[:client |
		client binary.
		client putFileStreamContents: stream reset as: aString]! !

!MCFtpRepository methodsFor: '*metacello-testsplatform' stamp: 'dkh 6/12/2012 10:19:43.983'!
directory

	^directory! !

!MCFtpRepository methodsFor: 'interface' stamp: 'CamilloBruni 3/2/2012 13:02'!
loadAllFileNames
	^ self clientDo:
		[:client |
		self parseDirectoryListing: client getDirectory]! !

!MCFtpRepository methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
password: passwordString
	password := passwordString! !

!MCFtpRepository methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
directory: dirPath
	directory := dirPath! !

!MCFtpRepository methodsFor: 'enumerating' stamp: 'stephaneducasse 2/4/2006 20:47'!
clientDo: aBlock
	| client |
	client := FTPClient openOnHostNamed: host.
	client loginUser: user password: password.
	directory isEmpty ifFalse: [client changeDirectoryTo: directory].
	^ [aBlock value: client] ensure: [client close]! !

!MCFtpRepository methodsFor: '*Komitter-Models' stamp: 'BenjaminVanRyseghem 11/22/2013 16:18'!
isRemote
	^ true! !

!MCFtpRepository methodsFor: 'parsing' stamp: 'stephaneducasse 2/4/2006 20:47'!
parseDirectoryListing: aString
	| stream files line tokens |
	stream := aString readStream.
	files := OrderedCollection new.
	[stream atEnd] whileFalse:
		[line := stream nextLine.
		tokens := line findTokens: ' '.
		tokens size > 2 ifTrue: [files add: tokens last]].
	^ files! !

!MCFtpRepository methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
host: hostname
	host := hostname! !

!MCFtpRepository methodsFor: 'required' stamp: 'nice 1/5/2010 15:59'!
readStreamForFileNamed: aString do: aBlock
	
	^ self clientDo:
		[:client | | stream |
		client binary.
		stream := RWBinaryOrTextStream on: String new.
		stream nextPutAll: (client getFileNamed: aString).
		aBlock value: stream reset]! !

!MCFtpRepository methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
user: userString
	user := userString! !

!MCFtpRepository methodsFor: '*metacello-pharocommonplatform' stamp: 'dkh 4/30/2013 13:26'!
asRepositorySpecFor: aMetacelloMCProject
	| dir |
	dir := directory.
	(directory at: 1) = $/
		ifFalse: [ dir := '/', dir ].
	^(aMetacelloMCProject repositorySpec)
		description:  'ftp://', host, dir;
	 	type: 'ftp';
		username: user;
		password: password;
		yourself! !

!MCFtpRepository methodsFor: '*metacello-testsplatform' stamp: 'dkh 6/12/2012 10:19:43.983'!
host

	^host! !

!MCFtpRepository class methodsFor: '*MonticelloGUI' stamp: 'bkv 2/18/2004 21:02'!
fillInTheBlankRequest
	^ 'FTP Repository:'

	! !

!MCFtpRepository class methodsFor: 'accessing' stamp: 'avi 9/16/2003 13:57'!
description
	^ 'FTP'! !

!MCFtpRepository class methodsFor: 'instance creation' stamp: 'avi 9/16/2003 13:57'!
host: host directory: directory user: user password: password
	^ self new
		host: host;
		directory: directory;
		user: user;
		password: password! !

!MCFtpRepository class methodsFor: 'accessing' stamp: 'avi 9/16/2003 13:57'!
creationTemplate
	^
'MCFtpRepository
	host: ''modules.squeakfoundation.org''
	directory: ''mc''
	user: ''squeak''
	password: ''squeak'''
	! !

!MCFtpRepository class methodsFor: '*MonticelloGUI' stamp: 'bkv 2/18/2004 21:02'!
morphicConfigure
	^ self fillInTheBlankConfigure! !

!MCFtpRepository class methodsFor: 'accessing' stamp: 'bkv 2/18/2004 20:38'!
templateCreationSelector
	^ #host:directory:user:password: ! !

!MCGemstoneRepository commentStamp: 'CamilloBruni 2/8/2012 18:10'!
An explicit subclass of MCHttpRepository to provide a template for gemstone repositories.!
!MCGemstoneRepository methodsFor: '*Komitter-Models' stamp: 'BenjaminVanRyseghem 11/23/2013 13:24'!
koRemote

	^ KomitGemstoneRemote new
		remote: self;
		yourself! !

!MCGemstoneRepository methodsFor: 'interface' stamp: 'CamilloBruni 4/23/2012 20:22'!
includesVersionNamed: aString
	"directly do a filename check since squeaksource only stores mcz"
	^ self includesFileNamed: aString, '.mcz'! !

!MCGemstoneRepository class methodsFor: 'accessing' stamp: 'CamilloBruni 6/26/2013 13:37'!
baseURL
	^ 'http://ss3.gemtalksystems.com/ss/'! !

!MCGemstoneRepository class methodsFor: 'testing' stamp: 'CamilloBruni 6/26/2013 13:37'!
isResponsibleFor: aUrl
	^ (aUrl includesSubstring: 'ss3.gemstone.com/') or: [  aUrl includesSubstring: 'ss3.gemtalksystems.com/' ]! !

!MCGemstoneRepository class methodsFor: 'accessing' stamp: 'CamilloBruni 2/8/2012 18:12'!
description
	^ 'ss3.gemstone.com'! !

!MCGitHubRepository methodsFor: 'initialize-release' stamp: 'dkh 08/22/2013 07:40'!
hasNoLoadConflicts: anMCGitHubRepository
  (anMCGitHubRepository isKindOf: self class)
    ifFalse: [ ^ false ].
  ^ self projectPath = anMCGitHubRepository projectPath
    and: [ self repoPath = anMCGitHubRepository repoPath ]! !

!MCGitHubRepository methodsFor: 'descriptions' stamp: 'dkh 5/16/2012 14:52:41'!
description
    | desc |
    desc := self class description , self projectPath , ':' , self projectVersion.
    self repoPath ifNil: [ ^ desc ].
    ^ desc , '/' , self repoPath! !

!MCGitHubRepository methodsFor: 'comparing' stamp: 'dkh 6/16/2012 08:57'!
hash
    ^ self description hash! !

!MCGitHubRepository methodsFor: 'accessing' stamp: 'dkh 5/16/2012 14:52:41'!
repoPath: anObject
    repoPath := anObject! !

!MCGitHubRepository methodsFor: 'initialize-release' stamp: 'dkh 7/24/2012 21:52'!
flushForScriptGet
    self class flushProjectEntry: self projectPath version: self projectVersion.
    directory := nil! !

!MCGitHubRepository methodsFor: 'descriptions' stamp: 'dkh 6/16/2012 09:03'!
directoryDescription
    ^ self directory pathName! !

!MCGitHubRepository methodsFor: 'accessing' stamp: 'dkh 07/01/2013 13:23'!
directory
  directory
    ifNil: [ 
      directory := self class
        projectDirectoryFrom: self projectPath
        version: self projectVersion.
      self repoPath
        ifNotNil: [ 
          directory := MetacelloPlatform current
            directoryFromPath: self repoPath
            relativeTo: directory ] ]
    ifNotNil: [ 
      (MCFileTreeFileUtils current directoryExists: directory)
        ifFalse: [ 
          self flushCache.
          ^ self directory ] ].
  ^ directory! !

!MCGitHubRepository methodsFor: 'accessing' stamp: 'dkh 5/16/2012 14:52:41'!
projectVersion
    (projectVersion == nil or: [ projectVersion isEmpty ])
        ifTrue: [ projectVersion := 'master' ].
    ^ projectVersion! !

!MCGitHubRepository methodsFor: 'initialize-release' stamp: 'dkh 6/16/2012 09:09'!
initialize
    super initialize.
    directory := nil.	"we'll lazily create the directory instance"
    self readonly: true! !

!MCGitHubRepository methodsFor: 'accessing' stamp: 'dkh 5/16/2012 14:52:41'!
projectPath: anObject
    projectPath := anObject! !

!MCGitHubRepository methodsFor: 'accessing' stamp: 'dkh 5/16/2012 14:52:41'!
metacelloProjectClassFor: aScriptEngine
    ^ MetacelloMCBaselineProject! !

!MCGitHubRepository methodsFor: 'accessing' stamp: 'dkh 5/16/2012 14:52:41'!
projectPath
    ^ projectPath! !

!MCGitHubRepository methodsFor: 'initialize-release' stamp: 'dkh 6/16/2012 09:11'!
flushCache
    "the directory acts like a cache since we download the directory from github"

    super flushCache.
    self class flushDownloadCache.
    directory := nil! !

!MCGitHubRepository methodsFor: 'accessing' stamp: 'dkh 5/16/2012 14:52:41'!
asRepositorySpecFor: aMetacelloMCProject
    ^ aMetacelloMCProject repositorySpec
        description: self description;
        type: 'github';
        yourself! !

!MCGitHubRepository methodsFor: 'testing' stamp: 'dkh 6/16/2012 09:00'!
isValid
    ^ true! !

!MCGitHubRepository methodsFor: 'accessing' stamp: 'dkh 5/16/2012 14:52:41'!
projectVersion: anObject
    projectVersion := anObject! !

!MCGitHubRepository methodsFor: 'accessing' stamp: 'dkh 5/16/2012 14:52:41'!
repoPath
    ^ repoPath! !

!MCGitHubRepository class methodsFor: 'accessing' stamp: 'dkh 7/24/2012 21:50'!
downloadCacheKey: projectPath version: versionString
    ^ projectPath , ':::' , versionString! !

!MCGitHubRepository class methodsFor: 'private' stamp: 'ChristopheDemarey 4/29/2013 15:24'!
cacheDirectoryFor: projectPath
	| cacheDirectory projectDirectory |
	
	cacheDirectory := self cacheDirectory.
	projectDirectory := MetacelloPlatform current directoryFromPath: projectPath relativeTo: cacheDirectory.
	MetacelloPlatform current ensureDirectoryExists: projectDirectory.
	^ projectDirectory! !

!MCGitHubRepository class methodsFor: 'accessing' stamp: 'dkh 6/16/2012 08:29'!
downloadCache
    DownloadCache ifNil: [ DownloadCache := Dictionary new ].
    ^ DownloadCache! !

!MCGitHubRepository class methodsFor: 'accessing' stamp: 'dkh 5/16/2012 14:52:41'!
description
    ^ 'github://'! !

!MCGitHubRepository class methodsFor: 'instance creation' stamp: 'dkh 5/16/2012 14:52:41'!
location: locationUrl
    ^ self location: locationUrl version: nil! !

!MCGitHubRepository class methodsFor: 'accessing' stamp: 'dkh 5/16/2012 14:52:41'!
isAbstract
    "abstract as far as creating new repositories interactively? yes"

    ^ true! !

!MCGitHubRepository class methodsFor: 'private' stamp: 'dkh 5/16/2012 14:52:41'!
parseLocation: locationUrl version: versionString
    "self 
	parseLocation: 'github://dalehenrich/MetacelloRepository:master/monticello/repos/itory/path'
	version: nil
     "

    | projectPath projectVersion repoPath headerSize desc projectDelim repoDelim versionDelim |
    headerSize := 'github://' size.
    desc := locationUrl.
    desc := desc copyFrom: headerSize + 1 to: desc size.
    projectVersion := repoPath := nil.
    projectDelim := desc indexOf: $/.
    repoDelim := desc indexOf: $/ startingAt: projectDelim + 1.
    (versionDelim := desc indexOf: $:) == 0
        ifTrue: [ 
            repoDelim == 0
                ifTrue: [ projectPath := desc ]
                ifFalse: [ 
                    projectPath := desc copyFrom: 1 to: repoDelim - 1.
                    repoPath := desc copyFrom: repoDelim + 1 to: desc size ] ]
        ifFalse: [ 
            projectPath := desc copyFrom: 1 to: versionDelim - 1.
            repoDelim == 0
                ifTrue: [ projectVersion := desc copyFrom: versionDelim + 1 to: desc size ]
                ifFalse: [ 
                    projectVersion := desc copyFrom: versionDelim + 1 to: repoDelim - 1.
                    repoPath := desc copyFrom: repoDelim + 1 to: desc size ] ].
    versionString ~~ nil
        ifTrue: [ projectVersion := versionString ].
    ^ self new
        projectPath: projectPath;
        projectVersion: projectVersion;
        repoPath: repoPath;
        yourself
! !

!MCGitHubRepository class methodsFor: 'initialization' stamp: 'dkh 6/16/2012 08:25'!
flushDownloadCache
    "self flushDownloadCache"

    DownloadCache := nil! !

!MCGitHubRepository class methodsFor: 'private' stamp: 'dkh 07/12/2013 11:36'!
cacheDirectory: aDirectory
  "explicitly set CacheDirectory"

  CacheDirectory := aDirectory! !

!MCGitHubRepository class methodsFor: 'utility' stamp: 'ChristopheDemarey 7/15/2014 15:53'!
projectDirectoryFrom: projectPath version: versionString
  | mcPlatform githubCacheDirectory projectDirectory downloadCacheKey cachePath |
  downloadCacheKey := self downloadCacheKey: projectPath version: versionString.
  mcPlatform := MetacelloPlatform current.
  githubCacheDirectory := mcPlatform
    directoryFromPath: versionString
    relativeTo: (self cacheDirectoryFor: projectPath).
  cachePath := self downloadCache at: downloadCacheKey ifAbsent: [  ].
  (cachePath isNil
    or: [ 
      (projectDirectory := mcPlatform
        directoryFromPath: cachePath
        relativeTo: githubCacheDirectory) exists not ])
    ifTrue: [ 
      | url archive directory zipFileName |
      MetacelloScriptGitHubDownloadNotification new
        projectPath: projectPath;
        versionString: versionString;
        signal.	"for testing purposes"
      mcPlatform ensureDirectoryExists: githubCacheDirectory.
      url := 'https://github.com/' , projectPath , '/zipball/' , versionString.
      zipFileName :=  MetacelloPlatform current 
						tempFileFor: 'github-' , (downloadCacheKey select: [ :c | c isAlphaNumeric ]) 
						suffix: '.zip'.
      archive := MetacelloPlatform current downloadFile: url to: zipFileName.
      directory := mcPlatform
        directoryFromPath: (cachePath := archive members first fileName)
        relativeTo: githubCacheDirectory.
      directory exists
        ifFalse: [ 
          MetacelloPlatform current
            extractRepositoryFrom: zipFileName
            to: githubCacheDirectory fullName ].
      self downloadCache at: downloadCacheKey put: cachePath.
      projectDirectory := mcPlatform
        directoryFromPath: cachePath
        relativeTo: githubCacheDirectory ].
  ^ projectDirectory! !

!MCGitHubRepository class methodsFor: 'initialization' stamp: 'dkh 07/12/2013 11:52'!
initialize
  "self initialize"

  Smalltalk addToStartUpList: self.
  self flushDownloadCache.
  self resetCacheDirectoryIfInvalid! !

!MCGitHubRepository class methodsFor: 'private' stamp: 'dkh 07/12/2013 11:36'!
defaultCacheDirectory
  | defaultDirectory cacheDirectory |
  defaultDirectory := MetacelloPlatform current defaultDirectory.
  cacheDirectory := MetacelloPlatform current
    directoryFromPath: 'github-cache'
    relativeTo: defaultDirectory.
  MetacelloPlatform current ensureDirectoryExists: cacheDirectory.
  ^ cacheDirectory! !

!MCGitHubRepository class methodsFor: 'private' stamp: 'dkh 07/12/2013 11:51'!
resetCacheDirectoryIfInvalid
  "Reset if invalid"

  CacheDirectory notNil
    and: [ 
      (MCFileTreeFileUtils current directoryExists: CacheDirectory)
        ifFalse: [ CacheDirectory := nil ] ]! !

!MCGitHubRepository class methodsFor: 'private' stamp: 'dkh 07/12/2013 11:52'!
cacheDirectory
  self resetCacheDirectoryIfInvalid.
  CacheDirectory ifNil: [ CacheDirectory := self defaultCacheDirectory ].
  ^ CacheDirectory! !

!MCGitHubRepository class methodsFor: 'instance creation' stamp: 'dkh 6/16/2012 09:08'!
location: locationUrl version: versionString
    ^ self parseLocation: locationUrl version: versionString! !

!MCGitHubRepository class methodsFor: 'utility' stamp: 'dkh 7/24/2012 21:50'!
flushProjectEntry: projectPath version: versionString
    self downloadCache removeKey: (self downloadCacheKey: projectPath version: versionString) ifAbsent: [  ]! !

!MCGitHubRepository class methodsFor: 'system startup' stamp: 'dkh 6/16/2012 08:24'!
startUp: resuming
    "Flush the GitHub download cache"

    resuming
        ifTrue: [ self flushDownloadCache ]! !

!MCHttpRepository commentStamp: '<historical>'!
I am general http repository for monticello.
I support the general protocol for listing files in a remote repository.!
!MCHttpRepository methodsFor: 'private' stamp: 'SvenVanCaekenberghe 6/5/2012 21:54'!
entityStreamContents: aBlock
	"Generate output in a buffer because we need the length"
	
	| stream |
	stream := RWBinaryOrTextStream on: String new.
	aBlock value: stream.
	stream reset.
	^ (ZnStreamingEntity type: ZnMimeType applicationOctetStream)
		stream: stream;
		contentLength: stream size;
		yourself! !

!MCHttpRepository methodsFor: 'i/o' stamp: 'SeanDeNigris 6/20/2012 23:28'!
displayProgress: label during: workBlock
	| nextUpdateTime |
	nextUpdateTime := 0.
	^UIManager default displayProgress: label 
		from: 0.0 to: 1.0 during:[:bar|
			[workBlock value] on: HTTPProgress do:[:ex|
				(ex total == nil or: [ex amount == nil]) ifFalse:[
					(nextUpdateTime < Time millisecondClockValue 
						or:[ex total = ex amount]) ifTrue:[
							bar current: ex amount asFloat / ex total asFloat.
							nextUpdateTime := Time millisecondClockValue + 100.
					].
				].
				ex resume.
			]
		].
! !

!MCHttpRepository methodsFor: 'accessing' stamp: 'CamilloBruni 9/14/2012 17:24'!
description
	^ self location! !

!MCHttpRepository methodsFor: 'converting' stamp: 'CamilloBruni 9/14/2012 17:24'!
asCreationTemplate
	^self class creationTemplateLocation: self location user: user password: password! !

!MCHttpRepository methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
location: aUrlString
	location := aUrlString! !

!MCHttpRepository methodsFor: '*UserManager-Core' stamp: 'BenjaminVanRyseghem 10/25/2012 14:53'!
keyChainGroupSelector

	^ #monticelloDefault! !

!MCHttpRepository methodsFor: 'accessing' stamp: 'CamilloBruni 9/18/2012 18:35'!
project
	"Return a project name"
	^ (self location splitOn: $/) last! !

!MCHttpRepository methodsFor: '*Komitter-Models' stamp: 'BenjaminVanRyseghem 11/22/2013 16:24'!
isPrivatePharoRepository
	
	^ self class pharoLocations includes: self location! !

!MCHttpRepository methodsFor: 'accessing' stamp: 'CamilloBruni 7/17/2013 23:21'!
user
	self userAndPasswordFromSettingsDo: [:usr :pwd | ^usr].
	"not in settings"
	user isEmptyOrNil ifFalse: [ ^user ].
	
	#UserManager asClassIfPresent: [ :userManager |
		(userManager default currentUser userNamePasswordFor: self keyChainGroupSelector)
			ifNotNil: [ :usr | 
				^ usr username ]].
	^ ''! !

!MCHttpRepository methodsFor: 'actions' stamp: 'SvenVanCaekenberghe 10/27/2013 12:19'!
parseFileNamesFromStream: aStream
	| names fullName |
	names := OrderedCollection new.
	[aStream atEnd] whileFalse:
		[[aStream upTo: $<. {$a. $A. nil} includes: aStream next] whileFalse.
		aStream upTo: $".
		aStream atEnd ifFalse: [
			fullName := aStream upTo: $".
			names add: fullName urlDecoded ]].
	^ names! !

!MCHttpRepository methodsFor: 'i/o' stamp: 'CamilloBruni 6/15/2013 10:13'!
loadAllFileNames
	| client |
	self displayProgress: 'Loading all file names from ', self description during: [
		client := self httpClient.
		client
			ifFail: [ :exception | 
				(exception className beginsWith: 'Zn')
					ifTrue: [ MCRepositoryError signal: 'Could not access ', self location, ': ', exception printString ]
					ifFalse: [ exception pass ] ];
			url: self locationWithTrailingSlash;
			queryAt: 'C' put: 'M;O=D';	"legacy that some servers maybe expect"
			get.
		self assertNonBinaryResponse: client response ].
	^ self parseFileNamesFromStream: client contents readStream! !

!MCHttpRepository methodsFor: 'actions' stamp: 'CamilloBruni 9/14/2012 17:24'!
locationWithTrailingSlash
	^ (self location endsWith: '/')
		ifTrue: [self location]
		ifFalse: [self location, '/']! !

!MCHttpRepository methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
user: userString
	user := userString! !

!MCHttpRepository methodsFor: 'i/o' stamp: 'EstebanLorenzano 4/25/2013 10:50'!
readStreamForFileNamed: aString do: aBlock
	| client |
	self displayProgress: 'Downloading ', aString during: [
		client := self httpClient.
		client
			ifFail: [ :exception | self error: 'Could not load ', aString, ': ', exception printString ];
			get: (self urlForFileNamed: aString).
		self assertBinaryResponse: client response.
		"immediately cache the version and avoid an unnecessary serialization"
		self cacheRawVersionNamed: aString stream: client contents ].
	^ aBlock value: client contents readStream! !

!MCHttpRepository methodsFor: 'private' stamp: 'SeanDeNigris 8/27/2012 12:05'!
assertNonBinaryResponse: response 
	
	response contentType isBinary ifTrue: [ MCRepositoryError signal: 'Did not expect a binary response but got ', response contentType printString ].! !

!MCHttpRepository methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/17/2015 15:50'!
gtDisplayOn: aStream
	aStream nextPutAll: self location! !

!MCHttpRepository methodsFor: 'private' stamp: 'CamilloBruni 9/18/2013 14:17'!
httpClient
	"Return a new, specifically configured instance of the HTTP client for internal use.
	Note how we request GZIP compression and will signal progress."

	^ ZnClient new
		systemPolicy;
		beOneShot;
		username: self user password: self password;
	
		signalProgress: true;
		yourself! !

!MCHttpRepository methodsFor: 'i/o' stamp: 'CamilloBruni 4/11/2013 17:22'!
handleUnsuccessfulResponse: aZnResponse
	(#(403 401) includes: aZnResponse code)
		ifTrue: [ MCPermissionDenied signalFor: self ].
	Error signal: 'Could not save version.'! !

!MCHttpRepository methodsFor: '*Komitter-Models' stamp: 'BenjaminVanRyseghem 11/30/2013 20:22'!
koRemote

	^ KomitHttpRemote new
		remote: self;
		yourself! !

!MCHttpRepository methodsFor: 'i/o' stamp: 'CamilloBruni 4/11/2013 17:19'!
writeStreamForFileNamed: aString replace: ignoreBoolean do: aBlock
	| entity |
	entity := self entityStreamContents: aBlock.
	self displayProgress: 'Uploading ', aString during: [
		self httpClient
			entity: entity;
			ifFail: [ :exception | 
				(exception isKindOf: ZnHttpUnsuccessful) 
					ifTrue: [ ^ self handleUnsuccessfulResponse: exception response ].
				self error: 'Could not save ', aString, ': ', exception printString ];
			url: (self urlForFileNamed: aString);
			put ]! !

!MCHttpRepository methodsFor: 'private' stamp: 'SeanDeNigris 8/27/2012 12:09'!
assertBinaryResponse: response 

	response contentType isBinary ifFalse: [ 
		MCRepositoryError signal: 'Expected a binary response instead of ', response contentType printString ].! !

!MCHttpRepository methodsFor: 'accessing' stamp: 'CamilloBruni 4/11/2013 17:42'!
credentials
	^ MCServerCredentials user: self user password: self password! !

!MCHttpRepository methodsFor: 'actions' stamp: 'CamilloBruni 5/1/2013 22:51'!
password
	self userAndPasswordFromSettingsDo: [:usr :pwd | ^pwd].

	self user isEmpty ifTrue: [^password ifNil: ['']].

	password isEmptyOrNil ifTrue: [ 
		password := (UserManager default currentUser userNamePasswordFor: self keyChainGroupSelector) 							ifNil: [ '' ]
							ifNotNil: [:usr | usr password ]].


	password isEmptyOrNil ifTrue: [
		| answer |
		user isEmptyOrNil ifTrue: [
			"Give the user a chance to change the login"
			answer := UIManager default request: 'User name for ', String cr, location
				initialAnswer: ''.
			answer isEmptyOrNil
				ifTrue: [^password]
				ifFalse: [self user: answer] ].
		
		password := UIManager default requestPassword: 'Password for "', self user, '" at ', String cr, self location.
		"The user doesn't care about logging into this repo. Clear the username so they will not be prompted every time"
		password isEmptyOrNil ifTrue: [ user := '' ].
	].

	^ password! !

!MCHttpRepository methodsFor: 'accessing' stamp: 'CamilloBruni 9/14/2012 17:24'!
location
	^ location! !

!MCHttpRepository methodsFor: 'actions' stamp: 'marcus.denker 11/10/2008 10:04'!
versionReaderForFileNamed: aString do: aBlock
	^ (self versionReaderForFileNamed: aString) ifNotNil: aBlock! !

!MCHttpRepository methodsFor: 'accessing' stamp: 'CamilloBruni 4/11/2013 17:45'!
credentials: mcServerCredentials
	self user: mcServerCredentials username.
	self password: mcServerCredentials password.! !

!MCHttpRepository methodsFor: 'i/o' stamp: 'SeanDeNigris 7/17/2012 15:50'!
cacheRawVersionNamed: aString stream: contents
	"directly forward the contents to the cache repository. 
	this avoids and unnecessary serialization step"
	MCCacheRepository uniqueInstance 
		writeStreamForFileNamed: aString 
		replace: true 
		do: [ :s| s nextPutAll: contents ]! !

!MCHttpRepository methodsFor: 'actions' stamp: 'SvenVanCaekenberghe 10/27/2013 11:46'!
urlForFileNamed: aString
	^ self locationWithTrailingSlash, aString urlEncoded! !

!MCHttpRepository methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
password: passwordString
	password := passwordString! !

!MCHttpRepository methodsFor: 'actions' stamp: 'CamilloBruni 9/14/2012 17:25'!
userAndPasswordFromSettingsDo: aBlock
	"The mcSettings file in ExternalSettings preferenceDirectory should contain entries for each account:
	
		account1: *myhost.mydomain* user:password
		account2: *otherhost.mydomain/somerep* dXNlcjpwYXNzd29yZA==

	That is it must start with 'account', followed by anything to distinguish accounts, and a colon. Then comes a match expression for the repository url, and after a space the user:password string.
	
	To not have the clear text password on your disc, you can base64 encode it:
			(Base64MimeConverter mimeEncode: 'user:password' readStream) contents
	"

	
	Settings ifNotNil: [
		Settings keysAndValuesDo: [:key :value | | entry userAndPassword |
			(key asLowercase beginsWith: 'account') ifTrue: [
				entry := value findTokens: '	 '.
				(entry first match: self location) ifTrue: [
					userAndPassword := entry second.
					(userAndPassword includes: $:) ifFalse: [
						userAndPassword := (Base64MimeConverter mimeDecodeToChars: userAndPassword readStream) contents].
					userAndPassword := userAndPassword findTokens: $:.
					^aBlock value: userAndPassword first 
						value: userAndPassword second 
					]
			]
		]
	].
	^nil! !

!MCHttpRepository methodsFor: 'actions' stamp: 'al 12/12/2005 11:06'!
flushCache
	super flushCache.
	readerCache := nil.! !

!MCHttpRepository methodsFor: '*Komitter-Models' stamp: 'BenjaminVanRyseghem 11/22/2013 16:28'!
isRemote
	^ self isPrivatePharoRepository not! !

!MCHttpRepository methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
asRepositorySpecFor: aMetacelloMCProject

	^(aMetacelloMCProject repositorySpec)
		description:  self description;
	 	type: 'http';
		yourself! !

!MCHttpRepository methodsFor: 'actions' stamp: 'stephaneducasse 2/4/2006 20:47'!
versionReaderForFileNamed: aString
	readerCache ifNil: [readerCache := Dictionary new].
	^ readerCache at: aString ifAbsent:
		[self resizeCache: readerCache.
		super versionReaderForFileNamed: aString do:
			[:r |
			r ifNotNil: [readerCache at: aString put: r]]]
	! !

!MCHttpRepository class methodsFor: 'accessing' stamp: 'ab 7/24/2003 21:20'!
description
	^ 'HTTP'! !

!MCHttpRepository class methodsFor: 'instance creation' stamp: 'CamilloBruni 5/7/2013 14:34'!
location: location
	^ MCServerRegistry uniqueInstance 
		repositoryAt: location credentialsDo: [ :username :password |
			(self repositoryClassFor: location) new
				location: location;
				user: username;
				password: password;
				yourself ]! !

!MCHttpRepository class methodsFor: 'instance creation' stamp: 'CamilloBruni 10/21/2012 13:26'!
project: aProjectIdentifier
	^ self location: self baseURL, aProjectIdentifier! !

!MCHttpRepository class methodsFor: 'creation template' stamp: 'CamilloBruni 2/15/2012 15:21'!
creationTemplateLocation: location user: user password: password
	^
self name, '
	location: {1}
	user: {2}
	password: {3}' format: {location printString. user printString. password printString}! !

!MCHttpRepository class methodsFor: 'accessing' stamp: 'CamilloBruni 10/21/2012 13:25'!
baseURL
	^ ''! !

!MCHttpRepository class methodsFor: 'testing' stamp: 'CamilloBruni 4/6/2013 23:04'!
isResponsibleFor: aURLString
	"Override in subclasses to enable custom instances for certain URLs"
	^ true! !

!MCHttpRepository class methodsFor: '*Komitter-Models' stamp: 'MarcusDenker 7/16/2014 12:41'!
pharoLocations
	"Answer the locations for both pharo and pharo inbox repositories.
	No commit should actually be pushed directly there"

	^ #('http://smalltalkhub.com/mc/Pharo/Pharo40/main' 
		'http://smalltalkhub.com/mc/Pharo/Pharo40/main/' 
		'http://smalltalkhub.com/mc/Pharo/Pharo40Inbox/main'
		'http://smalltalkhub.com/mc/Pharo/Pharo40Inbox/main/')! !

!MCHttpRepository class methodsFor: 'instance creation' stamp: 'MartinDias 9/26/2014 10:58'!
pharoInboxRepository
	^ self location: 'http://smalltalkhub.com/mc/Pharo/Pharo40Inbox/main'.! !

!MCHttpRepository class methodsFor: 'instance creation' stamp: 'SeanDeNigris 8/26/2012 18:22'!
location: aUrl user: user password: password

	| result |
	result := self location: aUrl.
	user ifNotEmpty: [
		result
			user: user;
			password: password ].
	^ result.! !

!MCHttpRepository class methodsFor: 'instance creation' stamp: 'CamilloBruni 4/6/2013 23:33'!
repositoryClassFor: location
	MCHttpRepository subclassesDo: [ :subclass | 
		(subclass isResponsibleFor: location)
			ifTrue: [ ^ subclass ]].
	^ MCHttpRepository! !

!MCHttpRepository class methodsFor: '*MonticelloGUI' stamp: 'bkv 2/18/2004 21:00'!
fillInTheBlankRequest
	^ 'HTTP Repository:'
			! !

!MCHttpRepository class methodsFor: 'creation template' stamp: 'CamilloBruni 10/21/2012 13:24'!
creationTemplate
	^self creationTemplateLocation: self baseURL
		user: ''
		password: ''
! !

!MCHttpRepository class methodsFor: 'initialization' stamp: 'bf 7/28/2005 19:44'!
clearPasswords
	self allSubInstancesDo: [:ea | ea password: ''].
! !

!MCHttpRepository class methodsFor: 'instance creation' stamp: 'MartinDias 9/26/2014 10:58'!
pharoRepository
	^ self location: 'http://smalltalkhub.com/mc/Pharo/Pharo40/main'.! !

!MCHttpRepository class methodsFor: '*MonticelloGUI' stamp: 'bkv 2/18/2004 21:01'!
morphicConfigure
	^ self fillInTheBlankConfigure! !

!MCInstanceVariableDefinition commentStamp: '<historical>'!
A MCInstanceVariableDefinition represents an instance variable definition.!
!MCInstanceVariableDefinition methodsFor: 'testing' stamp: 'cwp 7/7/2003 23:32'!
isInstanceVariable
	^ true! !

!MCInstanceVariableDefinition class methodsFor: 'accessing' stamp: 'cwp 7/7/2003 22:59'!
type
	^ #instance! !

!MCKomitSubmitter commentStamp: '<historical>'!
I am a class dedicated to the transformation of a Komit object into a MCCommit and its submission!
!MCKomitSubmitter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/27/2013 13:18'!
submitCommit: aKomit

	MCSaveVersionDialog addAsLastLogMessage: aKomit message asString.
	aKomit commitOn: self
	! !

!MCKomitSubmitter methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/29/2013 13:51'!
storeDependencies: newVersion for: aKomit

	self 
		retryOnCredentialRequest: [ aKomit repository storeDependencies: newVersion ]
		for: aKomit repository! !

!MCKomitSubmitter methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/29/2013 13:50'!
retryOnCredentialRequest: aBlock for: aRepository

	aBlock on: MCPermissionDenied do: [ :error | |credentials| 
		credentials := MCCredentialsRequest 
							signalUrl: aRepository location
							username: aRepository user
							password: aRepository password.
		credentials 
			ifNotNil: [ 
				aRepository credentials: credentials.
				^ self retryOnCredentialRequest: aBlock for: aRepository ]]! !

!MCKomitSubmitter methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/29/2013 13:51'!
storeVersion: newVersion for: aKomit

	self 
		retryOnCredentialRequest: [ aKomit repository storeVersion: newVersion ]
		for: aKomit repository! !

!MCKomitSubmitter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 12/6/2013 21:36'!
commitSlice: aSlice
	| versions slice view workingCopy version packages name |

	slice := MCSliceInfo new.
	view := KomitSliceUI new.
	view openDialogWithSpec
		centered;
		modalRelativeTo: World.

	view cancelled ifTrue: [ ^ self ].
	
	slice issueNumber: view issueNumberText.
	slice issueSummary: view titleText.
	
	versions := self createVersionFor: aSlice.
	
	KomitterManager current reset.
	
	packages := versions collect: [ :each | 
		KomitterManager current 
			storeVersion: each
			for: each package.
		each package ].
	
	slice includedPackages: packages.
	workingCopy := slice makeKomitSlice.
	
	name := workingCopy silentUniqueVersionNameIn: aSlice remote remote.
	
	version := workingCopy 
		silentlyNewSliceVersionWithName: name 
		message: aSlice message 
		in: aSlice remote remote.
		
	Cursor wait showWhile: [
		[ self
			storeVersion: version for: aSlice;
			storeDependencies: version for: aSlice
		] ensure: [ (MCVersionInspector new version: version) show ] 
	]! !

!MCKomitSubmitter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/26/2013 21:01'!
commitKomit: aKomit
	| versions |
	
	versions := self createVersionFor: aKomit.
	
	versions do: [ :version | 
		Cursor wait showWhile: [ 
			[ self
				storeVersion: version for: aKomit;
				storeDependencies: version  for: aKomit
			] ensure: [ (MCVersionInspector new version: version) show ] 
		]
	 ]! !

!MCKomitSubmitter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 12/6/2013 21:26'!
createVersionFor: aKomitableObject
	| versions currentAuthor |
	currentAuthor := Author fullNamePerSe.
	Author fullName: aKomitableObject author.
	[ 
	versions := aKomitableObject entities keys
		collect: [ :each | 
			| workingCopy name version patcher |
			workingCopy := each package workingCopy.
			name := workingCopy silentUniqueVersionNameIn: aKomitableObject repository.
			version := workingCopy silentlyNewVersionWithName: name message: aKomitableObject message in: aKomitableObject repository.
			workingCopy modified: each isFullyCommited not.
			patcher := MCPatcher snapshot: each patch base.
			(aKomitableObject entities at: each) do: [ :e | e operation applyTo: patcher ].
			version := MCVersion
				package: version package
				info: version info
				snapshot: patcher patchedSnapshot
				dependencies: version dependencies.
			KomitPackage removePackage: each.
			version ] ]
		ensure: [ Author fullName: currentAuthor ].
	^ versions! !

!MCKomitSubmitter class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 11/26/2013 13:18'!
komit: komit

	^ self new
		komit: komit;
		yourself! !

!MCLazyVersionInfo commentStamp: '<historical>'!
A MCLazyVersionInfo puts ancestor and stepChilds data in WeakArrays to allow their memory to be reclaimed and reloaded on demand.

For all purposes, a MCLazyVersionInfo behaves exactly like a MCVersionInfo with the same data, but:
- let the ancestry (and step children) be garbage collected
- and reload that ancestry (and stepChildren) from the MC repositories when accessed (MCLazyVersionInfo>>loadAncestorsAndStepChildren for the reload, MCLazyVersionInfo>>ancestors and MCLazyVersionInfo>>stepChildren for the access).

MCLazyVersionInfo is installed just as the ancestor in a MCWorkingAncestry (the direct ancestry of a WorkingCopy, which is the state all packages take when they are loaded in an image). It allows a MCWorkingAncestry to still know which package it is coming from, and, of course, the MCLazyVersionInfo to be able to reload the relevant ancestry from the right package.

Once installed, by flushing the Monticello package cache, all the stored ancestry is garbage collected, except the roots of those ancestry trees, which are the MCLazyVersionInfo instances inside the MCWorkingAncestry instances.

Warnings:

- Algorithms which traverse the entire ancestry chain of all packages will force a reload of all the packages contained in the image, which is a time and memory and network consuming process...

- It degrades gracefully when reloading becomes impossible (returns an empty ancestry, keeps knowledge of the fact some ancestry is missing, reloading a full ancestry on when possible). This has been tested.


!
!MCLazyVersionInfo methodsFor: 'initialization' stamp: 'ThierryGoubier 2/25/2015 22:39:26'!
initialize
	super initialize.
	ancestors := WeakArray new.
	stepChildren := WeakArray new! !

!MCLazyVersionInfo methodsFor: 'comparing' stamp: 'ThierryGoubier 3/2/2015 10:58'!
species
	"Make this class equivalent to a MCVersionInfo in all regards."

	^ self class superclass! !

!MCLazyVersionInfo methodsFor: 'initialization' stamp: 'ThierryGoubier 2/26/2015 10:54'!
lazy
	^ self! !

!MCLazyVersionInfo methodsFor: 'accessing' stamp: 'ThierryGoubier 3/2/2015 11:02'!
ancestors
	"Ensure we load ancestors as appropriate if necessary. Failure to load force us to return an empty set to avoid errors, but we'll keep track of the fact that this failure may be transient and that we can continue."

	(ancestors anySatisfy: #isNil)
		ifTrue: [ self loadAncestorsAndStepChildren ].
	(ancestors anySatisfy: #isNil)
		ifTrue: [ ^ #() ].
	^ ancestors! !

!MCLazyVersionInfo methodsFor: 'initialization' stamp: 'ThierryGoubier 2/25/2015 22:39:26'!
initializeWithName: vName id: aUUID message: aString date: aDate time: aTime author: initials ancestors: aCollection stepChildren: stepCollection
	name := vName.
	id := aUUID.
	message := aString.
	date := aDate.
	time := aTime.
	author := initials.
	ancestors := WeakArray withAll: aCollection.
	stepChildren := WeakArray withAll: stepCollection! !

!MCLazyVersionInfo methodsFor: 'accessing' stamp: 'ThierryGoubier 2/25/2015 22:39:26'!
stepChildren
	"Ensure we load step children as appropriate if necessary."

	(stepChildren anySatisfy: #isNil)
		ifTrue: [ self loadAncestorsAndStepChildren ].
	(stepChildren anySatisfy: #isNil)
		ifTrue: [ ^ #() ].
	^ stepChildren! !

!MCLazyVersionInfo methodsFor: 'private' stamp: 'ThierryGoubier 3/2/2015 11:05'!
loadAncestorsAndStepChildren
	"This code scans all the repositories to find the exact package version and reload the relevant info."

	"Transient failures, such as the lack of network connectivity, will return nothing and no errors from this code."

	(MCRepositoryGroup default in: [ :r | r versionWithInfo: self ifNone: [  ] ])
		ifNotNil: [ :aVersion | 
			ancestors := WeakArray withAll: aVersion info ancestors.
			stepChildren := WeakArray withAll: aVersion info stepChildren ]! !

!MCLazyVersionInfo class methodsFor: 'class initialization' stamp: 'ThierryGoubier 2/26/2015 09:42'!
install
	"Install the lazy mc versions on..."

	"self install"

	MCWorkingAncestry
		allInstancesDo: [ :each | each ancestors: (each ancestors collect: [ :e | MCLazyVersionInfo from: e ]) ].
	MCFileBasedRepository flushAllCaches.
	Smalltalk garbageCollect! !

!MCLazyVersionInfo class methodsFor: 'class initialization' stamp: 'ThierryGoubier 2/26/2015 09:44'!
initialize
	self install! !

!MCLazyVersionInfo class methodsFor: 'instance-creation' stamp: 'ThierryGoubier 2/25/2015 22:39:26'!
from: aVersionInfo
	^ self new
		initializeWithName: aVersionInfo name
		id: aVersionInfo id
		message: aVersionInfo message
		date: aVersionInfo date
		time: aVersionInfo time
		author: aVersionInfo author
		ancestors: aVersionInfo ancestors
		stepChildren: aVersionInfo stepChildren! !

!MCMcdReader commentStamp: 'TorstenBergmann 2/6/2014 08:08'!
Reader for an MCD format!
!MCMcdReader methodsFor: 'accessing' stamp: 'avi 2/13/2004 23:41'!
basicVersion
	^ MCDiffyVersion
		package: self package
		info: self info
		dependencies: self dependencies
		baseInfo: self baseInfo
		patch: self patch! !

!MCMcdReader methodsFor: 'loading' stamp: 'MarianoMartinezPeck 6/17/2012 12:37'!
loadPatch
	| old new |
	(self zip memberNamed: 'patch.bin') ifNotNil:
		[:m | [^ patch := (MCDataStream on: m contentStream) next ]
			on: Error do: [:fallThrough ]].
	definitions := OrderedCollection new.
	(self zip membersMatching: 'old/*')
		do: [:m | self extractDefinitionsFrom: m].
	old := definitions asArray.
	definitions := OrderedCollection new.
	(self zip membersMatching: 'new/*')
		do: [:m | self extractDefinitionsFrom: m].
	new := definitions asArray.
	^ patch := self buildPatchFrom: old to: new.
	! !

!MCMcdReader methodsFor: 'accessing' stamp: 'avi 2/14/2004 21:33'!
baseInfo
	^ baseInfo ifNil: [self loadBaseInfo]! !

!MCMcdReader methodsFor: 'loading' stamp: 'stephaneducasse 2/4/2006 20:47'!
loadBaseInfo
	^ baseInfo := self extractInfoFrom: (self parseMember: 'base')! !

!MCMcdReader methodsFor: 'accessing' stamp: 'avi 2/14/2004 21:34'!
patch
	^ patch ifNil: [self loadPatch]! !

!MCMcdReader methodsFor: 'loading' stamp: 'avi 2/14/2004 21:37'!
buildPatchFrom: oldDefinitions to: newDefinitions
	^ MCPatch
		fromBase: (MCSnapshot fromDefinitions: oldDefinitions)
		target: (MCSnapshot fromDefinitions: newDefinitions)! !

!MCMcdReader class methodsFor: 'accessing' stamp: 'avi 2/13/2004 23:09'!
extension
	^ 'mcd'! !

!MCMcdWriter commentStamp: 'TorstenBergmann 2/6/2014 08:08'!
Writing MCD format!
!MCMcdWriter methodsFor: 'writing' stamp: 'stephaneducasse 2/4/2006 20:47'!
writePatch: aPatch
	| old new |
	old := OrderedCollection new.
	new := OrderedCollection new.
	aPatch operations do:
		[:ea |
		ea isRemoval ifTrue: [old add: ea definition].
		ea isAddition ifTrue: [new add: ea definition].
		ea isModification ifTrue: [old add: ea baseDefinition. new add: ea definition]].
	self writeOldDefinitions: old.
	self writeNewDefinitions: new.
	self addString: (self serializeInBinary: aPatch) at: 'patch.bin'.! !

!MCMcdWriter methodsFor: 'visiting' stamp: 'avi 2/17/2004 01:48'!
writeDefinitions: aVersion
	self writeBaseInfo: aVersion baseInfo.
	self writePatch: aVersion patch.! !

!MCMcdWriter methodsFor: 'writing' stamp: 'nicolascellier 6/2/2013 18:39'!
writeOldDefinitions: aCollection
	self addString: (self serializeDefinitions: aCollection) at: 'old/source.', self snapshotWriterClass extension encodedTo: 'utf8'.! !

!MCMcdWriter methodsFor: 'writing' stamp: 'nicolascellier 6/2/2013 18:39'!
writeNewDefinitions: aCollection
	self addString: (self serializeDefinitions: aCollection) at: 'new/source.', self snapshotWriterClass extension encodedTo: 'utf8'.! !

!MCMcdWriter methodsFor: 'writing' stamp: 'nicolascellier 6/2/2013 18:39'!
writeBaseInfo: aVersionInfo
	| string |
	string := self serializeVersionInfo: aVersionInfo.
	self addString: string at: 'base' encodedTo: 'utf8'.
! !

!MCMcdWriter class methodsFor: 'accessing' stamp: 'avi 2/13/2004 23:09'!
readerClass
	^ MCMcdReader! !

!MCMcmReader commentStamp: 'TorstenBergmann 2/20/2014 16:24'!
Reader for Metacello MCM!
!MCMcmReader methodsFor: 'accessing' stamp: 'bf 3/23/2005 01:17'!
configurationName
	^fileName ifNotNil: [(fileName findTokens: '/\:') last copyUpToLast: $.]! !

!MCMcmReader methodsFor: 'accessing' stamp: 'bf 11/16/2005 11:01'!
version
	^self configuration! !

!MCMcmReader methodsFor: 'accessing' stamp: 'bf 11/16/2005 11:03'!
loadConfiguration
	stream reset.
	configuration := MCConfiguration fromArray: (MCScanner scan: stream).
	configuration name: self configurationName.
! !

!MCMcmReader methodsFor: 'accessing' stamp: 'bf 3/23/2005 01:17'!
fileName: aString
	fileName := aString! !

!MCMcmReader methodsFor: 'accessing' stamp: 'bf 11/16/2005 11:01'!
loadVersionInfo
	info := self configuration! !

!MCMcmReader methodsFor: 'accessing' stamp: 'bf 11/26/2005 20:26'!
configuration
	configuration ifNil: [self loadConfiguration].
	"browser modifies configuration, but the reader might get cached"
	^configuration copy! !

!MCMcmReader class methodsFor: 'accessing' stamp: 'bf 3/22/2005 10:47'!
extension
	^ 'mcm'! !

!MCMcmReader class methodsFor: 'instance creation' stamp: 'stephaneducasse 2/4/2006 20:47'!
on: aStream fileName: aFileName
	| reader |
	reader := self on: aStream.
	reader fileName: aFileName.
	^reader! !

!MCMcmWriter commentStamp: 'TorstenBergmann 2/20/2014 16:24'!
Writer for Metacello MCM!
!MCMcmWriter methodsFor: 'writing' stamp: 'bf 3/22/2005 18:00'!
close
	stream close! !

!MCMcmWriter methodsFor: 'writing' stamp: 'bf 3/24/2005 01:50'!
writeConfiguration: aConfiguration

	stream nextPut: $(.

	aConfiguration repositories do: [:ea | 
		stream cr.
		stream nextPutAll: 'repository '.
		(MCConfiguration repositoryToArray: ea) printElementsOn: stream].

	aConfiguration dependencies do: [:ea | 
		stream cr.
		stream nextPutAll: 'dependency '.
		(MCConfiguration dependencyToArray: ea) printElementsOn: stream].

	stream cr.
	stream nextPut: $).
	stream cr.! !

!MCMcmWriter class methodsFor: 'accessing' stamp: 'bf 3/22/2005 10:49'!
readerClass
	^ MCMcmReader! !

!MCMcmWriter class methodsFor: 'writing' stamp: 'stephaneducasse 2/4/2006 20:47'!
fileOut: aConfiguration on: aStream
	| inst |
	inst := self on: aStream.
	inst writeConfiguration: aConfiguration.
	inst close.
	
! !

!MCMczInstallerTest methodsFor: 'as yet unclassified' stamp: 'Anonymous 6/17/2013 13:16'!
deleteFile
	self fileName asFileReference ensureDelete! !

!MCMczInstallerTest methodsFor: 'as yet unclassified' stamp: 'stephaneducasse 2/4/2006 20:47'!
testInstallFromStream
	| stream |
	stream := RWBinaryOrTextStream on: String new.
	MCMczWriter fileOut: expected on: stream.
	MczInstaller installStream: stream reset.
	self assertNoChange.
	self assertVersionInfoPresent.
	! !

!MCMczInstallerTest methodsFor: 'as yet unclassified' stamp: 'stephaneducasse 2/4/2006 20:47'!
assertVersionInfoPresent
	| dict info |
	dict := MczInstaller versionInfo at: self mockPackage name.
	info := expected info.
	self assertDict: dict matchesInfo: info.! !

!MCMczInstallerTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/7/2003 18:15'!
fileName
	^ 'InstallerTest.mcz'! !

!MCMczInstallerTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/7/2003 19:36'!
tearDown
	expected snapshot updatePackage: self mockPackage.
	self deleteFile.! !

!MCMczInstallerTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/7/2003 18:16'!
fileStream
	^ FileStream forceNewFileNamed: self fileName.! !

!MCMczInstallerTest methodsFor: 'as yet unclassified' stamp: 'stephaneducasse 2/4/2006 20:47'!
assertNoChange
	| actual |
	actual := MCSnapshotResource takeSnapshot.
	diff := actual patchRelativeToBase: expected snapshot.
	self assert: diff isEmpty! !

!MCMczInstallerTest methodsFor: 'as yet unclassified' stamp: 'marcus.denker 11/10/2008 10:04'!
assertDict: dict matchesInfo: info
	#(name id message date time author)
		do: [:sel |  (info perform: sel) ifNotNil: [:i | dict at: sel ifPresent: [:d | self assert: i = d]]].
	info ancestors 
			with: (dict at: #ancestors) 
			do: [:i :d | self assertDict: d matchesInfo: i]! !

!MCMczInstallerTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/10/2003 16:25'!
testInstallFromFile
	MCMczWriter fileOut: expected on: self fileStream.
	MczInstaller installFileNamed: self fileName.
	self assertNoChange.! !

!MCMczInstallerTest methodsFor: 'as yet unclassified' stamp: 'stephaneducasse 2/4/2006 20:47'!
setUp
	expected := self mockVersion.
	self change: #one toReturn: 2.! !

!MCMczInstallerTest class methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 6/9/2012 23:06'!
suite
	^ (Smalltalk hasClassNamed: #MczInstaller)
		ifTrue: [ super suite ]
		ifFalse: [ self classForTestSuite new name: self name asString ]! !

!MCMczInstallerTest class methodsFor: 'as yet unclassified' stamp: 'cwp 8/13/2003 12:11'!
isAbstract
	^ (Smalltalk hasClassNamed: #MczInstaller) not
		! !

!MCMczReader commentStamp: 'TorstenBergmann 2/6/2014 08:08'!
Reader for an MCZ format!
!MCMczReader methodsFor: 'parsing' stamp: 'nicolascellier 6/2/2013 18:36'!
contentsForMember: member
	^[(member contentStreamFromEncoding: 'utf8') text contents] on: ZnInvalidUTF8
		do: [:exc | 
			"Case of legacy encoding, presumably it is latin-1.
			But if contents starts with a null character, it might be a case of WideString encoded in UTF-32BE"
			| str |
			str := (member contentStreamFromEncoding: 'latin1') text.
			exc return: ((str peek = Character null and: [ str size \\ 4 = 0 ])
				ifTrue: [WideString fromByteArray: str contents asByteArray]
				ifFalse: [str contents])]! !

!MCMczReader methodsFor: 'utilities' stamp: 'StephaneDucasse 8/17/2012 15:50'!
extractInfoFrom: dict
	^MCWorkingCopy infoFromDictionary: dict cache: self infoCache! !

!MCMczReader methodsFor: 'parsing' stamp: 'nicolascellier 6/2/2013 18:37'!
parseMember: memberOrName
	| member tokens |
	member := self zip member: memberOrName.
	tokens := (self contentsForMember: member) parseLiterals first.
	^ self associate: tokens! !

!MCMczReader methodsFor: 'loading' stamp: 'stephaneducasse 2/4/2006 20:47'!
loadDependencies
	dependencies := (self zip membersMatching: 'dependencies/*') collect: [:m | self extractDependencyFrom: m].
	dependencies := dependencies asArray.
! !

!MCMczReader methodsFor: 'parsing' stamp: 'nicolascellier 5/31/2013 23:33'!
extractDependencyFrom: zipMember
	^ MCVersionDependency
		package: (MCPackage named: (zipMember fileName copyAfterLast: $/))
		info: (self extractInfoFrom: (self parseMember: zipMember))! !

!MCMczReader methodsFor: 'accessing' stamp: 'CamilloBruni 4/24/2012 15:47'!
zip
	stream closed ifTrue: [ zip := nil].
	zip ifNil:
		[zip := ZipArchive new.
		zip readFrom: self stream].
	^ zip! !

!MCMczReader methodsFor: 'private' stamp: 'nicolascellier 5/31/2013 23:35'!
contentStreamForMember: member
	^[(member contentStreamFromEncoding: 'utf8') text] on: ZnInvalidUTF8
		do: [:exc | 
			"Case of legacy encoding, presumably it is latin-1 and we do not need to do anything
			But if contents starts with a null character, it might be a case of WideString encoded in UTF-32BE"
			| str |
			str := (member contentStreamFromEncoding: 'latin1') text.
			(str peek = Character null and: [ str size \\ 4 = 0 ])
				ifTrue: [str := (WideString fromByteArray: str contents asByteArray) readStream].
			exc return: str]! !

!MCMczReader methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
infoCache
	^ infoCache ifNil: [infoCache := Dictionary new]! !

!MCMczReader methodsFor: 'loading' stamp: 'BenjaminVanRyseghem 8/31/2012 15:10'!
loadVersionInfo

	info := self extractInfoFrom: (self parseMember: 'version')! !

!MCMczReader methodsFor: 'accessing' stamp: 'avi 1/22/2004 20:33'!
scanner
	^ MCScanner! !

!MCMczReader methodsFor: 'loading' stamp: 'stephaneducasse 2/4/2006 20:47'!
loadPackage
	| dict |
	dict := self parseMember: 'package'.
	package := MCPackage named: (dict at: #name)! !

!MCMczReader methodsFor: 'loading' stamp: 'MarianoMartinezPeck 6/17/2012 12:37'!
loadDefinitions
	definitions := OrderedCollection new.
	(self zip memberNamed: 'snapshot.bin') ifNotNil:
		[:m | [^ definitions := (MCDataStream on: m contentStream) next definitions]
			on: Error do: [:fallThrough ]].
	"otherwise"
	(self zip membersMatching: 'snapshot/*')
		do: [:m | self extractDefinitionsFrom: m].
! !

!MCMczReader methodsFor: 'parsing' stamp: 'nicolascellier 6/2/2013 18:36'!
extractDefinitionsFrom: member
	| reader |
	(MCSnapshotReader readerClassForFileNamed: member fileName)
		ifNotNil: [:rc |
			reader := rc on: (self contentsForMember: member) readStream.
			definitions addAll: reader definitions]
! !

!MCMczReader methodsFor: 'converting' stamp: 'stephane.ducasse 3/31/2009 21:23'!
associate: tokens
	| result |
	result := Dictionary new.
	tokens pairsDo: [:key :value | 
					| tmp |
					tmp := value.
					value isString ifFalse: [tmp := value collect: [:ea | self associate: ea]].
					value = 'nil' ifTrue: [tmp := ''].
					result at: key put: tmp].
	^ result! !

!MCMczReader class methodsFor: 'accessing' stamp: 'cwp 8/1/2003 14:59'!
extension
	^ 'mcz'! !

!MCMczReader class methodsFor: 'testing' stamp: 'avi 1/19/2004 14:48'!
supportsDependencies
	^ true! !

!MCMczReader class methodsFor: 'testing' stamp: 'cwp 8/1/2003 12:19'!
supportsVersions
	^ true! !

!MCMczWriter commentStamp: 'TorstenBergmann 2/6/2014 08:08'!
Writing MCZ format!
!MCMczWriter methodsFor: 'visiting' stamp: 'nicolascellier 6/2/2013 18:39'!
writeSnapshot: aSnapshot
	self addString: (self serializeDefinitions: aSnapshot definitions) at: 'snapshot/source.', self snapshotWriterClass extension encodedTo: 'utf8'.
	self addString: (self serializeInBinary: aSnapshot) at: 'snapshot.bin'! !

!MCMczWriter methodsFor: 'serializing' stamp: 'MarianoMartinezPeck 6/17/2012 12:37'!
serializeInBinary: aSnapshot
	| writer s |
	s := RWBinaryOrTextStream on: String new.
	writer := MCDataStream on: s.
	writer nextPut: aSnapshot.
	^ s contents! !

!MCMczWriter methodsFor: 'visiting' stamp: 'avi 2/17/2004 01:48'!
writeDefinitions: aVersion
	self writeSnapshot: aVersion snapshot! !

!MCMczWriter methodsFor: 'visiting' stamp: 'avi 2/17/2004 01:56'!
writeFormat
"	self addString: self format at: 'format'."! !

!MCMczWriter methodsFor: 'visiting' stamp: 'avi 9/13/2004 16:49'!
writeVersion: aVersion
	self writeFormat.
	self writePackage: aVersion package.
	self writeVersionInfo: aVersion info.
	self writeDefinitions: aVersion.
	aVersion dependencies do: [:ea | self writeVersionDependency: ea]! !

!MCMczWriter methodsFor: 'writing' stamp: 'stephaneducasse 2/4/2006 20:47'!
addString: string at: path
	| member |
	member := zip addString: string as: path.
	member desiredCompressionMethod: ZipArchive compressionDeflated 
	! !

!MCMczWriter methodsFor: 'accessing' stamp: 'cwp 8/1/2003 00:06'!
zip
	^ zip! !

!MCMczWriter methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 10:03'!
initialize
	super initialize.
	zip := ZipArchive new.
! !

!MCMczWriter methodsFor: 'serializing' stamp: 'CamilloBruni 7/6/2012 15:52'!
serializeVersionInfo: aVersionInfo
	infoWriter ifNil: [infoWriter := MCVersionInfoWriter new].
	^ String streamContents: [:s |
		infoWriter stream: s.
		infoWriter writeVersionInfo: aVersionInfo]! !

!MCMczWriter methodsFor: 'visiting' stamp: 'nicolascellier 6/2/2013 18:39'!
writeVersionDependency: aVersionDependency
	| string |
	string := (self serializeVersionInfo: aVersionDependency versionInfo).
	self addString: string at: 'dependencies/', aVersionDependency package name encodedTo: 'utf8'! !

!MCMczWriter methodsFor: 'writing' stamp: 'avi 2/17/2004 02:17'!
flush
	zip writeTo: stream.
	stream close! !

!MCMczWriter methodsFor: 'accessing' stamp: 'avi 2/17/2004 01:54'!
format
	^ '1'! !

!MCMczWriter methodsFor: 'accessing' stamp: 'avi 2/17/2004 02:07'!
snapshotWriterClass
	^ MCStWriter! !

!MCMczWriter methodsFor: 'serializing' stamp: 'nicolascellier 5/31/2013 23:07'!
serializeDefinitions: aCollection
	^String streamContents: [:aStream |
		| writer |
		writer := self snapshotWriterClass on: aStream.
		writer writeDefinitions: aCollection]! !

!MCMczWriter methodsFor: 'visiting' stamp: 'nicolascellier 6/2/2013 18:39'!
writePackage: aPackage
	self addString: (self serializePackage: aPackage) at: 'package' encodedTo: 'utf8'! !

!MCMczWriter methodsFor: 'visiting' stamp: 'nicolascellier 6/2/2013 18:39'!
writeVersionInfo: aVersionInfo
	| string |
	string := self serializeVersionInfo: aVersionInfo.
	self addString: string at: 'version' encodedTo: 'utf8'.
! !

!MCMczWriter methodsFor: 'writing' stamp: 'nicolascellier 6/2/2013 18:39'!
addString: string at: path encodedTo: encodingName
	| member |
	member := zip addString: (string convertToEncoding: encodingName) as: path.
	member desiredCompressionMethod: ZipArchive compressionDeflated 
	! !

!MCMczWriter methodsFor: 'serializing' stamp: 'cwp 8/13/2003 01:06'!
serializePackage: aPackage
	^ '(name ''', aPackage name, ''')'! !

!MCMczWriter class methodsFor: 'accessing' stamp: 'cwp 8/1/2003 12:35'!
readerClass
	^ MCMczReader! !

!MCMczWriter class methodsFor: 'writing' stamp: 'stephaneducasse 2/4/2006 20:47'!
fileOut: aVersion on: aStream
	| inst |
	inst := self on: aStream.
	inst writeVersion: aVersion.
	inst flush.
	
! !

!MCMergeBrowser commentStamp: 'TorstenBergmann 2/20/2014 15:52'!
Browser to merge changes!
!MCMergeBrowser methodsFor: 'morphic ui' stamp: 'ab 7/18/2003 18:07'!
getMenu: aMenu
	selection ifNil: [^ aMenu].
	^ self selectionIsConflicted
		ifTrue: [self getConflictMenu: aMenu]
		ifFalse: [self getOperationMenu: aMenu]! !

!MCMergeBrowser methodsFor: 'actions' stamp: 'gvc 5/16/2007 10:40'!
chooseAllNewerConflicts
	"Notify the potential new state of canMerge."
	
	conflicts do: [ :ea | ea chooseNewer ].
	self changed: #text; changed: #list; changed: #canMerge! !

!MCMergeBrowser methodsFor: 'actions' stamp: 'ab 7/18/2003 18:41'!
clearChoice
	self conflictSelectionDo:
		[selection clearChoice.
		self changed: #text; changed: #list]! !

!MCMergeBrowser methodsFor: 'actions' stamp: 'ab 7/18/2003 17:52'!
cancel
	self answer: false! !

!MCMergeBrowser methodsFor: 'actions' stamp: 'gvc 5/16/2007 10:41'!
chooseAllOlderConflicts
	"Notify the potential new state of canMerge."
	
	conflicts do: [ :ea | ea chooseOlder ].
	self changed: #text; changed: #list; changed: #canMerge! !

!MCMergeBrowser methodsFor: 'actions' stamp: 'gvc 5/16/2007 10:41'!
chooseRemote
	"Notify the potential new state of canMerge."
	
	self conflictSelectionDo:
		[selection chooseRemote.
		self changed: #text; changed: #list; changed: #canMerge]! !

!MCMergeBrowser methodsFor: 'actions' stamp: 'ab 7/22/2003 00:49'!
innerButtonRow
	^ self buttonRow:
		#((Keep chooseRemote 'keep the selected change' selectionIsConflicted)
		  (Reject chooseLocal 'reject the selected change' selectionIsConflicted))! !

!MCMergeBrowser methodsFor: 'actions' stamp: 'ab 7/18/2003 16:37'!
getOperationMenu: aMenu
	^ aMenu! !

!MCMergeBrowser methodsFor: 'actions' stamp: 'gvc 5/16/2007 10:41'!
chooseAllUnchosenLocal
	"Notify the potential new state of canMerge."
	
	conflicts do: [ :ea | ea isResolved ifFalse: [ ea chooseLocal ] ].
	self changed: #text; changed: #list; changed: #canMerge! !

!MCMergeBrowser methodsFor: 'morphic ui' stamp: 'nk 10/21/2003 23:35'!
buttonSpecs
	^ #((Merge merge 'Proceed with the merge' canMerge)
		 (Cancel cancel 'Cancel the merge')
		('All Newer' chooseAllNewerConflicts 'Choose all newer conflict versions')
		('All Older' chooseAllOlderConflicts 'Choose all older conflict versions')
		('Rest Local' chooseAllUnchosenLocal 'Choose local versions of all remaining conflicts')
		('Rest Remote' chooseAllUnchosenRemote 'Choose remote versions of all remaining conflicts')
)! !

!MCMergeBrowser methodsFor: 'actions' stamp: 'gvc 5/16/2007 10:41'!
chooseLocal
	"Notify the potential new state of canMerge."
	
	self conflictSelectionDo:
		[selection chooseLocal.
		self changed: #text; changed: #list; changed: #canMerge]! !

!MCMergeBrowser methodsFor: 'actions' stamp: 'ab 7/22/2003 00:51'!
canMerge
	^ merger isMerged! !

!MCMergeBrowser methodsFor: 'actions' stamp: 'gvc 5/16/2007 10:41'!
chooseAllUnchosenRemote
	"Notify the potential new state of canMerge."
	
	conflicts do: [ :ea | ea isResolved ifFalse: [ ea chooseRemote ] ].
	self changed: #text; changed: #list; changed: #canMerge! !

!MCMergeBrowser methodsFor: 'morphic ui' stamp: 'ab 7/19/2003 21:31'!
defaultLabel
	^ 'Merge Browser'! !

!MCMergeBrowser methodsFor: 'actions' stamp: 'GuillermoPolito 9/4/2010 20:38'!
merger: aMerger
	merger := aMerger.
	items := aMerger operations asSortedCollection.
	conflicts := aMerger conflicts sort: [:a :b | a operation <= b operation].! !

!MCMergeBrowser methodsFor: 'actions' stamp: 'tbn 7/6/2010 17:02'!
getConflictMenu: aMenu
	selection remoteChosen
		ifTrue: [aMenu add: 'Undo keep change' target: self selector: #clearChoice]
		ifFalse: [aMenu add: 'Keep change' target: self selector: #chooseRemote].
	selection localChosen
		ifTrue: [aMenu add: 'Undo reject change' target: self selector: #clearChoice]	
		ifFalse: [aMenu add: 'Reject change' target: self selector: #chooseLocal].
	^ aMenu! !

!MCMergeBrowser methodsFor: 'actions' stamp: 'ab 7/18/2003 18:42'!
conflictSelectionDo: aBlock
	self selectionIsConflicted
		ifTrue: aBlock
		ifFalse: [self inform: 'You must have a conflict selected']! !

!MCMergeBrowser methodsFor: 'morphic ui' stamp: 'gvc 4/2/2009 13:14'!
selection: aNumber
	"Notify change of conflicts too."
	
	super selection: aNumber.
	self changed: #selectionIsConflicted! !

!MCMergeBrowser methodsFor: 'actions' stamp: 'ab 7/18/2003 17:52'!
merge
	merger isMerged
		ifFalse: [self inform: 'You must resolve all the conflicts first']
		ifTrue: [self answer: true] ! !

!MCMergeBrowser methodsFor: 'actions' stamp: 'CamilloBruni 8/4/2011 15:10'!
selectionIsConflicted
	selection ifNil: [ ^ false ].
	^ selection isConflict! !

!MCMergeBrowser methodsFor: 'accessing' stamp: 'ab 7/18/2003 16:32'!
items
	^ conflicts, items! !

!MCMergeBrowser methodsFor: 'morphic ui' stamp: 'MarcusDenker 3/25/2013 13:05'!
widgetSpecs
	"ToolBuilder doesn't know about innerButtonRow. Made explicit here."

	^#(
		((buttonRow) (0 0 1 0) (0 0 0 30))
		((listMorph:selection:menu: list selection methodListMenu:) (0 0 1 0.4) (0 30 0 0))
		((buttonRow: #((Keep chooseRemote 'keep the selected change' selectionIsConflicted)
		  (Reject chooseLocal 'reject the selected change' selectionIsConflicted))) (0 0.4 1 0.4) (0 0 0 32))
		((textMorph: text) (0 0.4 1 1) (0 32 0 0))
		)
! !

!MCMergeBrowser class methodsFor: 'as yet unclassified' stamp: 'stephaneducasse 2/4/2006 20:47'!
resolveConflictsInMerger: aMerger
	| inst |
	inst := self new merger: aMerger.
	^ inst showModally ifNil: [false]! !

!MCMergeOrLoadWarning commentStamp: '<historical>'!
A MCMergeOrLoadWarning is a simple warning used when amerge or a load action may override existing entities.!
!MCMergeOrLoadWarning methodsFor: 'accessing' stamp: 'CamilloBruni 1/16/2012 17:42'!
messageText
	| packageNames |
	
	packageNames := versions collect: [ :ea|  ea package name ].
		
	^ String streamContents: [:s |
		s nextPutAll: 'You are about to load new versions of the following packages'; cr;
			nextPutAll: 'that have unsaved changes in the image:'; cr.
			
		packageNames sort do: [:name |
			s cr; space; space; nextPutAll: name].
		
		s cr cr
			nextPutAll: 'If you continue, you will lose these changes:']! !

!MCMergeOrLoadWarning methodsFor: 'exceptionDescription' stamp: 'abc 8/8/2011 12:56'!
defaultAction
	^ ( UIManager default
		confirm: self messageText
		trueChoice: 'Load' translated
		falseChoice: 'Merge' translated
		cancelChoice: 'Cancel' translated
		default: nil ).! !

!MCMergeOrLoadWarning methodsFor: 'accessing' stamp: 'abc 8/8/2011 12:53'!
versions: aCollection
	versions := aCollection! !

!MCMergeOrLoadWarning methodsFor: 'actions' stamp: 'CamilloBruni 9/12/2013 23:32'!
cancel
	^ self resume: nil! !

!MCMergeOrLoadWarning methodsFor: 'actions' stamp: 'CamilloBruni 9/12/2013 23:32'!
merge
	^ self resume: false! !

!MCMergeOrLoadWarning methodsFor: 'actions' stamp: 'CamilloBruni 9/12/2013 23:32'!
load
	^ self resume: true! !

!MCMergeOrLoadWarning class methodsFor: 'signalling' stamp: 'abc 8/8/2011 12:50'!
signalFor: aVersionCollection
	^ self new
		versions: aVersionCollection;
		signal! !

!MCMergeRecord commentStamp: 'TorstenBergmann 2/5/2014 13:49'!
A record for merging!
!MCMergeRecord methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
packageSnapshot
	^ packageSnapshot ifNil: [packageSnapshot := version package snapshot]! !

!MCMergeRecord methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
mergePatch
	^ mergePatch ifNil: [mergePatch := version snapshot patchRelativeToBase: self ancestorSnapshot]! !

!MCMergeRecord methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
ancestorInfo
	^ ancestorInfo ifNil: [ancestorInfo := version info commonAncestorWith: version workingCopy ancestry]! !

!MCMergeRecord methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
imagePatch
	^ imagePatch ifNil: [imagePatch := self packageSnapshot patchRelativeToBase: self ancestorSnapshot]! !

!MCMergeRecord methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
ancestorSnapshot
	^ ancestorSnapshot ifNil: [ancestorSnapshot := version workingCopy findSnapshotWithVersionInfo: self ancestorInfo]! !

!MCMergeRecord methodsFor: 'testing' stamp: 'abc 2/13/2004 17:14'!
isAncestorMerge
	^ version workingCopy ancestry hasAncestor: version info! !

!MCMergeRecord methodsFor: 'accessing' stamp: 'abc 2/13/2004 15:52'!
version
	^ version! !

!MCMergeRecord methodsFor: 'actions' stamp: 'abc 2/13/2004 17:14'!
updateWorkingCopy
	self isAncestorMerge ifFalse:
		[self imageIsClean
			ifTrue: [version workingCopy loaded: version]
			ifFalse: [version workingCopy merged: version]]! !

!MCMergeRecord methodsFor: 'testing' stamp: 'StephaneDucasse 4/27/2010 11:49'!
imageIsClean
	| ancestors |
	ancestors := version workingCopy ancestors.
	^ ancestors size = 1
		and: [(ancestors first = self ancestorInfo)
				and: [self imagePatch isEmpty]]! !

!MCMergeRecord methodsFor: 'initialize-release' stamp: 'stephaneducasse 2/4/2006 20:47'!
initializeWithVersion: aVersion
	version := aVersion! !

!MCMergeRecord class methodsFor: 'instance-creation' stamp: 'abc 2/13/2004 15:52'!
version: aVersion
	^ self basicNew initializeWithVersion: aVersion! !

!MCMergeResolutionRequest commentStamp: 'TorstenBergmann 2/5/2014 13:51'!
Notify to resolve conflicts by merging!
!MCMergeResolutionRequest methodsFor: 'actions' stamp: 'CamilloBruni 9/15/2013 17:52'!
autoMerge
	"If there are not conflicts, merge, otherwise delegate to the UI"
	self hasConflicts
		ifTrue: [ self resolve ]
		ifFalse: [ self merge ]! !

!MCMergeResolutionRequest methodsFor: '*Tool-Diff' stamp: 'gvc 2/7/2009 11:26'!
defaultAction
	"Modally open a merge tool."
	
	^self viewMerger! !

!MCMergeResolutionRequest methodsFor: '*Tool-Diff' stamp: 'SeanDeNigris 1/23/2014 00:02'!
viewPatchMerger
	"Open a modal diff tools browser to perform the merge."

	^ UIManager default merge: self merger informing: messageText.! !

!MCMergeResolutionRequest methodsFor: '*Tool-Diff' stamp: 'gvc 2/9/2010 14:06'!
viewMerger
	"Open a model browser to perform the merge and answer wheter merged."

	^PSMCPatchMorph usedByDefault
		ifTrue: [self viewPatchMerger]
		ifFalse: [(MCMergeBrowser new
					merger: merger;
					label: messageText) showModally]! !

!MCMergeResolutionRequest methodsFor: 'accessing' stamp: 'EstebanLorenzano 11/7/2012 16:13'!
merger: aMerger
	merger := aMerger! !

!MCMergeResolutionRequest methodsFor: 'testing' stamp: 'CamilloBruni 9/15/2013 17:52'!
hasConflicts
	^ self merger conflicts isEmpty not! !

!MCMergeResolutionRequest methodsFor: 'accessing' stamp: 'ab 7/18/2003 18:19'!
merger
	^ merger! !

!MCMergeResolutionRequest methodsFor: 'actions' stamp: 'CamilloBruni 9/15/2013 17:50'!
merge
	self resume: true! !

!MCMergeResolutionRequest methodsFor: 'actions' stamp: 'CamilloBruni 9/15/2013 17:50'!
resolve
	self pass! !

!MCMerger commentStamp: '<historical>'!
A MCMerger is an abstract responsible for performing merge operations and detecting conflicts.!
!MCMerger methodsFor: 'accessing' stamp: 'ab 6/2/2003 01:11'!
mergedSnapshot
	^ MCPatcher apply: self to: self baseSnapshot! !

!MCMerger methodsFor: 'operations' stamp: 'StephaneDucasse 6/24/2011 15:18'!
addConflictWithOperation: anOperation
	self operations add: anOperation beConflict! !

!MCMerger methodsFor: 'accessing' stamp: 'ab 7/18/2003 16:34'!
operations
	^ #()! !

!MCMerger methodsFor: 'accessing' stamp: 'avi 10/6/2004 15:19'!
provisions
	^ #()! !

!MCMerger methodsFor: 'operations' stamp: 'stephaneducasse 2/4/2006 20:47'!
load
	| loader |
	loader := MCPackageLoader new.
	loader provisions addAll: self provisions.
	self applyTo: loader.
	loader load! !

!MCMerger methodsFor: 'accessing' stamp: 'StephaneDucasse 6/24/2011 15:14'!
conflicts	
	^ self operations select: #isConflict
! !

!MCMerger methodsFor: 'operations' stamp: 'StephaneDucasse 6/24/2011 15:05'!
applyTo: anObject
	self isMerged ifFalse: [self error: 'You must resolve all the conflicts first'].
	self operations do: [:ea | ea applyTo: anObject]! !

!MCMerger methodsFor: 'testing' stamp: 'ab 6/5/2003 19:09'!
isMerged
	^ self conflicts allSatisfy: [:ea | ea isResolved]! !

!MCMerger methodsFor: 'operations' stamp: 'stephaneducasse 2/4/2006 20:47'!
loadWithNameLike: baseName
	| loader |
	loader := MCPackageLoader new.
	loader provisions addAll: self provisions.
	self applyTo: loader.
	loader loadWithNameLike: baseName! !

!MCMergingTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:47'!
testMultiPackageMerge2
	| merger |
	conflicts := #().
	merger := MCThreeWayMerger new.
	merger addBaseSnapshot: (self snapshotWithElements: #(a1 b1)).
	merger applyPatch: ((self snapshotWithElements: #()) patchRelativeToBase: (self snapshotWithElements: #(a1))).
	merger applyPatch: ((self snapshotWithElements: #(a1 b1)) patchRelativeToBase: (self snapshotWithElements: #(b1))).
	merger conflicts do: [:ea | self handleConflict: ea].
	self assert: merger mergedSnapshot definitions hasElements: #(a1 b1).
	self assert: conflicts isEmpty! !

!MCMergingTest methodsFor: 'tests' stamp: 'ab 12/5/2002 01:31'!
testSubtractiveConflictlessMerge
	self assertMerge: #(a1 b1)
				with: #()
				base: #(a1)
				
				gives: #(b1)
				conflicts: #()! !

!MCMergingTest methodsFor: 'tests' stamp: 'ab 12/5/2002 00:27'!
testComplexConflictlessMerge
	self 
		assertMerge: #(a1 b1 d1)
				with: #(a2 c1)
				base: #(a1 c1 d1)
				
				gives: #(a2 b1)
				conflicts: #()! !

!MCMergingTest methodsFor: 'tests' stamp: 'ab 12/5/2002 00:28'!
testAdditiveConflictlessMerge
	self
		assertMerge: #(a1 b1)
				with: #(a1 c1)
				base: #(a1)
			
				gives: #(a1 b1 c1)
				conflicts: #()! !

!MCMergingTest methodsFor: 'tests' stamp: 'ab 6/2/2003 01:43'!
testLocalRemoveRemoteModify
	self assertMerge: #(b1)
				with: #(a1 b1)
				base: #(a2 b1)
				
				gives: #(a1 b1)
				conflicts: #((a1 removed)).

	self assertMerge: #(b1)
				with: #(a2 b1)
				base: #(a1 b1)
				
				gives: #(a2 b1)
				conflicts: #((a2 removed)).! !

!MCMergingTest methodsFor: 'tests' stamp: 'ab 6/2/2003 01:38'!
testSimultaneousModification
	self assertMerge: #(a2)
				with: #(a3)
				base: #(a1)
				
				gives: #(a3)
				conflicts: #((a3 a2)).! !

!MCMergingTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:47'!
testMultiPackageMerge
	| merger |
	conflicts := #().
	merger := MCThreeWayMerger new.
	merger addBaseSnapshot: (self snapshotWithElements: #(a1 b1)).
	merger applyPatch: ((self snapshotWithElements: #()) patchRelativeToBase: (self snapshotWithElements: #(a1))).
	merger applyPatch: ((self snapshotWithElements: #(a2 b1)) patchRelativeToBase: (self snapshotWithElements: #(b1))).
	merger conflicts do: [:ea | self handleConflict: ea].
	self assert: merger mergedSnapshot definitions hasElements: #(a2 b1).
	self assert: conflicts isEmpty! !

!MCMergingTest methodsFor: 'tests' stamp: 'ab 6/2/2003 01:38'!
testMultipleConflicts
	self assertMerge: #(a1 b3 c1)
				with: #(a1 b2 d1)
				base: #(a1 b1 c2)
				
				gives: #(a1 b3 d1)
				conflicts: #((removed c1) (b2 b3))
! !

!MCMergingTest methodsFor: 'tests' stamp: 'ab 12/5/2002 00:28'!
testIdenticalModification
	self
		assertMerge: #(a2 b1)
				with: #(a2 b1)
				base: #(a1 b1)
				
				gives: #(a2 b1)
				conflicts: #()! !

!MCMergingTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:47'!
testMultiPackageMerge3
	| merger |
	conflicts := #().
	merger := MCThreeWayMerger new.
	merger addBaseSnapshot: (self snapshotWithElements: #(a1 b1)).
	merger applyPatch: ((self snapshotWithElements: #(a1 b1)) patchRelativeToBase: (self snapshotWithElements: #(b1))).
	merger applyPatch: ((self snapshotWithElements: #()) patchRelativeToBase: (self snapshotWithElements: #(a1))).
	merger conflicts do: [:ea | self handleConflict: ea].
	self assert: merger mergedSnapshot definitions hasElements: #(a1 b1).
	self assert: conflicts isEmpty! !

!MCMergingTest methodsFor: 'asserting' stamp: 'stephaneducasse 2/4/2006 20:47'!
assertMerge: local with: remote base: ancestor gives: result conflicts: conflictResult
	| merger |
	conflicts := #().
	merger := MCThreeWayMerger
				base: (self snapshotWithElements: local)
				target: (self snapshotWithElements: remote)
				ancestor: (self snapshotWithElements: ancestor).
	merger conflicts do: [:ea | self handleConflict: ea].
	self assert: merger mergedSnapshot definitions hasElements: result.
	self assert: conflicts asSet = conflictResult asSet.! !

!MCMergingTest methodsFor: 'emulating' stamp: 'marcus.denker 11/10/2008 10:04'!
handleConflict: aConflict	
	|l r|
	l := #removed.
	r := #removed.
	aConflict localDefinition ifNotNil: [:d | l := d token].
	aConflict remoteDefinition ifNotNil: [:d | r := d token].	
	conflicts := conflicts copyWith: (Array with: r with: l).
	(l = #removed or: [r = #removed])
		ifTrue: [aConflict chooseRemote]
		ifFalse:
			[l > r
				ifTrue: [aConflict chooseLocal]
				ifFalse: [aConflict chooseRemote]]
		! !

!MCMergingTest methodsFor: 'emulating' stamp: 'ab 7/6/2003 23:48'!
snapshotWithElements: anArray
	^ MCSnapshot
		fromDefinitions: (anArray collect: [:t | self mockToken: t])! !

!MCMergingTest methodsFor: 'tests' stamp: 'ab 12/5/2002 01:27'!
testSimultaneousRemove
	self assertMerge: #(a1)
				with: #(a1)
				base: #(a1 b1)
				
				gives: #(a1)
				conflicts: #()! !

!MCMergingTest methodsFor: 'asserting' stamp: 'ab 1/15/2003 16:46'!
assert: aCollection hasElements: anArray
	self assert: (aCollection collect: [:ea | ea token]) asSet = anArray asSet! !

!MCMergingTest methodsFor: 'tests' stamp: 'ab 6/2/2003 01:44'!
testLocalModifyRemoteRemove
	self assertMerge: #(a2 b1)
				with: #(b1)
				base: #(a1 b1)
				
				gives: #(b1)
				conflicts: #((removed a2)).
				
	self assertMerge: #(a1 b1)
				with: #(b1)
				base: #(a2 b1)
				
				gives: #(b1)
				conflicts: #((removed a1)).! !

!MCMethodDefinition commentStamp: '<historical>'!
A MCMethodDefinition represents a method definition. 
It captures the following information.

Instance Variables
	category:		<Object>
	classIsMeta:		<Object>
	className:		<Object>
	selector:		<Object>
	source:		<Object>
	timeStamp:		<Object>

!
!MCMethodDefinition methodsFor: 'accessing' stamp: 'ab 11/15/2002 01:11'!
selector
	^selector! !

!MCMethodDefinition methodsFor: 'printing' stamp: 'ab 12/5/2002 21:25'!
description
	^ Array	
		with: className
		with: selector
		with: classIsMeta! !

!MCMethodDefinition methodsFor: 'comparing' stamp: 'ab 5/24/2003 14:11'!
requirements
	^ Array with: className! !

!MCMethodDefinition methodsFor: 'installing' stamp: 'avi 9/17/2003 22:27'!
isExtensionMethod
	^ category beginsWith: '*'! !

!MCMethodDefinition methodsFor: 'installing' stamp: 'avi 11/10/2003 15:45'!
isOverrideMethod
	"this oughta check the package"
	^ self isExtensionMethod and: [category endsWith: '-override']! !

!MCMethodDefinition methodsFor: 'printing' stamp: 'BenjaminVanRyseghem 9/28/2011 15:24'!
shortSummaryPrefix

	^ self definition selector asString! !

!MCMethodDefinition methodsFor: '*Komitter-UI' stamp: 'NicolaiHess 4/8/2014 20:06'!
koClass
	self className ifNil: [ ^ nil ] ifNotNil: [ :cname |
		self isExtensionMethod 
		ifTrue:[  ^ KomitClass trackedClass: cname forExtension: self  category]
		ifFalse:[ ^ KomitClass trackedClass: cname ]
		]! !

!MCMethodDefinition methodsFor: 'accessing' stamp: 'lr 3/14/2010 21:13'!
actualClass
	^ Smalltalk globals
		at: className
		ifPresent: [ :class | 
			classIsMeta
				ifTrue: [ class classSide ]
				ifFalse: [ class ] ]! !

!MCMethodDefinition methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/21/2013 21:59'!
addOperation: aMCAddition on: aKOClass 
	
	aKOClass addMethodDefinition: aMCAddition! !

!MCMethodDefinition methodsFor: 'visiting' stamp: 'ab 7/18/2003 21:47'!
accept: aVisitor
	^ aVisitor visitMethodDefinition: self! !

!MCMethodDefinition methodsFor: 'installing' stamp: 'ThierryGoubier 1/13/2014 20:46'!
removeSelector: aSelector fromClass: aClass
	"Safely remove the given selector from the target class.
	Be careful not to remove the selector when it has wandered
	to another package, but remove the category if it is empty."

	| newCategory |
	newCategory := aClass organization categoryOfElement: aSelector.
	newCategory
		ifNotNil: [ 
			"If moved to and fro extension, ignore removal"
			(category beginsWith: '*') = (newCategory beginsWith: '*')
				ifFalse: [ ^ self ].	"Check if moved between different extension categories"
			((category beginsWith: '*') and: [ category ~= newCategory ])
				ifTrue: [ ^ self ] ].
	aClass removeSelector: aSelector.
	aClass organization removeProtocolIfEmpty: category! !

!MCMethodDefinition methodsFor: 'accessing' stamp: 'stephaneDucasse 5/8/2010 19:58'!
load
	self actualClass
		compile: source
		classified: category
		withStamp: timeStamp
		notifying: nil! !

!MCMethodDefinition methodsFor: 'accessing' stamp: 'ab 11/13/2002 01:59'!
source
	^ source! !

!MCMethodDefinition methodsFor: 'installing' stamp: 'ar 12/12/2009 15:40'!
unload
	| previousVersion |
	self isOverrideMethod ifTrue: [previousVersion := self scanForPreviousVersion].
	previousVersion
		ifNil: [self actualClass ifNotNil:[:class| self removeSelector: selector fromClass: class]]
		ifNotNil: [previousVersion fileIn] ! !

!MCMethodDefinition methodsFor: 'printing' stamp: 'al 12/3/2005 12:15'!
fullClassName
	"Using #class selector for classes for backwards compatibility"

	^ self classIsMeta
		ifFalse: [self className]
		ifTrue: [
			(self actualClass isNil or: [ self actualClass isTrait ])
				ifFalse: [self className, ' class']
				ifTrue: [self className, ' classSide']]! !

!MCMethodDefinition methodsFor: 'accessing' stamp: 'ab 1/15/2003 13:42'!
timeStamp
	^ timeStamp! !

!MCMethodDefinition methodsFor: 'testing' stamp: 'GuillermoPolito 1/11/2012 22:53'!
isLoadable
	^self actualClass notNil! !

!MCMethodDefinition methodsFor: 'installing' stamp: 'stephaneDucasse 5/8/2010 19:58'!
addMethodAdditionTo: aCollection
	| methodAddition |
	methodAddition := MethodAddition new
		compile: source
		classified: category
		withStamp: timeStamp
		notifying: nil
		logSource: true
		inClass: self actualClass.
	"This might raise an exception and never return"
	methodAddition createCompiledMethod.
	aCollection add: methodAddition.
! !

!MCMethodDefinition methodsFor: 'annotations' stamp: 'StephaneDucasse 12/30/2012 18:04'!
printAnnotations: requests on: aStream
	"Add a string for an annotation pane, trying to fulfill the browser annotationRequests."
	
	requests do: [ :aRequest |
		aRequest == #timeStamp ifTrue: [ aStream nextPutAll: self timeStamp ].
		aRequest == #messageCategory ifTrue: [ aStream nextPutAll: self category ].
		aRequest == #requirements ifTrue: [
			self requirements do: [ :req |
				aStream nextPutAll: req ] separatedBy: [ aStream space ]].
	] separatedBy: [ aStream space ].! !

!MCMethodDefinition methodsFor: 'testing' stamp: 'ab 8/8/2003 17:05'!
isInitializer
	^ selector = #initialize and: [classIsMeta]
	! !

!MCMethodDefinition methodsFor: 'comparing' stamp: 'stephaneducasse 2/4/2006 20:47'!
hash
	| hash |
	hash := String stringHash: classIsMeta asString initialHash: 0.
	hash := String stringHash: source initialHash: hash.
	hash := String stringHash: category initialHash: hash.
	hash := String stringHash: className initialHash: hash.
	^ hash! !

!MCMethodDefinition methodsFor: 'accessing' stamp: 'dkh 2/16/2012 14:49:00'!
setTimeStamp: aString
    ^ timeStamp := aString! !

!MCMethodDefinition methodsFor: 'accessing' stamp: 'ab 11/13/2002 01:59'!
category
	^ category! !

!MCMethodDefinition methodsFor: 'comparing' stamp: 'ab 7/19/2003 18:01'!
sortKey
	^ self className, '.', (self classIsMeta ifTrue: ['meta'] ifFalse: ['nonmeta']), '.', self selector! !

!MCMethodDefinition methodsFor: 'installing' stamp: 'PavelKrivanek 6/22/2011 09:47'!
postloadOver: aDefinition
	super postloadOver: aDefinition.
	self class initializersEnabled ifTrue: [
		(self isInitializer
			and: [ self actualClass isTrait not 
					and: [ aDefinition isNil or: [ self source ~= aDefinition source ]]]) ifTrue: [
				self actualClass theNonMetaClass initialize ] ].
	"Postloading of FFI fields."
	self isExternalStructureFieldDefinition
		ifTrue: [self actualClass theNonMetaClass compileFields].! !

!MCMethodDefinition methodsFor: 'accessing' stamp: 'ab 11/15/2002 01:12'!
className
	^className! !

!MCMethodDefinition methodsFor: 'serializing' stamp: 'stephaneducasse 2/4/2006 20:47'!
initializeWithClassName: classString
classIsMeta: metaBoolean
selector: selectorString
category: catString
timeStamp: timeString
source: sourceString
	className := classString asSymbol.
	selector := selectorString asSymbol.
	category := catString asSymbol.
	timeStamp := timeString.
	classIsMeta := metaBoolean.
	source := sourceString withSqueakLineEndings.
! !

!MCMethodDefinition methodsFor: 'printing' stamp: 'BenjaminVanRyseghem 9/28/2011 15:26'!
summary

	^ selector! !

!MCMethodDefinition methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/22/2013 16:30'!
fullTimeStamp
	^ DateAndTime fromMethodTimeStamp: timeStamp! !

!MCMethodDefinition methodsFor: 'comparing' stamp: 'ThierryGoubier 4/9/2015 23:18'!
= aDefinition
	^ super = aDefinition
		and: [ 
			aDefinition category = self category
				and: [ aDefinition source withSqueakLineEndings = self source withSqueakLineEndings ] ]! !

!MCMethodDefinition methodsFor: '*Ring-Monticello' stamp: 'MarcusDenker 8/1/2014 14:14'!
asRingDefinition

	^RGMethodDefinition new
		name: self selector;
		parentName: self className;
		isMetaSide: self classIsMeta;
		protocol: self category;
		sourceCode: self source;    
		stamp: self timeStamp! !

!MCMethodDefinition methodsFor: 'testing' stamp: 'ab 5/24/2003 13:49'!
isCodeDefinition
	^ true! !

!MCMethodDefinition methodsFor: 'installing' stamp: 'MartinDias 11/6/2013 16:04'!
scanForPreviousVersion
	^ SourceFiles
		changeRecordsFor: self asRingDefinition
		detect: [ :protocol | 
			protocol ~= category ]! !

!MCMethodDefinition methodsFor: 'testing' stamp: 'ab 12/4/2002 21:52'!
isMethodDefinition
	^true! !

!MCMethodDefinition methodsFor: 'accessing' stamp: 'LucasGiudice 9/14/2013 14:58'!
diffSource
	^'"protocol: ', self category,'"
', self source.! !

!MCMethodDefinition methodsFor: 'accessing' stamp: 'cwp 11/25/2002 07:26'!
classIsMeta
	^ classIsMeta! !

!MCMethodDefinition methodsFor: 'installing' stamp: 'NicoPaez 10/1/2010 10:30'!
isExternalStructureFieldDefinition
	"Really belongs in the FFI package, for now, include in base even if FFI is not loaded due to the dire consequences if its not here and an FFI package is loaded (incorrect field compilation can cause VM crashes).
	
	If in the future other external packages are found to need custom post-load blocks as well, a pluggable way of doing so should be investigated, but for now it's not worth the effort and coordination required with external package maintainers"
	^ selector = #fields
		and: [classIsMeta
			and: [
				(Smalltalk globals at: #ExternalStructure ifPresent: [:externalStructure |
					self actualClass theNonMetaClass inheritsFrom: externalStructure]) == true]]
! !

!MCMethodDefinition class methodsFor: 'cleanup' stamp: 'StephaneDucasse 3/9/2010 16:34'!
cleanUp
	"Flush caches"

	self shutDown.! !

!MCMethodDefinition class methodsFor: 'initialization' stamp: 'ab 8/22/2003 18:14'!
initialize
	Smalltalk addToShutDownList: self! !

!MCMethodDefinition class methodsFor: 'initialization' stamp: 'StephaneDucasse 12/28/2012 21:31'!
shutDown
	"Free up all cached monticello method definitions"
	self flushMethodCache ! !

!MCMethodDefinition class methodsFor: 'instance creation' stamp: 'ab 7/26/2003 02:05'!
className: classString
classIsMeta: metaBoolean
selector: selectorString
category: catString
timeStamp: timeString
source: sourceString
	^ self instanceLike:
		(self new initializeWithClassName: classString
					classIsMeta: metaBoolean
					selector: selectorString
					category: catString
					timeStamp: timeString
					source: sourceString)! !

!MCMethodDefinition class methodsFor: 'instance creation' stamp: 'MarcusDenker 7/17/2014 16:51'!
forMethodReference: aMethodReference
	| definition |
	definition := self cachedDefinitions at: aMethodReference compiledMethod ifAbsent: [].
	(definition isNil
		or: [definition selector ~= aMethodReference selector
		or: [definition className ~= aMethodReference className
		or: [definition classIsMeta ~= aMethodReference classIsMeta
		or: [definition category ~= aMethodReference category]]]])
			ifTrue: [
				definition := self 
					className: aMethodReference className
					classIsMeta: aMethodReference classIsMeta
					selector: aMethodReference selector
					category: aMethodReference category
					timeStamp: aMethodReference timeStampString
					source: aMethodReference source.
				self cachedDefinitions at: aMethodReference compiledMethod put: definition].
	^ definition
	! !

!MCMethodDefinition class methodsFor: 'settings' stamp: 'PavelKrivanek 6/22/2011 11:40'!
initializersEnabled: aBoolean

	InitializersEnabled := aBoolean! !

!MCMethodDefinition class methodsFor: 'initialization' stamp: 'CamilloBruni 6/2/2012 00:13'!
cachedDefinitions
	Definitions ifNil: [ Definitions := WeakIdentityKeyDictionary new ].
	^ Definitions! !

!MCMethodDefinition class methodsFor: 'settings' stamp: 'PavelKrivanek 6/22/2011 11:40'!
initializersEnabled

	^ InitializersEnabled ifNil: [true]! !

!MCMethodDefinition class methodsFor: 'instance creation' stamp: 'ab 4/1/2003 01:40'!
className: classString
selector: selectorString
category: catString
timeStamp: timeString
source: sourceString
	^ self	className: classString
			classIsMeta: false
			selector: selectorString
			category: catString
			timeStamp: timeString
			source: sourceString! !

!MCMethodDefinition class methodsFor: 'instance creation' stamp: 'ThierryGoubier 10/25/2013 15:06'!
instanceLike: aDefinition
	"The cache is playing havoc with the equality between methods. Methods of the same code but with different timestamps are considered equal. This breaks havoc with some filetree testing code which looks at timestamps."

	| aMCMethodDefinition |
	aMCMethodDefinition := super instanceLike: aDefinition.
	^ aMCMethodDefinition timeStamp ~= aDefinition timeStamp
		ifTrue: [ Instances add: aDefinition ]
		ifFalse: [ aMCMethodDefinition ]! !

!MCMethodDefinition class methodsFor: 'initialization' stamp: 'StephaneDucasse 12/28/2012 21:31'!
flushMethodCache
	"We do not named this method flushCache because it would override an important class methods."
	
	Definitions := nil.! !

!MCMethodDefinitionTest methodsFor: 'mocks' stamp: 'EstebanLorenzano 9/8/2013 11:54'!
override ^ 1! !

!MCMethodDefinitionTest methodsFor: 'testing' stamp: 'VeronicaUquillas 8/23/2011 11:47'!
testPartiallyRevertOverrideMethod
	| definition |
	self class compile: 'override ^ 2' classified: '*foobarbaz'.
	self class compile: 'override ^ 3' classified: self mockOverrideMethodCategory.
	self class compile: 'override ^ 4' classified: self mockOverrideMethodCategory.
	definition := (RGMethodDefinition realClass: self class selector: #override) asMCMethodDefinition.
	self assert: definition isOverrideMethod.
	self assert: self override = 4.
	definition unload.
	self assert: self override = 2.
	self assert: (RGMethodDefinition realClass: self class selector: #override) category = '*foobarbaz'.
	! !

!MCMethodDefinitionTest methodsFor: 'testing' stamp: 'GuillermoPolito 8/24/2012 13:48'!
testRevertOldMethod
	| definition changeRecord |
	Object compile: 'yourself ^ self' classified: '*MonticelloMocks'.
	definition := (RGMethodDefinition realClass: Object selector: #yourself) asMCMethodDefinition.
	changeRecord := definition scanForPreviousVersion.
	self assert: changeRecord notNil.
	self assert: changeRecord category = 'accessing'.
	changeRecord fileIn.! !

!MCMethodDefinitionTest methodsFor: 'testing' stamp: 'VeronicaUquillas 8/24/2011 11:47'!
testRevertOverrideMethod
	| definition |
	self class compile: 'override ^ 2' classified: self mockOverrideMethodCategory.
	definition := (RGMethodDefinition realClass: self class selector: #override) asMCMethodDefinition.
	self assert: definition isOverrideMethod.
	self assert: self override = 2.
	definition unload.
	self assert: self override = 1.
	self assert: (RGMethodDefinition realClass: self class selector: #override) category = 'mocks'.
	! !

!MCMethodDefinitionTest methodsFor: 'running' stamp: 'abc 8/24/2012 16:13'!
tearDown
       self restoreMocks.
       (MCWorkingCopy forPackage: (MCPackage named: 'FooBarBaz')) unregister.
       self class compile: 'override ^ 1' classified: 'mocks'.
       self ownPackage modified: isModified.

       "FIXME: Unregister Monticellomocks if it got created implicitly.
       This avoids a nasty failure of MCChangeNotificationTest due to
       some inconsistency about whether package names are case sensitive
       or not. They're treated as case insensitive in some name lookups but not
       in others; most importantly PackageOrganizer default treats package
       names as being case sensitive. The package created here is Monticellomocks
       (lower case mocks) and an instance of PackageInfo; the package expected
       in MCChangeNotificationTest is MonticelloMocks and an instance of
       MCMockPackageInfo. Since *that* lookup is case insensitive it can
       find Monticellomocks instead of MonticelloMocks and fail."
       "PackageOrganizer default unregisterPackageNamed: 'MonticelloMocks'."! !

!MCMethodDefinitionTest methodsFor: 'running' stamp: 'cwp 11/13/2003 14:15'!
ownPackage
	^ MCWorkingCopy forPackage: (MCPackage named: 'Monticello')! !

!MCMethodDefinitionTest methodsFor: 'testing' stamp: 'stephaneducasse 2/4/2006 20:47'!
testCannotLoad
	| definition |
	definition := self mockMethod: #kjahs87 class: 'NoSuchClass' source: 'kjahs87 ^self' meta: false.
	self should: [definition load] raise: Error.
	self assert: (navigation allImplementorsOf: #kjahs87) isEmpty! !

!MCMethodDefinitionTest methodsFor: 'testing' stamp: 'stephaneducasse 2/4/2006 20:47'!
testComparison
	|d1 d2 d3 d4 d5 |
	d1 := self mockMethod: #one class: 'A' source: '1' meta: false.
	d2 := self mockMethod: #one class: 'A' source: '2' meta: false.
	d3 := self mockMethod: #one class: 'A' source: '1' meta: true.
	d4 := self mockMethod: #two class: 'A' source: '1' meta: false.
	d5 := self mockMethod: #two class: 'A' source: '1' meta: false.
	
	self assert: (d1 isRevisionOf: d2).
	self deny: (d1 isSameRevisionAs: d2).
	
	self deny: (d1 isRevisionOf: d3).
	self deny: (d1 isRevisionOf: d4).
	
	self assert: (d4 isSameRevisionAs: d5).! !

!MCMethodDefinitionTest methodsFor: 'running' stamp: 'lr 3/14/2010 21:13'!
setUp
	navigation := (Smalltalk hasClassNamed: #SystemNavigation)
		ifTrue: [ (Smalltalk globals at: #SystemNavigation) new ]
		ifFalse: [ Smalltalk ].
	isModified := self ownPackage modified! !

!MCMethodDefinitionTest methodsFor: 'testing' stamp: 'stephaneducasse 2/4/2006 20:47'!
testLoadAndUnload
	|definition|
	definition := self mockMethod: #one class: 'MCMockClassA' source: 'one ^2' meta: false.
	self assert: self mockInstanceA one = 1.
	definition load.
	self assert: self mockInstanceA one = 2.
	definition unload.
	self deny: (self mockInstanceA respondsTo: #one)! !

!MCMock commentStamp: 'TorstenBergmann 2/5/2014 13:51'!
Common superclass for mocks!
!MCMock class methodsFor: 'as yet unclassified' stamp: 'cwp 7/21/2003 19:40'!
wantsChangeSetLogging
	^ false! !

!MCMockAPoolDictionary commentStamp: 'TorstenBergmann 2/5/2014 13:52'!
Mocking a pool!
!MCMockASubclass methodsFor: 'as yet unclassified' stamp: 'ab 7/7/2003 23:21'!
variables2
	^ ivar + CVar! !

!MCMockASubclass methodsFor: 'as yet unclassified' stamp: 'ab 7/7/2003 23:21'!
variables
	^ x + Y + MCMockClassA! !

!MCMockASubclass class methodsFor: 'as yet unclassified' stamp: 'pavel.krivanek 10/14/2010 16:23'!
initialize

	InitializationOrder := InitializationOrder
		ifNil: [ -100 ] "let the test fail"
		ifNotNil: [ InitializationOrder + 1.]! !

!MCMockClassA commentStamp: 'cwp 8/10/2003 16:43'!
This is a mock class. The Monticello tests manipulated it to simulate a developer modifying code in the image.!
!MCMockClassA methodsFor: 'numeric' stamp: 'GuillermoPolito 8/24/2012 15:28'!
two
	^ 2! !

!MCMockClassA methodsFor: 'boolean' stamp: 'cwp 7/13/2003 02:49'!
falsehood
	^ false! !

!MCMockClassA methodsFor: 'drag''n''drop' stamp: 'avi 9/23/2003 17:14'!
q! !

!MCMockClassA methodsFor: 'boolean' stamp: 'ab 7/7/2003 23:21'!
moreTruth

	^ true! !

!MCMockClassA methodsFor: 'numeric' stamp: ''!
c
	^ 'c1'! !

!MCMockClassA methodsFor: 'numeric' stamp: 'GuillermoPolito 8/24/2012 15:31'!
d
	^ 'd'! !

!MCMockClassA methodsFor: 'numeric' stamp: 'GuillermoPolito 8/24/2012 15:29'!
a
	^ 'a2'! !

!MCMockClassA methodsFor: 'numeric' stamp: 'GuillermoPolito 8/24/2012 15:29'!
b
	^ 'b1'! !

!MCMockClassA methodsFor: 'numeric' stamp: 'GuillermoPolito 8/24/2012 15:22'!
one
	^ 1! !

!MCMockClassA methodsFor: 'boolean' stamp: 'GuillermoPolito 8/24/2012 15:31'!
truth
	^ true! !

!MCMockClassA class methodsFor: 'as yet unclassified' stamp: 'stephaneducasse 2/4/2006 20:47'!
touchCVar
	CVar := #touched! !

!MCMockClassA class methodsFor: 'as yet unclassified' stamp: 'pavel.krivanek 10/14/2010 16:21'!
initialize
	CVar := #initialized.
	InitializationOrder := 1.
! !

!MCMockClassA class methodsFor: 'as yet unclassified' stamp: 'cwp 8/10/2003 02:31'!
cVar
	^ CVar! !

!MCMockClassA class methodsFor: 'as yet unclassified' stamp: '10/14/2010 15:41'!
initializationOrder

	^ InitializationOrder! !

!MCMockClassA class methodsFor: 'as yet unclassified' stamp: 'ab 7/7/2003 23:21'!
one

	^ 1! !

!MCMockClassB commentStamp: ''!
This comment has a bang!! Bang!! Bang!!!
!MCMockClassD methodsFor: 'as yet unclassified' stamp: 'cwp 7/8/2003 21:21'!
one
	^ 1! !

!MCMockClassE class methodsFor: 'as yet unclassified' stamp: 'cwp 7/8/2003 21:22'!
two
	^ 2! !

!MCMockDefinition commentStamp: 'TorstenBergmann 2/5/2014 13:46'!
A mock definition used for testing purposes!
!MCMockDefinition methodsFor: 'comparing' stamp: 'ab 7/7/2003 23:21'!
hash

	^ token hash! !

!MCMockDefinition methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
token: aString

	token := aString! !

!MCMockDefinition methodsFor: 'comparing' stamp: 'ab 7/7/2003 23:21'!
description

	^ token first! !

!MCMockDefinition methodsFor: 'comparing' stamp: 'MarianoMartinezPeck 5/30/2012 17:12'!
= definition
	self == definition
		ifTrue: [ ^ true ].
	self species = definition species
		ifFalse: [ ^ false ].
	^definition token = token! !

!MCMockDefinition methodsFor: 'printing' stamp: 'ab 7/7/2003 23:21'!
printString

	^ token! !

!MCMockDefinition methodsFor: 'accessing' stamp: 'ab 7/7/2003 23:21'!
token

	^ token! !

!MCMockDefinition methodsFor: 'printing' stamp: 'ab 7/7/2003 23:21'!
summary

	^ token! !

!MCMockDefinition methodsFor: 'converting' stamp: 'ab 7/7/2003 23:21'!
asString

	^ token! !

!MCMockDefinition class methodsFor: 'accessing' stamp: 'ab 7/7/2003 23:21'!
token: aString

	^ self new token: aString! !

!MCMockDefinition class methodsFor: 'compiling' stamp: 'cwp 7/21/2003 19:46'!
wantsChangeSetLogging
	^ false! !

!MCMockDependency methodsFor: 'comparing' stamp: 'cwp 11/7/2004 13:33'!
hash
	^ self name hash! !

!MCMockDependency methodsFor: 'comparing' stamp: 'cwp 11/7/2004 13:32'!
= other
	^ self name = other name! !

!MCMockDependency methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
initializeWithTree: expr
	expr isSymbol
		ifTrue: [name := expr.
				children := Array new.
				hasResolution := true.]
		ifFalse: [name := expr first.
				expr second isSymbol
					ifTrue: [hasResolution := false.
							children := Array new]
					ifFalse: [hasResolution := true.
							children := expr second]]! !

!MCMockDependency methodsFor: 'resolving' stamp: 'cwp 11/7/2004 14:42'!
hasResolution
	^ hasResolution! !

!MCMockDependency methodsFor: 'mocks' stamp: 'cwp 11/7/2004 14:41'!
mockVersionInfo
	^ MCVersionInfo
		name: self name
		id: (self uuidForName: name)
		message: ''
		date: nil
		time: nil
		author: ''
		ancestors: #()! !

!MCMockDependency methodsFor: 'accessing' stamp: 'cwp 11/7/2004 14:43'!
children
	^ children collect: [:ea | self class fromTree: ea]! !

!MCMockDependency methodsFor: 'resolving' stamp: 'cwp 11/7/2004 14:16'!
resolve
	^ self hasResolution
		ifTrue: [MCVersion new
					setPackage: MCSnapshotResource mockPackage
					info: self mockVersionInfo
					snapshot: MCSnapshotResource current snapshot
					dependencies: self children]
		ifFalse: [nil]! !

!MCMockDependency methodsFor: 'mocks' stamp: 'nk 2/22/2005 21:17'!
uuidForName: aName 
	| nm id |
	nm := aName asString.
	id := '00000000-0000-0000-0000-0000000000' 
				, (nm size = 1 ifTrue: [nm , '0'] ifFalse: [nm]).
	^UUID fromString: id! !

!MCMockDependency methodsFor: 'accessing' stamp: 'cwp 11/7/2004 14:38'!
name
	^ name! !

!MCMockDependency class methodsFor: 'instance creation' stamp: 'cwp 11/7/2004 14:43'!
fromTree: anArray 
	^ self new initializeWithTree: anArray! !

!MCMockDependentItem commentStamp: 'TorstenBergmann 2/5/2014 13:52'!
Mock for dependency testing!
!MCMockDependentItem methodsFor: 'accessing' stamp: 'ab 7/7/2003 23:21'!
provisions

	^ provides ifNil: [#()]! !

!MCMockDependentItem methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
name: aString

	name := aString! !

!MCMockDependentItem methodsFor: 'comparing' stamp: 'ab 7/7/2003 23:21'!
requirements

	^ requires ifNil: [#()]! !

!MCMockDependentItem methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
requires: anArray

	requires := anArray! !

!MCMockDependentItem methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
provides: anArray

	provides := anArray! !

!MCMockDependentItem methodsFor: 'accessing' stamp: 'ab 7/7/2003 23:21'!
name

	^ name! !

!MCMockDependentItem methodsFor: 'comparing' stamp: 'bf 5/20/2005 16:15'!
<= other
	^ self name <= other name! !

!MCMockRPackage commentStamp: 'cyrilledelaunay 1/24/2011 16:16'!
This class should be used instead of MCMockPackageInfo in the monticello tests!
!MCMockRPackage methodsFor: 'as yet unclassified' stamp: '2011-01-24T15:34:00+01:00'!
includesClass: aClass
	^self classes includes: aClass! !

!MCMockRPackage methodsFor: 'as yet unclassified' stamp: '2011-01-24T15:34:00+01:00'!
includesSystemCategory: categoryName
	^self systemCategories anySatisfy: [:cat | cat sameAs: categoryName]! !

!MCMockRPackage methodsFor: 'as yet unclassified' stamp: '2011-01-24T15:34:00+01:00'!
packageName
	^ 'MonticelloMocks'! !

!MCMockRPackage methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 7/4/2012 21:07'!
systemCategories
	^ Array with: 'MonticelloMocks'! !

!MCMockRPackage methodsFor: 'as yet unclassified' stamp: '2011-01-24T15:33:00+01:00'!
classNames
	^ #(	MCMockClassA
		 	MCMockASubclass
			MCMockClassB
			MCMockClassD
			MCMockClassE
			MCMockClassF
			MCMockClassG
			MCMockClassH
			MCMockClassI
		)! !

!MCMockRPackage methodsFor: 'as yet unclassified' stamp: '2011-01-24T15:50:00+01:00'!
name

	^ self packageName! !

!MCMockRPackage methodsFor: 'as yet unclassified' stamp: '2011-01-24T15:33:00+01:00'!
classes
	^ self classNames select: [ :tmpName | Smalltalk globals hasClassNamed: tmpName ] thenCollect: [ :tmpName | Smalltalk globals at: tmpName ]! !

!MCMockRPackage class methodsFor: 'initialize-release' stamp: 'StephaneDucasse 6/3/2012 23:29'!
initialize
	[self packageOrganizerClass default registerPackage: self new ] on: MessageNotUnderstood do: []! !

!MCModel2MTModelVisitor commentStamp: '<historical>'!
A MCModel2MTModelVisitor visits a Metacello model to transform it to a MT Model .

Instance variables:
	- project : the root element (an MTProject) of the target model
	
	
MCModel2MTModelVisitor new 
	visitConfiguration: ConfigurationOfVersionner  
	withVersion: (ConfigurationOfVersionner project version: #development)!
!MCModel2MTModelVisitor methodsFor: 'visiting' stamp: 'ChristopheDemarey 7/15/2013 14:48'!
visitMCVersion: aVersion
	"visit a Metacello Version"
	
	| groups packages projects repositories |
	
	project version
		description: aVersion spec description value;
		author: aVersion spec author value;
		timestamp: aVersion spec timestamp value.

	groups := aVersion groups.
	groups do:  [ :aGroup | self visitMCGroup: aGroup ].
	
	packages := aVersion packages.
	packages do:  [ :aPackage | self visitMCPackage: aPackage ].
	
	projects := aVersion projects.
	projects do:  [ :aProject | self visitMCProjectAsRequiredProject: aProject ].
	
	repositories := aVersion spec repositories list.
	repositories ifNotEmptyDo:  
		[:repo | project repository: repo first name].
! !

!MCModel2MTModelVisitor methodsFor: 'visiting' stamp: 'ChristopheDemarey 12/11/2012 13:57'!
visitConfiguration: aConfigurationClass
	"Visits a Configuration class with the current version."

	| currentVersion |
	
	currentVersion := aConfigurationClass project currentVersion.
	^ self visitConfiguration: aConfigurationClass withVersion: currentVersion.
! !

!MCModel2MTModelVisitor methodsFor: 'visiting' stamp: 'ChristopheDemarey 12/11/2012 14:36'!
visitMCProject: aProject withVersion: aVersion
	"visit a Metacello Project with the specified version."
	| version |
	
	version := MTVersion fromVersionString: aVersion versionString.
	project version: version.
	aVersion ifNotNil: [ self visitMCVersion: aVersion ].! !

!MCModel2MTModelVisitor methodsFor: 'visiting' stamp: 'ChristopheDemarey 12/11/2013 14:14'!
visitMCPackage: aPackage
	"visit a Metacello Package"

	| package version |
	
	package := MTPackage new.
	package name: aPackage name.
	
	version := MTVersion fromVersionName: aPackage file.
	package version: version.
	
	package dependencies: aPackage requires asOrderedCollection.
	
	project addDependency: package.
	^ package.
! !

!MCModel2MTModelVisitor methodsFor: 'visiting' stamp: 'ChristopheDemarey 2/24/2014 16:51'!
visitMCProjectAsRequiredProject: aProject
	"visit a Metacello Project to add it as a required projet. It is quite the same as visitMCProject except that we won't dive into the project structure.
	aProject is an instance of MetacelloMCProjectSpec."
	| version requiredProject |
	
	requiredProject := MTDependantProject new.
	requiredProject displayName: aProject name.
	requiredProject name: (aProject className ifNil: [aProject name] ifNotNil: [ :className | className configurationBaseName]).
	requiredProject configurationClass: aProject projectClass.
	requiredProject repositories: (aProject repositorySpecs collect: [ :aRepoSpec | aRepoSpec description]).
	requiredProject dependencies: (aProject loads ifNil: [ #() ] ifNotNilDo: [ :loads | loads ]) asOrderedCollection.
	
	version := MTVersion fromVersionString: aProject versionString.
	requiredProject version: version.
	
	project addDependency: requiredProject.
	^ requiredProject.! !

!MCModel2MTModelVisitor methodsFor: 'visiting' stamp: 'ChristopheDemarey 12/11/2013 14:14'!
visitMCGroup: aGroup
	"visit a Metacello Group"	
	| group |

	group := MTGroup new.
	group name: aGroup name.
	aGroup includes do: 
		[ :dep | 
		group addDependency: dep].
	project addDependency: group.
	^ group.
	! !

!MCModel2MTModelVisitor methodsFor: 'visiting' stamp: 'StephaneDucasse 8/23/2013 14:39'!
visitConfiguration: aConfigurationClass withVersionString: aVersionString
	"visits a Configuration class for the specified version and returns the project root object.
	 Returns the project root object or nil if the given version is nil."

	project := MTProject  new.
	project configurationClass: aConfigurationClass.
	self visitMCProject: aConfigurationClass project withVersion: (aConfigurationClass project version: aVersionString).
	^project
	! !

!MCModel2MTModelVisitor methodsFor: 'visiting' stamp: 'ChristopheDemarey 12/11/2012 13:58'!
visitConfiguration: aConfigurationClass withVersion: aVersion
	"visits a Configuration class for the specified version and returns the project root object.
	 Returns the project root object or nil if the given version is nil."

	aVersion ifNil: [ ^ nil ].
	project := MTProject  new.
	project configurationClass: aConfigurationClass.
	self visitMCProject: aConfigurationClass project withVersion: aVersion.
	^project
	! !

!MCModel2MTModelVisitorTest methodsFor: 'tests' stamp: 'ChristopheDemarey 6/5/2013 12:41'!
setUp
	super setUp.
	classFactory := ClassFactoryForTestCase new.! !

!MCModel2MTModelVisitorTest methodsFor: 'private' stamp: 'ChristopheDemarey 6/5/2013 13:24'!
checkGroups: project
	| group |
	
	group := project groups at: 1.
	self assert: group notNil.
	self assert:  group name equals: 'default'.
	self assert: (group dependencies hasEqualElements: #('Core' 'Tests')).
	
	group := project groups at: 2.
	self assert: group notNil.
	self assert:  group name equals: 'Core'.
	self assert: (group dependencies hasEqualElements: #('VersionnerTestXML-Parser')).
	
	group := project groups at: 3.
	self assert: group notNil.
	self assert:  group name equals: 'Tests'.
	self assert: (group dependencies hasEqualElements: #('VersionnerTestXML-Tests-Parser')).
! !

!MCModel2MTModelVisitorTest methodsFor: 'private' stamp: 'ChristopheDemarey 11/21/2013 17:49'!
checkPackages: project
	| packages proj |
	
	packages := project packages.
	
	proj := packages at: 1.
	self assert: proj notNil.
	self assert:  proj name equals: 'VersionnerTestXML-Parser'.
	self assert: proj dependencies equals: (OrderedCollection newFrom: #('BitmapCharacterSet' 'XMLWriter')).
	
	proj := packages at: 2.
	self assert: proj notNil.
	self assert:  proj name equals: 'VersionnerTestXML-Tests-Parser'.
	self assert: proj dependencies equals: (OrderedCollection newFrom: #('VersionnerTestXML-Parser')).
! !

!MCModel2MTModelVisitorTest methodsFor: 'tests' stamp: 'ChristopheDemarey 11/21/2013 16:34'!
testVisitXMLParserConfigurationWithVersion101
	"test the visitor with the 1.38 version of the Versionner configuration"

	| visitor config project version |
	
	visitor := MCModel2MTModelVisitor new.
	classFactory duplicateClass: ConfigurationOfVersionnerTestXMLParserTemplate withNewName: 'ConfigurationOfVersionnerTestXMLParser'.
	config := (Smalltalk globals at: #ConfigurationOfVersionnerTestXMLParser).
	version := config project version: '1.1'.
	project := visitor visitConfiguration: config withVersion: version.
	
	self assert: project class equals: MTProject.
	self assert: project name equals: 'VersionnerTestXMLParser'.
	self assert: project version name equals: '1.1'.
	self assert: project repository equals: 'http://www.smalltalkhub.com/mc/PharoExtras/XMLParser/main'.
	
	self checkGroups: project.
	self checkRequiredProjects: project.
	self checkPackages: project.! !

!MCModel2MTModelVisitorTest methodsFor: 'tests' stamp: 'ChristopheDemarey 6/5/2013 12:40'!
tearDown
	super tearDown.
	classFactory cleanUp.! !

!MCModel2MTModelVisitorTest methodsFor: 'private' stamp: 'ChristopheDemarey 6/5/2013 13:26'!
checkRequiredProjects: project
	| requiredProjects proj |
	
	requiredProjects := project requiredProjects.
	
	proj := requiredProjects at: 1.
	self assert: proj notNil.
	
	self assert: proj displayName equals: 'XMLWriter'.
	self assert: proj name equals: 'VersionnerTestXMLWriter'.
	self assert: proj version name equals: 'stable'.
	
	proj := requiredProjects at: 2.
	self assert: proj notNil.
	self assert:  proj displayName equals: 'BitmapCharacterSet'.
	self assert:  proj name equals: 'VersionnerTestBitmapCharacterSet'.
	self assert: proj version name equals: 'stable'.
	! !

!MCModification commentStamp: '<historical>'!
A MCModification represents the operation to modify an entity to a snapshot. !
!MCModification methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/21/2013 15:33'!
selector

	^ obsoletion selector! !

!MCModification methodsFor: '*Tool-Diff' stamp: 'gvc 1/14/2009 14:12'!
diffToSource
	"Answer toSource of the modification. If a class patch then answer
	the toSource with the class-side definition and comment appended."
	
	^self isClassPatch
		ifTrue: [self toSource, String cr, String cr, 
				modification classDefinitionString, String cr, String cr,
				modification commentStamp, String cr,
				modification comment]
		ifFalse: [self toSource]! !

!MCModification methodsFor: 'accessing' stamp: 'ab 6/1/2003 13:10'!
targetDefinition
	^ modification! !

!MCModification methodsFor: 'initializing' stamp: 'stephaneducasse 2/4/2006 20:47'!
initializeWithBase: base target: target
	obsoletion := base.
	modification := target.! !

!MCModification methodsFor: '*Komitter-UI' stamp: 'NicolaiHess 4/8/2014 20:03'!
koClass
	| klass |
	klass := obsoletion koClass.
	klass ifNil: [ ^ nil ].
	obsoletion addOperation: self on: klass.
	self isClassPatch
		ifTrue: [ klass modified: true ].
	^ klass! !

!MCModification methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/21/2013 21:11'!
koDestinationText

	^ modification koDestinationText! !

!MCModification methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/26/2013 14:43'!
koDefinition
	
	^  (KomitDefinition definition: self definition)
		operation: self;
		modified: true;
		yourself! !

!MCModification methodsFor: 'accessing' stamp: 'cwp 11/27/2002 09:46'!
modification
	^ modification! !

!MCModification methodsFor: 'accessing' stamp: 'cwp 11/27/2002 09:48'!
obsoletion
	^ obsoletion! !

!MCModification methodsFor: 'accessing' stamp: 'nk 11/10/2003 21:44'!
printAnnotations: request on: aStream
	aStream nextPutAll: 'old: '.
	obsoletion printAnnotations: request on: aStream.
	aStream cr.
	aStream nextPutAll: 'new: '.
	modification printAnnotations: request on: aStream.! !

!MCModification methodsFor: 'accessing' stamp: 'cwp 11/28/2002 06:55'!
definition
	^ modification! !

!MCModification methodsFor: 'accessing' stamp: 'LucasGiudice 9/14/2013 15:18'!
fromSource
	^ obsoletion source! !

!MCModification methodsFor: 'accessing' stamp: 'LucasGiudice 9/14/2013 15:02'!
toSource
	^ modification diffSource! !

!MCModification methodsFor: 'testing' stamp: 'nk 2/25/2005 17:29'!
isClassPatch
	^obsoletion isClassDefinition! !

!MCModification methodsFor: 'accessing' stamp: 'nk 2/23/2005 18:18'!
targetClass
	^ obsoletion actualClass! !

!MCModification methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/21/2013 15:10'!
isMethodPatch

	^ obsoletion isMethodDefinition! !

!MCModification methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/21/2013 21:17'!
koSourceText

	^ obsoletion koSourceText! !

!MCModification methodsFor: '*Tool-Diff' stamp: 'LucasGiudice 9/14/2013 15:18'!
diffFromSource
	"Answer fromSource of the modification. If a class patch then answer
	the fromSource with the class-side definition and comment appended."
	
	^self isClassPatch
		ifTrue: [self fromSource, String cr, String cr,
				obsoletion classDefinitionString, String cr, String cr,
				obsoletion commentStamp, String cr,
				obsoletion comment]
		ifFalse: [obsoletion diffSource]! !

!MCModification methodsFor: 'accessing' stamp: 'StephaneDucasse 6/24/2011 14:53'!
basicApplyTo: anObject
	anObject modifyDefinition: obsoletion to: modification! !

!MCModification methodsFor: 'accessing' stamp: 'ab 8/22/2003 02:27'!
inverse
	^ MCModification of: modification to: obsoletion! !

!MCModification methodsFor: '*Tool-Diff' stamp: 'gvc 4/2/2009 13:26'!
diff
	"Open a diff browser on the changes."

	(DiffMorph
		from: self fromSource
		to: self toSource
		contextClass: (self isClassPatch ifTrue: [nil] ifFalse: [self targetClass]))
			extent: 400@300;
			openInWindowLabeled: 'Diff' translated! !

!MCModification methodsFor: 'accessing' stamp: 'StephaneDucasse 8/17/2012 16:30'!
summarySuffix
	^ modification summarySuffixOver: obsoletion
! !

!MCModification methodsFor: 'accessing' stamp: 'ab 6/1/2003 13:10'!
baseDefinition
	^ obsoletion! !

!MCModification methodsFor: 'testing' stamp: 'cwp 11/28/2002 07:23'!
isModification
	^ true! !

!MCModification methodsFor: 'printing' stamp: 'StephaneDucasse 8/17/2012 16:30'!
summarySuffixOver: previousDefinition
	| sourceChanged categoryChanged timeStampChanged |
	sourceChanged := self source ~= previousDefinition source.
	timeStampChanged := self timeStamp ~= previousDefinition timeStamp.
	categoryChanged := self category ~= previousDefinition category.
	sourceChanged | timeStampChanged | categoryChanged
		ifFalse: [ ^super summarySuffixOver: previousDefinition ].
	sourceChanged ifTrue: [
		^categoryChanged
			ifTrue: [ ' (changed and recategorized)' ]
			ifFalse: [ ' (changed)' ] ].
	timeStampChanged & categoryChanged
		ifTrue: [^ ' (recategorized and different time stamp)' ].
	^categoryChanged
		ifTrue: [ ' (only recategorized)' ]
		ifFalse: [ ' (only different time stamp)' ]
! !

!MCModification methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/25/2013 18:20'!
koMethod
	
	^ (KomitMethod method: self definition)
		operation: self;
		modified: true;
		yourself! !

!MCModification class methodsFor: 'instance-creation' stamp: 'cwp 11/28/2002 07:19'!
of: base to: target
	^ self new initializeWithBase: base target: target! !

!MCMultiPackageLoader commentStamp: '<historical>'!
A PackageLoader doing some additional cross-package checks!
!MCMultiPackageLoader methodsFor: 'private' stamp: 'bf 3/17/2006 15:51'!
analyze
	| index |
	index := MCDefinitionIndex definitions: additions.
	removals removeAllSuchThat: [:removal |
		(index definitionLike: removal
			ifPresent: [:addition | obsoletions at: addition put: removal]
			ifAbsent: []) notNil].
	super analyze! !

!MCNoChangesException commentStamp: 'TorstenBergmann 2/5/2014 13:53'!
Notify that no changes have to be merged!
!MCNoChangesException methodsFor: 'accessing' stamp: 'jf 8/21/2003 19:49'!
defaultAction
	self inform: 'No changes'! !

!MCOrganizationDefinition commentStamp: '<historical>'!
A MCOrganizationDefinition represents a category change. !
!MCOrganizationDefinition methodsFor: 'accessing' stamp: 'StephaneDucasse 12/30/2012 09:52'!
categories
	"ensure the categories are sorted alphabetically, so the merge don't take it as a conflict"
	^ categories! !

!MCOrganizationDefinition methodsFor: 'private' stamp: 'EstebanLorenzano 2/11/2013 14:38'!
basicCommonPrefix
	"Answers the minimum common denominator on package names contained in the monticello package. 
	 It can answer a package in the form X-Y-, with a minus at end..."
	| stream  |
	categories isEmpty ifTrue: [ ^ '' ].
	
	stream := String new writeStream.
	categories first withIndexDo: [:c :index |
		categories do: [:each |
			(each at: index ifAbsent: []) = c 
				ifFalse: [ ^ stream contents ] ].
		stream nextPut: c ].
	
	^stream contents! !

!MCOrganizationDefinition methodsFor: 'accessing' stamp: 'EstebanLorenzano 2/11/2013 14:30'!
description
	^ Array with: #organization with: self commonPrefix! !

!MCOrganizationDefinition methodsFor: 'installing' stamp: 'avi 2/22/2004 13:46'!
postloadOver: oldDefinition
	SystemOrganization categories:
		(self
			reorderCategories: SystemOrganization categories
			original: (oldDefinition ifNil: [#()] ifNotNil: [oldDefinition categories]))! !

!MCOrganizationDefinition methodsFor: 'accessing' stamp: 'ab 7/19/2003 18:01'!
sortKey
	^ '<organization>'! !

!MCOrganizationDefinition methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/28/2011 15:24'!
shortSummaryPrefix

	^ self definition description last! !

!MCOrganizationDefinition methodsFor: '*Komitter-UI' stamp: 'NicolaiHess 4/8/2014 20:01'!
koClass
	self className ifNil: [ ^ nil ] ifNotNil: [ :cname | ^ KomitClass trackedClass: cname ]! !

!MCOrganizationDefinition methodsFor: 'accessing' stamp: 'StephaneDucasse 12/30/2012 09:52'!
categories: anArray
	categories := anArray sort! !

!MCOrganizationDefinition methodsFor: 'accessing' stamp: 'ab 5/24/2003 13:55'!
summary
	^ categories asArray printString! !

!MCOrganizationDefinition methodsFor: 'testing' stamp: 'cwp 7/11/2003 01:33'!
isOrganizationDefinition
	^ true! !

!MCOrganizationDefinition methodsFor: 'comparing' stamp: 'SeanDeNigris 2/13/2013 08:41'!
= aDefinition

	^ (super = aDefinition)
		and: [ self categories size = aDefinition categories size and: [ self categories includesAllOf: aDefinition categories ] ].! !

!MCOrganizationDefinition methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/22/2013 16:42'!
addOperation: aMCModification on: aKOClass 
	
	^ aKOClass addOrganizationDefinition: aMCModification! !

!MCOrganizationDefinition methodsFor: 'accessing' stamp: 'ab 7/18/2003 21:47'!
accept: aVisitor
	^ aVisitor visitOrganizationDefinition: self! !

!MCOrganizationDefinition methodsFor: '*Ring-Monticello' stamp: 'MarcusDenker 8/1/2014 14:07'!
asRingDefinition

	^RGOrganization new
		categories: self categories;
		yourself  ! !

!MCOrganizationDefinition methodsFor: 'accessing' stamp: 'EstebanLorenzano 2/11/2013 14:36'!
commonPrefix
	"Answer the package common name. 
	 In ancient times, this was answering X-Y-, with a minus at the end... this was useful for the 
	 old PackageInfo framework. RPackage does not do pattern matching, thus this is not needed anymore 
	 (and provoques an error)"
	| prefix |
	prefix := self basicCommonPrefix.
	^(prefix notEmpty and: [ prefix endsWith: '-' ])
		ifTrue: [ prefix allButLast ]
		ifFalse: [ prefix ].
	
! !

!MCOrganizationDefinition methodsFor: 'accessing' stamp: 'ab 7/22/2003 01:14'!
source
	^ String streamContents:
		[:s |
		categories do: [:ea | s nextPutAll: ea] separatedBy: [s cr]]! !

!MCOrganizationDefinition methodsFor: 'unloading' stamp: 'ChristopheDemarey 6/3/2013 16:44'!
unload
	categories
		do: [ :category | 
			(SystemOrganization isEmptyCategoryNamed: category)
				ifTrue: [ SystemOrganization removeCategory: category ] ]! !

!MCOrganizationDefinition methodsFor: 'private' stamp: 'stephaneducasse 2/4/2006 20:47'!
reorderCategories: allCategories original: oldCategories
	| first |
	first := allCategories detect: [:ea | categories includes: ea] ifNone: [^ allCategories].
	^ 	((allCategories copyUpTo: first) copyWithoutAll: oldCategories, categories),
		categories,
		((allCategories copyAfter: first) copyWithoutAll: oldCategories, categories)
! !

!MCOrganizationDefinition methodsFor: 'accessing' stamp: 'gvc 10/30/2006 11:18'!
patchWrapper
	"Answer a wrapper for a patch tree for the receiver."

	^PSMCOrganizationChangeWrapper with: self! !

!MCOrganizationDefinition class methodsFor: 'instance creation' stamp: 'StephaneDucasse 12/30/2012 09:59'!
categories: anArray
	^ self instanceLike: (self new categories: anArray)! !

!MCOrganizationTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:47'!
testReordering
	|dec cats newCats |
	dec := MCOrganizationDefinition categories: #(A B C).
	cats := #(X Y B Z C A Q).
	newCats := dec reorderCategories: cats original: #(B C A).
	self assert: newCats asArray = #(X Y A B C Z Q).! !

!MCOrganizationTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:47'!
testReorderingWithNoCategoriesInVersion
	|dec cats newCats |
	dec := MCOrganizationDefinition categories: #().
	cats := #(X Y B Z C A Q).
	newCats := dec reorderCategories: cats original: #().
	self assert: newCats asArray = cats.! !

!MCOrganizationTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:47'!
testReorderingWithRemovals
	|dec cats newCats |
	dec := MCOrganizationDefinition categories: #(A B C).
	cats := #(X Y B Z C A Q).
	newCats := dec reorderCategories: cats original: #(Y B C A Q).
	self assert: newCats asArray = #(X A B C Z).! !

!MCOrganizationTest methodsFor: 'tests' stamp: 'GuillermoPolito 4/27/2012 15:23'!
testLoadAndUnload
	| category |
	category := 'TestPackageToUnload'.
	SystemOrganization addCategory: category.
	(MCOrganizationDefinition categories: { category }) unload.
	self deny: (SystemOrganization includesCategory: category)! !

!MCPTest methodsFor: 'constants' stamp: 'dgd 2/14/2003 10:13'!
defaultTop
	"the default top for morphs"
	^ self defaultBounds top ! !

!MCPTest methodsFor: 'tests' stamp: 'dgd 2/14/2003 10:15'!
testTop
	"test the #top: messages and its consequences"

	| morph factor newTop newBounds |
	morph := Morph new.
	""
	factor := 10.
	newTop := self defaultTop + factor.
	newBounds := self defaultBounds translateBy: 0 @ factor.
	""
	morph top: newTop.
	""
	self assert: morph top = newTop;
		 assert: morph bounds = newBounds! !

!MCPTest methodsFor: 'constants' stamp: 'dgd 2/14/2003 10:13'!
defaultBounds
	"the default bounds for morphs"
	^ 0 @ 0 corner: 50 @ 40 ! !

!MCPackage commentStamp: '<historical>'!
MCPackage represents a package. It is merely a wrapper on top of a package set or packageInfo.

Strangely enough it does not inherit from MCDefinition.

Its most important method is snapshot which returns a snapshot with all the entities that should be saved. !
!MCPackage methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/17/2015 17:17'!
gtDisplayOn: aStream
	aStream nextPutAll: self name! !

!MCPackage methodsFor: 'comparing' stamp: 'ar 4/26/2005 21:57'!
hash
	^ name asLowercase hash! !

!MCPackage methodsFor: 'accessing' stamp: 'EstebanLorenzano 9/11/2012 17:01'!
packageSet
	^ RPackageSet named: name! !

!MCPackage methodsFor: 'printing' stamp: 'ab 7/10/2003 01:13'!
storeOn: aStream
	aStream
		nextPutAll: 'MCPackage';
		space; nextPutAll: 'named: '; store: name.! !

!MCPackage methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/24/2015 14:45'!
spotterForPackageFor: aStep
	<spotterOrder: 2>
	aStep listProcessor
		title: 'Packages';
		allCandidates: [ Array with: self correspondingRPackage ];
		itemName: [ :package | package name ];
		itemIcon: [ Smalltalk ui icons iconNamed: #packageIcon ];
		filter: GTFilterSubstring! !

!MCPackage methodsFor: '*RPackage-SystemIntegration' stamp: 'MarcusDenker 10/19/2012 09:47'!
correspondingRPackage

	^ RPackageOrganizer default packageNamed: self name asSymbol ifAbsent: [ nil ]! !

!MCPackage methodsFor: '*Komitter-Models' stamp: 'BenjaminVanRyseghem 11/22/2013 16:20'!
remotes

	^ self workingCopy remotes! !

!MCPackage methodsFor: 'working copies' stamp: 'cwp 11/13/2003 13:33'!
workingCopy
	^ MCWorkingCopy forPackage: self.! !

!MCPackage methodsFor: '*Komitter-Models' stamp: 'BenjaminVanRyseghem 11/20/2013 18:10'!
baseSnapshot

	^ self workingCopy baseSnapshot! !

!MCPackage methodsFor: 'working copies' stamp: 'bf 4/19/2005 16:26'!
hasWorkingCopy
	^ MCWorkingCopy registry includesKey: self! !

!MCPackage methodsFor: '*Komitter-Models' stamp: 'BenjaminVanRyseghem 11/24/2013 19:42'!
koPackage

	^ KomitPackage package: self! !

!MCPackage methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/16/2013 18:34'!
snapshot
	| packageInfo definitions categories |
	packageInfo := self packageSet.
	definitions := OrderedCollection new.
	categories := packageInfo categoryNames asArray.
	categories isEmpty 
		ifFalse: [ definitions add: (MCOrganizationDefinition categories: categories) ].
		
	packageInfo methods 
		do: [:ea | definitions add: ea asMCMethodDefinition] 
		displayingProgress: [ :ea| 'Snapshotting methods...' ].
		
	packageInfo overriddenMethods
		do: [:ea | definitions add:
					(packageInfo changeRecordForOverriddenMethod: ea) asMCMethodDefinition]
		displayingProgress: [ :ea| 'Searching for overrides in ', ea asString ].
		
	packageInfo definedClasses 
		do: [:ea | definitions addAll: ea classDefinitions] 
		displayingProgress: [ :ea| 'Snapshotting class ', ea asString ].
		
	(packageInfo respondsTo: #hasPreamble) ifTrue: [
		packageInfo hasPreamble 
			ifTrue: [definitions add: (MCPreambleDefinition from: packageInfo)].
		packageInfo hasPostscript 
			ifTrue: [definitions add: (MCPostscriptDefinition from: packageInfo)].
		packageInfo hasPreambleOfRemoval 
			ifTrue: [definitions add: (MCRemovalPreambleDefinition from: packageInfo)].
		packageInfo hasPostscriptOfRemoval 
			ifTrue: [definitions add: (MCRemovalPostscriptDefinition from: packageInfo)]]. 
	^ MCSnapshot fromDefinitions: definitions
! !

!MCPackage methodsFor: '*Komitter-Models' stamp: 'BenjaminVanRyseghem 12/6/2013 21:37'!
version

	^ KomitterManager current versionFor: self! !

!MCPackage methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/24/2015 14:45'!
spotterMonticelloWorkingCopyFor: aStep
	<spotterOrder: 1>
	aStep listProcessor
		title: 'Monticello Working Copy';
		allCandidates: [ Array with: self workingCopy ];
		itemIcon: [ Smalltalk ui icons iconNamed: #versionControlIcon ];
		filter: GTFilterSubstring! !

!MCPackage methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
name: aString
	name := aString! !

!MCPackage methodsFor: 'comparing' stamp: 'ar 4/26/2005 21:57'!
= other
	^ other species = self species and: [other name sameAs: name]! !

!MCPackage methodsFor: 'printing' stamp: 'nk 7/28/2003 13:30'!
printOn: aStream
	super printOn: aStream.
	aStream
		nextPut: $(;
		nextPutAll: name;
		nextPut: $)! !

!MCPackage methodsFor: 'working copies' stamp: 'cwp 11/13/2003 13:32'!
unload
	^ self workingCopy unload! !

!MCPackage methodsFor: 'testing' stamp: 'ChristopheDemarey 1/17/2014 18:25'!
isDirty
	
	^ self workingCopy
		ifNil: [ false ]
		ifNotNilDo: [ :wc | wc modified ]! !

!MCPackage methodsFor: '*Komitter-Models' stamp: 'BenjaminVanRyseghem 11/24/2013 20:25'!
silentSnapshot
	| packageInfo definitions categories |
	
	packageInfo := self packageSet.
	definitions := OrderedCollection new.
	categories := packageInfo categoryNames asArray.
	categories isEmpty 
		ifFalse: [ definitions add: (MCOrganizationDefinition categories: categories) ].
		
	packageInfo methods 
		do: [:ea | definitions add: ea asMCMethodDefinition].
		
	packageInfo overriddenMethods
		do: [:ea | definitions add:
					(packageInfo changeRecordForOverriddenMethod: ea) asMCMethodDefinition].
		
	packageInfo definedClasses 
		do: [:ea | definitions addAll: ea classDefinitions].
		
	(packageInfo respondsTo: #hasPreamble) ifTrue: [
		packageInfo hasPreamble 
			ifTrue: [definitions add: (MCPreambleDefinition from: packageInfo)].
		packageInfo hasPostscript 
			ifTrue: [definitions add: (MCPostscriptDefinition from: packageInfo)].
		packageInfo hasPreambleOfRemoval 
			ifTrue: [definitions add: (MCRemovalPreambleDefinition from: packageInfo)].
		packageInfo hasPostscriptOfRemoval 
			ifTrue: [definitions add: (MCRemovalPostscriptDefinition from: packageInfo)]].
		
	^ MCSnapshot fromDefinitions: definitions! !

!MCPackage methodsFor: 'accessing' stamp: 'ab 7/7/2003 00:57'!
name
	^ name! !

!MCPackage methodsFor: '*Komitter-Models' stamp: 'BenjaminVanRyseghem 11/26/2013 12:58'!
patch
	| snapshot base patch |
	
	snapshot := self silentSnapshot.
	base := self baseSnapshot.
	patch := base
		ifNil: [ MCPatch new initializeWithTarget: self snapshot ]
		ifNotNil: [ MCPatch new silentInitializeWithBase: base target: snapshot ].
		
	^ KomitPatch 
		base: base
		patch: patch! !

!MCPackage class methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/26/2015 17:56'!
gtExamplePackage
	<gtExample: 'Metacello package with corresponding RPackage'>
	MCWorkingCopy allManagers do: [ :each | 
		each packageName = 'GT-SpotterExtensions-Core' ifTrue: [ ^ each package ] ].
	^ nil! !

!MCPackage class methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/26/2015 17:56'!
gtExampleNoPackage
	<gtExample: 'Metacello package without corresponding RPackage'>
	^ MCPackage named: 'No-correspondingRPackage-For-This-MCPackage'! !

!MCPackage class methodsFor: 'instance creation' stamp: 'ab 7/10/2003 01:17'!
named: aString
	^ self new name: aString! !

!MCPackageCache commentStamp: 'LaurentLaffont 3/31/2011 21:06'!
I'm a kind of cache for versions and filenames of packages.!
!MCPackageCache methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 10:03'!
initialize
	super initialize.
	sorter := MCVersionSorter new.
	fileNames := Dictionary new.! !

!MCPackageCache methodsFor: 'accessing' stamp: 'AdrianLienhard 1/21/2010 22:14'!
recordVersionInfo: aVersionInfo forFileNamed: aString
	fileNames at: aVersionInfo put: aString.
	sorter addVersionInfo: aVersionInfo! !

!MCPackageCache methodsFor: 'accessing' stamp: 'avi 1/22/2004 18:21'!
versionInfos
	^ sorter sortedVersionInfos ! !

!MCPackageLoader commentStamp: '<historical>'!
A MCPackageLoader is responsible for loading packages.  It gets used by VersionLoader, so it is eventually responsible for loading everything.

Instance Variables
	additions:		<Definitions>  Definitions that need to be added
	errorDefinitions:		<Object>
	obsoletions:		<Object>
	provisions:		<Object>
	removals:		<Object>
	requirements:		<Object>
	unloadableDefinitions:		<Object>
	methodAdditions  <MethodAdditions> MethodDefinitions corresponding to the Definitions in "additions" that have been added so far.
!
!MCPackageLoader methodsFor: 'private' stamp: 'BertFreudenberg 12/26/2010 13:31'!
flushChangesFile
	"The changes file is second in the SourceFiles array"

	(SourceFiles at: 2) ifNotNil: [:f | f flush]! !

!MCPackageLoader methodsFor: 'patch ops' stamp: 'avi 2/17/2004 13:14'!
modifyDefinition: old to: new
	self addDefinition: new.
	obsoletions at: new put: old.! !

!MCPackageLoader methodsFor: 'private' stamp: 'CamilloBruni 7/17/2013 11:08'!
validate
	self analyze.
	unloadableDefinitions isEmpty ifFalse: [self warnAboutDependencies].! !

!MCPackageLoader methodsFor: 'private' stamp: 'avi 1/24/2004 17:44'!
errorDefinitionWarning
	^ String streamContents:
		[:s |
		s nextPutAll: 'The following definitions had errors while loading.  Press Proceed to try to load them again (they may work on a second pass):'; cr.
		errorDefinitions do: [:ea | s space; space; nextPutAll: ea summary; cr]] ! !

!MCPackageLoader methodsFor: 'public' stamp: 'CamilloBruni 7/17/2013 11:08'!
loadWithNameLike: baseName
	self validate.
	self useNewChangeSetNamedLike: baseName during: [self basicLoad]! !

!MCPackageLoader methodsFor: 'public' stamp: 'stephaneducasse 2/4/2006 20:47'!
updatePackage: aPackage withSnapshot: aSnapshot
	|  patch packageSnap |
	packageSnap := aPackage snapshot.
	patch := aSnapshot patchRelativeToBase: packageSnap.
	patch applyTo: self.
	packageSnap definitions do: [:ea | self provisions addAll: ea provisions]
! !

!MCPackageLoader methodsFor: 'initialization' stamp: 'StephaneDucasse 9/13/2009 18:15'!
initialize
	super initialize.
	additions := OrderedCollection new.
	removals := OrderedCollection new.
	obsoletions := Dictionary new.
	methodAdditions := OrderedCollection new. 
! !

!MCPackageLoader methodsFor: 'private' stamp: 'avi 2/17/2004 13:15'!
obsoletionFor: aDefinition
	^ obsoletions at: aDefinition ifAbsent: [nil]! !

!MCPackageLoader methodsFor: 'private' stamp: 'StephaneDucasse 9/13/2009 18:16'!
tryToLoad: aDefinition
	[aDefinition addMethodAdditionTo: methodAdditions] on: Error do: [errorDefinitions add: aDefinition].! !

!MCPackageLoader methodsFor: 'private' stamp: 'avi 1/24/2004 17:42'!
warnAboutErrors
	self notify: self errorDefinitionWarning.
! !

!MCPackageLoader methodsFor: 'public' stamp: 'CamilloBruni 7/17/2013 11:08'!
load
	self validate.
	self useNewChangeSetDuring: [self basicLoad].
	MCMethodDefinition cachedDefinitions finalizeValues.! !

!MCPackageLoader methodsFor: 'private' stamp: 'nk 8/30/2004 08:38'!
useNewChangeSetDuring: aBlock
	^self useNewChangeSetNamedLike: 'MC' during: aBlock! !

!MCPackageLoader methodsFor: 'public' stamp: 'EstebanLorenzano 10/17/2012 16:54'!
unloadPackage: aPackage
	self updatePackage: aPackage withSnapshot: MCSnapshot empty.
	MCMethodDefinition cachedDefinitions finalizeValues.! !

!MCPackageLoader methodsFor: 'public' stamp: 'CamilloBruni 7/17/2013 11:08'!
loadWithName: baseName
	self validate.
	self useChangeSetNamed: baseName during: [self basicLoad]! !

!MCPackageLoader methodsFor: 'public' stamp: 'stephaneducasse 2/4/2006 20:47'!
installSnapshot: aSnapshot
	| patch |
	patch := aSnapshot patchRelativeToBase: MCSnapshot empty.
	patch applyTo: self.
! !

!MCPackageLoader methodsFor: 'private' stamp: 'stephaneducasse 2/4/2006 20:47'!
analyze
	| sorter |
	sorter := self sorterForItems: additions.
	additions := sorter orderedItems.
	requirements := sorter externalRequirements.
	unloadableDefinitions := sorter itemsWithMissingRequirements asSortedCollection.
	
	sorter := self sorterForItems: removals.
	removals := sorter orderedItems reversed.! !

!MCPackageLoader methodsFor: 'private' stamp: 'NicoPaez 10/1/2010 10:33'!
provisions
	^ provisions ifNil: [provisions := Set withAll: Smalltalk globals keys]! !

!MCPackageLoader methodsFor: 'patch ops' stamp: 'ab 5/24/2003 16:14'!
removeDefinition: aDefinition
	removals add: aDefinition! !

!MCPackageLoader methodsFor: 'private' stamp: 'AlainPlantec 1/7/2010 22:20'!
shouldWarnAboutErrors
	^ errorDefinitions isEmpty not and: [false "should make this a setting ?"]! !

!MCPackageLoader methodsFor: 'patch ops' stamp: 'ab 5/24/2003 16:13'!
addDefinition: aDefinition
	additions add: aDefinition! !

!MCPackageLoader methodsFor: 'private' stamp: 'ab 5/24/2003 16:52'!
orderedAdditions
	^ additions! !

!MCPackageLoader methodsFor: 'private' stamp: 'stephaneducasse 2/4/2006 20:47'!
sorterForItems: aCollection
	| sorter |
	sorter := MCDependencySorter items: aCollection.
	sorter addExternalProvisions: self provisions.
	^ sorter! !

!MCPackageLoader methodsFor: 'private' stamp: 'CamilloBruni 7/17/2013 11:22'!
basicLoadDefinitions

	"FIXME. Do a separate pass on loading class definitions as the very first thing.
	This is a workaround for a problem with the so-called 'atomic' loading (you wish!!)
	which isn't atomic at all but mixes compilation of methods with reshapes of classes.

	Since the method is not installed until later, any class reshape in the middle *will*
	affect methods in subclasses that have been compiled before. There is probably
	a better way of dealing with this by ensuring that the sort order of the definition lists
	superclass definitions before methods for subclasses but I need this NOW, and adding
	an extra pass ensures that methods are compiled against their new class definitions."

	additions do: [ :each | self loadClassDefinition: each ] displayingProgress: 'Loading classes...'.
	additions do: [ :each | self tryToLoad: each           ] displayingProgress: 'Compiling methods...'.
	removals  do: [ :each | each unload                    ] displayingProgress: 'Cleaning up...'.
	
	self shouldWarnAboutErrors ifTrue: [ self warnAboutErrors ].
	errorDefinitions do: [ :each | each addMethodAdditionTo: methodAdditions ] displayingProgress: 'Reloading erroneous definitions...'.
	
	methodAdditions do: [ :each | each installMethod ].
	methodAdditions do: [ :each | each notifyObservers ].
	additions       do: [ :each | each postloadOver: (self obsoletionFor: each) ] displayingProgress: 'Initializing...'.
	! !

!MCPackageLoader methodsFor: 'private' stamp: 'ab 5/25/2003 01:24'!
dependencyWarning
	^ String streamContents:
		[:s |
		s nextPutAll: 'This package depends on the following classes:'; cr.
		requirements do: [:ea | s space; space; nextPutAll: ea; cr].
		s nextPutAll: 'You must resolve these dependencies before you will be able to load these definitions: '; cr.
		unloadableDefinitions do: [:ea | s space; space; nextPutAll: ea summary; cr]] ! !

!MCPackageLoader methodsFor: 'private' stamp: 'CamilloBruni 7/17/2013 11:06'!
useChangeSetNamed: baseName during: aBlock
	"Use the named change set, or create one with the given name."
	| oldChanges newChanges |
	oldChanges := ChangeSet current.
	newChanges := (ChangeSet named: baseName) ifNil: [ ChangeSet new name: baseName ].
	ChangeSet newChanges: newChanges.
	aBlock ensure: [ ChangeSet newChanges: oldChanges ].
! !

!MCPackageLoader methodsFor: 'private' stamp: 'MartinDias 7/25/2013 14:36'!
handleLoadErrorsDuring: aBlock
	[aBlock
		on: InMidstOfFileinNotification do: [ :notification | notification resume: true ]]
		on: SlotClassBuilderWarning do: [ :error | error resume ]! !

!MCPackageLoader methodsFor: 'private' stamp: 'ab 5/25/2003 01:19'!
orderDefinitionsForLoading: aCollection
	^ (self sorterForItems: aCollection) orderedItems! !

!MCPackageLoader methodsFor: 'private' stamp: 'CamilloBruni 7/17/2013 11:20'!
loadClassDefinition: aDefinition

	[ aDefinition isClassDefinition 
		ifTrue: [ aDefinition load ]
	] on: Error do: [ 
		errorDefinitions add: aDefinition ].! !

!MCPackageLoader methodsFor: 'private' stamp: 'CamilloBruni 7/17/2013 11:13'!
basicLoad
	errorDefinitions := OrderedCollection new.
	[ 
		self handleLoadErrorsDuring: [ self basicLoadDefinitions ]
	] ensure: [ self flushChangesFile ]! !

!MCPackageLoader methodsFor: 'private' stamp: 'ab 5/25/2003 01:22'!
warnAboutDependencies 
	self notify: self dependencyWarning! !

!MCPackageLoader methodsFor: 'private' stamp: 'nk 2/23/2005 07:50'!
useNewChangeSetNamedLike: baseName during: aBlock
	^self useChangeSetNamed: (ChangeSet uniqueNameLike: baseName) during: aBlock! !

!MCPackageLoader class methodsFor: 'public' stamp: 'ab 7/6/2003 23:30'!
installSnapshot: aSnapshot
	self new
		installSnapshot: aSnapshot;
		load! !

!MCPackageLoader class methodsFor: 'public' stamp: 'bf 12/5/2004 12:00'!
unloadPackage: aPackage
	self new
		unloadPackage: aPackage;
		loadWithNameLike: aPackage name, '-unload'! !

!MCPackageLoader class methodsFor: 'public' stamp: 'ab 7/7/2003 12:11'!
updatePackage: aPackage withSnapshot: aSnapshot
	self new
		updatePackage: aPackage withSnapshot: aSnapshot;
		load! !

!MCPackageManager commentStamp: 'StephaneDucasse 4/29/2011 20:42'!
MCPackageManager is a kind of package wrapper knowing if the package is dirty or not.
The class side manages registered package managers.

Instance Variables:
	package	<MCPackage>
	modified	<Boolean>

Class Instance Variables:
	registry	<Dictionary>!
!MCPackageManager methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 12/4/2014 21:53'!
gtDisplayOn: stream
	stream nextPutAll: self package name! !

!MCPackageManager methodsFor: 'operations' stamp: 'EstebanLorenzano 2/21/2014 15:33'!
unregister
	self class registry 
		removeKey: package
		ifAbsent: [ ^ self ].
	self class changed: (Array with: #unregistered with: package).
	self announcer announce: (MCWorkingCopyDeleted workingCopy: self package: package)! !

!MCPackageManager methodsFor: 'initialization' stamp: 'stephaneducasse 2/4/2006 20:47'!
initializeWithPackage: aPackage
	package := aPackage.
	self initialize.! !

!MCPackageManager methodsFor: 'private' stamp: 'EstebanLorenzano 5/21/2012 17:31'!
announcer
	^self class announcer! !

!MCPackageManager methodsFor: 'accessing' stamp: 'EstebanLorenzano 9/11/2012 17:01'!
packageSet
	^ package packageSet! !

!MCPackageManager methodsFor: 'initialization' stamp: 'StephaneDucasse 5/7/2011 18:18'!
initialize
	super initialize.
	modified := false.
! !

!MCPackageManager methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/22/2013 15:33'!
modified: aBoolean
	modified = aBoolean
		ifTrue: [ ^ self ].
	modified := aBoolean.
	self changed: #modified.
	modified
		ifFalse: [ 
			Smalltalk logChange: '"' , self packageName , '"' ].
	self announcer announce: (MCPackageModified package: self package)
	! !

!MCPackageManager methodsFor: 'accessing' stamp: 'cwp 11/13/2003 14:12'!
modified
	^ modified! !

!MCPackageManager methodsFor: 'accessing' stamp: 'ab 7/7/2003 16:47'!
package
	^ package! !

!MCPackageManager methodsFor: 'accessing' stamp: 'ab 7/7/2003 12:18'!
packageName
	^ package name! !

!MCPackageManager methodsFor: 'accessing' stamp: 'ab 7/5/2003 23:18'!
packageNameWithStar
	^ modified
		ifTrue: ['* ', self packageName]
		ifFalse: [self packageName]! !

!MCPackageManager class methodsFor: 'system changes' stamp: 'CamilloBruni 8/30/2012 11:19'!
classMoved: anEvent
	self managersForPackage: anEvent oldPackage do: [ :mgr | mgr modified: true ].
	self managersForPackage: anEvent newPackage do: [ :mgr | mgr modified: true ].! !

!MCPackageManager class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/22/2013 14:50'!
forPackage: aPackage
	^ self registry 
		at: aPackage 
		ifAbsent: [|mgr|
			mgr := self new initializeWithPackage: aPackage.
			self registry at: aPackage put: mgr.
			self announcer announce: (MCWorkingCopyCreated workingCopy: mgr package: aPackage).
			mgr ]! !

!MCPackageManager class methodsFor: 'private' stamp: 'EstebanLorenzano 8/3/2012 14:29'!
announcer
	^PrivateAnnouncer ifNil: [ SystemAnnouncer uniqueInstance  ]! !

!MCPackageManager class methodsFor: 'accessing' stamp: 'ab 3/31/2003 20:45'!
allManagers
	^ self registry values! !

!MCPackageManager class methodsFor: 'system changes' stamp: 'EstebanLorenzano 9/12/2012 13:35'!
managersForPackage: aPackage do: aBlock
	self registry do: [:mgr | 
		(mgr packageSet includesSystemCategory: aPackage name) ifTrue: [
			aBlock value: mgr.
		]
	].! !

!MCPackageManager class methodsFor: 'system changes' stamp: 'CamilloBruni 9/22/2012 10:43'!
methodMoved: anEvent
	self managersForPackage: anEvent oldPackage do: [ :mgr | mgr modified: true ].
	self managersForPackage: anEvent newPackage do: [ :mgr | mgr modified: true ].! !

!MCPackageManager class methodsFor: 'system changes' stamp: 'GuillermoPolito 9/21/2012 15:10'!
managersForCategory: aSystemCategory do: aBlock
	"Got to be careful here - we might get method categories where capitalization is problematic."
	| cat foundOne index |
	foundOne := false.
	cat := aSystemCategory ifNil:[^nil]. "yes this happens; for example in eToy projects"
	"first ask PackageInfos, their package name might not match the category"
	self registry do: [:mgr | 
		(mgr packageSet includesSystemCategory: aSystemCategory)	ifTrue: [
			aBlock value: mgr.
			foundOne := true.
		]
	].
	foundOne ifTrue: [^self].
	["Loop over categories until we found a matching one"
	self registry at: (MCPackage named: cat) ifPresent:[:mgr|
		aBlock value: mgr.
		foundOne := true.
	].
	index := cat lastIndexOf: $-.
	index > 0]whileTrue:[
		"Step up to next level package"
		cat := cat copyFrom: 1 to: index-1.
	].
	foundOne ifFalse:[
		"Create a new (but only top-level)"
		aBlock value: (MCWorkingCopy forPackage: (MCPackage named: aSystemCategory capitalized)).
	].! !

!MCPackageManager class methodsFor: 'private' stamp: 'EstebanLorenzano 5/21/2012 17:33'!
announcer: anAnnouncer
	PrivateAnnouncer := anAnnouncer! !

!MCPackageManager class methodsFor: 'system changes' stamp: 'EstebanLorenzano 3/19/2014 17:45'!
packageRenamed: anAnnouncement
	self allManagers 
		detect: [ :each | each packageName = anAnnouncement newName ]
		ifFound: [ :newPackage | newPackage modified: true ].
	(self allManagers 
		detect: [ :each | each packageName = anAnnouncement oldName ])
		unload.! !

!MCPackageManager class methodsFor: 'system changes' stamp: 'GuillermoPolito 8/3/2012 14:15'!
methodRemoved: anEvent
	self managersForClass: anEvent methodClass category: anEvent protocol do:[:mgr| mgr modified: true].
! !

!MCPackageManager class methodsFor: 'system changes' stamp: 'ar 4/27/2005 14:11'!
managersForClass: aClass category: methodCategory do: aBlock
	(methodCategory isEmptyOrNil or:[methodCategory first ~= $*]) ifTrue:[
		"Not an extension method"
		^self managersForClass: aClass do: aBlock.
	].
	self managersForCategory: methodCategory allButFirst do: aBlock.! !

!MCPackageManager class methodsFor: 'initialize' stamp: 'CamilloBruni 8/1/2012 16:27'!
initialize
	"Remove this later"

	self unregisterForNotifications.! !

!MCPackageManager class methodsFor: 'system changes' stamp: 'GuillermoPolito 8/3/2012 13:57'!
methodModified: anEvent
	^self managersForClass: anEvent methodClass selector: anEvent selector do:[:mgr| mgr modified: true].! !

!MCPackageManager class methodsFor: 'system changes' stamp: 'EstebanLorenzano 9/12/2012 13:35'!
managersForClass: aClass do: aBlock

	self registry do: [:mgr |
		(mgr packageSet includesClass: aClass)
			ifTrue: [aBlock value: mgr]]! !

!MCPackageManager class methodsFor: 'event registration' stamp: 'BernardoContreras 10/10/2014 19:20'!
registerInterestOnSystemChangesOnAnnouncer: anAnnouncer
	anAnnouncer 
		when: RPackageRenamed send: #packageRenamed: to: self;
		when: ClassAdded, ClassModifiedClassDefinition, ClassRenamed, ClassCommented send: #classModified: to: self;
		when: ClassRepackaged send: #classMoved: to: self;
		when: ClassRemoved send: #classRemoved: to: self;
		when: MethodAdded, MethodModified, MethodRecategorized send: #methodModified: to: self;
		when: MethodRepackaged send: #methodMoved: to: self;
		when: MethodRemoved send: #methodRemoved: to: self.! !

!MCPackageManager class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 4/21/2014 13:09'!
gtInspectorManagersIn: composite
	<gtInspectorPresentationOrder: 40>
	composite list
		title: 'Managers';
		display: [ self allManagers sorted: [ :x :y | x packageName < y packageName ] ];
		format: #packageName;
		filterOn: [ :text :each | each gtDisplayString includesSubstring: text caseSensitive: false ]! !

!MCPackageManager class methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
registry
	^ registry ifNil: [registry := Dictionary new]! !

!MCPackageManager class methodsFor: 'system changes' stamp: 'BenjaminVanRyseghem 11/30/2013 14:21'!
classRemoved: anEvent
	"Informs the registry who use to keep this class that its changed. Unlike #classModified:, class is not anymore in RPackages so it will not be found, that's why we look for system category instead if class is included or not"
	 
	self registry do: [:mgr |
		(mgr packageSet includesSystemCategory: anEvent classAffected category)
			ifTrue: [ mgr modified: true ].
		 
		(mgr packageSet extensionCategoriesForClass: anEvent classAffected) ifNotEmpty: [ mgr modified: true ].	
	]! !

!MCPackageManager class methodsFor: 'system changes' stamp: 'ar 4/26/2005 21:40'!
managersForClass: aClass selector: aSelector do: aBlock
	^self managersForClass: aClass category: (aClass organization categoryOfElement: aSelector) do: aBlock! !

!MCPackageManager class methodsFor: '*rpackage-systemintegration' stamp: 'CamilleTeruel 7/29/2012 18:45'!
unregisterForNotifications
	SystemAnnouncer uniqueInstance unsubscribe: self! !

!MCPackageManager class methodsFor: 'system changes' stamp: 'MartinDias 1/28/2014 16:16'!
classModified: anEvent
	self 
		managersForClass: anEvent classAffected 
		do:[ :mgr | mgr modified: true ].! !

!MCPackageModified commentStamp: '<historical>'!
An MCPackageModified is raised when a MCPackage is modified!
!MCPackageModified methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/14/2011 13:49'!
package: anObject
	
		package := anObject! !

!MCPackageModified methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/14/2011 13:49'!
package

		^ package! !

!MCPackageModified class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 4/14/2011 13:52'!
package: aMCPackage

	^ self new package: aMCPackage! !

!MCPackageTest methodsFor: 'tests' stamp: 'BernardoContreras 10/13/2014 17:14'!
testUnloadWithAdditionalTracking
	"This is to test against another entity removing the extension protocol as well."

	| mock |
	SystemAnnouncer uniqueInstance when: MethodRemoved send: #aMethodRemoved: to: self.
	self assert: (SystemAnnouncer uniqueInstance hasSubscriber: self ).
	self mockPackage unload.
	self deny: (Smalltalk hasClassNamed: #MCMockClassA).
	self deny: (MCSnapshotTest includesSelector: #mockClassExtension).
	self deny: (MCSnapshotTest  organization protocolNamed: self mockExtensionMethodCategory) notNil.
	mock := Smalltalk globals at: #MCMock.
	self assert: (mock subclasses detect: [ :c | c name = #MCMockClassA ] ifNone: [  ]) isNil.
	SystemAnnouncer uniqueInstance unsubscribe: self.
	self deny: (SystemAnnouncer uniqueInstance hasSubscriber: self ).
! !

!MCPackageTest methodsFor: 'private' stamp: 'ThierryGoubier 1/17/2014 10:34'!
aMethodRemoved: anEvent
	"Force cleaning of the protocol."

	(anEvent protocol = self mockExtensionMethodCategory and: [ anEvent methodClass == MCSnapshotTest ])
		ifTrue: [ anEvent methodClass organization removeProtocolIfEmpty: self mockExtensionMethodCategory ]! !

!MCPackageTest methodsFor: 'tests' stamp: 'ThierryGoubier 1/13/2014 20:51'!
testUnload
	| mock |
	self mockPackage unload.
	self deny: (Smalltalk hasClassNamed: #MCMockClassA).
	self deny: (MCSnapshotTest includesSelector: #mockClassExtension).
	self deny: (MCSnapshotTest  organization protocolNamed: self mockExtensionMethodCategory) notNil.
	mock := Smalltalk globals at: #MCMock.
	self assert: (mock subclasses detect: [ :c | c name = #MCMockClassA ] ifNone: [  ]) isNil! !

!MCPackageTest methodsFor: 'running' stamp: 'GuillermoPolito 8/24/2012 14:36'!
tearDown
	self mockSnapshot install.
	MCDataStream initialize "MCMockClassG ends up in the DataStream TypeMap -- we need to reset"! !

!MCPatch commentStamp: 'StephaneDucasse 6/24/2011 14:11'!
I represent a set of patch operations which can be applied by sending message applyTo: to my instances. !
!MCPatch methodsFor: 'accessing' stamp: 'ab 5/13/2003 12:18'!
operations
	^ operations! !

!MCPatch methodsFor: 'accessing' stamp: 'CamilloBruni 9/28/2011 17:27'!
hasConflict
	^ self operations anySatisfy: [ :change| change isConflict ]! !

!MCPatch methodsFor: 'querying' stamp: 'cwp 6/9/2003 11:53'!
isEmpty
	^ operations isEmpty! !

!MCPatch methodsFor: '*Komitter-Models' stamp: 'MarcusDenker 1/5/2014 15:26'!
initializeWithTarget: targetSnapshot
	| target |	
		
	target := MCDefinitionIndex definitions: targetSnapshot definitions.
	operations := (target definitions collect: [ :definition | MCAddition of: definition ]) asOrderedCollection.! !

!MCPatch methodsFor: '*Komitter-Models' stamp: 'BenjaminVanRyseghem 11/24/2013 20:27'!
silentInitializeWithBase: baseSnapshot target: targetSnapshot
	| base target |	
	operations := OrderedCollection new.
	base := MCDefinitionIndex definitions: baseSnapshot definitions.
	target := MCDefinitionIndex definitions: targetSnapshot definitions.
	
	target definitions 
		do: [ :t |
			base
				definitionLike: t
				ifPresent: [:b | (b isSameRevisionAs: t) ifFalse: [operations add: (MCModification of: b to: t)]]
				ifAbsent:  [operations add: (MCAddition of: t)] ].
		
	base definitions do: [:b |
		target
			definitionLike: b
			ifPresent: [:t]
			ifAbsent: [operations add: (MCRemoval of: b)]]		! !

!MCPatch methodsFor: 'applying' stamp: 'ab 5/24/2003 16:12'!
applyTo: anObject
	operations do: [:ea | ea applyTo: anObject].
! !

!MCPatch methodsFor: 'intializing' stamp: 'BenjaminVanRyseghem 11/8/2013 15:41'!
initializeWithBase: baseSnapshot target: targetSnapshot
	| base target |	
	operations := OrderedCollection new.
	base := MCDefinitionIndex definitions: baseSnapshot definitions.
	target := MCDefinitionIndex definitions: targetSnapshot definitions.
	
	target definitions 
		do: [ :t |
			base
				definitionLike: t
				ifPresent: [:b | (b isSameRevisionAs: t) ifFalse: [operations add: (MCModification of: b to: t)]]
				ifAbsent:  [operations add: (MCAddition of: t)] ]
		displayingProgress: 'Diffing...'.
		
	base definitions do: [:b |
		target
			definitionLike: b
			ifPresent: [:t]
			ifAbsent: [operations add: (MCRemoval of: b)]]		! !

!MCPatch methodsFor: 'intializing' stamp: 'stephaneducasse 2/4/2006 20:47'!
initializeWithOperations: aCollection
	operations := aCollection! !

!MCPatch methodsFor: '*MonticelloGUI' stamp: 'BenjaminVanRyseghem 2/8/2012 17:10'!
browse

	^ (MCPatchBrowser forPatch: self) show! !

!MCPatch class methodsFor: 'instance-creation' stamp: 'avi 9/11/2004 15:50'!
operations: aCollection
	^ self basicNew initializeWithOperations: aCollection! !

!MCPatch class methodsFor: 'instance-creation' stamp: 'avi 9/11/2004 15:49'!
fromBase: baseSnapshot target: targetSnapshot
	^ self new initializeWithBase: baseSnapshot target: targetSnapshot! !

!MCPatchBrowser commentStamp: 'TorstenBergmann 2/20/2014 15:52'!
The Monticello patch browser!
!MCPatchBrowser methodsFor: 'actions' stamp: 'ar 7/10/2009 22:46'!
revertSelection
	| loader |
	selection ifNotNil:
		[loader := MCPackageLoader new.
		selection inverse applyTo: loader.
		loader loadWithName: self changeSetNameForInstall ]! !

!MCPatchBrowser methodsFor: 'subclassresponsibility' stamp: 'lr 3/14/2010 21:13'!
selectedClass
	| definition |
	selection ifNil: [ ^ nil ].
	(definition := selection definition) ifNil: [ ^ nil ].
	definition isMethodDefinition
		ifFalse: [ ^ nil ].
	^ Smalltalk globals at: definition className ifAbsent: [  ]! !

!MCPatchBrowser methodsFor: '*Tool-Diff' stamp: 'StephaneDucasse 10/27/2014 08:44'!
methodListMenu: aMenu

	selection 
		ifNotNil: [ 
			aMenu addList: #(
				('Install'	 installSelection)
				('Diff'	diffSelection)
				('Revert'	 revertSelection)
				-)].
	super methodListMenu: aMenu.
	^ aMenu
! !

!MCPatchBrowser methodsFor: 'text' stamp: 'ab 7/16/2003 14:27'!
text: aTextOrString
	self changed: #text! !

!MCPatchBrowser methodsFor: 'text' stamp: 'ab 7/16/2003 14:40'!
text
	^ selection ifNil: [''] ifNotNil: [selection source]! !

!MCPatchBrowser methodsFor: 'selecting' stamp: 'stephaneducasse 2/4/2006 20:47'!
invert
	items := items collect: [:ea | ea inverse].
	self changed: #list; changed: #text; changed: #selection! !

!MCPatchBrowser methodsFor: 'subclassresponsibility' stamp: 'stephaneducasse 2/4/2006 20:47'!
selectedMessageName
	| definition |
	selection ifNil: [ ^nil ].
	(definition := selection definition) ifNil: [ ^nil ].
	definition isMethodDefinition ifFalse: [ ^nil ].
	^definition  selector! !

!MCPatchBrowser methodsFor: 'morphic ui' stamp: 'ab 8/22/2003 02:21'!
buttonSpecs
	^ #((Invert invert 'Show the reverse set of changes')
		 (Export export 'Export the changes as a change set'))! !

!MCPatchBrowser methodsFor: 'selecting' stamp: 'ab 7/16/2003 14:30'!
selection
	^ selection 
		ifNil: [0]
		ifNotNil: [self items indexOf: selection]! !

!MCPatchBrowser methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
patch: aPatch
	items := aPatch operations asSortedCollection! !

!MCPatchBrowser methodsFor: 'subclassresponsibility' stamp: 'stephaneducasse 2/4/2006 20:47'!
selectedClassOrMetaClass
	| definition |
	selection ifNil: [ ^nil ].
	(definition := selection definition) ifNil: [ ^nil ].
	definition isMethodDefinition ifFalse: [ ^nil ].
	^definition actualClass! !

!MCPatchBrowser methodsFor: 'morphic ui' stamp: 'ab 7/19/2003 21:31'!
defaultLabel
	^ 'Patch Browser'! !

!MCPatchBrowser methodsFor: 'subclassresponsibility' stamp: 'stephaneducasse 2/4/2006 20:47'!
selectedMessageCategoryName
	| definition |
	selection ifNil: [ ^nil ].
	(definition := selection definition) ifNil: [ ^nil ].
	definition isMethodDefinition ifFalse: [ ^nil ].
	^definition category! !

!MCPatchBrowser methodsFor: '*Tool-Diff' stamp: 'gvc 10/24/2006 15:44'!
diffSelection
	"Open a diff browser on the selection."
	
	selection ifNotNil:
		[selection diff]! !

!MCPatchBrowser methodsFor: 'morphic ui' stamp: 'MarcusDenker 3/25/2013 13:06'!
widgetSpecs
	 ^#(
		((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (0 0 1 0.4) (0 0 0 0))
		((textMorph: text) (0 0.4 1 1))
		) 

	! !

!MCPatchBrowser methodsFor: 'actions' stamp: 'stephaneducasse 2/4/2006 20:47'!
installSelection
	| loader |
	selection ifNotNil:
		[loader := MCPackageLoader new.
		selection applyTo: loader.
		loader loadWithName: self changeSetNameForInstall ]! !

!MCPatchBrowser methodsFor: 'selecting' stamp: 'MarcusDenker 3/25/2013 13:09'!
selection: aNumber
	selection := aNumber = 0 ifFalse: [self items at: aNumber].
	self changed: #selection; changed: #text.! !

!MCPatchBrowser methodsFor: 'accessing' stamp: 'ab 7/16/2003 14:39'!
list
	^ self items collect: [:ea | ea summary]! !

!MCPatchBrowser methodsFor: 'actions' stamp: 'nk 2/23/2005 08:04'!
changeSetNameForInstall
	"Answer the name of the change set into which my selection will be installed.
	Derive this from my label.
	If I have no label, use the current change set."

	| tokens |
	label ifNil: [ ^ChangeSet current name ].
	tokens := label findTokens: ' '.
	tokens removeAllFoundIn: { 'changes'. 'between'. 'and' }.
	(tokens size = 3 and: [ tokens second = '<working' ]) ifTrue: [ ^tokens first, '-to-working' ].
	tokens size = 2 ifFalse: [ ^'InstalledPatches' ].
	^'{1}-to-{2}' format: tokens ! !

!MCPatchBrowser methodsFor: 'accessing' stamp: 'ab 7/16/2003 14:36'!
items
	^ items! !

!MCPatchBrowser class methodsFor: 'instance creation' stamp: 'ab 7/16/2003 14:35'!
forPatch: aPatch
	^ self new patch: aPatch! !

!MCPatchOperation commentStamp: 'StephaneDucasse 6/24/2011 14:15'!
I'm an abstract class that represent an single delta element between two packages: removal, addition or modification.!
!MCPatchOperation methodsFor: 'accessing' stamp: 'StephaneDucasse 6/24/2011 14:57'!
operation
	"for compatibility with MCConflict interface"
	^ self! !

!MCPatchOperation methodsFor: 'testing' stamp: 'StephaneDucasse 6/24/2011 14:56'!
isRemoteNewer
	^ self localDefinition fullTimeStamp < self remoteDefinition fullTimeStamp! !

!MCPatchOperation methodsFor: '*Tool-Diff' stamp: 'gvc 1/14/2009 14:07'!
diffToSource
	"Answer toSource of the operation for a diff tool."
	
	^self toSource! !

!MCPatchOperation methodsFor: 'comparing' stamp: 'ab 7/19/2003 18:11'!
<= other
	^ self definition <= other definition! !

!MCPatchOperation methodsFor: '*Tool-Diff' stamp: 'gvc 10/30/2006 11:15'!
patchWrapper
	"Answer a wrapper for a patch tree for the receiver."

	^PSMCPatchOperationWrapper with: self! !

!MCPatchOperation methodsFor: '*Tool-Diff' stamp: 'gvc 4/1/2009 12:15'!
targetClassName
	"Answer the full class *name* of the target since the class may no longer exist."
	
	^self definition fullClassName! !

!MCPatchOperation methodsFor: '*Tool-Diff' stamp: 'nice 3/29/2011 00:11'!
shortSummary
	"Answer a short summary of the receiver."

	^self shortSummaryPrefix , self shortSummarySuffix! !

!MCPatchOperation methodsFor: 'accessing' stamp: 'StephaneDucasse 6/24/2011 14:55'!
clearChoice
	isApplicable := nil! !

!MCPatchOperation methodsFor: 'accessing' stamp: 'AlainPlantec 12/1/2009 22:09'!
sourceText
	^ self isClassPatch 
		ifTrue: [(TextDiffBuilder from: self fromSource to: self toSource) buildDisplayPatch]
		ifFalse: [TextDiffBuilder buildDisplayPatchFrom:  self fromSource to: self toSource inClass: self targetClass]
! !

!MCPatchOperation methodsFor: 'testing' stamp: 'cwp 11/27/2002 09:30'!
isAddition
	^ false! !

!MCPatchOperation methodsFor: '*Tool-Diff' stamp: 'BenjaminVanRyseghem 9/28/2011 15:25'!
shortSummaryPrefix
	"Answer a short summary prefix of the receiver."

	^ self definition summary! !

!MCPatchOperation methodsFor: 'applying operation' stamp: 'IgorStasenko 6/24/2011 17:29'!
applyTo: anObject

	(self isConflict and: [self isResolved not] ) ifTrue: [
		self error: 'Cannot continue until this conflict has been resolved' ].
	
	self remoteChosen ifTrue: [ self basicApplyTo: anObject ].! !

!MCPatchOperation methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/21/2013 14:28'!
koClass

	^ self subclassResponsibility! !

!MCPatchOperation methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/21/2013 16:34'!
koDefinition

	^ self subclassResponsibility! !

!MCPatchOperation methodsFor: 'initialization' stamp: 'StephaneDucasse 6/24/2011 15:13'!
initialize
	super initialize.
	
	"set default values"
	
	self beNonConflict! !

!MCPatchOperation methodsFor: 'accessing' stamp: 'StephaneDucasse 6/24/2011 14:54'!
chooseLocal
	isApplicable := false! !

!MCPatchOperation methodsFor: 'accessing' stamp: 'CamilloBruni 8/4/2011 15:16'!
source
	^ self localChosen
		ifTrue: [self fromSource]
		ifFalse: [self sourceText]! !

!MCPatchOperation methodsFor: 'testing' stamp: 'cwp 11/27/2002 09:30'!
isRemoval
	^ false! !

!MCPatchOperation methodsFor: 'testing' stamp: 'StephaneDucasse 6/24/2011 14:57'!
localDefinition
	^ self baseDefinition! !

!MCPatchOperation methodsFor: 'accessing' stamp: 'StephaneDucasse 6/24/2011 14:58'!
remoteDefinition
	^ self targetDefinition! !

!MCPatchOperation methodsFor: 'accessing' stamp: 'avi 8/31/2003 17:53'!
prefixForOperation: aSymbol
	aSymbol == #insert ifTrue: [^ '+'].
	aSymbol == #remove ifTrue: [^ '-'].
	^ ' '! !

!MCPatchOperation methodsFor: 'accessing' stamp: 'StephaneDucasse 6/24/2011 14:59'!
status
	^ self isResolved
		ifFalse: ['']
		ifTrue: [self remoteChosen
					ifFalse: ['L']
					ifTrue: ['R']]! !

!MCPatchOperation methodsFor: 'testing' stamp: 'StephaneDucasse 6/24/2011 14:56'!
isLocalNewer
	^ self localDefinition fullTimeStamp > self remoteDefinition fullTimeStamp! !

!MCPatchOperation methodsFor: 'accessing' stamp: 'AlainPlantec 1/7/2010 22:21'!
printAnnotations: requests on: aStream
	"Add a string for an annotation pane, trying to fulfill the CodeHolder annotationRequests"

	self definition printAnnotations: requests on: aStream.! !

!MCPatchOperation methodsFor: 'testing' stamp: 'StephaneDucasse 6/24/2011 15:07'!
isResolved
	^ isConflict and: [ isApplicable notNil ]! !

!MCPatchOperation methodsFor: 'accessing' stamp: 'cwp 11/28/2002 06:59'!
definition
	^ self subclassResponsibility ! !

!MCPatchOperation methodsFor: 'accessing' stamp: 'StephaneDucasse 6/24/2011 15:12'!
beNonConflict
	isConflict := false.
	isApplicable := true.! !

!MCPatchOperation methodsFor: 'testing' stamp: 'nk 2/25/2005 17:28'!
isClassPatch
	^false! !

!MCPatchOperation methodsFor: 'accessing' stamp: 'nk 2/23/2005 18:17'!
targetClass
	self subclassResponsibility.! !

!MCPatchOperation methodsFor: 'accessing' stamp: 'StephaneDucasse 6/24/2011 14:54'!
chooseNewer
	self isLocalNewer 
		ifTrue: [ self chooseLocal ]
		ifFalse: [ self isRemoteNewer ifTrue: [ self chooseRemote ]]! !

!MCPatchOperation methodsFor: 'accessing' stamp: 'StephaneDucasse 6/24/2011 14:55'!
chooseRemote
	isApplicable := true! !

!MCPatchOperation methodsFor: 'testing' stamp: 'IgorStasenko 6/24/2011 17:28'!
remoteChosen
	^ isApplicable ~~ false! !

!MCPatchOperation methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/21/2013 15:10'!
isMethodPatch

	^ self subclassResponsibility! !

!MCPatchOperation methodsFor: 'accessing' stamp: 'CamilloBruni 8/4/2011 15:15'!
summary
	| attribute |
	attribute := 
		self isResolved
			ifTrue: [self remoteChosen ifTrue: [#underlined] ifFalse: [#struckOut]]
			ifFalse: [#bold].
	^ Text string:( self definition summary, self summarySuffix) attribute: (TextEmphasis perform: attribute)! !

!MCPatchOperation methodsFor: 'testing' stamp: 'StephaneDucasse 6/24/2011 14:44'!
isConflict
	^ isConflict == true! !

!MCPatchOperation methodsFor: 'accessing' stamp: 'nk 2/25/2005 17:26'!
sourceString
	^self sourceText asString! !

!MCPatchOperation methodsFor: 'accessing' stamp: 'StephaneDucasse 6/24/2011 14:55'!
chooseOlder
	self isRemoteNewer 
		ifTrue: [ self chooseLocal ]
		ifFalse: [ self isLocalNewer ifTrue: [ self chooseRemote ]]! !

!MCPatchOperation methodsFor: '*Tool-Diff' stamp: 'gvc 1/14/2009 14:07'!
diffFromSource
	"Answer fromSource of the operation for a diff tool."
	
	^self fromSource! !

!MCPatchOperation methodsFor: 'testing' stamp: 'StephaneDucasse 6/24/2011 14:57'!
localChosen
	^ isApplicable == false
! !

!MCPatchOperation methodsFor: 'accessing' stamp: 'cwp 11/27/2002 09:26'!
inverse
	self subclassResponsibility! !

!MCPatchOperation methodsFor: '*Tool-Diff' stamp: 'gvc 10/24/2006 15:40'!
diff
	"Open a diff browser on the changes."
! !

!MCPatchOperation methodsFor: 'accessing' stamp: 'ab 7/6/2003 00:06'!
summarySuffix
	^ ''! !

!MCPatchOperation methodsFor: 'testing' stamp: 'cwp 11/27/2002 09:30'!
isModification
	^ false! !

!MCPatchOperation methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/21/2013 15:44'!
koMethod

	^ self subclassResponsibility! !

!MCPatchOperation methodsFor: '*Tool-Diff' stamp: 'nice 3/29/2011 00:11'!
shortSummarySuffix
	"Answer a short summary suffix of the receiver."

	^self fromSource = self toSource
		ifTrue: [' (revision changed)']
		ifFalse: ['']! !

!MCPatchOperation methodsFor: 'accessing' stamp: 'StephaneDucasse 6/24/2011 15:00'!
beConflict
	isConflict := true.
	isApplicable := nil. "not resolved"! !

!MCPatchTest methodsFor: 'tests' stamp: 'cwp 7/14/2003 15:31'!
testPatchContents
	self assert: patch operations size = 1.
	self assert: patch operations first isModification.
	self assert: patch operations first definition selector = #one.
! !

!MCPatchTest methodsFor: 'running' stamp: 'cwp 8/2/2003 17:24'!
tearDown
	self restoreMocks! !

!MCPatchTest methodsFor: 'running' stamp: 'stephaneducasse 2/4/2006 20:47'!
setUp
	|rev1 rev2|
	rev1 :=  MCSnapshotResource takeSnapshot.
	self change: #one toReturn: 2.
	rev2 :=  MCSnapshotResource takeSnapshot.
	patch := rev2 patchRelativeToBase: rev1.
	self change: #one toReturn: 1.! !

!MCPatcher commentStamp: 'LaurentLaffont 3/31/2011 21:05'!
I can add or remove or modify definitions. My main purpose is to generate monticello snapshot out of multiple snapshots or definitions by using my most used method #apply:to:.!
!MCPatcher methodsFor: 'operations' stamp: 'ab 6/1/2003 14:23'!
modifyDefinition: baseDefinition to: targetDefinition
	self addDefinition: targetDefinition! !

!MCPatcher methodsFor: 'adding' stamp: 'ab 6/2/2003 00:46'!
addDefinition: aDefinition
	definitions add: aDefinition! !

!MCPatcher methodsFor: 'operations' stamp: 'ab 6/2/2003 00:46'!
removeDefinition: aDefinition
	definitions remove: aDefinition! !

!MCPatcher methodsFor: 'initialize-release' stamp: 'stephaneducasse 2/4/2006 20:47'!
initializeWithSnapshot: aSnapshot
	definitions := MCDefinitionIndex definitions: aSnapshot definitions! !

!MCPatcher methodsFor: 'accessing' stamp: 'ab 7/6/2003 23:48'!
patchedSnapshot
	^ MCSnapshot fromDefinitions: definitions definitions! !

!MCPatcher class methodsFor: 'instance-creation' stamp: 'ab 6/1/2003 14:22'!
snapshot: aSnapshot
	^ self new initializeWithSnapshot: aSnapshot! !

!MCPatcher class methodsFor: 'public' stamp: 'stephaneducasse 2/4/2006 20:47'!
apply: aPatch to: aSnapshot
	| loader |
	loader := self snapshot: aSnapshot.
	aPatch applyTo: loader.
	^ loader patchedSnapshot! !

!MCPermissionDenied commentStamp: '<historical>'!
I am signalled when a repositroy cannot save or access a version.!
!MCPermissionDenied methodsFor: 'accessing' stamp: 'CamilloBruni 4/11/2013 17:17'!
repository: anObject
	repository := anObject! !

!MCPermissionDenied methodsFor: 'accessing' stamp: 'CamilloBruni 4/11/2013 17:17'!
repository
	^ repository! !

!MCPermissionDenied class methodsFor: 'signalling' stamp: 'CamilloBruni 4/11/2013 17:17'!
signalFor: aRepository
	^ self new
		repository: aRepository;
		signal! !

!MCPoolImportDefinition commentStamp: '<historical>'!
A MCPoolImportDefinition represents a pool definition.!
!MCPoolImportDefinition methodsFor: 'testing' stamp: 'cwp 7/7/2003 23:51'!
isPoolImport
	^ true! !

!MCPoolImportDefinition methodsFor: 'testing' stamp: 'bf 8/29/2006 11:41'!
isOrderDependend
	^false! !

!MCPoolImportDefinition class methodsFor: 'accessing' stamp: 'cwp 7/7/2003 22:59'!
type
	^ #pool! !

!MCPostscriptDefinition commentStamp: 'TorstenBergmann 2/5/2014 13:47'!
A postscript evaluated after load!
!MCPostscriptDefinition methodsFor: 'accessing' stamp: 'avi 2/28/2005 17:16'!
sortKey
	^ 'zzz' "force to the end so it gets loaded late"! !

!MCPostscriptDefinition methodsFor: 'installing' stamp: 'avi 2/28/2005 17:16'!
postload
	self evaluate! !

!MCPostscriptDefinition class methodsFor: 'accessing' stamp: 'avi 2/28/2005 17:04'!
scriptSelector
	^ #postscript! !

!MCPreambleDefinition commentStamp: 'TorstenBergmann 2/5/2014 13:47'!
A preamble evaluated before load!
!MCPreambleDefinition methodsFor: 'installing' stamp: 'avi 2/28/2005 17:15'!
load
	super load.
	self evaluate! !

!MCPreambleDefinition class methodsFor: 'accessing' stamp: 'avi 2/28/2005 17:04'!
scriptSelector
	^ #preamble! !

!MCPseudoFileStream commentStamp: '<historical>'!
A pseudo file stream which can be used for updates.!
!MCPseudoFileStream methodsFor: 'accessing' stamp: 'ar 4/14/2005 19:54'!
localName: aString
	localName := aString! !

!MCPseudoFileStream methodsFor: 'accessing' stamp: 'ar 4/14/2005 19:54'!
localName
	^localName! !

!MCReader commentStamp: 'TorstenBergmann 2/5/2014 13:53'!
Common superclass for Monticello readers!
!MCReader methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
stream: aStream
	stream := aStream! !

!MCReader methodsFor: 'accessing' stamp: 'CamilloBruni 4/24/2012 15:49'!
stream
	stream closed ifTrue: [ stream open ].
	^ stream
	! !

!MCReader class methodsFor: 'instance creation' stamp: 'stephaneducasse 2/4/2006 20:47'!
on: aStream name: aFileName
	| class |
	class := self readerClassForFileNamed: aFileName.
	^ class
		ifNil: [self error: 'Unsupported format: ', aFileName]
		ifNotNil: [class on: aStream]! !

!MCReader class methodsFor: 'instance creation' stamp: 'avi 1/21/2004 19:02'!
on: aStream
	^ self new stream: aStream! !

!MCReader class methodsFor: 'testing' stamp: 'avi 1/21/2004 19:00'!
canReadFileNamed: fileName
	^ (fileName endsWith: self extension)! !

!MCReader class methodsFor: 'testing' stamp: 'avi 1/21/2004 19:01'!
isAbstract
	^ (self respondsTo: #extension) not! !

!MCReader class methodsFor: 'testing' stamp: 'avi 1/21/2004 19:03'!
readerClassForFileNamed: fileName
	^ self concreteSubclasses
		detect: [:c | c canReadFileNamed: fileName]
		ifNone: [nil]! !

!MCReader class methodsFor: 'testing' stamp: 'avi 1/21/2004 19:01'!
concreteSubclasses
	^ self allSubclasses reject: [:c | c isAbstract]! !

!MCRemoval commentStamp: '<historical>'!
A MCRemoval represents the removal of an entity of a given snapshot.!
!MCRemoval methodsFor: 'accessing' stamp: 'cwp 11/27/2002 10:02'!
definition
	^ definition! !

!MCRemoval methodsFor: 'accessing' stamp: 'LucasGiudice 9/14/2013 15:08'!
fromSource
	^ definition diffSource! !

!MCRemoval methodsFor: 'accessing' stamp: 'ab 7/18/2003 16:44'!
toSource
	^ ''! !

!MCRemoval methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/21/2013 15:34'!
selector

	^ definition selector! !

!MCRemoval methodsFor: 'accessing' stamp: 'ab 6/1/2003 13:10'!
targetDefinition
	^ nil! !

!MCRemoval methodsFor: 'testing' stamp: 'nk 2/25/2005 17:28'!
isClassPatch
	^definition isClassDefinition! !

!MCRemoval methodsFor: 'accessing' stamp: 'nk 2/25/2005 17:23'!
targetClass
	^ definition actualClass! !

!MCRemoval methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/21/2013 15:10'!
isMethodPatch

	^ definition isMethodDefinition! !

!MCRemoval methodsFor: '*Komitter-UI' stamp: 'NicolaiHess 4/8/2014 20:03'!
koClass
	| klass |
	klass := definition koClass.
	klass ifNil: [ ^ nil ].
	definition addOperation: self on: klass.
	self isClassPatch
		ifTrue: [ klass removed: true ].
	^ klass! !

!MCRemoval methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/21/2013 22:06'!
koDestinationText

	^ ''! !

!MCRemoval methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/26/2013 14:43'!
koDefinition
	
	^  (KomitDefinition definition: self definition)
		operation: self;
		removed: true;
		yourself! !

!MCRemoval methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/21/2013 22:04'!
koSourceText
	^ definition koSourceText ! !

!MCRemoval methodsFor: 'accessing' stamp: 'nk 2/23/2005 18:38'!
sourceString
	^self fromSource asText
		addAttribute: TextEmphasis struckOut;
		addAttribute: TextColor blue;
		yourself! !

!MCRemoval methodsFor: 'accessing' stamp: 'StephaneDucasse 6/24/2011 14:53'!
basicApplyTo: anObject
	anObject removeDefinition: definition! !

!MCRemoval methodsFor: 'testing' stamp: 'cwp 11/28/2002 07:24'!
isRemoval
	^ true! !

!MCRemoval methodsFor: 'accessing' stamp: 'ab 8/22/2003 02:26'!
inverse
	^ MCAddition of: definition! !

!MCRemoval methodsFor: 'accessing' stamp: 'ab 7/6/2003 00:05'!
summarySuffix
	^ ' (removed)'! !

!MCRemoval methodsFor: 'accessing' stamp: 'ab 6/1/2003 13:10'!
baseDefinition
	^ definition! !

!MCRemoval methodsFor: 'initializing' stamp: 'stephaneducasse 2/4/2006 20:47'!
intializeWithDefinition: aDefinition
	definition := aDefinition! !

!MCRemoval methodsFor: '*Komitter-UI' stamp: 'BenjaminVanRyseghem 11/25/2013 18:20'!
koMethod
	
	^ (KomitMethod method: self definition)
		operation: self;
		removed: true;
		yourself! !

!MCRemoval class methodsFor: 'instance-creation' stamp: 'cwp 11/27/2002 10:03'!
of: aDefinition
	^ self new intializeWithDefinition: aDefinition! !

!MCRemovalPostscriptDefinition commentStamp: 'TorstenBergmann 2/5/2014 13:48'!
A postscript evaluated after unloading/removing!
!MCRemovalPostscriptDefinition methodsFor: 'installing' stamp: 'avi 2/28/2005 17:15'!
unload
	super unload.
	self evaluate! !

!MCRemovalPostscriptDefinition class methodsFor: 'accessing' stamp: 'avi 2/28/2005 17:04'!
scriptSelector
	^ #postscriptOfRemoval ! !

!MCRemovalPreambleDefinition commentStamp: 'TorstenBergmann 2/5/2014 13:48'!
A preamble evaluated before unloading/removing!
!MCRemovalPreambleDefinition methodsFor: 'installing' stamp: 'avi 2/28/2005 17:15'!
unload
	super unload.
	self evaluate! !

!MCRemovalPreambleDefinition methodsFor: 'accessing' stamp: 'avi 2/28/2005 17:14'!
sortKey
	^ 'zzz' "force to the end so it gets unloaded early"! !

!MCRemovalPreambleDefinition class methodsFor: 'accessing' stamp: 'avi 2/28/2005 17:04'!
scriptSelector
	^ #preambleOfRemoval! !

!MCRepository commentStamp: 'TorstenBergmann 2/5/2014 13:54'!
A Metacello repository!
!MCRepository methodsFor: 'accessing' stamp: 'avi 10/9/2003 12:53'!
description
	^ self class name! !

!MCRepository methodsFor: 'converting' stamp: 'bkv 2/18/2004 20:48'!
asCreationTemplate
	^ self creationTemplate! !

!MCRepository methodsFor: 'testing' stamp: 'avi 8/31/2004 01:08'!
alwaysStoreDiffs
	^ storeDiffs ifNil: [false]! !

!MCRepository methodsFor: '*metacello-core' stamp: 'dkh 7/24/2012 21:46'!
flushForScriptGet
    "noop"

! !

!MCRepository methodsFor: '*MonticelloGUI' stamp: 'bf 4/14/2005 17:30'!
openAndEditTemplateCopy
	^ self class fillInTheBlankConfigure: (self asCreationTemplate ifNil: [^nil])! !

!MCRepository methodsFor: 'notifying' stamp: 'avi 8/26/2004 14:27'!
notificationForVersion: aVersion
	^ MCVersionNotification version: aVersion repository: self! !

!MCRepository methodsFor: '*gofer-core-accessing' stamp: 'lr 12/11/2009 22:31'!
goferPriority
	^ 0! !

!MCRepository methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
doAlwaysStoreDiffs
	storeDiffs := true! !

!MCRepository methodsFor: 'storing' stamp: 'CamilloBruni 4/21/2012 21:12'!
prepareVersionForStorage: aVersion
	^ self alwaysStoreDiffs
		ifTrue: [
			aVersion asDiffAgainst:
				(self closestAncestorVersionFor: aVersion info ifNone: [^ aVersion])]
		ifFalse: [ aVersion ]! !

!MCRepository methodsFor: 'adding' stamp: 'abc 11/8/2013 17:11'!
addTo: aRepository
	^ aRepository addBasicRepository: self! !

!MCRepository methodsFor: '*Komitter-Models' stamp: 'BenjaminVanRyseghem 11/30/2013 22:20'!
isCache
	^ false! !

!MCRepository methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
metacelloProjectClassFor: aScriptEngine
    ^ MetacelloMCProject! !

!MCRepository methodsFor: 'accessing' stamp: 'bkv 2/18/2004 20:46'!
creationTemplate
	^ creationTemplate! !

!MCRepository methodsFor: 'printing' stamp: 'mas 9/24/2003 04:21'!
printOn: aStream
	super printOn: aStream.
	aStream
		nextPut: $(;
		nextPutAll: self description;
		nextPut: $).! !

!MCRepository methodsFor: 'storing' stamp: 'avi 8/26/2004 14:20'!
basicStoreVersion: aVersion
	self subclassResponsibility! !

!MCRepository methodsFor: 'interface' stamp: 'ab 8/21/2003 12:40'!
includesVersionNamed: aString
	self subclassResponsibility! !

!MCRepository methodsFor: 'testing' stamp: 'nk 11/2/2003 10:55'!
isValid
	^true! !

!MCRepository methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
creationTemplate: aString
	self creationTemplate ifNotNil: [ self error: 'Creation template already set for this MCRepository instance.' ].
	
	creationTemplate := aString.! !

!MCRepository methodsFor: 'notifying' stamp: 'avi 8/26/2004 14:23'!
notifyList
	^ #()! !

!MCRepository methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
projectVersion: aString
    "noop"

! !

!MCRepository methodsFor: 'accessing' stamp: 'marcus.denker 11/10/2008 10:04'!
closestAncestorVersionFor: anAncestry ifNone: errorBlock
	anAncestry breadthFirstAncestorsDo:
		[:ancestorInfo |
		(self versionWithInfo: ancestorInfo) ifNotNil: [:v | ^ v]].
	^ errorBlock value! !

!MCRepository methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/17/2015 15:53'!
gtDisplayOn: aStream
	aStream nextPutAll: self description! !

!MCRepository methodsFor: 'comparing' stamp: 'ab 8/21/2003 12:36'!
hash
	^ self description hash! !

!MCRepository methodsFor: '*MonticelloGUI' stamp: 'lr 9/26/2003 20:03'!
morphicOpen: aWorkingCopy
	self subclassResponsibility ! !

!MCRepository methodsFor: 'interface' stamp: 'ab 8/16/2003 18:22'!
versionWithInfo: aVersionInfo ifAbsent: aBlock
	self subclassResponsibility ! !

!MCRepository methodsFor: 'accessing' stamp: 'bf 3/10/2005 23:01'!
possiblyNewerVersionsOfAnyOf: someVersions
	^#()! !

!MCRepository methodsFor: '*gofer-core-accessing' stamp: 'lr 12/9/2009 20:50'!
goferReferences
	^ #()! !

!MCRepository methodsFor: '*monticellofiletree-core' stamp: 'dkh 4/5/2012 11:15:15'!
retrieveVersionsWithPackageNames: packageNames
    ^ self readableFileNames
        collect: [ :each | 
            | name |
            name := (each copyUpToLast: $.) copyUpTo: $(.
            name last isDigit
                ifFalse: [ 
                    Array
                        with: name
                        with: ''
                        with: ''
                        with: each ]
                ifTrue: [ 
                    Array
                        with: (packageNames add: (name copyUpToLast: $-))
                        with: ((name copyAfterLast: $-) copyUpTo: $.)
                        with: ((name copyAfterLast: $-) copyAfter: $.) asInteger
                        with: each	"pkg name"	"user"	"version" ] ]! !

!MCRepository methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
doNotAlwaysStoreDiffs
	storeDiffs := false! !

!MCRepository methodsFor: 'comparing' stamp: 'ab 8/21/2003 12:36'!
= other
	^ other species = self species and: [other description = self description]! !

!MCRepository methodsFor: 'notifying' stamp: 'stephaneducasse 2/4/2006 20:47'!
sendNotificationsForVersion: aVersion
	| notification notifyList |
	notifyList := self notifyList.
	notifyList isEmpty ifFalse:
		[notification := self notificationForVersion: aVersion.
		notifyList do: [:ea | notification notify: ea]]! !

!MCRepository methodsFor: 'storing' stamp: 'SeanDeNigris 7/17/2012 15:49'!
storeDependencies: aVersion
	MCCacheRepository uniqueInstance cacheAllFileNamesDuring: 
		[self cacheAllFileNamesDuring: 
			[aVersion allAvailableDependenciesDo:
				[:dep |
					(self includesVersionNamed: dep info name)
						ifFalse: [self storeVersion: dep]]]]! !

!MCRepository methodsFor: '*Komitter-Models' stamp: 'BenjaminVanRyseghem 11/22/2013 16:17'!
isRemote
	^ false! !

!MCRepository methodsFor: 'interface' stamp: 'avi 10/9/2003 12:42'!
versionWithInfo: aVersionInfo
	^ self versionWithInfo: aVersionInfo ifAbsent: [nil]! !

!MCRepository methodsFor: '*gofer-core-accessing' stamp: 'lr 12/12/2009 11:29'!
goferVersionFrom: aVersionReference
	self error: 'Unable to load from ' , self printString! !

!MCRepository methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
asRepositorySpecFor: aMetacelloMCProject

	self subclassResponsibility! !

!MCRepository methodsFor: '*MonticelloGUI' stamp: 'lr 9/26/2003 20:03'!
morphicOpen
	self morphicOpen: nil! !

!MCRepository methodsFor: 'storing' stamp: 'CamilloBruni 4/22/2012 21:11'!
storeVersion: aVersion
	self basicStoreVersion: (self prepareVersionForStorage: aVersion).
	self sendNotificationsForVersion: aVersion! !

!MCRepository class methodsFor: '*MonticelloGUI' stamp: 'CamilloBruni 10/9/2012 20:03'!
fillInTheBlankConfigure: aTemplateString 
	| chunk repo |
	aTemplateString
		ifNil: [^ false].
	chunk := UIManager default
				multiLineRequest: self fillInTheBlankRequest
				initialAnswer: aTemplateString
				answerHeight: 150.
	(chunk notNil and: [ chunk notEmpty ])
		ifTrue: [repo := self readFrom: chunk readStream.
			repo creationTemplate: chunk].
	^ repo! !

!MCRepository class methodsFor: 'accessing' stamp: 'ab 8/21/2003 00:29'!
description
	^ nil! !

!MCRepository class methodsFor: 'request handling' stamp: 'bkv 2/18/2004 20:58'!
fillInTheBlankRequest
	self subclassResponsibility.! !

!MCRepository class methodsFor: 'testing' stamp: 'ab 8/21/2003 12:59'!
isAbstract
	^ self description isNil! !

!MCRepository class methodsFor: 'accessing' stamp: 'bkv 2/18/2004 20:59'!
creationTemplate
	self subclassResponsibility.! !

!MCRepository class methodsFor: '*MonticelloGUI' stamp: 'bkv 2/18/2004 21:05'!
fillInTheBlankConfigure
	^ self fillInTheBlankConfigure: self creationTemplate
			! !

!MCRepository class methodsFor: 'accessing' stamp: 'ab 8/21/2003 00:30'!
allConcreteSubclasses
	^ self withAllSubclasses reject: [:ea | ea isAbstract]! !

!MCRepository class methodsFor: 'instance creation' stamp: 'ab 7/24/2003 21:01'!
morphicConfigure
	^ self new! !

!MCRepositoryAuthorizationTest methodsFor: 'tests' stamp: 'SeanDeNigris 8/27/2012 10:07'!
testStoredCredentials

	| repo registry |
	[
		registry := MCServerRegistry uniqueInstance.
		registry on: self exampleServerUrl beUser: 'myusername' withPassword: 'mypassword'.
		
		repo := MCHttpRepository location: self exampleServerUrl.
		
		self assert: repo user equals: 'myusername'.
		self assert: repo password equals: 'mypassword'.
	] ensure: [
		registry removeCredentialsFor: self exampleServerUrl ].! !

!MCRepositoryAuthorizationTest methodsFor: 'asserting' stamp: 'SeanDeNigris 8/27/2012 11:22'!
assert: registry on: serverUrlString hasUser: nameString withPassword: passwordString 

	registry repositoryAt: serverUrlString credentialsDo: [ :user :password |
		self assert: nameString equals: user.
		self assert: passwordString equals: password ].! !

!MCRepositoryAuthorizationTest methodsFor: 'tests' stamp: 'SeanDeNigris 8/27/2012 10:06'!
testEmptyCredentials

	| repo |
	"Although you can do this, it's easier to use #location:. See #testNoCredentials"
	repo := MCHttpRepository location: self exampleServerUrl user: '' password: ''.
	self assert: repo user equals: ''.
	self assert: repo password equals: ''.! !

!MCRepositoryAuthorizationTest methodsFor: 'accessing' stamp: 'SeanDeNigris 8/27/2012 10:13'!
exampleServerUrl

	^ 'http://www.squeaksource.com'.! !

!MCRepositoryAuthorizationTest methodsFor: 'tests' stamp: 'SeanDeNigris 8/27/2012 10:10'!
testStoredCredentialsUsesMostSpecific

	| repo registry nestedRepo |
	[
		nestedRepo := self exampleServerUrl, '/ss3'.
		registry := MCServerRegistry uniqueInstance.
		registry on: self exampleServerUrl beUser: 'myusername' withPassword: 'mypassword'.
		registry on: nestedRepo beUser: 'myss3username' withPassword: 'myss3password'.
		
		repo := MCHttpRepository location: nestedRepo.
		
		self assert: repo user equals: 'myss3username'.
		self assert: repo password equals: 'myss3password'.
	] ensure: [
		registry
			removeCredentialsFor: self exampleServerUrl;
			removeCredentialsFor: nestedRepo ].! !

!MCRepositoryAuthorizationTest methodsFor: 'tests' stamp: 'SeanDeNigris 8/27/2012 11:24'!
testOverrideStoredCredentials

	| repo registry |
	[
		registry := MCServerRegistry uniqueInstance.
		registry on: self exampleServerUrl beUser: 'myusername' withPassword: 'mypassword'.
		
		repo := MCHttpRepository location: self exampleServerUrl user: 'user_this_time' password: 'password_this_time'.
		
		self assert: repo user equals: 'user_this_time'.
		self assert: repo password equals: 'password_this_time'.
		self assert: registry on: self exampleServerUrl hasUser: 'myusername' withPassword: 'mypassword'.
	] ensure: [
		registry removeCredentialsFor: self exampleServerUrl ].! !

!MCRepositoryAuthorizationTest methodsFor: 'tests' stamp: 'SeanDeNigris 8/27/2012 10:07'!
testNoCredentials

	| repo |
	repo := MCHttpRepository location: self exampleServerUrl.
	self assert: repo user equals: ''.
	self assert: repo password equals: ''.! !

!MCRepositoryError commentStamp: '<historical>'!
I am an MC-specific errror!
!MCRepositoryGroup commentStamp: '<historical>'!
A singleton class, holds the list of repositories. Can look for a requested VersionInfo among its repositories.!
!MCRepositoryGroup methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/22/2013 14:51'!
removeRepository: aRepository
	repositories remove: aRepository ifAbsent: []! !

!MCRepositoryGroup methodsFor: 'adding' stamp: 'abc 11/8/2013 17:10'!
addRepositoryGroup: aRepositoryGroup
	aRepositoryGroup repositoriesDo: [ :each | 
		each addTo: self ]! !

!MCRepositoryGroup methodsFor: '*Komitter-Models' stamp: 'ChristopheDemarey 4/1/2014 17:30'!
remotes

	^ self repositories select: [ :each | each isCache not ]! !

!MCRepositoryGroup methodsFor: 'accessing' stamp: 'marcus.denker 11/10/2008 10:04'!
versionWithInfo: aVersionInfo ifNone: aBlock
	self repositoriesDo: [:ea | (ea versionWithInfo: aVersionInfo) ifNotNil: [:v | ^ v]].
	^aBlock value! !

!MCRepositoryGroup methodsFor: 'accessing' stamp: 'abc 6/20/2008 10:02'!
useCache
	^ useCache ifNil: [
		useCache := true
	]! !

!MCRepositoryGroup methodsFor: 'adding' stamp: 'abc 11/8/2013 17:09'!
addBasicRepository: aRepository
	((repositories includes: aRepository) 
	or: [ aRepository == MCCacheRepository uniqueInstance ])
		ifFalse: [
			repositories add: aRepository.
			self class default addRepository: aRepository ].
	^ aRepository! !

!MCRepositoryGroup methodsFor: 'testing' stamp: 'avi 11/7/2003 00:20'!
includes: aRepository
	^ self repositories includes: aRepository! !

!MCRepositoryGroup methodsFor: 'accessing' stamp: 'NorbertHartl 6/20/2008 10:11'!
disableCache
	useCache := false! !

!MCRepositoryGroup methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 10:03'!
initialize
	super initialize.
	repositories := OrderedCollection new! !

!MCRepositoryGroup methodsFor: 'accessing' stamp: 'SeanDeNigris 7/17/2012 15:42'!
repositories
	^ (self useCache 
		ifTrue: [Array with: MCCacheRepository uniqueInstance] 
		ifFalse: [Array new]) , repositories select: #isValid! !

!MCRepositoryGroup methodsFor: 'adding' stamp: 'abc 11/8/2013 17:10'!
addTo: aRepository
	^ aRepository addRepositoryGroup: self! !

!MCRepositoryGroup methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/22/2013 14:51'!
removeHTTPRepositoryLocationNamed: aRepositoryString
	
	| httpRepo others |
	httpRepo := repositories select: [:each | each isKindOf: MCHttpRepository]. 
	others := repositories reject: [:each | each isKindOf: MCHttpRepository].
	repositories := others, (httpRepo reject: [:each | each locationWithTrailingSlash = aRepositoryString])! !

!MCRepositoryGroup methodsFor: 'interface' stamp: 'dvf 8/10/2004 23:02'!
versionWithInfo: aVersionInfo
	^self versionWithInfo: aVersionInfo ifNone: [ self error: 'Could not find version ', aVersionInfo name printString,'. Maybe you need to add a repository?' ]! !

!MCRepositoryGroup methodsFor: 'interface' stamp: 'EstebanLorenzano 5/3/2013 14:22'!
includesVersionNamed: aString
	" check for existing version name in parallel over all repositories "
	| results |

	results := Array new: self repositories size.
	
	self repositories doWithIndex: [:repository :index | 
		" fork of test for each repository "
		results 
			at: index 
			put: (repository includesVersionNamed: aString) ].

	" check if any repository included the given versionName already"
	^ results anySatisfy: [:result| result = true ]	! !

!MCRepositoryGroup methodsFor: 'enumerating' stamp: 'avi 11/7/2003 00:51'!
repositoriesDo: aBlock
	self repositories do: [:ea | [aBlock value: ea] on: Error do: []]! !

!MCRepositoryGroup methodsFor: 'adding' stamp: 'abc 11/8/2013 17:09'!
addRepository: aRepository
	aRepository addTo: self.
	^ aRepository! !

!MCRepositoryGroup class methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
default
	^ default ifNil: [default := self new]! !

!MCRepositoryGroup class methodsFor: 'instance creation' stamp: 'EstebanLorenzano 9/8/2013 10:57'!
withRepositories: aCollection 
	| group |
	group  := self new.
	aCollection do: [ :each | group addRepository: each ].
	^ group 
		! !

!MCRepositoryInspector commentStamp: 'TorstenBergmann 2/20/2014 15:53'!
Inspector for a repository!
!MCRepositoryInspector methodsFor: 'morphic ui' stamp: 'avi 2/28/2004 20:07'!
versionSelection
	^ versions indexOf: selectedVersion! !

!MCRepositoryInspector methodsFor: 'morphic ui' stamp: 'stephaneducasse 2/4/2006 20:47'!
packageSelection: aNumber
	selectedPackage := aNumber isZero ifFalse: [ packages at: aNumber ].
	versions := repository versionsAvailableForPackage: selectedPackage.
	self changed: #packageSelection; changed: #versionList! !

!MCRepositoryInspector methodsFor: 'accessing' stamp: 'ClementBera 7/26/2013 16:50'!
setRepository: aRepository workingCopy: aWorkingCopy
	repository := aRepository.
	aWorkingCopy ifNotNil: [ selectedPackage := aWorkingCopy package].
	self refresh! !

!MCRepositoryInspector methodsFor: 'morphic ui' stamp: 'MarcusDenker 7/9/2014 17:21'!
versionSelection: aNumber
	selectedVersion := aNumber isZero
		ifTrue: [ nil ]
		ifFalse: [ versions at: aNumber ].
	self
		changed: #versionSelection;
		changed: #summary! !

!MCRepositoryInspector methodsFor: 'morphic ui' stamp: 'stephaneducasse 2/4/2006 20:47'!
sortedVersions
	| sorter |
	sorter := MCVersionSorter new.
	sorter addAllVersionInfos: versions.
	^ sorter sortedVersionInfos select: [:ea | versions includes: ea]! !

!MCRepositoryInspector methodsFor: 'morphic ui' stamp: 'avi 2/28/2004 20:07'!
packageSelection
	^ packages indexOf: selectedPackage! !

!MCRepositoryInspector methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
version
	^ version ifNil: [version := repository versionWithInfo: selectedVersion]! !

!MCRepositoryInspector methodsFor: 'morphic ui' stamp: 'avi 2/28/2004 18:51'!
packageListMenu: aMenu
	^aMenu! !

!MCRepositoryInspector methodsFor: 'morphic ui' stamp: 'avi 2/28/2004 18:51'!
defaultExtent
	^450@300! !

!MCRepositoryInspector methodsFor: 'testing' stamp: 'avi 2/28/2004 20:20'!
hasVersion
	^ selectedVersion notNil! !

!MCRepositoryInspector methodsFor: 'accessing' stamp: 'avi 2/28/2004 20:20'!
summary
	^ selectedVersion
		ifNotNil: [selectedVersion summary]
		ifNil: ['']! !

!MCRepositoryInspector methodsFor: 'actions' stamp: 'stephaneducasse 2/4/2006 20:47'!
refresh
	packages := repository packages.
	self changed: #packageList.
	self packageSelection: self packageSelection.
! !

!MCRepositoryInspector methodsFor: 'morphic ui' stamp: 'avi 2/28/2004 18:51'!
buttonSpecs
	^#(('Refresh' refresh 'refresh the version-list')) , super buttonSpecs! !

!MCRepositoryInspector methodsFor: 'morphic ui' stamp: 'avi 2/28/2004 18:51'!
defaultLabel
	^'Repository: ' , repository description! !

!MCRepositoryInspector methodsFor: 'actions' stamp: 'MarcusDenker 7/9/2014 15:59'!
load
	self hasVersion
		ifFalse: [ ^ self ].
	super load.
	self version workingCopy repositoryGroup addRepository: repository! !

!MCRepositoryInspector methodsFor: 'morphic ui' stamp: 'avi 2/28/2004 18:57'!
versionListMenu: aMenu
	^aMenu! !

!MCRepositoryInspector methodsFor: 'morphic ui' stamp: 'avi 2/28/2004 18:51'!
widgetSpecs
	^#(	((buttonRow) (0 0 1 0) (0 0 0 30))
		((listMorph: package) (0 0 0.5 0.6) (0 30 0 0))
		((listMorph: version) (0.5 0 1 0.6) (0 30 0 0))
		((textMorph: summary) (0 0.6 1 1) (0 0 0 0)) )! !

!MCRepositoryInspector methodsFor: 'morphic ui' stamp: 'avi 2/29/2004 11:32'!
versionList
	^ self sortedVersions collect: [:ea | ea name]! !

!MCRepositoryInspector methodsFor: 'morphic ui' stamp: 'avi 2/28/2004 20:09'!
packageList
	^ packages collect: [:ea | ea name]! !

!MCRepositoryInspector class methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 4/24/2012 14:51'!
repository: aFileBasedRepository workingCopy: aWorkingCopy
	^self new
		setRepository: aFileBasedRepository workingCopy: aWorkingCopy;
		yourself! !

!MCRepositoryTest methodsFor: 'actions' stamp: 'stephaneducasse 2/4/2006 20:47'!
saveSnapshot: aSnapshot named: aString
	| version |
	version := self versionWithSnapshot: aSnapshot name: aString.
	repository storeVersion: version.
	^ version info
	! !

!MCRepositoryTest methodsFor: 'asserting' stamp: 'ab 8/16/2003 18:07'!
assertVersionInfos: aCollection
	self assert: repository allVersionInfos asSet = aCollection asSet! !

!MCRepositoryTest methodsFor: 'tests' stamp: 'avi 2/17/2004 03:24'!
testIncludesName
	self deny: (repository includesVersionNamed: 'MonticelloTest-xxx.1-rev1').
	self saveSnapshot1.
	self assert: (repository includesVersionNamed: 'MonticelloTest-xxx.1-rev1').
	self deny: (repository includesVersionNamed: 'MonticelloTest-xxx.1-rev2').
	self saveSnapshot2.
	self assert:  (repository includesVersionNamed: 'MonticelloTest-xxx.1-rev2').! !

!MCRepositoryTest methodsFor: 'actions' stamp: 'ab 7/19/2003 16:20'!
saveSnapshot2
	^ self saveSnapshot: self snapshot2 named: 'rev2'! !

!MCRepositoryTest methodsFor: 'actions' stamp: 'ab 8/16/2003 17:46'!
addVersion: aVersion
	self subclassResponsibility ! !

!MCRepositoryTest methodsFor: 'actions' stamp: 'ab 7/19/2003 16:20'!
saveSnapshot1
	^ self saveSnapshot: self snapshot1 named: 'rev1'! !

!MCRepositoryTest methodsFor: 'building' stamp: 'stephaneducasse 2/4/2006 20:47'!
versionWithSnapshot: aSnapshot name: aString
	| info |
	info := self mockVersionInfo: aString. 
	^ MCVersion 
		package: (MCPackage new name: aString)
		info: info
		snapshot: aSnapshot! !

!MCRepositoryTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:47'!
testAddAndLoad
	| node |
	node := self addVersionWithSnapshot: self snapshot1 name: 'rev1'.
	self assert: (self snapshotAt: node) = self snapshot1.
! !

!MCRepositoryTest methodsFor: 'accessing' stamp: 'ab 7/7/2003 14:32'!
snapshotAt: aVersionInfo
	^ (repository versionWithInfo: aVersionInfo) snapshot! !

!MCRepositoryTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:47'!
testLoadMissingNode
	| node |
	node := MCVersionInfo new.
	self assertMissing: node! !

!MCRepositoryTest methodsFor: 'building' stamp: 'ab 7/10/2003 01:03'!
snapshot1
	^ (MCSnapshot fromDefinitions: (Array with: (MCOrganizationDefinition categories: #('y'))))! !

!MCRepositoryTest methodsFor: 'asserting' stamp: 'ab 7/19/2003 23:59'!
assertMissing: aVersionInfo
	self assert: (repository versionWithInfo: aVersionInfo) isNil! !

!MCRepositoryTest methodsFor: 'building' stamp: 'ab 7/10/2003 01:03'!
snapshot2
	^ (MCSnapshot fromDefinitions: (Array with: (MCOrganizationDefinition categories: #('x'))))! !

!MCRepositoryTest methodsFor: 'actions' stamp: 'stephaneducasse 2/4/2006 20:47'!
addVersionWithSnapshot: aSnapshot name: aString
	| version |
	version := self versionWithSnapshot: aSnapshot name: aString.
	self addVersion: version.
	^ version info! !

!MCRepositoryTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:47'!
testStoreAndLoad
	| node node2 |
	node := self saveSnapshot1.
	node2 := self saveSnapshot2.
	self assert: (self snapshotAt: node) = self snapshot1.
	self assert: (self snapshotAt: node2) = self snapshot2.! !

!MCRepositoryTest class methodsFor: 'testing' stamp: 'ab 7/6/2003 12:45'!
isAbstract
	^ self = MCRepositoryTest! !

!MCSaveVersionDialog commentStamp: 'ab 9/8/2009 08:24'!
Monticello's dialog that allows the user to change the version name and to enter a message for the commit log.!
!MCSaveVersionDialog methodsFor: 'accessing' stamp: 'ab 8/24/2003 20:37'!
versionName
	^ name! !

!MCSaveVersionDialog methodsFor: 'morphic ui' stamp: 'ab 8/24/2003 20:41'!
cancel
	self answer: nil! !

!MCSaveVersionDialog methodsFor: 'morphic ui' stamp: 'ab 8/24/2003 20:07'!
defaultExtent 
	^ 400@300! !

!MCSaveVersionDialog methodsFor: 'log message history' stamp: 'BenjaminVanRyseghem 11/27/2013 12:53'!
maxLogMessageHistory

	^ self maxLogMessageHistory! !

!MCSaveVersionDialog methodsFor: 'log message history' stamp: 'BenjaminVanRyseghem 11/24/2013 14:39'!
previousMessages

	^ self class previousMessages! !

!MCSaveVersionDialog methodsFor: 'morphic ui' stamp: 'CamilloBruni 11/2/2012 16:00'!
accept
	| version aMessage |
	version := (self findTextMorph: #versionName) text asString.
	aMessage := (self findTextMorph: #logMessage) text asString.
	self addAsLastLogMessage: aMessage.
	self answer: {version. aMessage}! !

!MCSaveVersionDialog methodsFor: 'morphic ui' stamp: 'ab 9/8/2009 08:45'!
buttonSpecs
	^ #((Accept accept 'accept version name and log message')
		(Cancel cancel 'cancel saving version')
		('Old log messages...' oldLogMessages 're-use a previous log message')
		) ! !

!MCSaveVersionDialog methodsFor: 'log message history' stamp: 'BenjaminVanRyseghem 11/27/2013 12:54'!
addAsLastLogMessage: aString

	self class addAsLastLogMessage: aString! !

!MCSaveVersionDialog methodsFor: 'morphic ui' stamp: 'ab 9/8/2009 08:48'!
oldLogMessages
	| list index |
	list := self previousMessages collect: [:s | s truncateWithElipsisTo: 30].
	list ifEmpty: [UIManager default inform: 'No previous log message was entered'. ^ self].
	index := UIManager default chooseFrom: list.
	
	"no comment was selected"
	index isZero ifTrue: [ ^ self ].
	
	self logMessage: (self previousMessages at: index)! !

!MCSaveVersionDialog methodsFor: 'morphic ui' stamp: 'ab 9/8/2009 08:58'!
defaultLabel
	^ 'Edit Version Name and Log Message:'! !

!MCSaveVersionDialog methodsFor: 'accessing' stamp: 'ab 8/24/2003 20:41'!
logMessage
	^ message ifNil: ['empty log message']! !

!MCSaveVersionDialog methodsFor: 'morphic ui' stamp: 'MarcusDenker 9/10/2014 17:16'!
setDefaultFocus
	(self findTextMorph: #logMessage)
		takeKeyboardFocus;
		selectAll;
		acceptAction: [ :contents | self accept ]! !

!MCSaveVersionDialog methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
versionName: aString
	name := aString.
	self changed: #versionName! !

!MCSaveVersionDialog methodsFor: 'morphic ui' stamp: 'jrp 7/2/2005 10:33'!
widgetSpecs
	^ #(	
		((textMorph: versionName) (0 0 1 0) (0 0 0 30))
		((textMorph: logMessage) (0 0 1 1) (0 30 0 -30))
		((buttonRow) (0 1 1 1) (0 -40 0 0))
		)! !

!MCSaveVersionDialog methodsFor: 'accessing' stamp: 'AlexandreBergel 8/1/2008 12:18'!
logMessage: aString
	message := aString.
	self changed: #logMessage! !

!MCSaveVersionDialog class methodsFor: 'history' stamp: 'BenjaminVanRyseghem 11/24/2013 14:40'!
previousMessages

	^ PreviousMessages ifNil: [ PreviousMessages := OrderedCollection new]! !

!MCSaveVersionDialog class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
taskbarIcon
	"Answer the icon for the receiver in a task bar."

	^ Smalltalk ui icons smallSaveAsIcon! !

!MCSaveVersionDialog class methodsFor: 'history' stamp: 'BenjaminVanRyseghem 11/27/2013 12:54'!
addAsLastLogMessage: aString

	((self previousMessages size > 0) and: [self previousMessages first = aString])
		ifTrue: [ ^ self ].
		
	self previousMessages addFirst: aString.
	(self previousMessages size > self maxLogMessageHistory)
		ifTrue: [self previousMessages removeLast]! !

!MCSaveVersionDialog class methodsFor: 'history' stamp: 'BenjaminVanRyseghem 11/27/2013 12:53'!
maxLogMessageHistory

	^ 15! !

!MCScanner commentStamp: 'LaurentLaffont 3/31/2011 21:08'!
I scan / tokenize metadata  (package name, version info, ancestry, dependencies, ...) found in .mcz files.

For example, try:

MCScanner scan:  '(name ''MyPackage-ll.6'' message ''Fix bug xxx'' id ''b21dbd73-f1c3-2746-a3cc-92f1d4edea28'')' readStream!
!MCScanner methodsFor: 'actions' stamp: 'CamilloBruni 7/6/2012 15:43'!
nextArray
	stream next. "("
	^ Array streamContents: [:s |
		[	stream skipSeparators.
			(stream peek = $)) or: [stream atEnd]
		] whileFalse: [ s nextPut: self next ].
		stream next = $) 
			ifFalse: [ self error: 'Unclosed array' ]]! !

!MCScanner methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
stream: aStream
	stream := aStream! !

!MCScanner methodsFor: 'actions' stamp: 'avi 1/22/2004 20:09'!
nextString
	^ stream nextDelimited: $'! !

!MCScanner methodsFor: 'actions' stamp: 'avi 1/22/2004 20:16'!
nextSymbol
	^ (String streamContents:
		[:s |
		[stream peek isAlphaNumeric] whileTrue: [s nextPut: stream next]]) asSymbol
			! !

!MCScanner methodsFor: 'actions' stamp: 'stephaneducasse 2/4/2006 20:47'!
next
	| c |
	stream skipSeparators.
	c := stream peek.
	c = $# ifTrue: [c := stream next; peek].
	c = $' ifTrue: [^ self nextString].
	c = $( ifTrue: [^ self nextArray].
	c isAlphaNumeric ifTrue: [^ self nextSymbol].
	self error: 'Unknown token type'.	! !

!MCScanner class methodsFor: 'public api' stamp: 'avi 1/22/2004 20:14'!
scan: aStream
	^ (self new stream: aStream) next! !

!MCScanner class methodsFor: 'public api' stamp: 'avi 1/22/2004 20:32'!
scanTokens: aString
	"compatibility"
	^ Array with: (self scan: aString readStream)! !

!MCScannerTest methodsFor: 'tests' stamp: 'avi 1/22/2004 20:26'!
test5
	self assertScans: #((a) b)! !

!MCScannerTest methodsFor: 'asserting' stamp: 'avi 1/22/2004 20:23'!
assertScans: anArray
	self assert: (MCScanner scan: anArray printString readStream) = anArray! !

!MCScannerTest methodsFor: 'tests' stamp: 'avi 1/22/2004 20:28'!
test6
	self should: [MCScanner scan: '(a b' readStream] raise: Error! !

!MCScannerTest methodsFor: 'tests' stamp: 'avi 1/22/2004 20:23'!
test4
	self assertScans: #(a '23' (x () ')''q' y12)).! !

!MCScannerTest methodsFor: 'tests' stamp: 'avi 1/22/2004 20:22'!
test2
	self assertScans: 'it''s alive'! !

!MCScannerTest methodsFor: 'tests' stamp: 'avi 1/22/2004 20:23'!
test3
	self assert: (MCScanner scan: '(a #b c)' readStream) = #(a #b c)! !

!MCScannerTest methodsFor: 'tests' stamp: 'avi 1/22/2004 20:19'!
test1
	self assertScans: #(a '23' (x))! !

!MCScriptDefinition commentStamp: 'TorstenBergmann 2/5/2014 13:46'!
Common superclass for script definitions!
!MCScriptDefinition methodsFor: 'accessing' stamp: 'avi 2/28/2005 17:12'!
description
	^ Array with: packageName with: self scriptSelector! !

!MCScriptDefinition methodsFor: 'accessing' stamp: 'EstebanLorenzano 9/11/2012 17:01'!
packageSet
	^ RPackageSet named: packageName! !

!MCScriptDefinition methodsFor: 'accessing' stamp: 'bf 10/25/2005 19:05'!
sortKey
	^ '!!', self scriptSelector "force to the front so it gets loaded first"! !

!MCScriptDefinition methodsFor: 'installing' stamp: 'EstebanLorenzano 9/12/2012 13:35'!
installScript: aString
	| sel pi |
	sel := (self scriptSelector, ':') asSymbol.
	pi := self packageSet.
	(pi respondsTo: sel)
		ifTrue: [pi perform: sel with: aString]! !

!MCScriptDefinition methodsFor: 'testing' stamp: 'bf 8/12/2009 22:55'!
isScriptDefinition
	^true! !

!MCScriptDefinition methodsFor: 'accessing' stamp: 'avi 2/28/2005 17:12'!
summary
	^ packageName, ' ', self scriptSelector! !

!MCScriptDefinition methodsFor: 'accessing' stamp: 'avi 2/28/2005 17:10'!
scriptSelector
	^ self class scriptSelector! !

!MCScriptDefinition methodsFor: 'accessing' stamp: 'avi 2/28/2005 16:54'!
script
	^ script! !

!MCScriptDefinition methodsFor: 'comparing' stamp: 'avi 2/28/2005 16:55'!
= aDefinition
	^ (super = aDefinition)
		and: [script = aDefinition script]! !

!MCScriptDefinition methodsFor: 'visiting' stamp: 'bf 8/12/2009 21:41'!
accept: aVisitor
	aVisitor visitScriptDefinition: self! !

!MCScriptDefinition methodsFor: 'accessing' stamp: 'bf 8/13/2009 00:09'!
packageName
	^ packageName! !

!MCScriptDefinition methodsFor: 'installing' stamp: 'MarcusDenker 5/2/2013 11:34'!
evaluate
	self class compiler evaluate: script! !

!MCScriptDefinition methodsFor: 'installing' stamp: 'avi 2/28/2005 17:12'!
load
	self installScript! !

!MCScriptDefinition methodsFor: 'installing' stamp: 'avi 2/28/2005 17:11'!
installScript
	self installScript: script! !

!MCScriptDefinition methodsFor: 'installing' stamp: 'avi 2/28/2005 17:12'!
unload
	self installScript: nil! !

!MCScriptDefinition methodsFor: 'accessing' stamp: 'avi 2/28/2005 17:04'!
source
	^ script! !

!MCScriptDefinition methodsFor: 'initializing' stamp: 'stephaneducasse 2/4/2006 20:47'!
initializeWithScript: aString packageName: packageString
	script := aString.
	packageName := packageString! !

!MCScriptDefinition class methodsFor: 'instance-creation' stamp: 'bf 4/4/2005 12:20'!
from: aPackageInfo
	^ self script: (aPackageInfo perform: self scriptSelector) contents asString packageName: aPackageInfo name! !

!MCScriptDefinition class methodsFor: 'accessing' stamp: 'avi 2/28/2005 17:00'!
scriptSelector
	self subclassResponsibility! !

!MCScriptDefinition class methodsFor: 'accessing' stamp: 'bf 8/13/2009 00:25'!
subclassForScriptSelector: selectorString
	^self allSubclasses detect: [:ea | ea scriptSelector = selectorString]! !

!MCScriptDefinition class methodsFor: 'instance-creation' stamp: 'avi 2/28/2005 16:59'!
script: aString packageName: packageString
	^ self instanceLike: (self new initializeWithScript: aString packageName: packageString)! !

!MCScriptDefinition class methodsFor: 'instance-creation' stamp: 'bf 8/13/2009 00:24'!
scriptSelector: selectorString script: aString packageName: packageString
	^ (self subclassForScriptSelector: selectorString)
		script: aString packageName: packageString! !

!MCScriptParser commentStamp: '<historical>'!
A MCScriptParser identifies script and add MCScriptDefinition. !
!MCScriptParser methodsFor: 'actions' stamp: 'MarcusDenker 5/18/2013 15:44'!
addDefinitionsTo: aCollection
	| tokens definition |
	tokens := source parseLiterals.
	definition := MCScriptDefinition
		scriptSelector: tokens second allButLast
		script: tokens third
		packageName: tokens first third.
	aCollection add: definition.! !

!MCScriptParser class methodsFor: 'factory identification hook' stamp: 'bf 8/13/2009 00:07'!
pattern
	^'(PackageInfo named: *'! !

!MCSerializationTest methodsFor: 'testing' stamp: 'avi 1/19/2004 15:14'!
testMczSerialization
	self assertVersionsMatchWith: MCMczWriter.
	self assertExtensionProvidedBy: MCMczWriter.
	self assertVersionInfosMatchWith: MCMczWriter.
	self assertDependenciesMatchWith: MCMczWriter.! !

!MCSerializationTest methodsFor: 'asserting' stamp: 'stephaneducasse 2/4/2006 20:47'!
assertVersionsMatchWith: writerClass
	| stream readerClass expected actual |
	readerClass := writerClass readerClass.
	expected := self mockVersion.
	stream := RWBinaryOrTextStream on: String new.
	writerClass fileOut: expected on: stream.
	actual := readerClass versionFromStream: stream reset.
	self assertVersion: actual matches: expected.! !

!MCSerializationTest methodsFor: 'mocks' stamp: 'stephaneducasse 2/4/2006 20:47'!
mockDiffyVersion
	| repos workingCopy base next |
	repos := MCDictionaryRepository new.
	workingCopy := MCWorkingCopy forPackage: self mockPackage.
	workingCopy repositoryGroup addRepository: repos.
	MCRepositoryGroup default removeRepository: repos.
	base := self mockVersion.
	repos storeVersion: base.
	self change: #a toReturn: 'a2'.
	next := self mockVersionWithAncestor: base.
	^ next asDiffAgainst: base	! !

!MCSerializationTest methodsFor: 'asserting' stamp: 'CamilloBruni 8/31/2013 20:23'!
assertExtensionProvidedBy: aClass
	aClass readerClass extension! !

!MCSerializationTest methodsFor: 'asserting' stamp: 'stephaneducasse 2/4/2006 20:47'!
assertSnapshotsMatchWith: writerClass
	| readerClass expected stream actual |
	readerClass := writerClass readerClass.
	expected := self mockSnapshot.
	stream := RWBinaryOrTextStream on: String new.
	(writerClass on: stream) writeSnapshot: expected.
	actual := readerClass snapshotFromStream: stream reset.
	self assertSnapshot: actual matches: expected.! !

!MCSerializationTest methodsFor: 'asserting' stamp: 'stephaneducasse 2/4/2006 20:47'!
assertVersionInfosMatchWith: writerClass
	| stream readerClass expected actual |
	readerClass := writerClass readerClass.
	expected := self mockVersion.
	stream := RWBinaryOrTextStream on: String new.
	writerClass fileOut: expected on: stream.
	actual := readerClass versionInfoFromStream: stream reset.
	self assert: actual = expected info.! !

!MCSerializationTest methodsFor: 'testing' stamp: 'stephaneducasse 2/4/2006 20:47'!
testMcdSerialization
	| stream expected actual |
	expected := self mockDiffyVersion.
	stream := RWBinaryOrTextStream on: String new.
	MCMcdWriter fileOut: expected on: stream.
	actual := MCMcdReader versionFromStream: stream reset.
	self assertVersion: actual matches: expected.! !

!MCSerializationTest methodsFor: 'testing' stamp: 'cwp 8/3/2003 18:43'!
testStSerialization
	self assertSnapshotsMatchWith: MCStWriter.! !

!MCSerializationTest methodsFor: 'asserting' stamp: 'IgorStasenko 4/15/2011 17:17'!
assertClass: readerClass providesServices: labels
	| services suffix |
	suffix := readerClass extension.
	self assert: (Smalltalk tools fileList isReaderNamedRegistered: readerClass name).
	services := readerClass fileReaderServicesForFile: 'foo' suffix: suffix.
	self assert: ((services collect: [:service | service buttonLabel]) includesAllOf: labels)! !

!MCSerializationTest methodsFor: 'asserting' stamp: 'stephaneducasse 2/4/2006 20:47'!
assertDependenciesMatchWith: writerClass
	| stream readerClass expected actual |
	readerClass := writerClass readerClass.
	expected := self mockVersionWithDependencies.
	stream := RWBinaryOrTextStream on: String new.
	writerClass fileOut: expected on: stream.
	actual := (readerClass on: stream reset) dependencies.
	self assert: actual = expected dependencies.! !

!MCServerCredentials commentStamp: '<historical>'!
I store a username and password.
!
!MCServerCredentials methodsFor: 'accessing' stamp: 'SeanDeNigris 8/26/2012 18:33'!
password

	^ password.! !

!MCServerCredentials methodsFor: 'private' stamp: 'SeanDeNigris 8/26/2012 18:25'!
password: aString 

	password := aString.! !

!MCServerCredentials methodsFor: 'private' stamp: 'SeanDeNigris 8/26/2012 18:25'!
username: aString 

	username := aString.! !

!MCServerCredentials methodsFor: 'accessing' stamp: 'SeanDeNigris 8/26/2012 18:33'!
username

	^ username.! !

!MCServerCredentials class methodsFor: 'instance creation' stamp: 'CamilloBruni 4/11/2013 17:33'!
user: nameString password: passwordString

	^ self new
			username: nameString;
			password: passwordString;
			yourself.! !

!MCServerRegistry commentStamp: 'TorstenBergmann 2/5/2014 13:56'!
Registry for metacello servers!
!MCServerRegistry methodsFor: 'initialization' stamp: 'SeanDeNigris 8/26/2012 18:18'!
initialize

	super initialize.
	registry := Dictionary new.! !

!MCServerRegistry methodsFor: 'private' stamp: 'CamilloBruni 2/19/2013 18:30'!
repositoryAt: urlString credentialsDo: aBlock


	| possibleMatches bestMatch |
	possibleMatches := registry associations select: [ :e | urlString beginsWith: e key ].
	possibleMatches isEmpty ifTrue: [ ^ aBlock value: '' value: '' ].
	bestMatch := possibleMatches inject: possibleMatches anyOne into: [ :last :new | 
		((new key asUrl path size > last key asUrl path size) 
		"this is ugly, but URL always returns a path element, even an empty one..."
		or: [ last key asUrl path size = 1 and: [ last key asUrl path last isEmpty ]]) 
			ifTrue: [ new ]
			ifFalse: [ last ]].
	^ aBlock value: bestMatch value username value: bestMatch value password.! !

!MCServerRegistry methodsFor: 'public' stamp: 'CamilloBruni 4/11/2013 17:33'!
on: repositoryUrl beUser: nameString withPassword: passwordString

	| credentials |
	credentials := MCServerCredentials user: nameString password: passwordString.
	registry at: repositoryUrl put: credentials.! !

!MCServerRegistry methodsFor: '*Tests-Monticello' stamp: 'SeanDeNigris 8/27/2012 10:02'!
removeCredentialsFor: aString 

	registry removeKey: aString.! !

!MCServerRegistry class methodsFor: 'instance creation' stamp: 'SeanDeNigris 8/26/2012 11:11'!
uniqueInstance

	^ uniqueInstance ifNil: [ uniqueInstance := self new ].! !

!MCSliceInfo commentStamp: 'TorstenBergmann 2/20/2014 15:52'!
A slice info!
!MCSliceInfo methodsFor: 'accessing' stamp: 'AlainPlantec 10/25/2010 09:17'!
issueSummary: aString

	issueSummary := aString.
	issueSummary := self usableIssueSummary.
	self changed: #issueSummary.
	self changed: #okUnabled.
! !

!MCSliceInfo methodsFor: '*Komitter-Models' stamp: 'EstebanLorenzano 7/21/2014 13:34'!
makeKomitSlice
	| name issue workingCopy |
	issue := self usableIssueNumber.
	issue isEmptyOrNil ifTrue: [ ^ nil ].
	name := self usableIssueSummary.
	name isEmptyOrNil ifTrue: [ ^ nil ].
	name := 'SLICE-Issue-' , issue asString , '-' , name.
	RPackageOrganizer default registerPackageNamed: name.
	workingCopy := MCWorkingCopy forPackage: (MCPackage new name: name).
	self includedPackages
		do: [:required | workingCopy requirePackage: required ].
	^ workingCopy! !

!MCSliceInfo methodsFor: 'accessing' stamp: 'AlainPlantec 10/25/2010 02:47'!
issueNumber

	^ issueNumber  ifNil: ['']! !

!MCSliceInfo methodsFor: 'accessing' stamp: 'AlainPlantec 10/25/2010 02:49'!
usableIssueNumber
	| s allowed |
	s := ''.
	allowed := ($0 to: $9).
	self issueNumber
		do: [:c | (allowed includes: c) ifTrue: [s := s , c asString]].
	^ s! !

!MCSliceInfo methodsFor: 'accessing' stamp: 'AlainPlantec 10/25/2010 00:27'!
includedPackages

	^ includedPackages ifNil: [#()]! !

!MCSliceInfo methodsFor: 'accessing' stamp: 'DamienCassou 4/12/2011 11:27'!
includedPackages: aCollection

	includedPackages := aCollection.
	self changed: #okUnabled.! !

!MCSliceInfo methodsFor: 'accessing' stamp: 'AlainPlantec 10/25/2010 02:41'!
issueSummary

	^ issueSummary ifNil: ['']! !

!MCSliceInfo methodsFor: 'accessing' stamp: 'AlainPlantec 10/25/2010 09:17'!
issueNumber: aString

	issueNumber := aString.
	issueNumber := self usableIssueNumber.
	self changed: #issueNumber.
	self changed: #okUnabled! !

!MCSliceInfo methodsFor: 'accessing' stamp: 'AlainPlantec 10/25/2010 09:27'!
usableIssueSummary
	| s allowed |
	s := ''.
	allowed := ($A to: $Z)
				, ($a to: $z)
				, ($0 to: $9)
				, (Array with: $-).
	self issueSummary
		do: [:c | ({Character space. Character tab. $_} includes: c)
				ifTrue: [s := s , '-']
				ifFalse: [(allowed includes: c)
						ifTrue: [s := s , c asString]]].
	^ s! !

!MCSliceInfo methodsFor: 'slice-making' stamp: 'EstebanLorenzano 7/21/2014 13:35'!
makeSlice
	| name issue workingCopy |
	issue := self usableIssueNumber.
	issue isEmptyOrNil ifTrue: [ ^ nil ].
	name := self usableIssueSummary.
	name isEmptyOrNil ifTrue: [ ^ nil ].
	name := 'SLICE-Issue-' , issue asString , '-' , name.
	RPackageOrganizer default registerPackageNamed: name.
	workingCopy := MCWorkingCopy forPackage: (MCPackage new name: name).
	self includedPackages
		do: [:required | workingCopy requirePackage: required package].
	^ workingCopy! !

!MCSliceMaker commentStamp: 'AlainPlantec 9/27/2011 11:43'!
MCSliceMaker is a dialog to help you making slices.
It allows you to enter the slice number, the summary and to directly select dependent dirty packages.
Then a slice package is added for you in the working copy browser from which it is opened.
Just copy-paste issue number and summary. All is formated for you.

Instance Variables
	info:		<MCSliceInfo>
	okToDoSlice:		<Boolean>
	window:		<StandardWindow>

info
	- It is the model for the user interface

okToDoSlice
	- true if the OK button is clicked, it is to avoid slice making in case of cancel and in the case where the close button of the window has been clicked

window
	- my window
!
!MCSliceMaker methodsFor: 'user interface' stamp: 'AlainPlantec 10/25/2010 02:16'!
ok
	self okToDoSlice: true.
	window delete! !

!MCSliceMaker methodsFor: 'user interface' stamp: 'IgorStasenko 1/16/2014 13:12'!
window
	| sliceInfoRow buttonsRow okBtn cancelBtn issueNumberEntry issueSummaryEntry tree treeMorph issueSummaryDownloader |
	window := StandardWindow new model: self. 
	window title: ' Slice Maker' translated.
	issueNumberEntry := self issueNumberEntryOn: window.
	issueSummaryDownloader := self issueSummaryDownloaderButtonOn: window.
	issueSummaryEntry := self issueSummaryOn: window.
	sliceInfoRow := PanelMorph new changeTableLayout; cellInset: 10 @ 4; layoutInset: 4 @ 4; listDirection: #leftToRight; hResizing: #shrinkWrap; vResizing: #shrinkWrap.
	sliceInfoRow addAllMorphs: {issueNumberEntry. window newLabel: '-'. issueSummaryDownloader. issueSummaryEntry}.
	buttonsRow := PanelMorph new changeTableLayout; cellInset: 10 @ 4; layoutInset: 4 @ 4; listDirection: #rightToLeft; hResizing: #shrinkWrap; vResizing: #shrinkWrap.
	okBtn := window newOKButtonFor: self  getEnabled: #okUnabled.
	cancelBtn := window newCancelButtonFor: self.
	okBtn isDefault: true.
	self info addDependent: okBtn.
	buttonsRow addAllMorphs: {cancelBtn. okBtn}.
	window
		addMorph: sliceInfoRow
		fullFrame: ( (0 @ 0 corner: 1 @ 0) asLayoutFrame bottomOffset: sliceInfoRow height).
	tree := MorphTreeModel new 
		rootItems: self rootItems;
		beCheckList;
		autoMultiSelection: true;
		wrapBlockOrSelector:  #packageNameWithStar;
		headerLabel: 'Dirty Packages to be included in the slice';
		yourself.
	tree onSelectionChangeSend:  #selectionChanged: to: self. 
	treeMorph := tree defaultTreeMorph buildContents; 
		"selectAll; "
		"hResizing: #spaceFill;"
		vResizing: #spaceFill;
		yourself.
	window
		addMorph: treeMorph
		fullFrame: (LayoutFrame identity
					topOffset:  sliceInfoRow height ; 
					bottomOffset: buttonsRow height negated).
	window
		addMorph: buttonsRow
		fullFrame:  ((0 @ 1 corner: 1 @ 1) asLayoutFrame  topOffset: buttonsRow height negated).
	^ window! !

!MCSliceMaker methodsFor: 'actions' stamp: 'DamienCassou 4/27/2012 16:30'!
downloadIssueSummaryFailed
	self info issueSummary: '------'! !

!MCSliceMaker methodsFor: 'selecting' stamp: 'BenjaminVanRyseghem 9/17/2011 19:29'!
update: aSymbol

	aSymbol = #okUnabled ifTrue: [ self changed: #okUnabled ].
	super update: aSymbol! !

!MCSliceMaker methodsFor: 'user interface' stamp: 'DamienCassou 4/27/2012 15:05'!
issueSummaryOn: canvas
	| issueSummaryEntry |
	issueSummaryEntry := canvas window
				newAutoAcceptTextEntryFor: self info
				get: #issueSummary
				set: #issueSummary:
				class: String
				getEnabled: nil
				help: 'An identification label for the slice. Just copy-paste the Google issue Summary here' translated.
	issueSummaryEntry ghostText: 'Just paste the issue summary here'.
	^ issueSummaryEntry! !

!MCSliceMaker methodsFor: 'user interface' stamp: 'AlainPlantec 10/25/2010 01:35'!
cancel
	self noSlice.
	window delete! !

!MCSliceMaker methodsFor: 'user interface' stamp: 'DamienCassou 4/27/2012 15:07'!
issueSummaryDownloaderButtonOn: canvas
	|button|
	button := canvas newButtonFor:  self action: #downloadIssueSummary label: 'grab' help: 'Grab issue summary from tracker'.
	^ button ! !

!MCSliceMaker methodsFor: 'actions' stamp: 'EstebanLorenzano 4/2/2015 11:32'!
downloadIssueSummary
	| title |

	
	title := ZnClient new
		url: 'http://tracker.pharo.org/issues/name/', self issueIdString;
		enforceHttpSuccess:true;
		ifFail:[:ex | ^ self informFailedWith: ex];
		get.

	self info issueSummary: title! !

!MCSliceMaker methodsFor: 'accessing' stamp: 'CamilloBruni 10/17/2012 10:17'!
issueIdString
	^ self issueNumber asString ! !

!MCSliceMaker methodsFor: 'user interface' stamp: 'AlainPlantec 10/11/2011 13:32'!
initialExtent
	^ 800@400! !

!MCSliceMaker methodsFor: 'user interface' stamp: 'AlainPlantec 10/25/2010 01:35'!
noSlice
	info := nil.
! !

!MCSliceMaker methodsFor: 'initialization' stamp: 'AlainPlantec 10/11/2011 11:56'!
initialize
	super initialize.
	info := MCSliceInfo new.
	info addDependent: self.
	
! !

!MCSliceMaker methodsFor: 'accessing' stamp: 'AlainPlantec 10/25/2010 02:16'!
okToDoSlice: aBoolean
	okToDoSlice := aBoolean! !

!MCSliceMaker methodsFor: 'accessing' stamp: 'AlainPlantec 10/25/2010 02:16'!
resultInfo
	^ self okToDoSlice 
		ifTrue: [info]! !

!MCSliceMaker methodsFor: 'user interface' stamp: 'AlainPlantec 10/11/2011 11:58'!
openFor: anotherWindow
	window := self window.
	anotherWindow openModal: window.
	^ self resultInfo! !

!MCSliceMaker methodsFor: 'selecting' stamp: 'AlainPlantec 10/11/2011 12:01'!
selectionChanged: aSelectionChangedAnnounce
	| allManagers selectedPackages sel |
	allManagers := MCWorkingCopy allManagers.
	sel := aSelectionChangedAnnounce selection selectedItemOrItemsOrNil.
	selectedPackages := sel
				ifNil: [#()]
				ifNotNil: [sel
						collect: [:n | allManagers 
								detect: [:m | m = n]]].
	self info
		includedPackages: selectedPackages.
	self changed: #okUnabled! !

!MCSliceMaker methodsFor: 'user interface' stamp: 'DamienCassou 4/27/2012 14:55'!
issueNumberEntryOn: canvas
	| issueNumberEntry |
	issueNumberEntry := canvas
				newAutoAcceptTextEntryFor: self info
				get: #issueNumber
				set: #issueNumber:
				class: String
				getEnabled: nil
				help: 'Google project issue number' translated.
	issueNumberEntry hResizing: #rigid.
	issueNumberEntry
		width: (StandardFonts defaultFont widthOfString: 'Issue number0').
	issueNumberEntry ghostText: 'Issue number'.
	^ issueNumberEntry! !

!MCSliceMaker methodsFor: 'accessing' stamp: 'AlainPlantec 10/25/2010 00:26'!
info
	^ info ! !

!MCSliceMaker methodsFor: 'accessing' stamp: 'CamilloBruni 10/17/2012 10:17'!
issueNumber
	"Return the entered issue number. 
	Use #asInteger to trim excess data from the user input, such as whitespaces."
	^ self info issueNumber asInteger! !

!MCSliceMaker methodsFor: 'actions' stamp: 'NicolaiHess 10/3/2014 20:54'!
informFailedWith: anError
	self inform: anError asString.
	self downloadIssueSummaryFailed! !

!MCSliceMaker methodsFor: 'user interface' stamp: 'DamienCassou 4/12/2011 11:27'!
okUnabled
	^ self info usableIssueNumber isEmptyOrNil not
		and: [self info usableIssueSummary isEmptyOrNil not
		and: [self info includedPackages isEmptyOrNil not]]! !

!MCSliceMaker methodsFor: 'accessing' stamp: 'AlainPlantec 10/25/2010 02:15'!
okToDoSlice
	^ okToDoSlice ifNil: [false]! !

!MCSliceMaker methodsFor: 'user interface' stamp: 'IgorStasenko 1/16/2014 13:09'!
rootItems
	^ (MCWorkingCopy allManagers sort: [ :a :b | 
		"sort putting modified packages first in the list"
		
		(a modified = b modified) 
			ifTrue: [ a package name <= b package name  ]
			ifFalse: [ a modified ]
		])! !

!MCSliceMaker class methodsFor: 'opening' stamp: 'AlainPlantec 10/25/2010 02:09'!
openFor: anotherWindow
	^ self new openFor: anotherWindow! !

!MCSmalltalkhubRepository commentStamp: '<historical>'!
I am specialized version of an MCHttpRepository for http://smalltalkhub.com.
I support a faster mcz listing that does not rely on parsing an html size.!
!MCSmalltalkhubRepository methodsFor: 'interface' stamp: 'CamilloBruni 9/14/2012 17:11'!
includesFileNamed: aString
	"avoid the slower default method and simply do a head request "
	self httpClient
		numberOfRetries: 0;
		ifFail: [ :exception| 
			exception response code = 404
				ifTrue: [ ^ false ].
			exception pass];
		head: (self urlForFileNamed: aString).
	^ true! !

!MCSmalltalkhubRepository methodsFor: 'converting' stamp: 'CamilloBruni 9/14/2012 17:20'!
asCreationTemplate
	^self class 
		creationTemplateOwner: self owner project: self project user: user password: password! !

!MCSmalltalkhubRepository methodsFor: 'accessing' stamp: 'CamilloBruni 9/18/2012 18:36'!
project: aString
	
	project := aString! !

!MCSmalltalkhubRepository methodsFor: 'accessing' stamp: 'CamilloBruni 4/6/2013 23:12'!
location: aUrlString
	| pathSegments |
	(self class isResponsibleFor: aUrlString)
		ifFalse: [ Error signal: 'Please provide a smalltalkhub url' ].
	"extract the smalltalkhub properties from the path part in the given URL"
	pathSegments := aUrlString asZnUrl pathSegments reject: [ :each | each = 'mc' ].
	self owner: pathSegments first.
	self project: pathSegments second.! !

!MCSmalltalkhubRepository methodsFor: '*Komitter-Models' stamp: 'BenjaminVanRyseghem 11/23/2013 12:43'!
koRemote

	^ KomitSmalltalkhubRemote new
		remote: self;
		yourself! !

!MCSmalltalkhubRepository methodsFor: 'accessing' stamp: 'CamilloBruni 9/14/2012 17:25'!
location
	^ 'http://smalltalkhub.com/mc/', self owner, '/', self project, '/main/' ! !

!MCSmalltalkhubRepository methodsFor: 'accessing' stamp: 'CamilloBruni 9/14/2012 17:21'!
project
	
	^ project! !

!MCSmalltalkhubRepository methodsFor: 'accessing' stamp: 'CamilloBruni 9/14/2012 17:21'!
owner
	
	^ owner! !

!MCSmalltalkhubRepository methodsFor: 'interface' stamp: 'BernardoContreras 3/8/2015 19:35'!
parseFileNamesFromStream: aNewLineDelimitedString
	^ aNewLineDelimitedString 
		ifNil: [ ^ OrderedCollection new ]
		ifNotNil: [ aNewLineDelimitedString substrings: String crlf ]! !

!MCSmalltalkhubRepository methodsFor: 'interface' stamp: 'CamilloBruni 6/15/2013 10:14'!
loadAllFileNames
	| client |
	client := self httpClient.
	client
		ifFail: [ :exception | self error: 'Could not access ', self location, ': ', exception printString ];
		url: self locationWithTrailingSlash;
		queryAt: 'format' put: 'raw';
		get.
	self assertNonBinaryResponse: client response.
	^ self parseFileNamesFromStream: client contents! !

!MCSmalltalkhubRepository methodsFor: 'accessing' stamp: 'CamilloBruni 9/14/2012 17:24'!
locationWithTrailingSlash
	^ self location! !

!MCSmalltalkhubRepository methodsFor: 'interface' stamp: 'CamilloBruni 9/14/2012 16:37'!
includesVersionNamed: aString
	"directly do a filename check since squeaksource only stores mcz"
	^ self includesFileNamed: aString, '.mcz'! !

!MCSmalltalkhubRepository methodsFor: 'accessing' stamp: 'CamilloBruni 9/18/2012 18:36'!
owner: aString
	
	owner := aString! !

!MCSmalltalkhubRepository class methodsFor: 'instance creation' stamp: 'CamilloBruni 10/9/2012 14:54'!
owner: owner project: project 
	^ self
		owner: owner
		project: project
		user: String empty
		password: String empty! !

!MCSmalltalkhubRepository class methodsFor: 'accessing' stamp: 'CamilloBruni 9/14/2012 16:38'!
description
	^ 'smalltalkhub.com'! !

!MCSmalltalkhubRepository class methodsFor: 'creation template' stamp: 'CamilloBruni 9/14/2012 17:23'!
creationTemplateOwner: owner project: project user: user password: password
	^ String streamContents: [ :s|
		s 
			nextPutAll: self name; cr;
			tab; nextPutAll: 'owner: '; print: owner; cr;
			tab; nextPutAll: 'project: '; print: project; cr;
			tab; nextPutAll: 'user: '; print: user; cr;
			tab; nextPutAll: 'password: '; print: password ].! !

!MCSmalltalkhubRepository class methodsFor: 'creation template' stamp: 'CamilloBruni 9/14/2012 17:15'!
creationTemplate
	^self creationTemplateOwner: ''
		project: ''
		user: ''
		password: ''
! !

!MCSmalltalkhubRepository class methodsFor: 'instance creation' stamp: 'CamilloBruni 9/14/2012 17:22'!
owner: owner project: project user: user password: password
	^ self new
		owner: owner;
		project: project;
		user: user;
		password: password;
		yourself! !

!MCSmalltalkhubRepository class methodsFor: 'accessing' stamp: 'CamilloBruni 5/7/2013 14:31'!
baseURL
	^ self smalltalkhubUrl, 'mc/'! !

!MCSmalltalkhubRepository class methodsFor: 'testing' stamp: 'CamilloBruni 5/7/2013 14:31'!
isResponsibleFor: aUrl
	^ aUrl includesSubstring: self hostName! !

!MCSmalltalkhubRepository class methodsFor: 'accessing' stamp: 'CamilloBruni 5/7/2013 14:30'!
smalltalkhubUrl
	^ 'http://', self hostName, '/'! !

!MCSmalltalkhubRepository class methodsFor: 'accessing' stamp: 'CamilloBruni 5/7/2013 14:31'!
hostName
	^ 'smalltalkhub.com'! !

!MCSnapshot commentStamp: '<historical>'!
MCSnapshot represents a list of entities compared to a given base entities. 

It holds a list of definitions (instances of MCDefinition subclasses). It can install these entities or update a package.!
!MCSnapshot methodsFor: 'accessing' stamp: 'ab 12/4/2002 18:09'!
definitions
	^ definitions! !

!MCSnapshot methodsFor: 'comparing' stamp: 'ab 7/10/2003 01:05'!
hash
	^ definitions asArray hash! !

!MCSnapshot methodsFor: 'comparing' stamp: 'MarianoMartinezPeck 5/30/2012 17:12'!
= other
	self == other
		ifTrue: [ ^ true ].
	self species = other species
		ifFalse: [ ^ false ].
	^ definitions asArray = other definitions asArray! !

!MCSnapshot methodsFor: 'loading' stamp: 'ab 7/6/2003 23:31'!
install
	MCPackageLoader installSnapshot: self! !

!MCSnapshot methodsFor: 'patching' stamp: 'ab 7/7/2003 00:37'!
patchRelativeToBase: aSnapshot
	^ MCPatch fromBase: aSnapshot target: self! !

!MCSnapshot methodsFor: 'loading' stamp: 'ab 7/7/2003 12:11'!
updatePackage: aPackage
	MCPackageLoader updatePackage: aPackage withSnapshot: self! !

!MCSnapshot methodsFor: 'initializing' stamp: 'stephaneducasse 2/4/2006 20:47'!
initializeWithDefinitions: aCollection
	definitions := aCollection.! !

!MCSnapshot class methodsFor: 'instance-creation' stamp: 'ab 7/6/2003 23:48'!
fromDefinitions: aCollection
	^ self new initializeWithDefinitions: aCollection! !

!MCSnapshot class methodsFor: 'instance-creation' stamp: 'ab 7/6/2003 23:48'!
empty
	^ self fromDefinitions: #()! !

!MCSnapshotBrowser commentStamp: 'TorstenBergmann 2/20/2014 15:52'!
Browser for snapshots!
!MCSnapshotBrowser methodsFor: 'menus' stamp: 'nk 4/17/2004 09:53'!
loadCategorySelection
	"Load the entire selected category"
	categorySelection ifNil: [ ^self ].
	self methodsForSelectedClassCategory do: [ :m | m load ].! !

!MCSnapshotBrowser methodsFor: 'selecting' stamp: 'cwp 7/10/2003 18:28'!
classSelection
	^ classSelection ifNil: [0] ifNotNil: [self visibleClasses indexOf: classSelection]! !

!MCSnapshotBrowser methodsFor: 'accessing' stamp: 'ab 7/18/2003 15:48'!
packageClasses
	^ items select: [:ea | ea isClassDefinition]! !

!MCSnapshotBrowser methodsFor: 'selecting' stamp: 'cwp 7/10/2003 20:26'!
methodSelection
	^ methodSelection
			ifNil: [0] 
			ifNotNil: [self visibleMethods indexOf: methodSelection]! !

!MCSnapshotBrowser methodsFor: 'menus' stamp: 'StephaneDucasse 10/27/2014 09:34'!
methodListMenu: aMenu 
	super methodListMenu: aMenu.
	( self selectedMessageName notNil and: [ methodSelection isLoadable ] )
		ifTrue: [ aMenu addLine; add: 'Load method' selector: #loadMethodSelection ].
	^ aMenu! !

!MCSnapshotBrowser methodsFor: 'accessing' stamp: 'StephaneDucasse 4/27/2010 11:50'!
methodsForSelectedClass
	^ items select: [:ea | (ea className = classSelection) 
							and: [ea isMethodDefinition
									and: [ea classIsMeta = self switchIsClass]]].! !

!MCSnapshotBrowser methodsFor: 'switch' stamp: 'cwp 7/12/2003 18:05'!
switchIsClass
	^ switch = #class! !

!MCSnapshotBrowser methodsFor: 'accessing' stamp: 'nk 11/10/2003 21:29'!
selectedMessageCategoryName
	^protocolSelection! !

!MCSnapshotBrowser methodsFor: 'morphic ui' stamp: 'bf 5/27/2005 19:33'!
buttonSpecs
	^ #(('instance' switchBeInstance 'show instance' buttonEnabled switchIsInstance)
		('?' switchBeComment 'show comment' buttonEnabled switchIsComment)
		('class' switchBeClass 'show class' buttonEnabled switchIsClass))! !

!MCSnapshotBrowser methodsFor: 'accessing' stamp: 'lr 3/14/2010 21:13'!
selectedClassOrMetaClass
	| class |
	classSelection ifNil: [ ^ nil ].
	class := Smalltalk globals at: classSelection ifAbsent: [ ^ nil ].
	^ self switchIsClass
		ifTrue: [ class class ]
		ifFalse: [ class ]! !

!MCSnapshotBrowser methodsFor: 'switch' stamp: 'cwp 7/12/2003 18:04'!
switchIsComment
	^ switch = #comment.! !

!MCSnapshotBrowser methodsFor: 'selecting' stamp: 'cwp 7/10/2003 19:35'!
protocolSelection
	^ protocolSelection 
		ifNil: [0]
		ifNotNil: [self visibleProtocols indexOf: protocolSelection]! !

!MCSnapshotBrowser methodsFor: 'listing' stamp: 'cwp 7/10/2003 18:33'!
categoryList
	^ self visibleCategories! !

!MCSnapshotBrowser methodsFor: 'menus' stamp: 'nk 4/17/2004 09:45'!
loadMethodSelection
	methodSelection ifNil: [ ^self ].
	methodSelection load.! !

!MCSnapshotBrowser methodsFor: 'listing' stamp: 'cwp 7/10/2003 20:20'!
classList
	^ self visibleClasses! !

!MCSnapshotBrowser methodsFor: 'listing' stamp: 'CamilloBruni 7/16/2013 06:55'!
visibleProtocols
	| methods protocols |
	self switchIsComment ifTrue: [^ Array new].
	methods := self methodsForSelectedClass.
	protocols := (methods collect: [:ea | ea category]) asSet asSortedCollection.
	protocols add: AllProtocol defaultName.
	^ protocols ! !

!MCSnapshotBrowser methodsFor: 'accessing' stamp: 'bf 8/21/2012 21:38'!
hasExtensions
	^self extensionClassNames notEmpty! !

!MCSnapshotBrowser methodsFor: 'accessing' stamp: 'StephaneDucasse 4/27/2010 11:51'!
methodsForSelectedClassCategory
	| visibleClasses |
	visibleClasses := self visibleClasses.
	^ items select: [:ea | (visibleClasses includes: ea className) 
								and: [ea isMethodDefinition
									and: [ea classIsMeta = self switchIsClass]]].! !

!MCSnapshotBrowser methodsFor: 'listing' stamp: 'cwp 7/10/2003 19:07'!
protocolList
	^ self visibleProtocols! !

!MCSnapshotBrowser methodsFor: 'switch' stamp: 'stephaneducasse 2/4/2006 20:47'!
switchBeComment
	switch := #comment.
	self signalSwitchChanged.! !

!MCSnapshotBrowser methodsFor: 'text' stamp: 'cwp 7/11/2003 00:30'!
text: aTextOrString
	self changed: #text! !

!MCSnapshotBrowser methodsFor: 'menus' stamp: 'nk 4/17/2004 09:46'!
loadProtocolSelection
	protocolSelection ifNil: [ ^self ].
	self methodsForSelectedProtocol do: [ :m | m load ].! !

!MCSnapshotBrowser methodsFor: 'accessing' stamp: 'nk 10/11/2003 16:45'!
selectedMessageName
	^methodSelection ifNotNil: [^ methodSelection selector ].
! !

!MCSnapshotBrowser methodsFor: 'selecting' stamp: 'cwp 7/10/2003 18:33'!
categorySelection
	^ categorySelection ifNil: [0] ifNotNil: [self visibleCategories indexOf: categorySelection]! !

!MCSnapshotBrowser methodsFor: 'listing' stamp: 'ab 7/18/2003 15:48'!
visibleClasses
	^ categorySelection = self extensionsCategory
		ifTrue: [self extensionClassNames]
		ifFalse: [self packageClasses
					select: [:ea | ea category = categorySelection]
					thenCollect: [:ea | ea className]].! !

!MCSnapshotBrowser methodsFor: 'menus' stamp: 'StephaneDucasse 10/27/2014 09:34'!
classListMenu: aMenu 
	classSelection ifNil: [ ^aMenu ].
	super classListMenu: aMenu.
	aMenu
		addLine;
		add: ('Load class {1}'  format: {classSelection})
		selector: #loadClassSelection.
	^ aMenu! !

!MCSnapshotBrowser methodsFor: 'accessing' stamp: 'cwp 7/10/2003 20:23'!
extensionClassNames
	^ (self allClassNames difference: self packageClassNames) asSortedCollection! !

!MCSnapshotBrowser methodsFor: 'accessing' stamp: 'ab 7/5/2003 23:41'!
extensionsCategory
	^ '*Extensions'! !

!MCSnapshotBrowser methodsFor: 'menus' stamp: 'StephaneDucasse 10/27/2014 09:34'!
categoryListMenu: aMenu 
	categorySelection
		ifNotNil: [aMenu
				add: (categorySelection = '*Extensions'
						ifTrue: ['Load all extension methods']
						ifFalse: ['Load class category {1}' format: {categorySelection}])
				selector: #loadCategorySelection].
	^ aMenu! !

!MCSnapshotBrowser methodsFor: 'switch' stamp: 'stephaneducasse 2/4/2006 20:47'!
switchIsInstance
	switch ifNil: [switch := #instance].
	^ switch = #instance.! !

!MCSnapshotBrowser methodsFor: 'listing' stamp: 'CamilloBruni 7/15/2013 22:26'!
visibleCategories
	^ ((self packageOrganizations gather: [ :ea | ea categories ]),
		(self packageClasses collect: [ :ea | ea category ]),
			(self hasExtensions ifTrue: [{ self extensionsCategory }] ifFalse: [#()]))
				asSet asSortedCollection! !

!MCSnapshotBrowser methodsFor: 'text' stamp: 'lr 3/20/2010 21:25'!
metaclassDefinitionString
	| defs |
	defs := items select: [:ea | (ea isClassDefinition or: [ea isClassDefinitionExtension])
			and: [ea className = classSelection]].

	defs isEmpty ifTrue: [^ 'This class is defined elsewhere.'].

	^ String streamContents: [:stream | 
		defs asArray sort 
			do: [:ea | ea printClassDefinitionOn: stream]
			separatedBy: [stream nextPut: $.; cr]
	].! !

!MCSnapshotBrowser methodsFor: 'selecting' stamp: 'MarcusDenker 3/25/2013 13:08'!
categorySelection: aNumber
	categorySelection := aNumber = 0 ifFalse: [self visibleCategories at: aNumber].
	self classSelection: 0.
	self changed: #categorySelection;
		changed: #classList.
! !

!MCSnapshotBrowser methodsFor: 'morphic ui' stamp: 'ab 7/18/2003 17:29'!
defaultExtent
	^ 650@400.! !

!MCSnapshotBrowser methodsFor: 'accessing' stamp: 'ab 7/18/2003 15:48'!
packageClassNames
	^ self packageClasses collect: [:ea | ea className]! !

!MCSnapshotBrowser methodsFor: 'text' stamp: 'GabrielOmarCotelli 12/3/2013 17:51'!
classCommentString
	^ items
		detect: [ :ea | ea isClassDefinition and: [ ea className = classSelection ] ]
		ifFound: [ :classDefinition | classDefinition comment ]
		ifNone: [ '' ]! !

!MCSnapshotBrowser methodsFor: 'menus' stamp: 'StephaneDucasse 10/27/2014 09:34'!
protocolListMenu: aMenu 
	protocolSelection
		ifNotNil: [aMenu
				add: ('Load protocol ''{1}''' format: {protocolSelection})
				selector: #loadProtocolSelection ].
	^ aMenu! !

!MCSnapshotBrowser methodsFor: 'text' stamp: 'lr 3/20/2010 21:05'!
text
	self switchIsComment ifTrue: [ ^ self classCommentString ].
	methodSelection ifNotNil: [ ^ methodSelection source ].
	protocolSelection ifNotNil: [ ^ '' ].
	classSelection ifNotNil: [
		^ self switchIsClass 
			ifTrue: [ self metaclassDefinitionString ]
			ifFalse: [ self classDefinitionString ] ].
	categorySelection ifNil: [ ^ self scriptDefinitionString ].
	^ ''! !

!MCSnapshotBrowser methodsFor: 'menus' stamp: 'cwp 7/10/2003 18:03'!
inspectSelection
	^ self methodSelection inspect! !

!MCSnapshotBrowser methodsFor: 'selecting' stamp: 'MarcusDenker 3/25/2013 13:09'!
protocolSelection: anInteger
	protocolSelection := (anInteger = 0 ifFalse: [self visibleProtocols at: anInteger]).
	self methodSelection: 0.
	self changed: #protocolSelection;
		changed: #methodList.! !

!MCSnapshotBrowser methodsFor: 'morphic ui' stamp: 'MarcusDenker 3/25/2013 13:05'!
widgetSpecs

	 ^#(
		((listMorph: category) (0 0 0.25 0.4))
		((listMorph: class) (0.25 0 0.50 0.4) (0 0 0 -30))
		((listMorph: protocol) (0.50 0 0.75 0.4))
		((listMorph:selection:menu:keystroke:  methodList methodSelection methodListMenu: methodListKey:from:) (0.75 0 1 0.4))
		((buttonRow) (0.25 0.4 0.5 0.4) (0 -30 0 0))
		((textMorph: text) (0 0.4 1 1))
		) ! !

!MCSnapshotBrowser methodsFor: 'listing' stamp: 'StephaneDucasse 12/28/2012 19:55'!
packageOrganizations
	^ items select: [:ea | ea isOrganizationDefinition]! !

!MCSnapshotBrowser methodsFor: 'switch' stamp: 'cwp 7/12/2003 18:57'!
signalSwitchChanged
	self protocolSelection: 0.
	self 
		changed: #switchIsInstance;
		changed: #switchIsComment;
		changed: #switchIsClass;
		changed: #protocolList;
		changed: #methodList;
		changed: #text.! !

!MCSnapshotBrowser methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
methodsForSelectedProtocol
	| methods |
	protocolSelection ifNil: [^ Array new].
	methods := self methodsForSelectedClass asOrderedCollection.
	(protocolSelection = '-- all --') 
		ifFalse: [methods removeAllSuchThat: [:ea | ea category ~= protocolSelection]].
	^ methods 
	
								! !

!MCSnapshotBrowser methodsFor: 'accessing' stamp: 'lr 3/14/2010 21:13'!
selectedClass
	classSelection ifNil: [ ^ nil ].
	^ Smalltalk globals at: classSelection ifAbsent: [ nil ]! !

!MCSnapshotBrowser methodsFor: 'switch' stamp: 'stephaneducasse 2/4/2006 20:47'!
switchBeInstance
	switch := #instance.
	self signalSwitchChanged.! !

!MCSnapshotBrowser methodsFor: 'selecting' stamp: 'MarcusDenker 3/25/2013 13:08'!
methodSelection: aNumber
	methodSelection := aNumber = 0 ifFalse: [self visibleMethods at: aNumber].
	self changed: #methodSelection; changed: #text.! !

!MCSnapshotBrowser methodsFor: 'switch' stamp: 'stephaneducasse 2/4/2006 20:47'!
switchBeClass
	switch := #class.
	self signalSwitchChanged.! !

!MCSnapshotBrowser methodsFor: 'listing' stamp: 'cwp 7/13/2003 02:11'!
methodList
	^ self visibleMethods collect: [:ea | ea selector]! !

!MCSnapshotBrowser methodsFor: 'menus' stamp: 'nk 4/30/2004 15:06'!
loadClassSelection
	classSelection ifNil: [ ^self ].
	(self packageClasses detect: [ :ea | ea className = classSelection ] ifNone: [ ^self ]) load.
	self methodsForSelectedClass do: [ :m | m load ].! !

!MCSnapshotBrowser methodsFor: 'listing' stamp: 'cwp 7/10/2003 19:46'!
visibleMethods
	^ classSelection 
		ifNil: [#()]
		ifNotNil: [self methodsForSelectedProtocol]! !

!MCSnapshotBrowser methodsFor: 'selecting' stamp: 'MarcusDenker 3/25/2013 13:08'!
classSelection: aNumber
	classSelection := aNumber = 0 ifFalse: [self visibleClasses at: aNumber].
	self protocolSelection: 0.
	self changed: #classSelection; 
		changed: #protocolList;
		changed: #methodList.
! !

!MCSnapshotBrowser methodsFor: 'morphic ui' stamp: 'ab 7/19/2003 21:31'!
defaultLabel
	^ 'Snapshot Browser'! !

!MCSnapshotBrowser methodsFor: 'text' stamp: 'tfel 8/28/2009 20:42'!
scriptDefinitionString
	| defs |
	defs := items select: [:ea | ea isScriptDefinition].
	defs isEmpty ifTrue: [^'(package defines no scripts)'].
	
	^ String streamContents: [:stream | 
		defs asArray sort 
			do: [:ea | stream nextPutAll: '---------- package ';
					nextPutAll: ea scriptSelector;
					nextPutAll: ' ----------'; cr;
					nextPutAll: ea script; cr]
			separatedBy: [stream cr]].! !

!MCSnapshotBrowser methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
snapshot: aSnapshot
	items := aSnapshot definitions asSortedCollection.
	self categorySelection: 0.! !

!MCSnapshotBrowser methodsFor: 'accessing' stamp: 'MarcusDenker 8/18/2010 11:40'!
allClassNames
	^ (items 
		select: [:ea | (ea isOrganizationDefinition | ea isScriptDefinition) not]
		thenCollect: [:ea | ea className]) asSet.
! !

!MCSnapshotBrowser methodsFor: 'text' stamp: 'stephaneducasse 2/4/2006 20:47'!
classDefinitionString
	| defs |
	defs := items select: [:ea | (ea isClassDefinition or: [ea isClassDefinitionExtension])
			and: [ea className = classSelection]].

	defs isEmpty ifTrue: [^ 'This class is defined elsewhere.'].

	^ String streamContents: [:stream | 
		defs asArray sort 
			do: [:ea | ea printDefinitionOn: stream]
			separatedBy: [stream nextPut: $.; cr]
	].! !

!MCSnapshotBrowser class methodsFor: 'instance creation' stamp: 'ab 7/19/2003 18:03'!
forSnapshot: aSnapshot
	^ self new snapshot: aSnapshot! !

!MCSnapshotBrowserTest methodsFor: 'morphic' stamp: 'cwp 7/13/2003 01:28'!
findListContaining: aString
	^ self listMorphs detect: [:m | m getList includes: aString]! !

!MCSnapshotBrowserTest methodsFor: 'private' stamp: 'cwp 7/14/2003 14:46'!
allCategories
	^ Array with: model extensionsCategory with: self mockCategoryName.! !

!MCSnapshotBrowserTest methodsFor: 'private' stamp: 'cwp 7/13/2003 02:53'!
falsehoodMethodSource
	^ 'falsehood
	^ false'! !

!MCSnapshotBrowserTest methodsFor: 'morphic' stamp: 'stephaneducasse 2/4/2006 20:47'!
morphsOfClass: aMorphClass
	| morphs |
	morphs := OrderedCollection new.
	morph allMorphsDo: [:m | (m isKindOf: aMorphClass) ifTrue: [morphs add: m]].
	^ morphs! !

!MCSnapshotBrowserTest methodsFor: 'testing' stamp: 'cwp 7/13/2003 13:04'!
testClassSelected
	self selectMockClassA.
	
	self assertAListMatches: self allCategories.
	self assertAListMatches: self definedClasses.
	self assertAListMatches: self classAProtocols.
	self denyAListIncludesAnyOf: self allMethods.
	self assertTextIs: self classADefinitionString.! !

!MCSnapshotBrowserTest methodsFor: 'morphic' stamp: 'cwp 7/13/2003 09:19'!
findButtonWithLabel: aString
	^ self buttonMorphs detect: [:m | m label = aString]! !

!MCSnapshotBrowserTest methodsFor: 'testing' stamp: 'cwp 7/13/2003 09:14'!
testThreeButtons
	self assertButtonExists: 'instance'.
	self assertButtonExists: '?'.
	self assertButtonExists: 'class'.! !

!MCSnapshotBrowserTest methodsFor: 'asserting' stamp: 'CamilloBruni 7/16/2013 06:52'!
assertAListMatches: strings
	| lists |
	lists := self listMorphs collect: #getList.
	lists
		detect: [ :list|
			(list size = strings size) and: [list includesAllOf: strings]]
		ifNone: [ 
			self fail: 'Could not find all "', strings asArray asString, '" ', 
						'in any of "', (lists collect: #asArray) asArray asString, '"'  ].! !

!MCSnapshotBrowserTest methodsFor: 'asserting' stamp: 'oscar.nierstrasz 6/5/2010 14:55'!
assertTextIs: aString
	self assert: self textMorph contents = aString.! !

!MCSnapshotBrowserTest methodsFor: 'private' stamp: 'cwp 8/10/2003 02:10'!
classAProtocols
	^ self protocolsForClass: self mockClassA.! !

!MCSnapshotBrowserTest methodsFor: 'private' stamp: 'oscar.nierstrasz 6/5/2010 14:58'!
classAclassDefinitionString
	^ self mockClassA class definition! !

!MCSnapshotBrowserTest methodsFor: 'testing' stamp: 'cwp 7/13/2003 02:50'!
testMethodSelected
	self clickOnListItem: self mockCategoryName.
	self clickOnListItem: 'MCMockClassA'.
	self clickOnListItem: 'boolean'.
	self clickOnListItem: 'falsehood'.
	
	self assertAListMatches: self allCategories.
	self assertAListMatches: self definedClasses.
	self assertAListMatches: self classAProtocols.
	self assertAListMatches: self classABooleanMethods.
	self assertTextIs: self falsehoodMethodSource.! !

!MCSnapshotBrowserTest methodsFor: 'asserting' stamp: 'cwp 7/13/2003 09:27'!
denyButtonOn: aString
	self deny: (self findButtonWithLabel: aString) getModelState.
	! !

!MCSnapshotBrowserTest methodsFor: 'asserting' stamp: 'stephaneducasse 2/4/2006 20:47'!
denyAListIncludesAnyOf: anArrayOfStrings
	| found |
	found := true.
	self listMorphs 
			detect: [:m | m getList includesAnyOf: anArrayOfStrings]
			ifNone: [found := false].
	self deny: found.! !

!MCSnapshotBrowserTest methodsFor: 'private' stamp: 'cwp 7/14/2003 14:58'!
allProtocols
	^ MCSnapshotResource current definitions
		select: [:def | def isMethodDefinition]
		thenCollect: [:def | def category]		! !

!MCSnapshotBrowserTest methodsFor: 'testing' stamp: 'oscar.nierstrasz 6/5/2010 14:58'!
testClassSideClassSelected
	self clickOnButton: 'class'.
	self selectMockClassA.
	
	self assertAListMatches: self allCategories.
	self assertAListMatches: self definedClasses.
	self assertAListMatches: self classAClassProtocols.
	self denyAListIncludesAnyOf: self allMethods.
	self assertTextIs: self classAclassDefinitionString.! !

!MCSnapshotBrowserTest methodsFor: 'asserting' stamp: 'stephaneducasse 2/4/2006 20:47'!
denyAListHasSelection: aString
	| found |
	found := true.
	self listMorphs 
			detect: [:m | m selection = aString]
			ifNone: [found := false].
	self deny: found.! !

!MCSnapshotBrowserTest methodsFor: 'asserting' stamp: 'cwp 7/13/2003 01:19'!
assertAListIncludes: anArrayOfStrings
	self listMorphs 
			detect: [:m | m getList includesAllOf: anArrayOfStrings]
			ifNone: [self assert: false].! !

!MCSnapshotBrowserTest methodsFor: 'morphic' stamp: 'cwp 7/13/2003 09:12'!
buttonMorphs
	^ self morphsOfClass: PluggableButtonMorph! !

!MCSnapshotBrowserTest methodsFor: 'asserting' stamp: 'cwp 7/13/2003 09:26'!
assertButtonOn: aString
	self assert: (self findButtonWithLabel: aString) getModelState.
	! !

!MCSnapshotBrowserTest methodsFor: 'morphic' stamp: 'cwp 7/28/2003 22:21'!
annotationTextMorph
	^ (self morphsOfClass: TextMorph) first! !

!MCSnapshotBrowserTest methodsFor: 'simulating' stamp: 'stephaneducasse 2/4/2006 20:47'!
clickOnListItem: aString
	| listMorph |
	listMorph := self findListContaining: aString.
	listMorph changeModelSelection: (listMorph getList indexOf: aString).! !

!MCSnapshotBrowserTest methodsFor: 'testing' stamp: 'cwp 7/13/2003 08:46'!
testProtocolIsCleared
	self clickOnListItem: self mockCategoryName.
	self clickOnListItem: 'MCMockASubclass'.
	self clickOnListItem: 'as yet unclassified'.
	self clickOnListItem: 'MCMockClassA'.
	
	self denyAListHasSelection: 'as yet unclassified'.! !

!MCSnapshotBrowserTest methodsFor: 'private' stamp: 'cwp 7/13/2003 02:23'!
classABooleanMethods
	^ #(falsehood moreTruth truth)! !

!MCSnapshotBrowserTest methodsFor: 'private' stamp: 'cwp 7/14/2003 14:59'!
definedClasses
	^ MCSnapshotResource current definitions 
		select: [:def | def isClassDefinition] 
		thenCollect: [:def | def className].! !

!MCSnapshotBrowserTest methodsFor: 'asserting' stamp: 'cwp 7/13/2003 09:12'!
assertButtonExists: aString
	self buttonMorphs detect: [:m | m label = aString] ifNone: [self assert: false].
				! !

!MCSnapshotBrowserTest methodsFor: 'running' stamp: 'stephaneducasse 2/4/2006 20:47'!
setUp
	model := MCSnapshotBrowser forSnapshot: MCSnapshotResource current snapshot.
	morph := model buildWindow.! !

!MCSnapshotBrowserTest methodsFor: 'private' stamp: 'oscar.nierstrasz 6/5/2010 14:58'!
classADefinitionString
	^ self mockClassA definition! !

!MCSnapshotBrowserTest methodsFor: 'simulating' stamp: 'cwp 7/13/2003 09:22'!
clickOnButton: aString
	(self findButtonWithLabel: aString) performAction.! !

!MCSnapshotBrowserTest methodsFor: 'testing' stamp: 'cwp 7/13/2003 02:40'!
testCategorySelected
	self clickOnListItem: self mockCategoryName.
	
	self assertAListMatches: self allCategories.
	self assertAListMatches: self definedClasses.
	self denyAListIncludesAnyOf: self allProtocols.
	self denyAListIncludesAnyOf: self allMethods.
	self assertTextIs: ''.! !

!MCSnapshotBrowserTest methodsFor: 'testing' stamp: 'cwp 7/13/2003 12:52'!
testComment
	self clickOnButton: '?'.
	self assertTextIs: ''.
	
	self clickOnListItem: self mockCategoryName.
	self assertTextIs: ''.
	
	self clickOnListItem: 'MCMockClassA'.
	self assertTextIs: self classAComment.! !

!MCSnapshotBrowserTest methodsFor: 'testing' stamp: 'cwp 7/13/2003 02:30'!
testFourColumns
	self assert: self listMorphs size = 4.! !

!MCSnapshotBrowserTest methodsFor: 'morphic' stamp: 'cwp 7/13/2003 02:34'!
listMorphs
	^ self morphsOfClass: PluggableListMorph! !

!MCSnapshotBrowserTest methodsFor: 'selecting' stamp: 'cwp 7/13/2003 13:04'!
selectMockClassA
	self clickOnListItem: self mockCategoryName.
	self clickOnListItem: 'MCMockClassA'.
	! !

!MCSnapshotBrowserTest methodsFor: 'private' stamp: 'cwp 8/10/2003 02:10'!
classAClassProtocols
	^ self protocolsForClass: self mockClassA class.! !

!MCSnapshotBrowserTest methodsFor: 'morphic' stamp: 'cwp 7/28/2003 22:21'!
textMorph
	^ (self morphsOfClass: TextMorph) last! !

!MCSnapshotBrowserTest methodsFor: 'testing' stamp: 'cwp 7/13/2003 09:31'!
testButtonMutex
	self assertButtonOn: 'instance'.
	self denyButtonOn: '?'.
	self denyButtonOn: 'class'.
	
	self clickOnButton: '?'.
	self assertButtonOn: '?'.
	self denyButtonOn: 'instance'.
	self denyButtonOn: 'class'.
	
	self clickOnButton: 'class'.
	self assertButtonOn: 'class'.
	self denyButtonOn: '?'.
	self denyButtonOn: 'instance'.
! !

!MCSnapshotBrowserTest methodsFor: 'testing' stamp: 'CamilloBruni 7/15/2013 22:29'!
testMethodIsCleared
	self clickOnListItem: self mockCategoryName.
	self clickOnListItem: 'MCMockClassA'.
	self clickOnListItem: 'boolean'.
	self clickOnListItem: 'falsehood'.
	self clickOnListItem: AllProtocol defaultName.
	
	self denyAListHasSelection: 'falsehood'.! !

!MCSnapshotBrowserTest methodsFor: 'private' stamp: 'CamilloBruni 7/15/2013 22:17'!
protocolsForClass: aClass
	^ aClass organization categories
! !

!MCSnapshotBrowserTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testTextPane
	self textMorph! !

!MCSnapshotBrowserTest methodsFor: 'testing' stamp: 'cwp 7/13/2003 08:52'!
testProtocolSelected
	self clickOnListItem: self mockCategoryName.
	self clickOnListItem: 'MCMockClassA'.
	self clickOnListItem: 'boolean'.
	
	self assertAListMatches: self allCategories.
	self assertAListMatches: self definedClasses.
	self assertAListMatches: self classAProtocols.
	self assertAListMatches: self classABooleanMethods.
	self assertTextIs: ''.		! !

!MCSnapshotBrowserTest methodsFor: 'private' stamp: 'cwp 8/10/2003 02:10'!
classAComment
	^ self mockClassA organization classComment.! !

!MCSnapshotBrowserTest methodsFor: 'private' stamp: 'cwp 7/14/2003 14:58'!
allMethods
	^ MCSnapshotResource current definitions
		select: [:def | def isMethodDefinition]
		thenCollect: [:def | def selector]		! !

!MCSnapshotBrowserTest methodsFor: 'testing' stamp: 'tfel 8/28/2009 20:43'!
testNoSelection
	self assertAListMatches: self allCategories.
	self denyAListIncludesAnyOf: self definedClasses.
	self denyAListIncludesAnyOf: self allProtocols.
	self denyAListIncludesAnyOf: self allMethods.
	"and if there I need to see the packages scripts (or none)"
	self assertTextIs: '(package defines no scripts)'.! !

!MCSnapshotReader commentStamp: 'LaurentLaffont 2/23/2011 20:21'!
I am an abstract class defining the interface for reading sources containing class and method definitions.
I should define loadDefinitions as a subclassResponsibility, but don't.
MCVersionReader could be a subclass of me for reading sources containing additional metadata, but isn't. 

I'm useless and can be safely removed. I'm only referenced in MCMczReader>>extractDefinitionsFrom: and it can be replaced by MCReader.!
!MCSnapshotReader methodsFor: 'accessing' stamp: 'avi 1/21/2004 23:10'!
snapshot
	^ MCSnapshot fromDefinitions: self definitions! !

!MCSnapshotReader methodsFor: 'accessing' stamp: 'avi 1/21/2004 23:09'!
definitions
	definitions ifNil: [self loadDefinitions].
	^ definitions! !

!MCSnapshotReader class methodsFor: 'accessing' stamp: 'avi 1/21/2004 22:56'!
snapshotFromStream: aStream
	^ (self on: aStream) snapshot! !

!MCSnapshotResource methodsFor: 'accessing' stamp: 'cwp 7/14/2003 14:51'!
snapshot
	^ snapshot! !

!MCSnapshotResource methodsFor: 'accessing' stamp: 'cwp 7/14/2003 14:50'!
definitions
	^ snapshot definitions! !

!MCSnapshotResource methodsFor: 'running' stamp: 'stephaneducasse 2/4/2006 20:47'!
setUp
	snapshot := self class takeSnapshot.! !

!MCSnapshotResource class methodsFor: 'accessing' stamp: 'cwp 7/14/2003 15:19'!
takeSnapshot
	^ self mockPackage snapshot! !

!MCSnapshotResource class methodsFor: 'accessing' stamp: 'cwp 8/1/2003 20:18'!
mockPackage
	^ (MCPackage new name: self mockPackageName)! !

!MCSnapshotResource class methodsFor: 'accessing' stamp: 'GuillermoPolito 8/24/2012 13:01'!
mockPackageName
	^ 'MonticelloMocks'! !

!MCSnapshotTest methodsFor: '*MonticelloMocks' stamp: 'cyrilledelaunay 1/21/2011 12:10'!
mockClassExtension

	"I change the protocol of this method to resolve the failing test: MCChangeNotificationTest >> testExtMethodModified. This test basically test that when we modified an extension method, the extended package is marked as 'modified'. The problem is that Monticello treat differently a classic method from an extension method, and this only by checking if the protocol name start with a star. Therefore, if the protocol does not match the extending package name, the extending package name will never be notified, and the test will fail. " ! !

!MCSnapshotTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:47'!
testInstanceReuse
	| x m n y |
	x := (MCPackage new name: self mockCategoryName) snapshot.
	Smalltalk garbageCollect.
	n := MCDefinition allSubInstances size.
	y := (MCPackage new name: self mockCategoryName) snapshot.
	Smalltalk garbageCollect.
	m := MCDefinition allSubInstances size.
	self assert: m = n! !

!MCSnapshotTest methodsFor: 'running' stamp: 'stephaneducasse 2/4/2006 20:47'!
setUp
	snapshot :=  self mockSnapshot.! !

!MCSnapshotTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:47'!
testCreation
	|d|
	d :=  self mockSnapshot definitions.
	self assert: (d anySatisfy: [:ea | ea isClassDefinition and: [ea className = #MCMockClassA]]).
	self assert: (d anySatisfy: [:ea | ea isMethodDefinition and: [ea selector = #mockClassExtension]]).
	self assert: (d allSatisfy: [:ea | ea isClassDefinition not or: [ea category endsWith: 'Mocks']]).
	! !

!MCSortingTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:47'!
testConsistentSorting
	| definitions shuffledAndSorted|
	definitions :=
		{self methodNamed: #a class: #A meta: false.
		self methodNamed: #a class: #A meta: true.
		self methodNamed: #a class: #B meta: false.
		self methodNamed: #b class: #A meta: false.
		self methodNamed: #b class: #B meta: false.
		self classNamed: #A.
		self classNamed: #B}.
	shuffledAndSorted :=
		(1 to: 100) collect: [:ea | self sortDefinitions: definitions shuffled].
	self assert: shuffledAndSorted asSet size = 1.
! !

!MCSortingTest methodsFor: 'building' stamp: 'ab 4/8/2003 18:03'!
methodNamed: aSymbol class: className meta: aBoolean
	^ MCMethodDefinition
		className: className
		classIsMeta: aBoolean
		selector: aSymbol
		category: ''
		timeStamp: ''
		source: ''! !

!MCSortingTest methodsFor: 'actions' stamp: 'ab 7/19/2003 18:01'!
sortDefinitions: aCollection
	^ aCollection asSortedCollection asArray! !

!MCSortingTest methodsFor: 'building' stamp: 'ab 4/8/2003 17:56'!
classNamed: aSymbol
	^ MCClassDefinition
		name: aSymbol
		superclassName: #Object
		category: ''
		instVarNames: #()
		comment: ''! !

!MCSortingTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:47'!
testSortOrder
	| aA aAm aB bA bB A B cA bAm cAm |
	aA := self methodNamed: #a class: #A meta: false.
	bA := self methodNamed: #b class: #A meta: false.
	cA := self methodNamed: #c class: #A meta: false.
	aAm := self methodNamed: #a class: #A meta: true.
	bAm := self methodNamed: #b class: #A meta: true.
	cAm := self methodNamed: #c class: #A meta: true.
	aB := self methodNamed: #a class: #B meta: false.
	bB := self methodNamed: #b class: #B meta: false.
	A := self classNamed: #A.
	B := self classNamed: #B.
	self assert: (self sortDefinitions: {aA. aAm. cAm. aB. bAm. bA. bB. A. cA. B})
					= {A. aAm. bAm. cAm. aA. bA. cA. B. aB.  bB}! !

!MCSortingTest methodsFor: 'building' stamp: 'ab 7/19/2003 17:56'!
sortKeyFor: aDefinition
	^ String streamContents:
		[:s |
		aDefinition description
			do: [:ea | s nextPutAll: ea asString]
			separatedBy: [s nextPut: $.]]! !

!MCSortingTest class methodsFor: 'testing' stamp: 'JorgeRessia 3/16/2010 20:26'!
isUnitTest
	^false! !

!MCSqueaksourceRepository commentStamp: '<historical>'!
I am a specialized MCHttpRepository for http://squeaksource.com.
I optimize checks for existing files by doing a head request instead of reloading the whole file list first.!
!MCSqueaksourceRepository methodsFor: 'interface' stamp: 'CamilloBruni 4/23/2012 20:22'!
includesVersionNamed: aString
	"directly do a filename check since squeaksource only stores mcz"
	^ self includesFileNamed: aString, '.mcz'! !

!MCSqueaksourceRepository methodsFor: 'interface' stamp: 'CamilloBruni 9/14/2012 17:10'!
includesFileNamed: aString
	
	"avoid the slower default method and simply do a head request "
	self httpClient
		numberOfRetries: 0;
		ifFail: [ :exception| 
			exception response code = 404
				ifTrue: [ ^ false ].
			exception pass];
		head: (self urlForFileNamed: aString).
		
	^ true! !

!MCSqueaksourceRepository methodsFor: '*Komitter-Models' stamp: 'BenjaminVanRyseghem 11/23/2013 13:17'!
koRemote

	^ KomitSqueakSourceRemote new
		remote: self;
		yourself! !

!MCSqueaksourceRepository class methodsFor: 'creation template' stamp: 'CamilloBruni 10/21/2012 13:25'!
baseURL
	^ 'http://squeaksource.com/'! !

!MCSqueaksourceRepository class methodsFor: 'testing' stamp: 'CamilloBruni 4/6/2013 23:07'!
isResponsibleFor: aUrl
	^ aUrl includesSubstring: 'squeaksource.com/'! !

!MCSqueaksourceRepository class methodsFor: 'accessing' stamp: 'CamilloBruni 2/8/2012 18:13'!
description
	^ 'squeaksource.com'! !

!MCStReader commentStamp: 'LaurentLaffont 3/31/2011 21:07'!
I read Category/Classes/Methodes/.... definitions from Monticello source.st file format.

See also MCStWriter.

Example:

|source|
source := String streamContents: [:aStream| |writer|
    writer := MCStWriter on: aStream.
    writer writeDefinitions: {True asClassDefinition. False asClassDefinition}.
].

(MCStReader on: source readStream) definitions explore.!
!MCStReader methodsFor: 'reading' stamp: 'avi 1/19/2004 21:56'!
typeOfSubclass: aSymbol
	#(
		(subclass: normal)
		(variableSubclass: variable)
		(variableByteSubclass: bytes)
		(variableWordSubclass: words)
		(weakSubclass: weak)
		) do: [:ea | ea first = aSymbol ifTrue: [^ ea second]].
	self error: 'Unrecognized class definition'! !

!MCStReader methodsFor: 'reading' stamp: 'stephaneducasse 2/4/2006 20:47'!
commentStampFor: aPseudoClass
	| comment |
	comment := aPseudoClass organization classComment.
	^  [comment stamp] on: MessageNotUnderstood do: [nil]! !

!MCStReader methodsFor: 'adding' stamp: 'marcus.denker 11/10/2008 10:04'!
addDefinitionsFromDoit: aString
	(MCDoItParser forDoit: aString) ifNotNil:
		[:parser |
		parser addDefinitionsTo: definitions]! !

!MCStReader methodsFor: 'reading' stamp: 'MarcusDenker 5/18/2013 15:44'!
classDefinitionFrom: aPseudoClass
	| tokens traitCompositionString lastIndex classTraitCompositionString |
	tokens := aPseudoClass definition parseLiterals.
	traitCompositionString := (aPseudoClass definition readStream
		match: 'uses:';
		upToAll: 'instanceVariableNames:') trimBoth.
	classTraitCompositionString := (aPseudoClass metaClass definition asString readStream
		match: 'uses:';
		upToAll: 'instanceVariableNames:') trimBoth.
	traitCompositionString isEmpty ifTrue: [traitCompositionString := '{}'].
	classTraitCompositionString isEmpty ifTrue: [classTraitCompositionString := '{}'].
	lastIndex := tokens size.
	^ MCClassDefinition
		name: (tokens at: 3)
		superclassName: (tokens at: 1)
		traitComposition: traitCompositionString
		classTraitComposition: classTraitCompositionString
		category: (tokens at: lastIndex)
		instVarNames: ((tokens at: lastIndex - 6) findTokens: ' ')
		classVarNames: ((tokens at: lastIndex - 4) findTokens: ' ')
		poolDictionaryNames: ((tokens at: lastIndex - 2) findTokens: ' ')
		classInstVarNames: (self classInstVarNamesFor: aPseudoClass)
		type: (self typeOfSubclass: (tokens at: 2))
		comment: (self commentFor: aPseudoClass)
		commentStamp: (self commentStampFor: aPseudoClass)! !

!MCStReader methodsFor: 'reading' stamp: 'MarcusDenker 5/18/2013 15:44'!
classInstVarNamesFor: aPseudoClass
	| tokens |
	
	self flag: #traits.
	aPseudoClass metaClass hasDefinition ifFalse: [^ #()].
	tokens := aPseudoClass metaClass definition parseLiterals.
	"tokens size = 4 ifFalse: [self error: 'Unrecognized metaclass definition']."
	^ tokens last findTokens: ' '! !

!MCStReader methodsFor: 'reading' stamp: 'MarcusDenker 5/18/2013 15:44'!
categoryFromDoIt: aString
	| tokens  |
	tokens := aString parseLiterals.
	tokens size = 3 ifFalse: [self error: 'Unrecognized category definition'].
	^ tokens at: 3! !

!MCStReader methodsFor: 'reading' stamp: 'avi 3/3/2004 15:23'!
methodDefinitionsFor: aPseudoClass
	^ aPseudoClass selectors collect: 
		[:ea |
		 MCMethodDefinition
			className: aPseudoClass name
			classIsMeta: aPseudoClass isMeta
			selector: ea
			category: (aPseudoClass organization categoryOfElement: ea)
			timeStamp: (aPseudoClass stampAt: ea)
			source: (aPseudoClass sourceCodeAt: ea)]! !

!MCStReader methodsFor: 'evaluating' stamp: 'stephaneducasse 2/4/2006 20:47'!
loadDefinitions
	| filePackage |
	filePackage :=
		FilePackage new
			fullName: 'ReadStream';
			fileInFrom: self readStream.
	definitions := OrderedCollection new.
	filePackage classes do:
		[:pseudoClass |
		pseudoClass hasDefinition
			ifTrue: [definitions add:
					(self classDefinitionFrom: pseudoClass)].
		definitions addAll: (self methodDefinitionsFor: pseudoClass).
		definitions addAll: (self methodDefinitionsFor: pseudoClass metaClass)].
	filePackage doIts do:
		[:ea |
		self addDefinitionsFromDoit: ea string].
	! !

!MCStReader methodsFor: 'evaluating' stamp: 'avi 1/21/2004 14:21'!
readStream
	^ ('!!!!

', stream contents) readStream! !

!MCStReader methodsFor: 'reading' stamp: 'stephaneducasse 2/4/2006 20:47'!
commentFor: aPseudoClass
	| comment |
	comment := aPseudoClass organization classComment.
	^ comment asString = ''
		ifTrue: [comment]
		ifFalse: [comment string]! !

!MCStReader methodsFor: 'reading' stamp: 'stephaneducasse 2/4/2006 20:47'!
systemOrganizationFromRecords: changeRecords
	| categories |
	categories := changeRecords
					select: [:ea | 'SystemOrganization*' match: ea string]
					thenCollect: [:ea | (self categoryFromDoIt: ea string)].
	^ categories isEmpty ifFalse: [MCOrganizationDefinition categories: categories asArray]! !

!MCStReader class methodsFor: 'accessing' stamp: 'avi 1/20/2004 00:17'!
extension
	^ 'st'! !

!MCStReaderTest methodsFor: 'util' stamp: 'sd 3/20/2008 22:31'!
methodWithStyle
	^ '!!EventHandler methodsFor: ''copying'' stamp: ''tk 1/22/2001 17:39''!!
veryDeepInner: deepCopier
	"ALL fields are weakly copied.  Can''t duplicate an object by duplicating a button that activates it.  See DeepCopier."

	super veryDeepInner: deepCopier.
	"just keep old pointers to all fields"
	clickRecipient := clickRecipient.!!
]style[(25 108 10 111)f1b,f1,f1LDeepCopier Comment;,f1!! !!

'! !

!MCStReaderTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:47'!
testMethodWithStyle
	| reader |
	reader := MCStReader on: self methodWithStyle readStream.
	self assert: reader definitions first isMethodDefinition.! !

!MCStReaderTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:47'!
testCommentWithoutStyle
	| reader |
	reader := MCStReader on: self commentWithoutStyle readStream.
	self assert: (reader definitions anySatisfy: [:ea | ea isMethodDefinition]).! !

!MCStReaderTest methodsFor: 'util' stamp: 'ab 8/17/2003 16:52'!
commentWithoutStyle
	^ '
CharacterScanner subclass: #CanvasCharacterScanner
	instanceVariableNames: ''canvas fillBlt foregroundColor runX lineY ''
	classVariableNames: ''''
	poolDictionaries: ''''
	category: ''Morphic-Support''!!

!!CanvasCharacterScanner commentStamp: ''<historical>'' prior: 0!!
A displaying scanner which draws its output to a Morphic canvas.!!

!!CanvasCharacterScanner methodsFor: ''stop conditions'' stamp: ''ar 12/15/2001 23:27''!!
setStopConditions
	"Set the font and the stop conditions for the current run."

	self setFont.
	stopConditions
		at: Space asciiValue + 1
		put: (alignment = Justified ifTrue: [#paddedSpace])!! !!'! !

!MCStReaderTest methodsFor: 'util' stamp: 'cwp 8/16/2003 23:35'!
commentWithStyle
	^ '!!AEDesc commentStamp: ''<historical>'' prior: 0!!
I represent an Apple Event Descriptor.  I am a low-level representation of Apple Event (and hence Applescript) information.  For further Information, see Apple''s Inside Macintosh: Interapplication Communications, at

	http://developer.apple.com/techpubs/mac/IAC/IAC-2.html.

Essentially, I represent a record comprising a one-word "string" (treating the word as fourbyte characters) representing a data type, followed by a pointer to a pointer (a handle) to the data I represent.  Care must be taken to assure that the Handle data is disposed after use, or memory leaks result.  At this time, I make no effort to do this automatically through finalization.!!
]style[(218 54 384)f1,f1Rhttp://developer.apple.com/techpubs/mac/IAC/IAC-2.html;,f1!!
'! !

!MCStReaderTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:47'!
testCommentWithStyle
	| reader |
	reader := MCStReader on: self commentWithStyle readStream.
	reader definitions! !

!MCStWriter commentStamp: 'LaurentLaffont 3/31/2011 21:07'!
I write Category/Classes/Methods/.... definitions into Monticello source.st file format found in .mcz packages.    

See also MCStReader

Example:

String streamContents: [:aStream| |writer|
    writer := MCStWriter on: aStream.
    writer writeDefinitions: {True asClassDefinition. False asClassDefinition}.
]!
!MCStWriter methodsFor: 'writing' stamp: 'avi 2/17/2004 02:25'!
writeSnapshot: aSnapshot
	self writeDefinitions: aSnapshot definitions! !

!MCStWriter methodsFor: 'visiting' stamp: 'cwp 8/2/2003 11:02'!
visitClassDefinition: definition
	self writeClassDefinition: definition.
	definition hasClassInstanceVariables ifTrue: [self writeMetaclassDefinition: definition].
	definition hasComment ifTrue: [self writeClassComment: definition].! !

!MCStWriter methodsFor: 'writing' stamp: 'pavel.krivanek 10/23/2010 19:40'!
writeDefinitions: aCollection
	
	"the correct initialization order is unknown if some classes are missing in the image"
	
	| presentInitializers notPresentInitializers orderedClasses |
	
	initializers := Set new.

	(MCDependencySorter sortItems: aCollection)
		do: [:ea | ea accept: self]
		displayingProgress: 'Writing definitions...'.
		
	presentInitializers := initializers select: [:each | Smalltalk hasClassNamed: each key ].
	notPresentInitializers := initializers reject: [:each | Smalltalk hasClassNamed: each key ].
	
	orderedClasses := (Class superclassOrder: (presentInitializers collect: [:each | Smalltalk classOrTraitNamed: each key]))
		collect: [:each | each name ].
				
	orderedClasses do: [:className |
		stream nextPutAll: (presentInitializers detect: [:each | each key = className]) value contents].
	
	(notPresentInitializers asSortedCollection: [:a :b | a key <= b key]) do: [:association |
		stream nextPutAll: association value contents ].! !

!MCStWriter methodsFor: 'visiting' stamp: 'avi 2/17/2004 02:23'!
visitMethodDefinition: definition
	self writeMethodPreamble: definition.
	self writeMethodSource: definition.
	self writeMethodPostscript.
	self writeMethodInitializer: definition.! !

!MCStWriter methodsFor: 'writing' stamp: 'al 12/2/2005 15:17'!
writeMetaclassDefinition: definition
	self chunkContents: [:str |
		str	nextPutAll: definition className;
			nextPutAll: ' class';
			cr; tab.
			definition hasClassTraitComposition ifTrue: [
				str	nextPutAll: 'uses: ';
					nextPutAll: definition classTraitCompositionString;
					cr; tab].
			str	nextPutAll: 'instanceVariableNames: ''';
				nextPutAll: definition classInstanceVariablesString;
				nextPut: $']! !

!MCStWriter methodsFor: 'writing' stamp: 'avi 9/23/2003 17:42'!
writeMethodPreamble: definition
	stream
		cr;
		nextPut: $!!;
		nextPutAll: definition fullClassName;
		nextPutAll: ' methodsFor: ';
		nextPutAll: definition category asString printString;
		nextPutAll: ' stamp: ';
		nextPutAll: definition timeStamp asString printString;
		nextPutAll: '!!';
		cr! !

!MCStWriter methodsFor: 'writing' stamp: 'ab 8/17/2003 17:09'!
writeClassComment: definition
	stream
		cr;
		nextPut: $!!;
		nextPutAll: definition className;
		nextPutAll: ' commentStamp: ';
		store: definition commentStamp;
		nextPutAll: ' prior: 0!!';
		cr;
		nextChunkPut: definition comment;
		cr.! !

!MCStWriter methodsFor: 'visiting' stamp: 'al 10/9/2005 19:40'!
visitMetaclassDefinition: definition
	self writeMetaclassDefinition: definition! !

!MCStWriter methodsFor: 'visiting' stamp: 'cwp 8/2/2003 11:02'!
visitOrganizationDefinition: defintion
	defintion categories do: [:cat | self writeCategory: cat].
! !

!MCStWriter methodsFor: 'writing' stamp: 'cwp 8/2/2003 12:43'!
writeMethodPostscript
	stream
		space;
		nextPut: $!!;
		cr! !

!MCStWriter methodsFor: 'writing' stamp: 'bf 8/13/2009 00:21'!
writeScriptDefinition: definition
	stream nextChunkPut: (
		'(PackageInfo named: {1}) {2}: {3}'
		format: {
			"{1}" definition packageName printString.
			"{2}" definition scriptSelector. 
			"{3}" definition script printString
		}); cr! !

!MCStWriter methodsFor: 'writing' stamp: 'cwp 8/4/2003 01:35'!
writeMethodSource: definition
	stream nextChunkPut: definition source! !

!MCStWriter methodsFor: 'writing' stamp: 'cwp 8/2/2003 01:46'!
writeCategory: categoryName
	stream
		nextChunkPut: 'SystemOrganization addCategory: ', categoryName printString;
		cr! !

!MCStWriter methodsFor: 'writing' stamp: 'cwp 8/2/2003 02:16'!
writeClassDefinition: definition
	self chunkContents: [:s | definition printDefinitionOn: stream]! !

!MCStWriter methodsFor: 'visiting' stamp: 'al 10/9/2005 19:40'!
visitTraitDefinition: definition
	self writeClassDefinition: definition.
	definition hasComment ifTrue: [self writeClassComment: definition].! !

!MCStWriter methodsFor: 'visiting' stamp: 'bf 8/12/2009 21:41'!
visitScriptDefinition: definition
	self writeScriptDefinition: definition
! !

!MCStWriter methodsFor: 'writing' stamp: 'cwp 8/2/2003 02:34'!
chunkContents: aBlock
	stream cr; nextChunkPut: (String streamContents: aBlock); cr! !

!MCStWriter methodsFor: 'writing' stamp: 'pavel.krivanek 10/23/2010 18:51'!
writeMethodInitializer: aMethodDefinition

	| initializationStream |
	
	aMethodDefinition isInitializer 
		ifTrue: [
			initializationStream := String new writeStream.			
			initializationStream nextChunkPut: aMethodDefinition className, ' initialize'; cr.
			initializers add: (aMethodDefinition className->initializationStream)].! !

!MCStWriter methodsFor: 'visiting' stamp: 'al 10/9/2005 19:52'!
visitClassTraitDefinition: definition
	self chunkContents: [:s | s
		nextPutAll: definition baseTrait;
		nextPutAll: ' classTrait';
		cr; tab;
		nextPutAll: 'uses: ';
		nextPutAll: (definition classTraitComposition ifNil: ['{}'])]
! !

!MCStWriter class methodsFor: 'accessing' stamp: 'avi 1/20/2004 00:16'!
readerClass
	^ MCStReader! !

!MCStWriterTest methodsFor: 'testing' stamp: 'cwp 9/14/2003 19:39'!
testClassDefinitionB
	writer visitClassDefinition: (self mockClassB asClassDefinition).
	self assertContentsOf: stream match: self expectedClassDefinitionB.
	! !

!MCStWriterTest methodsFor: 'data' stamp: 'GuillermoPolito 8/24/2012 12:57'!
expectedClassDefinitionA
 ^ '
MCMock subclass: #MCMockClassA
	instanceVariableNames: ''ivar''
	classVariableNames: ''CVar InitializationOrder''
	poolDictionaries: ''''
	category: ''MonticelloMocks''!!

!!MCMockClassA commentStamp: ''cwp 8/10/2003 16:43'' prior: 0!!
This is a mock class. The Monticello tests manipulated it to simulate a developer modifying code in the image.!!
'! !

!MCStWriterTest methodsFor: 'asserting' stamp: 'MarcusDenker 9/5/2013 13:16'!
assertMethodChunkIsWellFormed: chunk
	self class compiler
		source: chunk readStream;
		class: UndefinedObject;
		failBlock: [self assert: false];
		translate.
	! !

!MCStWriterTest methodsFor: 'asserting' stamp: 'cwp 8/2/2003 12:13'!
assertAllChunksAreWellFormed
	stream reset.
	stream 
		untilEnd: [self assertChunkIsWellFormed: stream nextChunk]
		displayingProgress: 'Checking syntax...'! !

!MCStWriterTest methodsFor: 'testing' stamp: 'GuillermoPolito 8/24/2012 12:57'!
methodWithBangs
	^ '
	^ ReadStream on: 
''MCRevisionInfo packageName: ''MonticelloCompatibilityTest''!!!!
MCOrganizationDeclaration categories: 
  #(
  ''MonticelloMocks'')!!!!

MCClassDeclaration
  name: #MCMockClassD
  superclassName: #Object
  category: #''MonticelloMocks''
  instVarNames: #()
  comment: ''''!!!!

MCMethodDeclaration className: #MCMockClassD selector: #one category: #''as yet unclassified'' timeStamp: ''cwp 7/8/2003 21:21'' source: 
''one
	^ 1''!!!!
''
'
! !

!MCStWriterTest methodsFor: 'testing' stamp: 'VeronicaUquillas 8/23/2011 11:45'!
testMethodDefinition
	writer visitMethodDefinition: (RGMethodDefinition realClass: self mockClassA selector: #one) asMCMethodDefinition.
	self assertContentsOf: stream match: self expectedMethodDefinition.
	stream reset.
	self assert: stream nextChunk isAllSeparators.
	self assertChunkIsWellFormed: stream nextChunk.
	self assertMethodChunkIsWellFormed: stream nextChunk.
	self assert: stream nextChunk isAllSeparators ! !

!MCStWriterTest methodsFor: 'data' stamp: 'GuillermoPolito 8/24/2012 12:57'!
expectedClassDefinitionB
 ^ '
MCMock subclass: #MCMockClassB
	instanceVariableNames: ''ivarb''
	classVariableNames: ''CVar''
	poolDictionaries: ''MCMockAPoolDictionary''
	category: ''MonticelloMocks''!!

MCMockClassB class
	instanceVariableNames: ''ciVar''!!

!!MCMockClassB commentStamp: '''' prior: 0!!
This comment has a bang!!!! Bang!!!! Bang!!!!!!
'! !

!MCStWriterTest methodsFor: 'testing' stamp: 'VeronicaUquillas 8/23/2011 11:45'!
testClassMethodDefinition
	writer visitMethodDefinition: (RGMethodDefinition realClass: self mockClassA class selector: #one) asMCMethodDefinition.
	self assertContentsOf: stream match: self expectedClassMethodDefinition.
	stream reset.
	self assert: stream nextChunk isAllSeparators.
	self assertChunkIsWellFormed: stream nextChunk.
	self assertMethodChunkIsWellFormed: stream nextChunk.
	self assert: stream nextChunk isAllSeparators ! !

!MCStWriterTest methodsFor: 'testing' stamp: 'stephaneducasse 2/4/2006 20:47'!
setUp
	stream := RWBinaryOrTextStream on: String new.
	writer := MCStWriter on: stream.
! !

!MCStWriterTest methodsFor: 'asserting' stamp: 'MarcusDenker 9/5/2013 13:16'!
assertChunkIsWellFormed: chunk
	self class compiler
		source:  chunk readStream ;
		class: UndefinedObject;
		noPattern: true;
		failBlock:  [self assert: false];
		translate.! !

!MCStWriterTest methodsFor: 'asserting' stamp: 'nk 2/22/2005 21:17'!
assertContentsOf: strm match: expected 
	| actual |
	actual := strm contents.
	self assert: actual size = expected size.
	actual with: expected do: [:a :e | self assert: a = e]! !

!MCStWriterTest methodsFor: 'data' stamp: 'abc 8/24/2012 16:11'!
expectedMethodDefinitionWithBangs
	^ '
!!MCStWriterTest methodsFor: ''testing'' stamp: ''GuillermoPolito 8/24/2012 12:57''!!
methodWithBangs
	^ ''
	^ ReadStream on: 
''''MCRevisionInfo packageName: ''''MonticelloCompatibilityTest''''!!!!!!!!
MCOrganizationDeclaration categories: 
  #(
  ''''MonticelloMocks'''')!!!!!!!!

MCClassDeclaration
  name: #MCMockClassD
  superclassName: #Object
  category: #''''MonticelloMocks''''
  instVarNames: #()
  comment: ''''''''!!!!!!!!

MCMethodDeclaration className: #MCMockClassD selector: #one category: #''''as yet unclassified'''' timeStamp: ''''cwp 7/8/2003 21:21'''' source: 
''''one
	^ 1''''!!!!!!!!
''''
''
!! !!
'! !

!MCStWriterTest methodsFor: 'data' stamp: 'GuillermoPolito 8/24/2012 14:04'!
expectedOrganizationDefinition
	^ 'SystemOrganization addCategory: #MonticelloMocks!!
'! !

!MCStWriterTest methodsFor: 'testing' stamp: 'pavel.krivanek 10/14/2010 16:41'!
testInitializerDefinition
	|chunk lastChunk penultChunk|
	writer writeSnapshot: self mockSnapshot.
	stream reset.
	[stream atEnd] whileFalse:
		[chunk := stream nextChunk.
		chunk isAllSeparators ifFalse: [
			penultChunk := lastChunk.
			lastChunk := chunk]].
	self assertContentsOf: penultChunk readStream match: self expectedInitializerA.
	self assertContentsOf: lastChunk readStream match: self expectedInitializerASubclass! !

!MCStWriterTest methodsFor: 'testing' stamp: 'pavel.krivanek 10/14/2010 16:43'!
expectedInitializerASubclass
	^ 'MCMockASubclass initialize'! !

!MCStWriterTest methodsFor: 'testing' stamp: 'ab 8/8/2003 17:01'!
expectedInitializerA
	^ 'MCMockClassA initialize'! !

!MCStWriterTest methodsFor: 'testing' stamp: 'VeronicaUquillas 8/23/2011 11:44'!
testMethodDefinitionWithBangs
	writer visitMethodDefinition: (RGMethodDefinition 
									realClass: self class
									selector: #methodWithBangs) asMCMethodDefinition.	
	self assertContentsOf: stream match: self expectedMethodDefinitionWithBangs.
	stream reset.
	self assert: stream nextChunk isAllSeparators.
	self assertChunkIsWellFormed: stream nextChunk.
	self assertMethodChunkIsWellFormed: stream nextChunk.
	self assert: stream nextChunk isAllSeparators ! !

!MCStWriterTest methodsFor: 'testing' stamp: 'cwp 8/10/2003 02:11'!
testClassDefinitionA
	writer visitClassDefinition: (self mockClassA asClassDefinition).
	self assertContentsOf: stream match: self expectedClassDefinitionA.
	stream reset.
	2 timesRepeat: [self assertChunkIsWellFormed: stream nextChunk]! !

!MCStWriterTest methodsFor: 'testing' stamp: 'EstebanLorenzano 9/12/2012 13:35'!
testOrganizationDefinition
	| definition |
	definition := MCOrganizationDefinition categories: 
					(self mockPackage packageSet systemCategories).
	writer visitOrganizationDefinition: definition.
	self assertContentsOf: stream match: self expectedOrganizationDefinition.
	self assertAllChunksAreWellFormed.! !

!MCStWriterTest methodsFor: 'data' stamp: 'cwp 8/2/2003 14:43'!
expectedClassMethodDefinition
	^ '
!!MCMockClassA class methodsFor: ''as yet unclassified'' stamp: ''ab 7/7/2003 23:21''!!
one

	^ 1!! !!
'! !

!MCStWriterTest methodsFor: 'data' stamp: 'abc 8/24/2012 16:10'!
expectedMethodDefinition
	^ '
!!MCMockClassA methodsFor: ''numeric'' stamp: ''GuillermoPolito 8/24/2012 15:22''!!
one
	^ 1!! !!
'! !

!MCSubDirectoryRepository commentStamp: 'nk 6/11/2004 18:56'!
A MCDirectoryRepository that looks in subdirectories too.!
!MCSubDirectoryRepository methodsFor: 'interface' stamp: 'StephaneDucasse 6/17/2012 18:52'!
loadAllFileNames
	"sorting {entry. dirName. name}"

	| sorted |
	sorted := SortedCollection sortBlock: [:a :b |
		a first modificationTime >= b first modificationTime ].
	self allDirectories
		do: [:dir | dir entries
				do: [:ent | ent isDirectory
						ifFalse: [sorted add: {ent. dir fullName. ent basename}]]].
	^ sorted
		collect: [:ea | ea third ]! !

!MCSubDirectoryRepository methodsFor: 'user interface' stamp: 'CamilloBruni 5/4/2012 19:04'!
description
	^ (directory / '*') fullName
! !

!MCSubDirectoryRepository methodsFor: 'i/o' stamp: 'nk 6/11/2004 20:34'!
writeStreamForFileNamed: aString replace: aBoolean do: aBlock 
	| file |
	file := aBoolean
				ifTrue: [FileStream
						forceNewFileNamed: (self findFullNameForReading: aString)]
				ifFalse: [FileStream
						newFileNamed: (self findFullNameForWriting: aString)].
	aBlock value: file.
	file close! !

!MCSubDirectoryRepository methodsFor: 'i/o' stamp: 'stephaneducasse 2/4/2006 20:47'!
readStreamForFileNamed: aString do: aBlock
	| file val |
	file := FileStream readOnlyFileNamed: (self findFullNameForReading: aString).
	val := aBlock value: file.
	file close.
	^ val! !

!MCSubDirectoryRepository methodsFor: 'enumeration' stamp: 'EstebanLorenzano 8/17/2012 13:12'!
allDirectories
	^directory allDirectories ! !

!MCSubDirectoryRepository methodsFor: 'i/o' stamp: 'SeanDeNigris 2/5/2013 15:35'!
splitNameVersionExtensionFor: aBaseName

	| file version |
	file := aBaseName asFileReference.
	version := (file extensions at: file extensions size - 1) asNumber.
	^ { file base. version. file extension }.
	
	
	! !

!MCSubDirectoryRepository methodsFor: 'i/o' stamp: 'TorstenBergmann 1/7/2015 14:52'!
findFullNameForWriting: aBaseName
	| possible split prefix fpattern now |
	split := self splitNameVersionExtensionFor: aBaseName.
	fpattern := split first, '*'.
	possible := SortedCollection sortBlock: [ :a :b |
		a first = b first
			ifTrue: [ a second = b second
					ifFalse: [ a second < b second ]
					ifTrue: [ a third fullName size < b third fullName size ]]
			ifFalse: [ a first > b first ] ].
	now := Time totalSeconds.
	prefix := directory pathSegments size.
	self allDirectories do: [:dir | | dirScore fileScore parts |
		parts := dir pathSegments allButFirst: prefix.
		dirScore := (parts select: [ :part | fpattern match: part ]) size.
		fileScore := (dir entries collect: [ :ent |
			(ent isDirectory not and: [ fpattern match: ent name ])
				ifFalse: [ SmallInteger maxVal ]
				ifTrue: [ now - ent modificationTime asSeconds ]]).	"minimum age"
		fileScore := fileScore isEmpty ifTrue: [ SmallInteger maxVal  ]
			ifFalse: [ fileScore min ].
		possible add: { dirScore. fileScore. dir } ].
	
	^ (possible first third) / aBaseName! !

!MCSubDirectoryRepository methodsFor: 'i/o' stamp: 'EstebanLorenzano 8/17/2012 13:43'!
findFullNameForReading: aBaseName
	"Answer the latest version of aBaseName"
	^((directory glob: [ :each | each basename = aBaseName])
		sorted: [ :a :b | a modificationTime < b modificationTime ])
		first.! !

!MCSubDirectoryRepository class methodsFor: 'user interface' stamp: 'nk 6/11/2004 18:48'!
description
	^ 'directory with subdirectories'! !

!MCSubDirectoryRepositoryTest commentStamp: '<historical>'!
I am not a subclass of MCRepositoryTest because my purpose was to show that a bug had been fixed and my author didn't feel like implementing all the reuirements of MCRepositoryTests!
!MCSubDirectoryRepositoryTest methodsFor: 'tests' stamp: 'SeanDeNigris 2/5/2013 15:43'!
testIssue7368
	"This is not a usage example. Hopefully the ugly private method under test will be refactored out of existence soon ;)"

	| collection |
	collection := MCSubDirectoryRepository new splitNameVersionExtensionFor: 'Spec-Core-AuthorName.120.mcz'.
	self assert: collection first equals: 'Spec-Core-AuthorName'.
	self assert: collection second equals: 120.
	self assert: collection third equals: 'mcz'.! !

!MCSystemCategoryParser commentStamp: '<historical>'!
A MCSystemCategoryParser extracts or set a category/protocol to the corresponding MCOrganizationDefinition.!
!MCSystemCategoryParser methodsFor: 'actions' stamp: 'StephaneDucasse 12/30/2012 17:34'!
addDefinitionsTo: aCollection
	| definition |
	definition := aCollection 
					detect: [:ea | ea isOrganizationDefinition ] 
					ifNone: [aCollection add: (MCOrganizationDefinition categories: #())].
	definition categories: (definition categories copyWith: self category).! !

!MCSystemCategoryParser methodsFor: 'accessing' stamp: 'MarcusDenker 5/18/2013 15:44'!
category
	| tokens  |
	tokens := source parseLiterals.
	tokens size = 3 ifFalse: [self error: 'Unrecognized category definition'].
	^ tokens at: 3! !

!MCSystemCategoryParser class methodsFor: 'factory identification hook' stamp: 'avi 3/10/2004 12:41'!
pattern
	^ 'SystemOrganization*'! !

!MCTestCase methodsFor: 'mocks' stamp: 'cwp 8/10/2003 16:53'!
commentStampForClass: name
	^ 'tester-', name,  ' 1/1/2000 00:00'! !

!MCTestCase methodsFor: 'mocks' stamp: 'GuillermoPolito 8/24/2012 13:48'!
mockExtensionMethodCategory
	^ '*MonticelloMocks'! !

!MCTestCase methodsFor: 'mocks' stamp: 'cwp 8/1/2003 20:27'!
mockPackage
	^ MCSnapshotResource mockPackage! !

!MCTestCase methodsFor: 'mocks' stamp: 'avi 1/19/2004 15:54'!
mockDependencies
	^ Array with: (MCVersionDependency package: self mockEmptyPackage info: (self mockVersionInfo: 'x'))! !

!MCTestCase methodsFor: 'mocks' stamp: 'ab 1/15/2003 17:55'!
mockToken: aSymbol
	^ MCMockDefinition token: aSymbol! !

!MCTestCase methodsFor: 'running' stamp: 'CamilloBruni 7/6/2012 16:21'!
runCase
	MCCacheRepository disableCacheDuring: [ ^ super runCase ].! !

!MCTestCase methodsFor: 'compiling' stamp: 'abc 2/16/2006 09:24'!
compileClass: aClass source: source category: category
	aClass compileSilently: source classified: category! !

!MCTestCase methodsFor: 'mocks' stamp: 'ab 4/1/2003 02:02'!
mockMethod: aSymbol class: className source: sourceString meta: aBoolean
	^ MCMethodDefinition
		className: className
		classIsMeta: aBoolean
		selector:  aSymbol
		category: 'as yet unclassified'
		timeStamp: ''
		source: sourceString! !

!MCTestCase methodsFor: 'mocks' stamp: 'lr 3/14/2010 21:13'!
mockClassA
	^ Smalltalk globals at: #MCMockClassA! !

!MCTestCase methodsFor: 'mocks' stamp: 'cwp 7/30/2003 19:23'!
mockVersion
	^ MCVersion 
		package: self mockPackage
		info: self mockVersionInfo
		snapshot: self mockSnapshot! !

!MCTestCase methodsFor: 'mocks' stamp: 'avi 1/19/2004 15:15'!
mockVersionWithDependencies
	^ MCVersion 
		package: self mockPackage
		info: self mockVersionInfo
		snapshot: self mockSnapshot
		dependencies: self mockDependencies! !

!MCTestCase methodsFor: 'mocks' stamp: 'avi 2/12/2004 19:58'!
mockVersionInfo
	^ self treeFrom: #(d ((b ((a))) (c)))! !

!MCTestCase methodsFor: 'mocks' stamp: 'cwp 8/10/2003 16:51'!
commentForClass: name
	^ 'This is a comment for ', name! !

!MCTestCase methodsFor: 'mocks' stamp: 'cwp 11/6/2004 16:03'!
mockVersionWithAncestor: aMCVersion 
	^ MCVersion
		package: self mockPackage
		info: (self mockVersionInfoWithAncestor: aMCVersion info)
		snapshot: self mockSnapshot! !

!MCTestCase methodsFor: 'mocks' stamp: 'MiguelCoba 7/25/2009 02:01'!
mockVersionInfo: tag 
	^ MCVersionInfo
		name: self mockVersionName, '-', tag asString
		id: UUID new
		message: self mockMessageString, '-', tag asString
		date: Date today
		time: Time now
		author: Author fullName
		ancestors: #()
! !

!MCTestCase methodsFor: 'mocks' stamp: 'cwp 11/13/2003 13:24'!
mockOverrideMethodCategory
	^ self mockExtensionMethodCategory, '-override'! !

!MCTestCase methodsFor: 'compiling' stamp: 'cwp 8/2/2003 15:05'!
restoreMocks
	self mockSnapshot updatePackage: self mockPackage! !

!MCTestCase methodsFor: 'mocks' stamp: 'cwp 8/10/2003 02:06'!
mockInstanceA
	^ self mockClassA new! !

!MCTestCase methodsFor: 'mocks' stamp: 'cwp 7/30/2003 19:24'!
mockMessageString
	^ 'A version generated for testing purposes.'! !

!MCTestCase methodsFor: 'mocks' stamp: 'GuillermoPolito 8/24/2012 12:57'!
mockCategoryName
	^ 'MonticelloMocks'! !

!MCTestCase methodsFor: 'asserting' stamp: 'cwp 8/8/2003 14:58'!
assertVersion: actual matches: expected
	self assertPackage: actual package matches: expected package.	
	self assertVersionInfo: actual info matches: expected info.
	self assertSnapshot: actual snapshot matches: expected snapshot.! !

!MCTestCase methodsFor: 'mocks' stamp: 'cwp 8/10/2003 16:50'!
mockClass: className super: superclassName
	^ MCClassDefinition
		name:  className
		superclassName:  superclassName
		category: self mockCategoryName
		instVarNames: #()
		classVarNames: #()
		poolDictionaryNames: #()
		classInstVarNames: #()
		type: #normal
		comment: (self commentForClass: className)
		commentStamp: (self commentStampForClass: className)! !

!MCTestCase methodsFor: 'asserting' stamp: 'stephaneducasse 2/4/2006 20:47'!
assertSnapshot: actual matches: expected
	| diff |
	diff := actual patchRelativeToBase: expected.
	self assert: diff isEmpty
! !

!MCTestCase methodsFor: 'mocks' stamp: 'MiguelCoba 7/25/2009 02:01'!
mockVersionInfoWithAncestor: aVersionInfo 
	^ MCVersionInfo
		name: aVersionInfo name, '-child'
		id: UUID new
		message: self mockMessageString
		date: Date today
		time: Time now
		author: Author fullName
		ancestors: {aVersionInfo}
! !

!MCTestCase methodsFor: 'mocks' stamp: 'stephaneducasse 2/4/2006 20:47'!
treeFrom: anArray
	| name id |
	name := anArray first.
	id := '00000000-0000-0000-0000-0000000000', (name asString size = 1 ifTrue: [name asString, '0'] ifFalse: [name asString]).
	^ MCVersionInfo
		name: name
		id: (UUID fromString: id)
		message: ''
		date: nil
		time: nil
		author: ''
		ancestors: (anArray size > 1 ifTrue: [(anArray second collect: [:ea | self treeFrom: ea])] ifFalse: [#()])! !

!MCTestCase methodsFor: 'mocks' stamp: 'cwp 7/14/2003 15:07'!
mockSnapshot
	^ MCSnapshotResource current snapshot! !

!MCTestCase methodsFor: 'asserting' stamp: 'cwp 8/8/2003 14:58'!
assertPackage: actual matches: expected
	self assert: actual = expected
! !

!MCTestCase methodsFor: 'mocks' stamp: 'cwp 7/30/2003 19:25'!
mockVersionName
	^ 'MonticelloTest-xxx.1'! !

!MCTestCase methodsFor: 'asserting' stamp: 'cwp 8/8/2003 15:50'!
assertVersionInfo: actual matches: expected
	self assert: actual name = expected name.
	self assert: actual message = expected message.
	self assert: actual ancestors size = expected ancestors size.
	actual ancestors with: expected ancestors do: [:a :e | self assertVersionInfo: a matches: e]
	! !

!MCTestCase methodsFor: 'mocks' stamp: 'lr 3/14/2010 21:13'!
mockClassB
	^ Smalltalk globals at: #MCMockClassB! !

!MCTestCase methodsFor: 'compiling' stamp: 'cwp 8/10/2003 02:12'!
change: aSelector toReturn: anObject
	self 
		compileClass: self mockClassA 
		source: aSelector, ' ^ ', anObject printString 
		category: 'numeric'! !

!MCTestCase methodsFor: 'mocks' stamp: 'EstebanLorenzano 7/21/2014 15:07'!
mockEmptyPackage
	^ MCPackage named: 'Mock empty package'! !

!MCTestCase class methodsFor: 'as yet unclassified' stamp: 'cwp 7/14/2003 15:12'!
isAbstract
	^ self = MCTestCase! !

!MCTestCase class methodsFor: 'as yet unclassified' stamp: 'cwp 7/14/2003 15:05'!
resources
	^ Array with: MCSnapshotResource! !

!MCTestCase class methodsFor: 'testing' stamp: 'JorgeRessia 3/16/2010 20:23'!
isUnitTest
	^false! !

!MCThreeWayMerger commentStamp: '<historical>'!
A MCThreeWayMerger is more advanced merge operation.
Operations are subclasses of MCPatchOperation:  addition (MCAddition), modification of an entity (MCModification ) and removal (MCRemoval).
!
!MCThreeWayMerger methodsFor: 'accessing' stamp: 'avi 10/6/2004 15:19'!
provisions
	^ provisions! !

!MCThreeWayMerger methodsFor: 'operations' stamp: 'ab 6/2/2003 01:30'!
addOperation: anOperation
	self operations add: anOperation! !

!MCThreeWayMerger methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
operations
	^ operations ifNil: [operations := OrderedCollection new]! !

!MCThreeWayMerger methodsFor: 'operations' stamp: 'StephaneDucasse 6/24/2011 15:12'!
removeDefinition: aDefinition
	index
		definitionLike: aDefinition
		ifPresent: [:other | 
			other = aDefinition
				ifTrue: [(self modificationConflictForDefinition: aDefinition)
							ifNotNil: [:c |
									c beNonConflict.
									^ self]. 
						(self redundantAdds includes: aDefinition)
							ifFalse: [self addOperation: (MCRemoval of: aDefinition)]]
				ifFalse: [self addConflictWithOperation: (MCRemoval of: other)]]
		ifAbsent: []! !

!MCThreeWayMerger methodsFor: 'operations' stamp: 'StephaneDucasse 6/24/2011 15:10'!
modificationConflictForDefinition: aDefinition
	^ self conflicts 
		detect: [:ea |
			(ea definition isRevisionOf: aDefinition) and:
				[ea operation isModification]] 
		ifNone: []! !

!MCThreeWayMerger methodsFor: 'operations' stamp: 'marcus.denker 11/10/2008 10:04'!
addDefinition: aDefinition
	index
		definitionLike: aDefinition
		ifPresent: [:other |
			(self removalForDefinition: aDefinition)
				ifNotNil:
					[:op |
					self addOperation: (MCModification of: other to: aDefinition).
					self removeOperation: op.
					^ self].
			other = aDefinition
				ifFalse: [self addConflictWithOperation: (MCModification of: other to: aDefinition)]
				ifTrue: [self redundantAdds add: aDefinition]]
		ifAbsent: [self addOperation: (MCAddition of: aDefinition)]! !

!MCThreeWayMerger methodsFor: 'operations' stamp: 'avi 9/19/2005 02:40'!
removalForDefinition: aDefinition
	^ operations ifNotNil:
		[operations
			detect: [:ea | (ea definition isRevisionOf: aDefinition) and: [ea isRemoval]]
			ifNone: []]! !

!MCThreeWayMerger methodsFor: 'operations' stamp: 'avi 2/13/2004 01:49'!
baseSnapshot
	^ (MCSnapshot fromDefinitions: index definitions)! !

!MCThreeWayMerger methodsFor: 'operations' stamp: 'avi 2/13/2004 01:52'!
applyPatch: aPatch
	aPatch applyTo: self! !

!MCThreeWayMerger methodsFor: 'operations' stamp: 'avi 9/19/2005 02:40'!
removeOperation: anOperation
	operations remove: anOperation! !

!MCThreeWayMerger methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 10:04'!
initialize
	super initialize.
	index := MCDefinitionIndex new.
	provisions := Set new! !

!MCThreeWayMerger methodsFor: 'operations' stamp: 'avi 10/6/2004 15:18'!
addBaseSnapshot: aSnapshot
	aSnapshot definitions do:
		[:ea |
		index add: ea.
		provisions addAll: ea provisions]! !

!MCThreeWayMerger methodsFor: 'operations' stamp: 'stephaneducasse 2/4/2006 20:47'!
redundantAdds
	^ redundantAdds ifNil: [redundantAdds := Set new]! !

!MCThreeWayMerger methodsFor: 'operations' stamp: 'StephaneDucasse 6/24/2011 14:40'!
modifyDefinition: baseDefinition to: targetDefinition
	index
		definitionLike: baseDefinition
		ifPresent: [:other | 
			other = baseDefinition
				ifTrue: [self addOperation: (MCModification of:  baseDefinition to: targetDefinition)]
				ifFalse: [other = targetDefinition
							ifFalse: [self addConflictWithOperation:
											(MCModification of: other to: targetDefinition)]]]
		ifAbsent: [self addConflictWithOperation: (MCAddition of: targetDefinition)]! !

!MCThreeWayMerger class methodsFor: 'instance-creation' stamp: 'avi 2/13/2004 01:53'!
base: aSnapshot patch: aPatch
	aPatch isEmpty ifTrue: [MCNoChangesException signal].
	^ self new
		addBaseSnapshot: aSnapshot;
		applyPatch: aPatch;
		yourself
		! !

!MCThreeWayMerger class methodsFor: 'instance-creation' stamp: 'ab 6/2/2003 01:09'!
base: aSnapshot target: targetSnapshot ancestor: ancestorSnapshot
	^ self base: aSnapshot patch: (targetSnapshot patchRelativeToBase: ancestorSnapshot)! !

!MCTool commentStamp: 'TorstenBergmann 2/20/2014 15:51'!
Common superclass for Monticello tools!
!MCTool methodsFor: 'morphic ui' stamp: 'nk 2/16/2004 16:50'!
arrowKey: aCharacter from: aPluggableListMorph 
	"backstop"! !

!MCTool methodsFor: 'morphic ui' stamp: 'stephaneducasse 2/4/2006 20:47'!
window
	^ morph ifNil: [morph := self buildWindow]! !

!MCTool methodsFor: 'morphic ui' stamp: 'ab 7/18/2003 17:42'!
close
	self window delete! !

!MCTool methodsFor: 'utils' stamp: 'StephaneDucasse 6/2/2012 20:34'!
allManagers

	^ MCWorkingCopy allManagers ! !

!MCTool methodsFor: 'morphic ui' stamp: 'TorstenBergmann 11/4/2014 17:48'!
listMorph: listSymbol selection: selectionSymbol menu: menuSymbol icon: iconSelector
	^ (PluggableIconListMorph
		on: self
		list: listSymbol
		selected: selectionSymbol
		changeSelected: (selectionSymbol, ':') asSymbol
		menu: menuSymbol)
			getIconSelector: iconSelector;
			yourself! !

!MCTool methodsFor: 'morphic ui' stamp: 'ab 7/17/2003 15:10'!
defaultExtent
	^ 500@500! !

!MCTool methodsFor: 'morphic ui' stamp: 'nk 2/16/2004 17:03'!
listMorph: listSymbol keystroke: keystrokeSymbol
	^ (self
		listMorph: (listSymbol, 'List') asSymbol
		selection: (listSymbol, 'Selection') asSymbol
		menu: (listSymbol, 'ListMenu:') asSymbol)
		keystrokeActionSelector: keystrokeSymbol;
		yourself! !

!MCTool methodsFor: 'morphic ui' stamp: 'StephaneDucasse 12/19/2012 16:51'!
buildWindow
	| window |
	window := SystemWindow labelled: self label.
	window model: self.
	self widgetSpecs do: [:spec |
		| send fractions offsets |
		send := spec first.
		fractions := spec at: 2 ifAbsent: [#(0 0 1 1)].
		offsets := spec at: 3 ifAbsent: [#(0 0 0 0)].
		window
			addMorph: (self perform: send first withArguments: send allButFirst)
			fullFrame:
				(LayoutFrame new 
					leftFraction: fractions first; 
					topFraction: fractions second;
					rightFraction: fractions third ; 
					bottomFraction: fractions fourth; 
					leftOffset: offsets first;
					topOffset: offsets second;
					rightOffset: offsets third;
					bottomOffset: offsets fourth)].
	^ window! !

!MCTool methodsFor: 'morphic ui' stamp: 'MarcusDenker 7/9/2014 15:57'!
showModally
	modal := true.
	self window openInWorldExtent: 400 @ 400.
	self setDefaultFocus.
	[ self window world notNil ] whileTrue: [ self window outermostWorldMorph doOneCycle ].
	morph := nil.
	^ modalValue! !

!MCTool methodsFor: 'opening' stamp: 'CamilloBruni 2/4/2012 12:25'!
showLabelled: labelString
	
	modal := false.
	self label: labelString.
	self window openInWorldExtent: self defaultExtent.
	self setDefaultFocus.
	^ self window.! !

!MCTool methodsFor: 'morphic ui' stamp: 'AlainPlantec 12/19/2009 21:32'!
defaultAnnotationPaneHeight 
	"Answer the receiver's preferred default height for new annotation panes."
	^ 25! !

!MCTool methodsFor: 'morphic ui' stamp: 'lr 7/28/2011 16:24'!
buttonState
	^ false! !

!MCTool methodsFor: 'morphic ui' stamp: 'ab 7/17/2003 15:23'!
buttonSpecs
	^ #()! !

!MCTool methodsFor: 'opening' stamp: 'CamilloBruni 2/4/2012 12:25'!
show
	"Open the tool returning the window."

	modal := false.
	self window openInWorldExtent: self defaultExtent.
	self setDefaultFocus.
	^ self window! !

!MCTool methodsFor: 'morphic ui' stamp: 'ab 8/24/2003 20:15'!
findTextMorph: aSymbol
	^ morph submorphs detect: [:ea | (ea respondsTo: #getTextSelector) and: [ea getTextSelector = aSymbol]] ifNone: []! !

!MCTool methodsFor: 'morphic ui' stamp: 'ar 2/14/2004 02:27'!
treeMorph: listSymbol
	^ self
		treeMorph: (listSymbol, 'Tree') asSymbol
		selection: (listSymbol, 'SelectionWrapper') asSymbol
		menu: (listSymbol, 'TreeMenu:') asSymbol! !

!MCTool methodsFor: 'morphic ui' stamp: 'ab 7/17/2003 15:40'!
widgetSpecs
	^ #()! !

!MCTool methodsFor: 'morphic ui' stamp: 'stephaneducasse 2/4/2006 20:47'!
label: aString
	label := aString! !

!MCTool methodsFor: '*Shout-Styling' stamp: 'AlainPlantec 8/27/2011 15:59'!
shoutAboutToStyle: aPluggableShoutMorphOrView
	^ false! !

!MCTool methodsFor: 'morphic ui' stamp: 'nk 2/16/2004 16:50'!
listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: keystrokeSymbol
	^ (PluggableListMorph
		on: self
		list: listSymbol
		selected: selectionSymbol
		changeSelected: (selectionSymbol, ':') asSymbol
		menu: menuSymbol)
		keystrokeActionSelector: keystrokeSymbol;
		yourself! !

!MCTool methodsFor: 'morphic ui' stamp: 'StephaneDucasse 2/20/2010 21:58'!
initialExtent

	^ 580@200! !

!MCTool methodsFor: 'morphic ui' stamp: 'stephaneducasse 2/4/2006 20:47'!
answer: anObject
	modalValue := anObject.
	self close.! !

!MCTool methodsFor: 'morphic ui' stamp: 'bf 5/27/2005 19:22'!
buttonSelected
	^ false! !

!MCTool methodsFor: 'morphic ui' stamp: 'AlainPlantec 12/16/2009 22:11'!
preferredColor  
	^ (Color r: 0.627 g: 0.69 b: 0.976)! !

!MCTool methodsFor: 'morphic ui' stamp: 'ab 7/18/2003 17:23'!
getMenu: aMenu
	^aMenu! !

!MCTool methodsFor: 'morphic ui' stamp: 'ab 7/17/2003 15:46'!
listMorph: listSymbol selection: selectionSymbol menu: menuSymbol
	^ PluggableListMorph
		on: self
		list: listSymbol
		selected: selectionSymbol
		changeSelected: (selectionSymbol, ':') asSymbol
		menu: menuSymbol! !

!MCTool methodsFor: 'morphic ui' stamp: 'MarcusDenker 9/23/2011 10:01'!
multiListMorph: listSymbol selection: selectionSymbol listSelection: listSelectionSymbol menu: menuSymbol
	^ PluggableListMorph
		on: self
		list: listSymbol
		primarySelection: selectionSymbol
		changePrimarySelection: (selectionSymbol, ':') asSymbol
		listSelection: listSelectionSymbol
		changeListSelection: (listSelectionSymbol, 'put:') asSymbol
		menu: menuSymbol! !

!MCTool methodsFor: 'morphic ui' stamp: 'bf 3/16/2005 14:48'!
findListMorph: aSymbol
	^ morph submorphs detect: [:ea | (ea respondsTo: #getListSelector) and: [ea getListSelector = aSymbol]] ifNone: []! !

!MCTool methodsFor: 'morphic ui' stamp: 'lr 10/5/2003 09:09'!
performButtonAction: anActionSelector enabled: anEnabledSelector
	(self perform: anEnabledSelector) 
		ifTrue: [ self perform: anActionSelector ]! !

!MCTool methodsFor: 'morphic ui' stamp: 'ab 7/17/2003 15:36'!
textMorph: aSymbol
	^ PluggableTextMorph on: self text: aSymbol accept: (aSymbol, ':') asSymbol! !

!MCTool methodsFor: 'morphic ui' stamp: 'lr 7/28/2011 16:23'!
buttonRow: specArray
	| aRow |
	aRow := PanelMorph new.
	aRow layoutPolicy: TableLayout new; listDirection: #leftToRight.
	aRow hResizing: #spaceFill; vResizing: #spaceFill; rubberBandCells: true.
	aRow clipSubmorphs: true; borderWidth: 0.
	aRow layoutInset: 2@2; cellInset: 1.
	aRow wrapCentering: #center; cellPositioning: #leftCenter.
	specArray do:
		[:triplet | | aButton state |
			state := triplet at: 5 ifAbsent: [#buttonState].
			aButton := PluggableButtonMorph
				on: self
				getState: state
				action: #performButtonAction:enabled:.
			aButton
				hResizing: #spaceFill;
				vResizing: #spaceFill;
				label: triplet first asString;
				getEnabledSelector: (triplet at: 4 ifAbsent: [#buttonEnabled]);
				arguments: (Array with: triplet second with: (triplet at: 4 ifAbsent: [#buttonEnabled])).
			aRow addMorphBack: aButton.
			aButton setBalloonText: triplet third].
	^ aRow! !

!MCTool methodsFor: 'morphic ui' stamp: 'ar 2/14/2004 02:43'!
treeMorph: listSymbol selection: selectionSymbol menu: menuSymbol
	^ SimpleHierarchicalListMorph
		on: self
		list: listSymbol
		selected: selectionSymbol
		changeSelected: (selectionSymbol, ':') asSymbol
		menu: menuSymbol
		keystroke: nil! !

!MCTool methodsFor: 'accessing' stamp: 'gvc 5/11/2006 11:13'!
minimumExtent
	"Answer the minumum extent for the tool."
	
	^100@100! !

!MCTool methodsFor: 'morphic ui' stamp: 'ab 7/18/2003 17:36'!
label
	^ label ifNil: [self defaultLabel]! !

!MCTool methodsFor: 'morphic ui' stamp: 'ab 7/18/2003 18:34'!
buttonRow
	^ self buttonRow: self buttonSpecs! !

!MCTool methodsFor: 'morphic ui' stamp: 'CamilloBruni 2/4/2012 12:27'!
setDefaultFocus
	"set the default focus on the morph elements.
	specializ this in subclasses"! !

!MCTool methodsFor: 'morphic ui' stamp: 'bf 5/27/2005 19:19'!
buttonEnabled
	^ true! !

!MCTool methodsFor: 'morphic ui' stamp: 'ab 7/17/2003 15:46'!
listMorph: listSymbol selection: selectionSymbol
	^ PluggableListMorph
		on: self
		list: listSymbol
		selected: selectionSymbol
		changeSelected: (selectionSymbol, ':') asSymbol! !

!MCTool methodsFor: 'morphic ui' stamp: 'ab 7/19/2003 22:33'!
fillMenu: aMenu fromSpecs: anArray
	anArray do:
		[:pair |
		aMenu add: pair first target: self selector: pair second].
	^ aMenu! !

!MCTool methodsFor: 'morphic ui' stamp: 'lr 9/26/2003 17:30'!
listMorph: listSymbol
	^ self
		listMorph: (listSymbol, 'List') asSymbol
		selection: (listSymbol, 'Selection') asSymbol
		menu: (listSymbol, 'ListMenu:') asSymbol! !

!MCTool class methodsFor: 'window color' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
theme
	"Answer the ui theme that provides controls."

	^ Smalltalk ui theme ! !

!MCTraitDefinition commentStamp: '<historical>'!
A MCTraitDefinition represents a trait.!
!MCTraitDefinition methodsFor: '*Ring-Monticello' stamp: 'VeronicaUquillas 8/4/2011 12:11'!
printMetaDefinitionOn: stream

	stream nextPutAll: self className, ' classTrait'; 
		 crtab;
		 nextPutAll: 'uses: ';
		 nextPutAll: self classTraitCompositionString.! !

!MCTraitDefinition methodsFor: 'comparing' stamp: 'al 6/5/2006 14:14'!
hash
	| hash |
	hash := String stringHash: name initialHash: 0.
	hash := String stringHash: self traitCompositionString initialHash: hash.
	hash := String stringHash: (category ifNil: ['']) initialHash: hash.
	^ hash
! !

!MCTraitDefinition methodsFor: 'printing' stamp: 'MartinDias 3/5/2014 18:49'!
printClassDefinitionOn: stream

	^ self printMetaDefinitionOn: stream! !

!MCTraitDefinition methodsFor: 'printing' stamp: 'al 6/5/2006 14:15'!
printDefinitionOn: stream
	stream nextPutAll: 'Trait named: #', self className;
		 cr;
		 tab;
		 nextPutAll: 'uses: ';
		 nextPutAll: self traitCompositionString;
		 cr;
		 tab;
		 nextPutAll: 'category: ';
		 store: self category asString
! !

!MCTraitDefinition methodsFor: 'comparing' stamp: 'MarcusDenker 1/12/2015 15:37'!
requirements
	"Assuming that traits in a composition can be identified by
	testing for the first character beeing an uppercase character
	(and thus not a special character such as {, # etc.)"

	| tokens traitNames |
	self hasTraitComposition ifFalse: [ ^Array new ].
	tokens := traitComposition parseLiterals.
	traitNames := tokens select: [:each | each first isUppercase].
	^traitNames asArray! !

!MCTraitDefinition methodsFor: 'testing' stamp: 'al 10/9/2005 20:28'!
hasClassInstanceVariables
	^ false

! !

!MCTraitDefinition methodsFor: 'initializing' stamp: 'al 6/5/2006 14:14'!
initializeWithName: classNameString 
	traitComposition:  traitCompositionString
	category:  categoryString
	comment:  commentString  
	commentStamp:   commentStampString
					
		name := classNameString asSymbol.
		traitComposition := traitCompositionString.
	     category := categoryString.
		comment := commentString withSqueakLineEndings.
		commentStamp :=  commentStampString ifNil: [self defaultCommentStamp]
! !

!MCTraitDefinition methodsFor: 'comparing' stamp: 'nice 10/31/2009 13:10'!
= aDefinition
	self flag: #traits. "Ugly we harcoded the super superclass method.  We will have to refactor the definition hierarchy"
	
	^ (aDefinition isKindOf: MCDefinition)
		and: [(self isRevisionOf: aDefinition)
		and: [self traitCompositionString = aDefinition traitCompositionString
		and: [category = aDefinition category
		and: [comment = aDefinition comment]]]]! !

!MCTraitDefinition methodsFor: 'visiting' stamp: 'al 10/9/2005 20:28'!
accept: aVisitor
	^ aVisitor visitTraitDefinition: self
! !

!MCTraitDefinition methodsFor: '*Ring-Monticello' stamp: 'MarcusDenker 7/30/2014 10:15'!
asRingDefinition

	| ring |
	ring := ( RGTraitDefinition named: self className)
		category: self category;
		superclassName: self superclassName;  
		traitCompositionSource: self traitCompositionString;
		comment: self comment;
		stamp: self commentStamp;
		definitionSource: self definitionString;
		withMetaclass.
		
	ring theMetaClass 
		traitCompositionSource: self classTraitCompositionString;
		definitionSource: self classDefinitionString.
	^ring! !

!MCTraitDefinition methodsFor: '*Ring-Monticello' stamp: 'MarcusDenker 5/18/2013 15:44'!
classTraitCompositionString
	^self traitComposition 
		ifNil: [ '{}' ]
		ifNotNil: [ :source| | tokens tcs |
			tcs := ''.
			tokens := source parseLiterals.
			tokens do:[ :each| 
				each first isUppercase 
					ifTrue: [ tcs := tcs, each, ' classTrait + ' ] ].
			tcs isEmpty 
				ifTrue: [ '{}' ]
				ifFalse:[ tcs copyFrom: 1 to: tcs size - 3 ] ]! !

!MCTraitDefinition methodsFor: 'installing' stamp: 'MarcusDenker 1/25/2015 09:15'!
createClass
	| trait |
	trait := Trait
		named: name
		uses: (Smalltalk compiler evaluate: self traitCompositionString)
		category: category.
	trait ifNotNil: [trait classComment: comment stamp: commentStamp].
	^trait! !

!MCTraitDefinition methodsFor: '*Ring-Monticello' stamp: 'VeronicaUquillas 8/4/2011 11:53'!
classDefinitionString
	"Answer a string describing the class-side definition."
	
	^String streamContents: [:stream | self printMetaDefinitionOn: stream]! !

!MCTraitDefinition class methodsFor: 'instance-creation' stamp: 'al 10/9/2005 20:28'!
name: classNameString traitComposition:  traitCompositionString category:  categoryString comment:  commentString commentStamp:   commentStamp
	^ self instanceLike:
		(self new initializeWithName: classNameString 
			traitComposition:  traitCompositionString
			category:  categoryString
			comment:  commentString  
			commentStamp:   commentStamp)
! !

!MCTraitParser commentStamp: '<historical>'!
A MCTraitParser extracts an MCTraitDefinition from the source.!
!MCTraitParser methodsFor: 'actions' stamp: 'MarcusDenker 5/18/2013 15:44'!
addDefinitionsTo: aCollection
	| tokens  definition traitCompositionString |
	tokens := source parseLiterals.
	traitCompositionString := (source readStream
		match: 'uses:';
		upToAll: 'category:') trimBoth.
	definition := MCTraitDefinition
		name: (tokens at: 3) 
		traitComposition: traitCompositionString
		category:  tokens last
		comment:  ''  
		commentStamp:   ''.
	aCollection add: definition.! !

!MCTraitParser class methodsFor: 'factory identification hook' stamp: 'al 10/9/2005 21:09'!
pattern
	^ 'Trait named:*'! !

!MCVariableDefinition commentStamp: '<historical>'!
A MCVariableDefinition represents a variable.!
!MCVariableDefinition methodsFor: 'comparing' stamp: 'cwp 7/7/2003 23:02'!
hash
	^ name hash! !

!MCVariableDefinition methodsFor: 'comparing' stamp: 'cwp 7/7/2003 23:02'!
= other
	^ (self species = other species)
		and: [self name = other name]! !

!MCVariableDefinition methodsFor: 'testing' stamp: 'cwp 7/7/2003 23:51'!
isPoolImport
	^ false! !

!MCVariableDefinition methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
name: aString
	name := aString! !

!MCVariableDefinition methodsFor: 'testing' stamp: 'cwp 7/7/2003 23:31'!
isClassInstanceVariable
	^ false! !

!MCVariableDefinition methodsFor: 'printing' stamp: 'nk 7/24/2003 14:56'!
printOn: aStream
	super printOn: aStream.
	aStream nextPut: $(; nextPutAll: self name; nextPut: $)! !

!MCVariableDefinition methodsFor: 'testing' stamp: 'cwp 7/7/2003 23:10'!
isInstanceVariableDefinition
	^ false! !

!MCVariableDefinition methodsFor: 'testing' stamp: 'bf 8/29/2006 11:41'!
isOrderDependend
	^true! !

!MCVariableDefinition methodsFor: 'testing' stamp: 'cwp 7/7/2003 23:08'!
isClassInstanceVariableDefinition
	^ false! !

!MCVariableDefinition methodsFor: 'testing' stamp: 'cwp 7/7/2003 23:30'!
isClassVariable
	^ false! !

!MCVariableDefinition methodsFor: 'accessing' stamp: 'cwp 11/25/2002 05:57'!
name
	^ name! !

!MCVariableDefinition methodsFor: 'testing' stamp: 'cwp 7/7/2003 23:31'!
isInstanceVariable
	^ false! !

!MCVariableDefinition class methodsFor: 'instance-creation' stamp: 'cwp 7/7/2003 23:18'!
name: aString
	^ self new name: aString
	! !

!MCVersion commentStamp: 'TorstenBergmann 2/5/2014 13:56'!
A Metacello version!
!MCVersion methodsFor: 'enumerating' stamp: 'nice 1/5/2010 15:59'!
allDependenciesNotIn: aDictionary do: aBlock ifUnresolved: failBlock
	
	self dependencies do: 
		[:ea | | version | 
		version := aDictionary at: ea ifAbsent: [ea resolve].
		version 
			ifNil: [failBlock value: ea]
			ifNotNil: [(aDictionary includes: version) ifFalse:
						[aDictionary at: ea put: version.
						version 
							allDependenciesNotIn: aDictionary 
							do: aBlock
							ifUnresolved: failBlock.
						aBlock value: version]]]! !

!MCVersion methodsFor: 'accessing' stamp: 'CamilloBruni 9/30/2011 16:18'!
changes
	^ self completeSnapshot patchRelativeToBase: self completePackageSnapshot! !

!MCVersion methodsFor: 'accessing' stamp: 'avi 2/12/2004 19:38'!
workingCopy
	^ package workingCopy! !

!MCVersion methodsFor: '*Komitter-Models' stamp: 'BenjaminVanRyseghem 11/26/2013 14:39'!
silentlyInitializeWithPackage: aPackage info: aVersionInfo snapshot: aSnapshot dependencies: aCollection

	package := aPackage.
	info := aVersionInfo.
	snapshot := aSnapshot.
	dependencies := aCollection! !

!MCVersion methodsFor: 'actions' stamp: 'avi 2/12/2004 19:37'!
adopt
	self workingCopy adopt: self! !

!MCVersion methodsFor: 'initialization' stamp: 'stephaneducasse 2/4/2006 20:47'!
initializeWithPackage: aPackage info: aVersionInfo snapshot: aSnapshot dependencies: aCollection
	package := aPackage.
	info := aVersionInfo.
	snapshot := aSnapshot.
	dependencies := aCollection.
	self addToCache.! !

!MCVersion methodsFor: 'accessing' stamp: 'nice 4/7/2014 22:06'!
completePackageSnapshot
	"Answer with a snapshot of current working copy of this package and all its dependencies."
	^self loadCompletePackageSnapshot! !

!MCVersion methodsFor: 'testing' stamp: 'bf 5/23/2005 15:43'!
canOptimizeLoading
	"Answer wether I can provide a patch for the working copy without the usual diff pass"
	^false! !

!MCVersion methodsFor: 'accessing' stamp: 'CamilloBruni 9/30/2011 16:12'!
loadCompleteSnapshot
	|definitions|
	
	definitions := self snapshot definitions asOrderedCollection.
	
	self dependencies 
		do: [ :each| definitions addAll: each resolve completeSnapshot definitions ]
		displayingProgress: [ :item| 'Loading dependencies from: ', item package name ].
	
	^ MCSnapshot fromDefinitions: definitions! !

!MCVersion methodsFor: 'actions' stamp: 'SeanDeNigris 7/17/2012 15:40'!
addToCache
	MCCacheRepository uniqueInstance storeVersion: self! !

!MCVersion methodsFor: '*MonticelloGUI' stamp: 'BenjaminVanRyseghem 2/8/2012 17:10'!
browse

	^ (MCSnapshotBrowser forSnapshot: self completeSnapshot)
		showLabelled: 'Snapshot of ', self fileName! !

!MCVersion methodsFor: 'actions' stamp: 'avi 1/22/2004 12:44'!
fileOutOn: aStream
	self writerClass fileOut: self on: aStream! !

!MCVersion methodsFor: 'initialization' stamp: 'stephaneducasse 2/4/2006 20:47'!
setPackage: aPackage info: aVersionInfo snapshot: aSnapshot dependencies: aCollection
	package := aPackage.
	info := aVersionInfo.
	snapshot := aSnapshot.
	dependencies := aCollection! !

!MCVersion methodsFor: 'accessing' stamp: 'avi 1/22/2004 12:44'!
fileName
	^ info name, '.', self writerClass extension! !

!MCVersion methodsFor: 'accessing' stamp: 'ab 7/7/2003 14:19'!
package
	^ package! !

!MCVersion methodsFor: 'enumerating' stamp: 'cwp 11/7/2004 14:24'!
withAllDependenciesDo: aBlock
	self allDependenciesDo: aBlock ifUnresolved: [:ignored].
	aBlock value: self! !

!MCVersion methodsFor: 'actions' stamp: 'avi 1/24/2004 20:13'!
load
	MCVersionLoader loadVersion: self! !

!MCVersion methodsFor: 'printing' stamp: 'nk 3/8/2004 23:54'!
printOn: aStream
	super printOn: aStream.
	aStream nextPut: $(.
	aStream nextPutAll: self info name.
	aStream nextPut: $).! !

!MCVersion methodsFor: 'actions' stamp: 'abc 2/13/2004 15:58'!
merge
	MCVersionMerger mergeVersion: self! !

!MCVersion methodsFor: 'converting' stamp: 'avi 2/19/2004 21:00'!
asDiffAgainst: aVersion
	aVersion info = self info ifTrue: [self error: 'Cannot diff against self!!'].
	^ MCDiffyVersion
		package: self package
		info: self info
		snapshot: self snapshot
		dependencies: self dependencies
		baseVersion: aVersion! !

!MCVersion methodsFor: 'enumerating' stamp: 'stephaneducasse 2/4/2006 20:47'!
allDependenciesDo: aBlock ifUnresolved: failBlock
	| dict |
	dict := Dictionary new.
	self allDependenciesNotIn: dict do: aBlock ifUnresolved: failBlock! !

!MCVersion methodsFor: 'accessing' stamp: 'avi 1/22/2004 12:44'!
writerClass
	^ MCMczWriter ! !

!MCVersion methodsFor: 'accessing' stamp: 'CamilloBruni 9/30/2011 16:08'!
completeSnapshot
	^ completeSnapshot ifNil: [ completeSnapshot := self loadCompleteSnapshot ]! !

!MCVersion methodsFor: 'enumerating' stamp: 'cwp 11/7/2004 11:58'!
allDependenciesDo: aBlock
	self allDependenciesDo: aBlock ifUnresolved: [:ignored | true]! !

!MCVersion methodsFor: 'testing' stamp: 'avi 2/13/2004 23:24'!
isDiffy
	^ false! !

!MCVersion methodsFor: 'accessing' stamp: 'adrian_lienhard 1/7/2009 17:32'!
summary
	^ String streamContents:
		[:s |
		s nextPutAll: info summaryHeader.
		(dependencies isNil or: [dependencies isEmpty]) ifFalse:
			[s cr; nextPutAll: 'Dependencies: '.
			dependencies
				do: [:ea | s nextPutAll: ea versionInfo name]
				separatedBy: [s nextPutAll: ', ']].
		s cr; cr; nextPutAll: info message]! !

!MCVersion methodsFor: 'testing' stamp: 'bf 3/22/2005 23:00'!
isCacheable
	^true! !

!MCVersion methodsFor: 'enumerating' stamp: 'stephaneducasse 2/4/2006 20:47'!
withAllDependenciesDo: aBlock ifUnresolved: failBlock
	| dict |
	dict := Dictionary new.
	self allDependenciesNotIn: dict do: aBlock ifUnresolved: failBlock.
	aBlock value: self! !

!MCVersion methodsFor: 'enumerating' stamp: 'nice 1/5/2010 15:59'!
allAvailableDependenciesDo: aBlock
	
	self dependencies do:
		[:ea |
		[ | version |version := ea resolve.
		version allAvailableDependenciesDo: aBlock.
		aBlock value: version]
			on: Error do: []]! !

!MCVersion methodsFor: 'accessing' stamp: 'CamilloBruni 4/20/2012 18:21'!
snapshot
	"lazily load snapshot..."
	snapshot isBlock ifTrue: [ 
		snapshot := snapshot value ].
	^ snapshot! !

!MCVersion methodsFor: 'accessing' stamp: 'ab 7/7/2003 14:28'!
info
	^ info! !

!MCVersion methodsFor: '*MonticelloGUI' stamp: 'ab 7/12/2003 00:19'!
open
	(MCVersionInspector new version: self) show! !

!MCVersion methodsFor: 'accessing' stamp: 'avi 1/22/2004 00:24'!
dependencies
	^ dependencies ifNil: [#()]! !

!MCVersion methodsFor: 'accessing' stamp: 'CamilloBruni 9/30/2011 16:20'!
loadCompletePackageSnapshot
	| definitions |
	definitions := package snapshot definitions asOrderedCollection.
	
	self dependencies 
		do: [ :each| definitions addAll: each package snapshot definitions ]
		displayingProgress: [ :item| 'Loading dependencies from: ', item package name ].
	
	^ MCSnapshot fromDefinitions: definitions
	
	! !

!MCVersion class methodsFor: 'instance creation' stamp: 'ab 7/7/2003 16:13'!
package: aPackage info: aVersionInfo
	^ self package: aPackage info: aVersionInfo snapshot: aPackage snapshot! !

!MCVersion class methodsFor: '*Komitter-Models' stamp: 'BenjaminVanRyseghem 11/26/2013 14:39'!
silentlyPackage: aPackage info: aVersionInfo snapshot: aSnapshot dependencies: aCollection

	^ self new silentlyInitializeWithPackage: aPackage info: aVersionInfo snapshot: aSnapshot dependencies: aCollection! !

!MCVersion class methodsFor: 'instance creation' stamp: 'cwp 11/7/2004 13:02'!
package: aPackage info: aVersionInfo snapshot: aSnapshot
	^ self package: aPackage info: aVersionInfo snapshot: aSnapshot dependencies: #()! !

!MCVersion class methodsFor: 'instance creation' stamp: 'avi 1/19/2004 13:11'!
package: aPackage info: aVersionInfo snapshot: aSnapshot dependencies: aCollection
	^ self new initializeWithPackage: aPackage info: aVersionInfo snapshot: aSnapshot dependencies: aCollection! !

!MCVersion class methodsFor: 'instance creation' stamp: 'ab 7/7/2003 16:13'!
package: aPackage
	^ self package: aPackage info: MCVersionInfo new! !

!MCVersionCreated commentStamp: '<historical>'!
An MCVersionCreated is raised when a MCVersion is created
!
!MCVersionCreated methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/14/2011 13:56'!
nameString: anObject
	
		nameString := anObject! !

!MCVersionCreated methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/14/2011 13:56'!
version

		^ version! !

!MCVersionCreated methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/14/2011 13:56'!
nameString

		^ nameString! !

!MCVersionCreated methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/14/2011 13:56'!
version: anObject
	
		version := anObject! !

!MCVersionCreated class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 4/14/2011 13:56'!
name: aName nameString: aString version: aMCVersion

	^ self new
			name: aName;
			nameString: aString;
			version: aMCVersion;
			yourself! !

!MCVersionCreated class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 5/24/2011 14:57'!
name: aName message: aString version: aMCVersion

	^ self new
			name: aName;
			nameString: aString;
			version: aMCVersion;
			yourself! !

!MCVersionDependency commentStamp: 'TorstenBergmann 2/6/2014 08:09'!
Dependencies!
!MCVersionDependency methodsFor: 'testing' stamp: 'avi 3/4/2004 00:34'!
isFulfilledBy: anAncestry
	^ anAncestry ancestors includes: versionInfo! !

!MCVersionDependency methodsFor: 'comparing' stamp: 'avi 1/19/2004 16:06'!
hash
	^ versionInfo hash! !

!MCVersionDependency methodsFor: 'accessing' stamp: 'avi 2/12/2004 19:38'!
repositoryGroup
	^ self package workingCopy repositoryGroup! !

!MCVersionDependency methodsFor: 'accessing' stamp: 'avi 1/19/2004 15:40'!
versionInfo
	^ versionInfo! !

!MCVersionDependency methodsFor: 'testing' stamp: 'bf 4/19/2005 16:29'!
isFulfilledByAncestors
	^ package hasWorkingCopy
		and: [self isFulfilledByAncestorsOf: package workingCopy ancestry]! !

!MCVersionDependency methodsFor: 'testing' stamp: 'bf 4/19/2005 16:29'!
isOlder
	"Answer true if I represent an older version of a package that is loaded."
	^ package hasWorkingCopy
		and: [self isFulfilled not
			and: [ self isFulfilledByAncestors
				and: [package workingCopy modified not]]]! !

!MCVersionDependency methodsFor: 'testing' stamp: 'nk 7/13/2004 08:45'!
isFulfilledByAncestorsOf: anAncestry
	^ anAncestry hasAncestor: versionInfo! !

!MCVersionDependency methodsFor: 'testing' stamp: 'bf 4/19/2005 16:29'!
isCurrent
	^ package hasWorkingCopy
		and: [self isFulfilled
			and: [package workingCopy modified not]]! !

!MCVersionDependency methodsFor: 'comparing' stamp: 'avi 1/19/2004 16:12'!
= other
	^ other species = self species
		and: [other versionInfo = versionInfo
				and: [other package = package]]! !

!MCVersionDependency methodsFor: 'initialization' stamp: 'stephaneducasse 2/4/2006 20:47'!
initializeWithPackage: aPackage info: aVersionInfo
	package := aPackage.
	versionInfo := aVersionInfo! !

!MCVersionDependency methodsFor: 'testing' stamp: 'bf 4/19/2005 16:29'!
isFulfilled
	^package hasWorkingCopy
		and: [self isFulfilledBy: package workingCopy ancestry]! !

!MCVersionDependency methodsFor: 'accessing' stamp: 'avi 1/19/2004 15:40'!
package
	^ package! !

!MCVersionDependency methodsFor: 'resolving' stamp: 'nk 6/13/2004 19:21'!
resolve
	^ self repositoryGroup
		versionWithInfo: versionInfo
		ifNone: [ MCRepositoryGroup default versionWithInfo: versionInfo ifNone: []]! !

!MCVersionDependency class methodsFor: 'instance-creation' stamp: 'avi 1/19/2004 13:13'!
package: aPackage info: aVersionInfo
	^ self basicNew initializeWithPackage: aPackage info: aVersionInfo! !

!MCVersionHistoryBrowser commentStamp: 'TorstenBergmann 2/20/2014 15:53'!
Browser for version history!
!MCVersionHistoryBrowser methodsFor: '*Tool-Diff' stamp: 'gvc 2/3/2010 15:31'!
viewChanges
	"View the changes between a prior version and this version."
	
	self
		viewChanges: (self baseSnapshot patchRelativeToBase: self selectedSnapshot)
		from:  self selectedInfo name
		to: ancestry name! !

!MCVersionHistoryBrowser methodsFor: 'accessing' stamp: 'ab 8/7/2003 21:27'!
repositoryGroup
	^ MCRepositoryGroup default! !

!MCVersionHistoryBrowser methodsFor: 'morphic ui' stamp: 'avi 2/13/2004 01:09'!
getMenu: aMenu
	index < 2 ifTrue: [^ aMenu].
	self fillMenu: aMenu fromSpecs: 
		(Array
			with: (Array with: 'view changes -> ', ancestry name with: #viewChanges)
			with: #('spawn history' spawnHistory)).
	^ aMenu! !

!MCVersionHistoryBrowser methodsFor: 'morphic ui' stamp: 'ab 7/17/2003 15:41'!
defaultExtent
	^ 440@169.
	! !

!MCVersionHistoryBrowser methodsFor: 'accessing' stamp: 'avi 2/13/2004 01:10'!
baseSnapshot
	^ self snapshotForInfo: ancestry! !

!MCVersionHistoryBrowser methodsFor: 'accessing' stamp: 'ab 8/22/2003 01:39'!
selectedSnapshot
	^ self snapshotForInfo: self selectedInfo! !

!MCVersionHistoryBrowser methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
summary
	| selInfo |
	selInfo := self selectedInfo.
	^ selInfo 
		ifNil: ['']
		ifNotNil: [selInfo summary]! !

!MCVersionHistoryBrowser methodsFor: 'accessing' stamp: 'ab 8/22/2003 01:38'!
snapshotForInfo: aVersionInfo
	^ (self repositoryGroup versionWithInfo: aVersionInfo) snapshot! !

!MCVersionHistoryBrowser methodsFor: 'accessing' stamp: 'ab 7/11/2003 23:24'!
selection
	^ index ifNil: [0]! !

!MCVersionHistoryBrowser methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
infos
	^ infos ifNil: [infos := ancestry withBreadthFirstAncestors]! !

!MCVersionHistoryBrowser methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
package: aMCPackage
	package := aMCPackage! !

!MCVersionHistoryBrowser methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
index: anObject
	"Set the value of index"

	index := anObject! !

!MCVersionHistoryBrowser methodsFor: 'morphic ui' stamp: 'avi 2/13/2004 01:09'!
defaultLabel
	^ ancestry name, ' History'! !

!MCVersionHistoryBrowser methodsFor: '*Tool-Diff' stamp: 'gvc 2/9/2010 14:06'!
viewChanges: patch from: fromDescription to: toDescription
	"Open a browser on the patch."
	
	|patchLabel|
	patchLabel := 'Changes between {1} and {2}' translated format: {fromDescription. toDescription}.
	PSMCPatchMorph usedByDefault
		ifTrue: [((PSMCPatchMorph forPatch: patch)
						fromDescription: fromDescription;
						toDescription: toDescription;
						newWindow)
					title: patchLabel;
					open]
		ifFalse: [(MCPatchBrowser forPatch: patch)
					label: patchLabel;
					show]! !

!MCVersionHistoryBrowser methodsFor: 'accessing' stamp: 'avi 9/17/2005 16:09'!
selectedInfo
	^ self infos at: self selection ifAbsent: [nil]! !

!MCVersionHistoryBrowser methodsFor: 'morphic ui' stamp: 'nk 7/28/2003 18:05'!
widgetSpecs
	^ #(
		((listMorph:selection:menu: list selection getMenu:) (0 0 0.3 1))
		((textMorph: summary) (0.3 0 1 1))
	 	)! !

!MCVersionHistoryBrowser methodsFor: 'morphic ui' stamp: 'avi 2/13/2004 01:10'!
spawnHistory
	MCVersionHistoryBrowser new
		ancestry: self selectedInfo;
		package: package;
		show! !

!MCVersionHistoryBrowser methodsFor: 'accessing' stamp: 'avi 9/17/2005 16:10'!
list
	^ self infos collect: [:ea | ea name]! !

!MCVersionHistoryBrowser methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
ancestry: anAncestry
	ancestry := anAncestry! !

!MCVersionHistoryBrowser methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
selection: aNumber
	index := aNumber.
	self changed: #selection; changed: #summary! !

!MCVersionHistoryBrowser methodsFor: 'accessing' stamp: 'ab 8/22/2003 01:41'!
index
	"Answer the value of index"

	^ index! !

!MCVersionInfo commentStamp: '<historical>'!
Adds to the record of ancestry, other identifying details.!
!MCVersionInfo methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/17/2015 16:54'!
gtDisplayOn: stream
	stream nextPutAll: self name! !

!MCVersionInfo methodsFor: 'pillaging' stamp: 'cwp 8/1/2003 00:26'!
time
	^ time! !

!MCVersionInfo methodsFor: 'comparing' stamp: 'ab 7/5/2003 14:09'!
hash
	^ id hash! !

!MCVersionInfo methodsFor: '*GT-SpotterExtensions-Core-private' stamp: 'StefanReichhart 2/27/2015 09:59'!
allAncestors
	^ (self allAncestorsTo: OrderedCollection new)
		sort: [ :a :b | a timeStamp >= b timeStamp ]! !

!MCVersionInfo methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/26/2015 15:03'!
"protocol: *GT-SpotterExtensions-Core"
spotterAncestorsFor: aStep
	<spotterOrder: 1>
	self flag: 'rewrite for direct streaming - get rid of recursion'.
	aStep listProcessor
		title: 'Ancestors';
		allCandidates: [ self allAncestors ];
		filter: GTFilterSubstring! !

!MCVersionInfo methodsFor: '*GT-SpotterExtensions-Core-private' stamp: 'StefanReichhart 2/27/2015 10:02'!
allAncestorsTo: aCollection
	self ancestors do: [ :versionInfo | 
		" do not add/process ancestry-branches which have already been added/processed "
		(aCollection includes: versionInfo) ifFalse: [ 
			aCollection add: versionInfo.
			versionInfo allAncestorsTo: aCollection ] ].
	^ aCollection! !

!MCVersionInfo methodsFor: 'initialization' stamp: 'stephaneducasse 2/4/2006 20:47'!
initializeWithName: vName id: aUUID message: aString date: aDate time: aTime author: initials ancestors: aCollection stepChildren: stepCollection
	name := vName.
	id := aUUID.
	message := aString.
	date := aDate.
	time := aTime.
	author := initials.
	ancestors :=  aCollection.
	stepChildren := stepCollection! !

!MCVersionInfo methodsFor: 'accessing' stamp: 'adrian_lienhard 1/7/2009 17:31'!
summary
	^ String streamContents:
		[:s |
		s
			nextPutAll: self summaryHeader; cr; cr;
			nextPutAll: self message.
		]! !

!MCVersionInfo methodsFor: 'pillaging' stamp: 'cwp 8/1/2003 00:24'!
id
	^ id ! !

!MCVersionInfo methodsFor: 'initialization' stamp: 'ThierryGoubier 2/26/2015 10:54'!
lazy
	^ MCLazyVersionInfo from: self! !

!MCVersionInfo methodsFor: 'comparing' stamp: 'ab 7/5/2003 14:23'!
= other
	^ other species = self species
		and: [other hasID: id]! !

!MCVersionInfo methodsFor: 'pillaging' stamp: 'cwp 8/1/2003 00:26'!
author
	^ author! !

!MCVersionInfo methodsFor: 'printing' stamp: 'ab 7/5/2003 18:00'!
printOn: aStream
	super printOn: aStream.
	aStream nextPut: $(; nextPutAll: self name; nextPut: $)
	! !

!MCVersionInfo methodsFor: 'accessing' stamp: 'BernhardPieber 11/21/2010 18:48'!
nameWithout: packageName
	| result |
	result := self name.
	(result beginsWith: packageName , '-') ifTrue: [
		result := result copyFrom: packageName size + 2 to: result size].
	^result! !

!MCVersionInfo methodsFor: 'pillaging' stamp: 'cwp 8/1/2003 00:26'!
date
	^ date! !

!MCVersionInfo methodsFor: 'accessing' stamp: 'avi 9/17/2003 11:24'!
timeString
	^ date asString, ', ', time asString! !

!MCVersionInfo methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/22/2013 16:30'!
timeStamp
	^ DateAndTime date: date time: time! !

!MCVersionInfo methodsFor: 'accessing' stamp: 'ab 7/12/2003 00:04'!
message
	^ message ifNil: ['']! !

!MCVersionInfo methodsFor: 'private' stamp: 'ab 7/5/2003 14:10'!
hasID: aUUID
	^ id = aUUID! !

!MCVersionInfo methodsFor: 'accessing' stamp: 'ab 7/11/2003 23:33'!
name
	^ name ifNil: ['<working copy>']! !

!MCVersionInfo methodsFor: 'accessing' stamp: 'avi 9/14/2004 15:22'!
summaryHeader
	^ String streamContents:
		[:s |
		s
			nextPutAll: 'Name: '; nextPutAll: self name; cr.
		date ifNotNil:
			[s
				nextPutAll: 'Author: '; nextPutAll: author; cr;
				nextPutAll: 'Time: '; nextPutAll:  date asString, ', ', time asString; cr].
		id ifNotNil:
			[s nextPutAll: 'UUID: '; nextPutAll: id asString; cr].
		s
			nextPutAll: 'Ancestors: '; nextPutAll: self ancestorString.
		self stepChildren isEmpty ifFalse:
			[s cr; nextPutAll: 'Backported From: '; nextPutAll: self stepChildrenString].
		]! !

!MCVersionInfo methodsFor: 'converting' stamp: 'StephaneDucasse 8/17/2012 15:54'!
asDictionary
	^ Dictionary new
		at: #name put: name;
		at: #id put: id asString;
		at: #message put: message;
		at: #date put: date;
		at: #time put: time;
		at: #author put: author;
		at: #ancestors put: (self ancestors collect: [:a | a asDictionary]);
		yourself! !

!MCVersionInfo methodsFor: 'accessing' stamp: 'EstebanLorenzano 3/31/2015 15:57'!
versionNumber
	^ ((self name copyAfterLast: $-) copyAfter: $.) asInteger! !

!MCVersionInfo class methodsFor: 'instance-creation' stamp: 'avi 9/11/2004 10:44'!
name: vName id: id message: message date: date time: time author: author ancestors: ancestors
	^ self 
		name: vName
		id: id
		message: message
		date: date
		time: time
		author: author
		ancestors: ancestors
		stepChildren: #()! !

!MCVersionInfo class methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/26/2015 17:55'!
gtExampleVersionInfo
	<gtExample: 'Metacello version-info'>
	MCWorkingCopy allManagers do: [ :each | 
		each packageName = 'GT-SpotterExtensions-Core' ifTrue: [ 
			^ each versionInfo ] ].
	^ nil! !

!MCVersionInfo class methodsFor: 'instance-creation' stamp: 'avi 9/11/2004 10:43'!
name: vName id: id message: message date: date time: time author: author ancestors: ancestors stepChildren: stepChildren
	^ self new
		initializeWithName: vName
		id: id
		message: message
		date: date
		time: time
		author: author
		ancestors: ancestors
		stepChildren: stepChildren! !

!MCVersionInfoWriter commentStamp: '<historical>'!
I serialize an MCVersionInfo into a given stream.
If the version info has been serialized before I output a compacted version consiting of the id.
!
!MCVersionInfoWriter methodsFor: 'testing' stamp: 'avi 1/22/2004 21:10'!
isWritten: aVersionInfo
	^ self written includes: aVersionInfo! !

!MCVersionInfoWriter methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
written
	^ written ifNil: [written := Set new]! !

!MCVersionInfoWriter methodsFor: 'serialization' stamp: 'avi 1/22/2004 21:10'!
wrote: aVersionInfo
	self written add: aVersionInfo! !

!MCVersionInfoWriter methodsFor: 'serialization' stamp: 'IgorStasenko 11/28/2012 16:02'!
writeVersionInfo: aVersionInfo
	(self isWritten: aVersionInfo)
		ifTrue: [^ stream nextPutAll: '(id '; print: aVersionInfo id asString; nextPut: $) ].
	stream nextPut: $(.
	#(name message id date time author) do: [:sel | 
		stream 
			nextPutAll: sel; space;
			print: (((aVersionInfo perform: sel) ifNil: ['']) asString convertToEncoding: 'latin-1' ); space ].
	stream nextPutAll: 'ancestors ('.
	aVersionInfo ancestors do: [:ea | self writeVersionInfo: ea].
	stream nextPutAll: ') stepChildren ('.
	aVersionInfo stepChildren do: [:ea | self writeVersionInfo: ea].
	stream nextPutAll: '))'.
	
	self wrote: aVersionInfo! !

!MCVersionInspector commentStamp: '<historical>'!
I am a tool that visually represents an MCVersion. 

While I can be opened on anMCVersion, you've probably seen me most often after saving a package in the Monticello Browser. 

I have buttons to perform common version-related actions - like browsing, loading, and viewing changes. In my main text area, I display the following information about my version - name, author, timestamp, UUID, ancestors and log message.!
!MCVersionInspector methodsFor: 'actions' stamp: 'CamilloBruni 9/30/2011 16:44'!
changes
	"Open a patch morph for the changes."
	
	self
		viewChanges: self version changes
		from: self version workingCopy description
		to: self version info name! !

!MCVersionInspector methodsFor: 'accessing' stamp: 'avi 9/17/2005 17:16'!
versionInfo
	^ self version info! !

!MCVersionInspector methodsFor: 'morphic ui' stamp: 'avi 8/31/2003 00:45'!
defaultExtent
	^ 400@200! !

!MCVersionInspector methodsFor: 'accessing' stamp: 'avi 2/28/2004 20:19'!
version
	^ version! !

!MCVersionInspector methodsFor: 'actions' stamp: 'avi 2/28/2004 20:19'!
adopt
	(self confirm:
'Modifying ancestry can be dangerous unless you know
what you are doing.  Are you sure you want to adopt
',self version info name, ' as an ancestor of your working copy?')
		ifTrue: [self version adopt]! !

!MCVersionInspector methodsFor: 'actions' stamp: 'BenjaminVanRyseghem 2/8/2012 17:10'!
browse

	^ self version browse! !

!MCVersionInspector methodsFor: 'testing' stamp: 'lr 9/26/2003 20:15'!
hasVersion
	^version notNil! !

!MCVersionInspector methodsFor: 'actions' stamp: 'avi 9/17/2005 17:14'!
history
	(MCVersionHistoryBrowser new ancestry: self versionInfo) show! !

!MCVersionInspector methodsFor: 'accessing' stamp: 'avi 9/17/2005 17:16'!
summary
	^self hasVersion
		ifTrue: [ self versionSummary ]
		ifFalse: [ String new ]! !

!MCVersionInspector methodsFor: 'morphic ui' stamp: 'Rik 12/17/2004
06:07'!
buttonSpecs
       ^ #((Browse browse 'Browse this version' hasVersion)
               (History history 'Browse the history of this version' hasVersion)
               (Changes changes 'Browse the changes this version would make to the
image' hasVersion)
               (Load load 'Load this version into the image' hasVersion)
               (Merge merge 'Merge this version into the image' hasVersion)
               (Adopt adopt 'Adopt this version as an ancestor of your working copy'
hasVersion)
               (Copy save 'Copy this version to another repository' hasVersion)
               (Diff diff 'Create an equivalent version based on an earlier release'
hasVersion))! !

!MCVersionInspector methodsFor: 'morphic ui' stamp: 'ar 8/6/2009 18:25'!
pickRepository
	| index |
	index := UIManager default chooseFrom: (self repositories collect: [:ea | ea description])
				title: 'Repository:'.
	^ index = 0 ifFalse: [self repositories at: index]! !

!MCVersionInspector methodsFor: 'morphic ui' stamp: 'avi 8/31/2003 00:44'!
repositories
	^ MCRepositoryGroup default repositories! !

!MCVersionInspector methodsFor: 'morphic ui' stamp: 'avi 2/28/2004 20:18'!
defaultLabel
	^ 'Version: ', self version info name! !

!MCVersionInspector methodsFor: 'actions' stamp: 'bf 3/14/2005 15:32'!
load
	Cursor wait showWhile: [self version load]! !

!MCVersionInspector methodsFor: 'actions' stamp: 'marcus.denker 11/10/2008 10:04'!
diff
	| ancestorVersion |
	self pickAncestor ifNotNil:
		[:ancestor |
		ancestorVersion := self version workingCopy repositoryGroup versionWithInfo: ancestor.
		(self version asDiffAgainst: ancestorVersion) open]! !

!MCVersionInspector methodsFor: 'actions' stamp: 'BenjaminVanRyseghem 3/22/2013 15:54'!
save
	
	self pickRepository 
		ifNotNil: [ :ea | 
			self version dependencies do: [ :each | ea storeVersion: each resolve ]. 
			ea storeVersion: self version ]! !

!MCVersionInspector methodsFor: 'morphic ui' stamp: 'ar 8/6/2009 18:25'!
pickAncestor
	| index versions |
	versions := self version info breadthFirstAncestors.
	index := UIManager default chooseFrom: (versions collect: [:ea | ea name])
				title: 'Ancestor:'.
	^ index = 0 ifFalse: [versions at: index]! !

!MCVersionInspector methodsFor: 'actions' stamp: 'avi 2/28/2004 20:19'!
merge
	self version merge! !

!MCVersionInspector methodsFor: 'morphic ui' stamp: 'ab 7/18/2003 18:43'!
widgetSpecs
	^ #(
		((buttonRow) (0 0 1 0) (0 0 0 30))
		((textMorph: summary) (0 0 1 1) (0 30 0 0))
		)! !

!MCVersionInspector methodsFor: '*Tool-Diff' stamp: 'gvc 2/9/2010 14:06'!
viewChanges: patch from: fromDescription to: toDescription
	"Open a patch morph for the changes."
	
	|title|
	title := 'Changes from {1} to {2}' format: {fromDescription. toDescription}.
	PSMCPatchMorph usedByDefault
		ifTrue: [((PSMCPatchMorph forPatch: patch)
						fromDescription: fromDescription;
						toDescription: toDescription;
						newWindow)
					title: title;
					open]
		ifFalse: [(MCPatchBrowser forPatch: self version changes)
					showLabelled: title]! !

!MCVersionInspector methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
version: aVersion
	version := aVersion! !

!MCVersionInspector methodsFor: 'accessing' stamp: 'avi 9/17/2005 17:16'!
versionSummary
	^ self version summary! !

!MCVersionInspector class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
taskbarIcon
	"Answer the icon for the receiver in a task bar."

	^ Smalltalk ui icons smallSaveIcon! !

!MCVersionLoader commentStamp: '<historical>'!
A MCVersionLoader is responsible for loading a given version. !
!MCVersionLoader methodsFor: 'checking' stamp: 'cwp 11/7/2004 17:02'!
depAgeIsOk: aDependency
	^ aDependency isOlder not 
		or: [self confirm: 'load older dependency ', aDependency versionInfo name , '?']! !

!MCVersionLoader methodsFor: 'checking' stamp: 'abc 8/8/2011 12:48'!
warnAboutLosingChangesTo: versionCollection
	^ (MCMergeOrLoadWarning signalFor: versionCollection).! !

!MCVersionLoader methodsFor: 'checking' stamp: 'CamilloBruni 1/16/2012 17:42'!
warnAboutLosingChangesTo: versionCollection ifCancel: cancelBlock ifMerge: mergeBlock
	
	| result |

	result := (MCMergeOrLoadWarning signalFor: versionCollection).
	
	result = false ifTrue: [ ^ mergeBlock value ].
	result = nil ifTrue: [ ^ cancelBlock value ].
	
	"otherwise we will continue loading"! !

!MCVersionLoader methodsFor: 'checking' stamp: 'cwp 11/7/2004 17:06'!
confirmMissingDependency: aDependency
	| name |
	name := aDependency versionInfo name.
	(self confirm: 'Can''t find dependency ', name, '. ignore?')
		ifFalse: [self error: 'Can''t find dependency ', name]! !

!MCVersionLoader methodsFor: 'checking' stamp: 'cwp 11/7/2004 17:00'!
checkIfDepIsOlder: aDependency
	^ aDependency isOlder not 
		or: [self confirm: 'load older dependency ', aDependency versionInfo name , '?']! !

!MCVersionLoader methodsFor: 'loading' stamp: 'cwp 11/7/2004 17:04'!
addVersion: aVersion
	aVersion dependencies do: [ :ea | self addDependency: ea].
	versions add: aVersion.
! !

!MCVersionLoader methodsFor: 'private' stamp: 'EstebanLorenzano 1/3/2014 09:43'!
ensurePackage: mcPackage 
	RPackageOrganizer default registerPackageNamed: mcPackage name 
		! !

!MCVersionLoader methodsFor: 'loading' stamp: 'CamilloBruni 1/16/2012 17:06'!
loadWithNameLike: aString
	| loader |
	
	self checkForModificationsIfCancel: [ ^ self] ifMerge: [ ^ self mergeVersions ].
	
	loader := versions size > 1
		ifTrue: [MCMultiPackageLoader new]
		ifFalse: [MCPackageLoader new].
		
	versions do: [:ea |
		ea canOptimizeLoading
			ifTrue: [ea patch applyTo: loader]
			ifFalse: [loader updatePackage: ea package withSnapshot: ea snapshot]].
		
	loader loadWithNameLike: aString.
	versions do: [:ea | ea workingCopy loaded: ea]! !

!MCVersionLoader methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 10:04'!
initialize
	super initialize.
	versions := OrderedCollection new! !

!MCVersionLoader methodsFor: 'checking' stamp: 'CamilloBruni 8/4/2011 12:46'!
localModifications
	^ versions select: [:ea | ea package workingCopy modified].
	! !

!MCVersionLoader methodsFor: 'testing' stamp: 'CamilloBruni 9/28/2011 17:15'!
hasLocalModifications
	^ self localModifications isEmpty not
	! !

!MCVersionLoader methodsFor: 'testing' stamp: 'sd 3/16/2008 08:53'!
hasVersions

	^ versions isEmpty not! !

!MCVersionLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
versions

	^versions! !

!MCVersionLoader methodsFor: 'loading' stamp: 'EstebanLorenzano 10/4/2013 12:48'!
load
	RPackageSet withCacheDo: [   
		| version |
		version := versions first. 
		self ensurePackage: version package.
		self loadWithNameLike: version info name ].! !

!MCVersionLoader methodsFor: 'loading' stamp: 'cwp 11/7/2004 17:06'!
addDependency: aDependency
	| dep |
	aDependency isCurrent ifTrue: [^ self].
	(self depAgeIsOk: aDependency) ifFalse: [^ self].
	dep := aDependency resolve.
	dep
		ifNil: [self confirmMissingDependency: aDependency]
		ifNotNil: [(versions includes: dep) ifFalse: [self addVersion: dep]]! !

!MCVersionLoader methodsFor: 'checking' stamp: 'md 3/5/2012 14:28'!
checkForModificationsIfCancel: cancelBlock ifMerge: mergeBlock
	| modifications |
	
	"first check if there are local packages which are dirty"
	modifications := self localModifications.
	modifications isEmpty ifTrue: [ ^ self].
	
	"ask the user what to do.. merge | overwrite | abort"
	^ self warnAboutLosingChangesTo: modifications ifCancel: cancelBlock ifMerge: mergeBlock! !

!MCVersionLoader methodsFor: 'loading' stamp: 'abc 8/8/2011 13:01'!
mergeVersions
	|merger|
	merger :=  MCVersionMerger new.
	merger addVersions: self localModifications.
	merger merge.! !

!MCVersionLoader class methodsFor: 'public api' stamp: 'avi 1/24/2004 20:06'!
loadVersion: aVersion
	self new
		addVersion: aVersion;
		load! !

!MCVersionMerger commentStamp: 'TorstenBergmann 2/6/2014 08:09'!
Merge versions!
!MCVersionMerger methodsFor: 'adding' stamp: 'CamilloBruni 8/4/2011 13:49'!
addVersions: aCollection
	aCollection do: [ :version|
		self addVersion: version].! !

!MCVersionMerger methodsFor: 'initialization' stamp: 'CamilloBruni 8/4/2011 14:03'!
initialize
	super initialize.
	records := OrderedCollection new.
	merger := MCThreeWayMerger new.! !

!MCVersionMerger methodsFor: 'actions' stamp: 'CamilloBruni 9/30/2011 16:52'!
gatherChanges
	records do: [:ea | merger addBaseSnapshot: ea packageSnapshot].
	records do: [:ea | merger applyPatch: ea mergePatch].! !

!MCVersionMerger methodsFor: 'adding' stamp: 'CamilloBruni 9/30/2011 16:53'!
addVersion: aVersion
	
	records add: (MCMergeRecord version: aVersion).
	aVersion dependencies 
		do: [:ea | | dep |
			dep := ea resolve.
			(records anySatisfy: [:r | r version = dep]) 
				ifFalse: [self addVersion: dep]]
		displayingProgress: [ :ea| 'Searching dependency: ', ea package name]! !

!MCVersionMerger methodsFor: 'actions' stamp: 'CamilloBruni 1/16/2012 15:49'!
merge

	self gatherChanges.

	self resolveConflicts ifTrue:
		[merger load.
		records do: [:ea | ea updateWorkingCopy].
		^ true].
	
	^ false! !

!MCVersionMerger methodsFor: 'actions' stamp: 'CamilloBruni 8/4/2011 14:03'!
resolveConflicts
	(records allSatisfy: [:ea | ea isAncestorMerge]) 
		ifTrue: [
			MCNoChangesException signal. 
			^ false].
		
	^ ((MCMergeResolutionRequest new merger: merger)
			signal: 'Merging ', records first version info name) = true! !

!MCVersionMerger methodsFor: 'actions' stamp: 'CamilloBruni 9/30/2011 16:51'!
mergeWithNameLike: baseName

	self gatherChanges.
	
	self resolveConflicts ifTrue:
		[merger loadWithNameLike: baseName.
		records do: [:ea | ea updateWorkingCopy]].! !

!MCVersionMerger class methodsFor: 'action' stamp: 'CamilloBruni 9/30/2011 16:53'!
mergeVersion: aVersion
	self new
		addVersion: aVersion;
		mergeWithNameLike: aVersion info name! !

!MCVersionNameAndMessageRequest commentStamp: 'TorstenBergmann 2/6/2014 08:09'!
Notify to requests for version name and message!
!MCVersionNameAndMessageRequest methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
suggestedName: aString
	suggestion := aString! !

!MCVersionNameAndMessageRequest methodsFor: '*MonticelloGUI' stamp: 'AndrewBlack 9/4/2009 14:11'!
defaultAction
	^ MCSaveVersionDialog new
		versionName: suggestion;
		logMessage: suggestedLogComment;
		showModally! !

!MCVersionNameAndMessageRequest methodsFor: 'accessing' stamp: 'AndrewBlack 9/4/2009 14:16'!
suggestedLogComment: aLogMessage

	suggestedLogComment := aLogMessage! !

!MCVersionNameAndMessageRequest methodsFor: 'accessing' stamp: 'ab 7/10/2003 01:07'!
suggestedName
	^ suggestion! !

!MCVersionNameAndMessageRequest methodsFor: 'accessing' stamp: 'AndrewBlack 9/4/2009 14:16'!
suggestedLogComment

	^ suggestedLogComment! !

!MCVersionNotification commentStamp: 'TorstenBergmann 2/6/2014 08:10'!
Version notification!
!MCVersionNotification methodsFor: 'error handling' stamp: 'MarcusDenker 12/16/2013 14:44'!
notify: aString
	| message |
	message := self messageTo: aString.
	SMTPClient
		deliverMailFrom: message from
		to: (Array with: message to)
		text: message text
		usingServer: MailComposition smtpServer! !

!MCVersionNotification methodsFor: 'as yet unclassified' stamp: 'stephaneducasse 2/4/2006 20:47'!
messageTo: aString
	| message |
	message := MailMessage empty.
	message setField: 'from' toString: self fromAddress.
	message setField: 'to' toString: aString.
	message setField: 'subject' toString: '[MC] ', version info name.
	message body: (MIMEDocument contentType: 'text/plain' content: self messageText).
	^ message! !

!MCVersionNotification methodsFor: 'as yet unclassified' stamp: 'avi 8/26/2004 15:13'!
fromAddress
	^ 'monticello@beta4.com'! !

!MCVersionNotification methodsFor: 'initialize-release' stamp: 'stephaneducasse 2/4/2006 20:47'!
initializeWithVersion: aVersion repository: aRepository
	version := aVersion.
	repository := aRepository.
	ancestor := repository closestAncestorVersionFor: version info ifNone: []. 
	changes := ancestor
				ifNil: [#()]
				ifNotNil: [(version snapshot patchRelativeToBase: ancestor snapshot) 							operations asSortedCollection]! !

!MCVersionNotification methodsFor: 'accessing' stamp: 'avi 8/26/2004 15:12'!
messageText
	^ String streamContents:
		[:s |
		s nextPutAll: 'Committed to repository: ', repository description; cr; cr.
		s nextPutAll: version summary.
		changes isEmpty ifFalse:
			[s cr; cr.
			s nextPutAll: '-----------------------------------------------------'; cr.
			s nextPutAll: 'Changes since ', ancestor info name, ':'; cr.
			changes do:
			[:ea |
			s cr; nextPutAll: ea summary; cr.
			s nextPutAll: ea sourceString]]]! !

!MCVersionNotification class methodsFor: 'instance creation' stamp: 'avi 8/26/2004 14:27'!
version: aVersion repository: aRepository
	^ self basicNew initializeWithVersion: aVersion repository: aRepository! !

!MCVersionReader commentStamp: 'TorstenBergmann 2/5/2014 13:53'!
A version reader!
!MCVersionReader methodsFor: 'accessing' stamp: 'CamilloBruni 4/20/2012 18:18'!
basicVersion
	^ MCVersion
		package: self package
		info: self info
		snapshot: [ self snapshot ]
		dependencies: self dependencies! !

!MCVersionReader methodsFor: 'accessing' stamp: 'avi 1/21/2004 23:10'!
definitions
	definitions ifNil: [self loadDefinitions].
	^ definitions! !

!MCVersionReader methodsFor: 'loading' stamp: 'ab 8/20/2003 19:54'!
loadVersionInfo
	self subclassResponsibility! !

!MCVersionReader methodsFor: 'accessing' stamp: 'ab 8/20/2003 19:53'!
package
	package ifNil: [self loadPackage].
	^ package! !

!MCVersionReader methodsFor: 'accessing' stamp: 'ab 8/20/2003 19:53'!
info
	info ifNil: [self loadVersionInfo].
	^ info! !

!MCVersionReader methodsFor: 'loading' stamp: 'ab 8/20/2003 19:54'!
loadPackage
	self subclassResponsibility ! !

!MCVersionReader methodsFor: 'accessing' stamp: 'avi 10/9/2003 12:38'!
version
	^ self basicVersion! !

!MCVersionReader methodsFor: 'loading' stamp: 'ab 8/20/2003 19:54'!
loadDefinitions
	self subclassResponsibility ! !

!MCVersionReader methodsFor: 'accessing' stamp: 'ab 8/20/2003 19:54'!
snapshot
	^ MCSnapshot fromDefinitions: self definitions! !

!MCVersionReader methodsFor: 'accessing' stamp: 'avi 1/19/2004 14:50'!
dependencies
	dependencies ifNil: [self loadDependencies].
	^ dependencies! !

!MCVersionReader methodsFor: 'loading' stamp: 'avi 1/19/2004 14:50'!
loadDependencies
	self subclassResponsibility ! !

!MCVersionReader class methodsFor: 'System-FileRegistry' stamp: 'CamilloBruni 2/3/2013 17:21'!
fileReaderServicesForFile: fullName suffix: suffix
	<fileService>
	self isAbstract ifTrue: [^ #()].
	^ ((suffix = self extension) or: [ suffix = '*' ])
		ifTrue: [self services]
		ifFalse: [Array new: 0]
		! !

!MCVersionReader class methodsFor: '*monticello-file services' stamp: 'nk 2/25/2005 11:12'!
openVersionFromStream: stream
	(self versionFromStream: stream) open! !

!MCVersionReader class methodsFor: '*monticello-file services' stamp: 'nk 2/25/2005 11:17'!
mergeVersionStream: stream
	(self versionFromStream: stream) merge! !

!MCVersionReader class methodsFor: 'reading' stamp: 'StephaneDucasse 2/2/2010 22:07'!
file: fileName streamDo: aBlock
	
	^ FileStream 
			readOnlyFileNamed: fileName 
			do: [:file | aBlock value: file]! !

!MCVersionReader class methodsFor: 'reading' stamp: 'bf 3/23/2005 01:20'!
on: s fileName: f
	^ self on: s! !

!MCVersionReader class methodsFor: '*monticello-file services' stamp: 'SeanDeNigris 6/18/2012 16:56'!
loadVersionStream: stream fromDirectory: directory
	| version repository |
	repository := MCDirectoryRepository new directory: directory.
	version := self versionFromStream: stream.
	version workingCopy repositoryGroup addRepository: repository.
	version load.
! !

!MCVersionReader class methodsFor: 'reading' stamp: 'avi 1/21/2004 22:59'!
versionInfoFromStream: aStream
	^ (self on: aStream) info! !

!MCVersionReader class methodsFor: 'System-FileRegistry' stamp: 'CamilloBruni 5/4/2012 21:38'!
loadVersionFile: fileName
	| version |
	version := self versionFromFile: fileName.
	version workingCopy repositoryGroup addRepository:
		(MCDirectoryRepository new directory: fileName asFileReference).
	version load.
! !

!MCVersionReader class methodsFor: 'System-FileRegistry' stamp: 'CamilloBruni 2/3/2013 17:22'!
initialize
	"MCVersionReader initialize"

	Smalltalk globals at: #MczInstaller ifPresent: [ :installer | 
		FileServices unregisterFileReader: installer ].
	
	self concreteSubclasses do: [ :aClass | 
		"get rid of AnObsoleteMCMcReader and AnObsoleteMCMcvReader"
		FileServices registerFileReader: aClass ].
	
	FileServices registeredFileReaderClasses 
		select: [ :ea | ea isObsolete ]
		thenDo: [ :ea | FileServices unregisterFileReader: ea ]! !

!MCVersionReader class methodsFor: 'System-FileRegistry' stamp: 'avi 1/21/2004 22:55'!
services
	^ Array 
		with: self serviceLoadVersion
		with: self serviceMergeVersion
		with: self serviceOpenVersion! !

!MCVersionReader class methodsFor: 'reading' stamp: 'avi 1/21/2004 22:58'!
versionFromStream: aStream
	^ (self on: aStream) version! !

!MCVersionReader class methodsFor: '*monticello-file services' stamp: 'tbn 8/11/2010 10:20'!
serviceOpenVersion
	^ (SimpleServiceEntry
		provider: self
		label: 'Open version'
		selector: #openVersionFromStream:
		description: 'Open a package version'
		buttonLabel: 'Open')
		argumentGetter: [ :fileList | fileList readOnlyStream ]! !

!MCVersionReader class methodsFor: 'System-FileRegistry' stamp: 'pavel.krivanek 10/24/2010 19:38'!
unload
	FileServices unregisterFileReader: self ! !

!MCVersionReader class methodsFor: 'reading' stamp: 'cwp 7/31/2003 23:03'!
versionFromFile: fileName
	^ self file: fileName streamDo: [:stream | self versionFromStream: stream]! !

!MCVersionReader class methodsFor: 'System-FileRegistry' stamp: 'cwp 8/1/2003 14:46'!
openVersionFile: fileName
	(self versionFromFile: fileName) open! !

!MCVersionReader class methodsFor: 'System-FileRegistry' stamp: 'cwp 8/1/2003 14:46'!
mergeVersionFile: fileName
	(self versionFromFile: fileName) merge! !

!MCVersionReader class methodsFor: '*monticello-file services' stamp: 'tbn 8/11/2010 10:19'!
serviceLoadVersion
	^ (SimpleServiceEntry
		provider: self
		label: 'Load version'
		selector: #loadVersionStream:fromDirectory:
		description: 'Load a package version'
		buttonLabel: 'Load')
		argumentGetter: [ :fileList | { fileList readOnlyStream . fileList directory } ]! !

!MCVersionReader class methodsFor: '*monticello-file services' stamp: 'tbn 8/11/2010 10:19'!
serviceMergeVersion
	^ (SimpleServiceEntry
		provider: self
		label: 'Merge version'
		selector: #mergeVersionStream:
		description: 'Merge a package version into the image'
		buttonLabel: 'Merge')
		argumentGetter: [ :fileList | fileList readOnlyStream ]! !

!MCVersionSorter commentStamp: 'TorstenBergmann 2/6/2014 08:10'!
Sort versions!
!MCVersionSorter methodsFor: 'adding' stamp: 'avi 9/11/2004 10:49'!
addVersionInfo: aVersionInfo
	roots add: aVersionInfo.
	self registerStepChildrenOf: aVersionInfo seen: Set new! !

!MCVersionSorter methodsFor: 'private' stamp: 'avi 9/11/2004 10:39'!
processVersionInfo: aVersionInfo
	(self addToCurrentLayer: aVersionInfo) ifTrue:
		[self pushLayer.
		(self knownAncestorsOf: aVersionInfo) do: [:ea | self processVersionInfo: ea].
		self popLayer]
! !

!MCVersionSorter methodsFor: 'private' stamp: 'stephaneducasse 2/4/2006 20:47'!
pushLayer
	depthIndex := depthIndex + 1.
	depthIndex > layers size ifTrue: [layers add: OrderedCollection new].
	! !

!MCVersionSorter methodsFor: 'private' stamp: 'stephaneducasse 2/4/2006 20:47'!
popLayer
	depthIndex := depthIndex - 1! !

!MCVersionSorter methodsFor: 'accessing' stamp: 'ab 8/17/2003 15:53'!
layers
	^ layers! !

!MCVersionSorter methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 10:04'!
initialize
	super initialize.
	stepparents := Dictionary new.
	roots := OrderedCollection new.! !

!MCVersionSorter methodsFor: 'adding' stamp: 'avi 9/11/2004 14:19'!
addAllAncestorsOf: aVersionInfo to: aSet
	(aSet includes: aVersionInfo) ifTrue: [^ self].
	aSet add: aVersionInfo.
	(self knownAncestorsOf: aVersionInfo) do:
		[:ea |
		self addAllAncestorsOf: ea to: aSet]! !

!MCVersionSorter methodsFor: 'adding' stamp: 'avi 8/31/2003 21:30'!
addAllVersionInfos: aCollection
	aCollection do: [:ea | self addVersionInfo: ea]! !

!MCVersionSorter methodsFor: 'adding' stamp: 'stephaneducasse 2/4/2006 20:47'!
addToCurrentLayer: aVersionInfo
	| layer |
	layer := layers at: depthIndex.
	(layer includes: aVersionInfo) ifFalse:
		[depths at: aVersionInfo ifPresent:
			[:i |
			i < depthIndex
				ifTrue: [(layers at: i) remove: aVersionInfo]
				ifFalse: [^ false]].
		layer add: aVersionInfo.
		depths at: aVersionInfo put: depthIndex.
		^ true].
	^ false ! !

!MCVersionSorter methodsFor: 'accessing' stamp: 'avi 9/11/2004 14:37'!
knownAncestorsOf: aVersionInfo
	^ aVersionInfo ancestors, (self stepParentsOf: aVersionInfo) asArray! !

!MCVersionSorter methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
allAncestorsOf: aVersionInfo
	| all |
	all := Set new.
	self addAllAncestorsOf: aVersionInfo to: all.
	^ all! !

!MCVersionSorter methodsFor: 'private' stamp: 'avi 9/11/2004 14:34'!
registerStepChildrenOf: aVersionInfo seen: aSet
	(aSet includes: aVersionInfo) ifTrue: [^ self].
	aSet add: aVersionInfo.
	aVersionInfo stepChildren do: [:ea | (self stepParentsOf: ea) add: aVersionInfo].
	aVersionInfo ancestors do: [:ea | self registerStepChildrenOf: ea seen: aSet].! !

!MCVersionSorter methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
sortedVersionInfos
	layers := OrderedCollection with: OrderedCollection new.
	depthIndex := 1.
	depths := Dictionary new.
	roots do: [:ea | self processVersionInfo: ea].
	^ layers gather: [:ea | ea]! !

!MCVersionSorter methodsFor: 'accessing' stamp: 'avi 9/11/2004 10:40'!
stepParentsOf: aVersionInfo
	^ (stepparents at: aVersionInfo ifAbsentPut: [Set new])! !

!MCVersionTest methodsFor: 'tests' stamp: 'cwp 11/7/2004 14:50'!
testAllMissing
	self 
		assert: #allDependenciesDo: 
		orders: #(a ((b (d e)) (c missing))) 
		as: #(d e b)! !

!MCVersionTest methodsFor: 'building' stamp: 'cwp 11/7/2004 12:29'!
dependencyFromTree: sexpr
	^ MCMockDependency fromTree: sexpr! !

!MCVersionTest methodsFor: 'tests' stamp: 'cwp 11/7/2004 14:25'!
testPostOrder
	self 
		assert: #allDependenciesDo: 
		orders: #(a ((b (d e)) c)) 
		as: #(d e b c)! !

!MCVersionTest methodsFor: 'tests' stamp: 'cwp 11/7/2004 14:53'!
testAllAvailablePostOrder
	self 
		assert: #allAvailableDependenciesDo: 
		orders: #(a ((b (d e)) c)) 
		as: #(d e b c)! !

!MCVersionTest methodsFor: 'tests' stamp: 'cwp 11/7/2004 14:29'!
testWithAllUnresolved
	self 
		assert: #withAllDependenciesDo:ifUnresolved: 
		orders: #(a ((b (d e)) (c missing)))
		as: #(d e b a)
		unresolved: #(c)! !

!MCVersionTest methodsFor: 'tests' stamp: 'cwp 11/7/2004 14:22'!
testWithAll
	self 
		assert: #withAllDependenciesDo: 
		orders: #(a ((b (d e)) c)) 
		as: #(d e b c a)! !

!MCVersionTest methodsFor: 'running' stamp: 'stephaneducasse 2/4/2006 20:47'!
setUp
	visited := OrderedCollection new.! !

!MCVersionTest methodsFor: 'building' stamp: 'cwp 11/7/2004 12:40'!
versionFromTree: sexpr
	^ (self dependencyFromTree: sexpr) resolve! !

!MCVersionTest methodsFor: 'asserting' stamp: 'cwp 11/7/2004 14:32'!
assert: aSelector orders: sexpr as: array
	| expected |
	expected := OrderedCollection new.
	version := self versionFromTree: sexpr.
	version perform: aSelector with: [:ea | expected add: ea info name].
	self assert: expected asArray = array! !

!MCVersionTest methodsFor: 'tests' stamp: 'cwp 11/7/2004 14:47'!
testAllUnresolved
	self 
		assert: #allDependenciesDo:ifUnresolved: 
		orders: #(a ((b (d e)) (c missing)))
		as: #(d e b)
		unresolved: #(c)! !

!MCVersionTest methodsFor: 'tests' stamp: 'cwp 11/7/2004 13:55'!
testDependencyOrder
	self 
		assert: #allDependenciesDo: 
		orders: #(a (b c)) 
		as: #(b c)! !

!MCVersionTest methodsFor: 'asserting' stamp: 'md 9/6/2005 18:41'!
assert: aSelector orders: sexpr as: expected unresolved: unresolved
	| missing |
	missing := OrderedCollection new.
	version := self versionFromTree: sexpr.
	version 
		perform: aSelector 
		with: [:ea | visited add: ea info name]
		with: [:ea | missing add: ea name].
	self assert: visited asArray = expected.
	self assert: missing asArray = unresolved.! !

!MCVersionTest methodsFor: 'tests' stamp: 'cwp 11/7/2004 14:56'!
testWithAllMissing
	self 
		assert: #withAllDependenciesDo: 
		orders: #(a ((b (d e)) (c missing))) 
		as: #(d e b a)! !

!MCWorkingAncestry commentStamp: '<historical>'!
The interim record of ancestry for a working copy, gets merged version added to the ancestry, and is used to create the VersionInfo when the working copy becomes a version. !
!MCWorkingAncestry methodsFor: 'initialization' stamp: 'ThierryGoubier 2/27/2015 11:17'!
lazy
	^ self! !

!MCWorkingAncestry methodsFor: 'adding' stamp: 'ThierryGoubier 2/26/2015 10:55'!
addStepChild: aVersionInfo
	stepChildren := stepChildren copyWith: aVersionInfo lazy! !

!MCWorkingAncestry methodsFor: 'accessing' stamp: 'MiguelCoba 7/25/2009 02:01'!
infoWithName: nameString message: messageString
	^ MCVersionInfo
		name: nameString
		id: UUID new
		message: messageString
		date: Date today
		time: Time now
		author: Author fullName
		ancestors: ancestors asArray
		stepChildren: self stepChildren asArray! !

!MCWorkingAncestry methodsFor: 'adding' stamp: 'ThierryGoubier 2/26/2015 10:54'!
addAncestor: aNode
	ancestors := (self ancestors reject: [ :each | aNode hasAncestor: each ]) copyWith: aNode lazy! !

!MCWorkingAncestry methodsFor: 'accessing' stamp: 'avi 2/13/2004 01:14'!
name
	^ '<working copy>'! !

!MCWorkingAncestry methodsFor: 'accessing' stamp: 'ThierryGoubier 2/26/2015 10:54'!
ancestors: anObject
	ancestors := anObject collect: [ :a | a lazy ]! !

!MCWorkingAncestry methodsFor: 'accessing' stamp: 'avi 2/13/2004 01:14'!
summary
	^ 'Ancestors: ', self ancestorString! !

!MCWorkingCopy commentStamp: 'StephaneDucasse 4/29/2011 20:44'!
MCWorkingCopy represents one version of a package in memory. It provides support for ancestry access, required packages and the repositories in which the package is managed.

Instance Variables:
	versionInfo	<MCAncestry>
	ancestry	<MCWorkingAncestry>
	counter	<Number>
	repositoryGroup	<MCRepositoryGroup>
	requiredPackages	<Collection>!
!MCWorkingCopy methodsFor: 'accessing' stamp: 'avi 2/13/2004 01:13'!
ancestry
	^ ancestry! !

!MCWorkingCopy methodsFor: 'accessing' stamp: 'bp 11/21/2010 18:33'!
description
	^ self packageNameWithStar, ' (', (ancestry ancestorStringWithout: self packageName), ')'! !

!MCWorkingCopy methodsFor: '*GT-SpotterExtensions-Core-private' stamp: 'StefanReichhart 2/17/2015 18:08'!
versionInfo
	^ self ancestors 
		ifNotEmptyDo: [ :list | list first ] 
		ifEmpty: [ nil ]! !

!MCWorkingCopy methodsFor: 'private' stamp: 'CamilloBruni 4/24/2012 15:22'!
uniqueVersionName
	|versionName|
	counter := nil.
	'Creating unique version number' 
		displayProgressFrom: 0 
		to: 1 
		during: [ :arg|
			[versionName := self nextVersionName.
			self repositoryGroup includesVersionNamed: versionName] whileTrue ].
	^ versionName! !

!MCWorkingCopy methodsFor: '*Komitter' stamp: 'BenjaminVanRyseghem 11/22/2013 16:21'!
remotes

	^ self repositoryGroup remotes! !

!MCWorkingCopy methodsFor: 'accessing' stamp: 'SeanDeNigris 7/17/2012 15:50'!
theCachedRepository

	^ MCCacheRepository uniqueInstance.! !

!MCWorkingCopy methodsFor: '*Komitter' stamp: 'BenjaminVanRyseghem 11/27/2013 16:58'!
silentlyNewVersionWithName: nameString message: messageString in: aRepository
	
	| info deps |
	info := ancestry infoWithName: nameString message: messageString.
	ancestry := MCWorkingAncestry new addAncestor: info.
	self modified: true.
	
	deps := self collectDependenciesWithMessage: messageString in: aRepository.
	
	(self repositoryGroup includes: aRepository) 
		ifFalse: [ self repositoryGroup addRepository: aRepository ].

	^ MCVersion
		silentlyPackage: package
		info: info
		snapshot: package snapshot
		dependencies: deps! !

!MCWorkingCopy methodsFor: 'accessing' stamp: 'CamilloBruni 3/2/2012 14:42'!
loadRemoteDependenciesIn: aRepository
	"load the remote dependencies of all packages in parallel"
	| dependencies |
	dependencies := self 
		requiredPackagesParallelCollect: [ :aPackage|
			(aPackage workingCopy closestAncestorSnapshotIn: aRepository) definitions.] 
		withMessage: 'Loading remote dependencies...'.
	^ dependencies 
		inject: OrderedCollection new
		into: [ :all :deps| all addAll: deps ]! !

!MCWorkingCopy methodsFor: 'accessing' stamp: 'SeanDeNigris 6/21/2012 09:07'!
requiredPackagesParallelCollect: aBlock withMessage: aMessage
	"load the remote dependencies of all packages in parallel"

	| packages progress results maxConcurrentConnections connectionThrottle addSemaphore |
	
	results := OrderedCollection new.
	addSemaphore := Semaphore forMutualExclusion.
	connectionThrottle := Semaphore new.
	progress := 0.
	maxConcurrentConnections := 5.
	maxConcurrentConnections timesRepeat: [ connectionThrottle signal ]. "make room for maxConcurrentConnections"
	packages := self requiredPackages.
	
	aMessage displayProgressFrom: 0 to: packages size during: [ :bar|
		packages do: [ :aPackage| 
			connectionThrottle wait. "no more than maxConcurrentConnections"
			[|result|
				[
					result := aBlock value: aPackage.
					addSemaphore critical: [ "update the non-threadsafe collection"
						results add: result.
						bar current: (progress := progress + 1)]
				] ensure: [ connectionThrottle signal. "free a connection" ].
			] fork ]].
	
	maxConcurrentConnections timesRepeat: [ connectionThrottle wait ]. "wait for the last connection to finish"
	
	^ results! !

!MCWorkingCopy methodsFor: 'initialization' stamp: 'stephaneducasse 2/4/2006 20:47'!
initialize
	super initialize.
	ancestry := MCWorkingAncestry new! !

!MCWorkingCopy methodsFor: 'operations' stamp: 'abc 11/8/2013 17:11'!
newVersionWithName: nameString message: messageString in: aRepository
	
	| info deps |
	info := ancestry infoWithName: nameString message: messageString.
	ancestry := MCWorkingAncestry new addAncestor: info.
	self modified: true; modified: false.
	
	deps := self collectDependenciesWithMessage: messageString in: aRepository.
	
	(self repositoryGroup includes: aRepository) 
		ifFalse: [ self repositoryGroup addRepository: aRepository ].

	^ MCVersion
		package: package
		info: info
		snapshot: package snapshot
		dependencies: deps! !

!MCWorkingCopy methodsFor: 'operations' stamp: 'EstebanLorenzano 9/8/2013 11:51'!
newVersionWithMessage: aMessageString in: aRepository
	^ self 
		newVersionWithName: (self uniqueVersionNameIn: aRepository)  
		message: aMessageString
		in: aRepository.

	"^ (self requestVersionNameAndMessageWithSuggestion: self uniqueVersionName) ifNotNil:
		[:pair |
		self newVersionWithName: pair first message: aMessageString].
	"! !

!MCWorkingCopy methodsFor: 'accessing' stamp: 'avi 2/13/2004 20:02'!
needsSaving
	^ self modified or: [self requiredPackages anySatisfy: [:ea | ea workingCopy needsSaving]]! !

!MCWorkingCopy methodsFor: 'private' stamp: 'StephaneDucasse 8/14/2013 14:57'!
findSnapshotWithVersionInfo: aVersionInfo
    "when an ancestor inside the ancestor chain is not found, does not pass nil instead.
    With this change we can now browse history and delta between them without having to 
    have the complete history"
    "instead of asking for the user to add a new repository, or copy the the missing package we simply
    return an empty Snapshot by returning nil"

    ^ aVersionInfo
        ifNil: [MCSnapshot empty]
        ifNotNil: [(self repositoryGroup versionWithInfo: aVersionInfo ifNone: [nil])
            ifNil: [MCSnapshot empty]
            ifNotNil: [:aVersion | aVersion snapshot]]! !

!MCWorkingCopy methodsFor: 'operations' stamp: 'avi 2/13/2004 01:07'!
notifyNoCommonAncestorWith: aVersion
	self notify:
'Could not find a common ancestor between (',
aVersion info name,
') and (',
ancestry ancestorString, ').
Proceeding with this merge may cause spurious conflicts.'! !

!MCWorkingCopy methodsFor: 'operations' stamp: 'stephaneducasse 2/4/2006 20:47'!
clearRequiredPackages
	requiredPackages := nil! !

!MCWorkingCopy methodsFor: '*Komitter' stamp: 'BenjaminVanRyseghem 11/24/2013 20:30'!
baseSnapshot

	^ self ancestors
		ifEmpty: [ nil ]
		ifNotEmpty: [ :ancestors | self findSnapshotWithVersionInfo: ancestors first ]! !

!MCWorkingCopy methodsFor: 'operations' stamp: 'avi 2/13/2004 01:07'!
adopt: aVersion
	ancestry addAncestor: aVersion info.
	self changed.! !

!MCWorkingCopy methodsFor: 'operations' stamp: 'EstebanLorenzano 9/8/2013 10:37'!
newVersionIn: aRepository
	^ (self requestVersionNameAndMessageWithSuggestion: (self uniqueVersionNameIn: aRepository)) 
		ifNotNil: [:pair |
			self 
				newVersionWithName: pair first trimBoth 
				message: pair last 
				in: aRepository ].
! !

!MCWorkingCopy methodsFor: 'accessing' stamp: 'CamilloBruni 9/30/2011 16:25'!
snapshot
	^ self package snapshot! !

!MCWorkingCopy methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/24/2015 14:45'!
spotterPackageRepositoriesFor: aStep
	<spotterOrder: 10>
	aStep listProcessor
		title: 'Package repositories';
		allCandidates: [ self repositoryGroup repositories ];
		itemName: [ :item | item description ];
		actLogic: [ :item | self spotterCommit: self in: item ];
		filter: GTFilterSubstring! !

!MCWorkingCopy methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/24/2015 14:45'!
spotterMonticelloPackageFor: aStep
	<spotterOrder: 21>
	aStep listProcessor
		title: 'Monticello Package';
		allCandidates: [ Array with: self package ];
		itemIcon: [ Smalltalk ui icons iconNamed: #monticelloPackageIcon ];
		filter: GTFilterSubstring! !

!MCWorkingCopy methodsFor: 'private' stamp: 'EstebanLorenzano 9/8/2013 10:36'!
uniqueVersionNameIn: aRepository
	|versionName|
	counter := nil.
	'Creating unique version number' 
		displayProgressFrom: 0 
		to: 1 
		during: [ :arg|
			[versionName := self nextVersionName.
			aRepository includesVersionNamed: versionName] whileTrue ].
	^ versionName! !

!MCWorkingCopy methodsFor: 'private' stamp: 'avi 2/4/2004 14:11'!
versionSeparator
	^ $_! !

!MCWorkingCopy methodsFor: 'accessing' stamp: 'avi 1/20/2004 16:04'!
requirePackage: aPackage
	(self requiredPackages includes: aPackage) ifFalse: [requiredPackages add: aPackage]! !

!MCWorkingCopy methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
requiredPackages
	^ requiredPackages ifNil: [requiredPackages := OrderedCollection new]! !

!MCWorkingCopy methodsFor: 'operations' stamp: 'stephaneducasse 2/4/2006 20:47'!
loaded: aVersion
	ancestry := MCWorkingAncestry new addAncestor: aVersion info.
	requiredPackages := OrderedCollection withAll: (aVersion dependencies collect: [:ea | ea package]).
	self modified: false.
	self changed! !

!MCWorkingCopy methodsFor: 'repositories' stamp: 'stephaneducasse 2/4/2006 20:47'!
repositoryGroup
	^ repositoryGroup ifNil: [repositoryGroup := MCRepositoryGroup new]! !

!MCWorkingCopy methodsFor: 'accessing' stamp: 'stephane.ducasse 2/6/2009 18:31'!
removeRequiredPackage: aPackage

	requiredPackages remove: aPackage ifAbsent: []
! !

!MCWorkingCopy methodsFor: 'repositories' stamp: 'stephaneducasse 2/4/2006 20:47'!
repositoryGroup: aRepositoryGroup
	repositoryGroup := aRepositoryGroup! !

!MCWorkingCopy methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/26/2015 15:55'!
spotterAncestorsFor: aStep
	<spotterOrder: 2>
	self flag: #maybeRewriteForDirectStreaming.
	aStep listProcessor
		title: 'Ancestors';
		allCandidates: [ self allAncestors ];
		filter: GTFilterSubstring! !

!MCWorkingCopy methodsFor: 'private' stamp: 'bf 9/8/2005 10:58'!
possiblyNewerVersions

	^Array streamContents: [:strm |
		self repositoryGroup repositories do: [:repo |
			strm nextPutAll: (self possiblyNewerVersionsIn: repo)]]! !

!MCWorkingCopy methodsFor: '*Komitter' stamp: 'BenjaminVanRyseghem 12/6/2013 21:38'!
collectSliceDependenciesWithMessage: messageString in: aRepository
	
	^ self requiredPackages collect: [:aPackage | 
			MCVersionDependency
				package: aPackage
				info:  aPackage version info ]
	! !

!MCWorkingCopy methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
versionInfo: aVersionInfo
	ancestry := MCWorkingAncestry new addAncestor: aVersionInfo! !

!MCWorkingCopy methodsFor: 'operations' stamp: 'CamilloBruni 1/19/2012 18:35'!
changesRelativeToRepository: aRepository
	^ self completeSnapshot patchRelativeToBase: (self closestAncestorSnapshotIn: aRepository).! !

!MCWorkingCopy methodsFor: 'printing' stamp: 'sd 3/15/2008 14:13'!
printOn: aStream

	super printOn: aStream.
	package name ifNotNil: [ aStream nextPutAll: '(' , package name asString, ')'].! !

!MCWorkingCopy methodsFor: 'accessing' stamp: 'ChristopheDemarey 2/27/2015 15:21'!
currentVersionInfo
	^ (self needsSaving or: [ancestry ancestors isEmpty])
		ifTrue: [ (self newVersionIn: self repositoryGroup) 
						ifNotNil: [ :version | version info ] ]
		ifFalse: [ancestry ancestors first]! !

!MCWorkingCopy methodsFor: 'operations' stamp: 'EstebanLorenzano 4/15/2014 14:11'!
unload
	"Unloads mcpackage, rpackage, classes and method extensions from this working copy"
	MCPackageLoader unloadPackage: self package.		
	package packageSet unregister.
	self unregister.
! !

!MCWorkingCopy methodsFor: 'accessing' stamp: 'EstebanLorenzano 9/8/2013 10:39'!
currentVersionInfoWithMessage: aMessageString in: aRepository
	^ (self needsSaving or: [ancestry ancestors isEmpty])
		ifTrue: [ (self newVersionWithMessage: aMessageString in: aRepository) info ]
		ifFalse: [ancestry ancestors first]! !

!MCWorkingCopy methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 12/3/2014 07:34'!
spotterCommit: workingCopy in: aRepository
	| newVersion |

	newVersion := workingCopy newVersionIn: aRepository.
	newVersion ifNil: [ ^ self ].
	Cursor wait showWhile: [
		[ 	aRepository storeVersion: newVersion.
			aRepository storeDependencies: newVersion ] 
		ensure: [ (MCVersionInspector new version: newVersion) show ]]! !

!MCWorkingCopy methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/17/2015 17:01'!
gtDisplayOn: stream
	ancestry ancestors isEmpty 
		ifTrue: [ 
			super gtDisplayOn: stream. stream nextPutAll: ' (unsaved)' ]
		ifFalse: [ 
			ancestry ancestors first gtDisplayOn: stream.
			self needsSaving ifTrue: [ stream nextPutAll: ' (modified)' ] ]
		! !

!MCWorkingCopy methodsFor: '*GT-SpotterExtensions-Core-private' stamp: 'StefanReichhart 2/17/2015 19:22'!
allAncestors
	^ self versionInfo 
		ifNotNilDo: [ :versionInfo | versionInfo allAncestors ]
		ifNil: [ #() ]! !

!MCWorkingCopy methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/26/2015 15:55'!
spotterPackageFor: aStep
	<spotterOrder: 21>
	self flag: #maybeRewriteForDirectStreaming.
	aStep listProcessor
		title: 'Packages';
		allCandidates: [ self package correspondingRPackage 
			ifNotNilDo: [ :rpackage | { rpackage } ] 
			ifNil: [ { } ] ];
		itemName: [ :item | item name ];
		itemIcon: [ Smalltalk ui icons iconNamed: #packageIcon ];
		filter: GTFilterSubstring! !

!MCWorkingCopy methodsFor: 'private' stamp: 'bf 9/8/2005 10:58'!
possiblyNewerVersionsIn: aRepository

	^aRepository possiblyNewerVersionsOfAnyOf: self ancestors! !

!MCWorkingCopy methodsFor: 'accessing' stamp: 'CamilloBruni 1/19/2012 18:34'!
completeSnapshot
	"return a complete snapshot of the loaded sources in this working copy. 
	unlike snapshot this includes also the snapshots of all packages"
	
	| definitions |
	
	definitions := self snapshot definitions asOrderedCollection.
	
	self requiredPackages 
		do: [ :aPackage| definitions addAll: aPackage workingCopy completeSnapshot definitions ]
		displayingProgress: [ :item| 'Loading dependencies from: ', item name ].
	
	^ MCSnapshot fromDefinitions: definitions! !

!MCWorkingCopy methodsFor: 'accessing' stamp: 'CamilloBruni 3/2/2012 13:32'!
closestAncestorSnapshotIn: aRepository
	
	"Returns a complete Snapshot including all required packages by recurisveliy walking all required package and trying to find the closes ancestor in the given repository"
	
	| definitions ancestorVersion|
	
	ancestorVersion := aRepository closestAncestorVersionFor: ancestry ifNone: [].
	
	definitions := ancestorVersion 
						ifNil: [ OrderedCollection new ] 
						ifNotNil: [ ancestorVersion snapshot definitions ].
	
	definitions addAll: (self loadRemoteDependenciesIn: aRepository).
	
	^ MCSnapshot fromDefinitions: definitions! !

!MCWorkingCopy methodsFor: 'operations' stamp: 'EstebanLorenzano 9/8/2013 10:39'!
collectDependenciesWithMessage: messageString in: aRepository
	
	^ self requiredPackages collect: [:aPackage | 
			MCVersionDependency
				package: aPackage
				info:  (aPackage workingCopy 
					currentVersionInfoWithMessage: messageString 
					in: aRepository) ]
	! !

!MCWorkingCopy methodsFor: 'accessing' stamp: 'avi 2/13/2004 01:07'!
ancestors
	^ ancestry ancestors! !

!MCWorkingCopy methodsFor: '*Komitter' stamp: 'BenjaminVanRyseghem 12/6/2013 21:25'!
silentUniqueVersionNameIn: aRepository
	|versionName|

	counter := nil.
	[
		versionName := self nextVersionName.
		aRepository includesVersionNamed: versionName
	] whileTrue.

	^ versionName! !

!MCWorkingCopy methodsFor: 'private' stamp: 'ab 8/24/2003 20:38'!
requestVersionNameAndMessageWithSuggestion: aString
	^ (MCVersionNameAndMessageRequest new suggestedName: aString) signal! !

!MCWorkingCopy methodsFor: 'private' stamp: 'MiguelCoba 7/25/2009 02:01'!
nextVersionName
	| branch oldName base author |
	branch := ''.
	ancestry ancestors isEmpty
		ifTrue: [counter ifNil: [counter := 0]. base := package name]
		ifFalse:
			[oldName := ancestry ancestors first name.
			oldName last isDigit
				ifFalse: [base := oldName]
				ifTrue: [
					base := oldName copyUpToLast: $-.
					branch := ((oldName copyAfterLast: $-) copyUpToLast: $.) copyAfter: $. ].
			counter ifNil: [
				counter := (ancestry ancestors collect: [:each |
					each name last isDigit
						ifFalse: [0]
						ifTrue: [(each name copyAfterLast: $.) extractNumber]]) max]].

	branch isEmpty ifFalse: [branch := '.',branch].
	counter := counter + 1.
	author := Author fullName collect: [ :each | each isAlphaNumeric ifTrue: [ each ] ifFalse: [ $_ ] ].
	^ base , '-' , author , branch , '.' , counter asString! !

!MCWorkingCopy methodsFor: '*GT-SpotterExtensions-Core-private' stamp: 'StefanReichhart 2/17/2015 18:09'!
nextAncestors
	^ self versionInfo 
		ifNotNilDo: [ :versionInfo | versionInfo ancestors ]
		ifNil: [ #() ]! !

!MCWorkingCopy methodsFor: 'operations' stamp: 'CamilloBruni 9/15/2013 17:51'!
merge: targetVersion
	| ancestorInfo merger ancestorSnapshot packageSnapshot |
	targetVersion dependencies do: [:ea | ea resolve merge].
	ancestorInfo := targetVersion info commonAncestorWith: ancestry.
	
	ancestorInfo = targetVersion info ifTrue: [^ MCNoChangesException signal].
	
	packageSnapshot := package snapshot.
	ancestorSnapshot := ancestorInfo
							ifNotNil: [(self findSnapshotWithVersionInfo: ancestorInfo)]
							ifNil: [self notifyNoCommonAncestorWith: targetVersion.  MCSnapshot empty].
	
	(ancestry ancestors size = 1
		and: [ancestry ancestors first = ancestorInfo
				and: [(packageSnapshot patchRelativeToBase: ancestorSnapshot) isEmpty]])
				ifTrue: [^ targetVersion load].
	
	merger := MCThreeWayMerger 
				base: packageSnapshot
				target: targetVersion snapshot
				ancestor: ancestorSnapshot.
	((MCMergeResolutionRequest new merger: merger)
		signal: 'Merging ', targetVersion info name) = true 
			ifTrue:[
				merger loadWithNameLike: targetVersion info name.
				ancestry addAncestor: targetVersion info ].
	self changed! !

!MCWorkingCopy methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/24/2015 14:45'!
spotterAllRepositoriesFor: aStep
	<spotterOrder: 20>
	aStep listProcessor
		title: 'All other repositories';
		allCandidates: [ MCRepositoryGroup default repositories \ self repositoryGroup repositories ];
		itemName: [ :item | item description ];
		actLogic: [ :item | self spotterCommit: self in: item ];
		filter: GTFilterSubstring! !

!MCWorkingCopy methodsFor: 'operations' stamp: 'marcus.denker 11/10/2008 10:04'!
backportChangesTo: aVersionInfo
	| baseVersion fullPatch currentVersionInfo currentVersion newSnapshot newAncestry |
	currentVersionInfo := self currentVersionInfo.
	baseVersion := self repositoryGroup versionWithInfo: aVersionInfo.
	currentVersion := self repositoryGroup versionWithInfo: currentVersionInfo.
	fullPatch := currentVersion snapshot patchRelativeToBase: baseVersion snapshot.
	(MCChangeSelectionRequest new
		patch: fullPatch;
		label: 'Changes to Backport';
		signal ) ifNotNil:
		[:partialPatch |
		newSnapshot := MCPatcher apply: partialPatch to: baseVersion snapshot.
		newAncestry := MCWorkingAncestry new
							addAncestor: aVersionInfo;
							addStepChild: currentVersionInfo;
							yourself.
		MCPackageLoader updatePackage: package withSnapshot: newSnapshot.
		ancestry := newAncestry.
		self modified: false; modified: true]! !

!MCWorkingCopy methodsFor: '*Komitter' stamp: 'BenjaminVanRyseghem 12/6/2013 21:26'!
silentlyNewSliceVersionWithName: nameString message: messageString in: aRepository
	| info deps |
	
	info := ancestry infoWithName: nameString message: messageString.
	ancestry := MCWorkingAncestry new addAncestor: info.
	self 
		modified: true;
		modified: false.
	
	deps := self collectSliceDependenciesWithMessage: messageString in: aRepository.
	
	(self repositoryGroup includes: aRepository) 
		ifFalse: [ self repositoryGroup addRepository: aRepository ].

	^ MCVersion
		silentlyPackage: package
		info: info
		snapshot: package snapshot
		dependencies: deps! !

!MCWorkingCopy methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
metacelloPackageNameWithBranch
	"answer array with package name and package name with branch name"
	ancestry ancestors isEmpty
		ifTrue: [ 
			^ {(package name).
			(package name)} ].
	^ (GoferVersionReference name: self ancestors first name) metacelloPackageNameWithBranch! !

!MCWorkingCopy methodsFor: 'operations' stamp: 'CamilloBruni 1/19/2012 16:12'!
merged: aVersion
	ancestry addAncestor: aVersion info.
	aVersion dependencies do: [:ea | self requirePackage: ea package].
	self changed! !

!MCWorkingCopy class methodsFor: 'initialize' stamp: 'CamilleTeruel 7/30/2012 14:09'!
initialize
	"self initialize"
	registry ifNotNil: [ registry rehash ].
	self registerForNotifications.! !

!MCWorkingCopy class methodsFor: 'private' stamp: 'StephaneDucasse 8/17/2012 15:58'!
infoFromDictionary: aDictionary cache: cache
	| id |
	id := (aDictionary at: #id) asString.
	^ cache at: id ifAbsentPut:
		[MCVersionInfo
			name: (aDictionary at: #name ifAbsent: [''])
			id: (UUID fromString: id)
			message: (aDictionary at: #message ifAbsent: [''])
			date: ([Date fromString: (aDictionary at: #date)] ifError: [nil])
			time: ([Time fromString: (aDictionary at: #time)] ifError: [nil])
			author: (aDictionary at: #author ifAbsent: [''])
			ancestors: (self ancestorsFromArray: (aDictionary at: #ancestors ifAbsent: []) cache: cache)
			stepChildren: (self ancestorsFromArray: (aDictionary at: #stepChildren ifAbsent: []) cache: cache)]! !

!MCWorkingCopy class methodsFor: 'private' stamp: 'avi 9/13/2004 18:00'!
adoptVersionInfoFrom: anInstaller
	|viCache|
	viCache := Dictionary new.
	anInstaller versionInfo keysAndValuesDo: [:packageName :info |
		(self forPackage: (MCPackage named: packageName))
			versionInfo: (self infoFromDictionary:  info cache: viCache)].
	[anInstaller clearVersionInfo] on: Error do: ["backwards compat"].! !

!MCWorkingCopy class methodsFor: 'querying' stamp: 'EstebanLorenzano 4/14/2014 16:04'!
hasPackageNamed: aName
	" self hasPackageNamed: 'ConfigurationOfFuel' "
	
	^ MCWorkingCopy allManagers
		detect: [ :each | each packageName = aName ]
		ifNone: [ false ].! !

!MCWorkingCopy class methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/26/2015 17:55'!
gtExampleWorkingCopy
	<gtExample: 'Metacello working-copy'>
	^ (RPackageOrganizer default packageOf: GTSpotter) mcPackage 
		ifNotNilDo: [ :mcp | mcp workingCopy ]! !

!MCWorkingCopy class methodsFor: 'event registration' stamp: 'MarianoMartinezPeck 9/5/2012 15:05'!
registerForNotifications
	"self registerForNotifications"
	<systemEventRegistration>
	
	MCPackageManager announcer: nil.
	SystemAnnouncer uniqueInstance unsubscribe: self.
	self registerInterestOnSystemChangesOnAnnouncer: SystemAnnouncer uniqueInstance.! !

!MCWorkingCopy class methodsFor: 'private' stamp: 'avi 2/17/2004 01:23'!
ancestorsFromArray: anArray cache: aDictionary
	^ anArray ifNotNil: [anArray collect: [:dict | self infoFromDictionary: dict cache: aDictionary]]! !

!MCWorkingCopyBrowser commentStamp: 'TorstenBergmann 2/20/2014 15:53'!
Browser for working copies!
!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'CamilloBruni 8/3/2011 14:34'!
repositoryMaxSearchSize
	^self class repositoryMaxSearchSize! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'StephaneDucasse 2/11/2012 11:10'!
saveRepositories

	FileStream forceNewFileNamed: 'MCRepositories.st' do: [:f |
		MCRepositoryGroup default repositoriesDo: [:r |
			r asCreationTemplate ifNotNil: [:template |
				f nextPutAll: 'MCRepositoryGroup default addRepository: (', template , ')!!'; cr]]]! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'c 8/10/2010 22:58'!
workingCopyListChanged
	self changed: #workingCopyList.
	self changed: #workingCopyTree.
	self changed: #workingCopyTreePath.
	self changedButtons.
! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'GuillermoPolito 5/3/2013 13:31'!
repository
	^ repository! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'StephaneDucasse 6/2/2012 20:35'!
unsortedWorkingCopies
	^ self allManagers ! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'ab 7/19/2003 22:05'!
workingCopySelection
	^ self workingCopies indexOf: workingCopy! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'marcus.denker 11/10/2008 10:04'!
revertPackage
	self pickAncestorVersionInfo ifNotNil: [:info |
		(self repositoryGroup versionWithInfo: info
			ifNone: [^self inform: 'No repository found for ', info name]
		) load]! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'avi 9/11/2004 15:32'!
inspectWorkingCopy
	workingCopy ifNotNil: [workingCopy inspect]! !

!MCWorkingCopyBrowser methodsFor: 'initialization' stamp: 'StephanEggermont 1/2/2014 15:37'!
initialize
	super initialize.
	order := self class order.
	self registerToAnnouncer.
	
	workingCopyPattern := ''.
	repositoryPattern := ''.
	showOnlyRepositoriesFromWorkingCopy := true
	! !

!MCWorkingCopyBrowser methodsFor: 'metacello' stamp: 'AlexandreBergel 11/11/2010 16:55'!
hasAnyBaseline 
	^ self baseLines notEmpty! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'AndrewBlack 9/8/2009 09:29'!
removeRequiredPackage

	| allRequiredPackages |
	workingCopy ifNil: [^ self].
	allRequiredPackages := workingCopy requiredPackages.
	allRequiredPackages ifEmpty: [UIManager default inform: 'This package has no requirements'. ^ self].
	(self pickWorkingCopySatisfying: [:wc | allRequiredPackages includes: wc package]) 
		ifNotNil:
			[:required |
			workingCopy removeRequiredPackage: required package.
			self workingCopyListChanged]! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'ar 8/6/2009 18:25'!
newRepository
	| types index |
	types := MCRepository allConcreteSubclasses asArray.
	index := UIManager default chooseFrom: (types collect: [:ea | ea description])
				title: 'Repository type:'.
	^ index = 0 ifFalse: [(types at: index) morphicConfigure]! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'GuillermoPolito 5/29/2011 14:46'!
editLoadScripts

	| menu |
	self hasWorkingCopy ifFalse: [^self].
	menu := UIManager default newMenuIn: self for: self.
	menu add: 'edit preamble' selector: #editScript: argument: #preamble.
	menu add: 'edit postscript' selector: #editScript: argument: #postscript.
	menu add: 'edit preambleOfRemoval' selector: #editScript: argument: #preambleOfRemoval.
	menu add: 'edit postscriptOfRemoval' selector: #editScript: argument: #postscriptOfRemoval.
	menu popUpInWorld.! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'MartinDias 9/26/2014 10:59'!
addSlice
	(MCSliceMaker openFor: self window)
		ifNotNil: [:sliceInfo | workingCopy := sliceInfo makeSlice.
			workingCopy ifNotNil: [
				workingCopy repositoryGroup 
					addRepository: MCHttpRepository pharoRepository;
					addRepository: MCHttpRepository pharoInboxRepository.
				workingCopyWrapper := MCDependentsWrapper with: workingCopy model: self.
					self repositorySelection: 0.]].
	self workingCopyListChanged; changed: #workingCopySelection; repositoryListChanged.
	self changedButtons.
! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'avi 2/13/2004 01:13'!
viewHistory
	workingCopy ifNotNil:
		[(MCWorkingHistoryBrowser new
				ancestry: workingCopy ancestry;
				package: workingCopy package)
			label:  'Version History: ',  workingCopy packageName;
			show]! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'avi 9/14/2004 14:57'!
canBackport
	^ self hasWorkingCopy and: [workingCopy needsSaving not]! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'tbn 7/6/2010 17:07'!
orderSpecs
	^ {
		'Sort alphabetically' -> [ :a :b | a package name <= b package name ].
		'Sort dirty first' -> [ :a :b | 
			a needsSaving = b needsSaving
				ifTrue: [ a package name <= b package name ]
				ifFalse: [ a needsSaving ] ].
		'Sort dirty last' -> [ :a :b | 
			a needsSaving = b needsSaving
				ifTrue: [ a package name <= b package name ]
				ifFalse: [ b needsSaving ] ].
		'Only dirty' -> [ :a :b | a package name <= b package name ]
	}! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'ab 7/22/2003 02:22'!
repositorySelection
	^ self repositories indexOf: self repository! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'EstebanLorenzano 9/12/2012 13:36'!
recompilePackage
	workingCopy package packageSet methods
		do: [:ea | ea actualClass recompile: ea selector]
		displayingProgress: 'Recompiling...'! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'lr 10/14/2008 14:24'!
workingCopyTreeMenu: aMenu
	^ self workingCopyListMenu: aMenu! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'BenjaminVanRyseghem 12/5/2013 16:21'!
workingCopyTree
	| workingCopies |
	workingCopies := self workingCopies.
	
	"filter the working copy list if there is a serach string"
	workingCopyPattern ifNotEmpty: [ 
		workingCopies := workingCopies select: [ :each| each package name asLowercase includesSubstring: workingCopyPattern ]].
			
	^ workingCopies collect: [:each| MCDependentsWrapper with: each model: self].! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'CamilloBruni 4/10/2013 11:14'!
saveVersion
	self canSave ifFalse: [ ^ self ].
	"fork the whole version creation "
	[ self basicSaveVersionIn: self repository ] fork! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'ar 2/14/2004 02:46'!
unloadPackage
	workingCopy unload.
	self workingCopySelection: 0.
	self workingCopyListChanged.! !

!MCWorkingCopyBrowser methodsFor: 'metacello' stamp: 'AlexandreBergel 10/27/2010 23:17'!
baseLines 
	| existingBaselines |
	existingBaselines := self configurationClass methods select: [:cm | cm selector beginsWith: 'baseline'].
	existingBaselines := (existingBaselines collect: [:m | m pragmas first argumentAt: 1]) asSortedCollection.
	^ existingBaselines! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'CamilloBruni 8/3/2011 14:51'!
removeRepository
	self repository ifNotNil:
		[:repos |
		self repositoryGroup removeRepository: repos.
		self repositorySelection: (1 min: self repositories size)].
	self repositoryListChanged.
	self changedButtons.
! !

!MCWorkingCopyBrowser methodsFor: 'metacello' stamp: 'MarcusDenker 7/9/2014 15:57'!
createVersionForBlessing: blessingSelector
	"blessingSelector = #release or #development"
	 
	| existingVersions msg initialAnswer newVersionNumber selectorName stream mcWorkingCopy |
	existingVersions := self configurationClass methods select: [:cm | cm selector beginsWith: 'version'].
	existingVersions := (existingVersions collect: [:m | m pragmas first argumentAt: 1]) asSortedCollection.
	
	msg := ''.
	existingVersions size > 4
		ifTrue: [ 
			msg := 'Last 4 versions: ', 
			(existingVersions copyFrom: (existingVersions size - 4) to: existingVersions size)
				 asArray printString, String cr ].
	
	existingVersions size > 0
		ifTrue: [ initialAnswer := existingVersions last, '.1' ]
		ifFalse: [ initialAnswer := '1.0' ].
	
	newVersionNumber := UIManager default request: msg initialAnswer: initialAnswer.
	newVersionNumber ifNil: [ ^ self ].

	selectorName := newVersionNumber copyWithoutAll: '.-'.
	stream := WriteStream on: String new.
	stream nextPutAll: 'version'.
	stream nextPutAll: selectorName.
	stream nextPutAll: ': spec 
        <version: '''.
	stream nextPutAll: newVersionNumber.
	stream nextPutAll: ''' imports: #(''', self lastBaseLine,''')>

        spec for: #common do: [
                spec blessing: ',blessingSelector printString,'.
'.

	self dependentPackages 
		do: [:pName | 
				stream nextPutAll: '			spec package: ''', pName, ''' with: '''.
							
				mcWorkingCopy := (MCPackage named: pName) workingCopy.
				mcWorkingCopy needsSaving ifTrue: [ self inform: 'The configuration you want to save depends on the package ', pName, '. You first need to save this package in order to create the version'. ^ self ].
				stream nextPutAll: (mcWorkingCopy ancestry ancestors first name).
			
				stream nextPutAll: '''.', String cr ].
	stream nextPutAll: '                ].'.

	self configurationClass compile: stream contents classified: 'versions'.

! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'bf 6/21/2005 15:50'!
changedButtons
	self changed: #hasWorkingCopy.
	self changed: #canSave.
	self changed: #canBackport.
	self changed: #hasRepository.
! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'lr 10/14/2008 14:25'!
order: anInteger
	self class order: (order := anInteger).
	self changed: #workingCopyList; changed: #workingCopyTree! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'ar 2/14/2004 02:38'!
workingCopySelectionWrapper
	^workingCopyWrapper! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'DanielAviv 1/29/2013 16:43'!
viewPastComments
	"Visualize past comments on a package."

       workingCopy ifNotNil:
               [(UIManager default
                       edit: (String streamContents:
                                       [:s|
                                       "Ignore the initial MCWorkingAncestry instance."
                                       workingCopy ancestry topologicalAncestors allButFirst
                                               do: [:versionInfo|
                                                       s nextPutAll: versionInfo summary]
                                               separatedBy: [s cr; cr"; next: 32 put: $-; cr; cr"]])
                       label: 'Version History: ',  workingCopy packageName) ]! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'CamilloBruni 8/3/2011 14:43'!
workingCopySearchMaxSize
	^self class workingCopySearchMaxSize! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'CamilloBruni 8/3/2011 14:51'!
workingCopy: wc
	workingCopy := wc.
	self changed: #workingCopySelection; repositoryListChanged.
	self changedButtons.
! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'TorstenBergmann 11/4/2014 17:48'!
repositoryIcon: a
 
	^Smalltalk ui icons monticelloPackageIcon	! !

!MCWorkingCopyBrowser methodsFor: 'metacello' stamp: 'AlexandreBergel 10/27/2010 22:48'!
browseConfiguration
	self configurationClass browse! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'CamilloBruni 8/3/2011 14:40'!
repositorySearchMaxSize
	^self class repositorySearchMaxSize! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'DanielUber 6/9/2012 09:39'!
repositoryList
	|repositories|
	repositories := self repositories.

	^ repositories collect: [:ea | ea description]! !

!MCWorkingCopyBrowser methodsFor: 'menu spec' stamp: 'StephaneDucasse 5/19/2011 14:51'!
unloadPackageMenuSpec

	^ #(#('Unload package' #unloadPackage)
		#('Delete working copy' #deleteWorkingCopy))! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'nk 3/9/2004 14:39'!
pickWorkingCopy
	^self pickWorkingCopySatisfying: [ :c | true ]! !

!MCWorkingCopyBrowser methodsFor: 'menu spec' stamp: 'StephaneDucasse 5/19/2011 14:33'!
configurationMenuSpec

	^ #(#('Add new baseline' #addMetacelloBaseline) 
		#('Browse configuration' #browseConfiguration) 
		#('Create release version' #createReleaseVersion) 
		#('Create development version' #createDevelopmentVersion))
! !

!MCWorkingCopyBrowser methodsFor: 'menu spec' stamp: 'StephaneDucasse 5/19/2011 14:44'!
revertPackageMenuSpec

	^ #(#('Revert package...' #revertPackage) 
			   #('Recompile package' #recompilePackage)
			   #('Backport package...' #backportChanges)
			   #('Inspect package' #inspectWorkingCopy))
! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'StephaneDucasse 5/19/2011 14:52'!
workingCopyListMenu: aMenu

	workingCopy ifNil: [ ^ aMenu ].
	(workingCopy package name beginsWith: 'ConfigurationOf') ifTrue: [
		self fillMenu: aMenu fromSpecs: self configurationMenuSpec.
		aMenu addLine ].
	self fillMenu: aMenu fromSpecs: self historyMenuSpec.
	aMenu addLine.
	self fillMenu: aMenu fromSpecs: self packageMenuSpec.
	aMenu addLine.
	self fillMenu: aMenu fromSpecs: self revertPackageMenuSpec.
	aMenu addLine.
	self fillMenu: aMenu fromSpecs: self unloadPackageMenuSpec.
	aMenu addLine.
	1 to: self orderSpecs size do: [ :index | 
		aMenu
			addUpdating: #orderString:
			target: self
			selector: #order:
			argumentList: {index} ].
	^ aMenu ! !

!MCWorkingCopyBrowser methodsFor: 'metacello' stamp: 'MarcusDenker 7/9/2014 15:58'!
dependentPackages
	"Return the list of dependent packages for the last baseline"

	"This method must be rewritten. It is a shame..."
	
	|  lastBaseLineName packageNames |
	lastBaseLineName := self lastBaseLine.

	packageNames := OrderedCollection new.
	(self configurationClass project version: lastBaseLineName)
		record loadDirective packageDirectivesDo: [:directive |
			packageNames add: directive file ].
		
	^ packageNames collect: [:p | 
		(p includes: $.)
			ifTrue: [ (p includes: $-)
						ifTrue: [ (p copyUpToLast: $-) ]
						ifFalse: [ (p copyUpTo: $.) ] ]
			ifFalse: [ p ]
		]

"	lastBaseLineMethod := (self configurationClass methods 
							select: [:cm | cm selector beginsWith: 'baseline'])
								select: [:cm | cm pragmas first arguments first = lastBaseLineName].
	lastBaseLineMethod := lastBaseLineMethod first.
"	
	"This does not work!! No idea why!!"
"	versionConstructor := (Smalltalk at: #MetacelloVersionConstructor) new.
	self configurationClass new perform: lastBaseLineMethod selector with: versionConstructor.
	versionSpec := (Smalltalk at: #MetacelloVersionSpec) new.
	versionConstructor root: versionSpec
"
	"This is probably the ugliest piece of code I ever wrote. There is really nothing to be proud of."
"	possiblePackageNames := 
		((lastBaseLineMethod literals select: [ :l | l class == ByteString ])
			reject: [:l | l beginsWith: 'http']).
	packageInfos := PackageInfo allPackages select: [ :pi | possiblePackageNames includes: pi packageName ].
"
	"packageInfos now contains the package that the lastest baseline depends on"
	"^ packageInfos collect: #packageName"

	! !

!MCWorkingCopyBrowser methodsFor: 'menu spec' stamp: 'TorstenBergmann 11/4/2014 17:49'!
widgetSpecs
	| searchBarOffset |
	
	searchBarOffset := 30 + StandardFonts defaultFont height + 10.
	
	^ {
		"send fractions offsets"
		{{#buttonRow}. {0. 0. 1. 0}. {0. 0. 0. 30.}}.
		
		{{#workingCopySearchField}. {0. 0. 0.5. 0.}. {0. 30. 0. searchBarOffset.}}.
		{{#treeMorph:. #workingCopy}. {0. 0. 0.5. 1}. {0. searchBarOffset+3. 0. 0.}}.
		
		{{#repositorySearchField}. {0.5. 0. 0.85. 0.}. {0. 30. 0. searchBarOffset.}}.
		{{#showOnlyRepositoriesFromWorkingCopyField}. { 0.85. 0. 1. 0.}. { 0. 30. 0. searchBarOffset .}}.
		{{#listMorph:selection:menu:icon: . #repositoryList . #repositorySelection . #repositoryListMenu: . #repositoryIcon:}. {0.5. 0. 1. 1}. {0. searchBarOffset+3. 0. 0.}}.
		}.! !

!MCWorkingCopyBrowser methodsFor: 'metacello' stamp: 'AlexandreBergel 11/11/2010 16:54'!
createReleaseVersion
	self hasAnyBaseline 
		ifFalse: [ UIManager default inform: 'Please, define a baseline first'. ^ self ].
		
	^ self createVersionForBlessing: #release! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'EstebanLorenzano 9/12/2012 13:36'!
editScript: scriptSymbol

	| script |
	script := workingCopy packageSet perform: scriptSymbol.
	script openLabel: scriptSymbol asString, ' of the Package ', workingCopy package name.! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'StephaneDucasse 5/19/2011 14:55'!
enterIssueNumber
	| issue |
	issue := UIManager default request: 'Please give the issue number' initialAnswer: '00000'.
	issue isEmptyOrNil ifFalse: [
		issue isAllDigits ifFalse: [
			UIManager default inform: 'You must give us a number'.
			issue := self enterIssueNumber]].
	^ issue
	! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'CamilloBruni 4/11/2013 17:28'!
storeVersion: newVersion in: aRepository
	self retryOnCredentialRequest: [ aRepository storeVersion: newVersion ]! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'StephaneDucasse 5/19/2011 14:52'!
workingCopySelection: aNumber
	self workingCopy: 
		(aNumber = 0 
			ifTrue: [nil]
			ifFalse: [self workingCopies at: aNumber]).	! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'StephanEggermont 1/2/2014 15:33'!
repositoryListMenu: aMenu
	self repository ifNil: [^ aMenu].
	self fillMenu: aMenu fromSpecs: self repositoryMenuSpec.
	aMenu add: (self repository alwaysStoreDiffs
					ifTrue: ['Store full versions']
					ifFalse: ['Store diffs'])
		target: self
		selector: #toggleDiffs.
		
	^ aMenu
				! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'stephaneducasse 2/4/2006 20:47'!
repository: aRepository
	repository := aRepository.
	workingCopy ifNotNil: [self defaults at: workingCopy put: aRepository]! !

!MCWorkingCopyBrowser methodsFor: 'metacello' stamp: 'ClementBera 7/26/2013 16:50'!
addMetacelloBaseline
	| baselineNumber existingBaselines msg selectorName  addedPackages package stream packagePattern |
	
	"0 -- must have a repository selected"
	repository ifNil: [ 
			UIManager default inform: 'Please select a repository and try again'. 
			^self ].
	"1 -- Selecting baseline name"
	existingBaselines := self baseLines. 
	
	existingBaselines size > 0  
		ifTrue: [msg := 'Current baselines:', String cr, (existingBaselines inject: '' into: [:sum :el | sum, el, String cr]), 'Enter a new baseline number']
		ifFalse: [msg := 'Enter a new baseline number ("-baseline" will be automatically added)'].
		
	baselineNumber := UIManager default request: msg initialAnswer: '1.0'.
	baselineNumber ifNil: [ ^ self ].
	
	"2 -- add package names"
	addedPackages := OrderedCollection new.
	packagePattern := UIManager default request: 'Please enter a pattern to filter package names' initialAnswer: '*'.
	[ | packageNames workingCopies |
	 packageNames := OrderedCollection new.
	workingCopies := OrderedCollection new.
	self workingCopies do: [:pkg | 
		((packagePattern match: pkg package name) and: [ (addedPackages includes: pkg package name) not ])
			ifTrue: [ 
				packageNames add: pkg package name.
				workingCopies add: pkg ]].
	 package := 
		UIManager default 
			chooseFrom: packageNames
			values: workingCopies
			title: 'Add dependent package (cancel to stop)'.
	 package ifNotNil: [addedPackages add: package package name ]
	] doWhileTrue: [ package notNil ].

	
	"3 -- Creating baseline"
	selectorName := baselineNumber copyWithoutAll: '.-'.
	stream := WriteStream on: String new.
	stream nextPutAll: 'baseline'.
	stream nextPutAll: selectorName.
	stream nextPutAll: ': spec 
        <version: '''.
	stream nextPutAll: baselineNumber.
	stream nextPutAll: '-baseline''>
        
        spec for: #common do: [
                spec blessing: #baseline.
                spec repository: '''.

	stream nextPutAll: repository description.
	stream nextPutAll: '''.    
                "spec 
                        package: ''Example-Core'';
                        package: ''Example-Tests'' with: [ spec requires: ''Example-Core'' ]"
'.
	addedPackages 
		do: [:pName | stream nextPutAll: '			spec package: ''', pName, '''.', String cr].
	stream nextPutAll: '                ].'.

	self configurationClass compile: stream contents classified: 'baselines'.
! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'EstebanLorenzano 7/21/2014 13:35'!
addMetacelloConfiguration
	|name|
	name := UIManager default 
				request: 'Name of the new Metacello configuration (e.g., ConfigurationOfYourSoftware)' translated 
				initialAnswer: 'ConfigurationOf'. 
	name isEmptyOrNil ifFalse:
		[ 
			"Check if the class does not exist"
			(Smalltalk globals includesKey: name asSymbol) ifTrue: [ self error: 'Class already exist'].

			"Check if metacello is loaded"
			(Smalltalk globals includesKey: #MetacelloConfigTemplate) ifFalse: 
				[Gofer new
  					squeaksource: 'MetacelloRepository';
  					package: 'ConfigurationOfMetacello';
 					 load.
				(Smalltalk at: #ConfigurationOfMetacello) perform: #loadLatestVersion].

			"Create the configuration"
			((Smalltalk globals at: #MetacelloConfigTemplate) duplicateClassWithNewName: name asSymbol)
        			category: name asString.

			"We create the package that has the same name"
			RPackageOrganizer default registerPackageNamed: name.
			
			"Select the package"
			workingCopy := MCWorkingCopy forPackage: (MCPackage new name: name).
			repository ifNotNil: [ workingCopy repositoryGroup addRepository: repository ].
			workingCopyWrapper := nil.
			workingCopy modified: true.
			self workingCopySelection: 0.
			self repositorySelection: 0 ].

	self workingCopyListChanged; 
		changed: #workingCopySelection;
		repositoryListChanged.
	self changedButtons.! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'ar 2/14/2004 02:57'!
workingCopySelectionWrapper: aWrapper
	workingCopyWrapper := aWrapper.
	self changed: #workingCopySelectionWrapper.
	self workingCopy: (aWrapper ifNotNil:[aWrapper item])! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'CamilloBruni 4/11/2013 17:50'!
retryOnCredentialRequest: aBlock
	aBlock	on: MCPermissionDenied do: [ :error | |credentials| 
		credentials := MCCredentialsRequest 
							signalUrl: repository location
							username: repository user
							password: repository password.
		credentials 
			ifNotNil: [ 
				self repository credentials: credentials.
				^ self retryOnCredentialRequest: aBlock ]]! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'BenjaminVanRyseghem 12/6/2013 13:17'!
workingCopySearchAccept: string
	| aString |

	aString := string ifNil: [ '' ].
	workingCopyPattern = aString asLowercase ifTrue: [ ^ self ].
	workingCopyPattern := aString asLowercase.
		
	packageProcess ifNotNil: [ packageProcess terminate ].	
	packageProcess := [ self workingCopyListChanged ] fork.! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'CamilloBruni 8/3/2011 14:50'!
addRepository: aRepository
	self repository: aRepository.
	self repositoryGroup addRepository: aRepository.
	self repositoryListChanged; 
		changed: #repositorySelection.
	self changedButtons.! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'lr 3/23/2010 09:57'!
workingCopyTreeLabel: aWrapper
	^ aWrapper asString! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'CamilloBruni 9/30/2011 16:26'!
browseWorkingCopy
	workingCopy ifNotNil:
		[(MCSnapshotBrowser forSnapshot: workingCopy completeSnapshot)
			label: 'Snapshot Browser: ', workingCopy packageName;
			show]! !

!MCWorkingCopyBrowser methodsFor: 'menu spec' stamp: 'StephaneDucasse 5/19/2011 14:41'!
historyMenuSpec

	^ #(#('Browse package' #browseWorkingCopy)
		#('View changes' #viewChanges) 
		#('View history' #viewHistory))
! !

!MCWorkingCopyBrowser methodsFor: '*Tool-Diff' stamp: 'BenjaminVanRyseghem 1/6/2014 00:43'!
viewChanges
	"View the changes made in the working copy."
	
	| patch |
	'Finding changes' displayProgressFrom: 0 to: 10 during:[:bar|
		self canSave ifTrue:[
		bar current: 1.
		patch := workingCopy changesRelativeToRepository: self repository].
		patch ifNil: [^ self].
		bar current: 3.
		patch isEmpty
			ifTrue: [
				workingCopy modified: false.
				bar current: 10.
				MCNoChangesException signal ]
			ifFalse: [
				workingCopy modified: true.
				bar current: 5.
				self
					viewChanges: patch
					from: workingCopy  packageName, ' (', workingCopy ancestry ancestorString, ')'
					to: ('Modified {1}' translated format: {workingCopy description})]]! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'CamilloBruni 8/3/2011 14:50'!
addRepositoryToPackage
	self repository ifNotNil:
		[:repos |
		(self pickWorkingCopySatisfying: [ :p | (p repositoryGroup includes: repos) not ]) ifNotNil:
			[:wc |
			workingCopy := wc.
			workingCopy repositoryGroup addRepository: repos.
			self repository: repos.	
			self
				changed: #workingCopySelection;
				repositoryListChanged;
				changed: #repositorySelection.
			self changedButtons]]! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'ar 8/6/2009 18:26'!
pickAncestorVersionInfo
	| ancestors index |
	ancestors := workingCopy ancestry breadthFirstAncestors.
	index := UIManager default chooseFrom: (ancestors collect: [:ea | ea name])
				title: 'Ancestor:'.
	^ index = 0 ifFalse: [ ancestors at: index]! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'TorstenBergmann 11/4/2014 17:55'!
buildWindow 	

	|window|
	window := super buildWindow.
	self repositoryListChanged.
	^window! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'lr 3/23/2010 09:58'!
workingCopyTreeChildren: aWrapper
	^ aWrapper contents! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'CamilloBruni 3/13/2012 18:39'!
workingCopySearchField
	^ SearchMorph new
		model: self;
		setIndexSelector: #workingCopySearchAccept:; 
		searchList: self class workingCopySearchList;
		updateSelector: #workingCopySearchAccept:;
		yourself
! !

!MCWorkingCopyBrowser methodsFor: 'menu spec' stamp: 'Lr 12/9/2010 17:20'!
buttonSpecs
	^ #(#('+Package' #addWorkingCopy 'Add a new package and make it the working copy')
		#('+Config' #addMetacelloConfiguration 'Add a new metacello configuration')
		#('+Slice' #addSlice 'Add a slice to cleaning and nicely propose a bug fix')
		#('Browse' #browseWorkingCopy 'Browse the working copy of the selected package' #hasWorkingCopy)
		#('Changes' #viewChanges 'View the working copy''s changes relative to the installed version from the repository' #canSave)
	 	#('+Repository' #addRepository 'Add an existing repository to the list of those visible')
		#('Save' #saveVersion 'Save the working copy as a new version to the selected repository' #canSave)
		#('Open' #openRepository 'Open a browser on the selected repository' #hasRepository))! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'CamilloBruni 3/13/2012 18:39'!
repositorySearchField
	^ SearchMorph new
		model: self;
		setIndexSelector: #repositorySearchAccept:; 
		updateSelector: #repositorySearchAccept:;
		searchList: self class repositorySearchList;
		yourself! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'CamilloBruni 1/16/2012 17:51'!
addRequiredDirtyPackage
	| dirtyPackages |
	
	dirtyPackages := self dirtyPackages.
	
	workingCopy ifNotNil: [:wc |
		dirtyPackages do: [:required |
			wc = required
				ifFalse: [ wc requirePackage: required package]]].
	
	self workingCopyListChanged! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'SeanDeNigris 7/7/2012 21:45'!
workingCopyTreeMorph
	^ SimpleHierarchicalListMorph
		on: self
		list: #workingCopyTree
		selected: #workingCopyWrapper
		changeSelected: #workingCopyWrapper:
		menu: #workingCopyListMenu:! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'CamilloBruni 4/11/2013 17:26'!
storeDependencies: newVersion in: aRepository
	self retryOnCredentialRequest: [ aRepository storeDependencies: newVersion ]! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'BenjaminVanRyseghem 12/6/2013 13:17'!
repositorySearchAccept: string
	| aString |

	aString := string ifNil: [ '' ].
	repositoryPattern = aString asLowercase ifTrue: [ ^ self ].
	repositoryPattern := aString asLowercase.
		
	repositoryProcess ifNotNil: [ repositoryProcess terminate ].
	repositoryProcess := [ self repositoryListChanged ] fork.! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'EstebanLorenzano 9/8/2013 10:37'!
basicSaveVersionIn: aRepository
	| newVersion waitForVersion |
	waitForVersion := Semaphore new.
	
	UIManager default defer: [
		newVersion := workingCopy newVersionIn: aRepository.
		waitForVersion signal ].
	
	Processor activeProcess == UIManager default uiProcess
		ifFalse: [ waitForVersion wait ].
	newVersion ifNil: [ ^ self ]. 
	
	Cursor wait showWhile: [[ 
		self
			storeVersion: newVersion in: aRepository;
			storeDependencies: newVersion in: aRepository.] 
			ensure: [ (MCVersionInspector new version: newVersion) show ]]! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'StephaneDucasse 6/2/2012 20:35'!
workingCopies
	^ (self orderSpecs size = order
		ifTrue: [ self allManagers select: [ :each | each modified ] ]
		ifFalse: [ self allManagers ])
			asSortedCollection: (self orderSpecs at: order) value.! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'ab 7/22/2003 02:21'!
hasRepository
	^ self repository notNil! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'StephanEggermont 1/2/2014 15:41'!
setShowOnlyRepositoriesFromWorkingCopy: anIndex
	showOnlyRepositoriesFromWorkingCopy  := (anIndex = 2).
	self repositorySelection: 0.
	self repositoryListChanged.
! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'marcus.denker 11/10/2008 10:04'!
clearRequiredPackages
	workingCopy ifNotNil:
		[:wc |
		wc clearRequiredPackages.
		self workingCopyListChanged]! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'ab 8/7/2003 21:22'!
canSave
	^ self hasWorkingCopy and: [self hasRepository]! !

!MCWorkingCopyBrowser methodsFor: 'menu spec' stamp: 'DanielAviv 1/29/2013 16:39'!
packageMenuSpec

	^ #(#('Add required package' #addRequiredPackage)
		#('Add all dirty packages as required' #addRequiredDirtyPackage)
		#('Remove required package' #removeRequiredPackage)
		#('Clear required packages' #clearRequiredPackages)
		#('View past comments' #viewPastComments))
! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'StephanEggermont 1/2/2014 15:48'!
currentShowOnlyRepositoriesFromWorkingCopy
	^showOnlyRepositoriesFromWorkingCopy ifTrue: [ 2] 
	ifFalse: [ 1] ! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'ab 7/22/2003 00:46'!
hasWorkingCopy
	^ workingCopy notNil! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'marcus.denker 11/10/2008 10:04'!
backportChanges
	self canBackport ifFalse: [^self].
	workingCopy ifNotNil:
		[workingCopy needsSaving ifTrue: [^ self inform: 'You must save the working copy before backporting.'].
		self pickAncestorVersionInfo ifNotNil:
			[:baseVersionInfo |
			workingCopy backportChangesTo: baseVersionInfo]]! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'CamilloBruni 4/6/2013 23:43'!
editRepository
	| newRepo |
	newRepo := self repository openAndEditTemplateCopy.
	newRepo ifNotNil: [ 
		(newRepo isKindOf: MCRepository)
			ifFalse: [ 
				self inform: 'Got a ', newRepo class name, ' instead of a Monticello Repository'].
		self flag: 'Is this ugly? yes!!'.
		self repository becomeForward: newRepo ].
	self repositoryListChanged! !

!MCWorkingCopyBrowser methodsFor: 'metacello' stamp: 'AlexandreBergel 10/27/2010 12:24'!
configurationClass
	^ Smalltalk globals at: workingCopy package name asSymbol ! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'ar 8/6/2009 18:26'!
pickWorkingCopySatisfying: aBlock
	| copies index |
	copies := self workingCopies select: aBlock.
	copies isEmpty ifTrue: [ ^nil ].
	index := UIManager default chooseFrom: (copies collect: [:ea | ea packageName])
				title: 'Package:'.
	^ index = 0 ifFalse: [ copies at: index]! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'stephaneducasse 2/4/2006 20:47'!
defaults
	^ defaults ifNil: [defaults := Dictionary new]! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'bf 6/3/2005 15:08'!
flushAllCaches
	| beforeBytes afterBytes beforeVersions afterVersions |
	Cursor wait showWhile: [
		beforeBytes := Smalltalk garbageCollect.
		beforeVersions := MCVersion allSubInstances size.
		MCFileBasedRepository flushAllCaches.
		afterBytes := Smalltalk garbageCollect.
		afterVersions := MCVersion allSubInstances size.
	].
	^self inform: (beforeVersions - afterVersions) asString, ' versions flushed', String cr,
 		(afterBytes - beforeBytes) asStringWithCommas, ' bytes reclaimed'! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'StephanEggermont 1/2/2014 15:48'!
showOnlyRepositoriesFromWorkingCopyField
	^(DropListMorph
		on: self 
		list: #getShowOnlyRepositoriesFromWorkingCopySettings
		selected: #currentShowOnlyRepositoriesFromWorkingCopy
		changeSelected: #setShowOnlyRepositoriesFromWorkingCopy:)
		listPaneColor: Color transparent;
		yourself			
! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'StephanEggermont 1/2/2014 15:42'!
getShowOnlyRepositoriesFromWorkingCopySettings
	^#('All' 'Package')! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'lr 10/14/2008 14:22'!
orderString: anIndex
	^ String streamContents: [ :stream |
		order = anIndex
			ifTrue: [ stream nextPutAll: '<yes>' ]
			ifFalse: [ stream nextPutAll: '<no>' ].
		stream nextPutAll: (self orderSpecs at: anIndex) key ]! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'CamilloBruni 8/3/2011 14:54'!
workingCopySearchAdd: aString 
	self workingCopySearchList: (self workingCopySearchList
			remove: aString
			ifAbsent: [];
			 yourself).
	self workingCopySearchList size = self workingCopySearchMaxSize
		ifTrue: [self workingCopySearchList removeLast].
	self workingCopySearchList addFirst: aString ! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'BenjaminVanRyseghem 10/18/2012 16:16'!
addRepository
	self newRepository ifNotNil: [:repos | 
		self addRepository: repos.
		workingCopy ifNil: [ repos morphicOpen: nil ]].
! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'StephanEggermont 1/2/2014 15:33'!
repositoryGroup
	^ showOnlyRepositoriesFromWorkingCopy
		ifTrue:  [ workingCopy ifNil: [ MCRepositoryGroup default ] ifNotNil: [ workingCopy repositoryGroup ]  ]
		ifFalse: [ MCRepositoryGroup default ] ! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'bf 6/21/2005 15:56'!
repositorySelection: aNumber
	aNumber = 0
		ifTrue: [self repository: nil]
		ifFalse: [self repository: (self repositories at: aNumber)].
	self changed: #repositorySelection.
	self changedButtons.
! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'PatrickBarroca 6/5/2010 17:36'!
defaultExtent

	^ 620@200! !

!MCWorkingCopyBrowser methodsFor: 'metacello' stamp: 'AlexandreBergel 10/27/2010 23:18'!
lastBaseLine
	^ self baseLines last! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'ar 2/14/2004 02:46'!
deleteWorkingCopy
	workingCopy unregister.
	self workingCopySelection: 0.
	self workingCopyListChanged.! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'BenjaminVanRyseghem 12/5/2013 16:22'!
repositories
	| repositories |
	repositories := self repositoryGroup repositories.
	
	"filter the repository list if there is a search string"
	repositoryPattern ifNotEmpty: [
		repositories := repositories select: [ :each| each description asLowercase includesSubstring: repositoryPattern ]].
	^ repositories! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'lr 3/23/2010 09:57'!
workingCopyTreeHasChildren: aWrapper
	^ aWrapper hasContents! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'CamilloBruni 8/3/2011 14:49'!
repositoryListChanged
	self changed: #repositoryList.! !

!MCWorkingCopyBrowser methodsFor: '*Tool-Diff' stamp: 'gvc 2/9/2010 14:06'!
viewChanges: patch from: fromDescription to: toDescription
	"Open a browser on the given patch."

	PSMCPatchMorph usedByDefault
		ifTrue: [((PSMCPatchMorph forPatch: patch)
						fromDescription: fromDescription;
						toDescription: toDescription;
						newWindow)
					title: ('Changes to {1}' translated format: {fromDescription});
					open]
		ifFalse: [(MCPatchBrowser forPatch: patch)
					label: 'Patch Browser: ', workingCopy description;
					show]! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'VincentBlondeau 2/1/2015 13:22'!
addRequiredPackage
	| chosen |
	workingCopy
		ifNotNil: [ :wc | 
			chosen := (SearchFacade mcPackageSearchRejectAll: [ :ea | ea = wc or: [ wc requiredPackages includes: ea package ] ])
				chooseFromOwner: self window.
			chosen
				ifNotNil: [ 
					wc requirePackage: chosen package.
					self workingCopyListChanged ] ]! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'c 8/10/2010 22:58'!
workingCopyTreePath
	workingCopy ifNil: [^ OrderedCollection new].
	^ OrderedCollection with: workingCopyWrapper.! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'PatrickBarroca 6/7/2010 02:15'!
enterSliceName
	| name |
	name := UIManager default request: 'Please describe the fix' initialAnswer: 'OneSentenceSummary'.
		name isEmptyOrNil ifFalse: [
		name isAllAlphaNumerics ifFalse:[
			UIManager default inform:'Your sentence can only be composed of alphanumerics caracters'.
			name := self enterSliceName]].
	^ name! !

!MCWorkingCopyBrowser methodsFor: 'metacello' stamp: 'AlexandreBergel 11/11/2010 16:54'!
createDevelopmentVersion
	self hasAnyBaseline 
		ifFalse: [ UIManager default inform: 'Please, define a baseline first'. ^ self ].
	^ self createVersionForBlessing: #development! !

!MCWorkingCopyBrowser methodsFor: 'updating' stamp: 'EstebanLorenzano 3/19/2014 15:52'!
update: anAnnouncement
	self workingCopyListChanged.! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'EstebanLorenzano 1/3/2014 10:26'!
addWorkingCopy
	| name |
	
	name := UIManager default request: 'Name of package:' translated.
	name isEmptyOrNil ifFalse: [
		RPackageOrganizer default registerPackageNamed: name.		
		workingCopy := MCWorkingCopy forPackage: (MCPackage new name: name).
		workingCopyWrapper := MCDependentsWrapper with: workingCopy model: self.
		self repositorySelection: 0 ].
	
	self 
		workingCopyListChanged; 
		changed: #workingCopySelection; 
		repositoryListChanged.
	self changedButtons.! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'MarcusDenker 9/13/2013 14:02'!
workingCopyList
	^ self workingCopies collect:
		[:ea |
		(workingCopy notNil and: [workingCopy requiredPackages includes: ea package])
			ifTrue: [Text string: ea description]
			ifFalse: [ea description]]! !

!MCWorkingCopyBrowser methodsFor: 'menu spec' stamp: 'StephaneDucasse 5/19/2011 14:38'!
repositoryMenuSpec
	^ 	#(('Open repository' #openRepository)
		   ('Edit repository info' #editRepository)
		   ('Add to package...' #addRepositoryToPackage)
		   ('Remove repository' #removeRepository)	
		   ('Load repositories' #loadRepositories)	
		   ('Save repositories' #saveRepositories)
		   ('Flush cached versions' #flushAllCaches))
		! !

!MCWorkingCopyBrowser methodsFor: 'initialization' stamp: 'BernardoContreras 10/13/2014 18:41'!
registerToAnnouncer
	SystemAnnouncer uniqueInstance weak
		when: MCVersionCreated send: #update: to: self;
		when: MCPackageModified send: #update: to: self;
		when: MCWorkingCopyCreated send: #update: to: self;
		when: MCWorkingCopyDeleted send: #update: to: self! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'CamilloBruni 8/3/2011 14:51'!
addRepositoryToWorkingCopy
	workingCopy ifNotNil:
		[:wc |
			workingCopy repositoryGroup addRepository: self repository.
			self
				changed: #workingCopySelection;
				repositoryListChanged;
				changed: #repositorySelection.
			self changedButtons]! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'CamilloBruni 10/10/2012 14:37'!
openRepository
	self repository ifNotNil: [:repos | 
		repos morphicOpen: workingCopy ]! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'AlainPlantec 10/24/2010 22:31'!
dirtyPackages
	^ self workingCopies select: [:copy | copy needsSaving].
! !

!MCWorkingCopyBrowser methodsFor: 'actions' stamp: 'CamilloBruni 8/3/2011 14:51'!
loadRepositories
	FileStream fileIn: 'MCRepositories.st'.
	self repositoryListChanged.
	self changedButtons.
! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'ab 7/19/2003 23:38'!
defaultLabel
	^ 'Monticello Browser'! !

!MCWorkingCopyBrowser methodsFor: 'morphic ui' stamp: 'avi 8/31/2004 01:14'!
toggleDiffs
	self repository alwaysStoreDiffs
		ifTrue: [self repository doNotAlwaysStoreDiffs]
		ifFalse: [self repository doAlwaysStoreDiffs]! !

!MCWorkingCopyBrowser class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/15/2013 13:49'!
taskbarIcon
	"Answer the icon for the receiver in a task bar."

	^ Smalltalk ui icons iconNamed: #versionControlIcon! !

!MCWorkingCopyBrowser class methodsFor: 'settings' stamp: 'CamilloBruni 8/3/2011 14:40'!
repositorySearchMaxSize
	^ repositorySearchMaxSize ifNil: [repositorySearchMaxSize := 15]
! !

!MCWorkingCopyBrowser class methodsFor: 'settings' stamp: 'CamilloBruni 8/4/2011 14:53'!
repositorySearchList
	^ repositorySearchList ifNil: [ repositorySearchList := OrderedCollection new ].! !

!MCWorkingCopyBrowser class methodsFor: 'settings' stamp: 'lr 10/14/2008 14:21'!
order: anInteger
	Order := anInteger! !

!MCWorkingCopyBrowser class methodsFor: 'tools registry' stamp: 'IgorStasenko 2/19/2011 04:06'!
registerToolsOn: registry
	registry register: self as: #monticelloBrowser! !

!MCWorkingCopyBrowser class methodsFor: 'instance creation' stamp: 'sd 6/5/2011 19:08'!
open

	self new show! !

!MCWorkingCopyBrowser class methodsFor: 'settings' stamp: 'CamilloBruni 8/4/2011 14:53'!
workingCopySearchList
	^ workingCopySearchList ifNil: [ workingCopySearchList := OrderedCollection new ].! !

!MCWorkingCopyBrowser class methodsFor: 'settings' stamp: 'CamilloBruni 8/3/2011 14:44'!
workingCopySearchMaxSize
	^ workingCopySearchMaxSize ifNil: [workingCopySearchMaxSize := 15]
! !

!MCWorkingCopyBrowser class methodsFor: 'settings' stamp: 'lr 10/14/2008 14:21'!
order
	^ Order ifNil: [ Order := 1 ]! !

!MCWorkingCopyCreated commentStamp: '<historical>'!
A MCWorkingCopyCreated is a announcement raised when a new MCWorkingCopy is created!
!MCWorkingCopyCreated methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/25/2012 19:56'!
workingCopy
	^ workingCopy! !

!MCWorkingCopyCreated methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/25/2012 19:56'!
workingCopy: anObject
	workingCopy := anObject! !

!MCWorkingCopyCreated methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/25/2012 19:55'!
package: anObject
	package := anObject! !

!MCWorkingCopyCreated methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/25/2012 19:55'!
package
	^ package! !

!MCWorkingCopyCreated class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 2/25/2012 19:57'!
workingCopy: workingCopy

	^ self new
		workingCopy: workingCopy;
		yourself! !

!MCWorkingCopyCreated class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 2/25/2012 19:56'!
workingCopy: aWC package: package

	^ self new
		workingCopy: aWC;
		package: package;
		yourself! !

!MCWorkingCopyDeleted commentStamp: '<historical>'!
A MCWorkingCopyDeleted class is an announcement raised when a MCWorkingCopy is removed!
!MCWorkingCopyDeleted methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/25/2012 20:24'!
workingCopy
	^ workingCopy! !

!MCWorkingCopyDeleted methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/25/2012 20:24'!
workingCopy: anObject
	workingCopy := anObject! !

!MCWorkingCopyDeleted methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/25/2012 20:24'!
package: anObject
	package := anObject! !

!MCWorkingCopyDeleted methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/25/2012 20:24'!
package
	^ package! !

!MCWorkingCopyDeleted class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 2/25/2012 20:24'!
workingCopy: workingCopy

	^ self new
		workingCopy: workingCopy;
		yourself! !

!MCWorkingCopyDeleted class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 2/25/2012 20:24'!
workingCopy: aWC package: package

	^ self new
		workingCopy: aWC;
		package: package;
		yourself! !

!MCWorkingCopyTest methodsFor: 'asserting' stamp: 'EstebanLorenzano 9/8/2013 11:03'!
assertNameWhenSavingTo: aRepository is: aString
	| name |
	name := nil.
	[aRepository storeVersion: (workingCopy newVersionIn: aRepository)]
		on: MCVersionNameAndMessageRequest
		do: [:n | name := n suggestedName. n resume: (Array with: name with: '')].
	self assert: name = aString! !

!MCWorkingCopyTest methodsFor: 'asserting' stamp: 'EstebanLorenzano 9/8/2013 11:03'!
assertNumberWhenSavingTo: aRepository is: aNumber
	| name |
	name := nil.
	[aRepository storeVersion: (workingCopy newVersionIn: aRepository)]
		on: MCVersionNameAndMessageRequest
		do: [:n | name := n suggestedName. n resume: (Array with: name with: '')].
	self assert: name = (self packageName, '-', Author fullName, '.', aNumber asString)! !

!MCWorkingCopyTest methodsFor: 'accessing' stamp: 'ab 7/7/2003 18:02'!
description
	^ self class name! !

!MCWorkingCopyTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:23'!
testRedundantMerge
	| base |
	base := self snapshot.
	self merge: base.
	self merge: base! !

!MCWorkingCopyTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:47'!
testSnapshotAndLoad
	| base inst |
	inst := self mockInstanceA.
	base :=  self snapshot.
	self change: #one toReturn: 2.
	self assert: inst one = 2.
	self load: base.
	self assert: inst one = 1.! !

!MCWorkingCopyTest methodsFor: 'running' stamp: 'MiguelCoba 7/25/2009 02:03'!
tearDown
	workingCopy unregister.
	self restoreMocks.
	self clearPackageCache.
	Author fullName: savedName.! !

!MCWorkingCopyTest methodsFor: 'tests' stamp: 'nice 1/5/2010 15:59'!
testSelectiveBackport
	| inst base intermediate final |
	inst := self mockInstanceA.
	base :=  self snapshot.
	self assert: inst one = 1.
	self change: #one toReturn: 2.
	intermediate := self snapshot.
	self change: #two toReturn: 3.
	final := self snapshot.
	[workingCopy backportChangesTo: base info]
		on: MCChangeSelectionRequest
		do: [:e | | patch selected |
			patch := e patch.
			selected := patch operations select: [:ea | ea definition selector = #two].
			e resume: (MCPatch operations: selected)]. 
	self assert: inst one = 1.
	self assert: inst two = 3.
	self assert: workingCopy ancestry ancestors size = 1.
	self assert: workingCopy ancestry ancestors first = base info.
	self assert: workingCopy ancestry stepChildren size = 1.
	self assert: workingCopy ancestry stepChildren first = final info! !

!MCWorkingCopyTest methodsFor: 'tests' stamp: 'CamilloBruni 2/10/2013 17:28'!
testBackport
	| inst base final backported ancestry |
	inst := self mockInstanceA.
	base := self snapshot.
	
	self assert: inst one = 1.
	
	self change: #one toReturn: 2.
	self change: #two toReturn: 3.
	
	final := self snapshot.
	[workingCopy backportChangesTo: base info]
		on: MCChangeSelectionRequest
		do: [:e | e resume: e patch].
		
	self assert: inst one = 2.
	self assert: inst two = 3.
	ancestry := workingCopy ancestry.
	self assert: ancestry ancestors size = 1.
	self assert: ancestry ancestors first = base info.
	self assert: ancestry stepChildren size = 1.
	self assert: ancestry stepChildren first = final info.
	
	backported := self snapshot.
	[workingCopy backportChangesTo: base info]
		on: MCChangeSelectionRequest
		do: [:e | e resume: e patch].
		
	ancestry := workingCopy ancestry.
	self assert: ancestry ancestors size = 1.
	self assert: ancestry ancestors first = base info.
	self assert: ancestry stepChildren size = 1.
	self assert: ancestry stepChildren first = backported info.
	! !

!MCWorkingCopyTest methodsFor: 'actions' stamp: 'EstebanLorenzano 9/8/2013 11:04'!
snapshot
	| version |
	[version := workingCopy newVersionIn: workingCopy repositoryGroup]
		on: MCVersionNameAndMessageRequest
		do: [:n | n resume: (Array with: n suggestedName with: '')].
	versions at: version info put: version.
	^ version! !

!MCWorkingCopyTest methodsFor: 'running' stamp: 'MiguelCoba 7/25/2009 02:02'!
setUp
	| repos1 repos2 |
	self clearPackageCache.
	repositoryGroup := MCRepositoryGroup new.
	repositoryGroup disableCache.
	workingCopy := MCWorkingCopy forPackage: self mockPackage.
	versions := Dictionary new.
	versions2 := Dictionary new.
	repos1 := MCDictionaryRepository new dictionary: versions.
	repos2 := MCDictionaryRepository new dictionary: versions2.
	repositoryGroup addRepository: repos1.
	repositoryGroup addRepository: repos2.
	MCRepositoryGroup default removeRepository: repos1; removeRepository: repos2.
	workingCopy repositoryGroup: repositoryGroup.
	savedName := Author fullName.
	Author fullName: 'abc'.! !

!MCWorkingCopyTest methodsFor: 'actions' stamp: 'avi 1/24/2004 20:13'!
load: aVersion
	aVersion load! !

!MCWorkingCopyTest methodsFor: 'running' stamp: 'Anonymous 6/17/2013 13:16'!
clearPackageCache
	| dir |
	dir := MCCacheRepository uniqueInstance directory.
"	(dir filesMatching: 'MonticelloMocks*') do: [:ea | ea ensureDeleted ]."
	(dir filesMatching: 'MonticelloTest*') do: [:ea | ea ensureDelete].
	(dir filesMatching: 'rev*') do: [:ea | ea ensureDelete].
	(dir filesMatching: 'foo-*') do: [:ea | ea ensureDelete].
	(dir filesMatching: 'foo2-*') do: [:ea | ea ensureDelete].! !

!MCWorkingCopyTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:23'!
testDoubleRepeatedMerge
	| base motherA1 motherA2 motherB1 motherB2 inst |
	base := self snapshot.
	self change: #a toReturn: 'a1'.
	motherA1 := self snapshot.
	self change: #c toReturn: 'c1'.
	motherA2 := self snapshot.
	self load: base.
	self change: #b toReturn: 'b1'.
	motherB1 := self snapshot.
	self change: #d toReturn: 'd1'.
	motherB2 := self snapshot.
	self load: base.
	self merge: motherA1.
	self merge: motherB1.
	self change: #a toReturn: 'a2'.
	self change: #b toReturn: 'b2'.
	self snapshot.
	self merge: motherA2.
	self merge: motherB2.
	inst := self mockInstanceA.
	self assert: inst a = 'a2'.
	self assert: inst b = 'b2'.
	self assert: inst c = 'c1'.
	self assert: inst d = 'd1'! !

!MCWorkingCopyTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:47'!
testAncestorMerge
	| base revA revB revC |

	base := self snapshot.
	self change: #a toReturn: 'a1'.
	revA :=  self snapshot.
	self change: #b toReturn: 'b1'.
	revB :=  self snapshot.	
	self change: #c toReturn: 'c1'.
	revC :=  self snapshot.	

	self should: [self basicMerge: revA] raise: MCNoChangesException.
	! !

!MCWorkingCopyTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:47'!
testMergeIntoUnmodifiedImage
	| base revA |

	base := self snapshot.
	self change: #a toReturn: 'a1'.
	revA := self snapshot.
	
	self load: base.

	self merge: revA.

	self assert: (workingCopy ancestors size = 1)
	! !

!MCWorkingCopyTest methodsFor: 'tests' stamp: 'bf 5/20/2005 18:25'!
testNaming
	| repos version |

	repos := MCDictionaryRepository new.
	self assertNameWhenSavingTo: repos is: self packageName, '-abc.1'.
	self assertNameWhenSavingTo: repos is: self packageName, '-abc.2'.
	repos := MCDictionaryRepository new.
	self assertNameWhenSavingTo: repos is: self packageName, '-abc.3'.
	version := self snapshot.
	version info instVarNamed: 'name' put: 'foo-jf.32'.
	version load.
	self assertNameWhenSavingTo: repos is: 'foo-abc.33'.
	self assertNameWhenSavingTo: repos is: 'foo-abc.34'.
	version info instVarNamed: 'name' put: 'foo-abc.35'.
	repos storeVersion: version.
	self assertNameWhenSavingTo: repos is: 'foo-abc.36'.
	self assertNameWhenSavingTo: repos is: 'foo-abc.37'.
	version info instVarNamed: 'name' put: 'foo-abc.10'.
	repos storeVersion: version.
	self assertNameWhenSavingTo: repos is: 'foo-abc.38'.
	version info instVarNamed: 'name' put: 'foo2-ab.40'.
	version load.
	self assertNameWhenSavingTo: repos is: 'foo2-abc.41'.! !

!MCWorkingCopyTest methodsFor: 'actions' stamp: 'CamilloBruni 9/15/2013 18:17'!
merge: aVersion
	[[self basicMerge: aVersion]
		on: MCMergeResolutionRequest do: [:n | n merge ]]
			on: MCNoChangesException do: [:n | ]! !

!MCWorkingCopyTest methodsFor: 'actions' stamp: 'avi 2/13/2004 14:30'!
basicMerge: aVersion
	aVersion merge! !

!MCWorkingCopyTest methodsFor: 'private' stamp: 'cwp 8/2/2003 15:03'!
packageName
	^ self mockPackage name! !

!MCWorkingCopyTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:23'!
testRepeatedMerge
	| base mother1 mother2 inst |
	base := self snapshot.
	self change: #one toReturn: 2.
	mother1 := self snapshot.
	self change: #two toReturn: 3.
	mother2 := self snapshot.
	self load: base.
	self change: #truth toReturn: false.
	self snapshot.
	inst := self mockInstanceA.
	self assert: inst one = 1.
	self assert: inst two = 2.
	self merge: mother1.
	self assert: inst one = 2.
	self assert: inst two = 2.
	self change: #one toReturn: 7.
	self assert: inst one = 7.
	self assert: inst two = 2.
	self merge: mother2.
	self assert: inst one = 7.
	self assert: inst two = 3! !

!MCWorkingCopyTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:47'!
testOptimizedLoad
	| inst base diffy |
	inst := self mockInstanceA.
	base := self snapshot.
	self change: #one toReturn: 2.
	self assert: inst one = 2.
	diffy := self snapshot asDiffAgainst: base.
	self deny: diffy canOptimizeLoading.
	self load: base.
	self assert: inst one = 1.
	self assert: diffy canOptimizeLoading.
	self load: diffy.
	self assert: inst one = 2.
! !

!MCWorkingCopyTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:47'!
testRepositoryFallback
	| version |
	version := self snapshot.
	self assert: (repositoryGroup versionWithInfo: version info) == version.
	versions removeKey: version info.
	versions2 at: version info put: version.
	self assert: ( repositoryGroup versionWithInfo: version info) == version.
	versions2 removeKey: version info.
	self should: [repositoryGroup versionWithInfo: version info] raise: Error.! !

!MCWorkingCopyTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:47'!
testSimpleMerge
	| mother base inst |
	inst := self mockInstanceA.
	base :=  self snapshot.
	self change: #one toReturn: 2.
	mother :=  self snapshot.
	self load: base.
	self change: #two toReturn: 3.
	self snapshot.
	self assert: inst one = 1.
	self assert: inst two = 3.
	
	self merge: mother.
	self assert: inst one = 2.
	self assert: inst two = 3.! !

!MCWorkingCopyTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:47'!
testMergeIntoImageWithNoChanges
	| base revB revA1 |

	self change: #a toReturn: 'a'.
	base := self snapshot.
	self change: #b toReturn: 'b'.
	revB := self snapshot.
	
	self load: base.
	self change: #a toReturn: 'a1'.
	revA1 := self snapshot.

	self change: #a toReturn: 'a'.
	self snapshot.
	self merge: revB.

	self assert: (workingCopy ancestors size = 2)
	! !

!MCWorkingHistoryBrowser commentStamp: 'TorstenBergmann 2/20/2014 15:53'!
Browser for working history!
!MCWorkingHistoryBrowser methodsFor: 'accessing' stamp: 'ab 8/22/2003 01:37'!
baseSnapshot
	^ package snapshot! !

!MCWriter commentStamp: 'TorstenBergmann 2/6/2014 08:08'!
Common superclass for metacello writers!
!MCWriter methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:47'!
stream: aStream
	stream := aStream! !

!MCWriter methodsFor: 'accessing' stamp: 'cwp 8/1/2003 01:14'!
stream
	^ stream! !

!MCWriter class methodsFor: 'accessing' stamp: 'cwp 8/1/2003 15:00'!
extension
	^ self readerClass extension! !

!MCWriter class methodsFor: 'accessing' stamp: 'cwp 7/28/2003 23:46'!
readerClass
	^ self subclassResponsibility ! !

!MCWriter class methodsFor: 'writing' stamp: 'cwp 8/1/2003 01:16'!
on: aStream
	^ self new stream: aStream! !

!MD5 commentStamp: 'ul 3/3/2008 23:40'!
This class implements the MD5 128-bit one-way hash function. It uses the MD5Plugin for better performance. Some methods are taken from the original version of MD5NonPrimitive.!
!MD5 methodsFor: 'initialization' stamp: 'StephaneDucasse 2/3/2010 22:14'!
initialize
	"Some magic numbers to get the process started"

	state :=  #[1 35 69 103 137 171 205 239 254 220 186 152 118 84 50 16]

! !

!MD5 methodsFor: 'private-buffers' stamp: 'StephaneDucasse 10/17/2009 17:15'!
processFinalBuffer: aByteArray bitLength: bitLength 
	"Pad the buffer until we have an even 64 bytes, then transform"
	| out |
	out := ByteArray new: 64.
	out 
		replaceFrom: 1
		to: aByteArray size
		with: aByteArray
		startingAt: 1.
	aByteArray size < 56 ifTrue: 
		[ out 
			at: aByteArray size + 1
			put: 128.	"trailing bit"
		self 
			storeLength: bitLength
			in: out.
		self processBuffer: out.
		^ self ].

	"not enough room for the length, so just pad this one, then..."
	aByteArray size < 64 ifTrue: 
		[ out 
			at: aByteArray size + 1
			put: 128 ].
	self processBuffer: out.

	"process one additional block of padding ending with the length"
	out := ByteArray new: 64.	"filled with zeros"
	aByteArray size = 64 ifTrue: 
		[ out 
			at: 1
			put: 128 ].
	self 
		storeLength: bitLength
		in: out.
	self processBuffer: out! !

!MD5 methodsFor: 'private-buffers' stamp: 'StephaneDucasse 10/17/2009 17:15'!
storeLength: bitLength in: aByteArray 
	"Fill in the final 8 bytes of the given ByteArray with a 64-bit
	little-endian representation of the original message length in bits."
	| n i |
	n := bitLength.
	i := aByteArray size - 8 + 1.
	[ n > 0 ] whileTrue: 
		[ aByteArray 
			at: i
			put: (n bitAnd: 255).
		n := n bitShift: -8.
		i := i + 1 ]! !

!MD5 methodsFor: 'private-buffers' stamp: 'ul 3/3/2008 22:28'!
primProcessBuffer: aByteArray withState: s

	<primitive: 'primitiveProcessBufferWithState' module: 'MD5Plugin'>
	self primitiveFailed! !

!MD5 methodsFor: 'accessing' stamp: 'ul 3/3/2008 22:00'!
hashStream: aPositionableStream

	| startPosition buf bitLength |
	self initialize.

	aPositionableStream atEnd ifTrue: [
		buf := ByteArray new: 64.
		buf at: 1 put: 128.
		self processBuffer: buf.
		^self finalValue ].

	startPosition := aPositionableStream position.
	[aPositionableStream atEnd] whileFalse: [
		buf := aPositionableStream next: 64.
		(aPositionableStream atEnd not and: [buf size = 64])
			ifTrue: [self processBuffer: buf]
			ifFalse: [
				bitLength := (aPositionableStream position - startPosition) * 8.
				self processFinalBuffer: buf bitLength: bitLength]].

	^ self finalValue! !

!MD5 methodsFor: 'private-buffers' stamp: 'ul 3/3/2008 19:17'!
processBuffer: aByteArray

	self primProcessBuffer: aByteArray withState: state.
	! !

!MD5 methodsFor: 'private-buffers' stamp: 'ul 3/3/2008 21:34'!
finalValue

	^state! !

!MD5 class methodsFor: 'accessing' stamp: 'ul 3/3/2008 23:37'!
blockSize
	^ 64! !

!MD5 class methodsFor: 'testing' stamp: 'ul 3/3/2008 22:46'!
isPluginAvailable

	<primitive: 'primitivePluginAvailable' module: 'MD5Plugin'>
	^false! !

!MD5 class methodsFor: 'instance creation' stamp: 'ul 3/3/2008 23:01'!
new

	self isPluginAvailable 
		ifTrue: [ ^self basicNew ]
		ifFalse: [ ^MD5NonPrimitive basicNew ]! !

!MD5 class methodsFor: 'accessing' stamp: 'ul 3/3/2008 23:37'!
hashSize
	^ 16! !

!MD5NonPrimitive commentStamp: '<historical>'!
This class implements the MD5 128-bit one-way hash function.  It relies on
the ThirtyTwoBitRegister class supplied as part of the "Digital Signatures"
functionality included in Squeak 2.7.  As of this date (1/20/2000), the
U.S. Government has lifted many of the previous restrictions on the export
of encryption software, but you should check before exporting anything
including this code.  MD5 is commonly used for some secure Internet
protocols, including authentication in HTTP, which is why I wrote it.

Submitted by Duane Maxwell

!
!MD5NonPrimitive methodsFor: 'private-functions' stamp: 'DSM 1/20/2000 13:38'!
ggA: a B: b C: c D: d M: m S: s T: t
	"compute a = b + ((a + g(b,c,d) + m + t) <<< s)"
	^ a += (self gX: b Y: c Z: d); += m; += t; leftRotateBy: s; += b.
! !

!MD5NonPrimitive methodsFor: 'private-rounds' stamp: 'StephaneDucasse 10/17/2009 17:15'!
round: data selector: selector round: round 
	"Do one round with the given function"
	| shiftIndex template abcd |
	1 
		to: 16
		do: 
			[ :i | 
			shiftIndex := (i - 1) \\ 4 + 1.
			abcd := ABCDTable at: shiftIndex.
			template := { 
				(abcd at: 1).
				(abcd at: 2).
				(abcd at: 3).
				(abcd at: 4).
				((IndexTable at: round) at: i).
				((ShiftTable at: round) at: shiftIndex).
				(SinTable at: (round - 1) * 16 + i)
			 }.
			self 
				step: data
				template: template
				selector: selector ]! !

!MD5NonPrimitive methodsFor: 'private-rounds' stamp: 'DSM 1/20/2000 17:58'!
rounds: data
	"Perform the four rounds with different functions"
	#(
	ffA:B:C:D:M:S:T:
	ggA:B:C:D:M:S:T:
	hhA:B:C:D:M:S:T:
	iiA:B:C:D:M:S:T:
	) doWithIndex: [ :selector :index |
		self round: data selector: selector round: index.]
! !

!MD5NonPrimitive methodsFor: 'private-buffers' stamp: 'len 10/15/2002 19:58'!
finalValue
	"Concatenate the state values to produce the 128-bite result"
	^ (state at: 1) asByteArray, (state at: 2) asByteArray, (state at: 3) asByteArray, (state at: 4) asByteArray! !

!MD5NonPrimitive methodsFor: 'private-functions' stamp: 'StephaneDucasse 10/17/2009 17:15'!
step: data template: item selector: selector 
	"Perform one step in the round"
	| args |
	args := { 
		(state at: (item at: 1)).
		(state at: (item at: 2)).
		(state at: (item at: 3)).
		(state at: (item at: 4)).
		(data at: (item at: 5)).
		(item at: 6).
		(item at: 7)
	 }.
	self 
		perform: selector
		withArguments: args! !

!MD5NonPrimitive methodsFor: 'initialization' stamp: 'StephaneDucasse 10/17/2009 17:15'!
initialize
	"Some magic numbers to get the process started"
	state := OrderedCollection newFrom: { 
			(ThirtyTwoBitRegister new load: 1732584193).
			(ThirtyTwoBitRegister new load: 4023233417).
			(ThirtyTwoBitRegister new load: 2562383102).
			(ThirtyTwoBitRegister new load: 271733878)
		 }! !

!MD5NonPrimitive methodsFor: 'private-functions' stamp: 'DSM 1/20/2000 13:38'!
hhA: a B: b C: c D: d M: m S: s T: t
	"compute a = b + ((a + h(b,c,d) + m + t) <<< s)"
	^ a += (self hX: b Y: c Z: d); += m; += t; leftRotateBy: s; += b.
! !

!MD5NonPrimitive methodsFor: 'private-functions' stamp: 'DSM 1/20/2000 01:48'!
gX: x Y: y Z: z
	" compute 'xz or y(not z)'"
	^ x copy bitAnd: z; bitOr: (z copy bitInvert; bitAnd: y)

	! !

!MD5NonPrimitive methodsFor: 'private-functions' stamp: 'DSM 1/20/2000 13:38'!
ffA: a B: b C: c D: d M: m S: s T: t
	"compute a = b + ((a + f(b,c,d) + m + t) <<< s)"
	^ a += (self fX: b Y: c Z: d); += m; += t; leftRotateBy: s; += b.
! !

!MD5NonPrimitive methodsFor: 'private-functions' stamp: 'DSM 1/20/2000 01:48'!
iX: x Y: y Z: z
	" compute 'y xor (x or (not z))'"
	^ y copy bitXor: (z copy bitInvert; bitOr: x)
! !

!MD5NonPrimitive methodsFor: 'private-functions' stamp: 'DSM 1/20/2000 13:39'!
iiA: a B: b C: c D: d M: m S: s T: t
	"compute a = b + ((a + i(b,c,d) + m + t) <<< s)"
	^ a += (self iX: b Y: c Z: d); += m; += t; leftRotateBy: s; += b.
! !

!MD5NonPrimitive methodsFor: 'private-buffers' stamp: 'StephaneDucasse 10/17/2009 17:15'!
processBuffer: aByteArray 
	"Process a 64-byte buffer"
	| saveState data |
	saveState := state collect: [ :item | item copy ].
	data := Array new: 16.
	1 
		to: 16
		do: 
			[ :index | 
			data 
				at: index
				put: (ThirtyTwoBitRegister new 
						reverseLoadFrom: aByteArray
						at: index * 4 - 3) ].
	self rounds: data.
	1 
		to: 4
		do: [ :index | (state at: index) += (saveState at: index) ]! !

!MD5NonPrimitive methodsFor: 'private-functions' stamp: 'DSM 1/20/2000 01:48'!
hX: x Y: y Z: z
	" compute 'x xor y xor z'"
	^ x copy bitXor: y; bitXor: z

	! !

!MD5NonPrimitive methodsFor: 'private-functions' stamp: 'DSM 1/20/2000 01:47'!
fX: x Y: y Z: z
	" compute 'xy or (not x)z'"
	^ x copy bitAnd: y; bitOr: (x copy bitInvert; bitAnd: z)

	! !

!MD5NonPrimitive class methodsFor: 'class initialization' stamp: 'StephaneDucasse 10/17/2009 17:15'!
initialize
	"MD5 initialize"
	"Obscure fact: those magic hex numbers that are hard to type in correctly are
	actually the result of a simple trigonometric function and are therefore
	easier to compute than proofread.  Laziness is sometimes a virtue."
	| c |
	c := 2 raisedTo: 32.
	SinTable := Array new: 64.
	1 
		to: 64
		do: 
			[ :i | 
			SinTable 
				at: i
				put: (ThirtyTwoBitRegister new load: (c * i sin abs) truncated) ].
	ShiftTable := { 
		#(7 12 17 22 ).
		#(5 9 14 20 ).
		#(4 11 16 23 ).
		#(6 10 15 21 )
	 }.
	IndexTable := { 
		#(
			1
			2
			3
			4
			5
			6
			7
			8
			9
			10
			11
			12
			13
			14
			15
			16
		).
		#(
			2
			7
			12
			1
			6
			11
			16
			5
			10
			15
			4
			9
			14
			3
			8
			13
		).
		#(
			6
			9
			12
			15
			2
			5
			8
			11
			14
			1
			4
			7
			10
			13
			16
			3
		).
		#(
			1
			8
			15
			6
			13
			4
			11
			2
			9
			16
			7
			14
			5
			12
			3
			10
		)
	 }.
	ABCDTable := { 
		#(1 2 3 4 ).
		#(4 1 2 3 ).
		#(3 4 1 2 ).
		#(2 3 4 1 )
	 }! !

!MFClassA commentStamp: 'SimonAllier 1/17/2012 10:44'!
I'm a dummy class just to have a package that is not empty.!
!MFClassA methodsFor: 'as yet unclassified' stamp: 'SimonAllier 5/29/2012 15:53'!
method
	|foo|
	self halt.! !

!MFClassB commentStamp: 'TorstenBergmann 2/19/2014 08:33'!
I'm a dummy class for test purposes  !
!MFClassB methodsFor: 'as yet unclassified' stamp: 'SimonAllier 5/29/2012 15:49'!
method3
	|foo|
	self halt.! !

!MFClassB methodsFor: 'as yet unclassified' stamp: 'SimonAllier 5/29/2012 15:49'!
method2
	|foo|! !

!MIMEDocument commentStamp: '<historical>'!
a MIME object, along with its type and the URL it was found at (if any)!
!MIMEDocument methodsFor: 'compatibility' stamp: 'mir 3/4/2002 17:46'!
contentType
	^self mimeType asString! !

!MIMEDocument methodsFor: 'accessing' stamp: 'mir 3/4/2002 18:19'!
contentStream
	"Answer a RWBinaryOrTextStream on the contents."

	contentStream
		ifNil: [contentStream := contents
				ifNil: [self contentStreamOnURI]
				ifNotNil: [(RWBinaryOrTextStream with: self contents) reset]].
	^contentStream! !

!MIMEDocument methodsFor: 'accessing' stamp: 'mir 3/4/2002 17:19'!
mainType
	^self mimeType main! !

!MIMEDocument methodsFor: 'accessing' stamp: 'mir 3/27/2005 10:55'!
uri
	"Answer the URL the receiver was downloaded from.  It may legitimately be nil."

	^uri! !

!MIMEDocument methodsFor: 'private' stamp: 'mir 3/27/2005 10:53'!
contents: contentStringOrBytes mimeType: aMimeType uri: aURI
	type := aMimeType.
	contents := contentStringOrBytes.
	uri := aURI! !

!MIMEDocument methodsFor: 'files' stamp: 'MarcusDenker 3/21/2011 14:34'!
saveToFile: anAbsolutePathString

	FileStream forceNewFileNamed: anAbsolutePathString do: [ :str |
		str binary.
		str nextPutAll: (self contents) ].! !

!MIMEDocument methodsFor: 'testing' stamp: 'ls 4/30/2000 18:45'!
isMultipartAlternative
	"whether the document is in a multipart format where the parts are alternates"
	^ self contentType = 'multipart/alternative'
! !

!MIMEDocument methodsFor: 'printing' stamp: 'mir 3/26/2005 17:48'!
printOn: aStream
	aStream nextPutAll: self class name;
		nextPutAll: ' (';
		nextPutAll: self mimeType asString;
		nextPutAll: ', '.
	contents
		ifNotNil: [aStream
			nextPutAll: self contents size printString;
			nextPutAll: ' bytes)']
		ifNil: [aStream nextPutAll: 'unknown size)'].! !

!MIMEDocument methodsFor: 'accessing' stamp: 'mir 3/26/2005 11:13'!
discardContents
	contents := nil.
	self discardContentStream! !

!MIMEDocument methodsFor: 'accessing' stamp: 'sma 4/28/2000 14:48'!
type
	"Deprecated. Use contentType instead."

	^ self contentType! !

!MIMEDocument methodsFor: 'accessing' stamp: 'mir 3/4/2002 16:24'!
type: mimeType
	type := mimeType! !

!MIMEDocument methodsFor: 'accessing' stamp: 'mir 3/4/2002 17:19'!
mimeType
	^type! !

!MIMEDocument methodsFor: 'private' stamp: 'mir 3/27/2005 10:53'!
contentStream: aStream mimeType: aMimeType uri: aUri
	type := aMimeType.
	contentStream := aStream.
	uri := aUri! !

!MIMEDocument methodsFor: 'testing' stamp: 'sbw 1/21/2001 11:13'!
isGif
	^ self mainType = 'image'
		and: [self subType = 'gif']! !

!MIMEDocument methodsFor: 'accessing' stamp: 'asasa 8/31/2010 20:40'!
url
	"Answer the URL the receiver was downloaded from.  It may legitimately be nil."

	^ uri ifNotNil:[uri asString asUrl]! !

!MIMEDocument methodsFor: 'private' stamp: 'mir 11/8/2005 13:39'!
privateContent: aString
	contents := aString! !

!MIMEDocument methodsFor: 'testing' stamp: 'st 9/18/2004 23:38'!
isPnm
	^ self mainType = 'image'
		and: [self subType = 'pnm']! !

!MIMEDocument methodsFor: 'private' stamp: 'mir 3/24/2005 17:37'!
getContentFromStream
	| streamContents |
	streamContents := self contentStream contents.
	self discardContentStream.
	^streamContents! !

!MIMEDocument methodsFor: 'testing' stamp: 'st 9/18/2004 23:37'!
isPng
	^ self mainType = 'image'
		and: [self subType = 'png']! !

!MIMEDocument methodsFor: 'private' stamp: 'mir 3/27/2005 10:50'!
contentStreamOnURI
	^self uri contentStream! !

!MIMEDocument methodsFor: 'accessing' stamp: 'damiencassou 5/30/2008 15:52'!
parts
	"Return the parts of this message.  There is a far more reliable implementation of parts in MailMessage, but for now we are continuing to use this implementation"
	| parseStream currLine separator msgStream messages |
	self isMultipart ifFalse: 
		[ ^ #() ].
	parseStream := self content readStream.
	currLine := ''.
	[ '--*' match: currLine ] whileFalse: [ currLine := parseStream nextLine ].
	separator := currLine copy.
	msgStream := LimitingLineStreamWrapper 
		on: parseStream
		delimiter: separator.
	messages := OrderedCollection new.
	[ parseStream atEnd ] whileFalse: 
		[ messages add: msgStream upToEnd.
		msgStream skipThisLine ].
	^ messages collect: [ :e | MailMessage from: e ]! !

!MIMEDocument methodsFor: 'private' stamp: 'mir 3/26/2005 11:12'!
discardContentStream
	contentStream ifNotNil: [contentStream close].
	contentStream := nil! !

!MIMEDocument methodsFor: 'compatibility' stamp: 'mir 3/22/2005 22:55'!
content
	^self contents! !

!MIMEDocument methodsFor: 'testing' stamp: 'ls 4/30/2000 18:07'!
isMultipart
	^self mainType = 'multipart'! !

!MIMEDocument methodsFor: 'accessing' stamp: 'mir 3/27/2005 10:53'!
uri: aURI
	uri := aURI! !

!MIMEDocument methodsFor: 'testing' stamp: 'sbw 1/21/2001 11:15'!
isJpeg
	^ self mainType = 'image'
		and: [self subType = 'jpeg' | (self subType = 'jpg')]! !

!MIMEDocument methodsFor: 'accessing' stamp: 'mir 3/24/2005 17:26'!
contents
	"Answer the receiver's raw data. If we have a stream to read from. Read in the data, cache it and discard the stream."

	contents ifNil: [contents := self getContentFromStream].
	^contents! !

!MIMEDocument methodsFor: 'accessing' stamp: 'mir 3/4/2002 17:19'!
subType
	^self mimeType sub! !

!MIMEDocument class methodsFor: 'instance creation' stamp: 'mir 3/27/2005 10:54'!
contents: content mimeType: aMimeType 
	"create a MIMEDocument with the given content-type and content"
	"MIMEDocument mimeType: 'text/plain' asMIMEType content: 'This is a test'"
	
	^self contents: content mimeType: aMimeType uri: nil! !

!MIMEDocument class methodsFor: 'compatibility' stamp: 'michael.rueger 2/25/2009 13:05'!
guessTypeFromExtension: ext
	"guesses a content type from the extension"
	^self guessTypeFromName: ext! !

!MIMEDocument class methodsFor: 'instance creation' stamp: 'mir 3/27/2005 10:52'!
contentStream: aStream mimeType: aMimeType uri: aURI
	"create a MIMEDocument with the given content-type and contentStream"
	"MIMEDocument mimeType: 'text/plain' asMIMEType contentStream: (ReadStream on: 'This is a test')"
	
	^self new contentStream: aStream mimeType: aMimeType uri: aURI! !

!MIMEDocument class methodsFor: 'content-types' stamp: 'bolot 5/16/1999 13:05'!
contentTypeHtml
	^'text/html'! !

!MIMEDocument class methodsFor: 'compatibility' stamp: 'michael.rueger 2/25/2009 13:05'!
guessContentTypeFromExtension: ext
	"guesses a content type from the extension"
	^(self guessTypeFromExtension: ext) asString! !

!MIMEDocument class methodsFor: 'compatibility' stamp: 'SvenVanCaekenberghe 10/22/2013 11:41'!
contentType: aMIMEType content: content
	"create a MIMEDocument with the given content-type and content"
	"MIMEDocument contentType: 'text/plain' content: 'This is a test'"
	
	^ self new
		privateContent: content;
		type: aMIMEType asZnMimeType;
		yourself! !

!MIMEDocument class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/22/2013 11:37'!
defaultMIMEType
	^ ZnMimeType default! !

!MIMEDocument class methodsFor: 'compatibility' stamp: 'michael.rueger 2/25/2009 12:29'!
resetMIMEdatabase
	"no-op for catching Kom override"! !

!MIMEDocument class methodsFor: 'instance creation' stamp: 'mir 3/27/2005 10:57'!
contents: content mimeType: aMimeType uri: aURL
	"create a MIMEDocument with the given content-type and content"
	"MIMEDocument mimeType: 'text/plain' asMIMEType content: 'This is a test'"
	
	^self new contents: content mimeType: aMimeType uri: aURL! !

!MIMEDocument class methodsFor: 'compatibility' stamp: 'SvenVanCaekenberghe 10/22/2013 11:42'!
contentType: type content: content url: url
	^ self 
		contents: content 
		mimeType: type asZnMimeType 
		uri: url! !

!MIMEDocument class methodsFor: 'content-types' stamp: 'bolot 5/16/1999 12:25'!
contentTypeFormData
	^'application/x-www-form-urlencoded'! !

!MIMEDocument class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 10/22/2013 11:41'!
contentStream: aStream
	^ self 
		contentStream: aStream 
		mimeType: self defaultMIMEType! !

!MIMEDocument class methodsFor: 'content-types' stamp: 'bolot 5/16/1999 13:05'!
contentTypeXml
	^'text/xml'! !

!MIMEDocument class methodsFor: 'content-types' stamp: 'bolot 5/16/1999 13:05'!
contentTypePlainText
	^'text/plain'! !

!MIMEDocument class methodsFor: 'compatibility' stamp: 'SvenVanCaekenberghe 10/22/2013 12:34'!
guessTypeFromName: url
	"guesses a content type from the url"
	
	| extension |
	extension := url asString copyAfterLast: $..
	^ ZnMimeType
		forFilenameExtension: extension
		ifAbsent: [ nil ]! !

!MIMEDocument class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 10/22/2013 11:42'!
contents: aString
	^ self 
		contents: aString 
		mimeType: self defaultMIMEType! !

!MIMEDocument class methodsFor: 'instance creation' stamp: 'mir 3/27/2005 10:52'!
contentStream: aStream mimeType: aMimeType 
	"create a MIMEDocument with the given content-type and contentStream"
	"MIMEDocument mimeType: 'text/plain' asMIMEType contentStream: (ReadStream on: 'This is a test')"
	
	^self contentStream: aStream mimeType: aMimeType uri: aStream uri! !

!MIMEDocument class methodsFor: 'content-types' stamp: 'bolot 5/16/1999 12:25'!
contentTypeMultipart
	^'multipart/form-data'! !

!MIMEDocument class methodsFor: 'instance creation' stamp: 'ls 7/23/1998 22:59'!
content: aString
	^self contentType: self defaultContentType  content: aString! !

!MIMEDocument class methodsFor: 'compatibility' stamp: 'michael.rueger 2/25/2009 12:36'!
defaultContentType
	^self defaultMIMEType asString! !

!MIMEHeaderValue commentStamp: '<historical>'!
I contain the value portion of a MIME-compatible header.

I must be only initialized with the value and not the field name.  E.g. in processing
	Subject: This is the subject
the MIMEHeaderValue should be given only 'This is the subject'

For traditional non-MIME headers, the complete value returned for mainValue and paramaters returns an empty collection.

For MIME headers, both mainValue and parameters are used.!
!MIMEHeaderValue methodsFor: 'printing' stamp: 'MarcusDenker 7/22/2014 13:12'!
asHeaderValue
	| strm |
	strm := (String new: 20) writeStream.
	strm nextPutAll: mainValue.
	parameters
		associationsDo: [ :e | 
			strm
				nextPut: $;;
				nextPutAll: e key;
				nextPutAll: '="';
				nextPutAll: e value;
				nextPutAll: '"' ].
	^ strm contents! !

!MIMEHeaderValue methodsFor: 'accessing' stamp: 'dvf 4/27/2000 18:13'!
mainValue: anObject
	mainValue := anObject! !

!MIMEHeaderValue methodsFor: 'printing' stamp: 'ls 2/10/2001 12:37'!
printOn: aStream
	super printOn: aStream.
	aStream nextPutAll: ': '.
	aStream nextPutAll: self asHeaderValue! !

!MIMEHeaderValue methodsFor: 'accessing' stamp: 'dvf 4/27/2000 18:18'!
parameters
	^parameters! !

!MIMEHeaderValue methodsFor: 'accessing' stamp: 'dvf 4/27/2000 18:11'!
parameters: anObject
	parameters := anObject! !

!MIMEHeaderValue methodsFor: 'accessing' stamp: 'ls 2/10/2001 13:06'!
parameterAt: aParameter put: value
	parameters at: aParameter put: value! !

!MIMEHeaderValue methodsFor: 'accessing' stamp: 'dvf 4/27/2000 18:55'!
mainValue
	^mainValue! !

!MIMEHeaderValue class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 1/8/2012 14:45'!
fromMIMEHeader: aString 
	"This is the value of a MIME header field and so is parsed to extract the various parts"
	| parts newValue parms |
	newValue := self new.
	parts := (aString findTokens: ';') readStream.
	newValue mainValue: parts next.
	parms := Dictionary new.
	parts do: 
		[ :e | | separatorPos parmValue parmName | 
		separatorPos := e 
			findAnySubStr: '='
			startingAt: 1.
		separatorPos <= e size ifTrue: 
			[ parmName := (e 
				copyFrom: 1
				to: separatorPos - 1) trimBoth asLowercase.
			parmValue := (e 
				copyFrom: separatorPos + 1
				to: e size) trimBoth withoutQuoting.
			parms 
				at: parmName
				put: parmValue ] ].
	newValue parameters: parms.
	^ newValue! !

!MIMEHeaderValue class methodsFor: 'instance creation' stamp: 'mdr 4/11/2001 12:02'!
fromTraditionalHeader: aString
	"This is a traditional non-MIME header (like Subject:) and so should be stored whole"

	| newValue |

	newValue := self new.
	newValue mainValue: aString.
	newValue parameters: #().
	^newValue.
! !

!MIMEHeaderValue class methodsFor: 'instance creation' stamp: 'mdr 4/11/2001 12:19'!
forField: aFName fromString: aString
	"Create a MIMEHeaderValue from aString.  How it is parsed depends on whether it is a MIME specific field or a generic header field."

	(aFName beginsWith: 'content-') 
		ifTrue: [^self fromMIMEHeader: aString]
		ifFalse: [^self fromTraditionalHeader: aString]
! !

!MOPTestClassA methodsFor: 'local' stamp: ''!
c3

	^ 'Trait3>>c3'! !

!MOPTestClassA methodsFor: 'local' stamp: ''!
c

	^ 'Trait3>>c'! !

!MOPTestClassA methodsFor: 'trait2 - c' stamp: ''!
c2

	^ 'Trait2>>c2'! !

!MOPTestClassB methodsFor: 'trait1 - c' stamp: ''!
c1

	^ 'Trait1>>c1'! !

!MOPTestClassB methodsFor: 'trait1 - c' stamp: ''!
c

	^ 'Trait1>>c'! !

!MOPTestClassB methodsFor: 'trait2 - c' stamp: ''!
c2

	^ 'Trait2>>c2'! !

!MOPTestClassC methodsFor: 'local' stamp: 'stephane.ducasse 10/7/2008 16:57'!
c

	^ 'C>>c'! !

!MOPTestClassC methodsFor: 'trait2 - c' stamp: ''!
c2

	^ 'Trait2>>c2'! !

!MOPTestClassD methodsFor: 'trait2 - c' stamp: ''!
c3

	^ 'Trait2>>c2'! !

!MOPTestClassD methodsFor: 'trait2 - c' stamp: ''!
c

	^ 'Trait2>>c'! !

!MOPTestClassD methodsFor: 'trait2 - c' stamp: ''!
c2

	^ 'Trait2>>c2'! !

!MOPTraitTest methodsFor: 'tests' stamp: 'matthew_fulmer 7/29/2009 14:24'!
testSelector
	"self debug: #testSelector"
	"The selector of a compiled method should be its name. 
	An aliased method should have the name of its alias name."
	
	self assert: (MOPTestClassA>>#c) selector = #c.
	self assert: (MOPTestClassC>>#c) selector = #c.
	self assert: (Trait3>>#c) selector = #c.
	self assert: (Trait3>>#c2) selector = #c2.
	self assert: (MOPTestClassD>>#c3) selector = #c3.! !

!MOPTraitTest methodsFor: 'tests' stamp: 'matthew_fulmer 7/29/2009 14:24'!
testOrigin
	"self debug: #testClass"
	"The origin of a compiledMethod is its defining class or trait."
	
	self assert: (MOPTestClassC>>#c) origin = MOPTestClassC.
	self assert: (MOPTestClassA>>#c) origin = Trait3.
	self assert: (Trait3>>#c2) origin = Trait2.
	self assert: (MOPTestClassA>>#c2) origin = Trait2.
	self assert: (MOPTestClassB>>#c) origin = Trait1.
	self assert: (MOPTestClassD>>#c3) origin = Trait2.
	self assert: (MOPTestClassD>>#c2) origin = Trait2.! !

!MOPTraitTest methodsFor: 'tests' stamp: 'matthew_fulmer 7/29/2009 14:24'!
testClass
	"self debug: #testClass"
	"The class of a compiled method is the class that contains it.
	A compiled method is shared."
	"methodClass could call 
		-> methodClassOrTrait"
	
	self assert: (Trait1>>#c) methodClass = Trait1.
	self assert: (Trait2>>#c) methodClass = Trait2.
	self assert: (MOPTestClassC>>#c) methodClass = MOPTestClassC.
	self assert: (MOPTestClassC>>#c2) methodClass = MOPTestClassC.
	self assert: (MOPTestClassD>>#c) methodClass = MOPTestClassD.
	self assert: (MOPTestClassD>>#c2) methodClass = MOPTestClassD.
	self assert: (MOPTestClassD>>#c3) methodClass = MOPTestClassD.
	self assert: (MOPTestClassA>>#c2) methodClass = MOPTestClassA.
	! !

!MTDependantProject commentStamp: '<historical>'!
A dependant project represents an external projetc you are dependending on.

Instance Variables
	- configurationClass : the configurationClass this project represents
	- repository : The core repository URL of this project!
!MTDependantProject methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/2/2014 23:30'!
symbolicVersionString
	^ symbolicVersionString! !

!MTDependantProject methodsFor: 'accessing' stamp: 'ChristopheDemarey 1/31/2013 10:27'!
displayName
	^ displayName! !

!MTDependantProject methodsFor: 'displaying' stamp: 'ChristopheDemarey 7/26/2013 17:02'!
displayString
	^ version 
		ifNil: [ displayName ]
		ifNotNil: [ version name 
					ifNil: [ displayName ]
					ifNotNil: [displayName, ' (', version name, ')' ] ]! !

!MTDependantProject methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 6/21/2013 10:44'!
treeNodeClass
	^ VSProjectLeafNode! !

!MTDependantProject methodsFor: 'visiting' stamp: 'ChristopheDemarey 12/6/2013 16:48'!
acceptVisitor: anMTProjectVisitor
	anMTProjectVisitor visitDependantProject: self! !

!MTDependantProject methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 2/24/2014 15:47'!
editVersion
	| availableVersions  index |
	
	configurationClass ifNil: [ UIManager inform: 'Cannot find the configuration class for ' , name.
							^ self ].
	availableVersions := configurationClass project versions 
							select: [ :aVersion | aVersion blessing ~= #baseline ]
							thenCollect: [ :aVersion | aVersion versionString ].
	availableVersions := configurationClass project symbolicVersionSymbols , availableVersions.
	
	index := UIManager default 
		chooseFrom:  availableVersions
		title: 'Available versions in ', name.
	(index = 0)
		ifFalse: [ | versionString |
				versionString := availableVersions at: index.
				self version: (MTVersion fromVersionString:  versionString) ]! !

!MTDependantProject methodsFor: 'displaying' stamp: 'ChristopheDemarey 2/17/2014 15:58'!
repositories: aRepositoryList
	"Set a list of repository URLs for this project."
	repositories := aRepositoryList asOrderedCollection.! !

!MTDependantProject methodsFor: 'accessing' stamp: 'ChristopheDemarey 11/30/2012 14:55'!
configurationClass
	^ configurationClass! !

!MTDependantProject methodsFor: 'displaying' stamp: 'ChristopheDemarey 6/5/2013 10:42'!
repositories
	^ repositories! !

!MTDependantProject methodsFor: 'comparing' stamp: 'ChristopheDemarey 2/24/2014 18:15'!
= other
	(super = other) ifFalse: [ ^false ].
	(self configurationClass = other configurationClass) ifFalse: [ ^false ].
	(self displayName = other displayName) ifFalse: [ ^false ].
	(self repositories hasEqualElements: other repositories) ifFalse: [ ^false ].
	^ true! !

!MTDependantProject methodsFor: 'initialize-release' stamp: 'ChristopheDemarey 12/12/2013 14:53'!
initialize 
	repositories  := OrderedCollection new.
	dependencies := OrderedCollection new.! !

!MTDependantProject methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 1/17/2014 18:39'!
editRepositories
	| packageName repoManager |
	
	packageName := configurationClass package name.
	repoManager := VersionnerRepositoriesManager newWithPackage: packageName.
	repoManager
		selectedChangedBlock:  [:remote :selected |
			selected
				ifTrue: [ self repositories add: remote location ]
				ifFalse: [ self repositories remove: remote location ] ];
		open;
		yourself.! !

!MTDependantProject methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/2/2014 23:30'!
symbolicVersionString: anObject
	symbolicVersionString := anObject! !

!MTDependantProject methodsFor: 'accessing' stamp: 'ChristopheDemarey 1/31/2013 10:27'!
displayName: anObject
	displayName := anObject! !

!MTDependantProject methodsFor: 'accessing' stamp: 'ChristopheDemarey 11/30/2012 14:55'!
configurationClass: anObject
	configurationClass := anObject! !

!MTDependantProject class methodsFor: 'instantiation' stamp: 'ChristopheDemarey 1/17/2014 18:46'!
newWithWorkingCopy: anMBConfigurationInfo
	"Create a new dependent project with the given project."
	| requiredProject  version |
	
	requiredProject := self new
		name: anMBConfigurationInfo name configurationBaseName;
		configurationClass: anMBConfigurationInfo configurationClass;
		yourself.
	requiredProject displayName: requiredProject name.
	requiredProject editRepositories.
	version := (anMBConfigurationInfo hasVersion: #stable)
		ifTrue: [ #stable ]
		ifFalse: [ #bleedingEdge ].
	requiredProject version: (MTVersion fromVersionString: version).
	^ requiredProject! !

!MTDependantProjectTest commentStamp: '<historical>'!
Test clas for a dependant project!
!MTDependantProjectTest methodsFor: 'private' stamp: 'ChristopheDemarey 12/12/2013 11:26'!
referenceDependency
	| version |
	
	version := MTVersion new
					name: '1.0';
					yourself.
					
	^ (MTDependantProject newNamed: 'LibXYZ')
			configurationClass: self class;
			repositories: #('http://smalltalkhub.com/mc/dummy/XYZ/main', 'http://github.com/XYZ');
			displayName: 'XYZ';
			parent: nil;
			version: version;
			yourself.! !

!MTDependantProjectTest methodsFor: 'tests' stamp: 'ChristopheDemarey 12/12/2013 12:44'!
testEquals
	| dependency otherDependency |
	
	dependency := self referenceDependency.
	
	otherDependency := self referenceDependency.
	self assert: otherDependency equals: dependency.
					
	otherDependency := self referenceDependency
								name: 'toto';
								yourself.
	self deny: otherDependency = dependency.

	otherDependency := self referenceDependency
								parent: self;
								yourself.
	self deny: otherDependency = dependency.

	otherDependency := self referenceDependency
								configurationClass: Object;
								yourself.
	self deny: otherDependency = dependency.
	
	otherDependency := self referenceDependency
								repositories: #('http://smalltalkhub.com/mc/dummy/XYZ/main', 'http://github.com/LibXYZ');
								yourself.
	self deny: otherDependency = dependency.! !

!MTDependency commentStamp: '<historical>'!
A MTDependency is an abstraction for project dependencies.

Instance Variables
	- name : The dependency name
	- repository : The repository URL used to find this dependency
	- version : The specific version describes by the dependency
	- platforms : If not nil, the dependency is only applicable to specified platforms
	- dependencies : A dependency could have dependencies
	- project : The project root node
	- parent: The owner of the dependency.!
!MTDependency methodsFor: 'displaying' stamp: 'ChristopheDemarey 2/21/2013 16:31'!
asString
	"Pretty print to display a dependency."
	^ self displayString.! !

!MTDependency methodsFor: 'accessing' stamp: 'ChristopheDemarey 12/11/2013 14:08'!
parent: anObject
	parent := anObject! !

!MTDependency methodsFor: 'accessing' stamp: 'ChristopheDemarey 6/12/2013 10:17'!
dependencies: aCollection
	dependencies := aCollection.! !

!MTDependency methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/19/2013 18:39'!
displayName
	^ self name! !

!MTDependency methodsFor: 'displaying' stamp: 'ChristopheDemarey 11/30/2012 17:49'!
displayString
	"Pretty print to display a dependency."
	self subclassResponsibility .! !

!MTDependency methodsFor: 'accessing' stamp: 'ChristopheDemarey 12/11/2013 17:23'!
project
	| myparent |
	myparent := self parent.
	[ myparent isNotNil ] whileTrue: [ [ myparent := myparent parent ] on: MessageNotUnderstood do: [ ^ myparent ] ].
	^ myparent! !

!MTDependency methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 6/21/2013 10:41'!
treeNodeClass
	"get the Node class to use to display this dependency in a a TreeModel."

	self shouldBeImplemented ! !

!MTDependency methodsFor: 'accessing' stamp: 'ChristopheDemarey 12/13/2012 16:04'!
version
	"Get the specific version used for this dependency"
	
	^version.! !

!MTDependency methodsFor: 'visiting' stamp: 'ChristopheDemarey 12/6/2013 16:44'!
acceptVisitor: aMTProjectVisitor 
	self subclassResponsibility! !

!MTDependency methodsFor: 'initialize-release' stamp: 'TesterBob 11/27/2012 15:36'!
initialize 
	dependencies  := OrderedCollection new.
! !

!MTDependency methodsFor: 'comparing' stamp: 'ChristopheDemarey 12/12/2013 12:42'!
= other
	(self name = other name) ifFalse: [ ^false ].
	(self version = other version) ifFalse: [ ^false ].
	(self parent = other parent) ifFalse: [ ^false ].
	"(self platforms  = other platforms) ifFalse: [ ^false ]."
	^true! !

!MTDependency methodsFor: 'accessing' stamp: 'ChristopheDemarey 11/14/2012 18:19'!
name: anObject
	name := anObject! !

!MTDependency methodsFor: 'printing' stamp: 'ChristopheDemarey 11/30/2012 13:12'!
printOn: aStream
	"Pretty print for dependencies"
	aStream nextPutAll: self name.! !

!MTDependency methodsFor: 'protocol' stamp: 'ChristopheDemarey 9/10/2013 00:27'!
remove
	"search if I am present in other groups and remove myself from these groups, 
	then remove myself from project dependencies"
	(self project groups select: [ :aGroup | aGroup dependencies includes: name ])
		do: [ :aGroup | aGroup removeDependency: name].
	self project dependencies: (self project dependencies reject: [ :dep | dep = self]).
	self project announcer announce: (MTProjectModelChanged project: self)! !

!MTDependency methodsFor: 'accessing' stamp: 'ChristopheDemarey 12/11/2013 14:07'!
parent
	^ parent! !

!MTDependency methodsFor: 'protocol' stamp: 'ChristopheDemarey 9/10/2013 00:21'!
removeDependency: aDependency
	dependencies remove: aDependency ifAbsent: [  ]! !

!MTDependency methodsFor: 'accessing' stamp: 'ChristopheDemarey 11/27/2012 11:48'!
name
	^ name! !

!MTDependency methodsFor: 'protocol' stamp: 'ChristopheDemarey 12/11/2013 17:20'!
addDependency: aDependency
	(dependencies includes: aDependency) 
		ifFalse: [ [ aDependency parent: self ] on: MessageNotUnderstood do: [ "ignore" ].
				 dependencies add: aDependency ] ! !

!MTDependency methodsFor: 'accessing' stamp: 'ChristopheDemarey 12/7/2012 13:42'!
dependencies
	^ dependencies! !

!MTDependency methodsFor: 'accessing' stamp: 'ChristopheDemarey 11/30/2012 13:10'!
version: aVersion
	"Set the specific version used for this dependency"
	
	version := aVersion.! !

!MTDependency class methodsFor: 'instantiation' stamp: 'ChristopheDemarey 1/24/2013 17:16'!
newNamed: aName
	"Create a new dependency with the given name."

	^ self new name: aName.! !

!MTDependencyTest methodsFor: 'as yet unclassified' stamp: 'ChristopheDemarey 6/27/2013 15:58'!
testRemove
	(project dependencyNamed: 'XML-Writer-Core') remove.
	self assert: ((project dependencyNamed:  'XML-Writer-Core') = nil).! !

!MTDependencyTest methodsFor: 'as yet unclassified' stamp: 'ChristopheDemarey 12/11/2013 18:25'!
testProject
	| dependency |
	
	dependency := project dependencyNamed: 'Core'.
	self assert: dependency project equals: project.
	
	dependency := (project dependencyNamed: 'XML-Writer-Core').
	self assert: dependency project equals: project.

	dependency := (project dependencyNamed: 'Collections-Support').
	self assert: dependency project equals: project.
! !

!MTDependencyTest methodsFor: 'as yet unclassified' stamp: 'ChristopheDemarey 6/27/2013 16:00'!
testRemoveGroup
	(project dependencyNamed: 'Core') remove.
	self assert: (project dependencyNamed: 'Core') = nil.
	self assert: ((project dependencyNamed: 'default') dependencies includes: 'Core') not! !

!MTDependencyTest methodsFor: 'as yet unclassified' stamp: 'ChristopheDemarey 6/27/2013 15:44'!
setUp
	| visitor |
	
	visitor := MCModel2MTModelVisitor new.
	version := ConfigurationOfVersionnerTestXMLWriter project version: '2.1.0'.
	project := visitor visitConfiguration: ConfigurationOfVersionnerTestXMLWriter withVersion: version.
! !

!MTDevelopmentWorkfow commentStamp: '<historical>'!
This class is used to manage the development workflow for a dedicated project.
!
!MTDevelopmentWorkfow methodsFor: 'private' stamp: 'ChristopheDemarey 2/7/2014 14:53'!
setStableBlessingFor: versionName
	(MetacelloToolBox configurationNamed: project name)
		modifyVersionMethodForVersion: versionName
			versionSpecsDo: [ :attr :versionSpec | 
					attr == #common
						ifTrue: [ versionSpec blessing: #stable ].
					true ];
		commitMethod! !

!MTDevelopmentWorkfow methodsFor: 'private' stamp: 'ChristopheDemarey 8/25/2014 11:44'!
standardizeDevVersionString: aDevVersionString
	| versionString |
	
	versionString := aDevVersionString copyReplaceAll: 'baseline-' with: ''.
	versionString  :=  versionString copyReplaceAll: '-baseline' with: ''.
	versionString  :=  versionString copyReplaceAll: 'baseline' with: ''.
	^ versionString , '-baseline' ! !

!MTDevelopmentWorkfow methodsFor: 'private' stamp: 'ChristopheDemarey 2/21/2014 16:16'!
createBaseline: baselineVersionString
	"Create a new baseline with information given by the project"
	MetacelloToolBox
		createBaseline: baselineVersionString
		for: project configurationClass name
		repository: project repository
		requiredProjects: (project requiredProjects collect: [ :each | each name ])
		packages: (project packages collect: [ :aPackage | aPackage name ])
		repositories: #()
		dependencies: project dependenciesMap
		groups: (project groups collect: [ :aGroup | aGroup name -> aGroup dependencies ])
		requiredProjectSpecs: self requiredProjectSpecs! !

!MTDevelopmentWorkfow methodsFor: 'accessing' stamp: 'ChristopheDemarey 6/25/2013 10:02'!
project: anObject
	project := anObject! !

!MTDevelopmentWorkfow methodsFor: 'private' stamp: 'ChristopheDemarey 11/21/2013 18:26'!
createInitialDevelopment: versionString
	"Create an initial development version with an empty configuration and return the configuration class."

	| toolbox |
	toolbox := MetacelloToolBox configurationNamed: project name.	
		
	"Only a static method available on the toolbox to create baselines"
	MetacelloToolBox
		createBaseline: versionString 
		for: toolbox project configuration class name
		repository: project repository
		requiredProjects: #()
		packages: #()
		repositories: #()
		dependencies: #()
		groups: #().
		
	toolbox
		symbolicVersionMethod: #development;
		addSymbolicSection: #common version: versionString;
		commitMethod.
		
	^toolbox project configuration class! !

!MTDevelopmentWorkfow methodsFor: 'private' stamp: 'ChristopheDemarey 9/16/2013 11:45'!
notifyConfigurationModified
	(MBConfigurationRoot current configurationInfoFor: project configurationClass class) 
		configurationClassModified! !

!MTDevelopmentWorkfow methodsFor: 'private' stamp: 'ChristopheDemarey 2/6/2014 13:51'!
developmentVersion: devVersionString platformAttribute: platformAttribute
	"Set the #development symbolic version to the given version, using the given platformAttribute."
	
	(MetacelloToolBox configurationNamed: project name)
		symbolicVersionMethod: #development;
		addSymbolicSection: platformAttribute version: devVersionString;
		commitMethod.
! !

!MTDevelopmentWorkfow methodsFor: 'protocol' stamp: 'ChristopheDemarey 2/7/2014 14:21'!
createInitialDevelopment
	"Create an initial development version for an empty configuration."

	^ self createInitialDevelopment: '0.1-baseline'! !

!MTDevelopmentWorkfow methodsFor: 'private' stamp: 'ChristopheDemarey 11/27/2013 13:10'!
developmentVersionNumber: aDevelopmentVersionString
	| versionNumber |
	versionNumber := aDevelopmentVersionString copyReplaceAll: 'baseline' with: ''.
	versionNumber  :=  versionNumber copyReplaceAll: '-' with: ''.
	^ versionNumber! !

!MTDevelopmentWorkfow methodsFor: 'accessing' stamp: 'ChristopheDemarey 6/25/2013 10:02'!
project
	^ project! !

!MTDevelopmentWorkfow methodsFor: 'protocol' stamp: 'ChristopheDemarey 2/25/2014 15:56'!
updateDevelopment
	"Update development baseline with information present in the project."

	| baseline versionString |
	versionString := self developmentVersion versionString.
	self isDevelopmentUsedInRelease 
		ifTrue: [ self createNextDevelopment: self nextDevelopmentVersionString ]
		ifFalse: [ baseline := MetacelloToolBox compiledMethodForVersion: self developmentVersion.
				baseline methodClass class removeSelector: baseline selector.
				self createBaseline: versionString ].
	self notifyConfigurationModified! !

!MTDevelopmentWorkfow methodsFor: 'private' stamp: 'ChristopheDemarey 2/21/2014 16:16'!
requiredProjectSpecs
	^ project requiredProjects 
		collect: [ :requiredProject |  VersionnerToolBox projectSpecFromRequiredProject: requiredProject ].! !

!MTDevelopmentWorkfow methodsFor: 'private' stamp: 'ChristopheDemarey 2/25/2014 15:32'!
isDevelopmentUsedInRelease
	| devVersion allProjectVersions |
	
	devVersion := self developmentVersion.
	devVersion ifNil: [ ^ false ].
	(devVersion blessing = #baseline) ifFalse: [ ^false ].
	
	allProjectVersions := project configurationClass project versions.
	^ allProjectVersions 
		detect: [ :aVersion | aVersion importedVersions includes: devVersion versionString ]
		ifFound: [ true ]
		ifNone: [ false ]! !

!MTDevelopmentWorkfow methodsFor: 'protocol' stamp: 'ChristopheDemarey 2/6/2014 15:43'!
developmentVersion
	^ project configurationClass project version: #development! !

!MTDevelopmentWorkfow methodsFor: 'private' stamp: 'ChristopheDemarey 6/25/2013 10:24'!
createBaseline
	"Create a new baseline with information given by the project" 
	|lastBaseline baselineVersionString|
	
	lastBaseline := self configurationClass baselines detect: [:aBaseline | aBaseline isBleedingEdge].
	baselineVersionString := (lastBaseline name asInteger +1) asString.
	
	^ self createBaseline: baselineVersionString.! !

!MTDevelopmentWorkfow methodsFor: 'private' stamp: 'ChristopheDemarey 3/28/2014 11:03'!
nextDevelopmentVersionString: aDevelopmentVersionString
	| versionNumber lastPointIndex newVersionNumber |
	versionNumber := self developmentVersionNumber: aDevelopmentVersionString.
	lastPointIndex := versionNumber 
						lastIndexOf: $. 
						ifAbsent: [ nil ].
	newVersionNumber := lastPointIndex 
		ifNil: [ versionNumber + 1 ]
		ifNotNil: [ | newMinorVersion |
				newMinorVersion := (versionNumber allButFirst: lastPointIndex) asInteger + 1.
				(versionNumber  copyFrom: 1 to: lastPointIndex) , (newMinorVersion asString) ].
	^ self standardizeDevVersionString: newVersionNumber
! !

!MTDevelopmentWorkfow methodsFor: 'protocol' stamp: 'ChristopheDemarey 7/5/2013 22:24'!
createNextDevelopment: newDevVersionString
	"Create the next baseline that will be used as development version."

	self createBaseline: newDevVersionString.
	self
		developmentVersion: newDevVersionString
		platformAttribute: #common.! !

!MTDevelopmentWorkfow methodsFor: 'protocol' stamp: 'ChristopheDemarey 4/1/2014 16:59'!
nextDevelopmentVersionString
	| newVersionString |
	
	newVersionString := self developmentVersion versionString.
	[ project configurationClass project hasVersion: newVersionString ] whileTrue: [
		newVersionString := self nextDevelopmentVersionString: newVersionString ].
	^ newVersionString! !

!MTDevelopmentWorkfow methodsFor: 'private' stamp: 'ChristopheDemarey 3/28/2014 11:31'!
version: versionString
	^ project configurationClass project version: versionString! !

!MTDevelopmentWorkfow methodsFor: 'protocol' stamp: 'ChristopheDemarey 3/19/2014 11:50'!
releaseDevelopment: versionName
	"Release the development baseline (will give a version method) with the given version name."

	| devVersionString |
	devVersionString := self developmentVersion versionString.
	MetacelloToolBox
		createVersion: versionName
		for: project name
		from: devVersionString 
		description: 'version ' , versionName.
	self setStableBlessingFor: versionName.
	MetacelloToolBox 
		stableVersion: versionName 
		for: project name
		platformAttribute: #common. 
	"keep the development version pointing to the baseline"	
	self
		developmentVersion: devVersionString
		platformAttribute: #common.
	self notifyConfigurationModified! !

!MTDevelopmentWorkfow class methodsFor: 'initialization' stamp: 'ChristopheDemarey 6/25/2013 10:00'!
newWithProject: project
	"Create a new instance dedicated to the project given as parameter."

	^ self new
		project: project;
		yourself! !

!MTDevelopmentWorkfowTest methodsFor: 'tests' stamp: 'ChristopheDemarey 11/21/2013 17:56'!
testNewProjectWithInitialVersionInRepository
	|  projectName configClass |

	projectName := 'VersionnerTest'.
	project := MTProject newNamed: projectName withInitialVersion: '0.1'  inRepository: ''.
	
	self assert: (project configurationClass notNil) description: 'Project configuration class is nil.'.
	self shouldnt: [configClass := Smalltalk globals at: (project configurationClass name)]
		raise: KeyNotFound
		description: 'Cannot find the Configuration class in the image.'.
	self assert: project name equals: projectName.
	
	configClass removeFromSystem.
	! !

!MTDevelopmentWorkfowTest methodsFor: 'tests' stamp: 'ChristopheDemarey 3/28/2014 11:02'!
testNextDevelopmentVersionString
	| workflow |
	
	workflow := MTDevelopmentWorkfow new.
	self assert: (workflow nextDevelopmentVersionString: '1.0-baseline') equals: '1.1-baseline'.
	self assert: (workflow nextDevelopmentVersionString: '1.0') equals: '1.1-baseline'.
	self assert: (workflow nextDevelopmentVersionString: 'baseline-0.9') equals: '0.10-baseline'.! !

!MTDevelopmentWorkfowTest methodsFor: 'tests' stamp: 'ChristopheDemarey 3/28/2014 10:59'!
testStandardizeDevVersionString
	| workflow |
	
	workflow := MTDevelopmentWorkfow new.
	self assert: (workflow standardizeDevVersionString: '1.0-baseline') equals: '1.0-baseline'.
	self assert: (workflow standardizeDevVersionString: 'baseline-1.3') equals: '1.3-baseline'.! !

!MTDevelopmentWorkfowTest methodsFor: 'tests' stamp: 'ChristopheDemarey 2/7/2014 14:57'!
testCreateInitialDevelopment
	|  version configuration |

	project := MTProject newNamed: 'Z' withInitialVersion: '0.1'  inRepository: 'http://smalltalkhub.com/mc/demarey/Versionner/main'.
	configuration := project configurationClass.
	
	visitor := MCModel2MTModelVisitor new.
	self shouldnt: [ version := configuration project version: #development]
		 raise: MetacelloSymbolicVersionDoesNotExistError
		description: 'Cannot find the #development symbolic version in the metacello description'.
	
	self assert: configuration project development versionString
		equals: '0.1-baseline'.
	
	"configuration removeFromSystem."! !

!MTDevelopmentWorkfowTestWithXMLParser methodsFor: 'tests' stamp: 'ChristopheDemarey 11/21/2013 18:34'!
testCreateNextDevelopment
	project devWorkflow createNextDevelopment: '999'.
	self assert: (project configurationClass selectors includes: #'baseline999:').! !

!MTDevelopmentWorkfowTestWithXMLParser methodsFor: 'utility' stamp: 'ChristopheDemarey 2/25/2014 15:23'!
setDevelopment: aVersionString
	project configurationClass compile: 'development: spec
	<symbolicVersion: #''development''>

	spec for: #''common'' version: ''' , aVersionString , '''.'! !

!MTDevelopmentWorkfowTestWithXMLParser methodsFor: 'tests' stamp: 'ChristopheDemarey 2/25/2014 15:24'!
testIsDevelopmentUsedInRelease
	| workflow |
	workflow := project devWorkflow.
	self assert: workflow isDevelopmentUsedInRelease equals: false.
	
	self setDevelopment: '1.0-baseline'.
	self assert: workflow isDevelopmentUsedInRelease equals: true.
	
	self setDevelopment: '2.0-baseline'.
	self assert: workflow isDevelopmentUsedInRelease equals: false.
	
	self setDevelopment: '1.1'.
	self assert: workflow isDevelopmentUsedInRelease equals: false.
! !

!MTDevelopmentWorkfowTestWithXMLParser methodsFor: 'tests' stamp: 'ChristopheDemarey 11/21/2013 17:52'!
testCreateBaseline
	| baselineName baseline |
	
	baselineName := '84.1'.
	project devWorkflow createBaseline: baselineName. 
	
	"Visit the created baseline"
	baseline := project configurationClass project version: baselineName.
	project := visitor visitConfiguration: project configurationClass withVersion: baseline.
	self assert: project notNil.
	self assert: project name equals: 'VersionnerTestXMLParser'.
	self assert: project version name equals: baselineName.
! !

!MTDevelopmentWorkfowTestWithXMLParser methodsFor: 'running' stamp: 'ChristopheDemarey 6/25/2013 13:19'!
tearDown 
	classFactory cleanUp.! !

!MTDevelopmentWorkfowTestWithXMLParser methodsFor: 'running' stamp: 'ChristopheDemarey 6/25/2013 13:19'!
setUp
	"Create a model of the project version we want to work on."
	| version |
	
	"create a copy of the class to don't pollute the configuration with code generated for tests purposes"
	classFactory := ClassFactoryForTestCase new.
	class := classFactory duplicateClass: ConfigurationOfVersionnerTestXMLParserTemplate withNewName: #ConfigurationOfVersionnerTestXMLParser.
	
	visitor := MCModel2MTModelVisitor new.
	version := class project version: '1.1'.
	project := visitor visitConfiguration: class withVersion: version.
		! !

!MTGroup commentStamp: '<historical>'!
A MTGroup is a convenient way to group software dependencies (instances of MTDependency). 

Instance Variables
	- dependencies : A collection of dependencies defiing the group.
!
!MTGroup methodsFor: 'displaying' stamp: 'ChristopheDemarey 11/30/2012 17:50'!
displayString
	^ name! !

!MTGroup methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 6/21/2013 10:44'!
treeNodeClass
	^ VSGroupLeafNode! !

!MTGroup methodsFor: 'protocol' stamp: 'ChristopheDemarey 12/11/2013 18:26'!
addDependency: aDependency
	super addDependency: aDependency.
	self project ifNotNil: [ self project announcer announce: (MTProjectModelChanged project: self) ].! !

!MTGroup methodsFor: 'visiting' stamp: 'ChristopheDemarey 12/6/2013 16:49'!
acceptVisitor: anMTProjectVisitor
	anMTProjectVisitor visitGroup: self! !

!MTModelComparator commentStamp: '<historical>'!
A comparator that can be used to compare a whole dependency graph.!
!MTModelComparator methodsFor: 'comparing' stamp: 'ChristopheDemarey 3/14/2014 18:28'!
is: anMTProject equalsTo: anOtherMTProject
	| referenceModelIterator modelToCompareIterator |
	
	referenceModelIterator := MTProjectBFSIterator on: anMTProject.
	modelToCompareIterator := MTProjectBFSIterator on: anOtherMTProject.
	
	[ true ] whileTrue: [ | referenceElement elementToCompare |
			referenceElement := referenceModelIterator next.
			elementToCompare := modelToCompareIterator next.
			(referenceElement = elementToCompare ) 
				ifFalse: [ ^false ].
			referenceModelIterator hasNext 
				ifFalse: [ ^ modelToCompareIterator hasNext not ]  ]
! !

!MTModelComparator class methodsFor: 'protocol' stamp: 'ChristopheDemarey 12/12/2013 13:34'!
is: anMTProject equalsTo: anOtherMTProject
	^self new is: anMTProject equalsTo: anOtherMTProject! !

!MTModelComparatorTest methodsFor: 'tests' stamp: 'ChristopheDemarey 3/14/2014 18:29'!
testIsEqualsTo
	| projectA projectB |
	
	projectA := self referenceModel.
	projectB := self referenceModel.
	self deny: projectA == projectB.
	self assert: (MTModelComparator is: projectA equalsTo: projectB).
	
	projectB removeDependencyNamed: 'PackageA2'.
	self deny: (MTModelComparator is: projectA equalsTo: projectB).
	
	projectB :=self referenceModel.
	projectB removeDependencyNamed: 'LibXYZ'.
	self deny: (MTModelComparator is: projectA equalsTo: projectB).

	projectB := self referenceModel.
	projectB removeDependencyNamed: 'All'.
	self deny: (MTModelComparator is: projectA equalsTo: projectB).

	projectB := self referenceModel.
	(projectB dependencyNamed: 'All') removeDependency: (projectB dependencyNamed: 'SmallGroup').
	self deny: (MTModelComparator is: projectA equalsTo: projectB).
	
	projectB := self referenceModel.
	(projectB dependencyNamed: 'LibXYZ') addDependency: 'Core'.
	self deny: (MTModelComparator is: projectA equalsTo: projectB).
	
	projectA := MTProjectExampleBuilder projectC.
	projectB := MTProjectExampleBuilder projectC.
	(projectB dependencyNamed: 'LibXYZ') addDependency: 'Core'.
	self deny: (MTModelComparator is: projectA equalsTo: projectB).
	self deny: (MTModelComparator is: projectB equalsTo: projectA).! !

!MTModelComparatorTest methodsFor: 'private' stamp: 'ChristopheDemarey 12/12/2013 14:42'!
referenceModel
	^ MTProjectExampleBuilder projectA! !

!MTPackage commentStamp: '<historical>'!
A MTPackage represents an internal depedency of a project, i.e a package located in the same MCPackage.

Note: Metacello allows to describe external dependencies. In this case, transitive dependencies are not fetched. As this is not the good way to express dependencies, it is not supported here!!!
!MTPackage methodsFor: 'displaying' stamp: 'ChristopheDemarey 1/24/2013 17:31'!
displayString
	^ version ifNil:
		[ name ]
			   ifNotNilDo:
		[ :aVersion | name, ' (', aVersion author , '.', aVersion name asString, ')' ].! !

!MTPackage methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 6/21/2013 10:44'!
treeNodeClass
	^VSPackageLeafNode! !

!MTPackage methodsFor: 'visiting' stamp: 'ChristopheDemarey 12/6/2013 16:50'!
acceptVisitor: anMTProjectVisitor
	anMTProjectVisitor visitPackage: self! !

!MTPlatform commentStamp: '<historical>'!
A MTPlatform reprensents targeted platforms (ex: pharo1.4.x, pharo2.x)
!
!MTProject commentStamp: '<historical>'!
A project represents a software development project, and more presicely, its depdendencies (also known as configuration).

Note: Need to add extra methods with "for:" parameter to handle platforms (e.g. for: #'pharo' do)

Instance Variables
	- configurationClass : the configurationClass this project represents
	- repository : The core repository URL of this project
	- packages : internal packages (MTPackage) the project depends on
	- groups : definitions of set of dependencies (MTGroups)
	- depedentProjects : list of external projects this project depends on (list of project names)
!
!MTProject methodsFor: 'private' stamp: 'TesterBob 11/27/2012 15:30'!
dependenciesFilteredBy: aClass
	"Filter dependencies to only get Class instances"
	^dependencies select: [ :each | each class =  aClass ].! !

!MTProject methodsFor: 'setting' stamp: 'ChristopheDemarey 12/11/2013 14:11'!
addDependency: aDependency
	"Add a dependency to the configuration (will create a new baseline)."

	dependencies add: aDependency.
	aDependency parent: self.
	self announcer announce: (MTProjectModelChanged project: self).! !

!MTProject methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/23/2013 17:17'!
announcer
	^ announcer ifNil: [announcer := Announcer new]! !

!MTProject methodsFor: 'accessing' stamp: 'TesterBob 11/27/2012 15:27'!
dependencies
	^dependencies .! !

!MTProject methodsFor: 'accessing' stamp: 'ChristopheDemarey 6/26/2013 18:03'!
dependencies: aDependencyList
	dependencies := aDependencyList! !

!MTProject methodsFor: 'protocol' stamp: 'ChristopheDemarey 3/6/2013 16:25'!
configurationClass: aConfigurationClass
	configurationClass := aConfigurationClass.
	self name: configurationClass name configurationBaseName.
! !

!MTProject methodsFor: 'accessing' stamp: 'ChristopheDemarey 1/30/2013 15:00'!
repository 
	^ repository ! !

!MTProject methodsFor: 'accessing' stamp: 'ChristopheDemarey 12/12/2012 15:04'!
version
	^ version! !

!MTProject methodsFor: 'accessing' stamp: 'ChristopheDemarey 6/6/2013 12:53'!
currentBaseline
	| baselines |
	
	baselines := self configurationClass project versions select: [:aVersion | aVersion blessing == #baseline].
	^baselines last! !

!MTProject methodsFor: 'accessing' stamp: 'ChristopheDemarey 6/25/2013 13:25'!
devWorkflow
	^ devWorkflow
		ifNil: [ devWorkflow := MTDevelopmentWorkfow newWithProject: self ]
		ifNotNil: [ :myself | myself ]! !

!MTProject methodsFor: 'visiting' stamp: 'ChristopheDemarey 12/6/2013 17:20'!
acceptVisitor: anMTProjectVisitor
	anMTProjectVisitor visitProject: self.
	dependencies do: [ :dependency | dependency acceptVisitor: anMTProjectVisitor ]! !

!MTProject methodsFor: 'accessing' stamp: 'TesterBob 11/27/2012 15:31'!
packages
	"Filter dependencies to only get packages"
	^ self dependenciesFilteredBy: MTPackage .! !

!MTProject methodsFor: 'accessing' stamp: 'TesterBob 11/27/2012 15:32'!
requiredProjects
	"Filter dependencies to only get RquiredProject"
	^ self dependenciesFilteredBy: MTDependantProject .! !

!MTProject methodsFor: 'accessing' stamp: 'ChristopheDemarey 11/30/2012 16:17'!
configurationClass
	^ configurationClass! !

!MTProject methodsFor: 'initialize-release' stamp: 'TesterBob 11/27/2012 15:42'!
initialize 
	dependencies  := OrderedCollection new.
! !

!MTProject methodsFor: 'comparing' stamp: 'ChristopheDemarey 12/12/2013 09:38'!
= other
	(self name = other name) ifFalse: [ ^false ].
	(self version = other version) ifFalse: [ ^false ].
	(self configurationClass  = other configurationClass) ifFalse: [ ^false ].
	(self repository = other repository) ifFalse: [ ^false ].
	^true! !

!MTProject methodsFor: 'accessing' stamp: 'TesterBob 11/27/2012 15:41'!
name: anObject
	name := anObject! !

!MTProject methodsFor: 'protocol' stamp: 'ChristopheDemarey 6/27/2013 15:48'!
removeDependencyNamed: aDependencyName
	"Remove a depedency from the configuration"
	
	(self dependencyNamed: aDependencyName) remove! !

!MTProject methodsFor: 'accessing' stamp: 'ChristopheDemarey 1/31/2013 10:54'!
repository: aRepositoryURL
	repository := aRepositoryURL.! !

!MTProject methodsFor: 'accessing' stamp: 'ChristopheDemarey 6/25/2013 10:45'!
dependenciesMap
	^ self packages collect: [ :aPackage | aPackage name -> aPackage dependencies ]! !

!MTProject methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/19/2013 18:41'!
dependencyNamed: aDependencyName
	"Get a depedency from its name"
	
	^ dependencies
		detect: [  :aDependency | (aDependency name =  aDependencyName) or: [ aDependency displayName =  aDependencyName ] ]
		ifNone: [ nil ]
! !

!MTProject methodsFor: 'accessing' stamp: 'ChristopheDemarey 12/12/2012 14:05'!
name
	^ name! !

!MTProject methodsFor: 'accessing' stamp: 'TesterBob 11/27/2012 15:31'!
groups
	"Filter dependencies to only get groups"
	^ self dependenciesFilteredBy: MTGroup .! !

!MTProject methodsFor: 'setting' stamp: 'ChristopheDemarey 12/12/2012 15:03'!
version: aMTVersion 
	version := aMTVersion! !

!MTProject class methodsFor: 'instance creation' stamp: 'ChristopheDemarey 3/28/2014 16:29'!
newNamed: projectName withInitialVersion: version inRepository: repositoryURL
	"Create the skeleton of a new project (alos known as configuration)"
	| project |

	project := self new.
	project name: projectName.
	project repository: repositoryURL.
	project configurationClass: project devWorkflow createInitialDevelopment.
	^ project.
	! !

!MTProject class methodsFor: 'instance creation' stamp: 'ChristopheDemarey 4/2/2014 15:19'!
newFromVersion: aMetacelloVersion inConfiguration: aConfigurationClass
	^ MCModel2MTModelVisitor new
		visitConfiguration: aConfigurationClass
		withVersion: aMetacelloVersion! !

!MTProjectBFSIterator commentStamp: '<historical>'!
BFS (see http://en.wikipedia.org/wiki/Breadth-first_search)  iterator for an MTProject graph.
We avoid to visit already visited children of a node.!
!MTProjectBFSIterator methodsFor: 'initialization' stamp: 'ChristopheDemarey 12/11/2013 11:35'!
initialize
	queue := SharedQueue new.
	alreadyVisited := Set new.! !

!MTProjectBFSIterator methodsFor: 'protocol' stamp: 'ChristopheDemarey 12/11/2013 13:20'!
hasNext
	^ queue isEmpty not
	! !

!MTProjectBFSIterator methodsFor: 'accessing' stamp: 'ChristopheDemarey 12/11/2013 13:07'!
project: anMTProject
	project := anMTProject.
	self reset! !

!MTProjectBFSIterator methodsFor: 'protocol' stamp: 'ChristopheDemarey 12/11/2013 13:11'!
next
	| currentElement |
	
	currentElement := queue nextOrNil.
	currentElement ifNotNil: [
		((self hasChildNodes: currentElement) and: [ self isNotVisited: currentElement ])
			ifTrue: [ queue nextPutAll: currentElement dependencies.
					 alreadyVisited add: currentElement ] ].
	^ currentElement! !

!MTProjectBFSIterator methodsFor: 'protocol' stamp: 'ChristopheDemarey 12/11/2013 13:07'!
reset
	self initialize.
	queue nextPut: project! !

!MTProjectBFSIterator methodsFor: 'private' stamp: 'ChristopheDemarey 12/11/2013 13:03'!
isNotVisited: aNode
	^ (alreadyVisited includes: aNode) not! !

!MTProjectBFSIterator methodsFor: 'private' stamp: 'ChristopheDemarey 12/12/2013 17:34'!
hasChildNodes: aNode
	| dependencies |
	
	[ dependencies := aNode dependencies ] 
		on: MessageNotUnderstood 
		do: [  ^false ].
	^ dependencies size > 0! !

!MTProjectBFSIterator class methodsFor: 'instance creation' stamp: 'ChristopheDemarey 12/10/2013 13:43'!
on: anMTProject
	^ self new
		project: anMTProject;
		yourself.! !

!MTProjectBFSIteratorTest methodsFor: 'tests' stamp: 'ChristopheDemarey 12/11/2013 13:17'!
testNext
	| iterator currentElement |
	
	iterator := MTProjectBFSIterator on: MTProjectExampleBuilder projectA.
	currentElement := iterator next.
	self assert: (currentElement isKindOf: MTProject).
	self assert: currentElement name equals: 'A'.
	
	(1 to: 5) do: [ :i |
			currentElement := iterator next.
			self assert: (currentElement isKindOf: MTPackage).
			self assert:  currentElement name equals: 'PackageA' , i asString ].
	
	currentElement := iterator next.
	self assert: (currentElement isKindOf: MTDependantProject).
	self assert: currentElement name equals: 'LibXYZ'.
		
	currentElement := iterator next.
	self assert: (currentElement isKindOf: MTGroup).
	self assert: currentElement name equals: 'SmallGroup'.
	currentElement := iterator next.
	self assert: (currentElement isKindOf: MTGroup).
	self assert: currentElement name equals: 'All'.

	(1 to: 5) do: [ :i |
			currentElement := iterator next.
			self assert: (currentElement isKindOf: MTPackage).
			self assert:  currentElement name equals: 'PackageA' , i asString ].
	
	currentElement := iterator next.
	self assert: (currentElement isKindOf: MTGroup).
	self assert: currentElement name equals: 'SmallGroup'.
	
	currentElement := iterator next.
	self assert: (currentElement isKindOf: MTDependantProject).
	self assert: currentElement name equals: 'LibXYZ'.
	
	self assert: iterator hasNext not.
	self assert: iterator next isNil! !

!MTProjectExampleBuilder commentStamp: '<historical>'!
A MTProjectExampleBuilder is used to create some MTProjects with dummy data or tests purposes.
!
!MTProjectExampleBuilder class methodsFor: 'building projects' stamp: 'ChristopheDemarey 3/14/2014 18:25'!
projectC
	| project |
	
	project := MTProject 
					newNamed: 'C'
					withInitialVersion: '0.1'
					inRepository: 'http://smalltalkhub.com/mc/dummy/C/main'.
	
	project addDependency: (MTDependantProject newNamed: 'LibXYZ').
	^ project! !

!MTProjectExampleBuilder class methodsFor: 'building projects' stamp: 'ChristopheDemarey 12/10/2013 13:39'!
projectB
	| project allGroup smallGroup |
	
	project := MTProject 
					newNamed: 'B'
					withInitialVersion: '0.2'
					inRepository: 'http://smalltalkhub.com/mc/dummy/A/main'.
	(1 to: 4) do: [ :i |
		project addDependency: (MTPackage newNamed: 'PackageA' , i asString) ].
	
	project addDependency: (MTDependantProject newNamed: 'LibXYZ').

	smallGroup := MTGroup newNamed: 'SmallGroup'.
	project packages do: [ :package | smallGroup addDependency: package ].
	project addDependency: smallGroup.
	
	allGroup := MTGroup newNamed: 'All'.
	allGroup addDependency: smallGroup.
	project addDependency: allGroup.
	
	^ project! !

!MTProjectExampleBuilder class methodsFor: 'building projects' stamp: 'ChristopheDemarey 12/10/2013 13:39'!
projectA
	| project allGroup smallGroup |
	
	project := MTProject 
					newNamed: 'A'
					withInitialVersion: '0.1'
					inRepository: 'http://smalltalkhub.com/mc/dummy/A/main'.
	(1 to: 5) do: [ :i |
		project addDependency: (MTPackage newNamed: 'PackageA' , i asString) ].
	
	project addDependency: (MTDependantProject newNamed: 'LibXYZ').

	smallGroup := MTGroup newNamed: 'SmallGroup'.
	project packages do: [ :package | smallGroup addDependency: package ].
	project addDependency: smallGroup.
	
	allGroup := MTGroup newNamed: 'All'.
	allGroup addDependency: smallGroup.
	allGroup addDependency: project requiredProjects first.
	project addDependency: allGroup.
	
	^ project! !

!MTProjectModelChanged commentStamp: '<historical>'!
A MTAnnouncement is used to signal a change on a MTProject model.!
!MTProjectModelChanged methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/23/2013 17:22'!
project: anObject
	project := anObject! !

!MTProjectModelChanged methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/23/2013 17:22'!
project
	^ project! !

!MTProjectModelChanged class methodsFor: 'creation' stamp: 'ChristopheDemarey 7/23/2013 18:00'!
project: anObject
	^ self new 
		project: anObject;
		yourself! !

!MTProjectTest commentStamp: '<historical>'!
Test class for MTProject!
!MTProjectTest methodsFor: 'tests' stamp: 'ChristopheDemarey 12/12/2013 10:28'!
testEquals
	| projectA projectB |
	
	projectA := MTProjectExampleBuilder projectA.
	projectB := MTProjectExampleBuilder projectA.
	self deny: projectA == projectB.
	self assert: projectA equals: projectB.
	
	projectB name: 'B'.
	self deny: projectA == projectB.
	
	projectB := MTProjectExampleBuilder projectA.
	projectB version: MTVersion new.
	self deny: projectA == projectB.

	projectB := MTProjectExampleBuilder projectA.
	projectB configurationClass: self class.
	self deny: projectA == projectB.

	projectB := MTProjectExampleBuilder projectA.
	projectB repository: 'http://localhost'.
	self deny: projectA == projectB.! !

!MTVersion commentStamp: '<historical>'!
A MTVersion describes a specific version of a dependency.

Instance Variables
	- author : the version author
	- versionString : a version String that can be used to load the described version (e.g ConfigurationOfXXX project version: versionString)
	- description : the version description 
	- timestamp : the commit time of this version
	- project : a reference to the described project!
!MTVersion methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/15/2013 14:10'!
timestamp: anObject
	timestamp := anObject! !

!MTVersion methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/15/2013 14:10'!
description
	^ description! !

!MTVersion methodsFor: 'accessing' stamp: 'ChristopheDemarey 11/30/2012 16:15'!
project
	"Get the project this version is refering to. May be a project or a required project"
	^ project! !

!MTVersion methodsFor: 'visiting' stamp: 'ChristopheDemarey 12/6/2013 16:54'!
acceptVisitor: anMTProjectVisitor
	anMTProjectVisitor visitVersion: self.! !

!MTVersion methodsFor: 'accessing' stamp: 'ChristopheDemarey 11/30/2012 11:44'!
author: anObject
	author := anObject! !

!MTVersion methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/25/2013 15:23'!
versionString
	^ versionString! !

!MTVersion methodsFor: 'comparing' stamp: 'ChristopheDemarey 12/12/2013 12:42'!
= other
	(self name = other name) ifFalse: [ ^false ].
	(self author = other author) ifFalse: [ ^false ].
	(self versionString = other versionString) ifFalse: [ ^false ].
	(self description = other description) ifFalse: [ ^false ].
	(self timestamp = other timestamp) ifFalse: [ ^false ].
	(self project = other project) ifFalse: [ ^false ].
	^true.! !

!MTVersion methodsFor: 'accessing' stamp: 'ChristopheDemarey 11/30/2012 11:44'!
author
	^ author! !

!MTVersion methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/15/2013 14:10'!
description: anObject
	description := anObject! !

!MTVersion methodsFor: 'accessing' stamp: 'ChristopheDemarey 12/7/2012 14:34'!
mcVersion
	"Get the MetacelloMCVersion object representing this version"

	| configurationClass |
	configurationClass := project configurationClass.
	configurationClass project version: versionString. ! !

!MTVersion methodsFor: 'accessing' stamp: 'ChristopheDemarey 11/30/2012 11:39'!
name: aName 
	name := aName.! !

!MTVersion methodsFor: 'printing' stamp: 'ChristopheDemarey 11/30/2012 16:26'!
printOn: aStream
	"Pretty print for a version"
	aStream "nextPutAll: name ;
			nextPut: $- ;
			nextPutAll: author ;
			nextPut: $. ;"
			nextPutAll: versionString asString .! !

!MTVersion methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/15/2013 14:10'!
timestamp
	^ timestamp! !

!MTVersion methodsFor: 'accessing' stamp: 'ChristopheDemarey 12/13/2012 16:08'!
versionString: aVersionString
	versionString := aVersionString.
	name := aVersionString.! !

!MTVersion methodsFor: 'accessing' stamp: 'ChristopheDemarey 12/13/2012 16:04'!
name
	^name.! !

!MTVersion class methodsFor: 'instance creation' stamp: 'ChristopheDemarey 11/30/2012 15:57'!
fromVersionString: aVersionString
	"Create a new version from a versionString."

	| version |
	version := self new.
	version versionString: aVersionString .
	^ version
! !

!MTVersion class methodsFor: 'instance creation' stamp: 'ChristopheDemarey 7/25/2013 15:21'!
fromVersionName: aVersionName
	"Create a new version from a versionName (a file reference)."

	| version names |
	names := MetacelloCommonMCSpecLoader nameComponentsFrom: aVersionName.
	version := self new.
	version name: names first.
	version author: (names at: 2).
	version versionString: (names at: 3).
	^ (version versionString = 0) ifTrue: [ nil ] ifFalse: [ version ]
! !

!MacOSClipboard commentStamp: 'TorstenBergmann 1/31/2014 10:28'!
The clipboard for MacOS!
!MacOSClipboard methodsFor: 'private' stamp: 'michael.rueger 3/2/2009 12:51'!
addUF8StringClipboardData: aString
	| ba  |

	self clearClipboard.
	ba := aString convertToWithConverter: (UTF8TextConverter new).
	self addClipboardData: ba dataFormat: 'public.utf8-plain-text'
! !

!MacOSPlatform commentStamp: '<historical>'!
I am a an object representing a Mac OS (pre OSX) platform. Use myself to access platform specific features.
!
!MacOSPlatform methodsFor: '*System-Clipboard' stamp: 'CamilloBruni 5/9/2013 22:27'!
clipboardClass
	^MacOSClipboard! !

!MacOSPlatform methodsFor: 'testing' stamp: 'CamilloBruni 5/9/2013 22:28'!
isMacOS
	^ true! !

!MacOSPlatform methodsFor: '*Glamour-Core' stamp: 'EstebanLorenzano 12/10/2014 22:44'!
menuShortcutModifierString
	^ 'cmd'! !

!MacOSPlatform methodsFor: 'accessing' stamp: 'cami 7/22/2013 18:33'!
family
	^#MacOS! !

!MacOSPlatform methodsFor: '*Files' stamp: 'DamienCassou 11/15/2013 18:10'!
potentialLocationsOfSourcesFile
	^ {
		"Take care of .app that have a 'Resources' folder as a sibling of the vm binary"
		Smalltalk vm fullPath asFileReference parent parent / 'Resources'.
		Smalltalk vm directory.
		Smalltalk vm fullPath asFileReference parent.
		FileLocator systemApplicationSupport.
		FileLocator userApplicationSupport.
	}! !

!MacOSPlatform methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/12/2013 14:22'!
lineEnding

	^ String lf! !

!MacOSPlatform methodsFor: '*Keymapping-KeyCombinations' stamp: 'CamilloBruni 11/29/2013 17:09'!
defaultModifier

	^ KMModifier meta! !

!MacOSPlatform methodsFor: 'accessing' stamp: 'CamilloBruni 5/9/2013 22:27'!
keyForValue: aKeyValue
	^Key valueForMacOSXPlatform: aKeyValue.! !

!MacOSPlatform class methodsFor: 'testing' stamp: 'CamilloBruni 5/9/2013 22:38'!
isMacOS

	^ self currentPlatformName = 'Mac OS'! !

!MacOSPlatform class methodsFor: 'testing' stamp: 'CamilloBruni 5/9/2013 22:38'!
isActivePlatform
	^ self isMacOS and: [ self currentVersion asNumber < 1000 ]! !

!MacOSResolver commentStamp: 'cwp 11/18/2009 11:57'!
I am an expert on Mac OS X filesystem conventions. I resolve origins according to these conventions.!
!MacOSResolver methodsFor: 'origins' stamp: 'DamienCassou 11/7/2013 17:12'!
preferences 
	^ self home / 'Library' / 'Preferences'! !

!MacOSResolver methodsFor: 'origins' stamp: 'CamilloBruni 11/8/2013 18:35'!
systemApplicationSupport
	^ self systemLibrary / 'Application Support'! !

!MacOSResolver methodsFor: 'origins' stamp: 'DamienCassou 7/4/2013 15:47'!
home
	^ self directoryFromEnvVariableNamed: 'HOME'! !

!MacOSResolver methodsFor: 'origins' stamp: 'DamienCassou 7/4/2013 15:45'!
cache
	^ self library / 'Caches'! !

!MacOSResolver methodsFor: 'origins' stamp: 'cwp 10/27/2009 21:45'!
desktop
	^ self home / 'Desktop'! !

!MacOSResolver methodsFor: 'origins' stamp: 'CamilloBruni 11/8/2013 18:35'!
userApplicationSupport
	^self userLibrary / 'Application Support'! !

!MacOSResolver methodsFor: 'origins' stamp: 'CamilloBruni 11/8/2013 19:06'!
systemLibrary
	^  FileSystem disk root / 'Library'! !

!MacOSResolver methodsFor: 'origins' stamp: 'cwp 10/27/2009 21:50'!
documents
	^ self home / 'Documents'! !

!MacOSResolver methodsFor: 'origins' stamp: 'CamilloBruni 11/8/2013 18:37'!
library
	^ self userLibrary! !

!MacOSResolver methodsFor: 'resolving' stamp: 'CamilloBruni 11/8/2013 19:07'!
supportedOrigins
	^ super supportedOrigins , #(userApplicationSupport systemApplicationSupport systemLibrary userLibrary)! !

!MacOSResolver methodsFor: 'origins' stamp: 'CamilloBruni 11/8/2013 18:35'!
userLibrary
	^  self home / 'Library'! !

!MacOSResolver methodsFor: 'origins' stamp: 'DamienCassou 12/20/2013 11:58'!
temp
	^ '/tmp' asFileReference! !

!MacOSResolver class methodsFor: 'accessing' stamp: 'cwp 10/27/2009 10:59'!
platformName
	^  'Mac OS'! !

!MacOSXPlatform commentStamp: '<historical>'!
I am a an object representing a MacOSX platform. Use myself to access platform specific features.

Please keep me polymorphic to the the other platform objects.

To get the current platform, you can evaluate:

OSPlatform current.!
!MacOSXPlatform methodsFor: 'testing' stamp: 'CamilloBruni 5/9/2013 22:28'!
isMacOSX
	^ true! !

!MacOSXPlatform methodsFor: 'accessing' stamp: 'cami 7/22/2013 18:33'!
family
	^#MacOSX! !

!MacOSXPlatform class methodsFor: 'testing' stamp: 'CamilloBruni 5/9/2013 22:39'!
isActivePlatform
	^ self isMacOS and: [ self currentVersion asNumber >= 1000 ]! !

!MacRomanTextConverter commentStamp: '<historical>'!
Text converter for Mac Roman.  An encoding used for the languages originated from Western Europe area.!
!MacRomanTextConverter class methodsFor: 'as yet unclassified' stamp: ''!
initialize
	self initializeTables! !

!MacRomanTextConverter class methodsFor: 'accessing' stamp: 'michael.rueger 2/2/2009 19:31'!
languageEnvironment
	^Latin1Environment! !

!MacRomanTextConverter class methodsFor: 'accessing' stamp: 'yo 8/4/2003 12:33'!
encodingNames 

	^ #('mac-roman' ) copy
! !

!MacRomanTextConverter class methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 3/7/2012 21:41'!
byteToUnicodeSpec
	"ByteTextConverter generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/VENDORS/APPLE/ROMAN.TXT'"

	^ #(
	16r00C4 16r00C5 16r00C7 16r00C9 16r00D1 16r00D6 16r00DC 16r00E1 
	16r00E0 16r00E2 16r00E4 16r00E3 16r00E5 16r00E7 16r00E9 16r00E8 
	16r00EA 16r00EB 16r00ED 16r00EC 16r00EE 16r00EF 16r00F1 16r00F3 
	16r00F2 16r00F4 16r00F6 16r00F5 16r00FA 16r00F9 16r00FB 16r00FC 
	16r2020 16r00B0 16r00A2 16r00A3 16r00A7 16r2022 16r00B6 16r00DF 
	16r00AE 16r00A9 16r2122 16r00B4 16r00A8 16r2260 16r00C6 16r00D8 
	16r221E 16r00B1 16r2264 16r2265 16r00A5 16r00B5 16r2202 16r2211 
	16r220F 16r03C0 16r222B 16r00AA 16r00BA 16r03A9 16r00E6 16r00F8 
	16r00BF 16r00A1 16r00AC 16r221A 16r0192 16r2248 16r2206 16r00AB 
	16r00BB 16r2026 16r00A0 16r00C0 16r00C3 16r00D5 16r0152 16r0153 
	16r2013 16r2014 16r201C 16r201D 16r2018 16r2019 16r00F7 16r25CA 
	16r00FF 16r0178 16r2044 16r20AC 16r2039 16r203A 16rFB01 16rFB02 
	16r2021 16r00B7 16r201A 16r201E 16r2030 16r00C2 16r00CA 16r00C1 
	16r00CB 16r00C8 16r00CD 16r00CE 16r00CF 16r00CC 16r00D3 16r00D4 
	16rF8FF 16r00D2 16r00DA 16r00DB 16r00D9 16r0131 16r02C6 16r02DC 
	16r00AF 16r02D8 16r02D9 16r02DA 16r00B8 16r02DD 16r02DB 16r02C7 )! !

!MacStore commentStamp: '<historical>'!
I'm a specific store for OSX file systems!
!MacStore methodsFor: 'public' stamp: 'CamilloBruni 5/9/2012 13:11'!
mimeTypesAt: aPath
	"Return a list of MIME types applicable to the receiver. This default implementation uses the file name extension to figure out what we're looking at but specific subclasses may use other means of figuring out what the type of some file is. Some systems like the macintosh use meta data on the file to indicate data type"
	"| typeCreator type | 
	typeCreator := self getMacFileTypeAndCreator: ((self fullNameFor: fileName)).
	type := (typeCreator at: 1) asLowercase.
	^TypeToMimeMappings at: type ifAbsent:[super mimeTypesFor: fileName]"
	self flag: 'TODO: properly implement the mac os version'.
	^ super mimeTypesAt: aPath! !

!MacStore class methodsFor: 'current' stamp: 'CamilloBruni 5/10/2012 15:43'!
isActiveClass
	^ Smalltalk os isMacOS! !

!Magnitude commentStamp: 'sd 9/4/2005 10:14'!
I'm the abstract class Magnitude that provides common protocol for objects that have
the ability to be compared along a linear dimension, such as dates or times.
Subclasses of Magnitude include Date, ArithmeticValue, and Time, as well as
Character and LookupKey.
 
 
My subclasses should implement
  < aMagnitude 
  = aMagnitude 
  hash

Here are some example of my protocol:
     3 > 4
     5 = 6
     100 max: 9
	7 between: 5 and: 10 
!
!Magnitude methodsFor: 'comparing' stamp: ''!
min: aMin max: aMax 

	^ (self min: aMin) max: aMax! !

!Magnitude methodsFor: 'hash' stamp: ''!
hash
	"Hash must be redefined whenever = is redefined."

	^self subclassResponsibility! !

!Magnitude methodsFor: 'testing' stamp: ''!
= aMagnitude 
	"Compare the receiver with the argument and answer with true if the 
	receiver is equal to the argument. Otherwise answer false."

	^self subclassResponsibility! !

!Magnitude methodsFor: 'testing' stamp: ''!
> aMagnitude 
	"Answer whether the receiver is greater than the argument."

	^aMagnitude < self! !

!Magnitude methodsFor: 'testing' stamp: 'nice 12/31/2008 04:06'!
>= aMagnitude 
	"Answer whether the receiver is greater than or equal to the argument."

	^aMagnitude <= self! !

!Magnitude methodsFor: 'comparing' stamp: ''!
min: aMagnitude 
	"Answer the receiver or the argument, whichever has the lesser 
	magnitude."

	self < aMagnitude
		ifTrue: [^self]
		ifFalse: [^aMagnitude]! !

!Magnitude methodsFor: 'testing' stamp: ''!
< aMagnitude 
	"Answer whether the receiver is less than the argument."

	^self subclassResponsibility! !

!Magnitude methodsFor: 'comparing' stamp: ''!
max: aMagnitude 
	"Answer the receiver or the argument, whichever has the greater 
	magnitude."

	self > aMagnitude
		ifTrue: [^self]
		ifFalse: [^aMagnitude]! !

!Magnitude methodsFor: 'testing' stamp: ''!
between: min and: max 
	"Answer whether the receiver is less than or equal to the argument, max, 
	and greater than or equal to the argument, min."

	^self >= min and: [self <= max]! !

!Magnitude methodsFor: 'comparing' stamp: 'CamilleTeruel 8/25/2014 11:31'!
compareWith: anotherMagnitude ifLesser: lesserBlock ifEqual: equalBlock ifGreater: greaterBlock

	^ self < anotherMagnitude
		ifTrue: lesserBlock
		ifFalse: [ 
			self = anotherMagnitude
				ifTrue: equalBlock
				ifFalse: greaterBlock ]! !

!Magnitude methodsFor: 'testing' stamp: ''!
<= aMagnitude 
	"Answer whether the receiver is less than or equal to the argument."

	^(self > aMagnitude) not! !

!Magnitude class methodsFor: '*Polymorph-Widgets-Themes' stamp: 'YuriyTymchuk 12/20/2013 11:18'!
systemIcon

	^ Smalltalk ui icons iconNamed: #magnitudeIcon! !

!MailAddressParser commentStamp: '<historical>'!
Parse mail addresses.  The basic syntax is:

	addressList := MailAddressParser addressesIn: aString

This currently only returns the bare addresses, but it could also return a list of the address "source codes".  For example, if you give it "Joe <joe@foo>, <jane>", it will currently return a list ('joe@foo' 'jane').  It would be nice to also get a list ('Joe <joe@foo>'  '<jane>').!
!MailAddressParser methodsFor: 'parsing' stamp: 'ls 10/23/1998 13:39'!
grabBasicAddress
	"grad an address of the form a.b@c.d.e"
	self startNewAddress.
	"grab either the domain if specified, or the domain if not"
	self addToAddress.
	[tokens isEmpty not and: [ tokens last type = $.] ] 
		whileTrue: 
			["add name-dot pairs of tokens"
			self addToAddress.
			(#(Atom QuotedString ) includes: tokens last type)
				ifFalse: [self error: 'bad token in address: ' , tokens last text].
			self addToAddress].
	(tokens isEmpty or: [tokens last type ~= $@])
		ifTrue: ["no domain specified"
			self finishAddress]
		ifFalse: 
			["that was the domain.  check that no QuotedString's slipped in"
			curAddrTokens do: [:tok | tok type = #QuotedString ifTrue: [self error: 'quote marks are not allowed within a domain name (' , tok text , ')']].
			"add the @ sign"
			self addToAddress.
			"add the local part"
			(#(Atom QuotedString ) includes: tokens last type)
				ifFalse: [self error: 'invalid local part for address: ' , tokens last text].
			self addToAddress.
			"add word-dot pairs if there are any"
			[tokens isEmpty not and: [tokens last type = $.]]
				whileTrue: 
					[self addToAddress.
					(tokens isEmpty not and: [#(Atom QuotedString ) includes: tokens last type])
						ifTrue: [self addToAddress]].
			self finishAddress]! !

!MailAddressParser methodsFor: 'building address list' stamp: 'ls 9/13/1998 01:30'!
finishAddress
	"we've finished one address.  Bundle it up and add it to the list of addresses"
	| address |

	address := String streamContents: [ :str |
		curAddrTokens do: [ :tok | str nextPutAll: tok text ] ].

	addresses addFirst: address.

	curAddrTokens := nil.! !

!MailAddressParser methodsFor: 'parsing' stamp: 'ls 9/13/1998 02:08'!
grabAddressWithRoute
	"grad an address of the form 'Descriptive Text <real.address@c.d.e>"
	
	self startNewAddress.

	tokens removeLast.	"remove the >"

	"grab until we see a $<"
	[ 
		tokens isEmpty ifTrue: [
			self error: '<> are not matched' ].
		tokens last type = $<
	] whileFalse: [ self addToAddress ].

	tokens removeLast.  "remove the <"


	self removePhrase.

	self finishAddress! !

!MailAddressParser methodsFor: 'parsing' stamp: 'bf 3/12/2000 20:06'!
grabAddresses
	"grab all the addresses in the string"
	| token |
	"remove comments"
	tokens removeAllSuchThat: [:t | t type == #Comment].
	"grab one address or address group each time through this loop"
	[ 
		"remove commas"
		[
			tokens isEmpty not and: [ tokens last type = $, ]
		] whileTrue: [ tokens removeLast ].

		"check whether any tokens are left"
		tokens isEmpty 
	] whileFalse: [
		token := tokens last.

		"delegate, depending on what form the address is in"
		"the from can be determined from the last token"

		token type = $> ifTrue: [
			self grabAddressWithRoute ]
		ifFalse: [ 
			(#(Atom DomainLiteral QuotedString) includes: token type)  ifTrue: [
				self grabBasicAddress ]
		ifFalse: [
			token type = $; ifTrue: [
				self grabGroupAddress ]
		ifFalse: [
			^self error: 'un-recognized address format' ] ] ]
	].

	^addresses! !

!MailAddressParser methodsFor: 'parsing' stamp: 'ls 9/13/1998 02:08'!
removePhrase
	"skip most characters to the left of this"

	[
		tokens isEmpty not and: [
			#(Atom QuotedString $. $@) includes: (tokens last type) ]
	] whileTrue: [ tokens removeLast ].
! !

!MailAddressParser methodsFor: 'building address list' stamp: 'ls 9/13/1998 01:31'!
addToAddress
	"add the last token to the address.  removes the token from the collection"
	curAddrTokens addFirst: (tokens removeLast)! !

!MailAddressParser methodsFor: 'initialization' stamp: 'ls 9/13/1998 01:25'!
initialize: tokenList
	tokens := tokenList asOrderedCollection copy.
	addresses := OrderedCollection new.! !

!MailAddressParser methodsFor: 'parsing' stamp: 'ls 9/13/1998 02:07'!
grabGroupAddress
	"grab an address of the form 'phrase : address, address, ..., address;'"
	"I'm not 100% sure what this format means, so I'm just returningthe list of addresses between the : and ;   -ls  (if this sounds right to someone, feel free to remove this comment :)"

	"remove the $; "
	tokens removeLast.

	"grab one address each time through this loop"
	[ 
		"remove commas"
		[
			tokens isEmpty not and: [ tokens last type = $, ]
		] whileTrue: [ tokens removeLast ].

		tokens isEmpty ifTrue: [
			"no matching :"
			^self error: 'stray ; in address list'. ].

		tokens last type = $:
	] whileFalse: [
		"delegate to either grabAddressWithRoute, or grabBasicAddress.  nested groups are not allowed"

		tokens last type = $> ifTrue: [
			self grabAddressWithRoute ]
		ifFalse: [ 
			(#(Atom DomainLiteral QuotedString) includes: tokens last type)  ifTrue: [
				self grabBasicAddress ]
		ifFalse: [
			^self error: 'un-recognized address format' ] ]
	].

	tokens removeLast.   "remove the :"

	self removePhrase.! !

!MailAddressParser methodsFor: 'building address list' stamp: 'MarcusDenker 7/22/2014 13:12'!
startNewAddress
	"set up data structures to begin a new address"

	curAddrTokens notNil
		ifTrue: [ self error: 'starting new address before finishing the last one!!' ].
	curAddrTokens := OrderedCollection new! !

!MailAddressParser class methodsFor: 'parsing' stamp: 'ls 9/13/1998 01:34'!
addressesIn: aString
	"return a collection of the bare addresses listed in aString"
	| tokens |
	tokens := MailAddressTokenizer tokensIn: aString.
	^(self new initialize: tokens) grabAddresses! !

!MailAddressParserTest commentStamp: '<historical>'!
This is the unit test for the class MailAddressParser. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see: 
	- http://www.c2.com/cgi/wiki?UnitTest
	- there is a chapter in the PharoByExample book (http://pharobyexample.org)
	- the sunit class category!
!MailAddressParserTest methodsFor: 'tests' stamp: 'sd 6/5/2005 10:31'!
testAddressesIn

	| testString correctAnswer |

	testString := 'joe@lama.com, joe2@lama.com joe3@lama.com joe4 , Not an Address <joe5@address>, joe.(annoying (nested) comment)literal@[1.2.3.4], "an annoying" group : joe1@groupie, joe2@groupie, "Joey" joe3@groupy, "joe6"."joe8"@group.com;,  Lex''s email account <lex>'.

correctAnswer := #('joe@lama.com' 'joe2@lama.com' 'joe3@lama.com' 'joe4' 'joe5@address' 'joe.literal@[1.2.3.4]' 'joe1@groupie' 'joe2@groupie' '"Joey"' 'joe3@groupy' '"joe6"."joe8"@group.com' 'lex') asOrderedCollection.

	self assert: ((MailAddressParser addressesIn: testString) =  correctAnswer).! !

!MailAddressToken commentStamp: '<historical>'!
a single token from an RFC822 mail address.  Used internally in MailAddressParser!
!MailAddressToken methodsFor: 'access' stamp: 'ls 9/12/1998 20:42'!
type
	^type! !

!MailAddressToken methodsFor: 'private' stamp: 'ls 9/12/1998 20:24'!
type: type0  text: text0
	type := type0.
	text := text0.! !

!MailAddressToken methodsFor: 'printing' stamp: 'ls 9/12/1998 20:40'!
printOn: aStream
	aStream nextPut: $[.
	aStream nextPutAll: self type asString.
	aStream nextPut: $|.
	aStream nextPutAll: self text.
	aStream nextPut: $].! !

!MailAddressToken methodsFor: 'access' stamp: 'ls 9/12/1998 20:42'!
text
	^text! !

!MailAddressToken class methodsFor: 'instance creation' stamp: 'ls 9/12/1998 20:31'!
type: type  text: text
	^self new type: type text: text! !

!MailAddressTokenizer commentStamp: '<historical>'!
Divides an address into tokens, as specified in RFC 822.  Used by MailAddressParser.!
!MailAddressTokenizer methodsFor: 'stream protocol' stamp: 'MarcusDenker 7/22/2014 13:12'!
atEnd
	^ self peek isNil! !

!MailAddressTokenizer methodsFor: 'stream protocol' stamp: 'ls 9/12/1998 20:51'!
next
	| ans |
	cachedToken ifNil: [ ^self nextToken ].
	ans := cachedToken.
	cachedToken := nil.
	^ans! !

!MailAddressTokenizer methodsFor: 'initialization' stamp: 'ls 9/12/1998 20:13'!
initialize: aString
	text := aString.
	pos := 1.! !

!MailAddressTokenizer methodsFor: 'tokenizing' stamp: 'ls 9/12/1998 20:15'!
peekChar
	^text at: pos ifAbsent: [ nil ]! !

!MailAddressTokenizer methodsFor: 'tokenizing' stamp: 'ls 9/12/1998 20:44'!
nextSpecial
	| c |
	c := self nextChar.
	^MailAddressToken type: c  text: c asString.! !

!MailAddressTokenizer methodsFor: 'tokenizing' stamp: 'MarcusDenker 10/9/2013 16:32'!
nextComment
	| start nestLevel paren |
	start := pos.
	pos := pos + 1.
	nestLevel := 1.
	[ nestLevel > 0 ]
		whileTrue: [ 
			pos := text indexOfAnyOf: CSParens startingAt: pos ifAbsent: [ 0 ].
			pos = 0
				ifTrue: [ self error: 'unterminated comment.  ie, more (''s than )''s' ].
			paren := self nextChar.
			nestLevel := paren = $(
				ifTrue: [ nestLevel + 1 ]
				ifFalse: [ nestLevel - 1 ] ].
	^ MailAddressToken type: #Comment text: (text copyFrom: start to: pos - 1)! !

!MailAddressTokenizer methodsFor: 'tokenizing' stamp: 'bf 3/12/2000 19:53'!
nextToken
	| c |
	self skipSeparators.
	c := self peekChar.
	c ifNil: [ ^nil ].
	c = $( ifTrue: [ ^self nextComment ].
	c = $" ifTrue: [ ^self nextQuotedString ].
	c = $[ ifTrue: [ ^self nextDomainLiteral ].
	(CSSpecials includes: c) ifTrue: [ ^self nextSpecial ].
	^self nextAtom! !

!MailAddressTokenizer methodsFor: 'tokenizing' stamp: 'ls 9/12/1998 20:14'!
skipSeparators
	pos := text indexOfAnyOf: CSNonSeparators  startingAt: pos  ifAbsent: [ text size + 1 ].! !

!MailAddressTokenizer methodsFor: 'tokenizing' stamp: 'ls 9/12/1998 20:52'!
nextChar
	self atEndOfChars ifTrue: [ ^nil ].
	pos := pos + 1.
	^text at: (pos-1)! !

!MailAddressTokenizer methodsFor: 'tokenizing' stamp: 'ls 9/13/1998 01:39'!
nextDomainLiteral
	| start end |
	start := pos.
	end := text indexOf: $] startingAt: start ifAbsent: [ 0 ].
	end = 0 ifTrue: [
		"not specified"
		self error: 'saw [ without a matching ]' ].

	pos := end+1.

	^MailAddressToken
		type: #DomainLiteral
		text: (text copyFrom: start to: end)! !

!MailAddressTokenizer methodsFor: 'tokenizing' stamp: 'PeterHugossonMiller 9/3/2009 10:02'!
nextQuotedString
	| res c |
	res := String new writeStream.
	res nextPut: self nextChar.   "record the starting quote"
	[ self atEndOfChars ] whileFalse: [
		c := self nextChar.
		c = $\ ifTrue: [
			res nextPut: c.
			res nextPut: self nextChar ]
		ifFalse: [
			c = $" ifTrue: [
				res nextPut: c.
				^MailAddressToken type: #QuotedString  text: res contents ]
			ifFalse: [
				res nextPut: c ] ] ].

	"hmm, never saw the final quote mark"
	^MailAddressToken type: #QuotedString  text: (res contents, '"')! !

!MailAddressTokenizer methodsFor: 'tokenizing' stamp: 'ls 9/12/1998 20:51'!
atEndOfChars
	^pos > text size! !

!MailAddressTokenizer methodsFor: 'tokenizing' stamp: 'ls 9/12/1998 20:44'!
nextAtom
	| start end |
	start := pos.
	pos := text indexOfAnyOf: CSNonAtom startingAt: start ifAbsent: [ text size + 1].
	end := pos - 1.
	^MailAddressToken
		type: #Atom
		text: (text copyFrom: start to: end)! !

!MailAddressTokenizer methodsFor: 'stream protocol' stamp: 'ls 9/12/1998 20:53'!
peek
	cachedToken ifNil: [ cachedToken := self nextToken. ].
	
	^cachedToken	! !

!MailAddressTokenizer class methodsFor: 'initialization' stamp: 'stephane.ducasse 7/3/2009 21:34'!
initialize
	"Initalize class variables using   MailAddressTokenizer initialize"

	| atomChars |

	CSParens := CharacterSet empty.
	CSParens addAll: '()'.

	CSSpecials := CharacterSet empty.
	CSSpecials addAll: '()<>@,;:\".[]'.

	CSNonSeparators := CharacterSet separators complement.


	"(from RFC 2822)"
	atomChars := CharacterSet empty.
	atomChars addAll: ($A to: $Z).
	atomChars addAll: ($a to: $z).
	atomChars addAll: ($0 to: $9).
	atomChars addAll: '!!#$%^''*+-/=?^_`{|}~'.

	CSNonAtom :=  atomChars complement.! !

!MailAddressTokenizer class methodsFor: 'instance creation' stamp: 'MarcusDenker 10/9/2013 16:35'!
forString: aString
	^self basicNew initialize: aString! !

!MailAddressTokenizer class methodsFor: 'instance creation' stamp: 'ls 9/13/1998 01:34'!
tokensIn: aString
	"return a collection of the tokens in aString"
	^(self forString: aString) upToEnd! !

!MailComposition commentStamp: '<historical>'!
a message being composed.  When finished, it will be submitted via a Celeste.!
!MailComposition methodsFor: 'private' stamp: 'nice 1/5/2010 15:59'!
breakLines: aString  atWidth: width
	"break lines in the given string into shorter lines"
	| result atAttachment |

	result := (String new: (aString size * 50 // 49)) writeStream.

	atAttachment := false.
	aString asString linesDo: [ :line | | start end | 
		(line beginsWith: '====') ifTrue: [ atAttachment := true ].
		atAttachment ifTrue: [
			"at or after an attachment line; no more wrapping for the rest of the message"
			result nextPutAll: line.  result cr ]
		ifFalse: [
			(line beginsWith: '>') ifTrue: [
				"it's quoted text; don't wrap it"
				result nextPutAll: line. result cr. ]
			ifFalse: [
				"regular old line.  Wrap it to multiple lines"
				start := 1.
					"output one shorter line each time through this loop"
				[ start + width <= line size ] whileTrue: [
	
					"find the end of the line"
					end := start + width - 1.
					[end >= start and: [ (line at: (end+1)) isSeparator not ]] whileTrue: [
						end := end - 1 ].
					end < start ifTrue: [
						"a word spans the entire width!!"
						end := start + width - 1 ].

					"copy the line to the output"
					result nextPutAll: (line copyFrom: start to: end).
					result cr.

					"get ready for next iteration"
					start := end+1.
					(line at: start) isSeparator ifTrue: [ start := start + 1 ].
				].

				"write out the final part of the line"
				result nextPutAll: (line copyFrom: start to: line size).
				result cr.
			].
		].
	].

	^result contents! !

!MailComposition methodsFor: 'access' stamp: 'MarcusDenker 12/16/2013 14:44'!
smtpServer
	^self class smtpServer! !

!MailComposition methodsFor: 'interface' stamp: 'dvf 5/11/2002 01:23'!
sendMailMessage: aMailMessage
	self messageText: aMailMessage text! !

!MailComposition methodsFor: 'interface' stamp: 'MarcusDenker 7/22/2014 13:10'!
addAttachment
	|   fileSelected|
	textEditor
		ifNotNil: [self hasUnacceptedEdits ifTrue: [textEditor accept]].
	
	fileSelected := UIManager default chooseFileMatching: nil.
	fileSelected
		ifNil: [^ self].
		
	fileSelected writeStreamDo: [ :stream|
		stream binary.
		self messageText:
				((MailMessage from: self messageText asString)
					addAttachmentFrom: stream
					withName: fileSelected basename; 
					text;
					yourself)] ! !

!MailComposition methodsFor: 'access' stamp: 'yo 7/26/2004 22:47'!
messageText: aText
	"change the current text"
	messageText := aText.
	self changed: #messageText.
	^true! !

!MailComposition methodsFor: 'interface' stamp: 'alain.plantec 5/30/2008 13:43'!
open
	"open an interface"
	self openInMorphic ! !

!MailComposition methodsFor: 'access' stamp: 'alain.plantec 6/19/2008 09:45'!
submit
	| message |
	"submit the message"
	textEditor
		ifNotNil: [self hasUnacceptedEdits ifTrue: [textEditor accept]].
	message := MailMessage from: messageText asString.
	self breakLinesInMessage: message.
	SMTPClient deliverMailFrom: message from to: (Array with: message to) text: message text usingServer: self smtpServer.

	morphicWindow ifNotNil: [morphicWindow delete].
! !

!MailComposition methodsFor: 'access' stamp: 'yo 7/26/2004 22:06'!
messageText
	"return the current text"
	^messageText.
! !

!MailComposition methodsFor: 'interface' stamp: 'alain.plantec 6/10/2008 22:30'!
openInMorphic
	"open an interface for sending a mail message with the given initial 
	text"
	| textMorph buttonsList sendButton attachmentButton |
	morphicWindow := SystemWindow labelled: 'Mister Postman'.
	morphicWindow model: self.
	textEditor := textMorph := PluggableTextMorph
						on: self
						text: #messageText
						accept: #messageText:
						readSelection: nil
						menu: #menuGet:shifted:.
	morphicWindow
		addMorph: textMorph
		frame: (0 @ 0.1 corner: 1 @ 1).
	buttonsList := AlignmentMorph newRow.
	sendButton := PluggableButtonMorph
				on: self
				getState: nil
				action: #submit.
	sendButton hResizing: #spaceFill;
		 vResizing: #spaceFill;
		 label: 'send message';
		 setBalloonText: 'Accept any unaccepted edits and add this to the queue of messages to be sent';
		 onColor: Color white offColor: Color white.
	buttonsList addMorphBack: sendButton.
	attachmentButton := PluggableButtonMorph
				on: self
				getState: nil
				action: #addAttachment.
	attachmentButton hResizing: #spaceFill;
		 vResizing: #spaceFill;
		 label: 'add attachment';
		 setBalloonText: 'Send a file with the message';
		 onColor: Color white offColor: Color white.
	buttonsList addMorphBack: attachmentButton.
	morphicWindow
		addMorph: buttonsList
		frame: (0 @ 0 extent: 1 @ 0.1).
	morphicWindow openInWorld! !

!MailComposition methodsFor: 'private' stamp: 'MarcusDenker 7/22/2014 13:11'!
breakLinesInMessage: message
	"reformat long lines in the specified message into shorter ones"

	"multipart message; process the top-level parts.  HACK: the parts are modified in place"

	message body mainType = 'text'
		ifTrue: [ 
			| newBodyText "it's a single-part text message.  reformat the text" |
			newBodyText := self breakLines: message bodyText atWidth: 72.
			message body: (MIMEDocument contentType: message body contentType content: newBodyText).
			^ self ].
	message body isMultipart
		ifFalse: [ ^ self ].
	message parts
		do: [ :part | 
			part body mainType = 'text'
				ifTrue: [ 
					| newBodyText |
					newBodyText := self breakLines: part bodyText atWidth: 72.
					part body: (MIMEDocument contentType: part body contentType content: newBodyText) ] ].
	message regenerateBodyFromParts! !

!MailComposition methodsFor: 'interface' stamp: 'StephaneDucasse 10/27/2014 08:43'!
menuGet: aMenu shifted: shifted
	
	aMenu addList: {
		{'Find...(f)' .	#find}.
		{'Find again (g)' . #findAgain}.
		{'Set search string (h)' . #setSearchString}.
		#-.
		{'Accept (s)' . #accept}.
		{'Send message' .  #submit}}.
	^aMenu.! !

!MailComposition class methodsFor: 'instance creation' stamp: 'dvf 5/11/2002 01:25'!
sendMailMessage: aMailMessage
	| newComposition |
	newComposition := self new.
	newComposition messageText: aMailMessage text; open! !

!MailComposition class methodsFor: 'smtp server' stamp: 'MarcusDenker 12/16/2013 14:43'!
setSmtpServer: aString
	SmtpServer := aString! !

!MailComposition class methodsFor: 'smtp server' stamp: 'MarcusDenker 12/16/2013 14:43'!
smtpServer
	"Answer the server for sending email"

	self isSmtpServerSet
		ifFalse: [self setSmtpServer].
	SmtpServer isEmpty ifTrue: [
		self error: 'no SMTP server specified' ].

	^SmtpServer! !

!MailComposition class methodsFor: 'smtp server' stamp: 'MarcusDenker 12/16/2013 14:43'!
isSmtpServerSet
	^ SmtpServer notNil and: [SmtpServer notEmpty]
! !

!MailComposition class methodsFor: 'smtp server' stamp: 'MarcusDenker 12/16/2013 14:43'!
setSmtpServer
	"Set the SMTP server used to send outgoing messages via"
	SmtpServer ifNil: [SmtpServer := ''].
	SmtpServer := UIManager default
		request: 'What is your mail server for outgoing mail?'
		initialAnswer: SmtpServer.
! !

!MailMessage commentStamp: '<historical>'!
I represent an Internet mail or news message.

	text - the raw text of my message
	body - the body of my message, as a MIMEDocument
	fields - a dictionary mapping lowercased field names into collections of MIMEHeaderValue's
	parts - if I am a multipart message, then this is a cache of my parts!
!MailMessage methodsFor: 'multipart' stamp: 'ls 3/18/2001 16:26'!
decoderClass
	| encoding |
	encoding := self fieldNamed: 'content-transfer-encoding' ifAbsent: [^ nil].
	encoding := encoding mainValue.
	encoding asLowercase = 'base64' ifTrue: [^ Base64MimeConverter].
	encoding asLowercase = 'quoted-printable' ifTrue: [^ QuotedPrintableMimeConverter].
	^ nil! !

!MailMessage methodsFor: 'parsing' stamp: 'MarcusDenker 7/22/2014 13:12'!
fieldsFrom: aStream do: aBlock 
	"Invoke the given block with each of the header fields from the given stream. The block arguments are the field name and value. The streams position is left right after the empty line separating header and body."
	| savedLine line s |
	savedLine := self readStringLineFrom: aStream.
	[ aStream atEnd ] whileFalse: 
		[ line := savedLine.
		line isEmpty ifTrue: [ ^ self ].	"quit when we hit a blank line"
		
		[ savedLine := self readStringLineFrom: aStream.
		savedLine notEmpty and: [ savedLine first isSeparator ] ] whileTrue: 
			[ "lines starting with white space are continuation lines"
			s := savedLine readStream.
			s skipSeparators.
			line := line , ' ' , s upToEnd ].
		self 
			reportField: line trimBoth
			to: aBlock ].

	"process final header line of a body-less message"
	savedLine isEmpty ifFalse: 
		[ self 
			reportField: savedLine trimBoth
			to: aBlock ]! !

!MailMessage methodsFor: 'printing/formatting' stamp: 'bkv 6/23/2003 14:17'!
regenerateBodyFromParts
	"regenerate the message body from the multiple parts"
	| bodyText |

	bodyText := String streamContents: [ :str |
		str cr.
		parts do: [ :part |
			str
				cr;
				nextPutAll: '--';
				nextPutAll: self attachmentSeparator;
				cr;
				nextPutAll: part text ].
	
		str
			cr;
			nextPutAll: '--';
			nextPutAll: self attachmentSeparator;
			nextPutAll: '--';
			cr ].

	body := MIMEDocument contentType: 'multipart/mixed' content: bodyText.
	text := nil.  "text needs to be reformatted"! !

!MailMessage methodsFor: 'printing/formatting' stamp: 'MarcusDenker 7/23/2014 12:02'!
viewBody
	"open a viewer on the body of this message"
	self containsViewableImage
		ifTrue: [^ self viewImageInBody].
	UIManager default  
		longMessage: self bodyTextFormatted
		title: (self name ifNil: ['(a message part)'])
! !

!MailMessage methodsFor: 'multipart' stamp: 'mdr 5/7/2001 11:22'!
atomicParts
	"Answer all of the leaf parts of this message, including those of multipart included messages"

	self body isMultipart ifFalse: [^ OrderedCollection with: self].
	^ self parts inject: OrderedCollection new into: [:col :part | col , part atomicParts]! !

!MailMessage methodsFor: 'accessing' stamp: 'ls 3/18/2001 16:24'!
subject

		^(self fieldNamed: 'subject' ifAbsent: [ ^'' ])  mainValue! !

!MailMessage methodsFor: 'parsing' stamp: 'CamilloBruni 8/22/2013 19:46'!
readDateFrom: aStream
	"Parse a date from the given stream and answer nil if the date can't be parsed. The date may be in any of the following forms:
		<day> <monthName> <year>		(5 April 1982; 5-APR-82)
		<monthName> <day> <year>		(April 5, 1982)
		<monthNumber> <day> <year>		(4/5/82)
	In addition, the date may be preceded by the day of the week and an optional comma, such as:
		Tue, November 14, 1989"

	| day month year |
	self skipWeekdayName: aStream.
	aStream peek isDigit ifTrue: [day := Integer readFrom: aStream].
	[aStream peek isAlphaNumeric] whileFalse: [aStream skip: 1].
	aStream peek isLetter
		ifTrue:		"month name or weekday name"
			[month := (String new: 10) writeStream.
			 [aStream peek isLetter] whileTrue: [month nextPut: aStream next].
			 month := month contents.
			 day ifNil:		"name/number..."
				[[aStream peek isAlphaNumeric] whileFalse: [aStream skip: 1].
				 (aStream peek isDigit) ifFalse: [^nil].
				 day := Integer readFrom: aStream]]
		ifFalse:		"number/number..."
			[month := Date nameOfMonth: day.
			 day := Integer readFrom: aStream].
	[aStream peek isAlphaNumeric] whileFalse: [aStream skip: 1].
	(aStream peek isDigit) ifFalse: [^nil].
	year := Integer readFrom: aStream.
	^Date year: year month: month day: day! !

!MailMessage methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 10:06'!
initialize
	"initialize as an empty message"

	super initialize.
	text := String cr.
	fields := Dictionary new.
	body := MIMEDocument contentType: 'text/plain' content: String cr! !

!MailMessage methodsFor: 'multipart' stamp: 'TonyFleig 11/28/2010 12:55'!
addMixedPart: bodyString contentType: aContentTypeString

	| newPart |
	newPart := MailMessage empty.
	newPart setField: 'content-type' toString: aContentTypeString.
	newPart body: (MIMEDocument contentType: aContentTypeString  content: bodyString).
	self addMixedPart: newPart.
! !

!MailMessage methodsFor: 'multipart' stamp: 'TonyFleig 11/28/2010 12:54'!
addAlternativePart: newPart
	self makeMultipart: 'alternative' with: newPart.
! !

!MailMessage methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 6/28/2010 12:22'!
time
	| dateField |
	dateField := (self fieldNamed: 'date' ifAbsent: [ ^0 ]) mainValue.
	^ [self timeFrom: dateField] ifError: [Date today asSeconds].
! !

!MailMessage methodsFor: 'printing/formatting' stamp: 'nice 1/5/2010 15:59'!
asSendableText
	"break lines in the given string into shorter lines"
	| result atAttachment width aString pastHeader |
	width := 72.
	aString := self text.
	result := (String new: aString size * 50 // 49) writeStream.
	pastHeader := false.
	atAttachment := false.
	aString asString
		linesDo: 
			[:line | | end start | 
			line isEmpty ifTrue: [pastHeader := true].
			pastHeader
				ifTrue: 
					["(line beginsWith: '--==')
						ifTrue: [atAttachment := true]."
					atAttachment
						ifTrue: 
							["at or after an attachment line; no more 
							wrapping for the rest of the message"
							result nextPutAll: line.
							result cr]
						ifFalse: [(line beginsWith: '>')
								ifTrue: 
									["it's quoted text; don't wrap it"
									result nextPutAll: line.
									result cr]
								ifFalse: 
									["regular old line.  Wrap it to multiple 
									lines "
									start := 1.
									"output one shorter line each time 
									through this loop"
									[start + width <= line size]
										whileTrue: 
											["find the end of the line"
											end := start + width - 1.
											[end >= start and: [(line at: end + 1) isSeparator not]]
												whileTrue: [end := end - 1].
											end < start ifTrue: ["a word spans the entire 
												width!! "
												end := start + width - 1].
											"copy the line to the output"
											result nextPutAll: (line copyFrom: start to: end).
											result cr.
											"get ready for next iteration"
											start := end + 1.
											(line at: start) isSeparator ifTrue: [start := start + 1]].
									"write out the final part of the line"
									result nextPutAll: (line copyFrom: start to: line size).
									result cr]]]
				ifFalse: 
					[result nextPutAll: line.
					result cr]].
	^ result contents! !

!MailMessage methodsFor: 'sending' stamp: 'SeanDeNigris 12/2/2011 12:02'!
sendOn: serverString 

	SMTPClient deliver: self usingServer: serverString.! !

!MailMessage methodsFor: 'multipart' stamp: 'TonyFleig 11/28/2010 12:54'!
addAlternativePart: bodyString contentType: aContentTypeString

	| newPart |
	newPart := MailMessage empty.
	newPart setField: 'content-type' toString: aContentTypeString.
	newPart body: (MIMEDocument contentType: aContentTypeString  content: bodyString).
	self addAlternativePart: newPart.
! !

!MailMessage methodsFor: 'accessing' stamp: 'ls 3/18/2001 16:27'!
fields
	"return the internal fields structure.  This is private and subject to change!!"
	^ fields! !

!MailMessage methodsFor: 'parsing' stamp: 'damiencassou 5/30/2008 15:52'!
headerFieldsNamed: fieldName do: aBlock 
	"Evalue aBlock once for each header field which matches fieldName.  The block is valued with one parameter, the value of the field"
	self 
		fieldsFrom: text readStream
		do: [ :fName :fValue | (fieldName sameAs: fName) ifTrue: [ aBlock value: fValue ] ]! !

!MailMessage methodsFor: 'accessing' stamp: 'mdr 3/21/2001 15:28'!
from

	^(self fieldNamed: 'from' ifAbsent: [ ^'' ]) mainValue! !

!MailMessage methodsFor: 'parsing' stamp: 'CamilloBruni 8/22/2013 19:50'!
timeFrom: aString 
	"Parse the date and time (rfc822) and answer the result as the number of seconds 
	since the start of 1980."
	| s t rawDelta delta plusOrMinus |
	s := aString readStream.

	"date part"
	t := ((self readDateFrom: s) ifNil: [ Date today ]) asSeconds.
	[ s atEnd or: [ s peek isAlphaNumeric ] ] whileFalse: [ s next ].

	"time part"
	s atEnd ifFalse: 
		[ "read time part (interpreted as local, regardless of sender's timezone)"
		s peek isDigit ifTrue: [ t := t + (Time readFrom: s) asSeconds ] ].
	s skipSeparators.

	"Check for a numeric time zone offset"
	('+-' includes: s peek) ifTrue: 
		[ plusOrMinus := s next.
		rawDelta := s peek isDigit 
			ifTrue: [ Integer readFrom: s ]
			ifFalse: [ 0 ].
		delta := (rawDelta // 100 * 60 + (rawDelta \\ 100)) * 60.
		t := plusOrMinus = $+ 
			ifTrue: [ t - delta ]
			ifFalse: [ t + delta ] ].

	"We ignore text time zone offsets like EST, GMT, etc..."
	^ t - (Date year: 1980 day: 1) asSeconds

	"MailMessage new timeFrom: 'Thu, 22 Jun 2000 14:17:47 -500'"
	"MailMessage new timeFrom: 'Thu, 22 Jun 2000 14:17:47 --500'"
	"MailMessage new timeFrom: 'on, 04 apr 2001 14:57:32'"! !

!MailMessage methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 1/8/2012 15:24'!
from: aString 
	"Parse aString to initialize myself."
	| parseStream contentType bodyText contentTransferEncoding |
	text := aString trimRight, String cr.
	parseStream := text readStream.
	contentType := 'text/plain'.
	contentTransferEncoding := nil.
	fields := Dictionary new.

	"Extract information out of the header fields"
	self 
		fieldsFrom: parseStream
		do: 
			[ :fName :fValue | 
			"NB: fName is all lowercase"
			fName = 'content-type' ifTrue: [ contentType := (fValue copyUpTo: $;) asLowercase ].
			fName = 'content-transfer-encoding' ifTrue: [ contentTransferEncoding := fValue asLowercase ].
			(fields 
				at: fName
				ifAbsentPut: [ OrderedCollection new: 1 ]) add: (MIMEHeaderValue 
					forField: fName
					fromString: fValue) ].

	"Extract the body of the message"
	bodyText := parseStream upToEnd.
	contentTransferEncoding = 'base64' ifTrue: 
		[ bodyText := Base64MimeConverter mimeDecodeToChars: bodyText readStream.
		bodyText := bodyText contents ].
	contentTransferEncoding = 'quoted-printable' ifTrue: [ bodyText := bodyText decodeQuotedPrintable ].
	body := MIMEDocument 
		contentType: contentType
		content: bodyText! !

!MailMessage methodsFor: 'initialization' stamp: 'mdr 4/11/2001 11:59'!
setField: fieldName toString: fieldValue
	^self setField: fieldName to: (MIMEHeaderValue forField: fieldName fromString: fieldValue)! !

!MailMessage methodsFor: 'multipart' stamp: 'TonyFleig 11/28/2010 12:55'!
makeMultipart: subType with: newPart
	"if I am not multipart already, then become a multipart message with one part"

	| multipartHeader |

	body isMultipart
		ifFalse: [
			parts := Array with: newPart.

			"fix up our header"
			multipartHeader := MIMEHeaderValue fromMIMEHeader: 'multipart/',subType.
			multipartHeader parameterAt: 'boundary' put: self class generateSeparator .
			self setField: 'content-type' to: multipartHeader.

			self setField: 'mime-version' to: (MIMEHeaderValue fromMIMEHeader: '1.0').
			self removeFieldNamed: 'content-transfer-encoding']
		ifTrue: [
			self parts.
			parts := parts copyWith: newPart.
			].

	"regenerate everything"
	self regenerateBodyFromParts.
	text := nil.! !

!MailMessage methodsFor: 'multipart' stamp: 'SvenVanCaekenberghe 1/8/2012 15:24'!
parseParts
	"private -- parse the parts of the message and store them into a collection"
	"If this is not multipart, store an empty collection"
	| parseStream msgStream messages separator |
	self body isMultipart ifFalse: 
		[ parts := #().
		^ self ].

	"If we can't find a valid separator, handle it as if the message is not multipart"
	separator := self attachmentSeparator.
	separator ifNil: 
		[ Transcript
			show: 'Ignoring bad attachment separater';
			cr.
		parts := #().
		^ self ].
	separator := '--' , separator trimRight.
	parseStream := self bodyText readStream.
	msgStream := LimitingLineStreamWrapper 
		on: parseStream
		delimiter: separator.
	msgStream limitingBlock: 
		[ :aLine | 
		aLine trimRight = separator or: 
			[ "Match the separator"
			aLine trimRight = (separator , '--') ] ].	"or the final separator with --"

	"Throw away everything up to and including the first separator"
	msgStream upToEnd.
	msgStream skipThisLine.

	"Extract each of the multi-parts as strings"
	messages := OrderedCollection new.
	[ parseStream atEnd ] whileFalse: 
		[ messages add: msgStream upToEnd.
		msgStream skipThisLine ].
	parts := messages collect: [ :e | MailMessage from: e ]! !

!MailMessage methodsFor: 'printing/formatting' stamp: 'mdr 5/7/2001 11:07'!
excerpt
	"Return a short excerpt of the text of the message"

	^ self bodyText withSeparatorsCompacted truncateWithElipsisTo: 60! !

!MailMessage methodsFor: 'printing/formatting' stamp: ''!
format
	"Replace the text of this message with a formatted version."
	"NOTE: This operation discards extra header fields."

	text := self formattedText.! !

!MailMessage methodsFor: 'multipart' stamp: 'mdr 3/22/2001 09:06'!
attachmentSeparator
	^(self fieldNamed: 'content-type' ifAbsent: [^nil]) parameters
		at: 'boundary' ifAbsent: [^nil]! !

!MailMessage methodsFor: 'fields' stamp: 'ls 3/18/2001 16:36'!
fieldsNamed: aString  separatedBy: separationString
	"return all fields with the specified name, concatenated together with separationString between each element.  Return an empty string if no fields with the specified name are present"
	| matchingFields |
	matchingFields := self fieldsNamed: aString ifAbsent: [ ^'' ].
	^String streamContents: [ :str |
		matchingFields
			do: [ :field | str nextPutAll: field mainValue ]
			separatedBy: [ str nextPutAll: separationString ]].
! !

!MailMessage methodsFor: 'fields' stamp: 'ls 3/18/2001 16:28'!
hasFieldNamed: aString
	^fields includesKey: aString asLowercase! !

!MailMessage methodsFor: 'accessing' stamp: 'ls 3/18/2001 16:26'!
name
	"return a default name for this part, if any was specified.  If not, return nil"
	| type nameField disposition |

	"try in the content-type: header"
	type := self fieldNamed: 'content-type' ifAbsent: [nil].
	(type notNil and: [(nameField := type parameters at: 'name' ifAbsent: [nil]) notNil])
		ifTrue: [^ nameField].

	"try in content-disposition:"
	disposition := self fieldNamed: 'content-disposition' ifAbsent: [nil].
	(disposition notNil and: [(nameField := disposition parameters at: 'filename' ifAbsent: [nil]) notNil])
		ifTrue: [^ nameField].

	"give up"
	^ nil! !

!MailMessage methodsFor: 'initialization' stamp: 'ls 2/10/2001 12:48'!
body: newBody
	"change the body"
	body := newBody.
	text := nil.! !

!MailMessage methodsFor: 'multipart' stamp: 'TonyFleig 11/28/2010 12:55'!
addMixedPart: newPart
	self makeMultipart: 'mixed' with: newPart.
! !

!MailMessage methodsFor: 'printing/formatting' stamp: 'ls 4/30/2000 18:52'!
formattedText
	"Answer a version of my text suitable for display.  This cleans up the header, decodes HTML, and things like that"

	
	^ self cleanedHeader asText, String cr , self bodyTextFormatted! !

!MailMessage methodsFor: 'accessing' stamp: 'ls 2/10/2001 12:49'!
text
	"the full, unprocessed text of the message"
	text ifNil: [ self regenerateText ].
	^text! !

!MailMessage methodsFor: 'printing/formatting' stamp: 'nk 6/12/2004 09:36'!
viewImageInBody
	| stream image |
	stream := self body contentStream.
	image := Form fromBinaryStream: stream.
	(World drawingClass withForm: image) openInWorld! !

!MailMessage methodsFor: 'multipart' stamp: 'mdr 4/11/2001 12:06'!
makeMultipart
	"if I am not multipart already, then become a multipart message with one part"

	| part multipartHeader |

	body isMultipart ifTrue: [ ^self ].

	"set up the new message part"
	part := MailMessage empty.
	part body: body.
	(self hasFieldNamed: 'content-type') ifTrue: [
		part setField: 'content-type' to: (self fieldNamed: 'content-type' ifAbsent: ['']) ].
	parts := Array with: part.

	"fix up our header"
	multipartHeader := MIMEHeaderValue fromMIMEHeader: 'multipart/mixed'.
	multipartHeader parameterAt: 'boundary' put: self class generateSeparator .
	self setField: 'content-type' to: multipartHeader.

	self setField: 'mime-version' to: (MIMEHeaderValue fromMIMEHeader: '1.0').
	self removeFieldNamed: 'content-transfer-encoding'.

	"regenerate everything"
	self regenerateBodyFromParts.
	text := nil.! !

!MailMessage methodsFor: 'parsing' stamp: 'HenrikSperreJohansen 6/12/2010 02:38'!
readStringLineFrom: aStream 
	"Read and answer the next line from the given stream. Consume the carriage return but do not append it to the string."

	^aStream nextLine! !

!MailMessage methodsFor: 'fields' stamp: 'ls 3/18/2001 16:32'!
fieldNamed: aString ifAbsent: aBlock
	| matchingFields |
	"return the value of the field with the specified name.  If there is more than one field, then return the first one"
	matchingFields := fields at: aString asLowercase ifAbsent: [ ^aBlock value ].
	^matchingFields first! !

!MailMessage methodsFor: 'printing' stamp: 'ls 11/11/2001 13:27'!
printOn: aStream 
	"For text parts with no filename show: 'text/plain: first line of text...'    
	for attachments/filenamed parts show: 'attachment: filename.ext'"

	| name |

	aStream nextPutAll: ((name := self name) ifNil: ['Text: ' , self excerpt]
			ifNotNil: ['File: ' , name])! !

!MailMessage methodsFor: 'multipart' stamp: 'mdr 4/11/2001 12:04'!
addAttachmentFrom: aStream withName: aName
	"add an attachment, encoding with base64.  aName is the option filename to encode"
	| newPart |
	self makeMultipart.
	self parts.  "make sure parts have been parsed"

	"create the attachment as a MailMessage"
	newPart := MailMessage empty.
	newPart setField: 'content-type' toString: 'application/octet-stream'.
	newPart setField: 'content-transfer-encoding' toString: 'base64'.
	aName ifNotNil: [
		| dispositionField |
		dispositionField := MIMEHeaderValue fromMIMEHeader: 'attachment'.
		dispositionField parameterAt: 'filename' put: aName.
		newPart setField: 'content-disposition' to: dispositionField ].
	newPart body: (MIMEDocument contentType: 'application/octet-stream' content: aStream upToEnd).


	"regenerate our text"
	parts := parts copyWith: newPart.
	self regenerateBodyFromParts.
	text := nil.! !

!MailMessage methodsFor: 'testing' stamp: 'kfr 11/5/2004 17:32'!
containsViewableImage
	^self body isJpeg | self body isGif | self body isPng! !

!MailMessage methodsFor: 'fields' stamp: 'ls 3/18/2001 16:21'!
fieldsNamed: aString ifAbsent: aBlock
	"return a list of all fields with the given name"
	^fields at: aString asLowercase ifAbsent: aBlock! !

!MailMessage methodsFor: 'printing/formatting' stamp: 'lr 3/14/2010 21:13'!
bodyTextFormatted
	"Answer a version of the text in my body suitable for display.  This will parse multipart forms, decode HTML, and other such things"

	"check for multipart"

	self body isMultipart
		ifTrue: [ 
			"check for alternative forms"
			self body isMultipartAlternative
				ifTrue: [ 
					"it's multipart/alternative.  search for a part that we can display, biasing towards nicer formats"
					#('text/html' 'text/plain')
						do: [ :format | 
							self parts
								do: [ :part | 
									part body contentType = format
										ifTrue: [ ^ part bodyTextFormatted ] ] ].	"couldn't find a desirable part to display; just display the first part"
					^ self parts first bodyTextFormatted ].	"not alternative parts.  put something for each part"
			^ Text
				streamContents: [ :str | 
					self parts
						do: [ :part | 
							((#('text' 'multipart') includes: part body mainType) or: [ part body contentType = 'message/rfc822' ])
								ifTrue: [ 
									"try to inline the message part"
									str nextPutAll: part bodyTextFormatted ]
								ifFalse: [ 
									| descript |
									str cr.
									descript := part name ifNil: [ 'attachment' ].
									str nextPutAll: (Text string: '[' , descript , ']' attribute: (TextMessageLink message: part)) ] ] ] ].	"check for HTML"
	self body contentType = 'text/html'
		ifTrue: [ 
			Smalltalk globals
				at: #HtmlParser
				ifPresent: [ :htmlParser | ^ (htmlParser parse: body content readStream) formattedText ] ].	"check for an embedded message"
	self body contentType = 'message/rfc822'
		ifTrue: [ ^ (MailMessage from: self body content) formattedText ].	"nothing special--just return the text"
	^ body content! !

!MailMessage methodsFor: 'accessing' stamp: 'ls 3/18/2001 16:34'!
cc

	^self fieldsNamed: 'cc' separatedBy: ', '! !

!MailMessage methodsFor: 'accessing' stamp: 'ls 3/18/2001 16:35'!
to
	^self fieldsNamed: 'to' separatedBy: ', '! !

!MailMessage methodsFor: 'initialization' stamp: 'ls 3/18/2001 16:20'!
setField: fieldName to: aFieldValue
	"set a field.  If any field of the specified name exists, it will be overwritten"
	fields at: fieldName asLowercase put: (OrderedCollection with: aFieldValue).
	text := nil.! !

!MailMessage methodsFor: 'printing/formatting' stamp: 'MarcusDenker 7/22/2014 13:12'!
cleanedHeader
	"Reply with a cleaned up version email header.  First show fields people would normally want to see (in a regular order for easy browsing), and then any other fields not explictly excluded"

	| new priorityFields omittedFields |
	new := (String new: text size) writeStream.
	priorityFields := #('Date' 'From' 'Subject' 'To' 'Cc').
	omittedFields := MailMessage omittedHeaderFields.	"Show the priority fields first, in the order given in priorityFields"
	priorityFields
		do: [ :pField | 
			"We don't check whether the priority field is in the omitted list!!"
			self
				headerFieldsNamed: pField
				do: [ :fValue | 
					new
						nextPutAll: pField;
						nextPutAll: ': ';
						nextPutAll: fValue decodeMimeHeader;
						cr ] ].	"Show the rest of the fields, omitting the uninteresting ones and ones we have already shown"
	omittedFields := omittedFields , priorityFields.
	self
		fieldsFrom: text readStream
		do: [ :fName :fValue | 
			((fName beginsWith: 'x-') or: [ omittedFields anySatisfy: [ :omitted | fName sameAs: omitted ] ])
				ifFalse: [ 
					new
						nextPutAll: fName;
						nextPutAll: ': ';
						nextPutAll: fValue;
						cr ] ].
	^ new contents! !

!MailMessage methodsFor: 'parsing' stamp: 'MarcusDenker 7/22/2014 13:11'!
skipWeekdayName: aStream
	"If the given stream starts with a weekday name or its abbreviation, advance the stream to the first alphaNumeric character following the weekday name."

	| position name abbrev |
	aStream skipSeparators.
	aStream peek isDigit
		ifTrue: [ ^ self ].
	aStream peek isLetter
		ifFalse: [ ^ self ].
	position := aStream position.
	name := (String new: 10) writeStream.
	[ aStream peek isLetter ] whileTrue: [ name nextPut: aStream next ].
	abbrev := name contents copyFrom: 1 to: (3 min: name position).
	abbrev := abbrev asLowercase.
	(#('sun' 'mon' 'tue' 'wed' 'thu' 'fri' 'sat') includes: abbrev asLowercase)
		ifTrue: [ 
			"found a weekday; skip to the next alphanumeric character"
			[ aStream peek isAlphaNumeric ] whileFalse: [ aStream skip: 1 ] ]
		ifFalse: [ 
			"didn't find a weekday so restore stream position"
			aStream position: position ]! !

!MailMessage methodsFor: 'printing/formatting' stamp: 'nice 1/5/2010 15:59'!
regenerateText
	"regenerate the full text from the body and headers"
	
	text := String streamContents: 
		[ :str | | encodedBodyText | 
		"first put the header"
		fields keysAndValuesDo: 
			[ :fieldName :fieldValues | 
			fieldValues do: 
				[ :fieldValue | 
				str
					nextPutAll: fieldName capitalized;
					nextPutAll: ': ';
					nextPutAll: fieldValue asHeaderValue;
					cr ] ].

		"skip a line between header and body"
		str cr.

		"put the body, being sure to encode it according to the header"
		encodedBodyText := body content.
		self decoderClass ifNotNil: 
			[ encodedBodyText := (self decoderClass mimeEncode: encodedBodyText readStream) upToEnd ].
		str nextPutAll: encodedBodyText ]! !

!MailMessage methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/8/2012 15:17'!
recipientList

	^ (self to findTokens: $,) collect: [ :e | e trimLeft ]! !

!MailMessage methodsFor: 'accessing' stamp: 'ls 1/3/1999 15:48'!
body
	"return just the body of the message"
	^body! !

!MailMessage methodsFor: 'multipart' stamp: 'ls 4/30/2000 18:22'!
parts
	parts ifNil: [self parseParts].
	^ parts! !

!MailMessage methodsFor: 'fields' stamp: 'ls 3/18/2001 16:30'!
removeFieldNamed: name
	"remove all fields with the specified name"
	fields removeKey: name ifAbsent: []! !

!MailMessage methodsFor: 'accessing' stamp: 'CamilloBruni 8/22/2013 19:50'!
date
	"Answer a date string for this message."

	^(Date fromSeconds: self time + (Date year: 1980 day: 1 ) asSeconds) 
		printFormat: #(2 1 3 47 1 2)! !

!MailMessage methodsFor: 'accessing' stamp: 'ls 1/3/1999 15:52'!
bodyText
	"return the text of the body of the message"
	^body content! !

!MailMessage methodsFor: 'parsing' stamp: 'SvenVanCaekenberghe 1/8/2012 14:45'!
reportField: aString to: aBlock 
	"Evaluate the given block with the field name a value in the given field. Do nothing if the field is malformed."
	| s fieldName fieldValue |
	(aString includes: $:) ifFalse: [ ^ self ].
	s := aString readStream.
	fieldName := (s upTo: $:) asLowercase.	"fieldname must be lowercase"
	fieldValue := s upToEnd trimBoth.
	fieldValue isEmpty ifFalse: 
		[ aBlock 
			value: fieldName
			value: fieldValue ]! !

!MailMessage class methodsFor: 'utilities' stamp: 'SeanDeNigris 12/3/2011 13:36'!
dateStampNow
	"Return the current date and time formatted per RFC5322  e.g.  'Thu, 18 Feb 1999 20:38:51 -0500'"

	^	DateAndTime now asEmailString.! !

!MailMessage class methodsFor: 'instance creation' stamp: 'nk 7/30/2004 18:08'!
empty
	"return a message with no text and no header"

	^self new! !

!MailMessage class methodsFor: 'instance creation' stamp: 'MarcusDenker 7/22/2014 13:10'!
from: senderString to: recipients about: subjectString asFollows: bodyString 

	| recipientsString |
	recipientsString := String streamContents: [ :str |
		recipients do: [ :e | str nextPutAll: e ] separatedBy: [ str nextPutAll: ', ' ] ].
	^ (self from: Character lf asString, bodyString)
			setField: 'from' toString: senderString;
			setField: 'date' toString: self dateStampNow;
			setField: 'subject' toString: subjectString;
			setField: 'to' toString: recipientsString;
			yourself.! !

!MailMessage class methodsFor: 'preferences' stamp: 'MarcusDenker 7/22/2014 13:12'!
omittedHeaderFields
	"Reply a list of fields to omit when displaying a nice simple message"

	"Note that heads of the form
		X-something: value
	are filtered programatically.  This is done since we don't want any of them
	and it is impossible to predict them in advance."

	^ #(
			'comments'
			'priority'
			'disposition-notification-to'
			'content-id'
			'received'
			'return-path'
			'newsgroups'
			'message-id'
			'path'
			'in-reply-to'
			'sender'
			'fonts'
			'mime-version'
			'status'
			'content-type'
			'content-transfer-encoding'
			'errors-to'
			'keywords'
			'references'
			'nntp-posting-host'
			'lines'
			'return-receipt-to'
			'precedence'
			'originator'
			'distribution'
			'content-disposition'
			'importance'
			'resent-to'
			'resent-cc'
			'resent-message-id'
			'resent-date'
			'resent-sender'
			'resent-from'
			'delivered-to'
			'user-agent'
			'content-class'
			'thread-topic'
			'thread-index'
			'list-help'
			'list-post'
			'list-subscribe'
			'list-id'
			'list-unsubscribe'
			'list-archive'
		)
! !

!MailMessage class methodsFor: 'utilities' stamp: 'PavelKrivanek 12/3/2013 15:07'!
dateTimeSuffix
	"Answer a string which indicates the date and time, intended for use in building fileout filenames, etc."

	^self monthDayTime24StringFrom: Time primUTCSecondsClock! !

!MailMessage class methodsFor: 'utilities' stamp: 'ls 4/30/2000 22:58'!
generateSeparator
	"generate a separator usable for making MIME multipart documents.  A leading -- will *not* be included"
	^'==CelesteAttachment' , (10000 to: 99999) atRandom asString , '=='.! !

!MailMessage class methodsFor: 'utilities' stamp: 'JB 2/12/2010 15:27'!
monthDayTime24StringFrom: aSecondCount
	| aDate aTime |
	"From the date/time represented by aSecondCount, produce a string which indicates the date and time in the compact form
             ddMMMhhmm		where dd is a two-digit day-of-month, MMM is the alpha month abbreviation and hhmm is the time on a 24-hr clock.

          Utilities monthDayTime24StringFrom: Time primSecondsClock
"

	aDate := Date fromSeconds: aSecondCount.
	aTime := Time fromSeconds: aSecondCount \\ 86400.

	^ (aDate dayOfMonth asTwoCharacterString), 
		(aDate monthName copyFrom: 1 to: 3), 
		(aTime hhmm24)! !

!MailMessage class methodsFor: 'instance creation' stamp: 'SeanDeNigris 12/2/2011 11:22'!
from: aString
	"Initialize a new instance from the given string."

	^ self new from: aString! !

!MailMessageTest commentStamp: 'TorstenBergmann 2/5/2014 10:12'!
SUnit tests for MailMessage!
!MailMessageTest methodsFor: 'tests' stamp: 'SeanDeNigris 12/6/2011 14:36'!
testCreateFromString

	| text message |
	text := 
'Date: Tue, 20 Feb 2001 13:52:53 +0300
From: mdr@scn.rg (Me Ru)
Subject: RE: Windows 2000 on your laptop
To: "Greg Y" <to1@mail.com>
cc: cc1@scn.org, cc1also@test.org
To: to2@no.scn.org, to2also@op.org
cc: cc2@scn.org

Hmmm... Good.  I will try to swap my German copy for something in
English, and then do the deed.  Oh, and expand my RAM to 128 first.

Mike
'.

	message := MailMessage from: text.

	self assert: message text = text.
	self assert: message subject = 'RE: Windows 2000 on your laptop'.
	self assert: message from = 'mdr@scn.rg (Me Ru)'.
	self assert: message date = '2/20/01'.
	self assert: message time = 667133573.
	self assert: message to = '"Greg Y" <to1@mail.com>, to2@no.scn.org, to2also@op.org'.
	self assert: message cc = 'cc1@scn.org, cc1also@test.org, cc2@scn.org'.! !

!MailMessageTest methodsFor: 'tests' stamp: 'TonyFleig 11/28/2010 13:48'!
testMultiPartMixed
	| m txt html  part1 part2 |
	
	txt := 'This is plain text.'.
	html :=  '<html><head></head><body>This is html.</body></html>'.
	
	m := MailMessage empty.
	m addMixedPart: txt contentType: 'text/plain'. 
	m addMixedPart: html contentType: 'text/html'.

	self assert: (((m fields at: 'content-type') at: 1) mainValue asLowercase = 'multipart/mixed'). 
	self assert: (m parts size = 2).

	part1 := m parts at: 1.
	part2 := m parts at: 2.

	self assert: (((part1 fields at: 'content-type') at: 1) mainValue asLowercase = 'text/plain').
	self assert: ((part1 body content) = txt).
	
	self assert: (((part2 fields at: 'content-type') at: 1) mainValue asLowercase = 'text/html').
	self assert: ((part2 body content) = html).
! !

!MailMessageTest methodsFor: 'tests' stamp: 'SeanDeNigris 12/2/2011 13:31'!
testRecipientList

	| message |
	message := MailMessage from: 'To: pharo-project@lists.gforge.inria.fr, pharo-users@lists.gforge.inria.fr'.
	
	self assert: (message recipientList size = 2).
	self assert: (message recipientList first = 'pharo-project@lists.gforge.inria.fr').	
	self assert: (message recipientList second = 'pharo-users@lists.gforge.inria.fr').! !

!MailMessageTest methodsFor: 'tests' stamp: 'TonyFleig 11/28/2010 13:12'!
testMultiPartAlternative
	| m txt html  part1 part2 |
	
	txt := 'This is plain text.'.
	html :=  '<html><head></head><body>This is html.</body></html>'.
	
	m := MailMessage empty.
	m addAlternativePart: txt contentType: 'text/plain'. 
	m addAlternativePart: html contentType: 'text/html'.

	self assert: (((m fields at: 'content-type') at: 1) mainValue asLowercase = 'multipart/alternative'). 
	self assert: (m parts size = 2).

	part1 := m parts at: 1.
	part2 := m parts at: 2.

	self assert: (((part1 fields at: 'content-type') at: 1) mainValue asLowercase = 'text/plain').
	self assert: ((part1 body content) = txt).
	
	self assert: (((part2 fields at: 'content-type') at: 1) mainValue asLowercase = 'text/html').
	self assert: ((part2 body content) = html).
! !

!MailMessageTest methodsFor: 'tests' stamp: 'SeanDeNigris 12/6/2011 16:26'!
testSimpleCreate

	| message |
	message := MailMessage
		from: 'community@world.st'
		to: { 'pharo-project@lists.gforge.inria.fr'. 'pharo-users@lists.gforge.inria.fr' }
		about: 'Great Progress'
		asFollows: 'Pharo is getting so cool!!'.
	
	self assert: (message text matchesRegex: 'Date\: [[:alpha:]]+, \d+ [[:alpha:]]+ \d+ \d\d\:\d\d\:\d\d [-+]\d\d\d\d
From\: community@world.st
Subject\: Great Progress
To\: pharo-project@lists.gforge.inria.fr, pharo-users@lists.gforge.inria.fr

Pharo is getting so cool!!
').! !

!ManifestASTCore commentStamp: '<historical>'!
I stores metadata on true and false positive critics. These meta data are used by the SmalllintManifestChecker and the critics Browser!
!ManifestASTCore class methodsFor: 'meta data' stamp: 'StephaneDucasse 3/29/2013 18:06'!
ruleRefersToClassRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#'RBLiteralNode class' #literalToken: #true)) #'2013-03-29T18:06:27.069+01:00') )! !

!ManifestASTCore class methodsFor: 'meta data' stamp: 'StephaneDucasse 3/29/2013 18:06'!
ruleSendsDifferentSuperRuleV1TODO
^ #(#(#(#RGMethodDefinition #(#RBMessageNode #replaceSourceWithMessageNode: #false)) #'2013-03-29T18:06:27.369+01:00') )! !

!ManifestASTCore class methodsFor: 'meta data' stamp: 'StephaneDucasse 3/29/2013 18:06'!
ruleLongMethodsRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#RBParser #parseBlockArgsInto: #false)) #'2013-03-29T18:06:27.028000001+01:00') #(#(#RGMethodDefinition #(#RBParser #patchLiteralArrayToken #false)) #'2013-03-29T18:06:27.030000002+01:00') #(#(#RGMethodDefinition #(#RBConfigurableFormatter #needsParenthesisFor: #false)) #'2013-03-29T18:06:27.030000009+01:00') #(#(#RGMethodDefinition #(#RBParser #parsePrimitiveObject #false)) #'2013-03-29T18:06:27.028000002+01:00') #(#(#RGMethodDefinition #(#RBFormatter #needsParenthesisFor: #false)) #'2013-03-29T18:06:27.028+01:00') #(#(#RGMethodDefinition #(#RBFormatter #formatMessage:cascade: #false)) #'2013-03-29T18:06:27.03+01:00') #(#(#RGMethodDefinition #(#'RBConfigurableFormatter class' #initialize #true)) #'2013-03-29T18:06:27.030000001+01:00') #(#(#RGMethodDefinition #(#RBParseTreeRewriter #visitCascadeNode: #false)) #'2013-03-29T18:06:27.030000004+01:00') #(#(#RGMethodDefinition #(#RBParser #parseStatementList:into: #false)) #'2013-03-29T18:06:27.030000005+01:00') #(#(#RGMethodDefinition #(#'RBConfigurableFormatter class' #settingsOn: #true)) #'2013-03-29T18:06:27.030000006+01:00') #(#(#RGMethodDefinition #(#RBProgramNode #matchList:index:against:index:inContext: #false)) #'2013-03-29T18:06:27.030000008+01:00') #(#(#RGMethodDefinition #(#RBMessageNode #replaceSourceWithMessageNode: #false)) #'2013-03-29T18:06:27.030000003+01:00') #(#(#RGMethodDefinition #(#RBParser #parseCascadeMessage #false)) #'2013-03-29T18:06:27.030000007+01:00') )! !

!ManifestASTCore class methodsFor: 'meta data' stamp: 'StephaneDucasse 3/29/2013 18:06'!
rejectRules
^ #('LawOfDemeterRule')! !

!ManifestASTCore class methodsFor: 'meta data' stamp: 'StephaneDucasse 3/29/2013 18:06'!
rejectClasses
^ #()! !

!ManifestASTCore class methodsFor: 'meta data' stamp: 'StephaneDucasse 3/29/2013 18:06'!
ruleEquivalentSuperclassMethodsRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#RBProgramNode #isBlock #false)) #'2013-03-29T18:06:26.929+01:00') )! !

!ManifestFuel commentStamp: 'TorstenBergmann 2/3/2014 23:17'!
Manifest for Fuel package!
!ManifestFuel class methodsFor: 'meta data' stamp: 'MartinDias 2/25/2013 14:50'!
ruleIfTrueBlocksRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#FLLightGeneralMapper #visitSubstitution:by:onRecursionDo: #false)) #'2013-02-25T14:50:01.650000001+01:00') )! !

!ManifestFuel class methodsFor: 'meta data' stamp: 'MartinDias 2/25/2013 14:13'!
rejectRules
^ #()! !

!ManifestFuel class methodsFor: 'meta data' stamp: 'MartinDias 2/25/2013 14:13'!
rejectClasses
^ #()! !

!ManifestFuel class methodsFor: 'meta data' stamp: 'MartinDias 2/25/2013 14:50'!
ruleConsistencyCheckRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#Float #serializeOn: #false)) #'2013-02-25T14:50:01.564000001+01:00') )! !

!ManifestKernel commentStamp: '<historical>'!
I stores metadata on true and false positive critics. These meta data are used by the SmalllintManifestChecker and the critics Browser!
!ManifestKernel methodsFor: 'code-critics' stamp: 'BenComan 2/10/2015 00:34'!
ruleConsistencyCheckRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#DelayScheduler #restoreResumptionTimes #false)) #'2015-02-10T00:34:25.546586+08:00') #(#(#RGMethodDefinition #(#DelayScheduler #schedule: #false)) #'2015-02-10T00:34:25.546586+08:00') #(#(#RGMethodDefinition #(#DelayScheduler #saveResumptionTimes #false)) #'2015-02-10T00:34:25.546586+08:00') )! !

!ManifestKernel class methodsFor: 'meta data' stamp: 'BenComan 10/26/2014 23:52'!
ruleLongMethodsRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#DelayScheduler #handleTimerEvent: #false)) #'2014-10-26T23:52:40.351947+08:00') )! !

!ManifestKernel class methodsFor: 'meta data' stamp: 'BenComan 10/26/2014 23:45'!
rejectRules
^ #()! !

!ManifestKernel class methodsFor: 'meta data' stamp: 'BenComan 10/26/2014 23:45'!
rejectClasses
^ #()! !

!ManifestKernel class methodsFor: 'meta data' stamp: 'BenComan 10/26/2014 23:52'!
ruleEqualsTrueRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#DelayScheduler #startUp #false)) #'2014-10-26T23:52:40.367323+08:00') )! !

!ManifestKernel class methodsFor: 'meta data' stamp: 'BenComan 10/26/2014 23:52'!
ruleConsistencyCheckRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#DelayScheduler #restoreResumptionTimes #false)) #'2014-10-26T23:52:40.336226+08:00') #(#(#RGMethodDefinition #(#DelayScheduler #saveResumptionTimes #false)) #'2014-10-26T23:52:40.336226+08:00') )! !

!ManifestKernelTests commentStamp: '<historical>'!
I stores metadata on true and false positive critics. These meta data are used by the SmalllintManifestChecker and the critics Browser!
!ManifestKernelTests class methodsFor: 'meta data' stamp: 'BenComan 10/26/2014 23:45'!
rejectRules
^ #()! !

!ManifestKernelTests class methodsFor: 'meta data' stamp: 'BenComan 10/26/2014 23:45'!
rejectClasses
^ #()! !

!ManifestKeyChainTest commentStamp: '<historical>'!
I stores metadata on true and false positive critics. These meta data are used by the SmalllintManifestChecker and the critics Browser!
!ManifestKeyChainTest class methodsFor: 'meta data' stamp: 'jeromegarcia 10/16/2014 17:50'!
rejectRules
^ #()! !

!ManifestKeyChainTest class methodsFor: 'meta data' stamp: 'jeromegarcia 10/16/2014 17:50'!
rejectClasses
^ #()! !

!ManifestKeyChainTest class methodsFor: 'meta data' stamp: 'jeromegarcia 10/16/2014 17:50'!
ruleLongMethodsRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#PharoUserPermissionsTest #testIsRoot #false)) #'2014-10-16T17:50:39.294526+02:00') )! !

!ManifestManifestCore commentStamp: '<historical>'!
I stores metadata on true and false positive critics. These meta data are used by the SmalllintManifestChecker and the critics Browser!
!ManifestManifestCore class methodsFor: 'meta data' stamp: 'StephaneDucasse 1/6/2014 20:51'!
ruleContainsRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#TheManifestBuilder #commentOfFalsePositive:onRule:version: #false)) #'2013-02-01T15:29:52.876+01:00') #(#(#RGMethodDefinition #(#TheManifestBuilder #commentOfToDo:onRule:version: #false)) #'2013-02-01T15:29:52.876000001+01:00') #(#(#RGMethodDefinition #(#SmalllintManifestChecker #criticsOf: #false)) #'2013-02-08T16:35:58.019+01:00') )! !

!ManifestManifestCore class methodsFor: 'meta data' stamp: 'StephaneDucasse 1/6/2014 20:51'!
ruleBadMessageRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#TheManifestBuilder #hasTruePositiveOf:version: #false)) #'2013-02-01T15:29:51.978000008+01:00') #(#(#RGMethodDefinition #(#TheManifestBuilder #hasFalsePositiveOf:version: #false)) #'2013-02-01T15:29:51.978000006+01:00') #(#(#RGMethodDefinition #(#TheManifestBuilder #rejectRules #false)) #'2013-02-01T15:29:51.978000007+01:00') #(#(#RGMethodDefinition #(#TheManifestBuilder #hasToDoOf:version: #false)) #'2013-02-01T15:29:51.978000005+01:00') )! !

!ManifestManifestCore class methodsFor: 'meta data' stamp: 'StephaneDucasse 1/6/2014 20:51'!
ruleCodeCruftLeftInMethodsRuleV1TODO
^ #(#(#(#RGMethodDefinition #(#TheManifestBuilder #hash #false)) #'2013-02-06T15:08:33.234+01:00') )! !

!ManifestManifestCore class methodsFor: 'meta data' stamp: 'StephaneDucasse 1/6/2014 20:51'!
ruleImplementedNotSentRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#TheManifestBuilder #addTruePositive:of:version: #false)) #'2013-02-01T15:29:52.678000007+01:00') #(#(#RGMethodDefinition #(#SmalllintManifestChecker #isTruePositive:forRuleId:versionId: #false)) #'2013-02-01T15:29:52.678000011+01:00') #(#(#RGMethodDefinition #(#TheManifestBuilder #removeManifestOf: #false)) #'2013-02-01T15:29:52.678000012+01:00') #(#(#RGMethodDefinition #(#TheManifestBuilder #dateOfToDo:onRule:version: #false)) #'2013-02-01T15:29:52.678000013+01:00') #(#(#RGMethodDefinition #(#TheManifestBuilder #dateOfTruePositive:onRule:version: #false)) #'2013-02-01T15:29:52.67800001+01:00') #(#(#RGMethodDefinition #(#TheManifestBuilder #removeAllManifest #false)) #'2013-02-01T15:29:52.678000006+01:00') #(#(#RGMethodDefinition #(#'RBLintRule class' #uniqueIdentifierNumber #true)) #'2013-02-01T15:29:52.678000008+01:00') #(#(#RGMethodDefinition #(#TheManifestBuilder #installTruePositiveOf:version: #false)) #'2013-02-01T15:29:52.678000009+01:00') )! !

!ManifestManifestCore class methodsFor: 'meta data' stamp: 'SimonAllier 3/22/2013 15:13'!
rejectRules
^ #('LawOfDemeterRule' 'MethodHasNoTimeStampRule')! !

!ManifestManifestCore class methodsFor: 'meta data' stamp: 'SimonAllier 2/1/2013 15:29'!
rejectClasses
^ #()! !

!ManifestManifestCore class methodsFor: 'meta data' stamp: 'SimonAllier 2/1/2013 15:29'!
ruleEquivalentSuperclassMethodsRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#'RBEqualNotUsedRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.458000004+01:00') #(#(#RGMethodDefinition #(#'RBEndTrueFalseRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.458000018+01:00') #(#(#RGMethodDefinition #(#'RBBlockLintRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.463000009+01:00') #(#(#RGMethodDefinition #(#'RBDetectContainsRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000036+01:00') #(#(#RGMethodDefinition #(#'RBMethodModifierSuperRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.458000029+01:00') #(#(#RGMethodDefinition #(#'RBExcessiveArgumentsRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000001+01:00') #(#(#RGMethodDefinition #(#'RBVariableNotDefinedRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000007+01:00') #(#(#RGMethodDefinition #(#'RBVariableAssignedLiteralRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000009+01:00') #(#(#RGMethodDefinition #(#'RBDetectIfNoneRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.458000028+01:00') #(#(#RGMethodDefinition #(#'RBPlatformDependentUserInteractionRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000006+01:00') #(#(#RGMethodDefinition #(#'RBMissingSuperSendsRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000048+01:00') #(#(#RGMethodDefinition #(#'RBOnlyReadOrWrittenVariableRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.463000005+01:00') #(#(#RGMethodDefinition #(#'RBMinMaxRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.465000002+01:00') #(#(#RGMethodDefinition #(#'RBAbstractClassRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000051+01:00') #(#(#RGMethodDefinition #(#'RBUnoptimizedAndOrRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000019+01:00') #(#(#RGMethodDefinition #(#'RBMethodModifierFinalRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000053+01:00') #(#(#RGMethodDefinition #(#'RBUsesAddRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000011+01:00') #(#(#RGMethodDefinition #(#'RBUnclassifiedMethodsRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.458000024+01:00') #(#(#RGMethodDefinition #(#'RBEquivalentSuperclassMethodsRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.465000001+01:00') #(#(#RGMethodDefinition #(#'RBBooleanPrecedenceRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.458000005+01:00') #(#(#RGMethodDefinition #(#'RBReturnsBooleanAndOtherRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000017+01:00') #(#(#RGMethodDefinition #(#'RBLongMethodsRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000035+01:00') #(#(#RGMethodDefinition #(#'RBCascadedNextPutAllsRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.463000007+01:00') #(#(#RGMethodDefinition #(#'RBReturnsIfTrueRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.463000002+01:00') #(#(#RGMethodDefinition #(#'RBInstVarInSubclassesRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.46000004+01:00') #(#(#RGMethodDefinition #(#'RBSearchingLiteralRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000062+01:00') #(#(#RGMethodDefinition #(#'RBContainsRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.458000016+01:00') #(#(#RGMethodDefinition #(#'RBAssignmentInIfTrueRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000012+01:00') #(#(#RGMethodDefinition #(#'RBTransformationRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000057+01:00') #(#(#RGMethodDefinition #(#'RBJustSendsSuperRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.458000015+01:00') #(#(#RGMethodDefinition #(#'RBSentNotImplementedRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000045+01:00') #(#(#RGMethodDefinition #(#'RBAssignmentWithoutEffectRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000025+01:00') #(#(#RGMethodDefinition #(#'RBExcessiveVariablesRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000016+01:00') #(#(#RGMethodDefinition #(#'RBGuardingClauseRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000043+01:00') #(#(#RGMethodDefinition #(#'RBVariableReferencedOnceRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000024+01:00') #(#(#RGMethodDefinition #(#'RBMethodSourceContainsLinefeedsRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.46000005+01:00') #(#(#RGMethodDefinition #(#'RBExtraBlockRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.463000012+01:00') #(#(#RGMethodDefinition #(#'RBGuardClauseRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.458000009+01:00') #(#(#RGMethodDefinition #(#'RBExcessiveMethodsRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000026+01:00') #(#(#RGMethodDefinition #(#'RBUnpackagedCodeRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000054+01:00') #(#(#RGMethodDefinition #(#'RBUnwindBlocksRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.458000003+01:00') #(#(#RGMethodDefinition #(#'RBUndeclaredReferenceRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000041+01:00') #(#(#RGMethodDefinition #(#'RBMissingSubclassResponsibilityRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000055+01:00') #(#(#RGMethodDefinition #(#'RBSubclassResponsibilityNotDefinedRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000014+01:00') #(#(#RGMethodDefinition #(#'RBParseTreeLintRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000022+01:00') #(#(#RGMethodDefinition #(#'RBEqualsTrueRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000059+01:00') #(#(#RGMethodDefinition #(#'RBLiteralArrayCharactersRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000063+01:00') #(#(#RGMethodDefinition #(#'RBTempVarOverridesInstVarRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.46000003+01:00') #(#(#RGMethodDefinition #(#'RBPrecedenceRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000064+01:00') #(#(#RGMethodDefinition #(#'RBSizeCheckRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.465+01:00') #(#(#RGMethodDefinition #(#'RBNotEliminationRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.458000025+01:00') #(#(#RGMethodDefinition #(#'RBUnconditionalRecursionRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.463000017+01:00') #(#(#RGMethodDefinition #(#'RBTemporaryVariableCapitalizationRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.45800002+01:00') #(#(#RGMethodDefinition #(#'RBAtIfAbsentRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000049+01:00') #(#(#RGMethodDefinition #(#'RBSendsDifferentSuperRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000065+01:00') #(#(#RGMethodDefinition #(#'RBEmptyExceptionHandlerRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.463+01:00') #(#(#RGMethodDefinition #(#'RBCollectSelectNotUsedRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.45800003+01:00') #(#(#RGMethodDefinition #(#'RBToDoWithIncrementRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.46000006+01:00') #(#(#RGMethodDefinition #(#'RBIfTrueBlocksRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000061+01:00') #(#(#RGMethodDefinition #(#'RBAddRemoveDependentsRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.458000031+01:00') #(#(#RGMethodDefinition #(#'RBTempsReadBeforeWrittenRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000027+01:00') #(#(#RGMethodDefinition #(#'RBExcessiveInheritanceRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.463000006+01:00') #(#(#RGMethodDefinition #(#'RBModifiesCollectionRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.458000023+01:00') #(#(#RGMethodDefinition #(#'RBBadMessageRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.463000001+01:00') #(#(#RGMethodDefinition #(#'RBNoClassCommentRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.458000013+01:00') #(#(#RGMethodDefinition #(#'RBUnnecessaryAssignmentRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000015+01:00') #(#(#RGMethodDefinition #(#'RBCollectionProtocolRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000028+01:00') #(#(#RGMethodDefinition #(#'RBStringConcatenationRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.458000008+01:00') #(#(#RGMethodDefinition #(#'RBThreeElementPointRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.458000026+01:00') #(#(#RGMethodDefinition #(#'RBTranslateLiteralsInMenusRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000013+01:00') #(#(#RGMethodDefinition #(#'RBOverridesSpecialMessageRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000031+01:00') #(#(#RGMethodDefinition #(#'RBToDoRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000037+01:00') #(#(#RGMethodDefinition #(#'RBSuperSendsNewRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000039+01:00') #(#(#RGMethodDefinition #(#'RBClassNotReferencedRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.463000008+01:00') #(#(#RGMethodDefinition #(#'RBOnlyReadOrWrittenTemporaryRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000058+01:00') #(#(#RGMethodDefinition #(#'RBYourselfNotUsedRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.463000015+01:00') #(#(#RGMethodDefinition #(#'RBUnreferencedVariablesRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000046+01:00') #(#(#RGMethodDefinition #(#'RBAssignmentInBlockRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.46+01:00') #(#(#RGMethodDefinition #(#'RBReturnInEnsureRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.463000018+01:00') #(#(#RGMethodDefinition #(#'RBAllAnyNoneSatisfyRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000021+01:00') #(#(#RGMethodDefinition #(#'RBIfTrueReturnsRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000044+01:00') #(#(#RGMethodDefinition #(#'RBUsesTrueRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.458000012+01:00') #(#(#RGMethodDefinition #(#'RBMethodHasNoTimeStampRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000004+01:00') #(#(#RGMethodDefinition #(#'RBImplementedNotSentRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.458000006+01:00') #(#(#RGMethodDefinition #(#'RBRefersToClassRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.46000001+01:00') #(#(#RGMethodDefinition #(#'RBCompositeLintRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000003+01:00') #(#(#RGMethodDefinition #(#'RBInstanceVariableCapitalizationRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000032+01:00') #(#(#RGMethodDefinition #(#'RBClassNameInSelectorRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.458000011+01:00') #(#(#RGMethodDefinition #(#'RBMissingTranslationsInMenusRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.463000003+01:00') #(#(#RGMethodDefinition #(#'RBBasicLintRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.463000004+01:00') #(#(#RGMethodDefinition #(#'RBFileBlocksRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.46000002+01:00') #(#(#RGMethodDefinition #(#'RBClassVariableCapitalizationRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000008+01:00') #(#(#RGMethodDefinition #(#'RBBetweenAndRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000002+01:00') #(#(#RGMethodDefinition #(#'RBSendsDeprecatedMethodToGlobalRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000038+01:00') #(#(#RGMethodDefinition #(#'RBCollectionMessagesToExternalObjectRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.46300001+01:00') #(#(#RGMethodDefinition #(#'RBCollectionCopyEmptyRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.458000014+01:00') #(#(#RGMethodDefinition #(#'RBUnoptimizedToDoRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.458000027+01:00') #(#(#RGMethodDefinition #(#'RBInconsistentMethodClassificationRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.458000021+01:00') #(#(#RGMethodDefinition #(#'RBLiteralArrayContainsSuspiciousTrueFalseOrNilRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.458000019+01:00') #(#(#RGMethodDefinition #(#'RBFloatEqualityComparisonRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000023+01:00') #(#(#RGMethodDefinition #(#'RBLiteralArrayContainsCommaRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.458000022+01:00') #(#(#RGMethodDefinition #(#'RBUnderscoreAssignmentRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000018+01:00') #(#(#RGMethodDefinition #(#'RBMissingYourselfRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000029+01:00') #(#(#RGMethodDefinition #(#'RBWhileTrueRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.45800001+01:00') #(#(#RGMethodDefinition #(#'RBLawOfDemeterRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000005+01:00') #(#(#RGMethodDefinition #(#'RBToDoCollectRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000034+01:00') #(#(#RGMethodDefinition #(#'RBAsOrderedCollectionNotNeededRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.458000017+01:00') #(#(#RGMethodDefinition #(#'RBMethodModifierOverrideRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000047+01:00') #(#(#RGMethodDefinition #(#'RBUtilityMethodsRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000052+01:00') #(#(#RGMethodDefinition #(#'RBSuperSendsRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000056+01:00') #(#(#RGMethodDefinition #(#'RBEqualNilRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000042+01:00') #(#(#RGMethodDefinition #(#'RBConsistencyCheckRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.463000011+01:00') #(#(#RGMethodDefinition #(#'RBDefinesEqualNotHashRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.463000013+01:00') #(#(#RGMethodDefinition #(#'RBCodeCruftLeftInMethodsRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.458000007+01:00') #(#(#RGMethodDefinition #(#'RBUncommonMessageSendRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.460000033+01:00') #(#(#RGMethodDefinition #(#'RBClassInstVarNotInitializedRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.463000014+01:00') #(#(#RGMethodDefinition #(#'RBSendsUnknownMessageToGlobalRule class' #identifierMinorVersionNumber #true)) #'2013-02-01T15:29:56.463000016+01:00') )! !

!ManifestManifestCore class methodsFor: 'meta data' stamp: 'StephaneDucasse 1/6/2014 20:51'!
ruleConsistencyCheckRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#TheManifestBuilder #addItem:wihtComment:selector: #false)) #'2013-02-01T15:29:51.672000001+01:00') #(#(#RGMethodDefinition #(#'RGMetaclassDefinition class' #manifestReadOn: #true)) #'2013-02-01T15:29:51.672000002+01:00') #(#(#RGMethodDefinition #(#'RGMethodDefinition class' #manifestReadOn: #true)) #'2013-02-01T15:29:51.672000003+01:00') )! !

!ManifestManifestCore class methodsFor: 'meta data' stamp: 'SimonAllier 3/22/2013 15:13'!
ruleClassNotReferencedRuleV1FalsePositive
^ #(#(#(#RGClassDefinition #(#RBRemoveAssignmentWithoutEffectRule)) #'2013-03-22T15:13:33.961+01:00') )! !

!ManifestManifestCore class methodsFor: 'meta data' stamp: 'SimonAllier 3/22/2013 11:32'!
ruleSentNotImplementedRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#ClassDescription #criticNameOn: #false)) #'2013-03-22T11:32:46.828+01:00') )! !

!ManifestManifestCriticBrowser commentStamp: '<historical>'!
ManifestManifestCriticBrowser is the manifest for the Manifest-CriticBrowser package itself.!
!ManifestManifestCriticBrowser class methodsFor: 'meta data' stamp: 'CamilloBruni 9/18/2013 22:54'!
ruleBadMessageRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#SingleCodeCriticResultList #perform:orSendTo: #false)) #'2013-02-01T15:29:51.915000005+01:00') )! !

!ManifestManifestCriticBrowser class methodsFor: 'meta data' stamp: 'CamilleTeruel 9/18/2013 10:41'!
ruleMissingYourselfRuleV1FalsePositive
^ #()! !

!ManifestManifestCriticBrowser class methodsFor: 'meta data' stamp: 'CamilleTeruel 9/18/2013 10:41'!
ruleCollectionMessagesToExternalObjectRuleV1FalsePositive
^ #()! !

!ManifestManifestCriticBrowser class methodsFor: 'meta data' stamp: 'SimonAllier 3/22/2013 15:13'!
rejectRules
^ #('LawOfDemeterRule' 'MethodHasNoTimeStampRule')! !

!ManifestManifestCriticBrowser class methodsFor: 'meta data' stamp: 'SimonAllier 2/1/2013 15:29'!
rejectClasses
^ #()! !

!ManifestManifestCriticBrowser class methodsFor: 'meta data' stamp: 'CamilloBruni 9/18/2013 22:54'!
ruleEquivalentSuperclassMethodsRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#SingleCodeCriticResultList #perform:orSendTo: #false)) #'2013-02-01T15:29:56.387000008+01:00') #(#(#RGMethodDefinition #(#'SelectRuleBrowser class' #defaultSpec #true)) #'2013-02-01T15:29:56.387000009+01:00') )! !

!ManifestManifestCriticBrowser class methodsFor: 'meta data' stamp: 'SimonAllier 2/6/2013 15:08'!
ruleGuardClauseRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#CriticBrowser #onWindowClosed #false)) #'2013-02-06T15:08:32.377+01:00') )! !

!ManifestManifestCriticBrowser class methodsFor: 'meta data' stamp: 'CamilloBruni 9/18/2013 22:54'!
ruleReturnsIfTrueRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#SingleCodeCriticResultList #iconFor: #false)) #'2013-02-01T15:29:51.740000004+01:00') )! !

!ManifestManifestCriticBrowser class methodsFor: 'meta data' stamp: 'SimonAllier 2/1/2013 15:29'!
ruleSubclassResponsibilityNotDefinedRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#SelectBrowser #nextAction #false)) #'2013-02-01T15:29:53.049+01:00') )! !

!ManifestManifestCriticBrowser class methodsFor: 'meta data' stamp: 'CamilleTeruel 9/18/2013 10:41'!
ruleSentNotImplementedRuleV1FalsePositive
^ #()! !

!ManifestManifestCriticBrowser class methodsFor: 'meta data' stamp: 'CamilloBruni 9/18/2013 22:54'!
ruleCodeCruftLeftInMethodsRuleV1TODO
^ #(#(#(#RGMethodDefinition #(#SingleCodeCriticResultList #addCriticWithCommentToFalsePositive #false)) #'2013-02-06T15:08:32.572+01:00') #(#(#RGMethodDefinition #(#SingleCodeCriticResultList #addCriticWithCommentToToDo #false)) #'2013-02-06T15:08:32.572000001+01:00') #(#(#RGMethodDefinition #(#SingleCodeCriticResultList #removeRuleToFalsePositive #false)) #'2013-03-21T14:07:34.827+01:00') #(#(#RGMethodDefinition #(#SingleCodeCriticResultList #addRuleToFalsePositive #false)) #'2013-03-21T14:07:34.827000001+01:00') )! !

!ManifestManifestCriticBrowser class methodsFor: 'meta data' stamp: 'SimonAllier 2/1/2013 15:29'!
ruleImplementedNotSentRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#'CommentFalsePositiveWindow class' #openOnCritic:onRule: #true)) #'2013-02-01T15:29:52.617000004+01:00') #(#(#RGMethodDefinition #(#CriticWorkingConfiguration #logInManifest: #false)) #'2013-02-01T15:29:52.617000005+01:00') #(#(#RGMethodDefinition #(#CriticsCache #addCritic:forRule: #false)) #'2013-02-01T15:29:52.617000006+01:00') #(#(#RGMethodDefinition #(#'CommentToDoWindow class' #openOnCritic:onRule: #true)) #'2013-02-01T15:29:52.617000007+01:00') )! !

!ManifestManifestCriticBrowser class methodsFor: 'meta data' stamp: 'SimomAllier 3/25/2013 16:31'!
ruleMissingSubclassResponsibilityRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#SelectPackageBrowser #addItems #false)) #'2013-03-25T16:31:39.782000002+01:00') #(#(#RGMethodDefinition #(#SelectRuleBrowser #addAllItems #false)) #'2013-03-25T16:31:39.782000003+01:00') #(#(#RGMethodDefinition #(#SelectPackageBrowser #removeAllItems #false)) #'2013-03-25T16:31:39.782000005+01:00') #(#(#RGMethodDefinition #(#SelectPackageBrowser #removeItems #false)) #'2013-03-25T16:31:39.782000006+01:00') #(#(#RGMethodDefinition #(#SelectRuleBrowser #removeAllItems #false)) #'2013-03-25T16:31:39.782000004+01:00') #(#(#RGMethodDefinition #(#SelectRuleBrowser #addItems #false)) #'2013-03-25T16:31:39.782+01:00') #(#(#RGMethodDefinition #(#SelectRuleBrowser #removeItems #false)) #'2013-03-25T16:31:39.782000001+01:00') #(#(#RGMethodDefinition #(#SelectPackageBrowser #addAllItems #false)) #'2013-03-25T16:31:39.782000007+01:00') )! !

!ManifestManifestCriticBrowser class methodsFor: 'meta data' stamp: 'CamilloBruni 9/18/2013 22:54'!
ruleOnlyReadOrWrittenVariableRuleV1FalsePositive
^ #(#(#(#RGClassDefinition #(#CriticBrowser)) #'2013-02-01T15:29:52.299+01:00') #(#(#RGClassDefinition #(#SelectBrowser)) #'2013-02-01T15:29:52.299000001+01:00') #(#(#RGClassDefinition #(#SingleCodeCriticResultList)) #'2013-02-01T15:29:52.301+01:00') #(#(#RGClassDefinition #(#ResetWindow)) #'2013-02-01T15:29:52.296000003+01:00') #(#(#RGClassDefinition #(#SelectPackageBrowser)) #'2013-02-01T15:29:52.296000002+01:00') )! !

!ManifestManifestCriticBrowser class methodsFor: 'meta data' stamp: 'CamilleTeruel 9/18/2013 10:41'!
ruleTemporaryVariableCapitalizationRuleV1FalsePositive
^ #()! !

!ManifestManifestCriticBrowser class methodsFor: 'meta data' stamp: 'CamilleTeruel 9/18/2013 10:41'!
ruleOnlyReadOrWrittenTemporaryRuleV1FalsePositive
^ #()! !

!ManifestManifestTests commentStamp: 'TorstenBergmann 2/19/2014 08:33'!
The manifest for Manifest-Tests package!
!ManifestOpalCompilerCore commentStamp: 'MarcusDenker 8/11/2014 10:13'!
This is the Manifest for Opal for recording false positive of the code critique tool!
!ManifestOpalCompilerCore class methodsFor: 'meta data' stamp: 'MarcusDenker 12/18/2012 17:42'!
ruleImplementedNotSentRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#OCASTTranslatorForEffect #emitIfFalse: #false)) #'2012-12-18T17:41:36.969+01:00') #(#(#RGMethodDefinition #(#OCASTTranslatorForEffect #emitIfTrue: #false)) #'2012-12-18T17:41:39.446+01:00') #(#(#RGMethodDefinition #(#OCASTTranslatorForEffect #emitIfNotNil: #false)) #'2012-12-18T17:41:41.777+01:00') #(#(#RGMethodDefinition #(#OCASTTranslator #emitCaseOf: #false)) #'2012-12-18T17:42:01.724+01:00') #(#(#RGMethodDefinition #(#OCASTTranslator #emitToByDo: #false)) #'2012-12-18T17:42:03.557+01:00') #(#(#RGMethodDefinition #(#OCASTTranslator #emitToDo: #false)) #'2012-12-18T17:42:05.34+01:00') #(#(#RGMethodDefinition #(#OCASTTranslator #emitIfNotNil: #false)) #'2012-12-18T17:42:07.349+01:00') #(#(#RGMethodDefinition #(#OCASTTranslator #emitIfNil: #false)) #'2012-12-18T17:42:09.472+01:00') #(#(#RGMethodDefinition #(#OCASTTranslator #emitCaseOfOtherwise: #false)) #'2012-12-18T17:42:11.795+01:00') )! !

!ManifestOpalCompilerCore class methodsFor: 'meta data' stamp: 'MarcusDenker 5/23/2013 08:43'!
ruleBadMessageRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#OCASTTranslator #initialize #false)) #'2013-05-23T08:43:44.793471+02:00') #(#(#RGMethodDefinition #(#OCASTTranslator #emitCaseOf: #false)) #'2013-05-23T08:43:44.793471+02:00') #(#(#RGMethodDefinition #(#OpalCompiler #evaluate #false)) #'2013-05-23T08:43:44.793471+02:00') )! !

!ManifestOpalCompilerCore class methodsFor: 'meta data' stamp: 'MarcusDenker 5/23/2013 08:43'!
rejectRules
^ #('SearchingLiteralRule' 'ExcessiveArgumentsRule' 'LongMethodsRule' 'ClassInstVarNotInitializedRule' 'UsesAddRule' 'ExcessiveMethodsRule' 'MissingYourselfRule' 'ExcessiveVariablesRule' 'TempsReadBeforeWrittenRule' 'AbstractClassRule' 'IfTrueReturnsRule')! !

!ManifestOpalCompilerCore class methodsFor: 'meta data' stamp: 'MarcusDenker 12/18/2012 17:41'!
rejectClasses
^ #()! !

!ManifestOpalCompilerCore class methodsFor: 'meta data' stamp: 'ClementBera 5/27/2014 16:17'!
ruleEqualsTrueRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#IRSqueakV3PlusClosuresBytecodeGenerator #returnConstant: #false)) #'2012-12-18T17:44:03.941+01:00') )! !

!ManifestOpalCompilerCore class methodsFor: 'meta data' stamp: 'MarcusDenker 9/20/2013 15:19'!
ruleMethodHasNoTimeStampRuleV1TruePositive
^ #(#(#(#RGMethodDefinition #(#OCSemanticWarning #correctIn: #false)) #'2012-12-18T17:43:05.023+01:00') #(#(#RGMethodDefinition #(#OCAbstractLocalVariable #isUninitialized #false)) #'2012-12-18T17:43:10.236+01:00') #(#(#RGMethodDefinition #(#IRPrinter #pushRemoteTemp:inVector: #false)) #'2012-12-19T08:07:38.013+01:00') )! !

!ManifestOpalCompilerCore class methodsFor: 'meta data' stamp: 'MarcusDenker 12/19/2012 08:10'!
ruleTempsReadBeforeWrittenRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#IRSequence #absorbJumpToSingleInstr: #false)) #'2012-12-19T08:10:39.177+01:00') )! !

!ManifestOpalCompilerCore class methodsFor: 'meta data' stamp: 'MarcusDenker 12/19/2012 08:13'!
ruleVariableAssignedLiteralRuleV1FalsePositive
^ #(#(#(#RGClassDefinition #(#IRMethod)) #'2012-12-19T08:13:54.508+01:00') )! !

!ManifestOpalCompilerCore class methodsFor: 'meta data' stamp: 'MarcusDenker 12/18/2012 17:43'!
ruleAssignmentInIfTrueRuleV1TruePositive
^ #(#(#(#RGMethodDefinition #(#OpalCompiler #from:class:context:notifying: #false)) #'2012-12-18T17:43:24.703000001+01:00') )! !

!ManifestOpalCompilerCore class methodsFor: 'meta data' stamp: 'MarcusDenker 12/19/2012 08:17'!
ruleToDoCollectRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#IRBytecodeScope #args #false)) #'2012-12-19T08:16:58.474000001+01:00') #(#(#RGMethodDefinition #(#IRBytecodeScope #temps #false)) #'2012-12-19T08:17:19.677+01:00') )! !

!ManifestOpalCompilerTests commentStamp: '<historical>'!
I store metadata for this package. These meta data are used by other tools such as the SmalllintManifestChecker and the critics Browser!
!ManifestOpalCompilerTests methodsFor: 'code-critics' stamp: 'GuillermoPolito 4/9/2015 21:04'!
ruleTempsReadBeforeWrittenRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#OCContextTempMappingTest #testAccessingTempsVectorInBlock2 #false)) #'2015-04-09T21:02:04.945558+02:00') )! !

!ManifestOpalCompilerTests methodsFor: 'code-critics' stamp: 'GuillermoPolito 4/9/2015 21:02'!
ruleExtraBlockRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#OCContextTempMappingTest #testAccessingMultipleVariablesInVector #false)) #'2015-04-09T21:02:04.935487+02:00') #(#(#RGMethodDefinition #(#OCContextTempMappingTest #testAccessingTempsVectorInBlock #false)) #'2015-04-09T21:02:04.935425+02:00') #(#(#RGMethodDefinition #(#OCContextTempMappingTest #testAccessingVariablesInBlock #false)) #'2015-04-09T21:02:04.935457+02:00') )! !

!ManifestOpalCompilerTests methodsFor: 'code-critics' stamp: 'GuillermoPolito 4/9/2015 21:02'!
ruleGuardClauseRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#OCContextTempMappingTest #testAccessingVariablesInOptimizedBlock2 #false)) #'2015-04-09T21:02:04.919962+02:00') )! !

!ManifestOpalCompilerTests methodsFor: 'code-critics' stamp: 'GuillermoPolito 4/9/2015 21:02'!
ruleOnlyReadOrWrittenTemporaryRuleV1FalsePositive
^ #(#(#(#RGMethodDefinition #(#OCContextTempMappingTest #testAccessingVariablesInOptimizedBlock2 #false)) #'2015-04-09T21:02:04.928132+02:00') #(#(#RGMethodDefinition #(#OCContextTempMappingTest #testAccessingTempsVectorInBlock #false)) #'2015-04-09T21:02:04.927985+02:00') #(#(#RGMethodDefinition #(#OCContextTempMappingTest #testAccessingVariablesInOptimizedBlock #false)) #'2015-04-09T21:02:04.927828+02:00') #(#(#RGMethodDefinition #(#OCContextTempMappingTest #testAccessingVariablesInBlock #false)) #'2015-04-09T21:02:04.928107+02:00') )! !

!ManyTestResourceTestCase commentStamp: 'TorstenBergmann 2/12/2014 23:14'!
SUnit tests for handling of many test resources!
!ManyTestResourceTestCase methodsFor: 'running' stamp: 'nfr 1/3/2010 18:07'!
testTearDownOrder
	| myResourceSetUpOrder myResourceReverseTearDownOrder |
	myResourceReverseTearDownOrder := OrderedCollection new: 7.
	myResourceSetUpOrder := (OrderedCollection new: 7)
		add: SimpleTestResource;
		add: SimpleTestResourceA1;
		add: SimpleTestResourceA2;
		add: SimpleTestResourceA;
		add: SimpleTestResourceB1;
		add: SimpleTestResourceB;
		yourself.
	self
		assert: (myResourceSetUpOrder allSatisfy: [:each | each isAvailable])
		description: 'At test start, not all my resources were set up'.
	self class resources
		do: [:each | each resetOrAddResourcesTo: myResourceReverseTearDownOrder].
	self
		assert: myResourceReverseTearDownOrder = myResourceSetUpOrder
		description: 'Wrong order for tearDown'.
	self
		assert: (myResourceSetUpOrder allSatisfy: [:each | each isAvailable])
		description: 'At test start, not all my resources were set up'! !

!ManyTestResourceTestCase methodsFor: 'utility' stamp: 'NiallRoss 7/18/2010 11:52'!
clearOuterResourceStateDuring: aBlock
	"This self-testing test must clear the outer state of its resources before starting and after finishing, so that it can construct test cases and suites of itself and test them."
	
	self
		assert: SimpleTestResourceA1 isAlreadyAvailable
		description: 'The resource was not set up for the test'.
	SimpleTestResourceA reset.
	SimpleTestResourceB reset.
	SimpleTestResourceA1 reset.
	self
		deny: SimpleTestResourceA1 isAlreadyAvailable
		description: 'The resource was still set up before we began the run'.
	^[super clearOuterResourceStateDuring: aBlock]
		ensure:
			[self
				deny: SimpleTestResourceA1 isAlreadyAvailable
				description: 'The resource was still set up after we finished the run'.
			self
				deny: SimpleTestResourceB1 isAlreadyAvailable
				description: 'The resource was still set up after we finished the run'.
			SimpleTestResourceA isAvailable.
			self
				assert: SimpleTestResourceA1 isAlreadyAvailable
				description: 'The resource was not set up again after the test'.
			SimpleTestResourceB isAvailable.
			self
				assert: SimpleTestResourceB1 isAlreadyAvailable
				description: 'The resource was not set up again after the test']! !

!ManyTestResourceTestCase class methodsFor: 'testing' stamp: ' 17/7/10 17:28'!
shouldInheritSelectors
	^true! !

!ManyTestResourceTestCase class methodsFor: 'accessing' stamp: 'nfr 1/3/2010 18:13'!
resources
	^super resources
		, (Array with: SimpleTestResourceA with: SimpleTestResourceB)! !

!Margin commentStamp: '<historical>'!
MorphMargin represents a margin (for now of rectangle-based operations).

It can be expressed as different objects:

- A number. When specified using a number, it sets all the four values to be the same.

- A point. When specified as a point, pairs top/bottom and left/right take their values from a point y and x. 

- Four numbers. They represent all the four directions.

- A rectangle. (do not use this version because it is proposed just for migration and it may force you to crea)


In the future we may add an API (#margin) for singular margin.!
!Margin methodsFor: 'initialization' stamp: 'StephaneDucasse 9/7/2013 09:32'!
fromRectangle: aRectangle
	"Pay attention do not use this method but prefer top:left:bottom:right:"
	
	self setTop: aRectangle top 
			left: aRectangle left 
			bottom: aRectangle bottom 
			right: aRectangle right! !

!Margin methodsFor: 'private' stamp: 'StephaneDucasse 9/7/2013 09:00'!
setTop: topNumber left: leftNumber bottom: bottomNumber right: rightNumber 

	top := topNumber.
	left := leftNumber.
	bottom := bottomNumber. 
	right := rightNumber.! !

!Margin methodsFor: 'accessing' stamp: 'StephaneDucasse 9/7/2013 11:37'!
width 
	^ self right - self left.! !

!Margin methodsFor: 'accessing' stamp: 'StephaneDucasse 9/7/2013 09:02'!
left
	^ left! !

!Margin methodsFor: 'operations' stamp: 'StephaneDucasse 9/7/2013 10:57'!
insetRectangle: aRectangle
	"Answer a rectangle whose size has been reduced by the receiver. The limitation is that since a rectangle topleft is always less than its bottomright you may have a some cases that are not possible to express. For that you should use a margin object instead of a rectangle."
	
	| l r t b|
	l := aRectangle left +  self left.
	r :=aRectangle right -  self right.
	t := aRectangle top + self top.
	b := aRectangle bottom - self bottom.
	^ Rectangle origin:  l @t extent: (r - l @ (b - t )) 
! !

!Margin methodsFor: 'accessing' stamp: 'StephaneDucasse 9/7/2013 09:02'!
top
	^ top! !

!Margin methodsFor: 'operations' stamp: 'StephaneDucasse 9/7/2013 10:57'!
expandRectangle: aRectangle
	"Answer a rectangle whose size has been expanded by the receiver which represents each rectangle corner."
	
	|  l r t b |
	l := aRectangle left - self left.
	r :=aRectangle right + self right.
	t := aRectangle top - self top.
	b := aRectangle bottom + self bottom.
	^ Rectangle origin:  l @t extent: ((r - l ) @ (b - t )) 
! !

!Margin methodsFor: 'accessing' stamp: 'StephaneDucasse 9/7/2013 09:02'!
bottom
	^ bottom! !

!Margin methodsFor: 'accessing' stamp: 'StephaneDucasse 9/7/2013 11:37'!
height
	^ self bottom - self top.! !

!Margin methodsFor: 'accessing' stamp: 'StephaneDucasse 9/7/2013 09:02'!
right
	^ right! !

!Margin methodsFor: 'initialization' stamp: 'StephaneDucasse 9/7/2013 09:01'!
initialize

	super initialize.
	self setTop: 0 left: 0 bottom: 0 right: 0 ! !

!Margin methodsFor: 'initialization' stamp: 'StephaneDucasse 9/7/2013 08:58'!
fromNumber: anInteger

	self setTop: anInteger left: anInteger bottom: anInteger right: anInteger! !

!Margin methodsFor: 'initialization' stamp: 'StephaneDucasse 9/7/2013 09:08'!
fromPoint: aPoint

	self setTop: aPoint y left: aPoint x bottom: aPoint y  right: aPoint x! !

!Margin methodsFor: 'printing' stamp: 'StephaneDucasse 9/7/2013 09:18'!
printOn: aStream

	aStream 
		nextPutAll: 'MorphMargin';
		nextPutAll: ' top: ';
		nextPutAll: top printString;
		nextPutAll: ' left: ';
		nextPutAll: left printString;
		nextPutAll: ' bottom: ';
		nextPutAll: bottom printString;
		nextPutAll: ' right: ';
		nextPutAll: right printString. 
	! !

!Margin methodsFor: 'accessing' stamp: 'StephaneDucasse 9/7/2013 12:55'!
rightBottom

	^ right @ bottom! !

!Margin methodsFor: 'converting' stamp: 'StephaneDucasse 9/7/2013 11:26'!
asMargin
	^ self ! !

!Margin methodsFor: 'testing' stamp: 'StephaneDucasse 9/7/2013 10:29'!
isZero

	^ (0 = top) 
		and: [ (0 = left) 
				and: [ (0 = right) 
					and: [ 0 = bottom]]]! !

!Margin methodsFor: 'operations' stamp: 'StephaneDucasse 9/7/2013 12:55'!
extendRectangle: aRectangle
	"Answer a rectangle whose size has been expanded (without changing its origin) by the receiver which represents each rectangle corner."
	
	^ Rectangle origin: aRectangle origin corner: aRectangle corner + self rightBottom 
! !

!Margin class methodsFor: 'instance creation' stamp: 'StephaneDucasse 9/7/2013 09:13'!
top: topNumber left: leftNumber bottom: bottomNumber right: rightNumber 

	^ self new setTop: topNumber left: leftNumber bottom: bottomNumber right: rightNumber 
! !

!Margin class methodsFor: 'instance creation' stamp: 'StephaneDucasse 9/7/2013 11:24'!
left: leftNumber top: topNumber right: rightNumber bottom: bottomNumber 

	^ self new setTop: topNumber left: leftNumber bottom: bottomNumber right: rightNumber 
! !

!Margin class methodsFor: 'will be deprecated' stamp: 'StephaneDucasse 9/7/2013 09:34'!
fromRectangle: aRectangle
	"Create a margin with four values based on aRectangle using exactly top, left, bottom, right semantics. Pay attention that most of the time you should not use this method but prefer top:left:bottom:right:. The reason is that using rectangle may force you to create rectangles with negative extent which is totally wrong and bogus."
	
	^ self new fromRectangle: aRectangle; yourself! !

!Margin class methodsFor: 'instance creation' stamp: 'StephaneDucasse 9/7/2013 09:03'!
fromNumber: aNumber
	"Create a margin whose four values are the same and based on anInteger"
	
	^ self new fromNumber: aNumber; yourself! !

!Margin class methodsFor: 'instance creation' stamp: 'StephaneDucasse 9/7/2013 09:10'!
fromPoint: aPoint
	"Create a margin whose values are based on the point value: top and bottom are y and left right are x."
	
	^ self new fromPoint: aPoint; yourself! !

!MarginBorder commentStamp: 'gvc 5/18/2007 12:46'!
Border with customisable inner margin.!
!MarginBorder methodsFor: 'accessing' stamp: 'gvc 10/17/2006 11:06'!
frameRectangle: aRectangle on: aCanvas
	"Reduce width by the margin."
	
	aCanvas frameAndFillRectangle: aRectangle
		fillColor: Color transparent
		borderWidth: (self width - self margin max: 0)
		topLeftColor: self topLeftColor
		bottomRightColor: self bottomRightColor.! !

!MarginBorder methodsFor: 'initialization' stamp: 'gvc 10/17/2006 11:05'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		margin: 0! !

!MarginBorder methodsFor: 'accessing' stamp: 'gvc 10/17/2006 11:07'!
drawLineFrom: startPoint to: stopPoint on: aCanvas
	"Reduce the width by the margin."
	
	| lineColor |
	lineColor := (stopPoint truncated quadrantOf: startPoint truncated) > 2 
				ifTrue: [self topLeftColor]
				ifFalse: [self bottomRightColor].
	aCanvas 
		line: startPoint
		to: stopPoint 
		width: (self width - self margin max: 0)
		color: lineColor! !

!MarginBorder methodsFor: 'accessing' stamp: 'gvc 10/17/2006 11:04'!
margin
	"Answer the value of margin"

	^ margin! !

!MarginBorder methodsFor: 'accessing' stamp: 'gvc 10/17/2006 11:04'!
margin: anObject
	"Set the value of margin"

	margin := anObject! !

!Matrix commentStamp: 'StephaneDucasse 2/15/2015 15:25'!
I represent a mathematical matrix or a two-dimensional array. I provide methods for creating matrices, operating on them arithmetically and algebraically. 

Structure:
 - numberOfRows : a non-negative integer saying how many rows there are.
 - numberOfColumns : a non-negative integer saying how many columns there are.
 - contents : an Array holding the elements in row-major order.  That is, for a 2x3 array the contents are (11 12 13 21 22 23).  


Element-wise matrix arithmetic works; you can freely mix matrices and numbers but
don't try to mix matrices and arrays (yet).
Matrix multiplication, using the symbol +* (derived from APL's +.x), works between
(Matrix or Array) +* (Matrix or Array).  Don't try to use a number as an argument of +*.
Matrix * Number and Number * Matrix work fine, so you don't need +* with numbers.
!
!Matrix methodsFor: 'testing' stamp: 'StephaneDucasse 2/15/2015 18:07'!
isSequenceable
	"LIE so that arithmetic on matrices will work.
	 What matters for arithmetic is not that there should be random indexing
	 but that the structure should be stable and independent of the values of
	 the elements.  #isSequenceable is simply the wrong question to ask."
	^ true! !

!Matrix methodsFor: 'private' stamp: 'StephaneDucasse 2/15/2015 10:50'!
indexForRow: row andColumn: column
	(row between: 1 and: numberOfRows)
		ifFalse: [self error: '1st subscript out of range'].
	(column between: 1 and: numberOfColumns)
		ifFalse: [self error: '2nd subscript out of range'].
	^(row-1) * numberOfColumns + column! !

!Matrix methodsFor: 'enumerating' stamp: 'raok 10/22/2002 00:15'!
with: aCollection collect: aBlock
	"aCollection must support #at:at: and be at least as large as the receiver."

	^self withIndicesCollect: [:each :row :column |
		aBlock value: each value: (aCollection at: row at: column)]
! !

!Matrix methodsFor: 'enumerating' stamp: 'StephaneDucasse 2/15/2015 17:53'!
withIndicesCollect: aBlock
	
	|i r|
	i := 0.
	r := contents shallowCopy.
	1 to: numberOfRows do: [ :row |
		1 to: numberOfColumns do: [ :column |
			i := i+1.
			r at: i put: (aBlock value: (r at: i) value: row value: column)]].
	^ self class rows: numberOfRows columns: numberOfColumns contents: r
! !

!Matrix methodsFor: 'private' stamp: 'StephaneDucasse 2/15/2015 10:50'!
rowAndColumnForIndex: index
	|t|

	t := index - 1.
	^(t // numberOfColumns + 1)@(t \\ numberOfColumns + 1)! !

!Matrix methodsFor: 'copying' stamp: 'StephaneDucasse 2/15/2015 10:50'!
shuffled
	^self class rows: numberOfRows columns: numberOfColumns contents: (contents shuffled)! !

!Matrix methodsFor: 'not implemented' stamp: 'raok 10/21/2002 23:42'!
reject: aBlock
	self shouldNotImplement! !

!Matrix methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2015 10:59'!
atRandom: aGenerator
	^ contents atRandom: aGenerator! !

!Matrix methodsFor: '*Collections-arithmetic' stamp: 'StephaneDucasse 2/15/2015 10:50'!
preMultiplyByArray: a
	"Answer a +* self where a is an Array."

	numberOfRows = 1 ifFalse: [self error: 'dimensions do not conform'].
	^Matrix rows: a size columns: numberOfColumns tabulate: [:row :col |
		(a at: row) * (contents at: col)]
! !

!Matrix methodsFor: 'converting' stamp: 'StephaneDucasse 2/15/2015 17:46'!
asOrderedCollection
	^ contents asOrderedCollection! !

!Matrix methodsFor: 'row/column operations' stamp: 'StephaneDucasse 2/15/2015 18:01'!
swapRow: anIndex withRow: anotherIndex
	| a b |
	a := self indexForRow: anIndex andColumn: 1.
	b := self indexForRow: anotherIndex andColumn: 1.
	numberOfColumns timesRepeat: [
		contents swap: a with: b.
		a := a + 1.
		b := b + 1].
! !

!Matrix methodsFor: 'row/column operations' stamp: 'StephaneDucasse 2/15/2015 16:46'!
atRow: rowNumber
	(rowNumber between: 1 and: numberOfRows)
		ifFalse: [self error: '1st subscript out of range'].
	^ contents 
			copyFrom: (rowNumber - 1) * numberOfColumns + 1 
			to: rowNumber*numberOfColumns! !

!Matrix methodsFor: 'testing' stamp: 'StephaneDucasse 2/15/2015 18:06'!
identityIncludes: anObject
	^ contents identityIncludes: anObject! !

!Matrix methodsFor: 'row/column operations' stamp: 'StephaneDucasse 2/15/2015 10:50'!
atRow: row put: aCollection
	|p|

	aCollection size = numberOfColumns ifFalse: [self error: 'wrong row size'].
	p := (self indexForRow: row andColumn: 1)-1.
	aCollection do: [:each | contents at: (p := p+1) put: each].
	^aCollection! !

!Matrix methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2015 10:51'!
at: rowNumber at: columnNumber
	^ contents at: (self indexForRow: rowNumber andColumn: columnNumber)! !

!Matrix methodsFor: 'converting' stamp: 'StephaneDucasse 2/15/2015 17:46'!
asFloatArray
	^ contents asFloatArray! !

!Matrix methodsFor: 'accessing' stamp: 'raok 10/21/2002 22:48'!
identityIndexOf: anElement ifAbsent: anExceptionBlock
	^self rowAndColumnForIndex:
		 (contents identityIndexOf: anElement ifAbsent: [^anExceptionBlock value])
! !

!Matrix methodsFor: 'testing' stamp: 'StephaneDucasse 2/15/2015 18:06'!
includesAll: aCollection
	^ contents includesAll: aCollection! !

!Matrix methodsFor: 'converting' stamp: 'StephaneDucasse 2/15/2015 17:47'!
asWordArray
	^ contents asWordArray! !

!Matrix methodsFor: 'not implemented' stamp: 'raok 10/21/2002 23:42'!
difference: aCollection
	"Union is in because the result is always a Set.
	 Difference and intersection are out because the result is like the receiver,
	 and with irregular seleection that cannot be."
	self shouldNotImplement! !

!Matrix methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2015 11:00'!
identityIndexOf: anElement
	
	^ self identityIndexOf: anElement ifAbsent: [ 0@0 ]
! !

!Matrix methodsFor: 'enumerating' stamp: 'StephaneDucasse 2/15/2015 17:52'!
indicesInject: start into: aBlock

	|current|
	current := start.
	1 to: numberOfRows do: [ :row |
		1 to: numberOfColumns do: [ :column |
			current := aBlock value: current value: row value: column ] ].
	^ current! !

!Matrix methodsFor: 'converting' stamp: 'StephaneDucasse 2/15/2015 17:46'!
asArray
	^ contents shallowCopy! !

!Matrix methodsFor: 'row/column operations' stamp: 'StephaneDucasse 2/15/2015 18:05'!
transposed
	[numberOfRows = numberOfColumns] assert.
	^ self indicesCollect: [ :row :column | self at: column at: row ]! !

!Matrix methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2015 10:58'!
atRandom
	"Return the contents of the receiver in a random order."
	^ contents atRandom
! !

!Matrix methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2015 11:01'!
replaceAll: oldObject with: newObject
	"Replace all occurrences of oldObject with newObject in the receiver."
	contents replaceAll: oldObject with: newObject! !

!Matrix methodsFor: 'copying' stamp: 'StephaneDucasse 2/15/2015 14:26'!
,, aMatrix
	"Answer a new matrix having the same number of columns as the receiver and aMatrix,
	 its rows being the rows of the receiver followed by the rows of aMatrix."

	[numberOfColumns = aMatrix numberOfColumns] assert.
	^self class 
			rows: numberOfRows + aMatrix numberOfRows 
			columns: numberOfColumns
			contents: contents , aMatrix privateContents
! !

!Matrix methodsFor: 'private' stamp: 'StephaneDucasse 2/15/2015 11:02'!
privateContents
	"Only used in #, #,, and #= so far.
	 It used to be called #contents, but that clashes with Collection>>contents."

	^ contents! !

!Matrix methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2015 10:59'!
columnCount
	^ numberOfColumns! !

!Matrix methodsFor: 'copying' stamp: 'StephaneDucasse 2/15/2015 14:28'!
, aMatrix
	"Answer a new matrix having the same number of rows as the receiver and aMatrix,
	 its columns being the columns of the receiver followed by the columns of aMatrix."
	|newCont newCols anArray oldCols a b c|

	[numberOfRows = aMatrix numberOfRows] assert.
	newCont := Array new: self size + aMatrix size.
	anArray := aMatrix privateContents.
	oldCols := aMatrix numberOfColumns.
	newCols := numberOfColumns + oldCols.
	a := b := c := 1.
	1 to: numberOfRows do: [:r |
		newCont replaceFrom: a to: a + numberOfColumns - 1 with: contents startingAt: b.
		newCont replaceFrom: a+numberOfColumns to: a + newCols - 1 with: anArray startingAt: c.
		a := a + newCols.
		b := b + numberOfColumns.
		c := c + oldCols].
	^self class rows: numberOfRows columns: newCols contents: newCont
		
! !

!Matrix methodsFor: 'copying' stamp: 'StephaneDucasse 2/15/2015 10:50'!
shuffledBy: aRandom
	^self class rows: numberOfRows columns: numberOfColumns contents: (contents copy shuffleBy: aRandom)! !

!Matrix methodsFor: 'converting' stamp: 'StephaneDucasse 2/15/2015 17:46'!
asIdentitySet
	^ contents asIdentitySet! !

!Matrix methodsFor: 'enumerating' stamp: 'StephaneDucasse 2/15/2015 17:53'!
withIndicesDo: aBlock
	
	| i |
	i := 0.
	1 to: numberOfRows do: [:row |
		1 to: numberOfColumns do: [:column |
			aBlock value: (contents at: (i := i+1)) value: row value: column]].
! !

!Matrix methodsFor: 'enumerating' stamp: 'StephaneDucasse 2/15/2015 17:53'!
withIndicesInject: start into: aBlock
	
	| i current |
	i := 0.
	current := start.
	1 to: numberOfRows do: [ :row |
		1 to: numberOfColumns do: [ :column |
			current := aBlock 
								value: current 
								value: (contents at: (i := i+1)) 
								value: row value: column ] ].
	^ current! !

!Matrix methodsFor: 'converting' stamp: 'StephaneDucasse 2/15/2015 17:46'!
asCharacterSet
	^ contents asCharacterSet! !

!Matrix methodsFor: 'copying' stamp: 'nice 10/5/2009 09:09'!
postCopy
	super postCopy.
	contents := contents copy! !

!Matrix methodsFor: 'row/column operations' stamp: 'StephaneDucasse 2/15/2015 17:59'!
diagonal
	"Answer (1 to: (numberOfRows min: numberOfColumns)) collect: [:i | self at: i at: i]"
	|i|
	i := numberOfColumns negated.
	^ (1 to: (numberOfRows min: numberOfColumns)) collect: [:j | contents at: (i := i + numberOfColumns + 1)]! !

!Matrix methodsFor: 'enumerating' stamp: 'raok 10/21/2002 23:53'!
with: aCollection do: aBlock
	"aCollection must support #at:at: and be at least as large as the receiver."

	self withIndicesDo: [:each :row :column |
		aBlock value: each value: (aCollection at: row at: column)].
! !

!Matrix methodsFor: 'enumerating' stamp: 'StephaneDucasse 2/15/2015 14:42'!
collect: aBlock
	"Answer a new matrix with transformed elements; transformations should be independent."

	^self class 
		rows: numberOfRows 
		columns: numberOfColumns 
		contents: (contents collect: aBlock)! !

!Matrix methodsFor: 'converting' stamp: 'StephaneDucasse 2/15/2015 17:46'!
asIntegerArray
	^ contents asIntegerArray! !

!Matrix methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2015 13:06'!
at: rowNumber at: columnNumber ifInvalid: value
	"If rowNumber,columnNumber is a valid index for the receiver, answer the corresponding element. Otherwise, answer value."

	(rowNumber between: 1 and: numberOfRows) ifFalse: [ ^ value ].
	(columnNumber between: 1 and: numberOfColumns) ifFalse: [ ^ value ].
	^contents at: (rowNumber - 1) * numberOfColumns + columnNumber
! !

!Matrix methodsFor: 'accessing' stamp: 'raok 10/21/2002 22:52'!
swap: r1 at: c1 with: r2 at: c2
	contents swap: (self indexForRow: r1 andColumn: c1)
			 with: (self indexForRow: r2 andColumn: c2)! !

!Matrix methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2015 10:58'!
atAllPut: value
	"Put value as value of all the receiver elements."
	contents atAllPut: value! !

!Matrix methodsFor: 'accessing submatrices' stamp: 'raok 11/25/2002 12:32'!
atRows: r1 to: r2 columns: c1 to: c2 put: aMatrix
	"Set the [r1..r2][c1..c2] submatrix of the receiver
	 from the [1..r2-r1+1][1..c2-c1+1] submatrix of aMatrix.
	 As long as aMatrix responds to at:at: and accepts arguments in the range shown,
	 we don't care if it is bigger or even if it is a Matrix at all."
	|rd cd|

	rd := r1 - 1.
	cd := c1 - 1.
	r1 to: r2 do: [:r |
		c1 to: c2 do: [:c |
			self at: r at: c put: (aMatrix at: r-rd at: c-cd)]].
	^aMatrix
! !

!Matrix methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2015 14:24'!
at: rowNumber at: columnNumber put: value
	"Put value at rowNumber,columnNumber"
	^ contents at: (self indexForRow: rowNumber andColumn: columnNumber) put: value! !

!Matrix methodsFor: 'removing' stamp: 'klub 9/14/2009 16:34'!
removeAll

	self shouldNotImplement! !

!Matrix methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2015 18:04'!
indexOf: anElement
	"If there are integers r, c such that (self at: r at: c) = anElement, answer some such r@c, otherwise answer 0@0. The order in which the receiver are searched is UNSPECIFIED except that it is the same as the order used by #indexOf:ifAbsent: and #readStream."

	^self indexOf: anElement ifAbsent: [0@0]
! !

!Matrix methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2015 18:04'!
indexOf: anElement ifAbsent: anExceptionBlock
	"If there are integers r, c such that (self at: r at: c) = anElement, answer some such r@c, otherwise answer the result of anExceptionBlock."

	^self rowAndColumnForIndex:
		 (contents indexOf: anElement ifAbsent: [^ anExceptionBlock value])
! !

!Matrix methodsFor: 'converting' stamp: 'StephaneDucasse 2/15/2015 17:46'!
asByteArray
	^ contents asByteArray! !

!Matrix methodsFor: 'accessing' stamp: 'MarcusDenker 2/25/2015 12:47'!
extent
    "Answer the receiver's dimensions as point."

    ^ self numberOfColumns @ self numberOfRows! !

!Matrix methodsFor: 'enumerating' stamp: 'StephaneDucasse 2/15/2015 17:52'!
with: aCollection inject: startingValue into: aBlock
	"aCollection must support #at:at: and be at least as large as the receiver."

	^ self withIndicesInject: startingValue into: [:value :each :row :column |
			aBlock value: value value: each value: (aCollection at: row at: column)]! !

!Matrix methodsFor: 'testing' stamp: 'StephaneDucasse 2/15/2015 11:03'!
occurrencesOf: anObject
	^ contents occurrencesOf: anObject! !

!Matrix methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2015 10:50'!
rowCount
	^numberOfRows! !

!Matrix methodsFor: '*Collections-arithmetic' stamp: 'StephaneDucasse 2/15/2015 14:32'!
preMultiplyByMatrix: m
	"Answer m +* self where m is a Matrix."
	|s|
	numberOfRows = m numberOfColumns ifFalse: [self error: 'dimensions do not conform'].
	^ Matrix 
		rows: m numberOfRows 
		columns: numberOfColumns 
		tabulate: [:row :col |
			s := 0.
			1 to: numberOfRows do: [:k | s := (m at: row at: k) * (self at: k at: col) + s].
			s ]! !

!Matrix methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2015 10:51'!
anyOne
	"Return one element from the receiver"
	^ contents anyOne! !

!Matrix methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2015 11:01'!
numberOfRows
	^ numberOfRows! !

!Matrix methodsFor: '*Collections-arithmetic' stamp: 'raok 10/22/2002 20:01'!
+* aCollection
	"Premultiply aCollection by self.  aCollection should be an Array or Matrix.
	 The name of this method is APL's +.x squished into Smalltalk syntax."

	^aCollection preMultiplyByMatrix: self
! !

!Matrix methodsFor: 'row/column operations' stamp: 'StephaneDucasse 2/15/2015 10:50'!
swapColumn: anIndex withColumn: anotherIndex
	|a b|

	a := self indexForRow: 1 andColumn: anIndex.
	b := self indexForRow: 1 andColumn: anotherIndex.
	numberOfRows timesRepeat: [
		contents swap: a with: b.
		a := a + numberOfColumns.
		b := b + numberOfColumns].
! !

!Matrix methodsFor: 'private' stamp: 'StephaneDucasse 2/15/2015 10:50'!
rows: rows columns: columns contents: anArray
	[rows isInteger and: [rows >= 0]] assert.
	[columns isInteger and: [columns >= 0]] assert.
	[rows * columns = anArray size] assert.
	numberOfRows := rows.
	numberOfColumns := columns.
	contents := anArray.
	^self! !

!Matrix methodsFor: 'not implemented' stamp: 'raok 10/21/2002 22:53'!
add: newObject
	self shouldNotImplement! !

!Matrix methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2015 10:50'!
numberOfColumns: anObject
	numberOfColumns := anObject! !

!Matrix methodsFor: 'printing' stamp: 'StephaneDucasse 2/15/2015 17:00'!
printOn: aStream

	aStream nextPutAll: '('.
	(1 to: self numberOfRows) 
		do: [ :r | 
				(self atRow: r) 
					do: [ :each | aStream nextPutAll: each printString ] 
					separatedBy: [ aStream space ]]
		separatedBy: [ aStream cr ].
	aStream nextPutAll: ' )'.! !

!Matrix methodsFor: 'converting' stamp: 'StephaneDucasse 2/15/2015 17:46'!
asSortedCollection
	^ contents asSortedCollection! !

!Matrix methodsFor: 'row/column operations' stamp: 'StephaneDucasse 2/15/2015 11:02'!
atColumn: column

	|p|
	p := (self indexForRow: 1 andColumn: column)-numberOfColumns.
	^(1 to: numberOfRows) collect: [:row | contents at: (p := p+numberOfColumns)]
! !

!Matrix methodsFor: 'comparing' stamp: 'raok 11/22/2002 13:14'!
hash
	"I'm really not sure what would be a good hash function here.
	 The essential thing is that it must be compatible with #=, and
	 this satisfies that requirement."

	^contents hash! !

!Matrix methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2015 11:01'!
size
	^ contents size! !

!Matrix methodsFor: 'printing' stamp: 'StephaneDucasse 2/15/2015 10:50'!
storeOn: aStream
	aStream nextPut: $(; nextPutAll: self class name;
		nextPutAll: ' rows: '; store: numberOfRows;
		nextPutAll: ' columns: '; store: numberOfColumns;
		nextPutAll: ' contents: '; store: contents;
		nextPut: $)! !

!Matrix methodsFor: 'removing' stamp: 'raok 10/21/2002 22:54'!
remove: anObject ifAbsent: anExceptionBlock
	self shouldNotImplement! !

!Matrix methodsFor: 'accessing submatrices' stamp: 'raok 11/25/2002 13:09'!
atRows: rs columns: cs
	"Answer a Matrix obtained by slicing the receiver.
	 rs and cs should be sequenceable collections of positive integers."

	^self class rows: rs size columns: cs size tabulate: [:r :c |
		self at: (rs at: r) at: (cs at: c)]! !

!Matrix methodsFor: 'converting' stamp: 'StephaneDucasse 2/15/2015 17:47'!
readStream
	"Answer a ReadStream that returns all the elements of the receiver in some UNSPECIFIED order."
	^ contents readStream! !

!Matrix methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2015 10:59'!
numberOfColumns
	^ numberOfColumns! !

!Matrix methodsFor: 'testing' stamp: 'StephaneDucasse 2/15/2015 18:06'!
includes: anObject
	^ contents includes: anObject! !

!Matrix methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2015 13:06'!
at: rowNumber at: columnNumber incrementBy: value
	"Add a value to the element available at rowNumber,columNumber."

	^ contents at: (self indexForRow: rowNumber andColumn: columnNumber) incrementBy: value! !

!Matrix methodsFor: 'not implemented' stamp: 'raok 10/21/2002 23:42'!
intersection: aCollection
	"Union is in because the result is always a Set.
	 Difference and intersection are out because the result is like the receiver,
	 and with irregular seleection that cannot be."
	self shouldNotImplement! !

!Matrix methodsFor: 'not implemented' stamp: 'raok 10/21/2002 23:42'!
select: aBlock
	self shouldNotImplement! !

!Matrix methodsFor: 'converting' stamp: 'StephaneDucasse 2/15/2015 17:46'!
asSet
	^ contents asSet! !

!Matrix methodsFor: 'enumerating' stamp: 'StephaneDucasse 2/15/2015 17:48'!
indicesCollect: aBlock
	
	| r i |
	r := Array new: numberOfRows * numberOfColumns.
	i := 0.
	1 to: numberOfRows do: [:row |
		1 to: numberOfColumns do: [:column |
			r at: (i := i+1) put: (aBlock value: row value: column)]].
	^ self class rows: numberOfRows columns: numberOfColumns contents: r! !

!Matrix methodsFor: 'comparing' stamp: 'StephaneDucasse 2/15/2015 15:28'!
= aMatrix
	^ aMatrix class == self class
		and: [ aMatrix numberOfRows = numberOfRows
				and: [ aMatrix numberOfColumns = numberOfColumns 
					and: [ aMatrix privateContents = contents ] ] ]! !

!Matrix methodsFor: 'enumerating' stamp: 'raok 10/21/2002 23:40'!
do: aBlock
	"Pass elements to aBlock one at a time in row-major order."
	contents do: aBlock! !

!Matrix methodsFor: 'testing' stamp: 'StephaneDucasse 2/15/2015 18:06'!
includesAny: aCollection
	^ contents includesAny: aCollection! !

!Matrix methodsFor: 'enumerating' stamp: 'StephaneDucasse 2/15/2015 17:48'!
indicesDo: aBlock
	1 to: numberOfRows do: [ :row |
		1 to: numberOfColumns do: [ :column |
			aBlock value: row value: column]].! !

!Matrix methodsFor: 'converting' stamp: 'StephaneDucasse 2/15/2015 17:46'!
asBag
	^ contents asBag! !

!Matrix methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2015 10:50'!
numberOfRows: anObject
	numberOfRows := anObject! !

!Matrix methodsFor: 'accessing submatrices' stamp: 'raok 11/25/2002 12:30'!
atRows: r1 to: r2 columns: c1 to: c2
	"Answer a submatrix [r1..r2][c1..c2] of the receiver."
	|rd cd|

	rd := r1 - 1.
	cd := c1 - 1.
	^self class rows: r2-rd columns: c2-cd tabulate: [:r :c| self at: r+rd at: c+cd]
! !

!Matrix methodsFor: 'accessing submatrices' stamp: 'StephaneDucasse 2/15/2015 18:02'!
atRows: r1 to: r2 columns: c1 to: c2 ifInvalid: element
	"Answer a submatrix [r1..r2][c1..c2] of the receiver.
	 Portions of the result outside the bounds of the original matrix are filled in with element."
	|rd cd|
	rd := r1 - 1.
	cd := c1 - 1.
	^self class rows: r2-rd columns: c2-cd tabulate: [ :r :c| self at: r+rd at: c+cd ifInvalid: element]
! !

!Matrix methodsFor: 'row/column operations' stamp: 'StephaneDucasse 2/15/2015 17:58'!
atColumn: column put: aCollection
	| p |
	aCollection size = numberOfRows ifFalse: [ self error: 'wrong column size' ].
	p := (self indexForRow: 1 andColumn: column) - numberOfColumns.
	aCollection do: [ :each | contents at: (p := p + numberOfColumns) put: each ].
	^ aCollection
! !

!Matrix methodsFor: 'converting' stamp: 'StephaneDucasse 2/15/2015 17:46'!
asSortedCollection: aBlock
	^ contents asSortedCollection: aBlock! !

!Matrix class methodsFor: 'instance creation' stamp: 'StephaneDucasse 2/15/2015 17:45'!
new: dimension
	"Answer a dimension*dimension matrix."
	^ self rows: dimension columns: dimension! !

!Matrix class methodsFor: 'special instance creation' stamp: 'StephaneDucasse 2/8/2015 22:21'!
identity: n
	| r |
	r := self zeros: n.
	1 to: n do: [ :i | r at: i at: i put: 1 ].
	^ r! !

!Matrix class methodsFor: 'instance creation' stamp: 'StephaneDucasse 2/15/2015 14:52'!
new: dimemsion element: element
	"Answer a dimemsion*dimemsion matrix with all elements set to element."

	^ self rows: dimemsion columns: dimemsion element: element! !

!Matrix class methodsFor: 'instance creation' stamp: 'StephaneDucasse 2/8/2015 22:23'!
rows: rowNumber columns: columnNumber
	"Create a Matrix of rowNUmber rows and columnNumber columns."
	^ self 
		rows: rowNumber 
		columns: columnNumber 
		contents: (Array new: rowNumber*columnNumber)! !

!Matrix class methodsFor: '*Deprecated40' stamp: 'StephaneDucasse 2/15/2015 17:02'!
column: aCollection
	"Create a matrix of one column having aCollection as contents"
	self deprecated: 'Use columnVector: instead'.
	^ self columnVector: aCollection! !

!Matrix class methodsFor: 'special instance creation' stamp: 'StephaneDucasse 2/15/2015 17:01'!
rowVector: aCollection
	"Create a matrix of one row having aCollection as contents"

	^self rows: 1 columns: aCollection size contents: aCollection asArray shallowCopy! !

!Matrix class methodsFor: 'instance creation' stamp: 'StephaneDucasse 2/15/2015 17:04'!
new: dimension tabulate: aTwoArgumentBlock
	"Answer a dimension*dimension matrix where it at: i at: j is aBlock value: i value: j."
	^ self rows: dimension columns: dimension tabulate: aTwoArgumentBlock! !

!Matrix class methodsFor: 'instance creation' stamp: 'StephaneDucasse 2/15/2015 17:45'!
rows: rowNumber columns: columnNumber tabulate: aTwoArgumentBlock
	"Answer a new Matrix of the given dimensions where
	 result at: i at: j is aTwoArgumentBlock value: i value: j"
	|a i|
	a := Array new: rowNumber*columnNumber.
	i := 0.
	1 to: rowNumber do: [:row |
		1 to: columnNumber do: [:column |
			a at: (i := i + 1) put: (aTwoArgumentBlock value: row value: column)]].
	^ self rows: rowNumber columns: columnNumber contents: a
! !

!Matrix class methodsFor: 'special instance creation' stamp: 'raok 10/22/2002 00:09'!
diagonal: aCollection
	|r i|
	r := self zeros: aCollection size.
	i := 0.
	aCollection do: [:each | i := i+1. r at: i at: i put: each].
	^r! !

!Matrix class methodsFor: 'private' stamp: 'StephaneDucasse 2/8/2015 22:20'!
rows: rowNumber columns: columnNumber contents: contents
	"Private!! Creates a Matrix of the given size with an adequate contents."
	^ self new rows: rowNumber columns: columnNumber contents: contents! !

!Matrix class methodsFor: '*Deprecated40' stamp: 'StephaneDucasse 2/15/2015 17:02'!
row: aCollection
	"Create a matrix of one row having aCollection as contents"
	self deprecated: 'Use rowVector: instead'.
	^ self rowVector: aCollection ! !

!Matrix class methodsFor: 'special instance creation' stamp: 'StephaneDucasse 2/15/2015 17:02'!
columnVector: aCollection
	"Create a matrix of one column having aCollection as contents"

	^ self rows: aCollection size columns: 1 contents: aCollection asArray shallowCopy! !

!Matrix class methodsFor: 'special instance creation' stamp: 'StephaneDucasse 2/15/2015 17:05'!
ones: dimension
	"Create a squared matrix of dimension full of 1"
	^ self new: dimension element: 1
! !

!Matrix class methodsFor: 'special instance creation' stamp: 'StephaneDucasse 2/15/2015 17:03'!
zeros: dimension
	"Create a Matrix of dimensionxdimemsion"
	^ self new: dimension element: 0! !

!Matrix class methodsFor: 'instance creation' stamp: 'StephaneDucasse 2/15/2015 17:45'!
rows: rowNumber columns: columnNumber element: element
	"Create a Matrix of rowNUmber rows and columnNumber columns filled with element."
	^ self 
		rows: rowNumber 
		columns: columnNumber
		contents: ((Array new: rowNumber * columnNumber) atAllPut: element; yourself)! !

!MatrixTest commentStamp: 'TorstenBergmann 2/20/2014 15:30'!
SUnit tests for matrix!
!MatrixTest methodsFor: 'tests - accessing' stamp: 'StephaneDucasse 2/15/2015 16:09'!
testSquaredWithAllElement

	self assert: ((Matrix new: 3 element: -1) occurrencesOf: -1) equals: 9.
! !

!MatrixTest methodsFor: 'tests - accessing' stamp: 'StephaneDucasse 2/15/2015 14:36'!
testAtAt
	self should:[matrix1 at: 2 at: 3] raise: Error.
	self should:[matrix1 at: 3 at: 2] raise: Error.
	self should:[matrix1 at: 3 at: 3] raise: Error.
	self should:[matrix1 at: 0 at: 1] raise: Error.
	self should:[matrix1 at: 1 at: 0] raise: Error.
	self should:[matrix1 at: 0 at: 0] raise: Error.
	
	self assert: (matrix1 at: 1 at: 1) equals: 1.
	self assert: (matrix23 at: 1 at: 1) equals: 11.
	self assert: (matrix23 at: 1 at: 2) equals: 21.
	self assert: (matrix23 at: 2 at: 1) equals: 12.
	self assert: (matrix23 at: 2 at: 2) equals: 22.
	self assert: (matrix23 at: 3 at: 1) equals: 13.
	self assert: (matrix23 at: 3 at: 2) equals: 23.! !

!MatrixTest methodsFor: 'tests - instance creation' stamp: 'StephaneDucasse 2/15/2015 15:29'!
testIdentity

	| m  m2 | 
	m := Matrix new: 3 element: 0.
	m at: 1 at:1 put: 1.
	m at: 2 at:2 put: 1.
	m at: 3 at:3 put: 1.
	self assert: (m occurrencesOf: 1) equals: 3.
	m2 := Matrix identity: 3.
	self assert: (m2 = m).
! !

!MatrixTest methodsFor: 'tests - accessing' stamp: 'StephaneDucasse 2/15/2015 14:43'!
testAtAllPut

	| m | 
	m := Matrix new: 3. 
	m do: [ :each | self assert: each equals: nil ].
	m atAllPut: 1.
	m do: [ :each | self assert: each equals: 1 ].! !

!MatrixTest methodsFor: 'tests - instance creation' stamp: 'StephaneDucasse 2/15/2015 15:20'!
testOneColumnOnly

	| m |
	m := Matrix column:  #(11 12 13).
	self assert: m numberOfColumns = 1.
	self assert: m numberOfRows = 3.
! !

!MatrixTest methodsFor: 'tests - accessing' stamp: 'StephaneDucasse 2/15/2015 14:37'!
testTransposed
	| transposedMatrix |
	transposedMatrix := matrix1 transposed.
	self assert: (transposedMatrix at: 1 at: 1) equals: 1.
	self assert: (transposedMatrix at: 1 at: 2) equals: 2.
	self assert: (transposedMatrix at: 2 at: 1) equals: 3.
	self assert: (transposedMatrix at: 2 at: 2) equals: 4! !

!MatrixTest methodsFor: 'tests - accessing' stamp: 'StephaneDucasse 2/15/2015 15:26'!
testContentsEncodings

	self assert: matrix23 privateContents equals: #(11 21 12 22 13 23)! !

!MatrixTest methodsFor: 'tests - testing' stamp: 'StephaneDucasse 2/15/2015 14:38'!
testTabulateEquals
	| m |
	m := Matrix rows: 3 columns: 2 tabulate: [ :row :column | column * 10 + row ].
	self assert: (m = matrix23)
! !

!MatrixTest methodsFor: 'tests - testing' stamp: 'dc 3/3/2007 17:49'!
testIncludes
	self assert:
			((1 to: 4)
				allSatisfy: [:i | matrix1 includes: i])
! !

!MatrixTest methodsFor: 'tests - arithmetic' stamp: 'StephaneDucasse 2/15/2015 14:35'!
testMultiply
	
	| result |
	self	should: [matrix1 preMultiplyByMatrix: (Matrix new: 3)] raise: Error.

	result := matrix2 preMultiplyByMatrix: matrix1.
	self assert: (result at: 1 at: 1) = 15.
	self assert: (result at: 1 at: 2) = 31.
	self assert: (result at: 2 at: 1) = 22.
	self assert: (result at: 2 at: 2) = 46! !

!MatrixTest methodsFor: 'setup' stamp: 'StephaneDucasse 2/15/2015 13:05'!
setUp
	matrix1 := Matrix new: 2.
	matrix1 at:1 at:1 put: 1.
	matrix1 at:1 at:2 put: 3.
	matrix1 at:2 at:1 put: 2.
	matrix1 at:2 at:2 put: 4.
	
	matrix2 := Matrix new: 2.
	matrix2 at:1 at:1 put: 3.
	matrix2 at:1 at:2 put: 7.
	matrix2 at:2 at:1 put: 4.
	matrix2 at:2 at:2 put: 8.
	
	matrix23 := Matrix rows: 3 columns: 2.
	matrix23 at: 1 at: 1 put: 11.
	matrix23 at: 1 at: 2 put: 21.
	matrix23 at: 2 at: 1 put: 12.
	matrix23 at: 2 at: 2 put: 22.
	matrix23 at: 3 at: 1 put: 13.
	matrix23 at: 3 at: 2 put: 23.! !

!MatrixTest methodsFor: 'tests - accessing' stamp: 'StephaneDucasse 2/15/2015 14:46'!
testCollectCreatesANewMatrix

	| m m2 | 
	m := Matrix new: 3. 
	m atAllPut: -1.
	self assert: (m occurrencesOf: -1) equals: 9.
	m2 := m collect: [ :each | each abs ].
	m2 collect: [ :each | self assert: each equals: 1 ].
	self assert: (m2 occurrencesOf: 1) equals: 9! !

!MatrixTest methodsFor: 'tests - instance creation' stamp: 'StephaneDucasse 2/15/2015 14:49'!
testIdentityOtherTest

	| m | 
	m := Matrix identity: 3.
	self assert: (m at: 1 at:1) equals: 1.
	self assert: (m at: 2 at:2) equals: 1.
	self assert: (m at: 3 at:3) equals: 1.
	self assert: (m occurrencesOf: 1) equals: 3.
! !

!MatrixTest methodsFor: 'tests - accessing' stamp: 'StephaneDucasse 2/15/2015 18:01'!
testDiagonal
	self assert: matrix1 diagonal equals: #(1 4).
	self assert: matrix2 diagonal equals: #(3 8).
	! !

!MatrixTest methodsFor: 'tests - accessing' stamp: 'StephaneDucasse 2/15/2015 14:37'!
testReplaceAll

	matrix1 replaceAll: 1 with: 10.
	self assert: (matrix1 at: 1 at: 1) equals: 10.
	self assert: (matrix1 at: 2 at: 1) equals: 2.
	self assert: (matrix1 at: 1 at: 2) equals: 3.
	self assert: (matrix1 at: 2 at: 2) equals: 4.! !

!MatrixTest methodsFor: 'tests - accessing' stamp: 'dc 3/3/2007 17:53'!
testSwap
	matrix1 swap: 1 at: 2 with: 1 at: 1.
	self assert: (matrix1 at: 1 at: 1) = 3.
	self assert: (matrix1 at: 1 at: 2) = 1.! !

!MatrixTest methodsFor: 'tests - accessing' stamp: 'StephaneDucasse 2/15/2015 16:47'!
testAtRow

	self assert: (matrix23 atRow: 1) equals: #(11 21).
	self assert: (matrix23 atRow: 2) equals: #(12 22).
	self assert: (matrix23 atRow: 3) equals: #(13 23).! !

!MatrixTest methodsFor: 'tests - copying' stamp: 'StephaneDucasse 2/15/2015 14:35'!
testCopy

	| copyMatrix |
	copyMatrix := matrix1 copy.
	self assert: matrix1 = copyMatrix ! !

!MatrixTest methodsFor: 'tests - testing' stamp: 'StephaneDucasse 2/15/2015 14:35'!
testTabulate
	| m |
	m := Matrix rows: 3 columns: 2 tabulate: [ :row :column | column * 10 + row ].
	self assert: (m at: 1 at: 1) equals: 11.
	self assert: (m at: 1 at: 2) equals: 21.
	self assert: (m at: 2 at: 1) equals: 12.
	self assert: (m at: 2 at: 2) equals: 22.
	self assert: (m at: 3 at: 1) equals: 13.
	self assert: (m at: 3 at: 2) equals: 23.! !

!MatrixTest methodsFor: 'tests - accessing' stamp: 'StephaneDucasse 2/15/2015 17:44'!
testAtColumn

	self assert: (matrix23 atColumn: 1) equals: #(11 12 13).
	self assert: (matrix23 atColumn: 2) equals: #(21 22 23).
	! !

!MatrixTransform2x3 commentStamp: '<historical>'!
This class represents a transformation for points, that is a combination of scale, offset, and rotation. It is implemented as a 2x3 matrix containing the transformation from the local coordinate system in the global coordinate system. Thus, transforming points from local to global coordinates is fast and cheap whereas transformations from global to local coordinate systems are relatively expensive.

Implementation Note: It is assumed that the transformation deals with Integer points. All transformations will return Integer coordinates (even though float points may be passed in here).!
!MatrixTransform2x3 methodsFor: 'element access' stamp: 'ar 11/2/1998 22:56'!
a23
	 ^self at: 6! !

!MatrixTransform2x3 methodsFor: 'composing' stamp: 'lr 7/4/2009 10:42'!
composedWithLocal: aTransformation into: result 
	"Return the composition of the receiver and the local transformation passed in.
	Store the composed matrix into result."
	| a11 a12 a13 a21 a22 a23 b11 b12 b13 b21 b22 b23 matrix |
	<primitive: 'primitiveComposeMatrix' module: 'Matrix2x3Plugin'>
	matrix := aTransformation asMatrixTransform2x3.
	a11 := self a11.
	b11 := matrix a11.
	a12 := self a12.
	b12 := matrix a12.
	a13 := self a13.
	b13 := matrix a13.
	a21 := self a21.
	b21 := matrix a21.
	a22 := self a22.
	b22 := matrix a22.
	a23 := self a23.
	b23 := matrix a23.
	result a11: a11 * b11 + (a12 * b21).
	result a12: a11 * b12 + (a12 * b22).
	result a13: a13 + (a11 * b13) + (a12 * b23).
	result a21: a21 * b11 + (a22 * b21).
	result a22: a21 * b12 + (a22 * b22).
	result a23: a23 + (a21 * b13) + (a22 * b23).
	^ result! !

!MatrixTransform2x3 methodsFor: 'objects from disk' stamp: 'StephaneDucasse 3/17/2010 21:12'!
restoreEndianness
	"This word object was just read in from a stream.  It was stored in Big Endian (Mac) format.  Swap each pair of bytes (16-bit word), if the current machine is Little Endian.
	Why is this the right thing to do?  We are using memory as a byteStream.  High and low bytes are reversed in each 16-bit word, but the stream of words ascends through memory.  Different from a Bitmap."
	| w b1 b2 b3 b4 |
	Smalltalk isLittleEndian ifTrue: 
		[ 1 
			to: self basicSize
			do: 
				[ :i | 
				w := self basicAt: i.
				b1 := w digitAt: 1.
				b2 := w digitAt: 2.
				b3 := w digitAt: 3.
				b4 := w digitAt: 4.
				w := (b1 << 24) + (b2 << 16) + (b3 << 8) + b4.
				self 
					basicAt: i
					put: w ] ]! !

!MatrixTransform2x3 methodsFor: 'accessing' stamp: 'ar 11/2/1998 23:19'!
offset
	^self a13 @ self a23! !

!MatrixTransform2x3 methodsFor: 'objects from disk' stamp: 'nk 3/17/2004 16:06'!
byteSize
	^self basicSize * self bytesPerBasicElement! !

!MatrixTransform2x3 methodsFor: 'transforming points' stamp: 'ar 2/2/2001 15:47'!
localPointToGlobal: aPoint
	"Transform aPoint from local coordinates into global coordinates"
	<primitive: 'primitiveTransformPoint' module: 'Matrix2x3Plugin'>
	^(self transformPoint: aPoint) rounded! !

!MatrixTransform2x3 methodsFor: 'element access' stamp: 'ar 11/2/1998 22:57'!
a13: value
	 self at: 3 put: value! !

!MatrixTransform2x3 methodsFor: 'element access' stamp: 'ar 11/2/1998 22:56'!
a22
	 ^self at: 5! !

!MatrixTransform2x3 methodsFor: 'testing' stamp: 'ar 2/2/2001 15:47'!
isPureTranslation
	"Return true if the receiver specifies no rotation or scaling."
	<primitive: 'primitiveIsPureTranslation' module: 'Matrix2x3Plugin'>
	^self a11 = 1.0 and:[self a12 = 0.0 and:[self a22 = 0.0 and:[self a21 = 1.0]]]! !

!MatrixTransform2x3 methodsFor: 'composing' stamp: 'RAA 9/20/2000 13:10'!
composedWithLocal: aTransformation
	"Return the composition of the receiver and the local transformation passed in"
	aTransformation isMatrixTransform2x3 ifFalse:[^super composedWithLocal: aTransformation].
	^self composedWithLocal: aTransformation asMatrixTransform2x3 into: self class new! !

!MatrixTransform2x3 methodsFor: 'testing' stamp: 'ar 11/2/1998 23:15'!
isMatrixTransform2x3
	"Return true if the receiver is 2x3 matrix transformation"
	^true! !

!MatrixTransform2x3 methodsFor: 'accessing' stamp: 'ar 2/2/2001 15:47'!
at: index
	<primitive: 'primitiveAt' module: 'FloatArrayPlugin'>
	^Float fromIEEE32Bit: (self basicAt: index)! !

!MatrixTransform2x3 methodsFor: 'printing' stamp: 'ar 11/2/1998 23:11'!
printOn: aStream
	aStream 
		nextPutAll: self class name;
		nextPut: $(;
		cr; print: self a11; tab; print: self a12; tab; print: self a13;
		cr; print: self a21; tab; print: self a22; tab; print: self a23;
		cr; nextPut:$).! !

!MatrixTransform2x3 methodsFor: 'private' stamp: 'lr 7/4/2009 10:42'!
setOffset: aPoint 
	"Set the raw offset in the receiver"
	| pt |
	pt := aPoint asPoint.
	self a13: pt x asFloat.
	self a23: pt y asFloat! !

!MatrixTransform2x3 methodsFor: 'element access' stamp: 'ar 11/2/1998 22:56'!
a11
	^self at: 1! !

!MatrixTransform2x3 methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
inverseTransformation
	"Return the inverse transformation of the receiver.
	The inverse transformation is computed by first calculating
	the inverse offset and then computing transformations
	for the two identity vectors (1@0) and (0@1)"
	| r1 r2 r3 m |
	r3 := self invertPoint: 0 @ 0.
	r1 := (self invertPoint: 1 @ 0) - r3.
	r2 := (self invertPoint: 0 @ 1) - r3.
	m := self species new.
	m
		a11: r1 x;
		a12: r2 x;
		a13: r3 x;
		a21: r1 y;
		a22: r2 y;
		a23: r3 y.
	^ m! !

!MatrixTransform2x3 methodsFor: 'transforming points' stamp: 'lr 7/4/2009 10:42'!
transformDirection: aPoint 
	"Transform aPoint from local coordinates into global coordinates"
	| x y |
	x := aPoint x * self a11 + (aPoint y * self a12).
	y := aPoint x * self a21 + (aPoint y * self a22).
	^ x @ y! !

!MatrixTransform2x3 methodsFor: 'objects from disk' stamp: 'nk 3/17/2004 15:04'!
bytesPerBasicElement
	"Answer the number of bytes that each of my basic elements requires.
	In other words:
		self basicSize * self bytesPerBasicElement
	should equal the space required on disk by my variable sized representation."
	^4! !

!MatrixTransform2x3 methodsFor: 'transforming rects' stamp: 'ar 2/2/2001 15:47'!
globalBounds: srcRect toLocal: dstRect
	"Transform aRectangle from global coordinates into local coordinates"
	<primitive: 'primitiveInvertRectInto' module: 'Matrix2x3Plugin'>
	^super globalBoundsToLocal: srcRect! !

!MatrixTransform2x3 methodsFor: 'transforming points' stamp: 'ar 2/2/2001 15:47'!
globalPointToLocal: aPoint
	"Transform aPoint from global coordinates into local coordinates"
	<primitive: 'primitiveInvertPoint' module: 'Matrix2x3Plugin'>
	^(self invertPoint: aPoint) rounded! !

!MatrixTransform2x3 methodsFor: 'element access' stamp: 'ar 11/2/1998 22:57'!
a23: value
	 self at: 6 put: value! !

!MatrixTransform2x3 methodsFor: 'element access' stamp: 'ar 11/2/1998 22:57'!
a12: value
	 self at: 2 put: value! !

!MatrixTransform2x3 methodsFor: 'transforming rects' stamp: 'ar 11/9/1998 14:40'!
localBoundsToGlobal: aRectangle
	"Transform aRectangle from local coordinates into global coordinates"
	^self localBounds: aRectangle toGlobal: Rectangle new! !

!MatrixTransform2x3 methodsFor: 'comparing' stamp: 'lr 7/4/2009 10:42'!
hash
	| result |
	<primitive: 'primitiveHashArray' module: 'FloatArrayPlugin'>
	result := 0.
	1 
		to: self size
		do: [ :i | result := result + (self basicAt: i) ].
	^ result bitAnd: 536870911! !

!MatrixTransform2x3 methodsFor: 'testing' stamp: 'ar 2/2/2001 15:47'!
isIdentity
	"Return true if the receiver is the identity transform; that is, if applying to a point returns the point itself."
	<primitive: 'primitiveIsIdentity' module: 'Matrix2x3Plugin'>
	^self isPureTranslation and:[self a13 = 0.0 and:[self a23 = 0.0]]! !

!MatrixTransform2x3 methodsFor: 'objects from disk' stamp: 'ar 8/6/2001 17:52'!
writeOn: aStream
	aStream nextWordsPutAll: self.! !

!MatrixTransform2x3 methodsFor: 'element access' stamp: 'ar 11/2/1998 22:56'!
a21
	 ^self at: 4! !

!MatrixTransform2x3 methodsFor: 'transforming rects' stamp: 'ar 2/2/2001 15:47'!
localBounds: srcRect toGlobal: dstRect
	"Transform aRectangle from local coordinates into global coordinates"
	<primitive: 'primitiveTransformRectInto' module: 'Matrix2x3Plugin'>
	^super localBoundsToGlobal: srcRect! !

!MatrixTransform2x3 methodsFor: 'private' stamp: 'lr 7/4/2009 10:42'!
setScale: aPoint 
	"Set the raw scale in the receiver"
	| pt |
	pt := aPoint asPoint.
	self a11: pt x asFloat.
	self a22: pt y asFloat! !

!MatrixTransform2x3 methodsFor: 'transforming points' stamp: 'lr 7/4/2009 10:42'!
transformPoint: aPoint 
	"Transform aPoint from local coordinates into global coordinates"
	| x y |
	x := aPoint x * self a11 + (aPoint y * self a12) + self a13.
	y := aPoint x * self a21 + (aPoint y * self a22) + self a23.
	^ x @ y! !

!MatrixTransform2x3 methodsFor: 'element access' stamp: 'ar 11/2/1998 22:56'!
a12
	^self at: 2! !

!MatrixTransform2x3 methodsFor: 'element access' stamp: 'ar 11/2/1998 22:57'!
a11: value
	 self at: 1 put: value! !

!MatrixTransform2x3 methodsFor: 'initialize' stamp: 'ar 11/2/1998 23:17'!
setIdentiy
	"Initialize the receiver to the identity transformation (e.g., not affecting points)"
	self
		a11: 1.0; a12: 0.0; a13: 0.0;
		a21: 0.0; a22: 1.0; a23: 0.0.! !

!MatrixTransform2x3 methodsFor: 'element access' stamp: 'ar 11/2/1998 22:57'!
a22: value
	 self at: 5 put: value! !

!MatrixTransform2x3 methodsFor: 'accessing' stamp: 'ar 2/2/2001 15:47'!
at: index put: value
	<primitive: 'primitiveAtPut' module: 'FloatArrayPlugin'>
	value isFloat 
		ifTrue:[self basicAt: index put: value asIEEE32BitWord]
		ifFalse:[self at: index put: value asFloat].
	^value! !

!MatrixTransform2x3 methodsFor: 'element access' stamp: 'ar 11/2/1998 22:56'!
a13
	^self at: 3! !

!MatrixTransform2x3 methodsFor: 'comparing' stamp: 'lr 7/4/2009 10:42'!
= aMatrixTransform2x3 
	| length |
	<primitive: 'primitiveEqual' module: 'FloatArrayPlugin'>
	self class = aMatrixTransform2x3 class ifFalse: [ ^ false ].
	length := self size.
	length = aMatrixTransform2x3 size ifFalse: [ ^ false ].
	1 
		to: self size
		do: [ :i | (self at: i) = (aMatrixTransform2x3 at: i) ifFalse: [ ^ false ] ].
	^ true! !

!MatrixTransform2x3 methodsFor: 'accessing' stamp: 'ar 11/2/1998 23:05'!
offset: aPoint
	self a13: aPoint x asFloat.
	self a23: aPoint y asFloat.! !

!MatrixTransform2x3 methodsFor: 'transforming rects' stamp: 'ar 11/9/1998 14:40'!
globalBoundsToLocal: aRectangle
	"Transform aRectangle from global coordinates into local coordinates"
	^self globalBounds: aRectangle toLocal: Rectangle new! !

!MatrixTransform2x3 methodsFor: 'transforming points' stamp: 'lr 7/4/2009 10:42'!
invertPoint: aPoint 
	"Transform aPoint from global coordinates into local coordinates"
	| x y det a11 a12 a21 a22 detX detY |
	x := aPoint x asFloat - self a13.
	y := aPoint y asFloat - self a23.
	a11 := self a11.
	a12 := self a12.
	a21 := self a21.
	a22 := self a22.
	det := a11 * a22 - (a12 * a21).
	det = 0.0 ifTrue: [ ^ 0 @ 0 ].	"So we have at least a valid result"
	det := 1.0 / det.
	detX := x * a22 - (a12 * y).
	detY := a11 * y - (x * a21).
	^ (detX * det) @ (detY * det)! !

!MatrixTransform2x3 methodsFor: 'private' stamp: 'ar 11/2/1998 23:17'!
setAngle: angle
	"Set the raw rotation angle in the receiver"
	| rad s c |
	rad := angle degreesToRadians.
	s := rad sin.
	c := rad cos.
	self a11: c.
	self a12: s negated.
	self a21: s.
	self a22: c.! !

!MatrixTransform2x3 methodsFor: 'element access' stamp: 'ar 11/2/1998 22:57'!
a21: value
	 self at: 4 put: value! !

!MatrixTransform2x3 methodsFor: 'converting' stamp: 'ar 11/2/1998 15:34'!
asMatrixTransform2x3
	^self! !

!MatrixTransform2x3 class methodsFor: 'instance creation' stamp: 'ar 11/2/1998 22:50'!
identity
	^self new setScale: 1.0! !

!MatrixTransform2x3 class methodsFor: 'instance creation' stamp: 'ar 7/9/1998 20:09'!
new
	^self new: 6! !

!MatrixTransform2x3 class methodsFor: 'instance creation' stamp: 'ar 11/2/1998 02:49'!
withAngle: angle
	^self new setAngle: angle! !

!MatrixTransform2x3 class methodsFor: 'instance creation' stamp: 'ar 11/2/1998 23:17'!
withRotation: angle
	^self new setAngle: angle! !

!MatrixTransform2x3 class methodsFor: 'instance creation' stamp: 'ar 11/12/1998 01:25'!
transformFromLocal: localBounds toGlobal: globalBounds
	^((self withOffset: (globalBounds center)) composedWithLocal:
		(self withScale: (globalBounds extent / localBounds extent) asFloatPoint))
			composedWithLocal: (self withOffset: localBounds center negated)
"
	^(self identity)
		setScale: (globalBounds extent / localBounds extent) asFloatPoint;
		setOffset: localBounds center negated asFloatPoint;
		composedWithGlobal:(self withOffset: globalBounds center asFloatPoint)
"! !

!MatrixTransform2x3 class methodsFor: 'instance creation' stamp: 'ar 11/3/1998 02:52'!
withOffset: aPoint
	^self identity setOffset: aPoint! !

!MatrixTransform2x3 class methodsFor: 'instance creation' stamp: 'mir 6/12/2001 15:34'!
newFromStream: s
	"Only meant for my subclasses that are raw bits and word-like.  For quick unpack form the disk."
	self isPointers | self isWords not ifTrue: [^ super newFromStream: s].
		"super may cause an error, but will not be called."
	^ s nextWordsInto: (self new: 6)! !

!MatrixTransform2x3 class methodsFor: 'instance creation' stamp: 'ar 11/2/1998 02:49'!
withScale: aPoint
	^self new setScale: aPoint! !

!MaybeContextInstanceVariableNode commentStamp: '<historical>'!
This class conspires to arrange that inst var access for contexts is done exclusively using the long-form instance variabl;e access bytecodes.  See InstructionStream class>>variablesAndOffsetsDo:.

A virtual machine can benefit in performance by organizing method and block activations using a  more conventional stack organization than by using first-class activation records (contexts).  But such a virtual machine is also cabable of hiding the stack and making it appear as if contexts are still used.  This means the system has better performance but still has all the benefits of first-class activation records.  To pull this off the VM needs to intercept any and all accesses to context objects so that it can make contexts function as proxy objects for stack frames.

Without help from the image such a virtual machine based on an interpreter would have to perform an expensive check on all instance variable accesses to determine if the instance variable was that of a context serving as a proxy for a stack frame.  A simple hack is to take advantage of the short and long forms of instance variable access bytecodes.  The BlueBook instruction set (and likely any bytecode set evolved from it) has short form bytecodes for fetching and storing the first few bytecodes (BlueBook fetch first 16, store first 8).  Contexts typically have at most 6 instance variables.  If we arrange to use the long-form bytecodes for all context inst var accesses then we only have to check for context inst var access in long-form bytecodes, and then only if the index is within the context inst var range.  This effectively makes the check free because on modern processors checking an index fetched from memory into a register against a constant costs far less than the memry read to fetch the index.!
!MaybeContextInstanceVariableNode methodsFor: 'accessing' stamp: 'eem 6/19/2008 09:27'!
code
	"Answer a bogus code to avoid creating quick methods.
	 See MethodNode>>generate:ifQuick:"
	^LoadLong! !

!MaybeContextInstanceVariableNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 18:08'!
emitCodeForStore: stack encoder: encoder
	encoder genStoreInstVarLong: index! !

!MaybeContextInstanceVariableNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 18:07'!
sizeCodeForStorePop: encoder
	^encoder sizeStorePopInstVarLong: index! !

!MaybeContextInstanceVariableNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 18:08'!
emitCodeForValue: stack encoder: encoder
	stack push: 1.
	^encoder genPushInstVarLong: index! !

!MaybeContextInstanceVariableNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 17:57'!
sizeCodeForStore: encoder
	^encoder sizeStoreInstVarLong: index! !

!MaybeContextInstanceVariableNode methodsFor: 'code generation' stamp: 'eem 6/19/2008 09:36'!
emitCodeForStorePop: stack encoder: encoder
	encoder genStorePopInstVarLong: index.
	stack pop: 1! !

!MaybeContextInstanceVariableNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 17:53'!
sizeCodeForValue: encoder
	^encoder sizePushInstVarLong: index! !

!MczInstaller commentStamp: 'TorstenBergmann 1/31/2014 10:14'!
An installer for Monticello files with the *.mcz extension. 

   MczInstaller installFileNamed: 'MyKillerApp-Core-Author.1.mcz'!
!MczInstaller methodsFor: 'installation' stamp: 'nicolascellier 6/2/2013 18:38'!
installMember: member
	 
	self useNewChangeSetDuring:
		[ CodeImporter evaluateReadStream: (self contentsForMember: member) readStream.
		]! !

!MczInstaller methodsFor: 'parsing' stamp: 'nicolascellier 6/2/2013 18:36'!
contentsForMember: member
	^[(member contentStreamFromEncoding: 'utf8') text contents] on: ZnInvalidUTF8
		do: [:exc | 
			"Case of legacy encoding, presumably it is latin-1.
			But if contents starts with a null character, it might be a case of WideString encoded in UTF-32BE"
			| str |
			str := (member contentStreamFromEncoding: 'latin1') text.
			exc return: ((str peek = Character null and: [ str size \\ 4 = 0 ])
				ifTrue: [WideString fromByteArray: str contents asByteArray]
				ifFalse: [str contents])]! !

!MczInstaller methodsFor: 'utilities' stamp: 'avi 2/17/2004 02:53'!
checkDependencies
	| dependencies unmet |
	dependencies := (zip membersMatching: 'dependencies/*') 
			collect: [:member | self extractInfoFrom: (self parseMember: member)].
	unmet := dependencies reject: [:dep |
		self versions: Versions anySatisfy: (dep at: #id)].
	^ unmet isEmpty or: [
		self confirm: (String streamContents: [:s|
			s nextPutAll: 'The following dependencies seem to be missing:'; cr.
			unmet do: [:each | s nextPutAll: (each at: #name); cr].
			s nextPutAll: 'Do you still want to install this package?'])]! !

!MczInstaller methodsFor: 'utilities' stamp: 'bf 2/9/2004 15:00'!
versions: aVersionList anySatisfy: aDependencyID
	^ aVersionList anySatisfy: [:version | 
			aDependencyID = (version at: #id)
				or: [self versions: (version at: #ancestors) anySatisfy: aDependencyID]]! !

!MczInstaller methodsFor: 'utilities' stamp: 'avi 2/17/2004 03:26'!
extractInfoFrom: dict
	dict at: #id put: (UUID fromString: (dict at: #id)).
	dict at: #date ifPresent: [:d | d isEmpty ifFalse: [dict at: #date put: (Date fromString: d)]].
	dict at: #time ifPresent: [:t | t isEmpty ifFalse: [dict at: #time put: (Time readFrom: t readStream)]].
	dict at: #ancestors ifPresent: [:a | dict at: #ancestors put: (a collect: [:ea | self extractInfoFrom: ea])].
	^ dict! !

!MczInstaller methodsFor: 'accessing' stamp: 'avi 2/17/2004 02:55'!
stream: aStream
	stream := aStream! !

!MczInstaller methodsFor: 'accessing' stamp: 'cwp 8/13/2003 02:17'!
extractVersionInfo
	^ self extractInfoFrom: (self parseMember: 'version')! !

!MczInstaller methodsFor: 'utilities' stamp: 'nicolascellier 6/2/2013 18:37'!
parseMember: memberOrName
	| member tokens |
	member := self zip member: memberOrName.
	tokens := (self contentsForMember: member) parseLiterals first.
	^ self associate: tokens! !

!MczInstaller methodsFor: 'private' stamp: 'nicolascellier 5/31/2013 23:35'!
contentStreamForMember: member
	^[(member contentStreamFromEncoding: 'utf8') text] on: ZnInvalidUTF8
		do: [:exc | 
			"Case of legacy encoding, presumably it is latin-1 and we do not need to do anything
			But if contents starts with a null character, it might be a case of WideString encoded in UTF-32BE"
			| str |
			str := (member contentStreamFromEncoding: 'latin1') text.
			(str peek = Character null and: [ str size \\ 4 = 0 ])
				ifTrue: [str := (WideString fromByteArray: str contents asByteArray) readStream].
			exc return: str]! !

!MczInstaller methodsFor: 'accessing' stamp: 'md 6/11/2013 10:00'!
zip
	^zip! !

!MczInstaller methodsFor: 'accessing' stamp: 'cwp 8/13/2003 01:58'!
extractPackageName
	^ (self parseMember: 'package') at: #name.
	! !

!MczInstaller methodsFor: 'installation' stamp: 'avi 2/17/2004 02:56'!
install
	| sources |
	zip := ZipArchive new.
	zip readFrom: stream.
	self checkDependencies ifFalse: [^false].
	self recordVersionInfo.
	sources := (zip membersMatching: 'snapshot/*') 
				asSortedCollection: [:a :b | a fileName < b fileName].
	sources do: [:src | self installMember: src].! !

!MczInstaller methodsFor: 'accessing' stamp: 'cwp 8/7/2003 19:18'!
recordVersionInfo
	Versions 
		at: self extractPackageName 
		put: self extractVersionInfo! !

!MczInstaller methodsFor: 'utilities' stamp: 'bf 2/9/2004 13:56'!
useNewChangeSetDuring: aBlock
	| changeHolder oldChanges newChanges |
	changeHolder := (ChangeSet respondsTo: #newChanges:)
						ifTrue: [ChangeSet]
						ifFalse: [Smalltalk].
	oldChanges := (ChangeSet respondsTo: #current)
						ifTrue: [ChangeSet current]
						ifFalse: [Smalltalk changes].

	newChanges := ChangeSet new name: (ChangeSet uniqueNameLike: self extractPackageName).
	changeHolder newChanges: newChanges.
	[aBlock value] ensure: [changeHolder newChanges: oldChanges].! !

!MczInstaller methodsFor: 'utilities' stamp: 'stephane.ducasse 3/31/2009 21:10'!
associate: tokens
	| result |
	result := Dictionary new.
	tokens pairsDo: [:key :value | 
					| tmp |
					tmp := value.
					value isString ifFalse: [tmp := value collect: [:ea | self associate: ea]].
					value = 'nil' ifTrue: [tmp := ''].
					result at: key put: tmp].
	^ result! !

!MczInstaller class methodsFor: 'System-FileRegistry' stamp: 'cwp 8/7/2003 18:49'!
extension
	^ 'mcz'! !

!MczInstaller class methodsFor: 'System-FileRegistry' stamp: 'CamilloBruni 2/3/2013 17:21'!
fileReaderServicesForFile: fileName suffix: suffix
	<fileService>
	^({ self extension. '*' } includes: suffix)
		ifTrue: [ self services ]
		ifFalse: [#()].
! !

!MczInstaller class methodsFor: 'installing' stamp: 'cwp 8/7/2003 17:56'!
installStream: aStream
	(self on: aStream) install! !

!MczInstaller class methodsFor: 'versioninfo' stamp: 'avi 2/17/2004 02:49'!
versionInfo
	^ Versions! !

!MczInstaller class methodsFor: 'versioninfo' stamp: 'avi 1/19/2004 13:13'!
clearVersionInfo
	Versions := Dictionary new! !

!MczInstaller class methodsFor: 'System-FileRegistry' stamp: 'cwp 8/7/2003 18:54'!
loadVersionFile: fileName
	self installFileNamed: fileName
! !

!MczInstaller class methodsFor: 'System-FileRegistry' stamp: 'avi 3/7/2004 14:51'!
initialize
	self clearVersionInfo.
	self registerForFileList.! !

!MczInstaller class methodsFor: 'System-FileRegistry' stamp: 'ab 8/8/2003 18:01'!
services
	^ Array with: self serviceLoadVersion! !

!MczInstaller class methodsFor: 'versioninfo' stamp: 'cwp 8/11/2003 23:49'!
storeVersionInfo: aVersion
	Versions 
		at: aVersion package name
		put: aVersion info asDictionary! !

!MczInstaller class methodsFor: 'installing' stamp: 'cwp 8/7/2003 18:13'!
installFileNamed: aFileName
	self installStream: (FileStream readOnlyFileNamed: aFileName)! !

!MczInstaller class methodsFor: 'instance creation' stamp: 'cwp 8/7/2003 17:56'!
on: aStream
	^ self new stream: aStream! !

!MczInstaller class methodsFor: 'System-FileRegistry' stamp: 'tbn 8/11/2010 10:20'!
serviceLoadVersion
	^ SimpleServiceEntry
		provider: self
		label: 'Load'
		selector: #loadVersionFile:
		description: 'Load a package version'! !

!MczInstaller class methodsFor: 'System-FileRegistry' stamp: 'IgorStasenko 4/15/2011 17:17'!
registerForFileList
	Smalltalk globals at: #MCReader ifAbsent: [ Smalltalk tools fileList registerFileReader: self ]! !

!MemoryFileSystemDirectory commentStamp: '<historical>'!
I represent a memory file system entry for a directory!
!MemoryFileSystemDirectory methodsFor: 'accessing' stamp: 'CamilloBruni 6/17/2013 10:42'!
fileEntryRemove: aFileName
	^ self fileEntryRemove: aFileName ifAbsent: [ FileDoesNotExist signalWith: aFileName ]! !

!MemoryFileSystemDirectory methodsFor: 'accessing' stamp: 'CamilloBruni 6/22/2012 20:02'!
entries
	^ entries! !

!MemoryFileSystemDirectory methodsFor: 'creation' stamp: 'S 6/17/2013 13:32'!
ensureCreateFile: aFileName
	^ self 
		fileEntryAt: aFileName 
		put: (MemoryFileSystemFile named: aFileName)! !

!MemoryFileSystemDirectory methodsFor: 'accessing' stamp: 'CamilloBruni 6/17/2013 10:40'!
fileEntryRemove: aFileName ifAbsent: absentBlock
	| deletedEntry |
	deletedEntry := entries removeKey: aFileName ifAbsent: [ ^ absentBlock value ].
	modificationTime := DateAndTime now.
	^ deletedEntry! !

!MemoryFileSystemDirectory methodsFor: 'testing' stamp: 'CamilloBruni 6/22/2012 20:02'!
isDirectory
	^ true! !

!MemoryFileSystemDirectory methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 14:47'!
fileEntryAt: aFileName ifAbsent: aBlock
	^ entries at: aFileName ifAbsent: aBlock! !

!MemoryFileSystemDirectory methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 14:54'!
fileSize
	^ 0! !

!MemoryFileSystemDirectory methodsFor: 'enumeration' stamp: 'MarcusDenker 10/7/2013 21:24'!
fileEntriesDo: aBlock
	
	entries keys sort do: [ :fileName|
		aBlock value: (entries at: fileName)].! !

!MemoryFileSystemDirectory methodsFor: 'initialization' stamp: 'CamilloBruni 6/22/2012 20:00'!
initialize
	super initialize.
	entries := Dictionary new.! !

!MemoryFileSystemDirectory methodsFor: 'accessing' stamp: 'CamilloBruni 5/24/2013 14:03'!
fileEntriesIncludes: aFileName
	^ entries includesKey: aFileName! !

!MemoryFileSystemDirectory methodsFor: 'creation' stamp: 'MaxLeske 9/27/2014 14:46'!
ensureCreateDirectory: aDirectoryName
	^ self 
		fileEntryAt: aDirectoryName
		put: (self class named: aDirectoryName)! !

!MemoryFileSystemDirectory methodsFor: 'accessing' stamp: 'CamilloBruni 5/24/2013 13:59'!
fileEntryAt: aFileName
	^ entries at: aFileName! !

!MemoryFileSystemDirectory methodsFor: 'accessing' stamp: 'CamilloBruni 5/24/2013 13:55'!
fileEntryAt: aFileName put: anEntry
	^ entries 
		at: aFileName 
		ifAbsentPut: [
			self modified.
			anEntry ]! !

!MemoryFileSystemDirectory methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 14:48'!
fileEntryAt: aFileName ifPresent: aBlock
	^ entries at: aFileName ifPresent: aBlock! !

!MemoryFileSystemEntry commentStamp: '<historical>'!
I am an abstract file system entry for a memory file system.
My subclasses should specialize on the kind of file they are.!
!MemoryFileSystemEntry methodsFor: 'accessing' stamp: 'CamilloBruni 6/22/2012 19:59'!
modificationTime
	
	^ modificationTime! !

!MemoryFileSystemEntry methodsFor: 'initialization' stamp: 'CamilloBruni 6/22/2012 20:27'!
initialize 
	creationTime := modificationTime := DateAndTime now.
	super initialize! !

!MemoryFileSystemEntry methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 14:46'!
basename: aString
	basename := aString! !

!MemoryFileSystemEntry methodsFor: 'accessing' stamp: 'CamilloBruni 6/22/2012 19:59'!
modificationTime: anObject
	
	modificationTime := anObject! !

!MemoryFileSystemEntry methodsFor: 'accessing' stamp: 'CamilloBruni 6/22/2012 19:59'!
creationTime
	
	^ creationTime! !

!MemoryFileSystemEntry methodsFor: 'private' stamp: 'CamilloBruni 6/22/2012 22:05'!
modified
	modificationTime := DateAndTime now.! !

!MemoryFileSystemEntry methodsFor: 'testing' stamp: 'CamilloBruni 6/22/2012 20:13'!
isFile
	^ self isDirectory not! !

!MemoryFileSystemEntry methodsFor: 'testing' stamp: 'PavelKrivanek 11/23/2012 12:21'!
isDirectory
	self subclassResponsibility! !

!MemoryFileSystemEntry methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 14:46'!
basename
	^ basename! !

!MemoryFileSystemEntry methodsFor: 'accessing' stamp: 'PavelKrivanek 11/23/2012 12:21'!
fileSize
	self subclassResponsibility ! !

!MemoryFileSystemEntry class methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 7/10/2012 14:53'!
named: aFileName
	^ self new
		basename: aFileName;
		yourself! !

!MemoryFileSystemFile commentStamp: '<historical>'!
I represent a memory file system entry for a regular file!
!MemoryFileSystemFile methodsFor: 'stream-protocol' stamp: 'CamilloBruni 6/22/2012 22:15'!
copyFrom: from to: position
	^ bytes copyFrom: from to: position! !

!MemoryFileSystemFile methodsFor: 'stream-protocol' stamp: 'CamilloBruni 6/23/2012 19:58'!
grow
	self grownBy: self sizeIncrement! !

!MemoryFileSystemFile methodsFor: 'private' stamp: 'MaxLeske 9/27/2014 22:27'!
updateSize: newSize
	size := newSize.
	modificationTime := nil! !

!MemoryFileSystemFile methodsFor: 'streams-compatibility' stamp: 'MaxLeske 9/27/2014 10:08'!
binaryReadStream
	^ ReadStream on: self bytes from: 1 to: size! !

!MemoryFileSystemFile methodsFor: 'stream-protocol' stamp: 'CamilloBruni 6/22/2012 21:25'!
at: first write: aCollection startingAt: start count: count 
	| last |
	last := first + count - 1.
	last > bytes size ifTrue: [ self grownBy: last - size ].
	bytes 
		replaceFrom: first
		to: last
		with: aCollection
		startingAt: start.
	size := last! !

!MemoryFileSystemFile methodsFor: 'testing' stamp: 'CamilloBruni 6/22/2012 20:02'!
isDirectory
	^ false! !

!MemoryFileSystemFile methodsFor: 'stream-protocol' stamp: 'MaxLeske 9/27/2014 10:09'!
readStream
	^ ReadStream on: self bytes asString from: 1 to: size! !

!MemoryFileSystemFile methodsFor: 'accessing' stamp: 'CamilloBruni 6/22/2012 20:57'!
sizeIncrement
	^ (bytes size min: 20) max: 1024! !

!MemoryFileSystemFile methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 14:54'!
fileSize
	^ size! !

!MemoryFileSystemFile methodsFor: 'stream-protocol' stamp: 'CamilloBruni 6/22/2012 20:54'!
at: index read: aCollection startingAt: start count: count 
	| max stop |
	max := size - index + 1 min: count.
	stop := start + max - 1.
	aCollection 
		replaceFrom: start
		to: stop
		with: bytes
		startingAt: index.
	^ stop - start + 1! !

!MemoryFileSystemFile methodsFor: 'initialization' stamp: 'CamilloBruni 6/22/2012 20:53'!
initialize
	super initialize.
	bytes := #[].
	size := 0! !

!MemoryFileSystemFile methodsFor: 'stream-protocol' stamp: 'CamilloBruni 6/22/2012 20:53'!
at: index put: anObject
	index > bytes size
		 ifTrue: [ self grow ].
		
	bytes at: index put: (anObject isCharacter
		ifTrue: [ anObject codePoint ]
		ifFalse: [ anObject ]).
	
	size := size max: index! !

!MemoryFileSystemFile methodsFor: 'stream-protocol' stamp: 'CamilloBruni 6/22/2012 20:54'!
at: index
	self flag: #todo. "out of bounds checks?"
	^ bytes at: index! !

!MemoryFileSystemFile methodsFor: 'stream-protocol' stamp: 'MaxLeske 9/26/2014 16:50'!
writeStreamDo: aBlock
	| stream |
	stream := WriteStream on: ByteArray new.
	[ aBlock value: stream ] ensure: [ stream close ].
	bytes := stream contents.
	self updateSize: bytes size! !

!MemoryFileSystemFile methodsFor: 'accessing' stamp: 'CamilloBruni 6/23/2012 18:48'!
bytes
	^ bytes! !

!MemoryFileSystemFile methodsFor: 'accessing' stamp: 'CamilloBruni 6/22/2012 22:10'!
grownBy: length
	bytes := bytes grownBy: length.
	
	self modified.! !

!MemoryFileSystemFile methodsFor: 'accessing' stamp: 'CamilloBruni 6/23/2012 18:48'!
internalSize
	^ bytes size! !

!MemoryFileSystemFile methodsFor: 'accessing' stamp: 'CamilloBruni 6/23/2012 20:16'!
truncate
	self truncateTo: size! !

!MemoryFileSystemFile methodsFor: 'accessing' stamp: 'nice 11/17/2013 23:03'!
truncateTo: aSize
	bytes size = aSize
		ifFalse: [bytes := bytes size < aSize
			ifTrue: [(ByteArray new: aSize)
				replaceFrom: 1 to: bytes size with: bytes startingAt: 1]
			ifFalse: [bytes copyFrom: 1 to: aSize]].
	size := bytes size.
	self modified.! !

!MemoryFileSystemTest commentStamp: 'TorstenBergmann 1/31/2014 11:48'!
SUnit tests for MemoryFileSystem!
!MemoryFileSystemTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/3/2012 11:42'!
testEqual
	| other |
	other := self createFileSystem.
	self deny: filesystem = other! !

!MemoryFileSystemTest methodsFor: 'initialize-release' stamp: 'EstebanLorenzano 4/3/2012 13:04'!
createFileSystem
	^ FileSystem memory! !

!MemoryFileSystemTest methodsFor: 'tests' stamp: 'VincentBlondeau 1/30/2015 15:01'!
testIsMemoryFileSystem
	self assert: filesystem isMemoryFileSystem.
	! !

!MemoryHandle commentStamp: '<historical>'!
I provide "primitives" for doing IO on files in a MemoryFileSystem. I delegate most of my actions to the MemoryFile. This way there is only one place needed where the data is stored.!
!MemoryHandle methodsFor: 'stream-protocol' stamp: 'CamilloBruni 6/23/2012 19:57'!
copyFrom: from to: position
	^ entry copyFrom: from to: position! !

!MemoryHandle methodsFor: 'private' stamp: 'CamilloBruni 6/22/2012 20:56'!
grow
	entry grow! !

!MemoryHandle methodsFor: 'public' stamp: 'CamilloBruni 6/23/2012 18:48'!
size
	"return the size for the interna"
	^ entry internalSize! !

!MemoryHandle methodsFor: 'public' stamp: 'CamilloBruni 6/23/2012 20:06'!
close
	self isOpen ifFalse: [ ^ self ].
	self truncate.
	entry := nil.! !

!MemoryHandle methodsFor: 'testing' stamp: 'CamilloBruni 6/22/2012 20:57'!
isOpen
	^ entry notNil! !

!MemoryHandle methodsFor: 'streams-compatibility' stamp: 'MaxLeske 1/25/2014 23:03'!
binaryReadStream
	^ entry binaryReadStream! !

!MemoryHandle methodsFor: 'public' stamp: 'CamilloBruni 6/22/2012 20:55'!
at: first write: aCollection startingAt: start count: count 
	writable ifFalse: [ self primitiveFailed ].
	entry at: first write: aCollection startingAt: start count: count.! !

!MemoryHandle methodsFor: 'stream-protocol' stamp: 'DamienCassou 11/27/2013 17:35'!
readStream
	"Return a readstream on my contents.
	Using myself as target collection allows to share the internal bytearray between multiple streams."
	^ entry readStream! !

!MemoryHandle methodsFor: 'public' stamp: 'CamilloBruni 6/22/2012 20:55'!
at: index read: aCollection startingAt: start count: count 
	^ entry at: index read: aCollection startingAt: start count: count ! !

!MemoryHandle methodsFor: 'public' stamp: 'CamilloBruni 6/22/2012 20:52'!
at: index put: anObject
	^ entry at: index put: anObject! !

!MemoryHandle methodsFor: 'public' stamp: 'CamilloBruni 6/22/2012 20:52'!
at: index
	^ entry at: index! !

!MemoryHandle methodsFor: 'stream-protocol' stamp: 'CamilloBruni 7/10/2012 14:54'!
writeStream
	"Return a writestream on my contents.
	Using myself as target collection allows to share the internal bytearray between multiple streams."
	^ WriteStream on: self from: 1 to: entry fileSize! !

!MemoryHandle methodsFor: 'public' stamp: 'CamilloBruni 6/22/2012 20:56'!
flush
	self truncate! !

!MemoryHandle methodsFor: 'public' stamp: 'CamilloBruni 6/22/2012 20:57'!
open
	entry := self basicOpen.! !

!MemoryHandle methodsFor: 'stream-protocol' stamp: 'CamilloBruni 6/23/2012 18:47'!
grownBy: length
	entry grownBy: length! !

!MemoryHandle methodsFor: 'public' stamp: 'CamilloBruni 6/22/2012 20:58'!
truncate
	entry truncate! !

!MemoryHandle methodsFor: 'public' stamp: 'CamilloBruni 6/23/2012 20:16'!
truncateTo: anInteger
	entry truncateTo: anInteger! !

!MemoryHandleTest commentStamp: 'TorstenBergmann 1/31/2014 11:49'!
SUnit tests for memory handles, the tests may be found in superclass!
!MemoryHandleTest methodsFor: 'running' stamp: 'EstebanLorenzano 4/3/2012 12:51'!
createFileSystem
	^ FileSystem memory! !

!MemoryStore commentStamp: '<historical>'!
I'm a specific store for memory file system!
!MemoryStore methodsFor: 'accessing' stamp: 'cwp 2/18/2011 12:46'!
root
	^ root! !

!MemoryStore methodsFor: 'private' stamp: 'CamilloBruni 5/5/2013 01:17'!
basicEntry: directoryEntry path: aPath nodesDo: aBlock
	directoryEntry fileEntriesDo: aBlock! !

!MemoryStore methodsFor: 'private' stamp: 'CamilloBruni 6/22/2012 21:06'!
basicOpen: path writable: aBoolean
	^ self
		nodeAt: path
		ifPresent: [ :aMemoryFileSystemEntry | aMemoryFileSystemEntry ]
		ifAbsent: [ 
			aBoolean
				ifFalse: [ self signalFileDoesNotExist: path ]
				ifTrue: [ self createFile: path ] ]! !

!MemoryStore methodsFor: 'public' stamp: 'S 6/17/2013 13:33'!
createDirectory: path
	| parent |
	parent := path parent.
	^ self
		nodeAt: parent
		ifPresent: [ :entry | 
			entry
				fileEntryAt: path basename
				ifPresent: [ :node | 
					node isDirectory
						ifTrue: [ self signalDirectoryExists: path ]
						ifFalse: [ self signalFileExists: path ] ].
			entry ensureCreateDirectory: path basename  ]
		ifAbsent: [ self signalDirectoryDoesNotExist: parent ]! !

!MemoryStore methodsFor: 'public' stamp: 'CamilloBruni 5/24/2013 14:05'!
rename: sourcePath to: destinationPath
	| sourceEntry destinationParentEntry newName |
	
	sourceEntry := self nodeAt: sourcePath.
	newName := destinationPath basename.
	
	destinationParentEntry := self nodeAt: destinationPath parent.
	
	destinationParentEntry isDirectory
		ifFalse: [ Error signal: 'Copy destination has to be a directory' ].
	destinationParentEntry 
		fileEntryAt: newName
		ifPresent: [ Error signal: 'Destination file exists already' ].
		
	destinationParentEntry 
		fileEntryAt: newName
		put: sourceEntry.
	sourceEntry basename: newName.
	
	
	(self nodeAt: sourcePath parent)
		fileEntryRemove: sourcePath basename 
	! !

!MemoryStore methodsFor: 'initialization' stamp: 'CamilloBruni 6/22/2012 20:16'!
initialize 
	root := MemoryFileSystemDirectory new! !

!MemoryStore methodsFor: 'private' stamp: 'CamilloBruni 7/10/2012 21:18'!
basicPosixPermissions: anEntry
	^ 8r777! !

!MemoryStore methodsFor: 'private' stamp: 'EstebanLorenzano 8/2/2012 15:39'!
basicIsSymlink: aNode
	^false! !

!MemoryStore methodsFor: 'public' stamp: 'CamilloBruni 6/22/2012 21:21'!
openFileStream: path writable: isWriteStream
	| entry |
	entry := self basicOpen: path writable: isWriteStream.
	^ isWriteStream 
		ifTrue: [ entry writeStream ]
		ifFalse: [ entry readStream ]! !

!MemoryStore methodsFor: 'private' stamp: 'CamilloBruni 6/22/2012 20:30'!
basicIsDirectory: aMemoryFileSystemEntry
	^ aMemoryFileSystemEntry isDirectory! !

!MemoryStore methodsFor: 'printing' stamp: 'CamilloBruni 9/5/2012 17:43'!
forReferencePrintOn: aStream
	aStream nextPutAll: 'memory://'! !

!MemoryStore methodsFor: 'public' stamp: 'CamilloBruni 6/17/2013 10:51'!
delete: path
	self 
		nodeAt: path parent
		ifPresent: [ :dict | 
			dict fileEntryRemove: path basename ifAbsent: [ FileDoesNotExist signalWith: path ]] 
		ifAbsent: [ DirectoryDoesNotExist signalWith: path parent ]! !

!MemoryStore methodsFor: 'private' stamp: 'CamilloBruni 6/22/2012 20:04'!
basicIsFile: aMemoryFileSystemEntry
	^ aMemoryFileSystemEntry isFile! !

!MemoryStore methodsFor: 'private' stamp: 'DamienCassou 6/8/2013 10:52'!
copy: sourcePath ifAbsent: absentBlock to: destinationPath ifPresent: presentBlock fileSystem: aFilesystem
        | sourceNode destinationNode |

        sourceNode := self
                nodeAt: sourcePath
                ifPresent: [ :source | source ]
                ifAbsent: [ ^ absentBlock value].

        sourceNode isDirectory
                ifTrue: [ ^ absentBlock value ].

        destinationNode := self
                nodeAt: destinationPath parent
                ifPresent: [ :destination |  destination ]
                ifAbsent: [ ^ self signalDirectoryDoesNotExist: destinationPath parent ].

        destinationNode isFile
                ifTrue: [ self signalDirectoryDoesNotExist: destinationPath parent ].

        (destinationNode fileEntriesIncludes: destinationPath basename)
                ifTrue: [ "cannot overwrite existing file"^ presentBlock value ].

        destinationNode
                fileEntryAt: destinationPath basename
                put: (sourceNode copy
                                        basename: destinationPath basename;
                                        yourself)
! !

!MemoryStore methodsFor: 'private' stamp: 'S 6/17/2013 13:32'!
createFile: aPath
	^ self
		nodeAt: aPath parent
		ifPresent: [ :entry | 
			entry isDirectory
				ifTrue: [ entry ensureCreateFile: aPath basename ]]
		ifAbsent: [ self signalDirectoryDoesNotExist: aPath parent ]! !

!MemoryStore methodsFor: 'private' stamp: 'CamilloBruni 7/10/2012 14:52'!
nodeAt: aPath ifPresent: presentBlock ifAbsent: absentBlock
	| current |
	current := self root.
	aPath do: [ :segment | 
		current isDirectory
			ifTrue: [ current := current fileEntryAt: segment ifAbsent: [ ^ absentBlock value ]]
			ifFalse: [ ^ absentBlock value ]].
	^ presentBlock value: current! !

!MemoryStore methodsFor: 'private' stamp: 'CamilloBruni 5/5/2013 01:13'!
basicEntry: entry nodesDo: aBlock
	entry fileEntriesDo: aBlock! !

!MemoryStore methodsFor: 'private' stamp: 'CamilloBruni 7/10/2012 21:13'!
basicSize: aMemoryFileSystemEntry
	^ aMemoryFileSystemEntry fileSize! !

!MemoryStore methodsFor: 'private' stamp: 'CamilloBruni 7/10/2012 14:52'!
replaceFile: path in: aBlock
	^ self
		nodeAt: path parent
		ifPresent: [ :entry | | old new |
			entry isDirectory
				ifFalse: [ self signalFileDoesNotExist: path ].
			old := entry fileEntryAt: path basename ifAbsent: [ self signalFileDoesNotExist: path ].
			new := aBlock value: old.
			entry fileEntryAt: path basename put: new ]
		ifAbsent: [ self signalFileDoesNotExist: path ]! !

!MemoryStore methodsFor: 'testing' stamp: 'VincentBlondeau 1/30/2015 14:56'!
isMemoryFileSystem
	^ true! !

!MemoryStore methodsFor: 'public' stamp: 'CamilloBruni 7/10/2012 14:51'!
basenameFromEntry: aMemoryFileSystemEntry
	^ aMemoryFileSystemEntry basename! !

!MemoryStore methodsFor: 'accessing' stamp: 'EstebanLorenzano 4/3/2012 09:36'!
handleClass
	^ MemoryHandle ! !

!MemoryStore methodsFor: 'private' stamp: 'CamilloBruni 7/10/2012 20:57'!
basicCreationTime: aMemoryFileSystemEntry
	^ aMemoryFileSystemEntry creationTime! !

!MemoryStore methodsFor: 'public' stamp: 'CamilloBruni 5/10/2012 16:02'!
checkName: aString fixErrors: fixErrors
	aString ifEmpty: [ self error: 'zero length file name' ].
	^ aString! !

!MemoryStore methodsFor: 'private' stamp: 'CamilloBruni 7/10/2012 20:57'!
basicModificationTime: aMemoryFileSystemEntry
	^ aMemoryFileSystemEntry modificationTime! !

!MemoryStore class methodsFor: 'public' stamp: 'CamilloBruni 5/7/2012 01:20'!
isCaseSensitive
	^ true! !

!MemoryStore class methodsFor: 'public' stamp: 'CamilloBruni 5/7/2012 01:11'!
separator 
	^ $:! !

!MemoryStore class methodsFor: 'public' stamp: 'cwp 2/18/2011 17:19'!
delimiter
	^ $/! !

!MenuCapturingMorph commentStamp: 'SeanDeNigris 2/20/2014 08:47'!
It's difficult to test whether menus appear because the test might block the UI thread and prevent it.

I use Morphic stepping to monitor the world for a new menu. If I find one, you can get it by sending me #menu.!
!MenuCapturingMorph methodsFor: 'menu' stamp: 'SeanDeNigris 12/14/2011 14:06'!
menu

	^ menu.! !

!MenuCapturingMorph methodsFor: 'stepping and presenter' stamp: 'SeanDeNigris 12/14/2011 14:08'!
step

	menu := World submorphs detect: [ :m | m isKindOf: MenuMorph ] ifNone: [ menu ].
	menu isNil ifFalse: [ 
		menu delete.
		self delete ].! !

!MenuGroupModel commentStamp: '<historical>'!
I am a group of menu items.

I am part of a menu, and groups items by meaning!
!MenuGroupModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/1/2013 18:33'!
autoRefresh: aBoolean

	autoRefresh value: aBoolean! !

!MenuGroupModel methodsFor: 'initialization' stamp: 'StephaneDucasse 2/26/2015 16:34'!
initialize
	super initialize.
	items := OrderedCollection new asValueHolder.
	autoRefresh := nil asValueHolder.
	autoRefresh whenChangedDo: [ :aBoolean | self menuItems do: [ :each | each autoRefresh: aBoolean ] ]! !

!MenuGroupModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/1/2013 14:07'!
menuItems

	^ items value! !

!MenuGroupModel methodsFor: 'private' stamp: 'StephaneDucasse 2/27/2015 21:20'!
buildWithSpecLayout: aSpecLayout
	"Build the widget using the spec name provided as argument"
	| adapter widget|
	adapter := self adapterFrom: aSpecLayout model: self.
	widget := adapter asWidget.
	self announce: (WidgetBuilt model: self widget: widget).
	^ widget! !

!MenuGroupModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/1/2013 18:34'!
addMenuItem: aMenuItem

	items add: aMenuItem.
	self autoRefresh 
		ifNotNil: [ aMenuItem autoRefresh: self autoRefresh ]! !

!MenuGroupModel methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 1/11/2014 20:11'!
isEmpty

	^ items isEmpty! !

!MenuGroupModel methodsFor: 'api-building' stamp: 'BenjaminVanRyseghem 11/29/2013 15:01'!
fromSpec: aSpec

	aSpec addToMenuGroupModel: self! !

!MenuGroupModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/1/2013 15:34'!
addItem: aBlock
	| item |
	
	item := MenuItemModel new.
	aBlock value: item.
	self addMenuItem: item! !

!MenuGroupModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/1/2013 18:33'!
autoRefresh

	^ autoRefresh value! !

!MenuGroupModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 11/1/2013 16:25'!
defaultSpec
	<spec: #default>
	
	^ #(MenuGroupAdapter
		adapt: #(model))! !

!MenuGroupModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/13/2014 15:22'!
adapterName

	^ #MenuGroupAdapter! !

!MenuItemModel commentStamp: '<historical>'!
I represent a menu item.

I have a name, a description, an icon, a shortcut, and an action to perform (aBlock).

I can also have a sub menu.
(and usually I do NOT have an action AND a sub menu)!
!MenuItemModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/1/2013 15:08'!
state: aBoolean

	state value: aBoolean! !

!MenuItemModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
subMenu: aMenuModel

	subMenu value: aMenuModel! !

!MenuItemModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/1/2013 18:14'!
description

	^ description value! !

!MenuItemModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/1/2013 15:08'!
enabled

	^ enabled value! !

!MenuItemModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 1/10/2014 15:19'!
performMenuActionWith: aMenuItem
	| en |

	en := self enabled.
	en isBlock ifTrue: [ en := en value ].
	en ifFalse: [ ^ self ].

	action value cull: aMenuItem! !

!MenuItemModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
shortcut: aShortcut

	shortcut value: aShortcut! !

!MenuItemModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/1/2013 15:07'!
action: aBlock

	action value: aBlock! !

!MenuItemModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
shortcut

	^ shortcut value! !

!MenuItemModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/1/2013 18:30'!
autoRefresh: aBlock

	autoRefresh value: aBlock! !

!MenuItemModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/29/2013 15:26'!
icon: anIcon

	icon value: anIcon! !

!MenuItemModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/1/2013 15:08'!
state

	^ state value! !

!MenuItemModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
subMenu

	^ subMenu value! !

!MenuItemModel methodsFor: 'api-building' stamp: 'BenjaminVanRyseghem 11/29/2013 15:02'!
fromSpec: aSpec

	aSpec addToMenuItemModel: self! !

!MenuItemModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/1/2013 15:10'!
action

	^ action value! !

!MenuItemModel methodsFor: 'initialization' stamp: 'DucasseStephane 9/10/2014 09:59'!
initialize

	super initialize.

	action := [] asValueHolder.
	enabled := true asValueHolder.
	state := nil asValueHolder.
	description := nil asValueHolder.
	name := '' asValueHolder.
	shortcut := nil asValueHolder.
	subMenu := nil asValueHolder.
	autoRefresh := false asValueHolder.
	icon := nil asValueHolder! !

!MenuItemModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
name: aString

	name value: aString! !

!MenuItemModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/1/2013 18:14'!
description: aString

	description value: aString! !

!MenuItemModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/1/2013 18:30'!
autoRefresh

	^ autoRefresh value! !

!MenuItemModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/1/2013 15:08'!
enabled: aBoolean

	enabled value: aBoolean! !

!MenuItemModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
name

	^ name value! !

!MenuItemModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/1/2013 17:56'!
icon

	^ icon value! !

!MenuItemModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 11/1/2013 16:25'!
defaultSpec
	<spec: #default>
	
	^ #(MenuItemAdapter
		adapt: #(model))! !

!MenuItemModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/13/2014 15:22'!
adapterName

	^ #MenuItemAdapter! !

!MenuItemMorph commentStamp: 'StephaneDucasse 4/22/2012 16:43'!
I represent an item in a menu.



Instance variables:
	isEnabled 	<Boolean>	True if the menu item can be executed.
	subMenu 	<MenuMorph | nil>	The submenu to activate automatically when the user mouses over the item.
	isSelected 	<Boolean>	True if the item is currently selected.
	target 		<Object>		The target of the associated action.
	selector 		<Symbol>	The associated action.
	arguments 	<Array>		The arguments for the associated action.
	icon		<Form | nil>	An optional icon form to be displayed to my left.

!
!MenuItemMorph methodsFor: 'accessing' stamp: 'nk 3/10/2004 15:19'!
hasIcon
	"Answer whether the receiver has an icon."
	^ icon notNil! !

!MenuItemMorph methodsFor: 'accessing' stamp: 'gvc 10/17/2008 14:43'!
enabled
	"Delegate to exisitng method."

	^self isEnabled! !

!MenuItemMorph methodsFor: 'events' stamp: 'MarcusDenker 12/11/2009 07:40'!
themeChanged
	"Also pass on to the submenu if any."

	super themeChanged.
	self subMenu ifNotNil: [:m | m themeChanged]! !

!MenuItemMorph methodsFor: 'events' stamp: 'ar 10/10/2000 01:38'!
activateOwnerMenu: evt
	"Activate our owner menu; e.g., pass control to it"
	owner ifNil:[^false]. "not applicable"
	(owner fullContainsPoint: evt position) ifFalse:[^false].
	owner activate: evt.
	^true! !

!MenuItemMorph methodsFor: 'selecting' stamp: 'dgd 9/9/2004 21:26'!
isSelected
	^ isSelected ! !

!MenuItemMorph methodsFor: 'private' stamp: 'StephaneDucasse 4/23/2012 12:26'!
offImage
	"Return the form to be used for indicating an off marker"
	| form |
	form := Form extent: (self fontToUse ascent-2) asPoint depth: 16.
	(form getCanvas)
		frameAndFillRectangle: form boundingBox fillColor: (Color gray: 0.9) 
			borderWidth: 1 borderColor: Color black.
	^form! !

!MenuItemMorph methodsFor: 'events' stamp: 'jm 11/4/97 07:15'!
handlesMouseDown: evt

	^ true
! !

!MenuItemMorph methodsFor: 'private' stamp: 'dgd 3/31/2006 12:16'!
upArrow
	^ ColorForm
		mappingWhiteToTransparentFrom: ((SubMenuMarker rotateBy: 270)asFormOfDepth: 8)! !

!MenuItemMorph methodsFor: 'accessing' stamp: 'sw 10/3/2002 20:50'!
allWordingsNotInSubMenus: verbotenSubmenuContentsList
	"Answer a collection of the wordings of all items and subitems, but omit the stay-up item, and also any items in any submenu whose tag is in verbotenSubmenuContentsList"

	self isStayUpItem ifTrue:[^ #()].
	subMenu ifNotNil:
		[^ (verbotenSubmenuContentsList includes: self contents asString)
			ifTrue:
				[#()]
			ifFalse:
				[subMenu allWordingsNotInSubMenus: verbotenSubmenuContentsList]].

	^ Array with: self contents asString! !

!MenuItemMorph methodsFor: 'events' stamp: 'ar 9/16/2000 14:40'!
handlesMouseOver: anEvent
	^true! !

!MenuItemMorph methodsFor: 'initialization' stamp: 'dgd 3/7/2003 15:07'!
defaultBounds
"answer the default bounds for the receiver"
	^ 0 @ 0 extent: 10 @ 10! !

!MenuItemMorph methodsFor: 'initialization' stamp: 'AlainPlantec 11/29/2009 22:02'!
initialize
	"initialize the state of the receiver"
	super initialize.
	""
	
	contents := ''.
	hasFocus := false.
	isEnabled := true.
	subMenu := nil.
	isSelected := false.
	target := nil.
	selector := nil.
	arguments := nil.
	font := StandardFonts menuFont.
	self hResizing: #spaceFill;
		 vResizing: #shrinkWrap! !

!MenuItemMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 5/23/2013 18:38'!
contents: aString withMarkers: aBool inverse: inverse 
	"Set the menu item entry. If aBool is true, parse aString for embedded markers."

	| markerIndex marker |
	self contentString: nil.	"get rid of old"
	aBool ifFalse: [^super contents: aString].
	self removeAllMorphs.	"get rid of old markers if updating"
	self hasIcon ifTrue: [ self icon: nil ].
	self flag: #CleanYesNoOnOffAfter.
	(aString isKindOf: Association)
		ifTrue: [ super contents: aString value. 
				marker := aString key   
					ifTrue: [self onImage]
					ifFalse: [self offImage]]
		ifFalse: [
		(aString notEmpty and: [aString first = $<]) 
			ifFalse: [^super contents: aString].
		markerIndex := aString indexOf: $>.
		markerIndex = 0 ifTrue: [^super contents: aString].
	marker := (aString copyFrom: 1 to: markerIndex) asLowercase.
	(#('<on>' '<off>' '<yes>' '<no>') includes: marker) 
		ifFalse: [^super contents: aString].
	self contentString: aString.	"remember actual string"
	marker := (marker = '<on>' or: [marker = '<yes>']) ~= inverse 
				ifTrue: [self onImage]
				ifFalse: [self offImage].
	super contents:  (aString copyFrom: markerIndex + 1 to: aString size)].
	"And set the marker"
	marker := ImageMorph new form: marker.
	marker position: self left @ (self top + 2).
	self addMorphFront: marker! !

!MenuItemMorph methodsFor: '*GT-SpotterExtensions-Core' stamp: 'AliakseiSyrel 1/29/2015 03:21'!
spotterPreviewMenuIn: aComposite
	<spotterPreview: 10>
	
	aComposite list
		title: [ self contents ];
		display: #yourself;
		format: [ :item | 
			GTSpotterItemBrick new 
				text: item contents; 
				icon: item icon; 
				disable;
				yourself ];
		styled: [ :brick | brick ];
		entity: (self hasSubMenu ifFalse: [ {self} ] ifTrue: [ self subMenu allItems ]).
		
	self flag: 'move "entity: self" somewhere else, maybe'! !

!MenuItemMorph methodsFor: 'private' stamp: 'StephaneDucasse 9/28/2014 15:52'!
subMenuMarker
	"private - answer the form to be used as submenu marker"
	 ^ self rightArrow! !

!MenuItemMorph methodsFor: 'copying' stamp: 'dgd 3/22/2003 14:56'!
veryDeepInner: deepCopier 
	"Copy all of my instance variables. Some need to be not copied  
	at all, but shared. Warning!!!! Every instance variable defined in  
	this class must be handled. We must also implement  
	veryDeepFixupWith:. See DeepCopier class comment."
	super veryDeepInner: deepCopier.
	isEnabled := isEnabled veryDeepCopyWith: deepCopier.
	subMenu := subMenu veryDeepCopyWith: deepCopier.
	isSelected := isSelected veryDeepCopyWith: deepCopier.
	icon := icon veryDeepCopyWith: deepCopier.
	"target := target.		Weakly copied"
	"selector := selector.		a Symbol"
	arguments := arguments! !

!MenuItemMorph methodsFor: 'private' stamp: 'StephaneDucasse 4/23/2012 12:26'!
onImage
	"Return the form to be used for indicating an on marker"
	| form |
	form := Form extent: (self fontToUse ascent-2) asPoint depth: 16.
	(form getCanvas)
		frameAndFillRectangle: form boundingBox fillColor: (Color gray: 0.8) 
			borderWidth: 1 borderColor: Color black;
		fillRectangle: (form boundingBox insetBy: 2) fillStyle: Color black.
	^form! !

!MenuItemMorph methodsFor: 'events' stamp: 'StephaneDucasse 6/26/2013 14:39'!
invokeWithEvent: evt
	"Perform the action associated with the given menu item."

	| w |
	self isEnabled ifFalse: [^ self].
	owner ifNotNil:[self isStayUpItem ifFalse:[
		self flag: #workAround. "The tile system invokes menus straightforwardly so the menu might not be in the world."
		(w := self world) ifNotNil:[
			owner deleteIfPopUp: evt.
			"Repair damage before invoking the action for better feedback"
			w displayWorldSafely]]].
	selector ifNil:[^self].
	Cursor normal showWhile: [ | selArgCount |  "show cursor in case item opens a new MVC window"
		(selArgCount := selector numArgs) = 0
			ifTrue:
				[target perform: selector]
			ifFalse:
				[selArgCount = arguments size
					ifTrue: [target perform: selector withArguments: arguments]
					ifFalse: [target perform: selector withArguments: (arguments copyWith: evt)]].
		self changed].! !

!MenuItemMorph methodsFor: 'private' stamp: 'AlainPlantec 12/19/2009 14:13'!
selectionFillStyle
	"answer the fill style to use with the receiver is the selected  
	element"
	Display depth <= 2 ifTrue: [^ Color gray].
	^ self theme settings menuSelectionColor.
! !

!MenuItemMorph methodsFor: 'accessing' stamp: 'jm 11/4/97 07:46'!
target: anObject

	target := anObject.
! !

!MenuItemMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 8/5/2014 10:39'!
drawBackgroundOnAthensCanvas: anAthensCanvas
	(isSelected and: [ isEnabled ])
		ifFalse: [ ^ self ].
	anAthensCanvas setPaint: self selectionFillStyle.
	anAthensCanvas drawShape: (0 @ 0 extent: self extent)! !

!MenuItemMorph methodsFor: 'accessing' stamp: 'ar 1/16/2001 16:57'!
contents: aString withMarkers: aBool
	^self contents: aString withMarkers: aBool inverse: false! !

!MenuItemMorph methodsFor: 'drawing' stamp: 'StephaneDucasse 9/28/2014 15:53'!
drawOn: aCanvas 
	| stringColor stringBounds |
	(isSelected and: [ isEnabled ])
		ifTrue: [aCanvas fillRectangle: self bounds fillStyle: self selectionFillStyle.
			stringColor := color negated]
		ifFalse: [stringColor := color].
	stringBounds := bounds.
	self hasIcon
		ifTrue: [| iconForm | 
			iconForm := self iconForm.
			aCanvas translucentImage: iconForm at: stringBounds left @ (self top + (self height - iconForm height // 2)).
			stringBounds := stringBounds left: stringBounds left + iconForm width + 2].
	self hasMarker
		ifTrue: [stringBounds := stringBounds left: stringBounds left + self submorphBounds width + 8].
	stringBounds := stringBounds top: stringBounds top + stringBounds bottom - self fontToUse height // 2.
	aCanvas
		drawString: self contents
		in: stringBounds
		font: self fontToUse
		color: stringColor.
	self hasSubMenu
		ifTrue: [| subMenuMarker subMenuMarkerPosition | 
			subMenuMarker := self subMenuMarker.
			subMenuMarkerPosition := self right - subMenuMarker width @ (self top + self bottom - subMenuMarker height // 2).
			aCanvas paintImage: subMenuMarker at: subMenuMarkerPosition]! !

!MenuItemMorph methodsFor: 'accessing' stamp: 'ar 9/18/2000 11:18'!
hasSubMenu: aMenuMorph
	subMenu ifNil:[^false].
	subMenu == aMenuMorph ifTrue:[^true].
	^subMenu hasSubMenu: aMenuMorph! !

!MenuItemMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 8/5/2014 10:51'!
drawOnAthensCanvas: anAthensCanvas
	| bnd |
	bnd := self bounds topLeft + self layoutInset.
	anAthensCanvas pathTransform
		restoreAfter: [ 
			anAthensCanvas pathTransform translateBy: bnd.
			self drawBackgroundOnAthensCanvas: anAthensCanvas.
			self drawIconAndLabelOnAthensCanvas: anAthensCanvas.
			self drawSubMenuMarkerOnAthensCanvas: anAthensCanvas ]! !

!MenuItemMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 8/5/2014 10:45'!
drawIconAndLabelOnAthensCanvas: anAthensCanvas
	anAthensCanvas pathTransform
		restoreAfter: [ 
			self drawIconOnAthensCanvas: anAthensCanvas.
			self drawLabelOnAthensCanvas: anAthensCanvas ]! !

!MenuItemMorph methodsFor: 'accessing' stamp: 'ar 1/16/2001 16:58'!
contentString
	^self valueOfProperty: #contentString! !

!MenuItemMorph methodsFor: 'private' stamp: 'dgd 3/31/2006 12:15'!
bottomArrow
	^ ColorForm
		mappingWhiteToTransparentFrom: ((SubMenuMarker rotateBy: 90) asFormOfDepth:8)! !

!MenuItemMorph methodsFor: 'accessing' stamp: 'jm 11/4/97 07:46'!
selector: aSymbol

	selector := aSymbol.
! !

!MenuItemMorph methodsFor: 'accessing' stamp: 'AlainPlantec 10/20/2010 00:23'!
icon: aForm 
	"change the the receiver's icon"
	icon := aForm.
	"self height: self minHeight.
	self width: self minWidth"! !

!MenuItemMorph methodsFor: 'events' stamp: 'StephaneDucasse 9/28/2014 16:00'!
mouseEnter: evt
	"The mouse entered the receiver"

	owner ifNotNil: [owner stayUp ifFalse: [self mouseEnterDragging: evt]].! !

!MenuItemMorph methodsFor: 'accessing' stamp: 'GuillermoPolito 9/1/2010 18:44'!
contentString: aString 
	aString ifNil: [self removeProperty: #contentString]
		ifNotNil: [self setProperty: #contentString toValue: aString]! !

!MenuItemMorph methodsFor: 'grabbing' stamp: 'GuillermoPolito 5/29/2011 14:47'!
aboutToBeGrabbedBy: aHand
	"Don't allow the receiver to act outside a Menu"
	| menu box |
	(owner notNil and:[owner submorphs size = 1]) ifTrue:[
		"I am a lonely menuitem already; just grab my owner"
		owner stayUp: true.
		^owner 	aboutToBeGrabbedBy: aHand].
	box := self bounds.
	menu := UIManager default newMenuIn: self for: nil.
	menu addMorphFront: self.
	menu bounds: box.
	menu stayUp: true.
	self isSelected: false.
	^menu! !

!MenuItemMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 8/5/2014 10:52'!
drawSubMenuMarkerOnAthensCanvas: anAthensCanvas
	self hasSubMenu
		ifFalse: [ ^ self ].
	anAthensCanvas pathTransform
		restoreAfter: [ 
			anAthensCanvas pathTransform translateX: self extent x - self subMenuMarker width Y: 0.
			anAthensCanvas pathTransform translateX: 0 Y: (self subMenuMarker height //2).
			anAthensCanvas setPaint: self subMenuMarker.
			anAthensCanvas drawShape: (0 @ 0 extent: self subMenuMarker extent) ]! !

!MenuItemMorph methodsFor: 'private' stamp: 'dgd 9/1/2004 17:10'!
iconForm
	"private - answer the form to be used as the icon"
	^ isEnabled
		ifTrue: [self icon]
		ifFalse: [self icon asGrayScale]! !

!MenuItemMorph methodsFor: 'initialization' stamp: 'ar 10/10/2000 02:05'!
deleteIfPopUp: evt
	"Recurse up for nested pop ups"
	owner ifNotNil:[owner deleteIfPopUp: evt].! !

!MenuItemMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 7/30/2014 21:52'!
isStayUpItem

	^selector == #toggleStayUp:! !

!MenuItemMorph methodsFor: 'accessing' stamp: 'dgd 3/22/2003 14:45'!
icon
	"answer the receiver's icon"
	^ icon! !

!MenuItemMorph methodsFor: 'events' stamp: 'StephaneDucasse 9/28/2014 16:05'!
deselectTimeOut: evt
	"Deselect timout. Now really deselect"

	owner selectedItem == self
		ifTrue: [ 
			evt hand newMouseFocus: owner.
			owner selectItem: nil event: evt ]! !

!MenuItemMorph methodsFor: 'events' stamp: 'ar 10/10/2000 01:37'!
activateSubmenu: evt
	"Activate our submenu; e.g., pass control to it"
	subMenu ifNil:[^false]. "not applicable"
	(subMenu fullContainsPoint: evt position) ifFalse:[^false].
	subMenu activate: evt.
	self removeAlarm: #deselectTimeOut:.
	^true! !

!MenuItemMorph methodsFor: 'accessing' stamp: 'jm 11/4/97 07:46'!
subMenu: aMenuMorph

	subMenu := aMenuMorph.
	self changed.
! !

!MenuItemMorph methodsFor: 'accessing' stamp: 'jm 11/4/97 07:46'!
selector

	^ selector
! !

!MenuItemMorph methodsFor: 'accessing' stamp: 'jm 11/4/97 07:46'!
isEnabled

	^ isEnabled
! !

!MenuItemMorph methodsFor: 'events' stamp: 'StephaneDucasse 9/28/2014 15:59'!
mouseUp: evt
	"Handle a mouse up event. Menu items get activated when the mouse is over them. Do nothing if we're not in a 'valid menu transition', meaning that the current hand focus must be aimed at the owning menu."
	evt hand mouseFocus == owner ifFalse: [^self].
	self contentString ifNotNil:[
		self contents: self contentString withMarkers: true inverse: true.
		self refreshWorld.
		(Delay forMilliseconds: 200) wait].
	self deselect: evt.
	self invokeWithEvent: evt.		
! !

!MenuItemMorph methodsFor: 'grabbing' stamp: 'GuillermoPolito 5/29/2011 14:47'!
duplicateMorph: evt
	"Make and return a duplicate of the receiver's argument"
	| dup menu |
	dup := self duplicate isSelected: false.
	menu := UIManager default newMenuIn: self for: nil.
	menu addMorphFront: dup.
	menu bounds: self bounds.
	menu stayUp: true.
	evt hand grabMorph: menu from: owner. "duplicate was ownerless so use #grabMorph:from: here"
	^menu! !

!MenuItemMorph methodsFor: 'selecting' stamp: 'StephaneDucasse 9/28/2014 15:23'!
adjacentTo
	^ {self bounds topRight + (10 @ 0). self bounds topLeft}! !

!MenuItemMorph methodsFor: 'selecting' stamp: 'ar 10/10/2000 01:39'!
deselect: evt
	self isSelected: false.
	subMenu ifNotNil: [
		owner ifNotNil:[owner activeSubmenu: nil].
		self removeAlarm: #deselectTimeOut:].! !

!MenuItemMorph methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 11/26/2014 12:21'!
spotterItemsFor: aStep
	<spotterOrder: 10>
	self hasSubMenu ifTrue: [ 
		self subMenu spotterItemsFor: aStep ]! !

!MenuItemMorph methodsFor: 'selecting' stamp: 'ar 9/18/2000 11:09'!
isSelected: aBoolean

	isSelected := aBoolean.
	self changed.
! !

!MenuItemMorph methodsFor: 'copying' stamp: 'sw 9/25/2002 03:24'!
veryDeepFixupWith: deepCopier
	"If target and arguments fields were weakly copied, fix them here.  If they were in the tree being copied, fix them up, otherwise point to the originals!!!!"

	super veryDeepFixupWith: deepCopier.
	target := deepCopier references at: target ifAbsent: [target].
	arguments notNil ifTrue:
	[arguments := arguments collect: [:each |
		deepCopier references at: each ifAbsent: [each]]]! !

!MenuItemMorph methodsFor: 'accessing' stamp: 'ar 9/18/2000 11:40'!
hasSubMenu
	"Return true if the receiver has a submenu"
	^subMenu notNil! !

!MenuItemMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 8/5/2014 10:41'!
drawIconOnAthensCanvas: anAthensCanvas
	self hasIcon
		ifFalse: [ ^ self ].
	anAthensCanvas setPaint: self iconForm.
	anAthensCanvas drawShape: (0 @ 0 extent: self iconForm extent).
	anAthensCanvas pathTransform translateX: self iconForm width + 2 Y: 0! !

!MenuItemMorph methodsFor: 'nil' stamp: 'jm 11/4/97 07:46'!
isEnabled: aBoolean

	isEnabled = aBoolean ifTrue: [^ self].
	isEnabled := aBoolean.
	self color: (aBoolean ifTrue: [Color black] ifFalse: [Color gray]).
! !

!MenuItemMorph methodsFor: 'accessing' stamp: 'jm 11/4/97 07:46'!
subMenu

	^ subMenu
! !

!MenuItemMorph methodsFor: 'events' stamp: 'ar 10/10/2000 00:24'!
mouseEnterDragging: evt
	"The mouse entered the receiver. Do nothing if we're not in a 'valid menu transition', meaning that the current hand focus must be aimed at the owning menu."
	evt hand mouseFocus == owner ifTrue:[owner selectItem: self event: evt]! !

!MenuItemMorph methodsFor: 'accessing' stamp: 'ar 9/18/2000 11:22'!
itemWithWording: wording
	"If any of the receiver's items or submenu items have the given wording (case-blind comparison done), then return it, else return nil."
	(self contents asString sameAs: wording) ifTrue:[^self].
	subMenu ifNotNil:[^subMenu itemWithWording: wording].
	^nil! !

!MenuItemMorph methodsFor: 'layout' stamp: 'MarcusDenker 9/7/2010 17:40'!
minWidth
	| subMenuWidth iconWidth markerWidth |
	subMenuWidth := self hasSubMenu
				ifTrue: [10]
				ifFalse: [0].
	iconWidth := self hasIcon
				ifTrue: [self icon width + 2]
				ifFalse: [0].
	markerWidth := self hasMarker
				ifTrue: [self submorphBounds width + 8]
				ifFalse: [0].
	^ (self fontToUse widthOfString: contents)
		+ subMenuWidth + iconWidth + markerWidth + 10! !

!MenuItemMorph methodsFor: 'events' stamp: 'sw 2/7/2001 00:03'!
doButtonAction
	"Called programattically, this should trigger the action for which the receiver is programmed"

	self invokeWithEvent: nil! !

!MenuItemMorph methodsFor: 'accessing' stamp: 'nk 3/10/2004 15:19'!
hasIconOrMarker
	"Answer whether the receiver has an icon or a marker."
	^ self hasIcon or: [ submorphs isEmpty not ]! !

!MenuItemMorph methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 11/21/2014 11:13'!
spotterActDefault
	self doButtonAction! !

!MenuItemMorph methodsFor: 'events' stamp: 'ar 10/10/2000 22:45'!
handleMouseUp: anEvent
	"The handling of control between menu item requires them to act on mouse up even if not the current focus. This is different from the default behavior which really only wants to handle mouse ups when they got mouse downs before"
	anEvent wasHandled ifTrue:[^self]. "not interested"
	anEvent hand releaseMouseFocus: self.
	anEvent wasHandled: true.
	anEvent blueButtonChanged
		ifTrue:[self blueButtonUp: anEvent]
		ifFalse:[self mouseUp: anEvent].! !

!MenuItemMorph methodsFor: 'accessing' stamp: 'gvc 10/17/2008 14:43'!
enabled: aBoolean
	"Delegate to exisitng method."

	self isEnabled: aBoolean! !

!MenuItemMorph methodsFor: 'events' stamp: 'dgd 2/22/2003 14:52'!
mouseLeaveDragging: evt 
	"The mouse left the receiver. Do nothing if we're not in a 'valid menu transition', meaning that the current hand focus must be aimed at the owning menu."

	owner ifNil: [^self].
	evt hand mouseFocus == owner ifFalse: [^self].
	"If we have a submenu, make sure we've got some time to enter it before actually leaving the menu item"
	subMenu isNil 
		ifTrue: [owner selectItem: nil event: evt]
		ifFalse: 
			[self 
				addAlarm: #deselectTimeOut:
				with: evt
				after: 500]! !

!MenuItemMorph methodsFor: 'events' stamp: 'ar 9/18/2000 21:46'!
handlesMouseOverDragging: evt
	^true! !

!MenuItemMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 8/5/2014 10:43'!
drawLabelOnAthensCanvas: anAthensCanvas
	anAthensCanvas pathTransform translateX: 0 Y: self fontToUse getPreciseAscent.
			anAthensCanvas
				setPaint: self color;
				setFont: self fontToUse;
				drawString: contents.! !

!MenuItemMorph methodsFor: 'accessing' stamp: 'nk 3/10/2004 15:25'!
hasMarker
	"Answer whether the receiver has a marker morph."
	^ submorphs isEmpty not! !

!MenuItemMorph methodsFor: 'nil' stamp: 'di 2/23/98 16:24'!
deselectItem
	| item |
	self isSelected: false.
	subMenu ifNotNil: [subMenu deleteIfPopUp].
	(owner isKindOf: MenuMorph) ifTrue:
		[item := owner popUpOwner.
		(item isKindOf: MenuItemMorph) ifTrue: [item deselectItem]].
! !

!MenuItemMorph methodsFor: 'private' stamp: 'dgd 9/1/2004 18:07'!
rightArrow

	^ SubMenuMarker! !

!MenuItemMorph methodsFor: 'private' stamp: 'dgd 3/31/2006 12:16'!
leftArrow
	^ ColorForm
		mappingWhiteToTransparentFrom: ((SubMenuMarker rotateBy: 180)asFormOfDepth: 8)! !

!MenuItemMorph methodsFor: 'accessing' stamp: 'jm 11/4/97 07:46'!
arguments: aCollection

	arguments := aCollection.
! !

!MenuItemMorph methodsFor: 'meta actions' stamp: 'ar 10/10/2000 02:13'!
wantsHaloFromClick
	"Only if I'm not a lonely submenu"
	^owner notNil and:[owner submorphs size > 1]! !

!MenuItemMorph methodsFor: 'selecting' stamp: 'dgd 9/1/2004 18:52'!
select: evt
	self isSelected: true.
	owner activeSubmenu: subMenu.
	subMenu ifNotNil: [
		subMenu delete.
		subMenu
			popUpAdjacentTo: self adjacentTo
			forHand: evt hand
			from: self.
		subMenu selectItem: nil event: evt].! !

!MenuItemMorph methodsFor: 'layout' stamp: 'dgd 9/4/2004 15:49'!
minHeight
	| iconHeight |
	iconHeight := self hasIcon
				ifTrue: [self icon height + 2]
				ifFalse: [0].
	^ self fontToUse height max: iconHeight ! !

!MenuItemMorph methodsFor: 'events' stamp: 'StephaneDucasse 9/28/2014 16:02'!
mouseDown: evt
	"Handle a mouse down event. Menu items get activated when the mouse is over them."

	evt shiftPressed ifTrue: [^ super mouseDown: evt].  "enable label editing"
	evt hand newMouseFocus: owner. "Redirect to menu for valid transitions"
	owner selectItem: self event: evt. 
! !

!MenuItemMorph methodsFor: 'accessing' stamp: 'ar 9/17/2000 18:32'!
contents: aString
	^self contents: aString withMarkers: true! !

!MenuItemMorph methodsFor: 'events' stamp: 'sw 5/5/2001 00:25'!
mouseLeave: evt
	"The mouse has left the interior of the receiver..."

	owner ifNotNil: [owner stayUp ifFalse: [self mouseLeaveDragging: evt]]! !

!MenuItemMorph methodsFor: 'accessing' stamp: 'jm 11/4/97 07:46'!
arguments

	^ arguments
! !

!MenuItemMorph methodsFor: 'accessing' stamp: 'jm 11/4/97 07:46'!
target

	^ target! !

!MenuItemMorph class methodsFor: 'initialization' stamp: 'jm 11/16/97 09:17'!
initialize
	"MenuItemMorph initialize"

	| f |
	f := Form
		extent: 5@9
		fromArray: #(2147483648 3221225472 3758096384 4026531840 4160749568 4026531840 3758096384 3221225472 2147483648)
		offset: 0@0.
	SubMenuMarker := ColorForm mappingWhiteToTransparentFrom: f.
! !

!MenuItemMorph class methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/26/2015 17:54'!
gtExampleMenuItemMorphWithSubitems
	<gtExample: 'Menu item with subitems'>
	^ World worldMenu items 
		detect: [ :each | each contents = 'System' ]! !

!MenuItemMorph class methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/26/2015 17:54'!
gtExampleMenuItemMorphWithoutSubitems
	<gtExample: 'Menu item without subitems'>
	^ World worldMenu items 
		detect: [ :each | each contents = 'System Browser' ]! !

!MenuLineMorph commentStamp: 'StephaneDucasse 9/28/2014 16:11'!
A MenuLineMorph is a item separator in menu.
!
!MenuLineMorph methodsFor: 'initialization' stamp: 'ar 11/8/2000 23:09'!
initialize
	super initialize.
	self hResizing: #spaceFill; vResizing: #spaceFill.! !

!MenuLineMorph methodsFor: 'private' stamp: 'NicolaiHess 8/5/2014 14:13'!
baseColor
	^ self theme autoMenuColor
		ifTrue: [ owner color twiceDarker ]
		ifFalse: [ 
			self theme currentSettings flatMenu
				ifFalse: [ owner color ]
				ifTrue: [ owner color twiceDarker ] ]! !

!MenuLineMorph methodsFor: 'drawing' stamp: 'NicolaiHess 8/5/2014 14:14'!
drawOn: aCanvas 
	self theme flatMenu 
		ifFalse: [
			aCanvas
				fillRectangle: (bounds topLeft corner: bounds rightCenter)
				color: self baseColor twiceDarker .
			aCanvas
				fillRectangle: (bounds leftCenter corner: bounds bottomRight)
				color: self baseColor twiceLighter ]
		ifTrue: [
			aCanvas
				fillRectangle: (bounds topLeft corner: bounds bottomRight)
				color: self baseColor ]! !

!MenuLineMorph methodsFor: 'drawing' stamp: 'NicolaiHess 8/5/2014 14:14'!
drawOnAthensCanvas: anAthensCanvas
	self theme flatMenu
		ifFalse: [ 
			anAthensCanvas setPaint: self baseColor twiceDarker.
			anAthensCanvas drawShape: (bounds topLeft corner: bounds rightCenter).
			anAthensCanvas setPaint: self baseColor twiceLighter.
			anAthensCanvas drawShape: (bounds leftCenter corner: bounds bottomRight) ]
		ifTrue: [ 
			anAthensCanvas setPaint: self baseColor.
			anAthensCanvas drawShape: (bounds topLeft corner: bounds bottomRight) ]! !

!MenuLineMorph methodsFor: 'layout' stamp: 'StephaneDucasse 9/28/2014 15:50'!
minHeight
	"Answer the receiver's minHeight"
	^ self theme menuBorderWidth! !

!MenuLineMorph methodsFor: 'layout' stamp: 'StephaneDucasse 9/28/2014 15:50'!
minWidth
	"Answer the receiver's minWidth"
	^  10 ! !

!MenuModel commentStamp: '<historical>'!
I am a simple model describing a menu.

I only contains a list of menu groups. Each group is separated by a splitter!
!MenuModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/12/2013 09:47'!
neglect: aModel

	aModel neglectMenuModel: self! !

!MenuModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/1/2013 15:38'!
applyTo: aModel

	aModel applyMenuModel: self! !

!MenuModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/1/2013 14:14'!
menuGroups

	^ groups value! !

!MenuModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/1/2013 15:35'!
addGroup: aBlock
	| group |
	
	group := MenuGroupModel new.
	aBlock value: group.
	self addMenuGroup: group! !

!MenuModel methodsFor: 'api' stamp: 'StephaneDucasse 10/22/2014 22:11'!
addTitle: aString
	title value: aString translated! !

!MenuModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 2/18/2014 23:08'!
buildWithSpecAsPopup

	^ self buildWithSpec: #popup! !

!MenuModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/1/2013 18:33'!
autoRefresh: aBoolean

	autoRefresh value: aBoolean! !

!MenuModel methodsFor: 'initialization' stamp: 'StephaneDucasse 2/26/2015 16:34'!
initialize

	super initialize.
	groups := OrderedCollection new asValueHolder.
	title := nil asValueHolder.
	icon := nil asValueHolder.
	autoRefresh := nil asValueHolder.
	autoRefresh whenChangedDo: [ :aBoolean | self menuGroups do: [ :each | each autoRefresh: aBoolean ] ]! !

!MenuModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/1/2013 14:36'!
icon: anIcon

	icon value: anIcon! !

!MenuModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/1/2013 18:34'!
addMenuGroup: aMenuGroup

	groups add: aMenuGroup.
	self autoRefresh 
		ifNotNil: [ aMenuGroup autoRefresh: self autoRefresh ]! !

!MenuModel methodsFor: 'printing' stamp: 'StephaneDucasse 11/11/2013 19:19'!
printOn: aStream

	super printOn: aStream.
	self title value ifNotNil: [:t | aStream nextPutAll: ' ''', t , '''' ]! !

!MenuModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/1/2013 14:36'!
title

	^ title value! !

!MenuModel methodsFor: 'api-building' stamp: 'BenjaminVanRyseghem 11/29/2013 15:00'!
fromSpec: aSpec

	aSpec addToMenuModel: self! !

!MenuModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/1/2013 14:36'!
title: aString

	title value: aString! !

!MenuModel methodsFor: 'api-building' stamp: 'BenjaminVanRyseghem 11/29/2013 16:14'!
addAllFromPragma: pragma target: target

	self fromSpec: (PragmaMenuBuilder 
		pragmaKeyword: pragma
		model: target) menuSpec! !

!MenuModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/1/2013 18:33'!
autoRefresh

	^ autoRefresh value! !

!MenuModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 2/18/2014 23:08'!
openWithSpecAt: aPosition

	self buildWithSpecAsPopup.
	self changed: #openAt: with: { aPosition }! !

!MenuModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/1/2013 14:36'!
icon

	^ icon value! !

!MenuModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 11/1/2013 16:24'!
defaultSpec
	<spec: #default>
	
	^ #(MenuAdapter
		adapt: #(model))! !

!MenuModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 2/18/2014 23:04'!
popup
	<spec>
	
	^ #(MenuAdapter
		adaptAsPopup: #(model))! !

!MenuModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/13/2014 15:22'!
adapterName

	^ #MenuAdapter! !

!MenuMorph commentStamp: '<historical>'!
Instance variables:
	defaultTarget 	<Object>				The default target for creating menu items
	selectedItem		<MenuItemMorph> 	The currently selected item in the receiver
	stayUp 			<Boolean>			True if the receiver should stay up after clicks
	popUpOwner 	<MenuItemMorph>	The menu item that automatically invoked the receiver, if any.
	activeSubMenu 	<MenuMorph>		The currently active submenu.!
!MenuMorph methodsFor: 'private' stamp: 'ar 10/7/2000 21:08'!
invokeMetaMenu: evt
	stayUp ifFalse:[^self]. "Don't allow this"
	^super invokeMetaMenu: evt! !

!MenuMorph methodsFor: '*SUnit-UITesting' stamp: 'SeanDeNigris 12/1/2011 22:47'!
choose: aString 

	| item |
	item := self itemWithWording: aString.
	item ifNil: [ self error: 'Menu does not have "', aString, '" item' ].
	item simulateClick.! !

!MenuMorph methodsFor: 'control' stamp: 'BenjaminVanRyseghem 10/18/2013 10:59'!
popUpAt: aPoint forHand: hand in: aWorld allowKeyboard: aBoolean 
	"Present this menu at the given point under control of the given  
	hand."
	| evt |
	aWorld submorphs
		select: [ :each | (each isKindOf: MenuMorph)
			and: [each stayUp not]]
		thenCollect: [ :menu | menu delete].

	self items isEmpty
		ifTrue: [^ self].

	self layoutItems.
	"precompute width"
	self
		positionAt: aPoint
		relativeTo: (selectedItem
				ifNil: [self items first])
		inWorld: aWorld.
	aWorld addMorphFront: self.
	"Acquire focus for valid pop up behavior"
	hand newMouseFocus: self.
	aBoolean
		ifTrue: [hand newKeyboardFocus: self].
	evt := hand lastEvent.
	(evt isKeyboard
			or: [evt isMouse
					and: [evt anyButtonPressed not]])
		ifTrue: ["Select first item if button not down"
			self moveSelectionDown: 1 event: evt].
	self updateColor.
	self changed! !

!MenuMorph methodsFor: 'construction' stamp: 'StephaneDucasse 10/27/2014 08:15'!
add: aLabelString icon: aForm subMenu: aMenuMorph
	"Append the given submenu with the given label."

	self addToggle: aLabelString target: nil selector: nil.
	self lastItem
		icon: aForm;
		subMenu: aMenuMorph.
	^ self! !

!MenuMorph methodsFor: 'invoking' stamp: 'AlainPlantec 12/19/2009 23:23'!
invokeAt: aPoint in: aWorld
	"Add this menu to the given world centered at the given point. Wait for the user to make a selection and answer it. The selection value returned is an integer in keeping with PopUpMenu, if the menu is converted from an MVC-style menu."
	"Details: This is invoked synchronously from the caller. In order to keep processing inputs and updating the screen while waiting for the user to respond, this method has its own version of the World's event loop."

	^ self invokeAt: aPoint in: aWorld allowKeyboard: self  menuKeyboardControl! !

!MenuMorph methodsFor: 'construction' stamp: 'StephaneDucasse 10/27/2014 08:17'!
add: aLabelString target: target selector: aSymbol argument: arg
	"Append a menu item with the given label. If the item is selected, it will send the given selector to the target object with the given argument."

	^ self add: aLabelString
		target: target
		selector: aSymbol
		argumentList: (Array with: arg)
! !

!MenuMorph methodsFor: 'accessing' stamp: 'gvc 7/30/2007 14:28'!
color: aColor
	"Set the receiver's color. Remember the base color in the case of a gradient background."

	super color: aColor.
	self setProperty: #basicColor toValue: aColor! !

!MenuMorph methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 5/8/2013 14:54'!
initialize
	super initialize.
	
	self setDefaultParameters.
	self listDirection: #topToBottom.
	self hResizing: #shrinkWrap.
	self vResizing: #shrinkWrap.
	defaultTarget := nil.
	selectedItem := nil.
	stayUp := false.
	popUpOwner := nil.
	self setProperty: #morphicLayerNumber toValue: self morphicLayerNumber.
	self theme currentSettings preferRoundCorner
		ifTrue: [ self useRoundedCorners ]! !

!MenuMorph methodsFor: 'control' stamp: 'alain.plantec 2/9/2009 12:20'!
displayAt: aPoint during: aBlock
	"Add this menu to the Morphic world during the execution of the given block."
	ActiveWorld addMorph: self centeredNear: aPoint.
	self world displayWorld.  "show myself"
	aBlock value.
	self delete! !

!MenuMorph methodsFor: 'construction' stamp: 'StephaneDucasse 10/27/2014 08:16'!
add: aLabelString selector: aSymbol argument: arg

	^ self add: aLabelString
		target: defaultTarget
		selector: aSymbol
		argumentList: (Array with: arg)
! !

!MenuMorph methodsFor: '*Deprecated40' stamp: 'StephaneDucasse 9/30/2014 13:24'!
title: aString
	"Add a title line at the top of this menu."
	self deprecated: 'Use method addTitle: instead' on: '29 september' in: #Pharo40. 
	self addTitle: aString! !

!MenuMorph methodsFor: 'construction' stamp: 'StephaneDucasse 10/27/2014 20:19'!
addUpdating: aWordingSelector selector: aSymbol

	self addUpdating: aWordingSelector target: defaultTarget selector: aSymbol argumentList: EmptyArray
! !

!MenuMorph methodsFor: 'menu' stamp: 'BenjaminVanRyseghem 4/12/2011 15:32'!
setInvokingView: invokingView
	"Re-work every menu item of the form
		<target> perform: <selector>
	to the form
		<target> perform: <selector> orSendTo: <invokingView>.
	This supports MVC's vectoring of non-model messages to the editPane."
	self items do:
		[:item |
		item hasSubMenu 
			ifTrue: [ item subMenu setInvokingView: invokingView]
			ifFalse: [ item arguments isEmptyOrNil ifTrue:  "only the simple messages"
						[item arguments: (Array with: item selector with: invokingView).
						item selector: #perform:orSendTo:]]]! !

!MenuMorph methodsFor: 'events' stamp: 'AlexandreBergel 11/11/2013 15:18'!
recordFiltering: matchString
	self setProperty: #matchString toValue: matchString! !

!MenuMorph methodsFor: 'private' stamp: 'NicolaiHess 12/20/2013 13:33'!
setTitleParametersFor: aMenuTitle 
	| menuTitleColor menuTitleBorderColor |
	self theme currentSettings preferRoundCorner
		ifTrue: [aMenuTitle useRoundedCorners].

	menuTitleColor := self theme currentSettings autoMenuColor
				ifTrue: [self color darker]
				ifFalse: [self theme menuTitleColorFor: 
						((UIManager default respondsTo: #modalMorph)
							ifTrue: [UIManager default modalMorph]
							ifFalse: [nil])].

	menuTitleBorderColor := self theme currentSettings menuTitleBorderColor.

	aMenuTitle
		color: menuTitleColor;
		borderWidth: 0;
		borderColor: menuTitleBorderColor;
		vResizing: #shrinkWrap;
		wrapCentering: #center;
		cellPositioning: #topLeft;
		maxCellSize:World width /2;
		clipSubmorphs:true;
		layoutInset: 0.
! !

!MenuMorph methodsFor: 'construction' stamp: 'StephaneDucasse 10/27/2014 08:17'!
add: aLabelString target: anObject selector: aSymbol
	"Append a menu item with the given label. If the item is selected, it will send the given selector to the target object."

	^ self add: aLabelString
		target: anObject
		selector: aSymbol
		argumentList: EmptyArray.
! !

!MenuMorph methodsFor: 'construction' stamp: 'gvc 10/12/2006 15:32'!
addToggle: aString target: anObject selector: aSymbol
	"Append a menu item with the given label. If the item is selected, it will send the given selector to the target object."

	self addToggle: aString
		target: anObject
		selector: aSymbol
		getStateSelector: nil
		argumentList: EmptyArray! !

!MenuMorph methodsFor: 'accessing' stamp: 'dgd 9/13/2004 13:36'!
hasItems
	"Answer if the receiver has menu items"
	^ submorphs
		anySatisfy: [:each | each isKindOf: MenuItemMorph] ! !

!MenuMorph methodsFor: 'drawing' stamp: 'EstebanLorenzano 5/15/2014 19:04'!
drawOn: aCanvas 
	"Draw the menu. Add keyboard-focus feedback if appropriate"

	super drawOn: aCanvas.

	(ActiveHand notNil
			and: [ActiveHand keyboardFocus == self
					and: [self rootMenu hasProperty: #hasUsedKeyboard]])
		ifTrue: [
			aCanvas
				frameAndFillRectangle: self innerBounds
				fillColor: Color transparent
				borderWidth: self theme menuBorderWidth
				borderColor: self theme menuKeyboardFocusColor
		].
! !

!MenuMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/15/2015 13:30'!
drawOnAthensCanvas: anAthensCanvas
	"Draw the menu. Add keyboard-focus feedback if appropriate"

	super drawOnAthensCanvas: anAthensCanvas.
	(ActiveHand notNil and: [ ActiveHand keyboardFocus == self and: [ self rootMenu hasProperty: #hasUsedKeyboard ] ])
		ifTrue: [ 
			(anAthensCanvas setStrokePaint: self theme menuKeyboardFocusColor) width: self theme menuBorderWidth.
			anAthensCanvas drawShape: self innerBounds ]! !

!MenuMorph methodsFor: 'events' stamp: 'gvc 1/16/2007 12:59'!
takesKeyboardFocus
	"Answer whether the receiver can normally take keyboard focus."

	^true! !

!MenuMorph methodsFor: 'actions' stamp: 'di 10/28/1999 09:50'!
deleteIfPopUp
	"Remove this menu from the screen if stayUp is not true. If it is a submenu, also remove its owning menu."

	stayUp ifFalse: [self topRendererOrSelf delete].
	(popUpOwner notNil and: [popUpOwner isKindOf: MenuItemMorph]) ifTrue: [
		popUpOwner isSelected: false.
		(popUpOwner owner isKindOf: MenuMorph)
			ifTrue: [popUpOwner owner deleteIfPopUp]].
! !

!MenuMorph methodsFor: 'construction' stamp: 'sw 11/5/1998 21:13'!
balloonTextForLastItem: balloonText
	submorphs last setBalloonText: balloonText! !

!MenuMorph methodsFor: 'construction' stamp: 'EstebanLorenzano 1/31/2013 19:25'!
addAllFrom: aMenuMorph
	"This is a fast add..."
	submorphs := submorphs, (aMenuMorph submorphs collect: [ :each |
		each copy 
			privateOwner: self;
			yourself ]).
	menuItems := submorphs copy asOrderedCollection! !

!MenuMorph methodsFor: 'construction' stamp: 'StephaneDucasse 10/27/2014 09:34'!
add: aLabelString selector: aSymbol
	"Append a menu item with the given label. If the item is selected, it will send the given selector to the default target object."
	"Details: Note that the menu item added captures the default target object at the time the item is added; the default target can later be changed before added additional items without affecting the targets of previously added entries. The model is that each entry is like a button that knows everything it needs to perform its action."

	self add: aLabelString
		target: defaultTarget
		selector: aSymbol
		argumentList: EmptyArray.
! !

!MenuMorph methodsFor: 'control' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
layoutItems
	"decorate aMenu with icons"

	| maxIconWidth |
	maxIconWidth := 0.

	self items do: [:item | 
		item icon ifNotNil: [maxIconWidth := maxIconWidth max: item icon width].
		item hasSubMenu ifTrue: [item subMenu layoutItems]].
	maxIconWidth isZero 
		ifFalse: [self addBlankIconsIfNecessary: (Smalltalk ui icons blankIconOfWidth: maxIconWidth)].
! !

!MenuMorph methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 6/28/2012 18:10'!
delete

	activeSubMenu ifNotNil:[activeSubMenu delete].
	^super delete! !

!MenuMorph methodsFor: 'keyboard control' stamp: 'GuillermoPolito 5/23/2012 11:39'!
keyboardFocusChange: aBoolean
	"Notify change due to green border for keyboard focus"
	super keyboardFocusChange: aBoolean.
	self changed! !

!MenuMorph methodsFor: 'construction' stamp: 'StephaneDucasse 10/27/2014 09:34'!
addList: aList
	"Add the given items to this menu, where each item is a pair (<string> <actionSelector>)..  If an element of the list is simply the symobl $-, add a line to the receiver.  The optional third element of each entry, if present, provides balloon help. The optional fourth element provide the icon selector"

	aList
		do: [ :tuple | 
			tuple == #-
				ifTrue: [ self addLine ]
				ifFalse: [ 
					self add: tuple first capitalized translated selector: tuple second.
					(tuple size > 2 and: [ tuple third notNil ])
						ifTrue: [ self balloonTextForLastItem: tuple third translated ].
					(tuple size > 3 and: [ tuple fourth notNil ])
						ifTrue: [ self lastItem icon: (Smalltalk ui icons iconNamed: tuple fourth) ] ] ]! !

!MenuMorph methodsFor: 'keyboard control' stamp: 'StephaneDucasse 2/9/2010 22:36'!
displayFiltered: evt
	| matchStr allItems matches feedbackMorph |
	matchStr := self valueOfProperty: #matchString.
	allItems := self submorphs select: [:m | m isKindOf: MenuItemMorph].
	matches :=  allItems select: [:m | | isMatch | 
		isMatch := 
			matchStr isEmpty or: [
				m contents includesSubstring: matchStr caseSensitive: false].
		m isEnabled: isMatch.
		isMatch].
	feedbackMorph := self valueOfProperty: #feedbackMorph.
	feedbackMorph ifNil: [
		feedbackMorph := 
			TextMorph new 
				autoFit: true;
				color: Color darkGray.
		self
			addLine;
			addMorphBack: feedbackMorph lock.
		self setProperty: #feedbackMorph toValue: feedbackMorph.
		self fullBounds.  "Lay out for submorph adjacency"].
	feedbackMorph contents: '<', matchStr, '>'.
	matchStr isEmpty ifTrue: [
		feedbackMorph delete.
		self submorphs last delete.
		self removeProperty: #feedbackMorph].
	    " This method is invoked with evt = nil from MenuMorph >> removeMatchString. The current implementation can't select an item without an event. "
       (evt notNil and: [ matches size >= 1 ]) 
		ifTrue: [self selectItem: matches first event: evt]
! !

!MenuMorph methodsFor: 'control' stamp: 'AlainPlantec 11/16/2010 08:59'!
deleteIfPopUp: evt
	"Remove this menu from the screen if stayUp is not true. If it is a submenu, also remove its owning menu."
	stayUp ifFalse: [self topRendererOrSelf delete].
	(popUpOwner notNil) ifTrue: [
		popUpOwner isSelected: false.
		popUpOwner deleteIfPopUp: evt].
	evt ifNotNil:[evt hand releaseMouseFocus: self].! !

!MenuMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 9/30/2014 13:49'!
items
	"Returns menu items filtering out menu lines"
	^ submorphs select: [:m | m isKindOf: MenuItemMorph]
! !

!MenuMorph methodsFor: '*Deprecated40' stamp: 'NicolaiHess 9/8/2014 22:06'!
addUpdating: aWordingSelector target: aTarget action: aSymbol
	self deprecated: 'use addUpdating: aWordingSelector target: aTarget selector: aSymbol' on: '9 september' in: #Pharo40. 
	self addUpdating: aWordingSelector target: aTarget selector: aSymbol argumentList: EmptyArray
! !

!MenuMorph methodsFor: 'events' stamp: 'ar 10/10/2000 01:57'!
mouseUp: evt
	"Handle a mouse up event.
	Note: This might be sent from a modal shell."
	(self fullContainsPoint: evt position) ifFalse:[
		"Mouse up outside. Release eventual focus and delete if pop up."
		evt hand releaseMouseFocus: self.
		^self deleteIfPopUp: evt].
	stayUp ifFalse:[
		"Still in pop-up transition; keep focus"
		evt hand newMouseFocus: self].! !

!MenuMorph methodsFor: 'construction' stamp: 'StephaneDucasse 7/30/2014 21:59'!
addTitle: aString icon: aForm
	"Add a title line at the top of this menu."

	| title titleContainer |
	title := AlignmentMorph newColumn.
	self setTitleParametersFor: title.	""
	aForm isNil
		ifTrue: [ titleContainer := title ]
		ifFalse: [ 
			| pair |
			pair := AlignmentMorph newRow.
			pair color: Color transparent.
			pair hResizing: #shrinkWrap.
			pair layoutInset: 0.	""
			pair addMorphBack: aForm asMorph.	""
			titleContainer := AlignmentMorph newColumn.
			titleContainer color: Color transparent.
			titleContainer vResizing: #shrinkWrap.
			titleContainer wrapCentering: #center.
			titleContainer cellPositioning: #topCenter.
			titleContainer layoutInset: 0.
			pair addMorphBack: titleContainer.	""
			title addMorphBack: pair ].	""


		aString asString
				linesDo: [ :line | titleContainer addMorphBack: (StringMorph contents: line font: StandardFonts menuFont) ].
		
	title setProperty: #titleString toValue: aString.
	self addMorphFront: title.	""
	title useSquareCorners.
	title on: #mouseDown send: #mouseDownInTitle: to: self.
	(self hasProperty: #needsTitlebarWidgets)
		ifTrue: [ self addStayUpIcons ]! !

!MenuMorph methodsFor: 'modal control' stamp: 'ar 1/5/2002 21:34'!
modalSelection
	^self valueOfProperty: #modalSelection ifAbsent:[nil]! !

!MenuMorph methodsFor: 'filtering' stamp: 'AlexandreBergel 11/11/2013 15:18'!
getFiltering: matchString
	^ self valueOfProperty: #matchString ifAbsentPut: [ String new ]! !

!MenuMorph methodsFor: 'construction' stamp: 'StephaneDucasse 10/27/2014 08:18'!
addWithLabel: aLabelString enablement: anEnablementSelector action: aSymbol
	"Append a menu item with the given label. If the item is selected, it will send the given selector to the target object with the given arguments. If the selector takes one more argument than the number of arguments in the given list, then the triggering event is supplied as as the last argument.  In this variant, the wording of the menu item is constant, and the optional enablementSelector determines whether or not the item should be enabled."

	self flag: #ToDeprecate.
	self
		addToggle: aLabelString
		target: defaultTarget
		selector: aSymbol
		getStateSelector: nil
		enablementSelector: anEnablementSelector
		argumentList: EmptyArray! !

!MenuMorph methodsFor: 'accessing' stamp: 'ar 9/18/2000 13:19'!
defaultTarget
	^defaultTarget! !

!MenuMorph methodsFor: 'copying' stamp: 'ar 9/18/2000 09:34'!
veryDeepFixupWith: deepCopier
	"If fields were weakly copied, fix them here.  If they were in the tree being copied, fix them up, otherwise point to the originals."

super veryDeepFixupWith: deepCopier.
defaultTarget := deepCopier references at: defaultTarget ifAbsent: [defaultTarget].
popUpOwner := deepCopier references at: popUpOwner ifAbsent: [popUpOwner].
activeSubMenu := deepCopier references at: activeSubMenu ifAbsent:[activeSubMenu].! !

!MenuMorph methodsFor: 'keyboard control' stamp: 'nice 1/5/2010 15:59'!
moveSelectionDown: direction event: evt
	"Move the current selection up or down by one, presumably under keyboard control.
	direction = +/-1"

	| index |
	index := (submorphs indexOf: selectedItem ifAbsent: [1-direction]) + direction.
	submorphs do: "Ensure finite"
		[:unused | | m | m := submorphs atWrap: index.
		((m isKindOf: MenuItemMorph) and: [m isEnabled]) ifTrue:
			[^ self selectItem: m event: evt].
		"Keep looking for an enabled item"
		index := index + direction sign].
	^ self selectItem: nil event: evt! !

!MenuMorph methodsFor: 'accessing' stamp: 'GuillermoPolito 9/1/2010 18:44'!
lastSelection
	"Return the label of the last selected item or nil."

	^selectedItem ifNotNil: [selectedItem selector].! !

!MenuMorph methodsFor: 'construction' stamp: 'StephaneDucasse 10/22/2014 22:11'!
addTitle: aString
	"Add a title line at the top of this menu."
	
	 self addTitle: aString translated icon: nil
		
		
	! !

!MenuMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 3/22/2010 21:20'!
lastItem

	submorphs reverseDo: [ :each |
			(each isKindOf: MenuItemMorph) ifTrue: [ ^each ] ].
	^submorphs last! !

!MenuMorph methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 11/22/2014 17:33'!
allItems
	| all |
	all := OrderedCollection new.
	self items do: [ :each |
		all add: each.
		each hasSubMenu 
			ifTrue: [ all addAll: each subMenu allItems ] ].
	^ all! !

!MenuMorph methodsFor: 'accessing' stamp: 'ar 9/18/2000 10:07'!
popUpOwner: aMenuItemMorph
	"Set the current pop-up owner"
	popUpOwner := aMenuItemMorph.
! !

!MenuMorph methodsFor: 'accessing' stamp: 'sw 12/4/2001 21:23'!
commandKeyHandler: anObject
	"Set the receiver's commandKeyHandler.  Whatever you set here needs to be prepared to respond to the message #commandKeyTypedIntoMenu: "

	self setProperty: #commandKeyHandler toValue: anObject! !

!MenuMorph methodsFor: 'accessing' stamp: 'nice 1/5/2010 15:59'!
itemWithWording: wording
	"If any of the receiver's items or submenu items have the given wording (case-blind comparison done), then return it, else return nil."
	
	self items do:[:anItem | | found |
		found := anItem itemWithWording: wording.
		found ifNotNil:[^found]].
	^ nil! !

!MenuMorph methodsFor: 'construction' stamp: 'StephaneDucasse 10/27/2014 17:53'!
addToggle: aString target: anObject selector: aSymbol getStateSelector: stateSymbol enablementSelector: enableSymbol argumentList: argList
	"Append a menu item with the given label. If the item is selected, it will send the given selector to the target object."

	|item|
	item := ToggleMenuItemMorph new
		contents: aString translated;
		target: anObject;
		selector: aSymbol;
		arguments: argList;
		getStateSelector: stateSymbol;
		enablementSelector: enableSymbol.
	^ self addMenuItem: item.
! !

!MenuMorph methodsFor: 'menu' stamp: 'GuillermoPolito 8/9/2010 21:23'!
doButtonAction
	"Do the receiver's inherent button action.  Makes sense for the kind of MenuMorph that is a wrapper for a single menu-item -- pass it on the the item"

	self hasItems ifTrue: [self menuItems first doButtonAction]! !

!MenuMorph methodsFor: 'keyboard control' stamp: 'rr 3/24/2004 13:40'!
moveUp: evt 
	^self moveSelectionDown: -1 event: evt! !

!MenuMorph methodsFor: 'menu' stamp: 'StephaneDucasse 10/27/2014 09:34'!
addItem

	| string sel |
	string := UIManager default request: 'Label for new item?' translated.
	string isEmpty ifTrue: [^ self].
	sel := UIManager default request: 'Selector?' translated.
	sel isEmpty ifFalse: [sel := sel asSymbol].
	self add: string selector: sel.
! !

!MenuMorph methodsFor: 'menu' stamp: 'RAA 1/18/2001 18:21'!
toggleStayUp: evt
	"Toggle my 'stayUp' flag and adjust the menu item to reflect its new state."

	self items do: [:item |
		item isStayUpItem ifTrue:
			[self stayUp: stayUp not.	
			 stayUp
				ifTrue: [item contents: 'dismiss this menu']
				ifFalse: [item contents: 'keep this menu up']]].
	evt hand releaseMouseFocus: self.
	stayUp ifFalse: [self topRendererOrSelf delete].
! !

!MenuMorph methodsFor: 'accessing' stamp: 'ar 9/18/2000 10:06'!
popUpOwner
	"Return the current pop-up owner that is the menu item that automatically initiated the receiver."
	^ popUpOwner
! !

!MenuMorph methodsFor: 'events' stamp: 'GabrielOmarCotelli 11/30/2013 16:52'!
updateColor
	"Update the color of the menu."

	self theme preferGradientFill
		ifFalse: [ ^ self ].
	self fillStyle: (self theme menuFillStyleFor: self).	
	"update the title color"
	self allMorphs
		detect: [ :each | each hasProperty: #titleString ]
		ifFound: [ :title | title fillStyle: (self theme menuTitleFillStyleFor: title) ]! !

!MenuMorph methodsFor: 'menu' stamp: 'StephaneDucasse 10/27/2014 18:02'!
addCustomMenuItems: aCustomMenu hand: aHandMorph

	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
	aCustomMenu addLine.
	aCustomMenu add: 'add title...' selector: #addTitle.
	aCustomMenu add: 'set target...' selector: #setTarget:.
	defaultTarget ifNotNil: [
		aCustomMenu add: 'add item...' selector: #addItem].
	aCustomMenu add: 'add line' selector: #addLine.
	(self items count: [:any| any hasSubMenu]) > 0
		ifTrue: [ aCustomMenu add: 'detach submenu' selector: #detachSubMenu: ].! !

!MenuMorph methodsFor: 'invoking' stamp: 'NicolaiHess 12/18/2014 01:28'!
invokeAt: aPoint in: aWorld allowKeyboard: aBoolean
	"Add this menu to the given world centered at the given point. Wait for the user to make a selection and answer it. The selection value returned is an integer in keeping with PopUpMenu, if the menu is converted from an MVC-style menu."
	"Details: This is invoked synchronously from the caller. In order to keep processing inputs and updating the screen while waiting for the user to respond, this method has its own version of the World's event loop." 
	| w originalFocusHolder |
	originalFocusHolder := aWorld primaryHand keyboardFocus.
	self popUpAt: aPoint forHand: aWorld primaryHand in: aWorld allowKeyboard: aBoolean.
	w := aWorld outermostWorldMorph. "containing hand"
	[self isInWorld] whileTrue: [w doOneSubCycle].
	self delete.
	self restoreFocus: originalFocusHolder in: aWorld.
	^ selectedItem ifNotNil: [selectedItem target]
! !

!MenuMorph methodsFor: 'menu' stamp: 'wiz 3/14/2006 23:40'!
updateItemsWithTarget: aTarget orWithHand: aHand
	"re-target all existing items"
	self items do: 
			[:item | item target ifNotNil: [
			item target isHandMorph 
				ifTrue: [item target: aHand]
				ifFalse: [item target: aTarget] ] ]! !

!MenuMorph methodsFor: 'accessing' stamp: 'AlainPlantec 12/14/2009 21:02'!
embeddable: aBoolean
	embeddable := aBoolean! !

!MenuMorph methodsFor: 'events' stamp: 'ar 10/10/2000 01:35'!
activate: evt
	"Receiver should be activated; e.g., so that control passes correctly."
	evt hand newMouseFocus: self.! !

!MenuMorph methodsFor: 'private' stamp: 'sw 5/1/2002 01:39'!
positionAt: aPoint relativeTo: aMenuItem inWorld: aWorld
	"Note: items may not be laid out yet (I found them all to be at 0@0),  
	so we have to add up heights of items above the selected item."

	| i yOffset sub delta |	
	self fullBounds. "force layout"
	i := 0.
	yOffset := 0.
	[(sub := self submorphs at: (i := i + 1)) == aMenuItem]
		whileFalse: [yOffset := yOffset + sub height].

	self position: aPoint - (2 @ (yOffset + 8)).

	"If it doesn't fit, show it to the left, not to the right of the hand."
	self right > aWorld worldBounds right
		ifTrue:
			[self right: aPoint x + 1].

	"Make sure that the menu fits in the world."
	delta := self bounds amountToTranslateWithin:
		(aWorld worldBounds withHeight: ((aWorld worldBounds height - 18) max: (ActiveHand position y) + 1)).
	delta = (0 @ 0) ifFalse: [self position: self position + delta]! !

!MenuMorph methodsFor: '*Tool-FileList' stamp: 'nk 2/15/2004 16:19'!
addService: aService for: serviceUser
	"Append a menu item with the given service. If the item is selected, it will perform the given service."

	aService addServiceFor: serviceUser toMenu: self.! !

!MenuMorph methodsFor: 'construction' stamp: 'NicolaiHess 9/8/2014 22:04'!
addUpdating: aWordingSelector target: aTarget selector: aSymbol

	self addUpdating: aWordingSelector target: aTarget selector: aSymbol argumentList: EmptyArray
! !

!MenuMorph methodsFor: 'keyboard control' stamp: 'dgd 9/9/2004 21:48'!
removeMatchString
	"Remove the matchString, if any."
	self setProperty: #matchString toValue: String new.
	self displayFiltered: nil! !

!MenuMorph methodsFor: 'construction' stamp: 'gvc 6/9/2006 09:25'!
addToggle: aString target: anObject selector: aSymbol getStateSelector: stateSymbol
	"Append a menu item with the given label. If the item is selected, it will send the given selector to the target object."

	self addToggle: aString
		target: anObject
		selector: aSymbol
		getStateSelector: stateSymbol
		argumentList: EmptyArray! !

!MenuMorph methodsFor: 'events' stamp: 'mtf 9/20/2007 05:37'!
mouseDown: evt
	"Handle a mouse down event."
	"Overridden to not grab on mouse down"
	(stayUp or:[self fullContainsPoint: evt position]) 
		ifFalse:[^self deleteIfPopUp: evt]. "click outside"
	self comeToFront! !

!MenuMorph methodsFor: 'private' stamp: 'ar 2/10/2001 00:37'!
morphicLayerNumber

	"helpful for insuring some morphs always appear in front of or behind others.
	smaller numbers are in front"
	^self valueOfProperty: #morphicLayerNumber  ifAbsent: [
		stayUp ifTrue:[100] ifFalse:[10]
	]! !

!MenuMorph methodsFor: 'modal control' stamp: 'ar 1/5/2002 21:34'!
modalSelection: anObject
	self setProperty: #modalSelection toValue: anObject.
	self isModalInvokationDone: true! !

!MenuMorph methodsFor: 'modal control' stamp: 'ar 1/5/2002 21:34'!
isModalInvokationDone: aBool
	self setProperty: #isModalInvokationDone toValue: aBool
! !

!MenuMorph methodsFor: 'menu' stamp: 'alain.plantec 2/9/2009 17:48'!
removeStayUpBox
	| box ext |
	submorphs isEmpty ifTrue: [^self].
	(submorphs first isAlignmentMorph) ifFalse: [^self].
	box := submorphs first submorphs last.
	ext := box extent.
	(box isKindOf: IconicButton) 
		ifTrue: 
			[box
				labelGraphic: (Form extent: ext depth: 8);
				shedSelvedge;
				borderWidth: 0;
				lock].
		box extent: ext.! !

!MenuMorph methodsFor: 'construction' stamp: 'StephaneDucasse 10/27/2014 17:54'!
add: aLabelString target: target selector: aSymbol argumentList: argList
	"Append a menu item with the given label. If the item is selected, it will send the given selector to the target object with the given arguments. If the selector takes one more argument than the number of arguments in the given list, then the triggering event is supplied as as the last argument."

	^ self
		addToggle: aLabelString
		target: target
		selector: aSymbol
		getStateSelector: nil
		enablementSelector: nil
		argumentList: argList! !

!MenuMorph methodsFor: 'actions' stamp: 'gvc 10/16/2008 16:37'!
themeChanged
	"Update the colour if specified."

	self color: (self theme menuColorFor: nil).
	super themeChanged! !

!MenuMorph methodsFor: 'events' stamp: 'NicolaiHess 4/5/2014 00:09'!
keyStroke: evt
	"Handle keboard item matching."
	
	| matchString char asc selectable help |
	help := self theme builder newBalloonHelp: 'Enter text to\narrow selection down\to matching items ' withCRs for: self corner: #topLeft.
	help popUpForHand: self activeHand.
	(self rootMenu hasProperty: #hasUsedKeyboard) 
		ifFalse: 
			[self rootMenu setProperty: #hasUsedKeyboard toValue: true.
			self changed].
	(evt commandKeyPressed and: [self commandKeyHandler notNil]) 
		ifTrue: 
			[self commandKeyHandler commandKeyTypedIntoMenu: evt.
			^self deleteIfPopUp: evt].
	char := evt keyCharacter.
	asc := char asciiValue.
	char = Character cr 
		ifTrue: 
			[selectedItem ifNotNil: 
					[selectedItem hasSubMenu 
						ifTrue: 
							[evt hand newMouseFocus: selectedItem subMenu.
							^evt hand newKeyboardFocus: selectedItem subMenu]
						ifFalse: 
							["self delete."

							^selectedItem invokeWithEvent: evt]].
			(selectable := self items) size = 1 
				ifTrue: [^selectable first invokeWithEvent: evt].
			^self].
	asc = 27 
		ifTrue: 
			["escape key"

			self valueOfProperty: #matchString
				ifPresentDo: 
					[:str | 
					str isEmpty 
						ifFalse: 
							["If filtered, first ESC removes filter"

							self setProperty: #matchString toValue: String new.
							self selectItem: nil event: evt.
							^self displayFiltered: evt]].
			"If a stand-alone menu, just delete it"
			popUpOwner ifNil: [^self delete].
			"If a sub-menu, then deselect, and return focus to outer menu"
			^ self deselectAndFocusOutermenuOn: evt].
		
	"Left arrow key - If we are in a submenu, then we remove myself (i.e., the current morph) and move the focus to the owner popup"
	(asc = 28)
		ifTrue: [ 			
				"If a stand-alone menu, do nothing"
				popUpOwner ifNil: [^self].
				"If a sub-menu, then deselect, and return focus to outer menu"
				^ self deselectAndFocusOutermenuOn: evt].
	
	"Right arrow key - If the selected menu item has a submenu, then we move the focus to the submenu "
	(asc = 29) 
		ifTrue: 
			["right arrow key"
			(selectedItem notNil and: [selectedItem hasSubMenu]) 
				ifTrue: 
					[evt hand newMouseFocus: selectedItem subMenu.
					selectedItem subMenu moveSelectionDown: 1 event: evt.
					^evt hand newKeyboardFocus: selectedItem subMenu]].
			
	asc = 30 ifTrue: [^self moveSelectionDown: -1 event: evt].	"up arrow key"
	asc = 31 ifTrue: [^self moveSelectionDown: 1 event: evt].	"down arrow key"
	asc = 11 ifTrue: [^self moveSelectionDown: -5 event: evt].	"page up key"
	asc = 12 ifTrue: [^self moveSelectionDown: 5 event: evt].	"page down key"
		
	"If we reach this point, it means that we are editing the filter associated to each menu. "
	"In case ther eis no filter associated to the menu, we simply create one"
	matchString := self valueOfProperty: #matchString ifAbsentPut: [ String new ].

	"If we press the backspace, then we simply remove the last character from matchString"
	(char = Character backspace and: [ matchString notEmpty ])
		ifTrue: [ matchString := matchString allButLast. 
				   self recordFiltering: matchString.
				   self displayFiltered: evt. ].
	
	"No need to go further if the character is not alphanumeric, i.e., not useful for filtering"
	char isAlphaNumeric ifFalse: [ ^ self ].
	matchString := matchString, char asString.
		
	self recordFiltering: matchString.
	self displayFiltered: evt.
	help := BalloonMorph string: 'Enter text to\narrow selection down\to matching items ' withCRs for: self corner: #topLeft.
	help popUpForHand: self activeHand.
! !

!MenuMorph methodsFor: 'control' stamp: 'StephaneDucasse 5/27/2010 22:23'!
popUpForHand: hand in: aWorld

	| p |
	"Present this menu under control of the given hand."
	p := hand position truncated.
	^self popUpAt: p forHand: hand in: aWorld
! !

!MenuMorph methodsFor: '*Deprecated40' stamp: 'StephaneDucasse 10/27/2014 20:20'!
addUpdating: aWordingSelector action: aSymbol
	self deprecated: 'Use addUpdating:selector:'.
	self addUpdating: aWordingSelector selector: aSymbol

! !

!MenuMorph methodsFor: 'control' stamp: 'ar 10/5/2000 19:31'!
popUpInWorld: aWorld
	"Present this menu under control of the given hand."
	^self popUpAt: aWorld primaryHand position forHand: aWorld primaryHand in: aWorld
! !

!MenuMorph methodsFor: 'events' stamp: 'ar 9/18/2000 10:13'!
handlesMouseDown: evt
	^true! !

!MenuMorph methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 5/8/2013 14:20'!
defaultBounds
	^ 0 @ 0 corner: 40 @ 10! !

!MenuMorph methodsFor: 'accessing' stamp: 'di 12/10/2001 22:11'!
rootMenu
	popUpOwner ifNil: [^ self].
	popUpOwner owner ifNil: [^ self].
	^ popUpOwner owner rootMenu! !

!MenuMorph methodsFor: 'modal control' stamp: 'AlainPlantec 12/19/2009 23:23'!
invokeModal
	"Invoke this menu and don't return until the user has chosen a value.
	See example below on how to use modal menu morphs."
	^ self invokeModal: self menuKeyboardControl

	"Example:
	| menu sub entry |
	menu := MenuMorph new.
	1 to: 3 do: [:i |
		entry := 'Line', i printString.
		sub := MenuMorph new.
		menu add: entry subMenu: sub.
		#('Item A' 'Item B' 'Item C')  do:[:subEntry|
			sub add: subEntry target: menu 
				selector: #modalSelection: argument: {entry. subEntry}]].
	menu invokeModal.
"

! !

!MenuMorph methodsFor: '*Deprecated40' stamp: 'StephaneDucasse 10/27/2014 08:11'!
addTranslatedList: aList
	"Add the given items to this menu, where each item is a pair (<string> <actionSelector>)..  If an element of the list is simply the symobl $-, add a line to the receiver.  The optional third element of each entry, if present, provides balloon help.
	The first and third items will be translated."

	self deprecated: 'Use addList: instead'.
	self addList: aList! !

!MenuMorph methodsFor: 'keyboard control' stamp: 'GabrielOmarCotelli 11/30/2013 16:51'!
selectMoreItem: evt
	| allItems |
	allItems := self submorphs select: [ :m | m isKindOf: MenuItemMorph ].
	allItems
		detect: [ :m | m contents size >= 4 and: [ (m contents first: 4) asString = 'more' ] ]
		ifFound: [ :more | 
			self selectItem: more event: evt.
			selectedItem invokeWithEvent: evt ]
		ifNone: [ self flash ]! !

!MenuMorph methodsFor: 'invoking' stamp: 'IgorStasenko 1/2/2012 18:10'!
informUserAt: aPoint during: aBlock 
	"Add this menu to the Morphic world during the execution of the given
	block. "
	| title w |
	title := self allMorphs
				detect: [:ea | ea hasProperty: #titleString].
	title := title submorphs first.
	self visible: false.
	w := ActiveWorld.
	aBlock
		value: [:string | 
			self visible
				ifFalse: [w addMorph: self centeredNear: aPoint.
					self visible: true].
			title contents: string.
			self setConstrainedPosition: self activeHand cursorPoint hangOut: false.
			self changed.
			w displayWorld
			"show myself"].
	self delete.
	w displayWorld! !

!MenuMorph methodsFor: 'construction' stamp: 'EstebanLorenzano 1/31/2013 19:25'!
addAllFromPragma: aString target: anObject
	self addAllFrom: (PragmaMenuBuilder 
		pragmaKeyword: aString
		model: anObject)
		menu ! !

!MenuMorph methodsFor: 'control' stamp: 'alain.plantec 2/9/2009 14:29'!
popUpEvent: evt in: aWorld
	"Present this menu in response to the given event."

	| aHand aPosition |
	aHand := evt ifNotNil: [evt hand] ifNil: [ActiveHand].
	aPosition := aHand position truncated.
	^ self popUpAt: aPosition forHand: aHand in: aWorld
! !

!MenuMorph methodsFor: 'copying' stamp: 'StephaneDucasse 9/30/2014 12:18'!
veryDeepInner: deepCopier
	"Copy all of my instance variables.  Some need to be not copied at all, but shared.  	Warning!!!!  Every instance variable defined in this class must be handled.  We must also implement veryDeepFixupWith:.  See DeepCopier class comment."

	super veryDeepInner: deepCopier.
	"defaultTarget := defaultTarget.		Weakly copied"
	selectedItem := selectedItem veryDeepCopyWith: deepCopier.
	stayUp := stayUp veryDeepCopyWith: deepCopier.
	popUpOwner := popUpOwner.		"Weakly copied"
	activeSubMenu := activeSubMenu. "Weakly copied"
	menuItems := menuItems.
! !

!MenuMorph methodsFor: 'accessing' stamp: 'sw 12/4/2001 21:22'!
commandKeyHandler
	"Answer the receiver's commandKeyHandler"

	^ self valueOfProperty: #commandKeyHandler ifAbsent: [nil]! !

!MenuMorph methodsFor: 'construction' stamp: 'BenjaminVanRyseghem 3/28/2011 15:48'!
addLine
	"Append a divider line to this menu. Suppress duplicate lines."
	self hasItems
		ifFalse: [^ nil].
	(self lastSubmorph isKindOf: MenuLineMorph)
		ifFalse: [^ self addMorphBack: MenuLineMorph new].
	^ nil! !

!MenuMorph methodsFor: 'construction' stamp: 'dgd 9/13/2004 19:59'!
addBlankIconsIfNecessary: anIcon 
	"If any of my items have an icon, ensure that all do by using  
	anIcon for those that don't"
	self items
		reject: [:each | each hasIconOrMarker]
		thenDo: [:each | each icon: anIcon]! !

!MenuMorph methodsFor: 'menu' stamp: 'wiz 1/16/2006 21:26'!
target: aMorph
"Set defaultTarget since thats what we got.
For the sake of targetSighting which assumes #target is a word we know."

defaultTarget := aMorph! !

!MenuMorph methodsFor: 'construction' stamp: 'StephaneDucasse 10/27/2014 20:20'!
addUpdating: wordingSelector target: target selector: aSymbol argumentList: argList
	"Append a menu item with the given label. If the item is selected, it will send the given selector to the target object with the given arguments. If the selector takes one more argument than the number of arguments in the given list, then the triggering event is supplied as as the last argument.  In this variant, the initial wording of the menu item is obtained by sending the wordingSelector to the target. If the wording prefixed with <yes> or <no>, the on/off state of the menu item will reflect it."
 
	|aString str|
	aString := (MessageSend receiver: target selector: wordingSelector) valueWithEnoughArguments: argList.
	self flag: #CleanYesNoOnOffAfter.
	(aString isKindOf: Association)
	     ifTrue: [aString := aString value]
		ifFalse: [
				str := aString readStream.
				(str skipTo: $>) ifTrue: [aString := str upToEnd]].
	self
		addToggle: aString
		target: target
		selector: aSymbol
		getStateSelector: wordingSelector
		enablementSelector: nil
		argumentList: argList
! !

!MenuMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 9/30/2014 13:45'!
menuItems
	^menuItems ifNil: [ menuItems:= OrderedCollection new].
! !

!MenuMorph methodsFor: 'keyboard control' stamp: 'sw 12/4/2001 20:13'!
handlesKeyboard: evt
	"Answer whether the receiver handles the keystroke represented by the event"

	^ evt anyModifierKeyPressed not or: [evt commandKeyPressed and: [self commandKeyHandler notNil]]! !

!MenuMorph methodsFor: 'menu' stamp: 'MarcusDenker 2/22/2010 09:27'!
setTarget: evt 
	"Set the default target object to be used for add item commands, and re-target all existing items to the new target or the the invoking hand."

	| oldDefaultTarget |
	oldDefaultTarget := defaultTarget .
	oldDefaultTarget ~~ defaultTarget 
		ifTrue: [self updateItemsWithTarget: defaultTarget orWithHand: evt hand ].
	! !

!MenuMorph methodsFor: 'accessing' stamp: 'ar 9/18/2000 11:18'!
hasSubMenu: aMenuMorph
	self items do: [:each | (each hasSubMenu: aMenuMorph) ifTrue:[^true]].
	^ false
! !

!MenuMorph methodsFor: '*Keymapping-Core' stamp: 'ThierryGoubier 9/15/2012 22:29'!
initializeShortcuts: aKMDispatcher
	super initializeShortcuts: aKMDispatcher.
	aKMDispatcher attachCategory: #MorphFocusNavigation! !

!MenuMorph methodsFor: 'construction' stamp: 'nk 4/6/2002 22:41'!
addStayUpItem
	"Append a menu item that can be used to toggle this menu's persistence."

	(self valueOfProperty: #hasTitlebarWidgets ifAbsent: [ false ])
		ifTrue: [ ^self ].
	self addStayUpIcons.! !

!MenuMorph methodsFor: 'menu' stamp: 'nk 3/31/2002 18:36'!
removeStayUpItems
	| stayUpItems |
	stayUpItems := self items select: [ :item | item isStayUpItem ].
	stayUpItems do: [ :ea | ea delete ].
! !

!MenuMorph methodsFor: 'accessing' stamp: 'alain.plantec 2/9/2009 16:16'!
stayUp: aBoolean

	stayUp := aBoolean.
	aBoolean ifTrue: [ self removeStayUpBox ].! !

!MenuMorph methodsFor: 'construction' stamp: 'jm 11/4/97 07:46'!
defaultTarget: anObject
	"Set the default target for adding menu items."

	defaultTarget := anObject.
! !

!MenuMorph methodsFor: 'keyboard control' stamp: 'rr 3/24/2004 13:41'!
moveDown: evt 
	^self moveSelectionDown: 1 event: evt! !

!MenuMorph methodsFor: 'control' stamp: 'sw 12/17/2001 16:43'!
popUpNoKeyboard
	"Present this menu in the current World, *not* allowing keyboard input into the menu"

	^ self popUpAt: ActiveHand position forHand: ActiveHand in: ActiveWorld allowKeyboard: false! !

!MenuMorph methodsFor: 'modal control' stamp: 'sw 2/3/2002 14:26'!
invokeModal: allowKeyboardControl
	"Invoke this menu and don't return until the user has chosen a value.  If the allowKeyboarControl boolean is true, permit keyboard control of the menu"

	^ self invokeModalAt: ActiveHand position in: ActiveWorld allowKeyboard: allowKeyboardControl! !

!MenuMorph methodsFor: '*Deprecated40' stamp: 'StephaneDucasse 10/27/2014 09:35'!
add: aLabelString action: aSymbol
	"Append a menu item with the given label. If the item is selected, it will send the given selector to the default target object."
	"Details: Note that the menu item added captures the default target object at the time the item is added; the default target can later be changed before added additional items without affecting the targets of previously added entries. The model is that each entry is like a button that knows everything it needs to perform its action."

	self deprecated: 'Use add:selector:'.
	self add: aLabelString selector: aSymbol! !

!MenuMorph methodsFor: 'menu' stamp: 'DamienCassou 9/23/2009 08:46'!
addTitle

	| string |
	string := UIManager default request: 'Title for this menu?' translated.
	string isEmptyOrNil ifTrue: [^ self].
	self addTitle: string.
! !

!MenuMorph methodsFor: 'keyboard control' stamp: 'rr 3/24/2004 13:45'!
filterListWith: char 
	| matchString |
	matchString := self valueOfProperty: #matchString ifAbsentPut: [String new].
	matchString := char = Character backspace 
				ifTrue: 
					[matchString isEmpty ifTrue: [matchString] ifFalse: [matchString allButLast]]
				ifFalse: [matchString copyWith: char].
	self setProperty: #matchString toValue: matchString! !

!MenuMorph methodsFor: 'actions' stamp: 'BenjaminVanRyseghem 11/1/2013 14:43'!
addIfNeededTitle: aTitle andIcon: anIcon

	(aTitle notNil or: [ anIcon notNil ])
		ifTrue: [ self addTitle: aTitle icon: anIcon ]! !

!MenuMorph methodsFor: 'control' stamp: 'sw 2/18/2001 00:52'!
popUpInWorld
	"Present this menu in the current World"

	^ self popUpInWorld: self currentWorld! !

!MenuMorph methodsFor: 'construction' stamp: 'gvc 11/20/2007 13:34'!
addToggle: aString selector: aSymbol
	"Append a menu item with the given label. If the item is selected,
	it will send the given selector to the default target object."

	self addToggle: aString
		target: defaultTarget
		selector: aSymbol
		getStateSelector: nil
		argumentList: EmptyArray! !

!MenuMorph methodsFor: 'private' stamp: 'NicolaiHess 12/18/2014 01:28'!
restoreFocus: originalFocusHolder in: aWorld
	"restore only if current focus holder is nil "

	aWorld primaryHand keyboardFocus ifNotNil: [ ^ self ].
	originalFocusHolder ifNotNil: [ aWorld primaryHand newKeyboardFocus: originalFocusHolder ]! !

!MenuMorph methodsFor: '*Deprecated40' stamp: 'StephaneDucasse 10/27/2014 08:17'!
add: aLabelString target: aTarget action: aSymbol
	
	self deprecated: 'use add: aString target: aTarget selector: aSymbol' on: '15 august' in: #Pharo40. 
	^ self add: aLabelString target: aTarget selector: aSymbol! !

!MenuMorph methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/26/2015 18:37'!
spotterItemsFor: aStep
	<spotterOrder: 10>
	self flag: #refactoringViolationForSpotterActDefault:.
	^ aStep listProcessor 
		title: 'Items';
		candidatesLimit: Float infinity;
		allCandidates: [ self items ];
		itemName: #contents;
		itemIcon: [ :item | item icon ];
		actLogic: [ :item | item hasSubMenu 
					ifTrue: [ aStep diveIn ] 
					ifFalse: [ item spotterActDefault. aStep exit ] ];
		filter: GTFilterSubstring ! !

!MenuMorph methodsFor: 'accessing' stamp: 'jm 11/4/97 07:46'!
stayUp

	^ stayUp
! !

!MenuMorph methodsFor: 'events' stamp: 'NicolaiHess 12/17/2014 21:52'!
handleFocusEvent: evt
	"Handle focus events. Valid menu transitions are determined based on the menu currently holding the focus after the mouse went down on one of its children."
	self processEvent: evt.

	"Need to handle keyboard input if we have the focus."
	evt isKeyboard ifTrue: [^ self handleEvent: evt].

	"We need to handle button clicks outside and transitions to local popUps so throw away everything else"
	(evt isMouseOver or:[evt isMouse not]) ifTrue:[^self].
	"What remains are mouse buttons and moves"
	evt isMove ifFalse:[^self handleEvent: evt]. "handle clicks outside by regular means"
	"Now it's getting tricky. On #mouseMove we might transfer control to *either* the currently active submenu or the pop up owner, if any. Since the active sub menu is always displayed upfront check it first."
	selectedItem ifNotNil:[(selectedItem activateSubmenu: evt) ifTrue:[^self]].
	"If we aren't under the hand anymore, transfer to the owner"
   (self fullContainsPoint: evt position) ifFalse:[
	popUpOwner ifNotNil:[(popUpOwner activateOwnerMenu: evt) ifTrue:[^self]]]! !

!MenuMorph methodsFor: 'construction' stamp: 'StephaneDucasse 10/27/2014 08:16'!
add: aLabelString subMenu: aMenuMorph 
	"Append the given submenu with the given label."
	self
		add: aLabelString
		icon: nil
		subMenu: aMenuMorph! !

!MenuMorph methodsFor: 'actions' stamp: 'gvc 3/29/2007 16:28'!
adoptPaneColor: paneColor
	"Change our color."
	
	super adoptPaneColor: paneColor.
	paneColor ifNil: [^self].
	self color: paneColor! !

!MenuMorph methodsFor: 'private' stamp: 'EstebanLorenzano 5/15/2014 19:05'!
setDefaultParameters
	"change the receiver's appareance parameters"

	self
		color: self theme settings derivedMenuColor;
		borderWidth: self theme menuBorderWidth;
		borderColor: self theme menuBorderColor.
	 self theme settings flatMenu 
		ifFalse: [
			self borderStyle: BorderStyle thinGray.
			self
				hasDropShadow: true;
				shadowColor:  self theme menuShadowColor;
				shadowOffset: 1 @ 1].
	self layoutInset: 3.
	self cellInset: 0@1.
! !

!MenuMorph methodsFor: 'private' stamp: 'ar 9/18/2000 12:12'!
selectedItem
	^selectedItem! !

!MenuMorph methodsFor: 'control' stamp: 'NicolaiHess 4/5/2014 00:09'!
deselectAndFocusOutermenuOn: anEvent
	"deselect and return focus to outer menu"

	self selectItem: nil event: anEvent.
	anEvent hand newMouseFocus: popUpOwner owner.
	^ anEvent hand newKeyboardFocus: popUpOwner owner! !

!MenuMorph methodsFor: 'menu' stamp: 'alain.plantec 2/8/2009 19:27'!
detachSubMenu: evt
	| possibleTargets item subMenu index |
	possibleTargets := self items select:[:any| any hasSubMenu].
	possibleTargets size > 0 ifTrue:[
		index := UIManager default  
				chooseFrom: (possibleTargets collect:[:t| t contents asString]) 
				title: 'Which menu?' translated.
		index = 0 ifTrue:[^self]].
	item := possibleTargets at: index.
	subMenu := item subMenu.
	subMenu ifNotNil: [
		item subMenu: nil.
		item delete.
		subMenu stayUp: true.
		subMenu popUpOwner: nil.
		subMenu addTitle: item contents.
		evt hand attachMorph: subMenu].
! !

!MenuMorph methodsFor: 'modal control' stamp: 'NicolaiHess 12/18/2014 01:29'!
invokeModalAt: aPoint in: aWorld allowKeyboard: aBoolean
	"Invoke this menu and don't return until the user has chosen a value.
	See senders of this method for finding out how to use modal menu morphs."
	| w originalFocusHolder |
	originalFocusHolder := aWorld primaryHand keyboardFocus.
	self popUpAt: aPoint forHand: aWorld primaryHand in: aWorld allowKeyboard: aBoolean.
	self isModalInvokationDone: false.
	w := aWorld outermostWorldMorph. "containing hand"
	[self isInWorld and: [ self isModalInvokationDone not ] ] whileTrue: [w doOneSubCycle].
	self delete.
	self restoreFocus: originalFocusHolder in: aWorld.
	^ self modalSelection! !

!MenuMorph methodsFor: 'construction' stamp: 'gvc 6/9/2006 09:45'!
addToggle: aString target: anObject selector: aSymbol getStateSelector: stateSymbol enablementSelector: enableSymbol
	"Append a menu item with the given label. If the item is selected, it will send the given selector to the target object."

	self addToggle: aString
		target: anObject
		selector: aSymbol
		getStateSelector: stateSymbol
		enablementSelector: enableSymbol
		argumentList: EmptyArray! !

!MenuMorph methodsFor: 'construction' stamp: 'FernandoOlivero 4/12/2011 09:53'!
addStayUpIcons
	"Add the titlebar with buttons."
	
	|title closeBox pinBox titleBarArea titleString spacer1 spacer2|
	title := submorphs
		detect: [:ea | ea hasProperty: #titleString]
		ifNone: [self setProperty: #needsTitlebarWidgets toValue: true.
				^self].
	closeBox := IconicButton new target: self;
		actionSelector: #delete;
		labelGraphic: self theme menuCloseForm;
		color: Color transparent;
		extent: 18 @ 18;
		borderWidth: 0.
	pinBox := IconicButton new target: self;
		actionSelector: #stayUp:;
		arguments: {true};
		labelGraphic: self theme menuPinForm;
		color: Color transparent;
		extent: 18 @ 18;
		borderWidth: 0.
	closeBox setBalloonText: 'Close this menu' translated.
	pinBox setBalloonText: 'Keep this menu up' translated.
	spacer1 := AlignmentMorph newSpacer: Color transparent.
	spacer1 width: 14;
		 hResizing: #rigid.
	spacer2 := AlignmentMorph newSpacer: Color transparent.
	spacer2 width: 14;
		 hResizing: #rigid.
	titleBarArea := AlignmentMorph newRow vResizing: #shrinkWrap;
		layoutInset: 2;
		color: title color;
		addMorphBack: closeBox;
		addMorphBack: spacer1;
		addMorphBack: title;
		addMorphBack: spacer2;
		addMorphBack: pinBox.
	title color: Color transparent.
	titleString := title
		findDeepSubmorphThat: [:each | each respondsTo: #font:]
		ifAbsent: [].
	titleString font: StandardFonts windowTitleFont.
	self theme currentSettings preferRoundCorner ifTrue: [
		titleBarArea
			roundedCorners: #(1 4);
			useRoundedCorners].
	self addMorphFront: titleBarArea.
	titleBarArea
		setProperty: #titleString
		toValue: (title valueOfProperty: #titleString).
	title removeProperty: #titleString.
	self setProperty: #hasTitlebarWidgets toValue: true.
	self removeProperty: #needsTitlebarWidgets.
	self removeStayUpItems! !

!MenuMorph methodsFor: 'control' stamp: 'AlainPlantec 12/19/2009 23:23'!
popUpAt: aPoint forHand: hand in: aWorld
	"Present this menu at the given point under control of the given hand.  Allow keyboard input into the menu."

	^ self popUpAt: aPoint forHand: hand in: aWorld allowKeyboard: self menuKeyboardControl! !

!MenuMorph methodsFor: 'dropping/grabbing' stamp: 'mtf 9/19/2007 12:26'!
mouseDownInTitle: evt
	"Handle a mouse down event in the title bar."
	"Grab the menu and drag it to some other place"
	evt hand grabMorph: self.! !

!MenuMorph methodsFor: 'construction' stamp: 'BenjaminVanRyseghem 3/28/2011 15:00'!
addMenuItem: anItem
	self addMorphBack: anItem.
	^ self menuItems add: anItem.
! !

!MenuMorph methodsFor: 'modal control' stamp: 'ar 1/5/2002 21:33'!
isModalInvokationDone
	^self valueOfProperty: #isModalInvokationDone ifAbsent:[false]! !

!MenuMorph methodsFor: 'construction' stamp: 'gvc 6/9/2006 09:39'!
addToggle: aString target: anObject selector: aSymbol getStateSelector: stateSymbol argumentList: argList
	"Append a menu item with the given label. If the item is selected, it will send the given selector to the target object."

	self addToggle: aString
		target: anObject
		selector: aSymbol
		getStateSelector: stateSymbol
		enablementSelector: nil
		argumentList: argList! !

!MenuMorph methodsFor: '*Tool-FileList' stamp: 'StephaneDucasse 3/5/2010 14:41'!
addServices: services for: served extraLines: linesArray

	services withIndexDo: [:service :i |
		self addService: service for: served.
		submorphs last setBalloonText: service description.
		(linesArray includes: i) | service usingLineAfter 
			ifTrue: [self addLine]].
! !

!MenuMorph methodsFor: 'control' stamp: 'StephaneDucasse 5/28/2011 13:40'!
wantsToBeDroppedInto: aMorph
	"Return true if it's okay to drop the receiver into aMorph.  A single-item MenuMorph is in effect a button rather than a menu, and as such should not be reluctant to be dropped into another object."

	^ (aMorph isWorldMorph or: [submorphs size = 1]) or: [self embeddable]! !

!MenuMorph methodsFor: 'control' stamp: 'StephaneDucasse 9/30/2014 12:01'!
activeSubmenu: aSubmenu 
	activeSubMenu
		ifNotNil: [activeSubMenu delete].
	activeSubMenu := aSubmenu.
	! !

!MenuMorph methodsFor: 'accessing' stamp: 'HilaireFernandes 11/19/2010 17:02'!
embeddable
	^ embeddable ifNil: [embeddable := false].
! !

!MenuMorph methodsFor: 'dropping/grabbing' stamp: 'ar 10/11/2000 14:23'!
justDroppedInto: aMorph event: evt
	| halo |
	super justDroppedInto: aMorph event: evt.
	halo := evt hand halo.
	(halo notNil and:[halo target hasOwner: self]) ifTrue:[
		"Grabbed single menu item"
		self addHalo: evt.
	].
	stayUp ifFalse:[evt hand newMouseFocus: self].! !

!MenuMorph methodsFor: 'events' stamp: 'nice 1/5/2010 15:59'!
popUpAdjacentTo: rightOrLeftPoint forHand: hand from: sourceItem 
	"Present this menu at the given point under control of the given  
	hand."
	| tryToPlace selectedOffset |
	hand world startSteppingSubmorphsOf: self.
	popUpOwner := sourceItem.
	self fullBounds.
self updateColor.
	"ensure layout is current"
	selectedOffset := (selectedItem
				ifNil: [self items first]) position - self position.
	tryToPlace := [:where :mustFit | | delta | 
			self position: where - selectedOffset.
			delta := self fullBoundsInWorld amountToTranslateWithin: sourceItem worldBounds.
			(delta x = 0
					or: [mustFit])
				ifTrue: [delta = (0 @ 0)
						ifFalse: [self position: self position + delta].
					sourceItem world addMorphFront: self.
					^ self]].
	tryToPlace value: rightOrLeftPoint first value: false;
		 value: rightOrLeftPoint last - (self width @ 0) value: false;
		 value: rightOrLeftPoint first value: true! !

!MenuMorph methodsFor: 'control' stamp: 'alain.plantec 2/9/2009 12:41'!
selectItem: aMenuItem event: anEvent
	selectedItem ifNotNil:[selectedItem deselect: anEvent].
	selectedItem := aMenuItem.
	selectedItem ifNotNil:[selectedItem select: anEvent].! !

!MenuMorph class methodsFor: 'private - utilities' stamp: 'StephaneDucasse 10/26/2014 18:15'!
confirm: queryString trueChoice: trueChoice falseChoice: falseChoice
	"Put up a yes/no menu with caption queryString. The actual wording for the two choices will be as provided in the trueChoice and falseChoice parameters. Answer true if the response is the true-choice,  false if it's the false-choice. This is a modal question -- the user must respond one way or the other.  Do not invoke this method - it is here to help in case of mini system, better use UIManager default"

	"MenuMorph 
		confirm: 'Are you sure?'  
		trueChoice: 'yes, I''m '  
		falseChoice: 'no, I just thought'"

	| menu aBlock result |
	(ProvideAnswerNotification signal: queryString) ifNotNil: [ :answer | ^ trueChoice = answer ].
	aBlock := [ :v | result := v ].
	menu := self new.
	menu addTitle: queryString icon: Smalltalk ui icons confirmIcon.
	menu
		add: trueChoice
		target: aBlock
		selector: #value:
		argument: true.
	menu
		add: falseChoice
		target: aBlock
		selector: #value:
		argument: false.
	[ 
	menu invokeAt: ActiveHand position in: ActiveWorld allowKeyboard: true.
	result isNil ] whileTrue.
	^ result! !

!MenuMorph class methodsFor: 'images' stamp: 'alain.plantec 2/9/2009 16:44'!
pushPinImage
	"Answer the push-pin image, creating and caching
	it at this time if it is absent"
	^ PushPinImage
				ifNil: [PushPinImage := Form
								extent: 16 @ 16
								depth: 32
								fromArray: #(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4289374634 4280690213 4282467139 4281811785 4286217083 0 0 0 0 0 0 0 0 0 0 0 4279900698 4289771447 4283150819 4278686942 4278602609 4281216819 4292862175 0 0 0 0 0 0 0 0 4292598747 4278519045 4291812321 4278425828 4278229220 4278360034 4278533726 4281676595 0 0 0 0 0 0 0 0 4293059298 4278781959 4289902007 4280591330 4278294757 4278359779 4278618315 4278454800 4287730065 0 0 0 0 4293717228 4289835441 4291743438 4288782753 4278782730 4283980117 4287155693 4278294756 4278360036 4278425831 4278725183 4281348657 0 0 0 4293190884 4281413937 4281677109 4278387459 4278584069 4278457889 4278717198 4285372595 4278753764 4278359781 4278556389 4278468957 4278650887 0 0 0 4286019447 4284243036 4283914071 4278781702 4285033581 4279932888 4278683597 4278490589 4278490848 4278620633 4278621404 4278591793 4279242768 0 0 0 4283519312 4285295466 4290165174 4290164405 4294638071 4282232039 4278491363 4278620380 4278723896 4278519564 4278389263 4278387459 4285427310 0 0 0 4285887863 4280431419 4286696174 4290634484 4286170860 4278818529 4278619863 4278661191 4278913293 4285493359 4284177243 4288585374 4294177779 0 0 0 4291480781 4278322439 4278614713 4278490852 4278622435 4278613940 4278458404 4278321667 4278518531 4288914340 0 0 0 0 0 0 0 4281018922 4278464064 4278359263 4278491102 4278724669 4278518276 4278387461 4278321666 4282532418 0 0 0 0 0 0 4292730333 4279045132 4278584327 4278665827 4278489307 4278621404 4278480807 4278595138 4278453252 4281677109 0 0 0 0 0 0 4284900966 4278848010 4283650898 4278781962 4278523682 4278726730 4278592304 4278454027 4278519045 4287861651 0 0 0 0 0 0 4280887593 4290493371 0 4290822079 4284308832 4280163615 4279439633 4281611320 4288322202 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 )
								offset: 0 @ 0]! !

!MenuMorph class methodsFor: 'private - utilities' stamp: 'StephaneDucasse 10/26/2014 18:14'!
chooseFrom: aList lines: linesArray title: queryString
	"Choose an item from the given list. Answer the index of the selected item. Do not invoke this method - it is here to help in case of mini system, better use UIManager default"
	
	
	"MenuMorph
		chooseFrom: #('Hello' 'Pharoers' 'Here' 'We' 'Go')
		lines: #(2 4)
		title: 'What''s up?'"
		
	| menu result |
	(ProvideAnswerNotification signal: queryString) ifNotNil:[:answer | 
		1 to: aList size do:[:i| (aList at: i) = answer ifTrue:[^i]].
		^0].
	result := 0.
	menu := self new.
	menu addTitle: queryString.
	1 to: aList size do:[:i| 
		menu add: (aList at: i) asString target: [:v| result := v] selector: #value: argument: i.
		(linesArray includes: i) ifTrue: [menu addLine]].
	
	menu invokeAt: ActiveHand position in: ActiveWorld allowKeyboard: true.
	^result! !

!MenuMorph class methodsFor: 'private - utilities' stamp: 'StephaneDucasse 10/26/2014 18:15'!
chooseFrom: aList values: valueList lines: linesArray title: queryString
	"Choose an item from the given list. Answer the index of the selected item.  Do not invoke this method - it is here to help in case of mini system, better use UIManager default"
	
	"MenuMorph
		chooseFrom: #('Hello' 'Pharoers' 'Here' 'We' 'Go')
		values: #('Ph' 'Pha' 'Pharo' 'Yeah' 'YeahYeah')
		lines: #(2 4)
		title: 'What''s up?'"
		
	| menu result |
	(ProvideAnswerNotification signal: queryString) ifNotNil:[:answer | 
		1 to: aList size do:[:i| (aList at: i) = answer ifTrue:[^answer]].
		^nil].
	result := nil.
	menu := self new.
	menu addTitle: queryString.
	1 to: aList size do:[:i| 
		menu add: (aList at: i) asString target: [:v| result := v] selector: #value: argument: (valueList at: i).
		(linesArray includes: i) ifTrue:[menu addLine]].

	menu invokeAt: ActiveHand position in: ActiveWorld allowKeyboard: true.
	^result! !

!MenuMorph class methodsFor: 'private - utilities' stamp: 'StephaneDucasse 10/26/2014 18:15'!
confirm: queryString orCancel: cancelBlock 
	"Put up a yes/no/cancel menu with caption aString. Answer true if  the response is yes, false if no. If cancel is chosen, evaluate cancelBlock. This is a modal question--the user must respond yes or no.  Do not invoke this method - it is here to help in case of mini system, better use UIManager default"
	"MenuMorph confirm: 'Reboot universe now' orCancel:[^'Nevermind'] "
	
	| choice |
	choice := self chooseFrom: {'Yes' translated. 'No' translated. 'Cancel' translated}
		lines: #()
		title: queryString.
	choice = 1 ifTrue: [^ true].
	choice = 2 ifTrue: [^ false].
	^ cancelBlock value! !

!MenuMorph class methodsFor: 'instance creation' stamp: 'jm 5/14/1998 17:21'!
entitled: aString
	"Answer a new instance of me with the given title."

	^ self new addTitle: aString
! !

!MenuMorph class methodsFor: 'instance creation' stamp: 'AlainPlantec 1/5/2010 12:27'!
initialize
	"MenuMorph initialize"
	PushPinImage := nil! !

!MenuMorph class methodsFor: 'example' stamp: 'StephaneDucasse 10/27/2014 09:34'!
example
	"MenuMorph example openInHand"
	<example>
	
	| menu |
	menu := MenuMorph new.
	menu addStayUpItem.
	menu add: 'apples' selector: #apples.
	menu add: 'oranges' selector: #oranges.
	menu addLine.
	menu addLine.  "extra lines ignored"
	menu add: 'peaches' selector: #peaches.
	menu addLine.
	menu add: 'pears' selector: #pears.
	menu addLine.
	^ menu
! !

!MenuMorph class methodsFor: 'images' stamp: 'jrp 7/27/2005 23:11'!
closeBoxImage
	"Supplied here because we don't necessarily have ComicBold"

	^ CloseBoxImage ifNil: [CloseBoxImage := SystemWindow closeBoxImage]! !

!MenuMorph class methodsFor: 'utilities' stamp: 'StephaneDucasse 10/26/2014 18:11'!
confirm: queryString
	"Put up a yes/no menu with caption queryString. Answer true if the response is yes, false if no. This is a modal question--the user must respond yes or no. Do not invoke this method - it is here to help in case of mini system, better use
	UIManager default confirm: 'Is is the question?' "

	^ self confirm: queryString trueChoice: 'Yes' translated falseChoice: 'No' translated! !

!MenuMorph class methodsFor: 'instance creation' stamp: 'StephaneDucasse 10/27/2014 09:37'!
fromList: anArray 
	"Construct a menu from an array of descriptions. See #addList comment"

	^ self new addList: anArray.
! !

!MenuMorph class methodsFor: '*Deprecated40' stamp: 'StephaneDucasse 10/27/2014 09:38'!
fromArray: anArray 
	"Construct a menu from anArray. See #addList comment"
	self deprecated: 'Use fromList: instead'.
	^ self fromList: anArray.
! !

!MenuMorph class methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/26/2015 18:40'!
gtExampleMenuMorph
	<gtExample>
	^ self example
	! !

!MenuRegistration commentStamp: 'AlainPlantec 2/16/2010 23:17'!
A MenuRegistration stores the declaration of a menu item. It is mainly an handler for a PluggableMenuItemSpec. 

A menu item is declared withing a particular method tagged with a pragma. This kind-of method takes a builder as argument and its evaluation results in the building of a MenuRegistration sub-tree which is stored in the builder.   As an example:
MenuRegistrationExample class>>myOwnCoolToolRegistrationOn: aBuilder 
	<worldMenuExample> 
	(aBuilder item: #MyOwnCoolTool)
		label: 'My own cool tool';
		target: Workspace; 
		selector: #openContents: ;
		arguments: #('yep, my own cool tool can be opened from the world menu !! :)')
	
Evaluating this method results in the creation of a MenuRegistration which name is #MyOwnCoolTool. Thus, the resulting sub-tree is only made of a root node. After it has be built, this root node is recorded in the builder. To experiment this, just evaluate the following code:
-------------
| builder |
builder := PragmaMenuBuilder new.
MenuRegistrationExample myOwnCoolToolRegistrationOn: builder.
builder explore
-------------

Using pragma allows the menu builder to dynamically discover which are the methods to evaluate in order to build a menu. Thus, a resulting menu is built by evaluating a set of methods which share the same pragma keyword.
In the following example, all method having <worldMenuExample> are evaluated for the building of the resulting menu:
---------------
(PragmaMenuBuilder pragmaKeyword: 'worldMenuExample' model: nil) menu popUpInWorld
---------------

Within a method, three kind of declarations can be used: (1) item by item (2) an item with a sub-menu and (3) a group.

1 -  item by item menu registration declaration:
This kind of declaring is for the setting of one menu item and only one within a method.

1.1 -  A simple menu item with an action
In the following example, a menu item with the name #'Browser' and a action which 
consists in sending #openClassBrowser to StandardToolSet is declared:

AClassSomewhere class>>openBrowserOn: aBuilder
	<myMenuTest>
	(aBuilder item: #'Browser') 
		target: StandardToolSet; 
		selector: #openClassBrowser.

A simple action without any argument can also be set with a block:
	(aBuilder item: #'Browser') action: [StandardToolSet openClassBrowser]

You can also indicate a balloon help string and a particular icon:
	(aBuilder item: #'Browser') 
		action: [StandardToolSet openClassBrowser];
		help: 'Open a system browser';
		icon: MenuIcons smallSystemBrowserIcon

If the action needs one or several arguments, you can also give it/them as follow:
	(aBuilder item: #'Save and quit') 
		target: SmalltalkImage current; 
		selector: #snapshot:andQuit:.
		arguments: #(true true)
		
By default, the item label is set with the item name but it can be explicitly given as follow:
	(aBuilder item: #'Browser')
		label: 'System browser'; 
		target: StandardToolSet; 
		selector: #openClassBrowser.

1.2  -  Placing the menu item in a  menu
The resulting menu item of previous example will be placed at the root of the menu.
In order to declare another place for it, you have to explicitly set its parent name.
As an example, consider the following item which declares a simple entry with no action.
Such item is typically used as a root for a sub-menu tree:

AClassSomewhere class>>openToolsOn: aBuilder
	<myMenuTest>
	(aBuilder item: #'Tools')

Now, a sub-menu item for #Tools can be declared separately, within another method
by using the #parent: message:

AnotherClassSomewhere class>>myToolsOn: aBuilder
	<myMenuTest>
	(aBuilder item: #'CoolTool')
		label: 'Cool tool';
		parent: #Tools;

Note that the argument of #parent: must be the name of another item. 
If it is not the case, then the parent name indication is simply ignored.

1.3  -  Item ordering

If no ordering setting is indicated, items ordering is unpredicable (it depends on method retrieving order). If one want an item to appear at a certain position, it is possible to set it by sending #order: to a MenuRegistration. The #order: message takes a float as argument. 
As an example, see  the two following declarations, in the resulting menu, Wozy is placed before 'Wozy configuration'

AnotherClassSomewhere class>>myWozySystemOpenOn: aBuilder
	<myMenuTest>
	(aBuilder item: #'Wozy')
		parent: #CoolTool;
		order: 1.0
		
AnotherClassSomewhere class>>myWozySystemConfigOn: aBuilder
	<myMenuTest>
	(aBuilder item: #'Wozy configuration')
		parent: #CoolTool;
		order: 2.0

2) Item with a submenu
The one menu item - one declaring method way can be ugly. When a set a menu items are known to be put all-together, it is possible to declare the sub-tree in one method. The following example show such a sub-tree with the #Tools item at root and four sub-items declared in a single method. Note a menu target declared for the root is shared by all sub-items. In that case, it also remains possible for a sub-item to declare its own target.

AClassSomewhere class>>openToolsOn: aBuilder
	<myMenuTest>
	(aBuilder item: #'Tools')
		target:  StandardToolSet; "The target is shared by all children"
		with: [ "My sub-menu are given here"
			(aBuilder item: #'System browser') selector: #openClassBrowser.
			(aBuilder item: #Workspace) selector: #openWorkspace.
			(aBuilder item: #'Test Runner') selector: #openTestRunner.
			(aBuilder item: #'Monticello Browser') selector: #openMonticelloBrowser]
		
3) group of menu items
When you want some items to be shown always grouped together, you can use a group. Its declaring is like an item with a submenu except that you are using the message #group: instead of #item:. The consequence is that only the children are shown in the menu. Of course, #label and #icon: are ignored for a group. Here is an example:

AClassSomewhere class>>mostUsedToolsOn: aBuilder
	<myMenuTest>
	(aBuilder group: #MostUsedTools) "My name can be also used as parent name"
		withSeparatorAfter; "A separator will be added after my last child"
		order: 0; "the entire group will be placed at the top"
		target:  StandardToolSet; "The target is shared by all children"
		with: [
			(aBuilder item: #'System browser') selector: #openClassBrowser.
			(aBuilder item: #Workspace) selector: #openWorkspace.
			(aBuilder item: #'Test Runner') selector: #openTestRunner.
			(aBuilder item: #'Monticello Browser') selector: #openMonticelloBrowser]

---------------------------
		
Instance Variables
	isGroup:		<Boolean>
	itemList:		<SortedCollection>
	order:		<Number>
	owner:		<MenuRegistration>
	parentName:		<Symbol>
	spec:		<PluggableMenuItemSpec>

isGroup
	- if true, then this item is ignored and flatten

itemList
	- all my MenuRegistration (my sub-menus or my elements if i'm a group)

order
	- my order in the owner list

owner
	- my owner

parentName
	- the declared parent name which serve as basis for PragmaBenuBuilder>>#arrangeRegistrations

spec
	- my PluggableMenuItemSpec
!
!MenuRegistration methodsFor: 'accessing' stamp: 'AlainPlantec 4/10/2010 09:31'!
precondition: aValuable
	precondition := aValuable! !

!MenuRegistration methodsFor: 'accessing' stamp: 'AlainPlantec 2/10/2010 21:03'!
parent: aSymbol
	self parentName: aSymbol! !

!MenuRegistration methodsFor: 'accessing' stamp: 'StephaneDucasse 6/5/2011 22:43'!
buildMenuSpec: aMenu 
	"recursiveley build the menu spec aMenu passed as argument"
	self itemList
		ifNotNil: [:l | 
			| m |
			m := isGroup 
				ifFalse: [PluggableMenuSpec withModel: nil]
				ifTrue: [aMenu].
			(l reject: [:i | i precondition value not]) do: [:i | i buildMenuSpec: m].
			isGroup ifFalse: [self spec subMenu: m]].
	isGroup
		ifTrue: [self spec separator ifTrue: [self itemList ifNotNil: [self itemList last spec separator: true]]] 
		ifFalse: [aMenu items add: self spec]! !

!MenuRegistration methodsFor: 'accessing' stamp: 'AlainPlantec 2/16/2010 16:45'!
addItem: anItem 
	"Add a MenuRegistration"
	self ensureItemList add: anItem! !

!MenuRegistration methodsFor: 'accessing' stamp: 'AlainPlantec 2/16/2010 11:42'!
isGroup: aBoolean
	isGroup := aBoolean! !

!MenuRegistration methodsFor: 'sub item creating' stamp: 'AlainPlantec 2/16/2010 13:08'!
item: aSymbol
	"set my name and my label with aSymbol (the label and the name as the same by default) and register myself as a child of my owner"
	^ (self builder newSubItem) name: aSymbol; label: aSymbol asString
! !

!MenuRegistration methodsFor: 'accessing' stamp: 'AlainPlantec 2/16/2010 16:45'!
itemList
	"Return my children"
	^ itemList 
! !

!MenuRegistration methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/24/2012 20:29'!
itemNamed: aName
	"Return the MenuRegistration named aName or nil if none is found"
	| result |
	self name = aName ifTrue: [^ self].
	result :=  self itemList ifNotNil: [:l | l detect: [:item | (item itemNamed: aName) notNil] ifNone: []].
	^ result
		ifNil: [ nil ]
		ifNotNil: [ result itemNamed: aName ]! !

!MenuRegistration methodsFor: 'initialization' stamp: 'AlainPlantec 2/11/2010 16:35'!
initialize
	super initialize.
	isGroup := false! !

!MenuRegistration methodsFor: 'spec accessing' stamp: 'StephaneDucasse 12/11/2013 10:33'!
enabledBlock
	^ self spec enabledBlock
! !

!MenuRegistration methodsFor: 'accessing' stamp: 'AlainPlantec 2/15/2010 11:17'!
itemList: aCollection
	"Set the list of MenuRegistration"
	 itemList := aCollection! !

!MenuRegistration methodsFor: 'printing' stamp: 'BenjaminVanRyseghem 1/24/2012 20:17'!
printOn: aStream

	super printOn: aStream.
	aStream << ' ( ' << self name asString << ' ) '! !

!MenuRegistration methodsFor: 'accessing' stamp: 'AlainPlantec 2/16/2010 16:45'!
ensureItemList
	"Return the list of MenuRegistration instances"
	^ itemList ifNil: [itemList := OrderedCollection new]! !

!MenuRegistration methodsFor: 'spec accessing' stamp: 'AlainPlantec 2/12/2010 16:04'!
help: anHelpText
	"set the help text"
	self spec help: anHelpText! !

!MenuRegistration methodsFor: 'spec accessing' stamp: 'AlainPlantec 2/12/2010 16:06'!
label: aLabel
	"set the label that is shown in the menu"
	self spec label: aLabel! !

!MenuRegistration methodsFor: 'spec accessing' stamp: 'BenjaminVanRyseghem 4/6/2012 18:48'!
enabled: aBooleanOrABlock

	aBooleanOrABlock == true
		ifTrue: [ 
			self spec enabled: true.
			^ self ].
	aBooleanOrABlock == false
		ifTrue: [ 
			self spec enabled: false.
			^ self ].
	self spec enabled: (aBooleanOrABlock cull: self model).! !

!MenuRegistration methodsFor: 'sub item creating' stamp: 'AlainPlantec 2/16/2010 13:43'!
newSubItem
	| reg |
	reg := self class owner: self.
	self addItem: reg.
	^ reg! !

!MenuRegistration methodsFor: 'spec accessing' stamp: 'AlainPlantec 2/13/2010 13:28'!
target: anObject
	"set the target for the action"
	self spec action 
		ifNil: [self spec action: (MessageSend receiver: (anObject ifNil: [owner itemReceiver]) selector: nil)]
		ifNotNil: [self spec action receiver: anObject]! !

!MenuRegistration methodsFor: 'initialize-release' stamp: 'AlainPlantec 2/15/2010 11:21'!
release
	itemList := nil.
	super release
	! !

!MenuRegistration methodsFor: 'spec accessing' stamp: 'EstebanLorenzano 1/30/2013 16:55'!
keyText: aString
	self spec keyText: aString! !

!MenuRegistration methodsFor: 'accessing' stamp: 'AlainPlantec 2/16/2010 19:37'!
assignOrderWithBlock: aBlock 
	"Compute recursively MenuRegistration order"
	self itemList 
		ifNotNil: [self itemList: (aBlock value: self itemList).
				self itemList do: [:rded | rded assignOrderWithBlock: aBlock]]! !

!MenuRegistration methodsFor: 'accessing' stamp: 'AlainPlantec 2/13/2010 12:52'!
builder
	^ owner builder! !

!MenuRegistration methodsFor: 'sub item creating' stamp: 'AlainPlantec 2/16/2010 11:42'!
group: aSymbol
	^ (self item: aSymbol) isGroup: true! !

!MenuRegistration methodsFor: 'accessing' stamp: 'AlainPlantec 2/15/2010 11:05'!
removeItem: anItem
	"Remove a MenuRegistration"
	self itemList remove: anItem ! !

!MenuRegistration methodsFor: 'sub item creating' stamp: 'AlainPlantec 2/16/2010 11:47'!
with: aBlock
	self builder currentRoot: self while: aBlock! !

!MenuRegistration methodsFor: 'accessing' stamp: 'AlainPlantec 2/10/2010 13:54'!
parentName
	^ parentName! !

!MenuRegistration methodsFor: 'initialize-release' stamp: 'AlainPlantec 2/18/2010 11:53'!
reset
	itemList 
		ifNotNil: [
			itemList do: [:i | i reset].
			itemList := nil].
	spec := nil
! !

!MenuRegistration methodsFor: 'spec accessing' stamp: 'BenjaminVanRyseghem 4/6/2012 18:27'!
action: aMessageSendOrABlock
	"set the action of the menu"
	
	aMessageSendOrABlock isBlock 
		ifTrue: [
			self target: aMessageSendOrABlock.
			self selector: #cull:.
			self arguments: {self model}]
		ifFalse: [
			self selector: aMessageSendOrABlock]
! !

!MenuRegistration methodsFor: 'accessing' stamp: 'AlainPlantec 2/11/2010 08:15'!
order
	^ order! !

!MenuRegistration methodsFor: 'accessing' stamp: 'AlainPlantec 4/10/2010 09:31'!
precondition
	^ precondition ifNil: [[true]]! !

!MenuRegistration methodsFor: 'spec accessing' stamp: 'AlainPlantec 2/13/2010 12:59'!
arguments: anArray
	"set the arguments for an item with an action"
	self spec action 
		ifNil: [self spec action: (MessageSend receiver: self itemReceiver selector: nil arguments: anArray)]
		ifNotNil: [self spec action arguments: anArray]! !

!MenuRegistration methodsFor: 'accessing' stamp: 'AlainPlantec 2/10/2010 13:54'!
parentName: aSymbol
	parentName := aSymbol! !

!MenuRegistration methodsFor: 'accessing' stamp: 'AlainPlantec 2/11/2010 08:15'!
owner
	^ owner! !

!MenuRegistration methodsFor: 'accessing' stamp: 'AlainPlantec 2/13/2010 12:54'!
model
	^ self builder model! !

!MenuRegistration methodsFor: 'spec accessing' stamp: 'AlainPlantec 2/12/2010 16:09'!
withSeparatorAfter
	"add a separator line after me"
	self spec separator: true! !

!MenuRegistration methodsFor: 'spec accessing' stamp: 'AlainPlantec 2/13/2010 12:58'!
selector: aSymbol
	"set the selector for item with an action"
	self spec action 
		ifNil: [self spec action: (MessageSend receiver: self itemReceiver selector: aSymbol)]
		ifNotNil: [self spec action selector: aSymbol]! !

!MenuRegistration methodsFor: 'spec accessing' stamp: 'AlainPlantec 2/12/2010 16:07'!
name: aSymbol
	"set my name (should be unique over all menu items"
	self spec name: aSymbol! !

!MenuRegistration methodsFor: 'accessing' stamp: 'AlainPlantec 2/15/2010 11:05'!
order: aNumber 
	"Set the value of order"

	order := aNumber! !

!MenuRegistration methodsFor: 'spec accessing' stamp: 'AlainPlantec 2/12/2010 22:23'!
icon: aForm
	"set the icon that is shown in the menu"
	self spec icon: aForm! !

!MenuRegistration methodsFor: 'spec accessing' stamp: 'AlainPlantec 2/12/2010 16:06'!
label 
	"return my label"
	^ self spec label! !

!MenuRegistration methodsFor: 'accessing' stamp: 'AlainPlantec 2/11/2010 08:15'!
owner: anItem
	owner := anItem! !

!MenuRegistration methodsFor: 'spec accessing' stamp: 'BenjaminVanRyseghem 3/31/2011 01:50'!
enabledBlock: aBlock

	self spec enabledBlock: aBlock! !

!MenuRegistration methodsFor: 'accessing' stamp: 'AlainPlantec 2/16/2010 16:51'!
sort: aSortBlock
	"Sort the tree recursively"
	self itemList
		ifNotNil: [
		self itemList: (self itemList asSortedCollection: aSortBlock).
		self itemList do: [:rded | rded sort: aSortBlock] ]! !

!MenuRegistration methodsFor: 'accessing' stamp: 'AlainPlantec 2/16/2010 16:49'!
collectMisplacedItemsIn: aCollection
	"Select recursively all MenuRegistration with a parentName 
	different from its owner name. 	This is possible since a parent name 
	can be given in order to force a menu item placement. 
	If my parentName is not the same as my owner name then it means 
	that I'm not in the right place and that my placement has to be resolved"
	
	self parentName
		ifNotNil: [owner
				ifNil: [aCollection add: self]
				ifNotNil: [owner name = self parentName
						ifFalse: [aCollection add: self]]].
	self itemList ifNotNil: [:l |
		l do: [:item | item collectMisplacedItemsIn: aCollection]]! !

!MenuRegistration methodsFor: 'accessing' stamp: 'AlainPlantec 2/13/2010 12:58'!
itemReceiver
	^ self target ifNil: [owner itemReceiver]! !

!MenuRegistration methodsFor: 'spec accessing' stamp: 'AlainPlantec 2/12/2010 16:07'!
name
	"returns my name which is used as a key (should unique over all the menu items"
	^ self spec name! !

!MenuRegistration methodsFor: 'spec accessing' stamp: 'AlainPlantec 2/12/2010 16:08'!
spec
	"return my PluggableMenuItemSpec"
	^ spec ifNil: [spec := PluggableMenuItemSpec new]! !

!MenuRegistration methodsFor: 'spec accessing' stamp: 'AlainPlantec 2/13/2010 12:59'!
target
	^ self spec action ifNotNil: [:action | action receiver]
! !

!MenuRegistration class methodsFor: 'instance creation' stamp: 'AlainPlantec 2/16/2010 12:20'!
owner: aMenuRegistration
	^ self new owner: aMenuRegistration! !

!MenuRegistrationExample commentStamp: 'AlainPlantec 2/17/2010 01:10'!
I'm here to show you how to use the menu registration. See class side methods and try it with:
----------------
(PragmaMenuBuilder pragmaKeyword: 'worldMenuExample' model: nil) menu popUpInWorld
----------------
!
!MenuRegistrationExample class methodsFor: 'menu actions' stamp: 'StephaneDucasse 3/17/2010 21:13'!
saveAndQuit
	Smalltalk snapshot: true andQuit: true! !

!MenuRegistrationExample class methodsFor: 'menu declaring' stamp: 'IgorStasenko 4/15/2011 17:19'!
mostUsedToolsOn: aBuilder 
	<worldMenuExample>
	(aBuilder group: #MostUsedTools)
		withSeparatorAfter;
		order: 0;
		target: Smalltalk tools;
		with: [
			(aBuilder item: #'System browser') selector: #openClassBrowser; icon: Smalltalk tools browser taskbarIcon.
			(aBuilder item: #Workspace) selector: #openWorkspace; icon: Smalltalk tools workspace taskbarIcon.
			(aBuilder item: #'Monticello Browser') selector: #openMonticelloBrowser; icon: Smalltalk tools monticelloBrowser taskbarIcon]! !

!MenuRegistrationExample class methodsFor: 'menu declaring' stamp: 'StephaneDucasse 3/17/2010 21:13'!
quitItemsOn: aBuilder 
	<worldMenuExample> 
	(aBuilder group: #QuitPharo)
		order: 9999; 
		with: [{
				{'Save'. {Smalltalk. #saveSession}. 'save the current version of the image on disk'}.
				{'Save as...'. {self. #saveAs}. 'save the current version of the image on disk under a new name.'}.
				{'Save and quit'. {self. #saveAndQuit}. 'save the current image on disk, and quit Pharo.'}.
	 			{'Quit'. {self. #quitSession}. 'quit Pharo.'}
			} do: [:triplet |
					(aBuilder item: triplet first asSymbol) 
						target: triplet second first;
				 		selector: triplet second second;
						help: (triplet size > 2 ifTrue: [triplet third] ifFalse: [nil])]]! !

!MenuRegistrationExample class methodsFor: 'menu declaring' stamp: 'IgorStasenko 4/15/2011 17:18'!
myOwnCoolToolRegistrationOn: aBuilder 
	<worldMenuExample> 
	(aBuilder item: #MyOwnCoolTool)
		parent: #Tools;
		label: 'My own cool tool';
		target: Smalltalk tools workspace; 
		selector: #openContents: ;
		arguments: #('yep, my own cool tool can be opened from the world menu !! :)')
! !

!MenuRegistrationExample class methodsFor: 'menu actions' stamp: 'StephaneDucasse 3/17/2010 21:13'!
quitSession
	Smalltalk
		snapshot: (self confirm: 'Save changes before quitting?' translated orCancel: [ ^ self ])
		andQuit: true! !

!MenuRegistrationExample class methodsFor: 'menu declaring' stamp: 'AlainPlantec 2/12/2010 15:02'!
pragmaKeyword
	^ 'worldMenuExample'! !

!MenuRegistrationExample class methodsFor: 'menu declaring' stamp: 'IgorStasenko 4/15/2011 17:18'!
myOwnCoolMenuRegistrationOn: aBuilder 
	<worldMenuExample>
	(aBuilder item: #MyOwnCoolMenu)
		parent: #Tools; "place me as a child of the #Tools node (declared by #toolsOn:)"
		label: 'The coolest tool here';
		with: [
			(aBuilder item: #MyOwnCoolTool)
				label: 'My own cool tool also here';
				target: Smalltalk tools workspace;
				selector: #openContents: ;
				arguments: #('yep, my own cool tool can be also opened from a world sub-menu !! :)')]! !

!MenuRegistrationExample class methodsFor: 'menu actions' stamp: 'StephaneDucasse 6/11/2012 18:12'!
saveAs
	Smalltalk saveAs.! !

!MenuRegistrationExample class methodsFor: 'menu declaring' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
toolsOn: aBuilder 
	<worldMenuExample>
	(aBuilder item: #Tools)
		order: 1.0;
		target: Smalltalk tools;
		icon: Smalltalk ui icons smallDoItIcon;
		withSeparatorAfter;
		with: [(aBuilder item: #Transcript) selector: #openTranscript; icon: Smalltalk tools transcript  taskbarIcon. 
			(aBuilder item: #'File Browser') selector: #openFileList; icon: Smalltalk tools fileList taskbarIcon.
			(aBuilder item: #'Process Browser') selector: #openProcessBrowser; icon: Smalltalk tools processBrowser taskbarIcon;
				 withSeparatorAfter]! !

!MenuRegistrationExample class methodsFor: 'menu declaring' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
theme
	"Answer the ui theme that provides controls."

	^ Smalltalk ui theme ! !

!MergeDiffMorph methodsFor: 'actions' stamp: 'gvc 11/1/2006 14:15'!
compositeText
	"Answer the composite text based on the selection state
	of the joins."

	^self joinMorph compositeText
	! !

!MergeDiffMorph methodsFor: 'accessing' stamp: 'gvc 1/8/2009 18:17'!
allowJoinClicks: anObject
	"Set the value of allowJoinClicks"

	allowJoinClicks := anObject! !

!MergeDiffMorph methodsFor: 'initialization' stamp: 'gvc 1/8/2009 18:17'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		allowJoinClicks: true! !

!MergeDiffMorph methodsFor: 'actions' stamp: 'gvc 11/1/2006 14:15'!
update: aspect
	"A join has probably changed its selection state."

	super update: aspect.
	aspect == #joinClicked
		ifTrue: [self
				changed;
				changed: #selectedDifferences]! !

!MergeDiffMorph methodsFor: 'actions' stamp: 'gvc 11/1/2006 14:15'!
newJoinMorph
	"Answer a new join morph."

	^super newJoinMorph
		when: #joinClicked send: #update: to: self with: #joinClicked! !

!MergeDiffMorph methodsFor: 'accessing' stamp: 'gvc 1/8/2009 18:17'!
allowJoinClicks
	"Answer the value of allowJoinClicks"

	^ allowJoinClicks! !

!MergeDiffMorph methodsFor: 'obsolete' stamp: 'gvc 7/6/2007 15:38'!
indicateSrc
	"Change the indicators of the joins to the src side."

	self joinMappings do: [:section |
		section selectionState: #src].
	self
		changed;
		changed: #selectedDifferences! !

!MergeDiffMorph methodsFor: 'actions' stamp: 'gvc 1/8/2009 18:17'!
calculatedJoinMappings
	"Specify click allowance for each section."
	
	^super calculatedJoinMappings do: [:j |
		j allowClick: self allowJoinClicks]! !

!MergeDiffMorph methodsFor: 'obsolete' stamp: 'gvc 7/6/2007 15:37'!
indicateDst
	"Change the indicators of the joins to the dst side."

	self joinMappings do: [:section |
		section selectionState: #dst].
	self
		changed;
		changed: #selectedDifferences! !

!MergeDiffMorph methodsFor: 'actions' stamp: 'gvc 11/1/2006 14:13'!
joinSectionClass
	"Answer the class to use for a new join section."

	^MergeJoinSection! !

!MergeJoinSection methodsFor: 'as yet unclassified' stamp: 'gvc 1/8/2009 18:04'!
wantsClick
	"Allow if explictly enabled and super."

	^self allowClick and: [super wantsClick]! !

!MergeJoinSection methodsFor: 'accessing' stamp: 'gvc 10/30/2006 15:25'!
selected: aBoolean
	"Set the value of selected"

	selected := aBoolean.
	self
		updateHighlights;
		changed: #selected! !

!MergeJoinSection methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 4/29/2011 00:36'!
drawOn: aCanvas
	"Draw the join on the given canvas."
	
	super drawOn: aCanvas.
	self stateIcon ifNotNil: [:i |
		aCanvas
			translucentImage: i
			at: self stateIconBounds topLeft]! !

!MergeJoinSection methodsFor: 'as yet unclassified' stamp: 'gvc 11/1/2006 14:22'!
borderColorToUse
	"Answer the border color to use based on the selection state."
	
	^self selected
		ifTrue: [self selectedBorderColor]
		ifFalse: [super borderColorToUse]! !

!MergeJoinSection methodsFor: 'accessing' stamp: 'gvc 10/31/2006 13:00'!
selectionState
	"Answer the value of selectionState"

	^ selectionState! !

!MergeJoinSection methodsFor: 'accessing' stamp: 'gvc 10/31/2006 13:03'!
stateIcons: anObject
	"Set the value of stateIcons"

	stateIcons := anObject! !

!MergeJoinSection methodsFor: 'as yet unclassified' stamp: 'gvc 10/31/2006 13:01'!
selectionStates
	"Answer the valid selection states in order."

	^#(src dst both neither)! !

!MergeJoinSection methodsFor: 'as yet unclassified' stamp: 'gvc 11/1/2006 12:10'!
appendToCompositeText: aText
	"If appropriate append the relevant src or dst text to the given text."
	
	self selectionState == #src ifTrue: [^aText append: self src text].
	self selectionState == #dst ifTrue: [^aText append: self dst text].
	self selectionState == #both ifTrue: [
		^aText
			append: self src text;
			append: self dst text]! !

!MergeJoinSection methodsFor: 'as yet unclassified' stamp: 'gvc 7/6/2007 15:14'!
stateIcon
	"Answer the state icon to use."

	self wantsClick ifFalse: [^nil].
	^self stateIcons at: (self selectionStates indexOf: self selectionState)! !

!MergeJoinSection methodsFor: 'as yet unclassified' stamp: 'gvc 10/31/2006 13:09'!
clicked
	"The receiver or a highlight was clicked."

	self wantsClick ifFalse: [^false].
	self selectNextState.
	^true! !

!MergeJoinSection methodsFor: 'accessing' stamp: 'gvc 10/25/2006 17:43'!
selectedBorderColor
	"Answer the value of selectedBorderColor"

	^ selectedBorderColor! !

!MergeJoinSection methodsFor: 'accessing' stamp: 'gvc 1/8/2009 18:04'!
allowClick: anObject
	"Set the value of allowClick"

	allowClick := anObject! !

!MergeJoinSection methodsFor: 'initialization' stamp: 'gvc 1/8/2009 18:05'!
initialize
	"Initialize the receiver."

	self
		allowClick: true;
		selected: false;
		selectionState: #dst;
		stateIcons: self defaultStateIcons;
		selectedBorderColor: Color black.
	super initialize! !

!MergeJoinSection methodsFor: 'as yet unclassified' stamp: 'gvc 10/31/2006 13:03'!
selectNextState
	"Set the selection state to the next one with wraparound."

	self selectionState: (
		self selectionStates at: (
			(self selectionStates indexOf: self selectionState) \\
				self selectionStates size + 1))! !

!MergeJoinSection methodsFor: 'accessing' stamp: 'gvc 10/25/2006 17:47'!
selected
	"Answer the value of selected"

	^ selected! !

!MergeJoinSection methodsFor: 'as yet unclassified' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
defaultStateIcons
	"Answer the default state icons."

	^{ Smalltalk ui icons smallBackIcon.
		Smalltalk ui icons smallForwardIcon.
		Smalltalk ui icons smallOkIcon.
		Smalltalk ui icons smallCancelIcon }! !

!MergeJoinSection methodsFor: 'accessing' stamp: 'gvc 10/25/2006 17:43'!
selectedBorderColor: anObject
	"Set the value of selectedBorderColor"

	selectedBorderColor := anObject! !

!MergeJoinSection methodsFor: 'as yet unclassified' stamp: 'gvc 7/30/2009 13:44'!
stateIconBounds
	"Answer the bounds of the state icon."
	
	|i|
	i := self stateIcon ifNil: [^nil].
	^self shape bounds center - (i extent // 2)
		extent: i extent! !

!MergeJoinSection methodsFor: 'accessing' stamp: 'gvc 1/8/2009 18:04'!
allowClick
	"Answer the value of allowClick"

	^ allowClick! !

!MergeJoinSection methodsFor: 'accessing' stamp: 'gvc 10/31/2006 13:03'!
stateIcons
	"Answer the value of stateIcons"

	^ stateIcons! !

!MergeJoinSection methodsFor: 'accessing' stamp: 'gvc 10/31/2006 13:00'!
selectionState: anObject
	"Set the value of selectionState"

	selectionState := anObject! !

!MergeJoinSection methodsFor: 'as yet unclassified' stamp: 'gvc 11/1/2006 14:18'!
containsPoint: aPoint
	"Answer whether the receiver contains the given point."

	^(super containsPoint: aPoint) or: [
		self stateIcon notNil and: [self stateIconBounds containsPoint: aPoint]]! !

!Message commentStamp: '<historical>'!
I represent a selector and its argument values.
	
Generally, the system does not use instances of Message for efficiency reasons. However, when a message is not understood by its receiver, the interpreter will make up an instance of me in order to capture the information involved in an actual message transmission. This instance is sent it as an argument with the message doesNotUnderstand: to the receiver.!
!Message methodsFor: 'accessing' stamp: ''!
selector
	"Answer the selector of the receiver."

	^selector! !

!Message methodsFor: 'comparing' stamp: 'eem 11/27/2008 13:17'!
analogousCodeTo: anObject
	"For MethodPropertires comparison."
	^self class == anObject class
	  and: [selector == anObject selector
	  and: [args = anObject arguments
	  and: [lookupClass == anObject lookupClass]]]! !

!Message methodsFor: 'printing' stamp: 'sma 6/1/2000 10:01'!
storeOn: aStream 
	"Refer to the comment in Object|storeOn:."

	aStream nextPut: $(;
	 nextPutAll: self class name;
	 nextPutAll: ' selector: ';
	 store: selector;
	 nextPutAll: ' arguments: ';
	 store: args;
	 nextPut: $)! !

!Message methodsFor: 'sending' stamp: 'HernanMoralesDurand 1/26/2014 08:32'!
sentTo: receiver
	"answer the result of sending this message to receiver"

	^ lookupClass
		ifNil: [ receiver perform: selector withArguments: args]
		ifNotNil: [ receiver perform: selector withArguments: args inSuperclass: lookupClass]! !

!Message methodsFor: 'sending' stamp: 'ajh 1/22/2003 11:51'!
sendTo: receiver
	"answer the result of sending this message to receiver"

	^ receiver perform: selector withArguments: args! !

!Message methodsFor: 'private' stamp: ''!
setSelector: aSymbol arguments: anArray

	selector := aSymbol.
	args := anArray! !

!Message methodsFor: 'private' stamp: 'ajh 9/23/2001 04:59'!
lookupClass: aClass

	lookupClass := aClass! !

!Message methodsFor: 'accessing' stamp: ''!
argument: newValue
	"Change the first argument to newValue and answer self"

	args at: 1 put: newValue! !

!Message methodsFor: 'testing' stamp: 'MarcusDenker 7/23/2014 22:31'!
hasArguments
	^args notEmpty! !

!Message methodsFor: 'printing' stamp: 'ajh 10/9/2001 15:31'!
printOn: stream

	args isEmpty ifTrue: [^ stream nextPutAll: selector].
	args with: selector keywords do: [:arg :word |
		stream nextPutAll: word.
		stream space.
		arg printOn: stream.
		stream space.
	].
	stream skip: -1.
! !

!Message methodsFor: 'accessing' stamp: ''!
argument
	"Answer the first (presumably sole) argument"

	^args at: 1! !

!Message methodsFor: 'accessing' stamp: 'ajh 10/9/2001 16:32'!
lookupClass

	^ lookupClass! !

!Message methodsFor: 'accessing' stamp: 'eem 1/3/2009 10:42'!
numArgs
	"Answer the number of arguments in this message"

	^args size! !

!Message methodsFor: 'private' stamp: 'ajh 3/9/2003 19:25'!
setSelector: aSymbol

	selector := aSymbol.
! !

!Message methodsFor: 'accessing' stamp: ''!
arguments
	"Answer the arguments of the receiver."

	^args! !

!Message methodsFor: 'accessing' stamp: ''!
sends: aSelector
	"answer whether this message's selector is aSelector"

	^selector == aSelector! !

!Message class methodsFor: 'instance creation' stamp: ''!
selector: aSymbol arguments: anArray 
	"Answer an instance of me with selector, aSymbol, and arguments, 
	anArray."

	^self new setSelector: aSymbol arguments: anArray! !

!Message class methodsFor: 'instance creation' stamp: ''!
selector: aSymbol
	"Answer an instance of me with unary selector, aSymbol."

	^self new setSelector: aSymbol arguments: (Array new: 0)! !

!Message class methodsFor: 'instance creation' stamp: 'MarcusDenker 7/27/2014 08:55'!
selector: aSymbol argument: anObject 
	"Answer an instance of me whose selector is aSymbol and single 
	argument is anObject."

	^self new setSelector: aSymbol arguments: { anObject }! !

!MessageAsTempNode commentStamp: '<historical>'!
This node represents accesses to temporary variables for do-its in the debugger.  Since they execute in another context, they must send a message to the original context to access the value of the temporary variable in that context.!
!MessageAsTempNode methodsFor: 'access to remote temps' stamp: 'di 10/12/1999 17:29'!
code
	"Allow synthetic temp nodes to be sorted by code"
	^ arguments first literalValue! !

!MessageAsTempNode methodsFor: 'access to remote temps' stamp: 'di 3/22/1999 09:38'!
asStorableNode: encoder
	"This node is a message masquerading as a temporary variable.
	It currently has the form {homeContext tempAt: offset}.
	We need to generate code for {expr storeAt: offset inTempFrame: homeContext},
	where the expr, the block argument, is already on the stack.
	This, in turn will get turned into {homeContext tempAt: offset put: expr}
	at runtime if nobody disturbs storeAt:inTempFrame: in Object (not clean)"
	^ MessageAsTempNode new
		receiver: nil  "suppress code generation for reciever already on stack"
		selector: #storeAt:inTempFrame:
		arguments: (arguments copyWith: receiver)
		precedence: precedence
		from: encoder! !

!MessageAsTempNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 14:52'!
sizeCodeForStorePop: encoder
	"This node has the form {expr storeAt: offset inTempFrame: homeContext},
	where the expr, the block argument, is already on the stack."
	^self sizeCodeForEffect: encoder! !

!MessageAsTempNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 14:52'!
emitCodeForStorePop: stack encoder: encoder
	"This node has the form {expr storeAt: offset inTempFrame: homeContext},
	where the expr, the block argument, is already on the stack."
	^self emitCodeForEffect: stack encoder: encoder! !

!MessageAsTempNode methodsFor: 'access to remote temps' stamp: 'eem 6/24/2008 11:50'!
store: expr from: encoder 
	"ctxt tempAt: n -> ctxt tempAt: n put: expr (see Assignment).
	For assigning into temps of a context being debugged."

	selector key ~= #namedTempAt: 
		ifTrue: [^self error: 'cant transform this message'].
	^ MessageAsTempNode new
		receiver: receiver
		selector: #namedTempAt:put:
		arguments: (arguments copyWith: expr)
		precedence: precedence
		from: encoder! !

!MessageBrowser commentStamp: '<historical>'!
A MessageBrowser is a UI to browse a list of method, regardless of what they could be.

example: 

MessageBrowser new
	openWithSpec;
	messages: (SystemNavigation new allSendersOf: #at:)
	yourself!
!MessageBrowser methodsFor: 'text selection' stamp: 'MarcusDenker 10/18/2014 12:31'!
autoSelect: aSelector

	textModel readSelectionBlock: [:text | self searchedString: aSelector asString in: text ]! !

!MessageBrowser methodsFor: 'actions' stamp: 'CamilloBruni 1/29/2013 23:51'!
inspectMethod
	self currentMethod ifNotNil: [ :m | m inspect ]! !

!MessageBrowser methodsFor: 'api' stamp: 'BenjaminVanRyseghem 6/21/2013 00:00'!
resetSelection
	
	listModel resetSelection! !

!MessageBrowser methodsFor: 'actions' stamp: 'CamilloBruni 1/29/2013 23:59'!
browseVersions
	self currentMethod ifNotNil: [ :method |
		model browseVersionsFrom: method compiledMethod ]! !

!MessageBrowser methodsFor: 'accessing' stamp: 'StephaneDucasse 7/6/2014 15:48'!
selectedMethod
	^ self selectedMessage compiledMethod! !

!MessageBrowser methodsFor: 'api' stamp: 'BenjaminVanRyseghem 6/14/2012 11:41'!
setSelectedIndex: anIndex

	listModel setSelectedIndex: anIndex ! !

!MessageBrowser methodsFor: 'initialization' stamp: 'GuillermoPolito 8/10/2014 14:08'!
registerListShortcutsFor: aWidget

	aWidget bindKeyCombination: PharoShortcuts current browseShortcut toAction: [ self browseMethod ].
	aWidget bindKeyCombination: PharoShortcuts current inspectItShortcut toAction: [ self inspectMethod ].
	aWidget bindKeyCombination: PharoShortcuts current browseImplementorsShortcut toAction: [ self browseMessages ].
	aWidget bindKeyCombination: PharoShortcuts current browseSendersShortcut toAction: [ self browseSendersOfMessage ].
	aWidget bindKeyCombination: PharoShortcuts current browseReferencesShortcut toAction: [ self browseClassRefs ].
	aWidget bindKeyCombination: PharoShortcuts current browseVersionsShortcut toAction: [ self browseVersions ].
	aWidget bindKeyCombination: PharoShortcuts current removeShortcut toAction: [ self removeMethods ].! !

!MessageBrowser methodsFor: 'accessing' stamp: ''!
listModel
	
	^ listModel! !

!MessageBrowser methodsFor: 'actions' stamp: 'CamilloBruni 1/29/2013 23:52'!
browseClass
	self currentMethod ifNotNil: [ :method | method methodClass browse ]! !

!MessageBrowser methodsFor: 'announcements' stamp: 'CamilleTeruel 9/4/2014 16:37'!
methodRemoved: anAnnouncement
	| item |
	self isDisplayed
		ifFalse: [ ^ self ].
	refreshingBlockHolder ifNil: [ ^ self ].
	item := anAnnouncement method.	"Item is a compiled methed, where the list is populated with RGMethod"	"(refreshingBlockHolder contents cull: item cull: anAnnouncement cull: self)
		ifFalse: [ ^ self ]."
	self okToChange
		ifFalse: [ ^ self ].
	UIManager default defer:  [ 
			((item methodClass notNil) and:[item methodClass isObsolete not])
			ifTrue:[	| sel itm |
			sel := listModel selectedIndex.
			itm := listModel selectedItem.
			(itm notNil and: [ itm methodClass = item methodClass and: [ itm selector = item selector ] ])
				ifTrue: [ textModel hasUnacceptedEdits: false ].
			self
				messages:
					(listModel listItems
						remove: item asFullRingDefinition ifAbsent: [ nil ];
						yourself).
			listModel setSelectedIndex: sel ]
		]! !

!MessageBrowser methodsFor: 'initialization' stamp: 'MarcusDenker 11/3/2014 15:34'!
initialize
	textConverterHolder := SourceMethodConverter new asValueHolder.
	model := AbstractTool new.
	topologicSortHolder := true asValueHolder.
	super initialize.
	askOkToClose := true asValueHolder.
	self windowIcon: self taskbarIcon.
	self registerToAnnouncements.
	self announcer when: WidgetBuilt send: #buildUpdateTitle to: self! !

!MessageBrowser methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
topologicSort
	
	^ topologicSortHolder value! !

!MessageBrowser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
textConverter
	
	^ textConverterHolder value! !

!MessageBrowser methodsFor: 'initialization' stamp: 'EstebanLorenzano 9/4/2013 20:51'!
buildUpdateTitle
	"Trying to have a clean subscription, this method is called in #initialize"
	
	self updateTitle.
	textModel text: textModel getText.! !

!MessageBrowser methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
refreshingBlock: aBlock

	refreshingBlockHolder value: aBlock! !

!MessageBrowser methodsFor: 'accessing' stamp: ''!
textModel
	
	^ textModel! !

!MessageBrowser methodsFor: 'actions' stamp: 'CamilloBruni 1/29/2013 23:55'!
removeMethods
	self currentMethod ifNotNil: [ :method |
		model removeMethod: method inClass: method methodClass ]! !

!MessageBrowser methodsFor: 'api' stamp: 'BenComan 1/25/2015 12:08'!
messages: aCollection

	self cacheHierarchyForClasses: aCollection.
	listModel items: (cachedHierarchy keys sort: [:a :b | self sortClassesInCachedHierarchy: a b: b]) asOrderedCollection.
	listModel listSize > 0
		ifTrue: [ 
			listModel setSelectedIndex: 1 ].! !

!MessageBrowser methodsFor: 'text selection' stamp: 'AlexandreBergel 1/29/2013 16:23'!
findFirstOccurrenceOf: searchedString in: textToSearchIn
	"Return the first index of aString in textToSearchIn "
	| firstIndex |
	firstIndex := textToSearchIn findString: searchedString startingAt: 1.
	[ (firstIndex > 1) and: [ (textToSearchIn at: (firstIndex - 1)) isAlphaNumeric ] ]
		whileTrue: [
			firstIndex := textToSearchIn findString: searchedString startingAt: firstIndex +1 ].
		
	^ firstIndex! !

!MessageBrowser methodsFor: 'announcements' stamp: 'NicolaiHess 1/24/2014 15:56'!
methodAdded: anAnnouncement
	| item |	
		
	self isDisplayed ifFalse: [ ^ self ].
	refreshingBlockHolder ifNil: [ ^ self ].
	item := anAnnouncement method.
	(refreshingBlockHolder value cull: item cull: anAnnouncement cull: self) ifFalse: [ ^ self ].
	
	UIManager default defer: [ 
		((item methodClass notNil) and:[item methodClass isObsolete not])
		ifTrue:[	| sel text boolean |
			boolean := textModel hasUnacceptedEdits.
			boolean ifTrue: [ text := textModel pendingText ].
			sel := listModel selectedItem.
			self messages: (listModel listItems add: item asFullRingDefinition; yourself).
			listModel setSelectedItem: sel.
			boolean ifTrue: [ textModel pendingText: text ]
		]
	]! !

!MessageBrowser methodsFor: 'api-events' stamp: 'BenjaminVanRyseghem 6/14/2012 11:47'!
whenSelectedItemChanged: aBlock 

	listModel whenSelectedItemChanged: aBlock ! !

!MessageBrowser methodsFor: 'menus' stamp: 'StephaneDucasse 7/6/2014 15:24'!
setListMenu
	listModel menu: [ :menu |
		menu addAllFromPragma: 'messageBrowserListMenu' target: self ].! !

!MessageBrowser methodsFor: 'testing' stamp: 'MarcusDenker 11/3/2014 15:26'!
sortClassesInCachedHierarchy: a b: b
	"Bullshitty name, Thanks Camillo"
	| aa bb minSize|
	aa := cachedHierarchy at: a.
	bb := cachedHierarchy at: b.
	
	minSize := aa size min: bb size.
	
	1 to: minSize do: [ :i | |compare|
		compare := (aa at: i) name compare: (bb at: i) name.
		compare ~~ 2
			ifTrue: [  ^ compare == 1 ]].
	^  aa size < bb size! !

!MessageBrowser methodsFor: 'initialization' stamp: 'DucasseStephane 9/10/2014 09:59'!
initializeWidgets

	self instantiateModels: #(
		listModel 		MultiColumnListModel
		textModel 		TextModel
		toolbarModel 	MethodToolbar ).
	
	listModel displayBlock: [ :item | self wrapItem: item ].
	textModel aboutToStyle: true.
	textModel whenBuiltDo: [ :ann | ann widget font: self codeFont ].
	refreshingBlockHolder := [ :item | true ] asValueHolder.
				
	self
		setListMenu;
		initializeDropList;
		setFocus.
! !

!MessageBrowser methodsFor: 'text selection' stamp: 'MarcusDenker 11/3/2014 15:30'!
searchedString: searchedString in: aString
	"Return the interval that corresponds to the portion of aString "
	"This method takes care of finding complete match to searchedString. "
	| string interval firstIndex |
	
	searchedString ifNil: [ ^ 0 to: 0 ].
	aString isEmptyOrNil ifTrue: [ ^0 to: 0 ].
	string := aString asString.
	interval := 0 to: 0.
	
	(searchedString includes: $:)
		ifTrue: [ | list |
			list := searchedString substrings: ':'.
			list size = 1
				ifTrue: [" binary selector "
					firstIndex := self findFirstOccurrenceOf: searchedString in: string.
					firstIndex isZero
						ifFalse: [ interval := firstIndex to: (firstIndex+searchedString size-1) ] ] 
					
				ifFalse: [
					| lastIndex |
					firstIndex := self findFirstOccurrenceOf: list first, ':' in: string. 
					firstIndex >0 ifTrue: [ 
								lastIndex := string findString: list last,':' startingAt: firstIndex+ (list first size -1).
								interval := firstIndex to: (lastIndex + list last size) ] ] ]
		ifFalse: [
			" unary selector "
			firstIndex := self findFirstOccurrenceOf: searchedString in: string.
			 firstIndex > 0
						ifTrue: [ interval := firstIndex to: (firstIndex+searchedString size - 1) ] ].
	^ interval! !

!MessageBrowser methodsFor: 'announcements' stamp: 'NicolaiHess 1/19/2014 11:46'!
methodModified: anAnnouncement
	| item oldItem sel index |
	
	self isDisplayed ifFalse: [ ^ self ].
	refreshingBlockHolder ifNil: [ ^ self ].
	item := anAnnouncement newMethod.
	oldItem := anAnnouncement oldMethod.
	sel := listModel selectedItem.
	sel ifNil: [ ^ self ].
	(sel notNil and: [(sel methodClass = oldItem methodClass and: [ sel selector = oldItem selector ])]) ifFalse: [ ^ self ].
	(refreshingBlockHolder value cull: item cull: anAnnouncement cull: self) ifFalse: [ ^ self ].	
		index := listModel selectedIndex .
	UIManager default defer:  [	| text list edits |
		edits := textModel hasUnacceptedEdits.
		edits
			ifTrue: [ text := textModel pendingText ].
		list := listModel listItems 
				remove: sel ifAbsent: [];
				add: item asFullRingDefinition; "to ensure it's still as RGMethod"
				yourself. 
		self messages: list.
		listModel setSelectedIndex: index.
		edits
			ifTrue: [ 
				textModel pendingText: text.
				textModel hasEditingConflicts: true ].
		]! !

!MessageBrowser methodsFor: 'private' stamp: 'EstebanLorenzano 10/11/2013 16:53'!
codeFont
	^ StandardFonts codeFont! !

!MessageBrowser methodsFor: 'api' stamp: 'BenjaminVanRyseghem 6/14/2012 10:15'!
sortingBlock: aBlock

	listModel sortingBlock: aBlock! !

!MessageBrowser methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
topologicSort: aBoolean
	
	^ topologicSortHolder value: aBoolean! !

!MessageBrowser methodsFor: 'messageList interface' stamp: 'MarcusDenker 9/19/2014 10:57'!
open

	^self openWithSpec! !

!MessageBrowser methodsFor: 'announcements-registration' stamp: 'BernardoContreras 9/27/2014 13:48'!
registerToAnnouncements

	SystemAnnouncer uniqueInstance weak		
		when: MethodAdded send: #methodAdded: to: self;
		when: MethodModified send: #methodModified: to: self;
		when: MethodRecategorized send: #methodRecategorized: to: self;
		when: MethodRemoved send: #methodRemoved: to: self! !

!MessageBrowser methodsFor: 'actions' stamp: 'CamilloBruni 1/29/2013 23:57'!
browseSendersOfMessage
	self currentMethod ifNotNil: [ :method |
		model browseSendersOfMessagesFrom: method selector ]! !

!MessageBrowser methodsFor: 'private' stamp: 'LeoGassman 11/7/2013 11:49'!
wrapItem: anItem
	| s |
	
	s :=String streamContents: [ :aStream | 
		3 to: (cachedHierarchy at: anItem) size do: [:i | aStream << '    '].
		aStream 
			<< anItem methodClass name << ' ('.
		anItem isFromTrait
			ifTrue: [ aStream << anItem compiledMethod origin name; space ].
		aStream << (anItem category ifNil: ['']) <<')'].

	^ {s. anItem selector.  '[',anItem package name,']'.}.! !

!MessageBrowser methodsFor: 'actions' stamp: 'CamilloBruni 1/30/2013 00:01'!
browseClassRefs
	self currentMethod ifNotNil: [ :method | 
		model browseClassRefsOf: method methodClass ]! !

!MessageBrowser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
textConverter: aTextConverter

	textConverterHolder value: (aTextConverter method: self textConverter method).
	textModel aboutToStyle: self textConverter shouldShout .
	textModel text: self textConverter getText.! !

!MessageBrowser methodsFor: 'actions' stamp: 'CamilloBruni 1/29/2013 23:58'!
browseMessages
	self currentMethod ifNotNil: [ :method |
		 model browseMessagesFrom: method selector ]! !

!MessageBrowser methodsFor: 'testing' stamp: ''!
cacheHierarchyForClasses: aCollection

	cachedHierarchy := self buildHierarchyForMessages: aCollection.! !

!MessageBrowser methodsFor: 'api' stamp: ''!
selectedMessage

	^ listModel selectedItem! !

!MessageBrowser methodsFor: 'initialization' stamp: 'MarcusDenker 10/14/2014 08:13'!
initializeDropList

	toolbarModel 
		addItemLabeled: 'Source' do: [ self textConverter: SourceMethodConverter new ];
		addItemLabeled: 'Time stamp' do: [ self textConverter: TimeStampMethodConverter new ]! !

!MessageBrowser methodsFor: 'accessing' stamp: 'StephaneDucasse 7/6/2014 15:48'!
selectedMethods
	^ self selectedMessage asOrderedCollection! !

!MessageBrowser methodsFor: 'initialization' stamp: 'NicolaiHess 9/27/2014 12:31'!
initializePresenter

	listModel whenSelectedItemChanged: [:item |
			toolbarModel method: item.
			textModel behavior: (item ifNil: [ nil ] ifNotNil: [ item methodClass ]).
			textModel doItReceiver: textModel behavior.
			textModel text: (self textConverter method: item; getText)].
		
	listModel whenListChanged: [ self updateTitle ].
		
	titleHolder whenChangedDo: [ self updateTitle ].
	textModel acceptBlock: [ :text :notifyer | (self accept: text notifying: notifyer)  notNil].! !

!MessageBrowser methodsFor: 'private' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
title
		
	^ titleHolder value , ' [' , listModel listSize printString , ']'! !

!MessageBrowser methodsFor: 'api' stamp: 'BenjaminVanRyseghem 6/14/2012 10:55'!
messages

	^ listModel listItems! !

!MessageBrowser methodsFor: '*MessageBrowserRefactoringAddition' stamp: 'StephaneDucasse 7/6/2014 15:53'!
refactor
	^ NautilusRefactoring model: self! !

!MessageBrowser methodsFor: 'private-focus' stamp: 'BenjaminVanRyseghem 2/8/2013 14:17'!
ensureKeyBindingsFor: aWidget
	
	self registerListShortcutsFor: listModel! !

!MessageBrowser methodsFor: 'announcements' stamp: ''!
methodRecategorized: aMethod! !

!MessageBrowser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/14/2012 11:34'!
selectedItem

	^ listModel selectedItem! !

!MessageBrowser methodsFor: 'private' stamp: 'MarcusDenker 7/30/2014 11:16'!
initialExtent

	^ (700 min: (World extent x)) @ (550 min: (World extent y))! !

!MessageBrowser methodsFor: 'icons' stamp: 'EstebanLorenzano 5/14/2013 14:51'!
taskbarIcon
	^ Smalltalk ui icons referencesIcon! !

!MessageBrowser methodsFor: 'api' stamp: 'StephaneDucasse 7/6/2014 15:48'!
selectedClass
	^ self selectedMethod origin instanceSide! !

!MessageBrowser methodsFor: 'accessing' stamp: 'CamilloBruni 1/29/2013 23:50'!
currentMethod
	^ self selectedMessage! !

!MessageBrowser methodsFor: '*MessageBrowserRefactoringAddition' stamp: 'StephaneDucasse 7/6/2014 15:55'!
browsedEnvironment
	^ browsedEnvironment ifNil: [ browsedEnvironment := RBBrowserEnvironment new ]! !

!MessageBrowser methodsFor: 'api' stamp: ''!
selectedMessage: aMessage

	listModel setSelectedItem: aMessage.! !

!MessageBrowser methodsFor: 'api' stamp: 'CamilloBruni 8/24/2012 16:47'!
setRefreshingBlockForSendersOf: aSelector
	| specialFlag specialByte |
	
	specialFlag := Smalltalk 
				hasSpecialSelector: aSelector
				ifTrueSetByte: [ :b | specialByte := b ].

	self refreshingBlock: [:method | 
		(method refersToLiteral: aSelector) or: [ specialFlag and: [ method scanFor: specialByte ]]]! !

!MessageBrowser methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 6/14/2012 10:12'!
buildHierarchyForMessages: messages
	| result classes |
	
	result := IdentityDictionary new.
	self topologicSort 
		ifFalse: [ 
			messages do: [:m | result at: m put: {} ].
			^ result ].
	
	classes := (messages collect: #methodClass) asSet.
	messages do: [:message || level class |
		class := message methodClass.
		level := OrderedCollection new.
		class allSuperclassesDo: [:superClass |
			(classes includes: superClass)
				ifTrue: [ level addFirst: superClass ]].
		level addLast: class.
		level addLast: message selector.
		result at: message put: level ].
	^ result! !

!MessageBrowser methodsFor: 'api' stamp: 'BenjaminVanRyseghem 6/13/2012 10:48'!
displayBlock: aBlock

	^ listModel displayBlock: aBlock! !

!MessageBrowser methodsFor: 'actions' stamp: 'CamilloBruni 1/29/2013 23:52'!
browseMethod
	self currentMethod ifNotNil: [ :method | method browse ]! !

!MessageBrowser methodsFor: 'private' stamp: 'NicolaiHess 9/27/2014 12:31'!
accept: text notifying: notifyer

	^listModel selectedItem
		ifNotNil: [:message | 
			message methodClass 
				compile: text 
				classified: message protocol
				notifying: notifyer ]! !

!MessageBrowser methodsFor: 'accessing' stamp: 'EstebanLorenzano 1/31/2013 12:12'!
model 
	^model! !

!MessageBrowser methodsFor: 'api' stamp: ''!
setRefreshingBlockForImplementorsOf: aSelector

	self refreshingBlock: [:message | message selector = aSelector ].! !

!MessageBrowser methodsFor: 'accessing' stamp: ''!
toolbarModel
	
	^ toolbarModel! !

!MessageBrowser methodsFor: 'initialization' stamp: ''!
setFocus

	self focusOrder
		add: listModel;
		add: toolbarModel;
		add: textModel! !

!MessageBrowser class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 6/18/2012 06:09'!
defaultSpec
	<spec>
	| delta |
	delta := 13.
	^ SpecLayout composed 
			add: #listModel origin: 0@0 corner: 1@0.5 offsetOrigin: 0@0 offsetCorner: 0@(delta negated);
			add: #toolbarModel origin: 0@0.5 corner: 1@0.5 offsetOrigin: 0@(delta negated) offsetCorner: 0@delta;
			add: #textModel origin: 0@0.5 corner: 1@1 offsetOrigin: 0@delta offsetCorner: 0@0;
			yourself! !

!MessageBrowser class methodsFor: 'instance creation' stamp: 'MarcusDenker 7/28/2014 21:21'!
browseSendersOf: aSymbol 
	"Special Version that sets the correct refreshing Block for Implentors Browser"
	^ self browse: aSymbol senders asSendersOf: aSymbol! !

!MessageBrowser class methodsFor: 'instance creation' stamp: 'MarcusDenker 7/28/2014 21:27'!
browse: aCollection title: aString autoSelect: aSelectString
	"Special Version that sets the correct refreshing Block for Implentors Browser"
	^ self new
		messages: aCollection;
		title: aString;
		autoSelect: aSelectString;
		open! !

!MessageBrowser class methodsFor: '*MessageBrowserRefactoringAddition' stamp: 'StephaneDucasse 7/6/2014 16:02'!
refactoringMethodMenu: aBuilder
	<messageBrowserListMenu>
	| target |
	target := aBuilder model.
	target selectedMethod ifNil: [ ^ target ].
	aBuilder model selectedClass refactoringMethod: aBuilder! !

!MessageBrowser class methodsFor: 'instance creation' stamp: 'MarcusDenker 7/28/2014 21:23'!
browse: aCollection title: aString
	"Special Version that sets the correct refreshing Block for Implentors Browser"
	^ self new
		messages: aCollection;
		title: aString;
		open! !

!MessageBrowser class methodsFor: 'instance creation' stamp: 'MarcusDenker 7/28/2014 21:23'!
browse: aCollection
	"Special Version that sets the correct refreshing Block for Implentors Browser"
	^ self new
		messages: aCollection;
		open! !

!MessageBrowser class methodsFor: 'instance creation - old' stamp: 'MarcusDenker 7/29/2014 07:09'!
openMessageList: messageList name: aString autoSelect: aSelector refreshingBlockSelector: aRefreshingBlockSelector
	
	| browser |
	browser := self new
		messages: messageList;
		title: aString;
		autoSelect: aSelector;
		yourself.
		
	aRefreshingBlockSelector ifNotNil:[(browser perform: aRefreshingBlockSelector with: aSelector)].
	^browser open
	
				
! !

!MessageBrowser class methodsFor: 'specs' stamp: ''!
title

	^ 'Message Browser'! !

!MessageBrowser class methodsFor: '*MessageBrowserRefactoringAddition' stamp: 'StephaneDucasse 7/6/2014 16:07'!
methodRefactoringSubMenu: aBuilder
	<messageBrowserListMenu>
	| target |
	target := aBuilder model.
	target selectedMethod ifNil: [ ^ target ].
	aBuilder model selectedClass methodRefactoring: aBuilder! !

!MessageBrowser class methodsFor: 'tool registration' stamp: 'EstebanLorenzano 5/11/2012 11:42'!
registerToolsOn: registry

	"Add ourselves to registry. See [Smalltalk tools]" 
	registry register: self as: #messageList! !

!MessageBrowser class methodsFor: 'instance creation' stamp: 'MarcusDenker 7/28/2014 21:21'!
browse: aCollection asImplementorsOf: aSymbol 
	"Special Version that sets the correct refreshing Block for Implentors Browser"
	^ self new
		setRefreshingBlockForImplementorsOf: aSymbol;
		messages: aCollection;
		title: 'Implementors of ', aSymbol printString;
		open! !

!MessageBrowser class methodsFor: 'menu' stamp: 'MarcusDenker 7/21/2014 11:39'!
messageBrowserListMenu: aBuilder
	<contextMenu>
	<messageBrowserListMenu>
	| target model message |
	
	target := aBuilder model.
	model := target model.
	target selectedMessage ifNil: [ ^self ].
	
	message := target selectedMessage compiledMethod.
	
	(aBuilder item: #'Browse full...')
		keyText: 'b';
		action: [ 
			Smalltalk tools browser 
				fullOnClass: message methodClass
				selector: message selector ].

	(aBuilder item: #'Inspect method...')
		keyText: 'i';
		action: [ message inspect ];
		withSeparatorAfter.

	(aBuilder item: #'Remove method...')
		keyText: 'x';
		action: [ 
			model 
				removeMethod: message 
				inClass: message methodClass ].

	(aBuilder item: #'Senders of...')
		keyText: 'n';
		action: [ model browseSendersOfMessagesFrom: message selector ].

	(aBuilder item: #'Implementors of...')
		keyText: 'm';
		action: [ model browseMessagesFrom: message selector ].

	(aBuilder item: #'Users of...')
		keyText: 'N';
		action: [ model browseClassRefsOf: message methodClass ].
	
	(aBuilder item: #'Versions...')
		keyText: 'v';
		action: [ model browseVersionsFrom: message ].		
! !

!MessageBrowser class methodsFor: 'specs' stamp: 'CamilloBruni 3/1/2014 03:24'!
testSpec
	<spec: #default>
	
	^ SpecLayout composed
			newColumn: [:col |
				col 
					add: #listModel;
					addSplitter;
					add: #toolbarModel height: self buttonHeight;
					add: #textModel ]
				! !

!MessageBrowser class methodsFor: 'instance creation' stamp: 'MarcusDenker 7/28/2014 21:21'!
browseImplementorsOf: aSymbol 
	"Special Version that sets the correct refreshing Block for Implentors Browser"
	^ self browse: aSymbol implementors asImplementorsOf: aSymbol! !

!MessageBrowser class methodsFor: 'instance creation' stamp: 'MarcusDenker 7/28/2014 21:52'!
browse: aCollection asSendersOf: aSymbol 
	"Special Version that sets the correct refreshing Block for Senders Browser"
	^ self new
		setRefreshingBlockForSendersOf: aSymbol;
		autoSelect: aSymbol;
		messages: aCollection;
		title: 'Senders of ', aSymbol printString;
		open! !

!MessageBrowserTest commentStamp: '<historical>'!
A MessageBrowserTest is a test class for testing the behavior of MessageBrowser!
!MessageBrowserTest methodsFor: 'tests substrings' stamp: 'AlexandreBergel 1/29/2013 15:51'!
testFindingTextWithoutJunkcharacter

	| intervalResult |
	intervalResult := MessageBrowser new searchedString: #LayoutFrame in: 'foo
asLayoutFrame

LayoutFrame '.

	self assert: (intervalResult = (20 to: 30))! !

!MessageBrowserTest methodsFor: 'tests' stamp: 'AlexandreBergel 1/29/2013 15:28'!
testFindingText

	| intervalResult |
	intervalResult := MessageBrowser new searchedString: #LayoutFrame in: 'foo
LayoutFrame

asLayoutFrame '.

	self assert: (intervalResult = (5 to: 15))! !

!MessageBrowserTest methodsFor: 'tests' stamp: 'AlexandreBergel 1/29/2013 15:42'!
testFindingTextWithColumn

	| intervalResult |
	intervalResult := MessageBrowser new searchedString: #foo:bar: in: 'zork
self foo: 3 bar: 5.
self foo: 3 bar: 6 '.

	self assert: (intervalResult = (11 to: 21))! !

!MessageBrowserTest methodsFor: 'tests' stamp: 'AlexandreBergel 1/29/2013 15:41'!
testFindingTextWithOneColumn

	| intervalResult |
	intervalResult := MessageBrowser new searchedString: #foo: in: 'zork
self foo: 3.
self foo: 6 '.

	self assert: (intervalResult = (11 to: 14))! !

!MessageBrowserTest methodsFor: 'tests' stamp: 'AlexandreBergel 1/29/2013 15:32'!
testFindingNotExistingText

	| intervalResult |
	intervalResult := MessageBrowser new searchedString: #foo in: 'zork
hello world '.

	self assert: (intervalResult = (0 to: 0))! !

!MessageCatcher commentStamp: '<historical>'!
Any message sent to me is returned as a Message object.

"Message catcher" creates an instance of me.
!
!MessageCatcher methodsFor: 'private' stamp: 'ajh 7/7/2004 18:22'!
privAccumulator: collection

	accumulator := collection! !

!MessageCatcher methodsFor: 'private' stamp: 'ajh 7/7/2004 18:22'!
privAccumulator

	^ accumulator! !

!MessageCatcher methodsFor: 'reflective operations' stamp: 'ajh 7/7/2004 18:22'!
doesNotUnderstand: aMessage

	accumulator ifNotNil: [accumulator add: aMessage].
	^ aMessage! !

!MessageDialogWindow commentStamp: 'gvc 5/18/2007 13:27'!
Dialog window displaying a message with a single OK button. Escape/return will close. Icon is a themed information icon.!
!MessageDialogWindow methodsFor: 'open/close' stamp: 'CamilloBruni 10/7/2012 22:26'!
initialExtent
	"Answer the initial extent for the receiver.
	Adjust the text if the text	would be wider than 1/4 the display width."
	
	|ext|
	ext := super initialExtent.
	self textMorph width > (Display width - 50) ifTrue: [
		self textMorph
			wrapFlag: true;
			hResizing: #rigid;
			extent: (Display width - 50) @ 0.
		ext := super initialExtent].
	^ext! !

!MessageDialogWindow methodsFor: 'accessing' stamp: 'gvc 8/29/2007 13:28'!
iconMorph: anObject
	"Set the value of iconMorph"

	iconMorph := anObject! !

!MessageDialogWindow methodsFor: 'theme' stamp: 'AlainPlantec 10/25/2010 11:15'!
themeChanged
	"Update the icon."

	super themeChanged.
	self iconMorph image: self icon
! !

!MessageDialogWindow methodsFor: 'private' stamp: 'SeanDeNigris 7/24/2012 21:09'!
textLines

	^ self textMorph text asString lines.! !

!MessageDialogWindow methodsFor: 'visual properties' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
icon
	"Answer an icon for the receiver."
	
	^ Smalltalk ui icons infoIcon! !

!MessageDialogWindow methodsFor: 'actions' stamp: 'gvc 8/29/2007 13:29'!
newContentMorph
	"Answer a new content morph."

	self iconMorph: self newIconMorph.
	self textMorph: self newTextMorph.
	^self newGroupboxFor: (self newRow: {self iconMorph. self textMorph})! !

!MessageDialogWindow methodsFor: 'theme' stamp: 'gvc 9/12/2007 17:47'!
playOpenSound
	"Play the themed sound for opening.
	Do nothing at present, done by the UIManager."! !

!MessageDialogWindow methodsFor: 'accessing' stamp: 'gvc 8/27/2006 10:26'!
textMorph: anObject
	"Set the value of textMorph"

	textMorph := anObject! !

!MessageDialogWindow methodsFor: 'private' stamp: 'StephaneDucasse 5/23/2013 18:38'!
newIconMorph
	"Answer an icon for the receiver."
	
	^ImageMorph new form: self icon! !

!MessageDialogWindow methodsFor: 'accessing' stamp: 'SeanDeNigris 7/24/2012 21:12'!
minimumWidth
	
	^ (self lineLengths max + 100) min: Display width.! !

!MessageDialogWindow methodsFor: 'accessing' stamp: 'GaryChambers 1/20/2012 16:37'!
text: aStringOrText
	"Set the text."
	
	|t|
	t := aStringOrText isString
		ifTrue: [aStringOrText asText addAttribute: (TextFontReference toFont: self textFont); yourself]
		ifFalse: [aStringOrText].
	t
		addAttribute: TextAlignment centered;
		addAttribute: (TextColor color: self textMorph textColor).
	self textMorph newContents: t
! !

!MessageDialogWindow methodsFor: 'private' stamp: 'GaryChambers 12/6/2011 10:09'!
newTextMorph
	"Answer a text morph."
	^self newText: ' '! !

!MessageDialogWindow methodsFor: 'accessing' stamp: 'gvc 10/17/2006 14:19'!
textFont
	"Answer the text font."
	
	^textFont! !

!MessageDialogWindow methodsFor: 'accessing' stamp: 'gvc 8/29/2007 13:29'!
iconMorph
	"Answer the value of iconMorph"

	^ iconMorph! !

!MessageDialogWindow methodsFor: 'accessing' stamp: 'gvc 8/27/2006 10:26'!
textMorph
	"Answer the value of textMorph"

	^ textMorph! !

!MessageDialogWindow methodsFor: 'actions' stamp: 'gvc 1/12/2007 15:15'!
newButtons
	"Answer new buttons as appropriate."

	^{self newOKButton isDefault: true}! !

!MessageDialogWindow methodsFor: 'accessing' stamp: 'GaryChambers 12/6/2011 10:08'!
textFont: aFont
	"Set the text font."
	
	textFont :=  aFont.
	self textMorph ifNotNil: [:m | m font: aFont]! !

!MessageDialogWindow methodsFor: 'private' stamp: 'SeanDeNigris 7/24/2012 21:12'!
lineLengths

	^ self textLines collect: [ :line | self textFont widthOfString: line ].! !

!MessageDialogWindow class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
taskbarIcon
	"Answer the icon for the receiver in a task bar."

	^ Smalltalk ui icons smallInfoIcon! !

!MessageNode commentStamp: '<historical>'!
I represent a receiver and its message.
	
Precedence codes:
	1 unary
	2 binary
	3 keyword
	4 other
	
If special>0, I compile special code in-line instead of sending messages with literal methods as remotely copied contexts.!
!MessageNode methodsFor: 'code generation' stamp: 'eem 5/15/2008 09:57'!
sizeCodeForIfNil: encoder value: forValue

	| theNode theSize theSelector |
	equalNode := encoder encodeSelector: #==.
	sizes := Array new: 1.
	theNode := arguments first.
	theSelector := #ifNotNil:.
	forValue
		ifTrue:
			[sizes at: 1 put: (theSize := (encoder sizePop + (theNode sizeCodeForEvaluatedValue: encoder))).
			 ^(receiver sizeCodeForValue: encoder)
			 + encoder sizeDup
			 + (encoder sizePushSpecialLiteral: nil)
			 + (equalNode sizeCode: encoder args: 1 super: false)
			 + (self 
					sizeCode: encoder forBranchOn: selector key == theSelector 
					dist: theSize)
			 + theSize]
		ifFalse:
			[sizes at: 1 put: (theSize := (theNode sizeCodeForEvaluatedEffect: encoder)).
			 ^(receiver sizeCodeForValue: encoder)
				+ (encoder sizePushSpecialLiteral: nil)
				+ (equalNode sizeCode: encoder args: 1 super: false)
				+ (self 
					sizeCode: encoder
					forBranchOn: selector key == theSelector 
					dist: theSize)
				+ theSize]! !

!MessageNode methodsFor: 'printing' stamp: 'RAA 2/15/2001 19:25'!
macroPrinter

	special > 0 ifTrue: [^MacroPrinters at: special].
	^nil
! !

!MessageNode methodsFor: 'testing' stamp: 'md 7/27/2006 19:09'!
isMessage
	^true! !

!MessageNode methodsFor: 'macro transformations' stamp: ''!
transformBoolean: encoder
	^self
		checkBlock: (arguments at: 1)
		as: 'argument'
		from: encoder! !

!MessageNode methodsFor: 'printing' stamp: 'eem 5/6/2008 14:14'!
printWhileOn: aStream indent: level

	self printReceiver: receiver on: aStream indent: level.
	(arguments isEmpty not
	 and: [arguments first isJust: NodeNil]) ifTrue:
			[selector := SelectorNode new
							key:
									(selector key == #whileTrue:
										ifTrue: [#whileTrue]
										ifFalse: [#whileFalse])
							code: #macro.
			arguments := Array new].
	self printKeywords: selector key arguments: arguments
		on: aStream indent: level! !

!MessageNode methodsFor: 'code generation' stamp: 'eem 8/15/2010 10:23'!
emitCodeForEffect: stack encoder: encoder
	"For #ifTrue:ifFalse: and #whileTrue: / #whileFalse: style messages, the pc is set to the jump instruction, so that mustBeBoolean exceptions can be shown correctly."
	special > 0
		ifTrue: 
			[pc := 0.
			self perform: (MacroEmitters at: special) with: stack with: encoder with: false]
		ifFalse: 
			[super emitCodeForEffect: stack encoder: encoder]! !

!MessageNode methodsFor: 'macro transformations' stamp: 'eem 5/23/2008 13:14'!
noteSpecialSelector: selectorSymbol
	"special > 0 denotes specially treated (potentially inlined) messages. "

	special := MacroSelectors indexOf: selectorSymbol.
! !

!MessageNode methodsFor: 'code generation' stamp: 'GuillermoPollito 2/8/2013 15:10'!
sizeCodeForWhile: encoder value: forValue
        "L1: ... Bfp(L2) ... Jmp(L1) L2: nil (nil for value only);
        justStmt, wholeLoop, justJump."
        | cond theArguments stmt stmtSize loopSize branchSize |
        cond := receiver.
        theArguments := arguments ifEmpty: [ Array with: (BlockNode withJust: NodeNil) ].
        stmt := theArguments at: 1.
        stmtSize := (stmt sizeCodeForEvaluatedEffect: encoder) + (encoder sizeJumpLong: 1).
        branchSize := self
                                        sizeCode: encoder
                                        forBranchOn: ((selector key == #whileFalse:) or: [ selector key == #whileFalse ])  "Btp for whileFalse"
                                        dist: stmtSize.
        loopSize := (cond sizeCodeForEvaluatedValue: encoder) + branchSize + stmtSize.
        sizes := Array with: stmtSize with: loopSize.
        ^loopSize + (forValue ifTrue: [encoder sizePushSpecialLiteral: nil] ifFalse: [0])! !

!MessageNode methodsFor: 'initialize-release' stamp: 'nice 3/2/2011 23:57'!
receiver: rcvr selector: selNode arguments: args precedence: p 
	"Decompile."

	self receiver: rcvr
		arguments: args
		precedence: p.
	originalSelector := selNode key.
	selNode code == #macro
		ifTrue: [self noteSpecialSelector: selNode key]
		ifFalse: [special := 0].
	selector := selNode.
	"self pvtCheckForPvtSelector: encoder"
	"We could test code being decompiled, but the compiler should've checked already. And where to send the complaint?"! !

!MessageNode methodsFor: 'code generation' stamp: 'GuillermoPollito 2/8/2013 15:11'!
emitCodeForWhile: stack encoder: encoder value: forValue
        "L1: ... Bfp(L2)|Btp(L2) ... Jmp(L1) L2: "
        | cond theArguments stmt stmtSize loopSize |
        cond := receiver.
        theArguments := arguments ifEmpty: [ Array with: (BlockNode withJust: NodeNil) ].
        stmt := theArguments at: 1.
        stmtSize := sizes at: 1.
        loopSize := sizes at: 2.
        cond emitCodeForEvaluatedValue: stack encoder: encoder.
        self emitCodeForBranchOn: ((selector key == #whileFalse:) or: [ selector key == #whileFalse ]) "Bfp for whileTrue"
                                        dist: stmtSize pop: stack encoder: encoder.   "Btp for whileFalse"
        pc := encoder methodStreamPosition.
        stmt emitCodeForEvaluatedEffect: stack encoder: encoder.
        self emitCodeForJump: 0 - loopSize encoder: encoder.
        forValue ifTrue: [encoder genPushSpecialLiteral: nil. stack push: 1]! !

!MessageNode methodsFor: 'macro transformations' stamp: 'eem 9/6/2009 19:19'!
transformIfFalseIfTrue: encoder
	^(self checkBlock: (arguments at: 1) as: 'False arg' from: encoder)
	   and: [(self checkBlock: (arguments at: 2) as: 'True arg' from: encoder)
	   and: [selector := SelectorNode new key: #ifTrue:ifFalse: code: #macro.
			arguments swap: 1 with: 2.
			arguments do: [:arg| arg noteOptimizedIn: self].
			true]]! !

!MessageNode methodsFor: 'printing' stamp: 'eem 5/6/2008 13:56'!
printCaseOn: aStream indent: level 
	"receiver caseOf: {[key]->[value]. ...} otherwise: [otherwise]"
	| braceNode otherwise extra |
	braceNode := arguments first.
	otherwise := arguments last.
	(arguments size = 1 or: [otherwise isJustCaseError]) ifTrue:
		[otherwise := nil].
	receiver
		printOn: aStream
		indent: level
		precedence: 3.
	aStream nextPutAll: ' caseOf: '.
	braceNode isVariableReference
		ifTrue: [braceNode printOn: aStream indent: level]
		ifFalse: 
			[aStream nextPutAll: '{'; crtab: level + 1.
			 braceNode casesForwardDo:
				[:keyNode :valueNode :last | 
				keyNode printOn: aStream indent: level + 1.
				aStream nextPutAll: ' -> '.
				valueNode isComplex
					ifTrue: 
						[aStream crtab: level + 2.
						extra := 1]
					ifFalse: [extra := 0].
				valueNode printOn: aStream indent: level + 1 + extra.
				last ifTrue: [aStream nextPut: $}]
					ifFalse: [aStream nextPut: $.;
							 crtab: level + 1]]].
	otherwise notNil ifTrue:
		[aStream crtab: level + 1; nextPutAll: ' otherwise: '.
		 extra := otherwise isComplex
					ifTrue: 
						[aStream crtab: level + 2.
						 1]
					ifFalse: [0].
		 otherwise printOn: aStream indent: level + 1 + extra]! !

!MessageNode methodsFor: 'printing' stamp: 'di 5/1/2000 23:20'!
printIfNil: aStream indent: level

	self printReceiver: receiver on: aStream indent: level.

	^self printKeywords: selector key
		arguments: (Array with: arguments first)
		on: aStream indent: level! !

!MessageNode methodsFor: 'visiting' stamp: 'eem 9/6/2009 12:35'!
accept: aVisitor
	^aVisitor visitMessageNode: self! !

!MessageNode methodsFor: 'macro transformations' stamp: 'eem 9/6/2009 13:30'!
transformIfTrue: encoder
	(self transformBoolean: encoder)
		ifTrue: 
			[arguments := 
				Array 
					with: ((arguments at: 1) noteOptimizedIn: self)
					with: ((BlockNode withJust: NodeNil) noteOptimizedIn: self).
			^true]
		ifFalse: 
			[^false]! !

!MessageNode methodsFor: 'testing' stamp: 'eem 9/23/2008 14:06'!
isNilIf

	^(special between: 3 and: 4)
	   and: [(arguments first returns or: [arguments first isJust: NodeNil])
	   and: [(arguments last returns or: [arguments last isJust: NodeNil])]]! !

!MessageNode methodsFor: 'testing' stamp: 'nice 4/2/2011 19:00'!
ensureCanCascade: encoder

	special > 0 ifTrue:
		[special := 0.
		selector := encoder encodeSelector: originalSelector.
		arguments := originalArguments.
		receiver isBlockNode ifTrue: [receiver deoptimize].
		arguments do:
			[:each|
			each isBlockNode ifTrue:
				[each deoptimize]]]! !

!MessageNode methodsFor: 'code generation' stamp: 'nice 2/3/2011 21:12'!
emitCodeForRepeat: stack encoder: encoder value: forValue 
	" L1: ... Jmp(L1)"
	| loopSize |
	loopSize := sizes at: 1.
	receiver emitCodeForEvaluatedEffect: stack encoder: encoder.
	self emitCodeForJump: 0 - loopSize encoder: encoder.
	forValue ifTrue: [encoder genPushSpecialLiteral: nil. stack push: 1]! !

!MessageNode methodsFor: 'code generation' stamp: 'nice 2/20/2012 20:49'!
sizeCodeForToDo: encoder value: forValue 
	" var := rcvr. L1: [var <= arg1] Bfp(L2) [block body. var := var + inc] Jmp(L1) L2: "
	| loopSize initStmt test block incStmt blockSize initSize limitInit |
	block := arguments at: 3.
	initStmt := arguments at: 4.
	test := arguments at: 5.
	incStmt := arguments at: 6.
	limitInit := arguments at: 7.
	initSize := forValue
		ifTrue: [initStmt sizeCodeForValue: encoder.]
		ifFalse: [initStmt sizeCodeForEffect: encoder].
	limitInit == nil ifFalse:
		[initSize := initSize + (limitInit sizeCodeForEffect: encoder)].
	blockSize := (block sizeCodeForEvaluatedEffect: encoder)
			+ (incStmt sizeCodeForEffect: encoder)
			+ (encoder sizeJumpLong: -1).
	loopSize := (test sizeCodeForValue: encoder)
			+ (self sizeCode: encoder forBranchOn: false dist: blockSize)
			+ blockSize.
	sizes := Array with: blockSize with: loopSize.
	^initSize
	+ loopSize! !

!MessageNode methodsFor: 'testing' stamp: 'eem 7/20/2009 09:31'!
isOptimized
	^special > 0! !

!MessageNode methodsFor: 'macro transformations' stamp: 'eem 9/6/2009 19:18'!
transformOr: encoder
	(self transformBoolean: encoder)
		ifTrue: 
			[arguments := 
				Array 
					with: ((BlockNode withJust: NodeTrue) noteOptimizedIn: self)
					with: ((arguments at: 1) noteOptimizedIn: self).
			^true]
		ifFalse: 
			[^false]! !

!MessageNode methodsFor: 'testing' stamp: ''!
isMessage: selSymbol receiver: rcvrPred arguments: argsPred
	"Answer whether selector is selSymbol, and the predicates rcvrPred and argsPred
	 evaluate to true with respect to receiver and the list of arguments.  If selSymbol or
	 either predicate is nil, it means 'don't care'.  Note that argsPred takes numArgs
	 arguments.  All block arguments are ParseNodes."

	^(selSymbol isNil or: [selSymbol==selector key]) and:
		[(rcvrPred isNil or: [rcvrPred value: receiver]) and:
			[(argsPred isNil or: [argsPred valueWithArguments: arguments])]]! !

!MessageNode methodsFor: 'printing' stamp: 'ul 11/15/2010 11:53'!
printToDoOn: aStream indent: level

	| limitNode |
	self printReceiver: receiver on: aStream indent: level.

	(arguments last == nil or: [(arguments last isMemberOf: AssignmentNode) not])
		ifTrue: [limitNode := arguments first]
		ifFalse: [limitNode := arguments last value].
	(selector key = #to:by:do:
	 and: [(arguments at: 2) isConstantNumber
	 and: [(arguments at: 2) key = 1]])
		ifTrue: [self printKeywords: #to:do:
					arguments: (Array with: limitNode with: (arguments at: 3))
					on: aStream indent: level]
		ifFalse: [self printKeywords: selector key
					arguments: (Array with: limitNode) , arguments allButFirst
					on: aStream indent: level]! !

!MessageNode methodsFor: 'code generation' stamp: 'nice 12/27/2009 03:11'!
sizeCodeForCase: encoder value: forValue

	| braceNode sizeIndex elseSize allReturn |
	forValue not ifTrue:
		[^super sizeCodeForEffect: encoder].
	equalNode := encoder encodeSelector: #=.
	braceNode := arguments first.
	sizes := Array new: 2 * braceNode numElements.
	sizeIndex := sizes size.
	elseSize := arguments size = 2
		ifTrue:
			[arguments last sizeCodeForEvaluatedValue: encoder] "otherwise: [...]"
		ifFalse:
			[caseErrorNode := encoder encodeSelector: #caseError.
			 (NodeSelf sizeCodeForValue: encoder)
			 + (caseErrorNode sizeCode: encoder args: 0 super: false)]. "self caseError"
	"There must be at least one branch around the otherwise/caseError
	  so the decompiler can identify the end of the otherwise/caseError."
	allReturn := true. "assume every case ends with a return"
	braceNode casesForwardDo:
		[:keyNode :valueNode :last |
		valueNode returns ifFalse: [allReturn := false]].
	braceNode casesReverseDo:
		[:keyNode :valueNode :last | | thenSize |
		sizes at: sizeIndex put: elseSize.
		thenSize := valueNode sizeCodeForEvaluatedValue: encoder.
		last ifFalse: [thenSize := thenSize + encoder sizePop].
		valueNode returns ifFalse: [thenSize := thenSize + (self sizeCode: encoder forJump: elseSize)].
		(last and: [allReturn]) ifTrue: [thenSize := thenSize + (self sizeCode: encoder forJump: elseSize)].
		sizes at: sizeIndex-1 put: thenSize.
		last ifFalse: [elseSize := elseSize + encoder sizeDup].
		elseSize := elseSize
					+ (keyNode sizeCodeForEvaluatedValue: encoder)
					+ (equalNode sizeCode: encoder args: 1 super: false)
					+ (self sizeCode: encoder forBranchOn: false dist: thenSize)
					+ thenSize.
		sizeIndex := sizeIndex - 2].
	^(receiver sizeCodeForValue: encoder) + elseSize! !

!MessageNode methodsFor: 'initialize-release' stamp: 'MarcusDenker 2/16/2010 09:05'!
receiver: rcvr selector: selName arguments: args precedence: p from: encoder sourceRange: range
	"Compile."
	encoder noteSourceRange: range forNode: self.
	^self
		receiver: rcvr
		selector: selName
		arguments: args
		precedence: p
		from: encoder! !

!MessageNode methodsFor: 'printing' stamp: ''!
precedence

	^precedence! !

!MessageNode methodsFor: 'macro transformations' stamp: 'eem 9/6/2009 19:17'!
transformWhile: encoder
	(self checkBlock: receiver as: 'receiver' from: encoder) ifFalse:
		[^false].
	arguments size = 0 ifTrue:  "transform bodyless form to body form"
		[selector := SelectorNode new
						key: (special = 10 ifTrue: [#whileTrue:] ifFalse: [#whileFalse:])
						code: #macro.
		 arguments := Array with: ((BlockNode withJust: NodeNil) noteOptimizedIn: self).
		 receiver noteOptimizedIn: self.
		 ^true].
	^(self transformBoolean: encoder)
	   and: [receiver noteOptimizedIn: self.
			arguments first noteOptimizedIn: self.
			true]! !

!MessageNode methodsFor: 'equation translation' stamp: 'RAA 2/14/2001 14:07'!
receiver: val
	"14 feb 2001 - removed return arrow"

	receiver := val! !

!MessageNode methodsFor: 'initialize-release' stamp: 'tk 10/26/2000 15:37'!
selector: sel
	selector := sel! !

!MessageNode methodsFor: 'code generation' stamp: 'eem 8/15/2010 10:23'!
emitCodeForValue: stack encoder: encoder
	"For #ifTrue:ifFalse: and #whileTrue: / #whileFalse: style messages, the pc is set to the jump instruction, so that mustBeBoolean exceptions can be shown correctly."
	special > 0
		ifTrue: 
			[pc := 0.
			self perform: (MacroEmitters at: special) with: stack with: encoder with: true]
		ifFalse: 
			[receiver ~~ nil ifTrue: [receiver emitCodeForValue: stack encoder: encoder].
			arguments do: [:argument | argument emitCodeForValue: stack encoder: encoder].
			pc := encoder methodStreamPosition + 1. "debug pc is first byte of the send, i.e. the next byte".
			selector
				emitCode: stack
				args: arguments size
				encoder: encoder
				super: receiver == NodeSuper]! !

!MessageNode methodsFor: 'macro transformations' stamp: 'eem 9/6/2009 13:33'!
transformAnd: encoder
	(self transformBoolean: encoder)
		ifTrue: 
			[arguments := 
				Array 
					with: ((arguments at: 1) noteOptimizedIn: self)
					with: ((BlockNode withJust: NodeFalse) noteOptimizedIn: self).
			^true]
		ifFalse: 
			[^false]! !

!MessageNode methodsFor: 'visiting' stamp: 'eem 9/23/2008 21:52'!
argumentsInEvaluationOrder
	"Answer the receivers arguments in evaluation order.
	 If the receiver is a transformed to:do: node this will undo the misordering done by the transformation."
	^(special > 0
	   and: [(MacroTransformers at: special) == #transformToDo:
	   and: [arguments size >= 7]])
		"arguments are in a weid order and may be nil in a transformed to:do: loop.  sigh...
		 c.f. emitCodeForToDo:encoder:value:"
		ifTrue:
			[(arguments at: 7)	"limitInit"
				ifNil: [{	(arguments at: 4).	"initStmt"
						(arguments at: 5).	"test"
						(arguments at: 3).	"block"
						(arguments at: 6) 	"incStmt" }]
				ifNotNil: [:limitInit|
						{ limitInit.
						(arguments at: 4).	"initStmt"
						(arguments at: 5).	"test"
						(arguments at: 3).	"block"
						(arguments at: 6) 	"incStmt" }]]
		ifFalse:
			[arguments]! !

!MessageNode methodsFor: 'private' stamp: 'acg 1/28/2000 00:57'!
ifNilReceiver

	^receiver! !

!MessageNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 16:28'!
emitCodeForIfNil: stack encoder: encoder value: forValue

	| theNode theSize ifNotNilSelector |
	theNode := arguments first.
	theSize := sizes at: 1.
	ifNotNilSelector := #ifNotNil:.
	receiver emitCodeForValue: stack encoder: encoder.
	forValue ifTrue: [encoder genDup. stack push: 1].
	encoder genPushSpecialLiteral: nil. stack push: 1.
	equalNode emitCode: stack args: 1 encoder: encoder.
	self 
		emitCodeForBranchOn: (selector key == ifNotNilSelector)
		dist: theSize 
		pop: stack 
		encoder: encoder.
	pc := encoder methodStreamPosition.
	forValue 
		ifTrue: 
			[encoder genPop. stack pop: 1.
			theNode emitCodeForEvaluatedValue: stack encoder: encoder]	
		ifFalse: [theNode emitCodeForEvaluatedEffect: stack encoder: encoder]! !

!MessageNode methodsFor: 'macro transformations' stamp: 'eem 9/6/2009 19:19'!
transformIfFalse: encoder
	(self transformBoolean: encoder)
		ifTrue: 
			[arguments := 
				Array 
					with: ((BlockNode withJust: NodeNil) noteOptimizedIn: self)
					with: ((arguments at: 1) noteOptimizedIn: self).
			^true]
		ifFalse:
			[^false]! !

!MessageNode methodsFor: 'testing' stamp: 'eem 2/3/2011 09:08'!
canCascade

	^receiver ~~ NodeSuper! !

!MessageNode methodsFor: 'code generation' stamp: 'nice 2/20/2012 20:50'!
emitCodeForToDo: stack encoder: encoder value: forValue 
	" var := rcvr. L1: [var <= arg1] Bfp(L2) [block body. var := var + inc] Jmp(L1) L2: "
	| loopSize initStmt limitInit test block incStmt blockSize |
	initStmt := arguments at: 4.
	limitInit := arguments at: 7.
	test := arguments at: 5.
	block := arguments at: 3.
	incStmt := arguments at: 6.
	blockSize := sizes at: 1.
	loopSize := sizes at: 2.
	limitInit == nil
		ifFalse: [limitInit emitCodeForEffect: stack encoder: encoder].
		
	"This will return the receiver of to:do: which is the initial value of the loop"
	forValue
		ifTrue: [initStmt emitCodeForValue: stack encoder: encoder.]
		ifFalse: [initStmt emitCodeForEffect: stack encoder: encoder].
	test emitCodeForValue: stack encoder: encoder.
	self emitCodeForBranchOn: false dist: blockSize pop: stack encoder: encoder.
	pc := encoder methodStreamPosition.
	block emitCodeForEvaluatedEffect: stack encoder: encoder.
	incStmt emitCodeForEffect: stack encoder: encoder.
	self emitCodeForJump: 0 - loopSize encoder: encoder.! !

!MessageNode methodsFor: 'code generation' stamp: 'PeterHugossonMiller 9/2/2009 16:13'!
emitCodeForCase: stack encoder: encoder value: forValue

	| braceNode sizeStream allReturn |
	forValue ifFalse:
		[^super emitCodeForEffect: stack encoder: encoder].
	braceNode := arguments first.
	sizeStream := sizes readStream.
	receiver emitCodeForValue: stack encoder: encoder.
	"There must be at least one branch around the otherwise/caseError
	  so the decompiler can identify the end of the otherwise/caseError."
	allReturn := true. "assume every case ends with a return"
	braceNode casesForwardDo:
		[:keyNode :valueNode :last | | thenSize elseSize |
		thenSize := sizeStream next.
		elseSize := sizeStream next.
		last ifFalse: [encoder genDup. stack push: 1].
		keyNode emitCodeForEvaluatedValue: stack encoder: encoder.
		equalNode emitCode: stack args: 1 encoder: encoder.
		self emitCodeForBranchOn: false dist: thenSize pop: stack encoder: encoder.
		last ifFalse: [encoder genPop. stack pop: 1].
		valueNode emitCodeForEvaluatedValue: stack encoder: encoder.
		last ifTrue: [stack pop: 1].
		valueNode returns ifFalse:
			[self emitCodeForJump: elseSize encoder: encoder.
			 allReturn := false].
		(last and: [allReturn]) ifTrue:
			[self emitCodeForJump: elseSize encoder: encoder]].
	arguments size = 2
		ifTrue:
			[arguments last emitCodeForEvaluatedValue: stack encoder: encoder] "otherwise: [...]"
		ifFalse:
			[NodeSelf emitCodeForValue: stack encoder: encoder.
			caseErrorNode emitCode: stack args: 0 encoder: encoder]! !

!MessageNode methodsFor: 'macro transformations' stamp: 'nice 1/12/2011 22:07'!
toDoFromWhileWithInit: initStmt
	"Return nil, or a to:do: expression equivalent to this whileTrue:"
	| variable increment limit toDoBlock body test |
	(selector key == #whileTrue:
	 and: [initStmt isAssignmentNode
	 and: [initStmt variable isTemp]]) ifFalse:
		[^nil].
	body := arguments last statements.
	variable := initStmt variable.
	increment := body last toDoIncrement: variable.
	(increment == nil
	 or: [receiver statements size ~= 1]) ifTrue:
		[^nil].
	test := receiver statements first.
	"Note: test chould really be checked that <= or >= comparison
	jibes with the sign of the (constant) increment"
	(test isMessageNode
	 and: [(limit := test toDoLimit: variable) notNil]) ifFalse:
		[^nil].
	"The block must not overwrite the limit"
	(limit isVariableNode and: [body anySatisfy: [:e | e isAssignmentNode and: [e variable = limit]]])
		ifTrue: [^nil]. 
	toDoBlock := BlockNode statements: body allButLast returns: false.
	toDoBlock arguments: (Array with: variable).
	variable scope: -1.
	variable beBlockArg.
	^MessageNode new
		receiver: initStmt value
		selector: (SelectorNode new key: #to:by:do: code: #macro)
		arguments: (Array with: limit with: increment with: toDoBlock)
		precedence: precedence! !

!MessageNode methodsFor: 'macro transformations' stamp: 'nice 2/3/2011 20:58'!
transformRepeat: encoder
	"answer true if this #repeat message can be optimized"
	
	^(self checkBlock: receiver as: 'receiver' from: encoder)
	   and: [receiver noteOptimizedIn: self.
			true]! !

!MessageNode methodsFor: 'testing' stamp: ''!
toDoIncrement: variable
	(receiver = variable and: [selector key = #+]) 
		ifFalse: [^ nil].
	arguments first isConstantNumber
		ifTrue: [^ arguments first]
		ifFalse: [^ nil]! !

!MessageNode methodsFor: 'macro transformations' stamp: 'ul 2/26/2011 21:58'!
transformCase: encoder

	| caseNode |
	caseNode := arguments first.
	(caseNode isMemberOf: BraceNode) ifFalse: [ ^false ].
	(caseNode blockAssociationCheck: encoder) ifFalse: [ ^false ].
	(arguments size = 1 or: [
		self checkBlock: arguments last as: 'otherwise arg' from: encoder ]) ifFalse: [
			^false ].
	 caseNode elements do: [ :messageNode |
		messageNode receiver noteOptimizedIn: self.
		messageNode arguments first noteOptimizedIn: self ].
	 arguments size = 2 ifTrue: [ arguments last noteOptimizedIn: self ].
	 ^true! !

!MessageNode methodsFor: 'macro transformations' stamp: 'eem 9/7/2010 14:56'!
transformToDo: encoder
	" var := rcvr. L1: [var <= arg1] Bfp(L2) [block body. var := var + inc] 
Jmp(L1) L2: "
	| limit increment block initStmt test incStmt limitInit blockVar myRange blockRange limitIsAssignedTo |
	"First check for valid arguments"
	((arguments last isMemberOf: BlockNode)
	  and: [arguments last numberOfArguments = 1
	  and: [arguments last firstArgument isVariableReference "As with debugger remote vars"]]) ifFalse:
		[^false].
	arguments size = 3
		ifTrue: [increment := arguments at: 2.
				(increment isConstantNumber
				 and: [increment literalValue ~= 0]) ifFalse: [^false]]
		ifFalse: [increment := encoder encodeLiteral: 1].
	(limit := arguments at: 1) isVariableReference ifTrue:
		[limitIsAssignedTo := false.
		 arguments last nodesDo:
			[:node|
			(node isAssignmentNode and: [node variable = limit]) ifTrue:
				[limitIsAssignedTo := true]].
		 limitIsAssignedTo ifTrue:
			[^false]].
	arguments size < 3 ifTrue:   "transform to full form"
		[selector := SelectorNode new key: #to:by:do: code: #macro].

	"Now generate auxiliary structures"
	myRange := encoder rawSourceRanges at: self ifAbsent: [1 to: 0].
	block := arguments last.
	blockRange := encoder rawSourceRanges at: block ifAbsent: [1 to: 0].
	blockVar := block firstArgument.
	initStmt := AssignmentNode new variable: blockVar value: receiver.
	limit isVariableReference | limit isConstantNumber
		ifTrue: [limitInit := nil]
		ifFalse:  "Need to store limit in a var"
			[limit := encoder bindBlockArg: blockVar key, 'LimiT' within: block.
			 limit scope: -2.  "Already done parsing block; flag so it won't print"
			 block addArgument: limit.
			 limitInit := AssignmentNode new
							variable: limit
							value: arguments first].
	test := MessageNode new
				receiver: blockVar
				selector: (increment key > 0 ifTrue: [#<=] ifFalse: [#>=])
				arguments: (Array with: limit)
				precedence: precedence from: encoder
				sourceRange: (myRange first to: blockRange first).
	incStmt := AssignmentNode new
				variable: blockVar
				value: (MessageNode new
							receiver: blockVar selector: #+
							arguments: (Array with: increment)
							precedence: precedence from: encoder)
				from: encoder
				sourceRange: (myRange last to: myRange last).
	arguments := (Array with: limit with: increment with: block),
					(Array with: initStmt with: test with: incStmt with: limitInit).
	block noteOptimizedIn: self.
	^true! !

!MessageNode methodsFor: 'testing' stamp: 'John M McIntosh 3/2/2009 19:58'!
isMessageNode
	^true! !

!MessageNode methodsFor: 'private' stamp: 'jmv 3/3/2011 08:53'!
receiver: rcvr arguments: args precedence: p

	receiver := rcvr.
	arguments := args.
	originalArguments := arguments copy.
	sizes := Array new: arguments size.
	precedence := p! !

!MessageNode methodsFor: 'equation translation' stamp: ''!
selector
	^selector! !

!MessageNode methodsFor: 'testing' stamp: ''!
toDoLimit: variable
	(receiver = variable and: [selector key = #<= or: [selector key = #>=]]) 
		ifTrue: [^ arguments first]
		ifFalse: [^ nil]! !

!MessageNode methodsFor: 'code generation (closures)' stamp: 'eem 8/4/2009 11:58'!
analyseTempsWithin: scopeBlock "<BlockNode>" rootNode: rootNode "<MethodNode>" assignmentPools: assignmentPools "<Dictionary>"
	"Assignments within optimized loops are tricky.  Because a loop repeats a
	 write to a temporary in an optimized loop effectively occurs after the loop.
	 To handle this collect the set of temps assigned to in optimized loops and
	 add extra writes after traversing the optimized loop constituents."
	| writtenToTemps |
	self isOptimizedLoop ifTrue:
		[{ receiver }, arguments do:
			[:node|
			(node notNil and: [node isBlockNode and: [node optimized]]) ifTrue:
				[assignmentPools at: node put: Set new]]].
	"receiver is nil in cascades"
	receiver == nil ifFalse:
		[receiver analyseTempsWithin: scopeBlock rootNode: rootNode assignmentPools: assignmentPools].
	arguments do:
		[:node|
		node == nil ifFalse: "last argument of optimized to:do: can be nil"
			[node analyseTempsWithin: scopeBlock rootNode: rootNode assignmentPools: assignmentPools]].
	"Add assignments representing subsequent iterations
	 and redo the closure analysis for the written-to temps."
	self isOptimizedLoop ifTrue:
		[writtenToTemps := Set new.
		 { receiver }, arguments do:
			[:node|
			(node notNil and: [node isBlockNode and: [node optimized]]) ifTrue:
				[(assignmentPools removeKey: node) do:
					[:temp|
					temp isBlockArg ifFalse: "ignore added assignments to to:do: loop args"
						[writtenToTemps add: temp.
						 temp addWriteWithin: node at: rootNode locationCounter]]]].
		 writtenToTemps isEmpty ifFalse:
			[(writtenToTemps asSortedCollection: ParseNode tempSortBlock) do:
				[:each| each analyseClosure: rootNode].
			 (writtenToTemps collect: [:each| each definingScope]) do:
				[:blockNode|
				blockNode ifHasRemoteTempNodeEnsureInitializationStatementExists: rootNode]]]! !

!MessageNode methodsFor: 'code generation' stamp: 'nice 3/31/2011 00:25'!
sizeCodeForValue: encoder
	| total |
	special > 0 
		ifTrue: 
			[encoder noteOptimizedSelector: originalSelector.
			^self perform: (MacroSizers at: special) with: encoder with: true].
	receiver == NodeSuper
		ifTrue: [selector := selector copy "only necess for splOops"].
	total := selector sizeCode: encoder args: arguments size super: receiver == NodeSuper.
	receiver == nil 
		ifFalse: [total := total + (receiver sizeCodeForValue: encoder)].
	sizes := arguments collect: 
					[:arg | | argSize | 
					argSize := arg sizeCodeForValue: encoder.
					total := total + argSize.
					argSize].
	^total! !

!MessageNode methodsFor: 'macro transformations' stamp: 'eem 9/6/2009 19:19'!
transformIfNil: encoder

	"vb: Removed the original transformBoolean: which amounds to a test we perform in each of the branches below."
	(MacroSelectors at: special) = #ifNotNil: ifTrue:
		[(self checkBlock: arguments first as: 'ifNotNil arg' from: encoder maxArgs: 1) ifFalse:
			[^false].

		"Transform 'ifNotNil: [stuff]' to 'ifNil: [nil] ifNotNil: [stuff]'.
		Slightly better code and more consistent with decompilation."
		self noteSpecialSelector: #ifNil:ifNotNil:.
		selector := SelectorNode new key: (MacroSelectors at: special) code: #macro.
		arguments := Array
						with: ((BlockNode withJust: NodeNil) noteOptimizedIn: self)
						with: (arguments first noteOptimizedIn: self).
		(self transform: encoder) ifFalse:
			[self error: 'compiler logic error'].
		^true].
	(self checkBlock: arguments first as: 'ifNil arg' from: encoder) ifFalse:
		[^false].
	arguments first noteOptimizedIn: self.
	^true! !

!MessageNode methodsFor: 'testing' stamp: 'eem 9/26/2008 12:39'!
isReturningIf

	^((special between: 3 and: 4) "ifTrue:ifFalse:/ifFalse:ifTrue:"
	    or: [special between: 17 and: 18]) "ifNil:ifNotNil:/ifNotNil:ifNil:"
		and: [arguments first returns and: [arguments last returns]]! !

!MessageNode methodsFor: 'macro transformations' stamp: ''!
transform: encoder
	special = 0 ifTrue: [^false].
	(self perform: (MacroTransformers at: special) with: encoder)
		ifTrue: 
			[^true]
		ifFalse: 
			[special := 0. ^false]! !

!MessageNode methodsFor: 'testing' stamp: ''!
isComplex
	
	^(special between: 1 and: 10) or: [arguments size > 2 or: [receiver isComplex]]! !

!MessageNode methodsFor: 'printing' stamp: 'di 5/1/2000 23:20'!
printIfNilNotNil: aStream indent: level

	self printReceiver: receiver ifNilReceiver on: aStream indent: level.

	(arguments first isJust: NodeNil) ifTrue:
		[^ self printKeywords: #ifNotNil:
				arguments: { arguments second }
				on: aStream indent: level].
	(arguments second isJust: NodeNil) ifTrue:
		[^ self printKeywords: #ifNil:
				arguments: { arguments first }
				on: aStream indent: level].
	^ self printKeywords: #ifNil:ifNotNil:
			arguments: arguments
			on: aStream indent: level! !

!MessageNode methodsFor: 'printing' stamp: 'nice 2/3/2011 20:57'!
printRepeatOn: aStream indent: level

	self printReceiver: receiver on: aStream indent: level.

	^self printKeywords: selector key
		arguments: (Array new)
		on: aStream indent: level! !

!MessageNode methodsFor: 'printing' stamp: 'eem 9/25/2008 16:12'!
printOn: aStream indent: level
	"may not need this check anymore - may be fixed by the #receiver: change"
	special ifNil: [^aStream nextPutAll: '** MessageNode with nil special **'].

	special > 0 ifTrue:
		[^self perform: self macroPrinter with: aStream with: level].

	self printReceiver: receiver on: aStream indent: level.
	selector isForFFICall
		ifTrue:
			[aStream space.
			 selector
				printAsFFICallWithArguments: arguments
				on: aStream
				indent: 0]
		ifFalse:
			[self printKeywords: selector key
				 arguments: arguments
				 on: aStream
				 indent: level]! !

!MessageNode methodsFor: 'private' stamp: 'vb 4/15/2007 09:10'!
checkBlock: node as: nodeName from: encoder

	^self checkBlock: node as: nodeName from: encoder maxArgs: 0! !

!MessageNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 17:12'!
emitCodeForIf: stack encoder: encoder value: forValue
	| thenExpr thenSize elseExpr elseSize |
	thenSize := sizes at: 1.
	elseSize := sizes at: 2.
	(forValue not and: [elseSize * thenSize > 0]) ifTrue:
		"Two-armed IFs forEffect share a single pop"
		[^super emitCodeForEffect: stack encoder: encoder].
	thenExpr := arguments at: 1.
	elseExpr := arguments at: 2.
	receiver emitCodeForValue: stack encoder: encoder.
	forValue
		ifTrue:  "Code all forValue as two-armed"
			[self emitCodeForBranchOn: false dist: thenSize pop: stack encoder: encoder.
			pc := encoder methodStreamPosition.
			thenExpr emitCodeForEvaluatedValue: stack encoder: encoder.
			stack pop: 1.  "then and else alternate; they don't accumulate"
			thenExpr returns not ifTrue:
				"...not ifTrue: avoids using ifFalse: alone during this compile)"
				"Elide jump over else after a return"
				[self emitCodeForJump: elseSize encoder: encoder].
			elseExpr emitCodeForEvaluatedValue: stack encoder: encoder]
		ifFalse:  "One arm is empty here (two-arms code forValue)"
			[thenSize > 0
				ifTrue:
					[self emitCodeForBranchOn: false dist: thenSize pop: stack encoder: encoder.
					pc := encoder methodStreamPosition.
					thenExpr emitCodeForEvaluatedEffect: stack encoder: encoder]
				ifFalse:
					[self emitCodeForBranchOn: true dist: elseSize pop: stack encoder: encoder.
					pc := encoder methodStreamPosition.
					elseExpr emitCodeForEvaluatedEffect: stack encoder: encoder]]! !

!MessageNode methodsFor: 'printing' stamp: 'eem 5/6/2008 13:57'!
printIfOn: aStream indent: level

	receiver ifNotNil:
		[receiver printOn: aStream indent: level + 1 precedence: precedence].
	(arguments last isJust: NodeNil) ifTrue:
		[^self printKeywords: #ifTrue: arguments: (Array with: arguments first)
					on: aStream indent: level].
	(arguments last isJust: NodeFalse) ifTrue:
		[^self printKeywords: #and: arguments: (Array with: arguments first)
					on: aStream indent: level].
	(arguments first isJust: NodeNil) ifTrue:
		[^self printKeywords: #ifFalse: arguments: (Array with: arguments last)
					on: aStream indent: level].
	(arguments first isJust: NodeTrue) ifTrue:
		[^self printKeywords: #or: arguments: (Array with: arguments last)
					on: aStream indent: level].
	self printKeywords: #ifTrue:ifFalse: arguments: arguments
					on: aStream indent: level! !

!MessageNode methodsFor: 'macro transformations' stamp: 'eem 9/6/2009 19:18'!
transformIfNilIfNotNil: encoder
	"vb: Changed to support one-argument ifNotNil: branch. In the 1-arg case we
	 transform the receiver to
		(var := receiver)
	 which is further transformed to
		(var := receiver) == nil ifTrue: .... ifFalse: ...
	 This does not allow the block variable to shadow an existing temp, but it's no different
	 from how to:do: is done."
	| ifNotNilArg |
	ifNotNilArg := arguments at: 2.
	((self checkBlock: (arguments at: 1) as: 'Nil arg' from: encoder)
	  and: [self checkBlock: ifNotNilArg as: 'NotNil arg' from: encoder maxArgs: 1]) ifFalse:
		[^false].

	ifNotNilArg numberOfArguments = 1 ifTrue:
		[receiver := AssignmentNode new
						variable: ifNotNilArg firstArgument
						value: receiver].

	selector := SelectorNode new key: #ifTrue:ifFalse: code: #macro.
	receiver := MessageNode new
					receiver: receiver
					selector: #==
					arguments: (Array with: NodeNil)
					precedence: 2
					from: encoder.
	arguments do: [:arg| arg noteOptimizedIn: self].
	^true! !

!MessageNode methodsFor: 'printing' stamp: 'eem 5/6/2008 14:09'!
printReceiver: rcvr on: aStream indent: level
					
	rcvr ifNil: [^ self].

	"Force parens around keyword receiver of kwd message"
	rcvr printOn: aStream indent: level precedence: precedence! !

!MessageNode methodsFor: 'testing' stamp: 'eem 7/20/2009 10:44'!
isOptimizedLoop
	^special > 0
	   and: [#(transformWhile: transformToDo:) includes: (MacroTransformers at: special)]! !

!MessageNode methodsFor: 'code generation' stamp: 'nice 2/3/2011 21:10'!
sizeCodeForRepeat: encoder value: forValue 
	"L1: ... Jmp(L1) nil (nil for value only);"
	| loopSize |
	loopSize := (receiver sizeCodeForEvaluatedEffect: encoder) + (encoder sizeJumpLong: 1).
	sizes := Array with: loopSize.
	^loopSize + (forValue ifTrue: [encoder sizePushSpecialLiteral: nil] ifFalse: [0])! !

!MessageNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 17:15'!
sizeCodeForIf: encoder value: forValue
	| thenExpr elseExpr branchSize thenSize elseSize |
	thenExpr := arguments at: 1.
	elseExpr := arguments at: 2.
	(forValue
	 or: [(thenExpr isJust: NodeNil)
	 or: [elseExpr isJust: NodeNil]]) not
			"(...not ifTrue: avoids using ifFalse: alone during this compile)"
		ifTrue:  "Two-armed IFs forEffect share a single pop"
			[^super sizeCodeForEffect: encoder].
	forValue
		ifTrue:  "Code all forValue as two-armed"
			[elseSize := elseExpr sizeCodeForEvaluatedValue: encoder.
			thenSize := (thenExpr sizeCodeForEvaluatedValue: encoder)
					+ (thenExpr returns
						ifTrue: [0]  "Elide jump over else after a return"
						ifFalse: [self sizeCode: encoder forJump: elseSize]).
			branchSize := self sizeCode: encoder forBranchOn: false dist: thenSize]
		ifFalse:  "One arm is empty here (two-arms code forValue)"
			[(elseExpr isJust: NodeNil)
				ifTrue:
					[elseSize := 0.
					thenSize := thenExpr sizeCodeForEvaluatedEffect: encoder.
					branchSize := self sizeCode: encoder forBranchOn: false dist: thenSize]
				ifFalse:
					[thenSize := 0.
					elseSize := elseExpr sizeCodeForEvaluatedEffect: encoder.
					branchSize := self sizeCode: encoder forBranchOn: true dist: elseSize]].
	sizes := Array with: thenSize with: elseSize.
	^(receiver sizeCodeForValue: encoder)
	+ branchSize + thenSize + elseSize! !

!MessageNode methodsFor: 'equation translation' stamp: ''!
receiver
	^receiver! !

!MessageNode methodsFor: 'printing' stamp: 'di 5/30/2000 23:17'!
printOn: strm indent: level precedence: outerPrecedence

	| parenthesize |
	parenthesize := precedence > outerPrecedence
		or: [outerPrecedence = 3 and: [precedence = 3 "both keywords"]].
	parenthesize
		ifTrue: [strm nextPutAll: '('.
				self printOn: strm indent: level.
				strm nextPutAll: ')']
		ifFalse: [self printOn: strm indent: level]! !

!MessageNode methodsFor: 'macro transformations' stamp: 'eem 9/6/2009 13:30'!
transformIfTrueIfFalse: encoder
	^(self checkBlock: (arguments at: 1) as: 'True arg' from: encoder)
	   and: [(self checkBlock: (arguments at: 2) as: 'False arg' from: encoder)
	   and: [arguments do: [:arg| arg noteOptimizedIn: self].
			true]]! !

!MessageNode methodsFor: 'printing' stamp: 'eem 9/25/2008 15:41'!
printKeywords: key arguments: args on: aStream indent: level
	| keywords indent arg kwd doCrTab |
	args size = 0 ifTrue:
		[aStream space; nextPutAll: key.
		 ^self].
	keywords := key keywords.
	doCrTab := args size > 2
				or: [{receiver} , args anySatisfy:
						[:thisArg |
						thisArg notNil
						and: [thisArg isBlockNode
							 or: [thisArg isMessageNode and: [thisArg precedence >= 3]]]]].
	1 to: (args size min: keywords size) do:
		[:i |
		arg := args at: i.
		kwd := keywords at: i.
		doCrTab
			ifTrue: [aStream crtab: level+1. indent := 1] "newline after big args"
			ifFalse: [aStream space. indent := 0].
		aStream nextPutAll: kwd; space.
		arg printOn: aStream
			indent: level + 1 + indent
			precedence: (precedence = 2 ifTrue: [1] ifFalse: [precedence])]! !

!MessageNode methodsFor: 'cascading' stamp: ''!
cascadeReceiver
	"Nil out rcvr (to indicate cascade) and return what it had been."

	| rcvr |
	rcvr := receiver.
	receiver := nil.
	^rcvr! !

!MessageNode methodsFor: 'printing' stamp: 'eem 9/25/2008 14:51'!
printParenReceiver: rcvr on: aStream indent: level
					
	rcvr isBlockNode ifTrue:
		[^rcvr printOn: aStream indent: level].
	aStream nextPut: $(.
	rcvr printOn: aStream indent: level.
	aStream nextPut: $)
! !

!MessageNode methodsFor: 'equation translation' stamp: 'tk 10/27/2000 15:11'!
arguments: list
	arguments := list! !

!MessageNode methodsFor: 'private' stamp: 'ul 2/20/2011 17:17'!
checkBlock: node as: nodeName from: encoder maxArgs: maxArgs
	"Answer true if node is a BlockNode with at most maxArgs arguments.
	This check is required in order to inline some special messages.
	Notify some undue usage of these special messages."

	node isBlockNode ifFalse: [ ^false ].
	node numberOfArguments <= maxArgs ifTrue: [ ^true ].
	^encoder notify: '<- ', nodeName , ' of ' , (MacroSelectors at: special) , ' has too many arguments'! !

!MessageNode methodsFor: 'macro transformations' stamp: 'eem 9/6/2009 13:30'!
transformIfNotNilIfNil: encoder
	"vb: Changed to support one-argument ifNotNil: branch. In the 1-arg case we
	 transform the receiver to
		(var := receiver)
	 which is further transformed to
		(var := receiver) == nil ifTrue: .... ifFalse: ...
	 This does not allow the block variable to shadow an existing temp, but it's no different
	 from how to:do: is done."
	| ifNotNilArg |
	ifNotNilArg := arguments at: 1.
	((self checkBlock: ifNotNilArg as: 'NotNil arg' from: encoder maxArgs: 1)
	  and: [self checkBlock: (arguments at: 2) as: 'Nil arg' from: encoder]) ifFalse:
		[^false].

	ifNotNilArg numberOfArguments = 1 ifTrue:
		[receiver := AssignmentNode new
						variable: ifNotNilArg firstArgument
						value: receiver].

	selector := SelectorNode new key: #ifTrue:ifFalse: code: #macro.
	receiver := MessageNode new
					receiver: receiver
					selector: #==
					arguments: (Array with: NodeNil)
					precedence: 2
					from: encoder.
	arguments swap: 1 with: 2.
	arguments do: [:arg| arg noteOptimizedIn: self].
	^true! !

!MessageNode methodsFor: 'initialize-release' stamp: 'ClementBera 7/26/2013 16:52'!
receiver: rcvr selector: aSelector arguments: args precedence: p from: encoder 
	"Compile."

	self receiver: rcvr
		arguments: args
		precedence: p.
	originalSelector := aSelector.
	self noteSpecialSelector: aSelector.
	(self transform: encoder)
		ifTrue: 
			[selector ifNil:
				[selector := SelectorNode new 
								key: (MacroSelectors at: special)
								code: #macro]]
		ifFalse: 
			[selector := encoder encodeSelector: aSelector.
			rcvr == NodeSuper ifTrue: [encoder noteSuper]].
	
! !

!MessageNode methodsFor: 'equation translation' stamp: ''!
arguments
	^arguments! !

!MessageNode methodsFor: 'code generation' stamp: 'nice 3/31/2011 00:24'!
sizeCodeForEffect: encoder

	special > 0 
		ifTrue:
			[encoder noteOptimizedSelector: originalSelector.
			^self perform: (MacroSizers at: special) with: encoder with: false].
	^super sizeCodeForEffect: encoder! !

!MessageNode class methodsFor: 'class initialization' stamp: 'nice 2/3/2011 21:27'!
initialize
	"MessageNode initialize"
	MacroSelectors := 
		#(	ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue:
			and: or:
			whileFalse: whileTrue: whileFalse whileTrue
			to:do: to:by:do:
			caseOf: caseOf:otherwise:
			ifNil: ifNotNil:  ifNil:ifNotNil: ifNotNil:ifNil:
			repeat ).
	MacroTransformers := 
		#(	transformIfTrue: transformIfFalse: transformIfTrueIfFalse: transformIfFalseIfTrue:
			transformAnd: transformOr:
			transformWhile: transformWhile: transformWhile: transformWhile:
			transformToDo: transformToDo:
			transformCase: transformCase:
			transformIfNil: transformIfNil:  transformIfNilIfNotNil: transformIfNotNilIfNil:
			transformRepeat: ).
	MacroEmitters := 
		#(	emitCodeForIf:encoder:value: emitCodeForIf:encoder:value:
			emitCodeForIf:encoder:value: emitCodeForIf:encoder:value:
			emitCodeForIf:encoder:value: emitCodeForIf:encoder:value:
			emitCodeForWhile:encoder:value: emitCodeForWhile:encoder:value:
			emitCodeForWhile:encoder:value: emitCodeForWhile:encoder:value:
			emitCodeForToDo:encoder:value: emitCodeForToDo:encoder:value:
			emitCodeForCase:encoder:value: emitCodeForCase:encoder:value:
			emitCodeForIfNil:encoder:value: emitCodeForIfNil:encoder:value:
			emitCodeForIf:encoder:value: emitCodeForIf:encoder:value:
			emitCodeForRepeat:encoder:value:).
	MacroSizers := 
		#(	sizeCodeForIf:value: sizeCodeForIf:value: sizeCodeForIf:value: sizeCodeForIf:value:
			sizeCodeForIf:value: sizeCodeForIf:value:
			sizeCodeForWhile:value: sizeCodeForWhile:value: sizeCodeForWhile:value: sizeCodeForWhile:value:
			sizeCodeForToDo:value: sizeCodeForToDo:value:
			sizeCodeForCase:value: sizeCodeForCase:value:
			sizeCodeForIfNil:value: sizeCodeForIfNil:value: sizeCodeForIf:value: sizeCodeForIf:value:
			sizeCodeForRepeat:value:).
	MacroPrinters := 
		#(	printIfOn:indent: printIfOn:indent: printIfOn:indent: printIfOn:indent:
			printIfOn:indent: printIfOn:indent:
			printWhileOn:indent: printWhileOn:indent: printWhileOn:indent: printWhileOn:indent:
			printToDoOn:indent: printToDoOn:indent:
			printCaseOn:indent: printCaseOn:indent:
			printIfNil:indent: printIfNil:indent: printIfNilNotNil:indent: printIfNilNotNil:indent:
			printRepeatOn:indent:)! !

!MessageNotUnderstood commentStamp: '<historical>'!
This exception is provided to support Object>>doesNotUnderstand:.!
!MessageNotUnderstood methodsFor: 'initialization' stamp: 'stephane.ducasse 12/22/2008 13:50'!
initialize

	super initialize.
	reachedDefaultHandler := false	! !

!MessageNotUnderstood methodsFor: 'accessing' stamp: 'stephane.ducasse 12/22/2008 13:50'!
defaultAction

	reachedDefaultHandler := true.
	super defaultAction.! !

!MessageNotUnderstood methodsFor: 'accessing' stamp: 'stephane.ducasse 12/22/2008 13:51'!
reachedDefaultHandler
	^reachedDefaultHandler! !

!MessageNotUnderstood methodsFor: 'accessing' stamp: 'pnm 8/16/2000 15:03'!
message: aMessage

	message := aMessage! !

!MessageNotUnderstood methodsFor: 'accessing' stamp: 'tfei 6/4/1999 18:27'!
message
	"Answer the selector and arguments of the message that failed."

	^message! !

!MessageNotUnderstood methodsFor: 'accessing' stamp: 'ClementBera 9/27/2013 17:58'!
messageText
	"Return an exception's message text."
	
	^ messageText 
		ifNil:
			[message 
				ifNil: [super messageText]
				ifNotNil: [
					message lookupClass == UndefinedObject
						ifTrue: ['receiver of "{1}" is nil' translated format: {message selector asString}]
						ifFalse: [message lookupClass printString, '>>', message selector asString]]]! !

!MessageNotUnderstood methodsFor: 'accessing' stamp: 'ajh 10/9/2001 16:38'!
receiver: obj

	receiver := obj! !

!MessageNotUnderstood methodsFor: 'accessing' stamp: 'ajh 10/9/2001 16:39'!
receiver
	"Answer the receiver that did not understand the message"

	^ receiver! !

!MessageNotUnderstood methodsFor: 'private' stamp: 'tfei 6/4/1999 18:30'!
isResumable
	"Determine whether an exception is resumable."

	^true! !

!MessageSend commentStamp: 'DF 5/25/2006 19:54'!
Instances of MessageSend encapsulate message sends to objects. Arguments can be either predefined or supplied when the message send is performed. 

Use #value to perform a message send with its predefined arguments and #valueWithArguments: if additonal arguments have to supplied.

Structure:
 receiver		Object -- object receiving the message send
 selector		Symbol -- message selector
 arguments		Array -- bound arguments!
!MessageSend methodsFor: 'accessing' stamp: 'sma 2/29/2000 20:39'!
selector
	^ selector! !

!MessageSend methodsFor: 'evaluating' stamp: 'IgorStasenko 3/12/2011 16:22'!
value: anObject1 value: anObject2 value: anObject3

	^ receiver 
		perform: selector 
		with: anObject1
		with: anObject2
		with: anObject3! !

!MessageSend methodsFor: 'evaluating' stamp: 'nk 3/11/2001 11:42'!
valueWithEnoughArguments: anArray
	"call the selector with enough arguments from arguments and anArray"
	| args |
	args := Array new: selector numArgs.
	args replaceFrom: 1
		to: (arguments size min: args size)
		with: arguments
		startingAt: 1.
	args size > arguments size ifTrue: [
		args replaceFrom: arguments size + 1
			to: (arguments size + anArray size min: args size)
			with: anArray
			startingAt: 1.
	].
	^ receiver perform: selector withArguments: args! !

!MessageSend methodsFor: 'evaluating' stamp: 'PavelKrivanek 6/24/2012 18:28'!
value
  "Send the message and answer the return value"

  (receiver class isObsolete) ifTrue: [^ nil].
  (receiver isBehavior and: [receiver isObsolete]) ifTrue: [^ nil].

  arguments ifNil: [^ receiver perform: selector].

  ^ receiver 
    perform: selector 
    withArguments: (self collectArguments: arguments)! !

!MessageSend methodsFor: 'evaluating' stamp: 'PavelKrivanek 6/24/2012 18:29'!
value: anObject

  (receiver class isObsolete) ifTrue: [^ nil].
  (receiver isBehavior and: [receiver isObsolete]) ifTrue: [^ nil].

  ^ receiver 
    perform: selector 
    with: anObject! !

!MessageSend methodsFor: 'printing' stamp: 'SqR 7/14/2001 11:36'!
printOn: aStream

        aStream
                nextPutAll: self class name;
                nextPut: $(.
        selector printOn: aStream.
        aStream nextPutAll: ' -> '.
        receiver printOn: aStream.
        aStream nextPut: $)! !

!MessageSend methodsFor: 'testing' stamp: 'nk 4/25/2002 08:04'!
isMessageSend
	^true
! !

!MessageSend methodsFor: 'testing' stamp: 'nk 7/21/2003 15:16'!
isValid
	^true! !

!MessageSend methodsFor: 'converting' stamp: 'IgorStasenko 3/12/2011 17:49'!
asWeakMessageSend

	^ WeakMessageSend
		receiver: receiver
		selector: selector
		arguments: arguments copy! !

!MessageSend methodsFor: 'evaluating' stamp: 'IgorStasenko 3/12/2011 16:16'!
cull: arg1 cull: arg2
	^ selector numArgs < 2 
		ifTrue: [ self cull: arg1]
		ifFalse: [ self value: arg1 value: arg2 ]! !

!MessageSend methodsFor: 'comparing' stamp: 'sma 3/11/2000 10:35'!
hash
	^ receiver hash bitXor: selector hash! !

!MessageSend methodsFor: 'evaluating' stamp: 'IgorStasenko 3/12/2011 16:22'!
value: anObject1 value: anObject2

	^ receiver 
		perform: selector 
		with: anObject1
		with: anObject2! !

!MessageSend methodsFor: '*glamour-helpers' stamp: 'TudorGirba 9/25/2013 06:53'!
glamourValueWithArgs: anArray 
	"This is the same as valueWithPossibleArgs: from squeak. 
	Unfortunately, VW's cullValue: is incompatible." 
	
	self selector isUnary ifTrue: [^self value]. 
	self selector numArgs = anArray size ifTrue: [^self valueWithArguments: anArray]. 
	self selector numArgs > anArray size 
		ifTrue: 
			[^self 
				valueWithArguments: anArray , (Array new: self selector numArgs - anArray size)]. 
	^self 
		valueWithArguments: 
			(anArray 
				copyFrom: 1 
				to: self selector numArgs)! !

!MessageSend methodsFor: 'evaluating' stamp: 'IgorStasenko 3/12/2011 16:15'!
cull: arg
	^ selector numArgs = 0 
		ifTrue: [ self value ]
		ifFalse: [ self value: arg ].

	! !

!MessageSend methodsFor: 'evaluating' stamp: 'IgorStasenko 3/12/2011 16:23'!
cull: arg1 cull: arg2 cull: arg3
	^ selector numArgs < 3 
		ifTrue: [ self cull: arg1 cull: arg2 ]
		ifFalse: [ self value: arg1 value: arg2 value: arg3 ]! !

!MessageSend methodsFor: 'accessing' stamp: 'sma 2/29/2000 20:39'!
receiver: anObject
	receiver := anObject! !

!MessageSend methodsFor: 'converting' stamp: 'nk 12/20/2002 17:54'!
asMinimalRepresentation
	^self! !

!MessageSend methodsFor: 'accessing' stamp: 'sma 2/29/2000 20:40'!
arguments: anArray
	arguments := anArray! !

!MessageSend methodsFor: 'accessing' stamp: 'sma 2/29/2000 20:39'!
receiver
	^ receiver! !

!MessageSend methodsFor: 'accessing' stamp: 'sma 2/29/2000 20:39'!
selector: aSymbol
	selector := aSymbol! !

!MessageSend methodsFor: 'evaluating' stamp: 'reThink 2/18/2001 16:51'!
valueWithArguments: anArray

	^ receiver 
		perform: selector 
		withArguments: (self collectArguments: anArray)! !

!MessageSend methodsFor: 'comparing' stamp: 'sma 2/29/2000 20:43'!
= anObject
	^ anObject species == self species 
		and: [receiver == anObject receiver
		and: [selector == anObject selector
		and: [arguments = anObject arguments]]]! !

!MessageSend methodsFor: 'accessing' stamp: 'eem 1/3/2009 10:42'!
numArgs
	"Answer the number of arguments in this message"

	^arguments size! !

!MessageSend methodsFor: 'accessing' stamp: 'sma 2/29/2000 20:39'!
arguments
	^ arguments! !

!MessageSend methodsFor: 'private' stamp: 'reThink 2/18/2001 17:33'!
collectArguments: anArgArray
	"Private"

    | staticArgs |
    staticArgs := self arguments.
    ^(anArgArray size = staticArgs size)
        ifTrue: [anArgArray]
        ifFalse:
            [(staticArgs isEmpty
                ifTrue: [ staticArgs := Array new: selector numArgs]
                ifFalse: [staticArgs copy] )
                    replaceFrom: 1
                    to: (anArgArray size min: staticArgs size)
                    with: anArgArray
                    startingAt: 1]! !

!MessageSend class methodsFor: 'instance creation' stamp: 'sma 2/29/2000 20:44'!
receiver: anObject selector: aSymbol
	^ self receiver: anObject selector: aSymbol arguments: #()! !

!MessageSend class methodsFor: 'instance creation' stamp: 'sma 2/29/2000 20:39'!
receiver: anObject selector: aSymbol arguments: anArray
	^ self new
		receiver: anObject;
		selector: aSymbol;
		arguments: anArray! !

!MessageSend class methodsFor: 'instance creation' stamp: 'sma 2/29/2000 20:44'!
receiver: anObject selector: aSymbol argument: aParameter
	^ self receiver: anObject selector: aSymbol arguments: (Array with: aParameter)! !

!MessageSendDebugAction commentStamp: '<historical>'!
A MessageSendDebugAction is an action that sends a message to a receiver with the right amount of arguments. 

To specify the receiver subclasses have to override the method #receiver. Furthermoe subclasses must specify an id. The selector is optional as the id will be used if no selector is present/


Instance Variables
	id:		<Object>
	selector:		<Object>

id
	- xxxxx

selector
	- xxxxx
!
!MessageSendDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/24/2013 18:01'!
id

	^ id! !

!MessageSendDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/24/2013 18:01'!
id: aSymbol
	
	id := aSymbol ! !

!MessageSendDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/24/2013 18:02'!
selector

	^ selector ifNil: [ self id ]! !

!MessageSendDebugAction methodsFor: 'actions' stamp: 'AndreiChis 9/24/2013 18:03'!
executeAction
	
	self receiver 
		perform: self selector
		withEnoughArguments: self arguments! !

!MessageSendDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/24/2013 18:03'!
arguments

	^ #()! !

!MessageSendDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/24/2013 18:04'!
receiver

	^ nil! !

!MessageSendDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/24/2013 18:02'!
selector: aSymbol

	selector := aSymbol! !

!MessageTally commentStamp: 'StephaneDucasse 9/27/2009 10:42'!
My instances observe and report the amount of time spent in methods.

NOTE: a higher-level user interface (combining the MessageTally result tree with a method browser) is available from TimeProfileBrowser. Note that TimeProfileBrowser was not fancy with the different setting possibilities.

	TimeProfileBrowser spyOn:  [20 timesRepeat: 
			[Transcript show: 100 factorial printString]]
	

Strategies
-----------
MessageTally provides two different strategies available for profiling:

* spyOn: and friends use a high-priority Process to interrupt the block or process being spied on at periodic intervals. The interrupted call stack is then examined for caller information. See below for an example showing different settings

* tallySends: and friends use the interpreter simulator to run the block, recording every method call.

The two give you different results:

	* spyOn: gives you a view of where the time is being spent in your program, at least on a rough statistical level (assuming you've run the 	block for long enough and have a high enough poll rate). If you're trying to optimize your code, start here and optimize the methods where 	most of the time is being spent first.

	* tallySends: gives you accurate counts of how many times methods get called, and by exactly which route. If you're debugging, or trying to 	figure out if a given method is getting called too many times, this is your tool.

Q: How do you interpret MessageTally>>tallySends
A: The methods #tallySends and #spyOn: measure two very different quantities, but broken down in the same who-called-who format.  #spyOn: is approximate, but more indicative of real time spent, whereas #tallySends is exact and a precise record of how many times each method got executed.

Examples
----------

Here you can see all the processes computation time
	
		[1000 timesRepeat: [3.14159 printString. Processor yield]] fork.
		[1000 timesRepeat: [30 factorial. Processor yield]] fork.
		[1000 timesRepeat: [30 factorial. Processor yield]] fork.
		MessageTally spyAllOn: [ (Delay forMilliseconds: 100) wait] 


Settings
---------
You can change the printing format (that is, the whitespace and string compression) by using these instance methods: 
	maxClassNameSize:
	maxClassPlusSelectorSize:
	maxTabs:

You can change the default polling period (initially set to 1) by calling
	MessageTally defaultPollPeriod: numberOfMilliseconds


To understand the difference
----------------------------------
Here we see all the processes
	[1000 timesRepeat: [
		100 timesRepeat: [120 factorial].
		(Delay forMilliseconds: 10) wait
		]] forkAt: 45 named: '45'.
	MessageTally spyAllOn: [10000 timesRepeat: [1.23 printString]]
	
	
Here we only see the execution of the expression [10000 timesRepeat: [1.23 printString]
	[1000 timesRepeat: [
		100 timesRepeat: [120 factorial].
		(Delay forMilliseconds: 10) wait
		]] forkAt: 45 named: '45'.
	MessageTally spyOn: [10000 timesRepeat: [1.23 printString]]
	
Here we only check the exact message sends: this is not a pc-sampling approach
	[1000 timesRepeat: [
		100 timesRepeat: [120 factorial].
		(Delay forMilliseconds: 10) wait
		]] forkAt: 45 named: '45'.
	MessageTally tallySends: [10000 timesRepeat: [1.23 printString]]
	


!
!MessageTally methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 1/18/2014 14:10'!
gtInspectorReportIn: composite
	<gtInspectorPresentationOrder: 60>
	^ composite text
		title: 'Report';
		display: [ String streamContents: [:s | self report: s ] ]! !

!MessageTally methodsFor: 'tallying' stamp: 'jmv 3/4/2009 10:37'!
tally: context in: aProcess by: count
	"Explicitly tally the specified context and its stack."
	| sender |

	"Add to this node if appropriate"
	context method == method ifTrue: [^self bumpBy: count].
	
	"No sender? Add new branch to the tree."
	(sender := context home sender) ifNil: [
		^ (self bumpBy: count) tallyPath: context in: aProcess by: count].
	
	"Find the node for the sending context (or add it if necessary)"
	^ (self tally: sender in: aProcess by: count) tallyPath: context in: aProcess by: count! !

!MessageTally methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 1/18/2014 14:05'!
children
	^ self sonsOver: 0! !

!MessageTally methodsFor: 'comparing' stamp: ''!
< aMessageTally 
	"Refer to the comment in Magnitude|<."

	^tally > aMessageTally tally! !

!MessageTally methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 1/18/2014 14:05'!
localTime
	^ self children
		inject: self time 
		into: [ :diff :each | diff - each time ]! !

!MessageTally methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 1/4/2014 22:56'!
gtInspectorSourceIn: composite
	<gtInspectorPresentationOrder: 50>
	^ self method ifNotNil: [
		self method gtInspectorSourceIn: composite]! !

!MessageTally methodsFor: 'initialization' stamp: 'Alexandre Bergel 3/15/2010 21:08'!
initialize
	"We do not do a super initialize since it is not strickly necessary and more importantly MessageTally must be instantiated quickly"
	"super initialize."
	
	maxClassNameSize := self class defaultMaxClassNameSize.
	maxClassPlusSelectorSize := self class defaultMaxClassPlusSelectorSize.
	maxTabs := self class defaultMaxTabs.
	reportOtherProcesses := true.
	time := 0.
	tally := 0.! !

!MessageTally methodsFor: 'private' stamp: ''!
class: aClass method: aMethod

	class := aClass.
	method := aMethod.
	tally := 0.
	receivers := Array new: 0! !

!MessageTally methodsFor: 'accessing' stamp: 'stp 05/08/1999 11:47'!
time
	"Answer the receiver's run time."

	^time! !

!MessageTally methodsFor: 'accessing' stamp: 'Alexandre Bergel 3/5/2010 17:19'!
theClass
	"Return the class of the object receiver related to this tally"
	
	 ^ class! !

!MessageTally methodsFor: 'printing' stamp: 'jmv 9/24/2009 15:49'!
fullPrintOn: aStream threshold: perCent
	| threshold |  
	threshold := (perCent asFloat / 100 * tally) rounded.
	aStream nextPutAll: '**Tree**'; cr.
	self
		rootPrintOn: aStream
		total: tally
		totalTime: time
		threshold: threshold.
	aStream nextPut: Character newPage; cr.
	aStream nextPutAll: '**Leaves**'; cr.
	self
		leavesPrintOn: aStream
		threshold: threshold! !

!MessageTally methodsFor: 'printing format' stamp: 'nk 3/8/2004 12:30'!
maxClassNameSize: aNumber
	maxClassNameSize := aNumber! !

!MessageTally methodsFor: 'tallying' stamp: ''!
bumpBy: count

	tally := tally + count! !

!MessageTally methodsFor: 'tallying' stamp: 'MarcusDenker 1/23/2011 09:15'!
tallyPath: context in: aProcess by: count
	| aMethod path |
	aMethod := context method.
	
	"Find the correct child (if there)"
	receivers do: [ :oldTally | 
		(oldTally method == aMethod and: [oldTally process == aProcess])
			ifTrue: [path := oldTally]].
		
	"Add new child if needed"
	path ifNil:[
		path := self class new class: context receiver class method: aMethod;
			process: aProcess;
			reportOtherProcesses: reportOtherProcesses;
			maxClassNameSize: maxClassNameSize;
			maxClassPlusSelectorSize: maxClassPlusSelectorSize;
			maxTabs: maxTabs.
		receivers := receivers copyWith: path].

	^ path bumpBy: count! !

!MessageTally methodsFor: 'accessing' stamp: 'Alexandre Bergel 3/4/2010 19:19'!
reportOtherProcesses
	^ reportOtherProcesses! !

!MessageTally methodsFor: 'printing format' stamp: 'nk 3/8/2004 12:29'!
maxClassNameSize
	^maxClassNameSize! !

!MessageTally methodsFor: 'collecting leaves' stamp: 'MarcusDenker 6/30/2014 13:29'!
leavesInto: leafDict fromSender: senderTally

	| rcvrs |
	rcvrs := self sonsOver: 0.
	rcvrs isEmpty
		ifTrue: [ self into: leafDict fromSender: senderTally ]
		ifFalse: [
			
			(reportOtherProcesses not and: [ rcvrs anyOne process isNil ]) ifTrue: [
				^self].
			
			rcvrs do: [ :node |
				node isPrimitives
					ifTrue: [ node leavesInto: leafDict fromSender: senderTally ]
					ifFalse: [ node leavesInto: leafDict fromSender: self ]]]! !

!MessageTally methodsFor: 'comparing' stamp: 'MarcusDenker 1/23/2011 09:14'!
isPrimitives
	"Detect pseudo node used to carry tally of local hits"
	^ receivers isNil! !

!MessageTally methodsFor: 'tallying' stamp: 'Alexandre Bergel 3/5/2010 17:37'!
tally: context by: count
	"Explicitly tally the specified context and its stack."
	| sender |
	
	"Add to this node if appropriate"
	context method == method ifTrue: [^self bumpBy: count].
	
	"No sender? Add new branch to the tree."
	(sender :=  context home sender) ifNil: [
		^ (self bumpBy: count) tallyPath: context by: count].
	
	"Find the node for the sending context (or add it if necessary)"
	^ (self tally: sender by: count) tallyPath: context by: count! !

!MessageTally methodsFor: 'printing' stamp: 'jmv 9/24/2009 15:47'!
leavesPrintExactOn: aStream
	| dict |
	dict := IdentityDictionary new: 100.
	self leavesInto: dict fromSender: nil.
	dict asSortedCollection
		do: [ :node |
			node printOn: aStream total: tally totalTime: nil tallyExact: true.
			node printSenderCountsOn: aStream ]! !

!MessageTally methodsFor: 'accessing' stamp: 'stp 05/08/1999 12:06'!
tally
	"Answer the receiver's number of tally."

	^tally! !

!MessageTally methodsFor: 'private' stamp: 'jmv 9/25/2009 08:48'!
close

	Timer ifNotNil: [ Timer terminate ].
	Timer := nil.
	class := method := tally := receivers := nil! !

!MessageTally methodsFor: 'printing format' stamp: 'nk 3/8/2004 12:29'!
maxClassPlusSelectorSize
	^maxClassPlusSelectorSize! !

!MessageTally methodsFor: 'collecting leaves' stamp: ''!
bump: hitCount
	tally := tally + hitCount! !

!MessageTally methodsFor: 'printing' stamp: 'jmv 9/24/2009 15:49'!
fullPrintExactOn: aStream
	aStream nextPutAll: '**Tree**'; cr.
	self
		treePrintOn: aStream
		tabs: OrderedCollection new
		thisTab: ''
		total: tally
		totalTime: time
		tallyExact: true
		orThreshold: nil.
	aStream nextPut: Character newPage; cr.
	aStream nextPutAll: '**Leaves**'; cr.
	self leavesPrintExactOn: aStream! !

!MessageTally methodsFor: 'private' stamp: 'MarcusDenker 1/23/2011 09:15'!
copyWithTally: hitCount
	^ (self class new class: class method: method)
		reportOtherProcesses: reportOtherProcesses;
		process: process;
		bump: hitCount! !

!MessageTally methodsFor: 'printing format' stamp: 'nk 3/8/2004 12:29'!
maxTabs
	^maxTabs! !

!MessageTally methodsFor: 'initialize-release' stamp: 'MarcusDenker 3/22/2013 12:57'!
spyAllEvery: millisecs on: aBlock
	"Create a spy and spy on the given block at the specified rate."
	"Spy all the system processes"

	| myDelay time0 |
	aBlock isBlock
		ifFalse: [ self error: 'spy needs a block here' ].
	self class: aBlock receiver class method: aBlock method.
		"set up the probe"
	myDelay := Delay forMilliseconds: millisecs.
	time0 := Time millisecondClockValue.
	gcStats := Smalltalk vm getParameters.
	Timer ifNotNil: [ self error: 'it seems a tally is already running' ].
	Timer := [
		[true] whileTrue: [
			| startTime observedProcess |
			startTime := Time millisecondClockValue.
			myDelay wait.
			observedProcess := Processor preemptedProcess.
			self
				tally: observedProcess suspendedContext
				in: observedProcess
				"tally can be > 1 if ran a long primitive"
				by: (Time millisecondClockValue - startTime) // millisecs].
		nil] newProcess.
	Timer priority: Processor timingPriority-1.
		"activate the probe and evaluate the block"
	Timer resume.
	^ aBlock ensure: [
		"cancel the probe and return the value"
		"Could have already been terminated. See #terminateTimerProcess"
		Timer ifNotNil: [
			Timer terminate.
			Timer := nil ].
		"Collect gc statistics"
		Smalltalk vm getParameters keysAndValuesDo: [ :idx :gcVal | 
			gcVal isNumber ifTrue: [ gcStats at: idx put: (gcVal - (gcStats at: idx))]].
		time := Time millisecondClockValue - time0]! !

!MessageTally methodsFor: 'comparing' stamp: 'MarcusDenker 6/30/2014 13:29'!
sonsOver: threshold
	"Returns all the sons that are not below a certain threshold. threshold is a number."
	| hereTally sons |
	(receivers isNil or: [ receivers isEmpty ]) ifTrue: [ ^#() ].
	hereTally := tally.
	sons := receivers select: [ :son | "subtract subNode tallies for primitive hits here"
		hereTally := hereTally - son tally.
		son tally > threshold ].
	hereTally > threshold
		ifTrue: [
			| last |
			last := self class new class: class method: method.
			last process: process.
			last reportOtherProcesses: reportOtherProcesses.
			^sons copyWith: (last primitives: hereTally)].
	^sons! !

!MessageTally methodsFor: 'printing' stamp: 'ClementBera 7/26/2013 16:52'!
printOn: aStream total: total totalTime: totalTime tallyExact: isExact 

	isExact 
		ifTrue: [
			| myTally |
			myTally := tally.
			receivers == nil 
				ifFalse: [receivers do: [:r | myTally := myTally - r tally]].
			aStream
				print: myTally;
				space]
		ifFalse: [
			| percentage |
			percentage := tally asFloat / total * 100.0.
			aStream
				nextPutAll: (percentage printShowingDecimalPlaces: 1);
				nextPutAll: '% {';
				print: (percentage * totalTime / 100) rounded;
				nextPutAll: 'ms} '].
	receivers 
		ifNil: [
			aStream
				nextPutAll: 'primitives';
				cr]
		ifNotNil: [
			| className aSelector aClass |
			aSelector := method selector.
			aClass := method methodClass.
			className := aClass name contractTo: self maxClassNameSize.
			aStream
				nextPutAll: class name;
				nextPutAll: (aClass = class 
							ifTrue: ['>>']
							ifFalse: ['(' , aClass name , ')>>']);
				nextPutAll: (aSelector 
							contractTo: self maxClassPlusSelectorSize - className size);
				cr]! !

!MessageTally methodsFor: 'printing' stamp: 'MarcusDenker 9/24/2013 14:12'!
treePrintOn: aStream tabs: tabs thisTab: myTab total: total totalTime: totalTime tallyExact: isExact orThreshold: threshold 
	| sons sonTab |
	tabs do: [:tab | aStream nextPutAll: tab].
	tabs size > 0 
		ifTrue: 
			[self 
				printOn: aStream
				total: total
				totalTime: totalTime
				tallyExact: isExact].
	sons := isExact ifTrue: [receivers] ifFalse: [self sonsOver: threshold].
	sons isEmpty 
		ifFalse: 
			[tabs addLast: myTab.
			sons := sons asSortedCollection.
			1 to: sons size do: 
					[:i | 
					sonTab := i < sons size ifTrue: ['  |'] ifFalse: ['  '].
					(sons at: i) 
						treePrintOn: aStream
						tabs: (tabs size < self maxTabs 
								ifTrue: [tabs]
								ifFalse: [(tabs select: [:x | x = '[']) copyWith: '['])
						thisTab: sonTab
						total: total
						totalTime: totalTime
						tallyExact: isExact
						orThreshold: threshold].
			tabs removeLast]! !

!MessageTally methodsFor: 'printing' stamp: 'MarcusDenker 6/30/2014 13:25'!
printOn: aStream 
	| aSelector className |
	(class isNil or: [method isNil]) ifTrue: [^super printOn: aStream].
	aSelector := method selector.
	className := method methodClass name.
	aStream
		nextPutAll: (class name contractTo: self maxClassNameSize);
		nextPutAll: '(';
		nextPutAll: (className  contractTo: self maxClassNameSize);
		nextPutAll: ')';
		nextPutAll: ' >> ';
		nextPutAll: (aSelector 
					contractTo: self maxClassPlusSelectorSize - className size)! !

!MessageTally methodsFor: 'collecting leaves' stamp: 'MarcusDenker 1/23/2011 09:13'!
bump: hitCount fromSender: senderTally
	"Add this hitCount to the total, and include a reference to the
	sender responsible for the increment"
	self bump: hitCount.
	senders ifNil: [senders := OrderedCollection new].
	senderTally ifNotNil: [senders add: (senderTally copyWithTally: hitCount)]! !

!MessageTally methodsFor: 'reporting' stamp: 'jmv 9/24/2009 15:35'!
report: strm cutoff: threshold 
	tally = 0
		ifTrue: [strm nextPutAll: ' - no tallies obtained']
		ifFalse: 
			[strm nextPutAll: ' - '; print: tally; nextPutAll: ' tallies, ', time printString, ' msec.'; cr; cr.
			self fullPrintOn: strm threshold: threshold].
		
	time isZero ifFalse:	
		[self reportGCStatsOn: strm].! !

!MessageTally methodsFor: 'accessing' stamp: 'ar 3/3/2009 19:29'!
process: aProcess
	process := aProcess! !

!MessageTally methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 1/18/2014 14:05'!
localTally
	^ self children 
		inject: self tally
		into: [ :diff :each | diff - each tally ]! !

!MessageTally methodsFor: 'reporting' stamp: 'jmv 3/4/2009 09:27'!
report: strm 
	"Print a report, with cutoff percentage of each element of the tree 
	(leaves, roots, tree), on the stream, strm."

	self report: strm cutoff: 1! !

!MessageTally methodsFor: 'reporting' stamp: 'CamilloBruni 10/21/2012 15:08'!
reportGCStatsOn: str
	| oldSpaceEnd youngSpaceEnd memoryEnd fullGCs fullGCTime incrGCs incrGCTime tenureCount upTime rootOverflows |
	upTime := time.
	oldSpaceEnd			:= gcStats at: 1.
	youngSpaceEnd		:= gcStats at: 2.
	memoryEnd			:= gcStats at: 3.
	fullGCs				:= gcStats at: 7.
	fullGCTime			:= gcStats at: 8.
	incrGCs				:= gcStats at: 9.
	incrGCTime			:= gcStats at: 10.
	tenureCount			:= gcStats at: 11.
	rootOverflows		:= gcStats at: 22.

	str cr.
	str	nextPutAll: '**Memory**'; cr.
	str	nextPutAll:	'	old			'.
	oldSpaceEnd printWithCommasSignedOn: str. 
	str nextPutAll: ' bytes'; cr.
	str	nextPutAll: '	young		'.
	(youngSpaceEnd - oldSpaceEnd) printWithCommasSignedOn: str. 
	str  nextPutAll: ' bytes'; cr.
	str	nextPutAll: '	used		'.
	youngSpaceEnd printWithCommasSignedOn: str. 
	str  nextPutAll: ' bytes'; cr.
	str	nextPutAll: '	free		'.
	(memoryEnd - youngSpaceEnd) printWithCommasSignedOn: str. 
	str  nextPutAll: ' bytes'; cr.

	str cr.
	str	nextPutAll: '**GCs**'; cr.
	str	nextPutAll: '	full			';
		print: fullGCs; nextPutAll: ' totalling '.
	fullGCTime printWithCommasOn: str.
	str nextPutAll: 'ms (';
		print: ((fullGCTime / upTime * 100) roundTo: 1.0);
		nextPutAll: '% uptime)'.
	fullGCs = 0 ifFalse:
		[str	nextPutAll: ', avg '; print: ((fullGCTime / fullGCs) roundTo: 1.0); nextPutAll: 'ms'].
	str	cr.
	str	nextPutAll: '	incr		';
		print: incrGCs; nextPutAll: ' totalling '.
	incrGCTime printWithCommasOn: str.
	str nextPutAll: 'ms (';
		print: ((incrGCTime / upTime * 100) roundTo: 1.0);
		nextPutAll: '% uptime)'.
	incrGCs = 0 ifFalse:
		[str nextPutAll:', avg '; print: ((incrGCTime / incrGCs) roundTo: 1.0); nextPutAll: 'ms'].
	str cr.
	str	nextPutAll: '	tenures		'.
	tenureCount printWithCommasOn: str.
	tenureCount = 0 ifFalse:
		[str nextPutAll: ' (avg '; print: (incrGCs / tenureCount) asInteger; nextPutAll: ' GCs/tenure)'].
	str	cr.
	str	nextPutAll: '	root table	'.
	rootOverflows printWithCommasOn: str.
	str nextPutAll:' overflows'.
	str cr.
! !

!MessageTally methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 1/18/2014 22:28'!
gtDisplayIdentifierOn: aStream
	class gtDisplayOn: aStream.
	self method methodClass ~~ class 
		ifTrue: [ aStream nextPut: $(; print: self method methodClass; nextPut: $) ].
	aStream 
		nextPutAll: '>>';
		store: self method selector! !

!MessageTally methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 1/18/2014 22:29'!
gtDisplayOn: aStream
	self gtDisplayIdentifierOn: aStream.
	aStream 
		nextPutAll: ' (';
		nextPutAll: self tally printString;
		nextPutAll: ')'! !

!MessageTally methodsFor: 'comparing' stamp: 'jmv 8/20/2009 08:20'!
hash
	"Hash is reimplemented because = is implemented."

	^method hash! !

!MessageTally methodsFor: 'comparing' stamp: ''!
> aMessageTally 
	"Refer to the comment in Magnitude|>."

	^tally < aMessageTally tally! !

!MessageTally methodsFor: 'initialize-release' stamp: 'MarcusDenker 2/23/2013 10:15'!
spyEvery: millisecs on: aBlock
	"Create a spy and spy on the given block at the specified rate."
	"Spy only on the active process (in which aBlock is run)"

	| myDelay time0 observedProcess |
	aBlock isBlock
		ifFalse: [ self error: 'spy needs a block here' ].
	self class: aBlock receiver class method: aBlock method.
		"set up the probe"
	observedProcess := Processor activeProcess.
	myDelay := Delay forMilliseconds: millisecs.
	time0 := Time millisecondClockValue.
	gcStats := Smalltalk vm getParameters.
	Timer ifNotNil: [ self error: 'it seems a tally is already running' ].
	Timer := [
		[ true ] whileTrue: [
			| startTime |
			startTime := Time millisecondClockValue.
			myDelay wait.
			self
				tally: Processor preemptedProcess suspendedContext
				in: (observedProcess == Processor preemptedProcess ifTrue: [observedProcess] ifFalse: [nil])
				"tally can be > 1 if ran a long primitive"
				by: (Time millisecondClockValue - startTime) // millisecs].
		nil] newProcess.
	Timer priority: Processor timingPriority-1.
		"activate the probe and evaluate the block"
	Timer resume.
	^ aBlock ensure: [
		"cancel the probe and return the value"
		"Could have already been terminated. See #terminateTimerProcess"
		Timer ifNotNil: [
			Timer terminate.
			Timer := nil ].
		"Collect gc statistics"
		Smalltalk vm getParameters keysAndValuesDo: [ :idx :gcVal | 
			gcVal isNumber ifTrue: [ gcStats at: idx put: (gcVal - (gcStats at: idx))]].
		time := Time millisecondClockValue - time0]! !

!MessageTally methodsFor: 'accessing' stamp: 'Alexandre Bergel 3/5/2010 17:18'!
method
	"Return the compiled method associated to this tally"
	
	^method! !

!MessageTally methodsFor: 'initialize-release' stamp: 'MarcusDenker 3/22/2013 12:57'!
spyEvery: millisecs onProcess: aProcess forMilliseconds: msecDuration
	"Create a spy and spy on the given process at the specified rate."
	| myDelay time0 endTime observedProcess sem |
	(aProcess isKindOf: Process)
		ifFalse: [self error: 'spy needs a Process here'].
	self class: aProcess suspendedContext receiver class method: aProcess suspendedContext method.
	"set up the probe"
	observedProcess := aProcess.
	myDelay := Delay forMilliseconds: millisecs.
	time0 := Time millisecondClockValue.
	endTime := time0 + msecDuration.
	sem := Semaphore new.
	gcStats := Smalltalk vm getParameters.
	Timer ifNotNil: [ self error: 'it seems a tally is already running' ].
	Timer := [
			[
				| startTime |
				startTime := Time millisecondClockValue.
				myDelay wait.
				self
					tally: Processor preemptedProcess suspendedContext
					in: (observedProcess == Processor preemptedProcess ifTrue: [ observedProcess ] ifFalse: [nil])
					"tally can be > 1 if ran a long primitive"
					by: (Time millisecondClockValue - startTime) // millisecs.
				startTime < endTime
			] whileTrue.
			sem signal.
		] newProcess.
	Timer priority: Processor timingPriority-1.
		"activate the probe and evaluate the block"
	Timer resume.
	"activate the probe and wait for it to finish"
	sem wait.
	"Collect gc statistics"
	Smalltalk vm getParameters keysAndValuesDo: [ :idx :gcVal | 
		gcVal isNumber ifTrue: [ gcStats at: idx put: (gcVal - (gcStats at: idx)) ] ].
	time := Time millisecondClockValue - time0! !

!MessageTally methodsFor: 'comparing' stamp: 'Alexandre Bergel 3/5/2010 17:17'!
= aMessageTally

	self species == aMessageTally species ifFalse: [^ false].
	^ aMessageTally method == method 
		and: [ aMessageTally process == process ]! !

!MessageTally methodsFor: 'private' stamp: ''!
primitives: anInteger

	tally := anInteger.
	receivers := nil! !

!MessageTally methodsFor: 'collecting leaves' stamp: 'MarcusDenker 1/23/2011 09:15'!
into: leafDict fromSender: senderTally 
	| leafNode |
	leafNode := leafDict at: method
				ifAbsentPut: 
					[ (self class new class: class method: method)
						process: process;
						reportOtherProcesses: reportOtherProcesses ].
					
	leafNode bump: tally fromSender: senderTally! !

!MessageTally methodsFor: 'printing' stamp: 'jmv 2/6/2010 10:09'!
printSenderCountsOn: aStream
	| mergedSenders |
	mergedSenders := IdentityDictionary new.
	senders do: [ :node | | mergedNode |
		mergedNode := mergedSenders at: node method ifAbsent: [ nil ].
		mergedNode
			ifNil: [ mergedSenders at: node method put: node ]
			ifNotNil: [ mergedNode bump: node tally ]].
	mergedSenders asSortedCollection do: [ :node | 
		10 to: node tally printString size by: -1 do: [ :i | aStream space].
		node printOn: aStream total: tally totalTime: nil tallyExact: true]! !

!MessageTally methodsFor: 'printing format' stamp: 'nk 3/8/2004 12:30'!
maxClassPlusSelectorSize: aNumber
	maxClassPlusSelectorSize := aNumber! !

!MessageTally methodsFor: 'accessing' stamp: 'jmv 9/24/2009 16:02'!
reportOtherProcesses: aBoolean
	reportOtherProcesses := aBoolean! !

!MessageTally methodsFor: 'accessing' stamp: 'Alexandre Bergel 3/15/2010 21:02'!
receivers 
	^ receivers ! !

!MessageTally methodsFor: 'tallying' stamp: 'MarcusDenker 1/23/2011 09:15'!
tallyPath: context by: count
	| aMethod path |
	aMethod := context method.
	
	"Find the correct child (if there)"
	receivers do: [ :oldTally | 
		oldTally method == aMethod ifTrue: [path := oldTally]].
	
	"Add new child if needed"
	path ifNil: [
		path := self class new class: context receiver class method: aMethod.
		path reportOtherProcesses: reportOtherProcesses.
		receivers := receivers copyWith: path].
	
	^ path bumpBy: count! !

!MessageTally methodsFor: 'printing' stamp: 'jmv 9/24/2009 15:48'!
leavesPrintOn: aStream threshold: threshold
	| dict |
	dict := IdentityDictionary new: 100.
	self leavesInto: dict fromSender: nil.
	(dict asOrderedCollection
			select: [:node | node tally > threshold])
		asSortedCollection do: [:node |
			node printOn: aStream total: tally totalTime: time tallyExact: false ]! !

!MessageTally methodsFor: 'printing' stamp: 'jmv 2/6/2010 10:19'!
rootPrintOn: aStream total: total totalTime: totalTime threshold: threshold

	| groups |
	groups := (self sonsOver: threshold) groupBy: [ :aTally | aTally process] having: [ :g | true ].
	groups do: [ :g |
		| sons p |
		sons := g asArray sort.
		p := g anyOne process.
		(reportOtherProcesses or: [ p notNil ]) ifTrue: [
			aStream nextPutAll: '--------------------------------'; cr.
			aStream nextPutAll: 'Process: ',  (p ifNil: [ 'other processes'] ifNotNil: [ p browserPrintString]); cr.
			aStream nextPutAll: '--------------------------------'; cr.
			sons do: [ :son |
				son
					treePrintOn: aStream
					tabs: OrderedCollection new
					thisTab: ''
					total: total
					totalTime: totalTime
					tallyExact: false
					orThreshold: threshold]].
	]! !

!MessageTally methodsFor: 'accessing' stamp: 'Alexandre Bergel 3/5/2010 17:19'!
process
	"Return the profiled process"
	
	^process! !

!MessageTally methodsFor: 'printing format' stamp: 'nk 3/8/2004 12:30'!
maxTabs: aNumber
	maxTabs := aNumber! !

!MessageTally class methodsFor: 'spying' stamp: 'Alexandre Bergel 3/16/2010 15:23'!
spyOn: aBlock reportOtherProcesses: aBoolean
	"
	Spy on aBlock, in the current process. Can include or not statistics on other processes in the report.
	[1000 timesRepeat: [
		100 timesRepeat: [120 factorial].
		(Delay forMilliseconds: 10) wait
		]] forkAt: 45 named: '45'.
	MessageTally spyOn: [10000 timesRepeat: [1.23 printString]] reportOtherProcesses: true
	"
	^ self spyOn: aBlock reportOtherProcesses: aBoolean cutoff: 1! !

!MessageTally class methodsFor: 'spying' stamp: 'Alexandre Bergel 3/16/2010 15:23'!
spyAllOn: aBlock
	"Spy on all the processes in the system
	
	[1000 timesRepeat: [3.14159 printString. Processor yield]] fork.
	[1000 timesRepeat: [20 factorial. Processor yield]] fork.
	[1000 timesRepeat: [20 factorial. Processor yield]] fork.
	MessageTally spyAllOn: [ (Delay forMilliseconds: 100) wait]
	
	"
	^ self spyAllOn: aBlock cutoff: 1! !

!MessageTally class methodsFor: 'spying' stamp: ''!
time: aBlock

	^ Time millisecondsToRun: aBlock! !

!MessageTally class methodsFor: 'spying' stamp: 'Alexandre Bergel 3/16/2010 15:24'!
spyOn: aBlock reportOtherProcesses: aBoolean cutoff: aNumber
	"
	Spy on aBlock, in the current process. Can include or not statistics on other processes in the report.
	[1000 timesRepeat: [
		100 timesRepeat: [120 factorial].
		(Delay forMilliseconds: 10) wait
		]] forkAt: 45 named: '45'.
	MessageTally spyOn: [10000 timesRepeat: [1.23 printString]] reportOtherProcesses: true
	"
	^ self 
		spyOn: aBlock 
		reportOtherProcesses: aBoolean 
		cutoff: aNumber 
		openResultWindow: true 
		closeAfter: true! !

!MessageTally class methodsFor: 'spying' stamp: 'ChristopheDemarey 9/26/2014 13:58'!
tallySendsTo: receiver inBlock: aBlock showTree: treeOption closeAfter: closeAfter openResultWindow: openResultWindow
	"
	MessageTally tallySends: [3.14159 printString]
	"
	"This method uses the simulator to count the number of calls on each method
	invoked in evaluating aBlock. If receiver is not nil, then only sends
	to that receiver are tallied.
	Results are presented as leaves, sorted by frequency,
	preceded, optionally, by the whole tree."
	| prev tallies startTime totalTime |
	startTime := Time millisecondClockValue.
	tallies := self new class: aBlock receiver class method: aBlock method.
	tallies reportOtherProcesses: true.	"Do NOT filter nodes with nil process"
	prev := aBlock.
	thisContext sender
		runSimulated: aBlock
		contextAtEachStep:
			[:current |
			current == prev ifFalse: 
				["call or return"
				prev sender ifNotNil: 
					["call only"
					(receiver isNil or: [current receiver == receiver])
						ifTrue: [tallies tally: current by: 1]].
				prev := current]].

	totalTime := Time millisecondClockValue - startTime // 1000.0 roundTo: 0.01.
	openResultWindow ifTrue: [
		StandardWindow new 
			withText: (String streamContents:
				[:s |
				s nextPutAll: 'This simulation took ' , totalTime printString
								, ' seconds.'; cr.
				treeOption
					ifTrue: [ tallies fullPrintExactOn: s ]
					ifFalse: [ tallies leavesPrintExactOn: s ].
				])
			 label: 'Spy Results';
			openInWorld ].
	closeAfter ifTrue: [ tallies close ].
	^ tallies! !

!MessageTally class methodsFor: 'spying' stamp: 'Alexandre Bergel 3/16/2010 15:21'!
spyOnProcess: aProcess forMilliseconds: msecDuration 

	^self spyOnProcess: aProcess forMilliseconds: msecDuration reportOtherProcesses: false
! !

!MessageTally class methodsFor: 'defaults' stamp: 'StephaneDucasse 11/11/2010 22:29'!
defaultMaxClassPlusSelectorSize
	"Return the default maximum width of the class plus selector together (not counting the '>>')"
	^100! !

!MessageTally class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 5/26/2014 07:57'!
on: aBlock
	"This utility method constructs a tally object and returns it without
	triggering the construction of the default report"
	^ MessageTally new
		spyEvery: 1
		on: aBlock;
		yourself ! !

!MessageTally class methodsFor: 'private' stamp: 'jmv 2/19/2010 14:43'!
terminateTimerProcess

	Timer ifNotNil: [ Timer terminate ].
	Timer := nil! !

!MessageTally class methodsFor: 'spying' stamp: 'Alexandre Bergel 3/16/2010 15:20'!
spyOn: aBlock cutoff: aNumber

	^self spyOn: aBlock reportOtherProcesses: false cutoff: aNumber! !

!MessageTally class methodsFor: 'spying' stamp: 'ChristopheDemarey 9/26/2014 13:57'!
spyOn: aBlock reportOtherProcesses: aBoolean cutoff: aNumber openResultWindow: openResultWindow closeAfter: closeAfter
	| node |
	node := self new.
	node reportOtherProcesses: aBoolean.
	node spyEvery: self defaultPollPeriod on: aBlock.
	openResultWindow
		ifTrue: [ 
			StandardWindow new
				withText: (String streamContents: [ :s | node report: s cutoff: aNumber ]) label: 'Spy Results';
				openInWorld ].
	closeAfter
		ifTrue: [ node close ].
	^ node! !

!MessageTally class methodsFor: 'spying' stamp: 'jmv 9/24/2009 15:59'!
spyOn: aBlock
	"
	Spy on aBlock, in the current process. Can include or not statistics on other processes in the report.
	[1000 timesRepeat: [
		100 timesRepeat: [120 factorial].
		(Delay forMilliseconds: 10) wait
		]] forkAt: 45 named: '45'.
	MessageTally spyOn: [10000 timesRepeat: [1.23 printString]]
	"
	^self spyOn: aBlock reportOtherProcesses: false! !

!MessageTally class methodsFor: 'public' stamp: 'jmv 9/24/2009 16:02'!
spyOn: aBlock toFileNamed: fileName reportOtherProcesses: aBoolean
	"Spy on the evaluation of aBlock. Write the data collected on a file
	named fileName."

	| file value node |
	node := self new.
	node reportOtherProcesses: aBoolean.
	value := node spyEvery: self defaultPollPeriod on: aBlock.
	file := FileStream newFileNamed: fileName.
	node report: file; close.
	file close.
	^value! !

!MessageTally class methodsFor: 'public' stamp: 'Alexandre Bergel 3/5/2010 17:41'!
tallySends: aBlock
	"
	MessageTally tallySends: [3.14159 printString]
	"
	
	"This method uses the simulator to count the number of calls on each method
	invoked in evaluating aBlock. If receiver is not nil, then only sends
	to that receiver are tallied.
	Results are presented as leaves, sorted by frequency,
	preceded, optionally, by the whole tree."

	^ self tallySendsTo: nil inBlock: aBlock showTree: true! !

!MessageTally class methodsFor: 'defaults' stamp: 'nk 3/8/2004 12:41'!
defaultPollPeriod
	"Answer the number of milliseconds between interrupts for spyOn: and friends.
	This should be faster for faster machines."
	^DefaultPollPeriod ifNil: [ DefaultPollPeriod := 1 ]! !

!MessageTally class methodsFor: 'defaults' stamp: 'jmv 3/2/2009 12:32'!
defaultMaxTabs
	"Return the default number of tabs after which leading white space is compressed"
	^120! !

!MessageTally class methodsFor: 'spying' stamp: 'ChristopheDemarey 9/26/2014 13:58'!
spyOnProcess: aProcess forMilliseconds: msecDuration reportOtherProcesses: aBoolean
	"
	Spy on aProcess for a certain amount of time
	| p1 p2 |  
	p1 := [100000 timesRepeat: [3.14159 printString. Processor yield]] newProcess.  
	p2 := [100000 timesRepeat: [3.14159 printString. Processor yield]] newProcess.
	p1 resume.
	p2 resume.  
	(Delay forMilliseconds: 100) wait.  
	MessageTally spyOnProcess: p1 forMilliseconds: 1000 reportOtherProcesses: true
	"
	| node |
	node := self new.
	node reportOtherProcesses: aBoolean.
	node
		spyEvery: self defaultPollPeriod
		onProcess: aProcess
		forMilliseconds: msecDuration.
	StandardWindow new
		withText:  (String streamContents: [:s | node report: s])
		 label: 'Spy Results';
		openInWorld.! !

!MessageTally class methodsFor: 'spying' stamp: 'Alexandre Bergel 3/16/2010 15:21'!
spyOn: aBlock reportOtherProcesses: aBoolean cutoff: aNumber openResultWindow: openResultWindow

	^ self 
		spyOn: aBlock 
		reportOtherProcesses: aBoolean 
		cutoff: aNumber 
		openResultWindow: openResultWindow 
		closeAfter: true! !

!MessageTally class methodsFor: 'spying' stamp: 'jmv 2/19/2010 14:41'!
spyOnProcess: aProcess forMilliseconds: msecDuration toFileNamed: fileName reportOtherProcesses: aBoolean
	"Spy on the evaluation of aProcess. Write the data collected on a file  
	named fileName. Will overwrite fileName"
	| file node |
	node := self new.
	node reportOtherProcesses: aBoolean.
	node
		spyEvery: self defaultPollPeriod
		onProcess: aProcess
		forMilliseconds: msecDuration.
	file := FileStream fileNamed: fileName.
	node report: file.
	file close! !

!MessageTally class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 3/26/2015 00:11'!
gtExampleSimplePrintString
	<gtExample: 'Simple printString'>
	^ MessageTally new 
		spyEvery: 1 on: [10 timesRepeat: [1.23 printString]];
		yourself! !

!MessageTally class methodsFor: 'defaults' stamp: 'StephaneDucasse 11/11/2010 22:29'!
defaultMaxClassNameSize
	"Return the default maximum width of the class name alone"
	^50! !

!MessageTally class methodsFor: 'spying' stamp: 'Alexandre Bergel 3/4/2010 18:47'!
tallySendsTo: receiver inBlock: aBlock showTree: treeOption
	^ self tallySendsTo: receiver inBlock: aBlock showTree: treeOption closeAfter: true! !

!MessageTally class methodsFor: 'defaults' stamp: 'nk 3/8/2004 12:41'!
defaultPollPeriod: numberOfMilliseconds
	"Set the default number of milliseconds between interrupts for spyOn: and friends.
	This should be faster for faster machines."
	DefaultPollPeriod := numberOfMilliseconds! !

!MessageTally class methodsFor: 'spying' stamp: 'Alexandre Bergel 3/5/2010 17:41'!
tallySendsTo: receiver inBlock: aBlock showTree: treeOption closeAfter: closeAfter
	^ self tallySendsTo: receiver inBlock: aBlock showTree: treeOption closeAfter: closeAfter openResultWindow: true! !

!MessageTally class methodsFor: 'spying' stamp: 'ChristopheDemarey 9/26/2014 13:58'!
spyAllOn: aBlock cutoff: aNumber
	| node result |
	node := self new.
	node reportOtherProcesses: true.	"Irrelevant in this case. All processes will be reported on their own."
	result := node spyAllEvery: self defaultPollPeriod on: aBlock.
	StandardWindow new
		withText:
				(String streamContents: [ :s |  node report: s cutoff: aNumber; close ])
			label: 'Spy Results';
		openInWorld.
	^ result! !

!MessageTallyTest commentStamp: 'TorstenBergmann 2/4/2014 20:46'!
SUnit tests for MessageTally!
!MessageTallyTest methodsFor: 'tallying' stamp: 'Alexandre Bergel 3/5/2010 17:29'!
testTallyShouldNotContainsAReturn

	"The block passed to MessageTally should not have a ^ "
	
	self should: [ MessageTally
					tallySendsTo: nil 
					inBlock:  [ ^ 3.14159 printString ] 
					showTree: true 
					closeAfter: false 
					openResultWindow: false ] raise: Error.
	! !

!MessageTallyTest methodsFor: 'tallying' stamp: 'MarcusDenker 12/8/2011 15:34'!
testTallySends
	"
	self debug: #testTallySends
	"
	
	| tally thisMethod activeProcess allProcesses numberOfProcesses processUsedByTally tallyForPrintString tallyForPrintStringBase tallyForSmallIntegerStar |
	allProcesses := Process allInstances.
	numberOfProcesses := allProcesses size.

	tally := MessageTally 
				tallySendsTo: nil 
				inBlock:  [ 3.14159 printString ] 
				showTree: true 
				closeAfter: false 
				openResultWindow: false.
	
	"tally is for this test method"
	thisMethod := self class >> #testTallySends.
	self assert: (tally hash = thisMethod hash).
	self assert: (tally method == thisMethod).
	self assert: (tally theClass == self class).


	processUsedByTally := tally process.
	self deny: (allProcesses includes: processUsedByTally).

	"Below is specialized for the execution ' 3.14159 printString '. Any method change in the execution flow of printString will turn this test to yellow"
	self assert: (tally tally >= 50).
	"The tally is not close, therefore the tree may be crawled over"
	self assert: (tally receivers isArray).
	self assert: (tally receivers size = 2).
	
	"--------"
	tallyForPrintString := tally receivers second.
	"Since 3.14159 is a float"
	self assert: (tallyForPrintString theClass == Float).
	"the executed method is Number>>printString"
	self assert: (tallyForPrintString method == ( Number>>#printString)).
	self assert: (tallyForPrintString tally >= 50).

	"--------"
	tallyForPrintStringBase := tallyForPrintString receivers first.
	"The receiver is still a Float"
	self assert: (tallyForPrintString theClass == Float).
	"the executed method is Number>>printStringBase: this time"
	self assert: (tallyForPrintStringBase method == ( Number>>#printStringBase:)).
	self assert: (tallyForPrintStringBase tally >= 50).
	
	"The method printStringBase: calls two methods:
	   SequenceableCollection class >> streamContents: and Float >> printOn:base:"
	
	self assert: (tallyForPrintStringBase receivers size = 2).
	
	"streamContents: is been tallied 13 times and printOn:base: 59 times"
	self assert: (tallyForPrintStringBase receivers size = 2).	
	self assert: (tallyForPrintStringBase receivers first tally) = 13.	
	self assert: (tallyForPrintStringBase receivers second tally) >= 50.	

	"We close to explicitely release reference of the process, the class and methods"
	tally close.
	
	
! !

!MessageTallyTest methodsFor: 'basic' stamp: 'Alexandre Bergel 3/4/2010 18:44'!
testInstantiation

	| messageTally |
	messageTally := MessageTally new.
	self assert: (messageTally time = 0).
	self assert: (messageTally tally = 0)! !

!MessageTallyTest methodsFor: 'sampling' stamp: 'Alexandre Bergel 3/15/2010 21:03'!
testSampling1

	| tally |
	tally := MessageTally
				spyOn: [ 1000  timesRepeat: [ 3.14159 printString  ] ]  
				reportOtherProcesses: false 
				cutoff: 1 
				openResultWindow: false
				closeAfter: false.

	"No process is accessible from the tally, the reason is that using the sampling method execute the block in the current process"
	self assert: (tally process isNil).

! !

!MessageTallyTest methodsFor: 'tallying' stamp: 'Alexandre Bergel 3/5/2010 17:53'!
testClosedTally

	| tally |
	tally := MessageTally
				tallySendsTo: nil 
				inBlock:  [ 3.14159 printString ] 
				showTree: true 
				closeAfter: true 
				openResultWindow: false.
				
	"The tally is closed, therefore nothing may be accessed"
	self assert: (tally receivers isNil)! !

!MetaLink commentStamp: 'MarcusDenker 3/1/2015 18:09'!
Metalinks are used to annotate other AST nodes. An annotated AST is expanded, compiled and executed on the fly thanks to the ReflectiveMethod/CompiledMethod Twin. 

For a given node metalinks can be put at different positions:

- before: The metalink is executed before the execution of the node.  
- instead: The metalink is executed insted the node.
- after: The metalink is executed after the execution of the node.
(... later: onError,  Do we have an #around instead of #instead?)

Not all the nodes provide all the position. For example, literals don't provide onError and onSuccess positions.

metaObject: The target object to call
selector: send this selector
arguments

condition:  turn link on/off 
level: Meta Level at which the link is active
------ Examples -----

MetaLink new 
	metaObject: Halt;
	selector: #now.
	
MetaObject new 
	metaObject: [ self halt ];
	selector: #value.!
!MetaLink methodsFor: 'link api' stamp: 'MarcusDenker 3/1/2015 17:59'!
metaObject: anObject
	metaObject := anObject .
	! !

!MetaLink methodsFor: 'accessing' stamp: 'MarcusDenker 3/1/2015 17:57'!
selector
	^selector
	! !

!MetaLink methodsFor: 'link api' stamp: 'MarcusDenker 3/1/2015 18:13'!
condition: aCondition
	condition:= aCondition

	
! !

!MetaLink methodsFor: 'link api' stamp: 'MarcusDenker 3/1/2015 18:06'!
control: aRFLinkControl
	control:= aRFLinkControl! !

!MetaLink methodsFor: 'accessing' stamp: 'MarcusDenker 3/1/2015 17:56'!
control
	^control
	! !

!MetaLink methodsFor: 'ast' stamp: 'MarcusDenker 3/1/2015 17:58'!
asLiteralNode
	^(RBLiteralNode value: self) ! !

!MetaLink methodsFor: 'ast' stamp: 'MarcusDenker 3/8/2015 09:02'!
metaAwareHook
	^RBMessageNode 
		receiver: self asLiteralNode
		selector: #valueInContext:
		arguments: {self encloseInBlock: self hook}
				

	! !

!MetaLink methodsFor: 'installing' stamp: 'MarcusDenker 3/1/2015 18:00'!
installOn: aNode 
	nodes add: aNode! !

!MetaLink methodsFor: 'ast' stamp: 'MarcusDenker 3/21/2015 15:21'!
hook
	| hook arg |
	hook := RBMessageNode receiver: (RBLiteralNode value: metaObject) selector: self selector arguments: (self arguments collect: #asLiteralNode).
	self hasCondition
		ifTrue: [ 
			arg := (RBBlockNode body: hook asSequenceNode).
			hook := RBMessageNode
				receiver: (RBMessageNode receiver: self condition sourceNode selector: #value)
				selector: #ifTrue:
				arguments: {arg} ].
	^ hook! !

!MetaLink methodsFor: 'accessing' stamp: 'MarcusDenker 7/3/2014 17:24'!
metaObject
	^ metaObject! !

!MetaLink methodsFor: 'accessing' stamp: 'MarcusDenker 3/1/2015 18:02'!
level
	^ level! !

!MetaLink methodsFor: 'link api' stamp: 'MarcusDenker 3/1/2015 17:59'!
selector: aSymbol
	selector := aSymbol! !

!MetaLink methodsFor: 'link api' stamp: 'MarcusDenker 3/1/2015 17:58'!
arguments: args
	arguments:= args! !

!MetaLink methodsFor: 'meta eval' stamp: 'MarcusDenker 3/11/2015 08:48'!
valueInContext: aBlock
	(RFMetaContext current isActive: self level) ifTrue: [
	RFMetaContext current shiftLevelUp.
	^aBlock ctxtEnsure: [RFMetaContext current shiftLevelDown] ]! !

!MetaLink methodsFor: 'initialization' stamp: 'MarcusDenker 3/1/2015 18:18'!
initialize
	nodes := IdentitySet new.
	control := #before.
	selector := #value.
	arguments := #().! !

!MetaLink methodsFor: 'link api' stamp: 'MarcusDenker 3/1/2015 18:02'!
level: anObject
	level := anObject! !

!MetaLink methodsFor: 'accessing' stamp: 'MarcusDenker 3/1/2015 17:55'!
condition
	^condition! !

!MetaLink methodsFor: 'accessing' stamp: 'MarcusDenker 3/6/2015 16:53'!
arguments
	^arguments! !

!MetaLink methodsFor: 'installing' stamp: 'MarcusDenker 3/1/2015 18:01'!
uninstall
	nodes do: [:node | node removeLink: self].
	nodes removeAll.! !

!MetaLink methodsFor: 'ast' stamp: 'MarcusDenker 3/8/2015 09:04'!
encloseInBlock: nodeOrCollection
	"Creates a new block node from a node or a list of nodes"
	| body |
	body := nodeOrCollection isCollection
		ifTrue: [ RBSequenceNode statements: nodeOrCollection ]
		ifFalse:[
			nodeOrCollection isSequence
				ifTrue: [ nodeOrCollection ]
				ifFalse: [ RBSequenceNode statements: {nodeOrCollection} ] ].
	^ RBBlockNode body: body ! !

!MetaLink methodsFor: 'testing' stamp: 'MarcusDenker 3/1/2015 18:03'!
hasCondition	
	^condition notNil! !

!MetaLink class methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 3/21/2015 15:18'!
uninstallAll
	<script>
	self allInstances do: #uninstall.! !

!MetaLinkTest commentStamp: 'MarcusDenker 3/1/2015 18:23'!
Tests for MetaLink!
!MetaLinkTest methodsFor: 'tests - simple' stamp: 'MarcusDenker 3/1/2015 18:12'!
testBlockLink
	| link |
	link := MetaLink new 
	metaObject: [1+2].
	
	self assert: link metaObject value = 3.
	self assert: link selector = #value.! !

!MetaLinkTest methodsFor: 'tests - simple' stamp: 'MarcusDenker 3/1/2015 18:11'!
testSimpleHaltLink
	| link |
	link := MetaLink new 
	metaObject: Halt;
	selector: #now.
	
	self assert: link metaObject = Halt.
	self assert: link selector = #now.! !

!MetaLinkTest methodsFor: 'tests - simple' stamp: 'MarcusDenker 3/1/2015 18:16'!
testCotrolLink
	| link |
	link := MetaLink new 
	metaObject: [1+2];
	control: #after.
	
	self assert: link metaObject value = 3.
	self assert: link selector = #value.
	self assert: link control = #after.! !

!MetaLinkTest methodsFor: 'tests - hooks' stamp: 'MarcusDenker 3/8/2015 09:31'!
testHaltHook
	| link |
	link := MetaLink new 
	metaObject: Halt;
	selector: #now.
	self assert: link hook class = RBMessageNode.
	self assert: link metaAwareHook class = RBMessageNode.
	self assert: link metaAwareHook arguments first class = RBBlockNode.! !

!MetaLinkTest methodsFor: 'tests - simple' stamp: 'MarcusDenker 3/1/2015 18:15'!
testConditionLink
	| link |
	link := MetaLink new 
	metaObject: [1+2];
	condition: true.
	
	self assert: link metaObject value = 3.
	self assert: link selector = #value.
	self assert: link condition.
	self assert: link hasCondition.! !

!Metacello commentStamp: 'dkh 7/28/2012 20:04'!
# Metacello User Guide

In this guide we'll take a walk through a couple of common development
scenarios and highlight some of the features of the *Metacello Scripting
API*.

*For installatation and more detailed documentation on the Metacello
Scripting API, see the [Metcello Scripting API Documentation][1].*

## Introduction

The number one job of the *Metacello Scripting API* is to simplify the
job of loading projects into your image. As you are probably all
too aware, today it's a two step process where you first load the
configuration into your image using [Gofer][2] and then load your
project using Metacello:

```Smalltalk
Gofer new
  package: 'ConfigurationOfSeaside30';
  squeaksource: 'MetacelloRepository';
  load.
((Smalltalk at: #ConfigurationOfSeaside30) version: #stable) load.
```

In the early days of Metacello (and Gofer) this was a great improvement
over the alternatives, but today, 3 years after the introduction of
Metacello, there should be a better way...and there is.
Using the *Metacello Scripting API* the above expression reduces to the
following:

```Smalltalk
Metacello new
  configuration: 'Seaside30';
  load.
```

## Loading

In this example of the [`load` command][5] we are leveraging a couple of
default values, namely the `version` of the project and the `repository` where the
**ConfigurationOfSeaside** package can be found:

```Smalltalk
Metacello new
  configuration: 'Seaside30';
  load.
```

Here is a variant
of the same expression with the (current) default values explicitly specified:

```Smalltalk
Metacello new
  configuration: 'Seaside30';
  version: #stable;
  squeaksource: 'MetacelloRepository';
  load.
```

The `version` attribute can be any legal [version number][10].
`squeaksource` is a [repository shortcut][4]. You can also specify the
full [repository description][3] as follows:

```Smalltalk
Metacello new
  configuration: 'Seaside30';
  version: #stable;
  repository: 'http://www.squeaksource.com/MetacelloRepository';
  load.
```

##Listing

Once you've loaded one or more projects into your image, you may want to
list them. The following is an example of the [`list` command][6]:

```Smalltalk
Metacello image
  configuration: [:spec | true ];
  list.
```

The `image` message tells Metacello that you'd like to look
at only loaded configurations. 

The *block* argument to the
`configuration:` message is used to *select* against the list of loaded
[MetacelloProjectSpec][7] instances in the [registry][8].

The `list` command itself returns a list of [MetacelloProjectSpec][7] instances that can be printed, inspected or otherwise manipulated.

In addition to a *select block*, you can specify a *select collection*
specifying the names of the projects you'd like to select:

```Smalltalk
Metacello registry
  configuration: #('Seaside30' 'MetacelloPreview');
  list.
```

The `registry` message tells Metacello that you'd like to
look at all projects in the [registry][8] whether or not they are loaded.

The *collection* argument to the `configuration:` message is used to
*select* against the list of project names in the [registry][8].

The `list` command can also be used to look at configurations in
Monticello repositories. For example:

```Smalltalk
Metacello new
  configuration: [:spec | spec name beginsWith: 'Seaside'];
  squeaksource: 'MetacelloRepository';
  list.
```

lists the configurations whose names (sans the `ConfigurationOf`) begin
with `Seaside` in the `MetacelloRepositry` in the
[Squeaksource](http://www.squeaksource.com) repostory.

## Getting

Once you've loaded a project into your image the next logical step is
upgrading your project to a new version. 

Let's say that a new `#stable` version of Seaside30 has been released
and that you want to upgrade. This is a two step process: 

* [get a new version of the configuration][11]
* [load the new version][12]

### Get a new version of the configuration

The following expression gets the latest version of the
configuration:

```Smalltalk
Metacello image
  configuration: 'Seaside30';
  get.
```

By using the `image` message, you can leverage the fact that the [registry][8] remembers
from which repository you loaded the original version of the configuration.

The `get` command simply downloads the latest version of the
configuration package from the repository.

You may download the configuration from a different repository:

```Smalltalk
Metacello image
  configuration: 'Seaside30';
  squeaksource: 'Seaside30;
  get.
```

The `get` command will update the [registry][8] with the new
repository location information.

You may also use the `get` command to load a configuration for a project
into your image without actually loading the project itself:

```Smalltalk
Metacello image
  configuration: 'SeasideRest';
  squeaksource: 'Seaside30';
  get.
```

The 'SeasideRest' project information will be registered in the [registry][8] and marked
as *unloaded*.

### Load the new version

Once you've got a new copy of the Seaside30 configuration loaded into your image, you may
upgrade your image with the following expression:

```Smalltalk
Metacello image
  configuration: 'Seaside30';
  version: #stable;
  load.
```

By using the `image` message, you are asking Metacello to look the
project up in the [registry][8] before performing the
operation, so it isn't necessary to supply all of the project details for every
command operation.

Of course, the `load` command updates the [registry][8].

If you want to load a project for which you've already done a `get`
(like the SeasideRest project earlier), you can do the following:

```Smalltalk
Metacello registry
  configuration: 'SeasideRest';
  version: #stable;
  load.
```

In this case you use the `registry` message to indicate that you are
interested in both *loaded* and *unloaded* projects.

##Locking

Let's say that you are using an older version of Seaside30 (say 3.0.5)
instead of the #stable version (3.0.7) and that your application doesn't
work with newer versions of Seaside30 (you've tried and it's more work
to get you application to work with the newer version of Seaside30 than
it's worth).

Let's also say that you want to try out something in the
SeasideRest project, but when you try loading SeasideRest, you end up
having Seaside 3.0.7 loaded as well. 

This is an unfortunate side effect of Metacello trying to *do the right
thing*, only in your case it is the wrong thing.

Fortunately, the [`lock` command][9] can give you control. First you
need to `lock` the Seaside30 project:

```Smalltalk
Metacello image
  configuration: 'Seaside30';
  lock.
```

The `image` message tells Metacello to do a lookup in the list of loaded
projects and then to put a lock on the loaded version of the project.

If you want you can specify which version of the project you want
locked:

```Smalltalk
Metacello image
  configuration: 'Seaside30';
  version: '3.0.5';
  lock.
```

After a project is locked an error (**MetacelloLockedProjectError**) is 
thrown when you attempt to load a project that has a dependency upon a 
different version of Seaside30. The error is thrown before any packages 
are actually loaded.

### Bypassing locks

Let's say that you want to load the SeasideRest project even though it may
require a version of Seaside30 that is later than the version that you have
locked. To do that you need to suppress the upgrade of the Seaside30
project during the load of the SeasideRest project and you can do that
with the use of the `onUpgrade:` message:

```Smalltalk
Metacello new
  configuration: 'SeasideRest';
  version: #stable;
  onUpgrade: [:ex :existing :new | 
    existing baseName = 'Seaside30'
      ifTrue: [ ex disallow ].
    ex pass ];
  load.
```

The `onUpgrade:` block tells Metacello to disallow the upgrade of any
project whose `baseName` is `Seaside30` and to continue with the load.
Of course if there are any explicit dependencies between SeasideRest and
the later version of Seaside30 (missing classes, etc.) then you may very
well get load errors or errors while using the SeasideRest, but that's
the price you pay for not upgrading.

### Upgrading a locked project

If you want to explicitly upgrade a locked project, you can use the
`load` command. The following command will upgrade Seaside30 to version
3.0.6 even if it is locked:

 ```Smalltalk
Metacello image
  configuration: 'Seaside30';
  version: '3.0.6';
  lock.
```

The newly loaded of the project will continue to be locked.

[1]: https://github.com/dalehenrich/metacello-work/blob/master/docs/MetacelloScriptingAPI.md
[2]: http://www.lukas-renggli.ch/blog/gofer
[3]: https://github.com/dalehenrich/metacello-work/blob/master/docs/MetacelloScriptingAPI.md#repository-descriptions
[4]: https://github.com/dalehenrich/metacello-work/blob/master/docs/MetacelloScriptingAPI.md#repository-shortcuts
[5]: https://github.com/dalehenrich/metacello-work/blob/master/docs/MetacelloScriptingAPI.md#loading
[6]: https://github.com/dalehenrich/metacello-work/blob/master/docs/MetacelloScriptingAPI.md#listing
[7]: https://github.com/dalehenrich/metacello-work/blob/master/docs/MetacelloScriptingAPI.md#metacelloprojectspec
[8]: https://github.com/dalehenrich/metacello-work/blob/master/docs/MetacelloScriptingAPI.md#metacello-project-registry
[9]: https://github.com/dalehenrich/metacello-work/blob/master/docs/MetacelloScriptingAPI.md#locking
[10]: https://github.com/dalehenrich/metacello-work/blob/master/docs/MetacelloScriptingAPI.md#metacello-version-numbers
[11]: https://github.com/dalehenrich/metacello-work/blob/master/docs/MetacelloUserGuide.md#get-a-new-version-of-the-configuration
[12]: https://github.com/dalehenrich/metacello-work/blob/master/docs/MetacelloUserGuide.md#load-the-new-version!
!Metacello methodsFor: 'api options' stamp: 'dkh 6/13/2012 16:05'!
ignoreImage
    "ignore image state"

    self addStatement: #'ignoreImage:' args: {true}! !

!Metacello methodsFor: 'api options' stamp: 'dkh 07/24/2013 15:22'!
onWarning: aBlock
  self addStatement: #'onWarning:' args: {aBlock}! !

!Metacello methodsFor: 'api repository shortcuts' stamp: 'dkh 7/17/2012 16:50'!
squeaksource: projectName
    self repository: 'http://www.squeaksource.com/' , projectName! !

!Metacello methodsFor: 'api repository shortcuts' stamp: 'dkh 7/17/2012 16:46'!
ss3: projectName
    self squeaksource3: projectName! !

!Metacello methodsFor: 'api projectSpec' stamp: 'dkh 7/12/2012 13:46'!
configuration: projectName
    self addStatement: #'configurationArg:' args: {projectName}! !

!Metacello methodsFor: 'api repository shortcuts' stamp: 'dkh 07/25/2013 15:17'!
squeaksource3: projectName
  self repository: 'http://ss3.gemtalksystems.com/ss/' , projectName! !

!Metacello methodsFor: 'api repository shortcuts' stamp: 'dkh 7/17/2012 16:48'!
impara: projectName
    self repository: 'http://source.impara.de/' , projectName! !

!Metacello methodsFor: 'api repository shortcuts' stamp: 'dkh 07/25/2013 15:21'!
filetreeDirectory: directoryName
  self repository: 'filetree://' , directoryName! !

!Metacello methodsFor: 'api actions' stamp: 'dkh 7/17/2012 10:53'!
lock
    "lock projects in registry"

    self addStatement: #'lock' args: #().
    ^ self execute! !

!Metacello methodsFor: 'api actions' stamp: 'dkh 7/19/2012 07:40'!
record: required
    self addStatement: #'record:' args: {required}.
    ^ self execute! !

!Metacello methodsFor: 'api options' stamp: 'dkh 07/24/2013 17:09'!
onLock: aBlock
  self addStatement: #'onLock:' args: {aBlock}! !

!Metacello methodsFor: 'api repository shortcuts' stamp: 'dkh 7/17/2012 16:48'!
renggli: projectName
    self repository: 'http://source.lukas-renggli.ch/' , projectName! !

!Metacello methodsFor: 'accessing' stamp: 'dkh 5/31/2012 17:57:13'!
statements
    statements ifNil: [ statements := OrderedCollection new ].
    ^ statements! !

!Metacello methodsFor: 'accessing' stamp: 'dkh 5/31/2012 17:57:13'!
statements: anObject
	statements := anObject! !

!Metacello methodsFor: 'api actions' stamp: 'dkh 7/23/2012 15:56'!
load
    self addStatement: #'load:' args: #(#()).
    ^ self execute! !

!Metacello methodsFor: 'accessing' stamp: 'dkh 7/13/2012 09:12'!
executorSpec
    executorSpec ifNil: [ executorSpec := #'MetacelloScriptApiExecutor' -> 'batch' ].
    ^ executorSpec! !

!Metacello methodsFor: 'api repository shortcuts' stamp: 'dkh 7/17/2012 16:49'!
saltypickle: projectName
    self repository: 'http://squeak.saltypickle.com/' , projectName! !

!Metacello methodsFor: 'api actions' stamp: 'dkh 7/13/2012 16:35'!
list
    "list projects in registry"

    self addStatement: #'list' args: #().
    ^ self execute! !

!Metacello methodsFor: 'accessing' stamp: 'dkh 7/13/2012 09:13'!
executorSpec: anAssoc
    executorSpec := anAssoc! !

!Metacello methodsFor: 'api actions' stamp: 'dkh 7/23/2012 15:55'!
fetch
    self addStatement: #'fetch:' args: #(#()).
    ^ self execute! !

!Metacello methodsFor: 'api projectSpec' stamp: 'dkh 7/12/2012 13:45'!
baseline: projectName
    self addStatement: #'baselineArg:' args: {projectName}! !

!Metacello methodsFor: 'api options' stamp: 'dkh 7/23/2012 16:17'!
cacheRepository: aRepositoryDescription
    self addStatement: #'cacheRepository:' args: {aRepositoryDescription}! !

!Metacello methodsFor: 'api projectSpec' stamp: 'dkh 7/12/2012 13:46'!
version: versionString
    self addStatement: #'versionArg:' args: {versionString}! !

!Metacello methodsFor: 'api repository shortcuts' stamp: 'dkh 07/25/2013 15:20'!
smalltalkhubUser: userName project: projectName
  self
    repository:
      'http://smalltalkhub.com/mc/' , userName , '/' , projectName , '/main'! !

!Metacello methodsFor: 'api repository shortcuts' stamp: 'dkh 07/25/2013 15:26'!
githubUser: userName project: projectName commitish: commitish path: path
  | branchOrCommitOrTag |
  branchOrCommitOrTag := commitish.
  branchOrCommitOrTag isEmpty
    ifTrue: [ branchOrCommitOrTag := 'master' ].
  self
    repository:
      'github://' , userName , '/' , projectName , ':' , branchOrCommitOrTag , '/'
        , path! !

!Metacello methodsFor: 'api projectSpec' stamp: 'dkh 7/12/2012 13:46'!
project: projectName
    self addStatement: #'projectArg:' args: {projectName}! !

!Metacello methodsFor: 'api repository shortcuts' stamp: 'dkh 7/17/2012 16:50'!
wiresong: projectName
    self repository: 'http://source.wiresong.ca/' , projectName! !

!Metacello methodsFor: 'private' stamp: 'dkh 5/31/2012 17:57:13'!
addStatement: selector args: args
    self statements add: selector -> args! !

!Metacello methodsFor: 'accessing' stamp: 'dkh 7/13/2012 09:16'!
scriptExecutor
    ^ (self class scriptExecutorClass: self executorSpec) new! !

!Metacello methodsFor: 'api options' stamp: 'dkh 7/23/2012 19:27'!
repositoryOverrides: aRepositoryDescriptionCollection
    self addStatement: #'repositoryOverrides:' args: {aRepositoryDescriptionCollection}! !

!Metacello methodsFor: 'api actions' stamp: 'dkh 7/17/2012 12:31'!
unlock
    "unlock projects in registry"

    self addStatement: #'unlock' args: #().
    ^ self execute! !

!Metacello methodsFor: 'api options' stamp: 'dkh 6/8/2012 14:03:46'!
onDowngrade: aBlock
    self addStatement: #'onDowngrade:' args: {aBlock}! !

!Metacello methodsFor: 'api actions' stamp: 'dkh 5/31/2012 17:57:13'!
load: required
    self addStatement: #'load:' args: {required}.
    ^ self execute! !

!Metacello methodsFor: 'api actions' stamp: 'dkh 7/23/2012 15:49'!
fetch: required
    self addStatement: #'fetch:' args: {required}.
    ^ self execute! !

!Metacello methodsFor: 'api repository shortcuts' stamp: 'dkh 7/17/2012 16:49'!
squeakfoundation: projectName
    self repository: 'http://source.squeakfoundation.org/' , projectName! !

!Metacello methodsFor: 'api actions' stamp: 'dkh 5/31/2012 17:57:13'!
get
    "resolve project name in given repository and return an instance of MetacelloProject resolved from a ConfigurationOf or BaselineOf"

    self addStatement: #'get' args: #().
    ^ self execute! !

!Metacello methodsFor: 'api repository shortcuts' stamp: 'dkh 7/17/2012 16:46'!
blueplane: projectName
    self repository: 'http://squeaksource.blueplane.jp/' , projectName! !

!Metacello methodsFor: 'api projectSpec' stamp: 'dkh 7/12/2012 13:45'!
className: className
    self addStatement: #'classNameArg:' args: {className}! !

!Metacello methodsFor: 'api repository shortcuts' stamp: 'dkh 7/17/2012 16:48'!
croquet: projectName
    self repository: 'http://hedgehog.software.umn.edu:8888/' , projectName! !

!Metacello methodsFor: 'private' stamp: 'dkh 7/12/2012 14:29'!
execute
    | script |
    script := self statements.
    self statements: nil.
    ^ self scriptExecutor execute: script! !

!Metacello methodsFor: 'api actions' stamp: 'dkh 07/25/2013 15:45'!
locked
  "list of locked projects in registry"

  ^ self
    project: [ :projectSpec | projectSpec isLocked ];
    list! !

!Metacello methodsFor: 'api options' stamp: 'dkh 6/7/2012 15:34'!
onConflict: aBlock
    self addStatement: #'onConflict:' args: {aBlock}! !

!Metacello methodsFor: 'api actions' stamp: 'dkh 7/23/2012 15:56'!
record
    self addStatement: #'record:' args: #(#()).
    ^ self execute! !

!Metacello methodsFor: 'api repository shortcuts' stamp: 'dkh 06/28/2013 16:52'!
gemsource: projectName
  self repository: 'http://seaside.gemtalksystems.com/ss/' , projectName! !

!Metacello methodsFor: 'api options' stamp: 'dkh 6/7/2012 15:33'!
onUpgrade: aBlock
    self addStatement: #'onUpgrade:' args: {aBlock}! !

!Metacello methodsFor: 'api projectSpec' stamp: 'dkh 7/12/2012 13:46'!
repository: repositoryDescription
    self addStatement: #'repositoryArg:' args: {repositoryDescription}! !

!Metacello methodsFor: 'api options' stamp: 'dkh 5/31/2012 17:57:13'!
silently
    "no progress bars"

    self addStatement: #'silently:' args: {true}! !

!Metacello class methodsFor: 'instance creation' stamp: 'dkh 7/13/2012 09:13'!
registry
    ^ self new
        executorSpec: #'MetacelloScriptRegistryExecutor' -> 'batch';
        yourself! !

!Metacello class methodsFor: 'private' stamp: 'dkh 7/13/2012 09:08'!
scriptExecutorClass
    ^ self scriptExecutorClass: {(#'MetacelloScriptApiExecutor' -> 'batch')}! !

!Metacello class methodsFor: 'instance creation' stamp: 'dkh 7/16/2012 10:12'!
image
    ^ self new
        executorSpec: #'MetacelloScriptImageExecutor' -> 'batch';
        yourself! !

!Metacello class methodsFor: 'private' stamp: 'dkh 7/13/2012 09:15'!
scriptExecutorClass: anExecutorSpec
    Smalltalk at: anExecutorSpec key ifAbsent: [ ConfigurationOf ensureMetacello: anExecutorSpec value ].
    ^ Smalltalk at: anExecutorSpec key! !

!Metacello class methodsFor: 'instance creation' stamp: 'dkh 07/27/2013 08:45'!
registrations
  ^ MetacelloProjectRegistration registry registrations! !

!Metacello class methodsFor: 'instance creation' stamp: 'dkh 6/13/2012 16:09'!
classic
    "set the options such that the load performed will be identical to the classic ConfigurationOf load:
	(ConfigurationOfExample project version: '1.0') load
	
	#classic forces Metacello to look at image state to determine which version of a project is loaded instead of using
		the registry to tell us explicitly which version of a project is loaded .. image state is not PRECISE"

    "useCurrentVersion is a 'private' option for enforcing classic rules, so it's not part of scripting api"

    ^ self new
        onUpgrade: [ :ex | ex allow ];
        onConflict: [ :ex | ex allow ];
        addStatement: #'useCurrentVersion:' args: {true};
        yourself! !

!MetacelloAbstractConstructor methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
configurationClass

	^self subclassResponsibility! !

!MetacelloAbstractConstructor methodsFor: 'pragma extraction' stamp: 'dkh 6/5/2012 19:01:24'!
extractVersionPragmas

	| aDict |
	aDict := Dictionary new.
	self extractPragmas: #version: into: aDict.
	^aDict! !

!MetacelloAbstractConstructor methodsFor: 'pragma extraction' stamp: 'dkh 6/5/2012 19:01:24'!
extractCommonDefaultSymbolicVersionPragmas

	| aDict |
	aDict := Dictionary new.
	self extractPragmas: #defaultSymbolicVersion: for: ConfigurationOf into: aDict.
	^aDict! !

!MetacelloAbstractConstructor methodsFor: 'pragma extraction' stamp: 'dkh 6/5/2012 19:01:24'!
extractVersionImportPragmas

	| aDict |
	aDict := Dictionary new.
	self extractPragmas: #version:imports: into: aDict.
	^aDict! !

!MetacelloAbstractConstructor methodsFor: 'pragma extraction' stamp: 'dkh 6/5/2012 19:01:24'!
extractAllVersionPragmas

	| aDict |
	aDict := Dictionary new.
	self extractPragmas: #version: into: aDict.
	self extractPragmas: #version:imports: into: aDict.
	^aDict! !

!MetacelloAbstractConstructor methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
extractPragmas: pragmaKeyword into: versionDict

	^self extractPragmas: pragmaKeyword for: self configurationClass into: versionDict
! !

!MetacelloAbstractConstructor methodsFor: 'pragma extraction' stamp: 'dkh 6/5/2012 19:01:24'!
extractSymbolicVersionPragmas

	| aDict |
	aDict := Dictionary new.
	self extractPragmas: #symbolicVersion: into: aDict.
	^aDict! !

!MetacelloAbstractConstructor methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
extractPragmas: pragmaKeyword for: aClass into: versionDict

	| versionString  pragmas |
	(Pragma 
		allNamed: pragmaKeyword
		in: aClass) do: [:pragma |
			versionString := pragma argumentAt: 1.
			pragmas := versionDict 
				at: versionString 
				ifAbsent: [ | list |
					list := OrderedCollection new.
					versionDict at: versionString put: list.
					list ].
			pragmas add: pragma ].
! !

!MetacelloAbstractConstructor methodsFor: 'pragma extraction' stamp: 'dkh 6/5/2012 19:01:24'!
extractDefaultSymbolicVersionPragmas

	| aDict |
	aDict := Dictionary new.
	self extractPragmas: #defaultSymbolicVersion: into: aDict.
	^aDict! !

!MetacelloAbstractPackageSpec methodsFor: '*metacello-mc-querying' stamp: 'dkh 6/8/2012 14:04:22'!
file 
	"MetacelloPackageSpec compatibility"
	
	^nil! !

!MetacelloAbstractPackageSpec methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
configMethodCascadeOn: aStream member: aMember last: lastCascade indent: indent

	self subclassResponsibility
! !

!MetacelloAbstractPackageSpec methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
setIncludes: aCollection

	includes := aCollection! !

!MetacelloAbstractPackageSpec methodsFor: 'adding' stamp: 'dkh 6/5/2012 19:01:24'!
addToMetacelloPackages: aMetacelloPackagesSpec

	aMetacelloPackagesSpec addMember: 
		(aMetacelloPackagesSpec addMember 
			name: self name;
			spec: self;
			yourself)! !

!MetacelloAbstractPackageSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
requires: aCollection

	aCollection setRequiresInMetacelloPackage: self! !

!MetacelloAbstractPackageSpec methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
setRequires: aCollection

	requires := aCollection! !

!MetacelloAbstractPackageSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
resolveToPackagesIn: aVersionSpec visited: visited

	^self subclassResponsibility! !

!MetacelloAbstractPackageSpec methodsFor: '*metacello-mc-querying' stamp: 'dkh 6/30/2012 12:32'!
repository
    self deprecated: 'Use repositories or repositorySpecs'.
    ^ nil! !

!MetacelloAbstractPackageSpec methodsFor: 'merging' stamp: 'dkh 6/5/2012 19:01:24'!
mergeSpec: anotherSpec

	| newSpec map anotherRequires anotherIncludes anotherAnswers |
	newSpec := super mergeSpec: anotherSpec.
	map := anotherSpec mergeMap.
	anotherSpec name ~~ nil 
		ifTrue: [ newSpec name: anotherSpec name ].
	(anotherRequires := map at: #requires) ~~ nil
		ifTrue: [ newSpec setRequires: self requires, anotherRequires ].
	(anotherIncludes := map at: #includes) ~~ nil
		ifTrue: [ newSpec setIncludes: self includes, anotherIncludes ].
	(anotherAnswers := map at: #answers) ~~ nil
		ifTrue: [ newSpec setAnswers: self answers, anotherAnswers ].
	^newSpec
	! !

!MetacelloAbstractPackageSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
loadUsing: aLoader gofer: gofer

	^self subclassResponsibility! !

!MetacelloAbstractPackageSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
includes

	includes == nil ifTrue: [ includes := #() ].
	^includes! !

!MetacelloAbstractPackageSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
forceUpdatePackageSpec: updatedSpecs using: anMCLoader

	^self updatePackageSpec: updatedSpecs using: anMCLoader! !

!MetacelloAbstractPackageSpec methodsFor: 'removing' stamp: 'dkh 6/5/2012 19:01:24'!
removeFromMetacelloPackages: aMetacelloPackagesSpec

	aMetacelloPackagesSpec addMember: 
		(aMetacelloPackagesSpec removeMember 
			name: self name;
			spec: self;
			yourself)! !

!MetacelloAbstractPackageSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
packagesNeedSavingVisited: visitedProjects using: repos into: aCollection
	"noop by default"
! !

!MetacelloAbstractPackageSpec methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/26/2015 21:00'!
spotterForRequiresFor: aStep
	<spotterOrder: 2>
	aStep listProcessor
		title: 'Requires';
		allCandidates: [ self requires ];
		itemName: [ :item | item name ];
		filter: GTFilterSubstring;
		wantsToDisplayOnEmptyQuery: true! !

!MetacelloAbstractPackageSpec methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
setAnswers: aCollection

	answers := aCollection! !

!MetacelloAbstractPackageSpec methodsFor: 'merging' stamp: 'dkh 6/5/2012 19:01:24'!
mergeMap

	| map |
	map := super mergeMap.
	map at: #requires put: requires.
	map at: #includes put: includes.
	map at: #answers put: answers.
	^map! !

!MetacelloAbstractPackageSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
resolveToAllPackagesIn: aVersionSpec into: packages visited: visited

	visited
		visit: self
		doing: [:spec |
			self visitingWithPackages: packages.
			(spec includes, spec requires) do: [:pkgName |
				(aVersionSpec packageNamed: pkgName)
					projectDo: [:prj | 
						(prj resolveToAllPackagesIn: aVersionSpec visited: visited) do: [:pkg | 
							packages at: pkg name put: pkg ]] 
					packageDo: [:pkg | 
						packages at: pkg name put: pkg.
						(pkg resolveToAllPackagesIn: aVersionSpec visited: visited) do: [:rpkg | 
							packages at: rpkg name put: rpkg ] ] 
					groupDo: [:grp | grp resolveToAllPackagesIn: aVersionSpec into: packages  visited: visited ]]]! !

!MetacelloAbstractPackageSpec methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/26/2015 21:00'!
spotterForIncludesFor: aStep
	<spotterOrder: 1>
	aStep listProcessor
		title: 'Includes';
		allCandidates: [ self includes ];
		itemName: [ :item | item name ];
		filter: GTFilterSubstring;
		wantsToDisplayOnEmptyQuery: true! !

!MetacelloAbstractPackageSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
updatePackageRepositoriesFor: aVersionSpec
	"noop by default"
	
	^true
! !

!MetacelloAbstractPackageSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
requires

	requires == nil ifTrue: [ requires := #() ].
	^requires! !

!MetacelloAbstractPackageSpec methodsFor: 'merging' stamp: 'dkh 6/5/2012 19:01:24'!
nonOverridable

	^#( includes requires answers )! !

!MetacelloAbstractPackageSpec methodsFor: '*metacello-mc-querying' stamp: 'dkh 6/8/2012 14:04:22'!
isPackageLoaded

	^false! !

!MetacelloAbstractPackageSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
updateForSpawnMethod: sourceSpec
	"This means that this spec was used in a baseline and will be used in a version .... drop all information that isn't useful"

	answers := name := requires := includes := nil! !

!MetacelloAbstractPackageSpec methodsFor: '*metacello-mc-querying' stamp: 'dkh 03/12/2013 20:25'!
getFile
  "MetacelloPackageSpec compatibility"

  ^ nil! !

!MetacelloAbstractPackageSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
repositorySpecs

	^#()! !

!MetacelloAbstractPackageSpec methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
configMethodBodyOn: aStream hasName: hasName cascading: cascading indent: indent

	| hasCascading hasRequires hasIncludes hasAnswers |
	hasCascading := cascading.
	hasRequires := self requires isEmpty not.
	hasIncludes := self includes isEmpty not.
	hasAnswers := self answers isEmpty not.
	hasRequires
		ifTrue: [ 
			hasName | hasIncludes | hasAnswers | hasCascading
				ifTrue: [ aStream cr; tab: indent ].
			aStream nextPutAll: 'requires: #('.
			self requires do: [:str | aStream nextPutAll: str printString, ' ' ].
			hasIncludes | hasAnswers | hasCascading
				ifTrue: [ aStream nextPutAll: ');' ]
				ifFalse: [ aStream nextPut: $) ]].
	hasIncludes
		ifTrue: [ 
			hasName | hasRequires | hasAnswers | hasCascading
				ifTrue: [ aStream cr; tab: indent ].
			aStream nextPutAll: 'includes: #('.
			self includes do: [:str | aStream nextPutAll: str printString, ' ' ].
			hasAnswers | hasCascading
				ifTrue: [ aStream nextPutAll: ');' ]
				ifFalse: [ aStream nextPut: $) ]].
	hasAnswers
		ifTrue: [ 
			hasName | hasRequires | hasIncludes | hasCascading
				ifTrue: [ aStream cr; tab: indent ].
			aStream nextPutAll: 'supplyingAnswers: #( '.
			self answers do: [:ar | 
				aStream nextPutAll: '#( '.
				ar do: [:val | 
					(val isString or: [ val isNumber or: [ val isSymbol or: [ val isCharacter ]]])
						ifTrue: [  aStream nextPutAll: val printString, ' ' ].
					val == true
						ifTrue: [  aStream nextPutAll: 'true ' ].
					val == false
						ifTrue: [  aStream nextPutAll: 'false ' ]].
				aStream nextPutAll: ') ' ].
			hasCascading
				ifTrue: [ aStream nextPutAll: ');' ]
				ifFalse: [ aStream nextPut: $) ]].
! !

!MetacelloAbstractPackageSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
updatePackageSpec: updatedSpecs using: anMCLoader
	"Add pkg copy to updatedSpecs if the file in current image is different from the receiver's file"
! !

!MetacelloAbstractPackageSpec methodsFor: 'testing' stamp: 'dkh 6/30/2012 13:21'!
hasRepository
    ^ false! !

!MetacelloAbstractPackageSpec methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
configMethodOn: aStream for: aValue selector: selector cascading: cascading cascade: cascade indent: indent

	| valuePrintString |
	aValue == nil ifTrue: [ ^self ].
	cascading ifTrue: [ aStream cr; tab: indent ].
	valuePrintString := aValue value isSymbol
		ifTrue: [ '#' , aValue value asString printString ]
		ifFalse: [ aValue value printString ].
	aStream  nextPutAll: selector, valuePrintString.
	cascade ifTrue: [ aStream nextPut: $; ]
! !

!MetacelloAbstractPackageSpec methodsFor: 'visiting' stamp: 'dkh 6/5/2012 19:01:24'!
projectDo: projectBlock packageDo: packageBlock groupDo: groupBlock

	self subclassResponsibility! !

!MetacelloAbstractPackageSpec methodsFor: '*metacello-mc-querying' stamp: 'dkh 6/8/2012 14:04:22'!
version 
	"MetacelloPackageSpec compatibility"
	
	^nil! !

!MetacelloAbstractPackageSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
includes: aCollection

	aCollection setIncludesInMetacelloPackage: self! !

!MetacelloAbstractPackageSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
resolveToAllPackagesIn: aVersionSpec visited: visited

	| packages |
	packages := Dictionary new.
	self resolveToAllPackagesIn: aVersionSpec into: packages visited: visited.
	^packages values asOrderedCollection
! !

!MetacelloAbstractPackageSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
visitingWithPackages: packages
	"noop"! !

!MetacelloAbstractPackageSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
name: aString
    ((aString at: 1) isSeparator or: [ (aString at: aString size) isSeparator ])
        ifTrue: [ self error: 'Names are not allowed to have leading or trailing blanks: ' , aString printString ].
    name := aString! !

!MetacelloAbstractPackageSpec methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
label

	^self name! !

!MetacelloAbstractPackageSpec methodsFor: 'copying' stamp: 'dkh 6/5/2012 19:01:24'!
postCopy

	super postCopy.
	requires := requires copy.
	includes := includes copy.
	answers := answers copy.
! !

!MetacelloAbstractPackageSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
answers

	answers == nil ifTrue: [ answers := #() ].
	^answers! !

!MetacelloAbstractPackageSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
referencedSpec

	^self! !

!MetacelloAbstractPackageSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
answers: aListOfPairs

	self setAnswers: aListOfPairs! !

!MetacelloAbstractPackageSpec methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
includesForPackageOrdering

	^#()! !

!MetacelloAbstractPackageSpec methodsFor: 'merging' stamp: 'dkh 6/5/2012 19:01:24'!
mergeIntoMetacelloPackages: aMetacelloPackagesSpec

	aMetacelloPackagesSpec addMember: 
		(aMetacelloPackagesSpec mergeMember 
			name: self name;
			spec: self;
			yourself)! !

!MetacelloAbstractPackageSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
name

	^name! !

!MetacelloAbstractPackageSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
resolveToLoadableSpec

	^self! !

!MetacelloAbstractPackageSpec class methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/26/2015 17:53'!
gtExamplePackageSpec
	<gtExample: 'Metacello package reference'>
	^ (ConfigurationOfGTSpotter project version: #development) packages anyOne! !

!MetacelloAbstractVersionConstructor methodsFor: 'accessing' stamp: 'dkh 10/3/2009 16:36'!
root

	^root! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
repositoryForProject: aString username: username password: password
    self repositoryForSpec: aString username: username password: password! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
project: aString overrides: aBlock
    self root project: aString overrides: aBlock constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
project
    project == nil
        ifTrue: [ project := self projectClass new ].
    ^ project! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
postLoadDoItForVersion: aSymbol
    self postLoadDoItForSpec: aSymbol! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
timestampForVersion: aBlockOrStringOrDateAndTime
    aBlockOrStringOrDateAndTime setTimestampInMetacelloConfig: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
postLoadDoItForPackage: aSymbol
    self postLoadDoItForSpec: aSymbol! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
projectForVersion: aString overrides: aBlock
    | spec projectSpec |
    projectSpec := self project projectSpec
        name: aString;
        yourself.
    spec := self project projectReferenceSpec
        name: aString;
        projectReference: projectSpec;
        yourself.
    self root packages add: spec.
    self with: projectSpec during: aBlock! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
supplyingAnswers: aCollection
    self root supplyingAnswers: aCollection constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'accessing' stamp: 'dkh 10/3/2009 16:37'!
root: aMetacelloSpec
    root := aMetacelloSpec! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
repositoryForVersion: aString username: username password: password
    self repositoryForSpec: aString username: username password: password! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
description: aBlockOrString
    "Define description field of version spec (MetacelloMCVersionSpec).
	 If <aBlockOrString> is a String, the version spec blessing is set to the String. It is recommended to use a Symbol.
	If <aBlockOrString> is a Block, the specifications in <aBlockOrString> are applied to the blessing spec (MetacelloValueHolderSpec). Not Recommended!!
	
		spec description: 'Descriptive comment'.
		
		spec description: [
			spec value: 'Descriptive comment'.
	 "

    self root description: aBlockOrString constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
authorForVersion: aBlockOrString
    aBlockOrString setAuthorInMetacelloConfig: self! !

!MetacelloAbstractVersionConstructor methodsFor: '*metacello-mc-accessing' stamp: 'dkh 6/8/2012 14:04:22'!
projectClass
    ^ MetacelloMCProject! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
projectPackage: aBlock
    "projectPackage spec data folded into project spec"

    self root projectPackage: aBlock constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
repositoriesForPackage: aBlock
    self repositoriesForSpec: aBlock! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
valueForValueHolder: anObject
    self root value: anObject! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
repository: description username: username password: password
    self root
        repository: description
        username: username
        password: password
        constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'private' stamp: 'DaleHenrichs 11/12/2010 12:28'!
evaluatePragma: pragma
	currentContext := pragma.
	[ self configuration perform: pragma selector with: self ] ensure: [ currentContext := nil ]! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'dkh 9/5/2012 06:26:03.064'!
baseline: aString
    self root baseline: aString constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
removeGroupForVersion: aString
    | spec |
    spec := self project groupSpec
        name: aString;
        yourself.
    self root packages remove: spec! !

!MetacelloAbstractVersionConstructor methodsFor: 'accessing' stamp: 'DaleHenrichs 12/4/2010 09:56'!
addAttribute: anAttribute

	self attributeOrder add: anAttribute! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 11:38'!
for: attributeListOrSymbol do: aBlock
    "conditional version support"

    attributeListOrSymbol setForDo: aBlock withInMetacelloConfig: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'initialization' stamp: 'dkh 10/5/2009 16:42'!
reset
    attributeMap := attributeOrder := nil! !

!MetacelloAbstractVersionConstructor methodsFor: 'api callbacks' stamp: 'DaleHenrichs 11/12/2010 09:54'!
setDescriptionWithString: aString

	self root description: aString! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
group: aString overrides: aStringOrCollection
    self root group: aString overrides: aStringOrCollection constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'dkh 9/5/2012 06:26:03.064'!
baseline: aString with: aBlockOrString
    self root baseline: aString with: aBlockOrString constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
preLoadDoIt: aSymbol
    self root preLoadDoIt: aSymbol constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
name: anObject
    self root name: anObject constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'accessing' stamp: 'DaleHenrichs 03/12/2011 22:10'!
setProject: aProject

	project := aProject! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
preLoadDoItForPackage: aSymbol
    self preLoadDoItForSpec: aSymbol! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
versionStringForProject: anObject
    self root versionString: anObject! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
repositoryForProject: anObject
    self repositoryForSpec: anObject! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
package: aString overrides: aBlock
    self root package: aString overrides: aBlock constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
package: packageName with: aBlockOrString
    "Define specification for package <packageName>.
	 If <aBlockOrString> is a String (or Symbol), the String is expected to be a version (or symbolic version).
	If <aBlockOrString> is a Block, the specifications in <aBlockOrString> are applied to the project:
	
		spec package: 'MyPackage' with: '1.0'.
		
		spec package: 'MyPackage' with: [
			spec file:'MyPackage-dkh.1'.
			spec repository: '/opt/gemstone/repository'.
	 "

    self root package: packageName with: aBlockOrString constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
repositoryForRepositories: aString username: username password: password
    self repositoryForVersion: aString username: username password: password! !

!MetacelloAbstractVersionConstructor methodsFor: 'api callbacks' stamp: 'DaleHenrichs 11/12/2010 09:54'!
setProject: aString withString: versionString

	| spec projectSpec |
	projectSpec := 
		(self project projectSpec)
			name: aString;
			versionString: versionString;
			yourself.
	spec := 
		(self project projectReferenceSpec)
			name: aString;
			projectReference: projectSpec;
			yourself.
	self root packages merge: spec.
! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
group: aString with: aStringOrCollection
    self root group: aString with: aStringOrCollection constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
removeProjectForVersion: aString
    | spec |
    spec := self project projectReferenceSpec
        name: aString;
        yourself.
    self root packages remove: spec! !

!MetacelloAbstractVersionConstructor methodsFor: 'accessing' stamp: 'dkh 10/3/2009 16:26'!
configuration: aConfig

	configuration := aConfig! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
versionForProject: anObject
    self versionStringForProject: anObject! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
operatorForProject: anObject
    self root operator: anObject! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
operator: anObject
    self root operator: anObject constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
postLoadDoItForProject: aSymbol
    self postLoadDoItForSpec: aSymbol! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
repositoryForSpec: aString username: username password: password
    self root repository: aString username: username password: password! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
postLoadDoItForSpec: aSymbol
    self validateDoItSelector: aSymbol.
    self root postLoadDoIt: aSymbol! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
projectForVersion: aString
    self project: aString with: ''! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
supplyingAnswersForPackage: anObject
    self root answers: anObject! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
repositoryForPackage: aString username: username password: password
    self repositoryForSpec: aString username: username password: password! !

!MetacelloAbstractVersionConstructor methodsFor: 'api callbacks' stamp: 'DaleHenrichs 11/12/2010 09:54'!
setTimestampWithString: aString

	self root timestamp: aString! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
file: aString
    "Define file field of a package spec (MetacelloPackageSpec) or project spec (MetacelloMCProjectSpec).

	For a package spec, the file: field is optional in a baseline. In a baseline, the file field may be used to specify a package branch for the package:
	
		spec package: 'MyPackage' with: [
			spec file: 'MyPackage.gemstone'. ]'.

	The file: field is required in a version. In a version, the file field defines the explicit version of the package to be loaded:
	
		spec package: 'MyPackage' with: [
			spec file: 'MyPackage.gemstone-dkh.1'. ]'.

	The following may be used as a short cut for specifying the file field in a version:

		spec package: 'MyPackage' with: 'MyPackage.gemstone-dkh.1'.

	For a project spec, the file field specifies the name of the Monticello package that contains the configuration. If you are using the convention of 
	naming the class and package usingthe  'ConfigurationOf' prefix, then there is no need to specify the file field:
	
		spec project: 'MyProject' with: [
			spec file: 'ConfigurationMyProject'.

	It should only be used when the package name for the configuration is different from the name of the project:

		spec project: 'MyProject' with: [
			spec file: 'MyProject-Metacello'.
	 "

    self root file: aString constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'accessing' stamp: 'DaleHenrichs 9/22/2010 16:43'!
symbolicVersion

	^symbolicVersion! !

!MetacelloAbstractVersionConstructor methodsFor: 'api callbacks' stamp: 'DaleHenrichs 11/12/2010 09:54'!
setPackage: aString withString: aFile

	| spec |
	spec := 
		(self project packageSpec)
			name: aString;
			file: aFile;
			yourself.
	self root packages merge: spec.
! !

!MetacelloAbstractVersionConstructor methodsFor: 'validation' stamp: 'DaleHenrichs 11/12/2010 10:28'!
validateDoItSelector: anObject

	anObject == nil ifTrue: [ ^ self ].
	anObject isSymbol ifFalse: [ self error: 'Invalid message selector for doit: ', anObject printString ].
! !

!MetacelloAbstractVersionConstructor methodsFor: 'accessing' stamp: 'dkh 10/3/2009 16:28'!
attributeMap

	attributeMap == nil ifTrue: [ attributeMap := Dictionary new ].
	^attributeMap! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 03/12/2011 22:11'!
project: aString
    self root project: aString constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
project: aString copyFrom: oldSpecName with: aBlock
    self root
        project: aString
        copyFrom: oldSpecName
        with: aBlock
        constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api callbacks' stamp: 'DaleHenrichs 11/12/2010 09:54'!
setBlessingWithBlock: aBlock

	| spec |
	(spec := self root getBlessing) == nil
		ifTrue: [ 
			spec := self project valueHolderSpec.
			self root setBlessing: spec ].
	self with: spec during: aBlock! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
projectForVersion: aString copyFrom: oldSpecName with: aBlock
    | spec projectSpec |
    projectSpec := self project projectSpec
        name: aString;
        yourself.
    spec := self project projectReferenceSpec
        name: aString;
        projectReference: projectSpec;
        yourself.
    self root packages copy: oldSpecName to: spec.
    self with: projectSpec during: aBlock! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
repositoryForRepositories: anObject
    self repositoryForSpec: anObject! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
repositoryForVersion: anObject
    self repositoryForSpec: anObject! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
projectPackageForProject: aBlock
    self with: self root during: aBlock! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
includes: anObject
    self root includes: anObject constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
preLoadDoItForSpec: aSymbol
    self validateDoItSelector: aSymbol.
    self root preLoadDoIt: aSymbol! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
repositoryForPackage: anObject
    self repositoryForSpec: anObject! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
repository: anObject
    self root repository: anObject constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
classNameForProject: aString
    self root className: aString! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
packageForVersion: packageName with: aBlockOrString
    aBlockOrString setPackage: packageName withInMetacelloConfig: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
preLoadDoItForVersion: aSymbol
    self preLoadDoItForSpec: aSymbol! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
configurationForVersion: aString with: aBlock
    aBlock setConfiguration: aString withInMetacelloConfig: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
nameForProject: aString
    self root name: aString! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
author: aBlockOrString
    "Define author field of version spec (MetacelloMCVersionSpec).
	 If <aBlockOrString> is a String, the version spec author is set to the String.
	If <aBlockOrString> is a Block, the specifications in <aBlockOrString> are applied to the author spec (MetacelloValueHolderSpec). Not Recommended!!
	
		spec author: 'dkh'.
		
		spec author: [
			spec value: 'dkh'. ].
	 "

    self root author: aBlockOrString constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
value: anObject
    self root value: anObject constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
package: aString
    self root package: aString constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
blessingForVersion: aBlockOrString
    aBlockOrString setBlessingInMetacelloConfig: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'accessing' stamp: 'dkh 10/5/2009 16:41'!
attributeOrder

	attributeOrder == nil ifTrue: [ attributeOrder := OrderedCollection new ].
	^attributeOrder! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
packageForVersion: aString
    | spec |
    spec := self project packageSpec
        name: aString;
        yourself.
    self root packages add: spec! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'dkh 9/5/2012 06:26:03.064'!
import: aString
    "import names defined in baseline <aString> to be used when loading the version

		spec baseline: 'Sample' with: [ spec repository: 'github://dalehenrich/sample:master/repository' ].
		spec import: 'Sample' ]
	 "

    self root import: aString constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
fileForProject: aString
    self root file: aString! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
version: anObject
    self root version: anObject constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'dkh 9/5/2012 06:26:03.064'!
configuration: aString with: aBlockOrString
    self root configuration: aString with: aBlockOrString constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api callbacks' stamp: 'dkh 9/7/2012 13:11'!
setFor: attributeList version: aString
    "conditional symbolicVersion support"

    attributeList asMetacelloAttributeList
        do: [ :attribute | 
            self attributeMap at: attribute put: aString.
            self addAttribute: attribute ]! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
timestamp: aBlockOrStringOrDateAndTime
    "Define timestamp field of version spec (MetacelloMCVersionSpec).
	 If <aBlockOrStringOrDateAndTime> is a String, the version spec timetamp is set to the String.
	 If <aBlockOrStringOrDateAndTime> is a DateAndTime, the version spec timetamp is set to the printString of the DateAndTime.
	If <aBlockOrStringOrDateAndTime> is a Block, the specifications in <aBlockOrStringOrDateAndTime> are applied to the timestamp spec (MetacelloValueHolderSpec). Not Recommended!!
	
		spec timestamp: '10/7/2009 14:40'.
		
		spec timestamp: DateAndTime now'.
		
		spec timestamp: [
			spec value: '10/7/2009 14:40'. ].
    "

    self root timestamp: aBlockOrStringOrDateAndTime constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api callbacks' stamp: 'dkh 9/7/2012 13:11'!
setFor: attributeList do: aBlock
    "conditional version support"

    attributeList asMetacelloAttributeList
        do: [ :attribute | 
            | blockList |
            blockList := self attributeMap
                at: attribute
                ifAbsent: [ self attributeMap at: attribute put: (blockList := OrderedCollection new) ].
            blockList add: aBlock.
            self addAttribute: attribute ]! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
removeProject: aString
    self root removeProject: aString constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
fileForPackage: aString
    self root file: aString! !

!MetacelloAbstractVersionConstructor methodsFor: 'api callbacks' stamp: 'DaleHenrichs 11/12/2010 09:54'!
setDescriptionWithBlock: aBlock

	| spec |
	(spec := self root getDescription) == nil
		ifTrue: [ 
			spec := self project valueHolderSpec.
			self root setDescription: spec ].
	self with: spec during: aBlock! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
baselineForVersion: aString with: aBlock
    aBlock setBaseline: aString withInMetacelloConfig: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
includesForPackage: anObject
    self root includes: anObject! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
repositories: aBlock
    self root repositories: aBlock constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'accessing' stamp: 'DaleHenrichs 11/3/2010 11:41'!
configurationClass

	^self configuration class! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
groupForVersion: aString with: aStringOrCollection
    | spec |
    spec := self project groupSpec
        name: aString;
        includes: aStringOrCollection;
        yourself.
    self root packages merge: spec! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
postLoadDoIt: aSymbol
    self root postLoadDoIt: aSymbol constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
versionString: anObject
    self root versionString: anObject constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 11:37'!
for: attributeListOrSymbol version: aString
    "conditional symbolicVersion support"

    attributeListOrSymbol setForVersion: aString withInMetacelloConfig: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
preLoadDoItForProject: aSymbol
    self preLoadDoItForSpec: aSymbol! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
repositoryForSpec: anObject
    self root repository: anObject! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
removePackage: aString
    self root removePackage: aString constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'accessing' stamp: 'DaleHenrichs 9/22/2010 16:43'!
symbolicVersion: aSymbol

	symbolicVersion := aSymbol! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
descriptionForVersion: aBlockOrString
    aBlockOrString setDescriptionInMetacelloConfig: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
loadsForProject: anObject
    self root loads: anObject! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
repositoriesForSpec: aBlock
    self with: self root repositories during: aBlock! !

!MetacelloAbstractVersionConstructor methodsFor: 'api callbacks' stamp: 'DaleHenrichs 11/12/2010 09:54'!
setPackage: aString withBlock: aBlock

	| spec |
	spec := 
		(self project packageSpec)
			name: aString;
			yourself.
	self root packages merge: spec.
	self with: spec during: aBlock! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
removeGroup: aString
    self root removeGroup: aString constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api callbacks' stamp: 'DaleHenrichs 11/12/2010 09:54'!
setTimestampWithBlock: aBlock

	| spec |
	(spec := self root getTimestamp) == nil
		ifTrue: [ 
			spec := self project valueHolderSpec.
			self root setTimestamp: spec ].
	self with: spec during: aBlock! !

!MetacelloAbstractVersionConstructor methodsFor: 'api callbacks' stamp: 'DaleHenrichs 11/12/2010 09:54'!
setProject: aString withBlock: aBlock
    | spec projectSpec |
    projectSpec := self project projectSpec
        name: aString;
        yourself.
    spec := self project projectReferenceSpec
        name: aString;
        projectReference: projectSpec;
        yourself.
    self root packages merge: spec.
    self with: projectSpec during: aBlock! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
requires: anObject
    self root requires: anObject constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
projectForVersion: aString with: aBlockOrString
    aBlockOrString setProject: aString withInMetacelloConfig: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
setBaseline: aString withBlock: aBlock
    | projectSpec |
    projectSpec := self setBaseline: aString.
    self with: projectSpec during: aBlock! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
versionForVersion: anObject
    self versionStringForVersion: anObject! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
versionStringForVersion: anObject
    self versionStringForProject: anObject! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
removePackageForVersion: aString
    | spec |
    spec := self project packageSpec
        name: aString;
        yourself.
    self root packages remove: spec! !

!MetacelloAbstractVersionConstructor methodsFor: 'api callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
setConfiguration: aString withBlock: aBlock
    | spec projectSpec |
    projectSpec := self project configurationOfProjectSpec
        name: aString;
        yourself.
    spec := self project projectReferenceSpec
        name: aString;
        projectReference: projectSpec;
        yourself.
    self root packages merge: spec.
    self with: projectSpec during: aBlock! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
groupForVersion: aString overrides: aStringOrCollection
    | spec |
    spec := self project groupSpec
        name: aString;
        includes: aStringOrCollection;
        yourself.
    self root packages add: spec! !

!MetacelloAbstractVersionConstructor methodsFor: 'api callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
setBaseline: aString
    | spec projectSpec |
    projectSpec := self project baselineOfProjectSpec
        name: aString;
        className: 'BaselineOf' , aString;
        yourself.
    spec := self project projectReferenceSpec
        name: aString;
        projectReference: projectSpec;
        yourself.
    self root packages merge: spec.
    ^ projectSpec! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
loads: anObject
    self root loads: anObject constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
repositoriesForProject: aBlock
    self repositoriesForSpec: aBlock! !

!MetacelloAbstractVersionConstructor methodsFor: 'api callbacks' stamp: 'DaleHenrichs 11/12/2010 09:54'!
setAuthorWithBlock: aBlock

	| spec |
	(spec := self root getAuthor) == nil
		ifTrue: [ 
			spec := self project valueHolderSpec.
			self root setAuthor: spec ].
	self with: spec during: aBlock! !

!MetacelloAbstractVersionConstructor methodsFor: 'accessing' stamp: 'dkh 10/3/2009 16:26'!
configuration

	^configuration! !

!MetacelloAbstractVersionConstructor methodsFor: 'api callbacks' stamp: 'DaleHenrichs 11/12/2010 09:54'!
setBlessingWithString: aString

	self root blessing: aString! !

!MetacelloAbstractVersionConstructor methodsFor: 'private' stamp: 'dkh 10/3/2009 16:31'!
with: aMetacelloSpec during: aBlock
    | previousRoot |
    previousRoot := self root.
    self root: aMetacelloSpec.
    aBlock
        ensure: [ self root: previousRoot ]! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
importForVersion: aString
    self root import: aString! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
requiresForPackage: anObject
    self root requires: anObject! !

!MetacelloAbstractVersionConstructor methodsFor: 'api callbacks' stamp: 'DaleHenrichs 11/12/2010 09:54'!
setAuthorWithString: aString

	self root author: aString! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
packageForVersion: aString overrides: aBlock
    | spec |
    spec := self project packageSpec
        name: aString;
        yourself.
    self root packages add: spec.
    self with: spec during: aBlock! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
className: aString
    "Define className field of a project spec (MetacelloMCProjectSpec).
	
		spec project: 'CoolBrowser' with: [
			spec className: 'ConfigurationOfCoolBrowser'. ].

	The className field is OPTIONAL in the project spec. If omitted, the className will be created by prepending 'ConfigurationOf' to the project name.
	 "

    self root className: aString constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
baselineForVersion: aString
    self setBaseline: aString! !

!MetacelloAbstractVersionConstructor methodsFor: 'api spec callbacks' stamp: 'dkh 9/5/2012 06:26:03.064'!
repositoriesForVersion: aBlock
    self repositoriesForSpec: aBlock! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
blessing: aBlockOrString
    "Define blessing field of version spec (MetacelloMCVersionSpec).
	 If <aBlockOrString> is a String, the version spec blessing is set to the String. It is recommended to use a Symbol.
	If <aBlockOrString> is a Block, the specifications in <aBlockOrString> are applied to the blessing spec (MetacelloValueHolderSpec). Not Recommended!!
	
		spec blessing: #release.
		
		spec blessing: [
			spec value: #release. ].
	
	The blessing should typically be set to one of three values:
		#baseline - indicating that the version spec is specifying a baseline version
		#development - indicating that the version spec is not stabilized and will change over time
		#release - indicating that the version spec has stabilized and will NOT change over time
	 "

    self root blessing: aBlockOrString constructor: self! !

!MetacelloAbstractVersionConstructor methodsFor: 'api' stamp: 'DaleHenrichs 11/12/2010 09:54'!
project: aString with: aBlockOrString
    self root project: aString with: aBlockOrString constructor: self! !

!MetacelloAbstractVersionConstructor class methodsFor: 'method generation' stamp: 'dkh 6/5/2012 19:01:24'!
symbolicMethodSelectorAndPragma: selector symbolicVersionSymbol: symbolicVersionSymbol on: strm
	strm
		nextPutAll: selector asString , ' spec';
		cr;
		tab;
		nextPutAll: '<symbolicVersion: #' , symbolicVersionSymbol asString printString;
		nextPutAll: '>';
		cr! !

!MetacelloAddMemberSpec methodsFor: 'actions' stamp: 'dkh 6/5/2012 19:01:24'!
applyAdd: addBlock copy: copyBlock merge: mergeBlock remove: removeBlock

	addBlock value: self! !

!MetacelloAddMemberSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
methodUpdateSelector

	^#overrides:! !

!MetacelloAddMemberSpec methodsFor: 'actions' stamp: 'dkh 6/5/2012 19:01:24'!
applyToList: aListSpec

	aListSpec add: self! !

!MetacelloAllowConflictingProjectUpgrade methodsFor: 'handlers' stamp: 'dkh 6/7/2012 15:50'!
handleResolutionFor: aScriptEngine
    ^ aScriptEngine handleConflict: self! !

!MetacelloAllowConflictingProjectUpgrade methodsFor: 'accessing' stamp: 'dkh 07/29/2013 16:44'!
operationString
  ^ 'load with conflicts'! !

!MetacelloAllowConflictingProjectUpgrade methodsFor: 'exception handling' stamp: 'dkh 7/18/2012 11:06'!
defaultAction
    ^ MetacelloConflictingProjectError
        signal:
            'Load Conflict between existing ' , self existingProjectRegistration printString , ' and '
                , self newProjectRegistration printString! !

!MetacelloAllowLockedProjectChange methodsFor: 'handlers' stamp: 'dkh 07/24/2013 16:58'!
handleResolutionFor: aScriptEngine
  ^ aScriptEngine handleLock: self! !

!MetacelloAllowLockedProjectChange methodsFor: 'accessing' stamp: 'dkh 07/24/2013 17:00'!
operationString: aString
  operationString := aString! !

!MetacelloAllowLockedProjectChange methodsFor: 'accessing' stamp: 'dkh 07/24/2013 17:00'!
operationString
  ^ operationString! !

!MetacelloAllowLockedProjectChange methodsFor: 'exception handling' stamp: 'dkh 07/30/2013 07:51'!
defaultAction
  Warning
    signal:
      'LOCK ENFORCED: Attempt to ' , self operationString printString
        , ' new project: ' , self newProjectRegistration printString printString
        , ' when existing project: '
        , self existingProjectRegistration printString printString
        , ' is locked. New project not loaded. Use #onLock: to intercept.'.
  ^ self disallow! !

!MetacelloAllowLockedProjectChange methodsFor: 'private' stamp: 'dkh 07/25/2013 04:42'!
checkAllowed
  "noop ... if user decided to allow lock to be broken, then so be it"

! !

!MetacelloAllowProjectDowngrade methodsFor: 'handlers' stamp: 'dkh 7/18/2012 16:46'!
handleOnDownGrade: onDownGradeBlock onUpgrade: onUpgradeBlock
    ^ onDownGradeBlock cull: self cull: self existingProjectRegistration cull: self newProjectRegistration! !

!MetacelloAllowProjectDowngrade methodsFor: 'handlers' stamp: 'dkh 6/8/2012 10:41'!
handleResolutionFor: aScriptEngine
    ^ aScriptEngine handleDowngrade: self! !

!MetacelloAllowProjectDowngrade methodsFor: 'accessing' stamp: 'dkh 07/29/2013 16:49'!
operationString
  ^ 'downgrade to'! !

!MetacelloAllowProjectUpgrade methodsFor: 'handlers' stamp: 'dkh 7/18/2012 16:46'!
handleOnDownGrade: onDownGradeBlock onUpgrade: onUpgradeBlock
    ^ onUpgradeBlock cull: self cull: self existingProjectRegistration cull: self newProjectRegistration! !

!MetacelloAllowProjectUpgrade methodsFor: 'handlers' stamp: 'dkh 6/7/2012 15:50'!
handleResolutionFor: aScriptEngine
    ^ aScriptEngine handleUpgrade: self! !

!MetacelloAllowProjectUpgrade methodsFor: 'accessing' stamp: 'dkh 07/29/2013 16:49'!
operationString
  ^ 'upgrade to'! !

!MetacelloAllowProjectUpgrade methodsFor: 'exception handling' stamp: 'dkh 7/18/2012 16:43'!
defaultAction
    "Default for Upgrade is to allow"

    self checkAllowed.
    ^ self newProjectRegistration! !

!MetacelloAlternateResource methodsFor: 'running' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpMonticelloRepository
	"This method builds a fake repository with the version references from #buildReferences."

	monticelloRepository := MCDictionaryRepository new.
	versionReferences do: [ :reference |
		monticelloRepository basicStoreVersion: (MCVersion new
			setPackage:  (MetacelloTestsMCPackage new name: reference packageName)
			info: (MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: #())
			snapshot: (MCSnapshot fromDefinitions: (Array
				with: (MCOrganizationDefinition categories: (Array with: reference packageName asSymbol))
				with: (MCClassDefinition name: reference packageName asSymbol superclassName: #Object category: reference packageName asSymbol instVarNames: #() comment: '')))
			dependencies: #()) ]! !

!MetacelloAlternateResource methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
monticelloRepository
	^ monticelloRepository! !

!MetacelloAlternateResource methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
versionReferences
	^ versionReferences! !

!MetacelloAlternateResource methodsFor: 'running' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUp
	super setUp.
	self
		setUpVersionReferences;
		setUpMonticelloRepository! !

!MetacelloAlternateResource methodsFor: 'running' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpVersionReferences
	"self reset"

	versionReferences := OrderedCollection new.
	versionReferences
		add: (GoferVersionReference name: 'GoferBar-dkh.24');
		add: (GoferVersionReference name: 'GoferBar-dkh.25');
		add: (GoferVersionReference name: 'GoferFoo-dkh.75');
		add: (GoferVersionReference name: 'GoferFoo-dkh.104')! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfAtomicFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline60MethodSourceFoo

	^(self class sourceCodeAt: #baseline60Foo:) asString

! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfAtomicFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
version20Foo: spec 
	"self reset"
	<version: '2.0' imports: #('2.0-baseline')>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec blessing: #release.
		spec 
			package: 'GoferBar' with: 'GoferBar-dkh.1';
			package: 'GoferFoo' with: 'GoferFoo-dkh.4';
			package: 'GoferBeau' with: 'GoferBeau-dkh.15';
			package: 'GoferFaux' with: 'GoferFaux-tg.30';
			yourself ].
! !

!MetacelloAtomicConfigurationResource methodsFor: 'Issue 86' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline62MethodSourceProjectIssue86

	^(self class sourceCodeAt: #baseline62ProjectIssue86:) asString

! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfAtomicFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline62Foo: spec 
	"self reset"
	<version: '6.2'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec 
			package: 'GoferFoo' with:'GoferFoo-lr.4';
			package: 'GoferBar' with: 'GoferBar-lr.1';
			package: 'GoferFaux' with: 'GoferFaux-tg.34';
			package: 'GoferBeau' with: 'GoferBeau-dkh.55';
			yourself.
		spec
			group: '1' with: #('GoferFoo' 'GoferBar');
			group: '2' with: #('GoferFoo' );
			yourself ].
! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfAtomicFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline25Foo: spec 
	"self reset"
	<version: '2.5-baseline'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec blessing: #baseline.
		spec 
			package: 'GoferFoo' with: [spec requires: 'GoferFan' ];
			yourself.
		spec 
			project: 'GoferFan' with: [ "requires GoferBeau"
				spec
					className: 'MetacelloTestConfigurationOfAtomicFan';
					versionString: '2.0-baseline';
					loads: 'GoferFan';
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			yourself ].
! !

!MetacelloAtomicConfigurationResource methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
monticelloRepository
	^ monticelloRepository! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfAtomicFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
linearProjectMethodSource

	^(self class sourceCodeAt: #project) asString copyReplaceAll: 'atomic' with: 'linear'

! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfAtomicFan' stamp: 'dkh 6/12/2012 15:41:23.319'!
postLoad31baselineMethodSource

	^(self class sourceCodeAt: #postLoad31baseline) asString

! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfAtomicFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
project
	"self reset"

	| constructor project |
	"Construct Metacello project"
	constructor := MetacelloVersionConstructor on: self.
	project := constructor project.
	project loader: 
		((project loaderClass new)
			shouldDisablePackageCache: true;
			yourself).
	project loadType: #atomic.
	^project
! !

!MetacelloAtomicConfigurationResource methodsFor: 'running' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpMonticelloRepository
	"This method builds a fake repository with the version references from #buildReferences."
	"self reset"

	monticelloRepository := MCDictionaryRepository new.
! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfAtomicFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
version51MethodSourceFoo

	^(self class sourceCodeAt: #version51Foo:) asString

! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfUmbrella' stamp: 'dkh 6/12/2012 15:41:23.319'!
version50Umbrella: spec 
	"self reset"
	<version: '5.0'>
	
	spec for: #common do: [
		spec 
			project: 'Umbrella' with: [
				spec
					className: 'MetacelloTestConfigurationOfLinearFoo';
					versionString: '5.0';
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			yourself ].
! !

!MetacelloAtomicConfigurationResource methodsFor: 'Issue 86' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline60ProjectIssue86: spec 
	"projects and packages"
	"self reset"
	<version: '6.0'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec 
			project: 'A' with: [
				spec
					className: 'MetacelloTestConfigurationOfLinearFoo';
					versionString: '6.0';
					loads: #('1');
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			project: 'B' with: [
				spec
					className: 'MetacelloTestConfigurationOfLinearFoo';
					versionString: '6.0';
					loads: #('2');
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			yourself ].
! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfAtomicFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
projectMethodSource

	^(self class sourceCodeAt: #project) asString

! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfUmbrella' stamp: 'dkh 6/12/2012 15:41:23.319'!
version51Umbrella: spec 
	"self reset"
	<version: '5.1'>
	
	spec for: #common do: [
		spec 
			project: 'Umbrella' with: [
				spec
					className: 'MetacelloTestConfigurationOfLinearFoo';
					versionString: '5.1';
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			yourself ].
! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfUmbrella' stamp: 'dkh 6/12/2012 15:41:23.319'!
version50MethodSourceUmbrella

	^(self class sourceCodeAt: #version50Umbrella:) asString

! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfUmbrella' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfUmbrellaA
    "self reset"

    | reference className definitionArray |
    reference := GoferVersionReference name: 'MetacelloTestConfigurationOfUmbrellaA-dkh.1'.
    className := reference packageName asSymbol.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: className)).
    (MCClassDefinition
        name: className
        superclassName: #'Object'
        category: className
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: true
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectClassMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'version50Umbrella:'
        category: 'cat'
        timeStamp: ''
        source: self version50MethodSourceUmbrella)}.
    monticelloRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #())! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfAtomicFan' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline20MethodSourceFan

	^(self class sourceCodeAt: #baseline20Fan:) asString

! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
projectClassMethodSource

	^(self class class sourceCodeAt: #project) asString

! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfAtomicFan' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfAtomicFan
    "self reset"

    | reference className definitionArray |
    reference := GoferVersionReference name: 'MetacelloTestConfigurationOfAtomicFan-dkh.1'.
    className := reference packageName asSymbol.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: className)).
    (MCClassDefinition
        name: className
        superclassName: #'Object'
        category: className
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: true
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectClassMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'baseline20Fan:'
        category: 'cat'
        timeStamp: ''
        source: self baseline20MethodSourceFan).
    (MCMethodDefinition
        className: className asString
        selector: 'baseline31Fan:'
        category: 'cat'
        timeStamp: ''
        source: self baseline31MethodSourceFan).
    (MCMethodDefinition
        className: className asString
        selector: 'postLoad31baseline'
        category: 'cat'
        timeStamp: ''
        source: self postLoad31baselineMethodSource)}.
    monticelloRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #())! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfAtomicFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
version50MethodSourceFoo

	^(self class sourceCodeAt: #version50Foo:) asString

! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfAtomicFan' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline31MethodSourceFan

	^(self class sourceCodeAt: #baseline31Fan:) asString

! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfAtomicFan' stamp: 'dkh 6/12/2012 15:41:23.319'!
postLoad31baseline
	"Throw an error if GoferFar isn't loaded"

	Smalltalk at: #GoferFar ifAbsent: [ self error: 'GoferFar should be loaded' ]! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfAtomicFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline61Foo: spec 
	"self reset"
	<version: '6.1'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec 
			package: 'GoferFoo' with:'GoferFoo-lr.4';
			package: 'GoferBar' with: 'GoferBar-lr.1';
			package: 'GoferFaux' with: 'GoferFaux-tg.34';
			package: 'GoferBeau' with: 'GoferBeau-dkh.55';
			yourself.
		spec
			group: '1' with: #('GoferFoo' 'GoferBar');
			group: '2' with: #('GoferFoo' 'GoferBeau');
			yourself ].
! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfAtomicFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
version20MethodSourceFoo

	^(self class sourceCodeAt: #version20Foo:) asString

! !

!MetacelloAtomicConfigurationResource methodsFor: 'Issue 86' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfProjectIssue86
    "self reset"

    | reference className definitionArray |
    reference := GoferVersionReference name: 'MetacelloTestConfigurationOfProjectIssue86-dkh.1'.
    className := reference packageName asSymbol.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: className)).
    (MCClassDefinition
        name: className
        superclassName: #'Object'
        category: className
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: true
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectClassMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self linearProjectMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'baseline60ProjectIssue86:'
        category: 'cat'
        timeStamp: ''
        source: self baseline60MethodSourceProjectIssue86).
    (MCMethodDefinition
        className: className asString
        selector: 'baseline61ProjectIssue86:'
        category: 'cat'
        timeStamp: ''
        source: self baseline61MethodSourceProjectIssue86).
    (MCMethodDefinition
        className: className asString
        selector: 'baseline62ProjectIssue86:'
        category: 'cat'
        timeStamp: ''
        source: self baseline62MethodSourceProjectIssue86)}.
    monticelloRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #())! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfAtomicFan' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline31Fan: spec 
	"self reset"
	<version: '3.1-baseline'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec postLoadDoIt: #postLoad31baseline.
		spec 
			package: 'GoferBar';
			package: 'GoferBeau' with: [ 
				spec 
					requires: 'GoferBar';
					includes: #('GoferFoo' ) ]; 
			package: 'GoferFar' with: [ spec requires: #('GoferFoo' ) ]; 
			yourself.
		spec 
			project: 'GoferFoo' with: [ "requires GoferBeau"
				spec
					className: 'MetacelloTestConfigurationOfLinearFoo';
					versionString: '2.0';
					loads: 'GoferFoo';
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			yourself ].
! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfAtomicFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline60Foo: spec 
	"self reset"
	<version: '6.0'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec 
			package: 'GoferFoo' with:'GoferFoo-lr.4';
			package: 'GoferBar' with: 'GoferBar-lr.1';
			package: 'GoferFaux' with: 'GoferFaux-tg.34';
			package: 'GoferBeau' with: 'GoferBeau-dkh.55';
			yourself.
		spec
			group: '1' with: #('GoferFoo' 'GoferBar');
			group: '2' with: #('1' 'GoferFaux');
			yourself ].
! !

!MetacelloAtomicConfigurationResource methodsFor: 'Issue 86' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline62ProjectIssue86: spec 
	"projects and packages"
	"self reset"
	<version: '6.2'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec 
			project: 'A' with: [
				spec
					className: 'MetacelloTestConfigurationOfLinearFoo';
					versionString: '6.2';
					loads: #('1');
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			project: 'B' with: [
				spec
					className: 'MetacelloTestConfigurationOfLinearFoo';
					versionString: '6.2';
					loads: #('2');
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			yourself ].
! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfAtomicFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
version51Foo: spec 
	"self reset"
	<version: '5.1'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec blessing: #release.
		spec 
			package: 'GoferUmbrella' with: 'GoferUmbrella-lr.5';
			yourself ].
! !

!MetacelloAtomicConfigurationResource methodsFor: 'Issue 86' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline60MethodSourceProjectIssue86

	^(self class sourceCodeAt: #baseline60ProjectIssue86:) asString

! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfAtomicFan' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline20Fan: spec 
	"self reset"
	<version: '2.0-baseline'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec blessing: #baseline.
		spec 
			package: 'GoferFan';
			yourself ].
! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfUmbrella' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfUmbrellaB
    "self reset"

    | reference className definitionArray |
    reference := GoferVersionReference name: 'MetacelloTestConfigurationOfUmbrellaB-dkh.1'.
    className := reference packageName asSymbol.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: className)).
    (MCClassDefinition
        name: className
        superclassName: #'Object'
        category: className
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: true
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectClassMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'version51Umbrella:'
        category: 'cat'
        timeStamp: ''
        source: self version51MethodSourceUmbrella)}.
    monticelloRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #())! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfAtomicFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline20Foo: spec 
	"self reset"
	<version: '2.0-baseline'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec blessing: #baseline.
		spec 
			package: 'GoferBar';
			package: 'GoferFoo';
			package: 'GoferBeau';
			package: 'GoferFaux';
			yourself ].
! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfAtomicFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline62MethodSourceFoo

	^(self class sourceCodeAt: #baseline62Foo:) asString

! !

!MetacelloAtomicConfigurationResource methodsFor: 'running' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUp
	super setUp.
	self
		setUpMonticelloRepository;
		setUpConfigurationOfAtomicFoo;
		setUpConfigurationOfLinearFoo;
		setUpConfigurationOfAtomicFan;
		setUpConfigurationOfUmbrellaA;
		setUpConfigurationOfUmbrellaB;
		setUpConfigurationOfProjectIssue86;
		yourself! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfAtomicFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline25MethodSourceFoo

	^(self class sourceCodeAt: #baseline25Foo:) asString

! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfAtomicFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfAtomicFoo
    "self reset"

    | reference className definitionArray |
    reference := GoferVersionReference name: 'MetacelloTestConfigurationOfAtomicFoo-dkh.1'.
    className := reference packageName asSymbol.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: className)).
    (MCClassDefinition
        name: className
        superclassName: #'Object'
        category: className
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: true
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectClassMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'baseline20Foo:'
        category: 'cat'
        timeStamp: ''
        source: self baseline20MethodSourceFoo).
    (MCMethodDefinition
        className: className asString
        selector: 'baseline25Foo:'
        category: 'cat'
        timeStamp: ''
        source: self baseline25MethodSourceFoo).
    (MCMethodDefinition
        className: className asString
        selector: 'version20Foo:'
        category: 'cat'
        timeStamp: ''
        source: self version20MethodSourceFoo)}.
    monticelloRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #())! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfAtomicFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline61MethodSourceFoo

	^(self class sourceCodeAt: #baseline61Foo:) asString

! !

!MetacelloAtomicConfigurationResource methodsFor: 'Issue 86' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline61MethodSourceProjectIssue86

	^(self class sourceCodeAt: #baseline61ProjectIssue86:) asString

! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfUmbrella' stamp: 'dkh 6/12/2012 15:41:23.319'!
version51MethodSourceUmbrella

	^(self class sourceCodeAt: #version51Umbrella:) asString

! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfAtomicFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfLinearFoo
    "self reset"

    | reference className definitionArray |
    reference := GoferVersionReference name: 'MetacelloTestConfigurationOfLinearFoo-dkh.1'.
    className := reference packageName asSymbol.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: className)).
    (MCClassDefinition
        name: className
        superclassName: #'Object'
        category: className
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: true
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectClassMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self linearProjectMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'baseline20Foo:'
        category: 'cat'
        timeStamp: ''
        source: self baseline20MethodSourceFoo).
    (MCMethodDefinition
        className: className asString
        selector: 'version20Foo:'
        category: 'cat'
        timeStamp: ''
        source: self version20MethodSourceFoo).
    (MCMethodDefinition
        className: className asString
        selector: 'version50Foo:'
        category: 'cat'
        timeStamp: ''
        source: self version50MethodSourceFoo).
    (MCMethodDefinition
        className: className asString
        selector: 'version51Foo:'
        category: 'cat'
        timeStamp: ''
        source: self version51MethodSourceFoo).
    (MCMethodDefinition
        className: className asString
        selector: 'baseline60Foo:'
        category: 'cat'
        timeStamp: ''
        source: self baseline60MethodSourceFoo).
    (MCMethodDefinition
        className: className asString
        selector: 'baseline61Foo:'
        category: 'cat'
        timeStamp: ''
        source: self baseline61MethodSourceFoo).
    (MCMethodDefinition
        className: className asString
        selector: 'baseline62Foo:'
        category: 'cat'
        timeStamp: ''
        source: self baseline62MethodSourceFoo)}.
    monticelloRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #())! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfAtomicFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline20MethodSourceFoo

	^(self class sourceCodeAt: #baseline20Foo:) asString

! !

!MetacelloAtomicConfigurationResource methodsFor: 'Issue 86' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline61ProjectIssue86: spec 
	"projects and packages"
	"self reset"
	<version: '6.1'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec 
			project: 'A' with: [
				spec
					className: 'MetacelloTestConfigurationOfLinearFoo';
					versionString: '6.1';
					loads: #('1');
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			project: 'B' with: [
				spec
					className: 'MetacelloTestConfigurationOfLinearFoo';
					versionString: '6.1';
					loads: #('2');
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			yourself ].
! !

!MetacelloAtomicConfigurationResource methodsFor: 'ConfigurationOfAtomicFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
version50Foo: spec 
	"self reset"
	<version: '5.0'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec blessing: #release.
		spec 
			package: 'GoferUmbrella' with: 'GoferUmbrella-dkh.4';
			yourself ].
! !

!MetacelloAtomicConfigurationResource class methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
project

	^self new project! !

!MetacelloAtomicLoadDirective methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
postloads

	postloads == nil ifTrue: [ postloads := OrderedCollection new ].
	^ postloads! !

!MetacelloAtomicLoadDirective methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
finalizeLoad: aGofer
	"load the accumulated packages (if any), reset the package list"

	| pkgLoads |
	self preloads do: [:directive | super loadPreloadDirective: directive ].
	preloads := nil.
	(pkgLoads := self packageloads) notEmpty 
		ifTrue: [
			self loader loadingSpecLoader 
				loadPackageDirectives: pkgLoads 
				gofer: aGofer.
			self packageloads: nil ].
	self postloads do: [:directive | super loadPostloadDirective: directive ].
	postloads := nil! !

!MetacelloAtomicLoadDirective methodsFor: 'enumerating' stamp: 'dkh 6/8/2012 14:04:22'!
directivesDo: aBlock

	aBlock value: self.
	self preloads do: [:directive | directive directivesDo: aBlock ].
	self loadDirectives do: [:directive | directive directivesDo: aBlock ].
	self postloads do: [:directive | directive directivesDo: aBlock ].
! !

!MetacelloAtomicLoadDirective methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
loadUsing: aLoaderDirective gofer: aGofer

	self loadDirectives isEmpty ifTrue: [ ^self ].
	aLoaderDirective loadAtomicLoadDirective: self gofer: aGofer.
! !

!MetacelloAtomicLoadDirective methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
loadPostloadDirective: aPostloadDirective
	"accumulate postloads"

	self postloads add: aPostloadDirective! !

!MetacelloAtomicLoadDirective methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
packageloads

	packageloads == nil ifTrue: [ packageloads := OrderedCollection new ].
	^ packageloads! !

!MetacelloAtomicLoadDirective methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
packageloads: anObject
	packageloads := anObject! !

!MetacelloAtomicLoadDirective methodsFor: 'enumerating' stamp: 'dkh 6/8/2012 14:04:22'!
prepostLoadDirectivesDo: aBlock

	self preloads do: [:directive | directive prepostLoadDirectivesDo: aBlock ].
	self loadDirectives do: [:directive | directive prepostLoadDirectivesDo: aBlock ].
	self postloads do: [:directive | directive prepostLoadDirectivesDo: aBlock ].! !

!MetacelloAtomicLoadDirective methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
loadPreloadDirective: aPreloadDirective 
	"accumulate preloads"

	self preloads add: aPreloadDirective! !

!MetacelloAtomicLoadDirective methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
title

	^'atomic load'! !

!MetacelloAtomicLoadDirective methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
loadPackageDirective: aPackageLoadDirective gofer: aGofer
	"accumulate packages"
	
	self packageloads add: aPackageLoadDirective! !

!MetacelloAtomicLoadDirective methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
loadAtomicLoadDirective: aLoaderDirective gofer: aGofer

	aLoaderDirective loadDirectives do: [:directive | directive loadUsing: self gofer: aGofer ].
! !

!MetacelloAtomicLoadDirective methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
loadLinearLoadDirective: aLoaderDirective gofer: aGofer

	self finalizeLoad: aGofer.
	super loadLinearLoadDirective: aLoaderDirective gofer: aGofer! !

!MetacelloAtomicLoadDirective methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
preloads

	preloads == nil ifTrue: [ preloads := OrderedCollection new ].
	^ preloads! !

!MetacelloAtomicLoadDirective methodsFor: 'enumerating' stamp: 'dkh 6/8/2012 14:04:22'!
prepostLoadsDo: aBlock

	self preloads do: [:directive | directive prepostLoadDo: aBlock ].
	self loadDirectives do: [:directive | directive prepostLoadDo: aBlock ].
	self postloads do: [:directive | directive prepostLoadDo: aBlock ].
	! !

!MetacelloAtomicMonticelloResource methodsFor: 'running' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUp
	super setUp.
	self
		setUpVersionReferences;
		setUpMonticelloRepository;
		setUpDependency;
		setUpNewerDependency! !

!MetacelloAtomicMonticelloResource methodsFor: 'running' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpNewerDependency
	"self reset"

	| reference |
	reference := GoferVersionReference name: 'GoferUmbrella-lr.5'.
	monticelloRepository basicStoreVersion: (MCVersion new
		setPackage:  (MetacelloTestsMCPackage new name: reference packageName)
		info: (MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: #())
		snapshot: (MCSnapshot fromDefinitions: (Array
				with: (MCOrganizationDefinition categories: (Array with: reference packageName asSymbol))
				with: (MCClassDefinition name: (reference packageName copyWithout: $-) asSymbol superclassName: #Object category: reference packageName asSymbol instVarNames: #() comment: '')))
		dependencies: (Array 
				with: (MCVersionDependency 
						package: (MetacelloTestsMCPackage new name: 'GoferBarDependency') 
						info: (monticelloRepository versionInfoFromVersionNamed: 'GoferBarDependency-lr.35')) 
				with: (MCVersionDependency 
						package: (MetacelloTestsMCPackage new name: 'GoferFooDependency') 
						info: (monticelloRepository versionInfoFromVersionNamed: 'GoferFooDependency-lr.35'))))! !

!MetacelloAtomicMonticelloResource methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
monticelloRepository
	^ monticelloRepository! !

!MetacelloAtomicMonticelloResource methodsFor: 'running' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpMonticelloRepository
	"This method builds a fake repository with the version references from #buildReferences."

	monticelloRepository := MCDictionaryRepository new.
	versionReferences do: [ :assoc | | reference superclassName |
		reference := assoc key.
		superclassName := assoc value.
		monticelloRepository basicStoreVersion: (MCVersion new
			setPackage:  (MetacelloTestsMCPackage new name: reference packageName)
			info: (MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: #())
			snapshot: (MCSnapshot fromDefinitions: (Array
				with: (MCOrganizationDefinition categories: (Array with: reference packageName asSymbol))
				with: (MCClassDefinition name: (reference packageName copyWithout: $-) asSymbol superclassName: superclassName category: reference packageName asSymbol instVarNames: #() comment: '')))
			dependencies: #()) ]! !

!MetacelloAtomicMonticelloResource methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
versionReferences
	^ versionReferences! !

!MetacelloAtomicMonticelloResource methodsFor: 'running' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpDependency
	"self reset"

	| reference |
	reference := GoferVersionReference name: 'GoferUmbrella-dkh.4'.
	monticelloRepository basicStoreVersion: (MCVersion new
		setPackage:  (MetacelloTestsMCPackage new name: reference packageName)
		info: (MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: #())
		snapshot: (MCSnapshot fromDefinitions: (Array
				with: (MCOrganizationDefinition categories: (Array with: reference packageName asSymbol))
				with: (MCClassDefinition name: (reference packageName copyWithout: $-) asSymbol superclassName: #Object category: reference packageName asSymbol instVarNames: #() comment: '')))
		dependencies: (Array 
				with: (MCVersionDependency 
						package: (MetacelloTestsMCPackage new name: 'GoferBarDependency') 
						info: (monticelloRepository versionInfoFromVersionNamed: 'GoferBarDependency-lr.30')) 
				with: (MCVersionDependency 
						package: (MetacelloTestsMCPackage new name: 'GoferFooDependency') 
						info: (monticelloRepository versionInfoFromVersionNamed: 'GoferFooDependency-lr.30'))))! !

!MetacelloAtomicMonticelloResource methodsFor: 'running' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpVersionReferences
	"self reset"

	versionReferences := OrderedCollection new.
	versionReferences
		add: ((GoferVersionReference name: 'GoferFan-dkh.1') -> #GoferFar);
		add: ((GoferVersionReference name: 'GoferBar-dkh.1') -> #Object);
		add: ((GoferVersionReference name: 'GoferFoo-dkh.4') -> #GoferBeau);
		add: ((GoferVersionReference name: 'GoferFoo-dkh.5') -> #GoferBeau);
		add: ((GoferVersionReference name: 'GoferBeau-dkh.15') -> #GoferBar);
		add: ((GoferVersionReference name: 'GoferFaux-tg.30') -> #Object);
		add: ((GoferVersionReference name: 'GoferFar-dkh.4') -> #GoferFoo);
		add: ((GoferVersionReference name: 'GoferBarDependency-dkh.4') -> #Object);
		add: ((GoferVersionReference name: 'GoferFooDependency-lr.4') -> #Object);
		add: ((GoferVersionReference name: 'GoferBarDependency-lr.30') -> #Object);
		add: ((GoferVersionReference name: 'GoferFooDependency-lr.30') -> #Object);
		add: ((GoferVersionReference name: 'GoferBarDependency-lr.35') -> #Object);
		add: ((GoferVersionReference name: 'GoferFooDependency-lr.35') -> #Object);
		yourself
	! !

!MetacelloBaseConfiguration commentStamp: 'dkh 5/30/2012 13:50'!
You should be using ConfigurationOf instead of MetacelloBaseConfiguration. 

The class is being kept around because many extant Metacello configurations use MetacelloBaseConfiguration as a sentinel class to indicate whether or not Metacello is loaded..

Once the Metacello scripting API becomes prevalent (the api has it's own ensureMetacello logic) this class can be removed.!
!MetacelloBaselineConstructor commentStamp: 'dkh 5/4/2012 17:05'!
##MetacelloBaselineConstructor

**MetacelloBaselineConstructor** extracts the #baseline pragma from a **BaselineOfConfiguration** and produces a **MetacelloVersion**:.

```Smalltalk
MetacelloBaselineConstructor on: BaselineOfExample
```
!
!MetacelloBaselineConstructor methodsFor: 'pragma extraction' stamp: 'dkh 6/5/2012 19:01:24'!
extractBaselinePragmaFor: aClass
    | pragmas |
    pragmas := Pragma allNamed: #'baseline' in: aClass.
    pragmas isEmpty
        ifTrue: [ ^ self error: 'No #baseline pragma found' ].
    ^ pragmas first! !

!MetacelloBaselineConstructor methodsFor: 'initialization' stamp: 'dkh 6/5/2012 19:01:24'!
on: aConfig
    self calculate: aConfig project: nil! !

!MetacelloBaselineConstructor methodsFor: 'private' stamp: 'dkh 6/18/2012 15:05'!
calculate: aConfig project: aProject
    | pragma versionMap versionSpec |
    self configuration: aConfig.
    pragma := self extractBaselinePragmaFor: aConfig class.
    self
        setProject:
            (aProject
                ifNil: [ 
                    [ aConfig class project ]
                        on: MessageNotUnderstood
                        do: [ :ex | ex return: nil ] ]).
    versionSpec := self project versionSpec.
    self root: versionSpec.
    self evaluatePragma: pragma.
    versionMap := Dictionary new.
    self project attributes
        do: [ :attribute | 
            | blockList |
            (blockList := self attributeMap at: attribute ifAbsent: [  ]) ~~ nil
                ifTrue: [ blockList do: [ :block | self with: versionSpec during: block ] ] ].
    versionSpec versionString: self project singletonVersionName.
    versionMap at: versionSpec versionString put: versionSpec createVersion.
    self project map: versionMap.
    self project configuration: aConfig! !

!MetacelloBaselineConstructor methodsFor: 'initialization' stamp: 'dkh 6/5/2012 19:01:24'!
on: aConfig project: aProject
    self calculate: aConfig project: aProject! !

!MetacelloBaselineConstructor methodsFor: '*metacello-mc-accessing' stamp: 'dkh 6/5/2012 19:01:24'!
projectClass
    ^ MetacelloMCBaselineProject! !

!MetacelloBaselineConstructor class methodsFor: 'instance creation' stamp: 'dkh 6/5/2012 19:01:24'!
on: aConfig
    ^ self new
        on: aConfig;
        yourself! !

!MetacelloBaselineConstructor class methodsFor: 'instance creation' stamp: 'dkh 6/18/2012 14:49'!
on: aConfig project: aProject
    ^ self new
        on: aConfig project: aProject;
        yourself! !

!MetacelloBaselineSpecGenerator methodsFor: 'accessing' stamp: 'dkh 7/16/2012 11:28'!
projectSpecLookupBlock
    ^ [ :projectName | 
    {(MetacelloProjectRegistration
        projectSpecForClassNamed: (MetacelloScriptEngine baselineNameFrom: projectName)
        ifAbsent: [  ])} ]! !

!MetacelloBaselineSpecGenerator methodsFor: 'accessing' stamp: 'dkh 7/16/2012 10:43'!
projectSpecCreationBlock
    ^ [ :projectName | {(MetacelloMCBaselineProject new baselineOfProjectSpec name: projectName)} ]! !

!MetacelloBaselineSpecGenerator methodsFor: 'accessing' stamp: 'dkh 7/16/2012 10:44'!
projectSpecListBlock
    ^ [ MetacelloProjectRegistration baselineProjectSpecs ]! !

!MetacelloCachingGoferResolvedReference methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
workingCopy
	"Answer a working copy or throw an error if not present."

	| pName |
	cachedVersion == nil ifTrue: [ ^super workingCopy ].
	pName := cachedVersion package name.
	^MCWorkingCopy allManagers
		detect: [ :each | pName = each packageName ]
		ifNone: [ self error: 'Working copy for ' , self name , ' not found' ]! !

!MetacelloCachingGoferResolvedReference methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
version
	"Answer a Monticello version of the receiver."

	cachedVersion == nil ifTrue: [ cachedVersion := super version ].
	^cachedVersion! !

!MetacelloCannotUpdateReleasedVersionError methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
isResumable
	"Determine whether an exception is resumable."

	^ true! !

!MetacelloCleanNotification methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
version: anObject
	version := anObject! !

!MetacelloCleanNotification methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
version
	^ version! !

!MetacelloCleanNotification methodsFor: 'signaling' stamp: 'dkh 6/5/2012 19:01:24'!
signal: aMetacelloVersion

	self version: aMetacelloVersion.
	^ self signal! !

!MetacelloCleanNotification class methodsFor: 'exceptioninstantiator' stamp: 'dkh 6/5/2012 19:01:24'!
signal: aMetacelloVersion

	^ self new signal: aMetacelloVersion! !

!MetacelloClearStackCacheNotification methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
cacheNames
	^ cacheNames! !

!MetacelloClearStackCacheNotification methodsFor: 'signaling' stamp: 'dkh 6/5/2012 19:01:24'!
signal: anArray
	"Signal the occurrence of an exceptional condition with a specified cacheName."

	self cacheNames: anArray.
	^ self signal! !

!MetacelloClearStackCacheNotification methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
cacheNames: anArray
	cacheNames := anArray! !

!MetacelloCommonMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
ignoreImage

	^self loaderPolicy ignoreImage! !

!MetacelloCommonMCSpecLoader methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
doingLoads: aBlock
	"escape mechanism for recording and null loaders to skip doing loaderlike things"
	
	aBlock value! !

!MetacelloCommonMCSpecLoader methodsFor: 'packages' stamp: 'dkh 6/8/2012 14:04:22'!
nameComponentsFrom: aVersionName

	^self class nameComponentsFrom: aVersionName! !

!MetacelloCommonMCSpecLoader methodsFor: 'versionInfo' stamp: 'dkh 6/8/2012 14:04:22'!
currentVersionInfoFor: packageSpec

	| cacheKey vi |
	cacheKey := packageSpec file.
	^MetacelloPlatform current
		stackCacheFor: #currentVersionInfo
		at: cacheKey
		doing: [ :cache | 
			vi := packageSpec currentVersionInfo.
			cache at: cacheKey put: vi ].
! !

!MetacelloCommonMCSpecLoader methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
resolvePackageSpecReferences: packageSpec gofer: gofer

	|  versionReference references localGofer |
	localGofer := gofer.
	self hasRepositoryOverrides not
		ifTrue: [
			packageSpec repositorySpecs notEmpty
				ifTrue: [ 
					localGofer := MetacelloGofer new.
					(self repositoriesFrom: packageSpec repositorySpecs) do: [:repo | localGofer repository: repo ]]].
	(packageSpec getFile == nil or: [ self shouldDisablePackageCache ])
		ifTrue: [ 
			"don't use package-cache when trying to get latest version"
			localGofer disablePackageCache ].
	versionReference := packageSpec goferLoaderReference.
	references := versionReference resolveAllWith: localGofer.
	localGofer enablePackageCache.
	^references! !

!MetacelloCommonMCSpecLoader methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
loadPackageDirectives: pkgLoads gofer: aGofer

	MetacelloPlatform current
		do:  [ | goferLoad loadBlock answers |
			goferLoad := MetacelloGoferLoad on: aGofer.
			answers := OrderedCollection new.
			pkgLoads do: [:packageLoadDirective | | resolvedReference |
				aGofer disablePackageCache. "for good luck:)"
				(resolvedReference := self 
						resolvePackageSpec: packageLoadDirective spec 
						gofer: aGofer) ~~ nil
					ifTrue: [ 
						goferLoad addResolved: resolvedReference.
						answers addAll: packageLoadDirective spec answers.
						packageLoadDirective resolvedReference:  resolvedReference ]].
			Transcript cr; show: 'Starting atomic load'.
			loadBlock := [
				"pkgLoads do: [:packageLoadDirective |  mcLoader preLoad: packageLoadDirective spec ]."
				goferLoad execute.
				pkgLoads do: [:packageLoadDirective |
					packageLoadDirective resolvedReference == nil
						ifTrue: [ Transcript cr; tab; show: 'Already Loaded -> ', packageLoadDirective file ]
						ifFalse: [ Transcript cr; tab; show: 'Loaded -> ', packageLoadDirective file, ' --- ',  packageLoadDirective repository description, ' --- ', packageLoadDirective resolvedReference repository description.
					packageLoadDirective resolvedReference workingCopy repositoryGroup addRepository: packageLoadDirective repository ]].
				MetacelloPlatform current clearCurrentVersionCache.
				"pkgLoads do: [:packageLoadDirective | 
					packageLoadDirective resolvedReference ~~ nil
						ifTrue: [mcLoader postLoad: packageLoadDirective spec ]]"].
			answers notEmpty
				ifTrue: [ loadBlock valueSupplyingMetacelloAnswers: answers ]
				ifFalse: [ loadBlock value].
			Transcript cr; show: 'Finished atomic load' ]
		displaying: 'Atomic Load...'.
! !

!MetacelloCommonMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
loadingSpecLoader

	^self! !

!MetacelloCommonMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
shouldDisablePackageCache

	disablePackageCache == nil ifTrue: [ disablePackageCache := false ].
	^ disablePackageCache! !

!MetacelloCommonMCSpecLoader methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
linearLoadPackageSpec: packageSpec gofer: gofer

	self subclassResponsibility! !

!MetacelloCommonMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
operator: aSymbol

	operator := aSymbol! !

!MetacelloCommonMCSpecLoader methodsFor: 'initialize-release' stamp: 'dkh 6/8/2012 14:04:22'!
initialize

	self loaderPolicy! !

!MetacelloCommonMCSpecLoader methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
linearLoadPackageSpecs: packageSpecs repositories: repositories
	
	| gofer |
	gofer := MetacelloGofer new.
	repositories do: [:repo | gofer repository: repo ].
	packageSpecs do: [:pkg | pkg loadUsing: self gofer: gofer ].
! !

!MetacelloCommonMCSpecLoader methodsFor: 'actions' stamp: 'dkh 7/5/2012 20:26'!
loadPackageDirective: aPackageLoadDirective gofer: aGofer
	| packageSpec |
	packageSpec := aPackageLoadDirective spec.
	MetacelloPlatform current
		do: [ 
			| loadBlock goferLoad answers resolvedReference |
			aGofer disablePackageCache.	"for good luck:)"
			resolvedReference := self resolvePackageSpec: packageSpec gofer: aGofer.
			resolvedReference isNil
				ifTrue: [ 
					"Package version already loaded into image"
					^ self ].
			loadBlock := [ 
			"mcLoader preLoad: packageSpec."
			goferLoad := MetacelloGoferLoad on: aGofer.
			goferLoad addResolved: resolvedReference.
			goferLoad execute.
			MetacelloPlatform current clearCurrentVersionCache	"mcLoader postLoad: packageSpec" ].
			(answers := packageSpec answers) notEmpty
				ifTrue: [ loadBlock valueSupplyingMetacelloAnswers: answers ]
				ifFalse: [ loadBlock value ].
			resolvedReference workingCopy repositoryGroup addRepository: aPackageLoadDirective repository.
			Transcript
				cr;
				show:
						'Loaded -> ' , resolvedReference name , ' --- ' , aPackageLoadDirective repository description , ' --- '
								, resolvedReference repository description ]
		displaying: 'Loading ' , packageSpec file! !

!MetacelloCommonMCSpecLoader methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
load
	| repos |
	repos := self repositoriesFrom: self spec repositorySpecs.
	^ self loadType == #atomic
		ifTrue: [self atomicLoadPackageSpecs: self spec packageSpecsInLoadOrder repositories: repos]
		ifFalse: ["assume #linear"
			self linearLoadPackageSpecs: self spec packageSpecsInLoadOrder repositories: repos ]
! !

!MetacelloCommonMCSpecLoader methodsFor: 'versionInfo' stamp: 'dkh 6/8/2012 14:04:22'!
ancestorsFor: packageSpec

	| cacheKey vi |
	cacheKey := packageSpec file.
	^MetacelloPlatform current
		stackCacheFor: #ancestors
		at: cacheKey
		doing: [ :cache | 
			vi := packageSpec ancestors.
			cache at: cacheKey put: vi ].
! !

!MetacelloCommonMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
loaderPolicy: anObject
	loaderPolicy := anObject! !

!MetacelloCommonMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
recordingSpecLoader

	^(MetacelloNullRecordingMCSpecLoader on: self spec)
		shouldDisablePackageCache: self shouldDisablePackageCache;
		loaderPolicy: self loaderPolicy copy;
		yourself! !

!MetacelloCommonMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
repositoryMap

	^self loaderPolicy repositoryMap! !

!MetacelloCommonMCSpecLoader methodsFor: 'repositories' stamp: 'dkh 6/8/2012 14:04:22'!
repositoriesFrom: aMetacelloMVRepositorySpecs

	^self repositoriesFrom: aMetacelloMVRepositorySpecs ignoreOverrides: false! !

!MetacelloCommonMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
operator

	operator == nil ifTrue: [ ^#= ].
	^operator! !

!MetacelloCommonMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
fetchingSpecLoader

	^self! !

!MetacelloCommonMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
shouldDisablePackageCache: anObject
	disablePackageCache := anObject! !

!MetacelloCommonMCSpecLoader methodsFor: 'repositories' stamp: 'dkh 6/8/2012 14:04:22'!
repositoriesFrom: aMetacelloMVRepositorySpecs ignoreOverrides: ignoreOverrides

	| repositories repos |
	(ignoreOverrides not and: [self hasRepositoryOverrides]) ifTrue: [ ^self loaderPolicy overrideRepositories ].
	repositories := MCRepositoryGroup default repositories.
	repos := OrderedCollection new.
	aMetacelloMVRepositorySpecs do: [:aSpec | | description repo |
		description := aSpec description.
		(repo := repositories detect: [:rep | rep description = description ] ifNone: [ aSpec createRepository ]) ~~ nil
			ifTrue: [ repos add: repo ]].
	^repos
! !

!MetacelloCommonMCSpecLoader methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
doLoad

	self subclassResponsibility! !

!MetacelloCommonMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
ensureSpecLoader
	^ self! !

!MetacelloCommonMCSpecLoader methodsFor: 'private' stamp: 'dkh 6/17/2012 19:52'!
retryingResolvePackageSpecReferences: packageSpec gofer: gofer
    | retryCount references repositoryError |
    retryCount := 0.
    references := #().
    [ references isEmpty and: [ retryCount < 3 ] ]
        whileTrue: [ 
            retryCount > 0
                ifTrue: [ 
                    Transcript
                        cr;
                        show: '...RETRY->' , packageSpec file ].
            references := [ self resolvePackageSpecReferences: packageSpec gofer: gofer ]
                on: Error , GoferRepositoryError
                do: [ :ex | 
                    self class retryPackageResolution
                        ifFalse: [ ex pass ].
                    retryCount >= 2
                        ifTrue: [ 
                            (ex isKindOf: GoferRepositoryError)
                                ifTrue: [ 
                                    "ignore repository errors at this point, in case an alternate repository is in the list "
                                    Transcript
                                        cr;
                                        show: 'gofer repository error: ' , ex description printString , '...ignoring'.
                                    repositoryError := ex.
                                    ex resume: #() ]
                                ifFalse: [ ex pass ] ].
                    ex return: #() ].
            retryCount := retryCount + 1 ].
    references isEmpty
        ifTrue: [ 
            Transcript
                cr;
                show: '...FAILED->' , packageSpec file.
            (MetacelloPackageSpecResolutionError new
                packageSpec: packageSpec;
                repositories: gofer repositories;
                repositoryError: repositoryError;
                yourself) signal ].
    ^ references! !

!MetacelloCommonMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
loaderPolicy

	loaderPolicy == nil ifTrue: [ loaderPolicy := MetacelloLoaderPolicy new ].
	^loaderPolicy! !

!MetacelloCommonMCSpecLoader methodsFor: 'doits' stamp: 'dkh 6/8/2012 14:04:22'!
preLoad: packageOrVersionSpec

	self subclassResponsibility! !

!MetacelloCommonMCSpecLoader methodsFor: 'testing' stamp: 'dkh 6/8/2012 14:04:22'!
hasRepositoryOverrides

	^self loaderPolicy hasRepositoryOverrides! !

!MetacelloCommonMCSpecLoader methodsFor: 'doits' stamp: 'dkh 6/8/2012 14:04:22'!
postLoad: packageOrVersionSpec
	"subclassResponsibility, but it gets called during an upgrade, so leave it as NOOP"! !

!MetacelloCommonMCSpecLoader methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
resolvePackageSpec: packageSpec gofer: gofer

	|  references resolvedReference mcVersion loadedVersionInfos |
	references := self retryingResolvePackageSpecReferences: packageSpec gofer: gofer.
	resolvedReference := references last asMetacelloCachingResolvedReference.
	mcVersion := resolvedReference version.
	(loadedVersionInfos := self ancestorsFor: packageSpec) ~~ nil
		ifTrue: [ 
			loadedVersionInfos do: [:info | info name = mcVersion info name 
				ifTrue: [ 
					"package already loaded, don't load again"
					^nil ]]].
	^resolvedReference! !

!MetacelloCommonMCSpecLoader methodsFor: 'testing' stamp: 'dkh 07/28/2013 16:10'!
ensureForDevelopment
  ^ true! !

!MetacelloCommonMCSpecLoader class methodsFor: 'accessing' stamp: 'dkh 6/17/2012 19:51'!
retryPackageResolution
    "if true, 
		errors during #retryingResolvePackageSpecReferences:gofer: are caught and 
		the resolution is retried 3 times. After the thrid time, a MetacelloPackageSpecResolutionError
		is thrown
	if false,
		an error during #retryingResolvePackageSpecReferences:gofer: will be passed,
		likely resulting in a walkback ... useful for debugging."

    RetryPackageResolution ifNil: [ RetryPackageResolution := true ].
    ^ RetryPackageResolution! !

!MetacelloCommonMCSpecLoader class methodsFor: 'accessing' stamp: 'dkh 6/17/2012 19:48'!
retryPackageResolution: aBool
    RetryPackageResolution := aBool! !

!MetacelloCommonMCSpecLoader class methodsFor: 'utilities' stamp: 'dkh 6/8/2012 14:04:22'!
nameComponentsFrom: aVersionName
	| ar |
	ar := (aVersionName last isDigit and: [ (aVersionName indexOf: $.) > 0 ])ifFalse: [Array with: aVersionName with: '' with: 0 with: aVersionName with: self]
		ifTrue: [ | vrsn str |
			str := ((aVersionName copyAfterLast: $-) copyAfterLast: $.).
			vrsn := str isEmpty
				ifTrue: [0]
				ifFalse: [str asInteger].
			Array
				with: (aVersionName copyUpToLast:  $-)								"base pkg name"
				with: ((aVersionName copyAfterLast: $-) copyUpTo: $.)				"user"
				with:  vrsn "version"
				with: aVersionName
				with: self ].
	^ar! !

!MetacelloCommonVersionNumberTestCase methodsFor: 'test alpha/numeric version numbers' stamp: 'dkh 6/22/2012 14:40'!
testAlphaNumericVersion2

	self assert: ((self versionClass fromString: '2.9.0-alpha.2') < (self versionClass fromString: '2.9.0-alpha.3')).
! !

!MetacelloCommonVersionNumberTestCase methodsFor: 'test alpha/numeric version numbers' stamp: 'dkh 6/22/2012 14:40'!
testAlphaNumericVersion4

	self assert: ((self versionClass fromString: '2.9.9-alpha.2') < (self versionClass fromString: '2.9.9')).
! !

!MetacelloCommonVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 14:36'!
testVersion04

	| v1 v2 |
	v1 := self versionClass fromString: '1.0.1'.
	v2 := self versionClass fromString: '1.0.0'.
	self assert: (v1 > v2)! !

!MetacelloCommonVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 14:39'!
testVersion22

	self assert: (MetacelloVersionNumber fromString: '3.0.0') collapseZeros size = 1.
	self assert: (MetacelloVersionNumber fromString: '3.0.0') = (MetacelloVersionNumber fromString: '3.0').
	self assert: (MetacelloVersionNumber fromString: '3.0') = (MetacelloVersionNumber fromString: '3.0.0').

! !

!MetacelloCommonVersionNumberTestCase methodsFor: 'test alpha/numeric version numbers' stamp: 'dkh 6/22/2012 15:02'!
testAlphaNumericVersion1

	"Use numeric comparison for pure numbers. If you non-numeric version separate with '-'"
	
	| x y |
	self assert: ((x := self versionClass fromString: '2.9.0') < (y := self versionClass fromString: '2.10.0')).
! !

!MetacelloCommonVersionNumberTestCase methodsFor: 'private' stamp: 'dkh 6/22/2012 12:13'!
versionClass
    ^ self subclassResponsibility! !

!MetacelloCommonVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 14:39'!
testVersion23

	self assert: (MetacelloVersionNumber fromString: '3.0.0.-rc.1') = (MetacelloVersionNumber fromString: '3.0.0-rc.1').
	self assert: (MetacelloVersionNumber fromString: '3.0') > (MetacelloVersionNumber fromString: '3.0-rc.1').
	self assert: (MetacelloVersionNumber fromString: '3') > (MetacelloVersionNumber fromString: '3-rc.1').
	self assert: (MetacelloVersionNumber fromString: '3.-rc.1') = (MetacelloVersionNumber fromString: '3.0.0-rc.1').
	self assert: (MetacelloVersionNumber fromString: '3.0.-rc.1') = (MetacelloVersionNumber fromString: '3.0.0-rc.1').
	self assert: (MetacelloVersionNumber fromString: '3') > (MetacelloVersionNumber fromString: '3.0-rc.1').
	self assert: (MetacelloVersionNumber fromString: '3.0') > (MetacelloVersionNumber fromString: '3.0.0-rc.1').

! !

!MetacelloCommonVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 14:39'!
testVersion25

	self assert: ((MetacelloVersionNumber fromString: '1.0-beta.24.0.1') < (MetacelloVersionNumber fromString: '1.0-beta.28')).
! !

!MetacelloCommonVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 14:36'!
testVersion02

	| v1 v2 |
	v1 := self versionClass fromString: '1.1.1'.
	v2 := self versionClass fromString: '1.0.0'.
	self assert: (v1 = v1).	
	self assert: (v2 = v2).
	self assert: (v1 > v2)! !

!MetacelloCommonVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 14:36'!
testVersion01

	self assert: ((self versionClass fromString: '1.1.1') versionString = '1.1.1')! !

!MetacelloCommonVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 14:37'!
testVersion14

	self assert: ((self versionClass fromString: '2.9.0-alpha02') < (self versionClass fromString: '2.9.0-alpha03')).
! !

!MetacelloCommonVersionNumberTestCase methodsFor: 'test alpha/numeric version numbers' stamp: 'dkh 6/22/2012 14:40'!
testAlphaNumericVersion3

	self assert: ((self versionClass fromString: '2.9.9-alpha.2') < (self versionClass fromString: '2.9.10')).
! !

!MetacelloCommonVersionNumberTestCase class methodsFor: 'testing' stamp: 'dkh 6/22/2012 12:13'!
isAbstract
    "Override to true if a TestCase subclass is Abstract and should not have
	TestCase instances built from it"

    ^ self name = #'MetacelloCommonVersionNumberTestCase'! !

!MetacelloConfigTemplate commentStamp: '<historical>'!
Copy me to create a new configuration or edit and evaluate the following doits.

        "Create configuration class and initial baseline method"

        MetacelloToolBox 
                createBaseline: '1.0-baseline'
                for: 'MyProject'
                repository: 'http://www.example.com/MyProjectRepository'
                requiredProjects: #('Gofer')
                packages: #('MyProject-Core' 'MyProject-Tests')
                dependencies:
                        {('MyProject-Core' -> #('Gofer')).
                         ('MyProject-Tests' -> #('MyProject-Core'))}
                groups:
                        {('default' -> #('Core')).
                        ('Core' -> #('MyProject-Core')).
                        ('Tests' -> #('MyProject-Tests'))}.

	   "create initial development method from the baseline"

         MetacelloToolBox
               createDevelopment: '1.0'
               for: 'MyProject'
                importFromBaseline: '1.0-baseline'
                description: 'initial version'.
!
!MetacelloConfigTemplate methodsFor: 'accessing' stamp: 'SeanDeNigris 7/12/2012 09:41'!
customProjectAttributes
	 "Edit to return a collection of any custom attributes e.g. for conditional loading: Array with: #'Condition1' with: #'Condition2.
	For more information see: http://code.google.com/p/metacello/wiki/CustomProjectAttrributes"

	^ #().! !

!MetacelloConfigTemplate methodsFor: 'accessing' stamp: 'CamilloBruni 1/10/2014 17:25'!
project

	^ project ifNil: [ 
		"Bootstrap Metacello if it is not already loaded"
		(self class baseConfigurationClassIfAbsent: []) ensureMetacello.
		"Construct Metacello project"
		project := MetacelloMCProject new projectAttributes: self customProjectAttributes. 
		(Smalltalk at: #MetacelloVersionConstructor) on: self project: project.
		project loadType: #linear. "change to #atomic if desired"
		project ]! !

!MetacelloConfigTemplate class methodsFor: 'private' stamp: 'DaleHenrichs 11/2/2010 16:51'!
baseConfigurationClassIfAbsent: aBlock

	^Smalltalk
		at: #MetacelloBaseConfiguration
		ifAbsent: [ 
			self ensureMetacelloBaseConfiguration.
			Smalltalk at: #MetacelloBaseConfiguration ifAbsent: aBlock ].
! !

!MetacelloConfigTemplate class methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
validate
	"Check the configuration for Errors, Critical Warnings, and Warnings (see class comment for MetacelloMCVersionValidator for more information). 
	Errors identify specification issues that will result in unexpected behaviour when you load the configuration. 
	Critical Warnings identify specification issues that may result in unexpected behavior when you load the configuration.
	Warnings identify specification issues that are technically correct, but are worth take a look at."

	"self validate"

	<apiDocumentation>
	self ensureMetacello.
	^ ((Smalltalk at: #MetacelloToolBox) validateConfiguration: self debug: #() recurse: false) explore! !

!MetacelloConfigTemplate class methodsFor: 'metacello tool support' stamp: 'dkh 6/8/2012 14:04:22'!
isMetacelloConfig
	"Answer true and the Metacello tools will operate on you"
	
	^true! !

!MetacelloConfigTemplate class methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
loadBleedingEdge
	"Load the latest versions of the mcz files defined for this project. It is not likely that the #bleedingEdge has been tested."

	"self loadBleedingEdge"

	<apiDocumentation>
	^(self project version: #bleedingEdge) load! !

!MetacelloConfigTemplate class methodsFor: 'private' stamp: 'DaleHenrichs 11/4/2010 10:23'!
ensureMetacelloBaseConfiguration

	Smalltalk
		at: #MetacelloBaseConfiguration
		ifAbsent: [ 
			| repository version |
			repository := MCHttpRepository location: 'http://seaside.gemstone.com/ss/metacello' user: '' password: ''.
			repository
				versionReaderForFileNamed: 'Metacello-Base-DaleHenrichs.2.mcz'
				do: [ :reader | 
					version := reader version.
					version load.
					version workingCopy repositoryGroup addRepository: repository ] ]! !

!MetacelloConfigTemplate class methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
load
	"Load the #stable version defined for this platform. The #stable version is the version that is recommended to be used on this platform."

	"self load"

	<apiDocumentation>
	^(self project version: #stable) load! !

!MetacelloConfigTemplate class methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
DevelopmentSupport

"See the methods in the 'development support' category on the class-side of MetacelloBaseConfiguration. Decide what development support methods you would like to use and copy them the the class-side of your configuration."
	<apiDocumentation>
! !

!MetacelloConfigTemplate class methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
project

	^self new project! !

!MetacelloConfigTemplate class methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
ensureMetacello

	(self baseConfigurationClassIfAbsent: []) ensureMetacello! !

!MetacelloConfigTemplate class methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
loadDevelopment
	"Load the #development version defined for this platform. The #development version will change over time and is not expected to be stable."

	"self loadDevelopment"

	<apiDocumentation>
	^(self project version: #development) load! !

!MetacelloConfigTemplateExample commentStamp: '<historical>'!
Copy me to create a new configuration or edit and evaluate the following doits.

        "Create configuration class and initial baseline method"

        MetacelloToolBox 
                createBaseline: '1.0-baseline'
                for: 'MyProject'
                repository: 'http://www.example.com/MyProjectRepository'
                requiredProjects: #('Gofer')
                packages: #('MyProject-Core' 'MyProject-Tests')
                dependencies:
                        {('MyProject-Core' -> #('Gofer')).
                         ('MyProject-Tests' -> #('MyProject-Core'))}
                groups:
                        {('default' -> #('Core')).
                        ('Core' -> #('MyProject-Core')).
                        ('Tests' -> #('MyProject-Tests'))}.

	   "create initial development method from the baseline"

         MetacelloToolBox
               createDevelopment: '1.0'
               for: 'MyProject'
                importFromBaseline: '1.0-baseline'
                description: 'initial version'.
!
!MetacelloConfigTemplateExample methodsFor: 'baselines' stamp: 'ChristopheDemarey 1/15/2014 11:32'!
baseline10: spec
	"Baselines are used by convention in Metacello and essentially are nothing else than normal versions.
	Name the baseline after the first version it was introduced.
	In this case 1.0-baseline was introduced the first time with the 1.0 version defined in the #version10 method.
	Metacello only uses the following tag to figure out the name of this baseline:"
	<version: '1.0-baseline'>

	"Using #common makes this dependency declaration available for all Smalltalks.
	If you need more fine-grained control you can add several #for:do: sections for other releases."
	spec for: #common do: [	
		spec blessing: #baseline.
		"specify the default repository for your project's packages"
		spec repository: 'http://smalltalkhub.com/mc/JohnDoe/MyProject/main'.
	
		"use separate methods for external projects"
		self 
			fuelMetalevel: spec;
			fileSystemLegacy: spec.
		
		"specify the dependencies between packages and projects"
		spec
			"a package without dependencies:"
			package: 'MyProject-Core';
			package: 'MyProject-Tests' with: [ 
				"Specfiy dependencies using the #requires: directive, you can refer to any name here, in this case to an external project"
				spec requires: #('MyProject-Core' 'FuelMetalevel' 'FileSystemLegacy')].
			
		"using groups certain packages and projects can be loaded conditionally"
		spec 
			"load the tests by default"
			group: 'default' with: #('core' 'test');
			group: 'test'    with: #('MyProject-Tests');
			group: 'core'    with: #('MyProject-Core')]! !

!MetacelloConfigTemplateExample methodsFor: 'versions' stamp: 'ChristopheDemarey 1/15/2014 11:32'!
versionDevelopment: spec
	"version specification for the current development branch, see #version10 for a complete explanation of a version declaration.
	In this case the 'dev' version uses the same baselin as version '1.0':"
	<version: 'dev' imports: #('1.0-baseline') >
	
	"Update this configuration regulrarly with intermediate releases.
	If a version is more stable or should stay accessible copy this 'dev' definition and give it a proper version name on its own.
	For example, in this case you might want to split a new version '1.1' by copying over this definition."
	spec for: #common do: [
		spec 
			description: 'Development Version';
			blessing: #development;
			author: 'John Doe';
			timestamp: '2013-05-09'.
		
		spec
			package: 'MyProject-Core'  with: 'MyProject-Core-JohnDoe.152';
			package: 'MyProject-Tests' with: 'MyProject-Tests-JohnDoe.173';
			"note that for the 'dev' version we rely on the #development version of the external FuleMetalevel project"
			project: 'FuelMetalevel'   with: #development ].! !

!MetacelloConfigTemplateExample methodsFor: 'accessing' stamp: 'ChristopheDemarey 1/15/2014 11:32'!
customProjectAttributes
	 "Edit to return a collection of any custom attributes e.g. for conditional loading: Array with: #'Condition1' with: #'Condition2.
	For more information see: http://code.google.com/p/metacello/wiki/CustomProjectAttrributes"

	^ #().! !

!MetacelloConfigTemplateExample methodsFor: 'tags' stamp: 'ChristopheDemarey 1/15/2014 11:32'!
stable: spec
	"Symbolic versions can be used to introduce an indirection to a version number.
	The real name used by Metacello is only defined by the following pragma:"
	<symbolicVersion: #stable >
	
	"If another version is stable for a differen Smalltalk use a specific name"
	"spec for: #'pharo1.4.x' version: '0.9'"
	
	"Specfiy which exact version you want to load"
	spec for: #'common' version: '1.0'.
	! !

!MetacelloConfigTemplateExample methodsFor: 'tags' stamp: 'ChristopheDemarey 1/15/2014 11:32'!
development: spec
	"By convention the development branch should point to a fixed version that is regularly updated and might contain unstable code.
	The name used by Metacello is only defined by the following pragma:"
	<symbolicVersion: #development >
	
	"For the development tag refer to a fixed version which you update if you commit new code.
	Note that you can refer here to any other version name from this configuration"
	spec for: #'common' version: 'dev'.
! !

!MetacelloConfigTemplateExample methodsFor: 'external projects' stamp: 'ChristopheDemarey 1/15/2014 11:32'!
fuelMetalevel: spec

	"Specify a dependency on an external project which has it's own configuration.
	The given project name can be chosen freely, for simplicity use the same name as the configuration or the conditional group you load."
	spec project: 'FuelMetalevel' with: [
		spec 
			repository: 'http://ss3.gemstone.com/ss/Fuel';
			className: 'ConfigurationOfFuel';
			"if you want to load by default a special group usse the #loads: message plus a group name of the external configuration"
			loads: #FuelMetalevel ].! !

!MetacelloConfigTemplateExample methodsFor: 'external projects' stamp: 'ChristopheDemarey 1/15/2014 11:32'!
fileSystemLegacy: spec
	"This is an example of an external project which does not have a configuration yet.
	Note that the package name is only used in the Metacello configuration and does not have be exactly the same as the Monticello project/version name."
	spec package: 'FileSystemLegacy' with: [
		spec 
			repository: 'http://smalltalkhub.com/mc/PharoExtras/FileSystemLegacy/main';
			"if you do not specify a version, automatically the newest version is chose."
			file:  'FileSystem-Legacy-JohanBrichau.2' ]! !

!MetacelloConfigTemplateExample methodsFor: 'accessing' stamp: 'ChristopheDemarey 1/15/2014 11:32'!
project

	^ project ifNil: [ 
		"Bootstrap Metacello if it is not already loaded"
		(self class baseConfigurationClassIfAbsent: []) ensureMetacello.
		"Construct Metacello project"
		project := MetacelloMCProject new projectAttributes: self customProjectAttributes. 
		(Smalltalk at: #MetacelloVersionConstructor) on: self project: project.
		project loadType: #linear. "change to #atomic if desired"
		project ]! !

!MetacelloConfigTemplateExample methodsFor: 'versions' stamp: 'ChristopheDemarey 1/15/2014 11:32'!
version10: spec
	"The name for this version is solely defined by the following pragma:"
	<version: '1.0' imports: #('1.0-baseline') >
	"Baselines are used to define more complex setups for your project.
	If you want to use external projects and have fine-graind control of the dependencies between packages use the #imports: part.
	See the #baseline10: for more details."
	
	"Using #for:do: with the #common release specifier the following version declaration is valid for all platforms."
	spec for: #common do: [
		spec 
			description: 'Version 1.0 the current stable release';
			blessing: #release;
			author: 'John Doe';
			timestamp: '2013-05-01'.
		
		"Specify the versions for each package and external project defined in the baseline, here the 1.0-baseline defined in the baseline10 method."
		spec
			"For standard Monticello packages simply refere to the full version name without the extension:"
			package: 'MyProject-Core'  with: 'MyProject-Core-JohnDoe.52';
			package: 'MyProject-Tests' with: 'MyProject-Tests-JohnDoe.73';
			
			"External projects versions are specified using #project:with:.
			Note the project name referes to the name used in the Metacello declaration.
			FuelMetalevel is defined in the #fuelMetalevel: method."
			project: 'FuelMetalevel' with: #stable ].
		
	"If you want to specify different version on other platforms add another #for:do: block with a different version identifier."! !

!MetacelloConfigTemplateExample class methodsFor: 'private' stamp: 'ChristopheDemarey 1/15/2014 11:32'!
baseConfigurationClassIfAbsent: aBlock

	^Smalltalk
		at: #MetacelloBaseConfiguration
		ifAbsent: [ 
			self ensureMetacelloBaseConfiguration.
			Smalltalk at: #MetacelloBaseConfiguration ifAbsent: aBlock ].
! !

!MetacelloConfigTemplateExample class methodsFor: 'development support' stamp: 'ChristopheDemarey 1/15/2014 11:32'!
validate
	"Check the configuration for Errors, Critical Warnings, and Warnings (see class comment for MetacelloMCVersionValidator for more information). 
	Errors identify specification issues that will result in unexpected behaviour when you load the configuration. 
	Critical Warnings identify specification issues that may result in unexpected behavior when you load the configuration.
	Warnings identify specification issues that are technically correct, but are worth take a look at."

	"self validate"

	<apiDocumentation>
	self ensureMetacello.
	^ ((Smalltalk at: #MetacelloToolBox) validateConfiguration: self debug: #() recurse: false) explore! !

!MetacelloConfigTemplateExample class methodsFor: 'metacello tool support' stamp: 'ChristopheDemarey 1/15/2014 11:32'!
isMetacelloConfig
	"Answer true and the Metacello tools will operate on you"
	
	^true! !

!MetacelloConfigTemplateExample class methodsFor: 'loading' stamp: 'ChristopheDemarey 1/15/2014 11:32'!
loadBleedingEdge
	"Load the latest versions of the mcz files defined for this project. It is not likely that the #bleedingEdge has been tested."

	"self loadBleedingEdge"

	<apiDocumentation>
	^(self project version: #bleedingEdge) load! !

!MetacelloConfigTemplateExample class methodsFor: 'private' stamp: 'ChristopheDemarey 1/15/2014 11:32'!
ensureMetacelloBaseConfiguration

	Smalltalk
		at: #MetacelloBaseConfiguration
		ifAbsent: [ 
			| repository version |
			repository := MCHttpRepository location: 'http://seaside.gemstone.com/ss/metacello' user: '' password: ''.
			repository
				versionReaderForFileNamed: 'Metacello-Base-DaleHenrichs.2.mcz'
				do: [ :reader | 
					version := reader version.
					version load.
					version workingCopy repositoryGroup addRepository: repository ] ]! !

!MetacelloConfigTemplateExample class methodsFor: 'loading' stamp: 'ChristopheDemarey 1/15/2014 11:32'!
load
	"Load the #stable version defined for this platform. The #stable version is the version that is recommended to be used on this platform."

	"self load"

	<apiDocumentation>
	^(self project version: #stable) load! !

!MetacelloConfigTemplateExample class methodsFor: 'development support' stamp: 'ChristopheDemarey 1/15/2014 11:32'!
DevelopmentSupport

"See the methods in the 'development support' category on the class-side of MetacelloBaseConfiguration. Decide what development support methods you would like to use and copy them the the class-side of your configuration."
	<apiDocumentation>
! !

!MetacelloConfigTemplateExample class methodsFor: 'accessing' stamp: 'ChristopheDemarey 1/15/2014 11:32'!
project

	^self new project! !

!MetacelloConfigTemplateExample class methodsFor: 'private' stamp: 'ChristopheDemarey 1/15/2014 11:32'!
ensureMetacello

	(self baseConfigurationClassIfAbsent: []) ensureMetacello! !

!MetacelloConfigTemplateExample class methodsFor: 'loading' stamp: 'ChristopheDemarey 1/15/2014 11:32'!
loadDevelopment
	"Load the #development version defined for this platform. The #development version will change over time and is not expected to be stable."

	"self loadDevelopment"

	<apiDocumentation>
	^(self project version: #development) load! !

!MetacelloConfigurationBrowser commentStamp: '<historical>'!
Metacello is a configuration language for packages. It allows one to define dependencies between packages as well as between complete projects. 

MetacelloConfigurationBrowser is simple tool to browse and load Metacello configurations from particular repositories typically named 'MetaRepoForPharoXY' (where X denotes the Pharo major version and Y denotes the minor version. e.g. MetaRepoForPharo30 is Pharo 3.0)

MetaRepoForPharoXY is the short form of MetacelloRepositoriesForPharoXY since the source limits the length of the project name.

The default repository is configured by #pharoDistributionRepository as...!
!MetacelloConfigurationBrowser methodsFor: 'accessing' stamp: 'TorstenBergmann 7/17/2013 14:18'!
configurationSearchAccept:  aString

    aString isEmptyOrNil
		ifTrue: [ self configBrowserModel configurationPattern: nil ]
		ifFalse: [ self configBrowserModel configurationPattern: 
					([ aString asRegexIgnoringCase ] on: RegexSyntaxError do: [ aString ])].
 ! !

!MetacelloConfigurationBrowser methodsFor: 'icons' stamp: 'TorstenBergmann 2/12/2014 09:34'!
taskbarIcon
 
	^ Smalltalk ui icons configIcon! !

!MetacelloConfigurationBrowser methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 22:56'!
initialize

	super initialize.
	self windowIcon: self taskbarIcon.
	 ! !

!MetacelloConfigurationBrowser methodsFor: 'accessing' stamp: 'tbn 6/20/2013 08:14'!
toolbarModel
	
	^ toolbarModel! !

!MetacelloConfigurationBrowser methodsFor: 'accessing' stamp: 'BenComan 12/18/2013 00:47'!
aboutText
	^ super aboutText,
		String crlf,
		MetacelloConfigurationBrowserPane pharoDistributionRepository .
	! !

!MetacelloConfigurationBrowser methodsFor: 'initialization' stamp: 'TorstenBergmann 7/4/2013 08:44'!
initializeWidgets

	self instantiateModels: #(
		configBrowserModel 	#MetacelloConfigurationBrowserPane
		toolbarModel 			#MetacelloConfigurationBrowserToolbar).
	! !

!MetacelloConfigurationBrowser methodsFor: 'actions' stamp: 'TorstenBergmann 7/3/2013 21:28'!
installConfiguration

	configBrowserModel installConfiguration! !

!MetacelloConfigurationBrowser methodsFor: 'actions' stamp: 'TorstenBergmann 7/3/2013 21:29'!
loadConfiguration

	configBrowserModel loadConfiguration! !

!MetacelloConfigurationBrowser methodsFor: 'accessing' stamp: 'TorstenBergmann 7/3/2013 20:59'!
configBrowserModel
	
	^ configBrowserModel! !

!MetacelloConfigurationBrowser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/7/2013 11:46'!
configurationSearchField
	
	^ SearchMorph new
		model: self;
		setIndexSelector: #configurationSearchAccept:; 
		updateSelector: #configurationSearchAccept:;
		searchList: self class configurationSearchList;
		asSpecAdapter! !

!MetacelloConfigurationBrowser methodsFor: 'initialization' stamp: 'tbn 6/19/2013 21:47'!
initialExtent

	^ (400 min: (World extent x)) @ (350 min: (World extent y))! !

!MetacelloConfigurationBrowser class methodsFor: 'specs' stamp: 'TorstenBergmann 7/17/2013 13:37'!
defaultSpec
	<spec>
	| delta searchBarOffset |
 	
	searchBarOffset := 5 + StandardFonts defaultFont height + 10.
	delta := 25.
	^ SpecLayout composed 
			add: #configBrowserModel origin: 0@0 corner: 1@1 offsetOrigin: 0@searchBarOffset offsetCorner: 0@(delta negated);
			 add: #toolbarModel origin: 0@1 corner: 1@1 offsetOrigin: 0@(delta negated) offsetCorner: 0@0; 
			add: #configurationSearchField origin: 0@0 corner: 1@0 offsetOrigin: 0@0 offsetCorner: 0@searchBarOffset; 
			yourself! !

!MetacelloConfigurationBrowser class methodsFor: 'private accessing' stamp: 'CamilloBruni 7/17/2013 22:21'!
configurationSearchList
	^ configurationSearchList ifNil: [ configurationSearchList := OrderedCollection new ].! !

!MetacelloConfigurationBrowser class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 9/5/2013 14:33'!
open

	^ self new
		openWithSpec;
		yourself
		! !

!MetacelloConfigurationBrowser class methodsFor: 'registration' stamp: 'TorstenBergmann 2/12/2014 09:34'!
menuCommandOn: aBuilder  
	<worldMenu>
	
	(aBuilder item: 'Configuration Browser')
		parent: #Tools;
		order: 0.20;
		action: [self new openWithSpec]; 
		icon: Smalltalk ui icons configIcon! !

!MetacelloConfigurationBrowser class methodsFor: 'accessing' stamp: 'tbn 6/20/2013 08:13'!
title
		
	^'Configuration browser'! !

!MetacelloConfigurationBrowserPane commentStamp: '<historical>'!
A MetacelloConfigurationBrowserPane is xxxxxxxxx.

Instance Variables
	configurationList:		<IconListModel>
	configurationPattern:		<RxMatcher>
	configurations:		<SortedCollection>
	repository:		<String>

configurationList
	- the list model to display configurations

configurationPattern
	- a pattern to filter configurations in the configurationList

configurations
	- a sorted list of available configurations in the repository

repository
	- the repository to use
!
!MetacelloConfigurationBrowserPane methodsFor: 'updating' stamp: 'TorstenBergmann 7/3/2013 21:10'!
updateList
	|selected|
	selected := self configurationList selectedIndex.
	self configurationList updateList.
	self configurationList setSelectedIndex: selected.! !

!MetacelloConfigurationBrowserPane methodsFor: 'actions' stamp: 'TorstenBergmann 8/29/2014 10:20'!
addRepository

	|repo|
	repo := UIManager default request: 'Repository to add' initialAnswer: 'http://smalltalkhub.com/mc/User/Project/main'.
	repo ifNotNil: [ AvailableRepositories add: repo. self repository: repo ]! !

!MetacelloConfigurationBrowserPane methodsFor: 'accessing' stamp: 'TorstenBergmann 7/17/2013 13:58'!
configurations

	configurations ifNil: [ configurations := self class retrieveConfigurationsFrom:  self repository ].
	^configurations! !

!MetacelloConfigurationBrowserPane methodsFor: 'accessing' stamp: 'TorstenBergmann 7/3/2013 21:38'!
selectedConfigurationClass

	^Smalltalk at: self selectedConfigurationName asSymbol ifAbsent: [ nil ]! !

!MetacelloConfigurationBrowserPane methodsFor: 'accessing' stamp: 'TorstenBergmann 7/3/2013 20:47'!
repository

	^repository! !

!MetacelloConfigurationBrowserPane methodsFor: 'actions' stamp: 'TorstenBergmann 7/3/2013 21:28'!
loadConfiguration

	self loadConfigurationWithStable: false.
	self updateList! !

!MetacelloConfigurationBrowserPane methodsFor: 'actions' stamp: 'TorstenBergmann 7/3/2013 21:28'!
installConfiguration

	self loadConfigurationWithStable: true.
	self updateList! !

!MetacelloConfigurationBrowserPane methodsFor: 'actions' stamp: 'TorstenBergmann 10/31/2013 12:27'!
refreshRepository
	self repository: self repository.
	self configurationPattern: configurationPattern ! !

!MetacelloConfigurationBrowserPane methodsFor: 'accessing' stamp: 'TorstenBergmann 7/17/2013 14:18'!
configurationPattern: aPattern
	"Sets a filter pattern"
	
	configurationPattern := aPattern.

	 self configurationList items: 
		(aPattern isNil ifTrue: [self configurations]
					    ifFalse: [self configurations select: [ :each| configurationPattern search: each ]]).

	self updateList
	
 ! !

!MetacelloConfigurationBrowserPane methodsFor: 'accessing' stamp: 'TorstenBergmann 7/3/2013 21:44'!
selectedConfigurationName
	self selectedConfiguration ifNil: [ ^String empty ].
	^self selectedConfiguration readStream upTo: $-.! !

!MetacelloConfigurationBrowserPane methodsFor: 'private accessing' stamp: 'tbn 2/18/2013 20:20'!
configurationList: aList

	configurationList := aList! !

!MetacelloConfigurationBrowserPane methodsFor: 'private' stamp: 'StephaneDucasse 2/7/2015 18:09'!
explicitTitleFromURLString: anURLString
	"find the name of the meta repository based on the fact that it starts with Meta"
	^ ( $/ split: anURLString) detect: [ :each | 'Meta*' match: each ] ifNone: [ anURLString ]! !

!MetacelloConfigurationBrowserPane methodsFor: 'actions' stamp: 'StephaneDucasse 2/7/2015 17:59'!
defineRepositoryInMCBrowser
	"Define the currently shown meta repository as a repository browsable from within the MC Browser. This is is simpler to copy a configuration to the meta repositories."

	MCRepositoryGroup default 
		addRepository: (self repositoryObjectFromURLString: self repository)! !

!MetacelloConfigurationBrowserPane methodsFor: 'initialization' stamp: 'tbn 6/19/2013 22:31'!
initConfigurationList	

	"Display in format name (author.version)"	
	configurationList displayBlock: [:item | 
		|tokens|
		tokens := (item findTokens: '-.').
		(tokens first allButFirst: 15), ' (',tokens second ,'.', tokens third, ')' ].  

	"Display loaded with a special icon (assuming the mcz is named like the class"
	configurationList icons: [:e | 
		(Smalltalk includesKey: (e findTokens: '-.') first asSymbol)
			ifTrue: [  Smalltalk ui icons configIconLoaded  ]
			ifFalse: [ Smalltalk ui icons configIcon  ]].
	
	! !

!MetacelloConfigurationBrowserPane methodsFor: 'actions' stamp: 'StephaneDucasse 2/7/2015 18:02'!
defineAllRepositoriesInMCBrowser
	"Define all the repositories as a repository browsable from within the MC Browser. This is is simpler to copy a configuration to the meta repositories."
	self availableRepositories do: [ :each | 
		MCRepositoryGroup default 
			addRepository: (self repositoryObjectFromURLString: each)] ! !

!MetacelloConfigurationBrowserPane methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 10/7/2013 11:53'!
initializeWidgets

	self instantiateModels:  #(configurationList IconListModel).	
	self focusOrder add: configurationList. 		
	configurationList menu: [ :aMenu | self configurationListMenu: aMenu ].			
	self initConfigurationList.
	self repository: self availableRepositories first! !

!MetacelloConfigurationBrowserPane methodsFor: 'accessing' stamp: 'TorstenBergmann 7/3/2013 21:31'!
selectedConfiguration

	^self configurationList selectedItem! !

!MetacelloConfigurationBrowserPane methodsFor: 'private accessing' stamp: 'tbn 6/19/2013 21:29'!
configurationList

	^configurationList ! !

!MetacelloConfigurationBrowserPane methodsFor: 'private testing' stamp: 'TorstenBergmann 7/3/2013 21:36'!
hasSelection

	^self selectedConfiguration notNil! !

!MetacelloConfigurationBrowserPane methodsFor: 'accessing' stamp: 'StephaneDucasse 2/7/2015 18:09'!
repository: aRepositoryUrl
	"clear config cache for new repositories"
	repository = aRepositoryUrl ifFalse: [ configurations := nil ].	
	repository := aRepositoryUrl.  
	
	self configurationList items: self configurations.
	self window ifNotNil: [:w |  w title: (self explicitTitleFromURLString: aRepositoryUrl) ]! !

!MetacelloConfigurationBrowserPane methodsFor: 'private accessing' stamp: 'TorstenBergmann 8/29/2014 10:08'!
availableRepositories
	"Return the available repositories"
	
	^self class availableRepositories! !

!MetacelloConfigurationBrowserPane methodsFor: 'actions' stamp: 'cami 7/22/2013 18:28'!
switchRepository
	| dialog |
	dialog := ListDialogWindow new
			getList: [ :r| self availableRepositories ];
			displayBlock: [:e | e ];
			title: 'Repository Search';
			yourself.
	dialog browseBlock: [ :el |
		el ifNotNil: [
			"only available onWin until other platforms can open a URL too"			 
			Smalltalk os isWin32 ifTrue: [ NBWin32Shell shellBrowse: el ] ]].
	
	(dialog openModal) cancelled ifFalse: [
		dialog listIndex > 0 ifTrue: [ self repository: (self availableRepositories at: dialog listIndex) ]]! !

!MetacelloConfigurationBrowserPane methodsFor: 'actions' stamp: 'StephaneDucasse 2/7/2015 18:00'!
repositoryObjectFromURLString: aString
	^ MCHttpRepository location: aString user: Author fullName password: ''! !

!MetacelloConfigurationBrowserPane methodsFor: 'private' stamp: 'TorstenBergmann 7/3/2013 21:37'!
loadConfigurationWithStable: loadStable
	"Load the configuration and (depending on the flag) load the latest stable version"
	| configName |
	self hasSelection ifFalse: [ ^self ].
	configName := self selectedConfigurationName.
	Gofer new
		url: self repository; 
		package: configName;
		load.
	loadStable ifFalse: [^self].
	
	"Now load the latest stable version"
	self selectedConfigurationClass project stableVersion load.! !

!MetacelloConfigurationBrowserPane methodsFor: 'menu' stamp: 'StephaneDucasse 2/7/2015 17:57'!
configurationListMenu: aMenu
	aMenu target: self.
	aMenu addTitle:  'Configuration'.
	self selectedConfiguration ifNotNil: [ 
		
		aMenu add: 'Install Stable Version' selector: #installConfiguration.
		self selectedConfigurationClass isNil 
			ifTrue:  [ aMenu add: 'Load Configuration' selector: #loadConfiguration ]
			ifFalse: [ aMenu add: 'Browse Configuration Class' selector: #browseConfiguration ].	
		aMenu addLine ].		 	
	aMenu	
		add: 'Switch Repository' selector: #switchRepository;
		add: 'Add Repository' selector: #addRepository;
		add: 'Define Repository in MC' selector: #defineRepositoryInMCBrowser;
		add: 'Define All repositories in MC' selector: #defineAllRepositoriesInMCBrowser;
		addLine;
		add: 'Refresh' selector: #refreshRepository.	
	^aMenu! !

!MetacelloConfigurationBrowserPane methodsFor: 'actions' stamp: 'TorstenBergmann 7/3/2013 21:37'!
browseConfiguration
	self hasSelection ifFalse: [ ^self ].
	self selectedConfigurationClass browse! !

!MetacelloConfigurationBrowserPane class methodsFor: 'spec' stamp: 'BenjaminVanRyseghem 5/14/2013 18:07'!
defaultSpec
	<spec>
	
	^ SpecLayout composed
		add: #configurationList;
		yourself! !

!MetacelloConfigurationBrowserPane class methodsFor: 'example' stamp: 'tbn 2/18/2013 21:33'!
example
	"
	self example
	"

	^self new 
		openWithSpec;
		repository: self pharoDistribution;
		yourself! !

!MetacelloConfigurationBrowserPane class methodsFor: 'defaults' stamp: 'StephaneDucasse 2/7/2015 17:50'!
defaultAvailableRepositories
	"Return the default list of available repositories"

	^ OrderedCollection
		with: self pharoDistributionRepository
		with: 'http://smalltalkhub.com/mc/Pharo/MetaRepoForPharo30/main'
		with: 'http://ss3.gemtalksystems.com/ss/MetaRepoForPharo20'
		with: 'http://www.squeaksource.com/MetacelloRepository'! !

!MetacelloConfigurationBrowserPane class methodsFor: 'accessing' stamp: 'TorstenBergmann 8/29/2014 10:09'!
availableRepositories
	"Return the available repositories"
	
	AvailableRepositories ifNil: [ AvailableRepositories := self defaultAvailableRepositories ].
	^AvailableRepositories ! !

!MetacelloConfigurationBrowserPane class methodsFor: 'accessing' stamp: 'tbn 2/18/2013 21:30'!
title 
 	^'Configurations'! !

!MetacelloConfigurationBrowserPane class methodsFor: 'accessing' stamp: 'MarcusDenker 10/15/2013 18:16'!
retrieveConfigurationsFrom: locationString
	"
	self retrieveConfigurationsFrom:  self pharoDistribution
	"

	| repo reductionMap split configName author version last topMostItems |
	repo := MCHttpRepository location: locationString.
				
	"Reduce to display only the latest"			
	reductionMap := Dictionary new.	
	(repo allVersionNames reverse 
		select: [ :each | each beginsWith: 'ConfigurationOf' ])
		do: [:each |				 
			split := each findTokens: '-.'.
			configName := split first.
			author := split second. 
			version := Integer readFrom: split last.
			last := reductionMap at: configName ifAbsentPut: [ author -> version].
			version > last value 
				ifTrue: [ reductionMap at: configName put: (author -> version) ] ].
			topMostItems := SortedCollection sortBlock: [:e1 :e2 | e1 asString <= e2 asString ].

	reductionMap keysAndValuesDo: [:key :val | 
		topMostItems add: (key, '-', val key, '.', val value asString)
	].	

	^topMostItems! !

!MetacelloConfigurationBrowserPane class methodsFor: 'accessing' stamp: 'TorstenBergmann 7/4/2013 08:46'!
pharoDistributionRepository
	"Returns the correct pharo distribution url"
	
	^'http://smalltalkhub.com/mc/Pharo/MetaRepoForPharo', SystemVersion current major asString, SystemVersion current minor asString, '/main'! !

!MetacelloConfigurationBrowserToolbar commentStamp: '<historical>'!
A MetacelloConfigurationBrowserToolbar is a toolbar for the configuration browser.

Instance Variables
	installModel:		<ButtonModel>
	loadModel:		<ButtonModel>

installModel
	- button model to install a configuration

loadModel
	- button model to load a configuration
!
!MetacelloConfigurationBrowserToolbar methodsFor: 'initialization' stamp: 'SeanDeNigris 11/9/2013 13:30'!
setLoadModel
	
	loadModel
		state: false;
		label: 'Load Configuration';
		action: [ self loadConfiguration ].
	

! !

!MetacelloConfigurationBrowserToolbar methodsFor: 'initialization' stamp: 'SeanDeNigris 11/9/2013 13:30'!
setInstallModel
	
	installModel
		state: false;
		label: 'Install Stable Version';
		action: [ self installConfiguration ].
	

! !

!MetacelloConfigurationBrowserToolbar methodsFor: 'initialization' stamp: 'StephaneDucasse 2/7/2015 18:03'!
initializeWidgets
	
	self instantiateModels: #(
		loadModel  		ButtonModel
		installModel      ButtonModel).
		
	self setLoadModel.
	self setInstallModel.
		
	self focusOrder
		add: loadModel;
		add: installModel! !

!MetacelloConfigurationBrowserToolbar methodsFor: 'actions' stamp: 'TorstenBergmann 7/17/2013 14:17'!
installConfiguration
	owner installConfiguration ! !

!MetacelloConfigurationBrowserToolbar methodsFor: 'actions' stamp: 'TorstenBergmann 7/17/2013 14:17'!
loadConfiguration
	owner loadConfiguration ! !

!MetacelloConfigurationBrowserToolbar methodsFor: 'initialization' stamp: 'StephaneDucasse 2/7/2015 18:03'!
installModel
	^ installModel
! !

!MetacelloConfigurationBrowserToolbar methodsFor: 'initialization' stamp: 'StephaneDucasse 2/7/2015 18:04'!
loadModel
	^ loadModel! !

!MetacelloConfigurationBrowserToolbar class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/7/2013 11:44'!
defaultSpec
	<spec>

	^ SpecLayout composed
		newRow: [ :row |
			row 
				add: #installModel;
				add: #loadModel ];
		yourself! !

!MetacelloConfigurationResource methodsFor: 'Issue 136' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfProjectIssue136
	"self reset"
	
	| versionInfo |
	versionInfo := self setUpConfigurationOfProjectIssue136dkh1.
	versionInfo := self setUpConfigurationOfProjectIssue136dkh2: {versionInfo}.
	! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFan' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfFan
	"self reset"
	
	| reference className definitionArray |
	reference := GoferVersionReference name: 'MetacelloTestConfigurationOfFan-dkh.1'.
	className := reference packageName asSymbol.
	definitionArray := {
					MCOrganizationDefinition categories: (Array with: className).
					MCClassDefinition name: className superclassName: #Object category: className instVarNames: #() comment: ''.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectClassMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline20Fan:'
						category: 'cat'
						timeStamp: ''
						source: self baseline20MethodSourceFan.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline30Fan:'
						category: 'cat'
						timeStamp: ''
						source: self baseline30MethodSourceFan.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline35Fan:'
						category: 'cat'
						timeStamp: ''
						source: self baseline35MethodSourceFan.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline40Fan:'
						category: 'cat'
						timeStamp: ''
						source: self baseline40MethodSourceFan.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline50Fan:'
						category: 'cat'
						timeStamp: ''
						source: self baseline50MethodSourceFan.
				}.
	monticelloRepository basicStoreVersion: (MCVersion new
		setPackage:  (MetacelloTestsMCPackage new name: reference packageName)
		info: (MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: #())
		snapshot: (MCSnapshot fromDefinitions: definitionArray)
		dependencies: #()) 
! !

!MetacelloConfigurationResource methodsFor: 'Issue 77' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline10D: spec 
	"self reset"
	<version: '1.0'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec 
			project: 'C' with: [
				spec
					className: 'MetacelloTestConfigurationOfIssue77C';
					loads: #('GoferFoo');
					versionString: '1.3';
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			package: 'GoferBar' with: [
				spec 
					file:'GoferBar-lr.1' ];
			group: 'default' with: #('GoferBar');
			yourself ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFoo' stamp: 'dkh 07/19/2013 22:50'!
baseline35Foo: spec
  "self reset"

  <version: '3.5'>
  spec
    for: #'common'
    do: [ 
      spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
      spec
        package: 'GoferFoo' with: 'GoferFoo-lr.1';
        package: 'GoferBar' with: 'GoferBar-lr.1';
        package: 'GoferFaux' with: 'GoferFaux-tg.31';
        package: 'GoferBeau' with: 'GoferBeau-dkh.54';
        yourself.
      spec
        group: '1' with: #('GoferFoo' 'GoferBar');
        group: '2' with: #('GoferFoo' 'GoferFaux');
        yourself ]! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline50MethodSourceFoo

	^(self class sourceCodeAt: #baseline50Foo:) asString

! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
project
	"self reset"

	| constructor project |
	"Construct Metacello project"
	project := MetacelloMCProject new.
	"Allow for customization of #projectAttributes"
	project projectAttributes: MetacelloConfigurationResource projectAttributes.
	MetacelloVersionConstructor on: self project: project.
	project loader: 
		((project loaderClass new)
			shouldDisablePackageCache: true;
			yourself).
	project loadType: #linear.
	^project
! !

!MetacelloConfigurationResource methodsFor: 'Issue 119' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfProjectIssue119dkh2: ancestors
    "version 2.0"

    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'MetacelloTestConfigurationOfProjectIssue119-dkh.2'.
    className := reference packageName asSymbol.
    definitionArray := {(MCClassDefinition
        name: className
        superclassName: #'Object'
        category: className
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: true
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectClassMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'baselineVersion20Issue119:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineVersion20Issue119:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version20Issue119:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version20Issue119:') asString)}.
    monticelloRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: ancestors)
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version117ProjectToolBox: spec
	<version: '1.1.7-baseline' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec package: 'Example-Core' overrides: [
				spec preLoadDoIt: #'alternatePreloadForCore'. ]. ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFeaux' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline40Feaux: spec 
	"self reset"
	<version: '4.0'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec 
			package: 'GeauxFoo' with:'GeauxFoo-lr.1';
			package: 'GeauxBar' with: 'GeauxBar.branch-lr.2';
			yourself ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
projectMethodSource

	^(self class sourceCodeAt: #project) asString

! !

!MetacelloConfigurationResource methodsFor: 'Issue 119' stamp: 'dkh 6/12/2012 15:41:23.319'!
baselineVersion30Issue119: spec
    <version: '3.0-baseline'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'baseline'.
            spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
            spec
                project: 'Foo '
                    with: [ 
                            spec
                                versionString: #'bleedingEdge';
                                className: 'MetacelloTestConfigurationOfFoo';
                                repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
                yourself.
            spec package: 'GoferBar' ]! !

!MetacelloConfigurationResource methodsFor: 'Issue 125' stamp: 'dkh 9/11/2012 15:14'!
baselineVersion30Issue125: spec
    <version: '3.0-baseline' imports: #('2.0-baseline')>
    spec
        for: #(#'attribute1' #'attribute2')
        do: [ 
            spec description: 'MetacelloConfigurationResource>>baselineVersion30Issue125:'.
            spec
                package: 'GoferFaux' with: [ spec requires: 'GoferFoo' ];
                package: 'GoferBeau' with: [ spec requires: 'GoferFaux' ];
                yourself ]! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfSymbolic' stamp: 'dkh 6/12/2012 15:41:23.319'!
version42SymbolicMethodSourceSymbolic

	^(self class sourceCodeAt: #version42Symbolic:) asString

! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version132ProjectToolBox: spec
	<version: '1.3.2-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'. ].

	spec for: #'level1_1' do: [
		spec package: 'GoferBeau' with: 'GoferBeau-dkh.15'.

		spec for: #'level2_1' do: [
			spec package: 'GoferBeau' with: 'GoferBeau-dkh.25'.

			spec for: #'level3_1' do: [
				spec package: 'GoferBeau' with: 'GoferBeau-dkh.53'. ]. ].

		spec for: #'level2_2' do: [
			spec package: 'GoferBeau' with: 'GoferBeau-dkh.54'.

			spec for: #'level3_2' do: [
				spec package: 'GoferBeau' with: 'GoferBeau-dkh.55'. ]. ]. ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectFee' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfProjectFee
	"self reset"
	
	| reference className definitionArray |
	reference := GoferVersionReference name: 'MetacelloTestConfigurationOfProjectFee-dkh.1'.
	className := reference packageName asSymbol.
	definitionArray := {
					MCOrganizationDefinition categories: (Array with: className).
					MCClassDefinition name: className superclassName: #Object category: className instVarNames: #() comment: ''.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectClassMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline40ProjectFee:'
						category: 'cat'
						timeStamp: ''
						source: self baseline40MethodSourceProjectFee.
				}.
	monticelloRepository basicStoreVersion: (MCVersion new
		setPackage:  (MetacelloTestsMCPackage new name: reference packageName)
		info: (MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: #())
		snapshot: (MCSnapshot fromDefinitions: definitionArray)
		dependencies: #()) 
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectFum' stamp: 'dkh 7/19/2012 07:32'!
setUpConfigurationOfProjectFum
    "self reset"

    | reference className definitionArray |
    reference := GoferVersionReference name: 'MetacelloTestConfigurationOfProjectFum-dkh.1'.
    className := reference packageName asSymbol.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: className)).
    (MCClassDefinition
        name: className
        superclassName: #'Object'
        category: className
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: true
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectClassMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'baseline10ProjectFum:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baseline10ProjectFum:') asString)}.
    monticelloRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #())! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfSymbolic' stamp: 'dkh 6/12/2012 15:41:23.319'!
version41SymbolicMethodSourceSymbolic

	^(self class sourceCodeAt: #version41Symbolic:) asString

! !

!MetacelloConfigurationResource methodsFor: 'Issue 95' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline40ProjectInfinite: spec 
	"self reset"
	<version: '4.0'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec
			project: 'Loop' with: [
				spec
					className: 'MetacelloTestConfigurationOfProjectLoop';
					versionString: '4.0';
					loads: 'GeauxBeau';
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			yourself.
		spec 
			package: 'GeauxBar' with: [
				spec
					file: 'GeauxBar.branch-lr.2';
					requires: 'Loop';
					yourself ];
			package: 'GoferBar' with: 'GoferBar-lr.1';
			yourself ].! !

!MetacelloConfigurationResource methodsFor: 'Issue 125' stamp: 'dkh 9/11/2012 15:33'!
setUpConfigurationOfProjectIssue125
    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'MetacelloTestConfigurationOfProjectIssue125-dkh.1'.
    className := reference packageName asSymbol.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: className)).
    (MCClassDefinition
        name: className
        superclassName: #'Object'
        category: className
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: true
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectClassMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'version30Issue125:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version30Issue125:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'baselineVersion20Issue125:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineVersion20Issue125:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'baselineVersion30Issue125:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineVersion30Issue125:') asString)}.
    monticelloRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFeaux' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfFeaux
	"self reset"
	
	| reference className definitionArray |
	reference := GoferVersionReference name: 'MetacelloTestConfigurationOfFeaux-dkh.1'.
	className := reference packageName asSymbol.
	definitionArray := {
					MCOrganizationDefinition categories: (Array with: className).
					MCClassDefinition name: className superclassName: #Object category: className instVarNames: #() comment: ''.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectClassMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline40Feaux:'
						category: 'cat'
						timeStamp: ''
						source: self baseline40MethodSourceFeaux.
				}.
	monticelloRepository basicStoreVersion: (MCVersion new
		setPackage:  (MetacelloTestsMCPackage new name: reference packageName)
		info: (MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: #())
		snapshot: (MCSnapshot fromDefinitions: definitionArray)
		dependencies: #()) 
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfSymbolic' stamp: 'dkh 6/12/2012 15:41:23.319'!
stableVersionC: spec 
	"self reset"
	<symbolicVersion: #stable>
	
	spec for: #'common' do: [ spec version: '4.2'].
	spec for: #'platformVersion1.x' do: [ spec version: '4.0'].
	spec for: #'platformVersion1.0.x' do: [ spec version: '4.1'].
	spec for: #'platformVersion1.1.x' do: [ spec version: '4.2'].
	spec for: #'platformVersion1.2.x' do: [ spec version: '4.3'].
! !

!MetacelloConfigurationResource methodsFor: 'Issue 115' stamp: 'dkh 05/10/2013 17:13'!
version10Issue156: spec
  "https://github.com/dalehenrich/metacello-work/issues/156"

  <version: '1.0.0'>
  spec
    for: #'common'
    do: [ 
      spec
        configuration: 'Goo'
          with: [ 
              spec
                versionString: '3.0.0';
                repository:
                    'dictionary://Metacello_MczConfiguration_Test_Repository' ];
        yourself ]! !

!MetacelloConfigurationResource methodsFor: 'Issue 119' stamp: 'dkh 6/12/2012 15:41:23.319'!
version40Issue119: spec
    <version: '4.0' imports: #('4.0-baseline')>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'development'.
            spec project: 'Foo' with: '2.0'.
            spec package: 'GoferBar' with: 'GoferBar-jf.1' ]! !

!MetacelloConfigurationResource methodsFor: 'Issue 154' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfProjectIssue154dkh1
    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'ConfigurationOfMetacelloProjectIssue154-dkh.1'.
    className := reference packageName asSymbol.
    definitionArray := {(MCClassDefinition
        name: className
        superclassName: #'Object'
        category: className
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: true
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectClassMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'baselineVersion10Issue154:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineVersion10Issue154:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'baselineVersion11Issue154:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineVersion11Issue154:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'baselineVersion12Issue154:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineVersion12Issue154:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'baselineVersion13Issue154:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineVersion13Issue154:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'baselineVersion20Issue154:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineVersion20Issue154:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'baselineVersion30Issue154:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineVersion30Issue154:') asString)}.
    monticelloRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFan' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline20Fan: spec 
	"self reset"
	<version: '2.0'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec 
			project: 'Foo' with: [
				spec
					className: 'MetacelloTestConfigurationOfFoo';
					versionString: '2.0';
					loads: #('GoferFaux' 'GoferBeau');
					file: 'MetacelloTestConfigurationOfFoo';
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			project: 'Far' with: [
				spec
					className: 'MetacelloTestConfigurationOfFoo';
					versionString: '2.0';
					loads: #('GoferBeau');
					file: 'MetacelloTestConfigurationOfFoo';
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			yourself ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFan' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline50Fan: spec 
	"self reset"
	<version: '5.0'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec 
			project: 'Foo' with: [
				spec
					className: 'MetacelloTestConfigurationOfFoo';
					versionString: '5.0';
					loads: #('GoferFaux' 'GoferBeau');
					file: 'MetacelloTestConfigurationOfFoo';
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			yourself ].
! !

!MetacelloConfigurationResource methodsFor: 'Issue 154' stamp: 'dkh 6/12/2012 15:41:23.319'!
baselineVersion10Issue154: spec
    <version: '1.0-baseline'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'baseline'.
            spec
                project: 'MetacelloExample'
                    with: [ 
                            spec
                                className: 'ConfigurationOfMetacelloExample';
                                versionString: '1.0';
                                projectPackage: [ 
                                            spec
                                                name: 'ConfigurationOfMetacelloExample';
                                                repository: 'dictionary://Metacello_Configuration_Test_Repository' ] ];
                yourself ]! !

!MetacelloConfigurationResource methodsFor: 'Issue 171' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfProjectIssue171dkh1
    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'MetacelloTestConfigurationOfProjectIssue171-dkh.1'.
    className := reference packageName asSymbol.
    definitionArray := {(MCClassDefinition
        name: className
        superclassName: #'Object'
        category: className
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: true
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectClassMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'baselineVersion20Issue171:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineVersion20Issue171:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version20Issue171:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version20Issue171:') asString)}.
    monticelloRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version100ProjectToolBox: spec
	<version: '1.0-baseline'>

	spec for: #'common' do: [
		spec blessing: #'testBlessing'.
		spec 
			package: 'Example-Core' with: [
				spec 
					includes: #('Example-AddOn' );
					file: 'Example-Core-anon.1';
					repository: 'http://www.example.com/or';
					preLoadDoIt: #'preloadForCore';
					postLoadDoIt: #'postloadForCore:package:'. ];
			package: 'Example-AddOn' with: [
				spec requires: #('Example-Core' ). ];
			package: 'Example-Tests' with: [
				spec requires: #('Example-AddOn' ). ]. ].
! !

!MetacelloConfigurationResource methodsFor: 'Issue 154' stamp: 'dkh 6/12/2012 15:41:23.319'!
baselineVersion11Issue154: spec
    <version: '1.1-baseline'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'baseline'.
            spec
                project: 'MetacelloExample'
                    with: [ 
                            spec
                                className: 'ConfigurationOfMetacelloExample';
                                versionString: '1.0';
                                projectPackage: [ 
                                            spec
                                                name: 'MetacelloExampleTestConfigurationIssue154';
                                                repository: 'dictionary://Metacello_Configuration_Test_Repository' ] ];
                yourself ]! !

!MetacelloConfigurationResource methodsFor: 'Issue 119' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfProjectIssue119dkh7: ancestors
    "versions 5.0"

    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'MetacelloTestConfigurationOfProjectIssue119-dkh.7'.
    className := reference packageName asSymbol.
    definitionArray := {(MCClassDefinition
        name: className
        superclassName: #'Object'
        category: className
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: true
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectClassMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'baselineVersion40Issue119:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineVersion40Issue119:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version50Issue119:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version50Issue119:') asString)}.
    monticelloRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: ancestors)
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFoo' stamp: 'dkh 05/11/2013 08:50'!
setUpIssue156ConfigurationOfProjectGoo
  "https://github.com/dalehenrich/metacello-work/issues/156"

  "self reset"

  | reference className definitionArray |
  reference := GoferVersionReference name: 'ConfigurationOfProjectGoo-dkh.1'.
  className := reference packageName asSymbol.
  definitionArray := {(MCOrganizationDefinition
    categories: (Array with: className)).
  (MCClassDefinition
    name: className
    superclassName: #'ConfigurationOf'
    category: className
    instVarNames: #()
    comment: '').
  (MCMethodDefinition
    className: className asString
    selector: 'version10Issue156:'
    category: 'cat'
    timeStamp: ''
    source: (self class sourceCodeAt: #'version10Issue156:') asString).
  (MCMethodDefinition
    className: className asString
    selector: 'version11Issue156:'
    category: 'cat'
    timeStamp: ''
    source: (self class sourceCodeAt: #'version11Issue156:') asString).
  (MCMethodDefinition
    className: className asString
    selector: 'version20Issue156:'
    category: 'cat'
    timeStamp: ''
    source: (self class sourceCodeAt: #'version20Issue156:') asString).
  (MCMethodDefinition
    className: className asString
    selector: 'version30Issue156:'
    category: 'cat'
    timeStamp: ''
    source: (self class sourceCodeAt: #'version30Issue156:') asString)}.
  monticelloRepository
    basicStoreVersion:
      (MCVersion new
        setPackage: (MetacelloTestsMCPackage new name: reference packageName)
        info:
          (MCVersionInfo
            name: reference name
            id: UUID new
            message: 'This is a mock version'
            date: Date today
            time: Time now
            author: reference author
            ancestors: #())
        snapshot: (MCSnapshot fromDefinitions: definitionArray)
        dependencies: #())! !

!MetacelloConfigurationResource methodsFor: 'Issue 154' stamp: 'dkh 6/12/2012 15:41:23.319'!
baselineVersion20Issue154: spec
    <version: '2.0-baseline'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'baseline'.
            spec
                project: 'MetacelloExample'
                    with: [ 
                            spec
                                className: 'ConfigurationOfMetacelloExample';
                                versionString: '1.0';
                                repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
                yourself ]! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version133ProjectToolBox: spec
	<version: '1.3.3-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'. ].

	spec for: #'level1_1' do: [
		spec package: 'GoferBar' with: 'GoferBar-jf.1'.

		spec for: #'level2_1' do: [
			spec package: 'GoferFoo' with: 'GoferFoo-lr.1'.

			spec for: #'level3_1' do: [
				spec package: 'GoferFaux' with: 'GoferFaux-tg.30'. ]. ].

		spec for: #'level2_2' do: [
			spec package: 'GeauxBar' with: 'GeauxBar.branch-lr.2'.

			spec for: #'level3_2' do: [
				spec package: 'GeauxBeau' with: 'GeauxBeau-dkh.55'. ]. ]. ].

	spec for: #'pharo' do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'. ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFix' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline60Fix: spec 
	"self reset"
	<version: '6.0'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec 
			package: 'GoferFoo' with: 'GoferFoo-lr.4';
			package: 'GoferBar' with: 'GoferBar-lr.1';
			package: 'GoferFaux' with: 'GoferFaux-tg.35';
			yourself. ].
! !

!MetacelloConfigurationResource methodsFor: 'Issue 171' stamp: 'dkh 6/12/2012 15:41:23.319'!
version21Issue171: spec
    <version: '2.1' imports: #('2.1-baseline')>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'development'.
            spec project: 'Foo' with: '2.0'.
            spec package: 'GeauxFoo' with: 'GeauxFoo-lr.1' ]! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline30MethodSourceFoo

	^(self class sourceCodeAt: #baseline30Foo:) asString

! !

!MetacelloConfigurationResource methodsFor: 'running' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpMonticelloRepository
	"This method builds a fake repository with the version references from #buildReferences."
	"self reset"

	monticelloRepository := MCDictionaryRepository new.
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfSymbolic' stamp: 'dkh 6/12/2012 15:41:23.319'!
version41Symbolic: spec 
	"self reset"
	<version: '4.1'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec blessing: #release.
		spec 
			package: 'GoferBeau' with: 'GoferBeau-dkh.25';
			package: 'GoferFaux' with:'GoferFaux-tg.31';
			yourself ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFix' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline60MethodSourceFix

	^(self class sourceCodeAt: #baseline60Fix:) asString

! !

!MetacelloConfigurationResource methodsFor: 'Issue 95' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline40MethodSourceProjectIssue95

	^(self class sourceCodeAt: #baseline40ProjectIssue95:) asString

! !

!MetacelloConfigurationResource methodsFor: 'Issue 77' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline12MethodSourceC

	^(self class sourceCodeAt: #baseline12C:) asString

! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFan' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline20MethodSourceFan

	^(self class sourceCodeAt: #baseline20Fan:) asString

! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version118ProjectToolBox: spec
	<version: '1.1.8-baseline' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec package: 'Example-Core' with: [
				spec preLoadDoIt: #'alternatePreloadForCore'. ]. ].
! !

!MetacelloConfigurationResource methodsFor: 'Issue 77' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpIssue77D
	"self reset"
	
	| reference className definitionArray |
	reference := GoferVersionReference name: 'MetacelloTestConfigurationOfIssue77D-dkh.1'.
	className := reference packageName asSymbol.
	definitionArray := {
					MCOrganizationDefinition categories: (Array with: className).
					MCClassDefinition name: className superclassName: #Object category: className instVarNames: #() comment: ''.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectClassMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline10D:'
						category: 'cat'
						timeStamp: ''
						source: self baseline10MethodSourceD.
				}.
	monticelloRepository basicStoreVersion: (MCVersion new
		setPackage:  (MetacelloTestsMCPackage new name: reference packageName)
		info: (MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: #())
		snapshot: (MCSnapshot fromDefinitions: definitionArray)
		dependencies: #()) 
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFoo' stamp: 'dkh 05/10/2013 17:13'!
baselineGooIssue156Baseline: spec
  "https://github.com/dalehenrich/metacello-work/issues/156"

  <baseline>
  spec
    for: #'common'
    do: [ 
      spec
        package: 'GoferFoo' with: 'GoferFoo-lr.1';
        package: 'GoferBar' with: 'GoferBar.branch-lr.1';
        package: 'GoferFaux' with: 'GoferFaux-tg.30';
        package: 'GoferBeau' with: 'GoferBeau-dkh.53';
        yourself ]! !

!MetacelloConfigurationResource methodsFor: 'Issue 171' stamp: 'dkh 6/12/2012 15:41:23.319'!
version20Issue171: spec
    <version: '2.0' imports: #('2.0-baseline')>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'development'.
            spec project: 'Foo' with: '2.0'.
            spec package: 'GeauxFoo' with: 'GeauxFoo-lr.1' ]! !

!MetacelloConfigurationResource methodsFor: 'Issue 119' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfProjectIssue119dkh5: ancestors
    "versions, 4.0, 4.1, 4.2, 4.3, 4.4"

    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'MetacelloTestConfigurationOfProjectIssue119-dkh.5'.
    className := reference packageName asSymbol.
    definitionArray := {(MCClassDefinition
        name: className
        superclassName: #'Object'
        category: className
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: true
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectClassMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'baselineVersion40Issue119:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineVersion40Issue119:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version40Issue119:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version40Issue119:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version41Issue119:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version41Issue119:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version42Issue119:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version42Issue119:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version43Issue119:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version43Issue119:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version44Issue119:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version44Issue119:') asString)}.
    monticelloRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: ancestors)
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
preloadDoItMethodSource

	^(self class sourceCodeAt: #preloadDoIt) asString

! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFan' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline50MethodSourceFan

	^(self class sourceCodeAt: #baseline50Fan:) asString

! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version135ProjectToolBox: spec
	<version: '1.3.5' imports: #('1.2.4-baseline' )>

	spec for: #'common' do: [
		spec repositories: [
			spec
				repository: 'http://www.example.com/ab';
				repository: 'http://www.example.com/ac' ]. ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline20MethodSourceFoo

	^(self class sourceCodeAt: #baseline20Foo:) asString

! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectFoe' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfProjectFoe
	"self reset"
	
	| reference className definitionArray |
	reference := GoferVersionReference name: 'MetacelloTestConfigurationOfProjectFoe-dkh.1'.
	className := reference packageName asSymbol.
	definitionArray := {
					MCOrganizationDefinition categories: (Array with: className).
					MCClassDefinition name: className superclassName: #Object category: className instVarNames: #() comment: ''.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectClassMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline40ProjectFoe:'
						category: 'cat'
						timeStamp: ''
						source: self baseline40MethodSourceProjectFoe.
				}.
	monticelloRepository basicStoreVersion: (MCVersion new
		setPackage:  (MetacelloTestsMCPackage new name: reference packageName)
		info: (MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: #())
		snapshot: (MCSnapshot fromDefinitions: definitionArray)
		dependencies: #()) 
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version116ProjectToolBox: spec
	<version: '1.1.6-baseline' imports: #('1.1.4-baseline' )>

	spec for: #'common' do: [
		spec project: 'Example Project' with: [
				spec
					preLoadDoIt: #'alternatePreloadForCore' ]. ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version114ProjectToolBox: spec
	<version: '1.1.4-baseline'>

	spec for: #'common' do: [
		spec project: 'Example Project' with: [
				spec
					className: 'MetacelloExampleProjectConfig';
					versionString: '1.0-baseline';
					preLoadDoIt: #'preloadForProject';
					postLoadDoIt: #'postloadForProject';
					repository: 'http://www.example.com/ob' ]. ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfSymbolic' stamp: 'dkh 6/12/2012 15:41:23.319'!
version42Symbolic: spec 
	"self reset"
	<version: '4.2'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec blessing: #release.
		spec 
			package: 'GoferBeau' with: 'GoferBeau-dkh.53';
			package: 'GoferFaux' with:'GoferFaux-tg.32';
			yourself ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFix' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline61MethodSourceFix

	^(self class sourceCodeAt: #baseline61Fix:) asString

! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version111ProjectToolBox: spec
	<version: '1.1.1-baseline'>

	spec for: #'common' do: [
		spec package: 'Example-Core'.

		spec for: #'nested' do: [
			spec package: 'Example-Base'. ]. ].

	spec for: #'extra' do: [
		spec package: 'Example-Test'. ].
! !

!MetacelloConfigurationResource methodsFor: 'Issue 77' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline10MethodSourceD

	^(self class sourceCodeAt: #baseline10D:) asString

! !

!MetacelloConfigurationResource methodsFor: 'Issue 119' stamp: 'dkh 6/12/2012 15:41:23.319'!
baselineVersion10Issue119: spec
    <version: '1.0-baseline'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'baseline'.
            spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
            spec
                project: 'Foo '
                    with: [ 
                            spec
                                className: 'MetacelloTestConfigurationOfFoo';
                                repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
                yourself.
            spec package: 'GoferBar ' ]! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
projectClassMethodSource

	^(self class class sourceCodeAt: #project) asString

! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfSymbolic' stamp: 'dkh 6/12/2012 15:41:23.319'!
version40Symbolic: spec 
	"self reset"
	<version: '4.0'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec blessing: #release.
		spec 
			package: 'GoferBeau' with: 'GoferBeau-dkh.15';
			package: 'GoferFaux' with:'GoferFaux-tg.30';
			yourself ].
! !

!MetacelloConfigurationResource methodsFor: 'Issue 119' stamp: 'dkh 6/12/2012 15:41:23.319'!
baselineVersion40Issue119: spec
    <version: '4.0-baseline'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'baseline'.
            spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
            spec
                project: 'Foo'
                    with: [ 
                            spec
                                versionString: #'bleedingEdge';
                                className: 'MetacelloTestConfigurationOfFoo';
                                repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
                yourself.
            spec package: 'GoferBar' ]! !

!MetacelloConfigurationResource methodsFor: 'Issue 95' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfProjectIssue95
	"self reset"
	
	| reference className definitionArray |
	reference := GoferVersionReference name: 'MetacelloTestConfigurationOfProjectIssue95-dkh.1'.
	className := reference packageName asSymbol.
	definitionArray := {
					MCOrganizationDefinition categories: (Array with: className).
					MCClassDefinition name: className superclassName: #Object category: className instVarNames: #() comment: ''.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectClassMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline40ProjectIssue95:'
						category: 'cat'
						timeStamp: ''
						source: self baseline40MethodSourceProjectIssue95.
				}.
	monticelloRepository basicStoreVersion: (MCVersion new
		setPackage:  (MetacelloTestsMCPackage new name: reference packageName)
		info: (MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: #())
		snapshot: (MCSnapshot fromDefinitions: definitionArray)
		dependencies: #()) 
! !

!MetacelloConfigurationResource methodsFor: 'Issue 136' stamp: 'dkh 6/12/2012 15:41:23.319'!
baselineVersion10Issue136: spec
	<version: '1.0-baseline'>

	spec for: #'common' do: [
		spec blessing: #baseline.
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec 
			package: 'GoferBeau'. ].
! !

!MetacelloConfigurationResource methodsFor: 'Issue 77' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpIssue77C
	"self reset"
	
	| reference className definitionArray |
	reference := GoferVersionReference name: 'MetacelloTestConfigurationOfIssue77C-dkh.1'.
	className := reference packageName asSymbol.
	definitionArray := {
					MCOrganizationDefinition categories: (Array with: className).
					MCClassDefinition name: className superclassName: #Object category: className instVarNames: #() comment: ''.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectClassMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline12C:'
						category: 'cat'
						timeStamp: ''
						source: self baseline12MethodSourceC.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline13C:'
						category: 'cat'
						timeStamp: ''
						source: self baseline13MethodSourceC.
				}.
	monticelloRepository basicStoreVersion: (MCVersion new
		setPackage:  (MetacelloTestsMCPackage new name: reference packageName)
		info: (MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: #())
		snapshot: (MCSnapshot fromDefinitions: definitionArray)
		dependencies: #()) 
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFan' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline40MethodSourceFan

	^(self class sourceCodeAt: #baseline40Fan:) asString

! !

!MetacelloConfigurationResource methodsFor: 'Issue 119' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfProjectIssue119dkh1
    "version 1.0"

    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'MetacelloTestConfigurationOfProjectIssue119-dkh.1'.
    className := reference packageName asSymbol.
    definitionArray := {(MCClassDefinition
        name: className
        superclassName: #'Object'
        category: className
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: true
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectClassMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'baselineVersion10Issue119:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineVersion10Issue119:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version10Issue119:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version10Issue119:') asString)}.
    monticelloRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloConfigurationResource methodsFor: 'Issue 119' stamp: 'dkh 6/12/2012 15:41:23.319'!
version43Issue119: spec
    <version: '4.3' imports: #('4.0-baseline')>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'development'.
            spec project: 'Foo ' with: '2.0'.
            spec package: 'GoferBar ' with: 'GoferBar-jf.1' ]! !

!MetacelloConfigurationResource methodsFor: 'Issue 171' stamp: 'dkh 6/12/2012 15:41:23.319'!
baselineVersion21Issue171: spec
    <version: '2.1-baseline'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'baseline'.
            spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
            spec
                project: 'Foo' with: [ spec className: 'MetacelloTestConfigurationOfFoo' ];
                yourself.
            spec package: 'GeauxFoo' ]! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version113ProjectToolBox: spec
	<version: '1.1.3' imports: #('1.1.3-baseline' )>

	spec for: #'outer' do: [
		spec 
			package: 'Example-Core' with: 'Example-Core-dkh.1';
			package: 'Example-Test' with: 'Example-Test-dkh.1'.

		spec for: #'nested' do: [
			spec package: 'Example-Core' with: 'Example-Core-dkh.2'. ]. ].

	spec for: #'extra' do: [
		spec package: 'Example-Core' with: 'Example-Core-dkh.3'. ].
! !

!MetacelloConfigurationResource methodsFor: 'Issue 171' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfProjectIssue171
    "self reset"

    | versionInfo |
    versionInfo := self setUpConfigurationOfProjectIssue171dkh1.
    versionInfo := self setUpConfigurationOfProjectIssue171dkh2: {versionInfo}! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectFie' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline40ProjectFie: spec 
	"just projects"
	"self reset"

	<version: '4.0'>
	spec for: #common do: [
		spec 
			project: 'Foo' with: [
				spec
					className: 'MetacelloTestConfigurationOfFoo';
					versionString: '4.0';
					file: 'MetacelloTestConfigurationOfFoo';
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			project: 'Feaux' with: [
				spec
					className: 'MetacelloTestConfigurationOfFeaux';
					versionString: '4.0';
					file: 'MetacelloTestConfigurationOfFeaux';
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			yourself. ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version112ProjectToolBox: spec
	<version: '1.1.2-baseline'>

	spec for: #'common' do: [
		spec package: 'Example-Core'.

		spec for: #'nested' do: [
			spec 
				package: 'Example-Base';
				package: 'Example-Test-Nested'. ]. ].

	spec for: #'extra' do: [
		spec package: 'Example-Test'. ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version115ProjectToolBox: spec
	<version: '1.1.5-baseline' imports: #('1.1.4-baseline' )>

	spec for: #'common' do: [
		spec project: 'Example Project' with: [
				spec
					preLoadDoIt: #'alternatePreloadForCore' ]. ].
! !

!MetacelloConfigurationResource methodsFor: 'Issue 119' stamp: 'dkh 6/12/2012 15:41:23.319'!
version41Issue119: spec
    <version: '4.1' imports: #('4.0-baseline')>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'development'.
            spec project: 'Foo ' with: '2.0'.
            spec package: 'GoferBar' with: 'GoferBar-jf.1' ]! !

!MetacelloConfigurationResource methodsFor: 'Issue 95' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline40ProjectLoop: spec 
	"self reset"
	<version: '4.0'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec 
			project: 'Infinite' with: [
				spec
					className: 'MetacelloTestConfigurationOfProjectInfinite';
					versionString: '4.0';
					loads: 'GoferBar';
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			package: 'GoferFaux' with: [
				spec
					file:'GoferFaux-tg.30';
					requires: 'Infinite';
					yourself ];
			package: 'GeauxBeau' with: [
				spec
					file: 'GeauxBeau-dkh.55';
					yourself ];
			yourself ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version108ProjectToolBox: spec
	<version: '1.0.8-baseline'>

	spec for: #'common' do: [
		spec 
			package: 'Example-Core';
			package: 'Example-Tests' with: [
				spec requires: #('Example-Core' ). ]. ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFan' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline30Fan: spec 
	"self reset"
	<version: '3.0'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec 
			project: 'Foo' with: [
				spec
					className: 'MetacelloTestConfigurationOfFoo';
					versionString: '3.0';
					loads: #('GoferFaux' 'GoferBeau');
					file: 'MetacelloTestConfigurationOfFoo';
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			yourself ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFan' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline35MethodSourceFan

	^(self class sourceCodeAt: #baseline35Fan:) asString

! !

!MetacelloConfigurationResource methodsFor: 'Issue 77' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline12C: spec 
	"self reset"
	<version: '1.2'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec 
			package: 'GoferFoo' with: 'GoferFoo-lr.1';
			package: 'GeauxBeau' with: 'GeauxBeau-dkh.55';
			yourself. ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFix' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline61Fix: spec 
	"self reset"
	<version: '6.1'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec 
			package: 'GoferFoo' with: 'GoferFoo-lr.4';
			package: 'GoferBar' with: 'GoferBar-lr.1';
			package: 'GoferBeau' with: 'GoferBeau-dkh.53';
			package: 'GoferFaux' with: 'GoferFaux-tg.31';
			yourself. ].
! !

!MetacelloConfigurationResource methodsFor: 'Issue 119' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfProjectIssue119dkh3: ancestors
    "version 3.0"

    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'MetacelloTestConfigurationOfProjectIssue119-dkh.3'.
    className := reference packageName asSymbol.
    definitionArray := {(MCClassDefinition
        name: className
        superclassName: #'Object'
        category: className
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: true
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectClassMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'baselineVersion30Issue119:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineVersion30Issue119:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version30Issue119:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version30Issue119:') asString)}.
    monticelloRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: ancestors)
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfProjectToolBox
    "self reset"

    | reference className definitionArray |
    reference := GoferVersionReference name: 'MetacelloTestConfigurationOfProjectToolBox-dkh.1'.
    className := reference packageName asSymbol.
    definitionArray := {(MCClassDefinition
        name: className
        superclassName: #'Object'
        category: className
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: true
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectClassMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'postloadDoIt'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'postloadDoIt') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'preloadDoIt'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'preloadDoIt') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'symbolicVersionExplicitlyDoesNotExistProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'symbolicVersionExplicitlyDoesNotExistProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version100ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version100ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version101ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version101ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version102ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version102ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version103ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version103ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version104ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version104ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version105ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version105ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version106ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version106ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version107ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version107ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version108ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version108ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version109ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version109ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version110ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version110ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version111ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version111ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version112ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version112ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'baselineVersion113ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineVersion113ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version113ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version113ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version114ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version114ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version115ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version115ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version116ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version116ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version117ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version117ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version118ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version118ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version119ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version119ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version120ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version120ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version121ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version121ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version122ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version122ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version123ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version123ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'baselineVersion124ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineVersion124ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version124ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version124ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version125ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version125ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version126ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version126ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version127ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version127ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version128ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version128ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version129ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version129ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version130ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version130ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version131ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version131ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version132ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version132ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version133ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version133ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version134ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version134ProjectToolBox:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version135ProjectToolBox:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version135ProjectToolBox:') asString)}.
    monticelloRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #())! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfSymbolic' stamp: 'dkh 6/12/2012 15:41:23.319'!
version43SymbolicMethodSourceSymbolic

	^(self class sourceCodeAt: #version43Symbolic:) asString

! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline30Foo: spec 
	"self reset"
	<version: '3.0'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec 
			package: 'GoferFoo' with: [
				spec 
					preLoadDoIt: #preloadDoIt;
					file: 'GoferFoo-lr.1' ];
			package: 'GoferBar' with: 'GoferBar.branch-lr.1';
			package: 'GoferFaux' with: 'GoferFaux-tg.30';
			package: 'GoferBeau' with: 'GoferBeau-dkh.53';
			yourself ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFoo' stamp: 'dkh 05/11/2013 08:33'!
baselineGoo300Issue156Configuration: spec
  "https://github.com/dalehenrich/metacello-work/issues/156"

  <version: '3.0.0'>
  spec
    for: #'common'
    do: [ 
      spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
      spec
        package: 'GoferGoo' with: 'GoferFoo-lr.1';
        package: 'GoferBar' with: 'GoferBar.branch-lr.1';
        package: 'GoferFaux' with: 'GoferFaux-tg.30';
        package: 'GoferBeau' with: 'GoferBeau-dkh.53';
        yourself ]! !

!MetacelloConfigurationResource methodsFor: 'Issue 95' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfProjectLoop
	"self reset"
	
	| reference className definitionArray |
	reference := GoferVersionReference name: 'MetacelloTestConfigurationOfProjectLoop-dkh.1'.
	className := reference packageName asSymbol.
	definitionArray := {
					MCOrganizationDefinition categories: (Array with: className).
					MCClassDefinition name: className superclassName: #Object category: className instVarNames: #() comment: ''.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectClassMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline40ProjectLoop:'
						category: 'cat'
						timeStamp: ''
						source: self baseline40MethodSourceProjectLoop.
				}.
	monticelloRepository basicStoreVersion: (MCVersion new
		setPackage:  (MetacelloTestsMCPackage new name: reference packageName)
		info: (MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: #())
		snapshot: (MCSnapshot fromDefinitions: definitionArray)
		dependencies: #()) 
! !

!MetacelloConfigurationResource methodsFor: 'Issue 154' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfProjectIssue154
    "self reset"

    | versionInfo |
    versionInfo := self setUpConfigurationOfMetacelloExampledkh1.
    versionInfo := self setUpConfigurationOfProjectIssue154dkh1! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFoo' stamp: 'dkh 05/10/2013 17:13'!
setUpIssue156BaselineOfGoo
  "https://github.com/dalehenrich/metacello-work/issues/156"

  "self reset"

  | reference className definitionArray |
  reference := GoferVersionReference name: 'BaselineOfGoo-dkh.1'.
  className := reference packageName asSymbol.
  definitionArray := {(MCOrganizationDefinition
    categories: (Array with: className)).
  (MCClassDefinition
    name: className
    superclassName: #'BaselineOf'
    category: className
    instVarNames: #()
    comment: '').
  (MCMethodDefinition
    className: className asString
    selector: 'baselineGooIssue156Baseline:'
    category: 'cat'
    timeStamp: ''
    source: (self class sourceCodeAt: #'baselineGooIssue156Baseline:') asString)}.
  monticelloRepository
    basicStoreVersion:
      (MCVersion new
        setPackage: (MetacelloTestsMCPackage new name: reference packageName)
        info:
          (MCVersionInfo
            name: reference name
            id: UUID new
            message: 'This is a mock version'
            date: Date today
            time: Time now
            author: reference author
            ancestors: #())
        snapshot: (MCSnapshot fromDefinitions: definitionArray)
        dependencies: #())! !

!MetacelloConfigurationResource methodsFor: 'Issue 136' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfProjectIssue136dkh2: ancestors
	"self reset"
	
	| reference className definitionArray versionInfo |
	reference := GoferVersionReference name: 'MetacelloTestConfigurationOfProjectIssue136-dkh.2'.
	className := reference packageName asSymbol.
	definitionArray := {
					MCOrganizationDefinition categories: (Array with: className).
					MCClassDefinition name: className superclassName: #Object category: className instVarNames: #() comment: ''.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectClassMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'baselineVersion10Issue136:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #baselineVersion10Issue136:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'version10Issue136:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #version10Issue136:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'version11Issue136:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #version11Issue136:) asString.
				}.
	monticelloRepository basicStoreVersion: (MCVersion new
		setPackage:  (MetacelloTestsMCPackage new name: reference packageName)
		info: (versionInfo := MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: ancestors)
		snapshot: (MCSnapshot fromDefinitions: definitionArray)
		dependencies: #()).
	^versionInfo
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version105ProjectToolBox: spec
	<version: '1.0.5-baseline'>

	spec for: #'common' do: [
		spec package: 'Example-Core' with: [
				spec repository: 'http://www.example.com/ob'. ]. ].
! !

!MetacelloConfigurationResource methodsFor: 'Issue 77' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline10MethodSourceB

	^(self class sourceCodeAt: #baseline10B:) asString

! !

!MetacelloConfigurationResource methodsFor: 'Issue 115' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfProjectIssue115dkh1
	"self reset"
	
	| reference className definitionArray versionInfo |
	reference := GoferVersionReference name: 'MetacelloTestConfigurationOfProjectIssue115-dkh.1'.
	className := reference packageName asSymbol.
	definitionArray := {
					MCOrganizationDefinition categories: (Array with: className).
					MCClassDefinition name: className superclassName: #Object category: className instVarNames: #() comment: ''.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectClassMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'baselineVersion10Issue115:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #baselineVersion10Issue115:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'version10Issue115:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #version10Issue115:) asString.
				}.
	monticelloRepository basicStoreVersion: (MCVersion new
		setPackage:  (MetacelloTestsMCPackage new name: reference packageName)
		info: (versionInfo := MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: #())
		snapshot: (MCSnapshot fromDefinitions: definitionArray)
		dependencies: #()).
	^versionInfo! !

!MetacelloConfigurationResource methodsFor: 'Issue 136' stamp: 'dkh 6/12/2012 15:41:23.319'!
version11Issue136: spec
	<version: '1.1' imports: #('1.0-baseline')>

	spec for: #'common' do: [
		spec blessing: #development.
		spec package: 'GoferBeau' with: 'GoferBeau-dkh.25'. ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version104ProjectToolBox: spec
	<version: '1.0.4-baseline' imports: #('1.0.2-baseline' )>

	spec for: #'common' do: [
		spec preLoadDoIt: nil. ].
! !

!MetacelloConfigurationResource methodsFor: 'Issue 95' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpIssue95
	"self reset"
	
	self
		setUpConfigurationOfProjectInfinite;
		setUpConfigurationOfProjectLoop;
		setUpConfigurationOfProjectIssue95;
		yourself		! !

!MetacelloConfigurationResource methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
monticelloRepository
	^ monticelloRepository! !

!MetacelloConfigurationResource methodsFor: 'Issue 119' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfProjectIssue119dkh6: ancestors
    "versions 1.0, 2.0. 3.0,4.0, 4.1, 4.2, 4.3, 4.4"

    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'MetacelloTestConfigurationOfProjectIssue119-dkh.6'.
    className := reference packageName asSymbol.
    definitionArray := {(MCClassDefinition
        name: className
        superclassName: #'Object'
        category: className
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: true
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectClassMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'baselineVersion10Issue119:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineVersion10Issue119:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'baselineVersion20Issue119:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineVersion20Issue119:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'baselineVersion30Issue119:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineVersion30Issue119:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'baselineVersion40Issue119:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineVersion40Issue119:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version10Issue119:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version10Issue119:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version20Issue119:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version20Issue119:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version30Issue119:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version30Issue119:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version40Issue119:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version40Issue119:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version41Issue119:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version41Issue119:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version42Issue119:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version42Issue119:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version43Issue119:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version43Issue119:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version44Issue119:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version44Issue119:') asString)}.
    monticelloRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: ancestors)
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloConfigurationResource methodsFor: 'Issue 171' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfProjectIssue171dkh2: ancestors
    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'MetacelloTestConfigurationOfProjectIssue171-dkh.2'.
    className := reference packageName asSymbol.
    definitionArray := {(MCClassDefinition
        name: className
        superclassName: #'Object'
        category: className
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: true
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectClassMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'baselineVersion21Issue171:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineVersion21Issue171:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version21Issue171:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version21Issue171:') asString)}.
    monticelloRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: ancestors)
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFoo' stamp: 'dkh 07/28/2013 10:40'!
setUpIssue156ConfigurationOfProjectSoo
  "self reset"

  | reference className definitionArray |
  reference := GoferVersionReference name: 'ConfigurationOfProjectSoo-dkh.1'.
  className := reference packageName asSymbol.
  definitionArray := {(MCOrganizationDefinition
    categories: (Array with: className)).
  (MCClassDefinition
    name: className
    superclassName: #'ConfigurationOf'
    category: className
    instVarNames: #()
    comment: '').
  (MCMethodDefinition
    className: className asString
    selector: 'version10Issue156:'
    category: 'cat'
    timeStamp: ''
    source: (self class sourceCodeAt: #'version10Issue156:') asString).
  (MCMethodDefinition
    className: className asString
    selector: 'version11Issue156:'
    category: 'cat'
    timeStamp: ''
    source: (self class sourceCodeAt: #'version11Issue156:') asString).
  (MCMethodDefinition
    className: className asString
    selector: 'version20Issue156:'
    category: 'cat'
    timeStamp: ''
    source: (self class sourceCodeAt: #'version20Issue156:') asString).
  (MCMethodDefinition
    className: className asString
    selector: 'version30Issue156:'
    category: 'cat'
    timeStamp: ''
    source: (self class sourceCodeAt: #'version30Issue156:') asString)}.
  monticelloRepository
    basicStoreVersion:
      (MCVersion new
        setPackage: (MetacelloTestsMCPackage new name: reference packageName)
        info:
          (MCVersionInfo
            name: reference name
            id: UUID new
            message: 'This is a mock version'
            date: Date today
            time: Time now
            author: reference author
            ancestors: #())
        snapshot: (MCSnapshot fromDefinitions: definitionArray)
        dependencies: #())! !

!MetacelloConfigurationResource methodsFor: 'Issue 115' stamp: 'dkh 05/10/2013 17:13'!
version11Issue156: spec
  "https://github.com/dalehenrich/metacello-work/issues/156"

  <version: '1.1.0'>
  spec
    for: #'common'
    do: [ 
      spec
        baseline: 'Goo'
          with: [ spec repository: 'dictionary://Metacello_MczConfiguration_Test_Repository' ];
        yourself ]! !

!MetacelloConfigurationResource methodsFor: 'Issue 119' stamp: 'dkh 6/12/2012 15:41:23.319'!
version42Issue119: spec
    <version: '4.2' imports: #('4.0-baseline')>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'development'.
            spec project: 'Foo' with: '2.0'.
            spec package: 'GoferBar ' with: 'GoferBar-jf.1' ]! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectFie' stamp: 'dkh 6/26/2012 14:56'!
setUpConfigurationOfProjectFie
    "self reset"

    | reference className definitionArray |
    reference := GoferVersionReference name: 'MetacelloTestConfigurationOfProjectFie-dkh.1'.
    className := reference packageName asSymbol.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: className)).
    (MCClassDefinition
        name: className
        superclassName: #'Object'
        category: className
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: true
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectClassMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'baseline15ProjectFie:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baseline15ProjectFie:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'baseline25ProjectFie:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baseline25ProjectFie:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'baseline35ProjectFie:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baseline35ProjectFie:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'baseline40ProjectFie:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baseline40ProjectFie:') asString)}.
    monticelloRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #())! !

!MetacelloConfigurationResource methodsFor: 'Issue 115' stamp: 'dkh 6/12/2012 15:41:23.319'!
baselineVersion10Issue115: spec
    <version: '1.0-baseline'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'baseline'.
            spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
            spec
                project: 'Foo'
                    with: [ 
                            spec
                                versionString: #'bleedingEdge';
                                className: 'MetacelloTestConfigurationOfFoo';
                                repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
                yourself.
            spec package: 'GeauxFoo' ]! !

!MetacelloConfigurationResource methodsFor: 'Issue 77' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline13MethodSourceC

	^(self class sourceCodeAt: #baseline13C:) asString

! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version129ProjectToolBox: spec
	<version: '1.2.9-baseline'>

	spec for: #'common' do: [
		spec 
			project: 'Example Project' with: [
				spec
					className: 'MetacelloExampleProjectConfig';
					versionString: '1.0-baseline';
					preLoadDoIt: #'preloadDoIt';
					postLoadDoIt: #'postloadDoIt';
					repository: 'http://www.example.com/ob' ];
			project: 'Copy Project' copyFrom: 'Example Project' with: [
				spec
					preLoadDoIt: nil;
					postLoadDoIt: nil ]. ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version126ProjectToolBox: spec
	<version: '1.2.6-baseline' imports: #('1.2.5-baseline' )>

	spec for: #'common' do: [
		spec package: 'Example-Core' with: [
				spec 
					preLoadDoIt: nil;
					postLoadDoIt: nil. ]. ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version101ProjectToolBox: spec
	<version: '1.0.1-baseline'>

	spec for: #'common' do: [
		spec blessing: #'testBlessing'. ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version102ProjectToolBox: spec
	<version: '1.0.2-baseline'>

	spec for: #'common' do: [
		spec preLoadDoIt: #'preloadForCore'.
		spec postLoadDoIt: #'postloadForCore:package:'.
		spec 
			package: 'Example-Core' with: [
				spec includes: #('Example-AddOn' ). ];
			package: 'Example-AddOn' with: [
				spec requires: #('Example-Core' ). ];
			package: 'Example-Tests' with: [
				spec requires: #('Example-AddOn' ). ]. ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectFie' stamp: 'dkh 6/26/2012 14:48'!
baseline25ProjectFie: spec
    "self reset"

    <version: '2.5'>
    spec
        for: #'common'
        do: [ 
            spec
                configuration: 'Foo'
                    with: [ 
                            spec
                                className: 'MetacelloTestConfigurationOfFoo';
                                versionString: '3.5';
                                repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
                import: 'Foo' ]! !

!MetacelloConfigurationResource methodsFor: 'Issue 119' stamp: 'dkh 6/12/2012 15:41:23.319'!
version44Issue119: spec
    <version: '4.4' imports: #('4.0-baseline')>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'development'.
            spec project: 'Foo' with: 2.0.
            spec package: 'GoferBar ' with: 'GoferBar-jf.1' ]! !

!MetacelloConfigurationResource methodsFor: 'Issue 125' stamp: 'dkh 9/11/2012 15:13'!
baselineVersion20Issue125: spec
    <version: '2.0-baseline'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'baseline'.
            spec description: 'MetacelloConfigurationResource>>baselineVersion20Issue125:'.
            spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
            spec
                package: 'GoferFoo';
                package: 'GoferBar' with: [ spec requires: 'GoferFoo' ];
                yourself ]! !

!MetacelloConfigurationResource methodsFor: 'Issue 95' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline40MethodSourceProjectInfinite

	^(self class sourceCodeAt: #baseline40ProjectInfinite:) asString

! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version107ProjectToolBox: spec
	<version: '1.0.7-baseline'>

	spec for: #'common' do: [
		spec 
			package: 'Example-Core' with: [
				spec 
					supplyingAnswers: #( #( 'preload' 'preload answer' ) #( 'postload' 'postload answer' ) );
					preLoadDoIt: #'preloadForSupplyingAnswers';
					postLoadDoIt: #'postloadForSupplyingAnswers'. ];
			package: 'Example-Tests' with: [
				spec supplyingAnswers: #( #( 'string' 'preload answer' ) #( 'symbol' #'abc def' ) #( 'integer' 1 ) #( 'boolean' true ) #( 'another boolean' false ) #( 'character' $a ) ). ]. ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version122ProjectToolBox: spec
	<version: '1.2.2-baseline'>

	spec for: #'common' do: [
		spec project: 'Example Project' with: [
				spec
					className: 'MetacelloExampleProjectConfig';
					repository: 'http://www.example.com/ob' ]. ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFan' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline40Fan: spec 
	"self reset"
	<version: '4.0'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec 
			project: 'Foo' with: [
				spec
					className: 'MetacelloTestConfigurationOfFoo';
					versionString: '4.0';
					loads: #('GoferFaux' 'GoferBeau');
					file: 'MetacelloTestConfigurationOfFoo';
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			yourself ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version134ProjectToolBox: spec
	<version: '1.3.4-baseline'>

	spec for: #'common' do: [
 ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectFoe' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline40MethodSourceProjectFoe

	^(self class sourceCodeAt: #baseline40ProjectFoe:) asString

! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectFee' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline40MethodSourceProjectFee

	^(self class sourceCodeAt: #baseline40ProjectFee:) asString

! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
postloadDoIt
	"self reset"

	Smalltalk at: #'Metacello_Configuration_Test_POST_DoIt_Result' put: true! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version103ProjectToolBox: spec
	<version: '1.0.3-baseline' imports: #('1.0.2-baseline' )>

	spec for: #'common' do: [
		spec preLoadDoIt: #'alternatePreloadForCore'. ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectFie' stamp: 'dkh 6/26/2012 16:25'!
baseline15ProjectFie: spec
    "self reset"

    "shouldn't affect anything ... the import: should only take effect on a load"

    <version: '1.5'>
    spec
        for: #'common'
        do: [ 
            spec
                configuration: 'Foo'
                    with: [ 
                            spec
                                className: 'MetacelloTestConfigurationOfFoo';
                                versionString: '3.5';
                                repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
                import: 'Foo' ]! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version127ProjectToolBox: spec
	<version: '1.2.7-baseline'>

	spec for: #'common' do: [
		spec project: 'Example Project' with: [
				spec
					className: 'MetacelloExampleProjectConfig';
					versionString: '1.0-baseline';
					preLoadDoIt: #'preloadDoIt';
					postLoadDoIt: #'postloadDoIt';
					repository: 'http://www.example.com/ob' ]. ].
! !

!MetacelloConfigurationResource methodsFor: 'Issue 77' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpIssue77
	"self reset"
	
	self
		setUpIssue77B;
		setUpIssue77C;
		setUpIssue77D
		! !

!MetacelloConfigurationResource methodsFor: 'Issue 119' stamp: 'dkh 6/12/2012 15:41:23.319'!
baselineVersion20Issue119: spec
    <version: '2.0-baseline'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'baseline'.
            spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
            spec
                project: 'Foo'
                    with: [ 
                            spec
                                versionString: #'bleedingEdge';
                                className: 'MetacelloTestConfigurationOfFoo';
                                repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
                yourself.
            spec package: 'GoferBar ' ]! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFan' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline35Fan: spec 
	"self reset"
	<version: '3.5'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec 
			project: 'Foo' with: [
				spec
					className: 'MetacelloTestConfigurationOfFoo';
					versionString: '3.5';
					loads: #('GoferFaux' 'GoferBeau');
					file: 'MetacelloTestConfigurationOfFoo';
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			yourself ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFum' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfFum
	"self reset"
	
	| reference className definitionArray |
	reference := GoferVersionReference name: 'MetacelloTestConfigurationOfFum-dkh.1'.
	className := reference packageName asSymbol.
	definitionArray := {
					MCOrganizationDefinition categories: (Array with: className).
					MCClassDefinition name: className superclassName: #Object category: className instVarNames: #() comment: ''.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectClassMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline40ProjectFum:'
						category: 'cat'
						timeStamp: ''
						source: self baseline40MethodSourceProjectFum.
				}.
	monticelloRepository basicStoreVersion: (MCVersion new
		setPackage:  (MetacelloTestsMCPackage new name: reference packageName)
		info: (MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: #())
		snapshot: (MCSnapshot fromDefinitions: definitionArray)
		dependencies: #()) 
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
symbolicVersionExplicitlyDoesNotExistProjectToolBox: spec
    <symbolicVersion: #'explicitly does not exist'>
    spec for: #'common' version: #'notDefined'! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFoo' stamp: 'dkh 9/13/2012 15:54'!
bleedingEdgeVersion: spec
    "self reset"

    <symbolicVersion: #'bleedingEdge'>
    spec for: #'common' version: '4.0'! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectFie' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline35ProjectFie: spec 
	"just projects"
	"self reset"

	<version: '3.5'>
	spec for: #common do: [
		spec 
			project: 'Foo' with: [
				spec
					className: 'MetacelloTestConfigurationOfFoo';
					versionString: '3.5';
					file: 'MetacelloTestConfigurationOfFoo';
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			project: 'Feaux' with: [
				spec
					className: 'MetacelloTestConfigurationOfFeaux';
					versionString: '4.0';
					file: 'MetacelloTestConfigurationOfFeaux';
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			yourself. ].
! !

!MetacelloConfigurationResource methodsFor: 'Issue 119' stamp: 'dkh 6/12/2012 15:41:23.319'!
version10Issue119: spec
    <version: '1.0' imports: #('1.0-baseline')>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'development'.
            spec project: 'Foo' with: '2.0'.
            spec package: 'GoferBar' with: 'GoferBar-jf.1' ]! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFum' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline40MethodSourceProjectFum

	^(self class sourceCodeAt: #baseline40ProjectFum:) asString

! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version119ProjectToolBox: spec
	<version: '1.1.9-baseline' imports: #('1.1.4-baseline' )>

	spec for: #'common' do: [
		spec project: 'Example Project' overrides: [
				spec
					className: 'MetacelloExampleProjectConfig';
					versionString: '1.0-baseline';
					preLoadDoIt: #'alternatePreloadForCore';
					repository: 'http://www.example.com/ob' ]. ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version109ProjectToolBox: spec
	<version: '1.0.9-baseline'>

	spec for: #'common' do: [
		spec 
			package: 'Example-Core';
			package: 'Example-Tests' with: [
				spec includes: #('Example-Core' ). ]. ].
! !

!MetacelloConfigurationResource methodsFor: 'Issue 154' stamp: 'dkh 6/12/2012 15:41:23.319'!
version10MetacelloExample: spec
    <version: '1.0' imports: #('1.0-baseline')>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'release'.
            spec package: 'GoferFoo' with: 'GoferFoo-lr.2' ]! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfSymbolic' stamp: 'dkh 6/12/2012 15:41:23.319'!
version40SymbolicMethodSourceSymbolic

	^(self class sourceCodeAt: #version40Symbolic:) asString

! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFoo' stamp: 'dkh 05/11/2013 08:38'!
baselineGoo500Issue156Configuration: spec
  "https://github.com/dalehenrich/metacello-work/issues/156"

  <version: '5.0.0'>
  spec
    for: #'common'
    do: [ 
      spec
        baseline: 'Goo'
          with: [ spec repository: 'dictionary://Metacello_MczConfiguration_Test_Repository' ];
        import: 'Goo' ]! !

!MetacelloConfigurationResource methodsFor: 'Issue 115' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfProjectIssue115
	"self reset"
	
	| versionInfo |
	versionInfo := self setUpConfigurationOfProjectIssue115dkh1.
	versionInfo := self setUpConfigurationOfProjectIssue115dkh2: {versionInfo}.
	! !

!MetacelloConfigurationResource methodsFor: 'Issue 77' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpIssue77B
	"self reset"
	
	| reference className definitionArray |
	reference := GoferVersionReference name: 'MetacelloTestConfigurationOfIssue77B-dkh.1'.
	className := reference packageName asSymbol.
	definitionArray := {
					MCOrganizationDefinition categories: (Array with: className).
					MCClassDefinition name: className superclassName: #Object category: className instVarNames: #() comment: ''.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectClassMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline10B:'
						category: 'cat'
						timeStamp: ''
						source: self baseline10MethodSourceB.
				}.
	monticelloRepository basicStoreVersion: (MCVersion new
		setPackage:  (MetacelloTestsMCPackage new name: reference packageName)
		info: (MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: #())
		snapshot: (MCSnapshot fromDefinitions: definitionArray)
		dependencies: #()) 
! !

!MetacelloConfigurationResource methodsFor: 'Issue 119' stamp: 'dkh 6/12/2012 15:41:23.319'!
version30Issue119: spec
    <version: '3.0' imports: #('3.0-baseline')>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'development'.
            spec project: 'Foo' with: '2.0'.
            spec package: 'GoferBar' with: 'GoferBar-jf.1' ]! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFum' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline40ProjectFum: spec 
	"master"
	"self reset"
	<version: '4.0'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec 
			project: 'Feaux' with: [
				spec
					className: 'MetacelloTestConfigurationOfFeaux';
					versionString: '4.0';
					file: 'MetacelloTestConfigurationOfFeaux';
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			project: 'Foo' with: [
				spec
					className: 'MetacelloTestConfigurationOfFoo';
					versionString: '4.0';
					file: 'MetacelloTestConfigurationOfFoo';
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			project: 'ProjectFie' with: [
				spec
					className: 'MetacelloTestConfigurationOfProjectFie';
					versionString: '4.0';
					file: 'MetacelloTestConfigurationOfProjectFie';
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			project: 'ProjectFee' with: [
				spec
					className: 'MetacelloTestConfigurationOfProjectFee';
					versionString: '4.0';
					file: 'MetacelloTestConfigurationOfProjectFee';
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			yourself ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
baselineVersion124ProjectToolBox: spec
	<version: '1.2.4-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'.
		spec repository: 'http://www.example.com/aa'. ].

	spec for: #'common' do: [
		spec repository: 'http://www.example.com/ab'. ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version110ProjectToolBox: spec
	<version: '1.1.0-baseline'>

	spec for: #'common' do: [
		spec 
			package: 'Example-Core';
			package: 'Example-Base';
			package: 'Example-Test1' with: [
				spec 
					requires: #('Example-Base' );
					includes: #('Example-Core' ). ];
			package: 'Example-Test2' with: [
				spec 
					includes: #('Example-Core' );
					supplyingAnswers: #( #( 'captionMatch' 'answer' ) ). ];
			package: 'Example-Test3' with: [
				spec 
					requires: #('Example-Base' );
					supplyingAnswers: #( #( 'captionMatch' 'answer' ) ). ];
			package: 'Example-Test4' with: [
				spec 
					requires: #('Example-Base' );
					includes: #('Example-Core' );
					supplyingAnswers: #( #( 'captionMatch' 'answer' ) ). ]. ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version106ProjectToolBox: spec
	<version: '1.0.6-baseline'>

	spec for: #'common' do: [
		spec package: 'Example-Core' with: [
				spec repositories: [
						spec
							repository: 'http://www.example.com/ob';
							repository: 'http://www.example.com/or' ]. ]. ].
! !

!MetacelloConfigurationResource methodsFor: 'Issue 119' stamp: 'dkh 6/12/2012 15:41:23.319'!
version50Issue119: spec
    <version: '5.0' imports: #('4.0-baseline')>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'development'.
            spec project: 'Foo' with: '1.0'.
            spec package: 'GoferBar' with: 'GoferBar-jf.1' ]! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFix' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfFix
	"self reset"
	
	| reference className definitionArray |
	reference := GoferVersionReference name: 'MetacelloTestConfigurationOfFix-dkh.1'.
	className := reference packageName asSymbol.
	definitionArray := {
					MCOrganizationDefinition categories: (Array with: className).
					MCClassDefinition name: className superclassName: #Object category: className instVarNames: #() comment: ''.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectClassMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline60Fix:'
						category: 'cat'
						timeStamp: ''
						source: self baseline60MethodSourceFix.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline61Fix:'
						category: 'cat'
						timeStamp: ''
						source: self baseline61MethodSourceFix.
				}.
	monticelloRepository basicStoreVersion: (MCVersion new
		setPackage:  (MetacelloTestsMCPackage new name: reference packageName)
		info: (MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: #())
		snapshot: (MCSnapshot fromDefinitions: definitionArray)
		dependencies: #()) 
! !

!MetacelloConfigurationResource methodsFor: 'Issue 119' stamp: 'dkh 6/12/2012 15:41:23.319'!
version20Issue119: spec
    <version: '2.0' imports: #('2.0-baseline')>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'development'.
            spec project: 'Foo' with: '2.0'.
            spec package: 'GoferBar' with: 'GoferBar-jf.1' ]! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfSymbolic' stamp: 'dkh 6/12/2012 15:41:23.319'!
version43Symbolic: spec 
	"self reset"
	<version: '4.3'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec blessing: #development.
		spec 
			package: 'GoferBeau' with: 'GoferBeau-dkh.54';
			package: 'GoferFaux' with:'GoferFaux-tg.33';
			yourself ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFoo' stamp: 'dkh 07/19/2013 22:50'!
baseline40Foo: spec
  "self reset"

  <version: '4.0'>
  spec
    for: #'common'
    do: [ 
      spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
      spec
        package: 'GoferFoo' with: 'GoferFoo-lr.1';
        package: 'GoferBar' with: 'GoferBar-lr.1';
        package: 'GoferFaux' with: 'GoferFaux-tg.32';
        package: 'GoferBeau' with: 'GoferBeau-dkh.55';
        yourself.
      spec
        group: '1' with: #('GoferFoo' 'GoferBar');
        group: '2' with: #('GoferFoo' 'GoferFaux');
        yourself ]! !

!MetacelloConfigurationResource methodsFor: 'Issue 154' stamp: 'dkh 6/12/2012 15:41:23.319'!
baselineVersion30Issue154: spec
    <version: '3.0-baseline'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'baseline'.
            spec
                project: 'MetacelloExample'
                    with: [ 
                            spec
                                className: 'ConfigurationOfMetacelloExample';
                                versionString: '1.0';
                                repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
                yourself ]! !

!MetacelloConfigurationResource methodsFor: 'Issue 115' stamp: 'dkh 6/12/2012 15:41:23.319'!
version11Issue115: spec
	<version: '1.1' imports: #('1.0-baseline')>

	spec for: #'common' do: [
		spec blessing: #development.
		spec  project: 'Foo' with: ''.
		spec package: 'GeauxFoo' with: 'GeauxFoo-lr.1'. ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFoo' stamp: 'dkh 05/11/2013 08:37'!
baselineGoo400Issue156Configuration: spec
  "https://github.com/dalehenrich/metacello-work/issues/156"

  <version: '4.0.0'>
  spec
    for: #'common'
    do: [ 
      spec
        baseline: 'Goo'
          with: [ spec repository: 'dictionary://Metacello_MczConfiguration_Test_Repository' ];
        import: 'Goo' ]! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFan' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline30MethodSourceFan

	^(self class sourceCodeAt: #baseline30Fan:) asString

! !

!MetacelloConfigurationResource methodsFor: 'Issue 154' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfMetacelloExampledkh1
    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'ConfigurationOfMetacelloExample-dkh.1'.
    className := reference packageName asSymbol.
    definitionArray := {(MCClassDefinition
        name: className
        superclassName: #'Object'
        category: className
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: true
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectClassMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'baselineVersion10MetacelloExample:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineVersion10MetacelloExample:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version10MetacelloExample:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version10MetacelloExample:') asString)}.
    monticelloRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
preloadDoIt
	"self reset"

	Smalltalk at: #'Metacello_Configuration_Test_DoIt_Result' put: true! !

!MetacelloConfigurationResource methodsFor: 'Issue 115' stamp: 'dkh 6/12/2012 15:41:23.319'!
version10Issue115: spec
	<version: '1.0' imports: #('1.0-baseline')>

	spec for: #'common' do: [
		spec blessing: #development.
		spec  project: 'Foo' .
		spec package: 'GeauxFoo' with: 'GeauxFoo-lr.1'. ].
! !

!MetacelloConfigurationResource methodsFor: 'Issue 171' stamp: 'dkh 6/12/2012 15:41:23.319'!
baselineVersion20Issue171: spec
    <version: '2.0-baseline'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'baseline'.
            spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
            spec
                project: 'Foo'
                    with: [ 
                            spec
                                className: 'MetacelloTestConfigurationOfFoo';
                                repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
                yourself.
            spec package: 'GeauxFoo' ]! !

!MetacelloConfigurationResource methodsFor: 'Issue 119' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfProjectIssue119dkh4: ancestors
    "version 4.0"

    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'MetacelloTestConfigurationOfProjectIssue119-dkh.4'.
    className := reference packageName asSymbol.
    definitionArray := {(MCClassDefinition
        name: className
        superclassName: #'Object'
        category: className
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: true
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectClassMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'baselineVersion40Issue119:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineVersion40Issue119:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'version40Issue119:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version40Issue119:') asString)}.
    monticelloRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: ancestors)
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloConfigurationResource methodsFor: 'Issue 77' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline10B: spec 
	"self reset"
	<version: '1.0'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec 
			project: 'C' with: [
				spec
					className: 'MetacelloTestConfigurationOfIssue77C';
					loads: #('GoferFoo');
					versionString: '1.2';
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			package: 'GoferBeau' with: 'GoferBeau-dkh.53';
			yourself ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFoo' stamp: 'dkh 9/13/2012 15:55'!
setUpConfigurationOfFoo
    "self reset"

    | reference className definitionArray |
    reference := GoferVersionReference name: 'MetacelloTestConfigurationOfFoo-dkh.1'.
    className := reference packageName asSymbol.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: className)).
    (MCClassDefinition
        name: className
        superclassName: #'Object'
        category: className
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'bleedingEdgeVersion:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'bleedingEdgeVersion:') asString).
    (MCMethodDefinition
        className: className asString
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectMethodSource).
    (MCMethodDefinition
        className: className asString
        classIsMeta: true
        selector: 'project'
        category: 'cat'
        timeStamp: ''
        source: self projectClassMethodSource).
    (MCMethodDefinition
        className: className asString
        selector: 'baseline20Foo:'
        category: 'cat'
        timeStamp: ''
        source: self baseline20MethodSourceFoo).
    (MCMethodDefinition
        className: className asString
        selector: 'baseline30Foo:'
        category: 'cat'
        timeStamp: ''
        source: self baseline30MethodSourceFoo).
    (MCMethodDefinition
        className: className asString
        selector: 'baseline35Foo:'
        category: 'cat'
        timeStamp: ''
        source: self baseline35MethodSourceFoo).
    (MCMethodDefinition
        className: className asString
        selector: 'baseline40Foo:'
        category: 'cat'
        timeStamp: ''
        source: self baseline40MethodSourceFoo).
    (MCMethodDefinition
        className: className asString
        selector: 'baseline50Foo:'
        category: 'cat'
        timeStamp: ''
        source: self baseline50MethodSourceFoo).
    (MCMethodDefinition
        className: className asString
        selector: 'preloadDoIt'
        category: 'cat'
        timeStamp: ''
        source: self preloadDoItMethodSource)}.
    monticelloRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #())! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfSymbolic' stamp: 'dkh 6/12/2012 15:41:23.319'!
stableVersionD: spec 
	"self reset"
	<symbolicVersion: #stable>
	
	spec for: #'common' version: '4.2'.
	spec for: #'platformVersion1.x' version: '4.0'.
	spec for: #'platformVersion1.0.x' version: '4.1'.
	spec for: #'platformVersion1.1.x' version: '4.2'.
	spec for: #'platformVersion1.2.x' version: '4.3'.
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline35MethodSourceFoo

	^(self class sourceCodeAt: #baseline35Foo:) asString

! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectFee' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline40ProjectFee: spec 
	"projects and packages"
	"self reset"
	<version: '4.0'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec 
			project: 'Foo' with: [
				spec
					className: 'MetacelloTestConfigurationOfFoo';
					versionString: '4.0';
					file: 'MetacelloTestConfigurationOfFoo';
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			yourself.
		spec 
			package: 'GeauxFaux' with: 'GeauxFaux-tg.32';
			package: 'GeauxBeau' with: 'GeauxBeau-dkh.55';
			yourself ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version120ProjectToolBox: spec
	<version: '1.2.0-baseline' imports: #('1.1.4-baseline' )>

	spec for: #'common' do: [
		spec project: 'Copied Example' copyFrom: 'Example Project' with: [
				spec
					preLoadDoIt: #'alternatePreloadForCore' ]. ].
! !

!MetacelloConfigurationResource methodsFor: 'Issue 154' stamp: 'dkh 6/12/2012 15:41:23.319'!
baselineVersion13Issue154: spec
    <version: '1.3-baseline'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'baseline'.
            spec
                project: 'MetacelloExample'
                    with: [ 
                            spec
                                className: 'ConfigurationOfMetacelloExample';
                                versionString: '1.0';
                                projectPackage: [ 
                                            spec
                                                file: 'MetacelloExampleTestConfigurationIssue154.gemstone';
                                                repository: 'dictionary://Metacello_Configuration_Test_Repository' ] ];
                yourself ]! !

!MetacelloConfigurationResource methodsFor: 'Issue 119' stamp: 'dkh 05/10/2013 17:13'!
setUpConfigurationOfProjectIssue156
  "https://github.com/dalehenrich/metacello-work/issues/156"

  "self reset"

  self
    setUpIssue156BaselineOfGoo;
    setUpIssue156ConfigurationOfGoo! !

!MetacelloConfigurationResource methodsFor: 'Issue 154' stamp: 'dkh 6/12/2012 15:41:23.319'!
baselineVersion12Issue154: spec
    <version: '1.2-baseline'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'baseline'.
            spec
                project: 'MetacelloExample'
                    with: [ 
                            spec
                                className: 'ConfigurationOfMetacelloExample';
                                versionString: '1.0';
                                projectPackage: [ 
                                            spec
                                                name: 'MetacelloExampleTestConfigurationIssue154';
                                                file: 'MetacelloExampleTestConfigurationIssue154.gemstone';
                                                repository: 'dictionary://Metacello_Configuration_Test_Repository' ] ];
                yourself ]! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFeaux' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline40MethodSourceFeaux

	^(self class sourceCodeAt: #baseline40Feaux:) asString

! !

!MetacelloConfigurationResource methodsFor: 'Issue 115' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfProjectIssue115dkh2: ancestors
	"self reset"
	
	| reference className definitionArray versionInfo |
	reference := GoferVersionReference name: 'MetacelloTestConfigurationOfProjectIssue115-dkh.2'.
	className := reference packageName asSymbol.
	definitionArray := {
					MCOrganizationDefinition categories: (Array with: className).
					MCClassDefinition name: className superclassName: #Object category: className instVarNames: #() comment: ''.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectClassMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'baselineVersion10Issue115:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #baselineVersion10Issue115:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'version10Issue115:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #version10Issue115:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'version11Issue115:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #version11Issue115:) asString.
				}.
	monticelloRepository basicStoreVersion: (MCVersion new
		setPackage:  (MetacelloTestsMCPackage new name: reference packageName)
		info: (versionInfo := MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: ancestors)
		snapshot: (MCSnapshot fromDefinitions: definitionArray)
		dependencies: #()).
	^versionInfo
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version130ProjectToolBox: spec
	<version: '1.3.0-baseline'>

	spec for: #'common' do: [
		spec 
			project: 'Example Project' with: [
				spec
					className: 'MetacelloExampleProjectConfig';
					versionString: '1.0-baseline';
					preLoadDoIt: #'preloadDoIt';
					postLoadDoIt: #'postloadDoIt';
					repository: 'http://www.example.com/ob' ];
			project: 'Copy Project' copyFrom: 'Example Project' with: [
				spec repository: 'http://www.example.com/or' ]. ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectFoe' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline40ProjectFoe: spec 
	"projects and packages"
	"self reset"
	<version: '4.0'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec 
			project: 'Foo' with: [
				spec
					className: 'MetacelloTestConfigurationOfFoo';
					versionString: '4.0';
					loads: '1';
					file: 'MetacelloTestConfigurationOfFoo';
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			yourself ].
! !

!MetacelloConfigurationResource methodsFor: 'Issue 95' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfProjectInfinite
	"self reset"
	
	| reference className definitionArray |
	reference := GoferVersionReference name: 'MetacelloTestConfigurationOfProjectInfinite-dkh.1'.
	className := reference packageName asSymbol.
	definitionArray := {
					MCOrganizationDefinition categories: (Array with: className).
					MCClassDefinition name: className superclassName: #Object category: className instVarNames: #() comment: ''.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectClassMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'baseline40ProjectInfinite:'
						category: 'cat'
						timeStamp: ''
						source: self baseline40MethodSourceProjectInfinite.
				}.
	monticelloRepository basicStoreVersion: (MCVersion new
		setPackage:  (MetacelloTestsMCPackage new name: reference packageName)
		info: (MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: #())
		snapshot: (MCSnapshot fromDefinitions: definitionArray)
		dependencies: #()) 
! !

!MetacelloConfigurationResource methodsFor: 'Issue 154' stamp: 'dkh 6/12/2012 15:41:23.319'!
baselineVersion10MetacelloExample: spec
    <version: '1.0-baseline'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'baseline'.
            spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
            spec package: 'GoferFoo' ]! !

!MetacelloConfigurationResource methodsFor: 'Issue 115' stamp: 'dkh 05/11/2013 08:49'!
version20Issue156: spec
  "https://github.com/dalehenrich/metacello-work/issues/156"

  <version: '2.0.0'>
  spec
    for: #'common'
    do: [ 
      spec
        configuration: 'Goo'
          with: [ 
              spec
                versionString: '4.0.0';
                repository:
                    'dictionary://Metacello_MczConfiguration_Test_Repository' ];
        yourself ]! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFoo' stamp: 'dkh 05/11/2013 08:38'!
setUpIssue156ConfigurationOfGoo
  "https://github.com/dalehenrich/metacello-work/issues/156"

  "self reset"

  | reference className definitionArray |
  reference := GoferVersionReference name: 'ConfigurationOfGoo-dkh.1'.
  className := reference packageName asSymbol.
  definitionArray := {(MCOrganizationDefinition
    categories: (Array with: className)).
  (MCClassDefinition
    name: className
    superclassName: #'ConfigurationOf'
    category: className
    instVarNames: #()
    comment: '').
  (MCMethodDefinition
    className: className asString
    selector: 'baselineGoo300Issue156Configuration:'
    category: 'cat'
    timeStamp: ''
    source:
      (self class sourceCodeAt: #'baselineGoo300Issue156Configuration:') asString).
  (MCMethodDefinition
    className: className asString
    selector: 'baselineGoo400Issue156Configuration:'
    category: 'cat'
    timeStamp: ''
    source:
      (self class sourceCodeAt: #'baselineGoo400Issue156Configuration:') asString).
  (MCMethodDefinition
    className: className asString
    selector: 'baselineGoo500Issue156Configuration:'
    category: 'cat'
    timeStamp: ''
    source:
      (self class sourceCodeAt: #'baselineGoo500Issue156Configuration:') asString)}.
  monticelloRepository
    basicStoreVersion:
      (MCVersion new
        setPackage: (MetacelloTestsMCPackage new name: reference packageName)
        info:
          (MCVersionInfo
            name: reference name
            id: UUID new
            message: 'This is a mock version'
            date: Date today
            time: Time now
            author: reference author
            ancestors: #())
        snapshot: (MCSnapshot fromDefinitions: definitionArray)
        dependencies: #())! !

!MetacelloConfigurationResource methodsFor: 'Issue 95' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline40MethodSourceProjectLoop

	^(self class sourceCodeAt: #baseline40ProjectLoop:) asString

! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version121ProjectToolBox: spec
	<version: '1.2.1-baseline'>

	spec for: #'common' do: [
		spec blessing: #'testBlessing'.
		spec repository: 'http://www.example.com/vor'.
		spec 
			package: 'Example-Core' with: [
				spec 
					includes: #('Example-AddOn' );
					file: 'Example-Core-anon.1';
					repository: 'http://www.example.com/or';
					preLoadDoIt: #'preloadForCore';
					postLoadDoIt: #'postloadForCore:package:'. ];
			package: 'Example-AddOn' with: [
				spec requires: #('Example-Core' ). ];
			package: 'Example-Tests' with: [
				spec requires: #('Example-AddOn' ). ]. ].
! !

!MetacelloConfigurationResource methodsFor: 'Issue 77' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline13C: spec 
	"self reset"
	<version: '1.3'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec 
			package: 'GoferFoo' with: 'GoferFoo-lr.4';
			package: 'GeauxBeau' with: 'GeauxBeau-dkh.56';
			yourself ].
! !

!MetacelloConfigurationResource methodsFor: 'Issue 136' stamp: 'dkh 6/12/2012 15:41:23.319'!
version10Issue136: spec
	<version: '1.0' imports: #('1.0-baseline')>

	spec for: #'common' do: [
		spec blessing: #development.
		spec package: 'GoferBeau' with: 'GoferBeau-dkh.15'. ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline50Foo: spec 
	"self reset"
	<version: '5.0'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec 
			package: 'GoferFoo' with:'GoferFoo-lr.2';
			package: 'GoferBar' with: 'GoferBar-lr.1';
			package: 'GoferFaux' with: 'GoferFaux-tg.34';
			package: 'GoferBeau' with: 'GoferBeau-dkh.55';
			yourself.
		spec
			group: '1' with: #('GoferFoo' 'GoferBar');
			group: '2' with: #('GoferFoo' 'GoferFaux');
			yourself ].
! !

!MetacelloConfigurationResource methodsFor: 'Issue 115' stamp: 'dkh 05/11/2013 08:51'!
version30Issue156: spec
  "https://github.com/dalehenrich/metacello-work/issues/156"

  <version: '3.0.0'>
  spec
    for: #'common'
    do: [ 
      spec
        configuration: 'Goo'
          with: [ 
              spec
                versionString: '5.0.0';
                repository:
                    'dictionary://Metacello_MczConfiguration_Test_Repository' ];
        yourself ]! !

!MetacelloConfigurationResource methodsFor: 'Issue 95' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline40ProjectIssue95: spec 
	"self reset"
	<version: '4.0'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec 
			project: 'Loop' with: [
				spec
					className: 'MetacelloTestConfigurationOfProjectLoop';
					versionString: '4.0';
					loads: 'GoferFaux';
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			project: 'Infinite' with: [
				spec
					className: 'MetacelloTestConfigurationOfProjectInfinite';
					versionString: '4.0';
					loads: 'GeauxBar';
					repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
			yourself ].! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfSymbolic' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfSymbolic
	"self reset"
	
	| reference className definitionArray |
	reference := GoferVersionReference name: 'MetacelloTestConfigurationOfSymbolic-dkh.1'.
	className := reference packageName asSymbol.
	definitionArray := {
					MCOrganizationDefinition categories: (Array with: className).
					MCClassDefinition name: className superclassName: #Object category: className instVarNames: #() comment: ''.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectClassMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'stableVersionD:'
						category: 'cat'
						timeStamp: ''
						source: self stableVersionDMethodSourceSymbolic.
					MCMethodDefinition 
						className: className asString
						selector: 'version40Symbolic:'
						category: 'cat'
						timeStamp: ''
						source: self version40SymbolicMethodSourceSymbolic.
					MCMethodDefinition 
						className: className asString
						selector: 'version41Symbolic:'
						category: 'cat'
						timeStamp: ''
						source: self version41SymbolicMethodSourceSymbolic.
					MCMethodDefinition 
						className: className asString
						selector: 'version42Symbolic:'
						category: 'cat'
						timeStamp: ''
						source: self version42SymbolicMethodSourceSymbolic.
					MCMethodDefinition 
						className: className asString
						selector: 'version43Symbolic:'
						category: 'cat'
						timeStamp: ''
						source: self version43SymbolicMethodSourceSymbolic.
				}.
	monticelloRepository basicStoreVersion: (MCVersion new
		setPackage:  (MetacelloTestsMCPackage new name: reference packageName)
		info: (MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: #())
		snapshot: (MCSnapshot fromDefinitions: definitionArray)
		dependencies: #()) 
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version125ProjectToolBox: spec
	<version: '1.2.5-baseline' imports: #('1.0-baseline' )>

	spec for: #'common' do: [
		spec package: 'Example-Core' with: [
				spec 
					preLoadDoIt: #'preloadDoIt';
					postLoadDoIt: #'postloadDoIt'. ]. ].
! !

!MetacelloConfigurationResource methodsFor: 'Issue 119' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfProjectIssue119
    "self reset"

    | versionInfo |
    versionInfo := self setUpConfigurationOfProjectIssue119dkh1.
    versionInfo := self setUpConfigurationOfProjectIssue119dkh2: {versionInfo}.
    versionInfo := self setUpConfigurationOfProjectIssue119dkh3: {versionInfo}.
    versionInfo := self setUpConfigurationOfProjectIssue119dkh4: {versionInfo}.
    versionInfo := self setUpConfigurationOfProjectIssue119dkh5: {versionInfo}.
    versionInfo := self setUpConfigurationOfProjectIssue119dkh6: {versionInfo}.
    versionInfo := self setUpConfigurationOfProjectIssue119dkh7: {versionInfo}! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfSymbolic' stamp: 'dkh 6/12/2012 15:41:23.319'!
stableVersionDMethodSourceSymbolic

	^(self class sourceCodeAt: #stableVersionD:) asString

! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version131ProjectToolBox: spec
	<version: '1.3.1-baseline'>

	spec for: #'common' do: [
		spec blessing: #'baseline'. ].

	spec for: #'level1_1' do: [
		spec 
			package: 'Example-Core' with: [
				spec repository: 'http://www.example.com/1'. ];
			package: 'Example-Core' with: [
				spec repository: 'http://www.example.com/2'. ];
			package: 'Example-Core' with: [
				spec repository: 'http://www.example.com/3'. ].

		spec for: #'level2_1' do: [
			spec package: 'Example-Core' with: [
					spec repository: 'http://www.example.com/4'. ].

			spec for: #'level3_1' do: [
				spec package: 'Example-Core' with: [
						spec repository: 'http://www.example.com/5'. ]. ]. ].

		spec for: #'level2_2' do: [
			spec package: 'Example-Core' with: [
					spec repository: 'http://www.example.com/6'. ].

			spec for: #'level3_2' do: [
				spec package: 'Example-Core' with: [
						spec repository: 'http://www.example.com/7'. ]. ]. ]. ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version124ProjectToolBox: spec
	<version: '1.2.4' imports: #('1.2.4-baseline' )>

	spec for: #'common' do: [
		spec repository: 'http://www.example.com/ac'. ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline20Foo: spec 
	"self reset"
	<version: '2.0'>
	
	spec for: #common do: [
		spec repository: 'dictionary://Metacello_Gofer_Test_Repository'.
		spec 
			package: 'GoferFoo' with: 'GoferFoo-lr.1';
			package: 'GoferBar' with: 'GoferBar.branch-lr.1';
			package: 'GoferFaux' with: 'GoferFaux-tg.30';
			package: 'GoferBeau' with: 'GoferBeau-dkh.25';
			yourself ].
! !

!MetacelloConfigurationResource methodsFor: 'running' stamp: 'dkh 07/28/2013 10:40'!
setUp
  "self reset"

  super setUp.
  self
    setUpMonticelloRepository;
    setUpConfigurationOfFoo;
    setUpConfigurationOfFeaux;
    setUpConfigurationOfProjectFie;
    setUpConfigurationOfProjectFee;
    setUpConfigurationOfFum;
    setUpConfigurationOfProjectFoe;
    setUpConfigurationOfFan;
    setUpConfigurationOfFix;
    setUpIssue77;
    setUpIssue95;
    setUpConfigurationOfSymbolic;
    setUpConfigurationOfProjectToolBox;
    setUpConfigurationOfProjectIssue115;
    setUpConfigurationOfProjectIssue136;
    setUpConfigurationOfProjectIssue119;
    setUpConfigurationOfProjectIssue171;
    setUpConfigurationOfProjectIssue154;
    setUpConfigurationOfProjectIssue156;
    setUpIssue156ConfigurationOfProjectGoo;
    setUpIssue156ConfigurationOfProjectSoo;
    setUpConfigurationOfProjectFum;
    setUpConfigurationOfProjectIssue125;
    yourself! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfFoo' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline40MethodSourceFoo

	^(self class sourceCodeAt: #baseline40Foo:) asString

! !

!MetacelloConfigurationResource methodsFor: 'Issue 136' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfProjectIssue136dkh1
	"self reset"
	
	| reference className definitionArray versionInfo |
	reference := GoferVersionReference name: 'MetacelloTestConfigurationOfProjectIssue136-dkh.1'.
	className := reference packageName asSymbol.
	definitionArray := {
					MCOrganizationDefinition categories: (Array with: className).
					MCClassDefinition name: className superclassName: #Object category: className instVarNames: #() comment: ''.
					MCMethodDefinition 
						className: className asString
						classIsMeta: true
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectClassMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'project'
						category: 'cat'
						timeStamp: ''
						source: self projectMethodSource.
					MCMethodDefinition 
						className: className asString
						selector: 'baselineVersion10Issue136:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #baselineVersion10Issue136:) asString.
					MCMethodDefinition 
						className: className asString
						selector: 'version10Issue136:'
						category: 'cat'
						timeStamp: ''
						source: (self class sourceCodeAt: #version10Issue136:) asString.
				}.
	monticelloRepository basicStoreVersion: (MCVersion new
		setPackage:  (MetacelloTestsMCPackage new name: reference packageName)
		info: (versionInfo := MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: #())
		snapshot: (MCSnapshot fromDefinitions: definitionArray)
		dependencies: #()).
	^versionInfo! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectFum' stamp: 'dkh 7/19/2012 07:30'!
baseline10ProjectFum: spec
    "self reset"

    <version: '1.0'>
    spec
        for: #'common'
        do: [ 
            spec
                project: 'Foo'
                    with: [ 
                            spec
                                className: 'MetacelloTestConfigurationOfFoo';
                                versionString: '5.0';
                                repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
                project: 'Fie'
                    with: [ 
                            spec
                                className: 'MetacelloTestConfigurationOfProjectFie';
                                versionString: '2.5';
                                repository: 'dictionary://Metacello_Configuration_Test_Repository' ];
                yourself ]! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version123ProjectToolBox: spec
	<version: '1.2.3-baseline'>

	spec for: #'common' do: [
		spec project: 'Example Project' with: [
				spec
					className: 'MetacelloExampleProjectConfig';
					repository: 'http://www.example.com/ob';
					repository: 'http://www.example.com/or' ]. ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
baselineVersion113ProjectToolBox: spec
	<version: '1.1.3-baseline'>

	spec for: #'outer' do: [
		spec 
			package: 'Example-Core';
			package: 'Example-Test'. ].
! !

!MetacelloConfigurationResource methodsFor: 'ConfigurationOfProjectToolBox' stamp: 'dkh 6/12/2012 15:41:23.319'!
version128ProjectToolBox: spec
	<version: '1.2.8-baseline' imports: #('1.2.7-baseline' )>

	spec for: #'common' do: [
		spec project: 'Example Project' with: [
				spec
					preLoadDoIt: nil;
					postLoadDoIt: nil ]. ].
! !

!MetacelloConfigurationResource methodsFor: 'Issue 125' stamp: 'dkh 9/11/2012 15:46'!
version30Issue125: spec
    <version: '3.0' imports: #('3.0-baseline')>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'release'.
            spec description: 'MetacelloConfigurationResource>>version30Issue125:'.
            spec
                package: 'GoferFoo' with: 'GoferFoo-lr.4';
                package: 'GoferBar' with: 'GoferBar-jf.1';
                yourself ].
    spec
        for: #'attribute1'
        do: [ 
            spec
                package: 'GoferFaux' with: 'GoferFaux-tg.32';
                package: 'GoferBeau' with: 'GoferBeau-dkh.55';
                yourself ].
    spec
        for: #'attribute2'
        do: [ 
            spec
                package: 'GoferFaux' with: 'GoferFaux-tg.33';
                package: 'GoferBeau' with: 'GoferBeau-dkh.56';
                yourself ]! !

!MetacelloConfigurationResource class methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
projectAttributes

	ProjectAttributes == nil ifTrue: [ ^#() ].
	^ProjectAttributes! !

!MetacelloConfigurationResource class methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
project

	^self new project! !

!MetacelloConfigurationResource class methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
projectAttributes: aCollection

	ProjectAttributes := aCollection! !

!MetacelloConfigurationSpecGenerator methodsFor: 'accessing' stamp: 'dkh 7/16/2012 11:28'!
projectSpecLookupBlock
    ^ [ :projectName | 
    {(MetacelloProjectRegistration
        projectSpecForClassNamed: (MetacelloScriptEngine configurationNameFrom: projectName)
        ifAbsent: [  ])} ]! !

!MetacelloConfigurationSpecGenerator methodsFor: 'accessing' stamp: 'dkh 7/16/2012 10:43'!
projectSpecCreationBlock
    ^ [ :projectName | {(MetacelloMCProject new configurationOfProjectSpec name: projectName)} ]! !

!MetacelloConfigurationSpecGenerator methodsFor: 'accessing' stamp: 'dkh 7/16/2012 10:45'!
projectSpecListBlock
    ^ [ MetacelloProjectRegistration configurationProjectSpecs ]! !

!MetacelloConfigurationTutorialPart1 methodsFor: 'lessons' stamp: 'NicolaiHess 6/5/2014 23:44'!
lesson10
	^Lesson
		title: 'Lesson 10'
		lesson: 
'
Smalltalk tools browser fullOnClass: MetacelloTutorialConfig selector: #baseline10:.
Smalltalk tools browser fullOnClass: MetacelloTutorialConfig selector: #version10:.

"In #baseline10: we''ve added two things: the ''Example-AddOnTests'' package and a specification for 
groups. 

The ''Example-AddOnTests'' package has been added to make the idea of needing to group packages a
little more appealing. The package requires ''Example-AddOn'' and ''Example-Tests''.

With two Test packages it would be convenient to be able to load all of the tests with a simple
expression like the following:"

  (MetacelloTutorialConfig project version: ''1.0'') load: { ''Tests''. }.

"instead of having to explicitly list all of the test projects like this:"

  (MetacelloTutorialConfig project version: ''1.0'') 
	load: { ''Example-Tests''. ''Example-AddOnTests''. }.

"This becomes especially useful if over time the project evolves to have more component and test 
packages.

The ''default'' group is special in that when a ''default'' group is defined, the #load method loads
the members of the ''default'' group instead of loading all of the packages:"

  (MetacelloTutorialConfig project version: ''1.0'') load.

"If you want to load all of the packages in a project, then the pseudo group ''ALL'' may be used as
follows:"

  (MetacelloTutorialConfig project version: ''1.0'') load: ''ALL''.


ProfStef next.
'! !

!MetacelloConfigurationTutorialPart1 methodsFor: 'lessons' stamp: 'NicolaiHess 6/5/2014 23:44'!
lesson11Timestamp
	^Lesson
		title: 'Lesson 11 (Timestamp)'
		lesson: 
'
Smalltalk tools browser fullOnClass: MetacelloTutorialConfig selector: #version11:.

"The timestamp of a version can be defined:"

	(MetacelloTutorialConfig project version: ''1.1'') timestamp.

"When using the OB-Metacello tools the timestamp field is automatically updated to reflect the current
DateAndTime that the update was made.

The timestamp is a String"

ProfStef next.
'! !

!MetacelloConfigurationTutorialPart1 methodsFor: 'lessons' stamp: 'NicolaiHess 6/5/2014 23:43'!
lesson06
	^Lesson
		title: 'Lesson 6'
		lesson: 
'
Smalltalk tools browser fullOnClass: MetacelloTutorialConfig selector: #version06:.

"In version 0.6 we''ve added dependency information in the form of the #requires: directive.
Both ''Example-Tests'' and  ''Example-AddOn'' require ''Example-Core'' to be loaded before they are
loaded. Print the following expressions to see that the requires directives are being followed:"

  (MetacelloTutorialConfig project version: ''0.5'') load: { ''Example-Tests''. }.
  (MetacelloTutorialConfig project version: ''0.6'') load: { ''Example-Tests''. }.
  (MetacelloTutorialConfig project version: ''0.6'') load: ''Example-AddOn''.
  (MetacelloTutorialConfig project version: ''0.6'') load: { ''Example-AddOn''. ''Example-Tests''. }.

"With version 0.6 we are mixing structural information (required packages and repository) with the
dynamic file version info. It is expected that over time the file version info will change from
version to version while the structural information will remain relatively static."

ProfStef next.
'! !

!MetacelloConfigurationTutorialPart1 methodsFor: 'lessons' stamp: 'NicolaiHess 6/5/2014 23:43'!
lesson02
	^Lesson
		title: 'Lesson 2'
		lesson: 
'
Smalltalk tools browser fullOnClass: MetacelloTutorialConfig selector: #version02:.

"For version 0.2, we''ve simply updated the package version to ''Example-Core-anon.9'', which 
can be confirmed by printing the following expression:"

  (MetacelloTutorialConfig project version: ''0.2'') spec.

ProfStef next.
'! !

!MetacelloConfigurationTutorialPart1 methodsFor: 'tutorial' stamp: 'DaleHenrichs 11/15/2010 12:10'!
tutorial
	^ #(#lesson01 #lesson02 #lesson03 #lesson04 #lesson05 #lesson06 #lesson07 #lesson08 #lesson10 #lesson11 #lesson11Author #lesson11Blessing #lesson11Descripton #lesson11Timestamp #lesson12DoIts #lesson13)! !

!MetacelloConfigurationTutorialPart1 methodsFor: 'lessons' stamp: 'NicolaiHess 6/5/2014 23:43'!
lesson05
	^Lesson
		title: 'Lesson 5'
		lesson: 
'
Smalltalk tools browser fullOnClass: MetacelloTutorialConfig selector: #version05:.

"For version 0.5 we''ve added an additional package to the mix: ''Example-AddOn'':"

  (MetacelloTutorialConfig project version: ''0.5'') spec.

"Of course, the point of specifiying packages in Metacello is to be able to load versions. Here are
a couple examples of loading versions of the Tutorial. If you print the result of each expression, 
you will see the list of packages in load order (note that for the tutorial, we are using the 
MetacelloNullRecordingMCSpecLoader. This class records which packages are loaded and the order that they are loaded in among other things instead of actually loading the packages."

  (MetacelloTutorialConfig project version: ''0.1'') load.
  (MetacelloTutorialConfig project version: ''0.4'') load.
  (MetacelloTutorialConfig project version: ''0.5'') load.

"You will note that in each case, all of the packages associated with the version are loaded, which 
is the default. 

If you want to load a subset of the packages in a project, you may list the packages that you
are interested in as an argument to the #load: method:"

  (MetacelloTutorialConfig project version: ''0.5'') load: { ''Example-Tests''. ''Example-Core'' }.

"Note that the ordering of the packages is based on the order in which the packages are specified.

If you evaluate the following expression:"

  (MetacelloTutorialConfig project version: ''0.5'') load: { ''Example-Tests''. }.

"Only the package is ''Example-Tests''. By default the packages are ordered, but there are no implicit
dependencies."

ProfStef next.
'! !

!MetacelloConfigurationTutorialPart1 methodsFor: 'lessons' stamp: 'NicolaiHess 6/5/2014 23:44'!
lesson08
	^Lesson
		title: 'Lesson 8'
		lesson: 
'
Smalltalk tools browser fullOnClass: MetacelloTutorialConfig selector: #version08:.

"In version 0.8 we''ve simply updated the package versions, which can be seen by comparing the 
results of loading version 0.7 and 0.8:"

  (MetacelloTutorialConfig project version: ''0.7'') load.
  (MetacelloTutorialConfig project version: ''0.8'') load.


ProfStef next.
'! !

!MetacelloConfigurationTutorialPart1 methodsFor: 'lessons' stamp: 'NicolaiHess 6/5/2014 23:43'!
lesson01
	^Lesson
		title: 'Lesson 1'
		lesson: 
'
Smalltalk tools browser fullOnClass: MetacelloTutorialConfig selector: #version01:.

"Version 0.1 represents the simplest version specification possible. 

In the method #version01, version 0.1 is defined with a single package ''Example-Core-anon.8'' 
that is loaded from the repository ''http://www.example.com/Example''.

Looking at this method you will notice a couple of things. 

Immediately after the method selector you see the pragma definition:

  <version: ''0.1''>

The pragma indicates that the version created in this method should be associated with version 
''0.1'' of the Tutorial project.

Looking a little closer you see that the argument to the method, <spec>, is the only variable in
the method and it is used as the receiver to four different messages:

  - #for:do:
  - #package:with:
  - #file: 
  - #repository:

With the evaluation of each block expression, a new object is pushed on a stack and the messages
within the block are sent to the object on the top of the stack.

So the method should be read as:

  Create version ''0.1''. The #common code for version ''0.1'' (#for:do:) consists of a package named 
  ''Example-Core'' (#package:with:) whose file attribute is ''Example-Core-anon.8'' (#file:) and whose 
  repository attribute is ''http://www.example.com/Example'' (#repository:).

We can see the spec created for version 0.1 by printing the following expression:"

  (MetacelloTutorialConfig project version: ''0.1'') spec.

"Note that in creating version ''0.1'' the #common attribute is extracted out.

In addition to #common, there are pre-defined attributes for each of the platforms upon which
Metacello runs (#pharo, #squeak, #gemstone and #squeakCommon). 

#squeakCommon is used for both #pharo and #squeak."

ProfStef next.
'! !

!MetacelloConfigurationTutorialPart1 methodsFor: 'intro' stamp: 'DaleHenrichs 11/15/2010 12:14'!
introductionText

	^'Convers basic Metacello configuration specifications:
	1. Open a code browser on the MetacelloTutorialConfig class:"
		MetacelloTutorialConfig browse.
	"2. In the browser view the ''--all--'' category.
	3. Have fun!!"'! !

!MetacelloConfigurationTutorialPart1 methodsFor: 'lessons' stamp: 'NicolaiHess 6/5/2014 23:43'!
lesson04
	^Lesson
		title: 'Lesson 4'
		lesson: 
'
Smalltalk tools browser fullOnClass: MetacelloTutorialConfig selector: #version04:.

"The specification for version 0.4 is basically the same as version 0.3. Instead of listing a 
repository with each package we specify a project repository that applies to all packages.

Compare the printStrings for the specs for each version:"

  (MetacelloTutorialConfig project version: ''0.3'') spec.

  (MetacelloTutorialConfig project version: ''0.4'') spec.


ProfStef next.
'! !

!MetacelloConfigurationTutorialPart1 methodsFor: 'lessons' stamp: 'NicolaiHess 6/5/2014 23:43'!
lesson07
	^Lesson
		title: 'Lesson 7'
		lesson: 
'
Smalltalk tools browser fullOnClass: MetacelloTutorialConfig selector: #baseline07:.
Smalltalk tools browser fullOnClass: MetacelloTutorialConfig selector: #version07:.

"For version 0.7, we are ceating a baseline version specification which is expected to be used
across several versions and the version specification which is restricted to the file versions.

In method #baseline07: the structure of version ''0.7-baseline'' is specified. The repository is 
listed, the packages are listed and the required packages are defined. We''ll cover the #blessing:
in a later lesson.

In method #version07: the file versions are specified. You will note that the pragma as an #imports: component that specifies the list of versions that this version (version ''0.7'') is based upon. In 
fact, if you print the spec for ''0.7-baseline'' and then print the spec for ''0.7'' you can see that 
''0.7'' is a composition of both versions:"

   (MetacelloTutorialConfig project version: ''0.7-baseline'') spec.
   (MetacelloTutorialConfig project version: ''0.7'') spec.

"Of course if you print the ''0.6'' spec and the ''0.7'' spec you can see that they specify exactly the
same information in a slightly different way:"

  (MetacelloTutorialConfig project version: ''0.6'') spec.
  (MetacelloTutorialConfig project version: ''0.7'') spec.

"and if you load each of the versions, you will see that they load the same packages, in the same 
order:"

  (MetacelloTutorialConfig project version: ''0.6'') load.
  (MetacelloTutorialConfig project version: ''0.7'') load.

"Finally, even though version ''0.7-baseline'' does not have explicit package versions, you may load
the version. When the ''real'' loader encounters a package name (without version information) it will
attempt to load the latest version of the package from the repository. With the
MetacelloNullRecordingMCSpecLoader the packages names are ''loaded'':"

  (MetacelloTutorialConfig project version: ''0.7-baseline'') load.

"Of course when a number of developers are working on a project it may be useful to load a
#baseline version so that you get the latest work from all of the project members. "

ProfStef next.
'! !

!MetacelloConfigurationTutorialPart1 methodsFor: 'lessons' stamp: 'NicolaiHess 6/5/2014 23:44'!
lesson11Author
	^Lesson
		title: 'Lesson 11 (Author)'
		lesson: 
'
Smalltalk tools browser fullOnClass: MetacelloTutorialConfig selector: #version11:.

"The author of a version can be defined:"

	(MetacelloTutorialConfig project version: ''1.1'') author.

"When using the OB-Metacello tools the author field is automatically updated to reflect the current
author as defined in the image."

ProfStef next.
'! !

!MetacelloConfigurationTutorialPart1 methodsFor: 'lessons' stamp: 'NicolaiHess 6/5/2014 23:43'!
lesson03
	^Lesson
		title: 'Lesson 3'
		lesson: 
'
Smalltalk tools browser fullOnClass: MetacelloTutorialConfig selector: #version03:.

"For version 0.3, we''ve updated the package version to ''Example-Core-anon.10'' and added an additional 
package ''Example-Tests-anon.3'', which can be confirmed by printing the following expression:"

  (MetacelloTutorialConfig project version: ''0.3'') spec

"As is often the case, the two packages share the same repository, so specifying a repository with
each package is redundant."

ProfStef next.
'! !

!MetacelloConfigurationTutorialPart1 methodsFor: 'lessons' stamp: 'NicolaiHess 6/5/2014 23:44'!
lesson11
	^Lesson
		title: 'Lesson 11'
		lesson: 
'
Smalltalk tools browser fullOnClass: MetacelloTutorialConfig selector: #version11:.

"In version 0.11 we''ve defined a couple of attributes that are expected to be used all of the time
in a version specification:

  #blessing:
  #description:
  #author:
  #timestamp:

The following lessons cover each of these attributes in more detail. "

ProfStef next.
'! !

!MetacelloConfigurationTutorialPart1 methodsFor: 'lessons' stamp: 'NicolaiHess 6/5/2014 23:44'!
lesson11Descripton
	^Lesson
		title: 'Lesson 11 (Description)'
		lesson: 
'
Smalltalk tools browser fullOnClass: MetacelloTutorialConfig selector: #version11:.

"A description can be defined for a version:"

	(MetacelloTutorialConfig project version: ''1.1'') description.
	

ProfStef next.
'! !

!MetacelloConfigurationTutorialPart1 methodsFor: 'lessons' stamp: 'NicolaiHess 6/5/2014 23:44'!
lesson13
	^Lesson
		title: 'Lesson 12 (DoIts)'
		lesson: 
'
Smalltalk tools browser fullOnClass: MetacelloTutorialConfig selector: #baseline13:.
Smalltalk tools browser fullOnClass: MetacelloTutorialConfig selector: #version13:.

"For version 1.3 we are adding a platform specific package ''Example-Platform''. ''Example-Platform''
requires ''Example-Core''. On GemStone, Pharo and Squeak, a branch of the ''Example-Platform'' package 
will be loaded: ''Example-Platform.gemstone'', ''Example-Platform.pharo'', ''Example-Platform.squeak'' 
respectively will be loaded. 

Consequently we''ve updated the baselines with #baseline13: to reflect the structural changes and
#version13: reflects the package versions.

The platform-specific versions and branches are defined in the #for:do: block for the corresponding
platforms: #gemstone, #pharo, #squeak (in both methods)

The result of the following expression will depend on the platform upon which you are running:"

	(MetacelloTutorialConfig project version: ''1.3'') load.

"Note that when you execute the following expresson to load ''Example-Core'' that the correct
''Example-Platform'' is loaded as well:"

	(MetacelloTutorialConfig project version: ''1.3'') load: ''Example-Core''.

"If you look at the specification for ''Example-Core'' (in #baseline13:) you will note that 
''Example-Core'' #includes: ''Example-Platform''. The #includes: directive means that the package 
''Example-Platform'' should be loaded whenever the ''Example-Core'' package is loaded.

Also note when you evaluate the following expression that the ''Example-Platform'' package is loaded
before ''Example-Tests'' as if ''Example-Tests'' #requires: ''Example-Platform'':"

	(MetacelloTutorialConfig project version: ''1.3'') load: ''Example-Tests''.

"When you use the #includes: directive, you are not only specifying that the listed packages should
be loaded when the parent package is loaded, but that the #included: packages should be loaded
_before_ any packages that require the parent package."

ProfStef next.
'! !

!MetacelloConfigurationTutorialPart1 methodsFor: 'lessons' stamp: 'NicolaiHess 6/5/2014 23:44'!
lesson12DoIts
	^Lesson
		title: 'Lesson 12 (DoIts)'
		lesson: 
'
Smalltalk tools browser fullOnClass: MetacelloTutorialConfig selector: #version12:.
Smalltalk tools browser fullOnClass: MetacelloTutorialConfig selector: #preloadForCore.
Smalltalk tools browser fullOnClass: MetacelloTutorialConfig selector: #postloadForCore:package:.

"Occassionally, you find that you need to perform an expression either before a package is loaded, or
after a package is loaded. To do that in Metacello, you can define a preLoadDoIt selector and a 
postLoadDoIt selector:"

	(MetacelloTutorialConfig project version: ''1.2'') spec.

"If you open a Transcript and execute the following expression, you will see that the pre load and
post load methods were executed:"

	(MetacelloTutorialConfig project version: ''1.2'') load.

"The pre/post load methods may take 0, 1 or 2 args. The loader is the first optional argument and the 
loaded packageSpec is the second optional argument."

ProfStef next.
'! !

!MetacelloConfigurationTutorialPart1 methodsFor: 'lessons' stamp: 'NicolaiHess 6/5/2014 23:44'!
lesson11Blessing
	^Lesson
		title: 'Lesson 11 (Blessing)'
		lesson: 
'
Smalltalk tools browser fullOnClass: MetacelloTutorialConfig selector: #version11:.

"A version can be tagged with a blessing like #alpha, #beta, #release, #development or any 
other tag that you find useful. The blessing for version 1.1 is #development"

	(MetacelloTutorialConfig project version: ''1.1'') blessing.

"The default blessing is #release, so even though we didn''t specify a blessing for version 
0.5, the blessing is set:"

	(MetacelloTutorialConfig project version: ''0.5'') blessing.
	
"For version 1.1, it is important to explicitly set the blessing, because it imports version
''1.0-baseline'' whose blessing is #baseline:"

	(MetacelloTutorialConfig project version: ''1.0-baseline'') blessing.

"Blessings can be used as a filter. For example, you will notice that the result of the 
following expression is version 0.6, because #stableVersion answers the latest version whose 
blessing is _not_ #development, #broken, or #blessing: "

	MetacelloTutorialConfig project stableVersion.
	MetacelloTutorialConfig project stableVersion load.

"The blessing of version 1.1 is #development. To find the latest #development version you 
would execute this expression:"

	MetacelloTutorialConfig project latestVersion: #development.
	(MetacelloTutorialConfig project latestVersion: #development) load.

"You can get the very last version independent of blessing by executing this expression:"

	MetacelloTutorialConfig project bleedingEdge.
	MetacelloTutorialConfig project bleedingEdge load.
	
"In general, the #development blessing should be used for any version that is unstable. Once a 
version has stabilized, a different blessing should be applied.

The following expression will load the latest version of all of the packages for the latest 
#baseline version:"

	(MetacelloTutorialConfig project latestVersion: #baseline) load.

"Since the latest #baseline version should reflect the most up-to-date project structure, executing
the previous expression should load the absolute bleeding edge of the project. "

ProfStef next.
'! !

!MetacelloConfigurationTutorialPart2 methodsFor: 'lessons' stamp: 'NicolaiHess 6/5/2014 23:45'!
lesson10
	^Lesson
		title: 'Lesson 10'
		lesson: 
'
Smalltalk tools browser fullOnClass: MetacelloProjectRefTutorialConfig selector: #baseline10:.
Smalltalk tools browser fullOnClass: MetacelloProjectRefTutorialConfig selector: #version10:.

"In lesson07 it was obvious that we copied the configuration information from 
MetacelloTutorialConfig and adapted it to our project.

There is a better way.

In #baseline10: we''ve created a project reference for the Example project.

The #className: specifies the name of the class that contains the project metadata. If 
the class is not present in the image, then we know that we need to load the 
configuration for the project.

The #file: and #repository: specifications give us the information needed to load the 
project metadata from a repository.

Finally, the #versionString: and #loads: tell us which version of the project to load 
and which packages to load from the project.

We''ve named the project reference ''Example ALL'' and in the specification for the 
''Project-Core'' package, we''ve specified that ''Example ALL'' is required:"

  (MetacelloProjectRefTutorialConfig project version: ''1.0'') load.

"Note that the entire Example project is loaded before ''Project-Core''"

ProfStef next.
'
! !

!MetacelloConfigurationTutorialPart2 methodsFor: 'intro' stamp: 'DaleHenrichs 11/15/2010 12:14'!
introductionText

	^'Covers project reference specifications:
	1. Open a code browser on the MetacelloTutorialConfig class:"
		MetacelloTutorialConfig browse.
	"2. In the browser view the ''--all--'' category.
	3. Have fun!!"'! !

!MetacelloConfigurationTutorialPart2 methodsFor: 'lessons' stamp: 'NicolaiHess 6/5/2014 23:45'!
lesson12
	^Lesson
		title: 'Lesson 12'
		lesson: 
'
Smalltalk tools browser fullOnClass: MetacelloProjectRefTutorialConfig selector: #baseline11:.
Smalltalk tools browser fullOnClass: MetacelloProjectRefTutorialConfig selector: #baseline12:.
Smalltalk tools browser fullOnClass: MetacelloProjectRefTutorialConfig selector: #version12:.

"In #baseline11: there is redundant information for each of the project references. 

In #baseline12: we use the #project:copyFrom:with: method to eliminate the need to 
specify the bulk of the project information twice. 

Evaluate and compare the results of the following expressions:"
 
  (MetacelloProjectRefTutorialConfig project version: ''1.1'') load: ''Project-Core''.
  (MetacelloProjectRefTutorialConfig project version: ''1.2'') load: ''Project-Core''.

  (MetacelloProjectRefTutorialConfig project version: ''1.1'') load: ''Project-Tests''.
  (MetacelloProjectRefTutorialConfig project version: ''1.2'') load: ''Project-Tests''.


ProfStef next.
'! !

!MetacelloConfigurationTutorialPart2 methodsFor: 'lessons' stamp: 'NicolaiHess 6/5/2014 23:45'!
lesson07
	^Lesson
		title: 'Lesson 7'
		lesson: 
'
Smalltalk tools browser fullOnClass: MetacelloProjectRefTutorialConfig selector: #baseline07:.
Smalltalk tools browser fullOnClass: MetacelloProjectRefTutorialConfig selector: #version07:.

"NOTE: you should run through the lessons in Part 1 first.

In this configuration we are defining a project that utilizes the packages from the 
Example project (MetacelloTutorialConfig):  ''Example-Core'', ''Example-AddOn'', 
''Example-Tests'' and 2 packages specific to the project: ''Project-Core'' and 
''Project-Tests'':"

  (MetacelloProjectRefTutorialConfig project version: ''0.7'') load.


ProfStef next.
'! !

!MetacelloConfigurationTutorialPart2 methodsFor: 'lessons' stamp: 'NicolaiHess 6/5/2014 23:45'!
lesson14
	^Lesson
		title: 'Lesson 14'
		lesson: 
'
Smalltalk tools browser fullOnClass: MetacelloProjectRefTutorialConfig selector: #baseline14:.
Smalltalk tools browser fullOnClass: MetacelloProjectRefTutorialConfig selector: #version14:.

"In this lesson we''ll cover the querying API for Metacello. The querying API is useful for analyzing the contents and structure of a version.

To start with we''ll look at version ''1.4'' of the MetacelloProjectRefTutorialConfig. You can list the packages in the version:"

  (MetacelloProjectRefTutorialConfig project version: ''1.4'') packages.

"The list project references:"

  (MetacelloProjectRefTutorialConfig project version: ''1.4'') projects.

"And the groups:"

  (MetacelloProjectRefTutorialConfig project version: ''1.4'') groups.

"You can access individual packages/project refs/groups using  the #packageNamed: method. Here you can access the package named: ''Project-Core'':"

  (MetacelloProjectRefTutorialConfig project version: ''1.4'') packageNamed: ''Project-Core''.

"The project reference named ''Example Default'':"

 (MetacelloProjectRefTutorialConfig project version: ''1.4'') packageNamed: ''Example Default''.

"The group named ''Core'':"

 (MetacelloProjectRefTutorialConfig project version: ''1.4'') packageNamed: ''Core''.

"Each of the attributes of the package can be accessed (#requires, #includes, #file, #repository, #preLoadDoIt, and #postLoadDoit). For example:"

  ((MetacelloProjectRefTutorialConfig project version: ''1.4'') packageNamed: ''Project-Core'') requires.

"Each of the attributes of the project can be accessed (#className, #versionString, #operator, #loads, #file, and #repository). For example:"

  ((MetacelloProjectRefTutorialConfig project version: ''1.4'') packageNamed: ''Example Default'') repository.

"Each of the attributes of the group can be accessed (#includes). For example:"

  ((MetacelloProjectRefTutorialConfig project version: ''1.4'') packageNamed: ''default'') includes.

"When looking at the ''Core'' group, there is only one package listed:"

  (MetacelloProjectRefTutorialConfig project version: ''1.4'') packageNamed: ''Core''.

"In the case of the ''Core'' group, it is defined in terms of the ''default'', which isn''t very useful. When looking at the contents of groups you''d like to see the complete list of packages, without having to explicitly expanding each group you encounter. #packagesForSpecNamed: does just that:"

  (MetacelloProjectRefTutorialConfig project version: ''1.4'') packagesForSpecNamed: ''Core''.

"If you were to load the ''Core'' package:"

  (MetacelloProjectRefTutorialConfig project version: ''1.4'') load: ''Core''.

"You end up seeing the packages from the Example project. If you want to get the list of packages that _would_ be loaded, you can use #allPackagesForSpecNamed:. For example:"

  (MetacelloProjectRefTutorialConfig project version: ''1.4'') allPackagesForSpecNamed: ''Core''.

"If you use #allPackagesForSpecNamed: with a project refernce name, you''ll see the packages that _would_ be loaded:"

  (MetacelloProjectRefTutorialConfig project version: ''1.4'') load: ''Example Default''.
  (MetacelloProjectRefTutorialConfig project version: ''1.4'') allPackagesForSpecNamed: ''Example Default''.

"You can also send #version to a project reference. This is useful if you want to explicitly walk the tree of projects:"

  ((MetacelloProjectRefTutorialConfig project version: ''1.4'') packageNamed: ''Example Default'') version.


ProfStef next.
'! !

!MetacelloConfigurationTutorialPart2 methodsFor: 'tutorial' stamp: 'DaleHenrichs 11/15/2010 12:24'!
tutorial
	^ #(#lesson07 #lesson10 #lesson11 #lesson12 #lesson13 #lesson14)! !

!MetacelloConfigurationTutorialPart2 methodsFor: 'lessons' stamp: 'NicolaiHess 6/5/2014 23:45'!
lesson11
	^Lesson
		title: 'Lesson 11'
		lesson: 
'
Smalltalk tools browser fullOnClass: MetacelloProjectRefTutorialConfig selector: #baseline11:.
Smalltalk tools browser fullOnClass: MetacelloProjectRefTutorialConfig selector: #version11:.

"As is often the case, it is useful to separate the test package from the core packages 
for a project. 

In #baseline11: we''ve created two project references. The reference named 
''Example Default'' loads the ''default'' group and the reference named ''Example Tests'' 
loads the ''Tests'' group.

We then made ''Project-Core'' require ''Example Default'' and ''Project-Tests'' requires 
''Project-Core'' and ''Example Tests''.

Now it is possible to load just the core packages:"

  (MetacelloProjectRefTutorialConfig project version: ''1.1'') load: ''Project-Core''.

"or the whole enchilada including tests:"

  (MetacelloProjectRefTutorialConfig project version: ''1.1'') load: ''Project-Tests''.


ProfStef next.
'! !

!MetacelloConfigurationTutorialPart2 methodsFor: 'lessons' stamp: 'NicolaiHess 6/5/2014 23:45'!
lesson13
	^Lesson
		title: 'Lesson 13'
		lesson: 
'
Smalltalk tools browser fullOnClass: MetacelloProjectRefTutorialConfig selector: #version13:.

"In #version13: we are importing the ''1.2-baseline'', but changing the Example project 
version to 1.3, so project versions can be updated in the verson method jus like 
package versions.

Evaluate and compare the results of these expressions:"

  (MetacelloProjectRefTutorialConfig project version: ''1.2'') load: ''Project-Core''.
  (MetacelloProjectRefTutorialConfig project version: ''1.3'') load: ''Project-Core''.

  (MetacelloProjectRefTutorialConfig project version: ''1.2'') load: ''Project-Tests''.
  (MetacelloProjectRefTutorialConfig project version: ''1.3'') load: ''Project-Tests''.

"It is worth noting that in version 1.3 of the Example project, the platform-specific
''Example-Platform'' was introduced and nothing special had to be done in the project 
reference to get the package included."

ProfStef next.
'! !

!MetacelloCopyMemberSpec methodsFor: 'actions' stamp: 'dkh 6/5/2012 19:01:24'!
applyAdd: addBlock copy: copyBlock merge: mergeBlock remove: removeBlock
    copyBlock value: self! !

!MetacelloCopyMemberSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
sourceName: aString

	sourceName := aString! !

!MetacelloCopyMemberSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
sourceName

	^sourceName! !

!MetacelloCopyMemberSpec methodsFor: 'actions' stamp: 'dkh 6/5/2012 19:01:24'!
applyToList: aListSpec

	aListSpec copy: self! !

!MetacelloCopyMemberSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
methodUpdateSelector

	^#copy:! !

!MetacelloCoreIssue125TestCase methodsFor: 'tests' stamp: 'dkh 05/11/2013 10:58'!
testForDoListAtrribute2Active
  "https://github.com/dalehenrich/metacello-work/issues/125"

  | project version expected actual |
  project := self projectWith: #(#'attribute2').
  version := project version: '3.0-baseline'.
  expected := 'spec blessing: #''baseline''.
spec preLoadDoIt: #''preloadForCore''.
spec postLoadDoIt: #''postloadForCore:package:''.
spec 
	project: ''Example Project'' with: [
		spec
			className: ''ConfigurationOfExampleProject'';
			versionString: ''1.0-baseline'';
			preLoadDoIt: #''preloadForProject'';
			postLoadDoIt: #''postloadForProject'';
			loads: #(''core'' ) ];
	project: ''Extra Project'' with: [
		spec
			className: ''ConfigurationOfExtraProject'';
			versionString: ''1.0-baseline'';
			preLoadDoIt: #''preloadForProject'';
			postLoadDoIt: #''postloadForProject'';
			loads: #(''core'' ) ].
spec 
	group: ''Core'' with: #(''Example Project'' );
	group: ''Core'' with: #(''Extra Project'' ).'.
  actual := version spec printString.
  self assert: expected = actual! !

!MetacelloCoreIssue125TestCase methodsFor: 'accessing' stamp: 'dkh 9/11/2012 14:57'!
projectWith: projectAttributes
    | project |
    "Construct Metacello project"
    project := MetacelloProject new.
    project projectAttributes: projectAttributes.
    MetacelloVersionConstructor on: self project: project.
    ^ project! !

!MetacelloCoreIssue125TestCase methodsFor: 'baselines' stamp: 'dkh 9/11/2012 14:59'!
baseline200: spec
    <version: '2.0-baseline'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'baseline'.
            spec
                preLoadDoIt: #'preloadForCore';
                postLoadDoIt: #'postloadForCore:package:'.
            spec
                project: 'Example Project'
                    with: [ 
                            spec
                                className: 'ConfigurationOfExampleProject';
                                versionString: '1.0-baseline';
                                preLoadDoIt: #'preloadForProject';
                                postLoadDoIt: #'postloadForProject';
                                loads: #('core');
                                yourself ];
                yourself.
            spec group: 'Core' with: #('Example Project') ]! !

!MetacelloCoreIssue125TestCase methodsFor: 'baselines' stamp: 'dkh 9/11/2012 14:57'!
baseline300: spec
    <version: '3.0-baseline' imports: #('2.0-baseline')>
    spec
        for: #(#'attribute1' #'attribute2')
        do: [ 
            spec
                project: 'Extra Project'
                    with: [ 
                            spec
                                className: 'ConfigurationOfExtraProject';
                                versionString: '1.0-baseline';
                                preLoadDoIt: #'preloadForProject';
                                postLoadDoIt: #'postloadForProject';
                                loads: #('core');
                                yourself ];
                yourself.
            spec group: 'Core' with: #('Extra Project') ]! !

!MetacelloCoreIssue125TestCase methodsFor: 'tests' stamp: 'dkh 05/11/2013 11:02'!
testForDoListNotActive
  "https://github.com/dalehenrich/metacello-work/issues/125"

  | project version expected actual |
  project := self projectWith: #().
  version := project version: '3.0-baseline'.
  expected := 'spec blessing: #''baseline''.
spec preLoadDoIt: #''preloadForCore''.
spec postLoadDoIt: #''postloadForCore:package:''.
spec project: ''Example Project'' with: [
		spec
			className: ''ConfigurationOfExampleProject'';
			versionString: ''1.0-baseline'';
			preLoadDoIt: #''preloadForProject'';
			postLoadDoIt: #''postloadForProject'';
			loads: #(''core'' ) ].
spec group: ''Core'' with: #(''Example Project'' ).'.
  actual := version spec printString.
  self assert: expected = actual! !

!MetacelloCoreIssue125TestCase methodsFor: 'accessing' stamp: 'dkh 9/11/2012 14:57'!
project

	^self projectWith: #()! !

!MetacelloCoreIssue125TestCase methodsFor: 'tests' stamp: 'dkh 05/11/2013 10:59'!
testForDoListAttribute1Atrribute2Active
  "https://github.com/dalehenrich/metacello-work/issues/125"

  | project version expected actual |
  project := self projectWith: #(#'attribute1' #'attribute2').
  version := project version: '3.0-baseline'.
  expected := 'spec blessing: #''baseline''.
spec preLoadDoIt: #''preloadForCore''.
spec postLoadDoIt: #''postloadForCore:package:''.
spec 
	project: ''Example Project'' with: [
		spec
			className: ''ConfigurationOfExampleProject'';
			versionString: ''1.0-baseline'';
			preLoadDoIt: #''preloadForProject'';
			postLoadDoIt: #''postloadForProject'';
			loads: #(''core'' ) ];
	project: ''Extra Project'' with: [
		spec
			className: ''ConfigurationOfExtraProject'';
			versionString: ''1.0-baseline'';
			preLoadDoIt: #''preloadForProject'';
			postLoadDoIt: #''postloadForProject'';
			loads: #(''core'' ) ];
	project: ''Extra Project'' with: [
		spec
			className: ''ConfigurationOfExtraProject'';
			versionString: ''1.0-baseline'';
			preLoadDoIt: #''preloadForProject'';
			postLoadDoIt: #''postloadForProject'';
			loads: #(''core'' ) ].
spec 
	group: ''Core'' with: #(''Example Project'' );
	group: ''Core'' with: #(''Extra Project'' );
	group: ''Core'' with: #(''Extra Project'' ).'.
  actual := version spec printString.
  self assert: expected = actual! !

!MetacelloCoreIssue125TestCase methodsFor: 'tests' stamp: 'dkh 05/11/2013 10:54'!
testForDoListAtrribute1Active
  "https://github.com/dalehenrich/metacello-work/issues/125"

  | project version expected actual |
  project := self projectWith: #(#'attribute1').
  version := project version: '3.0-baseline'.
  expected := 'spec blessing: #''baseline''.
spec preLoadDoIt: #''preloadForCore''.
spec postLoadDoIt: #''postloadForCore:package:''.
spec 
	project: ''Example Project'' with: [
		spec
			className: ''ConfigurationOfExampleProject'';
			versionString: ''1.0-baseline'';
			preLoadDoIt: #''preloadForProject'';
			postLoadDoIt: #''postloadForProject'';
			loads: #(''core'' ) ];
	project: ''Extra Project'' with: [
		spec
			className: ''ConfigurationOfExtraProject'';
			versionString: ''1.0-baseline'';
			preLoadDoIt: #''preloadForProject'';
			postLoadDoIt: #''postloadForProject'';
			loads: #(''core'' ) ].
spec 
	group: ''Core'' with: #(''Example Project'' );
	group: ''Core'' with: #(''Extra Project'' ).'.
  actual := version spec printString.
  self assert: expected = actual! !

!MetacelloCoreSymbolicVersionTest methodsFor: 'baselines' stamp: 'dkh 9/11/2012 11:25'!
baseline10: spec
    <version: '1.0-baseline'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'baseline'.
            spec
                project: 'Example Project'
                with: [ 
                    spec
                        className: 'MetacelloExampleProjectConfig';
                        versionString: '1.0-baseline';
                        preLoadDoIt: #'preloadForProject';
                        postLoadDoIt: #'postloadForProject';
                        yourself ] ]! !

!MetacelloCoreSymbolicVersionTest methodsFor: 'accessing' stamp: 'dkh 9/11/2012 11:23'!
projectWith: projectAttributes
    | project |
    "Construct Metacello project"
    project := MetacelloProject new.
    project projectAttributes: projectAttributes.
    MetacelloVersionConstructor on: self project: project.
    ^ project! !

!MetacelloCoreSymbolicVersionTest methodsFor: 'tests' stamp: 'dkh 9/11/2012 11:27'!
testBleedingEdgeMethod
    | project version |
    project := self projectWith: #(#'platformVersion1.x').
    self assert: (project version: #'bleedingEdge') = project bleedingEdge! !

!MetacelloCoreSymbolicVersionTest methodsFor: 'versions' stamp: 'dkh 9/11/2012 11:26'!
bleedingEdge: spec
    <symbolicVersion: #'bleedingEdge'>
    spec for: #'platformVersion1.x' version: '1.0-baseline'! !

!MetacelloCoreSymbolicVersionTest methodsFor: 'baselines' stamp: 'dkh 9/11/2012 11:25'!
baseline20: spec
    <version: '2.0-baseline'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'baseline'.
            spec
                project: 'Example Project'
                with: [ 
                    spec
                        className: 'MetacelloExampleProjectConfig';
                        versionString: '1.0-baseline';
                        preLoadDoIt: #'preloadForProject';
                        postLoadDoIt: #'postloadForProject';
                        yourself ] ]! !

!MetacelloCoreSymbolicVersionTest methodsFor: 'tests' stamp: 'dkh 9/11/2012 11:27'!
testBasicStableVersion
    | project version wc expected actual |
    project := self projectWith: #(#'platformVersion1.x').
    version := project version: #'stable'.
    expected := 'spec blessing: #''release''.
spec project: ''Example Project'' with: [
		spec
			className: ''MetacelloExampleProjectConfig'';
			versionString: ''1.0-baseline'';
			preLoadDoIt: #''preloadForProject'';
			postLoadDoIt: #''postloadForProject'' ].'.
    actual := version spec printString.
    self assert: expected = actual! !

!MetacelloCoreSymbolicVersionTest methodsFor: 'accessing' stamp: 'dkh 9/11/2012 11:23'!
project

	^self projectWith: #()! !

!MetacelloCoreSymbolicVersionTest methodsFor: 'tests' stamp: 'dkh 9/11/2012 11:28'!
testStableVersionMethod
    | project version |
    project := self projectWith: #(#'platformVersion1.x').
    self assert: (project version: #'stable') = project stableVersion! !

!MetacelloCoreSymbolicVersionTest methodsFor: 'tests' stamp: 'dkh 9/11/2012 11:29'!
testBasicBleedingEdgeVersion
    | project version wc expected actual |
    project := self projectWith: #(#'platformVersion1.x').
    version := project version: #'bleedingEdge'.
    expected := 'spec blessing: #''baseline''.
spec project: ''Example Project'' with: [
		spec
			className: ''MetacelloExampleProjectConfig'';
			versionString: ''1.0-baseline'';
			preLoadDoIt: #''preloadForProject'';
			postLoadDoIt: #''postloadForProject'' ].'.
    actual := version spec printString.
    self assert: expected = actual! !

!MetacelloCoreSymbolicVersionTest methodsFor: 'versions' stamp: 'dkh 9/11/2012 11:26'!
version10: spec
    <version: '1.0' imports: #('1.0-baseline')>
    spec for: #'common' do: [ spec blessing: #'release' ]! !

!MetacelloCoreSymbolicVersionTest methodsFor: 'versions' stamp: 'dkh 9/11/2012 11:26'!
stableVersion: spec
    <symbolicVersion: #'stable'>
    spec for: #'platformVersion1.x' version: '1.0'! !

!MetacelloCoreVersionQueryTestCase methodsFor: 'baselines' stamp: 'dkh 9/11/2012 11:38'!
baseline10: spec
    <version: '1.0-baseline'>
    spec
        for: #'common'
        do: [ 
            spec
                project: 'UTF8'
                with: [ 
                    spec
                        className: 'MetacelloVersionQueryMiscConfig';
                        versionString: '1.0-baseline';
                        loads: #('Misc-UTF8') ].
            spec
                group: 'Core' with: #('UTF8');
                group: 'Tests' with: #('UTF8');
                group: 'Recursive' with: #('Core' 'Recursive')	"recursive group definition" ]! !

!MetacelloCoreVersionQueryTestCase methodsFor: 'accessing' stamp: 'dkh 9/11/2012 11:36'!
projectWith: projectAttributes
    | project |
    "Construct Metacello project"
    project := MetacelloProject new.
    project projectAttributes: projectAttributes.
    MetacelloVersionConstructor on: self project: project.
    ^ project! !

!MetacelloCoreVersionQueryTestCase methodsFor: 'baselines' stamp: 'dkh 9/11/2012 12:03'!
baseline20: spec
    <version: '2.0-baseline'>
    spec
        for: #'common'
        do: [ 
            spec
                project: 'UTF8'
                with: [ 
                    spec
                        className: 'MetacelloVersionQueryMiscConfig';
                        versionString: #'stable';
                        loads: #('Misc-UTF8') ].
            spec
                project: 'UTF9'
                with: [ 
                    spec
                        className: 'MetacelloVersionQueryOtherConfig';
                        versionString: '1.0-baseline';
                        loads: #('Misc-UTF8') ].
            spec
                group: 'Core' with: #('UTF8' 'UTF9');
                group: 'Tests' with: #('UTF8');
                group: 'Recursive' with: #('Core' 'Recursive')	"recursive group definition" ]! !

!MetacelloCoreVersionQueryTestCase methodsFor: 'baselines' stamp: 'dkh 9/11/2012 12:07'!
baseline11: spec
    <version: '1.1-baseline' imports: #('1.0-baseline')>
    spec
        for: #'common'
        do: [ 
            spec
                project: 'UTF7'
                with: [ 
                    spec
                        className: 'MetacelloVersionQueryMiscConfig';
                        versionString: '1.0-baseline';
                        loads: #('Misc-UTF7') ].
            spec
                group: 'Core' with: #('UTF7');
                group: 'Tests' with: #('UTF7');
                yourself ]! !

!MetacelloCoreVersionQueryTestCase methodsFor: 'tests' stamp: 'dkh 9/11/2012 11:36'!
testBaseline10Groups
    | project version expected list |
    project := self project.
    version := project version: '1.0-baseline'.
    expected := #('Core' 'Tests' 'Recursive').
    list := version groups.
    self assert: list size = expected size.
    list do: [ :pkg | self assert: (expected includes: pkg name) ]! !

!MetacelloCoreVersionQueryTestCase methodsFor: 'accessing' stamp: 'dkh 9/11/2012 11:36'!
project

	^self projectWith: #()! !

!MetacelloCoreVersionQueryTestCase methodsFor: 'tests' stamp: 'dkh 9/11/2012 12:08'!
testDifference
    | project expected fromVersionString toVersionString report actual |
    project := self project.
    fromVersionString := '1.1-baseline'.
    toVersionString := '2.0-baseline'.
    report := (project version: fromVersionString) difference: (project version: toVersionString).
    report
        from: fromVersionString;
        to: toVersionString;
        configuration: 'Test Configuration'.
    expected := 'Test Configuration ''1.1-baseline'' to ''2.0-baseline''
	Additions:
		UTF9
			'''' to ''1.0-baseline''
	Modifications:
		UTF8
			''1.0-baseline'' to ''stable''
	Removals:
		UTF7
			''1.0-baseline'' to ''''
'.
    actual := report printString.
    self assert: expected = actual! !

!MetacelloCoreVersionQueryTestCase methodsFor: 'tests' stamp: 'dkh 9/11/2012 11:40'!
testBaseline10ResolveToLoadableSpecs01
    | project version expected list |
    project := self project.
    version := project version: '1.0-baseline'.
    expected := #('UTF8').
    list := version resolveToLoadableSpecs: #('UTF8').
    self assert: list size = expected size.
    list do: [ :pkg | self assert: (expected includes: pkg name) ].
    expected := #('UTF8').
    list := version resolveToLoadableSpecs: #('Recursive').
    self assert: list size = expected size.
    list do: [ :pkg | self assert: (expected includes: pkg name) ]! !

!MetacelloCoreVersionQueryTestCase methodsFor: 'tests' stamp: 'dkh 9/11/2012 11:38'!
testBaseline10Projects
    | project version expected list |
    project := self project.
    version := project version: '1.0-baseline'.
    expected := #('UTF8').
    list := version projects.
    self assert: list size = expected size.
    list do: [ :pkg | self assert: (expected includes: pkg name) ]! !

!MetacelloDevelopmentProcess methodsFor: 'lessons' stamp: 'NicolaiHess 6/5/2014 23:47'!
createDevelopmentVersion
	^Lesson
		title: '2. Create development version'
		lesson: '"After the configuration and initial baseline version have been created, define the initial development version:"
	
	MetacelloToolBox
		createDevelopment: ''1.0''
		for: ''Example''
		importFromBaseline: ''1.0-baseline''
		description: ''initial version''.

"After evaluating the above expression, take a look at the #version10: method in ConfigurationOfExample:"

	Smalltalk tools browser fullOnClass: ConfigurationOfExample selector: #version10:.

"The current version of the Shout project has been filled in as well as the current version of the ProfStef packages.

When a new development version is created the #development symbolic version is defined as well:"

	Smalltalk tools browser fullOnClass: ConfigurationOfExample selector: #development:.

"The #development version is defined as 1.0 for all platforms.

Note that the #development symbolic version is used in a number of the Development Support scripts, so you want to make sure that it is kept up-to-date."

ProfStef next.
'! !

!MetacelloDevelopmentProcess methodsFor: 'intro' stamp: 'NicolaiHess 6/5/2014 23:46'!
introductionText

	^'This tutorial covers some of the methods that can be found in the MetacelloToolBox.
CREATE PROJECT
	1. Create configuration and baseline version
	2. Create development version
	3. Validate and save configuration in project repository
	
DEVELOPMENT
	4. Checkpoint save
	5. Integrate code contributions
	6. Compare versions

RELEASE
	7. Release development version
	8. Create new development version

For convenience, a number of the methods covered in these sections can be found in the ''development support'' category on the class-side of MetacelloBaseConfiguration." 

	Smalltalk tools browser fullOnClass: MetacelloBaseConfiguration class selector: #DevelopmentProcess.

"After deciding which of the development support methods you will use in your project, copy the methods of interest to the the class-side of your own configuration or implement your own ''development support'' methods using the MetacelloToolBox API:"

	HelpBrowser openOn: MetacelloAPIDocumentation
"'! !

!MetacelloDevelopmentProcess methodsFor: 'lessons' stamp: 'DaleHenrichs 12/17/2010 11:09'!
validateAndSaveConfiguration
	^Lesson
		title: '3. Validate and save configuration in project repository'
		lesson: '"Before saving a configuration into the project repository, the configuration should be validated and any Critical Issues should be addressed:"
		
	(MetacelloToolBox validateConfiguration: ConfigurationOfExample) explore.

"Use Gofer to save the configuration to your project repository:"

	Gofer new
		url: ''http://www.example.com/ExampleRepository'';
		package: ''ConfigurationOfExample'';
		commit: ''Initial configuration''.

"Once you''ve done your initial commit, you can use the following expression to save the configuration to your project repository:"

	MetacelloToolBox saveConfigurationPackageFor: ''Example'' description: ''commit message''.
	
"Note that MetacelloToolBox class>>saveConfigurationPackageFor:description: validates the configuration before saving."

ProfStef next.
'! !

!MetacelloDevelopmentProcess methodsFor: 'lessons' stamp: 'DaleHenrichs 12/17/2010 12:24'!
createNewDevelopmentVersion
	^Lesson
		title: '8. Create new development version'
		lesson: '"After releasing a version it isn''t a bad idea to open a new development version for the next phase of development:"
	
	MetacelloToolBox
		createNewDevelopmentVersionIn: ConfigurationOfExample
		description: ''- aim at implementing new features''.

"The above expression uses the #release version as a template for the new version with the #release minor version number incremented." 

ProfStef next.
'! !

!MetacelloDevelopmentProcess methodsFor: 'tutorial' stamp: 'DaleHenrichs 12/17/2010 12:16'!
tutorial
	^#(  createConfigurationAndBaseline createDevelopmentVersion validateAndSaveConfiguration checkpointSave integrateCodeContributions compareVersions releaseVersion createNewDevelopmentVersion)! !

!MetacelloDevelopmentProcess methodsFor: 'lessons' stamp: 'DaleHenrichs 12/17/2010 11:28'!
checkpointSave
	^Lesson
		title: '4. Checkpoint save'
		lesson: '"After having done development for awhile, you may want to checkpoint your work to share with others, test in another development environment or just to backup your work.

You can save the modified mcz files, update the development version spec with the new mcz file names and then save the configuration:"

	MetacelloToolBox 
		saveModifiedPackagesAndConfigurationIn: ConfigurationOfExample
		description: ''- fixed Issue 1090''.

"Or you can arrange to just save the modified mcz files and update the development version spec with the new mcz file names:"

	MetacelloToolBox 
		saveModifiedPackagesIn: ConfigurationOfExample
		description: ''- fixed Issue 1090''.

ProfStef next.
'! !

!MetacelloDevelopmentProcess methodsFor: 'lessons' stamp: 'DaleHenrichs 1/14/2011 12:21'!
compareVersions
	^Lesson
		title: '6. Compare versions'
		lesson: '"Occasionally, it is useful to view the mcz and project version changes between the #development symbolic version and the #stable symbolic version:"

	(MetacelloToolBox compareVersionsIn: ConfigurationOfExample) inspect.
	
ProfStef next.
'! !

!MetacelloDevelopmentProcess methodsFor: 'lessons' stamp: 'NicolaiHess 6/5/2014 23:46'!
createConfigurationAndBaseline
	^Lesson
		title: '1. Create configuration'
		lesson: '"The MetacelloToolBox class provides programmatic support for creating and maintaining your configuration. 

Use the following expression to create your configuration class and initial baseline version. Edit the expression to specifiy the required projects, packages, dependencies and groups for your project:"
	
	MetacelloToolBox
		createBaseline: ''1.0-baseline''
		for: ''Example''
		repository: ''http://www.squeaksource.com/ProfStef''
		requiredProjects: #(''Shout'')
		packages: #(''ProfStef-Core'' ''ProfStef-Tests'')
		dependencies:
			{(''ProfStef-Core'' -> #(''Shout'')).
			(''ProfStef-Tests'' -> #(''ProfStef-Core''))}
		groups:
			{(''default'' -> #(''Core'')).
			(''Core'' -> #(''ProfStef-Core'')).
			(''Tests'' -> #(''ProfStef-Tests'')).
			(''Core Tests'' -> #(''Core'' ''Tests''))}.
			
"After evaluating the above expression, browse the configuration:"

	Smalltalk tools browser fullOnClass: ConfigurationOfExample selector: #baseline10:.
	
"Edit the #baseline10 method in the browser to fine tune the baseline specification."

ProfStef next.
'! !

!MetacelloDevelopmentProcess methodsFor: 'lessons' stamp: 'DaleHenrichs 12/17/2010 12:14'!
releaseVersion
	^Lesson
		title: '7. Release development version'
		lesson: '"When you ready to release the #development version of your project, the following things need to be done:

	1. Change #blessing of version to #release
	2. Set the #development symbolic version to #notFound (no longer in development)
	3. Set the #stable symbolic version to the current #development version
	4. Save the configuration
	5. Copy the configuration to http://www.squeaksource.com/MetacelloRepository (optional).

Steps 1-4 are performed by the following expression:"

	MetacelloToolBox 
		releaseDevelopmentVersionIn: ConfigurationOfExample
		description: ''- release version 1.0''.
	
"If you want to copy the saved configuration to another repository, use the following expression:"

	MetacelloToolBox 
		copyConfiguration: ConfigurationOfExample 
		to: ''http://www.example.com/MetacelloRepository''.

ProfStef next.
'! !

!MetacelloDevelopmentProcess methodsFor: 'lessons' stamp: 'DaleHenrichs 12/17/2010 11:37'!
integrateCodeContributions
	^Lesson
		title: '5. Integrate code contributions'
		lesson: '"If other developers have commited new versions of the packages in your project you can integrate the changes into your configuration by first loading the latest packages in your project:"

	(ConfigurationOfExample project version: #baseline) load.

"Then updating the mcz file specifications in #development version:"

	MetacelloToolBox 
		updateToLatestPackageVersionsIn: ConfigurationOfExample
		description: ''- integrated code from Barney and Fred''.

"Then checkpoint the configuration:"

	MetacelloToolBox 
		saveConfigurationPackageFor: ''Example'' 
		description: ''- integrated code from Barney and Fred''.

ProfStef next.
'! !

!MetacelloDevelopmentProcess class methodsFor: 'tutorial metainfo' stamp: 'DaleHenrichs 12/17/2010 10:31'!
title	

	^'Metacello Development Cycle'! !

!MetacelloDictionaryRepositoryTest methodsFor: 'running' stamp: 'dkh 6/12/2012 15:41:23.319'!
alternateRepository
	"MetacelloAlternateResource reset"

	^ MetacelloAlternateResource current monticelloRepository! !

!MetacelloDictionaryRepositoryTest methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
projectWith: projectAttributes

	| project |
	"Construct Metacello project"
	project := MetacelloMCProject new.
	project projectAttributes: projectAttributes.
	MetacelloVersionConstructor on: self project: project.
	project loader: 
		((project loaderClass new)
			shouldDisablePackageCache: true;
			yourself).
	project loadType: self loadType.
	^project
! !

!MetacelloDictionaryRepositoryTest methodsFor: 'running' stamp: 'dkh 6/12/2012 15:41:23.319'!
configurationRepository
	"MetacelloConfigurationResource reset"

	^ MetacelloConfigurationResource current monticelloRepository! !

!MetacelloDictionaryRepositoryTest methodsFor: 'running' stamp: 'dkh 6/12/2012 15:41:23.319'!
doSilently

	^true! !

!MetacelloDictionaryRepositoryTest methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
monticelloRepository
	"MetacelloMonticelloResource reset"
	^ MetacelloMonticelloResource current monticelloRepository! !

!MetacelloDictionaryRepositoryTest methodsFor: 'running' stamp: 'ChristopheDemarey 4/29/2013 16:22'!
runCase
	| original |
	(self doSilently) ifFalse: [ ^super runCase ].
	original := MetacelloPlatform current bypassGoferLoadUpdateCategories.
	[ 
	MetacelloPlatform current bypassGoferLoadUpdateCategories: true.
	^ MetacelloPlatform current suspendSystemUpdateEventsDuring: [ super runCase ] ]
		ensure: [ MetacelloPlatform current bypassGoferLoadUpdateCategories: original ]! !

!MetacelloDictionaryRepositoryTest methodsFor: 'running' stamp: 'dkh 6/12/2012 15:41:23.319'!
tearDown
	| aGofer |
	super tearDown.
	aGofer := Gofer new.
	self tearDownPackages: aGofer.
	aGofer references notEmpty ifTrue: [ aGofer metacelloUnload ].
	Smalltalk removeKey: #'Metacello_Gofer_Test_Repository' ifAbsent: [].
	Smalltalk removeKey: #'Metacello_Configuration_Test_Repository' ifAbsent: [].
	Smalltalk removeKey: #'Metacello_Configuration_Test_Alternate_Repository' ifAbsent: [].
	self tempRepositories do: [:repo | MCRepositoryGroup default removeRepository: repo ].
! !

!MetacelloDictionaryRepositoryTest methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
project

	| constructor project |
	"Construct Metacello project"
	constructor := MetacelloVersionConstructor on: self.
	project := constructor project.
	project loader: 
		((project loaderClass new)
			shouldDisablePackageCache: true;
			yourself).
	project loadType: self loadType.
	^project! !

!MetacelloDictionaryRepositoryTest methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
tempRepositories

	tempRepositories ifNil: [ tempRepositories := OrderedCollection new ].
	^tempRepositories! !

!MetacelloDictionaryRepositoryTest methodsFor: 'running' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUp
	| repo |
	super setUp.
	MetacelloConfigurationResource projectAttributes: nil.
	repo := self monticelloRepository.
	self tempRepositories add: repo.
	gofer repository: repo.
	Smalltalk at: #'Metacello_Gofer_Test_Repository' put: repo.
	repo := self alternateRepository.
	self tempRepositories add: repo.
	Smalltalk at: #'Metacello_Configuration_Test_Alternate_Repository' put: repo.
	repo := self configurationRepository.
	self tempRepositories add: repo.
	Smalltalk at: #'Metacello_Configuration_Test_Repository' put: repo.
! !

!MetacelloDictionaryRepositoryTest methodsFor: 'running' stamp: 'dkh 6/12/2012 15:41:23.319'!
tearDownPackages: aGoferInstance

	(self hasPackage: 'GoferFoo')
		ifTrue: [ aGoferInstance package: 'GoferFoo' ].
	(self hasPackage: 'GoferBar')
		ifTrue: [ aGoferInstance package: 'GoferBar' ].
	(self hasPackage: 'GoferFaux')
		ifTrue: [ aGoferInstance package: 'GoferFaux' ].
	(self hasPackage: 'GoferBeau')
		ifTrue: [ aGoferInstance package: 'GoferBeau' ].
	(self hasPackage: 'MetacelloTestConfigurationOfFoo')
		ifTrue: [ aGoferInstance package: 'MetacelloTestConfigurationOfFoo' ].
! !

!MetacelloDictionaryRepositoryTest methodsFor: 'running' stamp: 'dkh 6/12/2012 15:41:23.319'!
defaultTimeout
	"I don't want no stkinkin' timeouts"
	^60000! !

!MetacelloDictionaryRepositoryTest methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
loadType

	^#linear! !

!MetacelloDictionaryRepositoryTest methodsFor: 'utilities' stamp: 'dkh 6/12/2012 15:41:23.319'!
hasPackage: aString
	| package |
	package := MCWorkingCopy allManagers
		detect: [ :each | each packageName = aString ]
		ifNone: [ nil ].
	^ package notNil! !

!MetacelloDirective methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
packageDo: aBlock
! !

!MetacelloDirective methodsFor: 'enumerating' stamp: 'dkh 6/8/2012 14:04:22'!
prepostLoadDo: aBlock
! !

!MetacelloDirective methodsFor: 'initialize-release' stamp: 'dkh 6/8/2012 14:04:22'!
spec: packageOrVersionSpec loader: aLoader

	spec := packageOrVersionSpec.
	loader := aLoader! !

!MetacelloDirective methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
loader

	^loader! !

!MetacelloDirective methodsFor: 'enumerating' stamp: 'dkh 6/8/2012 14:04:22'!
directivesDo: aBlock

	aBlock value: self! !

!MetacelloDirective methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
loadUsing: aLoaderDirective gofer: aGofer

	self subclassResponsibility! !

!MetacelloDirective methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
loader: aLoader

	loader := aLoader! !

!MetacelloDirective methodsFor: 'enumerating' stamp: 'dkh 6/8/2012 14:04:22'!
prepostLoadDirectivesDo: aBlock
! !

!MetacelloDirective methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
addTo: aLoaderDirective

	aLoaderDirective add: self! !

!MetacelloDirective methodsFor: 'enumerating' stamp: 'dkh 6/8/2012 14:04:22'!
packageDirectivesDo: aBlock
! !

!MetacelloDirective methodsFor: 'printing' stamp: 'dkh 6/8/2012 14:04:22'!
label

	^self spec label! !

!MetacelloDirective methodsFor: 'printing' stamp: 'dkh 6/8/2012 14:04:22'!
printOn: aStream

	self printOn: aStream indent: 0! !

!MetacelloDirective methodsFor: 'printing' stamp: 'dkh 6/8/2012 14:04:22'!
printString
	"Explicit override of superclass implementation. When you are printing a loadDirective it is annoying to have it truncated."

	^String streamContents: [:s | self printOn: s]! !

!MetacelloDirective methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
title

	self subclassResponsibility! !

!MetacelloDirective methodsFor: 'enumerating' stamp: 'dkh 6/8/2012 14:04:22'!
versionDirectivesDepthFirstDo: aBlock
! !

!MetacelloDirective methodsFor: 'enumerating' stamp: 'dkh 6/8/2012 14:04:22'!
versionDirectivesDo: aBlock
! !

!MetacelloDirective methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
postLoadDo: aBlock

	! !

!MetacelloDirective methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
preLoadDo: aBlock! !

!MetacelloDirective methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
versionDo: aBlock
! !

!MetacelloDirective methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
spec

	^spec! !

!MetacelloDirective methodsFor: 'printing' stamp: 'dkh 6/8/2012 14:04:22'!
printOn: aStream indent: indent

	indent timesRepeat: [ aStream tab ].
	aStream
		nextPutAll: self title;
		nextPutAll: ' : ';
		nextPutAll: self label.
! !

!MetacelloDirective class methodsFor: 'instance creation' stamp: 'dkh 6/8/2012 14:04:22'!
postLoadSpec: packageOrVersionSpec loader: aLoader

	^MetacelloPostLoadDirective new
		spec: packageOrVersionSpec loader: aLoader! !

!MetacelloDirective class methodsFor: 'instance creation' stamp: 'dkh 6/8/2012 14:04:22'!
preLoadSpec: packageOrVersionSpec loader: aLoader

	^MetacelloPreLoadDirective new
		spec: packageOrVersionSpec loader: aLoader! !

!MetacelloDirective class methodsFor: 'instance creation' stamp: 'dkh 6/8/2012 14:04:22'!
loader: aLoader

	^self new
		loader: aLoader! !

!MetacelloDirective class methodsFor: 'instance creation' stamp: 'dkh 6/8/2012 14:04:22'!
loadPackage: aPackageSpec externalReference: externalReference loader: aLoader

	^MetacelloPackageLoadDirective new
		spec: aPackageSpec externalReference: externalReference  loader: aLoader! !

!MetacelloEnsureFetchingMCSpecLoader methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
scheduleFetchFor: packageSpec nearestReference: reference
	"latest version in repository already matches the cached reference...schedule a load directive for reference, so ensured load will come from cache"

	^ self
		scheduleFetchFor: packageSpec
		reference: reference
		message:
			'Fetched -> (nearest) ' , reference name , ' --- ' , reference repository description , ' --- '
				, reference repository description! !

!MetacelloEnsureFetchingMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
ensureSpecLoader
	^ self! !

!MetacelloEnsureFetchingMCSpecLoader methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
scheduleFetchFor: packageSpec cachedReference: reference
	"reference already in the cache during fetch ...schedule a load directive for reference, so ensured load will come from cache"

	^ self
		scheduleFetchFor: packageSpec
		reference: reference
		message:
			'Fetched -> (cached) ' , reference name , ' --- ' , reference repository description , ' --- '
				, reference repository description! !

!MetacelloErrorInProjectConstructionNotification methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
exception: anObject
	exception := anObject! !

!MetacelloErrorInProjectConstructionNotification methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
versionString
	^ versionString! !

!MetacelloErrorInProjectConstructionNotification methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
exception
	^ exception! !

!MetacelloErrorInProjectConstructionNotification methodsFor: 'exception description' stamp: 'dkh 6/5/2012 19:01:24'!
defaultAction
    "Answer false if you want the version recorded in the errorMap.
	Answer true if you want to go ahead and throw the error"

    ^ false! !

!MetacelloErrorInProjectConstructionNotification methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
versionString: anObject
	versionString := anObject! !

!MetacelloErrorInProjectConstructionNotification class methodsFor: 'instance creation' stamp: 'dkh 6/5/2012 19:01:24'!
versionString: aString exception: anException
    ^ self new
        versionString: aString;
        exception: anException;
        signal! !

!MetacelloExampleProjectConfig methodsFor: 'baselines' stamp: 'dkh 6/12/2012 15:41:23.319'!
baseline10: spec 
	<version: '1.0-baseline'>
	
	spec for: #common do: [
		spec 
			package: 'Example-Core';
			package: 'Example-AddOn' with: [ spec requires: #('Example-Core' ) ];
			package: 'Example-Tests' with: [ spec requires: #('Example-AddOn' ) ];
			package: 'Example-TestsUI' with: [ spec requires: #('Example-UI' 'Example-Tests' ) ];
			package: 'Example-UI' with: [ spec requires: #('Example-AddOn' ) ]].
! !

!MetacelloExplicitLoadDirective methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
explicitLoadUsing: aLoaderDirective gofer: aGofer

	aLoaderDirective loadLinearLoadDirective: self gofer: aGofer.
! !

!MetacelloExplicitLoadDirective methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
loadUsing: aLoaderDirective gofer: aGofer

	aLoaderDirective loadExplicitLoadDirective: self gofer: aGofer.
! !

!MetacelloExplicitLoadDirective methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
title

	^'explicit load'! !

!MetacelloExplicitLoadDirective methodsFor: 'testing' stamp: 'dkh 6/8/2012 14:04:22'!
isExplicit

	^true! !

!MetacelloExplicitLoadDirective methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
explicitLoadWithPolicy: aLoadPolicy

	| gofer |
	gofer := MetacelloGofer new.
	gofer disablePackageCache.
	gofer repository: aLoadPolicy cacheRepository.
	self explicitLoadUsing: self gofer: gofer! !

!MetacelloFetchingMCSpecLoader methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
explicitLoadPackageSpecs: packageSpecs repositories: repositories
	
	| directive |
	directive := self loaderPolicy 
		pushExplicitLoadDirectivesDuring: [ super linearLoadPackageSpecs: packageSpecs repositories: repositories ]
		for: self.
	directive explicitLoadWithPolicy: self loaderPolicy.! !

!MetacelloFetchingMCSpecLoader methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
scheduleFetchFor: packageSpec nearestReference: reference
	"latest version in repository already matches the cached reference...no need to schedule fetch"

	^ self! !

!MetacelloFetchingMCSpecLoader methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
atomicLoadPackageSpecs: packageSpecs repositories: repositories

	self loaderPolicy 
		pushAtomicLoadDirectivesDuring: [ super linearLoadPackageSpecs: packageSpecs repositories: repositories ]
		for: self
! !

!MetacelloFetchingMCSpecLoader methodsFor: 'versionInfo' stamp: 'dkh 6/8/2012 14:04:22'!
currentVersionInfoFor: packageSpec

	^self loadData
		currentVersionInfoFor: packageSpec 
		ifAbsent: [ super currentVersionInfoFor: packageSpec ]! !

!MetacelloFetchingMCSpecLoader methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
doLoad

	self loaderPolicy copy load! !

!MetacelloFetchingMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
loadData

	^self loaderPolicy loadData! !

!MetacelloFetchingMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
loadingSpecLoader

	^(MetacelloLoadingMCSpecLoader on: self spec)
		shouldDisablePackageCache: self shouldDisablePackageCache;
		loaderPolicy: self loaderPolicy copy;
		yourself! !

!MetacelloFetchingMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
ensureSpecLoader
	^ (MetacelloEnsureFetchingMCSpecLoader on: self spec)
		shouldDisablePackageCache: self shouldDisablePackageCache;
		loaderPolicy: self loaderPolicy; "explicitly share the loaderPolicy"
		yourself! !

!MetacelloFetchingMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
actionLabel

	^'Fetching '! !

!MetacelloFetchingMCSpecLoader methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
linearLoadPackageSpec: packageSpec gofer: gofer
	MetacelloPlatform current
		do: [ 
			| references nearestReference cachedReference externalReference mcVersion loadedVersionInfos |
			"check to see if mcz file is already in cacheRepository"
			cachedReference := self resolvePackageSpec: packageSpec cachedGofer: self loaderPolicy cacheGofer.
			(cachedReference ~~ nil and: [ packageSpec getFile ~~ nil ])
				ifTrue: [ 
					cachedReference name = packageSpec file
						ifTrue: [ 
							"exact match between packageSpec file and cache"
							^ self scheduleFetchFor: packageSpec cachedReference: cachedReference ] ].	"look up mcz file"
			references := self retryingResolvePackageSpecReferences: packageSpec gofer: gofer.
			nearestReference := references last asMetacelloCachingResolvedReference.	"If the mcz is already in the cacheRepository, no need to copy"
			(cachedReference ~~ nil and: [ cachedReference name = nearestReference name ])
				ifTrue: [ 
					"latest reference in repository matches cachedReference ... "
					^ self scheduleFetchFor: packageSpec nearestReference: nearestReference ].	"If the mcz is already loaded into the image, no need to copy"
			(self ignoreImage not and: [ (loadedVersionInfos := self ancestorsFor: packageSpec) ~~ nil ])
				ifTrue: [ 
					loadedVersionInfos
						do: [ :info | 
							info name = nearestReference name
								ifTrue: [ ^ self ] ] ].
			externalReference := (references select: [ :ref | ref name = nearestReference name ]) first
				asMetacelloCachingResolvedReference.
			self repositoryMap at: externalReference name put: externalReference repository.
			(self
				resolveDependencies: externalReference
				nearest: nearestReference
				into: (OrderedCollection with: nearestReference))
				do: [ :reference | 
					| pSpec l |
					mcVersion := reference version.
					(l := (GoferVersionReference name: reference name) resolveAllWith: self loaderPolicy cacheGofer) isEmpty
						ifTrue: [ 
							self cacheRepository storeVersion: mcVersion.
							reference == nearestReference
								ifTrue: [ pSpec := packageSpec ]
								ifFalse: [ 
									pSpec := packageSpec project packageSpec.
									pSpec name: mcVersion package name ].
							self loadData
								addVersion: mcVersion
								versionInfo: mcVersion info
								resolvedReference: reference
								packageSpec: pSpec ] ].
			self scheduleFetchFor: packageSpec externalReference: externalReference ]
		displaying: 'Fetching ' , packageSpec file! !

!MetacelloFetchingMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
cacheRepository

	^self loaderPolicy cacheRepository! !

!MetacelloFetchingMCSpecLoader methodsFor: 'doits' stamp: 'dkh 6/8/2012 14:04:22'!
preLoad: packageOrVersionSpec

	(MetacelloDirective preLoadSpec: packageOrVersionSpec loader: self) addTo: self loadDirective
! !

!MetacelloFetchingMCSpecLoader methodsFor: 'doits' stamp: 'dkh 6/8/2012 14:04:22'!
postLoad: packageOrVersionSpec

	(MetacelloDirective postLoadSpec: packageOrVersionSpec loader: self)  addTo: self loadDirective

! !

!MetacelloFetchingMCSpecLoader methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
resolveDependencies: aResolvedReference nearest: nearestReference into: aCollection

	| block retryCount coll notDone |
	self flag: 'Not used, but retained to avoid upgrade issues'.
	block := [ :dependency | | reference |
		reference := MetacelloCachingGoferResolvedReference
			name: dependency versionInfo name
			repository: aResolvedReference repository.
		coll add: reference.
		Transcript cr; show: 'Fetched dependency -> ', reference name, ' --- ', reference repository description.
		self resolveDependencies: reference nearest: reference into: coll].
	retryCount := 0.
	notDone := true.
	coll := OrderedCollection new.
	[ notDone and: [ retryCount < 3 ]]
		whileTrue: [
			retryCount > 0 ifTrue: [ Transcript cr; show: '...RETRY' ].
			[ 	
				"ensure that all resolved references have cached their version while wrapped by error handler"
				aCollection do: [:each | each version ]. 
				nearestReference version dependencies do: block.
				notDone := false ]
					on: Error 
					do: [:ex | 
						retryCount := retryCount + 1.
						retryCount >= 3 ifTrue: [ ex pass ].
						coll := OrderedCollection new ]].
	aCollection addAll: coll.
	^aCollection! !

!MetacelloFetchingMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
ensuredMap

	^self loaderPolicy ensuredMap! !

!MetacelloFetchingMCSpecLoader methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
linearLoadPackageSpecs: packageSpecs repositories: repositories
	
	self loaderPolicy 
		pushLinearLoadDirectivesDuring: [ super linearLoadPackageSpecs: packageSpecs repositories: repositories ]
		 for: self! !

!MetacelloFetchingMCSpecLoader methodsFor: 'printing' stamp: 'dkh 6/8/2012 14:04:22'!
printOn: aStream
	super printOn: aStream.
	aStream nextPut: $(.
	self loadDirective printOn: aStream.
	aStream nextPut: $)! !

!MetacelloFetchingMCSpecLoader methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
scheduleFetchFor: packageSpec externalReference: reference
	^ self
		scheduleFetchFor: packageSpec
		reference: reference
		message:
			'Fetched -> ' , reference name , ' --- ' , reference repository description , ' --- ' , reference repository description! !

!MetacelloFetchingMCSpecLoader methodsFor: 'versionInfo' stamp: 'dkh 6/8/2012 14:04:22'!
ancestorsFor: packageSpec

	^self loadData
		ancestorsFor: packageSpec 
		ifAbsent: [ super ancestorsFor: packageSpec ]! !

!MetacelloFetchingMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
loadDirective

	^self loaderPolicy loadDirective! !

!MetacelloFetchingMCSpecLoader methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
resolvePackageSpec: packageSpec cachedGofer: gofer

	|  versionReference references |
	versionReference := packageSpec goferLoaderReference.
	(references := versionReference resolveAllWith: gofer) isEmpty 
		ifTrue: [ ^nil ].
	^references last asMetacelloCachingResolvedReference.
! !

!MetacelloFetchingMCSpecLoader methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
scheduleFetchFor: packageSpec reference: reference message: message
	self loaderPolicy resetCacheGofer.
	self preLoad: packageSpec.
	(MetacelloDirective loadPackage: packageSpec externalReference: reference loader: self) addTo: self loadDirective.
	self postLoad: packageSpec.
	Transcript
		cr;
		show: message! !

!MetacelloFetchingMCSpecLoader methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
scheduleFetchFor: packageSpec cachedReference: reference
	"reference already in the cache during fetch ...no need to schedule fetch"

	^ self! !

!MetacelloGenericProjectSpec methodsFor: 'scripting' stamp: 'dkh 04/02/2013 20:22'!
hasNoLoadConflicts: aMetacelloProjectSpec
  "'projectPackage repositories'"

  ^ (super hasNoLoadConflicts: aMetacelloProjectSpec)
    and: [ 
      (self repositories isEmpty or: [ aMetacelloProjectSpec repositories isEmpty ])
        or: [ self repositories hasNoLoadConflicts: aMetacelloProjectSpec repositories ] ]! !

!MetacelloGenericProjectSpec methodsFor: 'scripting' stamp: 'dkh 6/15/2012 13:37'!
compareEqual: aMetacelloProjectSpec
    "'projectPackage repositories'"

    ^ (super compareEqual: aMetacelloProjectSpec)
        and: [ self repositories compareEqual: aMetacelloProjectSpec repositories ]! !

!MetacelloGenericProjectSpec methodsFor: 'construction' stamp: 'dkh 6/5/2012 19:01:24'!
projectPackage: aBlock constructor: aVersionConstructor
    aVersionConstructor projectPackageForProject: aBlock! !

!MetacelloGenericProjectSpec methodsFor: 'querying' stamp: 'dkh 6/30/2012 12:32'!
repository
    | specs |
    self deprecated: 'Use repositories or repositorySpecs'.
    (specs := self repositorySpecs) isEmpty
        ifTrue: [ ^ nil ].
    ^ specs first! !

!MetacelloGenericProjectSpec methodsFor: 'merging' stamp: 'dkh 6/5/2012 19:01:24'!
mergeSpec: anotherSpec
    | newSpec map anotherRepositories |
    newSpec := super mergeSpec: anotherSpec.
    map := anotherSpec mergeMap.
    (anotherRepositories := map at: #'repositories') ~~ nil
        ifTrue: [ 
            newSpec
                repositories:
                    (self getRepositories == nil
                        ifTrue: [ anotherRepositories ]
                        ifFalse: [ self repositories mergeSpec: anotherRepositories ]) ].
    ^ newSpec! !

!MetacelloGenericProjectSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
getRepositories
    "raw access to iv"

    ^ repositories! !

!MetacelloGenericProjectSpec methodsFor: 'scripting' stamp: 'dkh 6/5/2012 19:01:24'!
metacelloRegistrationHash
    "projectPackage (ignored) repositories"

    ^ super metacelloRegistrationHash bitXor: self repositories metacelloRegistrationHash! !

!MetacelloGenericProjectSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
repositories
    repositories ifNil: [ repositories := self project repositoriesSpec ].
    ^ repositories! !

!MetacelloGenericProjectSpec methodsFor: 'merging' stamp: 'dkh 6/5/2012 19:01:24'!
mergeMap
    | map |
    map := super mergeMap.
    map at: #'repositories' put: repositories.
    ^ map! !

!MetacelloGenericProjectSpec methodsFor: 'loading' stamp: 'dkh 6/5/2012 19:01:24'!
load
    (MetacelloLookupProjectSpecForLoad new
        projectSpec: self;
        yourself) signal performLoad! !

!MetacelloGenericProjectSpec methodsFor: 'accessing' stamp: 'dkh 7/19/2012 16:02'!
projectPackage: aProjectPackage
    self shouldBeMutable.
    projectPackage := aProjectPackage! !

!MetacelloGenericProjectSpec methodsFor: 'construction' stamp: 'dkh 6/5/2012 19:01:24'!
repository: aString username: username password: password constructor: aVersionConstructor
    aVersionConstructor repositoryForProject: aString username: username password: password! !

!MetacelloGenericProjectSpec methodsFor: 'construction' stamp: 'dkh 6/5/2012 19:01:24'!
repository: anObject constructor: aVersionConstructor
    aVersionConstructor repositoryForProject: anObject! !

!MetacelloGenericProjectSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
repository: aString username: username password: password
    self repositories repository: aString username: username password: password.
    self projectPackage: nil! !

!MetacelloGenericProjectSpec methodsFor: 'merging' stamp: 'dkh 6/5/2012 19:01:24'!
nonOverridable
    ^ super nonOverridable , #(#'projectPackage' #'repositories')! !

!MetacelloGenericProjectSpec methodsFor: 'testing' stamp: 'dkh 6/30/2012 13:18'!
hasRepository
    ^ self repositorySpecs notEmpty! !

!MetacelloGenericProjectSpec methodsFor: 'querying' stamp: 'dkh 6/30/2012 14:19'!
repositoryDescriptions
    ^ self repositorySpecs collect: [ :repoSpec | repoSpec description ]! !

!MetacelloGenericProjectSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
repositorySpecs
    repositories ifNil: [ ^ #() ].
    ^ self repositories map values! !

!MetacelloGenericProjectSpec methodsFor: 'loading' stamp: 'dkh 6/5/2012 19:01:24'!
loadVersion: aVersionOrNil
    self subclassResponsibility! !

!MetacelloGenericProjectSpec methodsFor: 'accessing' stamp: 'dkh 7/19/2012 16:02'!
repositories: anObject
    self shouldBeMutable.
    repositories := anObject.
    self projectPackage: nil! !

!MetacelloGenericProjectSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
projectPackage
    self subclassResponsibility! !

!MetacelloGenericProjectSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
name: aString
    super name: aString.
    self projectPackage: nil! !

!MetacelloGenericProjectSpec methodsFor: 'copying' stamp: 'dkh 6/5/2012 19:01:24'!
postCopy
    super postCopy.
    repositories := repositories copy.
    projectPackage := nil! !

!MetacelloGenericProjectSpec methodsFor: 'construction' stamp: 'dkh 6/5/2012 19:01:24'!
repositories: aBlock constructor: aVersionConstructor
    aVersionConstructor repositoriesForProject: aBlock! !

!MetacelloGenericProjectSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
repository: aStringOrMetacelloRepositorySpec
    self repositories repository: aStringOrMetacelloRepositorySpec.
    self projectPackage: nil! !

!MetacelloGenericProjectSpec methodsFor: 'scripting' stamp: 'dkh 7/17/2012 07:04'!
mergeScriptRepository: anotherSpec
    self repositories: anotherSpec repositories! !

!MetacelloGenericProjectSpec methodsFor: 'loading' stamp: 'dkh 6/5/2012 19:01:24'!
determineCurrentVersionForLoad
    self subclassResponsibility! !

!MetacelloGofer methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
basicReferencesIn: aRepository
	((aRepository isKindOf: MCDictionaryRepository) or: [aRepository isKindOf: MCDirectoryRepository])
		ifTrue: [ 
			"No need to cache references for a dictionary repository"
			^ super basicReferencesIn: aRepository ].
	"Use cache for network-based repositories - the contents of repository is cached based on first access 
	 and is _not_ updated afterword, so any mcz files added after the initial cache is created won't be seen"
	^ MetacelloPlatform current
		stackCacheFor: #goferRepository
		cacheClass: IdentityDictionary
		at: aRepository
		doing: [ :cache | 
			^ cache at: aRepository put: (super basicReferencesIn: aRepository) ]! !

!MetacelloGofer methodsFor: 'operations' stamp: 'dkh 6/8/2012 14:04:22'!
interactiveCommit

	^ self execute: MetacelloGoferCommit! !

!MetacelloGoferCommit methodsFor: 'running' stamp: 'ChristopheDemarey 9/11/2013 13:21'!
execute: aWorkingCopy
	| version |
	version := MetacelloPlatform current newVersionForWorkingCopy: aWorkingCopy.
	self gofer repositories
		do: [ :repository | repository storeVersion: version ]! !

!MetacelloGoferLoad methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
updateRepositories
	"Noop for Metacello...done by loader itself"
! !

!MetacelloGoferLoad methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
updateCategories
	MetacelloPlatform current bypassGoferLoadUpdateCategories
		ifFalse: [ super updateCategories ]! !

!MetacelloGoferPackage methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
findWorkingCopy
	"Answer a working copy, or nil if the package is not loaded."

	| wcs |
	wcs := MCWorkingCopy allManagers select: [ :each | self matchesWorkingCopy: each ].
	wcs isEmpty ifTrue: [ ^nil ].
	^wcs detectMax: [:ea | ea package name size ]! !

!MetacelloGoferPackage methodsFor: 'initialization' stamp: 'dkh 6/8/2012 14:04:22'!
initializeName: aString packageFilename: packagefilename

	name := aString.
	packageFilename := packagefilename! !

!MetacelloGoferPackage methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
packageFilename

	^packageFilename! !

!MetacelloGoferPackage methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
matchesWorkingCopy: aWorkingCopy
	"check that the working copy package name matches the package file name and that the first ancestor's package file name
	 matches the packageName"
	
	| pFilename |
	(pFilename := self packageFilename) == nil ifTrue: [ ^self error: 'cannot match working copy' ].
	(self class 
		packageFileName: pFilename 
		matchesPackageName: aWorkingCopy package name)
			ifTrue: [
				aWorkingCopy ancestry ancestors isEmpty ifTrue: [ ^true ].
				^self class 
					packageFileName: aWorkingCopy ancestry ancestors first name 
					matchesPackageName: self packageName ].
	^false
! !

!MetacelloGoferPackage methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
workingCopy
	
	workingCopy == nil ifTrue: [ workingCopy := self findWorkingCopy ].
	^workingCopy! !

!MetacelloGoferPackage methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
currentVersionInfo

	| wc |
	(wc := self workingCopy) ~~ nil
		ifTrue: [ 
			wc ancestry ancestors isEmpty not
				ifTrue: [ ^wc ancestry ancestors first ]].
	^nil! !

!MetacelloGoferPackage methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
ancestors

	| wc |
	(wc := self workingCopy) ~~ nil
		ifTrue: [ 
			wc ancestry ancestors isEmpty not
				ifTrue: [ ^wc ancestry ancestors ]].
	^nil! !

!MetacelloGoferPackage methodsFor: 'private' stamp: 'dkh 6/30/2012 07:54'!
matches: aLoadableReference
    "does Monticello-style #versionInfoFromVersionNamed: matching"

    | pFilename refFilename char |
    ((pFilename := self packageFilename) == nil or: [ self name = self packageFilename ])
        ifTrue: [ ^ super matches: aLoadableReference ].
    aLoadableReference name = pFilename
        ifTrue: [ ^ true ].
    (aLoadableReference name beginsWith: pFilename)
        ifFalse: [ ^ false ].
refFilename := aLoadableReference metacelloPackageNameWithBranch at: 2.
    refFilename = pFilename
        ifTrue: [ ^ true ].
    pFilename size < refFilename size
        ifTrue: [ 
            (refFilename beginsWith: pFilename)
                ifFalse: [ ^ false ].
            (char := pFilename at: pFilename size) ~= $-
                ifTrue: [ char := refFilename at: pFilename size + 1 ] ]
        ifFalse: [ 
            (pFilename beginsWith: refFilename)
                ifFalse: [ ^ false ].
            (char := refFilename at: refFilename size) ~= $-
                ifTrue: [ char := pFilename at: refFilename size + 1 ] ].
    ^ char = $. or: [ char = $- ]! !

!MetacelloGoferPackage class methodsFor: 'package name matching' stamp: 'dkh 6/8/2012 14:04:22'!
packageFileName: pkgFileName matchesPackageName: wcPkgName

	^(pkgFileName beginsWith: wcPkgName) 
		ifTrue: [ 
			(pkgFileName size = wcPkgName size) 
			or: [ ((pkgFileName at: wcPkgName size + 1) = $-) 
				or: [ ((pkgFileName at: wcPkgName size + 1) = $.) 
					or: [ (pkgFileName at: wcPkgName size + 1) isDigit ]]]]
		ifFalse: [
			pkgFileName size >= wcPkgName size ifTrue: [ ^false ].
			(wcPkgName beginsWith: pkgFileName) ifFalse: [ ^false ].
			^(wcPkgName at: pkgFileName size + 1) = $. ]
! !

!MetacelloGoferPackage class methodsFor: 'instance creation' stamp: 'dkh 6/8/2012 14:04:22'!
name: aString packageFilename: packageFilename
	^ self basicNew initializeName: aString packageFilename: packageFilename! !

!MetacelloGroupSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
resolveToPackagesIn: aVersionSpec into: packages visited: visited

	visited 
		visit: self 
		doing: [:aSpec | | map |
			map := aVersionSpec packages map.
			aSpec includes do: [:pkgName | 
				(aVersionSpec packageNamed: pkgName forMap: map ifAbsent: [])
					projectDo: [:ignored | ] 
					packageDo: [:pkg | packages at: pkg name put: pkg ] 
					groupDo: [:grp | grp resolveToPackagesIn: aVersionSpec into: packages visited: visited ]]]! !

!MetacelloGroupSpec methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
configMethodCascadeOn: aStream member: aMember last: lastCascade indent: indent

	aMember methodUpdateSelector == #remove:
		ifTrue: [ aStream nextPutAll: 'removeGroup: ', self name printString. ]
		ifFalse: [
			aStream 
				nextPutAll: 'group: ', self name printString;
				space; 
				nextPutAll: aMember methodUpdateSelector asString, ' #('.
			self includes do: [:str | aStream nextPutAll: str printString, ' ' ].
			aStream nextPut: $) ].
	lastCascade
		ifTrue: [ aStream nextPut: $. ]
		ifFalse: [ aStream nextPut: $;; cr ].
! !

!MetacelloGroupSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
requires: aCollection

	self shouldNotImplement! !

!MetacelloGroupSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
resolveToPackagesIn: aVersionSpec visited: visited

	| packages |
	packages := Dictionary new.
	self resolveToPackagesIn: aVersionSpec into: packages visited: visited.
	^packages values asOrderedCollection
! !

!MetacelloGroupSpec methodsFor: 'visiting' stamp: 'dkh 6/5/2012 19:01:24'!
projectDo: projectBlock packageDo: packageBlock groupDo: groupBlock

	groupBlock value: self! !

!MetacelloGroupSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
loadUsing: aLoader gofer: gofer
	"noop"! !

!MetacelloGroupSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
answers: aListOfPairs

	self shouldNotImplement! !

!MetacelloGroupSpec methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
configMethodOn: aStream indent: indent

	aStream 
		tab: indent;
		nextPutAll: 'spec '; cr;
		tab: indent + 1;
		nextPutAll: 'name: ', self name printString, ';'.
	self configMethodBodyOn: aStream hasName: true cascading: false indent: indent + 1.
	aStream nextPut: $.
! !

!MetacelloGroupSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
resolveToLoadableSpec

	^nil! !

!MetacelloGroupSpecTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testGroupSpec
    | group |
    group := self groupSpec
        name: 'Platform';
        includes: 'Core';
        yourself.
    self assert: group name = 'Platform'.
    self assert: (group includes includes: 'Core').
    group := self groupSpec
        name: 'Platform';
        includes: #('Core');
        yourself.
    self assert: group name = 'Platform'.
    self assert: (group includes includes: 'Core').
    self should: [ group requires: #() ] raise: Error.
    self should: [ group answers: #() ] raise: Error.
    group
        projectDo: [ :ignored | self assert: false ]
        packageDo: [ :ignored | self assert: false ]
        groupDo: [ :grp | self assert: group == grp ]! !

!MetacelloGroupSpecTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testGroupMergeSpec
    | groupA groupB group |
    groupA := self groupSpec
        name: 'Platform';
        includes: 'Core';
        yourself.
    groupB := self groupSpec
        name: 'Platform';
        includes: 'Tests';
        yourself.
    group := groupA mergeSpec: groupB.
    self assert: (group includes includes: 'Core').
    self assert: (group includes includes: 'Tests')! !

!MetacelloIssue108Resource methodsFor: 'running' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpMonticelloRepository
	"This method builds a fake repository with the version references from #buildReferences."

	monticelloRepository := MCDictionaryRepository new.
	versionReferences do: [ :reference |
		monticelloRepository basicStoreVersion: (MCVersion new
			setPackage:  (MetacelloTestsMCPackage new name: reference packageName)
			info: (MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: #())
			snapshot: (MCSnapshot fromDefinitions: (Array
				with: (MCOrganizationDefinition categories: (Array with: reference packageName asSymbol))
				with: (MCClassDefinition name: (reference packageName copyWithout: $-) asSymbol superclassName: #Object category: reference packageName asSymbol instVarNames: #() comment: '')))
			dependencies: #()) ]! !

!MetacelloIssue108Resource methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
monticelloRepository
	^ monticelloRepository! !

!MetacelloIssue108Resource methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
versionReferences
	^ versionReferences! !

!MetacelloIssue108Resource methodsFor: 'running' stamp: 'dkh 05/09/2013 12:02'!
setUp
  "https://code.google.com/p/metacello/issues/detail?id=108"

  super setUp.
  self
    setUpVersionReferences;
    setUpMonticelloRepository! !

!MetacelloIssue108Resource methodsFor: 'running' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpVersionReferences
	"self reset"

	versionReferences := OrderedCollection new.
	versionReferences
		add: (GoferVersionReference name: 'GoferBar.gemstone-dkh.68');
		add: (GoferVersionReference name: 'GoferBar.gemstone-dkh.69');
		add: (GoferVersionReference name: 'GoferBar.gemstone-dkh.70');
		add: (GoferVersionReference name: 'GoferBar-dkh.68');
		add: (GoferVersionReference name: 'GoferBar-dkh.69');
		add: (GoferVersionReference name: 'GoferBar-dkh.70');
		yourself
	! !

!MetacelloLinearLoadDirective methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
title

	^'linear load'! !

!MetacelloLinearLoadDirective methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
loadUsing: aLoaderDirective gofer: aGofer

	self loadDirectives isEmpty ifTrue: [ ^self ].
	aLoaderDirective loadLinearLoadDirective: self gofer: aGofer.
! !

!MetacelloLoadData methodsFor: 'versionInfo' stamp: 'dkh 6/8/2012 14:04:22'!
ancestorsFor: packageSpec ifAbsent: aBlock

	^self versionInfoMap 
		at: packageSpec file 
		ifAbsent: [ 
			self  packageNameMap 
				at: packageSpec name
				ifAbsent: aBlock ]! !

!MetacelloLoadData methodsFor: 'versionInfo' stamp: 'dkh 6/8/2012 14:04:22'!
currentVersionInfoFor: packageSpec ifAbsent: aBlock

	^self versionInfoMap 
		at: packageSpec file 
		ifAbsent: [ 
			self  packageNameMap 
				at: packageSpec name
				ifAbsent: aBlock ]! !

!MetacelloLoadData methodsFor: 'enumerating' stamp: 'dkh 6/8/2012 14:04:22'!
do: aBlock

	self dataMap valuesDo: [:ar |
		aBlock value: (ar at: 1) value: (ar at: 2) value: (ar at: 3) ]! !

!MetacelloLoadData methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
dataMap

	dataMap == nil ifTrue: [ dataMap := Dictionary new ].
	^dataMap! !

!MetacelloLoadData methodsFor: 'testing' stamp: 'dkh 6/8/2012 14:04:22'!
isEmpty

	^self dataMap isEmpty! !

!MetacelloLoadData methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
packageNameMap

	packageNameMap == nil ifTrue: [ packageNameMap := Dictionary new ].
	^packageNameMap! !

!MetacelloLoadData methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
addVersion: version versionInfo: versionInfo resolvedReference: resolvedReference packageSpec: packageSpec
	| vis |
	"check for duplicates and use the one that is being added"
	(vis := self packageNameMap at: packageSpec name ifAbsent: [  ]) ~~ nil
		ifTrue: [ 
			"remove old references"
			vis
				do: [ :vi | 
					self dataMap removeKey: vi name.
					self versionInfoMap removeKey: vi name ] ].
	self dataMap
		at: version info name
		put:
			{version.
			resolvedReference.
			packageSpec}.
	self versionInfoMap at: versionInfo name put: {versionInfo}.
	self packageNameMap at: packageSpec name put: {versionInfo}! !

!MetacelloLoadData methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
versionInfoMap

	versionInfoMap == nil ifTrue: [ versionInfoMap := Dictionary new ].
	^versionInfoMap! !

!MetacelloLoaderPolicy methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
pushAtomicLoadDirectivesDuring: aBlock for: aLoader

	self pushLoadDirective: (MetacelloAtomicLoadDirective loader: aLoader) during: aBlock.
! !

!MetacelloLoaderPolicy methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
ignoreImage
	^ ignoreImage! !

!MetacelloLoaderPolicy methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
repositoryMap: anObject
	repositoryMap := anObject! !

!MetacelloLoaderPolicy methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
ensuredMap: anObject
	ensuredMap := anObject! !

!MetacelloLoaderPolicy methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
silently: anObject
	silently := anObject! !

!MetacelloLoaderPolicy methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
loadData

 	loadData == nil ifTrue: [ loadData := MetacelloLoadData new ].
	^loadData
! !

!MetacelloLoaderPolicy methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
pushLinearLoadDirectivesDuring: aBlock for: aLoader

	self pushLoadDirective: (MetacelloLinearLoadDirective loader: aLoader) during: aBlock.
! !

!MetacelloLoaderPolicy methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
cacheGofer

	cacheGofer == nil 
		ifTrue: [ 
			"don't use a caching Gofer here, since we expect the contents to change during a fetch operation"
			cacheGofer := Gofer new. 
			cacheGofer disablePackageCache.
			cacheGofer repository: self cacheRepository. ].
	^ cacheGofer! !

!MetacelloLoaderPolicy methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
cacheRepository

	cacheRepository == nil ifTrue: [ cacheRepository := MCDictionaryRepository new ].
	^ cacheRepository! !

!MetacelloLoaderPolicy methodsFor: 'initialize-release' stamp: 'dkh 6/8/2012 14:04:22'!
initialize

	self 
		repositoryMap; 
		cacheRepository;
		ensuredMap.
	ignoreImage := false
! !

!MetacelloLoaderPolicy methodsFor: 'testing' stamp: 'dkh 6/8/2012 14:04:22'!
hasRepositoryOverrides

	^self overrideRepositories ~~ nil! !

!MetacelloLoaderPolicy methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
ignoreImage: anObject
	ignoreImage := anObject! !

!MetacelloLoaderPolicy methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
ensuredMap

	ensuredMap == nil ifTrue: [ ensuredMap := Dictionary new ].
	^ensuredMap! !

!MetacelloLoaderPolicy methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
silently

	silently == nil ifTrue: [ silently := false ].
	^ silently! !

!MetacelloLoaderPolicy methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
load

	overrideRepositories := Array with: self cacheRepository. "ensure that hasRepositoryOverrides is true"
	self loadDirective loadWithPolicy: self! !

!MetacelloLoaderPolicy methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
pushExplicitLoadDirectivesDuring: aBlock for: aLoader

	| directive |
	directive := MetacelloExplicitLoadDirective loader: aLoader.
	self pushLoadDirective: directive during: aBlock.
	^directive! !

!MetacelloLoaderPolicy methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
loadDirective

	loadDirective == nil ifTrue: [ loadDirective := MetacelloLinearLoadDirective new ].
	^ loadDirective! !

!MetacelloLoaderPolicy methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
overrideRepositories
	^ overrideRepositories! !

!MetacelloLoaderPolicy methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
pushLoadDirective: aLoaderDirective during: aBlock

	|  oldRoot |
	self loadDirective add: aLoaderDirective.
	oldRoot := loadDirective.
	loadDirective := aLoaderDirective.
	aBlock ensure: [ loadDirective := oldRoot ].
! !

!MetacelloLoaderPolicy methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
overrideRepositories: anObject
	overrideRepositories := anObject! !

!MetacelloLoaderPolicy methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
repositoryMap

	repositoryMap == nil ifTrue: [ repositoryMap := Dictionary new ].
	^repositoryMap! !

!MetacelloLoaderPolicy methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
resetCacheGofer

	cacheGofer := nil! !

!MetacelloLoaderPolicy methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
cacheRepository: anMCRepository

	cacheRepository := anMCRepository.
	"getting a new repository, so wipe out the cacheGofer and ensureMap"
	ensuredMap := cacheGofer := nil! !

!MetacelloLoaderPolicy class methodsFor: 'instance creation' stamp: 'dkh 6/8/2012 14:04:22'!
overrideRepositories: aCollection

	^self new overrideRepositories: aCollection
! !

!MetacelloLoadingMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
fetchingSpecLoader

	^(MetacelloFetchingMCSpecLoader on: self spec)
		shouldDisablePackageCache: self shouldDisablePackageCache;
		loaderPolicy: self loaderPolicy copy;
		yourself! !

!MetacelloLoadingMCSpecLoader methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
repositoryFor: pkgSpec with: gofer

	^([self resolveSpec: pkgSpec with: gofer]
		on: Error
		do: [:ignored | ^nil ]) repository! !

!MetacelloLoadingMCSpecLoader methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
goferCommitPackageUsing: repositorySpecs commitMessage: commitMessage

	| gofer repoSpecs wc |
	repoSpecs := self spec repositorySpecs notEmpty
				ifTrue: [ self spec repositorySpecs ]
				ifFalse: [ repositorySpecs ].
	gofer := MetacelloGofer new.
	gofer disablePackageCache.
	wc := self spec workingCopy.
	repositorySpecs do: [:repoSpec | | repo |
		repo := repoSpec createRepository.
		(wc possiblyNewerVersionsIn: repo) notEmpty
			ifTrue: [ self notify: 'There are possibly newer versions of the package ', self spec name printString, ' in the repository ', repo description printString, '. Cancel and manually merge if you want to pick up the changes from the later version.' ].
		gofer repository: repo ].
	gofer package: self spec name.
	gofer commit: commitMessage.
	^true! !

!MetacelloLoadingMCSpecLoader methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
resolveSpec: pkgSpec from: repositorySpecs

	| gofer |
	gofer := MetacelloGofer new.
	gofer disablePackageCache.
	(self repositoriesFrom: repositorySpecs ignoreOverrides: true) 
		do: [:repo | gofer repository: repo ].
	^self resolveSpec: pkgSpec with: gofer! !

!MetacelloLoadingMCSpecLoader methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
doLoad
	"NOOP"! !

!MetacelloLoadingMCSpecLoader methodsFor: 'packages' stamp: 'dkh 6/8/2012 14:04:22'!
latestPackage: aString fromRepository: repositorySpecs

	| gofer |
	gofer := MetacelloGofer new.
	gofer disablePackageCache.
	(self repositoriesFrom: repositorySpecs) do: [:repo | gofer repository: repo ].
	^([(GoferPackageReference name: aString) resolveWith: gofer]
		on: Error
		do: [:ignored | ^ nil ]) name
! !

!MetacelloLoadingMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
actionLabel

	^'Loading '! !

!MetacelloLoadingMCSpecLoader methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
goferCommitBranchPackage: branchName using: repositorySpecs commitMessage: commitMessage
	| gofer repoSpecs wc |
	repoSpecs := self spec repositorySpecs notEmpty
		ifTrue: [ self spec repositorySpecs ]
		ifFalse: [ repositorySpecs ].
	gofer := MetacelloGofer new.
	gofer disablePackageCache.
	wc := self spec workingCopy.
	repositorySpecs
		do: [ :repoSpec | 
			| repo |
			repo := repoSpec createRepository.
			(wc possiblyNewerVersionsIn: repo) notEmpty
				ifTrue: [ 
					self
						notify:
							'There are possibly newer versions of the package ' , self spec name printString , ' in the repository '
								, repo description printString
								, '. Cancel and manually merge if you want to pick up the changes from the later version.' ].
			gofer repository: repo ].
	gofer package: self spec name.
	[ gofer interactiveCommit ]
		on: MCVersionNameAndMessageRequest
		do: [ :ex | 
			| ref |
			ref := GoferVersionReference name: ex suggestedName.
			ex
				resume:
					{(ref packageName , '.' , branchName , '-' , ref author , '.' , ref versionNumber printString).
					commitMessage} ].
	^ true! !

!MetacelloLoadingMCSpecLoader methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
linearLoadPackageSpec: packageSpec gofer: gofer

	MetacelloPlatform current
		do:  [ | loadBlock goferLoad answers resolvedReference repo |
			resolvedReference := self resolvePackageSpec: packageSpec gofer: gofer.
			resolvedReference isNil ifTrue: [ "Package version already loaded into image" ^self ].
			loadBlock := [
				self preLoad: packageSpec.
				goferLoad := MetacelloGoferLoad on: MetacelloGofer new.
				goferLoad addResolved: resolvedReference.
				goferLoad execute.
				MetacelloPlatform current clearCurrentVersionCache.
				self postLoad: packageSpec ].
			(answers := packageSpec answers) notEmpty
				ifTrue: [ loadBlock valueSupplyingMetacelloAnswers: answers ]
				ifFalse: [ loadBlock value].
			repo := resolvedReference repository.
			self hasRepositoryOverrides
				ifTrue: [
					repo := self loaderPolicy repositoryMap 
								at: resolvedReference name 
								ifAbsent: [ resolvedReference repository ].
					resolvedReference workingCopy repositoryGroup addRepository:  repo ]
				ifFalse: [ resolvedReference workingCopy repositoryGroup addRepository: resolvedReference repository ].
			Transcript cr; show: 'Loaded -> ', resolvedReference name, ' --- ', repo description, ' --- ', resolvedReference repository description  ]
		displaying: 'Loading ', packageSpec file! !

!MetacelloLoadingMCSpecLoader methodsFor: 'doits' stamp: 'dkh 6/8/2012 14:04:22'!
preLoad: packageOrVersionSpec

	| block |
	(block := packageOrVersionSpec preLoadDoItBlock) ~~ nil
		ifTrue: [ block valueWithPossibleArgs: { self. packageOrVersionSpec. } ]! !

!MetacelloLoadingMCSpecLoader methodsFor: 'doits' stamp: 'dkh 6/8/2012 14:04:22'!
postLoad: packageOrVersionSpec

	| block |
	(block := packageOrVersionSpec postLoadDoItBlock) ~~ nil
		ifTrue: [ block valueWithPossibleArgs: { self. packageOrVersionSpec. } ]! !

!MetacelloLoadingMCSpecLoader methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
packagesNeedSavingUsing: repositorySpecs into: aCollection

	| wc repoSpecs repo |
	(wc := self spec workingCopy) == nil ifTrue: [ ^self ].
	(wc ancestry ancestors notEmpty and: [ wc modified not])
		ifTrue: [ ^self ].
	repoSpecs := self spec repositorySpecs notEmpty
				ifTrue: [ self spec repositorySpecs ]
				ifFalse: [ repositorySpecs ].
	repo := (self spec getFile == nil or: [ wc ancestry ancestors isEmpty ])
		ifTrue: [ (self repositoriesFrom: repoSpecs ignoreOverrides: true) first ]
		ifFalse: [
			([ self resolveSpec: self spec from: repoSpecs ] 
				on: Error 
				do: [:ignored | ^self ]) repository ].
	aCollection add: self spec -> repo! !

!MetacelloLoadingMCSpecLoader methodsFor: 'development support' stamp: 'ChristopheDemarey 9/11/2013 13:21'!
savePackageUsing: repositorySpecs

	| wc repo repoSpecs newVersion |
	(wc := self spec workingCopy) == nil ifTrue: [ ^false ].
	(wc ancestry ancestors notEmpty and: [ wc modified not])
		ifTrue: [ ^false ].
	repoSpecs := self spec repositorySpecs notEmpty
				ifTrue: [ self spec repositorySpecs ]
				ifFalse: [ repositorySpecs ].
	(self spec getFile == nil or: [ wc ancestry ancestors isEmpty ])
		ifTrue: [ repo := (self repositoriesFrom: repoSpecs ignoreOverrides: true) first ]
		ifFalse: [
			[ 	| newer |
				repo := (self resolveSpec: self spec from: repoSpecs) repository.
				newer := wc possiblyNewerVersionsIn: repo.
				newer isEmpty not 
					ifTrue: [
						(MetacelloPlatform current confirm: 'CAUTION!! These versions in the repository may be newer:', 
							String cr, newer printString, String cr,
							'Do you really want to save this version?') ifFalse: [ ^false ]] ] 
				on: Error 
				do: [:ignored | ^false ] ].
	(newVersion :=  MetacelloPlatform current newVersionForWorkingCopy: wc) == nil ifTrue: [ ^false ].
	repo storeVersion: newVersion.
	^true! !

!MetacelloLoadingMCSpecLoader methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
repositoryFor: pkgSpec from: repositorySpecs

	^([self resolveSpec: pkgSpec from: repositorySpecs]
		on: Error
		do: [:ignored | ^nil ]) repository! !

!MetacelloLoadingMCSpecLoader methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
copySpec: pkgSpec from: repositorySpecs to: repository

	| gofer |
	gofer := MetacelloGofer new.
	(self repositoriesFrom: repositorySpecs) do: [:repo | gofer repository: repo ].
	^self copySpec: pkgSpec with: gofer to: repository! !

!MetacelloLoadingMCSpecLoader methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
copySpec: pkgSpec with: gofer to: aRepository

	| repository resolvedReference |
	[resolvedReference := pkgSpec goferLoaderReference resolveWith: gofer]
		on: Error
		do: [:ignored | ^nil ].
	repository := MCRepositoryGroup default repositories
		detect: [ :each | each = aRepository ]
		ifNone: [ aRepository ].
	repository storeVersion: resolvedReference version.
	^resolvedReference repository! !

!MetacelloLoadingMCSpecLoader methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
resolveSpec: pkgSpec with: gofer

	^pkgSpec goferLoaderReference resolveWith: gofer! !

!MetacelloLookupBaselineSpecForEnsureLoad methodsFor: 'handlers' stamp: 'dkh 7/27/2012 00:30'!
handleResolutionFor: aScriptEngine
	^ aScriptEngine handleLookupBaselineSpecForEnsureLoad: self! !

!MetacelloLookupBaselineSpecForEnsureLoad methodsFor: 'exception description' stamp: 'dkh 7/27/2012 00:36'!
defaultAction
	"Answer <true> if you want to ensure the load of the baseline ... default is to load the baseline"

	^ true! !

!MetacelloLookupProjectSpec commentStamp: 'dkh 6/1/2012 10:02'!
**MetacelloLookupProjectSpec** is signalled to allow a handler to substitute a different (equivalent) project spec for fetching or loading purposes!
!MetacelloLookupProjectSpec methodsFor: 'handlers' stamp: 'dkh 6/7/2012 16:21'!
handleResolutionFor: aScriptEngine
    ^ aScriptEngine handleLookupProjectSpec: self! !

!MetacelloLookupProjectSpecForLoad commentStamp: 'dkh 6/1/2012 10:55'!
**MetacelloLookupProjectSpecForLoad** ends up returning an instance of **MetacelloProjectSpecForLoad**!
!MetacelloLookupProjectSpecForLoad methodsFor: 'handlers' stamp: 'dkh 6/7/2012 16:23'!
handleResolutionFor: aScriptEngine
    ^ aScriptEngine handleLookupProjectSpecForLoad: self! !

!MetacelloLookupProjectSpecForLoad methodsFor: 'exception description' stamp: 'dkh 6/5/2012 19:01:24'!
defaultAction
    "Result of signal should be the MetacelloProjectSpecForLoad to be used to perform the load. 
	Create a MetacelloProjectSpecForLoad and use the overrideProjectSpec: if you want to supply a different projectSpec"

    ^ MetacelloProjectSpecForLoad new
        projectSpec: self projectSpec;
        yourself! !

!MetacelloMCBaselineOfProjectSpec methodsFor: 'scripting' stamp: 'dkh 7/23/2012 14:29'!
validateVersionString: issues withDefaultVersionString: ignored
    self versionString
        ifNotNil: [ :vs | 
            | prj |
            prj := self project asBaselineProject.
            vs ~= prj singletonVersionName
                ifTrue: [ 
                    issues
                        add:
                            (MetacelloValidationError
                                configurationClass: self projectClass
                                reasonCode: #'invalidVersionString'
                                callSite:
                                    #'validateForScriptLoad:withDefaultVersionString:withDefaultRepositoryDecription:'
                                explanation:
                                    'version field is incorrect, should be: ' , prj singletonVersionName printString) ] ]! !

!MetacelloMCBaselineOfProjectSpec methodsFor: 'scripting' stamp: 'dkh 6/8/2012 14:04:22'!
asProjectRegistration
    ^ MetacelloProjectRegistration fromMCBaselineProjectSpec: self! !

!MetacelloMCBaselineOfProjectSpec methodsFor: 'scripting' stamp: 'dkh 6/8/2012 14:04:22'!
asProjectSpec
    ^ self copyForScriptingInto: (MetacelloMCProjectSpec for: self project asConfigurationProject)! !

!MetacelloMCBaselineOfProjectSpec methodsFor: 'scripting' stamp: 'dkh 6/8/2012 14:04:22'!
canDowngradeTo: aProjectSpec
    "cannot upgrade between baselines"

    ^ false! !

!MetacelloMCBaselineOfProjectSpec methodsFor: 'construction' stamp: 'dkh 6/8/2012 14:04:22'!
versionString: anObject constructor: aVersionConstructor
    self error: 'versionString: not allowed in a baseline project spec'! !

!MetacelloMCBaselineOfProjectSpec methodsFor: 'loading' stamp: 'dkh 07/16/2013 15:06'!
ensureConfigurationLoaded: vrsn ensured: ensured
  "answer true if the configuration should be reloaded"

  "see Issue #181 for details ... basically we always want to consider loading the baseline from a project reference, especially if the two project specs are not the same..."

  "https://github.com/dalehenrich/metacello-work/issues/181"

  ^ true! !

!MetacelloMCBaselineOfProjectSpec methodsFor: 'merging' stamp: 'dkh 6/8/2012 14:04:22'!
mergeSpec: anotherSpec
    ^ super mergeSpec: anotherSpec asBaselineProjectSpec! !

!MetacelloMCBaselineOfProjectSpec methodsFor: 'printing' stamp: 'dkh 6/8/2012 14:04:22'!
projectLabel
    ^ 'baseline'! !

!MetacelloMCBaselineOfProjectSpec methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
version
    self projectClass == nil
        ifTrue: [ ^ nil ].
    ^ self projectClassProject version! !

!MetacelloMCBaselineOfProjectSpec methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
constructClassName
    ^ 'BaselineOf' , self name! !

!MetacelloMCBaselineOfProjectSpec methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
versionString
    ^ versionString ifNil: [ self version ifNotNil: [:v | v versionString] ]! !

!MetacelloMCBaselineOfProjectSpec methodsFor: 'mutability' stamp: 'dkh 7/19/2012 20:42'!
copyForRegistration: aMetacelloProjectRegistration onWrite: aBlock
    | copy |
    aMetacelloProjectRegistration
        baselineProjectSpecIfPresent: [ :spec | 
            copy := spec copy.
            aBlock value: copy.
            aMetacelloProjectRegistration baselineProjectSpec: copy ]
        ifAbsent: [ 
            aMetacelloProjectRegistration
                configurationProjectSpecIfPresent: [ :spec | 
                    copy := spec copy.
                    aBlock value: copy.
                    aMetacelloProjectRegistration configurationProjectSpec: copy ]
                ifAbsent: [ aBlock value: nil ] ]! !

!MetacelloMCBaselineOfProjectSpec methodsFor: 'importing' stamp: 'dkh 6/26/2012 16:34'!
mergeImportLoads: aLoadList
    aLoadList
        ifNotNil: [ :otherLoads | self loads ifNil: [ loads := otherLoads ] ifNotNil: [ loads := loads , otherLoads ] ]! !

!MetacelloMCBaselineOfProjectSpec methodsFor: 'construction' stamp: 'dkh 6/8/2012 14:04:22'!
version: anObject constructor: aVersionConstructor
    self error: 'version: not allowed in a baseline project spec'! !

!MetacelloMCBaselineOfProjectSpec methodsFor: 'scripting' stamp: 'dkh 6/8/2012 14:04:22'!
canUpgradeTo: aProjectSpec
    "cannot upgrade between baselines"

    ^ false! !

!MetacelloMCBaselineOfProjectSpec methodsFor: 'private' stamp: 'dkh 07/28/2013 08:06'!
hasConflictWithConfiguration: aConfigurationProjectSpec
  self name = aConfigurationProjectSpec name
    ifFalse: [ ^ true ].
  self project configuration className
    = aConfigurationProjectSpec project configuration className
    ifFalse: [ ^ true ].
  ^ ((self repositories isEmpty
    or: [ aConfigurationProjectSpec repositories isEmpty ])
    or: [ self repositories hasNoLoadConflicts: aConfigurationProjectSpec repositories ])
    not! !

!MetacelloMCBaselineOfProjectSpec methodsFor: 'scripting' stamp: 'dkh 6/8/2012 14:04:22'!
asBaselineProjectSpec
    ^ self! !

!MetacelloMCBaselineOfProjectSpec methodsFor: 'printing' stamp: 'dkh 6/8/2012 14:04:22'!
hasClassName
    ^ className ~~ nil and: [ className ~= self constructClassName ]! !

!MetacelloMCBaselineOfProjectSpec methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
determineCurrentVersionForLoad
    ^ self version! !

!MetacelloMCBaselineProject commentStamp: 'dkh 5/5/2012 08:47'!
The **MetacelloMCBaselineProject**  is a wrapper for the **BaselineOf** version specification for file-based repositories.

There is a single version in a **MetacelloMCBaselineProject**, named *'baseline'*.

A typical **BaselineOf** is specification:

```Smalltalk
baseline: spec
    <baseline>
    spec
        package: 'External-Core';
        package: 'External-Tests' with: [ spec requires: 'External-Core' ];
        yourself.
    spec
        group: 'Core' with: #('External-Core');
        group: 'default' with: #('Core');
        group: 'Tests' with: #('External-Tests');
        yourself
```

The `<baseline>` pragma marks the method containing the baseline specification.!
!MetacelloMCBaselineProject methodsFor: 'as yet unclassified' stamp: 'dkh 7/2/2012 16:42'!
setBaselineRepositoryDescription: aListOrRepositoryDescriptions
    "set #version repositories to < aListOrRepositoryDescriptions>. Should be the directory where the BaselineOf is located."

    aListOrRepositoryDescriptions do: [:desc | self version spec repository: desc]! !

!MetacelloMCBaselineProject methodsFor: 'versions' stamp: 'dkh 7/20/2012 12:12'!
currentVersion
    ^ self version isSomethingLoaded
        ifTrue: [ self version ]
        ifFalse: [ nil ]! !

!MetacelloMCBaselineProject methodsFor: 'versions' stamp: 'dkh 6/8/2012 14:04:22'!
latestVersion
    ^ self version! !

!MetacelloMCBaselineProject methodsFor: 'versions' stamp: 'dkh 6/8/2012 14:04:22'!
lastVersion
    ^ self version! !

!MetacelloMCBaselineProject methodsFor: 'versions' stamp: 'dkh 6/8/2012 14:04:22'!
symbolicVersionSymbols
    ^ nil! !

!MetacelloMCBaselineProject methodsFor: 'versions' stamp: 'dkh 6/8/2012 14:04:22'!
version
    ^ self version: self singletonVersionName! !

!MetacelloMCBaselineProject methodsFor: 'versions' stamp: 'dkh 6/8/2012 14:04:22'!
development
    ^ nil! !

!MetacelloMCBaselineProject methodsFor: 'scripting' stamp: 'dkh 6/8/2012 14:04:22'!
asBaselineProject
    ^ self! !

!MetacelloMCBaselineProject methodsFor: 'scripting' stamp: 'dkh 6/8/2012 14:04:22'!
projectForScriptEngine: aMetacelloScriptEngine unconditionalLoad: aBool
    ^ aMetacelloScriptEngine getBaselineProjectUnconditionalLoad: aBool! !

!MetacelloMCBaselineProject methodsFor: 'versions' stamp: 'dkh 6/13/2012 13:51'!
singletonVersionName
    ^ self class singletonVersionName! !

!MetacelloMCBaselineProject methodsFor: 'versions' stamp: 'dkh 6/8/2012 14:04:22'!
latestVersionMatching: versionPatternString excludedBlessings: excluded
    ^ nil! !

!MetacelloMCBaselineProject methodsFor: 'versions' stamp: 'dkh 05/15/2013 21:02'!
versions
  ^ [ {(self version)} ]
    on: MetacelloVersionDoesNotExistError
    do: [ :ex | ^ #() ]! !

!MetacelloMCBaselineProject methodsFor: 'versions' stamp: 'dkh 6/8/2012 14:04:22'!
currentVersionAgainst: resolvedPackageAndProjectNames
    ^ nil! !

!MetacelloMCBaselineProject methodsFor: 'versions' stamp: 'dkh 6/8/2012 14:04:22'!
latestVersionMatching: versionPatternString includedBlessings: included excludedBlessings: excludedBlessings
    ^ nil! !

!MetacelloMCBaselineProject methodsFor: 'versions' stamp: 'dkh 6/8/2012 14:04:22'!
bleedingEdge
    ^ nil! !

!MetacelloMCBaselineProject methodsFor: 'versions' stamp: 'dkh 6/8/2012 14:04:22'!
latestVersionMatching: versionPatternString includedBlessings: included
    ^ nil! !

!MetacelloMCBaselineProject methodsFor: 'scripting' stamp: 'dkh 6/8/2012 14:04:22'!
asConfigurationProject
    ^ MetacelloMCProject new! !

!MetacelloMCBaselineProject methodsFor: 'versions' stamp: 'dkh 6/8/2012 14:04:22'!
stableVersion
    ^ nil! !

!MetacelloMCBaselineProject methodsFor: 'versions' stamp: 'dkh 6/8/2012 14:04:22'!
hasVersion: versionString
    ^ versionString = 'baseline'! !

!MetacelloMCBaselineProject methodsFor: 'versions' stamp: 'dkh 6/8/2012 14:04:22'!
latestVersionMatching: versionPatternString
    ^ nil! !

!MetacelloMCBaselineProject methodsFor: 'versions' stamp: 'dkh 6/8/2012 14:04:22'!
latestVersion: blessing
    ^ nil! !

!MetacelloMCBaselineProject class methodsFor: 'accessing' stamp: 'dkh 6/13/2012 13:51'!
singletonVersionName
    ^ 'baseline'! !

!MetacelloMCBaselineProject class methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
versionConstructorClass
    ^ MetacelloBaselineConstructor! !

!MetacelloMCConfigurationOfProjectSpec methodsFor: 'scripting' stamp: 'dkh 6/8/2012 14:04:22'!
asProjectRegistration
    ^ MetacelloProjectRegistration fromMCConfigurationProjectSpec: self! !

!MetacelloMCConfigurationOfProjectSpec methodsFor: 'scripting' stamp: 'dkh 6/8/2012 14:04:22'!
asProjectSpec
    ^ self copyForScriptingInto: (MetacelloMCProjectSpec for: self project asConfigurationProject)! !

!MetacelloMCConfigurationOfProjectSpec methodsFor: 'scripting' stamp: 'dkh 6/8/2012 14:04:22'!
asConfigurationProjectSpec
    ^ self! !

!MetacelloMCConfigurationOfProjectSpec methodsFor: 'mutability' stamp: 'dkh 7/19/2012 20:42'!
copyForRegistration: aMetacelloProjectRegistration onWrite: aBlock
    | copy |
    aMetacelloProjectRegistration
        configurationProjectSpecIfPresent: [ :spec | 
            copy := spec copy.
            aBlock value: copy.
            aMetacelloProjectRegistration configurationProjectSpec: copy ]
        ifAbsent: [ 
            aMetacelloProjectRegistration
                baselineProjectSpecIfPresent: [ :spec | 
                    copy := spec copy.
                    aBlock value: copy.
                    aMetacelloProjectRegistration baselineProjectSpec: copy ]
                ifAbsent: [ aBlock value: nil ] ]! !

!MetacelloMCConfigurationOfProjectSpec methodsFor: 'merging' stamp: 'dkh 6/8/2012 14:04:22'!
mergeSpec: anotherSpec
    ^ super mergeSpec: anotherSpec asConfigurationProjectSpec! !

!MetacelloMCConfigurationOfProjectSpec methodsFor: 'printing' stamp: 'dkh 6/8/2012 14:04:22'!
projectLabel
    ^ 'configuration'! !

!MetacelloMCConfigurationOfProjectSpec methodsFor: 'printing' stamp: 'dkh 6/8/2012 14:04:22'!
hasClassName
    ^ className ~~ nil and: [ className ~= self constructClassName ]! !

!MetacelloMCConfigurationOfProjectSpec methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
constructClassName
    ^ 'ConfigurationOf' , self name! !

!MetacelloMCGroupSpecTestCase methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
projectClass
    ^ MetacelloMCProject! !

!MetacelloMCPackagesSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testRemovePackageD
    "used by MetacelloAbstractVersionConstructor>>removePackage:"

    | packages removed |
    packages := self packagesSpec.
    packages
        add:
            (self packageSpec
                name: 'Package';
                requires: 'AnotherPackage';
                includes: 'IncludedPackage';
                answers: #(#('preload' 'preload answer') #('postload' 'postload answer'));
                file: 'Package-dkh.1';
                preLoadDoIt: #'preLoadDoIt';
                postLoadDoIt: #'postLoadDoIt';
                yourself).
    packages remove: 'Package'.
    removed := false.
    packages packageNamed: 'Package' ifAbsent: [ removed := true ].
    self assert: removed! !

!MetacelloMCPackagesSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testMergePackageA
    "used by MetacelloAbstractVersionConstructor>>package:with:"

    | packages package |
    packages := self packagesSpec.
    packages
        add:
            (self packageSpec
                name: 'Package';
                requires: 'AnotherPackage';
                includes: 'IncludedPackage';
                answers: #(#('preload' 'preload answer') #('postload' 'postload answer'));
                file: 'Package-dkh.1';
                preLoadDoIt: #'preLoadDoIt';
                postLoadDoIt: #'postLoadDoIt';
                yourself).
    packages
        merge:
            (self packageSpec
                name: 'Package';
                requires: 'AndAnotherPackage';
                includes: 'AndIncludedPackage';
                answers: #(#('xpostload' 'xpostload answer'));
                file: 'Package-dkh.2';
                yourself).
    package := packages packageNamed: 'Package' ifAbsent: [ self assert: false ].
    self assert: package name = 'Package'.
    self assert: package requires = #('AnotherPackage' 'AndAnotherPackage').
    self assert: package includes = #('IncludedPackage' 'AndIncludedPackage').
    self
        assert:
            package answers = #(#('preload' 'preload answer') #('postload' 'postload answer') #('xpostload' 'xpostload answer')).
    self assert: package file = 'Package-dkh.2'.
    self assert: package preLoadDoIt value == #'preLoadDoIt'.
    self assert: package postLoadDoIt value == #'postLoadDoIt'! !

!MetacelloMCPackagesSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testRemovePackageA
    "used by MetacelloAbstractVersionConstructor>>removePackage:"

    | packages removed |
    packages := self packagesSpec.
    packages
        add:
            (self packageSpec
                name: 'Package';
                requires: 'AnotherPackage';
                includes: 'IncludedPackage';
                answers: #(#('preload' 'preload answer') #('postload' 'postload answer'));
                file: 'Package-dkh.1';
                preLoadDoIt: #'preLoadDoIt';
                postLoadDoIt: #'postLoadDoIt';
                yourself).
    packages
        remove:
            (self packageSpec
                name: 'Package';
                yourself).
    removed := false.
    packages packageNamed: 'Package' ifAbsent: [ removed := true ].
    self assert: removed! !

!MetacelloMCPackagesSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testMergePackageD
    "used by MetacelloAbstractVersionConstructor>>package:with:"

    | packages |
    packages := self packagesSpec.
    packages
        add: 'Platform';
        merge: 'Tests'.
    packages packageNamed: 'Platform' ifAbsent: [ self assert: false ].
    packages packageNamed: 'Tests' ifAbsent: [ self assert: false ]! !

!MetacelloMCPackagesSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testAddPackageC
    "used by MetacelloAbstractVersionConstructor>>package: and MetacelloAbstractVersionConstructor>>package:overrides:"

    | packages |
    packages := self packagesSpec.
    packages
        add:
            {'Platform'.
            'Base'.
            'Tests'}.
    packages packageNamed: 'Platform' ifAbsent: [ self assert: false ].
    packages packageNamed: 'Base' ifAbsent: [ self assert: false ].
    packages packageNamed: 'Tests' ifAbsent: [ self assert: false ]! !

!MetacelloMCPackagesSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testAddPackageA
    "used by MetacelloAbstractVersionConstructor>>package: and MetacelloAbstractVersionConstructor>>package:overrides:"

    | packages package |
    packages := self packagesSpec.
    packages
        add:
            (self packageSpec
                name: 'Package';
                requires: 'AnotherPackage';
                includes: 'IncludedPackage';
                answers: #(#('preload' 'preload answer') #('postload' 'postload answer'));
                file: 'Package-dkh.1';
                preLoadDoIt: #'preLoadDoIt';
                postLoadDoIt: #'postLoadDoIt';
                yourself).
    packages
        add:
            (self packageSpec
                name: 'Package';
                requires: 'AndAnotherPackage';
                includes: 'AndIncludedPackage';
                answers: #(#('postload' 'postload answer'));
                file: 'Package-dkh.2';
                yourself).
    package := packages packageNamed: 'Package' ifAbsent: [ self assert: false ].
    self assert: package name = 'Package'.
    self assert: package requires = #('AndAnotherPackage').
    self assert: package includes = #('AndIncludedPackage').
    self assert: package answers = #(#('postload' 'postload answer')).
    self assert: package file = 'Package-dkh.2'.
    self assert: package preLoadDoIt value == nil.
    self assert: package postLoadDoIt value == nil! !

!MetacelloMCPackagesSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testCopyToPackage
    "not currently used by MetacelloAbstractVersionConstructor"

    | packages package |
    packages := self packagesSpec.
    packages
        add:
            (self packageSpec
                name: 'Package';
                requires: 'AnotherPackage';
                includes: 'IncludedPackage';
                answers: #(#('preload' 'preload answer') #('postload' 'postload answer'));
                file: 'Package-dkh.1';
                preLoadDoIt: #'preLoadDoIt';
                postLoadDoIt: #'postLoadDoIt';
                yourself).
    packages
        copy: 'Package'
        to:
            (self packageSpec
                name: 'PackageCopy';
                yourself).
    package := packages packageNamed: 'PackageCopy' ifAbsent: [ self assert: false ].
    self assert: package name = 'PackageCopy'.
    self assert: package requires = #('AnotherPackage').
    self assert: package includes = #('IncludedPackage').
    self assert: package answers = #(#('preload' 'preload answer') #('postload' 'postload answer')).
    self assert: package file = 'Package-dkh.1'.
    self assert: package preLoadDoIt value == #'preLoadDoIt'.
    self assert: package postLoadDoIt value == #'postLoadDoIt'! !

!MetacelloMCPackagesSpecTestCase methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
projectClass
    ^ MetacelloMCProject! !

!MetacelloMCPackagesSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testAddPackageB
    "used by MetacelloAbstractVersionConstructor>>package: and MetacelloAbstractVersionConstructor>>package:overrides:"

    | packages package |
    packages := self packagesSpec.
    packages
        add:
            {(self packageSpec
                name: 'Package';
                requires: 'AnotherPackage';
                includes: 'IncludedPackage';
                answers: #(#('preload' 'preload answer') #('postload' 'postload answer'));
                file: 'Package-dkh.1';
                preLoadDoIt: #'preLoadDoIt';
                postLoadDoIt: #'postLoadDoIt';
                yourself).
            (self packageSpec
                name: 'Package';
                requires: 'AndAnotherPackage';
                includes: 'AndIncludedPackage';
                answers: #(#('postload' 'postload answer'));
                file: 'Package-dkh.2';
                yourself)}.
    package := packages packageNamed: 'Package' ifAbsent: [ self assert: false ].
    self assert: package name = 'Package'.
    self assert: package requires = #('AndAnotherPackage').
    self assert: package includes = #('AndIncludedPackage').
    self assert: package answers = #(#('postload' 'postload answer')).
    self assert: package file = 'Package-dkh.2'.
    self assert: package preLoadDoIt value == nil.
    self assert: package postLoadDoIt value == nil! !

!MetacelloMCPackagesSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testMergePackageB
    "used by MetacelloAbstractVersionConstructor>>package:with:"

    | packages package |
    packages := self packagesSpec.
    packages
        add:
            (self packageSpec
                name: 'Package';
                requires: 'AnotherPackage';
                includes: 'IncludedPackage';
                answers: #(#('preload' 'preload answer') #('postload' 'postload answer'));
                file: 'Package-dkh.1';
                preLoadDoIt: #'preLoadDoIt';
                postLoadDoIt: #'postLoadDoIt';
                yourself).
    packages
        merge:
            {(self packageSpec
                name: 'Package';
                requires: 'AndAnotherPackage';
                includes: 'AndIncludedPackage';
                answers: #(#('xpostload' 'xpostload answer'));
                file: 'Package-dkh.2';
                yourself)}.
    package := packages packageNamed: 'Package' ifAbsent: [ self assert: false ].
    self assert: package name = 'Package'.
    self assert: package requires = #('AnotherPackage' 'AndAnotherPackage').
    self assert: package includes = #('IncludedPackage' 'AndIncludedPackage').
    self
        assert:
            package answers = #(#('preload' 'preload answer') #('postload' 'postload answer') #('xpostload' 'xpostload answer')).
    self assert: package file = 'Package-dkh.2'.
    self assert: package preLoadDoIt value == #'preLoadDoIt'.
    self assert: package postLoadDoIt value == #'postLoadDoIt'! !

!MetacelloMCPackagesSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testRemovePackageC
    "used by MetacelloAbstractVersionConstructor>>removePackage:"

    | packages removed |
    packages := self packagesSpec.
    packages
        add:
            (self packageSpec
                name: 'Package';
                requires: 'AnotherPackage';
                includes: 'IncludedPackage';
                answers: #(#('preload' 'preload answer') #('postload' 'postload answer'));
                file: 'Package-dkh.1';
                preLoadDoIt: #'preLoadDoIt';
                postLoadDoIt: #'postLoadDoIt';
                yourself).
    packages remove: {'Package'}.
    removed := false.
    packages packageNamed: 'Package' ifAbsent: [ removed := true ].
    self assert: removed! !

!MetacelloMCPackagesSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testRemovePackageB
    "used by MetacelloAbstractVersionConstructor>>removePackage:"

    | packages removed |
    packages := self packagesSpec.
    packages
        add:
            (self packageSpec
                name: 'Package';
                requires: 'AnotherPackage';
                includes: 'IncludedPackage';
                answers: #(#('preload' 'preload answer') #('postload' 'postload answer'));
                file: 'Package-dkh.1';
                preLoadDoIt: #'preLoadDoIt';
                postLoadDoIt: #'postLoadDoIt';
                yourself).
    packages
        remove:
            {(self packageSpec
                name: 'Package';
                yourself)}.
    removed := false.
    packages packageNamed: 'Package' ifAbsent: [ removed := true ].
    self assert: removed! !

!MetacelloMCPackagesSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testAddPackageD
    "used by MetacelloAbstractVersionConstructor>>package: and MetacelloAbstractVersionConstructor>>package:overrides:"

    | packages |
    packages := self packagesSpec.
    packages add: 'Platform'.
    packages packageNamed: 'Platform' ifAbsent: [ self assert: false ]! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
aLoadedPackageIsCurrent
	^ aLoadedPackageIsCurrent! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
aLoadedProjectIsCurrent: aBoolean
	aLoadedProjectIsCurrent := aBoolean! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'testing' stamp: 'dkh 6/8/2012 14:04:22'!
isLoadedMatchConstraints: matchBlock
	"all loaded projects and packages match constraints (at least one package loaded)"

	| matchStatus |
	matchStatus := #loadedMatchConstraints.
	(self evaluateStatus: #(#allLoadedToSpec #loadedToSpec #loadedMatchConstraints))
		ifTrue: [ 
			aPackageIsLoaded & aProjectIsLoaded
				ifTrue: [ 
					(aLoadedPackageIsExact | aLoadedPackageIsCurrent & aLoadedPackageIsNotCurrent not
						and: [ aLoadedProjectIsExact | aLoadedProjectIsCurrent & aLoadedProjectIsNotCurrent not ])
						ifTrue: [ matchBlock value: matchStatus ] ]
				ifFalse: [ 
					aPackageIsLoaded
						ifTrue: [ 
							aLoadedPackageIsExact | aLoadedPackageIsCurrent & aLoadedPackageIsNotCurrent not
								ifTrue: [ matchBlock value: matchStatus ] ]
						ifFalse: [ 
							hasNoPackage & (aLoadedProjectIsExact | aLoadedProjectIsCurrent) & aLoadedProjectIsNotCurrent not
								ifTrue: [ matchBlock value: matchStatus ] ] ] ]! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
aProjectIsLoaded
	^aProjectIsLoaded! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'testing' stamp: 'dkh 6/8/2012 14:04:22'!
isAllLoadedToSpec: matchBlock
        "all projects and packages are loaded and match specification"

	(self evaluateStatus: #(#allLoadedToSpec))
		ifTrue: [ 
			((hasNoPackage
				or: [ 
					aPackageIsLoaded & aPackageNotLoaded not & aLoadedPackageIsExact & aLoadedPackageIsNotCurrent not
						& aLoadedPackageIsCurrent not ])
				and: [ 
					hasNoProject
						or: [ 
							aProjectIsLoaded & aProjectNotLoaded not & aLoadedProjectIsExact & aLoadedProjectIsNotCurrent not
								& aLoadedProjectIsCurrent not ] ])
				ifTrue: [ matchBlock value: #allLoadedToSpec ] ]! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
aPackageNotLoaded: aBoolean
	aPackageNotLoaded := aBoolean! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
hasNoProject
	^ hasNoProject! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
hasNoProject: aBoolean
	hasNoProject := aBoolean! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
aPackageIsLoaded
	^aPackageIsLoaded! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
aLoadedPackageIsNotCurrent
	^ aLoadedPackageIsNotCurrent! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
abort
	^ abort! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
aLoadedPackageIsExact: aBoolean
	aLoadedPackageIsExact := aBoolean! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
hasNoPackage: aBoolean
	hasNoPackage := aBoolean! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'initialization' stamp: 'dkh 6/8/2012 14:04:22'!
initialize
	super initialize.
	hasNoPackage := hasNoProject := true.
	aProjectIsLoaded := aPackageIsLoaded := false.
	aLoadedProjectIsExact := aLoadedPackageIsExact := false.
	aLoadedProjectIsCurrent := aLoadedPackageIsCurrent := false.
	aLoadedProjectIsNotCurrent := aLoadedPackageIsNotCurrent := false.
	aProjectNotLoaded := aPackageNotLoaded := false.
	vrsnStatus := Set new.
	abort := false! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
hasNoPackage
	^ hasNoPackage! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
aPackageIsLoaded: aBoolean
	aPackageIsLoaded := aBoolean! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
aLoadedProjectIsNotCurrent: aBoolean
	aLoadedProjectIsNotCurrent := aBoolean! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
aPackageNotLoaded
	^aPackageNotLoaded! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
vrsnStatus
	^vrsnStatus! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
aProjectIsLoaded: aBoolean
	aProjectIsLoaded := aBoolean! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
aLoadedPackageIsNotCurrent: aBoolean
	aLoadedPackageIsNotCurrent := aBoolean! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
aLoadedPackageIsExact
	^ aLoadedPackageIsExact! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
aProjectNotLoaded
	^aProjectNotLoaded! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
aLoadedProjectIsExact
	^ aLoadedProjectIsExact! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'evaulation' stamp: 'dkh 6/8/2012 14:04:22'!
evaluateStatus: validStatusList
	^self abort
		ifTrue: [ false ]
		ifFalse: [ 
			(self hasNoProject or: [ self vrsnStatus isEmpty ])
				ifTrue: [ true ]
				ifFalse: [ 
					| valid |
					valid := true.
					vrsnStatus
						do: [ :status | 
							(validStatusList includes: status)
								ifFalse: [ valid := false ] ].
					valid ] ]! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
abort: aBoolean
	abort := aBoolean! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
aLoadedPackageIsCurrent: aBoolean
	aLoadedPackageIsCurrent := aBoolean! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'testing' stamp: 'dkh 6/8/2012 14:04:22'!
isSomethingLoaded: somethingLoadedBlock
	"at least one package loaded"

	(self evaluateStatus: #(#allLoadedToSpec #loadedToSpec #loadedMatchConstraints #somethingLoaded))
		ifTrue: [ 
			aPackageIsLoaded
				ifTrue: [ somethingLoadedBlock value: #somethingLoaded ] ]! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'testing' stamp: 'dkh 6/8/2012 14:04:22'!
isLoadedToSpec: matchBlock
	"all loaded projects and packages match specifications (at least one package loaded)"

	| matchStatus |
	matchStatus := #loadedToSpec.
	(self evaluateStatus: #(#allLoadedToSpec #loadedToSpec))
		ifTrue: [ 
			aPackageIsLoaded & aProjectIsLoaded
				ifTrue: [ 
					(aLoadedPackageIsExact & aLoadedPackageIsCurrent not & aLoadedPackageIsNotCurrent not
						and: [ aLoadedProjectIsExact & aLoadedProjectIsCurrent not & aLoadedProjectIsNotCurrent not ])
						ifTrue: [ matchBlock value: matchStatus ] ]
				ifFalse: [ 
					aPackageIsLoaded
						ifTrue: [ 
							aLoadedPackageIsExact & aLoadedPackageIsCurrent not & aLoadedPackageIsNotCurrent not
								ifTrue: [ matchBlock value: matchStatus ] ]
						ifFalse: [ 
							hasNoPackage & aLoadedProjectIsExact & aLoadedProjectIsCurrent not & aLoadedProjectIsNotCurrent not
								ifTrue: [ matchBlock value: matchStatus ] ] ] ]! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
aProjectNotLoaded: aBoolean
	aProjectNotLoaded := aBoolean! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
aLoadedProjectIsExact: aBoolean
	aLoadedProjectIsExact := aBoolean! !

!MetacelloMCPartiallyLoadedStatus methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
aLoadedProjectIsNotCurrent
	^ aLoadedProjectIsNotCurrent! !

!MetacelloMCPartiallyLoadedStatus class methodsFor: 'instance creation' stamp: 'dkh 6/8/2012 14:04:22'!
new
	^ self basicNew initialize! !

!MetacelloMCProject methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
packagesNeedSaving: aVersionString
	"Answer a collection of associations (package -> repository) representing the packages 
	 reachable from this project that need to be saved"

	| packages |
	packages := Set new.
	(self version: aVersionString) spec 
		packagesNeedSavingVisited: (Set with: self configuration class name asString)
		into: packages.
	^packages! !

!MetacelloMCProject methodsFor: 'repository creation' stamp: 'dkh 6/8/2012 14:04:22'!
createRepository: aRepositorySpec

	^ MetacelloPlatform current createRepository: aRepositorySpec! !

!MetacelloMCProject methodsFor: 'spec classes' stamp: 'dkh 6/8/2012 14:04:22'!
repositoriesSpecClass

	^MetacelloRepositoriesSpec! !

!MetacelloMCProject methodsFor: 'spec classes' stamp: 'dkh 6/8/2012 14:04:22'!
defaultLoaderClass

	^MetacelloLoadingMCSpecLoader! !

!MetacelloMCProject methodsFor: 'spec classes' stamp: 'dkh 6/8/2012 14:04:22'!
packageSpecClass

	^MetacelloPackageSpec! !

!MetacelloMCProject methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
fetchProject: aLoaderPolicy
	"fetch the latest version of the configuration package"
	
	| mcLoader |
	(mcLoader := self loader) == nil
		ifTrue: [ mcLoader := self project loaderClass on: nil ].
	mcLoader loaderPolicy: aLoaderPolicy.
	mcLoader doingLoads: [ 
		MCWorkingCopy
			managersForClass: self configuration class
			do: [:mgr | | pkg |
				pkg := self packageSpec.
				mgr repositoryGroup repositories do: [:repo | pkg repositories repository: (repo asRepositorySpecFor: self) ].
				pkg name: mgr packageName.
				pkg fetchUsing: mcLoader.
				^true ]].
	^true
! !

!MetacelloMCProject methodsFor: 'scripting' stamp: 'dkh 6/8/2012 14:04:22'!
projectForScriptEngine: aMetacelloScriptEngine unconditionalLoad: aBool
    ^ aMetacelloScriptEngine getConfigurationProjectUnconditionalLoad: aBool! !

!MetacelloMCProject methodsFor: 'repository updating' stamp: 'dkh 6/8/2012 14:04:22'!
updatePackageRepositoriesFor: versionString

	| versionSpec |
	(versionSpec := (self version: versionString) versionSpec) packageSpecsInLoadOrder do: [:pkgSpec |
		pkgSpec updatePackageRepositoriesFor: versionSpec ].
	^true! !

!MetacelloMCProject methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
pragmaKeywords

	^super pragmaKeywords, #(projectPackage:attribute: packages:attribute: repositories:attribute: )! !

!MetacelloMCProject methodsFor: 'spec classes' stamp: 'dkh 6/8/2012 14:04:22'!
projectSpecClass

	^MetacelloMCProjectSpec! !

!MetacelloMCProject methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
updateProject: aLoaderPolicy
	"load the latest version of the configuration package"

	"WARNING: don't forget to refresh your project instance after doing an #updateProject, 
	 otherwise your instance won't reflect the info in the freshly loaded configuration"

	| mcLoader |
	(mcLoader := self loader) == nil
		ifTrue: [ mcLoader := self project loaderClass on: nil ].
	mcLoader loaderPolicy: aLoaderPolicy.
	mcLoader
		doingLoads: [ 
			MCWorkingCopy
				managersForClass: self configuration class
				do: [ :mgr | 
					| pkg ar |
					pkg := self packageSpec.
					mgr repositoryGroup repositories do: [ :repo | pkg repositories repository: (repo asRepositorySpecFor: self) ].
					ar := mgr metacelloPackageNameWithBranch.
					pkg name: (ar at: 1).
					(ar at: 2) notEmpty
						ifTrue: [ pkg file: (ar at: 2) ].
					pkg load.
					^ true ] ].
	^ true! !

!MetacelloMCProject methodsFor: 'spec classes' stamp: 'dkh 6/8/2012 14:04:22'!
configurationOfProjectSpecClass
    ^ MetacelloMCConfigurationOfProjectSpec! !

!MetacelloMCProject methodsFor: 'spec classes' stamp: 'dkh 6/8/2012 14:04:22'!
repositorySpecClass

	^MetacelloRepositorySpec! !

!MetacelloMCProject methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
fetchProject
	"fetch the latest version of the configuration package"
	
	^self fetchProject: MetacelloLoaderPolicy new! !

!MetacelloMCProject methodsFor: 'as yet unclassified' stamp: 'dkh 7/2/2012 16:41'!
setBaselineRepositoryDescription: aListOrRepositoryDescriptions
    "noop "

! !

!MetacelloMCProject methodsFor: 'spec classes' stamp: 'dkh 6/8/2012 14:04:22'!
packageSpec

	^self packageSpecClass for: self! !

!MetacelloMCProject methodsFor: 'spec classes' stamp: 'dkh 6/8/2012 14:04:22'!
repositoriesSpec

	^self repositoriesSpecClass for: self! !

!MetacelloMCProject methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
saveProject

	| pkgSpec |
	(pkgSpec := self projectPackage) == nil ifTrue: [ ^false ].
	^pkgSpec savePackage! !

!MetacelloMCProject methodsFor: 'spec classes' stamp: 'dkh 6/8/2012 14:04:22'!
versionSpecClass

	^MetacelloMCVersionSpec! !

!MetacelloMCProject methodsFor: 'scripting' stamp: 'dkh 6/8/2012 14:04:22'!
asBaselineProject
    ^ MetacelloMCBaselineProject new! !

!MetacelloMCProject methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
projectPackage

	MCWorkingCopy
		managersForClass: self configuration class
		do: [:mgr | | pkgSpec repo |
			pkgSpec := 
				self packageSpec
					name: mgr packageName;
					yourself.
			mgr ancestors notEmpty
				ifTrue: [ pkgSpec file: mgr ancestors first name ].
			repo := mgr repositoryGroup repositories 
				detect: [:each | each ~~ MCCacheRepository default ] 
				ifNone: [ 
					Transcript cr; show: 'Using cache repository for ', self label, ' project package'.
					MCCacheRepository default ].
			pkgSpec repository: (repo asRepositorySpecFor: self).
			^pkgSpec].
	^nil! !

!MetacelloMCProject methodsFor: 'spec classes' stamp: 'dkh 6/8/2012 14:04:22'!
baselineOfProjectSpecClass
    ^ MetacelloMCBaselineOfProjectSpec! !

!MetacelloMCProject methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
goferCommitProject: commitMessage

	| pkgSpec |
	(pkgSpec := self projectPackage) == nil ifTrue: [ ^false ].
	^pkgSpec goferCommitPackage: commitMessage! !

!MetacelloMCProject methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
updateProject
	"load the latest version of the configuration package"

	"WARNING: don't forget to refresh your project instance after doing an #updateProject, 
	 otherwise your instance won't reflect the info in the freshly loaded configuration"
	
	^self updateProject: MetacelloLoaderPolicy new! !

!MetacelloMCProject methodsFor: 'scripting' stamp: 'dkh 6/8/2012 14:04:22'!
asConfigurationProject
    ^ self! !

!MetacelloMCProject methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
goferBranch: branchName project: commitMessage
    | pkgSpec |
    pkgSpec := self projectPackage.
    pkgSpec file: pkgSpec name , '.' , branchName.
    ^ pkgSpec goferBranchPackage: branchName message: commitMessage! !

!MetacelloMCProject methodsFor: 'spec classes' stamp: 'dkh 6/8/2012 14:04:22'!
repositorySpec

	^self repositorySpecClass for: self! !

!MetacelloMCProjectReferenceSpecTestCase methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
projectClass
    ^ MetacelloMCProject! !

!MetacelloMCProjectSpec methodsFor: 'loading' stamp: 'dkh 07/29/2013 07:16'!
ensureLoadedForDevelopmentUsing: mcLoader
  "for #development projects, always need latest version of package when contemplating a load"

  | ensured |
  ensured := mcLoader ensuredMap at: self name ifAbsent: [ nil ].
  self projectClass ~~ nil
    ifTrue: [ 
      | vrsn |
      vrsn := self versionOrNil.
      vrsn ~~ nil
        ifTrue: [ 
          (self ensureConfigurationLoaded: vrsn ensured: ensured)
            ifTrue: [ 
              mcLoader ensureForDevelopment
                ifTrue: [ 
                  | pc |
                  (pc := self projectClass) ~~ nil
                    ifTrue: [ 
                      MetacelloClearStackCacheNotification
                        signal:
                          #(#'currentVersion' #'currentVersionAgainst:' #'currentVersionInfo' #'versionConstructor' #'loadableSpecNames')
                            , {pc} ].
                  self ensureLoadUsing: mcLoader ]
                ifFalse: [ self projectPackage fetchUsing: mcLoader ].
              mcLoader ensuredMap at: self name put: #'latest' ].
          ^ self ] ].
  ensured == nil
    ifTrue: [ 
      "projectClass == nil or version == nil"
      mcLoader ensureForDevelopment
        ifTrue: [ 
          | pc |
          (pc := self projectClass) ~~ nil
            ifTrue: [ 
              MetacelloClearStackCacheNotification
                signal:
                  #(#'currentVersion' #'currentVersionAgainst:' #'currentVersionInfo' #'versionConstructor' #'loadableSpecNames')
                    , {pc} ].
          self ensureLoadUsing: mcLoader ]
        ifFalse: [ self fetchUsing: mcLoader ].
      mcLoader ensuredMap at: self name put: #'present' ]! !

!MetacelloMCProjectSpec methodsFor: 'querying' stamp: 'dkh 9/10/2012 16:05'!
file
    file ifNil: [ ^ self className ].
    ^ file! !

!MetacelloMCProjectSpec methodsFor: 'scripting' stamp: 'dkh 6/8/2012 14:04:22'!
asProjectRegistration
    (self className beginsWith: 'BaselineOf')
        ifTrue: [ ^ MetacelloProjectRegistration fromMCBaselineProjectSpec: self ].
    ^ MetacelloProjectRegistration fromMCConfigurationProjectSpec: self! !

!MetacelloMCProjectSpec methodsFor: 'scripting' stamp: 'dkh 6/8/2012 14:04:22'!
asConfigurationProjectSpec
    ^ self copyForScriptingInto: (MetacelloMCConfigurationOfProjectSpec for: self project asConfigurationProject)! !

!MetacelloMCProjectSpec methodsFor: 'scripting' stamp: 'dkh 6/8/2012 14:04:22'!
canDowngradeTo: aMetacelloProjectSpec
    ^ (super canDowngradeTo: aMetacelloProjectSpec) and: [ self file = aMetacelloProjectSpec file ]! !

!MetacelloMCProjectSpec methodsFor: 'scripting' stamp: 'dkh 6/15/2012 13:40'!
compareEqual: aMetacelloProjectSpec
    "'projectPackage repositories'"

    ^ (super compareEqual: aMetacelloProjectSpec) and: [ self file = aMetacelloProjectSpec file ]! !

!MetacelloMCProjectSpec methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
fetchUsing: aLoader
    (MetacelloLookupProjectSpec new
        projectSpec: self;
        yourself) signal projectPackage fetchUsing: aLoader! !

!MetacelloMCProjectSpec methodsFor: 'as yet unclassified' stamp: 'dkh 07/28/2013 09:45'!
hasConflictWithBaseline: aBaselineProjectSpec
  "baseline may not trump a configuration"

  ^ false! !

!MetacelloMCProjectSpec methodsFor: 'scripting' stamp: 'dkh 04/02/2013 20:23'!
hasNoLoadConflicts: aMetacelloProjectSpec
  "'projectPackage repositories'"

  ^ (super hasNoLoadConflicts: aMetacelloProjectSpec)
    and: [ self file = aMetacelloProjectSpec file ]! !

!MetacelloMCProjectSpec methodsFor: 'scripting' stamp: 'dkh 7/23/2012 11:56'!
validateVersionString: issues withDefaultVersionString: defaultVersionString
    self versionString
        ifNil: [ 
            defaultVersionString
                ifNotNil: [ self versionString: defaultVersionString ]
                ifNil: [ 
                    issues
                        add:
                            (MetacelloValidationError
                                configurationClass: self projectClass
                                reasonCode: #'incompleteProjectSpec'
                                callSite:
                                    #'validateForScriptLoad:withDefaultVersionString:withDefaultRepositoryDecription:'
                                explanation: 'version field required') ] ]! !

!MetacelloMCProjectSpec methodsFor: 'loading' stamp: 'dkh 07/16/2013 15:05'!
ensureConfigurationLoaded: vrsn ensured: ensured
  "answer true if the configuration should be reloaded"

  vrsn blessing == #'development'
    ifTrue: [ 
      ensured ~~ #'latest'
        ifTrue: [ ^ MetacelloScriptEnsureProjectLoadedForDevelopment signal ] ].
  ^ false! !

!MetacelloMCProjectSpec methodsFor: 'scripting' stamp: 'dkh 6/8/2012 14:04:22'!
metacelloRegistrationHash
    "file"

    ^ String stringHash: self file initialHash: super metacelloRegistrationHash! !

!MetacelloMCProjectSpec methodsFor: 'scripting' stamp: 'dkh 7/27/2012 04:59'!
versionForScriptEngine: aMetacelloScriptEngine
    | prj |
    prj := self projectClass ifNil: [ self project ] ifNotNil: [ self projectClassProject ].
    ^ ((prj projectForScriptEngine: aMetacelloScriptEngine) version: self versionString)
        silently: aMetacelloScriptEngine silently;
        ignoreImage: aMetacelloScriptEngine ignoreImage;
        cacheRepository: aMetacelloScriptEngine cacheRepository;
        repositoryOverrides: aMetacelloScriptEngine repositoryOverrides! !

!MetacelloMCProjectSpec methodsFor: 'mutability' stamp: 'dkh 7/19/2012 20:26'!
copyForRegistration: aMetacelloProjectRegistration onWrite: aBlock
    self subclassResponsibility! !

!MetacelloMCProjectSpec methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
updatePackageSpec: updatedSpecs
    "Add project copy to updatedSpecs if the current version of the project 
	 is different from the receiver's version"

    | prj currentVersion spec |
    className == nil
        ifTrue: [ ^ self ].
    prj := self projectClassProject.
    (currentVersion := prj currentVersion) = self versionOrNil
        ifTrue: [ ^ self ].
    currentVersion == nil
        ifTrue: [ ^ self ].
    spec := self copy.
    spec versionString: currentVersion versionString.
    updatedSpecs at: spec name put: spec! !

!MetacelloMCProjectSpec methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
projectClass
    self className == nil
        ifTrue: [ ^ nil ].
    ^ Smalltalk at: self className asSymbol ifAbsent: [  ]! !

!MetacelloMCProjectSpec methodsFor: 'scripting' stamp: 'dkh 6/8/2012 14:04:22'!
canUpgradeTo: aMetacelloProjectSpec
    ^ (super canUpgradeTo: aMetacelloProjectSpec) and: [ self file = aMetacelloProjectSpec file ]! !

!MetacelloMCProjectSpec methodsFor: 'testing' stamp: 'dkh 6/14/2012 15:53'!
allPackagesLoaded: aLoader
    "answer true if all of the packages (excluding projects) are loaded"

    | vrsn pkgs |
    (vrsn := self versionOrNil) == nil
        ifTrue: [ ^ false ].
    pkgs := OrderedCollection new.
    (self loadListForVersion: vrsn)
        do: [ :nm | 
            vrsn packages
                do: [ :pkg | 
                    (pkg isPackageLoaded: aLoader)
                        ifFalse: [ ^ false ] ] ].
    ^ true! !

!MetacelloMCProjectSpec methodsFor: 'scripting' stamp: 'dkh 6/8/2012 14:04:22'!
asBaselineProjectSpec
    ^ self copyForScriptingInto: (MetacelloMCBaselineOfProjectSpec for: self project asBaselineProject)! !

!MetacelloMCProjectSpec methodsFor: 'accessing' stamp: 'dkh 7/19/2012 16:03'!
file: aString
    self shouldBeMutable.
    file := aString.
    self projectPackage: nil! !

!MetacelloMCProjectSpec methodsFor: 'construction' stamp: 'dkh 6/8/2012 14:04:22'!
file: aString constructor: aVersionConstructor
    aVersionConstructor fileForProject: aString! !

!MetacelloMCProjectSpec methodsFor: 'testing' stamp: 'dkh 6/8/2012 14:04:22'!
isPossibleBaseline

	| vrsn |
	(vrsn := self versionOrNil) == nil ifTrue: [ ^false ].
	(vrsn allPackagesForSpecNamed: (self loadListForVersion: vrsn)) do: [:pkg |
		pkg workingCopy == nil ifTrue: [ ^false ]].
	^true! !

!MetacelloMCProjectSpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
packageFileSpecFor: aMetacelloPackagesSpec

	^(aMetacelloPackagesSpec project projectReferenceSpec)
			name: self name;
			projectReference: self copy;
			yourself.
! !

!MetacelloMCProjectSpec methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
updateForSpawnMethod: sourceSpec
	"This means that this spec was used in a baseline and will be used in a version .... drop all information that isn't useful"
	
	repositories := className := operator := loads := projectPackage := nil.
	sourceSpec ~~ nil ifTrue: [ versionString := sourceSpec versionString ].! !

!MetacelloMCProjectSpec methodsFor: 'testing' stamp: 'dkh 6/8/2012 14:04:22'!
isPartiallyLoaded: aLoader

	| vrsn |
	(vrsn := self versionOrNil) == nil ifTrue: [ ^false ].
	(self loadListForVersion: vrsn) do: [:nm |
		(vrsn packagesForSpecNamed: nm ) do: [:pkg |
			(pkg isPackageLoaded: aLoader) ifTrue: [ ^true ]]].
	^false! !

!MetacelloMCProjectSpec methodsFor: 'scripting' stamp: 'dkh 6/8/2012 14:04:22'!
asProjectSpec
    ^ self! !

!MetacelloMCProjectSpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
getFile
    "raw access to iv"

    ^ file! !

!MetacelloMCProjectSpec methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
relativeCurrentVersion
    "currentVersion calculated relative to the loadList"

    | vrsn expanded loadList |
    (vrsn := self versionOrNil) == nil
        ifTrue: [ ^ nil ].
    expanded := [ vrsn expandToLoadableSpecNames: (loadList := self loadListForVersion: vrsn) ]
        on: Error
        do: [ :ex | 
            vrsn blessing == #'development'
                ifTrue: [ 
                    self ensureLoadUsing: self loader.
                    vrsn := self versionOrNil.
                    ex return: (vrsn expandToLoadableSpecNames: loadList) ].
            ex pass ].
    ^ self projectClassProject currentVersionAgainst: expanded! !

!MetacelloMCProjectSpec methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
version
	"Empty version string means use latestVersion or #bleedingEdge"

	self projectClass == nil
		ifTrue: [ ^ nil ].
	^ self versionString == nil
		ifTrue: [ 
			| vrsn |
			"Eventually it will become an error to not specify a project reference version as default: #stable is the preferred default"
			"self deprecated: 'Must specify a project reference version.'."
			self flag: 'deprecate after version 1.0'.
			(vrsn := self projectClassProject latestVersion) == nil
				ifTrue: [ self projectClassProject version: #bleedingEdge ]
				ifFalse: [ vrsn ] ]
		ifFalse: [ self projectClassProject version: self versionString ]! !

!MetacelloMCProjectSpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
loadedPackageNames: aLoader

	| vrsn pkgs |
	(vrsn := self versionOrNil) == nil ifTrue: [ ^#() ].
	pkgs := OrderedCollection new.
	(self loadListForVersion: vrsn) do: [:nm |
		(vrsn packagesForSpecNamed: nm ) do: [:pkg |
			(pkg isPackageLoaded: aLoader) ifTrue: [ pkgs add: pkg name ]]].
	^pkgs! !

!MetacelloMCProjectSpec methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
loadVersion: aVersionOrNil
    "Load the correct version of the project"

    | vrsn mcLoader list |
    self ensureProjectLoaded.
    vrsn := aVersionOrNil.
    vrsn == nil
        ifTrue: [ 
            [ vrsn := self version ]
                on: MetacelloVersionDoesNotExistError
                do: [ :ex | 
                    ^ (MetacelloProjectSpecLoadError projectSpec: self)
                        versionDoesNotExistException: ex;
                        signal:
                                'No version found for ' , self versionString printString , ' of ' , self className asString , ' because: '
                                        , ex description ] ].
    mcLoader := self loader copy.
    mcLoader operator: self operator.
    vrsn loader: mcLoader.
    list := (mcLoader ignoreImage
        ifTrue: [ self loadListForVersion: vrsn ]
        ifFalse: [ vrsn packageAndProjectNamesToLoad: (self loadListForVersion: vrsn) loader: mcLoader ]) asSet.
    MetacelloPlatform current
        useStackCacheDuring: [ :dict | 
            | projectCache cachedList |
            projectCache := dict at: self projectClass ifAbsent: [ dict at: self projectClass put: Dictionary new ].
            (cachedList := projectCache at: vrsn ifAbsent: [  ]) == nil
                ifTrue: [ projectCache at: vrsn put: list ]
                ifFalse: [ 
                    (cachedList size = list size and: [ cachedList includesAllOf: list ])
                        ifTrue: [ 
                            "no need to refetch list ... recursion stoppper (Issue 95)"
                            ^ self ]
                        ifFalse: [ projectCache at: vrsn put: list ] ].
            vrsn versionString ~= self versionString
                ifTrue: [ Transcript show: ' [' , vrsn versionString , ']' ].
            mcLoader preLoad: self.
            vrsn fetchRequiredFromArray: list.	"do the load"
            (MetacelloProjectSpecLoadedNotification new projectSpec: (self copy versionString: vrsn versionString))
                signal.
            mcLoader postLoad: self ]
        defaultDictionary: Dictionary new! !

!MetacelloMCProjectSpec methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
resolveToAllPackagesIn: aVersionSpec visited: visited
    | vrsn |
    visited
        pushProject: [ 
            visited
                visit: self
                doing: [ :spec | 
                    spec ensureProjectLoaded.
                    vrsn := spec version.
                    ^ vrsn
                        allPackagesForSpecNamed: (self loadListForVersion: vrsn)
                        ifAbsent: [ self error: 'invalid loads: spec' ] ] ].
    ^ #()! !

!MetacelloMCProjectSpec methodsFor: 'testing' stamp: 'dkh 6/8/2012 14:04:22'!
compareRelativeCurrentVersion: anOperator targetVersionStatus: targetVersionStatus using: anMCLoader

	| cv vrsn |
	(vrsn := self versionOrNil) == nil ifTrue: [ ^false ].
	(cv := self relativeCurrentVersion) == nil ifTrue: [ ^false ].
	(targetVersionStatus includes: cv versionStatus)
		ifTrue: [ ^cv perform: anOperator with: vrsn ].
	^false
	
! !

!MetacelloMCProjectSpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
projectPackage
    projectPackage
        ifNil: [ 
            self className ifNil: [ ^ nil ].
            projectPackage := self project packageSpec.
            projectPackage name: self className.
            self getFile ifNotNil: [ projectPackage file: self file ].
            projectPackage repositories: self getRepositories ].
    ^ projectPackage! !

!MetacelloMCProjectSpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
className: aString
    super className: aString.
    self projectPackage: nil! !

!MetacelloMCProjectSpec methodsFor: 'testing' stamp: 'dkh 6/13/2012 16:30'!
compareCurrentVersion: anOperator targetVersionStatus: targetVersionStatus using: anMCLoader
    ^ (MetacelloLookupProjectSpecForLoad new
        projectSpec: self;
        yourself) signal
        performCurrentVersionTestAgainst: self versionOrNil
        operator: anOperator
        targetVersionStatus: targetVersionStatus
        using: anMCLoader! !

!MetacelloMCProjectSpec methodsFor: 'loading' stamp: 'dkh 03/13/2013 15:18'!
ensureProjectLoaded
  "Ensure that the MetacelloProject is loaded in image. 
	 projectClass == nil or requested version non-existent warrants a project package load."

  "answer true if the projectClass exists"

  (self projectClass == nil
    or: [ 
      self versionOrNil == nil
        or: [ (loader notNil or: [ self isMutable ]) and: [ self loader ignoreImage ] ] ])
    ifTrue: [ 
      | pc |
      (pc := self projectClass) ~~ nil
        ifTrue: [ 
          MetacelloClearStackCacheNotification
            signal:
              #(#'currentVersion' #'currentVersionAgainst:' #'currentVersionInfo' #'versionConstructor' #'loadableSpecNames')
                , {pc} ].
      self projectPackage ifNil: [ ^ true ].
      self ensureLoadUsing: self loader ].
  ^ self projectClass ~~ nil! !

!MetacelloMCProjectSpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
loadPackageList

	| vrsn pkgs |
	(vrsn := self versionOrNil) == nil ifTrue: [ ^#() ].
	pkgs := OrderedCollection new.
	(self loadListForVersion: vrsn) do: [:nm |
		pkgs addAll: ((vrsn packagesForSpecNamed: nm ) collect: [:each | each name ])].
	^pkgs! !

!MetacelloMCProjectSpec methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
ensureLoadUsing: aLoader
    (MetacelloLookupProjectSpec new
        projectSpec: self;
        yourself)  signal projectPackage ensureLoadUsing: aLoader! !

!MetacelloMCProjectSpec methodsFor: 'scripting' stamp: 'dkh 6/8/2012 14:04:22'!
copyForScriptingInto: aProjectSpec
    ^aProjectSpec
        setName: name;
        className: className;
        versionString: versionString;
        operator: operator;
        setLoads: loads;
        preLoadDoIt: preLoadDoIt;
        postLoadDoIt: postLoadDoIt;
        repositories: repositories copy;
        file: file! !

!MetacelloMCProjectSpec methodsFor: 'scripting' stamp: 'dkh 7/23/2012 11:17'!
validateForScriptLoad: aScriptEngine withDefaultVersionString: defaultVersionString withDefaultRepositoryDecription: defaultRepositoryDecription
    | issues callSite |
    issues := OrderedCollection new.
    callSite := #'validateForScriptLoad:withDefaultVersionString:withDefaultRepositoryDecription:'.
    self name
        ifNil: [ 
            issues
                add:
                    (MetacelloValidationError
                        configurationClass: self projectClass
                        reasonCode: #'incompleteProjectSpec'
                        callSite: callSite
                        explanation: 'name field required') ].
    self className
        ifNil: [ 
            issues
                add:
                    (MetacelloValidationError
                        configurationClass: self projectClass
                        reasonCode: #'incompleteProjectSpec'
                        callSite: callSite
                        explanation: 'className field required') ].
    self repositories isEmpty
        ifTrue: [ 
            defaultRepositoryDecription
                ifNotNil: [ self repository: defaultRepositoryDecription ]
                ifNil: [ 
                    issues
                        add:
                            (MetacelloValidationError
                                configurationClass: self projectClass
                                reasonCode: #'incompleteProjectSpec'
                                callSite: callSite
                                explanation: 'repository field required') ] ].
    self validateVersionString: issues withDefaultVersionString: defaultVersionString.
    ^ issues! !

!MetacelloMCProjectSpec methodsFor: 'querying' stamp: 'dkh 7/2/2012 16:40'!
projectClassProject
    "indirection needed when projectClass is _not_ a subclass of MetacelloProject"

    ^ self projectClass new project
        setBaselineRepositoryDescription: self repositoryDescriptions;
        yourself! !

!MetacelloMCProjectSpec methodsFor: 'loading' stamp: 'dkh 7/7/2012 07:16'!
determineCurrentVersionForLoad
    "don't use self currentVersion, because we are interested in the currentVersion of the project as loaded in image, not the current version relative to our load list"

    | prjct version currentVersion packageAndProjectNames cvs |
    self projectClass == nil
        ifTrue: [ ^ nil ].
    (version := self versionOrNil) == nil
        ifTrue: [ ^ nil ].
    version blessing == #'baseline'
        ifTrue: [ ^ version ].
    self loader ignoreImage
        ifTrue: [ ^ version ].
    prjct := self projectClass new project.
    prjct loader: self loader.
    (currentVersion := prjct currentVersion) == nil
        ifTrue: [ ^ nil ].
    (cvs := currentVersion versionStatus) == #'somethingLoaded'
        ifTrue: [ ^ nil ].
    (#(#'allLoadedToSpec' #'loadedToSpec' #'loadedMatchConstraints') includes: (cvs := currentVersion versionStatus))
        ifTrue: [ 
            (currentVersion perform: self operator with: version)
                ifTrue: [ 
                    "load currentVersion"
                    ^ currentVersion ].	"load version"
            ^ nil ].
    version = currentVersion
        ifTrue: [ ^ currentVersion ].	"I don't believe that it is possible to reach this point in the method, so I will be interested if I run across a case that produces this error"
    (MetacelloProjectSpecLoadConflict projectSpec: self)
        signal:
            'Project load conflict for' , prjct label printString , ' between current version ' , currentVersion printString , '('
                , cvs asString , ') and specified version ' , version printString
                , '. Press resume to continue with load anyway'.
    ^ nil! !

!MetacelloMCProjectSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testMCProjectSpec
    | project repository |
    project := self projectSpec.
    project
        name: 'Project';
        projectPackage: self project packageSpec;
        className: 'ConfigurationOfProject';
        repository: 'http://example.com/repository' username: 'dkh' password: 'password';
        repository: '/opt/gemstone/repository';
        yourself.
    self assert: project name = 'Project'.
    self assert: project className = 'ConfigurationOfProject'.
    self assert: project projectPackage name = project className.
    self assert: project projectPackage file = project className.
    repository := project repositories map at: '/opt/gemstone/repository' ifAbsent: [ self assert: false ].
    self assert: repository type = 'directory'.
    repository := project repositories map at: 'http://example.com/repository' ifAbsent: [ self assert: false ].
    self assert: repository type = 'http'.
    self assert: repository username = 'dkh'.
    self assert: repository password = 'password'! !

!MetacelloMCProjectSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testMCProjectMergeSpec
    | projectA projectB project packageA packageB repository |
    projectA := self projectSpec
        name: 'Project';
        projectPackage: self project packageSpec;
        className: 'ConfigurationOfProject';
        repository: 'http://example.com/repository' username: 'dkh' password: 'password';
        repository: '/opt/gemstone/repository';
        yourself.
    projectB := self projectSpec
        name: 'Project';
        projectPackage: self project packageSpec;
        className: 'ConfigurationOfProjectB';
        repository: 'http://example.com/repository' username: 'DaleHenrichs' password: 'secret';
        repository: '/opt/gemstone/repo';
        yourself.
    project := projectA mergeSpec: projectB.
    self assert: project name = 'Project'.
    self assert: project className = 'ConfigurationOfProjectB'.
    self assert: project projectPackage name = project className.
    self assert: project projectPackage file = project className.
    repository := project repositories map at: '/opt/gemstone/repository' ifAbsent: [ self assert: false ].
    self assert: repository type = 'directory'.
    repository := project repositories map at: '/opt/gemstone/repo' ifAbsent: [ self assert: false ].
    self assert: repository type = 'directory'.
    repository := project repositories map at: 'http://example.com/repository' ifAbsent: [ self assert: false ].
    self assert: repository type = 'http'.
    self assert: repository username = 'DaleHenrichs'.
    self assert: repository password = 'secret'! !

!MetacelloMCProjectSpecTestCase methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
projectClass
    ^ MetacelloMCProject! !

!MetacelloMCTestsAbstractConfig methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
project

	| constructor |
	^project ifNil: [
		"Construct Metacello project"
		constructor := MetacelloVersionConstructor on: self.
		project := constructor project.
		project loader: MetacelloNullRecordingMCSpecLoader new.
		project].
! !

!MetacelloMCValueHolderSpecTestCase methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
projectClass
    ^ MetacelloMCProject! !

!MetacelloMCVersion methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
silently: aBool 
	"by default silently is false"
	
	self loaderPolicy silently: aBool! !

!MetacelloMCVersion methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
currentlyLoadedClassesInVersion

	^self spec currentlyLoadedClassesInVersion! !

!MetacelloMCVersion methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
loader: aLoader

	self versionSpec loader: aLoader! !

!MetacelloMCVersion methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
currentlyLoadedExtensionClassesInVersion

	^self spec currentlyLoadedExtensionClassesInVersion! !

!MetacelloMCVersion methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
fetchRequiredFromArray: anArray
	| originalLoader displayString newLoader |
	originalLoader := self versionSpec loader.
	newLoader := originalLoader fetchingSpecLoader.
	displayString := newLoader actionLabel , self versionNumber printString , ' of ' , self spec projectLabel.
	MetacelloPlatform current
		do: [ 
			[ 
			self versionSpec loader: newLoader.
			MetacelloPlatform current
				useStackCacheDuring: [ :dict | ^ self executeLoadFromArray: anArray ]
				defaultDictionary: Dictionary new ] ensure: [ self versionSpec loader: originalLoader ] ]
		displaying: displayString! !

!MetacelloMCVersion methodsFor: 'querying' stamp: 'dkh 9/11/2012 10:16'!
packages
	"Answers the list of packages associated with this version"

	| packages |
	packages := OrderedCollection new.
	self spec projectDo: [:ignored | ] packageDo: [:pkg | packages add: pkg ] groupDo: [:ignored | ].
	^packages
! !

!MetacelloMCVersion methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
record: required

	^required recordRequiredForMetacelloMCVersion: self
! !

!MetacelloMCVersion methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
packagesForSpecNamed: aString ifAbsent: aBlock
	"resolves list of packages associated with the named spec.
	   If the spec is a packages, answer a list including only the package. #requires: and #includes:
			fields in the package are ignored.
	   If the spec is a project, answers an empty list.
	   If the spec is a group, answers the list of packages in the #includes: field of the group. 
			Groups in the #includes: field are expanded following the transitive closure on groups"
	"If there is no spec named <aString>, aBlock is evaluated"

	| pkgSpec |
	pkgSpec := self spec packageNamed: aString ifAbsent: aBlock.
	^pkgSpec resolveToPackagesIn: self spec visited: MetacelloVisitedPackages new! !

!MetacelloMCVersion methodsFor: 'querying' stamp: 'dkh 9/11/2012 11:53'!
packageAndProjectNamesToLoad: defaultList loader: aLoader
	"Answer the list of packages and projects to be loaded: packages already loaded plust defaultList"
	
	| loadedPackageNames projectMap loadedProjectNames list |
	loadedPackageNames := ((self packages select: [:pkg | pkg isPackageLoaded: aLoader ]) 
		collect: [:pkg | pkg name ]) asSet, 
			defaultList.
	projectMap := Dictionary new.
	self  projects do: [:prj | 
		prj className ~~ nil
			ifTrue: [ | coll loaded |
				coll := projectMap at: prj className ifAbsent: [
					coll := OrderedCollection new.
					projectMap at: prj className put: coll.
					coll].
				(loaded := prj loadedPackageNames: aLoader) isEmpty 
					ifFalse: [  coll add: prj -> (loaded -> prj loadPackageList) ]]].
	loadedProjectNames := Set new.
	projectMap keysAndValuesDo: [:prjClass :coll |
		coll size <= 1
			ifTrue: [ coll do: [:assoc | loadedProjectNames add: assoc key name ]]
			ifFalse: [ 
				"multiple project references against the same configuration ... only count project as loaded
				 if there is an exact match for loaded projects...
				 See http://code.google.com/p/metacello/issues/detail?id=86"
				coll do: [:assoc | | loaded packageList |
					loaded := assoc value key. "loaded packages from project"
					packageList := assoc value value. "loadlist for project"
					(packageList difference: loaded) isEmpty
						ifTrue: [ loadedProjectNames add: assoc key name ]]]].
	list := loadedPackageNames, loadedProjectNames.
	list isEmpty ifTrue: [ ^self spec defaultPackageNames].
	^list! !

!MetacelloMCVersion methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
load

	^self doLoadRequiredFromArray: self spec defaultPackageNames! !

!MetacelloMCVersion methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
loaderPolicy: anObject
	loaderPolicy := anObject! !

!MetacelloMCVersion methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
allPackagesForSpecNamed: aStringOrArray ifAbsent: aBlock
	"resolves list of packages associated with the named spec.
	   If the spec is a packages, answer a list including the package and the transitive closure on 
			its #requires: and #includes: fields.
	   If the spec is a project, answer a list of the packages associated with the project,
			following the transitive closure on packages reachable starting with the #loads: field.
	   If the spec is a group, answers the list of packages in the #includes: field of the group. 
			Groups in the #includes: field are expanded following the transitive closure on groups"
	"In essence, this query answers the list of all packages that would be loaded if the package 
		named <aString> were loaded."
	"If there is no spec named <aString>, aBlock is evaluated"

	^aStringOrArray 
		resolvePackageSpecsNamedForMetacelloMCVersion: self 
		visited: MetacelloVisitedPackages new 
		ifAbsent: aBlock 
! !

!MetacelloMCVersion methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
fetch

	^self doFetchRequiredFromArray: self spec defaultPackageNames! !

!MetacelloMCVersion methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
loadRequiredFromArray: anArray

	| displayString |
	displayString := 'Loading ', self versionNumber printString, ' of ', self spec projectLabel.
	MetacelloPlatform current
		do: [ ^self executeLoadFromArray: anArray ]
		displaying: displayString! !

!MetacelloMCVersion methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
cacheRepository: repository 
	"by default cacheRepository is an MCDictionaryRepository"
	
	self loaderPolicy cacheRepository: repository! !

!MetacelloMCVersion methodsFor: 'querying' stamp: 'dkh 9/11/2012 11:53'!
defaultPackageNamesToLoad: defaultList
	"Answer the list of packages and projects to be loaded: packages already loaded plust defaultList"
	
	^ self packageAndProjectNamesToLoad: defaultList loader: self loader! !

!MetacelloMCVersion methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
doFetchRequiredFromArray: anArray

	| oldPolicy oldBypassProgress displayString |
	displayString := self versionNumber printString, ' of ', self spec projectLabel.
	Transcript cr; show: 'Fetching ', displayString, '...'.
	oldPolicy := loaderPolicy. 
	oldBypassProgress := MetacelloPlatform current bypassProgressBars.
	self loaderPolicy silently ifTrue: [ MetacelloPlatform current bypassProgressBars: true ].
	[ 	| ans |
		ans := self fetchRequiredFromArray: anArray.
		Transcript cr; show: '...finished ', self versionNumber printString.
		^ans ]
			ensure: [ 
				MetacelloPlatform current bypassProgressBars: oldBypassProgress.
				loaderPolicy := oldPolicy ]
	! !

!MetacelloMCVersion methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
doRecordRequiredFromArray: anArray

	| originalLoader oldPolicy displayString oldBypassProgress |
	displayString := self versionNumber printString, ' of ', self spec projectLabel.
	Transcript cr; show: 'Recording ', displayString, '...'.
	originalLoader := self versionSpec loader.
	oldPolicy := loaderPolicy. 
	oldBypassProgress := MetacelloPlatform current bypassProgressBars.
	self loaderPolicy silently ifTrue: [ MetacelloPlatform current bypassProgressBars: true ].
	[	MetacelloPlatform current
			do:  [ | ans |
				self versionSpec loader: originalLoader recordingSpecLoader.
				ans := (self executeLoadFromArray: anArray) copy.
				Transcript cr; show: '...finished ', self versionNumber printString.
				^ans ]
			displaying: 'Recording ', displayString ]
				ensure: [
					MetacelloPlatform current bypassProgressBars: oldBypassProgress.
					self versionSpec loader: originalLoader.
					loaderPolicy := oldPolicy ]! !

!MetacelloMCVersion methodsFor: 'private' stamp: 'dkh 9/10/2012 15:43'!
computeVersionStatus
	"
		#allLoadedToSpec - all projects and packages are loaded and match specification
		#loadedToSpec - all loaded projects and packages match specifications (at least one package loaded)
		#loadedMatchConstraints - all loaded projects and packages match constraints (at least one package loaded)
		#somethingLoaded - at least one package loaded
	"

	self spec computeVersionStatus: [ :status | ^ status ].
	^ #noStatus! !

!MetacelloMCVersion methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
doLoadRequiredFromArray: anArray

	| displayString oldPolicy oldBypassProgress |
	displayString := self versionNumber printString, ' of ', self spec projectLabel.
	Transcript cr; show: 'Loading ', displayString, '...'.
	oldPolicy := loaderPolicy. 
	oldBypassProgress := MetacelloPlatform current bypassProgressBars.
	self loaderPolicy silently ifTrue: [ MetacelloPlatform current bypassProgressBars: true ].
	[	| fetchLoader |
		fetchLoader := self fetchRequiredFromArray: (self defaultPackageNamesToLoad: anArray).
		MetacelloPlatform current
			do:  [  fetchLoader doLoad ]
			displaying: 'Loading ', displayString.
		Transcript cr; show: '...finished ', self versionNumber printString.
		^fetchLoader ]
		ensure: [ 
			MetacelloPlatform current bypassProgressBars: oldBypassProgress.
			loaderPolicy := oldPolicy ]
! !

!MetacelloMCVersion methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
repositoryOverrides: repositoriesCollection 

	self loaderPolicy overrideRepositories: repositoriesCollection! !

!MetacelloMCVersion methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
loaderPolicy

	loaderPolicy == nil ifTrue: [ loaderPolicy := MetacelloLoaderPolicy new ].
	^ loaderPolicy! !

!MetacelloMCVersion methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
allPackagesForSpecs: pkgSpecs visited: visited

 
	| coll |
	coll := Dictionary new.
	pkgSpecs
		do: [:pkgSpec | (pkgSpec resolveToAllPackagesIn: self spec visited: visited)
				do: [:pkg | coll at: pkg name put: pkg ]].
	^ coll values asOrderedCollection
! !

!MetacelloMCVersion methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
fetch: required

	^required fetchRequiredForMetacelloMCVersion: self
! !

!MetacelloMCVersion methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
load: required

	^required loadRequiredForMetacelloMCVersion: self
! !

!MetacelloMCVersion methodsFor: 'querying' stamp: 'dkh 9/11/2012 11:53'!
defaultPackageNamesToLoad
	"Answer the list of packages and projects to be loaded --> packages already loaded"
	
	^ self defaultPackageNamesToLoad: self spec defaultPackageNames! !

!MetacelloMCVersion methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
ignoreImage: aBool 
	"by default ignoreImage is false"
	
	self loaderPolicy ignoreImage: aBool! !

!MetacelloMCVersion methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
record

	^self doRecordRequiredFromArray: self spec defaultPackageNames! !

!MetacelloMCVersion methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
executeLoadFromArray: anArray

	| loader mcLoader |
	loader := MetacelloMCVersionSpecLoader on: self spec.
	loader required: anArray.
	loaderPolicy notNil ifTrue: [ loader loaderPolicy: loaderPolicy ].
	^loader load! !

!MetacelloMCVersion methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
allPackagesForSpecNamed: aStringOrArray
	"resolves list of packages associated with the named spec.
	   If the spec is a packages, answer a list including the package and the transitive closure on 
			its #requires: and #includes: fields.
	   If the spec is a project, answer a list of the packages associated with the project,
			following the transitive closure on packages reachable starting with the #loads: field.
	   If the spec is a group, answers the list of packages in the #includes: field of the group. 
			Groups in the #includes: field are expanded following the transitive closure on groups"
	"In essence, this query answers the list of all packages that would be loaded if the package 
		named <aString> were loaded."
	"If there is no spec named <aString>, answers an empty list"

	^self allPackagesForSpecNamed: aStringOrArray ifAbsent: [ ^#() ]! !

!MetacelloMCVersion methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
packagesForSpecNamed: aString
	"resolves list of packages associated with the named spec.
	   If the spec is a packages, answer a list including only the package. #requires: and #includes:
			fields in the package are ignored.
	   If the spec is a project, answers an empty list.
	   If the spec is a group, answers the list of packages in the #includes: field of the group. 
			Groups in the #includes: field are expanded following the transitive closure on groups"
	"If there is no spec named <aString>, answers an empty list"

	^self packagesForSpecNamed: aString ifAbsent: [ ^#() ]! !

!MetacelloMCVersionSpec methodsFor: 'querying' stamp: 'dkh 9/11/2012 13:42'!
packageNames
    "leave reference to packages for upgrade purposes"

    packages == nil
        ifTrue: [ ^ super packageNames ].
    ^ self packages map keys asSet! !

!MetacelloMCVersionSpec methodsFor: 'testing' stamp: 'dkh 6/8/2012 14:04:22'!
isSomethingLoaded
	"at least one package loaded"
	
	self isPartiallyCurrent isSomethingLoaded: [ :ignored | ^ true ].
	^ false! !

!MetacelloMCVersionSpec methodsFor: 'testing' stamp: 'dkh 6/8/2012 14:04:22'!
isLoadedMatchConstraintsAgainst: resolvedPackageAndProjectNames
	"all loaded projects and packages match constraints (at least one package loaded)"

	(self isPartiallyCurrentAgainst: resolvedPackageAndProjectNames) isLoadedMatchConstraints: [ :ignored | ^ true ].
	^ false! !

!MetacelloMCVersionSpec methodsFor: 'querying' stamp: 'dkh 05/08/2013 09:32'!
currentlyLoadedClassesInVersion
  | classes |
  classes := Set new.
  self
    projectDo: [ :ignored |  ]
    packageDo: [ :packageSpec | 
      | wc |
      wc := [ packageSpec workingCopy ]
        on: Error
        do: [ :ex | ex return: nil ].
      wc ~~ nil
        ifTrue: [ classes addAll: (MetacelloPlatform current packageInfoFor: wc) classes ] ]
    groupDo: [ :ignored |  ].
  ^ classes! !

!MetacelloMCVersionSpec methodsFor: 'testing' stamp: 'dkh 6/8/2012 14:04:22'!
isAllLoadedToSpecAgainst: resolvedPackageAndProjectNames
	"all projects and packages are loaded and match specification"

	(self isPartiallyCurrentAgainst: resolvedPackageAndProjectNames) isAllLoadedToSpec: [ :ignored | ^ true ].
	^ false! !

!MetacelloMCVersionSpec methodsFor: 'enumerating' stamp: 'dkh 6/8/2012 14:04:22'!
specListProjectDo: projectBlock packageDo: packageBlock groupDo: groupBlock

	self packages specListDo: [:pkgSpec |
		pkgSpec projectDo: projectBlock packageDo: packageBlock groupDo: groupBlock ]! !

!MetacelloMCVersionSpec methodsFor: 'construction' stamp: 'dkh 6/8/2012 14:04:22'!
package: packageName with: aBlockOrString constructor: aVersionConstructor
    aVersionConstructor packageForVersion: packageName with: aBlockOrString! !

!MetacelloMCVersionSpec methodsFor: 'testing' stamp: 'dkh 6/8/2012 14:04:22'!
isAllLoadedToSpec
	"all projects and packages are loaded and match specification"

	self isPartiallyCurrent isAllLoadedToSpec: [ :ignored | ^ true ].
	^ false! !

!MetacelloMCVersionSpec methodsFor: 'merging' stamp: 'dkh 9/11/2012 12:12'!
mergeSpec: anotherSpec
    | newSpec map anotherRepositories |
    newSpec := super mergeSpec: anotherSpec.
    map := anotherSpec mergeMap.
    (anotherRepositories := map at: #'repositories') isEmpty not
        ifTrue: [ 
            newSpec
                repositories:
                    (self repositories isEmpty
                        ifTrue: [ anotherRepositories ]
                        ifFalse: [ self repositories mergeSpec: anotherRepositories ]) ].
    ^ newSpec! !

!MetacelloMCVersionSpec methodsFor: 'testing' stamp: 'dkh 6/8/2012 14:04:22'!
isLoadedToSpecAgainst: resolvedPackageAndProjectNames
	"all loaded projects and packages match specifications (at least one package loaded)"

	(self isPartiallyCurrentAgainst: resolvedPackageAndProjectNames) isLoadedToSpec: [ :ignored | ^ true ].
	^ false! !

!MetacelloMCVersionSpec methodsFor: 'querying' stamp: 'dkh 05/08/2013 09:32'!
currentlyLoadedExtensionClassesInVersion
  | classes |
  classes := Dictionary new.
  self
    projectDo: [ :ignored |  ]
    packageDo: [ :packageSpec | 
      | wc |
      wc := [ packageSpec workingCopy ]
        on: Error
        do: [ :ex | ex return: nil ].
      wc ~~ nil
        ifTrue: [ 
          | packageInfo |
          packageInfo := MetacelloPlatform current packageInfoFor: wc.
          packageInfo extensionClasses
            do: [ :cl | classes at: cl put: (packageInfo extensionCategoriesForClass: cl) ] ] ]
    groupDo: [ :ignored |  ].
  ^ classes! !

!MetacelloMCVersionSpec methodsFor: 'accessing' stamp: 'dkh 9/11/2012 13:41'!
packages
    "leave reference to packages for upgrade purposes"

    packages == nil
        ifTrue: [ ^ super packages ].
    ^ packages! !

!MetacelloMCVersionSpec methodsFor: 'printing' stamp: 'dkh 9/10/2012 15:57'!
configMethodOn: aStream last: last indent: indent
    | spec hasRepositories hasPackageSpecs hasImport |
    hasRepositories := (spec := self repositoriesSpec) ~~ nil and: [ spec list isEmpty not ].
    hasImport := self import ~~ nil.
    hasPackageSpecs := false.
    self packagesSpec list
        do: [ :member | 
            member spec
                projectDo: [ :proj | 
                    member spec name ~~ nil
                        ifTrue: [ hasPackageSpecs := true ] ]
                packageDo: [ :package | 
                    member spec name ~~ nil
                        ifTrue: [ hasPackageSpecs := true ] ]
                groupDo: [ :group | 
                    member spec name ~~ nil
                        ifTrue: [ hasPackageSpecs := true ] ] ].
    self configMethodBasicOn: aStream last: (hasRepositories | hasPackageSpecs | hasImport) not indent: indent.
    hasImport
        ifTrue: [ 
            self
                configMethodValueOn: aStream
                for: self import
                selector: 'import:'
                last: (hasRepositories | hasPackageSpecs) not
                indent: indent ].
    hasRepositories
        ifTrue: [ 
            spec map values size = 1
                ifTrue: [ 
                    aStream
                        tab: indent;
                        nextPutAll: 'spec repository: ';
                        nextPutAll: spec map values first description printString , '.'.
                    hasPackageSpecs
                        ifTrue: [ aStream cr ] ]
                ifFalse: [ 
                    self
                        configMethodOn: aStream
                        for: spec
                        selector: 'repositories:'
                        last: hasPackageSpecs not
                        indent: indent ] ].
    self configPackagesSpecMethodOn: aStream indent: indent.
    last
        ifFalse: [ aStream cr ]! !

!MetacelloMCVersionSpec methodsFor: 'testing' stamp: 'dkh 6/8/2012 14:04:22'!
isPartiallyCurrent

	^self isPartiallyCurrentAgainst: (self expandToLoadableSpecNames: #('ALL'))! !

!MetacelloMCVersionSpec methodsFor: 'testing' stamp: 'dkh 6/8/2012 14:04:22'!
isSomethingLoadedAgainst: resolvedPackageAndProjectNames
	"at least one package loaded"

	(self isPartiallyCurrentAgainst: resolvedPackageAndProjectNames) isSomethingLoaded: [ :ignored | ^ true ].
	^ false
! !

!MetacelloMCVersionSpec methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
versionClass

	^MetacelloMCVersion! !

!MetacelloMCVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
repositories
	repositories == nil ifTrue: [ repositories := self project repositoriesSpec ].
	^ repositories! !

!MetacelloMCVersionSpec methodsFor: 'merging' stamp: 'dkh 9/11/2012 12:11'!
mergeMap
    | map |
    map := super mergeMap.
    map at: #'repositories' put: self repositories.
    ^ map! !

!MetacelloMCVersionSpec methodsFor: 'construction' stamp: 'dkh 6/8/2012 14:04:22'!
removePackage: aString constructor: aVersionConstructor
    aVersionConstructor removePackageForVersion: aString! !

!MetacelloMCVersionSpec methodsFor: 'printing' stamp: 'dkh 6/8/2012 14:04:22'!
configSpawnMethodOn: aStream indent: indent

	super configSpawnMethodOn: aStream indent: indent.
	self configPackagesSpecMethodOn: aStream indent: indent.! !

!MetacelloMCVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
repository: aString username: username password: password
	self repositoriesSpec repository: aString username: username password: password! !

!MetacelloMCVersionSpec methodsFor: 'querying' stamp: 'dkh 9/11/2012 11:57'!
difference: otherVersionSpec
    "Return a dictionary of additions, removals and modifications"

    | report myProjectSpecs myPackageSpecs otherProjectSpecs otherPackageSpecs |
    report := MetacelloVersionDiffReport new.
    myProjectSpecs := Dictionary new.
    myPackageSpecs := Dictionary new.
    self
        projectDo: [ :projectSpec | myProjectSpecs at: projectSpec name put: projectSpec ]
        packageDo: [ :packageSpec | myPackageSpecs at: packageSpec name put: packageSpec ]
        groupDo: [ :ignored |  ].
    otherProjectSpecs := Dictionary new.
    otherPackageSpecs := Dictionary new.
    otherVersionSpec
        projectDo: [ :projectSpec | otherProjectSpecs at: projectSpec name put: projectSpec ]
        packageDo: [ :packageSpec | otherPackageSpecs at: packageSpec name put: packageSpec ]
        groupDo: [ :ignored |  ].
    myProjectSpecs
        valuesDo: [ :myProjectSpec | 
            | otherProjectSpec |
            otherProjectSpec := otherProjectSpecs at: myProjectSpec name ifAbsent: [  ].
            otherProjectSpec == nil
                ifTrue: [ 
                    report removals
                        at: myProjectSpec name
                        put:
                            {(myProjectSpec versionString).
                            ''} ]
                ifFalse: [ 
                    myProjectSpec versionString = otherProjectSpec versionString
                        ifFalse: [ 
                            report modifications
                                at: myProjectSpec name
                                put:
                                    {(myProjectSpec versionString).
                                    (otherProjectSpec versionString)} ] ] ].
    otherProjectSpecs
        valuesDo: [ :otherProjectSpec | 
            (myProjectSpecs at: otherProjectSpec name ifAbsent: [  ]) == nil
                ifTrue: [ 
                    report additions
                        at: otherProjectSpec name
                        put:
                            {''.
                            (otherProjectSpec versionString)} ] ].
    myPackageSpecs
        valuesDo: [ :myPackageSpec | 
            | otherPackageSpec |
            otherPackageSpec := otherPackageSpecs at: myPackageSpec name ifAbsent: [  ].
            otherPackageSpec == nil
                ifTrue: [ 
                    report removals
                        at: myPackageSpec name
                        put:
                            {(myPackageSpec file).
                            ''} ]
                ifFalse: [ 
                    myPackageSpec file = otherPackageSpec file
                        ifFalse: [ 
                            report modifications
                                at: myPackageSpec name
                                put:
                                    {(myPackageSpec file).
                                    (otherPackageSpec file)} ] ] ].
    otherPackageSpecs
        valuesDo: [ :otherPackageSpec | 
            (myPackageSpecs at: otherPackageSpec name ifAbsent: [  ]) == nil
                ifTrue: [ 
                    report additions
                        at: otherPackageSpec name
                        put:
                            {''.
                            (otherPackageSpec file)} ] ].
    ^ report! !

!MetacelloMCVersionSpec methodsFor: 'merging' stamp: 'dkh 9/11/2012 12:11'!
nonOverridable
    ^ super nonOverridable , #(#'repositories')! !

!MetacelloMCVersionSpec methodsFor: 'testing' stamp: 'dkh 6/8/2012 14:04:22'!
isPartiallyCurrentAgainst: resolvedPackageAndProjectNames
	| mcLoader status |
	status := MetacelloMCPartiallyLoadedStatus new.
	mcLoader := self loader.
	self
		specsNamed: resolvedPackageAndProjectNames
		projectDo: [ :prj | 
			| vrsn currentVersion |
			status hasNoProject: false.
			vrsn := prj versionOrNil.
			vrsn ~~ nil
				ifTrue: [ 
					(currentVersion := prj relativeCurrentVersion) ~~ nil
						ifTrue: [ status vrsnStatus add: currentVersion versionStatus ] ].
			currentVersion ~~ nil
				ifTrue: [ 
					status aProjectIsLoaded: true.
					(currentVersion perform: #= with: vrsn)
						ifTrue: [ status aLoadedProjectIsExact: true ]
						ifFalse: [ 
							(currentVersion perform: prj projectReference operator with: vrsn)
								ifTrue: [ status aLoadedProjectIsCurrent: true ]
								ifFalse: [ status aLoadedProjectIsNotCurrent: true ] ] ]
				ifFalse: [ status aProjectNotLoaded: true ] ]
		packageDo: [ :pkg | 
			status hasNoPackage: false.
			pkg
				currentPackageLoaded: [ :versionInfos :file | 
					| wcName wcRef fileRef exact current |
					status aPackageIsLoaded: true.
					versionInfos isEmpty
						ifTrue: [ status aLoadedPackageIsNotCurrent: true ]
						ifFalse: [ 
							exact := current := false.
							versionInfos
								do: [ :vi | 
									wcName := vi name.
									fileRef := GoferResolvedReference name: file.
									wcRef := GoferResolvedReference name: wcName.
									(wcRef compare: fileRef using: #=)
										ifTrue: [ exact := true ] ].
							exact
								ifTrue: [ status aLoadedPackageIsExact: true ]
								ifFalse: [ 
									versionInfos
										do: [ :vi | 
											wcName := vi name.
											fileRef := GoferResolvedReference name: file.
											wcRef := GoferResolvedReference name: wcName.
											(wcRef compare: fileRef using: #>=)
												ifTrue: [ current := true ] ].
									current
										ifTrue: [ status aLoadedPackageIsCurrent: true ]
										ifFalse: [ status aLoadedPackageIsNotCurrent: true ] ] ] ]
				notLoaded: [ status aPackageNotLoaded: true ]
				using: mcLoader ]
		groupDo: [ :ignoredGroup | 
			"if we encounter a group, trouble"
			status abort: true.
			^ status ].
	^ status! !

!MetacelloMCVersionSpec methodsFor: 'testing' stamp: 'dkh 6/8/2012 14:04:22'!
isPossibleBaseline

	self 
		projectDo: [:prj | prj isPossibleBaseline ifFalse: [ ^false ]] 
		packageDo: [:pkg | pkg isPackageLoaded ifFalse: [ ^false ]] 
		groupDo: [:ignored | ].
	^true! !

!MetacelloMCVersionSpec methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
updateForSpawnMethod: sourceSpec
	"This means that this spec was used in a baseline and will be used in a version .... drop all information that isn't useful"
	
	repositories := preLoadDoIt := postLoadDoIt := nil.
! !

!MetacelloMCVersionSpec methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
repositorySpecs

	^self repositories map values! !

!MetacelloMCVersionSpec methodsFor: 'querying' stamp: 'dkh 9/11/2012 12:26'!
packageSpecsInLoadOrderForMap: packageMap
    | loadOrder pkgs packageNames importNames importProjectSpec importSpec |
    loadOrder := self packageSpecsInLoadOrder.
    importNames := (packageNames := (packageMap values collect: [ :pkg | pkg name ]) asSet) copy.
    self import ifNil: [ ^ loadOrder select: [ :pkg | packageNames includes: pkg name ] ].
    loadOrder do: [ :pkg | importNames remove: pkg name ifAbsent: [  ] ].
    pkgs := OrderedCollection new.
    importProjectSpec := loadOrder detect: [ :pkg | pkg name = self import ].
    loadOrder
        do: [ :pkg | 
            (packageNames includes: pkg name)
                ifTrue: [ pkgs add: pkg ].
            pkg name = self import
                ifTrue: [ 
                    "insert the imports at this point"
                    importNames
                        do: [ :importedName | 
                            pkgs
                                add:
                                    (importSpec := importProjectSpec copy
                                        name: importedName;
                                        mergeImportLoads: {importedName};
                                        yourself).
                            importSpec projectReference name: importedName ] ] ].
    ^ pkgs! !

!MetacelloMCVersionSpec methodsFor: 'testing' stamp: 'dkh 6/8/2012 14:04:22'!
isLoadedMatchConstraints
	"all loaded projects and packages match constraints (at least one package loaded)"
	
	self isPartiallyCurrent isLoadedMatchConstraints: [ :ignored | ^ true ].
	^ false! !

!MetacelloMCVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
computeVersionStatus: matchBlock
	self computeVersionStatus: (self expandToLoadableSpecNames: #('ALL')) matchBlock: matchBlock! !

!MetacelloMCVersionSpec methodsFor: 'enumerating' stamp: 'dkh 6/8/2012 14:04:22'!
specsNamed: packageAndProjectNames projectDo: projectBlock packageDo: packageBlock groupDo: groupBlock

	| map |
	map := self packages map.
	packageAndProjectNames do: [:name | | pkgSpec |
		(pkgSpec := map at: name ifAbsent: [ ]) ~~ nil
			ifTrue: [ pkgSpec projectDo: projectBlock packageDo: packageBlock groupDo: groupBlock ]]! !

!MetacelloMCVersionSpec methodsFor: 'construction' stamp: 'dkh 6/8/2012 14:04:22'!
package: aString overrides: aBlock constructor: aVersionConstructor
    aVersionConstructor packageForVersion: aString overrides: aBlock! !

!MetacelloMCVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
repositoriesSpec

	^self repositories! !

!MetacelloMCVersionSpec methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
packagesNeedSavingVisited: visitedProjects into: aCollection

	self packages map valuesDo: [:pkg | pkg packagesNeedSavingVisited: visitedProjects using: self repositories map values into: aCollection ].
! !

!MetacelloMCVersionSpec methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
updatedPackageSpecs

	| updatedSpecs mcLoader |
	updatedSpecs := Dictionary new.
	mcLoader := self loader.
	self packages map valuesDo: [:pkg | pkg updatePackageSpec: updatedSpecs using: mcLoader].
	^updatedSpecs! !

!MetacelloMCVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
repositories: anObject
	repositories := anObject! !

!MetacelloMCVersionSpec methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
forceUpdatedPackageSpecs

	| updatedSpecs mcLoader |
	updatedSpecs := Dictionary new.
	mcLoader := self loader.
	self packages map valuesDo: [:pkg | pkg forceUpdatePackageSpec: updatedSpecs using: mcLoader].
	^updatedSpecs! !

!MetacelloMCVersionSpec methodsFor: 'copying' stamp: 'dkh 9/11/2012 13:42'!
postCopy
    super postCopy.
    repositories := repositories copy.
    packages := packages copy	"leave reference to packages for upgrade purposes"! !

!MetacelloMCVersionSpec methodsFor: 'construction' stamp: 'dkh 6/8/2012 14:04:22'!
package: aString constructor: aVersionConstructor
    aVersionConstructor packageForVersion: aString! !

!MetacelloMCVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
repository: aString
	self repositoriesSpec add: aString! !

!MetacelloMCVersionSpec methodsFor: 'testing' stamp: 'dkh 6/8/2012 14:04:22'!
isLoadedToSpec
	"all loaded projects and packages match specifications (at least one package loaded)"
	
	self isPartiallyCurrent isLoadedToSpec: [ :ignored | ^ true ].
	^ false! !

!MetacelloMCVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
computeVersionStatus: resolvedPackageAndProjectNames matchBlock: matchBlock
	| status |
	status := resolvedPackageAndProjectNames isNil
		ifTrue: [ self isPartiallyCurrent ]
		ifFalse: [ self isPartiallyCurrentAgainst: resolvedPackageAndProjectNames ].
	status isAllLoadedToSpec: matchBlock.
	status isLoadedToSpec: matchBlock.
	status isLoadedMatchConstraints: matchBlock.
	status isSomethingLoaded: matchBlock! !

!MetacelloMCVersionSpecLoader methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
resolvePackageNames

	packages := Dictionary new.
	self resolveToLoadableSpecs.
	^packages values collect: [:pkg | pkg name ]! !

!MetacelloMCVersionSpecLoader methodsFor: 'spec compatibility' stamp: 'dkh 6/8/2012 14:04:22'!
repositorySpecs

	| repositoryMap |
	repositoryMap := self versionSpec repositories ~~ nil
		ifTrue: [ self versionSpec repositories map ]
		ifFalse: [ Dictionary new ].
	^repositoryMap values.! !

!MetacelloMCVersionSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
loader

	loader == nil 
		ifTrue: [
			loader := self versionSpec loader copy.
			loader spec: self.
			loaderPolicy notNil ifTrue: [ loader loaderPolicy: loaderPolicy] ].
	^loader! !

!MetacelloMCVersionSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
required: anObject
	required := anObject! !

!MetacelloMCVersionSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
project

	^self versionSpec project! !

!MetacelloMCVersionSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
packages

	^packages! !

!MetacelloMCVersionSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
loaderPolicy
	^ loaderPolicy! !

!MetacelloMCVersionSpecLoader methodsFor: 'spec compatibility' stamp: 'dkh 6/26/2012 12:11'!
packageSpecsInLoadOrder
    ^ self versionSpec packageSpecsInLoadOrderForMap: packages! !

!MetacelloMCVersionSpecLoader methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
repositories

	^self repositorySpecs! !

!MetacelloMCVersionSpecLoader methodsFor: 'spec compatibility' stamp: 'dkh 6/8/2012 14:04:22'!
versionString

	^self versionSpec versionString! !

!MetacelloMCVersionSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
label

	^self versionSpec label! !

!MetacelloMCVersionSpecLoader methodsFor: 'loading' stamp: 'dkh 6/26/2012 11:50'!
load
    | mcLoader |
    packages := Dictionary new.
    self resolveToLoadableSpecs.
    mcLoader := self loader.
    packages values
        do: [ :pkg | 
            pkg ensureLoadedForDevelopmentUsing: mcLoader.
            mcLoader ignoreImage
                ifFalse: [ 
                    (pkg compareCurrentVersion: self operator targetVersionStatus: #(#'allLoadedToSpec') using: mcLoader)
                        ifTrue: [ packages removeKey: pkg name ] ] ].
    packages notEmpty
        ifTrue: [ 
            mcLoader preLoad: self versionSpec.
            mcLoader load.
            mcLoader postLoad: self versionSpec ].
    ^ mcLoader! !

!MetacelloMCVersionSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
versionSpec
	^ versionSpec! !

!MetacelloMCVersionSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
loaderPolicy: anObject
	loaderPolicy := anObject! !

!MetacelloMCVersionSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
required

	required == nil ifTrue: [ ^#() ].
	^ required! !

!MetacelloMCVersionSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
versionSpec: anObject
	versionSpec := anObject! !

!MetacelloMCVersionSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
name

	^self versionSpec name! !

!MetacelloMCVersionSpecLoader methodsFor: 'private' stamp: 'dkh 6/26/2012 16:12'!
resolveToLoadableSpecs
    self versionSpec resolveToLoadableSpecs: required forLoad: true map: packages! !

!MetacelloMCVersionSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
operator

	^self loader operator! !

!MetacelloMCVersionSpecLoader class methodsFor: 'instance creation' stamp: 'dkh 6/8/2012 14:04:22'!
on: aVersionSpec

	^(self new) 
		versionSpec: aVersionSpec;
		yourself! !

!MetacelloMCVersionSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testMCVersionMergeSpec
    | versionA versionB version repository package group projectReferenceSpec |
    versionA := self versionSpec
        blessing: #'baseline';
        versionString: '1.0';
        repository: 'http://example.com/repository' username: 'dkh' password: 'password';
        repository: '/opt/gemstone/repository';
        yourself.
    versionA packages
        merge:
                (self packageSpec
                        name: 'Package';
                        requires: 'AnotherPackage';
                        yourself);
        merge:
                (self groupSpec
                        name: 'Platform';
                        includes: 'Core';
                        yourself);
        merge:
                (self projectReferenceSpec
                        name: 'Project';
                        projectReference:
                                (self projectSpec
                                        name: 'Project';
                                        projectPackage: self project packageSpec;
                                        className: 'ConfigurationOfProjectA';
                                        repository: 'http://example.com/repository'
                                            username: 'dkh'
                                            password: 'password';
                                        repository: '/opt/gemstone/repository';
                                        yourself));
        yourself.
    versionB := self versionSpec
        blessing: #'release';
        versionString: '1.1';
        repository: 'http://example.com/repository' username: 'DaleHenrichs' password: 'secret';
        repository: '/opt/gemstone/repo';
        yourself.
    versionB packages
        merge:
                (self packageSpec
                        name: 'Package';
                        requires: 'AndAnotherPackage';
                        yourself);
        merge:
                (self groupSpec
                        name: 'Platform';
                        includes: 'Tests';
                        yourself);
        merge:
                (self projectReferenceSpec
                        name: 'Project';
                        projectReference:
                                (self projectSpec
                                        name: 'Project';
                                        projectPackage: self project packageSpec;
                                        className: 'ConfigurationOfProjectA';
                                        repository: 'http://example.com/repository'
                                            username: 'DaleHenrichs'
                                            password: 'secret';
                                        repository: '/opt/gemstone/repo';
                                        yourself));
        yourself.
    version := versionA mergeSpec: versionB.
    self assert: version blessing value = #'release'.
    self assert: version versionString value = '1.1'.
    repository := version repositories map at: '/opt/gemstone/repository' ifAbsent: [ self assert: false ].
    self assert: repository type = 'directory'.
    repository := version repositories map at: '/opt/gemstone/repo' ifAbsent: [ self assert: false ].
    self assert: repository type = 'directory'.
    repository := version repositories map at: 'http://example.com/repository' ifAbsent: [ self assert: false ].
    self assert: repository type = 'http'.
    self assert: repository username = 'DaleHenrichs'.
    self assert: repository password = 'secret'.
    package := version packages packageNamed: 'Package' ifAbsent: [ self assert: false ].
    self assert: package name = 'Package'.
    projectReferenceSpec := version packages packageNamed: 'Project' ifAbsent: [ self assert: false ].
    self assert: projectReferenceSpec projectName = 'Project'.
    repository := projectReferenceSpec repositories map at: '/opt/gemstone/repository' ifAbsent: [ self assert: false ].
    self assert: repository type = 'directory'.
    repository := projectReferenceSpec repositories map at: '/opt/gemstone/repo' ifAbsent: [ self assert: false ].
    self assert: repository type = 'directory'.
    repository := projectReferenceSpec repositories map
        at: 'http://example.com/repository'
        ifAbsent: [ self assert: false ].
    self assert: repository type = 'http'.
    self assert: repository username = 'DaleHenrichs'.
    self assert: repository password = 'secret'.
    group := version packages packageNamed: 'Platform' ifAbsent: [ self assert: false ].
    self assert: (group includes includes: 'Core').
    self assert: (group includes includes: 'Tests')! !

!MetacelloMCVersionSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testMCVersionSpec
    | version projectReferenceSpec group package repository |
    version := self versionSpec
        blessing: #'baseline';
        versionString: '1.0';
        repository: 'http://example.com/repository' username: 'dkh' password: 'password';
        repository: '/opt/gemstone/repository';
        yourself.
    version packages
        add:
                (self packageSpec
                        name: 'Package';
                        requires: 'AnotherPackage';
                        includes: 'IncludedPackage';
                        answers: #(#('preload' 'preload answer') #('postload' 'postload answer'));
                        file: 'Package-dkh.1';
                        preLoadDoIt: #'preLoadDoIt';
                        postLoadDoIt: #'postLoadDoIt';
                        yourself);
        add:
                (self groupSpec
                        name: 'Platform';
                        includes: 'Core';
                        yourself);
        add:
                (self projectSpec
                        name: 'Project';
                        className: 'ConfigurationOfProjectA';
                        versionString: #'stable';
                        loads: #('MyPackage' 'MyTests');
                        preLoadDoIt: #'preLoadDoItB';
                        postLoadDoIt: #'postLoadDoItB';
                        yourself);
        yourself.
    self assert: version blessing value = #'baseline'.
    self assert: version versionString value = '1.0'.
    repository := version repositories map at: '/opt/gemstone/repository' ifAbsent: [ self assert: false ].
    self assert: repository type = 'directory'.
    repository := version repositories map at: 'http://example.com/repository' ifAbsent: [ self assert: false ].
    self assert: repository type = 'http'.
    self assert: repository username = 'dkh'.
    self assert: repository password = 'password'.
    package := version packages packageNamed: 'Package' ifAbsent: [ self assert: false ].
    self assert: package name = 'Package'.
    group := version packages packageNamed: 'Platform' ifAbsent: [ self assert: false ].
    self assert: (group includes includes: 'Core').
    projectReferenceSpec := version packages packageNamed: 'Project' ifAbsent: [ self assert: false ].
    self assert: projectReferenceSpec projectName = 'Project'.
    self assert: projectReferenceSpec versionString = #'stable'.
    version
        projectDo: [ :prjct | prjct == projectReferenceSpec ]
        packageDo: [ :pkg | pkg == package ]
        groupDo: [ :grp | grp == group ]! !

!MetacelloMCVersionSpecTestCase methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
projectClass
    ^ MetacelloMCProject! !

!MetacelloMCVersionValidator commentStamp: 'dkh 1/26/2012 09:49'!
Performs configuration validation.

For programmatically decoding reason codes use:

  MetacellMCVersionValidator fullDescriptionForReasonCode: <reasonCode>

Warning reason codes:

	#notDevelopmentVersion			- the symbolic version #development refers to a non-development literal version.
	#loadWarning 						- Warning signalled during load [load validation].
	#onlyBaselineVersion 				- one or more baseline versions have been defined, but no non-baseline versions are defined.
	#stableDevelopmentVersion		- a version whose blessing is #development has been declared as a #stable version

Critical Warning reason codes:

	#duplicateVersionDefinitions 		         - there are multiple pragma methods specifying the same version
	#loadDeprecation					         - deprecation warning signalled while loading configuration [load validation]
	#missingRecommendedProjectSpecField - missing recommended fields in project reference (versionString). The versionString should be specified so that #bleedingEdge loads will be predictable and repeatable
	#noLoadableVersions 				         - no non #baseline versions defined in configuration
	#noTests 							         - no test cases defined in loaded configuration [load validation]
	#noVersionSpecified 				         - no version defined for the project reference or package. The version specified in the baseline or the latest version of the project or package in the repository will be used.
	#packageNameMismatch 			         - the name in the packageSpec does not match the name of the mcz file
	#projectClassNameFileMismatch 	         - the class name of the configuration does not match the mcz file containing the configuration
	#testDeprecation 					         - deprecation warning signalled while running configuration tests [load validation]

Error reason codes:

	#cannotResolveVersion 			- the version (project reference or symbolic version) was not found in the specified configuration
	#duplicateNames 					- multiple independent definitions for an entity with same name (project, package, or group)
	#incompleteProjectSpec 			- missing required fields in project reference (className and/or repository)
	#incorrectVersionString 			- the version declared in pragma doesn't match version in versionSpec
	#invalidDoItSelector 				- doit select must be a Symbol
	#invalidVersionString 				- versionString must be a String
	#loadError 							- error occured while loading configuration [load validation]
	#missingVersionImport 			- version specified in import pragma not defined in configuration
	#noVersionsDefined 				- no usable baseline or version defined in configuration ... configuration cannot be loaded
	#projectCreationError 				- error occured while resolving project reference
	#shadowedNames 					- name duplication between packages and projects
	#testFailures						- test failures while running tests [load validation]
	#versionCompositionError 			- error while creating versionSpec from pragmas


!
!MetacelloMCVersionValidator methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
errorReasonCodes
	^ super errorReasonCodes, #(#loadError #testFailures )! !

!MetacelloMCVersionValidator methodsFor: 'private' stamp: 'dkh 6/30/2012 13:24'!
validateVersionSpec: versionSpec
    versionSpec blessing value == #'broken'
        ifTrue: [ ^ self ].
    versionSpec
        projectDo: [ :projectSpec | 
            | referencedProjectSpec |
            projectSpec versionString == nil
                ifTrue: [ 
                    self
                        recordValidationCriticalWarning:
                            'No version specified for the project reference ' , projectSpec name printString , ' in version '
                                , versionSpec versionString printString
                        versionString: versionSpec versionString
                        callSite: #'validateVersionSpec:'
                        reasonCode: #'noVersionSpecified' ].
            referencedProjectSpec := projectSpec referencedSpec.
            versionSpec blessing value == #'baseline'
                ifTrue: [ 
                    referencedProjectSpec hasRepository
                        ifTrue: [ 
                            (referencedProjectSpec file beginsWith: referencedProjectSpec className)
                                ifFalse: [ 
                                    self
                                        recordValidationCriticalWarning:
                                            'The class name of project ' , referencedProjectSpec className printString , ' does not match the file name '
                                                , referencedProjectSpec file printString , ' in version '
                                                , versionSpec versionString printString
                                        versionString: versionSpec versionString
                                        callSite: #'validateVersionSpec:'
                                        reasonCode: #'projectClassNameFileMismatch' ] ]
                        ifFalse: [ 
                            self
                                recordValidationError:
                                    'The specification for the project reference ' , projectSpec name printString , ' in version '
                                        , versionSpec versionString printString
                                        , ' is missing the required repository field'
                                versionString: versionSpec versionString
                                callSite: #'validateVersionSpec:'
                                reasonCode: #'incompleteProjectSpec' ] ].
            referencedProjectSpec ensureProjectLoaded
                ifTrue: [ 
                    [ projectSpec version ]
                        on: MetacelloVersionDoesNotExistError
                        do: [ :ex | 
                            | explanation |
                            explanation := projectSpec versionString == nil
                                ifTrue: [ 'the default version' ]
                                ifFalse: [ 'version ' , projectSpec versionString printString ].
                            self
                                recordValidationError:
                                    'Cannot resolve ' , explanation , ' for the project reference ' , projectSpec name printString , ' in version '
                                        , versionSpec versionString printString
                                versionString: versionSpec versionString
                                callSite: #'validateVersionSpec:'
                                reasonCode: #'cannotResolveVersion' ] ] ]
        packageDo: [ :packageSpec | 
            (packageSpec file beginsWith: packageSpec name)
                ifFalse: [ 
                    self
                        recordValidationCriticalWarning:
                            'The name of package ' , packageSpec name printString , ' does not match the file name ' , packageSpec file printString
                                , ' in version ' , versionSpec versionString printString
                        versionString: versionSpec versionString
                        callSite: #'validateVersionSpec:'
                        reasonCode: #'packageNameMismatch' ].
            packageSpec file = packageSpec name
                ifTrue: [ 
                    self
                        recordValidationCriticalWarning:
                            'No version specified for the package ' , packageSpec name printString , ' in version '
                                , versionSpec versionString printString
                        versionString: versionSpec versionString
                        callSite: #'validateVersionSpec:'
                        reasonCode: #'noVersionSpecified' ] ]
        groupDo: [ :ignored |  ].
    self validateBaselineVersionSpec: versionSpec! !

!MetacelloMCVersionValidator methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
validateProjectLoad
	| issues project versions currentVersion collectedIssues |
	(issues := self validateProject select: [ :issue | issue isError ]) notEmpty
		ifTrue: [ ^ issues ].
	project := self configurationClass project.
	collectedIssues := issues.
	versions := project versions
		select: [ :version | 
			validationReport := nil.
			version blessing ~~ #broken
				and: [ 
					version blessing ~~ #baseline
						and: [ (issues := (self validateProject: project version: version versionString) select: [ :issue | issue isCritical ]) isEmpty ] ] ].
	validationReport := collectedIssues.
	versions isEmpty
		ifTrue: [ 
			self
				recordValidationCriticalWarning: 'No non #baseline versions  available  in ' , self configurationClass name asString
				callSite: #validateProjectLoad
				reasonCode: #noLoadableVersions.
			^ self validationReport ].
	(currentVersion := project currentVersion) ~~ nil
		ifTrue: [ 
			| index |
			index := versions indexOf: currentVersion.
			versions := versions copyFrom: index to: versions size ].
	versions do: [ :version | self validateCleanLoadAndTestsForVersion: version loads: #('ALL') ].
	^ self validationReport! !

!MetacelloMCVersionValidator methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
validateProjectVersionLoad: versionString loads: loadList
	| issues project currentVersion version |
	(issues := (self validateProjectVersion: versionString) select: [ :issue | issue isError ]) notEmpty
		ifTrue: [ ^ issues ].
	project := self configurationClass project.
	version := project
		version: versionString
		ifAbsent: [ 
			self
				recordValidationError: 'Version ' , versionString printString , ' does not exist.'
				callSite: #validateProjectVersionLoad:loads:
				reasonCode: #cannotResolveVersion.
			^ self validationReport ].
	version blessing = #broken
		ifTrue: [ self error: 'The specified version is #broken' ].
	self validateCleanLoadAndTestsForVersion: version loads: loadList.
	^ self validationReport! !

!MetacelloMCVersionValidator methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
validateCleanLoadAndTestsForVersion: version loads: loadList
	| cleanLoad cleanTests |
	cleanTests := cleanLoad := false.
	[ 
	self validateVersionLoad: version loads: loadList.
	cleanLoad := true ]
		on: Error , Warning
		do: [ :ex | 
			(ex isKindOf: Error)
				ifTrue: [ 
					self
						recordValidationError:
							'Error while loading version ' , version versionString printString , ' in ' , self configurationClass name asString
								, ' ' , ex description
						versionString: version versionString
						callSite: #validateCleanLoadAndTestsForVersion:loads:
						reasonCode: #loadError ].
			(ex isKindOf: Warning)
				ifTrue: [ 
					(ex isKindOf: Deprecation)
						ifTrue: [ 
							self
								recordValidationCriticalWarning:
									'Deprecation while loading version ' , version versionString printString , ' in '
										, self configurationClass name asString , ' ' , ex description
								versionString: version versionString
								callSite: #validateCleanLoadAndTestsForVersion:loads:
								reasonCode: #loadDeprecation ]
						ifFalse: [ 
							self
								recordValidationWarning:
									'Warning while loading version ' , version versionString printString , ' in ' , self configurationClass name asString
										, ' ' , ex description
								versionString: version versionString
								callSite: #validateCleanLoadAndTestsForVersion:loads:
								reasonCode: #loadWarning.
							Smalltalk
								at: #UndeclaredVariableWarning
								ifPresent: [ :undeclaredWrning | 
									(ex isKindOf: undeclaredWrning)
										ifTrue: [ ex resume: true ] ].
							ex resume ] ] ].
	cleanLoad
		ifTrue: [ 
			cleanTests := [ self validateVersionTests: version ]
				on: Deprecation
				do: [ :ex | 
					| message |
					message := 'Deprecation warning while running tests for version ' , version versionString printString , ' in '
						, self configurationClass name asString , ' ' , ex description.	"Deprecation warning for release tests is the same as a test failure"
					self
						recordValidationCriticalWarning: message
						versionString: version versionString
						callSite: #validateCleanLoadAndTestsForVersion:loads:
						reasonCode: #testDeprecation.
					ex return: false ].
			cleanTests
				ifTrue: [ MetacelloCleanLoadAndTestsNotification signal: version ]
				ifFalse: [ MetacelloCleanLoadNotification signal: version ] ]! !

!MetacelloMCVersionValidator methodsFor: 'validation' stamp: 'dkh 7/2/2012 17:32'!
validateBaselineVersionSpec: versionSpec
    | projectNames packageNames groupNames versionMessage |
    self
        validateDoIts: versionSpec
        versionString: versionSpec versionString
        errorMessage: ' version ' , versionSpec versionString printString.
    projectNames := Set new.
    packageNames := Set new.
    groupNames := Set new.
    versionMessage := ' in version ' , versionSpec versionString printString.
    versionSpec
        projectDo: [ :projectSpec | 
            projectSpec resolveProjectSpec className == nil
                ifTrue: [ 
                    self
                        recordValidationError:
                            'Missing required field (className:) for project reference ' , projectSpec name printString , ' in version '
                                , versionSpec versionString printString
                        versionString: versionSpec versionString
                        callSite: #'validateBaselineVersionSpec:'
                        reasonCode: #'incompleteProjectSpec' ].
            projectSpec resolveProjectSpec versionString == nil
                ifTrue: [ 
                    self
                        recordValidationCriticalWarning:
                            'Missing recommended field (versionString:) for project reference ' , projectSpec name printString , ' in version '
                                , versionSpec versionString printString
                        versionString: versionSpec versionString
                        callSite: #'validateBaselineVersionSpec:'
                        reasonCode: #'missingRecommendedProjectSpecField' ].
            projectSpec hasRepository
                ifTrue: [ 
                    (self recurse and: [ projectSpec versionString ~~ nil ])
                        ifTrue: [ 
                            | project |
                            projectSpec resolveProjectSpec ensureProjectLoaded.
                            project := self
                                validateProjectCreationFrom: projectSpec resolveProjectSpec projectClass
                                onError: [ :ex | 
                                    self
                                        recordValidationError: 'Error creating project reference: ' , ex description
                                        versionString: versionSpec versionString
                                        callSite: #'validateBaselineVersionSpec:'
                                        reasonCode: #'projectCreationError'.
                                    nil ].
                            project ~~ nil
                                ifTrue: [ 
                                    self validationReport
                                        addAll:
                                            (self class
                                                validateProject: project
                                                version: projectSpec versionString
                                                debug: self debug
                                                recurse: self recurse
                                                visited: self visited) ] ] ]
                ifFalse: [ 
                    self
                        recordValidationError:
                            'Missing required field (repository:) for project reference ' , projectSpec name printString , ' in version '
                                , versionSpec versionString printString
                        versionString: versionSpec versionString
                        callSite: #'validateBaselineVersionSpec:'
                        reasonCode: #'incompleteProjectSpec' ].
            self
                validateDoIts: projectSpec
                versionString: versionSpec versionString
                errorMessage: projectSpec name printString , versionMessage.
            (projectNames includes: projectSpec name)
                ifTrue: [ 
                    self
                        recordValidationError:
                            'Duplicate projects named' , projectSpec name printString , versionMessage
                        versionString: versionSpec versionString
                        callSite: #'validateBaselineVersionSpec:'
                        reasonCode: #'duplicateNames' ]
                ifFalse: [ projectNames add: projectSpec name ] ]
        packageDo: [ :packageSpec | 
            self
                validateDoIts: packageSpec
                versionString: versionSpec versionString
                errorMessage: packageSpec name printString , versionMessage.
            (packageNames includes: packageSpec name)
                ifTrue: [ 
                    self
                        recordValidationError:
                            'Duplicate packages named' , packageSpec name printString , versionMessage
                        versionString: versionSpec versionString
                        callSite: #'validateBaselineVersionSpec:'
                        reasonCode: #'duplicateNames' ]
                ifFalse: [ projectNames add: packageSpec name ] ]
        groupDo: [ :groupSpec | 
            (groupNames includes: groupSpec name)
                ifTrue: [ 
                    self
                        recordValidationError: 'Duplicate groups named' , groupSpec name printString , versionMessage
                        versionString: versionSpec versionString
                        callSite: #'validateBaselineVersionSpec:'
                        reasonCode: #'duplicateNames' ]
                ifFalse: [ projectNames add: groupSpec name ] ].
    (packageNames intersection: projectNames) notEmpty
        ifTrue: [ 
            self
                recordValidationError: 'Names duplicated between packages and projects' , versionMessage
                versionString: versionSpec versionString
                callSite: #'validateBaselineVersionSpec:'
                reasonCode: #'shadowedNames' ].
    (groupNames intersection: projectNames) notEmpty
        ifTrue: [ 
            self
                recordValidationError: 'Names duplicated between groups and projects' , versionMessage
                versionString: versionSpec versionString
                callSite: #'validateBaselineVersionSpec:'
                reasonCode: #'shadowedNames' ].
    (projectNames intersection: packageNames) notEmpty
        ifTrue: [ 
            self
                recordValidationError: 'Names duplicated between projects and packages' , versionMessage
                versionString: versionSpec versionString
                callSite: #'validateBaselineVersionSpec:'
                reasonCode: #'shadowedNames' ].
    (groupNames intersection: packageNames) notEmpty
        ifTrue: [ 
            self
                recordValidationError: 'Names duplicated between groups and packages' , versionMessage
                versionString: versionSpec versionString
                callSite: #'validateBaselineVersionSpec:'
                reasonCode: #'shadowedNames' ].
    (projectNames intersection: groupNames) notEmpty
        ifTrue: [ 
            self
                recordValidationError: 'Names duplicated between projects and groups' , versionMessage
                versionString: versionSpec versionString
                callSite: #'validateBaselineVersionSpec:'
                reasonCode: #'shadowedNames' ].
    (packageNames intersection: groupNames) notEmpty
        ifTrue: [ 
            self
                recordValidationError: 'Names duplicated between packages and groups' , versionMessage
                versionString: versionSpec versionString
                callSite: #'validateBaselineVersionSpec:'
                reasonCode: #'shadowedNames' ]! !

!MetacelloMCVersionValidator methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
validateVersionLoad: version loads: loadList
	| list |
	list := loadList asOrderedCollection.
	list isEmpty
		ifTrue: [ list add: 'default' ].
	(version groups includes: 'Tests')
		ifTrue: [ list add: 'Tests' ].
	version load: list! !

!MetacelloMCVersionValidator methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
criticalWarningReasonCodes
	^ super criticalWarningReasonCodes
		, #(#noLoadableVersions #noTests #testDeprecation #loadDeprecation #noVersionSpecified #'missingRecommendedProjectSpecField' )! !

!MetacelloMCVersionValidator methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
warningReasonCodes
	^ super warningReasonCodes, #(#loadWarning #notDevelopmentVersion #stableDevelopmentVersion)! !

!MetacelloMCVersionValidator methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
validateVersionTests: version
	| testCases cleanTests |
	testCases := IdentitySet new.
	cleanTests := true.
	version currentlyLoadedClassesInVersion
		do: [ :class | 
			((class inheritsFrom: TestCase) and: [ class isAbstract not ])
				ifTrue: [ testCases add: class ] ].
	testCases
		do: [ :testCase | 
			| testResults |
			testResults := testCase suite run.
			testResults defects notEmpty
				ifTrue: [ 
					self
						recordValidationError:
							'Test failures in tests ' , testCase name asString , ' for ' , version versionString printString , ' in '
								, self configurationClass name asString , ' ' , testResults printString
						versionString: version versionString
						callSite: #validateVersionTests:
						reasonCode: #testFailures.
					cleanTests := false ] ].
	testCases isEmpty
		ifTrue: [ 
			self
				recordValidationCriticalWarning:
					'No test cases for ' , version versionString printString , ' in ' , self configurationClass name asString
				versionString: version versionString
				callSite: #validateVersionTests:
				reasonCode: #noTests.
			cleanTests := false ].
	^ cleanTests! !

!MetacelloMCVersionValidator methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
validateVersionSpecForSymbolicVersion: versionSpec symbolicVersion: symbolicVersionString
	| blessing |
	versionSpec blessing value == #broken
		ifTrue: [ ^ self ].
	blessing := versionSpec blessing value.
	(symbolicVersionString == #development and: [ blessing ~~ #development ])
		ifTrue: [ 
			self
				recordValidationWarning:
					'Symbolic version ' , symbolicVersionString printString , ' refers to a version' , versionSpec versionString printString
						, ' whose blessing ' , blessing printString , ' is not #development'
				versionString: versionSpec versionString
				callSite: #validateVersionSpecForSymbolicVersion:symbolicVersion:
				reasonCode: #notDevelopmentVersion ]! !

!MetacelloMCVersionValidator class methodsFor: 'instance creation' stamp: 'dkh 6/8/2012 14:04:22'!
validateConfigurationLoad: configurationClass
	^ ((self new)
		configurationClass: configurationClass;
		yourself) validateProjectLoad! !

!MetacelloMCVersionValidator class methodsFor: 'instance creation' stamp: 'dkh 6/8/2012 14:04:22'!
validateConfigurationLoad: configurationClass version: versionString loads: loadList
	^ ((self new)
		configurationClass: configurationClass;
		yourself) validateProjectVersionLoad: versionString loads: loadList! !

!MetacelloMCVersionValidator class methodsFor: 'instance creation' stamp: 'dkh 6/8/2012 14:04:22'!
validateConfigurationLoad: configurationClass version: versionString
	^self validateConfigurationLoad: configurationClass version: versionString loads: #()
! !

!MetacelloMCVersionValidator class methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
populateReasonCodeDescriptions
    "update MetacelloMCVersionValidator class comment to include any changes to descriptions"

    | dict |
    dict := super populateReasonCodeDescriptions.
    dict
        at: #'notDevelopmentVersion'
            put: 'the symbolic version #development refers to a non-development literal version.';
        at: #'loadWarning' put: 'Warning signalled during load [load validation].';
        at: #'stableDevelopmentVersion'
            put: 'a version whose blessing is #development has been declared as a #stable version.'.	"Warnings"
    dict
        at: #'loadDeprecation' put: 'deprecation warning signalled while loading configuration [load validation].';
        at: #'missingRecommendedProjectSpecField'
            put:
                'missing recommended fields in project reference (versionString). The versionString should be specified so that #bleedingEdge loads will be predictable and repeatable.';
        at: #'noLoadableVersions' put: 'no non #baseline versions defined in configuration.';
        at: #'noTests' put: 'no test cases defined in loaded configuration [load validation].';
        at: #'noVersionSpecified'
            put:
                'no version defined for the project reference or package. The version specified in the baseline or the latest version of the project or package in the repository will be used.';
        at: #'testDeprecation'
            put: 'deprecation warning signalled while running configuration tests [load validation].'.	"Critical Warnings"
    dict
        at: #'loadError' put: 'error occured while loading configuration [load validation].';
        at: #'testFailures' put: 'test failures while running tests [load validation].'.	"Errors"
    ^ dict! !

!MetacelloMemberListSpec methodsFor: 'enumeration' stamp: 'dkh 6/5/2012 19:01:24'!
detect: aBlock ifNone: exceptionBlock
	"Evaluate aBlock with each of the receiver's elements as the argument.  
	Answer the first element for which aBlock evaluates to true. If none  
	evaluate to true, then evaluate the argument, exceptionBlock."

	self
		do: [ :each | 
			(aBlock value: each)
				ifTrue: [ ^ each ] ].
	^ exceptionBlock value! !

!MetacelloMemberListSpec methodsFor: 'enumeration' stamp: 'dkh 6/5/2012 19:01:24'!
detect: aBlock
	"Evaluate aBlock with each of the receiver's elements as the argument. 
	Answer the first element for which aBlock evaluates to true."

	^ self detect: aBlock ifNone: [ self error: 'Object is not in the collection.' ]! !

!MetacelloMemberListSpec methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
mapCopy: aMemberSpec into: map
    | spec |
    spec := map at: aMemberSpec sourceName ifAbsent: [  ].
    spec == nil
        ifTrue: [ ^ self error: 'Source spec named ' , aMemberSpec sourceName printString , ' not found' ]
        ifFalse: [ 
            spec aboutToCopy.
            map at: aMemberSpec name put: (spec copy mergeSpec: aMemberSpec spec copy) ]! !

!MetacelloMemberListSpec methodsFor: 'merging' stamp: 'dkh 6/5/2012 19:01:24'!
mergeSpec: anotherSpec

	| newSpec val |
	newSpec := super mergeSpec: anotherSpec.
	newSpec list: self list copy.
	anotherSpec list do: [:groupMember | groupMember applyToList: newSpec ].
	^newSpec! !

!MetacelloMemberListSpec methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
clearMemberMap

	memberMap := nil.! !

!MetacelloMemberListSpec methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
mapMerge: aMemberSpec into: map
	| spec |
	spec :=  map at: aMemberSpec name ifAbsent: [].
	spec == nil
		ifTrue: [ map at: aMemberSpec name put: aMemberSpec spec copy ]
		ifFalse: [ map at: aMemberSpec name put: (spec mergeSpec: aMemberSpec spec)]! !

!MetacelloMemberListSpec methodsFor: 'enumeration' stamp: 'dkh 6/5/2012 19:01:24'!
specListDetect: aBlock ifNone: exceptionBlock
	"Evaluate aBlock with each of the receiver's elements as the argument.  
	Answer the first element for which aBlock evaluates to true. If none  
	evaluate to true, then evaluate the argument, exceptionBlock."

	self
		specListDo: [ :each | 
			(aBlock value: each)
				ifTrue: [ ^ each ] ].
	^ exceptionBlock value! !

!MetacelloMemberListSpec methodsFor: 'enumeration' stamp: 'dkh 6/5/2012 19:01:24'!
specListDo: aBlock

	self list do: [:member |  aBlock value: member spec ]! !

!MetacelloMemberListSpec methodsFor: 'enumeration' stamp: 'dkh 6/5/2012 19:01:24'!
specListSelect: aBlock 
	| newCollection |
	newCollection := OrderedCollection new.
	self specListDo: [:each | (aBlock value: each) ifTrue: [newCollection add: each]].
	^newCollection! !

!MetacelloMemberListSpec methodsFor: 'actions' stamp: 'dkh 6/5/2012 19:01:24'!
add: aSpec

	self subclassResponsibility! !

!MetacelloMemberListSpec methodsFor: 'adding' stamp: 'dkh 6/5/2012 19:01:24'!
addMember: aMember

	self list add: aMember.
	self clearMemberMap
! !

!MetacelloMemberListSpec methodsFor: 'actions' stamp: 'dkh 6/5/2012 19:01:24'!
copy: aMemberSpec

	self addMember: aMemberSpec! !

!MetacelloMemberListSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
list

	list == nil ifTrue: [ list := OrderedCollection new ].
	^list! !

!MetacelloMemberListSpec methodsFor: 'testing' stamp: 'dkh 6/5/2012 19:01:24'!
isEmpty

	^self list isEmpty! !

!MetacelloMemberListSpec methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
mapRemove: aMemberSpec into: map
	
	map removeKey: aMemberSpec name ifAbsent: []! !

!MetacelloMemberListSpec methodsFor: 'toolbox support' stamp: 'dkh 9/12/2012 14:16'!
deleteSpec: aSpec
    "remove the spec from list"

    | member |
    member := self list detect: [ :aMember | aMember spec = aSpec ] ifNone: [ ^ self ].
    self list remove: member! !

!MetacelloMemberListSpec methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
mapAdd: aMemberSpec into: map
	
	map at: aMemberSpec name put: aMemberSpec spec! !

!MetacelloMemberListSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
map
	
	| map |
	memberMap ~~ nil ifTrue: [ ^memberMap ].
	map := Dictionary new.
	self list do: [:member | 
		member
			applyAdd: [:memberSpec | self mapAdd: memberSpec into: map ] 
			copy: [:memberSpec | self mapCopy: memberSpec into: map ]
			merge: [:memberSpec | self mapMerge: memberSpec into: map ] 
			remove: [:memberSpec | self mapRemove: memberSpec into: map ]].
	memberMap := map.
	^memberMap! !

!MetacelloMemberListSpec methodsFor: 'testing' stamp: 'dkh 6/5/2012 19:01:24'!
notEmpty

	^self list notEmpty! !

!MetacelloMemberListSpec methodsFor: 'actions' stamp: 'dkh 6/5/2012 19:01:24'!
copy: specNamed to: aSpec

	self subclassResponsibility! !

!MetacelloMemberListSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
list: aCollection

	list := aCollection.
	self clearMemberMap! !

!MetacelloMemberListSpec methodsFor: 'enumeration' stamp: 'dkh 6/5/2012 19:01:24'!
select: aBlock 
	| newCollection |
	newCollection := OrderedCollection new.
	self do: [:each | (aBlock value: each) ifTrue: [newCollection add: each]].
	^newCollection! !

!MetacelloMemberListSpec methodsFor: 'enumeration' stamp: 'dkh 6/5/2012 19:01:24'!
collect: aBlock 
	| newCollection |
	newCollection :=OrderedCollection new.
	self do: [:each | newCollection add: (aBlock value: each)].
	^ newCollection! !

!MetacelloMemberListSpec methodsFor: 'enumeration' stamp: 'dkh 6/5/2012 19:01:24'!
do: aBlock

	self map values do: aBlock! !

!MetacelloMemberListSpec methodsFor: 'actions' stamp: 'dkh 6/5/2012 19:01:24'!
merge: aSpec

	self subclassResponsibility! !

!MetacelloMemberListSpec methodsFor: 'copying' stamp: 'dkh 6/5/2012 19:01:24'!
postCopy

	super postCopy.
	list := list copy.
	self clearMemberMap! !

!MetacelloMemberListSpec methodsFor: 'actions' stamp: 'dkh 6/5/2012 19:01:24'!
remove: aSpec

	self subclassResponsibility! !

!MetacelloMemberListSpec methodsFor: 'enumeration' stamp: 'dkh 6/5/2012 19:01:24'!
specListDetect: aBlock
	"Evaluate aBlock with each of the receiver's elements as the argument. 
	Answer the first element for which aBlock evaluates to true."

	^ self specListDetect: aBlock ifNone: [ self error: 'Object is not in the collection.' ]! !

!MetacelloMemberSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
sourceName

	^self name! !

!MetacelloMemberSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
addToMetacelloPackages: aMetacelloPackagesSpec

	aMetacelloPackagesSpec addMember: self! !

!MetacelloMemberSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
methodUpdateSelector

	^self subclassResponsibility! !

!MetacelloMemberSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
removeFromMetacelloPackages: aMetacelloPackagesSpec

	aMetacelloPackagesSpec addMember: self! !

!MetacelloMemberSpec methodsFor: 'actions' stamp: 'dkh 6/5/2012 19:01:24'!
applyAdd: addBlock copy: copyBlock merge: mergeBlock remove: removeBlock

	self subclassResponsibility

! !

!MetacelloMemberSpec methodsFor: 'actions' stamp: 'dkh 6/5/2012 19:01:24'!
applyToList: aListSpec

	self subclassResponsibility! !

!MetacelloMemberSpec methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
configMethodCascadeOn: aStream last: lastCascade indent: indent

	self spec 
		configMethodCascadeOn: aStream 
		member: self 
		last: lastCascade 
		indent: indent! !

!MetacelloMemberSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
name: aString

	name := aString! !

!MetacelloMemberSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
spec: aMetacelloSpec

	spec := aMetacelloSpec! !

!MetacelloMemberSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
removeFromMetacelloRepositories: aMetacelloRepositoriesSpec

	aMetacelloRepositoriesSpec addMember: self
! !

!MetacelloMemberSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
mergeIntoMetacelloRepositories: aMetacelloRepositoriesSpec

	aMetacelloRepositoriesSpec addMember: self
! !

!MetacelloMemberSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
mergeIntoMetacelloPackages: aMetacelloPackagesSpec

	aMetacelloPackagesSpec addMember: self! !

!MetacelloMemberSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
name

	^name! !

!MetacelloMemberSpec methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
configMethodOn: aStream indent: indent

	aStream nextPutAll: self class name asString, ' member: ('.
	self spec configMethodOn: aStream indent: indent.
	aStream nextPutAll: ')'.! !

!MetacelloMemberSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
spec

	^spec! !

!MetacelloMemberSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
addToMetacelloRepositories: aMetacelloRepositoriesSpec

	aMetacelloRepositoriesSpec addMember: self! !

!MetacelloMergeMemberSpec methodsFor: 'actions' stamp: 'dkh 6/5/2012 19:01:24'!
applyAdd: addBlock copy: copyBlock merge: mergeBlock remove: removeBlock

	mergeBlock value: self
! !

!MetacelloMergeMemberSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
methodUpdateSelector

	^#with:! !

!MetacelloMergeMemberSpec methodsFor: 'actions' stamp: 'dkh 6/5/2012 19:01:24'!
applyToList: aListSpec

	aListSpec merge: self! !

!MetacelloMethodSection methodsFor: 'testing' stamp: 'dkh 9/13/2012 19:12'!
includesAttributeFrom: attributeCollection
    ^ (attributeCollection asSet intersection: self attributes asSet) notEmpty! !

!MetacelloMethodSection methodsFor: 'accessing' stamp: 'dkh 9/7/2012 10:45'!
attribute
    self deprecated: 'Use attributes instead'.
    self attributes size > 1
        ifTrue: [ self error: 'invalid use of attribute' ].
    self attributes isEmpty
        ifTrue: [ ^ nil ].
    ^ self attributes first! !

!MetacelloMethodSection methodsFor: 'accessing' stamp: 'dkh 9/7/2012 06:42'!
attributes
    attributes ifNil: [ attributes := OrderedCollection new ].
    ^ attributes! !

!MetacelloMethodSection methodsFor: 'accessing' stamp: 'dkh 9/7/2012 10:49'!
attribute: anObject
    self deprecated: 'Use attributes: instead'.
    self attributes size > 1
        ifTrue: [ self error: 'invalid use of attribute:' ].
    attributes := OrderedCollection with: anObject! !

!MetacelloMethodSection methodsFor: 'printing' stamp: 'dkh 9/12/2012 09:46'!
attributePrintString
    | stream |
    stream := WriteStream on: String new.
    self attributes size = 1
        ifTrue: [ stream nextPutAll: '#' , attributes first asString printString ]
        ifFalse: [ 
            stream nextPutAll: '#('.
            self attributes
                do: [ :attribute | 
                    stream
                        nextPutAll: '#' , attribute asString printString;
                        space ].
            stream nextPut: $) ].
    ^ stream contents! !

!MetacelloMethodSection methodsFor: 'accessing' stamp: 'dkh 9/8/2012 05:41'!
attributes: aCollectionOrSymbol
    attributes := aCollectionOrSymbol asMetacelloAttributeList! !

!MetacelloMethodSectionPath methodsFor: 'conversion' stamp: 'dkh 9/7/2012 14:00'!
asAttributeOrPath
    self size = 1
        ifTrue: [ 
            | attribute |
            attribute := self at: 1.
            ^ attribute size = 1
                ifTrue: [ attribute at: 1 ]
                ifFalse: [ attribute ] ].
    ^ self! !

!MetacelloMethodSectionPath methodsFor: 'conversion' stamp: 'dkh 9/7/2012 13:41'!
asMetacelloAttributePath
    ^ self! !

!MetacelloMethodSpec methodsFor: 'method generation' stamp: 'dkh 6/5/2012 19:01:24'!
methodSource

	self subclassResponsibility! !

!MetacelloMethodSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
selector
	^ selector! !

!MetacelloMethodSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
versionString
	^ versionString! !

!MetacelloMethodSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
category
	^ category! !

!MetacelloMethodSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
project: anObject
	project := anObject! !

!MetacelloMethodSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
versionString: aStringOrSymbol
	versionString := aStringOrSymbol! !

!MetacelloMethodSpec methodsFor: 'method generation' stamp: 'dkh 6/5/2012 19:01:24'!
compileMethod

	(project configuration class
		compile: self methodSource
		classified: self category) == nil
		ifTrue: [ self error: 'Error compiling the method' ]! !

!MetacelloMethodSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
project
	^ project! !

!MetacelloMethodSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
methodSections

	methodSections == nil ifTrue: [ methodSections := OrderedCollection new ].
	^ methodSections! !

!MetacelloMethodSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
selector: anObject
	selector := anObject! !

!MetacelloMethodSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
methodSections: anObject
	methodSections := anObject! !

!MetacelloMethodSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
category: anObject
	category := anObject! !

!MetacelloMonticelloResource methodsFor: 'running' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpMonticelloRepository
	"This method builds a fake repository with the version references from #buildReferences."

	monticelloRepository := MCDictionaryRepository new.
	versionReferences do: [ :reference |
		monticelloRepository basicStoreVersion: (MCVersion new
			setPackage:  (MetacelloTestsMCPackage new name: reference packageName)
			info: (MCVersionInfo
				name: reference name
				id: UUID new
				message: 'This is a mock version'
				date: Date today
				time: Time now
				author: reference author
				ancestors: #())
			snapshot: (MCSnapshot fromDefinitions: (Array
				with: (MCOrganizationDefinition categories: (Array with: reference packageName asSymbol))
				with: (MCClassDefinition name: (reference packageName copyWithout: $-) asSymbol superclassName: #Object category: reference packageName asSymbol instVarNames: #() comment: '')))
			dependencies: #()) ]! !

!MetacelloMonticelloResource methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
monticelloRepository
	^ monticelloRepository! !

!MetacelloMonticelloResource methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
versionReferences
	^ versionReferences! !

!MetacelloMonticelloResource methodsFor: 'running' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUp
	super setUp.
	self
		setUpVersionReferences;
		setUpMonticelloRepository! !

!MetacelloMonticelloResource methodsFor: 'running' stamp: 'dkh 07/19/2013 22:53'!
setUpVersionReferences
  "self reset"

  versionReferences := OrderedCollection new.
  versionReferences
    add: (GoferVersionReference name: 'GoferBar.branch-lr.1');
    add: (GoferVersionReference name: 'GoferBar.branch-lr.2');
    add: (GoferVersionReference name: 'GoferBar-jf.1');
    add: (GoferVersionReference name: 'GoferBar-lr.1');
    add: (GoferVersionReference name: 'GoferFoo-lr.1');
    add: (GoferVersionReference name: 'GoferFoo-lr.2');
    add: (GoferVersionReference name: 'GoferFoo-lr.4');
    add: (GoferVersionReference name: 'GoferBeau-dkh.15');
    add: (GoferVersionReference name: 'GoferBeau-dkh.25');
    add: (GoferVersionReference name: 'GoferBeau-dkh.53');
    add: (GoferVersionReference name: 'GoferBeau-dkh.54');
    add: (GoferVersionReference name: 'GoferBeau-dkh.55');
    add: (GoferVersionReference name: 'GoferBeau-dkh.56');
    add: (GoferVersionReference name: 'GoferFaux-tg.30');
    add: (GoferVersionReference name: 'GoferFaux-tg.31');
    add: (GoferVersionReference name: 'GoferFaux-tg.32');
    add: (GoferVersionReference name: 'GoferFaux-tg.33');
    add: (GoferVersionReference name: 'GoferFaux-tg.34');
    add: (GoferVersionReference name: 'GoferFaux-tg.35');
    add: (GoferVersionReference name: 'GeauxBar.branch-lr.2');
    add: (GoferVersionReference name: 'GeauxFoo-lr.1');
    add: (GoferVersionReference name: 'GeauxFaux-tg.32');
    add: (GoferVersionReference name: 'GeauxBeau-dkh.55');
    add: (GoferVersionReference name: 'GeauxBeau-dkh.56');
    add:
        (GoferVersionReference name: 'ConfigurationOfNautilusWithoutPackages-dkh.55');
    add:
        (GoferVersionReference name: 'ConfigurationOfNautilusWithoutPackages-dkh.56');
    add:
        (GoferVersionReference name: 'ConfigurationOfNautilusWithoutPackages-dkh.57');
    add: (GoferVersionReference name: 'ConfigurationOfNautilus-dkh.56');
    add: (GoferVersionReference name: 'ConfigurationOfGlamourSeaside-dkh.55');
    add: (GoferVersionReference name: 'ConfigurationOfGlamourSeaside-dkh.56');
    add: (GoferVersionReference name: 'ConfigurationOfGlamourSeaside-dkh.57');
    add: (GoferVersionReference name: 'ConfigurationOfGlamour-dkh.56');
    yourself! !

!MetacelloNullRecordingMCSpecLoader methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
doingLoads: aBlock
	"escape mechanism for recording and null loaders to skip doing loaderlike things"
! !

!MetacelloNullRecordingMCSpecLoader methodsFor: 'versionInfo' stamp: 'dkh 6/8/2012 14:04:22'!
currentVersionInfoFor: packageSpec

	^self loadData
		currentVersionInfoFor: packageSpec 
		ifAbsent: [ nil ]
! !

!MetacelloNullRecordingMCSpecLoader methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
resolveRecordingPackageSpecReference: packageSpec gofer: gofer

	| externalPackageReference |
	externalPackageReference := packageSpec file == nil
				ifTrue: [ GoferPackageReference name: packageSpec name ]
				ifFalse: [ GoferResolvedReference name: packageSpec file repository: nil ].
	packageSpec repositorySpecs isEmpty
		ifTrue: [  self repositoryMap at: externalPackageReference packageName put: (gofer repositories reject: [:repo | repo = MCCacheRepository default ]) ]
		ifFalse: [  self repositoryMap at: externalPackageReference packageName put: (packageSpec repositorySpecs collect: [:repoSpec | repoSpec createRepository ]) ].
	^externalPackageReference! !

!MetacelloNullRecordingMCSpecLoader methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
loadPackageDirectives: pkgLoads gofer: aGofer
	"Noop"! !

!MetacelloNullRecordingMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
loadingSpecLoader

	^self! !

!MetacelloNullRecordingMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
packages

	| packages |
	packages := OrderedCollection new.
	self loadDirective packageDirectivesDo: [:directive | packages add: directive spec ].
	^packages! !

!MetacelloNullRecordingMCSpecLoader methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
resolvePackageSpecReferences: packageSpec gofer: gofer

	|  versionReference references localGofer |
	localGofer := gofer.
	self hasRepositoryOverrides not
		ifTrue: [
			packageSpec repositorySpecs notEmpty
				ifTrue: [ 
					localGofer := MetacelloGofer new.
					(self repositoriesFrom: packageSpec repositorySpecs) do: [:repo | localGofer repository: repo ]]].
	(packageSpec getFile == nil or: [ self shouldDisablePackageCache ])
		ifTrue: [ 
			"don't use package-cache when trying to get latest version"
			localGofer disablePackageCache ].
	versionReference := packageSpec goferLoaderReference.
	references := versionReference resolveAllWith: localGofer.
	localGofer enablePackageCache.
	^references! !

!MetacelloNullRecordingMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
actionLabel

	^'Recording '! !

!MetacelloNullRecordingMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
beforeLoads

	beforeLoads == nil ifTrue: [ beforeLoads := OrderedCollection new ].
	^beforeLoads! !

!MetacelloNullRecordingMCSpecLoader methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
linearLoadPackageSpec: packageSpec gofer: gofer

	MetacelloPlatform current
		do:  [ | externalReference loadBlock answers fake |
			externalReference := self resolveRecordingPackageSpecReference: packageSpec gofer: gofer.
			loadBlock := [
					self preLoad: packageSpec.
					(MetacelloDirective 
						loadPackage: packageSpec 
						externalReference: externalReference 
						loader: self) addTo: self loadDirective.
					self postLoad: packageSpec ].
			(answers := packageSpec answers) notEmpty
				ifTrue: [ loadBlock valueSupplyingMetacelloAnswers: answers ]
				ifFalse: [ loadBlock value ].
			fake := packageSpec copy.
			fake name: fake file.
			self loadData 
				addVersion: fake
				versionInfo: fake
				resolvedReference: externalReference 
				packageSpec: packageSpec ]
		displaying: 'Recording ', packageSpec file! !

!MetacelloNullRecordingMCSpecLoader methodsFor: 'doits' stamp: 'dkh 6/8/2012 14:04:22'!
preLoad: packageOrVersionSpec

	self evalDoits ifFalse: [ ^self ].
	packageOrVersionSpec preLoadDoItBlock ~~ nil
		ifTrue: [ self beforeLoads add: packageOrVersionSpec name, ' load' ].
	super preLoad: packageOrVersionSpec! !

!MetacelloNullRecordingMCSpecLoader methodsFor: 'doits' stamp: 'dkh 6/8/2012 14:04:22'!
postLoad: packageOrVersionSpec

	self evalDoits ifFalse: [ ^self ].
	packageOrVersionSpec postLoadDoItBlock ~~ nil
		ifTrue: [ self afterLoads add: packageOrVersionSpec name, ' load' ].
	super postLoad: packageOrVersionSpec! !

!MetacelloNullRecordingMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
afterLoads

	afterLoads == nil ifTrue: [ afterLoads := OrderedCollection new ].
	^afterLoads! !

!MetacelloNullRecordingMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
evalDoits

	evalDoits == nil ifTrue: [ evalDoits := false ].
	^evalDoits! !

!MetacelloNullRecordingMCSpecLoader methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
loadPackageDirective: aPackageLoadDirective gofer: aGofer
	"Noop"! !

!MetacelloNullRecordingMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
loadedPackages

	| packages |
	packages := OrderedCollection new.
	self loadDirective packageDirectivesDo: [:directive | packages add: directive file ].
	^packages! !

!MetacelloNullRecordingMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
evalDoits: aBool

	evalDoits := aBool! !

!MetacelloNullRecordingMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
loadedRepositories

	| repos |
	repos := OrderedCollection new.
	self repositoryMap values collect: [:coll | repos addAll: coll ].
	^repos! !

!MetacelloNullRecordingMCSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
recordingSpecLoader

	^self! !

!MetacelloNullRecordingMCSpecLoader methodsFor: 'testing' stamp: 'dkh 6/8/2012 14:04:22'!
ensureForDevelopment

	^false! !

!MetacelloPackageLoadDirective methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
file

	^self externalReference name! !

!MetacelloPackageLoadDirective methodsFor: 'enumerating' stamp: 'dkh 6/8/2012 14:04:22'!
packageDo: aBlock

	aBlock value: self! !

!MetacelloPackageLoadDirective methodsFor: 'initialize-release' stamp: 'dkh 6/8/2012 14:04:22'!
spec: aPackageSpec externalReference: anExternalReference loader: aLoader

	super spec: aPackageSpec loader: aLoader.
	externalReference := anExternalReference! !

!MetacelloPackageLoadDirective methodsFor: 'enumerating' stamp: 'dkh 6/8/2012 14:04:22'!
packageDirectivesDo: aBlock

	aBlock value: self! !

!MetacelloPackageLoadDirective methodsFor: 'printing' stamp: 'dkh 6/8/2012 14:04:22'!
label

	^self file! !

!MetacelloPackageLoadDirective methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
resolvedReference: anObject
	resolvedReference := anObject! !

!MetacelloPackageLoadDirective methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
externalReference
	^ externalReference! !

!MetacelloPackageLoadDirective methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
packageName

	^self externalReference packageName! !

!MetacelloPackageLoadDirective methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
title

	^'load'! !

!MetacelloPackageLoadDirective methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
repository

	^self externalReference repository! !

!MetacelloPackageLoadDirective methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
loadUsing: aLoaderDirective gofer: aGofer

	aLoaderDirective loadPackageDirective: self gofer: aGofer! !

!MetacelloPackageLoadDirective methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
resolvedReference
	^ resolvedReference! !

!MetacelloPackageSpec methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
file

	file == nil ifTrue: [ ^self name ].
	^file
! !

!MetacelloPackageSpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
setPreLoadDoIt: aSymbol

	preLoadDoIt := aSymbol! !

!MetacelloPackageSpec methodsFor: 'querying' stamp: 'dkh 6/30/2012 13:30'!
repository
    self deprecated: 'Use repositories or repositorySpecs'.
    self repositorySpecs isEmpty
        ifTrue: [ ^ nil ].
    ^ self repositorySpecs first! !

!MetacelloPackageSpec methodsFor: 'merging' stamp: 'dkh 6/8/2012 14:04:22'!
mergeSpec: anotherSpec

	| newSpec map anotherPackages anotherRepositories |
	newSpec := super mergeSpec: anotherSpec.
	map := anotherSpec mergeMap.
	(anotherRepositories := map at: #repositories) notEmpty
		ifTrue: [ 
			newSpec 
				repositories: (self repositories isEmpty
					ifTrue: [ anotherRepositories ]
					ifFalse: [ self repositories mergeSpec: anotherRepositories ]) ].
	^newSpec! !

!MetacelloPackageSpec methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
loadUsing: aLoader gofer: gofer

	^aLoader linearLoadPackageSpec: self gofer: gofer! !

!MetacelloPackageSpec methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
preLoadDoIt

	^preLoadDoIt! !

!MetacelloPackageSpec methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
forceUpdatePackageSpec: updatedSpecs using: anMCLoader
	
	self updatePackageSpec: updatedSpecs force: true using: anMCLoader! !

!MetacelloPackageSpec methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
getPostLoadDoIt

	^postLoadDoIt! !

!MetacelloPackageSpec methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
postLoadDoIt

	^postLoadDoIt! !

!MetacelloPackageSpec methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
packagesNeedSavingVisited: visitedProjects using: repos into: aCollection

	^self loader packagesNeedSavingUsing: repos into: aCollection! !

!MetacelloPackageSpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
getName
    "raw access to iv"

    ^ name! !

!MetacelloPackageSpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
getRepositories
    "raw access to iv"

    ^ repositories! !

!MetacelloPackageSpec methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
goferBranchPackage: branchName message: commitMessage
	"uses gofer to do commit ... non-interactive"

	| latestFile pkgSpec   |
	(file notNil and: [ (self name, '.', branchName) = self file ])
		ifTrue: [ 
			latestFile := self loader latestPackage: self file fromRepository: self repositorySpecs.
			pkgSpec := self copy.
			latestFile ~~ nil
				ifTrue: [ 
					pkgSpec file: latestFile.
					pkgSpec goferCommitPackage: commitMessage.
					^ self ] ].
	self loader goferCommitBranchPackage: branchName using: self repositorySpecs commitMessage: commitMessage! !

!MetacelloPackageSpec methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
updatePackageRepositories: repositorySpecs

	| resolvedPackageRef |
	Transcript cr; show: '  Looking up version -> ', self file.
	resolvedPackageRef := self loader resolveSpec: self from: repositorySpecs.
	Transcript cr; show: 'Update repositoryGroup -> ', resolvedPackageRef name, ' ' , resolvedPackageRef repository description.
	resolvedPackageRef version workingCopy repositoryGroup addRepository: resolvedPackageRef repository
! !

!MetacelloPackageSpec methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
updatePackageRepositoriesFor: aVersionSpec
	"Don't update the repository unless the package is loaded in the image"
	
	self workingCopy == nil ifTrue: [ ^self ].
	self updatePackageRepositories: self repositorySpecs, aVersionSpec repositorySpecs.	
! !

!MetacelloPackageSpec methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
extractNameFromFile

	file == nil ifTrue: [ ^nil ].
	^(self loader nameComponentsFrom: self file) first! !

!MetacelloPackageSpec methodsFor: 'construction' stamp: 'dkh 6/8/2012 14:04:22'!
postLoadDoIt: aSymbol constructor: aVersionConstructor
    aVersionConstructor postLoadDoItForPackage: aSymbol! !

!MetacelloPackageSpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
repository: aString username: username password: password

	self repositories repository: aString username: username password: password! !

!MetacelloPackageSpec methodsFor: 'printing' stamp: 'dkh 6/8/2012 14:04:22'!
configMethodBodyOn: aStream hasName: hasName indent: indent

	| hasFile hasRepositories hasPreLoadDoIt hasPostLoadDoIt hasRequiresOrIncludesOrAnswers |
	hasFile := file ~~ nil.
	hasRepositories := self repositorySpecs size > 0.
	hasPreLoadDoIt := self getPreLoadDoIt ~~ nil.
	hasPostLoadDoIt := self getPostLoadDoIt ~~ nil.
	hasRequiresOrIncludesOrAnswers := (self requires isEmpty and: [ self includes isEmpty and: [self answers isEmpty ]]) not.
	hasRequiresOrIncludesOrAnswers
		ifTrue: [ 
			self 
				configMethodBodyOn: aStream 
				hasName: hasName 
				cascading: hasFile | hasRepositories | hasPreLoadDoIt | hasPostLoadDoIt
				indent: indent ].
	self 
		configMethodOn: aStream 
		for: file 
		selector: 'file: ' 
		cascading: hasName | hasRepositories | hasPreLoadDoIt | hasPostLoadDoIt | hasRequiresOrIncludesOrAnswers 
		cascade: hasRepositories | hasPreLoadDoIt | hasPostLoadDoIt 
		indent: indent.
	hasRepositories
		ifTrue: [ 
			(self repositorySpecs size > 1)
				ifTrue: [ 
					hasName | hasFile | hasPreLoadDoIt | hasPostLoadDoIt | hasRequiresOrIncludesOrAnswers
						ifTrue: [ 
							aStream cr;
							tab: indent. ].
					aStream 
						nextPutAll: 'repositories: ['; 
						cr;
						tab: indent + 1;
						nextPutAll: 'spec'; 
						cr.
					self repositories configMethodCascadeOn: aStream indent: indent + 1.
					aStream nextPutAll: ' ]' ]
				ifFalse: [ 
					hasName | hasFile | hasPreLoadDoIt | hasPostLoadDoIt | hasRequiresOrIncludesOrAnswers
						ifTrue: [ aStream cr; tab: indent ].
					self repositories configMethodCascadeOn: aStream indent: indent ].
			hasPreLoadDoIt | hasPostLoadDoIt ifTrue: [ aStream nextPut: $; ] ].
	self 
		configMethodOn: aStream 
		for: self getPreLoadDoIt 
		selector: 'preLoadDoIt: '
		cascading: hasName | hasFile | hasRepositories | hasPostLoadDoIt | hasRequiresOrIncludesOrAnswers 
		cascade: hasPostLoadDoIt 
		indent: indent.
	self 
		configMethodOn: aStream 
		for: self getPostLoadDoIt 
		selector: 'postLoadDoIt: ' 
		cascading: hasName | hasFile | hasRepositories | hasPreLoadDoIt | hasRequiresOrIncludesOrAnswers 
		cascade: false 
		indent: indent.
	aStream nextPut: $.! !

!MetacelloPackageSpec methodsFor: 'construction' stamp: 'dkh 6/8/2012 14:04:22'!
file: aString constructor: aVersionConstructor
    aVersionConstructor fileForPackage: aString! !

!MetacelloPackageSpec methodsFor: 'merging' stamp: 'dkh 6/8/2012 14:04:22'!
nonOverridable

	^super nonOverridable, #( repositories)! !

!MetacelloPackageSpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
getFile
	"raw access to iv"
	
	^file! !

!MetacelloPackageSpec methodsFor: 'testing' stamp: 'dkh 6/30/2012 13:23'!
hasRepository
    ^ self repositorySpecs notEmpty! !

!MetacelloPackageSpec methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
repositorySpecs

	^self repositories map values! !

!MetacelloPackageSpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
setPostLoadDoIt: aSymbol

	postLoadDoIt := aSymbol! !

!MetacelloPackageSpec methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
updatePackageSpec: updatedSpecs using: anMCLoader
	"Add pkg copy to updatedSpecs if the file in current image is different from the receiver's file"
	
	self updatePackageSpec: updatedSpecs force: false using: anMCLoader! !

!MetacelloPackageSpec methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
fetchPackage: aLoaderPolicy

	self fetchUsing: 
		(self loader
			loaderPolicy: aLoaderPolicy;
			yourself)! !

!MetacelloPackageSpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
preLoadDoIt: anObject

	anObject setPreLoadDoItInMetacelloSpec: self! !

!MetacelloPackageSpec methodsFor: 'construction' stamp: 'dkh 6/8/2012 14:04:22'!
preLoadDoIt: aSymbol constructor: aVersionConstructor
    aVersionConstructor preLoadDoItForPackage: aSymbol! !

!MetacelloPackageSpec methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
repositories: anObject
	repositories := anObject! !

!MetacelloPackageSpec methodsFor: 'gofer' stamp: 'dkh 6/8/2012 14:04:22'!
workingCopyName

	| wc |
	(wc := self workingCopy) == nil ifTrue: [ ^nil ].
	wc ancestry ancestors isEmpty not
		ifTrue: [ ^wc ancestry ancestors first name ].
	^nil! !

!MetacelloPackageSpec methodsFor: 'copying' stamp: 'dkh 6/8/2012 14:04:22'!
postCopy

	super postCopy.
	goferPackage := nil.
	repositories := repositories copy.
! !

!MetacelloPackageSpec methodsFor: 'testing' stamp: 'dkh 6/8/2012 14:04:22'!
compareCurrentVersion: anOperator targetVersionStatus: statusIgnored using: anMCLoader

	self 
		currentPackageLoaded: [:bool | ^bool ] 
		comparing: anOperator 
		notLoaded: [:ignored | ^false ]
		using: anMCLoader
! !

!MetacelloPackageSpec methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
postLoadDoIt: anObject

	anObject setPostLoadDoItInMetacelloSpec: self! !

!MetacelloPackageSpec methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
ensureLoadUsing: mcLoader
	self explicitLoadUsing: mcLoader ensureSpecLoader! !

!MetacelloPackageSpec methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
name

	name == nil ifTrue: [ name := self extractNameFromFile ].
	^name! !

!MetacelloPackageSpec methodsFor: 'testing' stamp: 'dkh 07/19/2013 15:50'!
currentPackageLoaded: loadedBlock comparing: comarisonOperator notLoaded: notLoadedBlock using: anMCLoader
  "Use currentVersionInfoFor: because it involves the loader and returns versionInfo for a planned load 
	 (atomic loaders) or currently loaded package"

  | wcName vis |
  vis := anMCLoader ancestorsFor: self.
  vis notNil
    ifTrue: [ 
      | fileRef wcRef |
      self getFile == nil
        ifTrue: [ ^ loadedBlock value: false ].
      vis
        do: [ :vi | 
          wcName := vi name.
          fileRef := GoferVersionReference name: self file.
          fileRef versionNumber = 0
            ifTrue: [ 
              "a shame that GoferVersionReference doesn't have better method for recognizing a missing verion number"
              "fix for: https://github.com/dalehenrich/metacello-work/issues/185"
              ^ loadedBlock value: false ].
          wcRef := GoferVersionReference name: wcName.
          (wcRef compare: fileRef using: comarisonOperator)
            ifTrue: [ ^ loadedBlock value: true ] ].
      ^ loadedBlock value: false ].
  ^ notLoadedBlock value: true! !

!MetacelloPackageSpec methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
ensureLoadedForDevelopmentUsing: mcLoader
	"noop"
	
	^true! !

!MetacelloPackageSpec methodsFor: 'printing' stamp: 'dkh 6/8/2012 14:04:22'!
configMethodCascadeOn: aStream member: aMember last: lastCascade indent: indent

	aMember methodUpdateSelector  == #remove:
		ifTrue: [ aStream  nextPutAll: 'removePackage: ', self name printString ]
		ifFalse: [ self configShortCutMethodBodyOn: aStream member: aMember indent: indent ].
	lastCascade
		ifTrue: [ aStream nextPut: $. ]
		ifFalse: [ aStream nextPut: $;; cr ]! !

!MetacelloPackageSpec methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
fetchUsing: mcLoader

	| fetchingSpecLoader |
	fetchingSpecLoader := mcLoader fetchingSpecLoader.
	fetchingSpecLoader
		linearLoadPackageSpecs: (Array with: self) 
		repositories: (fetchingSpecLoader repositoriesFrom: self repositorySpecs).
! !

!MetacelloPackageSpec methodsFor: 'gofer' stamp: 'dkh 6/8/2012 14:04:22'!
workingCopyNameFor: anMCLoader

	| vi |
	(vi := anMCLoader currentVersionInfoFor: self) == nil ifTrue: [ ^nil ].
	^vi name! !

!MetacelloPackageSpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
goferLoaderReference

	^file == nil 
		ifTrue: [ GoferPackageReference name: self name ]
		ifFalse: [ 
			"does Monticello-style #versionInfoFromVersionNamed: matching"
			MetacelloGoferPackage name: self name packageFilename: self file ]! !

!MetacelloPackageSpec methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
resolveToPackagesIn: aVersionSpec visited: visited

	^{ self }
! !

!MetacelloPackageSpec methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
loadUsing: mcLoader

	self loader doingLoads: [ self explicitLoadUsing: mcLoader ]
! !

!MetacelloPackageSpec methodsFor: 'gofer' stamp: 'dkh 6/8/2012 14:04:22'!
workingCopy

	^self goferPackage workingCopy! !

!MetacelloPackageSpec methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
packageSpecsInLoadOrder

	^{ self. }! !

!MetacelloPackageSpec methodsFor: 'printing' stamp: 'dkh 6/8/2012 14:04:22'!
configShortCutMethodBodyOn: aStream member: aMember indent: indent

	| hasFile hasRepositories hasPreLoadDoIt hasPostLoadDoIt hasRequiresOrIncludesOrAnswers |
	hasFile := file ~~ nil.
	hasRepositories := self repositorySpecs size > 0.
	hasPreLoadDoIt := self getPreLoadDoIt ~~ nil.
	hasPostLoadDoIt := self getPostLoadDoIt ~~ nil.
	hasRequiresOrIncludesOrAnswers := (self requires isEmpty and: [ self includes isEmpty and: [self answers isEmpty ]]) not.
	hasRepositories | hasPreLoadDoIt | hasPostLoadDoIt | hasRequiresOrIncludesOrAnswers
		ifTrue: [
			aStream 
				nextPutAll: 'package: ', self name printString, ' ';
				nextPutAll: aMember methodUpdateSelector asString, ' ['; cr.
			aStream tab: indent + 1; nextPutAll: 'spec '.
			self configMethodBodyOn: aStream hasName: false indent: indent + 2.
			aStream nextPutAll: ' ]'.
			^self ].
	aStream nextPutAll: 'package: ', self name printString.
	hasFile
		ifTrue: [ aStream nextPutAll: ' with: ', file printString ]! !

!MetacelloPackageSpec methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
repositories

	repositories == nil ifTrue: [ repositories := self project repositoriesSpec ].
	^ repositories! !

!MetacelloPackageSpec methodsFor: 'merging' stamp: 'dkh 6/8/2012 14:04:22'!
mergeMap

	| map |
	map := super mergeMap.
	map at: #file put: file.
	map at: #repositories put: self repositories.
	map at: #preLoadDoIt put: preLoadDoIt.
	map at: #postLoadDoIt put: postLoadDoIt.
	^map! !

!MetacelloPackageSpec methodsFor: 'gofer' stamp: 'dkh 6/8/2012 14:04:22'!
currentVersionInfo

	^self goferPackage currentVersionInfo! !

!MetacelloPackageSpec methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
load

	self explicitLoadUsing: self loader! !

!MetacelloPackageSpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
goferPackage

	goferPackage == nil 
		ifTrue: [ goferPackage := MetacelloGoferPackage name: self name packageFilename: self file ].
	^goferPackage! !

!MetacelloPackageSpec methodsFor: 'construction' stamp: 'dkh 6/8/2012 14:04:22'!
repository: aString username: username password: password constructor: aVersionConstructor
    aVersionConstructor repositoryForPackage: aString username: username password: password! !

!MetacelloPackageSpec methodsFor: 'testing' stamp: 'dkh 6/8/2012 14:04:22'!
compareWorkingCopyNamed: wcName using: comarisonOperator
	| fileRef wcRef |
	fileRef := GoferResolvedReference name: self file.
	wcRef := GoferResolvedReference name: wcName.
	^ wcRef compare: fileRef using: comarisonOperator! !

!MetacelloPackageSpec methodsFor: 'construction' stamp: 'dkh 6/8/2012 14:04:22'!
repository: anObject constructor: aVersionConstructor
    aVersionConstructor repositoryForPackage: anObject! !

!MetacelloPackageSpec methodsFor: 'construction' stamp: 'dkh 6/8/2012 14:04:22'!
supplyingAnswers: anObject constructor: aVersionConstructor
    aVersionConstructor supplyingAnswersForPackage: anObject! !

!MetacelloPackageSpec methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
fetch

	self fetchUsing: self loader! !

!MetacelloPackageSpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
file: aString

	file := aString! !

!MetacelloPackageSpec methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
isPackageLoaded

	^self isPackageLoaded: self loader! !

!MetacelloPackageSpec methodsFor: 'development support' stamp: 'dkh 9/12/2012 12:14'!
updateForSpawnMethod: sourceSpec
    "This means that this spec was used in a baseline and will be used in a version .... drop all information that isn't useful"

    | nm fl |
    nm := name.
    fl := file.
    fl == nil
        ifTrue: [ 
            "if only name has been set, then force the file to be non-nil, if any attribute besides file is set, then leave file nil"
            {answers.
            requires.
            includes.
            repositories.
            preLoadDoIt.
            postLoadDoIt} detect: [ :each | each ~~ nil ] ifNone: [ fl := name ] ].
    super updateForSpawnMethod: sourceSpec.
    file := repositories := goferPackage := preLoadDoIt := postLoadDoIt := nil.
    name := nm.
    file := fl.
    ^ file == nil! !

!MetacelloPackageSpec methodsFor: 'loading' stamp: 'dkh 7/2/2012 18:49'!
repositoryDescriptions
    ^ self repositorySpecs collect: [ :repoSpec | repoSpec description ]! !

!MetacelloPackageSpec methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
isPackageLoaded: aLoader

	^(self workingCopyNameFor: aLoader) ~~ nil! !

!MetacelloPackageSpec methodsFor: 'construction' stamp: 'dkh 6/8/2012 14:04:22'!
requires: anObject constructor: aVersionConstructor
    aVersionConstructor requiresForPackage: anObject! !

!MetacelloPackageSpec methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
goferCommitPackage: commitMessage
	"uses gofer to do commit ... non-interactive"
	
	| latestFile pkgSpec |
	^(file notNil and: [ self name = self file ])
		ifTrue: [
			latestFile := self loader latestPackage: self name fromRepository: self repositorySpecs.
			pkgSpec := self copy.
			pkgSpec file: latestFile.
			pkgSpec goferCommitPackage: commitMessage ]
		ifFalse: [ self loader goferCommitPackageUsing: self repositorySpecs commitMessage: commitMessage ]
! !

!MetacelloPackageSpec methodsFor: 'visiting' stamp: 'dkh 6/8/2012 14:04:22'!
projectDo: projectBlock packageDo: packageBlock groupDo: groupBlock

	packageBlock value: self! !

!MetacelloPackageSpec methodsFor: 'construction' stamp: 'dkh 6/8/2012 14:04:22'!
includes: anObject constructor: aVersionConstructor
    aVersionConstructor includesForPackage: anObject! !

!MetacelloPackageSpec methodsFor: 'gofer' stamp: 'dkh 6/8/2012 14:04:22'!
ancestors

	^self goferPackage ancestors! !

!MetacelloPackageSpec methodsFor: 'visiting' stamp: 'dkh 6/8/2012 14:04:22'!
visitingWithPackages: packages

	packages at: self name put: self! !

!MetacelloPackageSpec methodsFor: 'testing' stamp: 'dkh 6/8/2012 14:04:22'!
compareRelativeCurrentVersion: anOperator targetVersionStatus: statusIgnored using: anMCLoader

	^self compareCurrentVersion: anOperator targetVersionStatus: statusIgnored using: anMCLoader
! !

!MetacelloPackageSpec methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
explicitLoadUsing: mcLoader

	| wc fetchingSpecLoader |
	((wc := self workingCopy) ~~ nil and: [ wc needsSaving ]) 
		ifTrue: [ 
			(MetacelloSkipDirtyPackageLoad signal: self)
				ifTrue:  [
					Transcript cr; show: 'Skipping load of modified package: ', self file.
					^self]
				ifFalse: [Transcript cr; show: 'Load over modified package: ', self file] ].
	"fetch and explicitly load it"
	fetchingSpecLoader := mcLoader fetchingSpecLoader.
	fetchingSpecLoader
		explicitLoadPackageSpecs: (Array with: self) 
		repositories: (fetchingSpecLoader repositoriesFrom: self repositorySpecs).
! !

!MetacelloPackageSpec methodsFor: 'construction' stamp: 'dkh 6/8/2012 14:04:22'!
repositories: aBlock constructor: aVersionConstructor
    aVersionConstructor repositoriesForPackage: aBlock! !

!MetacelloPackageSpec methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
savePackage
	"Interactive save ... prompted for commit message and package name unless MCVersionNameAndMessageRequest handled"

	| latestFile pkgSpec |
	^(file notNil and: [ self name = self file ])
		ifTrue: [
			latestFile := self loader latestPackage: self name fromRepository: self repositorySpecs.
			pkgSpec := self copy.
			pkgSpec file: latestFile.
			pkgSpec savePackage ]
		ifFalse: [ self loader savePackageUsing: self repositorySpecs ]
! !

!MetacelloPackageSpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
repository: aStringOrMetacelloRepositorySpec

	self repositories repository: aStringOrMetacelloRepositorySpec! !

!MetacelloPackageSpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
info
	"test compatibility method"

	^self! !

!MetacelloPackageSpec methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
copySpecTo: aRepositorySpec
	"Copy current mcz file to the repository named in aRepositorySpec"

	self loader copySpec: self from: self repositorySpecs to: aRepositorySpec createRepository! !

!MetacelloPackageSpec methodsFor: 'development support' stamp: 'dkh 6/8/2012 14:04:22'!
updatePackageSpec: updatedSpecs force: force using: anMCLoader
	"Add pkg copy to updatedSpecs if the file in current image is different from the receiver's file"

	| viName |
	(force not and: [ self getFile == nil ])
		ifTrue: [ ^ self ].	"no file explicitly specified in this spec"
	(viName := self workingCopyNameFor: anMCLoader) == nil
		ifTrue: [ ^ self ].	"no working copy"
	viName ~= self file
		ifTrue: [ 
			| spec |
			spec := self copy.
			spec file: viName.
			updatedSpecs at: spec name put: spec ]
		ifFalse: [ updatedSpecs at: self name put: #uptodate ]! !

!MetacelloPackageSpec methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
includesForPackageOrdering

	^self includes! !

!MetacelloPackageSpec methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
getPreLoadDoIt

	^preLoadDoIt! !

!MetacelloPackageSpec methodsFor: 'testing' stamp: 'dkh 6/8/2012 14:04:22'!
currentPackageLoaded: loadedBlock notLoaded: notLoadedBlock using: anMCLoader
	"Use currentVersionInfoFor: because it involves the loader and returns versionInfo for a planned load 
	 (atomic loaders) or currently loaded package"

	| wcName vis |
	vis := anMCLoader ancestorsFor: self.
	vis notNil
		ifTrue: [ 
			self getFile == nil
				ifTrue: [ ^ loadedBlock value: #() value: self file ].
			^ loadedBlock value: vis value: self file ].
	^ notLoadedBlock value! !

!MetacelloPackageSpec methodsFor: 'printing' stamp: 'dkh 6/8/2012 14:04:22'!
configMethodOn: aStream indent: indent

	| hasRepositories hasPreLoadDoIt hasPostLoadDoIt hasRequiresOrIncludesOrAnswers hasFile |
	hasFile := file ~~ nil.
	hasRepositories := self repositorySpecs size > 0.
	hasPreLoadDoIt := self getPreLoadDoIt ~~ nil.
	hasPostLoadDoIt := self getPostLoadDoIt ~~ nil.
	hasRequiresOrIncludesOrAnswers := (self requires isEmpty and: [ self includes isEmpty and: [self answers isEmpty ]]) not.
	aStream tab: indent; nextPutAll: 'spec '.
	hasFile | hasRepositories | hasPreLoadDoIt | hasPostLoadDoIt | hasRequiresOrIncludesOrAnswers
		ifTrue: [
			aStream cr; tab: indent + 1; nextPutAll: 'name: ', self name printString; nextPut: $;.
			self configMethodBodyOn: aStream hasName: true indent: indent + 1 ]
		ifFalse: [
			aStream nextPutAll: 'name: ', self name printString ]! !

!MetacelloPackageSpecResolutionError methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
repositories: anObject
	repositories := anObject! !

!MetacelloPackageSpecResolutionError methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
repositoryError: anObject
	repositoryError := anObject! !

!MetacelloPackageSpecResolutionError methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
repositories
	^ repositories! !

!MetacelloPackageSpecResolutionError methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
description
    "Return a textual description of the exception."

    ^ 'Could not resolve: ' , packageSpec name , ' [' , packageSpec file , ']' , ' in' , self repositoryString
        ,
            (repositoryError == nil
                ifTrue: [ '' ]
                ifFalse: [ 
                    "report repository error to user here, since failure here is likely to be due to earlier repository error"
                    ' ERROR: ' , repositoryError description printString ])! !

!MetacelloPackageSpecResolutionError methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
repositoryString
    | repositoryString |
    repositoryString := ''.
    self repositories do: [ :repo | repositoryString := repositoryString , ' ' , repo description ].
    ^ repositoryString! !

!MetacelloPackageSpecResolutionError methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
packageSpec
	^ packageSpec! !

!MetacelloPackageSpecResolutionError methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
packageSpec: anObject
	packageSpec := anObject! !

!MetacelloPackageSpecResolutionError methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
repositoryError
	^ repositoryError! !

!MetacelloPackageSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testPackageMergeSpec
    | packageA packageB package repository |
    packageA := self packageSpec
        name: 'Package';
        name: 'Package';
        requires: 'AnotherPackage';
        includes: 'IncludedPackage';
        answers: #(#('preload' 'preload answer') #('postload' 'postload answer'));
        file: 'Package-dkh.1';
        preLoadDoIt: #'preLoadDoIt';
        postLoadDoIt: #'postLoadDoIt';
        repository: 'http://example.com/repository' username: 'dkh' password: 'password';
        repository: '/opt/gemstone/repository';
        yourself.
    packageB := self packageSpec
        name: 'Package';
        requires: 'AndAnotherPackage';
        includes: 'AndIncludedPackage';
        answers: #(#('xpostload' 'xpostload answer'));
        file: 'Package-dkh.2';
        repository: 'http://example.com/repository' username: 'DaleHenrichs' password: 'secret';
        repository: '/opt/gemstone/repo';
        yourself.
    package := packageA mergeSpec: packageB.
    self assert: package name = 'Package'.
    self assert: package requires = #('AnotherPackage' 'AndAnotherPackage').
    self assert: package includes = #('IncludedPackage' 'AndIncludedPackage').
    self
        assert:
            package answers = #(#('preload' 'preload answer') #('postload' 'postload answer') #('xpostload' 'xpostload answer')).
    self assert: package file = 'Package-dkh.2'.
    self assert: package preLoadDoIt value == #'preLoadDoIt'.
    self assert: package postLoadDoIt value == #'postLoadDoIt'.
    repository := package repositories map at: '/opt/gemstone/repository' ifAbsent: [ self assert: false ].
    self assert: repository type = 'directory'.
    repository := package repositories map at: '/opt/gemstone/repo' ifAbsent: [ self assert: false ].
    self assert: repository type = 'directory'.
    repository := package repositories map at: 'http://example.com/repository' ifAbsent: [ self assert: false ].
    self assert: repository type = 'http'.
    self assert: repository username = 'DaleHenrichs'.
    self assert: repository password = 'secret'! !

!MetacelloPackageSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testPackageSpec
    | package repository |
    package := self packageSpec
        name: 'Package';
        requires: 'AnotherPackage';
        includes: 'IncludedPackage';
        answers: #(#('preload' 'preload answer') #('postload' 'postload answer'));
        file: 'Package-dkh.1';
        preLoadDoIt: #'preLoadDoIt';
        postLoadDoIt: #'postLoadDoIt';
        repository: 'http://example.com/repository' username: 'dkh' password: 'password';
        repository: '/opt/gemstone/repository';
        yourself.
    self assert: package name = 'Package'.
    self assert: package requires = #('AnotherPackage').
    self assert: package includes = #('IncludedPackage').
    self assert: package answers = #(#('preload' 'preload answer') #('postload' 'postload answer')).
    self assert: package file = 'Package-dkh.1'.
    self assert: package preLoadDoIt value == #'preLoadDoIt'.
    self assert: package postLoadDoIt value == #'postLoadDoIt'.
    repository := package repositories map at: '/opt/gemstone/repository' ifAbsent: [ self assert: false ].
    self assert: repository type = 'directory'.
    repository := package repositories map at: 'http://example.com/repository' ifAbsent: [ self assert: false ].
    self assert: repository type = 'http'.
    self assert: repository username = 'dkh'.
    self assert: repository password = 'password'! !

!MetacelloPackageSpecTestCase methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
projectClass
    ^ MetacelloMCProject! !

!MetacelloPackagesSpec methodsFor: 'actions' stamp: 'dkh 6/5/2012 19:01:24'!
copy: specNamed to: spec

	self addMember: 
		(self copyMember 
			name: spec name;
			sourceName: specNamed;
			spec: spec;
			yourself)
! !

!MetacelloPackagesSpec methodsFor: 'actions' stamp: 'dkh 6/5/2012 19:01:24'!
add: aSpec

	aSpec addToMetacelloPackages: self! !

!MetacelloPackagesSpec methodsFor: 'actions' stamp: 'dkh 6/5/2012 19:01:24'!
merge: aSpec

	aSpec mergeIntoMetacelloPackages: self! !

!MetacelloPackagesSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
packageNamed: aString ifAbsent: aBlock

	^self map at: aString ifAbsent: aBlock! !

!MetacelloPackagesSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
applyIncludesTo: orderedSpecs for: pkgSpec firstTime: firstTime
	| movedSpecs baseIndex includedSpec result |
	movedSpecs := Set new.
	baseIndex := orderedSpecs indexOf: pkgSpec.
	pkgSpec includesForPackageOrdering
		do: [:includedSpecName | 
			includedSpec := orderedSpecs
						detect: [:spec | spec name = includedSpecName ]
						ifNone: [].
			(self slideIn: orderedSpecs spec: includedSpec baseIndex: baseIndex seen: IdentitySet new firstTime: firstTime)
				ifTrue: [ movedSpecs add: includedSpec name ]].
	^ movedSpecs! !

!MetacelloPackagesSpec methodsFor: 'actions' stamp: 'dkh 6/5/2012 19:01:24'!
remove: aSpec

	aSpec removeFromMetacelloPackages: self! !

!MetacelloPackagesSpec methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
sortPackageSpecs: orderedSpecs for: packageSpec

	| packageIndex moved movePackage targetPackage targetIndex targetPackages |
	packageIndex := orderedSpecs indexOf: packageSpec.
	moved := movePackage := false.
	targetPackages := packageSpec requires.
	targetPackages do: [:targetPackageName |
		targetPackage := orderedSpecs 
			detect: [:each | each name = targetPackageName ] 
			ifNone: [].
		targetIndex := orderedSpecs indexOf: targetPackage.
		movePackage := movePackage or: [ packageIndex <= targetIndex ]].
	movePackage 
		ifTrue: [
			moved := true.
			orderedSpecs remove: packageSpec ifAbsent: [ ^self error: 'unexpected error removing package' ].
			targetIndex := 0.
			targetPackages do: [:targetPackageName | 
				(targetPackage := orderedSpecs detect: [:each | 
					each name = targetPackageName ] ifNone: []) ~~ nil
						ifTrue: [ targetIndex := targetIndex max: (orderedSpecs indexOf: targetPackage) ]].
			targetIndex == 0
				ifTrue: [ orderedSpecs add: packageSpec beforeIndex: packageIndex ]
				ifFalse: [ orderedSpecs add: packageSpec afterIndex: targetIndex ]].
	^moved! !

!MetacelloPackagesSpec methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
configMethodOn: aStream indent: indent

	| packageSpecs |
	packageSpecs := self map values.
	packageSpecs size = 0 ifTrue: [ ^aStream nextPutAll: 'spec add: []' ].
	packageSpecs size = 1
		ifTrue: [
			aStream 
				tab: indent; 
				nextPutAll: 'spec add: ['; cr.
			packageSpecs first configMethodOn: aStream indent: indent + 1.
			aStream nextPut: $]; cr ]
		ifFalse: [
			aStream 
				tab: indent; 
				nextPutAll: 'spec'.
			1 to: packageSpecs size do: [:index | | packageSpec |
				packageSpec := packageSpecs at: index.
				aStream 
					tab: indent + 1;
					nextPutAll: 'add: ['; cr.
				packageSpec configMethodOn: aStream indent: indent + 2.
				aStream nextPut: $].
				index < packageSpecs size
					ifTrue: [ aStream nextPut: $; ].
				aStream cr ]]! !

!MetacelloPackagesSpec methodsFor: 'accessing' stamp: 'dkh 9/6/2012 03:05'!
packageSpecsInLoadOrder
    | orderedSpecs moved lastMovedSpecs count terminationLimit map specsWithIncludes firstTime |
    "specification order is the default order"
    map := self map.
    orderedSpecs := OrderedCollection new.
    self list
        do: [ :member | 
            | spec |
            spec := map at: member name ifAbsent: [  ].
            (spec == nil or: [ orderedSpecs includes: spec ])
                ifFalse: [ orderedSpecs add: spec ] ].
    orderedSpecs isEmpty
        ifTrue: [ ^ orderedSpecs ].
    moved := true.
    count := 0.
    terminationLimit := orderedSpecs size * 2.
    [ moved ]
        whileTrue: [ 
            count := count + 1.
            count > terminationLimit
                ifTrue: [ 
                    "Cheap termination hack - an APPARENT loop"
                    self error: 'Apparent loop in before/after dependency definitions' ].
            moved := false.
            orderedSpecs
                do: [ :packageSpec | moved := moved or: [ self sortPackageSpecs: orderedSpecs for: packageSpec ] ] ].
    lastMovedSpecs := Set new.
    moved := true.
    count := 0.
    specsWithIncludes := orderedSpecs select: [ :pkgSpec | pkgSpec includesForPackageOrdering isEmpty not ].
    firstTime := true.
    [ moved ]
        whileTrue: [ 
            | result |
            count := count + 1.	"count > terminationLimit"
            count > 14
                ifTrue: [ 
                    "Cheap termination hack - an APPARENT loop"
                    self error: 'Apparent loop in before/after dependency definitions' ].
            moved := false.
            result := Set new.
            specsWithIncludes
                do: [ :packageSpec | result addAll: (self applyIncludesTo: orderedSpecs for: packageSpec firstTime: firstTime) ].
            result size = lastMovedSpecs size
                ifTrue: [ 
                    result
                        do: [ :name | 
                            (lastMovedSpecs includes: name)
                                ifFalse: [ moved := true ] ] ]
                ifFalse: [ moved := true ].
            lastMovedSpecs := result.
            firstTime := false ].
    ^ orderedSpecs! !

!MetacelloPackagesSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
slideIn: orderedSpecs spec: targetSpec baseIndex: baseIndex seen: seen firstTime: firstTime
	| targetIndex requires targetRequires targetRequiresIndexes minIndex baseSpec required |

	(seen includes: targetSpec) ifTrue: [ ^false ].
	targetIndex := orderedSpecs indexOf: targetSpec.
	baseIndex >= targetIndex ifTrue: [ ^false ].
	required := false.
	baseSpec := orderedSpecs at: baseIndex.
	baseIndex + 1 to: targetIndex - 1 do: [:index | | spec |
		spec := orderedSpecs at: index.
		(spec requires includes: baseSpec name) ifTrue: [ required := true ]].
	firstTime ifFalse: [ required ifFalse: [ ^false ]].
	requires := targetSpec requires.
	targetRequires := orderedSpecs
				select: [:spec | requires includes: spec name].
	targetRequiresIndexes := targetRequires
				collect: [:spec | orderedSpecs indexOf: spec].
	targetRequiresIndexes add: baseIndex.
	minIndex := targetRequiresIndexes
				detectMax: [:each | each].
	minIndex + 1 < targetIndex
		ifTrue: [
			orderedSpecs remove: targetSpec.
			orderedSpecs add: targetSpec afterIndex: minIndex.
			seen add: targetSpec ]
		ifFalse: [ ^self slideIn: orderedSpecs spec: (orderedSpecs at: minIndex) baseIndex: 1 seen: seen firstTime: firstTime].
	^true
! !

!MetacelloPackagesSpecTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testMergeGroupB
    "used by MetacelloAbstractVersionConstructor>>group:with:"

    | packages group |
    packages := self packagesSpec.
    packages
        add:
            (self groupSpec
                name: 'Platform';
                includes: 'Core';
                yourself).
    packages
        merge:
            {(self groupSpec
                name: 'Platform';
                includes: 'Tests';
                yourself)}.
    group := packages packageNamed: 'Platform' ifAbsent: [ self assert: false ].
    self assert: (group includes includes: 'Core').
    self assert: (group includes includes: 'Tests')! !

!MetacelloPackagesSpecTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testAddProjectA
    "used by MetacelloAbstractVersionConstructor>>project:overrides:"

    | packages project projectReferenceSpec |
    packages := self packagesSpec.
    packages
        add:
            (self projectSpec
                name: 'Project';
                className: 'ConfigurationOfProjectA';
                versionString: #'stable';
                loads: #('MyPackage' 'MyTests');
                preLoadDoIt: #'preLoadDoItB';
                postLoadDoIt: #'postLoadDoItB';
                yourself).
    packages
        add:
            (self projectSpec
                name: 'Project';
                className: 'ConfigurationOfProject';
                versionString: '1.0';
                operator: #'<';
                loads: #('MyPackage');
                preLoadDoIt: #'preLoadDoIt';
                postLoadDoIt: #'postLoadDoIt';
                yourself).
    projectReferenceSpec := packages packageNamed: 'Project' ifAbsent: [ self assert: false ].
    self assert: projectReferenceSpec projectName = 'Project'.
    self assert: projectReferenceSpec versionString = '1.0'.
    self should: [ projectReferenceSpec includes: #() ] raise: Error.
    self should: [ projectReferenceSpec requires: #() ] raise: Error.
    self should: [ projectReferenceSpec answers: #() ] raise: Error.
    projectReferenceSpec
        projectDo: [ :prjct | self assert: projectReferenceSpec == prjct ]
        packageDo: [ :ignored | self assert: false ]
        groupDo: [ :ignored | self assert: false ].
    project := projectReferenceSpec referencedSpec.
    self assert: project name = 'Project'.
    self assert: project className = 'ConfigurationOfProject'.
    self assert: project versionString = '1.0'.
    self assert: project operator == #'<'.
    self assert: project loads = #('MyPackage').
    self assert: project preLoadDoIt value == #'preLoadDoIt'.
    self assert: project postLoadDoIt value == #'postLoadDoIt'.
    project
        projectDo: [ :prjct | self assert: project == prjct ]
        packageDo: [ :ignored | self assert: false ]
        groupDo: [ :ignored | self assert: false ]! !

!MetacelloPackagesSpecTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testRemoveProjectA
    "used by MetacelloAbstractVersionConstructor>>removeProject:"

    | packages project projectReferenceSpec removed |
    packages := self packagesSpec.
    packages
        add:
            (self projectSpec
                name: 'Project';
                className: 'ConfigurationOfProject';
                versionString: '1.0';
                operator: #'<';
                loads: #('MyPackage');
                preLoadDoIt: #'preLoadDoIt';
                postLoadDoIt: #'postLoadDoIt';
                yourself).
    projectReferenceSpec := packages packageNamed: 'Project' ifAbsent: [ self assert: false ].
    project := projectReferenceSpec referencedSpec.
    self assert: project name = 'Project'.
    self assert: project className = 'ConfigurationOfProject'.
    self assert: project versionString = '1.0'.
    self assert: project operator == #'<'.
    self assert: project loads = #('MyPackage').
    self assert: project preLoadDoIt value == #'preLoadDoIt'.
    self assert: project postLoadDoIt value == #'postLoadDoIt'.
    packages
        remove:
            (self projectReferenceSpec
                name: 'Project';
                yourself).
    removed := false.
    packages packageNamed: 'Project' ifAbsent: [ removed := true ].
    self assert: removed! !

!MetacelloPackagesSpecTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testAddGroupA
    "used by MetacelloAbstractVersionConstructor>>group:overrides:"

    | packages group |
    packages := self packagesSpec.
    packages
        add:
            (self groupSpec
                name: 'Platform';
                includes: 'Core';
                yourself).
    packages
        add:
            (self groupSpec
                name: 'Platform';
                includes: 'Tests';
                yourself).
    group := packages packageNamed: 'Platform' ifAbsent: [ self assert: false ].
    self deny: (group includes includes: 'Core').
    self assert: (group includes includes: 'Tests')! !

!MetacelloPackagesSpecTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testRemoveGroupC
    "used by MetacelloAbstractVersionConstructor>>removeGroup:"

    | packages group removed |
    packages := self packagesSpec.
    packages
        add:
            {(self groupSpec
                name: 'Platform';
                includes: 'Core';
                yourself).
            (self groupSpec
                name: 'Base';
                includes: 'Base';
                yourself).
            (self groupSpec
                name: 'Tests';
                includes: 'Tests';
                yourself)}.
    packages packageNamed: 'Platform' ifAbsent: [ self assert: false ].
    packages packageNamed: 'Base' ifAbsent: [ self assert: false ].
    packages packageNamed: 'Tests' ifAbsent: [ self assert: false ].
    packages remove: 'Tests'.
    packages packageNamed: 'Platform' ifAbsent: [ self assert: false ].
    packages packageNamed: 'Base' ifAbsent: [ self assert: false ].
    removed := false.
    packages packageNamed: 'Tests' ifAbsent: [ removed := true ].
    self assert: removed! !

!MetacelloPackagesSpecTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testMergeGroupA
    "used by MetacelloAbstractVersionConstructor>>group:with:"

    | packages group |
    packages := self packagesSpec.
    packages
        add:
            (self groupSpec
                name: 'Platform';
                includes: 'Core';
                yourself).
    packages
        merge:
            (self groupSpec
                name: 'Platform';
                includes: 'Tests';
                yourself).
    group := packages packageNamed: 'Platform' ifAbsent: [ self assert: false ].
    self assert: (group includes includes: 'Core').
    self assert: (group includes includes: 'Tests')! !

!MetacelloPackagesSpecTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testMergeProjectB
    "used by MetacelloAbstractVersionConstructor>>project:with:"

    | packages project projectReferenceSpec referenceSpec |
    packages := self packagesSpec.
    project := self projectSpec
        name: 'Project';
        className: 'ConfigurationOfProjectA';
        versionString: #'stable';
        loads: #('MyPackage' 'MyTests');
        preLoadDoIt: #'preLoadDoItB';
        postLoadDoIt: #'postLoadDoItB';
        yourself.
    referenceSpec := self project projectReferenceSpec
        name: project name;
        projectReference: project;
        yourself.
    packages add: referenceSpec.
    project := self projectSpec
        name: 'Project';
        className: 'ConfigurationOfProject';
        versionString: '1.0';
        operator: #'<';
        loads: #('MyPackage');
        preLoadDoIt: #'preLoadDoIt';
        postLoadDoIt: #'postLoadDoIt';
        yourself.
    referenceSpec := self project projectReferenceSpec
        name: project name;
        projectReference: project;
        yourself.
    packages merge: {referenceSpec}.
    projectReferenceSpec := packages packageNamed: 'Project' ifAbsent: [ self assert: false ].
    project := projectReferenceSpec referencedSpec.
    self assert: project name = 'Project'.
    self assert: project className = 'ConfigurationOfProject'.
    self assert: project versionString = '1.0'.
    self assert: project operator == #'<'.
    self assert: project loads = #('MyPackage').
    self assert: project preLoadDoIt value == #'preLoadDoIt'.
    self assert: project postLoadDoIt value == #'postLoadDoIt'.
    project
        projectDo: [ :prjct | self assert: project == prjct ]
        packageDo: [ :ignored | self assert: false ]
        groupDo: [ :ignored | self assert: false ]! !

!MetacelloPackagesSpecTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testRemoveProjectB
    "used by MetacelloAbstractVersionConstructor>>removeProject:"

    | packages project projectReferenceSpec removed |
    packages := self packagesSpec.
    packages
        add:
            (self projectSpec
                name: 'Project';
                className: 'ConfigurationOfProject';
                versionString: '1.0';
                operator: #'<';
                loads: #('MyPackage');
                preLoadDoIt: #'preLoadDoIt';
                postLoadDoIt: #'postLoadDoIt';
                yourself).
    projectReferenceSpec := packages packageNamed: 'Project' ifAbsent: [ self assert: false ].
    project := projectReferenceSpec referencedSpec.
    self assert: project name = 'Project'.
    self assert: project className = 'ConfigurationOfProject'.
    self assert: project versionString = '1.0'.
    self assert: project operator == #'<'.
    self assert: project loads = #('MyPackage').
    self assert: project preLoadDoIt value == #'preLoadDoIt'.
    self assert: project postLoadDoIt value == #'postLoadDoIt'.
    packages
        remove:
            {(self projectReferenceSpec
                name: 'Project';
                yourself)}.
    removed := false.
    packages packageNamed: 'Project' ifAbsent: [ removed := true ].
    self assert: removed! !

!MetacelloPackagesSpecTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testAddGroupB
    "used by MetacelloAbstractVersionConstructor>>group:overrides:"

    | packages group |
    packages := self packagesSpec.
    packages
        add:
            {(self groupSpec
                name: 'Platform';
                includes: 'Core';
                yourself).
            (self groupSpec
                name: 'Platform';
                includes: 'Tests';
                yourself)}.
    group := packages packageNamed: 'Platform' ifAbsent: [ self assert: false ].
    self deny: (group includes includes: 'Core').
    self assert: (group includes includes: 'Tests')! !

!MetacelloPackagesSpecTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testCopyToGroup
    "not currently used by MetacelloAbstractVersionConstructor"

    | packages group |
    packages := self packagesSpec.
    packages
        add:
            (self groupSpec
                name: 'Platform';
                includes: 'Core';
                yourself).
    packages
        merge:
            (self groupSpec
                name: 'Platform';
                includes: 'Tests';
                yourself).
    group := packages packageNamed: 'Platform' ifAbsent: [ self assert: false ].
    self assert: (group includes includes: 'Core').
    self assert: (group includes includes: 'Tests').
    group := self groupSpec
        name: 'PlatformCopy';
        includes: 'Copy';
        yourself.
    packages copy: 'Platform' to: group.
    group := packages packageNamed: 'PlatformCopy' ifAbsent: [ self assert: false ].
    self assert: (group includes includes: 'Core').
    self assert: (group includes includes: 'Copy').
    self assert: (group includes includes: 'Tests')! !

!MetacelloPackagesSpecTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testRemoveGroupA
    "used by MetacelloAbstractVersionConstructor>>removeGroup:"

    | packages group removed |
    packages := self packagesSpec.
    packages
        add:
            (self groupSpec
                name: 'Platform';
                includes: 'Core';
                yourself).
    packages
        merge:
            (self groupSpec
                name: 'Platform';
                includes: 'Tests';
                yourself).
    group := packages packageNamed: 'Platform' ifAbsent: [ self assert: false ].
    self assert: (group includes includes: 'Core').
    self assert: (group includes includes: 'Tests').
    packages
        remove:
            (self groupSpec
                name: 'Platform';
                includes: 'Core';
                yourself).
    removed := false.
    packages packageNamed: 'Platform' ifAbsent: [ removed := true ].
    self assert: removed! !

!MetacelloPackagesSpecTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testCopyToProject
    "used by MetacelloAbstractVersionConstructor>>project:copyFrom:with:"

    | packages project referenceSpec |
    packages := self packagesSpec.
    packages
        add:
            (self projectSpec
                name: 'Project';
                className: 'ConfigurationOfProjectA';
                versionString: #'stable';
                loads: #('MyPackage' 'MyTests');
                preLoadDoIt: #'preLoadDoItB';
                postLoadDoIt: #'postLoadDoItB';
                yourself).
    project := self projectSpec
        name: 'ProjectCopy';
        yourself.
    referenceSpec := self project projectReferenceSpec
        name: 'ProjectCopy';
        projectReference: project;
        yourself.
    packages copy: 'Project' to: referenceSpec.
    project := (packages packageNamed: 'ProjectCopy' ifAbsent: [ self assert: false ]) referencedSpec.
    self assert: project name = 'ProjectCopy'.
    self assert: project className = 'ConfigurationOfProjectA'.
    self assert: project versionString = #'stable'.
    self assert: project operator == #'>='.
    self assert: project loads = #('MyPackage' 'MyTests').
    self assert: project preLoadDoIt value == #'preLoadDoItB'.
    self assert: project postLoadDoIt value == #'postLoadDoItB'! !

!MetacelloPackagesSpecTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testMergeProjectA
    "used by MetacelloAbstractVersionConstructor>>project:with:"

    | packages project projectReferenceSpec referenceSpec |
    packages := self packagesSpec.
    project := self projectSpec
        name: 'Project';
        className: 'ConfigurationOfProjectA';
        versionString: #'stable';
        loads: #('MyPackage' 'MyTests');
        preLoadDoIt: #'preLoadDoItB';
        postLoadDoIt: #'postLoadDoItB';
        yourself.
    referenceSpec := self project projectReferenceSpec
        name: project name;
        projectReference: project;
        yourself.
    packages add: referenceSpec.
    project := self projectSpec
        name: 'Project';
        className: 'ConfigurationOfProject';
        versionString: '1.0';
        operator: #'<';
        loads: #('MyPackage');
        preLoadDoIt: #'preLoadDoIt';
        postLoadDoIt: #'postLoadDoIt';
        yourself.
    referenceSpec := self project projectReferenceSpec
        name: project name;
        projectReference: project;
        yourself.
    packages merge: referenceSpec.
    projectReferenceSpec := packages packageNamed: 'Project' ifAbsent: [ self assert: false ].
    project := projectReferenceSpec referencedSpec.
    self assert: project name = 'Project'.
    self assert: project className = 'ConfigurationOfProject'.
    self assert: project versionString = '1.0'.
    self assert: project operator == #'<'.
    self assert: project loads = #('MyPackage').
    self assert: project preLoadDoIt value == #'preLoadDoIt'.
    self assert: project postLoadDoIt value == #'postLoadDoIt'.
    project
        projectDo: [ :prjct | self assert: project == prjct ]
        packageDo: [ :ignored | self assert: false ]
        groupDo: [ :ignored | self assert: false ]! !

!MetacelloPackagesSpecTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testRemoveGroupB
    "used by MetacelloAbstractVersionConstructor>>removeGroup:"

    | packages group removed |
    packages := self packagesSpec.
    packages
        add:
            {(self groupSpec
                name: 'Platform';
                includes: 'Core';
                yourself).
            (self groupSpec
                name: 'Base';
                includes: 'Base';
                yourself).
            (self groupSpec
                name: 'Tests';
                includes: 'Tests';
                yourself)}.
    packages packageNamed: 'Platform' ifAbsent: [ self assert: false ].
    packages packageNamed: 'Base' ifAbsent: [ self assert: false ].
    packages packageNamed: 'Tests' ifAbsent: [ self assert: false ].
    packages
        remove:
            {'Base'.
            'Tests'}.
    packages packageNamed: 'Platform' ifAbsent: [ self assert: false ].
    removed := false.
    packages packageNamed: 'Base' ifAbsent: [ removed := true ].
    self assert: removed.
    removed := false.
    packages packageNamed: 'Tests' ifAbsent: [ removed := true ].
    self assert: removed! !

!MetacelloPackagesSpecTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testAddProjectB
    "used by MetacelloAbstractVersionConstructor>>project:overrides:"

    | packages project projectReferenceSpec |
    packages := self packagesSpec.
    packages
        add:
            {(self projectSpec
                name: 'Project';
                className: 'ConfigurationOfProjectA';
                versionString: #'stable';
                loads: #('MyPackage' 'MyTests');
                preLoadDoIt: #'preLoadDoItB';
                postLoadDoIt: #'postLoadDoItB';
                yourself).
            (self projectSpec
                name: 'Project';
                className: 'ConfigurationOfProject';
                versionString: '1.0';
                operator: #'<';
                loads: #('MyPackage');
                preLoadDoIt: #'preLoadDoIt';
                postLoadDoIt: #'postLoadDoIt';
                yourself)}.
    projectReferenceSpec := packages packageNamed: 'Project' ifAbsent: [ self assert: false ].
    self assert: projectReferenceSpec projectName = 'Project'.
    self assert: projectReferenceSpec versionString = '1.0'.
    self should: [ projectReferenceSpec includes: #() ] raise: Error.
    self should: [ projectReferenceSpec requires: #() ] raise: Error.
    self should: [ projectReferenceSpec answers: #() ] raise: Error.
    projectReferenceSpec
        projectDo: [ :prjct | self assert: projectReferenceSpec == prjct ]
        packageDo: [ :ignored | self assert: false ]
        groupDo: [ :ignored | self assert: false ].
    project := projectReferenceSpec referencedSpec.
    self assert: project name = 'Project'.
    self assert: project className = 'ConfigurationOfProject'.
    self assert: project versionString = '1.0'.
    self assert: project operator == #'<'.
    self assert: project loads = #('MyPackage').
    self assert: project preLoadDoIt value == #'preLoadDoIt'.
    self assert: project postLoadDoIt value == #'postLoadDoIt'.
    project
        projectDo: [ :prjct | self assert: project == prjct ]
        packageDo: [ :ignored | self assert: false ]
        groupDo: [ :ignored | self assert: false ]! !

!MetacelloPharo30Platform commentStamp: '<historical>'!
Class used to abstract specific code for the Pharo 3.0 platform.
!
!MetacelloPharo30Platform methodsFor: 'monticello' stamp: 'ChristopheDemarey 9/12/2013 10:28'!
newVersionForWorkingCopy: aWorkingCopy
	^aWorkingCopy newVersionIn: aWorkingCopy repositoryGroup! !

!MetacelloPharo30Platform methodsFor: 'system' stamp: 'ChristopheDemarey 5/27/2013 16:18'!
suspendSystemUpdateEventsDuring: aBlock
	"Wraps call to the system evetn manager to tell it that we want to suspend events during execution of aBlock"
	"From Pharo2, we cannot suspend system events since missing events brak the image (rpackage at least should be notified."
	"SystemAnnouncer uniqueInstance suspendAllWhile: aBlock"
	^ aBlock value
! !

!MetacelloPharo30Platform methodsFor: 'pharo 2.0 compat' stamp: 'dkh 5/8/2013 09:40'!
packageInfoFor: aMCWorkingCopy
  "MCPackageManager>>packageInfo is deprecated in Pharo2.0"

  ^ aMCWorkingCopy packageSet! !

!MetacelloPharo30Platform methodsFor: 'github support' stamp: 'ChristopheDemarey 9/19/2013 11:02'!
downloadFile: url to: outputFileName
	"download a Zip file from <url> into <outputFileName>"
	outputFileName asFileReference ensureDelete.
	ZnClient new
		url: url;
		downloadTo: outputFileName.
    ^ ZipArchive new 
		readFrom: outputFileName asFileReference! !

!MetacelloPharo30Platform methodsFor: 'file system' stamp: 'ChristopheDemarey 4/29/2013 15:14'!
directoryFromPath: adirectoryPath relativeTo: anotherDirectoryPath
	"Get a handle on the following path: anotherDirectoryPath/adirectoryPath"
	^ anotherDirectoryPath resolveString: adirectoryPath! !

!MetacelloPharo30Platform methodsFor: 'file system' stamp: 'ChristopheDemarey 4/29/2013 13:16'!
fileHandleOn: aPath
	"Get an handle on a file."

	^ aPath asFileReference! !

!MetacelloPharo30Platform methodsFor: 'github support' stamp: 'ChristopheDemarey 9/19/2013 10:35'!
extractRepositoryFrom: zipFile to: directory
    "unzip <zipFile> into <directory>"
	ZipArchive new 
		readFrom:  zipFile;
		extractAllTo: directory asFileReference.! !

!MetacelloPharo30Platform methodsFor: 'file system' stamp: 'ChristopheDemarey 4/29/2013 15:58'!
fileDirectoryClass
	^FileSystem! !

!MetacelloPharo30Platform methodsFor: 'file system' stamp: 'ChristopheDemarey 7/15/2014 15:48'!
tempFileFor: aName suffix: aSuffixString
	^ FileReference newTempFilePrefix: aName suffix: aSuffixString! !

!MetacelloPharo30Platform methodsFor: 'file system' stamp: 'ChristopheDemarey 5/29/2013 18:16'!
parentDirectoryOf: aFileHandler
	"Get the parent directory of this file."
	
	^ aFileHandler parent! !

!MetacelloPharo30Platform methodsFor: 'file system' stamp: 'ChristopheDemarey 5/27/2013 17:43'!
recursiveDelete: aDirectory
	"delete this directory and all children of it"

	^  aDirectory deleteAll! !

!MetacelloPharo30Platform methodsFor: 'utilities' stamp: 'ChristopheDemarey 5/31/2013 13:02'!
string: aString includesSubstring: aSubstring
	"abstract String>>includesSubstring: to have the same message on all supported platforms."

	^aString includesSubstring: aSubstring! !

!MetacelloPharo30Platform methodsFor: 'file system' stamp: 'ChristopheDemarey 4/29/2013 14:17'!
defaultDirectory
	"Get the image default directory"
	
	^FileLocator imageDirectory asFileReference! !

!MetacelloPharo30Platform methodsFor: 'file system' stamp: 'ChristopheDemarey 5/14/2013 17:44'!
fileFromPath: aFileName relativeTo: aDirectoryPath
	"Get a handle on the following path: anotherDirectoryPath/aFileName"
	^ aDirectoryPath / aFileName! !

!MetacelloPharo30Platform methodsFor: 'file system' stamp: 'ChristopheDemarey 7/22/2013 11:20'!
ensureDirectoryExists: aDirectoryHandle
	"Ensure the directory exists."

	^ aDirectoryHandle ensureCreateDirectory ; yourself! !

!MetacelloPharo30Platform methodsFor: 'file system' stamp: 'ChristopheDemarey 5/14/2013 17:55'!
readStreamOn: aFileHandle do: aBlock
	"Get a read stream on the file handle and execute some actions on it."
	^ aFileHandle readStreamDo: aBlock! !

!MetacelloPharo30Platform class methodsFor: 'initialize-release' stamp: 'ChristopheDemarey 4/29/2013 14:22'!
initialize
  self select

! !

!MetacelloPharoCommonPlatform commentStamp: '<historical>'!
MetacelloPharoPlatform contains all Pharo specific code to load Metacello.!
!MetacelloPharoCommonPlatform methodsFor: 'attributes' stamp: 'ChristopheDemarey 4/30/2013 09:24'!
defaultPlatformAttributes
	| attributes versionString |
	((Smalltalk respondsTo: #image) and: [ Smalltalk image respondsTo: #metacelloPlatformAttributes ])
		ifTrue: [ ^ Smalltalk image metacelloPlatformAttributes ].
	attributes := OrderedCollection with: #squeakCommon with: #pharo.
	Smalltalk
		at: #SystemVersion
		ifPresent: [ :cl | 
			versionString := cl current version.
			(((versionString beginsWith: 'Pharo-1') or: [ versionString beginsWith: 'PharoCore1' ])
				or: [ versionString beginsWith: 'Pharo1' ])
				ifTrue: [ 
					attributes add: #'pharo1.x'.
					((versionString beginsWith: 'Pharo-1.0') or: [ versionString beginsWith: 'PharoCore1.0' ])
						ifTrue: [ attributes add: #'pharo1.0.x' ]
						ifFalse: [ 
							((versionString beginsWith: 'Pharo-1.1') or: [ versionString beginsWith: 'Pharo1.1' ])
								ifTrue: [ attributes add: #'pharo1.1.x' ]
								ifFalse: [ 
									((versionString beginsWith: 'Pharo-1.2') or: [ versionString beginsWith: 'Pharo1.2' ])
										ifTrue: [ attributes add: #'pharo1.2.x' ]
										ifFalse: [ 
											(versionString beginsWith: 'Pharo1.3')
												ifTrue: [ attributes add: #'pharo1.3.x' ] ] ] ] ] ].
	^ attributes! !

!MetacelloPharoCommonPlatform methodsFor: 'utilities' stamp: 'ChristopheDemarey 4/30/2013 09:23'!
authorName

	^Author fullName! !

!MetacelloPharoCommonPlatform methodsFor: 'notification' stamp: 'ChristopheDemarey 4/30/2013 09:24'!
collection: aCollection do: aBlock displaying: aString

	self bypassProgressBars ifTrue: [ ^super collection: aCollection do: aBlock displaying: aString ].
	aCollection 
		do: aBlock
		displayingProgress: aString! !

!MetacelloPharoCommonPlatform methodsFor: 'repository creation' stamp: 'ChristopheDemarey 4/30/2013 09:24'!
createRepository: aRepositorySpec

	| type |
	type := aRepositorySpec type.
	type = 'ftp'
		ifTrue: [ | description headerSize index host directory |
			description := aRepositorySpec description.
			headerSize := 'ftp://' size.
			index := description indexOf: $/ startingAt: headerSize + 1.
			host := description copyFrom: headerSize + 1 to: index - 1.
			directory := description copyFrom: index + 1 to: description size.
			^ MCFtpRepository
				host: host 
				directory: directory 
				user: aRepositorySpec username
				password: aRepositorySpec password].
	^ super createRepository: aRepositorySpec! !

!MetacelloPharoCommonPlatform methodsFor: 'github support' stamp: 'CamilloBruni 10/15/2013 21:35'!
downloadFile: url to: outputFileName
    "download from <url> into <outputFileName>"

    | in out err proc archive zipfile |
    in := (' -L ' , url) readStream.
    out := FileStream forceNewFileNamed: outputFileName.
    err := FileStream forceNewFileNamed: '/tmp/curl.err'.
    proc := #OSProcess asClass thisOSProcess
        forkJob: '/usr/bin/curl'
        arguments:
            {'-L'.
            url}
        environment: nil
        descriptors: (Array with: nil with: out with: err).
    proc ifNil: [ #OSProcess asClass noAccessorAvailable ].
    [ proc isRunning ] whileTrue: [ (Delay forMilliseconds: 100) wait ].
    out close.
    err close.
    archive := ZipArchive new.
    zipfile := #FileDirectory asClass on: outputFileName.
    zipfile containingDirectory readOnlyFileNamed: zipfile localName do: [ :fileStream | archive readFrom: fileStream ].
    ^ archive! !

!MetacelloPharoCommonPlatform methodsFor: 'utilities' stamp: 'ChristopheDemarey 4/30/2013 09:25'!
timestamp

	^Date today mmddyyyy, ' ',
		((String streamContents: [:s | Time now print24: true on: s]) copyFrom: 1 to: 5)! !

!MetacelloPharoCommonPlatform methodsFor: 'reflection' stamp: 'CamilleTeruel 11/21/2013 12:43'!
copyClass: oldClass as: newName inCategory: newCategoryName
	| copysName class newDefinition |
	copysName := newName asSymbol.
	copysName = oldClass name
		ifTrue: [ ^ oldClass ].
	(Smalltalk includesKey: copysName)
		ifTrue: [ ^ self error: copysName , ' already exists' ].
	newDefinition := oldClass definition copyReplaceAll: '#' , oldClass name asString with: '#' , copysName asString printString.
	newDefinition := newDefinition
		copyReplaceAll: 'category: ' , (SystemOrganization categoryOfElement: oldClass name) asString printString
		with: 'category: ' , newCategoryName printString.
	class := self class compiler evaluate: newDefinition logged: true.
	class class instanceVariableNames: oldClass class instanceVariablesString.
	class copyAllCategoriesFrom: oldClass.
	class class copyAllCategoriesFrom: oldClass class.
	class category: newCategoryName.
	^ class! !

!MetacelloPharoCommonPlatform methodsFor: 'github support' stamp: 'MarcusDenker 10/16/2013 10:39'!
extractRepositoryFrom: zipFile to: directory
    "unzip <zipFile> into <directory>"

    | out err proc errorMessage |
    out := FileStream forceNewFileNamed: '/tmp/zip.out'.
    err := FileStream forceNewFileNamed: '/tmp/zip.err'.
    errorMessage := ''.
    [ 
    proc := #OSProcess asClass thisOSProcess
        forkJob: '/usr/bin/unzip'
        arguments:
            {'-u'.
            zipFile.
            '-d'.
            directory}
        environment: nil
        descriptors: (Array with: nil with: out with: err).
    proc ifNil: [ self noAccessorAvailable ].
    [ proc isRunning ] whileTrue: [ (Delay forMilliseconds: 100) wait ] ]
        ensure: [ 
            out close.
            err close ].
    FileStream
        fileNamed: '/tmp/zip.err'
        do: [ :fileStream | 
            (errorMessage := fileStream contentsOfEntireFile) notEmpty
                ifTrue: [ self error: 'unzip failure: ' , errorMessage printString ] ]! !

!MetacelloPharoCommonPlatform methodsFor: 'utilities' stamp: 'ChristopheDemarey 4/30/2013 09:23'!
authorName: aString

	Author fullName: aString! !

!MetacelloPharoCommonPlatform methodsFor: 'repository creation' stamp: 'ChristopheDemarey 4/30/2013 09:25'!
extractTypeFromDescription: description

	(description beginsWith: 'ftp://') ifTrue: [ ^'ftp' ].
	^super extractTypeFromDescription: description! !

!MetacelloPharoCommonPlatform methodsFor: 'file system' stamp: 'ChristopheDemarey 7/15/2014 16:13'!
tempFileFor: aName suffix: aSuffixString
	^ '/tmp/' , aName , aSuffixString! !

!MetacelloPharoPlatform methodsFor: 'attributes' stamp: 'dkh 9/8/2011 14:48'!
defaultPlatformAttributes
	| attributes versionString |
	((Smalltalk respondsTo: #image) and: [ Smalltalk image respondsTo: #metacelloPlatformAttributes ])
		ifTrue: [ ^ Smalltalk image metacelloPlatformAttributes ].
	attributes := OrderedCollection with: #squeakCommon with: #pharo.
	Smalltalk
		at: #SystemVersion
		ifPresent: [ :cl | 
			versionString := cl current version.
			(((versionString beginsWith: 'Pharo-1') or: [ versionString beginsWith: 'PharoCore1' ])
				or: [ versionString beginsWith: 'Pharo1' ])
				ifTrue: [ 
					attributes add: #'pharo1.x'.
					((versionString beginsWith: 'Pharo-1.0') or: [ versionString beginsWith: 'PharoCore1.0' ])
						ifTrue: [ attributes add: #'pharo1.0.x' ]
						ifFalse: [ 
							((versionString beginsWith: 'Pharo-1.1') or: [ versionString beginsWith: 'Pharo1.1' ])
								ifTrue: [ attributes add: #'pharo1.1.x' ]
								ifFalse: [ 
									((versionString beginsWith: 'Pharo-1.2') or: [ versionString beginsWith: 'Pharo1.2' ])
										ifTrue: [ attributes add: #'pharo1.2.x' ]
										ifFalse: [ 
											(versionString beginsWith: 'Pharo1.3')
												ifTrue: [ attributes add: #'pharo1.3.x' ] ] ] ] ] ].
	^ attributes! !

!MetacelloPharoPlatform methodsFor: 'utilities' stamp: 'dkh 10/7/2009 10:54'!
authorName

	^Author fullName! !

!MetacelloPharoPlatform methodsFor: 'notification' stamp: 'DaleHenrichs 3/11/2010 19:28'!
collection: aCollection do: aBlock displaying: aString

	self bypassProgressBars ifTrue: [ ^super collection: aCollection do: aBlock displaying: aString ].
	aCollection 
		do: aBlock
		displayingProgress: aString! !

!MetacelloPharoPlatform methodsFor: 'repository creation' stamp: 'dkh 12/7/2009 14:48'!
createRepository: aRepositorySpec

	| type |
	type := aRepositorySpec type.
	type = 'ftp'
		ifTrue: [ | description headerSize index host directory |
			description := aRepositorySpec description.
			headerSize := 'ftp://' size.
			index := description indexOf: $/ startingAt: headerSize + 1.
			host := description copyFrom: headerSize + 1 to: index - 1.
			directory := description copyFrom: index + 1 to: description size.
			^ MCFtpRepository
				host: host 
				directory: directory 
				user: aRepositorySpec username
				password: aRepositorySpec password].
	^ super createRepository: aRepositorySpec! !

!MetacelloPharoPlatform methodsFor: 'utilities' stamp: 'dkh 10/7/2009 11:01'!
timestamp

	^Date today mmddyyyy, ' ',
		((String streamContents: [:s | Time now print24: true on: s]) copyFrom: 1 to: 5)! !

!MetacelloPharoPlatform methodsFor: 'notification' stamp: 'EstebanLorenzano 7/19/2013 15:58'!
do: aBlock displaying: aString

	self bypassProgressBars ifTrue: [ ^super do: aBlock displaying: aString ].
	aString
		displayProgressFrom: 0 to: 2
		during: [ :bar |
			bar current: 1.
			RPackageSet withCacheDo: [ aBlock value ].
			bar current: 2 ]! !

!MetacelloPharoPlatform methodsFor: 'reflection' stamp: 'MarcusDenker 8/28/2013 10:46'!
copyClass: oldClass as: newName inCategory: newCategoryName
	| copysName class newDefinition |
	copysName := newName asSymbol.
	copysName = oldClass name
		ifTrue: [ ^ oldClass ].
	(Smalltalk includesKey: copysName)
		ifTrue: [ ^ self error: copysName , ' already exists' ].
	newDefinition := oldClass definition copyReplaceAll: '#' , oldClass name asString with: '#' , copysName asString printString.
	newDefinition := newDefinition
		copyReplaceAll: 'category: ' , (SystemOrganization categoryOfElement: oldClass name) asString printString
		with: 'category: ' , newCategoryName printString.
	class := Smalltalk compiler source:  newDefinition; logged: true; evaluate.
	class class instanceVariableNames: oldClass class instanceVariablesString.
	class copyAllCategoriesFrom: oldClass.
	class class copyAllCategoriesFrom: oldClass class.
	class category: newCategoryName.
	^ class! !

!MetacelloPharoPlatform methodsFor: 'repository creation' stamp: 'dkh 12/7/2009 14:07'!
extractTypeFromDescription: description

	(description beginsWith: 'ftp://') ifTrue: [ ^'ftp' ].
	^super extractTypeFromDescription: description! !

!MetacelloPharoPlatform methodsFor: 'utilities' stamp: 'DaleHenrichs 1/5/2011 16:59'!
authorName: aString

	Author fullName: aString! !

!MetacelloPharoPlatform class methodsFor: 'initialize-release' stamp: 'dkh 8/20/2009 15:33'!
initialize
	"implmented to force initialize on load"
	
	super initialize! !

!MetacelloPlatform methodsFor: 'monticello' stamp: 'dkh 09/23/2013 13:59'!
newVersionForWorkingCopy: aWorkingCopy
  ^ aWorkingCopy newVersion! !

!MetacelloPlatform methodsFor: 'notification' stamp: 'dkh 6/5/2012 19:01:24'!
collection: aCollection do: aBlock displaying: aString

	aCollection do: aBlock! !

!MetacelloPlatform methodsFor: 'repository creation' stamp: 'ChristopheDemarey 4/29/2013 13:22'!
createRepository: aRepositorySpec
    | type |
    type := aRepositorySpec type.
    type = 'http'
        ifTrue: [ 
            ^ MCHttpRepository
                location: aRepositorySpec description
                user: aRepositorySpec username
                password: aRepositorySpec password ].
    type = 'directory'
        ifTrue: [ ^ MCDirectoryRepository new directory:  (self fileHandleOn: aRepositorySpec description) ].
    Smalltalk
        at: #'MCFileTreeRepository'
        ifPresent: [ :cl | 
            type = 'filetree'
                ifTrue: [ 
                    | description headerSize |
                    description := aRepositorySpec description.
                    headerSize := 'filetree://' size.
                    ^ cl new
                        directory:
                             (self fileHandleOn: (aRepositorySpec description copyFrom: headerSize + 1 to: description size)) ] ].
    Smalltalk
        at: #'MCGitHubRepository'
        ifPresent: [ :cl | 
            type = 'github'
                ifTrue: [ ^ cl location: aRepositorySpec description ] ].
    type = 'dictionary'
        ifTrue: [ 
            | description headerSize globalName |
            description := aRepositorySpec description.
            headerSize := 'dictionary://' size.
            globalName := (description copyFrom: headerSize + 1 to: description size) asSymbol.
            ^ Smalltalk
                at: globalName
                ifAbsent: [ 
                    Smalltalk
                        at: globalName
                        put:
                            (MCDictionaryRepository new
                                description: description;
                                yourself) ] ].
    ^ nil! !

!MetacelloPlatform methodsFor: 'github support' stamp: 'dkh 7/7/2012 07:37'!
downloadFile: url to: outputFileName
    "download from <url> into <outputFileName>"

    self subclassResponsibility! !

!MetacelloPlatform methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
bypassGoferLoadUpdateCategories: anObject
	bypassGoferLoadUpdateCategories := anObject! !

!MetacelloPlatform methodsFor: 'file system' stamp: 'ChristopheDemarey 4/29/2013 15:37'!
fileHandleOn: aPath
	"Get an handle on a file."

	^ self fileDirectoryClass on: aPath! !

!MetacelloPlatform methodsFor: 'repository creation' stamp: 'dkh 6/5/2012 19:01:24'!
extractTypeFromDescription: description
    description == nil
        ifTrue: [ ^ nil ].
    ((description beginsWith: '/') or: [ description second = $: ])
        ifTrue: [ ^ 'directory' ].
    (description beginsWith: 'dictionary://')
        ifTrue: [ ^ 'dictionary' ].
    (description beginsWith: 'filetree://')
        ifTrue: [ ^ 'filetree' ].
    (description beginsWith: 'github://')
        ifTrue: [ ^ 'github' ].
    ^ 'http'! !

!MetacelloPlatform methodsFor: 'utilities' stamp: 'dkh 6/5/2012 19:01:24'!
authorName: aString
	"Primarily used for testing"

	self subclassResponsibility! !

!MetacelloPlatform methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
bypassProgressBars

	bypassProgressBars == nil ifTrue: [ bypassProgressBars := false ].
	^ bypassProgressBars! !

!MetacelloPlatform methodsFor: 'file system' stamp: 'ChristopheDemarey 5/29/2013 18:16'!
parentDirectoryOf: aFileHandler
	"Get the parent directory of this file."
	
	^ aFileHandler containingDirectory! !

!MetacelloPlatform methodsFor: 'scripting' stamp: 'dkh 7/23/2012 11:05'!
defaultRepositoryDescription
    ^ 'http://www.squeaksource.com/MetacelloRepository'! !

!MetacelloPlatform methodsFor: 'file system' stamp: 'ChristopheDemarey 5/27/2013 17:42'!
recursiveDelete: aDirectory
	"delete this directory and all children of it"

	^  aDirectory recursiveDelete! !

!MetacelloPlatform methodsFor: 'utilities' stamp: 'ChristopheDemarey 5/31/2013 13:02'!
string: aString includesSubstring: aSubstring
	"abstract String>>includesSubstring: to have the same message on all supported platforms."

	^aString includesSubString: aSubstring! !

!MetacelloPlatform methodsFor: 'user interaction' stamp: 'dkh 6/5/2012 19:01:24'!
confirm: aString
	
	^(Smalltalk hasClassNamed: #UIManager)
		ifTrue: [ (Smalltalk classNamed: #UIManager) default perform: #confirm: with: aString ]
		ifFalse: [
			"throw warning and answer true, if no way to announce"
			Warning signal: aString.
			true ]! !

!MetacelloPlatform methodsFor: 'reflection' stamp: 'dkh 6/5/2012 19:01:24'!
copyClass: oldClass as: newName inCategory: newCategoryName

	self subclassResponsibility! !

!MetacelloPlatform methodsFor: 'as yet unclassified' stamp: 'dkh 07/01/2013 08:49'!
downloadErrorFileNameFor: zipFileName
  ^ '/tmp/curl-' , (zipFileName select: [ :c | c isAlphaNumeric ]) , '.err'! !

!MetacelloPlatform methodsFor: 'caching' stamp: 'dkh 6/5/2012 19:01:24'!
stackCacheFor: cacheName at: key doing: aBlock

	^self stackCacheFor: cacheName cacheClass: Dictionary at: key doing: aBlock! !

!MetacelloPlatform methodsFor: 'file system' stamp: 'ChristopheDemarey 4/29/2013 15:17'!
ensureDirectoryExists: aDirectoryHandle
	"Ensure the directory exists."

	^ aDirectoryHandle assureExistence ; yourself! !

!MetacelloPlatform methodsFor: 'file system' stamp: 'ChristopheDemarey 5/14/2013 18:04'!
readStreamOn: aFileHandle do: aBlock
	"Get a read stream on the file handle and execute some actions on it."
	| stream |
	stream := aFileHandle readStream.
	^ [ aBlock value: stream ] 
		ensure: [ stream close ]! !

!MetacelloPlatform methodsFor: 'attributes' stamp: 'ChristopheDemarey 5/31/2013 14:04'!
defaultPlatformAttributes
	| versionString |
	Smalltalk at: #SystemVersion ifPresent: [:cl |
		versionString := cl current version.
		(versionString beginsWith: 'Pharo')
			ifTrue: [ ^ #(#squeakCommon #pharo ) ].
		(versionString beginsWith: 'Squeak')
			ifTrue: [^ #(#squeakCommon #squeak )].
		"see http://code.google.com/p/metacello/issues/detail?id=146"
		(self string: versionString includesSubstring: 'Pharo')
			ifTrue: [ ^ #(#squeakCommon #pharo ) ].
		(versionString includesSubstring: 'Squeak')
			ifTrue: [^ #(#squeakCommon #squeak )].
		self error: 'Unrecognized version of Squeak/Pharo: ', versionString ].
	^ #(#gemstone )! !

!MetacelloPlatform methodsFor: 'reflection' stamp: 'dkh 6/5/2012 19:01:24'!
globalNamed: globalName

	^Smalltalk at: globalName! !

!MetacelloPlatform methodsFor: 'utilities' stamp: 'dkh 6/5/2012 19:01:24'!
authorName

	Smalltalk at: #Author ifPresent: [:cl | ^cl perform: #initials ].
	^'no developer initials'! !

!MetacelloPlatform methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
bypassGoferLoadUpdateCategories

	bypassGoferLoadUpdateCategories == nil ifTrue: [ bypassGoferLoadUpdateCategories := false ].
	^ bypassGoferLoadUpdateCategories! !

!MetacelloPlatform methodsFor: 'transactions' stamp: 'dkh 6/5/2012 19:01:24'!
transact: aBlock
	"On GemStone, we want to optionally abort before command execution and commit after 
	 common execution. Other plaforms don't need to do anything special.
	 Returning out of block, skips commit."
	
	aBlock value! !

!MetacelloPlatform methodsFor: 'repository creation' stamp: 'dkh 05/08/2013 09:33'!
packageInfoFor: aMCWorkingCopy
  ^ aMCWorkingCopy packageInfo
! !

!MetacelloPlatform methodsFor: 'caching' stamp: 'dkh 6/5/2012 19:01:24'!
primeStackCacheFor: cacheName doing: noArgBlock defaultDictionary: aDictionary

	self deprecated: 'use #primeStackCacheWith:doing:'.
	self 
		useStackCacheDuring: [:dict | | cache |
			cache := dict at: cacheName ifAbsent: [].
			cache == nil
				ifTrue: [ 
					cache := Dictionary new.
					dict at: cacheName put: cache ].
			^noArgBlock value ] 
		defaultDictionary: aDictionary! !

!MetacelloPlatform methodsFor: 'notification' stamp: 'dkh 6/5/2012 19:01:24'!
do: aBlock displaying: aString

	aBlock value! !

!MetacelloPlatform methodsFor: 'system' stamp: 'CamilloBruni 10/15/2013 21:37'!
suspendSystemUpdateEventsDuring: aBlock
	"Wraps call to the system evetn manager to tell it that we want to suspend events during execution of aBlock"
	(Smalltalk at: #SystemChangeNotifier) uniqueInstance doSilently: aBlock! !

!MetacelloPlatform methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
bypassProgressBars: anObject
	bypassProgressBars := anObject! !

!MetacelloPlatform methodsFor: 'file system' stamp: 'ChristopheDemarey 4/29/2013 15:11'!
directoryFromPath: adirectoryPath relativeTo: anotherDirectoryPath
	"Get a handle on the following path: anotherDirectoryPath/adirectoryPath"
	^ anotherDirectoryPath directoryNamed: adirectoryPath! !

!MetacelloPlatform methodsFor: 'github support' stamp: 'dkh 7/7/2012 07:36'!
extractRepositoryFrom: zipFile to: directory
    "unzip <zipFile> into <directory>"

    self subclassResponsibility! !

!MetacelloPlatform methodsFor: 'github support' stamp: 'CamilloBruni 10/15/2013 21:36'!
fileDirectoryClass

	^Smalltalk at: #FileDirectory! !

!MetacelloPlatform methodsFor: 'caching' stamp: 'dkh 6/5/2012 19:01:24'!
stackCacheFor: cacheName cacheClass: cacheClass at: key doing: aBlock

	self 
		useStackCacheDuring: [:dict | | cache |
			cache := dict at: cacheName ifAbsent: [].
			cache ~~ nil
				ifTrue: [ | value hasEntry |
					hasEntry := true.
					value := cache at: key ifAbsent: [ hasEntry := false ].
					hasEntry ifTrue: [ ^value ]]
				ifFalse: [ 
					cache := cacheClass new.
					dict at: cacheName put: cache ].
			^aBlock value: cache ] 
		defaultDictionary: nil! !

!MetacelloPlatform methodsFor: 'caching' stamp: 'dkh 6/5/2012 19:01:24'!
clearCurrentVersionCache
	MetacelloClearStackCacheNotification signal: #(#currentVersion #currentVersionAgainst: #currentVersionInfo)! !

!MetacelloPlatform methodsFor: 'caching' stamp: 'dkh 6/5/2012 19:01:24'!
useStackCacheDuring: aBlock defaultDictionary: defaultDictionary
	| dict |
	dict := MetacelloStackCacheNotification signal.
	dict == nil
		ifTrue: [ 
			dict := defaultDictionary == nil
				ifTrue: [ Dictionary new ]
				ifFalse: [ defaultDictionary ] ].
	[ ^ aBlock value: dict ]
		on: MetacelloStackCacheNotification , MetacelloClearStackCacheNotification
		do: [ :ex | 
			(ex isKindOf: MetacelloStackCacheNotification)
				ifTrue: [ ex resume: dict ].
			(ex isKindOf: MetacelloClearStackCacheNotification)
				ifTrue: [ 
					| keys |
					keys := ex cacheNames.
					keys ifNil: [ keys := dict keys ].
					keys
						do: [ :k | 
							(dict includesKey: k)
								ifTrue: [ 
									| c |
									c := dict at: k.
									c keys do: [ :ck | c removeKey: ck ].
									dict removeKey: k ] ].
					ex resume ] ]! !

!MetacelloPlatform methodsFor: 'utilities' stamp: 'dkh 6/5/2012 19:01:24'!
timestamp

	^DateAndTime now printString! !

!MetacelloPlatform methodsFor: 'file system' stamp: 'ChristopheDemarey 4/29/2013 14:17'!
defaultDirectory
	"Get the image default directory"
	
	^self fileDirectoryClass default! !

!MetacelloPlatform methodsFor: 'tests' stamp: 'dkh 6/5/2012 19:01:24'!
defaultTimeout
	"squeak compatability"
	^60! !

!MetacelloPlatform methodsFor: 'reflection' stamp: 'dkh 6/5/2012 19:01:24'!
globalNamed: globalName ifAbsent: absentBlock

	^Smalltalk at: globalName ifAbsent: absentBlock! !

!MetacelloPlatform methodsFor: 'caching' stamp: 'dkh 6/5/2012 19:01:24'!
primeStackCacheWith: aDictionary doing: noArgBlock

	self 
		useStackCacheDuring: [:dict | ^noArgBlock value ] 
		defaultDictionary: aDictionary! !

!MetacelloPlatform class methodsFor: 'initialize-release' stamp: 'dkh 05/05/2013 13:39'!
initialize
  "noop ... use #select"

! !

!MetacelloPlatform class methodsFor: 'initialize-release' stamp: 'dkh 05/05/2013 13:39'!
select
  Current := self new! !

!MetacelloPlatform class methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
current
	Current
		ifNil: [Current := MetacelloPlatform new].
	^ Current! !

!MetacelloPlatform class methodsFor: 'initialize-release' stamp: 'dkh 05/05/2013 13:39'!
unselect
  MetacelloPlatform current class = self
    ifTrue: [ Current := nil ]! !

!MetacelloPostLoadDirective methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
addTo: aLoaderDirective

	spec postLoadDoIt value ~~ nil ifTrue: [ aLoaderDirective add: self ]! !

!MetacelloPostLoadDirective methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
loadUsing: aLoaderDirective gofer: aGofer

	aLoaderDirective loadPostloadDirective: self.
! !

!MetacelloPostLoadDirective methodsFor: 'printing' stamp: 'dkh 6/8/2012 14:04:22'!
label

	^super label, ' >> ', self spec postLoadDoIt value asString! !

!MetacelloPostLoadDirective methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
title

	^'postload'! !

!MetacelloPostLoadDirective methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
postLoadDo: aBlock

	aBlock value: self! !

!MetacelloPreLoadDirective methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
addTo: aLoaderDirective

	spec preLoadDoIt value ~~ nil ifTrue: [ aLoaderDirective add: self ]! !

!MetacelloPreLoadDirective methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
loadUsing: aLoaderDirective gofer: aGofer

	aLoaderDirective loadPreloadDirective: self.
	! !

!MetacelloPreLoadDirective methodsFor: 'printing' stamp: 'dkh 6/8/2012 14:04:22'!
label

	^super label, ' >> ', self spec preLoadDoIt value asString! !

!MetacelloPreLoadDirective methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
title

	^'preload'! !

!MetacelloPreLoadDirective methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
preLoadDo: aBlock

	aBlock value: self! !

!MetacelloPrePostLoadDirective methodsFor: 'enumerating' stamp: 'dkh 6/8/2012 14:04:22'!
prepostLoadDo: aBlock

	aBlock value: self! !

!MetacelloPrePostLoadDirective methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
evaluateSupplyingAnswers: loadBlock

	| answers |
	(answers := self spec answers) notEmpty
		ifTrue: [ loadBlock valueSupplyingMetacelloAnswers: answers ]
		ifFalse: [ loadBlock value]! !

!MetacelloPrePostLoadDirective methodsFor: 'enumerating' stamp: 'dkh 6/8/2012 14:04:22'!
prepostLoadDirectivesDo: aBlock

	aBlock value: self! !

!MetacelloProject methodsFor: 'spec classes' stamp: 'dkh 6/5/2012 19:01:24'!
baselineOfProjectSpec
    ^ self baselineOfProjectSpecClass for: self! !

!MetacelloProject methodsFor: 'versions' stamp: 'dkh 6/5/2012 19:01:24'!
currentVersion
	| cacheKey cv |
	cacheKey := self configuration class.
	^ MetacelloPlatform current
		stackCacheFor: #currentVersion
		at: cacheKey
		doing: [ :cache | 
			cv := self currentVersionAgainst: nil.
			^ cache at: cacheKey put: cv ]! !

!MetacelloProject methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
platformAttributes

	 ^self projectPlatformAttributes! !

!MetacelloProject methodsFor: 'spec classes' stamp: 'dkh 6/5/2012 19:01:24'!
groupSpec

	^self groupSpecClass for: self! !

!MetacelloProject methodsFor: 'spec classes' stamp: 'dkh 6/5/2012 19:01:24'!
defaultLoaderClass

	^MetacelloSpecLoader! !

!MetacelloProject methodsFor: 'versions' stamp: 'dkh 6/5/2012 19:01:24'!
lastVersion

	| coll |
	coll := (self map values asArray sort: [:a :b | a <= b ]) asOrderedCollection.
	coll isEmpty ifTrue: [ ^nil ].
	^coll last! !

!MetacelloProject methodsFor: 'spec classes' stamp: 'dkh 6/5/2012 19:01:24'!
loaderClass

	loaderClass == nil ifTrue: [ loaderClass := self defaultLoaderClass ].
	^loaderClass! !

!MetacelloProject methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
project

	^self! !

!MetacelloProject methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
projectPlatformAttributes

	| list aBlock |
	list := OrderedCollection new.
	(aBlock := self projectAttributes) ~~ nil 
		ifTrue: [ list addAll: aBlock value ].
	^self defaultPlatformAttributes, list! !

!MetacelloProject methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
errorMap
	^ errorMap! !

!MetacelloProject methodsFor: 'versions' stamp: 'dkh 6/5/2012 19:01:24'!
development

	^self version: #development! !

!MetacelloProject methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
errorMap: anObject
    errorMap ifNil: [ errorMap := Dictionary new ].
    errorMap := anObject! !

!MetacelloProject methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 11/14/2014 23:01'!
gtInspectorVersionsIn: composite
	<gtInspectorPresentationOrder: 40>
	composite list
		title: 'Versions';
		display: #versions! !

!MetacelloProject methodsFor: 'spec classes' stamp: 'dkh 6/5/2012 19:01:24'!
packagesSpecClass

	^MetacelloPackagesSpec! !

!MetacelloProject methodsFor: 'spec classes' stamp: 'dkh 6/5/2012 19:01:24'!
groupSpecClass

	^MetacelloGroupSpec! !

!MetacelloProject methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
lookupVersion: aVersionString ifAbsent: aBlock
    "please use version:...this is a private method"

    ^ self map
        at: aVersionString
        ifAbsent: [ 
            (MetacelloVersionDefinitionError project: self project versionString: aVersionString)
                exception: (self errorMap at: aVersionString ifAbsent: [ ^ aBlock value ]);
                signal ]! !

!MetacelloProject methodsFor: 'scripting' stamp: 'dkh 6/5/2012 19:01:24'!
projectForScriptEngine: aMetacelloScriptEngine unconditionalLoad: aBool
    ^ self subclassResponsibility! !

!MetacelloProject methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
projectAttributes: aList

	projectAttributes := aList! !

!MetacelloProject methodsFor: 'spec classes' stamp: 'dkh 6/5/2012 19:01:24'!
versionSpec

	^self versionSpecClass for: self! !

!MetacelloProject methodsFor: 'versions' stamp: 'dkh 6/5/2012 19:01:24'!
latestVersionMatching: versionPatternString includedBlessings: included excludedBlessings: excludedBlessings

	| excluded |
	excluded := excludedBlessings asSet copy.
	excluded removeAllFoundIn: included.
	^(self map values select: [:version |
		(included isEmpty or: [ included includes: version blessing ]) 
			and: [ (excluded includes: version blessing) not 
				and: [ version versionNumber match: versionPatternString ]]])
		detectMax: [:version | version ]! !

!MetacelloProject methodsFor: 'spec classes' stamp: 'dkh 6/5/2012 19:01:24'!
valueHolderSpecClass

	^MetacelloValueHolderSpec! !

!MetacelloProject methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
pragmaKeywords

	^#(version:attribute: blessing:attribute: description:attribute: required:attribute: groups:attribute: doits:attribute:)! !

!MetacelloProject methodsFor: 'spec classes' stamp: 'dkh 6/5/2012 19:01:24'!
loaderClass: aMetacelloSpecLoader

	loaderClass := aMetacelloSpecLoader! !

!MetacelloProject methodsFor: 'spec classes' stamp: 'dkh 6/5/2012 19:01:24'!
packagesSpec

	^self packagesSpecClass for: self! !

!MetacelloProject methodsFor: 'versions' stamp: 'dkh 6/5/2012 19:01:24'!
hasVersion: versionString

	self version: versionString ifAbsent: [ ^false ].
	^true! !

!MetacelloProject methodsFor: 'versions' stamp: 'dkh 6/5/2012 19:01:24'!
version: aVersionString
    | vrsn |
    aVersionString isSymbol
        ifTrue: [ 
            | symbolicVersionString |
            symbolicVersionString := self symbolicVersionMap
                at: aVersionString
                ifAbsent: [ (MetacelloSymbolicVersionDoesNotExistError project: self project versionString: aVersionString) signal ].
            symbolicVersionString == #'notDefined'
                ifTrue: [ (MetacelloSymbolicVersionNotDefinedError project: self project versionString: aVersionString) signal ].
            ^ self
                lookupVersion: symbolicVersionString
                ifAbsent: [ (MetacelloSymbolicVersionDoesNotExistError project: self project versionString: symbolicVersionString) signal ] ].
    ^ self
        lookupVersion: aVersionString
        ifAbsent: [ (MetacelloVersionDoesNotExistError project: self project versionString: aVersionString) signal ]! !

!MetacelloProject methodsFor: 'versions' stamp: 'dkh 6/5/2012 19:01:24'!
latestVersionMatching: versionPatternString
	"Answer whether the version number of the receiver matches the given pattern string.

	 A Metacello version number is made up of version sequences delimited by the characters $. and $-.
	 The $. introduces a numeric version sequence and $- introduces an alphanumeric version sequence.
	 
	 A version pattern is made up of version pattern match sequences. also delimited by the characters $. 
	 and $-.. Each pattern match sequence is tested against the corresponding version sequence of the 
	 receiver, using the 'standard' pattern matching rules. All sequences must answer true for a match.
	
	 The special pattern sequence '?' is a match for the corresponding version sequence and all subsequent 
	 version sequences. '?' as the version pattern matches all versions. No more version pattern 
	 sequences are permitted once the '?' sequence is used. If used, it is the last version pattern
	 sequence."

	^self 
		latestVersionMatching: versionPatternString 
		includedBlessings: #()
		excludedBlessings: self excludeFromLatestVersion
! !

!MetacelloProject methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
defaultPlatformAttributes

	^ MetacelloPlatform current defaultPlatformAttributes! !

!MetacelloProject methodsFor: 'spec classes' stamp: 'dkh 6/5/2012 19:01:24'!
projectSpecClass
    ^ MetacelloProjectSpec! !

!MetacelloProject methodsFor: 'spec classes' stamp: 'dkh 6/5/2012 19:01:24'!
baselineOfVersionSpecClass
    ^ self subclassResponsibility! !

!MetacelloProject methodsFor: 'spec classes' stamp: 'dkh 6/5/2012 19:01:24'!
loader

	^loader! !

!MetacelloProject methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
symbolicVersionMap: aDictionary

	symbolicVersionMap := aDictionary
				
				! !

!MetacelloProject methodsFor: 'scripting' stamp: 'dkh 6/5/2012 19:01:24'!
projectForScriptEngine: aMetacelloScriptEngine
    ^ self projectForScriptEngine: aMetacelloScriptEngine unconditionalLoad: false! !

!MetacelloProject methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
map
	versionMap ifNil: [ ^ Dictionary new ].
	^ versionMap! !

!MetacelloProject methodsFor: 'loading' stamp: 'dkh 6/5/2012 19:01:24'!
load: aVersionString

	^(self version: aVersionString) load
! !

!MetacelloProject methodsFor: 'spec classes' stamp: 'dkh 6/5/2012 19:01:24'!
versionSpecClass

	^MetacelloVersionSpec! !

!MetacelloProject methodsFor: 'spec classes' stamp: 'dkh 6/5/2012 19:01:24'!
baselineOfProjectSpecClass
    ^ self subclassResponsibility! !

!MetacelloProject methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
map: aDictionary

	versionMap := aDictionary! !

!MetacelloProject methodsFor: 'versions' stamp: 'dkh 6/5/2012 19:01:24'!
latestVersionMatching: versionPatternString includedBlessings: included

	^self 
		latestVersionMatching: versionPatternString 
		includedBlessings: included
		excludedBlessings: self excludeFromLatestVersion
! !

!MetacelloProject methodsFor: 'spec classes' stamp: 'dkh 6/5/2012 19:01:24'!
projectReferenceSpec

	^self projectReferenceSpecClass for: self! !

!MetacelloProject methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
loadType
	"#atomic or #linear"

	loadType == nil ifTrue: [ ^#atomic ].
	^loadType! !

!MetacelloProject methodsFor: 'spec classes' stamp: 'dkh 6/5/2012 19:01:24'!
projectSpec

	^self projectSpecClass for: self! !

!MetacelloProject methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
defaultBlessing

	^#release! !

!MetacelloProject methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/26/2015 15:55'!
spotterForVersionsFor: aStep
	<spotterOrder: 1>
	self flag: #maybeRewriteForDirectStreaming.
	aStep listProcessor
		title: 'Versions';
		allCandidates: [
			(#( stableVersion currentVersion bleedingEdge development ) 
				collect: [ :each | [ self perform: each ] on: Error do: [  nil ] ]) 
				reject: [ :each | each isNil ] ];
		itemName: [ :version | version versionString ];
		filter: GTFilterSubstring;
		wantsToDisplayOnEmptyQuery: true! !

!MetacelloProject methodsFor: 'versions' stamp: 'dkh 6/5/2012 19:01:24'!
latestVersion

	| excluded |
"	self deprecated: 'Please use #stableVersion instead.'.
"	self flag: 'deprecate after version 1.0'.
	excluded := self excludeFromLatestVersion.
	^(self map values select: [:version |  
		(excluded includes: version blessing) not ]) detectMax: [:version | version ]! !

!MetacelloProject methodsFor: 'versions' stamp: 'dkh 6/5/2012 19:01:24'!
version: aVersionString ifAbsent: aBlock

	^[ self version: aVersionString ] on: MetacelloVersionDoesNotExistError do: [:ex | aBlock value ].! !

!MetacelloProject methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
configuration: anObject
	configuration := anObject! !

!MetacelloProject methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
excludeFromLatestVersion

	^#(structural development broken baseline)
! !

!MetacelloProject methodsFor: 'versions' stamp: 'dkh 6/5/2012 19:01:24'!
symbolicVersionSymbols

	^self symbolicVersionMap keys asArray sort: [:a :b | a <= b ]! !

!MetacelloProject methodsFor: 'spec classes' stamp: 'dkh 6/5/2012 19:01:24'!
loader: aLoader

	loader := aLoader! !

!MetacelloProject methodsFor: 'spec classes' stamp: 'dkh 6/5/2012 19:01:24'!
valueHolderSpec

	^self valueHolderSpecClass for: self! !

!MetacelloProject methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
sortedAndFilteredVersions

		^(self map values asArray sort: [:a :b | a >= b ]) select: [:vrsn | (#(structural broken baseline) includes: vrsn blessing) not ].
! !

!MetacelloProject methodsFor: 'versions' stamp: 'dkh 6/22/2012 12:41'!
versionNumberClass: aClass
    versionNumberClass := aClass! !

!MetacelloProject methodsFor: 'versions' stamp: 'dkh 6/5/2012 19:01:24'!
latestVersionMatching: versionPatternString excludedBlessings: excluded

	^self 
		latestVersionMatching: versionPatternString 
		includedBlessings: #()
		excludedBlessings: excluded
! !

!MetacelloProject methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
printOn: aStream
	| label |
	self configuration class printOn: aStream.
	aStream nextPut: $(.
	self versions
		do: [ :vrsn | 
			aStream nextPutAll: vrsn versionString.
			vrsn spec ~~ nil
				ifTrue: [ 
					(label := vrsn spec projectLabel) isEmpty
						ifFalse: [ aStream nextPutAll: ' [' , label , ']' ] ].
			aStream
				nextPut: $,;
				space ].
	aStream nextPut: $)! !

!MetacelloProject methodsFor: 'versions' stamp: 'dkh 6/5/2012 19:01:24'!
currentVersionAgainst: resolvedPackageAndProjectNames
	| cacheKey |
	cacheKey := resolvedPackageAndProjectNames isNil
		ifTrue: [ Array with: self configuration class with: nil ]
		ifFalse: [ Array with: self configuration class with: (resolvedPackageAndProjectNames sort: [ :a :b | a <= b ]) ].
	^ MetacelloPlatform current
		stackCacheFor: #currentVersionAgainst:
		at: cacheKey
		doing: [ :cache | 
			| cv versions latestSomethingLoaded |
			cv := nil.
			versions := self sortedAndFilteredVersions.
			versions
				do: [ :version | 
					| status matchBlock |
					status := resolvedPackageAndProjectNames isNil
						ifTrue: [ version spec isPartiallyCurrent ]
						ifFalse: [ version spec isPartiallyCurrentAgainst: resolvedPackageAndProjectNames ].
					matchBlock := [ :matchStatus | 
					cv := version copy.
					cv versionStatus: matchStatus.
					^ cache at: cacheKey put: cv ].
					status isAllLoadedToSpec: matchBlock.
					status isLoadedToSpec: matchBlock.
					status isLoadedMatchConstraints: matchBlock.
					status
						isSomethingLoaded: [ :matchStatus | 
							latestSomethingLoaded isNil
								ifTrue: [ 
									cv := version copy.
									cv versionStatus: matchStatus.
									latestSomethingLoaded := cv ] ] ].
			latestSomethingLoaded ifNotNil: [ ^ cache at: cacheKey put: latestSomethingLoaded ].
			^ cache at: cacheKey put: nil ]! !

!MetacelloProject methodsFor: 'versions' stamp: 'dkh 6/5/2012 19:01:24'!
bleedingEdge

	^self version: #bleedingEdge! !

!MetacelloProject methodsFor: 'versions' stamp: 'dkh 6/5/2012 19:01:24'!
stableVersion

	^self version: #stable! !

!MetacelloProject methodsFor: 'spec classes' stamp: 'dkh 6/5/2012 19:01:24'!
configurationOfProjectSpecClass
    ^ self subclassResponsibility! !

!MetacelloProject methodsFor: 'spec classes' stamp: 'dkh 6/5/2012 19:01:24'!
projectReferenceSpecClass

	^MetacelloProjectReferenceSpec! !

!MetacelloProject methodsFor: 'spec classes' stamp: 'dkh 6/5/2012 19:01:24'!
configurationOfProjectSpec
    ^ self configurationOfProjectSpecClass for: self! !

!MetacelloProject methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
configuration
	^ configuration! !

!MetacelloProject methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
projectAttributes

	projectAttributes ~~ nil ifTrue: [ ^projectAttributes ].
	^#()! !

!MetacelloProject methodsFor: 'versions' stamp: 'dkh 6/22/2012 12:41'!
versionNumberClass
    versionNumberClass ifNil: [ versionNumberClass := MetacelloVersionNumber ].
    ^ versionNumberClass! !

!MetacelloProject methodsFor: 'versions' stamp: 'dkh 6/5/2012 19:01:24'!
versions

	^self map values asArray sort: [:a :b | a <= b ]! !

!MetacelloProject methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
attributes

	^(OrderedCollection with: #common)
		addAll: self platformAttributes;
		yourself
! !

!MetacelloProject methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
label

	^self configuration class name! !

!MetacelloProject methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
symbolicVersionMap

	^symbolicVersionMap
				
				! !

!MetacelloProject methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
loadType: aSymbol
	"#atomic or #linear"

	loadType := aSymbol! !

!MetacelloProject methodsFor: 'versions' stamp: 'dkh 6/5/2012 19:01:24'!
latestVersion: blessing

	^(self map values select: [:version | blessing = version blessing ]) detectMax: [:version | version ]! !

!MetacelloProject class methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/26/2015 17:54'!
gtExampleMetacelloProject
	<gtExample: 'Metacello project'>
	^ ConfigurationOfGTSpotter project! !

!MetacelloProject class methodsFor: 'instance creation' stamp: 'dkh 6/5/2012 19:01:24'!
on: aConfig

	^self basicNew configuration: aConfig; yourself! !

!MetacelloProject class methodsFor: 'instance creation' stamp: 'dkh 6/5/2012 19:01:24'!
new

	| inst |
	inst := self basicNew.
	^inst configuration: inst; yourself! !

!MetacelloProject class methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
versionConstructorClass
    ^ MetacelloVersionConstructor! !

!MetacelloProjectRefTutorialConfig methodsFor: 'lessons' stamp: 'dkh 3/18/2011 14:15:41'!
lesson10
"   [ see method: #baseline10: #version10: ]
In lesson07 it was obvious that we copied the configuration information from 
MetacelloTutorialConfig and adapted it to our project.

There is a better way.

In #baseline10: we've created a project reference for the Example project.

The #className: specifies the name of the class that contains the project metadata. If 
the class is not present in the image, then we know that we need to load the 
configuration for the project.

The #file: and #repository: specifications give us the information needed to load the 
project metadata from a repository.

Finally, the #versionString: and #loads: tell us which version of the project to load 
and which packages to load from the project.

We've named the project reference 'Example ALL' and in the specification for the 
'Project-Core' package, we've specified that 'Example ALL' is required:

  (MetacelloProjectRefTutorialConfig project version: '1.0') load.

Note that the entire Example project is loaded before 'Project-Core'
"! !

!MetacelloProjectRefTutorialConfig methodsFor: 'versions' stamp: 'dkh 3/18/2011 14:15:41'!
version14: spec 
	<version: '1.4' imports: #('1.4-baseline' )>
	
	spec for: #common do: [
		spec blessing: #beta.
		spec description: 'Add groups and Project-Extra'.

		spec
			project: 'Example Default' with: '1.3';
			project: 'Example Tests' with: '1.3'.
		spec 
			package: 'Project-Core' with: 'Project-Core-anon.2';
			package: 'Project-Tests' with: 'Project-Tests-anon.2';
			package: 'Project-Extra' with: 'Project-Extra-anon.1'.].
! !

!MetacelloProjectRefTutorialConfig methodsFor: 'lessons' stamp: 'dkh 3/18/2011 14:15:41'!
lesson12
"   [ see method: #baseline11: #baseline12: #version12: ]
In #baseline11: there is redundant information for each of the project references. 

In #baseline12: we use the #project:copyFrom:with: method to eliminate the need to 
specify the bulk of the project information twice. 

Evaluate and compare the results of the following expressions:
 
  (MetacelloProjectRefTutorialConfig project version: '1.1') load: 'Project-Core'.
  (MetacelloProjectRefTutorialConfig project version: '1.2') load: 'Project-Core'.

  (MetacelloProjectRefTutorialConfig project version: '1.1') load: 'Project-Tests'.
  (MetacelloProjectRefTutorialConfig project version: '1.2') load: 'Project-Tests'.

"! !

!MetacelloProjectRefTutorialConfig methodsFor: 'baselines' stamp: 'dkh 3/18/2011 14:15:41'!
baseline11: spec 
	<version: '1.1-baseline'>
	
	spec for: #common do: [
		spec blessing: #baseline.
		spec repository: 'http://www.example.com/Project'.

		spec
			project: 'Example Default' with: [
				spec
					className: 'MetacelloTutorialConfig';
					versionString: '1.1';
					loads: #('default' );
					file: 'Metacello-Tutorial';
					repository: 'http://seaside.gemstone.com/ss/metacello' ];
			project: 'Example Tests' with: [
				spec
					className: 'MetacelloTutorialConfig';
					versionString: '1.1';
					loads: #('Tests' );
					file: 'Metacello-Tutorial';
					repository: 'http://seaside.gemstone.com/ss/metacello' ].
		spec 
			package: 'Project-Core' with: [ spec requires: 'Example Default' ];
			package: 'Project-Tests' with: [ 
				spec requires: #('Project-Core' 'Example Tests' ).].].
! !

!MetacelloProjectRefTutorialConfig methodsFor: 'lessons' stamp: 'dkh 3/18/2011 14:15:41'!
lesson14
"   [ see method: #baseline14: #version14: ]
In this lesson we'll cover the querying API for Metacello. The querying API is useful for analyzing the contents and structure of a version.

To start with we'll look at version '1.4' of the MetacelloProjectRefTutorialConfig. You can list the packages in the version:

  (MetacelloProjectRefTutorialConfig project version: '1.4') packages

The list project references:

  (MetacelloProjectRefTutorialConfig project version: '1.4') projects

And the groups:

  (MetacelloProjectRefTutorialConfig project version: '1.4') groups

You can access individual packages/project refs/groups using  the #packageNamed: method. Here you can access the package named: 'Project-Core':

  (MetacelloProjectRefTutorialConfig project version: '1.4') packageNamed: 'Project-Core'

The project reference named 'Example Default':

 (MetacelloProjectRefTutorialConfig project version: '1.4') packageNamed: 'Example Default'

The group named 'Core':

 (MetacelloProjectRefTutorialConfig project version: '1.4') packageNamed: 'Core'

Each of the attributes of the package can be accessed (#requires, #includes, #file, #repository, #preLoadDoIt, and #postLoadDoit). For example:

  ((MetacelloProjectRefTutorialConfig project version: '1.4') packageNamed: 'Project-Core') requires

Each of the attributes of the project can be accessed (#className, #versionString, #operator, #loads, #file, and #repository). For example:

  ((MetacelloProjectRefTutorialConfig project version: '1.4') packageNamed: 'Example Default') repository

Each of the attributes of the group can be accessed (#includes). For example:

  ((MetacelloProjectRefTutorialConfig project version: '1.4') packageNamed: 'default') includes

When looking at the 'Core' group, there is only one package listed:

  (MetacelloProjectRefTutorialConfig project version: '1.4') packageNamed: 'Core'

In the case of the 'Core' group, it is defined in terms of the 'default', which isn't very useful. When looking at the contents of groups you'd like to see the complete list of packages, without having to explicitly expanding each group you encounter. #packagesForSpecNamed: does just that:

  (MetacelloProjectRefTutorialConfig project version: '1.4') packagesForSpecNamed: 'Core'

If you were to load the 'Core' package:

  (MetacelloProjectRefTutorialConfig project version: '1.4') load: 'Core'

You end up seeing the packages from the Example project. If you want to get the list of packages that _would_ be loaded, you can use #allPackagesForSpecNamed:. For example:

  (MetacelloProjectRefTutorialConfig project version: '1.4') allPackagesForSpecNamed: 'Core'

If you use #allPackagesForSpecNamed: with a project refernce name, you'll see the packages that _would_ be loaded:

  (MetacelloProjectRefTutorialConfig project version: '1.4') load: 'Example Default'
  (MetacelloProjectRefTutorialConfig project version: '1.4') allPackagesForSpecNamed: 'Example Default'

You can also send #version to a project reference. This is useful if you want to explicitly walk the tree of projects:

  ((MetacelloProjectRefTutorialConfig project version: '1.4') packageNamed: 'Example Default') version

"! !

!MetacelloProjectRefTutorialConfig methodsFor: 'versions' stamp: 'dkh 3/18/2011 14:15:41'!
version11: spec 
	<version: '1.1' imports: #('1.1-baseline' )>
	
	spec for: #common do: [
		spec blessing: #beta.
		
		spec 
			package: 'Project-Core' with: 'Project-Core-anon.1';
			package: 'Project-Tests' with: 'Project-Tests-anon.1'.].
! !

!MetacelloProjectRefTutorialConfig methodsFor: 'baselines' stamp: 'dkh 3/18/2011 14:15:41'!
baseline14: spec 
	<version: '1.4-baseline' imports: #('1.2-baseline' )>
	
	spec for: #common do: [
		spec description: 'Add groups and Project-Extra, extending 1.2-baseline'.
		spec 
			package: 'Project-Core' with: [ spec includes: 'Project-Extra' ];
			package: 'Project-Extra' with: [ spec requires: 'Project-Core' ].
		spec 
			group: 'default' with: #('Project-Core' 'Project-Extra' );
			group: 'Core' with: #('default' );
			group: 'Tests' with: #('Project-Tests' ).].
! !

!MetacelloProjectRefTutorialConfig methodsFor: 'accessing' stamp: 'dkh 3/18/2011 14:15:41'!
project
	"NOTE: The MetacelloNullRecordingMCSpecLoader is being used to prevent packages
		from being loaded, see MetacelloConfigTemplate>>project for an example #project
		method that loads the package for real"

	^ project ifNil: [ | constructor loader |
		"Construct Metacello project"
		constructor := (Smalltalk at: #MetacelloVersionConstructor) on: self.
		project := constructor project.
		loader := MetacelloNullRecordingMCSpecLoader new.
		loader evalDoits: true.
		project loader: loader.
		project ]! !

!MetacelloProjectRefTutorialConfig methodsFor: 'versions' stamp: 'dkh 3/18/2011 14:15:41'!
version10: spec 
	<version: '1.0' imports: #('1.0-baseline' )>
	
	spec for: #common do: [
		spec blessing: #beta.
		
		spec 
			package: 'Project-Core' with: 'Project-Core-anon.1';
			package: 'Project-Tests' with: 'Project-Tests-anon.1'.].
! !

!MetacelloProjectRefTutorialConfig methodsFor: 'baselines' stamp: 'dkh 3/18/2011 14:15:41'!
baseline10: spec 
	<version: '1.0-baseline'>
	
	spec for: #common do: [
		spec blessing: #baseline.
		spec repository: 'http://www.example.com/Project'.
		spec
			project: 'Example ALL' with: [
				spec
					className: 'MetacelloTutorialConfig';
					versionString: '1.0';
					loads: #('ALL' );
					file: 'MetacelloTutorialConfig';
					repository: 'http://seaside.gemstone.com/ss/metacello' ].
		spec 
			package: 'Project-Core' with: [ spec requires: 'Example ALL' ];
			package: 'Project-Tests' with: [ spec requires: 'Project-Core' ].].
! !

!MetacelloProjectRefTutorialConfig methodsFor: 'lessons' stamp: 'dkh 3/18/2011 14:15:41'!
lesson07
"   [ see method: #baseline07: #version07: ]
NOTE: you should run through the lessons in MetacellTutorialConfig first.

In this configuration we are defining a project that utilizes the packages from the 
Example project (MetacelloTutorialConfig):  'Example-Core', 'Example-AddOn', 
'Example-Tests' and 2 packages specific to the project: 'Project-Core' and 
'Project-Tests':

  (MetacelloProjectRefTutorialConfig project version: '0.7') load.

"! !

!MetacelloProjectRefTutorialConfig methodsFor: 'baselines' stamp: 'dkh 3/18/2011 14:15:41'!
baseline12: spec 
	<version: '1.2-baseline'>
	
	spec for: #common do: [
		spec blessing: #baseline.
		spec repository: 'http://www.example.com/Project'.
		spec
			project: 'Example Default' with: [
				spec
					className: 'MetacelloTutorialConfig';
					versionString: '1.2';
					loads: #('default' );
					file: 'Metacello-Tutorial';
					repository: 'http://seaside.gemstone.com/ss/metacello' ];
			project: 'Example Tests' 
				copyFrom: 'Example Default' 
				with: [ spec loads: #('Tests' ).].
		spec 
			package: 'Project-Core' with: [ spec requires: 'Example Default' ];
			package: 'Project-Tests' with: [ 
				spec requires: #('Project-Core' 'Example Tests' ).].].
! !

!MetacelloProjectRefTutorialConfig methodsFor: 'lessons' stamp: 'dkh 3/18/2011 14:15:41'!
lesson11
"   [ see method: #baseline11: #version11: ]
As is often the case, it is useful to separate the test package from the core packages 
for a project. 

In #baseline11: we've created two project references. The reference named 
'Example Default' loads the 'default' group and the reference named 'Example Tests' 
loads the 'Tests' group.

We then made 'Project-Core' require 'Example Default' and 'Project-Tests' requires 
'Project-Core' and 'Example Tests'.

Now it is possible to load just the core packages:

  (MetacelloProjectRefTutorialConfig project version: '1.1') load: 'Project-Core'.

or the whole enchilada including tests:

  (MetacelloProjectRefTutorialConfig project version: '1.1') load: 'Project-Tests'.

"! !

!MetacelloProjectRefTutorialConfig methodsFor: 'baselines' stamp: 'dkh 3/18/2011 14:15:41'!
baseline07: spec 
	<version: '0.7-baseline'>
	spec
		for: #common
		do: [spec blessing: #baseline.
			spec repository: 'http://www.example.com/Project'.
			spec 
				package: 'Project-Core' with: [
					spec requires: 'Example-Core' ];
				package: 'Project-Tests' with: [
					spec requires: #('Project-Core' 'Example-Tests' )];
				package: 'Example-Core' with: [
					spec repository: 'http://www.example.com/Example'];
				package: 'Example-Tests' with: [
					spec requires: 'Example-Core';
						 repository: 'http://www.example.com/Example'];
				package: 'Example-AddOn' with: [
					spec requires: 'Example-Core';
						 repository: 'http://www.example.com/Example']]! !

!MetacelloProjectRefTutorialConfig methodsFor: 'lessons' stamp: 'dkh 3/18/2011 14:15:41'!
lesson13
"   [ see method: #version13: ]
In #version13: we are importing the '1.2-baseline', but changing the Example project 
version to 1.3, so project versions can be updated in the verson method jus like 
package versions.

Evaluate and compare the results of these expressions:

  (MetacelloProjectRefTutorialConfig project version: '1.2') load: 'Project-Core'.
  (MetacelloProjectRefTutorialConfig project version: '1.3') load: 'Project-Core'.

  (MetacelloProjectRefTutorialConfig project version: '1.2') load: 'Project-Tests'.
  (MetacelloProjectRefTutorialConfig project version: '1.3') load: 'Project-Tests'.

It is worth noting that in version 1.3 of the Example project, the platform-specific
'Example-Platform' was introduced and nothing special had to be done in the project 
reference to get the package included.
 
"! !

!MetacelloProjectRefTutorialConfig methodsFor: 'versions' stamp: 'dkh 3/18/2011 14:15:41'!
version12: spec 
	<version: '1.2' imports: #('1.2-baseline' )>
	
	spec for: #common do: [
		spec blessing: #beta.
		spec 
			package: 'Project-Core' with: 'Project-Core-anon.1';
			package: 'Project-Tests' with: 'Project-Tests-anon.1'.].
! !

!MetacelloProjectRefTutorialConfig methodsFor: 'versions' stamp: 'dkh 3/18/2011 14:15:41'!
version13: spec 
	<version: '1.3' imports: #('1.2-baseline' )>
	
	spec for: #common do: [
		spec blessing: #beta.
		spec description: 'Import functionality from the example project, different packages'.

		spec 
			package: 'Project-Core' with: 'Project-Core-anon.1';
			package: 'Project-Tests' with: 'Project-Tests-anon.1';
			project: 'Example Default' with: '1.3';
			project: 'Example Tests' with: '1.3'].
! !

!MetacelloProjectRefTutorialConfig methodsFor: 'versions' stamp: 'dkh 3/18/2011 14:15:41'!
version07: spec 
	<version: '0.7' imports: #('0.7-baseline' )>
	
	spec for: #common do: [
		spec blessing: #release.
		
		spec 
			package: 'Project-Core' with: 'Project-Core-anon.1';
			package: 'Project-Tests' with: 'Project-Tests-anon.1';
			package: 'Example-Core' with: 'Example-Core-anon.12';
			package: 'Example-Tests' with: 'Example-Tests-anon.3';
			package: 'Example-AddOn' with: 'Example-AddOn-anon.1'.].
! !

!MetacelloProjectRefTutorialConfig class methodsFor: 'accessing' stamp: 'dkh 3/18/2011 14:15:41'!
project

	^self new project! !

!MetacelloProjectRefTutorialConfig class methodsFor: 'private' stamp: 'dkh 3/18/2011 14:15:41'!
ensureMetacello
	"Bootstrap Gofer (if necessary), bootstrap ConfigurationOfMetacello (using old Gofer API), then load the latest 
	version of Metacello itself."

	Smalltalk at: #MetacelloProject ifAbsent: [
		Smalltalk at: #Gofer ifAbsent: [
			"Current version of Gofer from which to bootstrap - as of 1.0-beta.15"
			self bootstrapPackage: 'Gofer-lr.83' from: 'http://seaside.gemstone.com/ss/metacello' ].
		Smalltalk at: #Gofer ifPresent: [:goferClass | | gofer |
			gofer := goferClass new
				url: 'http://seaside.gemstone.com/ss/metacello';
				yourself.
			[ gofer addPackage: 'ConfigurationOfMetacello' ] on: Warning do: [:ex | ex resume ].
			gofer load ].
		"load 'default' group of Metacello"
		(Smalltalk at: #ConfigurationOfMetacello) perform: #load ]! !

!MetacelloProjectRefTutorialConfig class methodsFor: 'metacello tool support' stamp: 'dkh 3/18/2011 14:15:41'!
isMetacelloConfig
	"Answer true and the Metacello tools will operate on you"
	
	^true! !

!MetacelloProjectRefTutorialConfig class methodsFor: 'private' stamp: 'dkh 3/18/2011 14:15:41'!
bootstrapPackage: aString from: aPath 
	| repository version |
	repository := MCHttpRepository
				location: aPath
				user: ''
				password: ''.
	repository
		versionReaderForFileNamed: aString , '.mcz'
		do: [:reader | 
			version := reader version.
			version load.
			version workingCopy repositoryGroup addRepository: repository]! !

!MetacelloProjectReferenceSpec methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
configMethodCascadeOn: aStream member: aMember last: lastCascade indent: indent
    aMember methodUpdateSelector == #'remove:'
        ifTrue: [ aStream nextPutAll: 'removeProject: ' , self name printString ]
        ifFalse: [ 
            self projectReference == nil
                ifTrue: [ ^ self ].
            aStream nextPutAll: self projectLabel , ': ' , self projectName printString , ' '.
            (aMember methodUpdateSelector == #'copy:' and: [ self projectReference hasNonVersionStringField ])
                ifTrue: [ aStream nextPutAll: 'copyFrom: ' , aMember sourceName printString , ' ' ].
            self projectReference configShortCutMethodOn: aStream member: aMember indent: indent + 1 ].
    lastCascade
        ifTrue: [ aStream nextPut: $. ]
        ifFalse: [ 
            aStream
                nextPut: $;;
                cr ]! !

!MetacelloProjectReferenceSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
versionOrNil

	^self projectReference versionOrNil! !

!MetacelloProjectReferenceSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
requires: aCollection

	self shouldNotImplement! !

!MetacelloProjectReferenceSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
resolveToPackagesIn: aVersionSpec visited: visited

	^#()! !

!MetacelloProjectReferenceSpec methodsFor: 'merging' stamp: 'dkh 6/5/2012 19:01:24'!
mergeSpec: anotherSpec

	| newSpec map anotherProjectReference |
	newSpec := super mergeSpec: anotherSpec.
	map := anotherSpec mergeMap.
	(anotherProjectReference := map at: #projectReference) ~~ nil
		ifTrue: [ 
			newSpec projectReference: 
				(newSpec projectReference == nil
					ifTrue: [ anotherProjectReference ]
					ifFalse: [ newSpec projectReference mergeSpec: anotherProjectReference ])].
	^newSpec! !

!MetacelloProjectReferenceSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
loadUsing: aLoader gofer: ignored

	| required |
	required := self resolveToLoadableSpec.
	required loader: aLoader.
	^required load! !

!MetacelloProjectReferenceSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
projectLabel
    ^ self projectReference projectLabel! !

!MetacelloProjectReferenceSpec methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 12/11/2014 06:49'!
gtInspectorProjectsIn: composite
	<gtInspectorPresentationOrder: 40>
	composite list 
		title: 'Projects';
		display: [
			| projects |
			projects := OrderedCollection new.
			self
					projectDo: [:prj | projects add: prj ] 
					packageDo: [:pkg | ] 
					groupDo: [:ignored | ].
			projects ]
! !

!MetacelloProjectReferenceSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
packagesNeedSavingVisited: visitedProjects using: repos into: aCollection
	
	| prjct clsName vrsn |
	prjct := self resolveToLoadableSpec.
	(visitedProjects includes: (clsName := prjct className)) ifTrue: [ ^self ].
	visitedProjects add: clsName.
	(vrsn := self versionOrNil) == nil ifTrue: [ ^self ].
	vrsn spec 
		packagesNeedSavingVisited: visitedProjects 
		into: aCollection! !

!MetacelloProjectReferenceSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
resolveProjectSpec

	^self projectReference! !

!MetacelloProjectReferenceSpec methodsFor: 'merging' stamp: 'dkh 6/5/2012 19:01:24'!
mergeMap

	| map |
	map := super mergeMap.
	map at: #projectReference put: projectReference.
	^map! !

!MetacelloProjectReferenceSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
resolveToAllPackagesIn: aVersionSpec into: packages visited: visited

	(self resolveProjectSpec resolveToAllPackagesIn: aVersionSpec visited: visited) do: [:pkg |
		packages at: pkg put: pkg ]! !

!MetacelloProjectReferenceSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
versionString

	^self projectReference versionString! !

!MetacelloProjectReferenceSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
repositories
    ^ self referencedSpec repositories! !

!MetacelloProjectReferenceSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
projectReference
	^ projectReference! !

!MetacelloProjectReferenceSpec methodsFor: 'merging' stamp: 'dkh 6/5/2012 19:01:24'!
nonOverridable

	^super nonOverridable, #( projectReference )! !

!MetacelloProjectReferenceSpec methodsFor: 'testing' stamp: 'dkh 6/30/2012 13:22'!
hasRepository
    ^ self projectReference hasRepository! !

!MetacelloProjectReferenceSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
updateForSpawnMethod: sourceSpec
	"This means that this spec was used in a baseline and will be used in a version .... drop all information that isn't useful"

	| nm |
	nm := name.
	self projectReference updateForSpawnMethod: sourceSpec.
	super updateForSpawnMethod: sourceSpec.
	name := nm.
! !

!MetacelloProjectReferenceSpec methodsFor: 'loading' stamp: 'dkh 6/5/2012 19:01:24'!
repositorySpecs

	^self repositories map values! !

!MetacelloProjectReferenceSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
updatePackageSpec: updatedSpecs using: anMCLoader
	"Add project copy to updatedSpecs if the current version of the project 
	 is different from the receiver's version"
	
	self projectReference updatePackageSpec: updatedSpecs! !

!MetacelloProjectReferenceSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
projectReference: anObject
	projectReference := anObject! !

!MetacelloProjectReferenceSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
projectName
	^self projectReference name! !

!MetacelloProjectReferenceSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
relativeCurrentVersion

	^self projectReference relativeCurrentVersion! !

!MetacelloProjectReferenceSpec methodsFor: 'visiting' stamp: 'dkh 6/5/2012 19:01:24'!
projectDo: projectBlock packageDo: packageBlock groupDo: groupBlock

	projectBlock value: self! !

!MetacelloProjectReferenceSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
version

	^self projectReference version! !

!MetacelloProjectReferenceSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
includes: aCollection

	self shouldNotImplement! !

!MetacelloProjectReferenceSpec methodsFor: 'merging' stamp: 'dkh 6/5/2012 19:01:24'!
aboutToCopy
    self projectReference className! !

!MetacelloProjectReferenceSpec methodsFor: 'copying' stamp: 'dkh 6/5/2012 19:01:24'!
postCopy

	super postCopy.
	projectReference := projectReference copy.
! !

!MetacelloProjectReferenceSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
repository: aStringOrMetacelloRepositorySpec
    ^ self projectReference repository: aStringOrMetacelloRepositorySpec! !

!MetacelloProjectReferenceSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
referencedSpec

	^self projectReference! !

!MetacelloProjectReferenceSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
versionString: aString

	^self projectReference versionString: aString! !

!MetacelloProjectReferenceSpec methodsFor: 'importing' stamp: 'dkh 6/26/2012 10:48'!
mergeImportLoads: aLoadList
    self projectReference mergeImportLoads: aLoadList! !

!MetacelloProjectReferenceSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
answers: aListOfPairs

	self shouldNotImplement! !

!MetacelloProjectReferenceSpec methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
configMethodOn: aStream indent: indent

	aStream 
		tab: indent; nextPutAll: 'spec '; cr;
		tab: indent + 1; nextPutAll: 'name: ', self name printString; nextPut: $;; cr;
		tab: indent + 1; nextPutAll: 'projectReference: '; nextPut: $[; cr.
	aStream 
		tab: indent + 2; nextPutAll: 'spec'.
	self projectReference ifNotNil: [ self projectReference configMethodBodyOn: aStream indent: indent + 2].
	aStream nextPutAll: ' ].'! !

!MetacelloProjectReferenceSpec methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
resolveToLoadableSpec

	^self resolveProjectSpec resolveToLoadableSpec! !

!MetacelloProjectReferenceSpec class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 00:27'!
gtExampleProjectReferenceSpec
	<gtExample: 'Metacello project reference'>
	^ (ConfigurationOfGTInspectorCore project version: #development) projects anyOne! !

!MetacelloProjectReferenceSpecTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testProjectReferenceSpec
    | projectReference project |
    projectReference := self projectReferenceSpec
        name: 'Project';
        projectReference:
                (project := self projectSpec
                        name: 'Project';
                        className: 'ConfigurationOfProjectA';
                        versionString: #'stable';
                        yourself);
        yourself.
    self assert: projectReference name = 'Project'.
    self assert: projectReference projectName = 'Project'.
    self assert: projectReference projectReference == project.
    self should: [ projectReference includes: #() ] raise: Error.
    self should: [ projectReference requires: #() ] raise: Error.
    self should: [ projectReference answers: #() ] raise: Error.
    projectReference
        projectDo: [ :prjct | self assert: projectReference == prjct ]
        packageDo: [ :ignored | self assert: false ]
        groupDo: [ :ignored | self assert: false ]! !

!MetacelloProjectReferenceSpecTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testProjectReferenceMergeSpec
    | projectReferenceA projectReferenceB projectReference project |
    projectReferenceA := self projectReferenceSpec
        name: 'Project';
        projectReference:
                (self projectSpec
                        name: 'Project';
                        className: 'ConfigurationOfProjectA';
                        versionString: #'stable';
                        yourself);
        yourself.
    projectReferenceB := self projectReferenceSpec
        name: 'Project';
        projectReference:
                (self projectSpec
                        name: 'Project';
                        className: 'ConfigurationOfProjectB';
                        versionString: '1.0';
                        yourself);
        yourself.
    projectReference := projectReferenceA mergeSpec: projectReferenceB.
    self assert: projectReference name = 'Project'.
    self assert: projectReference projectName = 'Project'.
    project := projectReference projectReference.
    self assert: project className = 'ConfigurationOfProjectB'.
    self assert: project versionString = '1.0'! !

!MetacelloProjectRegistration methodsFor: 'accessing' stamp: 'dkh 07/29/2013 10:30'!
projectSpec
  ^ self
    configurationProjectSpecIfPresent: [ :spec | spec ]
    ifAbsent: [ self baselineProjectSpec ]! !

!MetacelloProjectRegistration methodsFor: 'lookup' stamp: 'dkh 7/19/2012 20:58'!
lookupConfigurationSpec
    configurationProjectSpec ifNotNil: [ :spec | ^ spec ].
    ^ baselineProjectSpec! !

!MetacelloProjectRegistration methodsFor: 'mutability' stamp: 'dkh 7/19/2012 15:11'!
immutable
    mutable := false! !

!MetacelloProjectRegistration methodsFor: 'testing' stamp: 'dkh 7/18/2012 11:39'!
canDowngradeTo: aProjectRegistration
    "true if there are no load conflicts
        OR
       if the load conflicts involved two cofigurations ONLY and a downgrade is allowed"

    (self hasLoadConflicts: aProjectRegistration)
        ifFalse: [ ^ true ].
    configurationProjectSpec
        ifNotNil: [ 
            aProjectRegistration configurationProjectSpec
                ifNotNil: [ 
                    configurationProjectSpec ensureProjectLoaded.
                    ^ configurationProjectSpec canDowngradeTo: aProjectRegistration configurationProjectSpec ] ].
    ^ false! !

!MetacelloProjectRegistration methodsFor: 'accessing' stamp: 'dkh 7/19/2012 16:03'!
projectName: anObject
    self shouldBeMutable.
    projectName := anObject! !

!MetacelloProjectRegistration methodsFor: 'accessing' stamp: 'dkh 07/24/2012 17:49'!
baselineProjectSpecIfPresent: presentBlock ifAbsent: absentBlock
     ^ baselineProjectSpec ifNotNil: [ presentBlock cull: baselineProjectSpec ]  ifNil: absentBlock
! !

!MetacelloProjectRegistration methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
configurationProjectSpecIfAbsent: absentBlock
    ^ configurationProjectSpec ifNil: absentBlock! !

!MetacelloProjectRegistration methodsFor: 'accessing' stamp: 'dkh 7/19/2012 16:03'!
loadedInImage: anObject
    self shouldBeMutable.
    loadedInImage := anObject! !

!MetacelloProjectRegistration methodsFor: 'querying' stamp: 'dkh 6/24/2012 13:57'!
currentlyLoadedClassesInProject
    | classes |
    classes := Set new.
    self
        configurationProjectSpecIfPresent: [ :spec | classes addAll: spec currentlyLoadedClassesInVersion ]
        ifAbsent: [  ].
    self baselineProjectSpecIfPresent: [ :spec | classes addAll: spec currentlyLoadedClassesInVersion ] ifAbsent: [  ].
    ^ classes! !

!MetacelloProjectRegistration methodsFor: 'mutability' stamp: 'dkh 7/19/2012 15:11'!
mutable
    mutable := true! !

!MetacelloProjectRegistration methodsFor: 'registration' stamp: 'dkh 7/19/2012 11:25'!
registerProject
    "unconditionally register <newRegistration> ... use with care"

    self class registry registerProjectRegistration: self! !

!MetacelloProjectRegistration methodsFor: 'registration' stamp: 'dkh 7/19/2012 11:33'!
unregisterProject
    self class registry unregisterProjectRegistration: self! !

!MetacelloProjectRegistration methodsFor: 'accessing' stamp: 'dkh 07/26/2013 15:55'!
baselineProjectSpec
  "only one of baselineProjectSpec or configurationProjectSpec should ever be set"

  ^ baselineProjectSpec! !

!MetacelloProjectRegistration methodsFor: 'accessing' stamp: 'dkh 07/26/2013 16:01'!
baselineProjectSpec: anObject
  "only one of baselineProjectSpec or configurationProjectSpec should ever be set"

  self shouldBeMutable.
  baselineProjectSpec := anObject! !

!MetacelloProjectRegistration methodsFor: 'printing' stamp: 'dkh 6/30/2012 14:24'!
printOn: aStream
    | label versionString descriptions |
    self
        configurationProjectSpecIfPresent: [ :spec | 
            label := spec className.
            versionString := spec versionString ]
        ifAbsent: [ 
            "baseline"
            label := self baselineProjectSpec className.
            versionString := '[baseline]' ].
    aStream
        nextPutAll: label;
        space;
        nextPutAll: versionString.
    (descriptions := self repositoryDescriptions) isEmpty
        ifTrue: [ ^ self ].
    aStream nextPutAll: ' from '.
    descriptions size = 1
        ifTrue: [ aStream nextPutAll: descriptions first ]
        ifFalse: [ 
            aStream nextPut: ${.
            descriptions do: [ :description | aStream nextPutAll: description ].
            aStream nextPut: $} ]! !

!MetacelloProjectRegistration methodsFor: 'testing' stamp: 'dkh 7/19/2012 21:03'!
canUpgradeTo: aProjectRegistration
    "true if there are no load conflicts
        OR
       if the load conflicts involved two cofigurations ONLY and an upgrade is allowed"

    (self hasLoadConflicts: aProjectRegistration)
        ifFalse: [ ^ true ].
    configurationProjectSpec
        ifNotNil: [ 
            aProjectRegistration configurationProjectSpec
                ifNotNil: [ 
                    configurationProjectSpec copy ensureProjectLoaded.
                    ^ configurationProjectSpec canUpgradeTo: aProjectRegistration configurationProjectSpec ] ].
    ^ false! !

!MetacelloProjectRegistration methodsFor: 'testing' stamp: 'dkh 07/26/2013 16:05'!
isValid
  " has a name and one or the other of the projectSpecs is non-nil"

  "only one of baselineProjectSpec or configurationProjectSpec should ever be set"

  projectName ifNil: [ ^ false ].
  ^ (configurationProjectSpec notNil and: [ baselineProjectSpec isNil ])
    or: [ baselineProjectSpec notNil and: [ configurationProjectSpec isNil ] ]! !

!MetacelloProjectRegistration methodsFor: 'accessing' stamp: 'dkh 07/26/2013 16:01'!
configurationProjectSpec
  "only one of baselineProjectSpec or configurationProjectSpec should ever be set"

  ^ configurationProjectSpec! !

!MetacelloProjectRegistration methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
baselineProjectSpecIfAbsent: absentBlock
    ^ baselineProjectSpec ifNil: absentBlock! !

!MetacelloProjectRegistration methodsFor: 'mutability' stamp: 'dkh 7/19/2012 15:11'!
isMutable
    mutable ifNil: [ ^ true ].
    ^ mutable! !

!MetacelloProjectRegistration methodsFor: 'accessing' stamp: 'dkh 6/30/2012 14:25'!
repositoryDescriptions
    ^ (self configurationProjectSpecIfAbsent: [ self baselineProjectSpec ]) repositoryDescriptions! !

!MetacelloProjectRegistration methodsFor: 'comparision' stamp: 'dkh 6/5/2012 19:01:24'!
hash
    ^ ((String stringHash: projectName initialHash: 0) bitXor: configurationProjectSpec metacelloRegistrationHash)
        bitXor: baselineProjectSpec metacelloRegistrationHash! !

!MetacelloProjectRegistration methodsFor: 'mutability' stamp: 'dkh 7/19/2012 16:06'!
shouldBeMutable
    self isMutable
        ifTrue: [ ^ self ].
    self error: 'Not allowed to modify an immutable object'! !

!MetacelloProjectRegistration methodsFor: 'accessing' stamp: 'dkh 7/16/2012 12:23'!
loadedInImage
    loadedInImage ifNil: [ loadedInImage := false ].
    ^ loadedInImage! !

!MetacelloProjectRegistration methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
projectName
	^ projectName! !

!MetacelloProjectRegistration methodsFor: 'accessing' stamp: 'dkh 6/13/2012 13:52'!
version
    ^ (self configurationProjectSpecIfAbsent: [ ^ MetacelloMCBaselineProject singletonVersionName ]) versionString! !

!MetacelloProjectRegistration methodsFor: 'accessing' stamp: 'dkh 07/24/2012 17:38'!
configurationProjectSpecIfPresent: presentBlock ifAbsent: absentBlock
    ^ configurationProjectSpec ifNotNil: [ presentBlock cull: configurationProjectSpec ]  ifNil: absentBlock! !

!MetacelloProjectRegistration methodsFor: 'lookup' stamp: 'dkh 7/19/2012 20:58'!
lookupBaselineSpec
    baselineProjectSpec ifNotNil: [ :spec | ^ spec ].
    ^ configurationProjectSpec! !

!MetacelloProjectRegistration methodsFor: 'accessing' stamp: 'dkh 6/7/2012 17:37'!
baseName
    ^ MetacelloScriptEngine baseNameOf: (configurationProjectSpec ifNil: [ baselineProjectSpec ]) className! !

!MetacelloProjectRegistration methodsFor: 'accessing' stamp: 'dkh 07/26/2013 16:01'!
configurationProjectSpec: anObject
  "only one of baselineProjectSpec or configurationProjectSpec should ever be set"

  self shouldBeMutable.
  configurationProjectSpec := anObject! !

!MetacelloProjectRegistration methodsFor: 'comparision' stamp: 'dkh 6/5/2012 19:01:24'!
= aRegistration
    aRegistration class == self class
        ifFalse: [ ^ false ].
    ^ (configurationProjectSpec registrationsCompareEqual: aRegistration configurationProjectSpec)
        and: [ baselineProjectSpec registrationsCompareEqual: aRegistration baselineProjectSpec ]! !

!MetacelloProjectRegistration methodsFor: 'copying' stamp: 'dkh 7/19/2012 15:12'!
postCopy
    super postCopy.
    mutable := nil! !

!MetacelloProjectRegistration methodsFor: 'lookup' stamp: 'dkh 05/10/2013 08:28'!
lookupSpec: aProjectSpec
  self configurationProjectSpec
    ifNotNil: [ :spec | 
      spec className = aProjectSpec className
        ifTrue: [ ^ spec ] ].
  self baselineProjectSpec
    ifNotNil: [ :spec | 
      spec className = aProjectSpec className
        ifTrue: [ ^ spec ] ].
  ^ nil! !

!MetacelloProjectRegistration methodsFor: 'accessing' stamp: 'dkh 7/17/2012 12:36'!
locked
    locked ifNil: [ locked := false ].
    ^ locked! !

!MetacelloProjectRegistration methodsFor: 'accessing' stamp: 'dkh 07/26/2013 16:42'!
merge: aProjectRegistration
  " ... merge is done when a spec has been loaded into the image"

  "only one of baselineProjectSpec or configurationProjectSpec should ever be set"

  self shouldBeMutable.
  (self isValid and: [ aProjectRegistration isValid ])
    ifFalse: [ self error: 'Invalid registrations' ].
  aProjectRegistration configurationProjectSpec
    ifNotNil: [ 
      "use aProjectRegistration's configurationProjectSpec and nil my baselineProjectSpec"
      configurationProjectSpec := aProjectRegistration configurationProjectSpec.
      baselineProjectSpec := nil.
      ^ self ].
  aProjectRegistration baselineProjectSpec
    ifNotNil: [ 
      "use aProjectRegistration's baselineProjectSpec and nil my configurationProjectSpec"
      configurationProjectSpec := nil.
      baselineProjectSpec := aProjectRegistration baselineProjectSpec ]! !

!MetacelloProjectRegistration methodsFor: 'mutability' stamp: 'dkh 7/19/2012 16:45'!
copyOnWrite: aBlock
    "assume that only registered projects are immutable ... otherwise you'll get an error"

    | copy |
    self class registry
        registrationFor: self
        ifPresent: [ :existing |  ]
        ifAbsent: [ 
            aBlock value: self.
            ^ self ].
    self unregisterProject.
    copy := self copy.
    aBlock value: copy.
    copy registerProject.
    ^ copy! !

!MetacelloProjectRegistration methodsFor: 'accessing' stamp: 'dkh 7/19/2012 16:03'!
locked: anObject
    self shouldBeMutable.
    locked := anObject! !

!MetacelloProjectRegistration methodsFor: 'testing' stamp: 'dkh 07/28/2013 08:07'!
hasLoadConflicts: aProjectRegistration
  "5 combinations of loads with no load conflicts:
        No configs and baselines =
        configs = and no baselines
        configs = and baselines =
        configs = and no baseline loaded (self) with a baseline to load (aProjectRegistration)
        config loaded (self), no config to load (aProjectRegistration) and no baseline loaded(self) with a baseline to load (aProjectRegistration) "

  self isValid
    ifFalse: [ self error: 'Invalid projectRegistration: ' , self printString ].
  aProjectRegistration isValid
    ifFalse: [ self error: 'Invalid projectRegistration: ' , aProjectRegistration printString ].
  configurationProjectSpec
    ifNil: [ 
      aProjectRegistration configurationProjectSpec notNil
        ifTrue: [ 
          ^ baselineProjectSpec
            hasConflictWithConfiguration:
              aProjectRegistration configurationProjectSpec ] ]
    ifNotNil: [ 
      aProjectRegistration configurationProjectSpec
        ifNotNil: [ 
          (aProjectRegistration configurationProjectSpec
            hasLoadConflicts: configurationProjectSpec)
            ifTrue: [ ^ true ] ] ].
  ^ baselineProjectSpec
    ifNil: [ 
      ^ configurationProjectSpec
        hasConflictWithBaseline: aProjectRegistration baselineProjectSpec ]
    ifNotNil: [ baselineProjectSpec hasLoadConflicts: aProjectRegistration baselineProjectSpec ]! !

!MetacelloProjectRegistration class methodsFor: 'instance creation' stamp: 'dkh 6/5/2012 19:01:24'!
fromMCBaselineProjectSpec: aProjectSpec
    ^ self new
        projectName: aProjectSpec name;
        baselineProjectSpec: aProjectSpec;
        yourself! !

!MetacelloProjectRegistration class methodsFor: 'accessing' stamp: 'dkh 6/13/2012 13:37'!
configurationClasses
    "Return a set of the Metacello configuration classes that have been loaded into the image."

    "self configurationClasses"

    | answer |
    answer := IdentitySet new.
    ConfigurationOf allSubclasses
        do: [ :cl | 
            (cl == BaselineOf or: [ cl inheritsFrom: BaselineOf ])
                ifFalse: [ answer add: cl ] ].
    Object allSubclasses
        do: [ :cl | 
            (answer includes: cl)
                ifFalse: [ 
                    (([ cl isMetacelloConfig ]
                        on: Error
                        do: [ :ex | ex return: false ]) and: [ cl name asString beginsWith: 'ConfigurationOf' ])
                        ifTrue: [ answer add: cl ] ] ].
    ^ answer! !

!MetacelloProjectRegistration class methodsFor: 'registration' stamp: 'dkh 7/19/2012 21:33'!
registerProjectSpec: aProjectSpec ifPresent: presentBlock
    | newRegistration |
    newRegistration := aProjectSpec asProjectRegistration.
    ^ self registry
        registrationFor: newRegistration
        ifPresent: [ :existing | presentBlock value: existing value: newRegistration ]
        ifAbsent: [ newRegistration registerProject ]! !

!MetacelloProjectRegistration class methodsFor: 'accessing' stamp: 'dkh 6/13/2012 13:18'!
baselineClasses
    "Return a set of the Metacello baseline classes that have been loaded into the image."

    "self baselineClasses"

    ^ BaselineOf allSubclasses! !

!MetacelloProjectRegistration class methodsFor: 'accessing' stamp: 'dkh 7/19/2012 11:17'!
registry: aMetacelloProjectRegistry
    Registry := aMetacelloProjectRegistry! !

!MetacelloProjectRegistration class methodsFor: 'accessing' stamp: 'dkh 7/14/2012 07:47'!
projectSpecs
    "MetacelloProjectRegistration projectSpecs"

    ^ self configurationProjectSpecs , self baselineProjectSpecs! !

!MetacelloProjectRegistration class methodsFor: 'querying' stamp: 'dkh 7/19/2012 12:01'!
registrationForProjectSpec: aProjectSpec ifAbsent: absentBlock ifPresent: presentBlock
    | newRegistration |
    newRegistration := aProjectSpec asProjectRegistration.
    self registry
        registrationFor: newRegistration
        ifPresent: [ :existing | ^ presentBlock value: existing value: newRegistration ]
        ifAbsent: [ ^ absentBlock value: newRegistration ]! !

!MetacelloProjectRegistration class methodsFor: 'mutability' stamp: 'dkh 7/20/2012 11:37'!
copyRegistryWhile: aBlock
    "install copy of registry for duration of <aBlock> execution."

    "registrations will be copied on write during <aBlock> execution."

    "Unconditionally revert to the original
	version of the registry. Otherwise leave the new copy installed."

    | oldRegistry newRegistry |
    oldRegistry := self registry.
    newRegistry := self registry copy.
    self registry: newRegistry.
    aBlock
        ensure: [ 
            "install old version of registry"
            self registry: oldRegistry ]! !

!MetacelloProjectRegistration class methodsFor: 'instance creation' stamp: 'dkh 6/5/2012 19:01:24'!
fromMCConfigurationProjectSpec: aProjectSpec
    ^ self new
        projectName: aProjectSpec name;
        configurationProjectSpec: aProjectSpec;
        yourself! !

!MetacelloProjectRegistration class methodsFor: 'accessing' stamp: 'dkh 7/19/2012 11:51'!
primeRegistryFromImage
    "MetacelloProjectRegistration primeRegistryFromImage"

    self registry primeRegistryFromImage! !

!MetacelloProjectRegistration class methodsFor: 'querying' stamp: 'dkh 7/19/2012 12:47'!
registrationForClassNamed: aClassName ifAbsent: absentBlock
    ^ self registry registrationForClassNamed: aClassName ifAbsent: absentBlock! !

!MetacelloProjectRegistration class methodsFor: 'accessing' stamp: 'dkh 7/19/2012 11:17'!
registry
    Registry ifNil: [ Registry := MetacelloProjectRegistry new ].
    ^ Registry! !

!MetacelloProjectRegistration class methodsFor: 'accessing' stamp: 'dkh 7/19/2012 11:18'!
baselineProjectSpecs
    "MetacelloProjectRegistration baselineProjectSpecs"

    ^ self registry baselineProjectSpecs! !

!MetacelloProjectRegistration class methodsFor: 'mutability' stamp: 'dkh 7/20/2012 11:37'!
copyRegistryRestoreOnErrorWhile: aBlock
    "install copy of registry for duration of <aBlock> execution."

    "registrations will be copied on write during <aBlock> execution."

    "if <aBlock> does not return control to this context, revert to the original
	version of the registry. Otherwise leave the new copy installed."

    | oldRegistry newRegistry |
    oldRegistry := self registry.
    newRegistry := self registry copy.
    self registry: newRegistry.
    aBlock
        ensure: [ 
            "install old version of registry"
            self registry: oldRegistry ].
    self registry: newRegistry	"if control returned, install newRegistry"! !

!MetacelloProjectRegistration class methodsFor: 'querying' stamp: 'dkh 7/19/2012 11:34'!
projectSpecForClassNamed: aClassName ifAbsent: absentBlock
    ^ self registry projectSpecForClassNamed: aClassName ifAbsent: absentBlock! !

!MetacelloProjectRegistration class methodsFor: 'accessing' stamp: 'dkh 7/19/2012 11:47'!
configurationProjectSpecs
    "MetacelloProjectRegistration configurationProjectSpecs"

    ^ self registry configurationProjectSpecs! !

!MetacelloProjectRegistration class methodsFor: 'accessing' stamp: 'dkh 7/19/2012 11:52'!
resetRegistry
    Registry := nil! !

!MetacelloProjectRegistry methodsFor: 'querying' stamp: 'dkh 7/19/2012 11:14'!
projectSpecForClassNamed: aClassName ifAbsent: absentBlock
    ^ (self configurationRegistry
        at: aClassName
        ifAbsent: [ ^ (self baselineRegistry at: aClassName ifAbsent: [^absentBlock value]) baselineProjectSpec ])
        configurationProjectSpec! !

!MetacelloProjectRegistry methodsFor: 'accessing' stamp: 'dkh 05/10/2013 16:42'!
isEmpty
  ^ self configurationProjectSpecs isEmpty
    and: [ self baselineProjectSpecs isEmpty ]! !

!MetacelloProjectRegistry methodsFor: 'initialization' stamp: 'dkh 07/29/2013 16:18'!
primeRegistryFromImage: configurationClasses baselineClasses: baselineClasses
  "MetacelloProjectRegistration primeRegistryFromImage"

  baselineClasses
    do: [ :cl | 
      (self baselineRegistry includesKey: cl name asString)
        ifFalse: [ 
          "not registered"
          (self primeRegistryCurrentVersionFor: cl)
            ifNotNil: [ :version | 
              | projectSpec |
              projectSpec := (version project projectSpec
                name: (MetacelloScriptEngine baseNameOf: cl name asString);
                repositories: version project projectPackage repositories copy;
                yourself) asBaselineProjectSpec.
              self primeRegisterLoadedProjectSpec: projectSpec ] ] ].
  configurationClasses
    do: [ :cl | 
      (self configurationRegistry includesKey: cl name asString)
        ifFalse: [ 
          "not registered"
          (self primeRegistryCurrentVersionFor: cl)
            ifNotNil: [ :version | 
              | projectSpec repos projectPackage project |
              project := version project.
              projectPackage := project projectPackage.
              repos := nil.
              projectPackage ~~ nil
                ifTrue: [ repos := projectPackage repositories copy ].
              projectSpec := (version project projectSpec
                name: (MetacelloScriptEngine baseNameOf: cl name asString);
                className: cl name asString;
                versionString: version versionString;
                repositories: repos;
                yourself) asConfigurationProjectSpec.
              self primeRegisterLoadedProjectSpec: projectSpec ] ] ]! !

!MetacelloProjectRegistry methodsFor: 'accessing' stamp: 'dkh 7/19/2012 11:13'!
configurationRegistry
    configurationRegistry ifNil: [ configurationRegistry := Dictionary new ].
    ^ configurationRegistry! !

!MetacelloProjectRegistry methodsFor: 'initialization' stamp: 'dkh 07/27/2013 08:36'!
primeRegisterLoadedProjectSpec: projectSpec
  MetacelloProjectRegistration
    registrationForProjectSpec: projectSpec
    ifAbsent: [ :new | 
      new
        loadedInImage: true;
        registerProject ]
    ifPresent: [ :existing :new | 
      existing
        copyOnWrite: [ :existingCopy | 
          existingCopy loadedInImage: true.
          existing locked
            ifFalse: [ 
              "lock takes precedence when priming from image"
              existingCopy merge: new ] ] ]! !

!MetacelloProjectRegistry methodsFor: 'registration' stamp: 'dkh 7/19/2012 11:33'!
unregisterProjectRegistration: aMetacelloProjectRegistration
    aMetacelloProjectRegistration configurationProjectSpec
        ifNotNil: [ :spec | 
            self configurationRegistry
                removeKey: spec className
                ifAbsent: [ self error: 'unexpectedly missing project registration' ] ].
    aMetacelloProjectRegistration baselineProjectSpec
        ifNotNil: [ :spec | self baselineRegistry removeKey: spec className ifAbsent: [ self error: 'unexpectedly missing project registration' ] ]! !

!MetacelloProjectRegistry methodsFor: 'registration' stamp: 'dkh 7/19/2012 15:27'!
registerProjectRegistration: aMetacelloProjectRegistration
    "unconditionally register <newRegistration> ... use with care"

    aMetacelloProjectRegistration configurationProjectSpec
        ifNotNil: [ :spec | 
            self configurationRegistry
                at: spec className
                ifPresent: [ :existing | 
                    (existing configurationProjectSpec registrationsCompareEqual: spec)
                        ifFalse: [ 
                            Transcript
                                cr;
                                show:
                                        'REGISTRATION OF INCOMPATABLE PROJECTS: ' , existing printString , ' REPLACED BY '
                                                , aMetacelloProjectRegistration printString ] ].
            spec immutable.
            self configurationRegistry at: spec className put: aMetacelloProjectRegistration ].
    aMetacelloProjectRegistration baselineProjectSpec
        ifNotNil: [ :spec | 
            self baselineRegistry
                at: spec className
                ifPresent: [ :existing | 
                    (existing baselineProjectSpec registrationsCompareEqual: spec)
                        ifFalse: [ 
                            Transcript
                                cr;
                                show:
                                        'REGISTRATION OF INCOMPATABLE PROJECTS: ' , existing printString , ' REPLACED BY '
                                                , aMetacelloProjectRegistration printString ] ].
            spec immutable.
            self baselineRegistry at: spec className put: aMetacelloProjectRegistration ].
    aMetacelloProjectRegistration immutable! !

!MetacelloProjectRegistry methodsFor: 'copying' stamp: 'dkh 7/20/2012 11:13'!
postCopy
    super postCopy.
    baselineRegistry := self baselineRegistry copy.
    configurationRegistry := self configurationRegistry copy! !

!MetacelloProjectRegistry methodsFor: 'initialization' stamp: 'dkh 07/29/2013 16:58'!
primeRegistryCurrentVersionFor: cl
  ^ [ cl project currentVersion ]
    on: Error
    do: [ :ex | 
      Warning
        signal:
          'Error finding current version of ' , cl name asString
            , '. Probably an invalid specification.'.
      nil ]! !

!MetacelloProjectRegistry methodsFor: 'initialization' stamp: 'dkh 07/26/2013 07:16'!
primeRegistryFromImage
  "MetacelloProjectRegistration primeRegistryFromImage"

  self
    primeRegistryFromImage: MetacelloProjectRegistration configurationClasses
    baselineClasses: MetacelloProjectRegistration baselineClasses! !

!MetacelloProjectRegistry methodsFor: 'querying' stamp: 'dkh 7/19/2012 12:45'!
registrationForClassNamed: aClassName ifAbsent: absentBlock
    | baseName |
    baseName := MetacelloScriptEngine baseNameOf: aClassName.
    self configurationRegistry at: aClassName ifPresent: [ :registration | ^ registration ].
    self baselineRegistry at: aClassName ifPresent: [ :registration | ^ registration ].
    self configurationRegistry at: 'ConfigurationOf' , baseName ifPresent: [ :registration | ^ registration ].
    self baselineRegistry at: 'BaselineOf' , baseName ifPresent: [ :registration | ^ registration ].
    ^ absentBlock value! !

!MetacelloProjectRegistry methodsFor: 'accessing' stamp: 'dkh 7/19/2012 11:09'!
baselineProjectSpecs
    "MetacelloProjectRegistration baselineProjectSpecs"

    | projectSpecs |
    projectSpecs := OrderedCollection new.
    self baselineRegistry
        keysAndValuesDo: [ :className :registration | projectSpecs add: (self projectSpecForClassNamed: className ifAbsent: [ self error: 'not expected' ]) ].
    ^ projectSpecs asArray! !

!MetacelloProjectRegistry methodsFor: 'accessing' stamp: 'dkh 7/19/2012 11:11'!
baselineRegistry
    baselineRegistry ifNil: [ baselineRegistry := Dictionary new ].
    ^ baselineRegistry! !

!MetacelloProjectRegistry methodsFor: 'accessing' stamp: 'dkh 07/27/2013 08:45'!
registrations
  ^ self baselineRegistry values , self configurationRegistry values! !

!MetacelloProjectRegistry methodsFor: 'registration' stamp: 'dkh 7/19/2012 11:30'!
registrationFor: aMetacelloProjectRegistration ifPresent: presentBlock ifAbsent: absentBlock
    | baseName |
    baseName := aMetacelloProjectRegistration baseName.
    aMetacelloProjectRegistration configurationProjectSpec
        ifNotNil: [ :spec | self configurationRegistry at: spec className ifPresent: [ :existing | ^ presentBlock value: existing ] ].
    aMetacelloProjectRegistration baselineProjectSpec
        ifNotNil: [ :spec | self baselineRegistry at: spec className ifPresent: [ :existing | ^ presentBlock value: existing ] ].
    self configurationRegistry
        at: 'ConfigurationOf' , baseName
        ifPresent: [ :existing | ^ presentBlock value: existing ].
    self baselineRegistry at: 'BaselineOf' , baseName ifPresent: [ :existing | ^ presentBlock value: existing ].
    ^ absentBlock value! !

!MetacelloProjectRegistry methodsFor: 'accessing' stamp: 'dkh 7/19/2012 12:11'!
configurationProjectSpecs
    "MetacelloProjectRegistration configurationProjectSpecs"

    | projectSpecs |
    projectSpecs := OrderedCollection new.
    self configurationRegistry
        keysAndValuesDo: [ :className :registration | projectSpecs add: (self projectSpecForClassNamed: className ifAbsent: [ self error: 'not expected' ]) ].
    ^ projectSpecs asArray! !

!MetacelloProjectRegistry methodsFor: 'accessing' stamp: 'dkh 7/19/2012 11:13'!
projectSpecs
    "MetacelloProjectRegistration projectSpecs"

    ^ self configurationProjectSpecs , self baselineProjectSpecs! !

!MetacelloProjectSpec methodsFor: 'accessing' stamp: 'dkh 9/10/2012 16:05'!
file
    ^ self className! !

!MetacelloProjectSpec methodsFor: 'construction' stamp: 'dkh 6/5/2012 19:01:24'!
loads: anObject constructor: aVersionConstructor
    aVersionConstructor loadsForProject: anObject! !

!MetacelloProjectSpec methodsFor: 'scripting' stamp: 'dkh 07/29/2013 11:18'!
canDowngradeTo: aMetacelloProjectSpec
  (self className = aMetacelloProjectSpec className
    and: [ self operator == aMetacelloProjectSpec operator ])
    ifFalse: [ ^ false ].
  self versionOrNil == nil
    ifTrue: [ 
      "https://github.com/dalehenrich/metacello-work/issues/198#issuecomment-21737458"
      ^ true ].
  ^ (self compareVersions: aMetacelloProjectSpec usingOperator: self operator)
    not! !

!MetacelloProjectSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
getOperator

	^operator! !

!MetacelloProjectSpec methodsFor: 'scripting' stamp: 'dkh 07/13/2013 14:22'!
compareEqual: aMetacelloProjectSpec
  "name className versionString operator loads preLoadDoIt postLoadDoIt"

  ^ self className = aMetacelloProjectSpec className
    and: [ 
      (self compareVersionsEqual: aMetacelloProjectSpec)
        and: [ 
          self operator == aMetacelloProjectSpec operator
            and: [ 
              self loads = aMetacelloProjectSpec loads
                and: [ 
                  self preLoadDoIt value == aMetacelloProjectSpec preLoadDoIt value
                    and: [ self postLoadDoIt value == aMetacelloProjectSpec postLoadDoIt value ] ] ] ] ]! !

!MetacelloProjectSpec methodsFor: 'querying' stamp: 'dkh 6/24/2012 11:39'!
currentlyLoadedClassesInVersion
    self versionOrNil ifNotNil: [ :vrsn | ^ vrsn currentlyLoadedClassesInVersion ].
    ^ #()! !

!MetacelloProjectSpec methodsFor: 'scripting' stamp: 'dkh 7/21/2012 14:12'!
mergeScriptLoads: aSpec
    self shouldBeMutable.
    aSpec loads
        ifNotNil: [ :otherLoads | self loads ifNil: [ loads := otherLoads ] ifNotNil: [ loads := (loads , otherLoads) asSet asArray ] ].
    self loader: aSpec loader! !

!MetacelloProjectSpec methodsFor: 'accessing' stamp: 'dkh 7/19/2012 15:09'!
setPreLoadDoIt: aSymbol
    self shouldBeMutable.
    preLoadDoIt := aSymbol! !

!MetacelloProjectSpec methodsFor: 'construction' stamp: 'dkh 6/5/2012 19:01:24'!
versionString: anObject constructor: aVersionConstructor
    aVersionConstructor versionStringForProject: anObject! !

!MetacelloProjectSpec methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
projectLabel
    ^ 'project'! !

!MetacelloProjectSpec methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 11/23/2014 20:38'!
gtInspectorPackagesIn: composite
	<gtInspectorPresentationOrder: 40>
	self version gtInspectorPackagesIn: composite! !

!MetacelloProjectSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
preLoadDoIt

	^preLoadDoIt! !

!MetacelloProjectSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
getPostLoadDoIt

	^postLoadDoIt! !

!MetacelloProjectSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
postLoadDoIt

	^postLoadDoIt! !

!MetacelloProjectSpec methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 11/23/2014 20:36'!
gtInspectorProjectsIn: composite
	<gtInspectorPresentationOrder: 40>
	self version gtInspectorProjectsIn: composite! !

!MetacelloProjectSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
getRepositories
    "raw access to iv"

    ^ nil! !

!MetacelloProjectSpec methodsFor: 'scripting' stamp: 'dkh 6/5/2012 19:01:24'!
metacelloRegistrationHash
    "name className versionString operator loads preLoadDoIt postLoadDoIt"

    | hash |
    hash := String stringHash: name initialHash: 0.
    hash := String stringHash: self className initialHash: hash.
    hash := String stringHash: self versionString initialHash: hash.
    hash := String stringHash: self operator asString initialHash: hash.
    hash := String stringHash: self preLoadDoIt asString initialHash: hash.
    hash := String stringHash: self postLoadDoIt asString initialHash: hash.
    ^ hash bitXor: loads hash! !

!MetacelloProjectSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
versionString
	^ versionString! !

!MetacelloProjectSpec methodsFor: 'scripting' stamp: 'dkh 7/19/2012 10:19'!
unregisterProject
    ^ MetacelloProjectRegistration
        registrationForProjectSpec: self
        ifAbsent: [  ]
        ifPresent: [ :existing :new | existing unregisterProject ]! !

!MetacelloProjectSpec methodsFor: 'scripting' stamp: 'dkh 07/25/2013 15:43'!
isLocked
  ^ self registration locked! !

!MetacelloProjectSpec methodsFor: 'scripting' stamp: 'dkh 07/29/2013 11:18'!
canUpgradeTo: aMetacelloProjectSpec
  (self className = aMetacelloProjectSpec className
    and: [ self operator == aMetacelloProjectSpec operator ])
    ifFalse: [ ^ false ].
  self versionOrNil == nil
    ifTrue: [ 
      "https://github.com/dalehenrich/metacello-work/issues/198#issuecomment-21737458"
      ^ true ].
  ^ self compareVersions: aMetacelloProjectSpec usingOperator: self operator! !

!MetacelloProjectSpec methodsFor: 'construction' stamp: 'dkh 6/5/2012 19:01:24'!
postLoadDoIt: aSymbol constructor: aVersionConstructor
    aVersionConstructor postLoadDoItForProject: aSymbol! !

!MetacelloProjectSpec methodsFor: 'construction' stamp: 'dkh 6/5/2012 19:01:24'!
className: aString constructor: aVersionConstructor
    aVersionConstructor classNameForProject: aString! !

!MetacelloProjectSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
getFile
    "raw access to iv"

    ^ nil! !

!MetacelloProjectSpec methodsFor: 'testing' stamp: 'dkh 9/10/2012 15:49'!
hasRepository
    ^ false! !

!MetacelloProjectSpec methodsFor: 'printing' stamp: 'dkh 6/30/2012 13:25'!
configShortCutMethodOn: aStream member: aMember indent: indent
    | hasVersionString hasOperator hasProjectPackage hasLoads hasClassName hasPreLoadDoIt hasPostLoadDoIt |
    hasClassName := self hasClassName.
    hasVersionString := self versionString ~~ nil.
    hasOperator := operator ~~ nil.
    hasProjectPackage := self hasRepository or: [ hasClassName & (self getFile ~~ nil or: [ className ~= self name ]) ].
    hasLoads := self loads ~~ nil.
    hasPreLoadDoIt := self getPreLoadDoIt ~~ nil.
    hasPostLoadDoIt := self getPostLoadDoIt ~~ nil.
    hasClassName | hasOperator | hasProjectPackage | hasLoads | hasPreLoadDoIt | hasPostLoadDoIt
        ifTrue: [ 
            (aMember methodUpdateSelector == #'copy:' or: [ aMember methodUpdateSelector == #'with:' ])
                ifTrue: [ 
                    aStream
                        nextPutAll: 'with: [';
                        cr ]
                ifFalse: [ 
                    aStream
                        nextPutAll: 'overrides: [';
                        cr ].
            aStream
                tab: indent;
                nextPutAll: 'spec'.
            self configMethodBodyOn: aStream indent: indent.
            aStream nextPutAll: ' ]'.
            ^ self ].
    hasVersionString
        ifTrue: [ 
            | vs |
            vs := self versionString.
            aStream nextPutAll: 'with: '.
            vs isSymbol
                ifTrue: [ aStream nextPut: $# ].
            aStream nextPutAll: vs asString printString ]! !

!MetacelloProjectSpec methodsFor: 'accessing' stamp: 'dkh 7/19/2012 15:09'!
setPostLoadDoIt: aSymbol
    self shouldBeMutable.
    postLoadDoIt := aSymbol! !

!MetacelloProjectSpec methodsFor: 'construction' stamp: 'dkh 6/5/2012 19:01:24'!
operator: anObject constructor: aVersionConstructor
    aVersionConstructor operatorForProject: anObject! !

!MetacelloProjectSpec methodsFor: 'construction' stamp: 'dkh 6/5/2012 19:01:24'!
name: aString constructor: aVersionConstructor
    aVersionConstructor nameForProject: aString! !

!MetacelloProjectSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
preLoadDoIt: anObject

	anObject setPreLoadDoItInMetacelloSpec: self! !

!MetacelloProjectSpec methodsFor: 'testing' stamp: 'dkh 9/11/2012 09:24'!
hasNonVersionStringField
    | hasVersionString hasOperator hasProjectPackage hasLoads hasClassName hasPreLoadDoIt hasPostLoadDoIt |
    hasClassName := self hasClassName.
    hasVersionString := self versionString ~~ nil.
    hasOperator := operator ~~ nil.
    hasProjectPackage := (self file ~~ nil and: [ hasClassName and: [ self className ~= self name ] ])
        or: [ self hasRepository ].
    hasLoads := self loads ~~ nil.
    hasPreLoadDoIt := self getPreLoadDoIt ~~ nil.
    hasPostLoadDoIt := self getPostLoadDoIt ~~ nil.
    ^ hasClassName | hasOperator | hasProjectPackage | hasLoads | hasPreLoadDoIt | hasPostLoadDoIt! !

!MetacelloProjectSpec methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
constructClassName
    ^ nil! !

!MetacelloProjectSpec methodsFor: 'private' stamp: 'dkh 7/19/2012 16:02'!
setLoads: aCollection
    self shouldBeMutable.
    loads := aCollection! !

!MetacelloProjectSpec methodsFor: 'construction' stamp: 'dkh 6/5/2012 19:01:24'!
preLoadDoIt: aSymbol constructor: aVersionConstructor
    aVersionConstructor preLoadDoItForProject: aSymbol! !

!MetacelloProjectSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
projectPackage

	^nil! !

!MetacelloProjectSpec methodsFor: 'accessing' stamp: 'dkh 7/19/2012 16:03'!
name: aString
    ((aString at: 1) isSeparator or: [ (aString at: aString size) isSeparator ])
        ifTrue: [ self error: 'Names are not allowed to have leading or trailing blanks: ' , aString printString ].
    self shouldBeMutable.
    name := aString! !

!MetacelloProjectSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
postLoadDoIt: anObject

	anObject setPostLoadDoItInMetacelloSpec: self! !

!MetacelloProjectSpec methodsFor: 'accessing' stamp: 'dkh 7/19/2012 15:09'!
versionString: anObject
    self shouldBeMutable.
    versionString := anObject! !

!MetacelloProjectSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
name

	^name! !

!MetacelloProjectSpec methodsFor: 'scripting' stamp: 'dkh 07/13/2013 14:21'!
compareVersionsEqual: aMetacelloProjectSpec
  | vrsn otherVrsn |
  vrsn := self versionOrNil.
  otherVrsn := aMetacelloProjectSpec versionOrNil.
  vrsn ifNil: [ ^ vrsn = otherVrsn ].
  otherVrsn ifNil: [ ^ false ].
  ^ vrsn versionNumber = otherVrsn versionNumber! !

!MetacelloProjectSpec methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
hasClassName
    ^ className ~~ nil! !

!MetacelloProjectSpec methodsFor: 'as yet unclassified' stamp: 'dkh 04/02/2013 20:28'!
hasLoadConflicts: aMetacelloProjectSpec
  ^ (self hasNoLoadConflicts: aMetacelloProjectSpec) not! !

!MetacelloProjectSpec methodsFor: 'printing' stamp: 'dkh 9/10/2012 16:17'!
configMethodBodyOn: aStream indent: indent
    | hasVersionString hasOperator hasProjectPackage hasLoads hasClassName hasPreLoadDoIt hasPostLoadDoIt |
    hasClassName := self hasClassName.
    hasVersionString := self versionString ~~ nil.
    hasOperator := operator ~~ nil.
    hasProjectPackage := self hasRepository or: [ hasClassName & (self getFile ~~ nil) ].
    hasLoads := self loads ~~ nil.
    hasPreLoadDoIt := self getPreLoadDoIt ~~ nil.
    hasPostLoadDoIt := self getPostLoadDoIt ~~ nil.
    hasClassName
        ifTrue: [ 
            hasVersionString | hasOperator | hasProjectPackage | hasLoads
                ifTrue: [ 
                    aStream
                        cr;
                        tab: indent + 1 ]
                ifFalse: [ aStream space ].
            aStream nextPutAll: 'className: ' , self className printString.
            hasVersionString | hasPreLoadDoIt | hasPostLoadDoIt | hasOperator | hasLoads | hasProjectPackage
                ifTrue: [ aStream nextPut: $; ] ].
    hasVersionString
        ifTrue: [ 
            | vs |
            hasClassName | hasOperator | hasProjectPackage | hasLoads | hasPreLoadDoIt | hasPostLoadDoIt
                ifTrue: [ 
                    aStream
                        cr;
                        tab: indent + 1 ]
                ifFalse: [ aStream space ].
            vs := self versionString.
            aStream nextPutAll: 'versionString: '.
            vs isSymbol
                ifTrue: [ aStream nextPut: $# ].
            aStream nextPutAll: vs asString printString.
            hasPreLoadDoIt | hasPostLoadDoIt | hasOperator | hasProjectPackage | hasLoads
                ifTrue: [ aStream nextPut: $; ] ].
    hasPreLoadDoIt
        ifTrue: [ 
            hasClassName | hasOperator | hasProjectPackage | hasLoads | hasPreLoadDoIt
                ifTrue: [ 
                    aStream
                        cr;
                        tab: indent + 1 ]
                ifFalse: [ aStream space ].
            aStream nextPutAll: 'preLoadDoIt: '.
            self preLoadDoIt value isSymbol
                ifTrue: [ 
                    aStream
                        nextPut: $#;
                        nextPutAll: self preLoadDoIt value asString printString ]
                ifFalse: [ aStream nextPutAll: self preLoadDoIt value asString ].
            hasPostLoadDoIt | hasOperator | hasProjectPackage | hasLoads
                ifTrue: [ aStream nextPut: $; ] ].
    hasPostLoadDoIt
        ifTrue: [ 
            hasClassName | hasOperator | hasProjectPackage | hasLoads | hasPostLoadDoIt
                ifTrue: [ 
                    aStream
                        cr;
                        tab: indent + 1 ]
                ifFalse: [ aStream space ].
            aStream nextPutAll: 'postLoadDoIt: '.
            self postLoadDoIt value isSymbol
                ifTrue: [ 
                    aStream
                        nextPut: $#;
                        nextPutAll: self postLoadDoIt value asString printString ]
                ifFalse: [ aStream nextPutAll: self postLoadDoIt value asString ].
            hasOperator | hasProjectPackage | hasLoads
                ifTrue: [ aStream nextPut: $; ] ].
    hasOperator
        ifTrue: [ 
            hasClassName | hasVersionString | hasProjectPackage | hasLoads | hasPreLoadDoIt | hasPostLoadDoIt
                ifTrue: [ 
                    aStream
                        cr;
                        tab: indent + 1 ]
                ifFalse: [ aStream space ].
            aStream nextPutAll: 'operator: #' , self operator asString printString.
            hasProjectPackage | hasLoads
                ifTrue: [ aStream nextPut: $; ] ].
    hasLoads
        ifTrue: [ 
            hasClassName | hasVersionString | hasOperator | hasProjectPackage | hasPreLoadDoIt | hasPostLoadDoIt
                ifTrue: [ 
                    aStream
                        cr;
                        tab: indent + 1 ]
                ifFalse: [ aStream space ].
            aStream nextPutAll: 'loads: #('.
            self loads do: [ :str | aStream nextPutAll: str printString , ' ' ].
            aStream nextPut: $).
            hasProjectPackage
                ifTrue: [ aStream nextPut: $; ] ].
    hasProjectPackage
        ifTrue: [ 
            | hasName hasRepo |
            hasRepo := self hasRepository.
            hasName := self file ~= self className.
            hasName
                ifTrue: [ 
                    hasClassName | hasVersionString | hasOperator | hasLoads | hasPreLoadDoIt | hasPostLoadDoIt
                        ifTrue: [ 
                            aStream
                                cr;
                                tab: indent + 1 ]
                        ifFalse: [ aStream space ].
                    aStream nextPutAll: 'file: ' , self file printString.
                    hasRepo
                        ifTrue: [ aStream nextPut: $; ] ].
            hasRepo
                ifTrue: [ 
                    | repos |
                    repos := self repositories map values.
                    repos size = 1
                        ifTrue: [ 
                            hasClassName | hasVersionString | hasOperator | hasLoads | hasPreLoadDoIt | hasPostLoadDoIt | hasName
                                ifTrue: [ 
                                    aStream
                                        cr;
                                        tab: indent + 1 ]
                                ifFalse: [ aStream space ].
                            repos first configMethodCascadeOn: aStream lastCascade: true ]
                        ifFalse: [ 
                            aStream cr.
                            self repositories configMethodCascadeOn: aStream indent: indent ] ] ]! !

!MetacelloProjectSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
getClassName
    "raw access to iv"

    ^ className! !

!MetacelloProjectSpec methodsFor: 'scripting' stamp: 'dkh 07/13/2013 14:22'!
hasNoLoadConflicts: aMetacelloProjectSpec
  "same as compareEqual:, except if versionString and/or repositories are not 
	specified for either one, then there are not conflicts"

  ^ self className = aMetacelloProjectSpec className
    and: [ 
      ((self versionString == nil or: [ aMetacelloProjectSpec versionString == nil ])
        or: [ self compareVersionsEqual: aMetacelloProjectSpec ])
        and: [ self operator == aMetacelloProjectSpec operator ] ]! !

!MetacelloProjectSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
versionKey
	"suitable for using as a unique key for the receiver's version in a dictionary"

	^ self version versionKey! !

!MetacelloProjectSpec methodsFor: 'adding' stamp: 'dkh 6/5/2012 19:01:24'!
addToMetacelloPackages: aMetacelloPackagesSpec

	| spec |
	spec := (aMetacelloPackagesSpec project projectReferenceSpec)
			name: self name;
			projectReference: self copy;
			yourself.
	aMetacelloPackagesSpec addMember: 
		(aMetacelloPackagesSpec addMember 
			name: spec name;
			spec: spec;
			yourself)
			
! !

!MetacelloProjectSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
loads
	^ loads! !

!MetacelloProjectSpec methodsFor: 'private' stamp: 'dkh 9/11/2012 11:50'!
resolveToLoadableSpec

	^self copy! !

!MetacelloProjectSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
versionOrNil

	^[ self version ] on: MetacelloVersionDoesNotExistError do: [:ex | ^nil ].
! !

!MetacelloProjectSpec methodsFor: 'accessing' stamp: 'dkh 7/19/2012 16:03'!
operator: anObject
    " #= #~= #> #< #>= #<= #~> "

    self shouldBeMutable.
    operator := anObject! !

!MetacelloProjectSpec methodsFor: 'merging' stamp: 'dkh 6/5/2012 19:01:24'!
mergeMap

	| map |
	map := super mergeMap.
	map at: #name put: name.
	map at: #className put: className.
	map at: #versionString put: versionString.
	map at: #operator put: operator.
	map at: #loads put: loads.
	map at: #preLoadDoIt put: preLoadDoIt.
	map at: #postLoadDoIt put: postLoadDoIt.
	^map! !

!MetacelloProjectSpec methodsFor: 'loading' stamp: 'dkh 6/5/2012 19:01:24'!
load

	self subclassResponsibility! !

!MetacelloProjectSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
loads: aCollection

	aCollection setLoadsInMetacelloProject: self! !

!MetacelloProjectSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
operator

	operator == nil ifTrue: [ ^#>= ].
	^ operator! !

!MetacelloProjectSpec methodsFor: 'scripting' stamp: 'dkh 07/29/2013 11:18'!
compareVersions: aMetacelloProjectSpec usingOperator: anOperator
  ^ aMetacelloProjectSpec versionOrNil == nil
    ifTrue: [ 
      "https://github.com/dalehenrich/metacello-work/issues/199#issuecomment-21739622"
      aMetacelloProjectSpec versionString asMetacelloVersionNumber
        perform: anOperator
        with: self version versionNumber ]
    ifFalse: [ ^ aMetacelloProjectSpec version perform: anOperator with: self version ]! !

!MetacelloProjectSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
className
    className ifNil: [ self name ifNotNil: [ self className: self constructClassName ] ].
    ^ className! !

!MetacelloProjectSpec methodsFor: 'visiting' stamp: 'dkh 6/5/2012 19:01:24'!
projectDo: projectBlock packageDo: packageBlock groupDo: groupBlock
    projectBlock value: self! !

!MetacelloProjectSpec methodsFor: 'scripting' stamp: 'dkh 7/17/2012 11:19'!
registration
    ^ MetacelloProjectRegistration
        registrationForProjectSpec: self
        ifAbsent: [ :ignored |  ]
        ifPresent: [ :existing :new | existing ]! !

!MetacelloProjectSpec methodsFor: 'private' stamp: 'dkh 7/19/2012 16:02'!
setName: aStringOrNil
    self shouldBeMutable.
    name := aStringOrNil! !

!MetacelloProjectSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
version
    self subclassResponsibility! !

!MetacelloProjectSpec methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
label

	^self name! !

!MetacelloProjectSpec methodsFor: 'accessing' stamp: 'dkh 7/19/2012 16:03'!
className: aString
    self shouldBeMutable.
    className := aString! !

!MetacelloProjectSpec methodsFor: 'construction' stamp: 'dkh 6/5/2012 19:01:24'!
version: anObject constructor: aVersionConstructor
    aVersionConstructor versionForProject: anObject! !

!MetacelloProjectSpec methodsFor: 'scripting' stamp: 'dkh 6/6/2012 16:05'!
registrationsCompareEqual: aMetacelloProjectSpec
    "name className versionString operator loads preLoadDoIt postLoadDoIt"

    ^ self className = aMetacelloProjectSpec className
        and: [ self versionString = aMetacelloProjectSpec versionString and: [ self operator == aMetacelloProjectSpec operator ] ]! !

!MetacelloProjectSpec methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
loadListForVersion: vrsn 

	^ (self loads == nil
			or: [self loads isEmpty])
		ifTrue: [vrsn spec defaultPackageNames]
		ifFalse: [self loads]! !

!MetacelloProjectSpec methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
configMethodOn: aStream indent: indent

	aStream 
		tab: indent;
		nextPutAll: 'spec '; cr;
		tab: indent + 1;
		nextPutAll: 'name: ', self name printString, ';'.
	self configMethodBodyOn: aStream indent: indent.
	aStream nextPut: $.! !

!MetacelloProjectSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
getPreLoadDoIt

	^preLoadDoIt! !

!MetacelloProjectSpec class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 00:27'!
gtExampleMetacelloSpec
	<gtExample: 'Metacello project reference'>
	^ (ConfigurationOfGTInspectorCore project version: #development) projects anyOne! !

!MetacelloProjectSpecForLoad methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
projectSpec
	^ projectSpec! !

!MetacelloProjectSpecForLoad methodsFor: 'accessing' stamp: 'dkh 6/13/2012 15:40'!
useDetermineVersionForLoad
    useDetermineVersionForLoad ifNil: [ useDetermineVersionForLoad := true ].
    ^ useDetermineVersionForLoad! !

!MetacelloProjectSpecForLoad methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
overrideProjectSpec: anObject
	overrideProjectSpec := anObject! !

!MetacelloProjectSpecForLoad methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
projectSpec: anObject
	projectSpec := anObject! !

!MetacelloProjectSpecForLoad methodsFor: 'operations' stamp: 'dkh 07/10/2013 22:36'!
performCurrentVersionTestAgainst: vrsn operator: anOperator targetVersionStatus: targetVersionStatus using: anMCLoader
  "answer true if the current state of image is to be left as is"

  | currentVersion existing new |
  vrsn ifNil: [ ^ false ].
  self useDetermineVersionForLoad
    ifTrue: [ 
      | prjct cv |
      self hasOverride
        ifTrue: [ 
          self
            error:
              'unexpected logic combination: useDeterminVersionForLoad & hasOverride' ].
      prjct := self projectSpec projectClassProject.
      prjct loader: anMCLoader.
      (cv := prjct currentVersion) == nil
        ifTrue: [ ^ false ].
      (targetVersionStatus includes: cv versionStatus)
        ifTrue: [ ^ cv perform: anOperator with: vrsn ].
      ^ false ].
  (self hasOverride not or: [ targetVersionStatus ~= #(#'allLoadedToSpec') ])
    ifTrue: [ ^ false ].
  (self overrideProjectSpec allPackagesLoaded: anMCLoader)
    ifFalse: [ 
      "roughly equivalent to versionStatus test above (#'allLoadedToSpec')"
      ^ false ].
  (self overrideProjectSpec
    isPartiallyLoaded: self overrideProjectSpec copy loader)
    ifFalse: [ 
      "if the project is not loaded at all"
      ^ false ].
  (currentVersion := self overrideProjectSpec versionOrNil) ifNil: [ ^ false ].
  currentVersion = vrsn
    ifTrue: [ ^ true ].
  existing := self overrideProjectSpec asProjectRegistration.
  new := self projectSpec asProjectRegistration.
  ^ currentVersion > vrsn
    ifTrue: [ 
      "answer false if downgrade allowed"
      (MetacelloAllowProjectDowngrade new
        existingProjectRegistration: existing;
        newProjectRegistration: new;
        signal) == existing ]
    ifFalse: [ 
      "answer false if upgrade allowed"
      (MetacelloAllowProjectUpgrade new
        existingProjectRegistration: existing;
        newProjectRegistration: new;
        signal) == existing ]! !

!MetacelloProjectSpecForLoad methodsFor: 'accessing' stamp: 'dkh 6/13/2012 15:39'!
useDetermineVersionForLoad: anObject
	useDetermineVersionForLoad := anObject! !

!MetacelloProjectSpecForLoad methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
overrideProjectSpec
	^ overrideProjectSpec! !

!MetacelloProjectSpecForLoad methodsFor: 'testing' stamp: 'dkh 6/5/2012 19:01:24'!
hasOverride
    ^ self overrideProjectSpec ~~ nil! !

!MetacelloProjectSpecForLoad methodsFor: 'operations' stamp: 'dkh 6/14/2012 17:39'!
performLoad
    | displayString spec |
    spec := self projectSpec.
    displayString := 'Project: ' , spec name.
    spec versionString ~~ nil
        ifTrue: [ displayString := displayString , ' ' , spec versionString ].
    Transcript
        cr;
        show: displayString.
    self hasOverride
        ifTrue: [ 
            | override |
            override := self overrideProjectSpec copy.
            override mergeScriptLoads: spec.
            override loadVersion: nil ]
        ifFalse: [ 
            spec
                loadVersion:
                    (self useDetermineVersionForLoad
                        ifTrue: [ spec determineCurrentVersionForLoad ]
                        ifFalse: [ spec versionOrNil ]) ]! !

!MetacelloProjectSpecGenerator methodsFor: 'accessing' stamp: 'dkh 7/16/2012 11:27'!
projectSpecLookupBlock
    ^ [ :projectName | 
    {(MetacelloProjectRegistration
        projectSpecForClassNamed: (MetacelloScriptEngine baselineNameFrom: projectName)
        ifAbsent: [  ]).
    (MetacelloProjectRegistration
        projectSpecForClassNamed: (MetacelloScriptEngine configurationNameFrom: projectName)
        ifAbsent: [  ])} ]! !

!MetacelloProjectSpecGenerator methodsFor: 'accessing' stamp: 'dkh 7/16/2012 10:44'!
projectSpecListBlock
    ^ [ MetacelloProjectRegistration projectSpecs ]! !

!MetacelloProjectSpecGenerator methodsFor: 'accessing' stamp: 'dkh 7/16/2012 10:42'!
projectSpecCreationBlock
    ^ [ :projectName | {(MetacelloMCProject new projectSpec name: projectName)} ]! !

!MetacelloProjectSpecGenerator methodsFor: 'accessing' stamp: 'dkh 7/16/2012 10:34'!
target
	^ target! !

!MetacelloProjectSpecGenerator methodsFor: 'accessing' stamp: 'dkh 7/16/2012 10:34'!
target: anObject
	target := anObject! !

!MetacelloProjectSpecLoadConflict methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
possibleVersions
    "not applicable to a Conflict error"

    self shouldNotImplement! !

!MetacelloProjectSpecLoadConflict methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
versionString
    "not applicable to a Conflict error"

    self shouldNotImplement! !

!MetacelloProjectSpecLoadConflict methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
isResumable
	"Determine whether an exception is resumable."

	^ true! !

!MetacelloProjectSpecLoadError methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
projectSpec

	^projectSpec! !

!MetacelloProjectSpecLoadError methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
versionString
    ^ self versionDoesNotExistException versionString! !

!MetacelloProjectSpecLoadError methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
projectSpec: aMetacelloMCProjectSpec

	projectSpec := aMetacelloMCProjectSpec! !

!MetacelloProjectSpecLoadError methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
versionDoesNotExistException
	^ versionDoesNotExistException! !

!MetacelloProjectSpecLoadError methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
versionDoesNotExistException: anObject
	versionDoesNotExistException := anObject! !

!MetacelloProjectSpecLoadError methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
possibleVersions
    ^ self versionDoesNotExistException possibleVersions! !

!MetacelloProjectSpecLoadError methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
isResumable
	"Determine whether an exception is resumable."

	^ false! !

!MetacelloProjectSpecLoadError class methodsFor: 'instance creation' stamp: 'dkh 6/5/2012 19:01:24'!
projectSpec: aMetacelloMCProjectSpec

	^self new
		projectSpec: aMetacelloMCProjectSpec;
		yourself! !

!MetacelloProjectSpecLoadedNotification commentStamp: 'dkh 6/1/2012 09:32'!
**MetacelloLoadProjectSpecVersionNotification** is signalled to indicate that the given project spec was loaded into the image.!
!MetacelloProjectSpecLoadedNotification methodsFor: 'handlers' stamp: 'dkh 6/7/2012 16:19'!
handleResolutionFor: aScriptEngine
    ^ aScriptEngine handleProjectSpecLoaded: self! !

!MetacelloProjectSpecLoadedNotification methodsFor: 'exception description' stamp: 'dkh 6/5/2012 19:01:24'!
defaultAction
    ^ nil! !

!MetacelloProjectSpecTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testProjectSpec
    | project |
    project := self projectSpec.
    project
        name: 'Project';
        className: 'ConfigurationOfProject';
        versionString: '1.0';
        versionString: #'stable';
        operator: #'<';
        operator: nil;
        loads: 'MyPackage';
        loads: #('MyPackage' 'MyTests');
        preLoadDoIt: #'preLoadDoIt';
        postLoadDoIt: #'postLoadDoIt';
        yourself.
    self assert: project name = 'Project'.
    self assert: project className = 'ConfigurationOfProject'.
    self assert: project versionString = #'stable'.
    self assert: project operator == #'>='.
    self assert: project loads = #('MyPackage' 'MyTests').
    self assert: project preLoadDoIt value == #'preLoadDoIt'.
    self assert: project postLoadDoIt value == #'postLoadDoIt'.
    self should: [ project includes: #() ] raise: Error.
    self should: [ project requires: #() ] raise: Error.
    self should: [ project answers: #() ] raise: Error.
    project
        projectDo: [ :prjct | self assert: project == prjct ]
        packageDo: [ :ignored | self assert: false ]
        groupDo: [ :ignored | self assert: false ].
    self should: [ project preLoadDoIt: '' ] raise: Error.
    self should: [ project postLoadDoIt: '' ] raise: Error! !

!MetacelloProjectSpecTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testProjectMergeSpec
    | projectA projectB project |
    projectA := self projectSpec
        name: 'Project';
        className: 'ConfigurationOfProject';
        versionString: '1.0';
        loads: #('MyPackage');
        preLoadDoIt: #'preLoadDoIt';
        postLoadDoIt: #'postLoadDoIt';
        yourself.
    projectB := self projectSpec
        name: 'Project';
        className: 'ConfigurationOfProjectB';
        versionString: #'stable';
        operator: #'<';
        loads: #('MyPackage' 'MyTests');
        preLoadDoIt: #'preLoadDoItB';
        postLoadDoIt: #'postLoadDoItB';
        yourself.
    project := projectA mergeSpec: projectB.
    self assert: project name = 'Project'.
    self assert: project className = 'ConfigurationOfProjectB'.
    self assert: project versionString = #'stable'.
    self assert: project operator == #'<'.
    self assert: project loads = #('MyPackage' 'MyTests').
    self assert: project preLoadDoIt value == #'preLoadDoItB'.
    self assert: project postLoadDoIt value == #'postLoadDoItB'! !

!MetacelloReferenceConfig methodsFor: 'baseline 1.0' stamp: 'dkh 1/26/2012 11:26:02'!
baseline10: spec 
	<version: '1.0-baseline'>
	
	spec for: #common do: [
		"alternate methods for specifying author, blessing, description, timestamp, preLoadDoIt, postLoadDoit (not recommended)"
		spec blessing: [ spec value: #baseline. ].
		spec description: [ spec value: 'Descriptive comment'. ].
		spec author: [ spec value: 'dkh'. ].
		spec timestamp: [ spec value: '10/7/2009 14:40'. ].
		spec timestamp: [ spec value: (DateAndTime fromString: '10/7/2009 14:40'). ].
		"recommended methods for specifying author, blessing, description, timestamp, preLoadDoIt, postLoadDoit"
		"#development, #baseline, #release, #beta, etc."
		spec blessing: #baseline.									
		spec description: 'Descriptive comment'.
		spec author: 'dkh'.
		spec timestamp: (DateAndTime fromString: '10/7/2009 14:40').
		spec timestamp: '10/7/2009 14:40'.
		spec
			"Before loading packages or projects in this version, send #preloadForVersion to an instance of this config"
			preLoadDoIt: #preloadForVersion;
			"After loading packages or projects in this version, send #postloadForVersion to an instance of this config"
			postLoadDoIt: #postloadForVersion.
		spec repository: 'http://www.example.com/rr'.
		spec repository: 'http://www.example.com/private' username: 'foo' password: 'bar'.
		spec repositories: [
			"One or more repositories may be defined (MCReposioryGroup). Previous forms useful when specifying a single reposiory."
			spec 
				"directory-based repositories"
				repository: '/opt/mc/repository';
				repository: 'c:\pharo\myapp\repo\';
				"ftp-based repository ... note, supported in Pharo/Squeak only"					
				repository: 'ftp://ftp.example.com/repo';
				"dictionary-based repository ... repository stored at `Smalltalk at: #GlobalName`"		
				repository: 'dictionary://GlobalName';				
				repository: 'http://www.example.com/rr';
				repository: 'http://www.example.com/ar';
				repository: 'http://www.example.com/private' username: 'foo' password: 'bar' ].
		spec
			"Create or update a project reference named 'UI Support'"
			project: 'UI Support' with: [							
				"One or more of the following attributes may be defined or changed"
				spec
					"OPTIONAL: Name of config class (i.e., ConfigurationOfXXX), if not specified, className is assumed to be the 
					 name of the project prependended with 'ConfigurationOf'"
					className: 'ConfigurationOfUI';
					"Version of project to be loaded. if theversionString is not specified, then the latest version of the project is used."
					versionString: '1.0';
					"Before loading this project, send #preloadForProject to an instance of this config"
					preLoadDoIt: #preloadForProject;
					"After loading this project, send #postloadForProject to an instance of this config"
					postLoadDoIt: #postloadForProject;
					"OPTIONAL: Version comparison operator #= #~= #> #< #>= #<= #~> "
					operator: #~>; 	
					"OPTIONAL: List of packages to be loaded from project"															
					loads: #('UI-Core' );	
					"Optional: Name of package containing the config, by convention same as className"						
					file: 'ConfigurationOfUI';	
					"Repository where package resides"					
					repository: 'http://www.example.com/r' ];	
			"Create a new project reference to replace existing project reference"
			project: 'UI Support' overrides: [					
				"One or more of the following attributes may be defined"
				spec
					className: 'ConfigurationOfUINew';
					versionString: '1.0';
					operator: #>=;
					loads: #('UI-Core' 'UI-Tests' );
					repository: 'http://www.example.com/r' username: 'foo' password: 'bar' ];
			"Create project reference named 'UI Tests'"
		 	project: 'UI Tests' 
				"based on c copy of 'UI Support' project"									
				copyFrom: 'UI Support' 								
				with: [
					"One or more of the following attributes may be changed"
					spec
						className: 'ConfigurationOfUI';
						versionString: '1.0';
						operator: #~>;
						loads: #('UI-Core' 'UI-Tests' );
						repository: 'http://www.example.com/r'];
			"Change the versionString for 'UI Support' to '1.0.1'"
			project: 'UI Support' with: '1.0.1';	
			"Remove the project reference 'UI Tests'"				
			removeProject: 'UI Tests';
			"Multiple repositories for configuration - config may be found in either repository. 
			 Secondary repository is useful when primary repository may not be available"
			project: 'UI Multi' with: [							
				spec
					className: 'ConfigurationOfMulti';
					repository: 'http://www.example.com/r';
					repository: 'http://www.example.com/s' ].
		"Create or update 'Example-AddOn' package"								
		spec 
			package: 'Example-AddOn' with: [						
				"One or more of the following attributes may be defined or changed"
				spec
					"'Example-Core' must be loaded before 'Example-AddOn'" 
					requires: #('Example-Core' );
					"When 'Example-AddOn' is loaded, load 'Example-UI'"				
					includes: #('Example-UI' );
					"Explicitly oad version 'Example-AddOn-anon.3' of the package"					
					file: 'Example-AddOn-anon.3';					
					repositories: [
						spec 
							"Load 'Example-AddOn' from  the 'http://www.example.com/yar'"
							repository: 'http://www.example.com/yar'; 
							"or 'http://www.example.com/yas' repositores" 
							repository: 'http://www.example.com/yas']; 
					"Before loading 'Example-AddOn' send #preloadForAddOn to an instance of this config"
					preLoadDoIt: #preloadForAddOn;
					"After loading 'Example-AddOn' send #postloadForAddOn to an instance of this config"			
					postLoadDoIt: #postloadForAddOn ];
			"Create a new package to replace existing package"			
			package: 'Example-AddOn' overrides: [					
				"One or more of the following attributes may be defined"
				spec 
					requires: #('Example-Core' 'UI Support' );
					includes: #('Example-UI' );
					file: 'Example-AddOn-anon.7';
					supplyingAnswers: #( #('list of packages' 'Kernel* Collection*'));
					repository: 'http://www.example.com/or' username: 'foo' password: 'bar' ;
					preLoadDoIt: #preloadForAddOn;
					postLoadDoIt: #postloadForAddOn ];
			"Change the package version loaded"
			package: 'Example-AddOn' with:'Example-AddOn-anon.5';	
			"Create 'Example-Core' package in project"					
			package: 'Example-Core';								
			package: 'Example-Tests' with: [
				spec requires: #('Example-Core' ) ];
			package: 'Example-TestsUI' with: [
				spec requires: #('Example-UI' ) ];
			package: 'Example-UI' with: [
				spec requires: #('Example-AddOn' ) ];
			"Remove the package 'Example-Tests'"
			removePackage: 'Example-Tests'.						
		spec
			"Create or update the group 'default', adding 'Example-Core' and 'Example-AddOn' to the group."
			group: 'default' 
				with: 	#('Example-Core' 'Example-AddOn' );
			"Create the group 'default' to replace existing group, consisting of 'Example-Core' and 'Example-AddOn'"	
			group: 'default' 
				overrides:  #('Example-Core' 'Example-Tests' );	
			"Remove the group 'default'"
			removeGroup: 'default' ].									
! !

!MetacelloReferenceConfig methodsFor: 'accessing' stamp: 'dkh 1/26/2012 11:26:02'!
project

	^ project ifNil: [ | constructor |
		"Construct Metacello project"
		constructor := (Smalltalk at: #MetacelloVersionConstructor) on: self.
		project := constructor project ]! !

!MetacelloReferenceConfig class methodsFor: 'accessing' stamp: 'dkh 05/07/2013 16:05'!
project
  "force new version as workaround for https://code.google.com/p/smalltalk-hub/issues/detail?id=21"

  ^ self new project! !

!MetacelloRemoveMemberSpec methodsFor: 'actions' stamp: 'dkh 6/5/2012 19:01:24'!
applyAdd: addBlock copy: copyBlock merge: mergeBlock remove: removeBlock

	removeBlock value: self
! !

!MetacelloRemoveMemberSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
methodUpdateSelector

	^#remove:! !

!MetacelloRemoveMemberSpec methodsFor: 'actions' stamp: 'dkh 6/5/2012 19:01:24'!
applyToList: aListSpec

	aListSpec remove: self! !

!MetacelloRepositoriesSpec methodsFor: 'scripting' stamp: 'dkh 6/8/2012 14:04:22'!
metacelloRegistrationHash
    ^ ((self map values sort: [ :a :b | a description <= b description ]) collect: [ :each | each description ]) hash! !

!MetacelloRepositoriesSpec methodsFor: 'scripting' stamp: 'dkh 07/16/2013 19:15'!
hasNoLoadConflicts: aMetacelloProjectSpec
  | repositorySpecs anotherRepositorySpecs |
  repositorySpecs := self map values
    sort: [ :a :b | a description <= b description ].
  anotherRepositorySpecs := aMetacelloProjectSpec map values
    sort: [ :a :b | a description <= b description ].
  repositorySpecs size ~= anotherRepositorySpecs size
    ifTrue: [ ^ false ].
  1 to: repositorySpecs size do: [ :index | 
    | repoSpec anotherRepoSpec |
    repoSpec := repositorySpecs at: index.
    anotherRepoSpec := anotherRepositorySpecs at: index.
    (repoSpec hasNoLoadConflicts: anotherRepoSpec)
      ifFalse: [ ^ false ] ].
  ^ true! !

!MetacelloRepositoriesSpec methodsFor: 'printing' stamp: 'dkh 6/8/2012 14:04:22'!
configMethodCascadeOn: aStream indent: indent

	| repositorySpecs |
	repositorySpecs := self map values sort: [:a :b | a description <= b description ].
	repositorySpecs size = 1
		ifTrue: [ repositorySpecs first configMethodCascadeOn: aStream lastCascade: true ]
		ifFalse: [
			1 to: repositorySpecs size do: [:index | | repositorySpec |
				aStream tab: indent + 1.
				(repositorySpecs at: index)
					configMethodCascadeOn: aStream 
					lastCascade: index >= repositorySpecs size ]]! !

!MetacelloRepositoriesSpec methodsFor: 'scripting' stamp: 'dkh 6/15/2012 13:40'!
compareEqual: aMetacelloProjectSpec
    | repositorySpecs anotherRepositorySpecs |
    repositorySpecs := (self map values sort: [ :a :b | a description <= b description ])
        collect: [ :each | each description ].
    anotherRepositorySpecs := (aMetacelloProjectSpec map values sort: [ :a :b | a description <= b description ])
        collect: [ :each | each description ].
    ^ repositorySpecs = anotherRepositorySpecs! !

!MetacelloRepositoriesSpec methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
add: aStringOrSpec

	aStringOrSpec addToMetacelloRepositories: self! !

!MetacelloRepositoriesSpec methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
merge: aRepositorySpec

	aRepositorySpec mergeIntoMetacelloRepositories: self! !

!MetacelloRepositoriesSpec methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
remove: aRepositorySpec

	aRepositorySpec removeFromMetacelloRepositories: self! !

!MetacelloRepositoriesSpec methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
repository: aStringOrSpec

	aStringOrSpec addToMetacelloRepositories: self! !

!MetacelloRepositoriesSpec methodsFor: 'construction' stamp: 'dkh 6/8/2012 14:04:22'!
repository: aString username: username password: password constructor: aVersionConstructor
    aVersionConstructor repositoryForRepositories: aString username: username password: password! !

!MetacelloRepositoriesSpec methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
repository: description username: username password: password

	| spec |
	spec := 
		(self project repositorySpec)
			description: description;
			username: username;
			password: password;
			yourself.
	self addMember: 
		(self addMember 
			name: spec name;
			spec: spec;
			yourself)! !

!MetacelloRepositoriesSpec methodsFor: 'construction' stamp: 'dkh 6/8/2012 14:04:22'!
repository: anObject constructor: aVersionConstructor
    aVersionConstructor repositoryForRepositories: anObject! !

!MetacelloRepositoriesSpec methodsFor: 'printing' stamp: 'dkh 6/8/2012 14:04:22'!
configMethodOn: aStream indent: indent

	aStream 
		tab: indent; 
		nextPutAll: 'spec';
		cr.
	self configMethodCascadeOn: aStream indent: indent! !

!MetacelloRepositoriesSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testCopyTo
    | repositories |
    repositories := self repositoriesSpec.
    repositories
        add:
            (self repositorySpec
                description: 'http://example.com/repository';
                username: 'dkh';
                password: 'password';
                yourself).
    self
        should: [ 
            repositories
                copy: 'http://example.com/repository'
                to:
                    (self repositorySpec
                        description: 'http://example.com/alternate/repository';
                        yourself) ]
        raise: Error! !

!MetacelloRepositoriesSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testAddE
    | repositories repository |
    repositories := self repositoriesSpec.
    repositories
        repository: 'http://example.com/repository' username: 'dkh' password: 'password';
        repository: '/opt/gemstone/repository'.
    repository := repositories map at: 'http://example.com/repository' ifAbsent: [ self assert: false ].
    self assert: repository description = 'http://example.com/repository'.
    self assert: repository type = 'http'.
    repository := repositories map at: '/opt/gemstone/repository' ifAbsent: [ self assert: false ].
    self assert: repository description = '/opt/gemstone/repository'.
    self assert: repository type = 'directory'! !

!MetacelloRepositoriesSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testAddC
    | repositories repository |
    repositories := self repositoriesSpec.
    repositories add: #('http://example.com/repository' '/opt/gemstone/repository').
    repository := repositories map at: 'http://example.com/repository' ifAbsent: [ self assert: false ].
    self assert: repository description = 'http://example.com/repository'.
    self assert: repository type = 'http'.
    repository := repositories map at: '/opt/gemstone/repository' ifAbsent: [ self assert: false ].
    self assert: repository description = '/opt/gemstone/repository'.
    self assert: repository type = 'directory'! !

!MetacelloRepositoriesSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testAddB
    | repositories repository |
    repositories := self repositoriesSpec.
    repositories
        add:
                (self repositorySpec
                        description: 'http://example.com/repository';
                        username: 'dkh';
                        password: 'password';
                        yourself);
        add: '/opt/gemstone/repository'.
    repository := repositories map at: 'http://example.com/repository' ifAbsent: [ self assert: false ].
    self assert: repository description = 'http://example.com/repository'.
    self assert: repository type = 'http'.
    self assert: repository username = 'dkh'.
    self assert: repository password = 'password'.
    repository := repositories map at: '/opt/gemstone/repository' ifAbsent: [ self assert: false ].
    self assert: repository description = '/opt/gemstone/repository'.
    self assert: repository type = 'directory'! !

!MetacelloRepositoriesSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testAddA
    | repositories repository |
    repositories := self repositoriesSpec.
    repositories
        add:
                (self repositorySpec
                        description: 'http://example.com/repository';
                        username: 'dkh';
                        password: 'password';
                        yourself);
        add:
                (self repositorySpec
                        description: 'http://example.com/repository';
                        username: 'DaleHenrichs';
                        password: 'secret';
                        yourself).
    repository := repositories map at: 'http://example.com/repository' ifAbsent: [ self assert: false ].
    self assert: repository description = 'http://example.com/repository'.
    self assert: repository type = 'http'.
    self assert: repository username = 'DaleHenrichs'.
    self assert: repository password = 'secret'! !

!MetacelloRepositoriesSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testRemoveA
    | repositories removed |
    repositories := self repositoriesSpec.
    repositories
        add:
            (self repositorySpec
                description: 'http://example.com/repository';
                username: 'dkh';
                password: 'password';
                yourself).
    repositories
        remove:
            (self repositorySpec
                description: 'http://example.com/repository';
                yourself).
    removed := false.
    repositories map at: 'http://example.com/repository' ifAbsent: [ removed := true ].
    self assert: removed! !

!MetacelloRepositoriesSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testRemoveB
    | repositories removed |
    repositories := self repositoriesSpec.
    repositories
        add:
            (self repositorySpec
                description: 'http://example.com/repository';
                username: 'dkh';
                password: 'password';
                yourself).
    repositories
        remove:
            {(self repositorySpec
                description: 'http://example.com/repository';
                yourself)}.
    removed := false.
    repositories map at: 'http://example.com/repository' ifAbsent: [ removed := true ].
    self assert: removed! !

!MetacelloRepositoriesSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testAddF
    | repositories repository |
    repositories := self repositoriesSpec.
    repositories
        repository:
                (self repositorySpec
                        description: 'http://example.com/repository';
                        username: 'dkh';
                        password: 'password';
                        yourself);
        repository:
                (self repositorySpec
                        description: 'http://example.com/repository';
                        username: 'DaleHenrichs';
                        password: 'secret';
                        yourself).
    repository := repositories map at: 'http://example.com/repository' ifAbsent: [ self assert: false ].
    self assert: repository description = 'http://example.com/repository'.
    self assert: repository type = 'http'.
    self assert: repository username = 'DaleHenrichs'.
    self assert: repository password = 'secret'! !

!MetacelloRepositoriesSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testMergeC
    | repositories repository |
    repositories := self repositoriesSpec.
    repositories
        add:
                (self repositorySpec
                        description: 'http://example.com/repository';
                        username: 'dkh';
                        password: 'password';
                        yourself);
        merge:
                {(self repositorySpec
                        description: 'http://example.com/repository';
                        password: 'secret';
                        yourself).
                    (self repositorySpec
                        description: 'http://example.com/repository';
                        username: 'DaleHenrichs';
                        yourself)}.
    repository := repositories map at: 'http://example.com/repository' ifAbsent: [ self assert: false ].
    self assert: repository description = 'http://example.com/repository'.
    self assert: repository type = 'http'.
    self assert: repository username = 'DaleHenrichs'.
    self assert: repository password = 'secret'! !

!MetacelloRepositoriesSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testMergeA
    | repositories repository |
    repositories := self repositoriesSpec.
    repositories
        add:
                (self repositorySpec
                        description: 'http://example.com/repository';
                        username: 'dkh';
                        password: 'password';
                        yourself);
        merge:
                (self repositorySpec
                        description: 'http://example.com/repository';
                        username: 'DaleHenrichs';
                        password: 'secret';
                        yourself).
    repository := repositories map at: 'http://example.com/repository' ifAbsent: [ self assert: false ].
    self assert: repository description = 'http://example.com/repository'.
    self assert: repository type = 'http'.
    self assert: repository username = 'DaleHenrichs'.
    self assert: repository password = 'secret'! !

!MetacelloRepositoriesSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testMergeB
    | repositories repository |
    repositories := self repositoriesSpec.
    repositories
        add:
                (self repositorySpec
                        description: 'http://example.com/repository';
                        username: 'dkh';
                        password: 'password';
                        yourself);
        merge: 'http://example.com/repository'.
    repository := repositories map at: 'http://example.com/repository' ifAbsent: [ self assert: false ].
    self assert: repository description = 'http://example.com/repository'.
    self assert: repository type = 'http'.
    self assert: repository username = 'dkh'.
    self assert: repository password = 'password'! !

!MetacelloRepositoriesSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testRemoveC
    | repositories removed |
    repositories := self repositoriesSpec.
    repositories
        add:
            (self repositorySpec
                description: 'http://example.com/repository';
                username: 'dkh';
                password: 'password';
                yourself).
    repositories remove: {'http://example.com/repository'}.
    removed := false.
    repositories map at: 'http://example.com/repository' ifAbsent: [ removed := true ].
    self assert: removed! !

!MetacelloRepositoriesSpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testRemoveD
    | repositories removed |
    repositories := self repositoriesSpec.
    repositories
        add:
            (self repositorySpec
                description: 'http://example.com/repository';
                username: 'dkh';
                password: 'password';
                yourself).
    repositories remove: 'http://example.com/repository'.
    removed := false.
    repositories map at: 'http://example.com/repository' ifAbsent: [ removed := true ].
    self assert: removed! !

!MetacelloRepositoriesSpecTestCase methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
projectClass
    ^ MetacelloMCProject! !

!MetacelloRepositorySpec methodsFor: 'adding' stamp: 'dkh 6/8/2012 14:04:22'!
addToMetacelloRepositories: aMetacelloRepositoriesSpec

	aMetacelloRepositoriesSpec addMember: 
		(aMetacelloRepositoriesSpec addMember 
			name: self name;
			spec: self;
			yourself)! !

!MetacelloRepositorySpec methodsFor: 'mc support' stamp: 'dkh 07/16/2013 19:35'!
hasNoLoadConflicts: aMetacelloProjectSpec
  self description = aMetacelloProjectSpec description
    ifTrue: [ ^ true ].
  self type = 'github'
    ifTrue: [ 
      ^ self createRepository
        hasNoLoadConflicts: aMetacelloProjectSpec createRepository ].
  ^ false! !

!MetacelloRepositorySpec methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
description

	^description! !

!MetacelloRepositorySpec methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
password

	password == nil ifTrue: [ password := '' ].
	^password! !

!MetacelloRepositorySpec methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
username

	username == nil ifTrue: [ username := '' ].
	^username! !

!MetacelloRepositorySpec methodsFor: 'mc support' stamp: 'dkh 6/8/2012 14:04:22'!
createRepository
    | repo |
    repo := self project createRepository: self.
    ^ MCRepositoryGroup default repositories detect: [ :each | each = repo ] ifNone: [ repo ]! !

!MetacelloRepositorySpec methodsFor: 'merging' stamp: 'dkh 6/8/2012 14:04:22'!
mergeMap
    | map |
    map := super mergeMap.
    map at: #'description' put: description.
    map at: #'type' put: self type.
    map at: #'username' put: username.
    map at: #'password' put: password.
    ^ map! !

!MetacelloRepositorySpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
password: aString

	password := aString! !

!MetacelloRepositorySpec methodsFor: 'printing' stamp: 'dkh 6/8/2012 14:04:22'!
configMethodCascadeOn: aStream lastCascade: lastCascade

	aStream nextPutAll: 'repository: ', self description printString.
	(self username isEmpty not or: [ self password isEmpty not ])
		ifTrue: [ aStream nextPutAll: ' username: ', self username printString, ' password: ', self password printString ].
	lastCascade ifFalse: [ aStream nextPut: $;; cr ].
! !

!MetacelloRepositorySpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
description: aString

	description := aString! !

!MetacelloRepositorySpec methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
removeFromMetacelloRepositories: aMetacelloRepositoriesSpec

	aMetacelloRepositoriesSpec addMember: 
		(aMetacelloRepositoriesSpec removeMember 
			name: self name;
			spec: self;
			yourself)! !

!MetacelloRepositorySpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
username: aString

	username := aString! !

!MetacelloRepositorySpec methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
mergeIntoMetacelloRepositories: aMetacelloRepositoriesSpec

	aMetacelloRepositoriesSpec addMember: 
		(aMetacelloRepositoriesSpec mergeMember 
			name: self name;
			spec: self;
			yourself)! !

!MetacelloRepositorySpec methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
type

	type == nil ifTrue: [ type := self extractTypeFromDescription ].
	^type! !

!MetacelloRepositorySpec methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
type: aString

	type := aString! !

!MetacelloRepositorySpec methodsFor: 'querying' stamp: 'dkh 6/8/2012 14:04:22'!
name

	^self description! !

!MetacelloRepositorySpec methodsFor: 'private' stamp: 'dkh 6/8/2012 14:04:22'!
extractTypeFromDescription

	^MetacelloPlatform current extractTypeFromDescription: self description! !

!MetacelloRepositorySpec methodsFor: 'printing' stamp: 'dkh 6/8/2012 14:04:22'!
configMethodOn: aStream indent: indent

	aStream 
		tab: indent; 
		nextPutAll: 'spec '.
	self configMethodCascadeOn: aStream lastCascade: true! !

!MetacelloRepositorySpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testRepositoryMergeSpec
    | repositoryA repositoryB repository |
    repositoryA := self repositorySpec
        description: '/opt/gemstone/repository';
        username: 'dkh';
        password: 'password';
        type: 'directory';
        yourself.
    repositoryB := self repositorySpec
        description: 'http://example.com/repository';
        password: 'secret';
        yourself.
    repository := repositoryA mergeSpec: repositoryB.
    self assert: repository description = 'http://example.com/repository'.
    self assert: repository username = 'dkh'.
    self assert: repository password = 'secret'.
    self assert: repository type = 'http'! !

!MetacelloRepositorySpecTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 15:41:23.319'!
testRepositorySpec
    | repository |
    repository := self repositorySpec
        description: '/opt/gemstone/repository';
        username: 'dkh';
        password: 'password';
        type: 'directory';
        yourself.
    self assert: repository name = repository description.
    self assert: repository description = '/opt/gemstone/repository'.
    self assert: repository username = 'dkh'.
    self assert: repository password = 'password'.
    self assert: repository type = 'directory'.
    repository := self repositorySpec
        description: '/opt/gemstone/repository';
        yourself.
    self assert: repository description = '/opt/gemstone/repository'.
    self assert: repository type = 'directory'.
    repository := self repositorySpec
        description: 'http://example.com/repository';
        yourself.
    self assert: repository description = 'http://example.com/repository'.
    self assert: repository type = 'http'! !

!MetacelloRepositorySpecTestCase methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
projectClass
    ^ MetacelloMCProject! !

!MetacelloRepositorySqueakCommonTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 10:19:43.983'!
testFtpRepository
    | project pkg repoSpec repo |
    project := self project.
    pkg := (project version: '1.3-baseline') packageNamed: 'Example-Core'.
    repoSpec := pkg repositorySpecs first.
    self assert: repoSpec type = 'ftp'.
    repo := repoSpec createRepository.
    self assert: repo class == MCFtpRepository.
    self assert: repo host = 'ftp.example.com'.
    self assert: repo directory = 'examples'! !

!MetacelloRepositorySqueakCommonTestCase methodsFor: 'tests' stamp: 'BenComan 3/21/2014 22:06'!
testAsRepositorySpecFor
    | project testBlock |
    project := self project.
    testBlock := [ :pkg :expectedType1 :expectedType2 | 
    | repoSpec1 repo repoSpec2 |
    repoSpec1 := pkg repositorySpecs first.
    self assert: repoSpec1 type = expectedType1.
    repo := repoSpec1 createRepository.
    repoSpec2 := repo asRepositorySpecFor: project.
    self assert: repoSpec2 type = expectedType2.
    expectedType1 = expectedType2
        ifTrue: [ self assert: repoSpec1 description asFileReference fullName = repoSpec2 description asFileReference fullName ]
        ifFalse: [ 
            "special case for standard directory type that defaults to MCServerDirectoryRepository"
            self
                assert:
                    (repoSpec1 description copyFrom: 'server://' size + 1 to: repoSpec1 description size) = repoSpec2 description ] ].
    testBlock
        value: ((project version: '1.0-baseline') packageNamed: 'Example-Core')
        value: 'directory'
        value: 'directory'.
    testBlock value: ((project version: '1.3-baseline') packageNamed: 'Example-Core') value: 'ftp' value: 'ftp'.
    testBlock value: ((project version: '1.4-baseline') packageNamed: 'Example-Core') value: 'http' value: 'http'.
    testBlock
        value: ((project version: '1.5-baseline') packageNamed: 'Example-Core')
        value: 'dictionary'
        value: 'dictionary'! !

!MetacelloRepositorySqueakCommonTestCase methodsFor: 'baselines' stamp: 'dkh 6/12/2012 10:19:43.983'!
baseline13: spec
    <version: '1.3-baseline'>
    spec
        for: #'squeakCommon'
        do: [ 
            spec
                package: 'Example-Core'
                with: [ 
                    spec
                        includes: 'Example-AddOn';
                        file: 'Example-Core-anon.1';
                        repository: 'ftp://ftp.example.com/examples' ] ]! !

!MetacelloRepositorySqueakCommonTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 10:19:43.983'!
testHttpRepository
    | project pkg repoSpec repo |
    project := self project.
    pkg := (project version: '1.4-baseline') packageNamed: 'Example-Core'.
    repoSpec := pkg repositorySpecs first.
    self assert: repoSpec type = 'http'.
    repo := repoSpec createRepository.
    self assert: repo class == MCHttpRepository.
    self assert: repo description = 'http://example.com/examples'! !

!MetacelloRepositorySqueakCommonTestCase methodsFor: 'running' stamp: 'dkh 6/12/2012 10:19:43.983'!
tearDown
    super tearDown.
    Smalltalk removeKey: #'Metacello_Platform_Test_GlobalDictionary' ifAbsent: [  ]! !

!MetacelloRepositorySqueakCommonTestCase methodsFor: 'baselines' stamp: 'dkh 7/12/2013 07:03'!
baseline16: spec
  <version: '1.6-baseline'>
  spec
    for: #'common'
    do: [ 
      spec
        package: 'Example-Core'
        with: [ 
          spec
            includes: 'Example-AddOn';
            file: 'Example-Core-anon.1';
            repository:
                'filetree://' , MCFileTreeFileUtils current default fullName , '/temp/repo' ] ]

! !

!MetacelloRepositorySqueakCommonTestCase methodsFor: 'baselines' stamp: 'dkh 6/12/2012 10:19:43.983'!
baseline14: spec
    <version: '1.4-baseline'>
    spec
        for: #'common'
        do: [ 
            spec
                package: 'Example-Core'
                with: [ 
                    spec
                        includes: 'Example-AddOn';
                        file: 'Example-Core-anon.1';
                        repository: 'http://example.com/examples' ] ]! !

!MetacelloRepositorySqueakCommonTestCase methodsFor: 'accessing' stamp: 'dkh 5/7/2013 19:11'!
project
     "force new version as workaround for https://code.google.com/p/smalltalk-hub/issues/detail?id=21"

	| constructor project |
	"Construct Metacello project"
	constructor := MetacelloVersionConstructor on: self.
	project := constructor project.
	project loader: MetacelloNullRecordingMCSpecLoader new.
	^project! !

!MetacelloRepositorySqueakCommonTestCase methodsFor: 'baselines' stamp: 'dkh 6/12/2012 10:19:43.983'!
baseline15: spec
    <version: '1.5-baseline'>
    spec
        for: #'common'
        do: [ 
            spec
                package: 'Example-Core'
                with: [ 
                    spec
                        includes: 'Example-AddOn';
                        file: 'Example-Core-anon.1';
                        repository: 'dictionary://Metacello_Platform_Test_GlobalDictionary' ] ]! !

!MetacelloRepositorySqueakCommonTestCase methodsFor: 'running' stamp: 'dkh 6/12/2012 10:19:43.983'!
setUp
    super setUp.
    Smalltalk
        at: #'Metacello_Platform_Test_GlobalDictionary'
        put:
            (MCDictionaryRepository new
                description: 'dictionary://Metacello_Platform_Test_GlobalDictionary';
                yourself)! !

!MetacelloRepositorySqueakCommonTestCase methodsFor: 'tests' stamp: 'BenComan 3/21/2014 22:10'!
testDirectoryRepository
    | project pkg repoSpec repo |
    project := self project.
    pkg := (project version: '1.0-baseline') packageNamed: 'Example-Core'.
    repoSpec := pkg repositorySpecs first.
    self assert: repoSpec type = 'directory'.
    repo := repoSpec createRepository.
    self assert: repo class == MCDirectoryRepository.
    self assert: repo description = '/opt/mcexamples' asFileReference fullName! !

!MetacelloRepositorySqueakCommonTestCase methodsFor: 'baselines' stamp: 'dkh 6/12/2012 10:19:43.983'!
baseline10: spec
    <version: '1.0-baseline'>
    spec
        for: #'common'
        do: [ 
            spec
                package: 'Example-Core'
                with: [ 
                    spec
                        includes: 'Example-AddOn';
                        file: 'Example-Core-anon.1';
                        repository: '/opt/mcexamples' ] ]! !

!MetacelloRepositorySqueakCommonTestCase methodsFor: 'tests' stamp: 'DamienCassou 4/4/2014 15:30'!
testFileTreeRepository
  "must create repository against an existing directory"

  | project pkg repoSpec repo fileUtils workingDir tempDir repoDir |
  fileUtils := MCFileTreeFileUtils current.
  workingDir := fileUtils default.
  tempDir := fileUtils directoryFromPath: 'temp' relativeTo: workingDir.
  [ 
  fileUtils ensureDirectoryExists: tempDir.
  repoDir := fileUtils directoryFromPath: 'repo' relativeTo: tempDir.
  fileUtils ensureDirectoryExists: repoDir.
  project := self project.
  pkg := (project version: '1.6-baseline') packageNamed: 'Example-Core'.
  repoSpec := pkg repositorySpecs first.
  self assert: repoSpec type = 'filetree'.
  repo := repoSpec createRepository.
  self
    assert: repo class == (Smalltalk at: #'MCFileTreeRepository' ifAbsent: [  ]).
  self
    assert:
      repo description equals: ('filetree://' , (fileUtils default fullName , '/temp/repo') asFileReference fullName )]
    ensure: [ 
      (fileUtils directoryExists: tempDir)
        ifTrue: [ fileUtils deleteAll: tempDir ] ]

! !

!MetacelloRepositorySqueakCommonTestCase methodsFor: 'tests' stamp: 'dkh 6/12/2012 10:19:43.983'!
testDictionaryRepository
    | project pkg repoSpec repo |
    project := self project.
    pkg := (project version: '1.5-baseline') packageNamed: 'Example-Core'.
    repoSpec := pkg repositorySpecs first.
    self assert: repoSpec type = 'dictionary'.
    repo := repoSpec createRepository.
    self assert: repo class == MCDictionaryRepository.
    self assert: repo dictionary == (Smalltalk at: #'Metacello_Platform_Test_GlobalDictionary') dictionary! !

!MetacelloResolveProjectUpgrade methodsFor: 'exception handling' stamp: 'dkh 6/7/2012 15:25'!
disallow
    "default action"

    self resume: self existingProjectRegistration! !

!MetacelloResolveProjectUpgrade methodsFor: 'exception handling' stamp: 'dkh 7/18/2012 16:42'!
defaultAction
    "Result of signal should be the projectRegistration to be used to perform the load ... default is to disallow"

    ^ self existingProjectRegistration! !

!MetacelloResolveProjectUpgrade methodsFor: 'exception handling' stamp: 'dkh 7/18/2012 16:40'!
allow
    self checkAllowed.
    self resume: self newProjectRegistration! !

!MetacelloResolveProjectUpgrade methodsFor: 'accessing' stamp: 'dkh 5/29/2012 16:30'!
newProjectRegistration: anObject
	newProjectRegistration := anObject! !

!MetacelloResolveProjectUpgrade methodsFor: 'private' stamp: 'dkh 07/25/2013 04:44'!
checkAllowed
  self existingProjectRegistration locked
    ifTrue: [ 
      self
        resume:
          (MetacelloAllowLockedProjectChange new
            operationString: self operationString;
            existingProjectRegistration: self existingProjectRegistration;
            newProjectRegistration: self newProjectRegistration;
            signal) ]! !

!MetacelloResolveProjectUpgrade methodsFor: 'handlers' stamp: 'dkh 7/24/2012 11:37'!
handleOnDownGrade: onDownGradeBlock onUpgrade: onUpgradeBlock
    self subclassResponsibility! !

!MetacelloResolveProjectUpgrade methodsFor: 'accessing' stamp: 'dkh 5/29/2012 16:30'!
newProjectRegistration
	^ newProjectRegistration! !

!MetacelloResolveProjectUpgrade methodsFor: 'accessing' stamp: 'dkh 7/18/2012 17:08'!
operationString
    self subclassResponsibility! !

!MetacelloResolveProjectUpgrade methodsFor: 'exception handling' stamp: 'dkh 07/25/2013 11:57'!
allowEvenIfLocked
  "for internal ScriptEngine use only. from the Scripting API use:
		onLocked: [:ex | ex allow]
		"

  self resume: self newProjectRegistration! !

!MetacelloResolveProjectUpgrade methodsFor: 'accessing' stamp: 'dkh 5/29/2012 16:30'!
existingProjectRegistration: anObject
	existingProjectRegistration := anObject! !

!MetacelloResolveProjectUpgrade methodsFor: 'accessing' stamp: 'dkh 5/29/2012 16:30'!
existingProjectRegistration
	^ existingProjectRegistration! !

!MetacelloScriptApiExecutor commentStamp: 'dkh 7/12/2012 14:49'!
MetacelloScriptExecutor decodes script args and launches MetacelloScriptEngine to run for each projectSpec encounters...i,e., primarily here to handl array and block args to configuration:, baseline: or project:.!
!MetacelloScriptApiExecutor methodsFor: 'execution callback' stamp: 'dkh 7/16/2012 15:56'!
executeCollection: aCollection do: projectSpecBlock
    self projectSpecsFromRepositoryArg
        do: [ :projectSpec | 
            (aCollection includes: (MetacelloScriptEngine baseNameOf: projectSpec className))
                ifTrue: [ projectSpecBlock value: (self applyArgsToProjectSpec: projectSpec copy) ] ]! !

!MetacelloScriptApiExecutor methodsFor: 'execution callback' stamp: 'dkh 7/16/2012 15:59'!
executeBlock: selectBlock do: projectSpecBlock
    (self projectSpecsFromRepositoryArg select: selectBlock)
        do: [ :projectSpec | projectSpecBlock value: (self applyArgsToProjectSpec: projectSpec copy) ]! !

!MetacelloScriptApiExecutor methodsFor: 'execution callback' stamp: 'dkh 7/16/2012 16:38'!
projectSpecsFromRepositoryArg
    | spec repo projectSpecs |
    repositoryArg ifNil: [ ^ #() ].
    spec := (projectSpecGenerator projectSpecCreationBlock value: 'xxx') first.
    repo := spec project createRepository: (spec project repositorySpec description: repositoryArg).
    projectSpecs := OrderedCollection new.
    ((Gofer new disablePackageCache
        repository: repo;
        allResolved) collect: [ :resolvedReference | resolvedReference packageName ]) asSet
        do: [ :packageName | 
            (projectSpecGenerator projectSpecCreationBlock value: (MetacelloScriptEngine baseNameOf: packageName))
                do: [ :projectSpec | 
                    projectSpec className = packageName
                        ifTrue: [ projectSpecs add: (self applyArgsToProjectSpec: projectSpec copy) ] ] ].
    ^ projectSpecs! !

!MetacelloScriptApiExecutor methodsFor: 'execution callback' stamp: 'dkh 7/16/2012 17:10'!
executeString: aString do: projectSpecBlock
    self singleRoot: true.
    (projectSpecGenerator projectSpecCreationBlock value: aString)
        do: [ :projectSpec | projectSpec ifNotNil: [ projectSpecBlock value: (self applyArgsToProjectSpec: projectSpec copy) ] ]! !

!MetacelloScriptEngine commentStamp: 'dkh 7/12/2012 14:48'!
MetacelloScriptEngine runs the execution of the script for one projectSpec!
!MetacelloScriptEngine methodsFor: 'defaults' stamp: 'dkh 7/23/2012 10:02'!
defaultVersionString
    ^ self class defaultVersionString! !

!MetacelloScriptEngine methodsFor: 'options' stamp: 'dkh 7/12/2012 14:25'!
ignoreImage
    ^ self options at: #'ignoreImage' ifAbsent: [ false ]! !

!MetacelloScriptEngine methodsFor: 'accessing' stamp: 'dkh 7/12/2012 14:26'!
projectSpec
    ^ projectSpec! !

!MetacelloScriptEngine methodsFor: 'accessing' stamp: 'dkh 7/12/2012 14:25'!
root
	^ root! !

!MetacelloScriptEngine methodsFor: 'handlers' stamp: 'dkh 7/12/2012 14:25'!
handleLookupProjectSpec: exception
    ^ exception
        resume:
            ((self lookupProjectSpecFor: exception projectSpec) ifNil: [ ^ exception resume: exception projectSpec ])! !

!MetacelloScriptEngine methodsFor: 'project lookup' stamp: 'dkh 7/12/2012 14:25'!
getBaselineUnconditionalLoad: unconditionalLoad
    | spec |
    spec := self projectSpec.
    Smalltalk
        at: spec className asSymbol
        ifPresent: [ :cl | 
            unconditionalLoad
                ifFalse: [ ^ cl ] ].
    (spec := self lookupProjectSpecFor: spec) projectPackage load.
    ^ Smalltalk at: spec className asSymbol! !

!MetacelloScriptEngine methodsFor: 'options' stamp: 'dkh 7/23/2012 19:31'!
repositoryOverrides
    ^ (self options at: #'repositoryOverrides' ifAbsent: [ ^ nil ])
        collect: [ :description | (MetacelloMCProject new repositorySpec description: description) createRepository ]! !

!MetacelloScriptEngine methodsFor: 'options' stamp: 'dkh 7/12/2012 14:25'!
useCurrentVersion
    "private option used to implement the classic mode"

    ^ self options at: #'useCurrentVersion' ifAbsent: [ false ]! !

!MetacelloScriptEngine methodsFor: 'handlers' stamp: 'dkh 07/24/2013 17:07'!
handleNotificationsForAction: actionBlock
  [ 
  [ 
  [ 
  actionBlock
    on:
      MetacelloLookupProjectSpec , MetacelloLookupProjectSpecForLoad
        , MetacelloProjectSpecLoadedNotification
        , MetacelloScriptEnsureProjectLoadedForDevelopment
        , MetacelloLookupBaselineSpecForEnsureLoad
    do: [ :ex | 
      "lookup and registration handlers need to be innermost set of handlers ...they may throw option notifications"
      ex handleResolutionFor: self ] ]
    on:
      MetacelloAllowProjectDowngrade , MetacelloAllowProjectUpgrade
        , MetacelloAllowConflictingProjectUpgrade
    do: [ :ex | 
      "option handlers need to be outermost set of handlers ... last line of defense before users are involved"
      ex handleResolutionFor: self ] ]
    on: MetacelloAllowLockedProjectChange
    do: [ :ex | 
      "MetacelloAllowLockedProjectChange need to be outermost handler ... since it is signaled from second line of handlers"
      ex handleResolutionFor: self ] ]
    on: Warning
    do: [ :ex | 
      "Warning is absolute outermost handler"
      self handleWarning: ex ]! !

!MetacelloScriptEngine methodsFor: 'project lookup' stamp: 'dkh 7/12/2012 14:25'!
getBaselineProjectUnconditionalLoad: unconditionalLoad
    | project |
    project := (self getBaselineUnconditionalLoad: unconditionalLoad) project.
    project version spec repositories: self repositories copy.
    ^ project! !

!MetacelloScriptEngine methodsFor: 'options' stamp: 'dkh 7/23/2012 16:30'!
cacheRepository
    ^ (MetacelloMCProject new repositorySpec description: (self options at: #'cacheRepository' ifAbsent: [ ^ nil ]))
        createRepository! !

!MetacelloScriptEngine methodsFor: 'actions api' stamp: 'dkh 04/03/2013 12:31'!
lock
  | spec |
  MetacelloProjectRegistration
    copyRegistryRestoreOnErrorWhile: [ 
      self setDefaultsAndValidate: self projectSpec copy.	"don't add defaults"
      spec := self projectSpec.
      MetacelloProjectRegistration
        registrationForProjectSpec: spec
        ifAbsent: [ :new | 
          new
            locked: true;
            registerProject ]
        ifPresent: [ :existing :new | 
          existing
            copyOnWrite: [ :existingCopy | 
              existingCopy locked: true.
              spec
                copyForRegistration: existingCopy
                onWrite: [ :specCopy | 
                  specCopy
                    ifNil: [ existingCopy merge: new ]
                    ifNotNil: [ 
                      specCopy mergeScriptRepository: spec.
                      spec := specCopy ] ] ] ].
      self root: spec ]! !

!MetacelloScriptEngine methodsFor: 'defaults' stamp: 'dkh 7/23/2012 11:09'!
defaultRepositoryDescription
    ^ self class defaultRepositoryDescription! !

!MetacelloScriptEngine methodsFor: 'project lookup' stamp: 'dkh 7/12/2012 14:25'!
getConfigurationUnconditionalLoad: unconditionalLoad
    | spec |
    spec := self projectSpec.
    Smalltalk
        at: spec className asSymbol
        ifPresent: [ :cl | 
            unconditionalLoad
                ifFalse: [ ^ cl ] ].
    (spec := self lookupProjectSpecFor: spec) projectPackage load.
    ^ Smalltalk at: spec className asSymbol! !

!MetacelloScriptEngine methodsFor: 'accessing' stamp: 'dkh 7/12/2012 14:25'!
options
    options ifNil: [ options := Dictionary new ].
    ^ options! !

!MetacelloScriptEngine methodsFor: 'accessing' stamp: 'dkh 7/12/2012 14:33'!
options: aDictionary
    options := aDictionary! !

!MetacelloScriptEngine methodsFor: 'actions api' stamp: 'dkh 7/23/2012 15:53'!
record: required
    self
        fetchRecord: [ :version | 
            required isEmpty
                ifTrue: [ version record ]
                ifFalse: [ version record: required ] ]
        required: required! !

!MetacelloScriptEngine methodsFor: 'accessing' stamp: 'dkh 7/12/2012 14:25'!
repositories
    ^ self projectSpec repositories! !

!MetacelloScriptEngine methodsFor: 'handlers' stamp: 'dkh 07/24/2013 15:38'!
handleWarning: exception
  ^ (self options at: #'onWarning' ifAbsent: [ ^ exception pass ])
    cull: exception! !

!MetacelloScriptEngine methodsFor: 'actions api' stamp: 'dkh 07/01/2013 06:09'!
load: required onProjectDownGrade: onDownGradeBlock onProjectUpgrade: onUpgradeBlock
  MetacelloProjectRegistration
    copyRegistryRestoreOnErrorWhile: [ 
      self
        handleNotificationsForAction: [ 
          | version loadedSpec |
          self setDefaultsAndValidateProjectSpec.
          [ loadedSpec := (self lookupProjectSpecFor: self projectSpec) copy ]
            on: MetacelloAllowProjectDowngrade , MetacelloAllowProjectUpgrade
            do: [ :ex | ex handleOnDownGrade: onDownGradeBlock onUpgrade: onUpgradeBlock ].
          version := loadedSpec versionForScriptEngine: self.
          self
            root:
              (required isEmpty
                ifTrue: [ version load ]
                ifFalse: [ version load: required ]) loadDirective.
          loadedSpec loads: required.
          MetacelloProjectRegistration
            registrationForProjectSpec: loadedSpec
            ifAbsent: [ :new | 
              new
                loadedInImage: true;
                registerProject ]
            ifPresent: [ :existing :new | 
              existing
                copyOnWrite: [ :existingCopy | 
                  existingCopy
                    loadedInImage: true;
                    merge: new ] ] ] ]! !

!MetacelloScriptEngine methodsFor: 'accessing' stamp: 'dkh 7/12/2012 14:25'!
root: anObject
	root := anObject! !

!MetacelloScriptEngine methodsFor: 'project lookup' stamp: 'dkh 04/03/2013 12:34'!
setDefaultsAndValidateProjectSpec
  "NOTE: projectSpec has defaults assigned if versionString or repository missing"

  self setDefaultsAndValidate: self projectSpec! !

!MetacelloScriptEngine methodsFor: 'handlers' stamp: 'dkh 7/24/2012 11:43'!
handleEnsureProjectLoadedForDevelopment: exception
    "if useCurrentVersion resume with true, else resume with false"

    ^ exception resume: self useCurrentVersion! !

!MetacelloScriptEngine methodsFor: 'actions api' stamp: 'dkh 04/03/2013 12:30'!
list
  self setDefaultsAndValidateProjectSpec.
  self root: self projectSpec! !

!MetacelloScriptEngine methodsFor: 'project lookup' stamp: 'dkh 7/12/2012 14:25'!
getConfigurationProjectUnconditionalLoad: unconditionalLoad
    ^ (self getConfigurationUnconditionalLoad: unconditionalLoad) project! !

!MetacelloScriptEngine methodsFor: 'handlers' stamp: 'dkh 07/24/2013 17:08'!
handleLock: exception
  ^ (self options at: #'onLock' ifAbsent: [ ^ exception pass ])
    cull: exception
    cull: exception existingProjectRegistration
    cull: exception newProjectRegistration! !

!MetacelloScriptEngine methodsFor: 'project lookup' stamp: 'dkh 05/11/2013 07:45'!
lookupProjectSpecFor: aProjectSpec
  "if there is no conflict, choose new spec"

  | registration loadedSpec |
  registration := MetacelloProjectRegistration
    registrationForProjectSpec: aProjectSpec
    ifAbsent: [ :new | new ]
    ifPresent: [ :existing :new | 
      (existing hasLoadConflicts: new)
        ifTrue: [ 
          ((existing canUpgradeTo: new)
            ifTrue: [ MetacelloAllowProjectUpgrade new ]
            ifFalse: [ 
              (existing canDowngradeTo: new)
                ifTrue: [ MetacelloAllowProjectDowngrade new ]
                ifFalse: [ MetacelloAllowConflictingProjectUpgrade new ] ])
            existingProjectRegistration: existing;
            newProjectRegistration: new;
            signal ]
        ifFalse: [ new ] ].
  ^ registration lookupSpec: aProjectSpec! !

!MetacelloScriptEngine methodsFor: 'actions api' stamp: 'dkh 04/03/2013 12:30'!
fetchRecord: fetchRecordBlock required: required
  MetacelloProjectRegistration
    copyRegistryWhile: [ 
      self
        handleNotificationsForAction: [ 
          | version loadedSpec |
          self setDefaultsAndValidateProjectSpec.
          [ loadedSpec := self lookupProjectSpecFor: self projectSpec ]
            on: MetacelloAllowProjectDowngrade , MetacelloAllowProjectUpgrade
            do: [ :notification | 
              notification
                handleOnDownGrade: [ :ex :existing :new | ex allowEvenIfLocked ]
                onUpgrade: [ :ex :existing :new | ex allowEvenIfLocked ] ].
          version := loadedSpec versionForScriptEngine: self.
          self root: (fetchRecordBlock value: version) loadDirective ] ]! !

!MetacelloScriptEngine methodsFor: 'handlers' stamp: 'dkh 05/11/2013 07:51'!
handleLookupProjectSpecForLoad: exception
  "if overrideProjectSpec is nil, use currentVersion in image, ignoreImage is false"

  | requested override |
  requested := exception projectSpec.
  override := self useCurrentVersion
    ifTrue: [ 
      "don't do lookup in registry if we expect to use the #currentVersion calculation"
      nil ]
    ifFalse: [ 
      | registered |
      registered := self lookupProjectSpecFor: exception projectSpec.
      (registered compareEqual: requested)
        ifFalse: [ 
          "counts as override, only if they differ in some aspect"
          override := registered ] ].
  ^ exception
    resume:
      (MetacelloProjectSpecForLoad new
        projectSpec: requested;
        useDetermineVersionForLoad: self useCurrentVersion;
        overrideProjectSpec: override;
        yourself)! !

!MetacelloScriptEngine methodsFor: 'accessing' stamp: 'dkh 7/12/2012 14:26'!
projectSpec: aProjectSpec
    projectSpec := aProjectSpec! !

!MetacelloScriptEngine methodsFor: 'accessing' stamp: 'dkh 7/12/2012 14:25'!
projectName
    ^ self projectSpec name! !

!MetacelloScriptEngine methodsFor: 'handlers' stamp: 'dkh 05/11/2013 07:53'!
handleLookupBaselineSpecForEnsureLoad: exception
  "if requested and registered don't compare equal, then ensure the new baseline is loaded"

  | requested registered |
  requested := exception projectSpec.
  registered := self lookupProjectSpecFor: exception projectSpec.
  ^ exception resume: (registered compareEqual: requested) not! !

!MetacelloScriptEngine methodsFor: 'actions api' stamp: 'dkh 04/03/2013 12:31'!
unlock
  | spec |
  MetacelloProjectRegistration
    copyRegistryRestoreOnErrorWhile: [ 
      self setDefaultsAndValidate: self projectSpec copy.	"don't add defaults"
      spec := self projectSpec.
      MetacelloProjectRegistration
        registrationForProjectSpec: spec
        ifAbsent: [ :ignored |  ]
        ifPresent: [ :existing :new | existing copyOnWrite: [ :existingCopy | existingCopy locked: false ] ].
      self root: spec ]! !

!MetacelloScriptEngine methodsFor: 'handlers' stamp: 'dkh 7/12/2012 14:25'!
handleDowngrade: exception
    ^ (self options at: #'onDowngrade' ifAbsent: [ ^ exception pass ])
        cull: exception
        cull: exception existingProjectRegistration
        cull: exception newProjectRegistration! !

!MetacelloScriptEngine methodsFor: 'actions api' stamp: 'dkh 7/20/2012 16:17'!
load: required
    self
        load: required
        onProjectDownGrade: [ :ex :existing :new | ex allowEvenIfLocked ]
        onProjectUpgrade: [ :ex :existing :new | ex allowEvenIfLocked ]! !

!MetacelloScriptEngine methodsFor: 'actions api' stamp: 'dkh 7/23/2012 15:53'!
fetch: required
    self
        fetchRecord: [ :version | 
            required isEmpty
                ifTrue: [ version fetch ]
                ifFalse: [ version fetch: required ] ]
        required: required! !

!MetacelloScriptEngine methodsFor: 'actions api' stamp: 'dkh 04/03/2013 12:30'!
get
  " load a fresh copy from repo"

  | spec projectPackage |
  MetacelloProjectRegistration
    copyRegistryRestoreOnErrorWhile: [ 
      self setDefaultsAndValidateProjectSpec.
      spec := self projectSpec.
      projectPackage := spec projectPackage.
      projectPackage repositorySpecs
        do: [ :repoSpec | repoSpec createRepository flushForScriptGet ].
      projectPackage load.
      self root: (Smalltalk at: spec className asSymbol) project.
      MetacelloProjectRegistration
        registrationForProjectSpec: spec
        ifAbsent: [ :new | new registerProject ]
        ifPresent: [ :existing :new | 
          existing
            copyOnWrite: [ :existingCopy | 
              spec
                copyForRegistration: existingCopy
                onWrite: [ :specCopy | 
                  specCopy
                    ifNil: [ existingCopy merge: new ]
                    ifNotNil: [ specCopy mergeScriptRepository: spec ] ] ] ] ]! !

!MetacelloScriptEngine methodsFor: 'handlers' stamp: 'dkh 7/12/2012 14:25'!
handleConflict: exception
    ^ (self options at: #'onConflict' ifAbsent: [ ^ exception pass ])
        cull: exception
        cull: exception existingProjectRegistration
        cull: exception newProjectRegistration! !

!MetacelloScriptEngine methodsFor: 'options' stamp: 'dkh 7/12/2012 14:25'!
silently
    ^ self options at: #'silently' ifAbsent: [ false ]! !

!MetacelloScriptEngine methodsFor: 'handlers' stamp: 'dkh 7/12/2012 14:25'!
handleUpgrade: exception
    ^ (self options at: #'onUpgrade' ifAbsent: [ ^ exception pass ])
        cull: exception
        cull: exception existingProjectRegistration
        cull: exception newProjectRegistration! !

!MetacelloScriptEngine methodsFor: 'handlers' stamp: 'dkh 7/19/2012 20:48'!
handleProjectSpecLoaded: exception
    MetacelloProjectRegistration
        registrationForProjectSpec: exception projectSpec
        ifAbsent: [ :new | 
            new
                loadedInImage: true;
                registerProject ]
        ifPresent: [ :existing :new | 
            "unconditionally merge new with existing (updates registration)"
            existing
                copyOnWrite: [ :existingCopy | 
                    existingCopy
                        loadedInImage: true;
                        merge: new ] ].
    exception resume! !

!MetacelloScriptEngine methodsFor: 'project lookup' stamp: 'dkh 04/03/2013 12:29'!
setDefaultsAndValidate: aProjectSpec
  "NOTE: aProjectSpec has defaults assigned if versionString or repository missing"

  | issues |
  issues := aProjectSpec
    validateForScriptLoad: self
    withDefaultVersionString: self defaultVersionString
    withDefaultRepositoryDecription: self defaultRepositoryDescription.
  issues isEmpty
    ifTrue: [ ^ self ].
  (MetacelloValidationFailure
    issues: issues
    message: 'Project spec validation failure') signal! !

!MetacelloScriptEngine class methodsFor: 'defaults' stamp: 'dkh 7/23/2012 10:03'!
defaultVersionString
    DefaultVersionString ifNil: [ DefaultVersionString := #'stable' ].
    ^ DefaultVersionString! !

!MetacelloScriptEngine class methodsFor: 'utility' stamp: 'dkh 07/14/2013 12:00'!
baselineProjectNameOf: baselineClassName
  ^ (baselineClassName beginsWith: 'BaselineOf')
    ifTrue: [ baselineClassName copyFrom: 'BaselineOf' size + 1 to: baselineClassName size ]
    ifFalse: [ baselineClassName ]! !

!MetacelloScriptEngine class methodsFor: 'defaults' stamp: 'dkh 7/23/2012 11:09'!
defaultRepositoryDescription
    DefaultRepositoryDescription
        ifNil: [ DefaultRepositoryDescription := MetacelloPlatform current defaultRepositoryDescription ].
    ^ DefaultRepositoryDescription! !

!MetacelloScriptEngine class methodsFor: 'utility' stamp: 'dkh 07/14/2013 12:01'!
baseNameOf: className
  ^ (className beginsWith: 'BaselineOf')
    ifTrue: [ className copyFrom: 'BaselineOf' size + 1 to: className size ]
    ifFalse: [ 
      (className beginsWith: 'ConfigurationOf')
        ifTrue: [ className copyFrom: 'ConfigurationOf' size + 1 to: className size ]
        ifFalse: [ className ] ]! !

!MetacelloScriptEngine class methodsFor: 'utility' stamp: 'dkh 07/14/2013 12:01'!
configurationProjectNameOf: configurationClassName
  ^ (configurationClassName beginsWith: 'ConfigurationOf')
    ifTrue: [ 
      configurationClassName
        copyFrom: 'ConfigurationOf' size + 1
        to: configurationClassName size ]
    ifFalse: [ configurationClassName ]! !

!MetacelloScriptEngine class methodsFor: 'utility' stamp: 'dkh 7/12/2012 15:04'!
baselineNameFrom: baseName
    "Return the fully-qualified configuration class name."

    ^ (baseName indexOfSubCollection: 'BaselineOf') > 0
        ifTrue: [ baseName ]
        ifFalse: [ 'BaselineOf' , baseName ]! !

!MetacelloScriptEngine class methodsFor: 'utility' stamp: 'dkh 7/12/2012 15:04'!
configurationNameFrom: baseName
    "Return the fully-qualified configuration class name."

    ^ (baseName indexOfSubCollection: 'ConfigurationOf') > 0
        ifTrue: [ baseName ]
        ifFalse: [ 'ConfigurationOf' , baseName ]! !

!MetacelloScriptEnsureProjectLoadedForDevelopment methodsFor: 'handlers' stamp: 'dkh 7/24/2012 11:42'!
handleResolutionFor: aScriptEngine
    ^ aScriptEngine handleEnsureProjectLoadedForDevelopment: self! !

!MetacelloScriptEnsureProjectLoadedForDevelopment methodsFor: 'exception handling' stamp: 'dkh 7/24/2012 11:40'!
defaultAction
    "Go ahead and download a new copy of configuration because blessing is #development"

    ^ true! !

!MetacelloScriptExecutor commentStamp: 'dkh 7/12/2012 14:49'!
MetacelloScriptExecutor decodes script args and launches MetacelloScriptEngine to run for each projectSpec encounters...i,e., primarily here to handl array and block args to configuration:, baseline: or project:.!
!MetacelloScriptExecutor methodsFor: 'args' stamp: 'dkh 7/13/2012 09:30'!
repositoryArg: anObject
    repositoryArg := anObject! !

!MetacelloScriptExecutor methodsFor: 'args' stamp: 'dkh 7/13/2012 09:30'!
baselineArg: anObject
	baselineArg := anObject! !

!MetacelloScriptExecutor methodsFor: 'options api' stamp: 'dkh 07/24/2013 18:37'!
onWarning: aBlock
  self options at: #'onWarning' put: aBlock! !

!MetacelloScriptExecutor methodsFor: 'options api' stamp: 'dkh 7/13/2012 09:31'!
silently: aBool
    self options at: #'silently' put: aBool! !

!MetacelloScriptExecutor methodsFor: 'args' stamp: 'dkh 7/13/2012 09:30'!
versionArg
    ^ versionArg! !

!MetacelloScriptExecutor methodsFor: 'args' stamp: 'dkh 7/13/2012 09:30'!
classNameArg: anObject
    classNameArg := anObject! !

!MetacelloScriptExecutor methodsFor: 'execution' stamp: 'dkh 7/16/2012 17:10'!
execute: statements
    statements
        do: [ :assoc | assoc value ifNil: [ self perform: assoc key ] ifNotNil: [ self perform: assoc key withArguments: assoc value ] ].
    projectSpecGenerator := self projectSpecGenerator.
    projectSpecGenerator target
        execute: [ :projectSpec | 
            | engine |
            engine := MetacelloScriptEngine new
                options: self options copy;
                projectSpec: projectSpec;
                yourself.
            engine perform: actionArg key withArguments: actionArg value.
            engine root ifNotNil: [ :root | self roots add: root ] ]
        against: self.
    ^ (self singleRoot and: [ self roots size == 1 ])
        ifTrue: [ self roots first ]
        ifFalse: [ self roots ]! !

!MetacelloScriptExecutor methodsFor: 'execution callback' stamp: 'dkh 7/16/2012 17:09'!
executeString: aString do: projectSpecBlock
    self singleRoot: true.
    ((projectSpecGenerator projectSpecLookupBlock value: aString) select: self projectSpecSelectBlock)
        do: [ :projectSpec | projectSpecBlock value: (self applyArgsToProjectSpec: projectSpec copy) ]! !

!MetacelloScriptExecutor methodsFor: 'args' stamp: 'dkh 7/13/2012 09:30'!
baselineArg
	^ baselineArg! !

!MetacelloScriptExecutor methodsFor: 'args' stamp: 'dkh 7/13/2012 09:30'!
versionArg: anObject
    versionArg := anObject! !

!MetacelloScriptExecutor methodsFor: 'actions api' stamp: 'dkh 7/17/2012 10:53'!
lock
    actionArg := #'lock' -> #()! !

!MetacelloScriptExecutor methodsFor: 'accessing' stamp: 'dkh 7/16/2012 17:09'!
singleRoot: aBool
    singleRoot := aBool! !

!MetacelloScriptExecutor methodsFor: 'actions api' stamp: 'dkh 7/19/2012 07:45'!
record: required
    actionArg := #'record:' -> {required}! !

!MetacelloScriptExecutor methodsFor: 'options api' stamp: 'dkh 07/24/2013 17:10'!
onLock: aBlock
  self options at: #'onLock' put: aBlock! !

!MetacelloScriptExecutor methodsFor: 'accessing' stamp: 'dkh 7/13/2012 09:02'!
options
    options ifNil: [ options := Dictionary new ].
    ^ options! !

!MetacelloScriptExecutor methodsFor: 'execution callback' stamp: 'dkh 7/16/2012 14:57'!
executeCollection: aCollection do: projectSpecBlock
    aCollection
        do: [ :projectName | 
            ((projectSpecGenerator projectSpecLookupBlock value: projectName) select: self projectSpecSelectBlock)
                do: [ :projectSpec | projectSpecBlock value: (self applyArgsToProjectSpec: projectSpec copy) ] ]! !

!MetacelloScriptExecutor methodsFor: 'actions api' stamp: 'dkh 7/16/2012 10:17'!
list
    actionArg := #'list' -> #()! !

!MetacelloScriptExecutor methodsFor: 'options api' stamp: 'dkh 7/23/2012 16:18'!
cacheRepository: aRepositoryDescription
    self options at: #'cacheRepository' put: aRepositoryDescription! !

!MetacelloScriptExecutor methodsFor: 'accessing' stamp: 'dkh 7/16/2012 17:09'!
singleRoot
    singleRoot ifNil: [ singleRoot := false ].
    ^ singleRoot! !

!MetacelloScriptExecutor methodsFor: 'args' stamp: 'dkh 7/13/2012 09:30'!
classNameArg
    ^ classNameArg! !

!MetacelloScriptExecutor methodsFor: 'args' stamp: 'dkh 7/13/2012 09:30'!
projectArg: anObject
    projectArg := anObject! !

!MetacelloScriptExecutor methodsFor: 'args' stamp: 'dkh 7/13/2012 09:30'!
repositoryArg
    ^ repositoryArg! !

!MetacelloScriptExecutor methodsFor: 'accessing' stamp: 'dkh 7/13/2012 09:02'!
roots
    roots ifNil: [ roots := OrderedCollection new ].
    ^ roots! !

!MetacelloScriptExecutor methodsFor: 'options api' stamp: 'dkh 7/23/2012 19:28'!
repositoryOverrides: aRepositoryDescriptionList
    self options at: #'repositoryOverrides' put: aRepositoryDescriptionList! !

!MetacelloScriptExecutor methodsFor: 'actions api' stamp: 'dkh 7/17/2012 12:31'!
unlock
    actionArg := #'unlock' -> #()! !

!MetacelloScriptExecutor methodsFor: 'actions api' stamp: 'dkh 7/16/2012 10:17'!
load: required
    actionArg := #'load:' -> {required}! !

!MetacelloScriptExecutor methodsFor: 'actions api' stamp: 'dkh 7/23/2012 15:58'!
fetch: required
    actionArg := #'fetch:' -> {required}! !

!MetacelloScriptExecutor methodsFor: 'args' stamp: 'dkh 7/13/2012 09:30'!
configurationArg
    ^ configurationArg! !

!MetacelloScriptExecutor methodsFor: 'options api' stamp: 'dkh 7/13/2012 09:31'!
ignoreImage: aBool
    self options at: #'ignoreImage' put: aBool! !

!MetacelloScriptExecutor methodsFor: 'execution' stamp: 'dkh 7/13/2012 09:33'!
applyArgsToProjectSpec: aProjectSpec
    classNameArg ifNotNil: [ aProjectSpec className: classNameArg ].
    versionArg ifNotNil: [ aProjectSpec versionString: versionArg ].
    repositoryArg ifNotNil: [ aProjectSpec repository: repositoryArg ].
    ^ aProjectSpec! !

!MetacelloScriptExecutor methodsFor: 'actions api' stamp: 'dkh 7/16/2012 10:17'!
get
    actionArg := #'get' -> #()! !

!MetacelloScriptExecutor methodsFor: 'options api' stamp: 'dkh 7/13/2012 09:31'!
onConflict: aBlock
    self options at: #'onConflict' put: aBlock! !

!MetacelloScriptExecutor methodsFor: 'args' stamp: 'dkh 7/13/2012 09:30'!
configurationArg: anObject
    configurationArg := anObject! !

!MetacelloScriptExecutor methodsFor: 'options api' stamp: 'dkh 7/13/2012 09:31'!
onDowngrade: aBlock
    self options at: #'onDowngrade' put: aBlock! !

!MetacelloScriptExecutor methodsFor: 'execution' stamp: 'dkh 7/16/2012 11:06'!
projectSpecGenerator
    baselineArg
        ifNotNil: [ 
            configurationArg ifNotNil: [ self error: ' baseline: and configuration: are both be specified' ].
            projectArg ifNotNil: [ self error: ' baseline: and project are both be specified' ].
            ^ MetacelloBaselineSpecGenerator new
                target: baselineArg;
                yourself ].
    configurationArg
        ifNotNil: [ 
            baselineArg ifNotNil: [ self error: ' baseline: and configuration: are both be specified' ].
            projectArg ifNotNil: [ self error: ' configuration and project are both be specified' ].
            ^ MetacelloConfigurationSpecGenerator new
                target: configurationArg;
                yourself ].
    projectArg
        ifNotNil: [ 
            configurationArg ifNotNil: [ self error: ' project and configuration: are both be specified' ].
            baselineArg ifNotNil: [ self error: ' baseline: and project are both be specified' ].
            ^ MetacelloProjectSpecGenerator new
                target: projectArg;
                yourself ].
    self error: 'project, baseline, or configuration not specified'! !

!MetacelloScriptExecutor methodsFor: 'execution callback' stamp: 'dkh 7/16/2012 11:34'!
projectSpecSelectBlock
    ^ [ :projectSpec | true ]! !

!MetacelloScriptExecutor methodsFor: 'execution callback' stamp: 'dkh 7/16/2012 14:56'!
executeBlock: selectBlock do: projectSpecBlock
    ((projectSpecGenerator projectSpecListBlock value select: selectBlock) select: self projectSpecSelectBlock)
        do: [ :projectSpec | projectSpecBlock value: (self applyArgsToProjectSpec: projectSpec copy) ]! !

!MetacelloScriptExecutor methodsFor: 'options api' stamp: 'dkh 7/13/2012 09:31'!
onUpgrade: aBlock
    self options at: #'onUpgrade' put: aBlock! !

!MetacelloScriptExecutor methodsFor: 'args' stamp: 'dkh 7/13/2012 09:30'!
projectArg
    ^ projectArg! !

!MetacelloScriptExecutor methodsFor: 'options api' stamp: 'dkh 7/13/2012 09:31'!
useCurrentVersion: aBool
    "private option used to implement the classic mode"

    self options at: #'useCurrentVersion' put: aBool! !

!MetacelloScriptGitHubDownloadNotification methodsFor: 'accessing' stamp: 'dkh 7/24/2012 22:11'!
projectPath: anObject
	projectPath := anObject! !

!MetacelloScriptGitHubDownloadNotification methodsFor: 'accessing' stamp: 'dkh 7/24/2012 22:11'!
versionString
	^ versionString! !

!MetacelloScriptGitHubDownloadNotification methodsFor: 'accessing' stamp: 'dkh 7/24/2012 22:11'!
projectPath
	^ projectPath! !

!MetacelloScriptGitHubDownloadNotification methodsFor: 'accessing' stamp: 'dkh 7/24/2012 22:11'!
versionString: anObject
	versionString := anObject! !

!MetacelloScriptImageExecutor methodsFor: 'execution callback' stamp: 'dkh 7/16/2012 14:53'!
projectSpecSelectBlock
    ^ [ :projectSpec | 
    projectSpec
        ifNil: [ false ]
        ifNotNil: [ 
            MetacelloProjectRegistration
                registrationForProjectSpec: projectSpec
                ifAbsent: [ false ]
                ifPresent: [ :existingRegistration :newRegistration | existingRegistration loadedInImage ] ] ]! !

!MetacelloScriptNotification methodsFor: 'handlers' stamp: 'dkh 6/7/2012 16:07'!
handleResolutionFor: aScriptEngine
    self subclassResponsibility! !

!MetacelloScriptProjectSpecNotification methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
projectSpec
    ^ projectSpec! !

!MetacelloScriptProjectSpecNotification methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
projectSpec: anObject
    projectSpec := anObject! !

!MetacelloScriptProjectSpecNotification methodsFor: 'exception description' stamp: 'dkh 6/5/2012 19:01:24'!
defaultAction
    "Result of signal should be the projectSpec to be used to perform the load"

    ^ self projectSpec! !

!MetacelloScriptRegistryExecutor methodsFor: 'actions api' stamp: 'dkh 7/13/2012 09:36'!
reset
! !

!MetacelloScriptRegistryExecutor methodsFor: 'execution callback' stamp: 'dkh 07/28/2013 10:07'!
projectSpecSelectBlock
  ^ [ :projectSpec | projectSpec notNil ]! !

!MetacelloScriptRegistryExecutor methodsFor: 'actions api' stamp: 'dkh 7/13/2012 09:37'!
remove
! !

!MetacelloScriptRegistryExecutor methodsFor: 'actions api' stamp: 'dkh 7/20/2012 12:00'!
prime
! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - github reference' stamp: 'dkh 06/29/2013 12:27'!
configurationGithubReferenceXXX: spec
  <baseline>
  spec
    for: #'common'
    do: [ 
      spec description: 'MetacelloScriptingResource>>configurationGithubReferenceXXX:'.
      spec
        configuration: 'External'
        with: [ 
          spec
            version: '0.9.0';
            repository: 'http://ss3.gemtalksystems.com/ss/external' ] ]! !

!MetacelloScriptingResource methodsFor: 'issue 63' stamp: 'dkh 07/20/2013 03:59'!
configuration097Issue185: spec
  <version: '0.9.7'>
  spec
    for: #'common'
    do: [ 
      spec description: 'MetacelloScriptingResource>>configuration0957Issue185:'.
      spec
        baseline: 'External'
          with: [ 
              spec
                repository:
                  'github://dalehenrich/external:'
                    , MetacelloScriptingResource externalCustomIssue185SHA4
                    , '/repository' ];
        import: 'External' ]! !

!MetacelloScriptingResource methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
configurationRepository
    ^ configurationRepository! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - github reference' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpBaselineGithubReferenceXX
    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'BaselineOfGithubRefXX-dkh.1'.
    className := #'BaselineOfGithubRefXX'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'BaselineOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'baselineGithubReferenceXX:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineGithubReferenceXX:') asString)}.
    externalRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'issue 84' stamp: 'dkh 7/24/2012 20:20'!
setUpConfigurationNextedIssue84dkh1
    "see https://github.com/dalehenrich/metacello-work/issues/84"

    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'ConfigurationOfNestedIssue84-dkh.1'.
    className := #'ConfigurationOfNestedIssue84'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'ConfigurationOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'version10NestedIssue84:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version10NestedIssue84:') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'versionNumberClass'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'versionNumberClass') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'customProjectAttributes'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'customProjectAttributes') asString)}.
    configurationRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'issue 63' stamp: 'dkh 07/16/2013 14:11'!
configuration091Issue181: spec
  <version: '0.9.1'>
  spec
    for: #'common'
    do: [ 
      spec description: 'MetacelloScriptingResource>>configuration091Issue181:'.
      spec
        baseline: 'External'
          with: [ 
              spec
                repository:
                  'github://dalehenrich/external:' , MetacelloScriptingResource externalCustomSHA
                    , '/repository' ];
        import: 'External' ]! !

!MetacelloScriptingResource methodsFor: 'issue 32' stamp: 'dkh 6/18/2012 15:07'!
setUpBaselineIssue32
    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'BaselineOfIssue32-dkh.1'.
    className := #'BaselineOfIssue32'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'BaselineOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'postloadDoIt'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'postloadDoIt') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'preloadDoIt'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'preloadDoIt') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'baselineIssue32:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineIssue32:') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'customProjectAttributes'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'customProjectAttributes') asString)}.
    externalRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'issue 63' stamp: 'dkh 07/16/2013 14:11'!
configuration092Issue181: spec
  <version: '0.9.2'>
  spec
    for: #'common'
    do: [ 
      spec description: 'MetacelloScriptingResource>>configuration092Issue181:'.
      spec
        baseline: 'External'
          with: [ 
              spec
                repository:
                  'github://dalehenrich/external:'
                    , MetacelloScriptingResource externalCustomIssue181SHA
                    , '/repository' ];
        import: 'External' ]! !

!MetacelloScriptingResource methodsFor: 'baseline:with:' stamp: 'dkh 6/22/2012 17:23'!
conflictOf11: spec
    <version: '1.1.0'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'development'.
            spec description: 'MetacelloScriptingResource>>conflictOf11:'.
            spec author: 'dkh'.
            spec timestamp: '6/1/2012 14:46' ].
    spec
        for: #'custom'
        do: [ 
            spec
                configuration: 'ExternalX'
                with: [ 
                    spec
                        version: '0.9.0';
                        repository: 'dictionary://Metacello_Conflict_Test_Repository' ] ]! !

!MetacelloScriptingResource methodsFor: 'invalid configurations' stamp: 'dkh 6/22/2012 17:24'!
invalidConfiguration30: spec
    <version: '3.0.0'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'release'.
            spec description: 'MetacelloScriptingResource>>invalidConfiguration30: ... missing repository:'.
            spec
                project: 'External'
                with: [ 
                    spec
                        className: 'ConfigurationOfExternal';
                        version: '0.9.0' ] ]! !

!MetacelloScriptingResource methodsFor: 'external configurations' stamp: 'dkh 6/22/2012 17:25'!
versionOfXXX: spec
    <version: '0.9.0'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'development'.
            spec description: 'MetacelloScriptingResource>>versionOfXXX:'.
            spec author: 'dkh'.
            spec timestamp: '5/4/2012 14:16'.
            spec
                baseline: 'External'
                with: [ spec repository: 'github://dalehenrich/external:' , MetacelloScriptingResource externalCustomSHA , '/repository' ] ]! !

!MetacelloScriptingResource methodsFor: 'external configurations' stamp: 'dkh 7/21/2012 14:32'!
setUpConfigurationOfExternalIV
    "see https://github.com/dalehenrich/metacello-work/issues/6"

    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'ConfigurationOfExternalIV-dkh.1'.
    className := #'ConfigurationOfExternalIV'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'ConfigurationOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'versionOfIV:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'versionOfIV:') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'customProjectAttributes'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'customProjectAttributes') asString)}.
    configurationRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'issue 63' stamp: 'dkh 07/16/2013 14:11'!
configuration091Issue63: spec
  <version: '0.9.1'>
  spec
    for: #'common'
    do: [ 
      spec description: 'MetacelloScriptingResource>>configuration091Issue63:'.
      spec
        baseline: 'External'
          with: [ 
              spec
                repository:
                  'github://dalehenrich/external:' , MetacelloScriptingResource externalCustomSHA
                    , '/repository' ];
        import: 'External' ]! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - github reference' stamp: 'dkh 6/22/2012 17:22'!
configurationGithubReferenceIV: spec
    <baseline>
    spec
        for: #'common'
        do: [ 
            spec description: 'MetacelloScriptingResource>>configurationGithubReferenceIV:'.
            spec
                project: 'External'
                with: [ 
                    spec
                        className: 'ConfigurationOfExternal';
                        version: '0.9.0';
                        repository:
                                'github://dalehenrich/external:' , MetacelloScriptingResource externalConfigurationSHA , '/repository' ] ]! !

!MetacelloScriptingResource methodsFor: 'issue 32' stamp: 'dkh 6/22/2012 17:24'!
version10Issue47: spec
    <version: '1.0.0'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'development'.
            spec description: 'MetacelloScriptingResource>>version10Issue47:'.
            spec author: 'dkh'.
            spec timestamp: '6/18/2012 14:34'.
            spec baseline: 'Issue32' ].
    spec
        for: #'custom'
        do: [ spec baseline: 'Issue32' with: [ spec repository: 'dictionary://Metacello_External_Test_Repository' ] ]! !

!MetacelloScriptingResource methodsFor: 'issue 32' stamp: 'dkh 6/22/2012 18:11'!
version10Issue59: spec
    <version: '1.0'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'development'.
            spec description: 'MetacelloScriptingResource>>version10Issue59:'.
            spec author: 'dkh'.
            spec timestamp: '6/18/2012 14:34'.
            spec baseline: 'Issue32' ].
    spec
        for: #'custom'
        do: [ spec baseline: 'Issue32' with: [ spec repository: 'dictionary://Metacello_External_Test_Repository' ] ]! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - external' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpBaselineOfExternalXX
    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'BaselineOfExternalXX-dkh.1'.
    className := #'BaselineOfExternalXX'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'BaselineOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'externalBaselineXX:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'externalBaselineXX:') asString)}.
    externalRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'external core' stamp: 'dkh 07/26/2013 09:48'!
setUpExternalCoreX
  "self reset"

  | reference className definitionArray versionInfo |
  reference := GoferVersionReference name: 'External-CoreX-dkh.1'.
  className := #'ExternalCoreX'.
  definitionArray := {(MCOrganizationDefinition
    categories: (Array with: reference packageName asSymbol)).
  (MCClassDefinition
    name: className
    superclassName: #'Object'
    category: reference packageName
    instVarNames: #()
    comment: '').
  (MCMethodDefinition
    className: className asString
    classIsMeta: true
    selector: 'externalAuthorName'
    category: 'cat'
    timeStamp: ''
    source: (self class sourceCodeAt: #'externalAuthorName') asString).
  (MCMethodDefinition
    className: 'Object'
    classIsMeta: true
    selector: 'isExternal'
    category: '*external-corex'
    timeStamp: ''
    source: (self class sourceCodeAt: #'isExternal') asString)}.
  externalRepository
    basicStoreVersion:
      (MCVersion new
        setPackage: (MetacelloTestsMCPackage new name: reference packageName)
        info:
          (versionInfo := MCVersionInfo
            name: reference name
            id: UUID new
            message: 'This is a mock version'
            date: Date today
            time: Time now
            author: reference author
            ancestors: #())
        snapshot: (MCSnapshot fromDefinitions: definitionArray)
        dependencies: #()).
  ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - github reference' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpBaselineGithubReferenceVI
    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'BaselineOfGithubRefVI-dkh.1'.
    className := #'BaselineOfGithubRefVI'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'BaselineOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'configurationGithubReferenceXXX:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'configurationGithubReferenceXXX:') asString)}.
    externalRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
externalRepository
    ^ externalRepository! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - github reference' stamp: 'dkh 6/22/2012 17:22'!
configurationGithubReferenceX: spec
    <baseline>
    spec
        for: #'common'
        do: [ 
            spec description: 'MetacelloScriptingResource>>configurationGithubReferenceX:'.
            spec
                project: 'External'
                with: [ 
                    spec
                        className: 'ConfigurationOfExternal';
                        version: '0.9.0';
                        repository:
                                'github://dalehenrich/external:' , MetacelloScriptingResource externalConfigurationSHA , '/repository' ] ]! !

!MetacelloScriptingResource methodsFor: 'issue 59' stamp: 'dkh 6/22/2012 18:13'!
setUpConfigurationIssue59
    "see https://github.com/dalehenrich/metacello-work/issues/59"

    "Use MetacelloVersionNumber instead of MetacelloSematicVersionNumber"

    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'ConfigurationOfIssue59-dkh.1'.
    className := #'ConfigurationOfIssue59'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'ConfigurationOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'version10Issue59:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version10Issue59:') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'versionNumberClass'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'versionNumberClass') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'customProjectAttributes'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'customProjectAttributes') asString)}.
    configurationRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'external core' stamp: 'dkh 6/12/2012 15:41:23.319'!
externalAuthorName
    ^ 'dkh'! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - github reference' stamp: 'dkh 6/12/2012 15:41:23.319'!
baselineGithubReferenceVII: spec
    <baseline>
    spec
        for: #'common'
        do: [ 
            spec description: 'MetacelloScriptingResource>>baselineGithubReferenceVII:'.
            spec
                baseline: 'External Core'
                    with: [ 
                            spec
                                className: 'BaselineOfExternal';
                                loads: 'Core';
                                repository:
                                        'github://dalehenrich/external:' , MetacelloScriptingResource externalCustomSHA , '/repository' ];
                project: 'External Tests' copyFrom: 'External Core' with: [ spec loads: 'Tests' ] ]! !

!MetacelloScriptingResource methodsFor: 'baseline:with:' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpMarianosImage
    "className: test case
	seehttps://github.com/dalehenrich/metacello-work/issues/24"

    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'MarianosImage-dkh.1'.
    className := #'MarianosImage'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'ConfigurationOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'versionOfMariano:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'versionOfMariano:') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'customProjectAttributes'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'customProjectAttributes') asString)}.
    configurationRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'issue 32' stamp: 'dkh 6/18/2012 14:37'!
postloadDoIt
	"self reset"

	Smalltalk at: #'Metacello_Configuration_Test_POST_DoIt_Result' put: true! !

!MetacelloScriptingResource methodsFor: 'baseline:with:' stamp: 'dkh 7/21/2012 14:20'!
setUpConfigurationOfExternalXX
    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'ConfigurationOfExternalXX-dkh.1'.
    className := #'ConfigurationOfExternalXX'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'ConfigurationOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'versionOfXX:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'versionOfXX:') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'customProjectAttributes'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'customProjectAttributes') asString)}.
    configurationRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'sample repository' stamp: 'dkh 6/12/2012 15:41:23.319'!
isSample
    ^ false! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - github reference' stamp: 'dkh 6/22/2012 17:22'!
configurationGithubReferenceV: spec
    <baseline>
    spec
        for: #'common'
        do: [ 
            spec description: 'MetacelloScriptingResource>>configurationGithubReferenceV:'.
            spec
                project: 'External'
                    with: [ 
                            spec
                                className: 'ConfigurationOfExternal';
                                version: '0.9.0';
                                loads: 'Core';
                                repository:
                                        'github://dalehenrich/external:' , MetacelloScriptingResource externalConfigurationSHA , '/repository' ];
                project: 'External Tests' copyFrom: 'External' with: [ spec loads: 'Tests' ] ]! !

!MetacelloScriptingResource methodsFor: 'external configurations' stamp: 'dkh 6/12/2012 15:41:23.319'!
versionOfX091: spec
    <version: '0.9.1'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'development'.
            spec description: 'MetacelloScriptingResource>>versionOfX091:'.
            spec author: 'dkh'.
            spec timestamp: '5/4/2012 14:16' ].
    spec
        for: #'custom'
        do: [ spec baseline: 'ExternalX' with: [ spec repository: 'dictionary://Metacello_Configuration_Test_Repository' ] ]! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - external' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpBaselineOfExternalX
    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'BaselineOfExternalX-dkh.1'.
    className := #'BaselineOfExternalX'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'BaselineOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'externalBaselineX:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'externalBaselineX:') asString)}.
    externalRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'issue 84' stamp: 'dkh 8/3/2012 17:24'!
setUpConfigurationNextedIssue84
    "see https://github.com/dalehenrich/metacello-work/issues/84"

    "self reset"

    | versionInfo |
    versionInfo := self setUpConfigurationNextedIssue84dkh1.
    self setUpConfigurationNextedIssue84dkh2: {versionInfo}! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - external' stamp: 'dkh 6/12/2012 15:41:23.319'!
externalBaselineX: spec
    <baseline>
    spec description: 'MetacelloScriptingResource>>externalBaselineX:'.
    spec
        package: 'External-CoreX';
        package: 'External-TestsX' with: [ spec requires: 'External-CoreX' ];
        yourself.
    spec
        group: 'Core' with: #('External-CoreX');
        group: 'default' with: #('Core');
        group: 'Tests' with: #('External-TestsX');
        yourself! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - github reference' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpBaselineGithubReferenceVIII
    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'BaselineOfGithubRefVIII-dkh.1'.
    className := #'BaselineOfGithubRefVIII'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'BaselineOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'baselineGithubReferenceV:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineGithubReferenceV:') asString)}.
    externalRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'invalid configurations' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpInvalidConfigurations
    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'ConfigurationOfInvalidConfigurations-dkh.1'.
    className := #'ConfigurationOfInvalidConfigurations'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'ConfigurationOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'invalidConfiguration10:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'invalidConfiguration10:') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'invalidConfiguration20:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'invalidConfiguration20:') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'invalidConfiguration30:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'invalidConfiguration30:') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'customProjectAttributes'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'customProjectAttributes') asString)}.
    configurationRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'issue 32' stamp: 'dkh 6/22/2012 17:24'!
version09Issue32: spec
    <version: '0.9.0'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'development'.
            spec description: 'MetacelloScriptingResource>>baselineOfIssue32:'.
            spec author: 'dkh'.
            spec timestamp: '6/18/2012 14:34' ].
    spec
        for: #'custom'
        do: [ spec baseline: 'Issue32' with: [ spec repository: 'dictionary://Metacello_External_Test_Repository' ] ]! !

!MetacelloScriptingResource methodsFor: 'invalid configurations' stamp: 'dkh 6/22/2012 17:23'!
invalidConfiguration10: spec
    <version: '1.0.0'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'release'.
            spec description: 'MetacelloScriptingResource>>invalidConfiguration10: ... missing className:'.
            spec
                project: 'External'
                with: [ 
                    spec
                        version: '0.9.0';
                        repository:
                                'github://dalehenrich/external:' , MetacelloScriptingResource externalConfigurationSHA , '/repository' ] ]! !

!MetacelloScriptingResource methodsFor: 'external core' stamp: 'ChristopheDemarey 9/12/2013 18:36'!
setUpExternalCore
  "self reset"

  | reference className definitionArray versionInfo |
  reference := GoferVersionReference name: 'External-Core-dkh.1'.
  className := #'ExternalCore'.
  definitionArray := {(MCOrganizationDefinition
    categories: (Array with: reference packageName asSymbol)).
  (MCClassDefinition
    name: className
    superclassName: #'Object'
    category: reference packageName
    instVarNames: #()
    comment: '').
  (MCMethodDefinition
    className: className asString
    classIsMeta: true
    selector: 'externalAuthorName'
    category: 'cat'
    timeStamp: ''
    source: (self class sourceCodeAt: #'externalAuthorName') asString).
  (MCMethodDefinition
    className: 'Object'
    classIsMeta: true
    selector: 'isExternal'
    category: '*external-core'
    timeStamp: ''
    source: (self class sourceCodeAt: #'isExternal') asString)}.
  externalRepository
    basicStoreVersion:
      (MCVersion new
        setPackage: (MetacelloTestsMCPackage new name: reference packageName)
        info:
          (versionInfo := MCVersionInfo
            name: reference name
            id: UUID new
            message: 'This is a mock version'
            date: Date today
            time: Time now
            author: reference author
            ancestors: #())
        snapshot: (MCSnapshot fromDefinitions: definitionArray)
        dependencies: #()).
  ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - github reference' stamp: 'dkh 07/29/2013 07:34'!
setUpConfigurationExternalRef
  "self reset"

  | reference className definitionArray versionInfo |
  reference := GoferVersionReference name: 'ConfigurationOfExternalRef-dkh.1'.
  className := #'ConfigurationOfExternalRef'.
  definitionArray := {(MCOrganizationDefinition
    categories: (Array with: reference packageName asSymbol)).
  (MCClassDefinition
    name: className
    superclassName: #'ConfigurationOf'
    category: reference packageName
    instVarNames: #()
    comment: '').
  (MCMethodDefinition
    className: className asString
    classIsMeta: false
    selector: 'configurationExternalRef090:'
    category: 'cat'
    timeStamp: ''
    source: (self class sourceCodeAt: #'configurationExternalRef090:') asString).
  (MCMethodDefinition
    className: className asString
    classIsMeta: false
    selector: 'configurationExternalRef091:'
    category: 'cat'
    timeStamp: ''
    source: (self class sourceCodeAt: #'configurationExternalRef091:') asString)}.
  externalRepository
    basicStoreVersion:
      (MCVersion new
        setPackage: (MetacelloTestsMCPackage new name: reference packageName)
        info:
          (versionInfo := MCVersionInfo
            name: reference name
            id: UUID new
            message: 'This is a mock version'
            date: Date today
            time: Time now
            author: reference author
            ancestors: #())
        snapshot: (MCSnapshot fromDefinitions: definitionArray)
        dependencies: #()).
  ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'locking' stamp: 'dkh 7/20/2012 16:50'!
setUpLockConfigurations
    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'ConfigurationOfLockConfigurations-dkh.1'.
    className := #'ConfigurationOfLockConfigurations'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'ConfigurationOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'lockConfiguration10:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'lockConfiguration10:') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'lockConfiguration11:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'lockConfiguration11:') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'customProjectAttributes'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'customProjectAttributes') asString)}.
    configurationRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'external configurations' stamp: 'dkh 07/26/2013 09:58'!
versionOfExternal091: spec
  <version: '0.9.1'>
  spec
    for: #'common'
    do: [ 
      spec blessing: #'development'.
      spec description: 'MetacelloScriptingResource>>versionOfExternal091:'.
      spec author: 'dkh'.
      spec timestamp: '5/4/2012 14:16'.
      spec
        baseline: 'External'
        with: [ 
          spec
            repository:
              'github://dalehenrich/external:' , MetacelloScriptingResource externalCustomSHA
                , '/repository' ] ]! !

!MetacelloScriptingResource methodsFor: 'issue 59' stamp: 'dkh 6/22/2012 18:07'!
versionNumberClass
    ^ MetacelloVersionNumber! !

!MetacelloScriptingResource methodsFor: 'external configurations' stamp: 'dkh 7/21/2012 14:21'!
versionOfIV: spec
    <version: '0.9.0'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'development'.
            spec description: 'MetacelloScriptingResource>>baselineOfIV:'.
            spec author: 'dkh'.
            spec timestamp: '5/4/2012 14:16' ].
    spec
        for: #'custom'
        do: [ spec baseline: 'ExternalX' with: [ spec repository: 'dictionary://Metacello_Configuration_Test_Repository' ] ]! !

!MetacelloScriptingResource methodsFor: 'external configurations' stamp: 'dkh 07/29/2013 13:46'!
setUpConfigurationOfExternaldkh1
  "self reset"

  | reference className definitionArray versionInfo |
  reference := GoferVersionReference name: 'ConfigurationOfExternal-dkh.1'.
  className := #'ConfigurationOfExternal'.
  definitionArray := {(MCOrganizationDefinition
    categories: (Array with: reference packageName asSymbol)).
  (MCClassDefinition
    name: className
    superclassName: #'ConfigurationOf'
    category: reference packageName
    instVarNames: #()
    comment: '').
  (MCMethodDefinition
    className: className asString
    classIsMeta: false
    selector: 'versionOfExternal090:'
    category: 'cat'
    timeStamp: ''
    source: (self class sourceCodeAt: #'versionOfExternal090:') asString)}.
  externalRepository
    basicStoreVersion:
      (MCVersion new
        setPackage: (MetacelloTestsMCPackage new name: reference packageName)
        info:
          (versionInfo := MCVersionInfo
            name: reference name
            id: UUID new
            message: 'This is a mock version'
            date: Date today
            time: Time now
            author: reference author
            ancestors: #())
        snapshot: (MCSnapshot fromDefinitions: definitionArray)
        dependencies: #()).
  ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - external' stamp: 'dkh 6/12/2012 15:41:23.319'!
externalBaselineXXX: spec
    <baseline>
    spec
        for: #'common'
        do: [ 
            spec description: 'MetacelloScriptingResource>>externalBaselineXXX:'.
            spec
                package: 'External-CoreX';
                package: 'External-TestsX' with: [ spec requires: 'External-CoreX' ];
                yourself.
            spec
                group: 'Core' with: #('External-CoreX');
                group: 'default' with: #('Core');
                group: 'Tests' with: #('External-TestsX');
                yourself ].
    spec
        for: #'custom'
        do: [ 
            spec package: 'External-UIX'.
            spec group: 'UI' with: #('External-UIX') ]! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - external' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpBaselineOfExternalXXX
    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'BaselineOfExternalXXX-dkh.1'.
    className := #'BaselineOfExternalXXX'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'BaselineOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'externalBaselineXXX:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'externalBaselineXXX:') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'customProjectAttributes'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'customProjectAttributes') asString)}.
    externalRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'external configurations' stamp: 'dkh 7/21/2012 14:03'!
stableVersionOfX: spec
    "self reset"

    <symbolicVersion: #'stable'>
    spec for: #'common' version: '0.9.0'! !

!MetacelloScriptingResource methodsFor: 'issue 63' stamp: 'dkh 07/16/2013 14:11'!
configuration092Issue63: spec
  <version: '0.9.2'>
  spec
    for: #'common'
    do: [ 
      spec description: 'MetacelloScriptingResource>>configuration092Issue63:'.
      spec
        baseline: 'External'
          with: [ 
              spec
                repository:
                  'github://dalehenrich/external:' , MetacelloScriptingResource externalCustomSHA
                    , '/repository' ];
        package: 'GoferBar'
          with: [ 
              spec
                file: 'GoferBar-lr.1';
                repository: 'dictionary://Metacello_Gofer_Test_Repository' ];
        package: 'GoferFoo'
          with: [ 
              spec
                file: 'GoferFoo-lr.2';
                requires: 'External';
                repository: 'dictionary://Metacello_Gofer_Test_Repository' ];
        import: 'External' ]! !

!MetacelloScriptingResource methodsFor: 'external core' stamp: 'dkh 6/12/2012 15:41:23.319'!
isExternal
    ^ false! !

!MetacelloScriptingResource methodsFor: 'issue 84' stamp: 'dkh 7/24/2012 20:11'!
version10NestedIssue84: spec
    <version: '1.0.0'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'development'.
            spec description: 'MetacelloScriptingResource>>version10NestedIssue84:'.
            spec author: 'dkh'.
            spec timestamp: '7/24/2012 19:23'.
            spec repository: 'dictionary://Metacello_Configuration_Test_Repository'.
            spec package: 'External-CoreX' ]! !

!MetacelloScriptingResource methodsFor: 'baseline:with:' stamp: 'dkh 6/22/2012 17:23'!
conflictOf10: spec
    <version: '1.0.0'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'development'.
            spec description: 'MetacelloScriptingResource>>conflictOf10:'.
            spec author: 'dkh'.
            spec timestamp: '6/1/2012 14:46' ].
    spec
        for: #'custom'
        do: [ 
            spec
                configuration: 'ExternalX'
                with: [ 
                    spec
                        version: '0.9.1';
                        repository: 'dictionary://Metacello_Conflict_Test_Repository' ] ]! !

!MetacelloScriptingResource methodsFor: 'external configurations' stamp: 'dkh 7/21/2012 14:16'!
setUpConfigurationOfExternalXXX
    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'ConfigurationOfExternalXXX-dkh.1'.
    className := #'ConfigurationOfExternalXXX'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'ConfigurationOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'versionOfXXX:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'versionOfXXX:') asString)}.
    configurationRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'issue 63' stamp: 'dkh 07/19/2013 15:32'!
setUpConfiguration181
  "self reset"

  | reference className definitionArray versionInfo |
  reference := GoferVersionReference name: 'ConfigurationOfIssue181-dkh.1'.
  className := #'ConfigurationOfIssue181'.
  definitionArray := {(MCOrganizationDefinition
    categories: (Array with: reference packageName asSymbol)).
  (MCClassDefinition
    name: className
    superclassName: #'ConfigurationOf'
    category: reference packageName
    instVarNames: #()
    comment: '').
  (MCMethodDefinition
    className: className asString
    classIsMeta: false
    selector: 'configuration091Issue181:'
    category: 'cat'
    timeStamp: ''
    source: (self class sourceCodeAt: #'configuration091Issue181:') asString).
  (MCMethodDefinition
    className: className asString
    classIsMeta: false
    selector: 'configuration092Issue181:'
    category: 'cat'
    timeStamp: ''
    source: (self class sourceCodeAt: #'configuration092Issue181:') asString).
  (MCMethodDefinition
    className: className asString
    classIsMeta: false
    selector: 'configuration093Issue185:'
    category: 'cat'
    timeStamp: ''
    source: (self class sourceCodeAt: #'configuration093Issue185:') asString).
  (MCMethodDefinition
    className: className asString
    classIsMeta: false
    selector: 'configuration094Issue185:'
    category: 'cat'
    timeStamp: ''
    source: (self class sourceCodeAt: #'configuration094Issue185:') asString).
  (MCMethodDefinition
    className: className asString
    classIsMeta: false
    selector: 'configuration095Issue185:'
    category: 'cat'
    timeStamp: ''
    source: (self class sourceCodeAt: #'configuration095Issue185:') asString).
  (MCMethodDefinition
    className: className asString
    classIsMeta: false
    selector: 'configuration096Issue185:'
    category: 'cat'
    timeStamp: ''
    source: (self class sourceCodeAt: #'configuration096Issue185:') asString).
  (MCMethodDefinition
    className: className asString
    classIsMeta: false
    selector: 'configuration097Issue185:'
    category: 'cat'
    timeStamp: ''
    source: (self class sourceCodeAt: #'configuration097Issue185:') asString)}.
  configurationRepository
    basicStoreVersion:
      (MCVersion new
        setPackage: (MetacelloTestsMCPackage new name: reference packageName)
        info:
          (versionInfo := MCVersionInfo
            name: reference name
            id: UUID new
            message: 'This is a mock version'
            date: Date today
            time: Time now
            author: reference author
            ancestors: #())
        snapshot: (MCSnapshot fromDefinitions: definitionArray)
        dependencies: #()).
  ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'issue 63' stamp: 'dkh 07/20/2013 03:58'!
configuration094Issue185: spec
  <version: '0.9.4'>
  spec
    for: #'common'
    do: [ 
      spec description: 'MetacelloScriptingResource>>configuration094Issue185:'.
      spec
        baseline: 'External'
          with: [ 
              spec
                repository:
                  'github://dalehenrich/external:'
                    , MetacelloScriptingResource externalCustomIssue185SHA1
                    , '/repository' ];
        import: 'External' ]! !

!MetacelloScriptingResource methodsFor: 'external configurations' stamp: 'dkh 7/21/2012 14:16'!
setUpConfigurationOfExternalXdkh1
    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'ConfigurationOfExternalX-dkh.1'.
    className := #'ConfigurationOfExternalX'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'ConfigurationOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'stableVersionOfX:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'stableVersionOfX:') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'versionOfX090:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'versionOfX090:') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'customProjectAttributes'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'customProjectAttributes') asString)}.
    configurationRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'baseline:with:' stamp: 'dkh 6/22/2012 17:23'!
conflictOf12: spec
    <version: '1.2.0'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'development'.
            spec description: 'MetacelloScriptingResource>>conflictOf12:'.
            spec author: 'dkh'.
            spec timestamp: '6/1/2012 14:46' ].
    spec
        for: #'custom'
        do: [ 
            spec
                configuration: 'ExternalX'
                with: [ 
                    spec
                        operator: #'=';
                        version: '0.9.2';
                        repository: 'dictionary://Metacello_Conflict_Test_Repository'	"#= forces conflict" ] ]! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - github reference' stamp: 'dkh 6/12/2012 15:41:23.319'!
baselineGithubReferenceV: spec
    <baseline>
    spec
        for: #'common'
        do: [ 
            spec description: 'MetacelloScriptingResource>>baselineGithubReferenceV:'.
            spec
                baseline: 'External'
                with: [ spec repository: 'github://dalehenrich/external:' , MetacelloScriptingResource externalCustomSHA , '/repository' ] ]! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - github reference' stamp: 'dkh 07/29/2013 07:47'!
configurationExternalRef090: spec
  <version: '0.9.0'>
  spec
    for: #'common'
    do: [ 
      spec blessing: #'version'.
      spec
        description: 'MetacelloScriptingResource>>configurationExternalRef090:'.
      spec
        project: 'External'
        with: [ 
          spec
            className: 'ConfigurationOfExternal';
            version: '0.9.0';
            repository: 'dictionary://Metacello_Configuration_Test_Repository' ] ]! !

!MetacelloScriptingResource methodsFor: 'external configurations' stamp: 'dkh 07/29/2013 13:46'!
setUpConfigurationOfExternaldkh2
  "self reset"

  | reference className definitionArray versionInfo |
  reference := GoferVersionReference name: 'ConfigurationOfExternal-dkh.2'.
  className := #'ConfigurationOfExternal'.
  definitionArray := {(MCOrganizationDefinition
    categories: (Array with: reference packageName asSymbol)).
  (MCClassDefinition
    name: className
    superclassName: #'ConfigurationOf'
    category: reference packageName
    instVarNames: #()
    comment: '').
  (MCMethodDefinition
    className: className asString
    classIsMeta: false
    selector: 'versionOfExternal090:'
    category: 'cat'
    timeStamp: ''
    source: (self class sourceCodeAt: #'versionOfExternal090:') asString).
  (MCMethodDefinition
    className: className asString
    classIsMeta: false
    selector: 'versionOfExternal091:'
    category: 'cat'
    timeStamp: ''
    source: (self class sourceCodeAt: #'versionOfExternal091:') asString)}.
  externalRepository
    basicStoreVersion:
      (MCVersion new
        setPackage: (MetacelloTestsMCPackage new name: reference packageName)
        info:
          (versionInfo := MCVersionInfo
            name: reference name
            id: UUID new
            message: 'This is a mock version'
            date: Date today
            time: Time now
            author: reference author
            ancestors: #())
        snapshot: (MCSnapshot fromDefinitions: definitionArray)
        dependencies: #()).
  ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'baseline:with:' stamp: 'dkh 6/22/2012 17:24'!
versionOfMariano: spec
    <version: '0.9.0'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'development'.
            spec description: 'MetacelloScriptingResource>>versionOfMariano:'.
            spec author: 'dkh'.
            spec timestamp: '5/31/2012 16:04' ].
    spec
        for: #'custom'
        do: [ spec baseline: 'ExternalX' with: [ spec repository: 'dictionary://Metacello_Configuration_Test_Repository' ] ]! !

!MetacelloScriptingResource methodsFor: 'issue 32' stamp: 'dkh 6/18/2012 14:37'!
preloadDoIt
	"self reset"

	Smalltalk at: #'Metacello_Configuration_Test_DoIt_Result' put: true! !

!MetacelloScriptingResource methodsFor: 'accessing' stamp: 'dkh 6/12/2012 15:41:23.319'!
sampleRepository
    ^ sampleRepository! !

!MetacelloScriptingResource methodsFor: 'issue 32' stamp: 'dkh 6/18/2012 15:47'!
setUpConfigurationIssue32
    "see https://github.com/dalehenrich/metacello-work/issues/32"

    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'ConfigurationOfIssue32-dkh.1'.
    className := #'ConfigurationOfIssue32'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'ConfigurationOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'version10Issue47:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version10Issue47:') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'version09Issue32:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version09Issue32:') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'customProjectAttributes'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'customProjectAttributes') asString)}.
    configurationRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'issue 63' stamp: 'dkh 07/20/2013 03:59'!
configuration096Issue185: spec
  <version: '0.9.6'>
  spec
    for: #'common'
    do: [ 
      spec description: 'MetacelloScriptingResource>>configuration0956Issue185:'.
      spec
        baseline: 'External'
          with: [ 
              spec
                repository:
                  'github://dalehenrich/external:'
                    , MetacelloScriptingResource externalCustomIssue185SHA3
                    , '/repository' ];
        import: 'External' ]! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - github reference' stamp: 'dkh 6/22/2012 17:22'!
configurationGithubReferenceXX: spec
    <baseline>
    spec
        for: #'common'
        do: [ 
            spec description: 'MetacelloScriptingResource>>configurationGithubReferenceXX:'.
            spec
                configuration: 'External'
                with: [ 
                    spec
                        version: '0.9.0';
                        repository:
                                'github://dalehenrich/external:' , MetacelloScriptingResource externalConfigurationSHA , '/repository' ] ]! !

!MetacelloScriptingResource methodsFor: 'sample repository' stamp: 'dkh 6/12/2012 15:41:23.319'!
sampleAuthorName
    ^ (Smalltalk at: #'ExternalCore') new externalAuthorName! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - github reference' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpBaselineGithubReferenceIV
    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'BaselineOfGithubRefIV-dkh.1'.
    className := #'BaselineOfGithubRefIV'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'BaselineOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'configurationGithubReferenceX:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'configurationGithubReferenceX:') asString)}.
    externalRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'issue 63' stamp: 'dkh 6/26/2012 16:45'!
setUpConfiguration63
    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'ConfigurationOfIssue63-dkh.1'.
    className := #'ConfigurationOfIssue63'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'ConfigurationOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'configuration091Issue63:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'configuration091Issue63:') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'configuration092Issue63:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'configuration092Issue63:') asString)}.
    configurationRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'locking' stamp: 'dkh 7/20/2012 16:48'!
lockConfiguration11: spec
    <version: '1.1.0'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'release'.
            spec description: 'MetacelloScriptingResource>>lockConfiguration10: '.
            spec
                configuration: 'ExternalX'
                with: [ 
                    spec
                        version: '0.9.1';
                        repository: 'dictionary://Metacello_Config_Test_Repository' ] ]! !

!MetacelloScriptingResource methodsFor: 'external configurations' stamp: 'dkh 6/22/2012 17:24'!
versionOfX090: spec
    <version: '0.9.0'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'development'.
            spec description: 'MetacelloScriptingResource>>versionOfX090:'.
            spec author: 'dkh'.
            spec timestamp: '5/4/2012 14:16' ].
    spec
        for: #'custom'
        do: [ spec baseline: 'ExternalX' with: [ spec repository: 'dictionary://Metacello_Configuration_Test_Repository' ] ]! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - github reference' stamp: 'dkh 6/12/2012 15:41:23.319'!
baselineGithubReferenceVI: spec
    <baseline>
    spec
        for: #'common'
        do: [ 
            spec description: 'MetacelloScriptingResource>>baselineGithubReferenceVI:'.
            spec
                baseline: 'External Core'
                    with: [ 
                            spec
                                className: 'BaselineOfExternal';
                                loads: 'Core';
                                repository:
                                        'github://dalehenrich/external:' , MetacelloScriptingResource externalCustomSHA , '/repository' ];
                baseline: 'External Tests'
                    with: [ 
                            spec
                                className: 'BaselineOfExternal';
                                loads: 'Tests';
                                repository:
                                        'github://dalehenrich/external:' , MetacelloScriptingResource externalCustomSHA , '/repository' ] ]! !

!MetacelloScriptingResource methodsFor: 'issue 63' stamp: 'dkh 07/20/2013 03:58'!
configuration095Issue185: spec
  <version: '0.9.5'>
  spec
    for: #'common'
    do: [ 
      spec description: 'MetacelloScriptingResource>>configuration095Issue185:'.
      spec
        baseline: 'External'
          with: [ 
              spec
                repository:
                  'github://dalehenrich/external:'
                    , MetacelloScriptingResource externalCustomIssue185SHA2
                    , '/repository' ];
        import: 'External' ]! !

!MetacelloScriptingResource methodsFor: 'external repository' stamp: 'dkh 6/12/2012 15:41:23.319'!
customProjectAttributes
    ^ #(#custom)! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - github reference' stamp: 'dkh 06/29/2013 12:27'!
baselineGithubReferenceIV: spec
  <baseline>
  spec
    for: #'common'
    do: [ 
      spec description: 'MetacelloScriptingResource>>baselineGithubReferenceIV:'.
      spec
        baseline: 'External'
        with: [ spec repository: 'http://ss3.gemtalksystems.com/ss/external' ] ]! !

!MetacelloScriptingResource methodsFor: 'locking' stamp: 'dkh 7/20/2012 16:48'!
lockConfiguration10: spec
    <version: '1.0.0'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'release'.
            spec description: 'MetacelloScriptingResource>>lockConfiguration10: '.
            spec
                configuration: 'ExternalX'
                with: [ 
                    spec
                        version: '0.9.0';
                        repository: 'dictionary://Metacello_Config_Test_Repository' ] ]! !

!MetacelloScriptingResource methodsFor: 'baseline:with:' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpConfigurationOfConflict
    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'ConfigurationOfConflict-dkh.1'.
    className := #'ConfigurationOfConflict'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'ConfigurationOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'conflictOf10:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'conflictOf10:') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'conflictOf11:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'conflictOf11:') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'conflictOf12:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'conflictOf12:') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'customProjectAttributes'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'customProjectAttributes') asString)}.
    configurationRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - github reference' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpBaselineGithubReferenceIX
    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'BaselineOfGithubRefIX-dkh.1'.
    className := #'BaselineOfGithubRefIX'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'BaselineOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'configurationGithubReferenceIV:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'configurationGithubReferenceIV:') asString)}.
    externalRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - github reference' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpBaselineGithubReferenceXIII
    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'BaselineOfGithubRefXIII-dkh.1'.
    className := #'BaselineOfGithubRefXIII'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'BaselineOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'baselineGithubReferenceVII:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineGithubReferenceVII:') asString)}.
    externalRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'issue 32' stamp: 'dkh 6/18/2012 14:38'!
baselineIssue32: spec
    <baseline>
    spec
        for: #'common'
        do: [ 
            spec description: 'MetacelloScriptingResource>>baselineIssue32:'.
            spec
                package: 'External-CoreX';
                package: 'External-TestsX' with: [ spec requires: 'External-CoreX' ];
                preLoadDoIt: #'preloadDoIt';
                postLoadDoIt: #'postloadDoIt';
                yourself.
            spec
                group: 'Core' with: #('External-CoreX');
                group: 'default' with: #('Core');
                group: 'Tests' with: #('External-TestsX');
                yourself ]! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - github reference' stamp: 'dkh 07/29/2013 07:47'!
configurationExternalRef091: spec
  <version: '0.9.1'>
  spec
    for: #'common'
    do: [ 
      spec blessing: #'version'.
      spec
        description: 'MetacelloScriptingResource>>configurationExternalRef090:'.
      spec
        project: 'External'
        with: [ 
          spec
            className: 'ConfigurationOfExternal';
            version: '0.9.1';
            repository: 'dictionary://Metacello_Configuration_Test_Repository' ] ]! !

!MetacelloScriptingResource methodsFor: 'external configurations' stamp: 'dkh 7/21/2012 14:16'!
setUpConfigurationOfExternalXdkh2: ancestors
    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'ConfigurationOfExternalX-dkh.2'.
    className := #'ConfigurationOfExternalX'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'ConfigurationOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'stableVersionOfX:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'stableVersionOfX:') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'versionOfX090:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'versionOfX090:') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'versionOfX091:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'versionOfX091:') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'customProjectAttributes'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'customProjectAttributes') asString)}.
    configurationRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: ancestors)
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'issue 63' stamp: 'dkh 07/19/2013 12:52'!
configuration093Issue185: spec
  <version: '0.9.3'>
  spec
    for: #'common'
    do: [ 
      spec description: 'MetacelloScriptingResource>>configuration093Issue185:'.
      spec
        baseline: 'External'
          with: [ 
              spec
                repository:
                  'github://dalehenrich/external:'
                    , MetacelloScriptingResource externalCustomIssue185SHA
                    , '/repository' ];
        import: 'External' ]! !

!MetacelloScriptingResource methodsFor: 'issue 84' stamp: 'dkh 7/24/2012 19:21'!
setUpConfigurationIssue84
    "see https://github.com/dalehenrich/metacello-work/issues/84"

    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'ConfigurationOfIssue84-dkh.1'.
    className := #'ConfigurationOfIssue84'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'ConfigurationOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'version10Issue84:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version10Issue84:') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'customProjectAttributes'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'customProjectAttributes') asString)}.
    configurationRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'invalid configurations' stamp: 'dkh 6/22/2012 17:23'!
invalidConfiguration20: spec
    <version: '2.0.0'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'release'.
            spec description: 'MetacelloScriptingResource>>invalidConfiguration20: ... missing version:'.
            spec
                project: 'External'
                with: [ 
                    spec
                        className: 'ConfigurationOfExternal';
                        repository:
                                'github://dalehenrich/external:' , MetacelloScriptingResource externalConfigurationSHA , '/repository' ] ]! !

!MetacelloScriptingResource methodsFor: 'external configurations' stamp: 'dkh 7/21/2012 14:17'!
setUpConfigurationOfExternalX
    "self reset"

    | versionInfo |
    versionInfo := self setUpConfigurationOfExternalXdkh1.
    versionInfo := self setUpConfigurationOfExternalXdkh2: {versionInfo}! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - github reference' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpBaselineGithubReferenceV
    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'BaselineOfGithubRefV-dkh.1'.
    className := #'BaselineOfGithubRefV'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'BaselineOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'configurationGithubReferenceXX:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'configurationGithubReferenceXX:') asString)}.
    externalRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - github reference' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpBaselineGithubReferenceXII
    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'BaselineOfGithubRefXII-dkh.1'.
    className := #'BaselineOfGithubRefXII'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'BaselineOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'baselineGithubReferenceVI:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineGithubReferenceVI:') asString)}.
    externalRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'sample repository' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpSampleCore
    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'Sample-CoreX-dkh.1'.
    className := #'SampleCoreX'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'Object'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: true
        selector: 'sampleAuthorName'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'sampleAuthorName') asString).
    (MCClassDefinition
        name: #'Object'
        superclassName: #'ProtoObject'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: 'Object'
        classIsMeta: true
        selector: 'isSample'
        category: '*sample-core'
        timeStamp: ''
        source: (self class sourceCodeAt: #'isSample') asString)}.
    sampleRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'issue 84' stamp: 'dkh 7/24/2012 19:34'!
version10Issue84: spec
    <version: '1.0.0'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'release'.
            spec description: 'MetacelloScriptingResource>>version10Issue84:'.
            spec author: 'dkh'.
            spec timestamp: '7/24/2012 19:23'.
            spec
                configuration: 'NestedIssue84'
                with: [ 
                    spec
                        version: '1.0.0';
                        repository: 'dictionary://Metacello_Config_Test_Repository' ] ]! !

!MetacelloScriptingResource methodsFor: 'external configurations' stamp: 'dkh 07/26/2013 10:08'!
versionOfExternal090: spec
  <version: '0.9.0'>
  spec
    for: #'common'
    do: [ 
      spec description: 'MetacelloScriptingResource>>versionOfExternal090:'.
      spec repository: 'dictionary://Metacello_Configuration_Test_Repository'.
      spec
        package: 'External-Core' with: 'External-Core-dkh.1';
        yourself ]! !

!MetacelloScriptingResource methodsFor: 'running' stamp: 'dkh 07/29/2013 07:34'!
setUp
  "self reset"

  super setUp.
  self
    setUpRepositories;
    setUpExternalCore;
    setUpExternalCoreX;
    setUpSampleCore;
    setUpBaselineOfExternalX;
    setUpBaselineOfExternalXX;
    setUpBaselineOfExternalXXX;
    setUpConfigurationOfExternaldkh1;
    setUpConfigurationOfExternaldkh2;
    setUpConfigurationExternalRef;
    setUpConfigurationOfExternalX;
    setUpConfigurationOfExternalXX;
    setUpConfigurationOfExternalXXX;
    setUpConfigurationOfExternalIV;
    setUpBaselineGithubReferenceXX;
    setUpBaselineGithubReferenceIV;
    setUpBaselineGithubReferenceV;
    setUpBaselineGithubReferenceVI;
    setUpBaselineGithubReferenceVII;
    setUpBaselineGithubReferenceVIII;
    setUpBaselineGithubReferenceIX;
    setUpBaselineGithubReferenceXI;
    setUpBaselineGithubReferenceXII;
    setUpBaselineGithubReferenceXIII;
    setUpMarianosImage;
    setUpConfigurationOfConflict;
    setUpInvalidConfigurations;
    setUpConfigurationIssue32;
    setUpBaselineIssue32;
    setUpConfigurationIssue59;
    setUpConfiguration63;
    setUpLockConfigurations;
    setUpConfigurationIssue84;
    setUpConfigurationNextedIssue84;
    setUpConfiguration181;
    yourself! !

!MetacelloScriptingResource methodsFor: 'running' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpRepositories
    "self reset"

    configurationRepository := MCDictionaryRepository new.
    externalRepository := MCDictionaryRepository new.
    sampleRepository := MCDictionaryRepository new! !

!MetacelloScriptingResource methodsFor: 'external configurations' stamp: 'dkh 6/22/2012 17:25'!
versionOfXX: spec
    <version: '0.9.0'>
    spec
        for: #'common'
        do: [ 
            spec blessing: #'development'.
            spec description: 'MetacelloScriptingResource>>versionOfXX:'.
            spec author: 'dkh'.
            spec timestamp: '5/4/2012 14:16' ].
    spec
        for: #'custom'
        do: [ 
            spec
                baseline: 'External'
                with: [ spec repository: 'github://dalehenrich/external:' , MetacelloScriptingResource externalCustomSHA , '/repository' ] ]! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - github reference' stamp: 'dkh 6/12/2012 15:41:23.319'!
baselineGithubReferenceXX: spec
    <baseline>
    spec
        for: #'common'
        do: [ 
            spec description: 'MetacelloScriptingResource>>baselineGithubReferenceXX:'.
            spec
                baseline: 'External'
                with: [ spec repository: 'github://dalehenrich/external:' , MetacelloScriptingResource externalCustomSHA , '/repository' ] ]! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - external' stamp: 'dkh 6/12/2012 15:41:23.319'!
externalBaselineXX: spec
    <baseline>
    spec
        for: #'common'
        do: [ 
            spec description: 'MetacelloScriptingResource>>externalBaselineXX:'.
            spec
                package: 'External-CoreX';
                package: 'External-TestsX' with: [ spec requires: 'External-CoreX' ];
                yourself.
            spec
                group: 'Core' with: #('External-CoreX');
                group: 'default' with: #('Core');
                group: 'Tests' with: #('External-TestsX');
                yourself ]! !

!MetacelloScriptingResource methodsFor: 'issue 84' stamp: 'dkh 7/24/2012 20:37'!
setUpConfigurationNextedIssue84dkh2: ancestors
    "see https://github.com/dalehenrich/metacello-work/issues/84"

    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'ConfigurationOfNestedIssue84-dkh.2'.
    className := #'ConfigurationOfNestedIssue84'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'ConfigurationOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'version10NestedIssue84:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'version10NestedIssue84:') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'versionNumberClass'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'versionNumberClass') asString).
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'customProjectAttributes'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'customProjectAttributes') asString)}.
    configurationRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: ancestors)
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - github reference' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpBaselineGithubReferenceXI
    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'BaselineOfGithubRefXI-dkh.1'.
    className := #'BaselineOfGithubRefXI'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'BaselineOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'configurationGithubReferenceV:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'configurationGithubReferenceV:') asString)}.
    externalRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource methodsFor: 'baseline pragma - github reference' stamp: 'dkh 6/12/2012 15:41:23.319'!
setUpBaselineGithubReferenceVII
    "self reset"

    | reference className definitionArray versionInfo |
    reference := GoferVersionReference name: 'BaselineOfGithubRefVII-dkh.1'.
    className := #'BaselineOfGithubRefVII'.
    definitionArray := {(MCOrganizationDefinition categories: (Array with: reference packageName asSymbol)).
    (MCClassDefinition
        name: className
        superclassName: #'BaselineOf'
        category: reference packageName
        instVarNames: #()
        comment: '').
    (MCMethodDefinition
        className: className asString
        classIsMeta: false
        selector: 'baselineGithubReferenceIV:'
        category: 'cat'
        timeStamp: ''
        source: (self class sourceCodeAt: #'baselineGithubReferenceIV:') asString)}.
    externalRepository
        basicStoreVersion:
            (MCVersion new
                setPackage: (MetacelloTestsMCPackage new name: reference packageName)
                info:
                    (versionInfo := MCVersionInfo
                        name: reference name
                        id: UUID new
                        message: 'This is a mock version'
                        date: Date today
                        time: Time now
                        author: reference author
                        ancestors: #())
                snapshot: (MCSnapshot fromDefinitions: definitionArray)
                dependencies: #()).
    ^ versionInfo! !

!MetacelloScriptingResource class methodsFor: 'accessing' stamp: 'dkh 07/20/2013 03:58'!
externalCustomIssue185SHA1
  "SHA of commit on 'custom' branch that should be used with this version of tests (https://github.com/dalehenrich/external)"

  "it's too dangerous to use the HEAD of a branch in tests, because over time the HEAD will change to match latest testing needs, but old tests will likely break"

  ^ '96cf2ed0a252ce55b7fd5ec4bedf3ad999ca6d23'! !

!MetacelloScriptingResource class methodsFor: 'accessing' stamp: 'dkh 6/22/2012 17:26'!
externalCustomSHA
    "SHA of commit on 'custom' branch that should be used with this version of tests (https://github.com/dalehenrich/external)"

    "it's too dangerous to use the HEAD of a branch in tests, because over time the HEAD will change to match latest testing needs, but old tests will likely break"

    "self reset"

    ^ '1ac58502ade7814e1590f71d615cca434b1a4fd5'! !

!MetacelloScriptingResource class methodsFor: 'accessing' stamp: 'dkh 07/20/2013 03:58'!
externalCustomIssue185SHA2
  "SHA of commit on 'custom' branch that should be used with this version of tests (https://github.com/dalehenrich/external)"

  "it's too dangerous to use the HEAD of a branch in tests, because over time the HEAD will change to match latest testing needs, but old tests will likely break"

  ^ '9e79d0e165bd51f7476d10a07968706f6034a6e6'! !

!MetacelloScriptingResource class methodsFor: 'accessing' stamp: 'dkh 07/20/2013 03:58'!
externalCustomIssue185SHA3
  "SHA of commit on 'custom' branch that should be used with this version of tests (https://github.com/dalehenrich/external)"

  "it's too dangerous to use the HEAD of a branch in tests, because over time the HEAD will change to match latest testing needs, but old tests will likely break"

  ^ '11dfa72bc4a956ce0cb5a7603ea39f5abf73ff1c'! !

!MetacelloScriptingResource class methodsFor: 'accessing' stamp: 'dkh 07/16/2013 14:08'!
externalCustomIssue181SHA
  "SHA of commit on 'custom' branch that should be used with this version of tests (https://github.com/dalehenrich/external)"

  "it's too dangerous to use the HEAD of a branch in tests, because over time the HEAD will change to match latest testing needs, but old tests will likely break"

  ^ '36ac04abfc3a173de9432a134a718bf14b0a6968'! !

!MetacelloScriptingResource class methodsFor: 'accessing' stamp: 'dkh 6/22/2012 17:37'!
externalConfigurationSHA
    "SHA of commit on 'configuration' branch that should be used with this version of tests (https://github.com/dalehenrich/external)"

    "it's too dangerous to use the HEAD of a branch in tests, because over time the HEAD will change to match latest testing needs, but old tests will likely break"

    "self reset"

    ^ 'd91949731736bf48879781c29c7365feca461cde'! !

!MetacelloScriptingResource class methodsFor: 'accessing' stamp: 'dkh 07/19/2013 12:56'!
externalCustomIssue185SHA
  "SHA of commit on 'custom' branch that should be used with this version of tests (https://github.com/dalehenrich/external)"

  "it's too dangerous to use the HEAD of a branch in tests, because over time the HEAD will change to match latest testing needs, but old tests will likely break"

  ^ '29efb3d9cb86da55402a543cbef5771e39f864e7'! !

!MetacelloScriptingResource class methodsFor: 'accessing' stamp: 'dkh 07/20/2013 03:58'!
externalCustomIssue185SHA4
  "SHA of commit on 'custom' branch that should be used with this version of tests (https://github.com/dalehenrich/external)"

  "it's too dangerous to use the HEAD of a branch in tests, because over time the HEAD will change to match latest testing needs, but old tests will likely break"

  ^ 'e36dcd023518f4d2a209a482097f5a8ef745ef25'! !

!MetacelloSemanticVersionNumber commentStamp: 'dkh 6/24/2012 18:20'!
MetacelloSemanticVersionNumber conforms to version 2.0.0-rc.1 of  [Semantic Versioning 2.0.0-rc.1](http://semver.org/)

The most important thing that you need to know is that: 
**A normal version number MUST take the form X.Y.Z where X, Y, and Z are non-negative integers.**

**Semantic Versioning Specification** extracted from [Semantic versioning 2.0.0-rc.1](https://github.com/mojombo/semver/blob/3c7f2e8df747ea0ca15208fdfc90e3275240184f/semver.md):

Semantic Versioning Specification (SemVer)
------------------------------------------

The key words "MUST", "MUST NOT", "REQUIRED", "SHALL", "SHALL NOT", "SHOULD",
"SHOULD NOT", "RECOMMENDED", "MAY", and "OPTIONAL" in this document are to be
interpreted as described in RFC 2119.

1. Software using Semantic Versioning MUST declare a public API. This API
could be declared in the code itself or exist strictly in documentation.
However it is done, it should be precise and comprehensive.

1. A normal version number MUST take the form X.Y.Z where X, Y, and Z are
non-negative integers. X is the major version, Y is the minor version, and Z
is the patch version. Each element MUST increase numerically by increments of
one. For instance: 1.9.0 -> 1.10.0 -> 1.11.0.

1. Once a versioned package has been released, the contents of that version
MUST NOT be modified. Any modifications must be released as a new version.

1. Major version zero (0.y.z) is for initial development. Anything may change
at any time. The public API should not be considered stable.

1. Version 1.0.0 defines the public API. The way in which the version number
is incremented after this release is dependent on this public API and how it
changes.

1. Patch version Z (x.y.Z | x > 0) MUST be incremented if only backwards
compatible bug fixes are introduced. A bug fix is defined as an internal
change that fixes incorrect behavior.

1. Minor version Y (x.Y.z | x > 0) MUST be incremented if new, backwards
compatible functionality is introduced to the public API. It MUST be
incremented if any public API functionality is marked as deprecated. It MAY be
incremented if substantial new functionality or improvements are introduced
within the private code. It MAY include patch level changes. Patch version
MUST be reset to 0 when minor version is incremented.

1. Major version X (X.y.z | X > 0) MUST be incremented if any backwards
incompatible changes are introduced to the public API. It MAY include minor
and patch level changes. Patch and minor version MUST be reset to 0 when major
version is incremented.

1. A pre-release version MAY be denoted by appending a hyphen and a series of
dot separated identifiers immediately following the patch version. Identifiers
MUST be comprised of only ASCII alphanumerics and dash [0-9A-Za-z-].
Pre-release versions satisfy but have a lower precedence than the associated
normal version. Examples: 1.0.0-alpha, 1.0.0-alpha.1, 1.0.0-0.3.7,
1.0.0-x.7.z.92.

1. A build version MAY be denoted by appending a plus sign and a series of dot
separated identifiers immediately following the patch version or pre-release
version. Identifiers MUST be comprised of only ASCII alphanumerics and dash
[0-9A-Za-z-]. Build versions satisfy and have a higher precedence than the
associated normal version. Examples: 1.0.0+build.1, 1.3.7+build.11.e0f985a.

1. Precedence MUST be calculated by separating the version into major, minor,
patch, pre-release, and build identifiers in that order. Major, minor, and
patch versions are always compared numerically. Pre-release and build version
precedence MUST be determined by comparing each dot separated identifier as
follows: identifiers consisting of only digits are compared numerically and
identifiers with letters or dashes are compared lexically in ASCII sort order.
Numeric identifiers always have lower precedence than non-numeric identifiers.
Example: 1.0.0-alpha < 1.0.0-alpha.1 < 1.0.0-beta.2 < 1.0.0-beta.11 <
1.0.0-rc.1 < 1.0.0-rc.1+build.1 < 1.0.0 < 1.0.0+0.3.7 < 1.3.7+build <
1.3.7+build.2.b8f12d7 < 1.3.7+build.11.e0f985a.

About
-----

The Semantic Versioning specification is authored by [Tom
Preston-Werner](http://tom.preston-werner.com), inventor of Gravatars and
cofounder of GitHub.

If you'd like to leave feedback, please [open an issue on
GitHub](https://github.com/mojombo/semver/issues).


License
-------

Creative Commons - CC BY 3.0
http://creativecommons.org/licenses/by/3.0/
!
!MetacelloSemanticVersionNumber methodsFor: 'copying' stamp: 'dkh 6/21/2012 17:59'!
copyFrom: start to: stop 
	"Answer a copy of a subset of the receiver, starting from element at 
	index start until element at index stop."

	| newSize new j |
	newSize := stop - start + 1.
	new := self species new: newSize.
	j := 0.
	start to: stop do: [:i |
		new at: j + 1 put: (self at: i).
		j := j + 1 ].
	^new! !

!MetacelloSemanticVersionNumber methodsFor: 'accessing' stamp: 'dkh 6/21/2012 21:06'!
normalVersion
    normalVersion ifNil: [ normalVersion := #() ].
    ^ normalVersion! !

!MetacelloSemanticVersionNumber methodsFor: 'comparing' stamp: 'dkh 6/21/2012 17:59'!
~> aMetacelloVersionNumber

	aMetacelloVersionNumber size == 1 ifTrue: [ ^false ].
	^self >= aMetacelloVersionNumber and: [ self < aMetacelloVersionNumber approximateBase ]! !

!MetacelloSemanticVersionNumber methodsFor: 'comparing' stamp: 'dkh 6/21/2012 19:52'!
< aMetacelloVersionNumber
    aMetacelloVersionNumber species = self species
        ifFalse: [ ^ false ].
    ^ self compareLessThan: aMetacelloVersionNumber! !

!MetacelloSemanticVersionNumber methodsFor: 'private' stamp: 'dkh 6/22/2012 15:20'!
compareLessThan: aMetacelloVersionNumber
    | myComponents otherComponents defaultResult |
    aMetacelloVersionNumber species = self species
        ifFalse: [ ^ false ].
    myComponents := self normalVersion.
    otherComponents := aMetacelloVersionNumber normalVersion.
    defaultResult := true.
    (self compareEqualTo: myComponents other: otherComponents)
        ifTrue: [ defaultResult := false ]
        ifFalse: [ 
            (self compareLessThan: myComponents other: otherComponents version: #'normal')
                ifFalse: [ ^ false ] ].
    myComponents := self preReleaseVersion.
    otherComponents := aMetacelloVersionNumber preReleaseVersion.
    (self compareEqualTo: myComponents other: otherComponents)
        ifTrue: [ 
            myComponents size > 0
                ifTrue: [ defaultResult := false ] ]
        ifFalse: [ ^ self compareLessThan: myComponents other: otherComponents version: #'preRelease' ].
    myComponents := self buildVersion.
    otherComponents := aMetacelloVersionNumber buildVersion.
    ^ (self compareEqualTo: myComponents other: otherComponents)
        ifTrue: [ defaultResult ]
        ifFalse: [ self compareLessThan: myComponents other: otherComponents version: #'build' ]! !

!MetacelloSemanticVersionNumber methodsFor: 'accessing' stamp: 'dkh 6/21/2012 21:06'!
buildVersion
    buildVersion ifNil: [ buildVersion := #() ].
    ^ buildVersion! !

!MetacelloSemanticVersionNumber methodsFor: 'comparing' stamp: 'dkh 6/22/2012 14:57'!
match: aVersionPattern
    "Answer whether the version number of the receiver matches the given pattern string.

	 A Metacello version number is made up of version sequences delimited by the characters $. and $-.
	 The $. introduces a numeric version sequence and $- introduces an alphanumeric version sequence.
	 
	 A version pattern is made up of version pattern match sequences. also delimited by the characters $. 
	 and $-.. Each pattern match sequence is tested against the corresponding version sequence of the 
	 receiver, using the 'standard' pattern matching rules. All sequences must answer true for a match.
	
	 The special pattern sequence '?' is a match for the corresponding version sequence and all subsequent 
	 version sequences. '?' as the version pattern matches all versions. No more version pattern 
	 sequences are permitted once the '?' sequence is used. If used, it is the last version pattern
	 sequence. "

    | patternVersion mySize patternSize components |
    patternVersion := (self class fromString: aVersionPattern forPattern: true) versionComponents.
    components := self versionComponents.
    mySize := components size.
    patternSize := patternVersion size.
    mySize = patternSize
        ifFalse: [ 
            mySize < patternSize
                ifTrue: [ ^ false ].
            (patternVersion at: patternSize) ~= '?'
                ifTrue: [ ^ false ].
            mySize := patternSize ].
    1 to: mySize do: [ :i | 
        | pattern |
        pattern := (patternVersion at: i) asString.
        pattern = '?'
            ifTrue: [ 
                i = mySize
                    ifFalse: [ ^ self error: 'Invalid version match pattern: ' , aVersionPattern printString ] ]
            ifFalse: [ 
                (pattern match: (components at: i) asString)
                    ifFalse: [ ^ false ] ] ].
    ^ true! !

!MetacelloSemanticVersionNumber methodsFor: 'accessing' stamp: 'dkh 6/21/2012 21:05'!
buildVersion: anObject
	buildVersion := anObject! !

!MetacelloSemanticVersionNumber methodsFor: 'accessing' stamp: 'dkh 6/21/2012 17:59'!
versionString

	| strm |
	strm := WriteStream on: String new.
	self printOn: strm.
	^strm contents! !

!MetacelloSemanticVersionNumber methodsFor: 'converting' stamp: 'dkh 6/21/2012 18:02'!
asMetacelloSemanticVersionNumber
    ^ self! !

!MetacelloSemanticVersionNumber methodsFor: 'private' stamp: 'dkh 6/22/2012 11:02'!
compareEqualTo: aMetacelloVersionNumber
    aMetacelloVersionNumber species = self species
        ifFalse: [ ^ false ].
    (self compareEqualTo: self normalVersion other: aMetacelloVersionNumber normalVersion)
        ifFalse: [ ^ false ].
    (self compareEqualTo: self preReleaseVersion other: aMetacelloVersionNumber preReleaseVersion)
        ifFalse: [ ^ false ].
    ^ self compareEqualTo: self buildVersion other: aMetacelloVersionNumber buildVersion! !

!MetacelloSemanticVersionNumber methodsFor: 'private' stamp: 'dkh 6/21/2012 21:26'!
compareEqualTo: myComponents other: otherComponents
    | mySize |
    mySize := myComponents size.
    mySize = otherComponents size
        ifFalse: [ ^ false ].
    1 to: mySize do: [ :i | 
        (myComponents at: i) = (otherComponents at: i)
            ifFalse: [ ^ false ] ].
    ^ true! !

!MetacelloSemanticVersionNumber methodsFor: 'printing' stamp: 'dkh 6/21/2012 21:17'!
printOn: aStream
    self print: self normalVersion prefix: nil on: aStream.
    self print: self preReleaseVersion prefix: $- on: aStream.
    self print: self buildVersion prefix: $+ on: aStream! !

!MetacelloSemanticVersionNumber methodsFor: 'accessing' stamp: 'dkh 6/21/2012 17:59'!
approximateBase

	| base |
	base := self copyFrom: 1 to: self size - 1.
	base at: base size put: (base at: base size) + 1.
	^base! !

!MetacelloSemanticVersionNumber methodsFor: 'private' stamp: 'dkh 6/22/2012 14:44'!
versionComponents
    ^ self normalVersion , self preReleaseVersion , self buildVersion! !

!MetacelloSemanticVersionNumber methodsFor: 'accessing' stamp: 'dkh 6/21/2012 21:06'!
preReleaseVersion
    preReleaseVersion ifNil: [ preReleaseVersion := #() ].
    ^ preReleaseVersion! !

!MetacelloSemanticVersionNumber methodsFor: 'private' stamp: 'dkh 6/22/2012 15:28'!
compareLessThan: myComponents other: otherComponents version: version
    | mySize aSize commonSize count more |
    mySize := myComponents size.
    aSize := otherComponents size.
    commonSize := mySize min: aSize.
    count := 0.
    more := true.
    [ more and: [ count < commonSize ] ]
        whileTrue: [ 
            (myComponents at: count + 1) = (otherComponents at: count + 1)
                ifTrue: [ count := count + 1 ]
                ifFalse: [ more := false ] ].
    count < commonSize
        ifTrue: [ ^ (myComponents at: count + 1) metacelloSemanticVersionComponentLessThan: (otherComponents at: count + 1) ].
    mySize < aSize
        ifTrue: [ 
            mySize = 0
                ifTrue: [ 
                    #'preRelease' == version
                        ifTrue: [ ^ false ].
                    ^ true ].
            (myComponents at: commonSize) = (otherComponents at: commonSize)
                ifFalse: [ ^ true ].
            ^ true ]
        ifFalse: [ 
            mySize = aSize
                ifTrue: [ ^ false ].
            aSize = 0
                ifTrue: [ 
                    #'build' == version
                        ifTrue: [ ^ false ].
                    ^ true ].
            (myComponents at: commonSize) = (otherComponents at: commonSize)
                ifFalse: [ ^ false ].
            ^ true ]! !

!MetacelloSemanticVersionNumber methodsFor: 'printing' stamp: 'dkh 07/09/2012 16:15'!
asString
	"Answer a string that represents the receiver."

	^ self printString! !

!MetacelloSemanticVersionNumber methodsFor: 'comparing' stamp: 'dkh 6/22/2012 16:10'!
hash
    ^ self versionComponents hash! !

!MetacelloSemanticVersionNumber methodsFor: 'operations' stamp: 'dkh 6/21/2012 17:59'!
decrementMinorVersionNumber
	| int |
	self size to: 1 by: -1 do: [ :index | 
		(int := self at: index) isString
			ifFalse: [ 
				int > 0
					ifTrue: [ self at: index put: int - 1 ].
				^ self ] ]! !

!MetacelloSemanticVersionNumber methodsFor: 'operations' stamp: 'dkh 6/21/2012 17:59'!
incrementMinorVersionNumber

	| int |
	self size to: 1 by: -1 do: [:index | 
		(int := self at: index) isString 
			ifFalse: [ 
				self at: index put: int + 1.
				^self ]].! !

!MetacelloSemanticVersionNumber methodsFor: 'comparing' stamp: 'dkh 6/21/2012 19:53'!
= aMetacelloVersionNumber
    aMetacelloVersionNumber species = self species
        ifFalse: [ ^ false ].
    ^ self compareEqualTo: aMetacelloVersionNumber! !

!MetacelloSemanticVersionNumber methodsFor: 'enumerating' stamp: 'dkh 6/21/2012 17:59'!
do: aBlock 
	"Refer to the comment in Collection|do:."
	1 to: self size do:
		[:index | aBlock value: (self at: index)]! !

!MetacelloSemanticVersionNumber methodsFor: 'accessing' stamp: 'dkh 6/21/2012 21:05'!
preReleaseVersion: anObject
	preReleaseVersion := anObject! !

!MetacelloSemanticVersionNumber methodsFor: 'printing' stamp: 'dkh 6/21/2012 21:16'!
print: components prefix: prefixChar on: aStream
    | beforeFirst |
    beforeFirst := true.
    components
        do: [ :component | 
            beforeFirst
                ifTrue: [ 
                    beforeFirst := false.
                    prefixChar ifNotNil: [ aStream nextPut: prefixChar ] ]
                ifFalse: [ aStream nextPut: $. ].
            aStream nextPutAll: component asString ]! !

!MetacelloSemanticVersionNumber methodsFor: 'accessing' stamp: 'dkh 6/21/2012 21:05'!
normalVersion: anObject
	normalVersion := anObject! !

!MetacelloSemanticVersionNumber methodsFor: 'enumerating' stamp: 'dkh 6/21/2012 17:59'!
do: elementBlock separatedBy: separatorBlock
	"Evaluate the elementBlock for all elements in the receiver,
	and evaluate the separatorBlock between."

	| beforeFirst | 
	beforeFirst := true.
	self do:
		[:each |
		beforeFirst
			ifTrue: [beforeFirst := false]
			ifFalse: [separatorBlock value].
		elementBlock value: each]! !

!MetacelloSemanticVersionNumber class methodsFor: 'private' stamp: 'dkh 6/21/2012 18:43'!
isSemanticIdentifier: aString
    "whether the receiver is composed entirely of alphanumerics"

    aString
        do: [ :c | 
            c isAlphaNumeric
                ifFalse: [ 
                    c = $-
                        ifFalse: [ ^ false ] ] ].
    ^ true! !

!MetacelloSemanticVersionNumber class methodsFor: 'private' stamp: 'dkh 6/22/2012 14:53'!
extractNumericComponent: subString forPattern: forPattern
    "$. separated components are integers"

    | number |
    forPattern
        ifTrue: [ ^ subString ].
    number := [ subString asNumber ]
        on: Error
        do: [ :ex | ex return: subString ].
    ^ number asString = subString
        ifTrue: [ number ]
        ifFalse: [ subString ]! !

!MetacelloSemanticVersionNumber class methodsFor: 'instance creation' stamp: 'dkh 6/22/2012 14:50'!
fromString: aString
    ^ self fromString: aString forPattern: false! !

!MetacelloSemanticVersionNumber class methodsFor: 'instance creation' stamp: 'dkh 6/22/2012 16:48'!
fromString: aString forPattern: forPattern
    | new tokens preRelease build versionString identifierCount normalEnd preReleaseEnd normalComponents preReleaseComponents buildComponents |
    normalComponents := OrderedCollection new.
    preReleaseComponents := OrderedCollection new.
    buildComponents := OrderedCollection new.
    preRelease := aString indexOf: $- startingAt: 1.
    build := aString indexOf: $+ startingAt: 1.
    (build > 0 and: [ preRelease > build ])
        ifTrue: [ preRelease := 0 ].
    normalEnd := preRelease = 0
        ifTrue: [ 
            build = 0
                ifTrue: [ aString size ]
                ifFalse: [ build - 1 ] ]
        ifFalse: [ preRelease - 1 ].
    versionString := aString copyFrom: 1 to: normalEnd.
    identifierCount := 0.
    (versionString findTokens: '.')
        do: [ :subString | 
            | integer |
            forPattern
                ifTrue: [ integer := subString ]
                ifFalse: [ 
                    integer := subString asInteger.
                    integer < 0
                        ifTrue: [ self error: 'invalid version number: normal version component must be integer ' , subString printString ] ].
            normalComponents add: integer.
            identifierCount := identifierCount + 1 ].
    (forPattern not and: [ identifierCount ~= 3 ])
        ifTrue: [ self error: 'invalid version number: normal version must have only 3 components' ].
    preReleaseEnd := build = 0
        ifTrue: [ aString size ]
        ifFalse: [ build - 1 ].
    preRelease > 0
        ifTrue: [ 
            versionString := aString copyFrom: preRelease + 1 to: preReleaseEnd.
            (versionString findTokens: '.')
                do: [ :subString | 
                    (forPattern or: [ self isSemanticIdentifier: subString ])
                        ifFalse: [ self error: 'invalid version number: preRelease version component must be one of [0-9A-Za-z-]' ].
                    preReleaseComponents add: (self extractNumericComponent: subString forPattern: forPattern) ] ].
    build > 0
        ifTrue: [ 
            versionString := aString copyFrom: build + 1 to: aString size.
            (versionString findTokens: '.')
                do: [ :subString | 
                    (forPattern or: [ self isSemanticIdentifier: subString ])
                        ifFalse: [ self error: 'invalid version number: build version component must be one of [0-9A-Za-z-]' ].
                    buildComponents add: (self extractNumericComponent: subString forPattern: forPattern) ] ].
    ^ self new
        normalVersion: normalComponents;
        preReleaseVersion: preReleaseComponents;
        buildVersion: buildComponents;
        yourself! !

!MetacelloSemanticVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/21/2012 18:08'!
validateSemanticVersionStrings: versionStrings
    | versions version |
    versions := versionStrings collect: [ :each | each asMetacelloSemanticVersionNumber ].
    version := versions at: 1.
    2 to: versions size do: [ :index | 
        | nextVersion |
        nextVersion := versions at: index.
        self assert: version < nextVersion.
        version := nextVersion ]! !

!MetacelloSemanticVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 15:34'!
testSemanticVersioning
    self validateSemanticVersionStrings: #('1.0.0-rc.1+build.1' '1.0.0-rc.1+build.2' '1.0.0-rc.2+build.0').
    self validateSemanticVersionStrings: #('1.0.0-rc.1+build.1' '1.0.0+build.0').
    self validateSemanticVersionStrings: #('1.0.0-alpha' '1.0.0-1').
    self validateSemanticVersionStrings: #('1.0.0-1' '1.0.0+alpha').
    self validateSemanticVersionStrings: #('1.0.0-alpha' '1.0.0+1').
    self validateSemanticVersionStrings: #('1.0.0+alpha' '1.0.0+1').
    self validateSemanticVersionStrings: #('1.0.0--' '1.0.0-a').
    self validateSemanticVersionStrings: #('1.0.0+-' '1.0.0+a').
    self validateSemanticVersionStrings: #('1.0.0-rc.1' '1.0.0' '1.0.0+build.1').
    self validateSemanticVersionStrings: #('1.0.0-rc.1+build.1' '1.0.0-rc.1+build.2' '1.0.0-rc.2+build.3').
    self validateSemanticVersionStrings: #('1.0.0-rc.1' '1.0.0-rc.1+build.2' '1.0.0-rc.2').
    self validateSemanticVersionStrings: #('1.0.0-rc.1+build.1' '1.0.0-rc.1+build.2' '1.0.0-rc.2').
    self validateSemanticVersionStrings: #('1.0.0-rc.1+build.1' '1.0.0-rc.1+build.2' '1.0.0-rc.2+build.2').
    self validateSemanticVersionStrings: #('1.0.0-rc.1+build.1' '1.0.0' '1.0.0+build.0').
    self validateSemanticVersionStrings: #('1.0.0+10000' '1.0.0+a').
    self validateSemanticVersionStrings: #('1.0.0-10000' '1.0.0-a')! !

!MetacelloSemanticVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/21/2012 18:08'!
testSemanticVersioningSpecItem11
    "[Semantic Versioning 2.0.0-rc.1](http://semver.org/)"

    self validateSemanticVersionStrings: #('1.0.0+build.1' '1.3.7+build.11.e0f985a')! !

!MetacelloSemanticVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 16:55'!
testVersion09
    | v1 v2 |
    v1 := self versionClass fromString: '1.0.0'.
    v2 := self versionClass fromString: '0.7.0'.
    self assert: v1 >= v2.
    self assert: v2 <= v1! !

!MetacelloSemanticVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/21/2012 18:11'!
testSemanticVersioningSubsetCompliance
    "subset of sample versions that are compatible with MetacellVersionNumber syntax"

    self
        validateSemanticVersionStrings:
            #('1.0.0-alpha' '1.0.0-alpha.1' '1.0.0-beta.2' '1.0.0-beta.11' '1.0.0-rc.1' '1.0.0')! !

!MetacelloSemanticVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 16:56'!
testVersion16
    self assert: (self versionClass fromString: '1.0.0-beta.0') < (self versionClass fromString: '1.0.0')! !

!MetacelloSemanticVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 11:29'!
testLessThanComparison
    self assert: '1.0.0-rc.1+build.1' asMetacelloSemanticVersionNumber < '1.0.0' asMetacelloSemanticVersionNumber.
    self
        assert: '1.0.0-rc.1+build.1' asMetacelloSemanticVersionNumber < '1.0.0+build.0' asMetacelloSemanticVersionNumber.
    self assert: '1.0.0-alpha.1' asMetacelloSemanticVersionNumber < '1.0.0-0.3.7' asMetacelloSemanticVersionNumber.
    self assert: '1.0.0-alpha' asMetacelloSemanticVersionNumber < '1.0.0-alpha.1' asMetacelloSemanticVersionNumber.
    self assert: '1.0.0+-' asMetacelloSemanticVersionNumber < '1.0.0+a' asMetacelloSemanticVersionNumber.
    self assert: '1.0.0-0.3.7' asMetacelloSemanticVersionNumber < '1.0.0-x.7.z.92' asMetacelloSemanticVersionNumber! !

!MetacelloSemanticVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 09:00'!
testEqualityComparison
    self deny: '1.0.0+-' asMetacelloSemanticVersionNumber = '1.0.0--' asMetacelloSemanticVersionNumber.
    self sampleVersionStrings
        do: [ :versionString | self assert: versionString asMetacelloSemanticVersionNumber = versionString asMetacelloSemanticVersionNumber ]! !

!MetacelloSemanticVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/21/2012 18:08'!
testSemanticVersioningSpecItem10
    "[Semantic Versioning 2.0.0-rc.1](http://semver.org/)"

    self validateSemanticVersionStrings: #('1.0.0-alpha' '1.0.0-alpha.1' '1.0.0-0.3.7' '1.0.0-x.7.z.92')! !

!MetacelloSemanticVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 11:18'!
sampleVersionStrings
    ^ #('1.0.0+-' '1.0.0-alpha' '1.0.0-alpha.1' '1.0.0-0.3.7' '1.0.0-x.7.z.92')
        , #('1.0.0+build.1' '1.3.7+build.11.e0f985a')
        ,
            #('1.0.0-alpha' '1.0.0-alpha.1' '1.0.0-beta.2' '1.0.0-beta.11' '1.0.0-rc.1' '1.0.0-rc.1+build.1' '1.0.0' '1.0.0+0.3.7' '1.3.7+build' '1.3.7+build.2.b8f12d7' '1.3.7+build.11.e0f985a')
        , #('1.0.0-alp-h-a' '1.0.0-r-c.1' '1.0.0+alp-h-a' '1.0.0+r-c.1')! !

!MetacelloSemanticVersionNumberTestCase methodsFor: 'test matching' stamp: 'dkh 6/22/2012 16:50'!
testStandardMatch
    self assert: ((self versionClass fromString: '1.0.0+alpha5.0') match: '1.0.0+alpha#.0').
    self assert: ((self versionClass fromString: '1.1.1') match: '*.*.*').
    self deny: ((self versionClass fromString: '1.1.1') match: '*.*').
    self assert: ((self versionClass fromString: '1.1.0') match: '1.1.*').
    self assert: ((self versionClass fromString: '1.1.0') match: '1.#.*').
    self deny: ((self versionClass fromString: '1.10.0+build.0') match: '1.#.*').
    self assert: ((self versionClass fromString: '1.0.0-alpha5.0') match: '1.0.0-alpha#.0').
    self assert: ((self versionClass fromString: '1.0.0-alpha5+build5.0') match: '1.0.0-alpha5+build#.0').
    self deny: ((self versionClass fromString: '1.0.0-alpha10.0') match: '1.0.0-alpha#.0')! !

!MetacelloSemanticVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/21/2012 18:08'!
testSemanticVersioningSpecItem12
    "According to [Semantic Versioning 2.0.0-rc.1](http://semver.org/), the following expression should be true:
	1.0.0-alpha < 1.0.0-alpha.1 < 1.0.0-beta.2 < 1.0.0-beta.11 < 1.0.0-rc.1 < 1.0.0-rc.1+build.1 < 1.0.0 < 
		1.0.0+0.3.7 < 1.3.7+build < 1.3.7+build.2.b8f12d7 < 1.3.7+build.11.e0f985a"

    self
        validateSemanticVersionStrings:
            #('1.0.0-alpha' '1.0.0-alpha.1' '1.0.0-beta.2' '1.0.0-beta.11' '1.0.0-rc.1' '1.0.0-rc.1+build.1' '1.0.0' '1.0.0+0.3.7' '1.3.7+build' '1.3.7+build.2.b8f12d7' '1.3.7+build.11.e0f985a')! !

!MetacelloSemanticVersionNumberTestCase methodsFor: 'test matching' stamp: 'dkh 6/22/2012 15:00'!
testSpecialMatch
    self assert: ((self versionClass fromString: '1.1.0') match: '?').
    self assert: ((self versionClass fromString: '1.0.0-alpha') match: '?').
    self assert: ((self versionClass fromString: '1.0.0-rc.1+build.1') match: '?').
    self assert: ((self versionClass fromString: '1.1.0') match: '*.*.?').
    self assert: ((self versionClass fromString: '1.3.7+build.2.b8f12d7') match: '?').
    self assert: ((self versionClass fromString: '1.3.7+build.11.e0f985a') match: '?').
    self deny: ((self versionClass fromString: '1.1.0') match: '*.*.*-?').
    self deny: ((self versionClass fromString: '1.1.0') match: '*.*.*+?').
    self assert: ((self versionClass fromString: '1.1.1') match: '*.?')! !

!MetacelloSemanticVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 16:50'!
testVersion10
    | x y |
    self
        assert:
            (x := (({(self versionClass fromString: '1.0.0').
            (self versionClass fromString: '0.7.0').
            (self versionClass fromString: '0.8.0').
            (self versionClass fromString: '0.9.0').
            (self versionClass fromString: '1.0.1')} sort: [ :a :b | a <= b ]) collect: [ :each | each versionString ])
                asArray) = (y := #('0.7.0' '0.8.0' '0.9.0' '1.0.0' '1.0.1'))! !

!MetacelloSemanticVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 16:55'!
testVersion15
    self assert: (self versionClass fromString: '1.0.0-beta.0') < (self versionClass fromString: '1.0.0-beta.1')! !

!MetacelloSemanticVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 16:57'!
testVersion17
    self assert: (self versionClass fromString: '1.0.0') > (self versionClass fromString: '1.0.0-0').
    self assert: (self versionClass fromString: '1.0.0') > (self versionClass fromString: '1.0.0-beta.0').
    self assert: (self versionClass fromString: '1.0.0') > (self versionClass fromString: '1.0.0-beta')! !

!MetacelloSemanticVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 16:51'!
testVersion18
    | x y |
    self deny: (x := self versionClass fromString: '1.0.0') < (y := self versionClass fromString: '1.0.0-0').
    self assert: (x := self versionClass fromString: '1.0.0') > (y := self versionClass fromString: '1.0.0-0').
    self assert: (x := self versionClass fromString: '1.0.0') < (y := self versionClass fromString: '1.0.0+0').
    self deny: (x := self versionClass fromString: '1.0.0') > (y := self versionClass fromString: '1.0.0+0')! !

!MetacelloSemanticVersionNumberTestCase methodsFor: 'private' stamp: 'dkh 6/22/2012 14:41'!
versionClass
    ^ MetacelloSemanticVersionNumber! !

!MetacelloSemanticVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 08:59'!
testPrinting
    | x vrsn |
    self sampleVersionStrings
        do: [ :versionString | self assert: versionString = (x := (vrsn := versionString asMetacelloSemanticVersionNumber) printString) ]! !

!MetacelloSemanticVersionNumberTestCase methodsFor: 'test matching' stamp: 'dkh 6/22/2012 12:15'!
testInvalidSpecialMatch
    self should: [ (self versionClass fromString: '1.1.1') match: '?.?.?' ] raise: Error! !

!MetacelloSemanticVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 16:54'!
testVersion05
    | v1 v2 |
    v1 := self versionClass fromString: '3.0.0'.
    v2 := self versionClass fromString: '2.0.0'.
    self assert: v1 > v2! !

!MetacelloSemanticVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 16:55'!
testVersion12
    self deny: (self versionClass fromString: '1.0.0') <= (self versionClass fromString: '0.7.0')! !

!MetacelloSemanticVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 16:57'!
testVersion19
    self assert: (self versionClass fromString: '1.0.0-beta.0') < (self versionClass fromString: '1.0.0')! !

!MetacelloSkipDirtyPackageLoad methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
packageSpec: aMetacelloPackageSpec

	packageSpec := aMetacelloPackageSpec! !

!MetacelloSkipDirtyPackageLoad methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
defaultAction
	"Default action is to skip the load of a dirty package"

	^true! !

!MetacelloSkipDirtyPackageLoad methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
packageSpec

	^packageSpec! !

!MetacelloSkipDirtyPackageLoad class methodsFor: 'signalling' stamp: 'dkh 6/5/2012 19:01:24'!
signal: aMetacelloPackageSpec

	^(self new packageSpec: aMetacelloPackageSpec) signal! !

!MetacelloSpec methodsFor: 'mutability' stamp: 'dkh 7/19/2012 15:03'!
immutable
    mutable := false! !

!MetacelloSpec methodsFor: 'spec creation' stamp: 'dkh 6/5/2012 19:01:24'!
mergeMember

	^MetacelloMergeMemberSpec for: self project! !

!MetacelloSpec methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 11/12/2014 23:05'!
gtInspectorCodeIn: composite
	<gtInspectorPresentationOrder: 40>
	composite pharoPlayground 
		title: 'Code';
		display: [ 
			String streamContents: [ :s | self configMethodOn: s indent: 0] ]
! !

!MetacelloSpec methodsFor: 'merging' stamp: 'dkh 6/5/2012 19:01:24'!
mergeSpec: aSpec
    | newSpec nonOverridable |
    self validateMergeForSpec: aSpec.
    newSpec := self copy.
    nonOverridable := self nonOverridable.
    aSpec mergeMap
        keysAndValuesDo: [ :key :value | 
            (nonOverridable includes: key)
                ifFalse: [ 
                    value ~~ nil
                        ifTrue: [ newSpec instVarNamed: key asString put: value ] ] ].
    ^ newSpec! !

!MetacelloSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
project

	^project! !

!MetacelloSpec methodsFor: 'accessing' stamp: 'dkh 7/19/2012 15:07'!
loader: aLoader
    "We're interested in propogating the loader state, _except_ for the spec"

    self shouldBeMutable.
    loader := aLoader copy.
    loader spec: self! !

!MetacelloSpec methodsFor: 'doits' stamp: 'dkh 6/5/2012 19:01:24'!
postLoadDoIt
	"noop unless non-nil value returned"

	^nil! !

!MetacelloSpec methodsFor: 'doits' stamp: 'dkh 6/5/2012 19:01:24'!
preLoadDoIt
	"noop unless non-nil value returned"
	
	^nil! !

!MetacelloSpec methodsFor: 'mutability' stamp: 'dkh 7/19/2012 15:03'!
mutable
    mutable := true! !

!MetacelloSpec methodsFor: 'doits' stamp: 'dkh 6/5/2012 19:01:24'!
postLoadDoItBlock

	^self doItBlock: self postLoadDoIt value
! !

!MetacelloSpec methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
configMethodOn: aStream

	self configMethodOn: aStream indent: 0

! !

!MetacelloSpec methodsFor: 'merging' stamp: 'dkh 6/5/2012 19:01:24'!
mergeMap

	^Dictionary new.
! !

!MetacelloSpec methodsFor: 'initialization' stamp: 'dkh 7/19/2012 15:09'!
for: aProject
    self shouldBeMutable.
    project := aProject! !

!MetacelloSpec methodsFor: 'doits' stamp: 'dkh 6/5/2012 19:01:24'!
preLoadDoItBlock

	^self doItBlock: self preLoadDoIt value
! !

!MetacelloSpec methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
printOn: aStream

	self configMethodOn: aStream indent: 0

! !

!MetacelloSpec methodsFor: 'merging' stamp: 'dkh 6/5/2012 19:01:24'!
validateMergeForSpec: aSpec
    aSpec class = self class
        ifFalse: [ 
            self
                error:
                    'The project spec ' , self name printString , ' in project ' , self project label , ' has incompatible specs. '
                        , aSpec class name asString , ' and ' , self class name asString , ' are not compatible.' ]! !

!MetacelloSpec methodsFor: 'spec creation' stamp: 'dkh 6/5/2012 19:01:24'!
addMember

	^MetacelloAddMemberSpec for: self project! !

!MetacelloSpec methodsFor: 'merging' stamp: 'dkh 6/5/2012 19:01:24'!
nonOverridable

	^#()! !

!MetacelloSpec methodsFor: 'mutability' stamp: 'dkh 7/19/2012 15:03'!
isMutable
    mutable ifNil: [ ^ true ].
    ^ mutable! !

!MetacelloSpec methodsFor: 'mutability' stamp: 'dkh 7/19/2012 15:06'!
shouldBeMutable
    self isMutable
        ifTrue: [ ^ self ].
    self error: 'Not allowed to modify an immutable object'! !

!MetacelloSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
loader

	loader == nil 
		ifTrue: [ | prjctLoader |
			(prjctLoader := self project loader) == nil
				ifTrue: [ self loader: (self project loaderClass on: self) ]
				ifFalse: [ self loader: prjctLoader ]].
	^loader! !

!MetacelloSpec methodsFor: 'doits' stamp: 'dkh 6/5/2012 19:01:24'!
doItBlock: selector

	selector == nil ifTrue: [ ^nil ].
	selector numArgs = 0
		ifTrue: [ ^[ self project configuration perform: selector ] ].
	selector numArgs = 1
		ifTrue: [ ^[:aLoader | self project configuration perform: selector with: aLoader ] ].
	selector numArgs = 2
		ifTrue: [ ^[:aLoader :pkgSpec | self project configuration perform: selector with: aLoader with: pkgSpec ] ].
	^nil
! !

!MetacelloSpec methodsFor: 'spec creation' stamp: 'dkh 6/5/2012 19:01:24'!
copyMember

	^MetacelloCopyMemberSpec for: self project! !

!MetacelloSpec methodsFor: 'merging' stamp: 'dkh 6/5/2012 19:01:24'!
aboutToCopy
! !

!MetacelloSpec methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
label

	^self printString! !

!MetacelloSpec methodsFor: 'copying' stamp: 'dkh 7/19/2012 21:12'!
postCopy
    super postCopy.
    mutable := nil.
    loader ~~ nil
        ifTrue: [ self loader: loader ].
! !

!MetacelloSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
answers

	^#()! !

!MetacelloSpec methodsFor: 'spec creation' stamp: 'dkh 6/5/2012 19:01:24'!
removeMember

	^MetacelloRemoveMemberSpec for: self project! !

!MetacelloSpec methodsFor: 'mutability' stamp: 'dkh 7/19/2012 16:44'!
copyOnWrite: aBlock
    "assume that only registered projects are immutable ... otherwise you'll get an error"

    | copy |
    copy := self copy.
    aBlock value: copy.
    ^ copy! !

!MetacelloSpec methodsFor: 'importing' stamp: 'dkh 6/26/2012 16:34'!
mergeImportLoads: aLoadList
    self error: 'import: can only be used with baseline project specs'! !

!MetacelloSpec methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
configMethodOn: aStream indent: indent

	self subclassResponsibility

! !

!MetacelloSpec class methodsFor: 'instance creation' stamp: 'dkh 6/5/2012 19:01:24'!
for: aVersionMap

	^(self platformClass new)
		for: aVersionMap;
		yourself! !

!MetacelloSpec class methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
platformClass

	^self! !

!MetacelloSpec class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 00:27'!
gtExampleMetacelloSpec
	<gtExample: 'Metacello group reference'>
	^ (ConfigurationOfGTInspectorCore project version: #development) groups anyOne! !

!MetacelloSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
spec: aMetacelloPackagesSpec

	spec := aMetacelloPackagesSpec! !

!MetacelloSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
project

	^self spec project! !

!MetacelloSpecLoader methodsFor: 'actions' stamp: 'dkh 6/5/2012 19:01:24'!
unload

	self subclassResponsibility! !

!MetacelloSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
loadType
	"#atomic or #linear"
	
	^self project loadType! !

!MetacelloSpecLoader methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
spec

	^spec! !

!MetacelloSpecLoader methodsFor: 'actions' stamp: 'dkh 6/5/2012 19:01:24'!
load

	self subclassResponsibility! !

!MetacelloSpecLoader class methodsFor: 'instance creation' stamp: 'dkh 6/5/2012 19:01:24'!
on: aMetacelloPackagesSpec

	^(self new) 
		spec: aMetacelloPackagesSpec;
		yourself! !

!MetacelloSpecTestCase methodsFor: 'specs' stamp: 'dkh 5/4/2012 20:37:12'!
projectSpec
    ^ self project projectSpec! !

!MetacelloSpecTestCase methodsFor: 'accessing' stamp: 'dkh 5/4/2012 20:37:12'!
projectWith: projectAttributes
    | project |
    "Construct Metacello project"
    project := self projectClass new.
    project projectAttributes: projectAttributes.
    MetacelloVersionConstructor on: self project: project.
    project loader: MetacelloNullRecordingMCSpecLoader new.
    ^ project! !

!MetacelloSpecTestCase methodsFor: 'specs' stamp: 'dkh 5/4/2012 20:37:12'!
groupSpec
    ^ self project groupSpec! !

!MetacelloSpecTestCase methodsFor: '*metacello-testsmccore' stamp: 'dkh 6/12/2012 15:41:23.319'!
packageSpec
    ^ self project packageSpec! !

!MetacelloSpecTestCase methodsFor: 'accessing' stamp: 'dkh 5/4/2012 20:37:12'!
projectClass
    ^ MetacelloProject! !

!MetacelloSpecTestCase methodsFor: 'specs' stamp: 'dkh 5/4/2012 20:37:12'!
versionSpec
    ^ self project versionSpec! !

!MetacelloSpecTestCase methodsFor: 'accessing' stamp: 'dkh 5/4/2012 20:37:12'!
project
    ^ self projectWith: #()! !

!MetacelloSpecTestCase methodsFor: 'specs' stamp: 'dkh 5/4/2012 20:37:12'!
packagesSpec
    ^ self project packagesSpec! !

!MetacelloSpecTestCase methodsFor: '*metacello-testsmccore' stamp: 'dkh 6/12/2012 15:41:23.319'!
repositoriesSpec
    ^ self project repositoriesSpec! !

!MetacelloSpecTestCase methodsFor: 'specs' stamp: 'dkh 5/4/2012 20:37:12'!
projectReferenceSpec
    ^ self project projectReferenceSpec! !

!MetacelloSpecTestCase methodsFor: 'specs' stamp: 'dkh 5/4/2012 20:37:12'!
valueHolderSpec
    ^ self project valueHolderSpec! !

!MetacelloSpecTestCase methodsFor: '*metacello-testsmccore' stamp: 'dkh 6/12/2012 15:41:23.319'!
repositorySpec
    ^ self project repositorySpec! !

!MetacelloStackCacheTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testClearCache

	MetacelloPlatform current 
		stackCacheFor: #cached
		at: #key 
		doing: [:cache | | value |
			cache at: #x put: 1.
			self assert: (cache at: #x ifAbsent: []) == 1.
			MetacelloClearStackCacheNotification signal.
			self assert: (cache at: #x ifAbsent: []) == nil ]
! !

!MetacelloStackCacheTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testCollectionCacheKey

	| x |
	self assert: 
		(Array with: self class with: (Array with: 'faux' with: 'foobar'))
			= (Array with: self class with: (Array with: 'faux' with: 'foobar')).
	self deny: 
		(Array with: self class with: (Array with: 'faux' with: 'foobar'))
			= (Array with: self class with: (Array with: 'faux' with: 'foobar' with: 'foobaz')).
	self assert: (x := self collectionCacheKey) == 6.
! !

!MetacelloStackCacheTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
cachedReturnOfValue

	^MetacelloPlatform current 
		stackCacheFor: #cached
		at: #key 
		doing: [:cache | | value |
			value := cache at: #x ifAbsent: [ 0 ].
			value > 5 
				ifTrue: [ cache at: #key put: value ]
				ifFalse: [ 
					value := value + 1.
					cache at: #x put: value ].
			self cachedReturnOfValue ]
! !

!MetacelloStackCacheTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
directReturnOfValue

	^MetacelloPlatform current 
		stackCacheFor: #direct
		at: #key 
		doing: [:cache | | value |
			value := cache at: #x ifAbsent: [ 0 ].
			value > 5 ifTrue: [ ^value ].
			value := value + 1.
			cache at: #x put: value.
			self directReturnOfValue ]
! !

!MetacelloStackCacheTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testCacheNil

	| x |
	self assert: (x := self cacheNil) == nil! !

!MetacelloStackCacheTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
cacheNil

	^MetacelloPlatform current 
		stackCacheFor: #cacheNil
		at: #key 
		doing: [:cache | | value |
			cache at: #key put: nil.
			self cacheNil ]
! !

!MetacelloStackCacheTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testMixedStack

	| x |
	self assert: (x := self mixedStack) == 4! !

!MetacelloStackCacheTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testDefaultDictionary

	| defaultDictionary |
	defaultDictionary := Dictionary new.
	MetacelloPlatform current 
		useStackCacheDuring: [:dict | 
			self 
				cachedReturnOfValue;
				collectionCacheKey;
				cacheNil;
				directReturnOfValue;
				mixedStack;
				mixedStackCall ] 
		defaultDictionary: defaultDictionary.
	self assert: (defaultDictionary includesKey: #cached).
	self assert: (defaultDictionary includesKey: #cacheNil).
	self assert: (defaultDictionary includesKey: #collection).
	self assert: (defaultDictionary includesKey: #direct).
	self assert: (defaultDictionary includesKey: #mixed).
	self assert: (defaultDictionary includesKey: #mixedStack).
! !

!MetacelloStackCacheTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testCachedReturn

	| x |
	self assert: (x := self cachedReturnOfValue) == 6! !

!MetacelloStackCacheTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
collectionCacheKey

	| key |
	key := Array with: self class with: (Array with: #x with: #y).
	^MetacelloPlatform current 
		stackCacheFor: #collection
		at: key 
		doing: [:cache | | value |
			value := cache at: #x ifAbsent: [ 0 ].
			value > 5 
				ifTrue: [ cache at: key put: value ]
				ifFalse: [ 
					value := value + 1.
					cache at: #x put: value ].
			self collectionCacheKey ]
! !

!MetacelloStackCacheTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
mixedStack

	^MetacelloPlatform current 
		stackCacheFor: #mixed
		at: #key 
		doing: [:cache | | value |
			value := cache at: #x ifAbsent: [ 0 ].
			value > 3 ifTrue: [ ^value ].
			value := value + 1.
			cache at: #x put: value.
			self assert: self directReturnOfValue == 6.
			self assert: self mixedStackCall == 4.
			self mixedStack ]
! !

!MetacelloStackCacheTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testDirectReturn

	| x |
	self assert: (x := self directReturnOfValue) == 6! !

!MetacelloStackCacheTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testPrimeStackCache

	| cached collection cacheNil direct mixed mixedStack block defaultDictionary |
	defaultDictionary := Dictionary new.
	block := [ 
		cached := Dictionary new.
		collection := Dictionary new.
		cacheNil := Dictionary new.
		direct := Dictionary new.
		mixed := Dictionary new.
		mixedStack := Dictionary new.
		MetacelloPlatform current useStackCacheDuring: [ :dict | self cachedReturnOfValue ] defaultDictionary: cached.
		MetacelloPlatform current useStackCacheDuring: [ :dict | self collectionCacheKey ] defaultDictionary: collection.
		MetacelloPlatform current useStackCacheDuring: [ :dict | self cacheNil ] defaultDictionary: cacheNil.
		MetacelloPlatform current useStackCacheDuring: [ :dict | self directReturnOfValue ] defaultDictionary: direct.
		MetacelloPlatform current useStackCacheDuring: [ :dict | self mixedStack ] defaultDictionary: mixed.
		MetacelloPlatform current useStackCacheDuring: [ :dict | self mixedStackCall ] defaultDictionary: mixedStack ].	

	"Test without priming stack cache ... each defaultDictionary is used independently"
	block value.
	self assert: ((cached at: #cached) at: #key) == 6.
	self assert: ((collection at: #collection) at: #x) == 6.
	self assert: ((cacheNil at: #cacheNil) at: #key) == nil.
	self assert: ((direct at: #direct) at: #x) == 6.
	self assert: ((mixed at: #cached) at: #key) == 6.
	self assert: ((mixed at: #mixed) at: #x) == 4.
	self assert: ((mixed at: #mixedStack) at: #x) == 4.
	self assert: ((mixed at: #direct) at: #x) == 6.
	self assert: ((mixedStack at: #cached) at: #key) == 6.
	self assert: ((mixedStack at: #mixedStack) at: #x) == 4.	

	"Prime stack cache with defaultDictionary .... all values should be stored there instead of individual defaults."
	MetacelloPlatform current primeStackCacheWith: defaultDictionary doing: block.
	self assert: ((defaultDictionary at: #cached) at: #key) == 6.
	self assert: ((defaultDictionary at: #collection) at: #x) == 6.
	self assert: ((defaultDictionary at: #cacheNil) at: #key) == nil.
	self assert: ((defaultDictionary at: #direct) at: #x) == 6.
	self assert: ((defaultDictionary at: #cached) at: #key) == 6.
	self assert: ((defaultDictionary at: #mixed) at: #x) == 4.
	self assert: ((defaultDictionary at: #mixedStack) at: #x) == 4.
	self assert: ((defaultDictionary at: #direct) at: #x) == 6.
	self assert: ((defaultDictionary at: #cached) at: #key) == 6.
	self assert: ((defaultDictionary at: #mixedStack) at: #x) == 4! !

!MetacelloStackCacheTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
mixedStackCall

	^MetacelloPlatform current 
		stackCacheFor: #mixedStack
		at: #key 
		doing: [:cache | | value |
			value := cache at: #x ifAbsent: [ 0 ].
			value > 3 ifTrue: [ ^value ].
			value := value + 1.
			cache at: #x put: value.
			self assert: self cachedReturnOfValue == 6.
			self mixedStackCall ]
! !

!MetacelloSymbolicVersionDoesNotExistError methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
possibleVersions
    ^ self project symbolicVersionSymbols! !

!MetacelloSymbolicVersionDoesNotExistError methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
description
    "Return a textual description of the exception."

    ^ 'The symbolic version ' , self versionString printString , ' is not defined in ' , self project label
        , ' for the current platform. Possible symbolic version values include: ' , self possibleVersions printString! !

!MetacelloSymbolicVersionMethodSpec methodsFor: 'method generation' stamp: 'dkh 9/7/2012 10:44'!
methodSource
    | strm |
    strm := WriteStream on: String new.
    self symbolicMethodSelectorAndPragma: self selector symbolicVersionSymbol: self versionString on: strm.
    (self methodSections asArray sort: [ :a :b | a attributes first <= b attributes first ])
        do: [ :methodSection | 
            | vs |
            strm
                cr;
                tab;
                nextPutAll: 'spec for: ' , methodSection attributePrintString , ' version: '.
            vs := methodSection versionString.
            vs isSymbol
                ifTrue: [ strm nextPut: $# ].
            strm
                nextPutAll: vs asString printString , '.';
                cr ].
    ^ strm contents! !

!MetacelloSymbolicVersionMethodSpec methodsFor: 'method generation' stamp: 'dkh 6/5/2012 19:01:24'!
symbolicMethodSelectorAndPragma: aSelector symbolicVersionSymbol: symbolicVersionSymbol on: strm
	strm
		nextPutAll: aSelector asString , ' spec';
		cr;
		tab;
		nextPutAll: '<symbolicVersion: #' , symbolicVersionSymbol asString printString;
		nextPutAll: '>';
		cr! !

!MetacelloSymbolicVersionMethodSpec methodsFor: 'adding' stamp: 'dkh 9/9/2012 07:33'!
addMethodSection: attribute versionString: aString
    self methodSections
        add:
            (MetacelloSymbolicVersionSpec new
                attributes: attribute asMetacelloAttributeList;
                versionString: aString;
                yourself)! !

!MetacelloSymbolicVersionMethodSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
versionString: aStringOrSymbol

	aStringOrSymbol isSymbol ifFalse: [ self error: 'Version symbol ', aStringOrSymbol printString, ' for symbolic version method must be a Symbol' ].
	super versionString: aStringOrSymbol! !

!MetacelloSymbolicVersionNotDefinedError methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
description
    "Return a textual description of the exception."

    ^ 'The symbolic version ' , self versionString printString , ' is EXPLICITLY not defined in ' , self project label
        , ' for the current platform (i.e., symbolic version defined as #notDefined).'! !

!MetacelloSymbolicVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
versionString
	^ versionString! !

!MetacelloSymbolicVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
versionString: anObject
	versionString := anObject! !

!MetacelloTestsGoferCleanup methodsFor: 'cleaning' stamp: 'dkh 6/12/2012 15:41:23.319'!
cleanupProtocols: aWorkingCopy
	"Not needed - for faster test running"! !

!MetacelloTestsGoferUnload methodsFor: 'unloading' stamp: 'dkh 6/12/2012 15:41:23.319'!
unloadClasses: aWorkingCopy
	"skip this so that tests run faster"! !

!MetacelloTestsGoferUnload methodsFor: 'running' stamp: 'dkh 6/12/2012 15:41:23.319'!
execute
	self workingCopies 
		do: [ :copy | self unload: copy ].
	self model load.
	self gofer metacelloCleanup.
	self workingCopies 
		do: [ :copy | self unregister: copy ]! !

!MetacelloTestsMCPackage methodsFor: 'accessing' stamp: 'dkh 6/17/2013 16:41:23.319'!
packageSet
	"Aiming for speeding up the running of the tests"

	^ MetacelloTestsPackageSet named: name
! !

!MetacelloTestsMCPackage methodsFor: 'accessing' stamp: 'ChristopheDemarey 8/25/2014 12:02'!
species
	^ MCPackage! !

!MetacelloTestsMCPackage methodsFor: 'accessing' stamp: 'dkh 6/17/2013 16:24:12'!
packageInfo
	"Aiming for speeding up the running of the tests"

	^ MetacelloTestsPackageSet named: name
! !

!MetacelloTestsPackageSet commentStamp: '<historical>'!
This class is used to speed up Metacello tests.
!
!MetacelloTestsPackageSet methodsFor: 'listing' stamp: 'EstebanLorenzano 5/29/2013 16:09'!
extensionMethods
	"Test packages don't extend classes and skipping this operation is a significant performance gain for running tests"
	^ #()! !

!MetacelloTestsPackageSet methodsFor: 'listing' stamp: 'EstebanLorenzano 5/29/2013 16:09'!
overriddenMethods
	"Test packages don't override methods and skipping this operation is a significant performance gain for running tests"
	^ #()! !

!MetacelloToolBox commentStamp: '<historical>'!
MetacelloToolbox implements a toolbox API for Metacello.

The toolbox methods on the class-side implement scripts for a number of commonly performed Metacello development tasks. The methods should be used in development scripts or GUI tools so that a common implementation is preserved across the toolset.!
!MetacelloToolBox methodsFor: 'private' stamp: 'dkh 3/7/2012 17:08:50'!
buildMapFrom: mapList for: packageList
	| map |
	map := Dictionary new.
	mapList
		do: [ :assoc | 
			| pkgName pkgSpec |
			pkgName := assoc key.
			(packageList includes: pkgName)
				ifFalse: [ self error: 'package ' , pkgName printString , ' not found in packages.' ].
			map at: pkgName put: assoc value ].
	^ map! !

!MetacelloToolBox methodsFor: 'api-configuration' stamp: 'dkh 9/8/2012 05:05'!
modifySection: sectionAttributeOrPath sectionIndex: sectionIndex repository: repositoryDescription requiredProjects: newProjectList packages: newPackageList dependencies: dependecies includes: includes files: files repositories: repositories preLoadDoIts: preLoadDoIts postLoadDoIts: postLoadDoIts supplyingAnswers: supplyingAnswers groups: newGroups versionSpecsDo: aBlock
    "
		repositoryDescription - metacello repository string
		newProjectList - collection of project base names (without ConfigurationOf prefix)
		newPackageList - collection of package base names
		dependencies - collection of associations where key is name of package and value is collection of required packages and projects
		includes - collection of associations where key is name of package and value is collection of included packages and projects
		files - collection of associations where key is name of package and value is name of file
		repositories - collection of associations where key is name of package and value is collection of repository descriptions
		preLoadDoIts - collection of associations where key is name of package and value is preload doit selector
		postLoadDoIts - collection of associations where key is name of package and value is postload doit selector
		supplyingAnswers - collection of associations where key is name of package and value is the supplyingAnswers array
		newGroups - collection of associations where key is the name of the group and value is the collection of group members
	"

    | versionSpec dependencyMap includesMap filesMap repositoriesMap preLoadDoItsMap postLoadDoItsMap supplyingAnswersMap groups packageList newGroupNames |
    versionSpec := (self methodSpec
        findMethodSection: sectionAttributeOrPath asMetacelloAttributePath
        sectionIndex: sectionIndex) versionSpec.
    repositoryDescription ~~ nil
        ifTrue: [ versionSpec repository: repositoryDescription ].
    newProjectList
        do: [ :projectName | 
            (versionSpec packages specListDetect: [ :spec | spec name = projectName ] ifNone: [  ]) == nil
                ifTrue: [ versionSpec packages merge: (self createProjectReferenceSpec: projectName) ]
                ifFalse: [ self error: 'Project named: ' , projectName printString , ' already exists.' ] ].
    packageList := OrderedCollection new.
    groups := OrderedCollection new.
    newGroupNames := OrderedCollection new.
    versionSpec
        projectDo: [ :ignored |  ]
        packageDo: [ :pkg | packageList add: pkg name ]
        groupDo: [ :group | 
            groups add: group name -> group includes.
            newGroupNames add: group name ].
    newPackageList
        do: [ :packageName | 
            (packageList includes: packageName)
                ifTrue: [ self error: 'Package named: ' , packageName printString , ' already exists.' ]
                ifFalse: [ packageList add: packageName ] ].
    newGroups
        do: [ :assoc | 
            (newGroupNames includes: assoc key)
                ifTrue: [ self error: 'Group named: ' , assoc key printString , ' already exists.' ]
                ifFalse: [ groups add: assoc ] ].
    dependencyMap := self buildMapFrom: dependecies for: packageList.
    includesMap := self buildMapFrom: includes for: packageList.
    filesMap := self buildMapFrom: files for: packageList.
    repositoriesMap := self buildMapFrom: repositories for: packageList.
    preLoadDoItsMap := self buildMapFrom: preLoadDoIts for: packageList.
    postLoadDoItsMap := self buildMapFrom: postLoadDoIts for: packageList.
    supplyingAnswersMap := self buildMapFrom: supplyingAnswers for: packageList.
    packageList
        do: [ :packageName | 
            | spec |
            (newPackageList includes: packageName)
                ifTrue: [ 
                    spec := self createPackageSpec: packageName.
                    versionSpec packages merge: spec ]
                ifFalse: [ spec := versionSpec packages specListDetect: [ :spc | spc name = packageName ] ].
            dependencyMap
                at: packageName
                ifPresent: [ :dependencyList | spec setRequires: spec requires , dependencyList ].
            includesMap at: packageName ifPresent: [ :includesList | spec setIncludes: spec includes , includesList ].
            filesMap at: packageName ifPresent: [ :file | spec file: file ].
            repositoriesMap
                at: packageName
                ifPresent: [ :repositoriesList | repositoriesList do: [ :repoString | spec repository: repoString ] ].
            preLoadDoItsMap at: packageName ifPresent: [ :preLoad | spec preLoadDoIt: preLoad ].
            postLoadDoItsMap at: packageName ifPresent: [ :postLoad | spec postLoadDoIt: postLoad ].
            supplyingAnswersMap at: packageName ifPresent: [ :answer | spec answers: answer ] ].
    groups
        do: [ :assoc | 
            | spec |
            (newGroupNames includes: assoc key)
                ifFalse: [ 
                    spec := self createGroupSpec: assoc key.
                    versionSpec packages merge: spec.
                    spec setIncludes: spec includes , assoc value ] ].
    aBlock value: versionSpec! !

!MetacelloToolBox methodsFor: 'spec creation' stamp: 'dkh 3/7/2012 17:08:50'!
createGroupSpec: baseName
	^ (self project groupSpec)
		name: baseName;
		yourself! !

!MetacelloToolBox methodsFor: 'api-configuration' stamp: 'dkh 3/7/2012 17:08:50'!
abortMethod

	project := project configuration class project.	"recalculate project"
	methodSpec := nil! !

!MetacelloToolBox methodsFor: 'api-configuration' stamp: 'dkh 3/7/2012 17:08:50'!
addSection: sectionAttributeOrPath repository: repositoryDescription requiredProjects: projectList packages: packageList dependencies: dependecies groups: groups versionSpecsDo: aBlock
	"
		repositoryDescription - metacello repository string
		projectList - collection of project base names (without ConfigurationOf prefix)
		packageList - collection of package base names
		dependencies - collection of associations where key is name of package and value is collection of required packages and projects
		groups - collection of associations where key is the name of the group and value is the collection of group members
	"
	self
		addSection: sectionAttributeOrPath
		repository: repositoryDescription
		requiredProjects: projectList
		packages: packageList
		dependencies: dependecies
		includes: #()
		files: #()
		repositories: #()
		preLoadDoIts: #()
		postLoadDoIts: #()
		supplyingAnswers: #()
		groups: groups
		versionSpecsDo: aBlock! !

!MetacelloToolBox methodsFor: 'private' stamp: 'dkh 3/7/2012 17:08:50'!
ensureMetacello
	"noop for now"! !

!MetacelloToolBox methodsFor: 'accessing' stamp: 'dkh 3/7/2012 17:08:50'!
project

	^project! !

!MetacelloToolBox methodsFor: 'api-configuration' stamp: 'dkh 9/13/2012 16:43'!
updateVersionMethodForVersion: inputVersionStringOrSymbol updateProjects: updateProjects updatePackages: updatePackages versionSpecsDo: aBlock
    ^ self
        updateVersionMethodForVersion: inputVersionStringOrSymbol
        projectAttributes: project attributes
        updateProjects: updateProjects
        updatePackages: updatePackages
        versionSpecsDo: aBlock! !

!MetacelloToolBox methodsFor: 'private' stamp: 'dkh 3/7/2012 17:08:50'!
clearVersionSpec: versionSpec fullVersionSpec: fullVersionSpec updateProjects: updateProjects updatePackages: updatePackages
	versionSpec
		specListProjectDo: [ :spec | 
			updateProjects
				ifTrue: [ 
					| fullProjectReferenceSpec fullProjectSpec |
					(fullProjectReferenceSpec := fullVersionSpec packageNamed: spec name) ~~ nil
						ifTrue: [ 
							fullProjectSpec := fullProjectReferenceSpec projectReference.
							fullProjectSpec versionString == nil
								ifTrue: [ spec projectReference versionString: '' ] ] ] ]
		packageDo: [ :spec | 
			updatePackages
				ifTrue: [ 
					spec getFile ~~ nil
						ifTrue: [ spec file: '' ] ] ]
		groupDo: [ :ignored |  ]! !

!MetacelloToolBox methodsFor: 'testing' stamp: 'dkh 3/7/2012 17:08:50'!
hasMethodForSymbolicVersion: versionSymbol

	^(self constructor extractSymbolicVersionPragmas at: versionSymbol ifAbsent: [ ^ false ]) size > 0
! !

!MetacelloToolBox methodsFor: 'validation' stamp: 'dkh 3/7/2012 17:08:50'!
validateConfiguration
    | issues |
    issues := (MetacelloMCVersionValidator validateConfiguration: project configuration class recurse: false)
        select: [ :issue | issue isCritical ].
    issues notEmpty
        ifTrue: [ MetacelloValidationFailure issues: issues message: 'There are critical issues in the configuration' ]! !

!MetacelloToolBox methodsFor: 'api-configuration' stamp: 'dkh 3/7/2012 17:08:50'!
imports: importList

	self methodSpec imports: importList! !

!MetacelloToolBox methodsFor: 'private' stamp: 'dkh 05/15/2013 20:39'!
baselineNameFrom: baseName
  ^ self class baselineNameFrom: baseName! !

!MetacelloToolBox methodsFor: 'api-configuration' stamp: 'dkh 3/7/2012 17:08:50'!
createVersionMethod: selector inCategory: category forVersion: versionString
	
	methodSpec := (MetacelloVersionMethodSpec new)
		project: project;
		selector: selector;
		category: category;
		versionString: versionString;
		yourself.! !

!MetacelloToolBox methodsFor: 'api-configuration' stamp: 'EstebanLorenzano 7/21/2014 13:36'!
baselineNamed: baseName
  | baselineName |
  "Check if the class does not exist"
  baselineName := self baselineNameFrom: baseName.
  (Smalltalk includesKey: baselineName asSymbol)
    ifFalse: [ 
      "Create the configuration class"
      self ensureMetacello.
      BaselineOf
        subclass: baselineName
        instVarNames: #()
        classVars: #()
        classInstVars: #()
        poolDictionaries: #()
        category: baselineName.
      RPackageOrganizer default registerPackageNamed: baselineName ].
  project := (MetacelloPlatform current globalNamed: baselineName asSymbol) project! !

!MetacelloToolBox methodsFor: 'private' stamp: 'dkh 9/13/2012 16:18'!
editVersionSpecsForImport: constructor projectAttributes: projectAttributes active: activeSection fullVersionSpec: fullVersionSpec updateProjects: updateProjects updatePackages: updatePackages visited: visitedSpecs updated: updatedSpecs
    | fileSpecified encounteredPackageSpecs |
    fileSpecified := Bag new.
    encounteredPackageSpecs := Bag new.
    constructor
        methodSectionsInEvaluationOrder: projectAttributes reverse
        do: [ :methodSection | 
            "collect packageSpec names ... interested in singletons"
            methodSection versionSpec
                specListProjectDo: [ :spec |  ]
                packageDo: [ :spec | 
                    encounteredPackageSpecs add: spec name.
                    (spec copy updateForSpawnMethod: spec)
                        ifFalse: [ fileSpecified add: spec name ] ]
                groupDo: [ :spec |  ] ].
    constructor
        methodSectionsInEvaluationOrder: projectAttributes reverse
        do: [ :methodSection | 
            | versionSpec attributePath packageSpecsToDelete |
            versionSpec := methodSection versionSpec.
            attributePath := methodSection attributePath.
            versionSpec updateForSpawnMethod: versionSpec.
            packageSpecsToDelete := OrderedCollection new.
            versionSpec
                specListProjectDo: [ :spec | spec updateForSpawnMethod: spec ]
                packageDo: [ :spec | 
                    encounteredPackageSpecs remove: spec name.
                    (spec updateForSpawnMethod: spec)
                        ifTrue: [ 
                            "no file speced"
                            ((fileSpecified includes: spec name) or: [ encounteredPackageSpecs includes: spec name ])
                                ifTrue: [ 
                                    "already specified somewhere else, need to delete this spec from version spec OR we're deleting all but first occurence"
                                    packageSpecsToDelete add: spec ]
                                ifFalse: [ 
                                    "file hasn't been specified, so specify now"
                                    spec file: spec name.
                                    fileSpecified add: spec name ] ]
                        ifFalse: [ 
                            "file specified"
                            (fileSpecified occurrencesOf: spec name) > 1
                                ifTrue: [ 
                                    "multiple specifications for file ... delete all but first occurence"
                                    packageSpecsToDelete add: spec.
                                    fileSpecified remove: spec name ] ] ]
                groupDo: [ :spec | spec updateForSpawnMethod: spec ].
            packageSpecsToDelete do: [ :spec | versionSpec deleteSpec: spec ].
            activeSection
                ifTrue: [ 
                    self
                        updateVersionSpec: versionSpec
                        fullVersionSpec: fullVersionSpec
                        updateProjects: updateProjects
                        updatePackages: updatePackages
                        visited: visitedSpecs
                        updated: updatedSpecs ]
                ifFalse: [ 
                    self
                        clearVersionSpec: versionSpec
                        fullVersionSpec: fullVersionSpec
                        updateProjects: updateProjects
                        updatePackages: updatePackages ] ]! !

!MetacelloToolBox methodsFor: 'api-configuration' stamp: 'dkh 3/7/2012 17:08:50'!
updateVersionMethodForVersion: inputVersionStringOrSymbol versionSpecsDo: aBlock
	^ self
		updateVersionMethodForVersion: inputVersionStringOrSymbol
		updateProjects: true
		updatePackages: true
		versionSpecsDo: aBlock! !

!MetacelloToolBox methodsFor: 'api-configuration' stamp: 'dkh 9/7/2012 07:50'!
addSymbolicSection: attribute version: versionString
    self methodSpec methodSections
        do: [ :methodSection | 
            methodSection attributes = {attribute}
                ifTrue: [ 
                    methodSection versionString: versionString.
                    ^ self ] ].
    self methodSpec addMethodSection: attribute versionString: versionString! !

!MetacelloToolBox methodsFor: 'api-configuration' stamp: 'EstebanLorenzano 7/21/2014 13:36'!
configurationNamed: baseName
	| configurationName |
	"Check if the class does not exist"
	configurationName := self configurationNameFrom: baseName.
	(Smalltalk includesKey: configurationName asSymbol)
		ifFalse: [ 
			self ensureMetacello.	
			"Create the configuration class"
			MetacelloPlatform current
				copyClass: (MetacelloPlatform current globalNamed: #MetacelloConfigTemplate)
				as: configurationName asSymbol
				inCategory: configurationName asString.	
			"Create the package that has the same name"
			RPackageOrganizer default registerPackageNamed: configurationName ].
	project := (MetacelloPlatform current globalNamed: configurationName asSymbol) project! !

!MetacelloToolBox methodsFor: 'api-configuration' stamp: 'dkh 3/7/2012 17:08:50'!
modifiedPackageSpecs: versionStringOrSymbol packageSpecsDo: aBlock
	| versionSpec |
	versionSpec := (self project version: versionStringOrSymbol) spec.
	versionSpec
		projectDo: [ :ignored |  ]
		packageDo: [ :packageSpec | 
			| wc |
			wc := packageSpec workingCopy.
			wc ~~ nil
				ifTrue: [ 
					wc modified
						ifTrue: [ aBlock value: versionSpec value: packageSpec value: wc ] ] ]
		groupDo: [ :ignored |  ]! !

!MetacelloToolBox methodsFor: 'api-configuration' stamp: 'dkh 3/7/2012 17:08:50'!
modifySymbolicVersionMethodFor: versionSymbol

	^self modifySymbolicVersionMethodFor: versionSymbol symbolicVersionSpecsDo: [:symbolicVersionSpec | true ].
! !

!MetacelloToolBox methodsFor: 'api-configuration' stamp: 'dkh 3/7/2012 17:08:50'!
symbolicVersionMethod: versionSymbol
	(self hasMethodForSymbolicVersion: versionSymbol)
		ifTrue: [ self modifySymbolicVersionMethodFor: versionSymbol ]
		ifFalse: [ 
			self
				createSymbolicVersionMethod: versionSymbol asString , ':'
				inCategory: 'symbolic versions'
				forVersion: versionSymbol ].
! !

!MetacelloToolBox methodsFor: 'api-configuration' stamp: 'dkh 9/13/2012 19:13'!
updateVersionMethodForVersion: inputVersionStringOrSymbol projectAttributes: projectAttributes updateProjects: updateProjects updatePackages: updatePackages versionSpecsDo: aBlock
    | constructor updatedSpecs fullVersionSpec version coll pragma imports blessing reversed addedSections visitedSpecs sourceVersionString keptSections |
    updatedSpecs := Set new.
    version := project version: inputVersionStringOrSymbol.
    sourceVersionString := version versionString.	"resolve symbolic version"
    blessing := version blessing.
    blessing == #'release'
        ifTrue: [ 
            MetacelloCannotUpdateReleasedVersionError
                signal: 'Should not update a version that has been released (resume to continue update).' ].
    fullVersionSpec := version spec.
    constructor := self constructor.
    coll := constructor extractAllVersionPragmas at: sourceVersionString ifAbsent: [ ^ updatedSpecs ].
    coll size > 1
        ifTrue: [ self error: 'More than one pragma defining ' , sourceVersionString printString ].
    pragma := coll at: 1.
    imports := pragma numArgs = 2
        ifTrue: [ pragma argumentAt: 2 ]
        ifFalse: [ #() ].
    methodSpec := MetacelloVersionMethodSpec new
        project: project;
        selector: pragma selector;
        category: (project configuration class whichCategoryIncludesSelector: pragma selector);
        versionString: sourceVersionString;
        imports: imports;
        yourself.
    constructor extractMethodSectionsFor: sourceVersionString.
    addedSections := Dictionary new.
    visitedSpecs := Set new.
    keptSections := IdentitySet new.
    constructor
        methodSectionsInEvaluationOrder: projectAttributes reverse
        do: [ :methodSection | 
            | versionSpec |
            versionSpec := methodSection versionSpec.
            (blessing ~~ #'baseline' and: [ methodSection includesAttributeFrom: projectAttributes ])
                ifTrue: [ 
                    self
                        updateVersionSpec: versionSpec
                        fullVersionSpec: fullVersionSpec
                        updateProjects: updateProjects
                        updatePackages: updatePackages
                        visited: visitedSpecs
                        updated: updatedSpecs ].
            (aBlock value: methodSection attributeOrPath value: versionSpec)
                ifTrue: [ keptSections add: methodSection topParent ] ].
    constructor methodSections
        do: [ :methodSection | 
            (methodSection includesAttributeFrom: projectAttributes)
                ifTrue: [ 
                    (keptSections includes: methodSection)
                        ifTrue: [ self methodSpec methodSections add: methodSection ] ]
                ifFalse: [ self methodSpec methodSections add: methodSection ] ].
    ^ updatedSpecs! !

!MetacelloToolBox methodsFor: 'validation' stamp: 'dkh 3/7/2012 17:08:50'!
validateVersion: versionStringOrSymbol
    | issues |
    issues := (MetacelloMCVersionValidator validateProject: project version: versionStringOrSymbol)
        select: [ :issue | issue isError ].
    issues notEmpty
        ifTrue: [ 
            MetacelloValidationFailure
                issues: issues
                message: 'There are error issues with version ' , versionStringOrSymbol printString ]! !

!MetacelloToolBox methodsFor: 'api-configuration' stamp: 'dkh 9/7/2012 13:33'!
addSection: sectionAttributeOrPath repository: repositoryDescription requiredProjects: projectList packages: packageList dependencies: dependecies includes: includes files: files repositories: repositories preLoadDoIts: preLoadDoIts postLoadDoIts: postLoadDoIts supplyingAnswers: supplyingAnswers groups: groups versionSpecsDo: aBlock
    "
		repositoryDescription - metacello repository string
		projectList - collection of project base names (without ConfigurationOf prefix)
		packageList - collection of package base names
		dependencies - collection of associations where key is name of package and value is collection of required packages and projects
		includes - collection of associations where key is name of package and value is collection of included packages and projects
		files - collection of associations where key is name of package and value is name of file
		repositories - collection of associations where key is name of package and value is collection of repository descriptions
		preLoadDoIts - collection of associations where key is name of package and value is preload doit selector
		postLoadDoIts - collection of associations where key is name of package and value is postload doit selector
		supplyingAnswers - collection of associations where key is name of package and value is the supplyingAnswers array
		groups - collection of associations where key is the name of the group and value is the collection of group members
	"

    | versionSpec dependencyMap includesMap filesMap repositoriesMap preLoadDoItsMap postLoadDoItsMap supplyingAnswersMap |
    versionSpec := self createVersionSpec: self methodSpec versionString.
    repositoryDescription ~~ nil
        ifTrue: [ versionSpec repository: repositoryDescription ].
    dependencyMap := self buildMapFrom: dependecies for: packageList.
    includesMap := self buildMapFrom: includes for: packageList.
    filesMap := self buildMapFrom: files for: packageList.
    repositoriesMap := self buildMapFrom: repositories for: packageList , projectList.
    preLoadDoItsMap := self buildMapFrom: preLoadDoIts for: packageList.
    postLoadDoItsMap := self buildMapFrom: postLoadDoIts for: packageList.
    supplyingAnswersMap := self buildMapFrom: supplyingAnswers for: packageList.
    projectList
        do: [ :projectName | 
            | spec |
            spec := self createProjectReferenceSpec: projectName.
            repositoriesMap
                at: projectName
                ifPresent: [ :repositoriesList | repositoriesList do: [ :repoString | spec repository: repoString ] ].
            versionSpec packages merge: spec ].
    packageList
        do: [ :packageName | 
            | spec |
            spec := self createPackageSpec: packageName.
            dependencyMap at: packageName ifPresent: [ :dependencyList | spec requires: dependencyList ].
            includesMap at: packageName ifPresent: [ :includesList | spec includes: includesList ].
            filesMap at: packageName ifPresent: [ :file | spec file: file ].
            repositoriesMap
                at: packageName
                ifPresent: [ :repositoriesList | repositoriesList do: [ :repoString | spec repository: repoString ] ].
            preLoadDoItsMap at: packageName ifPresent: [ :preLoad | spec preLoadDoIt: preLoad ].
            postLoadDoItsMap at: packageName ifPresent: [ :postLoad | spec postLoadDoIt: postLoad ].
            supplyingAnswersMap at: packageName ifPresent: [ :answer | spec answers: answer ].
            versionSpec packages merge: spec ].
    groups
        do: [ :assoc | 
            | spec |
            spec := self createGroupSpec: assoc key.
            spec includes: assoc value.
            versionSpec packages merge: spec ].
    aBlock value: versionSpec.
    self methodSpec addMethodSection: sectionAttributeOrPath asMetacelloAttributePath versionSpec: versionSpec! !

!MetacelloToolBox methodsFor: 'spec creation' stamp: 'EstebanLorenzano 7/21/2014 13:36'!
createConfiguration: baseName
	| configurationName |
	"Check if the class does not exist"
	configurationName := (baseName beginsWith: 'ConfigurationOf')
		ifTrue: [ baseName ]
		ifFalse: [ 'ConfigurationOf' , baseName ].
	(Smalltalk includesKey: configurationName asSymbol)
		ifFalse: [ 
			self ensureMetacello.	
			"Create the configuration class"
			MetacelloPlatform current
				copyClass: (MetacelloPlatform current globalNamed: #MetacelloConfigTemplate)
				as: configurationName asSymbol
				inCategory: configurationName asString.	
			"Create the package that has the same name"
			RPackageOrganizer default registerPackageNamed: configurationName ].
	^(MetacelloPlatform current globalNamed: configurationName asSymbol) project! !

!MetacelloToolBox methodsFor: 'spec creation' stamp: 'dkh 3/7/2012 17:08:50'!
createProjectReferenceSpec: projectBaseName
    | configurationName projectReferenceProject versionString |
    configurationName := self configurationNameFrom: projectBaseName.
    projectReferenceProject := (MetacelloPlatform current
        globalNamed: configurationName asSymbol
        ifAbsent: [ 
            self
                error:
                    'The configuration ' , configurationName printString , ' for the project ' , projectBaseName printString
                        , ' is not currently loaded into the image.' ]) project.
    versionString := (projectReferenceProject hasVersion: #'stable')
        ifTrue: [ #'stable' ]
        ifFalse: [ #'bleedingEdge' ].
    ^ project projectReferenceSpec
        name: projectBaseName;
        projectReference:
                (project projectSpec
                        name: projectBaseName;
                        className: configurationName;
                        versionString: versionString;
                        yourself);
        yourself! !

!MetacelloToolBox methodsFor: 'api-configuration' stamp: 'dkh 9/14/2012 09:47'!
importFrom: inputVersionStringOrSymbol projectAttributes: projectAttributes inactiveAttributes: inactiveAttributesList updateProjects: updateProjects updatePackages: updatePackages versionSpecsDo: aBlock
    | constructor updatedSpecs fullVersionSpec version visitedSpecs fromVersionString attributeSet |
    constructor := self constructor.
    updatedSpecs := Set new.
    visitedSpecs := Set new.
    version := project version: inputVersionStringOrSymbol.
    fromVersionString := version versionString.	"resolve symbolic versions"
    fullVersionSpec := version spec.
    self methodSpec imports: {fromVersionString}.
    constructor extractMethodSectionsFor: fromVersionString.
    self
        editVersionSpecsForImport: constructor
        projectAttributes: projectAttributes
        active: true
        fullVersionSpec: fullVersionSpec
        updateProjects: updateProjects
        updatePackages: updatePackages
        visited: visitedSpecs
        updated: updatedSpecs.
    attributeSet := projectAttributes.
    inactiveAttributesList
        do: [ :inactiveAttributes | 
            self
                editVersionSpecsForImport: constructor
                projectAttributes: inactiveAttributes
                active: false
                fullVersionSpec: fullVersionSpec
                updateProjects: updateProjects
                updatePackages: updatePackages
                visited: visitedSpecs
                updated: updatedSpecs.
            attributeSet := attributeSet , projectAttributes ].
    attributeSet := attributeSet asSet.
    constructor
        methodSectionsDo: [ :methodSection | 
            | versionSpec attributePath |
            versionSpec := methodSection versionSpec.
            attributePath := methodSection attributePath.
            (methodSection includesAttributeFrom: attributeSet)
                ifFalse: [ 
                    versionSpec updateForSpawnMethod: versionSpec.
                    versionSpec
                        specListProjectDo: [ :spec | spec updateForSpawnMethod: spec ]
                        packageDo: [ :spec | spec updateForSpawnMethod: spec ]
                        groupDo: [ :spec | spec updateForSpawnMethod: spec ].
                    self
                        clearVersionSpec: versionSpec
                        fullVersionSpec: fullVersionSpec
                        updateProjects: updateProjects
                        updatePackages: updatePackages ].
            (aBlock value: attributePath asAttributeOrPath value: versionSpec)
                ifTrue: [ self methodSpec addMethodSection: attributePath versionSpec: versionSpec ] ]! !

!MetacelloToolBox methodsFor: 'api-configuration' stamp: 'dkh 9/13/2012 16:05'!
importFrom: inputVersionStringOrSymbol updateProjects: updateProjects updatePackages: updatePackages versionSpecsDo: aBlock
    ^ self
        importFrom: inputVersionStringOrSymbol
        projectAttributes: project attributes
        inactiveAttributes: #()
        updateProjects: updateProjects
        updatePackages: updatePackages
        versionSpecsDo: aBlock! !

!MetacelloToolBox methodsFor: 'api-configuration' stamp: 'dkh 9/8/2012 05:04'!
modifySection: sectionAttributeOrPath repository: repositoryDescription requiredProjects: newProjectList packages: newPackageList dependencies: dependecies includes: includes files: files repositories: repositories preLoadDoIts: preLoadDoIts postLoadDoIts: postLoadDoIts supplyingAnswers: supplyingAnswers groups: newGroups versionSpecsDo: aBlock
    "
		repositoryDescription - metacello repository string
		newProjectList - collection of project base names (without ConfigurationOf prefix)
		newPackageList - collection of package base names
		dependencies - collection of associations where key is name of package and value is collection of required packages and projects
		includes - collection of associations where key is name of package and value is collection of included packages and projects
		files - collection of associations where key is name of package and value is name of file
		repositories - collection of associations where key is name of package and value is collection of repository descriptions
		preLoadDoIts - collection of associations where key is name of package and value is preload doit selector
		postLoadDoIts - collection of associations where key is name of package and value is postload doit selector
		supplyingAnswers - collection of associations where key is name of package and value is the supplyingAnswers array
		newGroups - collection of associations where key is the name of the group and value is the collection of group members
	"

    self
        modifySection: sectionAttributeOrPath
        sectionIndex: 1
        repository: repositoryDescription
        requiredProjects: newProjectList
        packages: newPackageList
        dependencies: dependecies
        includes: includes
        files: files
        repositories: repositories
        preLoadDoIts: preLoadDoIts
        postLoadDoIts: postLoadDoIts
        supplyingAnswers: supplyingAnswers
        groups: newGroups
        versionSpecsDo: aBlock! !

!MetacelloToolBox methodsFor: 'api-configuration' stamp: 'dkh 3/7/2012 17:08:50'!
modifyVersionMethodForVersion: inputVersionStringOrSymbol
	^ self modifyVersionMethodForVersion: inputVersionStringOrSymbol versionSpecsDo: [ :attribute :versionSpec | true ]! !

!MetacelloToolBox methodsFor: 'api-configuration' stamp: 'dkh 3/7/2012 17:08:50'!
modifyVersionMethodForVersion: inputVersionStringOrSymbol versionSpecsDo: aBlock
	^ self
		updateVersionMethodForVersion: inputVersionStringOrSymbol
		updateProjects: false
		updatePackages: false
		versionSpecsDo: aBlock! !

!MetacelloToolBox methodsFor: 'accessing' stamp: 'dkh 3/7/2012 17:08:50'!
project: aMetacelloProject

	project := aMetacelloProject! !

!MetacelloToolBox methodsFor: 'spec creation' stamp: 'dkh 3/7/2012 17:08:50'!
createVersionSpec: versionString
	| versionSpec |
	versionSpec := project versionSpec.
	versionSpec versionString: versionString.
	^ versionSpec! !

!MetacelloToolBox methodsFor: 'api-configuration' stamp: 'dkh 3/7/2012 17:08:50'!
addSection: sectionAttributeOrPath repository: repositoryDescription requiredProjects: projectList packages: packageList repositories: repositories dependencies: dependecies groups: groups versionSpecsDo: aBlock
    "
		repositoryDescription - metacello repository string
		projectList - collection of project base names (without ConfigurationOf prefix)
		packageList - collection of package base names
		repositories - collection of associations where key is name of package and value is collection of repository descriptions
		dependencies - collection of associations where key is name of package and value is collection of required packages and projects
		groups - collection of associations where key is the name of the group and value is the collection of group members
	"

    self
        addSection: sectionAttributeOrPath
        repository: repositoryDescription
        requiredProjects: projectList
        packages: packageList
        dependencies: dependecies
        includes: #()
        files: #()
        repositories: repositories
        preLoadDoIts: #()
        postLoadDoIts: #()
        supplyingAnswers: #()
        groups: groups
        versionSpecsDo: aBlock! !

!MetacelloToolBox methodsFor: 'accessing' stamp: 'dkh 3/7/2012 17:08:50'!
constructor

	| constructor |
	constructor := MetacelloToolBoxConstructor new.
	constructor configuration: project configuration class new.
	^constructor! !

!MetacelloToolBox methodsFor: 'api-configuration' stamp: 'dkh 9/8/2012 05:17'!
addSectionsFrom: inputVersionStringOrSymbol forBaseline: forBaseline updateProjects: updateProjects updatePackages: updatePackages versionSpecsDo: aBlock
    | constructor updatedSpecs projectAttributes fullVersionSpec version coll pragma imports visitedSpecs fromVersionString |
    constructor := self constructor.
    updatedSpecs := Set new.
    visitedSpecs := Set new.
    projectAttributes := project attributes.
    version := project version: inputVersionStringOrSymbol.
    fromVersionString := version versionString.
    fullVersionSpec := version spec.
    fullVersionSpec := version spec.
    coll := constructor extractAllVersionPragmas at: fromVersionString ifAbsent: [ ^ nil ].
    coll size > 1
        ifTrue: [ self error: 'More than one pragma defining ' , fromVersionString printString ].
    pragma := coll at: 1.
    imports := pragma numArgs = 2
        ifTrue: [ pragma argumentAt: 2 ]
        ifFalse: [ #() ].
    methodSpec imports: imports.
    constructor extractMethodSectionsFor: fromVersionString.
    constructor methodSections
        do: [ :methodSection | 
            | versionSpec attributeList |
            versionSpec := methodSection versionSpec.
            attributeList := methodSection attributes.
            forBaseline
                ifFalse: [ 
                    (projectAttributes includes: attributeList)
                        ifTrue: [ 
                            self
                                updateVersionSpec: versionSpec
                                fullVersionSpec: fullVersionSpec
                                updateProjects: updateProjects
                                updatePackages: updatePackages
                                visited: visitedSpecs
                                updated: updatedSpecs ] ].
            (aBlock value: methodSection attributeOrPath value: versionSpec)
                ifTrue: [ self methodSpec addMethodSection: methodSection attributePath versionSpec: versionSpec ] ]! !

!MetacelloToolBox methodsFor: 'api-configuration' stamp: 'dkh 3/7/2012 17:08:50'!
commitMethod
	| skipValidation isues |
	skipValidation := false.
	self methodSpec ifNil: [ ^self ].
	self methodSpec compileMethod.
	project := project configuration class project.	"recalculate project"
	[ project version: self methodSpec versionString ]
		on: MetacelloSymbolicVersionDoesNotExistError
		do: [ :ex | 
			"symbolic versions can be removed"
			skipValidation := true ].
	skipValidation
		ifFalse: [ self validateVersion: self methodSpec versionString ].
	methodSpec := nil! !

!MetacelloToolBox methodsFor: 'spec creation' stamp: 'dkh 3/7/2012 17:08:50'!
createPackageSpec: baseName
	^ (project packageSpec)
		name: baseName;
		yourself! !

!MetacelloToolBox methodsFor: 'private' stamp: 'dkh 9/13/2012 16:55'!
updateVersionSpec: versionSpec fullVersionSpec: fullVersionSpec updateProjects: updateProjects updatePackages: updatePackages visited: visitedSpecs updated: updatedSpecs
    versionSpec
        specListProjectDo: [ :spec | 
            (updateProjects and: [ (visitedSpecs includes: spec name) not ])
                ifTrue: [ 
                    | fullProjectSpec |
                    fullProjectSpec := (fullVersionSpec packageNamed: spec name) projectReference.
                    (fullProjectSpec versionString ~~ nil
                        and: [ fullProjectSpec versionString ~~ #'stable' and: [ fullProjectSpec projectClass ~~ nil ] ])
                        ifTrue: [ 
                            | cv |
                            cv := fullProjectSpec projectClassProject currentVersion.
                            cv ~~ nil
                                ifTrue: [ 
                                    cv versionString ~= fullProjectSpec versionString
                                        ifTrue: [ 
                                            spec projectReference versionString: cv versionString.
                                            updatedSpecs add: spec name ] ]
                                ifFalse: [ 
                                    "set to an empty string as a place holder, since we know we should have a version, but we are unable to figure out the version"
                                    spec projectReference versionString: ''.
                                    updatedSpecs add: spec name ] ] ] ]
        packageDo: [ :spec | 
            (updatePackages and: [ (visitedSpecs includes: spec name) not ])
                ifTrue: [ 
                    spec getFile ~~ nil
                        ifTrue: [ 
                            | viName |
                            spec file = ''
                                ifTrue: [ spec file: spec name ].
                            (viName := spec workingCopyNameFor: spec loader) ~~ nil
                                ifTrue: [ 
                                    viName ~= spec file
                                        ifTrue: [ 
                                            spec file: viName.
                                            updatedSpecs add: spec name ].
                                    visitedSpecs add: spec name ] ] ] ]
        groupDo: [ :ignored |  ]! !

!MetacelloToolBox methodsFor: '*Versionner-Core-DependenciesModel' stamp: 'ChristopheDemarey 2/21/2014 16:01'!
addSection: sectionAttributeOrPath repository: repositoryDescription requiredProjects: projectList packages: packageList dependencies: dependecies includes: includes files: files repositories: repositories preLoadDoIts: preLoadDoIts postLoadDoIts: postLoadDoIts supplyingAnswers: supplyingAnswers groups: groups versionSpecsDo: aBlock requiredProjectSpecs: requiredProjectSpecs
    "
		repositoryDescription - metacello repository string
		projectList - collection of project base names (without ConfigurationOf prefix)
		packageList - collection of package base names
		dependencies - collection of associations where key is name of package and value is collection of required packages and projects
		includes - collection of associations where key is name of package and value is collection of included packages and projects
		files - collection of associations where key is name of package and value is name of file
		repositories - collection of associations where key is name of package and value is collection of repository descriptions
		preLoadDoIts - collection of associations where key is name of package and value is preload doit selector
		postLoadDoIts - collection of associations where key is name of package and value is postload doit selector
		supplyingAnswers - collection of associations where key is name of package and value is the supplyingAnswers array
		groups - collection of associations where key is the name of the group and value is the collection of group members
		requiredProjectSpecs - collection of already computed required project specs.

	"

    | versionSpec dependencyMap includesMap filesMap repositoriesMap preLoadDoItsMap postLoadDoItsMap supplyingAnswersMap |
    versionSpec := self createVersionSpec: self methodSpec versionString.
    repositoryDescription ~~ nil
        ifTrue: [ versionSpec repository: repositoryDescription ].
    dependencyMap := self buildMapFrom: dependecies for: packageList.
    includesMap := self buildMapFrom: includes for: packageList.
    filesMap := self buildMapFrom: files for: packageList.
    repositoriesMap := self buildMapFrom: repositories for: packageList , projectList.
    preLoadDoItsMap := self buildMapFrom: preLoadDoIts for: packageList.
    postLoadDoItsMap := self buildMapFrom: postLoadDoIts for: packageList.
    supplyingAnswersMap := self buildMapFrom: supplyingAnswers for: packageList.
    requiredProjectSpecs do: [ :projectSpec | versionSpec packages merge: projectSpec ].
    packageList
        do: [ :packageName | 
            | spec |
            spec := self createPackageSpec: packageName.
            dependencyMap at: packageName ifPresent: [ :dependencyList | spec requires: dependencyList ].
            includesMap at: packageName ifPresent: [ :includesList | spec includes: includesList ].
            filesMap at: packageName ifPresent: [ :file | spec file: file ].
            repositoriesMap
                at: packageName
                ifPresent: [ :repositoriesList | repositoriesList do: [ :repoString | spec repository: repoString ] ].
            preLoadDoItsMap at: packageName ifPresent: [ :preLoad | spec preLoadDoIt: preLoad ].
            postLoadDoItsMap at: packageName ifPresent: [ :postLoad | spec postLoadDoIt: postLoad ].
            supplyingAnswersMap at: packageName ifPresent: [ :answer | spec answers: answer ].
            versionSpec packages merge: spec ].
    groups
        do: [ :assoc | 
            | spec |
            spec := self createGroupSpec: assoc key.
            spec includes: assoc value.
            versionSpec packages merge: spec ].
    aBlock value: versionSpec.
    self methodSpec addMethodSection: sectionAttributeOrPath asMetacelloAttributePath versionSpec: versionSpec! !

!MetacelloToolBox methodsFor: 'accessing' stamp: 'dkh 3/7/2012 17:08:50'!
methodSpec

	^methodSpec! !

!MetacelloToolBox methodsFor: 'api-configuration' stamp: 'dkh 9/9/2012 07:36'!
modifySymbolicVersionMethodFor: versionSymbol symbolicVersionSpecsDo: aBlock
    | constructor coll pragma |
    constructor := self constructor.
    coll := constructor extractSymbolicVersionPragmas at: versionSymbol ifAbsent: [ ^ nil ].
    coll size > 1
        ifTrue: [ self error: 'More than one pragma defining ' , versionSymbol printString ].
    pragma := coll at: 1.
    methodSpec := MetacelloSymbolicVersionMethodSpec new
        project: project;
        selector: pragma selector;
        category: (project configuration class whichCategoryIncludesSelector: pragma selector);
        versionString: versionSymbol;
        yourself.
    (constructor extractSymbolicVersionSpecsFor: versionSymbol)
        do: [ :symbolicVersionSpec | 
            (aBlock value: symbolicVersionSpec)
                ifTrue: [ self methodSpec addMethodSection: symbolicVersionSpec attributes versionString: symbolicVersionSpec versionString ] ]! !

!MetacelloToolBox methodsFor: 'spec creation' stamp: 'dkh 3/7/2012 17:08:50'!
createVersion: versionString
	| version  |
	[ version := project version: versionString ]
		on: MetacelloVersionDoesNotExistError
		do: [ :ex | 
			| versionSpec |
			versionSpec := self createVersionSpec: versionString.
			version := versionSpec createVersion.
			project map == nil
				ifTrue: [ project map: Dictionary new ].
			project map at: versionString put: version ].
	^version! !

!MetacelloToolBox methodsFor: 'api-configuration' stamp: 'dkh 3/7/2012 17:08:50'!
commitConfiguration: commitComment! !

!MetacelloToolBox methodsFor: 'api-configuration' stamp: 'dkh 3/7/2012 17:08:50'!
createSymbolicVersionMethod: selector inCategory: category forVersion: versionSymbol
	| constructor |
	methodSpec := (MetacelloSymbolicVersionMethodSpec new)
		project: project;
		selector: selector;
		category: category;
		versionString: versionSymbol;
		yourself.
	constructor := self constructor.
	self methodSpec methodSections: (constructor extractSymbolicVersionSpecsFor: versionSymbol) asOrderedCollection.
! !

!MetacelloToolBox methodsFor: 'private' stamp: 'dkh 3/7/2012 17:08:50'!
configurationNameFrom: baseName	
	^self class configurationNameFrom: baseName! !

!MetacelloToolBox class methodsFor: 'tool support' stamp: 'dkh 3/7/2012 17:08:50'!
compiledMethodForVersion: aMetacelloVersion

	| toolbox pragma |
	toolbox := MetacelloToolBox new project: aMetacelloVersion project.
	pragma := (toolbox constructor extractAllVersionPragmas at: aMetacelloVersion versionString ifAbsent: [ ^ nil ]) first.
	^pragma method! !

!MetacelloToolBox class methodsFor: 'scripts' stamp: 'dkh 3/7/2012 17:08:50'!
createDevelopment: developmentVersionString for: configurationBasename from: existingDevelopmentVersionString imports: imports description: aString
	"Create a new development version based on the specifications in an existing version, but override the imports for the new version. Modify the #development symbolic version to reference the new version."

	<apiDocumentation>
	| toolbox |
	toolbox := self
		createVersion: developmentVersionString
		for: configurationBasename
		from: existingDevelopmentVersionString
		description: aString.
	toolbox
		modifyVersionMethodForVersion: developmentVersionString;
		imports: imports;
		commitMethod.
	^ toolbox! !

!MetacelloToolBox class methodsFor: 'private' stamp: 'dkh 3/7/2012 17:08:50'!
appendDescription: aString to: versionSpec
	aString isEmpty
		ifTrue: [ ^ self ].
	^ versionSpec description value isEmpty
		ifTrue: [ versionSpec description: aString ]
		ifFalse: [ 
			| strm |
			strm := WriteStream on: String new.
			strm
				nextPutAll: versionSpec description value;
				cr;
				nextPutAll: aString.
			versionSpec description: strm contents ]! !

!MetacelloToolBox class methodsFor: 'utility' stamp: 'dkh 3/7/2012 17:08:50'!
platformAttributes
	"Answer the list of platform attributes for the current platform"
	<apiDocumentation>
	^MetacelloPlatform current defaultPlatformAttributes! !

!MetacelloToolBox class methodsFor: 'scripts' stamp: 'dkh 3/7/2012 17:08:50'!
createBaseline: baselineVersionString for: configurationBasename from: existingBaselineVersionString description: aString
	"Create a new baseline version based on the specification in an existing baseline"

	<apiDocumentation>
	^ self
		createBaseline: baselineVersionString
		for: configurationBasename
		from: existingBaselineVersionString
		description: aString
		versionSpecsDo: [ :attribute :versionSpec | true ]! !

!MetacelloToolBox class methodsFor: 'scripts' stamp: 'dkh 3/7/2012 17:08:50'!
updateDevelopment: developmentVersionString for: configurationBasename updateProjects: updateProjects description: message
	"Update packageSpecs and (conditionally) the project specs in the given version to reflect the new mcz file and project versions."

	<apiDocumentation>
	| toolbox updatedSpecs |
	toolbox := self configurationNamed: configurationBasename.
	updatedSpecs := toolbox
		updateVersionMethodForVersion: developmentVersionString
		updateProjects: updateProjects
		updatePackages: true
		versionSpecsDo: [ :attribute :versionSpec | 
			attribute == #common
				ifTrue: [ 
					"update the author, description and timeStamp"
					versionSpec
						author: MetacelloPlatform current authorName;
						timestamp: MetacelloPlatform current timestamp.
					self appendDescription: message to: versionSpec ].
			true ].
	updatedSpecs notEmpty
		ifTrue: [ toolbox commitMethod ].
	^ updatedSpecs! !

!MetacelloToolBox class methodsFor: 'scripts' stamp: 'dkh 3/7/2012 17:08:50'!
createBaseline: baselineVersionString for: configurationBasename from: existingBaselineVersionString description: aString versionSpecsDo: versionSpecBlock
	"Create a new baseline version based on the specification in an existing baseline. Evaluate <versionSpecBlock> for each section."

	<apiDocumentation>
	| toolbox |
	(toolbox := self configurationNamed: configurationBasename)
		createVersionMethod: 'baseline' , (self stripVersionStringForSelector: baselineVersionString) , ':'
			inCategory: 'baselines'
			forVersion: baselineVersionString;
		addSectionsFrom: existingBaselineVersionString
			forBaseline: true
			updateProjects: false
			updatePackages: false
			versionSpecsDo: [ :attribute :versionSpec | 
				attribute == #common
					ifTrue: [ 
						aString notEmpty
							ifTrue: [ versionSpec description: aString ] ].
				versionSpecBlock value: attribute value: versionSpec ];
		commitMethod.
	^ toolbox! !

!MetacelloToolBox class methodsFor: 'load validation' stamp: 'dkh 3/7/2012 17:08:50'!
validatePlatformLoad: platformAttribute for: configurationBasename
	"Validate, Load, and run tests for all versions of the given configuration. Return list of issues."

	<apiDocumentation>
	| issues configurationClass toolbox cleanDevelopmentLoads cleanLoadAndTests stableVersion |
	configurationClass := Smalltalk at: (self configurationNameFrom: configurationBasename) asSymbol.
	cleanDevelopmentLoads := OrderedCollection new.
	cleanLoadAndTests := OrderedCollection new.
	issues := [ MetacelloMCVersionValidator validateConfigurationLoad: configurationClass ]
		on: MetacelloCleanNotification
		do: [ :ex | 
			(ex isKindOf: MetacelloCleanLoadAndTestsNotification)
				ifTrue: [ cleanLoadAndTests add: ex version ].
			((ex isKindOf: MetacelloCleanLoadNotification) and: [ ex version blessing == #development ])
				ifTrue: [ cleanDevelopmentLoads add: ex version ].
			ex resume ].
	(cleanDevelopmentLoads isEmpty and: [ cleanLoadAndTests isEmpty ])
		ifTrue: [ 
			self inform: 'Failed validation with no versions load clean'.
			^ issues ].
	toolbox := self configurationNamed: configurationBasename.
	cleanLoadAndTests notEmpty
		ifTrue: [ 
			toolbox
				symbolicVersionMethod: #stable;
				addSymbolicSection: platformAttribute version: (stableVersion := cleanLoadAndTests last) versionString;
				commitMethod ].
	stableVersion notNil
		ifTrue: [ 
			stableVersion blessing == #development
				ifTrue: [ 
					issues
						add:
							(MetacelloValidationWarning
								configurationClass: configurationClass
								reasonCode: #stableDevelopmentVersion
								callSite: #validatePlatformLoad:for:
								explanation:
									'Development version ' , stableVersion versionString printString , ' is marked as #stableVersion for '
										, configurationClass name asString) ].
			cleanDevelopmentLoads := cleanDevelopmentLoads select: [ :version | version > stableVersion ] ].
	cleanDevelopmentLoads notEmpty
		ifTrue: [ 
			toolbox
				symbolicVersionMethod: #development;
				addSymbolicSection: platformAttribute version: cleanDevelopmentLoads last versionString;
				commitMethod ]
		ifFalse: [ 
			toolbox
				symbolicVersionMethod: #development;
				addSymbolicSection: platformAttribute version: #notDefined;
				commitMethod ].
	^ issues! !

!MetacelloToolBox class methodsFor: 'utility' stamp: 'dkh 05/15/2013 20:36'!
baselineNameFrom: baseName
  "Return the fully-qualified baseline class name."

  <apiDocumentation>
  ^ MetacelloScriptEngine baselineNameFrom: baseName! !

!MetacelloToolBox class methodsFor: 'scripts' stamp: 'dkh 3/7/2012 17:08:50'!
compareVersion: fromVersionString for: configurationBasename to: toVersionString
	"Return a MetacelloMCVersionDiffReport that whose fields 
		#additions
		#removals
		#modifications
	   refer to a dictionary whose keys are package names and whose 
	   values are a 2 element array. The first element is the mcz file 
	   name for the first version and the second element is the mcz file 
	   name for second version.
	There are also fields for the name of the configuration (#configuration), 
	the #from version string and the #to version string.
	
	The printString of the version report should provide all of the necessary info for 
	a developer."

	<apiDocumentation>
	| toolbox report |
	toolbox := self configurationNamed: configurationBasename.
	report := (toolbox project version: fromVersionString) difference: (toolbox project version: toVersionString).
	report 
		from: fromVersionString;
		to: toVersionString;
		configuration: configurationBasename.
	^ report! !

!MetacelloToolBox class methodsFor: 'validation' stamp: 'dkh 3/7/2012 17:08:50'!
validateProject: aMetacelloProject version: versionString debug: debugList recurse: aBool
	"Check a specific version in the configuration for Errors, Critical Warnings, and Warnings (see class comment for MetacelloMCVersionValidator for more information). "

	<apiDocumentation>
	^ MetacelloMCVersionValidator
		validateProject: aMetacelloProject
		version: versionString
		debug: debugList
		recurse: aBool! !

!MetacelloToolBox class methodsFor: 'utility' stamp: 'dkh 07/18/2013 07:42'!
baseNameOf: configurationClassName
  "Return the baseName for the given configuration class name."

  <apiDocumentation>
  ^ (configurationClassName beginsWith: 'ConfigurationOf')
    ifTrue: [ 
      configurationClassName
        copyFrom: 'ConfigurationOf' size + 1
        to: configurationClassName size ]
    ifFalse: [ configurationClassName ]! !

!MetacelloToolBox class methodsFor: 'deprecated' stamp: 'dkh 3/7/2012 17:08:50'!
createBaseline: baselineVersionString for: configurationBasename repository: repositoryDescription requiredProjects: projectList packages: packageList dependencies: dependencies groups: groups
    "Create a new baseline version based on the specified project structure.
		repositoryDescription - metacello repository string
		projectList - collection of project base names (without ConfigurationOf prefix)
		packageList - collection of package base names
		dependencies - collection of associations where key is name of package and value is collection of required packages and projects
		groups - collection of associations where key is the name of the group and value is the collection of group members
	"

    <apiDocumentation>
    self
        deprecated:
            'Use createBaseline:for: repository:requiredProjects:packages:repositories:dependencies:groups: instead'.
    ^ self
        createBaseline: baselineVersionString
        for: configurationBasename
        repository: repositoryDescription
        requiredProjects: projectList
        packages: packageList
        repositories: #()
        dependencies: dependencies
        groups: groups! !

!MetacelloToolBox class methodsFor: 'help' stamp: 'dkh 3/7/2012 17:08:50'!
helpTopicFor: aConfigurationClass
	| topic pages page helpTopicClass |
	(helpTopicClass := self helpTopicClass) ifNil: [^self error: 'Help system not installed'].
	topic := helpTopicClass named: (self baseNameOfConfiguration: aConfigurationClass).
	pages := (aConfigurationClass respondsTo: #helpPages)
		ifTrue: [ aConfigurationClass perform: #helpPages ]
		ifFalse: [ #(#helpIntro #helpInstallation #helpGettingStarted) ].
	pages
		do: [ :pageSelectorOrClass | 
			page := (Smalltalk hasClassNamed: pageSelectorOrClass asString)
				ifTrue: [ (Smalltalk classNamed: pageSelectorOrClass asString) perform: #asHelpTopic ]
				ifFalse: [ 
					[ aConfigurationClass perform: pageSelectorOrClass ]
						on: MessageNotUnderstood
						do: [ :ex | self defaultTopic: pageSelectorOrClass for: aConfigurationClass ] ].
			topic perform: #addSubtopic: with: page ].
	^ topic! !

!MetacelloToolBox class methodsFor: 'development support' stamp: 'dkh 3/7/2012 17:08:50'!
releaseDevelopmentVersionIn: aConfigurationClass description: commitMessage
	"Release #development version: set version blessing to #release, update the #development and #stable symbolic version methods and save the configuration."

	<apiDocumentation>
	| version |
	version := aConfigurationClass project version: #development.
	self
		releaseVersion: version versionString for: aConfigurationClass name asString;
		saveConfigurationPackageFor: aConfigurationClass name asString description: commitMessage! !

!MetacelloToolBox class methodsFor: 'development support' stamp: 'dkh 3/7/2012 17:08:50'!
createNewBaselineVersionIn: aConfigurationClass description: creationMessage versionSpecsDo: versionSpecBlock
	"Create a new baseline version based upon #stable version's baseline. Evaluate <versionSpecBlock> for each section.
	 A new baseline should be created if new packages or projects have been added or package dependencies have changed."

	<apiDocumentation>
	| currentVersion existingBaselineVersionString baselineVersionNumber |
	currentVersion := aConfigurationClass project version: #stable.
	existingBaselineVersionString := currentVersion importedVersions first.
	baselineVersionNumber := existingBaselineVersionString asMetacelloVersionNumber incrementMinorVersionNumber.
	self
		createBaseline: baselineVersionNumber versionString
		for: aConfigurationClass name asString
		from: existingBaselineVersionString
		description: creationMessage
		versionSpecsDo: versionSpecBlock! !

!MetacelloToolBox class methodsFor: 'scripts' stamp: 'dkh 3/7/2012 17:08:50'!
updateDevelopment: developmentVersionString for: configurationBasename updatePackages: updatePackages description: message
	"Update project specs and (conditionally) the package specs in the given version to reflect the new mcz file and project versions."

	<apiDocumentation>
	| toolbox updatedSpecs |
	toolbox := self configurationNamed: configurationBasename.
	updatedSpecs := toolbox
		updateVersionMethodForVersion: developmentVersionString
		updateProjects: true
		updatePackages: updatePackages
		versionSpecsDo: [ :attribute :versionSpec | 
			attribute == #common
				ifTrue: [ 
					"update the author, description and timeStamp"
					versionSpec
						author: MetacelloPlatform current authorName;
						timestamp: MetacelloPlatform current timestamp.
					self appendDescription: message to: versionSpec ].
			true ].
	updatedSpecs notEmpty
		ifTrue: [ toolbox commitMethod ].
	^ updatedSpecs! !

!MetacelloToolBox class methodsFor: 'help' stamp: 'dkh 3/7/2012 17:08:50'!
defaultTopic: pageSelector for: aConfigurationClass
	| topic stream helpTopicClass |
	(helpTopicClass := self helpTopicClass) ifNil: [^self error: 'Help system not installed'].
	stream := WriteStream on: String new.
	pageSelector == #helpInstallation
		ifTrue: [ 
			stream
				nextPutAll: 'To install this configuration, execute the following expression in a workspace:'; cr; tab.
			(aConfigurationClass project hasVersion: #stable)
				ifTrue: [ stream nextPutAll: '(', aConfigurationClass name asString, ' project version: #stable) load.' ]
				ifFalse: [ 
					(aConfigurationClass respondsTo: #load)
						ifTrue: [ stream nextPutAll: aConfigurationClass name asString , ' load.' ]
						ifFalse: [ stream nextPutAll: aConfigurationClass name asString, ' project latestVersion load.' ]].
			^ helpTopicClass perform: #title:contents: withArguments: { 'Installing'.  stream contents} ].
	pageSelector == #helpIntro
		ifTrue: [ 
			stream
				nextPutAll: 'I am a Metacello configuration for the ', (MetacelloToolBox baseNameOfConfiguration: aConfigurationClass), ' project.'.
			^ helpTopicClass perform: #title:contents: withArguments: { 'Intro' . stream contents} ].
	pageSelector == #helpGettingStarted
		ifTrue: [ 
			stream
				nextPutAll: 'I guess you''re on your own:).'.
			^ helpTopicClass perform: #title:contents: withArguments: { 'Getting Started' .stream contents} ].
! !

!MetacelloToolBox class methodsFor: 'scripts' stamp: 'dkh 3/7/2012 17:08:50'!
updateDescription: developmentVersionString for: configurationBasename description: message
	"Update description"

	<apiDocumentation>
	^ (self configurationNamed: configurationBasename)
		updateVersionMethodForVersion: developmentVersionString
			updateProjects: false
			updatePackages: false
			versionSpecsDo: [ :attribute :versionSpec | 
				attribute == #common
					ifTrue: [ 
						"update the author, description and timeStamp"
						versionSpec
							author: MetacelloPlatform current authorName;
							timestamp: MetacelloPlatform current timestamp.
						self appendDescription: message to: versionSpec ].
				true ];
		commitMethod! !

!MetacelloToolBox class methodsFor: '*Versionner-Core-DependenciesModel' stamp: 'ChristopheDemarey 2/21/2014 15:58'!
createBaseline: baselineVersionString for: configurationBasename repository: repositoryDescription requiredProjects: projectList packages: packageList repositories: repositories dependencies: dependencies groups: groups requiredProjectSpecs: requiredProjectSpecs
    "Create a new baseline version based on the specified project structure.
		repositoryDescription - metacello repository string
		projectList - collection of project base names (without ConfigurationOf prefix)
		packageList - collection of package base names
		repositories - collection of associations where key is name of package and value is collection of repository descriptions
		dependencies - collection of associations where key is name of package and value is collection of required packages and projects
		groups - collection of associations where key is the name of the group and value is the collection of group members
		loads - collection of associations where key is name of a project and value is collection of packages/groups to load.
	"

    <apiDocumentation>
    | toolbox |
    (toolbox := self configurationNamed: configurationBasename)
        createVersionMethod: 'baseline' , (self stripVersionStringForSelector: baselineVersionString) , ':'
            inCategory: 'baselines'
            forVersion: baselineVersionString;
        addSection: #'common'
            repository: repositoryDescription
            requiredProjects: projectList
            packages: packageList
	      dependencies: dependencies
            includes: #()
            files: #()
            repositories: repositories
            preLoadDoIts: #()
            postLoadDoIts: #()
            supplyingAnswers: #()
            groups: groups
		versionSpecsDo: [ :versionSpec | versionSpec blessing: #'baseline' ]
		requiredProjectSpecs: requiredProjectSpecs;
	 commitMethod.
    ^ toolbox! !

!MetacelloToolBox class methodsFor: 'utility' stamp: 'dkh 3/7/2012 17:08:50'!
baseNameOfConfiguration: aConfigurationClass
	"Return the baseName for the given configuration class."

	<apiDocumentation>
	^self baseNameOf: aConfigurationClass name asString! !

!MetacelloToolBox class methodsFor: 'load validation' stamp: 'dkh 3/7/2012 17:08:50'!
validatePlatformLoad: platformAttribute for: configurationBasename version: versionString
	"Load, and run tests for the given version of the configuration. Mark as #stable, if load and tests are clean. Return list of issues."

	<apiDocumentation>
	| issues configurationClass toolbox cleanLoadAndTests stableVersion |
	configurationClass := Smalltalk at: (self configurationNameFrom: configurationBasename) asSymbol.
	cleanLoadAndTests := OrderedCollection new.
	issues := [ MetacelloMCVersionValidator validateConfigurationLoad: configurationClass version: versionString ]
		on: MetacelloCleanNotification
		do: [ :ex | 
			(ex isKindOf: MetacelloCleanLoadAndTestsNotification)
				ifTrue: [ cleanLoadAndTests add: ex version ].
			ex resume ].
	toolbox := self configurationNamed: configurationBasename.
	cleanLoadAndTests isEmpty
		ifTrue: [ ^issues ].
	stableVersion := cleanLoadAndTests last.
	toolbox
		symbolicVersionMethod: #stable;
		addSymbolicSection: platformAttribute version: stableVersion versionString;
		commitMethod.
	stableVersion blessing == #development
		ifTrue: [ 
			issues
				add:
					(MetacelloValidationWarning
						configurationClass: configurationClass
						reasonCode: #stableDevelopmentVersion
						callSite: #validatePlatformLoad:for:version:
						explanation:
							'Development version ' , stableVersion versionString printString , ' is marked as #stableVersion for '
								, configurationClass name asString) ].
	^ issues! !

!MetacelloToolBox class methodsFor: 'utility' stamp: 'dkh 3/7/2012 17:08:50'!
checkForCriticalValidationIssues: configurationBasename
	"Validate the named configuration and filter out all non-critical issues."
	<apiDocumentation>
	^ (MetacelloMCVersionValidator
		validateConfiguration: (Smalltalk at: (self configurationNameFrom: configurationBasename) asSymbol))
		select: [ :issue | issue isCritical ]! !

!MetacelloToolBox class methodsFor: 'private' stamp: 'dkh 3/7/2012 17:08:50'!
stripVersionStringForSelector: versionString

	^((versionString copyWithout: $.) copyWithout: $-) 
		copyReplaceAll: 'baseline' with: '' 
! !

!MetacelloToolBox class methodsFor: 'validation' stamp: 'dkh 3/7/2012 17:08:50'!
validateConfiguration: configurationClass debug: debugList recurse: aBool
	"Check the configuration for Errors, Critical Warnings, and Warnings (see class comment for MetacelloMCVersionValidator for more information). "

	<apiDocumentation>
	^ MetacelloMCVersionValidator validateConfiguration: configurationClass debug: debugList recurse: aBool! !

!MetacelloToolBox class methodsFor: 'utility' stamp: 'dkh 6/13/2012 13:07'!
configurationClasses
    "Return a set of the Metacello configuration classes that have been loaded into the image."

    <apiDocumentation>
    ^ MetacelloProjectRegistration configurationClasses! !

!MetacelloToolBox class methodsFor: 'scripts' stamp: 'dkh 9/7/2012 13:34'!
modifyVersion: sourceVersionString section: sectionAttributeOrPath for: configurationBasename repository: repositoryDescription requiredProjects: projectList packages: packageList dependencies: dependencies includes: includes files: files repositories: repositories preLoadDoIts: preLoadDoIts postLoadDoIts: postLoadDoIts supplyingAnswers: supplyingAnswers groups: groups
	"Modify a new version based on the specified project structure.
		repositoryDescription - metacello repository string
		projectList - collection of project base names (without ConfigurationOf prefix)
		packageList - collection of package base names
		dependencies - collection of associations where key is name of package and value is collection of required packages and projects
		includes - collection of associations where key is name of package and value is collection of included packages and projects
		files - collection of associations where key is name of package and value is name of file
		repositories - collection of associations where key is name of package and value is collection of repository descriptions
		preLoadDoIts - collection of associations where key is name of package and value is preload doit selector
		postLoadDoIts - collection of associations where key is name of package and value is postload doit selector
		supplyingAnswers - collection of associations where key is name of package and value is the supplyingAnswers array
		groups - collection of associations where key is the name of the group and value is the collection of group members
	"

	<apiDocumentation>
	| toolbox |
	(toolbox := self configurationNamed: configurationBasename)
		modifyVersionMethodForVersion: sourceVersionString versionSpecsDo: [:attribute :versionSpec | true ];
		modifySection: sectionAttributeOrPath asMetacelloAttributePath
			repository: repositoryDescription
			requiredProjects: projectList
			packages: packageList
			dependencies: dependencies
			includes: includes
			files: files
			repositories: repositories
			preLoadDoIts: preLoadDoIts
			postLoadDoIts: postLoadDoIts
			supplyingAnswers: supplyingAnswers
			groups: groups
			versionSpecsDo: [ :versionSpec | true ];
		commitMethod.
	^ toolbox! !

!MetacelloToolBox class methodsFor: 'scripts' stamp: 'dkh 3/7/2012 17:08:50'!
modifyVersion: sourceVersionString for: configurationBasename projectDo: projectBlock packageDo: packageBlock groupDo: groupBlock
	"Modify the project, package and/or group specifications for the given version"

	<apiDocumentation>
	self
		modifyVersion: sourceVersionString
		for: configurationBasename
		versionSpecsDo: [ :attribute :versionSpec | 
			versionSpec
				specListProjectDo: [ :spec | projectBlock value: attribute value: versionSpec value: spec ]
				packageDo: [ :spec | packageBlock value: attribute value: versionSpec value: spec ]
				groupDo: [ :spec | groupBlock value: attribute value: versionSpec value: spec ].
			true ]! !

!MetacelloToolBox class methodsFor: 'development support' stamp: 'dkh 3/7/2012 17:08:50'!
createNewDevelopmentVersionIn: aConfigurationClass description: creationMessage
	"Create a new development version using the #stable version as model."

	<apiDocumentation>
	| currentVersion developmentVersion |
	currentVersion := aConfigurationClass project version: #stable.
	developmentVersion := currentVersion versionNumber copy incrementMinorVersionNumber.
	self
		createDevelopment: developmentVersion versionString
		for: aConfigurationClass name asString
		from: currentVersion versionString
		imports: currentVersion importedVersions
		description: creationMessage! !

!MetacelloToolBox class methodsFor: 'instance creation' stamp: 'dkh 05/15/2013 20:15'!
baselineNamed: baseName
  ^ self new
    baselineNamed: baseName;
    yourself! !

!MetacelloToolBox class methodsFor: 'scripts' stamp: 'dkh 3/7/2012 17:08:50'!
releaseEarlyAccessVersion: earlyAccessVersionString for: configurationBasename from: developmentVersionString
	"Update the #development and #earlyAccess symbolic versions."

	<apiDocumentation>
	| toolbox message previousEarlyAccessVersion previousEarlyAccessSeparator index earlyAccessDescription |
	self flag: 'Make this more general purpose'.
	toolbox := self configurationNamed: configurationBasename.
	message := (toolbox project version: developmentVersionString) description.
	previousEarlyAccessVersion := (MetacelloVersionNumber fromString: earlyAccessVersionString) decrementMinorVersionNumber
		asString.
	previousEarlyAccessSeparator := '---' , previousEarlyAccessVersion , '---'.
	(index := message indexOfSubCollection: previousEarlyAccessSeparator) > 0
		ifTrue: [ 
			index + previousEarlyAccessSeparator size + 1 <= message size
				ifTrue: [ earlyAccessDescription := message copyFrom: index + previousEarlyAccessSeparator size + 1 to: message size ] ].
	toolbox
		createVersionMethod: 'version' , (self stripVersionStringForSelector: earlyAccessVersionString) , ':'
			inCategory: 'versions'
			forVersion: earlyAccessVersionString;
		addSectionsFrom: developmentVersionString
			forBaseline: false
			updateProjects: true
			updatePackages: true
			versionSpecsDo: [ :attribute :versionSpec | 
				attribute == #common
					ifTrue: [ 
						"update the author, blessing, description and timeStamp"
						versionSpec
							author: MetacelloPlatform current authorName;
							description: earlyAccessDescription;
							blessing: #development;
							timestamp: MetacelloPlatform current timestamp ].
				true ];
		commitMethod.
	toolbox
		symbolicVersionMethod: #earlyAccess;
		addSymbolicSection: #common version: earlyAccessVersionString;
		commitMethod.
	toolbox
		modifyVersionMethodForVersion: developmentVersionString
			versionSpecsDo: [ :attribute :versionSpec | 
					attribute == #common
						ifTrue: [ 
							"update the author, description and timeStamp"
							versionSpec
								author: MetacelloPlatform current authorName;
								timestamp: MetacelloPlatform current timestamp.
							self appendDescription: '---' , earlyAccessVersionString , '---' to: versionSpec ].
					true ];
		commitMethod.
	^ toolbox! !

!MetacelloToolBox class methodsFor: 'scripts' stamp: 'ChristopheDemarey 3/18/2014 16:31'!
createDevelopment: developmentVersionString for: configurationBasename importFromBaseline: baselineVersionString description: aString
	"Create a new development version based on the specifications in an existing baseline version. Modify the #development symbolic version to reference the new version."

	<apiDocumentation>
	| toolbox |
	(toolbox := self configurationNamed: configurationBasename)
		createVersionMethod: 'version' , (self stripVersionStringForSelector: developmentVersionString) , ':'
			inCategory: 'versions'
			forVersion: developmentVersionString;
		importFrom: baselineVersionString
			updateProjects: false
			updatePackages: true
			versionSpecsDo: [ :attribute :versionSpec | 
				attribute == #common
					ifTrue: [ 
						"update the author, blessing, description and timeStamp"
						versionSpec
							author: MetacelloPlatform current authorName;
							blessing: #development;
							description: aString;
							timestamp: MetacelloPlatform current timestamp ].
				true ];
		commitMethod.
	toolbox
		symbolicVersionMethod: #development;
		addSymbolicSection: #common version: developmentVersionString;
		commitMethod.
	^ toolbox! !

!MetacelloToolBox class methodsFor: 'scripts' stamp: 'dkh 3/7/2012 17:08:50'!
createBaseline: baselineVersionString for: configurationBasename repository: repositoryDescription requiredProjects: projectList packages: packageList dependencies: dependencies includes: includes files: files repositories: repositories preLoadDoIts: preLoadDoIts postLoadDoIts: postLoadDoIts supplyingAnswers: supplyingAnswers groups: groups
	"Create a new baseline version based on the specified project structure.
		repositoryDescription - metacello repository string
		projectList - collection of project base names (without ConfigurationOf prefix)
		packageList - collection of package base names
		dependencies - collection of associations where key is name of package and value is collection of required packages and projects
		includes - collection of associations where key is name of package and value is collection of included packages and projects
		files - collection of associations where key is name of package and value is name of file
		repositories - collection of associations where key is name of package and value is collection of repository descriptions
		preLoadDoIts - collection of associations where key is name of package and value is preload doit selector
		postLoadDoIts - collection of associations where key is name of package and value is postload doit selector
		supplyingAnswers - collection of associations where key is name of package and value is the supplyingAnswers array
		groups - collection of associations where key is the name of the group and value is the collection of group members
	"

	<apiDocumentation>
	| toolbox |
	(toolbox := self configurationNamed: configurationBasename)
		createVersionMethod: 'baseline' , (self stripVersionStringForSelector: baselineVersionString) , ':'
			inCategory: 'baselines'
			forVersion: baselineVersionString;
		addSection: #common
			repository: repositoryDescription
			requiredProjects: projectList
			packages: packageList
			dependencies: dependencies
			includes: includes
			files: files
			repositories: repositories
			preLoadDoIts: preLoadDoIts
			postLoadDoIts: postLoadDoIts
			supplyingAnswers: supplyingAnswers
			groups: groups
			versionSpecsDo: [ :versionSpec | versionSpec blessing: #baseline ];
		commitMethod.
	^ toolbox! !

!MetacelloToolBox class methodsFor: 'development support' stamp: 'dkh 3/7/2012 17:08:50'!
createNewBaselineVersionIn: aConfigurationClass description: creationMessage
	"Create a new baseline version based upon #stable version's baseline.
	 A new baseline should be created if new packages or projects have been added or package dependencies have changed."

	<apiDocumentation>
	| currentVersion existingBaselineVersionString baselineVersionNumber |
	currentVersion := aConfigurationClass project version: #stable.
	existingBaselineVersionString := currentVersion importedVersions first.
	baselineVersionNumber := existingBaselineVersionString asMetacelloVersionNumber incrementMinorVersionNumber.
	self
		createBaseline: baselineVersionNumber versionString
		for: aConfigurationClass name asString
		from: existingBaselineVersionString
		description: creationMessage! !

!MetacelloToolBox class methodsFor: 'validation' stamp: 'dkh 3/7/2012 17:08:50'!
descriptionForValidationReasonCode: reasonCode
	"Description of validation reasonCode"

	<apiDocumentation>
	^MetacelloMCVersionValidator descriptionForReasonCode: reasonCode! !

!MetacelloToolBox class methodsFor: 'scripts' stamp: 'dkh 3/7/2012 17:08:50'!
saveModifiedDevelopmentPackages: developmentVersionString for: configurationBasename description: commitMessage
	"Save modified mcz files associated with the project. Then update given version to reflect the new mcz file versions."

	<apiDocumentation>
	| toolbox modifiedPackages cacheRepository |
	modifiedPackages := Dictionary new.
	(toolbox := self configurationNamed: configurationBasename)
		modifiedPackageSpecs: developmentVersionString
		packageSpecsDo: [ :versionSpec :packageSpec :monticelloWorkingCopy | 
			| repositories repositoryGroup wcRepositoryGroup |
			wcRepositoryGroup := monticelloWorkingCopy repositoryGroup.
			repositoryGroup := MCRepositoryGroup new.
			repositories := packageSpec repositories collect: [ :each | each createRepository ].
			repositories isEmpty
				ifTrue: [ 
					repositories := versionSpec repositories collect: [ :repoSpec | repoSpec createRepository ].
					wcRepositoryGroup repositories notEmpty
						ifTrue: [ repositories := repositories select: [ :repo | wcRepositoryGroup includes: repo ] ].
					repositories isEmpty
						ifTrue: [ repositories := monticelloWorkingCopy repositoryGroup repositories reject: [ :repo | repo = MCCacheRepository default ] ] ].
			repositories do: [ :repo | 
				(monticelloWorkingCopy possiblyNewerVersionsIn: repo) notEmpty
					ifTrue: [ self notify: 'There are possibly newer versions of the package ', packageSpec name printString, ' in the repository ', repo description printString, '. Cancel and manually merge if you want to pick up the changes from the later version.' ].
				repositoryGroup addRepository: repo ].
			modifiedPackages at: packageSpec name put: repositoryGroup ].
	cacheRepository := MCCacheRepository default.
	modifiedPackages isEmpty ifTrue: [ self notify: 'Empty modified packages list' "actually here for debugging purposes" ].
	modifiedPackages
		keysAndValuesDo: [ :packageName :repositoryGroup | 
			| gofer repositoryList packageSpec |
			gofer := Gofer new.
			gofer disablePackageCache.
			(repositoryGroup repositories reject: [:repo | repo = cacheRepository ]) do: [ :repository | gofer repository: repository ].
			gofer package: packageName.
			gofer commit: commitMessage ].
	^ modifiedPackages! !

!MetacelloToolBox class methodsFor: 'scripts' stamp: 'dkh 3/7/2012 17:08:50'!
stableVersion: stableVersionString for: configurationBasename platformAttribute: platformAttribute
	<apiDocumentation>
	"Set the #stable symbolic version to the given version, using the given platformAttribute."
	
	(MetacelloToolBox configurationNamed: configurationBasename)
		symbolicVersionMethod: #stable;
		addSymbolicSection: platformAttribute version: stableVersionString;
		commitMethod.
! !

!MetacelloToolBox class methodsFor: 'scripts' stamp: 'dkh 3/7/2012 17:08:50'!
createDevelopment: developmentVersionString for: configurationBasename from: existingDevelopmentVersionString description: aString
	"Create a new development version based on the specifications in an existing development version. Modify the #development symbolic version to reference the new version."

	<apiDocumentation>
	| toolbox |
	(toolbox := self configurationNamed: configurationBasename)
		createVersionMethod: 'version' , (self stripVersionStringForSelector: developmentVersionString) , ':'
			inCategory: 'versions'
			forVersion: developmentVersionString;
		addSectionsFrom: existingDevelopmentVersionString
			forBaseline: false
			updateProjects: true
			updatePackages: true
			versionSpecsDo: [ :attribute :versionSpec | 
				attribute == #common
					ifTrue: [ 
						"update the author, blessing, description and timeStamp"
						versionSpec
							author: MetacelloPlatform current authorName;
							description: aString;
							blessing: #development;
							timestamp: MetacelloPlatform current timestamp ].
				true ];
		commitMethod.
	toolbox
		symbolicVersionMethod: #development;
		addSymbolicSection: #common version: developmentVersionString;
		commitMethod.
	^ toolbox! !

!MetacelloToolBox class methodsFor: 'development support' stamp: 'dkh 3/7/2012 17:08:50'!
compareVersionsIn: aConfigurationClass
	"Compare the current #stable version to current #development version"

	<apiDocumentation>
	| developmentVersion previousVersion |
	developmentVersion := aConfigurationClass project version: #development.
	previousVersion := aConfigurationClass project version: #stable.
	^self
		compareVersion: previousVersion versionString
		for: aConfigurationClass name asString
		to: developmentVersion versionString
	! !

!MetacelloToolBox class methodsFor: 'instance creation' stamp: 'dkh 3/7/2012 17:08:50'!
configurationNamed: baseName

	^self new 
		configurationNamed: baseName;
		yourself! !

!MetacelloToolBox class methodsFor: 'validation' stamp: 'dkh 3/7/2012 17:08:50'!
copyConfiguration: aConfigurationClass to: metacelloRepositoryString
	"Copy the current configuration mcz file to the given repository (i.e., http: //... or directory://, etc.)"

	<apiDocumentation>
	| project |
	project := aConfigurationClass project.
	project projectPackage
		copySpecTo:
			((project repositorySpec)
				description: metacelloRepositoryString;
				yourself)! !

!MetacelloToolBox class methodsFor: 'scripts' stamp: 'dkh 3/7/2012 17:08:50'!
createBranch: branchName for: configurationBasename description: commitMessage
	"Create a new branch for the project and save the configuration to it's repository."
	
	<apiDocumentation>
	| toolbox criticalIssues |
	branchName isEmpty ifTrue: [ ^self saveConfigurationPackageFor: configurationBasename description: commitMessage ].
	(criticalIssues := self checkForCriticalValidationIssues: configurationBasename) isEmpty
		ifTrue: [ 
			toolbox := self configurationNamed: configurationBasename.
			toolbox project goferBranch: branchName project: commitMessage.
			^toolbox ].
	 self error: 'There are critical issues in configuration ' , configurationBasename printString, '. Configuration not saved'.
	^nil! !

!MetacelloToolBox class methodsFor: 'development support' stamp: 'dkh 3/7/2012 17:08:50'!
modifyDevelopmentVersionIn: aConfigurationClass imports: imports requiredProjects: projectList packages: packageList description: message
	"Modify #development version's baseline version based on the given structure
		imports - imports array
		projectList - collection of project base names (without ConfigurationOf prefix)
		packageList - collection of package base names
	"

	<apiDocumentation>
	| developmentVersion files |
	developmentVersion := aConfigurationClass project version: #development.
	files := OrderedCollection new.
	packageList do: [:packageName | files add: packageName -> packageName ].
	self
		modifyVersion: developmentVersion versionString
		section: #common
		for: aConfigurationClass name asString
		repository: nil
		requiredProjects: projectList
		packages: packageList
		dependencies: #()
		includes: #()
		files: files
		repositories: #()
		preLoadDoIts: #()
		postLoadDoIts: #()
		supplyingAnswers: #()
		groups: #().
	(self configurationNamed: aConfigurationClass name asString)
		modifyVersionMethodForVersion: developmentVersion versionString;
		imports: imports;
		commitMethod.
	self
		updateDevelopment: developmentVersion versionString
		for: aConfigurationClass name asString
		updateProjects: false 
		description: message! !

!MetacelloToolBox class methodsFor: 'scripts' stamp: 'dkh 3/7/2012 17:08:50'!
releaseVersion: developmentVersionString for: configurationBasename blessingAttribute: attribute platformAttribute: platformAttribute
	<apiDocumentation>
	"Set the blessing to #release and set the #stable symbolic version to the given version, using the given attributes for each."
	
	| toolbox |
	(toolbox := self configurationNamed: configurationBasename)
		modifyVersionMethodForVersion: developmentVersionString
			versionSpecsDo: [ :attr :versionSpec | 
					attr == attribute
						ifTrue: [ versionSpec blessing: #release ].
					true ];
		commitMethod;
		symbolicVersionMethod: #development;
		addSymbolicSection: platformAttribute version: #notDefined;
		commitMethod;
		symbolicVersionMethod: #stable;
		addSymbolicSection: platformAttribute version: developmentVersionString;
		commitMethod.
	^ toolbox! !

!MetacelloToolBox class methodsFor: 'scripts' stamp: 'dkh 3/7/2012 17:08:50'!
modifySymbolicVersion: symbolicVersionSymbol for: configurationBasename attribute: attribute to: versionString
	"Set the value of the symbolic version for the given attribute to the given version string"

	<apiDocumentation>
	| toolbox |
	(toolbox := self configurationNamed: configurationBasename)
		modifySymbolicVersionMethodFor: symbolicVersionSymbol;
		addSymbolicSection: attribute version: versionString;
		commitMethod.
	^ toolbox! !

!MetacelloToolBox class methodsFor: 'development support' stamp: 'dkh 3/7/2012 17:08:50'!
saveModifiedPackagesAndConfigurationIn: aConfigurationClass description: commitMessage
	"Save modified mcz files, update and then save the configuration."

	<apiDocumentation>
	| version |
	version := aConfigurationClass project version: #development.
	self
		saveModifiedDevelopmentPackages: version versionString
		for: aConfigurationClass name asString
		description: commitMessage.
	(self
		updateDevelopment: version versionString
		for: aConfigurationClass name asString
		updateProjects: false
		description: commitMessage) isEmpty
		ifTrue: [ self updateDescription: version versionString for: aConfigurationClass name asString description: commitMessage ].
	self saveConfigurationPackageFor: aConfigurationClass name asString description: commitMessage! !

!MetacelloToolBox class methodsFor: 'development support' stamp: 'dkh 3/7/2012 17:08:50'!
updateToLatestPackageVersionsIn: aConfigurationClass description: descriptionString
	"Update the #development version to match currently loaded mcz files."

	"self updateToLatestPackageVersions: '- fixed a bug'"

	<apiDocumentation>
	^self
		updateDevelopment: #development
		for: aConfigurationClass name asString
		updateProjects: false 
		description: descriptionString! !

!MetacelloToolBox class methodsFor: 'validation' stamp: 'dkh 3/7/2012 17:08:50'!
validateConfiguration: configurationClass
	"Check the configuration for Errors, Critical Warnings, and Warnings (see class comment for MetacelloMCVersionValidator for more information). "

	<apiDocumentation>
	^ self validateConfiguration: configurationClass debug: #() recurse: false! !

!MetacelloToolBox class methodsFor: 'development support' stamp: 'dkh 3/7/2012 17:08:50'!
createNewBaselineVersionIn: aConfigurationClass requiredProjects: projectList packages: packageList dependencies: dependencies  groups: groups
	"Create a new baseline version based upon #stable version's baseline, modify the baseline based on the provided structural additions:
		projectList - collection of project base names (without ConfigurationOf prefix)
		packageList - collection of package base names
		dependencies - collection of associations where key is name of package and value is collection of required packages and projects
		groups - collection of associations where key is the name of the group and value is the collection of group members
	"

	<apiDocumentation>
	| currentVersion existingBaselineVersionString baselineVersionNumber |
	currentVersion := aConfigurationClass project version: #development.
	existingBaselineVersionString := currentVersion importedVersions first.
	baselineVersionNumber := existingBaselineVersionString asMetacelloVersionNumber incrementMinorVersionNumber.
	self
		createBaseline: baselineVersionNumber versionString
		for: aConfigurationClass name asString
		from: existingBaselineVersionString
		description: ''.
	self
		modifyVersion: baselineVersionNumber versionString
		section: #common
		for: aConfigurationClass name asString
		repository: nil
		requiredProjects: projectList
		packages: packageList
		dependencies: dependencies
		includes: #()
		files: #()
		repositories: #()
		preLoadDoIts: #()
		postLoadDoIts: #()
		supplyingAnswers: #()
		groups: groups! !

!MetacelloToolBox class methodsFor: 'development support' stamp: 'dkh 3/7/2012 17:08:50'!
modifyBaselineVersionIn: aConfigurationClass repository: repositoryDescription requiredProjects: projectList packages: packageList dependencies: dependencies includes: includes files: files repositories: repositories preLoadDoIts: preLoadDoIts postLoadDoIts: postLoadDoIts supplyingAnswers: supplyingAnswers groups: groups
	"Modify #development version's baseline version based on the given structure
		repositoryDescription - metacello repository string
		projectList - collection of project base names (without ConfigurationOf prefix)
		packageList - collection of package base names
		dependencies - collection of associations where key is name of package and value is collection of required packages and projects
		includes - collection of associations where key is name of package and value is collection of included packages and projects
		files - collection of associations where key is name of package and value is name of file
		repositories - collection of associations where key is name of package and value is collection of repository descriptions
		preLoadDoIts - collection of associations where key is name of package and value is preload doit selector
		postLoadDoIts - collection of associations where key is name of package and value is postload doit selector
		supplyingAnswers - collection of associations where key is name of package and value is the supplyingAnswers array
		groups - collection of associations where key is the name of the group and value is the collection of group members
	"

	<apiDocumentation>
	| currentVersion existingBaselineVersionString |
	currentVersion := aConfigurationClass project version: #development.
	existingBaselineVersionString := currentVersion importedVersions first.
	self
		modifyVersion: existingBaselineVersionString
		section: #common
		for: aConfigurationClass name asString
		repository: repositoryDescription
		requiredProjects: projectList
		packages: packageList
		dependencies: dependencies
		includes: includes
		files: files
		repositories: repositories
		preLoadDoIts: preLoadDoIts
		postLoadDoIts: postLoadDoIts
		supplyingAnswers: supplyingAnswers
		groups: groups! !

!MetacelloToolBox class methodsFor: 'scripts' stamp: 'dkh 3/7/2012 17:08:50'!
releaseVersion: developmentVersionString for: configurationBasename
	"Set the #common blessing to #release and set the #common #stable symbolic version to the given version."

	<apiDocumentation>
	^ self
		releaseVersion: developmentVersionString
		for: configurationBasename
		blessingAttribute: #common
		platformAttribute: #common! !

!MetacelloToolBox class methodsFor: 'development support' stamp: 'dkh 3/7/2012 17:08:50'!
saveModifiedPackagesIn: aConfigurationClass description: commitMessage
	"Save modified mcz files and update the configuration."

	| version |
	version := aConfigurationClass project version: #development.
	self
		saveModifiedDevelopmentPackages: version versionString for: aConfigurationClass name asString description: commitMessage;
		updateDevelopment: version versionString
			for: aConfigurationClass name asString
			updateProjects: false
			description: commitMessage! !

!MetacelloToolBox class methodsFor: 'help' stamp: 'dkh 3/7/2012 17:08:50'!
helpTopicClass

	^Smalltalk at: #HelpTopic ifAbsent: []! !

!MetacelloToolBox class methodsFor: 'scripts' stamp: 'dkh 3/7/2012 17:08:50'!
createBaseline: baselineVersionString for: configurationBasename repository: repositoryDescription requiredProjects: projectList packages: packageList repositories: repositories dependencies: dependencies groups: groups
    "Create a new baseline version based on the specified project structure.
		repositoryDescription - metacello repository string
		projectList - collection of project base names (without ConfigurationOf prefix)
		packageList - collection of package base names
		repositories - collection of associations where key is name of package and value is collection of repository descriptions
		dependencies - collection of associations where key is name of package and value is collection of required packages and projects
		groups - collection of associations where key is the name of the group and value is the collection of group members
	"

    <apiDocumentation>
    | toolbox |
    (toolbox := self configurationNamed: configurationBasename)
        createVersionMethod: 'baseline' , (self stripVersionStringForSelector: baselineVersionString) , ':'
            inCategory: 'baselines'
            forVersion: baselineVersionString;
        addSection: #'common'
            repository: repositoryDescription
            requiredProjects: projectList
            packages: packageList
            repositories: repositories
            dependencies: dependencies
            groups: groups
            versionSpecsDo: [ :versionSpec | versionSpec blessing: #'baseline' ];
        commitMethod.
    ^ toolbox! !

!MetacelloToolBox class methodsFor: 'scripts' stamp: 'dkh 3/7/2012 17:08:50'!
createVersion: targetVersionString for: configurationBasename from: sourceVersionString description: aString
	"Create a new version based on the specifications in the given version. 
	 If the new version string contains 'baseline', then create a new baseline version.
	 If the given version is a baseline, then create a new version based on the given baseline.
	 If the given version is a non-baseline version, then create a new version based on the given version."

	<apiDocumentation>
	| toolbox sourceVersion |
	toolbox := self configurationNamed: configurationBasename.
	sourceVersion := toolbox project version: sourceVersionString.
	^ (targetVersionString indexOfSubCollection: 'baseline') > 0
		ifTrue: [ 
			"create baseline version from baseline version"
			sourceVersion blessing ~~ #baseline
				ifTrue: [ 
					self
						error:
							'Cannot create a baseline version ' , sourceVersionString printString , ' from a non-baseline version '
								, targetVersionString printString ].
			self
				createBaseline: targetVersionString
				for: configurationBasename
				from: sourceVersionString
				description: aString ]
		ifFalse: [ 
			sourceVersion blessing == #baseline
				ifTrue: [ 
					"create development version version from baseline version"
					self
						createDevelopment: targetVersionString
						for: configurationBasename
						importFromBaseline: sourceVersion versionString
						description: aString ]
				ifFalse: [ 
					"create development version version from development version"
					self
						createDevelopment: targetVersionString
						for: configurationBasename
						from: sourceVersion versionString
						description: aString ] ]! !

!MetacelloToolBox class methodsFor: 'scripts' stamp: 'dkh 3/7/2012 17:08:50'!
modifyVersion: sourceVersionString for: configurationBasename versionSpecsDo: aBlock
	"Modify the version specifications for the given version"

	<apiDocumentation>
	(self configurationNamed: configurationBasename)
		modifyVersionMethodForVersion: sourceVersionString versionSpecsDo: aBlock;
		commitMethod! !

!MetacelloToolBox class methodsFor: 'validation' stamp: 'dkh 3/7/2012 17:08:50'!
validateProject: aMetacelloProject version: versionString
	"Check a specific version in the configuration for Errors, Critical Warnings, and Warnings (see class comment for MetacelloMCVersionValidator for more information). "

	<apiDocumentation>
	^ self validateProject: aMetacelloProject version: versionString debug: #() recurse: false
! !

!MetacelloToolBox class methodsFor: 'scripts' stamp: 'dkh 3/7/2012 17:08:50'!
saveConfigurationPackageFor: configurationBasename description: commitMessage
	"Save mcz file that contains the configuration to it's repository."
	
	<apiDocumentation>
	| toolbox criticalIssues |
	(criticalIssues := self checkForCriticalValidationIssues: configurationBasename) isEmpty
		ifTrue: [ 
			toolbox := self configurationNamed: configurationBasename.
			toolbox project goferCommitProject: commitMessage.
			^toolbox ].
	 self error: 'There are critical issues in configuration ' , configurationBasename printString, '. Configuration not saved'.
	^nil! !

!MetacelloToolBox class methodsFor: 'utility' stamp: 'dkh 3/7/2012 17:08:50'!
configurationNameFrom: baseName
    "Return the fully-qualified configuration class name."

    <apiDocumentation>
    ^ MetacelloScriptEngine configurationNameFrom: baseName! !

!MetacelloToolBoxConstructor methodsFor: 'api callbacks' stamp: 'dkh 9/7/2012 13:12'!
setFor: attributeList version: aString
    "conditional symbolicVersion support"

    self methodSections
        add:
            (MetacelloSymbolicVersionSpec new
                attributes: attributeList asMetacelloAttributeList;
                versionString: aString;
                yourself)! !

!MetacelloToolBoxConstructor methodsFor: 'private' stamp: 'DaleHenrichs 12/23/2010 15:21'!
methodSection: methodSection do: aBlock

	methodSection methodSections do: aBlock.
	methodSection methodSections do: [ :ms | self methodSection: ms do: aBlock ]! !

!MetacelloToolBoxConstructor methodsFor: 'accessing' stamp: 'dkh 9/13/2012 16:09'!
methodSectionAttributes
    | attributes |
    attributes := Set new.
    self methodSectionsDo: [ :methodSection | attributes addAll: methodSection attributes ].
    ^ attributes! !

!MetacelloToolBoxConstructor methodsFor: 'api callbacks' stamp: 'dkh 9/7/2012 13:12'!
setFor: attributeList do: aBlock
    "conditional version support"

    | methodSection |
    methodSection := MetacelloVersionMethodSection new
        attributes: attributeList asMetacelloAttributeList;
        block: aBlock;
        yourself.
    currentSection ~~ nil
        ifTrue: [ currentSection addMethodSection: methodSection ]
        ifFalse: [ self methodSections add: methodSection ]! !

!MetacelloToolBoxConstructor methodsFor: 'private' stamp: 'DaleHenrichs 12/22/2010 09:56'!
evaluateMethodSection: methodSection version: sourceVersionString
	| versionSpec |
	versionSpec := self project versionSpec.
	versionSpec versionString: sourceVersionString.
	methodSection versionSpec: versionSpec.
	currentSection := methodSection.
	self with: versionSpec during: methodSection block.
	methodSection methodSections do: [ :ms | self evaluateMethodSection: ms version: sourceVersionString ]! !

!MetacelloToolBoxConstructor methodsFor: 'extraction' stamp: 'DaleHenrichs 12/22/2010 11:07'!
extractMethodSectionsFor: sourceVersionString
	| coll pragma |
	coll := self extractAllVersionPragmas at: sourceVersionString ifAbsent: [ ^ #() ].
	coll size > 1
		ifTrue: [ self error: 'More than one pragma defining ' , sourceVersionString printString ].
	pragma := coll at: 1.
	self evaluatePragma: pragma.
	self methodSections do: [ :methodSection | self evaluateMethodSection: methodSection version: sourceVersionString ].
! !

!MetacelloToolBoxConstructor methodsFor: 'private' stamp: 'dkh 9/7/2012 10:43'!
methodSection: methodSection inEvaluationOrder: attributes do: aBlock
    | selected |
    selected := IdentitySet new.
    attributes
        do: [ :attribute | 
            methodSection methodSections
                do: [ :ms | 
                    (ms attributes includes: attribute)
                        ifTrue: [ selected add: ms ] ] ].
    selected do: aBlock.
    attributes size == 1
        ifTrue: [ ^ self ].
    selected
        do: [ :ms | self methodSection: ms inEvaluationOrder: (attributes copyFrom: 2 to: attributes size) do: aBlock ]! !

!MetacelloToolBoxConstructor methodsFor: 'initialization' stamp: 'DaleHenrichs 11/18/2010 16:40'!
reset
	super reset.	"not needed, but included for completeness"
	methodSections := nil! !

!MetacelloToolBoxConstructor methodsFor: 'enumeration' stamp: 'DaleHenrichs 12/23/2010 15:10'!
methodSectionsDo: aBlock

	self methodSection: self do: aBlock
! !

!MetacelloToolBoxConstructor methodsFor: 'extraction' stamp: 'DaleHenrichs 11/15/2010 10:06'!
extractSymbolicVersionSpecsFor: sourceVersionSymbol
	| coll versionSpec pragma |
	coll := self extractSymbolicVersionPragmas at: sourceVersionSymbol ifAbsent: [ ^ #() ].
	coll size > 1
		ifTrue: [ self error: 'More than one pragma defining ' , sourceVersionSymbol printString ].
	pragma := coll at: 1.
	self evaluatePragma: pragma.
	^ self methodSections

! !

!MetacelloToolBoxConstructor methodsFor: 'enumeration' stamp: 'dkh 9/7/2012 10:40'!
methodSectionsInEvaluationOrder: attributes do: aBlock
    "breadth first traversal ... to collect selected sections, then evaluate individual sections in attribute order"

    | selected processed |
    selected := IdentitySet new.
    self methodSection: self inEvaluationOrder: attributes do: [ :methodSection | selected add: methodSection ].
    processed := IdentitySet new.
    attributes
        do: [ :attribute | 
            | list |
            list := OrderedCollection new.
            selected
                do: [ :methodSection | 
                    (processed includes: methodSection)
                        ifFalse: [ 
                            (methodSection attributes includes: attribute)
                                ifTrue: [ 
                                    list add: methodSection.
                                    processed add: methodSection ] ] ].
            list do: aBlock ]! !

!MetacelloToolBoxConstructor methodsFor: 'private' stamp: 'DaleHenrichs 11/14/2010 02:08'!
methodSections

	methodSections == nil ifTrue: [ methodSections := OrderedCollection new ].
	^methodSections! !

!MetacelloToolBoxTutorial methodsFor: 'lessons' stamp: 'DaleHenrichs 1/14/2011 12:22:17'!
releaseVersion10

	^Lesson
		title: 'Release version 1.0'
		lesson: 
'"
	1. Create configuration
	2. Prepare to modify the version method for version 1.0:
		- the project and package versions are not updated
	3. Change the blessing to #release for the #common attribute
	4. Note that the return value for the #attributeBlocksDo: block is true. If the return value is false, the versionSpec would not be included in the updated mehtod.
	5. Compile and validate the #version10: method .
	6. Remove version 1.0 from the definition of the #development symbolic version - the version is no longer in development
		- the return value for the  #methodSectionsDo: block (like the #versionSpecsDo: block) determins whether the methodSection is carried forward or not
	7. Compile and validate the #development: method
	8. Prepare to define the symbolic version method #stable:
	9. Define version 1.0 as the #stable symbolic version for #common
	10. Compile and validate the #stable: method"
	
"1"	(MetacelloToolBox configurationNamed: ''Example'')
"2."		modifyVersionMethodForVersion: ''1.0''
			versionSpecsDo: [ :attribute :versionSpec | 
					attribute == #common
"3."						ifTrue: [ versionSpec blessing: #release ].
"4."					true ];
"5."		commitMethod;
"6."		modifySymbolicVersionMethodFor: #development
			symbolicVersionSpecsDo: [ :methodSection | methodSection versionString ~= ''1.0'' ];
"7."		commitMethod;
"8."		createSymbolicVersionMethod: ''stable:'' inCategory: ''symbolic versions'' forVersion: #stable;
"9."		addSymbolicSection: #common version: ''1.0'';
"10."	commitMethod.

"After evaluating the above expression, take a look at the updated method #version10, where you will see that the blessing has been updated to #release.

Look at the #development: method (which should be empty) and the #stable: method"

ProfStef next.
'
! !

!MetacelloToolBoxTutorial methodsFor: 'lessons' stamp: 'DaleHenrichs 1/14/2011 12:22:17'!
intro

	^Lesson
		title: 'Intro'
		lesson: 
'"The lessons in this section cover some of the same material that was covered in the development process tutorial, but we take a closer look at the implementation using the instance-side protocol instead of the class-side protocol"
	
ProfStef next.
'
! !

!MetacelloToolBoxTutorial methodsFor: 'intro' stamp: 'DaleHenrichs 1/14/2011 12:22:17'!
introductionText

	^'Dive down into the MetacelloToolBox API to take a closer look at the implementation of the development support methods.'! !

!MetacelloToolBoxTutorial methodsFor: 'lessons' stamp: 'DaleHenrichs 1/14/2011 12:22:17'!
create10Baseline

	^Lesson
		title: 'Create 1.0 Baseline'
		lesson: 
'"
	1. Create configuration
		- class named ConfigurationOfExample created if it does not already exist.
	2. Prepare to define baseline version method
		- selector, category and version number defined
	3. Define baseline project structure
		- repository
		- external project ''Shout''
		- packages ''ProfStef-Core'' and ''ProfStef-Tests'', plus dependencies
	4. Compile the #baseline10: method
		- version method compiled and validated "
	
"1."	(MetacelloToolBox configurationNamed: ''Example'')
"2."		createVersionMethod: ''baseline10:'' inCategory: ''baselines'' forVersion: ''1.0-baseline'';
"3."		addSection: #common
			repository: ''http://www.squeaksource.com/ProfStef''
			requiredProjects: #(''Shout'')
			packages: #(''ProfStef-Core'' ''ProfStef-Tests'')
			dependencies:
				{(''ProfStef-Core'' -> #(''Shout'')).
				(''ProfStef-Tests'' -> #(''ProfStef-Core''))}
			groups:
				{(''default'' -> #(''Core'')).
				(''Core'' -> #(''ProfStef-Core'')).
				(''Tests'' -> #(''ProfStef-Tests'')).
				(''Core Tests'' -> #(''Core'' ''Tests''))}
			versionSpecsDo: [ :versionSpec | versionSpec blessing: #baseline ];
"4."		commitMethod.

"After evaluating the above expression, browse the configuration:"

	ConfigurationOfExample browse.
	
"and look at the generated method #baseline10:. Note that the symbolic version #bleedingEdge is used for the Shout project."

ProfStef next.
'
! !

!MetacelloToolBoxTutorial methodsFor: 'lessons' stamp: 'DaleHenrichs 1/14/2011 12:22:17'!
open10ForDevelopment

	^Lesson
		title: 'Open version 1.0 for development'
		lesson: 
'"
	1. Create configuration
		- always start a toolbox expression this way
	2. Prepare to define version method #version10:
		- similar expression used to create baseline method
	3. Import specification from version 1.0-baseline
		- specs that are not needed in a version are dropped
		- import is added to pragma
		- with #updateProjects set to true, the current version of the project Shout will set
		- with #updatePackages set to true, the current mcz files for the packages ProfStef-Core ProfStef-Tests will be set
	4. Define desired versionSpec attributes
		- current author and timestamp
		- set blessing to #development
		- set the description
		- return value of true in block, means the versionSpec is added to current method being defined
	5. Compile the #version10: method
		- compile and validate
	6. Prepare to define symbolic version method #development:
	7. Define symbolic version 
		- symbolic version #development maps to version 1.0 for the #common attributes
		- multiple addSymbolicSection: expressions may be used 
	8. Compile the #development: method
		- compile and validate"
	
	| description |
	description := ''- fixed a bug''.
"1."	(MetacelloToolBox configurationNamed: ''Example'')
"2."		createVersionMethod: ''version10:'' inCategory: ''versions'' forVersion: ''1.0'';
"3."		importFrom: ''1.0-baseline''
			updateProjects: true
			updatePackages: true
			versionSpecsDo: [ :attribute :versionSpec | 
				attribute == #common
					ifTrue: [ 
"4."						versionSpec
							author: MetacelloPlatform current authorName;
							blessing: #development;
							description: description;
							timestamp: MetacelloPlatform current timestamp ].
				true ];
"5."		commitMethod;
"6."		createSymbolicVersionMethod: ''development:'' inCategory: ''symbolic versions'' forVersion: #development;
"7."		addSymbolicSection: #common version: ''1.0'';
"8."		commitMethod.

"After evaluating the above expression, take a look at the generated methods:
	- #version10:
	- #development:"

ProfStef next.
'
! !

!MetacelloToolBoxTutorial methodsFor: 'tutorial' stamp: 'DaleHenrichs 1/14/2011 12:22:17'!
tutorial

	^#(
		intro
		create10Baseline
		open10ForDevelopment 
		updateVersion10
		releaseVersion10
		open11ForDevelopment
		create11Baseline
		releaseVersion11PharoOnly
		)! !

!MetacelloToolBoxTutorial methodsFor: 'lessons' stamp: 'DaleHenrichs 1/14/2011 12:22:17'!
open11ForDevelopment

	^Lesson
		title: 'Open version 1.1 for development'
		lesson: 
'"
	1. Create configuration
	2. Prepare to define version method #version11:
	3. Use version 1.0 as basis for version 1.1. basically a copy. Differs from import.
	4. Update project and package versions
		- with #updateProjects set to true, the current version of the project Shout will set
		- with #updatePackages set to true, the current mcz files for the packages ProfStef-Core ProfStef-Tests will be set
	5. Define desired versionSpec attributes
		- current author and timestamp
		- set blessing to #development
		- set the description
	6. Compile and validate the #version11: method
	7. Prepare to modify symbolic version method #development:
		- keep all of the existing symbolic version specs in the method
	8. Define/change the symbolic version for #development to 1.1
	9. Compile and validate the #development: method"
	
	| description |
	description := ''''.
"1."	(MetacelloToolBox configurationNamed: ''Example'')
"2."		createVersionMethod: ''version11:'' inCategory: ''versions'' forVersion: ''1.1'';
"3."		addSectionsFrom: ''1.0''
			forBaseline: false
"4."			updateProjects: true
			updatePackages: true
			versionSpecsDo: [ :attribute :versionSpec | 
				attribute == #common
					ifTrue: [ 
"5."						versionSpec
							author: MetacelloPlatform current authorName;
							description: description;
							blessing: #development;
							timestamp: MetacelloPlatform current timestamp ].
				true ];
"6."		commitMethod;
"7."		modifySymbolicVersionMethodFor: #development symbolicVersionSpecsDo: [ :symbolicVersionSpec | true ];
"8."		addSymbolicSection: #common version: ''1.1'';
"9."		commitMethod.

"After evaluating the above expression, take a look at the generated methods:
	- #version11:
	- #development:"


ProfStef next.
'
! !

!MetacelloToolBoxTutorial methodsFor: 'lessons' stamp: 'DaleHenrichs 1/14/2011 12:22:17'!
updateVersion10

	^Lesson
		title: 'Update specs for version 1.0'
		lesson: 
'"
	1. Create configuration
	2. Prepare to update the version method for version 1.0:
		- with #updateProjects set to true, the current version of the project Shout will set
		- with #updatePackages set to true, the current mcz files for the packages ProfStef-Core ProfStef-Tests will be set
	3. Define desired versionSpec attributes
		- current author and timestamp
	4. Append the #logEntry to the version descripttion
	5. Compile the #version10: method
		- compile and validate"
	
	| logEntry |
	logEntry := ''- fixed a bug''.
"1."	(MetacelloToolBox configurationNamed: ''Example'')
"2."		updateVersionMethodForVersion: ''1.0''
			versionSpecsDo: [ :attribute :versionSpec | 
				attribute == #common
					ifTrue: [ 
"3."						versionSpec
							author: MetacelloPlatform current authorName;
							timestamp: MetacelloPlatform current timestamp.
"4."						versionSpec description value isEmpty
							ifTrue: [ versionSpec description: logEntry ]
							ifFalse: [ 
								| strm |
								strm := WriteStream on: String new.
								strm
									nextPutAll: versionSpec description value;
									cr;
									nextPutAll: logEntry.
								versionSpec description: strm contents ] ].
				true ];
"5."		commitMethod.

"After evaluating the above expression, take a look at the updated method #version10. Unless you changed the packages that were loaded in your image, you should just see the #timestamp and #description fields updated."

ProfStef next.
'
! !

!MetacelloToolBoxTutorial methodsFor: 'lessons' stamp: 'DaleHenrichs 1/14/2011 12:22:17'!
create11Baseline

	^Lesson
		title: 'Create 1.1 Baseline'
		lesson: 
'"
	1. Create configuration
	2. Prepare to define baseline version method
	3. Copy specs from 1.0-baseline. This is a copy not an import, so all specs are preserved
		- with #updateProjects set to false, the version of the project Shout is preserved
		- with #updatePackages set to false, the specification of the mcz files for the packages ProfStef-Core ProfStef-Tests are preserved (typically not specified)
	4. Add and additional section for the attribute #pharo
		- the package ProfStefBrowser and it''s dependencies are added
		- the package is added to the UI group
	5. Compile and validate #baseline11: method
	6. Prepare to modify the method defining version 1.1.
		- false as return value in block means that all existing version specs in 1.1 are dropped on floor. Basically just the method name and pragma are preserved
	7. Import the versionSpecs from 1.1-baseline into version 1.1
	8. Compile and validate the #version11: method
	9. Prepare to modify the method defining symbolic version #development. Preserve existing symbolic version specs
	10.  add symbolic version spec for #pharo
	11. Compile and validate the #development: method
"
	
	| description |
	description := ''''.
"1."	(MetacelloToolBox configurationNamed: ''Example'')
"2"		createVersionMethod: ''baseline11:'' inCategory: ''baselines'' forVersion: ''1.1-baseline'';
"3."		addSectionsFrom: ''1.0-baseline''
			forBaseline: true
			updateProjects: false
			updatePackages: false
			versionSpecsDo: [ :attribute :versionSpec | true ];
"4"		addSection: #pharo
			repository: nil
			requiredProjects: #()
			packages: #(''ProfStefBrowser'')
			dependencies: {(''ProfStefBrowser'' -> #(''ProfStef-Core''))}
			groups: {(''UI'' -> #(''ProfStefBrowser''))}
			versionSpecsDo: [ :versionSpec |  ];
"5."		commitMethod;
"6."		modifyVersionMethodForVersion: ''1.1'' versionSpecsDo: [ :attribute :versionSpec | false ];
"7."		importFrom: ''1.1-baseline''
			updateProjects: true
			updatePackages: true
			versionSpecsDo: [ :attribute :versionSpec | 
				attribute == #common
					ifTrue: [ 
						"update the author, blessing and timeStamp"
						versionSpec
							author: MetacelloPlatform current authorName;
							blessing: #development;
							description: description;
							timestamp: MetacelloPlatform current timestamp ].
				true ];
"8."		commitMethod;
"9"		modifySymbolicVersionMethodFor: #development symbolicVersionSpecsDo: [ :symbolicVersionSpec | true ];
"10."	addSymbolicSection: #pharo version: ''1.1'';
"11."	commitMethod.

"Look at the generated methods: 

	#baseline11:
	#version11:
	#development:"
	
ProfStef next.
'
! !

!MetacelloToolBoxTutorial methodsFor: 'lessons' stamp: 'DaleHenrichs 1/14/2011 12:22:17'!
releaseVersion11PharoOnly

	^Lesson
		title: 'Release version 1.1 (#pharo only)'
		lesson: 
'"
	1. Create configuration
	2. Prepare to modify the version method for version 1.1:
	3. Change the blessing to #release for the #pharo attribute
	4. Compile and validate the #version11: method .
	5. Remove version 1.0 from the definition of the #development symbolic version
	6. Compile and validate the #development: method
	7. Prepare to define the symbolic version method #stable:
	8. Define version 1.1 as the #stable symbolic version for #common
	9. Compile and validate the #stable: method"
	
"1."	(MetacelloToolBox configurationNamed: ''Example'')
"2."		modifyVersionMethodForVersion: ''1.1''
			versionSpecsDo: [ :attribute :versionSpec | 
					attribute == #pharo
"3."						ifTrue: [ versionSpec blessing: #release ].
					true ];
"4."		commitMethod;
"5."		modifySymbolicVersionMethodFor: #development
			symbolicVersionSpecsDo: [ :symbolicVersionSpec | symbolicVersionSpec attribute ~~ #pharo ];
"6."		commitMethod;
"7."		modifySymbolicVersionMethodFor: #stable symbolicVersionSpecsDo: [ :symbolicVersionSpec | true ];
"8."		addSymbolicSection: #pharo version: ''1.1'';
"9."		commitMethod.

"After evaluating the above expression, take a look at the generated methods:

	#version11:
	#development:
	#stable: "
	
ProfStef next.
'
! !

!MetacelloToolBoxTutorial class methodsFor: 'tutorial metainfo' stamp: 'DaleHenrichs 1/14/2011 12:22:17'!
title	

	^'Inside Metacello Toolbox API'! !

!MetacelloTutorialConfig methodsFor: 'versions' stamp: 'dkh 3/18/2011 14:15:41'!
version02: spec 
	<version: '0.2'>
	
	spec for: #common do: [
		spec 
			package: 'Example-Core' with: [
				spec 
					file: 'Example-Core-anon.9';
					repository: 'http://www.example.com/Example' ] ].
! !

!MetacelloTutorialConfig methodsFor: 'baselines' stamp: 'dkh 3/18/2011 14:15:41'!
baseline13: spec 
	<version: '1.3-baseline'>
	
	spec for: #common do: [
		spec blessing: #baseline.
		spec repository: 'http://www.example.com/Example'.
		
		spec 
			package: 'Example-Core' with: [
				spec includes: #('Example-Platform' ) ];
			package: 'Example-Tests' with: [ spec requires: 'Example-Core' ];
			package: 'Example-AddOn' with: [ spec requires: 'Example-Core' ];
			package: 'Example-Platform' with: [ spec requires: 'Example-Core' ];
			package: 'Example-AddOnTests' with: [ 
				spec requires: #('Example-AddOn' 'Example-Tests' ) ].
		spec 
			group: 'default' with: #('Example-Core' 'Example-AddOn' );
			group: 'Tests' with: #('Example-Tests' 'Example-AddOnTests' ) ].
	spec for: #gemstone do: [
		spec package: 'Example-Platform' with: 'Example-Platform.gemstone'.].
	spec for: #pharo do: [
		spec package: 'Example-Platform' with: 'Example-Platform.pharo'.].
	spec for: #squeak do: [
		spec package: 'Example-Platform' with: 'Example-Platform.squeak'.].! !

!MetacelloTutorialConfig methodsFor: 'lessons' stamp: 'dkh 3/18/2011 14:15:41'!
lesson02
"  [ see method: #version02: ]
For version 0.2, we've simply updated the package version to 'Example-Core-anon.9', which 
can be confirmed by printing the following expression:

  (MetacelloTutorialConfig project version: '0.2') spec

"! !

!MetacelloTutorialConfig methodsFor: 'lessons' stamp: 'dkh 3/18/2011 14:15:41'!
lesson14
"
STILL UNDER CONSTRUCTION: Open your browsers on the class MetacelloProjectRefTutorial to continue the tutorial.
"! !

!MetacelloTutorialConfig methodsFor: 'lessons' stamp: 'dkh 3/18/2011 14:15:41'!
lesson05
"   [ see method: #version05: ]
For version 0.5 we've added an additional package to the mix: 'Example-AddOn':

  (MetacelloTutorialConfig project version: '0.5') spec

Of course, the point of specifiying packages in Metacello is to be able to load versions. Here are
a couple examples of loading versions of the Tutorial. If you print the result of each expression, 
you will see the list of packages in load order (note that for the tutorial, we are using the 
MetacelloNullRecordingMCSpecLoader. This class records which packages are loaded and the order that they are loaded in among other things instead of actually loading the packages.

  (MetacelloTutorialConfig project version: '0.1') load.
  (MetacelloTutorialConfig project version: '0.4') load.
  (MetacelloTutorialConfig project version: '0.5') load.

You will note that in each case, all of the packages associated with the version are loaded, which 
is the default. 

If you want to load a subset of the packages in a project, you may list the packages that you
are interested in as an argument to the #load: method:

  (MetacelloTutorialConfig project version: '0.5') load: { 'Example-Tests'. 'Example-Core' }.

Note that the ordering of the packages is based on the order in which the packages are specified.

If you evaluate the following expression:

  (MetacelloTutorialConfig project version: '0.5') load: { 'Example-Tests'. }.

Only the package is 'Example-Tests'. By default the packages are ordered, but there are no implicit
dependencies.
"! !

!MetacelloTutorialConfig methodsFor: 'accessing' stamp: 'dkh 3/18/2011 14:15:41'!
project
	"NOTE: The MetacelloNullRecordingMCSpecLoader is being used to prevent packages
		from being loaded, see MetacelloConfigTemplate>>project for an example #project
		method that loads the package for real"

	^ project ifNil: [ | constructor loader |
		"Construct Metacello project"
		constructor := (Smalltalk at: #MetacelloVersionConstructor) on: self.
		project := constructor project.
		loader := MetacelloNullRecordingMCSpecLoader new.
		loader evalDoits: true.
		project loader: loader.
		project ]! !

!MetacelloTutorialConfig methodsFor: 'lessons' stamp: 'dkh 3/18/2011 14:15:41'!
lesson08
"   [ see method: #version08: ]
In version 0.8 we've simply updated the package versions, which can be seen by comparing the 
results of loading version 0.7 and 0.8:

  (MetacelloTutorialConfig project version: '0.7') load.
  (MetacelloTutorialConfig project version: '0.8') load.

"! !

!MetacelloTutorialConfig methodsFor: 'lessons' stamp: 'dkh 3/18/2011 14:15:41'!
lesson01
" [ see metod: #version01: ]
Version 0.1 represents the simplest version specification possible. 

In the method #version01, version 0.1 is defined with a single package 'Example-Core-anon.8' 
that is loaded from the repository 'http://www.example.com/Example'.

Looking at this method you will notice a couple of things. 

Immediately after the method selector you see the pragma definition:

  <version: '0.1'>

The pragma indicates that the version created in this method should be associated with version 
'0.1' of the Tutorial project.

Looking a little closer you see that the argument to the method, <spec>, is the only variable in
the method and it is used as the receiver to four different messages:

  - #for:do:
  - #package:with:
  - #file: 
  - #repository:

With the evaluation of each block expression, a new object is pushed on a stack and the messages
within the block are sent to the object on the top of the stack.

So the method should be read as:

  Create version '0.1'. The #common code for version '0.1' (#for:do:) consists of a package named 
  'Example-Core' (#package:with:) whose file attribute is 'Example-Core-anon.8' (#file:) and whose 
  repository attribute is 'http://www.example.com/Example' (#repository:).

We can see the spec created for version 0.1 by printing the following expression:

  (MetacelloTutorialConfig project version: '0.1') spec

Note that in creating version '0.1' the #common attribute is extracted out.

In addition to #common, there are pre-defined attributes for each of the platforms upon which
Metacello runs (#pharo, #squeak, #gemstone and #squeakCommon). 

#squeakCommon is used for both #pharo and #squeak.
"! !

!MetacelloTutorialConfig methodsFor: 'versions' stamp: 'dkh 3/18/2011 14:15:41'!
version04: spec 
	<version: '0.4'>
	
	spec for: #common do: [
		spec repository: 'http://www.example.com/Example'.
		spec 
			package: 'Example-Core' with: 'Example-Core-anon.10';
			package: 'Example-Tests' with: 'Example-Tests-anon.3' ].
! !

!MetacelloTutorialConfig methodsFor: 'versions' stamp: 'dkh 3/18/2011 14:15:41'!
version06: spec 
	<version: '0.6'>
	
	spec for: #common do: [
		spec repository: 'http://www.example.com/Example'.
		spec 
			package: 'Example-Core' with: 'Example-Core-anon.12';
			package: 'Example-Tests' with: [
				spec 
					file: 'Example-Tests-anon.3';
					requires: 'Example-Core' ];
			package: 'Example-AddOn' with: [
				spec 
					file: 'Example-AddOn-anon.1';
					requires: 'Example-Core' ]].
! !

!MetacelloTutorialConfig methodsFor: 'baselines' stamp: 'dkh 3/18/2011 14:15:41'!
baseline10: spec 
	<version: '1.0-baseline'>
	
	spec for: #common do: [
		spec blessing: #baseline.
		spec repository: 'http://www.example.com/Example'.
		
		spec 
			package: 'Example-Core';
			package: 'Example-Tests' with: [ spec requires: 'Example-Core' ];
			package: 'Example-AddOn' with: [ spec requires: 'Example-Core' ];
			package: 'Example-AddOnTests' with: [ 
				spec requires: #('Example-AddOn' 'Example-Tests' ) ].
		spec 
			group: 'default' with: #('Example-Core' 'Example-AddOn' );
			group: 'Tests' with: #('Example-Tests' 'Example-AddOnTests' ) ].
! !

!MetacelloTutorialConfig methodsFor: 'lessons' stamp: 'dkh 3/18/2011 14:15:41'!
lesson07
"   [ see method: #baseline07: and #version07: ]
For version 0.7, we are ceating a baseline version specification which is expected to be used
across several versions and the version specification which is restricted to the file versions.

In method #baseline07: the structure of version '0.7-baseline' is specified. The repository is 
listed, the packages are listed and the required packages are defined. We'll cover the #blessing:
in a later lesson.

In method #version07: the file versions are specified. You will note that the pragma as an #imports: component that specifies the list of versions that this version (version '0.7') is based upon. In 
fact, if you print the spec for '0.7-baseline' and then print the spec for '0.7' you can see that 
'0.7' is a composition of both versions:

   (MetacelloTutorialConfig project version: '0.7-baseline') spec.
   (MetacelloTutorialConfig project version: '0.7') spec.

Of course if you print the '0.6' spec and the '0.7' spec you can see that they specify exactly the
same information in a slightly different way:

  (MetacelloTutorialConfig project version: '0.6') spec.
  (MetacelloTutorialConfig project version: '0.7') spec.

and if you load each of the versions, you will see that they load the same packages, in the same 
order:

  (MetacelloTutorialConfig project version: '0.6') load.
  (MetacelloTutorialConfig project version: '0.7') load.

Finally, even though version '0.7-baseline' does not have explicit package versions, you may load
the version. When the 'real' loader encounters a package name (without version information) it will
attempt to load the latest version of the package from the repository. With the
MetacelloNullRecordingMCSpecLoader the packages names are 'loaded':

  (MetacelloTutorialConfig project version: '0.7-baseline') load.

Of course when a number of developers are working on a project it may be useful to load a
#baseline version so that you get the latest work from all of the project members. 

"! !

!MetacelloTutorialConfig methodsFor: 'doits' stamp: 'dkh 3/18/2011 14:15:41'!
preloadForCore

	Transcript cr; show: '#preloadForCore executed'.! !

!MetacelloTutorialConfig methodsFor: 'versions' stamp: 'dkh 3/18/2011 14:15:41'!
version01: spec 
	<version: '0.1'>
	
	spec for: #common do: [
		spec 
			package: 'Example-Core' with: [
				spec 
					file: 'Example-Core-anon.8';
					repository: 'http://www.example.com/Example' ] ].
! !

!MetacelloTutorialConfig methodsFor: 'versions' stamp: 'dkh 3/18/2011 14:15:41'!
version08: spec 
	<version: '0.8' imports: #('0.7-baseline')>
	
	spec for: #common do: [
		spec 
			package: 'Example-Core' with: 'Example-Core-anon.15';
			package: 'Example-Tests' with: 'Example-Tests-anon.6';
			package: 'Example-AddOn' with: 'Example-AddOn-anon.2' ].
! !

!MetacelloTutorialConfig methodsFor: 'lessons' stamp: 'dkh 3/18/2011 14:15:41'!
lesson11
"   [ see method: #version11: ]
In version 0.11 we've defined a couple of attributes that are expected to be used all of the time
in a version specification:

  #blessing:
  #description:
  #author:
  #timestamp:

The following lessons cover each of these attributes in more detail. 
"! !

!MetacelloTutorialConfig methodsFor: 'versions' stamp: 'dkh 3/18/2011 14:15:41'!
version13: spec 
	<version: '1.3' imports: #('1.3-baseline')>
	
	spec for: #common do: [
		spec blessing: #development.
		spec description: 'Add in doits for Example-Core'.
		spec author: 'dkh'.
		spec timestamp: '10/13/2009 14:27'.
		spec 
			package: 'Example-Core' with: 'Example-Core-anon.17';
			package: 'Example-Tests' with: 'Example-Tests-anon.6';
			package: 'Example-AddOn' with: 'Example-AddOn-anon.1';
			package: 'Example-AddOnTests' with: 'Example-AddOnTests-anon.1' ].
	spec for: #gemstone do: [
		spec package: 'Example-Platform' with: 'Example-Platform.gemstone-dkh.4'.].
	spec for: #pharo do: [
		spec package: 'Example-Platform' with: 'Example-Platform.pharo-dkh.7'.].
	spec for: #squeak do: [
		spec package: 'Example-Platform' with: 'Example-Platform.squeak-dkh.3'.].! !

!MetacelloTutorialConfig methodsFor: 'lessons' stamp: 'dkh 3/18/2011 14:15:41'!
lesson13
"  [ see methods: #baseline13: #version13: ]
For version 1.3 we are adding a platform specific package 'Example-Platform'. 'Example-Platform'
requires 'Example-Core'. On GemStone, Pharo and Squeak, a branch of the 'Example-Platform' package 
will be loaded: 'Example-Platform.gemstone', 'Example-Platform.pharo', 'Example-Platform.squeak' 
respectively will be loaded. 

Consequently we've updated the baselines with #baseline13: to reflect the structural changes and
#version13: reflects the package versions.

The platform-specific versions and branches are defined in the #for:do: block for the corresponding
platforms: #gemstone, #pharo, #squeak (in both methods)

The result of the following expression will depend on the platform upon which you are running:

	(MetacelloTutorialConfig project version: '1.3') load.

Note that when you execute the following expresson to load 'Example-Core' that the correct
'Example-Platform' is loaded as well:

	(MetacelloTutorialConfig project version: '1.3') load: 'Example-Core'.

If you look at the specification for 'Example-Core' (in #baseline13:) you will note that 
'Example-Core' #includes: 'Example-Platform'. The #includes: directive means that the package 
'Example-Platform' should be loaded whenever the 'Example-Core' package is loaded.

Also note when you evaluate the following expression that the 'Example-Platform' package is loaded
before 'Example-Tests' as if 'Example-Tests' #requires: 'Example-Platform':

	(MetacelloTutorialConfig project version: '1.3') load: 'Example-Tests'.

When you use the #includes: directive, you are not only specifying that the listed packages should
be loaded when the parent package is loaded, but that the #included: packages should be loaded
_before_ any packages that require the parent package.


"! !

!MetacelloTutorialConfig methodsFor: 'lessons' stamp: 'dkh 3/18/2011 14:15:41'!
lesson11Blessing
"   [ see method: #version11: ]
A version can be tagged with a blessing like #alpha, #beta, #release, #development or any 
other tag that you find useful. The blessing for version 1.1 is #development

	(MetacelloTutorialConfig project version: '1.1') blessing.

The default blessing is #release, so even though we didn't specify a blessing for version 
0.5, the blessing is set:

	(MetacelloTutorialConfig project version: '0.5') blessing.
	
For version 1.1, it is important to explicitly set the blessing, because it imports version
'1.0-baseline' whose blessing is #baseline:

	(MetacelloTutorialConfig project version: '1.0-baseline') blessing.

Blessings can be used as a filter. For example, you will notice that the result of the 
following expression is version 0.6, because #stableVersion answers the latest version whose 
blessing is _not_ #development, #broken, or #blessing: 

	MetacelloTutorialConfig project stableVersion.
	MetacelloTutorialConfig project stableVersion load.

The blessing of version 1.1 is #development. To find the latest #development version you 
would execute this expression:

	MetacelloTutorialConfig project latestVersion: #development.
	(MetacelloTutorialConfig project latestVersion: #development) load.

You can get the very last version independent of blessing by executing this expression:

	MetacelloTutorialConfig project bleedingEdge.
	MetacelloTutorialConfig project bleedingEdge load.
	
In general, the #development blessing should be used for any version that is unstable. Once a 
version has stabilized, a different blessing should be applied.

The following expression will load the latest version of all of the packages for the latest 
#baseline version:

	(MetacelloTutorialConfig project latestVersion: #baseline) load.

Since the latest #baseline version should reflect the most up-to-date project structure, executing
the previous expression should load the absolute bleeding edge of the project. 
"! !

!MetacelloTutorialConfig methodsFor: 'lessons' stamp: 'dkh 3/18/2011 14:15:41'!
lesson10
"   [ see method: #baseline10: #version10: ]
In #baseline10: we've added two things: the 'Example-AddOnTests' package and a specification for 
groups. 

The 'Example-AddOnTests' package has been added to make the idea of needing to group packages a
little more appealing. The package requires 'Example-AddOn' and 'Example-Tests'.

With two Test packages it would be convenient to be able to load all of the tests with a simple
expression like the following:

  (MetacelloTutorialConfig project version: '1.0') load: { 'Tests'. }.

instead of having to explicitly list all of the test projects like this:

  (MetacelloTutorialConfig project version: '1.0') 
	load: { 'Example-Tests'. 'Example-AddOnTests'. }.

This becomes especially useful if over time the project evolves to have more component and test 
packages.

The 'default' group is special in that when a 'default' group is defined, the #load method loads
the members of the 'default' group instead of loading all of the packages:

  (MetacelloTutorialConfig project version: '1.0') load.

If you want to load all of the packages in a project, then the pseudo group 'ALL' may be used as
follows:

  (MetacelloTutorialConfig project version: '1.0') load: 'ALL'.

"! !

!MetacelloTutorialConfig methodsFor: 'lessons' stamp: 'dkh 3/18/2011 14:15:41'!
lesson11Timestamp
"  [ see method: #version11: ]
The timestamp of a version can be defined:

	(MetacelloTutorialConfig project version: '1.1') timestamp.

When using the OB-Metacello tools the timestamp field is automatically updated to reflect the current
DateAndTime that the update was made.

The timestamp is a String
"! !

!MetacelloTutorialConfig methodsFor: 'lessons' stamp: 'dkh 3/18/2011 14:15:41'!
lesson06
"   [ see method: #version06: ]
In version 0.6 we've added dependency information in the form of the #requires: directive.
Both 'Example-Tests' and  'Example-AddOn' require 'Example-Core' to be loaded before they are
loaded. Print the following expressions to see that the requires directives are being followed:

  (MetacelloTutorialConfig project version: '0.5') load: { 'Example-Tests'. }.
  (MetacelloTutorialConfig project version: '0.6') load: { 'Example-Tests'. }.
  (MetacelloTutorialConfig project version: '0.6') load: 'Example-AddOn'.
  (MetacelloTutorialConfig project version: '0.6') load: { 'Example-AddOn'. 'Example-Tests'. }.

With version 0.6 we are mixing structural information (required packages and repository) with the
dynamic file version info. It is expected that over time the file version info will change from
version to version while the structural information will remain relatively static.

"! !

!MetacelloTutorialConfig methodsFor: 'doits' stamp: 'dkh 3/18/2011 14:15:41'!
postloadForCore: loader package: packageSpec

	Transcript cr; 
		show: '#postloadForCore executed, Loader: ', loader printString, 
			' spec: ', packageSpec printString.! !

!MetacelloTutorialConfig methodsFor: 'versions' stamp: 'dkh 3/18/2011 14:15:41'!
version11: spec 
	<version: '1.1' imports: #('1.0-baseline')>
	
	spec for: #common do: [
		spec blessing: #development.
		spec description: 'Example of a complete version specification'.
		spec author: 'dkh'.
		spec timestamp: '10/12/2009 09:26'.
		spec 
			package: 'Example-Core' with: 'Example-Core-anon.15';
			package: 'Example-Tests' with: 'Example-Tests-anon.4';
			package: 'Example-AddOn' with: 'Example-AddOn-anon.1';
			package: 'Example-AddOnTests' with: 'Example-AddOnTests-anon.1' ].
! !

!MetacelloTutorialConfig methodsFor: 'versions' stamp: 'dkh 3/18/2011 14:15:41'!
version05: spec 
	<version: '0.5'>
	
	spec for: #common do: [
		spec repository: 'http://www.example.com/Example'.
		spec 
			package: 'Example-Core' with: 'Example-Core-anon.11';
			package: 'Example-Tests' with: 'Example-Tests-anon.3';
			package: 'Example-AddOn' with: 'Example-AddOn-anon.1' ].
! !

!MetacelloTutorialConfig methodsFor: 'versions' stamp: 'dkh 3/18/2011 14:15:41'!
version10: spec 
	<version: '1.0' imports: #('1.0-baseline')>
	
	spec for: #common do: [
		spec 
			package: 'Example-Core' with: 'Example-Core-anon.14';
			package: 'Example-Tests' with: 'Example-Tests-anon.3';
			package: 'Example-AddOn' with: 'Example-AddOn-anon.1';
			package: 'Example-AddOnTests' with: 'Example-AddOnTests-anon.1' ].
! !

!MetacelloTutorialConfig methodsFor: 'lessons' stamp: 'dkh 3/18/2011 14:15:41'!
lesson04
"   [ see method: #version04: ]
The specification for version 0.4 is basically the same as version 0.3. Instead of listing a 
repository with each package we specify a project repository that applies to all packages.

Compare the printStrings for the specs for each version:

  (MetacelloTutorialConfig project version: '0.3') spec

  (MetacelloTutorialConfig project version: '0.4') spec
"! !

!MetacelloTutorialConfig methodsFor: 'lessons' stamp: 'dkh 3/18/2011 14:15:41'!
lesson11Author
"  [ see method: #version11: ]
The author of a version can be defined:

	(MetacelloTutorialConfig project version: '1.1') author.

When using the OB-Metacello tools the author field is automatically updated to reflect the current
author as defined in the image.

"! !

!MetacelloTutorialConfig methodsFor: 'lessons' stamp: 'dkh 3/18/2011 14:15:41'!
lesson03
"   [ see method: #version03: ]
For version 0.3, we've updated the package version to 'Example-Core-anon.10' and added an additional 
package 'Example-Tests-anon.3', which can be confirmed by printing the following expression:

  (MetacelloTutorialConfig project version: '0.3') spec

As is often the case, the two packages share the same repository, so specifying a repository with
each package is redundant.

"! !

!MetacelloTutorialConfig methodsFor: 'baselines' stamp: 'dkh 3/18/2011 14:15:41'!
baseline07: spec 
	<version: '0.7-baseline'>
	
	spec for: #common do: [
		spec blessing: #baseline.
		spec repository: 'http://www.example.com/Example'.
		
		spec 
			package: 'Example-Core';
			package: 'Example-Tests' with: [ spec requires: 'Example-Core' ];
			package: 'Example-AddOn' with: [ spec requires: 'Example-Core' ] ].
! !

!MetacelloTutorialConfig methodsFor: 'lessons' stamp: 'dkh 3/18/2011 14:15:41'!
lesson11Descripton
"  [ see method: #version11: ]
A description can be defined for a version:

	(MetacelloTutorialConfig project version: '1.1') description.

"! !

!MetacelloTutorialConfig methodsFor: 'lessons' stamp: 'dkh 3/18/2011 14:15:41'!
lesson12DoIts
"  [ see methods: #version12: #preloadForCore #postloadForCore:package: ]
Occassionally, you find that you need to perform an expression either before a package is loaded, or
after a package is loaded. To do that in Metacello, you can define a preLoadDoIt selector and a 
postLoadDoIt selector:

	(MetacelloTutorialConfig project version: '1.2') spec.

If you open a Transcript and execute the following expression, you will see that the pre load and
post load methods were executed:

	(MetacelloTutorialConfig project version: '1.2') load.

The pre/post load methods may take 0, 1 or 2 args. The loader is the first optional argument and the 
loaded packageSpec is the second optional argument.
"! !

!MetacelloTutorialConfig methodsFor: 'versions' stamp: 'dkh 3/18/2011 14:15:41'!
version03: spec 
	<version: '0.3'>
	
	spec for: #common do: [
		spec 
			package: 'Example-Core' with: [
				spec 
					file: 'Example-Core-anon.10';
					repository: 'http://www.example.com/Example' ];
			package: 'Example-Tests' with: [
				spec 
					file: 'Example-Tests-anon.3';
					repository: 'http://www.example.com/Example' ]].
! !

!MetacelloTutorialConfig methodsFor: 'versions' stamp: 'dkh 3/18/2011 14:15:41'!
version07: spec 
	<version: '0.7' imports: #('0.7-baseline')>
	
	spec for: #common do: [
		spec 
			package: 'Example-Core' with: 'Example-Core-anon.12';
			package: 'Example-Tests' with: 'Example-Tests-anon.3';
			package: 'Example-AddOn' with: 'Example-AddOn-anon.1' ].
! !

!MetacelloTutorialConfig methodsFor: 'versions' stamp: 'dkh 3/18/2011 14:15:41'!
version12: spec 
	<version: '1.2' imports: #('1.0-baseline')>
	
	spec for: #common do: [
		spec blessing: #development.
		spec description: 'Add in doits for Example-Core'.
		spec author: 'dkh'.
		spec timestamp: '10/12/2009 09:26'.
		spec 
			package: 'Example-Core' with: [
				spec 
					file: 'Example-Core-anon.16';
					preLoadDoIt: #preloadForCore;
					postLoadDoIt: #postloadForCore:package: ];
			package: 'Example-Tests' with: 'Example-Tests-anon.5';
			package: 'Example-AddOn' with: 'Example-AddOn-anon.1';
			package: 'Example-AddOnTests' with: 'Example-AddOnTests-anon.1' ].
! !

!MetacelloTutorialConfig class methodsFor: 'accessing' stamp: 'dkh 3/18/2011 14:15:41'!
project

	^self new project! !

!MetacelloTutorialConfig class methodsFor: 'private' stamp: 'dkh 3/18/2011 14:15:41'!
ensureMetacello
	"Bootstrap Gofer (if necessary), bootstrap ConfigurationOfMetacello (using old Gofer API), then load the latest 
	version of Metacello itself."

	Smalltalk at: #MetacelloProject ifAbsent: [
		Smalltalk at: #Gofer ifAbsent: [
			"Current version of Gofer from which to bootstrap - as of 1.0-beta.15"
			self bootstrapPackage: 'Gofer-lr.83' from: 'http://seaside.gemstone.com/ss/metacello' ].
		Smalltalk at: #Gofer ifPresent: [:goferClass | | gofer |
			gofer := goferClass new
				url: 'http://seaside.gemstone.com/ss/metacello';
				yourself.
			[ gofer addPackage: 'ConfigurationOfMetacello' ] on: Warning do: [:ex | ex resume ].
			gofer load ].
		"load 'default' group of Metacello"
		(Smalltalk at: #ConfigurationOfMetacello) perform: #load ]! !

!MetacelloTutorialConfig class methodsFor: 'metacello tool support' stamp: 'dkh 3/18/2011 14:15:41'!
isMetacelloConfig
	"Answer true and the Metacello tools will operate on you"
	
	^true! !

!MetacelloTutorialConfig class methodsFor: 'private' stamp: 'dkh 3/18/2011 14:15:41'!
bootstrapPackage: aString from: aPath 
	| repository version |
	repository := MCHttpRepository
				location: aPath
				user: ''
				password: ''.
	repository
		versionReaderForFileNamed: aString , '.mcz'
		do: [:reader | 
			version := reader version.
			version load.
			version workingCopy repositoryGroup addRepository: repository]! !

!MetacelloValidationCriticalWarning commentStamp: '<historical>'!
MetacelloValidationCriticalWarning indicates that there is a logical inconsistency that may not be intentional and that could cause incorrect loads!
!MetacelloValidationCriticalWarning methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
label

	^'Critical Warning'! !

!MetacelloValidationCriticalWarning methodsFor: 'testing' stamp: 'dkh 6/5/2012 19:01:24'!
isCriticalWarning

	^true! !

!MetacelloValidationError commentStamp: '<historical>'!
MetacelloValidationError indicates that errors are to be expected if an attempt to use the configuration/version is made!
!MetacelloValidationError methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
label

	^'Error'! !

!MetacelloValidationError methodsFor: 'testing' stamp: 'dkh 6/5/2012 19:01:24'!
isError

	^true! !

!MetacelloValidationFailure methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
issues
	^ issues! !

!MetacelloValidationFailure methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
issues: anObject
	issues := anObject! !

!MetacelloValidationFailure class methodsFor: 'instance creation' stamp: 'dkh 6/5/2012 19:01:24'!
issues: anObject message: aString
    ^ self new
        issues: anObject;
        signal: aString! !

!MetacelloValidationIssue methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
explanation
	^ explanation! !

!MetacelloValidationIssue methodsFor: 'testing' stamp: 'dkh 6/5/2012 19:01:24'!
isError

	^false! !

!MetacelloValidationIssue methodsFor: 'testing' stamp: 'dkh 6/5/2012 19:01:24'!
isCritical

	^self isError or: [ self isCriticalWarning ]! !

!MetacelloValidationIssue methodsFor: 'testing' stamp: 'dkh 6/5/2012 19:01:24'!
isWarning

	^false! !

!MetacelloValidationIssue methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
configurationClass: aClass
	configurationClass := aClass! !

!MetacelloValidationIssue methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
callSite: anObject
	callSite := anObject! !

!MetacelloValidationIssue methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
reasonCode

	reasonCode == nil ifTrue: [ reasonCode := #none ].
	^ reasonCode! !

!MetacelloValidationIssue methodsFor: 'testing' stamp: 'dkh 6/5/2012 19:01:24'!
isCriticalWarning

	^false! !

!MetacelloValidationIssue methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
configurationClass
	^ configurationClass! !

!MetacelloValidationIssue methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
callSite
	^ callSite! !

!MetacelloValidationIssue methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
label

	^''! !

!MetacelloValidationIssue methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
printOn: aStream
	aStream
		nextPutAll: self label;
		nextPut: $:;
		space;
		nextPutAll: self explanation.
	self reasonCode ~~ #none
		ifTrue: [ 
			aStream
				space;
				nextPut: ${;
				space;
				nextPutAll: self reasonCode asString;
				space;
				nextPut: $} ].
	(self configurationClass ~~ nil or: [ self callSite ~~ nil ])
		ifTrue: [ 
			aStream
				space;
				nextPut: $[;
				space.
			self configurationClass ~~ nil
				ifTrue: [ 
					aStream
						nextPutAll: self configurationClass name asString;
						space ].
			self callSite ~~ nil
				ifTrue: [ 
					aStream
						nextPutAll: self callSite name asString;
						space ].
			aStream nextPut: $] ]! !

!MetacelloValidationIssue methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
reasonCode: anObject
	reasonCode := anObject! !

!MetacelloValidationIssue methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
explanation: aString
	explanation := aString! !

!MetacelloValidationIssue class methodsFor: 'instance creation' stamp: 'dkh 6/5/2012 19:01:24'!
configurationClass: aClass reasonCode: aSymbol callSite: aCallSite explanation: aString

	^(self new)
		configurationClass: aClass;
		reasonCode: aSymbol;
		callSite: aCallSite;
		explanation: aString;
		yourself! !

!MetacelloValidationNotification methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
issue: anObject
	issue := anObject! !

!MetacelloValidationNotification methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
issue
	^ issue! !

!MetacelloValidationNotification methodsFor: 'signaling' stamp: 'dkh 6/5/2012 19:01:24'!
signal: aMetacelloValidationIssue

	self issue: aMetacelloValidationIssue.
	^ self signal! !

!MetacelloValidationNotification class methodsFor: 'exceptioninstantiator' stamp: 'dkh 6/5/2012 19:01:24'!
signal: aMetacelloValidationIssue

	^ self new signal: aMetacelloValidationIssue! !

!MetacelloValidationWarning commentStamp: '<historical>'!
MetacelloValidationWarning indicates that there is a logical inconsistency that is not likely to cause any functional problems!
!MetacelloValidationWarning methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
label

	^'Warning'! !

!MetacelloValidationWarning methodsFor: 'testing' stamp: 'dkh 6/5/2012 19:01:24'!
isWarning

	^true! !

!MetacelloValueHolderSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
value
	^ value! !

!MetacelloValueHolderSpec methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
setDescriptionInMetacelloVersion: aMetacelloVersionSpec

	aMetacelloVersionSpec setDescription: self! !

!MetacelloValueHolderSpec methodsFor: 'merging' stamp: 'dkh 6/5/2012 19:01:24'!
mergeMap

	| map |
	map := super mergeMap.
	map at: #value put: value.
	^map! !

!MetacelloValueHolderSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
value: anObject
	value := anObject! !

!MetacelloValueHolderSpec methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
setPreLoadDoItInMetacelloSpec: aMetacelloSpec

	aMetacelloSpec setPreLoadDoIt: self! !

!MetacelloValueHolderSpec methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
setAuthorInMetacelloVersion: aMetacelloVersionSpec

	aMetacelloVersionSpec setAuthor: self! !

!MetacelloValueHolderSpec methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
setBlessingInMetacelloVersion: aMetacelloVersionSpec

	aMetacelloVersionSpec setBlessing: self! !

!MetacelloValueHolderSpec methodsFor: 'construction' stamp: 'dkh 6/5/2012 19:01:24'!
value: anObject constructor: aVersionConstructor
    aVersionConstructor valueForValueHolder: anObject! !

!MetacelloValueHolderSpec methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
setPostLoadDoItInMetacelloSpec: aMetacelloSpec

	aMetacelloSpec setPostLoadDoIt: self! !

!MetacelloValueHolderSpec methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
setTimestampInMetacelloVersion: aMetacelloVersionSpec

	aMetacelloVersionSpec setTimestamp: self! !

!MetacelloValueHolderSpec methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
configMethodOn: aStream indent: indent

	aStream tab: indent; nextPutAll: 'spec value: ', self value printString! !

!MetacelloValueHolderSpecTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testValueHolderSpec
    | valueHolder |
    valueHolder := self valueHolderSpec
        value: 'an Object';
        yourself.
    self assert: valueHolder value = 'an Object'! !

!MetacelloValueHolderSpecTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testValueHolderMergeSpec
    | valueHolderA valueHolderB valueHolder |
    valueHolderA := self valueHolderSpec
        value: 'an Object';
        yourself.
    valueHolderB := self valueHolderSpec
        value: 1.1;
        yourself.
    valueHolder := valueHolderA mergeSpec: valueHolderB.
    self assert: valueHolder value = 1.1! !

!MetacelloVersion methodsFor: 'querying' stamp: 'dkh 9/11/2012 10:16'!
projects
	"Answers the list of projects associated with this version"

	| projects |
	projects := OrderedCollection new.
	self spec projectDo: [:prj | projects add: prj projectReference ] packageDo: [:ignored | ] groupDo: [:ignored | ].
	^projects
! !

!MetacelloVersion methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
description
    ^ self basicSpec description value! !

!MetacelloVersion methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 11/14/2014 21:58'!
gtInspectorPackagesIn: composite
	<gtInspectorPresentationOrder: 40>
	composite list
		title: 'Packages';
		display: [ self spec packages packageSpecsInLoadOrder select: [ :each | 
				each isKindOf: MetacelloPackageSpec ] ]! !

!MetacelloVersion methodsFor: 'comparing' stamp: 'dkh 6/5/2012 19:01:24'!
~> aMetacelloVersion

	aMetacelloVersion species = self species ifFalse: [ ^false ].
	^self versionNumber ~> aMetacelloVersion versionNumber! !

!MetacelloVersion methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
versionStatus

	versionStatus == nil ifTrue: [ versionStatus := self computeVersionStatus].
	^versionStatus! !

!MetacelloVersion methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 11/23/2014 20:53'!
allProjects
	| all |
	all := OrderedCollection new.
	self allProjectsDo: [ :each |
		all add: each ].
	^ all! !

!MetacelloVersion methodsFor: 'comparing' stamp: 'dkh 6/5/2012 19:01:24'!
< aMetacelloVersion

	aMetacelloVersion species = self species ifFalse: [ ^false ].
	^self versionNumber < aMetacelloVersion versionNumber! !

!MetacelloVersion methodsFor: 'testing' stamp: 'dkh 6/5/2012 19:01:24'!
isAllLoadedToSpec
	"all projects and packages are loaded and match specification"
	
	^self spec isAllLoadedToSpec! !

!MetacelloVersion methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
importedVersions: aCollection

	importedVersions := aCollection! !

!MetacelloVersion methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
project
    ^ self basicSpec project! !

!MetacelloVersion methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
projectLabel
    ^ self basicSpec projectLabel! !

!MetacelloVersion methodsFor: 'querying' stamp: 'dkh 9/11/2012 10:35'!
packageNamed: aString

	^self packageNamed: aString ifAbsent: [ ^nil ].
! !

!MetacelloVersion methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 11/13/2014 08:34'!
gtInspectorProjectsIn: composite
	<gtInspectorPresentationOrder: 40>
	composite list
		title: 'Projects';
		display: [ self projects ]! !

!MetacelloVersion methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
spec: aMetacellVersionSpec

	spec := aMetacellVersionSpec! !

!MetacelloVersion methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
versionString

	^self versionNumber versionString! !

!MetacelloVersion methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 11/23/2014 21:01'!
allProjectsDo: aBlock
	self allProjectsDo: aBlock withTraversedProjects: OrderedCollection new! !

!MetacelloVersion methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
versionSpec

	^self spec! !

!MetacelloVersion methodsFor: 'querying' stamp: 'dkh 9/11/2012 11:53'!
difference: aMetacelloVersion
	"Return a a dictionary of additions, removals and modifications"
	
	^self spec difference: aMetacelloVersion spec! !

!MetacelloVersion methodsFor: 'testing' stamp: 'dkh 6/5/2012 19:01:24'!
isLoadedMatchConstraints
	"all loaded projects and packages match constraints"
	
	^self spec isLoadedMatchConstraints! !

!MetacelloVersion methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
loader

	^self spec loader! !

!MetacelloVersion methodsFor: 'actions' stamp: 'dkh 6/5/2012 19:01:24'!
load: required

	^self subclassResponsibility! !

!MetacelloVersion methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
timestamp
    ^ self basicSpec timestamp value! !

!MetacelloVersion methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
basicSpec
    ^ self spec! !

!MetacelloVersion methodsFor: 'testing' stamp: 'dkh 6/5/2012 19:01:24'!
name

	^self versionString! !

!MetacelloVersion methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
spec

	^spec! !

!MetacelloVersion methodsFor: 'querying' stamp: 'dkh 9/11/2012 10:16'!
groups
	"Answers the list of groups associated with this version"
	
	| groups |
	groups := OrderedCollection new.
	self spec projectDo: [:ignored | ] packageDo: [:ignored | ] groupDo: [:grp | groups add: grp ].
	^groups
! !

!MetacelloVersion methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
blessing
    ^ self basicSpec blessing value! !

!MetacelloVersion methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
versionNumber: aVersionNumber

	versionNumber := aVersionNumber! !

!MetacelloVersion methodsFor: 'testing' stamp: 'dkh 6/5/2012 19:01:24'!
isSomethingLoaded
	"at least one project or package has been loaded"
	
	^self spec isSomethingLoaded! !

!MetacelloVersion methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
versionKey
    "version printString, without the versionStatus decorations, suitable for using as a unique key for the 
	 receiver in a dictionary"

    ^ String
        streamContents: [ :aStream | 
            | label |
            self versionNumber printOn: aStream.
            self basicSpec ~~ nil
                ifTrue: [ 
                    (label := self projectLabel) isEmpty
                        ifFalse: [ aStream nextPutAll: ' [' , label , ']' ] ] ]! !

!MetacelloVersion methodsFor: 'querying' stamp: 'dkh 9/11/2012 12:09'!
expandToLoadableSpecNames: nameList
	"Just like #resolveToLoadableSpecs:, but returns list of spec names instead of specs"
	
	^self spec expandToLoadableSpecNames: nameList! !

!MetacelloVersion methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 11/23/2014 21:30'!
allProjectsDo: aBlock withTraversedProjects: aCollection
	self projects do: [ :each |
		(each version notNil and: [(aCollection includes: each version) not]) 
		ifTrue: [
			aCollection add: each version.
			aBlock value: each version.
			each version allProjectsDo: aBlock withTraversedProjects: aCollection ] ]! !

!MetacelloVersion methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
printOn: aStream
    | label vs |
    (#(structural broken) includes: self blessing) not
        ifTrue: [ 
            (vs := self versionStatus) == #'somethingLoaded'
                ifTrue: [ aStream nextPutAll: '<>' ].
            vs == #'loadedMatchConstraints'
                ifTrue: [ aStream nextPutAll: '>=' ].
            vs == #'loadedToSpec'
                ifTrue: [ aStream nextPut: $~ ] ].
    self versionNumber printOn: aStream.
    self basicSpec ~~ nil
        ifTrue: [ 
            (label := self projectLabel) isEmpty
                ifFalse: [ aStream nextPutAll: ' [' , label , ']' ] ]
! !

!MetacelloVersion methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
versionStatus: aSymbol

	versionStatus := aSymbol! !

!MetacelloVersion methodsFor: 'actions' stamp: 'dkh 6/5/2012 19:01:24'!
load

	^self subclassResponsibility! !

!MetacelloVersion methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/26/2015 21:00'!
spotterForGroupsFor: aStep
	<spotterOrder: 2>
	aStep listProcessor
		title: 'Groups';
		allCandidates: [ self groups ];
		itemName: [ :item | item name ];
		filter: GTFilterSubstring;
		wantsToDisplayOnEmptyQuery: true! !

!MetacelloVersion methodsFor: 'actions' stamp: 'dkh 6/5/2012 19:01:24'!
unload

	^self spec unload! !

!MetacelloVersion methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
versionNumber

	^versionNumber! !

!MetacelloVersion methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
importedVersions

	importedVersions == nil ifTrue: [ importedVersions := #() ].
	^importedVersions! !

!MetacelloVersion methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/26/2015 21:00'!
spotterForPackagesFor: aStep
	<spotterOrder: 3>
	aStep listProcessor
		title: 'Packages';
		allCandidates: [ self packages ];
		itemName: [ :item | item file ];
		filter: GTFilterSubstring;
		wantsToDisplayOnEmptyQuery: true! !

!MetacelloVersion methodsFor: 'testing' stamp: 'dkh 6/5/2012 19:01:24'!
isPossibleBaseline

	^self spec isPossibleBaseline! !

!MetacelloVersion methodsFor: 'comparing' stamp: 'dkh 6/5/2012 19:01:24'!
hash

	^self versionNumber hash! !

!MetacelloVersion methodsFor: 'querying' stamp: 'dkh 9/11/2012 10:35'!
packageNamed: aString ifAbsent: aBlock

	| pkg |
	(pkg := self spec packageNamed: aString ifAbsent: []) == nil
		ifTrue: [ ^aBlock value ].
	^pkg referencedSpec! !

!MetacelloVersion methodsFor: 'querying' stamp: 'dkh 9/11/2012 11:40'!
resolveToLoadableSpecs: nameList
	"Resolves names in namelist to the  list of packages and projects in the version that would be loaded. Projects are 
	not traversed during the transitive closure. The scope is that of the version itself.
	   If the spec is a package, answer a list including the package and the transitive closure on 
			its #requires: and #includes: fields.
	   If the spec is a project, answer the project.
	   If the spec is a group, answers the list of packages in the #includes: field of the group. 
			Groups in the #includes: field are expanded following the transitive closure on groups"

	^self spec resolveToLoadableSpecs: nameList! !

!MetacelloVersion methodsFor: 'private' stamp: 'dkh 9/10/2012 15:43'!
computeVersionStatus
    ^ #'noStatus'! !

!MetacelloVersion methodsFor: 'querying' stamp: 'dkh 6/22/2012 12:38'!
versionNumberFrom: aString
    ^ self versionNumber class fromString: aString! !

!MetacelloVersion methodsFor: 'comparing' stamp: 'dkh 6/5/2012 19:01:24'!
= aMetacelloVersion

	aMetacelloVersion species = self species ifFalse: [ ^false ].
	^self versionNumber = aMetacelloVersion versionNumber! !

!MetacelloVersion methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
author

	^self spec author value! !

!MetacelloVersion methodsFor: 'testing' stamp: 'dkh 6/5/2012 19:01:24'!
isLoadedToSpec
	"all loaded projects and packages match specifications"
	
	^self spec isLoadedToSpec! !

!MetacelloVersion class methodsFor: 'instance creation' stamp: 'dkh 6/22/2012 12:34'!
fromSpec: aMetacelloVersionSpec
    ^ (self new versionNumber: aMetacelloVersionSpec versionNumber)
        spec: aMetacelloVersionSpec;
        yourself! !

!MetacelloVersion class methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/26/2015 17:53'!
gtExampleMetacelloVersion
	<gtExample: 'Metacello Version'>
	^ ConfigurationOfGTSpotter project version: #development! !

!MetacelloVersion class methodsFor: 'instance creation' stamp: 'dkh 6/5/2012 19:01:24'!
fromString: aString

	^self new versionNumber: aString asMetacelloVersionNumber! !

!MetacelloVersionConstructor methodsFor: 'deprecated' stamp: 'dkh 6/5/2012 19:01:24'!
prepareForMethodUpdate: aConfig sourceVersion: sourceVersionString forceUpdate: forceUpdate generating: generateBlock
	| pragmaDict versionSpecs pragmaMap updatedPackageSpecs updatedPackageSpecsMap reversed pragmaColl seenUpdatedPackageSpecs |
	self deprecated: 'see MetacelloToolBox for replacement methods'.
	self configuration: aConfig.
	versionSpecs := Dictionary new.
	pragmaMap := Dictionary new.
	pragmaDict := self extractAllVersionPragmas.
	pragmaColl := pragmaDict at: sourceVersionString ifAbsent: [ ^ self ].
	pragmaColl
		do: [ :pragma | 
			| specs versionSpec |
			specs := Dictionary new.
			self evaluatePragma: pragma.
			self attributeMap
				keysAndValuesDo: [ :attribute :blockList | 
					versionSpec := self project versionSpec.
					versionSpec versionString: sourceVersionString.
					specs at: attribute put: versionSpec.
					blockList do: [ :block | self with: versionSpec during: block ] ].
			versionSpecs
				at: pragma selector
				put:
					{specs.
					(self attributeOrder).
					nil}.
			pragmaMap at: pragma selector put: pragma.
			self reset ].
	versionSpecs
		keysAndValuesDo: [ :selector :ar | 
			updatedPackageSpecsMap := Dictionary new.
			seenUpdatedPackageSpecs := Dictionary new.
			ar at: 3 put: updatedPackageSpecsMap.
			reversed := aConfig project attributes reverse.
			reversed
				do: [ :attribute | 
					| vs |
					(vs := (ar at: 1) at: attribute ifAbsent: [  ]) ~~ nil
						ifTrue: [ 
							updatedPackageSpecs := forceUpdate
								ifTrue: [ vs forceUpdatedPackageSpecs ]
								ifFalse: [ vs updatedPackageSpecs ].
							updatedPackageSpecs associations
								do: [ :assoc | 
									| filename |
									(filename := seenUpdatedPackageSpecs at: assoc key ifAbsent: [  ]) == nil
										ifTrue: [ 
											assoc value == #uptodate
												ifTrue: [ 
													"#uptodate means that the spec is up-to-date and we mark it as
										 seen so that the spec is not update for a 'later' spec"
													seenUpdatedPackageSpecs at: assoc key put: #uptodate ]
												ifFalse: [ seenUpdatedPackageSpecs at: assoc key put: assoc value file ] ]
										ifFalse: [ 
											"if the spec was already seen as up-to-date or the file is the same as 
								 the one already seen don't propogate the file"
											(filename == #uptodate or: [ assoc value == #uptodate or: [ filename = assoc value file ] ])
												ifTrue: [ updatedPackageSpecs removeKey: assoc key ] ] ].
							updatedPackageSpecsMap at: attribute put: updatedPackageSpecs ] ].	"clear out #uptodate markers"
			updatedPackageSpecsMap
				valuesDo: [ :d | 
					d associations
						do: [ :assoc | 
							assoc value == #uptodate
								ifTrue: [ d removeKey: assoc key ] ] ].	"remove shadowed packages"
			1 to: reversed size do: [ :index | 
				| attribute d |
				attribute := reversed at: index.
				((d := updatedPackageSpecsMap at: attribute ifAbsent: [  ]) ~~ nil and: [ d keys size > 0 ])
					ifTrue: [ 
						index + 1 to: reversed size do: [ :shadowIndex | 
							d
								keysDo: [ :key | 
									| dict |
									(dict := updatedPackageSpecsMap at: (reversed at: shadowIndex) ifAbsent: [  ]) ~~ nil
										ifTrue: [ dict removeKey: key ifAbsent: [  ] ] ] ] ] ].
			updatedPackageSpecsMap keys
				do: [ :key | 
					| d |
					d := updatedPackageSpecsMap at: key.
					d isEmpty
						ifTrue: [ updatedPackageSpecsMap removeKey: key ] ].	"ready to generate source for method"
			generateBlock
				value: selector
				value: pragmaMap
				value: ar
				value: updatedPackageSpecsMap ]! !

!MetacelloVersionConstructor methodsFor: 'initialization' stamp: 'dkh 6/22/2012 12:43'!
calculate: aConfig project: aProject
    | versionMap symbolicVersionMap executionBlock pragmaDict |
    self setProject: aProject.
    self configuration: aConfig.
    versionMap := Dictionary new.
    symbolicVersionMap := Dictionary new.
    executionBlock := self specResolverBlock.
    self collectAllVersionsFromVersionPragmasInto: versionMap using: executionBlock.
    pragmaDict := self extractVersionImportPragmas.
    self verifyVersionImportPragmas: pragmaDict definedIn: versionMap.
    self collectAllVersionsFromVersionImportPragmasInto: versionMap using: executionBlock satisfiedPragmas: pragmaDict.
    self collectAllSymbolicVersionsFromVersionPragmasInto: symbolicVersionMap using: self symbolicVersionResolverBlock.
    self project map: versionMap.
    self project errorMap: self errorMap.
    self project symbolicVersionMap: symbolicVersionMap.
    self project configuration: aConfig.	"now that we have a nearly complete project, we can collect the defaultSymbolicVersions, which expect the project to be fully constructed"
    self
        collectDefaultSymbolicVersionsFromVersionPragmasFrom: self extractDefaultSymbolicVersionPragmas
        into: symbolicVersionMap
        using: self defaultSymbolicVersionResolverBlock.	"Pick up defaults from MetacelloBaseConfiguration"
    self
        collectDefaultSymbolicVersionsFromVersionPragmasFrom: self extractCommonDefaultSymbolicVersionPragmas
        into: symbolicVersionMap
        using: self commonDefaultSymbolicVersionResolverBlock.	"now resolive symbolicVersions defined as symbolicVersions"
    symbolicVersionMap copy
        keysAndValuesDo: [ :symbolic :original | 
            | versionString visited |
            versionString := original.
            visited := Set new.
            [ 
            visited add: versionString.
            versionString isSymbol and: [ versionString ~~ #'notDefined' ] ]
                whileTrue: [ 
                    versionString := symbolicVersionMap
                        at: versionString
                        ifAbsent: [ self error: 'Cannot resolve symbolic version ' , original printString ].
                    (visited includes: versionString)
                        ifTrue: [ self error: 'Loop detected resolving symbolic version ' , original printString ] ].
            symbolicVersionMap at: symbolic put: versionString ]! !

!MetacelloVersionConstructor methodsFor: 'initialization' stamp: 'dkh 6/5/2012 19:01:24'!
on: aConfig project: aProject
    | cacheKey cachedProject |
    cacheKey := aConfig class.
    cachedProject := MetacelloPlatform current
        stackCacheFor: #'versionConstructor'
        at: cacheKey
        doing: [ :cache | 
            self calculate: aConfig project: aProject.
            cache at: cacheKey put: self project.
            ^ self ].
    aProject map: cachedProject map.
    aProject errorMap: cachedProject errorMap.
    aProject symbolicVersionMap: cachedProject symbolicVersionMap.
    aProject configuration: aConfig.
    self setProject: aProject! !

!MetacelloVersionConstructor methodsFor: 'deprecated' stamp: 'dkh 6/5/2012 19:01:24'!
spawnPackageMethodIn: aConfig category: methodCategory named: newSelector sourceVersion: sourceVersionString targetVersion: targetVersionString blessing: blessing

	self deprecated: 'see MetacelloToolBox class>>createBaseline:for:from:description: for replacement method'.
	self 
		prepareForMethodUpdate: aConfig 
		sourceVersion: sourceVersionString 
		forceUpdate: blessing ~~ #baseline
		generating: [:selector :pragmaMap :ar :updatedPackageSpecsMap | | strm |
			strm := WriteStream on: String new.
			strm 
				nextPutAll: newSelector asString, ' spec'; cr;
				tab; nextPutAll: 
						'<version: ', 
						targetVersionString printString, 
						' imports: #(', sourceVersionString printString, 
						')>';cr.
			(ar at: 2) do: [:attribute | | vs d |
				vs := (ar at: 1) at: attribute.
				(d := updatedPackageSpecsMap at: attribute ifAbsent: []) ~~ nil
					ifTrue: [ 
						vs packagesSpec list do: [:member | | x |
							x := d at: member spec name ifAbsent: [].
						 	member spec updateForSpawnMethod: x ]]
					ifFalse: [
						vs packagesSpec list do: [:member |
							member spec updateForSpawnMethod: member spec copy ]].
				strm cr; tab; nextPutAll: 'spec for: ', attribute printString, ' do: ['; cr.
				attribute == #common
					ifTrue: [
						vs 
							author: MetacelloPlatform current authorName;
							timestamp: MetacelloPlatform current timestamp.
						blessing ~~ nil
							ifTrue: [ vs blessing: blessing ]].
				vs configSpawnMethodOn: strm indent: 2.
				strm nextPutAll: '].'].
				(aConfig class	
					compile: strm contents
					classified: methodCategory) == nil 
						ifTrue: [ self error: 'Error compiling the method' ]].
	^true
! !

!MetacelloVersionConstructor methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
symbolicVersionResolverBlock
	^ [ :symbolicVrsn :pragma | 
	| result |
	result := nil.
	(pragma argumentAt: 1) = symbolicVrsn
		ifTrue: [ 
			self symbolicVersion: symbolicVrsn.
			self evaluatePragma: pragma.
			self project attributes
				do: [ :attribute | 
					| versionString |
					versionString := self attributeMap at: attribute ifAbsent: [  ].
					versionString ~~ nil
						ifTrue: [ result := versionString ] ] ].
	result ]! !

!MetacelloVersionConstructor methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
collectAllVersionsFromVersionPragmasInto: versionMap using: executionBlock
    | defined versionPragmaDict |
    versionPragmaDict := self extractVersionPragmas.
    versionPragmaDict
        keysAndValuesDo: [ :versionString :pragmaColl | 
            | versionSpec |
            versionSpec := self project versionSpec.
            versionSpec versionString: versionString.
            defined := false.
            [ 
            pragmaColl
                do: [ :pragma | 
                    executionBlock value: versionSpec value: pragma.
                    defined := true ] ]
                on: Error
                do: [ :ex | 
                    (MetacelloErrorInProjectConstructionNotification versionString: versionSpec versionString exception: ex)
                        ifTrue: [ ^ ex pass ]
                        ifFalse: [ 
                            self errorMap at: versionSpec versionString put: ex.
                            defined := false ] ].
            defined
                ifTrue: [ 
                    self validateVersionString: versionString againstSpec: versionSpec.
                    versionMap at: versionSpec versionString put: versionSpec createVersion ].
            self reset ]! !

!MetacelloVersionConstructor methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
defaultSymbolicVersionResolverBlock: receiver
	^ [ :symbolicVrsn :pragma | 
	| result |
	result := nil.
	(pragma argumentAt: 1) = symbolicVrsn
		ifTrue: [ 
			self symbolicVersion: symbolicVrsn.
			result := [ receiver perform: pragma selector ] on: MetacelloVersionDoesNotExistError do: [ :ex | ex return: nil ] ].
	result ]! !

!MetacelloVersionConstructor methodsFor: 'private' stamp: 'dkh 9/6/2012 03:05'!
collectAllVersionsFromVersionImportPragmasInto: versionMap using: executionBlock satisfiedPragmas: pragmaDict
    | defined done completed count |
    done := false.
    completed := IdentitySet new.
    count := 0.
    [ 
    count := count + 1.
    count > 10000
        ifTrue: [ self error: 'Apparent loop in import expansion' ].
    done ]
        whileFalse: [ 
            done := true.
            pragmaDict
                keysAndValuesDo: [ :versionString :pragmaColl | 
                    | versionSpec |
                    versionSpec := nil.
                    defined := false.
                    [ 
                    pragmaColl
                        do: [ :pragma | 
                            (completed includes: pragma)
                                ifFalse: [ 
                                    | imports |
                                    done := false.
                                    imports := pragma argumentAt: 2.
                                    imports
                                        detect: [ :importedVersion | (versionMap includesKey: importedVersion) not ]
                                        ifNone: [ 
                                            imports
                                                do: [ :importedVersion | 
                                                    | version |
                                                    (version := versionMap at: importedVersion ifAbsent: [  ]) ~~ nil
                                                        ifTrue: [ 
                                                            defined := true.
                                                            completed add: pragma.
                                                            versionSpec == nil
                                                                ifTrue: [ versionSpec := version spec copy ]
                                                                ifFalse: [ versionSpec := versionSpec mergeSpec: version spec copy ].
                                                            versionSpec versionString: versionString.
                                                            executionBlock value: versionSpec value: pragma ] ] ] ] ] ]
                        on: Error
                        do: [ :ex | 
                            (MetacelloErrorInProjectConstructionNotification versionString: versionSpec versionString exception: ex)
                                ifTrue: [ ^ ex pass ]
                                ifFalse: [ 
                                    self errorMap at: versionSpec versionString put: ex.
                                    done := true.
                                    defined := false ] ].
                    defined
                        ifTrue: [ 
                            | version importedVersions |
                            importedVersions := OrderedCollection new.
                            version := versionSpec createVersion.
                            pragmaColl do: [ :pragma | importedVersions addAll: (pragma argumentAt: 2) ].
                            version importedVersions: importedVersions.
                            self validateVersionString: versionString againstSpec: versionSpec.
                            versionMap at: versionSpec versionString put: version ].
                    self reset ] ]! !

!MetacelloVersionConstructor methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
errorMap
    errorMap ifNil: [ errorMap := Dictionary new ].
    ^ errorMap! !

!MetacelloVersionConstructor methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
verifyVersionImportPragmas: pragmaDict definedIn: versionMap
    pragmaDict copy
        keysAndValuesDo: [ :versionString :pragmaColl | 
            [ 
            pragmaColl
                do: [ :pragma | 
                    (pragma argumentAt: 2)
                        do: [ :importedVersion | 
                            versionMap
                                at: importedVersion
                                ifAbsent: [ 
                                    pragmaDict
                                        at: importedVersion
                                        ifAbsent: [ 
                                            ^ self
                                                error:
                                                    'The imported version:' , importedVersion printString , ' for version: ' , versionString
                                                        , ' referenced from the method: ' , pragma selector printString
                                                        , ' in configuration ' , configuration class printString
                                                        , ' has not been defined.' ] ] ] ] ]
                on: Error
                do: [ :ex | 
                    (MetacelloErrorInProjectConstructionNotification versionString: versionString exception: ex)
                        ifTrue: [ ^ ex pass ]
                        ifFalse: [ 
                            pragmaDict removeKey: versionString.
                            self errorMap at: versionString put: ex ] ] ]! !

!MetacelloVersionConstructor methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
collectAllSymbolicVersionsFromVersionPragmasInto: symbolicVersionMap using: executionBlock
	| defined versionPragmaDict versionString |
	versionPragmaDict := self extractSymbolicVersionPragmas.
	versionPragmaDict
		keysAndValuesDo: [ :versionSymbol :pragmaColl | 
			defined := false.
			pragmaColl
				do: [ :pragma | 
					defined := true.
					versionString := executionBlock value: versionSymbol value: pragma ].
			defined
				ifTrue: [ 
					versionString == nil
						ifFalse: [ symbolicVersionMap at: versionSymbol put: versionString ]].
			self reset ]! !

!MetacelloVersionConstructor methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
commonDefaultSymbolicVersionResolverBlock
	^ self defaultSymbolicVersionResolverBlock: (ConfigurationOf new project: self project)
! !

!MetacelloVersionConstructor methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
defaultSymbolicVersionResolverBlock
	^ self defaultSymbolicVersionResolverBlock: self configuration
! !

!MetacelloVersionConstructor methodsFor: 'initialization' stamp: 'dkh 6/5/2012 19:01:24'!
on: aConfig

	| cacheKey |
	cacheKey := aConfig class.
	project := MetacelloPlatform current
		stackCacheFor: #versionConstructor
		at: cacheKey
		doing: [ :cache | 
			self calculate: aConfig project: nil.
			cache at: cacheKey put:  self project ].
	self setProject: project.! !

!MetacelloVersionConstructor methodsFor: 'deprecated' stamp: 'dkh 6/5/2012 19:01:24'!
updatePackageMethodIn: aConfig sourceVersion: sourceVersionString

	self deprecated: 'see MetacelloToolBox class>>updateDevelopment:for:updateProjects:description: for replacement method'.
	self 
		prepareForMethodUpdate: aConfig 
		sourceVersion: sourceVersionString 
		forceUpdate: false
		generating: [:selector :pragmaMap :ar :updatedPackageSpecsMap | | strm pragma |
			updatedPackageSpecsMap isEmpty ifTrue: [ ^false ].
			strm := WriteStream on: String new.
			strm 
				nextPutAll: selector asString, ' spec'; cr;
				tab; nextPutAll: '<version: ', sourceVersionString printString.
			pragma := pragmaMap at: selector.
			pragma numArgs = 2
				ifTrue: [
					strm nextPutAll: ' imports: #('.
					(pragma argumentAt: 2) do: [:versionString |
						strm nextPutAll: versionString printString; space ]].
			strm nextPutAll: ')>';cr.
			(ar at: 2) do: [:attribute | | vs d |
				vs := (ar at: 1) at: attribute.
				(d := updatedPackageSpecsMap at: attribute ifAbsent: []) ~~ nil
					ifTrue: [ 
						vs packagesSpec list do: [:member | 
							member spec file ~~ nil
								ifTrue: [ | x |
									(((x := d at: member spec name ifAbsent: []) ~~ nil) and: [ x ~~ #uptodate ])
						 				ifTrue: [ member spec file: x file ]]]].
				strm cr; tab; nextPutAll: 'spec for: ', attribute printString, ' do: ['; cr.
				attribute == #common
					ifTrue: [ 
						vs 
							author: MetacelloPlatform current authorName;
							timestamp: MetacelloPlatform current timestamp ].
				vs configMethodOn: strm indent: 2.
				strm nextPutAll: '].'].
			(aConfig class	
					compile: strm contents
					classified: (aConfig class whichCategoryIncludesSelector: pragma selector)) == nil
						ifTrue: [ self error: 'Error compiling the method' ]].
	^true
! !

!MetacelloVersionConstructor methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
specResolverBlock
	^ [ :versionSpec :pragma | 
	(pragma argumentAt: 1) = versionSpec versionString
		ifTrue: [ 
			self evaluatePragma: pragma.
			self project attributes
				do: [ :attribute | 
					| blockList |
					(blockList := self attributeMap at: attribute ifAbsent: [  ]) ~~ nil
						ifTrue: [ blockList do: [ :block | self with: versionSpec during: block ] ] ] ] ]! !

!MetacelloVersionConstructor methodsFor: 'validation' stamp: 'dkh 6/5/2012 19:01:24'!
validateVersionString: versionString againstSpec: versionSpec

	versionString = versionSpec versionString
		ifFalse: [ 
			MetacelloValidationNotification
				signal:
					(MetacelloValidationError
						configurationClass: self configurationClass
						reasonCode: #incorrectVersionString
						callSite: #validateVersionString:againstSpec
						explanation:
							'The version declared in the pragma ', versionString printString , ' does not match the version in the spec '
								, versionSpec versionString printString) ].
! !

!MetacelloVersionConstructor methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
collectDefaultSymbolicVersionsFromVersionPragmasFrom: versionPragmaDict into: symbolicVersionMap using: executionBlock
	| defined versionString |
	versionPragmaDict
		keysAndValuesDo: [ :versionSymbol :pragmaColl | 
			defined := false.
			symbolicVersionMap
				at: versionSymbol
				ifAbsent: [ 
					"process the defaultSymbolicVersion only if the symbolicVersion is not defined yet"
					pragmaColl
						do: [ :pragma | 
							defined := true.
							versionString := executionBlock value: versionSymbol value: pragma ].
					defined
						ifTrue: [ 
							versionString == nil
								ifFalse: [ symbolicVersionMap at: versionSymbol put: versionString ] ].
					self reset ] ]! !

!MetacelloVersionConstructor class methodsFor: 'instance creation' stamp: 'dkh 6/5/2012 19:01:24'!
on: aConfig

	^(self new)
		on: aConfig;
		yourself! !

!MetacelloVersionConstructor class methodsFor: 'instance creation' stamp: 'dkh 6/5/2012 19:01:24'!
on: aConfig project: aProject

	^(self new)
		on: aConfig project: aProject;
		yourself! !

!MetacelloVersionConstructor class methodsFor: 'deprecated' stamp: 'dkh 6/5/2012 19:01:24'!
spawnPackageMethodIn: aConfig category: methodCategory named: newSelector sourceVersion: sourceVersionString targetVersion: targetVersionString blessing: blessing

	self deprecated: 'see MetacelloToolBox class>>createDevelopment:for:importFromBaseline:description: for a similar example'.
	^self new
		spawnPackageMethodIn: aConfig 
		category: methodCategory 
		named: newSelector
		sourceVersion: sourceVersionString 
		targetVersion: targetVersionString
		blessing: blessing! !

!MetacelloVersionConstructor class methodsFor: 'deprecated' stamp: 'dkh 6/5/2012 19:01:24'!
updatePackageMethodIn: aConfig sourceVersion: sourceVersionString

	self deprecated: 'see MetacelloToolBox class>>updateDevelopment:for:updateProjects:description: for a similar example'.
	^self new
		updatePackageMethodIn: aConfig 
		sourceVersion: sourceVersionString! !

!MetacelloVersionConstructor class methodsFor: 'deprecated' stamp: 'dkh 6/5/2012 19:01:24'!
spawnPackageMethodIn: aConfig named: newSelector sourceVersion: sourceVersionString targetVersion: targetVersionString blessing: blessing

	self deprecated: 'see MetacelloToolBox class>>createDevelopment:for:importFromBaseline:description: for a similar example'.
	^self new
		spawnPackageMethodIn: aConfig 
		category: 'versions'
		named: newSelector 
		sourceVersion: sourceVersionString 
		targetVersion: targetVersionString
		blessing: blessing! !

!MetacelloVersionConstructor class methodsFor: 'deprecated' stamp: 'dkh 6/5/2012 19:01:24'!
spawnPackageMethodIn: aConfig named: newSelector sourceVersion: sourceVersionString targetVersion: targetVersionString

	self deprecated: 'see MetacelloToolBox class>>createDevelopment:for:importFromBaseline:description: for a similar example'.
	^self 
		spawnPackageMethodIn: aConfig 
		category: 'versions'
		named: newSelector 
		sourceVersion: sourceVersionString 
		targetVersion: targetVersionString 
		blessing: #development! !

!MetacelloVersionDefinitionError methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
exception: anObject
	exception := anObject! !

!MetacelloVersionDefinitionError methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
description
    "Return a textual description of the exception."

    ^ 'The version ' , self versionString printString , ' is not defined in ' , self project label
        , ' for the current platform, because an exception occurred while creating the version:. '
        , self exception description , '. Evaluate the following to see the error: ''['
        , self project configuration class name asString
        ,
            ' project ] 
	on: MetacelloErrorInProjectConstructionNotification 
	do: [:ex | ex resume: true ].'''
        ,
            '
Possible versions include: ' , self possibleVersions printString! !

!MetacelloVersionDefinitionError methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
exception
	^ exception! !

!MetacelloVersionDiffReport methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
modifications: anObject
	modifications := anObject! !

!MetacelloVersionDiffReport methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
to: anObject
	to := anObject! !

!MetacelloVersionDiffReport methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
from
	^ from! !

!MetacelloVersionDiffReport methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
configuration
	^ configuration! !

!MetacelloVersionDiffReport methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
modifications
	modifications ifNil: [ modifications := Dictionary new ].
	^ modifications! !

!MetacelloVersionDiffReport methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
configuration: anObject
	configuration := anObject! !

!MetacelloVersionDiffReport methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
from: anObject
	from := anObject! !

!MetacelloVersionDiffReport methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
removals
	removals ifNil: [ removals := Dictionary new ].
	^ removals! !

!MetacelloVersionDiffReport methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
additions: anObject
	additions := anObject! !

!MetacelloVersionDiffReport methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
removals: anObject
	removals := anObject! !

!MetacelloVersionDiffReport methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
to
	^ to! !

!MetacelloVersionDiffReport methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
additions
	additions ifNil: [ additions := Dictionary new ].
	^ additions! !

!MetacelloVersionDiffReport methodsFor: 'printing' stamp: 'dkh 6/8/2012 14:04:22'!
printOn: aStream
	| printBlock |
	printBlock := [ :pkgName :ar | 
	aStream
		tab: 2;
		nextPutAll: pkgName asString;
		cr.
	aStream
		tab: 3;
		nextPutAll: (ar at: 1) asString printString;
		nextPutAll: ' to ';
		nextPutAll: (ar at: 2) asString printString;
		cr ].
	aStream
		nextPutAll: self configuration asString;
		space;
		nextPutAll: from asString printString;
		nextPutAll: ' to ';
		nextPutAll: to asString printString;
		cr.
	aStream
		tab;
		nextPutAll: 'Additions:';
		cr.
	self additions keysAndValuesDo: printBlock.
	aStream
		tab;
		nextPutAll: 'Modifications:';
		cr.
	self modifications keysAndValuesDo: printBlock.
	aStream
		tab;
		nextPutAll: 'Removals:';
		cr.
	self removals keysAndValuesDo: printBlock! !

!MetacelloVersionDoesNotExistError methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
possibleVersions
    ^ self project symbolicVersionSymbols , (self project versions collect: [ :each | each versionString ])! !

!MetacelloVersionDoesNotExistError methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
project
	^ project! !

!MetacelloVersionDoesNotExistError methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
description
    "Return a textual description of the exception."

    ^ 'Version ' , self versionString printString , ' is not defined in ' , self project label
        , '. Possible versions include: ' , self possibleVersions printString! !

!MetacelloVersionDoesNotExistError methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
versionString
	^ versionString! !

!MetacelloVersionDoesNotExistError methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
project: anObject
	project := anObject! !

!MetacelloVersionDoesNotExistError methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
versionString: anObject
	versionString := anObject! !

!MetacelloVersionDoesNotExistError class methodsFor: 'instance creation' stamp: 'dkh 6/5/2012 19:01:24'!
project: aMetacelloProject versionString: aVersionString

	^(self new)
		project: aMetacelloProject;
		versionString: aVersionString;
		yourself! !

!MetacelloVersionLoadDirective methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
finalizeLoad: aGofer
	"nothing special for linear loads"! !

!MetacelloVersionLoadDirective methodsFor: 'enumerating' stamp: 'dkh 6/8/2012 14:04:22'!
directivesDo: aBlock

	aBlock value: self.
	self loadDirectives do: [:directive | directive directivesDo: aBlock ].! !

!MetacelloVersionLoadDirective methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
loadDirectives

	loadDirectives == nil ifTrue: [ loadDirectives := OrderedCollection new ].
	^ loadDirectives! !

!MetacelloVersionLoadDirective methodsFor: 'enumerating' stamp: 'dkh 6/8/2012 14:04:22'!
prepostLoadDirectivesDo: aBlock

	self loadDirectives do: [:directive | directive prepostLoadDirectivesDo: aBlock ].! !

!MetacelloVersionLoadDirective methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
loadPreloadDirective: aPreloadDirective 

	| block |
	(block :=  aPreloadDirective spec preLoadDoItBlock) ~~ nil
		ifTrue: [
			aPreloadDirective evaluateSupplyingAnswers: [ block valueWithPossibleArgs: 
					(Array 
						with: aPreloadDirective loader 
						with: aPreloadDirective spec) ].
			Transcript cr; show: 'Evaluated -> ', aPreloadDirective spec label, ' >> ', aPreloadDirective spec preLoadDoIt value asString]! !

!MetacelloVersionLoadDirective methodsFor: 'enumerating' stamp: 'dkh 6/8/2012 14:04:22'!
versionDirectivesDepthFirstDo: aBlock

	self loadDirectives do: [:directive | directive versionDirectivesDepthFirstDo: aBlock ].
	aBlock value: self.
! !

!MetacelloVersionLoadDirective methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
add: aDirective

	self loadDirectives add: aDirective! !

!MetacelloVersionLoadDirective methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
loadPackageDirective: aPackageLoadDirective gofer: aGofer

	aPackageLoadDirective loader loadingSpecLoader 
		loadPackageDirective: aPackageLoadDirective 
		gofer: aGofer! !

!MetacelloVersionLoadDirective methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
loadAtomicLoadDirective: aLoaderDirective gofer: aGofer

	aLoaderDirective loadDirectives do: [:directive | directive loadUsing: aLoaderDirective gofer: aGofer ].
	aLoaderDirective finalizeLoad: aGofer.! !

!MetacelloVersionLoadDirective methodsFor: 'enumerating' stamp: 'dkh 6/8/2012 14:04:22'!
versionDirectivesDo: aBlock

	aBlock value: self.
	self loadDirectives do: [:directive | directive versionDirectivesDo: aBlock ].! !

!MetacelloVersionLoadDirective methodsFor: 'enumerating' stamp: 'dkh 6/8/2012 14:04:22'!
packagesDo: aBlock

	self loadDirectives do: [:directive | directive packageDo: aBlock ].! !

!MetacelloVersionLoadDirective methodsFor: 'enumerating' stamp: 'dkh 6/8/2012 14:04:22'!
versionDo: aBlock

	aBlock value: self.
! !

!MetacelloVersionLoadDirective methodsFor: 'printing' stamp: 'dkh 6/8/2012 14:04:22'!
printOn: aStream indent: indent

	super printOn: aStream indent: indent.
	self printLoadDirectivesOn: aStream indent: indent! !

!MetacelloVersionLoadDirective methodsFor: 'enumerating' stamp: 'dkh 6/8/2012 14:04:22'!
versionsDo: aBlock

	self loadDirectives do: [:directive | directive versionDo: aBlock ].! !

!MetacelloVersionLoadDirective methodsFor: 'loading' stamp: 'dkh 6/8/2012 14:04:22'!
loadPostloadDirective: aPostloadDirective 

	| block |
	(block :=  aPostloadDirective spec postLoadDoItBlock) ~~ nil
		ifTrue: [
			aPostloadDirective evaluateSupplyingAnswers: [ block valueWithPossibleArgs: 
					(Array 
						with: aPostloadDirective loader 
						with: aPostloadDirective spec) ].
			Transcript cr; show: 'Evaluated -> ', aPostloadDirective spec label, ' >> ', aPostloadDirective spec postLoadDoIt value asString]! !

!MetacelloVersionLoadDirective methodsFor: 'testing' stamp: 'dkh 6/8/2012 14:04:22'!
isExplicit

	^false! !

!MetacelloVersionLoadDirective methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
loadExplicitLoadDirective: aLoaderDirective gofer: aGofer
	"load has already been performed, no need to load again"! !

!MetacelloVersionLoadDirective methodsFor: 'printing' stamp: 'dkh 6/8/2012 14:04:22'!
printLoadDirectivesOn: aStream indent: indent

	self loadDirectives do: [:each |
		aStream cr. 
		each printOn: aStream indent: indent + 1 ].! !

!MetacelloVersionLoadDirective methodsFor: 'enumerating' stamp: 'dkh 6/8/2012 14:04:22'!
packageDirectivesDo: aBlock

	self loadDirectives do: [:directive | directive packageDirectivesDo: aBlock ].! !

!MetacelloVersionLoadDirective methodsFor: 'printing' stamp: 'dkh 6/8/2012 14:04:22'!
label

	self spec == nil ifTrue: [ ^'' ].
	^self spec label! !

!MetacelloVersionLoadDirective methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
loadLinearLoadDirective: aLoaderDirective gofer: aGofer

	aLoaderDirective loadDirectives do: [:directive | directive loadUsing: aLoaderDirective gofer: aGofer ].
	aLoaderDirective finalizeLoad: aGofer.! !

!MetacelloVersionLoadDirective methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
loadDirectives: anObject
	loadDirectives := anObject! !

!MetacelloVersionLoadDirective methodsFor: 'actions' stamp: 'dkh 6/8/2012 14:04:22'!
loadWithPolicy: aLoadPolicy

	| gofer |
	gofer := MetacelloGofer new.
	gofer disablePackageCache.
	gofer repository: aLoadPolicy cacheRepository.
	self loadUsing: self gofer: gofer! !

!MetacelloVersionLoadDirective methodsFor: 'accessing' stamp: 'dkh 6/8/2012 14:04:22'!
spec
	"Expected to be a MetacelloVersionSpec"
	
	(spec == nil  and: [  self loader ~~ nil ]) 
		ifTrue: [ 
			^[ self loader spec versionSpec ] 
				on: MessageNotUnderstood
				do: [:ex | ex return: self loader spec ]].
	^spec! !

!MetacelloVersionLoadDirective methodsFor: 'enumerating' stamp: 'dkh 6/8/2012 14:04:22'!
prepostLoadsDo: aBlock

	self loadDirectives do: [:directive | directive prepostLoadDo: aBlock ].! !

!MetacelloVersionMethodSection methodsFor: 'accessing' stamp: 'dkh 9/7/2012 13:54'!
attributePath
    | path |
    path := MetacelloMethodSectionPath with: self attributes.
    ^ self parent == nil
        ifTrue: [ path ]
        ifFalse: [ self parent attributePath , path ]! !

!MetacelloVersionMethodSection methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
parent: anObject
	parent := anObject! !

!MetacelloVersionMethodSection methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
addMethodSection: methodSection

	methodSection parent: self.
	self methodSections add: methodSection! !

!MetacelloVersionMethodSection methodsFor: 'accessing' stamp: 'dkh 03/12/2013 20:14'!
printOn: aStream
  aStream
    nextPutAll: self class name asString;
    nextPut: $(.
  self versionSpec printOn: aStream.
  aStream nextPut: $)! !

!MetacelloVersionMethodSection methodsFor: 'accessing' stamp: 'dkh 9/8/2012 06:02'!
attributeOrPath
    ^ self parent == nil
        ifTrue: [ 
            self attributes size == 1
                ifTrue: [ self attributes first ]
                ifFalse: [ self attributes ] ]
        ifFalse: [ self attributePath ]! !

!MetacelloVersionMethodSection methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
block
	^ block! !

!MetacelloVersionMethodSection methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
parent
	^ parent! !

!MetacelloVersionMethodSection methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
versionSpec
	^ versionSpec! !

!MetacelloVersionMethodSection methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
topParent
	self parent == nil
		ifTrue: [ ^ self ].
	^ self parent topParent! !

!MetacelloVersionMethodSection methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
methodSections

	methodSections ifNil: [ methodSections := OrderedCollection new ].
	^methodSections! !

!MetacelloVersionMethodSection methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
versionSpec: anObject
	versionSpec := anObject! !

!MetacelloVersionMethodSection methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
block: anObject
	block := anObject! !

!MetacelloVersionMethodSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
imports
	imports == nil ifTrue: [ imports := #() ].
	^ imports! !

!MetacelloVersionMethodSpec methodsFor: 'method generation' stamp: 'dkh 9/7/2012 07:03'!
methodSource
    | strm |
    strm := WriteStream on: String new.
    self
        methodSelectorAndPragma: self selector
        imports: self imports
        versionString: self versionString
        on: strm.
    self
        methodSection: self
        pre: [ :methodSection :indent | 
            strm
                cr;
                tab: indent;
                nextPutAll: 'spec for: ' , methodSection attributePrintString , ' do: [';
                cr.
            methodSection versionSpec configMethodOn: strm last: methodSection methodSections isEmpty indent: indent + 1 ]
        last: false
        post: [ :methodSection :indent :last | 
            strm nextPutAll: ' ].'.
            (last or: [ indent = 1 or: [ methodSection methodSections isEmpty and: [ indent = 1 ] ] ])
                ifTrue: [ strm cr ] ]
        indent: 0.
    ^ strm contents! !

!MetacelloVersionMethodSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
imports: anObject
	imports := anObject! !

!MetacelloVersionMethodSpec methodsFor: 'adding' stamp: 'dkh 9/8/2012 05:10'!
findMethodSection: attributeOrPath sectionIndex: sectionIndex
    | attributePath index sections found |
    attributePath := attributeOrPath asMetacelloAttributePath.
    index := 1.
    sections := self methodSections.
    found := true.
    [ found ]
        whileTrue: [ 
            found := false.
            sections
                do: [ :ms | 
                    ms attributes = (attributePath at: index)
                        ifTrue: [ 
                            index == attributePath size
                                ifTrue: [ ^ ms ].
                            sections := ms methodSections.
                            index := index + 1.
                            found := true ] ] ].
    self error: 'Method section for attribute: ' , attributePath printString , ' not found.'! !

!MetacelloVersionMethodSpec methodsFor: 'method generation' stamp: 'dkh 6/5/2012 19:01:24'!
methodSelectorAndPragma: aSelector imports: importList versionString: aString on: strm
	strm
		nextPutAll: aSelector asString , ' spec';
		cr;
		tab;
		nextPutAll: '<version: ' , aString printString.
	importList notEmpty
		ifTrue: [ 
			strm nextPutAll: ' imports: #('.
			importList
				do: [ :importVersionString | 
					strm
						nextPutAll: importVersionString printString;
						space ].
			strm nextPut: $) ].
	strm
		nextPutAll: '>';
		cr! !

!MetacelloVersionMethodSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
versionString: aStringOrSymbol

	aStringOrSymbol isSymbol ifTrue: [ self error: 'Version string ', aStringOrSymbol printString, ' for version method must be a String' ].
	super versionString: aStringOrSymbol! !

!MetacelloVersionMethodSpec methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
methodSection: methodSection pre: preBlock last: last post: postBlock indent: indent
	| list |
	methodSection ~~ self
		ifTrue: [ preBlock value: methodSection value: indent ].
	list := methodSection methodSections.
	1 to: list size
		do: [ :index | | ms | 
			ms := list at: index.
			self
				methodSection: ms
				pre: preBlock
				last: index ~= list size
				post: postBlock
				indent: indent + 1 ].
	methodSection ~~ self
		ifTrue: [ postBlock value: methodSection value: indent value: last ]! !

!MetacelloVersionMethodSpec methodsFor: 'adding' stamp: 'dkh 9/8/2012 05:47'!
addMethodSection: attributePath versionSpec: versionSpec
    | attributeList methodSection index sections found |
    attributeList := attributePath last.
    methodSection := MetacelloVersionMethodSection new
        attributes: attributeList;
        versionSpec: versionSpec;
        yourself.
    attributePath size > 1
        ifTrue: [ 
            index := 1.
            sections := self methodSections.
            found := true.
            [ found ]
                whileTrue: [ 
                    found := false.
                    sections
                        do: [ :ms | 
                            ms attributes = (attributePath at: index)
                                ifTrue: [ 
                                    index == (attributePath size -1)
                                        ifTrue: [ 
                                            ms methodSections add: methodSection.
                                            ^ self ].
                                    sections := ms methodSections.
                                    index := index + 1.
                                    found := true ] ] ].
            self error: 'Method section for attribute: ' , (attributePath at: index) printString , ' not found.' ]
        ifFalse: [ self methodSections add: methodSection ]! !

!MetacelloVersionNumber commentStamp: 'dkh 6/22/2012 12:00'!
# Metacello version format

Thanks to [Mozilla Toolkit version format](https://developer.mozilla.org/en/Toolkit_version_format) for inspiration.

##Version Format
A version string consists of one or more version parts, separated with dots or dashes.

A version part with a leading dot is numeric. A version part with a leading dash is string.

The rationale behind splitting a version part into a sequence of strings and numbers is that when comparing version parts, the numeric parts are compared as numbers, e.g. '1.0-pre.1' < '1.0-pre.10', while the strings are compared bytewise. See the next section for details on how versions are compared.

##Comparing versions

When two version strings are compared, their version parts are compared left to right. Empty parts are ignored.

If at some point a version part of one version string is greater than the corresponding version part of another version string, then the first version string is greater than the other one.

If a version string has extra parts and the common parts are equal, the shorter version string is less than the longer version string (1.0 is less than 1.0.0).

Otherwise, the version strings are equal. 

##Comparing version parts

Version parts are also compared left to right, A string-part that exists is always less-then a nonexisting string-part (1.6-a is less than 1.6).

Examples

```
1 == 1. < 1.0 == 1..--0
< 1.1-a < 1.1-aa < 1.1-ab < 1.1-b < 1.1-c
< 1.1-pre < 1.1-pre.0 
< 1.1-pre.1-a < 1.1-pre.1-aa < 1.1-pre.1-b < 1.1-pre.1
< 1.1-pre.2
< 1.1-pre.10
< 1.1 < 1.1.0 < 1.1.00
< 1.10
< 2.0
```!
!MetacelloVersionNumber methodsFor: 'copying' stamp: 'dkh 6/5/2012 19:01:24'!
copyFrom: start to: stop 
	"Answer a copy of a subset of the receiver, starting from element at 
	index start until element at index stop."

	| newSize new j |
	newSize := stop - start + 1.
	new := self species new: newSize.
	j := 0.
	start to: stop do: [:i |
		new at: j + 1 put: (self at: i).
		j := j + 1 ].
	^new! !

!MetacelloVersionNumber methodsFor: 'printing' stamp: 'dkh 07/09/2012 16:15'!
asString
	"Answer a string that represents the receiver."

	^ self printString! !

!MetacelloVersionNumber methodsFor: 'comparing' stamp: 'dkh 6/5/2012 19:01:24'!
hash

"Returns a numeric hash key for the receiver."

| mySize interval hashValue |

(mySize := self size) == 0
  ifTrue: [ ^15243 ].

"Choose an interval so that we sample at most 5 elements of the receiver"
interval := ((mySize - 1) // 4) max: 1.

hashValue := 4459.
1 to: mySize by: interval do: [ :i | | anElement |
  anElement := self at: i.
  (anElement isKindOf: SequenceableCollection)
    ifTrue: [
      hashValue := (hashValue bitShift: -1) bitXor: anElement size.
      ]
    ifFalse: [
      hashValue := (hashValue bitShift: -1) bitXor: anElement hash.
      ].
  ].

^ hashValue abs
! !

!MetacelloVersionNumber methodsFor: 'operations' stamp: 'dkh 6/5/2012 19:01:24'!
decrementMinorVersionNumber
	| int |
	self size to: 1 by: -1 do: [ :index | 
		(int := self at: index) isString
			ifFalse: [ 
				int > 0
					ifTrue: [ self at: index put: int - 1 ].
				^ self ] ]! !

!MetacelloVersionNumber methodsFor: 'comparing' stamp: 'dkh 6/5/2012 19:01:24'!
~> aMetacelloVersionNumber

	aMetacelloVersionNumber size == 1 ifTrue: [ ^false ].
	^self >= aMetacelloVersionNumber and: [ self < aMetacelloVersionNumber approximateBase ]! !

!MetacelloVersionNumber methodsFor: 'operations' stamp: 'dkh 6/5/2012 19:01:24'!
incrementMinorVersionNumber

	| int |
	self size to: 1 by: -1 do: [:index | 
		(int := self at: index) isString 
			ifFalse: [ 
				self at: index put: int + 1.
				^self ]].! !

!MetacelloVersionNumber methodsFor: 'comparing' stamp: 'dkh 6/5/2012 19:01:24'!
< aMetacelloVersionNumber

	| condensed aCondensed |
	aMetacelloVersionNumber species = self species
		ifFalse: [ ^ false ].
	condensed := self collapseZeros.
	aCondensed := aMetacelloVersionNumber collapseZeros.
	(condensed ~~ self or: [ aCondensed ~~ aMetacelloVersionNumber ])
		ifTrue: [ ^ condensed compareLessThan: aCondensed ].
	^ self compareLessThan: aMetacelloVersionNumber! !

!MetacelloVersionNumber methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
compareLessThan: aMetacelloVersionNumber

	| mySize aSize commonSize count more |
	mySize := self size.
	aSize := aMetacelloVersionNumber size.
	commonSize :=  mySize min: aSize.
	count := 0.
	more := true.
	[ more and: [ count < commonSize ]] whileTrue: [
		(self at: count + 1) = (aMetacelloVersionNumber at: count + 1)
			ifTrue: [ count := count + 1 ]
			ifFalse: [ more := false ]].
	count < commonSize
		ifTrue: [ 
			^(self at: count + 1) 
				metacelloVersionComponentLessThan: (aMetacelloVersionNumber at: count + 1) ].
	mySize < aSize
		ifTrue: [ 
			mySize = 0 ifTrue: [ ^true ].
			"if the versions at commonSize are equal and the next version slot in aMetacelloVersionNumber 
			 is a string, then it's considered that I'm > aMetacelloVersionNumber
			 (i.e., '2.9.9' is greater than '2.9.9-alpha.2')"
			(self at: commonSize) = (aMetacelloVersionNumber at: commonSize)
				ifFalse: [ ^true ]. 
			^(aMetacelloVersionNumber at: commonSize+1) isString not]
		ifFalse: [ 
			mySize = aSize ifTrue: [ ^false ].
			aSize <= 0 ifTrue: [ ^false ].
			"if the versions at commonSize are equal and the next version slot is a string, 
			 then it's considered that I'm < aMetacelloVersionNumber
			 (i.e., '2.9.9-alpha.2' is less than '2.9.9')"
			(self at: commonSize) = (aMetacelloVersionNumber at: commonSize)
				ifFalse: [ ^false ].
			 ^(self at: commonSize+1) isString]
! !

!MetacelloVersionNumber methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
collapseZeros
	"the rule must be that zeros can be collapsed as long as the series of zeros ends in a string term"

	| collection newSize new j lastElementIsStringOrZero canCollapse |
	(self size = 0 or: [ self at: 1 ]) == 0
		ifTrue: [ ^ self ].
	collection := OrderedCollection new.
	lastElementIsStringOrZero := true.
	canCollapse := true.
	self size to: 1 by: -1 do: [ :i | 
		| element |
		element := self at: i.
		(canCollapse and: [ element == 0 ])
			ifTrue: [ 
				lastElementIsStringOrZero
					ifFalse: [ 
						canCollapse := false.
						collection addFirst: element.]]
			ifFalse: [ 
				collection addFirst: element.
				canCollapse := lastElementIsStringOrZero := element isString ] ].
	collection size = self size
		ifTrue: [ ^ self ].
	newSize := collection size.
	new := self species new: newSize.
	j := 0.
	collection
		do: [ :element | 
			new at: j + 1 put: element.
			j := j + 1 ].
	^ new! !

!MetacelloVersionNumber methodsFor: 'comparing' stamp: 'dkh 6/5/2012 19:01:24'!
match: aVersionPattern
	"Answer whether the version number of the receiver matches the given pattern string.

	 A Metacello version number is made up of version sequences delimited by the characters $. and $-.
	 The $. introduces a numeric version sequence and $- introduces an alphanumeric version sequence.
	 
	 A version pattern is made up of version pattern match sequences. also delimited by the characters $. 
	 and $-.. Each pattern match sequence is tested against the corresponding version sequence of the 
	 receiver, using the 'standard' pattern matching rules. All sequences must answer true for a match.
	
	 The special pattern sequence '?' is a match for the corresponding version sequence and all subsequent 
	 version sequences. '?' as the version pattern matches all versions. No more version pattern 
	 sequences are permitted once the '?' sequence is used. If used, it is the last version pattern
	 sequence. "
	
	| patternVersion mySize patternSize |
	patternVersion := aVersionPattern asMetacelloVersionNumber.
	mySize := self size.
	patternSize := patternVersion size.
	mySize = patternSize 
		ifFalse: [ 
			mySize < patternSize ifTrue: [ ^false ].
			(patternVersion at: patternSize) ~= '?' ifTrue: [ ^false ].
			mySize := patternSize ].
	1 to: mySize do: [:i | | pattern |
		pattern := (patternVersion at: i) asString.
		pattern = '?'
			ifTrue: [i = mySize ifFalse: [ ^self error: 'Invalid version match pattern: ', aVersionPattern printString ]]
			ifFalse: [ (pattern match: (self at: i) asString)  ifFalse: [ ^false ]]].
	^true
"
  '1.1.1' asMetacelloVersionNumber match: '*.*.*'. -> true
  '1.1.1' asMetacelloVersionNumber match: '*.#.*'. -> true
  '1.10.1' asMetacelloVersionNumber match: '*.#.*'. -> false
  '1.1.1' asMetacelloVersionNumber match: '*.*'. -> false
  '1.1.1' asMetacelloVersionNumber match: '*.?'. -> true
  '1.0' asMetacelloVersionNumber match: '1.?'. -> true
  '2.0' asMetacelloVersionNumber match: '1.?'. -> false
  '1.1.1' asMetacelloVersionNumber match: '?'. -> true
  '1' asMetacelloVersionNumber match: '*.?'. -> false
  '1-alpha5.0' asMetacelloVersionNumber match: '1-alpha*.?'. -> true
  '1-alpha15.0.1' asMetacelloVersionNumber match: '1-alpha*.?'. -> true
  '1.1' asMetacelloVersionNumber match: '?.?'. -> ERROR: invalid version match pattern
"
! !

!MetacelloVersionNumber methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
versionString

	| strm |
	strm := WriteStream on: String new.
	self printOn: strm.
	^strm contents! !

!MetacelloVersionNumber methodsFor: 'comparing' stamp: 'dkh 6/5/2012 19:01:24'!
= aMetacelloVersionNumber

	| condensed aCondensed |
	aMetacelloVersionNumber species = self species
		ifFalse: [ ^ false ].
	condensed := self collapseZeros.
	aCondensed := aMetacelloVersionNumber collapseZeros.
	(condensed ~~ self or: [ aCondensed ~~ aMetacelloVersionNumber ])
		ifTrue: [ ^ condensed compareEqualTo: aCondensed ].
	^ self compareEqualTo: aMetacelloVersionNumber! !

!MetacelloVersionNumber methodsFor: 'converting' stamp: 'dkh 6/5/2012 19:01:24'!
asMetacelloVersionNumber

	^self! !

!MetacelloVersionNumber methodsFor: 'enumerating' stamp: 'dkh 6/5/2012 19:01:24'!
do: aBlock 
	"Refer to the comment in Collection|do:."
	1 to: self size do:
		[:index | aBlock value: (self at: index)]! !

!MetacelloVersionNumber methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
compareEqualTo: aMetacelloVersionNumber

	| mySize |
	aMetacelloVersionNumber species = self species ifFalse: [ ^false ].
	mySize := self size.
	mySize = aMetacelloVersionNumber size 
		ifFalse: [ ^false ].
	1 to: mySize do: [:i |
		(self at: i) = (aMetacelloVersionNumber at: i) ifFalse: [ ^false ]].
	^true! !

!MetacelloVersionNumber methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
printOn: aStream

	| beforeFirst | 
	beforeFirst := true.
	self do:
		[:each |
		beforeFirst
			ifTrue: [beforeFirst := false]
			ifFalse: [
				each isString
					ifTrue: [ aStream nextPut: $- ]
					ifFalse: [ aStream nextPut: $. ] ].
		aStream nextPutAll: each asString ]
! !

!MetacelloVersionNumber methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
approximateBase

	| base |
	base := self copyFrom: 1 to: self size - 1.
	base at: base size put: (base at: base size) + 1.
	^base! !

!MetacelloVersionNumber methodsFor: 'enumerating' stamp: 'dkh 6/5/2012 19:01:24'!
do: elementBlock separatedBy: separatorBlock
	"Evaluate the elementBlock for all elements in the receiver,
	and evaluate the separatorBlock between."

	| beforeFirst | 
	beforeFirst := true.
	self do:
		[:each |
		beforeFirst
			ifTrue: [beforeFirst := false]
			ifFalse: [separatorBlock value].
		elementBlock value: each]! !

!MetacelloVersionNumber class methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
extractNumericComponent: subString
	"$. separated components are integers"

	| number |
	number := [subString asNumber] 
						on: Error 
						do: [:ex | ex return: subString ].
	^number asString = subString
		ifTrue: [ number ]
		ifFalse: [ subString ]! !

!MetacelloVersionNumber class methodsFor: 'instance creation' stamp: 'dkh 6/5/2012 19:01:24'!
fromString: aString

	| new components |
	components := OrderedCollection new.
	(aString findTokens: '.') do: [:subString | | strs |
		strs := subString findTokens: '-'.
		"first subString token could be an integer"
		components add: (self extractNumericComponent: strs first).
		strs size > 1
			ifTrue: [
				"remaining are uncoditionally Strings, because of leading $-"
				components addAll: strs allButFirst ]].
	new := self new: components size.
	1 to: components size do: [:i | new at: i put: (components at: i) ].
	^new! !

!MetacelloVersionNumberTestCase methodsFor: 'test approximately greater than' stamp: 'dkh 5/4/2012 20:37:12'!
testApproxVersion02

	self deny: '1.1' asMetacelloVersionNumber ~> '1' asMetacelloVersionNumber! !

!MetacelloVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testCollapseZeros

	self assert: (MetacelloVersionNumber fromString: '1.0-beta.24.0.1') collapseZeros printString = '1-beta.24.0.1'.
	self assert: (MetacelloVersionNumber fromString: '1.0-beta.24.0.0.1') collapseZeros printString = '1-beta.24.0.0.1'.
	self assert: (MetacelloVersionNumber fromString: '1.0.0-beta.24.0.0.1') collapseZeros printString = '1-beta.24.0.0.1'.
! !

!MetacelloVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testVersion03

	| v1 v2 |
	v1 := self versionClass fromString: '1.0.0.1'.
	v2 := self versionClass fromString: '1.0.0'.
	self assert: (v1 > v2)! !

!MetacelloVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 16:54'!
testVersion16
    self assert: (self versionClass fromString: '1.0-beta.0') < (self versionClass fromString: '1.0').
    self assert: (self versionClass fromString: '1.0-beta.0') < (self versionClass fromString: '1.0.0').
    self assert: (self versionClass fromString: '1.0-beta.0') < (self versionClass fromString: '1.0.0.0')! !

!MetacelloVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 16:53'!
testVersion17

	self assert: ((self versionClass fromString: '1.0') = (self versionClass fromString: '1.0.0')).
	self assert: ((self versionClass fromString: '1') = (self versionClass fromString: '1.0')).
	self assert: ((self versionClass fromString: '1') > (self versionClass fromString: '1-0')).
	self assert: ((self versionClass fromString: '1') > (self versionClass fromString: '1.0-beta.0')).
	self assert: ((self versionClass fromString: '1') > (self versionClass fromString: '1-beta.0')).
	self assert: ((self versionClass fromString: '1') > (self versionClass fromString: '1-beta')).
! !

!MetacelloVersionNumberTestCase methodsFor: 'test matching' stamp: 'dkh 5/4/2012 20:37:12'!
testStandardMatch

	self assert: ((self versionClass fromString: '1.1.1') match: '*.*.*').
	self deny: ((self versionClass fromString: '1.1.1') match: '*.*').
	self assert: ((self versionClass fromString: '1.1.0') match: '1.1.*').
	self assert: ((self versionClass fromString: '1.1.0') match: '1.#.*').
	self deny: ((self versionClass fromString: '1.10.0') match: '1.#.*').
	self assert: ((self versionClass fromString: '1-alpha5.0') match: '1-alpha#.0').
	self assert: ((self versionClass fromString: '1.alpha5.0') match: '1-alpha#.0').
	self assert: ((self versionClass fromString: '1.alpha5.0') match: '1.alpha#.0').
	self deny: ((self versionClass fromString: '1-alpha10.0') match: '1-alpha#.0').
! !

!MetacelloVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testVersion21

	self deny: (MetacelloVersionNumber fromString: '') > (MetacelloVersionNumber fromString: '0').
	self assert: (MetacelloVersionNumber fromString: '') < (MetacelloVersionNumber fromString: '0').
	self assert: (MetacelloVersionNumber fromString: '') = (MetacelloVersionNumber fromString: '').

! !

!MetacelloVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 15:10'!
testVersion10

	| x y |
	self assert: ((x := (({
		self versionClass fromString: '1.0'.
		self versionClass fromString: '0.7'.
		self versionClass fromString: '0.8'.
		self versionClass fromString: '0.9'.
		self versionClass fromString: '1.0.1'
	} sort: [:a :b | a <= b ]) collect: [:each | each versionString ]) asArray) = (y := #( '0.7' '0.8' '0.9' '1.0' '1.0.1')))! !

!MetacelloVersionNumberTestCase methodsFor: 'private' stamp: 'dkh 5/4/2012 20:37:12'!
versionClass

	^MetacelloVersionNumber! !

!MetacelloVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testVersion20

	self assert: (MetacelloVersionNumber fromString: '') printString = ''.
! !

!MetacelloVersionNumberTestCase methodsFor: 'test matching' stamp: 'dkh 5/4/2012 20:37:12'!
testInvalidSpecialMatch

	self 
		should: [ ((self versionClass fromString: '1.1') match: '?.?') ]
		raise: Error.
! !

!MetacelloVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testVersion08

	| v1 v2 |
	v1 := self versionClass fromString: '1.0a6'.
	v2 := self versionClass fromString: '1.0a5'.
	self assert: (v1 > v2)! !

!MetacelloVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testVersion06

	| v1 v2 |
	v1 := self versionClass fromString: '3.'.
	v2 := self versionClass fromString: '2'.
	self assert: (v1 > v2)! !

!MetacelloVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 16:52'!
testVersion12

	self deny: ((self versionClass fromString: '1.0') <= (self versionClass fromString: '0.7'))! !

!MetacelloVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 16:53'!
testVersion19

	self assert: ((self versionClass fromString: '1.0-beta.0') < (self versionClass fromString: '1')).
! !

!MetacelloVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testVersion11

	| v1 v2 |
	v1 := self versionClass fromString: '1.0.1b'.
	v2 := self versionClass fromString: '1.0.1a'.
	self assert: (v1 >= v2).
	self assert: (v2 <= v1)! !

!MetacelloVersionNumberTestCase methodsFor: 'test approximately greater than' stamp: 'dkh 5/4/2012 20:37:12'!
testApproxVersion03

	self assert: '1.1' asMetacelloVersionNumber ~> '1.1' asMetacelloVersionNumber! !

!MetacelloVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 16:52'!
testVersion09

	| v1 v2 |
	v1 := self versionClass fromString: '1.0'.
	v2 := self versionClass fromString: '0.7'.
	self assert: (v1 >= v2).
	self assert: (v2 <= v1)! !

!MetacelloVersionNumberTestCase methodsFor: 'test approximately greater than' stamp: 'dkh 5/4/2012 20:37:12'!
testApproxVersion01

	self assert: '1.1.1' asMetacelloVersionNumber ~> '1.1' asMetacelloVersionNumber! !

!MetacelloVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 16:52'!
testVersion15

	self assert: ((self versionClass fromString: '1.0-beta.0') < (self versionClass fromString: '1.0-beta.1')).
! !

!MetacelloVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testVersion24

	self assert: (MetacelloVersionNumber fromString: '3.0.3.-rc.1') ~= (MetacelloVersionNumber fromString: '3.0.0.3-rc.1').
	self assert: (MetacelloVersionNumber fromString: '1.0.0.1.0.0') = (MetacelloVersionNumber fromString: '1.0.0.1').
	self assert: (MetacelloVersionNumber fromString: '1.0.0.1') ~= (MetacelloVersionNumber fromString: '1..1').

! !

!MetacelloVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testVersion13

	self deny: ((self versionClass fromString: '0.8') <= (self versionClass fromString: '0.7')).
	self deny: ((self versionClass fromString: '0.8.1.8') <= (self versionClass fromString: '0.7.0.5')).
	! !

!MetacelloVersionNumberTestCase methodsFor: 'test matching' stamp: 'dkh 5/4/2012 20:37:12'!
testSpecialMatch

	self assert: ((self versionClass fromString: '1.1') match: '?').
	self assert: ((self versionClass fromString: 'alpha') match: '?').
	self assert: ((self versionClass fromString: '1.1.1.1.1') match: '?').
	self assert: ((self versionClass fromString: '1.alpha5') match: '?').
	self assert: ((self versionClass fromString: '1.1') match: '*.?').
	self assert: ((self versionClass fromString: '1.1') match: '?').
	self assert: ((self versionClass fromString: '10.1.1.1.1') match: '?').
	self deny: ((self versionClass fromString: '1.1') match: '*.*.?').
	self assert: ((self versionClass fromString: '1.1.1') match: '*.?').
! !

!MetacelloVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 15:10'!
testVersion18

	self deny: ((self versionClass fromString: '1.0') < (self versionClass fromString: '1')).
	self deny: ((self versionClass fromString: '1.0') < (self versionClass fromString: '1-0')).
! !

!MetacelloVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 16:52'!
testVersion05

	| v1 v2 |
	v1 := self versionClass fromString: '3'.
	v2 := self versionClass fromString: '2'.
	self assert: (v1 > v2)! !

!MetacelloVersionNumberTestCase methodsFor: 'tests' stamp: 'dkh 6/22/2012 16:52'!
testVersion07

	| v1 v2 |
	v1 := self versionClass fromString: '3.0.0'.
	v2 := self versionClass fromString: '2'.
	self assert: (v1 > v2)! !

!MetacelloVersionSpec methodsFor: 'printing' stamp: 'dkh 9/10/2012 15:58'!
configPackagesSpecMethodOn: aStream indent: indent

	| projectSpecs packageSpecs groupSpecs |
	projectSpecs := OrderedCollection new.
	packageSpecs := OrderedCollection new.
	groupSpecs := OrderedCollection new.
	self packagesSpec list do: [:member |
		member spec 
			projectDo: [:proj | member spec name ~~ nil ifTrue: [ projectSpecs add: member ]]
			packageDo: [:package | member spec name ~~ nil ifTrue: [ packageSpecs add: member ]]
			groupDo: [:group | member spec name ~~ nil ifTrue: [ groupSpecs add: member ]]].
	projectSpecs isEmpty not
		ifTrue: [
			aStream tab: indent; nextPutAll: 'spec '.
			projectSpecs size > 1 ifTrue: [ aStream cr; tab: indent + 1 ].
			1 to: projectSpecs size  do: [:index | 
				(projectSpecs at: index) configMethodCascadeOn: aStream last: index == projectSpecs size indent: indent + 1.
				index ~= projectSpecs size ifTrue: [ aStream tab: indent + 1 ]]].
	packageSpecs isEmpty not
		ifTrue: [
			projectSpecs isEmpty not ifTrue: [ aStream cr ].
			aStream tab: indent; nextPutAll: 'spec '.
			packageSpecs size > 1 ifTrue: [ aStream cr; tab: indent + 1 ].
			1 to: packageSpecs size  do: [:index | 
				(packageSpecs at: index) configMethodCascadeOn: aStream last: index == packageSpecs size indent: indent + 1.
				index ~= packageSpecs size ifTrue: [ aStream tab: indent + 1 ]]].
	groupSpecs isEmpty not
		ifTrue: [
			projectSpecs isEmpty not | packageSpecs isEmpty not ifTrue: [ aStream cr ].
			aStream tab: indent; nextPutAll: 'spec '.
			groupSpecs size > 1 ifTrue: [ aStream cr; tab: indent + 1 ].
			1 to: groupSpecs size  do: [:index | 
				(groupSpecs at: index) configMethodCascadeOn: aStream last: index == groupSpecs size indent: indent + 1.
				index ~= groupSpecs size ifTrue: [ aStream tab: indent + 1 ]]].
! !

!MetacelloVersionSpec methodsFor: 'construction' stamp: 'dkh 6/5/2012 19:01:24'!
description: aBlockOrString constructor: aVersionConstructor
    aVersionConstructor descriptionForVersion: aBlockOrString! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
description

	description == nil 
		ifTrue: [
			^self project valueHolderSpec
				value: '';
				yourself].
	^ description! !

!MetacelloVersionSpec methodsFor: 'querying' stamp: 'dkh 9/10/2012 15:40'!
packageNames
    packageList == nil
        ifTrue: [ ^ #() ].
    ^ self packages map keys asSet! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 9/11/2012 12:13'!
import
    ^ importName! !

!MetacelloVersionSpec methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
configMethodValueOn: aStream for: spec selector: selector last: last indent: indent
	| valuePrintString |
	spec == nil
		ifTrue: [ ^ self ].
	valuePrintString := spec value isSymbol
		ifTrue: [ '#' , spec value asString printString ]
		ifFalse: [ spec value printString ].
	aStream
		tab: indent;
		nextPutAll: 'spec ' , selector , ' ' , valuePrintString , '.'.
	last
		ifFalse: [ aStream cr ]! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
setPreLoadDoIt: aSymbol

	preLoadDoIt := aSymbol! !

!MetacelloVersionSpec methodsFor: 'construction' stamp: 'dkh 9/10/2012 15:24'!
versionString: anObject constructor: aVersionConstructor
    aVersionConstructor versionStringForVersion: anObject! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
projectLabel

	^self project label! !

!MetacelloVersionSpec methodsFor: 'merging' stamp: 'dkh 9/11/2012 14:18'!
mergeSpec: anotherSpec
    | newSpec map anotherPackages |
    newSpec := super mergeSpec: anotherSpec.
    map := anotherSpec mergeMap.
    (anotherPackages := map at: #'packageList') isEmpty not
        ifTrue: [ 
            newSpec
                packages:
                    (self packages isEmpty
                        ifTrue: [ anotherPackages ]
                        ifFalse: [ self packages mergeSpec: anotherPackages ]) ].
    ^ newSpec! !

!MetacelloVersionSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
preLoadDoIt

	^preLoadDoIt! !

!MetacelloVersionSpec methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
createVersion

	^self versionClass fromSpec: self! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
author: anObject

	anObject setAuthorInMetacelloVersion: self! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
getPostLoadDoIt
	^postLoadDoIt! !

!MetacelloVersionSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
postLoadDoIt

	^postLoadDoIt! !

!MetacelloVersionSpec methodsFor: 'querying' stamp: 'dkh 9/11/2012 10:36'!
packageNamed: aString

	^self packageNamed: aString ifAbsent: [ nil ]! !

!MetacelloVersionSpec methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
versionClass

	^MetacelloVersion! !

!MetacelloVersionSpec methodsFor: 'querying' stamp: 'dkh 6/5/2012 19:01:24'!
versionString
	versionString == nil ifTrue: [ ^'' ].
	^ versionString! !

!MetacelloVersionSpec methodsFor: 'construction' stamp: 'dkh 9/10/2012 15:23'!
project: aString copyFrom: oldSpecName with: aBlock constructor: aVersionConstructor
    aVersionConstructor projectForVersion: aString copyFrom: oldSpecName with: aBlock! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
description: anObject

	anObject setDescriptionInMetacelloVersion: self! !

!MetacelloVersionSpec methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
configMethodOn: aStream for: spec selector: selector last: last indent: indent
	spec == nil
		ifTrue: [ ^ self ].
	aStream
		tab: indent;
		nextPutAll: 'spec ' , selector , ' [';
		cr.
	spec configMethodOn: aStream indent: indent + 1.
	aStream nextPutAll: ' ].'.
	last
		ifFalse: [ aStream cr ]! !

!MetacelloVersionSpec methodsFor: 'construction' stamp: 'dkh 9/10/2012 15:24'!
removeProject: aString constructor: aVersionConstructor
    aVersionConstructor removeProjectForVersion: aString! !

!MetacelloVersionSpec methodsFor: 'loading' stamp: 'dkh 9/11/2012 11:49'!
resolveToLoadableSpec: aString forLoad: forLoad forMap: map packages: packageMap
    | package |
    package := self
        packageNamed: aString
        forLoad: forLoad
        forMap: map
        ifAbsent: [ ^ self error: 'Name not found: ' , aString ].
    packageMap at: package name put: package.
    ^ {package}! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
getDescription
	^description! !

!MetacelloVersionSpec methodsFor: 'construction' stamp: 'dkh 6/5/2012 19:01:24'!
postLoadDoIt: aSymbol constructor: aVersionConstructor
    aVersionConstructor postLoadDoItForVersion: aSymbol! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 9/11/2012 10:38'!
import: anObject
    importName := anObject! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 9/10/2012 15:54'!
packagesSpec

	^self packages! !

!MetacelloVersionSpec methodsFor: 'querying' stamp: 'dkh 9/11/2012 11:57'!
difference: otherVersionSpec
    "Return a dictionary of additions, removals and modifications"

    | report myProjectSpecs otherProjectSpecs |
    report := MetacelloVersionDiffReport new.
    myProjectSpecs := Dictionary new.
    self
        projectDo: [ :projectSpec | myProjectSpecs at: projectSpec name put: projectSpec ]
        packageDo: [ :ignored |  ]
        groupDo: [ :ignored |  ].
    otherProjectSpecs := Dictionary new.
    otherVersionSpec
        projectDo: [ :projectSpec | otherProjectSpecs at: projectSpec name put: projectSpec ]
        packageDo: [ :ignored |  ]
        groupDo: [ :ignored |  ].
    myProjectSpecs
        valuesDo: [ :myProjectSpec | 
            | otherProjectSpec |
            otherProjectSpec := otherProjectSpecs at: myProjectSpec name ifAbsent: [  ].
            otherProjectSpec == nil
                ifTrue: [ 
                    report removals
                        at: myProjectSpec name
                        put:
                            {(myProjectSpec versionString).
                            ''} ]
                ifFalse: [ 
                    myProjectSpec versionString = otherProjectSpec versionString
                        ifFalse: [ 
                            report modifications
                                at: myProjectSpec name
                                put:
                                    {(myProjectSpec versionString).
                                    (otherProjectSpec versionString)} ] ] ].
    otherProjectSpecs
        valuesDo: [ :otherProjectSpec | 
            (myProjectSpecs at: otherProjectSpec name ifAbsent: [  ]) == nil
                ifTrue: [ 
                    report additions
                        at: otherProjectSpec name
                        put:
                            {''.
                            (otherProjectSpec versionString)} ] ].
    ^ report! !

!MetacelloVersionSpec methodsFor: 'merging' stamp: 'dkh 9/11/2012 12:11'!
nonOverridable
    ^ super nonOverridable , #(#'packageList')! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
timestamp: anObject

	anObject setTimestampInMetacelloVersion: self! !

!MetacelloVersionSpec methodsFor: 'construction' stamp: 'dkh 6/5/2012 19:01:24'!
blessing: aBlockOrString constructor: aVersionConstructor
    aVersionConstructor blessingForVersion: aBlockOrString! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
setPostLoadDoIt: aSymbol

	postLoadDoIt := aSymbol! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
preLoadDoIt: anObject

	anObject setPreLoadDoItInMetacelloSpec: self! !

!MetacelloVersionSpec methodsFor: 'construction' stamp: 'dkh 9/10/2012 15:23'!
configuration: aString with: aBlockOrString constructor: aVersionConstructor
    aVersionConstructor configurationForVersion: aString with: aBlockOrString! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 9/10/2012 15:39'!
packages: anObject
    packageList := anObject! !

!MetacelloVersionSpec methodsFor: 'construction' stamp: 'dkh 6/5/2012 19:01:24'!
preLoadDoIt: aSymbol constructor: aVersionConstructor
    aVersionConstructor preLoadDoItForVersion: aSymbol! !

!MetacelloVersionSpec methodsFor: 'copying' stamp: 'dkh 9/10/2012 15:40'!
postCopy
    super postCopy.
    blessing := blessing copy.
    description := description copy.
    author := author copy.
    timestamp := timestamp copy.
    packageList := packageList copy! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
postLoadDoIt: anObject

	anObject setPostLoadDoItInMetacelloSpec: self! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
timestamp

	timestamp == nil 
		ifTrue: [
			^self project valueHolderSpec
				value: '';
				yourself].
	^ timestamp! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
versionString: anObject
	versionString := anObject! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
setDescription: anObject
	description := anObject! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
blessing

	blessing == nil 
		ifTrue: [
			^self project valueHolderSpec
				value: self project defaultBlessing;
				yourself].
	^ blessing! !

!MetacelloVersionSpec methodsFor: 'loading' stamp: 'dkh 9/11/2012 12:09'!
expandToLoadableSpecNames: nameList

	| cacheKey names |
	cacheKey := Array with: self label with: nameList.
	^MetacelloPlatform current
		stackCacheFor: #loadableSpecNames
		at: cacheKey
		doing: [ :cache | 
			names := (self resolveToLoadableSpecs: nameList) collect: [:spec | spec name ].
			cache at: cacheKey put: names ].
! !

!MetacelloVersionSpec methodsFor: 'testing' stamp: 'dkh 6/5/2012 19:01:24'!
isPartiallyCurrent: notLoadedMatters useEquality: useEquality

	self subclassResponsibility! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
getAuthor
	^author! !

!MetacelloVersionSpec methodsFor: 'construction' stamp: 'dkh 9/10/2012 15:22'!
group: aString with: aStringOrCollection constructor: aVersionConstructor
    aVersionConstructor groupForVersion: aString with: aStringOrCollection! !

!MetacelloVersionSpec methodsFor: 'querying' stamp: 'dkh 9/11/2012 10:36'!
packageNamed: aString forMap: map ifAbsent: absentBlock
    "import: only allowed to be used with baseline project specs"

    ^ self
        packageNamed: aString
        forLoad: true
        forMap: map
        ifAbsent: absentBlock! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 9/10/2012 15:39'!
packages
    packageList == nil
        ifTrue: [ packageList := self project packagesSpec ].
    ^ packageList! !

!MetacelloVersionSpec methodsFor: 'printing' stamp: 'dkh 9/10/2012 15:58'!
configMethodOn: aStream last: last indent: indent
    | spec hasPackageSpecs |
    hasPackageSpecs := false.
    self packagesSpec list
        do: [ :member | 
            member spec
                projectDo: [ :proj | 
                    member spec name ~~ nil
                        ifTrue: [ hasPackageSpecs := true ] ]
                packageDo: [ :package | 
                    member spec name ~~ nil
                        ifTrue: [ hasPackageSpecs := true ] ]
                groupDo: [ :group | 
                    member spec name ~~ nil
                        ifTrue: [ hasPackageSpecs := true ] ] ].
    self configMethodBasicOn: aStream last: hasPackageSpecs not indent: indent.
    self configPackagesSpecMethodOn: aStream indent: indent.
    last
        ifFalse: [ aStream cr ]! !

!MetacelloVersionSpec methodsFor: 'querying' stamp: 'dkh 9/11/2012 10:09'!
packageSpecsInLoadOrder
    ^ self packages packageSpecsInLoadOrder! !

!MetacelloVersionSpec methodsFor: 'construction' stamp: 'dkh 9/10/2012 15:23'!
project: aString constructor: aVersionConstructor
    aVersionConstructor projectForVersion: aString! !

!MetacelloVersionSpec methodsFor: 'construction' stamp: 'dkh 9/10/2012 15:24'!
import: aString constructor: aVersionConstructor
    aVersionConstructor importForVersion: aString! !

!MetacelloVersionSpec methodsFor: 'merging' stamp: 'dkh 9/11/2012 14:20'!
mergeMap
    | map |
    map := super mergeMap.
    map at: #'versionString' put: versionString.
    map at: #'blessing' put: blessing.
    map at: #'description' put: description.
    map at: #'author' put: author.
    map at: #'timestamp' put: timestamp.
    map at: #'preLoadDoIt' put: preLoadDoIt.
    map at: #'postLoadDoIt' put: postLoadDoIt.
    map at: #'packageList' put: self packages.
    ^ map! !

!MetacelloVersionSpec methodsFor: 'construction' stamp: 'dkh 6/5/2012 19:01:24'!
timestamp: aBlockOrStringOrDateAndTime constructor: aVersionConstructor
    aVersionConstructor timestampForVersion: aBlockOrStringOrDateAndTime! !

!MetacelloVersionSpec methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
configSpawnMethodOn: aStream indent: indent

	self configMethodValueOn: aStream for: self getBlessing selector: 'blessing:' last: false indent: indent.
	self configMethodValueOn: aStream for: self getAuthor selector: 'author:' last: false indent: indent.
	self configMethodValueOn: aStream for: self getTimestamp selector: 'timestamp:' last: false indent: indent.

! !

!MetacelloVersionSpec methodsFor: 'construction' stamp: 'dkh 6/5/2012 19:01:24'!
repository: aString username: username password: password constructor: aVersionConstructor
    aVersionConstructor repositoryForVersion: aString username: username password: password! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
getBlessing
	^blessing! !

!MetacelloVersionSpec methodsFor: 'construction' stamp: 'dkh 6/5/2012 19:01:24'!
repository: anObject constructor: aVersionConstructor
    aVersionConstructor repositoryForVersion: anObject! !

!MetacelloVersionSpec methodsFor: 'private' stamp: 'dkh 6/22/2012 12:35'!
versionNumber
    ^ self project versionNumberClass fromString: self versionString! !

!MetacelloVersionSpec methodsFor: 'construction' stamp: 'dkh 9/10/2012 15:23'!
baseline: aString with: aBlockOrString constructor: aVersionConstructor
    aVersionConstructor baselineForVersion: aString with: aBlockOrString! !

!MetacelloVersionSpec methodsFor: 'construction' stamp: 'dkh 9/10/2012 15:22'!
group: aString overrides: aStringOrCollection constructor: aVersionConstructor
    aVersionConstructor groupForVersion: aString overrides: aStringOrCollection! !

!MetacelloVersionSpec methodsFor: 'testing' stamp: 'dkh 6/5/2012 19:01:24'!
isPossibleBaseline
    self subclassResponsibility! !

!MetacelloVersionSpec methodsFor: 'loading' stamp: 'dkh 9/11/2012 11:49'!
resolveToLoadableSpecs: required forLoad: forLoad map: packageMap
    | reqd allReqd map newReqd spec |
    reqd := required copy.
    allReqd := Set new.
    map := self packages map.
    [ reqd isEmpty ]
        whileFalse: [ 
            newReqd := Set new.
            reqd
                do: [ :req | 
                    (self
                        resolveToLoadableSpec: req
                        forLoad: forLoad
                        forMap: map
                        packages: packageMap)
                        do: [ :loadableSpec | 
                            newReqd addAll: loadableSpec requires.
                            newReqd addAll: loadableSpec includes ] ].
            allReqd addAll: reqd.
            newReqd removeAllFoundIn: allReqd.
            reqd := newReqd ].
    packageMap keys
        do: [ :pkgName | 
            (spec := (packageMap at: pkgName) resolveToLoadableSpec) == nil
                ifTrue: [ packageMap removeKey: pkgName ]
                ifFalse: [ packageMap at: pkgName put: (packageMap at: pkgName) resolveToLoadableSpec ] ]! !

!MetacelloVersionSpec methodsFor: 'construction' stamp: 'dkh 9/10/2012 15:24'!
project: aString with: aBlockOrString constructor: aVersionConstructor
    aVersionConstructor projectForVersion: aString with: aBlockOrString! !

!MetacelloVersionSpec methodsFor: 'printing' stamp: 'dkh 9/10/2012 15:56'!
configMethodBasicOn: aStream last: last indent: indent
    | values lastIndex lastBlock |
    last
        ifTrue: [ 
            "need to calculate last statement with a value"
            values := {(self getBlessing).
            (self getDescription).
            (self getPreLoadDoIt).
            (self getPostLoadDoIt).
            (self getAuthor).
            (self getTimestamp)}.
            1 to: values size do: [ :index | 
                (values at: index) ~~ nil
                    ifTrue: [ lastIndex := index ] ].
            lastBlock := [ :arg | arg = lastIndex ] ]
        ifFalse: [ lastBlock := [ :arg | false ] ].
    self
        configMethodValueOn: aStream
        for: self getBlessing
        selector: 'blessing:'
        last: (lastBlock value: 1)
        indent: indent.
    self
        configMethodValueOn: aStream
        for: self getDescription
        selector: 'description:'
        last: (lastBlock value: 2)
        indent: indent.
    self
        configMethodValueOn: aStream
        for: self getPreLoadDoIt
        selector: 'preLoadDoIt:'
        last: (lastBlock value: 3)
        indent: indent.
    self
        configMethodValueOn: aStream
        for: self getPostLoadDoIt
        selector: 'postLoadDoIt:'
        last: (lastBlock value: 4)
        indent: indent.
    self
        configMethodValueOn: aStream
        for: self getAuthor
        selector: 'author:'
        last: (lastBlock value: 5)
        indent: indent.
    self
        configMethodValueOn: aStream
        for: self getTimestamp
        selector: 'timestamp:'
        last: (lastBlock value: 6)
        indent: indent! !

!MetacelloVersionSpec methodsFor: 'querying' stamp: 'dkh 9/11/2012 10:36'!
packageNamed: aString ifAbsent: aBlock

	^self packageNamed: aString forMap: self packages map ifAbsent: aBlock! !

!MetacelloVersionSpec methodsFor: 'loading' stamp: 'dkh 9/11/2012 11:49'!
resolveToLoadableSpecs: nameList
    "Resolves names in namelist to the  list of packages and projects in the version that would be loaded. Projects are 
	not traversed during the transitive closure. The scope is that of the version itself.
	   If the spec is a package, answer a list including the package and the transitive closure on 
			its #requires: and #includes: fields.
	   If the spec is a project, answer the project.
	   If the spec is a group, answers the list of packages in the #includes: field of the group. 
			Groups in the #includes: field are expanded following the transitive closure on groups"

    | map |
    map := Dictionary new.
    self resolveToLoadableSpecs: nameList forLoad: false map: map.
    ^ map values! !

!MetacelloVersionSpec methodsFor: 'toolbox support' stamp: 'dkh 9/12/2012 14:26'!
deleteSpec: aSpec
    "remove the spec from packages"

    self packages deleteSpec: aSpec! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
setBlessing: anObject
	blessing := anObject! !

!MetacelloVersionSpec methodsFor: 'querying' stamp: 'dkh 9/11/2012 10:37'!
packageNamed: aString forLoad: forLoad forMap: map ifAbsent: absentBlock
    | importSpec |
    ^ map
        at: aString
        ifAbsent: [ 
            (forLoad and: [ self import notNil ])
                ifTrue: [ 
                    "expect the 'missing' name to be satisfied within context of imported project"
                    importSpec := (map at: self import ifAbsent: absentBlock) copy
                        name: aString;
                        mergeImportLoads: {aString};
                        yourself.
                    importSpec projectReference name: aString.
                    importSpec ]
                ifFalse: [ 
                    (aString = 'default' or: [ aString = 'ALL' ])
                        ifTrue: [ 
                            self project groupSpec
                                name: aString;
                                includes: self packageNames;
                                yourself ]
                        ifFalse: [ absentBlock value ] ] ]! !

!MetacelloVersionSpec methodsFor: 'enumerating' stamp: 'dkh 9/11/2012 10:08'!
projectDo: projectBlock packageDo: packageBlock groupDo: groupBlock

	self packageSpecsInLoadOrder do: [:pkgSpec |
		pkgSpec projectDo: projectBlock packageDo: packageBlock groupDo: groupBlock ]! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
getTimestamp
	^timestamp! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
setAuthor: anObject
	author := anObject! !

!MetacelloVersionSpec methodsFor: 'loading' stamp: 'dkh 9/11/2012 12:13'!
defaultPackageNames
	"if there is a package named 'default' (a group) then it defines the default package names,
	 otherwise answer a list of all of the package names in this version"

	self packages packageNamed: 'default' ifAbsent: [ ^self packageNames ].
	^#('default')! !

!MetacelloVersionSpec methodsFor: 'construction' stamp: 'dkh 9/10/2012 15:24'!
removeGroup: aString constructor: aVersionConstructor
    aVersionConstructor removeGroupForVersion: aString! !

!MetacelloVersionSpec methodsFor: 'construction' stamp: 'dkh 9/10/2012 15:23'!
baseline: aString constructor: aVersionConstructor
    aVersionConstructor baselineForVersion: aString! !

!MetacelloVersionSpec methodsFor: 'construction' stamp: 'dkh 6/5/2012 19:01:24'!
repositories: aBlock constructor: aVersionConstructor
    aVersionConstructor repositoriesForVersion: aBlock! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
author

	author == nil 
		ifTrue: [
			^self project valueHolderSpec
				value: '';
				yourself].
	^ author! !

!MetacelloVersionSpec methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
label

	^self versionString, ' [', self projectLabel, ']'! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
blessing: anObject

	anObject setBlessingInMetacelloVersion: self! !

!MetacelloVersionSpec methodsFor: 'construction' stamp: 'dkh 9/10/2012 15:24'!
project: aString overrides: aBlock constructor: aVersionConstructor
    aVersionConstructor projectForVersion: aString overrides: aBlock! !

!MetacelloVersionSpec methodsFor: 'construction' stamp: 'dkh 6/5/2012 19:01:24'!
author: aBlockOrString constructor: aVersionConstructor
    aVersionConstructor authorForVersion: aBlockOrString! !

!MetacelloVersionSpec methodsFor: 'printing' stamp: 'dkh 6/5/2012 19:01:24'!
configMethodOn: aStream indent: indent

	self configMethodOn: aStream last: true indent: indent! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
getPreLoadDoIt
	^preLoadDoIt! !

!MetacelloVersionSpec methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
setTimestamp: anObject
	timestamp := anObject! !

!MetacelloVersionSpecTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testVersionSpec
    | version |
    version := self versionSpec
        blessing: #'baseline';
        versionString: '1.0';
        description: 'A description';
        author: 'dkh';
        timestamp: '1/24/2012 09:59';
        preLoadDoIt: #'preLoadDoIt';
        postLoadDoIt: #'postLoadDoIt';
        yourself.
    self assert: version blessing value = #'baseline'.
    self assert: version versionString value = '1.0'.
    self assert: version description value = 'A description'.
    self assert: version author value = 'dkh'.
    self assert: version timestamp value = '1/24/2012 09:59'.
    self assert: version preLoadDoIt value == #'preLoadDoIt'.
    self assert: version postLoadDoIt value == #'postLoadDoIt'.
    self should: [ version preLoadDoIt: '' ] raise: Error.
    self should: [ version postLoadDoIt: '' ] raise: Error! !

!MetacelloVersionSpecTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testVersionSpecCreateVersion
    | spec version |
    spec := self versionSpec
        blessing: #'baseline';
        versionString: '1.0';
        description: 'A description';
        author: 'dkh';
        timestamp: '1/24/2012 09:59';
        preLoadDoIt: #'preLoadDoIt';
        postLoadDoIt: #'postLoadDoIt';
        yourself.
    version := spec createVersion.
    self assert: version class == spec versionClass.
    self assert: version spec == spec.
    self assert: version versionNumber asString = '1.0'.
    self assert: version blessing = #'baseline'.
    self assert: version versionString = '1.0'.
    self assert: version description = 'A description'.
    self assert: version author = 'dkh'.
    self assert: version timestamp = '1/24/2012 09:59'! !

!MetacelloVersionSpecTestCase methodsFor: 'tests' stamp: 'dkh 5/4/2012 20:37:12'!
testVersionMergeSpec
    | versionA versionB version |
    versionA := self versionSpec
        blessing: #'baseline';
        versionString: '1.0';
        description: 'A description';
        author: 'dkh';
        timestamp: '1/24/2012 09:59';
        preLoadDoIt: #'preLoadDoIt';
        postLoadDoIt: #'postLoadDoIt';
        yourself.
    versionB := self versionSpec
        blessing: #'release';
        versionString: '1.1';
        description: 'A FULL description';
        author: 'DaleHenrichs';
        timestamp: '1/24/2012 10:22';
        preLoadDoIt: #'preLoadDoItB';
        postLoadDoIt: #'postLoadDoItB';
        yourself.
    version := versionA mergeSpec: versionB.
    self assert: version blessing value = #'release'.
    self assert: version versionString value = '1.1'.
    self assert: version description value = 'A FULL description'.
    self assert: version author value = 'DaleHenrichs'.
    self assert: version timestamp value = '1/24/2012 10:22'.
    self assert: version preLoadDoIt value == #'preLoadDoItB'.
    self assert: version postLoadDoIt value == #'postLoadDoItB'! !

!MetacelloVersionValidator methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
errorReasonCodes
    ^ #(#'duplicateNames' #'shadowedNames' #'invalidDoItSelector' #'invalidVersionString' #'missingVersionImport' #'projectCreationError' #'noVersionsDefined' #'cannotResolveVersion' #'incompleteProjectSpec' #'incorrectVersionString' #'versionCompositionError' #'versionCreationError')! !

!MetacelloVersionValidator methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
validateProjectCreationFrom: aConfigurationClass onError: aBlock
    [ ^ aConfigurationClass project ]
        on: Error , MetacelloValidationNotification , MetacelloErrorInProjectConstructionNotification
        do: [ :ex | 
            (ex isKindOf: MetacelloValidationNotification)
                ifTrue: [ 
                    self validationReport add: ex issue.
                    ex resume ].
            (ex isKindOf: MetacelloErrorInProjectConstructionNotification)
                ifTrue: [ 
                    self
                        recordValidationError:
                            'Error creating version: ' , ex versionString , ' error: ' , ex exception description
                                , ' to reproduce evalutate the following: ''[' , self configurationClass name asString
                                ,
                                    ' project ] on: MetacelloErrorInProjectConstructionNotification do: [:ex | ex resume: true ]'''
                        callSite: #'validateProjectCreationFrom:onError:'
                        reasonCode: #'versionCreationError'.
                    ex resume: false ].
            ^ aBlock value: ex ]! !

!MetacelloVersionValidator methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
recurse: anObject
	recurse := anObject! !

!MetacelloVersionValidator methodsFor: 'validation' stamp: 'dkh 6/5/2012 19:01:24'!
validate
	"Issue 5: 
		[]no shadowing of names across project/package/group boundaries
	 Issue 6: 
		[]package version supplied for each package
		[]no released (stable/bleedingEdge) versions (only development version)
		package spec used instead of project spec in baseline (ConfigurationOfPharo-DaleHenrichs.50)
	Issue 20:
		[]pre and post load doits must be symbols, not blocks
	Others:
		[]symbolic versions can be resolved.
		[]Ensure that versions are Strings and symbolic versions are symbols.
	 	[]Ensure that imported versions are defined."

	self validatePragmas.
	^self validateProject! !

!MetacelloVersionValidator methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
validateBaselineVersionSpec: versionSpec

	self subclassResponsibility! !

!MetacelloVersionValidator methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
validateDoIts: aSpec versionString: versionString errorMessage: errorMessage
	| ar |
	ar := {
		#preLoadDoIt.	'preLoadDoIt selector for '.
		#postLoadDoIt.	'postLoadDoIt selector for '.
	}.
	1 to: ar size by: 2 do: [ :i | 
		| selector |
		selector := (aSpec perform: (ar at: i)) value.
		selector ~~ nil
			ifTrue: [ 
				selector isSymbol
					ifFalse: [ 
						self
							recordValidationError: (ar at: i + 1) , errorMessage , ' is not a symbol'
							versionString: versionString
							callSite: #validateDoIts:versionString:errorMessage:
							reasonCode: #invalidDoItSelector ] ] ]! !

!MetacelloVersionValidator methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
validationReport: anObject
	validationReport := anObject! !

!MetacelloVersionValidator methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
validateVersionSpec: versionSpec

	self subclassResponsibility! !

!MetacelloVersionValidator methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
validatePragmas
    "Ensure that versions are Strings and symbolic versions are symbols.
	 Ensure that imported versions are defined"

    | versionPragmas versionImportPragmas symbolicVersionPragmas versionStrings |
    versionPragmas := self extractVersionPragmas.
    versionImportPragmas := self extractVersionImportPragmas.
    symbolicVersionPragmas := self extractSymbolicVersionPragmas.
    versionStrings := Set new.
    versionPragmas keys , versionImportPragmas keys , symbolicVersionPragmas keys
        do: [ :versionString | 
            (versionStrings includes: versionString)
                ifTrue: [ 
                    self
                        recordValidationCriticalWarning:
                            'version ' , versionString printString , ' is defined multiple times.'
                        versionString: versionString
                        callSite: #'validatePragmas'
                        reasonCode: #'duplicateVersionDefinitions' ]
                ifFalse: [ versionStrings add: versionString ] ].
    versionPragmas
        keysAndValuesDo: [ :versionString :pragmaList | 
            versionString isString
                ifFalse: [ 
                    self
                        recordValidationError: 'version ' , versionString printString , ' is not a String.'
                        versionString: versionString
                        callSite: #'validatePragmas'
                        reasonCode: #'invalidVersionString' ].
            pragmaList size > 1
                ifTrue: [ 
                    self
                        recordValidationCriticalWarning:
                            'version ' , versionString printString , ' is defined multiple times.'
                        versionString: versionString
                        callSite: #'validatePragmas'
                        reasonCode: #'duplicateVersionDefinitions' ] ].
    symbolicVersionPragmas
        keysAndValuesDo: [ :versionString :pragmaList | 
            versionString isSymbol
                ifFalse: [ 
                    self
                        recordValidationError: 'symbolic version ' , versionString printString , ' is not a Symbol.'
                        versionString: versionString
                        callSite: #'validatePragmas'
                        reasonCode: #'invalidVersionString' ].
            pragmaList size > 1
                ifTrue: [ 
                    self
                        recordValidationCriticalWarning:
                            'version ' , versionString printString , ' is defined multiple times.'
                        versionString: versionString
                        callSite: #'validatePragmas'
                        reasonCode: #'duplicateVersionDefinitions' ] ].
    versionImportPragmas
        keysAndValuesDo: [ :versionString :pragmaList | 
            versionString isString
                ifFalse: [ 
                    self
                        recordValidationError: 'version ' , versionString printString , ' is not a String.'
                        versionString: versionString
                        callSite: #'validatePragmas'
                        reasonCode: #'invalidVersionString' ].
            pragmaList size > 1
                ifTrue: [ 
                    self
                        recordValidationCriticalWarning:
                            'version ' , versionString printString , ' is defined multiple times.'
                        versionString: versionString
                        callSite: #'validatePragmas'
                        reasonCode: #'duplicateVersionDefinitions' ].
            pragmaList
                do: [ :versionImportPragma | 
                    (versionImportPragma arguments at: 2)
                        do: [ :importedVersionString | 
                            (versionStrings includes: importedVersionString)
                                ifFalse: [ 
                                    self
                                        recordValidationError:
                                            'version ' , importedVersionString printString , ' referenced in import list of version ' , versionString printString
                                                , ' has not been defined.'
                                        versionString: versionString
                                        callSite: #'validatePragmas'
                                        reasonCode: #'missingVersionImport' ] ] ] ]! !

!MetacelloVersionValidator methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
recurse
	recurse == nil ifTrue: [ recurse := false ].
	^ recurse! !

!MetacelloVersionValidator methodsFor: 'pragma extraction' stamp: 'dkh 6/5/2012 19:01:24'!
extractExcludedValidations

	| exclusionDict |
	exclusionDict := Dictionary new.
	(Pragma 
		allNamed: #excludedValidationIssues:
		in: self configurationClass) do: [:pragma | | exclusions |
			exclusions := pragma argumentAt: 1.
			1 to: exclusions size by: 2 do: [:index |
			exclusionDict 
				at: (exclusions at: index) 
				put: (exclusions at: index + 1) ]].
	^exclusionDict! !

!MetacelloVersionValidator methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
warningReasonCodes
	^ #(#onlyBaselineVersion )! !

!MetacelloVersionValidator methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
recordValidationCriticalWarning: aString versionString: versionString callSite: callSite reasonCode: aSymbol
	"reasonCodes:
		#packageNameMismatch
		#projectClassNameFileMismatch
		#duplicateVersionDefinitions
		#duplicateAttributeBlocks
	"

	(self criticalWarningReasonCodes includes: aSymbol)
		ifFalse: [ self error: 'Unknown critical warning reason code' ].
	((self exludededValidations at: versionString ifAbsent: [ #() ]) includes: aSymbol)
		ifTrue: [ ^self ].
	(self debug includes: #criticalWarning) ifTrue: [ self halt: 'Debug triggered for critical warning: ', aString ].
	self validationReport
		add:
			(MetacelloValidationCriticalWarning
				configurationClass:
					(self recurse
						ifTrue: [ self configurationClass ]
						ifFalse: [ nil ])
				reasonCode: aSymbol
				callSite: callSite
				explanation: aString)! !

!MetacelloVersionValidator methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
validateVersionSpecForSymbolicVersion: versionSpec symbolicVersion: symbolicVersionString

	self subclassResponsibility! !

!MetacelloVersionValidator methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
debug: aCollection
	"Any combination of: #error, #criticalWarning, #warning"

	debug := aCollection! !

!MetacelloVersionValidator methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
visited: anIdentitySet

	visited := anIdentitySet! !

!MetacelloVersionValidator methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
recordValidationError: aString versionString: versionString callSite: callSite reasonCode: aSymbol
	"reasonCodes:
		#noVersionForSymbolicVersion
		#duplicateNames
		#shadowedNames
		#invalidDoItSelector
		#invalidVersionString
		#missingVersionImport
		#projectCreationError
		#noVersionsDefined
		#cannotResolveVersion
		#incompleteProjectSpec
		#incorrectVersionString
	"

	(self errorReasonCodes includes: aSymbol)
		ifFalse: [ self error: 'Unknown error reason code' ].
	((self exludededValidations at: versionString ifAbsent: [ #() ]) includes: aSymbol)
		ifTrue: [ ^self ].
	(self debug includes: #error) ifTrue: [ self halt: 'Debug triggered for error: ', aString ].
	self validationReport
		add:
			(MetacelloValidationError
				configurationClass:
					(self recurse
						ifTrue: [ self configurationClass ]
						ifFalse: [ nil ])
				reasonCode: aSymbol
				callSite: callSite
				explanation: aString)! !

!MetacelloVersionValidator methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
visited

	visited == nil ifTrue: [ visited := IdentitySet new ].
	^visited! !

!MetacelloVersionValidator methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
validationReport
	
	validationReport == nil ifTrue: [ validationReport := OrderedCollection new ].
	^ validationReport! !

!MetacelloVersionValidator methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
criticalWarningReasonCodes
    ^ #(#'packageNameMismatch' #'projectClassNameFileMismatch' #'duplicateVersionDefinitions')! !

!MetacelloVersionValidator methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
recordValidationCriticalWarning: aString callSite: callSite reasonCode: aSymbol

	^self recordValidationCriticalWarning: aString versionString: nil callSite: callSite reasonCode: aSymbol
! !

!MetacelloVersionValidator methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
recordValidationWarning: aString versionString: versionString callSite: callSite reasonCode: aSymbol
	"reasonCodes:
		#onlyBaselineVersion
		#noVersionSpecified
	"

	(self warningReasonCodes includes: aSymbol)
		ifFalse: [ self error: 'Unknown warning reason code' ].
	((self exludededValidations at: versionString ifAbsent: [ #() ]) includes: aSymbol)
		ifTrue: [ ^self ].
	(self debug includes: #warning) ifTrue: [ self halt: 'Debug triggered for critical warning: ', aString ].
	self validationReport
		add:
			(MetacelloValidationWarning
				configurationClass:
					(self recurse
						ifTrue: [ self configurationClass ]
						ifFalse: [ nil ])
				reasonCode: aSymbol
				callSite: callSite
				explanation: aString)! !

!MetacelloVersionValidator methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
configurationClass
	^ configurationClass! !

!MetacelloVersionValidator methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
exludededValidations

	exludededValidations == nil ifTrue: [ exludededValidations := self extractExcludedValidations ].
	^exludededValidations! !

!MetacelloVersionValidator methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
validateProjectVersion: versionString
	| project |
	project := self
		validateProjectCreationFrom: self configurationClass
		onError: [ :ex | 
			self
				recordValidationError:
					'Error creating project: ' , ex description , ' to reproduce evalutate the following: '''
						, self configurationClass name asString , ' project'''
				callSite: #validateProject
				reasonCode: #projectCreationError.
			^ self validationReport ].
	^ self validateProject: project version: versionString! !

!MetacelloVersionValidator methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
recordValidationWarning: aString callSite: callSite reasonCode: aSymbol

				
	^self recordValidationWarning: aString versionString: nil callSite: callSite reasonCode: aSymbol
! !

!MetacelloVersionValidator methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
recordValidationError: aString callSite: callSite reasonCode: aSymbol

	^self recordValidationError: aString versionString: nil callSite: callSite reasonCode: aSymbol
! !

!MetacelloVersionValidator methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
debug

	debug == nil ifTrue: [ debug := #() ].
	^ debug! !

!MetacelloVersionValidator methodsFor: 'validation' stamp: 'dkh 6/5/2012 19:01:24'!
validateProject: project version: versionString
	| version spec |
	(self visited includes: project configuration class)
		ifTrue: [ ^ self validationReport ].
	self visited add: project configuration class.
	[ version := project version: versionString ]
		on: Error
		do: [ :ex | 
			self
				recordValidationError: 'Could not resolve version ' , versionString printString , ' due to error: ' , ex description
				versionString: versionString
				callSite: #validateProject:version:
				reasonCode: #cannotResolveVersion.
			^ self validationReport ].
	spec := version spec.
	[ 
	spec blessing value == #baseline
		ifTrue: [ self validateBaselineVersionSpec: spec ]
		ifFalse: [ self validateVersionSpec: spec ] ]
		on: Error
		do: [ :ex | 
			self
				recordValidationError: 'Error composing version ' , version versionString printString , ': ' , ex description
				versionString: version versionString
				callSite: #validateProject:version:
				reasonCode: #versionCompositionError ].
	^ self validationReport! !

!MetacelloVersionValidator methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
validateProject
	| project |
	project := self
		validateProjectCreationFrom: self configurationClass
		onError: [ :ex | 
			self
				recordValidationError:
					'Error creating project: ' , ex description , ' to reproduce evalutate the following: '''
						, self configurationClass name asString , ' project'''
				callSite: #validateProject
				reasonCode: #projectCreationError.
			^ self validationReport ].
	^ self validateProject: project! !

!MetacelloVersionValidator methodsFor: 'validation' stamp: 'dkh 6/5/2012 19:01:24'!
validateProject: project
	| hasNoBaseline hasNoVersion |
	(self visited includes: project configuration class)
		ifTrue: [ ^ self validationReport ].
	self visited add: project configuration class.
	hasNoBaseline := hasNoVersion := true.
	project versions
		do: [ :version | 
			| spec |
			spec := version spec.
			[ 
			spec blessing value == #baseline
				ifTrue: [ 
					hasNoBaseline := false.
					self validateBaselineVersionSpec: spec ]
				ifFalse: [ 
					hasNoVersion := false.
					self validateVersionSpec: spec ] ]
				on: Error
				do: [ :ex | 
					self
						recordValidationError: 'Error composing version ' , version versionString printString , ': ' , ex description
						versionString: version versionString
						callSite: #validateProject:
						reasonCode: #versionCompositionError ] ].
	project symbolicVersionMap keys
		do: [ :symbolicVersion | 
			| version |
			version := [ project version: symbolicVersion ]
				on: Error , MetacelloSymbolicVersionNotDefinedError
				do: [ :ex | 
					"MetacelloSymbolicVersionNotDefinedError are explicitly not defined, so are not validation errors"
					(ex isKindOf: MetacelloSymbolicVersionNotDefinedError)
						ifFalse: [ 
							self
								recordValidationError:
									'symbolic version ' , symbolicVersion printString , ' does not resolve to a literal version.'
								callSite: #validatePragmas
								reasonCode: #cannotResolveVersion ].
					ex return: nil ].
			version ~~ nil
				ifTrue: [ self validateVersionSpecForSymbolicVersion: version spec symbolicVersion: symbolicVersion ] ].
	hasNoVersion
		ifTrue: [ 
			hasNoBaseline
				ifTrue: [ 
					self
						recordValidationError: 'No usable baseline or versions defined.'
						callSite: #validatePragmas
						reasonCode: #noVersionsDefined ]
				ifFalse: [ 
					self
						recordValidationWarning: 'Only baseline defined (no version defined).'
						callSite: #validatePragmas
						reasonCode: #onlyBaselineVersion ] ].
	^ self validationReport! !

!MetacelloVersionValidator methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
configurationClass: anObject
	configurationClass := anObject! !

!MetacelloVersionValidator class methodsFor: 'instance creation' stamp: 'dkh 6/5/2012 19:01:24'!
validateConfiguration: configurationClass debug: debugList recurse: aBool
	^ ((self new)
		configurationClass: configurationClass;
		debug: debugList;
		recurse: aBool;
		yourself) validate! !

!MetacelloVersionValidator class methodsFor: 'instance creation' stamp: 'dkh 6/5/2012 19:01:24'!
validateConfiguration: configurationClass recurse: aBool

	^self validateConfiguration: configurationClass debug: #() recurse: aBool! !

!MetacelloVersionValidator class methodsFor: 'instance creation' stamp: 'dkh 6/5/2012 19:01:24'!
validateProject: aMetacelloProject recurse: aBool

	^self validateProject: aMetacelloProject debug: #() recurse: aBool! !

!MetacelloVersionValidator class methodsFor: 'instance creation' stamp: 'dkh 6/5/2012 19:01:24'!
validateProject: aMetacelloProject version: versionString debug: debugList recurse: aBool

	^ ((self new)
		configurationClass: aMetacelloProject configuration class;
		debug: debugList;
		recurse: aBool;
		yourself) validateProject: aMetacelloProject version: versionString! !

!MetacelloVersionValidator class methodsFor: 'instance creation' stamp: 'dkh 6/5/2012 19:01:24'!
validateConfiguration: configurationClass

	^self validateConfiguration: configurationClass debug: #() recurse: false! !

!MetacelloVersionValidator class methodsFor: 'instance creation' stamp: 'dkh 6/5/2012 19:01:24'!
validateProject: aMetacelloProject version: versionString debug: debugList

	^self validateProject: aMetacelloProject version: versionString debug: debugList recurse: false
! !

!MetacelloVersionValidator class methodsFor: 'instance creation' stamp: 'dkh 6/5/2012 19:01:24'!
validateProject: aMetacelloProject debug: debugList recurse: aBool
	^ ((self new)
		recurse: aBool;
		debug: debugList;
		configurationClass: aMetacelloProject configuration class;
		yourself) validateProject: aMetacelloProject! !

!MetacelloVersionValidator class methodsFor: 'private' stamp: 'dkh 6/5/2012 19:01:24'!
populateReasonCodeDescriptions
    "update MetacelloMCVersionValidator class comment to include any changes to descriptions"

    | dict |
    dict := Dictionary new.
    dict
        at: #'onlyBaselineVersion'
        put: 'one or more baseline versions have been defined, but no non-baseline versions are defined.'.
    dict
        at: #'duplicateVersionDefinitions' put: 'there are multiple pragma methods specifying the same version.';
        at: #'packageNameMismatch' put: 'the name in the packageSpec does not match the name of the mcz file.';
        at: #'projectClassNameFileMismatch'
            put: 'the class name of the configuration does not match the mcz file containing the configuration.';
        at: #'cannotResolveVersion'
            put: 'the version (project reference or symbolic version) was not found in the specified configuration.'.
    dict
        at: #'duplicateNames'
            put: 'multiple independent definitions for an entity with same name (project, package, or group).';
        at: #'incompleteProjectSpec' put: 'missing required fields in project reference (repository, className).';
        at: #'incorrectVersionString' put: 'the version declared in pragma doesn''t match version in versionSpec.';
        at: #'invalidDoItSelector' put: 'doit select must be a Symbol.';
        at: #'invalidVersionString' put: 'versionString must be a String.';
        at: #'missingVersionImport' put: 'version specified in import pragma not defined in configuration.';
        at: #'noVersionsDefined'
            put: 'no usable baseline or version defined in configuration ... configuration cannot be loaded.';
        at: #'projectCreationError' put: 'error occured while resolving project reference.';
        at: #'versionCreationError'
            put:
                'error occured while resolving version specification, error will be thrown if an attempt is made to use the version.';
        at: #'shadowedNames' put: 'name duplication between packages and projects.';
        at: #'versionCompositionError' put: 'error while creating versionSpec from pragmas.'.
    ^ dict! !

!MetacelloVersionValidator class methodsFor: 'instance creation' stamp: 'dkh 6/5/2012 19:01:24'!
validateProject: aMetacelloProject version: versionString debug: debugList recurse: aBool visited: visitied

	^(self new
		configurationClass: aMetacelloProject configuration class;
		debug: debugList;
		recurse: aBool;
		visited: visitied;
		yourself) validateProject: aMetacelloProject version: versionString! !

!MetacelloVersionValidator class methodsFor: 'instance creation' stamp: 'dkh 6/5/2012 19:01:24'!
validateProject: aMetacelloProject version: versionString

	^self validateProject: aMetacelloProject version: versionString debug: #() recurse: false
! !

!MetacelloVersionValidator class methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
descriptionForReasonCode: reasonCode
	^ self reasonCodeDescriptions at: reasonCode ifAbsent: [ self error: 'Unknown reasonCode: ' , reasonCode printString ]! !

!MetacelloVersionValidator class methodsFor: 'instance creation' stamp: 'dkh 6/5/2012 19:01:24'!
validateProject: aMetacelloProject

	^self validateProject: aMetacelloProject debug: #() recurse: false! !

!MetacelloVersionValidator class methodsFor: 'accessing' stamp: 'dkh 6/5/2012 19:01:24'!
reasonCodeDescriptions

	reasonCodeDescriptions ifNil: [ reasonCodeDescriptions := self populateReasonCodeDescriptions ].
	^reasonCodeDescriptions! !

!MetacelloVisitedPackages methodsFor: 'visiting' stamp: 'dkh 6/8/2012 14:04:22'!
visit: aSpec doing: aBlock

	aSpec
		projectDo: [:spec | 
			(projects includes: spec name) ifTrue: [ ^self ].
			projects add: spec name ] 
		packageDo: [:spec | 
			(packages includes: spec name) ifTrue: [ ^self ].
			packages add: spec name ] 
		groupDo: [:spec | 
			(groups includes: spec name) ifTrue: [ ^self ].
			groups add: spec name ].
	aBlock value: aSpec! !

!MetacelloVisitedPackages methodsFor: 'initialize-release' stamp: 'dkh 6/8/2012 14:04:22'!
initialize

	groups := Set new.
	packages := Set new.
	projects := Set new.! !

!MetacelloVisitedPackages methodsFor: 'visiting' stamp: 'dkh 6/8/2012 14:04:22'!
pushProject: aBlock

	| oldGroups oldPackages oldProjects |
	oldGroups := groups.
	oldPackages := packages.
	oldProjects := projects.
	groups := Set new.
	packages := Set new.
	^aBlock ensure: [
		groups := oldGroups.
		packages := oldPackages.
		projects := oldProjects ]! !

!Metaclass commentStamp: '<historical>'!
My instances add instance-specific behavior to various class-describing objects in the system. This typically includes messages for initializing class variables and instance creation messages particular to a class. There is only one instance of a particular Metaclass, namely the class which is being described. A Metaclass shares the class variables of its instance.
	
[Subtle] In general, the superclass hierarchy for metaclasses parallels that for classes. Thus,
	Integer superclass == Number, and
	Integer class superclass == Number class.
However there is a singularity at Object. Here the class hierarchy terminates, but the metaclass hierarchy must wrap around to Class, since ALL metaclasses are subclasses of Class. Thus,
	Object superclass == nil, and
	Object class superclass == Class.

[Subtle detail] A class is know by name to an environment.  Typically this is the SystemDictionary named Smalltalk.  If we ever make lightweight classes that are not in Smalltalk, they must be in some environment.  Specifically, the code that sets 'wasPresent' in name:inEnvironment:subclassOf:instanceVariableNames:variable:words:pointers:classVariableNames:poolDictionaries:category:comment:changed: must continue to work.!
!Metaclass methodsFor: 'testing' stamp: ''!
isObsolete
	"Return true if the receiver is obsolete"
	^self soleInstance == nil "Either no thisClass"
		or:[self soleInstance classSide ~~ self "or I am not the class of thisClass"
			or:[self soleInstance isObsolete]] "or my instance is obsolete"! !

!Metaclass methodsFor: 'composition' stamp: ''!
assertConsistantCompositionsForNew: aTraitComposition
	"Applying or modifying a trait composition on the class side
	of a behavior has some restrictions."

	| baseTraits notAddable message |
	baseTraits := aTraitComposition traits select: [:each | each isBaseTrait].
	baseTraits isEmpty ifFalse: [
		notAddable := (baseTraits reject: [:each | each classSide methodDict isEmpty]).
		notAddable isEmpty ifFalse: [
			message := String streamContents: [:stream |
				stream nextPutAll: 'You can not add the base trait(s)'; cr.
				notAddable
					do: [:each | stream nextPutAll: each name]
					separatedBy: [ stream nextPutAll: ', '].
				stream cr; nextPutAll: 'to this composition because it/they define(s) methods on the class side.'].
		^TraitCompositionException signal: message]].
		
	(self instanceSide traitComposition traits asSet =
			(aTraitComposition traits
				select: [:each | each isClassTrait]
				thenCollect: [:each | each baseTrait]) asSet) ifFalse: [
				^TraitCompositionException signal: 'You can not add or remove class side traits on
				the class side of a composition. (But you can specify aliases or exclusions
				for existing traits or add a trait which does not have any methods on the class side.)']! !

!Metaclass methodsFor: 'accessing' stamp: ''!
soleInstance
	"The receiver has only one instance. Answer it."

	^thisClass! !

!Metaclass methodsFor: 'accessing' stamp: 'al 3/25/2006 12:38'!
traitComposition: aTraitComposition
	traitComposition := aTraitComposition! !

!Metaclass methodsFor: 'initialize-release' stamp: 'ar 7/13/1999 04:52'!
adoptInstance: oldInstance from: oldMetaClass 
	"Recreate any existing instances of the argument, oldClass, as instances of 
	the receiver, which is a newly changed class. Permute variables as 
	necessary."
	thisClass class == self ifTrue:[^self error:'Metaclasses have only one instance'].
	oldMetaClass isMeta ifFalse:[^self error:'Argument must be Metaclass'].
	oldInstance class == oldMetaClass ifFalse:[^self error:'Not the class of argument'].
	^thisClass := self 
		newInstanceFrom: oldInstance 
		variable: self isVariable 
		size: self instSize 
		map: (self instVarMappingFrom: oldMetaClass)! !

!Metaclass methodsFor: '*Manifest-Core' stamp: ''!
criticTheNonMetaclassClass

	^self theNonMetaClass ! !

!Metaclass methodsFor: 'initialize' stamp: ''!
initializeFrom: anotherClassTrait
	self traitComposition: self traitComposition copyTraitExpression.
	self methodDict: self methodDict copy.
	self localSelectors: self localSelectors copy.
	self basicOrganization: self organization copy.! !

!Metaclass methodsFor: '*Ring-Core-Kernel' stamp: ''!
asFullRingDefinition

	^ self theNonMetaClass asFullRingDefinition theMetaClass! !

!Metaclass methodsFor: 'compiling' stamp: ''!
bindingOf: varName

	^self theNonMetaClass classBindingOf: varName! !

!Metaclass methodsFor: 'class hierarchy' stamp: ''!
addSubclass: aClass
	"Do nothing."! !

!Metaclass methodsFor: 'accessing' stamp: ''!
category
	^ self theNonMetaClass category! !

!Metaclass methodsFor: '*Tools' stamp: 'SeanDeNigris 5/28/2013 17:46'!
canonicalArgumentName

	^ 'aClass'.! !

!Metaclass methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/12/2013 14:42'!
classClass
	^self! !

!Metaclass methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/12/2013 14:42'!
baseClass
	^thisClass.! !

!Metaclass methodsFor: 'composition' stamp: ''!
uses: aTraitCompositionOrArray
	| copyOfOldTrait newComposition |
	copyOfOldTrait := self copy.
	newComposition := aTraitCompositionOrArray asTraitComposition.
	self assertConsistantCompositionsForNew: newComposition.
	self setTraitComposition: newComposition.
	SystemAnnouncer uniqueInstance
		traitDefinitionChangedFrom: copyOfOldTrait to: self.! !

!Metaclass methodsFor: 'instance variables' stamp: ''!
addInstVarNamed: aString 
	"Add the argument, aString, as one of the receiver's instance variables."

	| fullString |
	fullString := String streamContents: [:strm |
		self instVarNames do: [:aString2 | strm nextPutAll: aString2; space].
		strm nextPutAll: aString].
	self instanceVariableNames: fullString! !

!Metaclass methodsFor: 'compiling' stamp: ''!
binding
	"return an association that can be used as the binding
	 To share it between methods, reuse an existing one if possible"
	^self methodDict 
		ifEmpty: [nil -> self]
		ifNotEmpty: [:dict | dict anyOne classBinding]! !

!Metaclass methodsFor: 'copying' stamp: 'nice 12/29/2010 10:21'!
postCopy
	"Don't share the reference to the sole instance."

	super postCopy.
	thisClass := nil.! !

!Metaclass methodsFor: 'class hierarchy' stamp: ''!
addObsoleteSubclass: aClass
	"Do nothing."! !

!Metaclass methodsFor: '*Ring-Core-Kernel' stamp: ''!
asRingDefinition

	^ self theNonMetaClass asRingDefinition theMetaClass! !

!Metaclass methodsFor: 'initialize-release' stamp: ''!
uses: aTraitCompositionOrArray instanceVariableNames: instVarString 
	| newComposition newMetaClass copyOfOldMetaClass |
	
	copyOfOldMetaClass := self copy.
	newMetaClass := self instanceVariableNames: instVarString.
	
	newComposition := aTraitCompositionOrArray asTraitComposition.
	newMetaClass assertConsistantCompositionsForNew: newComposition.
	newMetaClass setTraitComposition: newComposition.
	
	SystemAnnouncer uniqueInstance
		classDefinitionChangedFrom: copyOfOldMetaClass to: newMetaClass! !

!Metaclass methodsFor: 'accessing' stamp: ''!
name
	"Answer a String that is the name of the receiver, either 'Metaclass' or 
	the name of the receiver's class followed by ' class'."

	thisClass == nil
		ifTrue: [^'a Metaclass']
		ifFalse: [^thisClass name , ' class']! !

!Metaclass methodsFor: 'pool variables' stamp: ''!
sharedPools
	^OrderedCollection new.! !

!Metaclass methodsFor: 'accessing' stamp: 'al 3/25/2006 13:16'!
basicLocalSelectors: aSetOrNil
	localSelectors := aSetOrNil! !

!Metaclass methodsFor: 'testing' stamp: ''!
isAnonymous
	^self soleInstance isAnonymous ! !

!Metaclass methodsFor: 'fileIn/Out' stamp: 'ar 12/22/1999 17:31'!
fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex
	^self fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex initializing: true! !

!Metaclass methodsFor: 'compiling' stamp: ''!
acceptsLoggingOfCompilation
	"Answer whether the receiver's method submisions and class defintions should be logged to the changes file and to the current change set.  The metaclass follows the rule of the class itself."

	^ self theNonMetaClass acceptsLoggingOfCompilation! !

!Metaclass methodsFor: 'class hierarchy' stamp: ''!
removeSubclass: aClass
	"Do nothing."! !

!Metaclass methodsFor: 'instance variables' stamp: ''!
removeInstVarNamed: aString 
	"Remove the argument, aString, as one of the receiver's instance variables."

	| newArray newString |
	(self instVarNames includes: aString)
		ifFalse: [self error: aString , ' is not one of my instance variables'].
	newArray := self instVarNames copyWithout: aString.
	newString := ''.
	newArray do: [:aString2 | newString := aString2 , ' ' , newString].
	self instanceVariableNames: newString! !

!Metaclass methodsFor: 'testing' stamp: 'MarcusDenker 10/17/2013 12:08'!
isClass
	^ true! !

!Metaclass methodsFor: '*Fuel' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper

	^aGeneralMapper visitMetaclass: self
! !

!Metaclass methodsFor: 'class hierarchy' stamp: ''!
obsoleteSubclasses
	"Answer the receiver's subclasses."
	self theNonMetaClass == nil ifTrue:[^#()].
	^self theNonMetaClass obsoleteSubclasses 
		select:[:aSubclass| aSubclass isMeta not] 
		thenCollect:[:aSubclass| aSubclass class]

	"Metaclass allInstancesDo:
		[:m | Compiler evaluate: 'subclasses:=nil' for: m logged: false]"! !

!Metaclass methodsFor: 'accessing' stamp: 'ar 7/11/1999 05:19'!
environment
	^thisClass environment! !

!Metaclass methodsFor: 'fileIn/Out' stamp: ''!
fileOutInitializerOn: aStream
	(self includesSelector: #initialize) ifTrue: 
		[aStream cr.
		aStream nextChunkPut: self soleInstance name , ' initialize'].! !

!Metaclass methodsFor: 'initialize-release' stamp: 'MarcusDenker 2/19/2015 15:47'!
instanceVariableNames: instVarString 
	"Declare additional named variables for my instance."
	| theClass |
	theClass := self theNonMetaClass.
	
	theClass := PharoClassInstaller make: [ :builder |
		builder
			superclass: theClass superclass;
			name: theClass name;
			layoutClass: theClass layout class;
			slots: theClass slots;
			sharedVariablesFromString: theClass classVariablesString;
			sharedPools: theClass sharedPoolsString;
			traitComposition: theClass traitComposition;
			category: theClass category asString;
			classSlots: instVarString asSlotCollection ].
	^ theClass theMetaClass! !

!Metaclass methodsFor: 'accessing instances and variables' stamp: ''!
classVarNames
	"Answer a set of the names of the class variables defined in the receiver's instance."
	
	self theNonMetaClass ifNil: [ ^ Set new ].
	^self theNonMetaClass classVarNames! !

!Metaclass methodsFor: 'copying' stamp: 'tk 8/19/1998 16:16'!
veryDeepCopyWith: deepCopier
	"Return self.  Must be created, not copied.  Do not record me."! !

!Metaclass methodsFor: '*OpalCompiler-Core' stamp: ''!
compilerClass
	"The compiler class is defined on instance-side to be able to customize it for *one* metaclass"
	^ self instanceSide classSideCompilerClass! !

!Metaclass methodsFor: 'composition' stamp: ''!
noteNewBaseTraitCompositionApplied: aTraitComposition
	"The argument is the new trait composition of my base trait - add
	the new traits or remove non existing traits on my class side composition.
	(Each class trait in my composition has its base trait on the instance side
	of the composition - manually added traits to the class side are always 
	base traits.)"
	
	| newComposition traitsFromInstanceSide |
	traitsFromInstanceSide := self traitComposition traits
		select: [:each | each isClassTrait]
		thenCollect: [:each | each baseTrait].
		
	newComposition := self traitComposition copyTraitExpression.
	(traitsFromInstanceSide copyWithoutAll: aTraitComposition traits) do: [:each |
		newComposition removeFromComposition: each classTrait].
	(aTraitComposition traits copyWithoutAll: traitsFromInstanceSide) do: [:each |
		newComposition add:  (each classTrait)].

	self setTraitComposition: newComposition! !

!Metaclass methodsFor: 'class hierarchy' stamp: ''!
subclassesDo: aBlock
	"Evaluate aBlock for each of the receiver's immediate subclasses."
	self theNonMetaClass subclassesDo:[:aSubclass|
		"The following test is for Class class which has to exclude
		the Metaclasses being subclasses of Class."
		aSubclass isMeta ifFalse:[aBlock value: aSubclass class]].! !

!Metaclass methodsFor: 'accessing' stamp: 'al 3/25/2006 12:35'!
traitComposition
	traitComposition ifNil: [traitComposition := TraitComposition new].
	^traitComposition! !

!Metaclass methodsFor: 'fileIn/Out' stamp: 'MarcusDenker 1/13/2015 10:44'!
definition
	"Refer to the comment in ClassDescription|definition."

	^ String streamContents: 
		[:strm |
		strm print: self.
		self hasTraitComposition ifTrue: [
			strm
				crtab;
				nextPutAll: 'uses: ';
				print: self traitComposition ].
		
		(self usesSpecialSlot or: [ Slot showSlotClassDefinition ])
			ifFalse: [  
						strm
							crtab;
							nextPutAll: 'instanceVariableNames: ';
							store: self instanceVariablesString]
			ifTrue: [ 
						strm
							crtab;
							nextPutAll: 'slots: ';
							nextPutAll: self slotDefinitionString]]! !

!Metaclass methodsFor: 'accessing hierarchy protocol' stamp: ''!
hasClassSide
	^false! !

!Metaclass methodsFor: 'fileIn/Out' stamp: ''!
nonTrivial 
	"Answer whether the receiver has any methods or instance variables."

	^ self instVarNames notEmpty or: [self hasMethods or: [self hasTraitComposition]]! !

!Metaclass methodsFor: 'testing' stamp: ''!
isMeta
	^ true! !

!Metaclass methodsFor: 'fileIn/Out' stamp: 'MarcusDenker 5/7/2013 23:32'!
fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex initializing: aBool
	super fileOutOn: aFileStream
		moveSource: moveSource
		toFile: fileIndex.
	(aBool and:[moveSource not and: [self includesSelector: #initialize]]) ifTrue: 
		[aFileStream cr.
		aFileStream cr.
		aFileStream nextChunkPut: thisClass name , ' initialize'.
		aFileStream cr]! !

!Metaclass methodsFor: 'compiling' stamp: ''!
possibleVariablesFor: misspelled continuedFrom: oldResults

	^ self theNonMetaClass possibleVariablesFor: misspelled continuedFrom: oldResults
! !

!Metaclass methodsFor: 'testing' stamp: ''!
canZapMethodDictionary
	"Return true if it is safe to zap the method dictionary on #obsolete"
	self soleInstance == nil
		ifTrue:[^true]
		ifFalse:[^self soleInstance canZapMethodDictionary]! !

!Metaclass methodsFor: 'pool variables' stamp: ''!
classPool
	"Answer the dictionary of class variables."

	^self theNonMetaClass classPool! !

!Metaclass methodsFor: 'instance creation' stamp: 'nk 11/9/2003 10:00'!
new
	"The receiver can only have one instance. Create it or complain that
	one already exists."

	thisClass class ~~ self
		ifTrue: [^thisClass := self basicNew]
		ifFalse: [self error: 'A Metaclass should only have one instance!!']! !

!Metaclass methodsFor: 'compiling' stamp: ''!
wantsChangeSetLogging
	"Answer whether code submitted for the receiver should be remembered by the changeSet mechanism.The metaclass follows the rule of the class itself."

	^ self theNonMetaClass wantsChangeSetLogging! !

!Metaclass methodsFor: 'accessing' stamp: 'al 3/25/2006 13:16'!
basicLocalSelectors
	"Direct accessor for the instance variable localSelectors.
	Since localSelectors is lazily initialized, this may 
	return nil, which means that all selectors are local."

	^ localSelectors! !

!Metaclass methodsFor: 'compiling' stamp: ''!
wantsRecompilationProgressReported
	"The metaclass follows the rule of the class itself."

	^ self theNonMetaClass wantsRecompilationProgressReported! !

!Metaclass methodsFor: '*OpalCompiler-Core' stamp: ''!
compiler
	"The compiler is defined on instance-side to be able to customize it for *one* metaclass"
	^ self instanceSide classSideCompiler! !

!Metaclass methodsFor: '*NativeBoost-Core' stamp: 'Igor.Stasenko 9/28/2010 08:00'!
externalTypeAlias: aName
	"redirect request to my instance side"
	^ self instanceSide externalTypeAlias: aName! !

!Metaclass methodsFor: 'initialize-release' stamp: 'MarcusDenker 1/12/2015 16:07'!
slots: slotsDefinition 
	"Declare additional named variables for my instance."
	^thisClass classBuilder
		class: self
		slots: slotsDefinition! !

!Metaclass methodsFor: 'testing' stamp: ''!
isSelfEvaluating
	^self isObsolete not! !

!Metaclass methodsFor: 'class hierarchy' stamp: ''!
subclasses
	"Answer the receiver's subclasses."
	self theNonMetaClass == nil ifTrue:[^#()].
	^self theNonMetaClass subclasses 
		select:[:aSubclass| aSubclass isMeta not] 
		thenCollect:[:aSubclass| aSubclass class]

	"Metaclass allInstancesDo:
		[:m | Compiler evaluate: 'subclasses:=nil' for: m logged: false]"! !

!MetaclassTest commentStamp: 'TorstenBergmann 2/5/2014 08:40'!
Sunit tests for metaclasses!
!MetaclassTest methodsFor: 'tests' stamp: 'MarcusDenker 11/3/2013 11:42'!
testMetaclassAndTraitClassRespectsPolymorphismRules
	| repeatedMethodsThatDoNotAccessInstanceVariables differentMethodsWithSameSelector |
	"If the method is in Metaclass and ClassTrait it must access some instance variable, otherwise the method can be implemented in TApplyingOnClassSide"
	repeatedMethodsThatDoNotAccessInstanceVariables := self
		repeatedMethodsThatDoNotAccessInstanceVariablesBetween: Metaclass
		and: ClassTrait.
	self assert: repeatedMethodsThatDoNotAccessInstanceVariables size = 0.	"If the method is in Metaclass and ClassTrait, and they have different implementations, it must be declared in TApplyingOnClassSide as an explicitRequirement method"
	differentMethodsWithSameSelector := self differentMethodsWithSameSelectorBetween: Metaclass and: ClassTrait.
	differentMethodsWithSameSelector
		do: [ :selector | 
			(TApplyingOnClassSide >> selector) sourceCode.
			self assert: (TApplyingOnClassSide >> selector) isRequired ].	"Only a few methods are allowed to belong to one class and not to the other
	It would be excelent to remove these methods somehow, but is NOT good idea add methods to this list"	"basicLocalSelectors basicLocalSelectors: localSelectors localSelectors: traitComposition traitComposition: -> accessors to instance variables that do not belong to ClassTrait
	baseClass classClass -> they have their equivalent for ClassTraits (baseTrait classTrait)
	environment postCopy -> the implementation for ClassTrait is in TBehavior
	veryDeepCopyWith: -> the implementation for ClassTraits is in Object
	fileOutOn:moveSource:toFile: fileOutOn:moveSource:toFile:initializing: -> the implementation for ClassTraits is in TClassDescription"
	self
		assert:
			(Metaclass localSelectors difference: ClassTrait localSelectors)
				=
					{#externalTypeAlias:.
					#baseClass.
					#basicLocalSelectors:.
					#basicLocalSelectors.
					#classClass.
					#isClass.
					#environment.
					#fileOutOn:moveSource:toFile:.
					#fileOutOn:moveSource:toFile:initializing:.
					#postCopy.
					#traitComposition.
					#traitComposition:.
					#veryDeepCopyWith:} asSet.	"initializeWithBaseTrait: asMCDefinition -> has no equivalent in classes
	baseTrait isClassTrait classTrait baseTrait isBaseTrait classTrait: -> they have their equivalent for Metaclasses
	compile:classified:withStamp:notifying:logSource: -> the implementation for Metaclasses is in TClassDescription
	copy -> the implementation for Metaclasses is in Object"
	self
		assert:
			(ClassTrait localSelectors difference: Metaclass localSelectors)
				=
					{#initializeWithBaseTrait:.
					#asMCDefinition.
					#baseTrait:.
					#isClassTrait.
					#classTrait.
					#baseTrait.
					#compile:classified:withStamp:notifying:logSource:.
					#isBaseTrait.
					#copy.
					#classTrait:} asSet! !

!MethodAdded commentStamp: 'cyrilledelaunay 1/18/2011 13:06'!
This announcement is emited when we add a method to a class or a trait using:
	=> Behavior >> compile: or TraitBehavior >> compile:!
!MethodAdded methodsFor: 'accessing' stamp: 'CamilleTeruel 9/4/2014 18:00'!
methodAdded
	^ method! !

!MethodAdded class methodsFor: 'instance creation' stamp: 'CamilleTeruel 9/4/2014 16:31'!
method: aCompiledMethod
	^self new
		method: aCompiledMethod;
		yourself! !

!MethodAddition commentStamp: 'rej 2/25/2007 19:30'!
I represent the addition of a method to a class.  I can produce the CompiledMethod, install it, and then notify the system that the method has been added.  This allows Monticello to implement atomic addition.  A loader can compile all classes and methods first and then install all methods only after they have been all compiled, and in a way that executes little code.ß!
!MethodAddition methodsFor: 'operations' stamp: 'rej 2/25/2007 22:09'!
installMethod
	myClass addSelectorSilently: selector withMethod: compiledMethod.
! !

!MethodAddition methodsFor: 'operations' stamp: 'MarcusDenker 4/30/2013 10:17'!
writeSourceToLog
	logSource ifTrue: [
		myClass logMethodSource: text forMethod: compiledMethod
			inCategory: category withStamp: changeStamp
	].
! !

!MethodAddition methodsFor: 'accessing' stamp: 'PavelKrivanek 12/6/2012 22:54'!
priorCategoryOrNil: anObject
	priorCategoryOrNil := anObject! !

!MethodAddition methodsFor: 'operations' stamp: 'MarcusDenker 9/5/2013 15:41'!
createCompiledMethod
	compiledMethod := myClass compiler 
		source: text asString;
		requestor: requestor;
		category: category;
		failBlock: [ ^nil ];
		compile.
	selector := compiledMethod selector.
	self writeSourceToLog.
	priorMethodOrNil := myClass compiledMethodAt: selector ifAbsent: [ nil ].
	priorCategoryOrNil := myClass organization categoryOfElement: selector! !

!MethodAddition methodsFor: 'notifying' stamp: 'CamilleTeruel 9/4/2014 17:34'!
notifyObservers
	SystemAnnouncer uniqueInstance 
		suspendAllWhile: [myClass organization classify: selector under: category].
	priorMethodOrNil 
		ifNil: [ SystemAnnouncer uniqueInstance methodAdded: compiledMethod ]
		ifNotNil: [
			SystemAnnouncer uniqueInstance methodChangedFrom: priorMethodOrNil to: compiledMethod oldProtocol: priorCategoryOrNil.
			priorCategoryOrNil = category ifFalse: [
       			SystemAnnouncer uniqueInstance methodRecategorized: compiledMethod oldProtocol: priorCategoryOrNil ] ].
	"The following code doesn't seem to do anything."
	myClass instanceSide noteCompilationOf: selector meta: myClass isClassSide.
! !

!MethodAddition methodsFor: 'compilation' stamp: 'rej 2/25/2007 20:36'!
compile: aString classified: aString1 withStamp: aString2 notifying: aRequestor logSource: aBoolean inClass: aClass

	text := aString.
	category := aString1.
	changeStamp := aString2.
	requestor := aRequestor.
	logSource := aBoolean.
	myClass := aClass! !

!MethodAddition methodsFor: 'accessing' stamp: 'PavelKrivanek 12/6/2012 22:54'!
priorCategoryOrNil
	^ priorCategoryOrNil! !

!MethodAddition methodsFor: 'compilation' stamp: 'rej 2/26/2007 10:51'!
compile
    "This method is the how compiling a method used to work.  All these steps were done at once.
     This method should not normally be used, because the whole point of MethodAddition is to let
	you first create a compiled method and then install the method later."
	self createCompiledMethod.
	self installMethod.
	self notifyObservers.
	^selector! !

!MethodAnnouncement commentStamp: 'CamilleTeruel 9/4/2014 14:33'!
An abstract class for method announcements.!
!MethodAnnouncement methodsFor: 'accessing' stamp: 'CamilleTeruel 9/4/2014 14:32'!
method: aCompiledMethod
	method := aCompiledMethod! !

!MethodAnnouncement methodsFor: 'accessing' stamp: 'CamilleTeruel 9/4/2014 15:14'!
protocol
	
	^ method protocol! !

!MethodAnnouncement methodsFor: 'accessing' stamp: 'CamilleTeruel 9/4/2014 15:14'!
selector
	
	^ method selector! !

!MethodAnnouncement methodsFor: 'accessing' stamp: 'CamilleTeruel 9/4/2014 14:32'!
method
	
	^ method! !

!MethodAnnouncement methodsFor: 'accessing' stamp: 'CamilleTeruel 9/4/2014 15:36'!
methodClass
	^ method methodClass! !

!MethodAnnouncement methodsFor: 'accessing' stamp: 'CamilleTeruel 9/4/2014 15:58'!
methodAffected
	^self method! !

!MethodAnnouncement methodsFor: 'accessing' stamp: 'CamilleTeruel 9/4/2014 15:37'!
methodOrigin
	^ method origin! !

!MethodAnnouncement methodsFor: 'testing' stamp: 'CamilleTeruel 9/4/2014 15:52'!
isProvidedByATrait

	^ self methodOrigin ~= self methodClass
! !

!MethodBrowser commentStamp: '<historical>'!
A MethodBrowser is a simple browser using Spec to display a list of methods and their source code

	| si |
	si := MethodBrowser new.
	si openWithSpec.
	si methods: Object methodDict values!
!MethodBrowser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/12/2012 19:35'!
acceptBlock: aBlock

	textModel acceptBlock: aBlock! !

!MethodBrowser methodsFor: 'api' stamp: 'BenjaminVanRyseghem 6/6/2012 20:46'!
wrapWith: aBlock

	listModel displayBlock: aBlock! !

!MethodBrowser methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 6/12/2012 19:33'!
initializePresenter

	listModel whenSelectedItemChanged: [:selection |
		selection
			ifNil: [
				textModel text: ''.
				textModel behavior: nil.
				toolbarModel method: nil ]
			ifNotNil: [:m | 
				textModel text: m sourceCode.
				textModel behavior: m methodClass.
				toolbarModel method: m ]].
	
	self acceptBlock: [:t | self listModel selectedItem inspect ].
	self wrapWith: [:item | item methodClass name,'>>#', item selector ].! !

!MethodBrowser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/4/2012 14:42'!
action

	^ textModel actionToPerformHolder content! !

!MethodBrowser methodsFor: 'api' stamp: 'BenjaminVanRyseghem 1/31/2012 13:10'!
methods: aList

	"Here I reroute my entry point to the list model's entry point"
	self listModel items: aList! !

!MethodBrowser methodsFor: 'api' stamp: 'BenjaminVanRyseghem 6/13/2012 16:24'!
sortingBlock: aBlock 

	listModel sortingBlock: aBlock ! !

!MethodBrowser methodsFor: 'api' stamp: 'BenjaminVanRyseghem 6/12/2012 19:32'!
displayBlock: aBlock

	listModel displayBlock: aBlock! !

!MethodBrowser methodsFor: 'initialization' stamp: 'CamilloBruni 9/22/2013 21:34'!
initializeWidgets

	listModel := self newList.
	textModel := self newText.
	toolbarModel := self instantiate: MethodToolbar.
	
	self focusOrder
		add: listModel;
		add: toolbarModel;
		add: textModel.
	
	textModel aboutToStyle: true.! !

!MethodBrowser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/14/2011 14:51'!
textModel

	^ textModel! !

!MethodBrowser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/14/2011 14:51'!
listModel

	^ listModel! !

!MethodBrowser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/18/2012 01:58'!
toolbarModel

	^ toolbarModel! !

!MethodBrowser methodsFor: 'focus' stamp: 'BenjaminVanRyseghem 1/17/2012 03:16'!
takeKeyboardFocus

	^ self listModel takeKeyboardFocus! !

!MethodBrowser class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/1/2013 15:51'!
defaultSpec
	<spec>
	| delta |
	delta := 15.
	^ SpecLayout composed 
			add: #listModel origin: 0@0 corner: 1@0.5 offsetOrigin: 0@0 offsetCorner: 0@(delta negated);
			add: #toolbarModel origin: 0@0.5 corner: 1@0.5 offsetOrigin: 0@(delta negated) offsetCorner: 0@delta;
			add: #textModel origin: 0@0.5 corner: 1@1 offsetOrigin: 0@delta offsetCorner: 0@0;
			yourself! !

!MethodBrowser class methodsFor: 'example' stamp: 'MarcusDenker 5/6/2013 17:11'!
example

	| mb |
	mb := MethodBrowser new.
	mb openWithSpec.
	mb methods: Object methods! !

!MethodBrowser class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/31/2012 13:36'!
title

	^ 'Method Browser'! !

!MethodBrowser class methodsFor: 'specs' stamp: 'bvr 6/4/2012 17:27'!
defaultSpec2
^{ #Panel.
		#changeTableLayout.
		#listDirection:. 	#bottomToTop.
		#addMorph:. 		{#model. #listModel.}.
		#addMorph:. 		{#model. #textModel.}.
		#vResizing:.		 #spaceFill.
		#hResizing:.		 #spaceFill.}! !

!MethodChangeRecord commentStamp: '<historical>'!
MethodChangeRecords are used to record method changes.  Here is a simple summary of the relationship between the changeType symbol and the recording of prior state

			|	prior == nil			|	prior not nil	
	---------	|----------------------------	|--------------------
	add		|	add					|	change
	---------	|----------------------------	|--------------------
	remove	|	addedThenRemoved	|	remove

Structure:
changeType			symbol -- as summarized above
currentMethod	method
				This is the current version of the method.
				It can be used to assert this change upon entry to a layer. 
infoFromRemoval -- an array of size 2.
				The first element is the source index of the last version of the method.
				The second element is the category in which it was defined, so it
				can be put back there if re-accepted from a version browser.

Note that the above states each have an associated revoke action:
	add --> remove
	change --> change back
	remove --> add back
	addedThenRemoved --> no change
However all of these are accomplished trivially by restoring the original method dictionary.!
!MethodChangeRecord methodsFor: 'accessing' stamp: 'di 4/1/2000 12:02'!
changeType

	^ changeType! !

!MethodChangeRecord methodsFor: 'infos' stamp: 'di 4/1/2000 11:05'!
noteMethodInfoFromRemoval: info
	"Store an array with the source index of the last version of the method,
	and the category in which it was defined (so it can be put back there if
	re-accepted from a version browser)."

	infoFromRemoval := info! !

!MethodChangeRecord methodsFor: 'all changes' stamp: 'MarcusDenker 7/25/2014 09:30'!
noteChangeType: newChangeType
	changeType := (changeType == #addedThenRemoved and: [ newChangeType == #change ])
		ifTrue: [ #add ]
		ifFalse: [ newChangeType ]! !

!MethodChangeRecord methodsFor: 'infos' stamp: 'di 4/1/2000 12:02'!
methodInfoFromRemoval
	"Return an array with the source index of the last version of the method,
	and the category in which it was defined (so it can be put back there if
	re-accepted from a version browser)."

	(changeType == #remove or: [changeType == #addedThenRemoved])
		ifTrue: [^ infoFromRemoval]
		ifFalse: [^ nil]! !

!MethodChangeRecord methodsFor: 'printing' stamp: 'di 4/1/2000 12:02'!
printOn: strm

	super printOn: strm.
	strm nextPutAll: ' ('; print: changeType; nextPutAll: ')'! !

!MethodClassInitializeAction commentStamp: '<historical>'!
Action when the method is a class initialize method!
!MethodClassInitializeAction methodsFor: 'order' stamp: 'TorstenBergmann 8/23/2014 00:09'!
isActionHandled

	^ method isClassInitializeMethod ! !

!MethodClassInitializeAction methodsFor: 'order' stamp: 'TorstenBergmann 8/23/2014 00:09'!
privateActionIcon

	 ^IconicButton new 
			target: self browser;
			actionSelector: #runClassInitializeMethod:;
		 	arguments: { method };
			labelGraphic: (Smalltalk ui icons scriptManagerIcon) ;
			color: Color transparent;
			extent: 12 @ 12;
			helpText: '(Re)initialize class';
			borderWidth: 0 ! !

!MethodClassInitializeAction methodsFor: 'order' stamp: 'TorstenBergmann 8/22/2014 23:39'!
actionOrder
	"Return the priority of this action"
	
	^0! !

!MethodClassifier commentStamp: '<historical>'!
I am a method classifier that sets the protocl of methods using some simple rules.

Example Usage:
	MethodClassifier classify: MyClass >> #mySelector!
!MethodClassifier methodsFor: 'initialization' stamp: 'CamilloBruni 1/30/2013 21:02'!
initialize
	self buildPrefixDictionary.! !

!MethodClassifier methodsFor: 'initialization' stamp: 'EstebanLorenzano 1/15/2014 11:27'!
buildPrefixDictionary
	prefixMapping := Dictionary new.
	prefixMapping 
		at: 'test' put: 'tests';
	 	at: 'bench' put: 'benchmarking';
	 	at: 'copy' put: 'copying';
		at: 'initialize' put: 'initialization';
		at: 'accept' put: 'visitor';
		at: 'visit' put: 'visitor';
		at: 'signal' put: 'signalling';
		at: 'parse' put: 'parsing';
		at: 'add' put: 'adding';
		at: 'is' put: 'testing';
		at: 'as' put: 'converting';
		at: 'new' put: 'instance creation'.! !

!MethodClassifier methodsFor: 'classification-rules' stamp: 'CamilloBruni 1/30/2013 22:11'!
classifyInSuperclassProtocol: aMethod
	| currentClass |
	currentClass := aMethod methodClass.
	
	[ currentClass superclass isNil ] whileFalse: [
		currentClass := currentClass superclass.
		(currentClass includesSelector: aMethod selector)
			ifTrue: [ 
				aMethod protocol: (currentClass >> aMethod selector) protocol.
				^ true ]].
	
	^ false.! !

!MethodClassifier methodsFor: 'classification-rules' stamp: 'CamilloBruni 1/30/2013 21:40'!
classifyAccessor: aMethod
	" If the method is a setter or getter for a  "
	| names selector |
	
	names := aMethod methodClass allInstVarNames.
	selector := aMethod selector.
	
	(selector endsWith: ':')
		ifTrue: [ "selector might be a setter"
			selector := selector allButLast ].
	
	(names includes: selector)
		ifFalse: [ ^ false ].
		
	aMethod protocol: 'accessing'.
	^ true.! !

!MethodClassifier methodsFor: 'classification-rules' stamp: 'EstebanLorenzano 5/28/2013 14:10'!
classifyByOtherImplementors: aMethod
	| protocolBag |
	
	protocolBag := Bag new.
	
	aMethod implementors 
		ifEmpty: [ ^ false ]
		ifNotEmpty: [ :methods |
			methods 
				do: [ :method | 
					self flag: 'TODO: at some point we should have first-class protocols which will tell whether they are extensions...'.
					((method protocol beginsWith: '*') or: [ method protocol = Protocol unclassified ])
						ifFalse: [ protocolBag add: method protocol ]]
				without: aMethod ].
			
	protocolBag ifEmpty: [ ^ false ].
	aMethod protocol: protocolBag sortedCounts first value.
	^ true! !

!MethodClassifier methodsFor: 'classification' stamp: 'StephaneDucasse 8/29/2013 22:03'!
classifyAll: aCollectionOfMethods
	
	aCollectionOfMethods do: [ :method |
		self classify: method ]! !

!MethodClassifier methodsFor: 'classification' stamp: 'CamilloBruni 1/30/2013 21:47'!
classify: aMethod
	(self classifyAccessor: aMethod)
		ifTrue: [ ^ aMethod category ].
	(self classifyInSuperclassProtocol: aMethod)
		ifTrue: [ ^ aMethod category ].
		
	(self classifyByKnownPrefix: aMethod)
		ifTrue: [ ^ aMethod category ].
	(self classifyByOtherImplementors: aMethod)
		ifTrue: [ ^ aMethod category ].! !

!MethodClassifier methodsFor: 'classification-rules' stamp: 'CamilloBruni 1/30/2013 22:13'!
classifyByKnownPrefix: aMethod
	prefixMapping keysAndValuesDo: [ :prefix :protocol |
		(aMethod selector beginsWith: prefix)
			ifTrue: [
				aMethod protocol: protocol.
				^ true ]].
	^ false.! !

!MethodClassifier class methodsFor: 'classification' stamp: 'CamilloBruni 1/30/2013 21:45'!
classify: aMethod
	^ self new classify: aMethod! !

!MethodClassifier class methodsFor: 'classification' stamp: 'StephaneDucasse 8/29/2013 22:03'!
classifyAll: aCollectionOfMethods
	^ self new classifyAll: aCollectionOfMethods! !

!MethodContainsFlagsAction commentStamp: '<historical>'!
Action when the method contains a flag!
!MethodContainsFlagsAction methodsFor: 'order' stamp: 'BenjaminVanRyseghem 1/2/2013 12:41'!
isActionHandled
	"Return true if the provided method fits this action requirement"

	^ method containsFlag! !

!MethodContainsFlagsAction methodsFor: 'order' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
privateActionIcon
	"Return the icon for this action"

	^ Smalltalk ui icons iconNamed: #flagIcon! !

!MethodContainsFlagsAction methodsFor: 'order' stamp: 'BenjaminVanRyseghem 1/24/2013 11:03'!
actionOrder
	"Return the priority of this action"

	^ 300! !

!MethodContainsFlagsAction methodsFor: 'order' stamp: 'BenjaminVanRyseghem 1/2/2013 12:52'!
actionStateToCache
	"Return the state of the icon for caching purpose"
	
	^ icon! !

!MethodContainsHaltAction commentStamp: '<historical>'!
Action when the method contains a halt!
!MethodContainsHaltAction methodsFor: 'order' stamp: 'BenjaminVanRyseghem 1/2/2013 12:41'!
isActionHandled

	^ method containsHalt! !

!MethodContainsHaltAction methodsFor: 'order' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
privateActionIcon
	"Return the icon for this action"

	^ Smalltalk ui icons iconNamed: #haltIcon! !

!MethodContainsHaltAction methodsFor: 'order' stamp: 'BenjaminVanRyseghem 2/20/2013 19:57'!
actionOrder
	"Return the priority of this action"
	
	^ 100! !

!MethodContainsHaltAction methodsFor: 'order' stamp: 'BenjaminVanRyseghem 1/2/2013 12:52'!
actionStateToCache
	"Return the state of the icon for caching purpose"
	
	^ icon! !

!MethodContextTest commentStamp: 'tlk 5/31/2004 16:07'!
I am an SUnit Test of MethodContext and its super type, ContextPart. See also BlockContextTest.
See pages 430-437 of A. Goldberg and D. Robson's  Smalltalk-80 The Language (aka the purple book), which deal with Contexts. My fixtures are from their example. (The Squeak byte codes are not quite the same as Smalltalk-80.)
My fixtures are:
aReceiver         - just some arbitrary object, "Rectangle origin: 100@100 corner: 200@200"
aSender           - just some arbitrary object, thisContext
aCompiledMethod - just some arbitrary method, "Rectangle rightCenter".
aMethodContext   - just some arbitray context ...  

!
!MethodContextTest methodsFor: 'tests' stamp: 'mada 5/3/2012 18:57'!
testTempNamed
	| oneTemp context |
	
	oneTemp := 1.
	self assert: (thisContext tempNamed: 'oneTemp') = oneTemp.
	
	context := self class contextWithTempForTesting.
	self assert: (context tempNamed: 'string') = 'test'
! !

!MethodContextTest methodsFor: 'tests - ast mapping' stamp: 'MarcusDenker 10/22/2014 13:19'!
testSourceNodeOptimizedBlock
	"When asking for the sourceNode of a block that is not there at runtime, we nevertheless what to 
	get the corresponding ASTnode of the inlined Block"
	
	| sourceNode |
	
	sourceNode := Smalltalk compiler evaluate: '1 to: 1 do: [ :i | ^ thisContext sourceNode ]'.
	self assert: sourceNode isBlock.! !

!MethodContextTest methodsFor: 'tests' stamp: 'md 2/9/2007 19:08'!
testTempNamedPut
	| oneTemp |
	
	oneTemp := 1.
	self assert: (thisContext tempNamed: 'oneTemp') = oneTemp.
	thisContext tempNamed: 'oneTemp' put: 2.
	self assert: (thisContext tempNamed: 'oneTemp') = 2.! !

!MethodContextTest methodsFor: 'tests' stamp: 'MarcusDenker 3/8/2012 17:19'!
testClosureRestart
	"Test that various combinations of closures are restarted with the expected values"
	"no args, no remote temps blocks are not tested, as I don't know how to do that programatically without ending up looping endlessly"
	self should: [self privRestartBlockTest] notTakeMoreThan: 0.1 second.
	self should: [self privRestartArgBlockTest] notTakeMoreThan: 0.1 second.
	"self should: [self privRestartBlockArgsNoRemoteTempsTest] notTakeMoreThan: 0.1 second" "FAILING!!"! !

!MethodContextTest methodsFor: 'tests' stamp: 'tlk 5/31/2004 17:10'!
testFindContextSuchThat
	self assert: (aMethodContext findContextSuchThat: [:each| true]) printString = aMethodContext printString.
	self assert: (aMethodContext hasContext: aMethodContext). ! !

!MethodContextTest methodsFor: 'running' stamp: 'ClementBera 5/28/2014 13:34'!
setUp
	super setUp.
	aCompiledMethod := Rectangle methodDict at: #rightCenter.
	aReceiver := 100@100 corner: 200@200.
	aSender := thisContext.
	aMethodContext := Context sender: aSender receiver: aReceiver method: aCompiledMethod arguments: #(). ! !

!MethodContextTest methodsFor: 'tests' stamp: 'ClementBera 5/28/2014 13:34'!
testActivateReturnValue
	self assert:  ((aSender activateReturn: aMethodContext value: #()) isKindOf: Context).
	self assert:  ((aSender activateReturn: aMethodContext value: #()) receiver = aMethodContext).! !

!MethodContextTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/30/2012 12:13'!
testSetUp
	"Note: In addition to verifying that the setUp worked the way it was expected to, testSetUp is used to illustrate the meaning of the simple access methods, methods that are not normally otherwise 'tested'"
	
	self deny: aMethodContext isDead.
	self assert: aMethodContext home = aMethodContext.
	self assert: aMethodContext receiver = aReceiver.
	self assert: (aMethodContext method isKindOf: CompiledMethod).
	self assert: aMethodContext method = aCompiledMethod.
	self assert: aMethodContext methodNode selector = #rightCenter.
	self assert: aMethodContext client printString = 'MethodContextTest>>#testSetUp'.
! !

!MethodContextTest methodsFor: 'private' stamp: 'StephaneDucasse 5/28/2011 14:04'!
privRestartArgBlockTest
	"This tests may loop endlessly if incorrect, so call it from another method testing it does not time out"
	|firstTimeThrough |
	firstTimeThrough := true.
	
	self assert: 30 equals: ([:a | |b| 
		self assert: 10 = a .
		self assert: nil == b.
		b := a + 20. 
		firstTimeThrough ifTrue: [
			firstTimeThrough := false.
			thisContext restart.].
		b] value: 10)
! !

!MethodContextTest methodsFor: 'private' stamp: 'StephaneDucasse 5/28/2011 14:04'!
privRestartBlockTest
	"This tests may loop endlessly if incorrect, so call it from another method testing it does not time out"
	|a firstTimeThrough |
	firstTimeThrough := true.
	a := 10.
	
	self assert: 30 equals: [|b| 
		self assert: 10 = a .
		self assert: nil == b.
		b := a + 20. 
		firstTimeThrough ifTrue: [
			firstTimeThrough := false.
			thisContext restart.].
		b] value
! !

!MethodContextTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/30/2012 12:13'!
testMethodContext

	self assert: aMethodContext home notNil.
	self assert: aMethodContext receiver notNil.
	self assert: (aMethodContext method isKindOf: CompiledMethod).! !

!MethodContextTest methodsFor: 'private' stamp: 'StephaneDucasse 5/28/2011 14:04'!
privRestartBlockArgsNoRemoteTempsTest
	"This tests may loop endlessly if incorrect, so call it from another method testing it does not time out"
	
	self assert: 30 equals: ([:a :first | |b| 
		self assert: 10 = a .
		self assert: nil == b.
		b := a + 20. 
		first ifTrue: [
			"Cheat and modify one of the args so we will not loop endlessly"
			 thisContext tempAt: 2 put: false.
			thisContext restart.].
		b] value: 10 value: true)
! !

!MethodContextTest methodsFor: 'tests' stamp: 'ClementBera 5/28/2014 13:34'!
testReturn
	"Why am I overriding setUp? Because sender must be thisContext, i.e, testReturn, not setUp."
	aMethodContext := Context sender: thisContext receiver: aReceiver method: aCompiledMethod arguments: #(). 
	self assert: (aMethodContext return: 5) = 5.! !

!MethodContextTest methodsFor: 'tests' stamp: 'tlk 5/31/2004 17:08'!
testMethodIsBottomContext
	self assert: aMethodContext bottomContext = aSender.
	self assert: aMethodContext secondFromBottom = aMethodContext.! !

!MethodContextTest class methodsFor: 'closures for testing' stamp: 'mada 5/3/2012 18:57'!
contextWithTempForTesting 
	| string |
	string := 'test'.
	^ [self class. string asUppercase] asContext.
! !

!MethodDeclaration commentStamp: '<historical>'!
I represent the declaration of a method.  My contents are the source code to import, and the category reader is the object who knows the class, category and timestamp where to install the method.

Sending me the message #import makes me install the method into the class.!
!MethodDeclaration methodsFor: 'importing' stamp: 'StephaneDucasse 12/1/2013 21:56'!
importFor: requestor
	self existsBehavior
		ifFalse: [ self handleMissingBehavior ].
	requestor ifNotNil: [ requestor contents ifNil: [ requestor contents: contents ] ].
	^ self targetClass
		compile: contents
		classified: categoryName
		withStamp: stamp
		notifying: requestor! !

!MethodDeclaration methodsFor: 'importing' stamp: 'StephaneDucasse 12/4/2013 20:19'!
handleMissingBehavior
	"self error: ('Cannot install method in unexistent behavior {1}' format: {(behaviorName asString)})"
	
	(MissingClassError 
		className: behaviorName asString)
		signal! !

!MethodDeclaration methodsFor: 'accessing' stamp: 'GuillermoPolito 5/5/2012 20:13'!
category: aCategoryName
	categoryName := aCategoryName! !

!MethodDeclaration methodsFor: 'importing' stamp: 'CamilloBruni 7/17/2013 15:23'!
import
	^ self importFor: nil! !

!MethodDeclaration methodsFor: 'accessing' stamp: 'GuillermoPolito 5/5/2012 20:13'!
stamp: aMethodStamp
	stamp := aMethodStamp! !

!MethodDeclaration class methodsFor: 'instance creation' stamp: 'GuillermoPolito 5/5/2012 20:40'!
contents: someContents behaviorName: behaviorName isMeta: isMeta category: categoryName stamp: stamp
	^self new
			contents: someContents;
			behaviorName: behaviorName;
			isMeta: isMeta;
			category: categoryName;
			stamp: stamp;
			yourself! !

!MethodDefaultAction commentStamp: '<historical>'!
Action by default, empty icon!
!MethodDefaultAction methodsFor: 'order' stamp: 'BenjaminVanRyseghem 1/2/2013 13:04'!
isActionHandled
	"Return true if the provided method fits this action requirement"

	^ true! !

!MethodDefaultAction methodsFor: 'order' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
privateActionIcon
	"Return the icon for this action"

	^ Smalltalk ui icons iconNamed: #emptyIcon! !

!MethodDefaultAction methodsFor: 'order' stamp: 'BenjaminVanRyseghem 2/20/2013 19:57'!
actionOrder
	"Return the priority of this action"
	
	^ 9999999999999999999999999999! !

!MethodDefaultAction methodsFor: 'order' stamp: 'BenjaminVanRyseghem 1/2/2013 13:04'!
actionStateToCache
	"Return the state of the icon for caching purpose"
	
	^ icon! !

!MethodDefinitionAcceptor commentStamp: '<historical>'!
I am an acceptor in the context of method definition!
!MethodDefinitionAcceptor methodsFor: 'protocol' stamp: 'EstebanLorenzano 5/28/2013 14:39'!
accept: source notifying: aController
	| protocol method |

	protocol := self model selectedCategory.
	method := self model selectedMethod.
	
	protocol ifNil: [
		protocol := method 
			ifNil: [ Protocol unclassified ]
			ifNotNil: [ method protocol ] ].

	self model
		compileAMethodFromCategory: protocol
		withSource: source
		notifying: aController! !

!MethodDictionary commentStamp: 'StephaneDucasse 2/27/2010 22:35'!
I'm a special dictionary holding methods. I am just like a normal Dictionary, except that I am implemented differently.  Each Class has an instance of MethodDictionary to hold the correspondence between selectors (names of methods) and methods themselves.

In a normal Dictionary, the instance variable 'array' holds an array of Associations.  Since there are thousands of methods in the system, these Associations waste space.  

Each MethodDictionary is a variable object, with the list of keys (selector Symbols) in the variable part of the instance.  The variable 'array' holds the values, which are CompiledMethods.!
!MethodDictionary methodsFor: 'private' stamp: 'nice 11/14/2009 15:33'!
fixCollisionsFrom: start
	"The element at start has been removed and replaced by nil.
	This method moves forward from there, relocating any entries
	that had been placed below due to collisions with this one."

	| key index |
	index := start.
	[ (key := self basicAt: (index := index \\ array size + 1)) == nil ] whileFalse: [
		| newIndex |
		(newIndex := self findElementOrNil: key) = index ifFalse: [
			self swap: index with: newIndex ] ]! !

!MethodDictionary methodsFor: 'private' stamp: 'MarcusDenker 9/30/2011 10:19'!
grow 
	| newSelf |
	newSelf := self species newForCapacity: self basicSize * 2.
	1 to: self basicSize do:
		[:i | (self basicAt: i) ifNotNil: [ :key | newSelf at: key put: (array at: i)]].
	self becomeForward: newSelf! !

!MethodDictionary methodsFor: 'testing' stamp: 'StephaneDucasse 5/28/2011 14:00'!
isHealthy
	"Test that selector hashes match their positions stored in dictionary,
	answer true if everything ok, false otherwise
	
	MethodDictionary allInstances select: [:dict |
		dict isHealthy not ]

	"
	1 to: self basicSize do: [:i | | selector |
		selector := self basicAt: i.
		selector ifNotNil: [
			(self scanFor: selector) == i ifFalse: [ ^ false ]]].
	^ true! !

!MethodDictionary methodsFor: 'private' stamp: 'ul 11/13/2009 13:46'!
swap: oneIndex with: otherIndex

	| element |
	element := self basicAt: oneIndex.
	self basicAt: oneIndex put: (self basicAt: otherIndex).
	self basicAt: otherIndex put: element.
	array swap: oneIndex with: otherIndex
! !

!MethodDictionary methodsFor: 'private' stamp: 'MarianoMartinezPeck 9/18/2011 19:14'!
compactWithoutBecome
	"Return a copy of self which has the highest possible load factor (between 37.5% and 75%)."
	
	| newInstance |
	newInstance := self species new: self size.
	1 to: self basicSize do: [ :index | 
		(self basicAt: index) ifNotNil: [ :key |
			newInstance at: key put: (array at: index) ] ].
	^newInstance! !

!MethodDictionary methodsFor: 'private' stamp: 'MarianoMartinezPeck 9/27/2011 20:07'!
rehash 

	| newInstance |
	newInstance := self species newForCapacity: self basicSize.
	1 to: self basicSize do: [ :index | 
		(self basicAt: index) ifNotNil: [ :key |
			newInstance at: key put: (array at: index) ] ].
	self copyFrom: newInstance! !

!MethodDictionary methodsFor: 'private' stamp: 'GuillermoPolito 8/21/2010 19:19'!
scanFor: anObject
	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
	| element start finish |
	finish := array size.
	start := (anObject basicIdentityHash \\ finish) + 1.

	"Search from (hash mod size) to the end."
	start to: finish do:
		[:index | ((element := self basicAt: index) isNil or: [element == anObject])
			ifTrue: [^ index ]].

	"Search from 1 to where we started."
	1 to: start-1 do:
		[:index | ((element := self basicAt: index) isNil or: [element == anObject])
			ifTrue: [^ index ]].

	^ 0  "No match AND no empty slot"! !

!MethodDictionary methodsFor: 'enumeration' stamp: 'StephaneDucasse 8/25/2010 22:15'!
associationsDo: aBlock 

	tally = 0 ifTrue: [^ self].
	1 to: self basicSize do:
		[:i | (self basicAt: i) ifNotNil:
			[ :key | aBlock value: (Association key: key value: (array at: i))]]! !

!MethodDictionary methodsFor: 'accessing' stamp: 'GuillermoPolito 8/21/2010 19:16'!
keyAtValue: value ifAbsent: exceptionBlock
	"Answer the key whose value equals the argument, value. If there is
	none, answer the result of evaluating exceptionBlock."
	1 to: self basicSize do:
		[:index |
		value = (array at: index)
			ifTrue:
				[(self basicAt: index) ifNotNil: [ :theKey | ^ theKey]]].
	^ exceptionBlock value! !

!MethodDictionary methodsFor: '*FuelTests' stamp: 'MarianoMartinezPeck 4/20/2012 21:29'!
isEqualRegardlessMethodsTrailerTo: aMethodDictionary

	"Two dictionaries are equal if
	 (a) they are the same 'kind' of thing.
	 (b) they have the same set of keys.
	 (c) for each (common) key, they have the same value"

	self == aMethodDictionary ifTrue: [ ^ true ].
	(aMethodDictionary isDictionary) ifFalse: [^false].
	self size = aMethodDictionary size ifFalse: [^false].
	self associationsDo: [:assoc|
		((aMethodDictionary at: assoc key ifAbsent: [^false]) isEqualRegardlessTrailerTo:  assoc value)
			ifFalse: [^false]].
	^true

! !

!MethodDictionary methodsFor: 'removing' stamp: 'MarianoMartinezPeck 9/18/2011 18:52'!
removeKey: key ifAbsent: errorBlock 
	"The interpreter might be using this MethodDictionary while
	this method is running!! Therefore we perform the removal
	in a copy, and then atomically copy that copy"
	
	| copy removedValue |
	copy := self copy.
	removedValue := copy removeDangerouslyKey: key ifAbsent: [^ errorBlock value].
	self copyFrom: copy.
	^ removedValue! !

!MethodDictionary methodsFor: 'accessing' stamp: 'nice 5/1/2011 18:39'!
at: key ifPresent: aBlock

	^(array at: (self findElementOrNil: key))
		ifNotNil: [ :value | aBlock cull: value ]! !

!MethodDictionary methodsFor: 'accessing' stamp: 'MarcusDenker 8/16/2010 12:49'!
associationAt: key ifAbsent: aBlock
      "Answer the association with the given key.
       If key is not found, return the result of evaluating aBlock."

       ^(array at: (self scanFor: key))
               ifNil: [ aBlock value ]
               ifNotNil: [ :value | key -> value ]! !

!MethodDictionary methodsFor: 'enumeration' stamp: 'GuillermoPolito 8/21/2010 19:17'!
keysDo: aBlock 
	tally = 0 ifTrue: [^ self].
	1 to: self basicSize do:
		[:i | (self basicAt: i) ifNotNil: [ :key | aBlock value: key]]! !

!MethodDictionary methodsFor: 'accessing' stamp: 'StephaneDucasse 8/25/2010 22:14'!
add: anAssociation

	^ self at: anAssociation key put: anAssociation value! !

!MethodDictionary methodsFor: 'accessing' stamp: 'GuillermoPolito 8/21/2010 19:14'!
at: key ifAbsent: aBlock

	| index |
	index := self findElementOrNil: key.
	(self basicAt: index) ifNil: [ ^ aBlock value ].
	^ array at: index! !

!MethodDictionary methodsFor: 'private' stamp: 'MarianoMartinezPeck 9/18/2011 19:13'!
compact
	"Make sure that I have the highest possible load factor (between 37.5% and 75%)."
	
	| newInstance |
	newInstance := self compactWithoutBecome.
	newInstance capacity = self capacity
		ifTrue: [ self copyFrom: newInstance ]
		ifFalse: [ self becomeForward: newInstance ]! !

!MethodDictionary methodsFor: 'enumeration' stamp: 'GuillermoPolito 8/21/2010 19:17'!
valuesDo: aBlock 
	tally = 0 ifTrue: [^ self].
	1 to: self basicSize do:
		[:i | (array at: i) ifNotNil: [ :value | aBlock value: value]]! !

!MethodDictionary methodsFor: 'accessing' stamp: 'GuillermoPolito 8/21/2010 19:15'!
at: key put: value
	"Set the value at key to be value."
	| index |
	index := self findElementOrNil: key.
	(self basicAt: index) 
		ifNil: 
			[tally := tally + 1.
			self basicAt: index put: key]
		ifNotNil:
			[(array at: index) flushCache].
	array at: index put: value.
	self fullCheck.
	^ value! !

!MethodDictionary methodsFor: 'private' stamp: 'StephaneDucasse 8/25/2010 22:01'!
postCopy
	array := array copy! !

!MethodDictionary methodsFor: 'private' stamp: 'GuillermoPolito 8/21/2010 19:19'!
removeDangerouslyKey: key ifAbsent: aBlock
	"This is not really dangerous.  But if normal removal
	were done WHILE a MethodDict were being used, the
	system might crash.  So instead we make a copy, then do
	this operation (which is NOT dangerous in a copy that is
	not being used), and then use the copy after the removal."

	| index element |
	index := self findElementOrNil: key.
	(self basicAt: index) ifNil: [ ^ aBlock value ].
	element := array at: index.
	array at: index put: nil.
	self basicAt: index put: nil.
	tally := tally - 1.
	self fixCollisionsFrom: index.
	^ element! !

!MethodDictionary methodsFor: 'enumeration' stamp: 'GuillermoPolito 8/21/2010 19:16'!
keysAndValuesDo: aBlock 
	"Enumerate the receiver with all the keys and values passed to the block"
	tally = 0 ifTrue: [^ self].
	1 to: self basicSize do:
		[:i | (self basicAt: i) ifNotNil:
			[ :key | aBlock value: key value: (array at: i)]
		]! !

!MethodDictionary methodsFor: 'accessing' stamp: 'GuillermoPolito 8/21/2010 19:15'!
keyAtIdentityValue: value ifAbsent: exceptionBlock
	"Answer the key whose value equals the argument, value. If there is
	none, answer the result of evaluating exceptionBlock."
	1 to: self basicSize do:
		[:index |
		value == (array at: index)
			ifTrue:
				[(self basicAt: index) ifNotNil: [ :theKey | ^ theKey]]].
	^ exceptionBlock value! !

!MethodDictionary methodsFor: 'removing' stamp: 'MarianoMartinezPeck 9/27/2011 20:08'!
removeAll
	"Remove all elements from this collection. Preserve the capacity"
	
	| newSelf |
	tally = 0 ifTrue: [^self].
	newSelf := self species newForCapacity: self basicSize.
	self copyFrom: newSelf! !

!MethodDictionary class methodsFor: 'instance creation' stamp: 'MarianoMartinezPeck 9/27/2011 20:06'!
new: numberOfElements
	"Create an instance large enough to hold numberOfElements methods without growing."
	
	^self newForCapacity: (self sizeFor: numberOfElements)! !

!MethodDictionary class methodsFor: 'initialization' stamp: 'MarianoMartinezPeck 9/18/2011 19:05'!
compactAllInstances

	| instancesToExchange newInstances |
	instancesToExchange := Array streamContents: [ :oldStream |
		newInstances := Array streamContents: [ :newStream |
			self allInstances do: [ :each |
				| newInstance |
				newInstance := each compactWithoutBecome.
				newInstance capacity = each capacity 
					ifTrue: [ each copyFrom: newInstance ]
					ifFalse: [
						oldStream nextPut: each.
						newStream nextPut: newInstance ] ] ] ].
	instancesToExchange elementsForwardIdentityTo: newInstances! !

!MethodDictionary class methodsFor: 'sizing' stamp: 'MarianoMartinezPeck 1/18/2012 19:11'!
sizeFor: numberOfElements
    "Return the minimum capacity of a dictionary that can hold numberOfElements elements. At least 25% of the array must be empty and the return value must be a nonnegative power of 2. Notice that the max: 1 is because a MethodDictionaries can never be entirely empty, as the #grow method requires it not to be (since it does self basicSize * 2)"

	^(numberOfElements * 4 // 3 max: 1) asLargerPowerOfTwo ! !

!MethodDictionary class methodsFor: 'instance creation' stamp: 'MarianoMartinezPeck 9/27/2011 20:05'!
new
	"Create a new instance with 32 slots, which can hold at most 24 methods before growing is necessary."
	
	^self newForCapacity: 32! !

!MethodDictionary class methodsFor: 'instance creation' stamp: 'MarianoMartinezPeck 9/27/2011 20:06'!
newForCapacity: capacity
	"Create an instance with the given capacity which must be a power of two."
	
	^(self basicNew: capacity) initialize: capacity
! !

!MethodDictionaryTest commentStamp: 'TorstenBergmann 2/5/2014 08:40'!
SUnit tests for MethodDictionary!
!MethodDictionaryTest methodsFor: 'requirements' stamp: 'Alexandre Bergel 12/25/2009 08:31'!
emptyDict
	^ self empty! !

!MethodDictionaryTest methodsFor: 'test - removing' stamp: ''!
testKeysAndValuesRemove
	| oldSize collection keyIn |
	
	collection := self nonEmptyDict .
	oldSize := collection  size.
	keyIn := collection keys anyOne.
	
	collection  keysAndValuesRemove: [:key :value | key == self keyNotInNonEmptyDict ].
	self assert: (collection  size = (oldSize )).
	
	collection  keysAndValuesRemove: [:key :value | key == keyIn ].
	self assert: (collection  size = (oldSize - 1)).
	self should: [ collection at: keyIn  ] raise: Error.! !

!MethodDictionaryTest methodsFor: 'tests - others' stamp: 'GuillermoPolito 8/28/2010 21:15'!
testAtExistantKeyReturnsOkCompiledMethod
	| methodSelector method |
	methodSelector := #testAssociationAtExistantKeyReturnsOkAssociation.
	method := self class methodDict at: methodSelector ifAbsent: [self error].
	
	self assert: method class = CompiledMethod.! !

!MethodDictionaryTest methodsFor: 'requirements' stamp: 'TestRunner 12/25/2009 08:30'!
nonEmptyDict
	^ nonEmptyDict ! !

!MethodDictionaryTest methodsFor: 'tests' stamp: 'TestRunner 12/25/2009 08:23'!
testKeyAtValueIfAbsentLocalyDefined
	" self debug: #testKeyAtValueIfAbsentLocalyDefined "
	self assert: (self class methodDict keyAtValue: (self class >> #testKeyAtValueIfAbsentLocalyDefined) ifAbsent: []) == #testKeyAtValueIfAbsentLocalyDefined.
	
	self assert: (self class methodDict keyAtValue: (Object >> #printOn:) ifAbsent: [#notFound]) == #notFound! !

!MethodDictionaryTest methodsFor: 'setUps' stamp: 'GuillermoPolito 8/28/2010 19:59'!
modifiedMethodDictionaryCopy
	| copy |
	
	copy := self class methodDict copy.
	copy at: #methodAddedToIncreaseTheDict put: Object >> #=.
	^copy.! !

!MethodDictionaryTest methodsFor: 'tests - Dictionary keys values associations access' stamp: ''!
testKeysSortedSafely
	| collection result |
	collection := self nonEmpty.
	result := collection keysSortedSafely.
	result do: [ :key | collection at: key ].
	self assert: result size = collection size.
	self should: [ result detect: [ :each | (result occurrencesOf: each) > 1 ] ] raise: Error.
	self assert: result asArray isSorted! !

!MethodDictionaryTest methodsFor: 'helpers' stamp: 'Alexandre Bergel 12/25/2009 08:21'!
aValue

	^ self class >> #aValue! !

!MethodDictionaryTest methodsFor: 'requirements' stamp: 'Alexandre Bergel 12/25/2009 08:25'!
empty
	^ MethodDictionary new! !

!MethodDictionaryTest methodsFor: 'requirements' stamp: 'TestRunner 12/25/2009 08:37'!
keyNotInNonEmptyDict
" return a key not included in nonEmptyDict"
	^ #keyNotInNonEmptyDict! !

!MethodDictionaryTest methodsFor: 'test - removing' stamp: ''!
testRemoveKeyIfAbsent
	
	| collection oldSize keyIn value result |
	collection := self nonEmptyDict .
	oldSize := collection size.
	keyIn := collection  keys anyOne.
	value := collection at: keyIn .
	
	result := collection removeKey: keyIn ifAbsent: [888].
	
	self assert: result = value.
	self assert: (collection  size = (oldSize - 1)).
	self should: [ (collection  at: keyIn )] raise: Error.
	
	self assert: (collection removeKey: self keyNotInNonEmptyDict ifAbsent: [888] ) = 888.! !

!MethodDictionaryTest methodsFor: 'requirements' stamp: 'Alexandre Bergel 12/25/2009 08:31'!
newEmptyDict
	^ MethodDictionary new! !

!MethodDictionaryTest methodsFor: 'test - removing' stamp: ''!
testRemoveKey
	"self debug: #testRemoveKey"

	| collection oldSize keyIn |
	collection := self nonEmptyDict .
	oldSize := collection size.
	keyIn := collection  keys anyOne.
	
	collection removeKey: keyIn .
	self assert: (collection  size = (oldSize - 1)).
	self should: [ (collection  at: keyIn )] raise: Error.
	
	self should: [collection removeKey: self keyNotInNonEmptyDict ] raise: Error! !

!MethodDictionaryTest methodsFor: 'tests' stamp: 'MarcusDenker 5/10/2013 00:25'!
testIncludesKeyLocalyDefined
	" self debug: #testIncludesKeyLocalyDefined "
	self assert: (self class includesSelector: #testIncludesKeyLocalyDefined).! !

!MethodDictionaryTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAnyNoneThere
	"self debug: #testIncludesAnyOfNoneThere'"
	
	self deny: (self nonEmpty includesAny: self empty).
	self deny: (self nonEmpty includesAny: { self elementNotIn. self anotherElementNotIn })! !

!MethodDictionaryTest methodsFor: 'tests - Dictionary keys values associations access' stamp: ''!
testAssociations

	| collection result  |
	collection := self nonEmpty .
	result := collection associations.
	
	self assert: result size = collection size.
	result do: [:assoc | self assert: (assoc value) = (collection at: assoc key) ].
	"keys do: [ :key | self assert: ( result at: key ) = ( collection at: key )] ."
	! !

!MethodDictionaryTest methodsFor: 'tests - includes' stamp: ''!
testIncludesElementIsThere
	"self debug: #testIncludesElementIsThere"
	
	self assert: (self nonEmpty includes: self nonEmpty anyOne).! !

!MethodDictionaryTest methodsFor: 'assertions' stamp: 'GuillermoPolito 8/28/2010 19:53'!
assertPreservesCapacity: oldDictionary comparedTo: rehashedDictionary
	self assert: oldDictionary capacity = rehashedDictionary capacity.! !

!MethodDictionaryTest methodsFor: 'tests - Dictionary keys values associations access' stamp: ''!
testValues
	
	| collection result |
	collection := self nonEmpty .
	result := collection values.
	
	self assert: result size = collection size.
	result do: [:each | self assert: (collection occurrencesOf:each ) = (result occurrencesOf: each) ].
	! !

!MethodDictionaryTest methodsFor: 'tests - integrity' stamp: 'CamilloBruni 3/23/2013 12:09'!
testAllMethodDictionariesAreHealthy
	
	self assert: (MethodDictionary allInstances select: [:dict | dict isHealthy not ]) isEmpty.! !

!MethodDictionaryTest methodsFor: 'tests - others' stamp: 'GuillermoPolito 8/28/2010 21:33'!
testIdentityKeyAtNonExistantValueReturnsFailBlock
	| methodSelector result aMethod error |
	methodSelector := #testAssociationAtExistantKeyReturnsOkAssociation.
	error := #error.
	
	result := self class methodDict keyAtIdentityValue: self ifAbsent: [error].
	
	self assert: result = error.! !

!MethodDictionaryTest methodsFor: 'tests - others' stamp: 'GuillermoPolito 8/28/2010 21:29'!
testKeyAtExistantValueCopyReturnsOkKey
	| methodSelector result aMethod |
	methodSelector := #testAssociationAtExistantKeyReturnsOkAssociation.
	aMethod := (self class >> methodSelector) copy.
	result := self class methodDict keyAtValue: aMethod ifAbsent: [self error].
	
	self assert: result = methodSelector.! !

!MethodDictionaryTest methodsFor: 'tests - others' stamp: 'GuillermoPolito 8/28/2010 21:28'!
testKeyAtNonexistantValueExecutesFailBlock
	| methodSelector result error |
	methodSelector := #inexistant:method:larala:.
	error := #error.
	result := self class methodDict keyAtValue: self ifAbsent: [error].
	
	self assert: result = error.! !

!MethodDictionaryTest methodsFor: 'tests - Dictionary keys values associations access' stamp: ''!
testKeys
	| collection result |
	collection := self nonEmpty.
	result := collection keys.
	result do: [ :key | collection at: key ].
	self assert: result size = collection size.
	self should: [ result detect: [ :each | (result occurrencesOf: each) > 1 ] ] raise: Error! !

!MethodDictionaryTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureDictionaryKeysValuesAssociationsAccess
	self nonEmpty.
	self deny: self nonEmpty isEmpty! !

!MethodDictionaryTest methodsFor: 'tests - others' stamp: 'GuillermoPolito 8/28/2010 21:33'!
testIdentityKeyAtExistantValueReturnsOkKey
	| methodSelector result aMethod |
	methodSelector := #testAssociationAtExistantKeyReturnsOkAssociation.
	
	aMethod := self class >> methodSelector.
	result := self class methodDict keyAtIdentityValue: aMethod ifAbsent: [self error].
	
	self assert: result = methodSelector.! !

!MethodDictionaryTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureDictionaryRemovingTest
	self nonEmptyDict.
	self deny: self nonEmptyDict isEmpty.
	self keyNotInNonEmptyDict.
	self deny: (self nonEmptyDict keys includes: self keyNotInNonEmptyDict)! !

!MethodDictionaryTest methodsFor: 'tests - others' stamp: 'GuillermoPolito 8/28/2010 21:22'!
testGrowPreservesElements
	| methodDictionary oldCapacity growedMethodDictionary |
	methodDictionary := self class methodDict copy.
	growedMethodDictionary := methodDictionary copy; grow; yourself.

	self assertPreservesElements: methodDictionary comparedTo: growedMethodDictionary.
	self assertPreservesElements: growedMethodDictionary comparedTo: methodDictionary.! !

!MethodDictionaryTest methodsFor: 'requirements' stamp: 'Alexandre Bergel 12/25/2009 08:29'!
anotherElementNotIn
" return an element different of 'elementNotIn'  not included in 'nonEmpty' "
	^ self class >> #anotherElementNotIn! !

!MethodDictionaryTest methodsFor: 'helpers' stamp: 'Alexandre Bergel 12/25/2009 08:21'!
anotherValue

	^ self class >> #anotherValue! !

!MethodDictionaryTest methodsFor: 'tests - rehashing' stamp: 'MarianoMartinezPeck 9/27/2011 20:09'!
testRehashPreservesElements
	| oldDictionary rehashedDictionary |
	oldDictionary := self modifiedMethodDictionaryCopy.
	
	rehashedDictionary := oldDictionary copy rehash.
	
	self assertPreservesElements: oldDictionary comparedTo: rehashedDictionary.
	self assertPreservesElements: rehashedDictionary comparedTo: oldDictionary.! !

!MethodDictionaryTest methodsFor: 'assertions' stamp: 'GuillermoPolito 8/28/2010 21:09'!
assertPreservesElements: oldDictionary comparedTo: newDictionary
	self assert: (oldDictionary keys allSatisfy: [ :key |
		(newDictionary includesKey: key) &
		((newDictionary at: key) == (oldDictionary at: key))
		])! !

!MethodDictionaryTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIncludeTest
	| anElementIn |
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self elementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self elementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self anotherElementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self anotherElementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self empty.
	self assert: self empty isEmpty! !

!MethodDictionaryTest methodsFor: 'tests - includes' stamp: ''!
testIncludesElementIsNotThere
	"self debug: #testIncludesElementIsNotThere"
	
	self deny: (self nonEmpty includes: self elementNotIn).
	self assert: (self nonEmpty includes: self nonEmpty anyOne).
	self deny: (self empty includes: self elementNotIn)! !

!MethodDictionaryTest methodsFor: 'requirements' stamp: 'TestRunner 12/25/2009 08:35'!
keyNotIn
" return a key not included in nonEmpty"
^ #bouba! !

!MethodDictionaryTest methodsFor: 'tests - others' stamp: 'GuillermoPolito 8/28/2010 21:16'!
testAssociationAtNonexistantKeyExecutesFailBlock
	| methodSelector result error |
	methodSelector := #inexistant:method:larala:.
	error := #error.
	result := self class methodDict associationAt: methodSelector ifAbsent: [error].
	
	self assert: result = error.! !

!MethodDictionaryTest methodsFor: 'tests' stamp: 'MarcusDenker 2/21/2010 12:52'!
testBehaviorLocalyDefined
	"method not acquired from a trait or from its superclass"
	" self debug: #testBehavior "
	self assert: (Object methodDict isKindOf: MethodDictionary).
	self assert: (Object selectors asSortedCollection = Object selectors asSortedCollection).! !

!MethodDictionaryTest methodsFor: 'requirement' stamp: 'Alexandre Bergel 12/25/2009 08:22'!
speciesClass
	^ MethodDictionary! !

!MethodDictionaryTest methodsFor: 'tests - others' stamp: 'GuillermoPolito 8/28/2010 21:33'!
testIdentityKeyAtExistantValueCopyReturnsFailBlock
	| methodSelector result aMethod error |
	methodSelector := #testAssociationAtExistantKeyReturnsOkAssociation.
	error := #error.
	
	aMethod := (self class >> methodSelector) copy.
	result := self class methodDict keyAtIdentityValue: aMethod ifAbsent: [error].
	
	self assert: result = error.! !

!MethodDictionaryTest methodsFor: 'helpers' stamp: 'Alexandre Bergel 12/25/2009 08:20'!
anIndex

	^ #aMethodName! !

!MethodDictionaryTest methodsFor: 'tests - includes' stamp: ''!
testIdentityIncludesNonSpecificComportement
	" test the same comportement than 'includes: '  "
	| collection |	
	collection := self nonEmpty  .
	
	self deny: (collection identityIncludes: self elementNotIn ).
	self assert:(collection identityIncludes: collection anyOne)
! !

!MethodDictionaryTest methodsFor: 'tests - others' stamp: 'GuillermoPolito 8/28/2010 20:59'!
testAssociationAtExistantKeyReturnsOkAssociation
	| methodSelector association |
	methodSelector := #testAssociationAtExistantKeyReturnsOkAssociation.
	association := self class methodDict associationAt: methodSelector ifAbsent: [self error].
	
	self assert: association key = methodSelector.
	self assert: association value = (self class >> methodSelector).! !

!MethodDictionaryTest methodsFor: 'tests - others' stamp: 'GuillermoPolito 8/28/2010 21:15'!
testAtNonexistantKeyExecutesFailBlock
	| methodSelector result error |
	methodSelector := #inexistant:method:larala:.
	error := #error.
	result := self class methodDict at: methodSelector ifAbsent: [error].
	
	self assert: result = error.! !

!MethodDictionaryTest methodsFor: 'tests - removing' stamp: 'GuillermoPolito 8/28/2010 19:26'!
testRemoveAllPreservesCapacity
	| methodSelector dictionary oldSize |
	methodSelector := #testRemoveAllPreservesCapacity.
	dictionary := MethodDictionary new.
	dictionary at: methodSelector put: self class >> methodSelector.
	
	oldSize := dictionary basicSize.
	dictionary removeAll.
	self assert: oldSize = dictionary basicSize.! !

!MethodDictionaryTest methodsFor: 'requirements' stamp: 'Alexandre Bergel 12/25/2009 08:29'!
elementNotIn
"return an element not included in 'nonEmpty' "

	^ self class >> #elementNotIn! !

!MethodDictionaryTest methodsFor: 'running' stamp: 'Alexandre Bergel 12/25/2009 08:28'!
setUp
	super setUp.
	nonEmptyDict := MethodDictionary new.
	nonEmptyDict at: #setUp put: (self class >> #setUp).
	nonEmptyDict at: #nonEmpty put: (self class >> #nonEmpty).! !

!MethodDictionaryTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAllNoneThere
	"self debug: #testIncludesAllOfNoneThere'"
	self deny: (self empty includesAll: self nonEmpty ).
	self deny: (self nonEmpty includesAll: { self elementNotIn. self anotherElementNotIn })! !

!MethodDictionaryTest methodsFor: 'test - removing' stamp: ''!
testRemove

	self should: [self nonEmptyDict remove: nil] raise: Error.
	self should: [self nonEmptyDict remove: nil ifAbsent: ['What ever here']] raise: Error.! !

!MethodDictionaryTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAnyAllThere
	"self debug: #testIncludesAnyOfAllThere'"
	self deny: (self nonEmpty includesAny: self empty).
	self assert: (self nonEmpty includesAny: { self nonEmpty anyOne }).
	self assert: (self nonEmpty includesAny: self nonEmpty).! !

!MethodDictionaryTest methodsFor: 'tests - others' stamp: 'GuillermoPolito 8/28/2010 21:29'!
testKeyAtExistantValueReturnsOkKey
	| methodSelector result aMethod |
	methodSelector := #testAssociationAtExistantKeyReturnsOkAssociation.
	aMethod := self class >> methodSelector.
	result := self class methodDict keyAtValue: aMethod ifAbsent: [self error].
	
	self assert: result = methodSelector.! !

!MethodDictionaryTest methodsFor: 'requirements' stamp: 'Alexandre Bergel 12/25/2009 08:32'!
nonEmptyDifferentFromNonEmptyDict
	" return a dictionary for which all keys are not included in nonEmptyDict"
	^ MethodDictionary new
		at: #nonEmptyDifferentFromNonEmptyDict put: (self class >> #nonEmptyDifferentFromNonEmptyDict)! !

!MethodDictionaryTest methodsFor: 'tests - others' stamp: 'GuillermoPolito 8/28/2010 21:19'!
testGrowDoublesCapacity
	| methodDictionary oldCapacity |
	methodDictionary := MethodDictionary new.
	oldCapacity := methodDictionary capacity.
	methodDictionary grow.
	self assert: oldCapacity * 2 = methodDictionary capacity.! !

!MethodDictionaryTest methodsFor: 'requirements' stamp: 'Alexandre Bergel 12/25/2009 08:27'!
nonEmpty
	^ nonEmptyDict! !

!MethodDictionaryTest methodsFor: 'tests - others' stamp: 'GuillermoPolito 8/28/2010 21:10'!
testAssociationsDoGoesOverEntireDictionary
	| associations |
	associations := MethodDictionary new.
	
	self class methodDict associationsDo:[ :association | associations add: association ].
	
	self assertPreservesElements: self class methodDict comparedTo: associations.! !

!MethodDictionaryTest methodsFor: 'tests - rehashing' stamp: 'MarianoMartinezPeck 9/27/2011 20:09'!
testRehashPreservesCapacity
	| oldDictionary rehashedDictionary |
	oldDictionary := self modifiedMethodDictionaryCopy.

	rehashedDictionary := oldDictionary copy rehash.
	
	self assertPreservesCapacity: oldDictionary comparedTo: rehashedDictionary.! !

!MethodFinder commentStamp: 'sd 4/21/2011 17:22'!
Find a method in the system from a set of examples.  Done by brute force, trying every possible selector.  Errors are skipped over using ( [3 + 'xyz'] ifError: [^ false] ).
Submit an array of the form ((data1 data2) answer  (data1 data2) answer).

	MethodFinder methodFor: #( (4 3) 7  (0 5) 5  (5 5) 10).

answer:  'data1 + data2'

More generally, use the brace notation to construct live examples.

The program tries data1 as the receiver, and
	tries all other permutations of the data for the receiver and args, and
	tries leaving out one argument, and
	uses all selectors data understands, and
	uses all selectors in all od data's superclasses.

Floating point values must be precise to 0.01 percent, or (X * 0.0001).

If you get an error, you have probably discovered a selector that needs to be removed from the Approved list.  See MethodFinder.initialize.  Please email the Pharo Team.

Only considers 0, 1, 2, and 3 argument messages.  The argument data may have 1 to 5 entries, but only a max of 4 used at a time.  For now, we only test messages that use given number of args or one fewer.  For example, this data (100 true 0.6) would test the receiver plus two args, and the receiver plus one arg, but not any other patterns.

Three sets of selectors:  Approved, AddAndRemove, and Blocks selectors.  When testing a selector in AddAndRemove, deepCopy the receiver.  We do not handle selectors that modify an argument (printOn: etc.).  Blocks is a set of (selector argNumber) where that argument must be a block.

For perform, the selector is tested.  It must be in the Approved list.

do: is not on the Approved list.  It does not produce a result that can be tested.  Type 'do' into the upper pane of the Selector Finder to find messages list that.


Implementation Notes
	
	arguments of the load: method are structured as follows:
		- Odd list entries are data for it, even ones are the answers.  nil input means data and answers were supplied already."
		"(MethodFinder new) load: #( (4 3) 7  (-10 5) -5  (-3 11) 8)





!
!MethodFinder methodsFor: 'argument permutation maps' stamp: 'tk 5/24/1999 16:31'!
permuteArgs 
	"Run through ALL the permutations.  First one was as presented."

	data first size <= 1 ifTrue: [^ false].	"no other way"
	mapList ifNil: [self makeAllMaps].
	mapStage := mapStage + 1.
	mapStage > mapList size ifTrue: [^ false].
	argMap := mapList at: mapStage.
	self mapData.
	^ true
	! !

!MethodFinder methodsFor: 'argument permutation maps' stamp: 'tk 5/18/1999 14:46'!
makeAllMaps 
	"Make a giant list of all permutations of the args.  To find the function, we will try these permutations of the input data.  receiver, args."

	| ii |
	mapList := Array new: argMap size factorial.
	ii := 1.
	argMap permutationsDo: [:perm |
		mapList at: ii put: perm copy.
		ii := ii + 1].
	mapStage := 1.	"about to be bumped"! !

!MethodFinder methodsFor: 'tests' stamp: 'ar 4/10/2005 18:48'!
test2: anArray
	"look for bad association"

	anArray do: [:sub |
		sub class == Association ifTrue: [
			(#('true' '$a' '2' 'false') includes: sub value printString) ifFalse: [
				self error: 'bad assn'].
			(#('3' '5.6' 'x' '''abcd''') includes: sub key printString) ifFalse: [
				self error: 'bad assn'].
		].
		sub class == Array ifTrue: [
			sub do: [:element | 
				element isString ifTrue: [element first asciiValue < 32 ifTrue: [
						self error: 'store into string in data']].
				element class == Association ifTrue: [
					element value class == Association ifTrue: [
						self error: 'bad assn']]]].
		sub class == Date ifTrue: [sub year isInteger ifFalse: [
				self error: 'stored into input date!!!!']].
		sub class == Dictionary ifTrue: [
				sub size > 0 ifTrue: [
					self error: 'store into dictionary']].
		sub class == OrderedCollection ifTrue: [
				sub size > 4 ifTrue: [
					self error: 'store into OC']].
		].! !

!MethodFinder methodsFor: 'find a constant' stamp: 'tk 1/8/2001 17:49'!
constDiv
	| const subTest got |
	"See if (data1 // C) is the answer"

	const := ((thisData at: 1) at: 1) // (answers at: 1).  "May not be right!!"
	got := (subTest := MethodFinder new copy: self addArg: const) 
				searchForOne isEmpty not.
	got ifFalse: [^ false]. 

	"replace data2 with const in expressions"
	subTest expressions do: [:exp |
		expressions add: (exp copyReplaceAll: 'data2' with: const printString)].
	selector addAll: subTest selectors.
	^ true! !

!MethodFinder methodsFor: 'initialize' stamp: 'sd 4/21/2011 16:06'!
copy: mthFinder addArg: aConstant
	"Copy inputs and answers, add an additional data argument to the inputs.  The same constant for every example"
	| more |
	more := Array with: aConstant.
	data := mthFinder data collect: [:argList | argList, more].
	answers := mthFinder answers.
	self load: nil.
! !

!MethodFinder methodsFor: 'find a constant' stamp: 'tk 12/29/2000 22:34'!
allNumbers
	"Return true if all answers and all data are numbers."

	answers do: [:aa | aa isNumber ifFalse: [^ false]].
	thisData do: [:vec |
			vec do: [:nn | nn isNumber ifFalse: [^ false]]].
	^ true! !

!MethodFinder methodsFor: 'find a constant' stamp: 'tk 1/8/2001 17:48'!
constPlus
	| const subTest got |
	"See if (data1 + C) is the answer"

	const := (answers at: 1) - ((thisData at: 1) at: 1).
	got := (subTest := MethodFinder new copy: self addArg: const) 
				searchForOne isEmpty not.
	got ifFalse: [^ false]. 

	"replace data2 with const in expressions"
	subTest expressions do: [:exp |
		expressions add: (exp copyReplaceAll: 'data2' with: const printString)].
	selector addAll: subTest selectors.
	^ true! !

!MethodFinder methodsFor: 'public api' stamp: 'ar 4/10/2005 18:48'!
findMessage
	"Control the search."

	data do: [:alist |
		(alist isKindOf: SequenceableCollection) ifFalse: [
			^ OrderedCollection with: 'first and third items are not Arrays']].
	Approved ifNil: [self initialize].	"Sets of allowed selectors"
	expressions := OrderedCollection new.
	self search: true.	"multi"
	expressions isEmpty ifTrue: [^ OrderedCollection with: 'no single method does that function'].
	expressions isString ifTrue: [^ OrderedCollection with: expressions].
 	^ expressions! !

!MethodFinder methodsFor: 'find a constant' stamp: 'tk 1/18/2001 22:46'!
constMod
	| subTest low |
	"See if mod, (data1 \\ C) is the answer"

	low := answers max.
	low+1 to: low+20 do: [:const |
		subTest := MethodFinder new copy: self addArg: const.
		(subTest testPerfect: #\\) ifTrue: [
			expressions add: 'data1 \\ ', const printString.
			selector add: #\\.
			^ true]].
	^ false! !

!MethodFinder methodsFor: 'find a constant' stamp: 'tk 1/8/2001 17:49'!
constMult
	| const subTest got |
	"See if (data1 * C) is the answer"

	((thisData at: 1) at: 1) = 0 ifTrue: [^ false].
	const := ((answers at: 1) asFloat / ((thisData at: 1) at: 1)) reduce.
	got := (subTest := MethodFinder new copy: self addArg: const) 
				searchForOne isEmpty not.
	got ifFalse: [^ false]. 

	"replace data2 with const in expressions"
	subTest expressions do: [:exp |
		expressions add: (exp copyReplaceAll: 'data2' with: const printString)].
	selector addAll: subTest selectors.
	^ true! !

!MethodFinder methodsFor: 'search' stamp: 'sd 4/21/2011 17:09'!
testPerfect: aSelector
	"Try this selector!! Return true if it answers every example perfectly.  Take the args in the order they are.  Do not permute them.  Survive errors.  later cache arg lists."

	| sz argList val rec activeSel perform |

	perform := aSelector beginsWith: 'perform:'.
	sz := argMap size.
	1 to: thisData size do: [:ii | "each example set of args"
		argList := (thisData at: ii) copyFrom: 2 to: sz.
		perform
			ifFalse: [activeSel := aSelector]
			ifTrue: [activeSel := argList first.	"what will be performed"
				((Approved includes: activeSel) or: [AddAndRemove includes: activeSel])
					ifFalse: [^ false].	"not approved"
				aSelector == #perform:withArguments: 
					ifTrue: [activeSel numArgs = (argList at: 2) basicSize "avoid error" 
								ifFalse: [^ false]]
					ifFalse: [activeSel numArgs = (aSelector numArgs - 1) 
								ifFalse: [^ false]]].
		1 to: sz do: [:num | 
			(Blocks includes: (Array with: activeSel with: num)) ifTrue: [
				(argList at: num) isBlock ifFalse: [^ false]]].
		rec := (AddAndRemove includes: activeSel) 
				ifTrue: [(thisData at: ii) first isSymbol ifTrue: [^ false].
						"vulnerable to modification"
					(thisData at: ii) first copyTwoLevel] 	"protect from damage"
				ifFalse: [(thisData at: ii) first].
		val := [[rec perform: aSelector withArguments: argList] 
					ifError: [:aString :aReceiver | 
							^ false]] on: Deprecation do: [:depr | 
							"We do not want to list deprecated methods" 
							^false.].
		((answers at: ii) closeTo: val) ifFalse: [^ false].
		].
	^ true! !

!MethodFinder methodsFor: 'argument permutation maps' stamp: 'tk 4/24/1999 19:29'!
thisData
	^ thisData ! !

!MethodFinder methodsFor: 'initialize' stamp: 'MarcusDenker 2/16/2015 15:20'!
initialize
	"The methods we are allowed to use.  (MethodFinder new initialize) "
	super initialize.

	Approved := Set new.
	AddAndRemove := Set new.
	Blocks := Set new.
	"These modify an argument and are not used by the MethodFinder: longPrintOn: printOn: storeOn: sentTo: storeOn:base: printOn:base: absPrintExactlyOn:base: absPrintOn:base: absPrintOn:base:digitCount: writeOn: writeScanOn: possibleVariablesFor:continuedFrom: printOn:format:"

"Object"  
	#("in class, instance creation"  newFrom: 
"accessing" at: basicAt: basicSize in: size yourself 
"testing" ifNil: ifNil:ifNotNil: ifNotNil: ifNotNil:ifNil: isColor isFloat isFraction  isInteger isMorph isNil isNumber isPoint isText isTransparent isWebBrowser notNil pointsTo: wantsSteps 
"comparing" = == hash identityHash ~= ~~ 
"copying" copy shallowCopy 
"dependents access" canDiscardEdits dependents hasUnacceptedEdits 
"updating" changed changed: okToChange update: windowIsClosing 
"printing" fullPrintString isLiteral longPrintString printString storeString 
"class membership" class isKindOf: isMemberOf: respondsTo:  
"error handling" 
"user interface"defaultBackgroundColor defaultLabel fullscreenSize initialExtent modelWakeUp  
"system primitives" instVarAt: instVarNamed: 
"private" 
"associating" -> 
"converting" as: asOrderedCollection asString 
"casing" caseOf: caseOf:otherwise: 
"binding" bindingOf: 
"macpal"  currentEvent currentHand currentWorld flash   
"flagging" flag: 
"translation support" "objects from disk" "finalization" ) do: [:sel | Approved add: sel].
	#(at:add: at:put: basicAt:put: "NOT instVar:at:"
"message handling" perform: perform:orSendTo: perform:with: perform:with:with: perform:with:with:with: perform:withArguments: perform:withArguments:inSuperclass: 
) do: [:sel | AddAndRemove add: sel].

"Boolean, True, False, UndefinedObject"  
	#("logical operations" & eqv: not xor: |
"controlling" and: ifFalse: ifFalse:ifTrue: ifTrue: ifTrue:ifFalse: or:
"copying" 
"testing" isEmptyOrNil) do: [:sel | Approved add: sel].

"Behavior" 
	#("initialize-release"
"accessing"  format methodDict sourceCodeTemplate subclassDefinerClass
"testing" instSize instSpec isBits isBytes isFixed isPointers isVariable isWeak isWords
"copying"
"printing" printHierarchy
"creating class hierarchy"
"creating method dictionary"
"instance creation" basicNew basicNew: new new:
"accessing class hierarchy" allSubclasses allSubclassesWithLevelDo:startingLevel: allSuperclasses subclasses superclass withAllSubclasses withAllSuperclasses
"accessing method dictionary" allSelectors changeRecordsAt: compiledMethodAt: compiledMethodAt:ifAbsent: firstCommentAt: lookupSelector: selectors selectorsDo: selectorsWithArgs: "slow but useful ->" sourceCodeAt: sourceCodeAt:ifAbsent: sourceMethodAt: sourceMethodAt:ifAbsent:
"accessing instances and variables" allClassVarNames allInstVarNames allSharedPools classVarNames instVarNames instanceCount sharedPools someInstance subclassInstVarNames
"testing class hierarchy" inheritsFrom: kindOfSubclass
"testing method dictionary" canUnderstand: classThatUnderstands: hasMethods includesSelector: whichClassIncludesSelector: whichSelectorsAccess: whichSelectorsReferTo: whichSelectorsReferTo:special:byte: whichSelectorsStoreInto:
"enumerating"
"user interface"
"private" indexIfCompact) do: [:sel | Approved add: sel].

"ClassDescription"
	#("initialize-release" 
"accessing"  isMeta name theNonMetaClass
"copying" 
"printing" classVariablesString instanceVariablesString sharedPoolsString
"instance variables"  
"method dictionary" 
"organization" category organization whichCategoryIncludesSelector:
"compiling" acceptsLoggingOfCompilation wantsChangeSetLogging
"fileIn/Out" definition
"private" ) do: [:sel | Approved add: sel].

"Class"
	#("initialize-release" 
"accessing" classPool
"testing"
"copying" 
"class name" 
"instance variables" 
"class variables" classVarAt: classVariableAssociationAt:
"pool variables" 
"compiling" 
"subclass creation" 
"fileIn/Out" ) do: [:sel | Approved add: sel]. 

"Metaclass"
	#("initialize-release" 
"accessing" isSystemDefined soleInstance
"copying" "instance creation" "instance variables"  "pool variables" "class hierarchy"  "compiling"
"fileIn/Out"  nonTrivial ) do: [:sel | Approved add: sel].

"Context, BlockContext"
	#(receiver client method receiver tempAt: 
"debugger access" pc selector sender shortStack sourceCode tempNames tempsAndValues
"controlling"  "printing" "system simulation" 
"initialize-release" 
"accessing" hasMethodReturn home numArgs
"evaluating" value value:ifError: value:value: value:value:value: value:value:value:value: valueWithArguments:
"controlling"  "scheduling"  "instruction decoding"  "printing" "private"  "system simulation" ) do: [:sel | Approved add: sel].
	#(value: "<- Association has it as a store" ) do: [:sel | AddAndRemove add: sel].

"Message"
	#("inclass, instance creation" selector: selector:argument: selector:arguments:
"accessing" argument argument: arguments sends:
"printing" "sending" ) do: [:sel | Approved add: sel].
	#("private" setSelector:arguments:) do: [:sel | AddAndRemove add: sel].

"Magnitude"
	#("comparing" < <= > >= between:and:
"testing" max: min: min:max: ) do: [:sel | Approved add: sel].

"Date, Time"
	#("in class, instance creation" fromDays: fromSeconds: fromString: today
	"in class, general inquiries" dayOfWeek: daysInMonth:forYear: daysInYear: firstWeekdayOfMonth:year: indexOfMonth: nameOfDay: nameOfMonth:
"accessing" day monthIndex monthName weekday year
"arithmetic" addDays: subtractDate: subtractDays:
"comparing"
"inquiries" dayOfMonth daysInMonth daysInYear daysLeftInYear firstDayOfMonth previous:
"converting" asSeconds
"printing"  mmddyyyy printFormat: 
"private" weekdayIndex 
	"in class, instance creation" fromSeconds: now 
	"in class, general inquiries" dateAndTimeFromSeconds: millisecondClockValue millisecondsToRun: totalSeconds
"accessing" hours minutes seconds
"arithmetic" addTime: subtractTime:
"comparing"
"printing" intervalString print24 
"converting") do: [:sel | Approved add: sel].
	#("private" 
		 ) do: [:sel | AddAndRemove add: sel].

"Number"
	#("in class" readFrom:base: 
"arithmetic" * + - / // \\ abs negated quo: reciprocal rem:
"mathematical functions" arcCos arcSin arcTan arcTan: cos exp floorLog: ln log log: raisedTo: raisedToInteger: sin sqrt squared tan
"truncation and round off" ceiling detentBy:atMultiplesOf:snap: floor roundTo: roundUpTo: rounded truncateTo: truncated
"comparing"
"testing" even isDivisibleBy: isInfinite isNaN isZero negative odd positive sign strictlyPositive
"converting" @ asInteger asNumber asPoint asSmallAngleDegrees degreesToRadians radiansToDegrees
"intervals" to: to:by: 
"printing" printStringBase: storeStringBase: ) do: [:sel | Approved add: sel].

"Integer"
	#("in class" primesUpTo:
"testing" isPowerOfTwo
"arithmetic" alignedTo:
"comparing"
"truncation and round off" normalize
"enumerating" timesRepeat:
"mathematical functions" degreeCos degreeSin factorial gcd: lcm: take:
"bit manipulation" << >> allMask: anyMask: bitAnd: bitClear: bitInvert bitInvert32 bitOr: bitShift: bitXor: lowBit noMask:
"converting" asCharacter asColorOfDepth: asFloat asFraction asHexDigit
"printing" asStringWithCommas hex hex8 radix:
"system primitives" lastDigit replaceFrom:to:with:startingAt:
"private" "benchmarks" ) do: [:sel | Approved add: sel].

"SmallInteger, LargeNegativeInteger, LargePositiveInteger"
	#("arithmetic" "bit manipulation" highBit "testing" "comparing" "copying" "converting" "printing" 
"system primitives" digitAt: digitLength 
"private" fromString:radix: ) do: [:sel | Approved add: sel].
	#(digitAt:put: ) do: [:sel | AddAndRemove add: sel].

"Float"
	#("arithmetic"
"mathematical functions" reciprocalLogBase2 timesTwoPower:
"comparing" "testing"
"truncation and round off" exponent fractionPart integerPart significand significandAsInteger
"converting" asApproximateFraction asIEEE32BitWord asTrueFraction
"copying") do: [:sel | Approved add: sel].

"Fraction, Random"
	#(denominator numerator reduced next nextValue) do: [:sel | Approved add: sel].
	#(setNumerator:denominator:) do: [:sel | AddAndRemove add: sel].

"Collection"
	#("accessing" anyOne
"testing" includes: includesAllOf: includesAnyOf: includesSubstringAnywhere: isEmpty isSequenceable occurrencesOf:
"enumerating" collect: collect:thenSelect: count: detect: detect:ifNone: detectMax: detectMin: detectSum: inject:into: reject: select: select:thenCollect: intersection:
"converting" asBag asCharacterSet asSet  asSortedCollection asSortedCollection:
"printing"
"private" maxSize
"arithmetic"
"math functions" average max median min range sum) do: [:sel | Approved add: sel].
	#("adding" add: addAll: addIfNotPresent:
"removing" remove: remove:ifAbsent: removeAll: removeAllFoundIn: removeAllSuchThat: remove:ifAbsent:) do: [:sel | AddAndRemove add: sel].

"SequenceableCollection"
	#("comparing" hasEqualElements:
"accessing" allButFirst allButLast at:ifAbsent: atAll: atPin: atWrap: fifth first first: fourth identityIndexOf: identityIndexOf:ifAbsent: indexOf: indexOf:ifAbsent: indexOf:startingAt:ifAbsent: indexOfSubCollection:startingAt: indexOfSubCollection:startingAt:ifAbsent: last second sixth third
"removing"
"copying" , copyAfterLast: copyAt:put: copyFrom:to: copyReplaceAll:with: copyReplaceFrom:to:with: copyUpTo: copyUpToLast: copyWith: copyWithout: copyWithoutAll: forceTo:paddingWith: shuffled sort:
"enumerating" collectWithIndex: findFirst: findLast: pairsCollect: with:collect: withIndexCollect: polynomialEval:
"converting" asArray asDictionary asFloatArray asIntegerArray asStringWithCr asWordArray reversed
 ) do: [:sel | Approved add: sel].
	#( swap:with:) do: [:sel | AddAndRemove add: sel].

"ArrayedCollection, Bag"
	#("private" defaultElement 
"sorting" isSorted
"accessing" cumulativeCounts sortedCounts sortedElements "testing" "adding" add:withOccurrences: "removing" "enumerating" 
	) do: [:sel | Approved add: sel].
	#( mergeSortFrom:to:by: sort sort: add: add:withOccurrences:
"private" setDictionary ) do: [:sel | AddAndRemove add: sel].

"Other messages that modify the receiver"
	#(atAll:put: atAll:putAll: atAllPut: atWrap:put: replaceAll:with: replaceFrom:to:with:  removeFirst removeLast) do: [:sel | AddAndRemove add: sel].

	self initialize2.

"
MethodFinder new initialize.
MethodFinder new organizationFiltered: Set
"

! !

!MethodFinder methodsFor: 'find a constant' stamp: 'tk 1/8/2001 17:47'!
constLinear
	| const subTest got denom num slope offset |
	"See if (data1 * C1) + C2 is the answer.  In the form  #(C2 C1) polynomialEval: data1 "

	denom := ((thisData at: 2) at: 1) - ((thisData at: 1) at: 1).
	denom = 0 ifTrue: [^ false].   "will divide by it"
	num := (answers at: 2) - (answers at: 1).

    slope := (num asFloat / denom) reduce.
    offset := ((answers at: 2) - (((thisData at: 2) at: 1) * slope)) reduce.

	const := Array with: offset with: slope.
	got := (subTest := MethodFinder new copy: self addArg: const) 
				searchForOne isEmpty not.
	got ifFalse: [^ false]. 

	"replace data2 with const in expressions"
	subTest expressions do: [:exp |
		expressions add: (exp copyReplaceAll: 'data2' with: const printString)].
	selector addAll: subTest selectors.
	^ true! !

!MethodFinder methodsFor: 'search' stamp: 'tk 4/12/2001 10:47'!
insertConstants
	"see if one of several known expressions will do it. C is the constant we discover here."
	"C  data1+C  data1*C  data1//C  (data1*C1 + C2) (data1 = C) (data1 ~= C) (data1 <= C) (data1 >= C) 
 (data1 mod C)"

	thisData size >= 2 ifFalse: [^ false].	"need 2 examples"
	(thisData at: 1) size = 1 ifFalse: [^ false].	"only one arg, data1"

	self const ifTrue: [^ true].
	self constUsingData1Value ifTrue: [^ true].
		"(data1 ?? const), where const is one of the values of data1"
		" == ~~ ~= = <= >= "

	self allNumbers ifFalse: [^ false].
	self constMod ifTrue: [^ true].
	self constPlus ifTrue: [^ true].
	self constMult ifTrue: [^ true].
	self constDiv ifTrue: [^ true].
	self constLinear ifTrue: [^ true].
	^ false! !

!MethodFinder methodsFor: 'accessing' stamp: 'tk 12/29/2000 13:39'!
data

	^ data! !

!MethodFinder methodsFor: 'initialize' stamp: 'BernardoContreras 8/11/2014 19:18'!
initialize2
	"The methods we are allowed to use.  (MethodFinder new initialize) "

"Set"
	#("in class" sizeFor:
"testing" "adding" "removing" "enumerating"
"private" array findElementOrNil: 
"accessing" someElement) do: [:sel | Approved add: sel].

"Dictionary, IdentityDictionary, IdentitySet"
	#("accessing" associationAt: associationAt:ifAbsent: at:ifPresent: keyAtIdentityValue: keyAtIdentityValue:ifAbsent: keyAtValue: keyAtValue:ifAbsent: keys
"testing" includesKey: ) do: [:sel | Approved add: sel].
	#(removeKey: removeKey:ifAbsent:
) do: [:sel | AddAndRemove add: sel].

"LinkedList, Interval, MappedCollection"
	#("in class"  from:to: from:to:by:
"accessing" contents) do: [:sel | Approved add: sel].
	#(
"adding" addFirst: addLast:) do: [:sel | AddAndRemove add: sel].

"OrderedCollection, SortedCollection"
	#("accessing" after: before:
"copying" copyEmpty
"removing" "enumerating" "private" 
"accessing" sortBlock) do: [:sel | Approved add: sel].
	#("adding" add:after: add:afterIndex: add:before: addAllFirst: addAllLast: addFirst: addLast:
"removing" removeAt: removeFirst removeLast
"accessing" sortBlock:) do: [:sel | AddAndRemove add: sel].

"Character"
	#("in class, instance creation" allCharacters digitValue: new separators
	"accessing untypeable characters" backspace cr enter lf linefeed nbsp newPage space tab
	"constants" alphabet characterTable
"accessing" asciiValue digitValue
"comparing"
"testing" isAlphaNumeric isDigit isLetter isLowercase isSafeForHTTP isSeparator isSpecial isUppercase isVowel tokenish
"copying"
"converting" asLowercase asUppercase
	) do: [:sel | Approved add: sel].

"String"
	#("in class, instance creation" crlf 
	"primitives" findFirstInString:inSet:startingAt: indexOfAscii:inString:startingAt: 	"internet"
"accessing" byteAt: endsWithDigit findAnySubStr:startingAt: findBetweenSubStrs: findDelimiters:startingAt: findString:startingAt: findString:startingAt:caseSensitive: findTokens: findTokens:includes: findTokens:keep: #includesSubstring: includesSubstring:caseSensitive: indexOf:startingAt: indexOfAnyOf: indexOfAnyOf:ifAbsent: indexOfAnyOf:startingAt: indexOfAnyOf:startingAt:ifAbsent: lineCorrespondingToIndex: lineCount lineNumber: skipAnySubStr:startingAt: skipDelimiters:startingAt: startsWithDigit
"comparing" alike: beginsWith: caseSensitiveLessOrEqual: charactersExactlyMatching: compare: endsWith: endsWithAnyOf: sameAs: startingAt:match:startingAt:
"copying" copyReplaceTokens:with: padLeftTo: padRightTo: padLeftTo:with: padRightTo:with:
"converting" asByteArray asDate asFileName asText asTime asUrl capitalized compressWithTable: contractTo: correctAgainst: initialIntegerOrNil keywords quoted withoutPeriodSuffix splitInteger stemAndNumericSuffix substrings surroundedBySingleQuotes truncateWithElipsisTo: trimBoth uncapitalized withNoLineLongerThan: withSeparatorsCompacted withoutLeadingDigits trimRight trimLeft
"displaying" "printing"
"system primitives" compare:with:collated: 
"Celeste" withCRs
"internet" decodeMimeHeader decodeQuotedPrintable withInternetLineEndings withSqueakLineEndings withoutQuoting urlEncoded UrlDecoded
"testing" isAllSeparators lastSpacePosition
"paragraph support" indentationIfBlank:
"arithmetic" ) do: [:sel | Approved add: sel].
	#(byteAt:put: translateToLowercase match:) do: [:sel | AddAndRemove add: sel].

"Symbol"
	#("in class, private" hasInterned:ifTrue:
	"access" morePossibleSelectorsFor: possibleSelectorsFor: selectorsContaining: thatStarts:skipping:
"accessing" "comparing" "copying" "converting" "printing" 
"testing" isInfix isKeyword isUnary) do: [:sel | Approved add: sel].

"Array"
	#("comparing" "converting" 
"printing" "private" hasLiteralSuchThat:) do: [:sel | Approved add: sel].

"Array2D"
	#("access" at:at: atCol: atCol:put: atRow: extent extent:fromArray: height width width:height:type:) do: [:sel | Approved add: sel].
	#(at:at:add: at:at:put: atRow:put: ) do: [:sel | AddAndRemove add: sel].

"ByteArray"
	#("accessing" doubleWordAt: wordAt: 
"platform independent access" longAt:bigEndian: shortAt:bigEndian: unsignedLongAt:bigEndian: unsignedShortAt:bigEndian: 
"converting") do: [:sel | Approved add: sel].
	#(doubleWordAt:put: wordAt:put: longAt:put:bigEndian: shortAt:put:bigEndian: unsignedLongAt:put:bigEndian: unsignedShortAt:put:bigEndian:
	) do: [:sel | AddAndRemove add: sel].

"FloatArray"		"Dont know what happens when prims not here"
	false ifTrue: [#("accessing" "arithmetic" *= += -= /=
"comparing"
"primitives-plugin" primAddArray: primAddScalar: primDivArray: primDivScalar: primMulArray: primMulScalar: primSubArray: primSubScalar:
"primitives-translated" primAddArray:withArray:from:to: primMulArray:withArray:from:to: primSubArray:withArray:from:to:
"converting" "private" "user interface") do: [:sel | Approved add: sel].
	].

"IntegerArray, WordArray"
"RunArray"
	#("in class, instance creation" runs:values: scanFrom:
"accessing" runLengthAt: 
"adding" "copying"
"private" runs values) do: [:sel | Approved add: sel].
	#(coalesce repeatLast:ifEmpty: repeatLastIfEmpty:
		) do: [:sel | AddAndRemove add: sel].

"Stream  -- many operations change its state"
	#("testing" atEnd) do: [:sel | Approved add: sel].
	#("accessing" next: nextMatchAll: nextMatchFor: upToEnd
next:put: nextPut: nextPutAll: "printing" print:
	) do: [:sel | AddAndRemove add: sel].

"PositionableStream"
	#("accessing" contentsOfEntireFile originalContents peek peekFor: "testing"
"positioning" position ) do: [:sel | Approved add: sel].
	#(nextDelimited: nextLine upTo: position: reset resetContents setToEnd skip: skipTo: upToAll: ) do: [:sel | AddAndRemove add: sel].
	"Because it is so difficult to test the result of an operation on a Stream (you have to supply another Stream in the same state), we don't support Streams beyond the basics.  We want to find the messages that convert Streams to other things."

"ReadWriteStream"
	#("file status" closed) do: [:sel | Approved add: sel].
	#("accessing" next: on: ) do: [:sel | AddAndRemove add: sel].

"WriteStream"
	#("in class, instance creation" on:from:to: with: with:from:to:
		) do: [:sel | Approved add: sel].
	#("positioning" resetToStart
"character writing" crtab crtab:) do: [:sel | AddAndRemove add: sel].

"LookupKey, Association, Link"
	#("accessing" key nextLink) do: [:sel | Approved add: sel].
	#(key: key:value: nextLink:) do: [:sel | AddAndRemove add: sel].

"Point"
	#("in class, instance creation" r:degrees: x:y:
"accessing" x y "comparing" "arithmetic" "truncation and round off"
"polar coordinates" degrees r theta
"point functions" bearingToPoint: crossProduct: dist: dotProduct: eightNeighbors flipBy:centerAt: fourNeighbors grid: nearestPointAlongLineFrom:to: nearestPointOnLineFrom:to: normal normalized octantOf: onLineFrom:to: onLineFrom:to:within: quadrantOf: rotateBy:centerAt: transposed unitVector
"converting" asFloatPoint asIntegerPoint corner: extent: rect:
"transforming" adhereTo: rotateBy:about: scaleBy: scaleFrom:to: translateBy: "copying"
"interpolating" interpolateTo:at:) do: [:sel | Approved add: sel].

"Rectangle"
	#("in class, instance creation" center:extent: encompassing: left:right:top:bottom: 
	merging: origin:corner: origin:extent: 
"accessing" area bottom bottomCenter bottomLeft bottomRight boundingBox center corner corners innerCorners left leftCenter origin right rightCenter top topCenter topLeft topRight
"comparing"
"rectangle functions" adjustTo:along: amountToTranslateWithin: areasOutside: bordersOn:along: encompass: expandBy: extendBy: forPoint:closestSideDistLen: insetBy: insetOriginBy:cornerBy: intersect: merge: pointNearestTo: quickMerge: rectanglesAt:height: sideNearestTo: translatedToBeWithin: withBottom: withHeight: withLeft: withRight: withSide:setTo: withTop: withWidth:
"testing" containsPoint: containsRect: hasPositiveExtent intersects: isTall isWide
"truncation and round off"
"transforming" align:with: centeredBeneath: newRectFrom: squishedWithin: "copying"
	) do: [:sel | Approved add: sel].

"Color"
	#("in class, instance creation" colorFrom: colorFromPixelValue:depth: gray: h:s:v: r:g:b: r:g:b:alpha: r:g:b:range:
	"named colors" black blue brown cyan darkGray gray green lightBlue lightBrown lightCyan lightGray lightGreen lightMagenta lightOrange lightRed lightYellow magenta orange red transparent veryDarkGray veryLightGray veryVeryDarkGray veryVeryLightGray white yellow
	"other"  indexedColors pixelScreenForDepth: quickHighLight:
"access" alpha blue brightness green hue luminance red saturation
"equality"
"queries" isBitmapFill isBlack isGray isSolidFill isTranslucent isTranslucentColor
"transformations" alpha: dansDarker darker lighter mixed:with: muchLighter slightlyDarker slightlyLighter veryMuchLighter alphaMixed:with:
"groups of shades" darkShades: lightShades: mix:shades: wheel:
"printing" shortPrintString
"other" colorForInsets rgbTriplet
"conversions" asB3DColor asColor balancedPatternForDepth: bitPatternForDepth: closestPixelValue1 closestPixelValue2 closestPixelValue4 closestPixelValue8 dominantColor halfTonePattern1 halfTonePattern2 indexInMap: pixelValueForDepth: pixelWordFor:filledWith: pixelWordForDepth: scaledPixelValue32
"private" privateAlpha privateBlue privateGreen privateRGB privateRed "copying"
	) do: [:sel | Approved add: sel].

"	For each selector that requires a block argument, add (selector argNum) 
		to the set Blocks."
"ourClasses := #(Object Boolean True False UndefinedObject Behavior ClassDescription Class Metaclass MethodContext BlockContext Message Magnitude Date Time Number Integer SmallInteger LargeNegativeInteger LargePositiveInteger Float Fraction Random Collection SequenceableCollection ArrayedCollection Bag Set Dictionary IdentityDictionary IdentitySet LinkedList Interval MappedCollection OrderedCollection SortedCollection Character String Symbol Array Array2D ByteArray FloatArray IntegerArray WordArray RunArray Stream PositionableStream ReadWriteStream WriteStream LookupKey Association Link Point Rectangle Color).
ourClasses do: [:clsName | cls := Smalltalk at: clsName.
	(cls selectors) do: [:aSel |
		((Approved includes: aSel) or: [AddAndRemove includes: aSel]) ifTrue: [
			(cls formalParametersAt: aSel) withIndexDo: [:tName :ind |
				(tName endsWith: 'Block') ifTrue: [
					Blocks add: (Array with: aSel with: ind)]]]]].
"
#((timesRepeat: 1 ) (indexOf:ifAbsent: 2 ) (pairsCollect: 1 ) (mergeSortFrom:to:by: 3 ) (ifNotNil:ifNil: 1 ) (ifNotNil:ifNil: 2 ) (ifNil: 1 ) (at:ifAbsent: 2 ) (ifNil:ifNotNil: 1 ) (ifNil:ifNotNil: 2 ) (ifNotNil: 1) (identityIndexOf:ifAbsent: 2 ) (sort: 1 ) (sortBlock: 1 ) (detectMax: 1 ) (repeatLastIfEmpty: 1 ) (allSubclassesWithLevelDo:startingLevel: 1 ) (keyAtValue:ifAbsent: 2 ) (in: 1 ) (ifTrue: 1 ) (or: 1 ) (select: 1 ) (inject:into: 2 )  (forPoint:closestSideDistLen: 2 ) (value:ifError: 2 ) (selectorsDo: 1 ) (removeAllSuchThat: 1 ) (keyAtIdentityValue:ifAbsent: 2 ) (detectMin: 1 ) (detect:ifNone: 1 ) (ifTrue:ifFalse: 1 ) (ifTrue:ifFalse: 2 ) (detect:ifNone: 2 ) (hasLiteralSuchThat: 1 ) (indexOfAnyOf:ifAbsent: 2 ) (reject: 1 ) (newRectFrom: 1 ) (removeKey:ifAbsent: 2 ) (at:ifPresent: 2 ) (associationAt:ifAbsent: 2 ) (withIndexCollect: 1 ) (repeatLast:ifEmpty: 2 ) (findLast: 1 ) (indexOf:startingAt:ifAbsent: 3 ) (remove:ifAbsent: 2 ) (ifFalse:ifTrue: 1 ) (ifFalse:ifTrue: 2 ) (caseOf:otherwise: 2 ) (count: 1 ) (collect: 1 ) (sort: 1 ) (and: 1 ) (asSortedCollection: 1 ) (with:collect: 2 ) (sourceCodeAt:ifAbsent: 2 ) (detect: 1 ) (collectWithIndex: 1 ) (compiledMethodAt:ifAbsent: 2 ) (detectSum: 1 ) (indexOfSubCollection:startingAt:ifAbsent: 3 ) (findFirst: 1 ) (sourceMethodAt:ifAbsent: 2 ) (collect:thenSelect: 1 ) (collect:thenSelect: 2 ) (select:thenCollect: 1 ) (select:thenCollect: 2 ) (ifFalse: 1 ) (indexOfAnyOf:startingAt:ifAbsent: 3 ) (indentationIfBlank: 1 ) ) do: [:anArray |
	Blocks add: anArray].

self initialize3.

"
MethodFinder new initialize.
MethodFinder new organizationFiltered: TranslucentColor class 
"
"Do not forget class messages for each of these classes"
! !

!MethodFinder methodsFor: 'argument permutation maps' stamp: 'tk 4/24/1999 19:29'!
argMap
	^ argMap ! !

!MethodFinder methodsFor: 'initialize' stamp: 'sd 4/21/2011 16:06'!
cleanInputs: dataAndAnswerString 
	"Find and remove common mistakes.  Complain when ill formed."
	| fixed ddd rs places |
	ddd := dataAndAnswerString.
	fixed := false.
	rs := (ddd , ' ') readStream.
	places := OrderedCollection new.
	
	[ rs upToAll: '#true'.
	rs atEnd ] whileFalse: [ places addFirst: rs position - 4 ].
	places do: 
		[ :pos | 
		ddd := ddd 
			copyReplaceFrom: pos
			to: pos
			with: ''.
		fixed := true ].	"remove #"
	rs := ddd readStream.
	places := OrderedCollection new.
	
	[ rs upToAll: '#false'.
	rs atEnd ] whileFalse: [ places addFirst: rs position - 5 ].
	places do: 
		[ :pos | 
		ddd := ddd 
			copyReplaceFrom: pos
			to: pos
			with: ''.
		fixed := true ].	"remove #"
	fixed ifTrue: 
		[ self inform: '#(true false) are Symbols, not Booleans.  
Next time use { true. false }.' ].
	fixed := false.
	rs := ddd readStream.
	places := OrderedCollection new.
	
	[ rs upToAll: '#nil'.
	rs atEnd ] whileFalse: [ places addFirst: rs position - 3 ].
	places do: 
		[ :pos | 
		ddd := ddd 
			copyReplaceFrom: pos
			to: pos
			with: ''.
		fixed := true ].	"remove #"
	fixed ifTrue: 
		[ self inform: '#nil is a Symbol, not the authentic UndefinedObject.  
Next time use nil instead of #nil' ].
	^ ddd! !

!MethodFinder methodsFor: 'find a constant' stamp: 'nice 1/5/2010 15:59'!
constUsingData1Value
	| subTest |
	"See if (data1 <= C) or (data1 >= C) is the answer"

	"quick test"
	((answers at: 1) class superclass == Boolean) ifFalse: [^ false].
	2 to: answers size do: [:ii | 
		((answers at: ii) class superclass == Boolean) ifFalse: [^ false]].

	thisData do: [:datums | | const got | 
		const := datums first.	"use data as a constant!!"
		got := (subTest := MethodFinder new copy: self addArg: const) 
					searchForOne isEmpty not.
		got ifTrue: [
			"replace data2 with const in expressions"
			subTest expressions do: [:exp |
				expressions add: (exp copyReplaceAll: 'data2' with: const printString)].
			selector addAll: subTest selectors.
			^ true]].
	^ false! !

!MethodFinder methodsFor: 'initialize' stamp: 'sd 4/21/2011 17:10'!
initialize3
	"additional selectors to consider"

	#(asWords threeDigitName ) do: [:sel | Approved add: sel].! !

!MethodFinder methodsFor: 'accessing' stamp: 'tk 12/29/2000 13:20'!
expressions
	^ expressions! !

!MethodFinder methodsFor: 'find a constant' stamp: 'tk 1/18/2001 22:45'!
const
	| const |
	"See if (^ constant) is the answer"

	"quick test"
	((const := answers at: 1) closeTo: (answers at: 2)) ifFalse: [^ false].
	3 to: answers size do: [:ii | (const closeTo: (answers at: ii)) ifFalse: [^ false]].
	expressions add: '^ ', const printString.
	selector add: #yourself.
	^ true! !

!MethodFinder methodsFor: 'argument permutation maps' stamp: 'sd 4/21/2011 17:01'!
mapData 
	"Force the data through the map (permutation) to create the data to test."

	thisData := data collect: [:realData | argMap collect: [:ind | realData at: ind]].
		! !

!MethodFinder methodsFor: 'search' stamp: 'tk 1/8/2001 17:53'!
searchForOne
	"Look for and return just one answer"

	expressions := OrderedCollection new.
	self search: false.	"non-multi"
	^ expressions
			! !

!MethodFinder methodsFor: 'search' stamp: 'MarcusDenker 6/28/2014 11:44'!
handleExceptionalSelectors
	"Handle some very slippery selectors.
	asSymbol -- want to be able to produce it, but do not want to make every string submitted into a Symbol!!"

	| aSel |
	answers first isSymbol
		ifFalse: [ ^ self ].
	thisData first first isString
		ifFalse: [ ^ self ].
	aSel := #asSymbol.
	(self testPerfect: aSel)
		ifFalse: [ ^ self ].
	selector add: aSel.
	expressions
		add:
			(String
				streamContents: [ :strm | 
					strm nextPutAll: 'data' , argMap first printString.
					aSel keywords
						doWithIndex: [ :key :ind | 
							strm nextPutAll: ' ' , key.
							key last == $: | key first isLetter not
								ifTrue: [ strm nextPutAll: ' data' , (argMap at: ind + 1) printString ] ] ])! !

!MethodFinder methodsFor: 'find a constant' stamp: 'md 11/14/2003 16:47'!
constEquiv
	| const subTest got jj |
	"See if (data1 = C) or (data1 ~= C) is the answer"

	"quick test"
	((answers at: 1) class superclass == Boolean) ifFalse: [^ false].
	2 to: answers size do: [:ii | 
		((answers at: ii) class superclass == Boolean) ifFalse: [^ false]].

	const := (thisData at: 1) at: 1.
	got := (subTest := MethodFinder new copy: self addArg: const) 
				searchForOne isEmpty not.
	got ifFalse: ["try other polarity for ~~ "
		(jj := answers indexOf: (answers at: 1) not) > 0 ifTrue: [
		const := (thisData at: jj) at: 1.
		got := (subTest := MethodFinder new copy: self addArg: const) 
				searchForOne isEmpty not]]. 
	got ifFalse: [^ false]. 

	"replace data2 with const in expressions"
	subTest expressions do: [:exp |
		expressions add: (exp copyReplaceAll: 'data2' with: const printString)].
	selector addAll: subTest selectors.
	^ true! !

!MethodFinder methodsFor: 'public api' stamp: 'sd 4/21/2011 17:33'!
load: dataWithAnswers
	"Find a function that takes the data and gives the answers.  Odd list entries are data for it, even ones are the answers.  nil input means data and answers were supplied already."
	"(MethodFinder new) load: #( (4 3) 7  (-10 5) -5  (-3 11) 8);
		findMessage  "

	dataWithAnswers ifNotNil: [
		data := Array new: dataWithAnswers size // 2.
		1 to: data size do: [:ii | data at: ii put: (dataWithAnswers at: ii*2-1)].
		answers := Array new: data size.
		1 to: answers size do: [:ii | answers at: ii put: (dataWithAnswers at: ii*2)]].
	data do: [:list | 
		(list isKindOf: SequenceableCollection) ifFalse: [
			^ self error: 'first and third items are not Arrays'].
		].
	argMap := (1 to: data first size) asArray.
	data do: [:list | list size = argMap size ifFalse: [
			self error: 'data arrays must all be the same size']].
	argMap size > 4 ifTrue: [self error: 'No more than a receiver and 
		three arguments allowed'].
		
	thisData := data copy.
	mapStage := mapList := nil.
! !

!MethodFinder methodsFor: 'tests' stamp: 'StephaneDucasse 8/15/2013 18:27'!
testFromTuple: nth
	"verify that the methods allowed don't crash the system.  Try N of each of the fundamental types.  up to 4 of each kind." 

	| objects nonRepeating even other aa cnt |
	objects := #((1 4 17 42) ($a $b $c $d) ('one' 'two' 'three' 'four')
	(x + rectangle: new) ((a b 1 4) (c 1 5) ($a 3 d) ()) (4.5 0.0 3.2 100.3)
	).

	objects := objects, {{true. false. true. false}. {Point. SmallInteger. Association. Array}.
	{Point class. SmallInteger class. Association class. Array class}.
	"{ 4 blocks }."
	{Date today. '1 Jan 1950' asDate. '25 Aug 1987' asDate. '1 Jan 2000' asDate}.
	{'15:16' asTime. '1:56' asTime. '4:01' asTime. '6:23' asTime}.
	{Dictionary new. Dictionary new. Dictionary new. Dictionary new}.
	{#(a b 1 4) asOrderedCollection. #(c 1 5) asOrderedCollection. 
		#($a 3 d) asOrderedCollection. #() asOrderedCollection}.
	{3->true. 5.6->$a. #x->2. 'abcd'->false}.
	{9 @ 3 extent: 5 @ 4. 0 @ 0 extent: 45 @ 9. -3 @ -7 extent: 2 @ 2. 4 @ 4 extent: 16 @ 16}.
	{Color red.  Color blue. Color black. Color gray}}.

	self test2: objects.
	"rec+0, rec+1, rec+2, rec+3 need to be tested.  " 
	cnt := 0.
	nth to: 4 do: [:take |
		nonRepeating := OrderedCollection new.
		objects do: [:each |
			nonRepeating addAll: (each copyFrom: 1 to: take)].
		"all combinations of take, from nonRepeating"
		even := true.
		nonRepeating combinations: take atATimeDo: [:tuple |
			even ifTrue: [other := tuple shallowCopy]
				ifFalse: [self load: (aa := Array with: tuple with: 1 with: other with: 7).
					(cnt := cnt+1) \\ 50 = 0 ifTrue: [
						Transcript cr; show: aa first printString].
					self search: true.
					self test2: aa.
					self test2: nonRepeating.
					"self test2: objects"].
			even := even not].
		].! !

!MethodFinder methodsFor: 'accessing' stamp: 'tk 12/29/2000 13:39'!
answers

	^ answers! !

!MethodFinder methodsFor: 'accessing' stamp: 'tk 1/4/2001 17:18'!
selectors
	"Note the inst var does not have an S on the end"

	^ selector! !

!MethodFinder methodsFor: 'search' stamp: 'sd 4/21/2011 17:51'!
simpleSearch
	"Run through first arg's class' selectors, looking for one that works."

	| class supers listOfLists |
	self handleExceptionalSelectors.
	class := thisData first first class.
	"Cache the selectors for the receiver class"
	(class == cachedClass and: [cachedArgNum = ((argMap size) - 1)]) 
		ifTrue: [listOfLists := cachedSelectorLists]
		ifFalse: [
			supers := class withAllSuperclasses.
			listOfLists := OrderedCollection new.
			supers do: [:cls |
				listOfLists add: (cls selectorsWithArgs: (argMap size) - 1)].
			cachedClass := class.
			cachedArgNum := (argMap size) - 1.
			cachedSelectorLists := listOfLists].
	listOfLists do: [:selectorList |
		selectorList do: [:aSel |
			(selector includes: aSel) ifFalse: [
				((Approved includes: aSel) or: [AddAndRemove includes: aSel]) ifTrue: [
					(self testPerfect: aSel) ifTrue: [
						selector add: aSel.
						expressions add: (String streamContents: [:strm | 
							strm nextPutAll: 'data', argMap first printString.
							aSel keywords doWithIndex: [:key :ind |
								strm nextPutAll: ' ',key.
								(key last == $:) | (key first isLetter not)
									ifTrue: [strm nextPutAll: ' data', 
										(argMap at: ind+1) printString]]])
						]]]]].
! !

!MethodFinder methodsFor: 'public api' stamp: 'sd 4/21/2011 17:48'!
search: multi
	"if Multi is true, collect all selectors that work."
	selector := OrderedCollection new.	"list of them"
	self simpleSearch.
	multi not & (selector isEmpty not) ifTrue: [^ selector].

	[self permuteArgs] whileTrue:
		[self simpleSearch.
		multi not & (selector isEmpty not) ifTrue: [^ selector]].
	self insertConstants.
	^ #()! !

!MethodFinder class methodsFor: 'instance creation' stamp: 'sd 4/21/2011 17:57'!
methodFor: dataAndAnswers
	"Return an expression that computes these answers."

	| resultOC resultString |
	resultOC := self new load: dataAndAnswers; findMessage.
	resultString := String streamContents: [:strm |
		resultOC do: [:exp | strm nextPut: $(; nextPutAll: exp; nextPut: $); space]].
	^ resultString! !

!MethodFinderTest commentStamp: 'sd 4/21/2011 16:54'!
To do:
	- radix should be returned !
!MethodFinderTest methodsFor: 'test examples' stamp: 'sd 4/21/2011 18:10'!
testMethodFor
	"self debug: #testMethodFor"
	
	self assert: (MethodFinder  methodFor: {#(1). true. #(2). false. #(5). true. #(10). false}) =  '(data1 odd) (data1 anyMask: 1) (data1 allMask: 1) '! !

!MethodFinderTest methodsFor: 'test examples' stamp: 'YuriyTymchuk 12/20/2013 16:55'!
testSubstraction
	"self debug: #testSubstraction"
	
	self assert: (MethodFinder new load: #((14 3) 11  (-10 5) -15  (4 -3) 7)) searchForOne asArray equals: #('data1 - data2').
	
	self assert: (MethodFinder new load: #(((12 4 8)) 24  ((1 3 6)) 10 )
	) searchForOne asArray  equals: #('data1 sum') ! !

!MethodFinderTest methodsFor: 'test examples' stamp: 'YuriyTymchuk 12/20/2013 16:50'!
testSearchForOne
	"self debug: #testSearchForOne"
	
	self
		assert: (MethodFinder new load: #(('abcd') $a  ('TedK') $T))
			searchForOne asArray
		equals: #('data1 first' 'data1 anyOne')
		 ! !

!MethodFinderTest methodsFor: 'test examples' stamp: 'YuriyTymchuk 12/20/2013 17:11'!
testGreaterThanANumber
	"self debug: #testGreaterThanANumber"
	
	self 
		assert: (MethodFinder new load: {#(7). true.   #(4.1).  true.   #(1.5). false}) searchForOne asArray 
		equals: #('data1 >= 4.1').
		
	self assert: (MethodFinder new load: {#(4 3). true.  #(-7 3). false.  #(5 1). true.  #(5 5). false}) searchForOne asArray 
		equals: #('data1 > data2').
	self assert: (MethodFinder new load: #((36) 7   (50) 10)) searchForOne asArray equals: #( 'data1 // 5' 'data1 quo: 5')! !

!MethodFinderTest methodsFor: 'test examples' stamp: 'sd 4/21/2011 16:10'!
testDegreeSin
	"self debug: #testDegreeSin"
	
	self assert: (MethodFinder new load: #( (0) 0  (30) 0.5  (45) 0.707106  (90) 1)) searchForOne asArray = #('data1 degreeSin') ! !

!MethodFinderTest methodsFor: 'test examples' stamp: 'sd 4/21/2011 16:12'!
testIfTrueIfFalse
	"self debug: #testIfTrueIfFalse"
	
	self assert: (MethodFinder new load:  { { true. [3]. [4]}. 3.  { false. [0]. [6]}. 6}) searchForOne asArray = #('data1 ifTrue: data2 ifFalse: data3') ! !

!MethodFinderTest methodsFor: 'test examples' stamp: 'YuriyTymchuk 12/20/2013 17:00'!
testPower
	"self debug: #testPower"
	
	self assert:(MethodFinder new load: #((7) 2   (4) 2 )) searchForOne asArray equals: #('^ 2')! !

!MethodFinderTest methodsFor: 'test examples' stamp: 'sd 4/21/2011 16:57'!
testReciprocal
	"self debug: #testReciprocal"
	
	self assert: (MethodFinder new load: #((5) 0.2   (2) 0.5)) searchForOne asArray = #('data1 reciprocal')
! !

!MethodFinderTest methodsFor: 'test examples' stamp: 'sd 4/21/2011 16:56'!
testPointY
	"self debug: #testPointY"
	
	self assert: (MethodFinder new load: {{Point x: 3 y: 4}. 4.  {Point x: 1 y: 5}. 5}) searchForOne asArray = #('data1 max' 'data1 y').
	self assert: (MethodFinder new load: {{Point x: 5 y: 4}. 4.  {Point x: 1 y: 5}. 5}) searchForOne asArray = #( 'data1 y').! !

!MethodFinderTest methodsFor: 'test examples' stamp: 'YuriyTymchuk 12/20/2013 17:03'!
testPolynomial
	"self debug: #testPolynomial"
	
	self assert: (MethodFinder new load: #( ((2 3) 2) 8   ((2 3) 5) 17 )) searchForOne asArray 
		equals: #('data1 polynomialEval: data2').	
	self assert: (MethodFinder new load: #((2) 8   (5) 17 )) searchForOne asArray 
		equals: #('#(2 3) polynomialEval: data1')	
! !

!MethodFinderTest methodsFor: 'test examples' stamp: 'sd 4/21/2011 16:13'!
testIsOdd
	"self debug: #testIsOdd"
	
	self assert: (MethodFinder new load: {#(1). true. #(2). false. #(5). true. #(10). false}) searchForOne asArray = #('data1 odd')! !

!MethodFinderTest methodsFor: 'test examples' stamp: 'sd 4/21/2011 18:08'!
testAllNumbers
	"self debug: #testAllNumbers"	

	self assert: (MethodFinder new load: #((5) 0.2   (2) 0.5)) allNumbers.
	self deny: (MethodFinder new load: #(('' $A) 'A')) allNumbers! !

!MethodFinderTest methodsFor: 'test examples' stamp: 'YuriyTymchuk 12/20/2013 16:52'!
testSearchForAccessAtOne
	"self debug: #testSearchForAccessAtOne"
	
	self
		assert: (MethodFinder new load: #(('abcd' 1) $a  ('Ted ' 3) $d ))
			searchForOne asArray
		equals: #('data1 at: data2' 'data1 atPin: data2' 'data1 atWrap: data2')
		 ! !

!MethodFinderTest methodsFor: 'test examples' stamp: 'sd 4/21/2011 17:07'!
testIsRadix
	"self debug: #testIsRadix"
	
	self assert: ((MethodFinder new load: #((4 2) '2r100'   (255 16) '16rFF'    (14 8) '8r16')) searchForOne) asArray = #('data1 storeStringBase: data2')
		
		"Apparently the system should find :
		the #('data1 radix: data2' 'data1 printStringBase: data2' 'data1 storeStringBase: data2')"! !

!MethodFinderTest methodsFor: 'test examples' stamp: 'YuriyTymchuk 12/20/2013 17:06'!
testDivision
	"self debug: #testDivision"
	
	self 
		assert: (MethodFinder new load: #((7 5) 2   (4 5) 4   (-9 4) 3)) searchForOne asArray 
		equals: #('data1 \\ data2').
	self assert:
		(MethodFinder new load: #((35) 3   (17) 1   (5) 5)) searchForOne asArray 
		equals: #('data1 \\ 8').
	self assert: (MethodFinder new load: #((12 4 8) 2  (1 3 6) 2  (5 2 16) 8)
	) searchForOne asArray equals:  #().! !

!MethodFinderTest methodsFor: 'test examples' stamp: 'YuriyTymchuk 12/20/2013 16:58'!
testAbs
	"self debug: #testAbs"
	
	self assert: (MethodFinder new load: #((4) 4  (-10) 10 (-3) 3 (2) 2 (-6) 6 (612) 612)) searchForOne asArray equals: #('data1 abs')! !

!MethodFromTraitAction commentStamp: '<historical>'!
Action when the method comes from a trait!
!MethodFromTraitAction methodsFor: 'order' stamp: 'BenjaminVanRyseghem 1/2/2013 12:41'!
isActionHandled

	^ method isFromTrait! !

!MethodFromTraitAction methodsFor: 'order' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
privateActionIcon
	"Return the icon for this action"

	^ IconicButton new 
			target: method originMethod;
			actionSelector: #browse;
			labelGraphic: (Smalltalk ui icons iconNamed: #traitIcon) ;
			color: Color transparent;
			extent: 12 @ 12;
			helpText: 'Browse the trait';
			borderWidth: 0! !

!MethodFromTraitAction methodsFor: 'order' stamp: 'BenjaminVanRyseghem 2/20/2013 19:57'!
actionOrder
	"Return the priority of this action"
	
	^ 200! !

!MethodIsATraitExplicitRequirementAction commentStamp: '<historical>'!
Action when the method is a explicitRequired!
!MethodIsATraitExplicitRequirementAction methodsFor: 'order' stamp: 'SebastianTleye 8/22/2013 11:14'!
actionOrder
	^150.! !

!MethodIsATraitExplicitRequirementAction methodsFor: 'order' stamp: 'SebastianTleye 8/22/2013 14:00'!
isActionHandled
	^method isRequired and: [ method methodClass ~= method origin ]! !

!MethodIsATraitExplicitRequirementAction methodsFor: 'order' stamp: 'SebastianTleye 8/22/2013 13:50'!
privateActionIcon
	"Return the icon for this action"
	"^ Smalltalk ui icons iconNamed: #traitRequiredMethodIcon"
	^ IconicButton new 
			target: method originMethod;
			actionSelector: #browse;
			labelGraphic: (Smalltalk ui icons iconNamed: #traitRequiredMethodIcon) ;
			color: Color transparent;
			extent: 12 @ 12;
			helpText: 'Browse the trait';
			borderWidth: 0! !

!MethodIsAbstractAction commentStamp: '<historical>'!
Action when the method is abstract!
!MethodIsAbstractAction methodsFor: 'order' stamp: 'BenjaminVanRyseghem 1/2/2013 12:58'!
isActionHandled

	^ method isAbstract! !

!MethodIsAbstractAction methodsFor: 'order' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
privateActionIcon
	"Return the icon for this action"
	
	^ Smalltalk ui icons iconNamed: #abstractIcon! !

!MethodIsAbstractAction methodsFor: 'order' stamp: 'BenjaminVanRyseghem 2/20/2013 19:57'!
actionOrder
	"Return the priority of this action"
	
	^ 700! !

!MethodIsAbstractAction methodsFor: 'order' stamp: 'BenjaminVanRyseghem 1/2/2013 12:59'!
actionStateToCache
	"Return the state of the icon for caching purpose"
	
	^ icon! !

!MethodIsExampleAction commentStamp: 'TorstenBergmann 8/22/2014 23:40'!
Action when the method is an example!
!MethodIsExampleAction methodsFor: 'as yet unclassified' stamp: 'TorstenBergmann 8/23/2014 00:09'!
isActionHandled

	^ method isExampleMethod ! !

!MethodIsExampleAction methodsFor: 'as yet unclassified' stamp: 'TorstenBergmann 8/23/2014 00:09'!
privateActionIcon

	 ^IconicButton new 
			target: self browser;
			actionSelector: #runExampleMethod:;
		 	arguments: { method };
			labelGraphic: (Smalltalk ui icons iconNamed: #smallDoItIcon) ;
			color: Color transparent;
			extent: 12 @ 12;
			helpText: 'Run the example';
			borderWidth: 0 ! !

!MethodIsExampleAction methodsFor: 'as yet unclassified' stamp: 'TorstenBergmann 8/22/2014 23:39'!
actionOrder
	"Return the priority of this action"
	
	^0! !

!MethodIsScriptAction commentStamp: 'TorstenBergmann 1/16/2015 20:03'!
Action when the method is an executable script tagged with one or more of the following pragmas

someMethod
  <script>
  ...

or:

myMethodReturningAForm
    <script: 'self myMethodReturningAForm asMorph openInWorld'>
    ...!
!MethodIsScriptAction methodsFor: 'order' stamp: 'TorstenBergmann 1/16/2015 20:03'!
privateActionIcon

	 ^IconicButton new 
			target: self browser;
			actionSelector: #runScriptMethod:;
		 	arguments: { method };
			labelGraphic: (Smalltalk ui icons scriptManagerIcon) ;
			color: Color transparent;
			extent: 12 @ 12;
			helpText: 'Run the script(s)';
			borderWidth: 0 ! !

!MethodIsScriptAction methodsFor: 'order' stamp: 'TorstenBergmann 12/23/2014 10:57'!
actionOrder
	"Return the priority of this action"
	
	^0! !

!MethodIsScriptAction methodsFor: 'order' stamp: 'TorstenBergmann 1/16/2015 19:59'!
isActionHandled

	^ method isScriptMethod or: [ method isScriptMethodWithScript ]! !

!MethodIsTestAction commentStamp: '<historical>'!
Aciton when the method is a test!
!MethodIsTestAction methodsFor: 'order' stamp: 'BenjaminVanRyseghem 1/2/2013 12:41'!
isActionHandled

	^ method isTestMethod! !

!MethodIsTestAction methodsFor: 'order' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
privateActionIcon
	"Return the icon for this action"
	| testIcon |
	
	testIcon := Smalltalk ui icons iconNamed: #testNotRunIcon.
	
	method hasPassedTest
		ifTrue: [ testIcon := Smalltalk ui icons iconNamed: #testGreenIcon ].
	method hasFailedTest
		ifTrue: [ testIcon := Smalltalk ui icons iconNamed: #testYellowIcon ].
	method hasErrorTest
		ifTrue: [ testIcon := Smalltalk ui icons iconNamed: #testRedIcon ].
	
	^ IconicButton new
		target: self browser;
		actionSelector: #runTestForAMethod:notifying:;
		arguments: {method. true};
		labelGraphic: testIcon;
		color: Color transparent;
		helpText: 'Run the test';
		extent: 12 @ 12;
		borderWidth: 0! !

!MethodIsTestAction methodsFor: 'order' stamp: 'BenjaminVanRyseghem 2/20/2013 19:57'!
actionOrder
	"Return the priority of this action"
	
	^ 0! !

!MethodMapExamples methodsFor: 'examples' stamp: 'MarcusDenker 12/19/2012 17:19'!
exampleTempNamedTempCopyingNestedBlock
	
	^[| b |
		b := 1.
		[   | a |
		 a := 2.
		 a := b . (DebuggerMethodMapOpal forMethod: thisContext method) tempNamed: 'b' in: thisContext ] value] value! !

!MethodMapExamples methodsFor: 'examples' stamp: 'MarcusDenker 12/19/2012 17:02'!
exampleTempNamedPutCopying
	| b |
	b := 1.
	^[ | a |
		 a := b . (DebuggerMethodMapOpal forMethod: thisContext method) tempNamed: 'b' in: thisContext put: 2. thisContext tempNamed: 'b' ] value! !

!MethodMapExamples methodsFor: 'examples' stamp: 'MarcusDenker 12/19/2012 17:07'!
exampleTempNamedTempVectorNestedBlock
	 | a |
      a  := 1.
	^[| b |
		b := a.
		[  
		 b := 2 . (DebuggerMethodMapOpal forMethod: thisContext method) tempNamed: 'b' in: thisContext ] value] value! !

!MethodMapExamples methodsFor: 'examples' stamp: 'MarcusDenker 12/19/2012 17:13'!
exampleSimpleTemp
	| b |
	b := 1.
	^(DebuggerMethodMapOpal forMethod: thisContext method) tempNamed: 'b' in: thisContext! !

!MethodMapExamples methodsFor: 'examples' stamp: 'MarcusDenker 12/19/2012 16:57'!
exampleTempNamedCopying2
	| b |
	b := 1.
	^[ | a |
		a := b . (DebuggerMethodMapOpal forMethod: thisContext method) tempNamed: 'b' in: thisContext ] value! !

!MethodMapExamples methodsFor: 'examples' stamp: 'MarcusDenker 12/19/2012 17:03'!
exampleTempNamedPutCopying2
	| b |
	b := 1.
	^[ | a |
		 a := b . (DebuggerMethodMapOpal forMethod: thisContext method) tempNamed: 'b' in: thisContext put: 2. thisContext outerContext tempNamed: 'b' ] value! !

!MethodMapExamples methodsFor: 'examples' stamp: 'MarcusDenker 12/19/2012 17:00'!
exampleTempNamedCopying
	| b |
	b := 1.
	^[ | a |
		 a := b . (DebuggerMethodMapOpal forMethod: thisContext method) tempNamed: 'b' in: thisContext ] value! !

!MethodMapExamples methodsFor: 'examples' stamp: 'MarcusDenker 12/19/2012 17:38'!
exampleTempNamedTempCopyingNestedBlockPROBLEM
	 | a |
		 a := 2. 
	^[| b | 
		b := 1.
		[  
		 a := b . (DebuggerMethodMapOpal forMethod: thisContext method) tempNamed: 'b' in: thisContext ] value] value! !

!MethodMapExamples methodsFor: 'examples' stamp: 'NicolaiHess 10/26/2014 01:04'!
defineCopiedVarBecomeDeadContext
	| a b |
	b := [ a := 1.a := a + 1. (DebuggerMethodMapOpal forMethod: thisContext method)  tempNamed:'a' in:thisContext].
	^ b! !

!MethodMapExamples methodsFor: 'examples' stamp: 'MarcusDenker 12/19/2012 17:04'!
exampleTempNamedPutTempVector
	| b |
	b := 1.
	^[ | a |
		 b := 2 . (DebuggerMethodMapOpal forMethod: thisContext method) tempNamed: 'b' in: thisContext put: 3. thisContext tempNamed: 'b' ] value! !

!MethodMapExamples methodsFor: 'examples' stamp: 'MarcusDenker 12/19/2012 16:54'!
exampleTempNamedTempVector
	| b |
	b := 1.
	^[ | a |
		 b := 2 . (DebuggerMethodMapOpal forMethod: thisContext method) tempNamed: 'b' in: thisContext ] value! !

!MethodMapExamples methodsFor: 'examples' stamp: 'NicolaiHess 10/26/2014 01:04'!
exampleCopiedVarFromDeadContext
	^ self defineCopiedVarBecomeDeadContext value! !

!MethodMapExamples methodsFor: 'examples' stamp: 'MarcusDenker 12/19/2012 16:56'!
exampleTempNamedTempVector2
	| b |
	b := 1.
	^[ | a |
		 b := 2 . (DebuggerMethodMapOpal forMethod: thisContext method) tempNamed: 'b' in: thisContext outerContext ] value! !

!MethodMapExamples methodsFor: 'examples' stamp: 'NicolaiHess 10/26/2014 01:04'!
exampleTempNamedTempVectorInlinedLoop
"This test is for accessing temp var c within an inlined loop scope. 
Temp var c is written in the loop and closed in a block -> therefore it is in a tempvector. "
	| a b c |
	c := nil.
	a := 1.
	[ c := 42.
	b := (DebuggerMethodMapOpal forMethod: thisContext method) tempNamed:'c' in: thisContext. a < 1 ]
		whileTrue: [ a := a + 1.
				[ c asString ] ].
	^ b! !

!MethodMapExamples methodsFor: 'examples' stamp: 'MarcusDenker 12/19/2012 17:05'!
exampleTempNamedPutTempVector2
	| b |
	b := 1.
	^[ | a |
		 b := 2 . (DebuggerMethodMapOpal forMethod: thisContext method) tempNamed: 'b' in: thisContext put: 3. thisContext outerContext tempNamed: 'b' ] value! !

!MethodMapTests methodsFor: 'testing - temp access' stamp: 'MarcusDenker 12/19/2012 18:01'!
testExampleTempNamedPutCopying2
	self assert: (self compileAndRunExample: #exampleTempNamedPutCopying2) equals: 2! !

!MethodMapTests methodsFor: 'testing - temp access' stamp: 'MarcusDenker 12/19/2012 18:03'!
testExampleTempNamedTempVector2
	self assert: (self compileAndRunExample: #exampleTempNamedTempVector2) equals: 2! !

!MethodMapTests methodsFor: 'testing - temp access' stamp: 'MarcusDenker 12/19/2012 18:01'!
testExampleTempNamedPutTempVector
	self assert: (self compileAndRunExample: #exampleTempNamedPutTempVector) equals: 3.! !

!MethodMapTests methodsFor: 'util' stamp: 'MarcusDenker 12/20/2012 15:14'!
compileAndRunExample: aSelector
	| cm |
	
	cm := self compileMethod:  MethodMapExamples>>aSelector.
	^cm valueWithReceiver:  MethodMapExamples new arguments: #().! !

!MethodMapTests methodsFor: 'testing - temp access' stamp: 'MarcusDenker 12/19/2012 18:02'!
testExampleTempNamedPutCopying
	self assert: (self compileAndRunExample: #exampleTempNamedPutCopying) equals: 2.! !

!MethodMapTests methodsFor: 'testing - temp access' stamp: 'MarcusDenker 12/19/2012 18:03'!
testExampleTempNamedTempVector
	self assert: (self compileAndRunExample: #exampleTempNamedTempVector) equals: 2! !

!MethodMapTests methodsFor: 'testing - temp access' stamp: 'MarcusDenker 12/19/2012 17:38'!
testExampleTempNamedTempVectorNestedBlock
	self assert:  (self compileAndRunExample:  #exampleTempNamedTempVectorNestedBlock ) equals: 2.! !

!MethodMapTests methodsFor: 'testing - source mapping' stamp: 'md 1/17/2013 16:47'!
testSourceMappingBlock
	| method range highlight |

	method := MethodMapExamples>>#exampleTempNamedCopying.

	range := (DebuggerMethodMapOpal forMethod: (self compileMethod: method)) rangeForPC: 42.
	highlight := method sourceCode copyFrom:  range first to: range last.
	self assert: highlight equals: 'b'.

	range := (DebuggerMethodMapOpal forMethod: (self compileMethod: method)) rangeForPC: 43.
	highlight := method sourceCode copyFrom:  range first to: range last.
	self assert: highlight equals: 'a := b'.
	
	range := (DebuggerMethodMapOpal forMethod: (self compileMethod: method)) rangeForPC: 44.
	highlight := method sourceCode copyFrom:  range first to: range last.
	self assert: highlight equals:'DebuggerMethodMapOpal'.
	
	range := (DebuggerMethodMapOpal forMethod: (self compileMethod: method)) rangeForPC: 45.
	highlight := method sourceCode copyFrom:  range first to: range last.
	self assert: highlight equals:'thisContext'.
	
	range := (DebuggerMethodMapOpal forMethod: (self compileMethod: method)) rangeForPC: 46.
	highlight := method sourceCode copyFrom:  range first to: range last.
	self assert: highlight equals: 'method'.! !

!MethodMapTests methodsFor: 'testing - ast mapping' stamp: 'MarcusDenker 4/19/2013 13:00'!
testThisContextSourceNode
	self assert: (thisContext sourceNode isKindOf: RBMethodNode).
	self assert: ([thisContext sourceNode] value isKindOf: RBBlockNode).
	self assert: ([true ifTrue: [thisContext sourceNode]]value isKindOf: RBBlockNode).


! !

!MethodMapTests methodsFor: 'testing - ast mapping' stamp: 'CamilleTeruel 1/28/2014 14:13'!
testBlockSourceNode
	| sourceNode |
	sourceNode := [ 1 + 2 ] sourceNode.
	self assert: sourceNode equals: (RBParser parseExpression: '[ 1 + 2 ]').

! !

!MethodMapTests methodsFor: 'testing - ast mapping' stamp: 'CamilleTeruel 1/28/2014 14:12'!
testBlockWithEnclosedBlockSourceNode
	| sourceNode |
	sourceNode := [ [ ] ] sourceNode.
	self assert: sourceNode equals: (RBParser parseExpression: '[ [ ] ]').
! !

!MethodMapTests methodsFor: 'testing - ast mapping' stamp: 'CamilleTeruel 2/7/2014 17:47'!
inlinedBlockSourceNode
	1 to: 1 do: [ :i | ^ thisContext sourceNode ]. 

! !

!MethodMapTests methodsFor: 'testing - temp access' stamp: 'NicolaiHess 10/26/2014 01:04'!
testCopiedVarFromDeadContext
	self assert:  (self compileAndRunExample:  #exampleCopiedVarFromDeadContext) equals: 2.! !

!MethodMapTests methodsFor: 'util' stamp: 'MarcusDenker 12/20/2012 15:13'!
compileMethod: aMethod

	^aMethod parseTree generate: aMethod trailer.
	! !

!MethodMapTests methodsFor: 'testing - ast mapping' stamp: 'MarcusDenker 4/29/2013 15:04'!
testBlockAndContextSourceNode
		
	|block blockNodeViaContext blockNodeViaClosure |


	block := [blockNodeViaContext := thisContext sourceNode].
	block value.
	blockNodeViaClosure := block sourceNode.

	self assert: blockNodeViaContext == blockNodeViaClosure
	

! !

!MethodMapTests methodsFor: 'testing - ast mapping' stamp: 'CamilleTeruel 1/28/2014 14:37'!
testDeadContextSourceNode
	| deadContext |
	deadContext := self deadContext.
	self assert: deadContext isDead. 
	self assert: deadContext sourceNode equals: (self class>>#deadContext) ast
! !

!MethodMapTests methodsFor: 'testing - source mapping' stamp: 'md 1/17/2013 16:47'!
testSimpleSourceMapping
	| method range highlight |

	method := Object>>('ha', 'lt') asSymbol.

	range := (DebuggerMethodMapOpal forMethod: (self compileMethod: method)) rangeForPC: 23.
	highlight := method sourceCode copyFrom:  range first to: range last.
	self assert: highlight equals: 'now'.


	! !

!MethodMapTests methodsFor: 'testing - ast mapping' stamp: 'CamilleTeruel 1/28/2014 14:14'!
testBlockWithTempsSourceNode
	| sourceNode |
	sourceNode := [ | t1 t2 | ] sourceNode.
	self assert: sourceNode equals: (RBParser parseExpression: '[ | t1 t2 | ]').
! !

!MethodMapTests methodsFor: 'testing - ast mapping' stamp: 'CamilleTeruel 1/28/2014 14:37'!
deadContext
	^ thisContext! !

!MethodMapTests methodsFor: 'testing - temp access' stamp: 'MarcusDenker 12/19/2012 17:32'!
testExampleSimpleTemp
	self assert: (self compileAndRunExample: #exampleSimpleTemp) equals: 1! !

!MethodMapTests methodsFor: 'testing - ast mapping' stamp: 'MarcusDenker 4/29/2013 15:03'!
testMethodSourceNodeAtPC
	self assert: (((Object>>#halt) sourceNodeForPC:  22) isKindOf: RBMessageNode).
! !

!MethodMapTests methodsFor: 'testing - temp access' stamp: 'NicolaiHess 10/26/2014 01:04'!
testExampleTempNamedTempVectorInlinedLoop
	self assert:  (self compileAndRunExample:  #exampleTempNamedTempVectorInlinedLoop ) equals: 42.! !

!MethodMapTests methodsFor: 'testing - ast mapping' stamp: 'CamilleTeruel 2/7/2014 17:48'!
testThisContextSourceNodeInInlinedMessage
	| inlinedBlockSourceNode |
	inlinedBlockSourceNode := self inlinedBlockSourceNode.
	self assert: (inlinedBlockSourceNode isKindOf: RBBlockNode).
	self assert: inlinedBlockSourceNode equals: (RBParser parseExpression: '[ :i | ^ thisContext sourceNode ]')! !

!MethodMapTests methodsFor: 'testing - temp access' stamp: 'MarcusDenker 12/19/2012 18:02'!
testExampleTempNamedCopying
	self assert: (self compileAndRunExample: #exampleTempNamedCopying) equals: 1! !

!MethodMapTests methodsFor: 'testing - temp access' stamp: 'MarcusDenker 12/19/2012 18:02'!
testExampleTempNamedCopying2
	self assert: (self compileAndRunExample: #exampleTempNamedCopying2) equals: 1! !

!MethodMapTests methodsFor: 'testing - ast mapping' stamp: 'CamilleTeruel 2/7/2014 17:54'!
testBlockWithArgAndEnclosedBlockSourceNode
	| sourceNode |
	sourceNode := [ :arg |  [ arg ] ] sourceNode.
	self assert: sourceNode equals: (RBParser parseExpression: '[ :arg | [ arg ] ]').
! !

!MethodMapTests methodsFor: 'testing - temp access' stamp: 'MarcusDenker 12/19/2012 18:02'!
testExampleTempNamedPutTempVector2
	self assert: (self compileAndRunExample: #exampleTempNamedPutTempVector2) equals: 3! !

!MethodMapTests methodsFor: 'testing - temp access' stamp: 'MarcusDenker 12/19/2012 18:04'!
testTempNamedTempCopyingNestedBlock
	self assert: (self compileAndRunExample:  #exampleTempNamedTempCopyingNestedBlock) equals: 1.! !

!MethodMapTests methodsFor: 'testing - temp access' stamp: 'MarcusDenker 12/19/2012 17:39'!
testTempNamedTempCopyingNestedBlockPROBLEM
	self assert:  (self compileAndRunExample:  #exampleTempNamedTempCopyingNestedBlockPROBLEM) equals: 1.! !

!MethodModification commentStamp: '<historical>'!
I collect and provide the information to update methods when a class changed.!
!MethodModification methodsFor: 'initialization' stamp: 'ToonVerwaest 3/28/2011 19:47'!
initialize
	addedSlots := Dictionary new! !

!MethodModification methodsFor: 'accessing' stamp: 'ToonVerwaest 3/28/2011 20:06'!
addedSlotNamed: name ifAbsent: aBlock
	^ addedSlots at: name ifAbsent: aBlock! !

!MethodModification methodsFor: 'installing' stamp: 'ToonVerwaest 3/28/2011 17:15'!
installRemovedSlot: removedSlot
	modificationMap at: removedSlot oldFieldIndex put: removedSlot! !

!MethodModification methodsFor: 'installing' stamp: 'ToonVerwaest 3/28/2011 17:15'!
installModifiedSlot: modifiedSlot
	modificationMap at: modifiedSlot oldFieldIndex put: modifiedSlot! !

!MethodModification methodsFor: 'installing' stamp: 'ToonVerwaest 3/28/2011 19:48'!
installAddedSlot: addedSlot
	addedSlots at: addedSlot name put: addedSlot! !

!MethodModified commentStamp: 'BenjaminVanRyseghem 4/1/2011 16:04'!
This announcement is emited when we RE-compile a method in a class or a trait, with: ClassDescription >> compile: or TraitDescription >> compile:. If the method is not yet registered in the class or the trait, the announcement will not be emitted.

The action of renaming a method will be handled by SystemMethodRemovedAnnouncement and SystemMethodAddedAnnouncement, since this refactoring is concretely composed by removing the old method and add a new with the new name  !
!MethodModified methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 09:47'!
oldProtocol: anObject
	
	oldProtocol := anObject! !

!MethodModified methodsFor: 'accessing' stamp: 'CamilleTeruel 9/4/2014 15:44'!
newMethod

	^ method! !

!MethodModified methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 09:52'!
oldMethod
	^ oldMethod! !

!MethodModified methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 09:47'!
oldProtocol
	
	^ oldProtocol! !

!MethodModified methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 09:55'!
oldMethod: aCompiledMethod
	oldMethod := aCompiledMethod.! !

!MethodModified methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 8/21/2014 19:43'!
gtMethodDiffIn: aComposite
	<gtInspectorPresentationOrder: 40>
	aComposite diff
		title: 'Diff';
		display: [ 
			Array 
				with: self newMethod sourceCode
				with: self oldMethod sourceCode ]
! !

!MethodModified methodsFor: 'accessing' stamp: 'CamilleTeruel 9/4/2014 15:58'!
newProtocol
	
	^ self protocol! !

!MethodModified class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/26/2015 18:32'!
gtExampleMethodModified
	" this is a fake annoucement, we just pick 2 arbitrary methods "
	<gtExample: 'Diff old and new method'>
	^ MethodModified new 
		oldMethod: (MethodModified >> #gtMethodDiffIn:);
		method: (MethodModified class >> #gtExampleMethodModified);
		yourself! !

!MethodModified class methodsFor: 'instance creation' stamp: 'CamilleTeruel 9/4/2014 16:31'!
methodChangedFrom: oldMethod to: newMethod oldProtocol: oldProtocol 
	^ self new
		method: newMethod;
		oldMethod: oldMethod;
		oldProtocol: oldProtocol;
		yourself! !

!MethodNameEditor commentStamp: '<historical>'!
A MethodNameEditor is an editor to set the name of a method.
This class is imported from OB.

Maybe it should be redone with Spec, but since it works well, I will not put more energy here.!
!MethodNameEditor methodsFor: 'morphic' stamp: ''!
update
	self changed: #argumentList; changed: #argumentIndex.
	self changed: #isUpEnabled; changed: #isDownEnabled; changed: #isOkEnabled.
	labelMorph contents: self methodName printString! !

!MethodNameEditor methodsFor: 'accessing' stamp: ''!
selector
	^ self methodName selector! !

!MethodNameEditor methodsFor: 'grips' stamp: 'BenjaminVanRyseghem 4/25/2012 13:54'!
addEdgeGrips
	"Should add these to the front!!"
	
	| l r lh |
	lh := self labelHeight.
	l  := WindowEdgeGripMorph new target: self; position: self position; edgeName: #left.
	l layoutFrame topOffset: lh negated + 22.
	r  := WindowEdgeGripMorph new target: self; position: self position; edgeName: #right.
	r layoutFrame topOffset: lh negated + 22.
	self
		addMorph: l;
		addMorph: r
! !

!MethodNameEditor methodsFor: 'morphic' stamp: 'BenjaminVanRyseghem 3/26/2012 17:19'!
newContentMorph
	^ (self newRow: {
		self newLabelGroup: {
			'Selector:' -> (selectorField:=(self newTextEntryFor: self getText: #selector setText: #selector: help: nil)
				autoAccept: true;
				on: #keyStroke send: #value:value: to: [:key :morph | key keyCharacter = Character cr ifTrue: [ self ok. true]. false];
				yourself).
			'Arguments:' -> (self newRow: {
				(self newListFor: self list: #argumentList selected: #argumentIndex changeSelected: #argumentIndex: help: nil)
					hResizing: #spaceFill;
					yourself.
				(self newColumn: {
					(self newButtonFor: self action: #up label: 'up'  help: nil)
						getEnabledSelector: #isUpEnabled.
					(self newButtonFor: self action: #down label: 'dn'  help: nil)
						getEnabledSelector: #isDownEnabled })
					hResizing: #shrinkWrap }).
			'Preview:' -> (labelMorph := self newLabel: self methodName printString) } })
 		minWidth: 400;
		yourself! !

!MethodNameEditor methodsFor: 'morphic' stamp: ''!
newOKButton
	^ self newOKButtonFor: self getEnabled: #isOkEnabled! !

!MethodNameEditor methodsFor: 'actions' stamp: ''!
cancel
	methodName := nil.
	^ super cancel! !

!MethodNameEditor methodsFor: 'actions' stamp: ''!
up
	self isUpEnabled ifFalse: [ ^ self ].
	self argumentList swap: self argumentIndex with: self argumentIndex - 1.
	self argumentIndex: self argumentIndex - 1! !

!MethodNameEditor methodsFor: 'testing' stamp: ''!
isDownEnabled
	^ self argumentIndex ~= 0 and: [ self argumentIndex + 1 between: 1 and: self argumentList size ]! !

!MethodNameEditor methodsFor: 'accessing' stamp: ''!
argumentIndex
	^ argumentIndex! !

!MethodNameEditor methodsFor: 'accessing' stamp: ''!
methodName
	^ methodName! !

!MethodNameEditor methodsFor: 'accessing' stamp: ''!
selector: aString
	self methodName selector: aString.
	self update! !

!MethodNameEditor methodsFor: 'actions' stamp: ''!
down
	self isDownEnabled ifFalse: [ ^ self ].
	self argumentList swap: self argumentIndex with: self argumentIndex + 1.
	self argumentIndex: self argumentIndex + 1! !

!MethodNameEditor methodsFor: 'testing' stamp: ''!
isUpEnabled
	^ self argumentIndex ~= 0 and: [ self argumentIndex - 1 between: 1 and: self argumentList size ]! !

!MethodNameEditor methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 23:05'!
initialize

	super initialize.

	self beResizeable! !

!MethodNameEditor methodsFor: 'accessing' stamp: ''!
argumentList
	^ self methodName arguments! !

!MethodNameEditor methodsFor: 'focus handling' stamp: 'BenjaminVanRyseghem 3/26/2012 17:10'!
defaultFocusMorph
	"Answer the morph that should have the keyboard
	focus by default when the dialog is opened."
	
	^ selectorField
		ifNil: [ super defaultFocusMorph ]! !

!MethodNameEditor methodsFor: 'initialization' stamp: ''!
initializeOn: aMethodName
	methodName := aMethodName.
	argumentIndex := 0.
	self initialize.
	self title: 'Method Name'! !

!MethodNameEditor methodsFor: 'grips' stamp: 'BenjaminVanRyseghem 4/25/2012 13:53'!
addGrips

	self addEdgeGrips! !

!MethodNameEditor methodsFor: 'testing' stamp: ''!
isOkEnabled
	^ self methodName isValid! !

!MethodNameEditor methodsFor: 'accessing' stamp: ''!
argumentIndex: anInteger
	argumentIndex := anInteger.
	self update! !

!MethodNameEditor class methodsFor: 'instance creation' stamp: ''!
openOn: aMethodName
	^ UITheme builder openModal: (self on: aMethodName)! !

!MethodNameEditor class methodsFor: 'instance creation' stamp: ''!
on: aMethodName
	^ self basicNew initializeOn: aMethodName! !

!MethodNode commentStamp: '<historical>'!
I am the root of the parse tree.!
!MethodNode methodsFor: 'printing' stamp: 'MarcusDenker 12/20/2012 13:27'!
printPrimitiveOn: aStream
	"Print the primitive on aStream"

	| primDecl |
	primitive = 0
		ifTrue: [ ^ self ].
	primitive = 120
		ifTrue: [ 
			"External call spec"
			^ aStream print: encoder literals first ].
	aStream nextPutAll: '<primitive: '.
	primitive = 117
		ifTrue: [ 
			primDecl := encoder literals at: 1.
			(primDecl at: 2) asString printOn: aStream.
			(primDecl at: 1)
				ifNotNil: [ :moduleName | 
					aStream nextPutAll: ' module: '.
					moduleName asString printOn: aStream ] ]
		ifFalse: [ aStream print: primitive ].
	self primitiveErrorVariableName
		ifNotNil: [ :primitiveErrorVariableName | 
			aStream
				nextPutAll: ' error: ';
				nextPutAll: primitiveErrorVariableName ].
	aStream nextPut: $>.! !

!MethodNode methodsFor: 'code generation' stamp: 'yo 8/30/2002 14:07'!
selector 
	"Answer the message selector for the method represented by the receiver."

	(selectorOrFalse isSymbol)
		ifTrue: [^selectorOrFalse].
	^selectorOrFalse key.
! !

!MethodNode methodsFor: 'code generation' stamp: 'MarcusDenke 4/29/2012 19:15'!
generateWithSource
	"Answer a CompiledMethod with source encoded in trailer."
	
	| source |
	
	"for doits, we need to store the source pretty printed from the 
	AST to get the return and methodName correct"
	self selector isDoIt ifTrue: [sourceText := self printString].
	
	^self generate: (CompiledMethodTrailer new sourceCode: sourceText).! !

!MethodNode methodsFor: 'source mapping' stamp: 'MarcusDenker 5/10/2013 12:50'!
rawSourceRangesAndMethodDo: aBinaryBlock
	"Evaluate aBinaryBlock with the rawSourceRanges and method generated from the receiver."

	| methNode method |
	methNode := Parser new
					encoderClass: encoder class;
					parse: self sourceCode
					class: self methodClass.
	method := methNode generate.  "set bytecodes to map to"
	^aBinaryBlock
		value: methNode encoder rawSourceRanges
		value: method! !

!MethodNode methodsFor: 'code generation' stamp: 'eem 9/25/2008 15:20'!
selectorNode
	"Answer a SelectorNode for the message selector of the method represented by the receiver."

	^(selectorOrFalse isMemberOf: SelectorNode)
		ifTrue: [selectorOrFalse]
		ifFalse: [SelectorNode new key: selectorOrFalse]! !

!MethodNode methodsFor: 'debugger support' stamp: 'eem 7/1/2009 13:45'!
hasGeneratedMethod
	^encoder hasGeneratedMethod! !

!MethodNode methodsFor: 'printing' stamp: 'ajh 1/24/2003 17:41'!
sourceText

	^ sourceText ifNil: [self printString]! !

!MethodNode methodsFor: 'printing' stamp: 'ajh 1/22/2003 17:39'!
methodClass

	^ encoder classEncoding! !

!MethodNode methodsFor: 'accessing' stamp: 'eem 6/11/2009 17:27'!
removeProperty: aSymbol
	properties := properties copyWithout: (Association
											key: aSymbol
											value: (properties propertyValueAt: aSymbol))! !

!MethodNode methodsFor: 'primitive error codes' stamp: 'eem 12/1/2008 14:56'!
removeAndRenameLastTempIfErrorCode
	self primitiveErrorVariableName ifNotNil:
		[:primitiveErrorVariableName|
		 temporaries last
			name: primitiveErrorVariableName
			key: primitiveErrorVariableName
			code: temporaries last code.
		 temporaries removeLast].! !

!MethodNode methodsFor: 'code generation (closures)' stamp: 'eem 7/24/2008 10:04'!
ensureClosureAnalysisDone
	block blockExtent ifNil:
		[temporaries := block analyseArguments: arguments temporaries: temporaries rootNode: self]! !

!MethodNode methodsFor: 'code generation (closures)' stamp: 'eem 5/29/2008 16:07'!
referencedValuesWithinBlockExtent: anInterval 
	^(localsPool select:
		[:temp|
		 temp isReferencedWithinBlockExtent: anInterval]) collect:
			[:temp|
			temp isRemote ifTrue: [temp remoteNode] ifFalse: [temp]]! !

!MethodNode methodsFor: 'converting' stamp: 'eem 8/31/2010 12:36'!
preenLocalIfNotNilArg
	"Try and spot a (var := expr) ifNil: [...] ifNotNil: [...] where var is only used in the ifNotNil: block
	 and convert it to expr ifNil: [...] ifNotNil: [:var| ...].  Deal both with the pretty-print case where
	 the block already declares the variable and the decompile case where it does not."

	| varsToHide |
	varsToHide := Set new.
	self nodesDo:
		[:node| | variable |
		(node isMessageNode
		and: [node macroPrinter == #printIfNilNotNil:indent:
		and: [node receiver isMessageNode
		and: [node receiver selector key == #==
		and: [node receiver receiver isAssignmentNode
		and: [(variable := node receiver receiver variable) isTemp
		and: [variable isRemote not
		and: [variable isOnlySubnodeOf: node in: self]]]]]]]) ifTrue:
			[node arguments last arguments isEmpty
				ifTrue: [node arguments last arguments: { variable }.
						varsToHide add: variable]
				ifFalse: [self assert: node arguments last arguments asArray =  { variable }].
			 node receiver receiver: node receiver receiver value]].
	varsToHide notEmpty ifTrue:
		[self nodesDo:
			[:node|
			((node == self or: [node isBlockNode])
			and: [node temporaries anySatisfy: [:temp| varsToHide includes: temp]]) ifTrue:
				[node temporaries: (node temporaries reject: [:temp| varsToHide includes: temp])]]]! !

!MethodNode methodsFor: 'visiting' stamp: 'eem 9/6/2009 12:35'!
accept: aVisitor
	^aVisitor visitMethodNode: self! !

!MethodNode methodsFor: 'printing' stamp: 'eem 12/1/2008 14:36'!
printOn: aStream
	| selectorNode |
	selectorNode := self selectorNode.
	precedence = 1
		ifTrue:
			[selectorNode isForFFICall
				ifTrue: [selectorNode
							printAsFFICallWithArguments: arguments
							on: aStream
							indent: 0]
				ifFalse: [aStream nextPutAll: selectorNode key]]
		ifFalse:
			[selectorNode key keywords with: arguments do:
				[:kwd :arg |
				aStream nextPutAll: kwd; space; nextPutAll: arg key; space]].
	comment == nil ifFalse:
		[aStream crtab: 1.
		 self printCommentOn: aStream indent: 1].
	block printTemporaries: temporaries on: aStream doPrior: [aStream crtab: 1].
	primitive > 0 ifTrue:
		[(primitive between: 255 and: 519) ifFalse:  "Dont decompile quick prims  e.g, ^ self or ^instVar"
			[aStream crtab: 1.
			 self printPrimitiveOn: aStream]].
	self printPropertiesOn: aStream.
	self printPragmasOn: aStream.
	aStream crtab: 1.
	block printStatementsOn: aStream indent: 0! !

!MethodNode methodsFor: 'code generation (closures)' stamp: 'ClementBera 7/26/2013 17:18'!
addLocalsToPool: locals "<Set of: TempVariableNode>"
	localsPool ifNil:
		[localsPool := IdentitySet new].
	localsPool addAll: locals! !

!MethodNode methodsFor: 'initialize-release' stamp: ''!
selector: selOrFalse arguments: args precedence: p temporaries: temps block: blk encoder: anEncoder primitive: prim 
	"Initialize the receiver with respect to the arguments given."

	encoder := anEncoder.
	selectorOrFalse := selOrFalse.
	precedence := p.
	arguments := args.
	temporaries := temps.
	block := blk.
	primitive := prim! !

!MethodNode methodsFor: 'accessing' stamp: 'eem 7/21/2009 15:59'!
temporaries: aSequence
	"For transformations etc, not used in compilation"
	temporaries := aSequence! !

!MethodNode methodsFor: 'printing' stamp: 'MarcusDenker 4/29/2012 09:35'!
sourceCode

	^ self sourceText.! !

!MethodNode methodsFor: 'accessing' stamp: 'eem 1/19/2009 10:28'!
primitiveErrorVariableName
	"Answer the primitive error code temp name, or nil if none."
	(primitive isInteger and: [primitive > 0]) ifTrue:
		[properties pragmas do:
			[:pragma| | kwds ecIndex |
			((kwds := pragma keyword keywords) first = 'primitive:'
			and: [(ecIndex := kwds indexOf: 'error:') > 0]) ifTrue:
				[^pragma argumentAt: ecIndex]]].
	^nil

	"(Parser new parse: (MethodNode sourceCodeAt: #primitiveErrorVariableName) class: Parser) primitiveErrorVariableName"

	"(Parser new parse: 'foo <primitive: 111 error: ''foo''> self primitiveFailed' class: Object) primitiveErrorVariableName"

	"(Parser new parse: 'foo <primitive: 111 error: foo> self primitiveFailed' class: Object) primitiveErrorVariableName"

	"(Parser new parse: 'foo <primitive: 111> self primitiveFailed' class: Object) primitiveErrorVariableName"

	"(Parser new parse: 'foo <primitive: ''foo'' error: foo module: ''bar''> self primitiveFailed' class: Object) primitiveErrorVariableName"

	"(Parser new parse: 'foo <primitive: ''foo'' module: ''bar'' error: foo> self primitiveFailed' class: Object) primitiveErrorVariableName"

	"(Parser new parse: 'foo <primitive: 111 error: foo> self primitiveFailed' class: Object) generate"! !

!MethodNode methodsFor: 'converting' stamp: 'MarcusDenker 5/10/2013 12:55'!
decompileString 
	"Answer a string description of the parse tree whose root is the receiver."

	^self formattedCode
! !

!MethodNode methodsFor: 'code generation' stamp: 'MarcusDenker 11/13/2012 18:52'!
generate
	"The receiver is the root of a parse tree. Answer a CompiledMethod."

	^self generate: CompiledMethodTrailer empty! !

!MethodNode methodsFor: 'printing' stamp: 'eem 12/1/2008 14:25'!
printPropertiesOn: aStream
	properties ifNil: [^self].
	properties propertyKeysAndValuesDo:
		[:prop :val|
		aStream crtab; nextPut: $<.
		prop = #on:in:
			ifTrue:
				[prop keywords with: val do:
					[:k :v | aStream nextPutAll: k; space; nextPutAll: v; space]]
			ifFalse:
				[prop = #on
					ifTrue: [aStream nextPutAll: prop; nextPutAll:': '; nextPutAll: val] 
					ifFalse: [aStream nextPutAll: prop; nextPutAll:': '; print: val]]. 
		aStream nextPut: $>]! !

!MethodNode methodsFor: 'code generation' stamp: 'lr 2/6/2006 23:24'!
properties
	^ properties! !

!MethodNode methodsFor: 'code generation' stamp: 'MarcusDenker 11/13/2012 18:51'!
generate: trailer ifQuick: methodBlock
	| v |
	(primitive = 0 and: [arguments size = 0 and: [block isQuick]]) ifFalse:
		[^self].
	v := block code.
	v < 0 ifTrue:
		[^self].
	v = LdSelf ifTrue:
		[^methodBlock value: (CompiledMethod toReturnSelfTrailerBytes: trailer)].
	(v between: LdTrue and: LdMinus1 + 3) ifTrue:
		[^methodBlock value: (CompiledMethod toReturnConstant: v - LdSelf trailerBytes: trailer)].
	v < ((CodeBases at: LdInstType) + (CodeLimits at: LdInstType)) ifTrue:
		[^methodBlock value: (CompiledMethod toReturnField: v trailerBytes: trailer)].
	v // 256 = 1 ifTrue:
		[^methodBlock value: (CompiledMethod toReturnField: v \\ 256 trailerBytes: trailer)]! !

!MethodNode methodsFor: 'initialize-release' stamp: 'tk 8/3/1999 12:47'!
block
	^ block! !

!MethodNode methodsFor: 'initialize-release' stamp: 'ajh 1/22/2003 17:53'!
sourceText: stringOrText

	sourceText := stringOrText! !

!MethodNode methodsFor: 'code generation (closures)' stamp: 'eem 5/20/2008 13:43'!
locationCounter
	^locationCounter! !

!MethodNode methodsFor: 'initialize-release' stamp: 'ajh 1/24/2003 17:37'!
selector: symbol

	selectorOrFalse := symbol! !

!MethodNode methodsFor: 'accessing' stamp: 'eem 7/21/2009 16:00'!
arguments: aSequence
	"For transformations etc, not used in compilation"
	arguments := aSequence! !

!MethodNode methodsFor: 'printing' stamp: 'eem 12/1/2008 14:35'!
printPragmasOn: aStream
	properties ifNil: [^self].
	properties pragmas do:
		[:pragma|
		"Primitives are printed in printPrimitiveOn:; skip these"
		(Parser primitivePragmaSelectors includes: pragma keyword) ifFalse:
			[aStream crtab: 1.
			 pragma printOn: aStream]]! !

!MethodNode methodsFor: 'code generation' stamp: 'MarcusDenker 11/13/2012 18:51'!
generate: trailer 
	"The receiver is the root of a parse tree. Answer an instance of aCompiledMethodClass.
	 The argument, trailer, is arbitrary but is typically either the reference to the source code
	 that is stored with every CompiledMethod, or an encoding of the method's temporary names."

	| primErrNode blkSize nLits literals stack method |
	self generate: trailer
		ifQuick:
			[:m |
			  m	literalAt: 2 put: encoder associationForClass;
				properties: properties.
			^m].
	primErrNode := self primitiveErrorVariableName ifNotNil:
						[encoder fixTemp: self primitiveErrorVariableName].
	encoder supportsClosureOpcodes ifTrue:
		[self ensureClosureAnalysisDone.
		 encoder rootNode: self. "this is for BlockNode>>sizeCodeForClosureValue:"].
	blkSize := (block sizeCodeForEvaluatedValue: encoder)
				+ (primErrNode
					ifNil: [0]
					ifNotNil:
						[primErrNode
							index: arguments size + temporaries size;
							sizeCodeForStore: encoder "The VM relies on storeIntoTemp: (129)"]).
	method := CompiledMethod
				newBytes: blkSize
				trailerBytes: trailer 
				nArgs: arguments size
				nTemps: (encoder supportsClosureOpcodes
							ifTrue: [| locals |
									locals := arguments,
											  temporaries,
											  (primErrNode
												ifNil: [#()]
												ifNotNil: [{primErrNode}]).
									encoder
										noteBlockExtent: block blockExtent
										hasLocals: locals.
									locals size]
							ifFalse: [encoder maxTemp])
				nStack: 0
				nLits: (nLits := (literals := encoder allLiterals) size)
				primitive: primitive.
	nLits > 255 ifTrue:
		[^self error: 'Too many literals referenced'].
	1 to: nLits do: [:lit | method literalAt: lit put: (literals at: lit)].
	encoder streamToMethod: method.
	stack := ParseStack new init.
	primErrNode ifNotNil: [primErrNode emitCodeForStore: stack encoder: encoder].
	stack position: method numTemps.
	block emitCodeForEvaluatedValue: stack encoder: encoder.
	stack position ~= (method numTemps + 1) ifTrue:
		[^self error: 'Compiler stack discrepancy'].
	encoder methodStreamPosition ~= (method size - trailer size) ifTrue:
		[^self error: 'Compiler code size discrepancy'].
	method needsFrameSize: stack size - method numTemps.
	method properties: properties.
	^method! !

!MethodNode methodsFor: 'initialize-release' stamp: 'ar 1/4/2002 00:23'!
selector: selOrFalse arguments: args precedence: p temporaries: temps block: blk encoder: anEncoder primitive: prim properties: propDict
	"Initialize the receiver with respect to the arguments given."

	encoder := anEncoder.
	selectorOrFalse := selOrFalse.
	precedence := p.
	arguments := args.
	temporaries := temps.
	block := blk.
	primitive := prim.
	properties := propDict.! !

!MethodNode methodsFor: 'converting' stamp: 'eem 8/31/2010 11:54'!
preen
	"Preen for pretty-printing and/or decompilation.
	 i.e. post-process to cover up for inadequacies in both algorithms.
	 Currently one case, hiding the assignment to the arg of an inlined block arg to ifNotNil:,
		(var := expr) ifNil: [...] ifNotNil: [...]    =>    expr ifNil: [...] ifNotNil: [:var| ...]."

	self preenLocalIfNotNilArg! !

!MethodNode methodsFor: 'source mapping' stamp: 'eem 6/4/2008 19:21'!
rawSourceRanges

	^self rawSourceRangesAndMethodDo: [:rawSourceRanges :method| rawSourceRanges]! !

!MethodNode methodsFor: 'accessing' stamp: 'md 7/27/2006 19:12'!
body
	^block! !

!MethodNode methodsFor: 'code generation (closures)' stamp: 'ClementBera 7/26/2013 17:18'!
noteBlockEntry: aBlock
	"Evaluate aBlock with the numbering for the block entry."
	locationCounter ifNil:
		[locationCounter := -1].
	aBlock value: locationCounter + 1.
	locationCounter := locationCounter + 2! !

!MethodNode methodsFor: 'printing' stamp: 'MarcusDenker 5/10/2013 12:57'!
formattedCode
	^ self fullPrintString ! !

!MethodNode methodsFor: 'code generation (closures)' stamp: 'eem 6/2/2008 12:12'!
noteBlockExit: aBlock
	"Evaluate aBlock with the numbering for the block exit."
	aBlock value: locationCounter + 1.
	locationCounter := locationCounter + 2! !

!MethodNode methodsFor: 'accessing' stamp: 'eem 7/21/2009 16:00'!
arguments
	"For transformations etc, not used in compilation"
	^arguments! !

!MethodNode methodsFor: 'initialize-release' stamp: 'MarcusDenker 8/28/2013 10:44'!
source: stringOrText

	sourceText := stringOrText! !

!MethodNode methodsFor: 'accessing' stamp: 'eem 7/21/2009 15:59'!
temporaries
	"For transformations etc, not used in compilation"
	^temporaries! !

!MethodNode methodsFor: 'printing' stamp: ''!
tempNames
	^ encoder tempNames! !

!MethodNode methodsFor: 'code generation' stamp: ''!
encoder
	^ encoder! !

!MethodNode methodsFor: 'debugger support' stamp: 'MarcusDenker 5/10/2013 12:49'!
blockExtentsToTempsMap
	"Answer a Dictionary of blockExtent to temp locations for the current method.
	 This is used by the debugger to locate temp vars in contexts.  A temp map
	 entry is a pair of the temp's name and its index, where an index is either an
	 integer for a normal temp or a pair of the index of the indirect temp vector
	 containing  the temp and the index of the temp in its indirect temp vector."

	^encoder blockExtentsToTempsMap ifNil:
		[| methNode |
		methNode := Parser new
						encoderClass: encoder class;
						parse: self sourceCode
						class: self methodClass.
		"As a side effect generate: creates data needed for the map."
		methNode generate.
		methNode encoder blockExtentsToTempsMap]! !

!MethodOveridesAction commentStamp: '<historical>'!
Action when the method overrides another one, or the method is overidden by another one or both!
!MethodOveridesAction methodsFor: 'order' stamp: 'BenjaminVanRyseghem 1/2/2013 13:07'!
isActionHandled

	isOverridden := method isOverridden.
	isOverride := method isOverride.
	^ isOverridden or: [ isOverride ]! !

!MethodOveridesAction methodsFor: 'order' stamp: 'MarcusDenker 9/27/2013 18:07'!
privateActionIcon
	"Return the icon for this action"

	isOverride
		ifTrue: [ 
			isOverridden
				ifTrue: [
					result := self buildUpAndDownArrowIcon: method.
					^ result key ]
				ifFalse: [ 
					^ IconicButton new
						target: self browser;
						actionSelector: #arrowUp:;
						arguments: {method};
						labelGraphic: (Smalltalk ui icons iconNamed: #arrowUpIcon);
						color: Color transparent;
						helpText: 'Browse overriden message';
						extent: 12 @ 12;
						borderWidth: 0 ] ]
		ifFalse: [ 
			isOverridden
				ifTrue: [ 
					^ IconicButton new
						target: self browser;
						actionSelector: #arrowDown:;
						arguments: {method};
						labelGraphic: (Smalltalk ui icons iconNamed: #arrowDownIcon);
						color: Color transparent;
						helpText: 'Browse overriding messages';
						extent: 12 @ 12;
						borderWidth: 0 ] ]! !

!MethodOveridesAction methodsFor: 'private' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
buildUpAndDownArrowIcon: aMethod

	| container up down |
	
	container := Morph new.
	container 
		extent: 12@12;
		color: Color transparent.
		
	up := IconicButton new 
				target: self browser;
				actionSelector: #arrowUp:;
				arguments: { aMethod };
				labelGraphic: (Smalltalk ui icons iconNamed: #arrowDoubleUpIcon);
				color: Color transparent;
				extent: 12 @ 6;
				helpText: 'Browse overriden message';
				borderWidth: 0.
				
	down :=  IconicButton new 
				target: self browser;
				actionSelector: #arrowDown:;
				arguments: { aMethod };
				labelGraphic: (Smalltalk ui icons iconNamed: #arrowDoubleDownIcon);
				color: Color transparent;
				extent: 12 @ 6;
				helpText: 'Browse overriding messages';
				borderWidth: 0.
				
	^ (container
		changeTableLayout;
		listDirection: #topToBottom;
		addMorph: down;
		addMorph: up;
		yourself) -> {up. down}.! !

!MethodOveridesAction methodsFor: 'order' stamp: 'BenjaminVanRyseghem 2/20/2013 19:57'!
actionOrder
	"Return the priority of this action"
	
	^ 600! !

!MethodOveridesAction methodsFor: 'order' stamp: 'BenjaminVanRyseghem 1/2/2013 12:58'!
actionStateToCache
	"Return the state of the icon for caching purpose"
	^ result 
		ifNil: [ super actionStateToCache ]
		ifNotNil: [ {(IconicButtonStateHolder forNautilus: result value first). (IconicButtonStateHolder forNautilus: result value second)} ]! !

!MethodPragmaTest commentStamp: 'TorstenBergmann 2/5/2014 08:41'!
SUnit tests for method pragmas!
!MethodPragmaTest methodsFor: 'testing-compiler' stamp: 'lr 8/19/2006 20:44'!
testCompileBinary
	self assertPragma: ' = 1' givesKeyword: #= arguments: #( 1 ).
	self assertPragma: ' , 3' givesKeyword: #, arguments: #( 3 ).
	self assertPragma: ' > 4' givesKeyword: #> arguments: #( 4 ).
	self assertPragma: ' < 5' givesKeyword: #< arguments: #( 5 ).

	self assertPragma: ' == 1' givesKeyword: #== arguments: #( 1 ).
	self assertPragma: ' <> 3' givesKeyword: #<> arguments: #( 3 ).
	self assertPragma: ' >< 4' givesKeyword: #>< arguments: #( 4 ).
	self assertPragma: ' ** 5' givesKeyword: #** arguments: #( 5 )! !

!MethodPragmaTest methodsFor: 'testing-primitives' stamp: 'lr 1/20/2006 02:31'!
testPrimitiveIndexed1
	"This test useses the #instVarAt: primitive."
	
	self compile: '<primitive: 74> ^ #inst' selector: #inst.
	self assert: self inst = #inst.! !

!MethodPragmaTest methodsFor: 'testing-pragma' stamp: 'lr 1/20/2006 00:35'!
testArguments
	| pragma |
	pragma := Pragma keyword: #foo: arguments: #( 123 ).
	self assert: pragma arguments = #( 123 ).! !

!MethodPragmaTest methodsFor: 'testing-compiler' stamp: 'lr 1/20/2006 02:25'!
testCompileArray
	self assertPragma: 'foo: #()' givesKeyword: #foo: arguments: #( () ).
	self assertPragma: 'foo: #( foo )' givesKeyword: #foo: arguments: #( ( foo ) ).
	self assertPragma: 'foo: #( foo: )' givesKeyword: #foo: arguments: #( ( foo: ) ).
	self assertPragma: 'foo: #( 12 )' givesKeyword: #foo: arguments: #( ( 12 ) ).
	self assertPragma: 'foo: #( true )' givesKeyword: #foo: arguments: #( ( true ) ).
	! !

!MethodPragmaTest methodsFor: 'testing-compiler' stamp: 'lr 1/20/2006 02:25'!
testCompileEmpty
	self assertPragma: 'foo' givesKeyword: #foo arguments: #().! !

!MethodPragmaTest methodsFor: 'testing-compiler' stamp: 'lr 1/20/2006 02:25'!
testCompileNumber
	self assertPragma: 'foo: 123' givesKeyword: #foo: arguments: #( 123 ).
	self assertPragma: 'foo: -123' givesKeyword: #foo: arguments: #( -123 ).
	self assertPragma: 'foo: 12.3' givesKeyword: #foo: arguments: #( 12.3 ).
	self assertPragma: 'foo: -12.3' givesKeyword: #foo: arguments: #( -12.3 ).! !

!MethodPragmaTest methodsFor: 'testing-primitives' stamp: 'CamilloBruni 2/26/2014 16:51'!
testPrimitiveNamed1
	"This test useses the #primitiveDirectoryLookup primitive."

	self compile: '<primitive: ''primitiveDirectoryLookup'' module: ''FilePlugin''> ^ #lookup' selector: #lookup.
	self assert: self lookup equals: #lookup.
	
! !

!MethodPragmaTest methodsFor: 'testing-finding' stamp: 'lr 1/21/2006 13:01'!
testAllNamedInSortedUsing
	| pragmasCompiled pragmasDetected |
	pragmasCompiled := self pragma: #foo: selector: #bar times: 5.
	pragmasDetected := Pragma 
		allNamed: #foo: in: self class 
		sortedUsing: [ :a :b | (a argumentAt: 1) > (b argumentAt: 1) ].
	self assert: pragmasDetected = (pragmasCompiled 
		sort: [ :a :b | (a argumentAt: 1) > (b argumentAt: 1) ]).! !

!MethodPragmaTest methodsFor: 'testing' stamp: 'lr 3/19/2007 11:38'!
testWithArgumentsDo
	| pragma wasHere |
	pragma := Pragma keyword: #add:after: arguments: #( 1 2 ).
	self assert: (pragma withArgumentsDo: [ :a :b |
		self assert: a = 1; assert: b = 2.
		wasHere := true ]).
	self assert: wasHere! !

!MethodPragmaTest methodsFor: 'testing-finding' stamp: 'lr 1/20/2006 08:15'!
testAllNamedInSortedByArgument
	| pragmasCompiled pragmasDetected |
	pragmasCompiled := self pragma: #foo: selector: #bar times: 5.
	pragmasDetected := Pragma allNamed: #foo: in: self class sortedByArgument: 1.
	self assert: pragmasDetected = (pragmasCompiled 
		sort: [ :a :b | (a argumentAt: 1) < (b argumentAt: 1) ])! !

!MethodPragmaTest methodsFor: 'testing-compiler' stamp: 'lr 1/20/2006 02:25'!
testCompileString
	self assertPragma: 'foo: ''''' givesKeyword: #foo: arguments: #( '' ).
	self assertPragma: 'foo: ''bar''' givesKeyword: #foo: arguments: #( 'bar' ).! !

!MethodPragmaTest methodsFor: 'testing-primitives' stamp: 'CamilloBruni 2/26/2014 16:08'!
testPrimitiveNamed2
	"This test useses the #primPathNameDelimiter primitive."

	self compile: '<primitive: ''primitiveDirectoryDelimitor'' module: ''FilePlugin''> ^ #delim' selector: #delim.
	self assert: self delim equals: FilePluginPrims new delimiter.
	
! !

!MethodPragmaTest methodsFor: 'testing-pragma' stamp: 'lr 1/20/2006 00:36'!
testMessage
	| pragma message |
	pragma := Pragma keyword: #foo: arguments: #( 123 ).
	message := pragma message.
	
	self assert: message selector = #foo:.
	self assert: message arguments = #( 123 ).! !

!MethodPragmaTest methodsFor: 'testing-primitives' stamp: 'MartinMcClure 3/18/2010 21:55'!
testPrimitiveIndexed2
	"This test useses the #identityHash primitive."

	self compile: '<primitive: 75> ^ #idHash' selector: #idHash.
	self assert: self idHash = self basicIdentityHash.! !

!MethodPragmaTest methodsFor: 'testing-method' stamp: 'lr 1/20/2006 07:54'!
testSelector
	| pragma |
	pragma := self pragma: 'foo' selector: #bar.
	self assert: pragma selector == #bar.! !

!MethodPragmaTest methodsFor: 'utilities' stamp: 'lr 1/20/2006 08:11'!
pragma: aSymbol selector: aSelector times: anInteger
	^ (self 
		compile: (String streamContents: [ :stream | 
			(1 to: anInteger) asArray shuffled do: [ :each | 
				stream 
					nextPut: $<; nextPutAll: aSymbol; space;
					print: each; nextPut: $>; cr ] ])
		selector: aSelector)
			pragmas.! !

!MethodPragmaTest methodsFor: 'testing-compiler' stamp: 'lr 10/5/2006 09:49'!
testCompileValue
	self assertPragma: 'foo: true' givesKeyword: #foo: arguments: #( true ).
	self assertPragma: 'foo: false' givesKeyword: #foo: arguments: #( false ).
	self assertPragma: 'foo: nil' givesKeyword: #foo: arguments: #( nil )! !

!MethodPragmaTest methodsFor: 'testing' stamp: 'lr 3/19/2007 11:40'!
testArgumentAt
	| pragma |
	pragma := Pragma keyword: #value:value:value: arguments: #( 3 2 1 ).
	self assert: (pragma argumentAt: 1) = 3.
	self assert: (pragma argumentAt: 2) = 2.
	self assert: (pragma argumentAt: 3) = 1! !

!MethodPragmaTest methodsFor: 'testing-finding' stamp: 'lr 1/20/2006 08:19'!
testAllNamedIn
	| pragmasCompiled pragmasDetected |
	pragmasCompiled := self pragma: #foo: selector: #bar times: 5.
	pragmasDetected := Pragma allNamed: #foo: in: self class.
	self assert: pragmasDetected = pragmasCompiled.
	
	pragmasDetected := Pragma allNamed: #foo: in: Object.
	self assert: pragmasDetected isEmpty.! !

!MethodPragmaTest methodsFor: 'utilities' stamp: 'lr 2/6/2006 20:48'!
pragma: aString selector: aSelector
	^ (self compile: '<' , aString , '>' selector: aSelector)
		pragmas first.! !

!MethodPragmaTest methodsFor: 'testing-pragma' stamp: 'lr 1/20/2006 00:35'!
testKeyword
	| pragma |
	pragma := Pragma keyword: #foo: arguments: #( 123 ).
	self assert: pragma keyword = #foo:.! !

!MethodPragmaTest methodsFor: 'testing' stamp: 'lr 3/19/2007 11:38'!
testSendTo
	| pragma wasHere |
	pragma := Pragma keyword: #value:value: arguments: #( 1 2 ).
	self assert: (pragma sendTo: [ :a :b |
		self assert: a = 1; assert: b = 2.
		wasHere := true ]).
	self assert: wasHere! !

!MethodPragmaTest methodsFor: 'testing-primitives' stamp: 'CamilloBruni 2/26/2014 16:52'!
testPrimitiveNamedErrorCode2
	"This test useses the #primitiveDirectoryLookup primitive."

	self compile: '<primitive: ''primitiveDirectoryLookup'' module: ''FilePlugin'' error: errorCode> ^ errorCode' selector: #lookup.
	self assert: self lookup equals: nil.
	
! !

!MethodPragmaTest methodsFor: 'running' stamp: 'lr 1/20/2006 02:15'!
tearDown
	(self class organization listAtCategoryNamed: self methodCategory)
		do: [ :each | self class removeSelectorSilently: each ].
	self class organization removeCategory: self methodCategory.! !

!MethodPragmaTest methodsFor: 'testing-compiler' stamp: 'lr 1/20/2006 07:39'!
testCompileFull
	self assertPragma: 'foo: 1' givesKeyword: #foo: arguments: #( 1 ).
	self assertPragma: 'foo: 1 bar: 2' givesKeyword: #foo:bar: arguments: #( 1 2 ).! !

!MethodPragmaTest methodsFor: 'testing-finding' stamp: 'lr 1/20/2006 08:18'!
testAllNamedFromTo
	| pragmasCompiled pragmasDetected |
	pragmasCompiled := self pragma: #foo: selector: #bar times: 5.
	pragmasDetected := Pragma allNamed: #foo: from: self class to: Object.
	self assert: pragmasDetected = pragmasCompiled.
	
	pragmasDetected := Pragma allNamed: #foo: from: Object to: Object.
	self assert: pragmasDetected isEmpty.! !

!MethodPragmaTest methodsFor: 'testing-method' stamp: 'md 2/18/2006 19:59'!
testMethodClass
	| pragma |
	pragma := self pragma: 'foo' selector: #bar.
	self assert: pragma methodClass == self class.! !

!MethodPragmaTest methodsFor: 'testing' stamp: 'lr 3/19/2007 11:42'!
testNumArgs
	| pragma |
	pragma := Pragma keyword: #value arguments: #().
	self assert: pragma numArgs = 0.
	
	pragma := Pragma keyword: #+ arguments: #( 1 ).
	self assert: pragma numArgs = 1.
	
	pragma := Pragma keyword: #value:value: arguments: #( 1 2 ).
	self assert: pragma numArgs = 2! !

!MethodPragmaTest methodsFor: 'utilities' stamp: 'lr 1/20/2006 02:23'!
compile: aString selector: aSelector
	self class 
		compileSilently: aSelector , String lf , aString
		classified: self methodCategory.
	^ self class >> aSelector.! !

!MethodPragmaTest methodsFor: 'testing-compiler' stamp: 'CamilloBruni 8/31/2013 20:23'!
testCompileTemps
	"Pragmas should be placeable before and after temps."

	self assert: (self compile: '| temps | <foo>' selector: #zork) pragmas notEmpty.
	self assert: (self compile: '<foo> | temps |' selector: #zork) pragmas notEmpty! !

!MethodPragmaTest methodsFor: 'testing-primitives' stamp: 'CamilloBruni 2/26/2014 16:52'!
testPrimitiveNamedErrorCode1
	"This test useses the #primitiveDirectoryLookup primitive."

	self compile: '<primitive: ''primitiveDirectoryLookup'' error: errorCode module: ''FilePlugin''> ^ errorCode' selector: #lookup.
	self assert: self lookup equals: nil.
	
! !

!MethodPragmaTest methodsFor: 'testing-finding' stamp: 'lr 1/20/2006 08:17'!
testAllNamedFromToSortedByArgument
	| pragmasCompiled pragmasDetected |
	pragmasCompiled := self pragma: #foo: selector: #bar times: 5.
	pragmasDetected := Pragma allNamed: #foo: from: self class to: Object sortedByArgument: 1.
	self assert: pragmasDetected = (pragmasCompiled 
		sort: [ :a :b | (a argumentAt: 1) < (b argumentAt: 1) ])! !

!MethodPragmaTest methodsFor: 'testing-finding' stamp: 'lr 1/20/2006 08:17'!
testAllNamedFromToSortedUsing
	| pragmasCompiled pragmasDetected |
	pragmasCompiled := self pragma: #foo: selector: #bar times: 5.
	pragmasDetected := Pragma 
		allNamed: #foo: from: self class to: Object 
		sortedUsing: [ :a :b | (a argumentAt: 1) > (b argumentAt: 1) ].
	self assert: pragmasDetected = (pragmasCompiled 
		sort: [ :a :b | (a argumentAt: 1) > (b argumentAt: 1) ]).! !

!MethodPragmaTest methodsFor: 'testing-compiler' stamp: 'lr 1/20/2006 02:25'!
testCompileSymbol
	self assertPragma: 'foo: #bar' givesKeyword: #foo: arguments: #( bar ).
	self assertPragma: 'foo: #bar:' givesKeyword: #foo: arguments: #( bar: ).
	self assertPragma: 'foo: #bar:zork:' givesKeyword: #foo: arguments: #( bar:zork: ).! !

!MethodPragmaTest methodsFor: 'testing-method' stamp: 'lr 1/20/2006 07:54'!
testMethod
	| pragma |
	pragma := self pragma: 'foo' selector: #bar.
	self assert: pragma method == (self class >> #bar).! !

!MethodPragmaTest methodsFor: 'utilities' stamp: 'MarcusDenker 5/1/2013 16:55'!
assertPragma: aString givesKeyword: aSymbol arguments: anArray
	| pragma  |
	pragma := self pragma: aString selector: #zork.
	self assert: pragma keyword = aSymbol.
	self assert: pragma arguments = anArray.
! !

!MethodPragmaTest methodsFor: 'testing-compiler' stamp: 'MarcusDenker 5/23/2013 09:48'!
testCompileInvalid
	"Invalid pragmas should properly raise an error."

	self should: [ self compile: '<>' selector: #zork ] raise: SyntaxErrorNotification.
	self should: [ self compile: '<1>' selector: #zork ] raise: SyntaxErrorNotification.	
	self should: [ self compile: '<#123>' selector: #zork ] raise: SyntaxErrorNotification.
	
	self should: [ self compile: '<foo bar>' selector: #zork ] raise: SyntaxErrorNotification.
	self should: [ self compile: '<foo 1>' selector: #zork ] raise: SyntaxErrorNotification.
	self should: [ self compile: '<foo bar zork>' selector: #zork ] raise: SyntaxErrorNotification.
	self should: [ self compile: '<foo bar 1>' selector: #zork ] raise: SyntaxErrorNotification.
	
	self should: [ self compile: '<foo: #bar: zork:>' selector: #zork ] raise: SyntaxErrorNotification.
	
	self should: [ self compile: '<<1>' selector: #zork ] raise: SyntaxErrorNotification.
	self should: [ self compile: '<=2>' selector: #zork ] raise: SyntaxErrorNotification.

	self should: [ self compile: '< =1 = >' selector: #zork ] raise: SyntaxErrorNotification.
	self should: [ self compile: '< =1 =2 >' selector: #zork ] raise: SyntaxErrorNotification.! !

!MethodPragmaTest methodsFor: 'utilities' stamp: 'lr 1/20/2006 11:50'!
methodCategory
	^ #generated! !

!MethodPragmaTest methodsFor: 'testing-compiler' stamp: 'lr 1/20/2006 02:25'!
testCompileCharacter
	self assertPragma: 'foo: $a' givesKeyword: #foo: arguments: #( $a ).
	self assertPragma: 'foo: $ ' givesKeyword: #foo: arguments: #( $  ).! !

!MethodPragmaTest methodsFor: 'testing-compiled' stamp: 'lr 2/6/2006 21:03'!
testNoPragma
	| method |
	method := self compile: '' selector: #foo.
	self assert: method pragmas = #().! !

!MethodRecategorized commentStamp: 'cyrilledelaunay 1/18/2011 15:03'!
This announcement will be emitted when:
	=> a non-empty protocol is renamed in a class or a trait (using ClassOrganizer >> renameCategory:toBe:). If the protocol does not contain any method, the announcement will not be emitted. Therefore, if we rename a non-empty protocol, both SystemMethodRecategorizedAnnouncement and SystemClassReorganizedAnnouncement will be emitted
	=> a method is removed from a category of a class or a trait (using ClassOrganizer >> removeElement:)
	=> a method is RE-categorized in a protocol of a trait or a class, using Organizer>>classify:under:.  If the method is classify under its current protocol, the announcement will not be emitted!
!MethodRecategorized methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 09:57'!
oldProtocol
	
	^ oldProtocol! !

!MethodRecategorized methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 09:57'!
oldProtocol: anObject
	
	oldProtocol := anObject! !

!MethodRecategorized methodsFor: 'accessing' stamp: 'CamilleTeruel 9/4/2014 15:44'!
methodRecategorized
	
	^ method! !

!MethodRecategorized methodsFor: 'accessing' stamp: 'CamilleTeruel 9/4/2014 15:58'!
newProtocol
	
	^ self protocol! !

!MethodRecategorized class methodsFor: 'instance creation' stamp: 'CamilleTeruel 9/4/2014 16:32'!
method: aCompiledMethod oldProtocol: anOldProtocol

	^self new
		method: aCompiledMethod;
		oldProtocol: anOldProtocol;
		yourself! !

!MethodRecompileStrategy commentStamp: '<historical>'!
I am simple update strategy that recompiles all methods.!
!MethodRecompileStrategy methodsFor: 'updating' stamp: 'CamilleTeruel 12/18/2013 13:37'!
updateClassLiteralKeysIn: aClass 
	aClass isMeta ifTrue: [ ^ self ].
	
	aClass methodsDo: [ :method | 
		method classBinding: (aClass environment bindingOf: aClass name) ]! !

!MethodRecompileStrategy methodsFor: 'updating' stamp: 'CamilleTeruel 12/18/2013 14:00'!
transform: oldClass to: newClass using: aMethodModification
	newClass compileAllFrom: oldClass.
	! !

!MethodRemoved commentStamp: 'cyrilledelaunay 1/18/2011 14:43'!
This announcement will be emitted when a method is removed from a trait or a class, 
using ClassDescription >>removeSelector: or TraitDescription >> removeSelector.
!
!MethodRemoved methodsFor: 'accessing' stamp: 'CamilleTeruel 9/4/2014 16:29'!
protocol
	^ protocol! !

!MethodRemoved methodsFor: 'accessing' stamp: 'MartinDias 2/11/2013 14:09'!
methodOrigin: anObject
	methodOrigin := anObject ! !

!MethodRemoved methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:48'!
protocol: anObject
	
	protocol := anObject! !

!MethodRemoved methodsFor: 'accessing' stamp: 'CamilleTeruel 9/5/2014 12:08'!
methodOrigin
	^ methodOrigin! !

!MethodRemoved methodsFor: 'accessing' stamp: 'CamilleTeruel 9/4/2014 15:44'!
methodRemoved
	
	^ method! !

!MethodRemoved class methodsFor: 'instance creation' stamp: 'CamilleTeruel 9/5/2014 12:09'!
methodRemoved: aCompiledMethod protocol: aProtocol origin: aBehavior
	^self new
		method: aCompiledMethod;
		protocol: aProtocol;
		methodOrigin: aBehavior;
		yourself! !

!MethodRepackaged commentStamp: 'TorstenBergmann 2/12/2014 22:57'!
Notify about repackaging of a method!
!MethodRepackaged methodsFor: 'accessing' stamp: 'GuillermoPolito 8/17/2012 17:18'!
methodRepackaged: anObject
	
	methodRepackaged := anObject! !

!MethodRepackaged methodsFor: 'accessing' stamp: 'GuillermoPolito 8/17/2012 17:18'!
oldPackage: anObject
	
	oldPackage := anObject! !

!MethodRepackaged methodsFor: 'accessing' stamp: 'GuillermoPolito 8/17/2012 17:18'!
methodRepackaged
	
	^ methodRepackaged! !

!MethodRepackaged methodsFor: 'accessing' stamp: 'GuillermoPolito 8/17/2012 17:18'!
oldPackage
	
	^ oldPackage! !

!MethodRepackaged methodsFor: 'accessing' stamp: 'GuillermoPolito 8/17/2012 17:18'!
newPackage
	
	^ newPackage! !

!MethodRepackaged methodsFor: 'accessing' stamp: 'GuillermoPolito 8/17/2012 17:18'!
newPackage: anObject
	
	newPackage := anObject! !

!MethodRepackaged class methodsFor: 'instance creation' stamp: 'GuillermoPolito 8/17/2012 17:20'!
methodRepackaged: aMethod oldPackage: oldPackage newPackage: newPackage
	^self new
			methodRepackaged: aMethod;
			oldPackage: oldPackage;
			newPackage: newPackage;
			yourself.! !

!MethodToolbar commentStamp: '<historical>'!
A MethodToolbar is xxxxxxxxx.

| b |
b := MethodToolbar new.
b openWithSpec.
b method: (ButtonModel>>#state:).
b method: nil!
!MethodToolbar methodsFor: 'private' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
sendersMethod

	methodHolder value
		ifNotNil: [:aMethod | self model browseSendersOfMessagesFrom: aMethod selector ]! !

!MethodToolbar methodsFor: 'private' stamp: 'StephaneDucasse 12/19/2012 16:55'!
addAll: aWindow  withSpec: aSpec

	aWindow
		addMorph: (self buildWithSpec: aSpec)
		fullFrame: ((0@0 corner: 1@0) asLayoutFrame bottomOffset: 30).
		! !

!MethodToolbar methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
method: aMethod

	methodHolder value: aMethod! !

!MethodToolbar methodsFor: 'initialization' stamp: ''!
setImplementorsModel
	
	implementorsModel
		state: false;
		label: 'Implementors';
		action: [ self implementorsMethod ].
	
! !

!MethodToolbar methodsFor: 'initialization' stamp: ''!
setVersionModel
	
	versionModel
		state: false;
		label: 'Version';
		action: [ self versionMethod ].
	
! !

!MethodToolbar methodsFor: 'api' stamp: 'BenjaminVanRyseghem 9/9/2013 10:02'!
addItemLabeled: aString do: aBlock

	dropListModel addItemLabeled: aString do: aBlock! !

!MethodToolbar methodsFor: 'initialization' stamp: ''!
registerForChanges

	methodHolder whenChangedDo: [:contents || boolean |
		boolean := contents
						ifNil: [ false ]
						ifNotNil: [ true ].
		browseModel state: boolean.
		sendersModel state: boolean.
		versionModel state: boolean.
		implementorsModel state: boolean]! !

!MethodToolbar methodsFor: 'initialization' stamp: ''!
setFocusOrder

	self focusOrder
		add: browseModel;
		add: sendersModel;
		add: implementorsModel;
		add: versionModel.
		! !

!MethodToolbar methodsFor: 'initialization' stamp: ''!
setSendersModel
	
	sendersModel
		state: false;
		label: 'Senders';
		action: [ self sendersMethod ].
	
! !

!MethodToolbar methodsFor: 'accessing' stamp: ''!
browseModel

	^ browseModel! !

!MethodToolbar methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/28/2013 23:38'!
implementorsModel

	^ implementorsModel! !

!MethodToolbar methodsFor: 'private' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
browseMethod

	methodHolder value
		ifNotNil: [:aMethod | aMethod browse ]! !

!MethodToolbar methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 10/1/2013 15:42'!
initializeWidgets
	
	browseModel := self newButton.
	sendersModel := self newButton.
	implementorsModel := self newButton.
	versionModel := self newButton.
	dropListModel := self newDropList.
				
	self 
		setFocusOrder;
		setBrowseModel;
		setVersionModel;
		setSendersModel;
		setImplementorsModel
! !

!MethodToolbar methodsFor: 'initialization' stamp: 'DucasseStephane 9/10/2014 09:59'!
initialize

	methodHolder := nil asValueHolder.
	model := AbstractTool new.
	
	super initialize.! !

!MethodToolbar methodsFor: 'accessing' stamp: ''!
model

	^ model! !

!MethodToolbar methodsFor: 'accessing' stamp: ''!
versionModel

	^ versionModel! !

!MethodToolbar methodsFor: 'accessing' stamp: ''!
dropListModel

	^ dropListModel! !

!MethodToolbar methodsFor: 'private' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
implementorsMethod

	methodHolder value
		ifNotNil: [:aMethod | self model browseMessagesFrom: aMethod selector ]! !

!MethodToolbar methodsFor: 'private' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
versionMethod

	methodHolder value
		ifNotNil: [:aMethod | self model browseVersionsFrom: aMethod ]! !

!MethodToolbar methodsFor: 'initialization' stamp: ''!
setBrowseModel
	
	browseModel
		state: false;
		label: 'Browse';
		action: [ self browseMethod ].
	
! !

!MethodToolbar methodsFor: 'api' stamp: 'BenjaminVanRyseghem 9/9/2013 10:09'!
emptyDropList
	
	dropListModel emptyList! !

!MethodToolbar methodsFor: 'accessing' stamp: ''!
sendersModel

	^ sendersModel! !

!MethodToolbar class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 9/29/2013 13:46'!
defaultSpec
	<spec>
	^ SpecLayout composed
		newRow: [ :row | 
			row
				add: #(model browseModel);
				add: #(model sendersModel);
				add: #(model implementorsModel);
				add: #(model versionModel);
				add: #(model dropListModel) ];
		yourself! !

!MethodToolbar class methodsFor: 'specs' stamp: ''!
title

	^ 'Toolbar'! !

!MethodWidget commentStamp: '<historical>'!
MethodWidget is the basic implementation of a wiget managing methods!
!MethodWidget methodsFor: 'protocol' stamp: ''!
vScrollValue

	^ methodsList scrollValue y! !

!MethodWidget methodsFor: 'protocol' stamp: ''!
selectMethod: aMethod

	methodsSelection at: aMethod put: true! !

!MethodWidget methodsFor: 'selection' stamp: ''!
selectedMethodIndex: anInteger

	| aMethod |
	aMethod :=  self getMethods at: anInteger ifAbsent: [ nil ].
	self selectedMethod: aMethod.

	self changed: #selectedMethodIndex.! !

!MethodWidget methodsFor: 'item creation' stamp: 'NicolaiHess 8/9/2014 21:11'!
buildMethodsList
	
	methodsList :=  PluggableIconListMorph new
						basicWrapSelector: #methodWrapper:;
						keystrokeSelector: #keyPressedOnElement:; 
						getIconSelector: #methodIconFor:;
						resetListSelector: #resetMethodSelection;
						getListSizeSelector: #methodListSize;
						autoDeselect: true;
						dragEnabled: true; 
						hResizing: #spaceFill;
						vResizing: #spaceFill;
						
						model: self;
						getIndexSelector: #selectedMethodIndex;
						setIndexSelector: #selectedMethodIndex:;
						getSelectionListSelector: #methodSelectionAt:;
						setSelectionListSelector: #methodSelectionAt:put:;
						getMenuSelector: #elementsMenu:shifted:;
						beMultipleSelection.

		Nautilus populateMethodList
			ifTrue: [ methodsList getListElementSelector: #getMethodItem: ]
			ifFalse: [ methodsList basicGetListElementSelector: #getMethodItem: ].	
					
		^ methodsList.! !

!MethodWidget methodsFor: 'initialization' stamp: 'NorbertHartl 3/28/2013 12:46'!
initialize

	super initialize.
	methodsSelection := IdentityDictionary new.! !

!MethodWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/28/2014 22:14'!
selectedMethods

	| associations |
	associations := self methodsSelection associations select: [:assoc | assoc value ] thenCollect: [:assoc | assoc key ].
	^ associations reject: [:each | each isNil ]! !

!MethodWidget methodsFor: 'protocol' stamp: 'NicolaiHess 8/9/2014 21:07'!
resetMethodSelection

	self methodsSelection removeAll! !

!MethodWidget methodsFor: 'protocol' stamp: 'SeanDeNigris 7/7/2012 21:03'!
getMethods

	^ methods ifNil: [ methods := self loadMethods ].! !

!MethodWidget methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 3/23/2012 18:57'!
label: aString

	"methodsGroup label: aString"! !

!MethodWidget methodsFor: 'protocol' stamp: ''!
takeKeyboardFocus

	methodsList takeKeyboardFocus! !

!MethodWidget methodsFor: 'selection' stamp: ''!
methodSelectionAt: anIndex

	| elt assoc |
	elt := self getMethods at: anIndex ifAbsent: [ ^ false ].
	
	(methodsSelection keys identityIncludes: elt) ifFalse: [ ^ false].
	
	assoc := methodsSelection associationAt: elt ifAbsent: [ ^ false ].
	assoc key selector = elt selector 
		ifTrue: [ ^ assoc value ]
		ifFalse: [ ^ false ]! !

!MethodWidget methodsFor: 'private' stamp: 'EstebanLorenzano 5/28/2013 14:40'!
loadMethods

	^ self model showGroups
		ifTrue: [ self model selectedCategories
					ifEmpty: [ self model methodsForCategoryInGroup: self model allLabel ]
					ifNotEmpty: [:cat | self model methodsForCategoriesInGroup: cat ]]
		ifFalse: [
			self model selectedCategories
				ifEmpty: [ self model methodsForCategory: self model allLabel ]
				ifNotEmpty: [:cat | self model methodsForCategories: cat ]]! !

!MethodWidget methodsFor: 'private' stamp: 'JurajKubelka 2/4/2015 10:17'!
methodsList
	^ methodsList! !

!MethodWidget methodsFor: 'protocol' stamp: 'NicolaiHess 8/9/2014 21:08'!
resetMethodList

	methods := nil! !

!MethodWidget methodsFor: 'selection' stamp: ''!
methodSelectionAt: anIndex put: aBoolean

	| element |
	element := self getMethods at: anIndex ifAbsent: [ ^ self ].
	methodsSelection at: element put: aBoolean.! !

!MethodWidget methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 4/25/2012 11:15'!
keyPressedOnElement: anEvent
	| aCharacter |
	
	aCharacter := anEvent keyCharacter.

	aCharacter == self model class nextFocusKey ifTrue: [ ^ self model giveFocusTo: self model sourceTextArea ].	
	aCharacter == self model class previousFocusKey ifTrue: [ ^ self model giveFocusTo: self model categoryWidget ].
! !

!MethodWidget methodsFor: 'protocol' stamp: 'MarcusDenker 11/21/2013 13:34'!
removeAllFromMethodsIconsCache: aMethod
	self methodsIconsCache
		keysDo: [ :method | 
			" for overrides "
			method selector = aMethod selector
				ifTrue: [ MethodsIconsCache removeKey: method ifAbsent: [  ] ] ]! !

!MethodWidget methodsFor: 'private' stamp: 'BenjaminVanRyseghem 1/14/2013 08:21'!
methodWrapper: anItem
	| package selector result emphasis |
	
	selector := anItem selector.
	package := self model selectedPackage.
	result := selector asMorph.
	emphasis := 0.
	anItem protocol asString first = $*
		ifTrue: [ | item |
			item := anItem protocol allButFirst asLowercase.
			((item = package name asLowercase) or: 
				[ (item beginsWith: package name asLowercase) and: [( item at: (package name size +1)) =$-]])
				ifFalse: [ result := selector asMorph color: self model extensionColor ; yourself ]]
		ifFalse: [ 
			(package extendedClasses includes: anItem methodClass)
				ifTrue: [  result := selector asMorph color: self model extensionColor ; yourself ]].
	
	anItem isFromTrait
		ifTrue: [ 
			| trait |
			trait := anItem origin.
			selector := selector, ' (', trait name ,')'.
			result := selector asMorph.
			emphasis := emphasis + 2 ].
	self model showInstance
		ifFalse: [ emphasis := emphasis + 1 ].
	^ result emphasis: emphasis.! !

!MethodWidget methodsFor: 'private' stamp: ''!
methodListSize
	
	^ self getMethods size! !

!MethodWidget methodsFor: 'protocol' stamp: ''!
methodsSelection

	^ methodsSelection! !

!MethodWidget methodsFor: 'selection' stamp: ''!
selectedMethodIndex

	^ self getMethods identityIndexOf: self selectedMethod ifAbsent: [ 0 ].! !

!MethodWidget methodsFor: 'protocol' stamp: 'NicolaiHess 8/9/2014 21:20'!
updateMethodList

	self update: #getMethodItem:! !

!MethodWidget methodsFor: 'protocol' stamp: ''!
vScrollValue: aNumber

	^ methodsList vScrollValue: aNumber! !

!MethodWidget methodsFor: 'private' stamp: 'BenjaminVanRyseghem 4/14/2012 13:10'!
hasFocus

	^ methodsList hasKeyboardFocus! !

!MethodWidget methodsFor: 'protocol' stamp: 'StephaneDucasse 3/22/2015 10:06'!
updateMethodList: aMethodOrNil
	
	self update: #getMethodItem:.
	self selectMethod: aMethodOrNil.
	aMethodOrNil ifNotNil: [  
		| index |
		index := (methods collect: [:each | each selector]) indexOf: aMethodOrNil selector ifAbsent: 0.
		self selectedMethodIndex: index.]! !

!MethodWidget methodsFor: 'private' stamp: ''!
methodsLabel

	^ self showInstance
		ifTrue: ['Instance methods' asText ]
		ifFalse: ['Class methods' asText allBold ]! !

!MethodWidget methodsFor: 'private' stamp: 'StephaneDucasse 2/13/2015 21:37'!
getMethodItem: anIndex

	^ self getMethods at: anIndex! !

!MethodWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/11/2014 10:41'!
invalidateCacheEntryFor: aMethod
	self removeAllFromMethodsIconsCache: aMethod.
	self updateList! !

!MethodWidget class methodsFor: 'menu' stamp: 'MarcusDenker 2/16/2015 16:45'!
elementsMenu: aBuilder
	<nautilusGlobalMethodMenu>
	| selectedMethods tmp target |
	target := aBuilder model.
	selectedMethods := target selectedMethods.
	
	(aBuilder item: #'Find Method...')
		keyText: 'f, m' if: Nautilus useOldStyleKeys not;
		keyText: 'f' if: Nautilus useOldStyleKeys;
		action: [ target findMethod ];
		order: 0;
		help: 'Search for a method by name'.
		
	tmp := ((aBuilder item: #'Browse full')
		keyText: 'b, f' if: Nautilus useOldStyleKeys not;
		keyText: 'b' if: Nautilus useOldStyleKeys;
		action: [ target fullBrowse ];
		order: 200;
		yourself).
		
	target selectedMethod ifNil: [
		tmp withSeparatorAfter.
		 ^ target ].
	
	(aBuilder item: #'Generate test and jump')
		keyText: 'h, j' if: Nautilus useOldStyleKeys not;
		keyText: 'j' if: Nautilus useOldStyleKeys;
		action: [ target generateTestMethodsAndFocus: true ];
		order: 300.
		
	(aBuilder item: #'Generate test')
		keyText: 'h, J' if: Nautilus useOldStyleKeys not;
		keyText: 'J' if: Nautilus useOldStyleKeys;
		action: [ target generateTestMethodsAndFocus: false ];
		order: 400;
		withSeparatorAfter.
		
	(target selectedMethods allSatisfy: [:meth | meth isTestMethod ])
		ifTrue: [
			(aBuilder item: #'Run tests')
				keyText: 'j, m' if: Nautilus useOldStyleKeys not;
				keyText: 't' if: Nautilus useOldStyleKeys;
				action: [ target runTestForMethods: selectedMethods notifying: true ];
				order: 1000 ].
			
	(aBuilder item: #'Senders of...')
		keyText: 'b, n' if: Nautilus useOldStyleKeys not;
		keyText: 'n' if: Nautilus useOldStyleKeys;
		action: [ target browseSendersOfMessages ];
		order: 1100;
		enabledBlock: [ target enableMethodSingleSelection ].
		
	(aBuilder item: #'Implementors of...')
		keyText: 'b, m' if: Nautilus useOldStyleKeys not;
		keyText: 'm' if: Nautilus useOldStyleKeys;
		action: [ target browseMessages ];
		order: 1200;
		enabledBlock: [ target enableMethodSingleSelection ].
		
	(aBuilder item: #'Inheritance')
		keyText: 'b, i' if: Nautilus useOldStyleKeys not;
		keyText: 'i' if: Nautilus useOldStyleKeys;
		action: [ target methodHierarchy ];
		order: 1300;
		enabledBlock: [ target enableMethodSingleSelection ].
		
	(aBuilder item: #'Versions')
		keyText: 'b, v' if: Nautilus useOldStyleKeys not;
		keyText: 'v' if: Nautilus useOldStyleKeys;
		action: [ target browseVersions ];
		order: 1400;
		enabledBlock: [ target enableMethodSingleSelection ];
		withSeparatorAfter.
	
	(aBuilder item: #'Categorize method')
		keyText: 'm, m' if: Nautilus useOldStyleKeys not;
		action: [ target categorizeMethod ];
		order: 1500.
		
	(aBuilder item: #'Move to package...')
		action: [ target moveMethodToPackage ];
		order: 1600.
		
	(aBuilder item: #'Remove...')
		keyText: 'x, m' if: Nautilus useOldStyleKeys not;
		keyText: 'x' if: Nautilus useOldStyleKeys;
		action: [ target removeMethods ];
		order: 1700;
		icon: (Smalltalk ui icons iconNamed: #removeIcon);
		withSeparatorAfter.
		
	(aBuilder item: #'Compare two methods')		 
		action: [ target compareTwoMethods ];
		order: 1800;
		enabledBlock: [ target enableMethodDualSelection ];
		withSeparatorAfter.	
		
	(aBuilder item: #'Add in group...')
		keyText: 'n, e, m' if: Nautilus useOldStyleKeys not;
		action: [ target addMethodsInGroup ];
		order: 1900.
		
	(aBuilder item: #'Inspect Method')
		action: [ target inspectMethod ];
		order: 1950.
		
	(aBuilder item: #'Toggle Bytecodes')
		keyText: 'b, b' if: Nautilus useOldStyleKeys not;
		keyText: 'b' if: Nautilus useOldStyleKeys;
		action: [ target toggleBytecodes ];
		order: 1970.
			
	(aBuilder item: #'File Out')
		action: [ target fileOutMethods ];
		order: 2000! !

!MethodWidget class methodsFor: 'shortcuts' stamp: 'ClementBera 12/12/2014 11:26'!
buildMethodShortcutsOn: aBuilder
	<keymap>	

	(aBuilder shortcut: #fullBrowse)
		category: #NautilusMethodShortcuts
		default: $b command
		do: [ :target | target fullBrowse ]
		description: 'Open a new browser on the selection'.
		
	(aBuilder shortcut: #restrictedBrowseClass)
		category: #NautilusMethodShortcuts
		default: $b command shift
		do: [ :target | target restrictedBrowseClass ]
		description: 'Open a restricted browser'.
		
	(aBuilder shortcut: #categorizeMethod)
		category: #NautilusMethodShortcuts
		default: $c command shift
		do: [ :target | target categorizeMethod ]
		description: 'Recategorize the selected methods'.
	
	(aBuilder shortcut: #addMethodsInGroup)
		category: #NautilusMethodShortcuts
		default: $e command
		do: [ :target | target addMethodsInGroup ]
		description: 'Add the selected methods in a group'.
	
	(aBuilder shortcut: #findMethod)
		category: #NautilusMethodShortcuts
		default: $f command
		do: [ :target | target findMethod ]
		description: 'Find a method'.
	
	(aBuilder shortcut: #methodHierarchy)
		category: #NautilusMethodShortcuts
		default: $i command
		do: [ :target | target enableMethodSingleSelection ifTrue: [ target methodHierarchy ]]
		description: 'Spawn selected method hierarchy'.
		
	(aBuilder shortcut: #generateTestMethodsAndFocus)
		category: #NautilusMethodShortcuts
		default: $j command
		do: [ :target | target generateTestMethodsAndFocus: true ]
		description: 'Generate test methods for the selected methods and jump to them'.
		
	(aBuilder shortcut: #generateTestMethods)
		category: #NautilusMethodShortcuts
		default: $j command shift
		do: [ :target | target generateTestMethodsAndFocus: false ]
		description: 'Generate test methods for the selected methods'.
		
	(aBuilder shortcut: #browseMessages)
		category: #NautilusMethodShortcuts
		default: $m command
		do: [ :target | target enableMethodSingleSelection ifTrue: [ target browseMessages ]]
		description: 'Browse implementors'.
	
	(aBuilder shortcut: #browseSendersOfMessages)
		category: #NautilusMethodShortcuts
		default: $n command
		do: [ :target | target enableMethodSingleSelection ifTrue: [ target browseSendersOfMessages ]]
		description: 'Browse senders'.
	
	(aBuilder shortcut: #runTestFor)
		category: #NautilusMethodShortcuts
		default: $t command
		do: [ :target | target runTestForMethods: target selectedMethods notifying: true]
		description: 'Run the selected test methods'.
		
	(aBuilder shortcut: #browseVersions)
		category: #NautilusMethodShortcuts
		default: $v command
		do: [ :target | target enableMethodSingleSelection ifTrue: [ target browseVersions ]]
		description: 'Browse version'.		
	
	(aBuilder shortcut: #removeMethods)
		category: #NautilusMethodShortcuts
		default: $x command
		do: [ :target | target removeMethods ]
		description: 'Remove the selected methods'.
		
	(aBuilder shortcut: #toggleBytecodes)
		category: #NautilusMethodShortcuts
		default: $b command
		do: [ :target | target toggleBytecodes ]
		description: 'ShowBytecodes'.! !

!MethodWithCorrespondingTestAction commentStamp: '<historical>'!
Action when the method has a corresponding test method!
!MethodWithCorrespondingTestAction methodsFor: 'order' stamp: 'BenjaminVanRyseghem 1/2/2013 12:41'!
isActionHandled

	^ (testMethod := method correspondingTestMethod) notNil! !

!MethodWithCorrespondingTestAction methodsFor: 'order' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
privateActionIcon
	"Return the icon for this action"
	| testIcon |
	
	testIcon := Smalltalk ui icons iconNamed: #testNotRunIcon.
	
	testMethod hasPassedTest
		ifTrue: [ testIcon := Smalltalk ui icons iconNamed: #testGreenIcon ].
	testMethod hasFailedTest
		ifTrue: [ testIcon := Smalltalk ui icons iconNamed: #testYellowIcon ].
	testMethod hasErrorTest
		ifTrue: [ testIcon := Smalltalk ui icons iconNamed: #testRedIcon ].
	
	^ IconicButton new
		target: self browser;
		actionSelector: #runTestForAMethod:notifying:;
		arguments:  { method. true};
		labelGraphic: testIcon;
		color: Color transparent;
		extent: 12 @ 12;
		helpText: 'Run the test';
		borderWidth: 0! !

!MethodWithCorrespondingTestAction methodsFor: 'order' stamp: 'BenjaminVanRyseghem 2/20/2013 19:57'!
actionOrder
	"Return the priority of this action"
	
	^ 500! !

!MimeConverter commentStamp: 'LaurentLaffont 6/8/2011 22:18'!
I'm the base class for converting some data from a MIME type to another. Subclasses should implement #mimeDecode and #mimeEncode.!
!MimeConverter methodsFor: 'accessing' stamp: 'tk 12/9/97 13:53'!
mimeStream
	^mimeStream! !

!MimeConverter methodsFor: 'accessing' stamp: 'tk 12/9/97 13:51'!
mimeStream: anObject
	mimeStream := anObject! !

!MimeConverter methodsFor: 'accessing' stamp: 'tk 12/9/97 13:55'!
dataStream
	^dataStream! !

!MimeConverter methodsFor: 'accessing' stamp: 'tk 12/9/97 13:51'!
dataStream: anObject
	dataStream := anObject! !

!MimeConverter methodsFor: 'conversion' stamp: 'bf 11/12/1998 13:30'!
mimeDecode
	"Do conversion reading from mimeStream writing to dataStream"

	self subclassResponsibility! !

!MimeConverter methodsFor: 'conversion' stamp: 'bf 11/12/1998 13:31'!
mimeEncode
	"Do conversion reading from dataStream writing to mimeStream"

	self subclassResponsibility! !

!MimeConverter class methodsFor: 'convenience' stamp: 'bf 3/10/2000 14:40'!
mimeEncode: aCollectionOrStream
	^ String streamContents: [:out |
		self mimeEncode: aCollectionOrStream to: out]! !

!MimeConverter class methodsFor: 'convenience' stamp: 'damiencassou 5/30/2008 11:45'!
mimeEncode: aCollectionOrStream to: outStream 
	self new
		dataStream: (aCollectionOrStream isStream 
				ifTrue: [ aCollectionOrStream ]
				ifFalse: [ aCollectionOrStream readStream ]);
		mimeStream: outStream;
		mimeEncode! !

!MimeConverter class methodsFor: 'convenience' stamp: 'bf 3/10/2000 14:47'!
forEncoding: encodingString
	"Answer a converter class for the given encoding or nil if unknown"
	encodingString ifNil: [^nil].
	^ encodingString asLowercase caseOf: 
		{ ['base64'] -> [Base64MimeConverter].
		  ['quoted-printable'] -> [QuotedPrintableMimeConverter]}
		otherwise: [].
! !

!MimeConverter class methodsFor: 'convenience' stamp: 'bf 3/10/2000 14:43'!
mimeDecode: aStringOrStream as: contentsClass
	^ contentsClass streamContents: [:out |
		self mimeDecode: aStringOrStream to: out]! !

!MimeConverter class methodsFor: 'convenience' stamp: 'damiencassou 5/30/2008 11:45'!
mimeDecode: aStringOrStream to: outStream 
	self new
		mimeStream: (aStringOrStream isStream 
				ifTrue: [ aStringOrStream ]
				ifFalse: [ aStringOrStream readStream ]);
		dataStream: outStream;
		mimeDecode! !

!MissingClassError commentStamp: '<historical>'!
I'm a specialized error that is invoked when trying to load a method for a non existing class. 

By default this exception is not resumable but it can be set and used for example as follow:


	[ FileStream fileIn: aFile ]
		on: MissingClassError
		do: [ :exception | 
				exception defineClass. 
				exception asResumable.
				exception resume. ]
			
			
So we give the possibility to compile and resume compution.
The method defineClass defines a simple class inheriting from Object (or from the class specified using #superclassName:)
The idea is that if later the effective class is loaded its definition will override  this one. !
!MissingClassError methodsFor: 'accessing' stamp: 'StephaneDucasse 12/4/2013 20:20'!
superclassName: aString

	superclassName := aString
! !

!MissingClassError methodsFor: 'accessing' stamp: 'StephaneDucasse 12/4/2013 20:21'!
superclassName

	^ superclassName ifNil: [ superclassName := 'Object' ]
! !

!MissingClassError methodsFor: 'actions' stamp: 'StephaneDucasse 12/4/2013 20:19'!
asResumable
	"When sent to the receiver, this one turns into a resumable exception allowing for example to define missing class on the fly."
	resumable := true.! !

!MissingClassError methodsFor: 'actions' stamp: 'MarcusDenker 12/7/2013 23:50'!
defineClass

	Smalltalk compiler evaluate: 
		self superclassName,  ' subclass: #', className, 
	' instanceVariableNames: ''''
	classVariableNames: ''''
	poolDictionaries: ''''
	category: ''Stub-Classes'''! !

!MissingClassError methodsFor: 'accessing' stamp: 'StephaneDucasse 12/1/2013 21:59'!
className: aString

	className := aString! !

!MissingClassError methodsFor: 'testing' stamp: 'StephaneDucasse 12/1/2013 21:55'!
isResumable
	"Determine whether an exception is resumable. By default not but can be resumable using accessors at exception raising time."

	^ resumable ifNil: [ super isResumable ]! !

!MissingClassError class methodsFor: 'instance creation' stamp: 'StephaneDucasse 12/1/2013 21:58'!
className: aString

	^ self new className: aString; yourself! !

!MockContainer commentStamp: '<historical>'!
I'm only a fake container, since in some cases to build a context we use the wraped model, and build a full container isn't so simple... !
!MockContainer methodsFor: 'accessing' stamp: 'GiselaDecuzzi 4/29/2013 15:21'!
model: anObject
	model := anObject! !

!MockContainer methodsFor: 'accessing' stamp: 'GiselaDecuzzi 4/29/2013 15:21'!
model
	^ model.! !

!MockContainer class methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/29/2013 15:23'!
for: model
	^ self new 
		model: model; 
		yourself.! !

!MockExceptionWithPassAction commentStamp: '<historical>'!
I am Exception used in the Weak collection tests which has a custom pass action.
Instead of using the Exception's default pass mechanism I will call a customized block.!
!MockExceptionWithPassAction methodsFor: 'handling' stamp: 'IgorStasenko 5/23/2011 13:07'!
pass
	^ passAction cull: self! !

!MockExceptionWithPassAction methodsFor: 'accessing' stamp: 'IgorStasenko 5/23/2011 13:07'!
passAction: aValuable
	passAction := aValuable! !

!MockFinalizerAction commentStamp: '<historical>'!
I am test object used for the WeakRegisty tests.
Upon finalization I trigger a custom finalizationAction (usually a Block)!
!MockFinalizerAction methodsFor: 'accessing' stamp: 'CamilloBruni 4/25/2013 16:20'!
finalize
	finalizationAction value! !

!MockFinalizerAction methodsFor: 'accessing' stamp: 'CamilloBruni 4/25/2013 16:20'!
finalizeValues
	finalizationAction value! !

!MockFinalizerAction methodsFor: 'accessing' stamp: 'CamilloBruni 4/25/2013 16:20'!
finalizationAction: aValuable
	finalizationAction := aValuable! !

!MockLessonView commentStamp: 'TorstenBergmann 2/12/2014 22:48'!
A LessonView mock for testing purposes!
!MockLessonView methodsFor: 'accessing' stamp: 'LaurentLaffont 1/21/2010 16:09'!
lesson
	^ lesson! !

!MockLessonView methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/27/2015 13:03'!
isOpenInWindow
	^ true! !

!MockLessonView methodsFor: 'gui' stamp: 'DannyChan 2/1/2010 22:02'!
showTutorialNode: aTutorialNode
	lesson:= aTutorialNode lessonInstance.
	title := aTutorialNode title.! !

!MockLessonView methodsFor: 'accessing' stamp: 'LaurentLaffont 1/21/2010 16:10'!
title
	^ title! !

!MockLessonView methodsFor: 'gui' stamp: 'LaurentLaffont 1/21/2010 16:10'!
showLesson: aLesson withTitle: aString
	lesson := aLesson.
	title := aString.! !

!MockSocketStream commentStamp: 'TorstenBergmann 2/5/2014 10:10'!
A test mock for socket streams!
!MockSocketStream methodsFor: 'accessing' stamp: 'fbs 3/22/2004 13:08'!
outStream
	^outStream! !

!MockSocketStream methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 10:08'!
initialize
	super initialize.
	self resetInStream.
	self resetOutStream.! !

!MockSocketStream methodsFor: 'stream out' stamp: 'fbs 3/22/2004 13:07'!
sendCommand: aString
	self outStream
		nextPutAll: aString;
		nextPutAll: String crlf.! !

!MockSocketStream methodsFor: 'stream in' stamp: 'fbs 3/22/2004 13:09'!
nextLineCrLf
	^(self upToAll: String crlf).! !

!MockSocketStream methodsFor: 'stream in' stamp: 'fbs 3/22/2004 13:10'!
nextLine
	^self nextLineCrLf! !

!MockSocketStream methodsFor: 'stream in' stamp: 'PeterHugossonMiller 9/3/2009 10:05'!
resetInStream
	inStream := String new writeStream.! !

!MockSocketStream methodsFor: 'stream in' stamp: 'fbs 3/22/2004 13:09'!
upToAll: delims
	^self inStream upToAll: delims.! !

!MockSocketStream methodsFor: 'testing' stamp: 'fbs 3/22/2004 13:08'!
atEnd
	^self inStream atEnd.! !

!MockSocketStream methodsFor: 'accessing' stamp: 'fbs 3/22/2004 12:51'!
atEnd: aBoolean
	atEnd := aBoolean.! !

!MockSocketStream methodsFor: 'accessing' stamp: 'fbs 3/22/2004 13:29'!
inStream
	^inStream! !

!MockSocketStream methodsFor: 'stream out' stamp: 'PeterHugossonMiller 9/3/2009 10:05'!
resetOutStream
	outStream := String new writeStream.! !

!MockSocketStream class methodsFor: 'instance creation' stamp: 'fbs 3/22/2004 12:46'!
on: socket
	^self basicNew initialize! !

!MockSourceEditor commentStamp: 'TorstenBergmann 1/31/2014 11:25'!
A mock object mocking a source editor!
!MockSourceEditor methodsFor: 'as yet unclassified' stamp: 'PavelKrivanek 11/8/2012 13:43'!
cut

	text := (text first: selectionStart-1), (text copyFrom: selectionEnd+1 to: text size).
		
	selectionStart := selectionStart - 1.	
	selectionEnd := selectionStart! !

!MockSourceEditor methodsFor: 'initialization' stamp: 'PavelKrivanek 11/8/2012 13:22'!
initialize

	super initialize.
	selectionStart := selectionEnd := 0.! !

!MockSourceEditor methodsFor: 'as yet unclassified' stamp: 'PavelKrivanek 11/8/2012 13:31'!
insertAndSelect: aString at: anInteger

	text := (text first: anInteger-1), 
		(' ' , aString) asText, 
		(text copyFrom: anInteger to: text size).
		
	selectionStart := anInteger.
	selectionEnd := anInteger + aString size ! !

!MockSourceEditor methodsFor: 'as yet unclassified' stamp: 'PavelKrivanek 11/8/2012 13:25'!
selection

	^ self text copyFrom: selectionStart to: selectionEnd! !

!MockSourceEditor methodsFor: 'as yet unclassified' stamp: 'PavelKrivanek 11/8/2012 13:24'!
selectionInterval

	^ Interval from: selectionStart to: selectionEnd.! !

!MockSourceEditor methodsFor: 'as yet unclassified' stamp: 'PavelKrivanek 11/8/2012 12:49'!
editor

	^ self! !

!MockSourceEditor methodsFor: 'as yet unclassified' stamp: 'PavelKrivanek 11/8/2012 13:23'!
selectFrom: start to: end

	selectionStart := start.
	selectionEnd := end.
! !

!MockSourceEditor methodsFor: 'as yet unclassified' stamp: 'PavelKrivanek 11/8/2012 12:48'!
contents: aText

	text := aText! !

!MockSourceEditor methodsFor: 'as yet unclassified' stamp: 'PavelKrivanek 11/8/2012 13:43'!
startIndex

	^ selectionStart! !

!MockSourceEditor methodsFor: 'as yet unclassified' stamp: 'PavelKrivanek 11/8/2012 13:25'!
selectionAsStream

	^ ReadStream
		on: (self text copyFrom: selectionStart to: selectionEnd)! !

!MockSourceEditor methodsFor: 'as yet unclassified' stamp: 'PavelKrivanek 11/8/2012 12:49'!
text

	^ text! !

!MockSourceEditor methodsFor: 'as yet unclassified' stamp: 'PavelKrivanek 11/8/2012 13:23'!
notify: aString at: anInteger in: aStream

	| pos |
	pos := self selectionInterval notEmpty
		ifTrue: [selectionStart + anInteger - 1 ]
		ifFalse: [anInteger].
	self insertAndSelect: aString at: (pos max: 1)! !

!MockTranscript methodsFor: 'initialization' stamp: 'JorgeRessia 3/4/2010 21:19'!
initialize
 
	super initialize.
	stream := String new writeStream.! !

!MockTranscript methodsFor: 'streaming' stamp: 'JorgeRessia 3/4/2010 21:19'!
show: anObject
	stream nextPutAll: anObject asString
	! !

!MockTranscript methodsFor: 'accessing' stamp: 'JorgeRessia 3/4/2010 21:19'!
contents
	^stream contents
	! !

!MockTranscript methodsFor: 'streaming' stamp: 'JorgeRessia 3/4/2010 21:19'!
cr 
	stream cr! !

!MockTutorial commentStamp: 'TorstenBergmann 2/12/2014 22:49'!
Mocking a tutorial for test purposes!
!MockTutorial methodsFor: 'lesson' stamp: 'LaurentLaffont 1/21/2010 15:15'!
thirdLesson
	^ Lesson title: 'third' lesson: 'Third lesson'.! !

!MockTutorial methodsFor: 'lesson' stamp: 'LaurentLaffont 1/21/2010 15:15'!
secondLesson
	^ Lesson title: 'second' lesson: 'Second lesson'.! !

!MockTutorial methodsFor: 'tutorial' stamp: 'LaurentLaffont 1/21/2010 15:14'!
tutorial 
	^ #(
firstLesson
secondLesson
thirdLesson
)! !

!MockTutorial methodsFor: 'lesson' stamp: 'LaurentLaffont 1/21/2010 15:15'!
firstLesson
	^ Lesson title: 'first' lesson: 'First lesson'.! !

!MockTutorial2 commentStamp: 'TorstenBergmann 2/12/2014 22:49'!
Mocking another tutorial for test purposes!
!Model commentStamp: '<historical>'!
Provides a superclass for classes that function as models.  The only behavior provided is fast dependents maintenance, which bypasses the generic DependentsFields mechanism.  1/23/96 sw!
!Model methodsFor: 'backstops' stamp: 'nk 6/29/2004 14:46'!
arrowKey: aChar from: view
	"backstop; all the PluggableList* classes actually handle arrow keys, and the models handle other keys."
	^false! !

!Model methodsFor: '*Tool-Base' stamp: 'alain.plantec 6/10/2008 20:22'!
containingWindow
	"Answer the window that holds the receiver. The dependents technique is
	odious and may not be airtight, if multiple windows have the same
	model. "
	^ self dependents
		detect: [:d | (d isSystemWindow)
				and: [d model == self]]
		ifNone: []! !

!Model methodsFor: 'dependents' stamp: 'BenjaminVanRyseghem 7/29/2013 14:21'!
removeDependent: anObject
	"Remove the given object as one of the receiver's dependents."

	| newDependents |
	newDependents := self dependents reject: [:each | each == anObject].
	self myDependents: (newDependents isEmpty ifFalse: [ newDependents ]).
	
	^ anObject! !

!Model methodsFor: 'backstops' stamp: 'tk 4/17/1998 17:28'!
selectedClass
	"All owners of TextViews are asked this during a doIt"
	^ nil! !

!Model methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 7/24/2013 13:36'!
update: anAspect

	^ self! !

!Model methodsFor: 'dependents' stamp: 'BenjaminVanRyseghem 7/29/2013 14:12'!
addDependent: anObject
	"Make the given object one of the receiver's dependents."

	(self dependents includes: anObject) ifFalse:
		[self myDependents: (self dependents copyWithDependent: anObject)].
	
	^ anObject! !

!Model methodsFor: 'copying' stamp: ''!
veryDeepFixupWith: deepCopier 
	"See if the dependents are being copied also.  If so, point at the new copies.  (The dependent has self as its model.)
	Dependents handled in class Object, when the model is not a Model, are fixed up in Object veryDeepCopy."

	| originalDependents refs |
	super veryDeepFixupWith: deepCopier.
	originalDependents := dependents.
	originalDependents ifNil: [
		^self.
		].
	dependents := nil.
	refs := deepCopier references.
	originalDependents
		do: [:originalDependent | | newDependent | 
			newDependent := refs
						at: originalDependent
						ifAbsent: [].
			newDependent
				ifNotNil: [self addDependent: newDependent]]! !

!Model methodsFor: 'dependents' stamp: 'BenjaminVanRyseghem 12/6/2013 10:59'!
dependents
	"Answer a collection of objects that are 'dependent' on the receiver;
	 that is, all objects that should be notified if the receiver changes."

	^ self myDependents ifNil: [#()]! !

!Model methodsFor: 'dependents-private' stamp: 'BenjaminVanRyseghem 7/29/2013 14:07'!
myDependents: aCollectionOrNil

	dependents := aCollectionOrNil! !

!Model methodsFor: '*Polymorph-Widgets' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
theme
	^ Smalltalk ui theme! !

!Model methodsFor: 'updating' stamp: 'zz 3/2/2004 23:49'!
step
	"Default for morphic models is no-op"! !

!Model methodsFor: 'dependents-private' stamp: 'BenjaminVanRyseghem 7/31/2013 14:12'!
actAsExecutor
	"Prepare the receiver to act as executor for any resources associated with it"
	self breakDependents! !

!Model methodsFor: 'edits' stamp: 'BenjaminVanRyseghem 7/29/2013 14:22'!
canDiscardEdits
	"Answer true if none of the views on this model has unaccepted edits that matter."

	dependents ifNil: [ ^ true ].
	
	self dependents
		do: [:each | each canDiscardEdits ifFalse: [ ^ false ] ]
		without: self.
		
	^ true! !

!Model methodsFor: 'edits' stamp: 'EstebanLorenzano 9/21/2012 13:22'!
hasUnacceptedEdits
	"Answer true if any of the views on this model has unaccepted edits."

	dependents ifNil: [^ false].
	self dependents
		do: [:each | 
			self flag: #fixMe. "The check for #respondsTo: is a hack necessary just because the old
			Browser uses it wrong. We need to change this after old Browser removal"
			((each respondsTo: #hasUnacceptedEdits) and: [ each hasUnacceptedEdits ]) 
				ifTrue: [^ true]]
		without: self.
	^ false
! !

!Model methodsFor: 'dependents-private' stamp: 'BenjaminVanRyseghem 7/29/2013 14:16'!
myDependents

	^ dependents! !

!Model methodsFor: '*Morphic-Core' stamp: 'StephaneDucasse 3/18/2010 21:23'!
initialExtent

	^ RealEstateAgent standardWindowExtent! !

!ModelDependentDialogWindow commentStamp: 'gvc 5/18/2007 12:44'!
DialogWindow that updates content based upon its model.!
!ModelDependentDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 9/15/2006 15:27'!
model: anObject
	"Set the model and add the panel for it."
	
	super model: anObject.
	self paneMorphs copy do: [:p | p delete].
	self addMainPanel! !

!ModelDependentDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 9/15/2006 15:27'!
addInitialPanel
	"Don't until the model is set."! !

!ModelList commentStamp: 'BenjaminVanRyseghem 1/21/2014 16:35'!
I am a simple list widget

I am used to expose the construction of a spec UI in the Spec documentation.!
!ModelList methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 1/21/2014 16:29'!
initializeWidgets

	list := self newList.
	
	list items: (AbstractWidgetModel allSubclasses 
		sorted: [:a :b | a name < b name ]).
		
	self focusOrder add: list! !

!ModelList methodsFor: 'api-events' stamp: 'BenjaminVanRyseghem 1/21/2014 15:19'!
whenSelectedItemChanged: aBlock

	list whenSelectedItemChanged: aBlock! !

!ModelList methodsFor: 'api' stamp: 'BenjaminVanRyseghem 1/21/2014 16:32'!
title

	^ 'Widgets'! !

!ModelList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/21/2014 15:17'!
list
	^ list! !

!ModelList class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/21/2014 15:18'!
defaultSpec
	<spec: #default>
	
	^ SpecLayout composed
		add: #list;
		yourself! !

!ModifiedField commentStamp: '<historical>'!
I encapsulate the modification of a slot.
The two use-cases are: slot renaming or a changed slot type.
Both cases enforce recompilation of all the methods accessing the corresponding variable.

This is unlike the ShiftedField modification which is only used when the type of the slot does not change.!
!ModifiedField methodsFor: 'installing' stamp: 'ToonVerwaest 3/28/2011 17:08'!
installOn: aModification
	aModification installModifiedSlot: self! !

!ModifiedField methodsFor: 'accessing' stamp: 'CamilloBruni 3/28/2011 18:50'!
originalSlot

	^ originalSlot! !

!ModifiedField methodsFor: 'migrating' stamp: 'ToonVerwaest 3/30/2011 13:54'!
migrateAt: index to: newInstance from: oldInstance
	newInstance
		instVarAt: index
		put: (oldInstance instVarAt: self oldFieldIndex)! !

!ModifiedField methodsFor: 'accessing' stamp: 'ToonVerwaest 3/28/2011 17:14'!
newFieldIndex
	^ newSlot index + fieldIndex! !

!ModifiedField methodsFor: 'accessing' stamp: 'CamilloBruni 3/28/2011 18:50'!
originalSlot: anObject
	originalSlot := anObject! !

!ModifiedField methodsFor: 'accessing' stamp: 'ToonVerwaest 3/28/2011 16:34'!
newSlot
	^ newSlot! !

!ModifiedField methodsFor: 'accessing' stamp: 'ToonVerwaest 3/28/2011 16:34'!
newSlot: anObject
	newSlot := anObject! !

!ModifiedField methodsFor: 'accessing' stamp: 'ToonVerwaest 3/28/2011 17:14'!
oldFieldIndex
	^ originalSlot index + fieldIndex! !

!MondrianPlugin commentStamp: 'StephaneDucasse 10/30/2014 07:42'!
I'm an example plugin that shows how we can switch the code pane with a morph when a package is selected.  !
!MondrianPlugin methodsFor: 'registration' stamp: 'BenjaminVanRyseghem 8/21/2011 17:31'!
classSelected: anAnnouncement

	| container |
	container := self model ui ifNotNil: [:view | view sourceCodeContainer ] ifNil: [ ^ self] .
	anAnnouncement itemClass
		ifNil: [
			subMorphs ifNil: [ subMorphs := container submorphs ].
			container removeAllMorphs.
			container addMorph: (self remplacementMorphUsing: anAnnouncement)]
		ifNotNil: [
			subMorphs ifNotNil: [
			container removeAllMorphs.
			subMorphs reverse do: [:each | container addMorph: each ]]]! !

!MondrianPlugin methodsFor: 'registration' stamp: 'BernardoContreras 10/22/2014 19:12'!
registerTo: aModel

	aModel announcer
		when: NautilusClassSelected send: #classSelected: to: self! !

!MondrianPlugin methodsFor: 'registration' stamp: 'BenjaminVanRyseghem 8/21/2011 17:03'!
remplacementMorphUsing: anAnnouncement
		
	^ Morph new color: Color blue; yourself! !

!MondrianPlugin class methodsFor: 'information' stamp: 'BenjaminVanRyseghem 2/17/2012 16:49'!
description

	^ 'When a package is selected, replace the text morph by a morph.
The purpose of this plugin is to be overriden'! !

!Monitor commentStamp: 'md 3/3/2006 09:19'!
A monitor provides process synchronization that is more high level than the one provided by a Semaphore. Similar to the classical definition of a Monitor it has the following properties:

1) At any time, only one process can execute code inside a critical section of a monitor.
2) A monitor is reentrant, which means that the active process in a monitor never gets blocked when it enters a (nested) critical section of the same monitor.
3) Inside a critical section, a process can wait for an event that may be coupled to a certain condition. If the condition is not fulfilled, the process leaves the monitor temporarily (in order to let other processes enter) and waits until another process signals the event. Then, the original process checks the condition again (this is often necessary because the state of the monitor could have changed in the meantime) and continues if it is fulfilled.
4) The monitor is fair, which means that the process that is waiting on a signaled condition the longest gets activated first.
5) The monitor allows you to define timeouts after which a process gets activated automatically.


Basic usage:

Monitor>>critical: aBlock
Critical section.
Executes aBlock as a critical section. At any time, only one process can execute code in a critical section.
NOTE: All the following synchronization operations are only valid inside the critical section of the monitor!!

Monitor>>wait
Unconditional waiting for the default event.
The current process gets blocked and leaves the monitor, which means that the monitor allows another process to execute critical code. When the default event is signaled, the original process is resumed.

Monitor>>waitWhile: aBlock
Conditional waiting for the default event.
The current process gets blocked and leaves the monitor only if the argument block evaluates to true. This means that another process can enter the monitor. When the default event is signaled, the original process is resumed, which means that the condition (argument block) is checked again. Only if it evaluates to false, does execution proceed. Otherwise, the process gets blocked and leaves the monitor again...

Monitor>>waitUntil: aBlock
Conditional waiting for the default event.
See Monitor>>waitWhile: aBlock.

Monitor>>signal
One process waiting for the default event is woken up.

Monitor>>signalAll
All processes waiting for the default event are woken up.


Using non-default (specific) events:

Monitor>>waitFor: aSymbol
Unconditional waiting for the non-default event represented by the argument symbol.
Same as Monitor>>wait, but the process gets only reactivated by the specific event and not the default event.

Monitor>>waitWhile: aBlock for: aSymbol
Confitional waiting for the non-default event represented by the argument symbol.
Same as Monitor>>waitWhile:for:, but the process gets only reactivated by the specific event and not the default event.

Monitor>>waitUntil: aBlock for: aSymbol
Confitional waiting for the non-default event represented by the argument symbol.
See Monitor>>waitWhile:for: aBlock.

Monitor>>signal: aSymbol
One process waiting for the given event is woken up. If there is no process waiting for this specific event, a process waiting for the default event gets resumed.

Monitor>>signalAll: aSymbol
All process waiting for the given event or the default event are woken up.

Monitor>>signalReallyAll
All processes waiting for any events (default or specific) are woken up.


Using timeouts

Monitor>>waitMaxMilliseconds: anInteger
Monitor>>waitFor: aSymbol maxMilliseconds: anInteger
Same as Monitor>>wait (resp. Monitor>>waitFor:), but the process gets automatically woken up when the specified time has passed.

Monitor>>waitWhile: aBlock maxMilliseconds: anInteger
Monitor>>waitWhile: aBlock for: aSymbol maxMilliseconds: anInteger
Same as Monitor>>waitWhile: (resp. Monitor>>waitWhile:for:), but the process gets automatically woken up when the specified time has passed.

Monitor>>waitUntil: aBlock maxMilliseconds: anInteger
Monitor>>waitUntil: aBlock for: aSymbol maxMilliseconds: anInteger
Same as Monitor>>waitUntil: (resp. Monitor>>waitUntil:for:), but the process gets automatically woken up when the specified time has passed.!
!Monitor methodsFor: 'waiting-basic' stamp: 'fbs 3/24/2004 14:39'!
waitWhile: aBlock
	"Conditional waiting for the default event.
	The current process gets blocked and leaves the monitor only if the argument block
	evaluates to true. This means that another process can enter the monitor. When the 
	default event is signaled, the original process is resumed, which means that the condition
	(argument block) is checked again. Only if it evaluates to false, does execution proceed.
	Otherwise, the process gets blocked and leaves the monitor again..."

	^ self waitWhile: aBlock for: nil! !

!Monitor methodsFor: 'waiting-timeout' stamp: 'NS 7/1/2002 22:03'!
waitFor: aSymbolOrNil maxMilliseconds: anIntegerOrNil
	"Same as Monitor>>waitFor:, but the process gets automatically woken up when the 
	specified time has passed."

	self checkOwnerProcess.
	self waitInQueue: (self queueFor: aSymbolOrNil) maxMilliseconds: anIntegerOrNil.! !

!Monitor methodsFor: 'accessing' stamp: 'NS 7/1/2002 20:02'!
cleanup
	self checkOwnerProcess.
	self critical: [self privateCleanup].! !

!Monitor methodsFor: 'private' stamp: 'StephaneDucasse 10/19/2010 14:01'!
queueDict
	^ queueDict ifNil: [queueDict := IdentityDictionary new].
	! !

!Monitor methodsFor: 'waiting-timeout' stamp: 'NS 7/1/2002 22:06'!
waitWhile: aBlock maxSeconds: aNumber
	"Same as Monitor>>waitWhile:, but the process gets automatically woken up when the 
	specified time has passed."

	^ self waitWhile: aBlock maxMilliseconds: (aNumber * 1000) asInteger! !

!Monitor methodsFor: 'waiting-timeout' stamp: 'NS 7/1/2002 22:05'!
waitUntil: aBlock for: aSymbolOrNil maxSeconds: aNumber
	"Same as Monitor>>waitUntil:for:, but the process gets automatically woken up when the 
	specified time has passed."

	^ self waitUntil: aBlock for: aSymbolOrNil maxMilliseconds: (aNumber * 1000) asInteger! !

!Monitor methodsFor: 'waiting-timeout' stamp: 'NS 7/1/2002 22:06'!
waitWhile: aBlock for: aSymbolOrNil maxSeconds: aNumber
	"Same as Monitor>>waitWhile:for:, but the process gets automatically woken up when the 
	specified time has passed."

	^ self waitWhile: aBlock for: aSymbolOrNil maxMilliseconds: (aNumber * 1000) asInteger! !

!Monitor methodsFor: 'private' stamp: 'ClementBera 7/26/2013 17:19'!
exitAndWaitInQueue: anOrderedCollection maxMilliseconds: anIntegerOrNil
	| lock delay |
	lock := queuesMutex 
		critical: [anOrderedCollection addLast: Semaphore new].
	self exit.
	anIntegerOrNil ifNil: [
		lock wait
	] ifNotNil: [
		delay := MonitorDelay signalLock: lock afterMSecs: anIntegerOrNil inMonitor: self queue: anOrderedCollection.
		lock wait.
		delay unschedule.
	].
	self enter.! !

!Monitor methodsFor: 'waiting-timeout' stamp: 'NS 7/1/2002 22:04'!
waitMaxMilliseconds: anIntegerOrNil
	"Same as Monitor>>wait, but the process gets automatically woken up when the 
	specified time has passed."

	^ self waitFor: nil maxMilliseconds: anIntegerOrNil! !

!Monitor methodsFor: 'private' stamp: 'NS 7/1/2002 13:17'!
waitInQueue: anOrderedCollection maxMilliseconds: anIntegerOrNil
	self exitAndWaitInQueue: anOrderedCollection maxMilliseconds: anIntegerOrNil.! !

!Monitor methodsFor: 'waiting-timeout' stamp: 'NS 7/1/2002 22:06'!
waitUntil: aBlock maxSeconds: aNumber
	"Same as Monitor>>waitUntil:, but the process gets automatically woken up when the 
	specified time has passed."

	^ self waitUntil: aBlock maxMilliseconds: (aNumber * 1000) asInteger! !

!Monitor methodsFor: 'private' stamp: 'NS 7/1/2002 13:17'!
waitWhile: aBlock inQueue: anOrderedCollection maxMilliseconds: anIntegerOrNil
	[aBlock value] whileTrue: [self exitAndWaitInQueue: anOrderedCollection maxMilliseconds: anIntegerOrNil].! !

!Monitor methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 10:08'!
initialize
	super initialize.
	mutex := Semaphore forMutualExclusion.
	queuesMutex := Semaphore forMutualExclusion.
	nestingLevel := 0.! !

!Monitor methodsFor: 'private' stamp: 'NS 7/1/2002 15:42'!
isOwnerProcess
	^ Processor activeProcess == ownerProcess! !

!Monitor methodsFor: 'waiting-timeout' stamp: 'NS 7/1/2002 22:05'!
waitUntil: aBlock maxMilliseconds: anIntegerOrNil
	"Same as Monitor>>waitUntil:, but the process gets automatically woken up when the 
	specified time has passed."

	^ self waitUntil: aBlock for: nil maxMilliseconds: anIntegerOrNil! !

!Monitor methodsFor: 'signaling-default' stamp: 'NS 7/1/2002 21:57'!
signal
	"One process waiting for the default event is woken up."

	^ self signal: nil! !

!Monitor methodsFor: 'signaling-specific' stamp: 'NS 4/13/2004 15:12'!
signal: aSymbolOrNil
	"One process waiting for the given event is woken up. If there is no process waiting 
	for this specific event, a process waiting for the default event gets resumed."

	| queue |
	self checkOwnerProcess.
	queue := self queueFor: aSymbolOrNil.
	queue isEmpty ifTrue: [queue := self defaultQueue].
	self signalQueue: queue.! !

!Monitor methodsFor: 'private' stamp: 'NS 4/13/2004 13:40'!
checkOwnerProcess
	self isOwnerProcess
		ifFalse: [self error: 'Monitor access violation'].! !

!Monitor methodsFor: 'waiting-timeout' stamp: 'NS 7/1/2002 22:06'!
waitWhile: aBlock maxMilliseconds: anIntegerOrNil
	"Same as Monitor>>waitWhile:, but the process gets automatically woken up when the 
	specified time has passed."

	^ self waitWhile: aBlock for: nil maxMilliseconds: anIntegerOrNil! !

!Monitor methodsFor: 'waiting-specific' stamp: 'NS 7/1/2002 21:58'!
waitFor: aSymbolOrNil
	"Unconditional waiting for the non-default event represented by the argument symbol.
	Same as Monitor>>wait, but the process gets only reactivated by the specific event and 
	not the default event."

	^ self waitFor: aSymbolOrNil maxMilliseconds: nil! !

!Monitor methodsFor: 'private' stamp: 'Lukas Renggli 11/2/2009 00:29'!
queueFor: aSymbol 
	aSymbol ifNil: [^self defaultQueue].
	^self queueDict at: aSymbol ifAbsentPut: [OrderedCollection new]! !

!Monitor methodsFor: 'private' stamp: 'NS 4/13/2004 16:34'!
signalLock: aSemaphore inQueue: anOrderedCollection
	queuesMutex critical: [
		aSemaphore signal.
		anOrderedCollection remove: aSemaphore ifAbsent: [].
	].! !

!Monitor methodsFor: 'private' stamp: 'NS 7/1/2002 15:06'!
defaultQueue
	defaultQueue ifNil: [defaultQueue := OrderedCollection new].
	^ defaultQueue! !

!Monitor methodsFor: 'waiting-specific' stamp: 'NS 7/1/2002 22:01'!
waitUntil: aBlock for: aSymbolOrNil
	"Confitional waiting for the non-default event represented by the argument symbol.
	See Monitor>>waitWhile:for: aBlock."

	^ self waitUntil: aBlock for: aSymbolOrNil maxMilliseconds: nil! !

!Monitor methodsFor: 'private' stamp: 'NS 4/13/2004 16:14'!
privateCleanup
	queuesMutex critical: [
		defaultQueue isEmpty ifTrue: [defaultQueue := nil].
		queueDict ifNotNil: [
			queueDict copy keysAndValuesDo: [:id :queue | 
				queue isEmpty ifTrue: [queueDict removeKey: id]].
			queueDict isEmpty ifTrue: [queueDict := nil].
		].
	].! !

!Monitor methodsFor: 'synchronization' stamp: 'nice 12/26/2009 00:10'!
critical: aBlock
	"Critical section.
	Executes aBlock as a critical section. At any time, only one process can be executing code 
	in a critical section.
	NOTE: All the following synchronization operations are only valid inside the critical section 
	of the monitor!!"

	^[
	self enter.
	aBlock value]
		ensure: [self exit].! !

!Monitor methodsFor: 'waiting-timeout' stamp: 'NS 7/1/2002 22:06'!
waitWhile: aBlock for: aSymbolOrNil maxMilliseconds: anIntegerOrNil
	"Same as Monitor>>waitWhile:for:, but the process gets automatically woken up when the 
	specified time has passed."

	self checkOwnerProcess.
	self waitWhile: aBlock inQueue: (self queueFor: aSymbolOrNil) maxMilliseconds: anIntegerOrNil.! !

!Monitor methodsFor: 'signaling-default' stamp: 'NS 7/1/2002 21:57'!
signalAll
	"All processes waiting for the default event are woken up."

	^ self signalAll: nil! !

!Monitor methodsFor: 'signaling-specific' stamp: 'NS 7/1/2002 22:02'!
signalReallyAll
	"All processes waiting for any events (default or specific) are woken up."

	self checkOwnerProcess.
	self signalAll.
	self queueDict valuesDo: [:queue |
		self signalAllInQueue: queue].! !

!Monitor methodsFor: 'waiting-specific' stamp: 'NS 7/1/2002 22:01'!
waitWhile: aBlock for: aSymbolOrNil
	"Confitional waiting for the non-default event represented by the argument symbol.
	Same as Monitor>>waitWhile:for:, but the process gets only reactivated by the specific 
	event and not the default event."

	^ self waitWhile: aBlock for: aSymbolOrNil maxMilliseconds: nil! !

!Monitor methodsFor: 'waiting-timeout' stamp: 'NS 7/1/2002 22:04'!
waitFor: aSymbolOrNil maxSeconds: aNumber
	"Same as Monitor>>waitFor:, but the process gets automatically woken up when the 
	specified time has passed."

	^ self waitFor: aSymbolOrNil maxMilliseconds: (aNumber * 1000) asInteger! !

!Monitor methodsFor: 'waiting-timeout' stamp: 'NS 7/1/2002 22:05'!
waitMaxSeconds: aNumber
	"Same as Monitor>>wait, but the process gets automatically woken up when the 
	specified time has passed."

	^ self waitMaxMilliseconds: (aNumber * 1000) asInteger! !

!Monitor methodsFor: 'waiting-basic' stamp: 'NS 7/1/2002 21:56'!
waitUntil: aBlock
	"Conditional waiting for the default event.
	See Monitor>>waitWhile: aBlock."

	^ self waitUntil: aBlock for: nil! !

!Monitor methodsFor: 'waiting-timeout' stamp: 'NS 7/1/2002 22:05'!
waitUntil: aBlock for: aSymbolOrNil maxMilliseconds: anIntegerOrNil
	"Same as Monitor>>waitUntil:for:, but the process gets automatically woken up when the 
	specified time has passed."

	^ self waitWhile: [aBlock value not] for: aSymbolOrNil maxMilliseconds: anIntegerOrNil! !

!Monitor methodsFor: 'signaling-specific' stamp: 'NS 7/1/2002 22:02'!
signalAll: aSymbolOrNil
	"All process waiting for the given event or the default event are woken up."

	| queue |
	self checkOwnerProcess.
	queue := self queueFor: aSymbolOrNil.
	self signalAllInQueue: self defaultQueue.
	queue ~~ self defaultQueue ifTrue: [self signalAllInQueue: queue].! !

!Monitor methodsFor: 'waiting-basic' stamp: 'NS 7/1/2002 21:55'!
wait
	"Unconditional waiting for the default event.
	The current process gets blocked and leaves the monitor, which means that the monitor
	allows another process to execute critical code. When the default event is signaled, the
	original process is resumed."

	^ self waitMaxMilliseconds: nil! !

!Monitor methodsFor: 'private' stamp: 'NS 4/13/2004 13:38'!
exit
	nestingLevel := nestingLevel - 1.
	nestingLevel < 1 ifTrue: [
		ownerProcess := nil.
		mutex signal
	].! !

!Monitor methodsFor: 'private' stamp: 'StephaneDucasse 10/19/2010 14:05'!
signalAllInQueue: anOrderedCollection
	 queuesMutex critical: [
		anOrderedCollection removeAllSuchThat: [ :each |
				each signal.
				true ] ]! !

!Monitor methodsFor: 'private' stamp: 'StephaneDucasse 10/19/2010 14:03'!
signalQueue: anOrderedCollection
	queuesMutex critical: [
	 anOrderedCollection isEmpty ifFalse: [
			anOrderedCollection removeFirst signal ] ]! !

!Monitor methodsFor: 'private' stamp: 'NS 4/13/2004 13:37'!
enter
	self isOwnerProcess ifTrue: [
		nestingLevel := nestingLevel + 1.
	] ifFalse: [
		mutex wait.
		ownerProcess := Processor activeProcess.
		nestingLevel := 1.
	].! !

!MonitorDelay commentStamp: 'NS 4/13/2004 16:51'!
This is a specialization of the class Delay that is used for the implementation of the class Monitor.!
!MonitorDelay methodsFor: 'private' stamp: 'BenComan 3/1/2015 10:46'!
schedulerSignalWaitingProcess
	"The delay time has elapsed; signal the waiting process."

	beingWaitedOn := false.
	monitor signalLock: delaySemaphore inQueue: queue.
! !

!MonitorDelay methodsFor: 'private' stamp: 'NS 4/13/2004 16:26'!
setDelay: anInteger forSemaphore: aSemaphore monitor: aMonitor queue: anOrderedCollection
	monitor := aMonitor.
	queue := anOrderedCollection.
	self setDelay: anInteger forSemaphore: aSemaphore.! !

!MonitorDelay class methodsFor: 'instance creation' stamp: 'JurajKubelka 2/25/2015 10:01'!
signalLock: aSemaphore afterMSecs: anInteger inMonitor: aMonitor queue: anOrderedCollection
	anInteger < 0 ifTrue: [self error: 'delay times cannot be negative'].
	^ (self new setDelay: anInteger forSemaphore: aSemaphore monitor: aMonitor queue: anOrderedCollection) schedule; yourself! !

!MonitorTest commentStamp: 'TorstenBergmann 2/5/2014 08:41'!
SUnit tests for monitors!
!MonitorTest methodsFor: 'examples' stamp: 'md 3/19/2006 21:15'!
testExample1

	| producer1 producer2  monitor goal work counter goalReached finished |
	goal := (1 to: 1000) asOrderedCollection.
	work := OrderedCollection new.
	counter := 0.
	goalReached := false.
	finished := Semaphore new.
	monitor := Monitor new.

	producer1 := [
       [monitor critical:
             [monitor waitUntil: [counter \\5 = 0].
              goalReached or: [work add: (counter := counter + 1)].
              goalReached := counter >= goal size.
              monitor signal
            ].
           goalReached
          ]
             whileFalse.
         finished signal.
	].

	producer2 := [
         [monitor critical:
                [monitor waitWhile: [counter \\5 = 0].
                 goalReached or: [work add: (counter := counter + 1)].
                 goalReached := counter >= goal size.
                 monitor signal].
         goalReached
       ] whileFalse.
     finished signal
	].

	producer1 forkAt: Processor userBackgroundPriority.
	producer2 forkAt: Processor userBackgroundPriority.

	finished wait; wait.
	self assert: goal = work! !

!MonitorTest methodsFor: 'examples' stamp: 'md 3/19/2006 21:19'!
testExample2
	"Here is a second version that does not use a semaphore to inform the 
	forking process about termination of both forked processes"

	| producer1 producer2  monitor goal work counter goalReached activeProducers|
	goal := (1 to: 1000) asOrderedCollection.
	work := OrderedCollection new.
	counter := 0.
	goalReached := false.
	activeProducers := 0.
	monitor := Monitor new.

  producer1 :=
      [ monitor critical: [activeProducers := activeProducers + 1].
  [monitor critical:
            [monitor waitUntil: [counter \\5 = 0].
      goalReached or: [work add: (counter := counter + 1)].
     " Transcript show: 'P1  '; show: counter printString; show: '  ';
       show: activeProducers printString; cr."
      goalReached := counter >= goal size.
      monitor signal
            ].
           goalReached
          ]
             whileFalse.
         monitor critical: [activeProducers := activeProducers - 1.
        monitor signal: #finish].
 ] .

 producer2 :=
    [monitor critical: [activeProducers := activeProducers + 1].

  [monitor critical:
          [monitor waitWhile: [counter \\5 = 0].
    goalReached or: [work add: (counter := counter + 1)].
    goalReached := counter >= goal size.
    monitor signal].
         goalReached ] whileFalse.
     monitor critical: [
		activeProducers := activeProducers - 1. 
		monitor signal: #finish].
	].

	producer1 forkAt: Processor userBackgroundPriority.
	producer2  forkAt: Processor userBackgroundPriority.


	monitor critical: [
		monitor waitUntil: [activeProducers = 0 & (goalReached)]
				for: #finish.
  	].

	self assert: goal = work
! !

!MonitorTest methodsFor: 'tests' stamp: 'JurajKubelka 2/25/2015 10:02'!
testWaitMaxMilliseconds
	| monitor |
	monitor := Monitor new.
	monitor critical: [ monitor waitMaxMilliseconds: 10 ].! !

!Month commentStamp: 'brp 5/13/2003 09:48'!
I represent a month.!
!Month methodsFor: 'accessing' stamp: 'brp 5/13/2003 09:05'!
previous 

	^ self class starting: (self start - 1) ! !

!Month methodsFor: 'conversion' stamp: 'brp 5/13/2003 09:04'!
asMonth

	^ self ! !

!Month methodsFor: 'testing' stamp: 'brp 5/13/2003 09:05'!
name 

	^ self monthName ! !

!Month methodsFor: 'accessing' stamp: 'brp 5/13/2003 09:05'!
daysInMonth

	^ self duration days.! !

!Month methodsFor: 'printing' stamp: 'brp 5/13/2003 09:05'!
printOn: aStream 

	aStream nextPutAll: self monthName, ' ', self year printString.! !

!Month methodsFor: 'accessing' stamp: 'brp 5/13/2003 09:05'!
index

	^ self monthIndex ! !

!Month class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/22/2013 19:41'!
month: month
	"Create a Month in the current year for the given <month>.
	<month> may be a number or a String with the name of the month."

	^ self 
		year: DateAndTime now year
		month: month
! !

!Month class methodsFor: 'accessing' stamp: 'brp 5/13/2003 09:02'!
nameOfMonth: anIndex

	^ MonthNames at: anIndex.! !

!Month class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/22/2013 19:42'!
readFrom: aStream

	| m y c |
	m := (ReadWriteStream with: '') reset.
	[(c := aStream next) isSeparator] whileFalse: [m nextPut: c].
	[(c := aStream next) isSeparator] whileTrue.
	y := (ReadWriteStream with: '') reset.
	y nextPut: c.
	[aStream atEnd] whileFalse: [y nextPut: aStream next].

	^ self 
		year: y contents asNumber
		month: (Month indexOfMonth: m contents)

"Month readFrom: 'July 1998' readStream"
! !

!Month class methodsFor: 'accessing' stamp: 'brp 7/27/2003 16:27'!
daysInMonth: indexOrName forYear: yearInteger 

	| index |
	index := indexOrName isInteger 
				ifTrue: [indexOrName]
				ifFalse: [self indexOfMonth: indexOrName].
	^ (DaysInMonth at: index)
			+ ((index = 2
					and: [Year isLeapYear: yearInteger])
						ifTrue: [1] ifFalse: [0])! !

!Month class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/22/2013 18:53'!
starting: aDateAndTime duration: aDuration 
	"Override - a each month has a defined duration"
	| start adjusted days |
	start := aDateAndTime asDateAndTime.
	adjusted := DateAndTime
				year: start year
				month: start month
				day: 1.
	days := self 
		daysInMonth: adjusted month 
		forYear: adjusted year.
	^ super
		starting: adjusted
		duration: (Duration days: days)! !

!Month class methodsFor: 'accessing' stamp: 'brp 8/23/2003 09:29'!
indexOfMonth: aMonthName 

	1 to: 12 do: [ :i |  (aMonthName, '*' match: (MonthNames at: i)) ifTrue: [^i] ].
 	self error: aMonthName , ' is not a recognized month name'.! !

!Month class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/22/2013 18:50'!
current
	^ self starting: DateAndTime now! !

!Month class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/22/2013 19:37'!
year: year month: month
	"Create a Month for the given <year> and <month>.
	<month> may be a number or a String with the
	name of the month. <year> should be with 4 digits."

	^ self starting: (DateAndTime year: year month: month day: 1)
! !

!Month class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/22/2013 19:37'!
month: month year: year
	^ self year: year month: month! !

!MonthTest commentStamp: 'brp 7/26/2003 22:44'!
This is the unit test for the class Month.
!
!MonthTest methodsFor: 'tests' stamp: 'brp 8/23/2003 16:08'!
testInquiries

	self 
		assert: month index = 7;
		assert: month name = #July;
		assert: month duration = (31 days).
! !

!MonthTest methodsFor: 'tests' stamp: 'CamilloBruni 8/22/2013 19:42'!
testInstanceCreation
	| m1 m2 |
	m1 := Month starting:  '4 July 1998' asDate.
	m2 := Month year: 1998 month: #July .
	self
		assert: month = m1;
		assert: month = m2! !

!MonthTest methodsFor: 'coverage' stamp: 'brp 7/26/2003 23:29'!
selectorsToBeIgnored

	| deprecated private special |
	deprecated := #().
	private := #( #printOn: ).
	special := #( #next ).

	^ super selectorsToBeIgnored, deprecated, private, special.! !

!MonthTest methodsFor: 'running' stamp: 'brp 8/6/2003 19:37'!
tearDown

	super tearDown.
	month := nil.! !

!MonthTest methodsFor: 'coverage' stamp: 'brp 7/27/2003 12:42'!
classToBeTested

	^ Month! !

!MonthTest methodsFor: 'tests' stamp: 'brp 7/26/2003 22:46'!
testReadFrom

	| m |
	m := Month readFrom: 'July 1998' readStream.
	self 
		assert: m = month! !

!MonthTest methodsFor: 'running' stamp: 'CamilloBruni 8/22/2013 19:42'!
setUp

	super setUp.
	month := Month year: 1998 month: 7.! !

!MonthTest methodsFor: 'tests' stamp: 'brp 1/30/2005 09:35'!
testEnumerating
	| weeks |
	weeks := OrderedCollection new.
	month weeksDo: [ :w | weeks add: w start ].
	0 to: 4 do: [ :i | weeks remove: (Week starting:  ('29 June 1998' asDate addDays: i * 7)) start ].
	self assert: weeks isEmpty! !

!MonthTest methodsFor: 'tests' stamp: 'brp 7/26/2003 23:02'!
testPreviousNext
	| n p |
	n := month next.
	p := month previous.

	self
		assert: n year = 1998;
		assert: n index = 8;
		assert: p year = 1998;
		assert: p index = 6.

! !

!MonthTest methodsFor: 'tests' stamp: 'brp 7/26/2003 22:50'!
testPrinting

	self 
		assert: month printString = 'July 1998'.
! !

!MonthTest methodsFor: 'tests' stamp: 'StephaneDucasse 6/9/2012 22:57'!
testIndexOfMonth
	"self debug: #testIndexOfMonth"
       | m |
       m := #(#January #February #March #April #May #June #July #August
#September #October #November #December).

       m withIndexDo: [:item :index | self assert: (Month indexOfMonth:
item) = index].

       self should: [Month indexOfMonth: 1] raise: self defaultTestError.
       self should: [Month indexOfMonth: #Marsh] raise: self defaultTestError.
"notice the misspell!!!!"
       self should: [Month indexOfMonth: #UnexistingMonth] raise:
 self defaultTestError.! !

!MonthTest methodsFor: 'tests' stamp: 'brp 7/26/2003 22:52'!
testConverting

	self assert: month asDate = '1 July 1998' asDate! !

!MonthTest methodsFor: 'tests' stamp: 'StephaneDucasse 6/9/2012 22:56'!
testNameOfMonth

       | m |
       m := #(#January #February #March #April #May #June #July #August
#September #October #November #December).

       m withIndexDo: [:item :index | self assert: (Month nameOfMonth:
index) = item].

       self should: [Month nameOfMonth: 0] raise: self defaultTestError.
       self should: [Month nameOfMonth: 13] raise: self defaultTestError.
       self should: [Month nameOfMonth: #January] raise: self defaultTestError.! !

!MonticelloRepositoryBrowser commentStamp: '<historical>'!
MonticelloRepositoryBrowser example!
!MonticelloRepositoryBrowser methodsFor: 'accessing' stamp: 'StephaneDucasse 4/17/2012 18:04'!
workingCopies

	^ workingCopies! !

!MonticelloRepositoryBrowser methodsFor: 'initialization' stamp: 'StephaneDucasse 4/17/2012 18:06'!
initialExtent

	^ 600@200! !

!MonticelloRepositoryBrowser methodsFor: 'accessing' stamp: 'StephaneDucasse 6/2/2012 20:29'!
allManagers

	^ self class allManagers 
	! !

!MonticelloRepositoryBrowser methodsFor: 'menu' stamp: 'StephaneDucasse 4/17/2012 18:35'!
orderSpecs
	^ {
		'Sort alphabetically' -> [ :a :b | a package name <= b package name ].
		'Sort dirty first' -> [ :a :b | 
			a needsSaving = b needsSaving
				ifTrue: [ a package name <= b package name ]
				ifFalse: [ a needsSaving ] ].
		'Sort dirty last' -> [ :a :b | 
			a needsSaving = b needsSaving
				ifTrue: [ a package name <= b package name ]
				ifFalse: [ b needsSaving ] ].
		'Only dirty' -> [ :a :b | a package name <= b package name ]}! !

!MonticelloRepositoryBrowser methodsFor: 'private' stamp: 'StephaneDucasse 4/17/2012 19:11'!
defaultOrderingBlock

	^ (self orderSpecs at: self class order) value! !

!MonticelloRepositoryBrowser methodsFor: 'menu' stamp: 'StephaneDucasse 6/2/2012 20:29'!
workingCopiesFromMC
	^ (self orderSpecs size = order
		ifTrue: [ self allManagers select: [ :each | each modified ] ]
		ifFalse: [ self allManagers ])
			asSortedCollection: (self orderSpecs at: order) value.! !

!MonticelloRepositoryBrowser methodsFor: 'private' stamp: 'StephaneDucasse 4/17/2012 18:20'!
repositoriesOfWorkingCopy: aWorkingCopy
	
	^ aWorkingCopy isNil
		ifFalse: [ aWorkingCopy repositoryGroup repositories]
		ifTrue: [ self allRepositories]	! !

!MonticelloRepositoryBrowser methodsFor: 'menu' stamp: 'StephaneDucasse 10/27/2014 09:34'!
workingCopiesMenu: aMenu


	aMenu target: self;
		add: 'Browse working copy' selector: #browseWorkingCopy.

	1 to: self orderSpecs size do: [ :index | 
		aMenu
			addUpdating: #orderString:
			target: self
			selector: #order:
			argumentList: {index} ].
	^ aMenu! !

!MonticelloRepositoryBrowser methodsFor: 'accessing' stamp: 'StephaneDucasse 4/19/2012 18:20'!
workingCopy
	^ workingCopies selectedItem! !

!MonticelloRepositoryBrowser methodsFor: 'menu' stamp: 'StephaneDucasse 4/17/2012 18:49'!
order

	^ order! !

!MonticelloRepositoryBrowser methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 9/25/2013 18:24'!
initializeWidgets

	self instantiateModels: #(
		repositories  #ListModel
		workingCopies  #ListModel).
		
	workingCopies sortingBlock: self defaultOrderingBlock.
	workingCopies displayBlock: [ :item | item description ].
	workingCopies menu: [ :aMenu | self workingCopiesMenu: aMenu ].
		
	repositories displayBlock: [ :item | item description ].
	repositories items: self allRepositories.

	"so that when we tab we go from working copies to repositories"
	self focusOrder
		add: workingCopies;
		add: repositories! !

!MonticelloRepositoryBrowser methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 22:57'!
initialize

	super initialize.
	order := self class order! !

!MonticelloRepositoryBrowser methodsFor: 'actions' stamp: 'StephaneDucasse 4/19/2012 18:19'!
openRepository
	self repository ifNotNil: [:repos | repos morphicOpen: self workingCopy ]! !

!MonticelloRepositoryBrowser methodsFor: 'menu' stamp: 'SD 4/19/2012 16:16'!
order: anInteger

	order := anInteger.
	self workingCopies sortingBlock: (self orderSpecs at: order) value.
	self order = 4 "dirty only"
		ifTrue: [self workingCopies filteringBlock: [:col | col select: #modified]]
		ifFalse: [self workingCopies resetFilteringBlock]. ! !

!MonticelloRepositoryBrowser methodsFor: 'private' stamp: 'StephaneDucasse 4/17/2012 18:31'!
allRepositories

	^ MCRepositoryGroup default repositories! !

!MonticelloRepositoryBrowser methodsFor: 'accessing' stamp: 'StephaneDucasse 4/17/2012 18:04'!
repositories

	^ repositories! !

!MonticelloRepositoryBrowser methodsFor: 'actions' stamp: 'StephaneDucasse 4/19/2012 18:21'!
newRepository
	| types index |
	types := MCRepository allConcreteSubclasses asArray.
	index := UIManager default chooseFrom: (types collect: [:ea | ea description])
				title: 'Repository type:'.
	^ index = 0 ifFalse: [(types at: index) morphicConfigure]! !

!MonticelloRepositoryBrowser methodsFor: 'api' stamp: 'SD 4/19/2012 16:12'!
workingCopies: aCollection
	"Set the value of the list widget"
	
	workingCopies items: aCollection ! !

!MonticelloRepositoryBrowser methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 6/12/2012 18:41'!
initializePresenter

	workingCopies whenSelectedItemChanged: 
			[ :item | repositories items: (self repositoriesOfWorkingCopy: item) ].! !

!MonticelloRepositoryBrowser methodsFor: 'actions' stamp: 'StephaneDucasse 4/19/2012 18:20'!
browseWorkingCopy
	| workingCopy |
	workingCopy := self workingCopy.
	workingCopy
		ifNotNil: [ 
			(MCSnapshotBrowser forSnapshot: workingCopy completeSnapshot)
				label: 'Snapshot Browser: ' , workingCopy packageName;
				show ]! !

!MonticelloRepositoryBrowser methodsFor: 'menu' stamp: 'StephaneDucasse 4/17/2012 18:48'!
orderString: anIndex
	^ String streamContents: [ :stream |
		order = anIndex
			ifTrue: [ stream nextPutAll: '<yes>' ]
			ifFalse: [ stream nextPutAll: '<no>' ].
		stream nextPutAll: (self orderSpecs at: anIndex) key ]! !

!MonticelloRepositoryBrowser class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 9/27/2013 10:48'!
defaultSpec

	^ {
		#ContainerModel.
			#add: . {{#model . #workingCopies} . 
					#layout: . #(FrameLayout
									rightFraction: 0.5)} . 
			#add: . {{#model . #repositories } . 
					#layout: . #(FrameLayout
									leftFraction: 0.5)}
		}! !

!MonticelloRepositoryBrowser class methodsFor: 'utils' stamp: 'StephaneDucasse 4/17/2012 18:42'!
order: anInteger
	Order := anInteger! !

!MonticelloRepositoryBrowser class methodsFor: 'utils' stamp: 'StephaneDucasse 6/2/2012 20:29'!
allManagers 

	^ MCWorkingCopy allManagers ! !

!MonticelloRepositoryBrowser class methodsFor: 'utils' stamp: 'StephaneDucasse 4/17/2012 18:41'!
order
	^ Order ifNil: [ Order := 1 ]! !

!MonticelloRepositoryBrowser class methodsFor: 'example' stamp: 'StephaneDucasse 6/2/2012 20:29'!
example
	"self example"
	
	self new 
		openWithSpec ; 
		workingCopies: (self allManagers)! !

!MonticelloRepositoryBrowser class methodsFor: 'spec' stamp: 'StephaneDucasse 4/17/2012 18:07'!
title

	^ 'Monticello Browser'! !

!Morph commentStamp: 'efc 2/26/2003 20:01'!
A Morph (from the Greek "shape" or "form") is an interactive graphical object. General information on the Morphic system can be found at http://minnow.cc.gatech.edu/squeak/30. 

Morphs exist in a tree, rooted at a World (generally a PasteUpMorph). The morphs owned by a morph are its submorphs. Morphs are drawn recursively; if a Morph has no owner it never gets drawn. To hide a Morph and its submorphs, set its #visible property to false using the #visible: method. 

The World (screen) coordinate system is used for most coordinates, but can be changed if there is a TransformMorph somewhere in the owner chain. 

My instance variables have accessor methods (e.g., #bounds, #bounds:). Most users should use the accessor methods instead of using the instance variables directly.

Structure:
instance var 	Type 			Description 
bounds 			Rectangle 		A Rectangle indicating my position and a size that will enclose 									me. 
owner 			Morph		 	My parent Morph, or nil for the top-level Morph, which is a
 				or nil			world, typically a PasteUpMorph.
submorphs 		Array 			My child Morphs. 
fullBounds 		Rectangle 		A Rectangle minimally enclosing me and my submorphs. 
color 			Color 			My primary color. Subclasses can use this in different ways. 
extension 		MorphExtension Allows extra properties to be stored without adding a
				or nil  				storage burden to all morphs. 

By default, Morphs do not position their submorphs. Morphs may position their submorphs directly or use a LayoutPolicy to automatically control their submorph positioning.

Although Morph has some support for BorderStyle, most users should use BorderedMorph if they want borders.!
!Morph methodsFor: 'submorphs-accessing' stamp: 'ar 9/9/2000 17:31'!
morphsInFrontOverlapping: aRectangle do: aBlock
	"Evaluate aBlock with all top-level morphs in front of someMorph that overlap with the given rectangle."
	^self morphsInFrontOf: nil overlapping: aRectangle do: aBlock! !

!Morph methodsFor: 'text-anchor' stamp: 'StephaneDucasse 4/22/2012 16:50'!
hasDocumentAnchorString
	^ (self textAnchorType == #document) ->  'Document' translated! !

!Morph methodsFor: 'submorphs-accessing' stamp: ''!
submorphCount

	^ submorphs size! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/25/2008 17:35'!
mouseWheel: evt 
	"Handle a mouseWheel event."! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'GaryChambers 12/2/2011 12:00'!
basicTheme: aUITheme
	"Set the current theme for the receiver."

	self theme = aUITheme ifFalse: [
		self setProperty: #theme toValue: aUITheme]! !

!Morph methodsFor: 'testing' stamp: 'ar 12/3/2001 12:33'!
shouldDropOnMouseUp
	| former |
	former := self formerPosition ifNil:[^false].
	^(former dist: self position) > 10! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'LC 9/28/1999 19:12'!
findDeepSubmorphThat: block1 ifAbsent: block2 
	self
		allMorphsDo: [:m | (block1 value: m)
				== true ifTrue: [^ m]].
	^ block2 value! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'ar 9/9/2000 17:31'!
morphsInFrontOf: someMorph overlapping: aRectangle do: aBlock
	"Evaluate aBlock with all top-level morphs in front of someMorph that overlap with the given rectangle. someMorph is either an immediate child of the receiver or nil (in which case all submorphs of the receiver are enumerated)."
	self submorphsDo:[:m|
		m == someMorph ifTrue:["Try getting out quickly"
			owner ifNil:[^self].
			^owner morphsInFrontOf: self overlapping: aRectangle do: aBlock].
		(m fullBoundsInWorld intersects: aRectangle)
			ifTrue:[aBlock value: m]].
	owner ifNil:[^self].
	^owner morphsInFrontOf: self overlapping: aRectangle do: aBlock.! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 20:03'!
vResizing: aSymbol
	"Layout specific. This property describes how the receiver should be resized with respect to its owner and its children. Possible values are:
		#rigid			-	do not resize the receiver
		#spaceFill		-	resize to fill owner's available space
		#shrinkWrap	- resize to fit children
	"
	self assureLayoutProperties vResizing: aSymbol.
	self layoutChanged.
! !

!Morph methodsFor: 'halos and balloon help' stamp: 'sd 12/5/2001 20:30'!
balloonFont: aFont 
	^ self setProperty: #balloonFont toValue: aFont! !

!Morph methodsFor: 'menus' stamp: 'StephaneDucasse 4/22/2012 16:53'!
lockedString
	"Answer the string to be shown in a menu to represent the 'locked' status"
	^ (self isLocked) -> 'be locked' translated! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'panda 4/28/2000 10:53'!
highlightedForDrop
	^(self valueOfProperty: #highlightedForDrop) == true! !

!Morph methodsFor: 'meta-actions' stamp: 'yo 3/15/2005 14:45'!
blueButtonDown: anEvent
	"Special gestures (cmd-mouse on the Macintosh; Alt-mouse on Windows and Unix) allow a mouse-sensitive morph to be moved or bring up a halo for the morph."
	| h tfm doNotDrag |
	h := anEvent hand halo.
	"Prevent wrap around halo transfers originating from throwing the event back in"
	doNotDrag := false.
	h ifNotNil:[
		(h innerTarget == self) ifTrue:[doNotDrag := true].
		(h innerTarget hasOwner: self) ifTrue:[doNotDrag := true].
		(self hasOwner: h target) ifTrue:[doNotDrag := true]].

	tfm := (self transformedFrom: nil) inverseTransformation.

	"cmd-drag on flexed morphs works better this way"
	h := self addHalo: (anEvent transformedBy: tfm).
	h ifNil: [^ self].
	doNotDrag ifTrue:[^self].
	"Initiate drag transition if requested"
	anEvent hand 
		waitForClicksOrDrag: h
		event: (anEvent transformedBy: tfm)
		selectors: { nil. nil. nil. #dragTarget:. }
		threshold: 5.
	"Pass focus explicitly here"
	anEvent hand newMouseFocus: h.! !

!Morph methodsFor: 'rotate scale and flex' stamp: 'AlainPlantec 5/8/2010 00:33'!
removeFlexShell
	self isFlexed ifTrue: [self owner removeFlexShell]! !

!Morph methodsFor: 'halos and balloon help' stamp: 'AlainPlantec 5/7/2010 23:29'!
addOptionalHandlesTo: aHalo box: box
! !

!Morph methodsFor: 'events-processing' stamp: 'EstebanLorenzano 12/23/2014 17:26'!
defaultEventDispatcher
	"Return the default event dispatcher to use with events that are directly sent to the receiver"
 	^ self class defaultEventDispatcher! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'dgd 8/31/2004 16:53'!
dockingBars
	"Answer the receiver's dockingBars"
	^ self submorphs
		select: [:each | each isDockingBar]
! !

!Morph methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 11/28/2012 00:58'!
simulateKeyStroke: aCharacter
	| event |

	event := KeyboardEvent new 
				setType: #keystroke 
				buttons: 0 
				position: 0@0 
				keyValue: aCharacter charCode 
				charCode: aCharacter charCode
				hand: ActiveHand 
				stamp: 0.
	self keyStroke: event! !

!Morph methodsFor: 'structure' stamp: 'dgd 2/22/2003 19:05'!
isInWorld
	"Return true if this morph is in a world."

	^self world notNil! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'dgd 2/22/2003 14:32'!
hasSubmorphs
	^submorphs notEmpty! !

!Morph methodsFor: 'geometry' stamp: 'IgorStasenko 12/22/2012 03:13'!
overlapsShadowForm: itsShadow bounds: itsBounds
	"Answer true if itsShadow and my shadow overlap at all"
	| andForm overlapExtent |
	overlapExtent := (itsBounds intersect: self fullBounds ifNone: [ ^ false ]) extent.
	overlapExtent > (0 @ 0)
		ifFalse: [^ false].
	andForm := self shadowForm.
	overlapExtent ~= self fullBounds extent
		ifTrue: [andForm := andForm
						contentsOfArea: (0 @ 0 extent: overlapExtent)].
	andForm := andForm
				copyBits: (self fullBounds translateBy: itsShadow offset negated)
				from: itsShadow
				at: 0 @ 0
				clippingBox: (0 @ 0 extent: overlapExtent)
				rule: Form and
				fillColor: nil.
	^ andForm bits
		anySatisfy: [:w | w ~= 0]! !

!Morph methodsFor: 'geometry' stamp: 'di 7/24/97 11:55'!
align: aPoint1 with: aPoint2
	"Translate by aPoint2 - aPoint1."

	^ self position: self position + (aPoint2 - aPoint1)! !

!Morph methodsFor: 'layout-properties' stamp: 'md 2/27/2006 09:59'!
layoutFrame
	"Layout specific. Return the layout frame describing where the  
	receiver should appear in a proportional layout"
	^ extension ifNotNil: [extension layoutFrame]! !

!Morph methodsFor: 'rounding' stamp: 'MarcusDenker 10/26/2011 14:58'!
useRoundedCorners
	self cornerStyle: #rounded! !

!Morph methodsFor: 'events-processing' stamp: 'CamilleTeruel 12/6/2013 14:36'!
handleUnknownEvent: anEvent
	"An event of an unknown type was sent to the receiver. What shall we do?!!"
	self inform: 'Unknown event: ', anEvent printString. 
	anEvent printString displayAt: 0@0.
	anEvent wasHandled: true.! !

!Morph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/6/2015 19:32'!
drawOnAthensCanvas: anAthensCanvas 
	| border |
	border := self borderStyle. 
	anAthensCanvas setPaint: self fillStyle.
	anAthensCanvas drawShape: self bounds.
	
	"Fill the given rectangle."
	anAthensCanvas drawShape: (self bounds insetBy: border width).

	(anAthensCanvas setStrokePaint: border).
	anAthensCanvas drawShape: (self bounds insetBy: (border width /2 asFloat)).
	

	"aBorderStyle frameRectangle: aRectangle on: self "
	
	! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/11/2007 14:29'!
focusBounds
	"Answer the bounds for drawing the focus indication."

	^self bounds! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'MarcusDenker 12/11/2009 07:40'!
navigateFocusForward
	"Change the keyboard focus to the next morph."

	self nextMorphWantingFocus ifNotNil: [:m |
		m takeKeyboardFocus]
	! !

!Morph methodsFor: '*Spec-MorphicAdapters' stamp: 'BenjaminVanRyseghem 11/23/2013 21:17'!
setModal: aSystemWindow
	|area mySysWin keyboardFocus|

	keyboardFocus := self activeHand keyboardFocus.
	mySysWin := self isSystemWindow ifTrue: [self] ifFalse: [self ownerThatIsA: SystemWindow].
	mySysWin ifNil: [mySysWin := self].
	mySysWin modalLockTo: aSystemWindow.
	area := RealEstateAgent maximumUsableArea.
	aSystemWindow extent: aSystemWindow initialExtent.
	aSystemWindow position = (0@0)
		ifTrue: [aSystemWindow
				position: self activeHand position - (aSystemWindow extent // 2)].
	aSystemWindow
		bounds: (aSystemWindow bounds translatedToBeWithin: area).
	[ |aWidget | 
	aWidget := aSystemWindow.
	[aWidget world notNil] whileTrue: [
		aWidget outermostWorldMorph doOneCycle]]
		ensure: [mySysWin modalUnlockFrom: aSystemWindow.
				self activeHand newKeyboardFocus: keyboardFocus].
	^aSystemWindow! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 2/15/2009 13:35'!
shadowOffsetRectangle
	"Answer a rectangle describing the offsets to the
	receiver's bounds for a drop shadow."

	^self shadowOffset negated corner: self shadowOffset! !

!Morph methodsFor: 'stepping and presenter' stamp: 'ar 2/12/2001 17:04'!
step
	"Do some periodic activity. Use startStepping/stopStepping to start and stop getting sent this message. The time between steps is specified by this morph's answer to the stepTime message.  The generic version dispatches control to the player, if any.  The nasty circumlocation about owner's transformation is necessitated by the flexing problem that the player remains in the properties dictionary both of the flex and the real morph.  In the current architecture, only the top renderer's pointer to the player should actually be honored for the purpose of firing."
! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'GuillermoPolito 5/3/2012 21:05'!
delete
	"Remove the receiver as a submorph of its owner and make its 
	new owner be nil."
	
	self removeHalo.
	self activeHand 
		releaseKeyboardFocus: self;
		releaseMouseFocus: self.
	owner ifNotNil:[ 
		self privateDelete.
		self announceDeleted.
	].! !

!Morph methodsFor: '*Keymapping-Core' stamp: 'GuillermoPolito 8/6/2013 16:23'!
allowsKeymapping: aBoolean

	^ self setProperty: #allowsKeymapping toValue: aBoolean! !

!Morph methodsFor: 'events-processing' stamp: 'gvc 1/25/2008 17:34'!
handlesMouseWheel: evt
	"Do I want to receive mouseWheel events?." 

	^false! !

!Morph methodsFor: 'text-anchor' stamp: 'aoy 2/15/2003 21:48'!
changeParagraphAnchor
	"Change the anchor from/to paragraph anchoring"

	| newType |
	newType := self textAnchorType == #paragraph 
		ifTrue: [#document]
		ifFalse: [#paragraph].
	owner isTextMorph 
		ifTrue: 
			[owner 
				anchorMorph: self
				at: self position
				type: newType]! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'sw 9/28/2001 08:39'!
actWhen
	"Answer when the receiver, probably being used as a button, should have its action triggered"

	^ self valueOfProperty: #actWhen ifAbsentPut: [#buttonDown]! !

!Morph methodsFor: 'stepping and presenter' stamp: 'ar 12/15/2000 00:00'!
stopStepping
	"Stop getting sent the 'step' message."

	| w |
	w := self world.
	w ifNotNil: [w stopStepping: self].
! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'ar 10/5/2000 18:13'!
formerPosition
	^self valueOfProperty: #formerPosition! !

!Morph methodsFor: 'testing' stamp: 'AlainPlantec 5/5/2010 17:55'!
isFlexed
	"Return true if the receiver is currently flexed"
	^ owner notNil and: [owner isFlexMorph]! !

!Morph methodsFor: 'geometry' stamp: 'ar 10/25/2000 15:01'!
point: aPoint from: aReferenceMorph

	owner ifNil: [^ aPoint].
	^ (owner transformFrom: aReferenceMorph) globalPointToLocal: aPoint.
! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'sw 9/25/2001 10:23'!
actWhen: aButtonPhase
	"Set the receiver's actWhen trait"

	self setProperty: #actWhen toValue: aButtonPhase! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 20:03'!
wrapCentering: aSymbol
	"Layout specific. This property describes how the rows/columns in a list-like layout should be centered.
		#topLeft - center at start of secondary direction
		#bottomRight - center at end of secondary direction
		#center - center in the middle of secondary direction
		#justified - insert extra space inbetween rows/columns
	"
	self assureTableProperties wrapCentering: aSymbol.
	self layoutChanged.! !

!Morph methodsFor: 'layout' stamp: 'ar 11/12/2000 23:10'!
layoutBounds
	"Return the bounds for laying out children of the receiver"
	| inset box |
	inset := self layoutInset.
	box := self innerBounds.
	inset isZero ifTrue:[^box].
	^box insetBy: inset.! !

!Morph methodsFor: '*Morphic-Base' stamp: 'nk 8/28/2003 15:56'!
defaultBitmapFillForm
	^ImageMorph defaultForm.
! !

!Morph methodsFor: 'copying' stamp: 'tk 2/3/2001 14:29'!
veryDeepFixupWith: deepCopier
	"If some fields were weakly copied, fix new copy here."

	"super veryDeepFixupWith: deepCopier.	Object has no fixups, so don't call it"

	"If my owner is being duplicated too, then store his duplicate.
	 If I am owned outside the duplicated tree, then I am no longer owned!!"
	owner := deepCopier references at: owner ifAbsent: [nil].

! !

!Morph methodsFor: 'event handling' stamp: 'tbn 3/12/2010 01:55'!
handleWindowEvent: anEvent
	"Handle an event concerning our host window"
	anEvent wasHandled ifTrue:[^self]. "not interested"
	(self wantsWindowEvent: anEvent) ifFalse:[^self].
	anEvent wasHandled: true.
	self windowEvent: anEvent.
! !

!Morph methodsFor: '*Morphic-Base' stamp: 'cb 6/25/2013 13:24'!
embedInWindow

	| window worldToUse |

	worldToUse := self world.		"I'm assuming we are already in a world"
	window := (SystemWindow labelled: self defaultLabel) model: nil.
	window bounds: ((self position - ((0@window labelHeight) + window borderWidth))
						corner: self bottomRight + window borderWidth).
	window addMorph: self frame: (0@0 extent: 1@1).
	window updatePaneColors.
	worldToUse addMorph: window.
	window activate! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'ar 10/11/2000 18:24'!
wantsDroppedMorph: aMorph event: evt
	"Return true if the receiver wishes to accept the given morph, which is being dropped by a hand in response to the given event. Note that for a successful drop operation both parties need to agree. The symmetric check is done automatically via aMorph wantsToBeDroppedInto: self."

	^self dropEnabled! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 20:06'!
disableTableLayout: aBool
	"Layout specific. Disable laying out the receiver in table layout"
	self assureLayoutProperties disableTableLayout: aBool.
	self layoutChanged.! !

!Morph methodsFor: 'layout-properties' stamp: 'tk 10/30/2001 18:39'!
vResizeToFit: aBoolean
	aBoolean ifTrue:[
		self vResizing: #shrinkWrap.
	] ifFalse:[
		self vResizing: #rigid.
	].! !

!Morph methodsFor: 'event handling' stamp: 'di 9/14/1998 07:33'!
mouseEnterDragging: evt
	"Handle a mouseEnterDragging event, meaning the mouse just entered my bounds with a button pressed or laden with submorphs.  The default response is to let my eventHandler, if any, handle it, or else to do nothing."

	self eventHandler ifNotNil:
		[^ self eventHandler mouseEnterDragging: evt fromMorph: self].
! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 20:02'!
wrapCentering
	"Layout specific. This property describes how the rows/columns in a list-like layout should be centered.
		#topLeft - center at start of secondary direction
		#bottomRight - center at end of secondary direction
		#center - center in the middle of secondary direction
		#justified - insert extra space inbetween rows/columns
	"
	| props |
	props := self layoutProperties.
	^props ifNil:[#topLeft] ifNotNil:[props wrapCentering].! !

!Morph methodsFor: 'rotate scale and flex' stamp: 'ar 11/24/1998 14:19'!
keepsTransform
	"Return true if the receiver will keep it's transform while being grabbed by a hand."
	^false! !

!Morph methodsFor: 'button' stamp: 'sw 2/6/2001 23:09'!
doButtonAction
	"If the receiver has a button-action defined, do it now.  The default button action of any morph is, well, to do nothing.  Note that there are several ways -- too many ways -- for morphs to have button-like actions.  This one refers not to the #mouseUpCodeToRun feature, nor does it refer to the Player-scripting mechanism.  Instead it is intended for morph classes whose very nature is to be buttons -- this method provides glue so that arbitrary buttons on the UI can be 'fired' programatticaly from user scripts"! !

!Morph methodsFor: 'events-processing' stamp: 'ar 1/10/2001 21:35'!
handleDropFiles: anEvent
	"Handle a drop from the OS."
	anEvent wasHandled ifTrue:[^self]. "not interested"
	(self wantsDropFiles: anEvent) ifFalse:[^self].
	anEvent wasHandled: true.
	self dropFiles: anEvent.
! !

!Morph methodsFor: 'menus' stamp: 'StephaneDucasse 4/22/2012 16:35'!
stickinessString
	"Answer the string to be shown in a menu to represent the stickiness status"
	
	^ (self isSticky) ->  'resist being picked up' translated! !

!Morph methodsFor: 'utilities' stamp: 'sw 10/23/1998 12:00'!
addTransparentSpacerOfSize: aPoint
	self addMorphBack: (self transparentSpacerOfSize: aPoint)! !

!Morph methodsFor: 'announcements' stamp: 'StephaneDucasse 8/22/2013 23:38'!
onAnnouncement: anAnnouncement do: aValuable
	self announcer when: anAnnouncement do: aValuable.! !

!Morph methodsFor: 'event handling' stamp: 'sw 5/6/1998 12:54'!
wouldAcceptKeyboardFocus
	"Answer whether a plain mouse click on the receiver should result in a text selection there"
	^ false! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'ar 10/8/2000 15:40'!
morphsAt: aPoint
	"Return a collection of all morphs in this morph structure that contain the given point, possibly including the receiver itself.  The order is deepest embedding first."
	^self morphsAt: aPoint unlocked: false! !

!Morph methodsFor: 'menus' stamp: 'sw 11/27/2001 07:17'!
addCustomMenuItems: aCustomMenu hand: aHandMorph
	"Add morph-specific items to the given menu which was invoked by the given hand.  This method provides is invoked both from the halo-menu and from the control-menu regimes."
! !

!Morph methodsFor: 'structure' stamp: 'marcus.denker 7/24/2009 14:07'!
outermostWorldMorph

	^World.! !

!Morph methodsFor: 'drop shadows' stamp: 'HenrikSperreJohansen 5/21/2010 13:34'!
changeShadowColor
	"Change the shadow color of the receiver -- triggered, e.g. from a menu"

	(UIManager default chooseColor: self shadowColor)
		ifNotNil: [:nc | self shadowColor: nc].
! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 10/29/2000 02:47'!
cellSpacingString: aSymbol
	^self layoutMenuPropertyString: aSymbol from: self cellSpacing! !

!Morph methodsFor: 'layout-menu' stamp: 'ar 10/31/2000 19:19'!
changeDisableTableLayout
	self disableTableLayout: self disableTableLayout not.
	self layoutChanged.! !

!Morph methodsFor: 'shortcuts' stamp: 'PavelKrivanek 7/24/2014 16:08'!
shortcutsHandler

	^ ShortcutsHandler ! !

!Morph methodsFor: 'structure' stamp: 'ClementBera 7/30/2013 11:05'!
world
	^owner ifNotNil: [owner world]! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/9/2009 17:44'!
focusIndicatorCornerRadius
	"Answer the corner radius preferred for the focus indicator
	for the receiver for themes that support this."

	^self theme focusIndicatorCornerRadiusFor: self ! !

!Morph methodsFor: 'thumbnail' stamp: 'dgd 9/12/2004 20:33'!
iconOrThumbnail
	"Answer an appropiate form to represent the receiver"

	^ self icon
		ifNil: [ | maxExtent fb |maxExtent := 320 @ 240.
			fb := self fullBounds.
			fb area <= (maxExtent x * maxExtent y)
				ifTrue: [self imageForm]
				ifFalse: [self imageFormForRectangle: (fb topLeft extent: maxExtent)]
		]
! !

!Morph methodsFor: 'wiw support' stamp: 'RAA 6/29/2000 10:49'!
addMorphInLayer: aMorph

	submorphs do: [ :each |
		each == aMorph ifTrue: [^self].
		aMorph morphicLayerNumber < each morphicLayerNumber ifTrue: [
			^self addMorph: aMorph inFrontOf: each
		].
	].
	self addMorphBack: aMorph
! !

!Morph methodsFor: 'updating' stamp: 'MarcusDenker 3/2/2015 17:47'!
removeDependent: anObject

	self announcer unsubscribe: anObject! !

!Morph methodsFor: 'menus' stamp: 'ar 11/29/2001 19:57'!
changeDirectionHandles
	^self wantsDirectionHandles: self wantsDirectionHandles not! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 19:59'!
listDirection
	"Layout specific. This property describes the direction in which a list-like layout should be applied. Possible values are:
		#leftToRight
		#rightToLeft
		#topToBottom
		#bottomToTop
	indicating the direction in which any layout should take place"
	| props |
	props := self layoutProperties.
	^props ifNil:[#topToBottom] ifNotNil:[props listDirection].! !

!Morph methodsFor: 'events-processing' stamp: 'ar 10/5/2000 19:25'!
rejectDropEvent: anEvent
	"This hook allows the receiver to repel a drop operation currently executed. The method is called prior to checking children so the receiver must validate that the event was really designated for it.
	Note that the ordering of the tests below is designed to avoid a (possibly expensive) #fullContainsPoint: test. If the receiver doesn't want to repel the morph anyways we don't need to check after all."
	(self repelsMorph: anEvent contents event: anEvent) ifFalse:[^self]. "not repelled"
	(self fullContainsPoint: anEvent position) ifFalse:[^self]. "not for me"
	"Throw it away"
	anEvent wasHandled: true.
	anEvent contents rejectDropMorphEvent: anEvent.! !

!Morph methodsFor: 'layout-menu' stamp: 'StephaneDucasse 4/22/2012 16:52'!
hasNoLayoutString
	^ (self layoutPolicy isNil) -> 'no layout' translated! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 9/27/2007 18:11'!
lastSubmorphRecursive
	"Answer recursive last submorph of the receiver."

	^self hasSubmorphs
		ifTrue: [self lastSubmorph lastSubmorphRecursive]
		ifFalse: [self]! !

!Morph methodsFor: 'halos and balloon help' stamp: 'AlainPlantec 5/7/2010 21:44'!
halo
	^ self outermostWorldMorph 
		ifNotNil: [:w | w haloMorphs detect: [:h | h target == self] ifNone: []]! !

!Morph methodsFor: 'structure' stamp: 'di 11/12/2000 16:18'!
ownerThatIsA: aClass
	"Return the first enclosing morph that is a kind of aClass, or nil if none"

	^ self firstOwnerSuchThat: [:m | m isKindOf: aClass]! !

!Morph methodsFor: 'accessing' stamp: 'sw 8/4/97 12:05'!
lock
	self lock: true! !

!Morph methodsFor: 'halos and balloon help' stamp: 'md 2/27/2006 09:54'!
setBalloonText: stringOrText maxLineLength: aLength 
	"Set receiver's balloon help text. Pass nil to remove the help."
	(extension isNil and: [stringOrText isNil]) ifTrue: [^ self].
	self assureExtension balloonText: 
		(stringOrText ifNotNil: [stringOrText asString withNoLineLongerThan: aLength])! !

!Morph methodsFor: '*Keymapping-Core' stamp: 'GuillermoPolito 10/20/2011 18:09'!
attachKeymapCategory: aCategoryName targetting: anObject
	self kmDispatcher attachCategory: aCategoryName targetting: anObject! !

!Morph methodsFor: 'miscellaneous' stamp: 'sw 7/20/2001 00:15'!
setExtentFromHalo: anExtent
	"The user has dragged the grow box such that the receiver's extent would be anExtent.  Do what's needed"

	self extent: anExtent! !

!Morph methodsFor: 'drawing' stamp: 'ar 3/17/2001 15:56'!
highlightForMouseDown: aBoolean
	aBoolean 
		ifTrue:[self setProperty: #highlightedForMouseDown toValue: aBoolean]
		ifFalse:[self removeProperty: #highlightedForMouseDown. self resetExtension].
	self changed! !

!Morph methodsFor: '*Keymapping-Core' stamp: 'ThierryGoubier 9/15/2012 21:06'!
initializeShortcuts: aKMDispatcher
	"Where we may attach keymaps or even on:do: local shortcuts if needed."

	aKMDispatcher attachCategory: #MorphFocusCtrlNavigation! !

!Morph methodsFor: 'text-anchor' stamp: 'ar 12/16/2001 19:22'!
relativeTextAnchorPosition: aPoint
	^self setProperty: #relativeTextAnchorPosition toValue: aPoint! !

!Morph methodsFor: 'accessing' stamp: 'MarcusDenker 9/7/2010 16:59'!
balloonText
	"Answer balloon help text or nil, if no help is available.  
	NB: subclasses may override such that they programatically  
	construct the text, for economy's sake, such as model phrases in 
	a Viewer"

	extension ifNil: [^nil].
	^extension balloonText ifNotNil: [:text | 
				text asString withNoLineLongerThan: self theme settings maxBalloonHelpLineLength]! !

!Morph methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 11/28/2012 00:59'!
simulateKeyStrokes: aString

	aString do: [:c | self simulateKeyStroke: c ].! !

!Morph methodsFor: 'drawing' stamp: 'JW 7/12/2005 20:12'!
shadowForm
	"Return a form representing the 'shadow' of the receiver - e.g., all pixels that are occupied by the receiver are one, all others are zero."
	| canvas |
	canvas := (Display defaultCanvasClass extent: self fullBounds extent depth: 1)
				asShadowDrawingCanvas: Color black. "Color black represents one for 1bpp"
	canvas translateBy: bounds topLeft negated
		during:[:tempCanvas| tempCanvas fullDrawMorph: self].
	^ canvas form offset: bounds topLeft
! !

!Morph methodsFor: 'events-processing' stamp: 'BenjaminVanRyseghem 1/18/2012 18:58'!
handleMouseMove: anEvent
	"System level event handling."
	anEvent wasHandled ifTrue:[^self]. "not interested"
	"Rules say that by default a morph gets #mouseMove iff
		* the hand is not dragging anything,
			+ and some button is down,
			+ and the receiver is the current mouse focus."
	(anEvent hand hasSubmorphs) ifTrue:[^self].
	(anEvent anyButtonPressed and:[anEvent hand mouseFocus == self]) ifFalse:[^self].
	anEvent wasHandled: true.
	self mouseMove: anEvent.
	(self handlesMouseStillDown: anEvent) ifTrue:[
		"Step at the new location"
		self startStepping: #handleMouseStillDown: 
			at: Time millisecondClockValue
			arguments: {anEvent copy resetHandlerFields}
			stepTime: self mouseStillDownStepRate ].
	^ self eventHandler ifNotNil: [:handler | handler mouseMove: anEvent fromMorph: self ]
! !

!Morph methodsFor: 'layout' stamp: 'StephaneDucasse 6/2/2013 14:18'!
fullBounds
	"Return the bounding box of the receiver and all its children. Recompute the layout if necessary."

	fullBounds ifNotNil: [ ^ fullBounds ].	"Errors at this point can be critical so make sure we catch 'em all right"
	self computeFullBounds.	"This should do it unless you don't screw up the bounds"
	^ fullBounds! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'BenjaminVanRyseghem 6/24/2012 23:27'!
widthToDisplayInTree: aTree

	^ self minExtent x! !

!Morph methodsFor: '*Morphic-Base' stamp: 'ar 11/14/2000 17:57'!
assureTableProperties
	| props |
	props := self layoutProperties.
	props == self ifTrue:[props := nil].
	props ifNil:[
		props := TableLayoutProperties new initializeFrom: self.
		self layoutProperties: props].
	props includesTableProperties 
		ifFalse:[self layoutProperties: (props := props asTableLayoutProperties)].
	^props! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 19:56'!
cellSpacing: aSymbol
	"Layout specific. This property describes how the cell size for each element in a list should be computed.
		#globalRect - globally equal rectangular cells
		#globalSquare - globally equal square cells
		#localRect - locally (e.g., per row/column) equal rectangular cells
		#localSquare - locally (e.g., per row/column) equal square cells
		#none - cells are sized based on available row/column constraints
	"
	self assureTableProperties cellSpacing: aSymbol.
	self layoutChanged.! !

!Morph methodsFor: 'geometry' stamp: 'ar 12/14/2000 13:48'!
bounds: newBounds
	| oldExtent newExtent |
	oldExtent := self extent.
	newExtent := newBounds extent.
	(oldExtent dotProduct: oldExtent) <= (newExtent dotProduct: newExtent) ifTrue:[
		"We're growing. First move then resize."
		self position: newBounds topLeft; extent: newExtent.
	] ifFalse:[
		"We're shrinking. First resize then move."
		self extent: newExtent; position: newBounds topLeft.
	].! !

!Morph methodsFor: 'caching' stamp: 'md 4/3/2006 12:02'!
releaseCachedState
	"Release any state that can be recomputed on demand, such as the pixel values for a color gradient or the editor state for a TextMorph. This method may be called to save space when a morph becomes inaccessible. Implementations of this method should do 'super releaseCachedState'."
	self borderStyle releaseCachedState. 
! !

!Morph methodsFor: 'halos and balloon help' stamp: 'sd 12/5/2001 20:29'!
balloonFont
	^ self
		valueOfProperty: #balloonFont
		ifAbsent: [self defaultBalloonFont]! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/29/2008 16:06'!
toggleVisible
	"Toggle the visibility of the receiver."

	self visible
		ifTrue: [self hide]
		ifFalse: [self show]! !

!Morph methodsFor: 'accessing' stamp: 'ar 8/25/2001 18:28'!
borderWidth
	^self borderStyle width! !

!Morph methodsFor: 'events-processing' stamp: 'BenjaminVanRyseghem 1/18/2012 19:06'!
handleMouseEnter: anEvent
	"System level event handling."
	(anEvent isDraggingEvent) ifTrue:[
		(self handlesMouseOverDragging: anEvent) ifTrue:[
			anEvent wasHandled: true.
			self mouseEnterDragging: anEvent].
		^ self eventHandler ifNotNil: [:handler | handler mouseEnterDragging: anEvent fromMorph: self ]].
	self wantsBalloon
		ifTrue:[anEvent hand triggerBalloonFor: self after: self balloonHelpDelayTime].
	(self handlesMouseOver: anEvent) ifTrue:[
		anEvent wasHandled: true.
		self mouseEnter: anEvent ].
	^ self eventHandler ifNotNil: [:handler | handler mouseEnter: anEvent fromMorph: self ].! !

!Morph methodsFor: 'testing' stamp: 'nk 10/13/2003 18:36'!
isLineMorph
	^false! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 9/5/2007 15:24'!
wantsKeyboardFocusNavigation
	"Answer whether the receiver would like keyboard focus
	when navigated to by keyboard."

	^self wantsKeyboardFocus! !

!Morph methodsFor: 'geometry' stamp: 'efc 2/13/2003 18:14'!
bottom: aNumber
	" Move me so that my bottom is at the y-coordinate aNumber. My extent (width & height) are unchanged "

	self position: (bounds left @ (aNumber - self height))! !

!Morph methodsFor: '*Morphic-Base' stamp: 'ar 11/13/2000 19:09'!
changeLayoutInset: evt
	| handle |
	handle := HandleMorph new forEachPointDo:[:newPoint |
		self layoutInset: (newPoint - evt cursorPoint) asIntegerPoint // 5].
	evt hand attachMorph: handle.
	handle startStepping.
! !

!Morph methodsFor: 'drop shadows' stamp: 'RAA 1/19/2001 07:51'!
addDropShadow

	self hasDropShadow ifTrue:[^self].
	self changed.
	self hasDropShadow: true.
	self shadowOffset: 3@3.
	self layoutChanged.
	self changed.! !

!Morph methodsFor: 'accessing' stamp: 'ar 12/27/2001 17:56'!
couldHaveRoundedCorners
	^ true! !

!Morph methodsFor: 'stepping and presenter' stamp: 'ar 12/15/2000 00:00'!
stopSteppingSelector: aSelector
	"Stop getting sent the given message."
	| w |
	w := self world.
	w ifNotNil: [w stopStepping: self selector: aSelector].
! !

!Morph methodsFor: 'geometry' stamp: 'efc 2/13/2003 18:17'!
bottom
	" Return the y-coordinate of my bottom side "

	^ bounds bottom! !

!Morph methodsFor: 'event handling' stamp: 'nk 3/10/2004 19:47'!
handlerForMouseDown: anEvent 
	"Return the (prospective) handler for a mouse down event. The handler is temporarily 
	installed and can be used for morphs further down the hierarchy to negotiate whether 
	the inner or the outer morph should finally handle the event."

	anEvent blueButtonPressed
		ifTrue: [^ self handlerForBlueButtonDown: anEvent].
	anEvent yellowButtonPressed
		ifTrue: [^ self handlerForYellowButtonDown: anEvent].
	anEvent controlKeyPressed
		ifTrue: [^ self handlerForMetaMenu: anEvent].
	(self handlesMouseDown: anEvent)
		ifFalse: [^ nil].	"not interested"

	anEvent handler
		ifNil: [^ self ].	"Same priority but I am innermost"

	"Nobody else was interested"
	^self mouseDownPriority >= anEvent handler mouseDownPriority
		ifTrue: [ self]
		ifFalse: [ nil]! !

!Morph methodsFor: 'testing' stamp: 'stephane.ducasse 11/14/2008 21:48'!
renameTo: aName 
	"Set The morph name."

	self topRendererOrSelf setNameTo: aName.
	^aName! !

!Morph methodsFor: 'halos and balloon help' stamp: 'ar 10/3/2000 17:05'!
mouseDownOnHelpHandle: anEvent
	"The mouse went down in the show-balloon handle"
	
	| str |
	anEvent shiftPressed ifTrue: [^ self editBalloonHelpText].
	str := self balloonText.
	str ifNil: [str := self noHelpString].
	self showBalloon: str hand: anEvent hand.
! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'ar 10/11/2000 18:24'!
separateDragAndDrop
	"Conversion only. Separate the old #dragNDropEnabled into #dragEnabled and #dropEnabled and remove the old property."
	| dnd |
	(self hasProperty: #dragNDropEnabled) ifFalse:[^self].
	dnd := (self valueOfProperty: #dragNDropEnabled) == true.
	self dragEnabled: dnd.
	self dropEnabled: dnd.
	self removeProperty: #dragNDropEnabled.
! !

!Morph methodsFor: 'geometry' stamp: 'bf 1/5/2000 19:08'!
screenLocation
	"For compatibility only"

	^ self fullBounds origin! !

!Morph methodsFor: 'geometry' stamp: 'SeanDeNigris 5/4/2013 11:17'!
fitInWorld

	self bounds: (self bounds translatedAndSquishedToBeWithin: self world bounds).! !

!Morph methodsFor: 'geometry' stamp: 'ar 9/22/2000 20:12'!
referencePosition
	"Return the current reference position of the receiver"
	| box |
	box := self bounds.
	^box origin + (self rotationCenter * box extent).
! !

!Morph methodsFor: 'stepping and presenter' stamp: 'ar 1/31/2001 13:07'!
startStepping
	"Start getting sent the 'step' message."
	self startStepping: #stepAt: at: Time millisecondClockValue arguments: nil stepTime: nil.! !

!Morph methodsFor: '*Morphic-Base' stamp: 'nk 8/28/2003 15:57'!
useBitmapFill
	"Make receiver use a solid fill style (e.g., a simple color)"
	| fill |
	self fillStyle isBitmapFill ifTrue:[^self]. "Already done"
	fill := BitmapFillStyle fromForm: self defaultBitmapFillForm.
	"Note: Must fix the origin due to global coordinates"
	fill origin: self bounds origin.
	self fillStyle: fill.! !

!Morph methodsFor: '*Morphic-Widgets-Taskbar' stamp: 'gvc 6/11/2007 15:04'!
taskbarThumbnail
	"Answer a new taskbar thumbnail for the receiver."

	^self taskThumbnailOfSize: self taskbarThumbnailExtent! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'RAA 12/15/2000 19:34'!
addMorphCentered: aMorph

	aMorph position: bounds center - (aMorph extent // 2).
	self addMorphFront: aMorph.
! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'ar 10/11/2000 18:20'!
dragNDropEnabled
	"Note: This method is only useful for dragEnabled == dropEnabled at all times"
	self separateDragAndDrop.
	^self dragEnabled and:[self dropEnabled]! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'ar 1/31/2001 12:45'!
addMorph: newMorph inFrontOf: aMorph
	"Add a morph to the list of submorphs in front of the specified morph"
	^self privateAddMorph: newMorph atIndex: ((submorphs indexOf: aMorph) max: 1).! !

!Morph methodsFor: 'geometry' stamp: 'ar 10/25/2000 15:02'!
pointFromWorld: aPoint
	^self point: aPoint from: self world! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'ar 10/11/2000 18:18'!
dropEnabled: aBool
	^self enableDrop: aBool! !

!Morph methodsFor: 'accessing' stamp: 'IgorStasenko 12/22/2012 03:10'!
visibleClearArea
	"Answer the receiver visible clear area. The intersection 
	between the clear area and the viewbox."
	^ self viewBox intersect: self clearArea ifNone: [ (0@0 corner: 0@0 ) ]! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'sw 7/3/1998 18:47'!
submorphWithProperty: aSymbol
	^ submorphs detect: [:aMorph | aMorph hasProperty: aSymbol] ifNone: [nil]! !

!Morph methodsFor: 'events-processing' stamp: 'BenjaminVanRyseghem 6/28/2012 12:58'!
handleMouseDown: anEvent
	"System level event handling."
	anEvent wasHandled ifTrue:[^self]. "not interested"
	anEvent hand removePendingBalloonFor: self.
	anEvent wasHandled: true.
	
	(anEvent controlKeyPressed
			and: [self cmdGesturesEnabled and: [ anEvent shiftPressed]])
		ifTrue: [
			self invokeMetaMenu: anEvent.
			^ self eventHandler ifNotNil: [:handler | handler mouseDown: anEvent fromMorph: self ].].

	"Make me modal during mouse transitions"
	anEvent hand newMouseFocus: self event: anEvent.
	anEvent blueButtonChanged ifTrue:[^self blueButtonDown: anEvent].
	
	self mouseDown: anEvent.
	
	anEvent hand removeHaloFromClick: anEvent on: self.
	(self handlesMouseStillDown: anEvent) ifTrue:[
		self startStepping: #handleMouseStillDown: 
			at: Time millisecondClockValue + self mouseStillDownThreshold
			arguments: {anEvent copy resetHandlerFields}
			stepTime: self mouseStillDownStepRate ].! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/27/2009 13:47'!
preferredButtonCornerStyle
	"Answer the preferred button corner style
	for submorphs. Answer nil for no preference."

	^nil! !

!Morph methodsFor: 'recategorized' stamp: 'gvc 2/23/2009 13:23'!
handlesDropShadowInHand
	"Answer whether the receiver will handle drop shadow drawing when picked up in the hand."

	^false! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 10/17/2006 10:36'!
visible: aBoolean 
	"set the 'visible' attribute of the receiver to aBoolean.
	Must update owner layout since its full bounds may depend
	on the receiver extending beyond its bounds."
	
	(extension isNil and:[aBoolean]) ifTrue: [^ self].
	self visible == aBoolean ifTrue: [^ self].
	self assureExtension visible: aBoolean.
	self changed.
	owner ifNotNil: [owner layoutChanged]! !

!Morph methodsFor: 'events-processing' stamp: 'gvc 1/28/2008 17:21'!
handleMouseWheel: anEvent
	"System level event handling."
	
	anEvent wasHandled ifTrue:[^self].
	(self handlesMouseWheel: anEvent) ifTrue:[
		anEvent wasHandled: true.
		self mouseWheel: anEvent]! !

!Morph methodsFor: 'meta-actions' stamp: 'sw 11/27/2001 14:59'!
resizeFromMenu
	"Commence an interaction that will resize the receiver"

	self resizeMorph: ActiveEvent! !

!Morph methodsFor: 'drop shadows' stamp: 'marcus.denker 8/24/2008 22:50'!
shadowOffset
	"Return the current shadow offset"
	
	extension ifNil: [^0@0].
	^self valueOfProperty: #shadowOffset ifAbsent:[0@0]! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 10/29/2000 03:00'!
wrapDirectionString: aSymbol
	^self layoutMenuPropertyString: aSymbol from: self wrapDirection ! !

!Morph methodsFor: '*Keymapping-Core' stamp: 'GuillermoPolito 3/14/2011 00:03'!
dispatchKeystrokeForEvent: evt 
	self kmDispatcher dispatchKeystroke: evt 
! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'nk 10/16/2003 14:02'!
removeAllMorphsIn: aCollection
	"greatly speeds up the removal of *lots* of submorphs"
	| set myWorld |
	set := IdentitySet new: aCollection size * 4 // 3.
	aCollection do: [:each | each owner == self ifTrue: [ set add: each]].
	myWorld := self world.
	(fullBounds notNil or:[myWorld notNil]) ifTrue:[self invalidRect: self fullBounds].
	set do: [:m | myWorld ifNotNil: [ m outOfWorld: myWorld ]. m privateOwner: nil].
	submorphs := submorphs reject: [ :each | set includes: each].
	set do: [ :m | self removedMorph: m ].
	self layoutChanged.
! !

!Morph methodsFor: 'halos and balloon help' stamp: 'ar 9/15/2000 16:16'!
hasHalo
	^self hasProperty: #hasHalo.! !

!Morph methodsFor: 'events-processing' stamp: 'ar 9/18/2000 19:14'!
processEvent: anEvent using: defaultDispatcher
	"This is the central entry for dispatching events in morphic. Given some event and a default dispatch strategy, find the right receiver and let him handle it.
	WARNING: This is a powerful hook. If you want to use a different event dispatcher from the default, here is the place to hook it in. Depending on how the dispatcher is written (e.g., whether it calls simply #processEvent: or #processEvent:using:) you can change the dispatch strategy for entire trees of morphs. Similarly, you can disable entire trees of morphs from receiving any events whatsoever. Read the documentation in class MorphicEventDispatcher before playing with it. "
	(self rejectsEvent: anEvent) ifTrue:[^#rejected].
	^defaultDispatcher dispatchEvent: anEvent with: self! !

!Morph methodsFor: 'naming' stamp: 'yo 12/3/2004 17:02'!
setNameTo: aName 
	| nameToUse nameString |
	nameToUse := aName ifNotNil: 
					[(nameString := aName asString) notEmpty ifTrue: [nameString] ifFalse: ['*']].
	self setNamePropertyTo: nameToUse	"no Texts here!!"! !

!Morph methodsFor: 'drawing' stamp: 'Henrik Sperre Johansen 3/15/2009 00:03'!
areasRemainingToFill: aRectangle 
	"Pushed up from BorderedMorph, all cases tested for there are
	supported by basic Morph."
	"Morphs which achieve translucency by other means than fillStyle will have
	to reimplement this"
	"Fixed here to test the fillStyle rather than color for translucency.
	Since can have a translucent fillStyle while the (calculated) color is not."
	self fillStyle isTranslucent
		ifTrue: [^ Array with: aRectangle].
	self wantsRoundedCorners
		ifTrue: [(self borderWidth > 0
					and: [self borderColor isColor
							and: [self borderColor isTranslucent]])
				ifTrue: [^ aRectangle
						areasOutside: (self innerBounds intersect: self boundsWithinCorners)]
				ifFalse: [^ aRectangle areasOutside: self boundsWithinCorners]]
		ifFalse: [(self borderWidth > 0
					and: [self borderColor isColor
							and: [self borderColor isTranslucent]])
				ifTrue: [^ aRectangle areasOutside: self innerBounds]
				ifFalse: [^ aRectangle areasOutside: self bounds]]! !

!Morph methodsFor: 'layout-menu' stamp: 'StephaneDucasse 4/22/2012 16:52'!
hasRubberBandCellsString
	^ (self rubberBandCells) -> 'rubber band cells' translated! !

!Morph methodsFor: 'accessing' stamp: 'sw 11/15/2001 16:33'!
resistsRemoval
	"Answer whether the receiver is marked as resisting removal"

	^ self hasProperty: #resistsRemoval! !

!Morph methodsFor: '*Morphic-Base' stamp: 'PavelKrivanek 7/13/2014 13:43'!
addHalo: evt
	| halo prospectiveHaloClass |
	
	UserManager default canShowMorphHalo
		ifFalse: [ ^ self ].
	prospectiveHaloClass := Smalltalk globals at: self haloClass ifAbsent: [ HaloMorph ].
	halo := prospectiveHaloClass new.
	halo bounds: (halo worldBoundsForMorph: self).
	halo popUpFor: self event: evt.
	^ halo! !

!Morph methodsFor: 'menu' stamp: 'AlainPlantec 11/5/2011 14:27'!
buildYellowButtonMenu: aHand 
	"build the morph menu for the yellow button"
	| menu |
	menu := UIManager default newMenuIn: self for: self.
	self addNestedYellowButtonItemsTo: menu event: ActiveEvent.
	^ menu! !

!Morph methodsFor: 'initialize' stamp: 'RAA 10/18/2000 12:33'!
openCenteredInWorld

	self 
		fullBounds;
		position: Display extent - self extent // 2;
		openInWorld.! !

!Morph methodsFor: 'menu' stamp: 'dgd 9/18/2004 18:35'!
wantsYellowButtonMenu: aBoolean 
	"Change the receiver to wants or not a yellow button menu"
	self setProperty: #wantsYellowButtonMenu toValue: aBoolean! !

!Morph methodsFor: '*glamour-morphic-widgets' stamp: 'cyrilledelaunay 6/6/2011 15:47'!
returnToOldResizingStrategy: aCollection

	|tmpSubmorphResizing|
	self submorphs with: aCollection third do: [:aMorph :resizingParameter |
		aMorph returnToOldResizingStrategy: resizingParameter.
		].
	self hResizing: aCollection first.
	self vResizing: aCollection second.! !

!Morph methodsFor: 'rotate scale and flex' stamp: 'AlainPlantec 5/8/2010 00:13'!
rotationCenter
	"Return the rotation center of the receiver. The rotation center defines the relative offset inside the receiver's bounds for locating the reference position."
	^self valueOfProperty: #rotationCenter ifAbsent: [0.5@0.5]
! !

!Morph methodsFor: 'Morphic-Base-Worlds' stamp: 'dgd 9/27/2004 11:45'!
viewBox
	^ self pasteUpMorph viewBox! !

!Morph methodsFor: 'accessing' stamp: 'tk 1/31/2002 10:25'!
insetColor
	owner ifNil:[^self color].
	^ self colorForInsets! !

!Morph methodsFor: '*SUnit-UITesting' stamp: 'SeanDeNigris 12/1/2011 22:08'!
simulateClick

	self simulateClickWith: MouseEvent redButton.! !

!Morph methodsFor: '*Morphic-Base' stamp: 'sma 11/11/2000 16:15'!
defaultBalloonColor
	^ Display depth <= 2
		ifTrue: [Color white]
		ifFalse: [BalloonMorph balloonColor]! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/11/2007 14:59'!
focusColor
	"Answer the keyboard focus indication color."

	^self borderStyle color contrastingColor! !

!Morph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/7/2015 21:12'!
drawSubmorphsOnAthensCanvas: anAthensCanvas
	self
		drawClippedOnAthensCanvas: anAthensCanvas
		during: [ submorphs reverseDo: [ :m | anAthensCanvas fullDrawMorph: m ] ]! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/12/2009 18:14'!
roundedCorners: anArray
	"Set the corners to round."

	anArray = #(1 2 3 4)
		ifTrue: [self removeProperty: #roundedCorners]
		ifFalse: [self setProperty: #roundedCorners toValue: anArray].
	self changed! !

!Morph methodsFor: 'accessing' stamp: 'sw 11/30/1998 12:44'!
highlight
	"The receiver is being asked to appear in a highlighted state.  Mostly used for textual morphs"
	self color: self highlightColor! !

!Morph methodsFor: 'recategorized' stamp: 'gvc 5/16/2007 11:26'!
changed
	"Report that the area occupied by this morph should be redrawn.
	Fixed to include submorphs outside the outerBounds."
	
	^fullBounds 
		ifNil: [self invalidRect: self privateFullBounds]
		ifNotNil: [self invalidRect: fullBounds]! !

!Morph methodsFor: '*Morphic-Base' stamp: 'nk 4/14/2004 17:48'!
borderWidth: aNumber
	| style |
	style := self borderStyle.
	style width = aNumber ifTrue: [ ^self ].

	style style = #none
		ifTrue: [ self borderStyle: (SimpleBorder width: aNumber color: Color transparent) ]
		ifFalse: [ style width: aNumber. self changed ].
! !

!Morph methodsFor: 'geometry' stamp: 'ar 10/25/2000 15:05'!
boundsInWorld
	^self bounds: self bounds in: self world! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 19:54'!
cellInset
	"Layout specific. This property specifies an extra inset for each cell in the layout."
	| props |
	props := self layoutProperties.
	^props ifNil:[0] ifNotNil:[props cellInset].! !

!Morph methodsFor: 'accessing' stamp: 'ar 8/25/2001 18:28'!
borderColor
	^self borderStyle color! !

!Morph methodsFor: 'layout' stamp: 'dgd 2/16/2003 21:54'!
minWidth
	"answer the receiver's minWidth"
	^ self
		valueOfProperty: #minWidth
		ifAbsent: [2]! !

!Morph methodsFor: 'meta-actions' stamp: 'ar 10/12/2000 17:07'!
handlerForMetaMenu: evt
	"Return the prospective handler for invoking the meta menu. By default, the top-most morph in the innermost world gets this menu"
	self isWorldMorph ifTrue:[^self].
	evt handler ifNotNil:[evt handler isWorldMorph ifTrue:[^self]].
	^nil! !

!Morph methodsFor: '*Morphic-Base' stamp: 'ar 11/13/2000 19:10'!
changeMinCellSize: evt
	| handle |
	handle := HandleMorph new forEachPointDo:[:newPoint |
		self minCellSize: (newPoint - evt cursorPoint) asIntegerPoint].
	evt hand attachMorph: handle.
	handle startStepping.
! !

!Morph methodsFor: 'menus' stamp: 'StephaneDucasse 10/27/2014 17:56'!
addExportMenuItems: aMenu hand: aHandMorph
	"Add export items to the menu"

	aMenu ifNotNil:
		[ | aSubMenu |
		aSubMenu := UIManager default newMenuIn: self for: self.
		aSubMenu add: 'BMP file' selector: #exportAsBMP.
		aSubMenu add: 'GIF file' selector: #exportAsGIF.
		aSubMenu add: 'JPEG file' selector: #exportAsJPEG.
		aSubMenu add: 'PNG file' selector: #exportAsPNG.
		aMenu add: 'export...' icon: Smalltalk ui icons smallExportIcon subMenu: aSubMenu.
		aMenu lastItem icon: Smalltalk ui icons smallExportIcon ].
! !

!Morph methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 10/17/2014 15:28'!
isBrick

	^ false! !

!Morph methodsFor: 'announcements' stamp: 'GuillermoPolito 5/1/2012 17:01'!
announcer
	^self valueOfProperty: #announcer ifAbsentPut: [ Announcer new ]! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 20:01'!
reverseTableCells
	"Layout specific. This property describes if the cells should be treated in reverse order of submorphs."
	| props |
	props := self layoutProperties.
	^props ifNil:[false] ifNotNil:[props reverseTableCells].! !

!Morph methodsFor: 'geometry' stamp: ''!
center

	^ bounds center! !

!Morph methodsFor: 'geometry' stamp: 'sw 10/25/1999 23:33'!
referencePositionInWorld: aPoint
	| localPosition |
	localPosition := owner
		ifNil: [aPoint]
		ifNotNil: [(owner transformFrom: self world) globalPointToLocal: aPoint].

	self referencePosition: localPosition
! !

!Morph methodsFor: 'accessing' stamp: 'sw 10/23/1998 12:01'!
beTransparent
	self color: Color transparent! !

!Morph methodsFor: 'geometry' stamp: 'di 3/6/2002 13:06'!
topCenter

	^ bounds topCenter! !

!Morph methodsFor: 'drawing' stamp: 'SeanDeNigris 2/5/2015 12:23'!
boundingBoxOfSubmorphs
	| aBox visibleSubmorphs |
	visibleSubmorphs := submorphs select: [ :m | m visible ].
	visibleSubmorphs ifEmpty: [ ^ bounds origin extent: self minimumExtent "so won't end up with something empty" ].
	aBox := visibleSubmorphs first fullBounds.
	visibleSubmorphs allButFirst do: [ :m | aBox := aBox quickMerge: m fullBounds ].
	^ aBox! !

!Morph methodsFor: 'rounding' stamp: 'gvc 9/11/2009 17:28'!
cornerStyle: aSymbol
	"This method makes it possible to set up desired corner style. aSymbol has to be one of:
		#square
		#rounded"

	aSymbol == self cornerStyle ifFalse:[
		self assureExtension.
		extension cornerStyle: aSymbol.
		self changed]! !

!Morph methodsFor: 'drop shadows' stamp: 'StephaneDucasse 4/22/2012 16:51'!
hasDropShadowString
	^ (self hasDropShadow) ->  'show shadow' translated! !

!Morph methodsFor: 'visual properties' stamp: 'ar 6/18/1999 06:57'!
useSolidFill
	"Make receiver use a solid fill style (e.g., a simple color)"
	self fillStyle isSolidFill ifTrue:[^self]. "Already done"
	self fillStyle: self fillStyle asColor. "Try minimizing changes"! !

!Morph methodsFor: '*Morphic-Base' stamp: 'sd 12/5/2001 20:23'!
defaultBalloonFont
	^ BalloonMorph balloonFont! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 19:59'!
listSpacing
	"Layout specific. This property describes how the heights for different rows in a table layout should be handled.
		#equal - all rows have the same height
		#none - all rows may have different heights
	"
	| props |
	props := self layoutProperties.
	^props ifNil:[#none] ifNotNil:[props listSpacing].! !

!Morph methodsFor: 'Morphic-Base-Worlds' stamp: 'sw 8/30/1998 09:47'!
topPasteUp
	"If the receiver is in a world, return that; otherwise return the outermost pasteup morph"
	^ self outermostMorphThat: [:m | m isKindOf: PasteUpMorph]! !

!Morph methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 1/2/2012 03:22'!
gtInspectorSubmorphsIn: composite
	<gtInspectorPresentationOrder: 80>  
	composite tree 
		title: 'Submorphs';
		rootsExpanded;
		display: [:each | {each} ];
		icon: [:each | | morphForm |
			morphForm := each imageForm.
			(morphForm extent x > 0 and: [morphForm extent y > 0 ])
				ifTrue: [(morphForm scaledToSize: 16@16) asMorph]
				ifFalse: [Form extent: 16@16] ];
		children: [:each | each submorphs];
		when: [:each | each submorphs notEmpty ]! !

!Morph methodsFor: 'menu' stamp: 'nk 3/10/2004 19:49'!
addMyYellowButtonMenuItemsToSubmorphMenus
	"Answer true if I have items to add to the context menus of my submorphs"

	^true! !

!Morph methodsFor: 'meta-actions' stamp: 'wiz 7/17/2004 22:17'!
potentialTargets
	"Return the potential targets for the receiver.
	This is derived from Morph>>potentialEmbeddingTargets."
	owner ifNil:[^#()].
	^owner morphsAt: self referencePosition behind: self unlocked: true not! !

!Morph methodsFor: 'menus' stamp: 'sw 2/3/2000 00:14'!
adjustedCenter
	"Provides a hook for objects to provide a reference point other than the receiver's center,for the purpose of centering a submorph under special circumstances, such as BalloonMorph"

	^ self center! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'alain.plantec 6/8/2009 23:41'!
allMorphsInto: aSet
	"Return a set of all submorphs.  Don't forget the hidden ones. Consider only objects that are in memory (see allNonSubmorphMorphs)." 

	submorphs do: [:m | m allMorphsInto: aSet].
	self allNonSubmorphMorphs do: [:m | 
			(aSet includes: m) ifFalse: ["Stop infinite recursion"
				m allMorphsInto: aSet]].
	aSet add: self.
	^ aSet! !

!Morph methodsFor: 'accessing' stamp: 'tk 2/15/2001 15:55'!
color

	^ color 	"has already been set to ((self valueOfProperty: #fillStyle) asColor)"! !

!Morph methodsFor: 'geometry' stamp: 'ar 10/25/2000 15:06'!
fullBoundsInWorld
	^self bounds: self fullBounds in: self world! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'AlainPlantec 12/1/2010 09:39'!
dismissViaHalo
	"The user has clicked in the delete halo-handle.  This provides a hook in case some concomitant action should be taken, or if the particular morph is not one which should be put in the trash can, for example."

	self setProperty: #lastPosition toValue: self positionInWorld.
	self dismissMorph! !

!Morph methodsFor: 'menus' stamp: 'StephaneDucasse 4/22/2012 16:51'!
hasDragAndDropEnabledString
	"Answer a string to characterize the drag & drop status of the  
	receiver"
	^ (self dragNDropEnabled) -> 'accept drops' translated! !

!Morph methodsFor: 'accessing' stamp: 'gvc 1/11/2007 12:21'!
enabled
	"Answer whether the receiver is enabled."

	^true! !

!Morph methodsFor: 'geometry' stamp: 'jm 8/3/97 15:50'!
bounds
	"Return the bounds of this morph."
	"Note: It is best not to override this method because many methods in Morph and its subclasses use the instance variable directly rather than 'self bounds'. Instead, subclasses should be sure that the bounds instance variable is correct."

	^ bounds
! !

!Morph methodsFor: 'geometry' stamp: 'ar 10/22/2000 18:03'!
transformedBy: aTransform
	aTransform isIdentity ifTrue:[^self].
	aTransform isPureTranslation ifTrue:[
		^self position: (aTransform localPointToGlobal: self position).
	].
	^self addFlexShell transformedBy: aTransform! !

!Morph methodsFor: '*Morphic-Widgets-Taskbar' stamp: 'gvc 4/18/2007 12:30'!
taskbarTask
	"Answer a new taskbar task for the receiver.
	Answer nil if not required."

	^nil! !

!Morph methodsFor: 'event handling' stamp: 'ar 9/14/2000 18:23'!
keyDown: anEvent
	"Handle a key down event. The default response is to do nothing."! !

!Morph methodsFor: '*Keymapping-Core' stamp: 'BenjaminVanRyseghem 11/12/2013 16:14'!
removeKeyCombination: aShortcut

	self kmDispatcher removeKeyCombination: aShortcut! !

!Morph methodsFor: 'announcements' stamp: 'ThierryGoubier 1/8/2014 14:40'!
doAnnounce: anAnnouncement
	"Take care of not creating the announcer when announcing. If the announcer doesn't exist then this means nobody has expressed an interest in the message."

	"Do not override announce: for now, there is a need to refactor the announcements code in at least SystemWindow and ExpanderMorph."

	(self valueOfProperty: #announcer ifAbsent: [ ^ self ]) announce: anAnnouncement! !

!Morph methodsFor: 'other events' stamp: 'sw 8/1/2001 14:09'!
menuButtonMouseLeave: event
	"The mouse left a menu-button area; restore standard cursor"

	event hand showTemporaryCursor: nil! !

!Morph methodsFor: 'halos and balloon help' stamp: 'sw 2/7/2000 11:27'!
balloonHelpAligner
	"Answer the morph to which the receiver's balloon help should point"
	^ (self valueOfProperty: #balloonTarget) ifNil: [self]! !

!Morph methodsFor: 'events-processing' stamp: 'GuillermoPolito 4/22/2012 17:19'!
handleKeyUp: anEvent
	"System level event handling."
	anEvent wasHandled ifTrue:[^self].
	(self handlesKeyUp: anEvent) ifFalse:[^self].
	anEvent wasHandled: true.
	^self keyUp: anEvent! !

!Morph methodsFor: '*Morphic-Base' stamp: 'ar 11/13/2000 19:10'!
changeMaxCellSize: evt
	| handle |
	handle := HandleMorph new forEachPointDo:[:newPoint |
		self maxCellSize: (newPoint - evt cursorPoint) asIntegerPoint].
	evt hand attachMorph: handle.
	handle startStepping.
! !

!Morph methodsFor: 'event handling' stamp: 'nk 2/14/2004 18:42'!
handlesMouseDown: evt
	"Do I want to receive mouseDown events (mouseDown:, mouseMove:, mouseUp:)?"
	"NOTE: The default response is false, except if you have added sensitivity to mouseDown events using the on:send:to: mechanism.  Subclasses that implement these messages directly should override this one to return true." 

	self eventHandler ifNotNil: [^ self eventHandler handlesMouseDown: evt].
	^ false! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'FernandoOlivero 4/12/2011 09:55'!
showBalloon: msgString hand: aHand
	"Pop up a balloon containing the given string,
	first removing any existing BalloonMorphs in the world."

	|w h|
	(w := self world) ifNil: [^self].
	h := aHand ifNil: [w activeHand].
	( self theme   builder newBalloonHelp: msgString for: self balloonHelpAligner)
		popUpFor: self hand: h! !

!Morph methodsFor: 'classification' stamp: 'di 5/7/1998 01:21'!
isAlignmentMorph

	^ false! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/29/2008 16:18'!
toggleVisibleAndRaise
	"Toggle the visibility of the receiver, brining to
	the front if becoming visible."

	self visible
		ifTrue: [self hide]
		ifFalse: [self comeToFront; show]! !

!Morph methodsFor: 'initialize' stamp: 'sw 3/21/2000 14:46'!
openInHand
	"Attach the receiver to the current hand in the current morphic world"

	self currentHand attachMorph: self! !

!Morph methodsFor: 'halos and balloon help' stamp: 'sw 4/8/98 13:26'!
wantsHaloFor: aSubMorph
	^ false! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'ar 8/13/2003 11:32'!
noteNewOwner: aMorph
	"I have just been added as a submorph of aMorph"! !

!Morph methodsFor: 'event handling' stamp: 'CamilloBruni 2/4/2012 14:43'!
yellowButtonActivity: shiftState 
	"Find me or my outermost owner that has items to add to a  
	yellow button menu.  
	shiftState is true if the shift was pressed.  
	Otherwise, build a menu that contains the contributions from  
	myself and my interested submorphs,  
	and present it to the user."
	| menu |
	self isWorldMorph
		ifFalse: [| outerOwner | 
			outerOwner := self outermostOwnerWithYellowButtonMenu.
			outerOwner
				ifNil: [^ false].
			outerOwner == self
				ifFalse: [^ outerOwner yellowButtonActivity: shiftState]].
	menu := self buildYellowButtonMenu: ActiveHand.
	menu
		addTitle: self externalName
		icon: (self iconOrThumbnailOfSize: 28).
	menu popUpInWorld: self currentWorld.
	^ true! !

!Morph methodsFor: 'stepping and presenter' stamp: 'sw 7/19/1998 11:51'!
startSteppingIn: aWorld
	"Start getting sent the 'step' message in aWorld"

	self step.  "one to get started!!"
	aWorld ifNotNil: [aWorld startStepping: self].
	self changed! !

!Morph methodsFor: 'testing' stamp: 'dgd 8/31/2004 15:00'!
isDockingBar
	"Return true if the receiver is a docking bar"
	^ false! !

!Morph methodsFor: 'halos and balloon help' stamp: 'ClementBera 7/30/2013 11:04'!
removeHalo
	"remove the surrounding halo (if any)"
	self halo ifNotNil: [self primaryHand removeHalo]! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'GaryChambers 6/10/2011 12:00'!
isWindowActive: aSystemWindow
	"Answer whether the given window is active.
	Implement in morphs that are designed to embed system windows.
	Delegate to owner."
	
	^self owner ifNil: [true] ifNotNil: [:o | o isWindowActive: aSystemWindow]! !

!Morph methodsFor: '*Morphic-Base' stamp: 'ar 10/31/2000 19:19'!
changeProportionalLayout
	| layout |
	((layout := self layoutPolicy) notNil and:[layout isProportionalLayout])
		ifTrue:[^self]. "already proportional layout"
	self layoutPolicy: ProportionalLayout new.
	self layoutChanged.! !

!Morph methodsFor: 'halos and balloon help' stamp: 'em 3/24/2005 10:05'!
noHelpString
	^ 'Help not yet supplied' translated! !

!Morph methodsFor: 'stepping and presenter' stamp: 'ar 10/22/2000 16:43'!
isSteppingSelector: aSelector
	"Return true if the receiver is currently stepping in its world"
	| aWorld |
	^ (aWorld := self world)
		ifNil:		[false]
		ifNotNil:	[aWorld isStepping: self selector: aSelector]! !

!Morph methodsFor: 'meta-actions' stamp: 'MarcusDenker 3/27/2011 17:12'!
maybeDuplicateMorph
	"Maybe duplicate the morph"

	^self duplicate openInHand! !

!Morph methodsFor: 'event handling' stamp: 'dgd 2/22/2003 14:36'!
transformFrom: uberMorph 
	"Return a transform to be used to map coordinates in a morph above me into my childrens coordinates, or vice-versa. This is used to support scrolling, scaling, and/or rotation. This default implementation just returns my owner's transform or the identity transform if my owner is nil. 
	Note:  This method cannot be used to map into the receiver's coordinate system!!"

	(self == uberMorph or: [owner isNil]) ifTrue: [^IdentityTransform new].
	^owner transformFrom: uberMorph! !

!Morph methodsFor: 'structure' stamp: 'ar 9/14/2000 16:47'!
allOwnersDo: aBlock
	"Evaluate aBlock with all owners of the receiver"
	owner ifNotNil:[^owner withAllOwnersDo: aBlock].! !

!Morph methodsFor: '*Keymapping-Core' stamp: 'ThierryGoubier 9/14/2012 22:21'!
kmDispatcher
	"When creating the KMDispatcher instance, load default shortcuts."

	^ self
		valueOfProperty: #kmDispatcher
		ifAbsentPut: [ 
			| kmd |
			kmd := KMDispatcher target: self.
			self initializeShortcuts: kmd.
			kmd ]! !

!Morph methodsFor: 'geometry' stamp: 'efc 2/13/2003 18:16'!
left
	" Return the x-coordinate of my left side "

	^ bounds left! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 19:58'!
listCentering
	"Layout specific. This property describes how the rows/columns in a list-like layout should be centered.
		#topLeft - center at start of primary direction
		#bottomRight - center at end of primary direction
		#center - center in the middle of primary direction
		#justified - insert extra space inbetween rows/columns
	"
	| props |
	props := self layoutProperties.
	^props ifNil:[#topLeft] ifNotNil:[props listCentering].! !

!Morph methodsFor: 'drawing' stamp: 'MarcusDenker 10/21/2013 14:22'!
show
	"Make sure this morph is on-stage."

	self visible
		ifTrue: [ ^ self ].
	self visible: true.
	self changed! !

!Morph methodsFor: 'accessing - extension' stamp: 'md 2/27/2006 08:35'!
initializeExtension
	"private - initializes the receiver's extension"
	extension := MorphExtension new! !

!Morph methodsFor: 'menus' stamp: 'sw 8/30/1998 09:42'!
snapToEdgeIfAppropriate
	| edgeSymbol oldBounds aWorld |
	(edgeSymbol := self valueOfProperty: #edgeToAdhereTo) ifNotNil:
		[oldBounds := bounds.
		self adhereToEdge: edgeSymbol.
		bounds ~= oldBounds ifTrue: [(aWorld := self world) ifNotNil: [aWorld viewBox ifNotNil:
			[aWorld displayWorld]]]]! !

!Morph methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 1/30/2015 16:29'!
brickThemer
	^ (self nearestOwnerThat: [ :each | (each isKindOf: GLMFoundationBrick) | (each isKindOf: GLMBrick) ])
		ifNotNil: [ :brick | brick themer ]
		ifNil: [ self theme brickThemer ]! !

!Morph methodsFor: 'announcements' stamp: 'ThierryGoubier 1/8/2014 14:36'!
announceKeyboardFocusChange: gotFocus
	| announcement |
	announcement := gotFocus 
						ifTrue: [ MorphGotFocus morph: self ]
						ifFalse: [ MorphLostFocus morph: self ].
	self doAnnounce: announcement.
	Morph announcer announce: announcement.! !

!Morph methodsFor: 'drawing' stamp: 'gvc 9/11/2009 17:59'!
clipSubmorphs: aBool
	"Drawing specific. If this property is set, clip the receiver's submorphs to the receiver's clipping bounds."
	self invalidRect: self fullBounds.
	
	aBool == self clipSubmorphs ifFalse:[
		self assureExtension.
		extension clipSubmorphs: aBool.
		self invalidRect: self fullBounds]! !

!Morph methodsFor: 'drawing' stamp: 'jm 6/11/97 17:21'!
imageForm

	^ self imageFormForRectangle: self fullBounds
! !

!Morph methodsFor: '*Morphic-Base' stamp: 'CamilleTeruel 12/6/2013 14:38'!
setArrowheads
	"Let the user edit the size of arrowheads for this object"

	| aParameter result  |
	aParameter := self renderedMorph valueOfProperty:  #arrowSpec ifAbsent: [PolygonMorph defaultArrowSpec].
	result := Morph obtainArrowheadFor: 'Head size for arrowheads: ' translated defaultValue: aParameter asString.
	result ifNotNil:
			[self renderedMorph  setProperty: #arrowSpec toValue: result]
		ifNil:
			[ self inform: 'Invalid input']! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'ar 2/6/2001 22:12'!
justGrabbedFrom: formerOwner
	"The receiver was just grabbed from its former owner and is now attached to the hand. By default, we pass this message on if we're a renderer."
	(self isRenderer and:[self hasSubmorphs]) 
		ifTrue:[self firstSubmorph justGrabbedFrom: formerOwner].! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 20:03'!
wrapDirection
	"Layout specific. This property describes the direction along which a list-like layout should be wrapped. Possible values are:
		#leftToRight
		#rightToLeft
		#topToBottom
		#bottomToTop
		#none
	indicating in which direction wrapping should occur. This direction must be orthogonal to the list direction, that is if listDirection is #leftToRight or #rightToLeft then wrapDirection must be #topToBottom or #bottomToTop and vice versa."
	| props |
	props := self layoutProperties.
	^props ifNil:[#none] ifNotNil:[props wrapDirection].! !

!Morph methodsFor: 'debug and other' stamp: 'RAA 5/24/2000 18:20'!
resumeAfterStepError
	"Resume stepping after an error has occured."

	self startStepping. "Will #step"
	self removeProperty:#errorOnStep. "Will remove prop only if #step was okay"
! !

!Morph methodsFor: 'menus' stamp: 'StephaneDucasse 10/27/2014 09:34'!
addMiscExtrasTo: aMenu
	"Add a submenu of miscellaneous extra items to the menu."

	self isWorldMorph
		ifFalse: [ 
			| subMenu |
			subMenu := UIManager default newMenuIn: self for: self.
			(self renderedMorph isSystemWindow not)
				ifTrue: [ subMenu add: 'put in a window' selector: #embedInWindow ].
			subMenu add: 'adhere to edge...' selector: #adhereToEdge.
			aMenu add: 'extras...' subMenu: subMenu ]! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'ar 9/18/2000 18:34'!
wantsToBeDroppedInto: aMorph
	"Return true if it's okay to drop the receiver into aMorph. This check is symmetric to #wantsDroppedMorph:event: to give both parties a chance of figuring out whether they like each other."
	^true! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/25/2008 22:42'!
focusChanged
	"Report that the area occupied by the morph's focus indicator should be redrawn.
	Optimized for border-only (no fill)."
	
	|rects fm|
	fm := self focusIndicatorMorph.
	fm fillStyle isTransparent
		ifTrue: [fm borderWidth > 0 ifTrue: [
					rects := fm bounds areasOutside: (fm bounds insetBy: fm borderWidth).
					rects do: [:r | self invalidRect: r]]]
		ifFalse: [self invalidRect: fm bounds]! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/14/2000 17:21'!
layoutProperties: newProperties
	"Return the current layout properties associated with the receiver"
	self layoutProperties == newProperties ifTrue:[^self].
	self assureExtension layoutProperties: newProperties.
! !

!Morph methodsFor: 'accessing' stamp: 'sw 11/26/2001 16:18'!
borderStyleForSymbol: aStyleSymbol
	"Answer a suitable BorderStyle for me of the type represented by a given symbol"

	| aStyle existing |
	aStyle := BorderStyle borderStyleForSymbol: aStyleSymbol asSymbol.
	aStyle ifNil: [self error: 'bad style'].
	existing := self borderStyle.
	aStyle width: existing width;
		baseColor: existing baseColor.
	^ (self canDrawBorder: aStyle)
		ifTrue:
			[aStyle]
		ifFalse:
			[nil]! !

!Morph methodsFor: 'geometry' stamp: 'efc 2/13/2003 18:12'!
topRight: aPoint
	" Move me so that my top right corner is at aPoint. My extent (width & height) are unchanged "

	self position: ((aPoint x - bounds width) @ (aPoint y))
! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'AlainPlantec 12/1/2010 09:35'!
rejectDropMorphEvent: evt
	"The receiver has been rejected, and must be put back somewhere.  There are three cases:
	(1)  It remembers its former owner and position, and goes right back there
	(2)  It remembers its former position only, in which case it was torn off from a parts bin, and the UI is that it floats back to its donor position and then vanishes."

	self formerOwner notNil 
		ifTrue: [^ self slideBackToFormerSituation: evt].

	self formerPosition  "Position but no owner -- can just make it vanish"
		ifNotNil: [^ self vanishAfterSlidingTo: self formerPosition event: evt].! !

!Morph methodsFor: 'structure' stamp: 'wiz 12/7/2006 15:12'!
renderedMorph
	"This now  gets overridden by rendering morphs."

	^self! !

!Morph methodsFor: 'text-anchor' stamp: 'ar 12/16/2001 18:36'!
textAnchorType
	^self valueOfProperty: #textAnchorType ifAbsent:[#document]! !

!Morph methodsFor: 'drawing' stamp: 'ar 9/1/2000 14:23'!
imageForm: depth forRectangle: rect
	| canvas |
	canvas := Display defaultCanvasClass extent: rect extent depth: depth.
	canvas translateBy: rect topLeft negated
		during:[:tempCanvas| tempCanvas fullDrawMorph: self].
	^ canvas form offset: rect topLeft! !

!Morph methodsFor: 'accessing' stamp: 'gvc 9/11/2009 17:52'!
color: aColor
	"Set the receiver's color.  Directly set the color if appropriate, else go by way of fillStyle"

	(aColor isColor or: [aColor isKindOf: InfiniteForm]) ifFalse:[^ self fillStyle: aColor].
	color = aColor ifFalse:
		[self assureExtension.
		extension fillStyle: nil.
		color := aColor.
		self changed]! !

!Morph methodsFor: 'meta-actions' stamp: 'MarcusDenker 11/28/2009 14:34'!
invokeMetaMenuAt: aPoint event: evt 
	| morphs target |
	morphs := self morphsAt: aPoint.
	(morphs includes: self)
		ifFalse: [morphs := morphs copyWith: self].
	morphs size = 1
		ifTrue: [morphs anyOne invokeMetaMenu: evt]
		ifFalse: [target := UIManager default
						chooseFrom: (morphs
								collect: [:t | t class name asString])
						values: morphs.
			target 
				ifNil: [^ self].
			target invokeMetaMenu: evt]! !

!Morph methodsFor: '*glamour-morphic-widgets' stamp: 'cyrilledelaunay 6/6/2011 16:39'!
glamourMinExtent

	^ self minExtent! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'GaryChambers 12/2/2011 12:00'!
theme: aUITheme
	"Set the current theme for the receiver."

	self theme = aUITheme ifFalse: [
		self basicTheme: aUITheme.
		self themeChanged]! !

!Morph methodsFor: '*Morphic-Base' stamp: 'sw 2/21/2000 15:21'!
collapse
	CollapsedMorph new beReplacementFor: self! !

!Morph methodsFor: 'drawing' stamp: 'dgd 2/16/2003 20:02'!
clipLayoutCells
	"Drawing/layout specific. If this property is set, clip the  
	submorphs of the receiver by its cell bounds."
	^ self
		valueOfProperty: #clipLayoutCells
		ifAbsent: [false]! !

!Morph methodsFor: 'meta-actions' stamp: 'MarcusDenker 11/28/2009 14:34'!
inspectAt: aPoint event: evt
	|  morphs target |
	morphs := self morphsAt: aPoint.
	(morphs includes: self) ifFalse:[morphs := morphs copyWith: self].
	target := UIManager default
				chooseFrom: (morphs
						collect: [:t |t class name asString])
				values: morphs
				title: ('inspect whom? (deepest at top)' translated).
	target ifNil:[^self].
	target inspectInMorphic: evt! !

!Morph methodsFor: 'geometry' stamp: 'efc 2/13/2003 18:22'!
width: aNumber
	" Set my width; my position (top-left corner) and height will remain the same "

	self extent: aNumber asInteger@self height.
! !

!Morph methodsFor: 'layout-menu' stamp: 'StephaneDucasse 4/22/2012 16:50'!
hasDisableTableLayoutString
	^ (self disableTableLayout) -> 'disable layout in tables' translated! !

!Morph methodsFor: 'recategorized' stamp: 'gvc 1/28/2008 16:17'!
rejectsEvent: anEvent
	"Return true to reject the given event.
	Rejecting an event means neither the receiver nor any of it's submorphs will be given any chance to handle it.
	If the event is a mouse wheel event then only reject if the receiver is not visible."
	
	(anEvent isMouse and: [anEvent isMouseWheel])
		ifTrue: [^self visible not].
	^self isLocked or: [self visible not]! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/11/2007 12:27'!
takesKeyboardFocus
	"Answer whether the receiver can normally take keyboard focus."

	^ false! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'GuillermoPolito 9/1/2010 18:41'!
formerPosition: formerPosition 
	formerPosition ifNil: [self removeProperty: #formerPosition]
		ifNotNil: [self setProperty: #formerPosition toValue: formerPosition]! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/11/2007 12:06'!
previousMorphInWindow
	"Answer the next morph in the window. Traverse
	from the receiver to its previous sibling's last submorph (recursive)
	or owner's previous sibling's last submorph (recursive) etc."

	^self submorphBefore notNil
		ifTrue: [self submorphBefore lastSubmorphRecursive]
		ifFalse: [self owner]! !

!Morph methodsFor: 'classification' stamp: ''!
isWorldOrHandMorph

	^ self isWorldMorph or: [self isHandMorph]! !

!Morph methodsFor: 'recategorized' stamp: 'StephaneDucasse 11/1/2009 19:24'!
privateMoveBy: delta 
	"Private!! Use 'position:' instead."
	| fill border|
	bounds := bounds translateBy: delta.
	fullBounds ifNotNil: [fullBounds := fullBounds translateBy: delta].
	fill := self fillStyle.
	fill isOrientedFill ifTrue: [fill origin: fill origin + delta].
	border := self borderStyle.
	(border hasFillStyle and: [border fillStyle isOrientedFill]) ifTrue: [
		border fillStyle origin: border fillStyle origin + delta]! !

!Morph methodsFor: 'events-processing' stamp: 'StephaneDucasse 7/18/2010 16:22'!
mouseDownPriority
	"Return the default mouse down priority for the receiver"

	^ 0
! !

!Morph methodsFor: 'geometry' stamp: 'efc 2/13/2003 18:08'!
bottomLeft: aPoint
	" Move me so that my bottom left corner is at aPoint. My extent (width & height) are unchanged "

	self position: ((aPoint x) @ (aPoint y - self height)).
! !

!Morph methodsFor: 'halos and balloon help' stamp: 'RAA 7/21/2000 11:10'!
boundsForBalloon

	"some morphs have bounds that are way too big"
	^self boundsInWorld! !

!Morph methodsFor: 'event handling' stamp: 'sw 4/2/98 14:16'!
hasFocus
	^ false! !

!Morph methodsFor: 'halos and balloon help' stamp: 'sma 11/11/2000 14:54'!
balloonColor
	^ self
		valueOfProperty: #balloonColor
		ifAbsent: [self defaultBalloonColor]! !

!Morph methodsFor: 'naming' stamp: 'gm 2/22/2003 13:16'!
name: aName 
	(aName isString) ifTrue: [self setNameTo: aName]! !

!Morph methodsFor: 'geometry' stamp: 'ClementBera 7/30/2013 11:03'!
goHome
	| box fb |
	owner ifNil: [^ self].
	self visible ifFalse: [^ self].

	box := owner visibleClearArea.
	fb := self fullBounds.

	fb left < box left
		ifTrue: [self left: box left - fb left + self left].
	fb right > box right
		ifTrue: [self right: box right - fb right + self right].

	fb top < box top
		ifTrue: [self top: box top - fb top + self top].
	fb bottom > box bottom
		ifTrue: [self bottom: box bottom - fb bottom + self bottom].
! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 20:04'!
listDirection: aSymbol
	"Layout specific. This property describes the direction in which a list-like layout should be applied. Possible values are:
		#leftToRight
		#rightToLeft
		#topToBottom
		#bottomToTop
	indicating the direction in which any layout should take place"
	self assureTableProperties listDirection: aSymbol.
	self layoutChanged.! !

!Morph methodsFor: 'event handling' stamp: 'tbn 3/12/2010 01:55'!
windowEvent: anEvent
	"Host window event"! !

!Morph methodsFor: 'event handling' stamp: 'ar 1/10/2001 21:28'!
wantsDropFiles: anEvent
	"Return true if the receiver wants files dropped from the OS."
	^false! !

!Morph methodsFor: 'thumbnail' stamp: 'dgd 9/13/2004 12:43'!
iconOrThumbnailOfSize: aNumberOrPoint 
	"Answer an appropiate form to represent the receiver"

	^ self iconOrThumbnail scaledIntoFormOfSize: aNumberOrPoint
! !

!Morph methodsFor: '*Athens-Morphic' stamp: 'IgorStasenko 11/7/2012 19:16'!
testAthensRender

| surf |
	surf := AthensCairoSurface extent: Display extent.

	surf drawDuring: [:can |
"		can pathTransform scaleBy: 0.5; rotateByDegrees: 30."
		self fullDrawOnAthensCanvas: can ].

	Display getCanvas drawImage: 	surf asForm  at: 0@0
! !

!Morph methodsFor: 'geometry' stamp: 'ar 10/25/2000 15:07'!
localPointToGlobal: aPoint
	^self point: aPoint in: nil! !

!Morph methodsFor: 'copying' stamp: 'AlainPlantec 12/1/2010 09:35'!
prepareToBeSaved
	"Prepare this morph to be saved to disk. Subclasses should nil out any instance variables that holds state that should not be saved, such as cached Forms. Note that this operation may take more drastic measures than releaseCachedState; for example, it might discard the transcript of an interactive chat session."

	self releaseCachedState.
	self formerOwner: nil.
	self formerPosition: nil.
	fullBounds := nil! !

!Morph methodsFor: 'private' stamp: 'AlainPlantec 10/3/2011 01:21'!
privateAddAllMorphs: aCollection atIndex: index
	"Private. Add aCollection of morphs to the receiver"
	| myWorld otherSubmorphs |
	myWorld := self world.
	otherSubmorphs := submorphs copyWithoutAll: aCollection.
	(index between: 0 and: otherSubmorphs size)
		ifFalse: [^ self error: 'index out of range'].
	index = 0
		ifTrue:[	submorphs := aCollection asArray, otherSubmorphs]
		ifFalse:[	index = otherSubmorphs size
			ifTrue:[	submorphs := otherSubmorphs, aCollection]
			ifFalse:[	submorphs := otherSubmorphs copyReplaceFrom: index + 1 to: index with: aCollection ]].
	aCollection do: [:m | | itsOwner itsWorld |
		itsOwner := m owner.
		itsOwner ifNotNil: [
			itsWorld := m world.
			(itsWorld == myWorld) ifFalse: [
				itsWorld ifNotNil: [self privateInvalidateMorph: m].
				m outOfWorld: itsWorld].
			(itsOwner ~~ self) ifTrue: [
				m owner privateRemove: m.
				m owner removedMorph: m ]].
		m privateOwner: self.
		myWorld ifNotNil: [self privateInvalidateMorph: m].
		(myWorld == itsWorld) ifFalse: [m intoWorld: myWorld].
		itsOwner == self ifFalse: [
			self addedMorph: m.
			m noteNewOwner: self ].
	].
	self layoutChanged.
! !

!Morph methodsFor: 'meta-actions' stamp: 'StephaneDucasse 10/27/2014 17:58'!
addEmbeddingMenuItemsTo: aMenu hand: aHandMorph
	"Construct a menu offerring embed targets for the receiver.  If the incoming menu is is not degenerate, add the constructed menu as a submenu; in any case, answer the embed-target menu"

	| menu potentialEmbeddingTargets |
	potentialEmbeddingTargets := self potentialEmbeddingTargets.
	potentialEmbeddingTargets size > 1
		ifFalse: [ ^ self ].
	menu := UIManager default newMenuIn: self for: self.
	potentialEmbeddingTargets
		reverseDo: [ :m | 
			menu
				add: m class name asString
				target: m
				selector: #addMorphFrontFromWorldPosition:
				argument: self topRendererOrSelf.
			menu lastItem icon: (m iconOrThumbnailOfSize: 16).
			self owner == m
				ifTrue: [ menu lastItem emphasis: 1 ] ].
	aMenu add: 'embed into' subMenu: menu.
	^ menu! !

!Morph methodsFor: 'geometry' stamp: 'sw 6/11/1999 18:48'!
center: aPoint
	self position: (aPoint - (self extent // 2))! !

!Morph methodsFor: 'change reporting' stamp: 'IgorStasenko 12/22/2012 03:13'!
invalidRect: aRectangle from: aMorph
	| damageRect |
	aRectangle hasPositiveExtent ifFalse: [ ^self ].
	damageRect := aRectangle.
	aMorph == self ifFalse:[
		"Clip to receiver's clipping bounds if the damage came from a child"
		self clipSubmorphs 
			ifTrue:[damageRect := aRectangle intersect: self clippingBounds ifNone: [ ^ self ]]].
	owner ifNotNil: [owner invalidRect: damageRect from: self].! !

!Morph methodsFor: 'accessing' stamp: 'usmanbhatti 3/6/2012 19:23'!
halosEnabled

	^ self class halosEnabled! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'michael.rueger 3/9/2009 18:48'!
goBehind

	owner addMorphBack: self.
! !

!Morph methodsFor: 'event handling' stamp: 'ar 10/25/2000 18:02'!
mouseStillDownThreshold
	"Return the number of milliseconds after which mouseStillDown: should be sent"
	^200! !

!Morph methodsFor: 'meta-actions' stamp: 'mir 3/17/2006 18:01'!
dismissMorph: evt
	self dismissMorph! !

!Morph methodsFor: 'geometry' stamp: 'tk 9/8/97 10:44'!
bottomLeft

	^ bounds bottomLeft! !

!Morph methodsFor: 'geometry' stamp: 'efc 2/13/2003 18:15'!
left: aNumber
	" Move me so that my left side is at the x-coordinate aNumber. My extent (width & height) are unchanged "

	self position: (aNumber @ bounds top)! !

!Morph methodsFor: 'geometry' stamp: 'di 3/6/2002 13:06'!
rightCenter

	^ bounds rightCenter! !

!Morph methodsFor: '*Morphic-Base' stamp: 'ar 10/26/2000 18:58'!
setShadowOffset: evt
	| handle |
	handle := HandleMorph new forEachPointDo:
		[:newPoint | self shadowPoint: newPoint].
	evt hand attachMorph: handle.
	handle startStepping.
! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'dgd 9/1/2004 16:26'!
deleteDockingBars
	"Delete the receiver's docking bars"
	self dockingBars
		do: [:each | each delete]! !

!Morph methodsFor: 'wiw support' stamp: 'RAA 7/19/2000 20:44'!
morphicLayerNumber

	"helpful for insuring some morphs always appear in front of or behind others.
	smaller numbers are in front"

	^(owner isNil or: [owner isWorldMorph]) ifTrue: [
		self valueOfProperty: #morphicLayerNumber ifAbsent: [100]
	] ifFalse: [
		owner morphicLayerNumber
	].

	"leave lots of room for special things"! !

!Morph methodsFor: 'structure' stamp: 'dgd 2/22/2003 19:06'!
topRendererOrSelf
	"Answer the topmost renderer for this morph, or this morph itself if it has no renderer. See the comment in Morph>isRenderer."

	| top topsOwner |
	owner ifNil: [^self].
	self isWorldMorph ifTrue: [^self].	"ignore scaling of this world"
	top := self.
	topsOwner := top owner.
	[topsOwner notNil and: [topsOwner isRenderer]] whileTrue: 
			[top := topsOwner.
			topsOwner := top owner].
	^top! !

!Morph methodsFor: 'event handling' stamp: 'GuillermoPolito 3/15/2013 16:17'!
keyStroke: anEvent
	"Handle a keystroke event.  The default response is to let my eventHandler, if any, handle it."
	^false! !

!Morph methodsFor: 'deferred message' stamp: 'AlainPlantec 3/10/2015 20:16'!
defer: aValuable
	"aValuable will be executed in the next UI rendering cycle"
	self owner 
		ifNotNil: [ self owner defer: aValuable] 
		ifNil: [ UIManager default defer: aValuable ]! !

!Morph methodsFor: 'geometry' stamp: 'di 9/30/1998 12:11'!
positionInWorld

	^ self pointInWorld: self position.
! !

!Morph methodsFor: 'accessing - extension' stamp: 'md 2/27/2006 08:31'!
hasExtension
	"answer whether the receiver has extention"
	^ extension notNil! !

!Morph methodsFor: 'event handling' stamp: 'ar 10/22/2000 17:08'!
mouseStillDown: evt
	"Handle a mouse move event. The default response is to let my eventHandler, if any, handle it."

	self eventHandler ifNotNil:
		[self eventHandler mouseStillDown: evt fromMorph: self].
! !

!Morph methodsFor: 'accessing' stamp: 'sw 7/2/1998 13:51'!
highlightColor: aColor
	self setProperty: #highlightColor toValue: aColor! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 19:55'!
cellSpacing
	"Layout specific. This property describes how the cell size for each element in a list should be computed.
		#globalRect - globally equal rectangular cells
		#globalSquare - globally equal square cells
		#localRect - locally (e.g., per row/column) equal rectangular cells
		#localSquare - locally (e.g., per row/column) equal square cells
		#none - cells are sized based on available row/column constraints
	"
	| props |
	props := self layoutProperties.
	^props ifNil:[#none] ifNotNil:[props cellSpacing].! !

!Morph methodsFor: 'events-processing' stamp: 'ar 9/13/2000 17:58'!
containsPoint: aPoint event: anEvent
	"Return true if aPoint is considered to be inside the receiver for the given event.
	The default implementation treats locked children as integral part of their owners."
	(self fullBounds containsPoint: aPoint) ifFalse:[^false].
	(self containsPoint: aPoint) ifTrue:[^true].
	self submorphsDo:[:m|
		(m isLocked and:[m fullContainsPoint: 
			((m transformedFrom: self) globalPointToLocal: aPoint)]) ifTrue:[^true]].
	^false! !

!Morph methodsFor: 'testing' stamp: ''!
isMorph

	^ true! !

!Morph methodsFor: 'updating' stamp: 'MarcusDenker 3/2/2015 17:48'!
changed: anAspect with: anObject

	self announcer announce: (MorphChangedWithArguments new
		morph: self;
		selector: anAspect;
		arguments: anObject)! !

!Morph methodsFor: 'meta-actions' stamp: 'MarcusDenker 9/13/2013 15:50'!
potentialEmbeddingTargets
	"Return the potential targets for embedding the receiver"

	| oneUp topRend |
	(oneUp := (topRend := self topRendererOrSelf) owner) ifNil: [ ^ #() ].
	^ (oneUp morphsAt: topRend referencePosition behind: topRend unlocked: true) reject: [ :m | m isFlexMorph ]! !

!Morph methodsFor: 'drop shadows' stamp: 'ar 10/26/2000 20:16'!
toggleDropShadow
	self hasDropShadow
		ifTrue:[self removeDropShadow]
		ifFalse:[self addDropShadow].! !

!Morph methodsFor: 'text-anchor' stamp: 'StephaneDucasse 4/22/2012 16:51'!
hasInlineAnchorString
	^ (self textAnchorType == #inline)-> 'Inline' translated! !

!Morph methodsFor: 'event handling' stamp: 'ar 10/28/2000 22:18'!
handlesKeyboard: evt
	"Return true if the receiver wishes to handle the given keyboard event"
	self eventHandler ifNotNil: [^ self eventHandler handlesKeyboard: evt].
	^ false
! !

!Morph methodsFor: 'geometry' stamp: 'ar 10/25/2000 15:01'!
point: aPoint in: aReferenceMorph

	owner ifNil: [^ aPoint].
	^ (owner transformFrom: aReferenceMorph) localPointToGlobal: aPoint.
! !

!Morph methodsFor: 'event handling' stamp: 'ar 1/10/2001 21:28'!
dropFiles: anEvent
	"Handle a number of files dropped from the OS"
! !

!Morph methodsFor: 'initialize' stamp: 'alain.plantec 6/10/2008 18:35'!
openInWorld
        "Add this morph to the world."

        self openInWorld: self currentWorld! !

!Morph methodsFor: 'drawing' stamp: 'ar 11/4/2000 23:39'!
changeClipSubmorphs
	self clipSubmorphs: self clipSubmorphs not.! !

!Morph methodsFor: 'menus' stamp: 'di 12/21/2000 17:18'!
setToAdhereToEdge: anEdge
	anEdge ifNil: [^ self].
	anEdge == #none ifTrue: [^ self removeProperty: #edgeToAdhereTo].
	self setProperty: #edgeToAdhereTo toValue: anEdge.
! !

!Morph methodsFor: '*Morphic-Base' stamp: 'ar 10/31/2000 19:20'!
changeTableLayout
	| layout |
	((layout := self layoutPolicy) notNil and:[layout isTableLayout])
		ifTrue:[^self]. "already table layout"
	self layoutPolicy: TableLayout new.
	self layoutChanged.! !

!Morph methodsFor: 'drawing' stamp: 'StephaneDucasse 6/2/2014 21:29'!
fullDrawOn: aCanvas
	"Draw the full Morphic structure on the given Canvas"

	self visible ifFalse: [^ self].
	(aCanvas isVisible: self fullBounds) ifFalse:[^self].
	
	(self hasProperty: #errorOnDraw) ifTrue:[^self drawErrorOn: aCanvas].
	
	[
		"Note: At some point we should generalize this into some sort of 
		multi-canvas so that we can cross-optimize some drawing operations."
		"Pass 1: Draw eventual drop-shadow"
		self hasDropShadow ifTrue: [ self drawDropShadowOn: aCanvas ].

		"Pass 2: Draw receiver itself"
		
		aCanvas roundCornersOf: self during:[
			(aCanvas isVisible: self bounds) ifTrue:[aCanvas drawMorph: self].
			self drawSubmorphsOn: aCanvas.
			self drawDropHighlightOn: aCanvas.
			self drawMouseDownHighlightOn: aCanvas]
		
	] on: Error do: [:err |
		self setProperty: #errorOnDraw toValue: true.
		self setProperty: #drawError toValue: err freeze.
		^ self drawErrorOn: aCanvas
	]! !

!Morph methodsFor: 'layout' stamp: 'StephaneDucasse 5/31/2013 19:18'!
computeBounds
	[ self doLayoutIn: self layoutBounds ]
		on: Error
		do: [ :ex | 
			"This should do it unless you don't screw up the bounds"
			fullBounds := bounds.
			ex pass ]! !

!Morph methodsFor: 'event handling' stamp: 'RAA 6/19/2000 07:13'!
transformFromOutermostWorld
	"Return a transform to map world coordinates into my local coordinates"

	"self isWorldMorph ifTrue: [^ MorphicTransform identity]."
	^ self transformFrom: self outermostWorldMorph! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'ar 10/8/2000 15:44'!
rootMorphsAt: aPoint
	"Return the list of root morphs containing the given point, excluding the receiver.
	ar 11/8/1999: Moved into morph for an incredibly ugly hack in 3D worlds"
self flag: #arNote. "check this at some point"
	^ self submorphs select:
		[:m | (m fullContainsPoint: aPoint) and: [m isLocked not]]! !

!Morph methodsFor: 'meta-actions' stamp: 'MarcusDenker 11/7/2009 18:50'!
maybeDuplicateMorph: evt
	^self duplicateMorph: evt! !

!Morph methodsFor: 'event handling' stamp: 'StephaneDucasse 7/2/2013 16:26'!
moveOrResizeFromKeystroke: anEvent
	"move or resize the receiver based on a keystroke"

	| dir |
	anEvent keyValue = 28
		ifTrue: [ dir := -1 @ 0 ].
	anEvent keyValue = 29
		ifTrue: [ dir := 1 @ 0 ].
	anEvent keyValue = 30
		ifTrue: [ dir := 0 @ -1 ].
	anEvent keyValue = 31
		ifTrue: [ dir := 0 @ 1 ].
	dir notNil
		ifTrue: [ 
			anEvent controlKeyPressed
				ifTrue: [ dir := dir * 10 ].
			anEvent shiftPressed
				ifTrue: [ self extent: self extent + dir ]
				ifFalse: [ self position: self position + dir ] ]! !

!Morph methodsFor: 'event handling' stamp: 'sw 11/16/1998 08:07'!
suspendEventHandler
	self eventHandler ifNotNil:
		[self setProperty: #suspendedEventHandler toValue: self eventHandler.
		self eventHandler: nil].
	submorphs do: [:m | m suspendEventHandler].  "All those rectangles"! !

!Morph methodsFor: 'event handling' stamp: 'CamilloBruni 8/1/2012 16:02'!
click: evt
	"Handle a single-click event. This message is only sent to clients that request it by sending #waitForClicksOrDrag:event: to the initiating hand in their mouseDown: method. This default implementation does nothing."

	^ self eventHandler ifNotNil:
		[self eventHandler click: evt fromMorph: self].! !

!Morph methodsFor: 'text-anchor' stamp: 'StephaneDucasse 4/22/2012 16:52'!
hasParagraphAnchorString
	^ (self textAnchorType == #paragraph) -> 'Paragraph' translated! !

!Morph methodsFor: '*SUnit-UITesting' stamp: 'SeanDeNigris 12/9/2011 14:07'!
simulateClickWith: buttons
	"Did you know there's #simulateClick (left), #simulateMiddleClick, and #simulateRightClick?
	buttons - look at MouseEvent's class-side for button types"

	| noButtons |
	noButtons := 0.
	{ #mouseDown->buttons. #mouseUp->noButtons } do: [ :type |
		self activeHand handleEvent: (MouseButtonEvent new 
			setType: type key
			position: (self pointInWorld: self center) "Some Morphs report local coords"
			which: (noButtons bitXor: buttons)
			buttons: type value
			hand: self activeHand
			stamp: Time millisecondClockValue) ].! !

!Morph methodsFor: 'layout' stamp: 'Sd 8/2/2014 15:50'!
adjustLayoutBounds
	"Adjust the receivers bounds depending on the resizing strategy imposed"

	| hFit vFit box myExtent extent |
	hFit := self hResizing.
	vFit := self vResizing.
	(hFit == #shrinkWrap or: [ vFit == #shrinkWrap ])
		ifFalse: [ ^ self ].	"not needed"
	box := self layoutBounds.
	myExtent := box extent.
	extent := self submorphBounds corner - box origin.
	hFit == #shrinkWrap
		ifTrue: [ myExtent := extent x @ myExtent y ].
	vFit == #shrinkWrap
		ifTrue: [ myExtent := myExtent x @ extent y ].	"Make sure we don't get smaller than minWidth/minHeight"
	myExtent x < self minWidth
		ifTrue: [ myExtent := (myExtent x max: self minWidth - self bounds width + self layoutBounds width) @ myExtent y ].
	myExtent y < self minHeight
		ifTrue: [ myExtent := myExtent x @ (myExtent y max: self minHeight - self bounds height + self layoutBounds height) ].
	self layoutBounds: (box origin extent: myExtent)! !

!Morph methodsFor: 'geometry' stamp: 'efc 2/13/2003 18:16'!
right
	" Return the x-coordinate of my right side "
	^ bounds right! !

!Morph methodsFor: 'undo' stamp: 'CamilleTeruel 12/6/2013 14:38'!
undoMove: cmd redo: redo owner: formerOwner bounds: formerBounds predecessor: formerPredecessor 
	"Handle undo and redo of move commands in morphic"

	self owner ifNil: [ ^ self inform: 'No owner' ].

	formerOwner ifNotNil: 
			[formerPredecessor ifNil: [formerOwner addMorphFront: self]
				ifNotNil: [formerOwner addMorph: self after: formerPredecessor]].
	self bounds: formerBounds.
	(self isSystemWindow) ifTrue: [self activate]! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'ar 10/5/2000 18:13'!
formerOwner
	^self valueOfProperty: #formerOwner! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'dgd 2/22/2003 14:31'!
firstSubmorph
	^submorphs first! !

!Morph methodsFor: 'geometry' stamp: 'di 3/6/2002 13:06'!
bottomCenter

	^ bounds bottomCenter! !

!Morph methodsFor: 'accessing' stamp: 'gvc 9/11/2009 17:09'!
borderStyle

	extension ifNil: [^BorderStyle default trackColorFrom: self].
	^(extension borderStyle ifNil: [BorderStyle default]) trackColorFrom: self! !

!Morph methodsFor: 'announcements' stamp: 'BernardoContreras 10/3/2014 11:31'!
onAnnouncement: anAnnouncement send: aMessageSelector to: anObject
	self announcer when: anAnnouncement send: aMessageSelector to: anObject.! !

!Morph methodsFor: 'geometry testing' stamp: ''!
containsPoint: aPoint

	^ self bounds containsPoint: aPoint! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/12/2009 18:12'!
roundedCorners
	"Return a list of those corners to round.

		1-4
		|  |
		2-3

	Returned array contains `codes' of those corners, which should be rounded.

	1 denotes top-left corner
	2 denotes bottom-left corner
	3 denotes bottom-right corner
	4 denotes top-right corner.

	Thus, if this method returned #(2 3) that would mean that bottom (left and right)
	corners would be rounded whereas top (left and right) corners wouldn't be rounded.

	This method returns #(1 2 3 4) and that means that all the corners should be rounded."

	^self valueOfProperty: #roundedCorners ifAbsent: [#(1 2 3 4)]! !

!Morph methodsFor: 'copying' stamp: 'tk 2/14/2001 12:47'!
deepCopy

	self error: 'Please use veryDeepCopy'.
! !

!Morph methodsFor: 'accessing' stamp: 'PavelKrivanek 7/24/2014 10:58'!
embeddedWindowOrNil

	"answer nil for common morphs, yourself from system windows and first submorph for transformation morphs"

	^ nil! !

!Morph methodsFor: 'accessing' stamp: 'dgd 2/16/2003 19:25'!
eventHandler: anEventHandler 
	"Note that morphs can share eventHandlers and all is OK. "
	self assureExtension eventHandler: anEventHandler! !

!Morph methodsFor: 'Morphic-Base-Pluggable Widgets' stamp: 'BenjaminVanRyseghem 5/7/2012 15:03'!
beginsWith: aString fromList: aMorph
	| string |
	string := self userString ifNil: [(self submorphs collect: [:m | m userString]) detect: [:us | us notNil] ifNone: ['']].
	
	^ string asString beginsWith: aString fromList: aMorph! !

!Morph methodsFor: 'structure' stamp: 'ar 3/18/2001 00:11'!
activeHand
	^ActiveHand! !

!Morph methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 1/20/2015 22:58'!
brickDoubleLink

	^ self valueOfProperty: #brickDoubleLink ifAbsentPut: [ nil ]! !

!Morph methodsFor: 'events-alarms' stamp: 'ar 9/11/2000 16:35'!
addAlarm: aSelector with: arg1 at: scheduledTime
	"Add an alarm (that is an action to be executed once) with the given set of parameters"
	^self addAlarm: aSelector withArguments: (Array with: arg1) at: scheduledTime! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/12/2007 10:12'!
initialColorInSystemWindow: aSystemWindow
	"Answer the colour the receiver should be when added to a SystemWindow."

	^Color white! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/10/2007 10:07'!
window
	"Answer the receiver's window."

	^self ownerThatIsA: SystemWindow! !

!Morph methodsFor: 'layout-menu' stamp: 'ar 11/13/2000 18:54'!
changeClipLayoutCells
	self invalidRect: self fullBounds.
	self clipLayoutCells: self clipLayoutCells not.
	self invalidRect: self fullBounds.! !

!Morph methodsFor: '*Athens-Morphic' stamp: 'IgorStasenko 9/6/2013 12:12'!
athensSurface

	^ owner 
		ifNil: [  nil ]
		ifNotNil: [ owner athensSurface  ]! !

!Morph methodsFor: 'drawing' stamp: 'tk 8/2/1998 14:33'!
doesOwnRotation
	"Some morphs don't want to TransformMorph to rotate their images, but we do"
	^ false! !

!Morph methodsFor: '*Keymapping-Core' stamp: 'GuillermoPolito 11/7/2013 16:52'!
handleKeystrokeWithKeymappings: aKeystrokeEvent

	self allowsKeymapping ifTrue: [
		self dispatchKeystrokeForEvent: aKeystrokeEvent.
	].! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'StephaneDucasse 12/21/2012 18:11'!
addMorph: aMorph fullFrame: aLayoutFrame

	aMorph layoutFrame: aLayoutFrame asLayoutFrame.
	aMorph hResizing: #spaceFill; vResizing: #spaceFill.
	self addMorph: aMorph.

! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 9/5/2007 12:55'!
drawKeyboardFocusOn: aCanvas
	"Draw the keyboard focus indication."

	self focusIndicatorMorph
		drawOn: aCanvas! !

!Morph methodsFor: 'testing' stamp: 'StephaneDucasse 10/13/2013 21:49'!
isTranslucentButNotTransparent
	"Answer true if this any of this morph is translucent but not transparent."

	^ color isColor and: [ color isTranslucentButNotTransparent ]
! !

!Morph methodsFor: 'accessing - properties' stamp: 'md 2/27/2006 09:48'!
removeProperty: aSymbol 
	"removes the property named aSymbol if it exists"
	extension ifNil:  [^ self].
	extension removeProperty: aSymbol! !

!Morph methodsFor: 'drawing' stamp: 'LC 5/18/2000 08:48'!
highlightedForMouseDown
	^(self valueOfProperty: #highlightedForMouseDown) == true! !

!Morph methodsFor: 'layout' stamp: 'StephaneDucasse 6/2/2013 14:18'!
computeFullBounds
	[ self doLayoutIn: self layoutBounds ]
		on: Error
		do: [ :ex | 
			"This should do it unless you don't screw up the bounds"
			fullBounds := bounds.
			ex pass ]! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/20/2007 10:31'!
defaultTaskbarThumbnailExtent
	"Answer the default size of a taskbar thumbnail for the receiver."

	^320@320! !

!Morph methodsFor: 'layout-menu' stamp: 'StephaneDucasse 4/22/2012 16:52'!
hasReverseCellsString
	^ (self reverseTableCells) -> 'reverse table cells' translated! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'mir 1/4/2001 11:02'!
startDrag: anItem with: anObject
	self currentHand attachMorph: anObject! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 5/8/2007 09:58'!
optimalExtent
	"Answer the submorphBounds extent plus twice our border width."
	
	^self submorphBounds extent + (self borderWidth * 2)! !

!Morph methodsFor: 'caching' stamp: 'jm 11/13/97 16:34'!
fullReleaseCachedState
	"Release the cached state of the receiver and its full submorph tree."

	self allMorphsDo: [:m | m releaseCachedState].
! !

!Morph methodsFor: 'events-processing' stamp: 'ar 9/15/2000 21:13'!
handleEvent: anEvent
	"Handle the given event"
	^anEvent sentTo: self.! !

!Morph methodsFor: 'event handling' stamp: 'GuillermoPolito 4/22/2012 17:20'!
handlesKeyStroke: evt
	^self handlesKeyboard: evt! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'BenjaminVanRyseghem 7/29/2013 14:17'!
myDependents
	"Improved performance dependents."
	
	^ (self valueOfProperty: #myDependents) ifNil: [ #() ]! !

!Morph methodsFor: 'geometry' stamp: 'ar 10/25/2000 15:06'!
globalPointToLocal: aPoint
	^self point: aPoint from: nil! !

!Morph methodsFor: 'layout-menu' stamp: 'StephaneDucasse 10/27/2014 20:19'!
addTableLayoutMenuItems: aMenu hand: aHand
	| menu sub |
	menu := UIManager default newMenuIn: self for: self.
	menu addUpdating: #hasReverseCellsString selector: #changeReverseCells.
	menu addUpdating: #hasClipLayoutCellsString selector: #changeClipLayoutCells.
	menu addUpdating: #hasRubberBandCellsString selector: #changeRubberBandCells.
	menu addLine.
	menu add: 'change cell inset...' selector: #changeCellInset:.
	menu add: 'change min cell size...' selector: #changeMinCellSize:.
	menu add: 'change max cell size...' selector: #changeMaxCellSize:.
	menu addLine.
	sub := UIManager default newMenuIn: self for: self.
	#(#leftToRight #rightToLeft #topToBottom #bottomToTop)
		do: [ :sym | 
			sub
				addUpdating: #listDirectionString:
				target: self
				selector: #changeListDirection:
				argumentList: (Array with: sym) ].
	menu add: 'list direction' subMenu: sub.
	sub := UIManager default newMenuIn: self for: self.
	#(#none #leftToRight #rightToLeft #topToBottom #bottomToTop)
		do: [ :sym | 
			sub
				addUpdating: #wrapDirectionString:
				target: self
				selector: #wrapDirection:
				argumentList: (Array with: sym) ].
	menu add: 'wrap direction' subMenu: sub.
	sub := UIManager default newMenuIn: self for: self.
	#(#center #topLeft #topRight #bottomLeft #bottomRight #topCenter #leftCenter #rightCenter #bottomCenter)
		do: [ :sym | 
			sub
				addUpdating: #cellPositioningString:
				target: self
				selector: #cellPositioning:
				argumentList: (Array with: sym) ].
	menu add: 'cell positioning' subMenu: sub.
	sub := UIManager default newMenuIn: self for: self.
	#(#topLeft #bottomRight #center #justified)
		do: [ :sym | 
			sub
				addUpdating: #listCenteringString:
				target: self
				selector: #listCentering:
				argumentList: (Array with: sym) ].
	menu add: 'list centering' subMenu: sub.
	sub := UIManager default newMenuIn: self for: self.
	#(#topLeft #bottomRight #center #justified)
		do: [ :sym | 
			sub
				addUpdating: #wrapCenteringString:
				target: self
				selector: #wrapCentering:
				argumentList: (Array with: sym) ].
	menu add: 'wrap centering' subMenu: sub.
	sub := UIManager default newMenuIn: self for: self.
	#(#none #equal)
		do: [ :sym | 
			sub
				addUpdating: #listSpacingString:
				target: self
				selector: #listSpacing:
				argumentList: (Array with: sym) ].
	menu add: 'list spacing' subMenu: sub.
	sub := UIManager default newMenuIn: self for: self.
	#(#none #localRect #localSquare #globalRect #globalSquare)
		do: [ :sym | 
			sub
				addUpdating: #cellSpacingString:
				target: self
				selector: #cellSpacing:
				argumentList: (Array with: sym) ].
	menu add: 'cell spacing' subMenu: sub.
	aMenu ifNotNil: [ aMenu add: 'table layout' subMenu: menu ].
	^ menu! !

!Morph methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 10/5/2014 12:08'!
gtInspectorMorphIn: composite
	<gtInspectorPresentationOrder: 90>  
	| morphPresentation |
	morphPresentation := composite morph.
	morphPresentation 
		title: 'Morph';
		display: [
			self imageForm asMorph
				on: #mouseDown send: #value: to: [ :event | 
					morphPresentation selection: (self morphsAt: event position) ] ];
		act: [ :pres | self exportAsPNG ] entitled: 'Export as PNG';
		act: [ :pres | self delete ] entitled: 'Delete'! !

!Morph methodsFor: 'structure' stamp: 'di 11/13/2000 00:50'!
outermostMorphThat: conditionBlock
	"Return the outermost containing morph for which aBlock is true, or nil if none"

	| outermost |
	self allOwnersDo: [:m | (conditionBlock value: m) ifTrue: [outermost := m]].
	^ outermost! !

!Morph methodsFor: 'menus' stamp: 'sw 9/21/2000 22:50'!
lockUnlockMorph
	"If the receiver is locked, unlock it; if unlocked, lock it"

	self isLocked ifTrue: [self unlock] ifFalse: [self lock]! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'GuillermoPolito 9/1/2010 18:40'!
formerOwner: aMorphOrNil 
	aMorphOrNil ifNil: [self removeProperty: #formerOwner]
		ifNotNil: [self setProperty: #formerOwner toValue: aMorphOrNil]! !

!Morph methodsFor: 'event handling' stamp: 'CamilloBruni 10/10/2012 13:37'!
keyboardFocusChange: gotFocus
	"The message is sent to a morph when its keyboard focus change. The given argument indicates that the receiver is gaining keyboard focus (versus losing) the keyboard focus. Morphs that accept keystrokes should change their appearance in some way when they are the current keyboard focus. This default implementation does nothing."
	self announceKeyboardFocusChange: gotFocus! !

!Morph methodsFor: 'initialize' stamp: 'sma 4/22/2000 20:28'!
openInWindowLabeled: aString

	^self openInWindowLabeled: aString inWorld: self currentWorld! !

!Morph methodsFor: 'events-processing' stamp: 'BenjaminVanRyseghem 1/18/2012 18:59'!
handleMouseStillDown: anEvent
	"Called from the stepping mechanism for morphs wanting continuously repeated 'yes the mouse is still down, yes it is still down, yes it has not changed yet, no the mouse is still not up, yes the button is down' etc messages"
	(anEvent hand mouseFocus == self) 
		ifFalse:[^self stopSteppingSelector: #handleMouseStillDown:].
	self mouseStillDown: anEvent.
	^ self eventHandler ifNotNil: [:handler | handler mouseStillDown: anEvent fromMorph: self ]
! !

!Morph methodsFor: 'events-removing' stamp: 'rw 4/25/2002 07:18'!
releaseActionMap
	"Release the action map"
	
 	self removeProperty: #actionMap! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'ar 12/16/2001 21:08'!
addMorphFrontFromWorldPosition: aMorph
	^self addMorphFront: aMorph fromWorldPosition: aMorph positionInWorld.! !

!Morph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/7/2015 21:16'!
drawKeyboardFocusOnAthensCanvas: anAthensCanvas
	"Draw the keyboard focus indication."

	self focusIndicatorMorph
		drawOnAthensCanvas: anAthensCanvas! !

!Morph methodsFor: 'text-anchor' stamp: 'StephaneDucasse 10/27/2014 20:19'!
addTextAnchorMenuItems: topMenu hand: aHand
	| aMenu |
	aMenu := UIManager default newMenuIn: self for: self.
	aMenu addUpdating: #hasInlineAnchorString selector: #changeInlineAnchor.
	aMenu addUpdating: #hasParagraphAnchorString selector: #changeParagraphAnchor.
	aMenu addUpdating: #hasDocumentAnchorString selector: #changeDocumentAnchor.
	topMenu ifNotNil: [ topMenu add: 'text anchor' subMenu: aMenu ].
	^aMenu! !

!Morph methodsFor: 'accessing - extension' stamp: 'md 2/27/2006 08:46'!
assureExtension
	"creates an extension for the receiver if needed"
	extension ifNil: [self initializeExtension].
	^ extension! !

!Morph methodsFor: 'halos and balloon help' stamp: 'stephane.ducasse 9/20/2008 21:57'!
preferredDuplicationHandleSelector
	"Answer the selector, either #addMakeSiblingHandle: or addDupHandle:, to be offered as the default in a halo open on me"

	^ #addDupHandle:! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'panda 4/28/2000 11:51'!
highlightForDrop
	self highlightForDrop: true! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'nice 1/5/2010 15:59'!
morphsAt: aPoint behind: aMorph unlocked: aBool 
	"Return all morphs at aPoint that are behind frontMorph; if aBool is true return only unlocked, visible morphs."

	| isBack all tfm |
	all := (aMorph isNil or: [owner isNil]) 
				ifTrue: 
					["Traverse down"

					(self fullBounds containsPoint: aPoint) ifFalse: [^#()].
					(aBool and: [self isLocked or: [self visible not]]) ifTrue: [^#()].
					nil]
				ifFalse: 
					["Traverse up"

					tfm := self transformedFrom: owner.
					all := owner 
								morphsAt: (tfm localPointToGlobal: aPoint)
								behind: self
								unlocked: aBool.
					WriteStream with: all].
	isBack := aMorph isNil.
	self submorphsDo: 
			[:m | | found | 
			isBack 
				ifTrue: 
					[tfm := m transformedFrom: self.
					found := m 
								morphsAt: (tfm globalPointToLocal: aPoint)
								behind: nil
								unlocked: aBool.
					found notEmpty 
						ifTrue: 
							[all ifNil: [all := Array new  writeStream].
							all nextPutAll: found]].
			m == aMorph ifTrue: [isBack := true]].
	(isBack and: [self containsPoint: aPoint]) 
		ifTrue: 
			[all ifNil: [^Array with: self].
			all nextPut: self].
	^all ifNil: [#()] ifNotNil: [all contents]! !

!Morph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/17/2015 12:36'!
drawOnCanvasWrapperFor: anAthensCanvas 
	self drawOn: anAthensCanvas asCanvasWrapper	! !

!Morph methodsFor: '*SUnit-UITesting' stamp: 'SeanDeNigris 12/9/2011 13:56'!
simulateMiddleClick

	self simulateClickWith: MouseEvent blueButton.! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'sw 4/9/98 14:26'!
submorphNamed: aName
	^ self submorphNamed: aName ifNone: [nil]! !

!Morph methodsFor: 'menus' stamp: 'StephaneDucasse 10/26/2014 11:20'!
adhereToEdge
	| menu |
	menu := UIManager default newMenuIn: self for: self.
	#(top right bottom left - center - topLeft topRight bottomRight bottomLeft - none)
		do: [:each |
			each == #-
				ifTrue: [menu addLine]
				ifFalse: [menu add: each asString selector: #setToAdhereToEdge: argument: each]].
	menu popUpEvent: self currentEvent in: self world! !

!Morph methodsFor: 'printing' stamp: 'MarcusDenker 10/28/2010 14:02'!
printOn: aStream 
	super printOn: aStream.
	aStream nextPutAll: '('.
	aStream
		print: self identityHash;
		nextPutAll: ')'! !

!Morph methodsFor: 'recategorized' stamp: 'gvc 2/2/2009 13:24'!
layoutChanged
	"Fixed to always flush layout cache - finally tracked down
	layout anomalies due to cached extents in layout
	policies not being flushed, the previous (incorrect) assumption being
	that it did not matter if layout was to be recomputed (fullBounds being nil).
	Recomputing of the layout apparently does not flush so must be done here."
	
	| layout |
	fullBounds := nil.
	layout := self layoutPolicy.
	layout ifNotNil:[layout flushLayoutCache].
	owner ifNotNil: [owner layoutChanged].
	"note: does not send #ownerChanged here - we'll do this when computing the new layout"! !

!Morph methodsFor: 'meta-actions' stamp: 'MarcusDenker 11/7/2009 18:52'!
copyToPasteBuffer: evt
	^evt hand copyToPasteBuffer: self.! !

!Morph methodsFor: 'updating' stamp: 'IgorStasenko 8/27/2013 16:25'!
handleUpdate: aMorphChangedAnnouncement
	^ aMorphChangedAnnouncement deliverTo: self! !

!Morph methodsFor: 'rounding' stamp: 'AlainPlantec 12/20/2009 00:20'!
roundedCornersString
	"Answer the string to put in a menu that will invite the user to 
	switch to the opposite corner-rounding mode"
	^ (self wantsRoundedCorners
		ifTrue: ['<yes>' translated]
		ifFalse: ['<no>' translated])
		, ('round corners' translated)! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 20:01'!
rubberBandCells
	"Layout specific. This property describes if a parent that is #shrinkWrapped around its children should ignore any #spaceFill children. E.g., when #rubberBandCells is true, the compound layout will always stay at the smallest available size, even though some child may be able to grow."
	| props |
	props := self layoutProperties.
	^props ifNil:[false] ifNotNil:[props rubberBandCells].! !

!Morph methodsFor: 'drawing' stamp: 'CamilloBruni 5/29/2012 17:13'!
drawErrorOn: aCanvas
	"The morph (or one of its submorphs) had an error in its drawing method."
	aCanvas
		frameAndFillRectangle: bounds
		fillColor: Color red
		borderWidth: 1
		borderColor: Color yellow.
	aCanvas line: bounds topLeft to: bounds bottomRight width: 1 color: Color yellow.
	aCanvas line: bounds topRight to: bounds bottomLeft width: 1 color: Color yellow.
	
	self valueOfProperty: #drawError ifPresentDo: [ :error| | trace stringBounds |
		trace := String streamContents: [ :s| error signalerContext shortDebugStackOn: s].
		stringBounds := bounds insetBy: 5.
		trace linesDo: [ :aString|
			aCanvas drawString: aString in: stringBounds.
			stringBounds := stringBounds top: stringBounds top + (TextStyle defaultFont pixelSize * 1.2) ]]! !

!Morph methodsFor: 'events-alarms' stamp: 'ar 9/11/2000 16:35'!
addAlarm: aSelector withArguments: args after: delayTime
	"Add an alarm (that is an action to be executed once) with the given set of parameters"
	^self addAlarm: aSelector withArguments: args at: Time millisecondClockValue + delayTime! !

!Morph methodsFor: 'Morphic-Base-Widgets' stamp: 'BenjaminVanRyseghem 2/12/2012 00:22'!
widthToDisplayInList: aList

	^ self minExtent x! !

!Morph methodsFor: 'user interface' stamp: 'tak 3/15/2005 17:36'!
becomeModal
	self currentWorld
		ifNotNil: [self currentWorld modalWindow: self]! !

!Morph methodsFor: 'menu' stamp: 'MarcusDenker 7/17/2014 13:27'!
hasYellowButtonMenu
	"Answer true if I have any items at all for a context (yellow button) menu."
	^ self wantsYellowButtonMenu
			! !

!Morph methodsFor: 'stepping and presenter' stamp: 'sw 3/22/2000 14:28'!
isStepping
	"Return true if the receiver is currently stepping in its world"
	| aWorld |
	^ (aWorld := self world)
		ifNil:		[false]
		ifNotNil:	[aWorld isStepping: self]! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/11/2007 11:34'!
nextMorphInWindow
	"Answer the next morph in the window. Traverse
	from the receiver to its first child or next sibling or owner's next sibling etc."

	^self hasSubmorphs
		ifTrue: [self submorphs first]
		ifFalse: [self nextMorphAcrossInWindow]! !

!Morph methodsFor: 'accessing - properties' stamp: 'md 2/27/2006 09:48'!
setProperty: aSymbol toValue: anObject 
	"change the receiver's property named aSymbol to anObject"
	anObject ifNil: [^ self removeProperty: aSymbol].
	self assureExtension setProperty: aSymbol toValue: anObject! !

!Morph methodsFor: 'halos and balloon help' stamp: 'AlainPlantec 5/7/2010 22:53'!
okayToRotateEasily
	"Answer whether it is appropriate for a rotation handle to be shown for the receiver.  This is a hook -- at present nobody declines."

	^ self respondsTo: #prepareForRotating! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/20/2009 18:42'!
boundsWithinCorners
 	"Changed to be more realistic..."
	
	^self bounds insetBy: 2! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 20:00'!
minCellSize
	"Layout specific. This property specifies the minimal size of a table cell."
	| props |
	props := self layoutProperties.
	^props ifNil:[0] ifNotNil:[props minCellSize].! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/11/2007 17:21'!
hasKeyboardFocus
	"Answer whether the receiver has keyboard focus."

	^((self world ifNil: [^false]) 
		activeHand ifNil: [^false])  keyboardFocus = self! !

!Morph methodsFor: 'halos and balloon help' stamp: 'AlainPlantec 5/7/2010 22:56'!
wantsHaloHandleWithSelector: aSelector inHalo: aHaloMorph
	"Answer whether the receiver would like to offer the halo handle with the given selector (e.g. #addCollapseHandle:)"

	(#(addDismissHandle:) includes: aSelector) ifTrue:
		[^ self resistsRemoval not].

	(#( addDragHandle: ) includes: aSelector) ifTrue:
		[^ self okayToBrownDragEasily].

	(#(addGrowHandle: addScaleHandle:) includes: aSelector) ifTrue:
		[^ self okayToResizeEasily].

	(#( addRotateHandle: ) includes: aSelector) ifTrue:
		[^ self okayToRotateEasily].

	(#(addRecolorHandle:) includes: aSelector) ifTrue:
		[^ self renderedMorph wantsRecolorHandle].

	^ true
	! !

!Morph methodsFor: 'thumbnail' stamp: 'sw 6/16/1999 11:29'!
permitsThumbnailing
	^ true! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'ar 10/6/2000 15:13'!
grabTransform
	"Return the transform for the receiver which should be applied during grabbing"
	^owner ifNil:[IdentityTransform new] ifNotNil:[owner grabTransform]! !

!Morph methodsFor: 'layout-menu' stamp: 'StephaneDucasse 10/27/2014 20:19'!
addCellLayoutMenuItems: aMenu hand: aHand
	"Cell (e.g., child) related items"
	| menu sub |
	menu := UIManager default newMenuIn: self for: self.
	menu addUpdating: #hasDisableTableLayoutString selector: #changeDisableTableLayout.
	menu addLine.
	sub := UIManager default newMenuIn: self for: self.
	#(#rigid #shrinkWrap #spaceFill)
		do: [ :sym | 
			sub
				addUpdating: #hResizingString:
				target: self
				selector: #hResizing:
				argumentList: (Array with: sym) ].
	menu add: 'horizontal resizing' subMenu: sub.
	sub := UIManager default newMenuIn: self for: self.
	#(#rigid #shrinkWrap #spaceFill)
		do: [ :sym | 
			sub
				addUpdating: #vResizingString:
				target: self
				selector: #vResizing:
				argumentList: (Array with: sym) ].
	menu add: 'vertical resizing' subMenu: sub.
	aMenu ifNotNil: [ aMenu add: 'child layout' subMenu: menu ].
	^ menu! !

!Morph methodsFor: 'initialize' stamp: 'dgd 3/7/2003 15:06'!
defaultBounds
"answer the default bounds for the receiver"
	^ 0 @ 0 corner: 50 @ 40! !

!Morph methodsFor: 'Morphic-Base-Worlds' stamp: 'dgd 9/1/2004 16:10'!
clearArea
	"Answer the clear area of the receiver. It means the area free  
	of docking bars."
	| visTop visBottom visLeft visRight |

	visTop := self top.
	visBottom := self bottom.
	visLeft := self left.
	visRight := self right.

	self dockingBars
		do: [:each | 
			(each isAdheringToTop and: [each bottom > visTop])
				ifTrue: [visTop := each bottom].

			(each isAdheringToBottom and: [each top < visBottom])
				ifTrue: [visBottom := each top].

			(each isAdheringToLeft and: [each right > visLeft])
				ifTrue: [visLeft := each right].

			(each isAdheringToRight and: [each left < visRight])
				ifTrue: [visRight := each left]
		].

	^ Rectangle
		left: visLeft
		right: visRight
		top: visTop
		bottom: visBottom
! !

!Morph methodsFor: 'testing' stamp: 'MarcusDenker 3/21/2010 20:16'!
isFullOnScreen
	"Answer if the receiver is full contained in the owner visible  
	area."
	owner ifNil: [^ true].
	self visible ifFalse: [^ true].
	^ owner clearArea containsRect: self fullBounds! !

!Morph methodsFor: 'geometry' stamp: 'di 2/23/98 11:36'!
worldBounds
	^ self world bounds! !

!Morph methodsFor: 'drawing' stamp: 'sw 11/26/2003 17:43'!
flashBounds
	"Flash the receiver's bounds  -- does not use the receiver's color, thus works with StringMorphs and SketchMorphs, etc., for which #flash is useless.  No senders initially, but useful to send this from a debugger or inspector"

	5 timesRepeat:
		[Display flash: self boundsInWorld  andWait: 120]! !

!Morph methodsFor: '*Morphic-Widgets-Taskbar' stamp: 'StephaneDucasse 5/23/2013 18:34'!
taskThumbnailOfSize: thumbExtent
	"Answer a new task thumbnail for the receiver."

	|f t r|
	r := self bounds scaledAndCenteredIn: (0@0 extent: thumbExtent).
	f := Form extent: r extent depth: Display depth.
	t := MatrixTransform2x3 withScale: f extent / self extent.
	f getCanvas
		transformBy: t
		clippingTo: f boundingBox
		during: [:c | c translateBy: self topLeft negated during: [:ct | self fullDrawOn: ct]]
		smoothing: 2.
	^ImageMorph new
		form: f! !

!Morph methodsFor: 'structure' stamp: 'di 11/13/2000 00:48'!
firstOwnerSuchThat: conditionBlock

	self allOwnersDo: [:m | (conditionBlock value: m) ifTrue: [^ m]].
	^ nil
! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'adrian_lienhard 7/19/2009 17:35'!
vanishAfterSlidingTo: aPosition event: evt

	| aForm aWorld startPoint endPoint |
	aForm := self imageForm offset: 0@0.
	aWorld := self world.
	startPoint := evt hand fullBounds origin.
	self delete.
	aWorld displayWorld.
	endPoint := aPosition.
	aForm slideFrom: startPoint  to: endPoint nSteps: 12 delay: 15.! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'sw 9/7/2000 08:29'!
addMorph: aMorph asElementNumber: aNumber
	"Add the given morph so that it becomes the aNumber'th element of my submorph list.  If aMorph is already one of my submorphs, reposition it"

	(submorphs includes: aMorph) ifTrue:
		[aMorph privateDelete].
	(aNumber <= submorphs size)
		ifTrue:
			[self addMorph: aMorph inFrontOf: (submorphs at: aNumber)]
		ifFalse:
			[self addMorphBack: aMorph]
! !

!Morph methodsFor: 'events-alarms' stamp: 'ar 9/11/2000 16:35'!
addAlarm: aSelector with: arg1 with: arg2 after: delayTime
	"Add an alarm (that is an action to be executed once) with the given set of parameters"
	^self addAlarm: aSelector withArguments: (Array with: arg1 with: arg2) after: delayTime! !

!Morph methodsFor: 'geometry' stamp: 'sw 10/25/1999 16:49'!
referencePositionInWorld

	^ self pointInWorld: self referencePosition
! !

!Morph methodsFor: 'halos and balloon help' stamp: 'ar 11/7/1999 21:55'!
addHalo: evt from: formerHaloOwner
	"Transfer a halo from the former halo owner to the receiver"
	^self addHalo: evt! !

!Morph methodsFor: 'events-alarms' stamp: 'ar 9/11/2000 16:35'!
addAlarm: aSelector with: arg1 with: arg2 at: scheduledTime
	"Add an alarm (that is an action to be executed once) with the given set of parameters"
	^self addAlarm: aSelector withArguments: (Array with: arg1 with: arg2) at: scheduledTime! !

!Morph methodsFor: 'stepping and presenter' stamp: 'ar 10/22/2000 16:42'!
startSteppingSelector: aSelector
	"Start getting sent the 'step' message."
	self startStepping: aSelector at: Time millisecondClockValue arguments: nil stepTime: nil.! !

!Morph methodsFor: 'stepping and presenter' stamp: 'sw 10/11/1999 12:59'!
stopSteppingSelfAndSubmorphs
	self allMorphsDo: [:m | m stopStepping]
! !

!Morph methodsFor: 'geometry' stamp: 'sw 6/4/2000 21:59'!
minimumExtent
	| ext |
	"This returns the minimum extent that the morph may be shrunk to.  Not honored in too many places yet, but respected by the resizeToFit feature, at least.  copied up from SystemWindow 6/00"
	(ext := self valueOfProperty: #minimumExtent)
		ifNotNil:
			[^ ext].
	^ 100 @ 80! !

!Morph methodsFor: 'geniestubs' stamp: 'nk 3/11/2004 17:30'!
mouseStillDownStepRate
	"At what rate do I want to receive #mouseStillDown: notifications?"
	^1! !

!Morph methodsFor: 'accessing' stamp: 'md 2/27/2006 09:52'!
beUnsticky
	"If the receiver is marked as sticky, make it now be unsticky"
	extension ifNotNil: [extension sticky: false]! !

!Morph methodsFor: '*Morphic-Base' stamp: 'DamienCassou 9/29/2009 13:01'!
exportAsGIF
	| fName |
	fName := UIManager default request:'Please enter the name' translated initialAnswer: self externalName,'.gif'.
	fName isEmptyOrNil ifTrue:[^self].
	GIFReadWriter putForm: self imageForm onFileNamed: fName.! !

!Morph methodsFor: 'private' stamp: 'MarcusDenker 10/22/2013 14:56'!
privateFullMoveBy: delta
	"Private!! Relocate me and all of my subMorphs by recursion. Subclasses that implement different coordinate systems may override this method."

	self privateMoveBy: delta.
	submorphs do: [:each | each privateFullMoveBy: delta].
! !

!Morph methodsFor: 'menus' stamp: 'StephaneDucasse 4/22/2012 16:50'!
hasDirectionHandlesString
	^ (self wantsDirectionHandles) ->  'direction handles' translated! !

!Morph methodsFor: 'accessing - properties' stamp: 'md 2/27/2006 08:53'!
valueOfProperty: aSymbol 
	"answer the value of the receiver's property named aSymbol"
	^ extension ifNotNil: [extension valueOfProperty: aSymbol]! !

!Morph methodsFor: 'drawing' stamp: 'sw 10/10/1999 23:25'!
refreshWorld
	| aWorld |
	(aWorld := self world) ifNotNil: [aWorld displayWorldSafely]
! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 10/31/2000 20:45'!
vResizingString: aSymbol
	^self layoutMenuPropertyString: aSymbol from: self vResizing! !

!Morph methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 2/28/2015 01:07'!
brickTransparentImageForm
	|background form brickBorder|
	
	self isBrick ifTrue: [ 
		brickBorder := self border.
		self border: GLMBrickBorder new ].
	
	background := self color.
	self color: Color transparent.
	form := self imageForm.
	self color: background.
	
	self isBrick ifTrue: [ 
		self border: brickBorder ].
	^ form! !

!Morph methodsFor: 'meta-actions' stamp: 'ar 11/4/2000 17:56'!
duplicateMorph: evt
	"Make and return a duplicate of the receiver's argument"
	| dup |
	dup := self duplicate.
	evt hand grabMorph: dup from: owner. "duplicate was ownerless so use #grabMorph:from: here"
	^dup! !

!Morph methodsFor: 'events-processing' stamp: 'ar 10/4/2000 18:48'!
handleFocusEvent: anEvent
	"Handle the given event. This message is sent if the receiver currently has the focus and is therefore receiving events directly from some hand."
	^self handleEvent: anEvent! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'ClementBera 7/30/2013 11:04'!
myDependents: aCollectionOrNil
	"Improved performance dependents."
	
	aCollectionOrNil 
		ifNil: [self removeProperty: #myDependents]
		ifNotNil: [self setProperty: #myDependents toValue: aCollectionOrNil]! !

!Morph methodsFor: 'geometry' stamp: 'efc 2/13/2003 18:09'!
bottomRight: aPoint
	" Move me so that my bottom right corner is at aPoint. My extent (width & height) are unchanged "

	self position: ((aPoint x - bounds width) @ (aPoint y - self height))
! !

!Morph methodsFor: 'drop shadows' stamp: 'ar 10/26/2000 18:59'!
shadowColor
	^self valueOfProperty: #shadowColor ifAbsent:[Color black]! !

!Morph methodsFor: 'menu' stamp: 'sw 11/27/2001 15:21'!
addBorderStyleMenuItems: aMenu hand: aHandMorph
	"Probably one could offer border-style items even if it's not a borderedMorph, so this remains a loose end for the moment"
! !

!Morph methodsFor: 'initialize' stamp: 'GuillermoPolito 5/1/2012 20:01'!
openInWorld: aWorld
	"Add this morph to the requested World."
	(aWorld visibleClearArea origin ~= (0@0) and: [self position = (0@0)]) ifTrue:
		[self position: aWorld visibleClearArea origin].
	aWorld addMorph: self.
	aWorld startSteppingSubmorphsOf: self.
	
	self announceOpened.! !

!Morph methodsFor: 'geometry' stamp: 'nk 4/27/2003 16:16'!
intersects: aRectangle
	"Answer whether aRectangle, which is in World coordinates, intersects me."

	^self fullBoundsInWorld intersects: aRectangle! !

!Morph methodsFor: 'change reporting' stamp: 'ar 8/12/2003 21:50'!
addedMorph: aMorph
	"Notify the receiver that the given morph was just added."
! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'panda 4/25/2000 15:50'!
enableDrag: aBoolean
	self setProperty: #dragEnabled toValue: aBoolean! !

!Morph methodsFor: 'visual properties' stamp: 'gvc 9/11/2009 16:39'!
fillStyle: aFillStyle
	"Set the current fillStyle of the receiver.
	Optimized for no change."
	
	self assureExtension.
	extension fillStyle = aFillStyle
		ifTrue: [^self]. "no change optimization"
	extension fillStyle: aFillStyle.
	color := aFillStyle asColor.
	self changed! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/29/2008 15:14'!
paneColor: aColor
	"Explicitly set the pane color for the reveiver."

	self setProperty: #paneColor toValue: aColor.
	self adoptPaneColor! !

!Morph methodsFor: 'event handling' stamp: 'di 9/14/1998 07:31'!
handlesMouseOverDragging: evt
	"Return true if I want to receive mouseEnterDragging: and mouseLeaveDragging: when the hand drags something over me (button up or button down), or when the mouse button is down but there is no mouseDown recipient.  The default response is false, except if you have added sensitivity to mouseEnterLaden: or mouseLeaveLaden:, using the on:send:to: mechanism."
	"NOTE:  If the hand state matters in these cases, it may be tested by constructs such as
		event anyButtonPressed
		event hand hasSubmorphs"

	self eventHandler ifNotNil: [^ self eventHandler handlesMouseOverDragging: evt].
	^ false! !

!Morph methodsFor: 'events-processing' stamp: 'ar 9/16/2000 14:22'!
handleListenEvent: anEvent
	"Handle the given event. This message is sent if the receiver is a registered listener for the given event."
	^anEvent sentTo: self.! !

!Morph methodsFor: 'events-processing' stamp: 'ar 4/23/2001 17:24'!
handleMouseOver: anEvent
	"System level event handling."
	anEvent hand mouseFocus == self ifTrue:[
		"Got this directly through #handleFocusEvent: so check explicitly"
		(self containsPoint: anEvent position event: anEvent) ifFalse:[^self]].
	anEvent hand noticeMouseOver: self event: anEvent! !

!Morph methodsFor: 'text-anchor' stamp: 'aoy 2/15/2003 21:48'!
changeInlineAnchor
	"Change the anchor from/to line anchoring"

	| newType |
	newType := self textAnchorType == #inline 
				ifTrue: [#paragraph]
				ifFalse: [#inline]. 
	owner isTextMorph 
		ifTrue: 
			[owner 
				anchorMorph: self
				at: self position
				type: newType]! !

!Morph methodsFor: 'event handling' stamp: 'ar 10/25/2000 18:04'!
mouseMove: evt
	"Handle a mouse move event. The default response is to let my eventHandler, if any, handle it."
	self eventHandler ifNotNil:
		[self eventHandler mouseMove: evt fromMorph: self].
! !

!Morph methodsFor: 'layout' stamp: 'ClementBera 7/30/2013 11:04'!
minWidth: aNumber 
	aNumber 
		ifNil: [self removeProperty: #minWidth]
		ifNotNil: [self setProperty: #minWidth toValue: aNumber].
	self layoutChanged! !

!Morph methodsFor: '*SUnit-UITesting' stamp: 'SeanDeNigris 12/1/2011 22:08'!
simulateRightClick

	self simulateClickWith: MouseEvent yellowButton.! !

!Morph methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 7/24/2013 13:35'!
update: anAspect

	^ self! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 8/9/2007 12:25'!
paneColor
	"Answer the window's pane color or our color otherwise."

	^self paneColorOrNil ifNil: [self color]! !

!Morph methodsFor: 'menus' stamp: 'MarcusDenker 11/28/2009 14:25'!
transferStateToRenderer: aRenderer
	"Transfer knownName, and visible over to aRenderer, which is being imposed above me as a transformation shell"

	aRenderer simplySetVisible: self visible



 

		! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 20:03'!
wrapDirection: aSymbol
	"Layout specific. This property describes the direction along which a list-like layout should be wrapped. Possible values are:
		#leftToRight
		#rightToLeft
		#topToBottom
		#bottomToTop
		#none
	indicating in which direction wrapping should occur. This direction must be orthogonal to the list direction, that is if listDirection is #leftToRight or #rightToLeft then wrapDirection must be #topToBottom or #bottomToTop and vice versa."
	self assureTableProperties wrapDirection: aSymbol.
	self layoutChanged.
! !

!Morph methodsFor: 'layout-menu' stamp: 'StephaneDucasse 4/22/2012 16:52'!
hasProportionalLayoutString
	| layout |
	^ ((layout := self layoutPolicy) notNil
			and: [layout isProportionalLayout]) -> 'proportional layout' translated! !

!Morph methodsFor: 'drawing' stamp: 'GaryChambers 9/8/2011 14:55'!
drawDropShadowOn: aCanvas

	aCanvas 
		translateBy: self shadowOffset 
		during: [ :shadowCanvas |
			shadowCanvas roundShadowCornersOf: self during: [
				(shadowCanvas isVisible: self bounds) ifTrue: [
					shadowCanvas fillRectangle: self bounds fillStyle: self shadowColor
				]
			]
		].
! !

!Morph methodsFor: 'events-alarms' stamp: 'ar 9/14/2000 12:15'!
addAlarm: aSelector withArguments: args at: scheduledTime
	"Add an alarm (that is an action to be executed once) with the given set of parameters"
	| scheduler |
	scheduler := self alarmScheduler.
	scheduler ifNotNil:[scheduler addAlarm: aSelector withArguments: args for: self at: scheduledTime].! !

!Morph methodsFor: 'structure' stamp: ''!
owner
	"Returns the owner of this morph, which may be nil."

	^ owner! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 19:54'!
cellPositioning
	"Layout specific. This property describes how the receiver should be layed out in its owner when the bounds of the cell assigned to the receiver do not exactly match its bounds. Possible values are:
		#topLeft, #topRight, #bottomLeft, #bottomRight, #topCenter, #leftCenter, #rightCenter, #bottomCenter, #center 
	which align the receiver's bounds with the cell at the given point."
	| props |
	props := self layoutProperties.
	^props ifNil:[#center] ifNotNil:[props cellPositioning].! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'PeterHugossonMiller 9/3/2009 10:06'!
morphsAt: aPoint unlocked: aBool
	"Return a collection of all morphs in this morph structure that contain the given point, possibly including the receiver itself.  The order is deepest embedding first."
	| mList |
	mList := Array new writeStream.
	self morphsAt: aPoint unlocked: aBool do:[:m| mList nextPut: m].
	^mList contents! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/14/2009 17:53'!
nextMorphWantingFocus
	"Answer the next morph that wants keyboard focus."

	|m|
	m := self nextMorphInWindow ifNil: [^nil].
	[m = self or: [m wantsKeyboardFocusNavigation]]
		whileFalse: [m := m nextMorphInWindow].
	^m wantsKeyboardFocusNavigation
		ifTrue: [m]
	! !

!Morph methodsFor: 'drop shadows' stamp: 'ar 11/12/2000 18:57'!
removeDropShadow
	self hasDropShadow ifFalse:[^self].
	self changed.
	self hasDropShadow: false.
	fullBounds ifNotNil:[fullBounds := self privateFullBounds].
	self changed.! !

!Morph methodsFor: 'event handling' stamp: 'PavelKrivanek 7/24/2014 16:22'!
handleKeystroke: anEvent 
	"System level event handling."
	
	anEvent wasHandled
		ifTrue: [^ self].
	
	self shortcutsHandler ifNotNil: [:handler | 
		handler handleKeystroke: anEvent inMorph: self.
		anEvent wasHandled ifTrue: [^ self]].
	
	(self handlesKeyStroke: anEvent)
		ifFalse: [^ self].
	anEvent wasHandled: true.
	self keyStroke: anEvent.
	^ self eventHandler ifNotNil: [:handler | handler keyStroke: anEvent fromMorph: self ].! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'panda 4/25/2000 15:50'!
dragEnabled
	"Get this morph's ability to add and remove morphs via drag-n-drop."
	^(self valueOfProperty: #dragEnabled) == true
! !

!Morph methodsFor: 'event handling' stamp: 'sw 11/16/1998 08:06'!
restoreSuspendedEventHandler
	| savedHandler |
	(savedHandler := self valueOfProperty: #suspendedEventHandler) ifNotNil:
		[self eventHandler: savedHandler].
	submorphs do: [:m | m restoreSuspendedEventHandler]
! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'MarcusDenker 7/9/2014 21:38'!
layoutInBounds: cellBounds
	"Layout specific. Apply the given bounds to the receiver after being layed out in its owner."
	| box aSymbol |
	
	cellBounds = self bounds ifTrue:[^self]. "already up to date. Fixed here to use bounds rather than fullBounds for the check."
	cellBounds extent = self bounds extent "nice fit. Fixed here to use bounds rather than fullBounds for the check."
		ifTrue:[^self position: cellBounds origin].
	box := bounds.
	self hResizing == #shrinkWrap
		ifTrue:[box := box origin extent: self minExtent x @ box height].
	self vResizing == #shrinkWrap
		ifTrue:[box := box origin extent: box width @ self minExtent y].
	"match #spaceFill constraints"
	self hResizing == #spaceFill 
		ifTrue:[box := box origin extent: cellBounds width @ box height].
	self vResizing == #spaceFill
		ifTrue:[box := box origin extent: box width @ cellBounds height].
	"align accordingly"
	aSymbol := (owner ifNil:[self]) cellPositioning.
	box := box align: (box perform: aSymbol) with: (cellBounds perform: aSymbol).
	"and install new bounds"
	self bounds: box.! !

!Morph methodsFor: '*Glamour-Morphic-Brick' stamp: 'TudorGirba 12/5/2014 06:41'!
exportAsPNGSilently
	| fName time |
	time := (DateAndTime now asString copyReplaceAll: ':' with: '-') copyReplaceAll: '.' with: '-'.
	fName := self externalName, time , '.png'.
	PNGReadWriter putForm: self imageForm onFileNamed: fName! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'ClementBera 7/30/2013 11:04'!
minExtent
	"Layout specific. Return the minimum size the receiver can be represented in.
	Implementation note: When this message is sent from an owner trying to lay out its children it will traverse down the morph tree and recompute the minimal arrangement of the morphs based on which the minimal extent is returned. When a morph with some layout strategy is encountered, the morph will ask its strategy to compute the new arrangement. However, since the final size given to the receiver is unknown at the point of the query, the assumption is made that the current bounds of the receiver are the base on which the layout should be computed. This scheme prevents strange layout changes when for instance, a table is contained in another table. Unless the inner table has been resized manually (which means its bounds are already enlarged) the arrangement of the inner table will not change here. Thus the entire layout computation is basically an iterative process which may have different results depending on the incremental changes applied.
	Fixed for shrinkWrap."

	| layout minExtent extra hFit vFit |
	hFit := self hResizing.
	vFit := self vResizing.
	(hFit == #rigid and: [vFit == #rigid]) 
		ifTrue: 
			["The receiver will not adjust to parents layout by growing or shrinking,
		which means that an accurate layout defines the minimum size."

			^self fullBounds extent max: self minWidth @ self minHeight].

	"An exception -- a receiver with #shrinkWrap constraints but no children is being treated #rigid (the equivalent to a #spaceFill receiver in a non-layouting owner)"
	self hasSubmorphs 
		ifFalse: 
			[hFit == #shrinkWrap ifTrue: [hFit := #rigid].
			vFit == #shrinkWrap ifTrue: [vFit := #rigid]].
	layout := self layoutPolicy.
	layout 
		ifNil: [minExtent := 0 @ 0]
		ifNotNil: [minExtent := layout minExtentOf: self in: self layoutBounds].
	hFit == #rigid 
		ifTrue: [minExtent := self fullBounds extent x @ minExtent y]
		ifFalse: 
			[extra := self bounds width - self layoutBounds width.
			minExtent := (minExtent x + extra) @ minExtent y].
	minExtent := vFit == #rigid 
				ifTrue: [minExtent x @ self fullBounds extent y]
				ifFalse: 
					[extra := self bounds height - self layoutBounds height.
					minExtent x @ (minExtent y + extra)].
	minExtent := minExtent max: self minWidth @ self minHeight.
	^minExtent! !

!Morph methodsFor: 'change reporting' stamp: 'ar 8/12/2003 22:26'!
privateInvalidateMorph: aMorph
	"Private. Invalidate the given morph after adding or removing.
	This method is private because a) we're invalidating the morph 'remotely'
	and b) it forces a fullBounds computation which should not be necessary
	for a general morph c) the morph may or may not actually invalidate
	anything (if it's not in the world nothing will happen) and d) the entire
	mechanism should be rewritten."
	aMorph fullBounds.
	aMorph changed! !

!Morph methodsFor: 'structure' stamp: 'di 11/13/2000 01:00'!
allOwners
	"Return the owners of the reciever"

	^ Array streamContents: [:strm | self allOwnersDo: [:m | strm nextPut: m]]! !

!Morph methodsFor: 'events-alarms' stamp: 'ar 9/11/2000 16:35'!
addAlarm: aSelector after: delayTime
	"Add an alarm (that is an action to be executed once) with the given set of parameters"
	^self addAlarm: aSelector withArguments: #() after: delayTime! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'ar 10/11/2000 18:18'!
dragEnabled: aBool
	^self enableDrag: aBool! !

!Morph methodsFor: 'rotate scale and flex' stamp: 'AlainPlantec 5/7/2010 21:27'!
prepareForScaling
	"If this morph requires a flex shell to scale,
	then wrap it in one and return it.
	Polygons, eg, may override to return themselves."

	^ self addFlexShell! !

!Morph methodsFor: 'geometry' stamp: 'ar 10/25/2000 15:04'!
bounds: aRectangle in: referenceMorph
	"Return the receiver's bounds as seen by aMorphs coordinate frame"
	owner ifNil: [^ aRectangle].
	^(owner transformFrom: referenceMorph) localBoundsToGlobal: aRectangle
! !

!Morph methodsFor: 'halos and balloon help' stamp: 'sma 12/23/1999 13:24'!
editBalloonHelpText
	"Modify the receiver's balloon help text."

	self editBalloonHelpContent: self balloonText! !

!Morph methodsFor: '*glamour-morphic-widgets' stamp: 'cyrilledelaunay 6/6/2011 16:03'!
setOptimalResizing
	self hResizing: #shrinkWrap.
	self vResizing: #shrinkWrap! !

!Morph methodsFor: '*Morphic-Base' stamp: 'nk 2/27/2003 11:48'!
useGradientFill
	"Make receiver use a solid fill style (e.g., a simple color)"
	| fill color1 color2 |
	self fillStyle isGradientFill ifTrue:[^self]. "Already done"
	color1 := self color asColor.
	color2 := color1 negated.
	fill := GradientFillStyle ramp: {0.0 -> color1. 1.0 -> color2}.
	fill origin: self topLeft.
	fill direction: 0 @ self bounds extent y.
	fill normal: self bounds extent x @ 0.
	fill radial: false.
	self fillStyle: fill! !

!Morph methodsFor: 'layout-menu' stamp: 'StephaneDucasse 10/27/2014 20:19'!
addLayoutMenuItems: topMenu hand: aHand
	| aMenu |
	aMenu := UIManager default newMenuIn: self for: self.
	aMenu addUpdating: #hasNoLayoutString selector: #changeNoLayout.
	aMenu addUpdating: #hasProportionalLayoutString selector: #changeProportionalLayout.
	aMenu addUpdating: #hasTableLayoutString selector: #changeTableLayout.
	aMenu addLine.
	aMenu add: 'change layout inset...' selector: #changeLayoutInset:.
	aMenu addLine.
	self addCellLayoutMenuItems: aMenu hand: aHand.
	self addTableLayoutMenuItems: aMenu hand: aHand.
	topMenu ifNotNil: [ topMenu add: 'layout' subMenu: aMenu ].
	^aMenu! !

!Morph methodsFor: '*Keymapping-Core' stamp: 'GuillermoPolito 8/5/2013 10:21'!
bindKeyCombination: aShortcut toAction: anAction
	self kmDispatcher bindKeyCombination: aShortcut asKeyCombination toAction: anAction! !

!Morph methodsFor: 'wiw support' stamp: 'ar 3/18/2001 00:14'!
shouldGetStepsFrom: aWorld
	^self world == aWorld! !

!Morph methodsFor: 'geometry' stamp: 'efc 2/13/2003 18:17'!
top
	" Return the y-coordinate of my top side "

	^ bounds top! !

!Morph methodsFor: '*Morphic-Widgets-Taskbar' stamp: 'gvc 6/11/2007 15:03'!
taskbarThumbnailExtent
	"Answer the size of a taskbar thumbnail for the receiver."

	^self extent min: self defaultTaskbarThumbnailExtent! !

!Morph methodsFor: 'debug and other' stamp: 'dgd 2/22/2003 19:05'!
ownerChain
	"Answer a list of objects representing the receiver and all of its owners.   The first element is the receiver, and the last one is typically the world in which the receiver resides"

	| c next |
	c := OrderedCollection with: self.
	next := self.
	[(next := next owner) notNil] whileTrue: [c add: next].
	^c asArray! !

!Morph methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 1/18/2012 18:53'!
mouseEnter: evt
	"Handle a mouseEnter event, meaning the mouse just entered my bounds with no button pressed. The default response is to let my eventHandler, if any, handle it."

	^ self eventHandler ifNotNil:
		[self eventHandler mouseEnter: evt fromMorph: self].
! !

!Morph methodsFor: 'halos and balloon help' stamp: 'AlainPlantec 12/19/2009 23:30'!
balloonHelpDelayTime
	"Return the number of milliseconds before a balloon help should be put up on the receiver. The balloon help will only be put up if the receiver responds to #wantsBalloon by returning true."
	^ self theme settings balloonHelpDelayTime! !

!Morph methodsFor: 'halos and balloon help' stamp: 'MarcusDenker 11/7/2009 21:51'!
okayToAddDismissHandle
	"Answer whether a halo on the receiver should offer a dismiss handle.  This provides a hook for making it harder to disassemble some strucures even momentarily"

	^self resistsRemoval not! !

!Morph methodsFor: 'debug and other' stamp: 'StephaneDucasse 10/27/2014 09:34'!
buildDebugMenu: aHand
	"Answer a debugging menu for the receiver. 
	 The hand argument is seemingly historical and plays no role presently"

	| aMenu |
	aMenu := UIManager default newMenuIn: self for: self.
	aMenu addStayUpItem.
	(self hasProperty: #errorOnDraw) ifTrue:
		[aMenu add: 'start drawing again' selector: #resumeAfterDrawError.].
	(self hasProperty: #drawError) ifTrue:
		[aMenu add: 'debug drawing error' selector: #debugDrawError.
		aMenu addLine].
	(self hasProperty: #errorOnStep) ifTrue:
		[aMenu add: 'start stepping again' selector: #resumeAfterStepError.
		aMenu addLine].

	aMenu add: 'inspect morph' selector: #inspectInMorphic:.
	aMenu lastItem icon: Smalltalk ui icons smallInspectItIcon.
	aMenu add: 'inspect owner chain' selector: #inspectOwnerChain.
	aMenu lastItem icon: Smalltalk ui icons smallInspectItIcon.
	self isMorphicModel ifTrue: [
		aMenu add: 'inspect model' target: self model selector: #inspect.
		aMenu lastItem icon: Smalltalk ui icons smallInspectItIcon ].
     aMenu add: 'explore morph' target: self selector: #explore.
	aMenu lastItem icon: Smalltalk ui icons smallInspectItIcon.
	aMenu addLine.
	aMenu add: 'browse morph class' target: self selector: #browseHierarchy.
	(self isMorphicModel)
		ifTrue: [aMenu
				add: 'browse model class'
				target: self model
				selector: #browseHierarchy].
	^ aMenu! !

!Morph methodsFor: 'accessing - extension' stamp: 'md 2/27/2006 08:47'!
resetExtension
	"reset the extension slot if it is not needed"
	(extension notNil and: [extension isDefault]) ifTrue: [extension := nil] ! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'ar 11/15/1998 23:42'!
addMorphFront: aMorph fromWorldPosition: wp

	self addMorphFront: aMorph.
	aMorph position: (self transformFromWorld globalPointToLocal: wp)! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 10/21/2008 16:51'!
passivate
	"Mark the receiver and submorphs as passive (background)."

	self submorphsDo: [:m | m passivate]! !

!Morph methodsFor: 'halos and balloon help' stamp: 'sw 11/27/2001 14:52'!
wantsRecolorHandle
	"Answer whether the receiver would like a recoloring halo handle to be put up.  Since this handle also presently affords access to the property-sheet, it is presently always allowed, even though SketchMorphs don't like regular recoloring"

	^ true
	
! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'sw 9/1/2000 10:16'!
submorphIndexOf: aMorph
	"Assuming aMorph to be one of my submorphs, answer where it occurs in my submorph list"

	^ submorphs indexOf: aMorph ifAbsent: [nil]! !

!Morph methodsFor: 'accessing' stamp: 'dgd 2/16/2003 21:57'!
beSticky
	"make the receiver sticky"
	self assureExtension sticky: true! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'MarcusDenker 12/11/2009 07:40'!
navigateFocusBackward
	"Change the keyboard focus to the previous morph."

	self previousMorphWantingFocus ifNotNil: [:m |
		m takeKeyboardFocus]
	! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'dgd 2/22/2003 14:35'!
submorphsDo: aBlock 
	submorphs do: aBlock! !

!Morph methodsFor: 'menu' stamp: 'marcus.denker 11/10/2008 10:04'!
addModelYellowButtonItemsTo: aCustomMenu event: evt 
	"Give my models a chance to add their context-menu items to  
	aCustomMenu."
	self model
		ifNotNil: [:mod |
			mod
				addModelYellowButtonMenuItemsTo: aCustomMenu
				forMorph: self
				hand: evt hand]! !

!Morph methodsFor: 'rotate scale and flex' stamp: 'ClementBera 7/30/2013 11:05'!
rotationCenter: aPointOrNil
	"Set the new rotation center of the receiver. The rotation center defines the relative offset inside the receiver's bounds for locating the reference position."
	aPointOrNil 
		ifNil: [self removeProperty: #rotationCenter]
		ifNotNil:[self setProperty: #rotationCenter toValue: aPointOrNil]
! !

!Morph methodsFor: 'accessing - properties' stamp: 'md 2/27/2006 09:47'!
otherProperties
	"answer the receiver's otherProperties"
	^ extension ifNotNil: [extension otherProperties]! !

!Morph methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 7/31/2013 14:10'!
actAsExecutor
	"Prepare the receiver to act as executor for any resources associated with it"
	self breakDependents! !

!Morph methodsFor: 'accessing' stamp: 'StephaneDucasse 4/22/2012 16:35'!
resistsRemoval: aBoolean
	"Set the receiver's resistsRemoval property as indicated"

	aBoolean
		ifTrue: [ self setProperty: #resistsRemoval toValue: true ]
		ifFalse: [ self removeProperty: #resistsRemoval ]! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/29/2008 14:56'!
paneColorOrNil
	"Answer the window's pane color or nil otherwise."

	^self valueOfProperty: #paneColor ifAbsent: [
		(self owner ifNil: [^nil]) paneColorOrNil]! !

!Morph methodsFor: 'event handling' stamp: 'di 9/14/1998 07:38'!
mouseLeaveDragging: evt
	"Handle a mouseLeaveLaden event, meaning the mouse just left my bounds with a button pressed or laden with submorphs. The default response is to let my eventHandler, if any, handle it; else to do nothing."

	self eventHandler ifNotNil:
		[self eventHandler mouseLeaveDragging: evt fromMorph: self]! !

!Morph methodsFor: 'halos and balloon help' stamp: 'sma 11/11/2000 14:55'!
balloonColor: aColor
	^ self
		setProperty: #balloonColor
		toValue: aColor! !

!Morph methodsFor: 'accessing' stamp: 'gvc 9/11/2009 17:09'!
borderStyle: newStyle
	newStyle = self borderStyle ifFalse:[
		(self canDrawBorder: newStyle) ifFalse:[
			"Replace the suggested border with a simple one"
			^self borderStyle: (BorderStyle width: newStyle width color: (newStyle trackColorFrom: self) color)].
		self assureExtension.
		self extension borderStyle: newStyle.
		self changed].! !

!Morph methodsFor: 'events-processing' stamp: 'ar 9/13/2000 17:14'!
processEvent: anEvent
	"Process the given event using the default event dispatcher."
	^self processEvent: anEvent using: self defaultEventDispatcher! !

!Morph methodsFor: 'drop shadows' stamp: 'ar 10/26/2000 19:03'!
hasDropShadow: aBool
	aBool
		ifTrue:[self setProperty: #hasDropShadow toValue: true]
		ifFalse:[self removeProperty: #hasDropShadow]! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 20:04'!
rubberBandCells: aBool
	"Layout specific. This property describes if a parent that is #shrinkWrapped around its children should ignore any #spaceFill children. E.g., when #rubberBandCells is true, the compound layout will always stay at the smallest available size, even though some child may be able to grow."
	self assureTableProperties rubberBandCells: aBool.
	self layoutChanged.! !

!Morph methodsFor: 'geometry' stamp: 'ar 10/25/2000 15:04'!
boundsIn: referenceMorph
	"Return the receiver's bounds as seen by aMorphs coordinate frame"
	^self bounds: self bounds in: referenceMorph! !

!Morph methodsFor: 'event handling' stamp: 'KTT 6/1/2004 11:41'!
keyUp: anEvent
	"Handle a key up event. The default response is to do nothing."! !

!Morph methodsFor: '*Keymapping-Core' stamp: 'GuillermoPolito 8/5/2013 10:27'!
on: aShortcut do: anAction
	
	^ self bindKeyCombination: aShortcut toAction: anAction ! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/14/2000 17:21'!
layoutPolicy: aLayoutPolicy
	"Layout specific. Return the layout policy describing how children of the receiver should appear."
	self layoutPolicy == aLayoutPolicy ifTrue:[^self].
	self assureExtension layoutPolicy: aLayoutPolicy.
	self layoutChanged.! !

!Morph methodsFor: 'accessing - properties' stamp: 'md 2/27/2006 09:47'!
hasProperty: aSymbol 
	"Answer whether the receiver has the property named aSymbol"
	extension ifNil: [^ false].
	^extension hasProperty: aSymbol! !

!Morph methodsFor: 'accessing' stamp: 'di 2/6/2001 14:02'!
borderWidthForRounding

	^ self borderWidth! !

!Morph methodsFor: 'events-processing' stamp: 'GuillermoPolito 4/22/2012 17:20'!
handleKeyDown: anEvent
	"System level event handling."
	anEvent wasHandled ifTrue:[^self].
	(self handlesKeyDown: anEvent) ifFalse:[^self].
	anEvent wasHandled: true.
	^self keyDown: anEvent! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'tk 12/15/1998 14:23'!
abandon
	"Like delete, but we really intend not to use this morph again.  Clean up a few things."

	self delete! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'nice 1/5/2010 15:59'!
morphsAt: aPoint unlocked: aBool do: aBlock
	"Evaluate aBlock with all the morphs starting at the receiver which appear at aPoint. If aBool is true take only visible, unlocked morphs into account."
	
	(self fullBounds containsPoint: aPoint) ifFalse:[^self].
	(aBool and:[self isLocked or:[self visible not]]) ifTrue:[^self].
	self submorphsDo:[:m| | tfm |
		tfm := m transformedFrom: self.
		m morphsAt: (tfm globalPointToLocal: aPoint) unlocked: aBool do: aBlock].
	(self containsPoint: aPoint) ifTrue:[aBlock value: self].! !

!Morph methodsFor: '*Morphic-Base' stamp: 'alain.plantec 6/19/2008 09:34'!
containingWindow
	"Answer a window that contains the receiver"

	^ self ownerThatIsA: SystemWindow! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'ar 8/12/2003 22:01'!
removedMorph: aMorph
	"Notify the receiver that aMorph was just removed from its children"
! !

!Morph methodsFor: 'initialize' stamp: 'dgd 2/14/2003 22:28'!
defaultColor
	"answer the default color/fill style for the receiver"
	^ Color blue! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 2/16/2009 11:15'!
expandFullBoundsForDropShadow: aRectangle
	"Return an expanded rectangle for an eventual drop shadow."
	
	^(aRectangle expandBy: self shadowOffsetRectangle)
		quickMerge: aRectangle! !

!Morph methodsFor: 'structure' stamp: 'ar 9/14/2000 16:48'!
withAllOwnersDo: aBlock
	"Evaluate aBlock with the receiver and all of its owners"
	aBlock value: self.
	owner ifNotNil:[^owner withAllOwnersDo: aBlock].! !

!Morph methodsFor: 'structure' stamp: 'di 11/12/2000 16:13'!
nearestOwnerThat: conditionBlock
	"Return the first enclosing morph for which aBlock evaluates to true, or nil if none"

	^ self firstOwnerSuchThat: conditionBlock
! !

!Morph methodsFor: 'accessing' stamp: 'wiz 11/6/2005 17:10'!
simplySetVisible: aBoolean
	"Set the receiver's visibility property.  This mild circumlocution is because my TransfomationMorph #visible: method would also set the visibility flag of my flexee, which in this case is pointless because it's the flexee that calls this.
	This appears in morph as a backstop for morphs that don't inherit from TFMorph"

	self visible: aBoolean! !

!Morph methodsFor: 'drop shadows' stamp: 'ClementBera 9/30/2013 11:00'!
shadowOffset: aPoint
	"Set the current shadow offset"
	(aPoint isNil or:[(aPoint x isZero) and: [ aPoint y isZero ]])
		ifTrue:[ self removeProperty: #shadowOffset ]
		ifFalse:[ self setProperty: #shadowOffset toValue: aPoint ].! !

!Morph methodsFor: 'rounding' stamp: 'ar 12/25/2001 19:44'!
toggleCornerRounding
	self cornerStyle == #rounded
		ifTrue: [self cornerStyle: #square]
		ifFalse: [self cornerStyle: #rounded].
	self changed! !

!Morph methodsFor: '*Spec-Core' stamp: 'IgorStasenko 12/19/2012 17:40'!
ensureLayoutAndAddMorph: aMorph

	aMorph layoutFrame
		ifNil: [ aMorph layoutFrame: LayoutFrame identity].
	self addMorph: aMorph ! !

!Morph methodsFor: 'creation' stamp: 'tk 2/6/1999 22:43'!
asMorph
	^ self! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/10/2007 13:40'!
dialogWindow
	"Answer the receiver's dialog window."

	^self ownerThatIsA: DialogWindow! !

!Morph methodsFor: 'accessing' stamp: 'tk 12/16/1998 11:54'!
userString
	"Do I have a text string to be searched on?"

	^ nil! !

!Morph methodsFor: '*Morphic-Widgets-ColorPicker' stamp: 'CamilloBruni 5/7/2013 23:37'!
scaledIntoFormOfSize: aSmallInteger 
	^ self imageForm scaledIntoFormOfSize: aSmallInteger ! !

!Morph methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 1/18/2012 18:46'!
doubleClickTimeout: evt
	"Handle a double-click timeout event. This message is only sent to clients that request it by sending #waitForClicksOrDrag:event: to the initiating hand in their mouseDown: method. This default implementation does nothing."

	^ self eventHandler ifNotNil:
		[self eventHandler doubleClickTimeout: evt fromMorph: self].! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'di 11/4/97 14:30'!
submorphsBehind: aMorph do: aBlock
	| behind |
	behind := false.
	submorphs do:
		[:m | m == aMorph ifTrue: [behind := true]
						ifFalse: [behind ifTrue: [aBlock value: m]]].
! !

!Morph methodsFor: '*Keymapping-Core' stamp: 'BenjaminVanRyseghem 2/20/2012 19:35'!
detachAllKeymapCategories

	self kmDispatcher detachAllKeymapCategories! !

!Morph methodsFor: 'halos and balloon help' stamp: 'SeanDeNigris 1/29/2013 13:57'!
balloonHelpTextForHandle: aHandle 
	"Answer a string providing balloon help for the
	given halo handle"
	(aHandle eventHandler mouseSelectorsInclude: #doRecolor:with:) ifTrue: [^ 'Change color'].
	(aHandle eventHandler mouseSelectorsInclude: #mouseDownInDimissHandle:with:) ifTrue: [^ 'Remove from screen' translated].
	#(#(#addFullHandles 'More halo handles')  #(#chooseEmphasisOrAlignment 'Emphasis & alignment') #(#chooseFont 'Change font') #(#chooseNewGraphicFromHalo 'Choose a new graphic') #(#chooseStyle 'Change style') #(#doDebug:with: 'Debug') #(#doDirection:with: 'Choose forward direction') #(#doDup:with: 'Duplicate')  #(#doMenu:with: 'Menu') #(#doGrab:with: 'Pick up')  #(#mouseDownInCollapseHandle:with: 'Collapse') #(#mouseDownOnHelpHandle: 'Help')  #(#prepareToTrackCenterOfRotation:with: 'Move object or set center of rotation') #(#startDrag:with: 'Move') #(#startGrow:with: 'Change size') #(#startRot:with: 'Rotate') #(#startScale:with: 'Change scale')#(#trackCenterOfRotation:with: 'Set center of rotation') )
		do: [:pair | (aHandle eventHandler mouseSelectorsInclude: pair first)
				ifTrue: [^ pair last]].
	^ 'unknown halo handle' translated! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 9/5/2007 15:22'!
wantsKeyboardFocus
	"Answer whether the receiver would like keyboard focus
	in the general case (mouse action normally)."

	^self takesKeyboardFocus and: [
		self visible and: [self enabled]]! !

!Morph methodsFor: 'accessing' stamp: 'RAA 2/19/2001 17:38'!
toggleLocked
	
	self lock: self isLocked not! !

!Morph methodsFor: 'debug and other' stamp: 'CamilloBruni 5/29/2012 16:51'!
resumeAfterDrawError

	self changed.
	self removeProperty:#errorOnDraw.
	self removeProperty:#drawError.
	self changed.! !

!Morph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/7/2015 21:14'!
fullDrawOnAthensCanvas: anAthensCanvas 
	"Draw the full Morphic structure on the given Canvas"

	self visible ifFalse: [^ self].
	(anAthensCanvas isVisible: self fullBounds) ifFalse: [^self].
	(self hasProperty: #errorOnDraw) ifTrue: [^self "drawErrorOn: aCanvas" ].

	(anAthensCanvas isVisible: self bounds) ifTrue: [ anAthensCanvas draw: self ].
	
	submorphs isEmpty ifTrue: [^self].

	self drawSubmorphsOnAthensCanvas: anAthensCanvas
! !

!Morph methodsFor: 'announcements' stamp: 'ThierryGoubier 1/8/2014 14:36'!
announceOpened
	self doAnnounce: (MorphOpened morph: self).
	self submorphs do: #announceOpened! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 9/6/2007 15:35'!
focusIndicatorMorph
	"Answer the focus indicator morph for the receiver."

	^self theme focusIndicatorMorphFor: self! !

!Morph methodsFor: 'events-processing' stamp: 'AlainPlantec 12/1/2010 09:33'!
handleDropMorph: anEvent
	"Handle a dropping morph."
	| aMorph localPt |
	aMorph := anEvent contents.
	"Do a symmetric check if both morphs like each other"
	((self wantsDroppedMorph: aMorph event: anEvent)	"I want her"
		and: [aMorph wantsToBeDroppedInto: self])		"she wants me"
		ifFalse: [^ self].
	anEvent wasHandled: true.
	"Transform the morph into the receiver's coordinate frame. This is currently incomplete since it only takes the offset into account where it really should take the entire transform."
	localPt := (self transformedFrom: anEvent hand world) "full transform down"
				globalPointToLocal: aMorph referencePosition.
	aMorph referencePosition: localPt.
	self acceptDroppingMorph: aMorph event: anEvent.
	aMorph justDroppedInto: self event: anEvent.
! !

!Morph methodsFor: 'halos and balloon help' stamp: 'AlainPlantec 12/19/2009 23:41'!
wantsDirectionHandles: aBool
	self setProperty: #wantsDirectionHandles toValue: aBool
! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/16/2008 16:57'!
tabKey: event
	"Check for tab key activity and change focus as appropriate."

	event controlKeyPressed ifFalse: [
		event keyCharacter = Character tab ifTrue: [
			event shiftPressed
				ifTrue: [self navigateFocusBackward]
				ifFalse: [self navigateFocusForward].
			^true]].
	^false! !

!Morph methodsFor: 'structure' stamp: 'RAA 6/13/2000 15:01'!
primaryHand

        | outer |
        outer := self outermostWorldMorph ifNil: [^ nil].
        ^ outer activeHand ifNil: [outer firstHand]! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 20:04'!
reverseTableCells: aBool
	"Layout specific. This property describes if the cells should be treated in reverse order of submorphs."
	self assureTableProperties reverseTableCells: aBool.
	self layoutChanged.! !

!Morph methodsFor: 'meta-actions' stamp: 'MarcusDenker 7/9/2012 15:31'!
dismissMorph
	"This is called from an explicit halo destroy/delete action."

	| w |
	w := self world ifNil:[^self].
	w deleteAllHalos; stopStepping: self.
	self delete! !

!Morph methodsFor: 'Morphic-Base-Widgets' stamp: 'BenjaminVanRyseghem 5/21/2013 18:02'!
listRenderOn: aCanvas atRow: aRow bounds: drawBounds color: drawColor backgroundColor: backgroundColor from: aMorph

	self bounds: drawBounds.
	self fullDrawOn: aCanvas.
	(aMorph submorphs includes: self)
		ifFalse: [ aMorph addMorph: self ]! !

!Morph methodsFor: '*Morphic-Base' stamp: 'GuillermoPolito 7/24/2012 13:08'!
on: eventName send: selector to: recipient withValue: value
	"NOTE: selector must take 3 arguments, of which value will be the *** FIRST ***"

	self eventHandler ifNil: [self eventHandler: MorphicEventHandler new].
	self eventHandler on: eventName send: selector to: recipient withValue: value
! !

!Morph methodsFor: 'accessing' stamp: 'sw 11/26/2001 16:16'!
setBorderStyle: aSymbol
	"Set the border style of my costume"

	| aStyle |
	aStyle := self borderStyleForSymbol: aSymbol.
	aStyle ifNil: [^ self].
	(self canDrawBorder: aStyle)
		ifTrue:
			[self borderStyle: aStyle]! !

!Morph methodsFor: 'copying' stamp: 'tk 1/6/1999 17:27'!
veryDeepCopyWith: deepCopier
	"Copy me and the entire tree of objects I point to.  An object in the tree twice is copied once, and both references point to him.  deepCopier holds a dictionary of objects we have seen.  See veryDeepInner:, veryDeepFixupWith:"

	self prepareToBeSaved.
	^ super veryDeepCopyWith: deepCopier! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'panda 4/25/2000 15:41'!
disableDragNDrop
	self enableDragNDrop: false! !

!Morph methodsFor: 'geometry' stamp: 'MarianoMartinezPeck 8/24/2012 15:26'!
extent: aPoint
	|newExtent|	
	newExtent := aPoint rounded.
	(bounds extent closeTo: newExtent) ifTrue: [^ self].
	self changed.
	bounds := (bounds topLeft extent: newExtent).
	self layoutChanged.
	self changed.
! !

!Morph methodsFor: 'classification' stamp: ''!
isHandMorph

	^ false! !

!Morph methodsFor: 'geometry' stamp: 'di 6/12/97 11:07'!
topLeft

	^ bounds topLeft! !

!Morph methodsFor: '*glamour-morphic-widgets' stamp: 'TudorGirba 1/16/2014 11:38'!
asReadOnlyMorph
	^ self! !

!Morph methodsFor: 'drawing' stamp: 'md 2/27/2006 08:49'!
visible
	"answer whether the receiver is visible"
	extension ifNil: [^ true].
	^ extension visible! !

!Morph methodsFor: 'Morphic-Base-Widgets' stamp: 'BenjaminVanRyseghem 7/25/2012 11:42'!
heightToDisplayInList: aList

	^ self minExtent y! !

!Morph methodsFor: '*Morphic-Base' stamp: 'MarcusDenker 10/21/2013 14:21'!
defaultLabel
	"Answer the default label to be used"
	^ self printString truncateTo: 40! !

!Morph methodsFor: '*Morphic-Base' stamp: 'ar 11/14/2000 17:56'!
assureLayoutProperties
	| props |
	props := self layoutProperties.
	props == self ifTrue:[props := nil].
	props ifNil:[
		props := LayoutProperties new initializeFrom: self.
		self layoutProperties: props].
	^props! !

!Morph methodsFor: 'rotate scale and flex' stamp: 'nk 9/4/2004 11:00'!
scale: newScale
	"Backstop for morphs that don't have to do something special to set their scale"
! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 10/18/2006 11:58'!
adoptPaneColor
	"Adopt our pane color."

	self adoptPaneColor: self paneColor! !

!Morph methodsFor: 'layout' stamp: 'dgd 2/16/2003 21:52'!
minHeight
	"answer the receiver's minHeight"
	^ self
		valueOfProperty: #minHeight
		ifAbsent: [2]! !

!Morph methodsFor: 'events-accessing' stamp: 'gvc 9/11/2009 17:43'!
actionMap
	"Answer an action map"

	^self updateableActionMap! !

!Morph methodsFor: 'layout-properties' stamp: 'dgd 2/16/2003 20:02'!
spaceFillWeight
	"Layout specific. This property describes the relative weight that 
	should be given to the receiver when extra space is distributed 
	between different #spaceFill cells."

	^ self
		valueOfProperty: #spaceFillWeight
		ifAbsent: [1]! !

!Morph methodsFor: 'event handling' stamp: 'CamilloBruni 8/1/2012 16:04'!
doubleClick: evt
	"Handle a double-click event. This message is only sent to clients that request it by sending #waitForClicksOrDrag:event: to the initiating hand in their mouseDown: method. This default implementation does nothing."

	^ self eventHandler ifNotNil:
		[self eventHandler doubleClick: evt fromMorph: self].! !

!Morph methodsFor: 'geometry' stamp: 'ar 9/27/2000 14:04'!
referencePosition: aPosition
	"Move the receiver to match its reference position with aPosition"
	| newPos intPos |
	newPos := self position + (aPosition - self referencePosition).
	intPos := newPos asIntegerPoint.
	newPos = intPos 
		ifTrue:[self position: intPos]
		ifFalse:[self position: newPos].! !

!Morph methodsFor: 'geometry' stamp: 'efc 2/13/2003 18:10'!
topLeft: aPoint
	" Move me so that my top left corner is at aPoint. My extent (width & height) are unchanged "

	self position: aPoint
! !

!Morph methodsFor: 'menus' stamp: 'sw 2/3/2000 00:12'!
adjustedCenter: c
	"Set the receiver's position based on the #adjustedCenter protocol for adhereToEdge.  By default this simply sets the receiver's center.   Though there are (at its inception anyway) no other implementors of this method, it is required in use with the #adhereToEdge when the centering of a submorph is to be with reference to a rectangle  other than the receiver's center."

	self center: c! !

!Morph methodsFor: 'structure' stamp: 'dgd 2/22/2003 14:34'!
root
	"Return the root of the composite morph containing the receiver. The owner of the root is either nil, a WorldMorph, or a HandMorph. If the receiver's owner is nil, the root is the receiver itself. This method always returns a morph."

	(owner isNil or: [owner isWorldOrHandMorph]) ifTrue: [^self].
	^owner root! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'dgd 9/6/2004 14:17'!
mainDockingBars
	"Answer the receiver's main dockingBars"
	^ self dockingBars
		select: [:each | each hasProperty: #mainDockingBarTimeStamp]! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'panda 4/25/2000 15:51'!
enableDrop: aBoolean
	self setProperty: #dropEnabled toValue: aBoolean! !

!Morph methodsFor: 'accessing' stamp: 'md 2/27/2006 09:53'!
eventHandler
	"answer the receiver's eventHandler"
	^ extension ifNotNil: [extension eventHandler] ! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'tk 10/20/2000 13:13'!
submorphBefore
	"Return the submorph after (behind) me, or nil"
	| ii |
	owner ifNil: [^ nil].
	^ (ii := owner submorphIndexOf: self) = 1 
		ifTrue: [nil]
		ifFalse: [owner submorphs at: ii-1].
	
! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'ar 1/31/2001 12:44'!
addMorph: newMorph behind: aMorph
	"Add a morph to the list of submorphs behind the specified morph"
	^self privateAddMorph: newMorph atIndex: (submorphs indexOf: aMorph) + 1.
! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 10/29/2000 02:48'!
cellPositioningString: aSymbol
	^self layoutMenuPropertyString: aSymbol from: self cellPositioning! !

!Morph methodsFor: 'printing' stamp: 'jm 5/28/1998 18:00'!
printStructureOn: aStream indent: tabCount

	tabCount timesRepeat: [aStream tab].
	self printOn: aStream.
	aStream cr.
	self submorphsDo: [:m | m printStructureOn: aStream indent: tabCount + 1].
! !

!Morph methodsFor: 'geometry testing' stamp: 'MarcusDenker 10/21/2013 14:22'!
fullContainsPoint: aPoint
	(self fullBounds containsPoint: aPoint)
		ifFalse: [ ^ false ].	"quick elimination"
	(self containsPoint: aPoint)
		ifTrue: [ ^ true ].	"quick acceptance"
	^ submorphs anySatisfy: [ :m | m fullContainsPoint: aPoint ]! !

!Morph methodsFor: 'layout' stamp: 'nice 1/5/2010 15:59'!
submorphBounds
	"Private. Compute the actual full bounds of the receiver"
	| box |
	submorphs do: [:m | | subBox | 
		(m visible) ifTrue: [
			subBox := m fullBounds.
			box 
				ifNil:[box := subBox copy]
				ifNotNil:[box := box quickMerge: subBox]]].
	box ifNil:[^self bounds]. "e.g., having submorphs but not visible"
	^ box origin asIntegerPoint corner: box corner asIntegerPoint
! !

!Morph methodsFor: 'menus' stamp: 'DamienCassou 9/29/2009 13:01'!
exportAsJPEG
	"Export the receiver's image as a JPEG"

	| fName |
	fName := UIManager default request: 'Please enter the name' translated initialAnswer: self externalName,'.jpeg'.
	fName isEmptyOrNil ifTrue: [^ self].
	self imageForm writeJPEGfileNamed: fName! !

!Morph methodsFor: 'layout' stamp: 'ClementBera 7/30/2013 11:04'!
minHeight: aNumber 
	aNumber 
		ifNil: [self removeProperty: #minHeight]
		ifNotNil: [self setProperty: #minHeight toValue: aNumber].
	self layoutChanged! !

!Morph methodsFor: 'private' stamp: ''!
privateSubmorphs: aCollection
	"Private!! Should only be used by methods that maintain the ower/submorph invariant."

	submorphs := aCollection.! !

!Morph methodsFor: 'events-processing' stamp: 'BenjaminVanRyseghem 1/18/2012 18:58'!
handleMouseLeave: anEvent
	"System level event handling."
	anEvent hand removePendingBalloonFor: self.
	anEvent isDraggingEvent ifTrue:[
		(self handlesMouseOverDragging: anEvent) ifTrue:[
			anEvent wasHandled: true.
			self mouseLeaveDragging: anEvent].
		^ self eventHandler ifNotNil: [:handler | handler mouseLeave: anEvent fromMorph: self ]].
	(self handlesMouseOver: anEvent) ifTrue:[
		anEvent wasHandled: true.
		self mouseLeave: anEvent ].
	^ self eventHandler ifNotNil: [:handler | handler mouseLeave: anEvent fromMorph: self ]! !

!Morph methodsFor: 'meta-actions' stamp: 'MarcusDenker 7/28/2014 21:25'!
showActions
	"Put up a message list browser of all the code that this morph  
	would run for mouseUp, mouseDown, mouseMove, mouseEnter,  
	mouseLeave, and mouseLinger."
	
	| list cls selector adder |
	list := SortedCollection new.
	adder := [:mrClass :mrSel | list
				add: (RGMethodDefinition realClass: mrClass selector: mrSel)].
	"the eventHandler"
	self eventHandler
		ifNotNil: [list := self eventHandler methodRefList.
			(self eventHandler handlesMouseDown: nil)
				ifFalse: [adder value: HandMorph value: #grabMorph:]].
	"If not those, then non-default raw events"
	#(#keyStroke: #mouseDown: #mouseEnter: #mouseLeave: #mouseMove: #mouseUp: #doButtonAction )
		do: [:sel | 
			cls := self class whichClassIncludesSelector: sel.
			cls
				ifNotNil: ["want more than default behavior"
					cls == Morph
						ifFalse: [adder value: cls value: sel]]].
	"The mechanism on a Button"
	(self respondsTo: #actionSelector)
		ifTrue: ["A button"
			selector := self actionSelector.
			cls := self target class whichClassIncludesSelector: selector.
			cls
				ifNotNil: ["want more than default behavior"
					cls == Morph
						ifFalse: [adder value: cls value: selector]]].
	Smalltalk tools messageList browse: list title:  'Actions of ' , self printString.! !

!Morph methodsFor: 'drawing' stamp: 'IgorStasenko 7/18/2011 17:48'!
drawOn: aCanvas

	aCanvas fillRectangle: self bounds fillStyle: self fillStyle borderStyle: self borderStyle! !

!Morph methodsFor: 'private' stamp: 'MarcusDenker 10/21/2013 14:22'!
privateAddMorph: aMorph atIndex: index
	| oldIndex myWorld itsWorld oldOwner |
	(index between: 1 and: submorphs size + 1)
		ifFalse: [ ^ self error: 'index out of range' ].
	myWorld := self world.
	oldOwner := aMorph owner.
	(oldOwner == self and: [ (oldIndex := submorphs indexOf: aMorph) > 0 ])
		ifTrue: [ 
			"aMorph's position changes within in the submorph chain"
			oldIndex < index
				ifTrue: [ 
					"moving aMorph to back"
					submorphs
						replaceFrom: oldIndex
						to: index - 2
						with: submorphs
						startingAt: oldIndex + 1.
					submorphs at: index - 1 put: aMorph ]
				ifFalse: [ 
					"moving aMorph to front"
					oldIndex - 1 to: index by: -1 do: [ :i | submorphs at: i + 1 put: (submorphs at: i) ].
					submorphs at: index put: aMorph ] ]
		ifFalse: [ 
			"adding a new morph"
			oldOwner
				ifNotNil: [ 
					itsWorld := aMorph world.
					itsWorld ifNotNil: [ self privateInvalidateMorph: aMorph ].
					itsWorld == myWorld
						ifFalse: [ aMorph outOfWorld: itsWorld ].
					oldOwner privateRemove: aMorph.
					oldOwner removedMorph: aMorph ].
			aMorph privateOwner: self.
			submorphs := submorphs copyReplaceFrom: index to: index - 1 with: (Array with: aMorph).
			itsWorld == myWorld
				ifFalse: [ aMorph intoWorld: myWorld ] ].
	myWorld ifNotNil: [ self privateInvalidateMorph: aMorph ].
	self layoutChanged.
	oldOwner == self
		ifFalse: [ 
			self addedMorph: aMorph.
			aMorph noteNewOwner: self ]! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'BenjaminVanRyseghem 6/24/2012 23:27'!
heightToDisplayInTree: aTree

	^ self minExtent y! !

!Morph methodsFor: 'change reporting' stamp: 'ar 11/12/2000 18:50'!
invalidRect: damageRect
	^self invalidRect: damageRect from: self! !

!Morph methodsFor: 'accessing' stamp: 'di 8/11/1998 12:33'!
unlock
	self lock: false! !

!Morph methodsFor: 'meta-actions' stamp: 'SeanDeNigris 4/24/2012 19:49'!
handlerForBlueButtonDown: anEvent
	"Return the (prospective) handler for a mouse down event. The handler is temporarily installed and can be used for morphs further down the hierarchy to negotiate whether the inner or the outer morph should finally handle the event.
	Note: Halos handle blue button events themselves so we will only be asked if there is currently no halo on top of us.
	Check whtehr halods are enabled (for deployment)."
	
	self wantsHaloFromClick ifFalse:[^nil].
	
	self class cycleHalosBothDirections ifTrue: [
		anEvent handler ifNil:[^self]. 
		(anEvent handler isKindOf: PasteUpMorph) ifTrue:[^self] ].

	(anEvent shiftPressed)
		ifFalse:[^nil] "let outer guy have it"
		ifTrue:[^self] "let me have it"
! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'di 10/18/2004 21:50'!
removeMorph: aMorph
	"Remove the given morph from my submorphs"
	| aWorld |
	aMorph owner == self ifFalse:[^self].
	aWorld := self world.
	aWorld ifNotNil:[
		aMorph outOfWorld: aWorld.
		self privateInvalidateMorph: aMorph.
	].
	self privateRemove: aMorph.
	aMorph privateOwner: nil.
	self removedMorph: aMorph.
! !

!Morph methodsFor: 'drawing' stamp: 'LC 5/18/2000 08:51'!
highlightForMouseDown
	self highlightForMouseDown: true! !

!Morph methodsFor: 'private' stamp: ''!
privateOwner: aMorph
	"Private!! Should only be used by methods that maintain the ower/submorph invariant."

	owner := aMorph.! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'efc 8/6/2005 11:35'!
submorphs
	"This method returns my actual submorphs collection. Modifying the collection directly could be dangerous; make a copy if you need to alter it."
	^ submorphs ! !

!Morph methodsFor: 'layout-menu' stamp: 'ar 11/13/2000 19:10'!
changeRubberBandCells
	self rubberBandCells: self rubberBandCells not.! !

!Morph methodsFor: 'drop shadows' stamp: 'dgd 2/16/2003 21:42'!
hasDropShadow
	"answer whether the receiver has DropShadow"
	^ self
		valueOfProperty: #hasDropShadow
		ifAbsent: [false]! !

!Morph methodsFor: 'drawing' stamp: 'IgorStasenko 12/22/2012 03:14'!
drawSubmorphsOn: aCanvas 
	"Display submorphs back to front"

	| drawBlock |
	submorphs isEmpty ifTrue: [^self].
	drawBlock := [:canvas | submorphs reverseDo: [:m | canvas fullDrawMorph: m]].
	self clipSubmorphs 
		ifTrue: [aCanvas clipBy: (aCanvas clipRect intersect: self clippingBounds ifNone: [ ^ self ]) during: drawBlock]
		ifFalse: [drawBlock value: aCanvas]! !

!Morph methodsFor: 'geometry' stamp: 'ar 10/25/2000 15:03'!
pointInWorld: aPoint
	^self point: aPoint in: self world! !

!Morph methodsFor: 'drawing' stamp: 'ar 10/29/2000 19:22'!
clipLayoutCells: aBool
	"Drawing/layout specific. If this property is set, clip the submorphs of the receiver by its cell bounds."
	aBool == false
		ifTrue:[self removeProperty: #clipLayoutCells]
		ifFalse:[self setProperty: #clipLayoutCells toValue: aBool].
	self changed.! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'panda 4/28/2000 10:52'!
dropHighlightColor
	^ Color blue! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'ClementBera 10/3/2013 10:29'!
submorphThat: block1 ifNone: block2
	^ submorphs detect: [:m | (block1 value: m) == true] ifNone: block2
	! !

!Morph methodsFor: 'accessing' stamp: 'MarcusDenker 10/3/2013 23:47'!
highlightColor
	
	^ (self valueOfProperty: #highlightColor)
		ifNotNil:
			[:val | val ifNil: [self error: 'nil highlightColor']]
		ifNil:
			[owner ifNil: [self color] ifNotNil: [owner highlightColor]]! !

!Morph methodsFor: 'halos and balloon help' stamp: 'sw 11/27/2001 14:50'!
okayToBrownDragEasily
	"Answer whether it it okay for the receiver to be brown-dragged easily -- i.e. repositioned within its container without extracting it.  At present this is just a hook -- nobody declines."

	^ true



"
	^ (self topRendererOrSelf owner isKindOf: PasteUpMorph) and:
		[self layoutPolicy isNil]"! !

!Morph methodsFor: '*Keymapping-Core' stamp: 'BenjaminVanRyseghem 2/20/2012 19:23'!
detachKeymapCategory: aCategoryName

	self kmDispatcher detachKeymapCategory: aCategoryName.! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'dgd 2/22/2003 14:30'!
comeToFront
	| outerMorph |
	outerMorph := self topRendererOrSelf.
	(outerMorph owner isNil or: [outerMorph owner hasSubmorphs not]) 
		ifTrue: [^self].
	outerMorph owner firstSubmorph == outerMorph 
		ifFalse: [outerMorph owner addMorphFront: outerMorph]! !

!Morph methodsFor: '*glamour-morphic-widgets' stamp: 'cyrilledelaunay 6/7/2011 10:37'!
glamourOptimalExtent

	|tmpOldResizing tmpResult|
	tmpOldResizing := self setOptimalResizingStrategyAndReturnOldOne. 
	tmpResult := self minExtent.
	self returnToOldResizingStrategy:  tmpOldResizing.
	^ tmpResult ! !

!Morph methodsFor: 'geometry' stamp: 'sw 6/4/2000 22:00'!
minimumExtent: aPoint
	"Remember a minimumExtent, for possible future use"

	self setProperty: #minimumExtent toValue: aPoint
! !

!Morph methodsFor: 'private' stamp: ''!
privateBounds: boundsRect
	"Private!! Use position: and/or extent: instead."

	fullBounds := nil.
	bounds := boundsRect.! !

!Morph methodsFor: 'drop shadows' stamp: 'ar 11/12/2000 18:58'!
shadowPoint: newPoint
	self changed.
	self shadowOffset: newPoint - self center // 5.
	fullBounds ifNotNil:[fullBounds := self privateFullBounds].
	self changed.! !

!Morph methodsFor: 'layout-menu' stamp: 'StephaneDucasse 4/22/2012 16:49'!
hasClipLayoutCellsString
	^ (self clipLayoutCells) -> 'clip to cell size' translated! !

!Morph methodsFor: 'event handling' stamp: 'mir 5/23/2000 17:43'!
startDrag: evt
	"Handle a double-click event. This message is only sent to clients that request it by sending #waitForClicksOrDrag:event: to the initiating hand in their mouseDown: method. This default implementation does nothing."

	self eventHandler ifNotNil:
		[self eventHandler startDrag: evt fromMorph: self].! !

!Morph methodsFor: 'menus' stamp: 'StephaneDucasse 10/22/2014 21:56'!
maybeAddCollapseItemTo: aMenu
	"If appropriate, add a collapse item to the given menu"

	| anOwner |
	(anOwner := self topRendererOrSelf owner) ifNotNil:
			[anOwner isWorldMorph ifTrue:
				[aMenu add: 'collapse' target: self selector: #collapse]]! !

!Morph methodsFor: 'geometry' stamp: ''!
width

	^ bounds width! !

!Morph methodsFor: 'accessing' stamp: 'sw 8/15/97 23:59'!
unlockContents
	self submorphsDo:
		[:m | m unlock]! !

!Morph methodsFor: 'wiw support' stamp: 'MarcusDenker 6/18/2014 11:27'!
addMorphInFrontOfLayer: aMorph

	| targetLayer |

	targetLayer := aMorph morphicLayerNumber.
	submorphs do: [ :each | | layerHere |
		each == aMorph ifTrue: [^self].
		layerHere := each morphicLayerNumber.
		"the <= is the difference - it insures we go to the front of our layer"
		targetLayer <= layerHere ifTrue: [
			^self addMorph: aMorph inFrontOf: each
		].
	].
	self addMorphBack: aMorph.
! !

!Morph methodsFor: 'accessing' stamp: 'nk 4/15/2004 07:50'!
doesBevels
	"To return true means that this object can show bevelled borders, and
	therefore can accept, eg, #raised or #inset as valid borderColors.
	Must be overridden by subclasses that do not support bevelled borders."

	^ false! !

!Morph methodsFor: 'layout-menu' stamp: 'ar 10/31/2000 19:19'!
changeNoLayout
	self layoutPolicy ifNil:[^self]. "already no layout"
	self layoutPolicy: nil.
	self layoutChanged.! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'nice 1/5/2010 15:59'!
submorphNamed: aName ifNone: aBlock 
	"Find the first submorph with this name, or a button with an action selector of that name"

	
	self submorphs do: 
			[:button | | sub args | 
			(button respondsTo: #actionSelector) 
				ifTrue: [button actionSelector == aName ifTrue: [^button]].
			((button respondsTo: #arguments) and: [(args := button arguments) notNil]) 
				ifTrue: [(args at: 2 ifAbsent: [nil]) == aName ifTrue: [^button]].
			(button isAlignmentMorph) 
				ifTrue: [(sub := button submorphNamed: aName ifNone: [nil]) ifNotNil: [^sub]]].
	^aBlock value! !

!Morph methodsFor: 'debug and other' stamp: 'nice 1/5/2010 15:59'!
allStringsAfter: aSubmorph 
	"return an OrderedCollection of strings of text in my submorphs.  If aSubmorph is non-nil, begin with that container."

	| list ok |
	list := OrderedCollection new.
	ok := aSubmorph isNil.
	self allMorphsDo: 
			[:sub | | string | 
			ok ifFalse: [ok := sub == aSubmorph].	"and do this one too"
			ok 
				ifTrue: 
					[(string := sub userString) ifNotNil: 
							[string isString ifTrue: [list add: string] ifFalse: [list addAll: string]]]].
	^list! !

!Morph methodsFor: 'event handling' stamp: 'GuillermoPolito 5/3/2013 10:58'!
mouseDown: evt 
	"Handle a mouse down event. The default response is to let my 
	eventHandler, if any, handle it."
	self eventHandler
		ifNotNil: [self eventHandler mouseDown: evt fromMorph: self]
! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'tk 10/20/2000 13:12'!
submorphAfter
	"Return the submorph after (behind) me, or nil"
	| ii |
	owner ifNil: [^ nil].
	^ (ii := owner submorphIndexOf: self) = owner submorphs size 
		ifTrue: [nil]
		ifFalse: [owner submorphs at: ii+1].
	
! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'di 11/4/97 14:29'!
submorphsInFrontOf: aMorph do: aBlock
	| behind |
	behind := false.
	submorphs do:
		[:m | m == aMorph ifTrue: [behind := true]
						ifFalse: [behind ifFalse: [aBlock value: m]]].
! !

!Morph methodsFor: 'event handling' stamp: 'ar 10/22/2000 17:06'!
handlesMouseStillDown: evt
	"Return true if the receiver wants to get repeated #mouseStillDown: messages between #mouseDown: and #mouseUp"
	self eventHandler ifNotNil: [^ self eventHandler handlesMouseStillDown: evt].
	^ false
! !

!Morph methodsFor: 'menus' stamp: 'ar 11/2/2000 15:04'!
changeDragAndDrop
	^self enableDragNDrop: self dragNDropEnabled not! !

!Morph methodsFor: 'debug and other' stamp: 'CamilloBruni 5/29/2012 17:17'!
debugDrawError
	
	(self valueOfProperty: #drawError) debug.! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 10/9/2007 11:26'!
themeChanged
	"The current theme has changed.
	Update any dependent visual aspects."

	self submorphsDo: [:m | m themeChanged].
	self changed! !

!Morph methodsFor: 'event handling' stamp: 'AlainPlantec 12/19/2009 23:25'!
tabAmongFields
	^ self theme settings tabAmongFields
		or: [self hasProperty: #tabAmongFields] ! !

!Morph methodsFor: 'menus' stamp: 'StephaneDucasse 10/27/2014 20:19'!
addToggleItemsToHaloMenu: aMenu
	"Add standard true/false-checkbox items to the memu"

	#(
		(resistsRemovalString toggleResistsRemoval 'whether I should be reistant to easy deletion via the pink X handle' true)
		(stickinessString toggleStickiness 'whether I should be resistant to a drag done by mousing down on me' true)
		(lockedString lockUnlockMorph 'when "locked", I am inert to all user interactions' true)
		(hasClipSubmorphsString changeClipSubmorphs 'whether the parts of objects within me that are outside my bounds should be masked.' false)
		(hasDirectionHandlesString changeDirectionHandles 'whether direction handles are shown with the halo' false)
		(hasDragAndDropEnabledString changeDragAndDrop 'whether I am open to having objects dropped into me' false)
	) do: [:each |
			aMenu addUpdating: each first selector: each second.
			aMenu balloonTextForLastItem: each third translated].

	self couldHaveRoundedCorners ifTrue:
		[aMenu addUpdating: #roundedCornersString selector: #toggleCornerRounding.
		aMenu balloonTextForLastItem: 'whether my corners should be rounded' translated]! !

!Morph methodsFor: 'testing' stamp: 'WilliamSix 1/14/2013 19:43'!
shouldFlex
	^ self isFlexMorph.! !

!Morph methodsFor: 'visual properties' stamp: 'gvc 9/11/2009 16:35'!
fillStyle
	"Return the current fillStyle of the receiver."
	
	^extension
		ifNil: [^color]
		ifNotNil: [extension fillStyle ifNil: [color]]! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 19:57'!
hResizing
	"Layout specific. This property describes how the receiver should be resized with respect to its owner and its children. Possible values are:
		#rigid			-	do not resize the receiver
		#spaceFill		-	resize to fill owner's available space
		#shrinkWrap	- resize to fit children
	"
	| props |
	props := self layoutProperties.
	^props ifNil:[#rigid] ifNotNil:[props hResizing].! !

!Morph methodsFor: 'utilities' stamp: 'sw 10/23/1998 11:50'!
transparentSpacerOfSize: aPoint
	^ (Morph new extent: aPoint) color: Color transparent! !

!Morph methodsFor: 'events-alarms' stamp: 'ar 9/11/2000 16:35'!
addAlarm: aSelector at: scheduledTime
	"Add an alarm (that is an action to be executed once) with the given set of parameters"
	^self addAlarm: aSelector withArguments: #() at: scheduledTime! !

!Morph methodsFor: 'printing' stamp: 'bf 7/17/2003 12:53'!
clipText
	"Copy the text in the receiver or in its submorphs to the clipboard"
	| content |
	"My own text"
	content := self userString.
	"Or in my submorphs"
	content ifNil: [
		| list |
		list := self allStringsAfter: nil.
		list notEmpty ifTrue: [
			content := String streamContents: [:stream |
				list do: [:each | stream nextPutAll: each; cr]]]].
	"Did we find something?"
	content
		ifNil: [self flash "provide feedback"]
		ifNotNil: [Clipboard clipboardText: content].! !

!Morph methodsFor: '*Spec-MorphicAdapters' stamp: 'BenjaminVanRyseghem 10/1/2013 13:47'!
asSpecAdapter

	^ MorphicGenericAdapter 
		morph: self! !

!Morph methodsFor: 'meta-actions' stamp: 'ar 10/6/2000 16:37'!
grabMorph: evt

	evt hand grabMorph: self! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'panda 4/25/2000 15:41'!
enableDragNDrop
	self enableDragNDrop: true! !

!Morph methodsFor: 'accessing - properties' stamp: 'md 2/27/2006 08:50'!
valueOfProperty: aSymbol ifAbsent: aBlock 
	"if the receiver possesses a property of the given name, answer  
	its value. If not then evaluate aBlock and answer the result of  
	this block evaluation"
	^ extension 
		ifNotNil: [extension valueOfProperty: aSymbol ifAbsent: aBlock]
		ifNil: [aBlock value]! !

!Morph methodsFor: 'event handling' stamp: 'tk 9/6/2000 12:42'!
click
	"Pretend the user clicked on me."

	(self handlesMouseDown: nil) ifTrue: [
		self mouseDown: nil.
		self mouseUp: nil].! !

!Morph methodsFor: '*Morphic-Base' stamp: 'AlainPlantec 12/12/2009 09:54'!
addWorldHandlesTo: aHaloMorph box: box
	aHaloMorph haloBox: box.
	HaloMorph haloSpecificationsForWorld 
		do: [:aSpec | aHaloMorph perform: aSpec addHandleSelector with: aSpec].
	aHaloMorph innerTarget addOptionalHandlesTo: aHaloMorph box: box! !

!Morph methodsFor: 'copying' stamp: 'pmm 3/13/2010 11:32'!
veryDeepInner: deepCopier 
	"The inner loop, so it can be overridden when a field should not  
	be traced."
	"super veryDeepInner: deepCopier.	know Object has no inst vars"
	bounds := bounds shallowCopy.
	"Points are shared with original"
	"owner := owner.	special, see veryDeepFixupWith:"
	submorphs := submorphs veryDeepCopyWith: deepCopier.
	"each submorph's fixup will install me as the owner"
	"fullBounds := fullBounds.	fullBounds is shared with original!!"
	color := color veryDeepCopyWith: deepCopier.
	"color, if simple, will return self. may be complex"
	extension := (extension veryDeepCopyWith: deepCopier)! !

!Morph methodsFor: 'accessing-backstop' stamp: 'wiz 2/14/2006 19:02'!
target: aMorph
"Morphs with targets will override. This backstop does nothing."
"This is here because targeting meta-actions are taken at morph level. 
Do not remove."! !

!Morph methodsFor: 'event handling' stamp: 'sw 8/29/2000 14:57'!
wouldAcceptKeyboardFocusUponTab
	"Answer whether the receiver is in the running as the new keyboard focus if the tab key were hit at a meta level.  This provides the leverage for tabbing among fields of a card, for example."

	^ false! !

!Morph methodsFor: 'drawing' stamp: 'StephaneDucasse 4/22/2012 16:50'!
hasClipSubmorphsString
	"Answer a string that represents the clip-submophs checkbox"
	^ (self clipSubmorphs) -> 'provide clipping' translated! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'BenjaminVanRyseghem 6/24/2012 23:39'!
treeRenderOn: aCanvas bounds: drawBounds color: drawColor font: aFont from: aMorph

	self bounds: drawBounds.
	aMorph addMorphBack: self.
       ! !

!Morph methodsFor: 'drawing' stamp: 'ar 10/29/2000 19:16'!
clippingBounds
	"Return the bounds to which any submorphs should be clipped if the property is set"
	^self innerBounds! !

!Morph methodsFor: 'drawing' stamp: 'panda 4/28/2000 11:59'!
drawDropHighlightOn: aCanvas
	self highlightedForDrop ifTrue: [
		aCanvas frameRectangle: self fullBounds color: self dropHighlightColor].! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 9/11/2006 09:38'!
modalUnlockFrom: aSystemWindow
	"Unlock the receiver as a modal owner of the given window."

	self unlock! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 20:06'!
hResizing: aSymbol
	"Layout specific. This property describes how the receiver should be resized with respect to its owner and its children. Possible values are:
		#rigid			-	do not resize the receiver
		#spaceFill		-	resize to fill owner's available space
		#shrinkWrap	- resize to fit children
	"
	self assureLayoutProperties hResizing: aSymbol.
	self layoutChanged.
! !

!Morph methodsFor: 'halos and balloon help' stamp: 'AlainPlantec 12/12/2009 07:10'!
transferHalo: event from: formerHaloOwner
	"Progressively transfer the halo to the next likely recipient"
	| localEvt w target |

	self flag: #workAround. "For halo's distinction between 'target' and 'innerTarget' we need to bypass any renderers."
	(formerHaloOwner == self and:[self isRenderer and:[self wantsHaloFromClick not]]) ifTrue:[
		event shiftPressed ifTrue:[
			target := owner.
			localEvt := event transformedBy: (self transformedFrom: owner).
		] ifFalse:[
			target := self renderedMorph.
			localEvt := event transformedBy: (target transformedFrom: self).
		].
		^target transferHalo: localEvt from: target].

"	formerHaloOwner == self ifTrue:[^ self removeHalo]."

	"Never transfer halo to top-most world"
	(self isWorldMorph and:[owner isNil]) ifFalse:[
		(self wantsHaloFromClick and:[formerHaloOwner ~~ self]) 
			ifTrue:[^self addHalo: event from: formerHaloOwner]].

	event shiftPressed ifTrue:[
		"Pass it outwards"
		owner ifNotNil:[^owner transferHalo: event from: formerHaloOwner].
		"We're at the top level; throw the event back in to find recipient"
		formerHaloOwner removeHalo.
		^self processEvent: event copy resetHandlerFields.
	].
	self submorphsDo:[:m|
		localEvt := event transformedBy: (m transformedFrom: self).
		(m fullContainsPoint: localEvt position) 
			ifTrue:[^m transferHalo: event from: formerHaloOwner].
	].
	"We're at the bottom most level; throw the event back up to the root to find recipient"
	formerHaloOwner removeHalo.

	
	(w := self world) ifNil: [ ^self ].
	localEvt := event transformedBy: (self transformedFrom: w) inverseTransformation.
	^ w processEvent: localEvt resetHandlerFields.
! !

!Morph methodsFor: 'printing' stamp: 'StephaneDucasse 8/2/2011 22:46'!
colorString: aColor

	aColor ifNil: [ ^'nil' ].
	^aColor name
		ifNil: [ aColor storeString ]
		ifNotNil: [ :colorName | 'Color ', colorName ]! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'ar 8/10/2003 18:31'!
privateDelete
	"Remove the receiver as a submorph of its owner"
	owner ifNotNil:[owner removeMorph: self].! !

!Morph methodsFor: 'halos and balloon help' stamp: 'ar 9/28/2000 17:54'!
hasHalo: aBool
	aBool
		ifTrue:[self setProperty: #hasHalo toValue: true]
		ifFalse:[self removeProperty: #hasHalo]! !

!Morph methodsFor: 'geometry' stamp: 'sw 10/9/1998 08:56'!
positionSubmorphs
	self submorphsDo:
		[:aMorph | aMorph snapToEdgeIfAppropriate]! !

!Morph methodsFor: 'layout-menu' stamp: 'ar 11/13/2000 19:10'!
changeListDirection: aSymbol
	| listDir wrapDir |
	self listDirection: aSymbol.
	(self wrapDirection == #none) ifTrue:[^self].
	"otherwise automatically keep a valid table layout"
	listDir := self listDirection.
	wrapDir := self wrapDirection.
	(listDir == #leftToRight or:[listDir == #rightToLeft]) ifTrue:[
		wrapDir == #leftToRight ifTrue:[^self wrapDirection: #topToBottom].
		wrapDir == #rightToLeft ifTrue:[^self wrapDirection: #bottomToTop].
	] ifFalse:[
		wrapDir == #topToBottom ifTrue:[^self wrapDirection: #leftToRight].
		wrapDir == #bottomToTop ifTrue:[^self wrapDirection: #rightToLeft].
	].
! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'ar 1/31/2001 12:54'!
addMorph: newMorph after: aMorph
	"Add the given morph as one of my submorphs, inserting it after anotherMorph"
	^self privateAddMorph: newMorph atIndex: (submorphs indexOf: aMorph)+1! !

!Morph methodsFor: 'rounding' stamp: 'ar 12/22/2001 22:45'!
wantsRoundedCorners
	"Return true if the receiver wants its corners rounded"
	^ self cornerStyle == #rounded! !

!Morph methodsFor: 'accessing - properties' stamp: 'md 2/27/2006 08:49'!
valueOfProperty: aSymbol ifPresentDo: aBlock 
	"If the receiver has a property of the given name, evaluate  
	aBlock on behalf of the value of that property"
	extension ifNil:  [^ self].
	^ aBlock value: (extension valueOfProperty: aSymbol ifAbsent: [^ self])! !

!Morph methodsFor: 'menu' stamp: 'AlainPlantec 12/10/2009 13:05'!
wantsYellowButtonMenu
	"Answer true if the receiver wants a yellow button menu"
	self
		valueOfProperty: #wantsYellowButtonMenu
		ifPresentDo: [:value | ^ value].
	self isInSystemWindow ifTrue: [^ false].
	^ self defaultYellowButtonMenuEnabled! !

!Morph methodsFor: 'layout' stamp: 'IgorStasenko 12/22/2012 03:11'!
privateFullBounds
	"Private. Compute the actual full bounds of the receiver"

	| box |
	submorphs isEmpty ifTrue: [^self outerBounds].
	box := self outerBounds copy.
	box := box quickMerge: (self clipSubmorphs 
						ifTrue: [self submorphBounds intersect: self clippingBounds ifNone: [ self clippingBounds ]]
						ifFalse: [self submorphBounds]).
	^box origin asIntegerPoint corner: box corner asIntegerPoint! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'panda 4/25/2000 15:46'!
toggleDragNDrop
	"Toggle this morph's ability to add and remove morphs via drag-n-drop."

		self enableDragNDrop: self dragNDropEnabled not.
! !

!Morph methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 7/27/2014 20:31'!
gtInspectorMorphExtensionIn: composite
	<gtInspectorPresentationOrder: 15>
	^ composite table
		title: 'Extension';
		showOnly: 50; 
		display: [ self extension gtInspectorVariableValuePairs asSortedCollection ];
		column: 'Variable' 
			evaluated: [:assoc | GTObjectPrinter new asNonTruncatedTextFrom: assoc key ];
		column: 'Value' 
			evaluated: [:assoc | GTObjectPrinter new asTruncatedTextFrom: assoc value ];
		send: #value;
		morphicSelectionAct: [:list | list selection value browse ] 
			icon: GLMUIThemeExtraIcons glamorousBrowse 
			on: $b 
			entitled: 'Browse';
		morphicSelectionAct: [:list | list selection value inspect ] 
			icon: GLMUIThemeExtraIcons glamorousInspect 
			on: $i 
			entitled: 'Inspect';
		selectionAct: [:list | 
			((list selection pointersToExcept: { list selection })
									reject: [ :each | each pointsOnlyWeaklyTo: list selection ]) inspect ] 
			on: $t
			entitled: 'Open pointers to'! !

!Morph methodsFor: 'accessing - extension' stamp: 'md 2/27/2006 08:46'!
privateExtension: aMorphExtension
	"private - change the receiver's extension"
	extension := aMorphExtension! !

!Morph methodsFor: 'accessing' stamp: 'AlainPlantec 10/17/2009 17:11'!
wantsToBeTopmost
	"Answer if the receiver want to be one of the topmost objects in its owner"
	^ false! !

!Morph methodsFor: 'halos and balloon help' stamp: 'AlainPlantec 12/19/2009 23:40'!
setBalloonText: stringOrText
	"Set receiver's balloon help text. Pass nil to remove the help."

	self setBalloonText: stringOrText maxLineLength: self theme settings maxBalloonHelpLineLength! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'AlainPlantec 2/17/2010 14:53'!
allMorphs
	"Return a collection containing all morphs in this composite morph (including the receiver)."

	| all |
	all := (Array new: submorphs size) writeStream.
	self allMorphsDo: [:m | all nextPut: m].
	^ all contents! !

!Morph methodsFor: 'accessing' stamp: 'md 2/27/2006 08:53'!
toggleStickiness
	"togle the receiver's Stickiness"
	extension ifNil: [^ self beSticky].
	extension sticky: extension sticky not! !

!Morph methodsFor: 'layout' stamp: 'ar 11/12/2000 17:35'!
layoutProportionallyIn: newBounds
	"Layout specific. Apply the given bounds to the receiver."
	| box frame |
	frame := self layoutFrame ifNil:[^self].
	"before applying the proportional values make sure the receiver's layout is computed"
	self fullBounds. "sigh..."
	"compute the cell size the receiver has given its layout frame"
	box := frame layout: self bounds in: newBounds.
	(box = self bounds) ifTrue:[^self]. "no change"
	^self layoutInBounds: box.! !

!Morph methodsFor: 'layout-menu' stamp: 'ar 11/13/2000 19:10'!
changeReverseCells
	self reverseTableCells: self reverseTableCells not.! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 20:05'!
listCentering: aSymbol
	"Layout specific. This property describes how the rows/columns in a list-like layout should be centered.
		#topLeft - center at start of primary direction
		#bottomRight - center at end of primary direction
		#center - center in the middle of primary direction
		#justified - insert extra space inbetween rows/columns
	"
	self assureTableProperties listCentering: aSymbol.
	self layoutChanged.! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 9/11/2006 09:37'!
modalLockTo: aSystemWindow
	"Lock the receiver as a modal owner of the given window."

	self lock! !

!Morph methodsFor: 'stepping and presenter' stamp: ''!
start
	"Start running my script. For ordinary morphs, this means start stepping."

	self startStepping.
! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'GuillermoPolito 5/1/2012 20:04'!
openInWindowLabeled: aString inWorld: aWorld
	"Changed to include the inset margin in the bound calculation."

	| window extent |
	window := (SystemWindow labelled: aString) model: nil.
	window 
		" guess at initial extent"
		bounds:  (RealEstateAgent initialFrameFor: window initialExtent: self fullBounds extent world: aWorld);
		addMorph: self frame: (0@0 extent: 1@1);
		updatePaneColors.
	" calculate extent after adding in case any size related attributes were changed.  Use
	fullBounds in order to trigger re-layout of layout morphs"
	extent := self fullBounds extent + 
			(window borderWidth@window labelHeight) + window borderWidth +
			(window class borderWidth * 2 @ (window class borderWidth + 1)). "include inset margin"
	window extent: extent.
	aWorld addMorph: window.
	window activate.
	aWorld startSteppingSubmorphsOf: window.
	
	window announceOpened.
	^window
! !

!Morph methodsFor: 'announcements' stamp: 'ThierryGoubier 1/8/2014 14:35'!
announceDeleted
	self doAnnounce: (MorphDeleted morph: self).
	self submorphs do: #announceDeleted! !

!Morph methodsFor: 'classification' stamp: 'ar 12/16/2001 18:28'!
isTextMorph
	^false! !

!Morph methodsFor: 'accessing' stamp: 'StephaneDucasse 5/31/2013 17:45'!
enabled: aBoolean
	"does nothing"

	! !

!Morph methodsFor: 'layout-menu' stamp: 'StephaneDucasse 4/23/2012 10:21'!
layoutMenuPropertyString: aSymbol from: currentSetting 
	| wording |
	wording := String
				streamContents: [:stream | 
					| index | 
					index := 1.
					aSymbol keysAndValuesDo: [:idx :ch | ch isUppercase
								ifTrue: [stream nextPutAll: (aSymbol copyFrom: index to: idx - 1) asLowercase.
										stream nextPutAll: ' '.
										index := idx]].
					index < aSymbol size
						ifTrue: [stream nextPutAll: (aSymbol copyFrom: index to: aSymbol size) asLowercase]].
	^ (aSymbol == currentSetting) -> wording translated! !

!Morph methodsFor: 'accessing' stamp: 'sw 11/15/2001 12:21'!
toggleResistsRemoval
	"Toggle the resistsRemoval property"

	self resistsRemoval
		ifTrue:
			[self removeProperty: #resistsRemoval]
		ifFalse:
			[self setProperty: #resistsRemoval toValue: true]! !

!Morph methodsFor: 'halos and balloon help' stamp: 'ar 10/3/2000 17:06'!
showBalloon: msgString
	"Pop up a balloon containing the given string,
	first removing any existing BalloonMorphs in the world."
	| w |
	self showBalloon: msgString hand: ((w := self world) ifNotNil:[w activeHand]).! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/14/2000 17:39'!
cellPositioning: aSymbol
	"Layout specific. This property describes how the receiver should be layed out in its owner when the bounds of the cell assigned to the receiver do not exactly match its bounds. Possible values are:
		#topLeft, #topRight, #bottomLeft, #bottomRight, #topCenter, #leftCenter, #rightCenter, #bottomCenter, #center 
	which align the receiver's bounds with the cell at the given point."
	self assureTableProperties cellPositioning: aSymbol.
	self layoutChanged.! !

!Morph methodsFor: 'stepping and presenter' stamp: ''!
stop
	"Stop running my script. For ordinary morphs, this means stop stepping."

	self stopStepping.
! !

!Morph methodsFor: 'copying' stamp: 'tk 2/19/2001 18:21'!
copy

	^ self veryDeepCopy! !

!Morph methodsFor: '*Keymapping-Core' stamp: 'SeanDeNigris 7/9/2012 23:40'!
hasKeymapCategoryNamed: aString

	^ self kmDispatcher targets anySatisfy: [ :e | e category name = aString ].! !

!Morph methodsFor: 'drop shadows' stamp: 'AlainPlantec 12/14/2009 11:09'!
shadowColor: aColor
	self shadowColor = aColor ifFalse: [self changed].
	self setProperty: #shadowColor toValue: aColor.! !

!Morph methodsFor: 'copying' stamp: 'MarcusDenker 9/13/2013 16:20'!
duplicate
	"Make and return a duplicate of the receiver"

	| newMorph topRend |
	((topRend := self topRendererOrSelf) ~~ self) ifTrue: [^ topRend duplicate].
	newMorph := self veryDeepCopy.
	newMorph arrangeToStartStepping.
		newMorph privateOwner: nil. "no longer in world"
	^newMorph! !

!Morph methodsFor: 'layout' stamp: 'MarcusDenker 10/3/2013 23:34'!
doLayoutIn: layoutBounds 
	"Compute a new layout based on the given layout bounds."

	"Note: Testing for #bounds or #layoutBounds would be sufficient to
	figure out if we need an invalidation afterwards but #outerBounds
	is what we need for all leaf nodes so we use that."

	| box priorBounds |
	priorBounds := self outerBounds.
	submorphs isEmpty ifTrue: [^fullBounds := priorBounds].
	"Send #ownerChanged to our children"
	submorphs do: [:m | m ownerChanged].
	self layoutPolicy ifNotNil: [:layout | layout layout: self in: layoutBounds].
	self adjustLayoutBounds.
	fullBounds := self privateFullBounds.
	box := self outerBounds.
	box = priorBounds 
		ifFalse: [self invalidRect: (priorBounds quickMerge: box)]! !

!Morph methodsFor: '*Morphic-Base' stamp: 'BenjaminVanRyseghem 6/21/2013 17:53'!
justDroppedInto: aMorph event: anEvent
	"This message is sent to a dropped morph after it has been dropped on -- and been accepted by -- a drop-sensitive morph"

	| aWindow |
	(self formerOwner notNil and: [self formerOwner ~~ aMorph])
		ifTrue: [self removeHalo].
	self formerOwner: nil.
	self formerPosition: nil.
	(aWindow := aMorph ownerThatIsA: SystemWindow) 
		ifNotNil: [aWindow isActive 
			ifFalse: [aWindow activate]].

	"An object launched by certain parts-launcher mechanisms should end up fully visible..."
	(self hasProperty: #beFullyVisibleAfterDrop) 
		ifTrue: [aMorph == ActiveWorld 
			ifTrue: [self goHome].
			self removeProperty: #beFullyVisibleAfterDrop].

! !

!Morph methodsFor: 'events-alarms' stamp: 'ar 9/11/2000 16:34'!
alarmScheduler
	"Return the scheduler being responsible for triggering alarms"
	^self world! !

!Morph methodsFor: 'menus' stamp: 'wiz 10/19/2006 00:35'!
adhereToEdge: edgeSymbol 
	| edgeMessage |
	(owner isNil or: [owner isHandMorph]) ifTrue: [^self].
	(owner class canUnderstand:  edgeSymbol) ifFalse:  [^self].
	(self class canUnderstand: ( edgeMessage := (edgeSymbol , ':') asSymbol ))
		 ifFalse:  [^self].
	
	self perform: edgeMessage
		withArguments: (Array with: (owner perform: edgeSymbol))! !

!Morph methodsFor: 'settings' stamp: 'AlainPlantec 12/19/2009 23:12'!
cmdGesturesEnabled
	^ self class cmdGesturesEnabled! !

!Morph methodsFor: 'event handling' stamp: 'GuillermoPolito 4/22/2012 17:19'!
handlesKeyDown: evt
	^self handlesKeyboard: evt! !

!Morph methodsFor: 'initialize' stamp: 'ar 1/31/2001 13:58'!
outOfWorld: aWorld
	"The receiver has just appeared in a new world. Notes:
		* aWorld can be nil (due to optimizations in other places)
		* owner is still valid
	Important: Keep this method fast - it is run whenever morphs are removed."
	aWorld ifNil:[^self].
	"ar 1/31/2001: We could explicitly stop stepping the receiver here but for the sake of speed I'm for now relying on the lazy machinery in the world itself."
	"aWorld stopStepping: self."
	self submorphsDo:[:m| m outOfWorld: aWorld].
! !

!Morph methodsFor: 'halos and balloon help' stamp: 'AlainPlantec 12/19/2009 23:40'!
wantsDirectionHandles
	^self valueOfProperty: #wantsDirectionHandles ifAbsent:[false]! !

!Morph methodsFor: 'geometry' stamp: 'StephaneDucasse 6/2/2014 21:29'!
outerBounds
	"Return the 'outer' bounds of the receiver, e.g., the bounds that need to be invalidated when the receiver changes."
	| box |
	box := self bounds.
	self hasDropShadow ifTrue:[box := self expandFullBoundsForDropShadow: box].
	^box! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'GaryChambers 11/15/2011 13:15'!
theme
	"Answer the current theme for the receiver."

	(self valueOfProperty: #theme) ifNotNil: [:t | ^ t].
	^(self owner ifNil: [self class]) theme! !

!Morph methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 4/1/2015 17:53'!
brickApi

	^ self valueOfProperty: #brickApi ifAbsentPut: [ GLMBrickMorphWrapper on: self ]! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 20:04'!
minCellSize: aPoint
	"Layout specific. This property specifies the minimal size of a table cell."
	self assureTableProperties minCellSize: aPoint.
	self layoutChanged.! !

!Morph methodsFor: 'initialization' stamp: 'EstebanLorenzano 10/15/2013 23:05'!
initialize
	"initialize the state of the receiver"
	super initialize.
	owner := nil.
	submorphs := EmptyArray.
	bounds := self defaultBounds.
	color := self defaultColor.! !

!Morph methodsFor: 'drawing' stamp: 'ar 11/8/2000 19:29'!
expandFullBoundsForRolloverBorder: aRectangle
	| delta |
	delta := self valueOfProperty: #rolloverWidth ifAbsent: [10@10].
	^aRectangle expandBy: delta.

! !

!Morph methodsFor: 'accessing' stamp: 'md 2/27/2006 09:53'!
isLocked
	"answer whether the receiver is Locked"
	extension ifNil: [^ false].
	^ extension locked! !

!Morph methodsFor: '*Morphic-Base' stamp: 'AlainPlantec 12/16/2009 12:27'!
embeddedInMorphicWindowLabeled: labelString
	| window |
	window := (SystemWindow labelled: labelString) model: nil.
	window setStripeColorsFrom:  (self theme windowColorFor: self).
	window addMorph: self frame: (0@0 extent: 1@1).
	^ window! !

!Morph methodsFor: '*Keymapping-Core' stamp: 'BenjaminVanRyseghem 2/20/2012 19:23'!
detachKeymapCategory: aCategoryName targetting: anObject

	self kmDispatcher detachKeymapCategory: aCategoryName targetting: anObject! !

!Morph methodsFor: 'submorphs-accessing' stamp: ''!
submorphsReverseDo: aBlock

	submorphs reverseDo: aBlock.! !

!Morph methodsFor: 'visual properties' stamp: 'ar 6/25/1999 11:11'!
useDefaultFill
	"Make receiver use a solid fill style (e.g., a simple color)"
	self fillStyle: self defaultColor.! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 9/21/2007 14:35'!
takeKeyboardFocus
	"Make the receiver the keyboard focus for the active hand."

	self activeHand newKeyboardFocus: self! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 10/21/2008 16:50'!
activate
	"Mark the receiver and submorphs as active (foreground)."

	self submorphsDo: [:m | m activate]! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 10/29/2000 02:47'!
listCenteringString: aSymbol
	^self layoutMenuPropertyString: aSymbol from: self listCentering! !

!Morph methodsFor: 'meta-actions' stamp: 'GuillermoPolito 5/29/2011 14:50'!
buildHandleMenu: aHand
	"Build the morph menu for the given morph's halo's menu handle. This menu has two sections. The first section contains commands that are interpreted by the hand; the second contains commands provided by the target morph. This method allows the morph to decide which items should be included in the hand's section of the menu."

	| menu |
	menu := UIManager default newMenuIn: self for: self.
	menu addStayUpItem.
	menu addLine.
	self addStandardHaloMenuItemsTo: menu hand: aHand.
	menu defaultTarget: aHand.
	self addAddHandMenuItemsForHalo: menu  hand: aHand.
	menu defaultTarget: self.
	self addCustomHaloMenuItems: menu hand: aHand.
	menu defaultTarget: aHand.
	^ menu
! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'PeterHugossonMiller 9/3/2009 10:06'!
morphsInFrontOverlapping: aRectangle
	"Return all top-level morphs in front of someMorph that overlap with the given rectangle."
	| morphList |
	morphList := Array new writeStream.
	self morphsInFrontOf: nil overlapping: aRectangle do:[:m | morphList nextPut: m].
	^morphList contents! !

!Morph methodsFor: '*Athens-Examples' stamp: 'IgorStasenko 5/6/2013 18:08'!
openInSceneView
	^ AthensSceneView new
		scene: (AthensMorphScene new morph:self);
		openInWindow! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'ar 8/12/2003 23:35'!
slideBackToFormerSituation: evt 
	| slideForm formerOwner formerPosition aWorld startPoint endPoint trans |
	formerOwner := self formerOwner.
	formerPosition := self formerPosition.
	aWorld := evt hand world.
	trans := formerOwner transformFromWorld.
	slideForm := trans isPureTranslation 
				ifTrue: [self imageForm offset: 0 @ 0]
				ifFalse: 
					[((TransformationMorph new asFlexOf: self) transform: trans) imageForm 
						offset: 0 @ 0]. 
	startPoint := evt hand fullBounds origin.
	endPoint := trans localPointToGlobal: formerPosition.
	owner removeMorph: self.
	aWorld displayWorld.
	slideForm 
		slideFrom: startPoint
		to: endPoint
		nSteps: 12
		delay: 15.
	formerOwner addMorph: self.
	self position: formerPosition.
	self justDroppedInto: formerOwner event: evt! !

!Morph methodsFor: '*Morphic-Widgets-Taskbar' stamp: 'gvc 10/9/2007 10:36'!
isTaskbar
	"Answer false in the general case."

	^false! !

!Morph methodsFor: '*Morphic-Base' stamp: 'AlainPlantec 9/30/2011 15:59'!
rowMorphForNode: aNode inColumn: aColumn
	| rm |
	rm := Morph new color: Color transparent;
			layoutPolicy: RowLayout new;
			hResizing: #shrinkWrap;
			vResizing: #shrinkWrap;
			layoutInset: aColumn container columnInset @ aColumn container rowInset;
			listDirection: #leftToRight;
			cellPositioning: #leftCenter;
			cellInset: 4@0;
			yourself.
			
	rm addMorph: self.
	
	aColumn isFirstColumn 
		ifTrue: [ | icon |
			icon := aColumn container iconBlock value: aNode.
			icon ifNotNil: [ rm addMorph: icon asMorph ].
			"for first column we don't use horizontal inset"
			rm  layoutInset: 0 @ aColumn container rowInset.
		].

	^ rm
! !

!Morph methodsFor: 'accessing' stamp: 'dgd 3/7/2003 15:24'!
raisedColor
	"Return the color to be used for shading raised borders. The 
	default is my own color, but it might want to be, eg, my 
	owner's color. Whoever's color ends up prevailing, the color 
	itself gets the last chance to determine, so that when, for 
	example, an InfiniteForm serves as the color, callers won't choke 
	on some non-Color object being returned"
	(color isColor
			and: [color isTransparent
					and: [owner notNil]])
		ifTrue: [^ owner raisedColor].
	^ color asColor raisedColor! !

!Morph methodsFor: 'Morphic-Base-Worlds' stamp: 'sw 7/1/1998 18:02'!
pasteUpMorph
	"Answer the closest containing morph that is a PasteUp morph"
	^ self ownerThatIsA: PasteUpMorph! !

!Morph methodsFor: 'accessing - properties' stamp: 'dgd 2/16/2003 20:55'!
valueOfProperty: aSymbol ifAbsentPut: aBlock 
	"If the receiver possesses a property of the given name, answer  
	its value. If not, then create a property of the given name, give 
	it the value obtained by evaluating aBlock, then answer that  
	value"
	^ self assureExtension valueOfProperty: aSymbol ifAbsentPut: aBlock! !

!Morph methodsFor: 'events-accessing' stamp: 'gvc 9/11/2009 17:43'!
updateableActionMap
	"Answer an updateable action map, saving it in my #actionMap property"
	
	| actionMap |
	self assureExtension.
	actionMap := extension actionMap.
	actionMap ifNil:
		[actionMap := self createActionMap.
		extension actionMap: actionMap].
	^actionMap! !

!Morph methodsFor: '*Morphic-Widgets-Taskbar' stamp: 'gvc 4/17/2007 17:44'!
taskbarButtonFor: aTaskBar
	"Answer a new task bar button for the receiver.
	Answer nil if not required."

	^nil! !

!Morph methodsFor: 'text-anchor' stamp: 'ar 12/16/2001 18:37'!
textAnchorType: aSymbol
	aSymbol == #document
		ifTrue:[^self removeProperty: #textAnchorType]
		ifFalse:[^self setProperty: #textAnchorType toValue: aSymbol].! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'pmm 3/13/2010 11:32'!
copyWithoutSubmorph: sub
	"Needed to get a morph to draw without one of its submorphs.
	NOTE:  This must be thrown away immediately after use."
	^ self shallowCopy privateSubmorphs: (submorphs copyWithout: sub)! !

!Morph methodsFor: '*Morphic-Base' stamp: 'StephaneDucasse 6/28/2013 11:26'!
resizeMorph: evt
	| handle |
	handle := HandleMorph new forEachPointDo: [ :newPoint | self extent: newPoint - self bounds topLeft ].
	evt hand attachMorph: handle.
	handle startStepping! !

!Morph methodsFor: 'halos and balloon help' stamp: 'sw 1/11/2000 18:24'!
defersHaloOnClickTo: aSubMorph
	"If a cmd-click on aSubMorph would make it a preferred recipient of the halo, answer true"
	"May want to add a way (via a property) for morphs to assert true here -- this would let certain kinds of morphs that are unusually reluctant to take the halo on initial click"

	^ false
	! !

!Morph methodsFor: 'event handling' stamp: 'SeanDeNigris 1/31/2014 18:32'!
mouseUp: evt
	"Handle a mouse up event. The default response is to let my eventHandler, if any, handle it."

	^ self eventHandler ifNotNil:
		[self eventHandler mouseUp: evt fromMorph: self].
! !

!Morph methodsFor: 'events-alarms' stamp: 'ar 9/11/2000 16:35'!
addAlarm: aSelector with: arg1 after: delayTime
	"Add an alarm (that is an action to be executed once) with the given set of parameters"
	^self addAlarm: aSelector withArguments: (Array with: arg1) after: delayTime! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'ar 8/12/2003 23:29'!
addAllMorphs: aCollection after: anotherMorph
	^self privateAddAllMorphs: aCollection 
			atIndex: (submorphs indexOf: anotherMorph ifAbsent: [submorphs size])! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'BenjaminVanRyseghem 3/19/2011 22:09'!
findSubmorphBinary: aBlock
	"Use binary search for finding a specific submorph of the receiver. Caller must be certain that the ordering holds for the submorphs."
	^submorphs findBinary: aBlock do: [ :found | found ] ifNone: [:a :b | ]! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/15/2000 14:16'!
spaceFillWeight: aNumber
	"Layout specific. This property describes the relative weight that should be given to the receiver when extra space is distributed between different #spaceFill cells."
	aNumber = 1
		ifTrue:[self removeProperty: #spaceFillWeight]
		ifFalse:[self setProperty: #spaceFillWeight toValue: aNumber].
	self layoutChanged.! !

!Morph methodsFor: 'accessing' stamp: 'md 2/27/2006 09:58'!
lock: aBoolean 
	"change the receiver's lock property"
	(extension isNil and: [aBoolean not]) ifTrue: [^ self].
	self assureExtension locked: aBoolean! !

!Morph methodsFor: 'accessing' stamp: 'StephaneDucasse 10/13/2013 21:50'!
wantsToBeCachedByHand
	"Return true if the receiver wants to be cached by the hand when it is dragged around.
	Note: The default implementation queries all submorphs since subclasses may have shapes that do not fill the receiver's bounds completely."

	self isTranslucentButNotTransparent ifTrue: [ ^ false ].
	self
		submorphsDo: [ :m | 
			m wantsToBeCachedByHand
				ifFalse: [ ^ false ] ].
	^ true! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'panda 4/28/2000 12:02'!
resetHighlightForDrop
	self highlightForDrop: false! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/11/2007 11:32'!
nextMorphAcrossInWindow
	"Answer the next morph in the window. Traverse
	from the receiver to its next sibling or owner's next sibling etc."

	^self submorphAfter ifNil: [
		(self owner ifNil: [^self]) nextMorphAcrossInWindow]! !

!Morph methodsFor: 'layout' stamp: 'ar 11/12/2000 17:33'!
acceptDroppingMorph: aMorph event: evt
	"This message is sent when a morph is dropped onto a morph that has agreed to accept the dropped morph by responding 'true' to the wantsDroppedMorph:Event: message. This default implementation just adds the given morph to the receiver."
	| layout |
	layout := self layoutPolicy.
	layout ifNil:[^self addMorph: aMorph].
	self privateAddMorph: aMorph 
		atIndex: (layout indexForInserting: aMorph at: evt position in: self).! !

!Morph methodsFor: 'halos and balloon help' stamp: 'ar 11/7/1999 18:57'!
addHalo
	"Invoke a halo programatically (e.g., not from a meta gesture)"
	^self addHalo: nil! !

!Morph methodsFor: 'drawing' stamp: 'gvc 9/11/2009 17:59'!
clipSubmorphs
	"Drawing specific. If this property is set, clip the receiver's  
	submorphs to the receiver's clipping bounds."
	
	extension ifNil: [^false].
	^extension clipSubmorphs ifNil: [false]! !

!Morph methodsFor: 'structure' stamp: 'ar 10/3/2000 15:36'!
hasOwner: aMorph
	"Return true if the receiver has aMorph in its owner chain"
	aMorph ifNil:[^true].
	self allOwnersDo:[:m| m = aMorph ifTrue:[^true]].
	^false! !

!Morph methodsFor: 'geometry' stamp: 'di 6/12/97 11:17'!
bottomRight

	^ bounds bottomRight! !

!Morph methodsFor: 'layout-properties' stamp: 'MarcusDenker 10/3/2013 23:32'!
layoutInset
	"Return the extra inset for layouts"

	^ self layoutProperties ifNil: [ 0 ] ifNotNil: [ :props | props layoutInset ]! !

!Morph methodsFor: 'menus' stamp: 'ar 9/22/2000 20:14'!
setRotationCenterFrom: aPoint
	self rotationCenter: (aPoint - self bounds origin) / self bounds extent asFloatPoint.! !

!Morph methodsFor: 'menu' stamp: 'MarcusDenker 9/7/2010 17:41'!
addTitleForHaloMenu: aMenu 
	aMenu
		addTitle: self externalName
		icon: (self iconOrThumbnailOfSize: 28)! !

!Morph methodsFor: 'events-alarms' stamp: 'ar 9/14/2000 12:14'!
removeAlarm: aSelector
	"Remove the given alarm"
	| scheduler |
	scheduler := self alarmScheduler.
	scheduler ifNotNil:[scheduler removeAlarm: aSelector for: self].! !

!Morph methodsFor: 'drawing' stamp: 'di 9/9/1998 22:25'!
imageFormForRectangle: rect

	^ self imageForm: Display depth forRectangle: rect
! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'ar 8/12/2003 23:28'!
addAllMorphs: aCollection
	^self privateAddAllMorphs: aCollection atIndex: submorphs size! !

!Morph methodsFor: 'halos and balloon help' stamp: 'sw 11/29/2001 06:29'!
okayToResizeEasily
	"Answer whether it is appropriate to have the receiver be easily resized by the user from the halo"

	^ true

	"This one was too jarring, not that it didn't most of the time do the right  thing but because some of the time it didn't, such as in a holder.  If we pursue this path, the test needs to be airtight, obviously...
	^ (self topRendererOrSelf owner isKindOf: PasteUpMorph) and:
		[self layoutPolicy isNil]"! !

!Morph methodsFor: 'structure' stamp: 'dgd 9/1/2004 17:17'!
isInDockingBar
	"answer if the receiver is in a menu bar"
	^ (owner notNil) and: [owner isDockingBar]! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'rhi 9/10/2000 12:12'!
findA: aClass
	"Return the first submorph of the receiver that is descended from the given class. Return nil if there is no such submorph. Clients of this code should always check for a nil return value so that the code will be robust if the user takes the morph apart."

	^self submorphs
		detect: [:p | p isKindOf: aClass]
		ifNone: [nil]! !

!Morph methodsFor: 'menus' stamp: 'MarcusDenker 9/28/2013 15:50'!
inspectInMorphic: evt
	Smalltalk tools inspector inspect: self! !

!Morph methodsFor: '*Morphic-Base' stamp: 'ar 11/13/2000 19:08'!
changeCellInset: evt
	| handle |
	handle := HandleMorph new forEachPointDo:[:newPoint |
		self cellInset: (newPoint - evt cursorPoint) asIntegerPoint // 5].
	evt hand attachMorph: handle.
	handle startStepping.
! !

!Morph methodsFor: '*Morphic-Base' stamp: 'DamienCassou 9/29/2009 13:01'!
exportAsPNG
	| fName |
	fName := UIManager default request:'Please enter the name' translated initialAnswer: self externalName,'.png'.
	fName isEmptyOrNil ifTrue:[^self].
	PNGReadWriter putForm: self imageForm onFileNamed: fName.! !

!Morph methodsFor: 'event handling' stamp: 'fbs 1/7/2005 15:43'!
preferredKeyboardBounds

	^ self bounds: self bounds in: World.
! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/13/2007 15:25'!
preferredCornerStyle
	"Answer the preferred corner style."

	^#square! !

!Morph methodsFor: 'geometry' stamp: 'efc 2/13/2003 18:15'!
right: aNumber
	" Move me so that my right side is at the x-coordinate aNumber. My extent (width & height) are unchanged "

	self position: ((aNumber - bounds width) @ bounds top)! !

!Morph methodsFor: '*Keymapping-Core' stamp: 'GuillermoPolito 8/6/2013 16:23'!
allowsKeymapping

	^ self valueOfProperty: #allowsKeymapping ifAbsent: [ true]! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'ar 1/31/2001 12:54'!
addMorphFront: aMorph
	^self privateAddMorph: aMorph atIndex: 1! !

!Morph methodsFor: '*Morphic-Widgets-Taskbar' stamp: 'gvc 10/9/2007 10:36'!
taskbars
	"Answer the receiver's taskbars."
	
	^self submorphs select: [:each |
		each isTaskbar]! !

!Morph methodsFor: 'geometry' stamp: ''!
height

	^ bounds height! !

!Morph methodsFor: '*Morphic-Base' stamp: 'SeanDeNigris 1/29/2013 13:10'!
addHandlesTo: aHaloMorph box: box
	"Add halo handles to the halo.  Apply the halo filter if appropriate"

	
	aHaloMorph haloBox: box.
	HaloMorph  currentHaloSpecifications do:
		[:aSpec | | wantsIt aSelector | 
			aSelector := aSpec addHandleSelector.
			(wantsIt := self wantsHaloHandleWithSelector: aSelector inHalo: aHaloMorph)
				ifTrue: [(#(addDupHandle:) includes: aSelector) 
					ifTrue: [wantsIt := self preferredDuplicationHandleSelector = aSelector]].
			wantsIt 
				ifTrue: [aHaloMorph perform: aSelector with: aSpec]].
	aHaloMorph innerTarget addOptionalHandlesTo: aHaloMorph box: box! !

!Morph methodsFor: 'layout' stamp: 'ar 10/31/2000 21:09'!
layoutBounds: aRectangle
	"Set the bounds for laying out children of the receiver.
	Note: written so that #layoutBounds can be changed without touching this method"
	| outer inner |
	outer := self bounds.
	inner := self layoutBounds.
	bounds := aRectangle origin + (outer origin - inner origin) corner:
				aRectangle corner + (outer corner - inner corner).! !

!Morph methodsFor: 'geometry' stamp: 'di 3/6/2002 13:06'!
leftCenter

	^ bounds leftCenter! !

!Morph methodsFor: 'structure' stamp: 'di 11/13/2000 00:59'!
withAllOwners
	"Return the receiver and all its owners"

	^ Array streamContents: [:strm | self withAllOwnersDo: [:m | strm nextPut: m]]! !

!Morph methodsFor: 'settings' stamp: 'AlainPlantec 12/19/2009 23:23'!
menuKeyboardControl
	^ self theme settings menuKeyboardControl! !

!Morph methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 4/8/2015 09:46'!
spotterPreviewMorphIn: aComposite
	<spotterPreview: 0>
	aComposite custom: 
		(self imageForm asAlphaImageMorph asBrick margin: 20)! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 10/29/2000 02:47'!
listDirectionString: aSymbol
	^self layoutMenuPropertyString: aSymbol from: self listDirection! !

!Morph methodsFor: 'private' stamp: 'di 10/18/2004 21:49'!
privateRemove: aMorph
	"Private!! Should only be used by methods that maintain the ower/submorph invariant."

	submorphs := submorphs copyWithout: aMorph.
	self layoutChanged.! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'dgd 2/22/2003 14:27'!
allMorphsDo: aBlock 
	"Evaluate the given block for all morphs in this composite morph (including the receiver)."

	submorphs do: [:m | m allMorphsDo: aBlock].
	aBlock value: self! !

!Morph methodsFor: 'stepping and presenter' stamp: 'stephane.ducasse 11/27/2008 22:31'!
stepAt: millisecondClockValue
	"Do some periodic activity. Use startStepping/stopStepping to start and stop getting sent this message. The time between steps is specified by this morph's answer to the stepTime message.
	The millisecondClockValue parameter gives the value of the millisecond clock at the moment of dispatch.
	Default is to dispatch to the parameterless step method for the morph, but this protocol makes it possible for some morphs to do differing things depending on the clock value"

	self step
! !

!Morph methodsFor: 'layout-properties' stamp: 'StephaneDucasse 12/21/2012 18:15'!
layoutFrame: aLayoutFrame
	"Layout specific. Return the layout frame describing where the receiver should appear in a proportional layout"
	self layoutFrame == aLayoutFrame ifTrue: [^self].
	self assureExtension layoutFrame: aLayoutFrame asLayoutFrame.
	self layoutChanged.! !

!Morph methodsFor: '*Morphic-Base' stamp: 'dgd 1/7/2005 19:31'!
fillWithRamp: rampSpecsOrColor oriented: aRatio 
	rampSpecsOrColor isColor
		ifTrue: [self color: rampSpecsOrColor".
			self borderColor: rampSpecsOrColor muchDarker"]
		ifFalse: [| fill | 
			fill := GradientFillStyle ramp: rampSpecsOrColor.
			fill origin: self bounds topLeft.
			fill direction: (self bounds extent * aRatio) truncated.
			fill radial: false.
			self fillStyle: fill.
			self borderColor: (rampSpecsOrColor first value mixed: 0.5 with: rampSpecsOrColor last value) muchDarker]! !

!Morph methodsFor: 'text-anchor' stamp: 'ar 12/16/2001 19:47'!
relativeTextAnchorPosition
	^self valueOfProperty: #relativeTextAnchorPosition! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 20:02'!
vResizing
	"Layout specific. This property describes how the receiver should be resized with respect to its owner and its children. Possible values are:
		#rigid			-	do not resize the receiver
		#spaceFill		-	resize to fill owner's available space
		#shrinkWrap	- resize to fit children
	"
	| props |
	props := self layoutProperties.
	^props ifNil:[#rigid] ifNotNil:[props vResizing].! !

!Morph methodsFor: 'meta-actions' stamp: 'ar 9/15/2000 20:25'!
blueButtonUp: anEvent
	"Ignored. Theoretically we should never get here since control is transferred to the halo on #blueButtonDown: but subclasses may implement this differently."! !

!Morph methodsFor: 'geometry' stamp: ''!
position

	^ bounds topLeft! !

!Morph methodsFor: 'layout-properties' stamp: 'md 2/27/2006 10:00'!
layoutPolicy
	"Layout specific. Return the layout policy describing how children 
	of the receiver should appear."
	^ extension ifNotNil: [ extension layoutPolicy]! !

!Morph methodsFor: 'stepping and presenter' stamp: 'sw 3/22/2000 14:27'!
arrangeToStartStepping
	"Arrange to start getting sent the 'step' message, but don't do that initial #step call that startStepping does"

	self arrangeToStartSteppingIn: self world! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'NicolaiHess 12/20/2014 21:03'!
openModal: aSystemWindow
	"Open the given window locking the receiver until it is dismissed.
	Answer the system window.
	Restore the original mouse and keyboard focus when closed."

	|area mySysWin keyboardFocus mouseFocus|
	mouseFocus := self activeHand mouseFocus.
	keyboardFocus := self activeHand keyboardFocus.
	mySysWin := self isSystemWindow ifTrue: [self] ifFalse: [self ownerThatIsA: SystemWindow].
	mySysWin ifNil: [mySysWin := self].
	mySysWin modalLockTo: aSystemWindow.
	area := RealEstateAgent maximumUsableArea.
	aSystemWindow extent: aSystemWindow initialExtent.
	aSystemWindow position = (0@0)
		ifTrue: [aSystemWindow
				position: self activeHand position - (aSystemWindow extent // 2)].
	aSystemWindow
		bounds: (aSystemWindow bounds translatedToBeWithin: area).
	[ |aWidget | 
	aWidget := aSystemWindow openAsIs.
	self activeHand mouseFocus:aWidget.
	[aWidget world notNil] whileTrue: [
		aWidget outermostWorldMorph doOneCycle]]
		ensure: [mySysWin modalUnlockFrom: aSystemWindow.
				self activeHand newKeyboardFocus: keyboardFocus.
				self activeHand mouseFocus: mouseFocus].
	^aSystemWindow! !

!Morph methodsFor: 'event handling' stamp: 'tk 8/10/1998 16:02'!
removeLink: actionCode
	self eventHandler ifNotNil:
		[self eventHandler on: actionCode send: nil to: nil]! !

!Morph methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 1/11/2015 15:18'!
asBrick
	
	^ GLMMorphBrick on: self! !

!Morph methodsFor: 'updating' stamp: 'MarcusDenker 3/2/2015 17:48'!
breakDependents
	
	self removeProperty: #announcer! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'dgd 2/22/2003 14:32'!
lastSubmorph
	^submorphs last! !

!Morph methodsFor: 'change reporting' stamp: 'sw 7/8/1998 13:21'!
ownerChanged
	"The receiver's owner, some kind of a pasteup, has changed its layout."

	self snapToEdgeIfAppropriate! !

!Morph methodsFor: 'geometry' stamp: 'efc 2/13/2003 18:22'!
height: aNumber
	" Set my height; my position (top-left corner) and width will remain the same "

	self extent: self width@aNumber asInteger.
! !

!Morph methodsFor: 'macpal' stamp: 'GaryChambers 12/21/2011 11:10'!
flash
	| fs w |
	fs := self fillStyle.
	self fillStyle: Color black.
	(w := self world) ifNotNil: [w displayWorldSafely].
	self fillStyle: fs! !

!Morph methodsFor: 'event handling' stamp: 'fbs 1/7/2005 15:42'!
preferredKeyboardPosition

	^ (self bounds: self bounds in: World) topLeft.
! !

!Morph methodsFor: 'user interface' stamp: 'tak 3/15/2005 17:10'!
doCancel
	self delete! !

!Morph methodsFor: 'geometry' stamp: 'efc 2/13/2003 18:14'!
top: aNumber
	" Move me so that my top is at the y-coordinate aNumber. My extent (width & height) are unchanged "

	self position: (bounds left @ aNumber)! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 10/29/2000 02:47'!
listSpacingString: aSymbol
	^self layoutMenuPropertyString: aSymbol from: self listSpacing! !

!Morph methodsFor: 'events-processing' stamp: 'SeanDeNigris 1/31/2014 18:38'!
handleMouseUp: anEvent
	"System level event handling."
	anEvent wasHandled ifTrue: [^self]. "not interested"
	anEvent hand mouseFocus == self ifFalse: [^self]. "Not interested in other parties"
	anEvent hand releaseMouseFocus: self.
	anEvent wasHandled: true.
	^ anEvent blueButtonChanged
		ifTrue: [
			self blueButtonUp: anEvent.
			self eventHandler ifNotNil: [:handler | handler mouseUp: anEvent fromMorph: self]]
		ifFalse: [ | result |
			result := self mouseUp: anEvent.
			self stopSteppingSelector: #handleMouseStillDown:.
			result ].! !

!Morph methodsFor: 'structure' stamp: 'sw 8/29/2000 14:55'!
morphPreceding: aSubmorph
	"Answer the morph immediately preceding aSubmorph, or nil if none"

	| anIndex |
	anIndex := submorphs indexOf: aSubmorph ifAbsent: [^ nil].
	^ anIndex > 1
		ifTrue:
			[submorphs at: (anIndex - 1)]
		ifFalse:
			[nil]! !

!Morph methodsFor: 'debug and other' stamp: 'StephaneDucasse 10/27/2014 17:57'!
addDebuggingItemsTo: aMenu hand: aHandMorph
	aMenu add: 'debug...' subMenu:  (self buildDebugMenu: aHandMorph).
	aMenu lastItem icon: Smalltalk ui icons smallDebugIcon! !

!Morph methodsFor: 'private' stamp: 'tk 8/30/1998 09:58'!
privateFullBounds: boundsRect
	"Private!! Computed automatically."

	fullBounds := boundsRect.! !

!Morph methodsFor: 'converting' stamp: ''!
asDraggableMorph
	^self! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 20:04'!
listSpacing: aSymbol
	"Layout specific. This property describes how the heights for different rows in a table layout should be handled.
		#equal - all rows have the same height
		#none - all rows may have different heights
	"
	self assureTableProperties listSpacing: aSymbol.
	self layoutChanged.! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 10/29/2000 03:00'!
wrapCenteringString: aSymbol
	^self layoutMenuPropertyString: aSymbol from: self wrapCentering! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'alain.plantec 6/8/2009 23:44'!
allNonSubmorphMorphs
	"Return a collection containing all morphs in this morph which are not currently in the submorph containment hierarchy"

	^ OrderedCollection new! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'sw 8/15/97 22:03'!
submorphsSatisfying: aBlock
	^ submorphs select: [:m | (aBlock value: m) == true]! !

!Morph methodsFor: 'halos and balloon help' stamp: 'sw 1/25/2000 17:43'!
wantsHaloFromClick
	^ true! !

!Morph methodsFor: 'menu' stamp: 'GuillermoPolito 5/29/2011 14:49'!
addNestedYellowButtonItemsTo: aMenu event: evt 
	"Add items to aMenu starting with me and proceeding down 
	through my submorph chain, 
	letting any submorphs that include the event position 
	contribute their items to the bottom of the menu, separated by 
	a line."
	| underMouse |

	self addYellowButtonMenuItemsTo: aMenu event: evt.

	underMouse := self
				submorphThat: [:each | each containsPoint: evt position]
				ifNone: [^ self].

	(underMouse addMyYellowButtonMenuItemsToSubmorphMenus
			and: [underMouse hasYellowButtonMenu])
		ifTrue: [| submenu |
			aMenu addLine.
			submenu := UIManager default newMenuIn: underMouse for: underMouse.
			underMouse addNestedYellowButtonItemsTo: submenu event: evt.
			aMenu
				add: underMouse externalName
				icon: (underMouse iconOrThumbnailOfSize: 16)
				subMenu: submenu
		]
! !

!Morph methodsFor: 'menus' stamp: 'StephaneDucasse 10/27/2014 09:34'!
addHaloActionsTo: aMenu
	"Add items to aMenu representing actions requestable via halo"

	| subMenu |
	subMenu := UIManager default newMenuIn: self for: self.
	subMenu addTitle: self externalName.
	subMenu addStayUpItem.
	subMenu addLine.
	subMenu add: 'delete' selector: #dismissViaHalo.
	subMenu balloonTextForLastItem: 'Delete this object -- warning -- can be destructive!!' translated.

	self maybeAddCollapseItemTo: subMenu.
	subMenu add: 'grab' selector: #openInHand.
	subMenu balloonTextForLastItem: 'Pick this object up -- warning, since this removes it from its container, it can have adverse effects.' translated.

	subMenu addLine.

	subMenu add: 'resize'  selector: #resizeFromMenu.
	subMenu balloonTextForLastItem: 'Change the size of this object' translated.

	subMenu add: 'duplicate'  selector: #maybeDuplicateMorph.
	subMenu balloonTextForLastItem: 'Hand me a copy of this object'.

	subMenu addLine.

	subMenu add: 'set color'  target: self renderedMorph selector: #changeColor.
	subMenu balloonTextForLastItem: 'Change the color of this object'.

	subMenu addLine.

	subMenu add: 'inspect' target: self selector: #inspect.
	subMenu balloonTextForLastItem: 'Open an Inspector on this object'.

	aMenu add: 'halo actions...' subMenu: subMenu
! !

!Morph methodsFor: 'initialize' stamp: 'cb 6/25/2013 13:24'!
openInWindow

	^self openInWindowLabeled: self defaultLabel
! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'sw 1/11/1999 20:07'!
repelsMorph: aMorph event: ev
	^ false! !

!Morph methodsFor: 'menus' stamp: 'StephaneDucasse 10/27/2014 09:34'!
addStandardHaloMenuItemsTo: aMenu hand: aHandMorph
	"Add standard halo items to the menu"

	self isWorldMorph ifTrue:
		[^ self addWorldHaloMenuItemsTo: aMenu hand: aHandMorph].

	aMenu add: 'send to back' selector: #goBehind.
	aMenu add: 'bring to front' selector: #comeToFront.
	self addEmbeddingMenuItemsTo: aMenu hand: aHandMorph.
	aMenu addLine.

	self addFillStyleMenuItems: aMenu hand: aHandMorph.
	self addBorderStyleMenuItems: aMenu hand: aHandMorph.
	self addDropShadowMenuItems: aMenu hand: aHandMorph.
	self addLayoutMenuItems: aMenu hand: aHandMorph.
	self addHaloActionsTo: aMenu.
	owner isTextMorph ifTrue:[self addTextAnchorMenuItems: aMenu hand: aHandMorph].
	aMenu addLine.
	self addToggleItemsToHaloMenu: aMenu.
	aMenu addLine.
	self addExportMenuItems: aMenu hand: aHandMorph.
	self addMiscExtrasTo: aMenu.
	self addDebuggingItemsTo: aMenu hand: aHandMorph.
	aMenu addLine.
	aMenu defaultTarget: aHandMorph.
! !

!Morph methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 1/20/2015 22:58'!
brickDoubleLink: aDoubleLink

	self setProperty: #brickDoubleLink toValue: aDoubleLink! !

!Morph methodsFor: 'halos and balloon help' stamp: 'ar 9/15/2000 16:13'!
haloClass
	"Answer the name of the desired kind of HaloMorph to launch on behalf of the receiver"

	^ #HaloMorph
! !

!Morph methodsFor: 'classification' stamp: 'jm 5/7/1998 13:45'!
isRenderer
	"A *renderer* morph transforms the appearance of its submorph in some manner. For example, it might supply a drop shadow or scale and rotate the morph it encases. Answer true if this morph acts as a renderer. This default implementation returns false."
	"Details: A renderer is assumed to have a single submorph. Renderers may be nested to concatenate their transformations. It is useful to be able to find the outer-most renderer. This can be done by ascending the owner chain from the rendered morph. To find the morph being rendered, one can descend through the (singleton) submorph lists of the renderer chain until a non-renderer is encountered."

	^ false
! !

!Morph methodsFor: 'meta-actions' stamp: 'PavelKrivanek 7/13/2014 13:43'!
invokeMetaMenu: evt
	| menu |
	
	UserManager default canShowMorphHalo
		ifFalse: [ ^ self ].
	menu := self buildMetaMenu: evt.
	menu addTitle: self externalName.
	self world ifNotNil: [
		menu popUpEvent: evt in: self world
	]! !

!Morph methodsFor: 'geometry' stamp: 'ar 10/25/2000 15:04'!
bounds: aRectangle from: referenceMorph
	"Return the receiver's bounds as seen by aMorphs coordinate frame"
	owner ifNil: [^ aRectangle].
	^(owner transformFrom: referenceMorph) globalBoundsToLocal: aRectangle
! !

!Morph methodsFor: 'layout-menu' stamp: 'StephaneDucasse 4/22/2012 16:53'!
hasTableLayoutString
	| layout |
	^ ((layout := self layoutPolicy) notNil
			and: [layout isTableLayout]) ->   'table layout' translated! !

!Morph methodsFor: 'geometry' stamp: 'tk 7/14/2001 11:11'!
setConstrainedPosition: aPoint hangOut: partiallyOutside
	"Change the position of this morph and and all of its submorphs to aPoint, but don't let me go outside my owner's bounds.  Let me go within two pixels of completely outside if partiallyOutside is true."

	| trialRect delta boundingMorph bRect |
	owner ifNil:[^self].
	trialRect := aPoint extent: self bounds extent.
	boundingMorph := self topRendererOrSelf owner.
	delta := boundingMorph
			ifNil:    [0@0]
			ifNotNil: [
				bRect := partiallyOutside 
					ifTrue: [boundingMorph bounds insetBy: 
								self extent negated + boundingMorph borderWidth + (2@2)]
					ifFalse: [boundingMorph bounds].
				trialRect amountToTranslateWithin: bRect].
	self position: aPoint + delta.
	self layoutChanged  "So that, eg, surrounding text will readjust"
! !

!Morph methodsFor: 'halos and balloon help' stamp: 'AlainPlantec 12/19/2009 23:17'!
wantsBalloon
	"Answer true if receiver wants to show a balloon help text is a few moments."

	^ (self balloonText notNil) and: [self balloonHelpEnabled]! !

!Morph methodsFor: 'meta-actions' stamp: 'wiz 11/9/2006 23:04'!
potentialTargetsAt: aPoint 
	"Return the potential targets for the receiver.  
	This is derived from Morph>>potentialEmbeddingTargets."
	| realOwner |
	realOwner := self topRendererOrSelf
	owner
		ifNil: [^ #()].
	^ realOwner
		morphsAt: aPoint
		! !

!Morph methodsFor: 'recategorized' stamp: 'di 9/14/1998 07:31'!
handlesMouseOver: evt
	"Do I want to receive mouseEnter: and mouseLeave: when the button is up and the hand is empty?  The default response is false, except if you have added sensitivity to mouseEnter: or mouseLeave:, using the on:send:to: mechanism." 

	self eventHandler ifNotNil: [^ self eventHandler handlesMouseOver: evt].
	^ false! !

!Morph methodsFor: 'viewer' stamp: 'AlainPlantec 1/14/2010 09:41'!
externalName
	^ self assureExtension externalName ifNil: [super externalName]! !

!Morph methodsFor: 'selected object' stamp: 'dgd 8/28/2004 16:30'!
selectedObject
	"answer the selected object for the hand or nil is none"
	^ self primaryHand selectedObject! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'panda 4/25/2000 15:51'!
dropEnabled
	"Get this morph's ability to add and remove morphs via drag-n-drop."
	^(self valueOfProperty: #dropEnabled) == true
! !

!Morph methodsFor: 'classification' stamp: ''!
isWorldMorph

	^ false! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'panda 4/28/2000 12:01'!
highlightForDrop: aBoolean
	self setProperty: #highlightedForDrop toValue: aBoolean.
	self changed! !

!Morph methodsFor: 'event handling' stamp: 'sw 3/8/1999 00:17'!
cursorPoint
	^ self currentHand lastEvent cursorPoint! !

!Morph methodsFor: 'card in a stack' stamp: 'stephane.ducasse 11/15/2008 14:34'!
tabHitWithEvent: anEvent
	"The tab key was hit.  The keyboard focus has referred this event to me, though this perhaps seems rather backwards.  Anyway, the assumption is that I have the property #tabAmongFields, so now the task is to tab to the next field."

	| currentFocus fieldList anIndex itemToHighlight |
	currentFocus := anEvent hand keyboardFocus.
	fieldList := self allMorphs select:
		[:aMorph | (aMorph wouldAcceptKeyboardFocusUponTab) and: [aMorph isLocked not]].

	fieldList isEmpty ifTrue:[^ self].

	anIndex := fieldList indexOf: currentFocus ifAbsent: [nil].
	itemToHighlight := fieldList atWrap: 
		(anIndex ifNotNil: [anEvent shiftPressed ifTrue: [anIndex - 1] ifFalse: [anIndex + 1]]
				ifNil: [1]).
	anEvent hand newKeyboardFocus: itemToHighlight. self flag: #arNote. "really???"
	itemToHighlight editor selectAll.
	itemToHighlight invalidRect: itemToHighlight bounds ! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'nk 10/16/2003 14:08'!
removeAllMorphs
	| oldMorphs myWorld |
	myWorld := self world.
	(fullBounds notNil or:[myWorld notNil]) ifTrue:[self invalidRect: self fullBounds].
	submorphs do: [:m | myWorld ifNotNil: [ m outOfWorld: myWorld ]. m privateOwner: nil].
	oldMorphs := submorphs.
	submorphs := EmptyArray.
	oldMorphs do: [ :m | self removedMorph: m ].
	self layoutChanged.
! !

!Morph methodsFor: 'accessing - extension' stamp: 'dgd 2/16/2003 19:22'!
extension
	"answer the recevier's extension"
	^ extension! !

!Morph methodsFor: '*Keymapping-Core' stamp: 'GuillermoPolito 5/4/2013 16:02'!
attachKeymapCategory: aCategory
	self kmDispatcher attachCategory: aCategory.! !

!Morph methodsFor: 'menus' stamp: 'DamienCassou 9/29/2009 13:01'!
exportAsBMP
	| fName |
	fName := UIManager default request:'Please enter the name' translated initialAnswer: self externalName,'.bmp'.
	fName isEmptyOrNil ifTrue:[^self].
	self imageForm writeBMPfileNamed: fName.! !

!Morph methodsFor: 'halos and balloon help' stamp: 'sw 3/1/2000 11:39'!
comeToFrontAndAddHalo
	self comeToFront.
	self addHalo! !

!Morph methodsFor: 'meta-actions' stamp: 'StephaneDucasse 10/27/2014 09:34'!
buildMetaMenu: evt
	"Build the morph menu. This menu has two sections. The first section contains commands that are handled by the hand; the second contains commands handled by the argument morph."
	| menu |
	menu := UIManager default newMenuIn: self for: self.
	menu addStayUpItem.
	menu add: 'grab' selector: #grabMorph:.
	menu add: 'copy to paste buffer' selector: #copyToPasteBuffer:.
	self maybeAddCollapseItemTo: menu.
	menu add: 'delete' selector: #dismissMorph:.
	menu addLine.
	menu add: 'copy text' selector: #clipText.
	menu addLine.
	menu add: 'go behind' selector: #goBehind.
	menu add: 'add halo' selector: #addHalo:.
	menu add: 'duplicate' selector: #maybeDuplicateMorph:.

	self addEmbeddingMenuItemsTo: menu hand: evt hand.

	menu add: 'resize' selector: #resizeMorph:.
	"Give the argument control over what should be done about fill styles"
	self addFillStyleMenuItems: menu hand: evt hand.
	self addDropShadowMenuItems: menu hand: evt hand.
	self addLayoutMenuItems: menu hand: evt hand.
	menu addUpdating: #hasClipSubmorphsString target: self selector: #changeClipSubmorphs argumentList: #().
	menu addLine.
	menu add: 'inspect' selector: #inspectAt:event: argument: evt position.
	menu add: 'explore' selector: #explore.
	menu lastItem icon: Smalltalk ui icons smallInspectItIcon.
	menu addLine..
	menu add: 'show actions' selector: #showActions.
	menu addLine.
	self addDebuggingItemsTo: menu hand: evt hand.

	self addCustomMenuItems: menu hand: evt hand.
	^ menu
! !

!Morph methodsFor: 'geometry' stamp: ''!
extent

	^ bounds extent! !

!Morph methodsFor: 'accessing' stamp: 'nk 9/4/2004 10:49'!
scaleFactor
	^self valueOfProperty: #scaleFactor ifAbsent: [ 1.0 ]
! !

!Morph methodsFor: 'other events' stamp: 'sw 8/1/2001 14:08'!
menuButtonMouseEnter: event
	"The mouse entered a menu-button area; show the menu cursor temporarily"

	event hand showTemporaryCursor: Cursor menu! !

!Morph methodsFor: 'settings' stamp: 'AlainPlantec 12/19/2009 23:16'!
balloonHelpEnabled
	^ self theme settings balloonHelpEnabled! !

!Morph methodsFor: 'updating' stamp: 'MarcusDenker 3/2/2015 17:48'!
changed: anAspect
	
	self announcer announce: (MorphChanged new
		morph: self;
		selector: anAspect)! !

!Morph methodsFor: 'event handling' stamp: 'GuillermoPolito 4/22/2012 17:19'!
handlesKeyUp: evt
	^self handlesKeyboard: evt! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'SeanDeNigris 1/29/2013 11:23'!
navigationKey: event
	"Check for tab key activity and change focus as appropriate.
	Check for menu key to do popup."
	
	event isUserInterrupt ifTrue: [ ^ true ].

	(event keyCharacter = Character escape and: [
			event anyModifierKeyPressed]) ifTrue: [
		^ self yellowButtonActivity: false ].
	
	self window ifNotNil: [:win |
		(win handlesKeyStroke: event) ifTrue: [
			(win keyStroke: event) ifTrue: [^true]]].
	
	^false! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'MarcusDenker 5/28/2014 16:40'!
aboutToBeGrabbedBy: aHand
	"The receiver is being grabbed by a hand.
	Perform necessary adjustments (if any) and return the actual morph
	that should be added to the hand."
	
	self formerOwner: owner.
	self formerPosition: self position.
	^self "Grab me"! !

!Morph methodsFor: 'private' stamp: ''!
privateSubmorphs
	"Private!! Use 'submorphs' instead."

	^ submorphs! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 10/31/2000 20:45'!
hResizingString: aSymbol
	^self layoutMenuPropertyString: aSymbol from: self hResizing! !

!Morph methodsFor: 'naming' stamp: 'dgd 2/16/2003 21:57'!
setNamePropertyTo: aName 
	"change the receiver's externalName"
	self assureExtension externalName: aName! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'sw 10/25/1999 23:34'!
replaceSubmorph: oldMorph by: newMorph
	| index itsPosition w |
	oldMorph stopStepping.
	itsPosition := oldMorph referencePositionInWorld.
	index := submorphs indexOf: oldMorph.
	oldMorph privateDelete.
	self privateAddMorph: newMorph atIndex: index.
	newMorph referencePositionInWorld: itsPosition.
	(w := newMorph world) ifNotNil:
		[w startSteppingSubmorphsOf: newMorph]! !

!Morph methodsFor: 'initialize' stamp: 'ar 1/31/2001 13:57'!
intoWorld: aWorld
	"The receiver has just appeared in a new world. Note:
		* aWorld can be nil (due to optimizations in other places)
		* owner is already set
		* owner's submorphs may not include receiver yet.
	Important: Keep this method fast - it is run whenever morphs are added."
	aWorld ifNil:[^self].
	self wantsSteps ifTrue:[aWorld startStepping: self].
	self submorphsDo:[:m| m intoWorld: aWorld].
! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 19:59'!
maxCellSize
	"Layout specific. This property specifies the maximum size of a table cell."
	| props |
	props := self layoutProperties.
	^props ifNil:[SmallInteger maxVal] ifNotNil:[props maxCellSize].! !

!Morph methodsFor: 'rotate scale and flex' stamp: 'sw 3/30/2005 03:44'!
addFlexShell
	"Wrap a rotating and scaling shell around this morph."

	| oldHalo flexMorph myWorld anIndex |

	myWorld := self world.
	oldHalo := self halo.
	anIndex := self owner submorphIndexOf: self.
	self owner addMorph: (flexMorph := self newTransformationMorph asFlexOf: self)
		asElementNumber: anIndex.
	self transferStateToRenderer: flexMorph.
	oldHalo ifNotNil: [oldHalo setTarget: flexMorph].
	myWorld ifNotNil: [myWorld startSteppingSubmorphsOf: flexMorph].

	^ flexMorph! !

!Morph methodsFor: 'accessing' stamp: 'md 2/27/2006 09:57'!
isSticky
	"answer whether the receiver is Sticky"
	extension ifNil: [^ false].
	^ extension sticky! !

!Morph methodsFor: 'drop shadows' stamp: 'StephaneDucasse 10/27/2014 20:19'!
addDropShadowMenuItems: aMenu hand: aHand
	| menu |
	menu := UIManager default newMenuIn: self for: self.
	menu
		addUpdating: #hasDropShadowString
		selector: #toggleDropShadow.
	menu addLine.
	menu add: 'shadow color...' target: self selector: #changeShadowColor.
	menu add: 'shadow offset...' target: self selector: #setShadowOffset:.
	aMenu add: 'drop shadow' subMenu: menu.! !

!Morph methodsFor: 'menus' stamp: 'sw 6/12/2001 21:08'!
presentHelp
	"Present a help message if there is one available"

	self inform: 'Sorry, no help has been
provided here yet.'! !

!Morph methodsFor: 'drawing' stamp: '   9/3/2000 13:55'!
drawMouseDownHighlightOn: aCanvas
	self highlightedForMouseDown ifTrue: [
		aCanvas frameRectangle: self fullBounds color: self color darker darker].! !

!Morph methodsFor: '*Morphic-Widgets-ColorPicker' stamp: 'SeanDeNigris 1/23/2014 00:23'!
changeColor
	
	| dialog |
	dialog := ColorSelectorDialogWindow new
		title: 'Choose color';
		selectedColor: self color.
	self openModal: dialog.
	dialog cancelled
		ifFalse: [self fillStyle: dialog selectedColor]
	
	! !

!Morph methodsFor: 'user interface' stamp: 'MarianoMartinezPeck 8/24/2012 15:28'!
initialExtent
	| ext |
	(ext := self valueOfProperty: #initialExtent)
		ifNotNil:
			[^ ext].
	^700@500! !

!Morph methodsFor: 'layout-properties' stamp: 'md 2/27/2006 09:58'!
layoutProperties
	"Return the current layout properties associated with the  
	receiver"
	^ extension ifNotNil: [ extension layoutProperties]! !

!Morph methodsFor: 'rotate scale and flex' stamp: 'AlainPlantec 5/7/2010 23:44'!
degreesOfFlex
	"Return any rotation due to flexing"
	"NOTE: because renderedMorph, which is used by the halo to set heading, goes down through dropShadows as well as transformations, we need this method (and its other implems) to come back up through such a chain."
	^ 0.0! !

!Morph methodsFor: 'private' stamp: 'jm 5/29/1998 21:28'!
privateColor: aColor

	color := aColor.
! !

!Morph methodsFor: 'updating' stamp: 'BernardoContreras 10/3/2014 11:30'!
addDependent: anObject

	self announcer weak
		when: MorphChanged , MorphChangedWithArguments
		send: #handleUpdate:
		to: anObject.
			
	^ anObject! !

!Morph methodsFor: 'stepping and presenter' stamp: 'ar 10/22/2000 16:36'!
startStepping: aSelector at: scheduledTime arguments: args stepTime: stepTime
	"Start stepping the receiver"
	| w |
	w := self world.
	w ifNotNil: [
		w startStepping: self at: scheduledTime selector: aSelector arguments: args stepTime: stepTime.
		self changed].! !

!Morph methodsFor: 'submorphs-add/remove' stamp: ''!
addMorph: aMorph

	self addMorphFront: aMorph.! !

!Morph methodsFor: 'accessing - properties' stamp: 'tk 10/9/2002 08:30'!
setProperties: aList
	"Set many properties at once from a list of prop, value, prop, value"

	1 to: aList size by: 2 do: [:ii |
		self setProperty: (aList at: ii) toValue: (aList at: ii+1)].! !

!Morph methodsFor: 'menus' stamp: 'dgd 9/22/2004 20:30'!
model
	^ nil ! !

!Morph methodsFor: 'menu' stamp: 'nk 3/10/2004 19:51'!
outermostOwnerWithYellowButtonMenu
	"Answer me or my outermost owner that is willing to contribute menu items to a context menu.
	Don't include the world."

	| outermost |
	outermost := self outermostMorphThat: [ :ea |
		ea isWorldMorph not and: [ ea hasYellowButtonMenu ]].
	^outermost ifNil: [ self hasYellowButtonMenu ifTrue: [ self ] ifFalse: []] ! !

!Morph methodsFor: 'menus' stamp: 'sw 11/27/2001 14:36'!
addAddHandMenuItemsForHalo: aMenu hand: aHandMorph
	"The former charter of this method was to add halo menu items that pertained specifically to the hand.  Over time this charter has withered, and most morphs reimplement this method simply to add their morph-specific menu items.  So in the latest round, all other implementors in the standard image have been removed.  However, this is left here as a hook for the benefit of existing code in client uses."

! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 19:56'!
disableTableLayout
	"Layout specific. Disable laying out the receiver in table layout"
	| props |
	props := self layoutProperties.
	^props ifNil:[false] ifNotNil:[props disableTableLayout].! !

!Morph methodsFor: 'drawing' stamp: 'nk 9/1/2004 15:08'!
imageForm: depth backgroundColor: aColor forRectangle: rect
	| canvas |
	canvas := Display defaultCanvasClass extent: rect extent depth: depth.
	canvas translateBy: rect topLeft negated
		during:[:tempCanvas| 
			tempCanvas fillRectangle: rect color: aColor.
			tempCanvas fullDrawMorph: self].
	^ canvas form offset: rect topLeft! !

!Morph methodsFor: 'event handling' stamp: 'nk 3/10/2004 19:48'!
handlerForYellowButtonDown: anEvent 
	"Return the (prospective) handler for a mouse down event with the yellow button pressed.
	The 	handler is temporarily installed and can be used for morphs further 
	down the hierarchy to negotiate whether the inner or the outer 
	morph should finally handle the event."

	(self hasYellowButtonMenu or: [ self handlesMouseDown: anEvent ])
		ifFalse: [ ^ nil].	"Not interested."

	anEvent handler
		ifNil: [^ self].	"Nobody else was interested"

	"Same priority but I am innermost."
	^ self mouseDownPriority >= anEvent handler mouseDownPriority
		ifFalse: [nil ]
		ifTrue: [self]! !

!Morph methodsFor: 'meta-actions' stamp: 'HenrikSperreJohansen 5/21/2010 13:33'!
changeColorTarget: anObject selector: aSymbol originalColor: aColor hand: aHand
	"Put up a color picker for changing some kind of color."
	
	(UIManager default chooseColor: aColor)
		ifNotNil: [:nc | anObject perform: aSymbol with: nc].
! !

!Morph methodsFor: 'text-anchor' stamp: 'aoy 2/15/2003 21:47'!
changeDocumentAnchor
	"Change the anchor from/to document anchoring"

	| newType |
	newType := self textAnchorType == #document 
		ifTrue: [#paragraph]
		ifFalse: [ #document].
	owner isTextMorph 
		ifTrue: 
			[owner 
				anchorMorph: self
				at: self position
				type: newType]! !

!Morph methodsFor: 'geometry' stamp: 'sma 2/5/2000 13:58'!
screenRectangle
	"For compatibility only"

	^ self fullBounds! !

!Morph methodsFor: 'visual properties' stamp: 'gvc 9/11/2009 17:27'!
cornerStyle
	"Returns one of the following symbols:
		#square
		#rounded
	according to the current corner style."

	self assureExtension.
	^extension cornerStyle ifNil: [#square]! !

!Morph methodsFor: 'geometry' stamp: 'ar 12/22/2001 22:43'!
innerBounds
	"Return the inner rectangle enclosed by the bounds of this morph excluding the space taken by its borders. For an unbordered morph, this is just its bounds."

	^ self bounds insetBy: self borderWidth! !

!Morph methodsFor: 'geometry' stamp: 'wiz 11/25/2004 12:54'!
position: aPoint 
	"Change the position of this morph and and all of its
	submorphs. "
	| delta box |
	delta := aPoint asNonFractionalPoint - bounds topLeft.
	(delta x = 0
			and: [delta y = 0])
		ifTrue: [^ self].
	"Null change"
	box := self fullBounds.
	(delta dotProduct: delta)
			> 100
		ifTrue: ["e.g., more than 10 pixels moved"
			self invalidRect: box.
			self
				invalidRect: (box translateBy: delta)]
		ifFalse: [self
				invalidRect: (box
						merge: (box translateBy: delta))].
	self privateFullMoveBy: delta.
	owner
		ifNotNil: [owner layoutChanged]! !

!Morph methodsFor: 'menus' stamp: 'StephaneDucasse 4/22/2012 16:53'!
resistsRemovalString
	"Answer the string to be shown in a menu to represent the 
	'resistsRemoval' status"
	^ (self resistsRemoval) -> 'resist being deleted' translated! !

!Morph methodsFor: 'menu' stamp: 'StephaneDucasse 10/27/2014 09:34'!
addYellowButtonMenuItemsTo: aMenu event: evt 
	"Populate aMenu with appropriate menu items for a  
	yellow-button (context menu) click."
	aMenu defaultTarget: self.
	self defaultYellowButtonMenuEnabled ifFalse: [^ self].
	aMenu addStayUpItem.
	self addModelYellowButtonItemsTo: aMenu event: evt.
	self cmdGesturesEnabled ifTrue: [
			aMenu addLine.
			aMenu add: 'inspect' selector: #inspect].
	aMenu addLine.
	self isWorldMorph ifFalse: [aMenu add: 'delete' selector: #delete].
	self world selectedObject == self
		ifTrue: [aMenu add: 'halo off' selector: #removeHalo]
		ifFalse: [aMenu add: 'halo on' selector: #addHalo].
	(self isWorldMorph
			or: [self wantsToBeTopmost])
		ifFalse: [
			aMenu addLine.
			aMenu add: 'send to back' selector: #goBehind.
			aMenu add: 'bring to front' selector: #comeToFront.
			self addEmbeddingMenuItemsTo: aMenu hand: evt hand].
	self isWorldMorph ifFalse: [
			self isFullOnScreen ifFalse: [aMenu add: 'move onscreen' selector: #goHome]].
			self addLayoutMenuItems: aMenu hand: evt hand.
			(owner notNil
					and: [owner isTextMorph])
				ifTrue: [self addTextAnchorMenuItems: aMenu hand: evt hand].
	self isWorldMorph ifFalse: [
			aMenu addLine.
			self addToggleItemsToHaloMenu: aMenu].
	aMenu addLine.
	self isWorldMorph
		ifFalse: [aMenu add: 'copy to paste buffer' selector: #copyToPasteBuffer:].
	(self allStringsAfter: nil) isEmpty ifFalse: [aMenu add: 'copy text' selector: #clipText].
	self addExportMenuItems: aMenu hand: evt hand.
	aMenu addLine.
	aMenu add: 'adhere to edge...' selector: #adhereToEdge.
	self addCustomMenuItems: aMenu hand: evt hand! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'sw 1/9/2001 12:30'!
findDeeplyA: aClass
	"Return a morph in the submorph tree of the receiver that is descended from the given class. Return nil if there is no such morph. Clients of this code should always check for a nil return value so that the code will be robust if the user takes the morph apart."

	^ (self allMorphs copyWithout: self)
		detect: [:p | p isKindOf: aClass]
		ifNone: [nil]! !

!Morph methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 1/30/2015 16:47'!
brickThemerChanged

	self submorphs do: #brickThemerChanged! !

!Morph methodsFor: 'meta-actions' stamp: 'MarcusDenker 11/28/2009 14:25'!
targetWith: evt
	"Some other morph become target of the receiver"
	|  newTarget |
	newTarget := UIManager default
				chooseFrom: (self potentialTargets
						collect: [:t | t class name asString])
				values: self potentialTargets
				title: (self externalName, ' targets...' translated).
	newTarget ifNil:[^self].
	self target: newTarget.! !

!Morph methodsFor: 'event handling' stamp: ''!
transformFromWorld
	"Return a transform to map world coordinates into my local coordinates"

	^ self transformFrom: nil! !

!Morph methodsFor: 'stepping and presenter' stamp: 'sw 3/22/2000 14:26'!
arrangeToStartSteppingIn: aWorld
	"Start getting sent the 'step' message in aWorld.  Like startSteppingIn:, but without the initial one to get started'"
	aWorld ifNotNil:
		[aWorld startStepping: self.
		self changed]! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'panda 4/25/2000 18:36'!
dragSelectionColor
	^ Color magenta! !

!Morph methodsFor: '*Morphic-Base' stamp: 'GuillermoPolito 7/24/2012 13:07'!
on: eventName send: selector to: recipient
	self eventHandler ifNil: [self eventHandler: MorphicEventHandler new].
	self eventHandler on: eventName send: selector to: recipient! !

!Morph methodsFor: 'accessing' stamp: 'ar 8/15/2001 22:40'!
colorForInsets
	"Return the color to be used for shading inset borders.  The default is my own color, but it might want to be, eg, my owner's color.  Whoever's color ends up prevailing, the color itself gets the last chance to determine, so that when, for example, an InfiniteForm serves as the color, callers won't choke on some non-Color object being returned"
	(color isColor and:[color isTransparent and:[owner notNil]]) ifTrue:[^owner colorForInsets].
	^ color colorForInsets
! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'ar 10/11/2000 18:21'!
enableDragNDrop: aBoolean
	"Set both properties at once"
	self separateDragAndDrop.
	self enableDrag: aBoolean.
	self enableDrop: aBoolean.! !

!Morph methodsFor: 'testing' stamp: 'ar 8/25/2001 19:14'!
canDrawBorder: aBorderStyle
	"Return true if the receiver can be drawn with the given border style."
	^true! !

!Morph methodsFor: 'structure' stamp: 'dgd 9/18/2004 15:56'!
isInSystemWindow
	"answer if the receiver is in a system window"
	^ owner isMorph and:[owner isSystemWindow or:[owner isInSystemWindow]]! !

!Morph methodsFor: 'drawing' stamp: 'di 7/8/1998 12:42'!
imageFormDepth: depth

	^ self imageForm: depth forRectangle: self fullBounds
! !

!Morph methodsFor: '*Spec-Core' stamp: 'BenjaminVanRyseghem 11/28/2013 17:21'!
centerWidget: aWindow

	aWindow
			fullBounds;
			center: self center! !

!Morph methodsFor: 'halos and balloon help' stamp: 'sw 10/29/1999 17:38'!
setCenteredBalloonText: aString
	self setBalloonText: aString.
	self setProperty: #helpAtCenter toValue: true! !

!Morph methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 2/6/2014 14:19'!
gtInspectorMappingsIn: composite
	<gtInspectorPresentationOrder: 95>
	self kmDispatcher gtInspectorMappingsIn: composite! !

!Morph methodsFor: 'menus' stamp: 'StephaneDucasse 10/27/2014 17:58'!
addFillStyleMenuItems: aMenu hand: aHand
	"Add the items for changing the current fill style of the Morph"
	| menu |
	menu := UIManager default newMenuIn: self for: self.
	self fillStyle addFillStyleMenuItems: menu hand: aHand from: self.
	menu addLine.
	menu add: 'solid fill' selector: #useSolidFill.
	menu add: 'gradient fill' selector: #useGradientFill.
	menu add: 'bitmap fill' selector: #useBitmapFill.
	menu add: 'default fill' selector: #useDefaultFill.
	aMenu add: 'fill style' subMenu: menu.
! !

!Morph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 2/8/2007 13:41'!
previousMorphWantingFocus
	"Answer the previous morph that wants keyboard focus."

	|m|
	m := self previousMorphInWindow ifNil: [^nil].
	[m = self or: [m wantsKeyboardFocusNavigation]]
		whileFalse: [m := m previousMorphInWindow ifNil: [^nil]].
	^m wantsKeyboardFocusNavigation
		ifTrue: [m]
	! !

!Morph methodsFor: 'thumbnail' stamp: 'dgd 9/12/2004 21:12'!
icon
	"Answer a form with an icon to represent the receiver"
	^ self valueOfProperty: #icon! !

!Morph methodsFor: 'geometry' stamp: 'sw 2/16/1999 22:05'!
shiftSubmorphsOtherThan: listNotToShift by: delta
	| rejectList |
	rejectList := listNotToShift ifNil: [OrderedCollection new].
	(submorphs copyWithoutAll: rejectList) do:
		[:m | m position: (m position + delta)]! !

!Morph methodsFor: 'accessing' stamp: 'md 2/27/2006 08:33'!
sticky: aBoolean 
	"change the receiver's sticky property"
	extension sticky: aBoolean! !

!Morph methodsFor: 'halos and balloon help' stamp: 'StephaneDucasse 9/7/2011 21:23'!
editBalloonHelpContent: aString
	| reply |
	reply := UIManager default
		multiLineRequest: 'Edit the balloon help text for ' translated, self externalName
		initialAnswer: (aString ifNil: [self noHelpString] ifNotNil: [aString])
		answerHeight: 200.
	reply ifNil: [^ self].  "User cancelled out of the dialog"
	(reply isEmpty or: [reply asString = self noHelpString])
		ifTrue: [self setBalloonText: nil]
		ifFalse: [self setBalloonText: reply]! !

!Morph methodsFor: 'menus' stamp: 'sw 4/27/1998 03:44'!
addCustomHaloMenuItems: aMenu hand: aHandMorph
	"Add morph-specific items to the given menu which was invoked by the given hand from the halo.  To get started, we defer to the counterpart method used with the option-menu, but in time we can have separate menu choices for halo-menus and for option-menus"

	self addCustomMenuItems: aMenu hand: aHandMorph! !

!Morph methodsFor: 'accessing' stamp: 'ar 12/18/2001 20:09'!
adoptPaneColor: paneColor
	self submorphsDo:[:m| m adoptPaneColor: paneColor].! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 19:54'!
cellInset: aNumber
	"Layout specific. This property specifies an extra inset for each cell in the layout."
	self assureTableProperties cellInset: aNumber.
	self layoutChanged.! !

!Morph methodsFor: 'events-processing' stamp: 'marcus.denker 8/24/2008 22:02'!
transformedFrom: uberMorph
	"Return a transform to map coordinates of uberMorph, a morph above me in my owner chain, into the coordinates of MYSELF not any of my children."
	"self flag: #arNote." "rename this method"
	owner ifNil:[^IdentityTransform basicNew].
	^ (owner transformFrom: uberMorph)! !

!Morph methodsFor: '*glamour-morphic-widgets' stamp: 'cyrilledelaunay 6/6/2011 15:47'!
setOptimalResizingStrategyAndReturnOldOne
	| tmpHResizing tmpVResizing tmpSubmorphResizing |
	tmpHResizing := self hResizing.
	tmpVResizing := self vResizing.
	self setOptimalResizing.
	tmpSubmorphResizing := self submorphs collect: [ :aMorph | aMorph setOptimalResizingStrategyAndReturnOldOne ].
	^ {tmpHResizing.
	tmpVResizing.
	tmpSubmorphResizing}! !

!Morph methodsFor: 'Morphic-Base-Worlds' stamp: 'dgd 8/28/2004 18:43'!
pasteUpMorphHandlingTabAmongFields
	"Answer the nearest PasteUpMorph in my owner chain that has the tabAmongFields property, or nil if none"

	| aPasteUp |
	aPasteUp := self owner.
	[aPasteUp notNil] whileTrue:
		[aPasteUp tabAmongFields ifTrue:
			[^ aPasteUp].
		aPasteUp := aPasteUp owner].
	^ nil! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/13/2000 20:04'!
maxCellSize: aPoint
	"Layout specific. This property specifies the maximum size of a table cell."
	self assureTableProperties maxCellSize: aPoint.
	self layoutChanged.! !

!Morph methodsFor: '*Keymapping-Core' stamp: 'GuillermoPolito 10/20/2011 23:33'!
attachKeymapCategory: aCategoryName onProperty: aProperty
	self kmDispatcher attachCategory: aCategoryName onProperty: aProperty! !

!Morph methodsFor: 'classification' stamp: 'jm 4/17/1998 00:44'!
isFlexMorph

	^ false
! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/14/2000 16:38'!
layoutInset: aNumber
	"Return the extra inset for layouts"
	self assureTableProperties layoutInset: aNumber.
	self layoutChanged.! !

!Morph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/10/2015 18:30'!
drawClippedOnAthensCanvas: anAthensCanvas during: aBlock

	^ self clipSubmorphs 
		ifTrue: [ 
			 anAthensCanvas
				clipBy: (self clippingBounds intersect: anAthensCanvas clipRect ifNone:[^ self])
				during: aBlock ] 
		ifFalse: [ aBlock value ]
! !

!Morph methodsFor: 'user interface' stamp: 'StephaneDucasse 5/13/2012 20:49'!
doFastReframe: ptName

	| newBounds |
	"For fast display, only higlight the rectangle during loop"
	newBounds := self boundsInWorld newRectButtonPressedDo: [:f :pt | 
		f 
			withSideOrCorner: ptName
			setToPoint: pt
			minExtent: self minimumExtent].
	Display deferUpdatesIn: Display boundingBox while: [
		self bounds: newBounds].

	^newBounds.! !

!Morph methodsFor: 'drawing' stamp: 'MarcusDenker 10/21/2013 14:22'!
hide
	owner ifNil: [ ^ self ].
	self visible
		ifFalse: [ ^ self ].
	self visible: false.
	self changed! !

!Morph methodsFor: 'debug and other' stamp: 'sw 11/5/1998 20:31'!
inspectOwnerChain
	self ownerChain inspectWithLabel: 'Owner chain for ', self printString! !

!Morph methodsFor: 'settings' stamp: 'AlainPlantec 12/10/2009 13:03'!
defaultYellowButtonMenuEnabled
	^ self class defaultYellowButtonMenuEnabled! !

!Morph methodsFor: 'halos and balloon help' stamp: 'ar 10/3/2000 17:03'!
deleteBalloon
	"If I am showing a balloon, delete it."
	| w |
	w := self world ifNil:[^self].
	w deleteBalloonTarget: self.! !

!Morph methodsFor: 'geometry' stamp: 'sw 8/20/97 23:04'!
topRight

	^ bounds topRight! !

!Morph methodsFor: 'testing' stamp: 'StephaneDucasse 7/18/2010 16:33'!
wantsSteps
	"Return true if the receiver overrides the default Morph step method."
	"Details: Find first class in superclass chain that implements #step and return true if it isn't class Morph."

	| c |
	c := self class.
	[c includesSelector: #step] whileFalse: [c := c superclass].
	^ c ~= Morph! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'ar 1/31/2001 12:55'!
addMorphBack: aMorph
	^self privateAddMorph: aMorph atIndex: submorphs size+1! !

!Morph methodsFor: '*Morphic-Base' stamp: 'nk 4/15/2004 10:55'!
borderColor: aColorOrSymbolOrNil 
	"Unfortunately, the argument to borderColor could be more than 	just a color. 
	It could also be a symbol, in which case it is to be interpreted as a style identifier.
	But I might not be able to draw that kind of border, so it may have to be ignored.
	Or it could be nil, in which case I should revert to the default border."

	| style newStyle |
	style := self borderStyle.
	style baseColor = aColorOrSymbolOrNil
		ifTrue: [^ self].

	aColorOrSymbolOrNil isColor
		ifTrue: [style style = #none "default border?"
				ifTrue: [self borderStyle: (SimpleBorder width: 0 color: aColorOrSymbolOrNil)]
				ifFalse: [style baseColor: aColorOrSymbolOrNil.
					self changed].
			^ self].

	self
		borderStyle: ( ({ nil. #none } includes: aColorOrSymbolOrNil)
				ifTrue: [BorderStyle default]
				ifFalse: [ "a symbol"
					self doesBevels ifFalse: [ ^self ].
					newStyle := (BorderStyle perform: aColorOrSymbolOrNil)
								color: style color;
								width: style width;
								yourself.
					(self canDrawBorder: newStyle)
						ifTrue: [newStyle]
						ifFalse: [style]])! !

!Morph methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 1/18/2012 18:54'!
mouseLeave: evt
	"Handle a mouseLeave event, meaning the mouse just left my bounds with no button pressed. The default response is to let my eventHandler, if any, handle it."

	^ self eventHandler ifNotNil:
		[self eventHandler mouseLeave: evt fromMorph: self].
! !

!Morph methodsFor: 'event handling' stamp: 'sw 11/3/97 02:11'!
wantsKeyboardFocusFor: aSubmorph
	"Answer whether a plain mouse click on aSubmorph, a text-edit-capable thing, should result in a text selection there"
	^ false! !

!Morph methodsFor: '*Morphic-Base' stamp: 'ar 2/16/1999 18:59'!
newTransformationMorph
	^TransformationMorph new! !

!Morph class methodsFor: '*Polymorph-Widgets-Themes' stamp: 'YuriyTymchuk 12/20/2013 11:19'!
systemIcon

	^ Smalltalk ui icons iconNamed: #morphIcon! !

!Morph class methodsFor: 'instance creation' stamp: 'jm 5/29/1998 21:28'!
newBounds: bounds color: color

	^ (self new privateBounds: bounds) privateColor: color
! !

!Morph class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/25/2013 18:27'!
announcer

	^ announcer ifNil: [ announcer := Announcer new ].! !

!Morph class methodsFor: 'settings' stamp: 'GuillermoPolito 3/19/2013 19:12'!
morphNavigationShortcutsOn: aBuilder
	"Basic, general navigation shortcut among morphs. #MorphNoCtrl will not work for TextMorphs."

	<keymap>
	(aBuilder shortcut: #navigateFocusForwardCtrl)
		category: #MorphFocusCtrlNavigation
		default: Character tab ctrl asKeyCombination
		do: [ :target :morph :event | morph navigateFocusForward ].
	(aBuilder shortcut: #navigateFocusBackwardCtrl)
		category: #MorphFocusCtrlNavigation
		default: Character tab shift ctrl asKeyCombination
		do: [ :target :morph :event | morph navigateFocusBackward ].
	(aBuilder shortcut: #navigateFocusForward)
		category: #MorphFocusNavigation
		default: Character tab asKeyCombination
		do: [ :target :morph :event | morph navigateFocusForward ].
	(aBuilder shortcut: #navigateFocusBackward)
		category: #MorphFocusNavigation
		default: Character tab shift asKeyCombination
		do: [ :target :morph :event | morph navigateFocusBackward ]! !

!Morph class methodsFor: 'settings' stamp: 'usmanbhatti 3/6/2012 19:23'!
halosEnabled

	^ HalosEnabled ifNil: [ HalosEnabled := true ]! !

!Morph class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:15'!
gtExampleSubmorphs
	<gtExample: 'Submorphs'>
	^ self new
		addMorph: self new;
		addMorph: self new;
		yourself! !

!Morph class methodsFor: 'settings' stamp: 'SeanDeNigris 4/24/2012 19:51'!
cycleHalosBothDirections

	^ CycleHalosBothDirections ifNil: [ CycleHalosBothDirections := false ].! !

!Morph class methodsFor: '*Polymorph-Widgets' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
theme
	"Answer the ui theme that provides controls."

	^ Smalltalk ui theme! !

!Morph class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:15'!
gtExampleEmpty
	<gtExample: 'Empty'>
	^ self new! !

!Morph class methodsFor: 'settings' stamp: 'BenjaminVanRyseghem 3/6/2012 19:38'!
halosEnabled: aBoolean

	HalosEnabled := aBoolean! !

!Morph class methodsFor: 'settings' stamp: 'AlainPlantec 12/10/2009 13:02'!
defaultYellowButtonMenuEnabled: aBoolean
	DefaultYellowButtonMenuEnabled := aBoolean! !

!Morph class methodsFor: 'settings' stamp: 'AlainPlantec 12/10/2009 13:09'!
defaultYellowButtonMenuEnabled
	^ DefaultYellowButtonMenuEnabled ifNil: [DefaultYellowButtonMenuEnabled := false]! !

!Morph class methodsFor: 'shortcuts' stamp: 'PavelKrivanek 7/24/2014 16:09'!
shortcutsHandler 

	^ ShortcutsHandler! !

!Morph class methodsFor: 'settings' stamp: 'SeanDeNigris 4/24/2012 19:52'!
cycleHalosBothDirections: aBoolean

	CycleHalosBothDirections := aBoolean.! !

!Morph class methodsFor: 'initialize-release' stamp: ''!
initialize
	"Morph initialize"

	"this empty array object is shared by all morphs with no submorphs:"
	EmptyArray := Array new.
! !

!Morph class methodsFor: 'accessing' stamp: 'EstebanLorenzano 12/23/2014 17:25'!
defaultEventDispatcher
	^ EventDispatcher ifNil: [ EventDispatcher := MorphicEventDispatcher new ]! !

!Morph class methodsFor: 'misc' stamp: 'MarcusDenker 10/21/2013 14:22'!
morphsUnknownToTheirOwners
	"Return a list of all morphs (other than HandMorphs) whose owners do not contain them in their submorph lists"

	"Morph morphsUnknownToTheirOwners"

	| problemMorphs |
	problemMorphs := OrderedCollection new.
	self allSubInstances
		do: [ :m | 
			| itsOwner |
			(m isHandMorph not and: [ (itsOwner := m owner) notNil and: [ (itsOwner submorphs includes: m) not ] ])
				ifTrue: [ problemMorphs add: m ] ].
	^ problemMorphs! !

!Morph class methodsFor: 'instance creation' stamp: ''!
newBounds: bounds

	^ self new privateBounds: bounds! !

!Morph class methodsFor: 'shortcuts' stamp: 'PavelKrivanek 7/24/2014 16:09'!
shortcutsHandler: anObject

	ShortcutsHandler := anObject! !

!Morph class methodsFor: 'settings' stamp: 'AlainPlantec 12/19/2009 23:12'!
cmdGesturesEnabled: aBoolean
	CmdGesturesEnabled := aBoolean! !

!Morph class methodsFor: 'misc' stamp: 'PeterHugossonMiller 9/2/2009 16:13'!
obtainArrowheadFor: aPrompt defaultValue: defaultPoint
	"Allow the user to supply a point to serve as an arrowhead size.  Answer nil if we fail to get a good point"

	| result  |
	result := UIManager default request: aPrompt initialAnswer: defaultPoint asString.
	result isEmptyOrNil ifTrue: [^ nil].
	^ [(Point readFrom: result readStream)]
		on: Error do: [:ex |  nil].! !

!Morph class methodsFor: 'instance creation' stamp: 'sw 8/4/97 12:05'!
newSticky

	^ self new beSticky! !

!Morph class methodsFor: '*Spec-Inspector' stamp: 'CamilloBruni 9/22/2013 19:40'!
additionalInspectorClasses
	^ super additionalInspectorClasses, { EyeViewHierarchyInspector. EyeMorphViewer }! !

!Morph class methodsFor: 'settings' stamp: 'AlainPlantec 12/19/2009 23:12'!
cmdGesturesEnabled
	^ CmdGesturesEnabled ifNil: [CmdGesturesEnabled := true]! !

!MorphAnnouncement commentStamp: '<historical>'!
I am an abstract announcement for morphic events.  I carry the morph where the event has ocurred.

My subclasses should add information for more precise events.!
!MorphAnnouncement methodsFor: 'accessing' stamp: 'GuillermoPolito 5/1/2012 19:47'!
morph
	^ morph! !

!MorphAnnouncement methodsFor: 'accessing' stamp: 'GuillermoPolito 5/1/2012 19:47'!
morph: anObject
	morph := anObject! !

!MorphAnnouncement class methodsFor: 'instance creation' stamp: 'GuillermoPolito 5/1/2012 19:48'!
morph: aMorph
	^self new
			morph: aMorph;
			yourself! !

!MorphChanged commentStamp: '<historical>'!
I am raised when a morph property changed, and should be propagated to dependents!
!MorphChanged methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/22/2013 15:05'!
selector
	^ selector! !

!MorphChanged methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/22/2013 15:05'!
selector: anObject
	selector := anObject! !

!MorphChanged methodsFor: 'delivering' stamp: 'IgorStasenko 8/27/2013 16:27'!
deliverTo: aHandler

	^ aHandler update: selector

	! !

!MorphChangedWithArguments commentStamp: '<historical>'!
I am an announcement raised when a Morph changed and need to propagate the information to dependents. In addition, I also propagate a value!
!MorphChangedWithArguments methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/23/2013 12:32'!
arguments: anObject
	arguments := anObject! !

!MorphChangedWithArguments methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/23/2013 12:32'!
arguments
	^ arguments! !

!MorphChangedWithArguments methodsFor: 'delivering' stamp: 'IgorStasenko 8/27/2013 16:28'!
deliverTo: aHandler

	^ aHandler update: selector with: arguments

	! !

!MorphDeleted commentStamp: '<historical>'!
I'm an announcement raised when a morph is deleted. Subscribe to me when you want to do things after the morph is opened.

Take into account that when a morph is deleted, all it's children also get deleted and they raise a similar announcement.!
!MorphDropListMorph commentStamp: 'gvc 5/18/2007 12:43'!
Drop list supporting morphs in list.!
!MorphDropListMorph methodsFor: 'accessing' stamp: 'GaryChambers 4/24/2012 15:22'!
font
	"Answer the content font"

	^self listFont! !

!MorphDropListMorph methodsFor: 'drawing' stamp: 'gvc 6/17/2006 12:11'!
newContentMorph
	"Answer a new content morph"

	^Morph new
		changeTableLayout;
		listDirection: #leftToRight;
		wrapCentering: #center;
		vResizing: #spaceFill;
		hResizing: #spaceFill;
		layoutInset: 2;
		color: Color transparent;
		borderWidth: 0;
		clipSubmorphs: true;
		lock! !

!MorphDropListMorph methodsFor: 'updating' stamp: 'gvc 9/29/2006 11:58'!
updateContentColor: paneColor
	"Change the content text color."
	! !

!MorphDropListMorph methodsFor: 'private' stamp: 'gvc 6/17/2006 11:43'!
listMorphClass
	"Answer the class for a new list morph"

	^PluggableMorphListMorph! !

!MorphDropListMorph methodsFor: 'testing' stamp: 'gvc 7/17/2006 13:35'!
updateContents
	"Update the contents."

	|item|
	self contentMorph removeAllMorphs.
	self listSelectionIndex > 0
		ifTrue: [item := (self list at: self listSelectionIndex) copy
					hResizing: #spaceFill;
					vResizing: #rigid.
				self contentMorph
					addMorph: item]! !

!MorphDropListMorph methodsFor: 'accessing' stamp: 'GaryChambers 4/24/2012 15:22'!
font: aFont
	"Set the list font"

	self listFont: aFont! !

!MorphEventSubscription commentStamp: 'GuillermoPolito 4/22/2012 19:17'!
I represent a subscription to an event.  I'm kind of an announcement, that's why I will be replaced by them soon :)!
!MorphEventSubscription methodsFor: 'accessing' stamp: 'GuillermoPolito 4/22/2012 18:36'!
selector

	^ selector! !

!MorphEventSubscription methodsFor: 'accessing' stamp: 'GuillermoPolito 4/22/2012 18:39'!
valueParameter: anObject

	valueParameter := anObject! !

!MorphEventSubscription methodsFor: 'events-triggering' stamp: 'GuillermoPolito 4/22/2012 18:40'!
click: anEvent fromMorph: aMorph 
	^self notify: anEvent from: aMorph! !

!MorphEventSubscription methodsFor: 'accessing' stamp: 'GuillermoPolito 4/22/2012 18:36'!
recipient

	^ recipient! !

!MorphEventSubscription methodsFor: 'events-triggering' stamp: 'GuillermoPolito 4/22/2012 18:41'!
mouseEnter: anEvent fromMorph: aMorph 
	^self notify: anEvent from: aMorph! !

!MorphEventSubscription methodsFor: 'accessing' stamp: 'GuillermoPolito 4/22/2012 18:36'!
selector: anObject

	selector := anObject! !

!MorphEventSubscription methodsFor: 'events-triggering' stamp: 'GuillermoPolito 4/22/2012 18:40'!
doubleClick: anEvent fromMorph: aMorph 
	^self notify: anEvent from: aMorph! !

!MorphEventSubscription methodsFor: 'events-triggering' stamp: 'GuillermoPolito 4/22/2012 18:41'!
mouseLeave: anEvent fromMorph: aMorph 
	^self notify: anEvent from: aMorph! !

!MorphEventSubscription methodsFor: 'accessing' stamp: 'GuillermoPolito 4/22/2012 18:36'!
event

	^ event! !

!MorphEventSubscription methodsFor: 'accessing' stamp: 'GuillermoPolito 4/22/2012 18:36'!
event: anEvent

	event := anEvent! !

!MorphEventSubscription methodsFor: 'accessing' stamp: 'GuillermoPolito 4/22/2012 18:36'!
recipient: anObject

	recipient := anObject! !

!MorphEventSubscription methodsFor: 'accessing' stamp: 'GuillermoPolito 4/22/2012 18:39'!
valueParameter

	^ valueParameter! !

!MorphEventSubscription methodsFor: 'events-triggering' stamp: 'GuillermoPolito 4/22/2012 18:42'!
doubleClickTimeout: anEvent fromMorph: aMorph 
	^self notify: anEvent from: aMorph! !

!MorphEventSubscription methodsFor: 'events-triggering' stamp: 'GuillermoPolito 4/22/2012 18:39'!
notify: anEvent from: sourceMorph
	| arity |
	recipient ifNil: [^ self].
	arity := selector numArgs.
	arity = 0 ifTrue:
		[^ recipient perform: selector].
	arity = 1 ifTrue:
		[^ recipient perform: selector with: anEvent].
	arity = 2 ifTrue:
		[^ recipient perform: selector with: anEvent with: sourceMorph].
	arity = 3 ifTrue:
		[^ recipient perform: selector with: valueParameter with: anEvent with: sourceMorph].
	self error: 'Event handling selectors must be Symbols and take 0-3 arguments'! !

!MorphEventSubscription class methodsFor: 'instance creation' stamp: 'GuillermoPolito 4/22/2012 18:35'!
on: anEvent send: aSelector to: anObject
	^self new
		event: anEvent;
		selector: aSelector;
		recipient: anObject;
		yourself! !

!MorphEventSubscription class methodsFor: 'instance creation' stamp: 'GuillermoPolito 4/22/2012 19:21'!
on: anEvent send: aMessageSelector to: anObject withValue: aValue
	^self new
		event: anEvent;
		selector: aMessageSelector;
		recipient: anObject;
		valueParameter: aValue;
		yourself! !

!MorphExtension commentStamp: '<historical>'!
MorphExtension provides access to extra instance state that is not required in most simple morphs.  This allows simple morphs to remain relatively lightweight while still admitting more complex structures as necessary.  The otherProperties field takes this policy to the extreme of allowing any number of additional named attributes, albeit at a certain cost in speed and space.!
!MorphExtension methodsFor: 'accessing - other properties' stamp: 'dgd 2/16/2003 21:00'!
valueOfProperty: aSymbol 
"answer the value of the receiver's property named aSymbol"
	^ self
		valueOfProperty: aSymbol
		ifAbsent: []! !

!MorphExtension methodsFor: 'accessing' stamp: 'dgd 2/16/2003 21:47'!
sticky: aBoolean 
	"change the receiver's sticky property"
	sticky := aBoolean! !

!MorphExtension methodsFor: 'other' stamp: 'ClementBera 7/30/2013 11:07'!
isDefault
	"Return true if the receiver is a default and can be omitted"
	locked == true
		ifTrue: [^ false].
	visible == false
		ifTrue: [^ false].
	sticky == true
		ifTrue: [^ false].
	balloonText ifNotNil: [^ false].
	externalName ifNotNil: [^ false].
	eventHandler ifNotNil: [^ false].
	otherProperties ifNotNil: [otherProperties isEmpty ifFalse: [^ false]].
	^ true! !

!MorphExtension methodsFor: 'accessing' stamp: 'gvc 9/11/2009 18:10'!
cornerStyle
	"Answer the value of cornerStyle"

	^cornerStyle! !

!MorphExtension methodsFor: 'accessing - other properties' stamp: 'md 2/27/2006 08:41'!
assureOtherProperties
	"creates an otherProperties for the receiver if needed"
	otherProperties ifNil: [self initializeOtherProperties].
	^ otherProperties! !

!MorphExtension methodsFor: 'connectors-copying' stamp: 'nk 5/1/2004 17:39'!
veryDeepFixupWith: deepCopier 
	"If target and arguments fields were weakly copied, fix them here.
	If they were in the tree being copied, fix them up, otherwise point to the originals!!!!"

	super veryDeepFixupWith: deepCopier.
	otherProperties ifNil: [ ^self ].

	"Properties whose values are only copied weakly replace those values if they were copied via another path"
	self copyWeakly do: [ :propertyName |
		otherProperties at: propertyName ifPresent: [ :property |
			otherProperties at: propertyName
				put: (deepCopier references at: property ifAbsent: [ property ])]].
! !

!MorphExtension methodsFor: 'accessing' stamp: 'gvc 9/11/2009 18:12'!
fillStyle
	"Answer the value of fillStyle"

	^ fillStyle! !

!MorphExtension methodsFor: 'accessing - other properties' stamp: 'md 2/27/2006 08:37'!
removeOtherProperties
	"Remove the 'other' properties"
	otherProperties := nil! !

!MorphExtension methodsFor: 'accessing' stamp: 'dgd 2/16/2003 21:51'!
eventHandler
	"answer the receiver's eventHandler"
	^ eventHandler ! !

!MorphExtension methodsFor: 'accessing - other properties' stamp: 'md 2/27/2006 08:43'!
removeProperty: aSymbol 
	"removes the property named aSymbol if it exists"
	otherProperties ifNil: [^ self].
	otherProperties removeKey: aSymbol ifAbsent: [].
	otherProperties isEmpty ifTrue: [self removeOtherProperties]! !

!MorphExtension methodsFor: 'viewer' stamp: 'di 8/10/1998 14:47'!
externalName
	^ externalName! !

!MorphExtension methodsFor: 'initialization' stamp: 'StephaneDucasse 7/18/2010 16:28'!
initialize
	
	locked := false.
	visible := true.
	sticky := false.

! !

!MorphExtension methodsFor: 'accessing - other properties' stamp: 'dgd 2/16/2003 21:04'!
otherProperties
	"answer the receiver's otherProperties"
	^ otherProperties! !

!MorphExtension methodsFor: 'printing' stamp: 'MarcusDenker 10/21/2013 14:23'!
printOn: aStream
	"Append to the argument, aStream, a sequence of characters that 
	identifies the receiver."

	super printOn: aStream.
	aStream
		space;
		nextPut: $(;
		print: self identityHash;
		nextPut: $).
	locked == true
		ifTrue: [ aStream nextPutAll: ' [locked] ' ].
	visible == false
		ifTrue: [ aStream nextPutAll: '[not visible] ' ].
	sticky == true
		ifTrue: [ aStream nextPutAll: ' [sticky] ' ].
	balloonText ifNotNil: [ aStream nextPutAll: ' [balloonText] ' ].
	externalName
		ifNotNil: [ 
			aStream
				nextPutAll: ' [externalName = ' , externalName;
				nextPutAll: ' ] ' ].
	eventHandler
		ifNotNil: [ 
			aStream
				nextPutAll: ' [eventHandler = ' , eventHandler printString;
				nextPutAll: '] ' ].
	(otherProperties isNil or: [ otherProperties isEmpty ])
		ifTrue: [ ^ self ].
	aStream nextPutAll: ' [other: '.
	self otherProperties
		keysDo: [ :aKey | 
			aStream
				nextPutAll: ' (' , aKey , ' -> ' , (self otherProperties at: aKey) printString;
				nextPutAll: ')' ].
	aStream nextPut: $]! !

!MorphExtension methodsFor: 'accessing - other properties' stamp: 'md 2/27/2006 08:43'!
valueOfProperty: aSymbol ifAbsent: aBlock 
	"if the receiver possesses a property of the given name, answer  
	its value. If not then evaluate aBlock and answer the result of  
	this block evaluation"
	otherProperties ifNil: [^ aBlock value].
	^ otherProperties at: aSymbol ifAbsent: [^ aBlock value]! !

!MorphExtension methodsFor: 'accessing' stamp: 'gvc 9/11/2009 16:55'!
fillStyle: anObject
	"Set the value of fillStyle"

	fillStyle := anObject! !

!MorphExtension methodsFor: 'accessing' stamp: 'di 8/10/1998 12:55'!
visible: newValue
	visible := newValue! !

!MorphExtension methodsFor: 'connectors-copying' stamp: 'MarcusDenker 9/7/2010 17:00'!
veryDeepInner: deepCopier 
	"Copy all of my instance variables.
	Some otherProperties need to be not copied at all, but shared. Their names are given by copyWeakly.
	Some otherProperties should not be copied or shared. Their names are given by propertyNamesNotCopied.
	This is special code for the dictionary. See DeepCopier, and veryDeepFixupWith:."

	| namesOfWeaklyCopiedProperties weaklyCopiedValues |
	super veryDeepInner: deepCopier.
	locked := locked veryDeepCopyWith: deepCopier.
	visible := visible veryDeepCopyWith: deepCopier.
	sticky := sticky veryDeepCopyWith: deepCopier.
	balloonText := balloonText veryDeepCopyWith: deepCopier.
	externalName := externalName veryDeepCopyWith: deepCopier.
	eventHandler := eventHandler veryDeepCopyWith: deepCopier. 	"has its own restrictions"
	
	fillStyle := fillStyle veryDeepCopyWith: deepCopier.
	layoutPolicy := layoutPolicy veryDeepCopyWith: deepCopier.
	layoutFrame := layoutFrame veryDeepCopyWith: deepCopier.
	layoutProperties := layoutProperties veryDeepCopyWith: deepCopier.
	borderStyle := borderStyle  veryDeepCopyWith: deepCopier.
	cornerStyle := cornerStyle veryDeepCopyWith: deepCopier.
	actionMap := actionMap veryDeepCopyWith: deepCopier.
	clipSubmorphs := clipSubmorphs veryDeepCopyWith: deepCopier.

	otherProperties ifNil: [ ^self ].

	otherProperties := otherProperties copy.
	self propertyNamesNotCopied do: [ :propName | otherProperties removeKey: propName ifAbsent: [] ].

	namesOfWeaklyCopiedProperties := self copyWeakly.
	weaklyCopiedValues := namesOfWeaklyCopiedProperties collect: [  :propName | otherProperties removeKey: propName ifAbsent: [] ].

	"Now copy all the others."
	otherProperties := otherProperties veryDeepCopyWith: deepCopier.

	"And replace the weak ones."
	namesOfWeaklyCopiedProperties with: weaklyCopiedValues do: [ :name :value | value ifNotNil: [ otherProperties at: name put: value ]].
! !

!MorphExtension methodsFor: 'accessing' stamp: 'di 8/14/1998 13:07'!
sticky
	^ sticky! !

!MorphExtension methodsFor: 'accessing' stamp: 'gvc 9/11/2009 18:10'!
borderStyle
	"Answer the value of borderStyle"

	^borderStyle! !

!MorphExtension methodsFor: 'accessing' stamp: 'gvc 9/11/2009 17:08'!
borderStyle: anObject
	"Set the value of borderStyle"

	borderStyle := anObject! !

!MorphExtension methodsFor: 'accessing - layout properties' stamp: 'gvc 9/11/2009 18:12'!
layoutProperties

	^layoutProperties! !

!MorphExtension methodsFor: 'accessing - layout properties' stamp: 'gvc 9/11/2009 18:10'!
layoutFrame

	^layoutFrame! !

!MorphExtension methodsFor: 'accessing' stamp: 'gvc 9/11/2009 18:10'!
clipSubmorphs
	"Answer the value of clipSubmorphs"

	^clipSubmorphs! !

!MorphExtension methodsFor: 'accessing' stamp: 'di 8/10/1998 12:55'!
balloonText: newValue
	balloonText := newValue! !

!MorphExtension methodsFor: 'accessing' stamp: 'gvc 9/11/2009 17:58'!
clipSubmorphs: anObject
	"Set the value of clipSubmorphs"

	clipSubmorphs := anObject! !

!MorphExtension methodsFor: 'accessing - layout properties' stamp: 'gvc 9/11/2009 16:47'!
layoutPolicy: aLayoutPolicy 
	
	layoutPolicy := aLayoutPolicy! !

!MorphExtension methodsFor: 'accessing' stamp: 'gvc 9/11/2009 17:39'!
actionMap: anObject
	"Set the value of actionMap"

	actionMap := anObject! !

!MorphExtension methodsFor: 'accessing' stamp: 'di 8/10/1998 12:56'!
eventHandler: newValue
	eventHandler := newValue! !

!MorphExtension methodsFor: 'accessing' stamp: 'gvc 9/11/2009 17:23'!
cornerStyle: anObject
	"Set the value of cornerStyle"

	cornerStyle := anObject! !

!MorphExtension methodsFor: 'accessing - other properties' stamp: 'dgd 2/16/2003 21:28'!
valueOfProperty: aSymbol ifAbsentPut: aBlock 
	"If the receiver possesses a property of the given name, answer  
	its value. If not, then create a property of the given name, give 
	it the value obtained by evaluating aBlock, then answer that  
	value"
	^self assureOtherProperties at: aSymbol ifAbsentPut: aBlock! !

!MorphExtension methodsFor: 'accessing - layout properties' stamp: 'gvc 9/11/2009 16:45'!
layoutFrame: aLayoutFrame

	layoutFrame := aLayoutFrame! !

!MorphExtension methodsFor: 'accessing - other properties' stamp: 'ClementBera 7/30/2013 11:07'!
sortedPropertyNames
	"answer the receiver's property names in a sorted way"

	| props |
	props := (Array new: 10) writeStream.
	locked == true ifTrue: [props nextPut: #locked].
	visible == false ifTrue: [props nextPut: #visible].
	sticky == true ifTrue: [props nextPut: #sticky].
	balloonText ifNotNil: [props nextPut: #balloonText].
	externalName ifNotNil: [props nextPut: #externalName].
	eventHandler ifNotNil: [props nextPut: #eventHandler].
	 otherProperties ifNotNil: [otherProperties associationsDo: [:a | props nextPut: a key]].
	^props contents sort: [:s1 :s2 | s1 <= s2]! !

!MorphExtension methodsFor: 'accessing' stamp: 'di 8/10/1998 12:52'!
balloonText
	^ balloonText! !

!MorphExtension methodsFor: 'accessing - other properties' stamp: 'ClementBera 7/30/2013 11:07'!
hasProperty: aSymbol 
	"Answer whether the receiver has the property named aSymbol"
	| property |
	otherProperties ifNil: [^ false].
	property := otherProperties at: aSymbol ifAbsent: [].
	property ifNil: [^ false].
	property == false ifTrue: [^ false].
	^ true! !

!MorphExtension methodsFor: 'other' stamp: 'alain.plantec 2/6/2009 17:09'!
inspectElement
	"Create and schedule an Inspector on the otherProperties and the 
	named properties."
	| key obj |
	key := UIManager default 
				chooseFrom: self sortedPropertyNames 
				values: self sortedPropertyNames
				title: 'Inspect which property?' translated.
	key
		ifNil: [^ self].
	obj := otherProperties
				at: key
				ifAbsent: ['nOT a vALuE'].
	obj = 'nOT a vALuE'
		ifTrue: [(self perform: key) inspect
			"named properties"]
		ifFalse: [obj inspect]! !

!MorphExtension methodsFor: 'accessing' stamp: 'dgd 2/16/2003 21:41'!
visible
	"answer whether the receiver is visible"
	^ visible! !

!MorphExtension methodsFor: 'accessing - other properties' stamp: 'dgd 2/16/2003 21:49'!
setProperty: aSymbol toValue: abObject 
	"change the receiver's property named aSymbol to anObject"
	self assureOtherProperties at: aSymbol put: abObject! !

!MorphExtension methodsFor: 'accessing' stamp: 'dgd 2/16/2003 21:38'!
locked
	"answer whether the receiver is Locked"
	^ locked! !

!MorphExtension methodsFor: 'connectors-copying' stamp: 'nk 5/1/2004 17:23'!
propertyNamesNotCopied
	"list of names of properties whose values should be deleted when veryDeepCopying a morph.
	See DeepCopier."

	^ #(connectedConstraints connectionHighlights highlightedTargets)
	"add yours to this list" 
! !

!MorphExtension methodsFor: 'accessing - layout properties' stamp: 'gvc 9/11/2009 16:47'!
layoutProperties: newProperties 
	"Return the current layout properties associated with the receiver"

	layoutProperties := newProperties! !

!MorphExtension methodsFor: 'connectors-copying' stamp: 'StephaneDucasse 4/3/2011 22:27'!
copyWeakly
	"list of names of properties whose values should be weak-copied when veryDeepCopying a morph.  See DeepCopier."

	^ #(formerOwner)
	"add yours to this list" 

	"formerOwner should really be nil at the time of the copy, but this will work just fine."! !

!MorphExtension methodsFor: 'accessing' stamp: 'dgd 2/16/2003 21:48'!
locked: aBoolean 
	"change the receiver's locked property"
	locked := aBoolean! !

!MorphExtension methodsFor: 'accessing - layout properties' stamp: 'gvc 9/11/2009 18:12'!
layoutPolicy

	^layoutPolicy! !

!MorphExtension methodsFor: 'accessing - other properties' stamp: 'marcus.denker 9/17/2008 17:39'!
initializeOtherProperties
	"private - initializes the receiver's otherProperties"
	otherProperties :=  SmallIdentityDictionary new! !

!MorphExtension methodsFor: 'accessing' stamp: 'dgd 2/16/2003 21:57'!
externalName: aString 
	"change the receiver's externalName"
	externalName := aString! !

!MorphExtension methodsFor: 'accessing' stamp: 'gvc 9/11/2009 17:41'!
actionMap
	"Answer the value of actionMap"

	^actionMap ifNil: [self valueOfProperty: #actionMap ifAbsent: []]! !

!MorphGotFocus commentStamp: '<historical>'!
I'm an announcement raised when a morph gets keyboard focus. !
!MorphHandlingMiddleButton commentStamp: 'SeanDeNigris 2/20/2014 08:53'!
I log when the middle mouse button has been clicked on me, which is useful for testing.!
!MorphHandlingMiddleButton methodsFor: 'meta-actions' stamp: 'SeanDeNigris 12/14/2011 15:17'!
handlerForBlueButtonDown: anEvent

	^ self.! !

!MorphHandlingMiddleButton methodsFor: 'initialization' stamp: 'SeanDeNigris 12/14/2011 15:24'!
initialize

	super initialize.
	receivedBlueButtonUp := receivedBlueButtonDown := false.! !

!MorphHandlingMiddleButton methodsFor: 'meta-actions' stamp: 'SeanDeNigris 12/14/2011 15:18'!
blueButtonDown: anEvent

	receivedBlueButtonDown := true.! !

!MorphHandlingMiddleButton methodsFor: 'meta-actions' stamp: 'SeanDeNigris 12/14/2011 15:18'!
blueButtonUp: anEvent

	receivedBlueButtonUp := true.! !

!MorphHandlingMiddleButton methodsFor: 'testing' stamp: 'SeanDeNigris 12/14/2011 15:21'!
wasClickedWithMiddleButton

	^ receivedBlueButtonDown and: [ receivedBlueButtonUp ].! !

!MorphLostFocus commentStamp: '<historical>'!
I'm an announcement raised when a morph losts keyboard focus.!
!MorphOpened commentStamp: '<historical>'!
I'm an announcement raised when a morph is opened.  Subscribe to me when you want to do things after the morph is opened.

Take into account that when a morph is opened, all it's children also get opened and they raise a similar announcement.!
!MorphTest commentStamp: '<historical>'!
This is the unit test for the class Morph. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see: 
	- http://www.c2.com/cgi/wiki?UnitTest
	- http://minnow.cc.gatech.edu/squeak/1547
	- the sunit class category!
!MorphTest methodsFor: 'testing - into/outof world' stamp: 'ar 8/10/2003 18:30'!
testIntoWorldTransferToNewGuy
	| m1 m2 |
	"Create the guys"
	m1 := TestInWorldMorph new.
	m2 := TestInWorldMorph new.
	self assert: (m1 intoWorldCount = 0).
	self assert: (m1 outOfWorldCount = 0).
	self assert: (m2 intoWorldCount = 0).
	self assert: (m2 outOfWorldCount = 0).

	morph addMorphFront: m1.
	m1 addMorphFront:  m2.
	self assert: (m1 intoWorldCount = 0).
	self assert: (m1 outOfWorldCount = 0).
	self assert: (m2 intoWorldCount = 0).
	self assert: (m2 outOfWorldCount = 0).

	morph openInWorld.
	self assert: (m1 intoWorldCount = 1).
	self assert: (m1 outOfWorldCount = 0).
	self assert: (m2 intoWorldCount = 1).
	self assert: (m2 outOfWorldCount = 0).

	morph addMorphFront: m2.
	self assert: (m1 intoWorldCount = 1).
	self assert: (m1 outOfWorldCount = 0).
	self assert: (m2 intoWorldCount = 1).
	self assert: (m2 outOfWorldCount = 0).

	morph addMorphFront: m1.
	self assert: (m1 intoWorldCount = 1).
	self assert: (m1 outOfWorldCount = 0).
	self assert: (m2 intoWorldCount = 1).
	self assert: (m2 outOfWorldCount = 0).

	m2 addMorphFront: m1.
	self assert: (m1 intoWorldCount = 1).
	self assert: (m1 outOfWorldCount = 0).
	self assert: (m2 intoWorldCount = 1).
	self assert: (m2 outOfWorldCount = 0).

	morph delete.
	self assert: (m1 intoWorldCount = 1).
	self assert: (m1 outOfWorldCount = 1).
	self assert: (m2 intoWorldCount = 1).
	self assert: (m2 outOfWorldCount = 1).
! !

!MorphTest methodsFor: 'running' stamp: 'StephaneDucasse 11/6/2009 17:55'!
tearDown
	morph delete.
	! !

!MorphTest methodsFor: 'testing - initialization' stamp: 'CamilloBruni 8/31/2013 20:23'!
testOpenInWorld
	morph openInWorld! !

!MorphTest methodsFor: 'testing - geometry' stamp: 'SeanDeNigris 2/5/2015 12:22'!
testBoundingBoxOfSubmorphs

	| subMorph |
	subMorph := morph copy
		topLeft: morph topLeft + 5;
		yourself.

	morph addMorph: subMorph.
	
	self assert: morph boundingBoxOfSubmorphs equals: subMorph bounds.
		! !

!MorphTest methodsFor: 'testing - into/outof world' stamp: 'ar 8/4/2003 00:11'!
testIntoWorldCollapseOutOfWorld
	| m1 m2 collapsed |
	"Create the guys"
	m1 := TestInWorldMorph new.
	m2 := TestInWorldMorph new.
	self assert: (m1 intoWorldCount = 0).
	self assert: (m1 outOfWorldCount = 0).
	self assert: (m2 intoWorldCount = 0).
	self assert: (m2 outOfWorldCount = 0).

	"add them to basic morph"
	morph addMorphFront: m1.
	m1 addMorphFront: m2.
	self assert: (m1 intoWorldCount = 0).
	self assert: (m1 outOfWorldCount = 0).
	self assert: (m2 intoWorldCount = 0).
	self assert: (m2 outOfWorldCount = 0).

	"open the guy"
	morph openInWorld.
	self assert: (m1 intoWorldCount = 1).
	self assert: (m1 outOfWorldCount = 0).
	self assert: (m2 intoWorldCount = 1).
	self assert: (m2 outOfWorldCount = 0).

	"collapse it"
	collapsed := 	CollapsedMorph new beReplacementFor: morph.
	self assert: (m1 intoWorldCount = 1).
	self assert: (m1 outOfWorldCount = 1).
	self assert: (m2 intoWorldCount = 1).
	self assert: (m2 outOfWorldCount = 1).

	"expand it"
	collapsed collapseOrExpand.
	self assert: (m1 intoWorldCount = 2).
	self assert: (m1 outOfWorldCount = 1).
	self assert: (m2 intoWorldCount = 2).
	self assert: (m2 outOfWorldCount = 1).

	"delete it"
	morph delete.
	self assert: (m1 intoWorldCount = 2).
	self assert: (m1 outOfWorldCount = 2).
	self assert: (m2 intoWorldCount = 2).
	self assert: (m2 outOfWorldCount = 2).
! !

!MorphTest methodsFor: 'testing - classification' stamp: 'md 4/16/2003 17:11'!
testIsMorph
	self assert: (morph isMorph).! !

!MorphTest methodsFor: 'testing - into/outof world' stamp: 'ar 8/4/2003 00:12'!
testIntoWorldDeleteOutOfWorld
	| m1 m2 |
	"Create the guys"
	m1 := TestInWorldMorph new.
	m2 := TestInWorldMorph new.
	self assert: (m1 intoWorldCount = 0).
	self assert: (m1 outOfWorldCount = 0).
	self assert: (m2 intoWorldCount = 0).
	self assert: (m2 outOfWorldCount = 0).

	morph addMorphFront: m1.
	m1 addMorphFront:  m2.
	self assert: (m1 intoWorldCount = 0).
	self assert: (m1 outOfWorldCount = 0).
	self assert: (m2 intoWorldCount = 0).
	self assert: (m2 outOfWorldCount = 0).

	morph openInWorld.
	self assert: (m1 intoWorldCount = 1).
	self assert: (m1 outOfWorldCount = 0).
	self assert: (m2 intoWorldCount = 1).
	self assert: (m2 outOfWorldCount = 0).

	morph delete.
	self assert: (m1 intoWorldCount = 1).
	self assert: (m1 outOfWorldCount = 1).
	self assert: (m2 intoWorldCount = 1).
	self assert: (m2 outOfWorldCount = 1).
	! !

!MorphTest methodsFor: 'running' stamp: 'tak 1/21/2005 11:12'!
setUp
	morph := Morph new! !

!MorphTest methodsFor: 'testing - geometry' stamp: 'Alexandre Bergel 8/2/2010 12:27'!
testExtent
	"
	self debug: #testExtent
	"
	| m1 m2 v1 v2 v3 b1 b2 |
	m1 := Morph new.
	m2 := Morph new.
	
	v1 := 100.000001.
	v2 := 100.000001000001.
	v3 := 100.000001000002.

	m1 extent: v1@v1.
	b1 := m1 bounds.
	
	m2 extent: v2@v3.
	b2 := m2 bounds.
	
	self assert: (b2 = b1).
! !

!MorphTreeAnnounce commentStamp: 'TorstenBergmann 9/5/2014 15:25'!
Announcements for morphic based trees!
!MorphTreeChangeRequest commentStamp: 'TorstenBergmann 9/5/2014 15:25'!
Used to announce a change request on the tree!
!MorphTreeChangeRequest methodsFor: 'accessing' stamp: 'AlainPlantec 5/27/2012 09:08'!
arguments
	^ arguments ifNil: [Array new]! !

!MorphTreeChangeRequest methodsFor: 'accessing' stamp: 'AlainPlantec 5/26/2012 19:12'!
action: aSymbol
	action := aSymbol! !

!MorphTreeChangeRequest methodsFor: 'accessing' stamp: 'AlainPlantec 5/27/2012 09:09'!
arguments: anArray
	arguments := anArray! !

!MorphTreeChangeRequest methodsFor: 'accessing' stamp: 'StephaneDucasse 3/2/2015 14:56'!
change: aTreeMorph
	action ifNil: [^self].
	aTreeMorph perform: action withEnoughArguments: self arguments! !

!MorphTreeChangeRequest class methodsFor: 'instance creation' stamp: 'AlainPlantec 5/26/2012 19:23'!
updateList
	^ self new action: #updateList! !

!MorphTreeChangeRequest class methodsFor: 'instance creation' stamp: 'AlainPlantec 5/27/2012 08:41'!
deselectAll
	^ self new action: #deselectAll! !

!MorphTreeChangeRequest class methodsFor: 'instance creation' stamp: 'AlainPlantec 10/17/2013 09:20'!
enabled
	^ self new action: #enabledFromModel! !

!MorphTreeChangeRequest class methodsFor: 'instance creation' stamp: 'AlainPlantec 5/27/2012 09:15'!
expandAll
	^ self new action: #expandAll! !

!MorphTreeChangeRequest class methodsFor: 'instance creation' stamp: 'AlainPlantec 10/18/2013 10:56'!
expandItemPath: anItemPath
	^ self new action: #expandItemPath:; arguments: (Array with: anItemPath)! !

!MorphTreeChangeRequest class methodsFor: 'instance creation' stamp: 'AlainPlantec 5/27/2012 10:03'!
selectItems: itemsList
	^ self new action: #selectItems:; arguments: (Array with: itemsList)! !

!MorphTreeChangeRequest class methodsFor: 'instance creation' stamp: 'AlainPlantec 5/27/2012 09:10'!
collapseAll
	^ self new action: #collapseAll! !

!MorphTreeChangeRequest class methodsFor: 'instance creation' stamp: 'AlainPlantec 5/27/2012 09:17'!
expandAllFromNode: aNode
	^ self new action: #expandAllFromNode:; arguments: (Array with: aNode)! !

!MorphTreeChangeRequest class methodsFor: 'instance creation' stamp: 'AlainPlantec 5/27/2012 08:37'!
updateSelectionFromModel
	^ self new action: #updateSelectionFromModel! !

!MorphTreeChangeRequest class methodsFor: 'instance creation' stamp: 'AlainPlantec 5/27/2012 11:01'!
pageSize: anInteger
	^ self new action: #pageSize:; arguments: (Array with: anInteger)! !

!MorphTreeChangeRequest class methodsFor: 'instance creation' stamp: 'AlainPlantec 5/27/2012 10:09'!
expandRoots
	^ self new action: #expandRoots! !

!MorphTreeChangeRequest class methodsFor: 'instance creation' stamp: 'AlainPlantec 6/3/2012 08:59'!
expandNodePath: aNodePath
	^ self new action: #expandNodePath:; arguments: (Array with: aNodePath)! !

!MorphTreeChangeRequest class methodsFor: 'instance creation' stamp: 'AlainPlantec 5/27/2012 11:02'!
chunkSize: anInteger
	^ self new action: #chunkSize:; arguments: (Array with: anInteger)! !

!MorphTreeChangeRequest class methodsFor: 'instance creation' stamp: 'AlainPlantec 5/27/2012 08:43'!
selectAll
	^ self new action: #selectAll! !

!MorphTreeChangeRequest class methodsFor: 'instance creation' stamp: 'AlainPlantec 10/17/2013 08:43'!
collapseNodePath: aNodePath
	^ self new action: #collapseNodePath:; arguments: (Array with: aNodePath) ! !

!MorphTreeChunkPager commentStamp: 'TorstenBergmann 9/5/2014 15:30'!
A chunk pager!
!MorphTreeChunkPager methodsFor: 'navigation' stamp: 'AlainPlantec 1/22/2010 23:18'!
nextPage
	| last |
	nextPageAllowed
		ifTrue: [[nextPageAllowed := false.
			pageSizeEditor
				ifNotNil: [pageSizeEditor acceptTextInModel].
			self changed: #pageSize.
			treeMorph scroller hasSubmorphs
				ifTrue: [last := treeMorph scroller lastSubmorph].
			self
				nextPage: (self lastIndex + pageSize min: self nodeList size).
			last
				ifNotNil: [| b1 b2 |
					b2 := (treeMorph bounds: treeMorph innerBounds in: self world) bottom - treeMorph vExtraScrollRange.
					b1 := last boundsInWorld bottom.
					treeMorph scrollBy: 0 @ (b2 - b1)].
			self buildPanel]
				ensure: [nextPageAllowed := true]] ! !

!MorphTreeChunkPager methodsFor: 'accessing' stamp: 'MarcusDenker 10/28/2010 14:03'!
computedHeightFromContents
	| h |
	h := 0.
	self submorphsDo: [:sm | h := h max: sm height].
	^ h max: (self preferedFont height + 8)
! !

!MorphTreeChunkPager methodsFor: 'navigation' stamp: 'AlainPlantec 1/21/2010 12:10'!
lastIndex
	^ lastIndex ifNil: [lastIndex := self pageSize]! !

!MorphTreeChunkPager methodsFor: 'navigation' stamp: 'AlainPlantec 1/21/2010 12:10'!
lastIndex: anIndex
	lastIndex := anIndex! !

!MorphTreeChunkPager methodsFor: 'initailize-release' stamp: 'AlainPlantec 1/23/2010 00:46'!
buildPanel
	| widgets nextButton lastPageButton  searchEditor |
	self removeAllMorphs.
	pageSize
		ifNil: [^ self].
	self atBottom: (((treeMorph scrollValue y <= self verticalScrollbarFrontier)) and: [treeMorph vIsScrollable]) not.
	widgets := OrderedCollection new.
	(self nodeList size > self lastIndex and: [self atBottom])
		ifTrue: [
			pageSizeEditor := self
					textEntryLabel: 'Page size'
					get: #pageSize
					set: #chunkSizeInput:
					help: 'Change the page size or the number of pages if the input begins with "/"' translated
					class: String.
			pageSizeEditor hResizing: #rigid.
			pageSizeEditor width: (self preferedFont  widthOfString: '10000').
			widgets add: pageSizeEditor.			
			nextButton := self
						buttonLabel: self class smallToRightIcon
						actionSelector: #nextPage
						arguments: {}
						getEnabled: #notOnLastPage
						help: 'Next page'.
			widgets add: nextButton.
			lastPageButton := self
					buttonLabel: self class smallToRightEndIcon
					actionSelector: #fullList
					arguments: {}
					getEnabled: #notOnLastPage
					help: 'Last page'.
			widgets add: lastPageButton.
			widgets add: (self spacer: 10)].
	self withSearch
			ifTrue: [searchEditor := self
						textEntryLabel: ''
						get: #pageSearchText
						set: #pageSearchText:
						help: 'Enter a text correspondig to your search' translated
						class: String.
			searchEditor ghostText: 'Searched text'.
			widgets add: searchEditor.
			widgets add: (self spacer: 10)].
	widgets add: (self spacer: 1).
	widgets add: (LabelMorph contents: (self lastIndex asString, ' / ', self nodeList size asString) font: self preferedFont).
	self addAllMorphs: widgets.
	self updateContents! !

!MorphTreeChunkPager methodsFor: 'testing' stamp: 'AlainPlantec 1/21/2010 11:44'!
notOnLastPage
	^ self onLastPage not! !

!MorphTreeChunkPager methodsFor: 'accessing' stamp: 'AlainPlantec 1/22/2010 10:59'!
atBottom: aBoolean
	atBottom ~= aBoolean 
		ifTrue: [atBottom := aBoolean]
! !

!MorphTreeChunkPager methodsFor: 'initailize-release' stamp: 'AlainPlantec 1/21/2010 21:54'!
updateContents
	treeMorph vIsScrollable 
		ifFalse: [self atBottom: true].
	super updateContents! !

!MorphTreeChunkPager methodsFor: 'navigation' stamp: 'SvenVanCaekenberghe 1/8/2012 14:46'!
chunkSizeInput: aString
	| input newPageSize |
	input := aString trimBoth.
	input ifEmpty: [treeMorph flash.
		^ false].
	newPageSize := Integer readFromString: input.
	newPageSize > 0 
		ifTrue: [self changePageSize: newPageSize.
			self nextPage.
			pageSizeEditor 
				ifNotNil: [pageSizeEditor takeKeyboardFocus]]
		ifFalse: [treeMorph flash.
			^ false].
	^ true! !

!MorphTreeChunkPager methodsFor: 'navigation' stamp: 'AlainPlantec 1/21/2010 21:42'!
fullList
	self lastIndex < self nodeList size
		ifTrue: [self nextPage: self nodeList size]! !

!MorphTreeChunkPager methodsFor: 'initialization' stamp: 'AlainPlantec 1/22/2010 16:17'!
initialize
	super initialize.
	nextPageAllowed := true! !

!MorphTreeChunkPager methodsFor: 'accessing' stamp: 'tg 1/21/2010 23:26'!
currentNodelist
	^ self nodeList copyFrom: 1 to: (self lastIndex min: self nodeList size)! !

!MorphTreeChunkPager methodsFor: 'accessing' stamp: 'AlainPlantec 1/22/2010 10:38'!
computedHeight 
	^ self nodeList size > self lastIndex 
		ifTrue: [super computedHeight ]
		ifFalse:[0]! !

!MorphTreeChunkPager methodsFor: 'testing' stamp: 'AlainPlantec 1/21/2010 12:10'!
onLastPage
	^ self lastIndex = self nodeList size! !

!MorphTreeChunkPager methodsFor: 'user interface' stamp: 'AlainPlantec 1/22/2010 10:57'!
verticalScrollbarFrontier
	^ 0.98! !

!MorphTreeChunkPager methodsFor: 'accessing' stamp: 'AlainPlantec 1/21/2010 11:44'!
atBottom
	^ atBottom ifNil: [atBottom := false]! !

!MorphTreeChunkPager methodsFor: 'user interface' stamp: 'MarcusDenker 9/13/2013 15:51'!
vScrollBarValue: scrollValue
	| old |
	old := atBottom.
	self atBottom: scrollValue >= self verticalScrollbarFrontier.
	old ~= atBottom
		ifTrue: [ self buildPanel ]! !

!MorphTreeChunkPager methodsFor: 'navigation' stamp: 'ThierryGoubier 2/8/2013 16:27'!
nextPage: newLast
	| addedNodeList |
	newLast > self lastIndex
		ifFalse: [ ^ self ].
	self lastIndex < self nodeList size
		ifTrue: [ 
			addedNodeList := self nodeList copyFrom: 1 to: newLast.
			self lastIndex: newLast.
			treeMorph scroller removeAllMorphs.
			treeMorph addSubmorphsFromNodeList: addedNodeList previouslyExpanded: treeMorph currentlyExpanded ]! !

!MorphTreeColumn commentStamp: 'TorstenBergmann 9/5/2014 15:25'!
A column in a morphic based tree!
!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 11/11/2009 09:47'!
container
	^ container! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 11/26/2009 11:29'!
defaultRowMorph
	^ Morph new color: Color red; borderWidth: 0; extent: 0@0; yourself
! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'BenjaminVanRyseghem 11/2/2013 17:32'!
rowMorphFor: aNode 
	| rowMorph |
	
	rowMorph := self rowMorphGetSelector
		ifNil: [aNode rowMorphForColumn: self]
		ifNotNil: [self rowMorphGetterBlock value: aNode value: self container].
	rowMorph := rowMorph asMorph.
	rowMorph
		ifNotNil: [rowMorph borderWidth: 0]
		ifNil: [rowMorph := self defaultRowMorph].
	^ rowMorph rowMorphForNode: aNode inColumn: self
! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 11/11/2009 10:16'!
startWidth: anInteger
	currentWidth := anInteger! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 11/9/2009 15:26'!
header
	^ header ifNil: [header :=  (Morph new extent: 0@0) color: Color transparent]! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 11/17/2009 18:52'!
color: aColor
	color := aColor! !

!MorphTreeColumn methodsFor: 'geometry' stamp: 'AlainPlantec 11/4/2009 21:52'!
height
	^ header ifNil: [0] ifNotNil: [header height]! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 2/1/2010 19:30'!
headerButtonLabel: aLabel font: aFont
	self headerButton.
	self header label: aLabel font: aFont.

! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 11/17/2009 19:11'!
isPotentialDropTarget
	^ isPotentialDropTarget ifNil: [isPotentialDropTarget := false]! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 1/31/2010 22:22'!
contentWidth
	| w |
	w := 0.
	self container allNodeMorphs do: [:n | w := w max: (n columnMorphAt: self index) width].
	^ w! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 11/9/2009 19:05'!
rowMorphGetSelector: aSelector
	rowMorphGetSelector := aSelector! !

!MorphTreeColumn methodsFor: 'testing' stamp: 'IgorStasenko 4/6/2011 16:31'!
isFirstColumn
	^ container columns first = self! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 2/1/2010 19:30'!
headerButtonLabel: aLabel font: aFont target: aReceiver actionSelector: aSelector arguments: aCollection
	self headerButton.
	self header label: aLabel font: aFont.
	self header actionSelector: aSelector.
	self header target: aReceiver.
	self header arguments: aCollection
	! !

!MorphTreeColumn methodsFor: 'accessing' stamp: 'StephaneDucasse 5/23/2013 18:40'!
thumbnailOfSize: thumbExtent
	"Answer a new thumbnail for the receiver."

	|f t r|
	r := self header fullBounds scaledAndCenteredIn: (0@0 extent: thumbExtent).
	f := Form extent: r extent depth: Display depth.
	t := MatrixTransform2x3 withScale: 1.0.
	f getCanvas
		transformBy: t
		clippingTo: f boundingBox
		during: [:c | c translateBy: self visibleBounds topLeft negated during: [:ct | self container fullDrawOn: ct]]
		smoothing: 6.
	^ImageMorph new
		form: f! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 11/11/2009 10:15'!
currentWidth
	^ currentWidth ifNil: [currentWidth := self defaultWidth]! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 1/27/2010 16:26'!
itemStringGetter: aSelectorOrAValuable
	rowMorphGetSelector := aSelectorOrAValuable isSymbol 
		ifTrue: [[:node | (node complexContents item perform: aSelectorOrAValuable) asMorph]]
		ifFalse: [[:node | (aSelectorOrAValuable value: node complexContents item) asMorph]]! !

!MorphTreeColumn methodsFor: 'accessing' stamp: 'AlainPlantec 11/12/2009 08:01'!
asDraggableMorph
	^ self thumbnailOfSize: self header fullBounds extent
	! !

!MorphTreeColumn methodsFor: 'initialize-release' stamp: 'AlainPlantec 11/3/2009 22:16'!
release
	container := nil.
	header := nil.
	super release.! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 11/11/2009 21:07'!
index
	^ self container columns indexOf: self! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 11/18/2009 11:48'!
shrinkWrap: aBoolean
	shrinkWrap := aBoolean! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 9/30/2011 17:10'!
headerButton
	self header: ((MorphTreeColumnButton new) 
		layoutPolicy: RowLayout new; 
		listDirection: #leftToRight; 
		wrapCentering: #center;
		cellInset: 5@0;
		layoutInset: 5@0;
		yourself)! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 2/2/2010 14:14'!
rowMorphGetterBlock
	^ self rowMorphGetSelector isSymbol
		ifTrue: [self rowMorphGetSelector numArgs = 0
				ifTrue: [[:node :cont | node perform: self rowMorphGetSelector]]
				ifFalse: [[:node :cont| node perform: self rowMorphGetSelector with: self container]]]
		ifFalse: [self rowMorphGetSelector numArgs = 2
				ifTrue: [self rowMorphGetSelector]
				ifFalse: [[:node :cont| self rowMorphGetSelector value: node]]] ! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'BenjaminVanRyseghem 11/2/2013 18:22'!
headerButtonLabel: aLabel icon: anIconForm
	self headerButtonLabel: aLabel font: nil.
	self header cellInset: 3@0.
	self header icon: (ImageMorph new form: anIconForm)! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'BenjaminVanRyseghem 11/2/2013 18:24'!
headerButtonLabel: aLabel font: aFont icon: anIconForm target: aReceiver actionSelector: aSelector arguments: aCollection
	self headerButton.
	self header label: aLabel font: aFont.
	self header icon: (ImageMorph new form: anIconForm).
	self header actionSelector: aSelector.
	self header target: aReceiver.
	self header arguments: aCollection! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 11/17/2009 19:12'!
asPotentialDropTarget
	isPotentialDropTarget := true.
	self container invalidRect: self visibleBounds! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 11/3/2009 16:38'!
container: aTreeMorph
	container := aTreeMorph! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 11/18/2009 10:22'!
currentWidth: anInteger
	self resizable ifTrue: [currentWidth := anInteger]! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 11/17/2009 19:13'!
noMorePotentialDropTarget
	isPotentialDropTarget := false.
	self container invalidRect: self visibleBounds! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 11/18/2009 09:52'!
resizable
	^ resizable ifNil: [resizable := true]! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 11/18/2009 09:53'!
resizable: aBoolean
	resizable := aBoolean! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 11/17/2009 18:54'!
dataBounds 
	^ self visibleBounds withTop: self container topHeader bottom! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 11/12/2009 07:57'!
visibleBounds
	^ self header bounds withBottom: self container scroller bottom! !

!MorphTreeColumn methodsFor: 'testing' stamp: 'AlainPlantec 1/23/2010 12:37'!
isLastColumn
	^ container columns last = self! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 1/27/2010 16:28'!
itemMorphGetter: aSelectorOrAValuable
	rowMorphGetSelector := aSelectorOrAValuable isSymbol 
		ifTrue: [[:node | node complexContents item perform: aSelectorOrAValuable]]
		ifFalse: [[:node | aSelectorOrAValuable value: node complexContents item]]! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 11/11/2009 20:55'!
header: aMorph
	header := aMorph clipSubmorphs: true; yourself.
	header model: self! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 11/18/2009 11:48'!
shrinkWrap
	^ shrinkWrap ifNil: [shrinkWrap := false]! !

!MorphTreeColumn methodsFor: 'accessing' stamp: 'AlainPlantec 10/3/2011 09:59'!
nodeStringGetter: aSelectorOrAValuable
	rowMorphGetSelector := aSelectorOrAValuable isSymbol 
		ifTrue: [[:node | (node complexContents perform: aSelectorOrAValuable) asMorph]]
		ifFalse: [[:node | (aSelectorOrAValuable value: node complexContents ) asMorph]]! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 11/11/2009 10:15'!
defaultWidth
	^ 100! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 11/17/2009 19:44'!
color 
	^ color ifNil: [self container columnColors at: ((self index \\ 2) + 1)]! !

!MorphTreeColumn methodsFor: 'converting' stamp: 'AlainPlantec 11/18/2009 10:07'!
drawColumnOn: aCanvas
	self isPotentialDropTarget 
		ifTrue: [aCanvas 
					frameAndFillRectangle: self dataBounds 
					fillColor: ((Color gray alpha: 0.1) alphaMixed: 0.9 with: (self color ifNotNil: [:c | c asColor] ifNil: [Color transparent]))
					borderWidth: 2 
					borderColor: Color gray]
		ifFalse: [self color 
						ifNotNil: [:c | 
							c isColor 
								ifTrue: [
									aCanvas 
										frameAndFillRectangle: self dataBounds 
										fillColor: self color
										borderWidth: 0 
										borderColor: Color transparent]
								ifFalse: [c origin: self dataBounds topLeft.
									c direction: 0@self dataBounds height.
									aCanvas fillRectangle: self dataBounds  basicFillStyle: c]]]! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 11/9/2009 19:04'!
rowMorphGetSelector
	^ rowMorphGetSelector! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 11/18/2009 10:47'!
forceWidthTo: anInteger
	currentWidth := anInteger! !

!MorphTreeColumn methodsFor: 'column drawing' stamp: 'AlainPlantec 11/18/2009 10:22'!
fixedWidth: anInteger
	currentWidth := anInteger.
	resizable := false! !

!MorphTreeColumnButton commentStamp: 'TorstenBergmann 9/5/2014 15:26'!
A button in a morphic based tree!
!MorphTreeColumnButton methodsFor: 'dropping/grabbing' stamp: 'AlainPlantec 11/12/2009 07:09'!
mouseUp: evt
	self noMorePotentialDropTarget.
	super mouseUp: evt! !

!MorphTreeColumnButton methodsFor: 'testing' stamp: 'MarcusDenker 3/26/2015 15:03'!
isDefault
	^true! !

!MorphTreeColumnButton methodsFor: 'accessing' stamp: 'AlainPlantec 11/17/2009 19:05'!
asPotentialDropTarget 
	self model asPotentialDropTarget! !

!MorphTreeColumnButton methodsFor: 'accessing' stamp: 'AlainPlantec 11/17/2009 19:05'!
noMorePotentialDropTarget
	self model noMorePotentialDropTarget! !

!MorphTreeColumnButton methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/16/2013 12:28'!
wantsDroppedMorph: aMorph event: anEvent 
	^ model container columnDropUnabled and: [(aMorph isTransferable) and: [(aMorph passenger isKindOf: MorphTreeColumn) and: [aMorph passenger ~= self model]]]! !

!MorphTreeColumnButton methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/8/2013 19:08'!
icon: anIcon
	
	icon ifNotNil: [ self removeMorph: icon ].
	
	anIcon ifNotNil: [
		icon := anIcon.
		self addMorphFront: anIcon ]! !

!MorphTreeColumnButton methodsFor: 'initialization' stamp: 'AlainPlantec 11/11/2009 20:56'!
model
	^ model! !

!MorphTreeColumnButton methodsFor: 'initialization' stamp: 'TudorGirba 3/11/2015 08:34'!
initialize
	super initialize.
	self enableDragNDrop: true.
	self fillStyle: (Smalltalk ui theme morphTreeColumnFillStyleFor: self).
	self borderStyle: (Smalltalk ui theme morphTreeColumnBorderStyleFor: self)
! !

!MorphTreeColumnButton methodsFor: 'dropping/grabbing' stamp: 'AlainPlantec 11/17/2009 19:05'!
mouseEnterDragging: evt
	(evt hand hasSubmorphs and:[self dropEnabled]) ifFalse: ["no d&d"
		^ super mouseEnterDragging: evt].
	(self wantsDroppedMorph: evt hand firstSubmorph event: evt )
		ifTrue:[
			self asPotentialDropTarget.
		].! !

!MorphTreeColumnButton methodsFor: 'event handling' stamp: 'AlainPlantec 11/11/2009 19:53'!
mouseDown: anEvent
	| selectors |
	selectors := Array 
		with: #click:
		with: nil
		with: nil
		with: (self dragEnabled ifTrue:[#startDrag:] ifFalse:[nil]).
	anEvent hand waitForClicksOrDrag: self event: anEvent selectors: selectors threshold: 10.
	super mouseDown: anEvent! !

!MorphTreeColumnButton methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/8/2013 20:17'!
removeIcon
	
	icon ifNotNil: [ self removeMorph: icon ].! !

!MorphTreeColumnButton methodsFor: 'accessing' stamp: 'AlainPlantec 11/12/2009 12:17'!
acceptDroppingMorph: aMorph event: evt
	self model container swapColumn: self model withColumn: aMorph passenger.
	evt hand releaseMouseFocus: self.
	self noMorePotentialDropTarget.
	self model container changed.
	Cursor normal show.
! !

!MorphTreeColumnButton methodsFor: 'dropping/grabbing' stamp: 'AlainPlantec 11/12/2009 07:09'!
mouseLeaveDragging: evt
	self noMorePotentialDropTarget ! !

!MorphTreeColumnButton methodsFor: 'dropping/grabbing' stamp: 'AlainPlantec 11/12/2009 06:58'!
handlesMouseOverDragging: evt
	^ true! !

!MorphTreeColumnButton methodsFor: 'initialization' stamp: 'AlainPlantec 11/11/2009 20:56'!
model: anObject
	model := anObject! !

!MorphTreeColumnButton methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 5/16/2013 12:23'!
startDrag: anEvent
	| aTransferMorph |
	self dragEnabled ifFalse: [^ self].
	(anEvent hand hasSubmorphs)
		ifTrue: [^ self].
	oldColor 
		ifNotNil: [
			self fillStyle: oldColor.
			oldColor := nil].
	aTransferMorph := self model transferFor: self model from: self.
	aTransferMorph align: aTransferMorph draggedMorph center with: anEvent position.
	anEvent hand grabMorph: aTransferMorph.
	anEvent hand releaseMouseFocus: self! !

!MorphTreeColumnButton methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/2/2013 18:20'!
icon

	^ icon! !

!MorphTreeListManager commentStamp: 'TorstenBergmann 9/5/2014 15:30'!
A manager caring about a morphic based tree!
!MorphTreeListManager methodsFor: 'client list accessing' stamp: 'AlainPlantec 10/7/2011 23:41'!
numSelectionsInView
	^ client numSelectionsInView! !

!MorphTreeListManager methodsFor: 'selection accessing' stamp: 'AlainPlantec 10/8/2011 23:50'!
selectedMorphList
	^ selectedMorphList ifNil: [selectedMorphList := LinkedList new]! !

!MorphTreeListManager methodsFor: 'mouse managing' stamp: 'BenjaminVanRyseghem 12/5/2013 14:05'!
mouseDown: event on: aTargetMorph
	"Changed to take keybaord focus."
	| clickedTheCheckbox |
	
	clickedTheCheckbox := self clicked: event inTheCheckboxOf: aTargetMorph.
	
	(self autoMultiSelection and: [ event shiftPressed not ])
		ifTrue: [ 
			firstClickedMorph := aTargetMorph.
			aTargetMorph selected
				ifTrue: [ 
					self removeFromSelection: aTargetMorph.
					(clickedTheCheckbox not and: [ self selectOnlyLastHighlighted and: [ aTargetMorph hasContentToShow ] ])
						ifTrue: [ 
							aTargetMorph = self lastClickedMorph
								ifFalse: [ self addToSelection: aTargetMorph ] ] ]
				ifFalse: [ 
					(clickedTheCheckbox not and: [ self selectOnlyLastHighlighted and: [ aTargetMorph hasContentToShow ] ])
						ifTrue: [ 
							aTargetMorph = self lastClickedMorph
								ifTrue: [ 
									self addToSelection: aTargetMorph.
									clickedTheCheckbox
										ifFalse: [ self lastClickedMorph: aTargetMorph ] ] ]
						ifFalse: [ 
							self addToSelection: aTargetMorph.
							clickedTheCheckbox
								ifFalse: [ self lastClickedMorph: aTargetMorph ] ] ] ].
	
	(clickedTheCheckbox not and: [ event shiftPressed not or: [ firstClickedMorph isNil ] ])
		ifTrue: [ firstClickedMorph := aTargetMorph ].
	
	aTargetMorph mouseDown: event! !

!MorphTreeListManager methodsFor: 'keyboard managing' stamp: 'EstebanLorenzano 11/26/2013 13:29'!
keyStroke: anEvent
	| char args |

	char := anEvent keyValue asCharacter. 

	(self arrowEvent: anEvent key: char)
		ifTrue: [ ^ true ].

	char = Character cr
		ifTrue: [ 
			self selectSearchedElement. 
			^ true ].
		
	anEvent anyModifierKeyPressed 
		ifFalse: [
			self basicKeyPressed: char.
			^ true].

	self keystrokeActionSelector 
		ifNil: [ ^ false].
		
	args := self keystrokeActionSelector numArgs.
	(args = 0 or: [args > 2]) 
		ifTrue: [^ self error: 'The keystrokeActionSelector must be a 1- or 2-keyword symbol']
		ifFalse: [
			^ args = 1 
				ifTrue: [
					self listModel 
						perform: self keystrokeActionSelector 
						with: anEvent]
				ifFalse: [
					self listModel 
						perform: self keystrokeActionSelector
						with: anEvent 
						with: self]]! !

!MorphTreeListManager methodsFor: 'selection change' stamp: 'AlainPlantec 10/7/2011 16:54'!
selectionUpdateFromViewWhile: aBlock
	| prev |
	prev := self isSelectionUpdateFromView.
	isSelectionUpdateFromView := true.
	aBlock ensure: [isSelectionUpdateFromView := prev]
! !

!MorphTreeListManager methodsFor: 'selection change' stamp: 'BenjaminVanRyseghem 11/21/2013 18:02'!
selectMorph: aNodeMorph multiple: withMultipleSelection 
	| path mult |
	self lastClickedMorph: aNodeMorph.
	aNodeMorph isNil
		ifTrue: [
			self emptySelection.
			^ nil].
	aNodeMorph selected
		ifTrue: [
			withMultipleSelection
				ifTrue: [self removeFromSelection: aNodeMorph]
				ifFalse: [
					mult := self selectedMorphList size > 1.
					path := aNodeMorph path collect: [:m | m complexContents].
					(self autoDeselection or: [mult])
						ifTrue: [
							self emptySelection.
							mult 
								ifTrue: [self addToSelection: aNodeMorph]
								ifFalse: [path := nil]]]]
		ifFalse: [
			withMultipleSelection
				ifFalse: [self emptySelection].
			self addToSelection: aNodeMorph.
			path := aNodeMorph path collect: [:m | m complexContents]].
	self selectionChanged.
	^ path! !

!MorphTreeListManager methodsFor: 'selection change' stamp: 'ThierryGoubier 10/1/2012 13:22'!
removeFromSelection: aMorph
	aMorph selected ifFalse: [^false].
	aMorph selected: false.
	aMorph unhighlight.
	self selectionUpdateFromViewWhile: [ | selHolder | 
		selHolder := self newSelectionHolderWithNodePath: nil.
		self listModel selection: selHolder].
	^ true
! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 14:59'!
lastClickedMorph

	^ lastClickedMorph! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 14:59'!
firstClickedMorph

	^ firstClickedMorph! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 14:59'!
columnDropUnabled

	^ columnDropUnabled! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 16:05'!
listModel
	^ client model! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 22:49'!
removeOnlyLastSelected: aBoolean

	removeOnlyLastSelected := aBoolean! !

!MorphTreeListManager methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 11/21/2013 22:48'!
initialize
	super initialize.
	lastKeystrokeTime := 0.
	lastKeystrokes := ''.
	lastSelection := 0.
	removeOnlyLastSelected := false! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 16:11'!
isMultiple	
	^ multipleSelection ifNil: [ multipleSelection := false ]! !

!MorphTreeListManager methodsFor: 'selection change' stamp: 'BenjaminVanRyseghem 11/21/2013 18:02'!
setSelectedMorph: aMorph
	| path |
	path := aMorph ifNotNil: [ aMorph path collect: [ :m | m complexContents ] ].
	self lastClickedMorph: aMorph.
	self emptySelection.
	aMorph 
		ifNotNil: [ self addToSelection: lastClickedMorph ].
	self selectionUpdateFromViewWhile: [ 
			self listModel selection: (self newSelectionHolderWithNodePath: path) ]! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 14:59'!
columnDropUnabled: aBoolean

	columnDropUnabled := aBoolean! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 16:24'!
autoMultiSelection: aBoolean
	autoMultiSelection := aBoolean.
	aBoolean ifTrue: [self multipleSelection: true]! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 15:00'!
firstClickedMorph: aNodeMorph

	firstClickedMorph := aNodeMorph! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 17:11'!
autoDeselection
	^ autoDeselection
		ifNil: [autoDeselection := false]! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 14:59'!
potentialDropMorph

	^ potentialDropMorph! !

!MorphTreeListManager methodsFor: 'selection change' stamp: 'AlainPlantec 10/7/2011 16:55'!
isSelectionUpdateFromView
	^ isSelectionUpdateFromView ifNil: [isSelectionUpdateFromView := false] ! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 15:00'!
keystrokeActionSelector: aSelectorOrBlock

	keystrokeActionSelector := aSelectorOrBlock! !

!MorphTreeListManager methodsFor: 'selection change' stamp: 'BenjaminVanRyseghem 11/21/2013 18:03'!
shiftSelectMorph: aNodeMorph 
	| m |
	m := aNodeMorph ifNil: [self allNodeMorphs last].
	self emptySelection.
	self searchedElement: nil.
	self 
		from: firstClickedMorph 
		to: m 
		do: [:nd | self addToSelection: nd]. 
	self lastClickedMorph: m.
	^ m path collect: [:p | p complexContents]! !

!MorphTreeListManager methodsFor: 'selection change' stamp: 'AlainPlantec 10/8/2011 23:49'!
emptySelection 
	self selectedMorphList do: [:n | n unhighlight; setSelectedSilently: false].
	self selectedMorphList removeAll.
	self selectionChanged
! !

!MorphTreeListManager methodsFor: 'keyboard managing' stamp: 'BenjaminVanRyseghem 11/21/2013 18:03'!
setSelectionIndexFromKeyboard: index multiSelection: multiSelect event: anEvent
	"Called internally to select the index-th item."
	| targetMorph |
	index ifNil: [^ self].
	index > self allNodeMorphs size ifTrue: [^self].
	targetMorph := index = 0 ifTrue: [nil] ifFalse: [self allNodeMorphs at: index].
	lastClickedMorph ifNotNil: [lastClickedMorph highlightForMouseDown: false].
	self isCheckList
		ifTrue: [
			(multiSelect and: [anEvent shiftPressed])
				ifTrue: [self autoMultiSelect: targetMorph]]
		ifFalse: [
			(multiSelect and: [anEvent shiftPressed])
				ifTrue: [self autoMultiSelect: targetMorph]
				ifFalse: [self setSelectedMorph: targetMorph]].
	self lastClickedMorph: (firstClickedMorph := targetMorph).
	anEvent shiftPressed
		ifTrue: [lastClickedMorph highlightForMouseDown: true].

	self selectionChanged.
	self scrollToShow: targetMorph
	
! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 14:59'!
lastKeystrokes

	^ lastKeystrokes! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 14:59'!
searchedElement

	^ searchedElement! !

!MorphTreeListManager methodsFor: 'mouse managing' stamp: 'BenjaminVanRyseghem 12/5/2013 13:22'!
mouseUp: event on: aNodeMorph 
	| path cmdOrCtrl clickedTheCheckbox |
	"No change if model is locked" 
	
	clickedTheCheckbox := self clicked: event inTheCheckboxOf: aNodeMorph.
	self listModel okToChange ifFalse: [^self].
	self listModel okToDiscardEdits ifFalse: [^ self].

	cmdOrCtrl := self commandOrCrontrolKeyPressed: event.
	
	path := (event shiftPressed and: [self isMultiple])
				ifTrue: [self shiftSelectMorph: aNodeMorph]
				ifFalse: [
					self autoMultiSelection
						ifTrue: [self selectedMorphList ifEmpty: [] ifNotEmpty: [:l | l last path collect: [:p | p complexContents]]]
						ifFalse: [self selectMorph: aNodeMorph multiple: ((cmdOrCtrl and: [self isMultiple]) or: [self autoMultiSelection]) clickedTheCheckBox: clickedTheCheckbox ]].
	self selectionUpdateFromViewWhile: [ | selHolder | 
		selHolder := self newSelectionHolderWithNodePath: path.
		self listModel selection: selHolder].
	
	clickedTheCheckbox ifFalse: [ self lastClickedMorph: aNodeMorph ].
	self selectionChanged. 
! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 17:35'!
isCheckList: aBoolean
	isCheckList := aBoolean! !

!MorphTreeListManager methodsFor: 'keyboard managing' stamp: 'EstebanLorenzano 11/26/2013 13:11'!
basicKeyPressed: aChar 
	| nextSelection oldSelection milliSeconds slowKeyStroke nextSelectionNodeMorph |
	
	(aChar == Character space and: [ lastClickedMorph notNil ])
		ifTrue: [
			self 
				selectMorph: lastClickedMorph 
				multiple: (self isMultiple or: [self autoMultiSelection]).
			self selectionUpdateFromViewWhile: [ | selHolder | 
				selHolder := self newSelectionHolderWithNodePath: lastClickedMorph complexContents path.
				self listModel selection: selHolder]].
		
	nextSelection := oldSelection := lastSelection.
	milliSeconds := Time millisecondClockValue.
	slowKeyStroke := milliSeconds - lastKeystrokeTime > 500.
	lastKeystrokeTime := milliSeconds.
	
	self searchedElement: nil.
	
	slowKeyStroke
		ifTrue: ["forget previous keystrokes and search in following elements"
			lastKeystrokes := aChar asLowercase asString.]
		ifFalse: ["append quick keystrokes but don't move selection if it still matches"
			lastKeystrokes := lastKeystrokes , aChar asLowercase asString.].
	"Get rid of blanks and style used in some lists"
	nextSelectionNodeMorph := self allNodeMorphs
		detect: [:a | a complexContents asString trimBoth asLowercase beginsWith: lastKeystrokes]
		ifNone: [^ self ].
	nextSelection := nextSelectionNodeMorph index.
	"No change if model is locked"
	self listModel okToChange ifFalse: [^ self].
	self searchedElement: nextSelectionNodeMorph.

	lastSelection := nextSelection.
	"change scrollbarvalue"
	self scrollToShow: nextSelectionNodeMorph.
	self selectionChanged! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 15:42'!
client: aMorphList
	client := aMorphList! !

!MorphTreeListManager methodsFor: 'selection change' stamp: 'NicolaiHess 2/11/2014 23:02'!
selectedItems: aNodeItemCollection
	self listModel okToDiscardEdits ifFalse: [^ self].
	self emptySelection.
	(self nodeMorphsWithAllNodeItems: aNodeItemCollection) ifNotEmpty:[:selection |
	self addAllToSelection: selection].
	lastClickedMorph
		ifNil: [lastClickedMorph := self selectedMorphList
						ifEmpty: []
						ifNotEmpty: [self selectedMorphList last]]! !

!MorphTreeListManager methodsFor: 'selection change' stamp: 'AlainPlantec 10/7/2011 16:56'!
newSelectionHolderWithNodePath: aNodePath 
	^ self isMultiple
		ifTrue: [MorphTreeMorphMultipleSelection new
				selectedNodePathList: (self selectedMorphList
						collect: [:s | s path	collect: [:m | m complexContents]])] 
		ifFalse: [MorphTreeMorphSingleSelection new selectedNodePath: aNodePath]! !

!MorphTreeListManager methodsFor: 'selection change' stamp: 'ThierryGoubier 7/23/2014 10:39'!
noteRemovalOfAll: aMorphList
	"When noting the removal of items, do not change their model status: the model will be in charge of it (i.e. either updates from the model or expand/collapse things)."

	aMorphList
		do: [ :each | 
			self selectedMorphList remove: each ifAbsent: [  ].
			lastClickedMorph == each
				ifTrue: [ lastClickedMorph := nil ] ]! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/21/2013 18:22'!
lastClickedMorph: aNodeMorph

	lastClickedMorph ifNotNil: [ lastClickedMorph complexContents lastClicked: false ].
	lastClickedMorph := aNodeMorph.
	aNodeMorph ifNotNil: [ aNodeMorph complexContents lastClicked: true ].! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 17:19'!
multipleSelection

	^ multipleSelection ifNil: [multipleSelection := false]! !

!MorphTreeListManager methodsFor: 'mouse managing' stamp: 'AlainPlantec 10/7/2011 23:09'!
mouseMove: evt on: aTargetMorph

	(aTargetMorph isNil or: [aTargetMorph highlightedForMouseDown not])
		ifTrue: [self allNodeMorphs do: [:m |
				m highlightedForMouseDown ifTrue: [m highlightForMouseDown: false]].
				aTargetMorph ifNotNil: [aTargetMorph highlightForMouseDown.
				(self autoMultiSelection and: [evt shiftPressed not])
					ifTrue: [
						self autoMultiSelect: aTargetMorph.
						self selectionChanged]]]! !

!MorphTreeListManager methodsFor: 'mouse managing' stamp: 'BenjaminVanRyseghem 12/6/2013 19:01'!
clicked: event inTheCheckboxOf: aTargetMorph
	| position |

	aTargetMorph ifNil: [ ^ false ].
	position := aTargetMorph point: event position from: client.
	^ self isCheckList and: [ (aTargetMorph checkClickableZone translateBy: 2 @ 0) containsPoint: position ]! !

!MorphTreeListManager methodsFor: 'selection change' stamp: 'NicolaiHess 2/7/2014 00:39'!
selectAll
	self allNodeMorphs isEmpty
		ifTrue: [^ self].
	self isMultiple
		ifFalse: [^ self]. 
	self addAllToSelection: self allNodeMorphs! !

!MorphTreeListManager methodsFor: 'client list accessing' stamp: 'AlainPlantec 10/7/2011 23:41'!
allNodeMorphs
	^ client allNodeMorphs! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 18:08'!
getSelectionIndexOf: aMorph
	^ aMorph ifNil: [0] ifNotNil: [aMorph index]! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 14:59'!
lastKeystrokeTime: anObject

	lastKeystrokeTime := anObject! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 14:59'!
lastSelection

	^ lastSelection! !

!MorphTreeListManager methodsFor: 'private' stamp: 'EstebanLorenzano 11/26/2013 13:38'!
selectSearchedElement

	self searchedElement 
		ifNotNil: [ :selectedMorph | 
			self setSelectedMorph: selectedMorph.
			self searchedElement: nil ]! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 14:59'!
autoDeselection: aBoolean

	autoDeselection := aBoolean! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 14:59'!
potentialDropMorph: anObject

	potentialDropMorph := anObject! !

!MorphTreeListManager methodsFor: 'selection change' stamp: 'AlainPlantec 10/7/2011 23:09'!
from: aNodeMorph to: anotherNodeMorph do: action
	| idx1 idx2 |
	idx1 := ((self getSelectionIndexOf: aNodeMorph) min: self allNodeMorphs size) max: 1.
	idx2 := ((self getSelectionIndexOf: anotherNodeMorph) min: self allNodeMorphs size) max: 1.
	(idx1 min: idx2) to: (idx1 max: idx2) do: [:idx | action value: (self allNodeMorphs at: idx)]
! !

!MorphTreeListManager methodsFor: 'selection change' stamp: 'BenjaminVanRyseghem 11/26/2013 10:12'!
silentlySetSelectedMorph: aMorph
	| path |
	
	path := aMorph ifNotNil: [ aMorph path collect: [ :m | m complexContents ] ].
	self isMultiple ifFalse: [ self emptySelection ].
	
	aMorph ifNotNil: [ self addToSelection: aMorph ].
	
	self selectionUpdateFromViewWhile: [ 
			self listModel selection: (self newSelectionHolderWithNodePath: path) ]! !

!MorphTreeListManager methodsFor: 'selection change' stamp: 'AlainPlantec 10/7/2011 22:48'!
autoAction
	^ firstClickedMorph
		ifNotNil: [
			firstClickedMorph selected
				ifTrue: [#addToSelection:]
				ifFalse: [#removeFromSelection:]]. 
	! !

!MorphTreeListManager methodsFor: 'client list accessing' stamp: 'AlainPlantec 10/7/2011 23:22'!
scrollToShow: aRectangle
	client scrollToShow: aRectangle! !

!MorphTreeListManager methodsFor: 'selection change' stamp: 'AlainPlantec 10/7/2011 23:10'!
selectMoreAtTop
	| first |
	autoTargetMorph ifNil: [^self].
	first := autoTargetMorph index.
	first > 1
		ifTrue: [
			self autoMultiSelect: (self allNodeMorphs at: first - 1).
			self selectionChanged]! !

!MorphTreeListManager methodsFor: 'selection change' stamp: 'NicolaiHess 2/7/2014 00:39'!
addAllToSelection: aCollection
| selHolder |
	self searchedElement: nil.
	aCollection do: [:m | m 
		highlight;
		selected: true ].
	self selectionChanged.
	self selectionUpdateFromViewWhile: [
		selHolder := self newSelectionHolderWithNodePath: (aCollection last path collect: [:m | m complexContents]).
		self listModel selection: selHolder]
! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 14:59'!
multipleSelection: anObject

	multipleSelection := anObject! !

!MorphTreeListManager methodsFor: 'selection accessing' stamp: 'StephaneDucasse 6/19/2014 08:25'!
secondSelection: anItem

 	| nodeMorph |
	nodeMorph := self allNodeMorphs detect: [ :e | e complexContents item == anItem ].
	self searchedElement: nodeMorph.
	client changed.! !

!MorphTreeListManager methodsFor: 'selection change' stamp: 'BenjaminVanRyseghem 12/5/2013 13:21'!
addToSelection: aMorph clickedTheCheckBox: checkBox
	aMorph selected ifTrue: [^false].
	self searchedElement: nil.
	checkBox ifFalse: [ aMorph highlight ].
	aMorph selected: true.
	^ true! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 14:59'!
lastKeystrokeTime

	^ lastKeystrokeTime! !

!MorphTreeListManager methodsFor: 'selection change' stamp: 'AlainPlantec 10/8/2011 22:06'!
deselectAll
	| selHolder |
	self allNodeMorphs isEmpty
		ifTrue: [^ self].
	self emptySelection.
	self selectionUpdateFromViewWhile: [
		selHolder := self newSelectionHolderWithNodePath: nil.
		self listModel selection: selHolder]

! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 14:59'!
lastKeystrokes: anObject

	lastKeystrokes := anObject! !

!MorphTreeListManager methodsFor: 'selection change' stamp: 'AlainPlantec 10/8/2011 01:04'!
autoMultiSelect: aTargetMorph
	autoTargetMorph := aTargetMorph.
	self autoAction
		ifNotNil: [:act |
			self
				from: firstClickedMorph
				to: aTargetMorph
				do: [:nd | self perform: act with: nd].
			self selectionUpdateFromViewWhile: [ | selHolder | 
				selHolder := self newSelectionHolderWithNodePath: nil.
				self listModel selection: selHolder].
			self selectionChanged.
			self scrollToShow: aTargetMorph bounds]! !

!MorphTreeListManager methodsFor: 'mouse managing' stamp: 'AlainPlantec 10/8/2011 14:15'!
doubleClick: anEvent on: aMorph
	doubleClickBlock ifNil: [^false].
	doubleClickBlock value.
	^ true! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 14:59'!
keystrokeActionSelector

	^ keystrokeActionSelector! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 14:59'!
lastSelection: anObject

	lastSelection := anObject! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 14:59'!
searchedElement: anObject

	searchedElement := anObject! !

!MorphTreeListManager methodsFor: 'selection change' stamp: 'AlainPlantec 10/7/2011 17:02'!
updateSelectionFromModel
	(self listModel selection) 
		ifNotNil: [:selHolder | 	
				self isSelectionUpdateFromView
					ifTrue: [
						self listModel selectionChanged.
						self selectionChanged]
					ifFalse: [selHolder updateView: client forModel: self listModel]].
! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 16:18'!
autoMultiSelection
	^ autoMultiSelection ifNil: [autoMultiSelection := false]! !

!MorphTreeListManager methodsFor: 'client list accessing' stamp: 'AlainPlantec 10/7/2011 23:24'!
commandOrCrontrolKeyPressed: anEvent
	^ client commandOrCrontrolKeyPressed: anEvent! !

!MorphTreeListManager methodsFor: 'selection change' stamp: 'AlainPlantec 10/7/2011 23:15'!
toggleExpandedState: aMorph
	aMorph toggleExpandedState.
	client innerWidgetChanged

! !

!MorphTreeListManager methodsFor: 'selection change' stamp: 'AlainPlantec 10/7/2011 21:51'!
addToSelection: aMorph
	aMorph selected ifTrue: [^false].
	self searchedElement: nil.
	aMorph highlight.
	aMorph selected: true.
	^ true! !

!MorphTreeListManager methodsFor: 'selection change' stamp: 'BenjaminVanRyseghem 12/5/2013 13:21'!
selectMorph: aNodeMorph multiple: withMultipleSelection clickedTheCheckBox: checkBox
	| path mult |
	
	checkBox ifFalse: [ self lastClickedMorph: aNodeMorph ].
	aNodeMorph isNil
		ifTrue: [
			self emptySelection.
			^ nil].
	aNodeMorph selected
		ifTrue: [
			withMultipleSelection
				ifTrue: [self removeFromSelection: aNodeMorph]
				ifFalse: [
					mult := self selectedMorphList size > 1.
					path := aNodeMorph path collect: [:m | m complexContents].
					(self autoDeselection or: [mult])
						ifTrue: [
							self emptySelection.
							mult 
								ifTrue: [self addToSelection: aNodeMorph]
								ifFalse: [path := nil]]]]
		ifFalse: [
			withMultipleSelection
				ifFalse: [self emptySelection].
			self addToSelection: aNodeMorph clickedTheCheckBox: checkBox.
			path := aNodeMorph path collect: [:m | m complexContents]].
	self selectionChanged.
	^ path! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 17:35'!
isCheckList
	^ isCheckList ifNil: [isCheckList := false]! !

!MorphTreeListManager methodsFor: 'keyboard managing' stamp: 'NicolaiHess 8/4/2014 08:45'!
arrowEvent: event key: aChar 
	"Handle a keyboard navigation character. Answer true if handled, false
	if not."
	| newIndex targetMorph targetIndex multi |
	
	self allNodeMorphs ifEmpty: [ ^ false].
	self listModel okToChange ifFalse: [^ false].
	self listModel okToDiscardEdits ifFalse: [^ false].

	newIndex := nil.
	targetMorph := lastClickedMorph.
	"Give the oportunity to model to handle the keystroke event. 
	 This is an ugly HACK due to the lack of proper key handling... but I can live with it for now"
	targetMorph ifNotNil: [  
		(self listModel arrowEvent: event key: aChar target: targetMorph)
			ifTrue:  [ ^  true ]].

	targetIndex := targetMorph
		ifNil: [ 0 ]
		ifNotNil: [ targetMorph index ].
	multi := (event shiftPressed and: [self isMultiple]) or: [self autoMultiSelection].
	aChar = Character arrowDown
		ifTrue: [newIndex := targetIndex + 1].
	aChar = Character arrowUp
		ifTrue: [newIndex := targetIndex - 1 max: 1].
	aChar = Character home
		ifTrue: [newIndex := 1].
	aChar = Character end
		ifTrue: [newIndex := self allNodeMorphs size].
	aChar = Character pageUp
		ifTrue: [newIndex := targetIndex - self numSelectionsInView max: 1].
	aChar = Character pageDown
		ifTrue: [newIndex := targetIndex + self numSelectionsInView].
	aChar = Character arrowRight
		ifTrue: [
			targetMorph ifNil: [^ false].
			(targetMorph canExpand and: [targetMorph isExpanded not])
				ifTrue: [
					self toggleExpandedState: targetMorph.
					^ true]
				ifFalse: [ newIndex := targetIndex + 1 ] ].
	aChar = Character arrowLeft
		ifTrue: [
			targetMorph ifNil: [^ false].
			(targetMorph canExpand and: [targetMorph isExpanded])
				ifTrue: [
					self toggleExpandedState: targetMorph.
					^ true]
				ifFalse: [ | parent |
					parent := targetMorph parent.
					parent
						ifNil: [newIndex := targetIndex - 1 max: 1]
						ifNotNil: [
							self toggleExpandedState: parent.
							newIndex := parent index]]].
	newIndex notNil
		ifTrue: [
			self
				setSelectionIndexFromKeyboard: newIndex
				multiSelection: multi
				event: event.
			self selectionChanged.
			^ true].
	^ false! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/11/2013 16:02'!
nodeMorphsWithAllNodeItems: aNodeItemList
	| result |

	result := OrderedCollection new.
	
	self allNodeMorphs do: [:m | 
		aNodeItemList do: [ :sel | (m expandPath: sel) ] ].
	
	self allNodeMorphs do: [:m | 
		aNodeItemList do: [ :sel | (m matchPath: sel)
			ifNotNil: [:col | result addAll: col ] ] ].

	^ result flattened! !

!MorphTreeListManager methodsFor: 'selection change' stamp: 'AlainPlantec 10/7/2011 16:09'!
selectionChanged
	client selectionChanged
! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 14:59'!
doubleClickBlock

	^ doubleClickBlock! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 14:59'!
doubleClickBlock: aBlock

	doubleClickBlock := aBlock! !

!MorphTreeListManager methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/26/2013 18:16'!
selectOnlyLastHighlighted
	^ removeOnlyLastSelected! !

!MorphTreeListManager methodsFor: 'selection change' stamp: 'ThierryGoubier 7/4/2014 10:18'!
updateLastClickedMorph
	"When the contents have been updated, ensure that lastClickedMorph refer to a correct morph."

	lastClickedMorph
		ifNil: [ lastClickedMorph := self selectedMorphList ifEmpty: [  ] ifNotEmpty: [ self selectedMorphList last ] ]
		ifNotNil: [ 
			self allNodeMorphs
				do: [ :each | 
					each complexContents withoutListWrapper = lastClickedMorph complexContents withoutListWrapper
						ifTrue: [ lastClickedMorph := each ] ] ]! !

!MorphTreeListManager methodsFor: 'selection change' stamp: 'AlainPlantec 10/7/2011 23:10'!
selectMoreAtBottom
	| last |
	autoTargetMorph ifNil: [^self].
	last := autoTargetMorph index.
	last < self allNodeMorphs size
		ifTrue: [
			self autoMultiSelect: (self allNodeMorphs at: last + 1).
			self selectionChanged]! !

!MorphTreeListManager methodsFor: 'selection accessing' stamp: 'AlainPlantec 10/7/2011 15:53'!
selectedMorph
	^ self selectedMorphList
		ifNotEmpty: [ :l | l last]
 		ifEmpty: []
! !

!MorphTreeModel commentStamp: '<historical>'!
I'm the base class for tree models.  See ClassListExample for basic usage.!
!MorphTreeModel methodsFor: 'announcing' stamp: 'AlainPlantec 10/17/2013 09:14'!
requestView: anAnnouncement
	^ self announcer announce: anAnnouncement ! !

!MorphTreeModel methodsFor: 'accessing' stamp: 'AlainPlantec 10/16/2013 16:52'!
enabled
	^ enabled ifNil: [ enabled := true ]! !

!MorphTreeModel methodsFor: 'dialog' stamp: 'AlainPlantec 10/11/2011 10:57'!
headerLabel

	^ headerLabel! !

!MorphTreeModel methodsFor: 'accessing' stamp: 'AlainPlantec 10/11/2011 10:57'!
keyStroke: anEvent

	anEvent keyString =  '<Cmd-a>'
		ifTrue: [ self selectAll ].
		
	anEvent keyString =  '<Cmd-A>'
		ifTrue: [ self deselectAll ]! !

!MorphTreeModel methodsFor: 'announcing' stamp: 'AlainPlantec 10/17/2013 09:12'!
onSelectionChangeSend: aSelector to: anObject
	self on: MorphTreeSelectionChanged send: aSelector to: anObject! !

!MorphTreeModel methodsFor: 'accessing' stamp: 'AlainPlantec 10/10/2011 11:25'!
rootNodes
	^ (self rootItems ifNil: [^nil])
		collect: [:ci | self rootNodeFromItem: ci].
! !

!MorphTreeModel methodsFor: 'selecting' stamp: 'AlainPlantec 1/29/2010 09:33'!
setSelection: aSelection
	selection := aSelection.
! !

!MorphTreeModel methodsFor: 'accessing' stamp: ''!
selectAllNodePaths: aCollectionOfNodePath
	self selection: (MorphTreeMorphMultipleSelection new selectedNodePathList: aCollectionOfNodePath)! !

!MorphTreeModel methodsFor: 'selecting' stamp: 'AlainPlantec 11/18/2009 08:17'!
selection
	^ selection.
! !

!MorphTreeModel methodsFor: 'dialog' stamp: 'AlainPlantec 10/2/2011 16:59'!
dialogWindowIn: aWindow title: aTitle
	^ self dialogWindowIn: aWindow title: aTitle selectedtems: Array new! !

!MorphTreeModel methodsFor: 'accessing' stamp: 'AlainPlantec 10/16/2013 16:52'!
enable
	self enabled: true! !

!MorphTreeModel methodsFor: 'expanding-collapsing' stamp: 'AlainPlantec 10/18/2013 10:25'!
expandRoots
	self requestView: (MorphTreeChangeRequest expandRoots)! !

!MorphTreeModel methodsFor: 'accessing' stamp: 'AlainPlantec 10/11/2011 10:56'!
autoMultiSelection: aBoolean
	autoMultiSelection := aBoolean
! !

!MorphTreeModel methodsFor: 'accessing' stamp: ''!
promptForCancel
	"Ask if it is OK to cancel changes"
	
	^(self confirm:
'Changes have not been saved.
Is it OK to cancel changes?' translated)
			! !

!MorphTreeModel methodsFor: 'accessing' stamp: ''!
okToDiscardEdits 
	^ self canDiscardEdits  or: [self promptForCancel]! !

!MorphTreeModel methodsFor: 'accessing' stamp: 'AlainPlantec 10/11/2011 11:03'!
isCheckList: aBoolean
	^ isCheckList := aBoolean! !

!MorphTreeModel methodsFor: 'accessing' stamp: 'AlainPlantec 10/16/2013 16:52'!
disable
	self enabled: false! !

!MorphTreeModel methodsFor: 'accessing' stamp: 'AlainPlantec 10/11/2011 10:57'!
headerLabel: aString
	
	headerLabel := aString! !

!MorphTreeModel methodsFor: 'expanding-collapsing' stamp: 'AlainPlantec 10/17/2013 12:01'!
expandAllFromNode: aNode
	self  requestView: (MorphTreeChangeRequest expandAllFromNode: aNode)
! !

!MorphTreeModel methodsFor: 'announcing' stamp: 'BernardoContreras 10/4/2014 17:24'!
on: anAnnouncementClass send: aSelector to: anObject
	self announcer when: anAnnouncementClass send: aSelector to: anObject! !

!MorphTreeModel methodsFor: 'accessing' stamp: 'AlainPlantec 10/2/2011 16:08'!
selectedItems
	^ selection 
		ifNil: [OrderedCollection new]
		ifNotNil: [selection selectedItems]! !

!MorphTreeModel methodsFor: 'accessing' stamp: ''!
selectedNode
	^ self selectedNodePath ifNotNil: [:path | path ifEmpty: [nil] ifNotEmpty: [path last]]! !

!MorphTreeModel methodsFor: 'accessing' stamp: 'AlainPlantec 10/10/2011 11:30'!
treeMorphClass
	^ MorphTreeMorph ! !

!MorphTreeModel methodsFor: 'accessing' stamp: 'AlainPlantec 10/11/2011 11:08'!
beCheckList
	self isCheckList: true
! !

!MorphTreeModel methodsFor: 'accessing' stamp: ''!
defaultPageSize
	^ nil! !

!MorphTreeModel methodsFor: 'accessing' stamp: ''!
rootNodeClassFromItem: anItem
	^ MorphTreeNodeModel! !

!MorphTreeModel methodsFor: 'accessing' stamp: ''!
rootNodeFromItem: anItem
	^ (self rootNodeClassFromItem: anItem) with: anItem model: self! !

!MorphTreeModel methodsFor: 'expanding-collapsing' stamp: 'AlainPlantec 10/17/2013 10:01'!
expandNodePath: aNodePath
	self requestView: (MorphTreeChangeRequest expandNodePath:  aNodePath)! !

!MorphTreeModel methodsFor: 'accessing' stamp: ''!
keyStroke: anEvent from: aTreeView! !

!MorphTreeModel methodsFor: 'accessing' stamp: ''!
selectNodePath: aNodePath
	self selection: (MorphTreeMorphSingleSelection new selectedNodePath: aNodePath)! !

!MorphTreeModel methodsFor: 'selecting' stamp: 'AlainPlantec 10/17/2013 10:00'!
selectAll
	self requestView: MorphTreeChangeRequest selectAll! !

!MorphTreeModel methodsFor: 'accessing' stamp: 'AlainPlantec 10/11/2011 10:57'!
multiSelection: aBoolean
	multiSelection := aBoolean! !

!MorphTreeModel methodsFor: 'wrapping' stamp: 'AlainPlantec 10/11/2011 10:58'!
wrapItem: anItem 
	"Here I return the display of my item, wrapped or not,
	using a block or a selector which will be performed
	directly on the item" 
	^ self wrapBlockOrSelector isBlock
		ifTrue: [wrapBlockOrSelector cull: anItem]
		ifFalse: [wrapBlockOrSelector isSymbol
				ifTrue: [| numArgs |
					numArgs := wrapBlockOrSelector numArgs.
					numArgs isZero
						ifTrue: [anItem perform: wrapBlockOrSelector]
						ifFalse: [numArgs = 1
								ifTrue: [anItem perform: wrapBlockOrSelector with: anItem]
								ifFalse: [self error: 'Wrong number of arguments']]]
				ifFalse: [anItem]]! !

!MorphTreeModel methodsFor: 'updating' stamp: 'ThierryGoubier 7/4/2014 09:22'!
updateList
	| items |
	items := self selectedItems.
	self requestView: MorphTreeChangeRequest updateList.
	self selectItems: items! !

!MorphTreeModel methodsFor: 'expanding-collapsing' stamp: 'AlainPlantec 10/17/2013 12:02'!
expandAll
	self  requestView: MorphTreeChangeRequest expandAll ! !

!MorphTreeModel methodsFor: 'dialog' stamp: 'MarcusDenker 9/13/2013 16:30'!
openDialogWindowIn: aWindow title: aTitle selectedtems: aCollection 
	| dialog |
	dialog := self dialogWindowIn:  aWindow title: aTitle selectedtems: aCollection.
	aWindow openModal: dialog.
	^ dialog cancelled ifFalse: [self selectedItems]
! !

!MorphTreeModel methodsFor: 'expanding-collapsing' stamp: 'AlainPlantec 10/17/2013 12:08'!
collapseAll
	self  requestView:  MorphTreeChangeRequest collapseAll! !

!MorphTreeModel methodsFor: 'keyboard managing' stamp: 'EstebanLorenzano 3/19/2014 13:44'!
arrowEvent: event key: aChar target: aMorph
	"Give model the capability of handle a key before is handled by MorphTreeListManager"
	^ false! !

!MorphTreeModel methodsFor: 'accessing' stamp: 'AlainPlantec 10/11/2011 10:57'!
wrapBlockOrSelector: aBlockOrSelector

	wrapBlockOrSelector := aBlockOrSelector! !

!MorphTreeModel methodsFor: 'dialog' stamp: 'AlainPlantec 10/7/2011 10:58'!
openDialogWindowIn: aWindow title: aTitle
	^ self openDialogWindowIn: aWindow title: aTitle selectedtems: Array new! !

!MorphTreeModel methodsFor: 'accessing' stamp: ''!
selectedItem
	^ self selectedNode ifNotNil: [:node | node item]! !

!MorphTreeModel methodsFor: 'selecting' stamp: 'AlainPlantec 10/17/2013 09:40'!
selection: aSelection
	self setSelection: aSelection.
	self  requestView: MorphTreeChangeRequest updateSelectionFromModel
! !

!MorphTreeModel methodsFor: 'accessing' stamp: 'AlainPlantec 10/17/2013 12:13'!
enabled: aBoolean
	aBoolean ~= enabled
		ifTrue: [ 
			enabled := aBoolean.
			self  requestView: MorphTreeChangeRequest enabled]! !

!MorphTreeModel methodsFor: 'accessing' stamp: 'AlainPlantec 10/11/2011 10:53'!
rootItems

	^ rootItems ifNil: [ rootItems := {} ]! !

!MorphTreeModel methodsFor: 'accessing' stamp: ''!
menu: menu shifted: b
	^ menu! !

!MorphTreeModel methodsFor: 'accessing' stamp: ''!
defaultChunkSize
	^ nil! !

!MorphTreeModel methodsFor: 'selecting' stamp: 'AlainPlantec 10/17/2013 12:05'!
deselectAll
	self  requestView: MorphTreeChangeRequest deselectAll! !

!MorphTreeModel methodsFor: 'accessing' stamp: 'AlainPlantec 10/10/2011 22:56'!
announcer
	^ announcer ifNil: [announcer := Announcer new]! !

!MorphTreeModel methodsFor: 'accessing' stamp: 'AlainPlantec 10/11/2011 10:54'!
rootItems: aCollection
	rootItems := aCollection.
! !

!MorphTreeModel methodsFor: 'selecting' stamp: 'AlainPlantec 10/17/2013 09:59'!
selectItems: aListOfItems
	self requestView: ( MorphTreeChangeRequest selectItems: aListOfItems )! !

!MorphTreeModel methodsFor: 'expanding-collapsing' stamp: 'AlainPlantec 10/18/2013 10:24'!
expandItemPath: anItemPath
	self  requestView: (MorphTreeChangeRequest expandItemPath: anItemPath)! !

!MorphTreeModel methodsFor: 'accessing' stamp: 'AlainPlantec 10/11/2011 11:28'!
autoMultiSelection
	^ autoMultiSelection ifNil: [autoMultiSelection := false]! !

!MorphTreeModel methodsFor: 'accessing' stamp: 'AlainPlantec 10/11/2011 10:57'!
wrapBlockOrSelector

	^ wrapBlockOrSelector ifNil: [wrapBlockOrSelector := #printString]! !

!MorphTreeModel methodsFor: 'accessing' stamp: 'AlainPlantec 10/11/2011 11:03'!
isCheckList
	^ isCheckList ifNil: [isCheckList := false]! !

!MorphTreeModel methodsFor: 'view' stamp: 'EstebanLorenzano 4/29/2014 13:52'!
defaultTreeMorph
	|  col |
	col := MorphTreeColumn new 
		rowMorphGetSelector: [:node | StringMorph contents: node item asString].
	
	self headerLabel
		ifNotNil: [	col headerButtonLabel: self headerLabel font: nil].
			
	^ (self treeMorphClass on: self) 
			columns:  (Array with: col);
			hResizing: #spaceFill;
			vResizing: #spaceFill;
			resizerWidth: 0;
			columnInset: 0; 
			rowInset: 2; 
			keystrokeActionSelector: #keyStroke:;
			"preferedPaneColor: Color white;"
			multiSelection: self multiSelection;
			autoMultiSelection: self autoMultiSelection;
			itemStringGetter: [:item | self wrapItem: item];
			isCheckList: self isCheckList";
			rowColorForEven: Color veryLightGray muchLighter odd: Color white".! !

!MorphTreeModel methodsFor: 'accessing' stamp: ''!
selectedNodePath
	^ self selection ifNotNil: [:s | s lastSelectedNodePath]! !

!MorphTreeModel methodsFor: 'selecting' stamp: 'AlainPlantec 10/17/2013 09:14'!
selectionChanged
	self requestView: (MorphTreeSelectionChanged new selection: self selection)
! !

!MorphTreeModel methodsFor: 'accessing' stamp: ''!
deeplyDetect: aBlock 
	self rootNodes
		do: [:sub | (sub deeplyDetect: aBlock)
				ifNotNil: [:found | ^ found]].
	^ nil ! !

!MorphTreeModel methodsFor: 'help-text' stamp: 'GuillermoPolito 11/7/2013 15:55'!
helpText

	^ nil! !

!MorphTreeModel methodsFor: 'accessing' stamp: 'AlainPlantec 10/11/2011 11:28'!
multiSelection
	^ multiSelection ifNil: [multiSelection := false]! !

!MorphTreeModel methodsFor: 'expanding-collapsing' stamp: 'AlainPlantec 10/18/2013 10:08'!
collapseNodePath: aNodePath
	self  requestView: (MorphTreeChangeRequest collapseNodePath: aNodePath)! !

!MorphTreeModel methodsFor: 'dialog' stamp: 'AlainPlantec 10/9/2011 15:01'!
dialogWindowIn: aWindow title: aTitle selectedtems: aCollection 
	| dialog treeMorph |
	dialog := self theme
				newPluggableDialogWindowIn: aWindow
				title: aTitle
				for: (treeMorph := self defaultTreeMorph).
	treeMorph buildContents; selectedItems: aCollection.
	dialog defaultFocusMorph: treeMorph.
	dialog minimumExtent: 300 @ 500.
	dialog beResizeable.
	^ dialog ! !

!MorphTreeModel class methodsFor: 'item handling' stamp: 'AlainPlantec 10/11/2011 11:11'!
itemsList: itemsList itemsHeaderName: aName

	^ self new
		rootItems: itemsList;
		headerLabel: aName;
		yourself! !

!MorphTreeModel class methodsFor: 'item handling' stamp: 'AlainPlantec 10/11/2011 11:12'!
itemsList: itemsList itemsHeaderName: aName wrapBlockOrSelector: wrapBlockOrSelector

	^ self new
		wrapBlockOrSelector: wrapBlockOrSelector;
		rootItems: itemsList;
		headerLabel: aName;
		yourself! !

!MorphTreeModel class methodsFor: 'examples' stamp: 'TorstenBergmann 9/5/2014 15:19'!
exampleCheckList2
	"self exampleCheckList2"
	| model |
	model := self new rootItems: Morph methods.
	model
		 wrapBlockOrSelector: #selector;
		 autoMultiSelection: true;
		 headerLabel: 'Plop';
		 beCheckList.
	^ (model openDialogWindowIn: World title: 'All Morph methods')
! !

!MorphTreeModel class methodsFor: 'examples' stamp: 'TorstenBergmann 9/5/2014 15:19'!
exampleCheckList3
	"self exampleCheckList3"
	Cursor wait 
		showWhile: [
			^ ((self new
				beCheckList;
				autoMultiSelection: true;
				rootItems: (Object allSubclasses sort: [:a :b | a name <= b name]);
				 headerLabel: 'Sub-classes';
				defaultTreeMorph) 
					buildContents;
					embeddedInMorphicWindowLabeled: 'All Object sub-classes ready to be checked') 
						openInWorld]! !

!MorphTreeModel class methodsFor: 'examples' stamp: 'TorstenBergmann 9/5/2014 15:19'!
exampleCheckList1
	"self exampleCheckList1"
	Cursor wait 
		showWhile: [
			^ self new
				beCheckList;
				rootItems: (Object allSubclasses sort: [:a :b | a name <= b name]);
				 headerLabel: 'Sub-classes';
				 openDialogWindowIn: World title: 'All Object sub-classes ready to be checked']! !

!MorphTreeModel class methodsFor: 'item handling' stamp: 'AlainPlantec 10/11/2011 11:11'!
itemsList: itemsList

	^ self new
		rootItems: itemsList;
		yourself! !

!MorphTreeModel class methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
theme
	^ Smalltalk ui theme! !

!MorphTreeMorph commentStamp: 'AlainPlantec 2/13/2010 07:41'!
A MorphTreeMorph is a list and a tree in one easily customizable widget. A list or tree is made of nodes. Each node can be made of whatever object . This allows the use of morphs inside the tree. A MorphTreeMorph works with a model which must use the TMorphTreeModel trait. MorphTreeModel uses it and can serves  as the model or as a superclass for a specific tree model.

Customizable columns:
Several customizable columns can be viewed. Columns are separated by resizers used in order to increase or decrease the columns width with the mouse.
A MorphTreeMorph can have a top header composed of buttons, one button per column. Such a button can have an icon and/or a title and may run some action when clicked on (a typical action is the ordering of the list). You can also allow column drag-and-drop so that a column  can be dynamically moved with a simple drop.
See this in action with following example:
-----------
ClassListExample new openOn: Collection
-----------
By default, the last column is not bounded, so that no resizer is added for it and threre exists no unused space between the last scroller and the right side of the whole tree. But, in some case one want to have a resizer also for the last column. This is the case for data grid as an example This is possible by sending #makeLastColumnBounded to the MorphTreeMorph.
Try it with:
-----------
SimpleGridExample new open
-----------

Single and multi-selection:
A MorphTreeMorph implements single and multiple selection. Multi-selection is allowed by sending  #multiSelection: with true as argument. Several items can be selected with ctrl-click (or cmd-click on mac) or with shift-click (see MorphTreeMorphModel comments to see how to handle selection from the model).
Try multi-selection with following example:
------------
SimplestClassListExample new openOn: Collection
------------

Double-click handling:
You can allow double-click just by indicating the message to send to the model with the doubleClickSelector: selector.
Try this with the package-tree example where double-clicking on a class node or or a method node open a browser on the class or on the method:
------------
PackageTreeExample new open
------------

Long list handling:
For very long lists or trees, two kind of pager can be used to limit the number of items visible in the list. The idea  is that when you have very long lists, you most of the time do not  want to see all details but just want some visual support for what is in the list: 
- with a simple pager, you indicate how much items are to be seen in one page, the list items are viewed page by page,
- with a chunk pager you can expand either incrementally or  all-together the number of items once you get to the bottom of the existing items.
See SimplestClassListWithPagerExample and SimplestClassListWithChunkExample examples.
Try them with:
------------
SimplestClassListWithPagerExample new openOn: Object.
SimplestClassListWithChunkExample new openOn: Object.
------------

Columns/rows coloring:
MorphTreeMorph makes it possible the coloring of either the columns or the rows. A MorphTreeMorph understands #rowColorForEven:odd: for rows coloring and columnColorForEven:odd: for columns coloring with two colors passed as argument (nil means no color). 
See following examples:
-------------
PackageTreeExample new open. "For row coloring"
ClassListExample new openOn: Collection. "For column coloring"
-------------

Column drag and drop
A column can be dragged. Inside the tree, a column can be dropped into another one. Then, the two columns are swapped (the roughly implemented)
Try it with:
-------------
ClassListExample new openOn: Collection.
-------------


Instance Variables
	autoDeselection:		<Object>
	autoMultiSelection:		<Object>
	columnColors:		<Object>
	columnDropUnabled:		<Object>
	columnInset:		<Object>
	columnResizers:		<Object>
	columns:		<Object>
	doubleClickSelector:		<Object>
	expandedToggleImage:		<Object>
	gapAfterIcon:		<Object>
	gapAfterToggle:		<Object>
	getListSelector:		<Object>
	getSelectionSelector:		<Object>
	hasToggleAtRoot:		<Object>
	iconReservedExtent:		<Object>
	indentGap:		<Object>
	keystrokeActionSelector:		<Object>
	lastSelectedMorph:		<Object>
	lineColor:		<Object>
	multipleSelection:		<Object>
	nodeList:		<Object>
	nodeSortBlock:		<Object>
	notExpandedToggleImage:		<Object>
	pager:		<Object>
	potentialDropMorph:		<Object>
	preferedPaneColor:		<Object>
	resizerWidth:		<Object>
	rowColors:		<Object>
	rowInset:		<Object>
	scrollDeltaHeight:		<Object>
	selectedMorphList:		<Object>
	setSelectionSelector:		<Object>
	shiftSelectedMorph:		<Object>
	topHeader:		<Object>
	topHeaderBackground:		<Object>
	unboundLastColumn:		<Object>
	withHLines:		<Object>

autoDeselection
	- xxxxx

autoMultiSelection
	- xxxxx

columnColors
	- xxxxx

columnDropUnabled
	- xxxxx

columnInset
	- xxxxx

columnResizers
	- xxxxx

columns
	- xxxxx

doubleClickSelector
	- xxxxx

expandedToggleImage
	- xxxxx

gapAfterIcon
	- xxxxx

gapAfterToggle
	- xxxxx

getListSelector
	- xxxxx

getSelectionSelector
	- xxxxx

hasToggleAtRoot
	- xxxxx

iconReservedExtent
	- xxxxx

indentGap
	- xxxxx

keystrokeActionSelector
	- xxxxx

lastSelectedMorph
	- xxxxx

lineColor
	- xxxxx

multipleSelection
	- xxxxx

nodeList
	- xxxxx

nodeSortBlock
	- xxxxx

notExpandedToggleImage
	- xxxxx

pager
	- xxxxx

potentialDropMorph
	- xxxxx

preferedPaneColor
	- xxxxx

resizerWidth
	- xxxxx

rowColors
	- xxxxx

rowInset
	- xxxxx

scrollDeltaHeight
	- xxxxx

selectedMorphList
	- xxxxx

setSelectionSelector
	- xxxxx

shiftSelectedMorph
	- xxxxx

topHeader
	- xxxxx

topHeaderBackground
	- xxxxx

unboundLastColumn
	- xxxxx

withHLines
	- xxxxx
!
!MorphTreeMorph methodsFor: 'accessing colors' stamp: 'AlainPlantec 2/3/2010 09:45'!
lineColorBlock
	^ lineColorBlock
! !

!MorphTreeMorph methodsFor: '*glamour-morphic-widgets' stamp: 'cyrilledelaunay 6/6/2011 15:56'!
setOptimalResizing
	self hResizing: #rigid.
	self vResizing: #rigid! !

!MorphTreeMorph methodsFor: 'expanding-collapsing' stamp: 'AlainPlantec 10/29/2009 10:08'!
toggleImageHeight
	^ self expandedToggleImage height max: self notExpandedToggleImage height.! !

!MorphTreeMorph methodsFor: 'selection' stamp: 'AlainPlantec 11/18/2009 07:29'!
isSingle	
	^ self isMultiple not! !

!MorphTreeMorph methodsFor: 'column handling' stamp: 'BenjaminVanRyseghem 11/2/2013 18:14'!
columns: aListOfTreeColumn
	"set the columns -  as a consequence, the topHeader is update (if present) and column resizers are added"

	self removeColumnResizers.
	topHeader ifNotNil: [ self removeMorph: topHeader ].
	columns := aListOfTreeColumn asOrderedCollection.
	aListOfTreeColumn do: [:col | col container: self].
	self buildTopHeader .
	self addColumnResizers.
! !

!MorphTreeMorph methodsFor: 'accessing colors' stamp: 'AlainPlantec 10/29/2009 10:08'!
preferedPaneColor: aColor
	self color: (preferedPaneColor := aColor).
! !

!MorphTreeMorph methodsFor: '*Spec-MorphicAdapters' stamp: 'BenjaminVanRyseghem 4/21/2013 00:14'!
initializeColumsFrom: aModel

	self columns: aModel columns! !

!MorphTreeMorph methodsFor: 'column handling' stamp: 'AlainPlantec 2/12/2010 21:24'!
addColumn: aTreeColumn afterIndex: aPosition
	"add a column at a given index then update the list
	in order to take the new column into account"
	aTreeColumn container: self.
	self columns add: aTreeColumn afterIndex: aPosition.
	self columnsChanged.
	self updateColumnMorphs.
	self updateList

! !

!MorphTreeMorph methodsFor: 'column handling' stamp: 'AlainPlantec 2/12/2010 21:23'!
addColumn: aTreeColumn
	"add a column"
	self addColumn: aTreeColumn afterIndex: self columns size! !

!MorphTreeMorph methodsFor: 'initialization' stamp: 'EstebanLorenzano 5/15/2014 14:03'!
initialize
	"initialize the state of the receiver"
	super initialize.
	columnColors := Array 
		with: Color transparent 
		with: Color transparent.
	rowColors := Array 
		with: self theme backgroundColor 
		with: self theme backgroundColor.
	self borderWidth: 0.

	
! !

!MorphTreeMorph methodsFor: 'column handling' stamp: 'AlainPlantec 2/12/2010 21:42'!
columnsChanged
	"A column has been added or removed or swapped with another one
	- rebuild all resizers and the top header"
	self removeColumnResizers.
	self removeTopHeader.
	self buildTopHeader.
	self addColumnResizers.
! !

!MorphTreeMorph methodsFor: 'column handling' stamp: 'AlainPlantec 2/12/2010 21:32'!
columnResizersToFront
	"Column resizers should always be at top"
	self columnResizers do: [:cl | cl comeToFront; fillStyle: cl normalFillStyle].
! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 16:16'!
keystrokeActionSelector: aSelector
	self listManager keystrokeActionSelector: aSelector! !

!MorphTreeMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/17/2015 13:41'!
drawOnAthensCanvas: anAthensCanvas

	self drawOnCanvasWrapperFor: anAthensCanvas
	! !

!MorphTreeMorph methodsFor: 'events-processing' stamp: 'AlainPlantec 10/16/2013 12:34'!
takesKeyboardFocus
	"Answer whether the receiver can normally take keyboard focus."

	^ self enabled! !

!MorphTreeMorph methodsFor: 'geometry' stamp: 'AlainPlantec 1/31/2010 22:56'!
columnInset: anInteger
	"Change the horizontal space between a resizer and a row morph"
	columnInset := anInteger.
! !

!MorphTreeMorph methodsFor: 'selection' stamp: 'AlainPlantec 10/7/2011 21:43'!
selectedItems: aNodeItemCollection
	self listManager selectedItems: aNodeItemCollection! !

!MorphTreeMorph methodsFor: 'updating' stamp: 'ThierryGoubier 7/23/2014 10:29'!
noteRemovalOfAll: aCollection
	"TODO: update the selection as well"

	 self listManager noteRemovalOfAll: aCollection.
	aCollection do: [ :each | each delete ].
	scroller removeAllMorphsIn: aCollection.
	self adjustSubmorphPositions! !

!MorphTreeMorph methodsFor: 'expanding-collapsing' stamp: 'alain.plantec 10/12/2009 23:25'!
notExpandedForm
	"Answer the form to use for unexpanded items."
	
	^self theme treeUnexpandedForm! !

!MorphTreeMorph methodsFor: 'updating' stamp: 'ThierryGoubier 7/4/2014 10:10'!
updateContentsWithPreviouslyExpanded: aNodeList
	"Make sure we notice the removal of the contained nodes."

	nodeList := nil.
	self noteRemovalOfAll: self allNodeMorphs.	"<-- Changed"
	(self nodeList isNil or: [ self nodeList isEmpty ])
		ifTrue: [ 
			nodeList := nil.
			^ self emptySelection ].
	self addSubmorphsFromNodeList: self currentNodelist previouslyExpanded: aNodeList.
	self listManager updateLastClickedMorph! !

!MorphTreeMorph methodsFor: 'events-processing' stamp: 'AlainPlantec 1/31/2010 21:37'!
mouseEnter: event
	"Changed to take keyboardFocusOnMouseDown preference into account."
	
	super mouseEnter: event.
	self wantsKeyboardFocus ifFalse: [^self].
	self keyboardFocusOnMouseDown ifFalse: [self takeKeyboardFocus]! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/2/2010 16:33'!
withTreeLines: aBoolean
	self  treeLineWidth: 1! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 10/16/2013 12:18'!
fillStyleToUse
	"Answer the fillStyle that should be used for the receiver."
	
	^self enabled
		ifTrue: [self theme listNormalFillStyleFor: self]
		ifFalse: [self theme listDisabledFillStyleFor: self]! !

!MorphTreeMorph methodsFor: 'selection' stamp: 'AlainPlantec 11/26/2009 07:20'!
selectNodePath: aPath
	aPath 
		ifNil: [self emptySelection] 
		ifNotNil: [self firstChild 
			ifNotNil: [:fc | fc selectNodePath: aPath]]! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/9/2009 15:25'!
topHeaderBackground
	^ topHeaderBackground ifNil: [topHeaderBackground := Color transparent]! !

!MorphTreeMorph methodsFor: 'selection' stamp: 'AlainPlantec 10/7/2011 16:25'!
beMultiple	
	self listManager multipleSelection: true! !

!MorphTreeMorph methodsFor: 'selection' stamp: 'AlainPlantec 10/7/2011 17:17'!
multiSelection: aBoolean
	self listManager multipleSelection: aBoolean! !

!MorphTreeMorph methodsFor: 'dropping/grabbing' stamp: 'AlainPlantec 2/12/2010 21:22'!
resetPotentialDropMorph
	"release the current drop morph candidate"
	potentialDropMorph ifNotNil: [
		potentialDropMorph resetHighlightForDrop.
		potentialDropMorph := nil]
! !

!MorphTreeMorph methodsFor: 'expanding-collapsing' stamp: 'AlainPlantec 10/7/2011 13:20'!
notExpandedFormForMorph: aMorph
	^ (aMorph selected and: [self selectionColor luminance < 0.7])
		ifTrue: [self theme whiteTreeUnexpandedForm]
		ifFalse: [self theme treeUnexpandedForm]
! !

!MorphTreeMorph methodsFor: 'scrolling' stamp: 'AlainPlantec 10/10/2011 20:06'!
newTransformMorph
	^ MorphTreeTransformMorph new ! !

!MorphTreeMorph methodsFor: 'events-processing' stamp: 'AlainPlantec 10/16/2013 12:35'!
mouseUp: event 
	"Fixed up highlight problems."
	| nodeMorph wasHigh |
	
	self enabled ifFalse: [ ^self ].
	mouseOverAllowed := false.
	nodeMorph := self scrollerSubMorphFromPoint: event position.

	wasHigh := nodeMorph notNil 
		ifTrue: [nodeMorph highlightedForMouseDown] 
		ifFalse: [false].
		
	self allNodeMorphs 
		do: [:m | 
				m highlightedForMouseDown 
					ifTrue: [m highlightForMouseDown: false]].
	wasHigh 
		ifFalse: [
			nodeMorph 
				ifNotNil: [^self]].

	self listManager mouseUp: event on: nodeMorph.

	! !

!MorphTreeMorph methodsFor: 'expanding-collapsing' stamp: 'AlainPlantec 10/9/2011 19:41'!
collapseAll
	self updateContentsWithPreviouslyExpanded: Array new.
! !

!MorphTreeMorph methodsFor: 'column handling' stamp: 'ThierryGoubier 10/21/2013 17:00'!
headerBounds
	"return the bounds of each top header button (one per column)"

	| positions controlBounds currPos currLeft |
	controlBounds := OrderedCollection new.
	currPos := scroller left.
	(positions := self columnResizers asOrderedCollection collect: [ :r | r position ])
		ifNotEmpty: [ 
			| currRight |
			currPos := positions removeFirst x.
			currLeft := scroller left - scroller offset x.
			currRight := currPos.
			controlBounds add: (currLeft @ topHeader top corner: currRight @ topHeader bottom).
			[ positions notEmpty ]
				whileTrue: [ 
					currLeft := currPos + self resizerWidth.
					currPos := positions removeFirst x.
					currRight := currPos.
					controlBounds add: (currLeft @ topHeader top corner: currRight @ topHeader bottom) ] ].
	self columnResizers size < self columns size
		ifTrue: [ 
			currLeft := currPos + self resizerWidth.
			controlBounds add: ((currLeft min: scroller right) @ topHeader top corner: scroller right @ topHeader bottom) ].
	^ controlBounds! !

!MorphTreeMorph methodsFor: 'selection' stamp: 'AlainPlantec 10/7/2011 17:12'!
autoDeselection: trueOrFalse
	"Enable/disable autoDeselect (see class comment)"
	self listManager autoDeselection: trueOrFalse! !

!MorphTreeMorph methodsFor: 'geometry' stamp: 'AlainPlantec 10/11/2011 10:25'!
maxNodeWidth
	^ maxNodeWidth ifNil: [maxNodeWidth := 0]! !

!MorphTreeMorph methodsFor: 'dropping/grabbing' stamp: 'AlainPlantec 2/12/2010 21:23'!
wantsDroppedMorph: aMorph event: anEvent
	"Return true if the receiver wishes to accept the given morph, which is being dropped 
	by a hand in response to the given event. Note that for a successful drop operation 
	both parties need to agree. The symmetric check is done automatically
	 via aMorph wantsToBeDroppedInto: self."

	^ self model wantsDroppedMorph: aMorph event: anEvent inMorph: self! !

!MorphTreeMorph methodsFor: 'events-processing' stamp: 'AlainPlantec 10/7/2011 21:23'!
mouseEnterDragging: evt
	| aMorph |
	(evt hand hasSubmorphs and: [self dropEnabled]) 
		ifFalse: [^super mouseEnterDragging: evt].
	(self wantsDroppedMorph: evt hand firstSubmorph event: evt)
		ifTrue: [
			aMorph := self scrollerSubMorphFromPoint: evt position.
			aMorph ifNotNil:[self potentialDropMorph: aMorph].
			evt hand newMouseFocus: self.
			"above is ugly but necessary for now"].! !

!MorphTreeMorph methodsFor: 'dropping/grabbing' stamp: 'AlainPlantec 2/12/2010 21:20'!
acceptDroppingMorph: aMorph event: evt
	"This message is sent when a morph is dropped onto a morph that has agreed 
	to accept the dropped morph by responding 'true' to the wantsDroppedMorph:Event: 
	message. This implementation relay the drop to the model then release the morph
	which was candidate fro a drop"
	self model
		acceptDroppingMorph: aMorph
		event: evt
		inMorph: self.
	self resetPotentialDropMorph.
	evt hand releaseMouseFocus: self.
	Cursor normal show.
! !

!MorphTreeMorph methodsFor: 'events-processing' stamp: 'alain.plantec 10/12/2009 23:25'!
mouseLeaveDragging: anEvent
	(self dropEnabled and:[anEvent hand hasSubmorphs]) ifFalse: ["no d&d"
		^ super mouseLeaveDragging: anEvent].
	self resetPotentialDropMorph.
	anEvent hand releaseMouseFocus: self.
	"above is ugly but necessary for now"
! !

!MorphTreeMorph methodsFor: 'updating' stamp: 'AlainPlantec 10/16/2013 16:57'!
enabledFromModel
	| val |
	self model ifNil: [ ^ self ].
	val := self model enabled.
	val ~= self enabled
		ifTrue: [ self enabled: val ] ! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 9/30/2011 16:14'!
hasIconBlock
	^ iconBlock notNil! !

!MorphTreeMorph methodsFor: 'geometry' stamp: 'AlainPlantec 1/31/2010 22:57'!
gapAfterToggle: anInteger
	"set the horizontal space after the toggle"
	gapAfterToggle := anInteger.
! !

!MorphTreeMorph methodsFor: 'expanding-collapsing' stamp: 'AlainPlantec 10/18/2013 09:30'!
expandItemPath: aNodePath
	(self allNodeMorphs at: 1 ifAbsent: [^self]) 
		openItemPath: aNodePath! !

!MorphTreeMorph methodsFor: 'events-processing' stamp: 'AlainPlantec 10/7/2011 21:23'!
scrollerSubMorphFromPoint: aPoint
	"Return the list element (morph) at the given point or nil if outside"
	| ptY |
	scroller hasSubmorphs ifFalse:[^nil].
	ptY := (scroller firstSubmorph point: aPoint from: self) y.
	"note: following assumes that submorphs are vertical, non-overlapping, and ordered"
	scroller firstSubmorph top > ptY ifTrue:[^nil].
	scroller lastSubmorph bottom < ptY ifTrue:[^nil].
	"now use binary search"
	^scroller 
		findSubmorphBinary: [:item|
			(item top <= ptY and:[item bottom >= ptY])
				ifTrue:[0] "found"
				ifFalse:[ (item top + item bottom // 2) > ptY ifTrue:[-1] ifFalse:[1]]]! !

!MorphTreeMorph methodsFor: 'events-processing' stamp: 'AlainPlantec 10/7/2011 21:25'!
toggleExpandedState: aMorph event: event
	| oldState |
	event yellowButtonPressed 
		ifTrue: [
			oldState := aMorph isExpanded.
			self allNodeMorphs copy do: [ :each |
				(each canExpand and: [each isExpanded = oldState]) 
					ifTrue: [each toggleExpandedState]]] 
		ifFalse: [aMorph toggleExpandedState].
	self adjustSubmorphPositions.
	! !

!MorphTreeMorph methodsFor: 'column handling' stamp: 'AlainPlantec 2/12/2010 22:04'!
removeColumn: aTreeColumn
	"Remove a column - rough implementation"
	self removeColumnAtIndex: (self columns indexOf: aTreeColumn)! !

!MorphTreeMorph methodsFor: 'submorphs-add/remove' stamp: 'AlainPlantec 10/6/2011 22:24'!
addSubmorphsFromNodeList
	self addSubmorphsFromNodeList: self currentNodelist previouslyExpanded: #() 
! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 10/29/2009 10:07'!
hasToggleAtRoot
	^ hasToggleAtRoot ifNil: [hasToggleAtRoot := self roots anySatisfy: [:s | s hasToggle]]
! !

!MorphTreeMorph methodsFor: 'geometry' stamp: 'AlainPlantec 11/17/2009 16:25'!
minResizerX
	^ scroller left + self minResizerOffset! !

!MorphTreeMorph methodsFor: 'events-processing' stamp: 'cami 7/22/2013 18:28'!
commandOrCrontrolKeyPressed: anEvent
	^ (Smalltalk os isMacOS) 
		ifTrue: [anEvent controlKeyPressed]
		ifFalse: [anEvent commandKeyPressed]! !

!MorphTreeMorph methodsFor: 'expanding-collapsing' stamp: 'AlainPlantec 1/22/2010 18:38'!
expandedNodesFrom: aMorpList

	^ (aMorpList select: [ :each | each isExpanded]) collect: [ :each | each complexContents].
	! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 10/10/2011 11:04'!
currentNodelist
	"The nodeList currently viewed "
	^ self nodeList! !

!MorphTreeMorph methodsFor: 'accessing colors' stamp: 'AlainPlantec 11/17/2009 19:47'!
columnColorForEven: evenColor odd: oddColor
	columnColors at: 2 put: oddColor.
	columnColors at: 1 put: evenColor.
	! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 19:39'!
doubleClickBlock: aValuableWithNoArg
	"set a  double click action"
	self listManager doubleClickBlock: aValuableWithNoArg! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 10/29/2009 10:08'!
withHLines
	^ withHLines ifNil: [withHLines := false]! !

!MorphTreeMorph methodsFor: 'selection' stamp: 'AlainPlantec 10/7/2011 18:29'!
selectedMorph
	^ self listManager selectedMorph! !

!MorphTreeMorph methodsFor: 'scrolling' stamp: 'AlainPlantec 10/10/2011 19:16'!
hScrollBarValue: scrollValue
	| prev |
	prev := scroller offset x.
	super hScrollBarValue: scrollValue.
	scroller offset x ~= prev
		ifTrue: [
			self updateColumnResizersXOffset.
			self updateTopHeader]! !

!MorphTreeMorph methodsFor: 'updating' stamp: 'AlainPlantec 10/8/2011 22:55'!
updateFromSelection: aSelection
	aSelection selectedNodePathList do: [:path | self selectNodePath: path].
	self scrollSelectionIntoView! !

!MorphTreeMorph methodsFor: 'announce requests' stamp: 'BernardoContreras 10/4/2014 17:24'!
registerRequestHandlers
	self model announcer when: MorphTreeChangeRequest send: #changeRequest: to: self.! !

!MorphTreeMorph methodsFor: 'selection' stamp: 'AlainPlantec 10/8/2011 23:50'!
selectedMorphList
	^ self listManager selectedMorphList! !

!MorphTreeMorph methodsFor: 'expanding-collapsing' stamp: 'alain.plantec 10/12/2009 23:25'!
expand: aMorph to: level
	| allChildren |
	aMorph toggleExpandedState.
	allChildren := OrderedCollection new: 10.
	aMorph recursiveAddTo: allChildren.
	allChildren do: [:each | 
		((each canExpand
			and: [each isExpanded not])
			and: [level > 0])
			ifTrue: [self expand: each to: level-1]].! !

!MorphTreeMorph methodsFor: 'scrolling' stamp: 'AlainPlantec 10/7/2011 18:28'!
scrollSelectionIntoView
	"make sure that the current selection is visible"
	self listManager selectedMorph
		ifNotNil: [:morph | self scrollToShow: morph bounds ]! !

!MorphTreeMorph methodsFor: 'events-processing' stamp: 'AlainPlantec 10/9/2011 01:23'!
keyStroke: event 
	"Process potential command keys."
	(self navigationKey: event) ifTrue: [^true].
	(self scrollByKeyboard: event) ifTrue: [^true].
	^ self listManager keyStroke: event! !

!MorphTreeMorph methodsFor: 'column handling' stamp: 'AlainPlantec 2/12/2010 21:46'!
columnDropUnabled
	"return true if column drop is enabled - see also #allowColumnDrop"
	^ columnDropUnabled ifNil: [columnDropUnabled := false]! !

!MorphTreeMorph methodsFor: 'events-processing' stamp: 'AlainPlantec 10/7/2011 22:23'!
mouseStillDown: anEvent
	(anEvent hand position y > self innerBounds bottom)
		ifTrue: [self listManager selectMoreAtBottom]
		ifFalse: [
			(anEvent hand position y < self innerBounds top)
				ifTrue: [self listManager selectMoreAtTop]
				ifFalse: [super mouseStillDown: anEvent]]! !

!MorphTreeMorph methodsFor: 'expanding-collapsing' stamp: 'AlainPlantec 2/17/2010 20:28'!
expandAllSuchThat: aBlock
	self roots do: [:m | self expand: m suchThat: aBlock].
	self innerWidgetChanged! !

!MorphTreeMorph methodsFor: 'expanding-collapsing' stamp: 'BenjaminVanRyseghem 11/22/2013 15:33'!
expandRoots
	"Expand all the receiver's roots"
	
	self roots
		do: [:each |
			(each canExpand and: [each isExpanded not])
				ifTrue: [each toggleExpandedState]].
	self innerWidgetChanged! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 10/16/2013 12:15'!
enable
	self enabled: true! !

!MorphTreeMorph methodsFor: 'expanding-collapsing' stamp: 'MarcusDenker 10/28/2010 14:02'!
expandSilently: aMorph suchThat: aBlock
	(aBlock value: aMorph complexContents)
		ifTrue: [
			aMorph isExpanded ifFalse: [aMorph expand].
			aMorph childrenDo: [:ch | self expandSilently: ch suchThat: aBlock]].
! !

!MorphTreeMorph methodsFor: 'accessing colors' stamp: 'AlainPlantec 2/3/2010 09:46'!
lineColor: aColor
	lineColorBlock := [:node | aColor]
! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/1/2010 09:02'!
iconBlock
	^ iconBlock ifNil: [[:node | node icon]]! !

!MorphTreeMorph methodsFor: 'column handling' stamp: 'AlainPlantec 10/1/2011 08:59'!
rowMorphsWidths
	"Return all row morphs witdhs based on the header bounds. 
	used when a resizer is moved horizontally or if some 
	change implies that the list is rebuilt"
	| result |
	result :=  self headerBounds collect: [:b | b width].
	result ifNotEmpty: [result at: 1 put: ((result at: 1) - 3 )].
	^ result
! !

!MorphTreeMorph methodsFor: 'column handling' stamp: 'AlainPlantec 2/12/2010 21:31'!
columnResizerFrames
	"return all resizers bounds in a collection - used to update column resizers position"
	| xOffset frms |
	xOffset := 0.
	frms := self columns collect: [:col | 
		xOffset := self minResizerOffset max: (xOffset + col currentWidth).
		scroller left + xOffset @ self top corner: scroller left + xOffset + self resizerWidth @ scroller bottom].
	"If the last column is unbounded, then its frame is removed from the collection because 
	no resizer is added for the last column"
	self lastColumnUnbounded  
		ifTrue: [frms 
			ifNotEmpty: [frms removeLast]].
	^ frms collect: [:f | f translateBy: (scroller offset x negated @ 0)]! !

!MorphTreeMorph methodsFor: 'announce requests' stamp: 'AlainPlantec 5/26/2012 00:10'!
selectItemsRequest: anAnnounce
	self selectedItems: anAnnounce itemsToSelect ! !

!MorphTreeMorph methodsFor: 'event handling' stamp: 'alain.plantec 10/12/2009 23:25'!
handlesKeyboard: evt
	^true! !

!MorphTreeMorph methodsFor: 'geometry' stamp: 'AlainPlantec 1/27/2010 11:25'!
resizerWidth
	^ resizerWidth ifNil:[resizerWidth := 3]! !

!MorphTreeMorph methodsFor: 'column handling' stamp: 'AlainPlantec 2/13/2010 07:38'!
makeLastColumnBounded
	"Make the last column horizontally resizable with a resizer"
	self lastColumnBounded 
		ifFalse: [
			unboundLastColumn := false.
			self columnsChanged]
! !

!MorphTreeMorph methodsFor: 'announce requests' stamp: 'AlainPlantec 5/26/2012 00:08'!
changeSelectionRequest: anAnnounce
	self updateSelectionFromModel! !

!MorphTreeMorph methodsFor: '*Keymapping-Core' stamp: 'StephaneDucasse 6/22/2014 11:56'!
initializeShortcuts: aKMDispatcher

	super initializeShortcuts: aKMDispatcher.
	aKMDispatcher attachCategory: #MorphFocusNavigation! !

!MorphTreeMorph methodsFor: 'geometry' stamp: 'AlainPlantec 2/3/2012 21:42'!
vExtraScrollRange
	"Return the amount of extra blank space to include below the bottom of the scroll content."
	"The classic behavior would be ^bounds height - (bounds height * 3 // 4)"
	"Takes into accound the top header height if present"
	^ super vExtraScrollRange + self topHeaderHeight 
! !

!MorphTreeMorph methodsFor: 'announce requests' stamp: 'AlainPlantec 5/28/2012 14:29'!
changeRequest: anAnnounce
	^ anAnnounce change: self! !

!MorphTreeMorph methodsFor: 'column handling' stamp: 'AlainPlantec 2/12/2010 21:33'!
columns
	"Return a column definitions, if empty, return a collection with one column"
	^columns ifNil: [self columns: (OrderedCollection with: MorphTreeColumn new). columns]! !

!MorphTreeMorph methodsFor: 'expanding-collapsing' stamp: 'MarcusDenker 9/13/2013 16:30'!
expandAllSilently: aMorph
	aMorph isExpanded ifFalse: [aMorph expand].
	aMorph childrenDo: [:ch | self expandAllSilently: ch].
	

! !

!MorphTreeMorph methodsFor: 'submorphs-add/remove' stamp: 'AlainPlantec 10/7/2011 18:52'!
addSubmorphsFromNodeList: aNodeList previouslyExpanded: expandedNodeList
	| morphList  |
	morphList := OrderedCollection new.
	self 
		addMorphsTo: morphList
		from: aNodeList
		withExpandedItems: expandedNodeList
		atLevel: 0.
	self insertNewMorphs: morphList.
	self listManager updateSelectionFromModel.
	self roots do: [:r | r updateChildrenRecursively].
	self updateColumnMorphs
	! !

!MorphTreeMorph methodsFor: 'events-processing' stamp: 'AlainPlantec 10/9/2011 01:21'!
handleMouseMove: anEvent
	"Reimplemented because we really want #mouseMove when a morph is dragged around"
	
	anEvent wasHandled 
		ifTrue:[^self]. 	
	(anEvent isDraggingEvent or:[ anEvent anyButtonPressed and:[anEvent hand mouseFocus == self]]) 
		ifFalse:[^self].
	anEvent wasHandled: true.
	self mouseMove: anEvent.
	(self handlesMouseStillDown: anEvent) 
		ifTrue: [
			"Step at the new location"
			self startStepping: #handleMouseStillDown: 
				at: Time millisecondClockValue + self mouseStillDownThreshold
				arguments: {anEvent copy resetHandlerFields}
				stepTime: self mouseStillDownStepRate].
! !

!MorphTreeMorph methodsFor: 'selection' stamp: 'AlainPlantec 10/7/2011 21:34'!
selectAll
	self listManager selectAll! !

!MorphTreeMorph methodsFor: 'expanding-collapsing' stamp: 'AlainPlantec 10/29/2009 10:08'!
toggleImageWidth
	^ self expandedToggleImage width max: self notExpandedToggleImage width.! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 10/17/2013 09:28'!
model: aTreeModel
	self model ifNotNil: [self model announcer unsubscribe: self].
	super model: aTreeModel.
	self registerRequestHandlers
! !

!MorphTreeMorph methodsFor: 'geometry' stamp: 'AlainPlantec 1/31/2010 22:56'!
gapAfterToggle
	"horizontal space after the toggle"
	^ gapAfterToggle ifNil: [gapAfterToggle := 5]! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/31/2011 16:25'!
mouseDownHighlightColor
	"Answer a good color to use for drawing the mouse down highlight.
	Used the line color if not transparent, otherwise a contrasting color in the
	same way as the line color is determined.
	Fall back to black if all my owners are transparent."

	|colored |
	colored := self color isTransparent
		ifTrue: [self firstOwnerSuchThat: [:o | o isWorldOrHandMorph not and: [o color isTransparent not]]]
		ifFalse: [self].
	colored ifNil: [^Color black].
	^colored color luminance > 0.5
		ifTrue: [Color black]
		ifFalse: [Color white]
! !

!MorphTreeMorph methodsFor: 'column handling' stamp: 'AlainPlantec 2/12/2010 22:05'!
removeColumnAtIndex: aPosition.
	"remove a column at a given position - rough implementation"
	self columns removeAt: aPosition.
	self columnsChanged.
	self updateList.




! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/3/2010 10:04'!
treeLineDashes
	^ treeLineDashes 
		ifNil: [treeLineDashes := self theme treeLineDashes]
	
! !

!MorphTreeMorph methodsFor: 'column handling' stamp: 'AlainPlantec 2/12/2010 22:02'!
lastColumnBounded
	"Return true if the last column can be resized with a resizer"
	^ self lastColumnUnbounded not! !

!MorphTreeMorph methodsFor: 'events-processing' stamp: 'BenjaminVanRyseghem 5/7/2013 14:19'!
yellowButtonEvent: anEvent

	(self scrollerSubMorphFromPoint: anEvent position) 
		ifNotNil: [:sel |
			sel selected
				ifFalse: [self listManager setSelectedMorph: sel].
			^ self yellowButtonActivity: anEvent shiftPressed ].
	^ self yellowButtonActivity: anEvent shiftPressed! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/9/2009 13:24'!
topHeaderHeight
	| h |
	self topHeader 
		ifNil: [^ 0] 
		ifNotNil: [:th | 
			h := th borderWidth * 2.
			self columns do: [:col | h := h max: col height].
			^ h]
		! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/8/2009 18:41'!
topHeader
	^ topHeader ! !

!MorphTreeMorph methodsFor: 'dropping/grabbing' stamp: 'AlainPlantec 2/12/2010 21:22'!
potentialDropMorph: aMorph
	"Set the morph (the MorphTreeNodeMorph) 
	which is the current drop target candidate "
	potentialDropMorph := aMorph.
	aMorph highlightForDrop! !

!MorphTreeMorph methodsFor: 'selection' stamp: 'AlainPlantec 11/25/2009 09:27'!
selectionFrameFor: aNodeMorph
	"Answer the frame of aNodeMorph in the receiver"
	^ aNodeMorph bounds:  aNodeMorph selectionFrame in: self! !

!MorphTreeMorph methodsFor: 'updating' stamp: 'AlainPlantec 10/3/2011 11:11'!
privateUpdateColumnMorphs
	self resetRootInfo.
	self updateTopHeader.
	self innerWidgetChanged.
! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/12/2010 22:02'!
itemStringGetter: aValuable
	"Set how to get a string for the first column with a valuable which 
	takes a row item (from a MorphTreeMorphNode point of view, its complexContents item) as argument"
	self columns first itemStringGetter: aValuable! !

!MorphTreeMorph methodsFor: 'updating' stamp: 'AlainPlantec 1/30/2010 09:09'!
updateTopHeader
	self topHeader ifNotNil: [:th | | w |
		th width: scroller width.
		w := self headerBounds.
		th submorphsDo: [:sm | w ifNotEmpty: [sm bounds: w removeFirst; layoutInset: self columnInset @ 0]]].
! !

!MorphTreeMorph methodsFor: 'expanding-collapsing' stamp: 'StephaneDucasse 5/23/2013 18:39'!
expandedToggleImage
	^ expandedToggleImage ifNil: [expandedToggleImage := ImageMorph new form: self expandedForm].
! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 10/29/2009 10:08'!
withHLines: aBoolean
	withHLines := aBoolean! !

!MorphTreeMorph methodsFor: 'geometry' stamp: 'AlainPlantec 10/11/2011 00:37'!
extent: newExtent
	super extent: newExtent.
	self resizerChanged.
! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/15/2009 21:58'!
indentingItemClass
	
	^ MorphTreeNodeMorph! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 10/6/2011 16:58'!
roots
	"Answer the receiver's roots"
	^ self rootsFrom: self allNodeMorphs
! !

!MorphTreeMorph methodsFor: 'updating' stamp: 'AlainPlantec 10/3/2011 00:29'!
innerWidgetChanged
	self setScrollDeltas.
	self updateColumnMorphsWidth.
	self adjustSubmorphPositions.
! !

!MorphTreeMorph methodsFor: 'accessing colors' stamp: 'MarcusDenker 10/3/2013 23:48'!
lineColorForNode: aNode
	"Answer a good color to use for drawing the lines that connect members of the hierarchy view.
	Used the cached color, or derive it if necessary by finding the receiver or 
	the first owner (up to my root) that is not transparent, then picking a contrasting color.
	Fall back to black if all my owners are transparent."

	^ lineColorBlock
		ifNotNil: [lineColorBlock value: aNode]
		ifNil: [
			| colored |
			colored := self color isTransparent
				ifTrue: [self firstOwnerSuchThat: [:o | o isWorldOrHandMorph not and: [o color isTransparent not]]]
				ifFalse: [self].
			colored 
				ifNil: [Color black]
				ifNotNil: [colored color luminance > 0.5
					ifTrue: [Color black]
					ifFalse: [Color white]]]
	
! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 10/9/2011 00:11'!
firstNodeMorph
	"returns the first scroller submorph if not empty, or nil if empty"
	^ self allNodeMorphs ifEmpty: [nil] ifNotEmpty: [scroller submorphs at: 1]! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 1/31/2010 22:53'!
firstChild
	"returns the first scroller submorph if not empty, or nil if empty"
	^ self firstNodeMorph! !

!MorphTreeMorph methodsFor: 'expanding-collapsing' stamp: 'AlainPlantec 1/31/2010 22:23'!
currentlyExpanded

	^ self expandedNodesFrom: (self allNodeMorphs).
	! !

!MorphTreeMorph methodsFor: 'selection' stamp: 'AlainPlantec 2/12/2011 19:32'!
selectionChanged
	self changed
! !

!MorphTreeMorph methodsFor: 'updating' stamp: 'AlainPlantec 10/29/2009 10:08'!
resetRootInfo
	hasToggleAtRoot := nil.! !

!MorphTreeMorph methodsFor: 'events-processing' stamp: 'AlainPlantec 10/7/2011 21:18'!
doubleClick: anEvent 
	| targetMorph |
	targetMorph := self scrollerSubMorphFromPoint: anEvent position.
	(self listManager doubleClick:  anEvent on: targetMorph)
		ifFalse: [super doubleClick: anEvent]
! !

!MorphTreeMorph methodsFor: 'updating' stamp: 'AlainPlantec 10/3/2011 00:11'!
resizerChanged
	self columns size > 1
		ifTrue: [
			self updateColumnResizersXOffset;
				resizeScroller;
				updateColumnMorphs]
		ifFalse: [self updateTopHeader]! !

!MorphTreeMorph methodsFor: 'scrolling' stamp: 'AlainPlantec 11/14/2009 09:06'!
scrollDeltaWidth
	"A guess -- assume that the width of a char is approx 1/2 the height of the font"
	^ self scrollDeltaHeight // 2


! !

!MorphTreeMorph methodsFor: 'submorphs-add/remove' stamp: 'BenjaminVanRyseghem 11/26/2013 18:29'!
addMorphsAfter: parentMorph fromCollection: aCollection
	"Sent when expanding a node in order to add chilldren nodes after the expanded node"
	| priorMorph morphList  subs |
	priorMorph := nil.
	morphList := OrderedCollection new.
	
	"prepare the list of nodes to be added"
	aCollection do: [:item | 
		priorMorph := self indentingItemClass new 
			initWithContents: item 
			prior: priorMorph 
			forList: self
			indentLevel: parentMorph indentLevel + 1.
		morphList add: priorMorph.
		"Was this row expanded ? if true -> expand it
			again " 
			priorMorph isExpanded
				ifTrue: [priorMorph isExpanded: true.
					priorMorph
						addChildrenForList: self
						addingTo: morphList
						withExpandedItems: #()] ].
	
	"Set new child morphs index"
	1 to: morphList size do: [:i | | m | (m := morphList at: i) index: i + parentMorph index].
	"Add the new morph list in the scroller"
	scroller addAllMorphs: morphList after: parentMorph.
	"update next morphs index"
	subs := self allNodeMorphs.
	morphList last index to: subs size do: [:pos | (subs at: pos) index: pos].
	"set the new morphs widths according to columns width"
	self updateColumnMorphsWidth.
	morphList do: [ :e | e doLayoutIn: e layoutBounds ].
	^morphList
	
! !

!MorphTreeMorph methodsFor: 'column handling' stamp: 'AlainPlantec 2/12/2010 21:38'!
swapColumnAt: oneIndex withColumnAt: anotherIndex
	"swap two column - very rough implementation which 
	simply rebuild everything"
	self columns swap: oneIndex with: anotherIndex. 
	self columnsChanged.
	self updateList.
	self columnResizersToFront
! !

!MorphTreeMorph methodsFor: 'geometry' stamp: 'AlainPlantec 2/2/2010 16:30'!
treeLineWidth: anInteger
	treeLineWidth := anInteger! !

!MorphTreeMorph methodsFor: 'accessing colors' stamp: 'AlainPlantec 11/20/2009 16:51'!
rowColorForEven: evenColor odd: oddColor
	rowColors at: 2 put: oddColor.
	rowColors at: 1 put: evenColor.
	! !

!MorphTreeMorph methodsFor: 'updating' stamp: 'AlainPlantec 10/11/2011 13:30'!
adjustSubmorphPositionsOf: aCollection startIdx: anIndex startPos: aStartPoint
	| p idx |
	p := aStartPoint.
	idx := anIndex.
	aCollection do: [ :each | | h |
		h := each height.
		each index: idx.
		each bounds: (p extent: each width @ h).
		maxNodeWidth := maxNodeWidth max: (each fullBounds width).
		idx := idx + 1.
		p := p + (0@h)].
	
	self setScrollDeltas.
	^ p
	! !

!MorphTreeMorph methodsFor: 'column handling' stamp: 'AlainPlantec 2/12/2010 22:02'!
lastColumnUnbounded
	"Return true if the last column can not be resized with a resizer"
	^ unboundLastColumn ifNil: [unboundLastColumn := true]! !

!MorphTreeMorph methodsFor: 'accessing colors' stamp: 'AlainPlantec 11/20/2009 16:59'!
rowColors
	^ rowColors! !

!MorphTreeMorph methodsFor: 'accessing colors' stamp: 'AlainPlantec 4/28/2011 22:32'!
rowColorForEven: evenColor 
	rowColors at: 1 put: evenColor.
	! !

!MorphTreeMorph methodsFor: 'event handling' stamp: 'AlainPlantec 10/9/2011 15:08'!
handlesMouseOver: evt
	^ self mouseOverAllowed ! !

!MorphTreeMorph methodsFor: 'dropping/grabbing' stamp: 'AlainPlantec 2/12/2010 21:46'!
forbidColumnDrop
	"Do not allow column drag and drop"
	columnDropUnabled := false! !

!MorphTreeMorph methodsFor: 'updating' stamp: 'AlainPlantec 10/11/2011 01:11'!
updateColumnMorphsWidth
	| rowMorphsWidths |
	self columns size > 1 ifFalse: [^ self].
	rowMorphsWidths := self rowMorphsWidths.
	self allNodeMorphs do: [:i | i updateColumnMorphsWidthWith: rowMorphsWidths].
! !

!MorphTreeMorph methodsFor: 'updating' stamp: 'AlainPlantec 11/15/2009 18:02'!
removeTopHeader
	topHeader 
		ifNotNil: [self removeMorph: topHeader.
		topHeader := nil]
! !

!MorphTreeMorph methodsFor: 'initialize - release' stamp: 'AlainPlantec 10/7/2011 21:27'!
release
	lineColorBlock := nil.
	columnResizers := nil.
	preferedPaneColor := nil.
	expandedToggleImage := nil.
	notExpandedToggleImage := nil.
	columns 
		ifNotNil: [
			columns do: [:col | col release]. 
			columns := nil].
	listManager 
		ifNotNil: [
			listManager release.
			listManager := nil].
	super release.! !

!MorphTreeMorph methodsFor: 'geometry' stamp: 'AlainPlantec 1/31/2010 22:56'!
columnInset
	"Horizontal space between a resizer and a row morph"
	^ columnInset ifNil: [columnInset := 0]! !

!MorphTreeMorph methodsFor: 'announce requests' stamp: 'AlainPlantec 5/26/2012 00:07'!
changeListRequest: anAnnounce
	self updateList! !

!MorphTreeMorph methodsFor: 'selection' stamp: 'AlainPlantec 10/8/2011 23:48'!
emptySelection
	self listManager emptySelection! !

!MorphTreeMorph methodsFor: 'drawing' stamp: 'AlainPlantec 10/6/2011 10:19'!
drawOn: aCanvas 
	super drawOn: aCanvas.
	self columns do: [:col | col drawColumnOn: aCanvas].

	
! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 10/16/2013 12:15'!
disable
	self enabled: false! !

!MorphTreeMorph methodsFor: 'geometry' stamp: 'AlainPlantec 11/15/2009 18:16'!
resizerWidth: anInteger
	resizerWidth := anInteger.
! !

!MorphTreeMorph methodsFor: 'column handling' stamp: 'AlainPlantec 2/12/2010 22:05'!
removeColumnResizers
	"Remove all column resizers"
	self removeAllMorphsIn: self columnResizers.
	self columnResizers do: [:r | r release].
	self columnResizers removeAll! !

!MorphTreeMorph methodsFor: 'geometry' stamp: 'AlainPlantec 2/2/2010 16:31'!
treeLineWidth
	^ treeLineWidth ifNil: [treeLineWidth := self  theme treeLineWidth] ! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 10/6/2011 16:57'!
rootsFrom: aCollectionOfNodes
	"Answer the receiver's roots"
	^ aCollectionOfNodes
		select: [:each | each indentLevel isZero]! !

!MorphTreeMorph methodsFor: 'expanding-collapsing' stamp: 'AlainPlantec 10/17/2013 12:00'!
expandAllFromNode: aNode
		self expandAll: ((self nodeMorphOfNode: aNode) ifNil: [^self]).
		self adjustSubmorphPositions
! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 10/3/2011 09:59'!
nodeStringGetter: aValuable
	"Set how to get a string for the first column node with a valuable which 
	takes a row  MorphTreeMorphNode as argument"
	self columns first nodeStringGetter: aValuable! !

!MorphTreeMorph methodsFor: 'selection' stamp: 'AlainPlantec 10/11/2011 11:06'!
beCheckList
	self isCheckList: true. ! !

!MorphTreeMorph methodsFor: 'updating' stamp: 'AlainPlantec 10/11/2011 10:22'!
adjustSubmorphPositions
	maxNodeWidth := 0.
	^ self adjustSubmorphPositionsOf: self allNodeMorphs startIdx: 1 startPos: 0@0 
! !

!MorphTreeMorph methodsFor: 'expanding-collapsing' stamp: 'alain.plantec 10/12/2009 23:25'!
expandedForm
	"Answer the form to use for expanded items."
	
	^self theme treeExpandedForm! !

!MorphTreeMorph methodsFor: 'geometry' stamp: 'AlainPlantec 11/15/2009 18:16'!
indentGap: anInteger
	indentGap := anInteger.
! !

!MorphTreeMorph methodsFor: 'event handling' stamp: 'GuillermoPolito 5/23/2012 11:40'!
keyboardFocusChange: aBoolean
	"The message is sent to a morph when its keyboard focus changes.
	Update for focus feedback."
	super keyboardFocusChange: aBoolean.
	self focusChanged! !

!MorphTreeMorph methodsFor: 'accessing colors' stamp: 'AlainPlantec 11/17/2009 19:47'!
columnColorForEven: evenColor 
	columnColors at: 2 put: nil.
	columnColors at: 1 put: evenColor.
	! !

!MorphTreeMorph methodsFor: 'drawing' stamp: 'AlainPlantec 10/6/2011 10:24'!
drawLinesOn: aCanvas
	"Draw the lines for the submorphs.
	Modified for performance."
	self hasToggleAtRoot ifFalse: [^ self].
	aCanvas 
		transformBy: scroller transform
		clippingTo: scroller innerBounds
		during: [:clippedCanvas |
			scroller submorphsDo: [ :submorph | | last |
				((submorph isExpanded and: [
					(submorph nextSibling notNil and: [
						clippedCanvas isVisible: (submorph fullBounds topLeft
							corner: submorph nextSibling fullBounds bottomRight)]) or: [
					submorph nextSibling isNil and: [(last := submorph lastChild) notNil and: [
						clippedCanvas isVisible: (submorph fullBounds topLeft
							corner: last fullBounds bottomRight)]]]]) or: [
				(clippedCanvas isVisible: submorph fullBounds) or: [
				(submorph nextSibling notNil and: [
						clippedCanvas isVisible: submorph nextSibling fullBounds])]]) ifTrue:[
					submorph drawLinesOn: clippedCanvas]]]
		smoothing: scroller smoothing
! !

!MorphTreeMorph methodsFor: 'updating' stamp: 'AlainPlantec 11/12/2009 21:18'!
updateColumnResizersHeight
	self columnResizers do: [:col | | b |
		b :=  col bounds.
		b := b left @ self top corner: b right @ scroller bottom.
		col bounds: b].
! !

!MorphTreeMorph methodsFor: 'expanding-collapsing' stamp: 'AlainPlantec 10/7/2011 13:18'!
expandedFormForMorph: aMorph
	"Answer the form to use for expanded items."
	
	^ ((aMorph selected) and: [self selectionColor luminance < 0.7])
		ifTrue: [self theme whiteTreeExpandedForm]
		ifFalse: [self theme treeExpandedForm]! !

!MorphTreeMorph methodsFor: 'geometry' stamp: 'AlainPlantec 10/29/2009 10:07'!
indentGap
	^ indentGap ifNil: [indentGap := 20]! !

!MorphTreeMorph methodsFor: 'updating' stamp: 'AlainPlantec 10/10/2011 11:07'!
buildContents
	nodeList := nil.
	scroller removeAllMorphs.
	(self nodeList isNil or: [self nodeList isEmpty]) 
		ifTrue: [
			nodeList := nil.	
			^ self emptySelection].
	self addSubmorphsFromNodeList.
! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 1/18/2010 17:49'!
nodeList
	^ nodeList ifNil: [nodeList := self getList]
! !

!MorphTreeMorph methodsFor: 'updating' stamp: 'AlainPlantec 10/9/2011 17:00'!
insertNewMorphs: morphList
	scroller addAllMorphs: morphList.
! !

!MorphTreeMorph methodsFor: 'selection' stamp: 'EstebanLorenzano 4/29/2014 17:29'!
secondarySelectionColor

	^ self theme secondarySelectionColor! !

!MorphTreeMorph methodsFor: 'events-processing' stamp: 'MartinDias 2/24/2014 18:08'!
startDrag: anEvent 
	| aTransferMorph itemMorph passenger |
	self dragEnabled
		ifTrue: [itemMorph := self allNodeMorphs
						detect: [:any | any highlightedForMouseDown]
						ifNone: []].
	(itemMorph isNil
			or: [anEvent hand hasSubmorphs])
		ifTrue: [^ self].
	itemMorph highlightForMouseDown: false.
	
	(self listManager selectedMorphList includes: itemMorph)
		ifFalse: [self listManager setSelectedMorph: itemMorph].
		
	passenger := self model dragPassengerFor: itemMorph inMorph: self.
	passenger
		ifNotNil: [
			aTransferMorph := self model transferFor: passenger from: self.
				"Ask the draggedMorph otherwise the transferMorph has not yet its bounds"
			aTransferMorph align: aTransferMorph draggedMorph center with: anEvent position.
			aTransferMorph
				dragTransferType: (self model dragTransferTypeForMorph: self).
			anEvent hand grabMorph: aTransferMorph].
	anEvent hand releaseMouseFocus: self! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 10/8/2011 17:42'!
getList 
	"Answer the full list to be displayed."
	^ model rootNodes.
! !

!MorphTreeMorph methodsFor: 'expanding-collapsing' stamp: 'MarcusDenker 10/28/2010 14:11'!
expandAll: aMorph
	|  subs |
	self expandAllSilently: aMorph.
	aMorph updateChildrenRecursively.
	subs := self scroller submorphs.
	1 to: subs size do: [:pos | (subs at: pos) index: pos].
	"set the new morphs widths according to columns width"
	self innerWidgetChanged.

! !

!MorphTreeMorph methodsFor: 'selection' stamp: 'AlainPlantec 10/8/2011 13:50'!
beSingle	
	self listManager multipleSelection: false! !

!MorphTreeMorph methodsFor: 'selection' stamp: 'AlainPlantec 2/11/2011 10:37'!
selectionColorToUse: aColor
	"Set the colour for selected items."

	aColor = self selectionColorToUse ifTrue: [^self].
	aColor
		ifNil: [self removeProperty: #selectionColorToUse]
		ifNotNil: [self setProperty: #selectionColorToUse toValue: aColor].
! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 18:02'!
listManager
	^ listManager ifNil: [listManager := MorphTreeListManager new client: self] ! !

!MorphTreeMorph methodsFor: 'announce requests' stamp: 'AlainPlantec 5/26/2012 19:30'!
nodeCollapseRequest: anAnnounce
	anAnnounce nodes
		ifEmpty: [self collapseAll]
		ifNotEmpty: [:nodes | self collapseNodePath: nodes]
! !

!MorphTreeMorph methodsFor: 'accessing colors' stamp: 'AlainPlantec 11/17/2009 19:40'!
columnColors 
	^ columnColors ! !

!MorphTreeMorph methodsFor: 'events-processing' stamp: 'AlainPlantec 10/16/2013 12:36'!
mouseDown: event 
	"Changed to take keybaord focus."
	| targetMorph selectors |
	self enabled ifFalse: [ ^self ].
	mouseOverAllowed := true.
	self wantsKeyboardFocus
		ifTrue: [self takeKeyboardFocus].
	(event yellowButtonPressed and: [(self commandOrCrontrolKeyPressed: event) not])
		ifTrue: ["First check for option (menu) click"			
			^ self yellowButtonEvent: event].
	(targetMorph := self scrollerSubMorphFromPoint: event position)
		ifNotNil: [targetMorph hasToggle
				ifTrue: [(targetMorph
							inToggleArea: (targetMorph point: event position from: self))
						ifTrue: [^ self toggleExpandedState: targetMorph event: event]]].
	targetMorph
		ifNil: [^ super mouseDown: event].
	targetMorph highlightForMouseDown.
	selectors := Array
				with: #click:
				with: #doubleClick:
				with: nil
				with: (self dragEnabled
						ifTrue: [#startDrag:]).
	event hand
		waitForClicksOrDrag: self
		event: event
		selectors: selectors
		threshold: 10.

	self listManager mouseDown: event on: targetMorph

! !

!MorphTreeMorph methodsFor: 'event handling' stamp: 'AlainPlantec 10/9/2011 01:27'!
handlesMouseStillDown: anEvent
	"Still down event is used to scroll the selection 
	when the mouse is outside (upon the top of 
	below the bottom)"
	^ (self innerBounds containsPoint: anEvent position) not! !

!MorphTreeMorph methodsFor: 'announce requests' stamp: 'AlainPlantec 5/26/2012 00:09'!
collapseRequest: anAnnounce
	anAnnounce nodes
		ifEmpty: [^ self collapseAll]
		ifNotEmpty: [:nodes | self collapseNodePath: nodes]

! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 10/16/2013 12:15'!
enabled
	^ enabled ifNil: [ enabled := super enabled ]! !

!MorphTreeMorph methodsFor: 'updating' stamp: 'AlainPlantec 10/6/2011 10:46'!
updateColumnMorphs
	self privateUpdateColumnMorphs
! !

!MorphTreeMorph methodsFor: 'expanding-collapsing' stamp: 'MarcusDenker 10/28/2010 14:03'!
expand: aMorph suchThat: aBlock
	(aBlock value: aMorph complexContents)
		ifTrue: [
			aMorph isExpanded ifFalse: [aMorph expand].
			aMorph childrenDo: [:ch | self expandSilently: ch suchThat: aBlock]].
	self innerWidgetChanged.! !

!MorphTreeMorph methodsFor: 'selection' stamp: 'BenjaminVanRyseghem 11/21/2013 22:50'!
removeOnlyLastSelected: aBoolean
	self listManager removeOnlyLastSelected: aBoolean! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/2/2010 16:31'!
withTreeLines
	^ self  treeLineWidth > 0! !

!MorphTreeMorph methodsFor: 'geometry' stamp: 'AlainPlantec 10/11/2011 13:11'!
innerBounds
	| inner |
	inner := super innerBounds.
	inner := inner withTop: self top + self topHeaderHeight.
	^ inner! !

!MorphTreeMorph methodsFor: 'selection' stamp: 'EstebanLorenzano 4/29/2014 16:47'!
selectionColorToUse
	"Answer the colour to use for selected items."
	self enabled ifFalse: [ ^ self paneColor ].
	^ self valueOfProperty: #selectionColorToUse 
		ifAbsent: [ self theme selectionColor ].! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 10/18/2013 20:00'!
setSelectedMorph: aNodeMorph 
	self listManager setSelectedMorph: aNodeMorph! !

!MorphTreeMorph methodsFor: 'selection' stamp: 'AlainPlantec 10/7/2011 16:19'!
autoMultiSelection: aBoolean
	self listManager autoMultiSelection: aBoolean! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/1/2010 09:03'!
iconBlock: aValuableWithOneArg
	"A valuable which value is an icon or nil. takes a node as argument"
	iconBlock := aValuableWithOneArg! !

!MorphTreeMorph methodsFor: 'enumeration' stamp: 'alain.plantec 10/24/2009 23:08'!
childrenDo: aBlock
	self roots do: aBlock! !

!MorphTreeMorph methodsFor: 'dropping/grabbing' stamp: 'AlainPlantec 2/12/2010 21:21'!
potentialDropMorph
	"return the morph (the MorphTreeNodeMorph) 
	which is the current drop target candidate "
	^potentialDropMorph! !

!MorphTreeMorph methodsFor: 'geometry' stamp: 'AlainPlantec 1/25/2010 08:34'!
rowInset: anInteger
	rowInset := anInteger.
! !

!MorphTreeMorph methodsFor: 'selection' stamp: 'AlainPlantec 10/11/2011 11:06'!
isCheckList: aBoolean
	self listManager isCheckList: aBoolean. ! !

!MorphTreeMorph methodsFor: 'geometry' stamp: 'AlainPlantec 1/25/2010 08:34'!
rowInset
	^ rowInset  ifNil: [rowInset := 0]
! !

!MorphTreeMorph methodsFor: 'selection' stamp: 'AlainPlantec 9/26/2011 23:44'!
selectionColor: aColor
	"Set the colour for selected items."

	| w |
	aColor
		ifNil: [self removeProperty: #selectionColor]
		ifNotNil: [self setProperty: #selectionColor toValue: aColor].
	w := self ownerThatIsA: SystemWindow.
	self selectionColorToUse: (
		(self theme settings fadedBackgroundWindows not or: [w isNil or: [w isActive]])
			ifTrue: [aColor]
			ifFalse: [self theme unfocusedSelectionColor])! !

!MorphTreeMorph methodsFor: 'updating' stamp: 'AlainPlantec 11/18/2009 09:54'!
updateColumnResizersXOffset
	self columnResizerFrames with: self columnResizers do: [:frm :resizer | resizer bounds: (frm withBottom: scroller bottom)].
! !

!MorphTreeMorph methodsFor: 'geometry' stamp: 'AlainPlantec 11/3/2009 17:29'!
minResizerOffset
	^ 20! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 1/31/2010 22:52'!
doubleClickSelector: aSelector
	"set doubleClickBlock from a selector representing a message to sent to the model on double-click"
	self doubleClickBlock: [self model perform: aSelector]! !

!MorphTreeMorph methodsFor: 'events-processing' stamp: 'AlainPlantec 10/10/2011 22:17'!
mouseStillDownStepRate
	"At what rate do I want to receive #mouseStillDown: notifications?"
	^10! !

!MorphTreeMorph methodsFor: 'expanding-collapsing' stamp: 'AlainPlantec 10/18/2013 10:03'!
expandNodePath: aNodePath
	(self allNodeMorphs at: 1 ifAbsent: [^self]) 
		openNodePath: aNodePath! !

!MorphTreeMorph methodsFor: 'accessing colors' stamp: 'AlainPlantec 11/17/2009 19:47'!
columnColorForOdd: oddColor 
	columnColors at: 1 put: nil.
	columnColors at: 2 put: oddColor.
	! !

!MorphTreeMorph methodsFor: 'expanding-collapsing' stamp: 'StephaneDucasse 5/23/2013 18:39'!
notExpandedToggleImage
	^ notExpandedToggleImage ifNil: [notExpandedToggleImage := ImageMorph new form: self notExpandedForm].
! !

!MorphTreeMorph methodsFor: 'expanding-collapsing' stamp: 'AlainPlantec 10/17/2013 12:03'!
expandAll
	"Expand all of the roots"
	
	self roots reverseDo: [:m | self expandAllSilently: m].
	self innerWidgetChanged! !

!MorphTreeMorph methodsFor: 'updating' stamp: 'HilaireFernandes 4/21/2013 16:52'!
updateList
	|value|
	value := scrollBar value.
	self updateContentsWithPreviouslyExpanded: self currentlyExpanded.
	self vScrollValue: value! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 1/31/2010 22:26'!
allNodeMorphs
	"all list morphs"
	^ scroller submorphs
		! !

!MorphTreeMorph methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 5/15/2014 14:42'!
adoptPaneColor: paneColor
	"Pass on to the selection, the border"
	
	super adoptPaneColor: paneColor.
	paneColor ifNil: [^self].
	self color: (self preferedPaneColor ifNil: [ Smalltalk ui theme backgroundColor ] ).
! !

!MorphTreeMorph methodsFor: 'announce requests' stamp: 'AlainPlantec 5/26/2012 11:10'!
nodeExpandRequest: anAnnounce
	anAnnounce nodes
		ifEmpty: [self expandAll]
		ifNotEmpty: [:nodes | anAnnounce recur 
			ifTrue: [self expandAllFromNode: nodes last]
			ifFalse: [self expandNodePath: nodes]]
! !

!MorphTreeMorph methodsFor: 'expanding-collapsing' stamp: 'alain.plantec 10/12/2009 23:25'!
expandAll: aMorph except: aBlock
	| allChildren |
	(aBlock value: aMorph complexContents)
		ifFalse: [^self].
	aMorph toggleExpandedState.
	allChildren := OrderedCollection new: 10.
	aMorph recursiveAddTo: allChildren.
	allChildren do: [:each | 
		(each canExpand
			and: [each isExpanded not])
			ifTrue: [self expandAll: each except: aBlock]].! !

!MorphTreeMorph methodsFor: 'column handling' stamp: 'AlainPlantec 2/13/2010 08:10'!
swapColumn: aColumn withColumn: anotherColumn
	"column swapping - this is the default behavior for column drag & drop"
	self swapColumnAt:  aColumn index withColumnAt: anotherColumn index! !

!MorphTreeMorph methodsFor: 'selection' stamp: 'EstebanLorenzano 4/29/2014 14:46'!
selectionColor
	"Answer the colour to use for selected items."

	^ self 
		valueOfProperty: #selectionColor 
		ifAbsent: [ self theme selectionColor ]! !

!MorphTreeMorph methodsFor: 'dropping/grabbing' stamp: 'AlainPlantec 2/13/2010 08:09'!
allowColumnDrop
	"allowing column drop means that a column 
	can be dropped into another one. The default behavior is to swap the
	two columns"
	columnDropUnabled := true! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 10/16/2013 13:56'!
enabled: aBoolean
	enabled := aBoolean.
	self
		submorphsDo: [ :sm | 
			sm
				allMorphsDo: [ :m | 
					(m respondsTo: #enabled:)
						ifTrue: [ m enabled: aBoolean ] ] ].
	self changed: #enabled.
	self changed! !

!MorphTreeMorph methodsFor: 'event handling' stamp: 'alain.plantec 10/12/2009 23:25'!
handlesMouseOverDragging: evt
	^self dropEnabled! !

!MorphTreeMorph methodsFor: 'submorphs-add/remove' stamp: 'AlainPlantec 10/6/2011 13:04'!
addMorphsTo: morphList from: aCollection withExpandedItems: expandedItems atLevel: newIndent 
	"Sent when building the list (by #buildContents), takes
	into accound old expanded items: they remain 
	expanded such that a list update don't change the list
	visual state"
	| priorMorph firstAddition |
	priorMorph := nil.
	firstAddition := nil.
	"also for the system progress bar"
	aCollection
		doWithIndex: [:item :idx | 
			priorMorph := self indentingItemClass new
						initWithContents: item
						prior: priorMorph
						forList: self
						indentLevel: newIndent.
			firstAddition
				ifNil: [firstAddition := priorMorph].
			morphList add: priorMorph.
			"Was this row expanded ? if true -> expand it
			again " 
			((item hasEquivalentIn: expandedItems)
					or: [priorMorph isExpanded])
				ifTrue: [priorMorph isExpanded: true.
					priorMorph
						addChildrenForList: self
						addingTo: morphList
						withExpandedItems: expandedItems]].
	^ firstAddition! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 1/18/2010 17:31'!
nodeList: aCollection 
	nodeList := aCollection.
! !

!MorphTreeMorph methodsFor: 'events-processing' stamp: 'AlainPlantec 10/16/2013 12:35'!
mouseMove: evt

	| targetMorph |
	self enabled ifFalse: [ ^self ].
	targetMorph := self scrollerSubMorphFromPoint: evt position.
	evt hand hasSubmorphs 
		ifFalse: [(self innerBounds containsPoint: evt position)
			ifTrue: [self listManager mouseMove: evt on: targetMorph]].
		
	(self dropEnabled and: [evt hand hasSubmorphs]) 
		ifFalse:[^super mouseMove: evt].
		
	potentialDropMorph 
		ifNotNil:[
			(potentialDropMorph containsPoint: (potentialDropMorph point: evt position from: self))
				ifTrue:[^self]].
			
	self mouseLeaveDragging: evt.
	
	(self containsPoint: evt position) 
		ifTrue: [self mouseEnterDragging: evt].! !

!MorphTreeMorph methodsFor: 'selection' stamp: 'AlainPlantec 10/7/2011 21:34'!
deselectAll
	self listManager deselectAll! !

!MorphTreeMorph methodsFor: 'column handling' stamp: 'AlainPlantec 2/12/2010 21:32'!
columnResizers
	"return the resizers which make it possible 
	to resize columns horizontally with the mouse"
	^ columnResizers ifNil: [ columnResizers := OrderedCollection new ]! !

!MorphTreeMorph methodsFor: 'updating' stamp: 'AlainPlantec 10/18/2013 11:09'!
update: aSymbol
	aSymbol = self nodeListSelector
		ifTrue: [ ^ self updateList ].
	super update: aSymbol ! !

!MorphTreeMorph methodsFor: 'announce requests' stamp: 'AlainPlantec 10/18/2013 10:01'!
selectItems: aNodeItemCollection
	self selectedItems: aNodeItemCollection
! !

!MorphTreeMorph methodsFor: 'accessing colors' stamp: 'AlainPlantec 2/3/2010 09:45'!
lineColorBlock: aValuable
	lineColorBlock := aValuable
! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 10/1/2011 12:49'!
nodeListSelector
	^ #rootNodes
! !

!MorphTreeMorph methodsFor: 'column handling' stamp: 'AlainPlantec 2/12/2010 21:24'!
addColumnResizers
	"add all needed column resizers"
	columnResizers := self columnResizerFrames
				withIndexCollect: [:frm :idx | 
					(MorphTreeResizerMorph container: self index: idx) bounds: (frm translateBy: (scroller offset x negated @ 0))].
	self addAllMorphs: columnResizers.
	self columnResizersToFront! !

!MorphTreeMorph methodsFor: 'updating' stamp: 'AlainPlantec 2/1/2010 19:23'!
buildTopHeader
	| subs |
	subs := OrderedCollection new.
	self columns
		do: [:col |
			col container: self.
			subs add: (col header hResizing: #rigid; layoutChanged; yourself)].
	topHeader := Morph new fillStyle: self topHeaderBackground.
	self addMorph: topHeader.
	topHeader clipSubmorphs: true.
	topHeader borderColor: Color veryLightGray.
	topHeader color: Color transparent.
	topHeader borderWidth: 0.
	topHeader addAllMorphs: subs.
	topHeader bounds: (scroller left @ self top corner: scroller right @ (self top + self topHeaderHeight)).

! !

!MorphTreeMorph methodsFor: 'updating' stamp: 'AlainPlantec 10/18/2013 09:46'!
updateSelectionFromModel
	^ self listManager updateSelectionFromModel! !

!MorphTreeMorph methodsFor: 'selection' stamp: 'AlainPlantec 10/7/2011 16:18'!
autoMultiSelection
	^ self listManager autoMultiSelection! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/9/2009 10:54'!
topHeaderBackground: aFillStyle
	topHeaderBackground := aFillStyle! !

!MorphTreeMorph methodsFor: 'column handling' stamp: 'AlainPlantec 2/12/2010 22:04'!
makeLastColumnUnbounded
	"Make the last column not horizontally  resizable (no resizer for it)"
	unboundLastColumn := true
! !

!MorphTreeMorph methodsFor: 'accessing colors' stamp: 'AlainPlantec 4/28/2011 22:32'!
rowColorForOdd: oddColor 
	rowColors at: 2 put: oddColor.
	! !

!MorphTreeMorph methodsFor: 'expanding-collapsing' stamp: 'AlainPlantec 2/2/2010 22:24'!
expandAllTo: aLevel
	self roots do: [:m | self expand: m to: aLevel].
	self innerWidgetChanged! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/5/2010 23:04'!
nodeMorphOfNode: aNode
	^ self allNodeMorphs detect: [:m | m complexContents  = aNode] ifNone: []! !

!MorphTreeMorph methodsFor: 'event handling' stamp: 'AlainPlantec 10/9/2011 15:07'!
mouseOverAllowed
	^ mouseOverAllowed ifNil: [mouseOverAllowed := false]! !

!MorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/3/2010 10:04'!
treeLineDashes: anArrayOfInteger
	treeLineDashes := anArrayOfInteger
	
! !

!MorphTreeMorph methodsFor: 'expanding-collapsing' stamp: 'AlainPlantec 10/18/2013 10:07'!
collapseNodePath: aPath
	self allNodeMorphs first collapseNodePath: aPath! !

!MorphTreeMorph methodsFor: 'accessing colors' stamp: 'AlainPlantec 10/29/2009 10:08'!
preferedPaneColor
	^ preferedPaneColor! !

!MorphTreeMorph class methodsFor: 'instance creation' stamp: 'AlainPlantec 2/17/2010 22:37'!
on: anObject
	^ self new model: anObject
! !

!MorphTreeMorphMultipleSelection commentStamp: 'TorstenBergmann 9/5/2014 15:28'!
Multiple selections in a morphic based tree!
!MorphTreeMorphMultipleSelection methodsFor: 'accessing' stamp: 'AlainPlantec 9/27/2011 13:55'!
addNodePath: aPath
	self selectedNodePathList add: aPath! !

!MorphTreeMorphMultipleSelection methodsFor: 'accessing' stamp: 'AlainPlantec 11/26/2009 07:27'!
lastSelectedNodePath
	^ self selectedNodePathList ifNotEmpty: [:l | l last]! !

!MorphTreeMorphMultipleSelection methodsFor: 'accessing' stamp: 'AlainPlantec 9/27/2011 23:01'!
empty
	self selectedNodePathList: OrderedCollection new
! !

!MorphTreeMorphMultipleSelection methodsFor: 'accessing' stamp: 'AlainPlantec 9/27/2011 23:06'!
removeNode: aNode
	self selectedNodePathList remove: aNode path ifAbsent: []
! !

!MorphTreeMorphMultipleSelection methodsFor: 'accessing' stamp: 'AlainPlantec 9/27/2011 13:55'!
selectedNodePathList
	^ selectedNodePathList ifNil: [selectedNodePathList := OrderedCollection new]! !

!MorphTreeMorphMultipleSelection methodsFor: 'accessing' stamp: 'AlainPlantec 11/25/2009 22:05'!
selectedNodePathList: aCollectionOfPath
	selectedNodePathList := aCollectionOfPath! !

!MorphTreeMorphMultipleSelection methodsFor: 'accessing' stamp: 'AlainPlantec 11/25/2009 18:15'!
selectedNodeList
	^ self selectedNodePathList 
		ifNil: [#()]
		ifNotNil: [:l | l collect: [:path | path last]]! !

!MorphTreeMorphMultipleSelection methodsFor: 'accessing' stamp: 'AlainPlantec 11/25/2009 18:13'!
selectedNodes
	^ OrderedCollection withAll: self selectedNodeList
! !

!MorphTreeMorphMultipleSelection methodsFor: 'accessing' stamp: 'AlainPlantec 11/25/2009 18:13'!
selectedItemOrItemsOrNil
	| theItems |
	theItems := self selectedNodeList collect: [ :each | each item ].
	^ theItems isEmpty ifTrue: [nil] ifFalse: [ theItems ]! !

!MorphTreeMorphSelection commentStamp: 'TorstenBergmann 9/5/2014 15:27'!
Superclass for selections in a morphic based tree!
!MorphTreeMorphSelection methodsFor: 'accessing' stamp: 'AlainPlantec 9/27/2011 22:29'!
addNode: aNode
	self addNodePath: aNode path! !

!MorphTreeMorphSelection methodsFor: 'accessing' stamp: 'AlainPlantec 9/27/2011 13:53'!
addNodePath: aPath
	^ self subclassResponsibility 
	! !

!MorphTreeMorphSelection methodsFor: 'accessing' stamp: 'AlainPlantec 11/26/2009 07:26'!
lastSelectedNodePath 
	^ self subclassResponsibility! !

!MorphTreeMorphSelection methodsFor: 'accessing' stamp: 'AlainPlantec 1/11/2010 13:41'!
lastSelectedNode
	^ self lastSelectedNodePath ifNotNil: [:path | path ifEmpty: [nil] ifNotEmpty: [:p | path last]]! !

!MorphTreeMorphSelection methodsFor: 'accessing' stamp: 'AlainPlantec 9/27/2011 23:00'!
empty
	self subclassResponsibility ! !

!MorphTreeMorphSelection methodsFor: 'accessing' stamp: 'AlainPlantec 12/1/2009 06:36'!
selectedNodePathList
	^ self subclassResponsibility! !

!MorphTreeMorphSelection methodsFor: 'accessing' stamp: 'AlainPlantec 9/27/2011 23:04'!
removeNode: aNode
	self subclassResponsibility ! !

!MorphTreeMorphSelection methodsFor: 'view updating' stamp: 'AlainPlantec 10/7/2011 17:02'!
updateView: aTreeMorph forModel: aTreeModel
	aTreeMorph updateFromSelection: self.
	aTreeModel selectionChanged! !

!MorphTreeMorphSelection methodsFor: 'accessing' stamp: 'AlainPlantec 9/27/2011 13:28'!
selectedNodes
	^ self lastSelectedNode
		ifNotNil: [:l | OrderedCollection with: l]
		ifNil: [OrderedCollection new]! !

!MorphTreeMorphSelection methodsFor: 'accessing' stamp: 'AlainPlantec 9/27/2011 13:28'!
selectedItems
	^ self selectedNodes collect: [:n | n item]
! !

!MorphTreeMorphSelection methodsFor: 'accessing' stamp: 'AlainPlantec 11/25/2009 18:11'!
selectedItemOrItemsOrNil
	^ self lastSelectedNode isNil 
		ifTrue: [ nil ]
		ifFalse: [ self lastSelectedNode item ]! !

!MorphTreeMorphSingleSelection commentStamp: 'TorstenBergmann 9/5/2014 15:28'!
Single selections in a morphic based tree!
!MorphTreeMorphSingleSelection methodsFor: 'accessing' stamp: 'AlainPlantec 9/27/2011 13:54'!
addNodePath: aPath
	self selectedNodePath: aPath! !

!MorphTreeMorphSingleSelection methodsFor: 'accessing' stamp: 'AlainPlantec 9/27/2011 23:05'!
removeNode: aNode
	self selectedNodePath = aNode path
		ifTrue: [self selectedNodePath: nil]! !

!MorphTreeMorphSingleSelection methodsFor: 'accessing' stamp: 'AlainPlantec 11/26/2009 07:25'!
lastSelectedNodePath
	^ self selectedNodePath! !

!MorphTreeMorphSingleSelection methodsFor: 'accessing' stamp: 'AlainPlantec 9/27/2011 23:00'!
empty
	self selectedNodePath: nil! !

!MorphTreeMorphSingleSelection methodsFor: 'accessing' stamp: 'AlainPlantec 11/26/2009 07:24'!
selectedNodePath
	^ selectedNodePath! !

!MorphTreeMorphSingleSelection methodsFor: 'accessing' stamp: 'AlainPlantec 12/1/2009 08:31'!
selectedNodePathList
	^ self selectedNodePath ifNil: [#()] ifNotNil: [Array with: self selectedNodePath]! !

!MorphTreeMorphSingleSelection methodsFor: 'accessing' stamp: 'AlainPlantec 11/26/2009 07:11'!
selectedNodePath: aSelectionPath
	selectedNodePath := aSelectionPath! !

!MorphTreeMorphTests commentStamp: '<historical>'!
A MorphTreeMorphTests tests aspects of a MorphTreeMorph
!
!MorphTreeMorphTests methodsFor: 'tests' stamp: 'ThierryGoubier 7/4/2014 09:41'!
testUpdatingSelectionsOnUpdateWithRemoval
	"Test that the selection does not refer to non-existing nodes after updates, including if the update removes nodes."

	| c w t |
	c := ClassTreeExample new.
	[ 
	w := c openOn: Collection.
	t := c dependents last.
	t expandAll.
	c
		selectItems:
			{Bag.
			CharacterSet}.
	c selection selectedNodes do: [ :e | self assert: (t selectedMorphList anySatisfy: [ :sm | sm complexContents = e ]) ].
	c rootClass: Bag.	"We change completely the list. CharacterSet is not anymore in the list after the update."
	c updateList.
	self assert: t selectedMorphList size = 1.	"We have only Bag selected now."
	self assert: t selectedMorphList first complexContents withoutListWrapper == Bag.
	c selection selectedNodes do: [ :e | self assert: (t selectedMorphList anySatisfy: [ :sm | sm complexContents = e ]) ] ]
		ensure: [ w close ]! !

!MorphTreeMorphTests methodsFor: 'tests' stamp: 'ThierryGoubier 7/4/2014 10:25'!
testLastClickedMorphSetUponUpdateList
	"Test that lastClickedMorph isn't set to nil after an update list."

	| c w t |
	c := ClassTreeExample new.
	[ 
	w := c openOn: Collection.
	t := c dependents last.
	t expandAll.
	c
		selectItems:
			{CharacterSet}.
	self assert: t listManager lastClickedMorph notNil.
	c rootClass: Bag.	"We change completely the list. CharacterSet is not anymore in the list after the update."
	c updateList.
	self assert: t listManager lastClickedMorph isNil.
	c selectItems: { Bag }.
	self assert: t listManager lastClickedMorph notNil ]
		ensure: [ w close ]! !

!MorphTreeMorphTests methodsFor: 'tests' stamp: 'ThierryGoubier 6/30/2014 19:46'!
testLeakingSelectionsOnUpdate
	"Test that selected morphs are forgotten on update."

	| c w t |
	c := ClassTreeExample new.
	[ 
	w := c openOn: Collection.
	t := c dependents last.
	t expandAll.
	t selectAll.
	c updateList.
	t listManager selectedMorphList do: [ :each | self assert: (t allNodeMorphs includes: each) ] ]
		ensure: [ w close ]! !

!MorphTreeMorphTests methodsFor: 'tests' stamp: 'ThierryGoubier 7/4/2014 07:11'!
testMaintainingSelectionsOnUpdate
	"Test that the selection is well maintained on list update."

	| c w t |
	c := ClassTreeExample new.
	[ 
	w := c openOn: Collection.
	t := c dependents last.
	t expandAll.
	c
		selectItems:
			{Bag.
			CharacterSet}.
	t selectedMorphList
		do: [ :e | 
			self
				assert:
					({Bag.
					CharacterSet} includes: e complexContents withoutListWrapper) ].
	c updateList.
	t selectedMorphList
		do: [ :e | 
			self
				assert:
					({Bag.
					CharacterSet} includes: e complexContents withoutListWrapper) ] ]
		ensure: [ w close ]! !

!MorphTreeMorphTests methodsFor: 'tests' stamp: 'ThierryGoubier 7/4/2014 09:36'!
testUpdatingSelectionsOnUpdate
	"Test that the selection does not refer to non-existing nodes after updates."

	| c w t |
	c := ClassTreeExample new.
	[ 
	w := c openOn: Collection.
	t := c dependents last.
	t expandAll.
	c
		selectItems:
			{Bag.
			CharacterSet}.
	c selection selectedNodes do: [ :e | self assert: (t selectedMorphList anySatisfy: [ :sm | sm complexContents = e ]) ].
	c rootClass: Bag.
	c updateList.
	c selection selectedNodes do: [ :e | self assert: (t selectedMorphList anySatisfy: [ :sm | sm complexContents = e ]) ] ]
		ensure: [ w close ]! !

!MorphTreeNavigationBar commentStamp: '<historical>'!
I'm a pager control used to navigate in a MorphTreeMorph that has a lot of entries.

You can see one of my subclass in action using:
"May take a while to open"
ClassListExample new open!
!MorphTreeNavigationBar methodsFor: 'accessing' stamp: 'AlainPlantec 1/21/2010 18:58'!
asDisabledForm: aForm
	| disa |
	disa := aForm copy.
	(aForm colorsUsed reject: [:c | c = Color transparent])
		do: [:c | disa replaceColor: c  withColor: (c alphaMixed: 0.4 with: Color white)].
	^ disa
! !

!MorphTreeNavigationBar methodsFor: 'accessing' stamp: 'AlainPlantec 1/19/2010 18:45'!
pageSize
	^ pageSize! !

!MorphTreeNavigationBar methodsFor: 'private' stamp: 'AlainPlantec 1/22/2010 14:46'!
handlesMouseDown: anEvent
	^ true! !

!MorphTreeNavigationBar methodsFor: 'accessing' stamp: 'AlainPlantec 1/22/2010 08:51'!
buttonLabel: aLabel actionSelector: aSelector arguments: aCollection getEnabled: enableSelector help: helpText

	| b |
	b := (aLabel isString ifTrue: [self basicButton] ifFalse: [self basicIcon])
		actionSelector: aSelector;
		arguments: aCollection;
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap;
		setBalloonText: helpText;
		yourself.
		aLabel isString 
			ifTrue: [b label: aLabel font: self preferedFont]
			ifFalse: [| f | 
				f := (enableSelector isNil or: [self perform: enableSelector])
					ifTrue: [aLabel]
					ifFalse: [b lock. self asDisabledForm: aLabel].
				b labelGraphic: f].
	^ b
	! !

!MorphTreeNavigationBar methodsFor: 'accessing' stamp: 'AlainPlantec 1/19/2010 18:45'!
pageSize: anInteger
	pageSize := anInteger! !

!MorphTreeNavigationBar methodsFor: 'initialization' stamp: 'AlainPlantec 1/22/2010 09:02'!
initialize
	super initialize.
	self hResizing: #spaceFill;
		 vResizing: #rigid;
		 changeTableLayout; 
		 listDirection: #leftToRight;
		 cellInset: 2 @ 0;
		 layoutInset: 3 @ 0;
		 listCentering: #center;
		 clipSubmorphs: true;
		 borderWidth: 0;
		 borderColor: Color lightGray! !

!MorphTreeNavigationBar methodsFor: 'navigation' stamp: 'AlainPlantec 1/22/2010 15:11'!
changePageSize: aNumberOrNil
	aNumberOrNil
		ifNotNil: [self updateForNewPageSize: aNumberOrNil]
		ifNil: [treeMorph removePager]
! !

!MorphTreeNavigationBar methodsFor: 'accessing' stamp: 'AlainPlantec 1/19/2010 18:44'!
nodeList
	^ treeMorph nodeList! !

!MorphTreeNavigationBar methodsFor: 'accessing' stamp: 'AlainPlantec 1/19/2010 18:46'!
treeMorph: aTreeMorph 
	treeMorph := aTreeMorph.
! !

!MorphTreeNavigationBar methodsFor: 'navigation' stamp: 'ThierryGoubier 2/8/2013 16:31'!
pageOfNodeIndex: anIndex
	^ (anIndex > 0 and: [anIndex <= self nodeList size])
		ifTrue: [((anIndex - 1) // pageSize) + 1]
		ifFalse: [nil]
			! !

!MorphTreeNavigationBar methodsFor: 'user interface' stamp: 'AlainPlantec 1/21/2010 11:45'!
vScrollBarValue: scrollValue
! !

!MorphTreeNavigationBar methodsFor: 'accessing' stamp: 'AlainPlantec 1/19/2010 18:43'!
basicButton
	| button |
	^ (button := SimpleButtonMorph new)
		clipSubmorphs: true;
		color: self pagerColor;		
		on: #mouseEnter send: #value to: [button borderColor: self pagerColor muchDarker];
		on: #mouseLeave send: #value to: [button borderColor: self pagerColor];
		target: self;
		layoutPolicy: TableLayout new; 
		listDirection: #leftToRight; 
		listCentering: #leftCenter; 
		wrapCentering: #center;
		layoutInset: 2@0;
		cellInset: 2@0;
		borderWidth: 1;
		borderColor: self pagerColor;
		yourself
	! !

!MorphTreeNavigationBar methodsFor: 'accessing' stamp: 'AlainPlantec 1/19/2010 18:45'!
pagerColor
	^ treeMorph pagerColor! !

!MorphTreeNavigationBar methodsFor: 'accessing' stamp: 'AlainPlantec 1/22/2010 08:52'!
textEntryLabel: aLabel get: getSel set: setSel help: helpText class: aClass
 	| pt |
	pt := PluggableTextFieldMorph new
		convertTo: aClass;
		alwaysAccept: true;
		on: self
		text: getSel
		accept: setSel
		readSelection: nil
		menu: nil;
		acceptOnCR: true;
		getEnabledSelector: nil;
		font: self preferedFont;
		cornerStyle: #square;
		hResizing: #spaceFill;
		vResizing: #rigid;
		borderStyle: (BorderStyle inset width: 1);
		color: Color white;
		hideScrollBarsIndefinitely;
		extent: 24@ (self preferedFont height + 4);
		setBalloonText: helpText.
	pt textMorph
		autoFit: true;
		wrapFlag: false;
		margins: (1@0 corner: 1@0).
	^pt! !

!MorphTreeNavigationBar methodsFor: 'navigation' stamp: 'AlainPlantec 1/22/2010 10:27'!
computedHeightFromContents
	| h |
	h := 0.
	self submorphsDo: [:sm | h := h max: sm height].
	^ h
! !

!MorphTreeNavigationBar methodsFor: 'accessing' stamp: 'AlainPlantec 1/19/2010 18:46'!
treeMorph: aTreeMorph pageSize: anInteger
	self treeMorph: aTreeMorph.
	self pageSize: anInteger! !

!MorphTreeNavigationBar methodsFor: 'accessing' stamp: 'AlainPlantec 1/21/2010 11:48'!
updateContents
	self bounds: self computedBounds.
	self color: treeMorph pagerColor.
! !

!MorphTreeNavigationBar methodsFor: 'accessing' stamp: 'AlainPlantec 1/19/2010 18:52'!
buildPanel
	self subclassResponsibility! !

!MorphTreeNavigationBar methodsFor: 'accessing' stamp: 'AlainPlantec 10/7/2011 17:22'!
pageSearchText: aString
	| founds chosen chosenNode |
	pageSearchText := aString.
	self changed: #pageSearchText.
	founds := OrderedCollection new.
	self nodeList doWithIndex: [:n :idx |
		(n includesSubstringAnywhere: pageSearchText)
			ifTrue: [founds add: idx -> n]].
	founds ifEmpty: [ ^ self flash ].
	founds size > 1 
		ifTrue: [ 
			chosen := 
				UIManager default 
					chooseFrom: (founds collect: [:l | l value] ) 
					values: (founds collect: [:l | l key] ) 
					lines: nil 
					title: ''.
			chosen ifNil: [^self]]
		ifFalse: [chosen := founds first key].
	self currentPage: (self pageOfNodeIndex: chosen).
	chosenNode := self nodeList at: chosen.
	treeMorph scroller 
		submorphsDo: [:sm | 
			sm complexContents ==  chosenNode
				ifTrue: [treeMorph listManager setSelectedMorph: sm.
					^ treeMorph scrollSelectionIntoView]]
! !

!MorphTreeNavigationBar methodsFor: 'accessing' stamp: 'AlainPlantec 1/19/2010 18:45'!
pageSearchText
	^ pageSearchText ifNil: [pageSearchText := '']! !

!MorphTreeNavigationBar methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/8/2012 14:46'!
pageSizeInput: aString
	| input |
	input := aString trimBoth.
	input ifEmpty: [input := '1'].
	(input beginsWith: '/' )
		ifTrue: [ | numberOfPages |
			input := (input copyFrom: 2 to: input size) trimBoth.
			numberOfPages := Integer readFromString: input.
			numberOfPages > 0 
				ifTrue: [self changePageSize: (self nodeList size // numberOfPages)]
				ifFalse: [treeMorph flash.
					^ false]]
		ifFalse: [ | newPageSize |
			newPageSize := Integer readFromString: input.
			newPageSize > 0 
				ifTrue: [self changePageSize: newPageSize]
				ifFalse: [treeMorph flash.
					^ false]].
	^ true
! !

!MorphTreeNavigationBar methodsFor: 'accessing' stamp: 'AlainPlantec 1/21/2010 11:52'!
basicIcon
	| button |
	^ (button := IconicButton new)
		clipSubmorphs: true;
		color: self pagerColor;		
		on: #mouseEnter send: #value to: [button borderColor: self pagerColor muchDarker];
		on: #mouseLeave send: #value to: [button borderColor: self pagerColor];
		target: self;
		layoutPolicy: TableLayout new; 
		listDirection: #leftToRight; 
		listCentering: #leftCenter; 
		wrapCentering: #center;
		layoutInset: 2@0;
		cellInset: 2@0;
		borderWidth: 1;
		borderColor: self pagerColor;
		yourself
	! !

!MorphTreeNavigationBar methodsFor: 'accessing' stamp: 'AlainPlantec 1/22/2010 08:49'!
preferedFont
	^ self balloonFont ! !

!MorphTreeNavigationBar methodsFor: 'navigation' stamp: 'AlainPlantec 1/21/2010 21:56'!
updateForNewPageSize: aPageSize
	pageSize := aPageSize max: 1.
	self changed: #pageSize! !

!MorphTreeNavigationBar methodsFor: 'private' stamp: 'AlainPlantec 1/22/2010 14:45'!
mouseDown: anEvent! !

!MorphTreeNavigationBar methodsFor: 'accessing' stamp: 'AlainPlantec 1/22/2010 09:07'!
computedHeight
	^ computedHeight
		ifNil: [computedHeight := self computedHeightFromContents + self layoutInset asPoint y + self cellInset asPoint y]! !

!MorphTreeNavigationBar methodsFor: 'accessing' stamp: 'AlainPlantec 1/22/2010 10:34'!
spacer: hsize
	^ (Morph new) color: Color transparent; extent: hsize @ (self hasSubmorphs  ifTrue: [self computedHeight] ifFalse: [(self preferedFont height + 8)]); yourself! !

!MorphTreeNavigationBar methodsFor: 'accessing' stamp: 'AlainPlantec 1/19/2010 18:47'!
withSearch
	^ withSearch ifNil: [withSearch := false]! !

!MorphTreeNavigationBar methodsFor: 'accessing' stamp: 'AlainPlantec 1/19/2010 18:47'!
withSearch: aBoolean
	withSearch := aBoolean.
	self buildPanel! !

!MorphTreeNavigationBar methodsFor: 'accessing' stamp: 'MarcusDenker 9/13/2013 16:29'!
computedBounds
	| tb tbw yGap |
	tb := treeMorph bounds.
	tbw := treeMorph borderWidth.
	yGap := self layoutInset asPoint y + self cellInset asPoint y.
	^ (tb bottomLeft + (tbw @ (self computedHeight + yGap) negated)) corner: (tb bottomRight - ( (tbw * 2) @ yGap )).
! !

!MorphTreeNavigationBar class methodsFor: 'icons' stamp: 'AlainPlantec 1/20/2010 15:10'!
smallToRightEndIcon
	^ (Form
	extent: 16@16
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4287401100 4279173376 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4287401100 4279173376 0 0 0 0 0 0 0 4278190080 4278190080 4278190080 0 0 0 0 4287401100 4279173376 0 0 0 0 0 0 0 4278190080 4287401100 4287401100 4278190080 0 0 0 4287401100 4279173376 0 0 0 0 0 0 4278190080 4287401100 4287401100 4287401100 4287401100 4278190080 0 50353408 4287401100 4279173376 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4291151301 4287401100 4287401100 4287401100 4287401100 4287401100 4278190080 0 4287401100 4279173376 4278190080 4291151301 4291151301 4291151301 4291151301 4291151301 4291151301 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 4278190080 4287401100 4279173376 4278190080 4291151301 4291151301 4291151301 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 4278190080 4287401100 4279173376 4278190080 4291151301 4291151301 4291151301 4291151301 4291151301 4291151301 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 4278190080 4287401100 4279173376 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4291151301 4287401100 4287401100 4287401100 4287401100 4287401100 4278190080 0 4287401100 4279173376 0 0 0 0 0 0 4278190080 4287401100 4287401100 4287401100 4287401100 4278190080 0 0 4287401100 4279173376 0 0 0 0 0 0 0 4278190080 4287401100 4287401100 4278190080 0 0 0 4287401100 4279173376 0 0 0 0 0 0 0 4278190080 4278190080 4278190080 0 0 0 0 4287401100 4279173376 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4287401100 4279173376 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4287401100 4279173376)
	offset: 0@0)! !

!MorphTreeNavigationBar class methodsFor: 'icons' stamp: 'AlainPlantec 1/20/2010 15:10'!
smallToLeftIcon
	^ (Form
	extent: 16@16
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4278190080 4278190080 4278190080 0 0 0 0 0 0 0 0 0 0 0 0 4278190080 4287401100 4287401100 4278190080 0 0 0 0 0 0 0 0 0 0 0 4278190080 4287401100 4287401100 4287401100 4287401100 4278190080 0 0 0 0 0 0 0 0 0 4278190080 4287401100 4287401100 4287401100 4287401100 4287401100 4291151301 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 0 0 4278190080 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 4291151301 4291151301 4291151301 4291151301 4291151301 4291151301 4278190080 0 0 4278190080 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 4291151301 4291151301 4291151301 4278190080 0 0 4278190080 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 4291151301 4291151301 4291151301 4291151301 4291151301 4291151301 4278190080 0 0 0 4278190080 4287401100 4287401100 4287401100 4287401100 4287401100 4291151301 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 0 0 50353408 0 4278190080 4287401100 4287401100 4287401100 4287401100 4278190080 0 0 0 0 0 0 0 0 0 0 0 4278190080 4287401100 4287401100 4278190080 0 0 0 0 0 0 0 0 0 0 0 0 0 4278190080 4278190080 4278190080 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: 0@0)! !

!MorphTreeNavigationBar class methodsFor: 'icons' stamp: 'AlainPlantec 1/20/2010 15:10'!
smallDiezeIcon
	^ (Form
	extent: 16@16
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4279173376 4279173376 0 0 4279173376 4279173376 0 0 0 0 0 0 0 0 0 0 4279173376 0 0 0 4279173376 0 0 0 0 0 0 0 0 0 0 0 4279173376 0 0 0 4279173376 0 0 0 0 0 0 0 0 0 0 0 4279173376 0 0 0 4279173376 0 0 0 0 0 0 0 4279173376 4279173376 4279173376 4279173376 4279173376 4279173376 4279173376 4279173376 4279173376 4279173376 4279173376 0 0 0 0 0 0 0 0 4279173376 4279173376 4279173376 0 4279173376 4279173376 0 0 0 0 0 0 0 0 0 0 4279173376 0 0 0 4279173376 0 0 0 0 0 0 0 0 0 0 0 4279173376 0 0 0 4279173376 0 0 0 0 0 0 0 0 4279173376 4279173376 4279173376 4279173376 4279173376 4279173376 4279173376 4279173376 4279173376 4279173376 4279173376 0 0 0 0 0 0 0 4279173376 4279173376 4279173376 0 4279173376 4279173376 0 0 0 0 0 0 0 0 0 0 4279173376 4279173376 0 0 4279173376 4279173376 0 0 0 0 0 0 0 0 0 0 4279173376 0 0 0 4279173376 0 0 0 0 0 0 0 0 0 0 0 4279173376 0 0 0 4279173376 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: 0@0)! !

!MorphTreeNavigationBar class methodsFor: 'icons' stamp: 'AlainPlantec 1/20/2010 15:10'!
smallVerticalResizingIcon
	^ (Form
	extent: 16@16
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4283914071 0 0 0 0 4286545791 4286545791 4287401100 4287401100 4287401100 4287401100 0 0 0 0 4286545791 4290822336 4283914071 0 0 4286611584 4293256677 4293256677 4294967295 4294967295 4294967295 4294967295 4287401100 0 0 4286545791 4290822336 4290822336 4290822336 4283914071 0 4286611584 4293256677 4293256677 4294967295 4294967295 4294967295 4294967295 4287401100 0 4283914071 4283914071 4283914071 4283914071 4283914071 4283914071 4283914071 4286611584 4293256677 4293256677 4294967295 4294967295 4294967295 4294967295 4287401100 0 0 0 0 0 0 0 0 4286611584 4293256677 4293256677 4294967295 4294967295 4294967295 4294967295 4287401100 0 0 0 0 4278190080 0 0 0 4286611584 4293256677 4293256677 4294967295 4294967295 4294967295 4294967295 4287401100 0 0 0 0 4278190080 4293256677 0 0 4286611584 4293256677 4293256677 4294967295 4294967295 4294967295 4294967295 4287401100 0 0 0 0 4278190080 4293256677 0 0 4286611584 4293256677 4293256677 4294967295 4294967295 4294967295 4294967295 4287401100 0 0 0 0 4278190080 4293256677 0 0 4286611584 4293256677 4293256677 4294967295 4294967295 4294967295 4294967295 4287401100 0 0 0 0 4278190080 4293256677 0 0 4286611584 4293256677 4293256677 4294967295 4294967295 4294967295 4294967295 4287401100 0 4283914071 4283914071 4283914071 4283914071 4283914071 4283914071 4283914071 4286611584 4287401100 4287401100 4294967295 4294967295 4294967295 4294967295 4287401100 0 0 4286545791 4290822336 4290822336 4290822336 4283914071 0 0 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 0 0 0 0 4286545791 4290822336 4283914071 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4283914071 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: 0@0)! !

!MorphTreeNavigationBar class methodsFor: 'icons' stamp: 'AlainPlantec 1/20/2010 15:10'!
smallToRightIcon
	^ (Form
	extent: 16@16
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4278190080 4278190080 4278190080 0 0 0 0 0 0 0 0 0 0 0 0 0 4278190080 4287401100 4287401100 4278190080 0 0 0 0 0 0 0 0 0 0 0 4278190080 4287401100 4287401100 4287401100 4287401100 4278190080 0 50353408 0 0 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4291151301 4287401100 4287401100 4287401100 4287401100 4287401100 4278190080 0 0 0 4278190080 4291151301 4291151301 4291151301 4291151301 4291151301 4291151301 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 4278190080 0 0 4278190080 4291151301 4291151301 4291151301 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 4278190080 0 0 4278190080 4291151301 4291151301 4291151301 4291151301 4291151301 4291151301 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 4278190080 0 0 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4291151301 4287401100 4287401100 4287401100 4287401100 4287401100 4278190080 0 0 0 0 0 0 0 0 0 4278190080 4287401100 4287401100 4287401100 4287401100 4278190080 0 0 0 0 0 0 0 0 0 0 0 4278190080 4287401100 4287401100 4278190080 0 0 0 0 0 0 0 0 0 0 0 0 4278190080 4278190080 4278190080 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: 0@0)! !

!MorphTreeNavigationBar class methodsFor: 'icons' stamp: 'AlainPlantec 1/20/2010 15:05'!
createIconMethods
	"self createIconMethods"
	#('smallToLeft' 'smallToRight' 'smallToLeftEnd' 'smallToRightEnd' 'smallDieze' 'smallVerticalResizing')
		do: [:n | | form |
			form := PNGReadWriter formFromFileNamed: n, '.png'.
			self class compile: (n, 'Icon', String cr, String tab, '^ ', form storeString) classified: #icons]! !

!MorphTreeNavigationBar class methodsFor: 'icons' stamp: 'AlainPlantec 1/20/2010 15:10'!
smallToLeftEndIcon
	^ (Form
	extent: 16@16
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4279173376 4287401100 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4279173376 4287401100 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4279173376 4287401100 0 0 0 0 4278190080 4278190080 4278190080 0 0 0 0 0 0 0 4279173376 4287401100 0 0 0 4278190080 4287401100 4287401100 4278190080 0 0 0 0 0 0 0 4279173376 4287401100 0 0 4278190080 4287401100 4287401100 4287401100 4287401100 4278190080 0 0 0 0 0 0 4279173376 4287401100 0 4278190080 4287401100 4287401100 4287401100 4287401100 4287401100 4291151301 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4279173376 4287401100 4278190080 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 4291151301 4291151301 4291151301 4291151301 4291151301 4291151301 4278190080 4279173376 4287401100 4278190080 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 4291151301 4291151301 4291151301 4278190080 4279173376 4287401100 4278190080 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 4291151301 4291151301 4291151301 4291151301 4291151301 4291151301 4278190080 4279173376 4287401100 0 4278190080 4287401100 4287401100 4287401100 4287401100 4287401100 4291151301 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4279173376 4287401100 50353408 0 4278190080 4287401100 4287401100 4287401100 4287401100 4278190080 0 0 0 0 0 0 4279173376 4287401100 0 0 0 4278190080 4287401100 4287401100 4278190080 0 0 0 0 0 0 0 4279173376 4287401100 0 0 0 0 4278190080 4278190080 4278190080 0 0 0 0 0 0 0 4279173376 4287401100 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4279173376 4287401100 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: 0@0)! !

!MorphTreeNavigationBar class methodsFor: 'instance creation' stamp: 'AlainPlantec 1/19/2010 18:47'!
on: aTreeMorph pageSize: aPageSize
	^ self new treeMorph: aTreeMorph  pageSize: aPageSize! !

!MorphTreeNodeModel commentStamp: '<historical>'!
I wrap an item to be displayed in a TreeMorph, so I can answer content and representation in a polymorphic way. 

My hierarchy usually follows TreeMorphModel one.!
!MorphTreeNodeModel methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 11/22/2013 15:42'!
hasContentToShow

	^ false! !

!MorphTreeNodeModel methodsFor: 'accessing' stamp: 'AlainPlantec 11/25/2009 11:12'!
enabled
	^ true! !

!MorphTreeNodeModel methodsFor: 'accessing' stamp: 'AlainPlantec 2/3/2010 09:52'!
level
	^ parentNode ifNil: [1] ifNotNil: [parentNode level + 1]! !

!MorphTreeNodeModel methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/24/2013 13:33'!
isExpanded: aBoolean! !

!MorphTreeNodeModel methodsFor: 'accessing' stamp: 'AlainPlantec 2/5/2010 23:00'!
path
	^ self pathIn: OrderedCollection new.! !

!MorphTreeNodeModel methodsFor: 'printing' stamp: 'AlainPlantec 10/8/2011 23:37'!
printOn: aStream
	aStream nextPutAll: 'Node('.
	self item printOn: aStream.
	aStream nextPut: $)! !

!MorphTreeNodeModel methodsFor: 'accessing' stamp: 'AlainPlantec 2/8/2010 09:39'!
childNodeClassFromItem: anItem
	^ self class! !

!MorphTreeNodeModel methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/21/2013 17:58'!
lastClicked: aBoolean
	"Do nothing but introduce a hook"! !

!MorphTreeNodeModel methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/24/2013 13:33'!
isExpanded

	^ false! !

!MorphTreeNodeModel methodsFor: 'accessing' stamp: 'AlainPlantec 2/5/2010 23:00'!
pathIn: aCollection 
	self parentNode
		ifNotNil: [(aCollection includes: self parentNode)
		ifFalse: [self parentNode pathIn: aCollection]].
	aCollection add: self.
	^ aCollection! !

!MorphTreeNodeModel methodsFor: 'accessing' stamp: 'AlainPlantec 2/8/2010 09:39'!
childNodeFromItem: anItem
	^ ((self childNodeClassFromItem: anItem) with: anItem model: model) parentNode: self; yourself! !

!MorphTreeNodeModel methodsFor: 'accessing' stamp: 'AlainPlantec 1/16/2010 14:49'!
parentNode: aNode
	parentNode := aNode! !

!MorphTreeNodeModel methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/21/2013 17:42'!
selected: aBoolean
	"Do nothing but introduce a hook"! !

!MorphTreeNodeModel methodsFor: 'accessing' stamp: 'AlainPlantec 1/18/2010 21:21'!
includesSubstringAnywhere: aString
	^ (Array with: self asString) includesSubstringAnywhere: aString! !

!MorphTreeNodeModel methodsFor: 'accessing' stamp: 'AlainPlantec 10/11/2011 00:55'!
rowMorphForColumn: aTreeColumn
	^ self item ifNotNil: [:i | self asString asMorph] ! !

!MorphTreeNodeModel methodsFor: 'dependents' stamp: 'BenjaminVanRyseghem 11/22/2013 12:51'!
addDependent: aDependent
	"Ensure to only have one dependent at every moment"
	
	dependents := #().
	super addDependent: aDependent! !

!MorphTreeNodeModel methodsFor: 'accessing' stamp: 'AlainPlantec 1/15/2010 13:41'!
parentNode
	^ parentNode! !

!MorphTreeNodeModel methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/22/2013 12:53'!
selected

	^ false! !

!MorphTreeNodeModel methodsFor: 'accessing' stamp: 'AlainPlantec 11/20/2009 21:25'!
color
	^ nil! !

!MorphTreeNodeModel methodsFor: 'accessing' stamp: 'AlainPlantec 1/19/2010 15:43'!
childrenItems
	^ Array new! !

!MorphTreeNodeModel methodsFor: 'events' stamp: 'BenjaminVanRyseghem 7/2/2013 14:25'!
mouseDown: event
	"Do not do anything"! !

!MorphTreeNodeModel methodsFor: 'accessing' stamp: 'GuillermoPolito 11/7/2013 15:55'!
helpText
	^ model helpText! !

!MorphTreeNodeModel methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 11/22/2013 14:59'!
isPartialMatch
	| result |

	result := false.
	
	self contents do: [:each | 
		(each selected or: [ each isPartialMatch ]) ifTrue: [ result := true ] ].

	^ result! !

!MorphTreeNodeModel methodsFor: 'accessing' stamp: 'CamilloBruni 2/19/2014 18:44'!
name
	^ self item name! !

!MorphTreeNodeModel methodsFor: 'accessing' stamp: 'AlainPlantec 1/19/2010 15:26'!
contents
	^ self childrenItems collect: [:ci | self childNodeFromItem: ci ]! !

!MorphTreeNodeModel methodsFor: 'accessing' stamp: 'AlainPlantec 11/24/2009 14:07'!
model: anObject
	model := anObject! !

!MorphTreeNodeMorph commentStamp: '<historical>'!
I draw the node part of a tree.!
!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/11/2011 15:45'!
toggleImageForm
	^ isExpanded 
			ifTrue: [container expandedFormForMorph: self]
			ifFalse: [container notExpandedFormForMorph: self] 
				
		
! !

!MorphTreeNodeMorph methodsFor: 'testing' stamp: 'AlainPlantec 9/30/2011 16:18'!
hasIcon
	"Answer whether the receiver has an icon."
	^ container hasIconBlock or: [self complexContents icon notNil]! !

!MorphTreeNodeMorph methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 10/11/2013 16:07'!
matchPath: anAssociation

	anAssociation ifNil: [ ^ nil ].
	^ anAssociation head = self complexContents withoutListWrapper
		ifFalse: [ nil ]
		ifTrue: [ | matchingChildren |
			anAssociation tail ifNil: [ ^ { self } ].
			matchingChildren := self children collect: [:child | child matchPath: anAssociation tail ].
			^ matchingChildren select: [ :e | e notNil ] ]! !

!MorphTreeNodeMorph methodsFor: 'testing' stamp: 'AlainPlantec 9/28/2011 09:58'!
isSelected
	"^ container selectedMorphList includes: self"
	^ self selected! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'alain.plantec 3/7/2009 09:29'!
children
	| children |
	children := OrderedCollection new.
	self childrenDo: [:each | children add: each].
	^children! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 9/30/2011 14:33'!
outerBounds
	"Return the 'outer' bounds of the receiver, e.g., the bounds that need to be invalidated when the receiver changes."
	
	^ self bounds! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
theme
	"Answer the ui theme that provides controls.
	Done directly here to avoid performance hit of
	looking up in window."

	^ Smalltalk ui theme! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 10/29/2009 16:44'!
path
	^ parent 
		ifNil: [OrderedCollection with: self]
		ifNotNil: [(parent path) add: self; yourself]! !

!MorphTreeNodeMorph methodsFor: 'drawing' stamp: 'AlainPlantec 2/3/2010 10:05'!
drawLinesToFirstChildOn: aCanvas
	"Draw line from me to first child.
	Don't bother if the first child has a toggle.."

	| vLineX vLineTop vLineBottom childBounds childCenter myTheme ldelta |
	self firstChild hasToggle ifTrue: [^self].
	childBounds := self firstChild toggleRectangle.
	childCenter := childBounds center.
	vLineX := childCenter x.
	vLineTop := bounds bottom.
	ldelta := container treeLineWidth // 2.
	self firstChild hasToggle
		ifTrue: [vLineBottom := childCenter y - (childBounds height // 2) + ldelta]
		ifFalse: [vLineBottom := childCenter y - 2].
	myTheme := self theme.
	aCanvas
		frameRectangle: (vLineX - ldelta @ vLineTop corner: (vLineX + ldelta + (container treeLineWidth \\ 2)) @ vLineBottom)
		width: container treeLineWidth
		colors: (myTheme treeLineColorsFrom: self lineColor)
		dashes: self treeLineDashes! !

!MorphTreeNodeMorph methodsFor: 'initialization' stamp: 'AlainPlantec 10/11/2011 00:01'!
initialize
	"initialize the state of the receiver"
	super initialize.
	self
		layoutPolicy: TableLayout new;
		cellPositioning: #leftCenter;
		listDirection: #leftToRight;
		cellSpacing: #none;
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap;
		color: Color transparent.


! !

!MorphTreeNodeMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/5/2013 12:43'!
retrieveCheckIcon

	^ self selected
		ifTrue: [ Smalltalk ui icons checkedBoxIcon ]
		ifFalse: [ 
			self isPartialMatch
				ifTrue: [ Smalltalk ui icons partialCheckedBoxIcon ]
				ifFalse: [ Smalltalk ui icons uncheckedBoxIcon ] ]! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'alain.plantec 10/23/2009 15:35'!
parent
	^ parent! !

!MorphTreeNodeMorph methodsFor: 'updating' stamp: 'ThierryGoubier 7/23/2014 10:35'!
toggleExpandedState
	| toDelete |
	self isExpanded: self isExpanded not.
	toDelete := OrderedCollection new.
	firstChild ifNotNil: [ firstChild withSiblingsDo: [ :aNode | aNode recursiveAddTo: toDelete ] ].
	container noteRemovalOfAll: toDelete.
	(isExpanded and: [ complexContents hasContents ])
		ifFalse: [ ^ self changed ].
	self expand! !

!MorphTreeNodeMorph methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 12/5/2013 12:44'!
drawOn: aCanvas
	"Note that selection is rendered from the container transformMorph (see MorphTreeTransformMorph)" 
	
	container withHLines 
		ifTrue: [
			aCanvas 
				frameRectangle: self selectionFrame
				width: 1
				colors: {Color veryLightGray. Color transparent}
				 dashes: #(1 2)].

	self hasToggle 
		ifTrue: [self drawToggleOn: aCanvas in: self toggleRectangle]. 
		
	container listManager isCheckList
		ifTrue: [self drawCheckOn: aCanvas ].
	

		
		
		
		
		
		
! !

!MorphTreeNodeMorph methodsFor: 'updating' stamp: 'AlainPlantec 2/5/2010 22:50'!
recursiveAddTo: aCollection

	firstChild ifNotNil: [firstChild withSiblingsDo: [ :aNode | aNode recursiveAddTo: aCollection]].
	aCollection add: self.

	! !

!MorphTreeNodeMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/17/2015 13:15'!
drawOnAthensCanvas: anAthensCanvas
	self drawOnCanvasWrapperFor: anAthensCanvas! !

!MorphTreeNodeMorph methodsFor: 'testing' stamp: 'AlainPlantec 10/7/2011 17:36'!
mustTakeIntoAccountCheckSpace
	^container listManager isCheckList! !

!MorphTreeNodeMorph methodsFor: 'change reporting' stamp: 'AlainPlantec 10/10/2011 23:43'!
invalidRect: aRectangle
	! !

!MorphTreeNodeMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/5/2013 12:44'!
computeCheckTopLeft
	| center offset |
	
	center := self checkRectangle center.
	offset := (self checkWidth / 2.0) truncated.
	^ (center x - offset) @ (center y - offset - 1)! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 9/28/2011 23:39'!
checkWidth
	^ 10! !

!MorphTreeNodeMorph methodsFor: 'expanding-collapsing' stamp: 'AlainPlantec 10/18/2013 10:04'!
openNodePath: anArray 
	| found |
	anArray isEmpty
		ifTrue: [^ container listManager setSelectedMorph: nil].
	found := nil.
	self
		withSiblingsDo: [:each | found
				ifNil: [(each complexContents = anArray first
							or: [anArray first isNil])
						ifTrue: [found := each]]].
	found
		ifNotNil: [found isExpanded
				ifFalse: [found toggleExpandedState.
					container adjustSubmorphPositions].
			found changed.
			anArray size = 1
				ifTrue: [^ container setSelectedMorph: found].
			^ found firstChild
				ifNil: [container setSelectedMorph: nil]
				ifNotNil: [found firstChild openNodePath: anArray allButFirst]].
	^ container setSelectedMorph: nil! !

!MorphTreeNodeMorph methodsFor: 'testing' stamp: 'alain.plantec 3/7/2009 09:29'!
isFirstItem
	^owner submorphs first == self! !

!MorphTreeNodeMorph methodsFor: 'updating' stamp: 'IgorStasenko 4/6/2011 16:59'!
delete
	parent := nil.
	complexContents := nil.
	firstChild := nil.
	container := nil.
	nextSibling := nil.
	controls := nil.
	super delete.
! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'IgorStasenko 12/22/2012 03:02'!
boundsForBalloon

	"some morphs have bounds that are way too big"
	container ifNil: [^super boundsForBalloon].
	^self boundsInWorld intersect: container boundsInWorld ifNone: [ self boundsInWorld ]! !

!MorphTreeNodeMorph methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 11/22/2013 14:59'!
isPartialMatch
	
	^ self complexContents isPartialMatch! !

!MorphTreeNodeMorph methodsFor: 'updating' stamp: 'AlainPlantec 10/7/2011 21:52'!
selectNodePath: anArray
	"select a node from a path based on wrapper node equivalence"
	
	| found |
	anArray isNil ifTrue: [^ self].
	anArray isEmpty ifTrue: [^ self].
	self
		withSiblingsDo: [:each | found
				ifNil: [(each complexContents = anArray first
							or: [anArray first isNil])
						ifTrue: [found := each]]].
	found
		ifNotNil: [
			anArray size = 1
				ifTrue: [^ container listManager addToSelection: found].
			found firstChild
				ifNotNil: [:fc | fc selectNodePath: anArray allButFirst]].
! !

!MorphTreeNodeMorph methodsFor: 'drawing' stamp: 'AlainPlantec 2/3/2010 07:28'!
drawLinesOn: aCanvas 
	| hasToggle |
	hasToggle := self hasToggle.
	"Draw line from toggle to text"
	self drawLineToggleToTextOn: aCanvas hasToggle: hasToggle.

	"Draw the line from my toggle to the nextSibling's toggle"
	self nextSibling ifNotNil: [ self drawLinesToNextSiblingOn: aCanvas hasToggle: hasToggle ].

	"If I have children and am expanded, draw a line to my first child"
	(self firstChild notNil and: [ self isExpanded ])
		ifTrue: [ self drawLinesToFirstChildOn: aCanvas]! !

!MorphTreeNodeMorph methodsFor: 'updating' stamp: 'AlainPlantec 10/7/2011 21:05'!
updateChildrenRecursively
	self childrenDo: [:child | 
		child parent: self. 
		child updateChildrenRecursively]
	
! !

!MorphTreeNodeMorph methodsFor: 'layout' stamp: 'Sd 8/2/2014 16:01'!
layoutBounds
	"Return the bounds for laying out children of the receiver"

	| lb left right |
	
	lb := super layoutBounds.
	container ifNil: [ ^ lb ].
	left := (lb left + self spacerWidth).
	right := (lb right max: left + self spacerWidth).
	"Make sure that left and right have changed simultaneously, avoiding creating degenerate rectangle"
	^ Rectangle left: left right: right top: lb top bottom: lb bottom
! !

!MorphTreeNodeMorph methodsFor: 'updating' stamp: 'EstebanLorenzano 4/29/2014 14:43'!
highlight
	self
		allMorphsDo: [:m | (m isKindOf: StringMorph)
				ifTrue: [m setProperty: #originalColor toValue: m color.
					m color: self theme selectionTextColor]].
	complexContents highlightingColor 
		ifNotNil: [:c |
			self setProperty: #originalColor toValue: color.
			self color: c]! !

!MorphTreeNodeMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/26/2013 10:07'!
selectedWithoutNotifyingComplexContents: aBoolean
	"Only called at creation"
	
	aBoolean ifFalse: [ ^ self ].
	
	container listManager silentlySetSelectedMorph: self.
	selected := aBoolean.! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'alain.plantec 3/10/2009 13:16'!
indentGap
	^ container indentGap * indentLevel! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/24/2013 13:34'!
isExpanded: aBoolean

	isExpanded := aBoolean.
	self complexContents isExpanded: aBoolean! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/3/2010 09:49'!
lineColor
	"Answer a good color to use for drawing the lines that connect members of the hierarchy view.
	Used the cached color, or derive it if necessary by finding the receiver or 
	the first owner (up to my root) that is not transparent, then picking a contrasting color.
	Fall back to black if all my owners are transparent."

	^ lineColor 
		ifNil: [lineColor := container lineColorForNode: self complexContents]
	
! !

!MorphTreeNodeMorph methodsFor: 'updating' stamp: 'AlainPlantec 10/10/2011 23:43'!
changed
	"Need to invalidate the selection frame."
	container
		ifNil: [super changed] 
		ifNotNil: [container invalidRect: self selectionFrame]! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'alain.plantec 3/7/2009 09:29'!
lastChild
	"Answer the last child."

	|c|
	c := self firstChild ifNil: [^nil].
	[c nextSibling isNil] whileFalse: [c := c nextSibling].
	^c! !

!MorphTreeNodeMorph methodsFor: 'printing' stamp: 'AlainPlantec 10/8/2011 23:37'!
printOn: aStream
	aStream nextPutAll: 'NodeMorph('.
	complexContents printOn: aStream.
	aStream nextPut: $)! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'IgorStasenko 4/6/2011 17:10'!
minWidth
	"Fixed to work such that guessed width is unnecessary in
	#adjustSubmorphPositions."
	| gap |
	
	gap := container ifNil: [ 0 ] ifNotNil: [ self indentGap ].
	^ gap  max: super minWidth! !

!MorphTreeNodeMorph methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 5/11/2013 23:04'!
drawMouseDownHighlightOn: aCanvas
	"Draw with a dotted border."
	
	self highlightedForMouseDown 
		ifTrue: [
			container ifNil: [^super drawMouseDownHighlightOn: aCanvas].
			aCanvas 
				frameRectangle: self bounds
				width: 1
				colors: {container mouseDownHighlightColor. Color transparent}
				dashes: #(1 1)]! !

!MorphTreeNodeMorph methodsFor: 'drag and drop' stamp: 'alain.plantec 3/7/2009 09:29'!
acceptDroppingMorph: toDrop event: evt
	complexContents acceptDroppingObject: toDrop complexContents.
	toDrop delete.
	self highlightForDrop: false.! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 10/10/2011 10:46'!
toggleRectangle
	^(bounds left + self indentGap) @ bounds top extent: (container toggleImageWidth) @ bounds height! !

!MorphTreeNodeMorph methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 10/11/2013 16:05'!
expandPath: anAssociation

	anAssociation ifNil: [ ^ false ].
	^ anAssociation head = self complexContents withoutListWrapper
		ifFalse: [ false ]
		ifTrue: [
			anAssociation tail ifNil: [ ^ true ].
			(self isExpanded not and: [ self canExpand ]) ifTrue: [
				self toggleExpandedState.
				container innerWidgetChanged ].
			self children anySatisfy: [:child | child expandPath: anAssociation tail ]]! !

!MorphTreeNodeMorph methodsFor: 'expanding-collapsing' stamp: 'AlainPlantec 10/18/2013 09:31'!
expandItemPath: anArray
	"Open a path."
	
	| found |
	anArray isEmpty
		ifTrue: [^ container listManager setSelectedMorph: nil].
	found := nil.
	self
		withSiblingsDo: [:each | found
				ifNil: [(each complexContents withoutListWrapper = anArray first
							or: [anArray first isNil])
						ifTrue: [found := each]]].
	found
		ifNotNil: [found isExpanded
				ifFalse: [found toggleExpandedState].
			found changed.
			anArray size = 1
				ifTrue: [^ container listManager setSelectedMorph: found].
			^ found firstChild
				ifNil: [container setSelectedMorph: nil]
				ifNotNil: [found firstChild expandItemPath: anArray allButFirst]].
	^container setSelectedMorph: nil! !

!MorphTreeNodeMorph methodsFor: 'updating' stamp: 'AlainPlantec 10/8/2011 20:24'!
closeItemPath: anArray
	"Close a path based on wrapper item equivalence."
	
	| found |
	anArray isEmpty
		ifTrue: [^ container listManager setSelectedMorph: nil].
	found := nil.
	self
		withSiblingsDo: [:each | found
				ifNil: [(each complexContents withoutListWrapper = anArray first)
						ifTrue: [found := each]]].
	found
		ifNotNil: [(found isExpanded and: [anArray size = 1])
				ifTrue: [found toggleExpandedState.
					container adjustSubmorphPositions].
			found changed.
			anArray size = 1
				ifTrue: [^ container listManager setSelectedMorph: found].
			^ found firstChild
				ifNil: [container setSelectedMorph: nil]
				ifNotNil: [found firstChild closeItemPath: anArray allButFirst]].
	^container setSelectedMorph: nil! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'ThierryGoubier 10/21/2013 20:21'!
spacerWidth
	"Such a morph composed of, left to right, some space according to the level in the tree, an expand toggle (if any), a check box (if any),  and the item morphs (icon + text often). Compute here the width of the space, including the toggle (and the check box) if there is one."

	| baseRect |
	baseRect := self mustTakeIntoAccountCheckSpace
		ifTrue: [ self checkRectangle ]
		ifFalse: [ self toggleRectangle ].
	^ (self mustTakeIntoAccountToggleSpace or: [ self mustTakeIntoAccountCheckSpace ])
		ifTrue: [ baseRect right + container gapAfterToggle - bounds left ]
		ifFalse: [ baseRect left - bounds left ]! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 9/28/2011 23:37'!
checkGap
	^ 2! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'ThierryGoubier 10/7/2012 22:48'!
selectionFrame
	"Answer the selection frame rectangle."

	^ self bounds: self bounds in: container! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 9/28/2011 23:36'!
checkRectangle
	| tr |
	tr := self toggleRectangle translateBy: (3 @ 0).
	^ self mustTakeIntoAccountToggleSpace 
		ifTrue: [(tr topRight + (self checkGap @ 0)) corner:  tr bottomRight + ((self checkGap + self checkWidth) @ 0)]
		ifFalse: [tr]
! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/12/2009 06:42'!
rowMorphAt: anIndex
	^ self submorphs seconds submorphs at: anIndex! !

!MorphTreeNodeMorph methodsFor: '*Spec-MorphicAdapters' stamp: 'BenjaminVanRyseghem 11/18/2013 10:39'!
model

	^ self complexContents! !

!MorphTreeNodeMorph methodsFor: '*Spec-MorphicAdapters' stamp: 'BenjaminVanRyseghem 11/18/2013 10:42'!
isMorphicModel

	^ true! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/5/2010 09:16'!
color
	^ complexContents color ifNil: [self index ifNotNil: [container rowColors at: ((self index \\ 2) + 1)]]! !

!MorphTreeNodeMorph methodsFor: 'mouse events' stamp: 'AlainPlantec 10/16/2013 13:00'!
mouseDown: event
	container enabled ifFalse: [ ^self ].
	complexContents mouseDown: event! !

!MorphTreeNodeMorph methodsFor: 'updating' stamp: 'AlainPlantec 10/10/2011 23:53'!
expand
	| c newChildren  |
	isExpanded := true.
	(c := complexContents contents) isEmpty ifTrue: [^self changed].
	newChildren := container addMorphsAfter: self fromCollection: c.
	firstChild := newChildren first.
	self updateChildren

	
! !

!MorphTreeNodeMorph methodsFor: 'updating' stamp: 'ThierryGoubier 2/8/2013 16:28'!
openItemPath: anArray
	"Open a path based on wrapper item equivalence. Generally more specific
	than #openPath: (string based)."
	
	| found |
	anArray isEmpty
		ifTrue: [^ container listManager setSelectedMorph: nil].
	found := nil.
	self
		withSiblingsDo: [:each | found
				ifNil: [(each complexContents withoutListWrapper = anArray first
							or: [anArray first isNil])
						ifTrue: [found := each]]].
	found
		ifNotNil: [found isExpanded
				ifFalse: [found toggleExpandedState].
			found changed.
			anArray size = 1
				ifTrue: [^ container listManager setSelectedMorph: found].
			^ found firstChild
				ifNil: [container setSelectedMorph: nil]
				ifNotNil: [found firstChild openItemPath: anArray allButFirst]].
	^self! !

!MorphTreeNodeMorph methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 12/5/2013 14:24'!
drawCheckOn: aCanvas
	| topLeft icon |
	
	topLeft := self computeCheckTopLeft.
	icon := self retrieveCheckIcon.
	
	aCanvas
		drawImage: icon
		at: topLeft! !

!MorphTreeNodeMorph methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 11/22/2013 15:42'!
hasContentToShow

	^ self complexContents hasContentToShow! !

!MorphTreeNodeMorph methodsFor: 'updating' stamp: 'AlainPlantec 11/15/2009 17:18'!
themeChanged! !

!MorphTreeNodeMorph methodsFor: 'updating' stamp: 'AlainPlantec 10/11/2011 01:12'!
withSiblingsDo: aBlock

	| node |
	node := self.
	[node isNil] 
		whileFalse: [
			aBlock value: node.
			node := node nextSibling].! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'alain.plantec 10/23/2009 15:36'!
parent: aNodeMorph
	parent := aNodeMorph! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'alain.plantec 3/7/2009 09:29'!
withoutListWrapper

	^complexContents withoutListWrapper! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'alain.plantec 3/7/2009 09:29'!
indentLevel

	^indentLevel! !

!MorphTreeNodeMorph methodsFor: 'updating' stamp: 'alain.plantec 3/7/2009 09:29'!
childrenDo: aBlock

	firstChild ifNotNil: [
		firstChild withSiblingsDo: [ :aNode | aBlock value: aNode].
	]! !

!MorphTreeNodeMorph methodsFor: 'initialization' stamp: 'AlainPlantec 10/11/2011 00:03'!
initRow
	self buildRowMorph.
	self layoutChanged
! !

!MorphTreeNodeMorph methodsFor: 'testing' stamp: 'alain.plantec 3/7/2009 09:29'!
isExpanded

	^isExpanded! !

!MorphTreeNodeMorph methodsFor: 'updating' stamp: 'AlainPlantec 9/27/2011 00:38'!
highlightForMouseDown: aBoolean
	aBoolean 
		ifTrue: [self setProperty: #highlightedForMouseDown toValue: aBoolean]
		ifFalse: [self removeProperty: #highlightedForMouseDown].
	self changed! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/22/2013 11:08'!
selected: aBoolean
	selected = aBoolean
		ifTrue: [^ self].
	aBoolean
		ifTrue: [container selectedMorphList add: self]
		ifFalse: [selected 
			ifNotNil: [container selectedMorphList remove: self]].
	selected := aBoolean.

	self complexContents selected: aBoolean! !

!MorphTreeNodeMorph methodsFor: 'drawing' stamp: 'AlainPlantec 2/11/2011 15:46'!
drawToggleOn: aCanvas in: aRectangle

	| aForm centeringOffset |
	aForm := self toggleImageForm.
	centeringOffset := ((aRectangle height - aForm extent y) / 2.0) truncated.
	^aCanvas 
		translucentImage: aForm 
		at: (aRectangle topLeft translateBy: 0 @ centeringOffset).
! !

!MorphTreeNodeMorph methodsFor: 'testing' stamp: 'alain.plantec 3/7/2009 09:29'!
canExpand

	^complexContents hasContents! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'alain.plantec 3/7/2009 09:29'!
balloonText

	^complexContents balloonText ifNil: [super balloonText]! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/20/2009 17:19'!
index: anInteger
	index := anInteger! !

!MorphTreeNodeMorph methodsFor: 'updating' stamp: 'AlainPlantec 10/11/2011 01:08'!
updateColumnMorphsWidthWith: aListOfWidths
	| sw |
	(container columns isEmpty or: [self hasSubmorphs not]) ifTrue: [^ self].
	sw := self spacerWidth.
	1 to: aListOfWidths size - 1 
		do: [:idx | | w | 
			w := aListOfWidths at: idx.
			(controls at: idx) width: (w - (idx = 1 ifTrue: [sw] ifFalse: [0]))].
! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/24/2013 12:42'!
setSelectedSilently: aBoolean
	
	selected := aBoolean.
	self complexContents selected: aBoolean! !

!MorphTreeNodeMorph methodsFor: 'layout' stamp: 'AlainPlantec 10/9/2011 18:38'!
fullBounds
	fullBounds ifNotNil: [^ fullBounds].
	^ submorphs 
		ifEmpty: [bounds]
		ifNotEmpty: [
			self doLayoutIn: self layoutBounds.
			fullBounds]! !

!MorphTreeNodeMorph methodsFor: 'updating' stamp: 'AlainPlantec 10/7/2011 17:23'!
openPath: anArray 
	| found |
	anArray isEmpty
		ifTrue: [^ container listManager setSelectedMorph: nil].
	found := nil.
	self
		withSiblingsDo: [:each | found
				ifNil: [(each complexContents asString = anArray first
							or: [anArray first isNil])
						ifTrue: [found := each]]].
	found
		ifNil: ["try again with no case sensitivity"
			self
				withSiblingsDo: [:each | found
						ifNil: [(each complexContents asString sameAs: anArray first)
								ifTrue: [found := each]]]].
	found
		ifNotNil: [found isExpanded
				ifFalse: [found toggleExpandedState.
					container adjustSubmorphPositions].
			found changed.
			anArray size = 1
				ifTrue: [^ container setSelectedMorph: found].
			^ found firstChild
				ifNil: [container setSelectedMorph: nil]
				ifNotNil: [found firstChild openPath: anArray allButFirst]].
	^ container setSelectedMorph: nil! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'IgorStasenko 4/6/2011 16:48'!
icon
	"answer the receiver's icon"
	
	^ container iconBlock value: self complexContents.
	! !

!MorphTreeNodeMorph methodsFor: '*Glamour-Morphic-Widgets' stamp: 'AliakseiSyrel 10/8/2014 02:11'!
container

	^ container! !

!MorphTreeNodeMorph methodsFor: 'initialization' stamp: 'ThierryGoubier 7/23/2014 10:36'!
initWithContents: anObject prior: priorMorph forList: hostList indentLevel: newLevel
	"Make sure we properly register the delete event on the model."

	container := hostList.
	self cellInset: container resizerWidth @ 0.
	complexContents := anObject.
	anObject addDependent: self.
	self onAnnouncement: MorphDeleted do: [ :ann | anObject removeDependent: ann morph ].
	isExpanded := anObject isExpanded.
	nextSibling := firstChild := nil.
	priorMorph ifNotNil: [ priorMorph nextSibling: self ].
	indentLevel := newLevel.
	self setBalloonText: anObject helpText.
	self initRow.
	anObject selected
		ifTrue: [ self selectedWithoutNotifyingComplexContents: true ]! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 12/2/2009 17:27'!
columnMorphAt: anIndex
	^ controls at: anIndex ! !

!MorphTreeNodeMorph methodsFor: 'testing' stamp: 'AlainPlantec 10/28/2009 22:57'!
mustTakeIntoAccountToggleSpace
	^ indentLevel > 0 or: [	container hasToggleAtRoot]! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/3/2010 10:05'!
treeLineDashes
	^ container treeLineDashes! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'alain.plantec 3/7/2009 09:29'!
nextSibling: anotherMorph

	nextSibling := anotherMorph! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/9/2009 19:36'!
controls
	^ controls! !

!MorphTreeNodeMorph methodsFor: 'testing' stamp: 'alain.plantec 10/23/2009 12:15'!
hasToggle
	^ self canExpand! !

!MorphTreeNodeMorph methodsFor: 'updating' stamp: 'AlainPlantec 11/15/2009 17:18'!
adoptPaneColor: aColor! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'alain.plantec 3/7/2009 09:29'!
nextSibling

	^nextSibling! !

!MorphTreeNodeMorph methodsFor: 'testing' stamp: 'AlainPlantec 10/10/2011 09:12'!
inToggleArea: aPoint

	^self sensitiveToggleRectangle containsPoint: aPoint! !

!MorphTreeNodeMorph methodsFor: 'mouse events' stamp: 'AlainPlantec 10/16/2013 13:00'!
handleMouseUp: anEvent 
	container enabled ifFalse: [ ^ false ].
	(container commandOrCrontrolKeyPressed: anEvent) 
		ifTrue: [^ container listManager mouseUp: anEvent on: self].
	^ super handleMouseUp: anEvent! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/5/2010 21:58'!
index
	^ index ! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 10/10/2011 09:12'!
sensitiveToggleRectangle
	^(bounds left + self indentGap) @ bounds top extent: (container toggleImageWidth + container gapAfterToggle) @ bounds height! !

!MorphTreeNodeMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/25/2013 16:31'!
takeHighlight

	container listManager lastClickedMorph: self.
	container selectionChanged! !

!MorphTreeNodeMorph methodsFor: 'updating' stamp: 'AlainPlantec 10/8/2011 17:42'!
addChildrenForList: hostList addingTo: morphList withExpandedItems: expandedItems
	firstChild 
		ifNotNil: [
			firstChild withSiblingsDo: [ :aNode | aNode delete].
			firstChild := nil].
	complexContents hasContents ifFalse: [^self].
	firstChild := hostList 
		addMorphsTo: morphList
		from: complexContents contents
		withExpandedItems: expandedItems
		atLevel: indentLevel + 1.
! !

!MorphTreeNodeMorph methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 11/25/2013 16:30'!
update: aSymbol

	aSymbol = #select
		ifTrue: [ ^ self selected: true ].
		
	aSymbol = #deselect
		ifTrue: [ ^ self selected: false ].
		
	aSymbol = #takeHighlight
		ifTrue: [ ^ self takeHighlight ].

	super update: aSymbol! !

!MorphTreeNodeMorph methodsFor: 'updating' stamp: 'AlainPlantec 10/31/2009 08:51'!
updateChildren
	self childrenDo: [:child | child parent: self]
	
! !

!MorphTreeNodeMorph methodsFor: 'testing' stamp: 'alain.plantec 3/7/2009 09:29'!
isSoleItem
	^self isFirstItem and: [ owner submorphs size = 1 ]! !

!MorphTreeNodeMorph methodsFor: 'updating' stamp: 'alain.plantec 3/7/2009 09:29'!
recursiveDelete

	firstChild ifNotNil: [
		firstChild withSiblingsDo: [ :aNode | aNode recursiveDelete].
	].
	self delete
	! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'alain.plantec 3/7/2009 09:29'!
complexContents

	^complexContents! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 9/28/2011 09:44'!
selected
	^ selected ifNil: [selected := false]! !

!MorphTreeNodeMorph methodsFor: 'drawing' stamp: 'AlainPlantec 2/3/2010 10:27'!
drawLineToggleToTextOn: aCanvas hasToggle: hasToggle
	"If I am not the only item in my container, draw the line between:
		- my toggle (if any) or my left edge (if no toggle)
		- and my text left edge.
	Only draw now if no toggle."

	| myBounds myCenter hLineY hLineLeft myTheme ldelta |
	self isSoleItem ifTrue: [ ^self ].
	self hasToggle ifTrue: [^self].
	myBounds := self toggleRectangle.
	myCenter := myBounds center.
	hLineY := myCenter y - 1.
	ldelta := container treeLineWidth // 2.
	hLineLeft := myCenter x - ldelta.
	"Draw line from toggle to text. Use optimised form since vertical."
	myTheme := self theme.
	aCanvas
		frameRectangle: (hLineLeft @ (hLineY ) corner: myBounds right + 3  + ldelta @ (hLineY + container treeLineWidth ))
		width: container treeLineWidth
		colors: (myTheme treeLineColorsFrom: (self parent ifNil: [self lineColor] ifNotNil: [self parent lineColor]))
		dashes: self treeLineDashes! !

!MorphTreeNodeMorph methodsFor: 'accessing' stamp: 'alain.plantec 3/7/2009 09:29'!
firstChild

	^firstChild! !

!MorphTreeNodeMorph methodsFor: 'initialization' stamp: 'AlainPlantec 10/11/2011 00:01'!
buildRowMorph
	| rowControls colAndControls |
	controls := OrderedCollection new.
	colAndControls := container columns 
		collect: [:col | | v |
			v := col rowMorphFor: complexContents.
			controls add: v.
			col -> v].
	rowControls := OrderedCollection new.
	colAndControls
		do: [:ctrl | | col morph |
			col := ctrl key.
			morph := ctrl value.
			morph clipSubmorphs: true.
			morph vResizing: #shrinkWrap.  
			rowControls add: morph.
			(morph = controls last and: [container lastColumnUnbounded]) ifFalse: [morph hResizing: #rigid].
			(col resizable not and: [col shrinkWrap])
				ifTrue: [col currentWidth < morph width 
						ifTrue: [col forceWidthTo: morph width]]].

	self addAllMorphs: rowControls.
	self layoutChanged
	
! !

!MorphTreeNodeMorph methodsFor: 'drawing' stamp: 'AlainPlantec 2/3/2010 11:41'!
drawLinesToNextSiblingOn: aCanvas hasToggle: hasToggle
	"Draw line from me to next sibling"
	
	| myBounds nextSibBounds vLineX myCenter vLineTop vLineBottom myTheme ldelta gap |
	myBounds := self toggleRectangle.
	nextSibBounds := self nextSibling toggleRectangle.
	myCenter := myBounds center.
	vLineX := myCenter x.
	gap := (container notExpandedForm extent y // 2) + 1.
	vLineTop := myCenter y + (self hasToggle ifTrue: [gap] ifFalse: [0]).
	vLineBottom := nextSibBounds center y - (self nextSibling hasToggle ifTrue: [gap] ifFalse: [0]).
	"Draw line from me to next sibling"
	myTheme := self theme.
	ldelta := container treeLineWidth // 2.
	aCanvas
		frameRectangle: (vLineX - ldelta @ vLineTop corner: vLineX + ldelta + (container treeLineWidth \\ 2) @ vLineBottom)
		width: container treeLineWidth
		colors: (myTheme treeLineColorsFrom: self lineColor)
		dashes: self treeLineDashes! !

!MorphTreeNodeMorph methodsFor: 'mouse events' stamp: 'BenjaminVanRyseghem 12/5/2013 13:50'!
checkClickableZone
	| topLeft icon |
	
	topLeft := self computeCheckTopLeft.
	icon := self retrieveCheckIcon.
	
	^ topLeft corner: icon extent + topLeft! !

!MorphTreeNodeMorph methodsFor: 'updating' stamp: 'YuriyTymchuk 7/17/2014 09:59'!
unhighlight
	complexContents highlightingColor
		ifNotNil: [
			(self valueOfProperty: #originalColor ifAbsent: [Color black])
				ifNotNil: [:c | self color: c]].
	self
		allMorphsDo: [:m | (m isKindOf: StringMorph)
				ifTrue: [m 
						color: (m
								valueOfProperty: #originalColor
								ifAbsent: [ Smalltalk ui theme textColor ])]].
! !

!MorphTreeNodeMorph methodsFor: 'expanding-collapsing' stamp: 'AlainPlantec 10/18/2013 10:08'!
collapseNodePath: anArray
	"Close a path based on node."
	
	| found |
	anArray isEmpty
		ifTrue: [^ container setSelectedMorph: nil].
	found := nil.
	self
		withSiblingsDo: [:each | found
				ifNil: [(each complexContents = anArray first)
						ifTrue: [found := each]]].
	found
		ifNotNil: [(found isExpanded and: [anArray size = 1])
				ifTrue: [found toggleExpandedState.
					container adjustSubmorphPositions].
			found changed.
			anArray size = 1
				ifTrue: [^ container listManager setSelectedMorph: found].
			^ found firstChild
				ifNil: [container setSelectedMorph: nil]
				ifNotNil: [found firstChild collapseNodePath: anArray allButFirst]].
	^container setSelectedMorph: nil! !

!MorphTreePager commentStamp: 'TorstenBergmann 9/5/2014 15:30'!
A tree pager!
!MorphTreePager methodsFor: 'accessing' stamp: 'AlainPlantec 1/21/2010 21:57'!
setPageInterval: anInterval
	currentPageFirstIndex := anInterval first.
	self showCurrentPage.
	self changed: #currentPage! !

!MorphTreePager methodsFor: 'accessing' stamp: 'AlainPlantec 1/21/2010 21:20'!
choosePage
	| choiceList chosen |
	choiceList := OrderedCollection new.
	self allIntervals 
		doWithIndex: [:assoc :idx | | choiceString |
			choiceString := idx asString, ': ', (self nodeList at: assoc key) asString, ' ... ', (self nodeList at: assoc value) asString.
			choiceList add: idx -> choiceString].
	chosen := 
		UIManager default 
			chooseFrom: (choiceList collect: [:c | c value])
			values: (choiceList collect: [:c | c key])
			lines: nil 
			title: 'Choose a page'.
	chosen ifNil: [^self].
	self currentPage: chosen.! !

!MorphTreePager methodsFor: 'accessing' stamp: 'AlainPlantec 1/19/2010 09:11'!
currentPageFirstIndex
	^ currentPageFirstIndex ifNil: [currentPageFirstIndex := 1]! !

!MorphTreePager methodsFor: 'accessing' stamp: 'AlainPlantec 1/21/2010 22:09'!
showCurrentPage
	self buildPanel.
	treeMorph scroller removeAllMorphs.
	(self nodeList isNil or: [self nodeList isEmpty]) 
		ifTrue: [^ treeMorph emptySelection].
	treeMorph addSubmorphsFromNodeList.
	treeMorph updateColumnMorphs.
	treeMorph scrollSelectionIntoView 
! !

!MorphTreePager methodsFor: 'accessing' stamp: 'AlainPlantec 1/19/2010 09:13'!
nextPage
	self currentPageLastIndex < self nodeList size
		ifTrue: [currentPageFirstIndex := (currentPageFirstIndex + pageSize) min: self nodeList size.
			self showCurrentPage]! !

!MorphTreePager methodsFor: 'accessing' stamp: 'AlainPlantec 1/19/2010 09:11'!
currentPage
	^ self currentPageLastIndex \\ pageSize > 0
		ifTrue: [(self currentPageLastIndex / pageSize) asInteger + 1]
		ifFalse: [(self currentPageLastIndex / pageSize) asInteger]! !

!MorphTreePager methodsFor: 'accessing' stamp: 'AlainPlantec 1/19/2010 09:15'!
previousPage
	self currentPageFirstIndex > 1
		ifTrue: [currentPageFirstIndex := (currentPageFirstIndex - pageSize) max: 1.
			self showCurrentPage]! !

!MorphTreePager methodsFor: 'navigation' stamp: 'AlainPlantec 1/22/2010 17:51'!
buildPanel
	| widgets firstPageButton previousButton wid nextButton lastPageButton pageSizeEditor searchEditor |
	self removeAllMorphs.
	pageSize
		ifNil: [^ self].
	self nodeList
		ifNil: [^ self].
	widgets := OrderedCollection new.
	(self nodeList size > pageSize)
		ifTrue: [firstPageButton := self
						buttonLabel: self class smallToLeftEndIcon 
						actionSelector: #currentPage:
						arguments: {1}
						getEnabled: #notOnFirstPage
						help: 'First page'.
			widgets add: firstPageButton.
			previousButton := self
						buttonLabel: self class smallToLeftIcon
						actionSelector: #previousPage
						arguments: {}
						getEnabled: #notOnFirstPage
						help: 'Previous page'.
			widgets add: previousButton.
			wid := self textEntryLabel: '' get: #currentPage set: #currentPage: help: 'Index of page to view' translated class: Integer.
			wid hResizing: #rigid.
			wid width: (self preferedFont widthOfString: '1000').
			widgets add: wid.
			widgets add: (self buttonLabel: self class smallDiezeIcon actionSelector: #choosePage arguments: {} getEnabled: nil help: 'Choose page').
			nextButton := self
						buttonLabel: self class smallToRightIcon
						actionSelector: #nextPage
						arguments: {}
						getEnabled: #notOnLastPage
						help: 'Next page'.
			widgets add: nextButton.
			lastPageButton := self
						buttonLabel: self class smallToRightEndIcon
						actionSelector: #currentPage:
						arguments: {self lastPage}
						getEnabled: #notOnLastPage
						help: 'Last page'.
			widgets add: lastPageButton.
			widgets add: (self spacer: 10)].
	widgets add: (LabelMorph contents: 'Page size: ' font: self preferedFont).
	pageSizeEditor := self
				textEntryLabel: 'Page size'
				get: #pageSize
				set: #pageSizeInput:
				help: 'Change the page size or the number of pages if the input begins with "/"' translated
				class: String.
	pageSizeEditor hResizing: #rigid.
	pageSizeEditor width: (self preferedFont widthOfString: '10000').
	widgets add: pageSizeEditor.
	self withSearch
		ifTrue: [searchEditor := self
						textEntryLabel: ''
						get: #pageSearchText
						set: #pageSearchText:
						help: 'Enter a text correspondig to your search' translated
						class: String.
			searchEditor ghostText: 'Searched text'.
			widgets add: searchEditor].
	self addAllMorphs: widgets.
	self updateContents! !

!MorphTreePager methodsFor: 'testing' stamp: 'AlainPlantec 1/19/2010 09:13'!
notOnLastPage
	^ self onLastPage not! !

!MorphTreePager methodsFor: 'testing' stamp: 'AlainPlantec 1/19/2010 09:13'!
notOnFirstPage
	^ self onFirstPage not
! !

!MorphTreePager methodsFor: 'accessing' stamp: 'AlainPlantec 1/19/2010 09:11'!
currentPage: anIndex
	anIndex = self currentPage ifTrue: [^ self].
	anIndex = 1 
		ifTrue: [self setPageInterval: (1 to: (pageSize min: self nodeList size))]
		ifFalse: [ | lastIdx  |
			lastIdx := (anIndex * pageSize).
			lastIdx <= self nodeList size 
				ifTrue: [self setPageInterval: (((lastIdx - pageSize + 1) max: 1) to: (lastIdx))]
				ifFalse: [self setPageInterval: ((((self lastPage - 1) * pageSize) + 1) to: self nodeList size)]]
! !

!MorphTreePager methodsFor: 'accessing' stamp: 'AlainPlantec 1/20/2010 15:36'!
allIntervals
	| intervals |
	intervals := OrderedCollection new.
	1 to: self lastPage do: [:p | | start | intervals add: ((start := (((p - 1) * self pageSize) + 1)) -> (start + pageSize - 1))].
	intervals last value: self nodeList size.
	^ intervals! !

!MorphTreePager methodsFor: 'private' stamp: 'AlainPlantec 1/19/2010 10:37'!
currentNodelist
	^ self nodeList copyFrom: self currentPageFirstIndex to: self currentPageLastIndex! !

!MorphTreePager methodsFor: 'user interface' stamp: 'AlainPlantec 1/22/2010 15:12'!
updateForNewPageSize: newPageSize
	pageSize ~= newPageSize
		ifTrue: [ |  oldLast |
			oldLast := self currentPageLastIndex.
			pageSize := newPageSize max: 1.
			currentPageFirstIndex := (oldLast + 1 - pageSize) max: 1.
			self nodeList ifNotNil: [self showCurrentPage]]
! !

!MorphTreePager methodsFor: 'testing' stamp: 'AlainPlantec 1/19/2010 09:14'!
onLastPage
	^ self currentPageLastIndex = self nodeList size! !

!MorphTreePager methodsFor: 'accessing' stamp: 'AlainPlantec 1/19/2010 09:11'!
currentPageLastIndex
	^ pageSize ifNil: [self nodeList size] ifNotNil: [(self currentPageFirstIndex + pageSize - 1) min: self nodeList size]! !

!MorphTreePager methodsFor: 'testing' stamp: 'AlainPlantec 1/19/2010 09:12'!
hasSeveralPages
	^ self lastPage > 1! !

!MorphTreePager methodsFor: 'accessing' stamp: 'AlainPlantec 1/19/2010 09:12'!
lastPage
	| p |
	p := (self nodeList size / pageSize) asInteger.
	self nodeList size \\ pageSize > 0 ifTrue: [p := p + 1].
	^ p.
! !

!MorphTreePager methodsFor: 'testing' stamp: 'AlainPlantec 1/19/2010 09:14'!
onFirstPage
	^ self currentPageFirstIndex = 1! !

!MorphTreePager methodsFor: 'accessing' stamp: 'ThierryGoubier 2/8/2013 16:24'!
nextPage: theIndexOfAnElement
	"To make sure we can go to the page of an element."

	self currentPage: (self pageOfNodeIndex: theIndexOfAnElement)! !

!MorphTreeResizerMorph commentStamp: 'TorstenBergmann 9/5/2014 15:29'!
A resizer morph for a morphic based tree!
!MorphTreeResizerMorph methodsFor: 'Polymorph-Widgets' stamp: 'AlainPlantec 11/17/2009 16:47'!
themeChanged
	"Update the fill style."
	self fillStyle: self normalFillStyle.
	super themeChanged! !

!MorphTreeResizerMorph methodsFor: 'drawing' stamp: 'AlainPlantec 11/17/2009 17:18'!
drawOn: aCanvas
	(owner notNil and: [owner containsPoint: self position])
		ifTrue: [super drawOn: aCanvas]
! !

!MorphTreeResizerMorph methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 11/17/2009 16:35'!
updateFromEvent: anEvent 
	"Update the splitter and attached morph positions from
	the mouse event.
	Take into account the mouse down offset."
	| pNew previousX newWidth minX newLeft |
	pNew := anEvent cursorPoint - lastMouse second.
	minX := index = 1 
		ifTrue: [container minResizerX] 
		ifFalse: [(container columnResizers at: index - 1) right + container minResizerOffset].
	newLeft := minX max: pNew x.
	index = 1 
		ifTrue: [newLeft := newLeft + 3].
	self left: newLeft.
	previousX := index = 1
		ifTrue: [container scroller left - container scroller offset x + 3] 
		ifFalse: [(container columnResizers at: index - 1) left].
	newWidth := self left - previousX.
	(container columns at: index) currentWidth: newWidth.
	container resizerChanged! !

!MorphTreeResizerMorph methodsFor: 'as yet unclassified' stamp: 'alain.plantec 3/10/2009 14:09'!
normalizedY: y 
	^y! !

!MorphTreeResizerMorph methodsFor: 'Polymorph-Widgets' stamp: 'alain.plantec 3/9/2009 12:55'!
shouldDraw
	^ true! !

!MorphTreeResizerMorph methodsFor: 'as yet unclassified' stamp: 'alain.plantec 3/11/2009 07:45'!
splitsTopAndBottom
	^ false! !

!MorphTreeResizerMorph methodsFor: 'as yet unclassified' stamp: 'alain.plantec 3/9/2009 12:53'!
resizeCursor
	^ Cursor resizeForEdge: #left! !

!MorphTreeResizerMorph methodsFor: 'as yet unclassified' stamp: 'alain.plantec 3/10/2009 14:09'!
normalizedX: x

	^ x! !

!MorphTreeResizerMorph methodsFor: 'Polymorph-Widgets' stamp: 'AlainPlantec 11/18/2009 10:01'!
mouseUp: anEvent
	"Change the cursor back to normal if necessary and change the color back to normal."
	
	self canResizeColumn ifFalse: [^ self].
	(self bounds containsPoint: anEvent cursorPoint)
		ifFalse: [anEvent hand showTemporaryCursor: nil].
	self class fastSplitterResize
		ifTrue: [self updateFromEvent: anEvent].
	traceMorph ifNotNil: [traceMorph delete. traceMorph := nil].
	self adoptPaneColor: self paneColor.
	self triggerEvent: #mouseUp! !

!MorphTreeResizerMorph methodsFor: 'private - testing' stamp: 'AlainPlantec 11/27/2009 22:49'!
canResizeColumn
	^(container columns at: index) resizable
! !

!MorphTreeResizerMorph methodsFor: 'Polymorph-Widgets' stamp: 'AlainPlantec 11/17/2009 16:53'!
adoptPaneColor: paneColor 
	"Change our color too."
	super adoptPaneColor: paneColor.
	self fillStyle: self normalFillStyle! !

!MorphTreeResizerMorph methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 11/8/2009 12:32'!
container: aTreeMorph index: anInteger
	container := aTreeMorph.
	index := anInteger! !

!MorphTreeResizerMorph methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 2/11/2011 22:29'!
normalFillStyle
	"Return the normal fillstyle for the receiver."
	^ self theme morphTreeSplitterNormalFillStyleFor: self! !

!MorphTreeResizerMorph methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 2/11/2011 22:31'!
pressedFillStyle
	"Return the pressed fillStyle of the receiver."
	^ self theme morphTreeSplitterPressedFillStyleFor: self! !

!MorphTreeResizerMorph methodsFor: 'event handling' stamp: 'AlainPlantec 11/18/2009 10:01'!
mouseEnter: anEvent
	self canResizeColumn ifFalse: [^ self].
	(owner notNil and: [owner bounds containsPoint: anEvent position]) 
		ifTrue: [super mouseEnter: anEvent]! !

!MorphTreeResizerMorph methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 11/17/2009 16:57'!
getOldColor
	^ oldColor ifNil: [Color transparent]! !

!MorphTreeResizerMorph methodsFor: 'as yet unclassified' stamp: 'alain.plantec 3/9/2009 13:09'!
setGrabbedColor
	"Set the color of the receiver when it is grabbed."
	
	self fillStyle: self pressedFillStyle! !

!MorphTreeResizerMorph methodsFor: 'dependents access' stamp: 'AlainPlantec 11/3/2009 22:25'!
delete
	super delete.
	self release.
	! !

!MorphTreeResizerMorph methodsFor: 'event handling' stamp: 'AlainPlantec 11/18/2009 10:01'!
mouseDown: anEvent 
	"A mouse button has been pressed.
	Update the color for feedback and store the mouse
	position and relative offset to the receiver."
	| cp |
	self canResizeColumn ifFalse: [^ self].
	(self bounds containsPoint: anEvent cursorPoint)
		ifTrue: [oldColor := self color.
			self setGrabbedColor].
	cp := anEvent cursorPoint.
	lastMouse := {cp. cp - self position}! !

!MorphTreeResizerMorph methodsFor: 'event handling' stamp: 'AlainPlantec 11/18/2009 10:02'!
mouseLeave: anEvent
	self canResizeColumn ifFalse: [^ self].
	super mouseLeave: anEvent! !

!MorphTreeResizerMorph methodsFor: 'event handling' stamp: 'AlainPlantec 11/18/2009 10:01'!
mouseMove: anEvent 
	self canResizeColumn ifFalse: [^ self].
	anEvent hand temporaryCursor
		ifNil: [^ self].
	self class fastSplitterResize
		ifTrue: [traceMorph
				ifNil: [traceMorph := Morph newBounds: self bounds.
					traceMorph borderColor: Color lightGray.
					traceMorph borderWidth: 1.
					self owner addMorph: traceMorph].
			traceMorph position: (anEvent cursorPoint x - lastMouse second x) @ traceMorph position y]
		ifFalse: [self updateFromEvent: anEvent]! !

!MorphTreeResizerMorph methodsFor: 'submorphs-add/remove' stamp: 'AlainPlantec 11/3/2009 22:26'!
release
	traceMorph := nil.
	oldColor := nil.
	container := nil.
	super release.
	! !

!MorphTreeResizerMorph class methodsFor: 'instance creation' stamp: 'AlainPlantec 11/8/2009 12:31'!
container: aTreeList index: anInteger
	^ self new container: aTreeList index: anInteger! !

!MorphTreeResizerMorph class methodsFor: 'accessing' stamp: 'AlainPlantec 11/12/2009 19:58'!
fastSplitterResize
	^ true! !

!MorphTreeSelectionChanged commentStamp: 'TorstenBergmann 9/5/2014 15:25'!
Used to announce the change of a selection in the tree!
!MorphTreeSelectionChanged methodsFor: 'accessing' stamp: 'AlainPlantec 10/11/2011 11:47'!
selection
	^ selection! !

!MorphTreeSelectionChanged methodsFor: 'accessing' stamp: 'AlainPlantec 10/11/2011 11:47'!
selection: aSelection
	selection := aSelection! !

!MorphTreeTransformMorph commentStamp: 'TorstenBergmann 9/5/2014 15:29'!
A custom transform morph for a morphic based tree!
!MorphTreeTransformMorph methodsFor: 'drawing' stamp: 'AlainPlantec 10/16/2013 13:57'!
drawSubmorphsOn: aCanvas
	submorphs ifEmpty: [^ self].
	aCanvas transformBy: transform
		clippingTo: (aCanvas clipRect intersect: (owner clippingBounds) ifNone: ["we're done here" ^ self ])
		during: [:myCanvas |  | top bottom |
			top := self topVisibleRowForCanvas: myCanvas.
			bottom := self bottomVisibleRowForCanvas: myCanvas startingAt: top.
			bottom 
				to: top
				by: -1			
				do: [:row | | m |
					m := submorphs basicAt: row.
					self drawRawColorOn: myCanvas forSubmorph: m.
					myCanvas fullDrawMorph: m] ]
		smoothing: smoothing.
	owner withTreeLines ifTrue: [owner drawLinesOn: aCanvas].
	owner enabled ifFalse: [ aCanvas fillRectangle: owner innerBounds fillStyle: (owner paneColor alpha: 0.2) ]
! !

!MorphTreeTransformMorph methodsFor: 'change reporting' stamp: 'AlainPlantec 2/17/2010 16:02'!
privateInvalidateMorph: aMorph
! !

!MorphTreeTransformMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 2/26/2015 21:52'!
drawSubmorphsOnAthensCanvas: anAthensCanvas
	| clip |
	clip := self clippingBounds intersect: anAthensCanvas clipRect.
	anAthensCanvas
		transformBy: self transform
		withClip: clip
		in: self innerBounds
		during: [ :canvas | 
			| top bottom |
			top := self topVisibleRowForCanvas: canvas.
			bottom := self bottomVisibleRowForCanvas: canvas startingAt: top.
			bottom to: top by: -1 do: [ :row | 
				| m |
				m := submorphs basicAt: row.
				self drawRawColorOn: anAthensCanvas asCanvasWrapper forSubmorph: m.
				canvas fullDrawMorph: m ] ].
	owner withTreeLines
		ifTrue: [ owner drawLinesOn: anAthensCanvas asCanvasWrapper ].
	owner enabled
		ifFalse: [ anAthensCanvas asCanvasWrapper fillRectangle: owner innerBounds fillStyle: (owner paneColor alpha: 0.2) ]! !

!MorphTreeTransformMorph methodsFor: 'submorphs-add/remove' stamp: 'AlainPlantec 10/3/2011 01:28'!
addAllMorphs: aCollection after: anotherMorph
	^self privateAddAllMorphs: aCollection 
			atIndex: (anotherMorph index ifNil: [submorphs size])! !

!MorphTreeTransformMorph methodsFor: 'private' stamp: 'AlainPlantec 10/11/2011 00:10'!
privateAddAllMorphs: aCollection atIndex: index
	"Private. Add aCollection of morphs to the receiver"
	submorphs := Array 
		new: submorphs size + aCollection size
		streamContents: [:str |
			1 to: index do: [:p | str nextPut: (submorphs atWrap: p)].
			str nextPutAll: aCollection.
			index + 1 to: submorphs size do: [:p | str nextPut: (submorphs atWrap: p)]].
	aCollection do: [:m |  
		m fullBounds. 
		m privateOwner: self].
	self layoutChanged.
! !

!MorphTreeTransformMorph methodsFor: 'drawing' stamp: 'AlainPlantec 10/10/2011 23:05'!
rowAtLocation: aPoint startingAt: aPosition
	"return the number of the row at aPoint"
	| y |
	y := aPoint y.
	submorphs ifEmpty: [^ nil].
	aPosition to: submorphs size do: [ :idx | | m |
		m := submorphs basicAt: idx.
		m topLeft y >= y ifTrue: [^ (idx - 1) max: 1]].
	^ submorphs size! !

!MorphTreeTransformMorph methodsFor: 'initialization' stamp: 'AlainPlantec 10/11/2011 00:07'!
initialize
	super initialize.
	self smoothingOn! !

!MorphTreeTransformMorph methodsFor: 'drawing' stamp: 'AlainPlantec 10/9/2011 15:51'!
topVisibleRowForCanvas: aCanvas startingAt: aPos
     "return the top visible row in aCanvas's clip rectangle"

        ^ self rowAtLocation: (aCanvas clipRect topLeft) startingAt: aPos.
! !

!MorphTreeTransformMorph methodsFor: 'testing' stamp: 'AlainPlantec 10/10/2011 17:44'!
wantsSteps
	^ false! !

!MorphTreeTransformMorph methodsFor: 'layout' stamp: 'AlainPlantec 10/11/2011 13:22'!
localSubmorphBounds
	"Answer, in my coordinate system, the bounds of all my visible submorphs (or nil if no visible submorphs)"
	localBounds ifNil: [ 
		self hasSubmorphs ifFalse: [^ nil].
		localBounds :=  self firstSubmorph fullBounds topLeft corner: owner maxNodeWidth @ (self lastSubmorph fullBounds bottom + owner extraScrollRange)].
	^ localBounds 
! !

!MorphTreeTransformMorph methodsFor: 'drawing' stamp: 'AlainPlantec 10/5/2011 22:37'!
rowAtLocation: aPoint
	"return the number of the row at aPoint"
	| y |
	y := aPoint y.
	submorphs ifEmpty: [^ nil].
	submorphs doWithIndex:  [:m :idx | m topLeft y >= y ifTrue: [^ (idx - 1) max: 1]].
	^ submorphs size! !

!MorphTreeTransformMorph methodsFor: 'drawing' stamp: 'AlainPlantec 10/9/2011 16:03'!
bottomVisibleRowForCanvas: aCanvas startingAt: aPos
     "return the bottom visible row in aCanvas's clip rectangle"
	
	^ self rowAtLocation: (aCanvas clipRect  bottomRight)  startingAt: aPos
! !

!MorphTreeTransformMorph methodsFor: 'geometry' stamp: 'AlainPlantec 11/16/2009 11:05'!
fullBounds
	"Overridden to clip submorph hit detection to my bounds."
	"It might be better to override doLayoutIn:, and remove this method"

	fullBounds ifNotNil:[^ fullBounds].
	fullBounds := bounds.
	^ fullBounds! !

!MorphTreeTransformMorph methodsFor: 'layout' stamp: 'AlainPlantec 10/11/2011 13:02'!
submorphBounds
	"Private. Compute the actual full bounds of the receiver, optimized for speed"
	self hasSubmorphs ifFalse: [^ nil].
	^ self firstSubmorph topLeft corner: owner scroller bounds bottomLeft + (0@ owner extraScrollRange)
! !

!MorphTreeTransformMorph methodsFor: 'drawing' stamp: 'AlainPlantec 10/9/2011 03:15'!
bottomVisibleRowForCanvas: aCanvas
     "return the bottom visible row in aCanvas's clip rectangle"
	
	^ self rowAtLocation: (aCanvas clipRect  bottomRight).
! !

!MorphTreeTransformMorph methodsFor: 'drawing' stamp: 'NicolaiHess 12/6/2013 01:09'!
drawRawColorOn: aCanvas forSubmorph: aSubMorph
	| c frame |
	frame := (aSubMorph fullBounds withWidth: owner scroller innerBounds width) translateBy:(owner scroller offset x)@0.
	aSubMorph = owner listManager searchedElement
		ifTrue: [ 
			aCanvas fillRectangle: frame color: owner secondarySelectionColor.
			^ self ].
	owner listManager isCheckList
		ifTrue: [ 
			aSubMorph = owner listManager lastClickedMorph
				ifTrue: [ 
					aCanvas fillRectangle: frame color: owner selectionColorToUse.
					^ self ] ]
		ifFalse: [ 
			aSubMorph selected
				ifTrue: [ 
					aCanvas fillRectangle: frame color: owner selectionColorToUse.
					^ self ] ].
	(c := aSubMorph color) notNil
		ifTrue: [ 
			c isColor
				ifTrue: [ 
					aCanvas
						frameAndFillRectangle: frame
						fillColor: c
						borderWidth: 0
						borderColor: Color transparent ]
				ifFalse: [ 
					c origin: aSubMorph bounds topLeft.
					c direction: aSubMorph bounds width @ 0.
					aCanvas fillRectangle: frame basicFillStyle: c ] ]! !

!MorphTreeTransformMorph methodsFor: 'drawing' stamp: 'AlainPlantec 10/9/2011 03:16'!
topVisibleRowForCanvas: aCanvas
     "return the top visible row in aCanvas's clip rectangle"

        ^ self rowAtLocation: (aCanvas clipRect topLeft).
! !

!MorphWithSubmorphsWrapper commentStamp: 'ls 3/1/2004 17:32'!
Display a morph in a SimpleHierarchicalListMorph, and arrange to recursively display the morph's submorphs.  The "item" that is wrapped is the morph to display.!
!MorphWithSubmorphsWrapper methodsFor: 'hierarchy' stamp: 'ls 3/1/2004 17:34'!
contents
	^item submorphs collect: [ :m |
		self class with: m ]! !

!MorphWrapper commentStamp: '<historical>'!
A MorphWrapper is used to wrap a morph with a layout in the goal to be easily added to another morph!
!MorphWrapper methodsFor: 'accessing' stamp: ''!
morph: anObject
	
	morph := anObject! !

!MorphWrapper methodsFor: 'adding' stamp: ''!
addIn: aContainer
		
	aContainer
		addMorph: morph
		fullFrame: layout! !

!MorphWrapper methodsFor: 'accessing' stamp: ''!
fullFrame: anObject
	
	layout := anObject! !

!MorphWrapper methodsFor: 'accessing' stamp: 'StephaneDucasse 12/21/2012 11:26'!
frame: rectangle
	
	layout := rectangle asLayoutFrame! !

!MorphWrapper class methodsFor: 'instance creation' stamp: 'ClementBera 6/28/2013 10:33'!
morph: morph layout: aLayout 

	^ self new
		layout: aLayout;
		morph: morph;
		yourself! !

!MorphicAdapterBindings commentStamp: '<historical>'!
I am used to link the spec-adapter names to the morphic adapters!
!MorphicAdapterBindings methodsFor: 'initialize' stamp: 'StephaneDucasse 3/7/2014 11:13'!
initializeBindings
	
	bindings
		at: #ButtonAdapter				put: #MorphicButtonAdapter;
		at: #CheckBoxAdapter			put: #MorphicCheckBoxAdapter;
		at: #ContainerAdapter			put: #MorphicContainerAdapter;
		at: #DiffAdapter				put: #MorphicDiffAdapter;
		at: #DropListAdapter			put: #MorphicDropListAdapter;
		at: #LabelAdapter				put: #MorphicLabelAdapter;
		at: #ListAdapter				put: #MorphicListAdapter;
		at: #IconListAdapter			put: #MorphicIconListAdapter;
		at: #ImageAdapter			put: #MorphicImageAdapter;
		at: #MultiColumnListAdapter	put: #MorphicMultiColumnListAdapter;
		at: #MenuAdapter				put: #MorphicMenuAdapter;
		at: #MenuGroupAdapter		put: #MorphicMenuGroupAdapter;
		at: #MenuItemAdapter			put: #MorphicMenuItemAdapter;
		at: #NewListAdapter			put: #MorphicNewListAdapter;
		at: #RadioButtonAdapter		put: #MorphicRadioButtonAdapter;
		at: #SliderAdapter				put: #MorphicSliderAdapter;
		at: #TabManagerAdapter		put: #MorphicTabManagerAdapter;
		at: #TabAdapter				put: #MorphicTabAdapter;
		at: #TextAdapter				put: #MorphicTextAdapter;
		at: #TextInputFieldAdapter		put: #MorphicTextInputFieldAdapter;
		at: #TreeAdapter				put: #MorphicTreeAdapter;
		at: #TreeColumnAdapter		put: #MorphicTreeColumnAdapter;
		at: #TreeNodeAdapter			put: #MorphicTreeNodeAdapter;
		at: #WindowAdapter			put: #MorphicWindowAdapter;
		at: #TickingWindowAdapter	put: #MorphicTickingWindowAdapter;
		at: #DialogWindowAdapter		put: #MorphicDialogWindowAdapter;
		yourself! !

!MorphicAlarm commentStamp: 'LaurentLaffont 3/4/2011 22:45'!
I represent a message to be scheduled by the WorldState.

For example, you can see me in action with the following example which print 'alarm test' on Transcript one second after evaluating the code:

Transcript open.
MorphicUIManager currentWorld
        addAlarm: #show: 
        withArguments: #('alarm test') 
        for: Transcript 
        at: (Time millisecondClockValue + 1000).

* Note *
Compared to doing:
[(Delay forMilliseconds: 1000) wait. Transcript show: 'alarm test'] forkAt: Processor activeProcess priority +1.

the alarm system has several distinctions:
- Runs with the step refresh rate resolution.
- Alarms only run for the active world. (Unless a non-standard scheduler is in use)
- Alarms with the same scheduled time are guaranteed to be executed in the order they were added!
!MorphicAlarm methodsFor: 'accessing' stamp: 'ar 9/11/2000 16:45'!
scheduledTime: msecs
	"Set the time (in milliseconds) that the receiver is scheduled to be executed"
	scheduledTime := msecs! !

!MorphicAlarm methodsFor: 'accessing' stamp: 'ar 9/11/2000 16:44'!
scheduledTime
	"Return the time (in milliseconds) that the receiver is scheduled to be executed"
	^scheduledTime! !

!MorphicAlarm methodsFor: 'evaluating' stamp: 'GuillermoPolito 9/1/2010 18:45'!
value: anArgument
	| nArgs |
	numArgs ifNil:[numArgs := selector numArgs].
	nArgs := arguments ifNil:[0] ifNotNil:[arguments size].
	nArgs = numArgs ifTrue:[
		"Ignore extra argument"
		^self value].
	^arguments ifNil: [receiver perform: selector with: anArgument]
		ifNotNil: [receiver perform: selector withArguments: (arguments copyWith: anArgument)]! !

!MorphicAlarm class methodsFor: 'instance creation' stamp: 'ar 9/11/2000 16:44'!
scheduledAt: scheduledTime receiver: aTarget selector: aSelector arguments: argArray
	^(self receiver: aTarget selector: aSelector arguments: argArray)
		scheduledTime: scheduledTime.! !

!MorphicButtonAdapter commentStamp: '<historical>'!
SpecInterpreter
	interpretASpec: MorphicButtonAdapter  defaultSpec
	model: (MorphicButtonAdapter model: ButtonModel2 new)
!
!MorphicButtonAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 13:59'!
state

	^ self model state! !

!MorphicButtonAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 13:58'!
keyStroke: anEvent fromMorph: aMorph! !

!MorphicButtonAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 1/10/2014 14:35'!
menu: aMenu
	| menuModel |
	
	menuModel := self model menu.
	menuModel isBlock ifTrue: [ menuModel := menuModel value ].
	^ menuModel buildWithSpec! !

!MorphicButtonAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 13:59'!
label
	
	^ self buildLabel: self model label withIcon: self model icon! !

!MorphicButtonAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 14:04'!
action

	self widget ifNotNil: [:m | m takeKeyboardFocus ].
	self model performAction.! !

!MorphicButtonAdapter methodsFor: 'factory' stamp: 'MarcusDenker 11/5/2014 16:44'!
buildWidget
	
	| button | 
	button := PluggableButtonMorph
				on: self 
				getState: #state 
				action:  #action 
				label: #label 
				menu: nil. 	
	button 
		getEnabledSelector: #enabled ;
		hResizing: #spaceFill ;
		vResizing: #spaceFill ;
		askBeforeChanging: self askBeforeChanging ;
		setBalloonText: self model help ;
		dragEnabled: self dragEnabled;
		dropEnabled: self dropEnabled ;	
		eventHandler: (MorphicEventHandler new on: #keyStroke send: #keyStroke:fromMorph: to: self).
	^ button! !

!MorphicButtonAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/25/2013 14:12'!
askBeforeChanging

	^ self model askBeforeChanging! !

!MorphicButtonAdapter methodsFor: 'private' stamp: 'BenjaminVanRyseghem 1/15/2014 10:19'!
buildLabel: text withIcon: icon

	icon ifNil: [ ^ text
			ifNil: [ '' ]
			ifNotNil: [ text ] ].
	
	^ IconicListItem 
		text: text 
		icon: icon
! !

!MorphicCheckBoxAdapter commentStamp: '<historical>'!
I am an adapter to ease the bridge a CheckBoxModel and a CheckboxMorph!
!MorphicCheckBoxAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 17:31'!
state: aBoolean
	
	^ self model state: aBoolean! !

!MorphicCheckBoxAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 17:31'!
state
	
	^ self model state! !

!MorphicCheckBoxAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 17:30'!
label
	
	^ self model label! !

!MorphicCheckBoxAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/22/2013 17:39'!
labelOnRight

	^ self widgetDo: [ :w | w listDirection: #rightToLeft ]! !

!MorphicCheckBoxAdapter methodsFor: 'factory' stamp: 'StephaneDucasse 8/31/2014 09:00'!
buildWidget

	| checkButton |
	checkButton := CheckboxMorph
						on: self 
						selected: #state
						changeSelected: #state:. 			
	checkButton 
			label:	self label; 
			beCheckbox;
			hResizing: #spaceFill; 
			vResizing: #shrinkWrap; 
			setBalloonText: self help;
			dragEnabled: self dragEnabled;
			dropEnabled: self dropEnabled;	
			labelClickable: self labelClickable.
	^ checkButton! !

!MorphicCheckBoxAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 17:30'!
labelClickable
	
	^ self model labelClickable! !

!MorphicCheckBoxAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/22/2013 17:39'!
labelOnLeft

	^ self widgetDo: [ :w | w listDirection: #leftToRight ]! !

!MorphicContainerAdapter commentStamp: '<historical>'!
I am the adapter providing the correct container class: PanelMorph!
!MorphicContainerAdapter methodsFor: 'factory' stamp: 'StephaneDucasse 8/31/2014 09:00'!
buildWidget

	^ PanelMorph new
		changeProportionalLayout;
		vResizing: #spaceFill;
		hResizing: #spaceFill;
		yourself! !

!MorphicContainerAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/29/2013 13:50'!
newHSplitterAt: aPosition
	
	self widgetDo: [ :w | w newHSplitterAt: aPosition ]! !

!MorphicContainerAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/29/2013 13:50'!
checkSplitters
	
	self widgetDo: [ :w | w checkSplitters ]! !

!MorphicContainerAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/28/2013 17:20'!
centerWidget: aWindow

	self widgetDo: [ :w| w centerWidget: aWindow ]! !

!MorphicContainerAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/29/2013 13:50'!
newVSplitterAt: aPosition
	
	self widgetDo: [ :w | w newVSplitterAt: aPosition ]! !

!MorphicContainerAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/1/2013 13:32'!
isRedrawable
	"This must be overriden in the adapter representing your container"
	
	^ true! !

!MorphicCoreUIManager commentStamp: 'PavelKrivanek 7/20/2014 15:00'!
This is a very simplified version of MorphicUIManager for Moprhic subset that contains ony Morphic-Core package and has only support of the most basic morphs.!
!MorphicCoreUIManager methodsFor: 'ui process' stamp: 'PavelKrivanek 10/8/2013 19:15'!
resumeUIProcess: aProcess
  "Adopt aProcess as the project process -- probably because of proceeding from a debugger"
      
  UIProcess := aProcess.
  UIProcess resume! !

!MorphicCoreUIManager methodsFor: 'ui process' stamp: 'PavelKrivanek 10/8/2013 19:15'!
terminateUIProcess
  UIProcess suspend; terminate.
  UIProcess := nil "?"! !

!MorphicCoreUIManager methodsFor: 'ui requests' stamp: 'PavelKrivanek 10/8/2013 19:15'!
checkForNewDisplaySize

  "Check whether the screen size has changed and if so take appropriate actions"

  Display extent = DisplayScreen actualScreenSize ifTrue: [^ Display].
  DisplayScreen startUp.
  World restoreMorphicDisplay.
! !

!MorphicCoreUIManager methodsFor: 'ui requests' stamp: 'PavelKrivanek 10/8/2013 19:15'!
newDisplayDepthNoRestore: pixelSize

  "Change depths.  Check if there is enough space!!  , di"
  | area need |
  pixelSize = Display depth ifTrue: [^ Display  "no change"].
  pixelSize abs < Display depth ifFalse:
    ["Make sure there is enough space"
    area := Display boundingBox area. "pixels"
    need := (area * (pixelSize abs - Display depth) // 8)  "new bytes needed"
        + Smalltalk lowSpaceThreshold.
    (Smalltalk garbageCollectMost <= need
      and: [Smalltalk garbageCollect <= need])
      ifTrue: [self error: 'Insufficient free space']].
  Display setExtent: Display extent depth: pixelSize.

  DisplayScreen startUp! !

!MorphicCoreUIManager methodsFor: 'ui requests' stamp: 'PavelKrivanek 10/8/2013 19:15'!
restoreDisplayAfter: aBlock

  aBlock value.
  World activeHand waitButton.
  World fullRepaintNeeded.! !

!MorphicCoreUIManager methodsFor: 'ui requests' stamp: 'PavelKrivanek 10/8/2013 19:15'!
currentWorld
  ActiveWorld ifNotNil: [^ActiveWorld].
  ^World! !

!MorphicCoreUIManager methodsFor: 'ui process' stamp: 'PavelKrivanek 10/8/2013 19:15'!
spawnNewProcess

  UIProcess := [
    [World doOneCycle.  Processor yield.  false] whileFalse: [].
  ] newProcess priority: Processor userSchedulingPriority.
  UIProcess name: 'Morphic UI Process'.
  UIProcess resume! !

!MorphicCoreUIManager methodsFor: 'ui process' stamp: 'PavelKrivanek 10/8/2013 19:15'!
uiProcess
  " Answer the currently active UI process for morphic world.
  Client should check explicitly if #uiProcess answers nil or not (see other implementations)"

  ^ UIProcess! !

!MorphicDialogWindowAdapter commentStamp: '<historical>'!
I am the adapter used to bridge a DialogWindowModel and a DialogWindow!
!MorphicDialogWindowAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 9/28/2013 23:47'!
triggerOkAction

	self widget ifNotNil: [:w | w toolbar triggerOkAction ]! !

!MorphicDialogWindowAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/27/2013 15:08'!
triggerCancelAction

	self widget ifNotNil: [:w | w toolbar triggerCancelAction ]! !

!MorphicDialogWindowAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 9/28/2013 23:49'!
cancelAction: aBlock

	^ self widget
		ifNotNil: [:w | w cancelAction: aBlock ]! !

!MorphicDialogWindowAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/24/2013 15:13'!
toolbarBlock

	^ [ self model toolbar ]! !

!MorphicDialogWindowAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 12/4/2013 13:13'!
toolbar: aToolbar 

	self widgetDo: [ :w | w toolbar: aToolbar ]! !

!MorphicDialogWindowAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 23:50'!
contentMorph

	^ self model contents! !

!MorphicDialogWindowAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 11:53'!
open

	self widget openInWorld! !

!MorphicDialogWindowAdapter methodsFor: 'factory' stamp: 'StephaneDucasse 8/31/2014 09:02'!
buildWidget

	^ SpecDialogWindow new
			specWidget: self contentMorph;
			setToolbarFrom: self toolbarBlock;
			model: self model;
			initialize;
			yourself! !

!MorphicDialogWindowAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 9/28/2013 23:48'!
okAction: aBlock

	^ self widget
		ifNotNil: [:w | w okAction: aBlock ]! !

!MorphicDialogWindowAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 9/28/2013 23:45'!
okButtonEnabled: aBoolean

	self widget ifNotNil: [ :w | w toolbar okButton enabled: aBoolean ]! !

!MorphicDiffAdapter commentStamp: '<historical>'!
I am an adpater to bridge a DiffModel and a DiffMorph!
!MorphicDiffAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/21/2013 22:16'!
showBoth

	self widgetDo: [ :w | w showBoth ]! !

!MorphicDiffAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/21/2013 21:02'!
showOnlyDestination: aBoolean

	self widgetDo: [ :w | w showOnlyDestination: aBoolean ]! !

!MorphicDiffAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/21/2013 21:01'!
rightText: aText

	self widgetDo: [ :w | 
		w 
			dstText: aText;
			updateText ]! !

!MorphicDiffAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/21/2013 18:16'!
leftText

	^ self model leftText! !

!MorphicDiffAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/21/2013 21:02'!
showOptions: aBoolean

	self widgetDo: [ :w | w showOptions: aBoolean ]! !

!MorphicDiffAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/21/2013 18:16'!
rightText

	^ self model rightText! !

!MorphicDiffAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/21/2013 21:01'!
contextClass: aClass

	self widgetDo: [ :w | 
		w 
			contextClass: aClass;
			updateText ]! !

!MorphicDiffAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/21/2013 18:18'!
showOnlyDestination

	^ self model showOnlyDestination! !

!MorphicDiffAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/21/2013 22:16'!
showOnlySource

	^ self model showOnlySource! !

!MorphicDiffAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/21/2013 22:17'!
showOnlySource: aBoolean

	self widgetDo: [ :w | w showOnlySource: aBoolean ]! !

!MorphicDiffAdapter methodsFor: 'factory' stamp: 'MarcusDenker 11/5/2014 16:44'!
buildWidget

	^ DiffMorph new  
		on: self ;
		from: self leftText to: self rightText contextClass: self contextClass;
		 hResizing:	#spaceFill;
		vResizing: #spaceFill;
		setBalloonText: self  help;
		showOptions: self showOptions;
		showOnlyDestination: self showOnlyDestination;
		eventHandler: (MorphicEventHandler new on: #keyStroke send: #keyStroke:fromMorph: to: self);
		yourself! !

!MorphicDiffAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/21/2013 21:01'!
leftText: aText

	self widgetDo: [ :w | 
		w 
			srcText: aText;
			updateText ]! !

!MorphicDiffAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/21/2013 18:16'!
contextClass

	^ self model contextClass! !

!MorphicDiffAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/21/2013 18:18'!
showOptions

	^ self model showOptions! !

!MorphicDropListAdapter commentStamp: '<historical>'!
I am the adapter used to bridget a DropListModel and a DropListMorph!
!MorphicDropListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/23/2013 13:04'!
getIconFor: anItem

	^ self model iconHolder cull: anItem model cull: anItem! !

!MorphicDropListAdapter methodsFor: 'factory' stamp: 'StephaneDucasse 8/31/2014 09:14'!
buildWidget

	^ SpecDropListMorph new
		wrapSelector:	 #wrap:withIndex:; 
	    	on: self list: #getList selected: #getIndex changeSelected: #setIndex:;
		hResizing: #spaceFill ;
		vResizing: #spaceFill ;
		dragEnabled: self dragEnabled;
		dropEnabled: self dropEnabled;	
		setBalloonText: self help;
		yourself! !

!MorphicDropListAdapter methodsFor: 'widget API' stamp: 'StephaneDucasse 8/23/2014 21:18'!
setIndex: anIndex
	^ self model setIndex: anIndex! !

!MorphicDropListAdapter methodsFor: 'widget API' stamp: 'StephaneDucasse 8/23/2014 21:18'!
wrapItem: anItem index: anIndex
	| result |
	result := self model displayForItem: anItem.	
	^ result asString! !

!MorphicDropListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:03'!
getIndex

	^ self model getIndex! !

!MorphicDropListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/22/2013 18:31'!
getList

	^ self model getList! !

!MorphicEvent commentStamp: '<historical>'!
This class represents the base for all events.

Instance variables:
	stamp	<Integer>	The millisecond clock time stamp (based on Time millisecondClock)
	source	<Hand | nil>	If non-nil the hand that generated the event.!
!MorphicEvent methodsFor: 'transforming' stamp: 'ar 9/13/2000 15:47'!
transformedBy: aMorphicTransform
	"Return the receiver transformed by the given transform into a local coordinate system."
! !

!MorphicEvent methodsFor: 'accessing' stamp: 'JMM 7/20/2004 22:10'!
windowIndex
	^windowIndex! !

!MorphicEvent methodsFor: 'dispatching' stamp: 'ar 9/15/2000 21:12'!
sentTo: anObject
	"Dispatch the receiver into anObject"
	^anObject handleUnknownEvent: self! !

!MorphicEvent methodsFor: 'testing' stamp: 'ar 9/13/2000 19:19'!
isKeyboard
	^false! !

!MorphicEvent methodsFor: 'accessing' stamp: 'ar 10/10/2000 01:20'!
wasHandled: aBool
	"Determine if this event was handled. May be ignored for some types of events."! !

!MorphicEvent methodsFor: 'initialize' stamp: 'ar 10/10/2000 01:18'!
resetHandlerFields
	"Reset anything that is used to cross-communicate between two eventual handlers during event dispatch"! !

!MorphicEvent methodsFor: 'testing' stamp: 'ar 10/10/2000 21:27'!
isKeystroke
	^false! !

!MorphicEvent methodsFor: 'testing' stamp: 'ar 9/13/2000 19:17'!
isDropEvent
	^false! !

!MorphicEvent methodsFor: 'testing' stamp: 'ar 9/14/2000 18:21'!
isMouseOver
	^self type == #mouseOver! !

!MorphicEvent methodsFor: 'testing' stamp: 'JMM 10/6/2004 21:23'!
isMove
	^false! !

!MorphicEvent methodsFor: 'accessing' stamp: 'ar 9/13/2000 16:48'!
hand
	"Return the source that generated the event"
	^source! !

!MorphicEvent methodsFor: 'accessing' stamp: 'ar 9/13/2000 15:29'!
timeStamp
	"Return the millisecond clock value at which the event was generated"
	^timeStamp ifNil:[timeStamp := Time millisecondClockValue]! !

!MorphicEvent methodsFor: 'accessing' stamp: 'ar 9/13/2000 15:34'!
type
	"Return a symbol indicating the type this event."
	^self subclassResponsibility! !

!MorphicEvent methodsFor: 'accessing' stamp: 'ar 10/10/2000 21:28'!
cursorPoint
	"Backward compatibility. Use #position instead"
	^ self position! !

!MorphicEvent methodsFor: 'initialize' stamp: 'ar 10/10/2000 01:18'!
copyHandlerState: anEvent
	"Copy the handler state from anEvent. Used for quickly transferring handler information between transformed events."
! !

!MorphicEvent methodsFor: 'comparing' stamp: 'ar 9/13/2000 15:36'!
hash
	^self type hash! !

!MorphicEvent methodsFor: 'private' stamp: 'ar 10/25/2000 20:53'!
setTimeStamp: stamp
	timeStamp := stamp.! !

!MorphicEvent methodsFor: 'accessing' stamp: 'JMM 7/20/2004 22:10'!
windowIndex: aValue
	windowIndex := aValue! !

!MorphicEvent methodsFor: 'testing' stamp: 'ar 9/13/2000 15:37'!
isMorphicEvent
	^true! !

!MorphicEvent methodsFor: 'accessing' stamp: 'ar 10/10/2000 01:19'!
wasHandled
	"Return true if this event was handled. May be ignored for some types of events."
	^false! !

!MorphicEvent methodsFor: 'testing' stamp: 'ar 9/13/2000 19:19'!
isMouse
	^false! !

!MorphicEvent methodsFor: 'comparing' stamp: 'ar 9/13/2000 15:36'!
= anEvent
	anEvent isMorphicEvent ifFalse:[^false].
	^self type = anEvent type! !

!MorphicEvent methodsFor: 'accessing' stamp: 'wiz 12/8/2004 23:13'!
position
	"Since cursorPoint is defined and refers to position it should be defined
	here as well"
	^ self subclassResponsibility! !

!MorphicEvent methodsFor: 'private' stamp: 'ar 10/25/2000 21:26'!
setHand: aHand
	source := aHand! !

!MorphicEvent methodsFor: 'testing' stamp: 'ar 9/22/2000 10:36'!
isDraggingEvent
	^false! !

!MorphicEvent methodsFor: 'testing' stamp: 'JMM 10/6/2004 21:35'!
isWindowEvent
	^false! !

!MorphicEventDispatcher commentStamp: '<historical>'!
The class represents a strategy for dispatching events to some immediate child of a morph. It is used by morphs to delegate the somewhat complex action of dispatching events accurately. !
!MorphicEventDispatcher methodsFor: 'dispatching-callback' stamp: 'AlainPlantec 11/10/2014 16:37'!
handleMouseLeave: anEvent 
	^ self dispatchDefault: anEvent with: morph! !

!MorphicEventDispatcher methodsFor: 'dispatching-callback' stamp: 'AlainPlantec 11/10/2014 16:37'!
handleMouseWheel: anEvent 
	^ self dispatchDefault: anEvent with: morph
	! !

!MorphicEventDispatcher methodsFor: 'dispatching' stamp: 'ar 10/10/2000 21:13'!
dispatchDropEvent: anEvent with: aMorph
	"Find the appropriate receiver for the event and let it handle it. The dispatch is similar to the default dispatch with one difference: Morphs are given the chance to reject an entire drop operation. If the operation is rejected, no drop will be executed."
	| inside index morphs child localEvt |
	"Try to get out quickly"
	(aMorph fullBounds containsPoint: anEvent cursorPoint)
		ifFalse:[^#rejected].
	"Give aMorph a chance to repel the dropping morph"
	aMorph rejectDropEvent: anEvent.
	anEvent wasHandled ifTrue:[^self].

	"Go looking if any of our submorphs wants it"
	index := 1.
	inside := false.
	morphs := aMorph submorphs.
	[index <= morphs size] whileTrue:[
		child := morphs at: index.
		localEvt := anEvent transformedBy: (child transformedFrom: aMorph).
		(child processEvent: localEvt using: self) == #rejected ifFalse:[
			localEvt wasHandled ifTrue:[^anEvent wasHandled: true]. "done"
			inside := true.
			index := morphs size]. "break"
		index := index + 1.
	].

	inside ifFalse:[inside := aMorph containsPoint: anEvent cursorPoint event: anEvent].
	inside ifTrue:[^aMorph handleEvent: anEvent].
	^#rejected! !

!MorphicEventDispatcher methodsFor: 'dispatching-callback' stamp: 'AlainPlantec 11/10/2014 16:38'!
handleUnknownEvent: anEvent 
	^ self dispatchDefault: anEvent with: morph! !

!MorphicEventDispatcher methodsFor: 'dispatching-callback' stamp: 'AlainPlantec 11/10/2014 16:35'!
handleMouseDown: anEvent 

	^ self dispatchMouseDown: anEvent with: morph! !

!MorphicEventDispatcher methodsFor: 'dispatching' stamp: 'ar 10/10/2000 01:20'!
dispatchDefault: anEvent with: aMorph
	"Dispatch the given event. The event will be passed to the front-most visible submorph that contains the position wrt. to the event."
	| localEvt index child morphs inside |
	"See if we're fully outside aMorphs bounds"
	(aMorph fullBounds containsPoint: anEvent position) ifFalse:[^#rejected]. "outside"
	"Traverse children"
	index := 1.
	morphs := aMorph submorphs.
	inside := false.
	[index <= morphs size] whileTrue:[
		child := morphs at: index.
		localEvt := anEvent transformedBy: (child transformedFrom: aMorph).
		(child processEvent: localEvt using: self) == #rejected ifFalse:[
			"Not rejected. The event was in some submorph of the receiver"
			inside := true.
			localEvt wasHandled ifTrue:[anEvent copyHandlerState: localEvt].
			index := morphs size. "break"
		].
		index := index + 1.
	].

	"Check for being inside the receiver"
	inside ifFalse:[inside := aMorph containsPoint: anEvent position event: anEvent].
	inside ifTrue:[^aMorph handleEvent: anEvent].
	^#rejected
! !

!MorphicEventDispatcher methodsFor: 'dispatching-callback' stamp: 'AlainPlantec 11/10/2014 16:36'!
handleWindowEvent: anEvent 

	^ self dispatchWindowEvent: anEvent with: morph! !

!MorphicEventDispatcher methodsFor: 'dispatching-callback' stamp: 'AlainPlantec 11/10/2014 16:37'!
handleKeyUp: anEvent 

	^ self dispatchDefault: anEvent with: morph	! !

!MorphicEventDispatcher methodsFor: 'dispatching' stamp: 'tbn 3/12/2010 01:53'!
dispatchWindowEvent: anEvent with: aMorph
	"Host window events do not have a position and are only dispatched to the World"
	aMorph isWorldMorph ifFalse: [^#rejected].
	anEvent wasHandled ifTrue:[^self].
	^aMorph handleEvent: anEvent
! !

!MorphicEventDispatcher methodsFor: 'dispatching-callback' stamp: 'AlainPlantec 11/10/2014 16:37'!
handleKeyDown: anEvent 

		^ self dispatchDefault: anEvent with: morph! !

!MorphicEventDispatcher methodsFor: 'dispatching-callback' stamp: 'AlainPlantec 11/10/2014 16:37'!
handleMouseMove: anEvent 
	^ self dispatchDefault: anEvent with: morph! !

!MorphicEventDispatcher methodsFor: 'dispatching-callback' stamp: 'AlainPlantec 11/10/2014 16:37'!
handleKeystroke: anEvent 

	^ self dispatchDefault: anEvent with: morph! !

!MorphicEventDispatcher methodsFor: 'dispatching-callback' stamp: 'AlainPlantec 11/10/2014 16:38'!
handleStep: anEvent 
	^ self dispatchDefault: anEvent with: morph! !

!MorphicEventDispatcher methodsFor: 'dispatching' stamp: 'ar 10/10/2000 21:14'!
dispatchMouseDown: anEvent with: aMorph
	"Find the appropriate receiver for the event and let it handle it. Default rules:
	* The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event.
	* When travelling down the hierarchy a prospective handler for the event is installed. This prospective handler can be used by submorphs wishing to handle the mouse down for negotiating who the receiver is.
	* When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed.
	* If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event.
"
	| globalPt localEvt index child morphs handler inside lastHandler |
	"Try to get out quickly"
	globalPt := anEvent cursorPoint.
	(aMorph fullBounds containsPoint: globalPt) ifFalse:[^#rejected].

	"Install the prospective handler for the receiver"
	lastHandler := anEvent handler. "in case the mouse wasn't even in the receiver"
	handler := aMorph handlerForMouseDown: anEvent.
	handler ifNotNil:[anEvent handler: handler].

	"Now give our submorphs a chance to handle the event"
	index := 1.
	morphs := aMorph submorphs.
	[index <= morphs size] whileTrue:[
		child := morphs at: index.
		localEvt := anEvent transformedBy: (child transformedFrom: aMorph).
		(child processEvent: localEvt using: self) == #rejected ifFalse:[
			"Some child did contain the point so we're part of the top-most chain."
			inside := false.
			localEvt wasHandled ifTrue:[anEvent copyHandlerState: localEvt].
			index := morphs size].
		index := index + 1.
	].

	(inside == false or:[aMorph containsPoint: anEvent cursorPoint event: anEvent]) ifTrue:[
		"Receiver is in the top-most unlocked, visible chain."
		handler ifNotNil:[handler handleEvent: anEvent].
		"Note: Re-installing the handler is not really necessary but good style."
		anEvent handler: lastHandler.
		^self
	].
	"Mouse was not on receiver nor any of its children"
	anEvent handler: lastHandler.
	^#rejected! !

!MorphicEventDispatcher methodsFor: 'dispatching-callback' stamp: 'AlainPlantec 11/10/2014 16:37'!
handleDropFiles: anEvent 
	^ self dispatchDefault: anEvent with: morph! !

!MorphicEventDispatcher methodsFor: 'dispatching-callback' stamp: 'AlainPlantec 11/10/2014 16:37'!
handleMouseEnter: anEvent 

	^ self dispatchDefault: anEvent with: morph! !

!MorphicEventDispatcher methodsFor: 'dispatching-callback' stamp: 'AlainPlantec 11/10/2014 16:37'!
handleMouseOver: anEvent 	
	^ self dispatchDefault: anEvent with: morph! !

!MorphicEventDispatcher methodsFor: 'dispatching-callback' stamp: 'AlainPlantec 11/10/2014 16:37'!
handleMouseUp: anEvent 
	^ self dispatchDefault: anEvent with: morph	! !

!MorphicEventDispatcher methodsFor: 'dispatching-callback' stamp: 'AlainPlantec 11/10/2014 16:36'!
handleDropMorph: anEvent 

	^ self dispatchDropEvent: anEvent with: morph! !

!MorphicEventDispatcher methodsFor: 'dispatching' stamp: 'EstebanLorenzano 2/24/2015 17:37'!
dispatchEvent: anEvent with: aMorph
	"Dispatch the given event for a morph that has chosen the receiver to dispatch its events. "
	morph := aMorph.
	[ ^ anEvent sentTo: self ]
	ensure: [ morph := nil ]! !

!MorphicEventHandler commentStamp: 'GuillermoPolito 4/22/2012 19:16'!
I'm the class in charge of handling the subscriptions to events such as clicks or key presses.
I'm a provisory solution while my clients are fixed and I can be replaced by announcements!
!MorphicEventHandler methodsFor: 'testing' stamp: 'GuillermoPolito 4/22/2012 19:02'!
existsSubscriptionsFor: anEvent
	^(subscriptions includesKey: anEvent) and: [ (subscriptions at: anEvent) notEmpty ]! !

!MorphicEventHandler methodsFor: 'testing' stamp: 'GuillermoPolito 4/22/2012 19:08'!
handlesKeyDown: evt
	^self existsSubscriptionsFor: #keyDown! !

!MorphicEventHandler methodsFor: 'events' stamp: 'GuillermoPolito 4/22/2012 18:57'!
click: event fromMorph: sourceMorph 
	^self notifyMorphsOfEvent: event ofType: #click from: sourceMorph! !

!MorphicEventHandler methodsFor: 'events' stamp: 'GuillermoPolito 7/18/2012 13:04'!
notifyMorphsOfEvent: anEvent ofType: eventType from: sourceMorph
	| result |
	result := false.
	((subscriptions includesKey: eventType) not or: [ (subscriptions at: eventType) isEmpty ])
		ifTrue: [ ^false ].
	(subscriptions at: eventType) do: [ :s | result := result | ((s notify: anEvent from: sourceMorph) == true) ].
	^result! !

!MorphicEventHandler methodsFor: 'events' stamp: 'GuillermoPolito 4/22/2012 18:56'!
mouseEnterDragging: event fromMorph: sourceMorph
	^self notifyMorphsOfEvent: event ofType: #mouseEnterDragging from: sourceMorph! !

!MorphicEventHandler methodsFor: 'testing' stamp: 'GuillermoPolito 4/22/2012 19:06'!
handlesMouseDown: evt
	^(self existsSubscriptionsFor: #mouseDown)
		or: [ (self existsSubscriptionsFor: #mouseStillDown)
			or: [ (self existsSubscriptionsFor: #mouseUp)
				or: [ (self handlesClickOrDrag: evt)
					or: [ self handlesGestureStart: evt]]]].! !

!MorphicEventHandler methodsFor: 'copying' stamp: 'GuillermoPolito 4/22/2012 18:13'!
veryDeepFixupWith: deepCopier
	| old |
	"ALL inst vars were weakly copied.  If they were in the tree being copied, fix them up, otherwise point to the originals!!!!"

	super veryDeepFixupWith: deepCopier.
	1 to: self class instSize do: [:ii | 
		old := self instVarAt: ii.
		self instVarAt: ii put: (deepCopier references at: old ifAbsent: [old])
		].

! !

!MorphicEventHandler methodsFor: 'events' stamp: 'GuillermoPolito 4/22/2012 18:56'!
keyUp: event fromMorph: sourceMorph
	^self notifyMorphsOfEvent: event ofType: #keyUp from: sourceMorph! !

!MorphicEventHandler methodsFor: 'testing' stamp: 'MarcusDenker 11/5/2014 17:07'!
handlesMouseOver: evt
	(self existsSubscriptionsFor: #mouseEnter) ifTrue: [ ^true ].
	(self existsSubscriptionsFor: #mouseLeave)  ifTrue: [ ^true ].
	(self existsSubscriptionsFor: #mouseOver) ifTrue: [ ^true ].
	^false.
		! !

!MorphicEventHandler methodsFor: 'events' stamp: 'GuillermoPolito 4/22/2012 18:55'!
startDrag: event fromMorph: sourceMorph 
	^self notifyMorphsOfEvent: event ofType: #startDrag from: sourceMorph! !

!MorphicEventHandler methodsFor: 'testing' stamp: 'GuillermoPolito 4/22/2012 19:03'!
handlesGestureStart: evt
	^self existsSubscriptionsFor: #gestureStart! !

!MorphicEventHandler methodsFor: 'initialization' stamp: 'GuillermoPolito 4/22/2012 18:47'!
initialize
	subscriptions := Dictionary new.! !

!MorphicEventHandler methodsFor: 'testing' stamp: 'SeanDeNigris 1/29/2013 13:55'!
mouseSelectorsInclude: selector

	| mouseEventTypes allSubscriptions |
	mouseEventTypes := #(
		mouseDown
		mouseMove
		mouseStillDown
		mouseUp
		mouseEnter
		mouseLeave
		mouseEnterDragging
		mouseLeaveDragging
		doubleClick).
	
	allSubscriptions := subscriptions values gather: [ :e | e ].
	^ allSubscriptions anySatisfy: [ :e | (mouseEventTypes includes: e event) and: [ e selector = selector ] ].! !

!MorphicEventHandler methodsFor: 'events' stamp: 'GuillermoPolito 4/22/2012 18:57'!
keyStroke: event fromMorph: sourceMorph
	^self notifyMorphsOfEvent: event ofType: #keyStroke from: sourceMorph! !

!MorphicEventHandler methodsFor: 'initialization' stamp: 'GuillermoPolito 4/22/2012 19:24'!
on: eventName send: selector to: recipient withValue: value
	
	selector numArgs = 3 ifFalse:
		[self error: 'Warning: value parameters are passed as first of 3 arguments'].
	self
		addSubscription: (MorphEventSubscription on: eventName send: selector to: recipient withValue: value)
		toEvent: eventName.
	
! !

!MorphicEventHandler methodsFor: 'events' stamp: 'GuillermoPolito 4/22/2012 18:56'!
mouseUp: event fromMorph: sourceMorph
	^self notifyMorphsOfEvent: event ofType: #mouseUp from: sourceMorph! !

!MorphicEventHandler methodsFor: 'testing' stamp: 'GuillermoPolito 4/22/2012 19:09'!
handlesKeyStroke: evt
	^self existsSubscriptionsFor: #keyStroke! !

!MorphicEventHandler methodsFor: 'events' stamp: 'GuillermoPolito 4/22/2012 18:57'!
doubleClickTimeout: event fromMorph: sourceMorph 
	^self notifyMorphsOfEvent: event ofType: #doubleClickTimeout from: sourceMorph! !

!MorphicEventHandler methodsFor: 'testing' stamp: 'GuillermoPolito 4/22/2012 19:07'!
handlesMouseOverDragging: evt
	^(self existsSubscriptionsFor: #mouseEnterDragging )
		or: [ self existsSubscriptionsFor: #mouseLeaveDragging ]! !

!MorphicEventHandler methodsFor: 'testing' stamp: 'GuillermoPolito 4/22/2012 19:06'!
handlesMouseMove: evt
	^self existsSubscriptionsFor: #mouseMove! !

!MorphicEventHandler methodsFor: 'events' stamp: 'MarcusDenker 11/5/2014 17:05'!
mouseOver: event fromMorph: sourceMorph
	^self notifyMorphsOfEvent: event ofType: #mouseOver from: sourceMorph! !

!MorphicEventHandler methodsFor: 'access' stamp: 'GuillermoPolito 4/22/2012 17:55'!
allRecipients
	^subscriptions collect: #recipients! !

!MorphicEventHandler methodsFor: 'events' stamp: 'GuillermoPolito 4/22/2012 19:24'!
addSubscription: aSubscription toEvent: eventName
	(subscriptions includesKey: eventName)
		ifFalse: [ subscriptions at: eventName put: Set new. ].
	(subscriptions at: eventName)
		add: aSubscription.! !

!MorphicEventHandler methodsFor: 'testing' stamp: 'GuillermoPolito 4/22/2012 19:01'!
handlesClickOrDrag: evt
	^(self existsSubscriptionsFor: #click)
		or: [ (self existsSubscriptionsFor: #doubleClick) 
			or: [(self existsSubscriptionsFor: #startDrag)]].! !

!MorphicEventHandler methodsFor: 'testing' stamp: 'GuillermoPolito 4/22/2012 19:09'!
handlesKeyboard: evt
	^(self handlesKeyDown: evt)
		or: [ (self handlesKeyUp: evt)
			or: [ self handlesKeyStroke: evt ]].! !

!MorphicEventHandler methodsFor: 'events' stamp: 'GuillermoPolito 4/22/2012 18:56'!
mouseStillDown: event fromMorph: sourceMorph
	^self notifyMorphsOfEvent: event ofType: #mouseStillDown from: sourceMorph! !

!MorphicEventHandler methodsFor: 'events' stamp: 'GuillermoPolito 4/22/2012 18:56'!
mouseLeaveDragging: event fromMorph: sourceMorph
	^self notifyMorphsOfEvent: event ofType: #mouseLeaveDragging from: sourceMorph! !

!MorphicEventHandler methodsFor: 'access' stamp: 'CamilloBruni 8/1/2012 16:11'!
methodRefList
	"Return a MethodReference for each message I can send."
	| list |
	list := OrderedCollection new.
	subscriptions do: [ :s | 
		s recipient ifNotNil: [list
						add: (RGMethodDefinition
								realClass: (s recipient class whichClassIncludesSelector: s selector)
								selector: s selector)]
		].
	^ list! !

!MorphicEventHandler methodsFor: 'events' stamp: 'GuillermoPolito 4/22/2012 18:56'!
mouseEnter: event fromMorph: sourceMorph
	^self notifyMorphsOfEvent: event ofType: #mouseEnter from: sourceMorph! !

!MorphicEventHandler methodsFor: 'initialization' stamp: 'GuillermoPolito 4/22/2012 19:22'!
on: eventName send: selector to: recipient
	self
		addSubscription: (MorphEventSubscription on: eventName send: selector to: recipient)
		toEvent: eventName.! !

!MorphicEventHandler methodsFor: 'events' stamp: 'GuillermoPolito 4/22/2012 18:57'!
doubleClick: event fromMorph: sourceMorph 
	^self notifyMorphsOfEvent: event ofType: #doubleClick from: sourceMorph! !

!MorphicEventHandler methodsFor: 'events' stamp: 'GuillermoPolito 4/22/2012 18:56'!
mouseLeave: event fromMorph: sourceMorph
	^self notifyMorphsOfEvent: event ofType: #mouseLeave from: sourceMorph! !

!MorphicEventHandler methodsFor: 'testing' stamp: 'GuillermoPolito 4/22/2012 19:08'!
handlesKeyUp: evt
	^self existsSubscriptionsFor: #keyUp! !

!MorphicEventHandler methodsFor: 'events' stamp: 'GuillermoPolito 4/22/2012 18:57'!
keyDown: event fromMorph: sourceMorph
	^self notifyMorphsOfEvent: event ofType: #keyDown from: sourceMorph! !

!MorphicEventHandler methodsFor: 'events' stamp: 'GuillermoPolito 4/22/2012 18:56'!
mouseDown: event fromMorph: sourceMorph 
	"Take double-clicks into account."
	((self handlesClickOrDrag: event) and:[event redButtonPressed]) ifTrue:[
		event hand waitForClicksOrDrag: sourceMorph event: event.
	].
	^self notifyMorphsOfEvent: event ofType: #mouseDown from: sourceMorph! !

!MorphicEventHandler methodsFor: 'events' stamp: 'GuillermoPolito 4/22/2012 18:56'!
mouseMove: event fromMorph: sourceMorph
	^self notifyMorphsOfEvent: event ofType: #mouseMove from: sourceMorph! !

!MorphicEventHandler methodsFor: 'testing' stamp: 'GuillermoPolito 4/22/2012 19:08'!
handlesMouseStillDown: evt
	^self existsSubscriptionsFor: #mouseStillDown.! !

!MorphicEventHandlerTest methodsFor: 'tests' stamp: 'GuillermoPolito 4/22/2012 18:34'!
testDoubleClickFromMorph

	morph eventHandler on: #doubleClick send: #value to: true.
	
	self assert: ((morph doubleClick: nil) == true)! !

!MorphicEventHandlerTest methodsFor: 'tests' stamp: 'GuillermoPolito 7/18/2012 12:51'!
testKeyStrokeFromMorph

	| keyboardEvent |
	keyboardEvent := KeyboardEvent new 
							setType: #keystroke
							buttons: 2
							position: nil
							keyValue: nil
							charCode: 65
							hand: nil
							stamp: nil.

	morph eventHandler on: #keyStroke send: #value to: true.
	
	self assert: ((morph handleKeystroke: keyboardEvent) == true)! !

!MorphicEventHandlerTest methodsFor: 'tests' stamp: 'GuillermoPolito 7/18/2012 12:52'!
testTwoEventHandlersAreAttached

	| keyboardEvent first second |
	keyboardEvent := KeyboardEvent new 
							setType: #keystroke
							buttons: 2
							position: nil
							keyValue: 65
							charCode: 65
							hand: nil
							stamp: nil.

	first := false.
	second := false.
	morph eventHandler on: #keyStroke send: #value to: [ first := true ].
	morph eventHandler on: #keyStroke send: #value to: [ second := true ].
	morph handleKeystroke: keyboardEvent.
	
	self assert: first.
	self assert: second.! !

!MorphicEventHandlerTest methodsFor: 'tests' stamp: 'GuillermoPolito 4/22/2012 18:34'!
testDoubleClickTimeoutFromMorph

	morph eventHandler on: #doubleClickTimeout send: #value to: true.
	
	self assert: ((morph doubleClickTimeout: nil) == true)! !

!MorphicEventHandlerTest methodsFor: 'running' stamp: 'GuillermoPolito 4/22/2012 18:34'!
tearDown

	morph := nil! !

!MorphicEventHandlerTest methodsFor: 'tests-events' stamp: 'GuillermoPolito 4/22/2012 18:34'!
testMouseEnterDraggingFromMorph

	| event | 
	event := MouseEvent basicNew setType: #mouseOver position: nil buttons: 2 hand: Morph new.
	morph eventHandler on: #mouseEnterDragging send: #value to: true.
	
	self assert: ((morph handleMouseEnter: event) == true)! !

!MorphicEventHandlerTest methodsFor: 'tests-events' stamp: 'GuillermoPolito 4/22/2012 18:34'!
testMouseEnterFromMorph

	morph eventHandler on: #mouseEnter send: #value to: true.
	
	self assert: ((morph mouseEnter: nil) == true)! !

!MorphicEventHandlerTest methodsFor: 'tests-events' stamp: 'GuillermoPolito 4/22/2012 18:34'!
testMouseLeaveFromMorph

	morph eventHandler on: #mouseLeave send: #value to: true.
	
	self assert: ((morph mouseLeave: nil) == true)! !

!MorphicEventHandlerTest methodsFor: 'running' stamp: 'GuillermoPolito 4/22/2012 19:15'!
setUp

	morph := Morph new.
	morph eventHandler: MorphicEventHandler new! !

!MorphicEventHandlerTest methodsFor: 'tests' stamp: 'GuillermoPolito 4/22/2012 18:34'!
testClickFromMorph

	morph eventHandler on: #click send: #value to: true.
	
	self assert: ((morph click: nil) == true)! !

!MorphicGenericAdapter commentStamp: '<historical>'!
I am a generic adapter used to embed directly a Morph in spec.

Be aware that when you use this, you broke Spec plateform independency and force you application to run only on top of Morphic!
!MorphicGenericAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/1/2013 13:43'!
morph

	^ self widget! !

!MorphicGenericAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/1/2013 13:43'!
morph: anObject

	widget := anObject! !

!MorphicGenericAdapter class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 10/1/2013 13:10'!
morph: morph

	^ self new
		morph: morph;
		yourself! !

!MorphicIconListAdapter commentStamp: '<historical>'!
I am the adapter used to bridge an IconListModel and a PluggableIconListMorph!
!MorphicIconListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:33'!
getIconFor: anItem

	^ self model getIconFor: anItem! !

!MorphicIconListAdapter methodsFor: 'factory' stamp: 'StephaneDucasse 8/31/2014 09:16'!
buildWidget

	^ PluggableIconListMorph new
		    	model: self ;
			getListSizeSelector: #listSize ;
			getListElementSelector: #listElementAt: ;
			getIndexSelector: #getIndex ;
			setIndexSelector: #setIndex: ;
			getSelectionListSelector:	#getSelectionStateFor: ;
			setSelectionListSelector:	#setSelectionStateFor:at: ;
			getIconSelector: #getIconFor: ;
			resetListSelector:	#resetListSelection ; 
			getMenuSelector:	#menu:shifted: ;
			setMultipleSelection:	self multiSelection;
			wrapSelector: 	#wrapItem:index: ;
			dragEnabled:	self dragEnabled ;
			dropEnabled:	self dropEnabled ; 	
			setBalloonText: self help; 
			hResizing: 	#spaceFill;
			vResizing: 	#spaceFill;
			yourself! !

!MorphicImageAdapter commentStamp: '<historical>'!
I am the bridge between an ImageModel and a AlphaImageMorph!
!MorphicImageAdapter methodsFor: 'factory' stamp: 'StephaneDucasse 8/31/2014 09:16'!
buildWidget
	| alphaImage |
	alphaImage := AlphaImageMorph new.
	alphaImage model: self.
	alphaImage
		getImageSelector: #getImage;
		vResizing: #spaceFill;
		hResizing: #spaceFill;
		layout: #center;
		dragEnabled: self dragEnabled;
		dropEnabled: self dropEnabled;
		setBalloonText: self help;
		update: #getImage.
	^ alphaImage! !

!MorphicImageAdapter methodsFor: 'private' stamp: 'BenjaminVanRyseghem 1/11/2014 22:23'!
click

	^ self model action value! !

!MorphicImageAdapter methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 1/11/2014 22:22'!
adapt: aComposableModel

	super adapt: aComposableModel.
	widget
		on: #click
		send: #click
		to: self! !

!MorphicImageAdapter methodsFor: 'widget protocol' stamp: 'BenjaminVanRyseghem 1/11/2014 22:08'!
getImage

	^ self model image! !

!MorphicLabelAdapter commentStamp: '<historical>'!
I am the adapter used to bridget a LabelModel and a LabelMorph!
!MorphicLabelAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 1/4/2014 18:16'!
emphasis: anInteger 

	self widgetDo: [ :w | w emphasis: anInteger ]! !

!MorphicLabelAdapter methodsFor: 'factory' stamp: 'StephaneDucasse 8/31/2014 09:17'!
buildWidget
	| label |
	label := LabelMorph new model: self.
	label
		getEnabledSelector: #enabled;
		getTextSelector: #getText;
		vResizing: #shrinkWrap;
		hResizing: #spaceFill;
		dragEnabled: self dragEnabled;
		dropEnabled: self dropEnabled;
		setBalloonText: self help.
	^ label! !

!MorphicLabelAdapter methodsFor: 'model access' stamp: 'BenjaminVanRyseghem 9/25/2013 17:24'!
getText

	^ self model label! !

!MorphicListAdapter commentStamp: '<historical>'!
I am the adapter used to bridge a ListModel and a PluggableListMorph!
!MorphicListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:10'!
acceptDroppingMorph: draggedMorph event: event inMorph: source
	| item index |
	
	index := source rowAtLocation: event position.
	item := self model getList at: index ifAbsent: [ nil ].
	
	^ self acceptDropBlock valueWithEnoughArguments: { draggedMorph. event. source. item. index }! !

!MorphicListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:08'!
listElementAt: anIndex

	^ self model listElementAt: anIndex! !

!MorphicListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:08'!
getSelectionStateFor: anIndex

	^ self model getSelectionStateFor: anIndex! !

!MorphicListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:08'!
listElementAt: anIndex ifAbsent: aBlock

	^ self model listElementAt: anIndex ifAbsent: aBlock! !

!MorphicListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:08'!
resetListSelection

	^ self model resetListSelection! !

!MorphicListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 1/6/2014 16:04'!
backgroundColorFor: anItem at: index

	^ self model backgroundColorFor: anItem at: index! !

!MorphicListAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 1/10/2014 09:53'!
autoDeselect: aBoolean

	self widgetDo: [ :w | w autoDeselect: aBoolean ]! !

!MorphicListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:07'!
getIndex

	^ self model getIndex! !

!MorphicListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:14'!
listSize

	^ self model listSize! !

!MorphicListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:08'!
setIndex: anIndex

	^ self model setIndex: anIndex! !

!MorphicListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:08'!
wrapItem: anObject index: index

	^ self model wrapItem: anObject index: index! !

!MorphicListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 1/10/2014 09:57'!
autoDeselect

	^ self model autoDeselect! !

!MorphicListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:08'!
setSelectionStateFor: anIndex at: aBoolean

	^ self model setSelectionStateFor: anIndex at: aBoolean! !

!MorphicListAdapter methodsFor: 'factory' stamp: 'StephaneDucasse 8/23/2014 21:07'!
buildWidget

	^ PluggableListMorph new
		model: self;
		getListSizeSelector: #listSize;
		autoDeselect: self autoDeselect;
		getIndexSelector: #getIndex;
		setIndexSelector: #setIndex:;
		getSelectionListSelector: #getSelectionStateFor:;
		setSelectionListSelector: #setSelectionStateFor:at:;
		backgroundColoringBlockOrSelector: #backgroundColorFor:at: ;
		getListElementSelector: #listElementAt: ;
		resetListSelector: #resetListSelection;
		getMenuSelector: #menu:shifted: ;
		setMultipleSelection: self multiSelection;
		wrapSelector: #wrapItem:index: ;
		setBalloonText: self help;
		dragEnabled: self dragEnabled;
		dropEnabled: self dropEnabled;	
		hResizing: #spaceFill;
		vResizing: #spaceFill! !

!MorphicListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 1/6/2014 15:50'!
backgroundColorFor: anItem

	^ self model backgroundColorFor: anItem! !

!MorphicListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:14'!
multiSelection

	^ self model multiSelection! !

!MorphicListAdapter methodsFor: 'widget API' stamp: 'StephaneDucasse 9/7/2014 12:25'!
menu: aMenu shifted: aBoolean

	^ (self model menu: aMenu shifted: aBoolean) 
		! !

!MorphicMenuAdapter commentStamp: '<historical>'!
I am the adapter used to build a MenuMorph from a MenuModel!
!MorphicMenuAdapter methodsFor: 'private' stamp: 'StephaneDucasse 8/31/2014 09:21'!
buildWidgetPopup
	widget := self basicMenuPopUp.
	self menuGroups
		do: [ :group | 
			| items |
			items := group buildWithSpec.
			items do: [ :item | widget addMenuItem: item ] ]
		separatedBy: [ widget addLine ].
	^ widget! !

!MorphicMenuAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/1/2013 14:37'!
title

	^ self model title! !

!MorphicMenuAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 1/5/2014 17:29'!
openAt: aPoint 

	self widgetDo: [ :w | w invokeAt: (aPoint + (2@7)) in: World allowKeyboard: true ]! !

!MorphicMenuAdapter methodsFor: 'private' stamp: 'StephaneDucasse 8/31/2014 09:20'!
buildWidget

	^ ToolDockingBarMorph new
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		adoptMenuModel: self model
		yourself! !

!MorphicMenuAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 1/11/2014 20:11'!
menuGroups

	^ self model menuGroups select: [:e | e isEmpty not ]! !

!MorphicMenuAdapter methodsFor: 'initialization' stamp: 'StephaneDucasse 8/30/2014 18:09'!
adaptAsPopup: aComposableModel

	model := aComposableModel.
	aComposableModel addDependent: self.
	widget := self buildWidgetPopup.! !

!MorphicMenuAdapter methodsFor: 'private' stamp: 'StephaneDucasse 8/30/2014 18:11'!
basicMenuPopUp

	^  MenuMorph new
		addIfNeededTitle: self title andIcon: self icon! !

!MorphicMenuAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/1/2013 14:37'!
icon

	^ self model icon! !

!MorphicMenuAdapter class methodsFor: 'instance creation' stamp: 'StephaneDucasse 8/31/2014 09:20'!
adaptAsPopup: aComposableModel
	^ self new
		adaptAsPopup: aComposableModel;
		yourself! !

!MorphicMenuGroupAdapter commentStamp: '<historical>'!
I am used to compute a MenuGroupModel.
There is not Morphic represenation of a MenuGroup, that is why I do not have a coresponding morph.!
!MorphicMenuGroupAdapter methodsFor: 'private' stamp: 'StephaneDucasse 8/31/2014 09:22'!
buildWidget

	^ self menuItems collect: [ :each | each buildWithSpec ]! !

!MorphicMenuGroupAdapter methodsFor: 'protocol' stamp: 'StephaneDucasse 8/31/2014 09:22'!
menuItems
	
	^ self model menuItems! !

!MorphicMenuItemAdapter commentStamp: '<historical>'!
I am the bridge between a MenuItemModel and a ToggleMenuItemMorph!
!MorphicMenuItemAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/1/2013 17:21'!
enabled
	| enabled | 
	
	enabled := self model enabled.
	
	^ (enabled isBlock or: [ enabled isMessageSend ])
		ifTrue: [ enabled cull: self model ]
		ifFalse: [ enabled ]! !

!MorphicMenuItemAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/1/2013 15:12'!
performMenuActionWith: arguments

	^ self model performMenuActionWith: arguments! !

!MorphicMenuItemAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/1/2013 18:02'!
shortcut
	| shortcut | 
	
	shortcut := self model shortcut.
	
	^ (shortcut isBlock or: [ shortcut isMessageSend ])
		ifTrue: [ shortcut cull: self model ]
		ifFalse: [ shortcut ]! !

!MorphicMenuItemAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/1/2013 15:02'!
actionArguments

	^ [ Array with: self ]! !

!MorphicMenuItemAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 1/5/2014 16:13'!
shortcutText
	| shortcut platform string |
	
	shortcut := self shortcut.
	shortcut isString ifTrue: [ shortcut := self defaultModifierShortcut ].
	shortcut ifNil: [ ^ nil ].
	platform := Smalltalk os platformFamily.
	shortcut combinationsDo: [ :each | (each platform = Smalltalk os platformFamily) ifTrue: [ shortcut := each ] ].
	
	string := '⌘⇧'.
	
	^ (platform =  #MacOSX and: [ 
		(StandardFonts menuFont hasGlyphsForAll: string) and: [
		string allSatisfy: [ :c | (StandardFonts menuFont characterFormAt: c) width~= 0 ]]])
		ifFalse: [ shortcut shortcut printString ]
		ifTrue: [ String streamContents: [:stream | shortcut shortcut prettyPrintOn: stream ] ]! !

!MorphicMenuItemAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/1/2013 18:16'!
balloonText
	| balloonText | 
	
	balloonText := self model description.
	balloonText ifNil: [ ^ nil ].
	
	^ (balloonText isBlock or: [ balloonText isMessageSend ])
		ifTrue: [ balloonText cull: self model ]
		ifFalse: [ balloonText ]! !

!MorphicMenuItemAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/1/2013 17:20'!
state
	| state | 
	
	state := self model state.
	
	^ (state isBlock or: [ state isMessageSend ])
		ifTrue: [ state cull: self model ]
		ifFalse: [ state ]! !

!MorphicMenuItemAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 3/4/2014 17:25:06'!
subMenu
	| subMenu | 
	
	subMenu := self model subMenu.
	subMenu ifNil: [ ^ nil ].
	
	^ (subMenu isBlock or: [ subMenu isMessageSend ])
		ifTrue: [ subMenu cull: self model ]
		ifFalse: [ subMenu buildWithSpecAsPopup ]! !

!MorphicMenuItemAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/1/2013 13:44'!
action

	^ self model action! !

!MorphicMenuItemAdapter methodsFor: 'factory' stamp: 'StephaneDucasse 8/31/2014 09:22'!
buildWidgetAutoRefresh
	^ UpdatingMenuItemMorph new
		target: self;
		balloonTextSelector: #balloonText;
		subMenuSelector: #subMenu;
		nameSelector: #name;
		selector: #performMenuActionWith:;
		argumentsBlock: self actionArguments;
		getStateSelector: #state;
		iconSelector: #icon;
		enablementSelector: #enabled;
		keyText: self shortcutText;
		yourself! !

!MorphicMenuItemAdapter methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/29/2013 15:58'!
defaultModifierShortcut
	
	^ self shortcut first isUppercase
		ifTrue: [ OSPlatform current defaultModifier + KMModifier shift + self shortcut first ]
		ifFalse: [ OSPlatform current defaultModifier + self shortcut first ]! !

!MorphicMenuItemAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/1/2013 18:23'!
autoRefresh
	| autoRefresh | 
	
	autoRefresh := self model autoRefresh.
	
	^ (autoRefresh isBlock or: [ autoRefresh isMessageSend ])
		ifTrue: [ autoRefresh cull: self model ]
		ifFalse: [ autoRefresh ]! !

!MorphicMenuItemAdapter methodsFor: 'factory' stamp: 'StephaneDucasse 8/31/2014 09:23'!
buildWidget
	^ self autoRefresh
		ifTrue: [ self buildWidgetAutoRefresh ]
		ifFalse: [ self buildWidgetNoRefersh ]! !

!MorphicMenuItemAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/1/2013 17:21'!
name
	| name | 
	
	name := self model name.
	
	^ (name isBlock or: [ name isMessageSend ])
		ifTrue: [ name cull: self model ]
		ifFalse: [ name ]! !

!MorphicMenuItemAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/1/2013 18:25'!
stateSelector

	^ self state
		ifNil: [ nil ]
		ifNotNil: [ #state ]! !

!MorphicMenuItemAdapter methodsFor: 'factory' stamp: 'StephaneDucasse 8/31/2014 09:22'!
buildWidgetNoRefersh
	^ ToggleMenuItemMorph new
		contents: self name;
		target: self;
		selector: #performMenuActionWith:;
		subMenu: self subMenu;
		argumentsBlock: self actionArguments;
		getStateSelector: self stateSelector;
		icon: self icon;
		enablementSelector: #enabled;
		balloonText: self balloonText;
		keyText: self shortcutText;
		yourself! !

!MorphicMenuItemAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/1/2013 17:56'!
icon
	| icon | 
	
	icon := self model icon.
	
	^ (icon isBlock or: [ icon isMessageSend ])
		ifTrue: [ icon cull: self model ]
		ifFalse: [ icon ]! !

!MorphicModel commentStamp: '<historical>'!
MorphicModels are used to represent structures with state and behavior as well as graphical structure.  A morphicModel is usually the root of a morphic tree depicting its appearance.  The tree is constructed concretely by adding its consituent morphs to a world.

When a part is named in a world, it is given a new slot in the model.  When a part is sensitized, it is named, and a set of mouse-driven methods is also generated in the model.  These may be edited to induce particular behavior.  When a variable is added through the morphic world, it is given a slot in the model, along with a set of access methods.

In addition for public variables (and this is the default for now), methods are generated and called in any outer model in which this model gets embedded, thus propagating variable changes outward.!
!MorphicModel methodsFor: 'accessing' stamp: ''!
model 
	^ model! !

!MorphicModel methodsFor: 'settings' stamp: 'AlainPlantec 12/10/2009 14:30'!
keyboardFocusOnMouseDown
	^ self class keyboardFocusOnMouseDown! !

!MorphicModel methodsFor: 'initialization' stamp: 'dgd 2/14/2003 22:28'!
defaultColor
	"answer the default color/fill style for the receiver"
	^ Color transparent! !

!MorphicModel methodsFor: 'initialization' stamp: 'dgd 2/14/2003 22:35'!
defaultBorderColor
	"answer the default border color/fill style for the receiver"
	^ Color yellow! !

!MorphicModel methodsFor: 'classification' stamp: 'ar 10/5/2000 16:40'!
isMorphicModel
	^true! !

!MorphicModel methodsFor: 'menu' stamp: 'MarcusDenker 7/17/2014 13:26'!
hasYellowButtonMenu
	"Answer true if I have any items at all for a context (yellow button) menu."
	^ self wantsYellowButtonMenu
			or: [model
					ifNil: [false]
					ifNotNil: [:aModel | aModel hasModelYellowButtonMenuItems]]! !

!MorphicModel methodsFor: 'menu' stamp: 'MarcusDenker 7/19/2014 10:09'!
addCustomMenuItems: aCustomMenu hand: aHandMorph

	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
	model ifNotNil: [model addModelMenuItemsTo: aCustomMenu forMorph: self hand: aHandMorph].! !

!MorphicModel methodsFor: 'caching' stamp: 'sw 3/6/2001 11:22'!
releaseCachedState
	"Release cached state of the receiver"

	(model ~~ self and: [model respondsTo: #releaseCachedState]) ifTrue:
		[model releaseCachedState].
	super releaseCachedState! !

!MorphicModel methodsFor: 'settings' stamp: 'AlainPlantec 12/10/2009 14:52'!
mouseOverForKeyboardFocus
	^ self class mouseOverForKeyboardFocus! !

!MorphicModel methodsFor: 'initialization' stamp: 'FernandoOlivero 5/10/2011 06:51'!
model: anObject
	"Set my model and make me me a dependent of the given object."

	model ifNotNil: [model removeDependent: self].
	anObject ifNotNil: [anObject addDependent: self].
	model := anObject.
! !

!MorphicModel methodsFor: 'initialization' stamp: 'dgd 3/7/2003 15:07'!
defaultBounds
"answer the default bounds for the receiver"
	^ 0 @ 0 corner: 200 @ 100! !

!MorphicModel class methodsFor: 'settings' stamp: 'AlainPlantec 12/10/2009 14:53'!
mouseOverForKeyboardFocus: aBoolean
	MouseOverForKeyboardFocus := aBoolean! !

!MorphicModel class methodsFor: 'settings' stamp: 'AlainPlantec 12/10/2009 14:30'!
keyboardFocusOnMouseDown
	^ KeyboardFocusOnMouseDown ifNil: [KeyboardFocusOnMouseDown := true]! !

!MorphicModel class methodsFor: 'settings' stamp: 'AlainPlantec 12/10/2009 14:32'!
keyboardFocusOnMouseDown: aBoolean
	KeyboardFocusOnMouseDown := aBoolean! !

!MorphicModel class methodsFor: 'settings' stamp: 'AlainPlantec 12/10/2009 14:53'!
mouseOverForKeyboardFocus
	^ MouseOverForKeyboardFocus ifNil: [MouseOverForKeyboardFocus := false]! !

!MorphicMultiColumnListAdapter commentStamp: '<historical>'!
I am the adapter used to bridge a MultiColumnListModel and a PluggableMultiColumnListMorph!
!MorphicMultiColumnListAdapter methodsFor: 'factory' stamp: 'StephaneDucasse 8/31/2014 09:23'!
buildWidget
	^ PluggableMultiColumnListMorph new
		wrapSelector: #wrapItem:index:;
		model: self;
		getListSizeSelector: #listSize;
		getIndexSelector: #getIndex;
		setIndexSelector: #setIndex:;
		getSelectionListSelector: #getSelectionStateFor:;
		setSelectionListSelector: #setSelectionStateFor:at:;
		getListElementSelector: #listElementAt:;
		resetListSelector: #resetListSelection;
		getMenuSelector: #menu:shifted:;
		dragEnabled: self dragEnabled;
		dropEnabled: self dropEnabled;
		setMultipleSelection: self multiSelection;
		setBalloonText: self help;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		yourself! !

!MorphicNewListAdapter commentStamp: '<historical>'!
I am the adapter used to bridge a NewListModel and a NewList!
!MorphicNewListAdapter methodsFor: 'list protocol-events' stamp: 'BenjaminVanRyseghem 9/25/2013 18:52'!
indexesHasBeenSelected

	^ [ :indexes | self model selectedIndexes: indexes ]! !

!MorphicNewListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:54'!
deSelectOnReclick: aBoolean

	self model deSelectOnReclick: aBoolean! !

!MorphicNewListAdapter methodsFor: 'list protocol-events' stamp: 'BenjaminVanRyseghem 9/25/2013 18:53'!
itemHasBeenSelected

	^ [ :item |  self model selectedItem: item ]! !

!MorphicNewListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:49'!
headerClickedBlock

	^ [ self headerClicked ]! !

!MorphicNewListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:47'!
separatorAfter: item at: index

	^ self model separatorAfter: item at: index! !

!MorphicNewListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:46'!
getDisplayForItem: item at: index

	^ self model getDisplayForItem: item at: index! !

!MorphicNewListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:46'!
getRawItemAt: index

	^ self model getRawItemAt: index! !

!MorphicNewListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:47'!
keyStrokeAction: anEvent

	^ self model keyStrokeAction: anEvent! !

!MorphicNewListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:47'!
unselectOnChange

	^ self model unselectOnChange! !

!MorphicNewListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:45'!
allowToSelect

	^ self model allowToSelect! !

!MorphicNewListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:46'!
getHeaderTitle

	^ self model getHeaderTitle! !

!MorphicNewListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:46'!
getListSize

	^ self model getListSize! !

!MorphicNewListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:46'!
draggedItemAtIndex: anIndex

	^ self model draggedItemAtIndex: anIndex! !

!MorphicNewListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:47'!
isMultipleSelection

	^ self model isMultipleSelection! !

!MorphicNewListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:58'!
selectedIndex

	^ self model selectedIndex! !

!MorphicNewListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 3/4/2014 17:25:06'!
getMenu: shiftKeyState

	^ (self model getMenu: shiftKeyState) 
		ifNotNil: [ :menuModel | menuModel buildWithSpecAsPopup ]! !

!MorphicNewListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:47'!
handlesDoubleClick

	^ self model handlesDoubleClick! !

!MorphicNewListAdapter methodsFor: 'list protocol-events' stamp: 'BenjaminVanRyseghem 9/25/2013 18:52'!
itemsHasBeenSelected

	^ [ :selection | self model selectedItems: selection ]! !

!MorphicNewListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:45'!
acceptDroppingMorph: aMorph atIndex: index event: event inMorph: source
	
	^ self model acceptDroppingMorph: aMorph atIndex: index event: event inMorph: source! !

!MorphicNewListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:47'!
iconMaxSize

	^ self model iconMaxSize! !

!MorphicNewListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:47'!
iconForItem: anItem at: anIndex

	^ self model iconForItem: anItem at: anIndex! !

!MorphicNewListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:47'!
hasHeader

	^ self model hasHeader! !

!MorphicNewListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:46'!
getItems

	^ self model getItems! !

!MorphicNewListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:50'!
headerClicked

	^ self model headerClicked! !

!MorphicNewListAdapter methodsFor: 'list protocol-events' stamp: 'BenjaminVanRyseghem 9/25/2013 18:52'!
indexHasBeenSelected

	^ [:index | self model selectedIndex: index ]! !

!MorphicNewListAdapter methodsFor: 'factory' stamp: 'StephaneDucasse 8/31/2014 09:24'!
buildWidget
	^ NewList new
		model: self;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		deSelectOnReclick: self deSelectOnReclick;
		isMultipleSelection: self isMultipleSelection;
		unselectOnChange: self model unselectOnChange;
		whenSelectedIndexChangedDo: self indexHasBeenSelected;
		whenSelectedIndexesChangedDo: self indexesHasBeenSelected;
		whenSelectedItemChangedDo: self itemHasBeenSelected;
		whenSelectedItemsChangedDo: self itemsHasBeenSelected;
		whenHeaderIsClickedDo: self headerClickedBlock;
		dragEnabled: self dragEnabled;
		dropEnabled: self dropEnabled;
		endOfInitialization;
		setIndex: self selectedIndex;
		hasHeader: self hasHeader;
		yourself! !

!MorphicNewListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:46'!
getHeaderHeight

	^ self model getHeaderHeight! !

!MorphicNewListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:45'!
deSelectOnReclick

	^ self model deSelectOnReclick! !

!MorphicNewListAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 18:46'!
doubleClick: event

	^ self model doubleClick: event! !

!MorphicRadioButtonAdapter commentStamp: '<historical>'!
I am the adapter used to link a RadioButtonModel with a CheckboxMorph (which can also act as a radio button)!
!MorphicRadioButtonAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 20:17'!
state: aBoolean

	^ self model state: aBoolean! !

!MorphicRadioButtonAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 20:16'!
state

	^ self model state! !

!MorphicRadioButtonAdapter methodsFor: 'factory' stamp: 'StephaneDucasse 8/31/2014 09:24'!
buildWidget
	^ CheckboxMorph new
		on: self selected: #state changeSelected: #state:;
		label: self label;
		labelClickable: self labelClickable;
		beRadioButton;
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap;
		setBalloonText: self help;
		dragEnabled: self dragEnabled;
		dropEnabled: self dropEnabled;
		yourself! !

!MorphicRadioButtonAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 20:15'!
label

	^ self model label! !

!MorphicRadioButtonAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 20:16'!
labelClickable

	^ self model labelClickable! !

!MorphicShortcutHandler commentStamp: '<historical>'!
I am a null shortcut handler for morphic. I register myself as a tool to be replaced by somebody else who really wants to handle shortcuts.!
!MorphicShortcutHandler methodsFor: 'shortcut-handling' stamp: 'GuillermoPolito 11/7/2013 16:47'!
handleKeystroke: aKeystrokeEvent inMorph: aMorph

	"I do nothing. I'm a null object"! !

!MorphicShortcutHandler class methodsFor: 'tools' stamp: 'MarcusDenker 7/2/2014 10:09'!
registerToolsOn: aToolRegistry
	"commente out as Smalltalk resetTools might register this handler and break keybindings"
	"aToolRegistry register: self new as: #shortcuts"! !

!MorphicSliderAdapter commentStamp: '<historical>'!
I am the adapter used to bridget a SliderModel and a PluggableSliderMorph!
!MorphicSliderAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 20:19'!
value

	^ self model value! !

!MorphicSliderAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 20:22'!
value: aValue

	^ self model value: aValue! !

!MorphicSliderAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 20:19'!
label

	^ self model label! !

!MorphicSliderAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 20:18'!
absoluteValue

	^ self model absoluteValue! !

!MorphicSliderAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 20:19'!
max

	^ self model max! !

!MorphicSliderAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 20:19'!
quantum

	^ self model quantum! !

!MorphicSliderAdapter methodsFor: 'factory' stamp: 'StephaneDucasse 8/31/2014 09:25'!
buildWidget
	^ PluggableSliderMorph new
		model: self;
		getValueSelector: #value;
		setValueSelector: #value:;
		value: self absoluteValue;
		getLabelSelector: #label;
		max: self max;
		min: self min;
		quantum: self quantum;
		setBalloonText: self help;
		vResizing: #spaceFill;
		hResizing: #spaceFill;
		yourself! !

!MorphicSliderAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 20:19'!
min

	^ self model min! !

!MorphicSliderAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 20:20'!
absoluteValue: aFloat

	^ self model absoluteValue: aFloat! !

!MorphicTabAdapter commentStamp: 'PeterUhnak 3/16/2015 23:29'!
I am the adapter used to bridge a TabModel and a Tab!
!MorphicTabAdapter methodsFor: 'updating' stamp: 'PeterUhnak 3/16/2015 23:04'!
bindModel: aTabModel andWidget: aWidget
	"bind change propagation between Spec TabModel and Morphic Tab"

	aWidget when: #tabSelected send: #tabSelected to: aTabModel.
	aTabModel actionsHolder whenChangedDo: [ :new | aWidget actions: new ].
	aTabModel closeableHolder whenChangedDo: [ :new | aWidget closeable: new ].
	aTabModel iconHolder whenChangedDo: [ :new | aWidget icon: new ].
	aTabModel labelHolder whenChangedDo: [ :new | aWidget label: new ].
	aTabModel menuHolder whenChangedDo: [ :new | aWidget menu: new ].
	aTabModel morphHolder whenChangedDo: [ :new | aWidget morph: new ].
	aTabModel retrievingBlockHolder whenChangedDo: [ :new | aWidget retrievingBlock: new ].
	aTabModel selectedHolder whenChangedDo: [ :new | aWidget selected: new ]! !

!MorphicTabAdapter methodsFor: 'initialization' stamp: 'PeterUhnak 3/16/2015 22:52'!
adapt: aComposableModel
	widget := self buildWidgetWith: aComposableModel.
	aComposableModel addDependent: widget.
	self bindModel: aComposableModel andWidget: widget! !

!MorphicTabAdapter methodsFor: 'factory' stamp: 'PeterUhnak 3/16/2015 23:27'!
buildWidgetWith: aTabModel
	^ Tab new
		model: aTabModel;
		label: aTabModel label;
		icon: aTabModel icon;
		retrievingBlock: aTabModel retrievingBlock;
		morph: aTabModel contents;
		menu: aTabModel menu;
		closeable: aTabModel closeable;
		setActionsFrom: [ aTabModel actions ];
		yourself! !

!MorphicTabManagerAdapter commentStamp: '<historical>'!
I am the adpater used to bridge a TabManagerModel and a TabManager!
!MorphicTabManagerAdapter methodsFor: 'factory' stamp: 'StephaneDucasse 8/31/2014 09:28'!
buildWidget
	^ TabManager new
		model: self model;
		setTabs: self getTabs;
		when: #tabSelected send: #tabSelected: to: self;
		vResizing: #spaceFill;
		hResizing: #spaceFill;
		yourself! !

!MorphicTabManagerAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 10/1/2013 14:25'!
getTabs

	^ [ self model tabs collect: [ :each | each buildWithSpec asWidget ] ]! !

!MorphicTabManagerAdapter methodsFor: 'spec protocol' stamp: 'MartinDias 2/25/2014 13:06'!
addTab: aTab

	self widgetDo: [ :w | w addTab: aTab buildWithSpec ]! !

!MorphicTabManagerAdapter methodsFor: 'widget API' stamp: 'YuriyTymchuk 9/17/2014 15:11'!
tabSelected: aTab

	self model selectedTab: aTab! !

!MorphicTextAdapter commentStamp: '<historical>'!
I am the adapter used to bridge a TextModel and a PluggableTextMorph!
!MorphicTextAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 21:23'!
behavior

	^ self model behavior! !

!MorphicTextAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 21:18'!
selectedBehavior

	^ self model selectedBehavior! !

!MorphicTextAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 21:17'!
doItContext

	^ self model doItContext! !

!MorphicTextAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 9/28/2013 22:36'!
setSelectionFromModel: aSelection

	self widget ifNotNil: [:w | w setSelection: aSelection ]! !

!MorphicTextAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/27/2013 14:58'!
askBeforeDiscardingEdits: aBoolean

	self widgetDo: [ :w | w askBeforeDiscardingEdits: aBoolean ]! !

!MorphicTextAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 1/10/2014 12:16'!
setHasUnacceptedEdits: aBoolean

	self widgetDo: [ :w | w basicHasUnacceptedEdits: aBoolean ]! !

!MorphicTextAdapter methodsFor: 'private-shout' stamp: 'BenjaminVanRyseghem 9/28/2013 22:00'!
okToStyle

	^ true! !

!MorphicTextAdapter methodsFor: 'widget API' stamp: 'NicolaiHess 2/15/2014 23:13'!
setSelection: interval

	self model setSelectionInterval: interval! !

!MorphicTextAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 9/28/2013 21:30'!
classOrMetaClass: aClass

	self widget classOrMetaClass: aClass! !

!MorphicTextAdapter methodsFor: 'widget API' stamp: 'EstebanLorenzano 10/11/2013 15:57'!
font: aFont
	self widgetDo: [ :w | w font: aFont ]! !

!MorphicTextAdapter methodsFor: 'NOCompletion' stamp: 'BenjaminVanRyseghem 9/28/2013 22:02'!
isCodeCompletionAllowed

	^ self model isCodeCompletionAllowed! !

!MorphicTextAdapter methodsFor: 'NOCompletion' stamp: 'BenjaminVanRyseghem 9/28/2013 22:00'!
selectedClassOrMetaClass

	^ self behavior! !

!MorphicTextAdapter methodsFor: 'NOCompletion' stamp: 'BenjaminVanRyseghem 9/28/2013 22:00'!
guessTypeForName: aString

	^nil! !

!MorphicTextAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 1/5/2014 14:18'!
hasEditingConflicts: aBoolean
 
	self widgetDo: [ :w | w hasEditingConflicts: aBoolean ]! !

!MorphicTextAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 21:18'!
readSelection

	^ self model readSelection! !

!MorphicTextAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 1/10/2014 12:32'!
pendingText

	^ self widgetDo: [ :w | w text ]! !

!MorphicTextAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 1/10/2014 12:32'!
pendingText: aText

	self widgetDo: [ :w | 
		w setText: aText.
		w hasUnacceptedEdits: true ]! !

!MorphicTextAdapter methodsFor: 'NOCompletion' stamp: 'BenjaminVanRyseghem 9/28/2013 22:00'!
receiverClass

	^ self behavior! !

!MorphicTextAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 21:19'!
shoutAboutToStyle: aMorph
	
	^ self model isAboutToStyle! !

!MorphicTextAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 10/1/2013 13:29'!
setScrollValue: aValue

	self widgetDo: [ :w | w scrollValue: aValue ]! !

!MorphicTextAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/27/2013 14:30'!
autoAccept

	^ self model autoAccept! !

!MorphicTextAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 1/5/2014 14:06'!
notify: errorMessage at: position in: sourceCode

	self widgetDo: [ :w | w notify: errorMessage at: position in: sourceCode ]! !

!MorphicTextAdapter methodsFor: 'widget API' stamp: 'StephaneDucasse 8/31/2014 09:28'!
autoAccept: aBoolean

	^ self model autoAccept: aBoolean! !

!MorphicTextAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 21:17'!
codePaneMenu: aMenu shifted: shifted 

	^ self model codePaneMenu: aMenu shifted: shifted ! !

!MorphicTextAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/27/2013 14:54'!
wantsVisualFeedback

	^ self model wantsVisualFeedback! !

!MorphicTextAdapter methodsFor: 'protocol-shout' stamp: 'BenjaminVanRyseghem 9/28/2013 22:03'!
isAboutToStyle

	^ self model isAboutToStyle! !

!MorphicTextAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 21:17'!
getText

	^ self model text! !

!MorphicTextAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 21:16'!
accept: aText notifying: aNotifyier

	self model accept: aText notifying: aNotifyier! !

!MorphicTextAdapter methodsFor: '*SmartSuggestions' stamp: 'GiselaDecuzzi 11/7/2013 12:34'!
sugsContext
	^SugsMorphicTextAdapterContext model: self! !

!MorphicTextAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 21:21'!
clearUserEditFlag

	self model text: self getText.
	self changed: #clearUserEdits! !

!MorphicTextAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/23/2013 23:20'!
accept
	
	self widgetDo:[ :w | w accept ]! !

!MorphicTextAdapter methodsFor: 'factory' stamp: 'StephaneDucasse 8/31/2014 09:41'!
buildWidget
	^ PluggableTextMorph new
		classOrMetaClass: self behavior;
		on: self
			text: #getText
			accept: #accept:notifying:
			readSelection: #readSelection
			menu: #codePaneMenu:shifted:
			setSelection: #setSelection:;
		enabled: self enabled;
		askBeforeDiscardingEdits: self askBeforeDiscardingEdits;
		autoAccept: self autoAccept;
		setBalloonText: self help;
		dragEnabled: self dragEnabled;
		dropEnabled: self dropEnabled;
		registerScrollChanges: #scrollValueChanged:;
		vResizing: #spaceFill;
		hResizing: #spaceFill;
		yourself! !

!MorphicTextAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 21:17'!
doItReceiver

	^ self model doItReceiver! !

!MorphicTextAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/24/2013 15:56'!
selectAll

	self widgetDo: [ :w | w selectAll ]! !

!MorphicTextAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/27/2013 14:58'!
askBeforeDiscardingEdits

	^ self model askBeforeDiscardingEdits! !

!MorphicTextAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 10/1/2013 13:27'!
scrollValueChanged: aValue

	self model scrollValue: aValue step! !

!MorphicTextAdapter methodsFor: '*NodeNavigation' stamp: 'GiselaDecuzzi 11/7/2013 14:18'!
isWorkspace
	^false! !

!MorphicTextAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 1/10/2014 12:16'!
hasUnacceptedEdits: aBoolean

	self model hasUnacceptedEdits: aBoolean! !

!MorphicTextInputFieldAdapter commentStamp: '<historical>'!
I am the adapter used to bridge a TextInputFieldModel and a PluggableTextFieldMorph!
!MorphicTextInputFieldAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 22:07'!
ghostText: aText

	^ self model ghostText: aText! !

!MorphicTextInputFieldAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 22:06'!
entryCompletion

	^ self model entryCompletion! !

!MorphicTextInputFieldAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 12/4/2013 14:39'!
encrypted: aBoolean

	self widgetDo: [ :w | 
		w encrypted: aBoolean.
		w changed ]! !

!MorphicTextInputFieldAdapter methodsFor: 'NOCompletion' stamp: 'BenjaminVanRyseghem 9/28/2013 22:07'!
isCodeCompletionAllowed
	
	^ false! !

!MorphicTextInputFieldAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 22:05'!
accept: aText

	self model accept: aText! !

!MorphicTextInputFieldAdapter methodsFor: 'factory' stamp: 'StephaneDucasse 8/31/2014 09:32'!
buildWidget
	| plu |
	plu := PluggableTextFieldMorph new
		convertTo: String;
		on: self
			text: #getText
			accept: #accept:
			readSelection: nil
			menu: nil.
	plu
		entryCompletion: self entryCompletion;
		autoAccept: self autoAccept;
		ghostText: self ghostText;
		enabled: self enabled;
		encrypted: self encrypted;
		setBalloonText: self help;
		dragEnabled: self dragEnabled;
		dropEnabled: self dropEnabled;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		acceptOnCR: self acceptOnCR;
		hideScrollBarsIndefinitely.
	^ plu! !

!MorphicTextInputFieldAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 22:07'!
acceptOnCR

	^ self model acceptOnCR! !

!MorphicTextInputFieldAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 22:06'!
ghostText

	^ self model ghostText! !

!MorphicTextInputFieldAdapter methodsFor: 'initialization' stamp: 'EstebanLorenzano 5/1/2014 11:34'!
adapt: aModel
	
	super adapt: aModel.
	aModel whenBuiltDo: [ :w | w widget color: Smalltalk ui theme backgroundColor ]! !

!MorphicTextInputFieldAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 22:07'!
encrypted

	^ self model encrypted! !

!MorphicTickingWindowAdapter commentStamp: 'StephaneDucasse 3/7/2014 10:55'!
I am the adapter used to bridge a TickingWindowModel and a TickingSpecWindow!
!MorphicTickingWindowAdapter methodsFor: 'stepping' stamp: 'DamienCassou 4/4/2014 14:54'!
step
	self model step! !

!MorphicTickingWindowAdapter methodsFor: 'factory' stamp: 'StephaneDucasse 8/31/2014 09:33'!
buildWidget
	^ TickingSpecWindow new
			model: self;
			isResizeable: self isResizeable;
			yourself! !

!MorphicTransform commentStamp: '<historical>'!
This class implements simple translation, scaling and rotation for points, as well as inverse transformations.  These transformations are used in TransformMorphs (clipping scrollers) and TransformationMorphs (general flex-morph wrappers) to map, eg, global mouse coords into local coords, and to invert, eg, local damage rectangles into global damage rectangles.!
!MorphicTransform methodsFor: 'accessing' stamp: 'SeanDeNigris 2/20/2015 23:01'!
withScale: aNumberOrPoint
	^ self copy setScale: aNumberOrPoint! !

!MorphicTransform methodsFor: 'accessing' stamp: ''!
offset
	^ offset
! !

!MorphicTransform methodsFor: 'transforming points' stamp: 'ar 11/2/1998 16:32'!
localPointToGlobal: aPoint
	"Transform aPoint from global coordinates into local coordinates"
	^self invert: aPoint! !

!MorphicTransform methodsFor: 'transformations' stamp: 'di 3/4/98 19:10'!
composedWith: aTransform
	"Return a new transform that has the effect of transforming points first by the receiver and then by the argument."

	self isIdentity ifTrue: [^ aTransform].
	aTransform isIdentity ifTrue: [^ self].
	^ CompositeTransform new globalTransform: self
							localTransform: aTransform! !

!MorphicTransform methodsFor: 'testing' stamp: 'ar 11/2/1998 20:57'!
isPureTranslation
	"Return true if the receiver specifies no rotation or scaling."

	^ angle = 0.0 and: [scale = 1.0]
! !

!MorphicTransform methodsFor: 'composing' stamp: 'nk 3/9/2001 13:55'!
composedWithLocal: aTransform
	aTransform isIdentity ifTrue:[^self].
	self isIdentity ifTrue:[^aTransform].
	aTransform isMorphicTransform ifFalse:[^super composedWithLocal: aTransform].
	self isPureTranslation ifTrue:[
		^aTransform withOffset: aTransform offset + self offset].
	aTransform isPureTranslation ifTrue:[
		^self withOffset: (self localPointToGlobal: aTransform offset negated) negated].
	^super composedWithLocal: aTransform.! !

!MorphicTransform methodsFor: 'accessing' stamp: ''!
scale
	^ scale! !

!MorphicTransform methodsFor: 'private' stamp: 'lr 7/4/2009 10:42'!
setOffset: aPoint 
	offset := aPoint! !

!MorphicTransform methodsFor: 'accessing' stamp: 'SeanDeNigris 2/20/2015 23:15'!
withAngle: radians
	^ self copy setAngle: radians! !

!MorphicTransform methodsFor: 'printing' stamp: 'ar 5/19/1999 18:21'!
printOn: aStream
	super printOn: aStream.
	aStream nextPut:$(;
		nextPutAll:'angle = '; print: angle;
		nextPutAll:'; scale = '; print: scale;
		nextPutAll:'; offset = '; print: offset;
		nextPut:$).! !

!MorphicTransform methodsFor: 'transformations' stamp: 'lr 7/4/2009 10:42'!
transform: aPoint 
	"Transform the given point from global to local coordinates."
	| p2 p3 |
	self isPureTranslation ifTrue: [ ^ aPoint + offset ].
	p2 := aPoint + offset.
	p3 := (p2 x * angle cos - (p2 y * angle sin)) @ (p2 y * angle cos + (p2 x * angle sin)) / scale.
	^ p3! !

!MorphicTransform methodsFor: 'accessing' stamp: 'ar 11/9/1998 14:33'!
inverseTransformation
	"Return the inverse transformation of the receiver"
	^MorphicTransform
		offset: (self transform: 0@0) - (self transform: offset)
		angle: angle negated
		scale: scale reciprocal! !

!MorphicTransform methodsFor: 'transforming points' stamp: 'ar 11/2/1998 16:13'!
globalPointToLocal: aPoint
	"Transform aPoint from global coordinates into local coordinates"
	^self transform: aPoint! !

!MorphicTransform methodsFor: 'transformations' stamp: 'di 10/2/1998 08:54'!
invertRect: aRectangle

	self error: 'method name changed to emphasize enclosing bounds'.
	^ self invertBoundsRect: aRectangle! !

!MorphicTransform methodsFor: 'private' stamp: 'SeanDeNigris 2/20/2015 23:15'!
setOffset: aPoint angle: radians scale: aNumberOrPoint
	offset := aPoint.
	angle := radians.
	scale := aNumberOrPoint! !

!MorphicTransform methodsFor: 'testing' stamp: 'ar 11/2/1998 20:57'!
isIdentity
	"Return true if the receiver is the identity transform; that is, if applying to a point returns the point itself."

	^ self isPureTranslation and: [offset = (0@0)]
! !

!MorphicTransform methodsFor: 'accessing' stamp: ''!
angle
	^ angle! !

!MorphicTransform methodsFor: 'accessing' stamp: 'SeanDeNigris 2/20/2015 23:01'!
withOffset: aPoint
	^ self copy setOffset: aPoint! !

!MorphicTransform methodsFor: 'private' stamp: 'SeanDeNigris 2/20/2015 22:53'!
setScale: aNumberOrPoint 
	scale := aNumberOrPoint! !

!MorphicTransform methodsFor: 'transformations' stamp: 'lr 7/4/2009 10:42'!
invert: aPoint 
	"Transform the given point from local to global coordinates."
	| p3 p2 |
	self isPureTranslation ifTrue: [ ^ aPoint - offset ].
	p3 := aPoint * scale.
	p2 := (p3 x * angle cos + (p3 y * angle sin)) @ (p3 y * angle cos - (p3 x * angle sin)).
	^ p2 - offset! !

!MorphicTransform methodsFor: 'testing' stamp: 'ar 11/2/1998 19:51'!
isMorphicTransform
	^true! !

!MorphicTransform methodsFor: 'initialize' stamp: 'lr 7/4/2009 10:42'!
setIdentiy
	scale := 1.0.
	offset := 0 @ 0.
	angle := 0.0! !

!MorphicTransform methodsFor: 'converting' stamp: 'di 10/26/1999 17:03'!
asMorphicTransform

	^ self! !

!MorphicTransform methodsFor: 'transformations' stamp: 'lr 7/4/2009 10:42'!
invertBoundsRect: aRectangle 
	"Return a rectangle whose coordinates have been transformed
	from local back to global coordinates.  NOTE: if the transformation
	is not just a translation, then it will compute the bounding box
	in global coordinates."
	| outerRect |
	self isPureTranslation 
		ifTrue: 
			[ ^ (self invert: aRectangle topLeft) corner: (self invert: aRectangle bottomRight) ]
		ifFalse: 
			[ outerRect := Rectangle encompassing: (aRectangle innerCorners collect: [ :p | self invert: p ]).
			"Following asymmetry due to likely subsequent truncation"
			^ outerRect topLeft - (1 @ 1) corner: outerRect bottomRight + (2 @ 2) ]! !

!MorphicTransform methodsFor: 'private' stamp: 'SeanDeNigris 2/20/2015 23:15'!
setAngle: radians
	angle := radians! !

!MorphicTransform methodsFor: 'transformations' stamp: 'lr 7/4/2009 10:42'!
transformBoundsRect: aRectangle 
	"Return a rectangle whose coordinates have been transformed
	from global to local coordinates.  NOTE: if the transformation
	is not just a translation, then it will compute the bounding box
	in global coordinates."
	| outerRect |
	self isPureTranslation 
		ifTrue: 
			[ ^ (self transform: aRectangle topLeft) corner: (self transform: aRectangle bottomRight) ]
		ifFalse: 
			[ outerRect := Rectangle encompassing: (aRectangle innerCorners collect: [ :p | self transform: p ]).
			"Following asymmetry due to likely subsequent truncation"
			^ outerRect topLeft - (1 @ 1) corner: outerRect bottomRight + (2 @ 2) ]! !

!MorphicTransform methodsFor: 'converting' stamp: 'ar 11/2/1998 20:14'!
asMatrixTransform2x3
	^((MatrixTransform2x3 withRotation: angle radiansToDegrees negated) composedWithLocal:
		(MatrixTransform2x3 withScale: scale))
			offset: offset negated! !

!MorphicTransform class methodsFor: 'instance creation' stamp: ''!
identity

	^ self offset: 0@0 angle: 0.0 scale: 1.0! !

!MorphicTransform class methodsFor: 'instance creation' stamp: ''!
new

	^ self offset: 0@0
! !

!MorphicTransform class methodsFor: 'instance creation' stamp: 'SeanDeNigris 2/20/2015 23:15'!
offset: aPoint angle: radians scale: aNumberOrPoint

	^ self basicNew setOffset: aPoint angle: radians scale: aNumberOrPoint! !

!MorphicTransform class methodsFor: 'instance creation' stamp: ''!
offset: aPoint

	^ self offset: aPoint angle: 0.0 scale: 1.0! !

!MorphicTreeAdapter commentStamp: '<historical>'!
I am the adapter used to bridge a TreeModel and a MorphTreeMorph!
!MorphicTreeAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 22:40'!
oddRowColor

	^ self model oddRowColor! !

!MorphicTreeAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/8/2013 11:58'!
expandAll

	self treeModel expandAll! !

!MorphicTreeAdapter methodsFor: 'drag and drop - private' stamp: 'BenjaminVanRyseghem 9/28/2013 23:22'!
acceptDroppingMorph: draggedMorph event: event inMorph: source
	| item |
	
	item := self widget
		ifNil:  [ 0 ]
		ifNotNil: [:w | w scrollerSubMorphFromPoint: event position ].

	^ self acceptDropBlock valueWithEnoughArguments: { draggedMorph. event. source. item }! !

!MorphicTreeAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/21/2013 11:49'!
filterWith: aFilter
	
	self widgetDo: [ :w || nodes |
		nodes := w model rootNodes.
		nodes do: [:r | r nodeModel updateAccordingTo: aFilter].
	
		self removeRootsSuchAs: [:n | (aFilter keepTreeNode: n) not and: [n isEmpty]].

		self changed: #rootNodes ].! !

!MorphicTreeAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 22:40'!
keyStroke: aKeyStroke

	^ self model keyStroke: aKeyStroke! !

!MorphicTreeAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 22:40'!
oddRowColor: aColor

	^ self model oddRowColor: aColor! !

!MorphicTreeAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/23/2013 21:58'!
collapseAll

	self treeModel collapseAll! !

!MorphicTreeAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/2/2013 18:01'!
columns: newColumns

	self widgetDo: [ :w || columns |
		columns := newColumns collect: [ :each | each buildWithSpec ]. 
		w columns: columns.
		w resizerChanged.
		w updateList ]! !

!MorphicTreeAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/8/2013 11:59'!
rootNodeHolder

	^ self model rootNodeHolder! !

!MorphicTreeAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/23/2013 21:42'!
onMorphTreeSelectionChanged: ann
	| items |
	
	items := (ann selection
		ifNil: [ #() ]
		ifNotNil: [:selection | selection selectedNodes ]).
		
	items := items collect: [ :each | each nodeModel ].

	self model selectedItems: items! !

!MorphicTreeAdapter methodsFor: 'reflective operations' stamp: 'BenjaminVanRyseghem 9/28/2013 23:04'!
doesNotUnderstand: aMessage

	(self treeModel respondsTo: aMessage selector) 
		ifFalse: [ ^ super doesNotUnderstand: aMessage ].
		
	^ self treeModel 
		perform: aMessage selector 
		withArguments: aMessage arguments! !

!MorphicTreeAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/22/2013 15:37'!
expandRoots

	self treeModel expandRoots! !

!MorphicTreeAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/24/2013 14:59'!
selectAdd

	self widgetDo: [ :w | w selectAll ]! !

!MorphicTreeAdapter methodsFor: 'initialize' stamp: 'BernardoContreras 9/27/2014 10:35'!
initialize

	super initialize.

	treeModel := SpecTreeModel model: self.	
	treeModel announcer
		when: MorphTreeSelectionChanged
		send: #onMorphTreeSelectionChanged:
		to: self.! !

!MorphicTreeAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/28/2013 23:03'!
updateTree

	self treeModel resetRootNodes.
	self treeModel changed: #rootNodes.! !

!MorphicTreeAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 22:40'!
evenRowColor

	^ self model evenRowColor! !

!MorphicTreeAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 22:42'!
iconBlock

	^ [:each | self iconFor: each ]! !

!MorphicTreeAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 22:40'!
autoDeselection

	^ self model autoDeselection! !

!MorphicTreeAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 22:40'!
doubleClick

	^ self model doubleClick! !

!MorphicTreeAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/2/2013 19:50'!
removeRootsSuchAs: aBlock

	self widgetDo: [ :w | w model rootNodes removeAllSuchThat: [ :node | aBlock value: node nodeModel ] ]! !

!MorphicTreeAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 3/4/2014 17:25:06'!
menu: aMenu shifted: aBoolean

	^ (self model menu: aMenu shifted: aBoolean) 
		ifNotNil: [ :menuModel | menuModel buildWithSpecAsPopup ]! !

!MorphicTreeAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 22:40'!
columnInset

	^ self model columnInset! !

!MorphicTreeAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 22:40'!
resizerWidth

	^ self model resizerWidth! !

!MorphicTreeAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 9/28/2013 22:59'!
setRoots: aCollection

	treeModel rootItems: aCollection! !

!MorphicTreeAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/21/2013 15:21'!
isCheckList: aBoolean

	self widgetDo: [ :w | w isCheckList: aBoolean ]! !

!MorphicTreeAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 22:40'!
rowInset

	^ self model rowInset! !

!MorphicTreeAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 23:16'!
roots

	^ self model roots! !

!MorphicTreeAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 23:26'!
childrenFor: aNode

	^ self model childrenFor: aNode! !

!MorphicTreeAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 22:40'!
autoMultiSelection

	^ self model autoMultiSelection! !

!MorphicTreeAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/28/2013 22:52'!
treeModel
	^ treeModel! !

!MorphicTreeAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/8/2013 11:58'!
columns

	^ self model columns collect: [ :each | each buildWithSpec ]! !

!MorphicTreeAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/21/2013 15:19'!
rootNodeFromItem: item
	| node |
	
	node := item isTreeNodeModel
		ifTrue: [ item ]
		ifFalse: [ self rootNodeHolder cull: item ].
		
	node container: self model.
	^ node buildWithSpec! !

!MorphicTreeAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 22:40'!
isCheckList

	^ self model isCheckList! !

!MorphicTreeAdapter methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 9/28/2013 22:54'!
changed: aSymbol

	treeModel changed: aSymbol! !

!MorphicTreeAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 22:40'!
iconFor: aNode

	^ self model iconFor: aNode! !

!MorphicTreeAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/26/2013 18:16'!
selectOnlyLastHighlighted

	^ self model selectOnlyLastHighlighted! !

!MorphicTreeAdapter methodsFor: 'factory' stamp: 'StephaneDucasse 8/31/2014 09:35'!
buildWidget
	^ MorphTreeMorph new
		model: self treeModel;
		dragEnabled: self dragEnabled;
		dropEnabled: self dropEnabled;
		initializeColumsFrom: self;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		autoDeselection: self autoDeselection;
		resizerWidth: self resizerWidth;
		columnInset: self columnInset;
		iconBlock: self iconBlock;
		rowInset: self rowInset;
		keystrokeActionSelector: #keyStroke:;
		multiSelection: self multiSelection;
		autoMultiSelection: self autoMultiSelection;
		removeOnlyLastSelected: self selectOnlyLastHighlighted;
		isCheckList: self isCheckList;
		doubleClickSelector: #doubleClick;
		getMenuSelector: #menu:shifted:;
		buildContents;
		yourself! !

!MorphicTreeAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 22:40'!
multiSelection

	^ self model multiSelection! !

!MorphicTreeAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 23:25'!
wrapItem: anItem

	^ self model wrapItem: anItem! !

!MorphicTreeAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/28/2013 22:40'!
preferedPaneColor

	^ self model preferedPaneColor! !

!MorphicTreeColumnAdapter commentStamp: '<historical>'!
I am the bridge between a TreeColumnModel and a MorphTreeColumn.

Ialso add support for on the fly refresh!
!MorphicTreeColumnAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/2/2013 17:18'!
performHeaderAction

	self headerAction cull: self model cull: self! !

!MorphicTreeColumnAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/2/2013 19:34'!
performHeaderActionSelector

	^ self headerAction
		ifNil: [ nil ]
		ifNotNil: [ #performHeaderAction ]! !

!MorphicTreeColumnAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/2/2013 17:03'!
headerLabel

	^ self model headerLabel! !

!MorphicTreeColumnAdapter methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 11/2/2013 17:45'!
update: aSymbol

	aSymbol == #displayBlockChanged ifTrue: [ ^ self displayBlockChanged ].
	aSymbol == #resizableChanged ifTrue: [ ^ self resizableChanged ].
	aSymbol == #headerLabelChanged ifTrue: [ ^ self headerLabelChanged ].
	aSymbol == #headerFontChanged ifTrue: [ ^ self headerFontChanged ].
	aSymbol == #headerIconChanged  ifTrue: [ ^ self headerIconChanged ].
	
	^ super update: aSymbol! !

!MorphicTreeColumnAdapter methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/2/2013 17:52'!
headerLabelChanged
	
	self widgetDo: [ :w | 
		w header label: self headerLabel.
		w container resizerChanged ]! !

!MorphicTreeColumnAdapter methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/2/2013 17:52'!
headerFontChanged
	
	self widgetDo: [ :w | 
		w header label: self headerLabel font: self headerFont.
		w container resizerChanged ]! !

!MorphicTreeColumnAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/2/2013 16:54'!
resizable

	^ self model resizable! !

!MorphicTreeColumnAdapter methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/8/2013 20:18'!
headerIconChanged
	
	self widgetDo: [ :w | 
		self headerIcon
			ifNil: [ w header removeIcon ]
			ifNotNil: [ w header icon: (ImageMorph new form: self headerIcon) ] ]! !

!MorphicTreeColumnAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/2/2013 16:54'!
argumentBlock

	^ [ Array with: self model ]! !

!MorphicTreeColumnAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/2/2013 16:57'!
headerIcon

	^ self model headerIcon! !

!MorphicTreeColumnAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/2/2013 16:57'!
headerFont

	^ self model headerFont! !

!MorphicTreeColumnAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/2/2013 16:57'!
headerAction

	^ self model headerAction! !

!MorphicTreeColumnAdapter methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/2/2013 18:18'!
displayBlockChanged

	self widgetDo: [ :w | 
		w rowMorphGetSelector: self displayBlock.
		w container updateList ]! !

!MorphicTreeColumnAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/2/2013 17:23'!
displayBlock

	^ self model displayBlock! !

!MorphicTreeColumnAdapter methodsFor: 'factory' stamp: 'StephaneDucasse 8/31/2014 09:35'!
buildWidget
	^ SpecTreeColumn new
		resizable: self resizable;
		startWidth: self initialWidth;
		setHeaderButtonLabel: self headerLabel
			font: self headerFont
			icon: self headerIcon
			target: self
			actionSelector: self performHeaderActionSelector;
		rowMorphGetSelector: self displayBlock! !

!MorphicTreeColumnAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 11/2/2013 16:55'!
initialWidth

	^ self model initialWidth! !

!MorphicTreeColumnAdapter methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/2/2013 17:53'!
resizableChanged
	
	self widgetDo: [ :w | w resizable: self resizable ]! !

!MorphicTreeNodeAdapter commentStamp: '<historical>'!
I am the bridget between a TreeNodeModel and a SpecTreeNodeModel!
!MorphicTreeNodeAdapter methodsFor: 'widget API' stamp: 'StephaneDucasse 8/23/2014 20:12'!
container
	^ self model container! !

!MorphicTreeNodeAdapter methodsFor: 'widget API' stamp: 'StephaneDucasse 8/23/2014 20:12'!
hasContentToShow
	^ self model hasContentToShow! !

!MorphicTreeNodeAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/25/2013 16:29'!
takeHighlight

	self widgetDo: [ :w | w changed: #takeHighlight ]! !

!MorphicTreeNodeAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/22/2013 13:25'!
selected: aBoolean

	aBoolean 
		ifTrue: [ self select ]
		ifFalse: [ self deselect ]! !

!MorphicTreeNodeAdapter methodsFor: 'widget API' stamp: 'StephaneDucasse 8/23/2014 20:12'!
itemBlock
	^ [ self item ]! !

!MorphicTreeNodeAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/21/2013 12:23'!
updateAccordingTo: aFilter

	self widgetDo: [ :w |
		w contents do: [ :n | n nodeModel updateAccordingTo: aFilter ].
		w contents removeAllSuchThat: [ :n | (aFilter keepTreeNode: n nodeModel) not  and: [ n nodeModel isEmpty ] ] ]! !

!MorphicTreeNodeAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 11/24/2013 13:39'!
isExpanded: aBoolean

	! !

!MorphicTreeNodeAdapter methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/30/2013 21:36'!
deselect

	self widgetDo: [ :w |
		w changed: #deselect.
		w model selectionChanged.
		w dependents do: [ :e | e changed ] ]! !

!MorphicTreeNodeAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 3/4/2014 17:25:06'!
hasChildrenBlock
	^ self model hasChildren! !

!MorphicTreeNodeAdapter methodsFor: 'widget API' stamp: 'StephaneDucasse 8/23/2014 20:12'!
selected
	^ self model selected! !

!MorphicTreeNodeAdapter methodsFor: 'widget API' stamp: 'StephaneDucasse 8/23/2014 20:12'!
item
	^ self model content! !

!MorphicTreeNodeAdapter methodsFor: 'factory' stamp: 'StephaneDucasse 8/31/2014 09:36'!
buildWidget
	^ SpecTreeNodeModel new
		setItemFromBlock: self itemBlock;
		icon: self icon;
		setChildren: self childrenBlock;
		hasContents: self hasChildrenBlock;
		model: self container;
		nodeModel: self model! !

!MorphicTreeNodeAdapter methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/30/2013 21:35'!
select

	self widgetDo: [ :w |
		w changed: #select.
		w model selectionChanged.
		w dependents do: [ :e | e changed ] ]! !

!MorphicTreeNodeAdapter methodsFor: 'widget API' stamp: 'StephaneDucasse 8/23/2014 20:12'!
childrenBlock
	^ [ self model buildChildren ]! !

!MorphicTreeNodeAdapter methodsFor: 'widget API' stamp: 'StephaneDucasse 8/23/2014 20:12'!
icon
	^ self model icon! !

!MorphicUIBugTest commentStamp: 'wiz 1/3/2007 13:57'!
A MorphicUIBugTest is a class for testing the shortcomings and repairs of the MorphicUI manager.
.

Instance Variables
	cases:		<aCollection>

cases
	- a list of morphs that may need to be deleted during teardown.
	the tests are expected to fill this list it starts out empty by default.
	
	
!
!MorphicUIBugTest methodsFor: 'running' stamp: 'MarcusDenker 10/28/2014 17:19'!
tearDown
	"default. tests will add morphs to list. Teardown will delete."

	cases do: [ :each | each delete ]! !

!MorphicUIBugTest methodsFor: 'running' stamp: 'MarcusDenker 10/28/2014 17:19'!
setUp
	"default. tests will add morphs to list. Teardown will delete."

	cases := #()! !

!MorphicUIManager commentStamp: 'StephaneDucasse 6/5/2011 22:19'!
The Morphic ui manager. 

I was packaged in toolbuilder and I may change in the future. For the moment, the goal is to unload toolbuilder. !
!MorphicUIManager methodsFor: 'services' stamp: ''!
questionWithoutCancel: aStringOrText
	"Open a question dialog."

	^self questionWithoutCancel: aStringOrText title: 'Question' translated! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newWindowFor: aModel title: titleString
	"Answer a new window morph."
	
	^self theme
		newWindowIn: self
		for: aModel
		title: titleString! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newGroupbox
	"Answer a plain groupbox."

	^self theme
		newGroupboxIn: self! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newColorChooserFor: aModel getColor: getSel setColor: setSel getEnabled: enabledSel help: helpText
	"Answer a color chooser with the given selectors."

	^self theme
		newColorChooserIn: self
		for: aModel
		getColor: getSel
		setColor: setSel
		getEnabled: enabledSel
		help: helpText! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
deny: aStringOrText
	"Open a denial dialog."

	^self deny: aStringOrText title: 'Access Denied' translated! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newGroupbox: aString
	"Answer a groupbox with the given label."

	^self theme
		newGroupboxIn: self
		label: aString! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newSliderFor: aModel getValue: getSel setValue: setSel getEnabled: enabledSel help: helpText
	"Answer a slider with the given selectors."

	^self theme
		newSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: 0
		max: 1
		quantum: nil
		getEnabled: enabledSel
		help: helpText! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
fileOpen: title extensions: exts path: path
	"Answer the result of a file open dialog with the given title, extensions to show and path."

	^self 
		fileOpen: title
		extensions: exts
		path: path
		preview: nil! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newButtonFor: aModel getState: stateSel action: actionSel arguments: args getEnabled: enabledSel labelForm: aForm help: helpText
	"Answer a new button."

	^self theme
		newButtonIn: self for: aModel
		getState: stateSel
		action: actionSel
		arguments: args
		getEnabled: enabledSel 
		label: (AlphaImageMorph new image: aForm)
		help: helpText! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newPanel
	"Answer a new panel."

	^self theme
		newPanelIn: self! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'SeanDeNigris 6/20/2012 23:31'!
informUserDuring: aBlock
	"Display a message as progress	during execution of the given block."
	"UIManager default informUserDuring: [:bar|
		#('one' 'two' 'three') do: [:info|
			bar label: info.
			1 to: 100 do: [:v |
				bar current: v.
				(Delay forMilliseconds: 20) wait]]]"
	
	self
		displayProgress: ''
		from: 1 to: 100
		during: [:bar | aBlock value: bar]! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'MarcusDenker 10/8/2014 15:09'!
openComparisonFrom: targetMethodSource
					to: originalMethodSource
					belongingTo: aClass
					from: aChange 
					labeled: aLabel 
					inWindowLabeled: aWindowLabel 
	| diffBuilder difference  |
	PSMCPatchMorph usedByDefault 
		ifTrue: [ ^ self openPolymorphComparisonFrom: originalMethodSource 
					to: targetMethodSource
					belongingTo: aClass
					from: aChange
					labeled: aLabel
					inWindowLabeled: aWindowLabel   ].
	diffBuilder :=  TextDiffBuilder
			from: originalMethodSource 
			to: targetMethodSource.
	difference := diffBuilder buildDisplayPatch.
	self edit: difference label: aLabel.
				! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newListFor: aModel list: listSelector selected: getSelector changeSelected: setSelector help: helpText
	"Answer a list for the given model."

	^self
		newListFor: aModel
		list: listSelector
		selected: getSelector
		changeSelected: setSelector
		getEnabled: nil
		help: helpText! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
centeredAlert: aStringOrText title: aString configure: aBlock
	"Open an alert dialog.
	Configure the dialog with the 1 argument block
	before opening modally."

	^self theme
		centeredAlertIn: self
		text: aStringOrText
		title: aString
		configure: aBlock! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newMenuFor: aModel
	"Answer a new menu."

	^self theme
		newMenuIn: self
		for: aModel! !

!MorphicUIManager methodsFor: 'private' stamp: 'CamilloBruni 9/14/2013 00:00'!
activate
	activeTranscript 
		ifNil: [ ThreadSafeTranscript install ]
		ifNotNil: [ Transcript := activeTranscript ].
	SystemProgressMorph enable.! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'MarcusDenker 12/2/2011 16:44'!
lowSpaceWatcherDefaultAction: preemptedProcess

	self interruptName: 'Space is low' preemptedProcess: preemptedProcess! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newRadioButtonFor: aModel getSelected: getSel setSelected: setSel getEnabled: enabledSel label: stringOrText help: helpText
	"Answer a checkbox (radio button appearance) with the given label."

	^self theme
		newRadioButtonIn: self
		for: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		label: stringOrText
		help: helpText! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newAlphaImage: aForm help: helpText
	"Answer an alpha image morph."

	^self theme
		newAlphaImageIn: self
		image: aForm
		help: helpText! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'StephaneDucasse 7/17/2010 13:11'!
chooseFrom: aList lines: linesArray title: aString
	"Choose an item from the given list. Answer the index of the selected item."
	
	^(self
		chooseFrom: aList
		values: nil
		lines: linesArray
		title: aString) ifNil: [0]! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newStack: controls
	"Answer a morph laid out with a stack of controls."

	^self theme
		newStackIn: self
		for: controls! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
chooseFont
	"Answer the result of a font selector dialog."

	^self chooseFont: nil! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel menu: menuSelector
	"Answer a text editor for the given model."

	^self theme
		newTextEditorIn: self
		for: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel
		menu: menuSelector! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newBasicTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel
	"Answer a text editor for the given model."

	^self
		newBasicTextEditorFor: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel
		menu: nil! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
chooseDirectory: title path: path
	"Answer the result of a file dialog with the given title, answer a directory."

	^self theme
		chooseDirectoryIn: self
		title: title
		path: path! !

!MorphicUIManager methodsFor: 'accessing' stamp: 'pavel.krivanek 11/21/2008 17:30'!
interactiveParser
	"Answer the value of interactiveParser"

	^ interactiveParser! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel font: aFont help: helpText
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel
		font: aFont
		help: helpText! !

!MorphicUIManager methodsFor: 'events' stamp: 'Pavel.Krivanek 10/28/2008 11:22'!
onEventSensorStartup: anEventSensor

	anEventSensor flushAllButDandDEvents! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newCheckboxFor: aModel getSelected: getSel setSelected: setSel label: stringOrText help: helpText
	"Answer a checkbox with the given label."

	^self theme
		newCheckboxIn: self
		for: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: nil
		label: stringOrText
		help: helpText! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newButtonFor: aModel getState: stateSel action: actionSel arguments: args getEnabled: enabledSel label: stringOrText help: helpText
	"Answer a new button."

	^self theme
		newButtonIn: self for: aModel
		getState: stateSel
		action: actionSel
		arguments: args
		getEnabled: enabledSel 
		label: stringOrText
		help: helpText! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newPluggableDialogWindow: title for: contentMorph
	"Answer a new pluggable dialog with the given content."

	^self theme
		newPluggableDialogWindowIn: self
		title: title
		for: contentMorph! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'GaryChambers 12/6/2011 10:17'!
request: aStringOrText initialAnswer: defaultAnswer title: aTitle
	"Create an instance of me whose question is queryString with the given 
	initial answer. Answer the string the user accepts.
	The title serves for the window that is opened
	Answer the empty string if the user cancels.
	Allow for interception with a ProvideAnswerNotification handler."
	
	|modalMorph|
	(ProvideAnswerNotification signal: aStringOrText) ifNotNil: [:answer |
		^answer == #default ifTrue: [defaultAnswer] ifFalse: [answer]].
	modalMorph := self modalMorph.
	^(modalMorph theme 
		textEntryIn: modalMorph
		text: aStringOrText
		title: aTitle
		entryText: defaultAnswer)! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newGroupbox: aString for: control
	"Answer a groupbox with the given label and control."

	^self theme
		newGroupboxIn: self
		label: aString
		for: control! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel help: helpText entryCompletion: anEntryCompletion
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel
		help: helpText
		entryCompletion: anEntryCompletion! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel 
		help: helpText! !

!MorphicUIManager methodsFor: 'ui process' stamp: 'MarcusDenker 12/2/2011 16:31'!
terminateUIProcess
	UIProcess suspend; terminate.
	UIProcess := nil "?"! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newEditableDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel addToList: addSel class: aClass default: defaultValue ghostText: ghostText getEnabled: enabledSel useIndex: useIndex help: helpText
	"Answer an editable drop list for the given model."

	^self theme
		newEditableDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		addToList: addSel
		class: aClass
		default: defaultValue
		ghostText: ghostText
		getEnabled: enabledSel
		useIndex: useIndex
		help: helpText! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newMorphDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel help: helpText
	"Answer a morph drop list for the given model."

	^self 
		newMorphDropListFor: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: nil
		useIndex: true
		help: helpText! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newCheckboxFor: aModel getSelected: getSel setSelected: setSel getEnabled: enabledSel getLabel: labelSel help: helpText
	"Answer a checkbox with the given label."

	^self theme
		newCheckboxIn: self
		for: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		getLabel: labelSel
		help: helpText! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newMorphDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel getEnabled: enabledSel help: helpText
	"Answer a morph drop list for the given model."

	^self 
		newMorphDropListFor: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		useIndex: true
		help: helpText! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel getEnabled: enabledSel useIndex: useIndex help: helpText
	"Answer a drop list for the given model."

	^self theme
		newDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		useIndex: useIndex
		help: helpText! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
chooseFont: aFont 
	"Answer the result of a font selector dialog with the given initial font."

	^self theme
		chooseFontIn: self
		title: 'Font Selector' translated
		font: aFont! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newVerticalSeparator
	"Answer a vertical separator."

	^self theme
		newVerticalSeparatorIn: self! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
proceed: aStringOrText
	"Open a proceed dialog."

	^self proceed: aStringOrText title: 'Proceed' translated! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'GaryChambers 12/6/2011 10:14'!
chooseFullFileNameMatching: patterns label: label
	"Let the user choose a file matching the given patterns"
	
	|modalMorph|
	modalMorph := self modalMorph.
	^modalMorph theme  
		chooseFullFileNameIn: modalMorph
		title: (label ifNil: ['Choose File' translated])
		patterns: patterns
		path: nil
		preview: false! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
deny: aStringOrText title: aString
	"Open a denial dialog."

	^self theme
		denyIn: self
		text: aStringOrText
		title: aString! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newHSVASelector: aColor help: helpText
	"Answer a hue-saturation-volume selector with the given color."

	^self theme
		newHSVASelectorIn: self
		color: aColor
		help: helpText! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newButtonLabelFor: aModel label: aString getEnabled: enabledSel
	"Answer a new button text label."

	^self theme
		newButtonLabelIn: self
		for: aModel
		label: aString
		getEnabled: enabledSel! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
alert: aStringOrText title: aString configure: aBlock
	"Open an alert dialog.
	Configure the dialog with the 1 argument block
	before opening modally."

	^self theme
		alertIn: self
		text: aStringOrText
		title: aString
		configure: aBlock! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newCancelButton
	"Answer a new cancel button."

	^self newCancelButtonFor: self! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'AlainPlantec 11/26/2010 10:19'!
request: aStringOrText initialAnswer: defaultAnswer entryCompletion: anEntryCompletion
	^ self request: aStringOrText initialAnswer: defaultAnswer title: 'Information Required' translated entryCompletion: anEntryCompletion
! !

!MorphicUIManager methodsFor: 'global state' stamp: 'FernandoOlivero 5/1/2011 11:40'!
world
	^ ActiveWorld ! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newString: aStringOrText style: aStyle
	"Answer a new embossed string."

	^self theme
		newStringIn: self
		label: aStringOrText
		font: self theme labelFont
		style: aStyle! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newHueSelector: aModel getHue: getSel setHue: setSel help: helpText
	"Answer a hue selector with the given selectors."

	^self theme
		newHueSelectorIn: self
		for: aModel
		getHue: getSel
		setHue: setSel
		help: helpText! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'BenComan 1/29/2015 23:46'!
openDebuggerOn: process context: context label: title contents: contentsStringOrNil fullView: bool 
	"Open a notifier in response to an error, halt, or notify. A notifier view
	just shows a short view of the sender stack and provides a menu that
	lets the user open a full debugger."
	| errorWasInUIProcess  debugger |
	errorWasInUIProcess := self spawnNewProcessIfThisIsUI: process.
	[Smalltalk tools debugger logDebuggerStackToFile
		ifTrue: [Smalltalk
				logError: title
				inContext: context ]] on: Error do: [].
	debugger := Smalltalk tools debugger new.
	self defer: [[ 
			debugger
				process: process
				controller: nil
				context: context.
			"schedule debugger in deferred UI message to address
			redraw problems after opening a debugger e.g. from
			the testrunner."
			"self defer: ["
			bool
				ifTrue: [debugger openFullNoSuspendLabel: title]
				ifFalse: [debugger openNotifierContents: contentsStringOrNil label: title].
			debugger errorWasInUIProcess: errorWasInUIProcess.]
				on: Error
				do: [:ex | Smalltalk tools debugger primitiveError: 'Original error: ' , title asString , '.
	Smalltalk tools debugger error: '
							, ([ex description]
									on: Error
									do: ['a ' , ex class printString]) , ':']].

	process suspend.
	^ debugger! !

!MorphicUIManager methodsFor: 'services' stamp: 'FernandoOlivero 4/12/2011 09:56'!
chooseOrRequestFrom: labelList values: valueList lines: linesArray title: aString
	"Choose an item from the given list. 
	 Answer the value selected of the selected item or the new string entered."
	
	^ self theme 
		chooseOrRequestIn: self modalMorph
		title: aString
		labels: labelList
		values: valueList
		lines: linesArray! !

!MorphicUIManager methodsFor: 'services' stamp: 'GaryChambers 8/23/2010 12:13'!
confirm: queryString trueChoice: trueChoice falseChoice: falseChoice 
	"Put up a yes/no menu with caption queryString. The actual wording for the two choices will be as provided in the trueChoice and falseChoice parameters. Answer true if the response is the true-choice, false if it's the false-choice.
	This is a modal question -- the user must respond one way or the other."
	
	^self
		confirm: queryString
		trueChoice: trueChoice
		falseChoice: falseChoice
		cancelChoice: nil
		default: nil! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'MarcusDenker 4/29/2011 00:36'!
onFontsChanged

	StringMorph allSubInstancesDo: [ :s | s layoutChanged ].
	TextMorph allSubInstancesDo: [ :s | s layoutChanged ].
	SystemWindow allInstancesDo: [ :w | [ w update: #relabel ] on: Error do: [ :ex | ] ].
	World ifNotNil: [ :w | w changed ].! !

!MorphicUIManager methodsFor: 'accessing' stamp: 'FernandoOlivero 5/9/2011 13:14'!
preferredCornerStyle
	^ self theme preferredCornerStyle! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newEmbeddedMenu
	"Answer a new menu."

	^self theme
		newEmbeddedMenuIn: self
		for: self! !

!MorphicUIManager methodsFor: 'events' stamp: 'BernardoContreras 1/22/2012 16:49'!
onDebug: process context: context title: title full: bool	
	
	| topCtxt |	
	
	topCtxt := process isActiveProcess ifTrue: [thisContext] ifFalse: [process suspendedContext].
	(topCtxt hasContext: context) ifFalse: [^ self error: 'context not in process'].	
	Smalltalk tools debugger 
					openOn: process 
					context: context 
					label: title 
					contents: nil 
					fullView: bool.! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'pavel.krivanek 2/24/2007 20:14'!
fileExistsDefaultAction: anException

	^ anException fileClass fileExistsUserHandling: anException fileName! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newSliderFor: aModel getValue: getSel setValue: setSel help: helpText
	"Answer a slider with the given selectors."

	^self theme
		newSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: 0
		max: 1
		quantum: nil
		getEnabled: nil
		help: helpText! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newButtonFor: aModel getState: stateSel action: actionSel arguments: args getEnabled: enabledSel getLabel: labelSel help: helpText
	"Answer a new button."

	^self theme
		newButtonIn: self for: aModel
		getState: stateSel
		action: actionSel
		arguments: args
		getEnabled: enabledSel 
		getLabel: labelSel
		help: helpText! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'SeanDeNigris 1/23/2014 00:06'!
merge: merger informing: aString

	| mergeMorph  window |
	mergeMorph := PSMCMergeMorph forMerger: merger.
	mergeMorph
		fromDescription: 'Working copy' translated;
		toDescription: aString.
	window := mergeMorph newWindow
		title: aString;
		yourself.
	self modalMorph openModal: window.
	^ mergeMorph merged! !

!MorphicUIManager methodsFor: 'ui process' stamp: 'AlainPlantec 3/10/2015 20:17'!
defer: aValuable
	"aValuable will be executed in the next UI rendering cycle"
	WorldState defer: aValuable! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
fileOpen: title
	"Answer the result of a file open dialog with the given title."

	^self
		fileOpen: title
		extensions: nil! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel font: aFont help: helpText entryCompletion: anEntryCompletion
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel
		font: aFont
		help: helpText
		entryCompletion: anEntryCompletion
! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newTabGroup: labelsAndPages
	"Answer a tab group with the given tab labels associated with pages."

	^self theme
		newTabGroupIn: self
		for: labelsAndPages! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newNoButtonFor: aModel
	"Answer a new No button."

	^self theme
		newNoButtonIn: self
		for: aModel! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'GaryChambers 12/6/2011 10:18'!
request: aStringOrText initialAnswer: defaultAnswer title: aTitle entryCompletion: anEntryCompletion
	"Create an instance of me whose question is queryString with the given 
	initial answer. Answer the string the user accepts.
	The title serves for the window that is opened
	Answer the empty string if the user cancels.
	Allow for interception with a ProvideAnswerNotification handler."
	
	|modalMorph|
	(ProvideAnswerNotification signal: aStringOrText) ifNotNil: [:answer |
		^answer == #default ifTrue: [defaultAnswer] ifFalse: [answer]].
	modalMorph := self modalMorph.
	^(modalMorph theme 
		textEntryIn: modalMorph
		text: aStringOrText
		title: aTitle
		entryText: defaultAnswer
		entryCompletion: anEntryCompletion)! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
chooseDropList: aStringOrText list: aList
	"Open a drop list chooser dialog."

	^self
		chooseDropList: aStringOrText
		title: 'Choose' translated
		list: aList! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
textEntry: aStringOrText title: aString entryText: defaultEntryText
	"Open a text entry dialog."

	^self theme
		textEntryIn: self
		text: aStringOrText
		title: aString
		entryText: defaultEntryText! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newImage: aForm
	"Answer a new image."

	^self theme
		newImageIn: self
		form: aForm! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
alert: aStringOrText title: aString
	"Open an alert dialog."

	^self
		alert: aStringOrText
		title: aString
		configure: [:d | ]! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
alert: aStringOrText
	"Open an alert dialog."

	^self alert: aStringOrText title: 'Alert' translated! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
proceed: aStringOrText title: aString
	"Open a proceed dialog and answer true if not cancelled, false otherwise."

	^self theme
		proceedIn: self
		text: aStringOrText
		title: aString! !

!MorphicUIManager methodsFor: 'services' stamp: 'FernandoOlivero 4/12/2011 09:56'!
enterOrRequestFrom: labelList values: valueList lines: linesArray title: aString
	"Choose an item from the given list. 
	 Answer the value selected of the selected item or the new string entered."
	
	^ self theme 
		enterOrRequestIn: self modalMorph
		title: aString
		labels: labelList
		values: valueList
		lines: linesArray! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel
	"Answer a text editor for the given model."

	^self theme
		newAutoAcceptTextEditorIn: self
		for: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'MarcusDenker 10/8/2014 14:50'!
edit: aText label: labelString accept: anAction
	"Open an editor on the given string/text"
	
	| window pane |
	window := (SystemWindow labelled: labelString) model: self.
	pane := PluggableTextMorph 
					on: (ValueHolder new)
					text: #contents 
					accept: #contents:
					readSelection: nil 
					menu: #codePaneMenu:shifted:.	
	pane font: StandardFonts codeFont.
	pane acceptAction: anAction.
	pane setText: aText.
	window 
		addMorph: pane frame: (0@0 corner: 1@1);
        	openInWorld.
	^window
		! !

!MorphicUIManager methodsFor: 'private' stamp: 'CamilloBruni 9/14/2013 00:00'!
deactivate
	activeTranscript := Transcript.
	SystemProgressMorph disable.! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newTreeFor: aModel list: listSelector selected: getSelector changeSelected: setSelector
	"Answer a new tree morph."
	
	^self theme
		newTreeIn: self
		for: aModel
		list: listSelector
		selected: getSelector
		changeSelected: setSelector! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newBalloonHelp: aTextStringOrMorph for: aMorph
	"Answer a new balloon help with the given contents for aMorph
	at a given corner."

	^self theme
		newBalloonHelpIn: self
		contents: aTextStringOrMorph
		for: aMorph
		corner: #bottomLeft! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newBracketSliderFor: aModel getValue: getSel setValue: setSel min: minValue max: maxValue quantum: quantum getEnabled: enabledSel help: helpText
	"Answer a bracket slider with the given selectors."

	^self theme
		newBracketSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: minValue
		max: maxValue
		quantum: quantum
		getEnabled: enabledSel
		help: helpText! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newButtonFor: aModel action: actionSel label: stringOrText help: helpText
	"Answer a new button."

	^self
		newButtonFor: aModel
		getState: nil
		action: actionSel
		arguments: nil
		getEnabled: nil 
		label: stringOrText
		help: helpText! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel font: aFont help: helpText
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel
		font: aFont
		help: helpText
! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newNoButton
	"Answer a new No button."

	^self newNoButtonFor: self! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newHSVSelector: aColor help: helpText
	"Answer a hue-saturation-volume selector with the given color."

	^self theme
		newHSVSelectorIn: self
		color: aColor
		help: helpText! !

!MorphicUIManager methodsFor: 'ui process' stamp: 'MarcusDenker 12/2/2011 16:28'!
uiProcess
	" Answer the currently active UI process for morphic world.
	Client should check explicitly if #uiProcess answers nil or not (see other implementations)"

	^ UIProcess! !

!MorphicUIManager methodsFor: 'private' stamp: 'GaryChambers 9/20/2011 13:15'!
openModal: aSystemWindow 
	"Open the given window at an available position with modality.
	Answer the system window."
	
	^self modalMorph openModal: aSystemWindow! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newRow: controls
	"Answer a morph laid out with a row of controls."

	^self theme
		newRowIn: self
		for: controls! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newTextEditorFor: aModel getText: getSel setText: setSel
	"Answer a text editor for the given model."

	^self
		newTextEditorFor: aModel
		getText: getSel
		setText: setSel
		getEnabled: nil! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newTitle: aString for: control
	"Answer a morph laid out with a column with a title."

	^self theme
		newTitleIn: self
		label: aString
		for: control! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
question: aStringOrText title: aString
	"Open a question dialog and answer true if yes,
	false if no and nil if cancelled."

	^self theme
		questionIn: self
		text: aStringOrText
		title: aString! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newGroupboxForAll: controls
	"Answer a plain groupbox with the given controls."

	^self theme
		newGroupboxIn: self
		forAll: controls! !

!MorphicUIManager methodsFor: 'ui process' stamp: 'BernardoContreras 1/22/2012 17:00'!
interruptName: labelString preemptedProcess: theInterruptedProcess
	"Create a Notifier on the active scheduling process with the given label."
	| preemptedProcess projectProcess |
	ActiveHand ifNotNil:[ActiveHand interrupted].
	ActiveWorld := World. "reinstall active globals"
	ActiveHand := World primaryHand.
	ActiveHand interrupted. "make sure this one's interrupted too"
	ActiveEvent := nil.

	projectProcess := self uiProcess.	"we still need the accessor for a while"
	preemptedProcess := theInterruptedProcess ifNil: [Processor preemptedProcess].
	"Only debug preempted process if its priority is >= projectProcess' priority"
	preemptedProcess priority < projectProcess priority 
		ifTrue:[preemptedProcess := projectProcess].
	preemptedProcess suspend.
	Smalltalk tools debugger openInterrupt: labelString onProcess: preemptedProcess.
! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel font: aFont help: helpText entryCompletion: anEntryCompletion
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel
		font: aFont
		help: helpText
		entryCompletion: anEntryCompletion! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel 
	"Answer a text editor for the given model."

	^self 
		newTextEditorFor: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel
		menu: nil! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'GaryChambers 12/6/2011 10:16'!
confirm: aStringOrText orCancel: cancelBlock
	"Put up a question dialog (with cancel) with the text queryString.
	Answer true if the response is yes, false if no.
	Answer the value of the cancel block if cancelled.
	This is a modal question--the user must respond yes or no or cancel."
	
	|modalMorph|
	(ProvideAnswerNotification signal: aStringOrText) ifNotNil: [:answer |
		^answer == #cancel ifTrue: [cancelBlock value] ifFalse: [answer]].
	modalMorph := self modalMorph.
	^(modalMorph theme 
		questionIn: modalMorph
		text: aStringOrText
		title: 'Question' translated) ifNil: cancelBlock! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'Pavel.Krivanek 10/28/2008 10:46'!
fontFromUser: priorFont	
	
	^ StrikeFont fromUser: priorFont allowKeyboard: true! !

!MorphicUIManager methodsFor: 'accessing' stamp: 'StephaneDucasse 7/17/2010 13:15'!
modalMorph
	"Answer the morph that should be used to handle modality."
	| sender receiver foundWorld |
	sender := thisContext sender.
	foundWorld := false.
	[foundWorld or: [sender isNil]]
		whileFalse: [receiver := sender receiver.
			((sender selector = #invokeWorldMenu:)
					or: [receiver == World
							and: [sender selector == #handleEvent:
									or: [sender selector == #findWindow:]]])
				ifTrue: [foundWorld := true]
				ifFalse: [sender := sender sender]].
	foundWorld
		ifTrue: [^ receiver world
				ifNil: [World]].
	^ SystemWindow topWindow
		ifNil: [World]! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newLabelFor: aModel getLabel: labelSel getEnabled: enabledSel
	"Answer a new text label."

	^self theme
		newLabelIn: self
		for: aModel
		getLabel: labelSel
		getEnabled: enabledSel! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newTextEntryFor: aModel getText: getSel setText: setSel help: helpText
	"Answer a text entry for the given model."

	^self
		newTextEntryFor: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: nil 
		help: helpText! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
chooseDirectory: title 
	"Answer the result of a file dialog with the given title, answer a directory."

	^self
		chooseDirectory: title
		path: nil! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
chooseDropList: aStringOrText title: aString list: aList
	"Open a drop list chooser dialog."

	^self theme
		chooseDropListIn: self
		text: aStringOrText
		title: aString
		list: aList! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'pavel.krivanek 2/24/2007 15:15'!
checkForNewDisplaySize

	"Check whether the screen size has changed and if so take appropriate actions"

	Display extent = DisplayScreen actualScreenSize ifTrue: [^ Display].
	DisplayScreen startUp.
	World restoreMorphicDisplay.
! !

!MorphicUIManager methodsFor: 'services' stamp: 'GaryChambers 12/2/2011 11:59'!
chooseFullFileName: title extensions: exts path: path preview: preview
	"Answer the result of a file name chooser dialog with the given title, extensions
	to show, path and preview type."

	^self theme
		chooseFullFileNameIn: self modalMorph
		title: title
		extensions: exts
		path: path
		preview: preview! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newListFor: aModel list: listSelector selected: getSelector changeSelected: setSelector getEnabled: enabledSel help: helpText
	"Answer a list for the given model."

	^self theme
		newListIn: self
		for: aModel
		list: listSelector
		selected: getSelector
		changeSelected: setSelector
		getEnabled: enabledSel
		help: helpText! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newString: aStringOrText
	"Answer a new embossed string."

	^self theme
		newStringIn: self
		label: aStringOrText
		font: self theme labelFont
		style: #plain! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newExpander: aString forAll: controls
	"Answer an expander with the given label and controls."

	^self theme
		newExpanderIn: self
		label: aString
		forAll: controls! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
questionWithoutCancel: aStringOrText title: aString
	"Open a question dialog and answer true if yes,
	false if no and nil if cancelled."

	^self theme
		questionWithoutCancelIn: self
		text: aStringOrText
		title: aString! !

!MorphicUIManager methodsFor: 'events' stamp: 'AlainPlantec 9/12/2011 00:50'!
onPrimitiveError: aString 
	| message |
	message := String
				streamContents: [:s | 
					| context |
					s nextPutAll: '*** System error handling failed ***'.
					s cr; nextPutAll: aString.
					context := thisContext sender sender.
					20
						timesRepeat: [context == nil
								ifFalse: [s cr; print: (context := context sender)]]].
	Transcripter askForEmergencyEvaluatorOrExitWithText: message.
	"init hands and redisplay" 
	World install
! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newFuzzyLabel: aString
	"Answer a new fuzzy label."

	^self theme
		newFuzzyLabelIn: self
		for: nil
		label: aString
		offset: 1
		alpha: 0.5
		getEnabled: nil! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newRow
	"Answer a morph laid out as a row."

	^self theme
		newRowIn: self
		for: #()! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newStack
	"Answer a morph laid out as a stack."

	^self theme
		newStackIn: self
		for: #()! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newFuzzyLabelFor: aModel label: aString offset: offset alpha: alpha getEnabled: enabledSel
	"Answer a new fuzzy label."

	^self theme
		newFuzzyLabelIn: self
		for: aModel
		label: aString
		offset: offset
		alpha: alpha
		getEnabled: enabledSel! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
chooseFileName: title extensions: exts path: path preview: preview
	"Answer the result of a file name chooser dialog with the given title, extensions
	to show, path and preview type."

	^self theme
		chooseFileNameIn: self
		title: title
		extensions: exts
		path: path
		preview: preview! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 5/4/2012 19:58'!
chooseDirectory: label from: dir
	"Answer the user choice of a directory."
	
	| modalMorph realLabel |
	realLabel := label ifNil: ['Choose Directory' translated].
	(ProvideAnswerNotification signal: realLabel) ifNotNil: [:answer |
		^answer ].
	modalMorph := self modalMorph.
	^modalMorph theme  
		chooseDirectoryIn: modalMorph
		title: realLabel
		path: (dir ifNotNil: [dir fullName])! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newRadioButtonFor: aModel getSelected: getSel setSelected: setSel label: stringOrText help: helpText
	"Answer a checkbox (radio button appearance) with the given label."

	^self
		newRadioButtonFor: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: nil
		label: stringOrText
		help: helpText! !

!MorphicUIManager methodsFor: 'private' stamp: 'FernandoOlivero 3/30/2011 16:26'!
openPolymorphComparisonFrom: targetMethodSource
					to: originalMethodSource
					belongingTo: aClass
					from: aChange 
					labeled: aLabel 
					inWindowLabeled: aWindowLabel 
	| diffMorph |
	diffMorph := DiffChangeMorph
		from: targetMethodSource
		label: aChange stamp
		to: originalMethodSource
		label: (aClass compiledMethodAt: aChange methodSelector) timeStamp
		contextClass: aClass.
	diffMorph openInWindowLabeled: aWindowLabel.! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newYesButtonFor: aModel
	"Answer a new yes button."

	^self theme
		newYesButtonIn: self
		for: aModel! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
abort: aStringOrText title: aString
	"Open an error dialog."

	^self theme
		abortIn: self
		text: aStringOrText
		title: aString! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel
		help: helpText! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'GaryChambers 12/6/2011 10:14'!
chooseFrom: labelList values: valueList lines: linesArray title: aString
	"Choose an item from the given list. Answer the selected item."
	
	|modalMorph|
	modalMorph := self modalMorph.
	^modalMorph theme  
		chooseIn: modalMorph
		title: aString
		labels: labelList
		values: valueList
		lines: linesArray! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'StephaneDucasse 9/7/2011 22:33'!
request: queryString initialAnswer: defaultAnswer
	"Create an instance of me whose question is queryString with the given initial answer. Invoke it centered at the given point, and answer the string the user accepts. Answer the empty string if the user cancels."


	 ^ self 
		request: queryString 
		initialAnswer: defaultAnswer 
		title: 'Provide the following information'
! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'GaryChambers 4/24/2012 13:28'!
multiLineRequest: queryString  initialAnswer: defaultAnswer answerHeight: answerHeight
	"Create a multi-line instance of me whose question is queryString with
	the given initial answer. Answer the string the user accepts.  Answer nil if the user cancels.  An
	empty string returned means that the ussr cleared the editing area and
	then hit 'accept'.  Because multiple lines are invited, we ask that the user
	use the ENTER key, or (in morphic anyway) hit the 'accept' button, to 
	submit; that way, the return key can be typed to move to the next line."
	
	|modalMorph|
	(ProvideAnswerNotification signal: queryString) ifNotNil: [:answer |
		^answer == #default ifTrue: [defaultAnswer] ifFalse: [answer]].
	modalMorph := self modalMorph.
	^(modalMorph theme 
		textEditorIn: modalMorph
		text: queryString
		title: 'Information Required' translated
		entryText: defaultAnswer
		entryHeight: answerHeight)
			ifNotNil: [:text | text asString]! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newColorChooserFor: aModel getColor: getSel setColor: setSel help: helpText
	"Answer a color chooser with the given selectors."

	^self theme
		newColorChooserIn: self
		for: aModel
		getColor: getSel
		setColor: setSel
		getEnabled: nil
		help: helpText! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newIncrementalSliderFor: aModel getValue: getSel setValue: setSel min: min max: max quantum: quantum getEnabled: enabledSel help: helpText
	"Answer an inremental slider with the given selectors."

	^self theme
		newIncrementalSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: min
		max: max
		quantum: quantum
		getEnabled: enabledSel
		help: helpText! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newLabelGroup: labelsAndControls font: aFont labelColor: aColor
	"Answer a morph laid out with a column of labels and a column of associated controls.
	Controls having a vResizing value of #spaceFill will
	cause their row to use #spaceFill also, otherwise #shrinkWrap."

	^self theme
		newLabelGroupIn: self
		for: labelsAndControls
		font: aFont
		labelColor: aColor
! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newCloseButton
	"Answer a new close button."

	^self newCloseButtonFor: self ! !

!MorphicUIManager methodsFor: 'ui process' stamp: 'MarcusDenker 12/6/2011 12:26'!
resumeUIProcess: aProcess
	"Adopt aProcess as the project process -- probably because of proceeding from a debugger"
			
	UIProcess := aProcess.
	UIProcess resume! !

!MorphicUIManager methodsFor: 'services' stamp: 'FernandoOlivero 4/12/2011 09:57'!
confirm: queryString trueChoice: trueChoice falseChoice: falseChoice cancelChoice: cancelChoice default: defaultOption
	"Put up a yes/no/cancel menu with caption queryString. The actual wording for the choices will be as provided in the trueChoice, falseChoice and cancelChoice parameters.
	defaultOption should be one of true, false or nil to set the default button.
	Answer true if the response is the true-choice, false if it's the false-choice, nil if the cancelChoice.
	This is a modal question -- the user must respond."
	
	(ProvideAnswerNotification signal: queryString) ifNotNil: [:answer |
		^answer].
	^ self theme  
		customQuestionIn: self modalMorph
		text: queryString
		yesText: trueChoice
		noText: falseChoice
		cancelText: cancelChoice
		default: defaultOption
		title: 'Question' translated! !

!MorphicUIManager methodsFor: 'services' stamp: 'StephaneDucasse 7/17/2010 13:10'!
chooseFrom: aList lines: linesArray message: messageString title: aString
	"Choose an item from the given list. Answer the selected item."
	
	^(self
		chooseFrom: aList
		values: nil
		lines: linesArray
		message: messageString
		title: aString) ifNil: [0]! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newPluggableDialogWindow: title
	"Answer a new pluggable dialog with the given content."

	^self
		newPluggableDialogWindow: title
		for: nil! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newSVSelector: aColor help: helpText
	"Answer a saturation-volume selector with the given color."

	^self theme
		newSVSelectorIn: self
		color: aColor
		help: helpText! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newMenu
	"Answer a new menu."

	^self theme
		newMenuIn: self
		for: self! !

!MorphicUIManager methodsFor: 'services' stamp: 'StephaneDucasse 7/17/2010 13:12'!
chooseOrRequestFrom: aList lines: linesArray title: aString
	"Choose an item from the given list. 
	 Answer the value selected of the selected item or the new string entered."
	
	^self
		chooseOrRequestFrom: aList
		values: aList
		lines: linesArray
		title: aString! !

!MorphicUIManager methodsFor: 'accessing' stamp: 'pavel.krivanek 11/21/2008 17:30'!
interactiveParser: anObject
	"Set the value of interactiveParser"

	interactiveParser := anObject! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newBasicTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel menu: menuSelector
	"Answer a text editor for the given model."

	^self theme
		newBasicTextEditorIn: self
		for: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel
		menu: menuSelector! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newMorphDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel getEnabled: enabledSel useIndex: useIndex help: helpText
	"Answer a morph drop list for the given model."

	^self theme
		newMorphDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		useIndex: useIndex
		help: helpText! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'GaryChambers 12/6/2011 10:18'!
requestPassword: aStringOrText 
	"Request for a password.
	Allow for interception with a ProvideAnswerNotification handler.
	Answer nil if the user cancels."
	
	|modalMorph|
	(ProvideAnswerNotification signal: aStringOrText) ifNotNil: [:answer |
		^answer == #default ifTrue: [''] ifFalse: [answer]].
	modalMorph := self modalMorph.
	^modalMorph theme 
		passwordEntryIn: modalMorph
		text: aStringOrText
		title: 'Password Required' translated
		entryText: ''! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newButtonFor: aModel action: actionSel getEnabled: enabledSel label: stringOrText help: helpText
	"Answer a new button."

	^self
		newButtonFor: aModel
		getState: nil
		action: actionSel
		arguments: nil
		getEnabled: enabledSel 
		label: stringOrText
		help: helpText! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newBalloonHelp: aTextStringOrMorph for: aMorph corner: cornerSymbol
	"Answer a new balloon help with the given contents for aMorph
	at a given corner."

	^self theme
		newBalloonHelpIn: self
		contents: aTextStringOrMorph
		for: aMorph
		corner: cornerSymbol! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newAlphaSelector: aModel getAlpha: getSel setAlpha: setSel help: helpText
	"Answer an alpha channel selector with the given selectors."

	^self theme
		newAlphaSelectorIn: self
		for: aModel
		getAlpha: getSel
		setAlpha: setSel
		help: helpText! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
message: aStringOrText
	"Open a message dialog."

	^self message: aStringOrText title: 'Information' translated! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
longMessage: aStringOrText title: aString
	"Open a (long) message dialog."

	^self theme
		longMessageIn: self
		text: aStringOrText
		title: aString! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newCheckboxFor: aModel getSelected: getSel setSelected: setSel getEnabled: enabledSel label: stringOrText help: helpText
	"Answer a checkbox with the given label."

	^self theme
		newCheckboxIn: self
		for: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		label: stringOrText
		help: helpText! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newDialogPanel
	"Answer a new main dialog panel."

	^self theme
		newDialogPanelIn: self! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
chooseColor: aColor title: title
	"Answer the result of a color selector dialog with the given title and initial colour."

	^self theme
		chooseColorIn: self
		title: title
		color: aColor! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newCancelButtonFor: aModel
	"Answer a new cancel button."

	^self theme
		newCancelButtonIn: self
		for: aModel! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newOKButton
	"Answer a new OK button."

	^self newOKButtonFor: self! !

!MorphicUIManager methodsFor: 'events' stamp: 'CamilloBruni 2/13/2012 23:22'!
onSnapshot: resuming
	"The resuming argument is true when image boots from disk,
	and false, if user just did an image snapshot."
	
	"if we resuming, check if we're still interactive "
	
	resuming ifTrue: [
		Smalltalk isInteractive ifFalse: [
			^ self nonInteractiveManager onSnapshot: resuming ].
		Smalltalk isHeadless ifTrue: [
			^ self headlessManager onSnapshot: resuming ]].

	SystemWindow wakeUpTopWindowUponStartup! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newFuzzyLabelFor: aModel label: aString getEnabled: enabledSel
	"Answer a new fuzzy label."

	^self theme
		newFuzzyLabelIn: self
		for: aModel
		label: aString
		offset: 1
		alpha: 0.5
		getEnabled: enabledSel! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newYesButton
	"Answer a new Yes button."

	^self newYesButtonFor: self! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
chooseColor
	"Answer the result of a color selector dialog ."

	^self chooseColor: Color black! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newListFor: aModel list: listSelector selected: getSelector changeSelected: setSelector icon: iconSelector getEnabled: enabledSel help: helpText
	"Answer a list for the given model."

	^self theme
		newListIn: self
		for: aModel
		list: listSelector
		selected: getSelector
		changeSelected: setSelector
		icon: iconSelector
		getEnabled: enabledSel
		help: helpText! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'SeanDeNigris 7/26/2011 14:27'!
confirm: aStringOrText
	"Put up a question dialog (without cancel).
	Answer true if the response is yes, false if no.
	This is a modal question--the user must respond yes or no."
	
	^ self confirm: aStringOrText label: 'Question' translated.! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newString: aStringOrText font: aFont style: aStyle
	"Answer a new embossed string."

	^self theme
		newStringIn: self
		label: aStringOrText
		font: aFont
		style: aStyle! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel 
		help: helpText! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newToolbar
	"Answer a toolbar."

	^self theme
		newToolbarIn: self! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel help: helpText
	"Answer a drop list for the given model."

	^self
		newDropListFor: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: nil
		useIndex: true
		help: helpText! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'CamilleTeruel 7/25/2014 18:32'!
warningDefaultAction: anException

"The user should be notified of the occurrence of an exceptional occurrence and given an option of continuing or aborting the computation. The description of the occurrence should include any text specified as the argument of the #signal: message."
	Smalltalk tools debugger
					openContext: anException signalerContext
					label: 'Warning'
					contents: anException messageText, '\\Select Proceed to continue, or close this window to cancel the operation.' withCRs.
	anException resume.! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'pavel.krivanek 2/24/2007 15:12'!
fileDoesNotExistsDefaultAction: anException

	^anException readOnly
		ifTrue: [StandardFileStream readOnlyFileDoesNotExistUserHandling: anException fileName]
		ifFalse: [StandardFileStream fileDoesNotExistUserHandling: anException fileName]
! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newCloseButtonFor: aModel
	"Answer a new close button."

	^self theme
		newCloseButtonIn: self
		for: aModel! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 10/7/2012 22:40'!
inform: aStringOrText
	"Display a message for the user to read and then dismiss."
	
	(ProvideAnswerNotification signal: aStringOrText) ifNotNil: [:answer |
		^true].
	GrowlMorph 
		openWithLabel: 'Information' translated 
		contents: aStringOrText! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'StephaneDucasse 2/25/2011 17:53'!
newMenuIn: aThemedMorph for: aModel
	"Answer a new menu."
	"UIManager default"
	^self theme 
		newMenuIn: aThemedMorph for: aModel! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
fileSave: title path: path
	"Answer the result of a file save open dialog with the given title."

	^self
		fileSave: title
		extensions: nil
		path: path! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
chooseColor: aColor 
	"Answer the result of a color selector dialog with the given color."

	^self theme
		chooseColorIn: self
		title: 'Colour Selector' translated
		color: aColor! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newScrollPaneFor: aMorph
	"Answer a new scroll pane morph to scroll the given morph."
	
	^self theme
		newScrollPaneIn: self
		for: aMorph! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newPluggableDialogWindow
	"Answer a new pluggable dialog."

	^self
		newPluggableDialogWindow: 'Dialog'! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newOKButtonFor: aModel
	"Answer a new OK button."

	^self
		newOKButtonFor: aModel
		getEnabled: nil! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'GaryChambers 12/6/2011 10:13'!
chooseFileMatching: patterns label: label
	"Let the user choose a file matching the given patterns"
	
	|modalMorph|
	modalMorph := self modalMorph.
	^modalMorph theme  
		chooseFileNameIn: modalMorph
		title: (label ifNil: ['Choose File' translated])
		patterns: patterns
		path: nil
		preview: false! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'pavel.krivanek 2/24/2007 13:22'!
restoreDisplay

	World fullRepaintNeeded! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newEditableDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel addToList: addSel ghostText: ghostText getEnabled: enabledSel help: helpText
	"Answer an editable drop list for the given model."

	^self theme
		newEditableDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		addToList: addSel
		class: String
		default: ''
		ghostText: ghostText
		getEnabled: enabledSel
		useIndex: false
		help: helpText! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newGroupboxFor: control
	"Answer a plain groupbox with the given control."

	^self theme
		newGroupboxIn: self
		for: control! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newOverflowRowForAll: aCollectionOfMorphs
	"Answer a new overflow row morph that provides a drop down for
	the given contents that are unable to fit the bounds."
	
	^self theme
		newOverflowRowIn: self
		forAll: aCollectionOfMorphs! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'MarcusDenker 9/29/2013 15:50'!
syntaxErrorNotificationDefaultAction: anException
	"Handle a syntax error.
	Note, if there is no #syntaxErrorDebugger registered, it will be silently ignored"
	^Smalltalk tools using: #syntaxErrorDebugger do: [:tool | 
			tool open: (tool syntaxError: anException)]! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'MarcusDenker 9/29/2013 09:05'!
unhandledErrorDefaultAction: anException

	"The current computation is terminated. The cause of the error should be logged or reported to the user. If the program is operating in an interactive debugging environment the computation should be suspended and the debugger activated."
	^Smalltalk tools debugger debugError: anException.! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
message: aStringOrText title: aString
	"Open a message dialog."

	^self theme
		messageIn: self
		text: aStringOrText
		title: aString! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newMorphListFor: aModel list: listSelector getSelected: getSelector setSelected: setSelector getEnabled: enabledSel help: helpText
	"Answer a morph list for the given model."

	^self theme
		newMorphListIn: self
		for: aModel
		list: listSelector
		getSelected: getSelector
		setSelected: setSelector
		getEnabled: enabledSel
		help: helpText! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'GaryChambers 12/6/2011 10:15'!
confirm: questionStringOrText label: labelStringOrText
	"Put up a question dialog (without cancel).
	Answer true if the response is yes, false if no.
	This is a modal question--the user must respond yes or no."
	
	|modalMorph|
	(ProvideAnswerNotification signal: questionStringOrText) ifNotNil: [:answer |
		^answer].
	modalMorph := self modalMorph.
	^modalMorph theme 
		questionWithoutCancelIn: modalMorph
		text: questionStringOrText
		title: labelStringOrText.! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newBasicTextEditorFor: aModel getText: getSel setText: setSel
	"Answer a text editor for the given model."

	^self
		newBasicTextEditorFor: aModel
		getText: getSel
		setText: setSel
		getEnabled: nil! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newImage: aForm size: aPoint
	"Answer a new image."

	^self theme
		newImageIn: self
		form: aForm
		size: aPoint! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newImageFor: aModel get: getSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newImageIn: self
		for: aModel
		get: getSel
		help: helpText! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
abort: aStringOrText
	"Open an error dialog."

	^self abort: aStringOrText title: 'Error' translated! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newColorPresenterFor: aModel getColor: getSel help: helpText
	"Answer a color presenter with the given selectors."

	^self theme
		newColorPresenterIn: self
		for: aModel
		getColor: getSel
		help: helpText! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel help: helpText entryCompletion: anEntryCompletion
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel
		help: helpText
		entryCompletion: anEntryCompletion! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newOKButtonFor: aModel getEnabled: enabledSel
	"Answer a new OK button."

	^self theme
		newOKButtonIn: self
		for: aModel
		getEnabled: enabledSel! !

!MorphicUIManager methodsFor: 'services' stamp: 'FernandoOlivero 4/12/2011 09:56'!
chooseFrom: labelList values: valueList lines: linesArray message: messageString title: aString
	"Choose an item from the given list. Answer the selected item."
	
	^ self theme
		chooseIn: self modalMorph
		title: aString
		message: messageString
		labels: labelList
		values: valueList
		lines: linesArray! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newMorphListFor: aModel list: listSelector getSelected: getSelector setSelected: setSelector help: helpText
	"Answer a morph list for the given model."

	^self
		newMorphListFor: aModel
		list: listSelector
		getSelected: getSelector
		setSelected: setSelector
		getEnabled: nil
		help: helpText! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newText: aStringOrText
	"Answer a new text."

	^self theme
		newTextIn: self
		text: aStringOrText! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel help: helpText entryCompletion: anEntryCompletion

	"Answer a text entry for the given model."

	^self theme
		newTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel 
		help: helpText
		entryCompletion: anEntryCompletion! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel getEnabled: enabledSel help: helpText
	"Answer a drop list for the given model."

	^self theme
		newDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		useIndex: true
		help: helpText! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
fileSave: title extensions: exts path: path
	"Answer the result of a file save dialog with the given title, extensions to show and path."

	^self theme
		fileSaveIn: self
		title: title
		extensions: exts
		path: path! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newLabelFor: aModel label: aString getEnabled: enabledSel
	"Answer a new text label."

	^self theme
		newLabelIn: self
		for: aModel
		label: aString
		getEnabled: enabledSel! !

!MorphicUIManager methodsFor: '*Deprecated40' stamp: 'MarcusDenker 10/7/2014 11:07'!
request: queryString initialAnswer: defaultAnswer centerAt: aPoint 	"Create an instance of me whose question is queryString with the given initial answer. Answer the string the user accepts. Answer the empty string if the user cancels."

	self 
		deprecated: 'Use #request:initialAnswer: instead'
		on: 	'7 October 2014' 
		in: 'UIManager'.

	 ^ self 
		request: queryString 
		initialAnswer: defaultAnswer 
		
! !

!MorphicUIManager methodsFor: 'settings' stamp: 'MarcusDenker 4/29/2013 15:51'!
interactiveParserFor: requestor
	"during Morphic loading the interactive parser must be disabled"

	(interactiveParser = false) ifTrue: [ ^ false ].  "can be nil"
	^super interactiveParserFor: requestor! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newLabel: aString
	"Answer a new text label."

	^self
		newLabelFor: nil
		label: aString
		getEnabled: nil! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel
		help: helpText! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newLabelGroup: labelsAndControls
	"Answer a morph laid out with a column of labels and a column of associated controls.
	Controls having a vResizing value of #spaceFill will
	cause their row to use #spaceFill also, otherwise #shrinkWrap."

	^self theme
		newLabelGroupIn: self
		for: labelsAndControls! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newMultistateButton
	"Answer a new multistate button morph.
	To be usable it needs to have fill styles assigned to various states along
	with mouse-up/down actions."
	
	^self theme
		newMultistateButtonIn: self! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
fileOpen: title extensions: exts path: path preview: preview
	"Answer the result of a file open dialog with the given title, extensions to show, path and preview type."

	^self theme
		fileOpenIn: self
		title: title
		extensions: exts
		path: path
		preview: preview! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newExpander: aString for: aControl
	"Answer an expander with the given label and control."

	^self theme
		newExpanderIn: self
		label: aString
		forAll: {aControl}! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newExpander: aString
	"Answer an expander with the given label."

	^self theme
		newExpanderIn: self
		label: aString
		forAll: #()! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newColumn: controls
	"Answer a morph laid out with a column of controls."

	^self theme
		newColumnIn: self
		for: controls! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newBracketSliderFor: aModel getValue: getSel setValue: setSel min: minValue max: maxValue quantum: quantum help: helpText
	"Answer a bracket slider with the given selectors."

	^self
		newBracketSliderFor: aModel
		getValue: getSel
		setValue: setSel
		min: minValue
		max: maxValue
		quantum: quantum 
		getEnabled: nil
		help: helpText! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newToolDockingBar
	"Answer a tool docking bar."

	^self theme
		newToolDockingBarIn: self! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
textEntry: aStringOrText title: aString
	"Open a text entry dialog."

	^self
		textEntry: aStringOrText
		title: aString
		entryText: ''! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
fileSave: title extensions: exts
	"Answer the result of a file save dialog with the given title."

	^self
		fileSave: title
		extensions: exts
		path: nil! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newSeparator
	"Answer an horizontal separator."

	^self theme
		newSeparatorIn: self! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
fileSave: title
	"Answer the result of a file save dialog with the given title."

	^self
		fileSave: title
		extensions: nil
		path: nil! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newCloseControlFor: aModel action: aValuable help: helpText
	"Answer a new cancel button."

	^self theme
		newCloseControlIn: self
		for: aModel
		action: aValuable
		help: helpText! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newSliderFor: aModel getValue: getSel setValue: setSel min: min max: max quantum: quantum getEnabled: enabledSel help: helpText
	"Answer a slider with the given selectors."

	^self theme
		newSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: min
		max: max
		quantum: quantum
		getEnabled: enabledSel
		help: helpText! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
question: aStringOrText
	"Open a question dialog."

	^self question: aStringOrText title: 'Question' translated! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'pavel.krivanek 2/24/2007 13:14'!
newDisplayDepthNoRestore: pixelSize

	"Change depths.  Check if there is enough space!!  , di"
	| area need |
	pixelSize = Display depth ifTrue: [^ Display  "no change"].
	pixelSize abs < Display depth ifFalse:
		["Make sure there is enough space"
		area := Display boundingBox area. "pixels"
		need := (area * (pixelSize abs - Display depth) // 8)  "new bytes needed"
				+ Smalltalk lowSpaceThreshold.
		(Smalltalk garbageCollectMost <= need
			and: [Smalltalk garbageCollect <= need])
			ifTrue: [self error: 'Insufficient free space']].
	Display setExtent: Display extent depth: pixelSize.

	DisplayScreen startUp! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'JuanVuletich 11/1/2010 15:17'!
currentWorld
	ActiveWorld ifNotNil: [^ActiveWorld].
	^World! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
textEntry: aStringOrText
	"Open a text entry dialog."

	^self textEntry: aStringOrText title: 'Entry' translated! !

!MorphicUIManager methodsFor: 'services' stamp: 'StephaneDucasse 7/17/2010 13:13'!
enterOrRequestFrom: aList lines: linesArray title: aString
	"Choose an item from the given list. 
	 Answer the value selected of the selected item or the new string entered."
	
	^self
		enterOrRequestFrom: aList
		values: aList
		lines: linesArray
		title: aString! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newGroupbox: aString forAll: controls
	"Answer a groupbox with the given label and controls."

	^self theme
		newGroupboxIn: self
		label: aString
		forAll: controls! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newButtonLabel: aString
	"Answer a new button text label."

	^self
		newButtonLabelFor: nil
		label: aString
		getEnabled: nil! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newToolbar: controls
	"Answer a toolbar with the given controls."

	^self theme
		newToolbarIn: self
		for: controls! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newToolSpacer
	"Answer a tool spacer."

	^self theme
		newToolSpacerIn: self! !

!MorphicUIManager methodsFor: 'services' stamp: ''!
fileOpen: title extensions: exts
	"Answer the result of a file open dialog with the given title and extensions to show."

	^self
		fileOpen: title
		extensions: exts
		path: nil! !

!MorphicUIManager methodsFor: 'ui requests' stamp: 'StephaneDucasse 1/2/2012 21:30'!
restoreDisplayAfter: aBlock

	aBlock value.
	World activeHand waitButton.
	World fullRepaintNeeded.! !

!MorphicUIManager methodsFor: 'controls' stamp: ''!
newToolbarHandle
	"Answer a toolbar handle."

	^self theme
		newToolbarHandleIn: self! !

!MorphicUIManager methodsFor: 'ui process' stamp: 'CamilloBruni 8/21/2013 19:17'!
spawnNewProcess

	UIProcess := [
		[World doOneCycle.  Processor yield.  false] whileFalse: [].
	] newProcess priority: Processor userSchedulingPriority.
	UIProcess name: 'Morphic UI Process'.
	UIProcess resume! !

!MorphicUIManager class methodsFor: 'accessing' stamp: 'alain.plantec 5/30/2008 13:55'!
isActiveManager
	"Answer whether I should act as the active ui manager"
	^ true! !

!MorphicWindowAdapter commentStamp: '<historical>'!
I am the adapter used to bridge a WindowModel and a SystemWindow!
!MorphicWindowAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 16:24'!
askOkToClose

	^ self model askOkToClose! !

!MorphicWindowAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 12/10/2013 23:08'!
isResizeable: aBoolean

	^ self widgetDo: [ :w | w isResizeable: aBoolean ]! !

!MorphicWindowAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/25/2013 16:04'!
close

	self widget ifNotNil: [ :w | w close ].! !

!MorphicWindowAdapter methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 9/29/2013 12:30'!
windowIsClosing

	self model windowIsClosing! !

!MorphicWindowAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 16:41'!
aboutText

	^ self model model
		ifNotNil: [ :m | m aboutText ]! !

!MorphicWindowAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/25/2013 16:02'!
rebuildWithSpecLayout: aSpec
	| sub |
	
	sub := self model window submorphs copy.
	self model window removeAllMorphs.
	sub allButLast do: [:e | self model window addMorphBack: e ].
	self model addModelIn: self widget withSpecLayout: aSpec.
	self widget model: self! !

!MorphicWindowAdapter methodsFor: 'initialize' stamp: 'DucasseStephane 9/10/2014 09:59'!
initialize

	super initialize.

	isClosedHolder := false asValueHolder.! !

!MorphicWindowAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/25/2013 16:04'!
isDisplayed

	^ self widget isDisplayed! !

!MorphicWindowAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 10/19/2013 15:17'!
addModelItemsToWindowMenu: aMenu

	self model addMenuItemsToWindowMenu: aMenu! !

!MorphicWindowAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 10/1/2013 15:16'!
title
1halt.
	^ self model title! !

!MorphicWindowAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/25/2013 16:03'!
title: aString

	^ self widget
		ifNotNil: [:w | w title: aString ]! !

!MorphicWindowAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 16:25'!
initialExtent

	^ self model initialExtent! !

!MorphicWindowAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 2/18/2014 23:54:16.555818'!
minimize

	self widgetDo: [ :w | w minimize ]! !

!MorphicWindowAdapter methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 1/5/2014 12:45'!
taskbarIcon 
	^ self model taskbarIcon! !

!MorphicWindowAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/28/2013 17:11'!
centered

	self widgetDo: [ :w | 
		w
			fullBounds;
			position: Display extent - w extent // 2 ]! !

!MorphicWindowAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 2/18/2014 23:54:16.555818'!
maximize

	self widgetDo: [ :w | w maximize ]! !

!MorphicWindowAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/25/2013 16:02'!
rebuildWithSpec: aSpec
	| sub |
	
	sub := self model window submorphs copy.
	self model window removeAllMorphs.
	sub allButLast do: [:e | self model window addMorphBack: e ].
	self model addModelIn: self widget withSpec: aSpec! !

!MorphicWindowAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 12/10/2013 23:08'!
isResizeable

	^ self model isResizeable! !

!MorphicWindowAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/28/2013 17:18'!
centeredRelativeTo: aModel

	self widgetDo: [ :w | aModel centerWidget: w ]! !

!MorphicWindowAdapter methodsFor: 'widget API' stamp: 'BenjaminVanRyseghem 9/25/2013 16:43'!
cancelled

	^ false! !

!MorphicWindowAdapter methodsFor: 'widget API' stamp: 'NicolaiHess 12/22/2013 23:33'!
okToChange
^ self model okToChange! !

!MorphicWindowAdapter methodsFor: 'widget API' stamp: 'BenComan 12/18/2013 01:34'!
aboutTitle
    ^ self model model
         ifNotNil: [ :m | (m respondsTo: #aboutTitle)
		ifTrue: [m aboutTitle]
		ifFalse: [m class name]].! !

!MorphicWindowAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/25/2013 16:00'!
open

	self model window openInWorld! !

!MorphicWindowAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/25/2013 15:47'!
addModelIn: widgetToBuild withSpec: aSpec
	
	widgetToBuild
		addMorph: (self model model buildWithSpec: aSpec)
		frame: (0@0 corner: 1@1)! !

!MorphicWindowAdapter methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/25/2013 16:23'!
addModelIn: widgetToBuild withSpecLayout: aSpec
	
	widgetToBuild
		addMorph: (self model model buildWithSpecLayout: aSpec)
		frame: (0@0 corner: 1@1)! !

!MorphicWindowAdapter methodsFor: 'factory' stamp: 'StephaneDucasse 8/31/2014 09:37'!
buildWidget
	^ SpecWindow new
		model: model;
		isResizeable: self isResizeable;
		yourself! !

!MorphicWindowAdapter methodsFor: 'spec protocol' stamp: 'BenjaminVanRyseghem 12/1/2013 01:07'!
modalRelativeTo: aWindow

	self widgetDo: [ :w | aWindow setModal: w ]! !

!MorphicWindowAdapter methodsFor: 'protocol' stamp: 'ChristopheDemarey 10/18/2013 13:09'!
openModal: aWindow

	^ self widget 
		ifNotNil: [:w | w openModal: aWindow asWidget ].! !

!MouseButtonEvent commentStamp: 'TorstenBergmann 2/20/2014 18:29'!
A button event from a mouse!
!MouseButtonEvent methodsFor: 'printing' stamp: 'ar 10/24/2000 16:29'!
storeOn: aStream
	super storeOn: aStream.
	aStream space.
	whichButton storeOn: aStream.! !

!MouseButtonEvent methodsFor: 'dispatching' stamp: 'ar 9/16/2000 13:05'!
sentTo: anObject
	"Dispatch the receiver into anObject"
	type == #mouseDown ifTrue:[^anObject handleMouseDown: self].
	type == #mouseUp ifTrue:[^anObject handleMouseUp: self].
	^super sentTo: anObject! !

!MouseButtonEvent methodsFor: 'accessing' stamp: 'MartinDias 9/26/2014 11:42'!
yellowButtonChanged
	"Answer true if the yellow mouse button has changed. This is the second mouse button or option+click on the Mac."

	^ whichButton anyMask: self class yellowButton! !

!MouseButtonEvent methodsFor: 'accessing' stamp: 'MartinDias 9/26/2014 11:40'!
blueButtonChanged
	"Answer true if the blue mouse button has changed. This is the third mouse button or cmd+click on the Mac."

	^ whichButton anyMask: self class blueButton! !

!MouseButtonEvent methodsFor: 'accessing' stamp: 'MartinDias 9/26/2014 11:41'!
redButtonChanged
	"Answer true if the red mouse button has changed. This is the first mouse button."

	^ whichButton anyMask: self class redButton! !

!MouseButtonEvent methodsFor: 'accessing' stamp: 'nk 3/11/2004 17:44'!
whichButton
	^whichButton! !

!MouseButtonEvent methodsFor: 'private' stamp: 'ar 10/5/2000 23:55'!
setType: evtType position: evtPos which: button buttons: evtButtons hand: evtHand stamp: stamp
	type := evtType.
	position := evtPos.
	buttons := evtButtons.
	source := evtHand.
	wasHandled := false.
	whichButton := button.
	timeStamp := stamp.! !

!MouseClickState commentStamp: '<historical>'!
MouseClickState is a simple class managing the distinction between clicks, double clicks, and drag operations. It has been factored out of HandMorph due to the many instVars.

Instance variables:
	clickClient 	<Morph>		The client wishing to receive #click:, #dblClick:, or #drag messages
	clickState 	<Symbol>	The internal state of handling the last event (#firstClickDown, #firstClickUp, #firstClickTimedOut)
	firstClickDown 	<MorphicEvent>	The #mouseDown event after which the client wished to receive #click: or similar messages
	firstClickUp 	<MorphicEvent>	The first mouse up event which came in before the double click time out was exceeded (it is sent if there is a timout after the first mouse up event occured)
	firstClickTime 	<Integer>	The millisecond clock value of the first event
	clickSelector 	<Symbol>	The selector to use for sending #click: messages
	dblClickSelector 	<Symbol>	The selector to use for sending #doubleClick: messages
	dblClickTime 	<Integer>	Timout in milliseconds for a double click operation
	dragSelector 	<Symbol>	The selector to use for sending #drag: messages
	dragThreshold 	<Integer>	Threshold used for determining if a #drag: message is sent (pixels!!)
!
!MouseClickState methodsFor: 'initialize' stamp: 'jcg 9/21/2001 13:08'!
client: aMorph click: aClickSelector dblClick: aDblClickSelector dblClickTime: timeOut dblClickTimeout: aDblClickTimeoutSelector drag: aDragSelector threshold: aNumber event: firstClickEvent
	clickClient := aMorph.
	clickSelector := aClickSelector.
	dblClickSelector := aDblClickSelector.
	dblClickTime := timeOut.
	dblClickTimeoutSelector := aDblClickTimeoutSelector.
	dragSelector := aDragSelector.
	dragThreshold := aNumber.
	firstClickDown := firstClickEvent.
	firstClickTime := firstClickEvent timeStamp.
	clickState := #firstClickDown.! !

!MouseClickState methodsFor: 'event handling' stamp: 'nk 7/26/2004 10:21'!
handleEvent: evt from: aHand
	"Process the given mouse event to detect a click, double-click, or drag.
	Return true if the event should be processed by the sender, false if it shouldn't.
	NOTE: This method heavily relies on getting *all* mouse button events."
	| localEvt timedOut isDrag |
	timedOut := (evt timeStamp - firstClickTime) > dblClickTime.
	localEvt := evt transformedBy: (clickClient transformedFrom: aHand owner).
	isDrag := (localEvt position - firstClickDown position) r > dragThreshold.
	clickState == #firstClickDown ifTrue: [
		"Careful here - if we had a slow cycle we may have a timedOut mouseUp event"
		(timedOut and:[localEvt isMouseUp not]) ifTrue:[
			"timeout before #mouseUp -> keep waiting for drag if requested"
			clickState := #firstClickTimedOut.
			dragSelector ifNil:[
				aHand resetClickState.
				self doubleClickTimeout; click "***"].
			^true].
		localEvt isMouseUp ifTrue:[

			(timedOut or:[dblClickSelector isNil]) ifTrue:[
				self click.
				aHand resetClickState.
				^true].
			"Otherwise transfer to #firstClickUp"
			firstClickUp := evt copy.
			clickState := #firstClickUp.
			"If timedOut or the client's not interested in dbl clicks get outta here"
			self click.
			aHand handleEvent: firstClickUp.
			^false].
		isDrag ifTrue:["drag start"
			self doubleClickTimeout. "***"
			aHand resetClickState.
			dragSelector "If no drag selector send #click instead"
				ifNil: [self click]
				ifNotNil: [self drag: firstClickDown].
			^true].
		^false].

	clickState == #firstClickTimedOut ifTrue:[
		localEvt isMouseUp ifTrue:["neither drag nor double click"
			aHand resetClickState.
			self doubleClickTimeout; click. "***"
			^true].
		isDrag ifTrue:["drag start"
			aHand resetClickState.
			self doubleClickTimeout; drag: firstClickDown. "***"
			^true].
		^false].

	clickState = #firstClickUp ifTrue:[
		(timedOut) ifTrue:[
			"timed out after mouseUp - signal timeout and pass the event"
			aHand resetClickState.
			self doubleClickTimeout. "***"
			^true].
		localEvt isMouseDown ifTrue:["double click"
			clickState := #secondClickDown.
			^false]].

	clickState == #secondClickDown ifTrue: [
		timedOut ifTrue:[
			"timed out after second mouseDown - pass event after signaling timeout"
			aHand resetClickState.
			self doubleClickTimeout. "***"
			^true].
		isDrag ifTrue: ["drag start"
			self doubleClickTimeout. "***"
			aHand resetClickState.
			dragSelector "If no drag selector send #click instead"
				ifNil: [self click]
				ifNotNil: [self drag: firstClickDown].
			^true].
		localEvt isMouseUp ifTrue: ["double click"
			aHand resetClickState.
			self doubleClick.
			^false]
	].

	^true
! !

!MouseClickState methodsFor: 'printing' stamp: 'nk 7/26/2004 09:13'!
printOn: aStream
	super printOn: aStream.
	aStream nextPut: $[; print: clickState; nextPut: $]
! !

!MouseClickState methodsFor: 'event handling' stamp: 'jcg 9/21/2001 11:23'!
click

	clickSelector ifNotNil: [clickClient perform: clickSelector with: firstClickDown]! !

!MouseClickState methodsFor: 'event handling' stamp: 'jcg 9/21/2001 11:24'!
doubleClick

	dblClickSelector ifNotNil: [clickClient perform: dblClickSelector with: firstClickDown]! !

!MouseClickState methodsFor: 'event handling' stamp: 'jcg 9/21/2001 13:09'!
doubleClickTimeout

	dblClickTimeoutSelector ifNotNil: [
		clickClient perform: dblClickTimeoutSelector with: firstClickDown]! !

!MouseClickState methodsFor: 'event handling' stamp: 'jcg 9/21/2001 11:27'!
drag: event

	dragSelector ifNotNil: [clickClient perform: dragSelector with: event]! !

!MouseEvent commentStamp: 'TorstenBergmann 2/20/2014 18:29'!
Superclass for mouse events!
!MouseEvent methodsFor: 'testing' stamp: 'ar 9/13/2000 15:32'!
isMouseLeave
	^self type == #mouseLeave! !

!MouseEvent methodsFor: 'dispatching' stamp: 'ar 10/10/2000 21:15'!
sentTo: anObject
	"Dispatch the receiver into anObject"
	type == #mouseOver ifTrue:[^anObject handleMouseOver: self].
	type == #mouseEnter ifTrue:[^anObject handleMouseEnter: self].
	type == #mouseLeave ifTrue:[^anObject handleMouseLeave: self].
	^super sentTo: anObject.! !

!MouseEvent methodsFor: 'button state' stamp: 'NS 5/19/2003 15:17'!
redButtonPressed
	"Answer true if the red mouse button is being pressed. This is the first mouse button."

	^ buttons anyMask: self class redButton! !

!MouseEvent methodsFor: 'testing' stamp: 'ar 9/13/2000 15:32'!
isMouseMove
	^self type == #mouseMove! !

!MouseEvent methodsFor: 'testing' stamp: 'gvc 1/28/2008 13:14'!
isMouseWheel
	"Answer whether the receiver is a mouse wheel event."
	
	^false! !

!MouseEvent methodsFor: 'printing' stamp: 'JMM 9/29/2004 13:25'!
printOn: aStream

	aStream nextPut: $[.
	aStream nextPutAll: self cursorPoint printString; space.
	aStream nextPutAll: type; space.
	aStream nextPutAll: self modifierString.
	aStream nextPutAll: self buttonString.
	aStream nextPutAll: timeStamp printString; space.
	aStream	 nextPutAll: self windowIndex printString.
	aStream nextPut: $].! !

!MouseEvent methodsFor: 'testing' stamp: 'ar 9/13/2000 15:32'!
isMouseUp
	^self type == #mouseUp! !

!MouseEvent methodsFor: 'accessing' stamp: 'ar 9/15/2000 22:51'!
cursorPoint
	"Answer the location of the cursor's hotspot when this event occured."

	^ position! !

!MouseEvent methodsFor: 'button state' stamp: 'ar 9/15/2000 22:51'!
targetPoint
	"Answer the location of the cursor's hotspot, adjusted by the offset
	of the last mouseDown relative to the recipient morph."

	^ position - source targetOffset! !

!MouseEvent methodsFor: 'converting' stamp: 'marcus.denker 8/24/2008 21:42'!
asMouseOver
	"Convert the receiver into a mouse over event"
	^MouseEvent basicNew setType: #mouseOver position: position buttons: buttons hand: source! !

!MouseEvent methodsFor: 'private' stamp: 'ar 10/10/2000 21:15'!
setType: aSymbol
	"For quick conversion between event types"
	type := aSymbol.! !

!MouseEvent methodsFor: 'converting' stamp: 'pmm 3/13/2010 11:33'!
asMouseEnter
	^self shallowCopy setType: #mouseEnter! !

!MouseEvent methodsFor: 'comparing' stamp: 'ar 9/15/2000 22:47'!
hash
	^ position hash + buttons hash! !

!MouseEvent methodsFor: 'printing' stamp: 'ar 10/25/2000 22:09'!
storeOn: aStream

	aStream nextPutAll: type.
	aStream space.
	self timeStamp storeOn: aStream.
	aStream space.
	position x storeOn: aStream.
	aStream space.
	position y storeOn: aStream.
	aStream space.
	buttons storeOn: aStream.! !

!MouseEvent methodsFor: 'converting' stamp: 'marcus.denker 8/24/2008 21:41'!
asMouseMove
	"Convert the receiver into a mouse move"
	^MouseMoveEvent basicNew setType: #mouseMove startPoint: position endPoint: position trail: {position. position} buttons: buttons hand: source stamp: Time millisecondClockValue.! !

!MouseEvent methodsFor: 'testing' stamp: 'ar 9/13/2000 15:32'!
isMouseDown
	^self type == #mouseDown! !

!MouseEvent methodsFor: 'button state' stamp: 'NS 5/19/2003 15:17'!
yellowButtonPressed
	"Answer true if the yellow mouse button is being pressed. This is the second mouse button or option+click on the Mac."

	^ buttons anyMask: self class yellowButton! !

!MouseEvent methodsFor: 'testing' stamp: 'ar 9/13/2000 15:32'!
isMouseEnter
	^self type == #mouseEnter! !

!MouseEvent methodsFor: 'converting' stamp: 'pmm 3/13/2010 11:33'!
asMouseLeave
	^self shallowCopy setType: #mouseLeave! !

!MouseEvent methodsFor: 'testing' stamp: 'ar 9/13/2000 15:30'!
isMouse
	^true! !

!MouseEvent methodsFor: 'comparing' stamp: 'ar 9/15/2000 22:50'!
= aMorphicEvent
	super = aMorphicEvent ifFalse:[^false].
	position = aMorphicEvent position ifFalse: [^ false].
	buttons = aMorphicEvent buttons ifFalse: [^ false].
	^ true
! !

!MouseEvent methodsFor: 'button state' stamp: 'NS 5/19/2003 15:17'!
blueButtonPressed
	"Answer true if the blue mouse button is being pressed. This is the third mouse button or cmd+click on the Mac."

	^ buttons anyMask: self class blueButton! !

!MouseEvent methodsFor: 'private' stamp: 'ar 9/15/2000 22:53'!
setType: evtType position: evtPos buttons: evtButtons hand: evtHand
	type := evtType.
	position := evtPos.
	buttons := evtButtons.
	source := evtHand.
	wasHandled := false.! !

!MouseEvent methodsFor: 'button state' stamp: 'NS 5/19/2003 15:17'!
anyButtonPressed
	"Answer true if any mouse button is being pressed."

	^ buttons anyMask: self class anyButton! !

!MouseEvent methodsFor: 'testing' stamp: 'ar 10/5/2000 19:43'!
isDraggingEvent
	source ifNil:[^false].
	source hasSubmorphs ifTrue:[^true].
	self anyButtonPressed ifTrue:[^true].
	^false! !

!MouseEvent class methodsFor: 'constants' stamp: 'NS 5/19/2003 15:16'!
redButton
	^ 4! !

!MouseEvent class methodsFor: 'constants' stamp: 'NS 5/19/2003 15:16'!
yellowButton
	^ 2! !

!MouseEvent class methodsFor: 'constants' stamp: 'NS 5/19/2003 15:16'!
blueButton
	^ 1! !

!MouseEvent class methodsFor: 'constants' stamp: 'NS 5/19/2003 15:16'!
anyButton
	^ 7! !

!MouseMoveEvent commentStamp: 'TorstenBergmann 2/20/2014 18:30'!
A move event from the mouse!
!MouseMoveEvent methodsFor: 'comparing' stamp: 'ar 9/15/2000 22:49'!
hash
	^ position hash + startPoint hash + buttons hash! !

!MouseMoveEvent methodsFor: 'accessing' stamp: 'ar 9/13/2000 16:25'!
startPoint
	"Return the point where the movement started."
	^startPoint! !

!MouseMoveEvent methodsFor: 'comparing' stamp: 'ar 9/15/2000 22:49'!
= aMorphicEvent
	super = aMorphicEvent ifFalse:[^false].
	position = aMorphicEvent position ifFalse: [^ false].
	startPoint = aMorphicEvent startPoint ifFalse: [^ false].
	buttons = aMorphicEvent buttons ifFalse: [^ false].
	^ true
! !

!MouseMoveEvent methodsFor: 'printing' stamp: 'ar 10/24/2000 16:30'!
storeOn: aStream
	super storeOn: aStream.
	aStream space.
	self startPoint x storeOn: aStream.
	aStream space.
	self startPoint y storeOn: aStream.
	aStream space.
	"trail storeOn: aStream."! !

!MouseMoveEvent methodsFor: 'dispatching' stamp: 'ar 10/10/2000 21:15'!
sentTo: anObject
	"Dispatch the receiver into anObject"
	type == #mouseMove ifTrue:[^anObject handleMouseMove: self].
	^super sentTo: anObject.
! !

!MouseMoveEvent methodsFor: 'private' stamp: 'ar 10/5/2000 23:55'!
setType: evtType startPoint: evtStart endPoint: evtEnd trail: evtTrail buttons: evtButtons hand: evtHand stamp: stamp
	type := evtType.
	startPoint := evtStart.
	position := evtEnd.
	trail := evtTrail.
	buttons := evtButtons.
	source := evtHand.
	wasHandled := false.
	timeStamp := stamp.! !

!MouseMoveEvent methodsFor: 'printing' stamp: 'JMM 9/29/2004 13:25'!
printOn: aStream

	aStream nextPut: $[.
	aStream nextPutAll: self startPoint printString; space.
	aStream nextPutAll: self endPoint printString; space.
	aStream nextPutAll: self type; space.
	aStream nextPutAll: self modifierString.
	aStream nextPutAll: self buttonString.
	aStream nextPutAll: timeStamp printString; space.
	aStream	 nextPutAll: self windowIndex printString.
	aStream nextPut: $].! !

!MouseMoveEvent methodsFor: 'testing' stamp: 'ar 9/13/2000 19:29'!
isMove
	^true! !

!MouseMoveEvent methodsFor: 'transforming' stamp: 'ar 9/15/2000 22:52'!
transformBy: aMorphicTransform
	"Transform the receiver into a local coordinate system."
	position :=  aMorphicTransform globalPointToLocal: position.
	startPoint :=  aMorphicTransform globalPointToLocal: startPoint.! !

!MouseMoveEvent methodsFor: 'transforming' stamp: 'ar 9/15/2000 22:52'!
translateBy: delta
	"add delta to cursorPoint, and return the new event"
	position := position + delta.
	startPoint := startPoint + delta.! !

!MouseMoveEvent methodsFor: 'accessing' stamp: 'ar 9/15/2000 22:51'!
endPoint
	"Return the point where the movement ended."
	^position! !

!MouseMoveEvent methodsFor: 'accessing' stamp: 'ar 10/24/2000 16:33'!
trail
	"Return any immediate points that have been assembled along the move"
	^trail ifNil:[#()]! !

!MouseOverHandler commentStamp: 'TorstenBergmann 2/20/2014 18:29'!
Mouse over handler in a hand morph!
!MouseOverHandler methodsFor: 'initialization' stamp: 'HernanWilkinson 6/12/2009 13:48'!
initializeTrackedMorphs

	leftMorphs := OrderedCollection new.
	overMorphs := WriteStream on: #().
	enteredMorphs := WriteStream on: #().
	! !

!MouseOverHandler methodsFor: 'event handling - private' stamp: 'HernanWilkinson 6/12/2009 13:38'!
transform: anEvent from: originalEvent andSendTo: aMorph

	| transformedEvent |

	transformedEvent := anEvent transformedBy: (aMorph transformedFrom: originalEvent hand).
	^ aMorph handleEvent: transformedEvent! !

!MouseOverHandler methodsFor: 'event handling - private' stamp: 'HernanWilkinson 6/12/2009 13:37'!
is: anEvent withFocusOver: aMorph 

	| focusedMorph |
	
	focusedMorph := anEvent hand mouseFocus.
	^ aMorph = focusedMorph or: [ aMorph hasOwner: focusedMorph ]! !

!MouseOverHandler methodsFor: 'event handling - private' stamp: 'HernanWilkinson 6/12/2009 13:29'!
initializeProcessMouseOver

	leftMorphs := mouseOverMorphs asIdentitySet.
	overMorphs := WriteStream on: (Array new: leftMorphs size).
	enteredMorphs := WriteStream on: #()! !

!MouseOverHandler methodsFor: 'event handling - private' stamp: 'HernanWilkinson 6/12/2009 11:56'!
hasLeftMorphsChanged

	^(leftMorphs isEmpty and: [ enteredMorphs position = 0 ]) not! !

!MouseOverHandler methodsFor: 'event handling - private' stamp: 'HernanWilkinson 6/12/2009 13:32'!
keepLeftMorphsOrder

	leftMorphs size > 1 ifTrue: [ leftMorphs := mouseOverMorphs intersection: leftMorphs ]
	! !

!MouseOverHandler methodsFor: 'event handling - private' stamp: 'HernanWilkinson 6/12/2009 11:41'!
informMouseLeaveToLeftMorphsUsing: anEvent 

	| asMouseLeaveEvent |
	
	asMouseLeaveEvent := anEvent asMouseLeave.
	
	leftMorphs do: [ :aLeftMorph | 
		self inform: asMouseLeaveEvent to: aLeftMorph originatedFrom: anEvent ifNotFocusedDo: [ overMorphs nextPut: aLeftMorph ] ]! !

!MouseOverHandler methodsFor: 'event handling - private' stamp: 'HernanWilkinson 6/12/2009 11:58'!
rememberOverList

	mouseOverMorphs := overMorphs contents.
! !

!MouseOverHandler methodsFor: 'event handling - private' stamp: 'HernanWilkinson 6/12/2009 13:36'!
inform: evt to: aLeftMorph originatedFrom: anEvent ifNotFocusedDo: aBlock

	^ (self is: anEvent withFocusOver: aLeftMorph) 
		ifTrue: [ self transform: evt from: anEvent andSendTo: aLeftMorph ]
		ifFalse: aBlock! !

!MouseOverHandler methodsFor: 'initialization' stamp: 'HernanWilkinson 6/4/2009 14:10'!
initialize
	mouseOverMorphs := #().
	
	self initializeTrackedMorphs
	! !

!MouseOverHandler methodsFor: 'event handling' stamp: 'HernanWilkinson 6/12/2009 13:40'!
noticeMouseOver: aMorph event: anEvent
	"Remember that the mouse is currently over some morph"

	leftMorphs remove: aMorph ifAbsent: [ enteredMorphs nextPut: aMorph ].
	overMorphs nextPut: aMorph.
! !

!MouseOverHandler methodsFor: 'event handling' stamp: 'HernanWilkinson 6/12/2009 13:51'!
processMouseOver: anEvent 

	self initializeProcessMouseOver.
	self handleAsMouseOver: anEvent.
	self hasLeftMorphsChanged ifTrue: [ 
		self handleAsMouseLeave: anEvent.
		self handleAsMouseEnter: anEvent.
		self rememberOverList ].
	
	self initializeTrackedMorphs 
! !

!MouseOverHandler methodsFor: 'event handling - private' stamp: 'HernanWilkinson 6/12/2009 08:44'!
handleAsMouseLeave: anEvent 

	self keepLeftMorphsOrder.
	self informMouseLeaveToLeftMorphsUsing: anEvent
! !

!MouseOverHandler methodsFor: 'event handling - private' stamp: 'HernanWilkinson 6/12/2009 11:59'!
handleAsMouseOver: anEvent 

	anEvent hand handleEvent: anEvent asMouseOver.
! !

!MouseOverHandler methodsFor: 'event handling - private' stamp: 'HernanWilkinson 6/12/2009 13:33'!
handleAsMouseEnter: anEvent 

	| asMouseEnterEvent |
	
	asMouseEnterEvent := anEvent asMouseEnter.
	enteredMorphs := enteredMorphs contents.
	enteredMorphs reverseDo: [ :anEnteredMorph | 
		self inform: asMouseEnterEvent to: anEnteredMorph originatedFrom: anEvent ifNotFocusedDo: [] ]! !

!MouseWheelEvent commentStamp: 'gvc 9/23/2008 11:46'!
A mouse event generated by intercepting the keyboard events (ctrl+up/down arrow) generated by the VM in response to mouse wheel activity.!
!MouseWheelEvent methodsFor: 'testing' stamp: 'SeanDeNigris 2/10/2015 14:02'!
isDown

	^ direction = Character arrowDown! !

!MouseWheelEvent methodsFor: 'testing' stamp: 'gvc 1/28/2008 13:14'!
isMouseWheel
	"Answer whether the receiver is a mouse wheel event."
	
	^true! !

!MouseWheelEvent methodsFor: 'accessing' stamp: 'gvc 1/25/2008 17:40'!
direction
	"Answer the value of direction"

	^ direction! !

!MouseWheelEvent methodsFor: 'accessing' stamp: 'gvc 1/25/2008 17:40'!
direction: anObject
	"Set the value of direction"

	direction := anObject! !

!MouseWheelEvent methodsFor: 'dispatching' stamp: 'gvc 1/25/2008 17:42'!
sentTo: anObject
	"Dispatch the receiver into anObject"
	
	type == #mouseWheel ifTrue:[^anObject handleMouseWheel: self].
	^super sentTo: anObject.
! !

!MouseWheelEvent methodsFor: 'accessing' stamp: 'gvc 1/28/2008 15:31'!
setType: evtType position: evtPos direction: dirSymbol buttons: evtButtons hand: evtHand stamp: stamp
	"Set the state for the receiver."
	
	type := evtType.
	position := evtPos.
	buttons := evtButtons.
	source := evtHand.
	wasHandled := false.
	direction := dirSymbol.
	timeStamp := stamp.! !

!MouseWheelEvent methodsFor: 'printing' stamp: 'SeanDeNigris 2/10/2015 14:05'!
printOn: aStream

	aStream nextPut: $[.
	aStream nextPutAll: self cursorPoint printString; space.
	aStream nextPutAll: type; space.
	aStream print: self direction; space.
	aStream nextPutAll: self modifierString.
	aStream nextPutAll: self buttonString.
	aStream nextPutAll: timeStamp printString; space.
	aStream	 nextPutAll: self windowIndex printString.
	aStream nextPut: $].! !

!MouseWheelEvent methodsFor: 'testing' stamp: 'SeanDeNigris 2/10/2015 14:02'!
isRight

	^ direction = Character arrowRight! !

!MouseWheelEvent methodsFor: 'testing' stamp: 'SeanDeNigris 2/10/2015 14:02'!
isLeft

	^ direction = Character arrowLeft! !

!MouseWheelEvent methodsFor: 'testing' stamp: 'SeanDeNigris 2/10/2015 14:02'!
isUp

	^ direction = Character arrowUp! !

!MouseWheelEvent class methodsFor: 'instance creation' stamp: 'SeanDeNigris 2/10/2015 14:01'!
fromCharacter: aCharacter position: aPoint buttons: evtButtons hand: evtHand stamp: stamp

	^ self new
		setType: #mouseWheel
		position: aPoint
		direction: aCharacter
		buttons: evtButtons
		hand: evtHand
		stamp: stamp! !

!MultiByteBinaryOrTextStream commentStamp: '<historical>'!
It is similar to MultiByteFileStream, but works on in memory stream.!
!MultiByteBinaryOrTextStream methodsFor: 'private basic' stamp: 'HenrikSperreJohansen 8/17/2012 11:29'!
basicNext: anInteger putAll: aCollection startingAt: startIndex
	
	^super next: anInteger putAll: aCollection startingAt: startIndex! !

!MultiByteBinaryOrTextStream methodsFor: 'filein/out' stamp: 'StephaneDucasse 2/3/2010 22:18'!
setConverterForCode

	| current |
	current := converter saveStateOf: self.
	self position: 0.
	self binary.
	((self next: 3) =  #[239 187 191]) ifTrue: [
		self converter: UTF8TextConverter new
	] ifFalse: [
		self converter: MacRomanTextConverter new.
	].
	converter restoreStateOf: self with: current.
	self text.
! !

!MultiByteBinaryOrTextStream methodsFor: 'private basic' stamp: 'md 10/20/2004 15:32'!
basicNext: anInteger

	^ super next: anInteger.
! !

!MultiByteBinaryOrTextStream methodsFor: 'accessing' stamp: 'yo 11/11/2002 13:16'!
binary
	isBinary := true
! !

!MultiByteBinaryOrTextStream methodsFor: 'private basic' stamp: 'yo 11/11/2002 13:21'!
basicNextPut: char

	^ super nextPut: char.
! !

!MultiByteBinaryOrTextStream methodsFor: 'accessing' stamp: 'yo 8/7/2003 09:12'!
converter: aConverter

	converter := aConverter.
! !

!MultiByteBinaryOrTextStream methodsFor: 'accessing' stamp: 'nk 8/2/2004 17:02'!
converter

	converter ifNil: [converter := self class defaultConverter].
	^ converter
! !

!MultiByteBinaryOrTextStream methodsFor: 'public' stamp: 'yo 11/11/2002 16:39'!
next

	| n |
	n := self converter nextFromStream: self.
	n ifNil: [^ nil].
	isBinary and: [n isCharacter ifTrue: [^ n asciiValue]].
	^ n.
! !

!MultiByteBinaryOrTextStream methodsFor: 'accessing' stamp: 'yo 11/11/2002 13:25'!
isBinary
	^ isBinary! !

!MultiByteBinaryOrTextStream methodsFor: 'public' stamp: 'yo 11/11/2002 13:25'!
peekFor: item 

	| next state |
	"self atEnd ifTrue: [^ false]. -- SFStream will give nil"
	state := converter saveStateOf: self.
	(next := self next) == nil ifTrue: [^ false].
	item = next ifTrue: [^ true].
	converter restoreStateOf: self with: state.
	^ false.
! !

!MultiByteBinaryOrTextStream methodsFor: 'accessing' stamp: 'yo 11/11/2002 16:33'!
text
	isBinary := false
! !

!MultiByteBinaryOrTextStream methodsFor: 'public' stamp: 'yo 11/11/2002 16:17'!
skipSeparators

	[self atEnd] whileFalse: [
		self basicNext isSeparator ifFalse: [
			^ self position: self position - 1]]

! !

!MultiByteBinaryOrTextStream methodsFor: 'public' stamp: 'yo 12/25/2003 16:04'!
skipSeparatorsAndPeekNext

	"A special function to make nextChunk fast"
	| peek pos |
	[self atEnd] whileFalse: [
		pos := self position.
		(peek := self next) isSeparator ifFalse: [
			self position: pos.
			^ peek.
		].
	].
! !

!MultiByteBinaryOrTextStream methodsFor: 'private basic' stamp: 'MarcusDenker 9/12/2014 13:03'!
basicPosition: pos

	^ self position: pos.
! !

!MultiByteBinaryOrTextStream methodsFor: 'public' stamp: 'LukasRenggli 5/8/2010 18:43'!
nextPutAll: aCollection
	^ self isBinary
		ifTrue: [ super nextPutAll: aCollection ]
		ifFalse: [ aCollection do: [ :each | self nextPut: each ] ]! !

!MultiByteBinaryOrTextStream methodsFor: 'public' stamp: 'PeterHugossonMiller 9/3/2009 10:07'!
nextDelimited: terminator

	| out ch pos |
	out := (String new: 1000) writeStream.
	self atEnd ifTrue: [^ ''].
	pos := self position.
	self next = terminator ifFalse: [
		"absorb initial terminator"
		self position: pos.
	].
	[(ch := self next) == nil] whileFalse: [
		(ch = terminator) ifTrue: [
			self peek = terminator ifTrue: [
				self next.  "skip doubled terminator"
			] ifFalse: [
				^ out contents  "terminator is not doubled; we're done!!"
			].
		].
		out nextPut: ch.
	].
	^ out contents.
! !

!MultiByteBinaryOrTextStream methodsFor: 'accessing' stamp: 'yo 11/11/2002 13:16'!
ascii
	isBinary := false
! !

!MultiByteBinaryOrTextStream methodsFor: 'private basic' stamp: 'yo 11/11/2002 13:21'!
basicNextPutAll: aString

	^ super nextPutAll: aString.
! !

!MultiByteBinaryOrTextStream methodsFor: 'filein/out' stamp: 'MarcusDenker 2/14/2010 09:30'!
setEncoderForSourceCodeNamed: streamName

	| l |
	l := streamName asLowercase.
	((l endsWith: 'cs') or: [
		(l endsWith: 'st') or: [
			(l endsWith: ('st.gz')) or: [
				(l endsWith: ('st.gz'))]]]) ifTrue: [
					self converter: MacRomanTextConverter new.
					^ self.
	].
	self converter: UTF8TextConverter new.
! !

!MultiByteBinaryOrTextStream methodsFor: 'private basic' stamp: 'yo 11/11/2002 13:21'!
basicPeek

	^ super peek
! !

!MultiByteBinaryOrTextStream methodsFor: 'public' stamp: 'yo 12/25/2003 16:04'!
peek
	"Answer what would be returned if the message next were sent to the receiver. If the receiver is at the end, answer nil.  "

	| next pos |
	self atEnd ifTrue: [^ nil].
	pos := self position.
	next := self next.
	self position: pos.
	^ next.

! !

!MultiByteBinaryOrTextStream methodsFor: 'private basic' stamp: 'MarcusDenker 9/12/2014 13:03'!
basicNext: n into: aString

	^ self next: n into: aString.
! !

!MultiByteBinaryOrTextStream methodsFor: 'public' stamp: 'LukasRenggli 5/8/2010 18:43'!
nextPut: aCharacter
	^ aCharacter isInteger 
		ifTrue: [ super nextPut: aCharacter asCharacter ]
		ifFalse: [ self converter nextPut: aCharacter toStream: self ]! !

!MultiByteBinaryOrTextStream methodsFor: 'properties-setting' stamp: 'yo 11/14/2002 13:49'!
setFileTypeToObject
	"do nothing.  We don't have a file type"! !

!MultiByteBinaryOrTextStream methodsFor: 'public' stamp: 'nk 7/29/2004 12:02'!
reset

	super reset.
	isBinary ifNil: [isBinary := false].
	collection class == ByteArray ifTrue: ["Store as String and convert as needed."
		collection := collection asString.
		isBinary := true].

	self converter. "ensure that we have a converter."! !

!MultiByteBinaryOrTextStream methodsFor: 'public' stamp: 'MarcusDenker 10/3/2013 23:52'!
next: anInteger 

	| multiString |
	self isBinary ifTrue: [^ (super next: anInteger) asByteArray].
	multiString := WideString new: anInteger.
	1 to: anInteger do: [:index |
		| character |
		(character := self next) ifNotNil: [
			multiString at: index put: character
		] ifNil: [
			multiString := multiString copyFrom: 1 to: index - 1.
			^ multiString
		]
	].
	^ multiString.
! !

!MultiByteBinaryOrTextStream methodsFor: 'public' stamp: 'yo 11/14/2002 13:54'!
padToEndWith: aChar
	"We don't have pages, so we are at the end, and don't need to pad."! !

!MultiByteBinaryOrTextStream methodsFor: 'private basic' stamp: 'monty 12/20/2013 00:29'!
basicNext
	| nextChar |

	^ isBinary
		ifTrue: [super next]
		ifFalse: [
			(nextChar := super next)
				ifNotNil: [nextChar asCharacter]].! !

!MultiByteBinaryOrTextStream methodsFor: 'public' stamp: 'yo 11/11/2002 13:24'!
nextMatchAll: aColl

    | save |
    save := converter saveStateOf: self.
    aColl do: [:each |
       (self next) = each ifFalse: [
            converter restoreStateOf: self with: save.
            ^ false.
		].
	].
    ^ true.
! !

!MultiByteBinaryOrTextStream methodsFor: 'private basic' stamp: 'MarcusDenker 9/12/2014 13:03'!
basicPosition

	^ self position.
! !

!MultiByteBinaryOrTextStream methodsFor: 'private basic' stamp: 'MarcusDenker 9/12/2014 13:03'!
basicNextInto: aString

	^ self nextInto: aString.
! !

!MultiByteBinaryOrTextStream methodsFor: 'public' stamp: 'PeterHugossonMiller 9/3/2009 10:08'!
upTo: delim 

	| out ch |
	out := (String new: 1000) writeStream.
	self atEnd ifTrue: [^ ''].
	[(ch := self next) isNil] whileFalse: [
		(ch = delim) ifTrue: [
			^ out contents  "terminator is not doubled; we're done!!"
		].
		out nextPut: ch.
	].
	^ out contents.
! !

!MultiByteBinaryOrTextStream methodsFor: 'converting' stamp: 'yo 11/11/2002 13:16'!
asBinaryOrTextStream

	^ self
! !

!MultiByteBinaryOrTextStream methodsFor: 'public' stamp: 'PeterHugossonMiller 9/3/2009 10:08'!
upToEnd

	| newStream element newCollection |
	newCollection := self isBinary
				ifTrue: [ByteArray new: 100]
				ifFalse: [String new: 100].
	newStream := newCollection writeStream.
	[(element := self next) notNil]
		whileTrue: [newStream nextPut: element].
	^ newStream contents
! !

!MultiByteBinaryOrTextStream methodsFor: 'public' stamp: 'HenrikSperreJohansen 8/17/2012 11:35'!
next: anInteger putAll: aCollection startingAt: startIndex


        (self isBinary or: [ aCollection class == ByteArray ]) ifTrue: [
                ^super next: anInteger putAll: aCollection startingAt: startIndex ].
        ^self converter next: anInteger putAll: aCollection startingAt: startIndex toStream: self! !

!MultiByteBinaryOrTextStream methodsFor: 'public' stamp: 'yo 7/30/2004 06:59'!
contents

	| ret state |
	state := converter saveStateOf: self.
	ret := self upToEnd.
	converter restoreStateOf: self with: state.
	^ ret.
! !

!MultiByteBinaryOrTextStream class methodsFor: 'instance creation' stamp: 'ClementBera 7/26/2013 16:18'!
on: aCollection encoding: encodingName 
	| aTextConverter |
	encodingName 
		ifNil: [aTextConverter := TextConverter default]
		ifNotNil: [aTextConverter := TextConverter newForEncoding: encodingName].
	^ (self on: aCollection)
		converter: aTextConverter! !

!MultiByteBinaryOrTextStream class methodsFor: 'instance creation' stamp: 'ClementBera 7/26/2013 16:27'!
with: aCollection encoding: encodingName 
	| aTextConverter |
	encodingName 
		ifNil: [aTextConverter := TextConverter default]
		ifNotNil: [aTextConverter := TextConverter newForEncoding: encodingName].
	^ (self with: aCollection)
		converter: aTextConverter! !

!MultiByteBinaryOrTextStream class methodsFor: 'defaults' stamp: 'yo 2/25/2005 20:04'!
defaultConverter
	^ Latin1TextConverter new.
! !

!MultiByteFileStream commentStamp: '<historical>'!
The central class to access the external file.  The interface of this object is similar to good old StandardFileStream, but internally it asks the converter, which is a sub-instance of TextConverter, and do the text conversion.

  It also combined the good old CrLfFileStream.  CrLfFileStream class>>new now returns an instance of MultiByteFileStream.

  There are several pitfalls:

  * You always have to be careful about the binary/text distinction.  In #text mode, it usually interpret the bytes.
  * A few file pointer operations treat the file as uninterpreted byte no matter what.  This means that if you use 'fileStream skip: -1', 'fileStream position: x', etc. in #text mode, the file position can be in the middle of multi byte character.  If you want to implement some function similar to #peek for example, call the saveStateOf: and restoreStateOf: methods to be able to get back to the original state.
  * #lineEndConvention: and #wantsLineEndConversion: (and #binary) can cause some puzzling situation because the inst var lineEndConvention and wantsLineEndConversion are mutated.  If you have any suggestions to clean up the protocol, please let me know.!
!MultiByteFileStream methodsFor: 'private basic' stamp: 'HenrikSperreJohansen 8/17/2012 11:30'!
basicNext: anInteger putAll: aCollection startingAt: startIndex


        ^super next: anInteger putAll: aCollection startingAt: startIndex! !

!MultiByteFileStream methodsFor: 'private' stamp: 'nice 1/18/2010 13:42'!
setConverterForCode

	| current |
	(SourceFiles at: 2)
		ifNotNil: [self fullName = (SourceFiles at: 2) fullName ifTrue: [^ self]].
	current := self converter saveStateOf: self.
	self position: 0.
	self binary.
	((self next: 3) = #[ 16rEF 16rBB 16rBF ]) ifTrue: [
		self converter: UTF8TextConverter new
	] ifFalse: [
		self converter: MacRomanTextConverter new.
	].
	converter restoreStateOf: self with: current.
	self text.
! !

!MultiByteFileStream methodsFor: 'private basic' stamp: 'md 10/17/2004 16:09'!
basicNext: anInteger

	^ super next: anInteger.
! !

!MultiByteFileStream methodsFor: 'accessing' stamp: 'nice 5/10/2009 00:18'!
converter: aConverter

	converter := aConverter.
	self installLineEndConventionInConverter
! !

!MultiByteFileStream methodsFor: 'private basic' stamp: 'yo 8/28/2002 11:07'!
basicNextPut: char

	^ super nextPut: char.
! !

!MultiByteFileStream methodsFor: 'accessing' stamp: 'nice 5/10/2009 00:14'!
binary

	super binary.
	self lineEndConvention: nil! !

!MultiByteFileStream methodsFor: 'accessing' stamp: 'nice 11/28/2009 13:06'!
lineEndConvention: aSymbol

	(lineEndConvention := aSymbol) ifNotNil: [wantsLineEndConversion := true].
	self installLineEndConventionInConverter! !

!MultiByteFileStream methodsFor: 'public' stamp: 'CamilloBruni 9/5/2012 11:26'!
peekFor: item 

	| next state |
	state := converter saveStateOf: self.
	(next := self next) == nil ifTrue: [^ false].
	item = next ifTrue: [^ true].
	converter restoreStateOf: self with: state.
	^ false.
! !

!MultiByteFileStream methodsFor: 'private basic' stamp: 'yo 8/28/2002 11:08'!
basicReadInto: byteArray startingAt: startIndex count: count

	^ super readInto: byteArray startingAt: startIndex count: count.
! !

!MultiByteFileStream methodsFor: 'fileIn/Out' stamp: 'HenrikSperreJohansen 2/9/2010 11:23'!
basicChunk
	"If our buffer in collection contains an chunk with no embedded !!'s, nor
	any non-ascii characters, return that.
	This presumes the source code encoding is unambiguously ascii-compatible"
	| bufferIX goodString |
	"Not possible if read buffering disabled"
	collection ifNil: [^nil].
	^ ((bufferIX := (collection indexOf: $!! startingAt: position + 1) min: readLimit +1) > 0
			and: [bufferIX < collection size
					and: [(collection at: bufferIX + 1)
								~= $!!
							and: [goodString := collection copyFrom: position + 1 to: bufferIX - 1.
								goodString isAsciiString]]])
		ifTrue: [ position := bufferIX.
				goodString]! !

!MultiByteFileStream methodsFor: 'accessing' stamp: 'yo 2/21/2004 02:57'!
ascii

	super ascii.
	self detectLineEndConvention.
! !

!MultiByteFileStream methodsFor: 'private basic' stamp: 'yo 8/28/2002 11:08'!
basicUpTo: delim

	^ super upTo: delim.
! !

!MultiByteFileStream methodsFor: 'private' stamp: 'StephaneDucasse 5/3/2010 22:59'!
requestDropStream: dropIndex
	"Needs to install proper converter"
	
	| result |
	result := super requestDropStream: dropIndex.
	result ifNotNil: [
		converter ifNil: [self converter: UTF8TextConverter new].
		lineEndConvention ifNil: [ self detectLineEndConvention] ].
	^result! !

!MultiByteFileStream methodsFor: 'crlf private' stamp: 'yo 2/24/2004 13:44'!
next: n innerFor: aString

	| peekChar state |
	"if we just read a CR, and the next character is an LF, then skip the LF"
	aString size = 0 ifTrue: [^ aString].
	(aString last = Character cr) ifTrue: [
		state := converter saveStateOf: self.
		peekChar := self bareNext.		"super peek doesn't work because it relies on #next"
		(peekChar notNil and: [peekChar ~= Character lf]) ifTrue: [
			converter restoreStateOf: self with: state.
		].
	].
 
	^ aString withSqueakLineEndings.
! !

!MultiByteFileStream methodsFor: 'public' stamp: 'yo 2/21/2004 04:00'!
peek
	"Answer what would be returned if the message next were sent to the receiver. If the receiver is at the end, answer nil.  "

	| next save |
	self atEnd ifTrue: [^ nil].
	save := converter saveStateOf: self.
	next := self next.
	converter restoreStateOf: self with: save.
	^ next.

! !

!MultiByteFileStream methodsFor: 'open/close' stamp: 'HenrikSperreJohansen 11/20/2009 15:13'!
open: fileName forWrite: writeMode 
	| result |
	result := super open: fileName forWrite: writeMode.
	result ifNotNil: [
			converter ifNil: [self converter: UTF8TextConverter new].
			lineEndConvention ifNil: [ self detectLineEndConvention ]
	].
	^result! !

!MultiByteFileStream methodsFor: 'crlf private' stamp: 'ul 11/25/2009 01:22'!
wantsLineEndConversion

	^wantsLineEndConversion == true
! !

!MultiByteFileStream methodsFor: 'private' stamp: 'ul 11/25/2009 01:28'!
installLineEndConventionInConverter

	converter ifNotNil: [
		converter installLineEndConvention: (
			(wantsLineEndConversion == true and: [ lineEndConvention notNil ]) "#doConversion is inlined here"
				ifTrue: [ LineEndStrings at: lineEndConvention ]
				ifFalse: [ nil ]) ]! !

!MultiByteFileStream methodsFor: 'crlf private' stamp: 'yo 2/24/2004 13:38'!
bareNext

	 ^ self converter nextFromStream: self.
! !

!MultiByteFileStream methodsFor: 'private basic' stamp: 'yo 8/28/2002 11:09'!
basicVerbatim: aString

	^ super verbatim: aString.
! !

!MultiByteFileStream methodsFor: 'open/close' stamp: 'nice 5/10/2009 00:18'!
reset

	super reset.
	converter ifNil: [
		self converter: UTF8TextConverter new.
	].
! !

!MultiByteFileStream methodsFor: 'public' stamp: 'ul 11/25/2009 01:28'!
next: anInteger 

	| multiString |
	self isBinary ifTrue: [^ super next: anInteger].
	multiString := String new: anInteger.
	1 to: anInteger do: [:index |
		| character |
		(character := self next)
			ifNotNil: [ multiString at: index put: character ]
			ifNil: [
				multiString := multiString copyFrom: 1 to: index - 1.
				(wantsLineEndConversion == true and: [ lineEndConvention notNil ]) "#doConversion is inlined here"
					ifFalse: [ ^multiString ].
				^self next: anInteger innerFor: multiString ] ].
	(wantsLineEndConversion == true and: [ lineEndConvention notNil ]) "#doConversion is inlined here"
		 ifFalse: [ ^multiString ].

	multiString := self next: anInteger innerFor: multiString.
	(multiString size = anInteger or: [self atEnd]) ifTrue: [ ^ multiString].
	^ multiString, (self next: anInteger - multiString size).
! !

!MultiByteFileStream methodsFor: 'public' stamp: 'nice 12/7/2009 08:26'!
upToAnyOf: delimiters do: aBlock

	^self collectionSpecies new: 1000 streamContents: [ :stream |
		| ch |
		[ (ch := self next) == nil or: [ (delimiters includes: ch) and: [aBlock value: ch. true] ] ] 
			whileFalse: [ stream nextPut: ch ] ]! !

!MultiByteFileStream methodsFor: 'public' stamp: 'yo 8/28/2002 11:13'!
nextMatchAll: aColl

    | save |
    save := converter saveStateOf: self.
    aColl do: [:each |
       (self next) = each ifFalse: [
            converter restoreStateOf: self with: save.
            ^ false.
		].
	].
    ^ true.
! !

!MultiByteFileStream methodsFor: 'private basic' stamp: 'yo 8/28/2002 11:08'!
basicPosition

	^ super position.
! !

!MultiByteFileStream methodsFor: 'crlf private' stamp: 'tbn 5/10/2012 15:29'!
detectLineEndConvention
	"Detect the line end convention used in this stream. The result may be either #cr, #lf or #crlf."
	| char numRead state |
	self isBinary ifTrue: [^ self error: 'Line end conventions are not used on binary streams'].
	wantsLineEndConversion == true ifFalse: [self lineEndConvention: nil.
					^lineEndConvention].
	self closed ifTrue: [self lineEndConvention: LineEndDefault.
					^lineEndConvention].

	"Default if nothing else found"
	numRead := 0.
	state := self converter saveStateOf: self.
	lineEndConvention := nil.
	[super atEnd not and: [numRead < LookAheadCount]]
		whileTrue: 
			[char := self next.
			char = Lf
				ifTrue: 
					[converter restoreStateOf: self with: state.
					self lineEndConvention: #lf.
					^lineEndConvention].
			char = Cr
				ifTrue: 
					[self peek = Lf
						ifTrue: [self lineEndConvention: #crlf]
						ifFalse: [self lineEndConvention: #cr].
					converter restoreStateOf: self with: state.
					^ lineEndConvention].
			numRead := numRead + 1].
	converter restoreStateOf: self with: state.
	self lineEndConvention: LineEndDefault.
	^ lineEndConvention! !

!MultiByteFileStream methodsFor: 'public' stamp: 'HenrikSperreJohansen 8/17/2012 11:36'!
next: anInteger putAll: aCollection startingAt: startIndex


        (self isBinary or: [ aCollection class == ByteArray ]) ifTrue: [
                ^super next: anInteger putAll: aCollection startingAt: startIndex ].
        ^self converter next: anInteger putAll: aCollection startingAt: startIndex toStream: self! !

!MultiByteFileStream methodsFor: 'private basic' stamp: 'yo 8/28/2002 11:08'!
basicSkip: n

	^ super skip: n.
! !

!MultiByteFileStream methodsFor: 'accessing' stamp: 'nk 9/5/2004 12:57'!
lineEndConvention

	^lineEndConvention! !

!MultiByteFileStream methodsFor: 'accessing' stamp: 'nice 5/10/2009 00:17'!
converter

	converter ifNil: [self converter: TextConverter defaultSystemConverter].
	^ converter
! !

!MultiByteFileStream methodsFor: 'public' stamp: 'ul 12/3/2009 01:33'!
next

	| char secondChar state |
	char := (converter ifNil: [ self converter ]) nextFromStream: self.
	(wantsLineEndConversion == true and: [ lineEndConvention notNil ]) "#doConversion is inlined here"
		 ifTrue: [
			char == Cr ifTrue: [
				state := converter saveStateOf: self.
				secondChar := self bareNext.
				secondChar ifNotNil: [
					secondChar == Lf ifFalse: [ converter restoreStateOf: self with: state ] ].
				^Cr ].
			char == Lf ifTrue: [
				^Cr ] ].
	^char.

! !

!MultiByteFileStream methodsFor: 'private basic' stamp: 'yo 8/28/2002 11:08'!
basicSetToEnd

	^ super setToEnd.
! !

!MultiByteFileStream methodsFor: 'public' stamp: 'ul 12/7/2009 23:35'!
skipSeparators

	| state character |
	[ 
		state := converter saveStateOf: self.
		(character := self next) 
			ifNil: [ false ]
			ifNotNil: [ character isSeparator ] ] whileTrue.
	character ifNotNil: [ 
		converter restoreStateOf: self with: state ]! !

!MultiByteFileStream methodsFor: 'remnant' stamp: 'kph 3/1/2009 15:50'!
wantsLineEndConversion: aBoolean
	
	wantsLineEndConversion :=  aBoolean.

	lineEndConvention ifNil: [ self detectLineEndConvention ]. ! !

!MultiByteFileStream methodsFor: 'public' stamp: 'ul 12/8/2009 00:05'!
skipSeparatorsAndPeekNext
	"Same as #skipSeparators, but returns the next character after the separators if such exists."

	| state character |
	[ 
		state := converter saveStateOf: self.
		(character := self next) 
			ifNil: [ false ]
			ifNotNil: [ character isSeparator ] ] whileTrue.
	character ifNotNil: [ 
		converter restoreStateOf: self with: state.
		^character ].
	! !

!MultiByteFileStream methodsFor: 'private basic' stamp: 'yo 8/28/2002 11:08'!
basicPosition: pos

	^ super position: pos.
! !

!MultiByteFileStream methodsFor: 'public' stamp: 'LukasRenggli 5/8/2010 18:41'!
nextPutAll: aCollection
	^ (self isBinary or: [ aCollection class == ByteArray ])
		ifTrue: [ super nextPutAll: aCollection ]
		ifFalse: [ self converter nextPutAll: aCollection toStream: self ]! !

!MultiByteFileStream methodsFor: 'public' stamp: 'yo 2/21/2004 03:26'!
nextDelimited: terminator

	| out ch save |
	out := (String new: 1000) writeStream.
	self atEnd ifTrue: [^ ''].
	save := converter saveStateOf: self.

	self next = terminator ifFalse: [
		"absorb initial terminator"
		converter restoreStateOf: self with: save.
	].
	[(ch := self next) == nil] whileFalse: [
		(ch = terminator) ifTrue: [
			self peek = terminator ifTrue: [
				self next.  "skip doubled terminator"
			] ifFalse: [
				^ out contents  "terminator is not doubled; we're done!!"
			].
		].
		out nextPut: ch.
	].
	^ out contents.
! !

!MultiByteFileStream methodsFor: 'crlf private' stamp: 'yo 2/21/2004 02:56'!
convertStringFromCr: aString 
	| inStream outStream |
	lineEndConvention ifNil: [^ aString].
	lineEndConvention == #cr ifTrue: [^ aString].
	lineEndConvention == #lf ifTrue: [^ aString copy replaceAll: Cr with: Lf].
	"lineEndConvention == #crlf"
	inStream := aString readStream.
	outStream :=  (String new: aString size) writeStream.
	[inStream atEnd]
		whileFalse: 
			[outStream nextPutAll: (inStream upTo: Cr).
			(inStream atEnd not or: [aString last = Cr])
				ifTrue: [outStream nextPutAll: CrLf]].
	^ outStream contents! !

!MultiByteFileStream methodsFor: 'private basic' stamp: 'yo 8/28/2002 11:07'!
basicNextPutAll: aString

	^ super nextPutAll: aString.
! !

!MultiByteFileStream methodsFor: 'remnant' stamp: 'yo 8/28/2002 11:06'!
accepts: aSymbol

 	^ converter accepts: aSymbol.
! !

!MultiByteFileStream methodsFor: 'crlf private' stamp: 'ul 11/25/2009 01:22'!
doConversion

	^wantsLineEndConversion == true and: [ lineEndConvention notNil ]! !

!MultiByteFileStream methodsFor: 'private basic' stamp: 'yo 8/28/2002 11:07'!
basicPeek

	^ super peek
! !

!MultiByteFileStream methodsFor: 'private basic' stamp: 'yo 8/28/2002 11:07'!
basicNext: n into: aString

	^ super next: n into: aString.
! !

!MultiByteFileStream methodsFor: 'public' stamp: 'LukasRenggli 5/8/2010 18:41'!
nextPut: aCharacter
	aCharacter isInteger 
		ifTrue: [ ^ super nextPut: aCharacter ].
	(wantsLineEndConversion == true and: [ lineEndConvention notNil ]) "#doConversion is inlined here"
		 ifTrue: [
			aCharacter = Cr
				ifTrue: [ converter nextPutAll: (LineEndStrings at: lineEndConvention) toStream: self ]
				ifFalse: [ converter nextPut: aCharacter toStream: self ].
			^aCharacter ].
	^ self converter nextPut: aCharacter toStream: self
! !

!MultiByteFileStream methodsFor: 'fileIn/Out' stamp: 'MarcusDenker 7/4/2014 11:02'!
nextChunk
	"Answer the contents of the receiver, up to the next terminator
	character. Doubled terminators indicate an embedded terminator
	character."
	self skipSeparators.
	^ self
		parseLangTagFor: (self basicChunk
				ifNil: [String
						new: 1000
						streamContents: [:stream | 
							| character state |
							[(character := self next) == nil
								or: [character == $!!
										and: [state := converter saveStateOf: self..
											self next ~~ $!!]]]
								whileFalse: [stream nextPut: character].
							character
								ifNotNil: [converter restoreStateOf: self with: state.]]])! !

!MultiByteFileStream methodsFor: 'private basic' stamp: 'yo 8/28/2002 11:07'!
basicNextInto: aString

	^ super nextInto: aString.
! !

!MultiByteFileStream methodsFor: 'public' stamp: 'ul 12/4/2009 19:08'!
upTo: delimiter

	^self collectionSpecies new: 1000 streamContents: [ :stream |
		| ch |
		[ (ch := self next) == nil or: [ ch = delimiter ] ] 
			whileFalse: [ stream nextPut: ch ] ]
! !

!MultiByteFileStream methodsFor: 'crlf private' stamp: 'yo 2/21/2004 02:56'!
convertStringToCr: aString 
	| inStream outStream |
	lineEndConvention ifNil: [^ aString].
	lineEndConvention == #cr ifTrue: [^ aString].
	lineEndConvention == #lf ifTrue: [^ aString copy replaceAll: Lf with: Cr].
	"lineEndConvention == #crlf"
	inStream := aString readStream.
	outStream := (String new: aString size) writeStream.
	[inStream atEnd]
		whileFalse: 
			[outStream nextPutAll: (inStream upTo: Cr).
			(inStream atEnd not or: [aString last = Cr])
				ifTrue: 
					[outStream nextPut: Cr.
					inStream peek = Lf ifTrue: [inStream next]]].
	^ outStream contents! !

!MultiByteFileStream methodsFor: 'public' stamp: 'ul 12/6/2009 04:18'!
upToEnd

	^self collectionSpecies
		new: self size - self position
		streamContents: [ :stream |
			| element |
			[ (element := self next) == nil ] whileFalse: [
				stream nextPut: element ] ]
! !

!MultiByteFileStream methodsFor: 'public' stamp: 'SvenVanCaekenberghe 12/3/2012 22:59'!
readInto: buffer startingAt: offset count: requestedCount
	"Read up to requestedCount elements into the given buffer starting at offset.
	Return the number of elements actually read.
	If I am binary or if buffer is a ByteArray, I skip decoding. Yes this is weird.
	This is a necessarily inefficient implementation, reading and decoding characters one by one."

	(self isBinary or: [ buffer class == ByteArray ])
		ifTrue: [ ^ super readInto: buffer startingAt: offset count: requestedCount ].
	0 to: requestedCount - 1 do: [ :count | 
		| element |
		(element := self next) ifNil: [ ^ count ].
		buffer at: offset + count put: element ].
	^ requestedCount! !

!MultiByteFileStream methodsFor: 'accessing' stamp: 'yo 8/6/2003 11:56'!
fileInEncodingName: aString

	self converter: (TextConverter newForEncoding: aString).
	super fileIn.
! !

!MultiByteFileStream class methodsFor: 'class initialization' stamp: 'yo 2/21/2004 02:44'!
initialize

	"MultiByteFileStream initialize"
	Cr := Character cr.
	Lf := Character lf.
	CrLf := String with: Cr with: Lf.
	LineEndStrings := Dictionary new.
	LineEndStrings at: #cr put: (String with: Character cr).
	LineEndStrings at: #lf put: (String with: Character lf).
	LineEndStrings at: #crlf put: (String with: Character cr with: Character lf).
	LookAheadCount := 2048.
	Smalltalk addToStartUpList: self.
	self startUp.
! !

!MultiByteFileStream class methodsFor: 'class initialization' stamp: 'yo 2/21/2004 02:45'!
defaultToCRLF

	"MultiByteFileStream defaultToCRLF"
	LineEndDefault := #crlf.! !

!MultiByteFileStream class methodsFor: 'accessing' stamp: 'StephaneDucasse 10/18/2010 14:05'!
lineEndDefault
	"Answer the default line-ending convention that will be used by default, which was determined at start-up by looking at platform attributes."
	^ LineEndDefault
! !

!MultiByteFileStream class methodsFor: 'class initialization' stamp: 'cami 7/22/2013 18:26'!
guessDefaultLineEndConvention
	"Lets try to guess the line end convention from what we know about the
	path name delimiter from FileDirectory."
	
	FileSystem disk delimiter = $:
		ifTrue: [^ self defaultToCR].
		
	FileSystem disk delimiter = $/
		ifTrue: [^ (Smalltalk os isMacOSX or: [Smalltalk os isUnix])
				ifTrue: [ self defaultToLF]
				ifFalse: [ self defaultToCR]].
			
	FileSystem disk delimiter = $\
		ifTrue: [^ self defaultToCRLF].
		
	"in case we don't know"
	^ self defaultToCR! !

!MultiByteFileStream class methodsFor: 'class initialization' stamp: 'yo 2/21/2004 02:46'!
defaultToLF

	"MultiByteFileStream defaultToLF"
	LineEndDefault := #lf.
! !

!MultiByteFileStream class methodsFor: 'instance creation' stamp: 'yo 8/28/2002 11:43'!
newFrom: aFileStream

	| rw n |
	n := aFileStream name.
	rw := aFileStream isReadOnly not.
	aFileStream close.
	^self new open: n forWrite: rw.
! !

!MultiByteFileStream class methodsFor: 'class initialization' stamp: 'yo 2/21/2004 02:44'!
startUp

	self guessDefaultLineEndConvention.
! !

!MultiByteFileStream class methodsFor: 'class initialization' stamp: 'yo 2/21/2004 02:45'!
defaultToCR

	"MultiByteFileStream defaultToCR"
	LineEndDefault := #cr.
! !

!MultiByteFileStreamTest commentStamp: 'TorstenBergmann 2/5/2014 10:18'!
SUnit tests for MultiByteFileStream 
!
!MultiByteFileStreamTest methodsFor: 'testing' stamp: 'SeanDeNigris 7/12/2012 08:44'!
testBinaryUpTo
	"This is a non regression test for bug http://bugs.squeak.org/view.php?id=6933"
	"self run: #testBinaryUpTo"
	
	| foo fileName |
	
	fileName := 'foobug6933'. 
	MultiByteFileStream 
		forceNewFileNamed: fileName 
		do: [ :stream | stream binary.
				stream nextPutAll: #[1 2 3 4] ].

	foo := MultiByteFileStream oldFileNamed: fileName.
	[foo binary.
		self assert: (foo upTo: 3) = #[1 2] 
	] ensure: [
		foo close.
 		fileName  asFileReference delete]. 
    ! !

!MultiByteFileStreamTest methodsFor: 'testing' stamp: 'HenrikSperreJohansen 5/19/2011 10:16'!
testLineEndingsWith: anEncodingName
	 | byteMap |
	"Make a map of different endings, and the expected byte pattern when three cr's are added using it"
	byteMap := Dictionary new.
	byteMap at: #cr put: #[13 13 13];
			at: #lf put: #[10 10 10];
			at: #crlf put: #[13 10 13 10 13 10].
	byteMap keysDo: [:lineEnding  |
		FileStream forceNewFileNamed: self lineEndTestFile do: [:stream | 
			stream 
				lineEndConvention: lineEnding;
				converter: (TextConverter newForEncoding: anEncodingName).
			"Test 3 cases: Use of nextPut, nextPutAll:, and nextPutAll with WideStrings"
			stream nextPut: Character cr;
					nextPutAll: Character cr asString;
					nextPutAll: Character cr asString asWideString.].
		FileStream oldFileNamed: self lineEndTestFile do: [:stream | | bytes expected| 
			bytes := stream binary; contents.
			self assert: bytes equals: (byteMap at: lineEnding)]]! !

!MultiByteFileStreamTest methodsFor: 'support' stamp: 'HenrikSperreJohansen 5/19/2011 09:53'!
lineEndTestFile
	^'lineEndTesting.txt'! !

!MultiByteFileStreamTest methodsFor: 'testing' stamp: 'SeanDeNigris 7/12/2012 08:44'!
testBasicChunk
	 | internalStream chunkKey |
	internalStream := self chunkString readStream.
	chunkKey := OrderedCollection new.
	[internalStream atEnd] whileFalse: 
		[ | chunk |
		chunk := internalStream nextChunk.
		chunkKey add: {internalStream position. chunk size. chunk}].
	[self writeChunkToFile.
	FileStream readOnlyFileNamed: 'chunkTest.txt' do: [:fileStream |
		1 to: chunkKey size do: [:ix | |chunk|
			chunk := fileStream nextChunk.
			self assert: (chunkKey at: ix) first equals: fileStream position.
			self assert: (chunkKey at: ix) second equals: chunk size.
			self assert: (chunkKey at: ix) last equals: chunk.]].
	] ensure: [
		 'chunkTest.txt' asFileReference delete]! !

!MultiByteFileStreamTest methodsFor: 'testing' stamp: 'StephaneDucasse 6/17/2013 15:55'!
tearDown
	'foobug6933' asFileReference ensureDelete.
	self lineEndTestFile asFileReference ensureDelete.! !

!MultiByteFileStreamTest methodsFor: 'support' stamp: 'HenrikSperreJohansen 2/9/2010 11:10'!
writeChunkToFile
	FileStream forceNewFileNamed: 'chunkTest.txt' do: [:stream | stream nextPutAll: self chunkString]! !

!MultiByteFileStreamTest methodsFor: 'testing' stamp: 'S 6/17/2013 13:16'!
testReadIntoStartingAtCount
	| testString filename buffer |
	testString := 'élève en Français'.
	filename := 'test-file-' , 99 atRandom printString , '.txt'.
	filename asFileReference ensureDelete.
	filename asFileReference
		writeStreamDo: [ :stream | 
			stream
				nextPutAll: testString;
				crlf ].
	buffer := String new: testString size.
	[ 
	filename asFileReference
		readStreamDo: [ :stream | 
			self assert: (stream readInto: buffer startingAt: 1 count: testString size) equals: testString size.
			self assert: buffer equals: testString ] ]
		ensure: [ filename asFileReference ensureDelete ]! !

!MultiByteFileStreamTest methodsFor: 'support' stamp: 'HenrikSperreJohansen 5/19/2011 09:53'!
chunkString
  "A chunk larger than buffer (currently 2048), but not long enough to fill it completely again. Therefore, buffer should contain some elements at end that are not part of the real buffer"
  | smallChunk chunkString |
  chunkString := 
  String new: (MultiByteFileStream new ascii enableReadBuffering braceArray size * 1.3) floor.
  smallChunk := 'ASDFASDFASDFASDFasdfasdfasdfasdfQWERQWERQWERqwerqwerqwer!! !!'.
  1 to: chunkString size by: smallChunk size do: [:ix |
    chunkString replaceFrom: ix to: (ix + smallChunk size -1 min: chunkString size) with: smallChunk startingAt: 1].
  ^chunkString! !

!MultiCanvas commentStamp: '<historical>'!
A canvas which forwards drawing commands to sub-canvases.!
!MultiCanvas methodsFor: 'accessing' stamp: 'RAA 8/14/2000 10:27'!
contentsOfArea: aRectangle into: aForm

	self apply: [ :c |
		(c isKindOf: FormCanvas) ifTrue: [
			c contentsOfArea: aRectangle into: aForm.
			^aForm
		].
	].
	self apply: [ :c |
		c contentsOfArea: aRectangle into: aForm.
		^aForm.
	].
	^aForm! !

!MultiCanvas methodsFor: 'accessing' stamp: 'ls 4/8/2000 22:35'!
extent
	^extent! !

!MultiCanvas methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 10:11'!
initialize
	super initialize.
	canvases := Set new.
	extent := 600@400.
	depth := 32. ! !

!MultiCanvas methodsFor: 'initialization' stamp: 'ls 4/8/2000 22:34'!
extent: newExtent
	"set the extent to be used with this canvas"
	extent := newExtent.! !

!MultiCanvas methodsFor: 'private' stamp: 'RAA 11/6/2000 14:17'!
apply: aCommand

	self flag: #roundedRudeness.	
	"This rudeness is to help get rounded corners to work right on RemoteCanvases. Since the RemoteCanvas has no other way to read its bits, we are grabbing them from Display for now. To support this, we need to see that the Display is written before any RemoteCanvases"

	canvases do: [ :canvas | 
		(canvas isKindOf: FormCanvas) ifTrue: [aCommand value: canvas]
	].
	canvases do: [ :canvas | 
		(canvas isKindOf: FormCanvas) ifFalse: [aCommand value: canvas]
	].
! !

!MultiCanvas methodsFor: 'initialization' stamp: 'ls 4/8/2000 22:35'!
depth: newDepth
	"set the extent to be used with this canvas"
	depth := newDepth.! !

!MultiCanvas methodsFor: 'accessing' stamp: 'ls 3/20/2000 20:48'!
removeCanvas: aCanvas
	canvases remove: aCanvas ifAbsent: []! !

!MultiCanvas methodsFor: 'initialization' stamp: 'RAA 8/1/2000 13:50'!
allocateForm: extentPoint
	"Allocate a new form which is similar to the receiver and can be used for accelerated blts"
	^Form extent: extentPoint depth: self depth! !

!MultiCanvas methodsFor: 'accessing' stamp: 'RAA 11/7/2000 17:46'!
clipRect
	
	^super clipRect ifNil: [
		0@0 extent: 5000@5000
	].! !

!MultiCanvas methodsFor: 'accessing' stamp: 'ls 3/20/2000 20:48'!
addCanvas: aCanvas
	canvases add: aCanvas! !

!MultiCanvas methodsFor: 'accessing' stamp: 'ls 4/8/2000 22:35'!
depth
	^depth! !

!MultiColumnListModel commentStamp: '<historical>'!
A MultiColumnListModel is a spec model for Multi columns list!
!MultiColumnListModel methodsFor: 'morphic' stamp: 'BenjaminVanRyseghem 7/14/2012 16:41'!
listElementAt: anIndex

	^ self wrapItem: (self listItems at: anIndex) index: anIndex ! !

!MultiColumnListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:52'!
setSelectedIndex: anIndex
	"<api: #integer min: 0 max: #listSize getter: #selectedIndex registration: #whenSelectionIndexChanged:>"
	"Set the index of the item you want to be selected"
	| idx selection |
	
	self allowToSelect ifFalse: [ ^ self ].
	self okToChange ifFalse: [ ^ self ].
	self listSize isZero ifTrue:  [ ^self ].
	idx := anIndex min: self listSize.
	selection := self listItems 
					at: idx 
					ifAbsent: [ idx := 0.
								nil ].
	
	selectionHolder index value: idx.
	selectionHolder selection value: selection.! !

!MultiColumnListModel methodsFor: 'morphic' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
setIndex: anIndex

	self allowToSelect ifFalse: [ ^ self ].
	self okToChange ifFalse: [ ^ self ].
	selectionHolder index value: anIndex.
	selectionHolder selection value: (self listItems at: anIndex ifAbsent: [ nil ]).! !

!MultiColumnListModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/1/2013 13:38'!
defaultSpec
	<spec: #default>
	
	^ #(MultiColumnListAdapter
		adapt: #(model))! !

!MultiColumnListModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/13/2014 15:21'!
adapterName

	^ #MultiColumnListAdapter! !

!MultiFontTest methodsFor: '*Multilingual-Tests-OtherLanguages' stamp: 'MarcusDenker 7/5/2014 19:03'!
testMultistringFont
	"self debug: #testMultistringFont"
	| text p style height width |
	[(TextStyle default fontArray at: JapaneseEnvironment leadingChar)
		ifNil: [^ self]]
		ifError: [ ^ self].
	text := ((#(20983874 20983876 20983878 )
				collect: [:e | e asCharacter])
				as: String) asText.
	p := Paragraph new.
	style := TextStyle default.
	p
		compose: text
		style: style
		from: 1
		in: (0 @ 0 corner: 100 @ 100).
	"See CompositionScanner>>setActualFont: &  
	CompositionScanner>>composeFrom:inRectangle:firstLine:leftSide:rightSide:"
	height := style defaultFont height + style leading.
	width := text
				inject: 0
				into: [:tally :next | tally
						+ (style defaultFont widthOf: next)].
	p adjustRightX.
	self assert: p extent = (width @ height).
	"Display getCanvas
		paragraph: p
		bounds: (10 @ 10 extent: 100 @ 100)
		color: Color black"! !

!MulticolumnLazyListMorph commentStamp: '<historical>'!
A variant of LazyListMorph that can display multi-column lists.!
!MulticolumnLazyListMorph methodsFor: 'row management' stamp: 'BenjaminVanRyseghem 2/21/2013 23:17'!
display: items atRow: row on: canvas
	"display the specified item, which is on the specified row; for Multicolumn 
	lists, items will be a list of strings"

	| drawBounds backgroundColor |
	backgroundColor := self backgroundColorForRow: row.
	drawBounds := self drawBoundsForRow: row.
	drawBounds := drawBounds
		intersect: self bounds
		ifNone: [ 
			"oh well"
			^ self ].
	items
		with: (1 to: items size)
		do: [ :item :index | 
			"move the bounds to the right at each step"
			index > 1
				ifTrue: [ drawBounds := drawBounds left: drawBounds left + listSource gapSize + (columnWidths at: index - 1) ].
			item
				listRenderOn: canvas
				atRow: row
				bounds: drawBounds
				color: color
				backgroundColor: backgroundColor
				from: self ]! !

!MulticolumnLazyListMorph methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 9/8/2011 12:33'!
drawOn: aCanvas
	self getListSize = 0 ifTrue:[ ^self ].

	self setColumnWidthsFor: aCanvas.
	self adjustWidth.
	
	super drawOn: aCanvas! !

!MulticolumnLazyListMorph methodsFor: 'scroll range' stamp: 'BenjaminVanRyseghem 2/12/2012 00:26'!
widthToDisplayItem: item
	"This class will be removed soon, so this method will disappear"
	| widths |
	
	widths := item collect: [ :each | each widthToDisplayInList: self ].
	^widths sum + ((listSource gapSize + 4) * (widths size - 1))   "add in space between the columns"
! !

!MulticolumnLazyListMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/17/2015 16:13'!
drawOnAthensCanvas: anAthensCanvas
	self getListSize = 0 ifTrue:[ ^self ].

	self setColumnWidthsFor: anAthensCanvas.
	self adjustWidth.
	
	super drawOnAthensCanvas: anAthensCanvas! !

!MulticolumnLazyListMorph methodsFor: 'as yet unclassified' stamp: 'BenjaminVanRyseghem 7/25/2012 11:57'!
drawBoundsForRow: row
	"calculate the bounds that row should be drawn at.  This might be outside our bounds!!"
	| topLeft drawBounds item width height |
	
	item := self getListItem: row.
	height := (item collect: [:e | e heightToDisplayInList: self ]) max.
	width := self width.
		
	topLeft := self topLeft x @ (self topLeft y + ((row - 1) * (height))).
	drawBounds := topLeft extent: (width @ height).
	^drawBounds! !

!MulticolumnLazyListMorph methodsFor: 'drawing' stamp: 'sps 3/23/2004 15:51'!
setColumnWidthsFor: aCanvas
        | row topRow bottomRow |
        "set columnWidths for drawing on the specified canvas"
		columnWidths ifNil: [
		columnWidths := (self item: 1) collect: [ :ignored | 0 ]. ].
	topRow := (self topVisibleRowForCanvas: aCanvas) max: 1.
	bottomRow :=  (self bottomVisibleRowForCanvas: aCanvas) max: 1.
	topRow > bottomRow ifTrue: [ ^ self ].
	topRow to: bottomRow do: [ :rowIndex |
                row := self item: rowIndex.
                columnWidths := columnWidths with: row collect: [ :currentWidth :item |
				| widthOfItem |
				widthOfItem := (font widthOfStringOrText: item).
				widthOfItem > currentWidth
					ifTrue: [ self changed.  widthOfItem ]
					ifFalse: [ currentWidth ] ] ]! !

!MulticolumnLazyListMorph methodsFor: 'row management' stamp: 'ls 5/18/2001 16:43'!
listChanged
	columnWidths := nil.
	super listChanged! !

!MulticolumnLazyListMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/17/2015 16:11'!
athensDisplay: items atRow: row on: anAthensCanvas
	| drawBounds backgroundColor |
	backgroundColor := self backgroundColorForRow: row.
	drawBounds := self drawBoundsForRow: row.
	drawBounds := drawBounds
		intersect: self bounds
		ifNone: [ 
			"oh well"
			^ self ].
	items
		with: (1 to: items size)
		do: [ :item :index | 
			"move the bounds to the right at each step"
			index > 1
				ifTrue: [ drawBounds := drawBounds left: drawBounds left + listSource gapSize + (columnWidths at: index - 1) ].
			anAthensCanvas
				morphicDrawString: item asString
				at: drawBounds topLeft
				font: self font
				color: color]! !

!MulticolumnLazyListMorph methodsFor: 'list access' stamp: 'BenjaminVanRyseghem 2/15/2012 16:52'!
item: index
	"return the index-th item, using the 'listItems' cache"
	| newItem itemWidth |
	(index between: 1 and: listItems size)
		ifFalse: [ "there should have been an update, but there wasn't!!"  ^self getListItem: index].
	(listItems at: index) ifNil: [ 
		newItem := self getListItem: index.

		maxWidth ifNotNil:[
			itemWidth := self widthToDisplayItem: newItem.
			itemWidth > maxWidth ifTrue:[
				maxWidth := itemWidth.
				self adjustWidth.
			]].
		listItems at: index put: newItem ].
	^listItems at: index! !

!MulticolumnLazyListMorph methodsFor: 'scroll range' stamp: 'BenjaminVanRyseghem 2/19/2012 18:22'!
hUnadjustedScrollRange
"bvr - Introduce here the old version of the super method just waiting for this class to be deleted"

	| itemsToCheck item index |
	"Check for a cached value"
	maxWidth ifNotNil:[^maxWidth].

	listItems isEmpty ifTrue: [^0]. "don't set maxWidth if empty do will be recomputed when there are some items"
	"Compute from scratch"
	itemsToCheck := 30 min: (listItems size).
	maxWidth := 0. 

	"Check the first few items to get a representative sample of the rest of the list."
	index := 1.
	[index < itemsToCheck] whileTrue:
		[ item := self getListItem: index. "Be careful not to actually install this item"
		maxWidth := maxWidth max: (self widthToDisplayItem: item).
		index:= index + 1.
		].

	"Add some initial fudge if we didn't check all the items."
	(itemsToCheck < listItems size) ifTrue:[maxWidth := maxWidth*2].

	^maxWidth + 150
! !

!MulticolumnLazyListMorph methodsFor: 'list access' stamp: 'ls 5/17/2001 21:23'!
getListItem: index
	^listSource getListRow: index! !

!MultipleMethodsEditor commentStamp: '<historical>'!
A MultipleMethodsEditor is a widget to edit multiple methods in one widget!
!MultipleMethodsEditor methodsFor: 'updating' stamp: 'IgorStasenko 12/19/2012 18:04'!
updateLayoutForMultiple

	self 
		addMorph: container
		fullFrame: (LayoutFrame identity
						bottomOffset: -25).
	self 
		addMorph: buttonsContainer
		fullFrame:  ((0@1 corner: 1@1) asLayoutFrame 
						topOffset: -25).! !

!MultipleMethodsEditor methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 8/5/2012 19:47'!
hasSingleElement

	^ editors size = 1! !

!MultipleMethodsEditor methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 8/6/2012 19:33'!
setDefault

	current := editors first! !

!MultipleMethodsEditor methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 8/5/2012 21:41'!
addEditor: anEditor

	editors addFirst: anEditor.
	anEditor 
		vResizing: #spaceFill;
		hResizing: #spaceFill.
	
	anEditor when: #vScroll send: #scrollFromEditor: to: self.

	current := anEditor.
	self updateScroller! !

!MultipleMethodsEditor methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 8/6/2012 18:25'!
updateButtonsStateFrom: aModel

	(buttonsContainer submorphs last: (editors size+1)) do:[:e | 
		e model == aModel 
			ifFalse: [ e model setState: false ].
		e update: #state ]! !

!MultipleMethodsEditor methodsFor: 'private' stamp: 'BenjaminVanRyseghem 8/6/2012 18:01'!
newButtonFor: e value: buttonValue label: label
	| model |

	model := MultipleMethodsEditorButtonModel
		on: self
		value: buttonValue
		label: label
		target: e.
		
	^ PluggableButtonMorph
		on: model
		getState: #state
		action: #action
		label: #label! !

!MultipleMethodsEditor methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 8/6/2012 18:00'!
newAllButton
	
	| model |
	model := MultipleMethodsEditorAllButtonModel on: self.
	
	^ PluggableButtonMorph
			on: model
			getState: #state
			action: #action
			label: #label! !

!MultipleMethodsEditor methodsFor: 'private' stamp: 'BenjaminVanRyseghem 8/5/2012 22:04'!
newProportionalPanelMorph
	| panel |
	panel := PanelMorph new
		color: Color white;
		changeProportionalLayout;
		yourself.
	^ panel! !

!MultipleMethodsEditor methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 8/6/2012 17:59'!
addAllButton
	
	buttonsContainer addMorph: self newAllButton! !

!MultipleMethodsEditor methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 8/6/2012 18:08'!
updateEditorsWith: firstHeight over: totalHeight into: panel
	| cumulatedHeight size |
	
	size := editors size.
	cumulatedHeight := 0.
	editors
		doWithIndex: [ :e :i | 
			| height newCumulatedHeight  |
			height := i == 1
				ifTrue: [ firstHeight ]
				ifFalse: [ 
					e vResizing: #rigid.
					e height ].
			newCumulatedHeight := cumulatedHeight + (height / totalHeight).
			panel addMorph: e fullFrame: (self layoutFor: i startingAt: cumulatedHeight finishingAt: newCumulatedHeight).
			i == size
				ifFalse: [ 
					| below |
					below := editors at: i + 1.
					self
						addSplitterBetween: e
						and: below
						to: panel
						at: newCumulatedHeight ].
			cumulatedHeight := newCumulatedHeight ]! !

!MultipleMethodsEditor methodsFor: 'initialization' stamp: 'EstebanLorenzano 10/16/2013 09:22'!
initialize

	super initialize.
	self changeProportionalLayout.
	"self color: Color white."
	lock := false.
	buttonsContainer := PanelMorph new
							changeTableLayout;
							listDirection: #rightToLeft;
							hResizing: #spaceFill;
							vResizing: #spaceFill;
							yourself.
							
	editors := OrderedCollection new.
	container := self newProportionalPanelMorph.
					
	self updateLayoutForSingle! !

!MultipleMethodsEditor methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 8/6/2012 18:04'!
setCurrent: anEditor

	(editors includes: anEditor) ifFalse: [ ^ self ].
	current := anEditor! !

!MultipleMethodsEditor methodsFor: 'private' stamp: 'BenjaminVanRyseghem 8/5/2012 22:04'!
addHFill
	buttonsContainer
		addMorph:
			(Morph new
				hResizing: #spaceFill;
				height: 0;
				yourself)! !

!MultipleMethodsEditor methodsFor: 'protocol' stamp: 'CamilloBruni 9/17/2012 21:18'!
giveFocusToDefault

	self hasSingleElement ifTrue: [ ^ self ].
	buttonsContainer submorphs copy reversed second model action! !

!MultipleMethodsEditor methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 8/5/2012 19:47'!
hasMultipleElements

	^ editors size > 1! !

!MultipleMethodsEditor methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 8/6/2012 18:10'!
updateScrollerWithMultipleElements
	| size panel totalHeight delta scroller firstHeight |
	
	delta := editors second font height * 2 + 10.
	size := editors size.
	firstHeight := self height - delta.
	
	totalHeight := (editors allButFirst inject: 0 into: [ :s :e | s + e height ]) + firstHeight + ((size - 1) * 4).
	
	panel := self newProportionalPanelMorph.
	
	scroller := TransformWithLayoutMorphForMultipleEditors new.
	container := self newScrollPaneWithScroller: scroller target: panel.
	container scroller changeTableLayout.
	
	self updateEditorsWith: firstHeight over: totalHeight into: panel.

	self addAllButton.
	self addButtons.
	
	self addHFill.
	
	panel hResizing: #spaceFill.
	panel extent: 0 @ (totalHeight - delta)! !

!MultipleMethodsEditor methodsFor: 'private' stamp: 'BenjaminVanRyseghem 8/6/2012 18:06'!
newButtonFor: e label: label
	| model |

	model := MultipleMethodsEditorButtonModel
		on: self
		label: label
		target: e.
		
	^ PluggableButtonMorph
		on: model
		getState: #state
		action: #action
		label: #label! !

!MultipleMethodsEditor methodsFor: 'private' stamp: 'IgorStasenko 12/20/2012 14:43'!
layoutFor: i startingAt: cumulatedHeight finishingAt: newCumulatedHeight

	^ (0 @ cumulatedHeight corner: 1 @ newCumulatedHeight) asLayoutFrame
		topOffset: (i == 1 ifTrue: [ 0 ] ifFalse: [ 2 ]);
		bottomOffset: (i == editors size ifTrue: [ 0 ] ifFalse: [ -2 ])! !

!MultipleMethodsEditor methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 8/6/2012 18:23'!
updateScrollerWithMultipleElementsWithoutButtons
	| size panel totalHeight delta scroller firstHeight |
	
	delta := editors second font height * 2 + 10.
	size := editors size.
	firstHeight := self height - delta.
	
	totalHeight := (editors allButFirst inject: 0 into: [ :s :e | s + e height ]) + firstHeight + ((size - 1) * 4).
	
	panel := self newProportionalPanelMorph.
	
	scroller := TransformWithLayoutMorphForMultipleEditors new.
	container := self newScrollPaneWithScroller: scroller target: panel.
	container scroller changeTableLayout.
	
	self updateEditorsWith: firstHeight over: totalHeight into: panel.
	
	panel hResizing: #spaceFill.
	panel extent: 0 @ (totalHeight - delta)! !

!MultipleMethodsEditor methodsFor: 'private' stamp: 'BenjaminVanRyseghem 8/5/2012 21:40'!
scrollFromEditor: aValue
	
	self hasMultipleElements ifFalse: [ ^ self ].
	lock ifTrue: [ ^ self ].
	lock := true.

	aValue = 0
		ifTrue: [ container vScrollbar setValue: container vScrollbar value - 0.1 ].

	aValue = 1
		ifTrue: [ container vScrollbar setValue: container vScrollbar value + 0.1 ].
		
	lock := false! !

!MultipleMethodsEditor methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 8/6/2012 18:13'!
addButtons
	editors
		doWithIndex: [ :e :i | 
			| button |
			(i == 1)
				ifTrue: [ 
					button := self newButtonFor: e label: 'current']
				ifFalse: [ 
					button := self newButtonFor: e label: (i-1) printString .
					button setBalloonText: e balloonText ].
			buttonsContainer addMorph: button ]! !

!MultipleMethodsEditor methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 8/5/2012 22:11'!
updateScrollerWithOneElement
		
	"container 
		addMorph: current
		fullFrame: (LayoutFrame fractions: (0@0 corner: 1@1))"! !

!MultipleMethodsEditor methodsFor: 'private' stamp: 'BenjaminVanRyseghem 8/5/2012 21:49'!
newScrollPaneWithScroller: scroller target: target
	| pane |
	
	pane := GeneralScrollPane new
						removeAllMorphs;
						scroller: scroller;
						yourself.

	pane
		scrollTarget: target;
		addMorph: scroller;
		resizeScroller;
		hScrollbarShowNever.
		
	^ pane! !

!MultipleMethodsEditor methodsFor: 'private' stamp: 'IgorStasenko 12/19/2012 18:02'!
addSplitterBetween: e and: below to: panel at: newCumulatedHeight
	| splitter |
	splitter := ProportionalSplitterMorph new
		beSplitsTopAndBottom;
		yourself.
	splitter
		addLeftOrTop: e;
		addRightOrBottom: below.
	panel
		addMorph: splitter
		fullFrame: ((0 @ newCumulatedHeight corner: 1 @ newCumulatedHeight) asLayoutFrame 
						topOffset: -2 ;
						bottomOffset: 2)! !

!MultipleMethodsEditor methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 8/6/2012 19:36'!
rgiveFocusToCurrent

	self hasSingleElement ifTrue: [ ^ self ].
	self setDefault.
	self updateLayoutForSingleWithButtons! !

!MultipleMethodsEditor methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 8/6/2012 00:55'!
removeEditor: anEditor

	editors remove: anEditor.
	current = anEditor
		ifTrue: [ current := editors at: 1 ifAbsent:[ nil ]].

	self updateScroller! !

!MultipleMethodsEditor methodsFor: 'updating' stamp: 'EstebanLorenzano 4/29/2014 11:26'!
updateLayoutForSingleWithButtons
	current ifNil: [ ^ self ].	
	self 
		addMorph: current
		fullFrame: (LayoutFrame identity 
						bottomOffset: -25).				
	self 
		addMorph: buttonsContainer
		fullFrame: ((0@1 corner: 1@1) asLayoutFrame 
						topOffset: -25).
	"current color: Color white."
! !

!MultipleMethodsEditor methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 8/5/2012 21:41'!
updateScroller

	container removeAllMorphs.
	buttonsContainer removeAllMorphs.
	
	self hasSingleElement
		ifTrue: [ 
			self 
				updateScrollerWithOneElement;
				updateLayoutForSingle]
		ifFalse: [ 
			self 
				updateScrollerWithMultipleElements;
				updateLayoutForMultiple ].
	! !

!MultipleMethodsEditor methodsFor: 'updating' stamp: 'EstebanLorenzano 11/20/2013 14:20'!
updateLayoutForSingle

	current ifNil: [ ^ self ].
	self 
		addMorph: current
		fullFrame: LayoutFrame identity.
					
	"current color: Color white."
! !

!MultipleMethodsEditorAllButtonModel commentStamp: '<historical>'!
I am model for multiple methods editor (the -All- button)!
!MultipleMethodsEditorAllButtonModel methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 23:05'!
initialize

	super initialize.

	state := true.! !

!MultipleMethodsEditorAllButtonModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 8/6/2012 18:00'!
model
	^ model! !

!MultipleMethodsEditorAllButtonModel methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 8/6/2012 18:18'!
state

	^ state! !

!MultipleMethodsEditorAllButtonModel methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 8/6/2012 17:58'!
label

	^ 'All'! !

!MultipleMethodsEditorAllButtonModel methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 8/6/2012 18:22'!
setState: aBoolean

	state := aBoolean! !

!MultipleMethodsEditorAllButtonModel methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 8/6/2012 18:24'!
action

	self model 
		updateScrollerWithMultipleElementsWithoutButtons;
		updateLayoutForMultiple.
	state := true.
	self changed: #state.
	self model updateButtonsStateFrom: self! !

!MultipleMethodsEditorAllButtonModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 8/6/2012 18:00'!
model: anObject
	model := anObject! !

!MultipleMethodsEditorAllButtonModel class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 8/6/2012 18:00'!
on: aModel

	^ self new
		model: aModel;
		yourself! !

!MultipleMethodsEditorButtonModel commentStamp: '<historical>'!
A MultipleMethodsEditorButtonModel is a ButtonModel created for MultipleMethodsEditor!
!MultipleMethodsEditorButtonModel methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 23:05'!
initialize

	super initialize.

	state := false! !

!MultipleMethodsEditorButtonModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 8/6/2012 18:02'!
model

	^ model! !

!MultipleMethodsEditorButtonModel methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 8/6/2012 18:18'!
state

	^ state! !

!MultipleMethodsEditorButtonModel methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 8/5/2012 20:01'!
label

	^ label 
		ifNil: [ '' ]
		ifNotNil: [:l | l ]! !

!MultipleMethodsEditorButtonModel methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 8/6/2012 18:26'!
setState: aBoolean 

	state := aBoolean! !

!MultipleMethodsEditorButtonModel methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 8/6/2012 18:17'!
action

	self model ifNil: [ ^ self ].
	self target ifNil: [ ^ self ].
	
	self target vScrollValue: 0.
	self model setCurrent: self target.
	self model updateLayoutForSingleWithButtons.
	state := true.
	self changed: #state.
	self model updateButtonsStateFrom: self! !

!MultipleMethodsEditorButtonModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 8/5/2012 19:59'!
label: anObject
	label := anObject! !

!MultipleMethodsEditorButtonModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 8/6/2012 18:02'!
model: anObject

	model := anObject! !

!MultipleMethodsEditorButtonModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 8/5/2012 21:42'!
target
	^ target! !

!MultipleMethodsEditorButtonModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 8/5/2012 21:42'!
target: anObject
	target := anObject! !

!MultipleMethodsEditorButtonModel class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 8/6/2012 18:04'!
on: aScroller value: value label: label target: target

	^ self new
		model: aScroller;
		vScrollValue: value;
		label: label;
		target: target;
		yourself! !

!MultipleMethodsEditorButtonModel class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 8/6/2012 18:07'!
on: aScroller label: label target: target

	^ self new
		model: aScroller;
		label: label;
		target: target;
		yourself! !

!MultipleSettingDeclaration commentStamp: 'TorstenBergmann 1/31/2014 10:30'!
A declaration for multiple settings!
!MultipleSettingDeclaration methodsFor: 'accessing' stamp: 'AlainPlantec 9/3/2010 15:51'!
domainValues
	^ domainValues ifNil: [domainValues := OrderedCollection new]! !

!MultipleSettingDeclaration methodsFor: 'user interface' stamp: 'AlainPlantec 11/25/2009 22:09'!
hasEditableList
	^ false! !

!MultipleSettingDeclaration methodsFor: 'user interface' stamp: 'AlainPlantec 9/3/2010 17:04'!
fixedDomainValueNodeForAssociation: anAssociation 
	| s |
	^ (s := (SettingDeclaration new name: anAssociation key))
		target: s;
		selector: #default;
		default: anAssociation value! !

!MultipleSettingDeclaration methodsFor: 'accessing' stamp: 'AlainPlantec 11/25/2009 22:09'!
domainValues: aCollection 
	domainValues := aCollection asArray collect: [ :v | v settingFixedDomainValueNodeFrom: self]! !

!MultipleSettingDeclaration methodsFor: 'user interface' stamp: 'AlainPlantec 11/25/2009 22:09'!
domainValuesLabels
	^ self domainValues
		collect: [:f | f name]! !

!MultipleSettingDeclaration methodsFor: 'user interface' stamp: 'AlainPlantec 9/3/2010 17:04'!
fixedDomainValueNodeForObject: anObject 
	| s |
	^ (s := (SettingDeclaration new name: anObject asString))
		target: s;
		selector: #default;
		default: anObject! !

!MultistateButtonMorph commentStamp: 'gvc 10/21/2008 13:27'!
A simple button that handles multiple fillstyle states:
	Normal
	Mouse-over
	Mouse-down-inside
	Mouse-down outside	
with variants being a combination of passive/active and enabled/disabled.!
!MultistateButtonMorph methodsFor: 'accessing' stamp: 'gvc 10/21/2008 13:28'!
enabled
	"Answer whether the button is rnabled."

	^enabled! !

!MultistateButtonMorph methodsFor: 'visual properties' stamp: 'gvc 10/21/2008 16:44'!
passiveDisabledNotOverDownFillStyle: aFillStyle
	"Set the passive, disabled, notOver, down fill style."

	self stateMap atPath: #(passive disabled notOver down) put: aFillStyle.
	self changed! !

!MultistateButtonMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/22/2008 11:34'!
mouseUp: evt 
	"Handle a mouse up event."
	
	super mouseUp: evt.
	self enabled ifFalse: [^self].
	self down: false.
	(self containsPoint: evt cursorPoint)
		ifTrue: [self triggerEvent: #up]
		ifFalse: [self triggerEvent: #upOutside]! !

!MultistateButtonMorph methodsFor: 'visual properties' stamp: 'gvc 10/21/2008 16:44'!
passiveEnabledNotOverUpFillStyle: aFillStyle
	"Set the passive, enabled, notOver, up fill style."

	self stateMap atPath: #(passive enabled notOver up) put: aFillStyle.
	self changed! !

!MultistateButtonMorph methodsFor: 'visual properties' stamp: 'gvc 10/21/2008 16:17'!
activeDisabledOverUpFillStyle: aFillStyle
	"Set the active, disabled, over, up fill style."

	self stateMap atPath: #(active disabled over up) put: aFillStyle.
	self changed! !

!MultistateButtonMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/21/2008 16:32'!
handlesMouseDown: evt
	"Yes."
	
	^true! !

!MultistateButtonMorph methodsFor: 'accessing' stamp: 'gvc 10/21/2008 15:57'!
over: anObject
	"Set the value of over"

	over := anObject.
	self changed! !

!MultistateButtonMorph methodsFor: 'visual properties' stamp: 'gvc 10/21/2008 16:17'!
activeEnabledOverDownFillStyle: aFillStyle
	"Set the active, enabled, over, down fill style."

	self stateMap atPath: #(active enabled over down) put: aFillStyle.
	self changed! !

!MultistateButtonMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/21/2008 16:27'!
handlesMouseOver: anEvent
	"Answer true, otherwise what is all that
	#mouseEnter:/#mouseLeave: stuff about?"

	^true! !

!MultistateButtonMorph methodsFor: 'updating' stamp: 'gvc 9/11/2009 17:05'!
changed
	"Update the fillStyle here."
	
	self assureExtension.
	extension fillStyle: self fillStyleToUse.
	color := self fillStyle asColor.
	super changed! !

!MultistateButtonMorph methodsFor: 'visual properties' stamp: 'gvc 10/21/2008 15:55'!
activeEnabledNotOverDownFillStyle: aFillStyle
	"Set the active, enabled, notOver, down fill style."

	self stateMap atPath: #(active enabled notOver down) put: aFillStyle.
	self changed! !

!MultistateButtonMorph methodsFor: 'accessing' stamp: 'gvc 10/21/2008 13:31'!
over
	"Answer the value of over"

	^ over! !

!MultistateButtonMorph methodsFor: 'initialization' stamp: 'gvc 10/21/2008 16:07'!
initialize
	"Initialize the receiver."

	self stateMap: KeyedTree new.
	enabled := true.
	active := true.
	over := false.
	down := false.
	super initialize! !

!MultistateButtonMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/21/2008 16:31'!
mouseEnterDragging: evt
	"Handle a mouseEnterDragging event, meaning the mouse just entered my bounds with a button pressed or laden with submorphs."

	super mouseEnterDragging: evt.
	self over: true! !

!MultistateButtonMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/22/2008 11:38'!
addUpAction: anActionOrBlock
	"Add an up event handler."
	
	self when: #up evaluate: anActionOrBlock! !

!MultistateButtonMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/21/2008 16:30'!
mouseLeaveDragging: evt
	"Handle a mouseLeaveLaden event, meaning the mouse just left my bounds with a button pressed or laden with submorphs."

	super mouseLeaveDragging: evt.
	self over: false! !

!MultistateButtonMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/21/2008 16:34'!
handlesMouseOverDragging: evt
	"Yes, for other states."
	
	^true! !

!MultistateButtonMorph methodsFor: 'accessing' stamp: 'gvc 10/21/2008 15:57'!
enabled: anObject
	"Set the value of enabled"

	enabled := anObject.
	self changed! !

!MultistateButtonMorph methodsFor: 'visual properties' stamp: 'gvc 10/21/2008 16:44'!
passiveDisabledOverDownFillStyle: aFillStyle
	"Set the passive, disabled, over, down fill style."

	self stateMap atPath: #(passive disabled over down) put: aFillStyle.
	self changed! !

!MultistateButtonMorph methodsFor: 'visual properties' stamp: 'gvc 10/21/2008 16:16'!
activeDisabledNotOverUpFillStyle: aFillStyle
	"Set the active, disabled, notOver, up fill style."

	self stateMap atPath: #(active disabled notOver up) put: aFillStyle.
	self changed! !

!MultistateButtonMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/21/2008 16:50'!
activate
	"Make active."

	super activate.
	self active: true! !

!MultistateButtonMorph methodsFor: 'accessing' stamp: 'gvc 10/21/2008 13:28'!
stateMap: anObject
	"Set the value of stateMap"

	stateMap := anObject! !

!MultistateButtonMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/22/2008 12:32'!
extent: aPoint
	"Center the fill style origin."
	
	|delta|
	self bounds extent = aPoint ifTrue: [^self].
	delta := aPoint - self extent // 2.
	self fillStyles do: [:fs | fs isOrientedFill ifTrue: [fs origin: fs origin + delta]].
	super extent: aPoint! !

!MultistateButtonMorph methodsFor: 'accessing' stamp: 'gvc 10/21/2008 15:57'!
down: anObject
	"Set the value of down"

	down := anObject.
	self changed! !

!MultistateButtonMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/22/2008 11:38'!
addDownAction: anActionOrBlock
	"Add a down event handler."
	
	self when: #down evaluate: anActionOrBlock! !

!MultistateButtonMorph methodsFor: 'visual properties' stamp: 'gvc 10/21/2008 16:44'!
passiveDisabledNotOverUpFillStyle: aFillStyle
	"Set the passive, disabled, notOver, up fill style."

	self stateMap atPath: #(passive disabled notOver up) put: aFillStyle.
	self changed! !

!MultistateButtonMorph methodsFor: 'accessing' stamp: 'gvc 10/21/2008 13:28'!
active
	"Answer the value of active"

	^ active! !

!MultistateButtonMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/21/2008 16:11'!
privateMoveBy: delta
	"Adjust all the fill styles"
	
	super privateMoveBy: delta.
	(self fillStyles copyWithout: self fillStyle) do: [:fs | fs isOrientedFill ifTrue: [fs origin: fs origin + delta]]! !

!MultistateButtonMorph methodsFor: 'accessing' stamp: 'gvc 10/21/2008 15:57'!
active: anObject
	"Set the value of active"

	active := anObject.
	self changed! !

!MultistateButtonMorph methodsFor: 'visual properties' stamp: 'gvc 10/21/2008 16:45'!
passiveEnabledOverUpFillStyle: aFillStyle
	"Set the passive, enabled, over, up fill style."

	self stateMap atPath: #(passive enabled over up) put: aFillStyle.
	self changed! !

!MultistateButtonMorph methodsFor: 'accessing' stamp: 'gvc 10/21/2008 13:31'!
down
	"Answer the value of down"

	^ down! !

!MultistateButtonMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/22/2008 11:39'!
removeUpActions
	"Remove all up event handlers"
	
	self removeActionsForEvent: #up! !

!MultistateButtonMorph methodsFor: 'visual properties' stamp: 'gvc 10/21/2008 15:55'!
activeEnabledNotOverUpFillStyle: aFillStyle
	"Set the active, enabled, notOver, up fill style."

	self stateMap atPath: #(active enabled notOver up) put: aFillStyle.
	self changed! !

!MultistateButtonMorph methodsFor: 'visual properties' stamp: 'gvc 10/21/2008 16:13'!
fillStyles
	"Answer all the fill styles"
	
	|styles|
	styles := OrderedCollection new.
	self stateMap do: [:actives |
		actives do: [:enableds |
			enableds do: [:overs |
				overs do: [:fs | styles add: fs]]]].
	^styles! !

!MultistateButtonMorph methodsFor: 'visual properties' stamp: 'gvc 10/21/2008 16:44'!
passiveEnabledNotOverDownFillStyle: aFillStyle
	"Set the passive, enabled, notOver, down fill style."

	self stateMap atPath: #(passive enabled notOver down) put: aFillStyle.
	self changed! !

!MultistateButtonMorph methodsFor: 'visual properties' stamp: 'gvc 10/21/2008 15:55'!
activeEnabledOverUpFillStyle: aFillStyle
	"Set the active, enabled, over, up fill style."

	self stateMap atPath: #(active enabled over up) put: aFillStyle.
	self changed! !

!MultistateButtonMorph methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 2/1/2011 14:25'!
mouseEnter: evt
	"Handle a mouseEnter event, meaning the mouse just entered my bounds with no button pressed."

	super mouseEnter: evt.
	self over: true! !

!MultistateButtonMorph methodsFor: 'visual properties' stamp: 'GaryChambers 2/15/2011 15:43'!
labelGraphic: anObject
	"do nothing. this is a hack to make this multistate button work with a menu on a system window.
	Need to refactor menu boxes!!"! !

!MultistateButtonMorph methodsFor: 'visual properties' stamp: 'gvc 10/21/2008 16:01'!
fillStyleToUse
	"Answer the fill style to used based on the current state."

	|map|
	map := self active
		ifTrue: [self stateMap at: #active ifAbsent: [self stateMap at: #passive ifAbsent: [Dictionary new]]]
		ifFalse: [self stateMap at: #passive ifAbsent: [self stateMap at: #active ifAbsent: [Dictionary new]]].
	map := self enabled
		ifTrue: [map at: #enabled ifAbsent: [map at: #disabled ifAbsent: [Dictionary new]]]
		ifFalse: [map at: #disabled ifAbsent: [map at: #enabled ifAbsent: [Dictionary new]]].
	map := self over
		ifTrue: [map at: #over ifAbsent: [map at: #notOver ifAbsent: [Dictionary new]]]
		ifFalse: [map at: #notOver ifAbsent: [map at: #over ifAbsent: [Dictionary new]]].
	^map at: (self down ifTrue: [#down] ifFalse: [#up]) ifAbsent: [
		map at: (self down ifTrue: [#up] ifFalse: [#down]) ifAbsent: [Color transparent]]! !

!MultistateButtonMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/22/2008 11:39'!
removeDownActions
	"Remove all down event handlers"
	
	self removeActionsForEvent: #down! !

!MultistateButtonMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/22/2008 11:34'!
mouseDown: evt 
	"Handle a mouse down event."
	
	super mouseDown: evt.
	self enabled ifFalse: [^self].
	self down: true.
	self triggerEvent: #down ! !

!MultistateButtonMorph methodsFor: 'visual properties' stamp: 'gvc 10/21/2008 16:17'!
activeDisabledOverDownFillStyle: aFillStyle
	"Set the active, disabled, over, down fill style."

	self stateMap atPath: #(active disabled over down) put: aFillStyle.
	self changed! !

!MultistateButtonMorph methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 2/1/2011 14:29'!
mouseLeave: evt
	"Handle a mouseLeave event, meaning the mouse just left my bounds with no button pressed."

	super mouseLeave: evt.
	self over: false! !

!MultistateButtonMorph methodsFor: 'visual properties' stamp: 'gvc 10/21/2008 16:16'!
activeDisabledNotOverDownFillStyle: aFillStyle
	"Set the active, disabled, notOver, down fill style."

	self stateMap atPath: #(active disabled notOver down) put: aFillStyle.
	self changed! !

!MultistateButtonMorph methodsFor: 'visual properties' stamp: 'gvc 10/21/2008 16:45'!
passiveEnabledOverDownFillStyle: aFillStyle
	"Set the passive, enabled, over, down fill style."

	self stateMap atPath: #(passive enabled over down) put: aFillStyle.
	self changed! !

!MultistateButtonMorph methodsFor: 'visual properties' stamp: 'gvc 10/21/2008 16:44'!
passiveDisabledOverUpFillStyle: aFillStyle
	"Set the passive, disabled, over, up fill style."

	self stateMap atPath: #(passive disabled over up) put: aFillStyle.
	self changed! !

!MultistateButtonMorph methodsFor: 'accessing' stamp: 'gvc 10/21/2008 13:28'!
stateMap
	"Answer the value of stateMap"

	^ stateMap! !

!MultistateButtonMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/21/2008 16:50'!
passivate
	"Make passive."

	super passivate.
	self active: false! !

!MultistateLabelMorph methodsFor: 'as yet unclassified' stamp: 'gvc 3/4/2010 15:34'!
initWithContents: aString font: aFont emphasis: emphasisCode
	"Grrr, why do they do basicNew?"
	
	colorMap := self defaultColorMap.
	super initWithContents: aString font: aFont emphasis: emphasisCode! !

!MultistateLabelMorph methodsFor: 'as yet unclassified' stamp: 'gvc 3/4/2010 15:40'!
drawOn: aCanvas
	"Draw based on state."

	self enabled
		ifTrue: [aCanvas
					drawString: self contents
					in: self bounds
					font: self fontToUse
					color: self color]
		ifFalse: [self disabledStyle == #inset
					ifTrue: [aCanvas
							drawString: self contents
							in: (self bounds translateBy: 1)
							font: self fontToUse
							color: self disabledColor muchLighter;
							drawString: self contents
							in: self bounds
							font: self fontToUse
							color: self disabledColor]
					ifFalse: [aCanvas
								drawString: self contents
								in: self bounds
								font: self fontToUse
								color: self disabledColor]]! !

!MultistateLabelMorph methodsFor: 'as yet unclassified' stamp: 'gvc 3/4/2010 15:37'!
pressedColor: aColor
	"Set the pressed colour."

	self colorMap at: #pressed put: aColor! !

!MultistateLabelMorph methodsFor: 'as yet unclassified' stamp: 'gvc 3/4/2010 15:24'!
interactionState: aSymbol
	"Set the appropriate text colour."
	
	self color: (self colorMap at: aSymbol)! !

!MultistateLabelMorph methodsFor: 'as yet unclassified' stamp: 'gvc 3/4/2010 15:37'!
selectedColor: aColor
	"Set the selected colour."

	self colorMap at: #selected put: aColor! !

!MultistateLabelMorph methodsFor: 'accessing' stamp: 'gvc 3/4/2010 15:19'!
colorMap: anObject
	"Set the value of colorMap"

	colorMap := anObject! !

!MultistateLabelMorph methodsFor: 'accessing' stamp: 'gvc 3/4/2010 15:19'!
colorMap
	"Answer the value of colorMap"

	^ colorMap! !

!MultistateLabelMorph methodsFor: 'as yet unclassified' stamp: 'gvc 3/4/2010 15:38'!
selectedDisabledColor: aColor
	"Set the selectedDisabled colour."

	self colorMap at: #selectedDisabled put: aColor! !

!MultistateLabelMorph methodsFor: 'as yet unclassified' stamp: 'gvc 3/4/2010 15:36'!
normalColor: aColor
	"Set the normal colour."

	self colorMap at: #normal put: aColor! !

!MultistateLabelMorph methodsFor: 'as yet unclassified' stamp: 'gvc 3/4/2010 15:37'!
selectedPressedColor: aColor
	"Set the selectedPressed colour."

	self colorMap at: #selectedPressed put: aColor! !

!MultistateLabelMorph methodsFor: 'as yet unclassified' stamp: 'gvc 3/4/2010 15:40'!
disabledColor
	"Answer the disabled colour."

	^self colorMap at: #disabled! !

!MultistateLabelMorph methodsFor: 'initialization' stamp: 'gvc 3/4/2010 15:20'!
initialize
	"Set up a default colour map."

	colorMap := self defaultColorMap.
	super initialize! !

!MultistateLabelMorph methodsFor: 'as yet unclassified' stamp: 'gvc 3/4/2010 15:40'!
disabledColor: aColor
	"Set the disabled colour."

	self colorMap at: #disabled put: aColor! !

!MultistateLabelMorph methodsFor: 'as yet unclassified' stamp: 'gvc 3/4/2010 15:37'!
selectedMouseOverColor: aColor
	"Set the selectedMouseOver colour."

	self colorMap at: #selectedMouseOver put: aColor! !

!MultistateLabelMorph methodsFor: 'as yet unclassified' stamp: 'gvc 3/4/2010 15:35'!
defaultColorMap
	"Answer the default colour map."

	|black grey|
	black := Color black.
	grey := Color gray.
	^Dictionary new
		at: #normal put: black;
		at: #mouseOver put: black;
		at: #pressed put: black;
		at: #disabled put: grey;
		at: #selected put: black;
		at: #selectedPressed put: black;
		at: #selectedMouseOver put: black;
		at: #selectedDisabled put: grey;
		yourself
		! !

!MultistateLabelMorph methodsFor: 'as yet unclassified' stamp: 'gvc 3/4/2010 15:36'!
mouseOverColor: aColor
	"Set the mouseOver colour."

	self colorMap at: #mouseOver put: aColor! !

!MustBeBooleanTests methodsFor: 'as yet unclassified' stamp: 'PabloHerrero 1/5/2015 20:11'!
testIfTrueEffect
	| temp fakeBool |
	
	fakeBool := MyBooleanObject new.
	temp := 1.
	fakeBool ifTrue: [ temp := 5 + 3 + 1 ].
	self assert: temp equals: 9.
	
	fakeBool ifTrue: [ [  ] ].
	"fakeBool ifTrue: [ 1+ 2. [ :a | a ] value: 5. 7 ]."! !

!MustBeBooleanTests methodsFor: 'as yet unclassified' stamp: 'CamilleTeruel 7/29/2014 16:54'!
testIfTrueValue
	| myBooleanObject |
	
	self assert: (MyBooleanObject new ifTrue: [ 1 + 2 ]) equals: '3 sent from my boolean object'.
	myBooleanObject := MyBooleanObject new.
	self assert: (myBooleanObject ifTrue: [ 1 + 2 ]) equals: '3 sent from my boolean object'.! !

!Mutex commentStamp: '<historical>'!
A Mutex is a light-weight MUTual EXclusion object being used when two or more processes need to access a shared resource concurrently. A Mutex grants ownership to a single process and will suspend any other process trying to aquire the mutex while in use. Waiting processes are granted access to the mutex in the order the access was requested.

Instance variables:
	semaphore	<Semaphore>		The (primitive) semaphore used for synchronization.
	owner		<Process>		The process owning the mutex.!
!Mutex methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 10:11'!
initialize
	super initialize.
	semaphore := Semaphore forMutualExclusion.! !

!Mutex methodsFor: 'mutual exclusion' stamp: 'das 11/3/2005 22:53'!
critical: aBlock
	"Evaluate aBlock protected by the receiver."
	| activeProcess |
	activeProcess := Processor activeProcess.
	activeProcess == owner ifTrue:[^aBlock value].
	^semaphore critical:[
		owner := activeProcess.
		aBlock ensure:[owner := nil]].! !

!MutexSet commentStamp: '<historical>'!
A MutexSet helps with aquiring a set of mutexes.!
!MutexSet methodsFor: 'private' stamp: 'das 11/3/2005 22:54'!
pvtCritical: aBlock startingAt: index
	| mutex |
	index > array size ifTrue:[^aBlock value].
	mutex := array at: index.
	^mutex critical:[self pvtCritical: aBlock startingAt: index+1].! !

!MutexSet methodsFor: 'initialize' stamp: 'das 11/3/2005 22:54'!
withAll: mutexList
	array := mutexList.! !

!MutexSet methodsFor: 'mutual exclusion' stamp: 'das 11/3/2005 22:54'!
critical: aBlock
	"Evaluate aBlock aquiring all mutexes"
	^self pvtCritical: aBlock startingAt: 1! !

!MutexSet class methodsFor: 'instance creation' stamp: 'das 11/3/2005 22:54'!
withAll: mutexList
	^self new withAll: mutexList! !

!MyBooleanObject methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 4/23/2013 16:03'!
ifTrue: aBlock 
	^ aBlock value printString , ' sent from my boolean object'! !

!MyResumableTestError commentStamp: 'TorstenBergmann 2/5/2014 08:38'!
A resumable error for tests!
!MyResumableTestError methodsFor: 'exception description' stamp: 'tfei 6/13/1999 00:46'!
isResumable

	^true! !

!MyTestError commentStamp: 'TorstenBergmann 2/5/2014 08:38'!
An error for tests!
!MyTestNotification commentStamp: 'TorstenBergmann 2/5/2014 08:38'!
A notification for tests !
!NBBasicExamples commentStamp: '<historical>'!
I am a collection on examples on how to use the NativeBoost infrastructure. 
Check my class-side methods for more details.!
!NBBasicExamples methodsFor: 'double type' stamp: 'IgorStasenko 11/23/2012 14:23'!
storeDouble: aDouble at: address
	" This method stores a double floating point value at given memory address.
	an address can be an instance of NBExternalAddress, or
	simple ByteArray with at least 8 bytes long, which will hold a 64bit floating-point value"
	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin' error: errorCode>

	"We are using a pseudo-function prototype and supplying own assembler code,
	instead of making a call to external function.
	An address and aDouble arguments are pushed on stack after coercion. "
	
	^ self nbCallout 
		"An additional options may affect the code generation. If options are omitted, then code generator will use defaults
		(see NBFFICallout class>>defaultOptions)"

		 options: #( 
			"do not accept nil as a pointer arument. 
			This means that passing nil as address will cause a primitive failure."
		- optCoerceNilToNull  
		
			" accept a byte array as pointer. In our case, address to a first byte in byte array will be pushed on stack"
		+ optAllowByteArraysPtr
		
			" accept an instance of NBExternalAddress when coercing pointer arguments.
			In our case, this method can accept NBExternalAddres in its address argument"
		+ optAllowExternalAddressPtr
		
		);
		function: #( void (void * address, double aDouble) )  
		" A pseudo-function takes 2 arguments, and having no return value. In this case, method will always answer nil object.
		  Under cdecl calling convention, arguments are pushed on stack in reverse order,
		  so, first pushed aDouble , then address"
		
		emit: [:gen |  | asm |
			asm := gen asm.

			"Here , we expecting that an address value is on top of the stack"
			asm 
				pop: EDX;  "load an address value into EDX register by popping it from a stack"
			
				"now copy the floating point value (which is 8-bytes long) to the given address"
				mov: ESP ptr to: EAX;
				mov: EAX to: EDX ptr;  " store first 32bit part of 64bit double value"
			
				mov: ESP ptr + 4 to: EAX;
				mov: EAX to: EDX ptr + 4.  " store second 32bit part of 64bit double value"
			
		]
	
	! !

!NBBasicExamples methodsFor: 'custom type' stamp: 'IgorStasenko 11/23/2012 14:15'!
encodeToUTF8: aWideString

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^
		self nbCallout 
			function: #(String (NBUTF8StringExample aWideString)) 
			emit: [:gen :proxy :asm |
				asm pop: asm EAX
			] ! !

!NBBasicExamples methodsFor: 'double type' stamp: 'IgorStasenko 11/23/2012 14:23'!
readDoubleFrom: address
	" This method loads the double from given external address.
	an address can be an instance of NBExternalAddress, or
	simple ByteArray with at least 8 bytes long, which holds a double floating value"
	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin' error: errorCode>

	"We are using a pseudo-function prototype and supplying own assembler code,
	instead of making a call to external function.
	In given example, an address argument , after coercion is pushed on stack. "
	
	^ self nbCallout

		"An additional options may affect the code generation. If options are omitted, then code generator will use defaults
			(see NBFFICallout class>>defaultOptions)"
		options: #( 
			"do not accept nil as a pointer argument. 
			This means that passing nil as address will cause a primitive failure."
		- optCoerceNilToNull  
		
			" accept a byte array as pointer. In our case, address to a first byte in byte array will be pushed on stack"
		+ optAllowByteArraysPtr
		
			" accept an instance of NBExternalAddress when coercing pointer arguments.
			In our case, this method can accept NBExternalAddres in its address argument"
		+ optAllowExternalAddressPtr
		
		);

		cdecl;  "Use cdecl C calling convention. This can be actually omitted, because it is default convention used by code generator. "		
				
		function: #( double ( void * address) )  
		" A pseudo-function takes 1 argument, and returns double value.
		  Under cdecl call convention, all floating point return types is returned in fp(0) CPU register"
		
		emit: [:gen |  | asm |
			asm := gen asm.

			"Here , we expecting that an address value is already pushed on stack"
			
			asm 
				pop: asm EAX;  "load an address value into EAX register by popping a stack"
				fld: (asm EAX ptr64). "load a floating point value from memory, at base address, held in EAX register into fp(0) register,
				we are using #ptr64, to indicate that memory operand size is 64bits long"
			
			" return value set, we are done. A code generator will take care for emitting code, which converts
			a double floating point value into smalltalk object. "
		]
! !

!NBBasicExamples methodsFor: 'double type' stamp: 'Igor.Stasenko 9/23/2010 04:53'!
writeAndReadDoubles

	| d bytes result |
	
	d := 1.5 .
	
	bytes := ByteArray new: 8.
	
	self storeDouble: d at: bytes.
	
	result := self readDoubleFrom: bytes.
	
	self assert: (result = d ).! !

!NBBasicExamples methodsFor: 'double type' stamp: 'IgorStasenko 11/23/2012 14:16'!
externalAddressValue: externalAddress
	"
	NBBasicExamples new externalAddressValue: (NBExternalAddress value: 10)

	Error message is in: 
	#verifyClassOf:is:generator:

	"
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout  
		 
		function: #( ulong ( NBExternalAddress  externalAddress) )  
		emit: [:gen :proxy :asm |
			asm pop: asm EAX
		]! !

!NBBasicExamples methodsFor: 'object format' stamp: 'Igor.Stasenko 12/9/2010 14:29'!
getObjectHeader: anObject
	"Answer the word, representing an object header. See Object>>nbOopHeader for implementation.
	This method provided only for educational purposes"
	
	^ anObject nbOopHeader! !

!NBBasicExamples class methodsFor: 'basic-float-operations' stamp: 'IgorStasenko 11/23/2012 14:13'!
swapDoubFirst: r1 withSecond: r2
 
    <primitive: #primitiveNativeCall module: #NativeBoostPlugin>

    ^ self nbCallout
		function: #( double ( double r1, double r2 ))
	    emit: [:gen :proxy :asm |
			"store r1 and r2 into the FPU stack"
	       asm fld: asm ESP ptr64.
	       asm fld: asm ESP ptr64 + 8.
			"swap the two topmost FPU stack elements"
			asm fxch: asm ST1.
 	   ]! !

!NBBasicExamples class methodsFor: 'basic-interpreter-proxy-interaction' stamp: 'IgorStasenko 11/23/2012 14:06'!
primitiveFailWithMessage
	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout 
		function: #( oop ( void) )  
		emit: [:gen :proxy :asm |
			"Fail the native code"
			gen failWithMessage: 'here is a message you wanna show to users when you fail a primitive'
		].! !

!NBBasicExamples class methodsFor: 'basic-external-function' stamp: 'IgorStasenko 8/24/2012 15:13'!
nbGetEnv: str
"
	This is a basic example for making an external call. 
	This method calls a Standard C library getenv() function
"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode >
	 ^ self nbCall: #( String getenv (String str) ) module: NativeBoost CLibrary! !

!NBBasicExamples class methodsFor: 'basic-interpreter-proxy-interaction' stamp: 'IgorStasenko 11/23/2012 14:12'!
returnNewArraySize3
	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout 
		function: #( oop ( void ))  
		emit: [:gen :proxy :asm |
			"Array -> EAX"
			proxy classArray.
			"Array new: 3 (Array oop is stored in EAX)"
			proxy instantiateClass: asm EAX indexableSize: 3
		]! !

!NBBasicExamples class methodsFor: 'basc-types' stamp: 'CamilloBruni 7/16/2012 10:33'!
returnFloat! !

!NBBasicExamples class methodsFor: 'basic-interpreter-proxy-interaction' stamp: 'IgorStasenko 11/23/2012 14:05'!
primitiveFail
	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout 
		function: #( oop ( void) )  
		emit: [:gen :proxy :asm |
			"Fail the native code"
			proxy primitiveFail.
		].! !

!NBBasicExamples class methodsFor: 'basic-interpreter-proxy-interaction' stamp: 'IgorStasenko 11/23/2012 14:08'!
returnClassOf: anObject
	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout 
		function: #( oop ( oop anObject ) )  
		emit: [:gen :proxy :asm |
			" anObject -> EAX "
			asm pop: asm EAX.
			"^ anObject class "
			proxy fetchClassOf: asm EAX.
		]! !

!NBBasicExamples class methodsFor: 'basc-types' stamp: 'IgorStasenko 11/23/2012 14:12'!
returnIntegerDirectOOP
	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

"here, since we put a return type 'oop', this means that NB FFI won't perform any conversion
of returned value, therefore a native code must take care by itself for returning a valid oop"
	^ self nbCallout 
		function: #( oop ( void) )  
		emit: [:gen :proxy :asm |
			asm mov: (123456789 << 1) + 1 to: asm EAX
		]! !

!NBBasicExamples class methodsFor: 'basic-interpreter-proxy-interaction' stamp: 'IgorStasenko 11/23/2012 14:13'!
returnNil
	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout 
		function: #( oop ( void ) )  
		emit: [:gen :proxy :asm |
			"nilObject -> EAX"
			proxy nilObject.
		]! !

!NBBasicExamples class methodsFor: 'basic-interpreter-proxy-interaction' stamp: 'IgorStasenko 11/23/2012 14:13'!
returnSpecialObjectsArray
	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout 
		function: #( oop ( void) )  
		emit: [:gen :proxy :asm |
			"store the special objects array into EAX"
			proxy specialObjectsArray.
		]! !

!NBBasicExamples class methodsFor: 'basc-types' stamp: 'IgorStasenko 11/23/2012 14:11'!
returnInteger: a minus: b
	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout 
		function: #( int ( int a,  int b) )  
		emit: [:gen :proxy :asm |
			" a "
			asm pop: asm EAX.
			" b "
			asm pop: asm EDX.
			"result := a - b"
			asm sub: asm EAX with: asm EDX
		]! !

!NBBasicExamples class methodsFor: 'basic-interpreter-proxy-interaction' stamp: 'IgorStasenko 11/23/2012 14:07'!
returnArrayClass
	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout 
		function: #( oop ( void) )  
		emit: [:gen :proxy :asm |
			"Access an internal data structure via the interpreter proxy"
			proxy classArray.
		]! !

!NBBasicExamples class methodsFor: 'basic-interpreter-proxy-interaction' stamp: 'IgorStasenko 11/23/2012 14:13'!
returnSelf
	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout 
		function: #( oop ( void) )  
		emit: [:gen :proxy :asm |
			"this is equivalent to: 
				proxy receiverInto: asm EAX."
			proxy receiver.
		]! !

!NBBasicExamples class methodsFor: 'basic-interpreter-proxy-interaction' stamp: 'IgorStasenko 11/23/2012 14:11'!
returnInstVar: aNumber from: anObject
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout 
		function: #( oop ( int aNumber, oop anObject ) )  
		emit: [:gen :proxy :asm |
			"aNumber -> EAX"
			asm pop: asm EAX.
			"EAX = aNumebr-1"
			asm sub: asm EAX with: 1.
			"if signed (AKA negative jump to failure)"
			asm js: 'failure'.
		
			"anObject -> EDX"
			asm pop: asm EDX.
			"EAX = anObject instVarAt: aNumber"
			proxy fetchPointer: asm EAX ofObject: asm EDX.
			asm leave; ret.
				
			asm label: 'failure'.
			proxy primitiveFail.
		]! !

!NBBasicExamples class methodsFor: 'basc-types' stamp: 'IgorStasenko 11/23/2012 14:11'!
returnInteger
	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout 
		function: #( int ( void) )  
		emit: [:gen :proxy :asm |
			asm mov: 123456789 to: asm EAX
		]! !

!NBBasicExamples class methodsFor: 'basic-interpreter-proxy-interaction' stamp: 'IgorStasenko 11/23/2012 14:12'!
returnMethodLiteral
	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout 
		function: #( oop ( void) )  
		emit: [:gen :proxy :asm |
			"store this method in EAX"
			proxy primitiveMethod.
			"the current method is in EAX
				EAX literalAt: 0 "
			proxy literal: 0 ofMethod: asm EAX.
		]! !

!NBBasicExamples class methodsFor: 'basic-interpreter-proxy-interaction' stamp: 'IgorStasenko 11/23/2012 14:04'!
failIfNegative: anInteger
	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout 
		function: #( void ( int anInteger ) )  
		emit: [:gen :proxy :asm |
			"aNumber -> EAX"
			asm pop: asm EAX.
			"check if the index in EAX is negative"
			asm test: asm EAX with: asm EAX.
			"if not signed (AKA positive jump to success)"
			asm jns: 'success'.
			gen failWithMessage: 'A negative number is forbidden!!'.
			asm label: 'success'.
		]! !

!NBBasicExamples class methodsFor: 'basc-types' stamp: 'IgorStasenko 11/23/2012 14:06'!
returnAddressOf: anObject
	"Yes, here we demonstrating that we can obtain a pointer (address) of object in memory.
	But in fact it has no any practical use, because at any moment once you return from the method,
	a GC may be triggered and given object can be relocated into different memory region,
	rendering an obtained address invalid"
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout 
		function: #( int ( oop anObject ) )  
		emit: [:gen :proxy :asm |
			asm pop: asm EAX.
		]! !

!NBBasicExamples class methodsFor: 'basic-interpreter-proxy-interaction' stamp: 'IgorStasenko 11/23/2012 14:07'!
returnAsBit: aBoolean
	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout 
		function: #( int ( oop aBoolean ) )  
		emit: [:gen :proxy :asm |
			" aBoolean -> EAX "
			asm pop: asm EAX.
			"^ EAX = true ifTrue: [ 1 ] ifFalse: [ 0 ] "
			proxy booleanValueOf: asm EAX.
		]! !

!NBBool methodsFor: 'emitting code' stamp: 'Igor.Stasenko 4/30/2010 13:55'!
pushAsValue: gen

	gen asm push: (gen proxy booleanValueOf: (loader emitLoad: gen)).
! !

!NBBool methodsFor: 'accessing' stamp: 'IgorStasenko 5/26/2012 17:05'!
valueSize
	"Answer a number of bytes, which takes a value of given type
	(not a pointer to it)
	"
	^ 1! !

!NBBool methodsFor: 'emitting code' stamp: 'StephaneDucasse 2/7/2014 16:16'!
coerceReturnValue: gen
	"convert C Bool to true or false"
	| proxy asm lfalse done |
	proxy := gen proxy.
	asm := gen asm.
	lfalse := asm uniqueLabelName: 'false'.
	done := asm uniqueLabelName: 'done'.
	asm 
		or: asm AL with: asm AL;
		je: lfalse.
	proxy trueObject.
	asm jmp: done.
	asm label: lfalse.
	proxy falseObject.
	asm label: done.! !

!NBBootstrapUlong commentStamp: 'Igor.Stasenko 5/14/2010 18:01'!
A special hacky type, 
which storing a ulong function return value into existing byte array instance.
A method, which using this type in callout should have an argument , named 'returnValueBuffer'
and pass a byte array instance, big enough to store ulong there.

This is essentially used during NativeBoost bootstrap, to generate & install the
gall gate function, without calling any of interpreterProxy function which may cause GC.!
!NBBootstrapUlong methodsFor: 'emitting code' stamp: 'IgorStasenko 7/1/2013 11:09'!
coerceReturnValue: gen
	| args result asm proxy |
	asm := gen asm.
	proxy := gen proxy.
	args := gen methodArgs.
	
	result := gen reserveTemp.
	asm mov: asm EAX to: result.
	
	"load a returnValueBuffer method argument oop"
	(NBSTMethodArgument new stackIndex: (args size - (args indexOf: #returnValueBuffer)))
		emitLoad: gen.
	proxy varBytesFirstFieldOf: asm EAX.  "EAX - address , where to store result "
	asm mov: result to: asm ECX.
	asm mov: asm ECX to: asm EAX ptr32.
	
	"primitive will return nil"
	proxy nilObject
! !

!NBBootstrapUlong methodsFor: 'accessing' stamp: 'IgorStasenko 5/26/2012 17:05'!
valueSize
	"Answer a number of bytes, which takes a value of given type
	(not a pointer to it)
	"
	^ 4! !

!NBByteArrayPtr methodsFor: 'emitting code' stamp: 'IgorStasenko 8/3/2011 19:47'!
pushAsPointer: gen

	self error: 'ByteArrayPtr is already pointer'! !

!NBByteArrayPtr methodsFor: 'accessing' stamp: 'IgorStasenko 5/26/2012 17:04'!
valueSize
	"Answer a number of bytes, which takes a value of given type
	(not a pointer to it)
	"
	^ self pointerSize ! !

!NBByteArrayPtr methodsFor: 'emitting code' stamp: 'CamilloBruni 7/23/2012 13:29'!
pushAsValue: gen

	"push a pointer to first indexable field of ByteArray, 
	which is always oop + BaseHeaderSize  
	"
	| asm proxy |
	asm := gen asm.
	proxy := gen proxy.
	loader emitLoad: gen.

	asm decorateWith: 'NBByteArrayPtr>>pushAsValue:' during: [  	
		asm 
			add: asm EAX with: proxy objectFormat varBytesFirstField;
			push: asm EAX ]! !

!NBByteArraySize commentStamp: 'Igor.Stasenko 5/3/2010 13:56'!
A helper type, which takes a byte array argument and pushing its size!
!NBByteArraySize methodsFor: 'emitting code' stamp: 'Igor.Stasenko 5/3/2010 14:00'!
coerceReturn: gen

	self error: 'Can''t use this type as a return value'! !

!NBByteArraySize methodsFor: 'emitting code' stamp: 'Igor.Stasenko 5/3/2010 22:44'!
pushAsPointer: gen
	self shouldNotImplement ! !

!NBByteArraySize methodsFor: 'accessing' stamp: 'IgorStasenko 5/26/2012 17:04'!
valueSize
	"Answer a number of bytes, which takes a value of given type
	(not a pointer to it)
	"
	^ 4! !

!NBByteArraySize methodsFor: 'emitting code' stamp: 'Igor.Stasenko 5/3/2010 22:40'!
pushAsValue: gen
	" push the array size "
	gen proxy slotSizeOf: (loader emitLoad: gen).
	gen asm push: gen asm EAX! !

!NBCPrinter class methodsFor: 'as yet unclassified' stamp: 'Igor.Stasenko 9/27/2010 01:46'!
initialize
	" self initialize "
	printFormat := '%s'.! !

!NBCPrinter class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/24/2012 16:20'!
printf: aString

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #( void printf (String printFormat, String aString) )
		module: NativeBoost CLibrary! !

!NBCallbackCodeGen commentStamp: '<historical>'!
The generated callback code does following:

1. Trunk
1.0. Each callback instance has unique trunk code, which is installed into external memory during callback initialization.
1.1. An external function makes a call to trunk address.
1.2. Trunk code sets the globally registered callback index to ECX register and jumps to callback entry code.

2. Entering callback 

2.1. saves the VM's execution state (stack/frame pointers, reenterInterpreter jump buffer). See #saveExecutionState.
2.2. fetching the callback oop for index passed from trunk.
2.3. coercing the callback function arguments to their smalltalk equivalent and creates an array with them. See #emitArgumentsCoercion.
2.4. synthesizes a fresh method context which is an activation of #pvtEnter:stackPointer:primitiveMethod: 
	and swaps the active context with synthesized context. See #activateCallbackContext: .

2.5. increments a global callback counter value. See #incrementCallbackCounter.
2.6. enters an interpreter loop by calling VM's #enterSmalltalkExecutiveImplementation function.

3. Leaving callback.

3.1. A leave procedure starts from method: #primLeave:stackPtr:contextOop:returnValue:primitiveMethod: , which
simply jumps to provided leave address, a code, generated for leaving from given callback.

3.2. Coerce the return value from smalltalk object to it's C equivalent. See #generateCallbackLeaveCodeFor:leaveAddr:.
3.3. Swaps a currently active context with one which were before entering callback
3.4. jumps to #returnToC label in callback entry code
3.5. sets the current C stack frame back to callback enter procedure.
3.6. restores the VM execution state (an opposite to 2.1) , see #restoreExecutionState.
3.7. decrements global callback counter.
3.8. returns to external function
!
!NBCallbackCodeGen methodsFor: 'callback entry code' stamp: 'IgorStasenko 5/8/2012 16:48'!
generateCallbackEnterCodeFor: callbackClass

	gen := (NBNativeFunctionGen new
		callType: callbackClass callType;
		fnSpec: callbackClass fnSpec;
		yourself).

	callbackClass numArgs: gen fnSpec arguments size.
	
	"optUseStackPointer should be turned off!!!!!!"
	gen parseOptions: #( + optProxyLabels - optUseStackPointer +optReserveCallgateSpace  "+optDebug" ).
			
	^ gen generate: [:g |  
			
		asm := gen asm.
		proxy := gen proxy.

		"
		Callback entry , jumped directly from trunk.
		ECX == callback index
		"
		cbIndex := gen reserveTemp.
		asm 
			mov: ECX to: cbIndex. 


		self 
			saveExecutionState;
			emitArgumentsCoercion;
			activateCallbackContext: callbackClass. 
		
		"increment callback counter value"
		self incrementCallbackCounter.					
	
		asm label: #safetyLoop.
		self enterSmalltalkExecutiveImplementation.
		" we never reach here"
		asm jmp: #safetyLoop.
"========================================================"

"Callback return entry point. We jump here from 
#generateCallbackLeaveCodeFor:leaveAddr:
 
The stack must contain:
  - saved EBP
  - EAX
  - EDX
"

		asm label: #returnToC;
			pop: EBP.

		self restoreExecutionState.
		self decrementCallbackCounter.
		
		asm
			pop: EAX;
			pop: EDX.

	].! !

!NBCallbackCodeGen methodsFor: 'global addresses' stamp: 'IgorStasenko 5/7/2012 12:36'!
CStackPointerAddress

	^ NativeBoost loadSymbol: 'CStackPointer' fromModule: NativeBoost VMModule! !

!NBCallbackCodeGen methodsFor: 'callback entry code' stamp: 'IgorStasenko 5/7/2012 12:48'!
incrementCallbackCounter

	"increment callback counter value"
	asm mov: NativeBoost forCurrentPlatform callbackCounterAddress asUImm32 to: EAX.
	asm inc: EAX ptr32.
	! !

!NBCallbackCodeGen methodsFor: 'callback leave code' stamp: 'CiprianTeodorov 12/11/2012 19:00'!
generateCallbackLeaveCodeFor: callbackClass leaveAddr: leaveAddress

	gen := (NBNativeFunctionGen new
		callType: callbackClass callType;
		fnSpec: callbackClass fnSpec;
		yourself).

	callbackClass numArgs: gen fnSpec arguments size.
	
	"optUseStackPointer should be turned off!!!!!!"
	gen parseOptions: #( + optProxyLabels - optUseStackPointer +optReserveCallgateSpace  "+optDebug" ).
			
	^ gen generate: [:g |
			
		asm := gen asm.
		proxy := gen proxy.

"see #primLeave:stackPtr:contextOop:returnValue:primitiveMethod: 
for arguments stack order
"
		"coerce the oop to return type"
		proxy stackValue: 1.

"******** currently only return types returned via EAX supported *********"
		gen fnSpec returnType coerceOopToOperand: gen ifFailedJumpTo: #failed.

	"keep return value(s) on stack"
		asm
			push: EDX; 
			push: EAX.

		proxy stackValue: 3. "saved EBP"
		proxy positive32BitValueOf: EAX.

		asm push: EAX.
		proxy ifFailedJumpTo: #failed.

		proxy swapActiveContext: [ proxy stackValue: 2 ] restoreMethod: [ proxy stackValue: 0 ].
	
		"swapactivecontext returns 0 on failure"
		asm 
			cmp: EAX with: 0;
			je: #failed. 
			
		asm 
			mov: leaveAddress asUImm to: EAX;
			jmp: EAX. "jump to callback leave-to-C code. see #generateCallbackEnterCodeFor:  " 
				
	asm label: #failed.
"asm int3."		
		proxy primitiveFail.
		
		asm 
			leave;
			leave;  " on failure, we do leave twice, because 
		#primLeave:stackPtr:contextOop:returnValue:primitiveMethod:
		creates own stack frame, and jumps to callback leave entry point
		but we want to return straight to VM" 
			ret.
	].

! !

!NBCallbackCodeGen methodsFor: 'callback entry code' stamp: 'IgorStasenko 9/15/2012 19:53'!
emitArgumentsCoercion
	" input - none,
	output - an arguments array in remmappable oops stack top"
	| args argOop i |
	args := gen reserveTemp.
	argOop := gen reserveTemp.
	
	asm decorateWith:  'emitArgumentsCoercion' during: [
	
		proxy createInstanceOf: Array size: (gen fnSpec arguments size).
		proxy pushRemappableOop: EAX.
	
		i := 0.
		gen fnSpec arguments do: [:arg |
			arg type readOop: (EBP ptr + arg offset) generator: gen.
			asm mov: EAX to: argOop.
			proxy popRemappableOop.
			asm mov: EAX to: args.
			proxy storePointer: i ofObject: args withValue: argOop.
			i := i+1.
			proxy pushRemappableOop: args.
		].

		gen releaseTemps: 2.
	]! !

!NBCallbackCodeGen methodsFor: 'misc' stamp: 'IgorStasenko 9/10/2012 13:26'!
memCopy: src to: dst size: sz

	asm 
		mov: src to: asm ESI;
		mov: dst to: asm EDI;
		mov: sz to: asm ECX;
		rep;
		movsb! !

!NBCallbackCodeGen methodsFor: 'global addresses' stamp: 'IgorStasenko 9/10/2012 12:49'!
reenterInterpreterAddress

	^ (NativeBoost loadSymbol: 'reenterInterpreter' fromModule: NativeBoost VMModule) value asUImm32 ! !

!NBCallbackCodeGen methodsFor: 'callback entry code' stamp: 'ClementBera 5/27/2014 13:49'!
activateCallbackContext: callbackClass

	"Activate a callback context, which is a 
	
	Context sender: s receiver: r method: m arguments: args 
	"

		| ctx method fld |
		
		method := callbackClass callbackEnterMethod.
		ctx := gen reserveTemp.
		fld := gen reserveTemp.
		
		proxy positive32BitIntegerFor: EBP.		
		proxy pushRemappableOop: EAX.  "push EBP -> remappable oops stack"
	
		proxy createInstanceOf: Context size: method frameSize.
		asm mov: EAX to: ctx.
		
		"Fill the context state, which is #('sender' 'pc' 'stackp' 'method' 'closureOrNil' 'receiver')"
	
		proxy integerObjectOf: method initialPC.
		asm mov: ctx to: ECX;
			mov: EAX to: ECX ptr + (proxy ivar: #pc in: Context).
	
		proxy integerObjectOf: method numTemps.
		asm mov: ctx to: ECX;
			mov: EAX to: ECX ptr + (proxy ivar: #stackp in: Context).
		
		NativeBoost extraRootsRegistry emitFetchCallback: cbIndex generator: gen.
		"EAX - callback oop"
	
		asm mov: ctx to: ECX;
			mov: EAX to: ECX ptr + (proxy ivar: #receiver in: Context);
			mov: EAX ptr + (proxy ivar: #enterMethod in: NBFFICallback) to: EDX;
			mov: EDX to: ECX ptr + (proxy ivar: #method in: Context).
			
		

		proxy firstIndexableField: ECX.
		asm mov: EAX to: fld.

		proxy popRemappableOop. "pop EBP from remappable oops stack"
		asm mov: fld to: ECX;
		mov: EAX to: ECX ptr + proxy oopSize. "put stackp as 1st method argument"

		proxy popRemappableOop. "saved arguments array (see #emitArgumentsCoercion)"
		asm mov: fld to: ECX;
		mov: EAX to: ECX ptr.
		
		proxy primitiveMethod.
		asm mov: fld to: ECX;
		mov: EAX to: ECX ptr + (2*proxy oopSize). "save current primitive method oop"


		"Now we swapping the currently active VM context with the context we're just created"		 
		proxy pushRemappableOop: ctx.
		proxy swapActiveContext: [ ctx ] restoreMethod: [ 0 ]. " EAX <- activeContext"
		asm mov: EAX to: ctx.
		proxy popRemappableOop.
		
		"set a sender in new context to be the old context
		ctx - old context, EAX - new context"
		asm mov: ctx to: ECX.
		asm mov: ECX to: EAX ptr + (proxy ivar: #sender in: Context).
! !

!NBCallbackCodeGen methodsFor: 'callback leave code' stamp: 'IgorStasenko 9/15/2012 19:54'!
restoreExecutionState

	"emit code to restore execution state"
	
	asm decorateWith: 'restoreExecutionState' during: [

	"restore registers & other , see corresponding #saveExecutionState"
	self memCopy: savedReenterInterpreter to: self reenterInterpreterAddress  size: self primJumpBufSize.

	asm 
		mov: savedEBX to: EBX;
		mov: savedESI to: ESI;
		mov: savedEDI to: EDI;

		mov: savedCStackPointer to: EAX;
		mov: EAX to: self CStackPointerAddress asUImm ptr;
		
		
		mov: savedCFramePointer to: EAX;
		mov: EAX to: self CFramePointerAddress asUImm ptr.
		
	]! !

!NBCallbackCodeGen methodsFor: 'callback leave code' stamp: 'IgorStasenko 5/7/2012 12:48'!
decrementCallbackCounter

	"increment callback counter value"
	asm mov: NativeBoost forCurrentPlatform callbackCounterAddress asUImm32 to: EAX.
	asm dec: EAX ptr32.
	! !

!NBCallbackCodeGen methodsFor: 'callback entry code' stamp: 'IgorStasenko 5/7/2012 18:29'!
enterSmalltalkExecutiveImplementation

	"call #enterSmalltalkExecutiveImplementation"
	
	| addr |
	
	addr := NativeBoost loadSymbol: 'enterSmalltalkExecutiveImplementation' fromModule: NativeBoost VMModule.
	
	asm cdeclCall: [:callInfo |
		asm 
			mov: addr asUImm32 to: EAX;
			call: EAX. 
	] alignment: NativeBoost forCurrentPlatform stackAlignment ! !

!NBCallbackCodeGen methodsFor: 'global addresses' stamp: 'EstebanLorenzano 2/13/2013 16:27'!
CFramePointerAddress

	^ NativeBoost loadSymbol: 'CFramePointer' fromModule: NativeBoost VMModule! !

!NBCallbackCodeGen methodsFor: 'misc' stamp: 'IgorStasenko 5/7/2012 22:31'!
generator: agen
	gen := agen.
	asm := gen asm.
	proxy := gen proxy.! !

!NBCallbackCodeGen methodsFor: 'primitives' stamp: 'IgorStasenko 9/10/2012 12:23'!
primJumpBufSize
	<primitive: #primJumpBufSize module: #NativeBoostPlugin>
	
	self error: 'a primitive failed. (seems like you using outdated VM)'! !

!NBCallbackCodeGen methodsFor: 'callback entry code' stamp: 'IgorStasenko 9/15/2012 19:50'!
saveExecutionState

	"emit code to save execution state"
	
	asm decorateWith: 'saveExecutionState' during: [

	"save registers"
	savedEBX := gen reserveTemp.
	savedESI := gen reserveTemp.
	savedEDI := gen reserveTemp.
	savedCStackPointer := gen reserveTemp.
	savedCFramePointer := gen reserveTemp.
	savedReenterInterpreter := gen reserveTemp.
	
	asm 
		mov: EBX to: savedEBX;
		mov: ESI to: savedESI;
		mov: EDI to: savedEDI;

		mov: self CStackPointerAddress asUImm ptr to: EAX;
		mov: EAX to: savedCStackPointer;
		mov: self CFramePointerAddress asUImm ptr to: EAX;
		mov: EAX to: savedCFramePointer;
		
		sub: asm ESP with: self primJumpBufSize;
		mov: ESP to: savedReenterInterpreter.
	
		self memCopy: self reenterInterpreterAddress to: savedReenterInterpreter  size: self primJumpBufSize
	]! !

!NBCharacterType commentStamp: '<historical>'!
Character type.
 Represented as single byte on C side.

Accepts Character/Smallint as argument, 
converts return value to Character instance!
!NBCharacterType methodsFor: 'emitting code' stamp: 'IgorStasenko 9/2/2012 23:34'!
pushAsValue: gen

	"oop is a Character or smallint"
	| asm oop classChar reg proxy notSmi done |
	
	asm := gen asm.
	proxy := gen proxy.

	notSmi := asm uniqueLabelName: 'notSmi'.
	done := asm uniqueLabelName: 'done'.
	
	oop := gen reserveTemp.
	classChar := gen reserveTemp.

	reg := loader emitLoad: gen.
	asm mov: reg to: oop.
	
	reg := proxy isIntegerObject: reg.
	
	asm or: reg with: reg;
		je: notSmi.
	
	asm push: (proxy integerValueOf: oop);
		jmp: done.
	asm label: notSmi.

	reg := proxy classCharacter.
	asm mov: reg to: classChar.

	reg := proxy fetchClassOf: oop.
	asm 
		cmp: reg with: classChar;
		jne: gen failedLabel.

	reg := proxy fetchInteger: 0 ofObject: oop.
	asm push: reg;
	label: done.
	
	gen releaseTemps: 2
! !

!NBCharacterType methodsFor: 'accessing' stamp: 'IgorStasenko 9/2/2012 23:34'!
valueSize
	^ 1! !

!NBCharacterType methodsFor: 'emitting code' stamp: 'IgorStasenko 9/2/2012 23:34'!
coerceReturnValue: gen
	| asm proxy val |
	"convert unsigned Char to ST Character"
	asm := gen asm.
	proxy := gen proxy.
	
	val := gen reserveTemp.
	asm movzx: asm EAX with: asm AL.
	asm mov: asm EAX to: val.
	
	proxy fetchPointer: val ofObject: (proxy characterTable).
	
	gen releaseTemps: 1! !

!NBCodeGenRecursion commentStamp: '<historical>'!
I am used to SIGNAL recursion error during code generation..

Do not confuse me with NBRecursionDetect  notification,
which is used to detect recursion.

A recursion usually happens when generating code for some method requires generating code for very same method, and so it enters infinite loop!
!NBCogInterpreterProxy commentStamp: '<historical>'!
I am a specialized interpreter proxy for the Cog family of intererpreters!
!NBCoreTests methodsFor: 'tests' stamp: 'IgorStasenko 2/20/2012 12:13'!
testGettingError

	self nonExistedPrim: [:context |

	"This error produced by Cog VM, when primitive not found"
		self assert: 
		(context tempAt: 	context method numTemps ) == #'not found'
	
	]! !

!NBCoreTests methodsFor: 'misc' stamp: 'IgorStasenko 2/20/2012 12:01'!
nonExistedPrim: aBlock
	| a b c|
	<primitive: #abra module: #kadabra error: errorCode >
	

	^ aBlock value: thisContext	! !

!NBCoreTests methodsFor: 'tests' stamp: 'IgorStasenko 5/28/2012 07:00'!
testRecursionDetection

	| result |
	result := false.
	
	NBRecursionDetect in: #abc during: [
		result := (NBRecursionDetect signalForMethod: #abc ) 
			].

	self assert: result == true.
	
	result := (NBRecursionDetect signalForMethod: #abc ).
	self assert: result == false.

! !

!NBCoreTests methodsFor: 'tests' stamp: 'IgorStasenko 3/20/2011 04:05'!
testPlatformId

	"sometimes i forget to set platform ID, when building plugin"
	
	self assert: NativeBoost platformId ~= 0! !

!NBCoreTests methodsFor: 'misc' stamp: 'IgorStasenko 2/8/2013 15:48'!
methodWithPrimitive220

	<primitive:220 error:errorCode>
	
	^errorCode ! !

!NBCoreTests methodsFor: 'tests' stamp: 'IgorStasenko 2/8/2013 17:10'!
testPrimitive220
	"
	Test a protocol for installing/removing native code directly.
	"
	| asm label method gen |
	[ ^ self ] value.  " this code will crash your VM "
 	method := self class>>#anotherMethodWithPrimitive220.
	NBNativeCodeGen removeNativeCodeFrom: method.
	
	method := self class>>#anotherMethodWithPrimitive220.
	self assert: method hasNativeCode not.
	
	
	asm := NativeBoost forCurrentPlatform newAssembler noStackFrame.
	
	label := asm uniqueLabelName: 'done'.
	gen := NBNativeCodeGen newForMethod: method.
	
	asm := gen asm. 
	asm noStackFrame.
	
	asm push: 999.
	gen proxy callFn: (gen proxy functions at:#primitiveFailFor: ). 
	asm 
		int3;
		jmp: label;
		mov: 1 to: asm EDX;
	label: label.

	NBNativeCodeGen installNativeCode: asm bytes into: method.

	( self class>>#anotherMethodWithPrimitive220 ) forceJIT.
	
	^ self anotherMethodWithPrimitive220 
! !

!NBCoreTests methodsFor: 'tests' stamp: 'HenrikSperreJohansen 6/24/2014 17:06'!
testOptionParsing
	|generator|
	generator := NBNativeCodeGen new.
	generator parseOptions: #(optStringOrNil).
	self assert: generator optStringOrNil.
	generator parseOptions: #(- optStringOrNil).
	self deny: generator optStringOrNil.
	
	"Lets move on to something a bit more advanced..."
	self deny: generator optNotThere.
	generator parseOptions: #(+ optEncoding: utf8 optStringOrNil  - optNotThere).
	self assert: generator optEncoding equals: #utf8.
	self assert:generator optStringOrNil.
	
	generator parseOptions: #(- optEncoding).
	self deny: generator optEncoding.
	
	! !

!NBCoreTests methodsFor: 'misc' stamp: 'IgorStasenko 2/8/2013 16:11'!
anotherMethodWithPrimitive220

	<primitive:220 error:errorCode>
	
	^ errorCode asString! !

!NBCoreTests methodsFor: 'misc' stamp: 'IgorStasenko 2/13/2012 13:42'!
stub2
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin >
	
	^ NBNativeCodeGen generateCode: [:gen | 
			
			self return0Code
		
		] andRetry: thisContext! !

!NBCoreTests methodsFor: 'tests' stamp: 'IgorStasenko 5/31/2012 14:53'!
testFinalization

	| reg objs count |
	
	reg := NBFinalizationRegistry new.
	count := 0.
	reg freeItemsDo: [:item | count := count + 1].
	
	self assert: count = reg initialSize.
	
	objs := OrderedCollection new.
	133 timesRepeat: [ reg add: (objs add: Object new) ].
	
	count := 0.
	reg freeItemsDo: [:item | count := count + 1].

	self assert: reg items size - count = 133.
	
	objs := nil.
	Smalltalk garbageCollect.
	
	count := 0.
	reg freeItemsDo: [:item | count := count + 1].
	
	self assert: count = reg items size.
	
	reg reset.
	count := 0.
	reg freeItemsDo: [:item | count := count + 1].
	
	self assert: count = reg initialSize.
! !

!NBCoreTests methodsFor: 'tests' stamp: 'IgorStasenko 8/24/2012 17:19'!
testExternalResourceManagerFinalization

	
	| obj count |
	
	
	count := 0. 
	obj := NBMockExternalObject new.
	obj data: [ count := count + 1 ].
	
	
	obj registerAsExternalResource.
	obj := nil.
	Smalltalk garbageCollect; garbageCollect.
	
	self assert: (count = 1)! !

!NBCoreTests methodsFor: 'tests' stamp: 'IgorStasenko 2/20/2012 14:26'!
testGenerateAndRetry

	NBNativeCodeGen removeNativeCodeFrom: (self class>>#stub2).
 	[
		self assert: self stub2 = 0.
	] ensure: [
		NBNativeCodeGen removeNativeCodeFrom: (self class>>#stub2).
	].	 
! !

!NBCoreTests methodsFor: 'tests' stamp: 'IgorStasenko 3/20/2011 04:12'!
testHasTrailerInstalled

	
	"Make sure compiled methods trailer installed"
	
	self assert: (CompiledMethodTrailer trailerKinds includes: #NativeCodeTrailer )! !

!NBCoreTests methodsFor: 'misc' stamp: 'IgorStasenko 2/20/2012 14:08'!
return0Code
	" a simple routine, just return 1 (smallinteger = 0)"
	| asm |
	
	^ (asm :=  NativeBoost newAssembler )
		noStackFrame;
		mov: 1 to: asm EAX;
		ret;
		bytes
! !

!NBCoreTests methodsFor: 'misc' stamp: 'IgorStasenko 2/13/2012 13:25'!
stub
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin >
	
	^ 100! !

!NBCoreTests methodsFor: 'tests' stamp: 'IgorStasenko 2/13/2012 14:04'!
testInstallingNativeCode
	"
	Test a protocol for installing/removing native code directly.
	"
	NBNativeCodeGen removeNativeCodeFrom: (self class>>#stub).
	self assert: (self class>>#stub) hasNativeCode not.
	
	self assert: self stub = 100.
	
	 [
		NBNativeCodeGen installNativeCode: self return0Code into: (self class>>#stub).
		self assert: (self class>>#stub) hasNativeCode.

		self assert: (self stub = 0).
	] ensure: [
		NBNativeCodeGen removeNativeCodeFrom: (self class>>#stub).
	].
	 
	self assert: (self class>>#stub) hasNativeCode not.
! !

!NBCoreTests methodsFor: 'tests' stamp: 'IgorStasenko 2/8/2013 15:51'!
testPrimitive220ErrorCode
	"
	Test a protocol for installing/removing native code directly.
	"
	NBNativeCodeGen removeNativeCodeFrom: (self class>>#methodWithPrimitive220).
	self assert: (self class>>#methodWithPrimitive220) hasNativeCode not.
	
	"502 is error code = ErrNoNativeCodeInMethod "
	self methodWithPrimitive220 = 502.
! !

!NBExternalAddress commentStamp: 'IgorStasenko 2/24/2012 17:10'!
My primary function is to represent a pointer (address) to memory, in cases, when a kind of data under given address does not having any special structure,
which can be reflected more nicely in language. 
Usually i can be used to hold pointer(s) to buffers (void*), or to allocated memory region etc.
I providing some basic interface for reading/writing data into memory where i pointing to, as well as some convenience methods.!
!NBExternalAddress methodsFor: 'memory access +' stamp: ''!
ulongAt: zeroBasedOffset
	
	"Reads unsigned 32-bit integer from memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(uint32 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			mov: asm EAX ptr32 + asm ECX to: asm EAX
	]
! !

!NBExternalAddress methodsFor: 'memory access +' stamp: ''!
longAt: zeroBasedOffset
	
	"Reads signed 32-bit integer from memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(int32 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			mov: asm EAX ptr32 + asm ECX to: asm EAX
	]
! !

!NBExternalAddress methodsFor: 'memory access +' stamp: ''!
nbUInt16AtOffset: zeroBasedOffset
	
	"Reads unsigned 16-bit integer from memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(uint16 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			mov: asm EAX ptr16 + asm ECX to: asm AX
	]
! !

!NBExternalAddress methodsFor: 'memory access +' stamp: ''!
nbUInt64AtOffset: zeroBasedOffset
	
	"Reads unsigned 64-bit integer from memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(uint64 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			mov: asm EAX ptr + asm ECX + 4 to: asm EDX;
			mov: asm EAX ptr + asm ECX to: asm EAX
	]
! !

!NBExternalAddress methodsFor: 'string access' stamp: 'IgorStasenko 11/24/2012 17:04'!
readString
	"sometimes we're just a pointer to string"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(String (self)) emit: [:gen |
		gen asm pop: gen asm EAX ] ! !

!NBExternalAddress methodsFor: 'memory access +' stamp: ''!
nbFloat64AtOffset: zeroBasedOffset put: value
	"Store 64-bit float at ZERO-based index.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong zeroBasedOffset, float64 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			add: asm EAX with: asm ECX;
			
			mov: asm ESP ptr to: asm ECX;
			mov: asm ECX to: asm EAX ptr;

			mov: asm ESP ptr +4 to: asm ECX;
			mov: asm ECX to: asm EAX ptr +4 
	] ! !

!NBExternalAddress methodsFor: 'memory access +' stamp: ''!
nbFloat32AtOffset: zeroBasedOffset put: value
	"Store 32-bit float at ZERO-based index.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong zeroBasedOffset, float32 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX;
			mov: asm EDX to: asm EAX ptr + asm ECX
	] ! !

!NBExternalAddress methodsFor: 'memory access +' stamp: ''!
nbUInt16AtOffset: zeroBasedOffset  put: value
	
	"Store unsigned 16-bit integer into memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong zeroBasedOffset, uint16 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX; "value"
			mov: asm DX to: asm EAX ptr16 + asm ECX
	] ! !

!NBExternalAddress methodsFor: 'memory access +' stamp: ''!
nbInt64AtOffset: zeroBasedOffset  put: value
	
	"Store signed 64-bit integer into memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong zeroBasedOffset, int64 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX; "value low word"
			mov: asm EDX to: asm EAX ptr32 + asm ECX;
			pop: asm EDX; "value high word"
			mov: asm EDX to: asm EAX ptr32 + asm ECX + 4
	]
! !

!NBExternalAddress methodsFor: 'string access' stamp: 'CiprianTeodorov 3/18/2013 22:35'!
writeString: aString
	"write a null-terminated byte string to receiver's address"
	
	| str |
	str := aString copyWith: (Character value: 0).
	NativeBoost memCopy: str asByteArray to: self size: str size.
! !

!NBExternalAddress methodsFor: 'memory access +' stamp: ''!
nbInt32AtOffset: zeroBasedOffset
	
	"Reads signed 32-bit integer from memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(int32 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			mov: asm EAX ptr32 + asm ECX to: asm EAX
	]
! !

!NBExternalAddress methodsFor: 'finalization' stamp: 'CamilloBruni 8/3/2012 15:27'!
free

	NativeBoost free: self! !

!NBExternalAddress methodsFor: 'memory access +' stamp: ''!
nbInt32AtOffset: zeroBasedOffset  put: value
	
	"Store signed 32-bit integer into memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong zeroBasedOffset, int32 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX; "value"
			mov: asm EDX to: asm EAX ptr32 + asm ECX
	]
! !

!NBExternalAddress methodsFor: 'memory access +' stamp: ''!
nbInt64AtOffset: zeroBasedOffset
	
	"Reads signed 64-bit integer from memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(int64 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			mov: asm EAX ptr + asm ECX + 4 to: asm EDX;
			mov: asm EAX ptr + asm ECX to: asm EAX
	]
! !

!NBExternalAddress methodsFor: 'memory access +' stamp: ''!
byteAt: zeroBasedOffset
	
	"Reads signed 8-bit integer from memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(int8 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			mov: asm EAX ptr8 + asm ECX to: asm AL
	]
! !

!NBExternalAddress methodsFor: 'memory access +' stamp: ''!
nbUInt8AtOffset: zeroBasedOffset
	
	"Reads unsigned 8-bit integer from memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(uint8 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			mov: asm EAX ptr8 + asm ECX to: asm AL
	]
! !

!NBExternalAddress methodsFor: 'memory access +' stamp: ''!
nbUInt8AtOffset: zeroBasedOffset  put: value
	
	"Store unsigned 8-bit integer into memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong zeroBasedOffset, uint8 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX; "value"
			mov: asm DL to: asm EAX ptr8 + asm ECX
	] ! !

!NBExternalAddress methodsFor: 'finalization' stamp: 'CamilloBruni 8/3/2012 15:27'!
finalize
	self free! !

!NBExternalAddress methodsFor: 'memory access +' stamp: ''!
byteAt: zeroBasedOffset put: value
	
	"Store signed 8-bit integer into memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong zeroBasedOffset, int8 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX; "value"
			mov: asm DL to: asm EAX ptr8 + asm ECX
	]
! !

!NBExternalAddress methodsFor: 'memory access +' stamp: ''!
nbFloat32AtOffset: zeroBasedOffset
	"Read 32-bit float at ZERO-based index.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(float32 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			add: asm EAX with: asm ECX;
			fld: asm EAX ptr32. "load a floating point value from memory, at base address, held in EAX register into fp(0) register,
				we are using #ptr32, to indicate that memory operand size is 32bits long"
	] ! !

!NBExternalAddress methodsFor: 'finalization' stamp: 'CamilloBruni 8/3/2012 15:30'!
freeAfterUse
	"add ourselves to finalization registry"
	NBExternalResourceManager 
		addResource: self 
		data: self value.
! !

!NBExternalAddress methodsFor: 'memory access +' stamp: ''!
nbFloat64AtOffset: zeroBasedOffset
	"Read 64-bit float at ZERO-based index.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(float64 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "index"
			add: asm EAX with: asm ECX;
			fld: asm EAX ptr64. "load a floating point value from memory, at base address, held in EAX register into fp(0) register,
				we are using #ptr64, to indicate that memory operand size is 64bits long"
	] ! !

!NBExternalAddress methodsFor: 'memory access +' stamp: ''!
nbInt16AtOffset: zeroBasedOffset
	
	"Reads signed 16-bit integer from memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(int16 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			mov: asm EAX ptr16 + asm ECX to: asm AX
	]
! !

!NBExternalAddress methodsFor: 'memory access +' stamp: ''!
nbInt16AtOffset: zeroBasedOffset  put: value
	
	"Store signed 16-bit integer into memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong zeroBasedOffset, int16 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX; "value"
			mov: asm DX to: asm EAX ptr16 + asm ECX
	]
! !

!NBExternalAddress methodsFor: 'memory access +' stamp: ''!
nbInt8AtOffset: zeroBasedOffset  put: value
	
	"Store signed 8-bit integer into memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong zeroBasedOffset, int8 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX; "value"
			mov: asm DL to: asm EAX ptr8 + asm ECX
	]
! !

!NBExternalAddress methodsFor: 'memory access +' stamp: ''!
nbInt8AtOffset: zeroBasedOffset
	
	"Reads signed 8-bit integer from memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(int8 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			mov: asm EAX ptr8 + asm ECX to: asm AL
	]
! !

!NBExternalAddress methodsFor: 'memory access +' stamp: ''!
ulongAt: zeroBasedOffset put: value
	
	"Store unsigned 32-bit integer into memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong zeroBasedOffset, uint32 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX; "value"
			mov: asm EDX to: asm EAX ptr32 + asm ECX
	]
! !

!NBExternalAddress methodsFor: 'comparing' stamp: 'IgorStasenko 8/4/2011 08:25'!
= anObject
	^ anObject class == self class and: [ anObject value = self value]! !

!NBExternalAddress methodsFor: 'memory access +' stamp: ''!
longAt: zeroBasedOffset put: value
	
	"Store signed 32-bit integer into memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong zeroBasedOffset, int32 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX; "value"
			mov: asm EDX to: asm EAX ptr32 + asm ECX
	]
! !

!NBExternalAddress methodsFor: 'memory access +' stamp: ''!
nbUInt32AtOffset: zeroBasedOffset
	
	"Reads unsigned 32-bit integer from memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(uint32 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			mov: asm EAX ptr32 + asm ECX to: asm EAX
	]
! !

!NBExternalAddress methodsFor: 'testing' stamp: 'IgorStasenko 8/4/2011 07:06'!
notNull
	^ self value ~= 0! !

!NBExternalAddress methodsFor: 'memory access +' stamp: ''!
nbUInt64AtOffset: zeroBasedOffset  put: value
	
	"Store unsigned 64-bit integer into memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function:  #(void (self, ulong zeroBasedOffset, uint64 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX; "value low word"
			mov: asm EDX to: asm EAX ptr32 + asm ECX;
			pop: asm EDX; "value high word"
			mov: asm EDX to: asm EAX ptr32 + asm ECX + 4
	]
! !

!NBExternalAddress methodsFor: 'memory access +' stamp: ''!
nbUInt32AtOffset: zeroBasedOffset  put: value
	
	"Store unsigned 32-bit integer into memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong zeroBasedOffset, uint32 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX; "value"
			mov: asm EDX to: asm EAX ptr32 + asm ECX
	]
! !

!NBExternalAddress class methodsFor: 'instance creation' stamp: 'Igor.Stasenko 5/4/2010 01:15'!
asNBExternalType: gen

	^ NBExternalAddressType new ! !

!NBExternalAddress class methodsFor: 'instance creation' stamp: 'Igor.Stasenko 5/17/2010 14:53'!
fromString: aString
	
	| result |
	
	result := NativeBoost allocate: aString size + 1.
	(self assert: result notNil).
	result writeString: aString.
	^ result! !

!NBExternalAddress class methodsFor: 'instance creation' stamp: 'Igor.Stasenko 5/18/2010 00:33'!
null
	^ self new! !

!NBExternalAddress class methodsFor: 'finalization' stamp: 'CamilloBruni 8/3/2012 15:32'!
finalizeResourceData: anExternalAddressValue
	"We use an intermediate interger for address value, 
	otherwise we would hold on to the NBExternalAddress forever"
	(self value: anExternalAddressValue) free! !

!NBExternalAddressTests methodsFor: 'tests' stamp: 'Igor.Stasenko 5/13/2010 22:51'!
testMemoryAccess

	| addr |
	
	addr := NativeBoost allocate: 10.
	[
		1 to: 10 do: [:i |
			addr byteAt: i-1 put: i ].
	
		1 to: 10 do: [:i |
			self assert: (addr byteAt: i-1) = i ].
	] ensure: [ NativeBoost free: addr ]
! !

!NBExternalAddressTests methodsFor: 'tests' stamp: 'IgorStasenko 8/4/2011 07:29'!
testStringAccess

	| addr string |
	
	addr := NativeBoost allocate: 10.
	[
		addr writeString: 'abcde'.
		string := addr readString. 

	] ensure: [ NativeBoost free: addr ].

	self assert: string = 'abcde'
! !

!NBExternalAddressTests methodsFor: 'tests' stamp: 'IgorStasenko 8/4/2011 08:25'!
testAddressAndStruct

	| struct addr string |
	
	struct := NBTestStructure2 new.
	
	self assert: struct addr class == NBExternalAddress .  
	
	addr := NativeBoost allocate: 10.
	[
		addr writeString: 'abcde'.

		struct addr: addr.
		
		self assert: addr = struct addr.

		string := struct addr readString .		
	] ensure: [ NativeBoost free: addr ].

	self assert: string = 'abcde'
! !

!NBExternalAddressTests methodsFor: 'tests' stamp: 'IgorStasenko 7/15/2013 15:47'!
testStructCopy

	| struct addr struct2 |

	[
	struct := NBTestStructure new.
	  
		struct byte: 5;
		long: 10;
		short: 20.
		
	addr := NativeBoost allocate: NBTestStructure instanceSize.
	
	NativeBoost memCopy: struct address to: addr size:  NBTestStructure instanceSize.
	struct2 := NBTestStructure fromPointer: addr.
		  

	self assert: struct2 byte = 5.
	self assert: struct2 long = 10.
	self assert: struct2 short = 20.
	
	] ensure: [
		NativeBoost free: addr ]
! !

!NBExternalAddressType methodsFor: 'emitting code' stamp: 'IgorStasenko 5/28/2012 07:13'!
pushAsValue: gen
	"push handle value"
	| asm proxy oop |
	
	proxy := gen proxy.
	asm := gen asm.
	
	oop := gen reserveTemp.
	loader emitLoad: gen to: oop.
	
	"we can skip class verification, if loader loads receiver, since nothing to fear there"
	loader isReceiver ifFalse: [
		self verifyClassOf: oop is: NBExternalAddress generator: gen.
	].

	proxy varBytesFirstFieldOf: oop.
	
	self valueSize = 4 ifTrue: [
		asm push: asm EAX ptr.
	] ifFalse: [ self notYetImplemented ].

	gen releaseTemps: 1.
! !

!NBExternalAddressType methodsFor: 'emitting code' stamp: 'IgorStasenko 7/1/2013 16:32'!
createInstanceWithValue: address generator: gen
	"Create an instance of NBExternalAddress with given value.
	Answer the resulting oop in EAX"
	| result asm proxy |
	asm := gen asm.
	proxy := gen proxy.
	
	result := gen reserveTemp.
	
	asm mov: address to: result.
	proxy createInstanceOf: NBExternalAddress size: NBExternalType pointerSize.
	asm mov: result to: asm ECX.
	proxy storePointer: asm ECX intoVarbytes: asm EAX at: 0.

	gen releaseTemps: 1.
	
	^ asm EAX! !

!NBExternalAddressType methodsFor: 'emitting code' stamp: 'IgorStasenko 6/28/2013 14:18'!
pushAsPointer: gen

	"push a pointer to external address first indexable field (where address value held)"
	| asm proxy oop |
	
	proxy := gen proxy.
	asm := gen asm.
	
	oop := gen reserveTemp.
	loader emitLoad: gen to: oop.

	"we can skip class verification, if loader loads receiver, since nothing to fear there"
	loader isReceiver ifFalse: [
		self verifyClassOf: oop is: NBExternalAddress generator: gen.
	].

	asm decorateWith: 'NBExternalAddressType>>pushAsPointer:' during: [  	
		proxy varBytesFirstFieldOf: oop.
		asm 
			push: asm EAX ].
	
	gen releaseTemps: 1.
! !

!NBExternalAddressType methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/4/2010 00:56'!
valueSize
	^ self pointerSize! !

!NBExternalAddressType methodsFor: 'emitting code' stamp: 'IgorStasenko 7/1/2013 16:16'!
coerceReturnValue: gen

	"input: address is in EAX. 
	output: ExternalAddress instance oop in EAX
	creates an instance of NBExternalAddress and store the address there"

	| asm result |
	
	asm := gen asm.
	
	result := self createInstanceWithValue: asm EAX generator: gen.
	asm mov: result to: asm EAX.
	
 ! !

!NBExternalArray commentStamp: '<historical>'!
I am abstract class which provides a convenient interface to work with arrays which elements are values of some external (C) type.
In order to use me with concrete element type, you must create a subclass of me and initialize element type properly.

Subclassing using public subclass:
 - if you want to create a public subclass of me, then you should make sure that in class-side #initialize method,
you add self-send #initElementType:  and specify the element type name to use. (And of course, initialize the class before attempting to create any instances).

Subclassing with anonymous subclass:
To create an anonymous subclass of me,  use #ofType: protocol, i.e.:

floatArrayClass := NBExternalArray ofType: 'float'.

Please note that separate #at: / #at:put: methods will be automatically added in each and every subclass. 
Never remove them, despite they looking identical to superclass methods!!
!!!!CAUTION!!!! Currently those methods do not perform any range checking for index. So, please make sure you using sane index values (1<= index <= size). 

Also, note, that class instance variables: elementType and elementSize, once initialized, is considered read-only. 
Changing them, once you created at least a single instance of your class may lead to funny consequences.

Arrays in external memory vs object memory:

My instances can work either with data held in object memory or in external memory. The difference is only at instantiation time: 

To create a new array in object memory, just use #new: protocol: 

	myArray := floatArrayClass new:  10.   "create a new array with 10 floats".

To allocate a new array in external memory, use #externalNew: protocol:   

	myArray := floatArrayClass externalNew:  10.  
	..
	myArray free.  "and sure thing, do not forget to free external memory after use".

To check whether array uses object memory or external memory , use #isExternal protocol.

Also, you can convert any external address into NBExternalArray subclass instance, i.e. suppose some external function returns a pointer (instance of NBExternalAddress):

	pointer := self callSomeFunc: 1. 
	
So, in order to access memory at given address as array of 100 elements of type 'int', you can use following: 

	myArray := (NBExternalArray ofType: 'int') onAddress: pointer size: 100.
	myArray at: 1.  "read first element"
	myArray at: 2 put: 50.  "write second element" 
	myArray do: [:each | ...  ] ... etc
			 
(sure thing, in the above example, the "NBExternalArray ofType: 'int' " expression is just to demonstrate the intent. It should be replaced with some variable, which you initialize only once and use many times, because creating an anonymous subclass each time would be highly ineffective )

Supported protocols: 
  	Since NBExternalTypeArray inherits from ArrayedCollection, you're free to use any protocols defined there as well as in its superclasses.
	There's only few additions comparing to ArrayedCollection, like #isExternal and #free .

Copying:
	a #copy behavior is special for external arrays: A copy will always use object memory, even if original used external memory.
!
!NBExternalArray methodsFor: 'accessing' stamp: 'IgorStasenko 12/7/2012 16:42'!
size
	^ size! !

!NBExternalArray methodsFor: 'private (code generation)' stamp: 'IgorStasenko 12/7/2012 16:44'!
emitCopy: asm 
	"Emit code to copy elementSize bytes from ESP ptr -> EAX ptr "
	| toCopy offset |
	
	toCopy := self class elementSize.
	
	toCopy > 8 ifTrue: [ ^ self emitCopyUsingLoop: asm ].
	
	offset := 0.
	[ toCopy >= 4 ] whileTrue: [
		asm 
			mov: asm ESP ptr + offset to: asm ECX;
			mov: asm ECX to: asm EAX ptr + offset.
			toCopy := toCopy - 4.
			offset := offset + 4.
	].

	toCopy >= 2  ifTrue: [
		asm 
			mov: asm ESP ptr16 + offset to: asm CX;
			mov: asm CX to: asm EAX ptr16 + offset.
		toCopy := toCopy - 2.
		offset := offset + 2.
	].

	toCopy > 0  ifTrue: [
		" last byte "
		asm 
			mov: asm ESP ptr8 + offset to: asm CL;
			mov: asm CL to: asm EAX ptr8 + offset.
	].
! !

!NBExternalArray methodsFor: 'accessing' stamp: 'IgorStasenko 12/7/2012 16:42'!
address
	"For external memory arrays, sometimes we may need to get an address"
	^ data! !

!NBExternalArray methodsFor: 'private (code generation)' stamp: 'IgorStasenko 12/7/2012 16:44'!
emitWrite
	"
	This method generates a native code for #at:put: method.
	The primitive will store a single value at given index in array.
	The value type (elementType) and its size (elementSize) controlled by class side.
	
	Note, data can be either variable-byte object (holding data in object memory), or
	instance of NBExternalAddress (holding data in external memory).
	
	To conform with common #at:put: behavior for collections, answer the value we're just put. 
	
	!!!!!!Note: no range checking for index!!!!!!
	
	"
	
	^ (self nbCalloutIn: thisContext sender)
		function: ' oop ( oop value , uint32 index , void * data , ' , self class elementType , ' value )'
		emit: [:gen :proxy :asm | | oop |
			
			oop := gen reserveTemp.
			"save value oop into temp to answer it when we done"
			asm pop: asm EAX;
				mov: asm EAX to: oop.
				
			" index "
			asm 
				pop: asm EAX;
				dec: asm EAX;
				mov: self class elementSize to: asm ECX;
				mul: asm ECX;
				
				pop: asm ECX; "pointer to array first element " 
				add: asm EAX with: asm ECX.  							

			" EAX now = @data + (elementSize * (index - 1 ) ) "
				
			self emitCopy: asm.

			"and finally, return original object "
			asm mov: oop to: asm EAX .
		].
	
! !

!NBExternalArray methodsFor: 'initialize-release' stamp: 'IgorStasenko 12/7/2012 16:43'!
initializeWithSize: aSize
	"initialize an instance of receiver with data held in object memory heap "
	size := aSize.
	data := ByteArray new: size * self class elementSize.
	

	! !

!NBExternalArray methodsFor: 'private (code generation)' stamp: 'IgorStasenko 12/7/2012 16:44'!
emitRead
	"
	This method generates a native code for #at: method
	the primitive will read a single element at given index in array.
	the value type (elementType) and its size (elementSize) controlled by class side.
	
	Note, data (instance variable) can hold either variable-byte object (holding data in object memory), or
	instance of NBExternalAddress s
	
	!!!!!!Note: no range checking for index!!!!!!
	"
	^ (self nbCalloutIn: thisContext sender) 
		function: 'oop ( uint32 index , void * data )'
		emit: [:gen :proxy :asm |

			" index "
			asm 
				pop: asm EAX;
				dec: asm EAX;
				mov: self class elementSize to: asm ECX;
				mul: asm ECX;
				
				pop: asm ECX; "pointer to array first element -> ECX " 
				add: asm EAX with: asm ECX.  
							
			" EAX <- @data + (elementSize * (index - 1 ) ) "
				
			"Emit code to read a value from given address and return oop"
			(gen resolveType: self class elementType) readOop: asm EAX ptr generator: gen.
		]
! !

!NBExternalArray methodsFor: 'initialize-release' stamp: 'IgorStasenko 12/7/2012 16:43'!
initializeWithAddress: anExternalAddress Size: aSize
	"initialize an instance of receiver with data held in external memory"
	size := aSize.
	data := anExternalAddress.
	

	! !

!NBExternalArray methodsFor: 'accessing' stamp: 'IgorStasenko 12/7/2012 16:42'!
at: index put: value
	"Set value at 1-based index.
	Note, this method used as a template for my anonymous subclasses. "
	
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self emitWrite ! !

!NBExternalArray methodsFor: 'accessing' stamp: 'IgorStasenko 12/7/2012 16:42'!
at: index
	"Answer an element using 1-based index.
	Note, this method used as a template for my anonymous subclasses. "
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self emitRead! !

!NBExternalArray methodsFor: 'copying' stamp: 'IgorStasenko 12/7/2012 16:43'!
postCopy
	
	self isExternal ifTrue: [
		"copy the data from external memory into newly allocated byte array "
		| newData sz |
		sz := self class elementSize * size.
		newData := ByteArray new: sz.
		NativeBoost memCopy: data to: newData size: sz.
		data := newData.
	] ifFalse: [
		data := data copy.
	]! !

!NBExternalArray methodsFor: 'testing' stamp: 'IgorStasenko 12/7/2012 16:44'!
isExternal
	"answer true if data referenced by receiver located in external heap, or just in object memory "
	^ data class ~= ByteArray ! !

!NBExternalArray methodsFor: 'initialize-release' stamp: 'IgorStasenko 12/7/2012 16:43'!
free
	"A convenience method, to explicitly free external memory, symmetrical when using
	#externalNew: protocol for creating receiver.
	Do nothing if receiver is not external array. 
	" 
	self isExternal ifTrue: [
		data free.
	].! !

!NBExternalArray methodsFor: 'private (code generation)' stamp: 'IgorStasenko 12/7/2012 16:44'!
emitCopyUsingLoop: asm
	| ssi sdi |
	"copy the value using loop "
	ssi := asm reserveTemp.
	sdi := asm reserveTemp.
	asm 
		mov: asm ESI to: ssi;
		mov: asm EDI to: sdi;
		cld;
		mov: asm ESP to: asm ESI;
		mov: asm EAX to: asm EDI;
		mov: self class elementSize to: asm ECX;
		rep;movsb;
		mov: ssi to: asm ESI;
		mov: sdi to: asm EDI;
		releaseTemps: 2.
! !

!NBExternalArray class methodsFor: 'instance creation' stamp: 'IgorStasenko 12/7/2012 16:45'!
new: numberOfElements

	^ self basicNew initializeWithSize: numberOfElements! !

!NBExternalArray class methodsFor: 'class initialization' stamp: 'StephaneDucasse 8/13/2013 17:42'!
initialize

	NBExternalArray allSubclassesDo: #installAccessors.! !

!NBExternalArray class methodsFor: 'accessing' stamp: 'IgorStasenko 12/7/2012 16:45'!
elementSize
	^ elementSize! !

!NBExternalArray class methodsFor: 'class initialization' stamp: 'IgorStasenko 6/27/2013 16:15'!
initElementType:  aTypeName
	"Initialize the element type and size.
	
	If you want to use a public subclass of me, then make sure you call this method
	in your class #initialize method.
	" 

	elementType := aTypeName.
	elementSize := (NBFFICallout new requestor: self; resolveType: elementType) typeSize .
	self installAccessors.! !

!NBExternalArray class methodsFor: 'session management' stamp: 'IgorStasenko 4/1/2014 17:21'!
updateElementSize
	"Update the element size, in case of session change where type is an external structure which
	uses different memory alignment on given platform
	" 
	elementSize := (NBFFICallout new requestor: self; resolveType: elementType) typeSize .
! !

!NBExternalArray class methodsFor: 'private' stamp: 'IgorStasenko 2/3/2014 18:16'!
installAccessors
	"Copy superclass methods, which serve as a template where generated code will be installed.
	Each subclass of NBExternalArray should implement (override) these key methods "
	Author useAuthor: 'NativeBoost' during: [ 
		self basicAddSelector: #at: withMethod: (NBExternalArray >> #at: ) copy.
		self basicAddSelector: #at:put: withMethod: (NBExternalArray >> #at:put: ) copy.
		self organization classify:  #at: under: NativeBoost automaticallyGeneratedCodeCategory.
		self organization classify:  #at:put: under: NativeBoost automaticallyGeneratedCodeCategory.
	].! !

!NBExternalArray class methodsFor: 'class factory' stamp: 'CiprianTeodorov 12/16/2012 15:50'!
ofType: aTypeName
	"Answer an anonymous subclass of receiver, ready for use for creating array(s) with given element type."

	^ self anonymousSubclassInitElementType: aTypeName! !

!NBExternalArray class methodsFor: 'private' stamp: 'IgorStasenko 12/3/2013 13:37'!
anonymousSubclassInitElementType: aTypeName
	"create and initialize the anonymous subclass of me"

	^ NBExternalArray newAnonymousSubclass initElementType: aTypeName.
! !

!NBExternalArray class methodsFor: 'instance creation' stamp: 'IgorStasenko 12/7/2012 16:45'!
onAddress: anNBExternalAddress size: desiredSize
	
	^ self basicNew initializeWithAddress: anNBExternalAddress Size: desiredSize
! !

!NBExternalArray class methodsFor: 'instance creation' stamp: 'IgorStasenko 12/7/2012 16:45'!
externalNew: numberOfElements
	"answer a fresh instance of receiver, allocated on external memory "
	
	^ self onAddress: (NativeBoost allocate: elementSize * numberOfElements) size: numberOfElements! !

!NBExternalArray class methodsFor: 'accessing' stamp: 'IgorStasenko 12/7/2012 16:45'!
elementType
	^ elementType! !

!NBExternalArray class methodsFor: 'session management' stamp: 'IgorStasenko 3/31/2014 16:21'!
initializeForNewSession

	self allSubclassesDo: [ :each | each updateElementSize ]! !

!NBExternalArrayTest methodsFor: 'tests - instances' stamp: 'IgorStasenko 12/7/2012 02:22'!
testBasicProtocol

	| cls array |
	
	cls := self apiClass ofType: 'int32' .
		
	array := cls new: 10.
	
	self assert: array size equals: 10.
	
	"instantiating with #new: should create an array in object memory "
	self assert: array isExternal equals: false.
	
	self assert: (array at: 1 put: 42) equals: 42.
	self assert: (array at: 1) equals: 42.
	
	self assert: (array at: 10 put: 420) equals: 420.
	self assert: (array at: 10) = 420.
	
	! !

!NBExternalArrayTest methodsFor: 'misc' stamp: 'IgorStasenko 12/7/2012 16:06'!
apiClass
	^ NBExternalArray ! !

!NBExternalArrayTest methodsFor: 'tests - instances' stamp: 'IgorStasenko 12/7/2012 02:45'!
testExternalArray

	| cls array |
	
	cls := self apiClass ofType: 'int32' .
		
	[ array := cls externalNew: 10.
	
	self assert: array size equals: 10.
	
	"instantiating with #externalNew: should create an array in external memory "
	self assert: array isExternal equals: true.
	
	self assert: (array at: 1 put: 42) equals: 42.
	self assert: (array at: 1) equals: 42.
	
	self assert: (array at: 10 put: 420) equals: 420.
	self assert: (array at: 10) = 420.
	] ensure: [ array free ] 
	! !

!NBExternalArrayTest methodsFor: 'tests - instances' stamp: 'IgorStasenko 12/7/2012 02:44'!
testExternalCopy

	| cls array copy |
	
	cls := self apiClass ofType: 'int32' .
		
	[
		array := cls externalNew: 10.
		array at: 1 put: 2.
		array at: 2 put: 3.
		copy := array copy.
	
		"#copy of external array should create a copy in object memory heap " 
		self assert: copy isExternal equals: false.
		
		"and , of course, copies should be equal "
		self assert: array = copy.	
	] ensure: [ array free ] 
	! !

!NBExternalArrayTest methodsFor: 'tests - class protocols' stamp: 'IgorStasenko 12/7/2012 02:22'!
testAnonymousClassCreation

	| cls |
	
	cls := self apiClass ofType: 'int32' .
	
	"should get an anonymous subclass" 
	self assert: (cls inheritsFrom: self apiClass).
	
	".. with properly initialized values" 
	self assert: cls elementType equals: 'int32'.
	self assert: cls elementSize = 4 .
	
	" and, of course, they should not be the same object" 
	self assert: cls ~~ self apiClass.
	! !

!NBExternalArrayTest methodsFor: 'tests - class protocols' stamp: 'IgorStasenko 12/7/2012 01:22'!
testAccessors

	"make sure a generated class has accessors installed "
	| cls m_at m_atput |
	
	cls := self apiClass ofType: 'int32' .
	
	self assert: (cls methodDict includesKey: #at: ).
	self assert: (cls methodDict includesKey: #at:put: ).
	
	m_at := cls compiledMethodAt: #at: .
	m_atput  := cls compiledMethodAt: #at:put: .

	"make sure they are properly installed"	
	self assert: m_at methodClass == cls.
	self assert: m_atput methodClass == cls.

	"make sure they are not same as in superclass "
	
	self assert: m_at ~~ (self apiClass compiledMethodAt: #at: ).
	self assert: m_atput ~~ (self apiClass compiledMethodAt: #at:put: ).
! !

!NBExternalEnumFromPairsTest methodsFor: 'accessing' stamp: 'CiprianTeodorov 12/13/2012 20:14'!
cbClass
	^NBTestCallbackReturnEnum1  ! !

!NBExternalEnumFromPairsTest methodsFor: 'native' stamp: 'CiprianTeodorov 12/13/2012 20:26'!
primEnumToInt1: aMyEnumInst
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	^ NBFFICallout 
		cdecl: {NBInt32. {self enumClass. #aMyEnumInst}}
		emitCall: [ :gen :proxy :asm | 
			asm pop: asm EAX 
		]! !

!NBExternalEnumFromPairsTest methodsFor: 'accessing' stamp: 'CiprianTeodorov 12/13/2012 20:27'!
enumToInt: anEnum 
	^self primEnumToInt1: anEnum ! !

!NBExternalEnumFromPairsTest methodsFor: 'native' stamp: 'CiprianTeodorov 12/13/2012 20:25'!
primExecuteCallbackEnumReturn1: anEnumCb
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	^ NBFFICallout
		cdecl: {self enumClass. {self cbClass. #anEnumCb}}
		emitCall: [ :gen :proxy :asm | 
			asm pop: asm EAX.
			asm push: 2400 asImm.
			asm call: asm EAX ]
		options: #(#optMayGC)! !

!NBExternalEnumFromPairsTest methodsFor: 'accessing' stamp: 'CiprianTeodorov 12/13/2012 20:25'!
executeCb: anEnumCb

	^self primExecuteCallbackEnumReturn1: anEnumCb
	! !

!NBExternalEnumFromPairsTest methodsFor: 'accessing' stamp: 'CiprianTeodorov 12/13/2012 20:01'!
enumClass
	^NBTestEnumerationFromPairs ! !

!NBExternalEnumTests methodsFor: 'accessing' stamp: 'CiprianTeodorov 12/13/2012 20:06'!
cbClass
	 ^NBTestCallbackReturnEnum! !

!NBExternalEnumTests methodsFor: 'tests' stamp: 'CiprianTeodorov 12/13/2012 20:27'!
testEnumToInt

	self assert: (self enumToInt:  self enumClass AAA) = 1.
	self assert: (self enumToInt: self enumClass BBB) = 2.
	self assert: (self enumToInt: self enumClass CCC) = 3.
	self assert: (self enumToInt: self enumClass DDD) = 2400.! !

!NBExternalEnumTests methodsFor: 'accessing' stamp: 'CiprianTeodorov 12/13/2012 20:06'!
callback
	^ self cbClass on: [ :anInt | self enumClass at: (self enumClass itemAt: anInt) ]! !

!NBExternalEnumTests methodsFor: 'accessing' stamp: 'CiprianTeodorov 12/13/2012 20:27'!
enumToInt: anEnum

	^self primEnumToInt: anEnum ! !

!NBExternalEnumTests methodsFor: 'tests' stamp: 'CiprianTeodorov 12/10/2012 19:58'!
testEnumIncludes
	self assert: (self enumClass includes: #DDD).
	self deny: (self enumClass includes: #EEE)! !

!NBExternalEnumTests methodsFor: 'tests' stamp: 'CiprianTeodorov 12/10/2012 19:57'!
testIntToEnum

	self assert: (self primIntToEnum: 1) value = 1 .
	self assert: (self primIntToEnum: 2) value = 2.
	self assert: (self primIntToEnum: 3) value = 3.
	self assert: (self primIntToEnum: 2400) value = 2400.! !

!NBExternalEnumTests methodsFor: 'tests' stamp: 'MarcusDenker 2/27/2013 09:00'!
testCallbackWrongReturn
	"there is an issue with callback return. If it fails I cannot see how we can catch the exception and continue"
	"so this test is supposed to fail for now."
	"In the future we might accept enumeration representation values (int/uint) and fix this"
	self skip.
	self should: [Error signal. self primExecuteCallbackEnumReturn: self callbackWrongReturn ] raise: NBNativeCodeError! !

!NBExternalEnumTests methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/23/2013 12:44'!
testCallbackEnumFromInt
	|result|
	self skip.
	result := (self executeCb:  self callback ).
	self assert: (result isKindOf: self enumClass ).
	self assert: result value = 2400.
	self assert: result item = #DDD. ! !

!NBExternalEnumTests methodsFor: 'native' stamp: 'CiprianTeodorov 12/13/2012 20:04'!
primEnumToInt: aMyEnumInst
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	^ NBFFICallout 
		cdecl: {NBInt32. {self enumClass. #aMyEnumInst}}
		emitCall: [ :gen :proxy :asm | 
			asm pop: asm EAX 
		]! !

!NBExternalEnumTests methodsFor: 'tests' stamp: 'CiprianTeodorov 12/13/2012 19:59'!
testFromIntegerFailure
	self should: [ self enumClass fromInteger: 234 ] raise: Error! !

!NBExternalEnumTests methodsFor: 'tests' stamp: 'CiprianTeodorov 12/10/2012 21:04'!
testNewError
	self should: [ self enumClass new ] raise: ShouldNotImplement! !

!NBExternalEnumTests methodsFor: 'initialize-release' stamp: 'CiprianTeodorov 12/13/2012 20:02'!
initialize
	super initialize.
	self enumClass initialize! !

!NBExternalEnumTests methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 8/24/2013 14:06'!
testCallbackAAA
	|result|
	self skip: 'workaround: this crashes the VM sometimes'.
	result := (self executeCb:  self callbackAAA ).
	self assert: (result isKindOf: self enumClass ).
	self assert: result value = 1.
	self assert: result item = #AAA.! !

!NBExternalEnumTests methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/23/2013 12:46'!
primExecuteCallbackEnumReturn: anEnumCb

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	"This code misssing the stack alignment before doing callback.
	most probably is the reason of crashing VM."
	
	self halt.
	^ NBFFICallout
		cdecl: {self enumClass. {self cbClass. #anEnumCb}}
		emitCall: [ :gen :proxy :asm | 
			asm pop: asm EAX.
			asm push: 2400 asImm.
			asm call: asm EAX ]
		options: #(#optMayGC)! !

!NBExternalEnumTests methodsFor: 'accessing' stamp: 'CiprianTeodorov 12/13/2012 20:24'!
executeCb: anEnumCb

	^self primExecuteCallbackEnumReturn: anEnumCb
	! !

!NBExternalEnumTests methodsFor: 'tests' stamp: 'CiprianTeodorov 12/10/2012 20:11'!
testEnumIdents
	self assert: self enumClass AAA value = 1.
	self assert: self enumClass DDD value = 2400! !

!NBExternalEnumTests methodsFor: 'accessing' stamp: 'CiprianTeodorov 12/13/2012 20:06'!
callbackAAA
	^ self cbClass on: [ :anInt | self enumClass AAA ]! !

!NBExternalEnumTests methodsFor: 'native' stamp: 'CiprianTeodorov 12/13/2012 20:05'!
primIntToEnum: anInteger
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	^ NBFFICallout 
		cdecl: {self enumClass. {#NBInt32. #anInteger}}
		emitCall: [ :gen :proxy :asm | 
			asm pop: asm EAX. 
		]! !

!NBExternalEnumTests methodsFor: 'accessing' stamp: 'CiprianTeodorov 12/13/2012 20:06'!
callbackWrongReturn
	^ self cbClass
		on: [ :anInt | 
			"this callback will return a plain integer"
			self enumClass itemAt: anInt ]! !

!NBExternalEnumTests methodsFor: 'tests' stamp: 'CiprianTeodorov 12/13/2012 19:59'!
testFromIntegerOk

	self assert: (self enumClass fromInteger:  1) value = 1 .
	self assert: (self enumClass fromInteger: 2) value = 2.
	self assert: (self enumClass fromInteger: 3) value = 3.
	self assert: (self enumClass fromInteger: 2400) value = 2400.! !

!NBExternalEnumTests methodsFor: 'tests' stamp: 'CiprianTeodorov 12/10/2012 19:57'!
testIntToEnumNotIncluded

	self assert: (self primIntToEnum: 7) value = 7.
	self assert: (self primIntToEnum: 3) value = 3.
	
	self assert: (self primIntToEnum: 7) item isNil.
	self assert: (self primIntToEnum: 256) item isNil.! !

!NBExternalEnumTests methodsFor: 'tests' stamp: 'CiprianTeodorov 12/13/2012 20:07'!
testNotEnumMember
	self should: [ self enumClass TTT ] raise: MessageNotUnderstood ! !

!NBExternalEnumTests methodsFor: 'accessing' stamp: 'CiprianTeodorov 12/11/2012 19:53'!
enumClass
	^NBTestEnumeration ! !

!NBExternalEnumeration commentStamp: 'CiprianTeodorov 12/12/2012 23:03'!
NBExternalEnumerationType reifies the enum declarations in C and offers a nice interface (especially in terms of debug/inspect).
To use it just subclass the NBExternalEnumeration and add an #enumDecl method to the class side such as:

NBExternalEnumeration subclass: #NBTestEnumeration
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NativeBoost-Tests'

NBTestEnumeration class>>enumDecl
	^ {(#AAA -> 1).
	(#BBB -> 2).
	(#CCC -> 3).
	(#DDD -> 2400)} asDictionary 

DO NOT FORGET to call the #initialize method on your class. The rest is automatically done ;)

You can use your new enum in two ways:
	- add it to a client class poolDictionaries list (see  #NBExternalEnumTests for an example), 
		and then just write CCC in your code -- CCC here is an item of your enum
	- send the name of an item to your class --- NBTestEnumeration DDD

The NBExternalEnumeration implements  (instance and class) some more API methods like:
	#itemAt: retrieves the item having a specific value  --- NBTestEnumeration itemAt: 2
	#includes: checks the existence of a specific item in the enum --- NBTestEnumeration includes: #AAA!
!NBExternalEnumeration methodsFor: 'accessing' stamp: 'CamilloBruni 2/23/2013 13:06'!
value

	^value! !

!NBExternalEnumeration methodsFor: 'comparing' stamp: 'CamilloBruni 2/23/2013 13:05'!
= anEnumInst

	^ self class == anEnumInst class and: [ self value = anEnumInst value ]! !

!NBExternalEnumeration methodsFor: 'accessing' stamp: 'CamilloBruni 2/23/2013 13:06'!
value: anObject

	value := anObject ! !

!NBExternalEnumeration methodsFor: 'accessing' stamp: 'CamilloBruni 2/23/2013 13:05'!
item

	^ self class itemAt: value! !

!NBExternalEnumeration methodsFor: 'printing' stamp: 'CamilloBruni 2/23/2013 13:06'!
printOn: stream
	super printOn: stream.

	stream nextPut: $(;
		 nextPutAll: self item printString;
		 nextPut: $)! !

!NBExternalEnumeration class methodsFor: 'error handling' stamp: 'CiprianTeodorov 12/10/2012 20:01'!
doesNotUnderstand: aMessage
	| v |
	^ (v := self at: aMessage selector) ifNil: [ super doesNotUnderstand: aMessage ] ifNotNil: [ v ]! !

!NBExternalEnumeration class methodsFor: 'enum declaration' stamp: 'CiprianTeodorov 12/15/2012 15:19'!
enumDecl
	^#()! !

!NBExternalEnumeration class methodsFor: 'class initialization' stamp: 'MaxLeske 3/12/2015 22:56'!
initialize
	| unsigned |
	unsigned := true.
	self
		classPool:
			(self initializeEnum associations
				collect: [ :assoc | 
					(unsigned and: [ assoc value < 0 ])
						ifTrue: [ unsigned := false ].
					ClassVariable
						key: assoc key
						value: (self basicNew value: assoc value) ]) asDictionary.
	representationType := unsigned
		ifTrue: [ NBUInt32 new ]
		ifFalse: [ NBInt32 new ]! !

!NBExternalEnumeration class methodsFor: 'instance creation' stamp: 'CiprianTeodorov 12/10/2012 19:59'!
new
	^self shouldNotImplement ! !

!NBExternalEnumeration class methodsFor: 'accessing' stamp: 'CiprianTeodorov 12/10/2012 20:20'!
at: anItem
	^ self classPool at: anItem ifAbsent: [ nil ]! !

!NBExternalEnumeration class methodsFor: 'accessing' stamp: 'CiprianTeodorov 12/10/2012 20:17'!
itemAt: aValue ifAbsent: exceptionBlock
	self classPool
		associationsDo: [ :assoc | 
			aValue = assoc value value
				ifTrue: [ ^ assoc key ] ].
	^ exceptionBlock value! !

!NBExternalEnumeration class methodsFor: 'accessing' stamp: 'CiprianTeodorov 12/13/2012 19:57'!
fromInteger: anIntegerValue
	| theItem |
	theItem := self itemAt: anIntegerValue.
	theItem ifNil: [ self error: 'Invalid value for ' , self name , ' enumeration' ].
	^ self at: theItem! !

!NBExternalEnumeration class methodsFor: 'converting' stamp: 'CiprianTeodorov 2/6/2013 21:34'!
asNBExternalType: aTypeName
	^ NBExternalEnumerationType objectClass: self representationType: self representationType! !

!NBExternalEnumeration class methodsFor: 'class initialization' stamp: 'CiprianTeodorov 12/13/2012 08:20'!
initializeEnum
	| decl |
	decl := self enumDecl.
	decl isDictionary
		ifTrue: [ ^ decl ].
	decl := Dictionary newFromPairs: decl.
	^ decl! !

!NBExternalEnumeration class methodsFor: 'accessing' stamp: 'CiprianTeodorov 2/6/2013 21:34'!
representationType
	^representationType! !

!NBExternalEnumeration class methodsFor: 'accessing' stamp: 'CiprianTeodorov 12/10/2012 20:17'!
itemAt: aValue
	^ self itemAt: aValue ifAbsent: [ nil ]! !

!NBExternalEnumeration class methodsFor: 'testing' stamp: 'CiprianTeodorov 12/10/2012 19:47'!
includes: aSymbol
	^self classPool includesKey: aSymbol ! !

!NBExternalEnumerationType methodsFor: 'accessing' stamp: 'CiprianTeodorov 12/11/2012 21:45'!
valueSize
	^4! !

!NBExternalEnumerationType methodsFor: 'emitting code' stamp: 'IgorStasenko 6/28/2013 14:19'!
pushAsPointer: gen

	self error: 'Pointer to enumeration values are not supported'.
	! !

!NBExternalEnumerationType methodsFor: 'accessing' stamp: 'CiprianTeodorov 12/25/2012 13:29'!
objectClass: anObject
	objectClass := anObject! !

!NBExternalEnumerationType methodsFor: 'emitting code' stamp: 'CiprianTeodorov 2/6/2013 21:51'!
coerceOopToOperand: gen ifFailedJumpTo: aLabel
	"coerce a object - oop , provided by loader and then put a result into an appropriate 
	operand (memory/register), answer that operand"

	| asm proxy oop class |
	self assert: pointerArity = 0.
	asm := gen asm.
	proxy := gen proxy.
	oop := gen reserveTemp.
	class := gen reserveTemp.
	asm mov: asm EAX to: oop.
	gen proxy fetchClassOf: oop.
	asm mov: asm EAX to: class.
	gen emitFetchClass: self objectClass.
	asm
		cmp: asm EAX with: class;
		jne: aLabel.
	proxy fetchPointer: self valueIvarIndex ofObject: oop.	"value ivar"
	self representationType coerceOopToOperand: gen ifFailedJumpTo: aLabel.
	asm push: asm EAX.
	gen releaseTemps: 2! !

!NBExternalEnumerationType methodsFor: 'printing' stamp: 'CiprianTeodorov 12/25/2012 13:29'!
printOn: aStream

	aStream nextPutAll: 'External enum(' , objectClass name , ')'
! !

!NBExternalEnumerationType methodsFor: 'accessing' stamp: 'CiprianTeodorov 12/11/2012 19:19'!
representationType: anObject
	representationType := anObject! !

!NBExternalEnumerationType methodsFor: 'accessing' stamp: 'CiprianTeodorov 12/25/2012 13:29'!
valueIvarIndex
	" return a zero-based index "
	^ ( objectClass instVarIndexFor: #value ifAbsent: [ self error: ' should not happen ' ] ) - 1
! !

!NBExternalEnumerationType methodsFor: 'accessing' stamp: 'CiprianTeodorov 12/11/2012 19:19'!
representationType
	^ representationType! !

!NBExternalEnumerationType methodsFor: 'accessing' stamp: 'CiprianTeodorov 12/25/2012 13:29'!
objectClass
	^ objectClass! !

!NBExternalEnumerationType methodsFor: 'emitting code' stamp: 'CiprianTeodorov 2/6/2013 21:38'!
coerceReturnValue: gen

	"value is in EAX, get a ST Integer and place it in the value ivar"

	| asm proxy  valueOop oop done |
	
	proxy := gen proxy.
	asm := gen asm.
	valueOop := gen reserveTemp.
	oop := gen reserveTemp.

	self representationType coerceReturnValue: gen.
	asm mov: asm EAX to: valueOop.
	proxy pushRemappableOop: valueOop.
	
	gen emitFetchClass: objectClass.
	
	proxy instantiateClass: asm EAX indexableSize: 0.
	"EAX <- our instance "
	asm mov: asm EAX to: oop.
	proxy popRemappableOop.
	asm mov: asm EAX to: valueOop.
	
	proxy storePointer: self valueIvarIndex ofObject: oop  withValue: valueOop.
	asm mov: oop to: asm EAX.  "return the oop"

	gen releaseTemps: 2.! !

!NBExternalEnumerationType methodsFor: 'emitting code' stamp: 'CiprianTeodorov 12/25/2012 13:29'!
pushAsValue: gen

	"push value"
	|asm proxy oop|
	proxy := gen proxy.
	asm := gen asm.
	oop := gen reserveTemp.
	loader emitLoad: gen to: oop.
	
	"Special case: do not emit type checking if argument is receiver"
	(loader isReceiver and: [  gen requestor  includesBehavior: objectClass ])
	ifFalse: [
		self verifyClassOf: oop is: objectClass generator: gen.
	].

	proxy fetchPointer: (self valueIvarIndex) ofObject: oop. "value ivar"
	proxy integerValueOf: asm EAX. "handle value"
	asm push: asm EAX.
	
	gen releaseTemps: 1.
! !

!NBExternalEnumerationType class methodsFor: 'instance creation' stamp: 'CiprianTeodorov 12/25/2012 13:29'!
objectClass: aClass representationType: anIntegerType
	^ self new
		objectClass: aClass;
		representationType: anIntegerType! !

!NBExternalEnumerationType class methodsFor: 'instance creation' stamp: 'CiprianTeodorov 12/25/2012 13:29'!
objectClass: aClass
	^ self objectClass: aClass representationType: NBUInt32 new! !

!NBExternalHandle commentStamp: 'IgorStasenko 2/24/2012 17:37'!
Usually, my instances representing an opaque object handle returned by external function. There's little what we can do with it, except from passing as argument to another function(s).

I hold a byte array of a pointer size (typicaly 4 or 8 bytes). You can set the raw handle value with #value: and read it with #value.


Note, do not subclass from me directly. If you want to represent some opaque C  data structure (handle, stucture, pointer to structure etc),
subclass from NBExternalObject instead. Otherwise, if you insist, override #asNBExternalType: method on class side in own subclass to provide own marshalling 
for instances of your subclass(es) (but it makes even less sense since once you define own #asNBExternalType:, you free to use any base class for your subclasses,
unless of course you want to reuse some of my methods)!
!NBExternalHandle methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/3/2010 02:41'!
asUnsignedLong
	"slow version"
	^ (self at: 1)
	+ ((self at: 2) << 8)
	+ ((self at: 3) <<16)
	+ ((self at: 4) << 24)! !

!NBExternalHandle methodsFor: 'accessing' stamp: 'IgorStasenko 11/24/2012 16:20'!
value
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCallout function: #(size_t () ) emit: [:gen :proxy :asm | 
		proxy receiver.
		proxy varBytesFirstFieldOf: asm EAX.
		
		self class instanceSize = 4 ifTrue: [
			asm mov: asm EAX ptr to: asm EAX.

		] ifFalse: [	
			"not implemented yet, sorry"
			self notYetImplemented.
		].
	] 
! !

!NBExternalHandle methodsFor: 'accessing' stamp: 'IgorStasenko 11/24/2012 16:20'!
value: aPositiveInteger
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCallout function: #(oop (size_t aPositiveInteger)) emit: [:gen :proxy :asm |
		
		self class instanceSize = 4 ifTrue: [ | temp |

			proxy receiver.
			proxy varBytesFirstFieldOf: asm EAX.
			
			asm  
				mov: asm ESP ptr to: asm EDX;
				mov: asm EDX to: asm EAX ptr.
					
		] ifFalse: [	
			"not implemented yet, sorry"
			self notYetImplemented.
		].
	
		proxy receiver 
	]
! !

!NBExternalHandle methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/3/2010 13:32'!
asUImm32
	^ self asUnsignedLong asUImm32! !

!NBExternalHandle methodsFor: 'printing' stamp: 'Igor.Stasenko 4/29/2010 12:28'!
printOn: aStream

	aStream nextPutAll: '@ 16r';
		nextPutAll: (self value printStringBase: 16)

! !

!NBExternalHandle methodsFor: 'comparing' stamp: 'TorstenBergmann 8/13/2013 20:03'!
= anotherExternalHandle

	^self species = anotherExternalHandle species
		and: [ self value = anotherExternalHandle value ]
		! !

!NBExternalHandle methodsFor: 'testing' stamp: 'IgorStasenko 6/2/2012 14:38'!
isNull
	^ self value = 0! !

!NBExternalHandle methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/3/2010 13:25'!
asUImm
	^ self asUnsignedLong asUImm! !

!NBExternalHandle methodsFor: '*Fuel' stamp: 'M 3/2/2014 21:14'!
fuelReplacement
	^ nil! !

!NBExternalHandle class methodsFor: 'instance creation' stamp: 'IgorStasenko 2/24/2012 17:02'!
asNBExternalType: gen

	self error: 'use NBExternalObject instead'.
	
	"Note, do not subclass from me directly. If you want to represent any opaque C structure (stucture, pointer to structure etc),
	subclass from NBExternalObject instead. Otherwise, if you insist, override this method in own subclass to provide own marshalling 
	for instances of your object(s)"! !

!NBExternalHandle class methodsFor: 'instance creation' stamp: 'Igor.Stasenko 5/2/2010 14:08'!
value: aValue
	^ self new value: aValue! !

!NBExternalHandle class methodsFor: 'instance creation' stamp: 'IgorStasenko 5/26/2012 14:55'!
new
	^ self basicNew: self instanceSize ! !

!NBExternalHandle class methodsFor: 'fields description' stamp: 'IgorStasenko 5/26/2012 14:57'!
instanceSize 

	^ NBExternalType pointerSize ! !

!NBExternalHeapManager commentStamp: 'Igor.Stasenko 9/25/2010 10:04'!
This is a simplistic implementation of external heap manager.

Using it , you can allocate or free external memory.

- should not throw any exceptions.

If allocation fails, should simply answer nil/0 !
!NBExternalHeapManager methodsFor: 'memory operations' stamp: 'Igor.Stasenko 9/25/2010 00:45'!
allocate: numBytes
	"Allocate a numBytes on heap, answer an address to first byte of allocated memory"
	
	
	^ sema critical: [ 	| freeBlock page |

		"yes, the free space search is implemented naively, by now"
		freeBlock := freeBlocks 
			detect: [:block | block length >= numBytes]
			ifNone: [ page := self allocatePage: numBytes.  page firstBlock ].

		freeBlock reserve: numBytes for: self.
		reservedBlocks at: freeBlock address put: freeBlock.
		freeBlock address
	]
! !

!NBExternalHeapManager methodsFor: 'memory operations' stamp: 'Igor.Stasenko 9/24/2010 23:44'!
free: address


	sema critical: [	| block |
		block := reservedBlocks removeKey: address ifAbsent: [
			self error: 'Unable to find a memory block with given address' ].
	
		block makeFreeFor: self ]
	! !

!NBExternalHeapManager methodsFor: 'callbacks' stamp: 'Igor.Stasenko 9/25/2010 00:48'!
addFreeBlock: aMemoryBlock

	"Check if free block covers entire page.
	and if it is, then free the page"
	
	(self checkForFreePage: aMemoryBlock) ifFalse: [
		freeBlocks add: aMemoryBlock
		]
! !

!NBExternalHeapManager methodsFor: 'memory pages' stamp: 'Igor.Stasenko 9/25/2010 00:18'!
alignToPageSize: requestedSize

	" pages is 4kb wide"
	| u align |
	align := self pageAlignment.
	
	^ (u := requestedSize \\ align) > 0 
		ifTrue: [ requestedSize + align - u ] 
		ifFalse: [ requestedSize ]! !

!NBExternalHeapManager methodsFor: 'memory pages' stamp: 'Igor.Stasenko 9/25/2010 00:11'!
allocatePage: requestedSize

	| bytesToAllocate addr page |
	
	bytesToAllocate := self alignToPageSize: (self minimumPageSize max: requestedSize).

	addr := self primAllocatePage: bytesToAllocate.
	
	page := NBMemoryPage address: addr length: bytesToAllocate.
	pages at: addr put: page.
	^ page
 ! !

!NBExternalHeapManager methodsFor: 'testing' stamp: 'Igor.Stasenko 9/24/2010 23:51'!
isValidAddress: anAddress

	^ self isValidAddress: anAddress size: 1! !

!NBExternalHeapManager methodsFor: 'memory pages' stamp: 'Igor.Stasenko 9/25/2010 00:35'!
minimumPageSize
	" lets grab minimum 32kb pages"
	
	^ 32768! !

!NBExternalHeapManager methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/25/2010 00:22'!
numBlocks
	^ freeBlocks size + reservedBlocks size! !

!NBExternalHeapManager methodsFor: 'memory pages' stamp: 'Igor.Stasenko 9/25/2010 00:06'!
pageAlignment
	" x86 4kb pages"
	
	^ 4096! !

!NBExternalHeapManager methodsFor: 'abstract' stamp: 'Igor.Stasenko 9/25/2010 00:19'!
primAllocatePage: numBytes
	self subclassResponsibility ! !

!NBExternalHeapManager methodsFor: 'callbacks' stamp: 'Igor.Stasenko 9/24/2010 23:43'!
removeFreeBlock: aMemoryBlock

	freeBlocks remove: aMemoryBlock ifAbsent: []! !

!NBExternalHeapManager methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/25/2010 00:22'!
numPages
	^ pages size! !

!NBExternalHeapManager methodsFor: 'initialization' stamp: 'Igor.Stasenko 9/24/2010 23:57'!
initialize
	sema := Semaphore forMutualExclusion.
	pages := Dictionary new.
	freeBlocks := IdentitySet new.
	reservedBlocks := Dictionary new.! !

!NBExternalHeapManager methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/25/2010 00:36'!
numAllocatedBlocks
	^ reservedBlocks size! !

!NBExternalHeapManager methodsFor: 'testing' stamp: 'Igor.Stasenko 9/25/2010 00:20'!
isValidAddress: anAddress size: numBytes
	"check, if given memory range (at given address and numBytes size)
	 is valid (currently allocated) using this heap manager "
	^ sema critical: [
		reservedBlocks anySatisfy: [:blk |
			blk address <= anAddress and: [blk address + blk length >= (anAddress + numBytes)]]
	]! !

!NBExternalHeapManager methodsFor: 'memory pages' stamp: 'Igor.Stasenko 9/25/2010 00:50'!
freePage: aMemoryPage
	pages removeKey: aMemoryPage address.
	freeBlocks remove: aMemoryPage firstBlock ifAbsent: [].
	
	^ self primFreePage: aMemoryPage
 ! !

!NBExternalHeapManager methodsFor: 'callbacks' stamp: 'Igor.Stasenko 9/25/2010 00:47'!
checkForFreePage: aMemoryBlock

	"Check if free block covers entire page.
	and if it is, then free the page"
	
	pages at: aMemoryBlock address ifPresent: [:page |
		page length = aMemoryBlock length ifTrue: [ self freePage: page. ^ true]
		].
	
	^ false! !

!NBExternalHeapManager methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/25/2010 00:36'!
numFreeBlocks
	^ freeBlocks size! !

!NBExternalHeapManager methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/24/2010 23:31'!
totalAllocatedMemory
	| total |
	
	total := 0.
	sema critical: [
		reservedBlocks valuesDo: [:blk | total := total + blk length ]].
	^ total! !

!NBExternalHeapManager methodsFor: 'abstract' stamp: 'Igor.Stasenko 9/25/2010 00:19'!
primFreePage: aMemoryPage

	self subclassResponsibility
 ! !

!NBExternalHeapManagerTests methodsFor: 'tests' stamp: 'FernandoOlivero 10/5/2010 20:47'!
testAllocate
	" 
		self new testAllocate 
	
	"
	| heap address size |
	
	size := 100.
	heap := self newHeap.
	
	address := heap allocate: size.
	
	self assert:  ( heap isValidAddress: address size: size ) .
	self assert:   heap totalAllocatedMemory = size.
	self assert:   heap numPages = 1 .
	self assert:  heap numAllocatedBlocks = 1.

	heap free: address.

	self assert: heap numAllocatedBlocks = 0.
	self assert: heap numPages = 0 .
	self assert: heap numBlocks = 0 .
	self assert:  (heap isValidAddress: address size: size) not .
	
	self assert: heap totalAllocatedMemory = 0.
	
	
	! !

!NBExternalHeapManagerTests methodsFor: 'tests' stamp: 'FernandoOlivero 10/5/2010 20:45'!
testAllocate2
	" 
		self new testAllocate2 
	
	"
	| heap addr1 addr2 |
	
	heap := self newHeap.

	addr1 := heap allocate: 1.
	addr2 := heap allocate: 2.
	
	self assert:  heap totalAllocatedMemory = 3 .
	self assert:  heap numAllocatedBlocks = 2 .

	heap free: addr1.

	self assert:  heap numAllocatedBlocks = 1.
	self assert:  heap totalAllocatedMemory = 2 .

	heap free: addr2.
	
	self assert:  heap numPages = 0 .
	self assert: heap numBlocks = 0 .
	self assert:  heap totalAllocatedMemory = 0 .
	
	
	
! !

!NBExternalHeapManagerTests methodsFor: 'accessing' stamp: 'IgorStasenko 8/5/2011 07:20'!
newHeap
	^  NBMockExternalHeapManager new! !

!NBExternalLibraryWrapper methodsFor: 'utils' stamp: 'IgorStasenko 11/24/2012 16:22'!
call: fnSpec
	" you can override this method if you need to"

	^ (self nbCalloutIn: thisContext sender)
		cdecl;	
		function: fnSpec module: self libraryNameOrHandle
! !

!NBExternalLibraryWrapper methodsFor: 'utils' stamp: 'IgorStasenko 8/20/2011 13:27'!
libraryNameOrHandle

	"provide a handle to the receiver's library"
	self subclassResponsibility 	! !

!NBExternalLibraryWrapper class methodsFor: 'helper' stamp: 'IgorStasenko 11/24/2012 16:23'!
createSimpleMethodFor: aSpec
	^ String
		streamContents: [ :str | 
			str
				nextPutAll: aSpec asMethodSelectorAndArguments;
				crtab;
				nextPutAll: '<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>';
				cr;
				crtab;
				nextPutAll: '^ self call: ';
				nextPutAll: aSpec asArraySpec;
				cr ]! !

!NBExternalLibraryWrapper class methodsFor: 'helper' stamp: 'IgorStasenko 11/24/2012 16:23'!
createArrayedMethodFor: aSpec


	^ String streamContents: [:str |
		str 
			nextPutAll: aSpec asMethodSelectorAndArrayOfArguments ;
			crtab;
			nextPutAll: '<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>';
			cr;
			crtab;
			nextPutAll: 'argsArray size = ', aSpec arguments size printString, ' ifFalse:[^Error signal: ''Incorrect number of arguments''].';
			crtab;
			nextPutAll: '^ self call: ';
			nextPutAll: aSpec asArraySpecArrayedArgs ;
			cr
	].


		
! !

!NBExternalLibraryWrapper class methodsFor: 'helper' stamp: 'cipt 10/21/2012 20:14'!
createMethodFor: aCFunctionDefinition
	"find the function name"

	| typeAndName spec source cat |
	"the parameter list follows the fn name "
	spec := NBFnSpec namedFunctionFrom: aCFunctionDefinition.
	spec arguments size > 15
		ifTrue: [ 
			source := self createArrayedMethodFor: spec.
			cat := 'automatically generated arrayed' ]
		ifFalse: [ 
			source := self createSimpleMethodFor: spec.
			cat := 'automatically generated' ].
	self compile: source classified: cat! !

!NBExternalObject commentStamp: 'IgorStasenko 2/24/2012 17:40'!
I representing an external object of one kind, provided by some external library/function.

My instance holds a handle, which is used to identify the external object when i am passed as an argument, or when i'm used as a return type in function signature.
A typical usage of me is to create a subclass, and then use that subclass name directly in function signatures:

NBExternalObject subclass: #MyExternalObject

newObj := MyExternalObject newObject.

MyExternalObject class>>newObject
  <primitive: #primitiveNativeCall ...>
 ^ self nbCall: #(MyExternalObject someExternalFunction() )

here, assume that someExternalFunction() returns some handle (or pointer) to some opaque external structure. By putting NBExternalObject subclass (MyExternalObject) as a return type
into the function signature, we are telling the code generator to automatically convert the return value into an instance of a given class and initialize its handle to the value returned by the function.

When used as argument type, the value, which is used to pass to the external function is value held in my handle instance variable:

MyExternalObject>>compareWith: anotherExternalObject
  <primitive: #primitiveNativeCall ...>
   ^ self nbCall: #( void compare ( self , MyExternalObject anotherExternalObject))

The main advantage of using NBExternalObject subclass as a type name for arguments is that it provides type safety by checking the incoming argument, that it
is an instance of your class, and nothing else. If not, the primitive will fail without calling the external function.
!
!NBExternalObject methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/17/2010 05:03'!
handle
	^ handle value! !

!NBExternalObject methodsFor: 'initialization' stamp: 'Igor.Stasenko 4/29/2010 12:25'!
initialize
	handle := NBExternalHandle new! !

!NBExternalObject methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/17/2010 05:03'!
handle: aUint
	handle value: aUint! !

!NBExternalObject methodsFor: 'external resource management' stamp: 'IgorStasenko 6/11/2012 05:36'!
registerAsExternalResource
	"Note, subclasses should implement #resourceData
	and #finalizeResourceData: on class side"
	NBExternalResourceManager addResource: self.
	! !

!NBExternalObject methodsFor: 'printing' stamp: 'Igor.Stasenko 4/29/2010 10:21'!
printOn: aStream

	super printOn: aStream.
	aStream nextPutAll: '( 0x';
		nextPutAll: (handle value printStringBase: 16);
		space;
		nextPut: $)! !

!NBExternalObject methodsFor: 'testing' stamp: 'Igor.Stasenko 5/17/2010 14:33'!
isNull
	^ handle value = 0! !

!NBExternalObject class methodsFor: 'instance creation' stamp: 'Igor.Stasenko 5/17/2010 14:29'!
null
	^ self new! !

!NBExternalObject class methodsFor: 'instance creation' stamp: 'Igor.Stasenko 4/29/2010 09:18'!
asNBExternalType: gen

	^ NBExternalObjectType objectClass: self! !

!NBExternalObjectType commentStamp: 'Igor.Stasenko 4/29/2010 09:17'!
I providing coercions for
NBExternalObject and its subclasses!
!NBExternalObjectType methodsFor: 'emitting code' stamp: 'IgorStasenko 7/1/2013 11:10'!
coerceReturnValue: gen

	"handle is in EAX. 
	first, create an instance of NBExternalHandle. Place the handle there ,
	then create an instance of receiver and place handle oop in its handle ivar"

	| asm proxy result handleOop oop done |
	
	proxy := gen proxy.
	asm := gen asm.
	result := gen reserveTemp.
	handleOop := gen reserveTemp.
	oop := gen reserveTemp.
	done := asm uniqueLabelName: 'done'.
	
	asm mov: asm EAX to: result.

	gen optReturnNullAsNil ifTrue: [ | notnil |
		notnil := asm uniqueLabelName: 'notNil'.
		
		asm 
			or: asm EAX with: asm EAX;
			jne: notnil.
		proxy nilObject.
		asm jmp: done.
		asm label: notnil.
	].	
	gen emitFetchClass: NBExternalHandle.
	
	proxy instantiateClass: asm EAX indexableSize: self pointerSize.
	asm mov: asm EAX to: handleOop.

	proxy varBytesFirstFieldOf: asm EAX.
	asm mov: result to: asm ECX;
		mov: asm ECX to: asm EAX ptr.
	
	proxy pushRemappableOop: handleOop.

	gen receiver ifNil: [ gen emitFetchClass: objectClass. ] ifNotNil: [proxy receiver].
	
	proxy instantiateClass: asm EAX indexableSize: 0.
	"EAX <- our instance "
	asm mov: asm EAX to: oop.
	proxy popRemappableOop.
	asm mov: asm EAX to: handleOop.
	
	proxy storePointer: self handleIvarIndex ofObject: oop  withValue: handleOop.
	
	asm mov: oop to: asm EAX.  "return the oop"

	gen releaseTemps: 3.
	asm label: done.
	! !

!NBExternalObjectType methodsFor: 'emitting code' stamp: 'IgorStasenko 7/1/2013 11:12'!
pushAsValue: gen
	"push handle value"
	| asm proxy oop |
	
	proxy := gen proxy.
	asm := gen asm.
	
	oop := gen reserveTemp.
	loader emitLoad: gen to: oop.
	
	"Special case: do not emit type checking if argument is receiver"
	(loader isReceiver and: [  gen requestor  includesBehavior: objectClass ])
	ifFalse: [
		self verifyClassOf: oop is: objectClass generator: gen.
	].

	proxy fetchPointer: (self handleIvarIndex) ofObject: oop. "handle ivar"
	proxy varBytesFirstFieldOf: asm EAX. "handle value ptr"
	asm mov: asm EAX ptr to: asm EAX. "handle value"
	asm push: asm EAX.
	
	gen releaseTemps: 1.

	! !

!NBExternalObjectType methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/29/2010 09:22'!
handleIvarIndex
	" return a zero-based index "
	^ ( objectClass instVarIndexFor: #handle ifAbsent: [ self error: ' should not happen ' ] ) - 1! !

!NBExternalObjectType methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/29/2010 09:18'!
objectClass: aClass
	objectClass := aClass! !

!NBExternalObjectType methodsFor: 'printing' stamp: 'Igor.Stasenko 5/18/2010 01:25'!
printOn: aStream

	aStream nextPutAll: 'External Object(' , objectClass name , ')'! !

!NBExternalObjectType methodsFor: 'emitting code' stamp: 'Igor.Stasenko 4/29/2010 09:15'!
coerceReturnPointer: gen

	
	self error: 'returning pointer to handle ?'

	"super coerceReturnPointer: gen"! !

!NBExternalObjectType methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/29/2010 09:18'!
objectClass
	^ objectClass! !

!NBExternalObjectType methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/29/2010 13:52'!
valueSize
	^ self pointerSize! !

!NBExternalObjectType methodsFor: 'emitting code' stamp: 'IgorStasenko 7/1/2013 11:12'!
pushAsPointer: gen 
	"push a pointer to handle value"
	| asm proxy oop |
	
	proxy := gen proxy.
	asm := gen asm.
	
	oop := gen reserveTemp.
	loader emitLoad: gen to: oop.

	"we can skip class verification, if loader loads receiver, since nothing to fear there"
	loader isReceiver ifFalse: [
		self verifyClassOf: oop is: objectClass generator: gen.
	].
	
	proxy fetchPointer: (self handleIvarIndex) ofObject: oop. "handle ivar"
	proxy varBytesFirstFieldOf: asm EAX. "handle value ptr"
	asm push: asm EAX.
	
	gen releaseTemps: 1.
! !

!NBExternalObjectType class methodsFor: 'instance creation' stamp: 'Igor.Stasenko 4/29/2010 09:16'!
objectClass: aClass
	^ self new objectClass: aClass! !

!NBExternalResourceExecutor commentStamp: '<historical>'!
i am responsible for finalizing an external resource,
registered using external resource manager.

When object, registered as external resource being garbage collected,
i telling an object's class to finalize it's associated data (by passing an object,
received from #resourceData message sent to an object at registration time).

I automatically keep tracking for session change (image save/boot), and ignore finalization of resources of old sessions (since they are not longer valid,
and cannot be freed since session changed).

Like that, a users of NBExternalResourceManager don't need to implement a session checking logic, and need only to:

a) register object as external resource:
     NBExternalResourceManager addResource: anObject.

an object should understand the #resourceData message, which is remembered at registration point (it can be any external resource like, id, handle or memory pointer).

Then, when object is garbage collected, its class will receive a message to finalize the resource data in #finalizeResourceData:
The passed data is exactly same as previously returned by #resourceData method.

An example:

Imagine that you want to represent an external resource by keeping its handle.

Object subclass: #MyExternalObject
 	instanceVariableNames: 'handle'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'XYZ'
	

To let your object(s) to be managed by external resource manager, you need to register it.
Usually you do it after successfully claiming an external resource:

MyExternalObject>>initialize

	handle := self createNewExternalResource.  "claim resource"
	self assert: self handleIsValid. "etc..."
	
	"Now, register receiver as external resource" 
	NBExternalResourceManager addResource: self 
"Another form of use is: 
	NBExternalResourceManager addResource: self data: handle.
"

----  
If you used #addResource: method for registration, you should provide an implementation of #resourceData method:

MyExternalObject>>resourceData
	^ handle "since we need only handle to identify external resource"

----	
Now, for properly finalizing the external resource we should implement:

MyExternalObject class>> finalizeResourceData: aHandle
	^ self destroyHandle: aHandle. "do whatever is needed to destroy the handle"

Note that in #finalizeResourceData: you cannot access any other properties of your instance, since it is already garbage collected. You also don't need to do a session checking, since it is done automatically by resource manager. 

!
!NBExternalResourceExecutor methodsFor: 'finalizing' stamp: 'IgorStasenko 5/28/2012 03:54'!
finalize 
	(NativeBoost sessionChanged: session) ifFalse: [
		resourceClass finalizeResourceData: data
	]! !

!NBExternalResourceExecutor methodsFor: 'initialization' stamp: 'IgorStasenko 3/23/2012 13:06'!
initialize 
	session := NativeBoost uniqueSessionObject ! !

!NBExternalResourceExecutor methodsFor: 'initialize-release' stamp: 'IgorStasenko 3/23/2012 13:04'!
resourceClass: aResourceClass data: aData

	resourceClass := aResourceClass.
	data := aData! !

!NBExternalResourceManager commentStamp: '<historical>'!
i am responsible for managing a finalization of external resources.

When object, registered as external resource being garbage collected,
i telling an object's class to finalize it's associated data (by passing an object,
received from #resourceData message sent to an object at registration time).

I automatically keep tracking for session change (image save/boot), and ignore finalization of resources of old sessions (since they are not longer valid,
and cannot be freed since session changed).

Like that, a users of NBExternalResourceManager don't need to implement a session checking logic, and need only to:

a) register object as external resource:
     NBExternalResourceManager addResource: anObject.

b) an object should understand the #resourceData message, which is remembered at registration point (it can be any external resource like, id, handle or memory pointer).

Then, when object is garbage collected, its class will receive a message to finalize the resource data in #finalizeResourceData:
The passed data is exactly same as previously returned by #resourceData method.

An example:

Imagine that you want to represent an external resource by keeping its handle.

Object subclass: #MyExternalObject
 	instanceVariableNames: 'handle'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'XYZ'
	

To let your object(s) to be managed by external resource manager, you need to register it.
Usually you do it after successfully claiming an external resource:

MyExternalObject>>initialize

	handle := self createNewExternalResource.  "claim resource"
	self assert: self handleIsValid. "etc..."
	
	"Now, register receiver as external resource" 
	NBExternalResourceManager addResource: self 
"Another form of use is: 
	NBExternalResourceManager addResource: self data: handle.
"

----  
If you used #addResource: method for registration, you should provide an implementation of #resourceData method:

MyExternalObject>>resourceData
	^ handle "since we need only handle to identify external resource"

----	
Now, for properly finalizing the external resource we should implement:

MyExternalObject class>> finalizeResourceData: aHandle
	^ self destroyHandle: aHandle. "do whatever is needed to destroy the handle"

Note that in #finalizeResourceData: you cannot access any other properties of your instance, since it is already garbage collected. You also don't need to do a session checking, since it is done automatically by resource manager. 

!
!NBExternalResourceManager methodsFor: 'external resource management' stamp: 'IgorStasenko 3/27/2012 19:11'!
addResource: anObject data: resourceData

	registry add: anObject executor: 
		(NBExternalResourceExecutor new resourceClass: anObject class data: resourceData)! !

!NBExternalResourceManager methodsFor: 'initialization' stamp: 'IgorStasenko 6/2/2012 14:43'!
initialize 
	registry := NBFinalizationRegistry new! !

!NBExternalResourceManager methodsFor: 'external resource management' stamp: 'IgorStasenko 3/27/2012 19:11'!
addResource: anObject 

	^ self addResource: anObject data: anObject resourceData
! !

!NBExternalResourceManager class methodsFor: 'accessing' stamp: 'IgorStasenko 3/23/2012 13:08'!
soleInstance 
	^ soleInstance ifNil: [ soleInstance  := self new ]! !

!NBExternalResourceManager class methodsFor: 'instance creation' stamp: 'IgorStasenko 6/2/2012 14:37'!
reset
	soleInstance := self new.! !

!NBExternalResourceManager class methodsFor: 'resource management' stamp: 'IgorStasenko 3/28/2012 18:42'!
addResource: anObject data: aData
	self soleInstance addResource: anObject data: aData! !

!NBExternalResourceManager class methodsFor: 'resource management' stamp: 'IgorStasenko 3/23/2012 13:13'!
addResource: anObject 
	self soleInstance addResource: anObject ! !

!NBExternalString commentStamp: 'IgorStasenko 8/10/2011 18:46'!
NBExternalString type can be used to coerce squeak's String to char* back and forth.

Use #String or #NBExternalString as type name.

Some functions may accept null as a valid argument (if string is optional).
You can set #optStringOrNull in callout options in that case.

If type is used as return value type, then C string (char *) converted to ByteString instance.
If return value is null, a nil will be answered instead.!
!NBExternalString methodsFor: 'emitting code' stamp: 'Igor.Stasenko 4/28/2010 13:44'!
pushAsValue: gen

	gen asm push: address.

! !

!NBExternalString methodsFor: 'emitting code' stamp: 'IgorStasenko 7/1/2013 11:13'!
prepareArgumentUsing: gen

	"prepare the ByteString argument.
	Allocate a space for string on stack, then copy string contents there
	and add terminating null character "
	
	| asm stringOop len loop done donePreparing notNil |
	
	asm := gen asm.
	
	loop := asm uniqueLabelName: 'loop'.
	done := asm uniqueLabelName: 'done'.
	notNil  := asm uniqueLabelName: 'notNil'.
	donePreparing := asm uniqueLabelName: 'donePreparing'.
	    
	loader emitLoad: gen.

	"reserve after emitting load, otherwise, if proxy using stackpointer temp, it will be clobbered"
	address := gen reserveTemp.  
	stringOop := gen reserveTemp.
	len := gen reserveTemp.

	asm mov: EAX to: stringOop.
	
	gen optStringOrNull ifTrue: [
		"allow passing nil as string, effectively will push null pointer as argument"
		gen proxy nilObject.
		asm 
			cmp: EAX with: stringOop;
			jne: notNil;
			mov: 0 to: address;  "null pointer"
			jmp: donePreparing.
	].
	asm label: notNil.
	gen proxy isBytes: stringOop.
	
	asm or: EAX with: EAX.
	asm jz: gen failedLabel.
	
	gen proxy byteSizeOf: stringOop.
	asm mov: EAX to: len.
	asm inc: EAX. "add 1 byte for terminating null character"
	gen reserveStackBytes: EAX andStoreAddrTo: address.

	gen proxy varBytesFirstFieldOf: stringOop.

	asm decorateWith: ' copy string contents to the stack ' during: [
	asm 
		push: ESI;
		push: EDI;
		mov: EAX to: ESI;
		mov: address to: EDI;
		mov: len to: ECX;
"		rep; movsb;  -- is flat memory model has ES=DS ? "
	label: loop;
		dec: ECX;
		jl: done;
		mov: ESI ptr to: AL;
		mov: AL to: EDI ptr;
		inc: ESI;
		inc: EDI;
		jmp: loop;
	label: done;
		mov: 0 to: EDI ptr8;  "store null-terminating character"
		pop: EDI;
		pop: ESI.
	].
	gen releaseTemps: 2.  "keep the address reserved, otherwise it will be clobbered"
	asm label: donePreparing   ! !

!NBExternalString methodsFor: 'emitting code' stamp: 'Igor.Stasenko 5/2/2010 20:38'!
strLen: gen
	" input: EAX - pointer to char* string
	 output: ECX - string length "
	| loop end asm |
	asm := gen asm.
	
	loop := asm uniqueLabelName: 'loop'.
	end := asm uniqueLabelName: 'end'.
	asm 
		mov: EAX to: ECX;
	label: loop;
		cmp: ECX ptr8 with: 0;
		je: end;
		inc: ECX;
		jmp: loop;
	label: end;
		sub: ECX with: EAX.
		
	^ ECX
! !

!NBExternalString methodsFor: 'emitting code' stamp: 'Igor.Stasenko 4/28/2010 20:26'!
pushAsPointer: gen 

	self error: 'Strings already passed as a pointer'.! !

!NBExternalString methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/28/2010 15:56'!
valueSize
	^ self pointerSize "i am live and die as a pointer"! !

!NBExternalString methodsFor: 'emitting code' stamp: 'IgorStasenko 7/1/2013 11:12'!
coerceReturnValue: gen
	"
	Copy a null-terminated C string into a newly created instance of ByteString
	input - char* string in EAX
	output - String oop in EAX "
	
	| cPtr strLen oop asm proxy notNull done |

	asm := gen asm.
	proxy := gen proxy.
	
	cPtr := gen reserveTemp.
	strLen := gen reserveTemp.
	oop := gen reserveTemp.
	notNull := asm uniqueLabelName: 'notNull'.
	done := asm uniqueLabelName: 'done'.
	
	
	asm mov: EAX to: cPtr.

	"check if return value is NULL, then answer nil instead" 
	asm 
		or: EAX with: EAX;
		jnz: notNull.

	proxy nilObject.
	asm jmp: done.		

	asm label: notNull.
	
	"count a number of characters"
	asm mov: (self strLen: gen) to: strLen.

	proxy classString.
	proxy instantiateClass: EAX indexableSize: strLen.
	
	asm mov: EAX to: oop. "oop"
	
	"copy the string"
	proxy varBytesFirstFieldOf: EAX.
	asm 
		push: ESI;
		push: EDI;
		mov: cPtr to: ESI;
		mov: EAX to: EDI;
		mov: strLen to: ECX;
		rep; movsb; 
		pop: EDI;
		pop: ESI;
		mov: oop to: EAX.

	asm label: done.
		
	gen releaseTemps: 3.
! !

!NBExternalStructure commentStamp: '<historical>'!
I representing external structures to closely mimic 'struct' types in C.
A C structure has transparent access to its fields: that is, a structure is transparent if you know its fields and can modify them. This is in contrast of opaque structures, which you never manipulate directly but through functions.

For each struct type, you define a subclass of me, and implement the #fieldsDesc class method. 
The #fieldDesc method should answer an array containing enumeration of structure fields in form of type and name, much like in C syntax, for example:

fieldDesc
	^ #(
		int field1;
		float field2;
		void* field3;
	).

Once you define the structure fields and initialize the class, you can create the instances of it and access the fields by their name (the accessor methods are generated automatically).	
An external structure can be allocated in object memory, or in external memory, using #new, or #externalNew correspondingly.
To test if given instance is allocated on external heap you can use #isExternal method.

For passing (sub)instance of NBExternalStructure as argument to external function, the function argument type must be resolved to refer to corresponding class, e.g. if you defined class MyStructure, the external function signature must use it like 'void foo (MyStructure arg)', or if you want to preserve an original C function signature as much as close to original, use aliases for type (so type with name '_C_struct_type_name_whatever' should resolve to 'MyStructure' at the end).

You can use external structure for  passing by value (MyStruct param),
or passing by pointer (MyStruct* param) both, depending of what external function expecting.

In case if you want to pass a pointer to structure, but function signature does not explicitly uses a struct type (like 'void* someParam'),
you can use #address accessor and pass it as parameter to function,e.g.

someObject callExternalFunctionWith: mystruct address.

Using external structure as return type: if external function returns a struct type:
MyStruct foo() 
the marshaller creates an instance of MyStruct on object memory, then lets function modify its fields and aswers the resulting object. 

If function returns a pointer to structure, like 'MyStruct * foo()',
then marshaller will create an instance of MyStruct as return value,
and store an address returned by function as instance of NBExternalAddress in its data ivar (effectively making the structure instance external). 

Please be aware, that #free method can only be used if you allocated an external structure by yourself , using #externalNew , but not for instances which returned by external function or when given memory is controlled by external library or was allocated using other means.!
!NBExternalStructure methodsFor: 'dnu' stamp: 'CiprianTeodorov 3/27/2013 21:47'!
doesNotUnderstand: aMessage

	self class isInitialized ifFalse: [
		"retry send after initialization"
		self class initializeAccessors.
		^ aMessage sentTo: self
	].

	^ super doesNotUnderstand: aMessage! !

!NBExternalStructure methodsFor: 'copying' stamp: 'jb 8/9/2013 17:00'!
postCopy
	"Copy is always internal, e.g, when making copy of structure with external address,
	 a copy will hold same data in its bytearray (in object memory)
	"
	self isExternal 
		ifFalse: [ data := data copy ]
		ifTrue: [ 
			| newData |
			newData := ByteArray new: self class instanceSize.
			NativeBoost memCopy: data to: newData size: self class instanceSize.
			data := newData
	 ]! !

!NBExternalStructure methodsFor: 'initialize-release' stamp: 'jb 8/9/2013 16:08'!
initializeInternal
	"initialize receiver with data held in object memory heap "
	data := ByteArray new: self class instanceSize.

	self initialize.! !

!NBExternalStructure methodsFor: 'printing' stamp: 'CiprianTeodorov 3/27/2013 21:47'!
printOn: aStream 
	"Append to the argument, aStream, the names and values of all the record's variables."

	Printing == true ifTrue: [ 
		"since we use field accessors for printing values,
		debugging the code with not-yet nativised accessors leads to infinite loop"
		^ aStream nextPutAll: self class name; nextPutAll: '(...)'.	
		].
	
	Printing := true.
	[ 
		aStream nextPutAll: self class name; nextPutAll: ' ( '; cr.
		self class fields namesInDeclarationOrder do: [ :field |
			aStream nextPutAll: field; nextPut: $:; space; tab.
				(self perform: field ) printOn: aStream.
				] separatedBy: [ aStream cr ].
		aStream cr; nextPut: $). ]
	ensure: [	Printing := false ].
	! !

!NBExternalStructure methodsFor: 'private' stamp: 'IgorStasenko 7/1/2013 14:01'!
fieldAt: aFieldName put: value
	"This method is used by auto-generated accessor method(s) to generate code for accessing
	field(s) of external structure. Do not override"

	^ NBFFICallout handleFailureIn: thisContext sender
		nativeCode: [:gen | self emitWrite: aFieldName generator: gen. gen bytes ]
! !

!NBExternalStructure methodsFor: 'testing' stamp: 'IgorStasenko 7/1/2013 14:15'!
isExternal
	"answer true if data referenced by receiver located in external heap, or just in object memory "
	^ data class == NBExternalAddress! !

!NBExternalStructure methodsFor: 'private' stamp: 'IgorStasenko 7/1/2013 14:01'!
fieldAt: aFieldName
	"This method is used by auto-generated accessor method(s) to generate code for accessing
	field(s) of external structure. Do not override"
	^ (self nbCalloutIn: thisContext sender)
		function: 'oop (void *data)'
		emit: [:gen | self emitRead: aFieldName generator: gen. ]
! !

!NBExternalStructure methodsFor: 'acccessing' stamp: 'IgorStasenko 7/1/2013 14:18'!
address
	"Answer an object which can be used as an address, pointing to first byte of external structure."
	^data! !

!NBExternalStructure methodsFor: 'private' stamp: 'IgorStasenko 7/1/2013 14:16'!
emitWrite: aFieldName generator: gen
	| offset type asm size rcvr fieldAddr |
			
	gen requestor: self class.
	type := self class fields typeOf: aFieldName.
	offset := self class fields offsetOf: aFieldName.
	rcvr := gen reserveTemp.
	fieldAddr := gen reserveTemp.

	asm := gen asm.
	type loader: (NBSTMethodArgument new stackIndex: 0).
	type emitPush: gen. "push value on stack"
		
	gen proxy stackValue: 1.  "receiver oop"
	asm mov: asm EAX to: rcvr.
	
	NBExternalStructureType new 
		objectClass: self class;
		fetchStructAddressFrom: rcvr gen: gen.
	
	"now, in EAX the address to first byte of external structure"
	offset > 0 ifTrue: [
	 	asm add: asm EAX with: offset ].
	
	asm mov: asm EAX to: fieldAddr.

	gen emitFailureTest. "important to check if everything ok, before we write value to receiver"
	
	size := type typeSize.
	
	"just copy the value from stack to the struct field"
	
	asm 
		mov: fieldAddr to: asm EAX.	
	offset := 0.
	[ size >= 4 ] whileTrue: [
		asm 
			mov: asm ESP ptr + offset to: asm ECX;
			mov: asm ECX to: asm EAX ptr + offset.
		size := size - 4.
		offset := offset + 4.
	].

	size >= 2  ifTrue: [
		asm 
			mov: asm ESP ptr16 + offset to: asm CX;
			mov: asm CX to: asm EAX ptr16 + offset.
		size := size - 2.
		offset := offset + 2.
	].

	size > 0  ifTrue: [
		" last byte "
		asm 
			mov: asm ESP ptr8 + offset to: asm CL;
			mov: asm CL to: asm EAX ptr8 + offset.
	].

	"answer the receiver"
	asm mov: rcvr to: asm EAX.
	gen epilogue.
	gen emitFailureHandler.
	
	^ gen
	! !

!NBExternalStructure methodsFor: 'initialize-release' stamp: 'CiprianTeodorov 4/7/2013 21:38'!
initializeWithAddress: anExternalAddress
	"initialize the receiver with data held in external memory"
	data := anExternalAddress.
! !

!NBExternalStructure methodsFor: 'private' stamp: 'CiprianTeodorov 3/28/2013 19:45'!
emitRead: aFieldName generator: gen
	| offset type asm mem |
			
	gen requestor: self class.
	type := self class fields typeOf: aFieldName.
	offset := self class fields offsetOf: aFieldName.

	asm := gen asm.
			
	asm pop: asm EAX.

	"load the value"
	mem := asm EAX ptr + offset.
	
	"read a value from given location and return oop"
	type readOop: mem generator: gen.

	^ gen! !

!NBExternalStructure methodsFor: 'initialize-release' stamp: 'IgorStasenko 7/1/2013 14:12'!
free
	"A convenience method, to explicitly free external memory, symmetrical when using
	#externalNew protocol for creating receiver.
	Do nothing if receiver is not pointing to external heap. 
	" 
	self isExternal ifTrue: [
		data free.
	].! !

!NBExternalStructure class methodsFor: 'alignment' stamp: 'CiprianTeodorov 3/27/2013 21:47'!
byteAlignment
	
	"default "
	^ NativeBoost forCurrentPlatform pointerSize
! !

!NBExternalStructure class methodsFor: 'accessing' stamp: 'CiprianTeodorov 3/27/2013 21:47'!
fields

	^ currentFields ifNil: [
		self rebuildFieldAccessors.
		currentFields
	].! !

!NBExternalStructure class methodsFor: 'instance creation' stamp: 'IgorStasenko 7/1/2013 14:19'!
fromPointer: externalAddress

	"Create an instance of receiver from given external address. "
	
	^self basicNew initializeWithAddress: externalAddress.
	! !

!NBExternalStructure class methodsFor: 'instance creation' stamp: 'IgorStasenko 7/1/2013 14:13'!
externalNew
	"Allocate enough bytes on external heap to hold my instance data, then answer an instance
	which using external data.
	
	Please note, that if you create my instances on external heap, do not forget to free memory after use, e.g.
	
	struct address free.
	"
	
	^ self fromPointer: (NativeBoost allocate: self instanceSize).
! !

!NBExternalStructure class methodsFor: 'ffi type' stamp: 'CiprianTeodorov 3/27/2013 21:47'!
asNBExternalType: gen
	^ NBExternalStructureType objectClass: self! !

!NBExternalStructure class methodsFor: 'managing accessors' stamp: 'CiprianTeodorov 5/19/2013 03:56'!
removeAccessor: aSelector
	methodDict at: aSelector ifAbsent: [ ^ self ].
	self removeSelectorSilently: aSelector.
	

	! !

!NBExternalStructure class methodsFor: 'accessing' stamp: 'CiprianTeodorov 3/27/2013 21:47'!
fieldsClass
	^NBExternalStructureFields ! !

!NBExternalStructure class methodsFor: 'session management' stamp: 'IgorStasenko 3/31/2014 11:44'!
initializeForNewSession

	self allSubclassesDo: [ :each | each updateFieldOffsets ]! !

!NBExternalStructure class methodsFor: 'testing' stamp: 'CiprianTeodorov 3/27/2013 21:47'!
isInitialized
	^ initialized == true! !

!NBExternalStructure class methodsFor: 'instance creation' stamp: 'IgorStasenko 7/1/2013 14:14'!
new
	^self basicNew initializeInternal! !

!NBExternalStructure class methodsFor: 'managing accessors' stamp: 'IgorStasenko 2/3/2014 18:16'!
createAccessorsFor: fieldName 
	"Define read/write accessors for the given field"
	| code |

	code := fieldName,'
	"This method was automatically generated"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self fieldAt: ' , fieldName printString.
	Author useAuthor: 'NativeBoost' during: [ 
		self compileSilently: code classified: NativeBoost automaticallyGeneratedCodeCategory ].
	
	code := fieldName,': anObject
	"This method was automatically generated"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self fieldAt: ' , fieldName printString , ' put: anObject'.
	Author useAuthor: 'NativeBoost' during: [ 
		self compileSilently: code classified: NativeBoost automaticallyGeneratedCodeCategory ].
! !

!NBExternalStructure class methodsFor: 'managing accessors' stamp: 'CiprianTeodorov 3/27/2013 21:47'!
flushNativeFieldAccessors

	methodDict do: [:method |
		NBNativeCodeGen removeNativeCodeFrom: method ]! !

!NBExternalStructure class methodsFor: 'managing accessors' stamp: 'CiprianTeodorov 3/27/2013 21:47'!
rebuildFieldAccessors

	currentFields ifNotNil: [
		currentFields fieldNamesDo: [:field |
			self removeAccessor: field.
			self removeAccessor: field asMutator ]].

	currentFields := self fieldsClass new 
		parseFields: self fieldsDesc byteAlignment: self byteAlignment structure: self.
	self fields fieldNamesDo: [:fldName | self createAccessorsFor: fldName ].

	^ currentFields! !

!NBExternalStructure class methodsFor: 'session management' stamp: 'IgorStasenko 3/31/2014 12:52'!
updateFieldOffsets

	"Update the field offsets and total structure size, in case if platform has changed and using
	different alignment comparing to previous session"
	
	currentFields ifNil: [ ^ self ].
	
	currentFields updateFieldOffsetsFor: self! !

!NBExternalStructure class methodsFor: 'fields description' stamp: 'CiprianTeodorov 3/27/2013 21:47'!
fieldsDesc
	"override this method in a subclass to get an automatically generated
	field accessors.
	
	The field description format is following:
	
	#( 
 		type1 name1;
		type2 name2;
		....
	)
	"
	^ #()! !

!NBExternalStructure class methodsFor: 'accessing' stamp: 'CiprianTeodorov 3/27/2013 21:47'!
offsetOf: aFieldName
	^ self fields offsetOf: aFieldName! !

!NBExternalStructure class methodsFor: 'class initialization' stamp: 'CiprianTeodorov 3/27/2013 21:47'!
initializeAccessors
	initialized := true.
	self rebuildFieldAccessors.! !

!NBExternalStructure class methodsFor: 'accessing' stamp: 'CiprianTeodorov 3/27/2013 21:47'!
instanceSize 
	
	^ self fields totalSize

	
! !

!NBExternalStructure class methodsFor: 'managing accessors' stamp: 'CiprianTeodorov 3/27/2013 21:47'!
noteCompilationOf: aSelector meta: isMeta
	initialized == true ifFalse: [ ^ self ].

	isMeta ifTrue: [ 
		"Compilation on a class side , lets get rid of native methods on instance side"
		(aSelector == #fieldsDesc or: [ aSelector == #byteAlignment ]) ifTrue: [ 
			self flushNativeFieldAccessors.
			self rebuildFieldAccessors ].
	].
! !

!NBExternalStructureFields methodsFor: 'parsing spec' stamp: 'CiprianTeodorov 1/19/2013 17:18'!
sizeAlignedTo: anAlign with: aType
	totalSize := (totalSize alignedTo: anAlign) + aType typeSize! !

!NBExternalStructureFields methodsFor: 'parsing spec' stamp: 'CiprianTeodorov 1/19/2013 17:19'!
parseFields: fieldSpec byteAlignment: byteAlign structure: structClass

	| stream type name gen align |
	stream := fieldSpec readStream.
	gen := NBFFICallout new requestor: structClass.
	
	fields := Dictionary new.
	totalSize := 0.
	[ stream atEnd ] whileFalse: [ | arity |
		type := gen resolveType: stream next. 
		arity := 0.
		[stream peek = #* ] whileTrue: [
			arity := arity + 1.
			stream next
		].
		type pointerArity: arity.
		
		name := stream next.
		name isSymbol ifFalse: [ self error: 'invalid field name'].
		fields at: name ifPresent: [ self error: 'duplicate field name' ].

		align := type typeSize min: byteAlign. "if byte align == 1, struct is packed"
		"add padding between fields, if needed"
		self sizeAlignedTo: align with: type. 

		self addField: name type: type. 
	
		stream peek == #';' ifTrue: [ stream next ].
	].
! !

!NBExternalStructureFields methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/19/2010 07:16'!
typeOf: fieldName

	^ (fields at: fieldName) at: 1! !

!NBExternalStructureFields methodsFor: 'parsing spec' stamp: 'CiprianTeodorov 1/19/2013 17:18'!
addField: aName type: aType
	fields
		at: aName
		put:
			{aType.
			(totalSize - aType typeSize)}! !

!NBExternalStructureFields methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/19/2010 06:41'!
totalSize
	^ totalSize! !

!NBExternalStructureFields methodsFor: 'computing' stamp: 'IgorStasenko 3/31/2014 16:12'!
updateFieldOffsetsFor: structClass

	"Recalculate field offsets based on (possibly new) platform byte alignment"
	| names byteAlign align type newSize |
	
	names := self namesInDeclarationOrder.
	
	newSize := 0.
	byteAlign := structClass byteAlignment.
	
	
	names do: [ :each |
		type := (fields at: each) first.
		align := type typeSize min: byteAlign.
		
		newSize := (newSize alignedTo: align) + type typeSize.
		fields
			at: each
			put:
			{ type.
			(newSize - type typeSize)} ].
		
	totalSize := newSize.! !

!NBExternalStructureFields methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/19/2010 07:16'!
offsetOf: fieldName

	^ (fields at: fieldName) at: 2! !

!NBExternalStructureFields methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/19/2010 07:16'!
fieldNamesDo: aBlock

	^ fields keysDo: [:name | aBlock value: name ]! !

!NBExternalStructureFields methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/19/2010 07:15'!
fieldNames

	^ fields keys! !

!NBExternalStructureFields methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/19/2010 09:20'!
namesInDeclarationOrder

	| result |
	
	result := SortedCollection sortBlock: [:a :b | a value second < b value second ].

	fields associationsDo: [:each  | result add: each ].
		
	^ result collect: [:each | each key ]! !

!NBExternalStructureType methodsFor: 'emitting code' stamp: 'IgorStasenko 7/5/2013 15:46'!
coerceReturnValue: gen

	| asm proxy |
	
	asm := gen asm.
	proxy := gen proxy.
	
	self returnViaRegisters ifTrue: [
		| temp1 temp2 oop dataOop |

		"save struct value(s) into temps"
		temp1 := gen reserveTemp.
		asm mov: asm EAX to: 	temp1.
			
		objectClass instanceSize > 4 ifTrue: [
			temp2 := gen reserveTemp.
			asm mov: asm EDX to: temp2
		].
	
		"instantiate our struct"
		oop := gen reserveTemp.
		dataOop := gen reserveTemp.
		
		"create data buf for struct"
		proxy createInstanceOf: ByteArray size: objectClass instanceSize.
		asm mov: asm EAX to: dataOop.
		
		proxy varBytesFirstFieldOf: asm EAX. "in EAX is pointer to first byte of struct"

		"copy struct values into newly created instance"
		asm mov: temp1 to: asm ECX.
		asm mov: asm ECX to: asm EAX ptr.

		objectClass instanceSize > 4 ifTrue: [
			asm mov: temp2 to: asm ECX.
			asm mov: asm ECX to: asm EAX ptr + 4.
		].
	
		proxy pushRemappableOop: dataOop.
		
		"now create instance and set it's data ivar "
		proxy createInstanceOf: objectClass.
		asm mov: asm EAX to: oop.
		
		proxy popRemappableOop.

		proxy storePointer: self dataIvarIndex ofObject: oop withValue: asm EAX.
		
		"return an instance of objectClass as result"
		asm mov: oop to: asm EAX 
		
	] ifFalse: [
		
		"just return a previously instantiated struct oop"		
		asm mov: returnOop to: asm EAX
	]! !

!NBExternalStructureType methodsFor: 'emitting code' stamp: 'IgorStasenko 7/1/2013 12:24'!
fetchAddressFromData: dataOop gen: gen

	"Input: the oop of data ivar (dataOop) from an instance of NBExternalStructure subclass
	Output: the address of struct's first field is in EAX.

	2 cases:
	  - data is ByteArray, then use address of its first byte
	  - data is NBExternalAddress, then use address value "
	
	| oopClass proxy asm notExternalAddress done |

	proxy := gen proxy.
	asm := gen asm.
	
	oopClass := gen reserveTemp.
	notExternalAddress := asm uniqueLabelName: 'notExternalAddress'.
	done := asm uniqueLabelName: 'done'.
	
	proxy fetchClassOf: dataOop.
	asm mov: asm EAX to: oopClass.

	gen emitFetchClass: NBExternalAddress.
	asm cmp: asm EAX with: oopClass.
	asm jne: notExternalAddress.
	
	"Data is external address. use its value"
	proxy fetchPointer: 0 ofObject: dataOop. 
	asm jmp: done.

	"Here we assume it is var-byte object (bytearray), use address of its first byte"
	asm label: notExternalAddress.
	proxy varBytesFirstFieldOf:  dataOop.

	asm label: done.

	gen releaseTemps: 1.
! !

!NBExternalStructureType methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/17/2010 18:43'!
objectClass: anObject

	objectClass := anObject! !

!NBExternalStructureType methodsFor: 'accessing' stamp: 'CiprianTeodorov 3/28/2013 20:24'!
dataIvarIndex
	" return a zero-based index "
	^ ( objectClass instVarIndexFor: #data ifAbsent: [ self error: ' should not happen ' ] ) - 1! !

!NBExternalStructureType methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/17/2010 18:43'!
objectClass

	^objectClass! !

!NBExternalStructureType methodsFor: 'emitting code' stamp: 'IgorStasenko 7/8/2013 17:38'!
pushAsPointer: gen
	"push a pointer to structure (which should be a subinstance of NBExternalStructure)"
	| asm oop |
	

	asm := gen asm.
	oop := gen reserveTemp.

	"we handle only 1-arity pointers here (stuct*) , the others is handled as generic pointer"
	pointerArity > 1 ifTrue: [ ^ super pushAsPointer: gen].

	loader emitLoad: gen to: oop.

	"do not verify if class is known"
	loader isReceiver ifFalse: [ 
		self verifyClassOf: oop is: objectClass generator: gen.
	].

	self fetchStructAddressFrom: oop gen: gen.
	
	asm push: asm EAX.

	gen releaseTemps: 1! !

!NBExternalStructureType methodsFor: 'emitting code' stamp: 'IgorStasenko 7/1/2013 12:21'!
fetchStructAddressFrom: oop gen: gen
	"Input: an instance of NBExternalStructure subclass in oop
	Output: the address of struct's first field is in EAX"
	| asm proxy dataOop |
	
	
	proxy := gen proxy.
	asm := gen asm.
	dataOop := gen reserveTemp.
	
	proxy fetchPointer: (self dataIvarIndex) ofObject: oop.

	asm mov: asm EAX to: dataOop.
	
	self fetchAddressFromData: dataOop gen: gen.
	
	gen releaseTemps: 1.! !

!NBExternalStructureType methodsFor: 'testing' stamp: 'CiprianTeodorov 1/28/2013 23:42'!
returnViaRegisters
"
answer true if return-by-value for given struct are returned in registers.
1byte, 2 bytes, and 4 bytes structures are returned in EAX.
8 byte structures are returned in EDX:EAX
otherwise it is assumed that caller passing a hidden argument (a pointer to struct)
which callee using for filling the data
"
"Both Mac OS X x86 and Win32 x86 return structs of a power of two in size
less than or equal to eight bytes in length in registers. Linux never does so. "
	^NativeBoost platformId = NativeBoostConstants linux32PlatformId
		ifTrue:[false]
		ifFalse:[ #(1 2 4 8) includes: self valueSize]! !

!NBExternalStructureType methodsFor: 'emitting code' stamp: 'CiprianTeodorov 7/30/2014 18:14'!
coerceReturnPointer: gen
	"input: pointer to struct in EAX
	output: instance of external structure oop pointing to given address"
	
	| asm proxy oop cont done |
	
	asm := gen asm.
	proxy := gen proxy.
	
	"we only care for 1 arity e.g. 'Struct *', otherwise use generic marshalling."
	pointerArity > 1 ifTrue: [  ^ super coerceReturnPointer: gen ].
	
	"handle the case where the pointer is null here"
	cont := asm uniqueLabelName: #cont.
	done := asm uniqueLabelName: #done.
	asm or: asm EAX with: asm EAX.
	asm jnz: cont.
	gen proxy nilObject.
	asm jmp: done.
	asm label: cont.
	
	"first create an instance of NBExternalAddress"
	NBExternalAddressType new 
		createInstanceWithValue: asm EAX generator: gen.
		
	proxy pushRemappableOop: asm EAX.
	
	oop := gen reserveTemp.
	proxy createInstanceOf: objectClass.
	asm mov: asm EAX to: oop.
	
	proxy popRemappableOop.
	proxy storePointer: self dataIvarIndex ofObject: oop withValue: asm EAX.

	"return an instance of objectClass as result"
	asm mov: oop to: asm EAX.
	gen releaseTemps: 1.
	asm label: done.! !

!NBExternalStructureType methodsFor: 'emitting code' stamp: 'CiprianTeodorov 4/7/2013 19:32'!
readOop: memoryOperand generator: gen
	"emit code to read a value from given memory operand
	and convert it to a corresponding ST object" 

	| asm proxy size offset oop src |
	
	asm := gen asm.
	proxy := gen proxy.

	pointerArity > 0 ifTrue: [
		asm mov: memoryOperand to: asm EAX.
		^ self coerceReturn: gen.
		].
	
	"read structure from given address, copy it to newly created instance of corresponding struct class"
	
	asm lea: asm EAX with: memoryOperand.
	src := gen reserveTemp.
	asm mov: asm EAX to: src.
	
	"instantiate our struct"

	oop := gen reserveTemp.
	gen emitFetchClass: objectClass.
	proxy instantiateClass: asm EAX indexableSize: 0.
	asm mov: asm EAX to: oop.
	
	gen emitFetchClass: ByteArray.
	proxy instantiateClass: asm EAX indexableSize: objectClass instanceSize.
	proxy storePointer: self dataIvarIndex ofObject: oop  withValue: asm EAX.
	proxy varBytesFirstFieldOf: asm EAX.
	asm mov: src to: asm EDX.
	"in EAX is pointer to first byte of struct"

	size := self valueSize.
	offset := 0.
	[ size >= 4 ] whileTrue: [
		asm 
			mov: asm EDX ptr + offset to: asm ECX;
			mov: asm ECX to: asm EAX ptr + offset.
		size := size - 4.
		offset := offset + 4.
	].

	size >= 2  ifTrue: [
		asm 
			mov: asm EDX ptr16 + offset to: asm CX;
			mov: asm CX to: asm EAX ptr16 + offset.
		size := size - 2.
		offset := offset + 2.
	].

	size > 0  ifTrue: [
		" last byte "
		asm 
			mov: asm EDX ptr8 + offset to: asm CL;
			mov: asm CL to: asm EAX ptr8 + offset.
	].

	"return an instance of objectClass as result"
	asm mov: oop to: asm EAX 
! !

!NBExternalStructureType methodsFor: 'emitting code' stamp: 'IgorStasenko 7/1/2013 16:25'!
prepareReturnValue: gen for: callinfo

	| asm proxy temp |
	
	asm := gen asm.
	proxy := gen proxy.
	
	(pointerArity = 0 and: [ self returnViaRegisters not ]) ifTrue: [
		"we should instantiate a new instance of struct 
		and push a pointer to its first byte on a stack (so C function will know where to store return value(s))"
		returnOop := gen reserveTemp.
		temp := gen reserveTemp.
		
		proxy createInstanceOf: objectClass.
		proxy pushRemappableOop: asm EAX.
		
		proxy createInstanceOf: ByteArray size: objectClass instanceSize.
		
		asm mov: asm EAX to: temp.
		proxy popRemappableOop.

		asm mov: asm EAX to: returnOop.
		proxy storePointer: self dataIvarIndex ofObject: asm EAX withValue: temp.
		
		asm mov: temp to: asm EAX.  
		proxy varBytesFirstFieldOf: asm EAX. "in EAX is pointer to first byte of struct"
		
		asm noticePush: asm pointerSize forCall: callinfo.
		asm push: asm EAX.
		gen releaseTemps: 1.
		
	]
! !

!NBExternalStructureType methodsFor: 'accessing' stamp: 'IgorStasenko 5/26/2012 14:12'!
valueSize 
	^ objectClass instanceSize ! !

!NBExternalStructureType methodsFor: 'emitting code' stamp: 'IgorStasenko 7/5/2013 15:43'!
pushAsValue: gen
	"pass a structure by value on stack"
	| asm oop bytesToCopy offset |
	
	asm := gen asm.
	
	oop := gen reserveTemp annotation: 'oop'.

	loader emitLoad: gen to: oop.
	
	loader isReceiver ifFalse: [
		"do not check type if argument is receiver, since we already know its class"
		self verifyClassOf: oop is: objectClass generator: gen.
	].

	self fetchStructAddressFrom: oop gen: gen. "in EAX the pointer to first byte of struct"
	 
	"struct size aligned to stack argument alignment"
	asm sub: asm ESP with: self stackSize. 

	"generate code to copy struct contents on a stack.
	source is [EAX]
	destination is [ESP]
	"

	bytesToCopy := self valueSize. 
	offset := 0.	
		
	"first copy by 4 bytes"
	[ bytesToCopy >= 4 ] whileTrue: [
		asm 
			mov: asm EAX ptr32 + offset to: asm EDX;
			mov: asm EDX to: asm ESP ptr32 + offset.
			
		bytesToCopy := bytesToCopy - 4.
		offset := offset + 4. 
	].
	"copy rest using 1-byte transfer"
	[ bytesToCopy > 0 ] whileTrue: [
		asm 
			mov: asm EAX ptr8 + offset to: asm DL;
			mov: asm DL to: asm ESP ptr8 + offset.
			
		bytesToCopy := bytesToCopy - 1.
		offset := offset + 1. 
	].


	gen releaseTemps: 1.
	! !

!NBExternalStructureType class methodsFor: 'instance creation' stamp: 'Igor.Stasenko 5/17/2010 18:42'!
objectClass: aClass
	^ self new objectClass: aClass! !

!NBExternalType commentStamp: 'IgorStasenko 2/15/2012 19:41'!
I am an abstract class that primarily serves for generating a machine code which converting arguments and return types
between Smalltalk and C worlds. 

My subclasses implementing a marshalling for concrete type, which is then used by FFI. 

Instance Variables:
	pointerArity	<Integer>
	
	loader	<NBVariableLoader>: an instance of argument loader, which emits code to load the smalltalk argument into register.	
		When generating the marshalling code to push a variable, my instances need this helper which, depending on where the object is (inst var, method arg, etc) gets the object in question into a register.!
!NBExternalType methodsFor: 'emitting code' stamp: 'IgorStasenko 5/11/2011 17:24'!
emitPush: generator

	pointerArity > 0 ifTrue: [ ^ self pushAsPointer: generator ].
	 
	generator coercionMayFail: self coercionMayFail.    
	^ self pushAsValue: generator.! !

!NBExternalType methodsFor: 'emitting code' stamp: 'Igor.Stasenko 5/11/2010 01:30'!
coerceOopToOperand: gen ifFailedJumpTo: aLabel

	"coerce a object - oop , provided by loader and then put a result into an appropriate 
	operand (memory/register), answer that operand"
	
	self subclassResponsibility ! !

!NBExternalType methodsFor: 'emitting code' stamp: 'IgorStasenko 5/26/2012 18:21'!
loadMem: memoryOperand generator: gen.
	"load the value from memory operand into return value register"
	gen asm mov: memoryOperand to: (gen asm reg: 0 size: self typeSize).
! !

!NBExternalType methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/28/2010 11:35'!
pointerArity
	^ pointerArity! !

!NBExternalType methodsFor: 'testing' stamp: 'IgorStasenko 5/11/2011 17:26'!
coercionMayFail
	"answer true if argument coercion ST->C may fail due to passing incomatible argument type.
	Some types could accept any ST object as argument and therefore never fail,
	and we don't need to check a primitive failuer before making a call.
	By default, asnwer true
	"
	^ true! !

!NBExternalType methodsFor: 'accessing' stamp: 'IgorStasenko 5/26/2012 14:30'!
baseTypeSize
	"Answer a number of bytes, which takes a value of given type
	(not a pointer to it)
	"
	
	self subclassResponsibility ! !

!NBExternalType methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/30/2010 09:51'!
loader: aLoader
	loader := aLoader! !

!NBExternalType methodsFor: 'emitting code' stamp: 'IgorStasenko 7/1/2013 11:07'!
pushAsPointer: gen 
	"by default, push argument as a bytearray ptr"
	
	"may accept:
		- nil
		- variable bytes oop
		- external address "
	| asm proxy notNil done oop  notExternalAddress |
	
	asm := gen asm.
	proxy := gen proxy.
	done := asm uniqueLabelName: 'done'.
	oop := gen reserveTemp.
	
	"load argument oop"
	loader emitLoad: gen to: oop.
	
	"handle nils, if we care"
	gen optCoerceNilToNull ifTrue: [
		notNil := asm uniqueLabelName: 'notNil'.
		proxy nilObject.
		asm cmp: asm EAX with: oop;
		jne: notNil;
		xor: asm EAX with: asm EAX;
		jmp: done;
		label: notNil.
	].

	"handle ExternalAddress, if we care"
	gen optAllowExternalAddressPtr ifTrue: [ | oopClass |
		oopClass := gen reserveTemp.
		notExternalAddress := asm uniqueLabelName: 'notExternalAddress'.
		proxy fetchClassOf: oop.
		asm mov: asm EAX to: oopClass.

		gen emitFetchClass: NBExternalAddress.
		asm cmp: asm EAX with: oopClass.
		asm jne: notExternalAddress.
		
		proxy fetchPointer: 0 ofObject: oop.  
		
		asm jmp: done.
		asm label: notExternalAddress.
		gen releaseTemps: 1.
	].

	"the last case is a byte/word array, 
	simply push a pointer to first indexable field of oop"

	gen optAllowByteArraysPtr ifTrue: [
		proxy isBytesOrWords: oop ifNotJumpTo: gen failedLabel.
		proxy varBytesFirstFieldOf: oop.
		asm jmp: done.
	].

	"if we get here, we fail"
	asm jmp: gen failedLabel.

	"and if we get here, we ok to proceed"
	asm label: done.
	asm push: asm EAX.

	gen releaseTemps: 1.
	! !

!NBExternalType methodsFor: 'testing' stamp: 'Igor.Stasenko 5/1/2010 16:05'!
isCallback
	^ false! !

!NBExternalType methodsFor: 'accessing' stamp: 'IgorStasenko 5/26/2012 14:33'!
stackSize
	"Answer a number of bytes, which takes a value of given type when pushed on stack"
	
	^ self typeSize alignedTo: self stackArgumentAlignment ! !

!NBExternalType methodsFor: 'initialization' stamp: 'Igor.Stasenko 4/28/2010 11:34'!
initialize

	pointerArity := 0.! !

!NBExternalType methodsFor: 'accessing' stamp: 'IgorStasenko 5/26/2012 01:04'!
stackArgumentAlignment
	"a minimum number of bytes, which argument of any type
	can have on stack, when pushed as argument"
	^ 4! !

!NBExternalType methodsFor: 'printing' stamp: 'Igor.Stasenko 4/30/2010 09:22'!
printOn: aStream

	super printOn: aStream.
	
	pointerArity timesRepeat: [ aStream nextPut: $* ].! !

!NBExternalType methodsFor: 'emitting code' stamp: 'Igor.Stasenko 4/28/2010 17:42'!
coerceReturn: gen
	 pointerArity > 0 ifTrue: [ self coerceReturnPointer: gen ]
			ifFalse: [ self coerceReturnValue: gen ].
! !

!NBExternalType methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/28/2010 11:35'!
pointerArity: additionalArity

	pointerArity := pointerArity + additionalArity.! !

!NBExternalType methodsFor: 'emitting code' stamp: 'IgorStasenko 5/4/2012 17:08'!
prepareReturnValue: gen for: callinfo

	"do some extra for preparing a function return value holder.
	no-op for most of the types, except external structures " 
! !

!NBExternalType methodsFor: 'accessing' stamp: 'IgorStasenko 5/26/2012 14:28'!
valueSize
	"Answer a number of bytes, which takes a value of given type
	(not a pointer to it)
	"
	
	self subclassResponsibility ! !

!NBExternalType methodsFor: 'error handling' stamp: 'IgorStasenko 7/12/2013 14:30'!
error: aMessage
	^ NBCodeGenerationError new signal: aMessage! !

!NBExternalType methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/30/2010 09:50'!
loader
	^ loader! !

!NBExternalType methodsFor: 'accessing' stamp: 'CiprianTeodorov 12/16/2012 15:34'!
typeName
	| tName |
	tName := self class name.
	pointerArity timesRepeat: [ tName , '*' ].
	^ tName! !

!NBExternalType methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/29/2010 05:49'!
pointerSize
	"Answer a number of bytes, which takes a pointer value"
	^ self class pointerSize! !

!NBExternalType methodsFor: 'emitting code' stamp: 'IgorStasenko 8/8/2011 19:54'!
verifyClassOf: oop is: aClass generator: gen

	| asm class okLabel |
	asm := gen asm.
	okLabel := asm uniqueLabelName: 'classIsOk'.
	
	class := gen reserveTemp.
	
	gen proxy fetchClassOf: oop.
	asm mov:  asm EAX to: class.
	
	gen emitFetchClass: aClass.
	
	asm cmp: asm EAX with: class;
		je: okLabel.
		gen failWithMessage: 'An instance of ' , aClass name , ' expected'.
	asm label: okLabel.
	
	gen releaseTemps: 1.! !

!NBExternalType methodsFor: 'emitting code' stamp: 'IgorStasenko 12/20/2011 14:21'!
coerceReturnPointer: gen

	"Return a pointer to receiver. 
	lets just return its value"
	
	| asm EAX cont done |
	asm := gen asm.
	EAX := asm EAX.
	cont := asm uniqueLabelName: 'cont'.
	done := asm uniqueLabelName: 'done'.
	
	(gen optReturnNullAsNil or: [gen optFailOnReturnNull ]) ifTrue: [
		asm or: EAX with: EAX.
		gen optFailOnReturnNull 
			ifTrue: [	asm jz: gen failedLabel. ]
			ifFalse: [
				asm jnz: cont.
				gen proxy nilObject.
				asm jmp: done 	]
	].
	asm label: cont.
	gen optReturnPtrAsExternalAddress 
		ifTrue: [ 
			(NBExternalAddress asNBExternalType: gen) coerceReturnValue: gen ]
		ifFalse: [ 
			gen optReturnPtrAsInt ifFalse: [
				self error: 'Function returns a pointer, but returning raw pointer value is prohibited by options' ].

			gen proxy positive32BitIntegerFor: asm EAX ].
	asm label: done
	! !

!NBExternalType methodsFor: 'emitting code' stamp: 'IgorStasenko 9/3/2012 01:03'!
readOop: memoryOperand generator: gen
	"emit code to read a value from given memory operand
	and convert it to a corresponding ST object" 
	
	memoryOperand size: self typeSize.
	pointerArity > 0 
		ifTrue: [ gen asm mov: memoryOperand to: gen asm EAX ]
		ifFalse: [ self loadMem: memoryOperand generator: gen ].
	
	self coerceReturn: gen! !

!NBExternalType methodsFor: 'emitting code' stamp: 'Igor.Stasenko 4/28/2010 11:41'!
prepareArgumentUsing: aNBFFICallout 
	"by default, do nothing"! !

!NBExternalType methodsFor: 'accessing' stamp: 'IgorStasenko 5/26/2012 17:09'!
typeSize
	
	"Answer a number of bytes, which receiver type takes in memory"

	pointerArity > 0 ifTrue: [ ^ self pointerSize ].
	^ self valueSize ! !

!NBExternalType methodsFor: 'emitting code' stamp: 'Igor.Stasenko 4/30/2010 08:10'!
coerceReturnValue: generator
	"emit code to coerce return value from external function call"
	
	self subclassResponsibility ! !

!NBExternalType class methodsFor: 'converting' stamp: 'Igor.Stasenko 4/28/2010 12:20'!
asNBExternalType: gen

	^ self new! !

!NBExternalType class methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/29/2010 05:49'!
pointerSize
	"Answer a number of bytes, which takes a pointer value"
	self flag: #x64.
	^ 4! !

!NBExternalType class methodsFor: 'public' stamp: 'IgorStasenko 6/27/2013 16:12'!
sizeOf: aTypeName

	^ (NBFFICallout new resolveType: aTypeName) typeSize! !

!NBExternalTypeValue commentStamp: '<historical>'!
I am a generic meta class for creating a subclasses, which instances will hold a single value of specified C type.
To create a new class for some concrete C type use:

myClass := NBExternalTypeValue getClassForType: 'float'.

Then you can use instances of given anonymous class(es) as a value holders for
type you specified:

float := myClass new.
...

float value:  1.5
float value

etc..

By combining this with class/pool variables we have a convenient way of defining a values, which are passed by pointer to a function.

For instance, imagine that we need to create a binding to a function:

void getFoo( SomeType * value) 

which is not an unusual situation, when C function using pointer arguments for storing it's output there.

And this is what NBExternalTypeValue is done for:
To define a binding to this function you can:
  - declare a pool/class variable, named SomeType
  - initialize it: 
        SomeType := NBExternalTypeValue ofType: 'SomeType'

and then use it in function signature:

getFoo: value
   <primitive .. >
  ^ self nbcall: #(void getFoo ( SomeType *  value ))

---
and call it like: 

var := SomeType new.
self getFoo: var.

var value -> will read the value 
!
!NBExternalTypeValue methodsFor: 'accessing' stamp: 'CiprianTeodorov 4/9/2013 19:46'!
value
	"Note, this method used as a template for my anonymous subclasses. "
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self emitRead! !

!NBExternalTypeValue methodsFor: 'accessing' stamp: 'CiprianTeodorov 4/9/2013 19:46'!
value: value
	"Note, this method used as a template for my anonymous subclasses. "
	
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self emitWrite ! !

!NBExternalTypeValue methodsFor: 'printing' stamp: 'CiprianTeodorov 4/9/2013 19:19'!
printOn: aStream 
	"Append to the argument, aStream, the names and values of all the record's variables."

	Printing == true ifTrue: [ 
		"since we use field accessors for printing values,
		debugging the code with not-yet nativised accessors leads to infinite loop"
		^ aStream nextPutAll: self class name; nextPutAll: '(...)'.	
		].
	
	Printing := true.
	[ 
		aStream 
			nextPutAll: self class name; 
			nextPutAll: ' ( '; 
			nextPutAll: self class valueType;
			nextPutAll: ') (';
		 cr.
		self value printOn: aStream.
		aStream cr; nextPut: $). ]
	ensure: [ Printing := false ].
	! !

!NBExternalTypeValue methodsFor: 'accessing' stamp: 'CiprianTeodorov 4/9/2013 19:41'!
emitCopy: asm 
	"Emit code to copy elementSize bytes from ESP ptr -> EAX ptr "
	| toCopy offset |
	
	toCopy := self class valueSize.
	
	toCopy > 8 ifTrue: [ ^ self emitCopyUsingLoop: asm ].
	
	offset := 0.
	[ toCopy >= 4 ] whileTrue: [
		asm 
			mov: asm ESP ptr + offset to: asm ECX;
			mov: asm ECX to: asm EAX ptr + offset.
			toCopy := toCopy - 4.
			offset := offset + 4.
	].

	toCopy >= 2  ifTrue: [
		asm 
			mov: asm ESP ptr16 + offset to: asm CX;
			mov: asm CX to: asm EAX ptr16 + offset.
		toCopy := toCopy - 2.
		offset := offset + 2.
	].

	toCopy > 0  ifTrue: [
		" last byte "
		asm 
			mov: asm ESP ptr8 + offset to: asm CL;
			mov: asm CL to: asm EAX ptr8 + offset.
	].
! !

!NBExternalTypeValue methodsFor: 'accessing' stamp: 'IgorStasenko 7/1/2013 14:29'!
emitWrite

	^(self nbCalloutIn: thisContext sender)
		function: 'oop (oop value, ', self class valueType,' value)'
		emit: [ :gen :proxy :asm | |oop|
			oop := gen reserveTemp.
			asm pop: asm EAX;
				mov: asm EAX to: oop.
				
			proxy receiver.
			proxy varBytesFirstFieldOf:  asm EAX.
			
			self emitCopy: asm.
			
			asm mov: oop to: asm EAX.
			 ]! !

!NBExternalTypeValue methodsFor: 'accessing' stamp: 'CiprianTeodorov 4/9/2013 19:42'!
emitCopyUsingLoop: asm
	| ssi sdi |
	"copy the value using loop "
	ssi := asm reserveTemp.
	sdi := asm reserveTemp.
	asm 
		mov: asm ESI to: ssi;
		mov: asm EDI to: sdi;
		cld;
		mov: asm ESP to: asm ESI;
		mov: asm EAX to: asm EDI;
		mov: self class valueSize to: asm ECX;
		rep;movsb;
		mov: ssi to: asm ESI;
		mov: sdi to: asm EDI;
		releaseTemps: 2.
! !

!NBExternalTypeValue methodsFor: 'accessing' stamp: 'IgorStasenko 7/1/2013 14:29'!
emitRead

	^ (self nbCalloutIn: thisContext sender) 
		function: 'oop ()'
		emit: [:gen :proxy :asm |
			proxy receiver. "receiver oop"
			proxy varBytesFirstFieldOf:  asm EAX.
			(gen resolveType: self class valueType) readOop: asm EAX ptr generator: gen.
			 ]! !

!NBExternalTypeValue class methodsFor: 'accessing' stamp: 'CiprianTeodorov 4/9/2013 19:21'!
valueType
	^ valueType! !

!NBExternalTypeValue class methodsFor: 'class initialization' stamp: 'IgorStasenko 1/17/2014 20:44'!
initValueType: aTypeName 
	"Initialize the value type and size.
	
	If you want to use a public subclass of me, then make sure you call this method
	in your class #initialize method.
	" 

	self valueType: aTypeName! !

!NBExternalTypeValue class methodsFor: 'class initialization' stamp: 'StephaneDucasse 8/13/2013 17:41'!
initialize

	NBExternalTypeValue allSubclassesDo: #installAccessors.
	"like that methods are correctly regenerated"! !

!NBExternalTypeValue class methodsFor: 'accessing' stamp: 'IgorStasenko 1/17/2014 20:42'!
valueType: aTypeName
	valueType := aTypeName.
	valueSize  := (NBFFICallout new requestor: self; resolveType: valueType) typeSize.
	self installAccessors.
	! !

!NBExternalTypeValue class methodsFor: 'class factory' stamp: 'IgorStasenko 1/17/2014 20:41'!
getClassForType: aTypeName
	"Do not confuse.!! This method answers an anonymous class,  a subclass of NBExternalTypeValue,
	which can be used for instantiation later i.e:
	
	floatTypeClass := NBExternalTypeValue ofType: 'float'.
	
	float  := floatTypeClass new.
	float value: 1.5.
	float value.
	
	"
	^ NBExternalTypeValue newAnonymousSubclass initValueType: aTypeName.

! !

!NBExternalTypeValue class methodsFor: 'instance creation' stamp: 'CiprianTeodorov 4/9/2013 20:50'!
new

	^ (self basicNew: self valueSize) initialize! !

!NBExternalTypeValue class methodsFor: 'private' stamp: 'IgorStasenko 2/3/2014 18:16'!
installAccessors
	"Copy superclass methods, which serve as a template where generated code will be installed.
	Each subclass of NBTypeValue should implement (override) these key methods "
	Author useAuthor: 'NativeBoost' during: [ 
		self basicAddSelector: #value withMethod: (NBExternalTypeValue >> #value ) copy.
		self basicAddSelector: #value: withMethod: (NBExternalTypeValue >> #value: ) copy.
		self organization classify:  #value under: NativeBoost automaticallyGeneratedCodeCategory.
		self organization classify:  #value: under: NativeBoost automaticallyGeneratedCodeCategory.
	].! !

!NBExternalTypeValue class methodsFor: 'converting' stamp: 'IgorStasenko 6/27/2013 17:05'!
asNBExternalType: gen 	
	^gen resolveType: self valueType! !

!NBExternalTypeValue class methodsFor: 'class factory' stamp: 'CiprianTeodorov 4/9/2013 19:20'!
ofType: aTypeName
	^ self getClassForType: aTypeName
! !

!NBExternalTypeValue class methodsFor: 'session management' stamp: 'IgorStasenko 3/31/2014 16:24'!
initializeForNewSession

	self allSubclassesDo: [ :each | each updateValueSize ].! !

!NBExternalTypeValue class methodsFor: 'accessing' stamp: 'CiprianTeodorov 4/9/2013 19:42'!
valueSize
	^valueSize! !

!NBExternalTypeValue class methodsFor: 'session management' stamp: 'IgorStasenko 4/1/2014 17:21'!
updateValueSize
	"Update the size, in case of session change where type is an external structure which
	uses different memory alignment on given platform
	" 

	valueSize  := (NBFFICallout new requestor: self; resolveType: valueType) typeSize.
! !

!NBExternalUnion class methodsFor: 'accessing' stamp: 'CiprianTeodorov 3/28/2013 20:13'!
fieldsClass
	^ NBExternalUnionFields! !

!NBExternalUnionFields methodsFor: 'parsing spec' stamp: 'CiprianTeodorov 1/19/2013 16:59'!
sizeAlignedTo: anAlign with: aType

	totalSize := (totalSize alignedTo: anAlign ) max: (aType typeSize alignedTo: anAlign)! !

!NBExternalUnionFields methodsFor: 'initialization' stamp: 'CiprianTeodorov 1/19/2013 17:05'!
initialize
	super initialize.
	
	nbFields := 0.! !

!NBExternalUnionFields methodsFor: 'accessing' stamp: 'CiprianTeodorov 1/19/2013 16:55'!
offsetOf: fieldName
	^ 0! !

!NBExternalUnionFields methodsFor: 'parsing spec' stamp: 'CiprianTeodorov 1/19/2013 17:05'!
addField: aName type: aType
	fields
		at: aName
		put:
			{aType.
			(nbFields := nbFields + 1)}! !

!NBExternalUnionFields methodsFor: 'accessing' stamp: 'IgorStasenko 3/31/2014 14:53'!
updateFieldOffsetsFor: unionClass
	"Not needed, since all fields have same offset == 0.. but we need to update total size"
	
	! !

!NBExtraRootsRegistry commentStamp: 'Igor.Stasenko 4/29/2010 07:53'!
This registry serve for instantiating an external types by native code.

My sole instance is always refreshing during fresh image startup.!
!NBExtraRootsRegistry methodsFor: 'accessing' stamp: 'CamilloBruni 7/23/2012 17:54'!
at: aName ifAbsentPut: aBlock

	^ self at: aName ifAbsent: [ self at: aName put: aBlock value ]! !

!NBExtraRootsRegistry methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/2/2010 12:52'!
at: aName put: anObject

	"register an object under given name."
	| sz index |
	sz := array size.
	index := sz + 1.
	(pool includesKey: aName) 
		ifTrue: [	index := pool at: aName ]
		ifFalse: [ pool at: aName put: index ].
		
	(index > array size) ifTrue: [
		array := array copyWith: anObject.
		self primAtMem: cell put: array.
		].
	
	array at: index put: anObject.
	^ anObject.
	
! !

!NBExtraRootsRegistry methodsFor: 'callbacks support' stamp: 'Igor.Stasenko 5/18/2010 02:48'!
emitFetchCallback: index generator: gen
	"index are one, returned from #registerCallback "
	| reg temp |
	index isMem 
		ifTrue: [ temp := index ]
		ifFalse: [ temp := gen reserveTemp. gen asm mov: index to: temp ].
	pool at: #callbacks ifAbsent: [
		self at: #callbacks put: WeakArray new ].	
	reg := self emitOopAt: #callbacks generator: gen.
	reg := gen proxy fetchPointer: temp ofObject: reg.
	
	index isMem ifFalse: [ gen releaseTemps: 1 ].
	^ reg
! !

!NBExtraRootsRegistry methodsFor: 'code generation' stamp: 'Igor.Stasenko 5/1/2010 12:44'!
emitFetchClass: aClass generator: gen

	(self assert: aClass  isMeta not ).  " no metaclasses here"

	"make sure we registered it"
	self at: aClass name put: aClass.
	^ self emitOopAt: aClass name	generator: gen! !

!NBExtraRootsRegistry methodsFor: 'primitives' stamp: 'IgorStasenko 11/24/2012 16:25'!
primAddGCRoot: addr

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>

	"add a given address as GC root"
	
	^ self nbCallout function: #(void ( ulong addr ) ) emit: [:gen |
		| proxy asm |
		proxy := gen proxy.
		asm := gen asm.
		
		asm 
			pop: asm EAX. "address"
			
		proxy addGCRoot: asm EAX.
	].
	
! !

!NBExtraRootsRegistry methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/29/2010 06:36'!
at: aName

	"Answer an object associated with given name."
	| index |
	index := pool at: aName.
	^ array at: index! !

!NBExtraRootsRegistry methodsFor: 'callbacks support' stamp: 'Igor.Stasenko 5/5/2010 21:09'!
registerCallback: aCallback
	"answer a zero-based index of registered callback "
	| index callbacks |
	
	callbacks := pool at: #callbacks ifAbsent: [
		self at: #callbacks put: (WeakArray with: aCallback).
		^ 0.
		].
	callbacks := array at: callbacks.
	freeCallbackIndexes ifEmpty: [
		
		callbacks := callbacks copyWith: aCallback.
		self at: #callbacks put: callbacks.
		^ callbacks size - 1
		].
	
	index := freeCallbackIndexes removeLast.
	callbacks at: index+1 put: aCallback.
	^ index
	! !

!NBExtraRootsRegistry methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/14/2010 02:06'!
at: aName ifAbsent: aBlock

	"Answer an object associated with given name."
	| index |
	index := pool at: aName ifAbsent: [ ^ aBlock value ].
	^ array at: index! !

!NBExtraRootsRegistry methodsFor: 'code generation' stamp: 'CamilloBruni 10/3/2012 14:42'!
emitOopAt: aName generator: gen

	"emit code for fetching an oop at given name from registry"
	
	| asm proxy index |
	
	proxy := gen proxy.
	asm := gen asm.
	index := pool at: aName.
	
	asm decorateWith: 'NBExtraRootsRegistry at: ', aName printString , ' (' , index asString , ')' during: [  
		asm mov: cell asUImm32 to: asm EAX.
		asm mov: asm EAX ptr to: asm EAX.  "array oop -> EAX"
	
		proxy fetchPointer: index-1 ofObject: asm EAX. ].
	"EAX <- oop"
	^ asm EAX! !

!NBExtraRootsRegistry methodsFor: 'initialize-release' stamp: 'Igor.Stasenko 5/5/2010 13:46'!
initialize: aMemoryCell
	freeCallbackIndexes := OrderedCollection new.
	pool := IdentityDictionary new.
	array := Array new.
	
	cell := aMemoryCell asUnsignedLong. 
	
	self primAtMem: cell put: array.
	self primAddGCRoot: cell.
	
	self at: #'___seed' put: Seed.
	self assert: array size = 1.
	
! !

!NBExtraRootsRegistry methodsFor: 'callbacks support' stamp: 'Igor.Stasenko 5/14/2010 02:07'!
releaseCallbackIndex: anIndex
	| callbacks |
	"release a previously registered zero-based callback index"
	
	callbacks := self at: #callbacks ifAbsent: [^ self ].
	
	freeCallbackIndexes add: anIndex.
	callbacks at: anIndex+1 put: nil.! !

!NBExtraRootsRegistry methodsFor: 'primitives' stamp: 'IgorStasenko 11/24/2012 16:25'!
primAtMem: addr put: anOop 

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>

	"write an oop to given memory address"
	
	^ self nbCallout function: #(void ( ulong addr, oop anOop )) emit: [:gen |
		| proxy asm |
		proxy := gen proxy.
		asm := gen asm.
		
		asm 
			pop: asm EAX; "address"
			pop: asm ECX; "oop"
			mov: asm ECX to: asm EAX ptr
	].
	
! !

!NBExtraRootsRegistry class methodsFor: 'instance creation' stamp: 'Igor.Stasenko 5/2/2010 12:50'!
newWithCell: aMemoryCell

	^ self basicNew initialize: aMemoryCell! !

!NBExtraRootsRegistry class methodsFor: 'instance creation' stamp: 'Igor.Stasenko 5/2/2010 12:50'!
new

	self error: 'use #newWithCell:'! !

!NBFFICallback commentStamp: '<historical>'!
My instances represent a callback function, which will be called by external function at some moment.

To create a new callback, first, make a subclass of me and override #fnSpec method, which is an anonymous C function signature, 
l.e.  'int (int foo , float bar )'  , which tells that given callback class implements a callback for a function which takes two arguments (foo, bar),
and returns integer.
(Additionally you can override a #callType method which determines a callback function calling convention. A default calling convention for callbacks is #cdecl,
and others is barely used on x86 platforms).

To use callbacks, you must instantiate it first by passing block as an argument:

mycallback := MyCallback on: someBlock.

The block is the closure which will be evaluated when callback function get called, so the block must take same number of arguments as specified in #fnSpec method, and its evaluation result must yield a value which can be converted back C type value, which you speficied as a return type of callback function.
For example, if callback signature is 'int (int foo , float bar )' , we can create a callback with following block closure:

mycallback := MyCallback on: [:foo :bar |  (foo + bar ) asInteger ]. 

Passing callback as an argument to external function. 

For passing a callbacks as an argument to C function, you can use its class name for an argument type.

For example:

primStQSort: base len: size compare: qsortCallback

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self 
		nbCall: #(void qsort (NBExternalAddress base, ulong size, 1, NBQSortCallback qsortCallback))
		module: NativeBoost CLibrary 
		options: #( optMayGC )

as you can see , the third argument (qsortCallback) of function signature, has 'NBQSortCallback' type, which is a class name of existing NBFFICallback subclass. 
And, of course you are free to create any type aliases for the callback type to use different type names in signature. Just make sure that aliases are resolved correctly to an instance of NBFFICallbackType, during processing of the function signature by NBFFICallout class.

!!!!Note!!!! A special care must be taken for all functions which may make callbacks!! 
In the above qsort() example, you can see an additional option for external call - #optMayGC, which tells a code generator to call an external function via call gate (a special stub which handling a code relocation caused by GC). Thats it, for any external functions, which may call the callback you must pass this option. 
Rationale: since most of external functions don't make any callbacks (and so has no chance to trigger GC), using this option by default will be an overkill, which will just spend extra CPU cycles for nothing. 
However, if you omit this option when calling the function(s) which may call back, expect a hard crash(es) to happen.   
If you unsure which external library functions may call back, you can turn on this option by default for all methods in your class by implementing  #ffiCalloutOptions method at class side:

MyClass class>>ffiCalloutOptions
 ^ #( optMayGC )

Like that, for any code generated to make external calls in methods of your class, this option will take an effect.

Callback lifetime. 

Each time you instantiating a new callback, it reserves a small amount of external memory , which must be freed once callback is no longer used.
This is done automatically, using object finalization scheme, once system detects that there is no more strong references to callback left.
So, you only need to make sure that an instance of callback, which you passed to some external function will be kept around in system, as long as
an external library has a pointer to it and can perform calls to it.  
If you lose the last reference to callback object before making sure that external library can no longer make calls to it, this will lead to an unpredictive behavior (segmentation fault, invalid instruction, memory corruption / pick your favorite).   

Redefining callback signature. 

A callback uses a lazy-initialization scheme to generate a common marshalling code which will be used by all instances of specific callback class.
So, changing a callback signature (by changing its #fnSpec method) will not have an immediate effect, if you already created at least a single instance of it. 
To make changes take effect, you must restart an image.
!
!NBFFICallback methodsFor: 'code emitting' stamp: 'IgorStasenko 9/15/2012 14:21'!
primLeave: leaveAddr stackPtr: saveStackPtr contextOop: senderContext 
	returnValue: oop primitiveMethod: aMethod
	"simply jump to the address, provided in leaveAddr parameter,
	which should be an unsigned integer value"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ NBNativeCodeGen methodAssembly: [:gen | | proxy asm |
		proxy := gen proxy.
		asm := gen asm.
		proxy stackValue: 4. "leaveAddr"
		proxy positive32BitValueOf: EAX.
		asm push: EAX.
		proxy ifFailedJumpTo: #failed.
		asm pop: EAX;
			jmp: EAX.  " jump to callback leave address "
		asm label: #failed.
		gen epilogue.
	]
! !

!NBFFICallback methodsFor: 'initialization' stamp: 'IgorStasenko 9/15/2012 20:07'!
initialize

	enterMethod := self class callbackEnterMethod.
	index := NativeBoost extraRootsRegistry registerCallback: self.
	self installTrunk.
	
	NBExternalResourceManager addResource: self data: {trunk. index }.! !

!NBFFICallback methodsFor: 'code emitting' stamp: 'IgorStasenko 5/8/2012 16:09'!
pvtEnter: arguments stackPointer: savedStackPtr primitiveMethod: aMethod
	"Note, this is for internal use only!!!!!! do not touch this method ever!! "
	| result theSender |
	result := 0.
	theSender := thisContext sender.
	[ 
	result := block valueWithArguments: arguments ]
	ensure: [
		self 
			primLeave: self class callbackLeaveAddress asUnsignedLong 
			stackPtr: savedStackPtr 
			contextOop: theSender 
			returnValue: result
			primitiveMethod: aMethod
		]
! !

!NBFFICallback methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/13/2010 22:38'!
block: aBlock

	self class numberOfArguments = aBlock numArgs ifFalse: [
		self error: 'Invalid number of arguments' ].
	
	block := aBlock! !

!NBFFICallback methodsFor: 'trunk management' stamp: 'IgorStasenko 11/24/2012 15:44'!
installTrunk
	| code bytes |
	code := self class trunkCode.
	bytes := code bytes.
	
	trunk := NativeBoost allocate: bytes size.
	NativeBoost memCopy: bytes to: trunk size: bytes size.
	
	trunk nbUInt32AtOffset: (code offsetAt: #index) put: index
! !

!NBFFICallback class methodsFor: 'accessing' stamp: 'IgorStasenko 5/8/2012 16:04'!
callbackEnterAddress

	self checkSession.
	
	cbEnter ifNil: [ self installCallbackCode ].
	
	^ cbEnter address

! !

!NBFFICallback class methodsFor: 'accessing' stamp: 'IgorStasenko 5/7/2012 13:47'!
callbackEnterMethod
	"do not override"
	^ NBFFICallback compiledMethodAt: #pvtEnter:stackPointer:primitiveMethod:  .! !

!NBFFICallback class methodsFor: 'private' stamp: 'IgorStasenko 5/8/2012 16:06'!
checkSession
	session == NativeBoost uniqueSessionObject ifFalse: [
		numArgs := cbEnter := cbLeave := trunkCode := nil.
		session := NativeBoost uniqueSessionObject.
	].

! !

!NBFFICallback class methodsFor: 'callback spec' stamp: 'IgorStasenko 9/16/2012 17:20'!
fnSpec

	"answer an anonymous C function signature for a given callback,
	like #( long ( int a, int* b) )"

	self subclassResponsibility .
! !

!NBFFICallback class methodsFor: 'callback spec' stamp: 'Igor.Stasenko 5/13/2010 23:33'!
asNBExternalType: gen
	^ NBFFICallbackType new callbackClass: self! !

!NBFFICallback class methodsFor: 'accessing' stamp: 'IgorStasenko 5/8/2012 16:05'!
callbackLeaveAddress

	self checkSession.
	
	cbLeave ifNil: [ self installCallbackCode ].
	
	^ cbLeave address

! !

!NBFFICallback class methodsFor: 'code generation' stamp: 'IgorStasenko 5/8/2012 16:53'!
installCallbackCode
	| enterCodeFn leaveCodeFn leaveOffset returnAddr |

		cbEnter := NBCallbackCodeGen new generateCallbackEnterCodeFor: self.
		cbEnter install.
		
		returnAddr := cbEnter address value + (cbEnter code offsetAt: #returnToC).
		cbLeave := NBCallbackCodeGen new generateCallbackLeaveCodeFor: self leaveAddr: returnAddr.
		
		cbLeave install.
! !

!NBFFICallback class methodsFor: 'private' stamp: 'IgorStasenko 5/7/2012 13:40'!
numArgs: int

	numArgs := int! !

!NBFFICallback class methodsFor: 'private' stamp: 'IgorStasenko 5/8/2012 16:06'!
reset 
	self checkSession.
	
	cbEnter ifNotNil: [
		
		cbEnter uninstall.
		cbLeave uninstall.
		numArgs := cbEnter := cbLeave := trunkCode := nil.
	].
! !

!NBFFICallback class methodsFor: 'accessing' stamp: 'IgorStasenko 5/8/2012 03:04'!
trunkCode
	self checkSession.

	^ trunkCode ifNil: [ | asm |
		asm := NativeBoost newAssembler noStackFrame.  "NO STACK FRAME, since we just jump to common entry point"

		asm
			mov: (0 asUImm32 label: (asm labelNamed: #index)) to: ECX; " callback index "
			mov: ((self callbackEnterAddress asUImm32) label: (asm labelNamed: #cbEnterAddress)) to: EAX;
			jmp: EAX.
		
		trunkCode := asm generatedCode.
	]
! !

!NBFFICallback class methodsFor: 'instance creation' stamp: 'Igor.Stasenko 5/13/2010 22:40'!
new
	self error: 'use #on: instead'.! !

!NBFFICallback class methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/11/2010 02:35'!
numberOfArguments

	^ numArgs! !

!NBFFICallback class methodsFor: 'callback spec' stamp: 'IgorStasenko 9/15/2012 14:24'!
callType

	"Answer a callback function calling convention
	#cdecl or #stdcall
	"
	
	"By default, use cdecl convention"
	
	^ #cdecl! !

!NBFFICallback class methodsFor: 'instance creation' stamp: 'Igor.Stasenko 5/13/2010 22:43'!
on: aBlock

	^ self basicNew initialize block: aBlock! !

!NBFFICallback class methodsFor: 'finalization' stamp: 'IgorStasenko 9/15/2012 14:18'!
finalizeResourceData: trunkAndIndex
	
	NativeBoost free: trunkAndIndex first.
	NativeBoost extraRootsRegistry releaseCallbackIndex: trunkAndIndex second.
! !

!NBFFICallbackTests methodsFor: 'tests - native callbacks' stamp: 'Igor.Stasenko 9/26/2010 05:38'!
testcallbackAddress

	| callback addr1 addr2 |

	callback := self createNativeCallback.
	
	[ 
		callback install.
		addr1 := callback address value.
		addr2 := self checkCallbackAddress: callback address.
	] ensure:  [ callback uninstall ].

	self assert: (addr1 = addr2)! !

!NBFFICallbackTests methodsFor: 'tests' stamp: 'Igor.Stasenko 5/14/2010 01:03'!
testMemCopy

	| mem bytes |


	bytes := #[ 1 2 3 4 5 6 7 8 9 10 ].
	
	mem := NativeBoost allocate: bytes size.
	
	[
	NativeBoost memCopy: bytes to: mem size: bytes size.
	
	1 to: bytes size do: [:i |
		self assert: (bytes at:i) = (mem byteAt: i-1)
		].
	] ensure: [ NativeBoost free: mem ]! !

!NBFFICallbackTests methodsFor: 'private' stamp: 'IgorStasenko 11/24/2012 16:26'!
checkCallbackAddress:  nativeCallbackAddr

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	

	^ self nbCallout function: #(ulong  (NBExternalAddress nativeCallbackAddr))
		emit: [:gen | 	gen asm pop: EAX ] 
"			options: #( - optAllowByteArraysPtr +optAllowExternalAddressPtr  ) "! !

!NBFFICallbackTests methodsFor: 'tests' stamp: 'IgorStasenko 6/27/2013 17:17'!
testCBGeneratedCode
	
	| addr trunk |

	
	addr := NBQSortCallback callbackEnterAddress asUnsignedLong.
	trunk := NBQSortCallback trunkCode.
	
	self assert: (trunk bytes unsignedLongAt: 1+ (trunk offsetAt: #cbEnterAddress) bigEndian: false) = addr.
	
	
	! !

!NBFFICallbackTests methodsFor: 'private' stamp: 'IgorStasenko 11/24/2012 16:26'!
checkCallback: arr1 with: arr2 compare: nativeCallback

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	

	^ self nbCallout function: #(long  (NBExternalAddress nativeCallback, byte* arr1, byte* arr2 ))
		emit: [:gen |
			gen asm pop: EAX;
				call: EAX
			] ! !

!NBFFICallbackTests methodsFor: 'tests - native callbacks' stamp: 'Igor.Stasenko 9/26/2010 05:36'!
createNativeCallback
	"
	The routine must compare the elements, then return one of the following values:
	< 0 elem1 less than elem2 
	0 elem1 equivalent to elem2 
	> 0 elem1 greater than elem2 
	"
	^ NBNativeFunctionGen 
		cdecl: #( int (byte* a, byte * b) )
		emit: [:gen | | asm |
			asm := gen asm.

			asm 
				mov: (gen arg: #b) to: EAX;
				mov: EAX ptr8 to: CL;
				mov: (gen arg: #a) to: EAX;
				mov: EAX ptr8 to: AL;
				sub: AL with: CL;
				movsx: EAX with: AL  "sign-extend the result"
		]
! !

!NBFFICallbackTests methodsFor: 'tests - native callbacks' stamp: 'sig 3/30/2012 14:55'!
testNativeCallback

	| orig bytes callback |
	
	orig := #[ 2 5 3 10 39 4 80 ] copy.
	bytes := orig copy.
	
	callback := self createNativeCallback.
	
	[ 
		callback install.
		self primNativeQSort: bytes compare: callback address.
	] ensure:  [ callback uninstall ].

	self assert: (orig sort = bytes)


! !

!NBFFICallbackTests methodsFor: 'tests - language-side callback' stamp: 'IgorStasenko 6/27/2013 17:17'!
testQSortCallbackST
	
	| callback orig bytes result |
	
	orig := #[ 2 5 3 10 39 4 80 ] copy.
	bytes := NativeBoost allocate: orig size.
	
	NativeBoost memCopy: orig to: bytes  size: orig size.

	callback := NBQSortCallback on: [:a :b | (a byteAt: 0) - (b byteAt: 0) ].
	
	self primStQSort: bytes len: orig size compare: callback.

	result := ByteArray new: orig size.
	NativeBoost memCopy: bytes to: result size: orig size.
	NativeBoost free: bytes.
		
	self assert: (orig sort = result)



! !

!NBFFICallbackTests methodsFor: 'private' stamp: 'IgorStasenko 11/24/2012 16:28'!
readByte: array at: index

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout
		function: #(byte (byte * array, ulong index))
		emit: [:gen |
			gen asm pop: EAX;
				pop: ECX;
				add: EAX with: ECX;
				mov: EAX ptr8 to: AL
			] ! !

!NBFFICallbackTests methodsFor: 'qsort callouts' stamp: 'IgorStasenko 11/24/2012 16:27'!
primStQSort: base len: size compare: qsortCallback

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout
		options: #( optMayGC );
		function: #(void qsort (NBExternalAddress base, ulong size, 1, NBQSortCallback qsortCallback))
		module: NativeBoost CLibrary! !

!NBFFICallbackTests methodsFor: 'private' stamp: 'IgorStasenko 11/24/2012 16:28'!
readByte: array

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout
		function: #(byte (byte * array))
		emit: [:gen |
			gen asm pop: EAX;
				mov: EAX ptr8 to: AL
			] ! !

!NBFFICallbackTests methodsFor: 'tests - native callbacks' stamp: 'Igor.Stasenko 9/26/2010 05:38'!
testInstallCallback

	| callback |
	
	callback := self createNativeCallback.

	callback install.
	self assert:(callback address notNil).
	callback uninstall.! !

!NBFFICallbackTests methodsFor: 'tests' stamp: 'Igor.Stasenko 5/4/2010 00:33'!
testReadByte

	| arr |
	
	arr := #(240 2 3 4 ) asByteArray.
	
	self assert: (self readByte: arr) == 240! !

!NBFFICallbackTests methodsFor: 'private' stamp: 'Igor.Stasenko 5/5/2010 16:55'!
dummyMethod: aParam

	^ aParam! !

!NBFFICallbackTests methodsFor: 'private' stamp: 'IgorStasenko 11/24/2012 16:26'!
checkEmitFetchClass
"
	checker for fetching the class code emitting
"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	

	^ self nbCallout
		function: #(oop  ())
		emit: [:gen |
			gen emitFetchClass: NBExternalAddress
			]! !

!NBFFICallbackTests methodsFor: 'tests' stamp: 'Igor.Stasenko 5/4/2010 00:14'!
testEmitFetchClass

   self assert: (self checkEmitFetchClass ==  NBExternalAddress)! !

!NBFFICallbackTests methodsFor: 'private' stamp: 'Igor.Stasenko 9/26/2010 05:38'!
benchQSort

	| bytes memBytes callback callback2 times |
	
	bytes := #[ 2 5 3 10 39 4 80 203 94 215 30 60 80 20 1 4 0 ].
	memBytes := NativeBoost allocate: bytes size.
	
	callback := self createNativeCallback.
	callback2 := NBQSortCallback on: [:a :b | (a byteAt: 0) - (b byteAt: 0) ].

	[ 
		callback install.
		
		times := { 
			[ bytes copy sort ].
	  		[ self primNativeQSort: bytes copy compare: callback address ].
			[ NativeBoost memCopy: bytes to:  memBytes size: bytes size. 
			  self primStQSort: memBytes len: bytes size compare: callback2 ].
		}
		collect: [:block |
			[ 100000 timesRepeat: block ] timeToRun ].

	] ensure:  [ callback uninstall. NativeBoost free: memBytes ].

	^ times

! !

!NBFFICallbackTests methodsFor: 'tests - language-side callback' stamp: 'IgorStasenko 6/27/2013 17:17'!
testCallbackCounter

	| callback orig bytes result ctr |
	
	"There was a bug in callback code, which crashed VM
	due to override of callgate saved method oop and return address,
	and GC, happened during callback"
	
 
	orig := #[ 2 5 55 23 67 23 ] copy.
	bytes := NativeBoost allocate: orig size.
	
	NativeBoost memCopy: orig to: bytes  size: orig size.

	ctr := 0.
	callback := NBQSortCallback on: [:a :b |

		NativeBoost insideCallback ifTrue: [ ctr := ctr+ 1].  "this involves using callgate" 
		Smalltalk garbageCollect. "this involves GC"
		 (a byteAt: 0) - (b byteAt: 0) ].
	
	self primStQSort: bytes len: orig size compare: callback.

	result := ByteArray new: orig size.
	NativeBoost memCopy: bytes to: result size: orig size.
	NativeBoost free: bytes.

	self assert: (ctr > 0).		
	self assert: (orig sort = result)



! !

!NBFFICallbackTests methodsFor: 'tests - language-side callback' stamp: 'IgorStasenko 11/24/2012 16:26'!
checkSTCallbackAddress:  callback

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	

	^ self nbCallout 
		function: #(void *  (NBQSortCallback  callback))
		emit: [:gen | 	gen asm pop: EAX ] 
! !

!NBFFICallbackTests methodsFor: 'qsort callouts' stamp: 'IgorStasenko 11/24/2012 16:27'!
primNativeQSort: base compare: nativeCallback
"Here, the base must be a ByteArray instance 
	num, the number of elements in it
	width = 4

Call qsort function:	
	void qsort(
	   void *base, - array ptr
	   size_t num,  - number of elements
	   size_t width,  - size of element
	   int (__cdecl *compare )(const void *, const void *) 
	);

	"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout 
		function: #(void qsort (byte* base, NBByteArraySize base, 1, NBExternalAddress nativeCallback))
		module: NativeBoost CLibrary
! !

!NBFFICallbackTests methodsFor: 'tests' stamp: 'ClementBera 5/27/2014 13:49'!
testCreateContext

	| context |
	
	context := 
		Context 
			sender: nil
			receiver: 1
			method: (self class compiledMethodAt: #dummyMethod: )
			arguments: #( 55 ).
			
		
	^ context! !

!NBFFICallbackTests methodsFor: 'tests - language-side callback' stamp: 'IgorStasenko 6/27/2013 17:17'!
testSTCallbackInstalled

	| callback trunk index |

	callback := NBQSortCallback on: [:x :y | ]. 
	trunk := callback trunk.
	index := callback index.
	
	self assert: ((NativeBoost extraRootsRegistry at: #callbacks) at: index +1) == callback.
	
	self assert: (self checkSTCallbackAddress:  callback) = trunk

	! !

!NBFFICallbackType commentStamp: 'Igor.Stasenko 5/4/2010 05:15'!
Pushing a callback to stack!
!NBFFICallbackType methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/13/2010 23:33'!
callbackClass: aClass
	callbackClass := aClass! !

!NBFFICallbackType methodsFor: 'accessing' stamp: 'cipt 11/28/2012 19:04'!
trunkIvarIndex
	" return a zero-based index "
	^ ( callbackClass instVarIndexFor: #trunk ifAbsent: [ self error: ' should not happen ' ] ) - 1! !

!NBFFICallbackType methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/4/2010 05:16'!
valueSize
	^ self pointerSize! !

!NBFFICallbackType methodsFor: 'emitting code' stamp: 'IgorStasenko 9/15/2012 14:22'!
pushAsValue: gen
	"push the callback trunk address"
	| asm proxy oop |
	
	proxy := gen proxy.
	asm := gen asm.
	
	oop := gen reserveTemp.

	loader emitLoad: gen to: oop.
	self verifyClassOf: oop is: callbackClass generator: gen.
	
	asm mov: oop to: asm EAX.
	asm mov: asm EAX ptr + (proxy ivar: #trunk in: callbackClass) to: asm EAX. 
	proxy fetchPointer: 0 ofObject: asm EAX. "callback address"
	asm push: asm EAX.
! !

!NBFFICallbackType methodsFor: 'emitting code' stamp: 'cipt 11/28/2012 19:36'!
coerceReturnValue: gen

	"trunk is in EAX. 
	first, create an instance of NBExternalHandle. Place the trunk there ,
	then create an instance of receiver and place trunk oop in its trunk ivar"

	| asm proxy result trunkOop oop done |
	
	proxy := gen proxy.
	asm := gen asm.
	result := gen reserveTemp.
	trunkOop := gen reserveTemp.
	oop := gen reserveTemp.
	done := asm uniqueLabelName: 'done'.
	
	asm mov: asm EAX to: result.

	gen optReturnNullAsNil ifTrue: [ | notnil |
		notnil := asm uniqueLabelName: 'notNil'.
		
		asm 
			or: asm EAX with: asm EAX;
			jne: notnil.
		proxy nilObject.
		asm jmp: done.
		asm label: notnil.
	].	
	gen emitFetchClass: NBExternalAddress.
	
	proxy instantiateClass: asm EAX indexableSize: 4.
	asm mov: asm EAX to: trunkOop.

	proxy firstIndexableField: asm EAX.
	asm mov: result to: asm ECX;
		mov: asm ECX to: asm EAX ptr.
	
	proxy pushRemappableOop: trunkOop.
	
	gen emitFetchClass: callbackClass.
	
	proxy instantiateClass: asm EAX indexableSize: 0.
	"EAX <- our instance "
	asm mov: asm EAX to: oop.
	proxy popRemappableOop.
	asm mov: asm EAX to: trunkOop.
	
	proxy storePointer: self trunkIvarIndex ofObject: oop  withValue: trunkOop.
	
	asm mov: oop to: asm EAX.  "return the oop"

	gen releaseTemps: 3.
	asm label: done.! !

!NBFFICallbackType methodsFor: 'testing' stamp: 'Igor.Stasenko 5/13/2010 23:31'!
isCallback
	^ true! !

!NBFFICallout commentStamp: '<historical>'!
Callout arguments can be either:
- an integer constant, boolean or nil
- a type name (string or symbol)
- a class name
- a class variable
- any other object, which responds to #asFFICalloutArgument:


An object , answered by #asFFICalloutArgument: should implement 
a public protocol of NBExternalType 

Todo....
Options:

argument coercion options:
	#coerceBoolToInt  - Boolean   -> C integer (0/1)
	#coerceNilToInt  -  nil       -> C integer (0)
	#coerceFloatToInt - Float     -> C integer
	#coerceCharToInt -  Character -> C integer

	#noTypeChecking - do not perform any type checking for pushed arguments 
	  (dangerous, but sometimes can be useful)
		
return value coercion options:
	#returnBoolAsInt  -  do not turn a bool(0/1) into Boolean (true/false)

cdecl calling convention:
   1.   Function parameters are pushed on the stack in a right-to-left order.
   2. Any local variables declared by the callee are allocated on the stack by subtracting the number of bytes required from esp. That is (sub esp,NUMBER_OF_BYTES).
   3. Registers eax, ecx, and edx are available for use in the subprogram.
   4. Registers ebx, esi, edi, and ebp must not be modified by the callee. (In fact, they may be used, but their original values must be restored before exiting the callee).
   5. When the callee terminates, any local variable must be released by restoring esp to its original value (mov esp,ebp).
   6. Function return values are returned in the eax register (except for floating point values, which are returned in the st0 register).
   7. After the callee is over, the parameters that were pushed on the stack by the caller must be removed by the caller itself once the callee is terminated. It can be done in two ways :
          * pop ecx n times, where n is the number of parameters pushed (cons: a useless result is stored in ecx, and ecx's value changes)
          * add esp,NUMBER_OF_BYTES_PREVIOUSLY_PUSHED (1 parameter pushed = 4 bytes on a 32 bit machine)!
!NBFFICallout methodsFor: 'failure code' stamp: 'IgorStasenko 8/8/2011 17:50'!
errorCodeForMessage: aString
	
	^ self class registerErrorMessage: aString! !

!NBFFICallout methodsFor: 'code generation' stamp: 'IgorStasenko 1/18/2012 16:22'!
newCallInfo 

	self optCdecl ifTrue: [ ^ asm newCdeclCall ].
	self optStdcall ifTrue: [ ^ asm newStdCall ].
	
! !

!NBFFICallout methodsFor: 'code generation' stamp: 'IgorStasenko 5/11/2011 17:23'!
coercionMayFail: aBoolean 
	coercionMayFail := coercionMayFail or: aBoolean ! !

!NBFFICallout methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/30/2010 11:48'!
fnSpec
	^ fnSpec! !

!NBFFICallout methodsFor: 'argument loaders' stamp: 'cipt 10/24/2012 20:39'!
indirectLoader: aLoader byIndex: anIndex
	^ NBSTIndirectArgument new
		argumentLoader: aLoader;
		elementIndex: anIndex! !

!NBFFICallout methodsFor: 'code generation' stamp: 'Igor.Stasenko 5/1/2010 13:52'!
callCleanup
 	" for cdecl call type we should pop the function arguments we are pushed on stack..
	but since we returning back to interpreter using leave , it will be cleaned anyways"
! !

!NBFFICallout methodsFor: 'call conventions' stamp: 'HenrikSperreJohansen 6/24/2014 16:25'!
cdecl
	options at: #optCdecl put: true! !

!NBFFICallout methodsFor: 'code generation' stamp: 'IgorStasenko 12/3/2013 02:27'!
generateInstructions: aFunctionBodyBlock
	| instructions |
	
	proxy prepareForCallout.
	"prepare & push arguments"	
	
	asm decorateWith: 'FFI: prepare arguments' during: [ fnSpec arguments do: [:arg | arg prepareArgumentUsing: self ] ].

	
	self foreignCall: [:call |
		"do not align, if its not required"
		self optNoAlignment ifTrue: [ call alignment: 1].

		self pushArguments.
	
		self emitFailureTest.

		asm decorateWith: 'FFI: performing a call' during: [
			aFunctionBodyBlock valueWithPossibleArgs: { self. proxy. asm}.
		
			"if we're using custom emitcall section, don't bother to cleanup the stack "
			(self optEmitCall or: [self optNoCleanup]) ifTrue: [ call disableCleanup ].
		].
	
	].
	
	"handle return value"
	asm decorateWith: 'FFI: coerce return value' during: [   
		fnSpec returnType coerceReturn: self ].
	
	self epilogue.
	self emitFailureHandler.

	(self optMayGC or: [proxy usedGate ]) ifTrue: [
		asm reserveExtraBytesOnStack: asm wordSize*2.
	].

	instructions := asm prepareInstructions.
	
	self optDebug ifTrue: [ self halt ].
	
	^ instructions
! !

!NBFFICallout methodsFor: 'accessing' stamp: 'IgorStasenko 8/21/2011 11:29'!
namedFnSpec: namedFn
	
	fnSpec := self newSpecParser parseNamedFunction: namedFn.
	! !

!NBFFICallout methodsFor: 'initialization' stamp: 'IgorStasenko 8/3/2011 06:33'!
initialize 
	super initialize.
	coercionMayFail := false! !

!NBFFICallout methodsFor: 'spec parsing' stamp: 'cipt 10/24/2012 20:25'!
argName: argName indirectIndex: anIndex type: typeName ptrArity: ptrArity
	| type |
	argName
		ifNil: [ 
			"allow nil,true,false as untyped arguments"
			typeName = 'nil'
				ifTrue: [ ^ NBFFIConst value: 0 ].
			typeName = 'false'
				ifTrue: [ ^ NBFFIConst value: 0 ].
			typeName = 'true'
				ifTrue: [ ^ NBFFIConst value: 1 ].
			ptrArity > 0
				ifTrue: [ self error: 'missing argument name' ].	"lone self"
			typeName = 'self'
				ifTrue: [ ^ (requestor asNBExternalType: self) loader: self receiverArgumentLoader ].
			^ self resolveType: typeName ].
	type := self typeName: typeName ptrArity: ptrArity.
	type loader: (self loaderForArgNamed: argName indirectIndex: anIndex).
	^ type! !

!NBFFICallout methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/26/2010 02:03'!
requestor
	^ requestor! !

!NBFFICallout methodsFor: 'accessing' stamp: 'IgorStasenko 7/12/2013 16:31'!
sender: aSenderContext
	| nArgs |
	self requestor: aSenderContext method methodClass.
	nArgs := aSenderContext method numArgs.
	methodArgs := aSenderContext method nbArgumentNames.
	self receiver: aSenderContext receiver.
	self assert: (methodArgs size = nArgs).
! !

!NBFFICallout methodsFor: 'spec parsing' stamp: 'CiprianTeodorov 5/18/2013 21:59'!
returnType: aType
	aType first = 'receiver'
		ifTrue: [ 
			| rcvr rqstr |
			"check that:
				1. method belongs to class side
				2. method class is subclass of NBExternalObject
				3. receiver is the same or subclass of the requestor -- since the requestor is the implementor"
			rcvr := self receiver.
			rqstr := self requestor soleInstance.
			(rcvr isBehavior
				and: [ (rcvr == rqstr or: [ rcvr inheritsFrom: rqstr ]) and: [ rcvr inheritsFrom: NBExternalObject ] ])
				ifTrue: [ ^ self typeName: rcvr name ptrArity: aType second ] ].
	self receiver: nil. "if the type is not 'receiver' then we don't need the receiver of the message so set it to nil"
	^ self typeName: aType first ptrArity: aType second! !

!NBFFICallout methodsFor: 'failure code' stamp: 'IgorStasenko 8/6/2011 18:32'!
failWithCode: aCode

	asm 
		mov: aCode to: EAX;
		jmp: self failedWithCodeLabel! !

!NBFFICallout methodsFor: 'accessing' stamp: 'JavierPimas 11/16/2011 17:08'!
callType: aCallType

	aCallType == #cdecl ifTrue: [
		^ self cdecl.
		].
	
	aCallType == #stdcall ifTrue: [
		^ self stdcall
		].
	
	self error: 'unknown call type'.
! !

!NBFFICallout methodsFor: 'code generation' stamp: 'IgorStasenko 1/18/2012 16:22'!
foreignCall: aBlock

	callInfo := self newCallInfo.
	callInfo alignment: self stackAlignment.
	asm performingCall: callInfo in: aBlock.! !

!NBFFICallout methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/26/2010 02:04'!
requestor: aRequestor
	requestor := aRequestor.
	
	(requestor respondsTo: #ffiCalloutOptions) ifTrue: [
		self parseOptions: requestor ffiCalloutOptions
	]
! !

!NBFFICallout methodsFor: 'accessing' stamp: 'IgorStasenko 8/21/2011 11:29'!
anonSpec: anonFunctionSpec

	fnSpec := self newSpecParser parseAnonFunction: anonFunctionSpec.
! !

!NBFFICallout methodsFor: 'code generation' stamp: 'IgorStasenko 12/3/2013 02:27'!
pushArguments

	" argument indexes pushed on ST stack are: 

	argType   ST stack  C stack 
	   index       index        push order
	    1              2             2
	    2              1             1
	    3              0             0
	"

	"both cdecl/apicall using reverse argument order on stack"
	fnSpec arguments notEmpty ifTrue: [
		asm decorateWith: 'FFI: pushing arguments' during: [   
			fnSpec arguments reverseDo: [:arg | 
				asm noticePush: arg stackSize forCall: callInfo.
				arg emitPush: self ] ]
	].

	fnSpec returnType 
		prepareReturnValue: self for: callInfo.! !

!NBFFICallout methodsFor: 'code generation' stamp: 'IgorStasenko 8/5/2011 18:01'!
receiverArgumentLoader
	^ NBSTMethodArgument new stackIndex: methodArgs size; isReceiver: true  ! !

!NBFFICallout methodsFor: 'type aliases' stamp: 'Igor.Stasenko 9/28/2010 08:00'!
aliasForType: aTypeName

	| alias |
	alias := aTypeName.
	(requestor notNil and: [ requestor respondsTo: #externalTypeAlias: ]) 
		ifTrue: [ alias := requestor externalTypeAlias: aTypeName.
			alias ifNil: [ alias := aTypeName ] ].
	
	" internal aliases "
	TypeAliases ifNil: [ self class initTypeAliases ].
	^ TypeAliases at: alias ifAbsent: [ alias ]! !

!NBFFICallout methodsFor: 'failure code' stamp: 'IgorStasenko 8/8/2011 17:49'!
failWithMessage: aString
	
	| errorCode |
	
	errorCode := self errorCodeForMessage: aString.
	
	^ self failWithCode: errorCode
! !

!NBFFICallout methodsFor: 'argument loaders' stamp: 'cipt 10/24/2012 20:30'!
loaderForArgNamed: argName indirectIndex: anIndex
	| loader |
	loader := self loaderForArgNamed: argName.
	anIndex isNil
		ifFalse: [ loader := self indirectLoader: loader byIndex: anIndex ].
	^ loader! !

!NBFFICallout methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/3/2010 01:05'!
methodArgs
	^ methodArgs! !

!NBFFICallout methodsFor: 'failure code' stamp: 'CamilloBruni 7/23/2012 13:29'!
emitFailureHandler
	"emit failure code only if there was a jump on failed label,
	and label are not already defined in code"
	| failLbl failWithCodeLabel |
	failLbl := self failedLabel.
	failWithCodeLabel  := self failedWithCodeLabel.

	self assert: failLbl isSet not.
	self assert: failWithCodeLabel isSet not.

	((asm isLabelUsed: failWithCodeLabel) or: [asm isLabelUsed: failLbl ] ) ifTrue: [
		asm decorateWith: 'FFI: handle failure' during: [   

		(asm isLabelUsed: failWithCodeLabel) ifTrue: [
			"assume that error code is passed in EAX"
			asm label: failWithCodeLabel.
			proxy primitiveFailFor: asm EAX.
			self epilogue ].

		(asm isLabelUsed: failLbl) ifTrue: [
			asm label: self failedLabel.
			proxy primitiveFail.
			self epilogue ].
	]]	
! !

!NBFFICallout methodsFor: 'code generation' stamp: 'Igor.Stasenko 4/28/2010 12:46'!
returnValueRegister
	
	"answer a register, which is used by functions to return value"
	^ EAX! !

!NBFFICallout methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 6/24/2014 16:25'!
useEmitCall
	"set the flag that we're generating code which using custom emitCall: section"
	
	options at: #optEmitCall put: true! !

!NBFFICallout methodsFor: 'failure code' stamp: 'IgorStasenko 8/6/2011 18:25'!
failedWithCodeLabel
	^ asm labelNamed: #FFICalloutFailedWithCode! !

!NBFFICallout methodsFor: 'accessing' stamp: 'CiprianTeodorov 5/18/2013 20:46'!
receiver: anObject
	receiver := anObject! !

!NBFFICallout methodsFor: 'accessing' stamp: 'CiprianTeodorov 5/18/2013 20:46'!
receiver
	^ receiver! !

!NBFFICallout methodsFor: 'failure code' stamp: 'IgorStasenko 8/3/2011 06:53'!
emitFailureTest
	"emit call to InterpreterProxy>>failed to check if there's everything ok
	(usually done before making a call) "

	coercionMayFail ifTrue: [
		proxy ifFailedJumpTo: self failedLabel ].
! !

!NBFFICallout methodsFor: 'failure code' stamp: 'IgorStasenko 8/6/2011 18:25'!
failedLabel
	^ asm labelNamed: #FFICalloutFailed! !

!NBFFICallout methodsFor: 'code generation' stamp: 'CamilloBruni 7/25/2012 12:43'!
generate: aFunctionBodyBlock
	"Answer the byte array, containing the generated machine code"
	| generatedCode |
	
	generatedCode := AJGeneratedCode fromInstructions: (self generateInstructions: aFunctionBodyBlock).
		
	^ generatedCode bytes
	
! !

!NBFFICallout methodsFor: 'spec parsing' stamp: 'Igor.Stasenko 4/30/2010 09:18'!
typeName: aName ptrArity: ptrArity

	^ (self resolveType: aName) pointerArity: ptrArity! !

!NBFFICallout methodsFor: 'call conventions' stamp: 'HenrikSperreJohansen 6/24/2014 16:25'!
stdcall
	options at: #optStdcall put:true! !

!NBFFICallout methodsFor: 'testing' stamp: 'Igor.Stasenko 5/18/2010 02:23'!
usesMethodArguments

	^ fnSpec arguments anySatisfy: [:type | type loader usesSTStack ]! !

!NBFFICallout methodsFor: 'code generation' stamp: 'IgorStasenko 11/22/2012 18:23'!
generateCall: functionSpec module: aModuleNameOrHandle
	"Generate a foreign function callout from given function specification and
	a module name"
	
	| fnAddress |

	self namedFnSpec: functionSpec.

	fnAddress := requestor nbGetSymbolAddress: fnSpec functionName module: aModuleNameOrHandle.
	fnAddress ifNil: [ self error: 'function unavailable' ].
	
	^ self generateCallToAddress: [ fnAddress ]
! !

!NBFFICallout methodsFor: 'argument loaders' stamp: 'cipt 10/21/2012 20:25'!
loaderFromMethodArgsNamed: argName
	methodArgs
		ifNotNil: [ 
			| index |
			index := methodArgs indexOf: argName ifAbsent: [ nil ].
			index
				ifNotNil: [ 
					"ok, this is a method argument"
					^ NBSTMethodArgument new stackIndex: methodArgs size - index ] ].
	^ nil! !

!NBFFICallout methodsFor: 'code generation' stamp: 'IgorStasenko 11/22/2012 18:10'!
generateCallToAddress: aFunctionAddressBlock
	"Generate a foreign function callout using given function address"

	^ self generate: [:gen | | fnAddress |

		fnAddress := aFunctionAddressBlock cull: self cull: proxy cull: asm.
		
		fnAddress ifNil: [ self error: 'function unavailable' ].
		
		self optMayGC 
			ifTrue: [
				"a GC may be triggered during external call. Make sure we making a call via gate "
				asm 
					push: fnAddress asUImm32;
					mov: NativeBoost callgateFunctionAddress asUImm32 to: EAX;
					call: EAX ]
			ifFalse: [
				asm mov: fnAddress asUImm32 to: EAX;
				call: EAX.  ] 
		]
	! !

!NBFFICallout methodsFor: 'spec parsing' stamp: 'Igor.Stasenko 4/30/2010 11:27'!
integerConstantArgument: int

	^ NBFFIConst value: int! !

!NBFFICallout methodsFor: 'accessing' stamp: 'TorstenBergmann 12/15/2014 12:39'!
resolveType: aTypeName
	" a type name could be
	 - a class variable name
	- a class name
	- a type name 
	- a type name, followed by arbitrary number pointer chars - $*"

	| name newName resolver binding ptrArity |
	
	newName := aTypeName.
	ptrArity := 0.
	"resolve aliases and pointers"	
	[
		name := newName asString trimRight.  
		newName := self aliasForType: name.
		newName last = $* ifTrue: [
			ptrArity := ptrArity + 1.
			newName := newName allButLast ].
		name = newName ] whileFalse.
	
	resolver := requestor ifNil: [ self class ].
	binding := resolver nbBindingOf: name asSymbol.
	
	binding ifNotNil: [ 
		^ (binding value asNBExternalType: self) pointerArity: ptrArity ] .

	^ self error: 'Unable to resolve external type: ', aTypeName.

! !

!NBFFICallout methodsFor: 'private' stamp: 'IgorStasenko 7/12/2013 16:31'!
methodArgs: aMethodArgumentNames
	"Note: avoid setting directly,  this method is only for testing purposes"
	methodArgs := aMethodArgumentNames! !

!NBFFICallout methodsFor: 'argument loaders' stamp: 'cipt 10/26/2012 19:26'!
loaderForArgNamed: argName
	| loader |
	"try getting the argument from the method arguments"
	loader := self loaderFromMethodArgsNamed: argName.
	loader
		ifNil: [ 
			"special case, receiver argument"
			argName = 'self'
				ifTrue: [ loader := self receiverArgumentLoader ].
			loader
				ifNil: [ 
					"Ask the requestor for the argument"
					loader := requestor nbFnArgument: argName generator: self.
					loader ifNil: [ Error signal: 'Could not find accessor for variable named "' , argName , '" in ' , method name ] ] ].	"]"
	^ loader! !

!NBFFICallout methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/30/2010 06:54'!
newSpecParser

	^ NBFnSpecParser new requestor: self
! !

!NBFFICallout class methodsFor: 'generator entry points' stamp: 'CamilloBruni 7/17/2012 14:01'!
stdcall: functionSpec emitCall: aCallEmittingBlock options: anOptions

	"Note, this is a special method, which should be sent only from 
	methods, which intend to use FFI callout code.
	All such methods should use a 'primitiveNativeCall' primitive.

	First argument is an array of types, where first element denotes a function return type,
	and rest denoting argument types.
	A CallEmittingBlock serves to emit an actual function call code. 

	" 
	| sender |
	sender := thisContext sender.
	^ self 
		handleFailureIn: sender
		nativeCode: [ :gen |
			gen
				useEmitCall;
				sender: sender;
				parseOptions: anOptions;
				stdcall;
				anonSpec: functionSpec;
				generate: aCallEmittingBlock  ]
! !

!NBFFICallout class methodsFor: 'generator entry points' stamp: 'Igor.Stasenko 5/3/2010 21:48'!
cdecl: functionSpec module: aModuleName

"Note, this is a special method, which should be sent only from 
methods, which intend to use FFI callout code.
All such methods should use a 'primitiveNativeCall' primitive.

First argument is an array of types, where first element denotes a function return type,
and rest denoting argument types.
A CallEmittingBlock serves to emit an actual function call code. 

" 
	| sender |
	sender := thisContext sender.
	^ self 
		handleFailureIn: sender
		nativeCode: [ :gen |
			gen
				sender: sender;
				cdecl;
				generateCall: functionSpec module: aModuleName ]
! !

!NBFFICallout class methodsFor: 'options' stamp: 'cipt 10/25/2012 19:14'!
defaultOptions
	"see #allOptions on my instance side"
	^ #(
	
	"#optCoerceNilToNull"
	"passing nil as a pointer-type argument, converts it to C NULL "
		
	#optAllowExternalAddressPtr
	"for a pointer-type argument, accept an instance of NBExternalAddress "
	
	"for a pointer-type argument, allow passing a pointer to byte arrays"
	#optAllowByteArraysPtr 
	
	"if function returns a pointer, return nil if pointer is null"
	#optReturnNullAsNil  
		
	"If function returns a pointer, fail primitive if pointer is null.
	Takes preference over #returnNullAsNil 
	Default: disabled. "
	"#optFailOnReturnNull"	

	"if function returns a pointer, convert it to unsigned integer object.
	Default: disabled
	#optReturnPtrAsInt "
	
	"If function returns a pointer, convert it to an instance of NBExternalAddress.
	Takes preference over #returnPtrAsInt.
	Default: enabled.  "
	#optReturnPtrAsExternalAddress
		
	"directly convert between C integers and Smallintegers instead of using proxy 	functions. perform no range checking"
	"#optQuickSmi --  not yet done	" 

	"directly convert between C integers and Smallintegers instead of using proxy 	functions. include range checking"
	"#optQuickSmiSafe --  not yet done	" 
				
	"string conversion"
	
	"for char* parameter type, when passed an instance of ByteString, 
	copy a ByteString's contents on a stack, append null character and pass a pointer to it"
	"#optAcceptStringForCharPtr ---  not yet implemented"	
		
	"for a function returning char* type, convert it to an instance of ByteString"
	"#optReturnCharPtrAsString -- not yet implemented"

	"for a function spec taking arguments indirectly from an array using the x@index convention
	check that the index is not outside x''s bounds "
	#optCheckIndirectArgBounds
	)
! !

!NBFFICallout class methodsFor: 'generator entry points' stamp: 'CamilloBruni 10/4/2012 15:34'!
cdecl: functionSpec emitCall: aCallEmittingBlock options: anOptions

	"Note, this is a special method, which should be sent only from 
	methods, which intend to use FFI callout code.
	All such methods should use a 'primitiveNativeCall' primitive.

	First argument is an array of types, where first element denotes a function return type,
	and rest denoting argument types.
	A CallEmittingBlock serves to emit an actual function call code. 

	" 
	| sender |
	sender := thisContext sender.
	^ self 
		handleFailureIn: sender
		nativeCode: [ :gen |
			gen
				useEmitCall;
				sender: sender;
				parseOptions: anOptions;
				cdecl;
				anonSpec: functionSpec;
				generate: aCallEmittingBlock  ]
! !

!NBFFICallout class methodsFor: 'error messages' stamp: 'IgorStasenko 2/20/2012 13:48'!
signalError: errorCode
	^ NBFFICalloutError signalError: errorCode
! !

!NBFFICallout class methodsFor: 'generator entry points' stamp: 'IgorStasenko 11/22/2012 13:39'!
call: anonFunctionSignature convention: callConvention functionAddress: aFunctionAddressBlock options: aCodeGenerationOptions

	"
	For documentation, please look at #call:convention:functionAddress:
	This method differs only by having additional argument - a code generation options
	" 
	| sender |
	sender := thisContext sender.
	^ self 
		handleFailureIn: sender
		nativeCode: [ :gen |
			gen
				sender: sender;
				callType: callConvention;
				parseOptions: aCodeGenerationOptions;
				anonSpec: anonFunctionSignature;
				generateCallToAddress: aFunctionAddressBlock
			]
! !

!NBFFICallout class methodsFor: 'generator entry points' stamp: 'CamilloBruni 7/17/2012 13:59'!
cdecl: functionSpec emitCall: aCallEmittingBlock

	"Note, this is a special method, which should be sent only from 
	methods, which intend to use FFI callout code.
	All such methods should use a 'primitiveNativeCall' primitive.

	First argument is an array of types, where first element denotes a function return type,
	and rest denoting argument types.
	A CallEmittingBlock serves to emit an actual function call code. 

	" 
	| sender |
	sender := thisContext sender.
	^ self 
		handleFailureIn: sender
		nativeCode: [ :gen |
			gen
				useEmitCall;
				sender: sender;
				cdecl;
				anonSpec: functionSpec;
				generate: aCallEmittingBlock  ]
! !

!NBFFICallout class methodsFor: 'initialize-release' stamp: 'Igor.Stasenko 4/28/2010 16:46'!
initialize

	Smalltalk removeFromStartUpList: self .
	
	self initTypeAliases! !

!NBFFICallout class methodsFor: 'initialize-release' stamp: 'IgorStasenko 9/3/2012 01:42'!
initTypeAliases
	"self initTypeAliases"
	TypeAliases := Dictionary newFromPairs:
	#(
"not really a type, useful only as return type or with pointers "
		void NBVoid
		
" 0/!!0  <-> false/true "
		bool NBBool

"fixed size integer types, byte order is platform dependent "
		int8 NBInt8
		uint8 NBUInt8
		int16 NBInt16
		uint16 NBUInt16
		int32 NBInt32
		uint32 NBUInt32
		int64 NBInt64
		uint64 NBUInt64

" aliases to common C compiler types.. some of them are platform dependent, some is not.. to be sorted out later "		
		signedByte int8
		unsignedByte int8
		signedShort int16
		unsignedShort uint16
		signedChar int8  
		unsignedChar uint8
		schar int8
		uchar uint8
		signedLong int32
		unsignedLong uint32
		sbyte int8
		byte uint8
		short int16
		ushort uint16
		long int32
		ulong uint32
		longlong int64
		ulonglong uint64
		uint uint32
		int int32

"unsigned for sizes.. usually same size as platform's word size"
		size_t NBSizeT
		
"character type. uint8 <-> accepts Character/Smallint as argument, converts return to Character "
		Character NBCharacterType
		char NBCharacterType
		

"Floats fixed-size. platform-dependent byte order"
		float16 NBFloat16
		float32 NBFloat32
		float64 NBFloat64
		float128 NBFloat128

"Floats, C type name aliases"
				
		float float32
		double float64
		shortFloat float16
		
"Special types "		
		oop NBOop
	)
	! !

!NBFFICallout class methodsFor: 'generator entry points' stamp: 'CamilloBruni 7/19/2012 17:28'!
cdecl: functionSpec
	" A shortcut for writing
	    cdecl: AFunctionSpecification module: NativeBoost CLibrary"
	| sender |
	sender := thisContext sender.
	^ self 
		handleFailureIn: sender
		nativeCode: [ :gen |
			gen
				sender: sender;
				cdecl;
				generateCall: functionSpec module: NativeBoost CLibrary ]! !

!NBFFICallout class methodsFor: 'error messages' stamp: 'IgorStasenko 8/8/2011 17:53'!
registerErrorMessage: aString
	| newCode |
	
	CustomErrorMessages ifNil: [ 
		CustomErrorMessages := Dictionary new.
		CustomErrorCodes := Dictionary new.
	].

	(CustomErrorMessages includesKey: aString) ifTrue: [
		^ CustomErrorMessages at: aString
	].
	
	"add new message and register code for it "

		
	newCode := 600 + CustomErrorCodes size.
	CustomErrorMessages at: aString put: newCode.
	CustomErrorCodes at: newCode put: aString.
	
	^ newCode! !

!NBFFICallout class methodsFor: 'generator entry points' stamp: 'CamilloBruni 7/17/2012 14:01'!
stdcall: functionSpec module: aModuleName

	"Note, this is a special method, which should be sent only from 
	methods, which intend to use FFI callout code.
	All such methods should use a 'primitiveNativeCall' primitive.

	First argument is an array of types, where first element denotes a function return type,
	and rest denoting argument types.
	A CallEmittingBlock serves to emit an actual function call code. 

	" 
	| sender |
	sender := thisContext sender.
	^ self 
		handleFailureIn: sender
		nativeCode: [ :gen |
			gen
				sender: sender;
				stdcall;
				generateCall: functionSpec module: aModuleName ]
! !

!NBFFICallout class methodsFor: 'generator entry points' stamp: 'Igor.Stasenko 5/3/2010 21:50'!
cdecl: functionSpec module: aModuleName options: anOptions

"Note, this is a special method, which should be sent only from 
methods, which intend to use FFI callout code.
All such methods should use a 'primitiveNativeCall' primitive.

First argument is an array of types, where first element denotes a function return type,
and rest denoting argument types.
A CallEmittingBlock serves to emit an actual function call code. 

" 
	| sender |
	sender := thisContext sender.
	^ self 
		handleFailureIn: sender
		nativeCode: [ :gen |
			gen
				sender: sender;
				parseOptions: anOptions;
				cdecl;
				generateCall: functionSpec module: aModuleName ]
! !

!NBFFICallout class methodsFor: 'error messages' stamp: 'IgorStasenko 8/8/2011 17:54'!
messageForCode: aCode
	CustomErrorCodes ifNil: [ ^ nil ].
	
	^ CustomErrorCodes at: aCode ifAbsent: nil! !

!NBFFICallout class methodsFor: 'generator entry points' stamp: 'CamilloBruni 7/17/2012 14:01'!
stdcall: functionSpec emitCall: aCallEmittingBlock

	"Note, this is a special method, which should be sent only from 
	methods, which intend to use FFI callout code.
	All such methods should use a 'primitiveNativeCall' primitive.

	First argument is an array of types, where first element denotes a function return type,
	and rest denoting argument types.
	A CallEmittingBlock serves to emit an actual function call code. 

	" 
	| sender |
	sender := thisContext sender.
	^ self 
		handleFailureIn: sender
		nativeCode: [ :gen |
			gen	
				useEmitCall;
				sender: sender;
				stdcall;
				anonSpec: functionSpec;
				generate: aCallEmittingBlock  ]
! !

!NBFFICallout class methodsFor: 'generator entry points' stamp: 'CamilloBruni 7/17/2012 14:00'!
stdcall: functionSpec module: aModuleName options: anOptions

	"Note, this is a special method, which should be sent only from 
	methods, which intend to use FFI callout code.
	All such methods should use a 'primitiveNativeCall' primitive.

	First argument is a function specification denoting return value type, name and
	arguments.

	" 
	| sender |
	sender := thisContext sender.
	^ self 
		handleFailureIn: sender
		nativeCode: [ :gen |
			gen
				sender: sender;
				parseOptions: anOptions;
				stdcall;
				generateCall: functionSpec module: aModuleName ]
! !

!NBFFICallout class methodsFor: 'generator entry points' stamp: 'IgorStasenko 11/22/2012 13:36'!
call: anonFunctionSignature convention: callConvention functionAddress: aFunctionAddressBlock

	"Note, this is a special method, which should be sent only from 
	methods, which intend to use FFI callout code.
	All such methods should use a 'primitiveNativeCall' primitive.

	First argument should be an anonymous function signature, describing the return type and arguments. 
	Second argument is calling convention for the function, should be either #cdecl or #stdcall (more can be added later)
	Third argument is a block, which takes 0 or 1 argument (generator instance) and should return an address of function to call,
	either an unsigned integer value, or NBExternalAddress instance.
	
	Example of use: 
	
		myMethod 
			<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode >
			^ NBFFICallout call: #( int () ) convention: #cdecl functionAddress: [:generator | NativeBoost loadSymbol: 'fork' fromModule: NativeBoost CLibrary]
			
	which is equivalent to: 
	
		myMethod 
			<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode >
			^ self nbCall: #( int fork() )

	This API allows users to define own custom semantics, how/where to obtain a pointer to function which needs to be called.
	Please note that function address block is evaluated only once during code generation, and received function address 
	will be imprinted into generated code, so this API does not fits for cases, when function address needs to be always
	resolved dynamically during each activation of the method.
	For that , there is #cdecl:emitCall: / #stdCall:emitCall: API which allow user to provide own assembler code for calling the function. 
	" 
	| sender |
	sender := thisContext sender.
	^ self 
		handleFailureIn: sender
		nativeCode: [ :gen |
			gen
				sender: sender;
				callType: callConvention;
				anonSpec: anonFunctionSignature;
				generateCallToAddress: aFunctionAddressBlock
			]
! !

!NBFFICalloutAPI methodsFor: 'initialization' stamp: 'IgorStasenko 11/22/2012 18:18'!
initialize
	conv := #cdecl.
	options := #().! !

!NBFFICalloutAPI methodsFor: 'call conventions' stamp: 'IgorStasenko 11/22/2012 18:11'!
stdcall
	conv := #stdcall! !

!NBFFICalloutAPI methodsFor: 'action' stamp: 'IgorStasenko 11/25/2012 15:40'!
function: functionSignature address: fnAddressBlock

	^ NBFFICallout handleFailureIn: context nativeCode: [:gen |
			gen
				callType: conv;
				sender: context;
				parseOptions: options;
				anonSpec: functionSignature;
				generateCallToAddress: fnAddressBlock  
		]
! !

!NBFFICalloutAPI methodsFor: 'accessing' stamp: 'IgorStasenko 11/22/2012 14:23'!
context: anObject
	context := anObject! !

!NBFFICalloutAPI methodsFor: 'action' stamp: 'IgorStasenko 11/24/2012 22:38'!
function: functionSignature module: moduleNameOrHandle

	^ NBFFICallout
		handleFailureIn: context nativeCode: [:gen |
			gen 
				callType: conv;
				sender: context;
				parseOptions: options;
				generateCall: functionSignature module: moduleNameOrHandle 
		]! !

!NBFFICalloutAPI methodsFor: 'options' stamp: 'IgorStasenko 11/22/2012 18:12'!
options: codeGenerationOptions
	options := codeGenerationOptions! !

!NBFFICalloutAPI methodsFor: 'call conventions' stamp: 'IgorStasenko 11/22/2012 18:11'!
cdecl
	conv := #cdecl! !

!NBFFICalloutAPI methodsFor: 'accessing' stamp: 'IgorStasenko 11/23/2012 13:56'!
convention: aCallConvention
	conv := aCallConvention ! !

!NBFFICalloutAPI methodsFor: 'action' stamp: 'IgorStasenko 11/24/2012 22:38'!
function: functionSignature emit: aCallEmittingBlock

	^ NBFFICallout handleFailureIn: context nativeCode: [:gen |
			gen
				useEmitCall;
				callType: conv;
				sender: context;
				parseOptions: options;
				
				anonSpec: functionSignature;
				generate: aCallEmittingBlock  
		]
! !

!NBFFICalloutAPI methodsFor: 'accessing' stamp: 'IgorStasenko 11/22/2012 14:23'!
context
	^ context! !

!NBFFICalloutAPI class methodsFor: 'instance creation' stamp: 'IgorStasenko 11/22/2012 14:24'!
inContext: aContext
	^ self new context: aContext! !

!NBFFICalloutError commentStamp: 'IgorStasenko 2/20/2012 13:52'!
My instances indicating an error during execution of FFI callout.
To get a description, i look up in NBFFICallout for custom error messages , in addition to my superclass.
!
!NBFFICalloutError methodsFor: 'accessing' stamp: 'IgorStasenko 2/20/2012 13:47'!
description

	^ NBErrorDescriptions at: errorCode ifAbsent: [
		(NBFFICallout messageForCode: errorCode) ifNil: [
		'Error during FFI call: ' , errorCode asString]].
	
! !

!NBFFICalloutIndirectArgumentTests methodsFor: 'nativeboost-primitives' stamp: 'IgorStasenko 11/24/2012 17:14'!
returnOopMinus1Of: anArg 

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin >
	
	^ self nbCallout
		options: #( + optUseStackPointer optNoAlignment +optCheckIndirectArgBounds - optDirectProxyFnAddress );
		function: #( oop (oop anArg@ -1) ) emit: [:gen |
			gen asm mov: gen asm ESP ptr to: gen asm EAX ]
	! !

!NBFFICalloutIndirectArgumentTests methodsFor: 'error messages' stamp: 'cipt 10/26/2012 21:05'!
boundsError
	^'Bound checking failed on indirect argument loading'! !

!NBFFICalloutIndirectArgumentTests methodsFor: 'nativeboost-primitives' stamp: 'CiprianTeodorov 5/18/2013 00:12'!
returnOop0Of: anArg 

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin >
	
	^ self nbCallout
		options: #( + optUseStackPointer optNoAlignment +optCheckIndirectArgBounds - optDirectProxyFnAddress );
		function: #( oop (oop anArg@0) ) emit: [:gen |
			gen asm mov: gen asm ESP ptr to: gen asm EAX ]
	! !

!NBFFICalloutIndirectArgumentTests methodsFor: 'nativeboost-primitives' stamp: 'IgorStasenko 11/24/2012 17:13'!
returnOop2Of: anArg 

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin >
	
	^ self nbCallout
		options: #( + optUseStackPointer optNoAlignment +optCheckIndirectArgBounds - optDirectProxyFnAddress );

		 function: #( oop (oop anArg@2) ) emit: [:gen |
			gen asm mov: gen asm ESP ptr to: gen asm EAX ]
	! !

!NBFFICalloutIndirectArgumentTests methodsFor: 'nativeboost-primitives' stamp: 'IgorStasenko 11/24/2012 17:15'!
returnOopMinus3Of: anArg 

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin >
	
	^ self nbCallout 
		options: #( + optUseStackPointer optNoAlignment +optCheckIndirectArgBounds - optDirectProxyFnAddress );
		function: #( oop (oop anArg@ -3) ) emit: [:gen |
			gen asm mov: gen asm ESP ptr to: gen asm EAX ]
	! !

!NBFFICalloutIndirectArgumentTests methodsFor: 'tests' stamp: 'cipt 10/27/2012 12:21'!
testIndirectArgumentDictionayFailure
	| array |
	array := {(1 -> 2).
	(3 -> 3)} asDictionary.
	self assert: (self returnOop1Of: array) =  2. "tally"
	self assert: (self returnOop2Of: array) = {nil. 1->2. nil. 3->3. nil}. "array"
	self
		should: [ self returnOop5Of: array ]
		raise: NBFFICalloutError
		withExceptionDo: [ :anEx | self assert: anEx messageText = self boundsError ]! !

!NBFFICalloutIndirectArgumentTests methodsFor: 'tests' stamp: 'cipt 10/26/2012 21:08'!
testIndirectArgumentFloatFailure
	| array |
	array := 2.0.
	self
		should: [ self returnOop1Of: array ]
		raise: NBFFICalloutError
		withExceptionDo: [ :anEx | self assert: anEx messageText = self typeError ].
	self
		should: [ self returnOop2Of: array ]
		raise: NBFFICalloutError
		withExceptionDo: [ :anEx | self assert: anEx messageText = self typeError ].
	self
		should: [ self returnOop5Of: array ]
		raise: NBFFICalloutError
		withExceptionDo: [ :anEx | self assert: anEx messageText = self typeError ]! !

!NBFFICalloutIndirectArgumentTests methodsFor: 'tests' stamp: 'cipt 10/26/2012 20:53'!
testIndirectArgumentObjectFirstBoundsFailure
	| array |
	array := Object new.
	self should: [ self returnOop1Of: array ] raise: NBFFICalloutError.
! !

!NBFFICalloutIndirectArgumentTests methodsFor: 'tests' stamp: 'cipt 10/26/2012 21:08'!
testIndirectArgumentObjectBoundsFailure
	| array |
	array := Object new.
	self
		should: [ self returnOop2Of: array ]
		raise: NBFFICalloutError
		withExceptionDo: [ :anEx | self assert: anEx messageText = self boundsError ].
	self
		should: [ self returnOop5Of: array ]
		raise: NBFFICalloutError
		withExceptionDo: [ :anEx | self assert: anEx messageText = self boundsError ]! !

!NBFFICalloutIndirectArgumentTests methodsFor: 'tests' stamp: 'cipt 10/26/2012 21:08'!
testIndirectArgumentPointFailure
	| array |
	array := 2 @ 5.
	self assert: (self returnOop1Of: array) == 2.
	self assert: (self returnOop2Of: array) == 5.
	self
		should: [ self returnOop5Of: array ]
		raise: NBFFICalloutError
		withExceptionDo: [ :anEx | self assert: anEx messageText = self boundsError ]! !

!NBFFICalloutIndirectArgumentTests methodsFor: 'tests' stamp: 'cipt 10/26/2012 21:08'!
testIndirectArgumentSmallIntegerFailure
	| array |
	array := 2.
	self
		should: [ self returnOop1Of: array ]
		raise: NBFFICalloutError
		withExceptionDo: [ :anEx | self assert: anEx messageText = self typeError ].
	self
		should: [ self returnOop2Of: array ]
		raise: NBFFICalloutError
		withExceptionDo: [ :anEx | self assert: anEx messageText = self typeError ].
	self
		should: [ self returnOop5Of: array ]
		raise: NBFFICalloutError
		withExceptionDo: [ :anEx | self assert: anEx messageText = self typeError  ]! !

!NBFFICalloutIndirectArgumentTests methodsFor: 'nativeboost-primitives' stamp: 'IgorStasenko 11/24/2012 17:13'!
returnOop5Of: anArg 

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin >
	
	^ self nbCallout 
		options: #( + optUseStackPointer optNoAlignment +optCheckIndirectArgBounds - optDirectProxyFnAddress );
	
		function: #( oop (oop anArg@5) ) emit: [:gen |
			gen asm mov: gen asm ESP ptr to: gen asm EAX ]
	! !

!NBFFICalloutIndirectArgumentTests methodsFor: 'tests' stamp: 'CiprianTeodorov 5/18/2013 00:12'!
testIndirectArgumentArray0Indirect
	| array |
	array := {1.
	2.
	3.
	4.
	5}.
	self
		should: [ self returnOop0Of: array ]
		raise: Error
		withExceptionDo: [ :anEx | self assert: (anEx messageText beginsWith: self boundsError) ].! !

!NBFFICalloutIndirectArgumentTests methodsFor: 'tests' stamp: 'cipt 10/27/2012 12:43'!
testNotIndirectableObjects
	|ok |
	ok := {
	2. "small integer"
	100 factorial. "large positive integer"
	3.4. "float"
	'abcd'. "bytestring"
	'abcd' asByteArray. "bytearray"
	}.
	ok do:[:each | self deny: (self primIsPointers: each)].! !

!NBFFICalloutIndirectArgumentTests methodsFor: 'error messages' stamp: 'cipt 10/26/2012 21:04'!
typeError
	^'Type checking failed on indirect argument loading'! !

!NBFFICalloutIndirectArgumentTests methodsFor: 'tests' stamp: 'cipt 10/27/2012 12:16'!
testIndirectArgumentLargePositiveIntegerFailure
	| array |
	array := 100 factorial.
	self
		should: [ self returnOop1Of: array ]
		raise: NBFFICalloutError
		withExceptionDo: [ :anEx | self assert: anEx messageText = self typeError ].
	self
		should: [ self returnOop2Of: array ]
		raise: NBFFICalloutError
		withExceptionDo: [ :anEx | self assert: anEx messageText = self typeError ].
	self
		should: [ self returnOop5Of: array ]
		raise: NBFFICalloutError
		withExceptionDo: [ :anEx | self assert: anEx messageText = self typeError ]! !

!NBFFICalloutIndirectArgumentTests methodsFor: 'tests' stamp: 'CiprianTeodorov 5/18/2013 00:10'!
testIndirectArgumentArrayNegativeIndirect
	| array |
	array := {1.
	2.
	3.
	4.
	5}.
	self
		should: [ self returnOopMinus1Of: array ]
		raise: Error
		withExceptionDo: [ :anEx | self assert: (anEx messageText beginsWith: self boundsError) ].
	self
		should: [ self returnOopMinus3Of: array ]
		raise: Error
		withExceptionDo: [ :anEx | self assert: (anEx messageText beginsWith: self boundsError) ]! !

!NBFFICalloutIndirectArgumentTests methodsFor: 'nativeboost-primitives' stamp: 'IgorStasenko 11/24/2012 17:12'!
returnOop1Of: anArg 

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin >
	
	^ self nbCallout 
		options: #( + optUseStackPointer optNoAlignment +optCheckIndirectArgBounds - optDirectProxyFnAddress );
		
		function: #( oop (oop anArg@1) ) emit: [:gen |
		gen asm mov: gen asm ESP ptr to: gen asm EAX ]
	! !

!NBFFICalloutIndirectArgumentTests methodsFor: 'tests' stamp: 'cipt 10/27/2012 12:41'!
testIndirectableObjects
	|ok |
	ok := {
	Object new.
	{1. 2}.
	{1->2. 2->3} asDictionary.
	2@3.
	}.
	ok do:[:each | self assert: (self primIsPointers: each)].! !

!NBFFICalloutIndirectArgumentTests methodsFor: 'tests' stamp: 'cipt 10/26/2012 20:43'!
testIndirectArgumentArrayOk
	| array |
	array := {1.
	2.
	3.
	4.
	5}.
	self assert: (self returnOop1Of: array) == 1.
	self assert: (self returnOop2Of: array) == 2.
	self assert: (self returnOop5Of: array) == 5! !

!NBFFICalloutIndirectArgumentTests methodsFor: 'nativeboost-primitives' stamp: 'IgorStasenko 11/24/2012 17:11'!
primIsPointers: anObject
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	^ self nbCallout function: #(NBBool (oop anObject)) 
		emit: [ :gen :proxy :asm | 
			asm pop: asm EAX. 
			proxy isPointers:  asm EAX 
		]! !

!NBFFICalloutTests methodsFor: 'private' stamp: 'IgorStasenko 11/24/2012 17:15'!
arraySize: array
	
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout 
		function: #(ulong (NBByteArraySize array))
		emit: [:gen |
			"pop the array size"
			gen asm pop: gen asm EAX
		]
! !

!NBFFICalloutTests methodsFor: 'tests' stamp: 'IgorStasenko 11/24/2012 17:16'!
returnParamUsingStackPtr: aParam

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin >
	
	^ self nbCallout 
		options: #( + optUseStackPointer optNoAlignment - optDirectProxyFnAddress );
		function: #( oop (oop aParam) ) emit: [:gen |
			gen asm mov: gen asm ESP ptr to: gen asm EAX ]
	! !

!NBFFICalloutTests methodsFor: 'generator callbacks' stamp: 'IgorStasenko 3/27/2012 18:19'!
nbBindingOf: aName

	^ self class bindingOf: aName! !

!NBFFICalloutTests methodsFor: 'private' stamp: 'IgorStasenko 1/17/2014 12:46'!
passString: str
	"see testPrepareArgumentsKeepsStackAligned"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode >
	
 
	^ self nbCallout
		function: #( uint (String str) ) emit: [
		:gen :proxy :asm |
			asm 
				mov: asm ESP to: asm EAX
		] ! !

!NBFFICalloutTests methodsFor: 'generator callbacks' stamp: 'IgorStasenko 9/3/2012 00:12'!
asNBExternalType: gen

	self assert: (gen respondsTo: #asm).
	self assert: (gen respondsTo: #proxy).
	
	self assert: (gen requestor == self).

	
	^ NBUInt32 new! !

!NBFFICalloutTests methodsFor: 'tests' stamp: 'Igor.Stasenko 4/30/2010 12:03'!
checkType: type class: typeClass value: const
	self assert: type class == typeClass.
	self assert: type value = const! !

!NBFFICalloutTests methodsFor: 'tests' stamp: 'cipt 10/26/2012 19:32'!
checkType: type class: typeClass arity: ptrArity stackIndex: stackIndex elementIndex: anIndex

	self assert: type class == typeClass.
	self assert: type pointerArity = ptrArity.
	self assert: type loader class == NBSTIndirectArgument.
	self assert: type loader argumentLoader stackIndex = stackIndex. 
	self assert: type loader elementIndex = anIndex  
	! !

!NBFFICalloutTests methodsFor: 'tests' stamp: 'IgorStasenko 8/10/2011 18:27'!
testProxyReceiver

	
	self assert: 
		(self returnReceiver: 10 arg2: 20) == self! !

!NBFFICalloutTests methodsFor: 'running' stamp: 'IgorStasenko 1/17/2014 12:49'!
setUp

	self class selectors do: [ :sel | NBNativeCodeGen removeNativeCodeFrom: (self class>>sel) ]! !

!NBFFICalloutTests methodsFor: 'tests' stamp: 'IgorStasenko 9/3/2012 00:03'!
testBuildingFnSpec

	| generator type s |
	generator := NBFFICallout new.
	
	CLASSVAR := 100.
	TYPEVAR := 'long'.
	
	generator
		requestor: self;
		methodArgs: #( 'arg1' 'arg2' 'arg3' );
		cdecl;
		anonSpec: #( long* (int self ,  String arg1, void**arg2, TYPEVAR arg1, char arg3, 0, nil, true, false , CLASSVAR ) ).


	type := generator fnSpec returnType.
	self assert: (type class == NBInt32).	
	self assert: (type pointerArity = 1).
	
	self assert: (generator fnSpec arguments size = 10).
	s := generator fnSpec arguments readStream.
"int self"		self checkType: s next class:  NBInt32 arity: 0 stackIndex: 3 .
"String arg1"	self checkType: s next class: NBExternalString arity: 0 stackIndex: 2 .
"void**arg2"	self checkType: s next class: NBVoid arity: 2 stackIndex: 1.
"TYPEVAR arg1"	self checkType: s next class:  NBInt32 arity: 0 stackIndex: 2.
"char arg3"		self checkType: s next class: NBCharacterType arity: 0 stackIndex: 0.
"0"				self checkType: s next class: NBFFIConst value: 0.
"nil"				self checkType: s next class: NBFFIConst value: 0.
"true"			self checkType: s next class: NBFFIConst value: 1.
"false"			self checkType: s next class: NBFFIConst value: 0.
"CLASSVAR"	self checkType: s next class: NBFFIConst value: 100.

! !

!NBFFICalloutTests methodsFor: 'tests' stamp: 'Igor.Stasenko 4/30/2010 12:02'!
checkType: type class: typeClass arity: ptrArity stackIndex: stackIndex

	self assert: type class == typeClass.
	self assert: type pointerArity = ptrArity.
	self assert: type loader class == NBSTMethodArgument.
	self assert: type loader stackIndex = stackIndex ! !

!NBFFICalloutTests methodsFor: 'tests' stamp: 'IgorStasenko 9/3/2012 00:12'!
testSupportedProtocols

	| gen spec arg | 
	gen := NBFFICallout new requestor: self.
	CLASSVAR := self. "so we will receive #asNBExternalType: "
	gen anonSpec: #(CLASSVAR (CLASSVAR testIvar)).
	
	spec := gen fnSpec.
	
	self assert: spec returnType class == NBUInt32.
	
	arg := spec arguments first.

	self assert: arg class == NBUInt32.
	self assert: arg loader ='testIvar loader'.
		! !

!NBFFICalloutTests methodsFor: 'private' stamp: 'IgorStasenko 11/24/2012 17:15'!
arraySize2: array with: param2
	
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout
		function: #(ulong (NBByteArraySize array, long param2))
		emit: [:gen |
			"pop the array size"
			gen asm pop: gen asm EAX
		]
! !

!NBFFICalloutTests methodsFor: 'generator callbacks' stamp: 'IgorStasenko 2/24/2012 17:53'!
nbFnArgument: argName generator: gen

	self assert: argName = 'testIvar'.
	^ 'testIvar loader'! !

!NBFFICalloutTests methodsFor: 'tests' stamp: 'IgorStasenko 11/24/2012 17:15'!
nativeFailWithCode: aCode

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout 
		function: #(void (uint aCode) ) emit: [:gen :proxy :asm |
			asm pop: asm EAX.
			gen failWithCode: asm EAX.
		]
! !

!NBFFICalloutTests methodsFor: 'tests' stamp: 'Igor.Stasenko 5/3/2010 23:31'!
testArraySize

	| arr |
	
	arr := ByteArray new: 100.

	self assert: (self arraySize: arr) = 100.

	self assert: (self arraySize2: arr with: 20) = 100.! !

!NBFFICalloutTests methodsFor: 'tests' stamp: 'cipt 10/24/2012 19:32'!
testBuildingFnSpecWithQueries

	| generator type s |
	generator := NBFFICallout new.
	
	CLASSVAR := 100.
	TYPEVAR := 'long'.
	
	generator
		requestor: self;
		methodArgs: #( 'arg1' 'arg2' 'arg3' );
		cdecl;
		anonSpec: #( long* (int self , int arg3@2,  String arg1, void**arg2, TYPEVAR arg1, long **arg1@1, char arg3, 0, nil, true, false , CLASSVAR ) ).


	type := generator fnSpec returnType.
	self assert: (type class == NBInt32).	
	self assert: (type pointerArity = 1).
	
	self assert: (generator fnSpec arguments size = 12).
	s := generator fnSpec arguments readStream.
"int self"		self checkType: s next class:  NBInt32 arity: 0 stackIndex: 3 .
"int arg3@2"    self checkType: s next class: NBInt32 arity: 0 stackIndex: 0 elementIndex: 2.
"String arg1"	self checkType: s next class: NBExternalString arity: 0 stackIndex: 2 .
"void**arg2"	self checkType: s next class: NBVoid arity: 2 stackIndex: 1.
"TYPEVAR arg1"	self checkType: s next class:  NBInt32 arity: 0 stackIndex: 2.
"long ** arg1@1"    self checkType: s next class: NBInt32 arity: 2 stackIndex: 2 elementIndex: 1.
"char arg3"		self checkType: s next class: NBCharacterType arity: 0 stackIndex: 0.
"0"				self checkType: s next class: NBFFIConst value: 0.
"nil"				self checkType: s next class: NBFFIConst value: 0.
"true"			self checkType: s next class: NBFFIConst value: 1.
"false"			self checkType: s next class: NBFFIConst value: 0.
"CLASSVAR"	self checkType: s next class: NBFFIConst value: 100.

! !

!NBFFICalloutTests methodsFor: 'tests' stamp: 'Igor.Stasenko 5/1/2010 12:02'!
testUseStackPointer


	self assert: (self returnParamUsingStackPtr: 100) = 100.
! !

!NBFFICalloutTests methodsFor: 'private' stamp: 'IgorStasenko 11/24/2012 17:16'!
returnReceiver: x arg2: y
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	

	^ self nbCallout
		function: #( oop (oop self , oop x, oop y)) emit: [
		:gen :proxy :asm |
			proxy receiver
		] ! !

!NBFFICalloutTests methodsFor: 'tests' stamp: 'IgorStasenko 1/17/2014 20:47'!
testPrepareArgumentsKeepsStackAligned


	| sp |
		 
	sp := self passString: '12345'.
	
	self assert: (sp \\ NativeBoost forCurrentPlatform stackAlignment) = 0.

! !

!NBFFICalloutTests methodsFor: 'tests' stamp: 'IgorStasenko 8/6/2011 18:36'!
testFailCode

	self assert: 
	(	
		[ self nativeFailWithCode: 1234. false ] on: NBNativeCodeError do: [:ex |
			ex return: ex errorCode = 1234 ]
	)
	! !

!NBFFIConst commentStamp: 'Igor.Stasenko 5/3/2010 18:10'!
My instances can be used to push an arbitrary integer value to the stack.
Could be useful for purposes, when some of the external function values is known beforehead,
like size of structure etc.

For emitting a constant as argument  for a function just put it into an argument list, like: 

apiCall: #( long 'IsBadWritePtr' (10) ) module: 'Kernel32.dll'

here, 10 is a constant, which will be pushed on stack!
!NBFFIConst methodsFor: 'emitting code' stamp: 'Igor.Stasenko 4/15/2010 22:33'!
emitPush: gen

	gen asm push: ((gen asm imm: value) size: 4)! !

!NBFFIConst methodsFor: 'accessing' stamp: 'IgorStasenko 8/2/2011 14:39'!
stackSize
	^ 4! !

!NBFFIConst methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/15/2010 22:17'!
value
	^ value! !

!NBFFIConst methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/15/2010 22:17'!
value: aValue
	value := aValue! !

!NBFFIConst methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/18/2010 23:07'!
loader
	^ self! !

!NBFFIConst methodsFor: 'testing' stamp: 'IgorStasenko 5/11/2011 17:27'!
coercionMayFail
	"Constants are pushed as is, and there is no any coercion required, so it cannot fail anything"
	
	^ false! !

!NBFFIConst methodsFor: 'emitting code' stamp: 'Igor.Stasenko 4/28/2010 13:54'!
prepareArgumentUsing: gen

	"do nothing"! !

!NBFFIConst methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/30/2010 11:46'!
pointerArity: ptrArity

	ptrArity > 0 ifTrue: [ self error: 'passing pointer to constant' ]! !

!NBFFIConst methodsFor: 'testing' stamp: 'Igor.Stasenko 5/18/2010 23:08'!
usesSTStack
	"Test, whether a receiver using an ST method's argument
	for converting it into a corresponding C value for pushing on stack
	"
	^ false! !

!NBFFIConst methodsFor: 'testing' stamp: 'Igor.Stasenko 5/3/2010 00:53'!
isCallback
	^ false! !

!NBFFIConst class methodsFor: 'instance creation' stamp: 'Igor.Stasenko 4/15/2010 22:18'!
value: aValue
	^ self new value: aValue! !

!NBFFIExternalStructTests methodsFor: 'util' stamp: 'IgorStasenko 6/27/2013 15:54'!
returnStructWithCallback: aCallback
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout 
		function: #(NBTestStructureWithCallback (NBQSortCallback aCallback) ) 
		emit: [:gen :proxy :asm |
		
			asm
				"mov: asm ESP ptr to: asm EAX;"
				pop: asm EAX;
				pop: asm EDX;
		"fill struct with 1, 2, 3 values"
				mov: 1 to: asm EAX ptr32;
				mov: asm EDX to: asm EAX ptr32+4;
				mov: 3 to: asm EAX ptr8+8;
				push: asm EAX
		 ]
	! !

!NBFFIExternalStructTests methodsFor: 'tests' stamp: 'CiprianTeodorov 5/19/2013 03:42'!
testReturnStruct9Bytes

	| s |
	
	NBNativeCodeGen removeNativeCodeFrom: self class >> #returnStruct9Bytes.

	s := self returnStruct9Bytes.
	
	self assert: s x = 1.
	self assert: s y = 2.
	self assert: s field asciiValue = 3.! !

!NBFFIExternalStructTests methodsFor: 'tests' stamp: 'IgorStasenko 7/12/2013 15:01'!
testExternallyAllocatedStructure

	| struct struct2 |
	
	struct := NBTestStructure externalNew.
	self assert: struct isExternal.
	
	[	struct byte: 10.
		struct short: -20.
		struct long: 100.
		struct float: 1.0.
		struct double: 2.0.
		struct int64: 123456789101112.
	
	
		struct2 := NBTestStructure fromPointer: struct address.
	
		self assert: (struct2 byte = 10).
		self assert: (struct2 short = -20).	
		self assert: (struct2 long = 100).	
		self assert: (struct2 float = 1.0).	
		self assert: (struct2 double = 2.0).	
		self assert: (struct2 int64 = 123456789101112).	
	] ensure: [  struct free ].! !

!NBFFIExternalStructTests methodsFor: 'tests' stamp: 'CiprianTeodorov 5/19/2013 03:42'!
testReturnStruct1Byte

	| s |
	
	NBNativeCodeGen removeNativeCodeFrom: self class >> #returnStruct1Byte.
	
	s := self returnStruct1Byte.
	
	self assert: s field = 42.! !

!NBFFIExternalStructTests methodsFor: 'util' stamp: 'CamilloBruni 9/5/2013 15:09'!
returnStruct1Byte
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout
		function: #(NBTestStructure1byte () ) 
		emit: [:gen :proxy :asm |
			NativeBoost platformId ~= NativeBoostConstants linux32PlatformId ifTrue:[
			asm mov: 42 to: asm EAX]
			ifFalse:[
				asm mov: asm ESP ptr to: asm EAX;
				mov: 42 to: asm EAX ptr32]
		]
	! !

!NBFFIExternalStructTests methodsFor: 'tests' stamp: 'CiprianTeodorov 5/19/2013 03:42'!
testReturnStructWithCallback

	| s callback|
	
	NBNativeCodeGen removeNativeCodeFrom: self class >> #returnStructWithCallback:.
	callback := NBQSortCallback on: [:a :b | a < b].
	s := self returnStructWithCallback: callback.
	
	self assert: s x = 1.
	self assert: s callback trunk  = callback trunk.
	self assert: s y = 3.! !

!NBFFIExternalStructTests methodsFor: 'tests' stamp: 'CiprianTeodorov 7/28/2014 22:50'!
testStructWithPointerAccess

	| struct |
	
	struct := NBTestStructureWithPointer1 new.
	self assert: struct isExternal not.
	self assert: struct field isNil.! !

!NBFFIExternalStructTests methodsFor: 'util' stamp: 'IgorStasenko 6/27/2013 15:52'!
returnStruct9Bytes
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout 
		function: #(NBTestStructure9bytes () ) 
		emit: [:gen :proxy :asm |
		"the implicit pointer to return value should be pushed on stack , hence we just using ESP ptr"
			asm 
				mov: asm ESP ptr to: asm EAX;
		"fill struct with 1, 2, 3 values"
				mov: 1 to: asm EAX ptr32;
				mov: 2 to: asm EAX ptr32+4;
				mov: 3 to: asm EAX ptr8+8
		]
	! !

!NBFFIExternalStructTests methodsFor: 'tests' stamp: 'IgorStasenko 7/12/2013 15:00'!
testStructAccess

	| struct |
	
	struct := NBTestStructure new.
	self assert: struct isExternal not.
	
	struct byte: 10.
	struct short: -20.
	struct long: 100.
	struct float: 1.0.
	struct double: 2.0.
	struct int64: 123456789101112.
	
	self assert: (struct byte = 10).
	self assert: (struct short = -20).	
	self assert: (struct long = 100).	
	self assert: (struct float = 1.0).	
	self assert: (struct double = 2.0).	
	self assert: (struct int64 = 123456789101112).	
	! !

!NBFFIExternalStructTests methodsFor: 'tests' stamp: 'CiprianTeodorov 5/19/2013 03:41'!
testNestedStructure

	| s1 s2 |
	
	s1 := NBTestNestedStructure new.
	s2 := NBTestStructure1byte new.
	s2 field: 42.
	
	self assert: s1 oneByte field = 0.
	
	s1 oneByte: s2.
	
	self assert: s1 oneByte field = 42.
	! !

!NBFFIExternalStructTests class methodsFor: 'accessing' stamp: 'CiprianTeodorov 5/19/2013 03:41'!
resources
	^{NBTestResources}! !

!NBFFIExternalUnionTests methodsFor: 'primitives' stamp: 'CiprianTeodorov 1/19/2013 18:20'!
returnUnionWithStructChar: aChar
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout 
		function: #(NBTestUnionWithStructure (char  aChar) ) 
		emit: [:gen :proxy :asm |
		
			asm
				pop: asm EAX;
				pop: asm EDX;
		"fill union with int"
				mov: asm DL to: asm EAX ptr8;
				push: asm EAX
		 ]
	! !

!NBFFIExternalUnionTests methodsFor: 'primitives' stamp: 'CiprianTeodorov 1/19/2013 18:15'!
returnUnionWithStructInt: anInt
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout 
		function: #(NBTestUnionWithStructure (int  anInt) ) 
		emit: [:gen :proxy :asm |
		
			asm
				pop: asm EAX;
				pop: asm EDX;
		"fill union with int"
				mov: asm EDX to: asm EAX ptr;
				push: asm EAX
		 ]
	! !

!NBFFIExternalUnionTests methodsFor: 'tests' stamp: 'CiprianTeodorov 5/19/2013 03:43'!
testReturnUnionWithStructChar
	| s |
	NBNativeCodeGen removeNativeCodeFrom: self class >> #returnUnionWithStructChar:.
	s := self returnUnionWithStructChar: $,.
	self assert: s x = $,! !

!NBFFIExternalUnionTests methodsFor: 'primitives' stamp: 'CiprianTeodorov 1/29/2013 19:39'!
returnUnionUnionInt: aN
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout 
		function: #(NBTestUnionWithUnion (int  aN) ) 
		emit: [:gen :proxy :asm |
			self return4Bytes: asm.
		]
	! !

!NBFFIExternalUnionTests methodsFor: 'primitives' stamp: 'CiprianTeodorov 1/29/2013 19:39'!
return4Bytes: asm
	NativeBoost platformId ~= NativeBoostConstants linux32PlatformId 
		ifTrue:[
			asm pop: asm EAX]
		ifFalse:[
			asm 
				pop: asm EAX;
				pop: asm EDX;
				mov: asm EDX to: asm EAX ptr; 
				push: asm EAX]! !

!NBFFIExternalUnionTests methodsFor: 'primitives' stamp: 'CiprianTeodorov 1/29/2013 19:39'!
returnUnionWithCallback: aCallback
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout 
		function: #(NBTestUnionWithCallback (NBQSortCallback aCallback) ) 
		emit: [:gen :proxy :asm |
			self return4Bytes: asm.
		 ]
	! !

!NBFFIExternalUnionTests methodsFor: 'primitives' stamp: 'CiprianTeodorov 1/19/2013 18:51'!
returnUnionWithStructStruct: aStructure
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout 
		function: #(NBTestUnionWithStructure (NBTestStructure9bytes  aStructure) ) 
		emit: [:gen :proxy :asm |
		
			asm
				pop: asm EAX;
				pop: asm EDX;
		"fill union with structure"
				mov: asm EDX to: asm EAX ptr;
				pop: asm EDX;
				mov: asm EDX to: asm EAX ptr + 4;
				pop: asm EDX;
				mov: asm EDX to: asm EAX ptr + 8;
				push: asm EAX.
		 ]
	! !

!NBFFIExternalUnionTests methodsFor: 'tests' stamp: 'CiprianTeodorov 5/19/2013 03:42'!
testReturnUnion2Pointers

	| s ptr|
	
	NBNativeCodeGen removeNativeCodeFrom: self class >> #returnUnionPointer:.
	ptr := NBExternalAddress fromString: 'abcd'.
	s := self returnUnionPointer: ptr.
	
	self assert: s addr1  =  ptr .
	self assert: s addr2    =  ptr .
	self assert: s addr1 readString = 'abcd'.! !

!NBFFIExternalUnionTests methodsFor: 'tests' stamp: 'CiprianTeodorov 5/19/2013 03:43'!
testReturnUnionWithStructInt
	|s|
	NBNativeCodeGen removeNativeCodeFrom: self class >> #returnUnionWithStructInt:.
	s := self returnUnionWithStructInt: 300.
	self assert: s z = 300! !

!NBFFIExternalUnionTests methodsFor: 'primitives' stamp: 'CiprianTeodorov 1/29/2013 19:39'!
returnUnionUnionChar: aChar
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout 
		function: #(NBTestUnionWithUnion (char  aChar) ) 
		emit: [:gen :proxy :asm |
			self return4Bytes: asm.
		]
	! !

!NBFFIExternalUnionTests methodsFor: 'tests' stamp: 'CiprianTeodorov 5/19/2013 03:42'!
testReturnUnion1Byte
	| s |
	NBNativeCodeGen removeNativeCodeFrom: self class >> #returnUnion1Byte.
	s := self returnUnion1Byte.
	self assert: s field1 = 42.
	self assert: s field2 = 42! !

!NBFFIExternalUnionTests methodsFor: 'tests' stamp: 'CiprianTeodorov 5/19/2013 03:44'!
testReturnUnionWithStructStruct

	| s struct|
	
	NBNativeCodeGen removeNativeCodeFrom: self class >> #returnUnionWithStructStruct:.
	struct := NBTestStructure9bytes new.
	struct x: 2345.
	struct y: 6789.
	struct field: $+.
	s := self returnUnionWithStructStruct: struct.
	
	self assert: s struct x   =  struct x.
	self assert: s struct y   =  struct y.
	self assert: s struct field   =  struct field.! !

!NBFFIExternalUnionTests methodsFor: 'tests' stamp: 'CiprianTeodorov 5/19/2013 03:44'!
testUnionWithUnion
	|u1 u2|
	u1 := NBTestUnionWithUnion new.
	u2 := NBTestUnionIntSize new.
	
	u2 y: 300.
	
	self assert: u1 union x = 0.
	self assert: u1 union y = 0.
	self assert: u1 union field = Character null.
	
	u1 union: u2.
	self assert: u1 union x = 300.
	self assert: u1 union y = 300.	
	self assert: u1 union field = $,.! !

!NBFFIExternalUnionTests methodsFor: 'tests' stamp: 'CiprianTeodorov 5/19/2013 03:43'!
testReturnUnionUnionDouble
	| s |
	NBNativeCodeGen removeNativeCodeFrom: self class >> #returnUnionUnionDouble:.
	s := self returnUnionUnionDouble: 2.3.

	self assert: (s z closeTo: 2.3)! !

!NBFFIExternalUnionTests methodsFor: 'primitives' stamp: 'IgorStasenko 12/3/2013 02:59'!
returnUnion1Byte
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout
		function: #(NBTestUnion1Byte  () ) 
		emit: [:gen :proxy :asm |
			NativeBoost platformId ~= NativeBoostConstants linux32PlatformId ifTrue:[
			asm mov: 42 to: asm EAX]
			ifFalse:[
				asm mov: asm ESP ptr to: asm EAX;
				mov: 42 to: asm EAX ptr32]
		]
	! !

!NBFFIExternalUnionTests methodsFor: 'primitives' stamp: 'CiprianTeodorov 1/29/2013 19:34'!
returnUnionUnionDouble: aN
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout 
		function: #(NBTestUnionWithUnion (double aN) ) 
		emit: [:gen :proxy :asm |
			NativeBoost platformId ~= NativeBoostConstants linux32PlatformId 
				ifTrue:[
					asm 
						pop: asm EAX;
						pop: asm EDX.]
				ifFalse:[
					asm
						pop: asm EAX;
						pop: asm ECX;
						pop: asm EDX;
						mov: asm ECX to: asm EAX ptr;
						mov: asm EDX to: asm EAX ptr + 4;
						push: asm EAX.					
					]
		]
	! !

!NBFFIExternalUnionTests methodsFor: 'tests' stamp: 'CiprianTeodorov 5/19/2013 03:43'!
testReturnUnionWithCallback

	| s callback|

	NBNativeCodeGen removeNativeCodeFrom: self class >> #returnUnionWithCallback:.
	callback := NBQSortCallback on: [:a :b | a < b].
	s := self returnUnionWithCallback: callback.
	
	self assert: s callback trunk  = callback trunk.! !

!NBFFIExternalUnionTests methodsFor: 'primitives' stamp: 'CiprianTeodorov 1/29/2013 19:39'!
returnUnionPointer: aPointer
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout 
		function: #(NBTestUnion2Pointers (void * aPointer) ) 
		emit: [:gen :proxy :asm |
			self return4Bytes: asm.
		]
	! !

!NBFFIExternalUnionTests methodsFor: 'tests' stamp: 'CiprianTeodorov 5/19/2013 03:43'!
testReturnUnionUnionInt
	| s |
	NBNativeCodeGen removeNativeCodeFrom: self class >> #returnUnionUnionInt:.
	s := self returnUnionUnionInt: 2344.
	self assert: s union x = 2344! !

!NBFFIExternalUnionTests methodsFor: 'tests' stamp: 'CiprianTeodorov 5/19/2013 03:43'!
testReturnUnionUnionChar
	| s |
	NBNativeCodeGen removeNativeCodeFrom: self class >> #returnUnionUnionChar:.
	s := self returnUnionUnionChar: $,.
	self assert: s x = $,! !

!NBFFIExternalUnionTests class methodsFor: 'accessing' stamp: 'CiprianTeodorov 5/19/2013 03:44'!
resources
	^{NBTestResources}! !

!NBFFIExternalValueTests methodsFor: 'tests' stamp: 'IgorStasenko 6/27/2013 17:33'!
testOutIntArg
	|x value|
	NBTestExternalValue initialize.
	value := 12345678.
	x := NBTestExternalValue new.

	self outputIntArg: x value: value.
	
	self assert: x value = value.! !

!NBFFIExternalValueTests methodsFor: 'primitives' stamp: 'IgorStasenko 6/27/2013 17:14'!
outputValueArg: x value: value 
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout 
		function: #(void (NBTestExternalValue * x, int value) ) 
		emit: [:gen :proxy :asm |
			asm pop: asm EAX.
			asm pop: asm ECX.
			asm mov: asm ECX to: asm EAX ptr32.
		]
	! !

!NBFFIExternalValueTests methodsFor: 'tests' stamp: 'CiprianTeodorov 4/9/2013 21:11'!
testValue
	|x value|
	NBTestExternalValue initialize.
	
	value := 12345678.
	
	x := NBTestExternalValue new.
	x value: value.
	
	self assert: x value = value.! !

!NBFFIExternalValueTests methodsFor: 'primitives' stamp: 'IgorStasenko 6/27/2013 17:33'!
outputVoidArg: x value: value 
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout 
		function: #(void (void * x, int value) ) 
		emit: [:gen :proxy :asm |
			asm pop: asm EAX.
			asm pop: asm ECX.
			asm mov: asm ECX to: asm EAX ptr32.
		]
	! !

!NBFFIExternalValueTests methodsFor: 'primitives' stamp: 'CiprianTeodorov 4/9/2013 21:22'!
outputIntArg: x value: value 
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout 
		function: #(void (int* x, int value) ) 
		emit: [:gen :proxy :asm |
			asm pop: asm EAX.
			asm pop: asm ECX.
			asm mov: asm ECX to: asm EAX ptr32.
		]
	! !

!NBFFIExternalValueTests methodsFor: 'tests' stamp: 'IgorStasenko 6/27/2013 17:32'!
testOutVoidArg
	|x value|
	NBTestExternalValue initialize.
	value := 12345678.
	x := NBTestExternalValue new.

	self outputVoidArg: x value: value.
	
	self assert: x value = value.! !

!NBFFIExternalValueTests methodsFor: 'tests' stamp: 'IgorStasenko 6/27/2013 17:33'!
testOutValueArg
	|x value|
	NBTestExternalValue initialize.
	value := 12345678.
	x := NBTestExternalValue new.

	self outputValueArg: x value: value.
	
	self assert: x value = value.! !

!NBFFIExternalValueTests methodsFor: 'tests' stamp: 'IgorStasenko 6/27/2013 17:38'!
testOutIntoByteArray
	|x value|
	NBTestExternalValue initialize.
	value := 12345678.
	x := ByteArray new: 4.

	self outputVoidArg: x value: value.
	
	self assert: (x nbUInt32AtOffset: 0)  = value.! !

!NBFinalizationRegistry commentStamp: '<historical>'!
i am a simplified implementation of WeakRegistry,
and have same public protocol.

The implementation is simpler and faster, because i rely on new finalization support in VM.
!
!NBFinalizationRegistry methodsFor: 'for tests only' stamp: 'IgorStasenko 5/31/2012 14:44'!
freeItemsDo: aBlock

	| free index |
	sema critical: [
		index := nextFreeIndex.
		
		[ index notNil ] whileTrue: [  |next item|
			item := items at: index.
			next := item nextFreeIndex.
			aBlock value: item.
			index := next
		]]! !

!NBFinalizationRegistry methodsFor: 'accessing' stamp: 'IgorStasenko 5/31/2012 02:56'!
initialSize
	^ 100! !

!NBFinalizationRegistry methodsFor: 'private' stamp: 'IgorStasenko 5/31/2012 03:55'!
grow
	"double the items array size"
	| oldSz |
	oldSz := items size.
	items := items grownBy: oldSz.
	
	self formatItems: oldSz+1
	! !

!NBFinalizationRegistry methodsFor: 'private' stamp: 'IgorStasenko 5/31/2012 03:58'!
getFreeItem
	| item nextFree |
	nextFreeIndex ifNil: [ self grow ].
	item := items at: nextFreeIndex.
	nextFreeIndex := item nextFreeIndex.
	^ item! !

!NBFinalizationRegistry methodsFor: 'initialization' stamp: 'IgorStasenko 5/31/2012 14:51'!
initialize
	super initialize.
	sema := Semaphore forMutualExclusion.
	self reset.
	WeakArray addWeakDependent: self! !

!NBFinalizationRegistry methodsFor: 'accessing' stamp: 'IgorStasenko 5/31/2012 02:59'!
add: anObject
	^ self add: anObject executor: anObject executor! !

!NBFinalizationRegistry methodsFor: 'finalizing' stamp: 'IgorStasenko 8/24/2012 17:17'!
finalizeValues 
	"Finalize any values, which happen to be stocked in finalization list, due to some weak references become garbage"
	
	sema critical: [ | item next |
		item := list swapWithNil.
		[ item notNil ]	whileTrue: [
			next := item next.
			[ item finalizeValues ] on: Exception fork: [:ex | ex pass ].
			
			item markAsFree: nextFreeIndex.
			nextFreeIndex := item index.
			item := next.
		]
	].
! !

!NBFinalizationRegistry methodsFor: 'private' stamp: 'IgorStasenko 5/31/2012 14:24'!
reset
	sema critical: [
		nextFreeIndex := nil.
		list := WeakFinalizationList new.
		items := Array new: self initialSize.
		self formatItems: 1.
	]
	
	! !

!NBFinalizationRegistry methodsFor: 'private' stamp: 'IgorStasenko 5/31/2012 03:57'!
formatItems: startingIndex

	startingIndex to: items size do: [:i | | item |
		item := 
			NBWeakFinalizerItem new
				list: list index: i freeIndex: nextFreeIndex.
		items at: i put: item.
		nextFreeIndex := i.
	].! !

!NBFinalizationRegistry methodsFor: 'accessing' stamp: 'IgorStasenko 5/31/2012 14:55'!
add: anObject executor: executor
	| item |
	
	"fool protection"
	anObject ifNil: [ self error: 'nil cannot be finalized!!!!'].
	
	sema critical: [
		item := self getFreeItem.
		item object: anObject executor: executor
	].
	^ item! !

!NBFinalizationRegistry methodsFor: 'for tests only' stamp: 'IgorStasenko 5/31/2012 14:41'!
items
	^ items! !

!NBFloat128 methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/28/2010 15:53'!
valueSize
	^ 16! !

!NBFloat16 commentStamp: '<historical>'!
not supported on x86 archs..

!
!NBFloat16 methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/28/2010 15:53'!
valueSize
	^ 2! !

!NBFloat32 methodsFor: 'emitting code' stamp: 'Igor.Stasenko 5/20/2010 04:06'!
pushAsValue: gen

	gen proxy pushFloatOopAsFloat32: (loader emitLoad: gen).

! !

!NBFloat32 methodsFor: 'emitting code' stamp: 'Igor.Stasenko 4/28/2010 18:32'!
loadMem: memoryOperand generator: gen.
	"floats get loaded into FP stack"
	
	gen asm fld: memoryOperand.
! !

!NBFloat32 methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/28/2010 15:52'!
valueSize
	^ 4! !

!NBFloat32 methodsFor: 'emitting code' stamp: 'Igor.Stasenko 4/28/2010 14:43'!
coerceReturnValue: gen

	"return value in ST(0)"
	
	NBFloat64 new pushValue: gen.
	gen proxy gatedCallFn: #floatObjectOf: .

	! !

!NBFloat64 methodsFor: 'emitting code' stamp: 'Igor.Stasenko 4/28/2010 14:43'!
coerceReturnValue: gen

	"return value in ST(0)"
	
	self pushValue: gen.
	gen proxy gatedCallFn: #floatObjectOf: .
! !

!NBFloat64 methodsFor: 'emitting code' stamp: 'JavierPimas 11/17/2011 11:04'!
pushAsValue: gen
	| proxy asm oop EAX |

	proxy := gen proxy.
	asm := gen asm.
	EAX := asm EAX.
	oop := loader emitLoad: gen.
	
	asm mov: oop to: EAX.
	
	proxy oop: EAX 
		ifSmallInt: [
			asm sar: EAX with: 1;
			push: EAX;
			push: EAX; " extra push to reserve totally 8 bytes on stack"
			fild: asm ESP ptr32;
			fstp: asm ESP ptr64 ] 
		ifNotSmallInt: [
			proxy pushFloatOopAsFloat64: EAX.
		].! !

!NBFloat64 methodsFor: 'emitting code' stamp: 'Igor.Stasenko 5/2/2010 20:41'!
pushValue: gen

	"argument in ST(0) "

	| asm |
	asm := gen asm.
	
	asm sub: (asm ESP) with: 8.
	asm fstp: asm ESP ptr64
	
	! !

!NBFloat64 methodsFor: 'emitting code' stamp: 'Igor.Stasenko 4/28/2010 18:32'!
loadMem: memoryOperand generator: gen.
	"floats get loaded into FP stack"
	
	gen asm fld: memoryOperand.
! !

!NBFloat64 methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/28/2010 15:52'!
valueSize
	^ 8! !

!NBFloat64 methodsFor: 'accessing' stamp: 'IgorStasenko 5/26/2012 14:01'!
stackSize
	"Answer a number of bytes, which takes a value of given type when pushed on stack"
	pointerArity > 0 ifTrue: [ ^ self pointerSize ].
	^ 8! !

!NBFloatPtr commentStamp: 'IgorStasenko 12/21/2011 13:43'!
Use to pass a pointer to instance of Float, which is C (double *) equivalent.
Can be used for functions which may modify the floating-point values at specified memory pointer.

NOTE: always copy float objects before passing them to such callouts.!
!NBFloatPtr methodsFor: 'emitting code' stamp: 'IgorStasenko 12/21/2011 13:40'!
pushAsPointer: gen

	self error: 'only value-type arguments allowed'! !

!NBFloatPtr methodsFor: 'accessing' stamp: 'IgorStasenko 12/21/2011 13:40'!
valueSize
	^ self pointerSize! !

!NBFloatPtr methodsFor: 'emitting code' stamp: 'IgorStasenko 12/21/2011 14:26'!
pushAsValue: gen

	"argument in ST(0) "

	| proxy oop asm |
	
	proxy := gen proxy.
	asm := gen asm.
	
	oop := loader emitLoad: gen.
	proxy verifyCompactClassOf: oop is: Float.
	asm 
		add: asm EAX with: proxy baseHeaderSize;
		push: asm EAX.
	! !

!NBFloatType commentStamp: 'Igor.Stasenko 4/28/2010 11:54'!
Abstract class for floating-point native types!
!NBFnArgument commentStamp: 'Igor.Stasenko 4/30/2010 12:12'!
I am abstract class, describing a function argument.
My subclasses should know what code to emit in order to load an argument.
!
!NBFnArgument methodsFor: 'emitting code' stamp: 'Igor.Stasenko 4/30/2010 10:46'!
emitLoad: gen
	"emit instructions to load a function argument into default register
	(EAX for integral types, FP(0) for floating point)"
	
	self subclassResponsibility ! !

!NBFnArgument methodsFor: 'emitting code' stamp: 'Igor.Stasenko 4/30/2010 12:21'!
emitLoad: gen to: operand
	"emit instructions to load a function argument into given operand"
	
	self subclassResponsibility ! !

!NBFnArgument methodsFor: 'testing' stamp: 'IgorStasenko 8/5/2011 18:02'!
isReceiver 
	"answer true if loader loads a primitive method's receiver "
	^ false! !

!NBFnArgument methodsFor: 'testing' stamp: 'Igor.Stasenko 5/18/2010 02:21'!
usesSTStack
	^ false! !

!NBFnSpec commentStamp: 'IgorStasenko 2/15/2012 19:46'!
I am used to hold a parsed function signature, describing a C function.
Since all C functions having return type, arguments and name (unless it anonymous one), 
same structure can be used to hold an information about it in my instances.
However, what objects used to represent types and arguments is up to code generator.

Instance Variables:
	returnType <Object>
	functionName	<String>
	arguments	<SequenceableCollection>!
!NBFnSpec methodsFor: 'adding' stamp: 'IgorStasenko 8/21/2011 02:49'!
addArgument: anArgument
	^ arguments add: anArgument! !

!NBFnSpec methodsFor: 'converting' stamp: 'IgorStasenko 8/19/2011 18:39'!
printType: typeAndArity on: str

	str nextPutAll: typeAndArity first.
	typeAndArity second timesRepeat: [ str nextPut: $* ].
! !

!NBFnSpec methodsFor: 'converting' stamp: 'cipt 10/21/2012 19:33'!
asArraySpecArrayedArgs

	^ String streamContents: [:str | |idx|

		str 
			nextPutAll: '#( '.
		
		self printType: returnType on: str.
		str space.
		
		functionName ifNotNil: [
			str nextPutAll: functionName; space ].
		
		str nextPutAll: '( '.
		idx := 1.
		arguments do: [:arg | 
			
			str nextPutAll: arg second. "type name"
			arg third timesRepeat: [
				str nextPut: $* ].
			str space;
				nextPutAll: 'argsArray@', idx printString;
				space.
			idx := idx + 1.
		] separatedBy: [ str nextPutAll: ', ' ].
	
		str nextPutAll: '))'.
		
	]! !

!NBFnSpec methodsFor: 'accessing' stamp: 'IgorStasenko 8/19/2011 17:44'!
arguments: anObject

	arguments := anObject! !

!NBFnSpec methodsFor: 'converting' stamp: 'IgorStasenko 8/19/2011 19:01'!
asMethodSelectorAndArguments

	^ String streamContents: [:str | 

		str 
			nextPutAll: functionName.
			
		arguments isEmpty ifFalse: [
			arguments size = 1 ifFalse: [
				str
					nextPut: $_;
					nextPutAll: arguments first first.
				].
			str
				nextPut: $: ; space;
				nextPutAll: arguments first first.
				
			arguments allButFirst do: [:arg | 
				str 
					space;
					nextPutAll: arg first; 
					nextPut: $: ;
					space;
					nextPutAll: arg first				
				]
			]
	]! !

!NBFnSpec methodsFor: 'accessing' stamp: 'IgorStasenko 8/19/2011 17:44'!
functionName

	^ functionName! !

!NBFnSpec methodsFor: 'initialization' stamp: 'IgorStasenko 8/19/2011 17:53'!
initialize
	arguments := OrderedCollection new! !

!NBFnSpec methodsFor: 'converting' stamp: 'cipt 10/21/2012 19:38'!
asMethodSelectorAndArrayOfArguments
	^ String
		streamContents: [ :str | 
			str
				nextPutAll: functionName;
				nextPutAll: ': argsArray';
				cr;
				nextPut: $".
			arguments do: [ :arg | str nextPutAll: arg first ] separatedBy: [ str nextPutAll: ', ' ].
			str nextPut: $" ]! !

!NBFnSpec methodsFor: 'accessing' stamp: 'IgorStasenko 8/19/2011 17:44'!
returnType: anObject

	returnType := anObject! !

!NBFnSpec methodsFor: 'converting' stamp: 'IgorStasenko 8/21/2011 11:35'!
asArraySpec

	^ String streamContents: [:str | 

		str 
			nextPutAll: '#( '.
		
		self printType: returnType on: str.
		str space.
		
		functionName ifNotNil: [
			str nextPutAll: functionName; space ].
		
		str nextPutAll: '( '.
		
		arguments do: [:arg | 
			
			str nextPutAll: arg second. "type name"
			arg third timesRepeat: [
				str nextPut: $* ].
			str space;
				nextPutAll: arg first;
				space
		] separatedBy: [ str nextPutAll: ', ' ].
	
		str nextPutAll: '))'.
		
	]! !

!NBFnSpec methodsFor: 'accessing' stamp: 'IgorStasenko 8/19/2011 17:44'!
arguments

	^ arguments! !

!NBFnSpec methodsFor: 'accessing' stamp: 'IgorStasenko 8/19/2011 17:44'!
functionName: anObject

	functionName := anObject! !

!NBFnSpec methodsFor: 'accessing' stamp: 'IgorStasenko 8/19/2011 17:44'!
returnType

	^ returnType! !

!NBFnSpec class methodsFor: 'instance creation' stamp: 'IgorStasenko 8/21/2011 11:07'!
namedFunctionFrom: anArrayWithDefinition

	"Create an instance of receiver by parsing an array in a form like C function definition: 

	#( void foo (int * x, float y ) ) 
	"

	^ NBFnSpecParser new parseNamedFunction: anArrayWithDefinition ! !

!NBFnSpecParser methodsFor: 'parsing' stamp: 'IgorStasenko 12/18/2011 19:28'!
parseArguments
"
Parse a arguments spec in a form of: 

#( type1 name1 , type2 name2 , nil, true, false , 100 )
"
	[ stream atEnd ] whileFalse: [
		self parseArgument ifNotNil: [:arg | 
			fnSpec addArgument: arg].
		
		self skipSpace.
		
		stream atEnd ifFalse: [ stream peek = $, ifFalse: [ self error: 'comma expected' ].
			stream next. self skipSpace. ]
	].! !

!NBFnSpecParser methodsFor: 'public interface' stamp: 'IgorStasenko 2/9/2012 12:47'!
parseNamedFunction: aFunctionDefinition

"
Parse a function definition in a form of: 

#( returnType functionName (arguments) )
or

'returnType functionName (arguments)'


Answer an instance of NBFnSpec class
"
	| argsSpec typeAndName fnName |
	
	fnSpec := NBFnSpec new.
	
	aFunctionDefinition isString ifTrue: [

		typeAndName :=  (aFunctionDefinition copyUpTo: $( ) trimBoth.
		argsSpec := ((aFunctionDefinition copyAfter: $( ) copyUpTo: $)) trimBoth.
	
	] ifFalse: [

		argsSpec := aFunctionDefinition last gather: [:ea | ea asString, ' ' ].
		typeAndName := aFunctionDefinition allButLast  gather: [:ea | ea asString, ' ' ].
	].
	
	stream := typeAndName readStream.
	fnSpec returnType: (requestor returnType: self parseType).
	
	fnName := self parseWord.
	fnName ifNil: [ self error: 'function name expected' ].

	fnSpec functionName: fnName.
	
	stream := argsSpec readStream.
	self parseArguments.

	^ fnSpec! !

!NBFnSpecParser methodsFor: 'parsing' stamp: 'IgorStasenko 8/19/2011 17:59'!
parseType
	" parse type name and optional number of asterisks, following it"
	| typeName ptrArity |

	typeName := self parseWord.
	typeName isNil ifTrue: [ ^ self error: 'type name expected' ].

	"skip 'const' , which is often used but has no any use for us "
	
	typeName = 'const' ifTrue: [
		self skipSpace.
		typeName := self parseWord.
		typeName isNil ifTrue: [ ^ self error: 'type name expected' ].
	].
	
	ptrArity := 0.
	[ self skipSpace. stream peek = $* ] whileTrue: [ 
		ptrArity := ptrArity + 1.
		stream next ].

	^ Array with: typeName with: ptrArity

! !

!NBFnSpecParser methodsFor: 'parsing' stamp: 'cipt 10/26/2012 19:21'!
parseArgument
	| argName indirectIndex typeAndPtrArity char |
	" An argument can be:

 - nil , true , false
 - a class/pool variable name
 - integer literal

 - self , with optional **
 - type name *** arg name

"
	char := stream peek.
	(char isDigit or: [ char = $- ])
		ifTrue: [ ^ requestor integerConstantArgument: self parseInt ].
	typeAndPtrArity := self parseType.
	self skipSpace.
	argName := self parseWord.
	self skipSpace.
	char := stream peek.
	char = $@
		ifTrue: [ 
			stream next.
			self skipSpace.
			argName := argName.
			indirectIndex := self parseInt ].	
	"for sole 'void' fake argument "
	(typeAndPtrArity = #('void' 0) and: [ argName isNil ])
		ifTrue: [ ^ nil ].
	^ requestor
		argName: argName
		indirectIndex: indirectIndex
		type: typeAndPtrArity first
		ptrArity: typeAndPtrArity second ! !

!NBFnSpecParser methodsFor: 'parsing' stamp: 'Igor.Stasenko 4/30/2010 06:03'!
parseInt

	| negate num |

	negate := false.
	stream peek = $- ifTrue: [ negate := true. stream next.  self skipSpace ].

	num := String new writeStream.	
	[ stream atEnd not and: [stream peek isDigit ] ] whileTrue: [ num nextPut: stream next ].

	num := num contents asInteger.
	negate ifTrue: [ num := num negated ].
	
	^ num! !

!NBFnSpecParser methodsFor: 'public interface' stamp: 'IgorStasenko 2/9/2012 12:42'!
parseAnonFunction: aFunctionDefinition

"
Parse a function definition in a form of: 

#( returnType (arguments) )
or

'returnType (arguments)'


Answer an instance of NBFnSpec class
"
	| argsSpec retType |
	
	fnSpec := NBFnSpec new.
	
	aFunctionDefinition isString ifTrue: [

		retType :=  (aFunctionDefinition copyUpTo: $( ) trimBoth.
		argsSpec := ((aFunctionDefinition copyAfter: $( ) copyUpTo: $)) trimBoth.
	
	] ifFalse: [

		argsSpec := aFunctionDefinition last gather: [:ea | ea asString, ' ' ].
		retType := aFunctionDefinition allButLast  gather: [:ea | ea asString, ' ' ].
	].
	
	stream := retType readStream.
	fnSpec returnType: (requestor returnType: self parseType).

	stream atEnd ifFalse: [ self error: 'Nothing more expected after function type'].	
	
	stream := argsSpec readStream.
	self parseArguments.

	^ fnSpec! !

!NBFnSpecParser methodsFor: 'initialization' stamp: 'IgorStasenko 8/21/2011 02:50'!
initialize
	requestor := self. ! !

!NBFnSpecParser methodsFor: 'requestor callbacks' stamp: 'cipt 10/24/2012 20:19'!
argName: aName indirectIndex: anIndex type: aTypeName ptrArity: arity
	
	^ { aName. anIndex. aTypeName. arity }! !

!NBFnSpecParser methodsFor: 'requestor callbacks' stamp: 'IgorStasenko 8/21/2011 10:55'!
returnType: aType

	
	^ aType! !

!NBFnSpecParser methodsFor: 'requestor callbacks' stamp: 'IgorStasenko 8/21/2011 10:57'!
integerConstantArgument: aValue
	^ aValue! !

!NBFnSpecParser methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/30/2010 05:31'!
requestor: aRequestor

	requestor := aRequestor.! !

!NBFnSpecParser methodsFor: 'parsing' stamp: 'IgorStasenko 6/1/2012 18:37'!
parseWord

	^ String streamContents: [:st |  | ch |
	
		"first char must be letter or underscore"
		ch := stream peek.	
		(ch notNil and: [ ch isLetter or: [ '_$' includes: ch ]]) ifFalse: [ ^ nil ].
		
		[ ch := stream peek. ch notNil and: [ch isLetter or: [ ('_$' includes: ch)  or: [ch isDigit] ] ] ] 
				whileTrue: [ st nextPut: stream next].
	]

! !

!NBFnSpecParser methodsFor: 'parsing' stamp: 'cipt 10/21/2012 01:27'!
skipSpace
	| ch |
	[ 
	ch := stream peek.
	ch ifNil: [ ^ self ].
	ch isSeparator ] whileTrue: [ stream next ]! !

!NBFnSpecParserTest methodsFor: 'accessing' stamp: 'cipt 10/26/2012 19:19'!
argName: argName indirectIndex: anIndex type: typeName ptrArity: ptrArity

	^ #argument! !

!NBFnSpecParserTest methodsFor: 'tests' stamp: 'cipt 10/26/2012 19:30'!
testParseAnonFn

	 | parser args |
	
	#(
		#(int * * ( 0, nil, -10, FOO_BAR , int a, int* _b, char** c, void* * * d_))
		'int * * ( 0, nil, -10, FOO_BAR , int a, int* _b, char** c, void* * * d_)'  ) do: [:spec |
	
	
		parser := self newParser parseAnonFunction: spec.
		
		self assert: parser returnType = #('int' 2).
	
		args := parser arguments.
		self assert: args size = 8.

		self assert: (args at: 1) = 0. 
		self assert: (args at: 2) = #(nil nil 'nil' 0). 
		self assert: (args at: 3) = -10. 
		self assert: (args at: 4) = #(nil nil 'FOO_BAR' 0). 
		self assert: (args at: 5) = #('a' nil 'int' 0). 
		self assert: (args at: 6) = #('_b' nil 'int' 1). 
		self assert: (args at: 7) = #('c' nil 'char' 2). 
		self assert: (args at: 8) = #('d_' nil 'void' 3 ). 
	]! !

!NBFnSpecParserTest methodsFor: 'tests' stamp: 'cipt 10/26/2012 19:30'!
testParseNamedFn

	 | parser args |
	
	#(
	(int * * #'function_n$a$m$e' ( 0, nil, -10, FOO_BAR , int a, int* _b, char** c, void* * * d_))
	' int * * function_n$a$m$e (0, nil, -10, FOO_BAR , int a, int* _b, char** c, void* * * d_    ' ) do: [:spec |

		parser := self newParser parseNamedFunction: spec.
		
		self assert: parser functionName = 'function_n$a$m$e'.
		self assert: parser returnType = #('int' 2).
		
		args := parser arguments.
		self assert: args size = 8.

		self assert: (args at: 1) = 0. 
		self assert: (args at: 2) = #(nil nil 'nil' 0). 
		self assert: (args at: 3) = -10. 
		self assert: (args at: 4) = #(nil nil 'FOO_BAR' 0). 
		self assert: (args at: 5) = #('a' nil 'int' 0). 
		self assert: (args at: 6) = #('_b' nil 'int' 1). 
		self assert: (args at: 7) = #('c' nil 'char' 2). 
		self assert: (args at: 8) = #('d_' nil 'void' 3 ). 
	].
! !

!NBFnSpecParserTest methodsFor: 'parser' stamp: 'IgorStasenko 2/13/2012 13:01'!
newParser
	^ NBFnSpecParser new! !

!NBFnSpecParserTest methodsFor: 'callbacks' stamp: 'IgorStasenko 2/13/2012 13:04'!
returnType: aType

	^ #returnType! !

!NBFnSpecParserTest methodsFor: 'tests' stamp: 'IgorStasenko 2/13/2012 13:16'!
testParserCallbacks

	| parser  spec parsedSpec args | 
	parser := self newParser requestor: self.
	
	spec := #(int * * function_name ( 0, nil, -10, FOO_BAR , int a, int* _b, char** c, void* * * d_)).
	parsedSpec := parser parseNamedFunction: spec.
	
	self assert: parsedSpec returnType equals: #returnType.
	
	args := parsedSpec arguments.
	
	self assert: args first = #integerConstant.
	self assert: args third = #integerConstant.
	args := args reject: [:each | each = #integerConstant ].

	self assert: args size = 6.
	self assert: args asSet size = 1.
	self assert: args first = #argument! !

!NBFnSpecParserTest methodsFor: 'callbacks' stamp: 'IgorStasenko 2/13/2012 13:03'!
integerConstantArgument: int

	^ #integerConstant! !

!NBFnSpecParserTest methodsFor: 'tests' stamp: 'IgorStasenko 2/9/2012 12:44'!
testParseNoArgsFn

	 | parser args |
	#( 
	 #(int * * function_name ( void ) )
	' int * * function_name  ( void ) '
	) do: [:spec |
		parser := self newParser parseNamedFunction: spec.
		
		self assert: parser functionName = 'function_name'.
		self assert: parser returnType = #('int' 2).
	
		args := parser arguments.
		self assert: args size = 0.
	]! !

!NBInt16 commentStamp: '<historical>'!
I responsible for marshalling 
	
	signed 16-bit integer 

type values.!
!NBInt16 methodsFor: 'emitting code' stamp: 'IgorStasenko 9/2/2012 23:14'!
coerceReturnValue: gen
	| asm |
	"convert signed short to ST integer"
	asm := gen asm.
	
	asm movsx: asm EAX with: asm AX.

	gen proxy integerObjectOf: asm EAX.
 
	! !

!NBInt16 methodsFor: 'emitting code' stamp: 'IgorStasenko 9/2/2012 23:14'!
pushAsValue: gen

	gen asm push: (gen proxy integerValueOf: (loader emitLoad: gen))! !

!NBInt32 commentStamp: '<historical>'!
I responsible for marshalling 
	
	signed 32-bit integer 

type values.!
!NBInt32 methodsFor: 'emitting code' stamp: 'IgorStasenko 9/2/2012 23:17'!
coerceOopToOperand: gen ifFailedJumpTo: aLabel
	" input: 
		EAX - oop
	  output:
	      EAX - result of coercion
	"
	
	self assert: (pointerArity = 0).
	gen proxy signed32BitValueOf: gen asm EAX! !

!NBInt32 methodsFor: 'emitting code' stamp: 'IgorStasenko 9/2/2012 23:17'!
coerceReturnValue: gen
	
	"convert int32 to ST integer"
	gen proxy signed32BitIntegerFor: (gen returnValueRegister).
 
	! !

!NBInt32 methodsFor: 'emitting code' stamp: 'IgorStasenko 9/2/2012 23:17'!
pushAsValue: gen

	gen asm push: (gen proxy signed32BitValueOf: (loader emitLoad: gen) )! !

!NBInt64 commentStamp: '<historical>'!
I responsible for marshalling 
	
	signed 64-bit integer 

type values.!
!NBInt64 methodsFor: 'emitting code' stamp: 'IgorStasenko 9/3/2012 00:55'!
coerceReturnValue: gen
	
	"convert 64-bit unsigned value in EAX:EDX to ST integer"
	gen proxy signed64BitIntegerFor
	
	! !

!NBInt64 methodsFor: 'emitting code' stamp: 'IgorStasenko 9/3/2012 00:24'!
pushAsValue: gen
	| asm |
	asm := gen asm.

	gen proxy signed64BitValueOf: (loader emitLoad: gen).

	asm 
		push: asm EDX;
		push: asm EAX.

	gen optCheckFailOnEveryArgument ifTrue: [
		gen proxy ifFailedEmit: [  gen failWithMessage: 'Argument coercion failed: signed 64-bit integer value expected' ].
	].! !

!NBInt8 commentStamp: '<historical>'!
I responsible for marshalling 
	
	signed 8-bit integer 

type values.!
!NBInt8 methodsFor: 'emitting code' stamp: 'IgorStasenko 9/2/2012 23:12'!
coerceReturnValue: gen
	| asm |
	
	"convert signed byte to ST integer"
	asm := gen asm.
	
	asm movsx: asm EAX with: asm AL.

	gen proxy integerObjectOf: asm EAX.
 
	! !

!NBInt8 methodsFor: 'emitting code' stamp: 'IgorStasenko 9/2/2012 23:12'!
pushAsValue: gen
	"should we truncate it to 8bit value here?"
	gen asm push: (gen proxy integerValueOf: (loader emitLoad: gen) )	

	! !

!NBIntegerExternalType commentStamp: 'Igor.Stasenko 4/28/2010 11:53'!
Abstract class for all integer external types!
!NBInterpreterProxy commentStamp: '<historical>'!
I am an important part of a native code generation toolchain, which provides an access to all interpreterProxy functions.

A native code, inevitably, needs to convert a method's arguments to their native representations, and access a different fields of oops. For this, we need to use interpreter proxy methods.

Code generator options, used by proxy: 

	#optNonMovable
		- The code is a standalone routine, which 
		a) will be placed into a non-movable memory region.
		b) can be called by any other function, not by primitiveNativeCall, therefore
	
	#optDirectProxyFnAddress
		- call proxy functions directly, instead of loading 
		their address indirectly via interpreterProxy struct

	 #optUseStackPointer 
		- use a direct ST stack pointer, initially retrieved using #getStackPointer
!
!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/29/2010 06:20'!
addGCRoot: sqIntPtr
	
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'call' stamp: 'CamilloBruni 7/19/2012 12:04'!
callFn: aFunctionOrName
	
	| fn |
	fn := aFunctionOrName.
	aFunctionOrName isString ifTrue: [ fn := self functions at: aFunctionOrName ].

	fn checkVersion. 

	gen optProxyLabels ifTrue: [
		asm label: (asm uniqueLabelName: fn name).
		].
	self canUseDirectProxyFnAddress ifTrue: [		
		asm 
			mov: (fn address asUImm32 annotation: fn name )   to: EAX;
			call: EAX	
	] ifFalse: [
		asm
			mov: (self class interpreterProxyAddress asUImm32 annotation: 'interpreterProxy address')   to: EAX;
			mov: ((EAX ptr + (fn index * self pointerSize)) annotation: fn name) to: EAX;
			call: EAX
	]
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 15:52'!
slotSizeOf: oop
	"Returns the number of slots in the receiver.
	If the receiver is a byte object, return the number of bytes.
	Otherwise return the number of words."

	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'IgorStasenko 8/5/2013 12:04'!
pushFloat: f
	"not recommended for use in native code"
	self shouldNotUse  
! !

!NBInterpreterProxy methodsFor: 'proxy classes' stamp: 'Igor.Stasenko 4/11/2010 16:40'!
classExternalFunction
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:03'!
checkedIntegerValueOf: oop
	"convert smallinteger into integer value. fails if oop is not a smallinteger"
	
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/30/2010 20:40'!
sendInvokeCallback: thunkPtr Stack: stackPtr Registers: regsPtr Jmpbuf: jmpBufPtr
	"Send the 4 argument callback message invokeCallback:stack:registers:jmpbuf:
	 to Alien class with the supplied args.  The arguments are raw C addresses
	 and are converted to integer objects on the way."
	
	"useless without Alien... "
	^ self gatedCall
	! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'IgorStasenko 8/5/2013 12:03'!
copyBitsFrom: x0 to: x1 at: y
	"This entry point needs to be implemented for the interpreter proxy.
	Since BitBlt is now a plugin we need to look up BitBltPlugin:=copyBitsFrom:to:at:
	and call it. This entire mechanism should eventually go away and be
	replaced with a dynamic lookup from BitBltPlugin itself but for backward
	compatibility this stub is provided"

	self shouldNotUse ! !

!NBInterpreterProxy methodsFor: 'initialization' stamp: 'CamilloBruni 8/3/2012 18:24'!
initialize
	
	"actually, this should be determined by querying NativeBoost platformId"
	objectFormat := NBObjectFormat32 new.

	"set it to nil, if there is recursion"
	stackPtrAddress := [self class stackPointerAddress] on: NBCodeGenRecursion do: [ nil ].
	framePtrAddress := [self class framePointerAddress] on: NBCodeGenRecursion do: [ nil ].
	cStackPtrAddress := [self class cStackPointerAddress] on: NBCodeGenRecursion do: [ nil ].
	cFramePtrAddress := [self class cFramePointerAddress] on: NBCodeGenRecursion do: [ nil ].! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'IgorStasenko 9/3/2012 00:23'!
positive64BitValueOf: oop 
	
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy functions Cog' stamp: 'CamilloBruni 7/19/2012 12:07'!
setInterruptCheckChain: aFunctionAddr
	self shouldBeImplemented ! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 14:57'!
failed
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy objects' stamp: 'CamilloBruni 7/23/2012 18:03'!
specialSelectorAt: index
	"generate the code to load the symbol at the given index from specialObjectsArray at: 23"
	"since we cannot directly access the specialObjectsArray we store it as an extra Root"
	NativeBoost extraRootsRegistry
		at: #specialSelectorsArray ifAbsentPut: [ Smalltalk specialSelectors ];
		"specialSelectorsArray -> EAX"
		emitOopAt: #specialSelectorsArray generator: gen.
	"EAX at: index"
	self stObject: asm EAX at: index.! !

!NBInterpreterProxy methodsFor: 'helpers' stamp: 'IgorStasenko 5/28/2012 06:32'!
stackPointer
	(self canUseStackPointer not
	or: [stackPtrAddress isNil]) ifTrue: [ 
		self error: 'cannot use stack pointer directly' ].

	"answer a memory operand "	
	^ stackPtrAddress asUImm32 ptr32! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:49'!
getThisSessionID
	
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy testing' stamp: 'Igor.Stasenko 4/11/2010 09:33'!
isBytes: oop
	 
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy classes' stamp: 'Igor.Stasenko 4/30/2010 20:29'!
classUnsafeAlien
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy objects' stamp: 'Igor.Stasenko 4/11/2010 16:15'!
characterTable
	"return a character table special object (array of 256 characters)"
	
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'helpers' stamp: 'CamilloBruni 8/3/2012 17:19'!
framePointer
	(self canUseStackPointer not
	or: [framePtrAddress isNil]) ifTrue: [ 
		self error: 'cannot use frame pointer directly' ].

	"answer a memory operand "	
	^ framePtrAddress asUImm32 ptr32! !

!NBInterpreterProxy methodsFor: 'proxy testing' stamp: 'Igor.Stasenko 4/11/2010 15:58'!
is: oop KindOf: stringPtr "char *"
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'testing' stamp: 'IgorStasenko 8/3/2011 05:56'!
usedGate 
	^ usedGate == true! !

!NBInterpreterProxy methodsFor: 'proxy classes' stamp: 'Igor.Stasenko 4/11/2010 16:15'!
classArray
	
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'helpers' stamp: 'Igor.Stasenko 5/20/2010 06:02'!
isBytesOrWords: oop ifNotJumpTo: label
	^ objectFormat isBytesOrWords: oop ifNotJumpTo: label! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'IgorStasenko 8/5/2013 12:03'!
pop: nItems
	"not recommended for use in native code.
	use #stackValue: "
	self shouldNotUse  
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:36'!
superclassOf:  classPointer
	
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 15:37'!
firstFixedField: oop
	"Answer an address of first fixed field for given oop"

	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'IgorStasenko 8/5/2013 12:04'!
signed64BitIntegerFor: op
"use #signed64BitIntegerFor instead"
	self shouldNotUse.! !

!NBInterpreterProxy methodsFor: 'helpers' stamp: 'IgorStasenko 8/7/2011 04:24'!
ifFailedEmit: aBlock
	| lbl |
	lbl := asm uniqueLabelName: 'notFailed'.
	
	self failed.
	asm or: EAX with: EAX.
	asm jz: lbl.
		
	aBlock value.
	
	asm label: lbl! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 15:53'!
stObject: obj at: index put: value
	"Do what ST would return for <obj> at: index put: value."

	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy classes' stamp: 'Igor.Stasenko 4/11/2010 16:16'!
classPoint
	
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy testing' stamp: 'Igor.Stasenko 4/11/2010 15:59'!
isIntegerObject: oop
	 " return true (1) only if oop is smallInteger (not big integer or any other object !!!!) "
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'helpers' stamp: 'Igor.Stasenko 9/29/2010 11:04'!
pushFloatOopAsFloat64: oop

	" input - oop , and operand, pointing to a Oop
	output: 32-bit floating-point value pushed on stack
	clobbers: EAX, ECX"

	Smalltalk compactClassesArray indexOf: Float ifAbsent: [
		"if Float is not compact class, do the hard way "
		self floatValueOf: oop.
		asm sub: (asm ESP) with: 8.
		asm fstp: asm ESP ptr64.
		^ self.
		].

	self verifyCompactClassOf: oop is: Float.
	objectFormat floatsMatchingPlatform ifFalse: [
		asm 
			push: EAX ptr + (self baseHeaderSize);
			push: EAX ptr + (self baseHeaderSize+4) ]
	ifTrue: [
		asm 
			push: EAX ptr + (self baseHeaderSize+4);
			push: EAX ptr + (self baseHeaderSize) ]
! !

!NBInterpreterProxy methodsFor: 'helpers' stamp: 'Igor.Stasenko 5/3/2010 14:28'!
createInstanceOf: aClass size: indexableSize

	^ self instantiateClass: [ gen emitFetchClass: aClass ] indexableSize: indexableSize! !

!NBInterpreterProxy methodsFor: 'proxy functions Cog' stamp: 'CamilloBruni 7/19/2012 12:07'!
primitiveFailFor: errorCode
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'VM-extras' stamp: 'Igor.Stasenko 5/14/2010 03:48'!
swapActiveContext: newContext

	"call the 'swapActiveContext' VM function "
	
	| fn |
	
	fn := NativeBoost loadFunction: 'swapActiveContext' from: ''.
	self assert: (fn ~= 0).
	asm push: newContext.
	asm mov: fn asUImm to: EAX.
	asm call: EAX;
	add: ESP with: 4.
	
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 15:54'!
stSizeOf: obj
	"Return the number of indexable fields in the given object. (i.e., what Smalltalk would return for <obj> size)."
	"Note: Assume oop is not a SmallInteger!!"

	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:20'!
pushRemappableOop: oop
	"Record the given object in a the remap buffer. Objects in this buffer are remapped when a compaction occurs. This facility is used by the interpreter to ensure that objects in temporary variables are properly remapped."

	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy-stack access' stamp: 'Igor.Stasenko 4/30/2010 20:16'!
stackFloatValue: offset
	"answer a float value of oop on stack at given offset value.
	
	Note, return value is loaded in FP register, not GP register"
	
	self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy functions Cog' stamp: 'CamilloBruni 7/19/2012 12:07'!
integerArg: index
	self shouldBeImplemented ! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:34'!
showDisplayBits: aForm Left: l Top: t Right: r Bottom: b
	"Repaint the portion of the Smalltalk screen bounded by the affected rectangle. Used to synchronize the screen after a Bitblt to the Smalltalk Display object."
	
	"any reason to use it here?"
	self shouldBeImplemented! !

!NBInterpreterProxy methodsFor: 'proxy objects' stamp: 'Igor.Stasenko 4/11/2010 16:15'!
nilObject
	
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/30/2010 20:35'!
reestablishContextPriorToCallback: callbackContext
	"callbackContext is an activation of invokeCallback:stack:registers:jmpbuf:.  Its sender
	 is the interpreter's state prior to the callback.  Reestablish that state."
	
	"WARNING!!!! do not use any proxy functions, which may 
	access the ST stack after calling this function, because its changing the active context
	and method, stack etc.
	
	Use at your own risk"
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 15:31'!
fetchClassOf: oop
	"Fetch the class of given oop"
		
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/30/2010 20:29'!
removeGCRoot: addr
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 15:39'!
literal: index ofMethod: methodOop
	"Answer a method's literal at given zero-based index"
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/30/2010 20:28'!
internalIsImmutable: oop
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'IgorStasenko 9/3/2012 00:56'!
positive64BitIntegerFor
		
	"Assume integer value is in EAX:EDX register pair.
	Make a call as if we push 2 arguments "
	| fn |
	
	fn := self functions at: #positive64BitIntegerFor: .
	
	^ self call: fn arguments: { asm EAX. asm EDX }! !

!NBInterpreterProxy methodsFor: 'proxy classes' stamp: 'Igor.Stasenko 4/11/2010 16:40'!
classExternalData
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:40'!
primitiveMethod
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'IgorStasenko 9/3/2012 00:54'!
signed64BitIntegerFor		
	"Assume integer value is in EAX:EDX register pair.
	Make a call as if we push 2 arguments "
	| fn |
	
	fn := self functions at: #signed64BitIntegerFor: .
	
	^ self call: fn arguments: { asm EAX. asm EDX }! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 15:53'!
stObject: obj at: index
	"Return what ST would return for <obj> at: index."

	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'helpers' stamp: 'IgorStasenko 5/26/2012 15:16'!
varBytesFirstFieldOf: oop 
	"Answer the address of first byte in oop in EAX.
	 oop must be of a variable byte format"
	
	asm 
		mov: oop to: asm EAX;
		add: asm EAX with: objectFormat varBytesFirstField ! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:32'!
primitiveFail
	"Fail a primitive."
	
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'helpers' stamp: 'HenrikSperreJohansen 8/25/2011 13:22'!
receiverInto: aReg
	"Input: aReg.
	Output: aReg - register holding method's receiver"
	

	^self stackValue: self methodArgumentCount storeIn: aReg.

	! !

!NBInterpreterProxy methodsFor: 'proxy classes' stamp: 'Igor.Stasenko 4/11/2010 16:40'!
classExternalLibrary
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:17'!
clone: oop
	"Return a shallow copy of the given object. May cause GC"
	"Assume: Oop is a real object, not a small integer."
	
	^ self gatedCall
! !

!NBInterpreterProxy methodsFor: 'proxy classes' stamp: 'Igor.Stasenko 4/11/2010 16:15'!
classBitmap
	
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'testing' stamp: 'IgorStasenko 5/28/2012 05:25'!
canUseStackPointer
	
	gen optUseStackPointer ifFalse: [ ^ false ].
	^ stackPtrAddress notNil
	! !

!NBInterpreterProxy methodsFor: 'call' stamp: 'CamilloBruni 7/23/2012 13:29'!
callGated: aFunction arguments: args
	"Call an interpreter proxy function through special gate function,
	ensuring that if it triggers GC and native code could be relocated, 
	then gate will return to correct native code address after relocation"

	| align |

	asm decorateWith: 'InterpreterProxy >> ' , aFunction name during: [ 

	align := gen stackAlignment.
	aFunction requiresAlignment ifFalse: [ align := 1 ].
	
	asm cdeclCall: [ :call |

		args reverseDo: [:arg | call push: arg value ].
		self gatedCallFn: aFunction.

	] alignment: align ].
	
	^ EAX! !

!NBInterpreterProxy methodsFor: 'helpers' stamp: 'Igor.Stasenko 9/29/2010 11:03'!
pushFloatOopAsFloat32: oop

	" input - oop , and operand, pointing to a Oop
	output: 32-bit floating-point value pushed on stack
	clobbers: EAX, ECX"

	Smalltalk compactClassesArray indexOf: Float ifAbsent: [
		"if Float is not compact class, do the hard way "
		self floatValueOf: oop.
		asm sub: (asm ESP) with: 4.
		asm fstp: asm ESP ptr32.
		^ self.
		].
	"since Float is a compact, to check that object is instance of float, 
	we just need to make sure that its header matching the Float's header format" 

	"Floating point value is stored in PowerPC word order"	
	self verifyCompactClassOf: oop is: Float.
	
	objectFormat floatsMatchingPlatform ifFalse: [
		asm 
			sub: ESP with: 8;
			mov: EAX ptr + self baseHeaderSize to: ECX;
			mov: ECX to: ESP ptr+4;
			mov: EAX ptr + (4+self baseHeaderSize) to: ECX;
			mov: ECX to: ESP ptr;
			fld: ESP ptr64;
			add: ESP with: 4 ] 
		ifTrue: [
			asm 
				fld: EAX ptr64 + self baseHeaderSize;
				sub: ESP with: 4 ].
	asm fstp: asm ESP ptr32
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'IgorStasenko 8/5/2013 12:03'!
ioLoadModule: m OfLength: l
	"implemented , see NBUtils class>>ioLoadModule: "
	self shouldNotUse ! !

!NBInterpreterProxy methodsFor: 'proxy classes' stamp: 'Igor.Stasenko 4/30/2010 20:29'!
classAlien
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy objects' stamp: 'CamilloBruni 7/23/2012 18:03'!
specialObjectsArray
	" load the special objects array into EAX"
	
	"since we cannot directly access the specialObjectsArray we store it as an extra Root"
	NativeBoost extraRootsRegistry
		at: #specialObjectsArray ifAbsentPut: [ Smalltalk specialObjectsArray ];
		"specialObjectsArray -> EAX"
		emitOopAt: #specialObjectsArray generator: gen.! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 15:30'!
fetchArray: index ofObject: oop
	"Fetch the instance variable at the given index of the given object. Return the address of first indexable field of resulting array object, or fail if the instance variable does not contain an indexable bytes or words object."
		
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'CamilloBruni 7/16/2012 09:50'!
booleanValueOf: oop
	"convert true and false (Smalltalk) to true or false(C).
	Fails if oop is not a boolean object"
	
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:44'!
ioMicroMSecs
	
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 15:55'!
storeInteger: index ofObject: obj withValue: integerValue
	"Note: Integer value must fit in SmallInt , otherwise function will fail primitive"

	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy testing' stamp: 'Igor.Stasenko 4/11/2010 16:01'!
isWords: oop
	"Answer true if the argument contains only indexable words (no oops). See comment in formatOf:"
	
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 15:19'!
majorVersion
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:51'!
ioFilename: aCharBuffer fromString: aFilenameString ofLength: filenameLength resolveAliases: bool
"the vm has to convert aFilenameString via any canonicalization and char-mapping and put the result in aCharBuffer.
Note the resolveAliases flag - this is an awful artefact of OSX and Apples demented alias handling. When opening a file, the flag must be  true, when closing or renaming it must be false. Sigh."	
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'call' stamp: 'CamilloBruni 7/23/2012 13:29'!
call: aFunction arguments: args
	
	| align |
	
	asm decorateWith: 'InterpreterProxy >> ' , aFunction name during: [ 
	

	align := gen stackAlignment.
	aFunction requiresAlignment ifFalse: [ align := 1 ].
	
	asm cdeclCall: [ :call |

		args reverseDo: [:arg | call push: arg value ].
		self callFn: aFunction.

	] alignment: align ].
	
	^ EAX! !

!NBInterpreterProxy methodsFor: 'proxy testing' stamp: 'Igor.Stasenko 4/11/2010 16:42'!
isInMemory: oop
	"Return true if the given address is in ST object memory"
	
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy objects' stamp: 'Igor.Stasenko 4/11/2010 16:15'!
falseObject
	
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'VM-extras' stamp: 'IgorStasenko 3/24/2011 21:28'!
callInterpreter

	"call the 'callInterpreter' VM function "
	
	| fn |
	
	fn := NativeBoost loadFunction: #callInterpret from: ''.
	self assert: (fn ~= 0).
	asm mov: fn asUImm to: EAX.
	asm call: EAX.! !

!NBInterpreterProxy methodsFor: 'call' stamp: 'Igor.Stasenko 9/29/2010 09:27'!
gatedCall

	| sender fn args |
	sender := thisContext sender.
	fn := self functions at: (sender method selector).
	args := Array new: sender method numArgs.
	1 to: args size do: [:i |  args at: i put: (sender tempAt: i ) ].
	
	^ self callGated: fn arguments: args! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'IgorStasenko 8/5/2013 12:04'!
push: anObject
	"not recommended for use in native code"
	self shouldNotUse  
! !

!NBInterpreterProxy methodsFor: 'proxy-stack access' stamp: 'Igor.Stasenko 4/30/2010 20:16'!
stackObjectValue: offset
	"Ensures that the given object is a real object, not a SmallInteger."
	^self simpleCall ! !

!NBInterpreterProxy methodsFor: 'helpers' stamp: 'CamilloBruni 8/3/2012 18:23'!
cStackPointer
	(self canUseStackPointer not
	or: [stackPtrAddress isNil]) ifTrue: [ 
		self error: 'cannot use c stack pointer directly' ].

	"answer a memory operand "	
	^ cStackPtrAddress asUImm32 ptr32! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/30/2010 20:15'!
signalSemaphoreWithIndex: index
	"Record the given semaphore index in the double buffer semaphores array to be signaled at the next convenient moment. Force a real interrupt check as soon as possible."
	
	
	^self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 09:38'!
signed32BitIntegerFor: value 
	^ self gatedCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:36'!
compilerHookVector
	
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy classes' stamp: 'Igor.Stasenko 4/11/2010 16:16'!
classFloat
	
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:32'!
incrementalGC
	"Do a mark/sweep garbage collection of just the young object 
	area of object memory (i.e., objects above youngStart), using 
	the root table to identify objects containing pointers to 
	young objects from the old object area."
	
	^ self gatedCall! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:36'!
setCompilerInitialized: initFlag
	
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy functions Cog' stamp: 'CamilloBruni 7/19/2012 12:07'!
topRemappableOop
	self shouldBeImplemented ! !

!NBInterpreterProxy methodsFor: 'VM-extras' stamp: 'IgorStasenko 5/7/2012 07:30'!
swapActiveContext: newContext restoreMethod: aMethodOop

	"call the 'swapActiveContextrestoreMethod' VM function "
	
	| fn |
	
	fn := NativeBoost loadFunction: 'swapActiveContextrestoreMethod' from: ''.
	self assert: (fn ~= 0).
		
	asm cdeclCall: [ :call |

		call push: aMethodOop value.
		call push: newContext value.
		
		asm 
			mov: fn asUImm to: EAX;
			call: EAX

	] alignment: gen stackAlignment 
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:22'!
byteSwapped: w

	"Answer the given integer with its bytes in the reverse order."
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy classes' stamp: 'Igor.Stasenko 4/11/2010 16:40'!
classExternalStructure
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'HenrikSperreJohansen 8/25/2011 00:58'!
methodArgumentCount
	"Answer a total number of arguments of primitive method"
	^ gen method numArgs! !

!NBInterpreterProxy methodsFor: 'proxy objects' stamp: 'CamilloBruni 7/23/2012 17:10'!
specialObjectsArrayAt: index
	"generate the code to load the value at the given index into EAX"
	self specialObjectsArray.
	self stObject: asm EAX at: index.! !

!NBInterpreterProxy methodsFor: 'proxy classes' stamp: 'Igor.Stasenko 4/11/2010 16:15'!
classCharacter
	
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'helpers' stamp: 'IgorStasenko 5/28/2012 03:17'!
prepareForCallout
	"reserve a stack pointer temp above any others
	
	- not used anymore, since Cog supports stackPointerAddress() function
	"
! !

!NBInterpreterProxy methodsFor: 'helpers' stamp: 'Igor.Stasenko 5/3/2010 14:29'!
createInstanceOf: aClass
	^ self createInstanceOf: aClass size: 0! !

!NBInterpreterProxy methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/29/2010 09:27'!
functions
	^ self class functions! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/30/2010 20:12'!
floatValueOf: oop
	"Return a double value of given floating point object.
	fails if oop is not a Float class instance"
	
	"note, result is floating point value"
	self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'IgorStasenko 5/4/2012 16:41'!
fetchPointer: index ofObject: oop
	"Answer an instance variable value at given index for given oop.
	No range checking performed.
	
	Output: EAX"
	| reg mem |
	(index isBlock or: [ oop isBlock]) ifTrue: [ ^ self simpleCall ].

	"shortcut if arguments are not blocks"
	reg := oop.
	reg isMem ifTrue: [ asm mov: oop to: EAX. reg := EAX ].

	mem := reg ptr32.

	index isInteger ifTrue: [
		mem displacement: (self baseHeaderSize+ (index*self oopSize)) asImm ]
	ifFalse: [ | idx  |
		idx := index.
		index isMem ifTrue: [ 
			"index stored at pointer" 
			asm mov: index to: ECX.
			idx := ECX.
			].
		mem index: idx; 
			scale: self oopSize;
			displacement: self baseHeaderSize asImm ].
	
	asm mov: mem to: EAX.
	^ EAX
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'IgorStasenko 8/5/2013 12:02'!
copyBits
	"This entry point needs to be implemented for the interpreter proxy.
	Since BitBlt is now a plugin we need to look up BitBltPlugin:=copyBits
	and call it. This entire mechanism should eventually go away and be
	replaced with a dynamic lookup from BitBltPlugin itself but for backward
	compatibility this stub is provided"
	
	self shouldNotUse ! !

!NBInterpreterProxy methodsFor: 'proxy testing' stamp: 'Igor.Stasenko 4/11/2010 15:58'!
is: oop MemberOf: stringPtr "char *"
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 09:39'!
success: flag
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'IgorStasenko 8/5/2013 12:04'!
positive64BitIntegerFor: op
"use positive64BitIntegerFor instead"
	self shouldNotUse.! !

!NBInterpreterProxy methodsFor: 'proxy functions Cog' stamp: 'CamilloBruni 7/19/2012 12:07'!
methodReturnValue: oop
	self shouldBeImplemented ! !

!NBInterpreterProxy methodsFor: 'proxy functions Cog' stamp: 'CamilloBruni 7/19/2012 12:07'!
utcMicroseconds
	self shouldBeImplemented ! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/30/2010 20:38'!
callbackEnter: callbackIDPtr

	" sqInt * callbackIDPtr 
	should point to a memory where jumpbuf will be stored "
	
	^ self gatedCall! !

!NBInterpreterProxy methodsFor: 'testing' stamp: 'Igor.Stasenko 9/29/2010 10:48'!
canUseDirectProxyFnAddress
	"Answer true if code generation routines can use interpreterProxy
	function addresses directly (available after bootstrap) "
	
	^ NativeBoost forCurrentPlatform isBootstrapping not
		and: [ gen optDirectProxyFnAddress ]! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:19'!
makePointwithxValue: xval yValue: yval
"make a Point xValue@yValue.
We know both will be integers so no value nor root checking is needed"
	^ self gatedCall
! !

!NBInterpreterProxy methodsFor: 'proxy testing' stamp: 'Igor.Stasenko 4/11/2010 16:00'!
isIntegerValue: value
	 " return true (1) only if given integer value fits in ST smallinteger immediate oop"
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:51'!
vmEndianness
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/30/2010 20:12'!
getStackPointer
	"return a ST stack pointer"
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/30/2010 20:11'!
internalIsMutable: oop
	"return a ST stack pointer"
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'helpers' stamp: 'IgorStasenko 8/30/2012 18:45'!
verifyCompactClassOf: oop is: aClass
	" fail prim, if oop class not matching the aClas
	output: oop in EAX "
	| index cont fail |

	index := Smalltalk compactClassesArray indexOf: aClass.
	oop = EAX ifFalse: [ asm mov: oop to: EAX ].
	
	cont := asm uniqueLabelName: 'cont'.
	fail := asm uniqueLabelName: 'fail'.
	asm 
	"smallinteger test"	
		test: EAX with: 1;
		jnz: fail;

		mov: EAX ptr to: ECX;
		and: ECX with: objectFormat compactClassMask;
		cmp: ECX with: (index bitShift: objectFormat compactClassIndexShift);
		je: cont.
		asm label: fail.
		gen failWithMessage: 'An instance of ', aClass name , ' expected'.	

	asm label: cont.
	
	! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'IgorStasenko 8/5/2013 12:04'!
floatObjectOf: floatValue
	"istantiate a floating point object and put a floating point value to it.
	answer that object "
	
	"we can't pass the floating point value in general purpose register,
	see the NBFloat64>>coerceReturnValue: how to do that."
	
	self shouldNotUse.
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 15:27'!
arrayValueOf: oop
	"Return the address of first indexable field of resulting array object, or fail if the instance variable does not contain an indexable bytes or words object."

	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy classes' stamp: 'Igor.Stasenko 4/11/2010 16:40'!
classExternalAddress
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions Cog' stamp: 'CamilloBruni 7/19/2012 12:07'!
addHighPriorityTickee: thickeeFnAddr period: periodms
	self shouldBeImplemented ! !

!NBInterpreterProxy methodsFor: 'call' stamp: 'Igor.Stasenko 4/9/2010 07:57'!
call: aFunction
	^ self call: aFunction arguments: #()

! !

!NBInterpreterProxy methodsFor: 'helpers' stamp: 'Igor.Stasenko 5/5/2010 20:11'!
indexOf: ivarName in: aClass

	^ aClass instVarIndexFor: ivarName ifAbsent: [nil]! !

!NBInterpreterProxy methodsFor: 'errors' stamp: 'IgorStasenko 8/5/2013 12:02'!
shouldNotUse

	self error: 'This is not recommended for use and therefore banned.'! !

!NBInterpreterProxy methodsFor: 'helpers' stamp: 'CamilloBruni 7/23/2012 13:29'!
verifyClassOf: oop is: aClass

	asm decorateWith: 'verifyClassOf:is:', aClass name during: [  

	"do a shortcut for compact classes"
	Smalltalk compactClassesArray indexOf: aClass ifAbsent: [ | class |
		class := gen reserveTemp.
		gen proxy fetchClassOf: oop.
		asm mov:  asm EAX to: class.
		gen emitFetchClass: aClass.
		asm cmp: asm EAX with: class;
			jne: gen failedLabel.
		gen releaseTemps: 1.
		^ self
	].

	^ self verifyCompactClassOf: oop is: aClass
	]! !

!NBInterpreterProxy methodsFor: 'proxy testing' stamp: 'Igor.Stasenko 4/11/2010 16:01'!
isPointers: value
	"Answer true if the argument has only fields that can hold oops. See comment in formatOf:"
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions Cog' stamp: 'CamilloBruni 7/19/2012 12:07'!
primitiveFailureCode
	self shouldBeImplemented ! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:12'!
positive32BitIntegerFor: integerValue
	"Convert a (possibly positive) integer value
	into corresponding smallint object or positive big int instance
	"
	
	^ self gatedCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:44'!
ioLoadFunction: fnName From: moduleName
	"Load and return the requested function from a module"
	
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy classes' stamp: 'Igor.Stasenko 4/11/2010 16:15'!
classByteArray
	
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions Cog' stamp: 'CamilloBruni 7/19/2012 12:07'!
isYoung: anOop
	self shouldBeImplemented ! !

!NBInterpreterProxy methodsFor: 'proxy classes' stamp: 'Igor.Stasenko 4/11/2010 16:16'!
classSemaphore
	
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:49'!
forceInterruptCheck
	
	^ self gatedCall! !

!NBInterpreterProxy methodsFor: 'proxy testing' stamp: 'Igor.Stasenko 4/11/2010 15:58'!
isIndexable: oop
	 
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'helpers' stamp: 'Igor.Stasenko 5/20/2010 07:25'!
oop: anOop ifSmallInt: aBlock ifNotSmallInt: notSmallIntBlock

	" emit code to check if argument, oop is smallInteger 
	squeak smallints having a least significant bit set"
	| lbl1 lbl2 |
	
	lbl1 := asm uniqueLabelName: 'notSmallInt'.
	asm 
		mov: anOop to: EAX;
		test: AL with: 1;
		je: lbl1.
	aBlock value.
	notSmallIntBlock ifNil: [ asm label: lbl1. ^ self ].
	
	lbl2 := asm uniqueLabelName: 'smallIntTestEnd'.
	asm jmp: lbl2.
	
	asm label: lbl1.
	notSmallIntBlock value.
	asm label: lbl2.
! !

!NBInterpreterProxy methodsFor: 'proxy-stack access' stamp: 'Igor.Stasenko 4/30/2010 20:16'!
stackIntegerValue: offset
	"answer a integer value of oop on stack at given offset value"
	^self simpleCall ! !

!NBInterpreterProxy methodsFor: 'proxy objects' stamp: 'Igor.Stasenko 4/11/2010 16:15'!
trueObject
	
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:49'!
fetchLong32: index ofObject: oop
	
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'accessing oop fields' stamp: 'Igor.Stasenko 5/19/2010 12:22'!
storePointer: op intoVarbytes: destOop at: offset
	" input:
	  op - register, holding a pointer value
	  destOop - register operand with variable bytes oop
	  offset - integer value"

	^ self 
		storeValue: op 
		ofSize: self pointerSize 
		intoVarbytes: destOop 
		at: offset
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'IgorStasenko 8/5/2013 12:04'!
pushInteger: int
	"not recommended for use in native code"
	self shouldNotUse  
! !

!NBInterpreterProxy methodsFor: 'call' stamp: 'IgorStasenko 8/3/2011 05:57'!
gatedCallFn: aFunctionOrName
	
	| fn gate |
	gen optNonMovable ifTrue: [
		"a non-movable code don't needs to use gate"
		^ self callFn: aFunctionOrName
		].
	
	fn := aFunctionOrName.
	aFunctionOrName isString  ifTrue: [ fn := self functions at: aFunctionOrName ].

	gate := NativeBoost callgateFunctionAddress.
	fn checkVersion.

	gen optProxyLabels ifTrue: [
		asm label: (asm uniqueLabelName: 'gated_', fn name).
		].

	"push an address of function to call"	
	self canUseDirectProxyFnAddress ifTrue: [ 
		asm 
			push: (fn address asUImm32 annotation: fn name).
	] ifFalse: [
		asm
			mov: (self class interpreterProxyAddress asUImm32 annotation: 'interpreterProxy address') to: EAX;
			mov: ((EAX ptr + (fn index * self pointerSize)) annotation: fn name) to: EAX;
			push: EAX
	].

	asm 
		mov: (gate asUImm32 annotation: 'Call gate')  to: EAX;
		call: EAX.

	usedGate := true.! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 5/5/2010 18:00'!
integerObjectOf:  value
	"Convert C integer value to smallinteger object.
	no range checking performed. "

	"lets not do call, but just do a shortcut (value << 1) + 1 "
	| tmp |
	tmp := value.
	value isBlock ifTrue: [ tmp := value value ].
	tmp = EAX ifFalse: [ asm mov: tmp to: EAX ].
	asm shl: EAX with: 1;
		inc: EAX	.
	
	^ EAX
	
	" ^ self simpleCall "
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:39'!
includesBehavior: aClass ThatOf: aSuperclass
	"Return the equivalent of 
		aClass includesBehavior: aSuperclass.
	Note: written for efficiency and better inlining (only 1 temp)"
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'helpers' stamp: 'IgorStasenko 5/28/2012 01:31'!
receiver
	"Input: none.
	Output: EAX - a method's receiver"
	
	self canUseStackPointer ifFalse: [ ^self stackValue: self methodArgumentCount ].
	"EAX - count "
	^self receiverInto: EAX.
	"EAX - receiver"
	! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:15'!
displayObject
	
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy classes' stamp: 'Igor.Stasenko 4/11/2010 16:38'!
classLargeNegativeInteger

	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:13'!
positive32BitValueOf: oop
	"Convert the given object into an integer value.
	The object may be either a positive ST integer or a four-byte LargePositiveInteger."
	
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'CamilloBruni 7/23/2012 13:29'!
stackValue: index storeIn: aReg
		
	(index isInteger and: [self canUseStackPointer]) ifTrue: [
		
		asm decorateWith: 'InterpreterProxy>>stackValue:' , index asString during:  [ 
		asm mov: self stackPointer to: aReg.
		
		objectFormat stackGrowsDown 
			ifTrue: [
				asm mov: aReg ptr + (self oopSize*index) to: aReg]
			ifFalse: [
				asm mov: aReg ptr - (self oopSize*index) to: aReg].
		^ aReg
	]].

	self error: 'Not available. (And should not reach here)'! !

!NBInterpreterProxy methodsFor: 'proxy classes' stamp: 'Igor.Stasenko 4/11/2010 16:16'!
classString
	
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/30/2010 20:11'!
callbackLeave:  callbackId
	"Leave from a previous callback"
	^ self gatedCall! !

!NBInterpreterProxy methodsFor: 'helpers' stamp: 'IgorStasenko 8/10/2011 17:52'!
shiftForPointer
	"answer the shift bits for pointer size"
	^ self pointerSize highBit - 1
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:21'!
become: array1 with: array2

	^ self gatedCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions Cog' stamp: 'CamilloBruni 7/19/2012 12:07'!
floatArg: index
	self shouldBeImplemented ! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'IgorStasenko 8/5/2013 12:04'!
pushBool: trueOrFalse
	"not recommended for use in native code"
	self shouldNotUse  
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 15:56'!
storePointer: index ofObject: obj withValue: oop
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 15:41'!
methodPrimitiveIndex
	"Answer a primitive index of currently activated method"
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy testing' stamp: 'Igor.Stasenko 4/11/2010 16:01'!
isWeak: oop
	"Answer true if the argument has only weak fields that can hold oops. See comment in formatOf:"
	
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'IgorStasenko 8/5/2013 12:03'!
obsoleteDontUseThisFetchWord: index ofObject: zap
	self shouldNotUse! !

!NBInterpreterProxy methodsFor: 'call' stamp: 'Igor.Stasenko 9/29/2010 09:27'!
simpleCall

	| sender fn args |
	sender := thisContext sender.
	fn := self functions at: (sender method selector).
	args := Array new: sender method numArgs.
	1 to: args size do: [:i |  args at: i put: (sender tempAt: i ) ].
	
	^ self call: fn arguments: args! !

!NBInterpreterProxy methodsFor: 'helpers' stamp: 'Igor.Stasenko 4/11/2010 23:04'!
ifFailedJumpTo: label
	self failed.
	asm or: EAX with: EAX.
	asm jnz: label.
		
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'IgorStasenko 9/3/2012 00:23'!
signed64BitValueOf: oop 
	
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 15:19'!
minorVersion
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy functions Cog' stamp: 'CamilloBruni 7/19/2012 12:07'!
primitiveErrorTable
	self shouldBeImplemented ! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 15:51'!
primitiveIndexOf: methodOop
	"return a primitive index for given method oop"
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions Cog' stamp: 'CamilloBruni 7/19/2012 12:07'!
isKindOf: oop Class: aClass
	self shouldBeImplemented ! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'IgorStasenko 8/5/2013 12:03'!
loadBitBltFrom: bbOop
	"This entry point needs to be implemented for the interpreter proxy.
	Since BitBlt is now a plugin we need to look up BitBltPlugin:=loadBitBltFrom
	and call it. This entire mechanism should eventually go away and be
	replaced with a dynamic lookup from BitBltPlugin itself but for backward
	compatibility this stub is provided"

	self shouldNotUse ! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 09:34'!
signed32BitValueOf: object

	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'helpers' stamp: 'Igor.Stasenko 5/19/2010 11:56'!
baseHeaderSize
	^ objectFormat baseHeaderSize! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'CamilloBruni 7/23/2012 13:29'!
stackValue: index
		
	(index isInteger and: [self canUseStackPointer]) ifTrue: [
		
		asm decorateWith: 'InterpreterProxy>>stackValue:' , index asString during:  [ 
		asm mov: self stackPointer to: EAX.
		
		objectFormat stackGrowsDown 
			ifTrue: [
				asm mov: EAX ptr + (self pointerSize*index) to: EAX]
			ifFalse: [
				asm mov: EAX ptr - (self pointerSize*index) to: EAX].
		^ EAX
	]].

	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:23'!
fullGC
	"Do a mark/sweep garbage collection of the entire object memory. Free inaccessible objects but do not move them."

	^ self gatedCall! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:20'!
popRemappableOop
	"Pop and return the possibly remapped object from the remap buffer."

	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions Cog' stamp: 'CamilloBruni 7/19/2012 12:07'!
instanceSizeOf: aClass
	self shouldBeImplemented ! !

!NBInterpreterProxy methodsFor: 'proxy functions Cog' stamp: 'CamilloBruni 7/19/2012 12:07'!
addSynchronousTickee: tickerFnAddr period: periodms round: roundms
	self shouldBeImplemented ! !

!NBInterpreterProxy methodsFor: 'proxy testing' stamp: 'Igor.Stasenko 4/11/2010 16:02'!
isWordsOrBytes: oop
	"Answer true if the contains only indexable words or bytes (no oops). See comment in formatOf:"
	"Note: Excludes CompiledMethods."
	
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 15:28'!
byteSizeOf: oop
	"Return the size of the receiver in bytes"

	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:09'!
integerValueOf: oop
	"Convert smallinteger oop to C integer value.
	No type checking performed.
	"
	
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/30/2010 20:10'!
fetchFloat: fieldIndex ofObject: objectPointer
	"Fetch the instance variable at the given index of the given object. Return the C double precision floating point value of that instance variable, or fail if it is not a Float."
	"Note: May be called by translated primitive code."
	
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 15:39'!
literalCountOf: methodOop
	"Answer a total number of literals for given method"
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'IgorStasenko 8/5/2013 12:03'!
pop: nItems thenPush: anObject
	"not recommended for use in native code.
	use #stackValue: , and return a result oop from native function instead"
	self shouldNotUse  
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 15:26'!
argumentCountOf: methodOop
	"return a number of arguments for given method oop"
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 15:52'!
sizeOfSTArrayFromCPrimitive: ptr
	"Return the number of indexable fields of the given object. This method is to be called from an automatically generated C primitive. The argument is assumed to be a pointer to the first indexable field of a words or bytes object; the object header starts 4 bytes before that."
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'accessing oop fields' stamp: 'Igor.Stasenko 5/19/2010 13:22'!
storeValue: op ofSize: numBytes intoVarbytes: destOop at: offset
	" input:
	  op - a register operand
	  numBytes - integer
	  destOop - register operand with variable bytes oop
	  offset - integer value"

	| mem |
	mem := destOop ptr + (objectFormat varBytesFirstField + offset).
	self assert: (op isGeneralPurpose & destOop isGeneralPurpose).
	asm mov: (asm reg: op index size: numBytes) to: (mem size: numBytes).
! !

!NBInterpreterProxy methodsFor: 'accessing' stamp: 'IgorStasenko 12/21/2011 14:20'!
generator: aGenerator

	gen := aGenerator.
	asm := aGenerator asm.
	objectFormat := NBObjectFormat current asm: asm.
	gen parseOptions: self class defaultOptions! !

!NBInterpreterProxy methodsFor: 'proxy functions Cog' stamp: 'CamilloBruni 7/19/2012 12:07'!
methodArg: index
	self shouldBeImplemented ! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'IgorStasenko 8/5/2013 12:03'!
ioLoadSymbol: sym OfLength: len FromModule: handle
	"implemented , see NBUtils class>>ioLoadSymbol:fromModule: "
	self shouldNotUse ! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/28/2010 13:32'!
fetchInteger: index ofObject: oop
	"Fetch the instance variable at the given index of the given object. Return the C integer value of that instance variable, or fail if it is not an integer."

	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'accessing' stamp: 'IgorStasenko 8/3/2011 19:50'!
objectFormat 
	^ objectFormat ! !

!NBInterpreterProxy methodsFor: 'proxy testing' stamp: 'Igor.Stasenko 4/11/2010 15:58'!
isFloatObject: oop
	 
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:19'!
instantiateClass: classOop indexableSize: sz

	^ self gatedCall
! !

!NBInterpreterProxy methodsFor: 'helpers' stamp: 'CamilloBruni 8/3/2012 18:23'!
cFramePointer
	(self canUseStackPointer not
	or: [stackPtrAddress isNil]) ifTrue: [ 
		self error: 'cannot use c stack pointer directly' ].

	"answer a memory operand "	
	^ cFramePtrAddress asUImm32 ptr32! !

!NBInterpreterProxy methodsFor: 'proxy classes' stamp: 'Igor.Stasenko 4/11/2010 16:16'!
classLargePositiveInteger
	
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy testing' stamp: 'Igor.Stasenko 4/11/2010 16:48'!
isArray: oop
	
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 15:37'!
firstIndexableField: oop
	"Answer an address of first indexable field for given oop"
	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'proxy functions' stamp: 'Igor.Stasenko 4/11/2010 16:23'!
fullDisplayUpdate
	"Repaint the entire smalltalk screen, ignoring the affected rectangle. Used in some platform's code when the Smalltalk window is brought to the front or uncovered."

	^ self simpleCall! !

!NBInterpreterProxy methodsFor: 'helpers' stamp: 'Igor.Stasenko 5/19/2010 11:54'!
oopSize
	^ objectFormat oopSize! !

!NBInterpreterProxy methodsFor: 'helpers' stamp: 'Igor.Stasenko 5/19/2010 11:54'!
pointerSize
	^ self oopSize! !

!NBInterpreterProxy methodsFor: 'proxy functions Cog' stamp: 'CamilloBruni 7/19/2012 12:07'!
tenuringIncrementalGC
	self shouldBeImplemented ! !

!NBInterpreterProxy methodsFor: 'proxy classes' stamp: 'Igor.Stasenko 4/11/2010 16:16'!
classSmallInteger
	
	^ self simpleCall
! !

!NBInterpreterProxy methodsFor: 'proxy functions Cog' stamp: 'CamilloBruni 7/19/2012 12:07'!
ownVM: threadIdAndFlags
	self shouldBeImplemented ! !

!NBInterpreterProxy methodsFor: 'helpers' stamp: 'Igor.Stasenko 5/19/2010 11:54'!
ivar: ivarName in: aClass
	"answer an offset of ivar relative to oop"
	| index |
	index := aClass instVarIndexFor: ivarName ifAbsent: [nil].
	^ objectFormat instVarOffsetAt: index.! !

!NBInterpreterProxy methodsFor: 'proxy functions Cog' stamp: 'CamilloBruni 7/19/2012 12:07'!
objectArg: index
	self shouldBeImplemented ! !

!NBInterpreterProxy methodsFor: 'helpers' stamp: 'Igor.Stasenko 5/20/2010 06:02'!
isBytes: oop ifNotJumpTo: label
	^ objectFormat isBytes: oop ifNotJumpTo: label! !

!NBInterpreterProxy methodsFor: 'proxy functions Cog' stamp: 'CamilloBruni 7/19/2012 12:07'!
disownVM: flags
	self shouldBeImplemented ! !

!NBInterpreterProxy class methodsFor: 'accessing functions' stamp: 'CamilloBruni 8/3/2012 18:26'!
cStackPointerAddress

	"to prevent recursion, we prohibit using stack pointer address when bootstrapping"
	NativeBoost forCurrentPlatform isBootstrapping ifTrue: [ ^ nil ].
	
	^ NativeBoost loadSymbol: #CStackPointer! !

!NBInterpreterProxy class methodsFor: 'class initialization' stamp: 'CamilloBruni 7/19/2012 11:54'!
proxyFunctionsData

	"taken from sqVirtualMachine.h"
	^ #(
		#minorVersion (void)
		#majorVersion (void)

		" InterpreterProxy methodsFor: 'stack access' "
		#pop: (sqInt)
		#pop:thenPush: (sqInt sqInt)
		#push: (sqInt)
		#pushBool: (sqInt)
		#pushFloat: (double)
		#pushInteger: (sqInt)
		#stackFloatValue: (sqInt )
		#stackIntegerValue: (sqInt)
		#stackObjectValue: (sqInt)
		#stackValue: (sqInt)

		" InterpreterProxy methodsFor: 'object access'  "

		#argumentCountOf: (sqInt)
		#arrayValueOf: (sqInt)
		#byteSizeOf: (sqInt)
		#fetchArray:ofObject: (sqInt sqInt)
		#fetchClassOf: (sqInt)
		#fetchFloat:ofObject: (sqInt sqInt)
		#fetchInteger:ofObject: (sqInt sqInt)
		#fetchPointer:ofObject: (sqInt sqInt)
		#obsoleteDontUseThisFetchWord:ofObject: (sqInt sqInt)
		#firstFixedField: (sqInt)
		#firstIndexableField: (sqInt)
		#literal:ofMethod: (sqInt  sqInt)
		#literalCountOf: (sqInt )
		#methodArgumentCount (void)
		#methodPrimitiveIndex (void)
		#primitiveIndexOf: (sqInt )
		#sizeOfSTArrayFromCPrimitive: (voidPtr)
		#slotSizeOf: (sqInt )
		#stObject:at: (sqInt   sqInt )
		#stObject:at:put: (sqInt   sqInt   sqInt)
		#stSizeOf: (sqInt)
		#storeInteger:ofObject:withValue: (sqInt   sqInt   sqInt )
		#storePointer:ofObject:withValue: (sqInt   sqInt   sqInt )

		" InterpreterProxy methodsFor: 'testing' "

		#is:KindOf: (sqInt   charPtr)
		#is:MemberOf: (sqInt charPtr)
		#isBytes: (sqInt )
		#isFloatObject: (sqInt )
		#isIndexable: (sqInt )
		#isIntegerObject: (sqInt )
		#isIntegerValue: (sqInt )
		#isPointers: (sqInt )
		#isWeak: (sqInt )
		#isWords: (sqInt )
		#isWordsOrBytes: (sqInt )

		" InterpreterProxy methodsFor: 'converting' "

		#booleanValueOf: (sqInt )
		#checkedIntegerValueOf: (sqInt )
		#floatObjectOf: (double )
		#floatValueOf: (sqInt )
		#integerObjectOf: (sqInt )
		#integerValueOf: (sqInt )
		#positive32BitIntegerFor: (sqInt )
		#positive32BitValueOf: (sqInt )

		" InterpreterProxy methodsFor: 'special objects' "

		#characterTable (void)
		#displayObject (void)
		#falseObject (void)
		#nilObject (void)
		#trueObject (void)

		" InterpreterProxy methodsFor: 'special classes' "

		#classArray (void)
		#classBitmap (void)
		#classByteArray (void)
		#classCharacter (void)
		#classFloat (void)
		#classLargePositiveInteger (void)
		#classPoint (void)
		#classSemaphore (void)
		#classSmallInteger (void)
		#classString (void)

		" InterpreterProxy methodsFor: 'instance creation' "

		#clone: (sqInt )
		#instantiateClass:indexableSize: (sqInt   sqInt )
		#makePointwithxValue:yValue: (sqInt   sqInt )
		#popRemappableOop (void)
		#pushRemappableOop: (sqInt )

		" InterpreterProxy methodsFor: 'other' "

		#become:with: (sqInt   sqInt )
		#byteSwapped: (sqInt)
		#failed (void)
		#fullDisplayUpdate (void)
		#fullGC (void)
		#incrementalGC (void)
		#primitiveFail (void)
		#showDisplayBits:Left:Top:Right:Bottom: (sqInt   sqInt  sqInt  sqInt  sqInt)
		#signalSemaphoreWithIndex: (sqInt)
		#success: (sqInt )
		#superclassOf: (sqInt )

		" InterpreterProxy methodsFor: 'compiler' "

		#compilerHookVector (void)
		#setCompilerInitialized: (sqInt )

		" VM_PROXY_MINOR > 1 "
		2
		" InterpreterProxy methodsFor: 'BitBlt support' "

		#loadBitBltFrom: (sqInt )
		#copyBits (void)
		#copyBitsFrom:to:at: (sqInt   sqInt   sqInt )

		" VM_PROXY_MINOR > 2 "
		3
		#classLargeNegativeInteger (void)
		#signed32BitIntegerFor: (sqInt )
		#signed32BitValueOf: (sqInt )
		#includesBehavior:ThatOf: (sqInt   sqInt )
		#primitiveMethod (void)

		" InterpreterProxy methodsFor: 'FFI support' "

		#classExternalAddress (void)
		#classExternalData (void)
		#classExternalFunction (void)
		#classExternalLibrary (void)
		#classExternalStructure (void)
		#ioLoadModule:OfLength: (sqInt sqInt)
		#ioLoadSymbol:OfLength:FromModule: (sqInt   sqInt   sqInt )
		#isInMemory: (sqInt )

		" VM_PROXY_MINOR > 3 "
		4
		#ioLoadFunction:From: (charPtr charPtr)
		#ioMicroMSecs (void)

		" VM_PROXY_MINOR > 4 "
		5
		#positive64BitIntegerFor: (sqLong)
		#positive64BitValueOf: (sqInt)
		#signed64BitIntegerFor: (sqLong)
		#signed64BitValueOf: (sqInt)

		" VM_PROXY_MINOR > 5 "
		6
		#isArray: (sqInt )
		#forceInterruptCheck (void)


		" VM_PROXY_MINOR > 6 "
		7
		#fetchLong32:ofObject: (sqInt  sqInt)
		#getThisSessionID (void)
		#ioFilename:fromString:ofLength:resolveAliases: (charPtr charPtr sqInt sqInt)
		#vmEndianness (void)

		8
		#internalIsImmutable: (sqInt)
		#internalIsMutable: (sqInt)
		#primitiveFailFor: (sqInt)
		#classAlien (void)
		#getStackPointer (void)
		#sendInvokeCallback:Stack:Registers:Jmpbuf: (sqInt sqInt sqInt sqInt)
		#reestablishContextPriorToCallback: (sqInt)
		#classUnsafeAlien (void)
		" New methods for proxy version 1.8 "
			
		" callbackEnter: Re-enter the interpreter loop for a callback.
			Arguments:
			callbackID: Pointer to a location receiving the callback ID
			used in callbackLeave
			Returns: True if successful, false otherwise  "
		callbackEnter: (sqIntPtr)
			
		" callbackLeave: Leave the interpreter from a previous callback
			Arguments:
			callbackID: The ID of the callback received from callbackEnter()
			Returns: True if succcessful, false otherwise. "
		callbackLeave: (sqInt)
			
		" addGCRoot: Add a variable location to the garbage collector.
			The contents of the variable location will be updated accordingly.
			Arguments:
			varLoc: Pointer to the variable location
			Returns: True if successful, false otherwise. "
		addGCRoot: (sqIntPtr)
			
		"  removeGCRoot: Remove a variable location from the garbage collector.
			Arguments:
			varLoc: Pointer to the variable location
			Returns: True if successful, false otherwise. "
		removeGCRoot: (sqIntPtr)
	)
! !

!NBInterpreterProxy class methodsFor: 'class initialization' stamp: 'CamilloBruni 7/18/2012 14:41'!
CogProxyFunctionsData

	"taken from sqVirtualMachine.h"
	^ #(
		#minorVersion (void)
		#majorVersion (void)

		" InterpreterProxy methodsFor: 'stack access' "
		#pop: (sqInt)
		#pop:thenPush: (sqInt sqInt)
		#push: (sqInt)
		#pushBool: (sqInt)
		#pushFloat: (double)
		#pushInteger: (sqInt)
		#stackFloatValue: (sqInt )
		#stackIntegerValue: (sqInt)
		#stackObjectValue: (sqInt)
		#stackValue: (sqInt)

		" InterpreterProxy methodsFor: 'object access'  "
		#argumentCountOf: (sqInt)
		#arrayValueOf: (sqInt)
		#byteSizeOf: (sqInt)
		#fetchArray:ofObject: (sqInt sqInt)
		#fetchClassOf: (sqInt)
		#fetchFloat:ofObject: (sqInt sqInt)
		#fetchInteger:ofObject: (sqInt sqInt)
		#fetchPointer:ofObject: (sqInt sqInt)
		#obsoleteDontUseThisFetchWord:ofObject: (sqInt sqInt)
		#firstFixedField: (sqInt)
		#firstIndexableField: (sqInt)
		#literal:ofMethod: (sqInt  sqInt)
		#literalCountOf: (sqInt )
		#methodArgumentCount (void)
		#methodPrimitiveIndex (void)
		#primitiveIndexOf: (sqInt )
		#sizeOfSTArrayFromCPrimitive: (voidPtr)
		#slotSizeOf: (sqInt )
		#stObject:at: (sqInt   sqInt )
		#stObject:at:put: (sqInt   sqInt   sqInt)
		#stSizeOf: (sqInt)
		#storeInteger:ofObject:withValue: (sqInt   sqInt   sqInt )
		#storePointer:ofObject:withValue: (sqInt   sqInt   sqInt )

		" InterpreterProxy methodsFor: 'testing' "

		#is:KindOf: (sqInt   charPtr)
		#is:MemberOf: (sqInt charPtr)
		#isBytes: (sqInt )
		#isFloatObject: (sqInt )
		#isIndexable: (sqInt )
		#isIntegerObject: (sqInt )
		#isIntegerValue: (sqInt )
		#isPointers: (sqInt )
		#isWeak: (sqInt )
		#isWords: (sqInt )
		#isWordsOrBytes: (sqInt )

		" InterpreterProxy methodsFor: 'converting' "

		#booleanValueOf: (sqInt )
		#checkedIntegerValueOf: (sqInt )
		#floatObjectOf: (double )
		#floatValueOf: (sqInt )
		#integerObjectOf: (sqInt )
		#integerValueOf: (sqInt )
		#positive32BitIntegerFor: (sqInt )
		#positive32BitValueOf: (sqInt )

		" InterpreterProxy methodsFor: 'special objects' "

		#characterTable (void)
		#displayObject (void)
		#falseObject (void)
		#nilObject (void)
		#trueObject (void)

		" InterpreterProxy methodsFor: 'special classes' "

		#classArray (void)
		#classBitmap (void)
		#classByteArray (void)
		#classCharacter (void)
		#classFloat (void)
		#classLargePositiveInteger (void)
		#classPoint (void)
		#classSemaphore (void)
		#classSmallInteger (void)
		#classString (void)

		" InterpreterProxy methodsFor: 'instance creation' "

		#clone: (sqInt )
		#instantiateClass:indexableSize: (sqInt   sqInt )
		#makePointwithxValue:yValue: (sqInt   sqInt )
		#popRemappableOop (void)
		#pushRemappableOop: (sqInt )

		" InterpreterProxy methodsFor: 'other' "

		#become:with: (sqInt   sqInt )
		#byteSwapped: (sqInt)
		#failed (void)
		#fullDisplayUpdate (void)
		#fullGC (void)
		#incrementalGC (void)
		#primitiveFail (void)
		#showDisplayBits:Left:Top:Right:Bottom: (sqInt   sqInt  sqInt  sqInt  sqInt)
		#signalSemaphoreWithIndex: (sqInt)
		#success: (sqInt )
		#superclassOf: (sqInt )

		" InterpreterProxy methodsFor: 'compiler' "

		#compilerHookVector (void)
		#setCompilerInitialized: (sqInt )

		" VM_PROXY_MINOR > 1 "
		2
		" InterpreterProxy methodsFor: 'BitBlt support' "

		#loadBitBltFrom: (sqInt )
		#copyBits (void)
		#copyBitsFrom:to:at: (sqInt   sqInt   sqInt )

		" VM_PROXY_MINOR > 2 "
		3
		#classLargeNegativeInteger (void)
		#signed32BitIntegerFor: (sqInt )
		#signed32BitValueOf: (sqInt )
		#includesBehavior:ThatOf: (sqInt   sqInt )
		#primitiveMethod (void)

		" InterpreterProxy methodsFor: 'FFI support' "
		#classExternalAddress (void)
		#classExternalData (void)
		#classExternalFunction (void)
		#classExternalLibrary (void)
		#classExternalStructure (void)
		#ioLoadModule:OfLength: (sqInt sqInt)
		#ioLoadSymbol:OfLength:FromModule: (sqInt   sqInt   sqInt )
		#isInMemory: (sqInt )

		" VM_PROXY_MINOR > 3 "
		4
		#ioLoadFunction:From: (charPtr charPtr)
		#ioMicroMSecs (void)

		" VM_PROXY_MINOR > 4 "
		5
		#positive64BitIntegerFor: (sqLong)
		#positive64BitValueOf: (sqInt)
		#signed64BitIntegerFor: (sqLong)
		#signed64BitValueOf: (sqInt)

		" VM_PROXY_MINOR > 5 "
		6
		#isArray: (sqInt )
		#forceInterruptCheck (void)


		" VM_PROXY_MINOR > 6 "
		7
		#fetchLong32:ofObject: (sqInt  sqInt)
		#getThisSessionID (void)
		#ioFilename:fromString:ofLength:resolveAliases: (charPtr charPtr sqInt sqInt)
		#vmEndianness (void)

		8
		" New methods for proxy version 1.8 "
			
		callbackEnter: (sqIntPtr)
		callbackLeave: (sqInt)
		addGCRoot: (sqIntPtr)
		removeGCRoot: (sqIntPtr)

		9

		primitiveFailFor: (sqInt code)
		setInterruptCheckChain: (void * aFunction )

		classAlien (void)
		classUnsafeAlien (void)
		sendInvokeCallback:Stack:Registers:Jmpbuf: (sqInt thunkPtrAsInt, sqInt stackPtrAsInt, sqInt regsPtrAsInt, sqInt jmpBufPtrAsInt)
		reestablishContextPriorToCallback: (sqInt callbackContext)
		getStackPointer (void)
		internalIsImmutable: (sqInt oop)
		internalIsMutable: (sqInt oop)

		10
		methodArg:  (sqInt index)
		objectArg:  (sqInt index)
		integerArg: (sqInt index)
		floatArg:   (sqInt index)
		methodReturnValue: (sqInt oop)
		topRemappableOop  (void)

		11

		disownVM: (sqInt flags)
		ownVM:   (sqInt threadIdAndFlags)
		addHighPriorityTickee:period: (void ticker (void), unsigned periodms)
		addSynchronousTickee:period:round: (void ticker (void), unsigned periodms, unsigned roundms)
		utcMicroseconds (void)
		tenuringIncrementalGC (void)
		isYoung: (sqInt anOop)
		isKindOf:Class: (sqInt oop, sqInt aClass)
		primitiveErrorTable (void)
		primitiveFailureCode (void)
		instanceSizeOf: (sqInt aClass)
	)
! !

!NBInterpreterProxy class methodsFor: 'options' stamp: 'Igor.Stasenko 5/19/2010 13:02'!
defaultOptions
	"Default options for proxy.
	Proxy options is applied before default options of generator,
	so generator can override them"

	^ #(
	"call proxy functions directly, instead of loading their address indirectly via interpreterProxy struct"
	#optDirectProxyFnAddress
		
	"use a direct ST stack pointer, initially retrieved using #getStackPointer"	
	 #optUseStackPointer 
	
	)
! !

!NBInterpreterProxy class methodsFor: 'accessing functions' stamp: 'IgorStasenko 11/24/2012 17:19'!
minorVersion
	"retrieve an interpreter proxy structure minor version value"

	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout
		options: #(
			"do not use interpreterProxy address directly"
			 - optDirectProxyFnAddress 
			"do not align stack for FFI call"
			+ optNoAlignment ); 
		function: #(short ()) emit: [:gen | 
			gen proxy minorVersion
		] ! !

!NBInterpreterProxy class methodsFor: 'accessing functions' stamp: 'CamilloBruni 8/3/2012 17:21'!
framePointerAddress

	"to prevent recursion, we prohibit using stack pointer address when bootstrapping"
	NativeBoost forCurrentPlatform isBootstrapping ifTrue: [ ^ nil ].
	
	^ self primFramePointerAddress ! !

!NBInterpreterProxy class methodsFor: 'accessing functions' stamp: 'CamilloBruni 8/3/2012 18:26'!
cFramePointerAddress

	"to prevent recursion, we prohibit using stack pointer address when bootstrapping"
	NativeBoost forCurrentPlatform isBootstrapping ifTrue: [ ^ nil ].
	
	^ NativeBoost loadSymbol: #CFramePointer ! !

!NBInterpreterProxy class methodsFor: 'accessing functions' stamp: 'Igor.Stasenko 5/3/2010 10:36'!
fnAddressAt: index
	"retrieve an interpreter proxy function address
	at given zero-based index.
	
	(self functions at: #minorVersion) address
	"
	index isString ifTrue: [ ^ self fnAddressAt: (self functions at: index) index ].
	^ NativeBoost ulongAt: self interpreterProxyAddress + (4 * index)
	! !

!NBInterpreterProxy class methodsFor: 'debugging' stamp: 'Igor.Stasenko 4/16/2010 03:31'!
fnSelectorAt: offset
" NBInterpreterProxy fnSelectorAt: 16r130 "
	^ (self functionAtOffset: offset) selector! !

!NBInterpreterProxy class methodsFor: 'class initialization' stamp: 'Igor.Stasenko 9/29/2010 09:22'!
generateFunctions
	" self generateFunctions   "
	
	Functions := self generateFunctionsFrom: self proxyFunctionsData.

	"checked using compiler on 32bits"
	self assert: (Functions at: #vmEndianness) index * 4 = 456.
	
	CogFunctions := self generateFunctionsFrom: self CogProxyFunctionsData.! !

!NBInterpreterProxy class methodsFor: 'accessing functions' stamp: 'Igor.Stasenko 5/2/2010 08:34'!
interpreterProxyAddress

	<primitive: #primitiveGetInterpreterProxy module: #NativeBoostPlugin> 

	^ self primitiveFailed! !

!NBInterpreterProxy class methodsFor: 'instance creation' stamp: 'Igor.Stasenko 5/1/2010 11:46'!
forGenerator: aNativeCodeGenerator

	^ self basicNew initialize generator: aNativeCodeGenerator! !

!NBInterpreterProxy class methodsFor: 'accessing functions' stamp: 'IgorStasenko 11/24/2012 17:20'!
primFramePointerAddress
	"retrieve a stack pointer address"

	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin' error: errorCode>

	^ self nbCallout function: #(uint ()) emit: [:gen :proxy :asm | | fn | 
			fn :=  [ (NativeBoost forCurrentPlatform 
						loadSymbol: 'framePointerAddress' fromModule: '') ] ifError: [ nil ].
			fn ifNil: [ ^ nil ]. "just for safety" 

			asm 
				mov: fn asUImm32 to: asm EAX;			
				call: EAX.
		].! !

!NBInterpreterProxy class methodsFor: 'class initialization' stamp: 'IgorStasenko 8/3/2011 09:08'!
initialize
	"self initialize"
	self generateFunctions! !

!NBInterpreterProxy class methodsFor: 'accessing functions' stamp: 'IgorStasenko 5/28/2012 05:18'!
stackPointerAddress

	"to prevent recursion, we prohibit using stack pointer address when bootstrapping"
	NativeBoost forCurrentPlatform isBootstrapping ifTrue: [ ^ nil ].
	
	^ self primStackPointerAddress ! !

!NBInterpreterProxy class methodsFor: 'class initialization' stamp: 'IgorStasenko 8/3/2011 07:36'!
generateFunctionsFrom: data
	| i stream minorV functions |
	
	functions := IdentityDictionary new.
	
	i := 0.
	stream := data readStream.
	minorV := 0.
	[ stream atEnd ] whileFalse: [ | val |
		val := stream next.
		val isInteger ifTrue: [ minorV := val ]
			ifFalse: [
				(functions includesKey: val) ifTrue: [ self error: 'duplicated function!!!!' ].
				functions at: val put: (
					NBProxyFunction new selector: val; parseArguments: stream next; index: i; 
					majorVersion: 1; minorVersion: minorV;	requiresAlignment: (self safeNoAlignFunctions includes: val) not; yourself ).
				i := i + 1. ]
	].
	^ functions! !

!NBInterpreterProxy class methodsFor: 'instance creation' stamp: 'Igor.Stasenko 5/1/2010 11:46'!
new
	self error: 'Use #forGenerator: '! !

!NBInterpreterProxy class methodsFor: 'accessing functions' stamp: 'IgorStasenko 2/8/2013 12:59'!
primStackPointerAddress
	"retrieve a stack pointer address"

	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin' error: errorCode>

	^ self nbCallout function: #(uint ()) emit: [:gen :proxy :asm | | fn | 
			fn :=  [ (NativeBoost loadSymbol: 'stackPointerAddress' fromModule: NativeBoost VMModule) ] ifError: [ nil ].
			fn ifNil: [ ^ nil ]. "just for safety" 

			asm 
				mov: fn asUImm32 to: asm EAX;			
				call: EAX.
		].! !

!NBInterpreterProxy class methodsFor: 'class initialization' stamp: 'CamilloBruni 7/18/2012 14:41'!
safeNoAlignFunctions

	"list of functions which is safe to call without stack alignment"
	
	^ #(
		minorVersion
		majorVersion
		failed
		primitiveMethod
		getStackPointer
		stackValue:
		primitiveFail
		nilObject
		trueObject
		falseObject
		methodArgumentCount
	)! !

!NBInterpreterProxy class methodsFor: 'debugging' stamp: 'Igor.Stasenko 9/29/2010 09:26'!
functionAtOffset: offset
	| index |
	index := offset / 4.
	^ self functions detect: [:fn | fn index = index ]
! !

!NBInterpreterProxy class methodsFor: 'accessing' stamp: 'IgorStasenko 11/23/2011 10:44'!
functions
	" choose a set of interprterProxy functions, depending on VM we're currently running on"
	^ (Smalltalk vm version beginsWith: 'Squeak') 
		ifTrue: [	Functions ]
		ifFalse: [ CogFunctions ]! !

!NBInterpreterProxy class methodsFor: 'accessing functions' stamp: 'IgorStasenko 11/24/2012 17:19'!
majorVersion
	"retrieve an interpreter proxy structure major version value"

	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout
		options: #(
			"do not use interpreterProxy address directly"
			 - optDirectProxyFnAddress 
			"do not align stack for FFI call"
			+ optNoAlignment );
			 
		function: #(short ()) emit: [:gen | 
			gen proxy majorVersion
		] ! !

!NBInterpreterProxyTest methodsFor: 'tests' stamp: 'MarcusDenker 4/10/2015 13:09'!
testStackPointer

	Smalltalk os isWindows ifTrue: [ self skip ].
	self assert: self primCheckStackPointer=0
	! !

!NBInterpreterProxyTest methodsFor: 'tests' stamp: 'MarcusDenker 4/10/2015 13:09'!
testStackPointer2

	Smalltalk os isWindows ifTrue: [ self skip ].
	self assert: self primCheckStackPointer2=0
	! !

!NBInterpreterProxyTest methodsFor: 'primitives' stamp: 'IgorStasenko 11/24/2012 17:21'!
primCheckStackPointer2
	"should answer 0"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCallout
		function: #(uint () ) 
		emit: [:gen :proxy :asm | 
			| get |
			proxy getStackPointer.
			asm 
				mov: NBInterpreterProxy stackPointerAddress asUImm32 ptr32 to: asm ECX;
				sub: asm EAX with: asm ECX
		] ! !

!NBInterpreterProxyTest methodsFor: 'primitives' stamp: 'IgorStasenko 11/24/2012 17:20'!
primCheckStackPointer
	"should answer 0"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self nbCallout function: #(uint () ) emit: [:gen :proxy :asm | 
		| get |
		proxy getStackPointer.
		asm 
			mov: NBInterpreterProxy stackPointerAddress asUImm32 to: asm ECX;
		 	mov: asm ECX ptr to: asm ECX;
			sub: asm EAX with: asm ECX
	] ! !

!NBMacConstants class methodsFor: 'initialization' stamp: 'IgorStasenko 11/18/2012 17:08'!
initialize

	RTLD_LAZY := 16r1.
	RTLD_NOW := 16r2.
	RTLD_LOCAL := 16r4.
	RTLD_GLOBAL := 16r8.
	
	RTLD_NOLOAD := 16r10.
	RTLD_NODELETE := 16r80.
	RTLD_FIRST := 16r100.  " Mac OS X 10.5 and later "
	

	RTLD_NEXT := -1 . " ((void *) -1) Search subsequent objects. "
	RTLD_DEFAULT := -2. " ((void *) -2) Use default search algorithm. "
	RTLD_SELF := -3. " ((void *) -3)  Search this and subsequent objects (Mac OS X 10.5 and later) "
	RTLD_MAIN_ONLY := -5. " ((void *) -5)  Search main executable only (Mac OS X 10.5 and later)"

	self initMmapflags.
	! !

!NBMacConstants class methodsFor: 'initialization' stamp: 'Igor.Stasenko 12/5/2010 19:18'!
initMmapflags

	PROT_READ := 16r1.	" Page can be read.  "
	PROT_WRITE := 16r2.	" Page can be written. "
	PROT_EXEC := 16r4.	" Page can be executed. "
	PROT_NONE := 16r0. 	" Page can not be accessed. "

	MAP_FILE := 0. " map from file (default) "
	MAP_ANON := 16r1000. " allocated from memory, swap space "
	
	" Flags contain sharing type and options.
 	Sharing types; choose one."
	
	MAP_SHARED := 16r0001. " [MF|SHM] share changes"
	MAP_PRIVATE := 16r0002. " [MF|SHM] changes are private"
	MAP_COPY  := MAP_PRIVATE.

	MAP_FIXED := 16r0010. " [MF|SHM] interpret addr exactly "
	
	MAP_RENAME := 16r0020. " Sun: rename private pages to file "
	MAP_NORESERVE := 16r0040. " Sun: don't reserve needed swap area "
	MAP_RESERVED0080 := 16r0080. " previously unimplemented MAP_INHERIT "
	MAP_NOEXTEND := 16r0100. " for MAP_FILE, don't change file size "
	MAP_HASSEMAPHORE := 16r0200. " region may contain semaphores "
	MAP_NOCACHE := 16r0400. " don't cache pages for this mapping "

	MAP_FAILED := -1 asImm asDWord.! !

!NBMacExternalHeapManager methodsFor: 'memory management' stamp: 'Igor.Stasenko 12/5/2010 19:19'!
primAllocatePage: bytesToAllocate
	| ptr buf |

	buf := ByteArray new: 4.

	self 
		mmapLength: bytesToAllocate 
		prot: self protFlags 
		flags: self mapFlags 
		into: buf.

	ptr := buf unsignedLongAt: 1 bigEndian: false.
	ptr = MAP_FAILED ifTrue: [ self error: 'Unable to map virtual memory' ].
	
	^ ptr

 ! !

!NBMacExternalHeapManager methodsFor: 'private' stamp: 'IgorStasenko 11/24/2012 17:22'!
mmapLength: bytesToAllocate prot: protFlags flags: mapFlags into: returnValueBuffer
		
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>

	"Note:  mmap using 32-bit offset, while mmap64 - 64bit one"

	^ self nbCallout 
		options: #( - optDirectProxyFnAddress );
		function: #(
			NBBootstrapUlong ( 0, uint bytesToAllocate, int protFlags, int mapFlags,
				-1,  0 "offset" )) 
		emit:  [:gen | | mmap |
			mmap := NativeBoost forCurrentPlatform getGlobalSymbolPointer: 'mmap'.
			gen asm mov: mmap asUImm32 to: gen asm EAX.
			gen asm call: gen asm EAX ]

 ! !

!NBMacExternalHeapManager methodsFor: 'flags' stamp: 'Igor.Stasenko 12/5/2010 19:13'!
mapFlags

	^ MAP_ANON bitOr: MAP_PRIVATE! !

!NBMacExternalHeapManager methodsFor: 'flags' stamp: 'Igor.Stasenko 12/5/2010 18:36'!
protFlags
	"since NativeBoost using heap for placing executable code there,
	it is important that all allocated memory should be executable"
	^  (PROT_READ bitOr: PROT_WRITE) bitOr: PROT_EXEC! !

!NBMacExternalHeapManager methodsFor: 'memory management' stamp: 'Igor.Stasenko 12/5/2010 19:19'!
primFreePage: aMemoryPage

	"call munmap()"

	| res |
	res := self unmap: aMemoryPage address length: aMemoryPage length.
	res = 0 ifFalse: [ self error: 'error during unmapping virtual memory page' ]! !

!NBMacExternalHeapManager methodsFor: 'private' stamp: 'IgorStasenko 11/24/2012 17:22'!
unmap: addr  length: len 
		
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>

	"unmap memory page"

	^ self nbCallout
		function: #( int munmap (uint addr, ulong  len)  ) 
		module: RTLD_DEFAULT
 ! !

!NBMacShell commentStamp: 'SeanDeNigris 3/28/2014 12:48'!
I represent the Mac shell. As a beginning, I can execute simple system calls.!
!NBMacShell class methodsFor: 'system' stamp: 'SeanDeNigris 3/28/2014 11:41'!
run: commandString
	"self run: 'open http://www.google.com'."

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode >
	^ self nbCall: #( int system (String commandString) ) module: NativeBoost CLibrary ! !

!NBMacShell class methodsFor: 'mac commands' stamp: 'SeanDeNigris 3/28/2014 12:16'!
open: aString
	"self open: 'http://www.google.com'"

	| openCommand |
	openCommand := 'open "{1}"' format: { aString }.
	self run: openCommand.! !

!NBMacSpecificTest methodsFor: 'tests' stamp: 'SeanDeNigris 3/28/2014 11:54'!
testSystemCall

	self flag: 'The result goes to stdout. Can we capture it?'.
	self 
		assert: (NBMacShell run: 'expr 1 + 1')
		equals: 0.! !

!NBMacSpecificTest class methodsFor: 'testing' stamp: 'TorstenBergmann 8/7/2013 12:11'!
isAbstract
  	"only run test subclasses on Mac"
	
	^(self name = #NBMacSpecificTest)
		or: [ OSPlatform isMacOS not ]! !

!NBMemoryBlock methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/24/2010 04:29'!
length: aValue

	length := aValue! !

!NBMemoryBlock methodsFor: 'memory operations' stamp: 'Igor.Stasenko 9/24/2010 23:20'!
reserve: numBytes for: heapManager
	"reserve a given number of bytes of memory
	if numBytes < length, then create a smaller block with free memory"
	| leftover |
	self assert: free.
	numBytes > length ifTrue: [ self error: 'can''t reserve more than length of block' ].
	heapManager removeFreeBlock: self.
	numBytes = length ifTrue: [ free := false. ^ self ].
	
	leftover := 
		NBMemoryBlock new
			address: address + numBytes;
			length: length - numBytes;
			left: self; 
			right: right.
	right := leftover.
	length := numBytes.
	free := false.
	heapManager addFreeBlock: leftover.
! !

!NBMemoryBlock methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/22/2010 04:17'!
isFree
	^ free! !

!NBMemoryBlock methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/22/2010 04:43'!
right: anObject

	right := anObject! !

!NBMemoryBlock methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/22/2010 04:43'!
left

	^left! !

!NBMemoryBlock methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/22/2010 04:43'!
address

	^address! !

!NBMemoryBlock methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/22/2010 04:43'!
address: anObject

	address := anObject! !

!NBMemoryBlock methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/22/2010 04:43'!
right

	^right! !

!NBMemoryBlock methodsFor: 'initialization' stamp: 'Igor.Stasenko 9/22/2010 04:38'!
initialize
	free := true! !

!NBMemoryBlock methodsFor: 'printing' stamp: 'Igor.Stasenko 9/26/2010 03:59'!
printOn: aStream

	super printOn: aStream.
	
	aStream 
		nextPutAll: '( @ 16r';
		nextPutAll: (address printStringBase: 16);
		nextPutAll: ', ';
		print: length.
		
	free ifTrue: [ aStream nextPutAll: ', free' ].
	
	aStream nextPut: $)! !

!NBMemoryBlock methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/22/2010 04:43'!
left: anObject

	left := anObject! !

!NBMemoryBlock methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/22/2010 04:43'!
length

	^length! !

!NBMemoryBlock methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/25/2010 00:46'!
makeFreeFor: heapManager
	"mark receiver as free and merge with adjusted blocks, if they also free"

	free := true.
	
	(right notNil and: [right isFree]) ifTrue: [
		length := length + right length.
		heapManager removeFreeBlock: right.
		right := right right.
		].
	
	(left notNil and: [ left isFree ]) 
		ifTrue: [ left length: (left length + length). left right: right.
			heapManager checkForFreePage: left
			 ]
		ifFalse: [ heapManager addFreeBlock: self ].! !

!NBMemoryPage methodsFor: 'as yet unclassified' stamp: 'Igor.Stasenko 9/25/2010 00:21'!
length
	^ length! !

!NBMemoryPage methodsFor: 'initialize-release' stamp: 'Igor.Stasenko 9/24/2010 23:41'!
address: addr length: len

	address := addr.
	length := len.
	initialBlock := NBMemoryBlock new address: addr; length: len! !

!NBMemoryPage methodsFor: 'as yet unclassified' stamp: 'Igor.Stasenko 9/25/2010 00:32'!
address
	^ address! !

!NBMemoryPage methodsFor: 'as yet unclassified' stamp: 'Igor.Stasenko 9/24/2010 23:19'!
totalAllocatedMemory

	| blk total |
	
	blk := initialBlock.
	total := 0.
	[ blk notNil ] whileTrue: [
		blk isFree ifFalse: [ total := total + blk length ].
		blk := blk right.
		].
	^ total! !

!NBMemoryPage methodsFor: 'as yet unclassified' stamp: 'Igor.Stasenko 9/25/2010 00:08'!
firstBlock
	^ initialBlock! !

!NBMemoryPage class methodsFor: 'instance creation' stamp: 'Igor.Stasenko 9/24/2010 23:42'!
address: addr length: len

	^ self basicNew address: addr length: len! !

!NBMockExternalHeapManager methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/25/2010 00:20'!
primAllocatePage: numBytes

	^ 0! !

!NBMockExternalHeapManager methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/25/2010 00:21'!
primFreePage: aMemoryPage

	^ 0! !

!NBMockExternalObject methodsFor: 'accessing' stamp: 'IgorStasenko 8/24/2012 17:05'!
data: anObject
	data := anObject! !

!NBMockExternalObject methodsFor: 'accessing' stamp: 'IgorStasenko 8/24/2012 17:05'!
resourceData
	^ data! !

!NBMockExternalObject class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/24/2012 17:18'!
finalizeResourceData: object

	object value! !

!NBNativeCodeError methodsFor: 'accessing' stamp: 'IgorStasenko 8/6/2011 18:17'!
errorCode
	^ errorCode! !

!NBNativeCodeError methodsFor: 'accessing' stamp: 'IgorStasenko 2/20/2012 13:04'!
signalError: error
	"set error/code and signal it"
	(errorCode := error) isSymbol 
		ifTrue: [
			" some errors produced by VM translated to symbols. we unifying it here to draw better description from our pool (see
			NativeBoostConstants class>> #initErrorDescriptions )"
			errorCode := ((Smalltalk specialObjectsArray at: 52) indexOf: error ifAbsent: [ ^self signal: self description ]) -1
		].
	
	^ self signal: self description! !

!NBNativeCodeError methodsFor: 'accessing' stamp: 'IgorStasenko 2/20/2012 13:46'!
description

	^ NBErrorDescriptions at: errorCode ifAbsent: [
		'Error during execution of native code: ' , errorCode asString].
	
! !

!NBNativeCodeError class methodsFor: 'signalling' stamp: 'IgorStasenko 8/6/2011 17:48'!
signalError: error
	^ self new signalError: error! !

!NBNativeCodeGen commentStamp: 'IgorStasenko 2/15/2012 19:49'!
I providing a basic interface for use a dynamically generated native code with NativeBoost plugin using #primitiveNativeCall.
On my class side, you can find the interface to help managing native code, as well as basic functionality for dealing with it at run time. 

My instance serves as a helper to access common facilities used for code generation: 
 - assembler
 - interpreter proxy

i do not provide anything beyond that, so you still basically on you own, and must use assembler and interpreter proxy for implementing a low-level funcitonality
in your code (like new primitive, new function etc)

Instance Variables:
	asm							: An object that is used to generate native code
	proxy	<NBInterpreterProxy> : An object providing an access to public VM interface: like fetching a var from smalltalk stack, accessing object's internals, etc.
	options	<Collection>   : A set of options which generated code may use 
	method 	: a compiled method instance where native code will be installed to, (of course in case if my instance used for generating code to be installed there,
		and if not, it can be ignored)
		
Usage:

My most simple use is in a form: 

myMethod
 <primitive: #pritmiveNativeCall module: #NativeBoostPlugin>
  ^ NBNativeCodeGen methodAssembly: [:gen |
	 "here you put an instructions or provide own machine code.
	a block should answer a bytearray, which should contain ready for use machine code"
	]

In case, if you want to use different top-level interface, like in order to write something like following:

myMethod
 <primitive: #pritmiveNativeCall module: #NativeBoostPlugin>
  ^ self myCode: [
	 "here you put an instructions or provide own machine code"
	]

You can use #handleFailureIn:nativeCode: method , which takes care of handling primitive failure, dealing with errors and 
finally installing native code, which you providing, into corresponding method.

!
!NBNativeCodeGen methodsFor: 'retrieving the code' stamp: 'Igor.Stasenko 4/25/2010 01:05'!
dumpBytes
	^ String streamContents: [:str |
		self bytes do: [:b | str nextPutAll: (b printStringBase: 16); space ]
		]
! !

!NBNativeCodeGen methodsFor: 'options' stamp: 'Igor.Stasenko 5/1/2010 10:18'!
defaultOptions

	^ self class defaultOptions! !

!NBNativeCodeGen methodsFor: 'initialize-release' stamp: 'HenrikSperreJohansen 8/23/2011 22:09'!
setMethod: aMethod
	method := aMethod

! !

!NBNativeCodeGen methodsFor: 'accessing' stamp: 'IgorStasenko 8/10/2011 15:08'!
stackAlignment

	^ self utils stackAlignment ! !

!NBNativeCodeGen methodsFor: 'options' stamp: 'HenrikSperreJohansen 6/24/2014 16:28'!
optionAt: optionName
	^ options at: optionName ifAbsent: false! !

!NBNativeCodeGen methodsFor: 'code generation' stamp: 'Igor.Stasenko 5/2/2010 13:03'!
emitFetchClass: aClass
	"emit code, which fetching the class oop into EAX"
	^  NativeBoost extraRootsRegistry emitFetchClass: aClass generator: self ! !

!NBNativeCodeGen methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 8/23/2011 22:08'!
method
	^method! !

!NBNativeCodeGen methodsFor: 'accessing' stamp: 'IgorStasenko 8/10/2011 15:08'!
utils
	^ NativeBoost forCurrentPlatform! !

!NBNativeCodeGen methodsFor: 'code generation' stamp: 'Igor.Stasenko 4/28/2010 13:48'!
reserveStackBytes: numBytesOrBlock andStoreAddrTo: aTemp

	"emit code to reserve a given number of bytes, answer the temp,
	which will hold an allocated block address "
	
	| numBytes |

	numBytes := numBytesOrBlock. 
	numBytesOrBlock isBlock ifTrue: [ numBytes := numBytesOrBlock value: self ].
	
	numBytes = EAX ifFalse: [
		asm mov: numBytes to: EAX ].
	
	"align stack to 4-bytes (will waste 4 bytes if its already aligned)"
	asm
		or: EAX with: 3;
		inc: EAX	;
		sub: ESP with: EAX;
		mov: ESP to: aTemp.  "store the allocated space start into a temp"
	^ aTemp
! !

!NBNativeCodeGen methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/1/2010 10:27'!
proxy
	^ proxy! !

!NBNativeCodeGen methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/11/2010 09:04'!
asm

	^ asm! !

!NBNativeCodeGen methodsFor: 'options' stamp: 'HenrikSperreJohansen 6/24/2014 16:28'!
doesNotUnderstand: message
	(message selector beginsWith: 'opt')
		ifTrue: [ ^ options at: message selector ifAbsent: false ].
	^ super doesNotUnderstand: message! !

!NBNativeCodeGen methodsFor: 'initialization' stamp: 'HenrikSperreJohansen 6/24/2014 16:24'!
initialize
	asm := self newAssembler.
	options := Dictionary new.
	proxy := NBInterpreterProxy forGenerator: self. 
	self parseOptions: self defaultOptions.

! !

!NBNativeCodeGen methodsFor: 'code generation' stamp: 'IgorStasenko 8/5/2011 07:38'!
reserveStackBytes: numBytesOrBlock

	"emit code to reserve a given number of bytes, answer the temp,
	which will hold an allocated block address "
	
	| address |
	address := self reserveTemp.
	^ self reserveStackBytes: numBytesOrBlock andStoreAddrTo: address! !

!NBNativeCodeGen methodsFor: 'accessing' stamp: 'IgorStasenko 5/7/2011 21:27'!
newAssembler

	^ NativeBoost newAssembler 
! !

!NBNativeCodeGen methodsFor: 'options' stamp: 'HenrikSperreJohansen 6/24/2014 17:06'!
parseOptions: optionsArray
	"parse an array, which is a sequence of options in a form of: 
	
	#( + option1 option2 option3: param3  - option5 -option6: ... )
	
	each time the #+ is seen, the options which follow it will be subject for inclusion
	and, correspondingly, if #- seen, then they will be excluded	.

	By default, (if none of #+ or #- specified initially), all options are subject for inclusion.
	
	If in inclusion mode, non-unary options will put the following element as its unary symbols counterparts value, rather than true.
	"

	| include option rs |
	include := true.
	rs := optionsArray readStream.
	[(option := rs next) isNil]
		whileFalse: [ 
			option
				caseOf:
					{(#+ -> [ include := true ]).
					(#- -> [ include := false ])}
				otherwise: [ 
					(option beginsWith: 'opt') not
						ifTrue: [ ^ self error: 'Invalid option name ' , option , ', must begin with ''opt''' ].
					option numArgs > 1
						ifTrue: [ ^ self error: 'Does not support setting options with more than one parameter' ].
					options at: (option allButLast: option numArgs) asSymbol put: (include and: [ option isUnary or: [ rs next ] ]) ] ]! !

!NBNativeCodeGen methodsFor: 'retrieving the code' stamp: 'IgorStasenko 8/3/2011 20:08'!
bytes
	^ self generatedCode bytes! !

!NBNativeCodeGen methodsFor: 'temporaries' stamp: 'IgorStasenko 5/9/2011 12:55'!
releaseTemps: count
	asm releaseTemps: count! !

!NBNativeCodeGen methodsFor: 'temporaries' stamp: 'IgorStasenko 5/9/2011 12:55'!
reserveTemp
	^ asm reserveTemp! !

!NBNativeCodeGen methodsFor: 'retrieving the code' stamp: 'IgorStasenko 8/3/2011 20:15'!
generatedCode

	proxy usedGate ifTrue: [
		asm reserveExtraBytesOnStack: asm wordSize*2.
		].
	
	self optDebug ifTrue: [ self halt. ].

	^ asm generatedCode.
! !

!NBNativeCodeGen methodsFor: 'code generation' stamp: 'CamilloBruni 7/23/2012 16:40'!
epilogue

	asm emitEpilogue: 0. ! !

!NBNativeCodeGen class methodsFor: 'instance creation' stamp: 'HenrikSperreJohansen 8/23/2011 22:10'!
newForMethod: aMethod
	^self new setMethod: aMethod! !

!NBNativeCodeGen class methodsFor: 'error handling' stamp: 'IgorStasenko 7/12/2013 16:38'!
getErrorFrom: aContext lastError: errorCode
	| lastError method |
	lastError := errorCode.
	method := aContext method.

	"Check that method has a #primitiveNativeCall, since it required by generator, and sometimes you can forget putting primitive pragma"
	(method primitive = 220 or: [ method hasNativeCallPrimitive])
		ifFalse: [ ^ ErrNoNBPrimitive ].
		
	"Check if method using an extended primitive pragma (introduced in Cog), 
	otherwise we just take an errorCode"
	(method pragmas anySatisfy: [:p | p keyword == #primitive:module:error: ])
	ifTrue: [
		"A primitive error is always the last temp (ensured by compiler) "
		lastError := aContext  tempAt: method numTemps. 
	].
	
	lastError = ErrNotEnabled ifTrue: [
		"If we cannot enable it, report an error..."
		NativeBoost enableNativeCode ifFalse: [ ^ NBNativeCodeError signal: 'Cannot enable native code execution' ].
	
		" Fake absence of native code, so then code generator will generate code and retry the call.
		Note that if you want to keep native code forever (generated once and kept forever as long as method exists), you might want to override this"
		
		lastError := ErrNoNativeCodeInMethod ].

	^ lastError ! !

!NBNativeCodeGen class methodsFor: 'debugging' stamp: 'Igor.Stasenko 4/28/2010 18:13'!
debugOff

	DebugOn := false! !

!NBNativeCodeGen class methodsFor: 'options' stamp: ''!
defaultOptions

	^ #() ! !

!NBNativeCodeGen class methodsFor: 'public API' stamp: 'CamilloBruni 10/4/2012 10:37'!
jitMethodAssembly: aBlock
	"This method will directly inline the nativecode in the jited
	method thus eliminating the overhead of running through the 
	whole primitive activation each time the method is invoked.
	Unlike in the cdecl style NativeBoost code generation the return
	value is passed in EDX and not in EAX."
	^ self handleFailureInJit: thisContext sender nativeCode:
		[:gen | aBlock cull: gen cull: gen proxy cull: gen asm. gen bytes ]
! !

!NBNativeCodeGen class methodsFor: 'error handling' stamp: 'IgorStasenko 2/20/2012 13:48'!
handleFailureIn: aContext nativeCode: aBlock

	| method lastError |

	"Note: make sure that #lastError are sent first, no guarantee that we won't be preempted before
	but this is best we can do if method is not using extended primitive pragma with error code"
	
	lastError := self getErrorFrom: aContext lastError: NativeBoost lastError.
	method := aContext method.

	"install native code and retry the send"
	lastError = ErrNoNativeCodeInMethod
		ifTrue: [ ^ self generateCode: aBlock andRetry: aContext ].

	"ok, we're out of options, signal an error here"
	^ self signalError: lastError
! !

!NBNativeCodeGen class methodsFor: 'error handling' stamp: 'IgorStasenko 11/9/2012 04:12'!
handleFailureInJit: aContext nativeCode: aBlock

	| method lastError |

	"Note: make sure that #lastError are sent first, no guarantee that we won't be preempted before
	but this is best we can do if method is not using extended primitive pragma with error code"
	
	lastError := self getErrorFromJit: aContext.
	method := aContext method.

	lastError = ErrRunningViaInterpreter ifTrue: [
		"a method contains native code, but executed by interpreter "
		method forceJIT ifFalse: [ self error: 'Failed to JIT the compiled method. Try reducing it''s size ' ].
		^ self retrySend: aContext
		].
	"install native code and retry the send"
	(lastError = ErrNoNativeCodeInMethod or: [ lastError isNil ] )
		ifTrue: [ ^ self generateCode: aBlock andRetry: aContext ].

	"ok, we're out of options, signal an error here"
	^ self signalError: lastError
! !

!NBNativeCodeGen class methodsFor: 'public API' stamp: 'HenrikSperreJohansen 8/23/2011 02:34'!
methodAssembly: aBlock

	"We're get here from a method, which contains  a native code.
	There are following error cases:
	  - method does not contains a NativeBoost primitive
	  - method's native code platform id doesn't match the current platform id
	  - method having no native code generated yet
	  - a native code runs but caused primitive failure
	"
	
	^ self handleFailureIn: thisContext sender nativeCode:
		[:gen | aBlock cull: gen cull: gen proxy cull: gen asm. gen bytes ]
! !

!NBNativeCodeGen class methodsFor: 'error handling' stamp: 'IgorStasenko 2/20/2012 13:48'!
signalError: errorCode
	^ NBNativeCodeError signalError: errorCode
! !

!NBNativeCodeGen class methodsFor: 'debugging' stamp: 'Igor.Stasenko 5/2/2010 18:05'!
debugOn

	DebugOn := true! !

!NBNativeCodeGen class methodsFor: 'error handling' stamp: 'IgorStasenko 9/21/2012 15:48'!
getErrorFromJit: aContext
	| lastError method |
	method := aContext method.

	"Check that method has a primitive 220"
	(method primitive = self jitPrimitiveNumber)
		ifFalse: [ ^ ErrNoNBPrimitive ].

	(method pragmas anySatisfy: [:p | p keyword == #primitive:error: ])
	ifTrue: [
		"A primitive error is always the last temp (ensured by compiler) "
		lastError := aContext  tempAt: method numTemps. 
	] ifFalse: [ lastError := ErrInvalidPrimitiveVoltageUse ].

	^ lastError ! !

!NBNativeCodeGen class methodsFor: 'error handling' stamp: 'IgorStasenko 2/13/2012 14:50'!
assertIsNBMethod: aMethod

	"Check that method having a native-boost primitive"
	
	
		((aMethod primitive = 117) and: [  | lit |  lit := aMethod literalAt: 1. 
			lit first = #NativeBoostPlugin and: [ lit second == #primitiveNativeCall]]) ifFalse: [ ^NBNativeCodeError signalError: ErrNoNBPrimitive ].! !

!NBNativeCodeGen class methodsFor: 'managing methods' stamp: 'IgorStasenko 2/13/2012 14:21'!
installNativeCode: bytes into: method 

	"install a native code into a compiled method"

	"Installing/removing native code directly:
		In some cases user(s) may need it, like in case if  you want to update/flush/recompile generated code 
		for a number of methods due to some change in environment.
	
		For example, my class(es) might have a 'DeveloperMode' flag, which depending on its value may affect a generated code
		in order to do some additional checks at runtime (when turned on), and suppress them (when turned off). 
		And so, in order to switch between those modes, we need a way to flush native code in affected methods.

		Also, since a plugin having no way to determine who provided a native code, users may implement own code generators
		(or just load code from file/cache) instead of using facilities provided by NativeBoost. "
	
	
	| trailer newMethod |
	trailer := CompiledMethodTrailer new.

	trailer 
		nativeCode: bytes
		platformId: NativeBoost platformId 
		sourcePointer: method trailer sourcePointer.
	newMethod :=  method copyWithTrailerBytes: trailer.
	method methodClass methodDict at: method selector put: newMethod.

	^ newMethod
! !

!NBNativeCodeGen class methodsFor: 'instance creation' stamp: 'IgorStasenko 9/23/2012 04:31'!
generateCode: aBlock andRetry: retryCtx

	| method bytes newMethod args |

	method := retryCtx method.

	NBRecursionDetect in: method during: [ 
		bytes := aBlock value: (self newForMethod: method).
	].

	DebugOn == true ifTrue: [ 
		(FileStream newFileNamed: 'asm.bin') nextPutAll: bytes; close.
		self halt ].
	
	newMethod := self installNativeCode: bytes into: method.
	
	newMethod primitive = self jitPrimitiveNumber ifTrue: [ newMethod forceJIT ].
	^ self retrySend: retryCtx
! !

!NBNativeCodeGen class methodsFor: 'error handling' stamp: 'IgorStasenko 9/20/2012 14:48'!
jitPrimitiveNumber
	^ 220! !

!NBNativeCodeGen class methodsFor: 'managing methods' stamp: 'IgorStasenko 2/13/2012 14:21'!
removeNativeCodeFrom: method
	"Installing/removing native code directly:
		In some cases user(s) may need it, like in case if  you want to update/flush/recompile generated code 
		for a number of methods due to some change in environment.
	
		For example, my class(es) might have a 'DeveloperMode' flag, which depending on its value may affect a generated code
		in order to do some additional checks at runtime (when turned on), and suppress them (when turned off). 
		And so, in order to switch between those modes, we need a way to flush native code in affected methods.

		Also, since a plugin having no way to determine who provided a native code, users may implement own code generators
		(or just load code from file/cache) instead of using facilities provided by NativeBoost. "

	|trailer|
	trailer := method trailer.
	trailer kind == #NativeCodeTrailer ifTrue: [  "it _should_ be true.. but lets check to be sure"
		| newTrailer |
		newTrailer := CompiledMethodTrailer new sourcePointer: trailer sourcePointer.
			
		method isInstalled ifTrue: [
			method methodClass methodDict 
				at: method selector 
				put:  ( method copyWithTrailerBytes: newTrailer)
			]
	]! !

!NBNativeCodeGen class methodsFor: 'error handling' stamp: 'IgorStasenko 9/23/2012 03:38'!
retrySend: retryCtx

	| method args |

	method := retryCtx method.

	"just resending the same message"
	args := Array new: method numArgs.
	1 to: args size do: [ :i |  args at: i put: (retryCtx tempAt: i) ].

	thisContext terminateTo: retryCtx sender. 
	^ retryCtx receiver perform: method selector withArguments: args.
! !

!NBNativeCodeGen class methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/2/2010 13:34'!
nativeMethods
	" self nativeMethods "
	^ CompiledMethod allInstances select: [:m |
		m trailer kind = #NativeCodeTrailer 
		and: [ m isInstalled ] ]! !

!NBNativeFunction methodsFor: 'code generation' stamp: 'CamilloBruni 8/3/2012 16:17'!
valueWithArguments: anArray
	"call this native function with the given arguments"
	self shouldBeImplemented.! !

!NBNativeFunction methodsFor: 'code generation' stamp: 'CamilloBruni 10/4/2012 19:32'!
emitCall: asm
	" emit the asm code for calling myself "
	asm mov: (handle asUImm32 annotation: self annotation) to: asm EAX.
	asm call: asm EAX.! !

!NBNativeFunction methodsFor: 'accessing' stamp: 'CamilloBruni 8/3/2012 15:22'!
resourceData
	^ handle! !

!NBNativeFunction methodsFor: 'accessing' stamp: 'IgorStasenko 8/23/2012 18:16'!
address
	^ handle! !

!NBNativeFunction methodsFor: 'initialize-release' stamp: 'CamilloBruni 8/3/2012 15:53'!
initializeWithCode: code fnSpec: aFnSpec
	
	| bytes |
	super initialize.
	
	fnSpec := aFnSpec.
	bytes := code bytes.
	handle := NativeBoost allocate: bytes size.
	NativeBoost 
		memCopy: bytes 
		to: handle 
		size: bytes size.! !

!NBNativeFunction methodsFor: 'accessing' stamp: 'IgorStasenko 8/23/2012 18:30'!
uninstall
	handle ifNotNil: [
		NativeBoost free: handle.
		handle := nil.
		]! !

!NBNativeFunction methodsFor: 'accessing' stamp: 'CamilloBruni 10/3/2012 14:41'!
annotation
	^ annotation! !

!NBNativeFunction methodsFor: 'accessing' stamp: 'CamilloBruni 10/3/2012 14:41'!
annotation: anObject
	annotation := anObject! !

!NBNativeFunction class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/3/2012 16:18'!
cdecl: fnSpec emit: aFunctionBodyBlock options: anOptionArray
	^ (NBNativeFunctionGen cdecl: fnSpec emit: aFunctionBodyBlock options: anOptionArray) install.! !

!NBNativeFunction class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/3/2012 16:18'!
cdecl: fnSpec emit: aFunctionBodyBlock
	^ (NBNativeFunctionGen cdecl: fnSpec emit: aFunctionBodyBlock) install.! !

!NBNativeFunction class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/3/2012 15:53'!
code: code fnSpec: fnSpec
	
	^ self basicNew
		initializeWithCode: code fnSpec: fnSpec! !

!NBNativeFunction class methodsFor: 'finalization' stamp: 'CamilloBruni 8/3/2012 15:24'!
finalizeResourceData: anExternalAddress
	anExternalAddress free! !

!NBNativeFunction class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/3/2012 16:18'!
stdCall: fnSpec emit: aFunctionBodyBlock
	^ (NBNativeFunctionGen stdCall: fnSpec emit: aFunctionBodyBlock) install.! !

!NBNativeFunction class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/3/2012 16:18'!
stdCall: fnSpec emit: aFunctionBodyBlock options: anOptionArray
	^ (NBNativeFunctionGen stdCall: fnSpec emit: aFunctionBodyBlock options: anOptionArray) install.! !

!NBNativeFunctionArgument methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/3/2010 19:13'!
type

	^type! !

!NBNativeFunctionArgument methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/3/2010 18:58'!
name: aName
	name := aName! !

!NBNativeFunctionArgument methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/3/2010 18:58'!
name
	^ name! !

!NBNativeFunctionArgument methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/3/2010 19:13'!
type: anObject

	type := anObject! !

!NBNativeFunctionArgument methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/3/2010 19:13'!
offset

	^offset! !

!NBNativeFunctionArgument methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/3/2010 19:13'!
offset: anObject

	offset := anObject! !

!NBNativeFunctionGen commentStamp: '<historical>'!
I'm a generator of native code. I can create C style functions, providing convenient syntactic sugar for accessing the function arguments in function body (but you still have to write the body of the function with the assembler).
I can be used for implementing small helper routines, low-level callbacks or functions which will run in separate (to VM) thread.

A function spec is used to help with fetching arguments from call stack by using #arg: method for that:

 NBNativeFunctionGen 
		cdecl: #( int (byte* a, byte * b) )
		emit: [:gen | | asm |
			asm := gen asm.
			"this will load argument from stack to register"
			asm mov: (gen arg: #b) to: EAX;
		].

By invoking the expression above, I will generate a native code and keep it in my instance. 
Now to put this code in use, it must be installed  (see #install) into external memory. Then an address to the function can be passed to any other external function,
or even called by FFI callout:

	myFunction := NBNativeFunctionGen cdecl: #(..) emit: [...].
	myFunction install.
	address := myFunction address.

After function is no longer needed, it must be uninstalled (to conserve the external memory):

	myFunction uninstall.

Note, that this must be done explicitly, since like everything which works with external resources, there's no any automatic resource management for external memory.
!
!NBNativeFunctionGen methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/13/2010 23:34'!
code
	^ code! !

!NBNativeFunctionGen methodsFor: 'accessing' stamp: 'CamilloBruni 8/3/2012 15:36'!
address
	^ nativeFunction address! !

!NBNativeFunctionGen methodsFor: 'code generation' stamp: 'HenrikSperreJohansen 6/24/2014 16:25'!
generateInstructions: aFunctionBodyBlock
	
	| instructions |
	
	options at: #optNonMovable put: true.  "native functions are non-movable code"
		
	self prepareArguments.
	
	aFunctionBodyBlock cull: self cull: proxy cull: asm.

	self epilogue.
	
	instructions := asm prepareInstructions.
	
	self optDebug ifTrue: [ self halt ].
	
	^ instructions

! !

!NBNativeFunctionGen methodsFor: 'code generation' stamp: 'IgorStasenko 8/23/2012 18:14'!
generate: aFunctionBodyBlock

	code := AJGeneratedCode fromInstructions: (self generateInstructions: aFunctionBodyBlock).
	
 ! !

!NBNativeFunctionGen methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/7/2010 22:31'!
stackSize
	^ stackSize! !

!NBNativeFunctionGen methodsFor: 'spec parsing' stamp: 'cipt 10/26/2012 19:19'!
argName: argName indirectIndex: anIndex type: typeName ptrArity: ptrArity

	| arg |
	arg := NBNativeFunctionArgument new.
	arg type: (self typeName: typeName ptrArity: ptrArity).
	arg name: argName.
	
	^ arg
	! !

!NBNativeFunctionGen methodsFor: 'accessing' stamp: 'CamilloBruni 7/23/2012 16:39'!
returnLabel
	^ returnLabel ifNil: [ 
		returnLabel := asm uniqueLabelName: 'Return' ]! !

!NBNativeFunctionGen methodsFor: 'installing' stamp: 'IgorStasenko 8/23/2012 18:06'!
install
	"install the code into a memory heap"
	self assert: code notNil.
	nativeFunction := NBNativeFunction code: code fnSpec: fnSpec.
	^ nativeFunction ! !

!NBNativeFunctionGen methodsFor: 'convenience' stamp: 'IgorStasenko 5/28/2012 07:23'!
arg: aName
	| arg |
	
	arg := fnSpec arguments detect: [:argx | argx name = aName ]
		ifNone: [ self error: 'invalid argument name' ].
	
	self assert: (arg type typeSize <= 8).
	
	^ (asm EBP ptr + arg offset) size: arg type typeSize! !

!NBNativeFunctionGen methodsFor: 'code generation' stamp: 'IgorStasenko 5/28/2012 07:20'!
prepareArguments

	| args offset |
	
	(self optCdecl or: [ self optStdcall ]) ifTrue: [
		args := fnSpec arguments.
	].
	
	offset := 8.  "+ return address + EBP"
	stackSize := 0.
	args withIndexDo: [:arg :i |  | sz |
		"arg size is 4 or 8"
		sz := arg type stackSize.
		stackSize := stackSize + sz.
		arg offset: offset.
		offset := offset + sz.
	].
! !

!NBNativeFunctionGen methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/3/2010 22:12'!
nb
	^ NativeBoost forCurrentPlatform ! !

!NBNativeFunctionGen methodsFor: 'convenience' stamp: 'CamilloBruni 7/23/2012 16:55'!
return
	"Generate a jump to the return label.
	Use this function instead of directly calling #ret, #leave on the assembler if you want to rely on the default cleanup instructions generated by me"
	asm jmp: self returnLabel.! !

!NBNativeFunctionGen methodsFor: 'installing' stamp: 'IgorStasenko 8/23/2012 18:04'!
uninstall
	"uninstall the code from a memory heap"
	
	nativeFunction ifNotNil: [ nativeFunction uninstall ].! !

!NBNativeFunctionGen methodsFor: 'code generation' stamp: 'CamilloBruni 7/23/2012 16:40'!
epilogue
	
	asm
		label: self returnLabel;
		emitEpilogue: (self optStdcall ifTrue: [ stackSize] ifFalse: [0]).! !

!NBNativeFunctionGen methodsFor: 'accessing' stamp: 'CamilloBruni 8/3/2012 15:36'!
nativeFunction
	^ nativeFunction! !

!NBNativeFunctionGen methodsFor: 'accessing' stamp: 'IgorStasenko 8/21/2011 11:01'!
fnSpec: anonymousSpec
	
	fnSpec := NBFnSpecParser new requestor: self ; parseAnonFunction: anonymousSpec! !

!NBNativeFunctionGen class methodsFor: 'generator entry points' stamp: 'IgorStasenko 8/23/2012 18:06'!
cdecl: fnSpec emit: aFunctionBodyBlock
	^ self new cdecl;
		fnSpec: fnSpec;
		generate: aFunctionBodyBlock;
		yourself! !

!NBNativeFunctionGen class methodsFor: 'generator entry points' stamp: 'IgorStasenko 8/23/2012 18:06'!
stdCall: fnSpec emit: aFunctionBodyBlock options: anOptions
	^ self new 
		parseOptions: anOptions;
		stdcall;
		fnSpec: fnSpec;
		generate: aFunctionBodyBlock;
		yourself! !

!NBNativeFunctionGen class methodsFor: 'generator entry points' stamp: 'IgorStasenko 8/23/2012 18:06'!
stdCall: fnSpec emit: aFunctionBodyBlock
	^ self new stdcall;
		fnSpec: fnSpec;
		generate: aFunctionBodyBlock;
		yourself! !

!NBNativeFunctionGen class methodsFor: 'generator entry points' stamp: 'IgorStasenko 8/23/2012 18:06'!
cdecl: fnSpec emit: aFunctionBodyBlock options: anOptions

	^ self new cdecl;
		parseOptions: anOptions;
		fnSpec: fnSpec;
		generate: aFunctionBodyBlock;
		yourself! !

!NBObjectFormat commentStamp: 'Igor.Stasenko 5/19/2010 11:12'!
i am exposing an object format to ease accessing various object fields directly,
without calling interpreter proxy functions, where it is appropriate!
!NBObjectFormat methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/19/2010 11:53'!
instVarOffsetAt: ivarIndex
	"answer an offset of instance variable with given 1-based index,
	relative to some oop"
	self subclassResponsibility ! !

!NBObjectFormat methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/19/2010 11:27'!
oopSize

	self subclassResponsibility ! !

!NBObjectFormat methodsFor: 'object formats' stamp: 'Igor.Stasenko 5/20/2010 05:52'!
indexableWordsFormat
	self subclassResponsibility ! !

!NBObjectFormat methodsFor: 'testing' stamp: 'IgorStasenko 11/23/2011 10:44'!
isCogVM

	^ (Smalltalk vm version beginsWith: 'Squeak') not! !

!NBObjectFormat methodsFor: 'sizes' stamp: 'HenrikSperreJohansen 8/23/2011 21:47'!
varBytesFirstField
	" answer an offset of first byte of variable-bytes oop, relative to object pointer"
	"In object formats where additional header fields are stored before the base header, this is just the size of the header"
	^ self baseHeaderSize
! !

!NBObjectFormat methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/20/2010 05:54'!
asm: anAsm
	asm := anAsm! !

!NBObjectFormat methodsFor: 'sizes' stamp: 'HenrikSperreJohansen 8/23/2011 21:51'!
stackArgumentSize

	"a default number of bytes on stack used by a single argument,
	for calling proxy functions"
	"In most cases, this will the same as oopSize, but not necessarily"
	^self subclassResponsibility! !

!NBObjectFormat methodsFor: 'sizes' stamp: 'HenrikSperreJohansen 8/23/2011 21:44'!
baseHeaderSize

	^ self oopSize! !

!NBObjectFormat class methodsFor: 'accessing' stamp: 'IgorStasenko 12/21/2011 14:20'!
current
	"answer an new instance of object format representing an object format of currently running system"
	^ NBObjectFormat32 new! !

!NBObjectFormat32 commentStamp: 'Igor.Stasenko 5/19/2010 11:13'!
- an object format for 32-bit images!
!NBObjectFormat32 methodsFor: 'emitting tests' stamp: 'CamilloBruni 7/23/2012 13:29'!
isBytesOrWords: oop ifNotJumpTo: label
	| gotIt |
	gotIt := asm uniqueLabelName: 'gotit'.
	asm decorateWith: '#isBytesOrWords:ifNotJumpTo:' during: [ 
	asm 
		mov: oop to: EAX;
		test: AL with: 1;
		jne: label;
		mov: EAX ptr to: ECX;
		and: ECX with: self objectFormatMask;
		cmp: ECX with: (self indexableWordsFormat bitShift: self objectFormatShift);
		je: gotIt;
		cmp: ECX with: (self indexableBytesFormat bitShift: self objectFormatShift);
		jl: label;
		label: gotIt
	]! !

!NBObjectFormat32 methodsFor: 'header shifts' stamp: 'Igor.Stasenko 5/20/2010 03:35'!
compactClassIndexShift
	"answer a compact class index shift"
	^ 12
! !

!NBObjectFormat32 methodsFor: 'object formats' stamp: 'HenrikSperreJohansen 8/22/2011 22:11'!
fixedFieldsFormat
 	" fixed fields only (all containing pointers) "
 	^ 2r0001! !

!NBObjectFormat32 methodsFor: 'header fields' stamp: 'HenrikSperreJohansen 8/22/2011 23:16'!
identityHashMask

	"answer a bit mask for a compact class index in base header "
	" ggghhhhhhhhhhhhcccccffffsssssstt "
	^ 2r00011111111111100000000000000000
! !

!NBObjectFormat32 methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/19/2010 11:53'!
instVarOffsetAt: index
	"answer an offset of instance variable with given 1-based index,
	relative to some oop"
	^ self baseHeaderSize + (self oopSize*(index-1)).! !

!NBObjectFormat32 methodsFor: 'header shifts' stamp: 'HenrikSperreJohansen 8/23/2011 00:55'!
sizeShift

	^ 2! !

!NBObjectFormat32 methodsFor: 'emitting tests' stamp: 'CamilloBruni 7/23/2012 13:29'!
ifImmediate: aLocation jumpTo: aLabel
	"Jump to aLabel, if the OOP in aLocation is that of an immediate smallinteger"
	asm decorateWith: '#jumpTo:ifImmediate::' 
	during: [ asm 
				test: aLocation with: 1;
				jnz: aLabel ]! !

!NBObjectFormat32 methodsFor: 'emitting tests' stamp: 'HenrikSperreJohansen 8/22/2011 22:26'!
isBytes2: oop ifNotJumpTo: label

	asm 
		mov: oop to: EAX;
		test: AL with: 1;
		jne: label;
		"mov: EAX ptr to: ECX;"
		"and: ECX with: self objectFormatMask;"
		test: EAX with: (self indexableBytesFormat bitShift: self objectFormatShift);
		jz: label! !

!NBObjectFormat32 methodsFor: 'sizes' stamp: 'HenrikSperreJohansen 8/23/2011 21:50'!
stackArgumentSize

	"a default number of bytes on stack used by a single argument,
	for calling proxy functions"
	
	^self oopSize! !

!NBObjectFormat32 methodsFor: 'object formats' stamp: 'HenrikSperreJohansen 8/22/2011 22:11'!
indexableBytesFormat
	" 8-11      indexable byte fields only (no pointers) (low 2 bits are low 2 bits of size) "
	^ 2r1000! !

!NBObjectFormat32 methodsFor: 'emitting tests' stamp: 'CamilloBruni 7/23/2012 13:29'!
jumpTo: aLabel ifNotWordsOOP: aLocation
	asm decorateWith: '#jumpTo:ifNotWordsOOP:' during: [ 
	self ifImmediate: aLocation jumpTo: aLabel .
	asm 	
		push: asm EAX;
		mov: aLocation ptr to: asm EAX;
		test: asm EAX with: (self indexableWordsFormat bitShift: self objectFormatShift);
		pop: asm EAX;
		jz: aLabel
	]! !

!NBObjectFormat32 methodsFor: 'header shifts' stamp: 'HenrikSperreJohansen 8/23/2011 00:05'!
objectFormatShift

	^ 8! !

!NBObjectFormat32 methodsFor: 'header shifts' stamp: 'HenrikSperreJohansen 8/22/2011 23:01'!
immediateShift

	^ 24! !

!NBObjectFormat32 methodsFor: 'emitting tests' stamp: 'CamilloBruni 7/23/2012 13:29'!
ifWordsOOP: aLocation storeHeaderIn: destinationLocation ifNotJumpTo: aLabel
	asm decorateWith: '#jumpTo:ifNotWordsOOP:' during: [ 
	asm 	
		mov: aLocation ptr to: destinationLocation;
		test: destinationLocation with: (self indexableWordsFormat bitShift: self objectFormatShift);
		jz: aLabel
	]! !

!NBObjectFormat32 methodsFor: 'header fields' stamp: 'HenrikSperreJohansen 8/23/2011 21:41'!
objectSizeMask

	"answer a bit mask for a compact class index in base header "
	" ggghhhhhhhhhhhhcccccffffsssssstt "
	^ 2r00000000000000000000000011111100
! !

!NBObjectFormat32 methodsFor: 'header fields' stamp: 'HenrikSperreJohansen 8/22/2011 23:19'!
compactClassMask

	"answer a bit mask for a compact class index in base header "
	" ggghhhhhhhhhhhhcccccffffsssssstt "
	^ 2r00000000000000011111000000000000
! !

!NBObjectFormat32 methodsFor: 'emitting tests' stamp: 'HenrikSperreJohansen 8/23/2011 01:51'!
sizeOf: headerRegister is: anImmediate ifNotJumpTo: aLabel
	asm 	and: headerRegister with: self objectSizeMask;
		xor: headerRegister with: (anImmediate bitShift: self sizeShift);
		jnz: aLabel! !

!NBObjectFormat32 methodsFor: 'testing' stamp: 'Igor.Stasenko 9/29/2010 10:58'!
floatsMatchingPlatform
	"Answer true if floats are store in platform native endianesness.
	
	This is false for Squeak on x86 , since they are always stored in bigendian format.
	Cog promising to always use native format for floats.
	"
	
	^ self isCogVM! !

!NBObjectFormat32 methodsFor: 'emitting tests' stamp: 'CamilloBruni 7/23/2012 13:29'!
jumpTo: aLabel ifImmediate: aLocation
	asm decorateWith: '#jumpTo:ifImmediate::' 
	during: [ asm 
				test: aLocation with: 1;
				jnz: aLabel ]! !

!NBObjectFormat32 methodsFor: 'object formats' stamp: 'Igor.Stasenko 5/20/2010 06:06'!
noFieldsFormat
	^ 0! !

!NBObjectFormat32 methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/19/2010 11:29'!
oopSize

	^ 4! !

!NBObjectFormat32 methodsFor: 'object formats' stamp: 'HenrikSperreJohansen 8/22/2011 22:11'!
indexableWordsFormat
	" indexable word fields only (no pointers) "
	^ 2r0110! !

!NBObjectFormat32 methodsFor: 'testing' stamp: 'IgorStasenko 8/5/2011 18:14'!
stackGrowsDown

	"Squeak interpreter stack grows up, while StackInterpreter down"
	^ self isCogVM! !

!NBObjectFormat32 methodsFor: 'header fields' stamp: 'HenrikSperreJohansen 8/22/2011 23:16'!
headerTypeMask

	"answer a bit mask for a compact class index in base header "
	" ggghhhhhhhhhhhhcccccffffsssssstt "
	^ 2r00000000000000000000000000000011
! !

!NBObjectFormat32 methodsFor: 'header fields' stamp: 'HenrikSperreJohansen 8/23/2011 21:41'!
objectFormatMask

	"answer a bit mask for a compact class index in base header "
	" ggghhhhhhhhhhhhcccccffffsssssstt "
	^ 2r00000000000000000000111100000000
! !

!NBObjectFormat32 methodsFor: 'emitting tests' stamp: 'Igor.Stasenko 5/20/2010 07:25'!
isBytes: oop ifNotJumpTo: label

	asm 
		mov: oop to: EAX;
		test: AL with: 1;
		jne: label;
		mov: EAX ptr to: ECX;
		and: ECX with: self objectFormatMask;
		cmp: ECX with: (self indexableBytesFormat bitShift: self objectFormatShift);
		jl: label! !

!NBObjectFormat32 class methodsFor: 'helper' stamp: 'IgorStasenko 11/24/2012 17:22'!
headerOf: anObject

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin >
	
	^ self nbCallout function: #( ulong (oop anObject) ) emit: [:gen |
		gen asm pop: gen asm EAX.
		gen asm mov: gen asm EAX ptr to: gen asm EAX
		]! !

!NBObjectFormat32Tests methodsFor: 'primitives' stamp: 'IgorStasenko 11/24/2012 17:23'!
pushDouble: aFloat

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout 
		function: #( double (double aFloat))
		emit: [:gen |
			| asm |
			asm := gen asm.
			asm fld: asm ESP ptr64		
		]! !

!NBObjectFormat32Tests methodsFor: 'tests' stamp: 'IgorStasenko 11/23/2011 10:46'!
testCompactFloats

	| idx format |
	format := NBObjectFormat32 new.
	idx := Smalltalk compactClassesArray indexOf: Float ifAbsent: [ ^ nil ].
	idx := idx bitShift: format compactClassIndexShift.

	NativeBoost enableNativeCode.
	Float allInstances do: [:each |
		| oopIdx |
		oopIdx := (NBObjectFormat32 headerOf: each) bitAnd: format compactClassMask.
		self assert: (oopIdx = idx) ]! !

!NBObjectFormat32Tests methodsFor: 'primitives' stamp: 'IgorStasenko 11/24/2012 17:23'!
getFloatPtrOffset: aFloat
	"return the difference between float oop and pointer to its stored floating-point value ,
	must be base header size"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout 
		function: #( ulong (oop aFloat, NBFloatPtr aFloat))
		emit: [:gen | | asm |
			asm := gen asm.
			asm pop: asm ECX. "oop"
			asm pop: asm EAX. "float ptr"
			asm sub: asm EAX with: asm ECX
		]! !

!NBObjectFormat32Tests methodsFor: 'tests' stamp: 'IgorStasenko 12/21/2011 14:21'!
testPushingFloatPointers

	self assert: (self getFloatPtrOffset: 10.0) =  NBObjectFormat current baseHeaderSize.
! !

!NBObjectFormat32Tests methodsFor: 'tests' stamp: 'Igor.Stasenko 5/20/2010 09:19'!
testPushingFloats

	self assert: (self pushFloat: 100.0) = 100.0.
	self assert: (self pushDouble: 100.0) = 100.0.! !

!NBObjectFormat32Tests methodsFor: 'primitives' stamp: 'IgorStasenko 11/24/2012 17:24'!
pushFloat: aFloat

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout 
		function: #( double (float aFloat))
		emit: [:gen |
			| asm |
			asm := gen asm.
			asm fld: asm ESP ptr32		
		]! !

!NBOop commentStamp: '<historical>'!
i am special "type", doing no conversion of any sort, just passing an object oop as it is.!
!NBOop methodsFor: 'emitting code' stamp: 'Igor.Stasenko 4/30/2010 13:55'!
pushAsValue: gen

	gen asm push: (loader emitLoad: gen) 

	! !

!NBOop methodsFor: 'emitting code' stamp: 'Igor.Stasenko 4/29/2010 07:56'!
pushAsPointer: gen

	self error: 'oop is already a pointer. go away'.! !

!NBOop methodsFor: 'accessing' stamp: 'IgorStasenko 5/28/2012 01:38'!
valueSize
	"Answer a number of bytes, which takes a value of given type
	(not a pointer to it)
	"
	
	^ self pointerSize  ! !

!NBOop methodsFor: 'emitting code' stamp: 'Igor.Stasenko 5/1/2010 12:04'!
coerceReturnValue: generator
	"oop is already in EAX, we don't need to do anything"! !

!NBPointerArgumentsTests methodsFor: 'generation options' stamp: 'CiprianTeodorov 3/16/2013 22:53'!
case1
	^#( +optAllowByteArraysPtr +optAllowExternalAddressPtr )! !

!NBPointerArgumentsTests methodsFor: 'generation options' stamp: 'CiprianTeodorov 3/16/2013 22:53'!
case3
	^#( -optAllowByteArraysPtr -optAllowExternalAddressPtr )! !

!NBPointerArgumentsTests methodsFor: 'struct ptr tests' stamp: 'IgorStasenko 7/12/2013 14:53'!
testStructCase1ExternalAddress 
	| value | 
	value := 12345678.
	self should: [ self readStructPtrCase1: (self structExternalAddress: value) ] raise: NBFFICalloutError 
! !

!NBPointerArgumentsTests methodsFor: 'struct ptr tests' stamp: 'CiprianTeodorov 3/16/2013 23:43'!
testStructCase2ByteArray 

	self should: [self readStructPtrCase2: (self structByteArray: 12345678)] raise: NBFFICalloutError 
! !

!NBPointerArgumentsTests methodsFor: 'struct ptr tests' stamp: 'CiprianTeodorov 3/16/2013 23:55'!
testStructCase1Struct 
	|value|
	value := 12345678.
	self assert:  (self readStructPtrCase1: (self structValue: value)) = value.! !

!NBPointerArgumentsTests methodsFor: 'enum primitives' stamp: 'CiprianTeodorov 3/17/2013 00:34'!
readEnumPtrCase3: arg 
	"this is the default case where both optAllowByteArraysPtr optAllowExternalAddressPtr are enabled"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self primitiveEnum: arg case: self case3.! !

!NBPointerArgumentsTests methodsFor: 'struct primitives' stamp: 'CiprianTeodorov 3/17/2013 22:29'!
arity2StructPtrCase3: arg
	"this is the default case where both optAllowByteArraysPtr optAllowExternalAddressPtr are enabled"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self primitiveArity2Struct: arg case: self case3.! !

!NBPointerArgumentsTests methodsFor: 'integer pointers tests' stamp: 'CiprianTeodorov 3/17/2013 00:36'!
intByteArray: aValue 
	^(self class intArrayType with: aValue) address.! !

!NBPointerArgumentsTests methodsFor: 'struct ptr tests' stamp: 'CiprianTeodorov 3/16/2013 23:56'!
testStructCase3Struct 
	|value|
	value := 12345678.
	self assert:  (self readStructPtrCase3: (self structValue: value)) = value.! !

!NBPointerArgumentsTests methodsFor: 'struct ptr tests' stamp: 'CiprianTeodorov 3/16/2013 23:52'!
testStructCase3ExternalAddress 

	self should: [self readStructPtrCase3: (self structExternalAddress: 12345)] raise: NBFFICalloutError.! !

!NBPointerArgumentsTests methodsFor: 'integer pointers tests' stamp: 'CiprianTeodorov 3/17/2013 00:10'!
testIntDirectly 

	self should: [self readIntPtrCase1: 12345] raise: NBFFICalloutError ! !

!NBPointerArgumentsTests methodsFor: 'struct ptr tests' stamp: 'CiprianTeodorov 3/17/2013 00:38'!
structByteArray: aValue 
	^(self class structArrayType with: (self structValue: aValue)) address.
! !

!NBPointerArgumentsTests methodsFor: 'struct primitives' stamp: 'CiprianTeodorov 3/17/2013 22:29'!
arity2StructPtrCase4: arg
	"this is the default case where both optAllowByteArraysPtr optAllowExternalAddressPtr are enabled"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self primitiveArity2Struct: arg case: self case4.! !

!NBPointerArgumentsTests methodsFor: 'struct ptr tests arity 2' stamp: 'IgorStasenko 7/8/2013 17:38'!
testArity2StructCase2Struct

	self should: [self arity2StructPtrCase2: (self structValue: 12345678)] raise: NBFFICalloutError.

! !

!NBPointerArgumentsTests methodsFor: 'enum pointers tests' stamp: 'IgorStasenko 7/12/2013 14:30'!
testEnumDirectly 
	self should: [self readEnumPtrCase1: self class enumClass BBB] raise: NBCodeGenerationError ! !

!NBPointerArgumentsTests methodsFor: 'integer primitives' stamp: 'CiprianTeodorov 3/16/2013 23:21'!
primitiveInt: anInt case: aCase

	^ (self nbCalloutIn: thisContext sender) 
		options: aCase; 
		function: #(int (int * anInt) ) 
		emit: [:gen :proxy :asm |
			asm pop: asm ECX;
				mov: asm ECX ptr to: asm EAX.
		]
		! !

!NBPointerArgumentsTests methodsFor: 'integer primitives' stamp: 'CiprianTeodorov 3/16/2013 23:18'!
readIntPtrCase3: anInt
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self primitiveInt: anInt case: self case3
		
		! !

!NBPointerArgumentsTests methodsFor: 'enum pointers tests' stamp: 'IgorStasenko 7/12/2013 14:33'!
testEnumCase1ByteArray 
	|item|
	item := self class enumClass BBB.
	self should: [ self readEnumPtrCase1: (self enumByteArray: item) ] raise: NBCodeGenerationError.! !

!NBPointerArgumentsTests methodsFor: 'integer primitives' stamp: 'CiprianTeodorov 3/16/2013 23:19'!
readIntPtrCase1: anInt
	"this is the default case where both optAllowByteArraysPtr optAllowExternalAddressPtr are enabled"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self primitiveInt: anInt case: self case1.! !

!NBPointerArgumentsTests methodsFor: 'struct ptr tests' stamp: 'CiprianTeodorov 3/16/2013 23:55'!
testStructCase2Struct 
	|value|
	value := 12345678.
	self assert:  (self readStructPtrCase2: (self structValue: value)) = value.! !

!NBPointerArgumentsTests methodsFor: 'struct primitives' stamp: 'CiprianTeodorov 3/16/2013 23:41'!
readStructPtrCase2: aStruct
	"this is the default case where both optAllowByteArraysPtr optAllowExternalAddressPtr are enabled"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self primitiveStruct: aStruct case: self case2.! !

!NBPointerArgumentsTests methodsFor: 'integer pointers tests' stamp: 'CiprianTeodorov 3/17/2013 00:08'!
testIntCase3ByteArray 

	self should: [ self readIntPtrCase3: (self intByteArray: 12345)] raise: NBFFICalloutError .
! !

!NBPointerArgumentsTests methodsFor: 'struct ptr tests' stamp: 'CiprianTeodorov 3/16/2013 23:44'!
testStructCase3ByteArray 

	self should: [self readStructPtrCase3: (self structByteArray: 12345678)] raise: NBFFICalloutError ! !

!NBPointerArgumentsTests methodsFor: 'enum pointers tests' stamp: 'IgorStasenko 7/12/2013 14:30'!
testEnumCase4ExternalAddress 
	self should: [self readEnumPtrCase4: (self enumExternalAddress: self class enumClass BBB)] raise: NBCodeGenerationError. ! !

!NBPointerArgumentsTests methodsFor: 'enum pointers tests' stamp: 'IgorStasenko 7/12/2013 14:33'!
testEnumCase1ExternalAddress 
	| item | 
	item := self class enumClass DDD.
	self should: [self readEnumPtrCase1: (self enumExternalAddress: item)] raise: NBCodeGenerationError.! !

!NBPointerArgumentsTests methodsFor: 'integer pointers tests' stamp: 'CiprianTeodorov 3/17/2013 00:08'!
testIntCase2ExternalAddress 
	| value | 
	value := 12345.
	self assert: (self readIntPtrCase2: (self intExternalAddress: value)) = value.! !

!NBPointerArgumentsTests methodsFor: 'integer primitives' stamp: 'CiprianTeodorov 3/16/2013 23:18'!
readIntPtrCase2: anInt
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self primitiveInt: anInt case: self case2
		! !

!NBPointerArgumentsTests methodsFor: 'enum pointers tests' stamp: 'IgorStasenko 7/12/2013 14:33'!
testEnumCase2ExternalAddress 
	| item | 
	item := self class enumClass DDD.
	self should: [self readEnumPtrCase2: (self enumExternalAddress: item)] raise: NBCodeGenerationError! !

!NBPointerArgumentsTests methodsFor: 'struct primitives' stamp: 'CiprianTeodorov 3/16/2013 23:41'!
readStructPtrCase1: aStruct
	"this is the default case where both optAllowByteArraysPtr optAllowExternalAddressPtr are enabled"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self primitiveStruct: aStruct case: self case1.! !

!NBPointerArgumentsTests methodsFor: 'enum pointers tests' stamp: 'IgorStasenko 7/12/2013 14:32'!
testEnumCase4ByteArray 
	|item|
	item := self class enumClass BBB.
	self 
		should:  [ self readEnumPtrCase4: (self enumByteArray: item) ]
		raise: NBCodeGenerationError! !

!NBPointerArgumentsTests methodsFor: 'generation options' stamp: 'CiprianTeodorov 3/16/2013 22:53'!
case2
	^#( -optAllowByteArraysPtr +optAllowExternalAddressPtr )! !

!NBPointerArgumentsTests methodsFor: 'enum pointers tests' stamp: 'CiprianTeodorov 3/17/2013 09:28'!
enumExternalAddress: aValue 
	^(toBeFreed := self class enumArrayType externalNew: 1)
		at: 1 put: aValue;
		address.
	! !

!NBPointerArgumentsTests methodsFor: 'enum primitives' stamp: 'CiprianTeodorov 3/17/2013 00:33'!
primitiveEnum: arg case: aCase

	^ (self nbCalloutIn: thisContext sender) 
		options: aCase; 
		function: {#NBInt32. {self class enumType. #*. #arg} } 
		emit: [:gen :proxy :asm |
			asm pop: asm ECX; "pointer to the enum"
				mov: asm ECX ptr to: asm EAX. "read the enum value"
		]! !

!NBPointerArgumentsTests methodsFor: 'struct ptr tests' stamp: 'IgorStasenko 7/12/2013 14:53'!
testStructCase1ByteArray 
	|value|
	value := 12345678.
	self should: [ self readStructPtrCase1: (self structByteArray: value)] raise: NBFFICalloutError.
! !

!NBPointerArgumentsTests methodsFor: 'enum pointers tests' stamp: 'IgorStasenko 7/12/2013 14:32'!
testEnumCase3ByteArray 
	self should: [self readEnumPtrCase3: (self enumByteArray: self class enumClass BBB)] raise: NBCodeGenerationError. ! !

!NBPointerArgumentsTests methodsFor: 'struct ptr tests' stamp: 'CiprianTeodorov 3/16/2013 23:56'!
testStructCase4Struct 
	|value|
	value := 12345678.
	self assert:  (self readStructPtrCase4: (self structValue: value)) = value.! !

!NBPointerArgumentsTests methodsFor: 'struct ptr tests arity 2' stamp: 'IgorStasenko 7/8/2013 17:38'!
testArity2StructCase1Struct

	"normally this test should fail, but it crashes the VM, because NBExternalStructure is variable byte class that gets captured by +optAllowByteArraysPtr"
	

	self should: [(self arity2StructPtrCase1: (self structValue: 12345678)).] raise: NBFFICalloutError.

! !

!NBPointerArgumentsTests methodsFor: 'integer pointers tests' stamp: 'CiprianTeodorov 3/17/2013 00:07'!
testIntCase1ByteArray 
	|value|
	value := 12345.
	self assert:  (self readIntPtrCase1: (self intByteArray: value)) = value.
! !

!NBPointerArgumentsTests methodsFor: 'integer pointers tests' stamp: 'CiprianTeodorov 3/17/2013 00:07'!
testIntCase1ExternalAddress 
	| value | 
	value := 12345.
	self assert: (self readIntPtrCase1: (self intExternalAddress: value)) = value.
! !

!NBPointerArgumentsTests methodsFor: 'enum pointers tests' stamp: 'CiprianTeodorov 3/17/2013 00:37'!
enumByteArray: aValue 
	^(self class enumArrayType with: aValue) address! !

!NBPointerArgumentsTests methodsFor: 'struct ptr tests arity 2' stamp: 'IgorStasenko 7/8/2013 17:38'!
testArity2StructCase4Struct
	"normally this test should fail, but it crashes the VM, because NBExternalStructure is variable byte class that gets captured by +optAllowByteArraysPtr"

	self should: [(self arity2StructPtrCase4: (self structValue: 12345678))] raise: NBFFICalloutError.
! !

!NBPointerArgumentsTests methodsFor: 'struct ptr tests' stamp: 'CiprianTeodorov 3/17/2013 09:30'!
structExternalAddress: aValue 
	^(toBeFreed := self class structArrayType externalNew: 1)
		at: 1 put: (self structValue: aValue);
		address.
	! !

!NBPointerArgumentsTests methodsFor: 'enum primitives' stamp: 'CiprianTeodorov 3/17/2013 00:34'!
readEnumPtrCase4: arg 
	"this is the default case where both optAllowByteArraysPtr optAllowExternalAddressPtr are enabled"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self primitiveEnum: arg case: self case4.! !

!NBPointerArgumentsTests methodsFor: 'enum pointers tests' stamp: 'IgorStasenko 7/12/2013 14:32'!
testEnumCase3ExternalAddress 
	self should: [self readEnumPtrCase3: (self enumExternalAddress: self class enumClass BBB)] raise: NBCodeGenerationError. ! !

!NBPointerArgumentsTests methodsFor: 'enum primitives' stamp: 'CiprianTeodorov 3/17/2013 00:33'!
readEnumPtrCase1: arg 
	"this is the default case where both optAllowByteArraysPtr optAllowExternalAddressPtr are enabled"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self primitiveEnum: arg case: self case1.! !

!NBPointerArgumentsTests methodsFor: 'struct primitives' stamp: 'CiprianTeodorov 3/17/2013 14:59'!
primitiveArity2Struct: arg case: aCase

	^ (self nbCalloutIn: thisContext sender) 
		options: aCase; 
		function: {#long. {self class structType. #*. #*. #arg} } 
		emit: [:gen :proxy :asm |
			asm pop: asm ECX; "pointer to the structure *"
				mov: asm ECX ptr32 to: asm ECX;
				mov: asm ECX ptr + 4 to: asm EAX. "read the long value from NBTestStructure"
		]! !

!NBPointerArgumentsTests methodsFor: 'integer primitives' stamp: 'CiprianTeodorov 3/16/2013 23:18'!
readIntPtrCase4: anInt
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self primitiveInt: anInt case: self case4.
		
		! !

!NBPointerArgumentsTests methodsFor: 'struct primitives' stamp: 'CiprianTeodorov 3/17/2013 14:55'!
arity2StructPtrCase2: arg
	"this is the default case where both optAllowByteArraysPtr optAllowExternalAddressPtr are enabled"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self primitiveArity2Struct: arg case: self case2.! !

!NBPointerArgumentsTests methodsFor: 'enum pointers tests' stamp: 'IgorStasenko 7/12/2013 14:33'!
testEnumCase2ByteArray 
	self should: [self readEnumPtrCase2: (self enumByteArray: self class enumClass BBB)] raise: NBCodeGenerationError. ! !

!NBPointerArgumentsTests methodsFor: 'integer pointers tests' stamp: 'CiprianTeodorov 3/17/2013 00:08'!
testIntCase3ExternalAddress 

	self should: [self readIntPtrCase3: (self intExternalAddress: 12345)] raise: NBFFICalloutError.! !

!NBPointerArgumentsTests methodsFor: 'struct primitives' stamp: 'CiprianTeodorov 3/16/2013 23:42'!
readStructPtrCase3: aStruct
	"this is the default case where both optAllowByteArraysPtr optAllowExternalAddressPtr are enabled"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self primitiveStruct: aStruct case: self case3.! !

!NBPointerArgumentsTests methodsFor: 'struct ptr tests' stamp: 'IgorStasenko 7/12/2013 14:54'!
testStructCase2ExternalAddress 
	| value | 
	value := 12345678.
	self should: [ self readStructPtrCase2: (self structExternalAddress: value) ] raise: NBFFICalloutError .
! !

!NBPointerArgumentsTests methodsFor: 'integer pointers tests' stamp: 'CiprianTeodorov 3/17/2013 00:07'!
testIntCase2ByteArray 

	self should: [self readIntPtrCase2: (self intByteArray: 12345)] raise: NBFFICalloutError ! !

!NBPointerArgumentsTests methodsFor: 'struct ptr tests' stamp: 'IgorStasenko 7/12/2013 14:54'!
testStructCase4ByteArray 
	|value|
	value := 12345678.
	self should:  [self readStructPtrCase4: (self structByteArray: value) ] raise: NBFFICalloutError .
! !

!NBPointerArgumentsTests methodsFor: 'running' stamp: 'CiprianTeodorov 3/17/2013 09:43'!
tearDown
	toBeFreed
		ifNotNil: [
			toBeFreed free.
			toBeFreed := nil ]! !

!NBPointerArgumentsTests methodsFor: 'integer pointers tests' stamp: 'CiprianTeodorov 3/17/2013 09:29'!
intExternalAddress: aValue 
	^(toBeFreed := self class intArrayType externalNew: 1)
		at: 1 put: aValue;
		address.
	! !

!NBPointerArgumentsTests methodsFor: 'integer pointers tests' stamp: 'IgorStasenko 7/5/2013 16:17'!
testIntCase4ExternalAddress 
	"
		see case4 for details
	"
	
	| address |
	
	address := NBExternalAddress value: 12345.
		
	self assert: (self readIntPtrCase4:  address ) equals: address value

! !

!NBPointerArgumentsTests methodsFor: 'struct primitives' stamp: 'CiprianTeodorov 3/17/2013 14:15'!
arity2StructPtrCase1: arg
	"this is the default case where both optAllowByteArraysPtr optAllowExternalAddressPtr are enabled"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self primitiveArity2Struct: arg case: self case1.! !

!NBPointerArgumentsTests methodsFor: 'struct ptr tests' stamp: 'CiprianTeodorov 3/16/2013 23:52'!
testStructCase4ExternalAddress 

	self should: [self readStructPtrCase4: (self structExternalAddress: 12345)] raise: NBFFICalloutError.! !

!NBPointerArgumentsTests methodsFor: 'struct primitives' stamp: 'CiprianTeodorov 3/16/2013 23:42'!
readStructPtrCase4: aStruct
	"this is the default case where both optAllowByteArraysPtr optAllowExternalAddressPtr are enabled"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self primitiveStruct: aStruct case: self case4.! !

!NBPointerArgumentsTests methodsFor: 'enum primitives' stamp: 'CiprianTeodorov 3/17/2013 00:34'!
readEnumPtrCase2: arg 
	"this is the default case where both optAllowByteArraysPtr optAllowExternalAddressPtr are enabled"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^self primitiveEnum: arg case: self case2.! !

!NBPointerArgumentsTests methodsFor: 'integer pointers tests' stamp: 'CiprianTeodorov 3/17/2013 00:08'!
testIntCase4ByteArray 
	|value|
	value := 12345.
	self assert:  (self readIntPtrCase4: (self intByteArray: value)) = value.! !

!NBPointerArgumentsTests methodsFor: 'struct ptr tests arity 2' stamp: 'IgorStasenko 7/8/2013 17:38'!
testArity2StructCase3Struct

	self should: [self arity2StructPtrCase3: (self structValue: 12345678)] raise: NBFFICalloutError.

! !

!NBPointerArgumentsTests methodsFor: 'struct primitives' stamp: 'CiprianTeodorov 3/17/2013 00:30'!
primitiveStruct: aStruct case: aCase

	^ (self nbCalloutIn: thisContext sender) 
		options: aCase; 
		function: {#long. {self class structType. #*. #aStruct} } 
		emit: [:gen :proxy :asm |
			asm pop: asm ECX; "pointer to the structure"
				mov: asm ECX ptr + 4 to: asm EAX. "read the long value from NBTestStructure"
		]! !

!NBPointerArgumentsTests methodsFor: 'generation options' stamp: 'IgorStasenko 7/5/2013 16:12'!
case4

	"allow only var-byte objects as pointer arguments.
	by turning off optAllowExternalAddressPtr this means that external address 
	will be treated as any other var-byte object and therefore an address of memory
	where address value is held will be passed to function instead of address value
	"
	^#( +optAllowByteArraysPtr -optAllowExternalAddressPtr )! !

!NBPointerArgumentsTests methodsFor: 'struct ptr tests' stamp: 'CiprianTeodorov 5/19/2013 03:45'!
structValue: aValue
	^(self class structClass new)
		long: aValue;
		yourself
! !

!NBPointerArgumentsTests class methodsFor: 'initialize - event' stamp: 'CiprianTeodorov 4/9/2013 21:54'!
initialize
	self reset.! !

!NBPointerArgumentsTests class methodsFor: 'accessing' stamp: 'CiprianTeodorov 5/19/2013 03:45'!
resources
	^{NBTestResources}! !

!NBPointerArgumentsTests class methodsFor: 'array types' stamp: 'CiprianTeodorov 3/17/2013 00:25'!
structArrayType
	^StructArrayType isNil ifTrue: [StructArrayType := NBExternalArray ofType: self structType] ifFalse:[StructArrayType]! !

!NBPointerArgumentsTests class methodsFor: 'type classes' stamp: 'CiprianTeodorov 3/17/2013 00:18'!
structClass
	^NBTestStructure ! !

!NBPointerArgumentsTests class methodsFor: 'array types' stamp: 'CiprianTeodorov 3/17/2013 00:19'!
intArrayType
	^IntArrayType isNil ifTrue: [IntArrayType := NBExternalArray ofType: #NBInt32] ifFalse:[IntArrayType]! !

!NBPointerArgumentsTests class methodsFor: 'type classes' stamp: 'CiprianTeodorov 3/17/2013 00:18'!
structType
	^self structClass name ! !

!NBPointerArgumentsTests class methodsFor: 'array types' stamp: 'CiprianTeodorov 3/17/2013 00:29'!
enumArrayType
	^EnumArrayType isNil ifTrue: [EnumArrayType := NBExternalArray ofType: self enumType] ifFalse:[EnumArrayType]! !

!NBPointerArgumentsTests class methodsFor: 'accessing' stamp: 'CiprianTeodorov 4/9/2013 21:54'!
reset
	EnumArrayType := nil.
	IntArrayType := nil.
	PtrArrayType := nil.
	StructArrayType := nil.! !

!NBPointerArgumentsTests class methodsFor: 'type classes' stamp: 'CiprianTeodorov 3/17/2013 00:29'!
enumType
	^self enumClass name ! !

!NBPointerArgumentsTests class methodsFor: 'array types' stamp: 'CiprianTeodorov 3/17/2013 15:01'!
ptrArrayType
	^PtrArrayType isNil ifTrue: [PtrArrayType := NBExternalArray ofType: 'void *'] ifFalse:[PtrArrayType]! !

!NBPointerArgumentsTests class methodsFor: 'type classes' stamp: 'CiprianTeodorov 3/17/2013 00:30'!
enumClass
	^NBTestEnumeration ! !

!NBProxyFunction methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/9/2010 07:35'!
index
	^ index! !

!NBProxyFunction methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/9/2010 07:14'!
selector
	^ selector! !

!NBProxyFunction methodsFor: 'comparing' stamp: 'Igor.Stasenko 4/9/2010 07:13'!
hash
	^ selector hash! !

!NBProxyFunction methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/29/2010 03:29'!
minorVersion

	^minorVersion! !

!NBProxyFunction methodsFor: 'adding' stamp: 'Igor.Stasenko 4/29/2010 03:34'!
address
	self assert: (index < NBInterpreterProxy functions size).
	
	self checkVersion.
	^ NBInterpreterProxy fnAddressAt: index! !

!NBProxyFunction methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/29/2010 03:29'!
majorVersion: anObject

	majorVersion := anObject! !

!NBProxyFunction methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/29/2010 03:29'!
arguments: anObject

	arguments := anObject! !

!NBProxyFunction methodsFor: 'parsing' stamp: 'Igor.Stasenko 9/29/2010 09:24'!
parseArguments: args 
	" not userful, lets ignore it"

"	(args size = 1 and: [ args first == #void ]) ifTrue: [ arguments := #(). ^ self ].
	
	arguments := args collect: [:type |
		( #(sqInt sqIntPtr sqLong double charPtr voidPtr) includes: type ) ifFalse: [
			self error: 'invalid argument type'
		].
	
		type
	]"! !

!NBProxyFunction methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/9/2010 07:22'!
selector: aSelector

	selector := aSelector! !

!NBProxyFunction methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/29/2010 03:29'!
retType: anObject

	retType := anObject! !

!NBProxyFunction methodsFor: 'comparing' stamp: 'Igor.Stasenko 4/9/2010 07:14'!
= object
	^ self class == object class and: [ selector == object selector ]! !

!NBProxyFunction methodsFor: 'asserting' stamp: 'Igor.Stasenko 4/29/2010 07:36'!
checkVersion

	"exclude basic functions, otherwise we enter an endless chicken and egg loop"
	minorVersion = 0 ifTrue:  [ ^ self ].
		
	self assert: (NBInterpreterProxy majorVersion = majorVersion
		and: [ NBInterpreterProxy minorVersion >= minorVersion]).
! !

!NBProxyFunction methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/9/2010 07:34'!
index: anIndex
	index := anIndex! !

!NBProxyFunction methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/29/2010 03:29'!
minorVersion: anObject

	minorVersion := anObject! !

!NBProxyFunction methodsFor: 'printing' stamp: 'IgorStasenko 5/11/2011 16:47'!
printOn: aStream

	aStream print: selector.
	arguments ifNotNil: [ 
		aStream  
		space;
		print: arguments ]! !

!NBProxyFunction methodsFor: 'accessing' stamp: 'IgorStasenko 8/3/2011 07:32'!
requiresAlignment 
	^ requiresAlignment ~~ false! !

!NBProxyFunction methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/29/2010 03:29'!
arguments

	^arguments! !

!NBProxyFunction methodsFor: 'accessing' stamp: 'IgorStasenko 8/3/2011 07:36'!
requiresAlignment: aBool
	requiresAlignment := aBool! !

!NBProxyFunction methodsFor: 'accessing' stamp: 'IgorStasenko 5/11/2011 16:50'!
name
	^ selector ! !

!NBProxyFunction methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/29/2010 03:29'!
retType

	^retType! !

!NBProxyFunction methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/29/2010 03:29'!
majorVersion

	^majorVersion! !

!NBQSortCallback methodsFor: 'accessing' stamp: 'IgorStasenko 11/24/2012 15:30'!
trunk
	^ trunk! !

!NBQSortCallback methodsFor: 'accessing' stamp: 'IgorStasenko 11/24/2012 15:30'!
index
	^ index! !

!NBQSortCallback class methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/13/2010 22:54'!
fnSpec

	^ #(int ( NBExternalAddress a, NBExternalAddress b))! !

!NBQSortCallback class methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/8/2010 19:17'!
callType

	^ #cdecl! !

!NBRecursionDetect commentStamp: '<historical>'!
i am used to detect recursion during code generation..

use me like following:

NBRecursionDetect in: someMethod during: [
	... some block ..
	].

if recursion is detected, while evaluating the block, then NBCodeGenRecursion error will be signaled.

A recursion usually happens when generating code for some method requires generating code for very same method, and so it enters infinite loop!
!NBRecursionDetect methodsFor: 'accessing' stamp: 'IgorStasenko 5/28/2012 05:40'!
method
	^ method! !

!NBRecursionDetect methodsFor: 'signalling' stamp: 'IgorStasenko 5/28/2012 05:35'!
signalForMethod: aMethod
	method := aMethod.
	^ self signal! !

!NBRecursionDetect methodsFor: 'exceptiondescription' stamp: 'IgorStasenko 5/28/2012 06:01'!
defaultAction 
	^ false "false indicate no recursion"! !

!NBRecursionDetect methodsFor: 'public' stamp: 'IgorStasenko 5/28/2012 06:46'!
check: aMethod
	method == aMethod 
		ifTrue: [
			self resume: true "recursion detected"
			  ] 
		ifFalse: [ self pass ]! !

!NBRecursionDetect class methodsFor: 'helper' stamp: 'IgorStasenko 5/28/2012 07:02'!
in: aMethod during: aBlock

	(self signalForMethod: aMethod) ifTrue: [
		^ NBCodeGenRecursion signal: aMethod printString
		].

	^ aBlock on: self do: [:ex | ex check: aMethod ].! !

!NBRecursionDetect class methodsFor: 'signalling' stamp: 'IgorStasenko 5/28/2012 05:41'!
signalForMethod: aMethod
	^ self new signalForMethod: aMethod
! !

!NBSTIndirectArgument methodsFor: 'accessing' stamp: 'CiprianTeodorov 5/18/2013 00:05'!
emitLoad: gen
	| asm |
	asm := gen asm.
	argumentLoader emitLoad: gen to: asm EAX.
	gen optCheckIndirectArgBounds
		ifTrue: [ 
			| typeOk boundsFailed endLabel oop |
			typeOk := asm uniqueLabelName: 'typeOk'.
			boundsFailed := asm uniqueLabelName: 'boundsFailed'.
			endLabel := asm uniqueLabelName: 'end'.
			oop := gen reserveTemp.
			asm mov: asm EAX to: oop.	
			"type checking"
			gen proxy isPointers: oop.
			asm cmp: asm EAX with: 0 asImm.
			asm jne: typeOk.
			gen failWithMessage: 'Type checking failed on indirect argument loading'.
			asm label: typeOk.
			"bounds checking"
			"bigger than 0"
			elementIndex <= 0 ifTrue:[ ^self error: 'Bound checking failed on indirect argument loading. index should be bigger that 0.'].
			"smaller than slot size"
			gen proxy slotSizeOf: oop.
			asm cmp: asm EAX with: elementIndex asImm.
			asm jl: boundsFailed.
			asm mov: oop to: asm EAX.
			asm jmp: endLabel .
			asm label: boundsFailed.
			gen failWithMessage: 'Bound checking failed on indirect argument loading'.
			asm label: endLabel .
			 ].
	gen proxy fetchPointer: elementIndex - 1 ofObject: asm EAX.
	^ asm EAX! !

!NBSTIndirectArgument methodsFor: 'accessing' stamp: 'cipt 10/24/2012 20:34'!
elementIndex
	^ elementIndex! !

!NBSTIndirectArgument methodsFor: 'accessing' stamp: 'cipt 10/24/2012 20:34'!
argumentLoader: anObject
	argumentLoader := anObject! !

!NBSTIndirectArgument methodsFor: 'accessing' stamp: 'cipt 10/24/2012 20:34'!
elementIndex: anObject
	elementIndex := anObject! !

!NBSTIndirectArgument methodsFor: 'accessing' stamp: 'cipt 10/24/2012 20:34'!
emitLoad: gen to: operand
	self emitLoad: gen.
	operand = gen asm EAX ifFalse:[gen asm mov: gen asm EAX to: operand]! !

!NBSTIndirectArgument methodsFor: 'accessing' stamp: 'cipt 10/24/2012 20:34'!
argumentLoader
	^ argumentLoader! !

!NBSTIndirectArgument methodsFor: 'accessing' stamp: 'cipt 10/24/2012 20:39'!
usesSTStack
	^ argumentLoader usesSTStack! !

!NBSTIvarArgument commentStamp: 'Igor.Stasenko 4/30/2010 12:24'!
This guy knows how to load a receiver's ivar.

!
!NBSTIvarArgument methodsFor: 'emitting code' stamp: 'Igor.Stasenko 4/30/2010 14:33'!
emitLoad: gen
	"emit instructions to load a function argument into default register
	(EAX for integral types, FP(0) for floating point)"

	| index |
	index := receiverClass allInstVarNames indexOf: ivarName.
	
	gen receiverArgumentLoader emitLoad: gen to: gen asm EAX.
	
	"receiver in EAX"
	gen proxy fetchPointer: index-1 ofObject: gen asm EAX.
	
	^ gen asm EAX! !

!NBSTIvarArgument methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/30/2010 12:24'!
receiverClass: anObject

	receiverClass := anObject! !

!NBSTIvarArgument methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/30/2010 12:24'!
receiverClass

	^receiverClass! !

!NBSTIvarArgument methodsFor: 'emitting code' stamp: 'Igor.Stasenko 4/30/2010 12:29'!
emitLoad: gen to: operand
	"emit instructions to load a function argument into given operand"
	
	self emitLoad: gen.
	
	operand = gen asm EAX ifFalse: [ gen asm mov: gen asm EAX to: operand ]
! !

!NBSTIvarArgument methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/30/2010 12:24'!
ivarName

	^ivarName! !

!NBSTIvarArgument methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/30/2010 12:24'!
ivarName: anObject

	ivarName := anObject! !

!NBSTIvarArgument methodsFor: 'testing' stamp: 'Igor.Stasenko 5/18/2010 02:22'!
usesSTStack
	^ true " to fetch receiver we accessing the stack"! !

!NBSTMethodArgument commentStamp: 'Igor.Stasenko 4/30/2010 10:47'!
i know what to emit for loading a method's argument from VM stack into register
!
!NBSTMethodArgument methodsFor: 'emitting the code' stamp: 'Igor.Stasenko 4/30/2010 07:25'!
emitLoad: gen

	gen proxy stackValue: stackIndex.
	
	^ gen asm EAX! !

!NBSTMethodArgument methodsFor: 'initialization' stamp: 'IgorStasenko 8/5/2011 18:00'!
initialize 
	isReceiver := false! !

!NBSTMethodArgument methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/30/2010 07:23'!
stackIndex: anObject

	stackIndex := anObject! !

!NBSTMethodArgument methodsFor: 'accessing' stamp: 'IgorStasenko 8/5/2011 18:00'!
isReceiver: aBool
	isReceiver := aBool ! !

!NBSTMethodArgument methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/30/2010 07:23'!
stackIndex

	^stackIndex! !

!NBSTMethodArgument methodsFor: 'emitting the code' stamp: 'Igor.Stasenko 4/30/2010 12:22'!
emitLoad: gen to: operand
	"emit instructions to load a function argument into given operand"
	
	gen proxy stackValue: stackIndex.
	
	operand = gen asm EAX ifFalse: [ gen asm mov: gen asm EAX to: operand ]
! !

!NBSTMethodArgument methodsFor: 'accessing' stamp: 'IgorStasenko 8/5/2011 18:00'!
isReceiver 
	^ isReceiver ! !

!NBSTMethodArgument methodsFor: 'testing' stamp: 'Igor.Stasenko 5/18/2010 02:22'!
usesSTStack
	^ true " to fetch receiver we accessing the stack"! !

!NBSTMethodArgument class methodsFor: 'errors' stamp: 'IgorStasenko 8/6/2011 18:20'!
lastError
	<primitive: #primitiveLastNativeCodeError module: #NativeBoostPlugin>
	^ self error: 'NativeBoost plugin is missing?'! !

!NBSizeT commentStamp: '<historical>'!
i implement marshalling for the size_t type.

size_t value size depends on a platform's word size.
on 32-bit it will be 32 bit.
on 64-bit it will be 64 bit 
!
!NBSizeT class methodsFor: 'converting' stamp: 'IgorStasenko 9/3/2012 00:10'!
asNBExternalType: gen

	self pointerSize = 4 ifTrue: [
		^ (gen resolveType: #uint32 )
		].
	
	self pointerSize = 8 ifTrue: [
		^  (gen resolveType: #uint64 )
		].
	
	self error: 'no clue'! !

!NBTCHAR commentStamp: 'Igor.Stasenko 4/29/2010 13:44'!
- depending on context, acts either as char or wchar!
!NBTCHAR class methodsFor: 'converting' stamp: 'Igor.Stasenko 5/1/2010 10:56'!
asNBExternalType: gen

	^ (gen optionAt: #WinUnicode) 
		ifTrue: [ 'wchar_t' asNBExternalType: gen ]
		ifFalse: [ #uchar asNBExternalType: gen ]
! !

!NBTString commentStamp: 'Igor.Stasenko 4/29/2010 14:26'!
- depending on context, acts either as char* or wchar* string!
!NBTString class methodsFor: 'converting' stamp: 'Igor.Stasenko 5/1/2010 10:56'!
asNBExternalType: gen

	^ (gen optionAt: #WinUnicode) 
		ifTrue: [ NBWideString asNBExternalType: gen ]
		ifFalse: [ NBExternalString asNBExternalType: gen ]
! !

!NBTestCallbackReturnEnum class methodsFor: 'as yet unclassified' stamp: 'CiprianTeodorov 12/11/2012 19:53'!
fnSpec 
	^#(#NBTestEnumeration (NBInt32))! !

!NBTestCallbackReturnEnum1 class methodsFor: 'as yet unclassified' stamp: 'CiprianTeodorov 12/13/2012 20:14'!
fnSpec 
	^#(#NBTestEnumerationFromPairs (NBInt32))! !

!NBTestEnumeration class methodsFor: 'as yet unclassified' stamp: 'CiprianTeodorov 12/11/2012 19:10'!
enumDecl
	^ {(#AAA -> 1).
	(#BBB -> 2).
	(#CCC -> 3).
	(#DDD -> 2400)} asDictionary ! !

!NBTestEnumerationFromPairs class methodsFor: 'as yet unclassified' stamp: 'CiprianTeodorov 12/13/2012 08:22'!
enumDecl
	^ #(AAA 1
	BBB  2
	CCC 3
	DDD 2400) ! !

!NBTestExternalValue methodsFor: '*generated-code-non-existing-package' stamp: 'CiprianTeodorov 4/9/2013 19:46'!
value
	"Note, this method used as a template for my anonymous subclasses. "
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self emitRead! !

!NBTestExternalValue methodsFor: '*generated-code-non-existing-package' stamp: 'CiprianTeodorov 4/9/2013 19:46'!
value: value
	"Note, this method used as a template for my anonymous subclasses. "
	
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self emitWrite ! !

!NBTestExternalValue class methodsFor: 'class initialization' stamp: 'CiprianTeodorov 4/9/2013 21:07'!
initialize

	self initValueType: 'int'.! !

!NBTestNestedStructure class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 5/26/2012 19:45'!
fieldsDesc
" self createAccessors "
	^ #(
	
		NBTestStructure1byte oneByte;
		int otherField
		)! !

!NBTestResources methodsFor: 'running' stamp: 'CiprianTeodorov 5/19/2013 03:36'!
setUp
	{NBTestNestedStructure.
	NBTestStructure.
	NBTestStructure1byte.
	NBTestStructure2.
	NBTestStructure9bytes.
	NBTestStructureWithCallback.
	NBTestUnion1Byte.
	NBTestUnion2Pointers.
	NBTestUnionIntSize.
	NBTestUnionWithCallback.
	NBTestUnionWithStructure.
	NBTestUnionWithUnion} do: [ :each | each perform: #rebuildFieldAccessors ]! !

!NBTestStructure class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 9/3/2012 01:44'!
fieldsDesc
" self rebuildFieldAccessors "
	^ #(
		byte byte;
		short short;
		long long;
		float float;
		double double;
		int64 int64;
		)! !

!NBTestStructure1byte class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 9/3/2012 02:36'!
fieldsDesc
" self rebuildFieldAccessors "
	^ #(
		byte field
		)! !

!NBTestStructure2 class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 9/3/2012 02:36'!
fieldsDesc
" self rebuildFieldAccessors "
	^ #(
		NBExternalAddress addr
		)! !

!NBTestStructure9bytes class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 9/3/2012 02:36'!
fieldsDesc
" self rebuildFieldAccessors"
	^ #(
		int x;
		int y;
		char field
		)! !

!NBTestStructureWithCallback class methodsFor: 'as yet unclassified' stamp: 'cipt 11/28/2012 19:10'!
fieldsDesc
" self rebuildFieldAccessors "
	^ #(
		int x;
		NBQSortCallback callback;
		int y;
		)! !

!NBTestStructureWithPointer1 class methodsFor: 'as yet unclassified' stamp: 'CiprianTeodorov 7/30/2014 18:06'!
fieldsDesc
" self rebuildFieldAccessors "
	^ #(
		NBTestUnion2Pointers * field
		)! !

!NBTestUnion1Byte class methodsFor: 'as yet unclassified' stamp: 'CiprianTeodorov 1/19/2013 17:28'!
fieldsDesc
	"		self rebuildFieldAccessors		 "
	^#(
		byte field1
		byte field2
		)! !

!NBTestUnion2Pointers class methodsFor: 'as yet unclassified' stamp: 'CiprianTeodorov 1/19/2013 17:31'!
fieldsDesc
	"			self rebuildFieldAccessors 			"
	^ #(
		NBExternalAddress addr1
		NBExternalAddress addr2
		)! !

!NBTestUnionIntSize class methodsFor: 'as yet unclassified' stamp: 'CiprianTeodorov 1/19/2013 17:33'!
fieldsDesc
	" 		self rebuildFieldAccessors 			"
	^ #(
		int x;
		int y;
		char field
		)! !

!NBTestUnionWithCallback class methodsFor: 'as yet unclassified' stamp: 'CiprianTeodorov 1/19/2013 17:36'!
fieldsDesc
	" 		self rebuildFieldAccessors 			"
	^ #(
		char x;
		NBQSortCallback callback;
		)! !

!NBTestUnionWithStructure class methodsFor: 'as yet unclassified' stamp: 'CiprianTeodorov 1/19/2013 17:38'!
fieldsDesc
	"		self rebuildFieldAccessors		 "
	^ #(
		char x;
		NBTestStructure9bytes struct;
		int z;
	)! !

!NBTestUnionWithUnion class methodsFor: 'as yet unclassified' stamp: 'CiprianTeodorov 1/19/2013 17:43'!
fieldsDesc
	"		self rebuildFieldAccessors		 "
	^ #(
		char x;
		NBTestUnionIntSize union;
		double z;
	)! !

!NBUInt16 commentStamp: '<historical>'!
I responsible for marshalling 
	
	unsigned 16-bit integer 

type values.!
!NBUInt16 methodsFor: 'emitting code' stamp: 'IgorStasenko 9/2/2012 23:14'!
pushAsValue: gen

	gen asm push: (gen proxy positive32BitValueOf: (loader emitLoad: gen))! !

!NBUInt16 methodsFor: 'accessing' stamp: 'IgorStasenko 9/2/2012 23:14'!
valueSize
	^ 2! !

!NBUInt16 methodsFor: 'emitting code' stamp: 'IgorStasenko 9/2/2012 23:14'!
coerceReturnValue: gen
	| asm |
	
	"convert signed short to ST integer"
	asm := gen asm.
	
	asm movzx: asm EAX with: asm AX.

	gen proxy integerObjectOf: asm EAX.
 
	! !

!NBUInt32 commentStamp: '<historical>'!
I responsible for marshalling 
	
	unsigned 32-bit integer 

type values.!
!NBUInt32 methodsFor: 'emitting code' stamp: 'IgorStasenko 9/2/2012 23:17'!
coerceReturnValue: gen
	| asm |
	
	"convert signed byte to ST integer"
	asm := gen asm.
	
	gen proxy positive32BitIntegerFor: asm EAX.! !

!NBUInt32 methodsFor: 'emitting code' stamp: 'CiprianTeodorov 12/11/2012 19:22'!
coerceOopToOperand: gen ifFailedJumpTo: aLabel
	" input: 
		EAX - oop
	  output:
	      EAX - result of coercion
	"
	
	self assert: (pointerArity = 0).
	gen proxy positive32BitValueOf: gen asm EAX! !

!NBUInt32 methodsFor: 'accessing' stamp: 'IgorStasenko 9/2/2012 23:17'!
valueSize
	^ 4! !

!NBUInt32 methodsFor: 'emitting code' stamp: 'IgorStasenko 9/2/2012 23:17'!
pushAsValue: gen
	| asm |
	asm := gen asm.

	asm push:
		(gen proxy positive32BitValueOf: (loader emitLoad: gen)).

	gen optCheckFailOnEveryArgument ifTrue: [
		gen proxy ifFailedEmit: [  gen failWithMessage: 'Argument coercion failed: positive 32-bit integer value expected' ].
	].! !

!NBUInt64 commentStamp: '<historical>'!
I responsible for marshalling 
	
	unsigned 64-bit integer 

type values.!
!NBUInt64 methodsFor: 'emitting code' stamp: 'IgorStasenko 9/3/2012 01:11'!
readOop: memoryOperand generator: gen
	"emit code to read a value from given memory operand
	and convert it to a corresponding ST object" 
	| asm |
	
	pointerArity > 0 ifTrue: [
		asm mov: memoryOperand to: asm EAX.
		^ self coerceReturn: gen
		].
	
	asm := gen asm.
	
	asm 
		lea: asm EAX with: memoryOperand;
		mov: asm EAX ptr + 4 to: asm EDX;
		mov: asm EAX ptr to: asm EAX.  
	
	self coerceReturn: gen
	! !

!NBUInt64 methodsFor: 'emitting code' stamp: 'IgorStasenko 9/3/2012 00:25'!
pushAsValue: gen
	| asm |
	asm := gen asm.

	gen proxy positive64BitValueOf: (loader emitLoad: gen).

	asm 
		push: asm EDX;
		push: asm EAX.

	gen optCheckFailOnEveryArgument ifTrue: [
		gen proxy ifFailedEmit: [  gen failWithMessage: 'Argument coercion failed: unsigned 64-bit integer value expected' ].
	].! !

!NBUInt64 methodsFor: 'emitting code' stamp: 'IgorStasenko 9/3/2012 01:10'!
loadMem: memoryOperand generator: gen

	self shouldNotImplement! !

!NBUInt64 methodsFor: 'accessing' stamp: 'IgorStasenko 9/2/2012 23:22'!
valueSize
	^ 8! !

!NBUInt64 methodsFor: 'emitting code' stamp: 'IgorStasenko 9/3/2012 00:57'!
coerceReturnValue: gen
	
	"convert 64-bit unsigned value in EAX:EDX to ST integer"
	gen proxy positive64BitIntegerFor
	
	! !

!NBUInt8 commentStamp: '<historical>'!
I responsible for marshalling 
	
	unsigned 8-bit integer 

type values.!
!NBUInt8 methodsFor: 'emitting code' stamp: 'IgorStasenko 9/2/2012 23:12'!
pushAsValue: gen 

	gen asm push: (	gen proxy positive32BitValueOf: (loader emitLoad: gen)).

	! !

!NBUInt8 methodsFor: 'accessing' stamp: 'IgorStasenko 9/2/2012 23:12'!
valueSize
	^ 1! !

!NBUInt8 methodsFor: 'emitting code' stamp: 'IgorStasenko 9/2/2012 23:12'!
coerceReturnValue: gen
	| asm |
	
	"convert unsigned byte to ST integer"
	asm := gen asm.
	
	asm movzx: asm EAX with: asm AL.

	gen proxy integerObjectOf: asm EAX.
 
	! !

!NBUTF8StringExample commentStamp: 'IgorStasenko 8/8/2011 17:29'!
This is an example of defining custom type.
This type accepts a string(s) and converts them into utf-8 representation on stack on the fly and then pushes the pointer to converted string to callee.



UTF8TextConverter new convertFromSystemString: (
NBBasicExamples new encodeToUTF8: 'owehjfopeh fr´' asWideString)!
!NBUTF8StringExample methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 7/23/2012 13:29'!
prepareArgumentUsing: gen

	"prepare the ByteString argument.
	Allocate a space for string on stack, then copy string contents there
	and add terminating null character "
	
	| asm stringOop len loop done donePreparing notNil 
	 moreThanOne moreThanTwo moreThanThree typeCheck |
	
	asm := gen asm.
	
	typeCheck := asm uniqueLabelName: 'ok'.
	loop := asm uniqueLabelName: 'loop'.
	done := asm uniqueLabelName: 'done'.
	notNil  := asm uniqueLabelName: 'notNil'.
	donePreparing := asm uniqueLabelName: 'donePreparing'.
	moreThanOne := asm uniqueLabelName: 'moreThanOne'.  
	moreThanTwo := asm uniqueLabelName: 'moreThanTwo'.  
	moreThanThree := asm uniqueLabelName: 'moreThanThree'.  
	    
	loader emitLoad: gen.

	"reserve after emitting load, otherwise, if proxy using stackpointer temp, it will be clobbered"
	address := gen reserveTemp.  
	stringOop := gen reserveTemp.
	len := gen reserveTemp.

	asm mov: EAX to: stringOop.
	
	gen optStringOrNull ifTrue: [
		"allow passing nil as string, effectively will push null pointer as argument"
		gen proxy nilObject.
		asm 
			cmp: EAX with: stringOop;
			jne: notNil;
			mov: 0 to: address;  "null pointer"
			jmp: donePreparing.
	].
	asm label: notNil.
	gen proxy isWords: stringOop.
	asm or: EAX with: EAX.
	asm jne: typeCheck.
	gen failWithMessage: 'WideString instance expected'.
	asm label: typeCheck.	
	gen proxy slotSizeOf: stringOop.
	asm mov: EAX to: len.

	"len*4 +1 - the total number of bytes to reserve on stack"
	asm 
		shl: EAX with: 2;
		inc: EAX.
	gen reserveStackBytes: EAX andStoreAddrTo: address.

	gen proxy firstIndexableField: stringOop.

	asm decorateWith: ' copy string contents to the stack ' during: [
	asm 
		push: ESI;
		push: EDI;
		mov: EAX to: ESI;
		mov: address to: EDI;
		mov: len to: ECX;

	label: loop;
		dec: ECX;
		jl: done;
		
		"load the unicode value"
		mov: ESI ptr to: EAX;
		
		cmp: EAX with: 16r7F;
		jg: moreThanOne;
	"one byte"
		mov: AL to: EDI ptr;
		inc: EDI;
		add: ESI with: 4;
		jmp: loop;
	label: moreThanOne;
		cmp: EAX with: 16r7FF;
	 	jg: moreThanTwo;
	"two bytes"
		mov: EAX to: EDX;
		shr: EDX with: 6;
		or: DL with: 16rC0 asUImm;
		mov: DL to: EDI ptr;
		inc: EDI;
		and: AL with: 2r111111;
		or: AL with: 16r80 asUImm;
		mov: AL to: EDI ptr;
		inc: EDI;
		add: ESI with: 4;
		jmp: loop;
	label: moreThanTwo;
		cmp: EAX with: 16rFFFF;
	 	jg: moreThanThree;
	"three bytes"	
		mov: EAX to: EDX;
		shr: EDX with: 12;
		or: DL with: 2r11100000 asUImm;
		mov: DL to: EDI ptr;
		inc: EDI;

		mov: EAX to: EDX;
		shr: EDX with: 6;
		and: DL with: 2r111111;
		or: DL with: 16r80 asUImm;
		mov: DL to: EDI ptr;
		inc: EDI;

		and: AL with: 2r111111;
		or: AL with: 16r80 asUImm;
		mov: AL to: EDI ptr;
		inc: EDI;
		add: ESI with: 4;
		jmp: loop;
		
	label: moreThanThree;
		cmp: EAX with: 16r1FFFFF;
		jg: gen failedLabel; "no more than 4 bytes!!"
	"4 bytes"
		mov: EAX to: EDX;
		shr: EDX with: 18;
		or: DL with: 2r11110000 asUImm;
		mov: DL to: EDI ptr;
		inc: EDI;

		mov: EAX to: EDX;
		shr: EDX with: 12;
		and: DL with: 2r111111;
		or: DL with: 16r80 asUImm;
		mov: DL to: EDI ptr;
		inc: EDI;

		mov: EAX to: EDX;
		shr: EDX with: 6;
		and: DL with: 2r111111;
		or: DL with: 16r80 asUImm;
		mov: DL to: EDI ptr;
		inc: EDI;

		and: AL with: 2r111111;
		or: AL with: 16r80 asUImm;
		mov: AL to: EDI ptr;
		inc: EDI;
		add: ESI with: 4;
		jmp: loop;
		
	label: done;
		mov: 0 to: EDI ptr8;  "store null-terminating character"
		pop: EDI;
		pop: ESI.
	].
	gen releaseTemps: 2.  "keep the address reserved, otherwise it will be clobbered"
	asm label: donePreparing! !

!NBUTF8StringExample methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/6/2011 16:04'!
pushAsValue: gen

	gen asm push: address.

! !

!NBUnixConstants class methodsFor: 'initialization' stamp: 'Igor.Stasenko 9/25/2010 06:57'!
initialize
	" self initialize "
	"from <bits/mman.h>"
	self
		initDlopenFlags;
		initMmapFlags! !

!NBUnixConstants class methodsFor: 'initialization' stamp: 'Igor.Stasenko 9/25/2010 08:37'!
initDlopenFlags

"From <bits/dlfcn.h>"

" The MODE argument to `dlopen' contains one of the following: "
	RTLD_LAZY	 := 16r00001. "Lazy function call binding."
	RTLD_NOW := 16r00002. " Immediate function call binding. "
	RTLD_BINDING_MASK := 16r3. " Mask of binding time value. "
	RTLD_NOLOAD	:= 16r00004. " Do not load the object."
	RTLD_DEEPBIND := 16r00008. " Use deep binding. "

" If the following bit is set in the MODE argument to `dlopen',
   the symbols of the loaded object and its dependencies are made
   visible as if the object were linked directly into the program.  "
	RTLD_GLOBAL := 16r00100.

" Unix98 demands the following flag which is the inverse to RTLD_GLOBAL.
   The implementation does this by default and so we can define the
   value to zero.  "
	RTLD_LOCAL := 0.

" Do not delete object when closed.  "
	RTLD_NODELETE := 16r01000.
	
" From <dlfcn.h> "
" If the first argument of `dlsym' or `dlvsym' is set to RTLD_NEXT
   the run-time address of the symbol called NAME in the next shared
   object is returned.  The 'next' relation is defined by the order
   the shared objects were loaded.  "
	RTLD_NEXT := 16rFFFFFFFF.  "  ((void *) -1l) "
   
" If the first argument to `dlsym' or `dlvsym' is set to RTLD_DEFAULT
   the run-time address of the symbol called NAME in the global scope
   is returned.  " 
	RTLD_DEFAULT := 0. 
   

! !

!NBUnixConstants class methodsFor: 'initialization' stamp: 'Igor.Stasenko 9/25/2010 09:12'!
initMmapFlags

	"From <bits/mman.h>"

	" Memory protection flags, can be bitored "	
		
	PROT_READ := 16r1.	" Page can be read.  "
	PROT_WRITE := 16r2.	" Page can be written. "
	PROT_EXEC := 16r4.	" Page can be executed. "
	PROT_NONE := 16r0. 	" Page can not be accessed. "

	PROT_GROWSDOWN  := 16r01000000. " Extend change to start of growsdown vma (mprotect only). "
	PROT_GROWSUP := 16r02000000. "Extend change to start of growsup vma (mprotect only). "

	
	" Sharing types (must choose one and only one of these). "
	MAP_SHARED := 16r01.		"Share changes."
	MAP_PRIVATE := 16r02.		"Changes are private."
	
	MAP_TYPE := 16r0f. 	"Mask for type of mapping. "

	" Other flags. "
	MAP_FIXED := 16r10.	"Interpret addr exactly. "

	MAP_FILE := 0.
	MAP_ANONYMOUS := 16r20. "Don't use a file."
	MAP_ANON := MAP_ANONYMOUS.
	MAP_32BIT := 16r40.	"Only give out 32-bit addresses."

	"These are Linux-specific."

	MAP_GROWSDOWN := 16r00100.	"Stack-like segment."
	MAP_DENYWRITE := 16r00800.		" ETXTBSY "
	MAP_EXECUTABLE := 16r01000.	" Mark it as an executable."
	MAP_LOCKED := 16r02000. 		" Lock the mapping. "
	MAP_NORESERVE := 16r04000.		" Don't check for reservations. "
	MAP_POPULATE := 16r08000.		" Populate (prefault) pagetables. "
	MAP_NONBLOCK := 16r10000.		" Do not block on IO."
	MAP_STACK := 16r20000.			" Allocation is for a stack. "

	MAP_FAILED := 16rFFFFFFFF.  "-1"! !

!NBUnixExternalHeapManager commentStamp: 'Igor.Stasenko 9/26/2010 04:05'!
Unix heap implementation, based on mmap()/munmap()
functions to manage external heap.!
!NBUnixExternalHeapManager methodsFor: 'memory pages' stamp: 'Igor.Stasenko 9/26/2010 03:37'!
primAllocatePage: bytesToAllocate
	| ptr buf |

	buf := ByteArray new: 4.

	self 
		mmapLength: bytesToAllocate 
		prot: self protFlags 
		flags: self mapFlags 
		into: buf.

	ptr := buf unsignedLongAt: 1 bigEndian: false.
	ptr = MAP_FAILED ifTrue: [ self error: 'Unable to map virtual memory' ].
	
	^ ptr

 ! !

!NBUnixExternalHeapManager methodsFor: 'private' stamp: 'IgorStasenko 11/24/2012 17:24'!
mmapLength: bytesToAllocate prot: protFlags flags: mapFlags into: returnValueBuffer
		
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>

	"Note:  mmap using 32-bit offset, while mmap64 - 64bit one"

	^ self nbCallout 
		options: #( - optDirectProxyFnAddress );
		function: #(
			NBBootstrapUlong ( 0, uint bytesToAllocate, int protFlags, int mapFlags,
				-1,  0 "offset" )
		
		) emit:  [:gen | | mmap |
			mmap := NativeBoost forCurrentPlatform getGlobalSymbolPointer: 'mmap'.
			gen asm mov: mmap asUImm32 to: gen asm EAX.
			gen asm call: gen asm EAX
			]

 ! !

!NBUnixExternalHeapManager methodsFor: 'flags' stamp: 'Igor.Stasenko 9/25/2010 08:49'!
mapFlags

	^ MAP_ANON bitOr: MAP_PRIVATE! !

!NBUnixExternalHeapManager methodsFor: 'flags' stamp: 'Igor.Stasenko 9/26/2010 03:51'!
protFlags
	"since NativeBoost using heap for placing executable code there,
	it is important that all allocated memory should be executable"
	^  (PROT_READ bitOr: PROT_WRITE) bitOr: PROT_EXEC! !

!NBUnixExternalHeapManager methodsFor: 'memory pages' stamp: 'Igor.Stasenko 9/26/2010 03:45'!
primFreePage: aMemoryPage

	"call munmap()"

	| res |
	res := self unmap: aMemoryPage address length: aMemoryPage length.
	res = 0 ifFalse: [ self error: 'error during unmapping virtual memory page' ]! !

!NBUnixExternalHeapManager methodsFor: 'private' stamp: 'IgorStasenko 11/24/2012 17:25'!
unmap: addr  length: len 
		
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>

	"unmap memory page"

	^ self nbCallout 
		function: #( int munmap (uint addr, ulong  len)  ) 
		module: RTLD_DEFAULT
 ! !

!NBUnixSpecificTest class methodsFor: 'testing' stamp: 'TorstenBergmann 8/7/2013 12:12'!
isAbstract
  	"only run test subclasses on Unix"

	^(self name = #NBUnixSpecificTest)
		or: [ OSPlatform isUnix not ]! !

!NBVoid methodsFor: 'emitting code' stamp: 'IgorStasenko 9/3/2012 00:14'!
pushAsValue: gen

	self error: 'pushing void ... puff... done!!'! !

!NBVoid methodsFor: 'emitting code' stamp: 'Igor.Stasenko 5/11/2010 02:30'!
coerceOopToOperand: gen ifFailedJumpTo: aLabel

	"coerce a object - oop , provided by loader and then put a result into an appropriate 
	operand (memory/register), answer that operand"
	
	pointerArity = 0 ifTrue: [ ^ self .  "returning void, do nothing " ].
	
	self shouldBeImplemented ! !

!NBVoid methodsFor: 'emitting code' stamp: 'Igor.Stasenko 5/3/2010 14:00'!
coerceReturnValue: gen

	"just return nil"
	
	gen proxy nilObject
! !

!NBVoid methodsFor: 'accessing' stamp: 'CiprianTeodorov 12/15/2012 21:13'!
valueSize 
	pointerArity < 1 ifTrue: [^self error: 'void has unknown size'].
	^self pointerSize ! !

!NBWeakFinalizerItem methodsFor: 'accessing' stamp: 'IgorStasenko 5/31/2012 03:15'!
index
	^ index! !

!NBWeakFinalizerItem methodsFor: 'accessing' stamp: 'IgorStasenko 5/31/2012 03:56'!
list: aList index: i freeIndex: nextFreeIndex

	list := aList.
	index := i.
	next := nextFreeIndex ! !

!NBWeakFinalizerItem methodsFor: 'accessing' stamp: 'IgorStasenko 5/31/2012 03:49'!
markAsFree: oldFreeIndex
	next := oldFreeIndex.
	executor := nil.
	"to make sure"
	self basicAt: 1 put: nil.! !

!NBWeakFinalizerItem methodsFor: 'accessing' stamp: 'IgorStasenko 5/31/2012 03:15'!
index: aNumber
	index := aNumber! !

!NBWeakFinalizerItem methodsFor: 'accessing' stamp: 'IgorStasenko 5/31/2012 04:00'!
object: anObject executor: ex

	executor := ex.
	self basicAt: 1 put: anObject! !

!NBWeakFinalizerItem methodsFor: 'accessing' stamp: 'IgorStasenko 5/31/2012 03:48'!
nextFreeIndex
	^ next! !

!NBWeakFinalizerItem methodsFor: 'public API' stamp: 'IgorStasenko 6/2/2012 15:23'!
doNotFinalize
	"send this message to avoid triggering finalization, once weakly-referenced object is dead"
	
	executor := nil.! !

!NBWin32Caret commentStamp: 'TorstenBergmann 12/18/2014 14:14'!
please use Caret in OSWindows project!
!NBWin32Caret class methodsFor: 'accessing' stamp: 'tbn 8/6/2013 22:20'!
getBlinkTime
	"Returns the elapsed time, in milliseconds, required to invert the caret's pixels. The user can set this value using the Control Panel."	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ NBFFICallout stdcall: #( uint GetCaretBlinkTime()) module: #user32
! !

!NBWin32Handle commentStamp: '<historical>'!
Instances of this class represent a reference value to a Win32 resource (file, window, ...)!
!NBWin32Handle methodsFor: 'conversion' stamp: 'Igor.Stasenko 5/18/2010 22:56'!
asUnsignedLong
	^ handle asUnsignedLong! !

!NBWin32Handle methodsFor: 'call convention' stamp: 'IgorStasenko 11/25/2012 14:16'!
nbCallingConvention
	^ #stdcall! !

!NBWin32Handle methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/17/2010 05:02'!
value: uint

	handle value: uint! !

!NBWin32Hdc methodsFor: 'operations' stamp: 'IgorStasenko 11/25/2012 14:17'!
rectangleLeft: nLeftRect top: nTopRect right: nRightRect bottom: nBottomRect
		<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
		^self nbCall: #(BOOL Rectangle(
			HDC self ,	 
   			int nLeftRect,	 
	     		int nTopRect,	 
            	int nRightRect,	 
            	int nBottomRect)) 
		module: #gdi32
! !

!NBWin32Hdc methodsFor: 'operations' stamp: 'IgorStasenko 11/25/2012 14:17'!
lineToX:  nXEnd y: nYEnd
		<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
		^self nbCall: #(BOOL LineTo(HDC self, int nXEnd, int nYEnd)) 
			module: #gdi32
! !

!NBWin32Hdc methodsFor: 'operations' stamp: 'IgorStasenko 11/25/2012 14:17'!
moveToX:  x y: y
		<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
		^self nbCall: #(BOOL MoveToEx(HDC self, int x, int y, 0)) 
			module: #gdi32
! !

!NBWin32Heap methodsFor: 'win heap api' stamp: 'IgorStasenko 11/24/2012 17:30'!
alloc: numberOfBytes

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>

	^ self nbCall: #( LPVOID HeapAlloc (self , 0 , SIZE_T numberOfBytes) )! !

!NBWin32Heap methodsFor: 'win heap api' stamp: 'IgorStasenko 11/24/2012 17:31'!
free: lpMem
"The HeapFree function frees a memory block allocated from a heap by the HeapAlloc or HeapReAlloc function. "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>


	^ self nbCall: #( BOOL HeapFree (self, 0, LPVOID lpMem) )! !

!NBWin32Heap methodsFor: 'win heap api' stamp: 'IgorStasenko 11/24/2012 17:32'!
sizeOf: lpMem

	"The HeapSize function retrieves the size of a memory block allocated from a heap by the HeapAlloc or HeapReAlloc function."
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>


	^ self nbCall: 
		#( SIZE_T HeapSize (self, 0 , LPCVOID lpMem) ) 
! !

!NBWin32Heap methodsFor: 'win heap api' stamp: 'IgorStasenko 11/24/2012 17:31'!
destroy

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>


	^ self nbCall: #( BOOL HeapDestroy (self) )! !

!NBWin32Heap methodsFor: 'win heap api' stamp: 'Igor.Stasenko 5/3/2010 02:05'!
privSetHandle: aHandle
	"do not use, if you not sure what you doing"
	handle := aHandle! !

!NBWin32Heap methodsFor: 'win heap api' stamp: 'IgorStasenko 11/24/2012 17:32'!
validate

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>


	^ self nbCall: #( BOOL HeapValidate (self) )! !

!NBWin32Heap methodsFor: 'win heap api' stamp: 'IgorStasenko 11/24/2012 17:32'!
unlock

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>


	^ self nbCall: #( BOOL HeapUnlock (self) )
! !

!NBWin32Heap methodsFor: 'win heap api' stamp: 'IgorStasenko 11/24/2012 17:33'!
zalloc: numberOfBytes
	"same as #alloc: but additionally zero-fill the allocated memory"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>


	^ self nbCall:
		#( LPVOID HeapAlloc (self , HEAP_ZERO_MEMORY , SIZE_T numberOfBytes) ) 
! !

!NBWin32Heap methodsFor: 'win heap api' stamp: 'IgorStasenko 11/24/2012 17:32'!
lock

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>


	^ self nbCall: #( BOOL HeapLock (self) )! !

!NBWin32Heap methodsFor: 'win heap api' stamp: 'IgorStasenko 11/24/2012 17:31'!
compact
"The HeapCompact function attempts to compact a specified heap. It compacts the heap by coalescing adjacent free blocks of memory and decommitting large free blocks of memory."
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>


	^ self nbCall: #( SIZE_T HeapCompact (self , 0) )! !

!NBWin32Heap methodsFor: 'call convention' stamp: 'IgorStasenko 11/24/2012 17:29'!
nbCallingConvention
	^ #stdcall! !

!NBWin32Heap methodsFor: 'call convention' stamp: 'IgorStasenko 11/24/2012 17:30'!
nbLibraryNameOrHandle
	^ #Kernel32! !

!NBWin32Heap methodsFor: 'win heap api' stamp: 'IgorStasenko 11/24/2012 17:32'!
realloc: flags mem: lpMem size: dwBytes

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>


	^ self nbCall: 
			#( LPVOID HeapReAlloc (self, DWORD flags, LPVOID lpMem, SIZE_T dwBytes) )
! !

!NBWin32Heap class methodsFor: 'instance creation' stamp: 'IgorStasenko 11/24/2012 17:35'!
create: options initialiSize: dwInitialSize maximumSize: dwMaximumSize

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>

	^ self nbCallout stdcall function: 
		#( NBWin32Heap HeapCreate (
			DWORD options, 
			SIZE_T dwInitialSize,
			SIZE_T dwMaximumSize) ) 
		module: #Kernel32
! !

!NBWin32Menu commentStamp: 'TorstenBergmann 12/18/2014 14:15'!
please use WinMenu in OSWindows project!
!NBWin32MessageBox commentStamp: 'TorstenBergmann 12/18/2014 14:16'!
please use WinMessageBox in OSWindows project!
!NBWin32MessageBox class methodsFor: 'instance creation' stamp: 'tbn 11/11/2012 20:00'!
test

	self messageBox: NBWin32Window getFocus text: 'Hello from Pharo' title: 'Pharo' flags: MB_YESNO! !

!NBWin32MessageBox class methodsFor: 'instance creation' stamp: 'IgorStasenko 11/25/2012 14:49'!
messageBox: hWnd text: lpText title: lpCaption flags: uType

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>

	^ self nbCallout stdcall function: #(int MessageBoxA(
  			HWND hWnd,
    			LPCTSTR  lpText,
    			LPCTSTR  lpCaption,
      		UINT uType
		)) module: #user32! !

!NBWin32Point class methodsFor: 'instance creation' stamp: 'TorstenBergmann 8/7/2013 13:08'!
x: x y: y

	^(self new)
		x: x;
		y: y;
		yourself! !

!NBWin32Point class methodsFor: 'accessing' stamp: 'TorstenBergmann 8/7/2013 12:42'!
fieldsDesc
" self rebuildFieldAccessors "
	^ #(
		long x;
		long y;
		)! !

!NBWin32PointTest methodsFor: 'tests' stamp: 'TorstenBergmann 8/7/2013 13:16'!
testInstanceCreation
	|p|
	p := (NBWin32Point x: 1 y: 5).
	self assert: p x = 1.
	self assert: p y = 5! !

!NBWin32Process commentStamp: 'TorstenBergmann 12/18/2014 14:15'!
now use WinProcess in OSWindows project!
!NBWin32Process methodsFor: 'testing' stamp: 'TorstenBergmann 8/13/2013 22:41'!
isNormalPriorityClass
	"Indicates a normal process with no special scheduling needs"
	
	^self getPriorityClass == NORMAL_PRIORITY_CLASS		! !

!NBWin32Process methodsFor: 'accessing' stamp: 'TorstenBergmann 8/13/2013 22:27'!
getPriorityClass
	"Return the priority class for the specified process"	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^NBFFICallout stdcall: #( DWORD GetPriorityClass(HANDLE self)) module: #kernel32	
! !

!NBWin32Process methodsFor: 'testing' stamp: 'TorstenBergmann 8/13/2013 22:41'!
isRealtimePriorityClass
	"Indicates a process that has the highest possible priority. The threads of a real-time priority class process preempt the threads of all other processes, including operating system processes performing important tasks."
	
	^self getPriorityClass == REALTIME_PRIORITY_CLASS		! !

!NBWin32Process methodsFor: 'testing' stamp: 'TorstenBergmann 8/13/2013 22:39'!
isHighPriorityClass
	"Indicates a process that performs time-critical tasks that must be executed immediately for it to run correctly."
	
	^self getPriorityClass == HIGH_PRIORITY_CLASS	! !

!NBWin32Process methodsFor: 'testing' stamp: 'TorstenBergmann 8/13/2013 22:40'!
isIdlePriorityClass
	"Indicates a process whose threads run only when the system is idle and are preempted by the threads of any process running in a higher priority class. An example is a screen saver. The idle priority class is inherited by child processes."
	
	^self getPriorityClass == IDLE_PRIORITY_CLASS		! !

!NBWin32Process class methodsFor: 'accessing' stamp: 'TorstenBergmann 8/13/2013 22:19'!
getCurrentProcess
	"Return an instance with a pseudohandle for the current process."	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ NBFFICallout stdcall: #( NBWin32Process GetCurrentProcess()) module: #kernel32	
! !

!NBWin32Process class methodsFor: 'accessing' stamp: 'TorstenBergmann 8/13/2013 22:22'!
getCurrentProcessId
	"Returns the process identifier (PID) of the calling process."	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ NBFFICallout stdcall: #( DWORD GetCurrentProcessId()) module: #kernel32	
! !

!NBWin32Rectangle class methodsFor: 'accessing' stamp: 'TorstenBergmann 8/13/2013 20:32'!
fieldsDesc
	"self rebuildFieldAccessors "
	^ #(
		long left;
		long top;
		long right;
		long bottom;
		)! !

!NBWin32Shell class methodsFor: 'accessing-64bit' stamp: 'tbn 11/9/2012 22:31'!
getCommonProgramFilesX86
	"Return the common program files x86.
  	 typically this is C:\Program Files (x86)\Common Files
	
		self getCommonProgramFilesX86
	"
	
	^self getEnvironmentVariable: 'COMMONPROGRAMFILES(x86)'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:34'!
showInternetSettingsGeneral
	"  	
		self showInternetSettingsGeneral
	"

	^self shellRunDLL: 'Shell32.dll,Control_RunDLL Inetcpl.cpl,,0'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:35'!
showJoystickSettings
	"	
		self showJoystickSettings
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL joy.cpl'! !

!NBWin32Shell class methodsFor: 'file system' stamp: 'tbn 11/9/2012 22:30'!
getTmpDirectory
	"Return the name of the temp directory.
	
		self getTmpDirectory
	"
	
	^self getEnvironmentVariable: 'TMP'! !

!NBWin32Shell class methodsFor: 'debugging' stamp: 'tbn 11/9/2012 22:07'!
outputDebugString: lpOutputString
	"Sends a string to the debugger for display.  Use tools like DebugView to display"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #(void OutputDebugStringA(LPCTSTR lpOutputString)) module: #Kernel32
	

! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:36'!
showProgramPropertiesInstallUninstall
	"  	
		self showProgramPropertiesInstallUninstall
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL appwiz.cpl,,1'! !

!NBWin32Shell class methodsFor: 'display' stamp: 'TorstenBergmann 8/8/2013 15:31'!
getScreenHeight
	"Returns the the vertical screen size"
	
	^self getSystemMetrics: SM_CYSCREEN   ! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:33'!
showDisplaySettingsScreenSaver
	"  	
		self showDisplaySettingsScreenSaver
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL desk.cpl,,1'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:34'!
showInternationalSettingsNumber
	"Show the internation settings dialog for number.
	
		self showInternationalSettingsNumber
	"

	^self shellRunDLL: 'Shell32.dll,Control_RunDLL Intl.cpl,,1'! !

!NBWin32Shell class methodsFor: 'accessing' stamp: 'tbn 11/9/2012 22:28'!
getApplicationDataFolder
	"Return the folder for application data
	
		self getApplicationDataFolder
	"
	
	^self getEnvironmentVariable: 'APPDATA'! !

!NBWin32Shell class methodsFor: 'api calls' stamp: 'tbn 11/9/2012 22:09'!
shellExecute: hwnd operation: lpOperation file: lpFile parameters: lpParameters directory: lpDirectory show: nShowCmd
		<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
		^ self nbCall: #( 
			HINSTANCE ShellExecuteA(
     				HWND hwnd,
     				LPCTSTR lpOperation,
         			LPCTSTR lpFile,
     				LPCTSTR lpParameters,
     				LPCTSTR lpDirectory,
        			INT nShowCmd)) module: 'Shell32.dll'
	
! !

!NBWin32Shell class methodsFor: 'file system' stamp: 'tbn 11/9/2012 22:29'!
getPathEntries
	"Return the PATH entries"
	
	^(self getEnvironmentVariable: 'PATH') findTokens: $;! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:33'!
showFontsProperties
	"
	self showFontsProperties
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL main.cpl @3'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:37'!
showTelephonySettings
	"
	self showTelephonySettings
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL telephon.cpl' ! !

!NBWin32Shell class methodsFor: 'display' stamp: 'TorstenBergmann 8/8/2013 15:31'!
getScreenSize
	"returns the current screen size
 	 Return Value:
		A point representing the current screen size
	" 
	|x y|
	x := self getScreenWidth.
	y := self getScreenHeight.
	^x@y! !

!NBWin32Shell class methodsFor: 'display' stamp: 'TorstenBergmann 8/8/2013 15:31'!
getScreenWidth
	"Returns the the horizontal screen size"
	
	^self getSystemMetrics: SM_CXSCREEN   ! !

!NBWin32Shell class methodsFor: 'operations' stamp: 'tbn 11/9/2012 22:12'!
shellOpen: file
	"
	self shellOpen: 'c:\pharo.pdf'
	"

	^self shellExecute: 'open' file: file parameters: '' directory: '' show: SW_SHOW! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:36'!
showPrinterManagementFolder
	"
	self showPrinterManagementFolder
	"

	^self shellRunDLL: 'Shell32.dll,SHHelpShortcuts_RunDLL PrintersFolder'! !

!NBWin32Shell class methodsFor: 'computer' stamp: 'tbn 11/9/2012 22:29'!
getComputerName
	"Return the name of the computer.
	
		self getComputerName
	"
	
	^self getEnvironmentVariable: 'COMPUTERNAME'! !

!NBWin32Shell class methodsFor: 'accessing' stamp: 'TorstenBergmann 12/20/2012 10:14'!
getEnvironmentVariable: variableName
	"Return the value of the given environment variable"
	
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode >
	 ^ self nbCall: #( String getenv (String variableName) ) module: NativeBoost CLibrary! !

!NBWin32Shell class methodsFor: 'api calls' stamp: 'TorstenBergmann 8/8/2013 20:33'!
getInetIsOffline: dwFlags
	"Retrieves the specified system metric or system configuration setting."
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^NBFFICallout stdcall: #(BOOL InetIsOffline(DWORD dwFlags)) module:  'url.dll'
	! !

!NBWin32Shell class methodsFor: 'file system' stamp: 'tbn 11/9/2012 22:29'!
getHomeDrive
	"Return the drive letter of the home drive.
	
		self getHomeDrive
	"
	
	^self getEnvironmentVariable: 'HOMEDRIVE'! !

!NBWin32Shell class methodsFor: 'cpu' stamp: 'tbn 11/9/2012 22:29'!
getProcessorLevel
	"Return the model number of the computer's processor.
	
		self getProcessorLevel
	"
	
	^self getEnvironmentVariable: 'PROCESSOR_LEVEL'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:33'!
showDisplaySettingsBackground
	"  	
		self showDisplaySettingsBackground
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL desk.cpl,,0'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:32'!
showAccessibilityCommonSettings
	"Show the common settings for accessibility
	
		self showAccessibilityCommonSettings
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL access.cpl,,5'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:34'!
showInternetExplorerFavoriteManager
	"
	self showInternetExplorerFavoriteManager
	"

	^self shellRunDLL: 'shdocvw.dll,DoOrganizeFavDlg'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:33'!
showInternationalSettingsInputLocales
	"Show the internation settings for input locales.
	
		self showInternationalSettingsInputLocales
	"

	^self shellRunDLL: 'Shell32.dll,Control_RunDLL Intl.cpl,,5'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:33'!
showHotPlugRemoveDialog
	"
	self showHotPlugRemoveDialog
	"

	^self shellRunDLL: 'Shell32.dll,Control_RunDLL HotPlug.dll'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:32'!
showControlPanel
	"
	self showControlPanel
	"

	^self shellRunDLL: 'Shell32.dll,Control_RunDLL'! !

!NBWin32Shell class methodsFor: 'file system' stamp: 'tbn 11/9/2012 22:29'!
getHomePath
	"Return the home path. Typically this is \Documents and Settings\{username}
	
		self getHomePath
	"
	
	^self getEnvironmentVariable: 'HOMEPATH'! !

!NBWin32Shell class methodsFor: 'api calls' stamp: 'tbn 8/6/2013 22:31'!
getCommandLine
	"Returns command-line string for the current process"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #(NBTString GetCommandLineA()) 
			module: #kernel32
! !

!NBWin32Shell class methodsFor: 'user' stamp: 'tbn 11/9/2012 22:30'!
getUserDomain
	"Return the name of the domain that contains the user’s account.
	
		self getUserDomain
	"
	
	^self getEnvironmentVariable: 'USERDOMAIN'! !

!NBWin32Shell class methodsFor: 'accessing' stamp: 'tbn 11/9/2012 22:28'!
getAllUsersProfileFolder
	"Return the profile path for all users.
  	 typically this is C:\Documents and Settings\All Users
	
		self getAllUsersProfileFolder
	"
	
	^self getEnvironmentVariable: 'ALLUSERSPROFILE'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:32'!
showAddPrinterWizard
	"
	self showAddPrinterWizard
	"

	^self shellRunDLL: 'shell32.dll,SHHelpShortcuts_RunDLL AddPrinter' ! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:34'!
showInternationalSettingsTime
	"Show the internation settings for input locales.
	
		self showInternationalSettingsTime
	"

	^self shellRunDLL: 'Shell32.dll,Control_RunDLL Intl.cpl,,3'! !

!NBWin32Shell class methodsFor: 'file system' stamp: 'tbn 11/9/2012 22:29'!
getPathExtensions
	"Returns a list of the file extensions that the OS considers to be executable.
	
		self getPathExtensions
	"
	
	^self getEnvironmentVariable: 'PATHEXT'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:34'!
showInternationalSettingsRegionalSettings
	"Show the regional and language settings. 
	
		self showInternationalSettingsRegionalSettings
	"

	^self shellRunDLL: 'Shell32.dll,Control_RunDLL Intl.cpl,,0'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:33'!
showInternationalSettingsCurrency
	"	
		self showInternationalSettingsCurrency
	"

	^self shellRunDLL: 'Shell32.dll,Control_RunDLL Intl.cpl,,2'! !

!NBWin32Shell class methodsFor: 'api calls' stamp: 'tbn 11/12/2012 09:50'!
primGetDriveType: lpRootPathName
	"
		self getDriveType: 'c:\' 
	"
		<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
		^ self nbCall: #(UINT GetDriveTypeA(LPCTSTR lpRootPathName)) module: #kernel32! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:35'!
showMapNetworkDriveWizard
	"
	self showMapNetworkDriveWizard
	"

	^self shellRunDLL: 'Shell32.dll,SHHelpShortcuts_RunDLL Connect'! !

!NBWin32Shell class methodsFor: 'user' stamp: 'tbn 11/9/2012 22:30'!
getUserName
	"Return the name of the logged in user
	
		self getUserName
	"
	
	^self getEnvironmentVariable: 'USERNAME'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:32'!
showAccessibilityKeyboardSettings
	"Show the keyboard settings for Windows accessibility
	
		self showAccessibilityKeyboardSettings
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL access.cpl,,1'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:37'!
showSystemSettings
	"Show the system settings. Note that the argument zero opens the first tab. 
	
		self showSystemSettings
	"

	^self shellRunDLL: 'Shell32.dll,Control_RunDLL Sysdm.cpl,,0'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:35'!
showMultimediaSettingsCDMusic
	"
	self showMultimediaSettingsCDMusic
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL mmsys.cpl,,3'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:32'!
showDateTimePropertiesTimezone
	"
	self showDateTimePropertiesTimezone
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL timedate.cpl,,/f'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:36'!
showProgramPropertiesWindowsSetup
	"  	
		self showProgramPropertiesWindowsSetup
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL appwiz.cpl,,2'! !

!NBWin32Shell class methodsFor: 'network' stamp: 'TorstenBergmann 8/8/2013 20:44'!
isInternetOffline

	^self getInetIsOffline: 0! !

!NBWin32Shell class methodsFor: 'keyboard' stamp: 'TorstenBergmann 8/8/2013 13:57'!
getKeyboardType
	|types res| 
	types := #( 'IBM PC/XT or compatible (83-key) keyboard' 
	    			'Olivetti "ICO" (102-key) keyboard'
	    			'IBM PC/AT (84-key) or similar keyboard'
	   			'IBM enhanced (101- or 102-key) keyboard'
	    			'Nokia 1050 and similar keyboards' 
	    			'Nokia 9140 and similar keyboards' 
	    			'Japanese keyboard').	
	res := (self getKeyboardType: 0).
	^res <= types size 
		ifTrue: [ types at: res ]
		ifFalse: [ '' ]! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:35'!
showMultimediaSettingsDevices
	"
	self showMultimediaSettingsDevices
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL mmsys.cpl,,4'! !

!NBWin32Shell class methodsFor: 'computer' stamp: 'TorstenBergmann 8/8/2013 15:28'!
getBootType
	"Returns the boot type as a string.	
		self getBootType	
	"
		
	^#('Normal' 'Fail-safe' 'Fail-safe with network') at: (self getSystemMetrics: SM_CLEANBOOT) + 1  ! !

!NBWin32Shell class methodsFor: 'file system' stamp: 'tbn 11/9/2012 22:30'!
getTempDirectory
	"Return the name of the temp directory.
	
		self getTempDirectory
	"
	
	^self getEnvironmentVariable: 'TEMP'! !

!NBWin32Shell class methodsFor: 'network' stamp: 'TorstenBergmann 8/8/2013 13:58'!
getLogonServer
	"Returns the users logon server
	
		self getLogonServer
	"
	
	^self getEnvironmentVariable: 'LOGONSERVER'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:36'!
showPowerOptions
	"
	self showPowerOptions
	"

	^self shellRunDLL: 'Shell32.dll,Control_RunDLL Ups.cpl'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:35'!
showModemSettings
	"
	self showModemSettings
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL modem.cpl' ! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:34'!
showInternetSettingsConnections
	"  	
		self showInternetSettingsConnections
	"

	^self shellRunDLL: 'Shell32.dll,Control_RunDLL Inetcpl.cpl,,4'! !

!NBWin32Shell class methodsFor: 'api calls' stamp: 'tbn 11/9/2012 22:10'!
shellExecute: lpOperation file: lpFile parameters: lpParameters directory: lpDirectory show: nShowCmd
		<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
		^ self nbCall: #( 
			HINSTANCE ShellExecuteA(
     				0,
     				LPCTSTR lpOperation,
         			LPCTSTR lpFile,
     				LPCTSTR lpParameters,
     				LPCTSTR lpDirectory,
        			INT nShowCmd)) module: 'Shell32.dll'
	
! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:35'!
showInternetSettingsSecurity
	"  	
		self showInternetSettingsSecurity
	"

	^self shellRunDLL: 'Shell32.dll,Control_RunDLL Inetcpl.cpl,,1'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:33'!
showFindFastSetting
	"
		self showFindFastSetting
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL findfast.cpl'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:35'!
showMultimediaSettingsAudio
	"
	self showMultimediaSettingsAudio
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL mmsys.cpl,,0'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:36'!
showMultimediaSettingsMIDI
	"
	self showMultimediaSettingsMIDI
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL mmsys.cpl,,2'! !

!NBWin32Shell class methodsFor: 'accessing' stamp: 'tbn 11/9/2012 22:28'!
getCommonProgramFiles 
	"Return the common program files 
  	 typically this is C:\Program Files\Common Files
	
		self getCommonProgramFiles 
	"
	
	^self getEnvironmentVariable: 'COMMONPROGRAMFILES'! !

!NBWin32Shell class methodsFor: 'mouse' stamp: 'TorstenBergmann 8/8/2013 15:26'!
getNumberOfMouseButtons
	"Returns the number of mouse buttons, or zero if no mouse is installed"
	
	^self getSystemMetrics: SM_CMOUSEBUTTONS  ! !

!NBWin32Shell class methodsFor: 'file system' stamp: 'tbn 11/9/2012 22:30'!
getSystemRootDirectory
	"Return the systems root directory. Typically this is
	  'C:\WINDOWS'
	
		self getSystemRootDirectory
	"
	
	^self getEnvironmentVariable: 'SystemRoot'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:34'!
showInternetExplorerSettings
	"Show the internet explorer settings 
	
		self showInternetExplorerSettings
	"

	^self shellRunDLL: 'Shell32.dll,Control_RunDLL Inetcpl.cpl,,6'! !

!NBWin32Shell class methodsFor: 'api calls' stamp: 'tbn 11/9/2012 22:09'!
shellAbout: hWnd application: szApp other: szOtherStuff icon: hIcon
	"
		self shellAbout: NBWin32Window getFocus application: 'Pharo' other: 'More' icon: (NBWin32Handle new value: 0)
	"
		<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
		^ self nbCall: #(int ShellAboutA(
     			HWND hWnd,
         		LPCTSTR szApp,
     			LPCTSTR szOtherStuff,
     			HICON hIcon
		)) module: #shell32! !

!NBWin32Shell class methodsFor: 'accessing' stamp: 'tbn 11/9/2012 22:28'!
getCommandLineProcessor
	"Return command line processor executable
	
		self getCommandLineProcessor
	"
	
	^self getEnvironmentVariable: 'ComSpec'! !

!NBWin32Shell class methodsFor: 'special' stamp: 'tbn 11/9/2012 22:22'!
lockWorkstation
	"Locks the workstation."

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCall: #(BOOL LockWorkStation(void)) module: #user32
! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:36'!
showSoundSettings
	"Show the sound properties dialog box. 
	
		self showSoundSettings
	"

	^self shellRunDLL: 'Shell32.dll,Control_RunDLL Mmsys.cpl,,0'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:32'!
showBluetoothSettings
	"	
		self showBluetoothSettings
	"

	^self shellRunDLL: 'irprops.cpl,,BluetoothAuthenticationAgent'! !

!NBWin32Shell class methodsFor: 'network' stamp: 'TorstenBergmann 8/8/2013 20:44'!
isInternetOnline

	^self isInternetOffline not! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:34'!
showInternetSettingsAdvanced
	"  	
		self showInternetSettingsAdvanced
	"

	^self shellRunDLL: 'Shell32.dll,Control_RunDLL Inetcpl.cpl,,6'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:36'!
showPrinterProperties
	"
	self showPrinterProperties
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL main.cpl @2'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:33'!
showDisplaySettingsCommon
	"  	
		self showDisplaySettingsCommon
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL desk.cpl,,3'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:32'!
showDateTimeProperties
	"
	self showDateTimeProperties
	"

	^self shellRunDLL: 'Shell32.dll,Control_RunDLL Timedate.cpl'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:36'!
showODBCSettings
	"
	self showODBCSettings
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL odbccp32.cpl' ! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:35'!
showMicrosoftWorkgroupPostofficeSettings
	"
	self showMicrosoftWorkgroupPostofficeSettings
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL wgpocpl.cpl'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:32'!
showCOMPortsSettings
	"
	self showCOMPortsSettings
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL ports.cpl' ! !

!NBWin32Shell class methodsFor: 'debugging' stamp: 'tbn 11/19/2012 07:05'!
isDebuggerPresent
	"Indicates whether the calling process is running under the context of a debugger.."	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ NBFFICallout stdcall: #( BOOL IsDebuggerPresent()) module: #kernel32
! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:36'!
showServerProperties
	"
	self showServerProperties
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL srvmgr.cpl' ! !

!NBWin32Shell class methodsFor: 'mouse' stamp: 'TorstenBergmann 8/8/2013 15:40'!
isTablet
	"Returns true if the current operating system is a tablet one"
	
	^(self getSystemMetrics: SM_TABLETPC) ~= 0 ! !

!NBWin32Shell class methodsFor: 'operations' stamp: 'tbn 11/9/2012 22:11'!
shellExplore: folder
	"
	self shellExplore: 'c:\'
	"

	^self shellExecute: 'explore' file: folder parameters: '' directory: '' show: SW_SHOW! !

!NBWin32Shell class methodsFor: 'file system' stamp: 'tbn 11/9/2012 22:30'!
getProgramFilesDirectory
	"Return the program files directory
	
		self getProgramFilesDirectory
	"
	
	^self getEnvironmentVariable: 'PROGRAMFILES'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:32'!
showAccessibilityDisplaySettings
	"Show the keyboard settings 
	
		self showAccessibilityDisplaySettings
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL access.cpl,,3'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:32'!
showAccessibilityMouseSettings
	"Show the mouse settings for accessibility 
	
		self showAccessibilityMouseSettings
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL access.cpl,,4'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:33'!
showFontsInstallationFolder
	"
	self showFontsInstallationFolder
	"

	^self shellRunDLL: 'Shell32.dll,SHHelpShortcuts_RunDLL FontsFolder'! !

!NBWin32Shell class methodsFor: 'cpu' stamp: 'tbn 11/9/2012 22:29'!
getProcessorIdentifier
	"Return a description of the processor.
	
		self getProcessorIdentifier
	"
	
	^self getEnvironmentVariable: 'PROCESSOR_IDENTIFIER'! !

!NBWin32Shell class methodsFor: 'keyboard' stamp: 'TorstenBergmann 8/8/2013 13:51'!
getKeyboardType: nTypeFlag
	"Retrieves information about the current keyboard.	 
	"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^NBFFICallout stdcall: #(int GetKeyboardType(int nTypeFlag)) module: #user32
	! !

!NBWin32Shell class methodsFor: 'mouse' stamp: 'TorstenBergmann 8/8/2013 15:39'!
isMouseWheelPresent
	"Returns true if a mouse with a wheel is installed, false otherwise
	 Windows NT4.0 and later, Windows 98"
	
	^(self getSystemMetrics: SM_MOUSEWHEELPRESENT) ~= 0 ! !

!NBWin32Shell class methodsFor: 'operations' stamp: 'tbn 11/9/2012 22:11'!
shellBrowse: url
	"
	self shellBrowse: 'http://www.pharo-project.org'
	"
	^self shellExecute: 'open' file: url parameters: '' directory: '' show: SW_SHOW! !

!NBWin32Shell class methodsFor: 'keyboard' stamp: 'TorstenBergmann 8/8/2013 14:03'!
getNumberOfFunctionKeys
	"Returns the number of function keys (typically 12, sometimes 18)
	 Return Value:
	 	An Integer
	"
	
	^self getKeyboardType: 2  ! !

!NBWin32Shell class methodsFor: 'api calls' stamp: 'tbn 11/12/2012 10:04'!
getDriveType: lpRootPathName
	"
		self getDriveType:  'D:\' 
	"
	
	| types |
	types := #(DRIVE_UNKNOWN DRIVE_NO_ROOT_DIR DRIVE_REMOVABLE DRIVE_FIXED DRIVE_REMOTE DRIVE_CDROM DRIVE_RAMDISK).
	^types at: (self primGetDriveType: lpRootPathName) +  1! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:34'!
showInternetSettingsContent
	"  	
		self showInternetSettingsContent
	"

	^self shellRunDLL: 'Shell32.dll,Control_RunDLL Inetcpl.cpl,,3'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:36'!
showProgramPropertiesStartupDisk
	"  	
		self showProgramPropertiesStartupDisk
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL appwiz.cpl,,3'! !

!NBWin32Shell class methodsFor: 'file system' stamp: 'tbn 11/9/2012 22:30'!
getSystemDrive
	"Return the drive containing the Windows root directory, usually C:
	
		self getSystemDrive
	"
	
	^self getEnvironmentVariable: 'SYSTEMDRIVE'! !

!NBWin32Shell class methodsFor: 'operations' stamp: 'tbn 11/9/2012 22:25'!
shellRunDLL: cmd
	"
	self shellRunDLL: 'shell32.dll,Control_RunDLL odbccp32.cpl'
	"
	
	^self shellExecute: 'open' file: 'rundll32.exe' parameters: cmd directory: '' show: SW_SHOW! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:36'!
showMultimediaSettingsVideo
	"
	self showMultimediaSettingsVideo
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL mmsys.cpl,,1'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:32'!
showAccessibilitySoundSettings
	"Show the sound settings for accessibility 
	
		self showAccessibilitySoundSettings
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL access.cpl,,2'! !

!NBWin32Shell class methodsFor: 'cpu' stamp: 'tbn 11/9/2012 22:29'!
getProcessorRevision
	"Return the revision number of the processor.
	
		self getProcessorRevision
	"
	
	^self getEnvironmentVariable: 'PROCESSOR_REVISION'! !

!NBWin32Shell class methodsFor: 'user' stamp: 'tbn 11/9/2012 22:30'!
getUserProfile
	"Return the users profile location. Typically this is C:\Documents and Settings\{username}
	
		self getUserProfile
	"
	
	^self getEnvironmentVariable: 'USERPROFILE'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:34'!
showInternetSettingsPrograms
	"  	
		self showInternetSettingsPrograms
	"

	^self shellRunDLL: 'Shell32.dll,Control_RunDLL Inetcpl.cpl,,5'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:37'!
showThemesSettings
	"
	self showThemesSettings
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL themes.cpl' ! !

!NBWin32Shell class methodsFor: 'computer' stamp: 'tbn 11/9/2012 22:29'!
getOS
	"Return the name of the OS"
	
	^self getEnvironmentVariable: 'OS'! !

!NBWin32Shell class methodsFor: 'operations' stamp: 'tbn 11/9/2012 22:13'!
shellPrint: file
	"
	self shellPrint: 'c:\index.html'
	"

	^self shellExecute: 'print' file: file parameters: '' directory: '' show: SW_SHOW! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:35'!
showMouseProperties
	"
	self showMouseProperties
	"

	^self shellRunDLL: 'Shell32.dll,Control_RunDLL main.cpl @0,0'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:35'!
showMailAndFaxSettings
	"
	self showMailAndFaxSettings
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL mlcfg32.cpl'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:35'!
showKeyboardProperties
	"
	self showKeyboardProperties
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL main.cpl @1'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:33'!
showInternationalSettingsDate
	"Show the internation settings for input locales.
	
		self showInternationalSettingsDate
	"

	^self shellRunDLL: 'Shell32.dll,Control_RunDLL Intl.cpl,,4'! !

!NBWin32Shell class methodsFor: 'mouse' stamp: 'TorstenBergmann 8/8/2013 15:34'!
isMouseAvailable
	"returns true if a mouse is available, otherwise false"
	
	^self getNumberOfMouseButtons ~= 0! !

!NBWin32Shell class methodsFor: 'cpu' stamp: 'tbn 11/9/2012 22:29'!
getProcessorArchitecture
	"Return processor chip architecture. Values: x86, IA64.
	
		self getProcessorArchitecture
	"
	
	^self getEnvironmentVariable: 'PROCESSOR_ARCHITECTURE'! !

!NBWin32Shell class methodsFor: 'cpu' stamp: 'tbn 11/9/2012 22:29'!
getNumberOfProcessors
	"Return the number of processors/cores.
	
		self getNumberOfProcessors
	"
	
	^self getEnvironmentVariable: 'NUMBER_OF_PROCESSORS'! !

!NBWin32Shell class methodsFor: 'api calls' stamp: 'TorstenBergmann 8/8/2013 15:24'!
getSystemMetrics: nIndex
	"Retrieves the specified system metric or system configuration setting."
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^NBFFICallout stdcall: #(int GetSystemMetrics(int nIndex)) module: #user32
	! !

!NBWin32Shell class methodsFor: 'network' stamp: 'TorstenBergmann 8/8/2013 15:23'!
isNetworkPresent

	^(self getSystemMetrics: SM_NETWORK) & 1 = 1! !

!NBWin32Shell class methodsFor: 'display' stamp: 'TorstenBergmann 8/8/2013 15:23'!
getNumberOfDisplayMonitors
	"Returns the number of display monitors attached to the desktop"
	
	^self getSystemMetrics: SM_CMONITORS ! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:33'!
showFormatDrive
	"
	self showFormatDrive
	"

	^self shellRunDLL: 'shell32.dll,SHFormatDrive'! !

!NBWin32Shell class methodsFor: 'control panel applets' stamp: 'tbn 11/9/2012 22:32'!
showDisplaySettingsAppearance
	"  	
		self showDisplaySettingsAppearance
	"

	^self shellRunDLL: 'shell32.dll,Control_RunDLL desk.cpl,,2'! !

!NBWin32Shell class methodsFor: 'file system' stamp: 'tbn 11/9/2012 22:30'!
getWindowsDirectory
	"Return the path to the windows directory"
	
	^self getEnvironmentVariable: 'windir'! !

!NBWin32ShellTest methodsFor: 'tests' stamp: 'TorstenBergmann 8/7/2013 12:28'!
testNoDebuggerPresentByDefault

	self deny: NBWin32Shell isDebuggerPresent  ! !

!NBWin32ShellTest methodsFor: 'tests' stamp: 'TorstenBergmann 8/7/2013 12:31'!
testNumberOfProcessors

	self assert: NBWin32Shell getNumberOfProcessors asInteger > 0! !

!NBWin32ShellTest methodsFor: 'tests' stamp: 'TorstenBergmann 8/7/2013 12:27'!
testGetComputerName

	self assert: NBWin32Shell getComputerName notEmpty  ! !

!NBWin32ShellTest methodsFor: 'tests' stamp: 'TorstenBergmann 8/7/2013 12:30'!
testGetDriveType

	self assert: (NBWin32Shell getDriveType:  'C:\')  = #DRIVE_FIXED! !

!NBWin32ShellTest methodsFor: 'tests' stamp: 'TorstenBergmann 8/7/2013 12:27'!
testGetCommandLine

	self assert: NBWin32Shell getCommandLine notEmpty  ! !

!NBWin32SpecificTest class methodsFor: 'testing' stamp: 'CamilloBruni 9/10/2013 14:19'!
isAbstract
  	"only run test subclasses on Windows"
	
	^(self name = #NBWin32SpecificTest)
		or: [ Smalltalk os isWin32 not ]! !

!NBWin32Thread commentStamp: 'TorstenBergmann 12/18/2014 14:15'!
please use WinThread in OSWindows project!
!NBWin32Thread methodsFor: 'testing' stamp: 'TorstenBergmann 8/13/2013 22:16'!
isThreadAllAccess
	"For systems that do not support security descriptors, the (pseudo) handle  is THREAD_ALL_ACCESS. "
	^self handle value = THREAD_ALL_ACCESS! !

!NBWin32Thread class methodsFor: 'accessing' stamp: 'TorstenBergmann 8/13/2013 21:43'!
getCurrentThread
	"Return an instance with a pseudohandle for the current thread."	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ NBFFICallout stdcall: #( NBWin32Thread GetCurrentThread()) module: #kernel32	
! !

!NBWin32Thread class methodsFor: 'accessing' stamp: 'TorstenBergmann 8/13/2013 22:24'!
getCurrentThreadId
	"Returns the thread identifier of the calling thread. Until the thread terminates, the thread identifier uniquely identifies the thread throughout the system."	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ NBFFICallout stdcall: #(DWORD GetCurrentThreadId()) module: #kernel32	
! !

!NBWin32Window commentStamp: 'Igor.Stasenko 4/29/2010 10:54'!
Through WinTypes pool,  i seen as HWND type ,
so whenever you type HWND, you are working with instances of me

!
!NBWin32Window methodsFor: 'api' stamp: 'TorstenBergmann 8/13/2013 20:22'!
getWindow: wCmd 
	"Retrieves the handle of a window that has the specified relationship (Z order or owner) to the specified window."
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #(HWND GetWindow(HWND self, UINT wCmd)) module: #user32
! !

!NBWin32Window methodsFor: 'operations' stamp: 'IgorStasenko 11/24/2012 17:35'!
destroyWindow
	"destroy the window"
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout 
		stdcall; 
		options: #( + optMayGC );  " calls windowproc"  
		function: #( BOOL DestroyWindow ( HWND self ))
		module: #user32
! !

!NBWin32Window methodsFor: 'accessing' stamp: 'IgorStasenko 11/25/2012 14:18'!
getDC
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCall: #( HDC GetDC ( HWND self ) )
		module: #user32! !

!NBWin32Window methodsFor: 'opening' stamp: 'TorstenBergmann 8/13/2013 21:30'!
close
	"Minimizes (but does not destroy) the specified window"
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout stdcall 
		function: #( BOOL CloseWindow( HWND self))
		module: #user32
! !

!NBWin32Window methodsFor: 'api' stamp: 'TorstenBergmann 8/13/2013 21:18'!
getWindowRectangle

	|rect|
	rect := NBWin32Rectangle new.
	^(self   getWindowRect: rect)
		ifTrue: [ rect ]
		ifFalse: [ self error: 'failed' ]
	! !

!NBWin32Window methodsFor: 'testing' stamp: 'tbn 8/6/2013 22:06'!
isEnabled
	"Determines whether the specified window is enabled for mouse and keyboard input. "
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #(BOOL IsWindowEnabled(HWND self)) module: #user32
! !

!NBWin32Window methodsFor: 'testing' stamp: 'IgorStasenko 11/25/2012 14:18'!
isIconic
	"Determines whether the specified window is minimized (iconic). "
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #(BOOL IsIconic(HWND self)) module: #user32
! !

!NBWin32Window methodsFor: 'accessing' stamp: 'IgorStasenko 11/25/2012 14:19'!
setWindowText: lpString
		<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
		^self nbCall: #(BOOL SetWindowTextA(HWND self, LPCTSTR lpString)) 
			module: #user32
! !

!NBWin32Window methodsFor: 'iterating' stamp: 'TorstenBergmann 8/13/2013 20:20'!
getNextWindow
	"Returns the handle of the window below the given window."
	
	^self getWindow: GW_HWNDNEXT! !

!NBWin32Window methodsFor: 'testing' stamp: 'tbn 8/6/2013 22:04'!
isWindow
	"Determines whether the specified window handle identifies an existing window "
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #(BOOL IsWindow(HWND self)) module: #user32
! !

!NBWin32Window methodsFor: 'accessing' stamp: 'tbn 11/12/2012 07:11'!
getWindowExStyle
	"Retrieves the extended window styles"
	
	^self getWindowLongAtIndex: GWL_EXSTYLE! !

!NBWin32Window methodsFor: 'api' stamp: 'IgorStasenko 11/25/2012 14:18'!
getWindowLongAtIndex: nIndex 
		<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
		^self nbCall: #(LONG GetWindowLongA(HWND self, int nIndex)) 
			module: #user32
! !

!NBWin32Window methodsFor: 'operations' stamp: 'tbn 11/12/2012 09:20'!
setNonResizable

	| newStyle |
	newStyle := self getWindowStyle bitClear: (WS_SIZEBOX|WS_MINIMIZE|WS_MAXIMIZE). 
	self setWindowLong: self index: GWL_STYLE newVale: newStyle. 	
 
		! !

!NBWin32Window methodsFor: 'opening' stamp: 'TorstenBergmann 8/13/2013 21:26'!
show
	"show the window"
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout stdcall 
		options: #( + optMayGC );  " calls windowproc"
		function: #( BOOL ShowWindow ( HWND self, SW_SHOW ))
		module: #user32
! !

!NBWin32Window methodsFor: 'operations' stamp: 'IgorStasenko 11/24/2012 17:37'!
moveWindowX: x y: y width: nWidth height: nHeight
	"move window example"
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout
		stdcall;  
		options: #( + optMayGC );  " calls windowproc"
		function: #( 
			BOOL MoveWindow ( HWND self,
				int x,
				int y,
				int nWidth,
   				int nHeight,
 				false
				))
		module: #user32
! !

!NBWin32Window methodsFor: 'iterating' stamp: 'TorstenBergmann 8/13/2013 20:44'!
getTopWindow
	"Examines the Z order of the child windows associated with the specified parent window and retrieves the handle of the child window at the top of the Z order."
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #(HWND GetTopWindow(HWND self)) module: #user32
! !

!NBWin32Window methodsFor: 'opening' stamp: 'TorstenBergmann 8/13/2013 21:32'!
minimize
	
	^self close! !

!NBWin32Window methodsFor: 'opening' stamp: 'TorstenBergmann 8/13/2013 21:34'!
destroy
	"Destroys the specified window. The function sends WM_DESTROY and WM_NCDESTROY messages to the window to deactivate it and remove the keyboard focus from it. The function also destroys the window's menu, flushes the thread message queue, destroys timers, removes clipboard ownership, and breaks the clipboard viewer chain (if the window is at the top of the viewer chain). 

If the specified window is a parent or owner window, DestroyWindow automatically destroys the associated child or owned windows when it destroys the parent or owner window. The function first destroys child or owned windows, and then it destroys the parent or owner window.

NOTE: A thread cannot use DestroyWindow to destroy a window created by a different thread." 

	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout stdcall 
		function: #( BOOL DestroyWindow( HWND self))
		module: #user32
! !

!NBWin32Window methodsFor: 'testing' stamp: 'IgorStasenko 11/25/2012 14:19'!
isZoomed
	"Determines whether a window is maximized. "
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #(BOOL IsZoomed(HWND self)) module: #user32
! !

!NBWin32Window methodsFor: 'drawing' stamp: 'IgorStasenko 11/24/2012 17:36'!
hide
	"destroy the window"
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout 
		stdcall;
		options: #( + optMayGC );  " calls windowproc"
		function: #( BOOL ShowWindow ( HWND self, SW_HIDE ))
		module: #user32
! !

!NBWin32Window methodsFor: 'accessing' stamp: 'IgorStasenko 11/25/2012 14:19'!
setWindowLong: hWnd index: nIndex newVale: dwNewLong
		<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
		^self nbCall: #(LONG SetWindowLongA(HWND hWnd, int nIndex, LONG dwNewLong)) 
			module: #user32
! !

!NBWin32Window methodsFor: 'api' stamp: 'TorstenBergmann 8/7/2013 12:50'!
getWindowFromPoint: point 
		<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
		
		^self nbCall: #(HWND WindowFromPoint(NBWin32Point point)) 
			module: #user32
! !

!NBWin32Window methodsFor: 'accessing' stamp: 'IgorStasenko 11/25/2012 14:19'!
releaseDC: hdc
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCall: #( 
	
		int ReleaseDC (
		  HWND self ,  " handle to window"
		  HDC hdc     " handle to DC "
		))
		module: #user32! !

!NBWin32Window methodsFor: 'iterating' stamp: 'TorstenBergmann 8/13/2013 20:21'!
getPreviousWindow
	"Returns the handle of the window above the given window."

	^self getWindow: GW_HWNDPREV	! !

!NBWin32Window methodsFor: 'comparing' stamp: 'TorstenBergmann 8/13/2013 20:02'!
= anotherNBWin32Window 
	"Compare using the external give handle"
	
	^self species = anotherNBWin32Window species
		and: [ handle = anotherNBWin32Window handle ]! !

!NBWin32Window methodsFor: 'api' stamp: 'IgorStasenko 11/25/2012 14:18'!
getWindowLong: hWnd index: nIndex 
		<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
		^self nbCall: #(LONG GetWindowLongA(HWND hWnd, int nIndex)) 
			module: #user32
! !

!NBWin32Window methodsFor: 'iterating' stamp: 'TorstenBergmann 8/13/2013 20:20'!
getActiveWindow
	"Retrieves  the window handle to the active window associated with the thread that calls the function. "
	
	^self class getActiveWindow! !

!NBWin32Window methodsFor: 'testing' stamp: 'tbn 8/6/2013 22:08'!
isUnicode
	"Determines whether the specified window is a native Unicode window.  "
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #(BOOL IsWindowUnicode(HWND self)) module: #user32
! !

!NBWin32Window methodsFor: 'api' stamp: 'tbn 11/11/2012 01:03'!
getWindowText
	"
	self getFocus getWindowText
	"
	| len str |	
	str := ByteString new: 1000.
	len := self getWindowText: self buffer: str bufferSize: 1000.
	^ str first: len.

	 ! !

!NBWin32Window methodsFor: 'testing' stamp: 'IgorStasenko 11/25/2012 14:18'!
isVisible
	"Retrieves the visibility state of the specified window. . "
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #(BOOL IsWindowVisible(HWND self)) module: #user32
! !

!NBWin32Window methodsFor: 'api' stamp: 'TorstenBergmann 8/13/2013 21:18'!
getWindowRect: rect
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #(BOOL GetWindowRect(HWND self, RECT* rect)) module: #user32
! !

!NBWin32Window methodsFor: 'accessing' stamp: 'tbn 11/12/2012 07:11'!
getWindowStyle
	"Retrieves the window styles"
	
	^self getWindowLongAtIndex: GWL_STYLE! !

!NBWin32Window methodsFor: 'api' stamp: 'IgorStasenko 11/25/2012 14:18'!
getWindowText: hWnd buffer: lpString bufferSize: nMaxCount
		<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
		^self nbCall: #(int GetWindowTextA(HWND hWnd, char* lpString, int nMaxCount)) 
			module: #user32
! !

!NBWin32Window methodsFor: 'iterating' stamp: 'TorstenBergmann 8/13/2013 20:48'!
getParent
	"Retrieves the handle of the specified child window's parent window.
	 If the window has no parent window, the return value is nil."
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^self nbCall: #(HWND GetParent(HWND self)) module: #user32
! !

!NBWin32Window class methodsFor: 'accessing' stamp: 'tbn 11/19/2012 06:57'!
getForegroundWindow 
	"Returns the handle of the foreground window (the window with which the user is currently working)."	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ NBFFICallout stdcall: #( HWND GetForegroundWindow()) module: #user32
! !

!NBWin32Window class methodsFor: 'as yet unclassified' stamp: 'Igor.Stasenko 5/17/2010 19:20'!
DefWindowProcW

	^ NBExternalAddress value: (NativeBoost loadSymbol: #DefWindowProcW fromModule: #user32)! !

!NBWin32Window class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 4/6/2012 13:58'!
DefWindowProcA

	^ NativeBoost loadSymbol: #DefWindowProcA fromModule: #user32! !

!NBWin32Window class methodsFor: 'accessing' stamp: 'tbn 8/6/2013 22:25'!
getClipboardViewer
	"Retrieves the handle of the first window in the clipboard viewer chain."	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ NBFFICallout stdcall: #( HWND GetClipboardOwner()) module: #user32
! !

!NBWin32Window class methodsFor: 'callout options' stamp: 'IgorStasenko 9/16/2012 18:10'!
ffiCalloutOptions 
	^ #( + optMayGC )! !

!NBWin32Window class methodsFor: 'accessing' stamp: 'TorstenBergmann 8/7/2013 13:01'!
getWindowFromPoint: point 
		<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
		
		^self nbCall: #(HWND WindowFromPoint(POINT point)) 
			module: #user32
! !

!NBWin32Window class methodsFor: 'accessing' stamp: 'tbn 8/6/2013 22:18'!
getCapture
	"Return retrieves the window (if any) that has captured the mouse. Only one window at a time can capture the mouse; this window receives mouse input whether or not the cursor is within its borders."
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout stdcall function: #( HWND  GetCapture	()) module: #user32
! !

!NBWin32Window class methodsFor: 'accessing' stamp: 'tbn 11/19/2012 06:51'!
getDesktopWindow
	"Return the handle of the windows desktop window"	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ NBFFICallout stdcall: #( HWND GetDesktopWindow()) module: #user32
! !

!NBWin32Window class methodsFor: 'accessing' stamp: 'tbn 8/6/2013 22:11'!
getActiveWindow
	"Retrieves the window handle to the active window associated with the thread that calls the function. "	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ NBFFICallout stdcall: #( HWND GetActiveWindow()) module: #user32
! !

!NBWin32Window class methodsFor: 'as yet unclassified' stamp: 'RichardWettel 1/13/2015 09:40'!
createWindowExA: dwExStyle lpClassName: lpClassName lpWindowName: lpWindowName dwStyle: dwStyle
x: x y: y width: nWidth height: nHeight hWndParent: hWndParent hMenu: hMenu
hInstance: hInstance lParam: lpParam

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>

	^ self nbCallout 
		stdcall;
		options: #( - optWinUnicode );
		function: #( HWND 'CreateWindowExA' 
			( DWORD dwExStyle,
			LPCTSTR lpClassName,
			LPCTSTR lpWindowName,
			DWORD dwStyle,
			ulong x,
			ulong y,
			ulong nWidth,
			ulong nHeight,
			HWND hWndParent,
			HMENU hMenu,
			HINSTANCE hInstance,
			LPVOID lpParam) ) 
		module: #user32
	! !

!NBWin32Window class methodsFor: 'as yet unclassified' stamp: 'RichardWettel 1/13/2015 09:40'!
createWindowExW: dwExStyle lpClassName: lpClassName lpWindowName: lpWindowName dwStyle: dwStyle
x: x y: y width: nWidth height: nHeight hWndParent: hWndParent hMenu: hMenu
hInstance: hInstance lParam: lpParam

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>

	^ self nbCallout
		stdcall;
		options: #( + optWinUnicode );
		function: #( HWND 'CreateWindowExW' 
			( DWORD dwExStyle,
			LPCTSTR lpClassName,
			LPCTSTR lpWindowName,
			DWORD dwStyle,
			ulong x,
			ulong y,
			ulong nWidth,
			ulong nHeight,
			HWND hWndParent,
			HMENU hMenu,
			HINSTANCE hInstance,
			LPVOID lpParam) ) 
		module: #user32
	! !

!NBWin32Window class methodsFor: 'accessing' stamp: 'IgorStasenko 11/24/2012 17:40'!
getFocus 
	"Return the HWND currently having the input focus"
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout stdcall function: #( HWND GetFocus ()) module: #user32
! !

!NBWin32Window class methodsFor: 'accessing' stamp: 'tbn 8/6/2013 22:24'!
getClipboardOwnerWindow
	"Retrieves the window handle of the current owner of the clipboard."	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ NBFFICallout stdcall: #( HWND GetClipboardOwner()) module: #user32
! !

!NBWin32WindowTest methodsFor: 'tests' stamp: 'TorstenBergmann 8/7/2013 11:59'!
testGetDesktopWindow

	self assert: NBWin32Window getDesktopWindow handle > 0! !

!NBWin32WindowTest methodsFor: 'tests' stamp: 'MarcusDenker 1/14/2014 17:21'!
testWindowFromPoint
	self skip. "fails on CI server"
	self assert: (NBWin32Window getWindowFromPoint: (NBWin32Point x: 100 y: 100)) isWindow! !

!NBWin32WindowTest methodsFor: 'tests' stamp: 'TorstenBergmann 8/7/2013 12:26'!
testIsEnabled

	self assert: NBWin32Window getDesktopWindow isEnabled! !

!NBWin32WindowTest methodsFor: 'tests' stamp: 'MarcusDenker 1/14/2014 17:21'!
testIsVisible
	self skip. "fails on CI server"
	self assert: NBWin32Window getDesktopWindow isVisible! !

!NBWinConstants class methodsFor: 'constants' stamp: 'TorstenBergmann 8/13/2013 22:37'!
baseConstants
	DEBUG_PROCESS := 16r00000001.
	DEBUG_ONLY_THIS_PROCESS := 16r00000002.
	CREATE_SUSPENDED := 16r00000004.
	DETACHED_PROCESS := 16r00000008.
	CREATE_NEW_CONSOLE := 16r00000010.
	NORMAL_PRIORITY_CLASS := 16r00000020.
	IDLE_PRIORITY_CLASS := 16r00000040.
	HIGH_PRIORITY_CLASS := 16r00000080.
	REALTIME_PRIORITY_CLASS := 16r00000100.
	CREATE_NEW_PROCESS_GROUP := 16r00000200.
	CREATE_UNICODE_ENVIRONMENT := 16r00000400.
	CREATE_SEPARATE_WOW_VDM := 16r00000800.
	CREATE_SHARED_WOW_VDM := 16r00001000.
	CREATE_FORCEDOS := 16r00002000.
	BELOW_NORMAL_PRIORITY_CLASS := 16r00004000.
	ABOVE_NORMAL_PRIORITY_CLASS := 16r00008000.
	"..."	
	ACE_OBJECT_TYPE_PRESENT := 16r00000001.
	ACE_INHERITED_OBJECT_TYPE_PRESENT := 	16r00000002.
	APPLICATION_ERROR_MASK := 16r20000000.
	ERROR_SEVERITY_SUCCESS := 16r00000000.
	ERROR_SEVERITY_INFORMATIONAL := 16r40000000.
	ERROR_SEVERITY_WARNING := 16r80000000.
	ERROR_SEVERITY_ERROR := 16rC0000000.
	
	SYNCHRONIZE := 16r100000.
		
	STANDARD_RIGHTS_REQUIRED := 16rF0000.
	STANDARD_RIGHTS_READ := 16r20000.
	STANDARD_RIGHTS_WRITE := 16r20000.
	STANDARD_RIGHTS_EXECUTE := 16r20000.
	STANDARD_RIGHTS_ALL := 16r1F0000.
	SPECIFIC_RIGHTS_ALL := 16rFFFF.
	ACCESS_SYSTEM_SECURITY := 16r1000000.! !

!NBWinConstants class methodsFor: 'constants' stamp: 'tbn 11/12/2012 10:09'!
windowMessages
	WM_ACTIVATEAPP :=  16r001C.
	WM_CANCELMODE :=  16r001F.
	WM_CHILDACTIVATE := 16r0022.
	WM_CLOSE := 16r0010.
	WM_COMPACTING := 16r0041.
	WM_CREATE :=  16r0001.
	WM_DESTROY := 16r0002.
     "http://msdn.microsoft.com/en-us/library/windows/desktop/ms632620(v=vs.85).aspx"   

	WM_ENABLE := 16r000A.
	WM_ENTERSIZEMOVE := 16r0231.
	WM_EXITSIZEMOVE := 16r0232.
	WM_GETMINMAXINFO := 16r0024.
	WM_GETICON := 16r007F.
	WM_INPUTLANGCHANGE := 16r0051.
	WM_INPUTLANGCHANGEREQUEST := 16r0050.
	WM_MOVE := 16r0003.
	WM_MOVING := 16r0216.
	WM_NCACTIVATE := 16r0086.
	WM_NCCALCSIZE := 16r0083.
	WM_NCCREATE := 16r0081.
	WM_NCDESTROY := 16r0082.
	WM_NULL := 16r0000.                                                                                             
	WM_QUERYDRAGICON := 16r0037.
	WM_QUERYOPEN := 16r0013.
	WM_QUIT := 16r0012.
	WM_SHOWWINDOW := 16r0018.
	WM_SIZE := 16r0005.
	WM_SIZING := 16r0214.
	WM_STYLECHANGED := 16r007D.
	WM_STYLECHANGING := 16r007C.
	WM_THEMECHANGED := 16r031A.
	WM_USERCHANGED := 16r0054.
	WM_WINDOWPOSCHANGED  := 16r0047.
	WM_WINDOWPOSCHANGING  := 16r0046
	
	! !

!NBWinConstants class methodsFor: 'constants' stamp: 'TorstenBergmann 8/8/2013 15:19'!
systemMetricConstants
	"http://msdn.microsoft.com/en-us/library/windows/desktop/ms724385(v=vs.85).aspx"

	SM_ARRANGE := 56.
	SM_CLEANBOOT := 67.
	SM_CMONITORS := 80.
	SM_CMOUSEBUTTONS := 43.
	SM_CXBORDER := 5.
	SM_CXCURSOR := 13.
	SM_CXDLGFRAME := 7.
	SM_CXDOUBLECLK := 36.
	SM_CXDRAG := 68.
	SM_CXEDGE := 45.
	SM_CXFIXEDFRAME := 7.
	SM_CXFOCUSBORDER := 83.
	SM_CXFRAME := 32.
	SM_CXFULLSCREEN := 16.
	SM_CXHSCROLL := 21.
	SM_CXHTHUMB := 10.
	SM_CXICON := 11.
	SM_CXICONSPACING := 38.
	SM_CXMAXIMIZED := 61.
	SM_CXMAXTRACK := 59.
	SM_CXMENUCHECK := 71.
	SM_CXMENUSIZE := 54.
	SM_CXMIN := 28.
	SM_CXMINIMIZED := 57.
	SM_CXMINSPACING := 47.
	SM_CXMINTRACK := 34.
	SM_CXPADDEDBORDER := 92.
	SM_CXSCREEN := 0.
	SM_CXSIZE := 30.
	SM_CXSIZEFRAME := 32.
	SM_CXSMICON := 49.
	SM_CXSMSIZE := 52.
	SM_CXVIRTUALSCREEN := 78.
	SM_CXVSCROLL := 2.
	SM_CYBORDER := 6.
	SM_CYCAPTION := 4.
	SM_CYCURSOR := 14.
	SM_CYDLGFRAME := 8.
	SM_CYDOUBLECLK := 37.
	SM_CYDRAG := 69.
	SM_CYEDGE := 46.
	SM_CYFIXEDFRAME := 8.
	SM_CYFOCUSBORDER := 84.
	SM_CYFRAME := 33.
	SM_CYFULLSCREEN := 17.
	SM_CYHSCROLL := 3.
	SM_CYICON := 12.
	SM_CYICONSPACING := 39.
	SM_CYKANJIWINDOW := 18.
	SM_CYMAXIMIZED := 62.
	SM_CYMAXTRACK := 60.
	SM_CYMENU := 15.
	SM_CYMENUCHECK := 72.
	SM_CYMENUSIZE := 55.
	SM_CYMIN := 29.
	SM_CYMINIMIZED := 58.
	SM_CYMINSPACING := 48.
	SM_CYMINTRACK := 35.
	SM_CYSCREEN := 1.
	SM_CYSIZE := 31.
	SM_CYSIZEFRAME := 33.
	SM_CYSMCAPTION := 51.
	SM_CYSMICON := 50.
	SM_CYSMSIZE := 53.
	SM_CYVIRTUALSCREEN := 79.
	SM_CYVSCROLL := 20.
	SM_CYVTHUMB := 9.
	SM_DBCSENABLED := 42.
	SM_DEBUG := 22.
	SM_DIGITIZER := 94.
	SM_IMMENABLED := 82.
	SM_MAXIMUMTOUCHES := 95.
	SM_MEDIACENTER := 87.
	SM_MENUDROPALIGNMENT := 40.
	SM_MIDEASTENABLED := 74.
	SM_MOUSEPRESENT := 19.
	SM_MOUSEHORIZONTALWHEELPRESENT := 91.
	SM_MOUSEWHEELPRESENT := 75.
	SM_NETWORK := 63.
	SM_PENWINDOWS := 41.
	SM_REMOTECONTROL := 16r2001.
	SM_REMOTESESSION := 16r1000.
	SM_SAMEDISPLAYFORMAT := 81.
	SM_SECURE := 44.
	SM_SHOWSOUNDS := 70.
	SM_SHUTTINGDOWN := 16r2000.
	SM_SLOWMACHINE := 73.
	SM_STARTER := 88.
	SM_SWAPBUTTON := 23.
	SM_TABLETPC := 86.
	SM_XVIRTUALSCREEN := 76.
	SM_YVIRTUALSCREEN := 77! !

!NBWinConstants class methodsFor: 'constants' stamp: 'Igor.Stasenko 5/2/2010 15:10'!
windowStyles
"
  Window Styles
"
 WS_OVERLAPPED := 16r00000000.
 WS_POPUP := 16r80000000.
 WS_CHILD := 16r40000000.
 WS_MINIMIZE := 16r20000000.
 WS_VISIBLE := 16r10000000.
 WS_DISABLED := 16r08000000.
 WS_CLIPSIBLINGS := 16r04000000.
 WS_CLIPCHILDREN := 16r02000000.
 WS_MAXIMIZE := 16r01000000.
 WS_CAPTION := 16r00C00000. " WS_BORDER | WS_DLGFRAME "
 WS_BORDER := 16r00800000.
 WS_DLGFRAME := 16r00400000.
 WS_VSCROLL := 16r00200000.
 WS_HSCROLL := 16r00100000.
 WS_SYSMENU := 16r00080000.
 WS_THICKFRAME := 16r00040000.
 WS_GROUP := 16r00020000.
 WS_TABSTOP := 16r00010000.

 WS_MINIMIZEBOX := 16r00020000.
 WS_MAXIMIZEBOX := 16r00010000.

"
  Common Window Styles
"
 WS_OVERLAPPEDWINDOW := ((((WS_OVERLAPPED bitOr:
 WS_CAPTION ) bitOr: WS_SYSMENU ) bitOr: WS_THICKFRAME ) bitOr: WS_MINIMIZEBOX )
 bitOr: WS_MAXIMIZEBOX.

 WS_POPUPWINDOW := (WS_POPUP bitOr: WS_BORDER) bitOr: WS_SYSMENU.

 WS_CHILDWINDOW := WS_CHILD.


 WS_TILED := WS_OVERLAPPED.
 WS_ICONIC := WS_MINIMIZE.
 WS_SIZEBOX := WS_THICKFRAME.
 WS_TILEDWINDOW := WS_OVERLAPPEDWINDOW.


! !

!NBWinConstants class methodsFor: 'constants' stamp: 'tbn 11/11/2012 20:14'!
messageBoxConstants

	MB_ABORTRETRYIGNORE := 16r00000002.
	MB_CANCELTRYCONTINUE := 16r00000006.
	MB_HELP := 16r00004000.
	MB_OK := 16r00000000.
	MB_OKCANCEL := 16r00000001.
	MB_RETRYCANCEL := 16r00000005.
	MB_YESNO := 16r00000004.
	MB_YESNOCANCEL := 16r00000003.
	
	"To display an icon in the message box, specify one of the following values."
	MB_ICONEXCLAMATION := 16r00000030. 
	MB_ICONWARNING := 16r00000030.
	MB_ICONINFORMATION := 16r00000040.
	MB_ICONASTERISK := 16r00000040.
	MB_ICONQUESTION := 16r00000020.
	MB_ICONSTOP := 16r00000010.
	MB_ICONERROR := 16r00000010.
	MB_ICONHAND := 16r00000010.
	
	"To indicate the default button, specify one of the following values."
	MB_DEFBUTTON1 := 16r00000000.
	MB_DEFBUTTON2 := 16r00000100.
	MB_DEFBUTTON3 := 16r00000200.
	MB_DEFBUTTON4 := 16r00000300.
	
	"To indicate the modality of the dialog box, specify one of the following values."
	MB_APPLMODAL := 16r00000000.
	MB_SYSTEMMODAL := 16r00001000.
	MB_TASKMODAL := 16r00002000.
	
	"To specify other options, use one or more of the following values."
	MB_DEFAULT_DESKTOP_ONLY := 16r00020000.
	MB_RIGHT := 16r00080000. "text is right justified"
	MB_RTLREADING := 16r00100000.
	MB_SETFOREGROUND := 16r00010000.
	MB_TOPMOST := 16r00040000.
	MB_SERVICE_NOTIFICATION := 16r00200000.
	
	IDABORT := 3.
	IDCANCEL := 2.
	IDCONTINUE := 11.
	IDIGNORE := 5.
	IDNO := 7.
	IDOK := 1.
	IDRETRY := 4.
	IDTRYAGAIN := 10.
	IDYES := 6.
	! !

!NBWinConstants class methodsFor: 'constants' stamp: 'tbn 11/12/2012 09:52'!
driveTypes

	DRIVE_UNKNOWN := 0.
	DRIVE_NO_ROOT_DIR := 1.
	DRIVE_REMOVABLE := 2.
	DRIVE_FIXED := 3.
	DRIVE_REMOTE := 4.
	DRIVE_CDROM := 5.
	DRIVE_RAMDISK := 6! !

!NBWinConstants class methodsFor: 'constants' stamp: 'TorstenBergmann 8/13/2013 19:21'!
showWindowConstants
	SW_HIDE := 0.
	SW_SHOWNORMAL := 1.
	SW_NORMAL := 1.
	SW_SHOWMINIMIZED := 2.
	SW_SHOWMAXIMIZED := 3.
	SW_MAXIMIZE := 3.
	SW_SHOWNOACTIVATE := 4.
	SW_SHOW := 5.
	SW_MINIMIZE := 6.
	SW_SHOWMINNOACTIVE := 7.
	SW_SHOWNA := 8.
	SW_RESTORE := 9.
	SW_SHOWDEFAULT := 10.
	SW_FORCEMINIMIZE := 11.
	SW_MAX := 11! !

!NBWinConstants class methodsFor: 'constants' stamp: 'Igor.Stasenko 5/18/2010 04:16'!
classStyles

	" Window class styles "
	CS_VREDRAW := 16r0001.
	CS_HREDRAW := 16r0002.
	CS_DBLCLKS := 16r0008.
	CS_OWNDC := 16r0020.
	CS_CLASSDC := 16r0040.
	CS_PARENTDC := 16r0080.
	CS_NOCLOSE := 16r0200.
	CS_SAVEBITS := 16r0800.
	CS_BYTEALIGNCLIENT := 16r1000.
	CS_BYTEALIGNWINDOW := 16r2000.
	CS_GLOBALCLASS := 16r4000.
	
	CS_IME := 16r00010000.
	CS_DROPSHADOW := 16r00020000.
! !

!NBWinConstants class methodsFor: 'class initialization' stamp: 'TorstenBergmann 8/13/2013 22:10'!
initialize
	" self initialize"
	
	self baseConstants;
		classStyles;
		heapConstants;
		threadConstants;
		windowStyles;
		windowExStyles;
		windowCreationConstants;
		gdiConstants;
		showWindowConstants;
		getWindowConstants;
		messageBoxConstants;
		systemMetricConstants;
		getWindowLongConstants;
		windowMessages;
		driveTypes! !

!NBWinConstants class methodsFor: 'constants' stamp: 'tbn 11/12/2012 07:07'!
getWindowLongConstants
	GWL_EXSTYLE := -20.
	GWL_HINSTANCE := -6.
	GWL_HWNDPARENT := -8.
	GWL_ID := -12.
	GWL_STYLE := -16.
	GWL_USERDATA := -21.
	GWL_WNDPROC := -4! !

!NBWinConstants class methodsFor: 'constants' stamp: 'TorstenBergmann 8/13/2013 22:12'!
threadConstants
	THREAD_TERMINATE := 1.
	THREAD_SUSPEND_RESUME := 2.
	THREAD_GET_CONTEXT := 8.
	THREAD_SET_CONTEXT := 16.
	THREAD_SET_INFORMATION := 32.
	THREAD_QUERY_INFORMATION := 64.
	THREAD_SET_THREAD_TOKEN := 128.
	THREAD_IMPERSONATE := 256.
	THREAD_DIRECT_IMPERSONATION := 16r200.
	THREAD_ALL_ACCESS := STANDARD_RIGHTS_REQUIRED|SYNCHRONIZE|16r3FF! !

!NBWinConstants class methodsFor: 'constants' stamp: 'Igor.Stasenko 5/2/2010 15:10'!
windowExStyles
" Extended Window Styles "

 WS_EX_DLGMODALFRAME := 16r00000001.
 WS_EX_NOPARENTNOTIFY := 16r00000004.
 WS_EX_TOPMOST := 16r00000008.
 WS_EX_ACCEPTFILES := 16r00000010.
 WS_EX_TRANSPARENT := 16r00000020.

 WS_EX_MDICHILD := 16r00000040.
 WS_EX_TOOLWINDOW := 16r00000080.
 WS_EX_WINDOWEDGE := 16r00000100.
 WS_EX_CLIENTEDGE := 16r00000200.
 WS_EX_CONTEXTHELP := 16r00000400.

 WS_EX_RIGHT := 16r00001000.
 WS_EX_LEFT := 16r00000000.
 WS_EX_RTLREADING := 16r00002000.
 WS_EX_LTRREADING := 16r00000000.
 WS_EX_LEFTSCROLLBAR := 16r00004000.
 WS_EX_RIGHTSCROLLBAR := 16r00000000.

 WS_EX_CONTROLPARENT := 16r00010000.
 WS_EX_STATICEDGE := 16r00020000.
 WS_EX_APPWINDOW := 16r00040000.


 WS_EX_OVERLAPPEDWINDOW  := (WS_EX_WINDOWEDGE bitOr: WS_EX_CLIENTEDGE).
 WS_EX_PALETTEWINDOW :=  (WS_EX_WINDOWEDGE bitOr: WS_EX_TOOLWINDOW) bitOr: WS_EX_TOPMOST.

 WS_EX_LAYERED := 16r00080000.

 WS_EX_NOINHERITLAYOUT := 16r00100000. " Disable inheritence of mirroring by children "
 WS_EX_LAYOUTRTL := 16r00400000. " Right to left mirroring "

 WS_EX_COMPOSITED := 16r02000000.

 WS_EX_NOACTIVATE := 16r08000000.
! !

!NBWinConstants class methodsFor: 'constants' stamp: 'Igor.Stasenko 5/2/2010 16:26'!
heapConstants
	HEAP_CREATE_ENABLE_EXECUTE := 16r00040000.
	HEAP_GENERATE_EXCEPTIONS := 16r00000004.
	HEAP_NO_SERIALIZE := 16r00000001.
	
	HEAP_REALLOC_IN_PLACE_ONLY := 16r00000010.
	HEAP_ZERO_MEMORY := 16r00000008.! !

!NBWinConstants class methodsFor: 'constants' stamp: 'TorstenBergmann 8/13/2013 19:23'!
getWindowConstants
	GW_HWNDFIRST := 0.
	GW_HWNDLAST := 1.
	GW_HWNDNEXT := 2.
	GW_HWNDPREV := 3.
	GW_OWNER := 4.
	GW_CHILD := 5.
	GW_ENABLEDPOPUP := 6.
	
			
	 ! !

!NBWinConstants class methodsFor: 'constants' stamp: 'Igor.Stasenko 5/17/2010 14:27'!
windowCreationConstants

	CW_USEDEFAULT  := 16r80000000.
! !

!NBWinConstants class methodsFor: 'constants' stamp: 'Igor.Stasenko 5/18/2010 04:07'!
gdiConstants

" pixel types "
PFD_TYPE_RGBA  := 0.
PFD_TYPE_COLORINDEX  := 1.

" layer types "
PFD_MAIN_PLANE := 0.
PFD_OVERLAY_PLANE := 1.
PFD_UNDERLAY_PLANE := -1.

" PIXELFORMATDESCRIPTOR flags "
PFD_DOUBLEBUFFER := 16r00000001.
PFD_STEREO := 16r00000002.
PFD_DRAW_TO_WINDOW := 16r00000004.
PFD_DRAW_TO_BITMAP := 16r00000008.
PFD_SUPPORT_GDI := 16r00000010.
PFD_SUPPORT_OPENGL := 16r00000020.
PFD_GENERIC_FORMAT := 16r00000040.
PFD_NEED_PALETTE := 16r00000080.
PFD_NEED_SYSTEM_PALETTE := 16r00000100.
PFD_SWAP_EXCHANGE := 16r00000200.
PFD_SWAP_COPY := 16r00000400.
PFD_SWAP_LAYER_BUFFERS := 16r00000800.
PFD_GENERIC_ACCELERATED := 16r00001000.
PFD_SUPPORT_DIRECTDRAW := 16r00002000.

" PIXELFORMATDESCRIPTOR flags for use in ChoosePixelFormat only "
PFD_DEPTH_DONTCARE := 16r20000000.
PFD_DOUBLEBUFFER_DONTCARE := 16r40000000.
PFD_STEREO_DONTCARE := 16r80000000.
! !

!NBWinTest class methodsFor: 'interface building' stamp: 'Igor.Stasenko 4/29/2010 15:35'!
createWindow
"
	NBWin32Window
		createWindowExA: 
		lpClassName:  lpWindowName:  dwStyle:  x:  y:  width:  height:  hWndParent:  hMenu:  hInstance:  lParam: 
		
	"! !

!NBWinTypes class methodsFor: 'object types' stamp: 'Igor.Stasenko 5/17/2010 15:19'!
objTypes

	WNDCLASSEX := #NBWndClassEx! !

!NBWinTypes class methodsFor: 'initialization' stamp: 'TorstenBergmann 8/13/2013 20:54'!
initialize
	" self initialize "
	BOOL := #bool.
	DWORD := #ulong.
	HWND := #NBWin32Window.
	POINT := #NBWin32Point.
	RECT := #NBWin32Rectangle.
	HDC := #NBWin32Hdc.
	HMENU := #HANDLE.
	UINT := #ulong.
	
	ATOM := #WORD.
	BOOLEAN := #BYTE.
	BYTE := #unsignedByte.
	CALLBACK := #'void*'.
	CHAR := #char.
	COLORREF := #DWORD.
	DWORDLONG := #ULONGLONG.

	DWORD32 := #ulong.
	DWORD64 := #ulonglong.
	FLOAT := #float.

	HRESULT := #LONG.
	INT := #long.
	INT32 := #long.
	INT64 := #longlong.
	LANGID := #WORD.
	LCID := #DWORD.
	LCTYPE := #DWORD.
	LGRPID := #DWORD.
	LONG := #long.
	LONGLONG := #longlong.

	LONG32 := #long.
	LONG64 := #longlong.
	LPARAM := #'LONG_PTR'.
	LPBOOL := #'BOOL*'.
	LPBYTE := #'BYTE*'.
	LPCOLORREF := #'DWORD*'.
	LPCVOID := #'void*'.
	LPDWORD := #'DWORD*'.
	
	WNDPROC := #'void*'.
	HANDLE := #NBWin32Handle.
	HINSTANCE :=  HMODULE := HCURSOR := HBRUSH := 
	HACCEL :=  HCOLORSPACE :=  HCONV := HICON := HCONVLIST := HDDEDATA := 
	HDESK := HDROP := HDWP := HENHMETAFILE := HFILE := HFONT := HGDIOBJ  := 
	HGLOBAL  := HHOOK  := HKEY  := HKL  := HLOCAL  := HMETAFILE  := HMODULE :=
	HMONITOR  := HPALETTE  := HPEN  := HRGN  := HRSRC  := HSZ  := HWINSTA := #HANDLE.

	self initialize2.
	self initialize3.
	self stringTypes.
	self objTypes.
	! !

!NBWinTypes class methodsFor: 'initialization' stamp: 'Igor.Stasenko 4/29/2010 14:23'!
initialize3
	" self initialize "
	
	LPHANDLE := 'HANDLE*'.
	LPINT := 'INT*'.
	LPLONG := 'LONG*'.
	
	LPVOID := 'void*'.
	LPWORD := 'WORD*'.
	LRESULT := 'LONG_PTR'.
	PBOOL := 'BOOL*'.
	PBOOLEAN := 'BOOLEAN*'.
	PBYTE := 'BYTE*'.
	PCHAR := 'CHAR*'.
	PDWORD := 'DWORD*'.
	PDWORDLONG := 'DWORDLONG*'.
	PDWORD32 := 'DWORD32*'.
	PDWORD64 := 'PDWORD64*'.
	PFLOAT := 'FLOAT*'.
	PHANDLE :='HANDLE*'.
	PHKEY := 'HKEY*'.
	PINT := 'INT*'.
	PINT32 := 'INT32*'.
	PINT64 := 'INT64*'.
	PLCID := 'PDWORD'.
	PLONG := 'LONG*'.
	PLONGLONG := 'LONGLONG*'.
	PLONG32 := 'LONG32*'.
	PLONG64 := 'LONG64*'.
	PSHORT := 'SHORT*'.
	PTBYTE := 'TBYTE*'.
	PTCHAR := 'TCHAR*'.
	PUCHAR := 'UCHAR*'.
	PUINT := 'UINT*'.
	PUINT32 := 'UINT32*'.
	PUINT64 := 'UINT64*'.
	PULONG := 'ULONG*'.
	PULONGLONG := 'ULONGLONG*'.
	PULONG32 := 'ULONG32*'.
	PULONG64 := 'ULONG64*'.
	PUSHORT := 'USHORT*'.
	PVOID := 'void*'.
	PWCHAR := 'WCHAR*'.
	PWORD := 'WORD*'.
	SHORT := 'short'.
	TBYTE := 'TCHAR'.
	UCHAR := #uchar.
	UINT := #uint.
	UINT32 := #uint.
	UINT64 := #uint64.
	ULONG := #ulong.
	ULONGLONG := #ulonglong.
	ULONG32 := #uint.
	ULONG64 := #uint64.
	USHORT := #ushort.
	USN := #LONGLONG.
	VOID := #void.
	WCHAR := #ushort.
	WORD := #ushort.
	WPARAM := #'UINT_PTR'.
	
	
	
	
	
! !

!NBWinTypes class methodsFor: 'initialization' stamp: 'Igor.Stasenko 5/17/2010 05:24'!
stringTypes
	TCHAR := #NBTCHAR.
	LPTCH := 'TCHAR*'.
	WCHAR := 'wchar_t'.
	LPWCH := 'WCHAR*'.

	LPTSTR := #NBTString.
	LPWSTR := #NBWideString.
	LPSTR := #NBExternalString.
	
	LPCSTR := #LPSTR.
	LPCTSTR := #LPTSTR.
	LPCWSTR := #LPWSTR.
	
	PCSTR := #LPCSTR.
	PCTSTR := #LPCTSTR.
	PCWSTR := #LPCWSTR.
	PSTR := #LPSTR.
	PTSTR := #LPTSTR.
	PWSTR := #LPWSTR.
! !

!NBWinTypes class methodsFor: 'initialization' stamp: 'Igor.Stasenko 4/29/2010 13:37'!
initialize2
	" self initialize "
	
	DWORD_PTR :=	#ULONG_PTR.
	HALF_PTR := #short. "Half the size of a pointer"
	INT_PTR := #long.
	LONG_PTR := #long.
	PDWORD_PTR := 'DWORD_PTR*'.
	PHALF_PTR := 'HALF_PTR*'.
	PINT_PTR := 'INT_PTR*'.
	PLONG_PTR := 'LONG_PTR*'.
	
	POINTER_32 := '__ptr32'.
	POINTER_64 := '__ptr64'.
	PSIZE_T := 'SIZE_T*'.
	PSSIZE_T := 'SSIZE_T*'.
	PUHALF_PTR := 'UHALF_PTR*'.
	PUINT_PTR := 'UINT_PTR*'.
	PULONG_PTR := 'ULONG_PTR*'.
	SC_HANDLE := #HANDLE.
	SC_LOCK := #LPVOID.
	SERVICE_STATUS_HANDLE := #HANDLE.
	SIZE_T := 'ULONG_PTR'.
	SSIZE_T := 'LONG_PTR'.
	UHALF_PTR := #ushort.  "different in 32/64"
	UINT_PTR := #uint.
	ULONG_PTR := #ulong. "different in 32/64"
	
	
	
	
	

! !

!NBWndClassEx methodsFor: 'registering' stamp: 'IgorStasenko 11/24/2012 16:24'!
register

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin >

	^ self nbCallout stdcall 
		function: #( ATOM RegisterClassExA (WNDCLASSEX * self) ) 
		module: #user32! !

!NBWndClassEx methodsFor: 'initialization' stamp: 'jb 11/14/2013 12:40'!
initialize
      self cbSize: (self class instanceSize).! !

!NBWndClassEx class methodsFor: 'fields description' stamp: 'Igor.Stasenko 5/19/2010 09:24'!
fieldsDesc
^ #(
	UINT cbSize;
	UINT style;
	WNDPROC lpfnWndProc;
	int cbClsExtra;
	int cbWndExtra;
	HINSTANCE hInstance;
	HICON hIcon;
	HCURSOR hCursor;
	HBRUSH hbrBackground;
	NBExternalAddress lpszMenuName;
	NBExternalAddress lpszClassName;
	HICON hIconSm;
)! !

!NBWndClassEx class methodsFor: 'unregistering' stamp: 'Igor.Stasenko 5/17/2010 18:54'!
unregister: aWndClassName 

	^ self unregister: aWndClassName instance: NativeBoostWin32 getVMModuleHandle.
! !

!NBWndClassEx class methodsFor: 'unregistering' stamp: 'IgorStasenko 11/24/2012 17:40'!
unregister: aWndClassName instance: hInstance

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin >

	^ self nbCallout stdcall  
		function: #( BOOL UnregisterClassA ( LPCTSTR aWndClassName, HINSTANCE hInstance ))
		module: #user32	! !

!NECClassVarEntry commentStamp: '<historical>'!
I represent a class Variable!
!NECClassVarEntry methodsFor: 'accessing' stamp: ''!
label
	^ 'class variable'! !

!NECClassVarEntry methodsFor: 'accessing' stamp: 'IgorStasenko 9/16/2013 17:19'!
type
	^ #classVar! !

!NECClassVarEntry methodsFor: 'operations' stamp: ''!
guessTypeWith: anECContext 
	^ anECContext guessClassVarClass: contents! !

!NECClassVarTypeGuesser commentStamp: '<historical>'!
I'm a simple InstructionClient that tries to guess the type of a given class variable name of a class. !
!NECClassVarTypeGuesser methodsFor: 'bytecode decoding' stamp: ''!
send: selector super: supered numArgs: numberArguments 
! !

!NECClassVarTypeGuesser methodsFor: 'instruction decoding' stamp: ''!
popIntoReceiverVariable: offset 
	self reset! !

!NECClassVarTypeGuesser methodsFor: 'public' stamp: ''!
methodRefs
	| theClass classVarAssoc |
	theClass := receiverClass classThatDefinesClassVariable: variableName.
	classVarAssoc := theClass classPool associationAt: variableName asSymbol.
	classVarAssoc value 
		ifNil: [ ^ SystemNavigation new allCallsOn: classVarAssoc ]
		ifNotNil: [ ^ classVarAssoc value class ]! !

!NECClassVarTypeGuesser methodsFor: 'bytecode decoding' stamp: ''!
popIntoLiteralVariable: anAssociation 
	anAssociation key == variableName asSymbol 
		ifTrue: [ found := true ]
		ifFalse: [ self reset ]! !

!NECClassVarTypeGuesserTest methodsFor: 'tests' stamp: ''!
testSuperClassVar
	self
		guessVariable: 'SuperClassVar'
		in: NECTestClass
		expected: Dictionary ! !

!NECClassVarTypeGuesserTest methodsFor: 'tests' stamp: ''!
testClassVar
	self
		guessVariable: 'ClassVar'
		in: NECTestClass
		expected: ByteString! !

!NECClassVarTypeGuesserTest methodsFor: 'tests' stamp: ''!
testDependentsFieldsClassVar
	self
		guessVariable: 'DependentsFields'
		in: NECTestClass
		expected: WeakIdentityKeyDictionary! !

!NECClassVarTypeGuesserTest methodsFor: 'utils' stamp: ''!
guessVariable: aString in: aClass expected: theClassExpected 
	| typeGuesser result |
	typeGuesser := NECClassVarTypeGuesser 
		variableName: aString
		class: aClass.
	result := typeGuesser perform.
	self assert: result == theClassExpected! !

!NECContext commentStamp: '<historical>'!
A completion is started by the ECController. The controller creates me to compute the context of the completion. The most important information about the context are the receiverClass and the completionToken. I create a ECModel or subclass when requested by the 'model' method.

I use SHParser and SHRange to parse the text input.!
!NECContext methodsFor: 'private-compute-index' stamp: 'EstebanLorenzano 4/18/2012 12:52'!
createEmptyRangeForGapAt: index 
	| current previous |
	current := ranges at: index.
	previous := ranges at: (index - 1 max: 1).
	self 
		insertEmptyRangeAt: index
		start: previous end + 1
		end: current start - 1.
	^ index! !

!NECContext methodsFor: 'private' stamp: ''!
computeReceiverClass
	| previous found |
	recurseCount := 0.
	completionIndex = 1 ifTrue: [^nil].
	found := self checkImpossibleReceiver.
	found ifTrue: [^nil].
	previous := ranges at: completionIndex - 1.
	previous type = #cascadeSeparator 
		ifTrue: [^self guessCascadeReceiver: completionIndex - 1].
	(previous type = #unary 
		and: [(self sourceOf: previous) = 'new' and: [completionIndex > 2]]) 
			ifTrue: 
				[previous := ranges at: completionIndex - 2.
				previous type = #globalVar 
					ifTrue: [^self guessTypeOf: completionIndex - 2]
					ifFalse: 
						[self configureSelectorsOnly.
						^nil]].
	^self guessTypeOf: completionIndex - 1! !

!NECContext methodsFor: 'private' stamp: ''!
compute
	completionIndex := self computeIndexOfPosition.
	receiverClass := self computeReceiverClass! !

!NECContext methodsFor: 'private-receiver-guessing' stamp: ''!
isSelectorsOnly
	| previous |
	previous := ranges at: completionIndex - 1.
	^previous isOpening! !

!NECContext methodsFor: 'private' stamp: ''!
guessTempVarClass: aSHRange 
	^self guessTempVarClass: (self sourceOf: aSHRange) type: aSHRange type.
! !

!NECContext methodsFor: 'private' stamp: ''!
guessCascadeReceiver: aNumber 
	| type |
	aNumber 
		to: 1
		by: -1
		do: 
			[ :index | 
			type := (ranges at: index) type.
			((#(#statementSeparator #assignment #ansiAssignment ) includes: type) or: [ (type beginsWith: 'pattern') or: [ type beginsWith: 'methodTemp' ] ]) ifTrue: [ ^ self guessTypeOf: index + 1 ] ].
	^ nil! !

!NECContext methodsFor: 'private-receiver-guessing' stamp: ''!
checkImpossibleReceiver
	^ self isSelectorsAndVariables
		ifTrue: [self configureSelectorsAndVariables]
		ifFalse: [self isVariablesOnly
				ifTrue: [self configureVariablesOnly]
				ifFalse: [self isSelectorsOnly
						and: [self configureSelectorsOnly]]]. ! !

!NECContext methodsFor: 'private' stamp: ''!
sourceOf: aSHRange stopAt: aNumber
	^ aSHRange type = #empty
		ifTrue: [String new]
		ifFalse: [source copyFrom: aSHRange start to: aNumber]! !

!NECContext methodsFor: 'private-type-guessing' stamp: 'NicolaiHess 2/18/2014 14:16'!
guessTypeOf: aNumber 
	| range |
	self configureSelectorsOnly.
	recurseCount > 10 ifTrue: [ ^ nil ].
	recurseCount := recurseCount + 1.
	range := ranges at: aNumber.
	
	range isSelf ifTrue: [ ^theClass ].
	range isSuper ifTrue: [ ^theClass superclass ].
	range isConstant ifTrue: [ ^self nonAbstractTypeOf: range ].
	range isArgument ifTrue: [ ^self guessArgument: range ].
	range isTemporaryVariable ifTrue: [ ^self guessTempVarClass: range ].
	range isInstanceVariable ifTrue: [ ^self guessInstVarClass: range ].
	range isClassVariable ifTrue: [ ^self guessClassVarClass: range ].
	range isGlobal ifTrue: [ ^self guessGlobal: aNumber ].
	
	^nil! !

!NECContext methodsFor: 'private-type-guessing' stamp: 'MarcusDenker 10/1/2014 13:22'!
nonAbstractTypeOf: aRange
	| cls |
	cls := aRange asType.
	cls hasAbstractMethods
		ifFalse: [ ^ cls ].
	^ [(cls readFromString: (aRange textIn: source)) class] on: Error do: [ cls ]! !

!NECContext methodsFor: 'initialization' stamp: ''!
initialize
	super initialize.
	source := String new.
	position := 0.
	recurseCount := 0.
	variables := true.
	selectors := true.
	ranges := OrderedCollection new.
	completionIndex := 0.
	completionToken := nil! !

!NECContext methodsFor: 'private-temporaries' stamp: ''!
convertBlocksToVariables: anOrderedCollection 
	| result blockStack |
	blockStack := anOrderedCollection.
	result := OrderedCollection new.
	blockStack do: [ :each | result addAll: each ].
	^ result! !

!NECContext methodsFor: 'private' stamp: 'CamilloBruni 8/5/2012 23:52'!
guessClassVarClass: aSHRange 
	| aClass name |
	name := self sourceOf: aSHRange.
	aClass := controller guessTypeFor: name.
	aClass
		ifNotNil: [^ aClass].
	^ (NECClassVarTypeGuesser 
		variableName: name 
		class: theClass theMetaClass) perform! !

!NECContext methodsFor: 'private-configure' stamp: ''!
configureSelectorsAndVariables
	variables := true.
	selectors := true.
	^true! !

!NECContext methodsFor: 'private' stamp: 'SeanDeNigris 6/22/2012 18:24'!
createRanges
	| parser |
	parser := SHParserST80 new on: controller model.
	ranges := parser 
				rangesIn: source
				classOrMetaClass: theClass
				workspace: controller workspace
				environment: nil.
	ranges := ranges select: [:each | each type ~= #comment]! !

!NECContext methodsFor: 'private' stamp: ''!
receiverClass
	^ receiverClass! !

!NECContext methodsFor: 'private-compute-index' stamp: ''!
createEmptyRangeAtTail
	| previous |
	previous := ranges last.
	ranges add: (SHRange 
			start: previous end + 1
			end: source size
			type: #empty).
	^ ranges size! !

!NECContext methodsFor: 'private-temporaries' stamp: ''!
handleBlockStack: aCollection with: aSHRange 
	| range blockStack |
	range := aSHRange.
	blockStack := aCollection.
	range isBlockStart 
		ifTrue: [ blockStack add: OrderedCollection new ]
		ifFalse: [ range isBlockEnd ifTrue: [ blockStack removeLast ] ]! !

!NECContext methodsFor: 'private' stamp: ''!
sourceOf: aSHRange 
	^aSHRange isString
		ifTrue: [aSHRange]
		ifFalse: [self sourceOf: aSHRange stopAt: aSHRange end]! !

!NECContext methodsFor: 'accessing' stamp: ''!
theClass
	^theClass! !

!NECContext methodsFor: 'private-compute-index' stamp: ''!
insertEmptyRangeAt: index start: start end: end 
	ranges
		add: (SHRange
				start: start
				end: end
				type: #empty)
		beforeIndex: index! !

!NECContext methodsFor: 'private-configure' stamp: ''!
configureVariablesOnly
	variables := true.
	selectors := false.
	^true! !

!NECContext methodsFor: 'accessing' stamp: 'MarcusDenker 12/2/2013 14:07'!
createModel
	| modelClass |
	
	self receiverClass
		ifNotNil: [^ NECTypedModel class: receiverClass].
		
	(controller workspace isNil
		and: [theClass notNil])
		ifTrue: [completionIndex = 1
				ifTrue: [^ NECOverrideModel class: theClass]].
			
	modelClass := NECUntypedModel.		
	(controller model respondsTo: #modelClass) 
		ifTrue: [
			controller model modelClass ifNotNil: [:class | modelClass :=  class]].	
			
	
	^ modelClass
		class: theClass
		temporaries: self temporaries
		additionals: controller additionals
		variables: variables
		selectors: selectors! !

!NECContext methodsFor: 'private' stamp: ''!
findSourceRangeFor: aNumber 
	aNumber
		to: ranges size
		by: 2
		do: [:index | 
			index + 3 > ranges size
				ifTrue: [^ nil].
			(ranges at: index + 1) isAssignment
				ifTrue: [(ranges at: index + 3) type = #statementSeparator
						ifTrue: [^ index + 2]
						ifFalse: [(ranges at: index + 2) type = #globalVar
								ifTrue: [^ index + 2]
								ifFalse: [(ranges at: index + 1) isAssignment 
										ifFalse: [^ nil]]]]]! !

!NECContext methodsFor: 'private-type-guessing' stamp: 'StephanEggermont 3/11/2014 11:18'!
guessArgument: aSHRange 
	| name |
	name := self sourceOf: aSHRange.
	(name = 'html') ifTrue: [
		 Smalltalk at: #WAHtmlCanvas ifPresent: [ :canvasClass | ^canvasClass].
		 Smalltalk at: #WARenderCanvas ifPresent: [ :canvasClass | ^canvasClass]].
	^ NECInstVarTypeGuesser getClassFromTypeSuggestingName: name! !

!NECContext methodsFor: 'private-configure' stamp: ''!
configureSelectorsOnly
	variables := false.
	selectors := true.
	^true! !

!NECContext methodsFor: 'private-temporaries' stamp: ''!
blockTemporaries
	| blocks range vars |
	blocks := OrderedCollection new.
	1 
		to: completionIndex - 1
		do: 
			[ :index | 
			range := ranges at: index.
			self 
				handleBlockStack: blocks
				with: range.
			range isBlockTemporary ifTrue: 
				[ vars := blocks last.
				vars add: range ] ].
	^ self convertBlocksToVariables: blocks! !

!NECContext methodsFor: 'accessing' stamp: ''!
completionToken
	completionToken ifNil: 
		[ | range |
		range := ranges at: completionIndex.
		completionToken := self 
			sourceOf: range
			stopAt: position.
		completionToken := completionToken wordBefore: completionToken size ].
	^ completionToken! !

!NECContext methodsFor: 'private-compute-index' stamp: ''!
computeIndexOfPosition
	| current |
	self checkForZeroPosition ifTrue: [ ^ 1 ].
	1 
		to: ranges size
		do: 
			[ :index | 
			current := ranges at: index.
			(current includesPosition: position) 
				ifTrue: [ ^ index ]
				ifFalse: 
					[ current end > position ifTrue: [ ^ self createEmptyRangeForGapAt: index ] ] ].
	^ self createEmptyRangeAtTail! !

!NECContext methodsFor: 'private' stamp: 'MarcusDenker 8/10/2014 11:57'!
guessInstVarClass: aSHRange 
	| aClass name |
	name := self sourceOf: aSHRange.
	aClass := controller guessTypeFor: name.
	aClass ifNotNil: [ ^ aClass ].
	^ (NECInstVarTypeGuesser 
		variableName: name
		class: theClass) perform! !

!NECContext methodsFor: 'accessing' stamp: ''!
model
	model isNil ifTrue: [ model := self createModel ].
	^ model! !

!NECContext methodsFor: 'action' stamp: ''!
narrowWith: aString 
	completionToken := aString.
	model ifNotNil: [ model narrowWith: aString ]! !

!NECContext methodsFor: 'private-receiver-guessing' stamp: ''!
isSelectorsAndVariables
	| current |
	current := ranges at: completionIndex.
	^current isUnfinished! !

!NECContext methodsFor: 'initialize-release' stamp: ''!
setController: aECController class: aClass source: aString position: anInteger 
	controller := aECController.
	theClass := aClass.
	source := aString.
	position := anInteger.
	self createRanges.
	self compute! !

!NECContext methodsFor: 'action' stamp: ''!
switchToUntyped
	receiverClass := nil.
	self configureSelectorsAndVariables.
	model := self createModel! !

!NECContext methodsFor: 'private-compute-index' stamp: ''!
checkForZeroPosition
	^ (position = 0
			or: [ranges isEmpty])
		and: [self insertEmptyRangeAt: 1 start: 0 end: 1.
			true]! !

!NECContext methodsFor: 'private' stamp: ''!
guessTempVarClass: aString type: aSymbol 
	| current type varName varType sourceIndex aClass |
	aClass := controller guessTypeFor: aString.
	aClass ifNotNil: [ ^ aClass ].
	varName := aString.
	varType := aSymbol.
	1 
		to: completionIndex
		do: 
			[ :index | 
			current := ranges at: index.
			(current type = varType and: [ (self sourceOf: current) = varName and: [ index + 3 <= ranges size ] ]) ifTrue: 
				[ (sourceIndex := self findSourceRangeFor: index) notNil ifTrue: 
					[ type := self guessTypeOf: sourceIndex.
					type ifNotNil: [ ^ type ] ] ] ].
	^ nil! !

!NECContext methodsFor: 'accessing' stamp: ''!
temporaries
	| tempRanges |
	tempRanges := ranges select: [ :each | #(#patternTempVar #patternArg ) includes: each type ].
	tempRanges addAll: self blockTemporaries.
	^ tempRanges collect: 
		[ :each | 
		NECLocalEntry 
			contents: (self sourceOf: each)
			type: each type ]! !

!NECContext methodsFor: 'private-receiver-guessing' stamp: ''!
isVariablesOnly
	| current previous |
	current := ranges at: completionIndex.
	^ current isVariablesOnly or: 
		[ current isOpening or: 
			[ previous := ranges at: completionIndex - 1.
			previous isOpening or: 
				[ previous isSeparator or: 
					[ previous isKeyword or: [ previous isAssignment or: [ previous isBinary ] ] ] ] ] ]! !

!NECContext methodsFor: 'private-type-guessing' stamp: ''!
guessGlobal: aNumber 
	| aClass |
	aClass := Smalltalk 
		at: (self sourceOf: (ranges at: aNumber)) asSymbol
		ifAbsent: [ ^ nil ].
	aClass isBehavior ifFalse: [ ^ nil ].
	aNumber = (completionIndex - 1) ifTrue: [ ^ aClass class ].
	(ranges size >= (aNumber + 1) and: [ (ranges at: aNumber + 1) type = #statementSeparator ]) ifTrue: [ ^ aClass class ].
	^ aClass! !

!NECContext class methodsFor: 'instance creation' stamp: ''!
controller: aECController class: aClass source: aString position: anInteger 
	^ self basicNew initialize
		setController: aECController
		class: aClass
		source: aString
		position: anInteger! !

!NECContextTest methodsFor: 'tests' stamp: ''!
testReceiverArgument
	| text context |
	text := 'testIt: aRectangle
	aRectangle printS'.
	context := self 
		createContextFor: text
		at: text size.
	self assert: context receiverClass == Rectangle.
	text := 'testIt: rect
	rect is'.
	context := self 
		createContextFor: text
		at: text size.
	self assert: context receiverClass isNil! !

!NECContextTest methodsFor: 'tests' stamp: ''!
testCompletionToken
	| text context |
	text := 'testIt: aRectangle
	| abc |
	test.
	abc daf'.
	context := self createContextFor: text at: text size.
	self assert: context completionToken = 'daf'! !

!NECContextTest methodsFor: 'tests' stamp: 'NicolaiHess 2/19/2014 15:38'!
testReceiverTempVar
	| text context |
	text := 'testIt
	| aha |
	aha _ ''test''.
	aha p'.
	context := self 
		createContextFor: text
		at: text size.
	self assert: context receiverClass == ByteString.
	text := 'testIt
	| aha |
	ah _ ''test''.
	ah p'.
	context := self 
		createContextFor: text
		at: text size.
	self assert: context receiverClass isNil.
	text := 'testIt
	| aha |
	aha _ constantString.
	aha p'.
	context := self 
		createContextFor: text
		at: text size.
	self assert: context receiverClass == ByteString.
	text := 'testIt
	| aha |
	aha _ constant asDate.
	aha p'.
	context := self 
		createContextFor: text
		at: text size.
	self assert: context receiverClass isNil.
	text := 'testIt
	| aha bili |
	aha _ constantString.
	bili _ aha.
	bili p'.
	context := self 
		createContextFor: text
		at: text size.
	self assert: context receiverClass == ByteString.
	text := 'testIt
	| aha bili |
	aha _ constantString.
	bili _ aha _ 15.
	bili p'.
	context := self 
		createContextFor: text
		at: text size.
	self assert: context receiverClass = SmallInteger.
	text := 'testIt
	| aha bili |
	aha _ constantString.
	bili _ 15.
	bili _ aha.
	bili p'.
	context := self 
		createContextFor: text
		at: text size.
	self assert: context receiverClass == SmallInteger.
	text := 'testIt
	[ :each | |a| a _ 16. a print'.
	context := self 
		createContextFor: text
		at: text size.
	self assert: context receiverClass == SmallInteger.
	text := 'testIt
	[ :each | |a| a _ Dictionary new. a print'.
	context := self 
		createContextFor: text
		at: text size.
	self assert: context receiverClass == Dictionary.
	text := 'testIt
	[ :each | |a| a _ Dictionary. a print'.
	context := self 
		createContextFor: text
		at: text size.
	self assert: context receiverClass == Dictionary class.
	text := 'testIt
	| aha |
	aha _ constantLargeInteger.
	aha p'.
	context := self 
		createContextFor: text
		at: text size.
	self assert: context receiverClass = LargePositiveInteger.! !

!NECContextTest methodsFor: 'tests' stamp: ''!
testCreateModel
	| text context |
	text := 'testIt: aRectangle
	aRectangle printS'.
	context := self createContextFor: text at: text size.
	self assert: context createModel class == NECTypedModel.
	text := 'testIt:'.
	context := self createContextFor: text at: text size.
	self assert: context createModel class = NECOverrideModel.
	text := 'testIt: rect
	rect is'.
	context := self createContextFor: text at: text size.
	self assert: context createModel class = NECUntypedModel! !

!NECContextTest methodsFor: 'private' stamp: 'CamilloBruni 8/21/2012 16:30'!
checkUntypedVariablesOnly: aString 
	| context model |
	context := self 
		createContextFor: aString
		at: aString size.
	self assert: context isVariablesOnly.
	model := context model.
	model loadEntries.
	self assert: model hasMessage not.
	self assert: (model entriesOfType: #instVar) notEmpty.
	context narrowWith: 'a'.
	self assert: (model entriesOfType: #selector) isEmpty! !

!NECContextTest methodsFor: 'tests' stamp: ''!
testBlockTemporariesBoxed
	| text temps context |
	text := 'testIt
	| a b c |
	a := [ :each | |d | d = a ifTrue:[ |x|  ] ifFalse:[ |y|.
	^self'.
	context := self 
		createContextFor: text
		at: 73.
	temps := context temporaries collect: [ :each | each contents ].
	self assert: temps size = 5.
	self assert: temps first = 'a'.
	self assert: temps second = 'b'.
	self assert: temps third = 'c'.
	self assert: temps fourth = 'each'.
	self assert: temps fifth = 'd'.
! !

!NECContextTest methodsFor: 'tests' stamp: ''!
testReceiverClassVar
	| text context |
	text := 'testIt
	ClassVar '.
	context := self 
		createContextFor: text
		at: text size.
	self assert: context receiverClass == ByteString! !

!NECContextTest methodsFor: 'tests' stamp: 'NicolaiHess 2/19/2014 15:31'!
testReceiverConstant
	| text context |
	text := 'testIt
	15r16 printS'.
	context := self createContextFor: text at: text size.
	self assert: context receiverClass == SmallInteger.
	text := 'testIt
	''test'' printS'.
	context := self createContextFor: text at: text size.
	self assert: context receiverClass == ByteString.
	text := 'testIt
	true ifTrue:'.
	context := self createContextFor: text at: text size.
	self assert: context receiverClass == True.
	text := 'testIt
	false  "this is it"
		printStr'.
	context := self createContextFor: text at: text size.
	self assert: context receiverClass == False.
	text := 'testIt
	a _ [ :test | test * test ] 
		v'.
	context := self createContextFor: text at: text size.
	self assert: context receiverClass == BlockClosure.
	text := 'testIt
	$c as'.
	context := self createContextFor: text at: text size.
	self assert: context receiverClass == Character.
	text := 'testIt
	#gaga as'.
	context := self createContextFor: text at: text size.
	self assert: context receiverClass == Symbol.
	text := 'testIt
	#( 1 2 3) as'.
	context := self createContextFor: text at: text size.
	self assert: context receiverClass == Array.
	text:='testIt
	2r1.1e2 as'.
	context := self createContextFor: text at: text size.
	self assert: context receiverClass == Float.
	text:='testIt
	23s32 as'.
	context := self createContextFor: text at: text size.
	self assert: context receiverClass == ScaledDecimal.
! !

!NECContextTest methodsFor: 'tests' stamp: ''!
testReceiverGlobal
	| text context |
	text := 'testIt
	Dictionary n'.
	context := self createContextFor: text at: text size.
	self assert: context receiverClass == Dictionary class.
! !

!NECContextTest methodsFor: 'tests' stamp: ''!
testInTheMiddelOfAWord
	| text context |
	text := 'hagada'.
	context := self 
		createContextFor: text
		at: 4.
	self assert: context completionToken = 'haga'! !

!NECContextTest methodsFor: 'tests' stamp: ''!
testReceiverCascade
	| text context |
	text := 'testIt
	| b |
	b _ Stream new.
	b 
		nextPutAll: ''test''; 
		nextPut: $c;
		s'.
	context := self createContextFor: text at: text size.
	self assert: context receiverClass == Stream.
	text := 'testIt
	| b |
	b _ Stream new
		nextPutAll: ''test''; 
		nextPut: $c with: true;
		s'.
	context := self createContextFor: text at: text size.
	self assert: context receiverClass == Stream.
	text := 'testIt: aStream
	| test |
	aStream
		nextPutAll: ''test''; 
		nextPut: $c with: true;
		s'.
	context := self createContextFor: text at: text size.
	self assert: context receiverClass == Stream.
	text := 'testIt: aStream
	aStream
		nextPutAll: ''test''; 
		nextPut: $c with: true;
		s'.
	context := self createContextFor: text at: text size.
	self assert: context receiverClass == Stream! !

!NECContextTest methodsFor: 'tests' stamp: ''!
testEmpty
	self createContextFor: '' at: 0! !

!NECContextTest methodsFor: 'tests' stamp: ''!
testReceiverTempVar2
	| text context |
	text := 'openMenuFor: aParagraphEditor 
	| theMenu |
	context := NECContext
				controller: self
				class: model receiverClass
				source: aParagraphEditor text string
				position: aParagraphEditor caret - 1.
	editor := aParagraphEditor.
	theMenu := NECMenuMorph
				controller: self
				position: (aParagraphEditor selectionPosition: context completionToken).
	theMenu isClosed
		ifFalse: [menuMorph := theMenu]. theMenu o'.
	context := self createContextFor: text at: text size.
	self assert: context receiverClass == NECMenuMorph! !

!NECContextTest methodsFor: 'private' stamp: ''!
createContextFor: aString at: anInteger 
	^ NECContext
		controller: NECController new
		class: NECTestClass
		source: aString
		position: anInteger! !

!NECContextTest methodsFor: 'tests' stamp: ''!
testUntypedVarsOnly
	self checkUntypedVariablesOnly: 'testIt
	'.
	self checkUntypedVariablesOnly: '+ aTest
	'.
	self checkUntypedVariablesOnly: 'gaga: aTest
	'.
	self checkUntypedVariablesOnly: 'gaga
	^ '.
	self checkUntypedVariablesOnly: 'testIt 
	a ifTrue:[ '.
	self checkUntypedVariablesOnly: 'testIt 
	a ifTrue:[ :each'.
	self checkUntypedVariablesOnly: 'testIt 
	a ifTrue:[ :each |'.
	self checkUntypedVariablesOnly: 'testIt 
	a ifTrue:[ :each | '.
	self checkUntypedVariablesOnly: 'testIt
	<primitive: 67> 
	'.
	self checkUntypedVariablesOnly: 'testIt
	ab _'.
	self checkUntypedVariablesOnly: 'testIt
	ab _ '.
	self checkUntypedVariablesOnly: 'self compare: '.
	self checkUntypedVariablesOnly: 'self compare: x caseSensitive: '.
	self checkUntypedVariablesOnly: 'self gaga: x gugu: ('.
	self checkUntypedVariablesOnly: 'testIt
	a _ 15 + '.
	self checkUntypedVariablesOnly: 'testIt
	self hugatada: '! !

!NECContextTest methodsFor: 'tests' stamp: ''!
testUnfinishedString
	| text context |
	text := 'testIt: aRectangle
	| a b c |
	self test: ''test it and so'.
	context := self 
		createContextFor: text
		at: text size.
	self assert: context completionToken = 'so'! !

!NECContextTest methodsFor: 'tests' stamp: ''!
testBlockTemporaries
	| text temps context |
	text := 'testIt
	| a b c |
	a _ [ :each | |d | ^d].
	^self'.
	context := self 
		createContextFor: text
		at: 39.
	temps := context temporaries collect: [ :each | each contents ].
	self assert: temps size = 5.
	self assert: temps first = 'a'.
	self assert: temps second = 'b'.
	self assert: temps third = 'c'.
	self assert: temps fourth = 'each'.
	self assert: temps fifth = 'd'! !

!NECContextTest methodsFor: 'tests' stamp: ''!
testReceiverGlobalVarNew
	| text context |
	text := 'testIt
	Dictionary new a'.
	context := self createContextFor: text at: text size.
	self assert: context receiverClass == Dictionary.
! !

!NECContextTest methodsFor: 'tests' stamp: ''!
testTemporaries
	| text temps context |
	text := 'testIt: aRectangle
	| a b c |
	a _ [ :each | |d | ^d].
	^self'.
	context := self 
		createContextFor: text
		at: text size.
	temps := context temporaries collect: [ :each | each contents ].
	self assert: temps size = 4.
	self assert: temps first = 'aRectangle'.
	self assert: temps second = 'a'.
	self assert: temps third = 'b'.
	self assert: temps fourth = 'c'! !

!NECContextTest methodsFor: 'tests' stamp: ''!
testCompletionTokenEmpty
	| text context |
	text := 'testIt: aRectangle
	| abc |
	test.
	abc daf '.
	context := self createContextFor: text at: text size.
	self assert: context completionToken = ''! !

!NECContextTest methodsFor: 'tests' stamp: ''!
testUntypedSelectorsOnly
	| text context model |
	text := 'testIt: aRectangle
	| ab bc bd |
	ab '.
	context := self 
		createContextFor: text
		at: text size.
	model := context model.
	self assert: model hasMessage.
	self assert: model message = 'press key for selectors'.
	context narrowWith: 'a'.
	self assert: (model entriesOfType: #selector) notEmpty.
	self assert: (model entriesOfType: #local) isEmpty.
	self assert: (model entriesOfType: #instance) isEmpty! !

!NECController commentStamp: '<historical>'!
I live as an instance variable in a Browser, Debugger, Workspace or other window. I'm the glue between all participants of the completion system. I create the NECContext and pass myself to the NECMenuMorph. I process the keyboard events and pass them to the NECMenuMorph or close the morph if needed.!
!NECController methodsFor: 'keyboard' stamp: 'EstebanLorenzano 2/25/2013 15:39'!
smartBackspace
	| opposite currentText currentEditor smartCharacter |
	
	currentEditor := editor.
	currentEditor hasSelection
		ifTrue: [ ^ false ].
	
	currentText := currentEditor text.
	smartCharacter := currentText at: currentEditor startIndex - 1 ifAbsent: [ ^ false ].	"take the opposite"
	
	opposite := self smartCharactersMapping at: smartCharacter ifAbsent: [ ^ false ].	"test if the next char is opposite"
	
	opposite = (currentText at: currentEditor stopIndex ifAbsent: [ ^ false ])
		ifFalse: [ ^ false ].	"test if there is an extra opposite to remove"
	
	(self 
		smartNeedExtraRemoveIn: currentText 
		for: smartCharacter 
		opposite: opposite 
		at: currentEditor startIndex)
			ifFalse: [  ^ false ].	
			
	currentEditor closeTypeIn.
	
	currentEditor 
		selectInvisiblyFrom: currentEditor startIndex - 1 
		to: currentEditor stopIndex.
	currentEditor replaceSelectionWith: currentEditor nullText.
	
	self invalidateEditorMorph.
	
	^ true! !

!NECController methodsFor: 'keyboard' stamp: 'HenrikSperreJohansen 8/28/2014 11:12'!
smartCharacterWithEvent: anEvent
	"char is extracted from anEvent, anEvent is passed because we may need it.
	We may remove char if this is not costly."

	| opposite previous next char insertion insertionCenter |
	char := anEvent keyCharacter.
	editor hasSelection
		ifTrue: [ 
			"we selected a piece of text and we type the same character that previously, so
		we unwrap it"
			"we selected a piece of text if the character is not a special one we do nothing."
			opposite := self smartCharactersMapping at: char ifAbsent: [ ^ nil ].	"else we wrap the selection"	"editor replaceSelectionWith: (String with: char) , (editor selection) , (String with: opposite)."	"ugly logic it should be encapsulated in the editor "
			editor enclose: anEvent.
			self invalidateEditorMorph.
			^ true ].	"we are not in a selection"
	opposite := self smartCharactersMapping
		at: char
		ifAbsent: [ 
			"if the character is not a special character"
			self smartInverseMapping at: char ifAbsent: [ ^ nil ].	"if the character is not a closing special character do nothing"	"The character is special"
			editor blinkPrevParen: char.
			(editor nextCharacterIfAbsent: [ ^ nil ]) = char
				ifFalse: [ ^ nil ].	"do not get this test but if we comment it out we cannot type closing ) anymore"
			editor selectFrom: editor startIndex + 1 to: editor startIndex.
			self invalidateEditorMorph.
			^ true ].
	previous := editor previousCharacterIfAbsent: [ Character space ].
	next := editor nextCharacterIfAbsent: [ Character space ].
	insertion := next isSeparator
				ifFalse: [ char asString ]
				ifTrue: [ 
					previous isSeparator
						ifFalse: [ char asString ]
						ifTrue: [ self newSmartCharacterInsertionStringForLeft: char right: opposite ]].
	editor replaceSelectionWith: insertion.
	insertionCenter := insertion size // 2 max: 1.
	editor selectFrom: editor startIndex + insertionCenter to: editor startIndex + (insertionCenter - 1).
	self invalidateEditorMorph.
	^ true! !

!NECController methodsFor: 'settings' stamp: ''!
smartInverseMapping
	^ inverseMapping ifNil: [ 
		inverseMapping := Dictionary new.
		self smartCharactersMapping
			keysAndValuesDo: [ :key :value | inverseMapping at: value put: key ].
		inverseMapping ]! !

!NECController methodsFor: 'keyboard' stamp: 'CamilloBruni 4/12/2013 16:29'!
handleKeystrokeAfter: aKeyboardEvent editor: aParagraphEditor 
	(aParagraphEditor isNil or: [ self isMenuOpen not ])
		ifTrue: [ ^ self ].
		
	aParagraphEditor atCompletionPosition 
		ifFalse: [ ^ self closeMenu ].
	
	self setModel: aParagraphEditor model.
	context narrowWith: aParagraphEditor wordAtCaret.
	menuMorph narrowCompletion.
	(context isNil or: [ context model isEmpty])
		ifTrue: [ ^self closeMenu ]! !

!NECController methodsFor: 'keyboard' stamp: 'CamilloBruni 1/15/2013 15:51'!
newSmartCharacterInsertionStringForLeft: left right: right
	((NECPreferences smartCharactersWithDoubleSpace includes: left) or: [
	(NECPreferences smartCharactersWithDoubleSpace includes: right)])
	ifTrue: [ 
		^ String with: left with: Character space with: Character space  with: right ].
	
	((NECPreferences smartCharactersWithSingleSpace includes: left) or: [
	(NECPreferences smartCharactersWithSingleSpace includes: right)])
	ifTrue: [ 
		^ String with: left with: Character space  with: right ].
	
	^ String with: left with: right! !

!NECController methodsFor: 'accessing' stamp: ''!
editor
	^ editor! !

!NECController methodsFor: 'menu morph' stamp: 'CamilloBruni 10/21/2012 14:54'!
closeMenu
	self stopCompletionDelay.
	menuMorph
		ifNotNil: [ menuMorph delete ].
	menuMorph := nil.! !

!NECController methodsFor: 'accessing' stamp: ''!
workspace
	^nil! !

!NECController methodsFor: 'keyboard' stamp: ''!
invalidateEditorMorph
		editor morph invalidRect: editor morph bounds.
! !

!NECController methodsFor: 'menu morph' stamp: 'IgorStasenko 9/16/2013 17:16'!
openMenuFor: aParagraphEditor 
	| theMenu |
	self stopCompletionDelay.
	
	context := self contextClass
				controller: self
				class: model selectedClassOrMetaClass 
				source: aParagraphEditor text string
				position: aParagraphEditor caret - 1.
	
	editor := aParagraphEditor.

	theMenu := self menuMorphClass
				controller: self
				position: (aParagraphEditor selectionPosition: context completionToken).
				
	theMenu isClosed
		ifFalse: [ menuMorph := theMenu ].
	
	(context isNil or: [ context model isEmpty ])
		ifTrue: [ ^self closeMenu ].! !

!NECController methodsFor: 'private' stamp: 'AlainPlantec 7/9/2013 12:38'!
resetCompletionDelay
	"Open the popup after 100ms and only after certain characters"
	self stopCompletionDelay.
	self isMenuOpen ifTrue: [ ^ self ].
	editor atCompletionPosition ifFalse: [ ^ self ].
	
	completionDelay := [
			(Delay forMilliseconds: NECPreferences popupAutomaticDelay) wait.
			UIManager default defer:  [ 
				editor atCompletionPosition ifTrue: [ self openMenu ]]
		] fork.
	! !

!NECController methodsFor: 'private' stamp: 'EstebanLorenzano 4/11/2012 16:40'!
contextClass
	^NECContext! !

!NECController methodsFor: 'initialize-release' stamp: ''!
setModel: aStringHolder 
	model := aStringHolder! !

!NECController methodsFor: 'private' stamp: 'IgorStasenko 8/28/2013 15:21'!
setEditor: anObject
	editor ifNotNil: [  
		"make sure we unsubscribe from old editor"
		editor morph announcer unsubscribe: self.
	].

	editor := anObject.
	editor morph onAnnouncement: MorphLostFocus send: #closeMenu to: self.! !

!NECController methodsFor: 'menu morph' stamp: 'EstebanLorenzano 2/1/2013 15:51'!
openMenu
	^ self openMenuFor: editor.! !

!NECController methodsFor: 'settings' stamp: ''!
smartCharacters
	^ NECPreferences smartCharacters ! !

!NECController methodsFor: 'private' stamp: 'EstebanLorenzano 2/25/2013 15:35'!
smartNeedExtraRemoveIn: currentText for: opposite
	"Test if smart remove need to remove an extra character when the smart character 
	 is equal to its opposite"
	
	(currentText select: [ :char | char = opposite ]) size odd
		ifTrue: [ ^ false ].
	^true! !

!NECController methodsFor: 'keyboard' stamp: 'MarcusDenker 10/5/2013 19:28'!
handleKeystrokeWithoutMenu: aKeyboardEvent
	
	self editor atCompletionPosition ifFalse: [ 
		^ (self smartInputWithEvent: aKeyboardEvent ) notNil ].	
	
	self stopCompletionDelay.

	(NECPreferences popupShowWithShortcut matches: {aKeyboardEvent})
		 ifTrue: [
			self openMenu.
			^true ].
		
	(self smartInputWithEvent: aKeyboardEvent )
		ifNotNil: [ ^true ].

	NECPreferences popupShowAutomatic ifTrue: [
		(aKeyboardEvent anyModifierKeyPressed not 
		and: [ aKeyboardEvent keyCharacter isCompletionCharacter ]) 
			ifTrue: [ self resetCompletionDelay ] ].
	
	^ false! !

!NECController methodsFor: 'keyboard' stamp: 'CamilloBruni 8/26/2012 17:51'!
leftArrow
	
	(menuMorph hideDetail)	
			ifFalse: [ 
				self closeMenu.
				^ false ].	
	^ true! !

!NECController methodsFor: 'type guessing' stamp: 'CamilloBruni 8/5/2012 23:39'!
guessTypeFor: aString
	^ model isNil ifFalse: [ model guessTypeForName: aString ]! !

!NECController methodsFor: 'private' stamp: 'EstebanLorenzano 2/25/2013 15:40'!
smartNeedExtraRemoveIn: currentText for: smartCharacter opposite: opposite at: position
	"Test if we need to remove an extra character when removing a smart character (any kind of smart character)"
	
	smartCharacter = opposite
		ifTrue: [ 
			(self smartNeedExtraRemoveIn: currentText for: opposite)
				ifFalse: [ ^ false ] ]
		ifFalse: [ 
			(self
				smartNeedExtraRemovePairedIn: currentText
				for: smartCharacter
				opposite: opposite
				at: position)
					ifFalse: [ ^false ] ].
	^ true! !

!NECController methodsFor: 'private' stamp: 'EstebanLorenzano 2/25/2013 15:43'!
smartNeedExtraRemovePairedIn: currentText for: smartCharacter opposite: opposite at: position
	"Test if we need to remove an extra character when removed a paired smart character.
	 A paired smart character is any smart character who has an opposite who is diferent to itself: [], ()"
	
	| startIndex countSmart countOpposite |
	
	countSmart := 0.
	countOpposite := 0.
	startIndex := self
		smartStartIndexIn: currentText
		for: smartCharacter
		opposite: opposite
		at: position.
		
	(currentText allButFirst: startIndex) 
		do: [ :char | 
			char = smartCharacter
				ifTrue: [ countSmart := countSmart + 1 ].
			char = opposite
				ifTrue: [ countOpposite := countOpposite + 1 ] ].
	
	(countSmart > countOpposite and: [ (countOpposite - countSmart) odd ])
		ifTrue: [ ^ false ].
		
	^true! !

!NECController methodsFor: 'menu morph' stamp: 'EstebanLorenzano 4/18/2012 11:05'!
isMenuEmpty
	^menuMorph isNil or: [ self context model notNil and: [ self context model isEmpty ] ]! !

!NECController methodsFor: 'menu morph' stamp: ''!
isMenuOpen
	^menuMorph notNil! !

!NECController methodsFor: 'accessing' stamp: ''!
model
	^model! !

!NECController methodsFor: 'keyboard' stamp: 'MarcusDenker 10/5/2013 19:27'!
handleKeystrokeBefore: aKeyboardEvent editor: anEditor
	"I return a boolean. 
	true when I have handled the event and no futher processing is needed by the caller."

	| keyCharacter controlKeyPressed |
	self flag: #fixme.	"this method should be split up"
	self setEditor: anEditor.
	self setModel: editor model.
	keyCharacter := aKeyboardEvent keyCharacter.
	controlKeyPressed := aKeyboardEvent controlKeyPressed.
	self isMenuOpen
		ifFalse: [ ^ self handleKeystrokeWithoutMenu: aKeyboardEvent ].
	(keyCharacter = Character home and: [ self captureNavigationKeys ])
		ifTrue: [ 
			menuMorph home.
			^ true ].
	(keyCharacter = Character end and: [ controlKeyPressed not and: [ self captureNavigationKeys ] ])
		ifTrue: [ 
			menuMorph end.
			^ true ].
	(keyCharacter = Character arrowRight and: [ self captureNavigationKeys ])
		ifTrue: [ 
			menuMorph showDetail.
			^ true ].
	(keyCharacter = Character arrowLeft and: [ self captureNavigationKeys ])
		ifTrue: [ ^ self leftArrow ].
	keyCharacter = Character arrowUp
		ifTrue: [ 
			menuMorph moveUp.
			^ true ].
	keyCharacter = Character arrowDown
		ifTrue: [ 
			menuMorph moveDown.
			^ true ].
	keyCharacter = Character pageUp
		ifTrue: [ 
			menuMorph pageUp.
			^ true ].
	keyCharacter = Character pageDown
		ifTrue: [ 
			menuMorph pageDown.
			^ true ].
	(keyCharacter = Character cr and: [ NECPreferences useEnterToAccept ])
		ifTrue: [ 
			menuMorph insertSelected
				ifTrue: [ ^ true ] ].
	keyCharacter = Character tab
		ifTrue: [ 
			NECPreferences expandPrefixes
				ifFalse: [ 
					menuMorph insertSelected
						ifTrue: [ ^ true ] ]
				ifTrue: [ 
					menuMorph insertCommonPrefixOrSelected
						ifTrue: [ ^ true ] ] ].
	self flag: #todo.	"Removing for now... most of the shortcuts are broken and no time or need now to fix them"	"(keyCharacter = $h and: [ controlKeyPressed ]) ifTrue: [ 
		menuMorph help.
		^ true ].

	(keyCharacter = $t and: [ controlKeyPressed ]) ifTrue: [ 
		menuMorph expand.
		^ true ].

	(keyCharacter = $u and: [ controlKeyPressed ]) ifTrue: [ 
		menuMorph switchToUntyped.
		^ true ].	"	"All keys but the alphanumeric chars (without command and control ) 
	and the backspace key do close the menu"
	keyCharacter = Character backspace
		ifTrue: [ 
			editor isCaretBehindChar
				ifFalse: [ self closeMenu ].
			^ false ].
	(controlKeyPressed not & aKeyboardEvent commandKeyPressed not
		and: [ aKeyboardEvent keyCharacter isCompletionCharacter ])
		ifFalse: [ 
			self closeMenu.
			^ keyCharacter = Character escape ].
	^ false! !

!NECController methodsFor: 'private' stamp: 'CamilloBruni 8/6/2012 00:26'!
stopCompletionDelay
	
	completionDelay ifNotNil: [ completionDelay terminate ].! !

!NECController methodsFor: 'private' stamp: 'EstebanLorenzano 4/11/2012 16:49'!
menuMorphClass
	^ NECMenuMorph! !

!NECController methodsFor: 'testing' stamp: 'CamilloBruni 8/26/2012 23:11'!
captureNavigationKeys
	^ NECPreferences captureNavigationKeys! !

!NECController methodsFor: 'settings' stamp: ''!
smartCharactersMapping
	^ NECPreferences smartCharactersMapping ! !

!NECController methodsFor: 'accessing' stamp: ''!
additionals
	^ nil! !

!NECController methodsFor: 'private' stamp: 'EstebanLorenzano 2/25/2013 15:33'!
smartStartIndexIn: currentText for: smartCharacter  opposite: opposite  at: position
	
	(position - 1) to: 1 by: -1 do: [ :index | | char | 
		char := currentText at: index.
		(char = smartCharacter or: [ char = opposite])
			 ifFalse: [ ^index ] ].
	
	^0! !

!NECController methodsFor: 'menu morph' stamp: 'EstebanLorenzano 2/1/2013 18:42'!
menuClosed
	NECSymbols resetCachedSymbols.
	menuMorph := nil.
	context := nil.! !

!NECController methodsFor: 'accessing' stamp: ''!
context
	^context! !

!NECController methodsFor: 'keyboard' stamp: 'Sd 11/27/2012 20:57'!
smartInputWithEvent: anEvent
	"aCharacter is extracted from anEvent, anEvent is passed because we may need it.
	We may remove aCharacter if this is not costly."
	
	anEvent keyCharacter = Character backspace
		ifTrue: [ self smartBackspace ifTrue: [ ^ true ]].
		
	self smartCharacters 
		ifFalse: [ ^ nil ].
	
	^ self smartCharacterWithEvent: anEvent! !

!NECController class methodsFor: 'class initialization' stamp: 'EstebanLorenzano 4/12/2012 13:43'!
initialize 
	self register! !

!NECController class methodsFor: 'testing' stamp: 'EstebanLorenzano 4/12/2012 13:24'!
allowModel: aModel 
	^NECPreferences enabled and: [ aModel isCodeCompletionAllowed ]! !

!NECController class methodsFor: 'accessing' stamp: 'EstebanLorenzano 4/23/2012 13:48'!
codeCompletionAround: aBlock textMorph: aTextMorph keyStroke: evt
	"Inserts code completion if allowed in this morph"
	
	| editor stringHolder completionAllowed controller |
	
	editor := aTextMorph editor.
	stringHolder := editor ifNotNil:[ editor model ].
	completionAllowed := self allowModel: stringHolder.
	completionAllowed 
		ifTrue: [ 
			controller := self uniqueInstance.
			controller setModel: stringHolder.
			(controller handleKeystrokeBefore: evt editor: editor)
				ifTrue:  [^ self ] ].

	aBlock value.
	
	completionAllowed
		ifTrue: [ controller handleKeystrokeAfter: evt editor: editor ]! !

!NECController class methodsFor: 'tools registry' stamp: 'EstebanLorenzano 4/12/2012 13:44'!
register
	self registerToolsOn: Smalltalk tools.! !

!NECController class methodsFor: 'instance creation' stamp: 'EstebanLorenzano 4/11/2012 15:08'!
reset
	uniqueInstance := nil
	! !

!NECController class methodsFor: 'tools registry' stamp: 'EstebanLorenzano 4/11/2012 10:47'!
registerToolsOn: registry
	"self registerToolsOn: Smalltalk tools" 
	registry register: self as: #codeCompletion
! !

!NECController class methodsFor: 'instance creation' stamp: 'EstebanLorenzano 4/11/2012 11:26'!
uniqueInstance
	^uniqueInstance ifNil: [ uniqueInstance := self basicNew initialize ]! !

!NECController class methodsFor: 'cleanup' stamp: 'MarcusDenker 4/24/2013 13:43'!
cleanUp
	self reset! !

!NECControllerTest commentStamp: '<historical>'!
A NECControllerTest is a test class for testing the behavior of NECController!
!NECControllerTest methodsFor: 'tests-keyboard' stamp: 'EstebanLorenzano 2/25/2013 15:49'!
testSmartNeedExtraRemoveInForOppositeAt

	self assert: (controller smartNeedExtraRemoveIn: '()' for: $( opposite:$) at:1).
	self deny: (controller smartNeedExtraRemoveIn: '(()' for: $( opposite:$) at:2).
	self assert: (controller smartNeedExtraRemoveIn: '(1()' for: $( opposite:$) at:3).
	self assert: (controller smartNeedExtraRemoveIn: '(1(1())' for: $( opposite:$) at:5).
	self assert: (controller smartNeedExtraRemoveIn: '((1)1())))' for: $( opposite:$) at:6).
	self deny: (controller smartNeedExtraRemoveIn: '()(()' for: $( opposite:$) at:3).
	self assert: (controller smartNeedExtraRemoveIn: '(foobar()' for: $( opposite:$) at:8).! !

!NECControllerTest methodsFor: 'initialize' stamp: 'EstebanLorenzano 2/25/2013 14:30'!
tearDown
	"Tearing down code for NECControllerTest"


	controller := nil.! !

!NECControllerTest methodsFor: 'initialize' stamp: 'EstebanLorenzano 2/25/2013 14:30'!
setUp
	"Setting up code for NECControllerTest"


	controller := NECController new.! !

!NECDetailMorph commentStamp: '<historical>'!
I display some detail information for a selected ECEntry in the ECMenuMorph.
The content I show, is provided by an ECDetailContentProvider subclass. 
!
!NECDetailMorph methodsFor: 'accessing' stamp: ''!
descriptionBounds
	^ self contentBounds top: self contentBounds top + 30! !

!NECDetailMorph methodsFor: 'drawing' stamp: ''!
defaultColor
	^ NECMenuMorph backgroundColor. ! !

!NECDetailMorph methodsFor: 'drawing' stamp: ''!
bounds
	^ super bounds topLeft extent: self class width @ self class height! !

!NECDetailMorph methodsFor: 'drawing' stamp: 'CamilloBruni 8/4/2012 01:49'!
drawOn: aCanvas 
	super drawOn: aCanvas.
	arrowPosition ifNotNil: [
		self drawArrowOn: aCanvas.
		self drawMessageOn: aCanvas]! !

!NECDetailMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/17/2015 16:05'!
drawOnAthensCanvas: anAthensCanvas 
	self drawOnCanvasWrapperFor: anAthensCanvas! !

!NECDetailMorph methodsFor: 'accessing' stamp: ''!
titleBounds
	^ self contentBounds top: self contentBounds top + 10! !

!NECDetailMorph methodsFor: 'drawing' stamp: ''!
messageFont
	^ NECMenuMorph messageFont! !

!NECDetailMorph methodsFor: 'drawing' stamp: ''!
drawArrowOn: aCanvas
	| point factor poligon |
	factor := self itemHeight.
	point := arrowPosition.
	poligon := OrderedCollection new.
	poligon add: point.
	poligon add: (point := point translateBy: (factor / 2) @ 0).
	poligon add: (point := point translateBy: 0 @ (factor * -0.5)).
	poligon add: (point := point translateBy: factor @ factor).
	poligon add: (point := point translateBy: (factor * -1) @ factor).
	poligon add: (point := point translateBy: 0 @ (factor * -0.5)).
	poligon add: (point := point translateBy: (factor * -0.5) @ 0).
	aCanvas drawPolygon: poligon fillStyle: self scrollColor! !

!NECDetailMorph methodsFor: 'drawing' stamp: ''!
contentBounds
	| factor rectangle |
	factor := self itemHeight.
	rectangle := self bounds top: self bounds top + 3.
	rectangle := rectangle left: rectangle left + (factor * 2.0).
	rectangle := rectangle bottom: rectangle bottom - factor.
	^ rectangle! !

!NECDetailMorph methodsFor: 'initialization' stamp: 'CamilloBruni 8/7/2012 11:41'!
initialize
	| childBounds |
	super initialize.
	
	self borderStyle: (BorderStyle color: Color gray width: 1).
	childBounds := self contentBounds.
	label := StringMorph 
		contents: ''
		font: self messageFont.
	label bounds: childBounds.
	self addMorph: label.
	title := StringMorph 
		contents: ''
		font: NECMenuMorph titleFont.
	title bounds: self titleBounds.
	self addMorph: title.
	description := TextMorph new.
	description autoFit: false.
	description bounds: self descriptionBounds.
	description borderWidth: 0.
	self addMorph: description! !

!NECDetailMorph methodsFor: 'drawing' stamp: ''!
itemHeight
	^ NECMenuMorph itemHeight! !

!NECDetailMorph methodsFor: 'drawing' stamp: 'CamilloBruni 8/7/2012 11:40'!
drawMessageOn: aCanvas
	| factor rectangle width browseMessage |
	factor := self itemHeight.
	rectangle := self bounds top: self bounds bottom - factor.
	rectangle := rectangle left: self contentBounds left.
	aCanvas 
		line: rectangle topLeft 
		to: rectangle topRight
		color: Color darkGray.
	rectangle := rectangle top: rectangle top + 1.
	aCanvas
		drawString: '<- close detail'
		in: rectangle
		font: self messageFont
		color: Color darkGray.
	browseMessage := 'browse ->'.
	width := self messageFont widthOfString: browseMessage.
	aCanvas
		drawString: browseMessage
		in: (rectangle left: rectangle right - width)
		font: self messageFont
		color: Color darkGray! !

!NECDetailMorph methodsFor: 'drawing' stamp: ''!
scrollColor
	^ NECMenuMorph scrollColor! !

!NECDetailMorph methodsFor: 'private' stamp: ''!
positionOnLeft: anInteger 
	^ arrowPosition x - self class width - anInteger ! !

!NECDetailMorph methodsFor: 'drawing' stamp: 'CamilloBruni 8/7/2012 11:41'!
position: aPoint menuWidth: anInteger 
	| y x |
	arrowPosition := aPoint.
	y := aPoint y + self class height.
	y := y > Display height
				ifTrue: [Display height - self class height]
				ifFalse: [aPoint y - self itemHeight].
	x := aPoint x.
	x := x + self class width > Display width
				ifTrue: [
					arrowPosition := (self positionOnLeft: anInteger) @ aPoint y.
					arrowPosition x]
				ifFalse: [x].
	self position: x @ y! !

!NECDetailMorph methodsFor: 'accessing' stamp: 'CamilloBruni 8/6/2012 00:34'!
entryDescription: anECEntryDescription 
	| categoryContents entryDescription |
	entryDescription := anECEntryDescription.
	title
		contents: (entryDescription title
				ifNil: [
					description bounds: self titleBounds.
					String new]
				ifNotNil: [
					description bounds: self descriptionBounds.
					entryDescription title]).
	description contentsWrapped: entryDescription description.
	categoryContents := entryDescription label.
	label contents: categoryContents! !

!NECDetailMorph class methodsFor: 'private' stamp: ''!
width
	^ NECMenuMorph itemWidth * 2.0! !

!NECDetailMorph class methodsFor: 'private' stamp: ''!
height
	^ NECMenuMorph itemHeight * 15.5! !

!NECEntry commentStamp: 'bar 10/5/2005 23:31'!
I represent a completion entry that is management by a ECModel and shown in the ECMenuMorph as a menu entry.!
!NECEntry methodsFor: 'accessing' stamp: ''!
contentsAsSymbol
	^ contents asSymbol ! !

!NECEntry methodsFor: 'detail information' stamp: ''!
createDescriptionWith: anECContext 
	| clazz |
	clazz := self guessTypeWith: anECContext.
	^ clazz 
		ifNil: [ NECEntryDescription label: self label ]
		ifNotNil: 
			[ NECEntryDescription 
				label: self label
				title: clazz printString
				description: clazz comment ]! !

!NECEntry methodsFor: 'testing' stamp: ''!
isLocal
	^ false! !

!NECEntry methodsFor: 'accessing' stamp: 'IgorStasenko 9/16/2013 17:18'!
setContents: aString 
	contents := aString.! !

!NECEntry methodsFor: 'testing' stamp: ''!
isInstance
	^ false! !

!NECEntry methodsFor: 'accessing' stamp: ''!
setContents: aString type: aSymbol 
	contents := aString.
	type := aSymbol! !

!NECEntry methodsFor: 'accessing' stamp: ''!
completion
	^ self contents asSymbol! !

!NECEntry methodsFor: 'accessing' stamp: ''!
label
	^ 'unknown'! !

!NECEntry methodsFor: 'printing' stamp: 'IgorStasenko 9/16/2013 17:21'!
printOn: aStream 
	aStream nextPutAll: self class name;
		 nextPut: $(;
		 nextPutAll: contents asString;
		 nextPut: $,;
		 nextPutAll: self type;
		 nextPut: $)! !

!NECEntry methodsFor: 'operations' stamp: ''!
descriptionWith: anECContext 
	description ifNotNil: [ ^ description ].
	^ description := self createDescriptionWith: anECContext! !

!NECEntry methodsFor: 'operations' stamp: ''!
guessTypeWith: anECContext 
	^ nil! !

!NECEntry methodsFor: 'accessing' stamp: ''!
type
	^type! !

!NECEntry methodsFor: 'conversion' stamp: 'CamilloBruni 8/4/2012 02:07'!
asNECEntry
	^ self! !

!NECEntry methodsFor: 'operations' stamp: 'MarcusDenker 7/30/2014 17:15'!
browseWith: anECContext 
	| guessType |
	guessType := self guessTypeWith: anECContext.
	guessType ifNil: [^ false].
	Smalltalk tools browser fullOnClass: guessType.
	^ true! !

!NECEntry methodsFor: 'accessing' stamp: ''!
contents
	^contents! !

!NECEntry methodsFor: 'operations' stamp: ''!
<= aECEntry 
	^ contents <= aECEntry contents! !

!NECEntry methodsFor: 'testing' stamp: ''!
isSelector
	^ false! !

!NECEntry class methodsFor: 'instance creation' stamp: 'IgorStasenko 9/16/2013 17:18'!
contents: aString 
	^ self new setContents: aString! !

!NECEntry class methodsFor: 'instance creation' stamp: ''!
contents: aString type: aSymbol
	^ self new setContents: aString type: aSymbol! !

!NECEntryDescription commentStamp: '<historical>'!
A NECEntryDescription is a holder for some information to be displayed.!
!NECEntryDescription methodsFor: 'initialize-release' stamp: ''!
setLabel: firstString title: secondString description: thirdString 
	label := firstString.
	title := secondString.
	description := thirdString! !

!NECEntryDescription methodsFor: 'accessing' stamp: ''!
description
(	description isNil or:[description isEmpty]) ifTrue:[^'-'].
	^ description! !

!NECEntryDescription methodsFor: 'accessing' stamp: ''!
label
	^ label! !

!NECEntryDescription methodsFor: 'accessing' stamp: ''!
title
^ title! !

!NECEntryDescription class methodsFor: 'instance creation' stamp: ''!
label: firstString 
	^ self new
		setLabel: firstString
		title: '(unknown)'
		description: nil! !

!NECEntryDescription class methodsFor: 'instance creation' stamp: ''!
label: firstString title: secondString description: thirdString 
	^ self new 
		setLabel: firstString
		title: secondString
		description: thirdString! !

!NECEntryTest methodsFor: 'tests' stamp: ''!
testLocal
	| entry |
	entry := NECLocalEntry 
		contents: 'abc'
		type: #patternArg:.
	self assert: entry contents = 'abc'.
	self assert: entry type = #patternArg:.
	self assert: entry isLocal! !

!NECEntryTest methodsFor: 'tests' stamp: ''!
testPrintOn
	| entry |
	entry := NECSelectorEntry 
		contents: 'compute'
		type: #unary:.
	self assert: 'NECSelectorEntry(compute,unary:)' = entry printString! !

!NECEntryTest methodsFor: 'tests' stamp: 'IgorStasenko 9/16/2013 17:30'!
testInstance
	| entry |
	entry := NECInstVarEntry contents: 'abc'.
	self assert: entry isInstance! !

!NECEntryTest methodsFor: 'tests' stamp: ''!
testCompletion
	| entry |
	entry := NECSelectorEntry 
		contents: 'makeItHappen'
		type: #unary:.
	self assert: entry completion = #makeItHappen! !

!NECGlobalEntry commentStamp: '<historical>'!
I represent a global variable.!
!NECGlobalEntry methodsFor: 'accessing' stamp: ''!
label
	^ 'global'! !

!NECGlobalEntry methodsFor: 'accessing' stamp: 'IgorStasenko 9/16/2013 16:13'!
type
	^ #globalVar! !

!NECGlobalEntry methodsFor: 'operations' stamp: ''!
guessTypeWith: anECContext 
	| globalEntry |
	globalEntry := Smalltalk at: contents ifAbsent: [^ nil].
	globalEntry isBehavior ifTrue: [^ globalEntry].
	globalEntry ifNotNil: [^ globalEntry class].
	^ nil! !

!NECInstVarEntry commentStamp: '<historical>'!
I represent an instance variable.!
!NECInstVarEntry methodsFor: 'accessing' stamp: 'IgorStasenko 9/16/2013 17:29'!
type
	^ #instVar! !

!NECInstVarEntry methodsFor: 'testing' stamp: 'IgorStasenko 9/16/2013 16:15'!
isInstance
	^true! !

!NECInstVarEntry methodsFor: 'accessing' stamp: ''!
label
	^ 'instance variable'! !

!NECInstVarEntry methodsFor: 'operations' stamp: ''!
guessTypeWith: anECContext 
	^ anECContext guessInstVarClass: contents! !

!NECInstVarTypeGuesser commentStamp: '<historical>'!
I'm a simple InstructionClient that tries to guess the type of a given instance variable name of a class. !
!NECInstVarTypeGuesser methodsFor: 'public' stamp: ''!
methodRefs
	| theClass selectors |
	theClass := receiverClass classThatDefinesInstanceVariable: variableName.
	theClass ifNil: [ ^ nil ].
	selectors := theClass whichSelectorsStoreInto: variableName.
	^ selectors collect: [ :each | 
		RGMethodDefinition realClass: theClass selector: each]! !

!NECInstVarTypeGuesser methodsFor: 'bytecode decoding' stamp: ''!
prepare: aCompiledMethod 
	| theClass |
	super prepare: aCompiledMethod.
	theClass := aCompiledMethod realClass.
	varIndex := (theClass allInstVarNames indexOf: variableName) - 1! !

!NECInstVarTypeGuesser methodsFor: 'bytecode decoding' stamp: ''!
popIntoReceiverVariable: offset 
	varIndex = offset 
		ifTrue: [ found := true ]
		ifFalse: [ self reset ]! !

!NECInstVarTypeGuesserTest methodsFor: 'testing' stamp: ''!
testConstantBoolean
	self 
		guessVariable: 'constantBoolean'
		in: NECTestClass
		expected: True! !

!NECInstVarTypeGuesserTest methodsFor: 'testing' stamp: ''!
testMessageSend
	self 
		guessVariable: 'messageSend'
		in: NECTestClass
		expected: Dictionary! !

!NECInstVarTypeGuesserTest methodsFor: 'testing' stamp: ''!
testConstantSymbol
	self
		guessVariable: 'constantSymbol'
		in: NECTestClass
		expected: ByteSymbol! !

!NECInstVarTypeGuesserTest methodsFor: 'private' stamp: ''!
guessVariable: aString in: aClass expected: theClassExpected 
	| typeGuesser result |
	typeGuesser := NECInstVarTypeGuesser 
		variableName: aString
		class: aClass.
	result := typeGuesser perform.
	self assert: result == theClassExpected! !

!NECInstVarTypeGuesserTest methodsFor: 'testing' stamp: ''!
testConstantArray
	self 
		guessVariable: 'constantArray'
		in: NECTestClass
		expected: Array! !

!NECInstVarTypeGuesserTest methodsFor: 'testing' stamp: ''!
testConstantIntegerNil
	self
		guessVariable: 'constantNil'
		in: NECTestClass
		expected: nil! !

!NECInstVarTypeGuesserTest methodsFor: 'testing' stamp: ''!
testMessageSend2
	self 
		guessVariable: 'messageSend2'
		in: NECTestClass
		expected: nil! !

!NECInstVarTypeGuesserTest methodsFor: 'testing' stamp: ''!
testSuperWithAnotherInit
	self 
		guessVariable: 'superInstVar'
		in: NECTestClass
		expected: Dictionary! !

!NECInstVarTypeGuesserTest methodsFor: 'testing' stamp: ''!
testComplexInit2
	self 
		guessVariable: 'complexInit2'
		in: NECTestClass
		expected: Dictionary! !

!NECInstVarTypeGuesserTest methodsFor: 'testing' stamp: ''!
testConstantInteger
	self 
		guessVariable: 'constantInteger'
		in: NECTestClass
		expected: SmallInteger! !

!NECInstVarTypeGuesserTest methodsFor: 'testing' stamp: ''!
testGlobalVarKeyword
	self
		guessVariable: 'globalVarKeyword'
		in: NECTestClass
		expected: SortedCollection! !

!NECInstVarTypeGuesserTest methodsFor: 'testing' stamp: ''!
testGlobalVarKeyword2
	self
		guessVariable: 'globalVarKeyword2'
		in: NECTestClass
		expected: SortedCollection! !

!NECInstVarTypeGuesserTest methodsFor: 'testing' stamp: ''!
testTypeSuggestingParameter
	self 
		guessVariable: 'typeSuggestingParameter2'
		in: NECTestClass
		expected: Rectangle! !

!NECInstVarTypeGuesserTest methodsFor: 'testing' stamp: ''!
testConstantString
	self
		guessVariable: 'constantString'
		in: NECTestClass
		expected: ByteString! !

!NECInstVarTypeGuesserTest methodsFor: 'testing' stamp: ''!
testComplexInit
	self
		guessVariable: 'complexInit'
		in: NECTestClass
		expected: nil! !

!NECLocalEntry commentStamp: '<historical>'!
I represent a local variable!
!NECLocalEntry methodsFor: 'accessing' stamp: ''!
label
	^ 'local variable'! !

!NECLocalEntry methodsFor: 'testing' stamp: ''!
isLocal
	^true! !

!NECLocalEntry methodsFor: 'operations' stamp: 'IgorStasenko 9/16/2013 17:26'!
guessTypeWith: anECContext 
	^ (anECContext guessTempVarClass: contents type: self type) 
		ifNil: [anECContext guessArgument: contents]! !

!NECMenuMorph commentStamp: '<historical>'!
I show the possible completions in a menu like appearance. The user may choose an entry from my list and complete the word he was typing in the editor. I'm showed with the Tab key and will be deleted when with ESC key or when a successful completion occurs. The following keystrokes are supported:

Ctrl-Space or Tab: Open a new morph. Tab requires at least one character in front of the cursor. When already open complete the selected entry. 
Esc: Close me
Ctrl+u: Change to untyped mode, so I show all selectors of all classes in the system and the variables that are accessible to the current context.
Arrow Up: Move one entry up.
Arrow Down: Move one entry down
Enter: (like Ctrl-Space and Tab): Complete with the selected item and close the morph
any letter or digit: Narrow the completion further
Ctrl+t: Toggle the expand flag. When expand is disabled, you don't see selectors belonging to Object and ProtoObject. 

!
!NECMenuMorph methodsFor: 'drawing' stamp: 'AlainPlantec 1/28/2015 21:53'!
drawLine: index on: aCanvas rectangle: rectangle
	| symbol font type string preString model highlightRectangle |
	model := context model.
	symbol := model entries at: index.
	string := symbol contents.
	preString := string asLowercase findString: context completionToken asLowercase.
	preString := preString <= 0
		ifFalse: [ string first: preString - 1 ]
		ifTrue: [ String empty ].
	type := symbol type.
	font := self selectFont: type.
	index = self selected
		ifTrue: [ 
			| rect |
			rect := rectangle withBottom: rectangle top + self class itemHeight.
			aCanvas fillRectangle: rect color: self class scrollColor.
			self detailPosition: rect topRight ].
	highlightRectangle := rectangle translateBy: (font widthOfString: preString) @ 0.
	highlightRectangle := highlightRectangle withWidth: (font widthOfString: context completionToken).
	aCanvas 
		clipBy: rectangle 
		during: [ :c | c fillRectangle: highlightRectangle color: (Color gray alpha: 0.3) ].
	aCanvas
		drawString: string
		in: (rectangle insetBy: 1)
		font: font
		color: (self selectColor: type)! !

!NECMenuMorph methodsFor: 'drawing' stamp: ''!
prepareRectForNextRow: aRectangle 
	^aRectangle translateBy: 0 @ self class itemHeight! !

!NECMenuMorph methodsFor: 'actions' stamp: ''!
showDetail
	detailMorph ifNotNil: [ ^ self browse ].
	self itemsCount isZero ifTrue: [ ^ self ].
	detailMorph := NECDetailMorph new.
	self addMorph: detailMorph.
	self updateDetail! !

!NECMenuMorph methodsFor: 'event handling' stamp: 'CamilloBruni 8/30/2012 16:55'!
handlesMouseDown: anEvent
	^ true! !

!NECMenuMorph methodsFor: 'accessing' stamp: ''!
height
	| count |
	count := self class maxLength.
	self visible ifTrue: [ 
		| height |
		height := World height - self bounds topLeft y.
		World submorphs do: [ :each |
			each class = TaskbarMorph 
				ifTrue: [ height := height - each height ] ].
		count := height // self class itemHeight - 1 min: count ].
	^ count asInteger isZero 
		ifTrue: [ 1 ]
		ifFalse: [ count ]! !

!NECMenuMorph methodsFor: 'actions' stamp: 'IgorStasenko 9/16/2013 17:26'!
browse

	(self selectedEntry browseWith: context)
		ifTrue: [ controller closeMenu ]! !

!NECMenuMorph methodsFor: 'private' stamp: ''!
visibleItemsCount.

	^ self lastVisible - self firstVisible + 1! !

!NECMenuMorph methodsFor: 'actions' stamp: ''!
moveUp
	(self selected = 0
			and: [self firstVisible = 1])
		ifTrue: [^ self].
	self selected: self selected - 1.
	self selected < self firstVisible
		ifTrue: [firstVisible := firstVisible - 1].
	self changed. ! !

!NECMenuMorph methodsFor: 'initialization' stamp: 'CamilloBruni 8/26/2012 15:47'!
initialize
	super initialize.
	self color: self class backgroundColor.
	self borderStyle: (BorderStyle color: Color gray width: 1).
	self
		when: #positionChanged
		send: #updateDetail
		to: self! !

!NECMenuMorph methodsFor: 'actions' stamp: 'SeanDeNigris 2/5/2013 13:03'!
insertCommonPrefix
	"Return value: true if the user input has been handled, regardless of whether a prefix was inserted"

	| prefix |
	context model isEmpty ifTrue: [^ false].
	context model entries size = 1
		ifTrue: [ ^ self insertSelected ].
	prefix := context model commonPrefix.
	self flag: 'Pending issue 7308, "controller editor wordAtCaret" below should be changed to "context completionToken"'.
	prefix size > controller editor wordAtCaret size
		ifTrue: [ 
			self insertCompletion: prefix.
			context narrowWith: controller editor wordAtCaret ].
	^ true! !

!NECMenuMorph methodsFor: 'actions' stamp: ''!
home
	self gotoPage: 1.
	self changed! !

!NECMenuMorph methodsFor: 'paging' stamp: ''!
gotoPage: anInteger
	| item |
	item := (anInteger - 1) * self pageHeight + 1.
	item >= self itemsCount
		ifTrue: [ ^ self ].
	item := item max: 1.
	firstVisible := item.
	self selected: firstVisible! !

!NECMenuMorph methodsFor: 'actions' stamp: ''!
pageDown
	self gotoPage: self currentPage + 1.
	self changed. ! !

!NECMenuMorph methodsFor: 'initialization' stamp: 'CamilloBruni 8/30/2012 14:55'!
createTitle
	| titleString transformationMorph |
	titleString := context model title ifNil: [ ^ self ].
	
	titleStringMorph := StringMorph new.
	titleStringMorph 
		contents: titleString;
		font: self class messageFont.
		
	transformationMorph := TransformationMorph new.
	transformationMorph rotationDegrees: -90.0;
		offset: self position negated - (0 @ (titleStringMorph width + 12));
		addMorph: titleStringMorph.

	self addMorph: transformationMorph.
	self resize.! !

!NECMenuMorph methodsFor: 'drawing' stamp: 'CamilloBruni 8/30/2012 14:52'!
resize
	| extent height |
	firstVisible := 1.
	height := self visibleItemsCount * self class itemHeight.
	pageHeight := self height asInteger.
	self hasMessage ifTrue: [ height := height + self class itemHeight ].
	titleStringMorph ifNotNil: [
		"titleStringMorph width: (titleStringMorph width min: 100)."
		height := height max: titleStringMorph width + 30 ].
	extent := self class itemWidth @ height.
	self extent: extent.! !

!NECMenuMorph methodsFor: 'actions' stamp: 'CamilloBruni 8/26/2012 23:37'!
insertSelected
	context model isEmpty ifTrue: [^ false].
	self insertCompletion: (context model completionAt: self selected).
	self delete.
	^ true! !

!NECMenuMorph methodsFor: 'drawing' stamp: ''!
hasMessage
	^ true ! !

!NECMenuMorph methodsFor: 'accessing' stamp: ''!
selected: aNumber 
	"Set the value of selected"
	context model notEmpty ifTrue: 
		[ ((1 to: self itemsCount) includes: aNumber) ifTrue: [ aNumber ~= selected ifTrue: [ selected := aNumber ] ] ]! !

!NECMenuMorph methodsFor: 'drawing' stamp: 'CamilloBruni 8/7/2012 11:32'!
drawOn: aCanvas 
	| rectangle model |
	"draw background"
	super drawOn: aCanvas.
	
	rectangle := self bounds insetBy: 1.
	rectangle := rectangle bottom: rectangle top + self class itemHeight.
	rectangle := rectangle left: rectangle left + 20.
	model := context model.
	
	self extent: self extent.
	self firstVisible > 1 
		ifTrue: [ self drawTopScrollArrowOn: aCanvas ].
	self lastVisible ~= self itemsCount 
		ifTrue: [ self drawBottomScrollArrowOn: aCanvas ].
		
	model notEmpty ifTrue: [ 
		self firstVisible to: self lastVisible do: [ :index | 
			self drawLine: index on: aCanvas rectangle: rectangle.
			rectangle := self prepareRectForNextRow: rectangle ]].
		
	self 
		drawMessageOn: aCanvas
		in: rectangle! !

!NECMenuMorph methodsFor: 'drawing' stamp: ''!
selectColor: type
	^ self class selectColorFor: type! !

!NECMenuMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/17/2015 16:06'!
drawOnAthensCanvas: anAthensCanvas 
	self drawOnCanvasWrapperFor: anAthensCanvas! !

!NECMenuMorph methodsFor: 'accessing' stamp: ''!
detailPosition: aPoint 
	detailPosition := aPoint.
	self triggerEvent: #positionChanged! !

!NECMenuMorph methodsFor: 'testing' stamp: 'CamilloBruni 8/26/2012 15:29'!
takesKeyboardFocus
	^ true! !

!NECMenuMorph methodsFor: 'actions' stamp: ''!
end
	self gotoPage: self pageCount.
	self changed.! !

!NECMenuMorph methodsFor: 'actions' stamp: 'CamilloBruni 8/26/2012 18:25'!
narrowCompletion
	| model |
	self selected: 0.
	firstVisible := 1.
	model := context model.
	model narrowWith: context completionToken.
	(model entries size = 1 and: [ model entries first contents = context completionToken ]) ifTrue: [
		self delete.
		^ false ].
	model notEmpty ifTrue: [ self selected: 1 ].
	self show.
	^ true! !

!NECMenuMorph methodsFor: 'actions' stamp: ''!
pageUp
	self gotoPage: self currentPage - 1.
	self changed. ! !

!NECMenuMorph methodsFor: 'drawing' stamp: ''!
selectFont: aSymbol 
	^ self class selectFontFor: aSymbol! !

!NECMenuMorph methodsFor: 'private' stamp: ''!
itemsCount
	^context model entryCount! !

!NECMenuMorph methodsFor: 'private' stamp: ''!
delete
	super delete.
	controller menuClosed! !

!NECMenuMorph methodsFor: 'paging' stamp: ''!
pageHeight
	^pageHeight.! !

!NECMenuMorph methodsFor: 'actions' stamp: 'BenjaminVanRyseghem 2/9/2013 17:54'!
insertCompletion: aString

	| caret old pos editor offset|
	editor := controller editor.
	caret := editor caret.
	editor selectInvisiblyFrom: caret - context completionToken size to: caret - 1.
	old := editor selection. 
	editor zapSelectionWith: aString.
	offset := NECPreferences spaceAfterCompletion
				ifTrue: [ 1 ]
				ifFalse: [ 0 ].
	pos := caret + (aString copyUpTo: $ ) size + offset - old size.
	editor selectAt: pos.
	editor morph invalidRect: editor morph bounds! !

!NECMenuMorph methodsFor: 'actions' stamp: 'EstebanLorenzano 2/1/2013 17:16'!
help
	self class helpText asMorph openInWindowLabeled: self class helpTitle! !

!NECMenuMorph methodsFor: 'private' stamp: ''!
isClosed
	^ owner isNil! !

!NECMenuMorph methodsFor: 'actions' stamp: 'JohanBrichau 4/5/2013 22:30'!
insertCommonPrefixOrSelected
	"Return value: true if the user input has been handled, regardless of whether a prefix was inserted"

	| prefix |
	context model isEmpty ifTrue: [^ false].
	context model entries size = 1
		ifTrue: [ ^ self insertSelected ].
	prefix := context model commonPrefix.
	prefix = context model narrowString ifTrue:[^ self insertSelected].
	self flag: 'Pending issue 7308, "controller editor wordAtCaret" below should be changed to "context completionToken"'.
	prefix size > controller editor wordAtCaret size
		ifTrue: [ 
			self insertCompletion: prefix.
			context narrowWith: controller editor wordAtCaret ].
	^ true! !

!NECMenuMorph methodsFor: 'drawing' stamp: 'CamilloBruni 8/3/2012 20:33'!
drawTopScrollArrowOn: aCanvas 
	| aPolygon point arrowHeight |
	arrowHeight := self class scrollArrowSize.
	point := self bounds topLeft translateBy: 6 @ 11.
	aPolygon := Array 
				with: point
				with: (point translateBy: arrowHeight @ 0)
				with: (point translateBy: arrowHeight / 2 @ arrowHeight negated).
	aCanvas 
		drawPolygon: aPolygon 
		fillStyle: Color black. 
	! !

!NECMenuMorph methodsFor: 'actions' stamp: 'CamilloBruni 8/26/2012 15:33'!
close
	self delete.! !

!NECMenuMorph methodsFor: 'paging' stamp: ''!
currentPage
	^(self selected - 1 // self pageHeight ) + 1.! !

!NECMenuMorph methodsFor: 'private' stamp: ''!
firstVisible
	^firstVisible min: context model entryCount! !

!NECMenuMorph methodsFor: 'drawing' stamp: 'CamilloBruni 8/7/2012 11:35'!
drawMessageOn: aCanvas in: rectangle 
	self hasMessage ifFalse: [ ^ self ].
	context model isEmpty ifFalse: [ 
		aCanvas 
			line: rectangle topLeft
			to: rectangle topRight
			color: Color gray ].
	self 
		drawModelMessageOn: aCanvas
		in: rectangle.! !

!NECMenuMorph methodsFor: 'actions' stamp: 'CamilloBruni 8/6/2012 00:29'!
hideDetail
	detailMorph ifNil: [ ^ false ].
	self removeMorph: detailMorph.
	detailMorph delete.
	detailMorph := nil.
	self changed.
	^ true! !

!NECMenuMorph methodsFor: 'actions' stamp: 'CamilloBruni 8/30/2012 14:46'!
show
	self resize.
	self activeHand 
		newMouseFocus: self.
	self changed.! !

!NECMenuMorph methodsFor: 'actions' stamp: ''!
moveDown
	self selected: self selected + 1.
	(self selected > self lastVisible
			and: [self selected <= self itemsCount])
		ifTrue: [firstVisible := firstVisible + 1].
	self changed! !

!NECMenuMorph methodsFor: 'drawing' stamp: 'EstebanLorenzano 2/1/2013 17:20'!
drawModelMessageOn: aCanvas in: rectangle 
	| message |
	
	self flag: #todo. "Removing for now... most of the shortcuts are broken and no time or need now to fix them" 

	message := context model hasMessage 
		ifTrue: [ context model message ", ' | ctrl-h=help'" ]
		ifFalse: [ self detailMessage ].
	aCanvas 
		drawString: message
		in: rectangle
		font: self class messageFont
		color: Color gray! !

!NECMenuMorph methodsFor: 'paging' stamp: ''!
pageCount
	| count |
	self itemsCount == self pageHeight
		ifTrue: [^ 1].
	count := self itemsCount // self pageHeight.
	(self itemsCount \\ self pageHeight) > 0 
		ifTrue:[count := count + 1].
	^count! !

!NECMenuMorph methodsFor: 'title' stamp: ''!
removeTitle
	titleStringMorph
		ifNil: [^ self].
	self removeMorph: titleStringMorph owner. 
	titleStringMorph := nil! !

!NECMenuMorph methodsFor: 'initialization' stamp: 'MarcusDenker 10/5/2013 19:29'!
setController: aECController position: aPoint
	controller := aECController.
	context := controller context.
	self position: aPoint - (20 @ 0).
	self narrowCompletion
		ifFalse: [ ^ self ].
	self createTitle.
	self openInWorld! !

!NECMenuMorph methodsFor: 'private' stamp: ''!
lastVisible

	^ (self firstVisible + self height-1)  min: (self itemsCount).! !

!NECMenuMorph methodsFor: 'drawing' stamp: 'EstebanLorenzano 2/1/2013 17:19'!
detailMessage

	^ String streamContents: [:stream |
		self flag: #todo. "Removing for now... most of the shortcuts are broken and no time or need now to fix them" 
		"stream << 'ctrl-h=help'."
		NECPreferences captureNavigationKeys ifTrue: [
			stream << (detailMorph
				ifNil: ['-> open detail']
				ifNotNil: ['<- close detail']	) ] ]! !

!NECMenuMorph methodsFor: 'private' stamp: 'CamilloBruni 8/7/2012 11:37'!
updateDetail
	detailMorph
		ifNil: [^ self].
	detailMorph
		entryDescription: (self selectedEntry descriptionWith: context);
		position: detailPosition menuWidth: self width;
		show! !

!NECMenuMorph methodsFor: 'paging' stamp: ''!
pageCountString
	^ self itemsCount = 501
		ifTrue: [ 'more' ]
		ifFalse: [ self pageCount asString ]! !

!NECMenuMorph methodsFor: 'event handling' stamp: 'CamilloBruni 8/30/2012 14:36'!
selectIndexAtPoint: aPoint
	| yPos  |
	yPos := aPoint y - self bounds top.
	selected := firstVisible + (yPos / self class itemHeight) floor.
	selected := selected min: context model entries size max: 1.! !

!NECMenuMorph methodsFor: 'accessing' stamp: ''!
selected
	"Answer the value of selected"
	selected ifNil: [ selected := self firstVisible ].
	^ selected! !

!NECMenuMorph methodsFor: 'accessing' stamp: ''!
selectedEntry
	^ context model entries at: self selected! !

!NECMenuMorph methodsFor: 'actions' stamp: 'CamilloBruni 8/7/2012 12:17'!
switchToUntyped
	context switchToUntyped.
	self 
		removeTitle; 
		narrowCompletion! !

!NECMenuMorph methodsFor: 'event handling' stamp: 'EstebanLorenzano 2/1/2013 16:53'!
mouseDown: evt
	(self bounds containsPoint: evt cursorPoint)
		ifTrue: [	
			evt wasHandled: true.
			^ self 
				selectIndexAtPoint: evt cursorPoint;
				insertSelected ].
			
	super mouseDown: evt.
	evt wasHandled: false.
	self flag: #fixme "ugly hack".
	controller editor morph owner owner
		takeKeyboardFocus;
		handleMouseDown: evt.
	self close.! !

!NECMenuMorph methodsFor: 'actions' stamp: ''!
expand
	context model toggleExpand.
	self narrowCompletion! !

!NECMenuMorph methodsFor: 'drawing' stamp: 'CamilloBruni 8/3/2012 20:32'!
drawBottomScrollArrowOn: aCanvas 
	| aPoligon point arrowHeight |
	point := self bounds bottomLeft translateBy: 6 @ -12.
	arrowHeight := self class scrollArrowSize.
	aPoligon := Array 
		with: point
		with: (point translateBy: arrowHeight @ 0)
		with: (point translateBy: (arrowHeight / 2) @ arrowHeight).
	aCanvas 
		drawPolygon: aPoligon
		fillStyle: Color black! !

!NECMenuMorph class methodsFor: 'help text' stamp: 'EstebanLorenzano 2/1/2013 17:15'!
shortcut: aString text: secondString on: aTextStream 
	aTextStream
		withAttributes: self shortcutAttributes
		do: [aTextStream nextPutAll: aString;
				 cr].
	aTextStream
		withAttributes: self explanationAttributes
		do: [aTextStream nextPutAll: secondString;
				 cr].
! !

!NECMenuMorph class methodsFor: 'preferences' stamp: ''!
selectColorFor: aSymbol 
	| attribute |
	attribute := self convertToSHSymbol: aSymbol.
	^ (SHTextStylerST80 new attributesFor: attribute) first color! !

!NECMenuMorph class methodsFor: 'preferences-fonts' stamp: 'CamilloBruni 8/6/2012 00:33'!
messageFont
	^ StandardFonts menuFont! !

!NECMenuMorph class methodsFor: 'preferences' stamp: ''!
maxLength
	^ 20! !

!NECMenuMorph class methodsFor: 'instance creation' stamp: ''!
controller: aECController position: aPoint 
	| newObject |
	newObject := self new.
	newObject setController: aECController position: aPoint.
	^ newObject! !

!NECMenuMorph class methodsFor: 'preferences' stamp: ''!
convertToSHSymbol: aSymbol
	^ (SHTextStylerST80 new attributesFor: aSymbol) notNil
		ifTrue: [ aSymbol ]
		ifFalse: [ #default ]! !

!NECMenuMorph class methodsFor: 'preferences' stamp: 'CamilloBruni 8/5/2012 23:13'!
itemWidth
	^ 250! !

!NECMenuMorph class methodsFor: 'preferences-fonts' stamp: 'CamilloBruni 8/6/2012 00:32'!
selectFontFor: aSymbol 
	| emphasized attributes |
	attributes := SHTextStylerST80 new 
		attributesFor: (self convertToSHSymbol: aSymbol).
	emphasized := attributes size > 1 
		ifTrue: [ attributes second emphasisCode ]
		ifFalse: [ 0 ].
	^ StandardFonts codeFont
		emphasized: emphasized! !

!NECMenuMorph class methodsFor: 'preferences' stamp: ''!
scrollArrowSize
	^ 8! !

!NECMenuMorph class methodsFor: 'preferences' stamp: ''!
itemHeight
	^ (self selectFontFor: #default) height + 2! !

!NECMenuMorph class methodsFor: 'preferences-fonts' stamp: ''!
titleFont
	^ StandardFonts windowTitleFont! !

!NECMenuMorph class methodsFor: 'preferences-colors' stamp: 'CamilloBruni 8/3/2012 21:20'!
backgroundColor
	^NECPreferences backgroundColor! !

!NECMenuMorph class methodsFor: 'preferences-colors' stamp: 'EstebanLorenzano 4/29/2014 16:47'!
scrollColor
	^ Smalltalk ui theme selectionColor! !

!NECMenuMorph class methodsFor: 'help text' stamp: 'EstebanLorenzano 2/1/2013 17:15'!
helpText
	| stream |
	stream := TextStream on: Text new.
	self 
		section: 'character completion'
		on: stream.
	self 
		shortcut: 'works on'
		text: ' [] {} () <> '''' ""'
		on: stream.
	self 
		shortcut: 'usage 1'
		text: 'enter open character - closing character is entered as well'
		on: stream.
	self 
		shortcut: 'usage 2'
		text: 'select some text, enter a smart character and the selected text get surrounded by the opening and closing character.'
		on: stream.
	self 
		section: 'open/close menu'
		on: stream.
	self 
		shortcut: 'ctrl-space or tab'
		text: 'open the completion menu'
		on: stream.
	self 
		shortcut: 'ESC'
		text: 'close menu'
		on: stream.
	self 
		shortcut: 'ctrl-h'
		text: 'open this help'
		on: stream.
	self 
		section: 'menu navigation'
		on: stream.
	self 
		shortcut: 'Arrows up/down'
		text: 'move the selection up and down'
		on: stream.
	self 
		shortcut: 'Page up/down'
		text: 'page up and down'
		on: stream.
	self 
		shortcut: 'Home/End'
		text: 'move to first or last page of the menu'
		on: stream.
	self 
		section: 'show details and browse'
		on: stream.
	self 
		shortcut: 'right arrow (detail closed)'
		text: 'show details about the selected item. This may be the type of the variable, the source of a method or the implementors of the selector.'
		on: stream.
	self 
		shortcut: 'right arrow (detail open)'
		text: 'open a new browser for the selected item.'
		on: stream.
	self 
		shortcut: 'left arrow'
		text: 'close the details'
		on: stream.
	self 
		section: 'changing menu contents'
		on: stream.
	self 
		shortcut: 'ctrl-u'
		text: 'switch to untyped mode in a typed menu'
		on: stream.
	self 
		shortcut: 'ctrl-t'
		text: 'filter out methods of class Object in a typed menu. press again to make the reappear.'
		on: stream.
	self 
		shortcut: 'alphanumeric character'
		text: 'filter the menu to the given input'
		on: stream.
	self 
		shortcut: 'backspace'
		text: 'delete an input character, adjust menu to the new input.'
		on: stream.
	self 
		section: 'inserting completion'
		on: stream.
	self 
		shortcut: 'ctrl-space or tab'
		text: 'close the menu and insert selected completion. if there only one item left in the menu this done automaticly.'
		on: stream.
	^ stream contents! !

!NECMenuMorph class methodsFor: 'help text' stamp: 'EstebanLorenzano 2/1/2013 17:15'!
section: aString on: aTextStream 
	aTextStream
		withAttributes: self sectionAttributes
		do: [aTextStream nextPutAll: aString].
	aTextStream cr! !

!NECMenuMorph class methodsFor: 'help text' stamp: 'EstebanLorenzano 2/1/2013 17:15'!
shortcutAttributes
	^ {TextIndent spaceUsed; tabs: 1. TextEmphasis italic }! !

!NECMenuMorph class methodsFor: 'help text' stamp: 'EstebanLorenzano 2/1/2013 17:15'!
explanationAttributes
	^{TextIndent spaceUsed; tabs: 2}! !

!NECMenuMorph class methodsFor: 'help text' stamp: 'EstebanLorenzano 2/1/2013 17:15'!
sectionAttributes
	^ {TextEmphasis bold}! !

!NECMenuMorph class methodsFor: 'help text' stamp: 'EstebanLorenzano 2/1/2013 17:16'!
helpTitle

	^ 'Completion Keyboard Help'! !

!NECModel commentStamp: '<historical>'!
I'm an abstract class that stores the entries to be completed.!
!NECModel methodsFor: 'private' stamp: 'CamilloBruni 8/4/2012 00:47'!
addToEntries: aCollection 
	| temp caseSensitive |
	caseSensitive := NECPreferences caseSensitive.
	temp := aCollection select: [ :each | 
		each contents 
			occursInWithEmpty: narrowString
			caseSensitive: caseSensitive ].
	entries addAll: temp! !

!NECModel methodsFor: 'accessing' stamp: ''!
entries
	^entries! !

!NECModel methodsFor: 'accessing' stamp: ''!
hasMessage
	^ self message notNil! !

!NECModel methodsFor: 'initialize-release' stamp: ''!
toggleExpand
	! !

!NECModel methodsFor: 'testing' stamp: ''!
isEmpty
	^ entries isEmpty! !

!NECModel methodsFor: 'private' stamp: ''!
resetSelectors
	selectors := (SortedCollection new: 500) sortBlock: 
		[ :a :b | 
		| scoreA scoreB |
		scoreA := scoreB := 0.
		(a contents 
			beginsWithEmpty: narrowString
			caseSensitive: NECPreferences caseSensitive) ifFalse: [ scoreA := 2 ].
		(b contents 
			beginsWithEmpty: narrowString
			caseSensitive: NECPreferences caseSensitive) ifFalse: [ scoreB := 2 ].
		a contents < b contents
			ifTrue: [ scoreB := scoreB + 1 ]
			ifFalse: [ scoreA := scoreA + 1 ].
		scoreA < scoreB ]! !

!NECModel methodsFor: 'accessing' stamp: ''!
initializeSelectors 
	self subclassResponsibility ! !

!NECModel methodsFor: 'accessing' stamp: ''!
entryCount
	^entries size! !

!NECModel methodsFor: 'private' stamp: ''!
reset
	self resetSelectors.
	self resetEntries.
	narrowString := String new! !

!NECModel methodsFor: 'accessing' stamp: 'JohanBrichau 4/5/2013 22:08'!
narrowString
	^ narrowString! !

!NECModel methodsFor: 'action' stamp: ''!
narrowWith: aString
	self subclassResponsibility ! !

!NECModel methodsFor: 'private' stamp: ''!
resetEntries
	entries := OrderedCollection new! !

!NECModel methodsFor: 'testing' stamp: ''!
notEmpty 
	^self isEmpty not! !

!NECModel methodsFor: 'initialize-release' stamp: ''!
setClass: aClass 
	clazz := aClass.
	self initializeSelectors.
	self narrowWith: String new! !

!NECModel methodsFor: 'initialization' stamp: ''!
initialize
	self reset! !

!NECModel methodsFor: 'accessing' stamp: ''!
at: aNumber 
	^ entries at: aNumber ! !

!NECModel methodsFor: 'action' stamp: ''!
title
	^nil! !

!NECModel methodsFor: 'accessing' stamp: 'SeanDeNigris 1/23/2013 15:06'!
commonPrefix
	"Longest match among the typed text and all menu entries"

	| seed matchLengths prefixLength |
	seed := self entries first contents asString.
	matchLengths := entries allButFirst
		collect: [ :entry | seed charactersExactlyMatching: entry contents asString ]
		thenSelect: [ :e | e >= narrowString size ].
	prefixLength := matchLengths isEmpty
		ifTrue: [ 0 ]
		ifFalse: [ matchLengths min ].
	^ seed first: prefixLength.! !

!NECModel methodsFor: 'accessing' stamp: 'EstebanLorenzano 2/1/2013 18:22'!
message
	^self isEmpty 
		ifTrue: ['no completions found'] 
		ifFalse: [nil]! !

!NECModel methodsFor: 'private' stamp: ''!
narrowString: aString 
	narrowString := aString! !

!NECModel methodsFor: 'action' stamp: 'EstebanLorenzano 2/1/2013 16:02'!
completionAt: aNumber
	| entry |
	
	entry := (self at: aNumber) completion separateKeywords.
	^ NECPreferences spaceAfterCompletion 
		ifTrue: [ entry, ' ' ]
		ifFalse: [ entry ]. 
	
	! !

!NECModel methodsFor: 'accessing' stamp: ''!
entriesOfType: aSymbol 
	| collection |
	collection := entries select: [ :each | each type == aSymbol ].
	^ collection collect: [ :each | each contents ]! !

!NECModel methodsFor: 'action' stamp: ''!
theClass
	^nil! !

!NECModel class methodsFor: 'instance creation' stamp: ''!
class: aClass 
	| newInstance |
	newInstance := self basicNew initialize.
	newInstance setClass: aClass.
	^ newInstance! !

!NECOverrideModel commentStamp: '<historical>'!
I'm used when completing a method override. I contain all selectors of the superclass minus the already implemented selectors of the current class. When a completion occurs I complete a method template with a send to super.!
!NECOverrideModel methodsFor: 'initialize-release' stamp: 'GabrielOmarCotelli 12/4/2013 08:32'!
initializeSelectors
	clazz superclass ifNotNil: [ self initializeSelectorsFor: clazz superclass ].
	clazz
		selectorsDo: [ :each | selectors detect: [ :ea | ea contentsAsSymbol == each ] ifFound: [ :entry | selectors remove: entry ifAbsent: [  ] ] ]! !

!NECOverrideModel methodsFor: 'action' stamp: ''!
title
	^ '(override) ' , clazz superclass name! !

!NECOverrideModel methodsFor: 'action' stamp: 'EstebanLorenzano 8/17/2012 16:40'!
completionAt: aNumber 
	| output source declaration |
	source :=  (self methodAt: aNumber) sourceCode.
	declaration := (source lineCorrespondingToIndex: 1) trimRight.
	output := WriteStream on: String new.
	output nextPutAll: declaration; cr; tab.
	(source includesSubstring: 'subclassResponsibility') ifFalse: [
		(source includes: $^)
			ifTrue: [ output nextPutAll: '^ ' ].
		output
			nextPutAll: 'super ';
			nextPutAll: declaration ].
	^ output contents! !

!NECOverrideModel methodsFor: 'private' stamp: ''!
methodAt: aNumber 
	^ clazz lookupSelector: (self at: aNumber) contentsAsSymbol! !

!NECOverrideModelTest methodsFor: 'testing' stamp: ''!
testCompletionAtWithReturn
	| completion |
	completion := model completionAt: 3.
	self assert: completion = 'toBeOverridenWithReturn
	^ super toBeOverridenWithReturn'! !

!NECOverrideModelTest methodsFor: 'testing' stamp: ''!
testTitle
	self assert: '(override) NECTestSuperClass' = model title! !

!NECOverrideModelTest methodsFor: 'testing' stamp: ''!
testCompletionAt
	| completion |
	completion := model completionAt: 2.
	self assert: completion = 'toBeOverriden: anArgument
	super toBeOverriden: anArgument'! !

!NECOverrideModelTest methodsFor: 'testing' stamp: ''!
testExpand
	| size |
	size := model entries size.
	self assert: size == model entries size! !

!NECOverrideModelTest methodsFor: 'testing' stamp: ''!
setUp
	model := NECOverrideModel class: NECTestClass.
	model toggleExpand! !

!NECOverrideModelTest methodsFor: 'testing' stamp: ''!
testOverride
	| selectors |
	self assert: model notEmpty.
	self assert: model entries size = 3.
	selectors := model entriesOfType: #selector.
	self
		assert: (selectors includes: #toBeOverriden:).
	self
		assert: (selectors includes: #initialize).
	self
		assert: (selectors includes: #toBeOverridenWithReturn)! !

!NECPreferences commentStamp: '<historical>'!
I control the preferences for completion framework. 
It is the same for NECompletion and NOCompletion (and other potential completion algorithms should be configured here too)

!
!NECPreferences class methodsFor: 'accessing' stamp: 'CamilloBruni 8/26/2012 23:10'!
captureNavigationKeys: aBoolean
	captureNavigationKeys := aBoolean! !

!NECPreferences class methodsFor: 'accessing' stamp: ''!
enabled
	^ enabled
! !

!NECPreferences class methodsFor: 'accessing' stamp: 'EstebanLorenzano 2/1/2013 16:40'!
popupAutomaticDelay
	^popupAutomaticDelay ifNil: [ popupAutomaticDelay := self defaultPopupDelay ] ! !

!NECPreferences class methodsFor: 'accessing' stamp: 'CamilloBruni 1/15/2013 15:45'!
smartCharactersWithSingleSpace
	^ smartCharactersWithSingleSpace! !

!NECPreferences class methodsFor: 'accessing' stamp: 'CamilloBruni 8/3/2012 23:56'!
expandPrefixes: aBoolean
	expandPrefixes := aBoolean! !

!NECPreferences class methodsFor: 'accessing' stamp: 'CamilloBruni 1/15/2013 15:46'!
smartCharactersWithSingleSpace: aString
	smartCharactersWithSingleSpace := aString! !

!NECPreferences class methodsFor: 'accessing' stamp: 'CamilloBruni 1/15/2013 15:46'!
smartCharactersWithDoubleSpace: aString
	smartCharactersWithDoubleSpace := aString! !

!NECPreferences class methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
backgroundColor 
	^backgroundColor ifNil: [ 
		backgroundColor := (Smalltalk ui theme settings menuColor ifNil: [ Color white ]) ]! !

!NECPreferences class methodsFor: 'settings' stamp: 'EstebanLorenzano 2/1/2013 16:37'!
defaultSpaceAfterCompletion
	^true! !

!NECPreferences class methodsFor: 'private' stamp: 'EstebanLorenzano 4/12/2012 13:10'!
currentController 
	^ (Smalltalk tools hasToolNamed: #codeCompletion)
		ifTrue: [ Smalltalk tools codeCompletion ]
		ifFalse: [ nil ]! !

!NECPreferences class methodsFor: 'defaults' stamp: 'CamilloBruni 1/15/2013 15:45'!
initialize
	enabled := caseSensitive := smartCharacters := false.
	expandPrefixes := false.
	captureNavigationKeys := false.
	useEnterToAccept := false.
	smartCharactersMapping := Dictionary new.
	smartCharactersMapping
		at: $( put: $);
		at: $[ put: $];
		at: ${ put: $};
		at: $" put: $";
		at: $' put: $'.
	smartCharactersWithSingleSpace := ''.
	smartCharactersWithDoubleSpace := '[]'.! !

!NECPreferences class methodsFor: 'accessing' stamp: 'EstebanLorenzano 2/1/2013 16:40'!
popupShowAutomatic
	^ popupShowAutomatic ifNil: [ popupShowAutomatic := self defaultPopupShowAutomatic ]! !

!NECPreferences class methodsFor: 'defaults' stamp: 'BenjaminVanRyseghem 2/9/2013 17:52'!
defaultUseEnterToAccept
	
	^ false! !

!NECPreferences class methodsFor: 'settings' stamp: 'StephaneDucasse 11/11/2014 18:23'!
settingsOn: aBuilder
	<systemsettings>
	(aBuilder setting: #'Code Completion')
		target: self;
		parentName: #codeBrowsing;
		selector: #enabled;
		icon: Smalltalk ui icons smallConfigurationIcon;
		description: 'Enable or disable code completion in browsers, debuggers and workspaces.';
		with: [ 
					| availableControllers |
					availableControllers := self availableControllers.
					availableControllers size > 1
						ifTrue: [ 
							(aBuilder pickOne: #completionController)
								order: -1;
								label: 'Controller';
								getSelector: #currentController;
								setSelector: #useController:;
								domainValues: availableControllers ].
					(aBuilder setting: #backgroundColor)
						label: 'Background Color'.
					(aBuilder setting: #expandPrefixes)
						label: 'Complete common prefixes using TAB in the suggested completions' translated.
					(aBuilder setting: #useEnterToAccept)
						label: 'Use ENTER to accept a suggested completion';
						default: self defaultUseEnterToAccept.
					(aBuilder setting: #captureNavigationKeys)
						label: 'Use navigation keys for extended completion functionality'.
					(aBuilder setting: #caseSensitive)
						label: 'Case Sensitive';
						description: 'Decide if you want eCompletion to be case sensitive or not.'.
					(aBuilder setting: #smartCharacters)
						label: 'Smart Characters';
						description: 'Decide if you want eCompletion to use smart characters, e.g, to automatically close brackets.'.
					(aBuilder setting: #smartCharactersWithSingleSpace)
						label: 'Smart Characters with Single Space';
				 		description: 'Enumerate the characters which are automatically inserted with a single space in between.'.
					(aBuilder setting: #smartCharactersWithDoubleSpace) 
						label: 'Smart Characters with Double Space';
				 		description: 'Enumerate the characters which are automatically inserted with a two spaces in between.'.
					(aBuilder setting: #popupShowAutomatic)
						default: self defaultPopupShowAutomatic;
						label: 'Popup is automatic'.
					(aBuilder setting: #popupAutomaticDelay)
						default: self defaultPopupDelay;
						label: 'Popup appearance delay'.
					(aBuilder pickOne: #popupShowWithShortcut)
						default: self defaultPopupShortcut;
						label: 'Popup appears with this shortcut';
						domainValues: self availablePopupShortcuts.
					(aBuilder setting: #spaceAfterCompletion)
						default: self defaultSpaceAfterCompletion;
						label: 'Put a space after completion'
					 ].! !

!NECPreferences class methodsFor: 'private' stamp: 'EstebanLorenzano 4/12/2012 11:24'!
useController: aClass
	aClass registerToolsOn: Smalltalk tools! !

!NECPreferences class methodsFor: 'accessing' stamp: 'EstebanLorenzano 4/12/2012 13:36'!
backgroundColor: aColor 
	backgroundColor := aColor! !

!NECPreferences class methodsFor: 'accessing' stamp: 'EstebanLorenzano 4/12/2012 13:11'!
enabled: aBoolean
	enabled := aBoolean.! !

!NECPreferences class methodsFor: 'accessing' stamp: ''!
caseSensitive: aBoolean
	caseSensitive := aBoolean! !

!NECPreferences class methodsFor: 'accessing' stamp: 'EstebanLorenzano 2/1/2013 15:39'!
popupShowWithShortcut: anObject
	popupShowWithShortcut := anObject! !

!NECPreferences class methodsFor: 'private' stamp: 'EstebanLorenzano 4/12/2012 13:04'!
availableControllers
	^NECController withAllSubclasses copyWithout: NECWorkspaceController! !

!NECPreferences class methodsFor: 'accessing' stamp: ''!
smartCharacters
	^ smartCharacters! !

!NECPreferences class methodsFor: 'accessing' stamp: 'GuillermoPolito 3/19/2013 19:12'!
availablePopupShortcuts
	^ {
		Character space shift. 
		Character tab asKeyCombination}! !

!NECPreferences class methodsFor: 'accessing' stamp: 'EstebanLorenzano 2/1/2013 15:39'!
popupAutomaticDelay: anObject
	popupAutomaticDelay := anObject! !

!NECPreferences class methodsFor: 'settings' stamp: 'EstebanLorenzano 2/1/2013 16:36'!
defaultPopupShowAutomatic
	^true! !

!NECPreferences class methodsFor: 'accessing' stamp: 'EstebanLorenzano 2/1/2013 16:40'!
popupShowWithShortcut
	^ popupShowWithShortcut ifNil: [ popupShowWithShortcut := self defaultPopupShortcut ]! !

!NECPreferences class methodsFor: 'accessing' stamp: ''!
smartCharactersMapping: aDictionary
	smartCharactersMapping := aDictionary! !

!NECPreferences class methodsFor: 'accessing' stamp: 'CamilloBruni 8/3/2012 23:56'!
expandPrefixes
	^ expandPrefixes! !

!NECPreferences class methodsFor: 'accessing' stamp: 'EstebanLorenzano 2/1/2013 15:54'!
spaceAfterCompletion
	^ spaceAfterCompletion ifNil: [ spaceAfterCompletion := true ]! !

!NECPreferences class methodsFor: 'settings' stamp: 'EstebanLorenzano 2/1/2013 16:39'!
defaultPopupDelay
	^ 500! !

!NECPreferences class methodsFor: 'settings' stamp: 'EstebanLorenzano 2/1/2013 17:22'!
defaultPopupShortcut
	^Character space shift! !

!NECPreferences class methodsFor: 'accessing' stamp: ''!
smartCharacters: aBoolean
	smartCharacters := aBoolean! !

!NECPreferences class methodsFor: 'accessing' stamp: 'CamilloBruni 8/26/2012 23:28'!
useEnterToAccept: aBoolean
	useEnterToAccept := aBoolean! !

!NECPreferences class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/9/2013 17:51'!
useEnterToAccept
	^ useEnterToAccept ifNil: [ useEnterToAccept := self defaultUseEnterToAccept ]! !

!NECPreferences class methodsFor: 'accessing' stamp: 'EstebanLorenzano 2/1/2013 15:37'!
popupShowAutomatic: aBoolean
	popupShowAutomatic := aBoolean! !

!NECPreferences class methodsFor: 'accessing' stamp: 'CamilloBruni 8/26/2012 23:10'!
captureNavigationKeys
	^ captureNavigationKeys! !

!NECPreferences class methodsFor: 'accessing' stamp: ''!
caseSensitive
	^ caseSensitive
! !

!NECPreferences class methodsFor: 'accessing' stamp: ''!
smartCharactersMapping
	^ smartCharactersMapping! !

!NECPreferences class methodsFor: 'accessing' stamp: 'CamilloBruni 1/15/2013 15:46'!
smartCharactersWithDoubleSpace
	^ smartCharactersWithDoubleSpace! !

!NECPreferences class methodsFor: 'accessing' stamp: 'EstebanLorenzano 2/1/2013 15:39'!
spaceAfterCompletion: anObject
	spaceAfterCompletion := anObject! !

!NECSelectorEntry commentStamp: '<historical>'!
I represent a selector!
!NECSelectorEntry methodsFor: 'private' stamp: ''!
lookupSelector: aSymbol class: aClass 
	"Look up the given selector in my methodDictionary.
	Return the corresponding method if found.
	Otherwise chase the superclass chain and try again.
	Return nil if no method is found."
	| lookupClass |
	lookupClass := aClass.
	[lookupClass isNil]
		whileFalse: [(lookupClass includesSelector: aSymbol)
				ifTrue: [^ Array
						with: lookupClass
						with: (lookupClass compiledMethodAt: aSymbol)].
			lookupClass := lookupClass superclass].
	^ nil! !

!NECSelectorEntry methodsFor: 'accessing' stamp: 'CamilloBruni 8/6/2012 00:08'!
label
	^ (self guessTypeWith: nil) ifNil:[ 'method' ] ifNotNil: [ 'class' ].! !

!NECSelectorEntry methodsFor: 'detail information' stamp: 'CamilloBruni 8/6/2012 00:36'!
createDescriptionWith: anECContext

	(self guessTypeWith: anECContext)
		ifNotNil: [ :clazz|
			^ NECEntryDescription 
					label: self label
					title: clazz printString
					description: clazz comment	].
	^ self
		findMethodWith: anECContext
		do: [:clazz :method | 
			self
				methodSourceDescription: clazz
				method: method ]
		ifAbsent: [:selector | self implementorsDescription: selector]! !

!NECSelectorEntry methodsFor: 'private' stamp: 'CamilloBruni 8/27/2013 01:40'!
findMethodWith: anECContext do: foundBlock ifAbsent: notfoundBlock 
	| theClass result implementors |
	theClass := anECContext model theClass.
	result := theClass
				ifNil: [implementors := self systemNavigation allImplementorsOf: contents.
					implementors size == 1
						ifTrue: [| ref | 
							ref := implementors first.
							self lookupSelector: ref selector class: ref realClass]
						ifFalse: [^ notfoundBlock value: contents]]
				ifNotNil: [self lookupSelector: contents class: theClass]. 
	^ foundBlock value: result first value: result second! !

!NECSelectorEntry methodsFor: 'operations' stamp: 'CamilloBruni 8/6/2012 00:06'!
guessTypeWith: anECContext 
	| globalEntry |
	globalEntry := Smalltalk at: contents ifAbsent: [^ nil].
	globalEntry isBehavior ifTrue: [^ globalEntry].
	globalEntry ifNotNil: [^ globalEntry class].
	^ nil! !

!NECSelectorEntry methodsFor: 'private' stamp: 'CamilloBruni 8/6/2012 00:41'!
methodSourceDescription: aClass method: aCompiledMethod 
	| styler styledText |
	
	styler := SHTextStylerST80 new.
	styler classOrMetaClass: aClass.
	styledText := styler styledTextFor: (aCompiledMethod sourceCode) asText.
	
	^ NECEntryDescription
		label: self label
		title: aClass printString
		description: styledText! !

!NECSelectorEntry methodsFor: 'private' stamp: 'MarcusDenker 7/30/2014 17:15'!
browseWith: anECContext

	(self guessTypeWith: anECContext)
		ifNotNil: [ :clazz|
			Smalltalk tools browser fullOnClass: clazz.
			^ true ].
	
	^ self
		findMethodWith: anECContext
		do: [ :class :method | 
			Smalltalk tools browser 
				fullOnClass: class 
				selector: method selector. 
			true ]
		ifAbsent: [ :selector | 
			SystemNavigation new 
				browseAllImplementorsOf: selector.
			true ]! !

!NECSelectorEntry methodsFor: 'private' stamp: 'MarcusDenker 7/17/2014 16:51'!
implementorsDescription: aSymbol 
	| implementors output |
	output := WriteStream on: String new.
	implementors := self systemNavigation allImplementorsOf: aSymbol.
	implementors isEmpty ifTrue: 
		[ ^ NECEntryDescription 
			label: 'symbol'
			title: '(no implementors)'
			description: 'This is just symbol.' ].
	implementors do: [ :each | 
		output
			nextPutAll: each className printString;
			cr ].
	^ NECEntryDescription 
		label: self label
		title: '(Implementors)'
		description: output contents! !

!NECSelfEntry commentStamp: '<historical>'!
I represent self!
!NECSelfEntry methodsFor: 'accessing' stamp: ''!
label
	^ 'self'! !

!NECSelfEntry methodsFor: 'operations' stamp: ''!
guessTypeWith: anECContext 
	^ anECContext theClass! !

!NECStringSortingTest methodsFor: 'tests' stamp: ''!
testCompareWithCase
	self assert: ('at:' compare: 'atOne' caseSensitive: true)
			== 3! !

!NECStringSortingTest methodsFor: 'tests' stamp: ''!
testCompare
	self assert: ('at:' compare: 'atOne' caseSensitive: false)
			== 1! !

!NECStringSortingTest methodsFor: 'tests' stamp: ''!
testCaseSensitiveMap
	| map colon o |
	map := String classPool at: #CaseSensitiveOrder.
	colon := map at: $: asciiValue + 1.
	o := map at: $O asciiValue + 1.
	self assert: colon > o! !

!NECSuperEntry commentStamp: '<historical>'!
I represent super.!
!NECSuperEntry methodsFor: 'accessing' stamp: ''!
label
	^ 'super'! !

!NECSuperEntry methodsFor: 'operations' stamp: ''!
guessTypeWith: anECContext 
	^ anECContext theClass ifNotNil: [anECContext theClass superclass]! !

!NECSymbols commentStamp: 'MarcusDenker 8/10/2014 12:02'!
I retrieve the symbols for the ecompletion algorithm.

TODO remove stupid symbols (like packages and timestamps)!
!NECSymbols class methodsFor: 'query' stamp: 'EstebanLorenzano 2/1/2013 18:44'!
contains: aString caseSensitive: aBoolean do: aBlock 
	| blockToPerform |

	blockToPerform := [ :each | 
		((each includes: $ ) not and: [ each includesSubstring: aString caseSensitive: aBoolean ]) 
			ifTrue: [ aBlock value: each ] ].

	cachedSymbols 
		ifNotNil:[ self cachedInterestingSymbolsDo: blockToPerform ]
		ifNil: [ self cacheInterestingSymbolsAndDo: blockToPerform ] 		
! !

!NECSymbols class methodsFor: 'private' stamp: 'CamilloBruni 2/3/2013 18:27'!
cacheInterestingSymbolsAndDo: aBlock
	"For time issue, we collect and perform the block in only one iteration"
	| cache |
	cache := OrderedCollection new: 5000.
	self interestingSymbolsDo: [:symbol |
		cache add: symbol.
		aBlock value: symbol ].
	" only assign the cache in the end, aBlock might do a non-local return!!"
	cachedSymbols := cache.! !

!NECSymbols class methodsFor: 'accessing' stamp: 'EstebanLorenzano 2/1/2013 18:31'!
cachedSymbols
	^cachedSymbols! !

!NECSymbols class methodsFor: 'private' stamp: 'EstebanLorenzano 2/1/2013 18:37'!
cachedInterestingSymbolsDo: aBlock
	self cachedSymbols do: aBlock! !

!NECSymbols class methodsFor: 'accessing' stamp: 'EstebanLorenzano 2/1/2013 18:31'!
resetCachedSymbols
	cachedSymbols := nil! !

!NECSymbols class methodsFor: 'private' stamp: 'EstebanLorenzano 2/1/2013 18:16'!
interestingSymbolsDo: aBlock

	Symbol allSymbolTablesDo:[:symbol |
		symbol isEmpty
			ifFalse: [
				(symbol first isUppercase and:[ Smalltalk globals includesKey: symbol ])
					ifTrue:[ aBlock value: symbol ]
					ifFalse: [ symbol first isLetter ifTrue: [ aBlock value: symbol ]]]].! !

!NECSymbols class methodsFor: 'query' stamp: ''!
startsWith: aChar caseSensitive: aBoolean do: aBlock 
	| char caseInSensitive firstChar |
	caseInSensitive := aBoolean not.
	firstChar := caseInSensitive 
		ifTrue: [ aChar asLowercase ]
		ifFalse: [ aChar ].
	Symbol allSymbolTablesDo: 
		[ :each | 
		| size |
		size := each size.
		char := size > 0 ifTrue: [ each first ].
		(char notNil 
			and: [ (char == firstChar or: [ caseInSensitive and: [ char asLowercase == firstChar ] ])
			and: [ (each 
				findAnySubStr: '- '
				startingAt: 2) > size ] ]) ifTrue: [ aBlock value: each ] ]! !

!NECTestClass commentStamp: '<historical>'!
I'm only for SUnit TestCases.!
!NECTestClass methodsFor: 'utils' stamp: ''!
lowPriorityOverrides: aRectangle 
	messageSend := aRectangle.
	typeSuggestingParameter2 := aRectangle. ! !

!NECTestClass methodsFor: 'tests' stamp: ''!
testIt: anArgument 
	| loc1 x2 t |
	x2 := [:bar :var | var < bar].
	loc1 := constantArray.
	x2 value: loc1.
	t := 15.
	^ x2! !

!NECTestClass methodsFor: 'initialization' stamp: 'NicolaiHess 2/19/2014 15:37'!
initialize: aRectangle 
	constantInteger := 15.
	constantLargeInteger := 1073741824.
	constantString := 'Ruben'.
	constantSymbol := #Symbol.
	constantArray := #(15 16 17 28 ).
	constantBoolean := true.
	typeSuggestingParameter := aRectangle.
	messageSend := Dictionary new.
	messageSend2 := aRectangle origin.
	globalVarKeyword := SortedCollection
				sortBlock: [:a :b | a <= b].
	globalVarKeyword2 := SortedCollection new: 15.
	constantNil := nil.
	typeSuggestingParameter2 := nil.
	complexInit := 15 > 16
				ifTrue: [#Symbol]
				ifFalse: ['String'].
	complexInit2 := Dictionary new: aRectangle origin x. ! !

!NECTestClass class methodsFor: 'initialization' stamp: ''!
initialize
	super initialize.
	ClassVar := 'Any string'! !

!NECTestSuperClass commentStamp: '<historical>'!
I'm only for SUnit TestCases.!
!NECTestSuperClass methodsFor: 'utils' stamp: ''!
toBeOverriden: anArgument 
	15 > 16
		ifTrue: [self sample * anArgument ]! !

!NECTestSuperClass methodsFor: 'initialization' stamp: ''!
initialize
	superInstVar := Dictionary new! !

!NECTestSuperClass methodsFor: 'utils' stamp: ''!
toBeOverridenWithReturn
	^ 'saga'! !

!NECTestSuperClass methodsFor: 'tests' stamp: ''!
testIt: aString
	self subclassResponsibility ! !

!NECTestSuperClass class methodsFor: 'initialization' stamp: ''!
initialize
	SuperClassVar := Dictionary new! !

!NECTypeInfo commentStamp: '<historical>'!
I'm used in ECInstVarTypeGuesser to store found type informations.!
!NECTypeInfo methodsFor: 'accessing' stamp: ''!
temporaryOffset
	^temporaryOffset! !

!NECTypeInfo methodsFor: 'testing' stamp: ''!
isDefinedByMessageSend
	^kind == 2! !

!NECTypeInfo methodsFor: 'testing' stamp: ''!
isDefinedByTemporary
	^ kind == 3! !

!NECTypeInfo methodsFor: 'accessing' stamp: ''!
setType: aClass kind: anInteger 
	type := aClass.
	kind := anInteger! !

!NECTypeInfo methodsFor: 'accessing' stamp: ''!
priority
	^kind! !

!NECTypeInfo methodsFor: 'accessing' stamp: ''!
type
	^type! !

!NECTypeInfo methodsFor: 'accessing' stamp: ''!
type: aClass 
	type := aClass! !

!NECTypeInfo methodsFor: 'accessing' stamp: ''!
temporaryOffset: anInteger 
	temporaryOffset := anInteger! !

!NECTypeInfo class methodsFor: 'instance creation' stamp: ''!
definedByTemporaryVar: anInteger
	| newInstance |
	newInstance := self new.
	newInstance setType: nil kind: 3.
	newInstance temporaryOffset: anInteger.
	^ newInstance! !

!NECTypeInfo class methodsFor: 'instance creation' stamp: ''!
definedByMessageSend: aClass 
	| newInstance |
	newInstance := self new.
	newInstance setType: aClass kind: 2.
	^ newInstance! !

!NECTypeInfo class methodsFor: 'instance creation' stamp: ''!
definedByLiteral: aClass 
	| newInstance |
	newInstance := self new.
	newInstance setType: aClass kind: 1.
	^ newInstance! !

!NECTypedModel commentStamp: '<historical>'!
I'm the model for a typed completion, that means when a receiver class is known. I only have selectors. I have an expand toggle: When false I filter out Object and ProtoObject selectors. The default value is true.!
!NECTypedModel methodsFor: 'initialization' stamp: ''!
initialize
	super initialize.
	expanded := true! !

!NECTypedModel methodsFor: 'action' stamp: ''!
toggleExpand
	expanded := expanded not.
	self initializeSelectors.
	self narrowWith: narrowString! !

!NECTypedModel methodsFor: 'action' stamp: ''!
title
	^clazz name! !

!NECTypedModel methodsFor: 'private' stamp: ''!
initializeSelectorsFor: aClass 
	|excludedClasses|
	selectors reset.
	excludedClasses := (expanded ifTrue: [#()] ifFalse: [Object withAllSuperclasses]).
	selectors addAll: ((aClass allSelectorsWithout: excludedClasses)
						collect: [:each | NECSelectorEntry contents: each type: #selector])! !

!NECTypedModel methodsFor: 'private' stamp: ''!
initializeSelectors
	self initializeSelectorsFor: clazz! !

!NECTypedModel methodsFor: 'action' stamp: ''!
narrowWith: aString 
	self
		narrowString: aString ;
		initializeSelectors.
	entries reset.
	self addToEntries: selectors! !

!NECTypedModel methodsFor: 'action' stamp: ''!
theClass
	^clazz! !

!NECTypedModelTest methodsFor: 'tests' stamp: ''!
testTitle
	| model |
	model := NECTypedModel class: NECTestClass.
	self assert: #NECTestClass = model title! !

!NECTypedModelTest methodsFor: 'tests' stamp: ''!
testExpand
	| model selectors |
	model := NECTypedModel class: NECTestClass.
	self assert: (model entriesOfType: #locals) isEmpty.
	self assert: (model entriesOfType: #instance) isEmpty.
	model toggleExpand.
	selectors := model entriesOfType: #selector.
	self assert: selectors size == 6.
	self assert: (selectors includes: #initialize).
	self assert: (selectors includes: #lowPriorityOverrides:).
	self assert: (selectors includes: #testIt:).
	model toggleExpand.
	selectors := model entriesOfType: #selector.
	self assert: selectors size > 100.
	self assert: (selectors includes: #instVarAt:).
	self assert: (selectors includes: #initialize).
	self assert: (selectors includes: #lowPriorityOverrides:).
	self assert: (selectors includes: #testIt:).
	self assert: (selectors includes: #instVarAt:).
	model toggleExpand.
	selectors := model entriesOfType: #selector.
	self assert: selectors size == 6! !

!NECTypedModelTest methodsFor: 'tests' stamp: ''!
testTyped
	| model selectors |
	model := NECTypedModel class: NECTestClass.
	self assert: (model entriesOfType: #locals) size == 0.
	self assert: (model entriesOfType: #instance) size == 0.
	selectors := model entriesOfType: #selector.
	self assert: selectors size > 0.
	self assert: (selectors includes: #initialize).
	self assert: (selectors includes: #lowPriorityOverrides:).
	self assert: (selectors includes: #testIt:).
	model narrowWith: 'low'.
	selectors := model entriesOfType: #selector.
	self deny: (selectors includes: #initialize).
	self assert: (selectors includes: #lowPriorityOverrides:).
	self deny: (selectors includes: #testIt:)! !

!NECTypedModelTest methodsFor: 'tests' stamp: ''!
testMessage
	| model |
	model := NECTypedModel class: NECTestClass.
	self shouldnt: model hasMessage.
	model narrowWith: 'hagadagadu'.
	self assert: model hasMessage.
	self assert: model message = 'no completions found'! !

!NECUntypedModel commentStamp: '<historical>'!
When no receiver class is known, I'm the right model. I store all temporary variables, instance variables of the selected class and all selectors in system. For performance reasons I only collect selectors when at least one character is known.!
!NECUntypedModel methodsFor: 'accessing' stamp: 'CamilloBruni 2/3/2013 21:39'!
listLimit: aNumber
	listLimit := aNumber! !

!NECUntypedModel methodsFor: 'initialize-release' stamp: 'CamilloBruni 8/7/2012 12:35'!
setClass: aClass temporaries: aCollection additionals: additionalCollection variables: variablesBoolean selectors: selectorsBoolean 
	includeVariables := variablesBoolean.
	includeSelectors := selectorsBoolean.
	clazz := aClass.
	self initializeInstVars.
	self initializeClassVars.
	includeVariables 
		ifTrue: [ 
			localVars := aCollection.
			self addAdditionals: additionalCollection ]
		ifFalse: [ localVars := OrderedCollection new ].
	self resetEntries.! !

!NECUntypedModel methodsFor: 'private' stamp: 'IgorStasenko 9/16/2013 17:28'!
initializeSelectors
	self resetSelectors.
	includeSelectors ifFalse: 
		[ Smalltalk keysAndValuesDo: [ :each :class |
			selectors add: (NECGlobalEntry contents: each) ].
		^ self ].
	narrowString ifEmpty: [ ^ self ].
	NECSymbols 
		contains: narrowString
		caseSensitive: NECPreferences caseSensitive
		do: [ :each | 
			(includeVariables or: [ each first isLowercase ]) ifTrue: 
				[ selectors add: (NECSelectorEntry 
						contents: each
						type: #selector).
				selectors size > self listLimit ifTrue: [ ^ self ]]]! !

!NECUntypedModel methodsFor: 'private' stamp: ''!
addSelectors
	self initializeSelectors.
	self addToEntries: selectors! !

!NECUntypedModel methodsFor: 'action' stamp: ''!
narrowWith: aString 
	self narrowString: aString.
	self resetEntries.
	self addVariables.
	self addSelectors! !

!NECUntypedModel methodsFor: 'accessing' stamp: 'CamilloBruni 2/3/2013 21:39'!
listLimit
	^ listLimit! !

!NECUntypedModel methodsFor: 'initialization' stamp: 'CamilloBruni 2/3/2013 21:39'!
initialize
	super initialize.
	localVars := SortedCollection new.
	instVars := SortedCollection new.
	classVars := SortedCollection new.
	includeSelectors := true.
	includeVariables := true.
	listLimit := 100.! !

!NECUntypedModel methodsFor: 'initialize-release' stamp: 'IgorStasenko 9/16/2013 17:28'!
initializeClassVars
	(clazz isNil or: [ includeVariables not ]) ifTrue: [ ^ self ].
	classVars := clazz theNonMetaClass allClassVarNames asSortedCollection.
	classVars := classVars collect: 
		[ :each | 
		NECClassVarEntry contents: each ]! !

!NECUntypedModel methodsFor: 'private' stamp: ''!
addVariables
	includeVariables
		ifFalse: [^ self].
	self addToEntries: localVars.
	self addToEntries: instVars.
	self addToEntries: classVars! !

!NECUntypedModel methodsFor: 'private' stamp: ''!
addAdditionals: aCollection 
	aCollection
		ifNotNil: [aCollection
				do: [:each | each isLocal
						ifTrue: [localVars add: each value]
						ifFalse: [each isInstance
								ifTrue: [instVars add: each value]
								ifFalse: [each isSelector
										ifTrue: [selectors add: each value]]]]]! !

!NECUntypedModel methodsFor: 'accessing' stamp: ''!
message
	^ (includeSelectors and: [ narrowString isEmpty ]) 
		ifTrue: 
			[ selectors size = 500 
				ifTrue: [ 'more...' ]
				ifFalse: [ 'press key for selectors' ] ]
		ifFalse: [ super message ]! !

!NECUntypedModel methodsFor: 'initialize-release' stamp: ''!
narrowString: aString 
	(narrowString isEmpty
			or: [aString isEmpty
			or: [aString first ~= narrowString first]])
		ifTrue: [self reset].
	super narrowString: aString! !

!NECUntypedModel methodsFor: 'initialize-release' stamp: 'IgorStasenko 9/16/2013 17:29'!
initializeInstVars
	(clazz isNil or: [ includeVariables not ]) ifTrue: [ ^ self ].
	instVars := clazz allInstVarNames asSortedCollection.
	instVars := instVars collect: 
		[ :each |  NECInstVarEntry contents: each ].
	instVars add: (NECSelfEntry 
			contents: 'self'
			type: #self).
	instVars add: (NECSuperEntry 
			contents: 'super'
			type: #super)! !

!NECUntypedModel methodsFor: 'private' stamp: 'CamilloBruni 8/21/2012 16:29'!
loadEntries
	self addVariables;
		addSelectors! !

!NECUntypedModel class methodsFor: 'instance creation' stamp: ''!
class: aClass temporaries: aCollection 
	^self 
		class: aClass
		temporaries: aCollection
		additionals: #()
		variables: true
		selectors: true! !

!NECUntypedModel class methodsFor: 'instance creation' stamp: ''!
class: aClass temporaries: aCollection additionals: additionalCollection variables: variablesBoolean selectors: selectorsBoolean 
	| newInstance |
	newInstance := self basicNew initialize.
	newInstance 
		setClass: aClass
		temporaries: aCollection
		additionals: additionalCollection
		variables: variablesBoolean
		selectors: selectorsBoolean.
	^ newInstance! !

!NECUntypedModelTest methodsFor: 'tests' stamp: 'CamilloBruni 8/21/2012 16:29'!
testAdditionalLocals
	| model locals |
	model := NECUntypedModel 
		class: NECTestClass
		temporaries: (OrderedCollection 
				with: (NECLocalEntry 
						contents: 'a'
						type: #local)
				with: (NECLocalEntry 
						contents: 'b'
						type: #local))
		additionals: (Array with: (NECLocalEntry 
				contents: 'veryImp'
				type: #local))
		variables: true
		selectors: true.
	model loadEntries.
	locals := model entriesOfType: #local.
	self assert: (locals includes: 'veryImp')! !

!NECUntypedModelTest methodsFor: 'tests' stamp: 'CamilloBruni 8/21/2012 16:29'!
testForClassLocals
	| model locals temps |
	temps := #('loc1' 'x2' 'bar' 'var' ) collect: 
		[ :each | 
		NECLocalEntry 
			contents: each
			type: #local ].
	model := NECUntypedModel 
		class: NECTestClass
		temporaries: temps.
	model loadEntries.
	locals := model entriesOfType: #local.
	self assert: locals size == 4.
	self assert: (locals includes: 'loc1').
	self assert: (locals includes: 'x2').
	self assert: (locals includes: 'bar').
	self assert: (locals includes: 'var').
	model narrowWith: 'l'.
	locals := model entriesOfType: #local.
	self assert: locals size == 1.
	self assert: (locals includes: 'loc1')! !

!NECUntypedModelTest methodsFor: 'tests' stamp: ''!
tearDown
	NECPreferences caseSensitive: prefValueCase! !

!NECUntypedModelTest methodsFor: 'tests' stamp: 'CamilloBruni 2/3/2013 21:40'!
testCaseSensitivity
	| model instances |
	self assert: NECPreferences caseSensitive.
	model := NECUntypedModel 
		class: NECTestClass
		temporaries: OrderedCollection new.
	model listLimit: Float infinity.
		
	model narrowWith: 'typesugg'.
	self assert: model isEmpty.
	
	NECPreferences caseSensitive: false.
	model narrowWith: 'typesugg'.
	instances := model entriesOfType: #instVar.
	self assert: instances size == 2.
	self assert: (instances includes: 'typeSuggestingParameter').
	
	model narrowWith: 'dict'.
	self assert: model notEmpty.
	self assert: ((model entriesOfType: #selector) includes: 'Dictionary')! !

!NECUntypedModelTest methodsFor: 'tests' stamp: ''!
testNoEntriesWithSpace
	| model separatorEntry |
	model := NECUntypedModel new.
	self assert: model isEmpty.
	model narrowWith: 'b'.
	separatorEntry := model entries detect: 
					[:each | 
					(each value asString detect: [:char | char isSeparator] ifNone: []) notNil]
				ifNone: [].
	self assert: separatorEntry isNil! !

!NECUntypedModelTest methodsFor: 'tests' stamp: 'NicolaiHess 2/19/2014 15:38'!
testCaseSensitive
	| model locals |
	self assert: NECPreferences caseSensitive.
	model := NECUntypedModel 
		class: NECTestClass
		temporaries: OrderedCollection new.
	model loadEntries.
	locals := model entriesOfType: #instVar.
	self assert: locals size == 18.
	self assert: (locals includes: 'third').
	self assert: (locals includes: 'constantInteger').
	self assert: (locals includes: 'complexInit2').
	self assert: (locals includes: 'typeSuggestingParameter').
	model narrowWith: 'fo'! !

!NECUntypedModelTest methodsFor: 'tests' stamp: ''!
setUp
	prefValueCase := NECPreferences caseSensitive.
	NECPreferences caseSensitive: true! !

!NECUntypedModelTest methodsFor: 'tests' stamp: ''!
testEmpty
	| model |
	model := NECUntypedModel new.
	self assert: model isEmpty.
	self assert: model entries isEmpty.
	self assert: model entryCount == 0! !

!NECUntypedModelTest methodsFor: 'tests' stamp: ''!
testTitle
	| model |
	model := NECUntypedModel
				class: NECTestClass
				temporaries: #().
	self assert: model title isNil! !

!NECUntypedModelTest methodsFor: 'tests' stamp: 'CamilloBruni 8/21/2012 16:29'!
testMessage
	| model |
	model := NECUntypedModel 
		class: NECTestClass
		temporaries: #('a' 'b' ).
	model loadEntries.
	self assert: model notEmpty.
	self assert: model hasMessage.
	self assert: model message = 'press key for selectors'.
	model narrowWith: 'b'.
	self shouldnt: model hasMessage.
	model narrowWith: ''.
	self assert: model hasMessage.
	self assert: model message = 'press key for selectors'.
	model narrowWith: 'hagadagadu'.
	self assert: model hasMessage.
	self assert: model message = 'no completions found'.
	model := NECUntypedModel new.
	self assert: model hasMessage.
	self assert: model message = 'press key for selectors'! !

!NECUntypedModelTest methodsFor: 'tests' stamp: 'CamilloBruni 2/3/2013 21:39'!
testNarrowWith
	| count model |
	model := NECUntypedModel new.
	model listLimit: Float infinity.
	
	self assert: model isEmpty.
	
	model narrowWith: 'b'.
	count := model entryCount.
	self assert: count == model entries size.
	self assert: model isEmpty not.
	
	model narrowWith: 'bar'.
	self assert: count > model entryCount.
	
	model narrowWith: 'barXXXX'.
	self assert: model isEmpty.
	
	model narrowWith: 'b'.
	self assert: count == model entryCount.
	
	model narrowWith: 'save'.
	self assert: model isEmpty not.
	
	model narrowWith: ''.
	self assert: model isEmpty! !

!NECUntypedModelTest methodsFor: 'tests' stamp: 'NicolaiHess 2/19/2014 15:38'!
testForClassInstVars
	| model locals |
	model := NECUntypedModel 
		class: NECTestClass
		temporaries: OrderedCollection new.
	model loadEntries.
	locals := model entriesOfType: #instVar.
	self assert: locals size == 18.
	self assert: (locals includes: 'third').
	self assert: (locals includes: 'constantInteger').
	self assert: (locals includes: 'complexInit2').
	self assert: (locals includes: 'typeSuggestingParameter').
	locals := model entriesOfType: #self.
	self assert: (locals includes: 'self').
	locals := model entriesOfType: #super.
	self assert: (locals includes: 'super').
	model narrowWith: 'fo'.
	locals := model entriesOfType: #instVar.
	self assert: locals size == 1.
	self assert: (locals includes: 'fourth')! !

!NECUntypedModelTest methodsFor: 'tests' stamp: 'CamilloBruni 8/21/2012 16:30'!
testForClassVars
	| model classVars |
	model := NECUntypedModel 
		class: NECTestClass
		temporaries: OrderedCollection new.
	model loadEntries.
	classVars := model entriesOfType: #classVar.
	self assert: classVars size >= 2.
	self assert: (classVars includes: 'SuperClassVar').
	self assert: (classVars includes: 'ClassVar')! !

!NECVarTypeGuesser commentStamp: '<historical>'!
I'm an InstructionClient that tries to guess the type of a given instance variable name of a class. !
!NECVarTypeGuesser methodsFor: 'bytecode decoding' stamp: ''!
pushTemporaryVariable: offset 
	"Push Contents Of Temporary Variable Whose Index Is the  
	argument, offset, On Top Of Stack bytecode."
	| info |
		contextCount > 0 ifTrue:[^self].

	info := NECTypeInfo definedByTemporaryVar: offset.
	types add: info! !

!NECVarTypeGuesser methodsFor: 'bytecode decoding' stamp: ''!
blockReturnTop
	contextCount := contextCount - 1! !

!NECVarTypeGuesser methodsFor: 'bytecode decoding' stamp: ''!
popIntoTemporaryVariable: offset 
	"Remove Top Of Stack And Store Into Temporary Variable bytecode."
	self reset
! !

!NECVarTypeGuesser methodsFor: 'public' stamp: ''!
methodRefs
	^ #()! !

!NECVarTypeGuesser methodsFor: 'public' stamp: ''!
perform
	| infos infosOfMethod methodRefs |
	variableName isEmpty
		ifTrue: [^ nil].
	methodRefs := self methodRefs.
	methodRefs
		ifNil: [^ nil]. 
	methodRefs isBehavior
		ifTrue: [^ methodRefs].
	contextCount := 0.
	infos := SortedCollection
				sortBlock: [:a :b | a priority <= b priority].
	methodRefs
		do: [:each | 
			self prepare: each.
			infosOfMethod := self typeOfVarIn: each compiledMethod.
			infos addAll: infosOfMethod].
	infos notEmpty
		ifTrue: [^ infos first type].
	^ nil! !

!NECVarTypeGuesser methodsFor: 'bytecode decoding' stamp: 'MarcusDenker 10/5/2013 19:25'!
computeVarType
	| info tempNames name |
	types ifEmpty: [ ^ nil ].
	info := types first.
	(hasSend and: [ info isDefinedByMessageSend not ])
		ifTrue: [ 
			info type: nil.
			^ info ].
	info isDefinedByTemporary
		ifFalse: [ ^ info ].
	tempNames := (receiverClass compiler parse: currentMethod sourceCode) tempNames.
	name := tempNames at: info temporaryOffset + 1.
	info type: (self class getClassFromTypeSuggestingName: name).
	^ info! !

!NECVarTypeGuesser methodsFor: 'private' stamp: ''!
reset
	contextCount > 0 ifTrue:[^self].
	types reset.
	hasSend := false.! !

!NECVarTypeGuesser methodsFor: 'instance creation' stamp: ''!
setVariableName: aString source: aSourceString class: aClass 
	variableName := aString.
	receiverClass := aClass! !

!NECVarTypeGuesser methodsFor: 'bytecode decoding' stamp: ''!
popIntoLiteralVariable: anAssociation 
	"Remove Top Of Stack And Store Into Literal Variable bytecode."
	self reset! !

!NECVarTypeGuesser methodsFor: 'bytecode decoding' stamp: ''!
pushActiveContext
	"Push Active Context On Top Of Its Own Stack bytecode."
	contextCount := contextCount + 1! !

!NECVarTypeGuesser methodsFor: 'bytecode decoding' stamp: ''!
interpretNextInstructionUsing: aScanner 
	found := false.
	aScanner interpretNextInstructionFor: self.
	^found
! !

!NECVarTypeGuesser methodsFor: 'initialization' stamp: ''!
initialize
	super initialize.
	types := OrderedCollection new.
	hasSend := false.
	contextCount := 0! !

!NECVarTypeGuesser methodsFor: 'bytecode decoding' stamp: ''!
send: selector super: supered numArgs: numberArguments 
	"Send Message With Selector, selector, bytecode. The argument,  
	supered, indicates whether the receiver of the message is specified with 
	'super' in the source method. The arguments of the message are found  
	in  
	the top numArguments locations on the stack and the receiver just  
	below them."
	contextCount > 0 ifTrue:[^self].

	hasSend := true! !

!NECVarTypeGuesser methodsFor: 'bytecode decoding' stamp: ''!
typeOfVarIn: aMethod 
	"Answer whether the receiver references an instance variable."
	| scanner end type infos |
	scanner := InstructionStream on: aMethod.
	end := scanner method endPC.
	currentMethod := aMethod.
	infos := OrderedCollection new.
	[ scanner pc <= end ] whileTrue: 
		[ (self interpretNextInstructionUsing: scanner) ifTrue: 
			[ type := self computeVarType.
			type ifNotNil: [ infos add: type ] ] ].
	^ infos! !

!NECVarTypeGuesser methodsFor: 'bytecode decoding' stamp: ''!
pushLiteralVariable: anAssociation 
	"Push Contents Of anAssociation On Top Of Stack bytecode."
	| info |
	contextCount > 0 ifTrue:[^self].

	info := NECTypeInfo definedByMessageSend: anAssociation value.
	types add: info! !

!NECVarTypeGuesser methodsFor: 'bytecode decoding' stamp: ''!
prepare: aCompiledMethod ! !

!NECVarTypeGuesser methodsFor: 'bytecode decoding' stamp: ''!
pushConstant: value 
	"Push Constant, value, on Top Of Stack bytecode."
	| info |
	contextCount > 0 ifTrue: [ ^ self ].
	value ifNotNil: 
		[ info := NECTypeInfo definedByLiteral: value class.
		types add: info ]! !

!NECVarTypeGuesser class methodsFor: 'instance creation' stamp: ''!
variableName: aString class: aClass 
	^self variableName: aString source: nil class: aClass ! !

!NECVarTypeGuesser class methodsFor: 'instance creation' stamp: ''!
variableName: aString source: sourceString class: aClass 
	| newInstance |
	newInstance := self basicNew initialize.
	newInstance 
		setVariableName: aString
		source: sourceString
		class: aClass.
	^ newInstance! !

!NECVarTypeGuesser class methodsFor: 'private' stamp: ''!
getClassFromTypeSuggestingName: aString 
	| firstUppercaseLetter className aStream aClass |
	aStream := WriteStream on: String new.
	aStream nextPut: aString first asUppercase.
	aStream
		nextPutAll: (aString copyFrom: 2 to: aString size).
	className := aStream contents.
	aClass := Smalltalk
				at: className asSymbol
				ifAbsent: [].
	(aClass isKindOf: Class)
		ifTrue: [^ aClass].
	firstUppercaseLetter := aString indexOfFirstUppercaseCharacter.
	className := firstUppercaseLetter > 1
				ifTrue: [aString copyFrom: firstUppercaseLetter to: aString size]
				ifFalse: [^ nil].
	aClass := Smalltalk
				at: className asSymbol
				ifAbsent: [].
	(aClass isKindOf: Class)
		ifTrue: [^ aClass].
	^ nil! !

!NECWorkspaceController commentStamp: '<historical>'!
I'm a specialized controller, that works with Workspaces.!
!NECWorkspaceController methodsFor: 'accessing' stamp: ''!
workspace
	^model! !

!NECWorkspaceController methodsFor: 'accessing' stamp: ''!
additionals
	^ self workspace completionAdditionals! !

!NNavDirection commentStamp: '<historical>'!
I'm the one who knows generalization to navigate an ast tree
I have two concret classes: NavigateInto and NavigateOver!
!NNavDirection class methodsFor: 'stand out' stamp: 'GiselaDecuzzi 5/14/2013 16:31'!
findSelectionFor: navigationContext
	self subclassResponsibility .! !

!NNavDirection class methodsFor: 'private' stamp: 'GiselaDecuzzi 5/13/2013 16:50'!
calculateBestSeletionFor: node beforeSelection: selectionInText step: blockForStep
	| selectionInNode |
	
	node ifNil:[ ^selectionInText ].
	selectionInNode := node start to: node stop.
	^ (selectionInText = selectionInNode )
		ifTrue: [blockForStep value: selectionInText  value: node ]
		ifFalse: [selectionInNode ].! !

!NNavDirectionChild commentStamp: '<historical>'!
I'm the one who knowshow to navigate inside the child nodes!
!NNavDirectionChild class methodsFor: 'stand out' stamp: 'GiselaDecuzzi 5/14/2013 16:26'!
findSelectionFor: navigationContext
	^ self
		calculateBestSeletionFor: (self childNodeFor: navigationContext bestNodeForSelection)
		beforeSelection: navigationContext textSelection
		step: [ :selection :target | self selectionChildrenScope: selection for: target ]! !

!NNavDirectionChild class methodsFor: 'step into' stamp: 'GiselaDecuzzi 5/14/2013 14:18'!
selectionChildrenScope: selected for: node
	| children |

	node ifNil: [ ^selected ].
	children := self childNodeFor: node.
	^children ifNil: [ selected ] ifNotNil: [children start to: children stop]! !

!NNavDirectionChild class methodsFor: 'builder' stamp: 'GiselaDecuzzi 5/14/2013 14:42'!
buildShortcut: aBuilder
	<keymap>
	(aBuilder shortcut: #selectChild)
		category: #SmalltalkEditor
		default: $o command mac | $o ctrl unix | $o ctrl
		do: [ :morph | morph standOutIntoScope ]
		description: 'Select the node choosing the child'! !

!NNavDirectionChild class methodsFor: 'private' stamp: 'GiselaDecuzzi 5/13/2013 15:20'!
askForNodeSelectionFrom: nodes
	
	
	^ UIManager default 
		enterOrRequestFrom: (nodes collect: [:node | (node respondsTo: #selector )ifTrue:[node selector] ifFalse:[node name]])
		values: nodes 
		lines: #() 
		title: 'Which code do you want to select?' translated! !

!NNavDirectionChild class methodsFor: 'private' stamp: 'GiselaDecuzzi 5/7/2013 17:23'!
childNodeFor: node
	"We find the child for a node, if it has not childs nil, if has more than one let the user select the one he wants."
	node ifNil:[^nil].
	^ node children isEmpty
		ifTrue: [ nil ]
		ifFalse: [ 
			node children size = 1
				ifTrue: [node children at: 1]
				ifFalse: [  self  askForNodeSelectionFrom: node children]
		 ]! !

!NNavDirectionFirstChild commentStamp: '<historical>'!
I navigate throw the childs picking allways the firs one!
!NNavDirectionFirstChild class methodsFor: 'builder' stamp: 'GiselaDecuzzi 6/18/2013 11:29'!
buildShortcut: aBuilder
	<keymap>
	(aBuilder shortcut: #firstChild) 
		category: #SmalltalkEditor
		default: self defaultKeyCombination
		do: [ :morph | morph standOutIntoFirstScope]
		description: 'Select the node scope reducing to the first child'


! !

!NNavDirectionFirstChild class methodsFor: 'builder' stamp: 'GiselaDecuzzi 6/19/2013 12:42'!
defaultKeyCombination
	^NNavNavigation useArrowsShortcuts 
		ifTrue: [ Character arrowRight command shift  mac | Character arrowRight ctrl shift ]
		ifFalse: [ $o command shift  mac| $o ctrl shift unix | $o ctrl shift  ]

! !

!NNavDirectionFirstChild class methodsFor: 'private' stamp: 'GiselaDecuzzi 5/14/2013 16:33'!
childNodeFor: node
	"We find the child for a node, if it has not childs nil, if has more than one return the first one."
	node ifNil:[^nil].
	^ node children isEmpty
		ifTrue: [ nil ]
		ifFalse: [ node children at: 1]
! !

!NNavDirectionParent commentStamp: '<historical>'!
I'm the one who knows how to navigate going to the parent node.!
!NNavDirectionParent class methodsFor: 'builder' stamp: 'GiselaDecuzzi 6/19/2013 12:43'!
defaultKeyCombination
	^NNavNavigation useArrowsShortcuts 
		ifTrue: [ Character arrowLeft command shift  mac | Character arrowLeft ctrl shift ]
		ifFalse: [ $p command shift  mac| $p ctrl shift unix | $p ctrl shift  ]

! !

!NNavDirectionParent class methodsFor: 'step over' stamp: 'GiselaDecuzzi 5/7/2013 14:43'!
selectionParentScope: selected for: node
	| nodeSelection |

	node ifNil: [ ^selected ].
	nodeSelection := node start to: node stop.
	selected = nodeSelection
		ifTrue: [ ^self selectionParentScope: selected for: node parent  ]
		ifFalse: [ ^nodeSelection ].! !

!NNavDirectionParent class methodsFor: 'builder' stamp: 'GiselaDecuzzi 6/18/2013 11:38'!
buildShortcut: aBuilder
	<keymap>

	(aBuilder shortcut: #parent)
		category: #SmalltalkEditor
		default: self defaultKeyCombination
		do: [ :morph | morph standOutOverScope ]
		description: 'Select the node scope going to the paren node'


! !

!NNavDirectionParent class methodsFor: 'stand out' stamp: 'GiselaDecuzzi 5/14/2013 16:28'!
findSelectionFor: navigationContext
	^ self
		calculateBestSeletionFor: navigationContext bestNodeForSelection 
		beforeSelection: navigationContext textSelection 
		step: [ :selection :target | self selectionParentScope: selection for: target parent ]! !

!NNavDirectionPreviousBrother commentStamp: '<historical>'!
Go back to the brother before!
!NNavDirectionPreviousBrother class methodsFor: 'builder' stamp: 'GiselaDecuzzi 6/18/2013 11:41'!
buildShortcut: aBuilder
	<keymap>

	(aBuilder shortcut: #previousSibling) 
		category: #SmalltalkEditor 
		default: self defaultKeyCombination 
		do: [ :morph | morph standOutPreviousChild]
		description: 'Select the node scope reducing to the previous sibling'


! !

!NNavDirectionPreviousBrother class methodsFor: 'builder' stamp: 'GiselaDecuzzi 6/19/2013 12:44'!
defaultKeyCombination
	^NNavNavigation useArrowsShortcuts 
		ifTrue: [Character arrowLeft command mac | Character arrowLeft ctrl  ]
		ifFalse: [ $u command mac| $u ctrl unix | $u ctrl  ]
! !

!NNavDirectionPreviousBrother class methodsFor: 'step over' stamp: 'GiselaDecuzzi 5/13/2013 18:07'!
brotherPositionFor: nodePosition brothers: brothers
	^ nodePosition = 1 ifTrue:  [ brothers size ] ifFalse: [ nodePosition - 1 ].! !

!NNavDirectionPreviousSelection commentStamp: '<historical>'!
I know how to go to the previous selection in the text!
!NNavDirectionPreviousSelection class methodsFor: 'builder' stamp: 'GiselaDecuzzi 5/22/2013 09:42'!
buildShortcut: aBuilder
	<keymap>

	(aBuilder shortcut: #previousSelection)
		category: #SmalltalkEditor
		default: $b command shift mac| $b ctrl shift unix | $b ctrl shift 
		do: [ :morph | morph standOutPreviousSelection ]
		description: 'Select the previous selected scope'! !

!NNavDirectionPreviousSelection class methodsFor: 'stand out' stamp: 'GiselaDecuzzi 5/14/2013 15:35'!
findSelectionFor: navigationContext
	^ navigationContext lastSelection ! !

!NNavDirectionSibling commentStamp: '<historical>'!
I'm the one who knows how to navigate in an horizontal way visiting node in the same level statin from left to right !
!NNavDirectionSibling class methodsFor: 'step over' stamp: 'GiselaDecuzzi 5/13/2013 18:07'!
brotherNodeFor: node
"Finds the next brother for the node"
	| brothers nodePosition nextBrotherPosition |

	node ifNil: [ ^nil ].
	node parent ifNil: [ ^nil ]. "no parent you are orphan"
	brothers := node parent children.
	nodePosition := (brothers indexOf: node) .
	nextBrotherPosition := self brotherPositionFor: nodePosition brothers: brothers .
	^ brothers at: nextBrotherPosition.
! !

!NNavDirectionSibling class methodsFor: 'builder' stamp: 'GiselaDecuzzi 6/19/2013 12:44'!
defaultKeyCombination
	^NNavNavigation useArrowsShortcuts 
		ifTrue: [ Character arrowRight command mac | Character arrowRight ctrl  ]
		ifFalse: [ $u command shift  mac| $u ctrl shift unix | $u ctrl shift  ]! !

!NNavDirectionSibling class methodsFor: 'step over' stamp: 'GiselaDecuzzi 5/13/2013 17:28'!
brotherPositionFor: nodePosition brothers: brothers
	^ nodePosition = brothers size ifTrue:  [ 1 ] ifFalse: [ nodePosition + 1 ].
! !

!NNavDirectionSibling class methodsFor: 'builder' stamp: 'GiselaDecuzzi 6/18/2013 11:40'!
buildShortcut: aBuilder
	<keymap>

	(aBuilder shortcut: #sibling)
		category: #SmalltalkEditor
		default: self defaultKeyCombination 
		do: [ :morph | morph standOutHorizontalScope]
		description: 'Select the node going to the siblings'


! !

!NNavDirectionSibling class methodsFor: 'step over' stamp: 'GiselaDecuzzi 5/13/2013 17:03'!
selectionBrotherScope: selected for: node
	| brother |

	node ifNil: [ ^selected ].
	brother := self brotherNodeFor:  node.
	^brother ifNil:[nil] ifNotNil: [ brother start to: brother stop].! !

!NNavDirectionSibling class methodsFor: 'stand out' stamp: 'GiselaDecuzzi 5/14/2013 16:27'!
findSelectionFor: navigationContext
	^ self
		calculateBestSeletionFor: (self brotherNodeFor: navigationContext bestNodeForSelection )
		beforeSelection: navigationContext textSelection 
		step: [ :selection :target | self selectionBrotherScope: selection for: target ]! !

!NNavNavigateTest commentStamp: '<historical>'!
I tests the navigations directions!
!NNavNavigateTest methodsFor: 'sibling-prev' stamp: 'GiselaDecuzzi 5/14/2013 16:09'!
testNextBrotherWhenItsTheFirstItsTheLast
	| bigBrother middleBrother littleBrother brother parent |
	
	parent := RBSequenceNode new.
	bigBrother := RBVariableNode named: 'big'. 
	parent addNode: bigBrother.
	
	middleBrother := RBVariableNode named: 'middle'. 
	parent addNode: middleBrother.
	
	littleBrother := RBVariableNode named: 'little'.
	parent addNode: littleBrother.
	
	brother := NNavDirectionPreviousBrother brotherNodeFor: bigBrother.
	self assert: brother equals: littleBrother .! !

!NNavNavigateTest methodsFor: 'sibling-prev' stamp: 'GiselaDecuzzi 5/14/2013 16:10'!
testNotPreviousBrotherWhenOrphan
	| orphanNode brother |
	
	orphanNode := RBVariableNode named: 'roque'.
	brother := NNavDirectionPreviousBrother  brotherNodeFor: orphanNode.
	self assert: brother isNil.! !

!NNavNavigateTest methodsFor: 'sibling-prev' stamp: 'GiselaDecuzzi 5/14/2013 16:07'!
testNextBrotherItsThePreviousOfTheChilds
	| bigBrother middleBrother littleBrother brother parent |
	
	parent := RBSequenceNode new.
	bigBrother := RBVariableNode named: 'big'. 
	parent addNode: bigBrother.
	
	middleBrother := RBVariableNode named: 'middle'. 
	parent addNode: middleBrother.
	
	littleBrother := RBVariableNode named: 'little'.
	parent addNode: littleBrother.
	
	brother := NNavDirectionPreviousBrother brotherNodeFor: middleBrother .
	self assert: brother equals: bigBrother  .
	
! !

!NNavNavigateTest methodsFor: 'sibling' stamp: 'GiselaDecuzzi 5/14/2013 16:09'!
testNotBrotherWhenOrphan
	| orphanNode brother |
	
	orphanNode := RBVariableNode named: 'roque'.
	brother := NNavDirectionPreviousBrother brotherNodeFor: orphanNode.
	self assert: brother isNil.! !

!NNavNavigateTest methodsFor: 'children' stamp: 'GiselaDecuzzi 5/13/2013 17:45'!
testNextChildWhenHasChildsIsTheBiggerOne
	| bigBrother littleBrother child parentRenamed |
	
	parentRenamed := RBSequenceNode new.
	bigBrother := RBVariableNode named: 'pp'. 
	parentRenamed addNode: bigBrother.
	
	littleBrother := RBVariableNode named: 'roque'.
	parentRenamed addNode: littleBrother.
	
	child := NNavDirectionFirstChild childNodeFor:  parentRenamed .
	self assert: child equals: bigBrother .! !

!NNavNavigateTest methodsFor: 'sibling' stamp: 'GiselaDecuzzi 5/13/2013 17:45'!
testSameNodeIsTheBrotherWhenOnlyChild
	| uniqueChildNode brother parent |
	
	parent := RBSequenceNode new.
	uniqueChildNode := RBVariableNode named: 'roque'.
	parent addNode: uniqueChildNode.
	
	self assert: uniqueChildNode parent equals: parent.
	self assert: parent children size equals: 1.
	
	brother := NNavDirectionSibling brotherNodeFor: uniqueChildNode.
	self assert: brother equals: uniqueChildNode .! !

!NNavNavigateTest methodsFor: 'sibling' stamp: 'GiselaDecuzzi 5/13/2013 17:45'!
testNextBrotherItsTheNextOfTheChilds
	| bigBrother littleBrother brother parent |
	
	parent := RBSequenceNode new.
	bigBrother := RBVariableNode named: 'pp'. 
	parent addNode: bigBrother.
	
	littleBrother := RBVariableNode named: 'roque'.
	parent addNode: littleBrother.
	
	brother := NNavDirectionSibling brotherNodeFor: bigBrother .
	self assert: brother equals: littleBrother  .
	
! !

!NNavNavigateTest methodsFor: 'sibling' stamp: 'GiselaDecuzzi 5/13/2013 17:45'!
testNextBrotherWhenItsTheLasItsTheFirst
	| bigBrother littleBrother brother parent |
	
	parent := RBSequenceNode new.
	bigBrother := RBVariableNode named: 'pp'. 
	parent addNode: bigBrother.
	
	littleBrother := RBVariableNode named: 'roque'.
	parent addNode: littleBrother.
	
	brother := NNavDirectionSibling brotherNodeFor: littleBrother.
	self assert: brother equals: bigBrother .! !

!NNavNavigateTest methodsFor: 'children' stamp: 'GiselaDecuzzi 5/13/2013 17:45'!
testNextChildWhenItHasNotChildsItIsNil
	| child parent |
	
	parent := RBSequenceNode new.
	
	child := NNavDirectionFirstChild childNodeFor:  parent .
	self assert: child isNil .! !

!NNavNavigation commentStamp: '<historical>'!
I'm the one who manage the navigation and I have memory from what I've been navigating!
!NNavNavigation methodsFor: 'current-context' stamp: 'GiselaDecuzzi 5/14/2013 15:11'!
textSelection 
	^ self textArea selectionInterval! !

!NNavNavigation methodsFor: 'private' stamp: 'GiselaDecuzzi 5/14/2013 16:02'!
updateState: newSelection

	newSelection = currentSelection ifFalse: [ lastSelection := currentSelection].
	currentSelection := newSelection.
	currentEditor := nil.
	! !

!NNavNavigation methodsFor: 'current-context' stamp: 'GiselaDecuzzi 5/14/2013 15:14'!
bestNodeForSelection
	| root |
	
	currentEditor isWorkspace 
		ifTrue: [root := RBParser parseFaultyExpression: self currentText]
		ifFalse:  [root := RBParser parseFaultyMethod: self currentText]. 
	^ root bestNodeFor: self textSelection .	! !

!NNavNavigation methodsFor: 'current-context' stamp: 'GiselaDecuzzi 5/30/2013 13:55'!
textArea
	^ currentEditor sourceTextArea ! !

!NNavNavigation methodsFor: 'accessing' stamp: 'GiselaDecuzzi 5/14/2013 15:35'!
lastSelection
	^ lastSelection! !

!NNavNavigation methodsFor: 'current-context' stamp: 'GiselaDecuzzi 5/14/2013 15:10'!
currentText
	^ self textArea text! !

!NNavNavigation methodsFor: 'navigation' stamp: 'MarcusDenker 7/26/2014 13:07'!
navigate: editor direction: direction
	| newSelection |

	currentEditor  := editor.
	newSelection := direction findSelectionFor: self.
	newSelection ifNil: [ ^self ].
	self textArea selectFrom: newSelection first to: newSelection last.
	self updateState: newSelection .

! !

!NNavNavigation class methodsFor: 'configuration' stamp: 'GiselaDecuzzi 6/18/2013 11:28'!
useArrowsShortcuts: enable
	UseArrowsShortcuts := enable.
	KMRepository reset.
! !

!NNavNavigation class methodsFor: 'instance creation' stamp: 'GiselaDecuzzi 5/13/2013 16:10'!
new
	"yes I'm a singleton"
	Instance ifNil: [Instance := super new].
	^Instance. ! !

!NNavNavigation class methodsFor: 'configuration' stamp: 'StephaneDucasse 11/11/2014 18:45'!
enableAstHighlightSetting: aBuilder 
	<systemsettings>
	(aBuilder setting: #useArrowsShortcuts) 
		label: 'AST navigation';
		parent: #codeBrowsing; 
		target: NNavNavigation  ;
		description: 'When selected the shortcuts for node navigation use arrows'
! !

!NNavNavigation class methodsFor: 'configuration' stamp: 'GiselaDecuzzi 6/18/2013 11:32'!
useArrowsShortcuts
	^UseArrowsShortcuts ifNil: [ false ]
! !

!NOCCompletionTable commentStamp: '<historical>'!
I keep track of symbols to be retrieved in ocompletion algorithm. 
Unlike ecompletion, I learn something and try to retrieve users last occurences of typing sequences first, then the system symbols which match. 

TODO remove stupid symbols (like packages and method extensions and timestamp)!
!NOCCompletionTable methodsFor: 'accessing' stamp: 'EstebanLorenzano 4/12/2012 11:20'!
listsForPrefix: aString 
	|  prefixes |
	aString isEmpty ifTrue: [^ Array with: (NOCEntryList ofSize: numberofEntries)].
	prefixes := OrderedCollection with: aString first asLowercase asString.
	 
	aString size > 1 
			ifTrue: [prefixes add: ((aString first: 2) collect: [:e | e asLowercase])].
	^ prefixes collect: [:prefix | table 
		at: prefix
		ifAbsentPut: [ NOCEntryList ofSize: numberofEntries ]]! !

!NOCCompletionTable methodsFor: 'accessing' stamp: 'rr 4/10/2009 12:11'!
fillRate
	^ self totalNumberOfEntries / self maxNumberOfEntries ! !

!NOCCompletionTable methodsFor: 'accessing' stamp: 'rr 4/9/2009 17:42'!
entriesPerPrefix: n
	numberofEntries := n! !

!NOCCompletionTable methodsFor: 'protocol' stamp: 'rr 4/15/2009 10:52'!
addEntry: aString date: d 
	| lists |
	lists := self listsForPrefix: aString.
	lists do: [:e | e
		addEntry: aString
		date: d] ! !

!NOCCompletionTable methodsFor: 'accessing' stamp: 'rr 4/10/2009 11:21'!
reset
	table := Dictionary new.! !

!NOCCompletionTable methodsFor: 'protocol' stamp: 'MarcusDenker 7/15/2012 13:47'!
quickFillWithCategoryOf: cls
	(Smalltalk organization classesInCategory: cls theNonMetaClass category) do: [:e | self quickFillWithClass: e]! !

!NOCCompletionTable methodsFor: 'protocol' stamp: 'ul 11/6/2010 06:35'!
compiled: selector in: class date: date

	| method |
	self addEntry: selector date: date.
	self class classes addEntry: class theNonMetaClass name date: date.
	(class canUnderstand: selector) ifFalse: [ ^self ].
	method := class compiledMethodAt: selector ifAbsent: [ ^self ].
	method messages do: [ :m | self  addEntry: m date: date ].
	method literals do: [ :each |
		(each isVariableBinding and: [
			each key notNil and: [
				each key first isUppercase ] ])
					ifTrue: [ 
						self class classes addEntry: each key date: date ] ]! !

!NOCCompletionTable methodsFor: 'protocol' stamp: 'rr 4/9/2009 17:55'!
addEntry: aString 
	| d |
	d := DateAndTime now.
	self 
		addEntry: aString
		date: d! !

!NOCCompletionTable methodsFor: 'protocol' stamp: 'rr 4/16/2009 12:01'!
justCompiled: selector in: class 
	| date |
	date := DateAndTime now.
	self 
		compiled: selector
		in: class
		date: date! !

!NOCCompletionTable methodsFor: 'accessing' stamp: 'rr 4/10/2009 12:10'!
maxNumberOfEntries
	^ 26 * 26 * numberofEntries ! !

!NOCCompletionTable methodsFor: 'initialization' stamp: 'rr 4/9/2009 17:45'!
initialize
	table := Dictionary new.! !

!NOCCompletionTable methodsFor: 'accessing' stamp: 'EstebanLorenzano 4/12/2012 11:20'!
listForPrefix: aString 
	| prefix |
	aString isEmpty ifTrue: [^ NOCEntryList ofSize: numberofEntries].
	prefix := aString size = 1 
			ifTrue: [ aString first asLowercase asString] 
			ifFalse: [(aString first: 2) collect: [:e | e asLowercase]].
			
	^ table 
		at: prefix
		ifAbsentPut: [ NOCEntryList ofSize: numberofEntries ]! !

!NOCCompletionTable methodsFor: 'protocol' stamp: 'rr 5/28/2009 14:10'!
quickFillWithClass: cls
	cls methodsDo: [:e | self justCompiled: e selector in: cls]
	! !

!NOCCompletionTable methodsFor: 'protocol' stamp: 'MarcusDenker 7/15/2012 13:48'!
quickFillWithCategoriesMatching: pattern
	(Smalltalk organization categoriesMatching: pattern) do: [:category | 
		(Smalltalk organization classesInCategory: category) do: [:e | self quickFillWithClass: e]]! !

!NOCCompletionTable methodsFor: 'accessing' stamp: 'rr 4/9/2009 17:49'!
totalNumberOfEntries
	^ table inject: 0 into: [:total :list | total + list numEntries]! !

!NOCCompletionTable methodsFor: 'accessing' stamp: 'rr 4/9/2009 17:46'!
numberOfEntries
	^ numberofEntries! !

!NOCCompletionTable methodsFor: 'accessing' stamp: 'rr 4/17/2009 14:14'!
entriesMatching: prefix
	| list |
	
	list := self listForPrefix: prefix.
	^ list entriesMatching: prefix! !

!NOCCompletionTable class methodsFor: 'class initialization' stamp: 'BernardoContreras 10/14/2014 20:12'!
initialize
	SystemAnnouncer uniqueInstance 
		unsubscribe: self;
		when: MethodAdded, MethodModified 
			send: #methodChanged: 
			to: self.
	Smalltalk addToShutDownList: self.! !

!NOCCompletionTable class methodsFor: 'instance creation' stamp: 'rr 4/14/2009 17:13'!
default
	^ table ifNil: [table := self new entriesPerPrefix: 40]! !

!NOCCompletionTable class methodsFor: 'system startup' stamp: 'MarcusDenker 11/14/2012 13:39'!
shutDown
	self reset! !

!NOCCompletionTable class methodsFor: 'events' stamp: 'GuillermoPolito 8/3/2012 14:44'!
methodChanged: event
	self default totalNumberOfEntries < 200 ifTrue: [self default quickFillWithCategoryOf: event methodClass].
	self default totalNumberOfEntries < 500 ifTrue: [self default quickFillWithClass: event methodClass].
	self default justCompiled: event selector in: event methodClass.! !

!NOCCompletionTable class methodsFor: 'instance creation' stamp: 'MarcusDenker 11/14/2012 13:33'!
reset
	classTable := nil.
	table := nil.! !

!NOCCompletionTable class methodsFor: 'accessing' stamp: 'CamilloBruni 8/4/2012 01:05'!
classes
	^ classTable ifNil: [classTable := self new entriesPerPrefix: 40]! !

!NOCCompletionTable class methodsFor: 'cleanup' stamp: 'MarcusDenker 11/14/2012 13:37'!
cleanUp
	self reset.! !

!NOCContext commentStamp: '<historical>'!
I keep the context of the ocompletion. 
I do the same as my parent but for this specific algorithm!
!NOCContext methodsFor: 'model creation' stamp: 'CamilloBruni 8/5/2012 23:55'!
createModel
	| aModel |
	
	aModel := NOCModel
		class: theClass
		temporaries: self temporaries
		additionals: controller additionals
		variables: variables
		selectors: selectors.
	aModel
		context: self.
		
	^ aModel ! !

!NOCContext methodsFor: 'model creation' stamp: 'EstebanLorenzano 2/1/2013 17:50'!
nextModel 
	"Provide a next lookup model. 
	 It is defining a chain of responsibility, translating the model to eCompletion, to ensure having results"
	^ super createModel! !

!NOCController commentStamp: '<historical>'!
I am the entrance door to the ocompletion algorithm. 
I can resolve the queried sequences and retrieve a list of answers according to ocompletion algorithm based on the last accepted sequences from the user.
!
!NOCController methodsFor: 'private' stamp: 'CamilloBruni 8/5/2012 23:16'!
menuMorphClass
	^ NOCMenuMorph! !

!NOCController methodsFor: 'private' stamp: 'EstebanLorenzano 4/12/2012 11:17'!
contextClass
	^NOCContext! !

!NOCDatedEntry commentStamp: '<historical>'!
I keep a symbol entry, along with the last time it was used in the system. 
I am used to sort the possible answers.!
!NOCDatedEntry methodsFor: 'accessing' stamp: 'ul 9/27/2010 05:08'!
unlink

	next previous: previous.
	previous next: next! !

!NOCDatedEntry methodsFor: 'accessing' stamp: 'rr 4/9/2009 15:32'!
now
	date := DateAndTime now! !

!NOCDatedEntry methodsFor: 'accessing' stamp: 'rr 2/21/2009 11:49'!
date
	^ date! !

!NOCDatedEntry methodsFor: 'accessing' stamp: 'ul 9/27/2010 05:07'!
next

	^next! !

!NOCDatedEntry methodsFor: 'accessing' stamp: 'ul 9/27/2010 05:07'!
previous

	^previous! !

!NOCDatedEntry methodsFor: 'accessing' stamp: 'ul 9/27/2010 05:38'!
matches: pref

	^contents beginsWithEmpty: pref caseSensitive: false! !

!NOCDatedEntry methodsFor: 'accessing' stamp: 'ul 9/27/2010 05:08'!
next: anODatedEntry

	next := anODatedEntry! !

!NOCDatedEntry methodsFor: 'accessing' stamp: 'rr 4/9/2009 15:38'!
date: d
	date := d! !

!NOCDatedEntry methodsFor: 'accessing' stamp: 'ul 9/27/2010 05:12'!
link: anODatedEntry
	"Link the given entry after me."

	anODatedEntry
		next: next;
		previous: self.
	next previous: anODatedEntry.
	next := anODatedEntry! !

!NOCDatedEntry methodsFor: 'accessing' stamp: 'ul 9/27/2010 05:08'!
previous: anODatedEntry

	previous := anODatedEntry! !

!NOCDatedEntry methodsFor: 'operations' stamp: 'rr 2/21/2009 11:49'!
<= anEntry
	^ date = anEntry date 
		ifTrue: [contents <= anEntry contents]
		ifFalse: [date > anEntry date]! !

!NOCEmptyModel commentStamp: '<historical>'!
I implement a null object pattern related to NOCModel in order to mark the end of possible completions in the answer list. 

!
!NOCEmptyModel methodsFor: 'accessing' stamp: 'rr 4/17/2009 14:26'!
narrowString: string! !

!NOCEmptyModel methodsFor: 'accessing' stamp: 'rr 4/17/2009 14:27'!
entryCount 
	^ 0! !

!NOCEmptyModel methodsFor: 'accessing' stamp: 'rr 4/14/2009 16:47'!
entries
	^ Array new! !

!NOCEmptyModel methodsFor: 'accessing' stamp: 'rr 4/17/2009 14:26'!
narrowWith: string 
! !

!NOCEntryList commentStamp: '<historical>'!
I am the list of entries (possible symbols) returned by nocompletion algorithm.

I am sorted according to last acceptance from the user.!
!NOCEntryList methodsFor: 'accessing' stamp: 'ul 9/27/2010 05:31'!
firstEntry
	^ entryHead previous! !

!NOCEntryList methodsFor: 'accessing' stamp: 'rr 4/9/2009 16:14'!
last
	^self lastEntry contents! !

!NOCEntryList methodsFor: 'accessing' stamp: 'EstebanLorenzano 4/12/2012 11:21'!
setSize: n
	size := n.
	entries := Dictionary new: n.
	entryHead := NOCDatedEntry contents: #'' size type: #selector.
	entryHead
		next: entryHead;
		previous: entryHead.
	
	! !

!NOCEntryList methodsFor: 'accessing' stamp: 'rr 4/9/2009 16:14'!
first
	^self firstEntry contents! !

!NOCEntryList methodsFor: 'adding' stamp: 'EstebanLorenzano 4/12/2012 11:21'!
addEntry: aSymbol date: aDate

	| entry currentEntry |
	entry := entries at: aSymbol ifAbsent: nil.
	entry 
		ifNotNil: [ entry unlink ]
		ifNil: [ 
			entry := NOCDatedEntry contents: aSymbol type: #selector.
			entries at: aSymbol put: entry ].
	entry date: aDate.
	currentEntry := entryHead previous.
	[ currentEntry == entryHead or: [
		currentEntry date <= aDate ] ] whileFalse: [
			currentEntry := currentEntry previous ].
	currentEntry link: entry.
	entries size > size ifTrue: [
		entry := entryHead next unlink.
		entries removeKey: entry contents ]! !

!NOCEntryList methodsFor: 'accessing' stamp: 'ul 9/27/2010 05:31'!
lastEntry
	^ entryHead next! !

!NOCEntryList methodsFor: 'accessing' stamp: 'rr 2/21/2009 11:46'!
numEntries
	^ entries size! !

!NOCEntryList methodsFor: 'adding' stamp: 'rr 4/9/2009 16:06'!
addEntry: aSymbol
	self addEntry: aSymbol date: DateAndTime now! !

!NOCEntryList methodsFor: 'accessing' stamp: 'ul 9/29/2010 18:56'!
entriesMatching: prefix
	
	^Array new: entries size // 4 + 1 streamContents: [ :stream |
		| entry |
		entry := self firstEntry.
		[ entry == entryHead ] whileFalse: [
			(entry matches: prefix) ifTrue: [ stream nextPut: entry ].
			entry := entry previous ] ]! !

!NOCEntryList class methodsFor: 'instance creation' stamp: 'rr 2/21/2009 11:44'!
ofSize: n 
	^ self new setSize: n; yourself! !

!NOCMenuMorph commentStamp: '<historical>'!
I am a morphic item used to show ocompletion entries. !
!NOCMenuMorph methodsFor: 'accessing' stamp: 'rr 4/15/2009 15:32'!
height
	^ 7! !

!NOCMenuMorph methodsFor: 'actions' stamp: 'rr 6/26/2009 11:33'!
narrowCompletion
	| model |
	
	self selected: 0.
	firstVisible := 1.
	model := context model.
	model narrowWith: context completionToken.
	model notEmpty ifTrue: [self selected: 1].
	model entries size < self selected ifTrue: [self selected: model entries size].
	self show.
	^ true! !

!NOCModel commentStamp: '<historical>'!
I keep the state of the ocompletion algorithm. 
See comments of my parents for details. !
!NOCModel methodsFor: 'accessing' stamp: 'MarcusDenker 10/5/2013 19:28'!
entries
	entries ifEmpty: [ self loadEntries ].
	^  entries! !

!NOCModel methodsFor: 'accessing' stamp: 'EstebanLorenzano 4/12/2012 11:20'!
noNextModel
	nextModel := NOCEmptyModel new.! !

!NOCModel methodsFor: 'accessing' stamp: 'CamilloBruni 8/5/2012 23:55'!
context: aNOCContext
	context := aNOCContext.! !

!NOCModel methodsFor: 'accessing' stamp: 'CamilloBruni 8/5/2012 23:33'!
contract
	expand := true.
	nextModel := nil.! !

!NOCModel methodsFor: 'private' stamp: 'CamilloBruni 8/7/2012 11:50'!
loadFavoredEntries
	
	(narrowString notEmpty and: [narrowString first isUppercase]) 
			ifTrue: [ ^ classTable entriesMatching: narrowString ].
					
	includeSelectors 
		ifTrue: [ ^ table entriesMatching: narrowString ]
		ifFalse: [ ^ #() ].! !

!NOCModel methodsFor: 'initialize-release' stamp: 'rr 4/14/2009 13:56'!
initializeSelectors! !

!NOCModel methodsFor: 'accessing' stamp: 'RomainRobbes 8/2/2010 17:56'!
entryCount
	^ self entries size! !

!NOCModel methodsFor: 'accessing' stamp: 'CamilloBruni 8/3/2012 21:26'!
tableForEntry: ent
	^ (ent notEmpty and: [ent first isUppercase]) 
			ifTrue: [classTable]
			ifFalse: [table]! !

!NOCModel methodsFor: 'accessing' stamp: 'EstebanLorenzano 4/12/2012 11:17'!
useUniqueTable
	table := NOCCompletionTable new entriesPerPrefix: 20.
	! !

!NOCModel methodsFor: 'accessing' stamp: 'rr 5/28/2009 11:29'!
addEntry: ent
	(self tableForEntry: ent) addEntry: ent ! !

!NOCModel methodsFor: 'accessing' stamp: 'rr 4/14/2009 13:56'!
addSelectors
	! !

!NOCModel methodsFor: 'accessing' stamp: 'MarcusDenker 12/2/2013 14:07'!
narrowWith: aString
	self narrowString: aString.
	self loadEntries.
	self nextModel ifNotNil: [:nm | nm narrowWith: aString].! !

!NOCModel methodsFor: 'accessing' stamp: 'CamilloBruni 8/6/2012 12:58'!
nextModel
	^ nextModel ifNil: [
		nextModel := context nextModel. 
		nextModel narrowWith: narrowString.
		nextModel ].! !

!NOCModel methodsFor: 'initialization' stamp: 'CamilloBruni 8/3/2012 21:26'!
initialize
	super initialize.
	self contract.
	table := NOCCompletionTable default.
	classTable := NOCCompletionTable classes.! !

!NOCModel methodsFor: 'private' stamp: 'CamilloBruni 8/7/2012 12:32'!
sortByLastRecentlyUsed: lastRecentlyUsedEntries
	"Sort my entrys by the most recently used date"
	| lastRecentlyUsed |
	
	lastRecentlyUsed := Dictionary new.
	
	lastRecentlyUsedEntries do: [ :entry|
		lastRecentlyUsed at: entry contents put: entry date asSeconds ].
	
	entries sort: [ :a :b|| dateA dateB|
		dateA := lastRecentlyUsed at: a contents asString ifAbsent: [ 0 ].
		dateB := lastRecentlyUsed at: b contents asString ifAbsent: [ 0 ].
		dateA >= dateB].! !

!NOCModel methodsFor: 'accessing' stamp: 'damiencassou 7/27/2009 14:22'!
at: aNumber
	
	^ self entries at: (aNumber max: 1) ! !

!NOCModel methodsFor: 'accessing' stamp: 'CamilloBruni 8/6/2012 00:01'!
title
	^ self nextModel title! !

!NOCModel methodsFor: 'private' stamp: 'CamilloBruni 8/7/2012 11:51'!
loadNextModelEntries
	entries := self nextModel entries ! !

!NOCModel methodsFor: 'accessing' stamp: 'rr 4/15/2009 13:28'!
expand
	expand := true.! !

!NOCModel methodsFor: 'accessing' stamp: 'rr 4/14/2009 13:46'!
table
	^ table! !

!NOCModel methodsFor: 'accessing' stamp: 'EstebanLorenzano 2/1/2013 16:01'!
completionAt: aNumber
	"when an entry is selected, update its date (for inlined messages which do not appear in the method's body"
	| entry |
	
	entry := (self at: aNumber) completion.
	self addEntry: entry.
	
	^ NECPreferences spaceAfterCompletion 
		ifTrue: [ entry separateKeywords, ' ' ]
		ifFalse: [ entry separateKeywords ].! !

!NOCModel methodsFor: 'private' stamp: 'CamilloBruni 8/7/2012 12:25'!
loadEntries
	| priorityEntries  |
	"entries used from the last recently used"
	priorityEntries := 6.
	self loadNextModelEntries.
	
	entries size <= priorityEntries
		ifTrue: [ ^ self ].
		
	"most recently used entries first!!"
	self sortByLastRecentlyUsed: self loadFavoredEntries.
		
	"sort the rest alphabetically"
	entries 
		mergeSortFrom: priorityEntries
		to: entries size 
		by: [ :a :b| 
			(a contents asString compare: b contents asString caseSensitive: false) <= 2 ]! !

!NaNException commentStamp: 'SvenVanCaekenberghe 4/15/2011 16:41'!
I am NaNException, an ArithmeticException signaled when Float nan was encountered where it was not allowed. !
!NameLookupFailure commentStamp: 'mir 5/12/2003 18:16'!
Signals that a name lookup operation failed.

	hostName	hostName for which the name loopup failed
!
!NameLookupFailure methodsFor: 'accessing' stamp: 'len 12/14/2002 11:57'!
hostName: aString
	hostName := aString! !

!NameLookupFailure methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/14/2013 19:59'!
standardMessageText
	"Generate a standard textual description"

	^ String
		streamContents: [ :stream | 
			stream << 'cannot resolve '.
			stream print: self hostName ]! !

!NameLookupFailure methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/14/2013 19:59'!
messageText
	"Overwritten to initialiaze the message text to a standard text if it has not yet been set"

	^ messageText ifNil: [ messageText := self standardMessageText ]! !

!NameLookupFailure methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/14/2013 20:04'!
defaultAction
	"Backward compatibility"

	| response |
	response := UIManager default chooseFrom: #('Retry' 'Give Up') title: self printString.
	^ response = 2
		ifTrue: [ super defaultAction ]
		ifFalse: [ self retry ]! !

!NameLookupFailure methodsFor: 'accessing' stamp: 'len 12/14/2002 11:57'!
hostName
	^ hostName! !

!NameLookupFailure class methodsFor: 'instance creation' stamp: 'len 12/14/2002 11:57'!
hostName: aString
	^ self new hostName: aString! !

!NameLookupFailure class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 1/14/2013 19:58'!
signalFor: hostName
	"Create and signal a NameLookupFailure for hostName"

	^ (self hostName: hostName) signal! !

!NameStringInHalo methodsFor: 'drawing' stamp: 'BenComan 4/17/2014 21:31'!
drawOn: aCanvas
	aCanvas fillRectangle: self bounds color: Color white.
	super drawOn: aCanvas.! !

!NativeBoost commentStamp: '<historical>'!
i am a core class, which provides a common functionality, 
required by many NativeBoost facilities to function, including:

- basic memory operations
- external roots registry
- call gate function
- session management

Every new session, i using an unique instance,
which is platform specific (see my subclasses).

To access a current session instance, you can issue:

NativeBoost forCurrentPlatform

!
!NativeBoost methodsFor: 'memory access' stamp: 'Igor.Stasenko 5/3/2010 10:31'!
ulongAt: ulongAddr

	| buf |
	
	buf := ByteArray new: 8.
	
	self ulongAt: ulongAddr into: buf.
	
	^ buf unsignedLongAt: 1 bigEndian: false! !

!NativeBoost methodsFor: 'retrieving symbols' stamp: 'IgorStasenko 11/24/2012 15:58'!
loadModule: aModuleName
	" call an interpreter proxy function 
		void* ioLoadModuleOfLength(char*, int)
	to retrieve an external module handle
	
	if module can't be loaded, or not found , answer 0
	"
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout
			options: #(- optAllowExternalAddressPtr);
			function: #( ulong (char* aModuleName, NBByteArraySize aModuleName ))
			emit: [:gen |
				gen proxy callFn: #ioLoadModule:OfLength: .
			] 
! !

!NativeBoost methodsFor: 'memory operations' stamp: 'Igor.Stasenko 9/25/2010 10:03'!
allocate: aSize
	"Allocate a memory block with given size in bytes,
	answer an NBExternalAddress instance - address to the beginning of memory block"
	
	" DO NOT OVERRIDE. Override #basicAllocate: instead"
	| addr |
	addr := self basicAllocate: aSize.
	addr ifNil: [ self allocationFailed ].
	^ addr! !

!NativeBoost methodsFor: 'memory operations' stamp: 'Igor.Stasenko 9/26/2010 04:12'!
free: address

	"Free the external memory, allocated using #allocate: message.
	Note: never pass pointers, which you allocated by other means"
	
	self subclassResponsibility ! !

!NativeBoost methodsFor: 'retrieving symbols' stamp: 'IgorStasenko 7/1/2013 11:04'!
ioLoadModule: aModuleName
	" call an interpreter proxy function 
		void* ioLoadModuleOfLength(char*, int)
	to retrieve an external module handle
	
	if module can't be loaded, or not found , answer nil
	"
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ NBNativeCodeGen methodAssembly: [:gen |
		| fail retHandle proxy asm moduleNameOop end |
		moduleNameOop := gen reserveTemp.
		asm := gen asm.
		proxy := gen proxy.
		fail := asm uniqueLabelName: 'failed'.
		retHandle := asm uniqueLabelName: 'retHandle'.
		end := asm uniqueLabelName: 'end'.
		
		proxy stackValue: 0.
		asm mov: EAX to: moduleNameOop.
		proxy isBytes: EAX.
		asm or: EAX with: EAX.
		asm jz: fail.
		proxy byteSizeOf: moduleNameOop.
		asm push: EAX.   " push length "
	
		proxy varBytesFirstFieldOf: moduleNameOop.
		asm push: EAX. "push first indexable field address"
		
		proxy callFn: #ioLoadModule:OfLength: .
		asm 
			or: EAX with: EAX;
			jnz: retHandle.
			
		proxy nilObject.
		asm jmp: end.
		
	asm label: retHandle.
		proxy signed32BitIntegerFor: EAX.
		asm jmp: end.
		
	asm label: fail.
		proxy primitiveFail.
	asm label: end.
		gen epilogue
	]
! !

!NativeBoost methodsFor: 'bootstrapping' stamp: 'Igor.Stasenko 5/2/2010 14:01'!
initializeExternalHeap
	
	"create and initialize a new instance of external memory heap"
	self subclassResponsibility! !

!NativeBoost methodsFor: 'callback support' stamp: 'cipt 11/3/2012 18:28'!
insideCallback
	bootstrapping ifTrue: [ ^ false ].
	^ (callbackCounterAddr nbInt32AtOffset:  0) ~= 0! !

!NativeBoost methodsFor: 'retrieving symbols' stamp: 'JavierPimas 9/27/2011 14:47'!
VMModule
	"answer a C library path, or module handle,
	use in FFI callouts as module: argument to call C run-time library function(s)"
	
	self subclassResponsibility ! !

!NativeBoost methodsFor: 'memory operations' stamp: 'Igor.Stasenko 5/3/2010 11:03'!
allocationFailed

	self error: 'Memory allocation failed'! !

!NativeBoost methodsFor: 'memory operations' stamp: 'IgorStasenko 12/6/2012 14:43'!
memCopy: src to: dst size: numBytes
	"Copy the numBytes from src to dst memory buffer.

	src & dst can be either a variable-byte oop or NBExternalAddress instance.
	
	Warning!!!! Warning!!!! Warning!!!! 
	This is a direct memory accees!!!!!! No range checking!!!!!!
	"
	
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout
		options: #( + optAllowByteArraysPtr optAllowExternalAddressPtr);
	 	function: #( void (byte * src, byte * dst, ulong numBytes))
		emit: [:gen |
			| asm temp1 temp2 |
			asm := gen asm.
			temp1 := gen reserveTemp.
			temp2 := gen reserveTemp.

			asm
				cld;
				mov: ESI to: temp1;
				mov: EDI to: temp2;
			
				pop: ESI; " src"
				pop: EDI; "dst"
				pop: ECX; "numBytes"
				rep; movsb;
				mov: temp1 to: ESI;
				mov: temp2 to: EDI
		]! !

!NativeBoost methodsFor: 'memory access' stamp: 'IgorStasenko 11/24/2012 16:01'!
ulongAt: addr into: returnValueBuffer

	"read uint from given address"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>

	^ self nbCallout
		" do not use optimizations, since it may lead to infinite resursion"
		options: #( - optDirectProxyFnAddress optUseStackPointer + optNoAlignment);
		function: #( NBBootstrapUlong (ulong addr))
		emit: [:gen | |asm|
			asm := gen asm.
			asm pop: asm EAX.
			asm mov: asm EAX ptr to: asm EAX
			]
! !

!NativeBoost methodsFor: 'memory operations' stamp: 'Igor.Stasenko 5/3/2010 10:58'!
basicAllocate: aSize
	"Allocate a memory block with given size in bytes,
	answer an NBExternalAddress instance - address to the beginning of memory block,
	or nil if allocation fails."
	self subclassResponsibility ! !

!NativeBoost methodsFor: 'initialization' stamp: 'IgorStasenko 3/31/2014 11:42'!
initialize
	"once we have call gate function, we can turn bootstrapping mode off"
	bootstrapping := true.
	
	"first, wipe out all native code from image"
	self class clearNativeCode.
	
	"now, we can enable the native code"
	self primEnableNativeCode.
	
	Current := self.   "set the class var"

	"Init basic stuff"
	self initializeExternalHeap.
		
	"callback counter"
	callbackCounterAddr := self allocate: 4.
	callbackCounterAddr nbInt32AtOffset: 0 put:  0.

	" finally, generate callgate function to finish bootstrap procedure"
	self callgateFunctionAddress.

	self initializeForNewSession.
! !

!NativeBoost methodsFor: 'initialize-release' stamp: 'Igor.Stasenko 5/2/2010 13:36'!
primEnableNativeCode
	"Primitive.
	Enables the execution of native code, which initially disabled during fresh image boot "
	<primitive: #primitiveEnable module: #NativeBoostPlugin> 

! !

!NativeBoost methodsFor: 'testing' stamp: 'Igor.Stasenko 9/25/2010 07:32'!
isBootstrapping
	^ bootstrapping! !

!NativeBoost methodsFor: 'bootstrapping' stamp: 'IgorStasenko 11/24/2012 15:56'!
bootstrapLoadSymbol: symbolName ofLength: symbolLen fromModule: moduleHandle
into: returnValueBuffer

	" call an interpreter proxy function 
void *ioLoadSymbolOfLengthFromModule(sqInt functionNameIndex, sqInt functionNameLength, void *moduleHandle)
		
	to retrieve an external module handle
	
	Returning a long 32 bit value may trigger GC which can move native code.
	In order to avoid that, we don't use any proxy function, which may lead to memory allocation.
	Thus, we store result into a byte array.
	"
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout 
		options: #( - optDirectProxyFnAddress optAllowExternalAddressPtr);
		function: #( NBBootstrapUlong (byte * symbolName , long symbolLen, ulong moduleHandle) )
		emit:  [:gen |
			gen proxy callFn: #ioLoadSymbol:OfLength:FromModule: 
		] ! !

!NativeBoost methodsFor: 'accessing' stamp: 'IgorStasenko 5/28/2012 07:00'!
callgateFunctionAddress
	
	^ gateFunction ifNil: [
		| bytes addr |

		NBRecursionDetect 
			in: #callgateFunctionAddress during: [		

			bytes := self generateCallgateCode.
			self assert: (bytes class isBytes).
		
			addr := self allocate: bytes size.
			"copy generated bytes to external memory"
			self memCopy: bytes to: addr size: bytes size.

		].
	  
		"finally set the function address"
		gateFunction := addr. 
		bootstrapping := false.
		gateFunction 
	]
! !

!NativeBoost methodsFor: 'bootstrapping' stamp: 'IgorStasenko 8/3/2011 09:22'!
generateCallgateCode
		
	"Answer a byte array of generated native code for gate function.
	We assume that caller reserves two temporaries on his stack frame
	[EBP-4], [EBP-8] for saving return address and pritimiveMethod oop"

	| asm primitiveMethod savedMethodOop returnAddr |

	asm :=  self newAssembler noStackFrame.

	savedMethodOop := EBP ptr - 4. 
	returnAddr := EBP ptr - 8.
	
	primitiveMethod := NBInterpreterProxy fnAddressAt: #primitiveMethod.
	
	asm
		mov: primitiveMethod to: EAX;
		call: EAX;  " retrieve a primitive method oop "
		mov: EAX to: savedMethodOop;
		pop: returnAddr; "store return address"
		pop: EAX; "function to call"
		call: EAX;  " call the function "
		push: returnAddr; "push return addr back on stack"
		push: EAX; " save return value "
		push: EDX;
		mov: primitiveMethod to: EAX;
		call: EAX;  " retrieve a primitive method oop "
		sub: EAX with: savedMethodOop;
		add: ESP ptr+8 with: EAX;  " current - old + returnAddress "
		pop: EDX;
		pop: EAX;
		ret.
		
	^ asm bytes
! !

!NativeBoost methodsFor: 'bootstrapping' stamp: 'IgorStasenko 3/31/2014 16:25'!
initializeForNewSession

	"let NBExternalStructure recalculate its fields"
	NBExternalStructure initializeForNewSession.
	NBExternalArray initializeForNewSession.
	NBExternalTypeValue initializeForNewSession.

	"notify any observers about session change"
	self class announcer announce: NBSessionChangeAnnouncement ! !

!NativeBoost methodsFor: 'retrieving symbols' stamp: 'CiprianTeodorov 3/18/2013 22:34'!
loadSymbol: aSymbolName fromModule: moduleName
	"module could be a string (name) or handle "

	| bytes module handle |
	
	bytes := ByteArray new: 8.
	moduleName isString ifTrue: [
		
		self 
			bootstrapLoadModule: moduleName asByteArray
			ofLength: moduleName size 
			into: bytes.
	
		module := bytes unsignedLongAt: 1 bigEndian: false.
		module = 0 ifTrue: [ ^ nil ].
	] ifFalse: [
		"if value is negative, use 32-bit complement"
		module := moduleName bitAnd: 16rFFFFFFFF.
	].
	self bootstrapLoadSymbol: aSymbolName asByteArray
		ofLength: aSymbolName size fromModule: module into: bytes.

	handle := bytes unsignedLongAt: 1 bigEndian: false.
	handle = 0 ifTrue: [ ^ nil ].

	^ NBExternalAddress value: handle
! !

!NativeBoost methodsFor: 'retrieving symbols' stamp: 'Igor.Stasenko 9/26/2010 04:59'!
CLibrary
	"answer a C library path, or module handle,
	use in FFI callouts as module: argument to call C run-time library function(s)"
	
	self subclassResponsibility ! !

!NativeBoost methodsFor: 'retrieving symbols' stamp: 'IgorStasenko 11/24/2012 15:57'!
loadFunction: fnName from: aModuleName
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>
	" call an interpreter proxy function 
		void* ioLoadFunctionFrom(char*, char*)
	to retrieve a function pointer of a registered module
	"
	^ self nbCallout 
		function: #( void* (String fnName,  String aModuleName) )
		emit: [:gen |	gen proxy callFn: #ioLoadFunction:From: ].
	! !

!NativeBoost methodsFor: 'bootstrapping' stamp: 'IgorStasenko 11/24/2012 15:55'!
bootstrapLoadModule: aModuleName ofLength: len into: returnValueBuffer
	" call an interpreter proxy function 
		void* ioLoadModuleOfLength(char*, int)
	to retrieve an external module handle
	
	Returning a long 32 bit value may trigger GC. So, we need a gate function for it,
	which we can't have without loading external stuff, so we store result into a byte array
	"
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout 
		options: #( - optDirectProxyFnAddress optAllowExternalAddressPtr);
		function: #( NBBootstrapUlong (byte * aModuleName , long len) )
		emit:  [:gen | 	gen proxy callFn: #ioLoadModule:OfLength: .  ] 
! !

!NativeBoost methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/25/2010 10:12'!
extraRootsRegistry

	^ extraRootsRegistry ifNil: [
	
		rootsCell := self allocate: (self pointerSize).
		extraRootsRegistry := NBExtraRootsRegistry newWithCell: rootsCell
	]! !

!NativeBoost methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/2/2010 13:52'!
pointerSize

	self subclassResponsibility ! !

!NativeBoost methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/5/2010 16:47'!
newAssembler

	self subclassResponsibility ! !

!NativeBoost methodsFor: 'callback support' stamp: 'Igor.Stasenko 9/26/2010 04:37'!
callbackCounterAddress
	^ callbackCounterAddr! !

!NativeBoost methodsFor: 'retrieving symbols' stamp: 'IgorStasenko 11/24/2012 15:56'!
ioLoadFunction: fnName from: aModuleName
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>
	" call an interpreter proxy function 
		void* ioLoadFunctionFrom(char*, char*)
	to retrieve a function pointer of a registered module
	"
	^ self nbCallout
		function: #( ulong (String fnName,  String aModuleName) )
		emit: [:gen |	gen proxy callFn: #ioLoadFunction:From: ].
	! !

!NativeBoost methodsFor: 'bootstrapping' stamp: 'IgorStasenko 11/24/2012 15:52'!
bootstrapLoadFunction: fnName from: aModuleName into: returnValueBuffer
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>
	" call an interpreter proxy function 
		void* ioLoadFunctionFrom(char*, char*)
	to retrieve a function pointer of a registered module
	"
	^ self nbCallout 
		function: #( NBBootstrapUlong (String fnName,  String aModuleName) )
		emit: [:gen |	gen proxy callFn: #ioLoadFunction:From: ].
	! !

!NativeBoost class methodsFor: 'memory access' stamp: 'Igor.Stasenko 5/3/2010 10:27'!
ulongAt: ulongAddr
	^ self forCurrentPlatform ulongAt: ulongAddr! !

!NativeBoost class methodsFor: 'memory access' stamp: 'Igor.Stasenko 5/5/2010 14:55'!
allocate: size
	^ self forCurrentPlatform allocate: size! !

!NativeBoost class methodsFor: 'memory access' stamp: 'Igor.Stasenko 5/5/2010 14:55'!
free: address
	^ self forCurrentPlatform free: address! !

!NativeBoost class methodsFor: 'testing' stamp: 'Igor.Stasenko 5/2/2010 11:00'!
isEnabled
	"Answer flag indicating whether running a native code enabled by plugin"
	
	<primitive: #primitiveIsEnabled module: #NativeBoostPlugin>
	
	^ self primitiveFailed! !

!NativeBoost class methodsFor: 'errors' stamp: 'IgorStasenko 8/6/2011 17:42'!
lastError
	<primitive: #primitiveLastNativeCodeError module: #NativeBoostPlugin>
	^ self error: 'NativeBoost plugin is not installed?'! !

!NativeBoost class methodsFor: 'testing' stamp: 'Igor.Stasenko 9/26/2010 06:28'!
insideCallback
	^ self forCurrentPlatform insideCallback! !

!NativeBoost class methodsFor: 'retrieving symbols' stamp: 'JavierPimas 9/27/2011 14:48'!
VMModule
	"answer a C library path, or module handle,
	use in FFI callouts as module: argument to call C run-time library function(s)"
	
	^ self forCurrentPlatform VMModule! !

!NativeBoost class methodsFor: 'memory access' stamp: 'Igor.Stasenko 5/13/2010 23:06'!
memCopy: src to: dst size: numBytes
	^ self forCurrentPlatform memCopy: src to: dst size: numBytes! !

!NativeBoost class methodsFor: 'debugger support' stamp: 'IgorStasenko 3/19/2012 13:17'!
simulatePrimitiveFor: aMethod receiver: recvr arguments: args context: ctx

	^ self tryRunNativeCode: aMethod for: recvr withArgs: args! !

!NativeBoost class methodsFor: 'platform id' stamp: 'Igor.Stasenko 5/2/2010 11:07'!
platformId

	<primitive: 'primitivePlatformId' module: 'NativeBoostPlugin'>
	
	" do not fail, answer nil instead"
	^ nil! !

!NativeBoost class methodsFor: 'class initialization' stamp: 'IgorStasenko 3/19/2012 12:43'!
initialize 
"self initialize"

	self registerPrimitiveSimulators! !

!NativeBoost class methodsFor: 'production mode support' stamp: 'IgorStasenko 7/12/2013 16:40'!
prepareForProduction
	"make sure all methods in image, which using NB call primitive, having captured method's argument names
	(so later, image can run NB code without requiring access to source code)"
	
	CompiledMethod allInstances do: [ :method |
		method hasNativeCallPrimitive ifTrue: [ 
			"that will make sure that names are cached"
			 method nbArgumentNames ]
	]! !

!NativeBoost class methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/17/2014 23:36'!
isAvailable
	"Return true when NativeBoost support is available in the VM, false otherwise"

	^ self isEnabledOrNil notNil! !

!NativeBoost class methodsFor: 'retrieving symbols' stamp: 'CamilloBruni 7/19/2012 11:51'!
loadSymbol: aSymbolName
	^ self loadSymbol: aSymbolName fromModule: ''! !

!NativeBoost class methodsFor: 'testing' stamp: 'IgorStasenko 5/28/2012 03:49'!
isEnabledOrNil
	"Answer flag indicating whether running a native code enabled by plugin"
	
	<primitive: #primitiveIsEnabled module: #NativeBoostPlugin>
	
	^ nil! !

!NativeBoost class methodsFor: 'subscribing for session change' stamp: 'BernardoContreras 10/19/2014 19:18'!
notifyAboutSessionChange: anObject
	"register an object to be notified about session change"
	self announcer weak when: NBSessionChangeAnnouncement send: #nbSessionChanged  to: anObject
! !

!NativeBoost class methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/2/2010 19:10'!
callgateFunctionAddress
	^ self forCurrentPlatform callgateFunctionAddress! !

!NativeBoost class methodsFor: 'accessing' stamp: 'IgorStasenko 5/28/2012 08:13'!
uniqueSessionObject
	"Answer an unique session object, which changes between
	image restarts.
	A call gate function is a good candidate for this, since its generated each time
	when image first boots. "

	^ self forCurrentPlatform callgateFunctionAddress ! !

!NativeBoost class methodsFor: 'testing' stamp: 'Igor.Stasenko 9/25/2010 05:16'!
primitiveLoadMainModule
	"Answer flag indicating whether running a native code enabled by plugin"
	
	<primitive: #primitiveLoadMainModule module: #NativeBoostPlugin>
	
	^ self primitiveFailed! !

!NativeBoost class methodsFor: 'accessing' stamp: 'IgorStasenko 3/28/2012 17:44'!
announcer
	^ NBAnnouncer ifNil: [ NBAnnouncer := Announcer new ].! !

!NativeBoost class methodsFor: 'platform id' stamp: 'Igor.Stasenko 4/29/2010 04:27'!
targetPlatformId

	"Should be implemented by subclasses to indicate a target platform.
	
	Answer zero - a non-existing platform id
	"
	
	^ 0! !

!NativeBoost class methodsFor: 'accessing' stamp: 'IgorStasenko 8/13/2013 14:59'!
automaticallyGeneratedCodeCategory
	"answer the name of non-existing package extension category which will be used for auto-generated code to categorize under"
	
	^ '*generated-code-non-existing-package'! !

!NativeBoost class methodsFor: 'debugger support' stamp: 'Igor.Stasenko 5/17/2010 22:01'!
isNativeMethod: aCompiledMethod
	| lit |
	
	lit := aCompiledMethod literalAt: 1.
	^ aCompiledMethod trailer kind == #NativeCodeTrailer 
		and: [ lit first == #NativeBoostPlugin and: [ lit second == #primitiveNativeCall]]! !

!NativeBoost class methodsFor: 'retrieving symbols' stamp: 'CamilloBruni 7/19/2012 11:50'!
loadSymbol: aSymbolName fromModule: moduleName
	^ self forCurrentPlatform 
		loadSymbol: aSymbolName fromModule: moduleName! !

!NativeBoost class methodsFor: 'retrieving symbols' stamp: 'Igor.Stasenko 9/26/2010 04:58'!
CLibrary
	"answer a C library path, or module handle,
	use in FFI callouts as module: argument to call C run-time library function(s)"
	
	^ self forCurrentPlatform CLibrary! !

!NativeBoost class methodsFor: 'retrieving symbols' stamp: 'CamilloBruni 7/19/2012 11:50'!
loadFunction: fnName from: aModuleName

	^ self forCurrentPlatform 
		loadFunction: fnName from: aModuleName! !

!NativeBoost class methodsFor: 'accessing' stamp: 'IgorStasenko 5/10/2011 15:27'!
clearNativeCode

	"Unconditionally clear all method's native code trailers using a single bulk-become"
	| old new |

	self isEnabled ifFalse: [ Current := nil ].
	
	Current ifNotNil: [
		Current insideCallback ifTrue: [
			self error: 'Clearing a native code while inside a callback' ]].
	
	old := OrderedCollection new.
	new := OrderedCollection new.
	
	CompiledMethod allInstancesDo: [:method | | trailer |
		trailer := method trailer.
		trailer kind == #NativeCodeTrailer ifTrue: [
			old add: method.
			new add: (method copyWithTrailerBytes: 
				(CompiledMethodTrailer new sourcePointer: trailer sourcePointer))
			]
	]. 
	
	old asArray elementsForwardIdentityTo: new asArray

! !

!NativeBoost class methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/2/2010 13:04'!
extraRootsRegistry

	^ self forCurrentPlatform extraRootsRegistry! !

!NativeBoost class methodsFor: 'system startup' stamp: 'IgorStasenko 5/11/2011 00:50'!
enableNativeCode
	"Enable the native code,
	answer true if operation was successfull or false if not"
	
	self isEnabled ifFalse: [
		"If native code is disable in plugin, this means 
		that a system is just started.
		Create a fresh instance of receiver "

		Current := nil. 
	].
	self forCurrentPlatform. 

	^ Current notNil! !

!NativeBoost class methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/18/2010 23:14'!
forCurrentPlatform

	"answer my subclass instance, suitable for use on current platform"
	self isEnabled ifFalse: [ Current := nil ].
	
	^ Current ifNil: [ self discoverPlatformId ]! !

!NativeBoost class methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/5/2010 16:46'!
newAssembler
	^ self forCurrentPlatform  newAssembler! !

!NativeBoost class methodsFor: 'debugger support' stamp: 'ClementBera 5/27/2014 13:49'!
registerPrimitiveSimulators

	Context simulatePrimitive: #primitiveNativeCall module: #NativeBoostPlugin with: self! !

!NativeBoost class methodsFor: 'testing' stamp: 'IgorStasenko 5/28/2012 03:58'!
sessionChanged: anOldSession

	"Answer true if session has changed.
	Do a quick test if NB plugin is not enabled yet to prevent fails in
	resource finalization during image startup.
	
	anOldSession is object which retrieved before, using #uniqueSessionObject message.
	"
	self isEnabledOrNil == true ifTrue: [
		Current ifNil: [ ^ true ].
		^ (Current callgateFunctionAddress  == anOldSession) not
	].
	"plugin is not enabled, or prim failed, assume session changed"
	^ true
	
! !

!NativeBoost class methodsFor: 'debugger support' stamp: 'ClementBera 5/27/2014 13:49'!
tryRunNativeCode: aCompiledMethod for: aReceiver withArgs: arguments
	"run only a native code of given method,
	and if it fails evaluate aFailBlock instead"
	| src node m |
	"self assert: (self isNativeMethod: aCompiledMethod)."
	
	src := String streamContents: [:str |
		str nextPutAll: 'NBDebug_stub'.
		1 to: aCompiledMethod numArgs do: [:i  |
			i = 1 
				ifTrue: [ str nextPutAll: ': ' ]
				ifFalse: [ str nextPutAll: ' with: ' ].
			str nextPutAll: 'arg'.
			i printOn: str.
		].
		str cr;
		nextPutAll: ' <primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode >'; cr;
		nextPutAll: ' ^ Context primitiveFailTokenFor: errorCode'.
	].

	node := Smalltalk compiler
		compile: src 
		in: aCompiledMethod methodClass
		classified: nil 
		notifying: nil 
		ifFail: [ ^ Context primitiveFailTokenFor: nil ].

	m := node generate: aCompiledMethod trailer.
	m flushCache.
	m selector flushCache.
	
	^ m valueWithReceiver: aReceiver arguments: arguments.
	! !

!NativeBoost class methodsFor: 'errors' stamp: 'IgorStasenko 5/11/2011 00:55'!
unsupportedPlatform 
	self error: 'You running on platform which not supported by NativeBoost'! !

!NativeBoost class methodsFor: 'retrieving symbols' stamp: 'CamilloBruni 7/19/2012 11:50'!
loadFunction: fnName

	^ self loadFunction: fnName from: ''! !

!NativeBoost class methodsFor: 'private' stamp: 'IgorStasenko 5/11/2011 00:48'!
resetInstance
	"!!!!!!!! Never use it !!!!!!!!
	It is here only for development purposes"

	Current := nil.! !

!NativeBoost class methodsFor: 'system startup' stamp: 'ClementBera 7/26/2013 16:27'!
discoverPlatformId
	
	| platId |
	
	"should not use it, if Current already set"
	self assert: (Current isNil). 

	platId := self platformId. 

	self allSubclassesDo: [:class |
		class targetPlatformId = platId ifTrue: [ 
			class new  " should set Current during initialization"
	]].

	Current ifNil: [ self unsupportedPlatform ].
	
	^ Current ! !

!NativeBoostConstants class methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/9/2010 11:00'!
currentPlatformId
	<primitive: 'primitivePlatformId' module: 'NativeBoostPlugin'>
	
	self primitiveFailed! !

!NativeBoostConstants class methodsFor: 'initialization' stamp: 'IgorStasenko 8/6/2011 18:10'!
initialize
	"self initialize"
	" Here the platform codes, defined to identify a platform on which VM runs.
	A compiled method which contain native code using this id to indicate for what platform 
	the native code is generated. 
	A primitive, which responsible for running native code, checks that platform id in method matching the platform id,
	specified by plugin, and if not, then primitive fails without attempt to run native code"

	"x86 platform codes"
	Linux32PlatformId := 1.
	Mac32PlatformId := 2. 
	Win32PlatformId := 3.

	self 
		initErrorCodes;
		initVMErrorCodes;
		initErrorDescriptions.
	! !

!NativeBoostConstants class methodsFor: 'error codes' stamp: 'IgorStasenko 9/21/2012 15:37'!
initErrorDescriptions

	NBErrorDescriptions := Dictionary newFromPairs:
	{
		NBPrimNoErr. 'No error'.
		NBPrimErrGenericFailure. 'Generic failure'.
		NBPrimErrBadReceiver. 'Bad receiver'.
		NBPrimErrBadArgument. 'Bad argument'.
		NBPrimErrBadIndex. 'Bad index'.
		NBPrimErrBadNumArgs. 'Invalid number of arguments'.
		NBPrimErrInappropriate. 'Inappropriate operation'.
		NBPrimErrUnsupported. 'unsupported operation'. 
		NBPrimErrNoModification. 'No modification allowed to immutable object'.
		NBPrimErrNoMemory. 'Insufficient object memory'.
		NBPrimErrNoCMemory. 'Insufficient C memory'.
		NBPrimErrNotFound. 'Not found'.
		NBPrimErrBadMethod. 'Bad method'.
		NBPrimErrNamedInternal. 'Internal error in named primitive machinery'.
		NBPrimErrObjectMayMove. 'Object may move'.
		NBPrimErrLimitExceeded. 'Resource limit exceeded'.
	
		ErrNotEnabled. 'Execution of native code is not enabled by plugin'.
		ErrNoNativeCodeInMethod. 'No native code installed in primitive method'.
		ErrInvalidPlatformId. 'Native code in primitive method are for different platform'.
	
		ErrNoNBPrimitive. 'A method where native code will be installed, missing a <primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode> pragma'.
		ErrRunningViaInterpreter.  'A method with primitive 220 (primitiveVoltage), contains JIT code, but VM decided to execute this method via interpreter '.
		ErrInvalidPrimitiveVoltageUse. 'A method uses primitive 220 (primitiveVoltage), but does not use an error code: <primitive: 220 error: errorCode> '
	 }! !

!NativeBoostConstants class methodsFor: 'error codes' stamp: 'IgorStasenko 8/6/2011 18:04'!
initVMErrorCodes
"took from OSCog's sqVirtualMachine.h"
	NBPrimNoErr := 0.
	NBPrimErrGenericFailure := 1.
	NBPrimErrBadReceiver := 2.
	NBPrimErrBadArgument := 3.
	NBPrimErrBadIndex := 4.
	NBPrimErrBadNumArgs := 5.
	NBPrimErrInappropriate := 6.
	NBPrimErrUnsupported := 7.
	NBPrimErrNoModification := 8.
	NBPrimErrNoMemory := 9.
	NBPrimErrNoCMemory := 10.
	NBPrimErrNotFound := 11.
	NBPrimErrBadMethod := 12.
	NBPrimErrNamedInternal := 13.
	NBPrimErrObjectMayMove := 14.
	NBPrimErrLimitExceeded := 15.! !

!NativeBoostConstants class methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/9/2010 11:03'!
win32PlatformId
	^ Win32PlatformId! !

!NativeBoostConstants class methodsFor: 'accessing' stamp: 'IgorStasenko 9/10/2012 12:07'!
mac32PlatformId
	^ Mac32PlatformId! !

!NativeBoostConstants class methodsFor: 'accessing' stamp: 'Igor.Stasenko 4/14/2010 15:03'!
linux32PlatformId
	^ Linux32PlatformId! !

!NativeBoostConstants class methodsFor: 'error codes' stamp: 'IgorStasenko 9/21/2012 15:46'!
initErrorCodes
	"An error codes used by Cog NB plugin.
	Note, at the moment of writing this, a primitive error codes 
	supported only in Cog VMs"
	
	NBErrorBase := 500.
	"execution of native code is not enabled by plugin"
	ErrNotEnabled := NBErrorBase + 1.  
	
	"failed to find a native code for primitive method"
	ErrNoNativeCodeInMethod := NBErrorBase + 2. 
	
	"native code generated for different platform"
	ErrInvalidPlatformId := NBErrorBase + 3. 
	
	 "the method which containing foreign call missing a #primitiveNativeCall primitive pragma"
	ErrNoNBPrimitive := NBErrorBase + 4.
	
 	"the method has a 220 primitive (primitiveVoltage), but VM decided to execute this method via interpreter "
	ErrRunningViaInterpreter := NBErrorBase + 5.
	
	"A method uses primitive 220 (primitiveVoltage), but does not use an error code: <primitive: 220 error: errorCode> "
	ErrInvalidPrimitiveVoltageUse := NBErrorBase + 6.! !

!NativeBoostLinux32 methodsFor: 'retrieving symbols' stamp: 'IgorStasenko 1/24/2012 12:38'!
getGlobalSymbolPointer: symbolName 

	| bytes addr |
	bytes := ByteArray new: 8.
	self bootstrapGetGlobalSymbolPointer: symbolName into: bytes.
	addr := bytes unsignedLongAt: 1 bigEndian: false.
	
	addr = 0 ifTrue: [ self error: 'failed to get a symbol address: ', symbolName ].
	^ NBExternalAddress value: addr
	! !

!NativeBoostLinux32 methodsFor: 'memory operations' stamp: 'Igor.Stasenko 9/26/2010 04:13'!
free: address

	"Free the external memory, allocated using #allocate: message.
	Note: never pass pointers, which you allocated by other means"
	
	heap free: address value! !

!NativeBoostLinux32 methodsFor: 'accessing' stamp: 'IgorStasenko 1/16/2014 12:40'!
stackAlignment

	^ 16! !

!NativeBoostLinux32 methodsFor: 'bootstrapping' stamp: 'Igor.Stasenko 9/26/2010 03:50'!
initializeExternalHeap

	"initialize external memory heap"
		
	heap := NBUnixExternalHeapManager new.

	! !

!NativeBoostLinux32 methodsFor: 'primitives' stamp: 'Igor.Stasenko 9/25/2010 06:30'!
primitiveDlsym
	"retrieve a pointer to dlsym(...) function"
	<primitive: 'primitiveDlsymFn' module: #NativeBoostPlugin>
		
	^ self primitiveFailed! !

!NativeBoostLinux32 methodsFor: 'retrieving symbols' stamp: 'JavierPimas 9/27/2011 14:46'!
VMModule
	"taken from CLibrary. Should work for fetching VM functions too.
	use in FFI callouts as module: argument to call C run-time library function(s)"
	
	"use global symbol space"
	^ RTLD_DEFAULT! !

!NativeBoostLinux32 methodsFor: 'retrieving symbols' stamp: 'IgorStasenko 1/18/2012 13:45'!
loadSymbol: aSymbolName fromModule: moduleName

	(moduleName = '' or: [moduleName = 0 ]) ifTrue: [
		"if module name is empty, try to retrieve symbol from globals "
		^ self getGlobalSymbolPointer: aSymbolName 
		].
	^ super loadSymbol: aSymbolName fromModule: moduleName! !

!NativeBoostLinux32 methodsFor: 'retrieving symbols' stamp: 'Igor.Stasenko 9/26/2010 05:00'!
CLibrary
	"answer a C library path, or module handle,
	use in FFI callouts as module: argument to call C run-time library function(s)"
	
	"use global symbol space"
	^ RTLD_DEFAULT! !

!NativeBoostLinux32 methodsFor: 'memory operations' stamp: 'Igor.Stasenko 9/25/2010 09:37'!
basicAllocate: numBytes
	"Allocate a memory block with given size in bytes,
	answer an NBExternalAddress instance - address to the beginning of memory block"
	| addr |
	addr := heap allocate: numBytes.
	addr = 0 ifTrue: [ ^ nil ].
	
	^ NBExternalAddress value: addr! !

!NativeBoostLinux32 methodsFor: 'bootstrapping' stamp: 'IgorStasenko 11/24/2012 16:02'!
bootstrapGetGlobalSymbolPointer: symbolName into: returnValueBuffer
	" call  dlsym(RTLD_DEFAULT, symbolName) "

	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin' error: errorCode>
	^ self nbCallout
		options: #( - optUseStackPointer );
		function: #( NBBootstrapUlong (RTLD_DEFAULT , String symbolName) )
		emit: [:gen |	 | asm |
				self assert: (self primitiveDlsym ~= 0).
				
				asm := gen asm.
				asm mov: (self primitiveDlsym asUImm) to: asm EAX.
				asm call: asm EAX.
		] 
	! !

!NativeBoostLinux32 methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/22/2010 03:25'!
pointerSize
	^ 4! !

!NativeBoostLinux32 methodsFor: 'primitives' stamp: 'Igor.Stasenko 9/25/2010 06:31'!
primitiveDlopen
	"retrieve a pointer to dlopen(...) function"
	<primitive: 'primitiveDlopenFn' module: #NativeBoostPlugin>
		
	^ self primitiveFailed! !

!NativeBoostLinux32 methodsFor: 'accessing' stamp: 'IgorStasenko 8/5/2011 08:48'!
newAssembler
	^ AJx86Assembler new.! !

!NativeBoostLinux32 class methodsFor: 'platform id' stamp: 'Igor.Stasenko 9/22/2010 03:12'!
targetPlatformId
	
	^ Linux32PlatformId ! !

!NativeBoostMac32 methodsFor: 'bootstrapping' stamp: 'Igor.Stasenko 12/5/2010 18:32'!
initializeExternalHeap

	"initialize external memory heap"
		
	heap := NBMacExternalHeapManager new.

	! !

!NativeBoostMac32 methodsFor: 'bootstrapping' stamp: 'IgorStasenko 11/24/2012 16:03'!
bootstrapGetGlobalSymbolPointer: symbolName into: returnValueBuffer
	" call  dlsym(RTLD_DEFAULT, symbolName) "
	" override, since mac using different RTLD_DEFAULT constant value "
	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin' error: errorCode>
	^ self nbCallout
		options: #( - optUseStackPointer);
		function: #( NBBootstrapUlong (RTLD_DEFAULT , String symbolName) )
		emit: [:gen |	 | asm |
				asm := gen asm.
				asm mov: (self primitiveDlsym asUImm) to: asm EAX.
				asm call: asm EAX.
		]! !

!NativeBoostMac32 methodsFor: 'bootstrapping' stamp: 'IgorStasenko 11/24/2012 16:03'!
getEntryPointStackOffset
	" call  dlsym(RTLD_DEFAULT, symbolName) "
	" override, since mac using different RTLD_DEFAULT constant value "
	
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin' error: errorCode>
	^ self nbCallout
		function: #( ulong () )
		emit: [:gen |	 | asm |
				asm := gen asm.
				asm mov: asm ESP to: asm EAX;
					and: asm EAX with: 16r0F.
		].

	! !

!NativeBoostMac32 methodsFor: 'platform-specific' stamp: 'IgorStasenko 8/2/2011 06:33'!
stackAlignment

	^ 16! !

!NativeBoostMac32 methodsFor: 'platform-specific' stamp: 'IgorStasenko 2/2/2012 16:00'!
VMModule
	"answer a C library path, or module handle,
	use in FFI callouts as module: argument to call C run-time library function(s)"
	
	^ self CLibrary! !

!NativeBoostMac32 methodsFor: 'assembler' stamp: 'IgorStasenko 8/5/2011 08:48'!
newAssembler
	^ AJx86Assembler new! !

!NativeBoostMac32 class methodsFor: 'accessing' stamp: 'Igor.Stasenko 12/4/2010 22:21'!
targetPlatformId
	
	^ Mac32PlatformId ! !

!NativeBoostWin32 methodsFor: 'retrieving symbols' stamp: 'Igor.Stasenko 9/26/2010 05:00'!
CLibrary
	"answer a C library path, or module handle,
	use in FFI callouts as module: argument to call C run-time library function(s)"
	
	"GNU/mingw compiler"
	^ 'crtdll.dll'! !

!NativeBoostWin32 methodsFor: 'memory operations' stamp: 'Igor.Stasenko 5/3/2010 10:59'!
basicAllocate: numBytes
	"answer an instance of NBExternalAddress, or nil if failed"
	| address |
	address := NBExternalAddress new.
	self bootstrapAllocate: numBytes into: address.
	(address asUnsignedLong) = 0 ifTrue: [ ^ nil ].
	^ address! !

!NativeBoostWin32 methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/3/2010 10:44'!
pointerSize
	^ 4! !

!NativeBoostWin32 methodsFor: 'memory operations' stamp: 'IgorStasenko 11/24/2012 16:08'!
free: lpMem
"The HeapFree function frees a memory block allocated from a heap by the HeapAlloc or HeapReAlloc function. "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>

	^ self nbCallout
		stdcall;
		"allow only external address"
		options: #( - optAllowByteArraysPtr + optAllowExternalAddressPtr );
		function: #( BOOL HeapFree (ulong heapHandle, 0, LPVOID lpMem) ) module: #Kernel32
! !

!NativeBoostWin32 methodsFor: 'private' stamp: 'IgorStasenko 11/24/2012 16:09'!
privCreateHeap: returnValueBuffer

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>

	^ self nbCallout
			options: #( - optDirectProxyFnAddress );
			stdcall;
			function: #( NBBootstrapUlong HeapCreate ( HEAP_CREATE_ENABLE_EXECUTE , 0 , 0 ) ) module: #Kernel32
! !

!NativeBoostWin32 methodsFor: 'accessing' stamp: 'MarcusDenker 9/3/2014 16:19'!
stackAlignment

	^ 16! !

!NativeBoostWin32 methodsFor: 'accessing' stamp: 'IgorStasenko 8/5/2011 08:48'!
newAssembler
	^ AJx86Assembler new.! !

!NativeBoostWin32 methodsFor: 'bootstrapping' stamp: 'Igor.Stasenko 5/3/2010 10:50'!
initializeExternalHeap

	"initialize external memory heap"

	| bytes |
	bytes := ByteArray new: 4.
	self privCreateHeap: bytes.

	heapHandle := bytes unsignedLongAt: 1 bigEndian: false.
	heapHandle = 0 ifTrue: [ self error: 'Unable to create external heap' ].
	
! !

!NativeBoostWin32 methodsFor: 'bootstrapping' stamp: 'IgorStasenko 11/24/2012 16:08'!
bootstrapAllocate: size into: returnValueBuffer

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>

	^ self nbCallout 
		stdcall;
		options: #( - optDirectProxyFnAddress optAllowExternalAddressPtr);
		function: #( NBBootstrapUlong HeapAlloc (ulong heapHandle , 0 , SIZE_T size) ) module: #Kernel32
! !

!NativeBoostWin32 methodsFor: 'retrieving symbols' stamp: 'IgorStasenko 2/8/2013 12:56'!
VMModule

	^ self class getVMModuleHandle handle! !

!NativeBoostWin32 class methodsFor: 'C heap access' stamp: 'IgorStasenko 11/24/2012 16:19'!
realloc: address newSize: aSize

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(ulong realloc (ulong address, ulong aSize)) module: 'crtdll.dll'! !

!NativeBoostWin32 class methodsFor: 'accessing' stamp: 'IgorStasenko 11/24/2012 16:17'!
getVMModuleHandle
"The GetModuleHandle function retrieves a module handle for the specified module if the file has been mapped into the address space of the calling process."

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>

	^ self nbCallout
		stdcall;
		function: #( HMODULE GetModuleHandleA (0) ) 
		module: #Kernel32
! !

!NativeBoostWin32 class methodsFor: 'accessing' stamp: 'tbn 11/11/2012 01:01'!
getVMModuleName

	| len str |	
	str := ByteString new: 1000.
	len := self primGetModuleFileName: str with: 1000.	
	^ str first: len.! !

!NativeBoostWin32 class methodsFor: 'platform id' stamp: 'Igor.Stasenko 4/29/2010 04:31'!
targetPlatformId
	
	^ Win32PlatformId! !

!NativeBoostWin32 class methodsFor: 'library loading' stamp: 'IgorStasenko 11/24/2012 16:18'!
loadLibrary: libName
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout
		stdcall function: #( long LoadLibraryA ( String libName )) module: #Kernel32
! !

!NativeBoostWin32 class methodsFor: 'library loading' stamp: 'RichardWettel 1/13/2015 09:39'!
getModuleHandle: lpModuleName
"The GetModuleHandle function retrieves a module handle for the specified module if the file has been mapped into the address space of the calling process."

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>

	^ self nbCallout 
		options: #( - optWinUnicode );
		stdcall;
		function: #( HMODULE GetModuleHandleA (LPCTSTR lpModuleName ) ) 
		module: #Kernel32
! !

!NativeBoostWin32 class methodsFor: 'library loading' stamp: 'tbn 11/10/2012 23:48'!
primGetModuleFileName: lpFileName with: nSize

"The GetModuleFileName function retrieves the fully-qualified path for the file that contains the specified module that the current process owns."

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>

	^ NBFFICallout 
		stdcall: #(
			DWORD GetModuleFileNameA (
				0,
				char * lpFileName,
				DWORD nSize)) 
		module: #Kernel32
		options: #( - optCoerceNilToNull WinUnicode )
! !

!NativeBoostWin32 class methodsFor: 'C heap access' stamp: 'IgorStasenko 11/24/2012 16:18'!
malloc: aSize

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #( void* malloc (ulong aSize) ) module: 'crtdll.dll'! !

!NativeBoostWin32 class methodsFor: 'library loading' stamp: 'IgorStasenko 11/24/2012 16:17'!
getProcAddress: hModule procName: lpProcName 
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout
		stdcall;
		function: #( 
		FARPROC GetProcAddress (
			HMODULE hModule,
			LPCSTR lpProcName ) ) 
		module: #Kernel32
! !

!NativeBoostWin32 class methodsFor: 'accessing' stamp: 'tbn 11/11/2012 00:47'!
squeakWindowHandle
	"This is slow, but efficient"
	
	^(self loadFunction: 'stWindow' from: '') nbUInt32AtOffset: 0
	
	! !

!NativeCodeTests methodsFor: 'tests' stamp: 'Igor.Stasenko 4/30/2010 20:03'!
testProxyFunctions

	| functions |
	
	functions := NBInterpreterProxy functions.
	functions valuesDo: [:fn |
		self assert: (NBInterpreterProxy canUnderstand: fn selector ).
	]! !

!NativeCodeTests methodsFor: 'tests' stamp: 'IgorStasenko 8/5/2011 08:24'!
testMovableStuff
	"test that if native code calls a VM function which triggers
	a full gc and relocates a native code, it will survive the move,
	
	a native code should return a difference between old and new primitive method,
	in case if its moved, the difference will be nonzero"
	
	| code |

	code := self createMoveTestCode.
	" we should not crash here ;) "
	^ (1 to: 10) collect: 
		[:each| 
			Array new: (Random new nextInt: 100). 
			self install: code into: (self class methodDict at: #movableStub).
		  
			self movableStub  
		]
	
	! !

!NativeCodeTests methodsFor: 'private' stamp: 'Igor.Stasenko 4/11/2010 18:21'!
movableStub
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>
	^ 999! !

!NativeCodeTests methodsFor: 'private' stamp: 'IgorStasenko 8/5/2011 08:22'!
createMoveTestCode

	^ NBFFICallout new
		anonSpec: #( int ());
		cdecl;
		generate: [:gen :proxy :asm |
			| methodOop |
			
			methodOop := gen reserveTemp.
			
			proxy primitiveMethod.
			asm mov: asm EAX to: methodOop.
			
			"call fullGC to trigger memory compaction"
			proxy fullGC.
			
			"return the difference between old primitiveMethod oop value and new one"
			proxy primitiveMethod.
			asm sub: asm EAX with: methodOop.

	].! !

!NativeCodeTests methodsFor: 'tests' stamp: 'IgorStasenko 3/27/2012 18:20'!
testArgumentOffsets

	"cdecl arguments placed in reverse order,
	
	push c;
	push b;
	push a..
	
	so, c is most closer to stack frame and having smallest offset.
	"
	NBNativeFunctionGen 
		cdecl: #( int (byte a, void * b, double c) )
		emit: [:gen |
			| arg |

			arg := gen arg: #a.
			self assert: (arg isMem).
			self assert: (arg displacement value = 8).

			arg := gen arg: #b.
			self assert: (arg isMem).
			self assert: (arg displacement value = 12).

			arg := gen arg: #c.
			self assert: (arg isMem).
			self assert: (arg displacement value = 16).
			
		]! !

!NativeCodeTests methodsFor: 'private' stamp: 'Igor.Stasenko 5/2/2010 10:56'!
install: nativeCode into: method

	| trailer  newMethod |
	trailer := CompiledMethodTrailer new.

	trailer nativeCode: nativeCode platformId: NativeBoost platformId sourcePointer: method trailer sourcePointer.
	newMethod := method copyWithTrailerBytes: trailer.
	
	method methodClass methodDict at: method selector put: newMethod.
	
! !

!NativeCodeTests class methodsFor: 'accessing' stamp: 'CiprianTeodorov 5/19/2013 03:46'!
resources
	^{NBTestResources}! !

!NaturalLanguageTranslator commentStamp: 'TorstenBergmann 9/16/2014 14:49'!
A NaturalLanguageTranslator is a dummy translator.

The localization framework is found in the gettext package usually 
overriding this class completely. 

As an alternative you can register a translator using
  
   NaturalLanguageTranslator current: myTranslator

If this is done the messages will be dispatched to it!
!NaturalLanguageTranslator class methodsFor: 'cleanup' stamp: 'TorstenBergmann 9/16/2014 15:02'!
cleanUp
	 Current ifNotNil: [ Current cleanUp ]! !

!NaturalLanguageTranslator class methodsFor: 'translate' stamp: 'TorstenBergmann 9/16/2014 15:02'!
translate: aString
	"Dispatch to a registered translator to translate the given string or (if there is no translator) return the untranslated string."
	Current ifNotNil: [ ^Current translate: aString ].
	^ aString! !

!NaturalLanguageTranslator class methodsFor: 'accessing' stamp: 'TorstenBergmann 9/16/2014 14:52'!
current: aTranslator
	"Register a translator that should receiver the translation messages"
	
	Current := aTranslator! !

!NaturalLanguageTranslator class methodsFor: 'accessing' stamp: 'TorstenBergmann 9/16/2014 15:15'!
current 
	"Return the currently registered translator"
	
	^Current ! !

!NaturalLanguageTranslator class methodsFor: 'translate' stamp: 'TorstenBergmann 9/16/2014 15:02'!
translate: aString toLocale: localeID
	"Dispatch to a registered translator to translate the given string with the given locale ID or (if there is no translator) return the untranslated string."
	Current ifNotNil: [ ^Current translate: aString toLocale: localeID ].
	^ aString! !

!NaturalLanguageTranslatorTest commentStamp: 'TorstenBergmann 9/16/2014 15:25'!
Tests for NaturalLanguageTranslator!
!NaturalLanguageTranslatorTest methodsFor: 'tests' stamp: 'TorstenBergmann 9/16/2014 15:06'!
testTranslatePureString

	self assert: 'Pharo' translated = 'Pharo'! !

!NaturalLanguageTranslatorTest methodsFor: 'tests' stamp: 'TorstenBergmann 9/16/2014 15:25'!
testRegisterCustomTranslator

	NaturalLanguageTranslator current: RegisterableTranslatorMock new.
	"Our custom translator translates the string differently"
	self assert: 'TestCase' translated = 'Testfall'.
	
	! !

!NaturalLanguageTranslatorTest methodsFor: 'running' stamp: 'TorstenBergmann 9/16/2014 15:22'!
tearDown

	NaturalLanguageTranslator current: previousRegistered.
	super tearDown! !

!NaturalLanguageTranslatorTest methodsFor: 'running' stamp: 'TorstenBergmann 9/16/2014 15:21'!
setUp

	super setUp.
	previousRegistered := NaturalLanguageTranslator current! !

!Nautilus commentStamp: '<historical>'!
I'm a new browser based on RPackage and Announcements with fancy goodies:

	- groups ( you can create groups with your favorite classes)
	- multi-selections
	- environments
	- iconic buttons
	- hierarchy
	- pragma based menus!
!Nautilus methodsFor: 'browser compatibility' stamp: 'BenjaminVanRyseghem 4/6/2012 17:44'!
spawnHierarchyForClass: aClass selector: aSelector

	self setClass: aClass selector: aSelector.
	self spawnHierarchy! !

!Nautilus methodsFor: 'accessing' stamp: ''!
plugins

	^ plugins ifNil: [ plugins := OrderedCollection new ]! !

!Nautilus methodsFor: 'accessing' stamp: 'SebastianTleye 4/23/2013 13:12'!
packagesWithoutExtensions
	^ self browsedEnvironment packagesWithoutExtensions asArray! !

!Nautilus methodsFor: 'accessing' stamp: ''!
selectedMethod

	^ selectedMethod! !

!Nautilus methodsFor: 'accessing' stamp: ''!
showCategories: aBoolean

	showCategories := aBoolean.
	self announcer announce: ( NautilusShowCategoriesChanged boolean: aBoolean )! !

!Nautilus methodsFor: 'accessing' stamp: 'NicolaiHess 9/27/2014 23:50'!
sortHierarchically: aBoolean

	sortHierarchically := aBoolean.
	self announcer announce: ( NautilusShowHierarchyChanged boolean: aBoolean )! !

!Nautilus methodsFor: 'browser compatibility' stamp: 'MarcusDenker 10/24/2013 11:19'!
labelString

	^ self ui
		ifNil: [ 'Nautilus' ]
		ifNotNil: [:theui | theui title ]! !

!Nautilus methodsFor: 'announcement' stamp: ''!
announce: anAnnouncement

	self announcer announce: anAnnouncement
! !

!Nautilus methodsFor: 'initialization' stamp: 'EstebanLorenzano 11/20/2013 16:28'!
initialize
	super initialize.

	plugins := OrderedCollection new.
	self class pluginClasses do: [:each || class position |
		class := each first.
		position := each second.
		plugins add: ((class model: self) position: position; yourself)]! !

!Nautilus methodsFor: 'accessing' stamp: ''!
showCategories

	^ showCategories ifNil: [ showCategories := true ]! !

!Nautilus methodsFor: 'accessing' stamp: 'NicolaiHess 10/2/2014 00:14'!
showHierarchy

	^ showHierarchy ifNil: [ showHierarchy := false ]! !

!Nautilus methodsFor: 'private' stamp: ''!
packagesUsedByTheSelectedClass

	| result class |
	result := OrderedCollection new.
	class := self selectedClass.
	
	class ifNil: [^{}].
	result add: class package.
	result addAll: (self foundExtentionsIn: class).
	result := result intersection: self packages.
	^ result select:[:each | each notNil]! !

!Nautilus methodsFor: 'history' stamp: 'BenjaminVanRyseghem 10/18/2013 17:15'!
removeFromHistory: aNautilusHistoryEntry

	self browsingHistory removeEntry: aNautilusHistoryEntry.
	self triggerEvent: #historyChanged! !

!Nautilus methodsFor: 'browser compatibility' stamp: 'NicolaiHess 9/7/2014 19:14'!
spawnHierarchy
 
	self 
		sortHierarchically: true;
		open.
	self ui showHierarchy: true! !

!Nautilus methodsFor: 'accessing' stamp: ''!
switchClassesAndPackages

	^ self class switchClassesAndPackages! !

!Nautilus methodsFor: 'accessing' stamp: ''!
ui

	^ ui! !

!Nautilus methodsFor: 'browser compatibility' stamp: ''!
codeTextMorph

	^ self ui codeTextMorph! !

!Nautilus methodsFor: 'accessing' stamp: ''!
selectedGroup

	^ selectedGroup! !

!Nautilus methodsFor: 'accessing' stamp: ''!
showGroups: aBoolean

	showGroups := aBoolean.
	self announcer announce: ( NautilusShowGroupsChanged boolean: aBoolean )! !

!Nautilus methodsFor: 'history' stamp: ''!
historyEntries

	^ self browsingHistory entries! !

!Nautilus methodsFor: 'accessing' stamp: ''!
commentPosition

	^ self class commentPosition! !

!Nautilus methodsFor: 'history' stamp: 'BenjaminVanRyseghem 10/18/2013 17:13'!
adopt: anAssociation

	self browsingHistory pauseDuring: [
		anAssociation key applyTo: self ]! !

!Nautilus methodsFor: 'accessing' stamp: ''!
uiClass

	^ uiClass ifNil: [ self defaultUIClass ]! !

!Nautilus methodsFor: 'history' stamp: ''!
hasPrevious
	
	^self browsingHistory hasPrevious! !

!Nautilus methodsFor: 'accessing' stamp: ''!
browsingHistory

	^ browsingHistory ifNil: [ browsingHistory := NavigationHistory new ]! !

!Nautilus methodsFor: 'accessing' stamp: ''!
selectedPackage: anObject

	selectedPackage := anObject.
	self announcer announce: ( NautilusPackageSelected package: anObject )! !

!Nautilus methodsFor: 'displaying' stamp: 'NicolaiHess 8/9/2014 23:59'!
open
	ui := (self uiClass on: self) open.
	self announce: (WindowOpened new window: ui window)! !

!Nautilus methodsFor: 'history' stamp: 'CamilloBruni 10/4/2012 11:30'!
previous
	self browsingHistory pauseDuring: [
		self adopt: self browsingHistory previous.
		self triggerEvent: #historyChanged ]! !

!Nautilus methodsFor: 'history' stamp: 'BenjaminVanRyseghem 10/18/2013 17:28'!
removeLastHistoryEntry

	self browsingHistory removeLastEntry.
	self triggerEvent: #historyChanged! !

!Nautilus methodsFor: 'history' stamp: 'NicolaiHess 1/11/2014 00:21'!
registerHistoryNewEntry
	| lastEntry wrapper |
	
	self browsingHistory isPaused ifTrue: [ ^ self ].
	wrapper := NautilusHistoryEntry with: self.
	self browsingHistory entries ifNotEmpty: [ :entries |
		lastEntry := entries last key.
		( lastEntry selectedClass isNil 
		or: [ ( wrapper selectedClass notNil 
			and: [ wrapper selectedMethod = lastEntry selectedMethod 
			and: [ wrapper selectedClass theNonMetaClass = lastEntry selectedClass theNonMetaClass ] ] ) ] ) 
				ifTrue: [ ^ self ] ].
	
	self browsingHistory add: wrapper.
	self triggerEvent: #historyChanged.! !

!Nautilus methodsFor: 'accessing' stamp: ''!
showGroups

	^ showGroups ifNil: [ showGroups := self shouldOpenOnGroups ]! !

!Nautilus methodsFor: 'accessing' stamp: 'NicolaiHess 9/27/2014 23:50'!
sortHierarchically

	^ sortHierarchically ifNil: [ sortHierarchically := self class sortHierarchically ]! !

!Nautilus methodsFor: 'displaying' stamp: ''!
defaultUIClass

	^ NautilusUI! !

!Nautilus methodsFor: 'displaying' stamp: 'CamilloBruni 9/21/2012 13:46'!
close

	ui close! !

!Nautilus methodsFor: 'accessing' stamp: ''!
selectedCategory

	^ selectedCategory! !

!Nautilus methodsFor: 'history' stamp: 'CamilloBruni 10/4/2012 11:31'!
next
	self browsingHistory pauseDuring: [
		self adopt: self browsingHistory next.
		self triggerEvent: #historyChanged ].! !

!Nautilus methodsFor: 'accessing' stamp: ''!
showComment

	^ showComment ifNil: [ showComment := false ]! !

!Nautilus methodsFor: 'accessing' stamp: ''!
showComment: aBoolean

	showComment := aBoolean.
	self announcer announce: ( NautilusShowCommentChanged boolean: aBoolean )! !

!Nautilus methodsFor: 'accessing' stamp: 'NicolaiHess 4/7/2014 22:27'!
groupsManager
	
	^ self class groupsManager! !

!Nautilus methodsFor: 'accessing' stamp: ''!
packages

	^ self browsedEnvironment packages asArray! !

!Nautilus methodsFor: 'accessing' stamp: ''!
selectedMethod: anObject

	selectedMethod := anObject.
	self announcer announce: ( NautilusMethodSelected method: anObject )! !

!Nautilus methodsFor: 'private' stamp: ''!
warningLimit

	^ self class warningLimit! !

!Nautilus methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/14/2013 15:49'!
parentOfClass: aClass 
	^ self class parentOfClass: aClass! !

!Nautilus methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/14/2012 15:33'!
selectedClass: aClass

	selectedClass := aClass.
	self selectedCategory: nil.
	aClass ifNotNil: [ self recentClasses add: aClass theNonMetaClass name ].
	self announcer announce: ( NautilusClassSelected class: aClass )! !

!Nautilus methodsFor: 'browser compatibility' stamp: ''!
openEditString: aString 

	" Dunno what to do"! !

!Nautilus methodsFor: 'accessing' stamp: ''!
selectedPackage

	^ selectedPackage! !

!Nautilus methodsFor: 'accessing' stamp: ''!
recentClasses

	^ self class recentClasses! !

!Nautilus methodsFor: 'accessing' stamp: ''!
browsedEnvironment: anEnvironment

	browsedEnvironment := anEnvironment! !

!Nautilus methodsFor: 'announcement' stamp: 'NicolaiHess 9/30/2014 21:05'!
announcer

	^ announcer ifNil: [ announcer := Announcer new ]! !

!Nautilus methodsFor: 'accessing' stamp: ''!
selectedCategory: anObject

	selectedCategory := anObject.
	self selectedMethod: nil.
	self announcer announce: ( NautilusProtocolSelected category: anObject )! !

!Nautilus methodsFor: 'history' stamp: ''!
hasNext
	
	^self browsingHistory hasNext! !

!Nautilus methodsFor: 'private' stamp: ''!
foundExtentionsIn: aClass

	^ aClass extendingPackages.
! !

!Nautilus methodsFor: 'accessing' stamp: ''!
browsedEnvironment

	^ browsedEnvironment ifNil: [ browsedEnvironment := RBBrowserEnvironment new ]! !

!Nautilus methodsFor: 'accessing' stamp: 'NicolaiHess 10/1/2014 23:58'!
showHierarchy: aBoolean

	showHierarchy := aBoolean.
	self announcer announce: ( NautilusShowPackagesChanged boolean: aBoolean not )! !

!Nautilus methodsFor: 'accessing' stamp: ''!
showInstance: aBoolean

	showInstance := aBoolean.
	self announcer announce: ( NautilusShowInstanceChanged boolean: aBoolean )! !

!Nautilus methodsFor: 'accessing' stamp: ''!
selectedClass

	^ selectedClass! !

!Nautilus methodsFor: 'history' stamp: 'NicolaiHess 1/11/2014 00:21'!
package: aPackage class: aClass category: aCategory method: aMethod

	self 
		selectedPackage: aPackage;
		selectedClass: aClass;
		selectedCategory: aCategory;
		selectedMethod: aMethod.
		
	self selectedClass notNil ifTrue:[self registerHistoryNewEntry ]! !

!Nautilus methodsFor: 'accessing' stamp: ''!
classes
	
	^ self browsedEnvironment classes! !

!Nautilus methodsFor: 'accessing' stamp: ''!
showInstance

	^ showInstance ifNil: [ showInstance := true ]! !

!Nautilus methodsFor: 'browser compatibility' stamp: 'EstebanLorenzano 10/9/2013 16:20'!
setClass: aClass selector: aSelector 
	
	| method protocol |
	method := aClass methodDict at: aSelector ifAbsent: [ nil ].
	protocol := method 
					ifNil: [ nil ]
					ifNotNil: [ method protocol ].
	self 
		showGroups: false;
		selectedPackage: (self parentOfClass: aClass);
		selectedClass: aClass;
		showInstance: aClass isMeta not;
		selectedCategory: protocol;
		selectedMethod: method
	! !

!Nautilus methodsFor: 'comparing' stamp: ''!
= aNautilus

	self class = aNautilus class ifFalse: [ ^ false ].
	1 to: self class instVarNames size do: [:index |
		(self instVarAt: index) = (aNautilus instVarAt: index)
			ifFalse: [ ^ false ]].
	^ true! !

!Nautilus methodsFor: 'private' stamp: 'NicolaiHess 4/7/2014 22:27'!
shouldOpenOnGroups

	^ self class openOnGroups and: [ (self class groupsManager) isEmpty not ]! !

!Nautilus methodsFor: 'browser compatibility' stamp: ''!
contents: aText

	self ui sourceCode: aText! !

!Nautilus methodsFor: 'accessing' stamp: ''!
selectedGroup: anObject

	selectedGroup := anObject.
	self announcer announce: ( NautilusGroupSelected group: anObject ).! !

!Nautilus class methodsFor: 'browser compatibility' stamp: 'BernardoContreras 7/17/2012 21:20'!
newOnClass: aClass selector: aSelector 

	^ self fullOnClass: aClass selector: aSelector ! !

!Nautilus class methodsFor: 'opening' stamp: ''!
openOnMethod: aMethod
	
	^ self openOnMethod: aMethod inEnvironment: self defaultBrowsedEnvironment! !

!Nautilus class methodsFor: 'accessing' stamp: 'NicolaiHess 9/27/2014 23:46'!
sortHierarchically: aBoolean

	SortHierarchically := aBoolean! !

!Nautilus class methodsFor: 'accessing' stamp: ''!
pluginClasses

	^ PluginClasses ifNil: [ PluginClasses := OrderedCollection new ].! !

!Nautilus class methodsFor: 'accessing' stamp: ''!
maxSize: anInteger

	maxSize := anInteger.
	self recentClasses maxSize: anInteger.! !

!Nautilus class methodsFor: 'opening' stamp: 'BenjaminVanRyseghem 5/13/2012 17:36'!
openOnCategory: aCategory ofClass: aClass inEnvironment: anEnvironment

	| instance |
	instance := self new.
	instance browsedEnvironment: anEnvironment.
	instance showInstance: aClass isMeta not.
	instance showGroups: false.
	instance package: aClass package class: aClass category: aCategory method: nil.
	instance open.
		
	^ instance! !

!Nautilus class methodsFor: 'opening' stamp: 'BenjaminVanRyseghem 6/26/2012 23:57'!
openOnClass: aClass onProtocol: aProtocol

	^ self 
		openOnClass: aClass 
		onProtocol: aProtocol 
		inEnvironment: self defaultBrowsedEnvironment! !

!Nautilus class methodsFor: 'private' stamp: ''!
defaultBrowsedEnvironment

	^ RBBrowserEnvironment new! !

!Nautilus class methodsFor: 'opening' stamp: 'NicolaiHess 9/7/2014 19:15'!
openOnPackage: aPackage inEnvironment: anEnvironment

	| instance |
	instance := self new.
	instance browsedEnvironment: anEnvironment.
	instance showGroups: false.
	instance selectedPackage: aPackage.
	instance open.
	instance ui showHierarchy: false.
	^ instance! !

!Nautilus class methodsFor: 'settings' stamp: ''!
switchClassesAndPackages

	^ SwitchClassesAndPackages ifNil: [ SwitchClassesAndPackages := false ]! !

!Nautilus class methodsFor: 'settings' stamp: 'EstebanLorenzano 2/4/2013 17:47'!
emptyCommentWarning
	^emptyCommentWarning ifNil: [ emptyCommentWarning := true ]! !

!Nautilus class methodsFor: 'opening' stamp: ''!
openOnPackage: aPackage

	^ self openOnPackage: aPackage inEnvironment: self defaultBrowsedEnvironment! !

!Nautilus class methodsFor: 'accessing' stamp: ''!
openOnGroups

	^ OpenOnGroups ifNil: [ OpenOnGroups := false ]! !

!Nautilus class methodsFor: 'accessing' stamp: ''!
historyMaxSize

	^ HistoryMaxSize ifNil: [ HistoryMaxSize := self defaultMaxSize ]! !

!Nautilus class methodsFor: 'browser compatibility' stamp: 'NicolaiHess 8/9/2014 23:24'!
fullOnClass: class 	selector: selector highlight: autoSelectString
	| nautilus |

	nautilus := self fullOnClass: class selector: selector.
	autoSelectString ifNotNil: [ nautilus ui highlight: autoSelectString ]! !

!Nautilus class methodsFor: 'accessing' stamp: ''!
showAnnotationPane: aBoolean

	ShowAnnotationPane := aBoolean! !

!Nautilus class methodsFor: 'settings' stamp: 'EstebanLorenzano 2/6/2013 14:27'!
useOldStyleKeys: aBoolean
	useOldStyleKeys := aBoolean! !

!Nautilus class methodsFor: 'settings' stamp: 'EstebanLorenzano 2/4/2013 17:53'!
emptyCommentWarning:aBoolean
	emptyCommentWarning := aBoolean.
	AbstractNautilusUI resetClassesIconsCache! !

!Nautilus class methodsFor: 'settings' stamp: ''!
commentPosition

	^ CommentPosition ifNil: [ self defaultCommentPosition ]! !

!Nautilus class methodsFor: 'accessing' stamp: 'StephaneDucasse 11/30/2013 13:56'!
resetGroups 
	groups := nil.! !

!Nautilus class methodsFor: 'events' stamp: 'CamilleTeruel 7/29/2012 18:46'!
stopNotifications
	" self stopNotifications "
	SystemAnnouncer uniqueInstance unsubscribe: self! !

!Nautilus class methodsFor: 'cleanup' stamp: 'md 4/15/2014 16:47'!
cleanUp
	AbstractNautilusUI resetIconCaches.
	RecentClasses := nil.
! !

!Nautilus class methodsFor: 'private' stamp: ''!
defaultCommentPosition

	^ #right! !

!Nautilus class methodsFor: 'opening' stamp: 'NicolaiHess 9/7/2014 19:09'!
openOnPackage: selectedPackage class: selectedClass category: selectedCategory method: selectedMethod group: selectedGroup showGroups: showGroups sortHierarchically: sortHierarchically showHierarchy: showHierarchy showComment: showComment  showInstance: showInstance showCategories: showCategories

	^ self openOnPackage: selectedPackage class: selectedClass category: selectedCategory method: selectedMethod group: selectedGroup showGroups: showGroups sortHierarchically: sortHierarchically showHierarchy: showHierarchy showComment: showComment  showInstance: showInstance showCategories: showCategories inEnvironment: self defaultBrowsedEnvironment! !

!Nautilus class methodsFor: 'opening' stamp: ''!
open
	^ self openInEnvironment: self defaultBrowsedEnvironment! !

!Nautilus class methodsFor: 'opening' stamp: ''!
openOnCategory: aCategory ofClass: aClass

	^ self openOnCategory: aCategory ofClass: aClass inEnvironment: self defaultBrowsedEnvironment! !

!Nautilus class methodsFor: 'icon' stamp: ''!
icon 

	^ AbstractNautilusUI icon! !

!Nautilus class methodsFor: 'opening' stamp: 'NicolaiHess 9/7/2014 19:15'!
openOnClass: aClass onProtocol: aProtocol inEnvironment: anEnvironment

	| instance |
	instance := self new.
	instance 
		browsedEnvironment: anEnvironment;
		showInstance: aClass isMeta not;
		selectedCategory: aProtocol;
		package: aClass package class: aClass category: nil method: nil;
		open.
	instance ui 
		showHierarchy: self switchClassesAndPackages.
	instance ui 
		selectedCategory: aProtocol;
		categorySelectionChanged;
		changed: #currentHistoryIndex.
	^ instance! !

!Nautilus class methodsFor: 'opening' stamp: 'JurajKubelka 2/3/2015 23:50'!
openOnMethod: aMethod inEnvironment: anEnvironment

	| instance class |
	class := aMethod methodClass.
	instance := self new.
	instance 
		browsedEnvironment: anEnvironment;
		showInstance: class isMeta not;
		showGroups: false;
		package: (self parentOfClass: class) 
			class: class 
			category: aMethod protocol asString 
			method: aMethod;
		open.
		
	 instance ui 
		useLastPackagePatternStringForClass: class;
		showHierarchy: self switchClassesAndPackages;
		giveFocusToMethod.

	^ instance! !

!Nautilus class methodsFor: 'browser compatibility' stamp: ''!
fullOnClass: aClass 

	^ self openOnClass: aClass! !

!Nautilus class methodsFor: 'opening' stamp: 'JurajKubelka 12/17/2014 11:22'!
openInEnvironment: anEnvironment

	| instance |
	instance := self new.
	instance 
		browsedEnvironment: anEnvironment;
		open.
	instance ui 
		useLastPackagePatternString;
		showHierarchy: self switchClassesAndPackages.
	^ instance! !

!Nautilus class methodsFor: 'system startup' stamp: 'MarcusDenker 10/16/2013 14:32'!
shutDown
	self cleanUp! !

!Nautilus class methodsFor: 'settings' stamp: 'MarcusDenker 8/6/2014 10:31'!
showDebugMenus
	^ShowDebugMenus ifNil: [ false ]! !

!Nautilus class methodsFor: 'private' stamp: ''!
defaultMaxSize

	^ NavigationHistory defaultMaxSize! !

!Nautilus class methodsFor: 'accessing' stamp: 'NicolaiHess 9/27/2014 23:46'!
sortHierarchically

	^ SortHierarchically ifNil: [ SortHierarchically := true ]! !

!Nautilus class methodsFor: 'accessing' stamp: ''!
historyMaxSize: anInteger

	(anInteger isKindOf: Integer) ifFalse: [ ^ self ].
	anInteger > 0 ifFalse: [ ^ self ].
	HistoryMaxSize := anInteger! !

!Nautilus class methodsFor: 'settings' stamp: 'BenjaminVanRyseghem 2/5/2013 14:35'!
populateMethodList

	^ populateMethodList ifNil: [ populateMethodList := self defaultPopulateMethodList ]! !

!Nautilus class methodsFor: 'accessing' stamp: 'NicolaiHess 4/7/2014 22:29'!
groupsManager
	^ groups ifNil: [ groups := self buildGroupManager ]! !

!Nautilus class methodsFor: 'settings' stamp: 'StephaneDucasse 11/11/2014 18:43'!
nautilusSettingsOn: aBuilder
	<systemsettings>
	(aBuilder group: #codeBrowsing) 
		label: 'Code Browsing';
		description: 'All settings concerned with code browsing look''n feel';
		with: [	
	(aBuilder group: #Nautilus)
		target: self;
		label: 'Nautilus Browser';
		parent: #codeBrowsing; 
		description: 'Settings related to the browser';
		with: [
			(aBuilder setting: #openOnGroups)
				label: 'Open the browser on groups ?';
				description: 'If true, Nautilus will show groups when opened' .
			(aBuilder pickOne: #commentPosition)
				label: 'Position of the comment pane:';
				target: self;
				default: self defaultCommentPosition;
				order: 1;
				domainValues: self commentPositions.
			(aBuilder setting: #sortHierarchically)
				label: 'Show hierarchy by default ?';
				description: 'If false, Nautilus will show a flat list of classes'.
			(aBuilder setting: #historyMaxSize)
				label: 'Set the max size of the navigation history' ;
				description: ('By default, the value is ', self defaultMaxSize printString).
			(aBuilder setting: #switchClassesAndPackages)
				label: 'Switch lists when opening on a class ?';
				description: 'Default value: false'.
			(aBuilder setting: #warningLimit)
				label: 'Set the warning limit of source code pane';
				description: 'By default, the value is 350
Put a negative value to disable'.
			(aBuilder setting: #emptyCommentWarning)
				label: 'Enable/disable warning for empty comments';
				description: 'Enable/disable the warning for empty comments. CAUTION!! To have comments in your classes is highly recomended'. 
			(aBuilder setting: #populateMethodList)
				label: 'Populate the method list at opening ?';
				default: self defaultPopulateMethodList;
				description: 'If true, the browser may be a bit slower to open on big classes. If false, you will need an extra click to access a method'.
			(aBuilder setting: #useOldStyleKeys)
				label: 'Use old style keys ?';
				description: 'If true, the browser will use the old style keys (This is highly non-recommended, you will lose a lot of cool access keys)'.
			(aBuilder setting: #showDebugMenus)
				label: 'Show DEBUG menu?';
				description: 'If true, the browser will show DEBUG entries in all menus for debugging Nautilus itself'.
				]]! !

!Nautilus class methodsFor: 'private' stamp: 'NicolaiHess 4/7/2014 22:26'!
buildGroupManager
	| holder |
	
	holder := GroupHolder new.
	
	(holder 
		addADynamicClassGroupSilentlyNamed: 'Most Viewed Classes' 
		block: [ self recentClassesElements ]) removable: false.
	(holder
		addADynamicClassGroupSilentlyNamed: 'Last Modified Classes'
		block: [ self lastModifiedClasses ]) removable: false.	
	(holder
		addADynamicGroupSilentlyNamed: 'Work'
		block: [ {} ]) removable: true; isFillable: true.
		
	^ holder
			! !

!Nautilus class methodsFor: 'groups' stamp: 'md 4/15/2014 16:47'!
lastModifiedClasses

	^  RecentMessageList uniqueInstance lastClasses: 10! !

!Nautilus class methodsFor: 'settings' stamp: 'MarcusDenker 8/6/2014 10:31'!
showDebugMenus: aBoolean
	ShowDebugMenus := aBoolean! !

!Nautilus class methodsFor: 'accessing' stamp: ''!
warningLimit

	^ WarningLimit ifNil: [ WarningLimit := 350 ]! !

!Nautilus class methodsFor: 'opening' stamp: ''!
openOnClass: aClass onGroup: aGroup inEnvironment: anEnvironment

	| instance |
	instance := self new.
	instance browsedEnvironment: anEnvironment.
	instance showInstance: aClass isMeta not.
	instance showGroups: true.
	instance selectedGroup: aGroup.
	instance package: aClass package class: aClass category: nil method: nil.
	instance open.
	^ instance! !

!Nautilus class methodsFor: 'browser compatibility' stamp: ''!
newOnClass: aClass

	^ self fullOnClass: aClass! !

!Nautilus class methodsFor: 'accessing' stamp: ''!
maxSize

	^ maxSize ifNil: [ maxSize := 10]! !

!Nautilus class methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/14/2013 15:48'!
parentOfClass: aClass 
	^ aClass package! !

!Nautilus class methodsFor: 'private' stamp: 'BenjaminVanRyseghem 2/5/2013 14:35'!
defaultPopulateMethodList

	^ false! !

!Nautilus class methodsFor: 'settings' stamp: 'EstebanLorenzano 2/6/2013 14:03'!
useOldStyleKeys
	^useOldStyleKeys ifNil: [ useOldStyleKeys := false ]! !

!Nautilus class methodsFor: 'accessing' stamp: ''!
recentClasses

	^ RecentClasses ifNil: [ RecentClasses := HistoryCollection maxSize: self maxSize ]! !

!Nautilus class methodsFor: 'opening' stamp: ''!
openOnClass: aClass onGroup: aGroup
	
	^ self openOnClass: aClass onGroup: aGroup inEnvironment: self defaultBrowsedEnvironment.! !

!Nautilus class methodsFor: 'opening' stamp: ''!
openOnClass: aClass

	^ self openOnClass: aClass inEnvironment: self defaultBrowsedEnvironment! !

!Nautilus class methodsFor: 'instance creation' stamp: ''!
browsedEnvironment: anEnvironment

	^ self new browsedEnvironment: anEnvironment! !

!Nautilus class methodsFor: 'settings' stamp: 'BenjaminVanRyseghem 2/5/2013 14:34'!
populateMethodList: aBoolean

	populateMethodList := aBoolean! !

!Nautilus class methodsFor: 'opening' stamp: 'JurajKubelka 12/17/2014 13:24'!
openOnClass: aClass inEnvironment: anEnvironment

	| instance |
	instance := self new.
	instance 
		browsedEnvironment: anEnvironment;
		showInstance: aClass isMeta not;
	 	showGroups: false;
	 	package: (self parentOfClass: aClass) 
			class: aClass 
			category: nil 
			method: nil;
	 	open.
	 instance ui 
		useLastPackagePatternStringForClass: aClass;
		showHierarchy: self switchClassesAndPackages;
		giveFocusToProtocol.
	^ instance! !

!Nautilus class methodsFor: 'browser compatibility' stamp: 'NicolaiHess 12/11/2013 11:24'!
fullOnClass: aClass selector: aSelector 

	^ aSelector
		ifNil: [ self openOnClass: aClass ]
		ifNotNil: [| method |
			method := aClass methodDict at: aSelector ifAbsent: [ ^ self openOnClass:aClass ].
			method ifNotNil: [ self openOnMethod: method ]]! !

!Nautilus class methodsFor: 'accessing' stamp: ''!
pluginClasses: aCollection

	PluginClasses := aCollection! !

!Nautilus class methodsFor: 'icon' stamp: ''!
taskbarIcon 

	^ AbstractNautilusUI icon! !

!Nautilus class methodsFor: 'opening' stamp: ''!
openOnGroup: aGroup inEnvironment: anEnvironment

	| instance |
	instance := self new.
	instance browsedEnvironment: anEnvironment.
	instance showGroups: true.
	instance selectedGroup: aGroup.
	instance open.
	^ instance! !

!Nautilus class methodsFor: 'accessing' stamp: ''!
openOnGroups:aBoolean

	OpenOnGroups := aBoolean! !

!Nautilus class methodsFor: 'settings' stamp: ''!
switchClassesAndPackages: aBoolean

	SwitchClassesAndPackages := aBoolean! !

!Nautilus class methodsFor: 'settings' stamp: ''!
commentPositions

	^ { #right. #bottom. #left. #top }! !

!Nautilus class methodsFor: 'opening' stamp: 'NicolaiHess 9/7/2014 19:10'!
openOnPackage: selectedPackage class: selectedClass category: selectedCategory method: selectedMethod group: selectedGroup showGroups: showGroups sortHierarchically: sortHierarchically showHierarchy: showHierarchy showComment: showComment  showInstance: showInstance showCategories: showCategories inEnvironment: anEnvironment

	| instance |
	instance := self new.
	instance browsedEnvironment: anEnvironment.
	
	instance package: selectedPackage class: selectedClass category: selectedCategory method: selectedMethod.
	instance selectedGroup: selectedGroup.	
	instance
		showGroups: showGroups;
		sortHierarchically: sortHierarchically;
		showComment: showComment;
		showInstance: showInstance;
		showCategories: showCategories.
	
	instance open.
	instance ui showHierarchy: showHierarchy.

	^ instance! !

!Nautilus class methodsFor: 'opening' stamp: ''!
openOnGroup: aGroup

	^ self openOnGroup: aGroup inEnvironment: self defaultBrowsedEnvironment! !

!Nautilus class methodsFor: 'settings' stamp: ''!
commentPosition: aSymbol

	(self commentPositions includes: aSymbol) ifFalse: [ ^ self ].
	CommentPosition := aSymbol! !

!Nautilus class methodsFor: 'browser compatibility' stamp: ''!
fullOnEnvironment: anEnvironment

	self openInEnvironment: anEnvironment! !

!Nautilus class methodsFor: 'private' stamp: 'NicolaiHess 4/7/2014 22:26'!
recentClassesElements
	^ self recentClasses mostViewedElements
		collect: [ :nm | Smalltalk at: nm ifAbsent: [nil] ]
		thenSelect: [ :e | e notNil ]! !

!Nautilus class methodsFor: 'accessing' stamp: ''!
warningLimit: anInteger

	WarningLimit := anInteger! !

!NautilusBooleanAnnouncement commentStamp: '<historical>'!
Announcement raised when a boolean value changed!
!NautilusBooleanAnnouncement methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/12/2011 11:21'!
boolean: anObject
	
		boolean := anObject! !

!NautilusBooleanAnnouncement methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/12/2011 11:21'!
boolean

		^ boolean! !

!NautilusBooleanAnnouncement class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 5/12/2011 11:21'!
boolean: aBoolean

	^ self new boolean: aBoolean! !

!NautilusBreadcrumbsPlugin commentStamp: '<historical>'!
A NautilusBreadcrumbsPlugin is a plugin which add breadcrumbs (for Igor ;) )
!
!NautilusBreadcrumbsPlugin methodsFor: 'registration' stamp: 'BernardoContreras 10/22/2014 19:14'!
registerTo: aModel

	aModel announcer
		when: NautilusPackageSelected send: #packageSelected: to: self;
		when: NautilusGroupSelected send: #groupSelected: to: self;
		when: NautilusClassSelected send: #classSelected: to: self;
		when: NautilusProtocolSelected send: #protocolSelected: to: self;
		when: NautilusMethodSelected send: #methodSelected: to: self;
		when: NautilusShowGroupsChanged send: #showGroupsChanged: to: self.! !

!NautilusBreadcrumbsPlugin methodsFor: 'announcement' stamp: 'BenjaminVanRyseghem 5/13/2012 17:16'!
packageSelected: anAnnouncement
	| package |
	
	package := anAnnouncement package.
	packageButton ifNotNil: [ container removeMorph: packageButton ].	
	container removeMorph: self hFill.
	packageButton := PluggableButtonMorph new
							model: self;
							getMenuSelector: #packageMenu:;
							actionBlock: [:evt |
								evt shiftPressed 
									ifTrue: [ Nautilus openOnPackage: package ]
									ifFalse: [
										model ui
											selectedClass: nil;
											selectedPackage: package ]].
	packageButton
		label: package name;
		height: 25.
	(package isNil or: [ model showGroups ]) ifFalse: [ container addMorph: packageButton ].
	container addMorph: self hFill.! !

!NautilusBreadcrumbsPlugin methodsFor: 'menus' stamp: 'NicolaiHess 7/26/2014 13:23'!
classMenu: aMenu
	
	^ self model ui classWidget classesMenu: aMenu shifted: false.
	! !

!NautilusBreadcrumbsPlugin methodsFor: 'announcement' stamp: 'BenjaminVanRyseghem 5/13/2012 17:09'!
classSelected: anAnnouncement
	| class |
	class := anAnnouncement itemClass.
	classButton ifNotNil: [ container removeMorph: classButton ].
	container removeMorph: self hFill.
	classButton := PluggableButtonMorph new
							model: self;
							getMenuSelector: #classMenu:;
							actionBlock: [:evt | evt shiftPressed
												ifTrue: [ class browse ]
												ifFalse: [ model ui selectedClass: class ]].
	classButton
		label: class name;
		height: 25.
	class ifNotNil: [ container addMorph: classButton ].
	container addMorph: self hFill.! !

!NautilusBreadcrumbsPlugin methodsFor: 'menus' stamp: 'BenjaminVanRyseghem 5/13/2012 17:31'!
methodMenu: aMenu
	
	^ self model ui methodWidget elementsMenu: aMenu shifted: false.! !

!NautilusBreadcrumbsPlugin methodsFor: 'display' stamp: 'BenjaminVanRyseghem 3/9/2012 21:34'!
display

	^ container! !

!NautilusBreadcrumbsPlugin methodsFor: 'announcement' stamp: 'BenjaminVanRyseghem 5/13/2012 17:15'!
groupSelected: anAnnouncement
	| group |
	group := anAnnouncement group.
	groupButton ifNotNil: [ container removeMorph: groupButton ].
	container removeMorph: self hFill.
	groupButton := PluggableButtonMorph new
							model: self;
							getMenuSelector: #groupMenu:;
							actionBlock: [:evt | 
								evt shiftPressed
									ifTrue: [ Nautilus openOnGroup: group ]
									ifFalse: [ model ui selectedGroup: group ]].
								
	groupButton
		label: group name;
		height: 25.
	group ifNotNil: [ container addMorph: groupButton ].
	container addMorph: self hFill! !

!NautilusBreadcrumbsPlugin methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 23:05'!
initialize

	super initialize.

	classButton := nil.
	container := PanelMorph new
					changeTableLayout;
					listDirection: #rightToLeft;
					hResizing: #spaceFill;
					vResizing: #rigid;
					addMorph: self hFill;
					height: 25.
	methodButton := nil.
	packageButton := nil.
	protocolButton := nil.! !

!NautilusBreadcrumbsPlugin methodsFor: 'announcement' stamp: 'BenjaminVanRyseghem 3/9/2012 22:11'!
showGroupsChanged: anAnnouncement

	container removeMorph: self hFill.
	model showGroups 
		ifTrue: [ 
			groupButton ifNotNil: [ container addMorph: groupButton behind: packageButton ].
			packageButton ifNotNil: [ container removeMorph: packageButton ]]
		ifFalse: [
			packageButton ifNotNil: [ container addMorph: packageButton behind: groupButton ].
			groupButton ifNotNil: [ container removeMorph: groupButton ]].
	container addMorph: self hFill.! !

!NautilusBreadcrumbsPlugin methodsFor: 'announcement' stamp: 'NicolaiHess 8/2/2014 21:51'!
protocolSelected: anAnnouncement
	| protocol |
	
	protocol := anAnnouncement category.
	protocolButton ifNotNil: [ container removeMorph: protocolButton ].
	container removeMorph: self hFill.
	protocolButton := PluggableButtonMorph new
							model: self;
							getMenuSelector: #protocolMenu:;
							actionBlock: [:evt |
								evt shiftPressed 
									ifTrue: [
										Nautilus openOnCategory: protocol ofClass: self model selectedClass ]
									ifFalse: [
										model ui selectedCategory: protocol.
										model ui updateCategoryAndMethod ]].
	protocolButton
		label: protocol asString;
		height: 25.
	protocol ifNotNil: [ container addMorph: protocolButton ].
	container addMorph: self hFill.! !

!NautilusBreadcrumbsPlugin methodsFor: 'announcement' stamp: 'BenjaminVanRyseghem 5/13/2012 17:30'!
methodSelected: anAnnouncement
	| method |
	method := anAnnouncement method.
	methodButton ifNotNil: [ container removeMorph: methodButton ].
	container removeMorph: self hFill.
	methodButton := PluggableButtonMorph new
							model: self;
							getMenuSelector: #methodMenu:;
							actionBlock: [ model ui selectedMethod: method ].
	method ifNotNil: [ 
		methodButton
			label: method selector asString;
			height: 25.
		container addMorph: methodButton ].
	container addMorph: self hFill.! !

!NautilusBreadcrumbsPlugin methodsFor: 'private' stamp: 'BenjaminVanRyseghem 3/9/2012 21:48'!
resetContainer
	
	container removeAllMorphs! !

!NautilusBreadcrumbsPlugin methodsFor: 'menus' stamp: 'BenjaminVanRyseghem 5/13/2012 17:15'!
groupMenu: aMenu
	
	^ self model ui menu: aMenu shifted: false.
	! !

!NautilusBreadcrumbsPlugin methodsFor: 'menus' stamp: 'BenjaminVanRyseghem 5/13/2012 17:16'!
packageMenu: aMenu
	
	^ self model ui menu: aMenu shifted: false.
	! !

!NautilusBreadcrumbsPlugin methodsFor: 'menus' stamp: 'BenjaminVanRyseghem 5/13/2012 17:32'!
protocolMenu: aMenu
	
	^ self model ui categoryWidget categoriesMenu: aMenu shifted: false.! !

!NautilusBreadcrumbsPlugin methodsFor: 'private' stamp: 'BenjaminVanRyseghem 3/9/2012 21:46'!
hFill

	^ hFill ifNil: [ hFill := Morph new
								height: 0;
								width: 2;
								hResizing: #spaceFill;
								vResizing: #rigid;
								yourself ].! !

!NautilusBreadcrumbsPlugin class methodsFor: 'position' stamp: 'BenjaminVanRyseghem 3/9/2012 21:40'!
defaultPosition

	^ #middle! !

!NautilusBreadcrumbsPlugin class methodsFor: 'information' stamp: 'BenjaminVanRyseghem 5/2/2012 13:16'!
pluginName

	^ 'BreadCrumbs'! !

!NautilusBreadcrumbsPlugin class methodsFor: 'information' stamp: 'StephaneDucasse 10/30/2014 08:23'!
description

	^ 'Present an interactive navigation path to the current selected element. Menus are active on the elements.'! !

!NautilusChanged commentStamp: '<historical>'!
A NautilusChanged is raised when a NautilusUI send th message #changed:!
!NautilusChanged methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/13/2012 21:34'!
symbol
	^ symbol! !

!NautilusChanged methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/13/2012 21:34'!
symbol: anObject
	symbol := anObject! !

!NautilusChanged class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 6/13/2012 21:34'!
symbol: symbol

	^ self new
		symbol: symbol;
		yourself! !

!NautilusClassSelected commentStamp: '<historical>'!
A NautilusClassSelected is raised when a class is selected!
!NautilusClassSelected methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/10/2011 14:45'!
class: anObject
	
		class := anObject! !

!NautilusClassSelected methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/10/2011 14:47'!
itemClass

	^ class! !

!NautilusClassSelected class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 5/10/2011 14:48'!
class: aClass

	^ self new class: aClass! !

!NautilusGroupSelected commentStamp: '<historical>'!
A NautilusGroupSelected is raised when a group is selected!
!NautilusGroupSelected methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/10/2011 14:46'!
group: anObject
	
		group := anObject! !

!NautilusGroupSelected methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/10/2011 14:46'!
group

		^ group! !

!NautilusGroupSelected class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 5/10/2011 14:48'!
group: aGroup

	^ self new group: aGroup! !

!NautilusHelp commentStamp: '<historical>'!
I am a page of the Help book related to Nautilus!
!NautilusHelp class methodsFor: 'accessing' stamp: 'SeanDeNigris 2/6/2013 14:42'!
bookName

	^ 'Nautilus'.! !

!NautilusHelp class methodsFor: 'accessing' stamp: 'SeanDeNigris 2/6/2013 14:46'!
pages

	^ #(contextMenus).
! !

!NautilusHelp class methodsFor: 'menus' stamp: 'SeanDeNigris 2/6/2013 14:51'!
contextMenus

	^ HelpTopic
		title: 'Adding to context menus'
		contents: 'On the class-side of your object, create a method that:
	1. takes one argument (a PragmaMenuAndShortcutRegistration).
	2. Begins with the pragma for whichever menu you want to extend (see AbstractNautilusUI "menu pragmas" protocol)
	
	For example, to extend the menu for the method list pane:
		methodMenu: aBuilder
			<nautilusGlobalMethodMenu>
			
	To see existing examples in your image, browse senders of that pragma'! !

!NautilusHistoryEntry commentStamp: '<historical>'!
I am a history entry which hold a single step of the Nautilus browsing history!
!NautilusHistoryEntry methodsFor: 'accessing' stamp: 'NicolaiHess 9/27/2014 23:52'!
sortHierarchically

		^ sortHierarchically! !

!NautilusHistoryEntry methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/18/2013 17:32'!
showComment: anObject
	
		showComment := anObject! !

!NautilusHistoryEntry methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/18/2013 17:32'!
selectedCategory

		^ selectedCategory! !

!NautilusHistoryEntry methodsFor: 'accessing' stamp: 'NicolaiHess 12/24/2014 13:56'!
selectedMethod
	selectedSelector ifNil: [ ^ nil ].
	^ selectedClass ifNil: [ nil ] ifNotNil: [ selectedClass compiledMethodAt: selectedSelector ifAbsent: [ nil ] ]! !

!NautilusHistoryEntry methodsFor: 'protocol' stamp: 'NicolaiHess 12/20/2014 00:23'!
applyTo: aNautilus
	aNautilus ui ifNotNil: [ :interface | interface resetAllListSelections ].
	aNautilus
		selectedPackage: self selectedPackage;
		selectedClass: selectedClass;
		selectedCategory: self selectedCategory.
	aNautilus selectedMethod: self selectedMethod.
	aNautilus browsingHistory
		pauseDuring: [ 
			aNautilus
				selectedGroup: self selectedGroup;
				showHierarchy: self showHierarchy;
				showGroups: self showGroups;
				sortHierarchically: self sortHierarchically;
				showComment: self showComment;
				showInstance: self showInstance;
				showCategories: self showCategories ].
	aNautilus ui
		ifNotNil: [ :interface | 
			interface showHierarchy: aNautilus showHierarchy.
			interface showInstance: (selectedClass ifNil: [ false ] ifNotNil: [ selectedClass isMeta not ]).
			interface
				selectedPackageWithoutChangingSelectionInternally: self selectedPackage;
				selectedClassWithoutChangingSelectionInternally: selectedClass;
				selectedCategoryInternally: self selectedCategory.
			interface updatePackageGroupAndClassList.
			interface selectedMethod: self selectedMethod.
			interface updateCategoryAndMethodList ]! !

!NautilusHistoryEntry methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/18/2013 17:32'!
showCategories: anObject
	
		showCategories := anObject! !

!NautilusHistoryEntry methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/18/2013 17:32'!
showComment

		^ showComment! !

!NautilusHistoryEntry methodsFor: 'accessing' stamp: 'NicolaiHess 9/27/2014 23:52'!
sortHierarchically: anObject
	
		sortHierarchically := anObject! !

!NautilusHistoryEntry methodsFor: 'accessing' stamp: 'NicolaiHess 12/20/2014 00:22'!
selectedSelector: anObject
	
		selectedSelector := anObject! !

!NautilusHistoryEntry methodsFor: 'accessing' stamp: 'NicolaiHess 12/20/2014 00:22'!
selectedMethod: anObject
	
		selectedSelector := anObject! !

!NautilusHistoryEntry methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/18/2013 17:32'!
showCategories

		^ showCategories! !

!NautilusHistoryEntry methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/18/2013 17:32'!
selectedClass: anObject
	
		selectedClass := anObject! !

!NautilusHistoryEntry methodsFor: 'accessing' stamp: 'NicolaiHess 10/1/2014 23:59'!
showHierarchy

		^ showHierarchy! !

!NautilusHistoryEntry methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/18/2013 17:32'!
selectedPackage

		^ selectedPackage! !

!NautilusHistoryEntry methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/18/2013 17:32'!
selectedGroup

		^ selectedGroup! !

!NautilusHistoryEntry methodsFor: 'protocol' stamp: 'NicolaiHess 12/20/2014 00:22'!
hash
	| hash |
	hash := selectedPackage hash.
	{ selectedCategory . selectedSelector . selectedClass . selectedGroup } do: [ :iv |
		hash := hash bitXor: iv hash ].
	^ hash! !

!NautilusHistoryEntry methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/18/2013 17:32'!
selectedClass

		^ selectedClass! !

!NautilusHistoryEntry methodsFor: 'protocol' stamp: 'NicolaiHess 12/20/2014 00:21'!
asHistoryString
	| label separator |
	separator := ' >>#'.
	label := self showGroups
		ifTrue: [ 
			Text
				streamContents: [ :s | 
					self selectedGroup
						ifNotNil: [ :g | 
							s << ('G: ' asText addAttribute: TextEmphasis italic from: 1 to: 3)
								<< (g name asText addAttribute: TextEmphasis italic from: 1 to: g name size).
							self selectedClass
								ifNotNil: [ :c | 
									s << separator << c name.
									self selectedSelector ifNotNil: [ :m | s << separator << m asString ] ] ] ] ]
		ifFalse: [ 
			String
				streamContents: [ :s | 
					self selectedPackage
						ifNotNil: [ :p | 
							self selectedClass
								ifNotNil: [ :c | 
									s << c name.
									self selectedSelector ifNotNil: [ :m | s << separator << m asString ] ] ] ] ].
	^ label! !

!NautilusHistoryEntry methodsFor: 'accessing' stamp: 'NicolaiHess 10/1/2014 23:59'!
showHierarchy: anObject
	
		showHierarchy:= anObject! !

!NautilusHistoryEntry methodsFor: 'private' stamp: 'NicolaiHess 12/20/2014 00:20'!
with: aNautilus
	
	self 
		selectedPackage: aNautilus selectedPackage;
		selectedCategory: aNautilus selectedCategory.
		aNautilus selectedMethod
			ifNil: [ self selectedSelector: nil ]
			ifNotNil: [:met | self selectedSelector: met selector].
	self
		selectedClass: aNautilus selectedClass;
		selectedGroup: aNautilus selectedGroup;
		showHierarchy: aNautilus showHierarchy;
		showGroups: aNautilus showGroups;
		sortHierarchically: aNautilus sortHierarchically;
		showComment: aNautilus showComment;
		showInstance: aNautilus showInstance;
		showCategories: aNautilus showCategories.! !

!NautilusHistoryEntry methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/18/2013 17:32'!
showInstance: anObject
	
		showInstance := anObject! !

!NautilusHistoryEntry methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/18/2013 17:32'!
showGroups: anObject
	
		showGroups := anObject! !

!NautilusHistoryEntry methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/18/2013 17:32'!
selectedCategory: anObject
	
		selectedCategory := anObject! !

!NautilusHistoryEntry methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/18/2013 17:32'!
showInstance

		^ showInstance! !

!NautilusHistoryEntry methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/18/2013 17:32'!
selectedPackage: anObject
	
		selectedPackage := anObject! !

!NautilusHistoryEntry methodsFor: 'protocol' stamp: 'NicolaiHess 12/20/2014 00:22'!
= anotherWrapper

	self species = anotherWrapper species ifFalse: [ ^ false ].
	^ 	self selectedPackage = anotherWrapper selectedPackage and: [ 
		self selectedGroup = anotherWrapper selectedGroup and: [
		self selectedClass = anotherWrapper selectedClass and: [
		self selectedCategory = anotherWrapper selectedCategory and: [
		self selectedSelector = anotherWrapper selectedSelector and: [
		self showHierarchy = anotherWrapper showHierarchy and: [
		self showInstance = anotherWrapper showInstance and: [
		self showGroups = anotherWrapper showGroups and: [
		self sortHierarchically = anotherWrapper sortHierarchically and: [
		self showComment = anotherWrapper showComment and:[
		self showCategories = anotherWrapper showCategories ]]]]]]]]]]! !

!NautilusHistoryEntry methodsFor: 'accessing' stamp: 'NicolaiHess 12/20/2014 00:23'!
selectedSelector

	^ selectedSelector! !

!NautilusHistoryEntry methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/18/2013 17:32'!
selectedGroup: anObject
	
		selectedGroup := anObject! !

!NautilusHistoryEntry methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/18/2013 17:32'!
showGroups

		^ showGroups! !

!NautilusHistoryEntry class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 10/18/2013 17:32'!
with: aNautilus

	^ self new 
		with: aNautilus;
		yourself! !

!NautilusHistoryEntryWithSourceCode commentStamp: '<historical>'!
I am a special wrapper used to store in the history unsaved source code!
!NautilusHistoryEntryWithSourceCode methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/18/2013 17:33'!
applyTo: aNautilus

	super applyTo: aNautilus.
	aNautilus ui ifNotNil: [ :interface |
		interface pendingText: self sourceCode ].

	aNautilus removeFromHistory: self! !

!NautilusHistoryEntryWithSourceCode methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/18/2013 17:33'!
sourceCode
	^ sourceCode ifNil: [ '' ]! !

!NautilusHistoryEntryWithSourceCode methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/18/2013 17:33'!
asHistoryString
	
	^ '*', super asHistoryString! !

!NautilusHistoryEntryWithSourceCode methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/18/2013 17:33'!
sourceCode: anObject
	sourceCode := anObject! !

!NautilusHistoryEntryWithSourceCode class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 10/18/2013 17:33'!
with: aNautilus sourceCode: sourceCode

	^ self new
		with: aNautilus;
		sourceCode: sourceCode;
		yourself! !

!NautilusKeyPressed commentStamp: '<historical>'!
A NautilusKeyPressed is raised each time a key is pressed on a Nautilus ui!
!NautilusKeyPressed methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/4/2011 14:16'!
key

		^ key! !

!NautilusKeyPressed methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/4/2011 14:16'!
key: anObject
	
		key := anObject! !

!NautilusKeyPressed class methodsFor: 'as yet unclassified' stamp: 'BenjaminVanRyseghem 5/10/2011 12:26'!
key: aKey

	^ self new key: aKey! !

!NautilusMethodSelected commentStamp: '<historical>'!
A NautilusMethodSelected is raised each time a mehod is selected!
!NautilusMethodSelected methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/10/2011 14:45'!
method

		^ method! !

!NautilusMethodSelected methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/10/2011 14:45'!
method: anObject
	
		method := anObject! !

!NautilusMethodSelected class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 5/10/2011 14:49'!
method: aMethod

	^ self new method: aMethod! !

!NautilusMonticello commentStamp: '<historical>'!
A NautilusMonticello is a class used to handle monticello integration into Nautilus by creating the menu entries!
!NautilusMonticello methodsFor: 'monticello menus behavior' stamp: ''!
addRepositoryTo: aGroup
	| repo |
	(repo := self newRepository) ifNil: [ ^ self ].
	aGroup addRepository: repo.! !

!NautilusMonticello methodsFor: 'display' stamp: ''!
viewChanges: patch from: fromDescription to: toDescription in: workingCopy
	"Open a browser on the given patch."

	PSMCPatchMorph usedByDefault
		ifTrue: [((PSMCPatchMorph forPatch: patch)
						fromDescription: fromDescription;
						toDescription: toDescription;
						newWindow)
					title: ('Changes to {1}' translated format: {fromDescription});
					open]
		ifFalse: [(MCPatchBrowser forPatch: patch)
					label: 'Patch Browser: ', workingCopy description;
					show]! !

!NautilusMonticello methodsFor: 'monticello menus behavior' stamp: 'SeanDeNigris 6/21/2012 09:10'!
viewChangesFor: mcpackage in: repo
	| workingCopy patch |

	workingCopy := mcpackage workingCopy.
	'Finding changes' displayProgressFrom: 0 to: 10 during:[:bar|
		bar current: 1.
		patch := workingCopy changesRelativeToRepository: repo.
		bar current: 3.
		patch isEmpty
			ifTrue: [
				workingCopy modified: false.
				bar current: 10.
				self inform: 'No changes' ]
			ifFalse: [
				workingCopy modified: true.
				bar current: 5.
				self
					viewChanges: patch
					from: workingCopy  packageName, ' (', workingCopy ancestry ancestorString, ')'
					to: ('Modified {1}' translated format: {workingCopy description})
					in: workingCopy ]]! !

!NautilusMonticello methodsFor: 'monticello menus behavior' stamp: ''!
newRepository
	| types index |
	types := MCRepository allConcreteSubclasses asArray.
	index := UIManager default chooseFrom: (types collect: [:ea | ea description])
				title: 'Repository type:'.
	^ index = 0 ifFalse: [(types at: index) morphicConfigure]! !

!NautilusMonticello methodsFor: 'monticello menus behavior' stamp: 'EstebanLorenzano 9/8/2013 11:02'!
commit: workingCopy in: aRepository
	| newVersion |

	newVersion := workingCopy newVersionIn: aRepository.
	newVersion ifNil: [ ^ self ].
	Cursor wait showWhile: [
		[ 	aRepository storeVersion: newVersion.
			aRepository storeDependencies: newVersion ] 
		ensure: [ (MCVersionInspector new version: newVersion) show ]]! !

!NautilusMonticello methodsFor: 'monticello menus behavior' stamp: ''!
open: mcpackage in: repo 
	| workingCopy |

	repo ifNil: [ ^ self ].
	workingCopy := mcpackage workingCopy.
	repo morphicOpen: workingCopy! !

!NautilusMonticello methodsFor: 'monticello menus behavior' stamp: ''!
createMCPackageFor: aPackage
	| name |
	name := aPackage name.
	name isEmptyOrNil ifFalse: [ MCWorkingCopy forPackage: (MCPackage new name: name) ]! !

!NautilusMonticello class methodsFor: 'monticello menus' stamp: 'NicolaiHess 7/28/2014 22:41'!
packagesOpenMenu: aBuilder
	<nautilusGlobalPackageMenu>
	
	| package mcpackage target last group |
	
	target := aBuilder model.
	(package := target selectedPackage) ifNil: [ ^ target ].
	mcpackage := package mcPackage.
	mcpackage ifNil: [ ^ self ].
	
	(aBuilder item: #('Open ',package name))
		label: 'Open...';
		order: 1297;
		help: 'Open';
		icon: (Smalltalk ui icons iconNamed: #monticelloPackageIcon);
		enabledBlock: [ target selectedPackages size < 2 ].

	(group := mcpackage workingCopy repositoryGroup) repositories doWithIndex: [:repo : index |
		last := (aBuilder item: ('Repo',index printString))
					label: repo description;
					parent: #('Open ',package name);
					order: index;
					action: [ self default open: mcpackage in: repo ]].
	last ifNotNil:[: lastEntry| lastEntry withSeparatorAfter].
		(aBuilder item: 'Add a repository')
						parent: #('Open ',package name);
						order: 99;
						action: [ self default addRepositoryTo: group ]! !

!NautilusMonticello class methodsFor: 'singleton' stamp: ''!
default

	^ Default ifNil: [ Default := self basicNew initialize ]! !

!NautilusMonticello class methodsFor: 'instance creation' stamp: 'ChristopheDemarey 7/12/2013 17:34'!
new

	^ self default! !

!NautilusMonticello class methodsFor: 'monticello menus' stamp: 'MarcusDenker 7/16/2014 17:24'!
packagesChangesMenu: aBuilder
	<nautilusGlobalPackageMenu>
	
	| package mcpackage target |
	
	target := aBuilder model.
	(package := target selectedPackage) ifNil: [ ^ target ].
	mcpackage := package mcPackage.
	mcpackage ifNil: [ ^ self ].
	
	mcpackage isDirty
		ifTrue: [ 
			(aBuilder item: #('Changes with ',package name))
				label: 'Changes with...';
				order: 1295;
				help: 'Changes';
				icon: (Smalltalk ui icons iconNamed: #monticelloPackageIcon);
				enabledBlock: [ target selectedPackages size < 2 ].
				
	mcpackage workingCopy repositoryGroup repositories doWithIndex: [:repo : index |
		(aBuilder item: ('Repo',index printString))
					label: repo description;
					parent: #('Changes with ',package name);
					order: index;
					action: [ self default viewChangesFor: mcpackage in: repo ]]]! !

!NautilusMonticello class methodsFor: 'monticello menus' stamp: 'MarcusDenker 7/16/2014 17:24'!
packagesCreateMenu: aBuilder
	<nautilusGlobalPackageMenu>
	
	| package mcpackage target |
	
	target := aBuilder model.
	(package := target selectedPackage) ifNil: [ ^ target ].
	mcpackage := package mcPackage.
	mcpackage ifNotNil: [ ^ self ].
	
	(aBuilder item: #'Create a MC package')
		order: 1297;
		help: 'Create a MC package corresponding to my name';
		icon: (Smalltalk ui icons iconNamed: #monticelloPackageIcon);
		action: [ self default createMCPackageFor: target selectedPackage ];
		enabledBlock: [ target selectedPackages size < 2 ].! !

!NautilusMonticello class methodsFor: 'monticello menus' stamp: 'MarcusDenker 7/16/2014 17:24'!
packagesCommitsMenu: aBuilder
	<nautilusGlobalPackageMenu>
	
	| package mcpackage target |
	
	target := aBuilder model.
	(package := target selectedPackage) ifNil: [ ^ target ].
	mcpackage := package mcPackage.
	mcpackage ifNil: [ ^self ].
	
	mcpackage isDirty
		ifTrue: [ | last group |
			(aBuilder item: #('Commit in ',package name))
				label: 'Commit in...';
				order: 1296;
				help: 'Commit';
				icon: (Smalltalk ui icons iconNamed: #monticelloPackageIcon);
				enabledBlock: [ target selectedPackages size < 2 ].
	(group := mcpackage workingCopy repositoryGroup) repositories doWithIndex: [:repo : index |
		last := ((aBuilder item: ('Repo',index printString))
					label: repo description;
					parent: #('Commit in ',package name);
					order: index;
					action: [ self default commit: mcpackage workingCopy in: repo ])].
		last withSeparatorAfter.
		(aBuilder item: 'Add a repository')
						parent: #('Commit in ',package name);
						order: 99;
						action: [ self default addRepositoryTo: group ]]! !

!NautilusPackageSelected commentStamp: '<historical>'!
A NautilusPackageSelected is raised when a package is selected!
!NautilusPackageSelected methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/4/2011 14:15'!
package: anObject
	
		package := anObject! !

!NautilusPackageSelected methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/4/2011 14:15'!
package

		^ package! !

!NautilusPackageSelected class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 5/10/2011 12:28'!
package: aPackage

	^ self new package: aPackage! !

!NautilusPluginManager commentStamp: '<historical>'!
NautilusPluginManager is a manger of plugins used to set up plugin for Nautilus UI!
!NautilusPluginManager methodsFor: 'lists behavior' stamp: 'BenjaminVanRyseghem 5/11/2011 13:25'!
resetPluginClassesListSelection

	pluginClassesSelected removeAll! !

!NautilusPluginManager methodsFor: 'items creation' stamp: 'BenjaminVanRyseghem 8/25/2011 14:19'!
buildPluginClassesList

	| list |
	list := PluggableListMorph
		on: self
		list: #getPluginClassesList
		primarySelection: #pluginClassesSelectedIndex
		changePrimarySelection: #pluginClassesSelectedIndex:
		listSelection: #pluginClassesSelectedAt:
		changeListSelection: #pluginClassesSelectedAt:put:
		menu: nil
		keystroke: nil.
		
	list wrapSelector: #pluginName.
		
	list resetListSelector: #resetPluginClassesListSelection.
	list autoDeselect: true.
	
	list
		vResizing: #spaceFill;
		hResizing: #spaceFill.
	^ list! !

!NautilusPluginManager methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/11/2011 15:51'!
pluginClassesSelected

		^ pluginClassesSelected! !

!NautilusPluginManager methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/11/2011 15:51'!
pluginsList

		^ pluginsList! !

!NautilusPluginManager methodsFor: 'lists behavior' stamp: 'BenjaminVanRyseghem 2/17/2012 16:32'!
pluginClassesSelectedIndex: anInteger

	pluginClassesSelectedIndex := anInteger.
	self changed: #pluginClassesSelectedIndex.
	self changed: #getText.! !

!NautilusPluginManager methodsFor: 'tree' stamp: 'BenjaminVanRyseghem 8/25/2011 13:50'!
pluginsSelectedIndex: anIndex! !

!NautilusPluginManager methodsFor: 'private' stamp: 'BenjaminVanRyseghem 5/11/2011 15:57'!
centering
	self left: ((World width / 2) - (self width /2)).
	self top: ((World height / 2) - (self height /2))! !

!NautilusPluginManager methodsFor: 'display' stamp: 'BenjaminVanRyseghem 5/11/2011 15:49'!
buildPluginClassesBox

	^ GroupboxMorph new
			addContentMorph: self buildPluginClassesList;
			addContentMorph: self buildAddButton;
			label: 'Available plugin classes:';
			hResizing: #spaceFill;
			vResizing: #spaceFill.! !

!NautilusPluginManager methodsFor: 'display' stamp: 'BenjaminVanRyseghem 2/17/2012 16:34'!
newContentMorph

	| row column |
	row := PanelMorph new
				layoutPolicy: TableLayout new;
				listDirection: #leftToRight;
				vResizing: #spaceFill;	
				hResizing: #spaceFill;
				spaceFillWeight: 3;
				addMorph: self buildButtonsColumn;
				addMorph: self buildPluginsBox;
				addMorph: self buildPluginClassesBox.
	column := PanelMorph new
					layoutPolicy: TableLayout new;
					listDirection: #topToBottom;
					vResizing: #spaceFill;	
					hResizing: #spaceFill;
					addMorph: self buildDescriptionTextArea;
					addMorph: row.
	^ column! !

!NautilusPluginManager methodsFor: 'items creation' stamp: 'EstebanLorenzano 5/15/2013 11:15'!
buildUpButton

	^ IconicButton new 
		target: self;
		actionSelector: #up;
		labelGraphic: (Smalltalk ui icons iconNamed: #upIcon);
		color: Color transparent;
		extent: 24 @ 24;
		borderWidth: 0! !

!NautilusPluginManager methodsFor: 'display' stamp: 'BenjaminVanRyseghem 5/11/2011 15:49'!
buildPluginsBox

	^ GroupboxMorph new
			addContentMorph: self buildPluginsList;
			addContentMorph: self buildRemoveButton;
			label: 'Selected plugins:';
			hResizing: #spaceFill;
			vResizing: #spaceFill.! !

!NautilusPluginManager methodsFor: 'lists behavior' stamp: 'BenjaminVanRyseghem 5/2/2012 13:18'!
getPluginClassesList

	^ AbstractNautilusPlugin allSubclasses sort: [:a :b | a pluginName <= b pluginName ]! !

!NautilusPluginManager methodsFor: 'items creation' stamp: 'ChristopheDemarey 8/29/2013 17:26'!
buildFullDownButton

	^ IconicButton new 
		target: self;
		actionSelector: #fullDown;
		labelGraphic: (Smalltalk ui icons iconNamed: #bottomIcon);
		color: Color transparent;
		extent: 24 @ 24;
		borderWidth: 0! !

!NautilusPluginManager methodsFor: 'lists behavior' stamp: 'BenjaminVanRyseghem 5/11/2011 11:24'!
pluginClassesSelectedAt: anIndex

	| object |
	object := self getPluginClassesList at: anIndex ifAbsent: [ ^ false ].
	^ pluginClassesSelected at: object ifAbsent: [ false ]! !

!NautilusPluginManager methodsFor: 'private' stamp: 'BenjaminVanRyseghem 8/25/2011 13:51'!
fullDown

	| list selection |
	list := pluginsList copy.
	selection := self selectedPlugins.
	selection doWithIndex: [:idx :count || each |
		each := list at: idx.
		pluginsList removeAt: idx-count+1.
		pluginsList addLast: each].

	self changed: #getPluginsList.
	self changed: #allSelections.! !

!NautilusPluginManager methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 5/11/2011 13:39'!
initialize

	super initialize.
	pluginClassesSelected := Dictionary new.
	pluginsSelected := Dictionary new.! !

!NautilusPluginManager methodsFor: 'items creation' stamp: 'EstebanLorenzano 5/15/2013 11:15'!
buildDownButton

	^ IconicButton new 
		target: self;
		actionSelector: #down;
		labelGraphic: (Smalltalk ui icons iconNamed: #downIcon);
		color: Color transparent;
		extent: 24 @ 24;
		borderWidth: 0! !

!NautilusPluginManager methodsFor: 'private' stamp: 'BenjaminVanRyseghem 8/25/2011 11:11'!
treeClass

	^ NautilusPluginManagerTree! !

!NautilusPluginManager methodsFor: 'display' stamp: 'BenjaminVanRyseghem 5/11/2011 11:28'!
title

	^ 'Nautilus Plugins Manager'! !

!NautilusPluginManager methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 8/25/2011 12:54'!
addButtonAction
	
	self selectedPluginClasses do: [:each | 
		self pluginsList addLast: { each. each defaultPosition } ].
	tree update: #rootNodes! !

!NautilusPluginManager methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/11/2011 15:51'!
pluginsSelected: anObject
	
		pluginsSelected := anObject! !

!NautilusPluginManager methodsFor: 'items creation' stamp: 'ChristopheDemarey 8/29/2013 17:26'!
buildFullUpButton

	^ IconicButton new 
		target: self;
		actionSelector: #fullUp;
		labelGraphic: (Smalltalk ui icons iconNamed: #topIcon);
		color: Color transparent;
		extent: 24 @ 24;
		borderWidth: 0! !

!NautilusPluginManager methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 5/11/2011 15:47'!
addButtonLabel
	
	^ 'Add'! !

!NautilusPluginManager methodsFor: 'lists behavior' stamp: 'BenjaminVanRyseghem 5/11/2011 11:25'!
pluginClassesSelectedAt: anIndex put: aBoolean

	| object |
	object := self getPluginClassesList at: anIndex ifAbsent: [ ^ self ].
	^ pluginClassesSelected at: object put: aBoolean! !

!NautilusPluginManager methodsFor: 'lists behavior' stamp: 'BenjaminVanRyseghem 8/25/2011 12:48'!
getPluginsList

	^ pluginsList ifNil: [ pluginsList := Nautilus pluginClasses copy ].! !

!NautilusPluginManager methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/11/2011 15:51'!
pluginsSelected

		^ pluginsSelected! !

!NautilusPluginManager methodsFor: 'text area behavior' stamp: 'BenjaminVanRyseghem 2/17/2012 16:31'!
getText
	| item | 
	
	item := self getPluginClassesList at: self pluginClassesSelectedIndex ifAbsent: [ ^ nil ].
	^ item 
		ifNil: [ '' ]
		ifNotNil: [ item description ]! !

!NautilusPluginManager methodsFor: 'private' stamp: 'BenjaminVanRyseghem 8/25/2011 13:52'!
up

	| list selection firstIndex |
	list := pluginsList copy.
	firstIndex := pluginsList size.
	selection := self selectedPlugins.
	selection do: [:index || each newIndex |
		each := list at: index.
		firstIndex := index-1 min: firstIndex.
		newIndex := index-1 max: 1.
		pluginsList removeAt: index.
		pluginsList add: each beforeIndex: newIndex .
		].
	
	self pluginsSelectedIndex: firstIndex.
	
	self changed: #getPluginsList.
	self changed: #allSelections.! !

!NautilusPluginManager methodsFor: 'display' stamp: 'BenjaminVanRyseghem 5/11/2011 15:57'!
openInWorld

	super openInWorld.
	self width: 500.
	self height: 400.
	self centering! !

!NautilusPluginManager methodsFor: 'buttons behavior' stamp: 'MarcusDenker 9/27/2013 18:06'!
removeButtonAction
	
	self selectedPlugins reverse do: [:item | self pluginsList remove: item ].
	self resetPluginsListSelection.
	tree deselectAll.
	tree model setSelection: nil.
	tree update: #rootNodes! !

!NautilusPluginManager methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 5/11/2011 15:50'!
addButtonState
	
	^ self selectedPluginClasses isEmpty not! !

!NautilusPluginManager methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/11/2011 15:51'!
pluginClassesSelected: anObject
	
		pluginClassesSelected := anObject! !

!NautilusPluginManager methodsFor: 'private' stamp: 'BenjaminVanRyseghem 8/25/2011 13:51'!
down

	| list selection firstIndex maxSize |
	list := pluginsList copy.
	maxSize := pluginsList size.
	firstIndex := maxSize.
	selection := self selectedPlugins.
	selection reverse do: [:index || each newIndex |
		each := list at: index.
		firstIndex := index+1 min: firstIndex.
		newIndex := index+1 min: maxSize.
		pluginsList removeAt: index.
		pluginsList add: each beforeIndex: newIndex .
		"set selection"
		].
	self pluginsSelectedIndex: firstIndex.
	
	self changed: #getPluginsList.
	self changed: #allSelections.! !

!NautilusPluginManager methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 5/11/2011 15:47'!
removeButtonLabel
	
	^ 'Remove'! !

!NautilusPluginManager methodsFor: 'lists behavior' stamp: 'BenjaminVanRyseghem 5/11/2011 13:33'!
resetPluginsListSelection

	pluginsSelected removeAll! !

!NautilusPluginManager methodsFor: 'items creation' stamp: 'BenjaminVanRyseghem 5/11/2011 15:42'!
buildAddButton

	^  (PluggableButtonMorph
			on: self 
			getState: #addButtonState
			action: #addButtonAction
			label: #addButtonLabel) hResizing: #spaceFill; vResizing: #shrinkWrap! !

!NautilusPluginManager methodsFor: 'private' stamp: 'MarcusDenker 9/27/2013 18:04'!
fullUp

	| list selection |
	list := pluginsList copy.
	selection := self selectedPlugins.
	selection reverse doWithIndex: [:idx :count || each |
		each := list at: idx.
		pluginsList removeAt: (idx+count-1).
		pluginsList addFirst: each].
	
	self changed: #getPluginsList.
	self changed: #allSelections.! !

!NautilusPluginManager methodsFor: 'items creation' stamp: 'MarcusDenker 9/27/2013 18:02'!
buildButtonsColumn

	| column |
	column := PanelMorph new.
	column 
		changeTableLayout;
		listDirection: #topToBottom.
		
		{
			self buildFullUpButton.
			self buildUpButton.
			self buildDownButton.
			self buildFullDownButton} reverse do: [:each | column addMorph: each ].
	
	column 
		vResizing: #spaceFill;
		width: 24;
		hResizing: #rigid.
	
	^ column! !

!NautilusPluginManager methodsFor: 'items creation' stamp: 'BenjaminVanRyseghem 8/25/2011 12:51'!
buildPluginsList
	
	tree := (self treeClass model: self) buildPluginsTree.
	tree
		vResizing: #spaceFill;
		hResizing: #spaceFill.
	
	
	^ tree buildContents! !

!NautilusPluginManager methodsFor: 'buttons behavior' stamp: 'BenjaminVanRyseghem 5/11/2011 15:49'!
removeButtonState
	
	^ self selectedPlugins isEmpty not! !

!NautilusPluginManager methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/11/2011 15:51'!
pluginsList: anObject
	
		pluginsList := anObject! !

!NautilusPluginManager methodsFor: 'private' stamp: 'BenjaminVanRyseghem 5/11/2011 13:45'!
isResizeable
	^true! !

!NautilusPluginManager methodsFor: 'lists behavior' stamp: 'BenjaminVanRyseghem 5/11/2011 11:23'!
pluginClassesSelectedIndex

	^ pluginClassesSelectedIndex ifNil: [ pluginClassesSelectedIndex := 0 ]! !

!NautilusPluginManager methodsFor: 'lists behavior' stamp: 'BenjaminVanRyseghem 8/25/2011 13:55'!
selectedPlugins

	^ tree selectedMorphList collect:[:each | each complexContents item ]! !

!NautilusPluginManager methodsFor: 'items creation' stamp: 'BenjaminVanRyseghem 5/11/2011 15:42'!
buildRemoveButton

	^  (PluggableButtonMorph
			on: self 
			getState: #removeButtonState
			action: #removeButtonAction
			label: #removeButtonLabel) hResizing: #spaceFill; vResizing: #shrinkWrap! !

!NautilusPluginManager methodsFor: 'lists behavior' stamp: 'BenjaminVanRyseghem 5/11/2011 15:56'!
selectedPluginClasses

	| associations list |
	list := self getPluginClassesList.
	pluginClassesSelected ifNil: [ ^ {} ].
	associations := pluginClassesSelected associations select: [:assoc | assoc value ].
	associations := associations collect: [:assoc | assoc key ].
	associations := associations sort: [:a : b | (list indexOf: a ifAbsent: [ 0 ]) <= (list indexOf: b ifAbsent: [ 0 ])].
	^ associations select: [:each | each notNil ]! !

!NautilusPluginManager methodsFor: 'private' stamp: 'BenjaminVanRyseghem 5/11/2011 15:56'!
applyChanges
	
	Nautilus pluginClasses: self pluginsList! !

!NautilusPluginManager methodsFor: 'items creation' stamp: 'BenjaminVanRyseghem 2/17/2012 16:32'!
buildDescriptionTextArea
	
	^ (PluggableTextMorph
		on: self
		text: #getText
		accept: nil) 
			enabled: false;
			vResizing: #spaceFill;	
			hResizing: #spaceFill;
			yourself! !

!NautilusPluginManagerTree commentStamp: '<historical>'!
A NautilusPluginManagerTree is a tree which is used to render the plugins selection!
!NautilusPluginManagerTree methodsFor: 't - accessing' stamp: 'AlainPlantec 10/17/2013 12:15'!
update

	self updateList! !

!NautilusPluginManagerTree methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 8/25/2011 11:09'!
model

	^ model! !

!NautilusPluginManagerTree methodsFor: 't - accessing' stamp: 'BenjaminVanRyseghem 8/25/2011 10:44'!
rootNodeClassFromItem: anItem
	^ PluginTreeNode! !

!NautilusPluginManagerTree methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 8/25/2011 11:09'!
model: anObject
	
	model := anObject! !

!NautilusPluginManagerTree methodsFor: 't - accessing' stamp: 'BenjaminVanRyseghem 8/25/2011 12:49'!
rootItems

	^ self model getPluginsList! !

!NautilusPluginManagerTree methodsFor: 'building' stamp: 'EstebanLorenzano 5/15/2014 13:56'!
buildPluginsTree
	| tree | 
	tree := IdentityMorphTreeMorph on: self.
	tree
		listManager: (IdentityMorphTreeListManager new client: tree);
		columns: {
				MorphTreeColumn new startWidth: 100;
					rowMorphGetSelector: #firstMorph;
					headerButtonLabel: 'Plugin name' font:  nil.
				MorphTreeColumn new startWidth: 75;
					rowMorphGetSelector: #secondMorph;
					headerButtonLabel: 'Position' font:  nil};
		withHLines: true;
		beMultiple;
		autoDeselection: false;
		rowInset: 4;
		columnInset: 4;
		getMenuSelector: #menu:shifted:.

	^ tree! !

!NautilusPluginManagerTree class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 8/25/2011 11:10'!
model: aModel
	
	^ self new model: aModel! !

!NautilusProtocolSelected commentStamp: '<historical>'!
A NautilusCategorySelected is raised when a category is selected!
!NautilusProtocolSelected methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/10/2011 17:16'!
category

		^ category! !

!NautilusProtocolSelected methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/10/2011 17:16'!
category: anObject
	
		category := anObject! !

!NautilusProtocolSelected class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 5/10/2011 17:17'!
category: anObject
	
	^ self new category: anObject! !

!NautilusRefactoring commentStamp: '<historical>'!
NautilusRefactoring is a facade for refactorings:
- class
- method
- inst var
- class var
- source code!
!NautilusRefactoring methodsFor: 'rewrite code' stamp: ''!
categoryRegex
	
	self model sourceCode: self categoryRegexText! !

!NautilusRefactoring methodsFor: 'method' stamp: ''!
renameMethodFor: aMethod
	| refactoring | 
	
	aMethod ifNil: [ ^ self ].
	refactoring := self privateRenameMethodFor: aMethod.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'source' stamp: ''!
extractToTemporaryBetween: anInterval from: aMethod
	| refactoring | 
	
	aMethod ifNil: [ ^ self ].
	refactoring := self privateExtractToTemporaryBetween: anInterval from: aMethod.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'private-source' stamp: ''!
privateCreateCascadeBetween: aSelection from: aMethod

	^ RBCreateCascadeRefactoring 
		model: environment
		combine: aSelection
		from: aMethod selector
		in: aMethod methodClass! !

!NautilusRefactoring methodsFor: 'undo-redo' stamp: ''!
redoOperation 

	self changeManager redoOperation! !

!NautilusRefactoring methodsFor: 'display' stamp: ''!
request: aString initialAnswer: aTemplateString

	^ UIManager default request: aString initialAnswer: aTemplateString
! !

!NautilusRefactoring methodsFor: 'inst var' stamp: 'NicolaiHess 8/4/2014 23:57'!
accessorsInstVarFrom: aClass
	| refactoring |
	
	aClass ifNil: [ ^ self ].
	refactoring := self privateAccessorsInstVarFrom: aClass.
	
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'private-source' stamp: ''!
privateInlineMethodFromComponentBetween: anInterval from: aMethod

	^ RBInlineMethodFromComponentRefactoring
		model: environment
		inline: anInterval
		inMethod: aMethod selector
		forClass: aMethod methodClass! !

!NautilusRefactoring methodsFor: 'method' stamp: 'MarkRizun 7/20/2014 18:34'!
deprecateMethodFor: aMethod
	| refactoring | 
	
	aMethod ifNil: [ ^ self ].
	refactoring := self privateDeprecateMethodFor: aMethod.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'method' stamp: ''!
pullUpMethodsFor: aCollection
	| refactoring | 
	
	aCollection ifEmpty: [ ^ self ].
	refactoring := self privatePullUpMethodsFor: aCollection.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'private-class' stamp: 'StephaneDucasse 1/31/2015 19:33'!
classRemovalRefactoringObjectFor: aCollection
	
	^ RBRemoveClassRefactoring 
			model: environment 
			classNames: (aCollection collect: [:e | e theNonMetaClass name ])! !

!NautilusRefactoring methodsFor: 'performing' stamp: 'CamilloBruni 10/8/2012 18:27'!
performRefactorings: aCollectionRefactoring

		[[[ self internalPerformRefactorings: aCollectionRefactoring ]
			on: RBRefactoringFailure do: [ :exception | self handleFailure: exception ]]
			on: RBRefactoringWarning do: [ :exception | self handleWarning: exception ]]
			on: RBRefactoringError   do: [ :exception | self handleError: exception ]! !

!NautilusRefactoring methodsFor: 'class' stamp: ''!
buildRenameRefactoringEngineFor: aClass

	| newName |
	newName := (UIManager default
			request: 'Enter the new class name:'
			initialAnswer: aClass name).
	newName isEmptyOrNil ifTrue: [ ^ nil ].
	^ RBRenameClassRefactoring
		model: RBNamespace new
		rename: aClass
		to: newName! !

!NautilusRefactoring methodsFor: 'private-class var' stamp: 'JurajKubelka 2/9/2015 10:30'!
privateAddClassVarFrom: aClass
	| name |
	name := (self
				request: 'Enter the new variable name:'
				initialAnswer: 'Var').
	name ifNil: [ ^ nil ].

	^ RBAddClassVariableRefactoring
		model: environment
		variable: name
		class: aClass theNonMetaClass! !

!NautilusRefactoring methodsFor: 'private-class' stamp: 'NicolaiHess 12/1/2014 21:41'!
privateInsertSuperclassFor: class

	| superclassName |
	superclassName := self request: 'Enter new superclass name:'.
	superclassName isEmptyOrNil ifTrue:[^ nil].	
	^ RBAddClassRefactoring
		model: environment
		addClass: superclassName
		superclass: class superclass
		subclasses: class asOrderedCollection
		category: class category! !

!NautilusRefactoring methodsFor: 'source' stamp: 'BenjaminVanRyseghem 6/26/2012 21:21'!
renameTemporaryNamed: oldname Between: anInterval from: aMethod
	| refactoring | 
	
	aMethod ifNil: [ ^ self ].
	refactoring := self privateRenameTemporaryNamed: oldname Between: anInterval from: aMethod.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'inst var' stamp: ''!
pullUpInstVarFrom: aClass
	| refactoring |
	
	aClass ifNil: [ ^ self ].
	refactoring := self privatePullUpInstVarFrom: aClass.
	
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'method' stamp: ''!
pushDownMethodsFor: aCollection
	| refactoring | 
	
	aCollection ifEmpty: [ ^ self ].
	refactoring := self privatePushDownMethodsFor: aCollection.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'rewrite code' stamp: ''!
protocolRegexText

	^ 'RBProtocolRegexRefactoring new
	replace: ''^\*system(.*)$'' with: ''*kernel$1'' ignoreCase: true;
	yourself'! !

!NautilusRefactoring methodsFor: 'display' stamp: 'BenjaminVanRyseghem 1/24/2013 13:58'!
chooseMultipleFrom: anArray title: aString

	| window |
	window :=  TickDialogWindow 
					itemsList: anArray 
					itemsHeaderName: ''
					wrapBlockOrSelector: [:e | e ]
					title: aString
					defaultValue: true.

	^ anArray isEmpty
		ifTrue: [ anArray copyEmpty ]
		ifFalse: [ window chooseFromOwner: self model window ]! !

!NautilusRefactoring methodsFor: 'private-method' stamp: 'SebastianTleye 8/2/2013 10:41'!
privateRemoveParameterMethodFor: aMethod
	| arguments parameter |
	
	arguments :=  aMethod argumentNames ifEmpty: [ ^ nil ].
	parameter := (UIManager default chooseFrom: arguments) ifNil: [ ^ nil ].
	
	^ RBRemoveParameterRefactoring
		model: environment
		removeParameter: (arguments at: parameter ifAbsent: [ ^ nil ])
		in: aMethod origin
		selector: aMethod selector! !

!NautilusRefactoring methodsFor: 'inst var' stamp: ''!
removeInstVarFrom: aClass
	| refactoring |
	
	aClass ifNil: [ ^ self ].
	refactoring := self privateRemoveInstVarFrom: aClass.
	
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'private-source' stamp: ''!
privateExtractToComponentBetween: anInterval from: aMethod

	^ RBExtractMethodToComponentRefactoring
		model: environment
		extract: anInterval
		from: aMethod selector
		in: aMethod methodClass! !

!NautilusRefactoring methodsFor: 'option' stamp: ''!
requestSelfArgumentName

	^ self request: 'Enter name for argument to refer to "self" in extracted method'! !

!NautilusRefactoring methodsFor: 'private-source' stamp: ''!
privateInlineTemporaryBetween: anInterval from: aMethod

	^ RBInlineTemporaryRefactoring
		model: environment
		inline: anInterval
		from: aMethod selector
		in: aMethod methodClass! !

!NautilusRefactoring methodsFor: 'rewrite code' stamp: ''!
searchCodeText

	^ 'RBParseTreeSearcher new
	matches: ''`@object'' do: [ :node :answer | node ];
	matchesMethod: ''`@method: `@args | `@temps | `@.statements'' do: [ :node :answer | node ];
	yourself'! !

!NautilusRefactoring methodsFor: 'class' stamp: 'MarkRizun 7/23/2014 16:49'!
insertSubclass

	| refactoring |
	refactoring := self privateInsertSubclassFor: self model selectedClass theNonMetaClass.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring ! !

!NautilusRefactoring methodsFor: 'private-method' stamp: 'PabloHerrero 3/1/2015 12:37'!
privateRenameMethodFor: aMethod
	| class selector oldMethodName newMethodName tempOldArguments oldArguments argumentPermutation |
	class := aMethod methodClass.
	selector := aMethod selector.
	oldArguments := aMethod ast arguments collect: #name.
	tempOldArguments := aMethod ast arguments collect: #name.
	oldMethodName := RBMethodName selector: selector arguments: oldArguments.
	(newMethodName := self requestMethodNameFor: oldMethodName) ifNil: [ ^ nil ].
	argumentPermutation := newMethodName arguments collect: [ :each | tempOldArguments indexOf: each ].
	^ RBRenameMethodRefactoring
		model: environment
		renameMethod: selector
		in: class
		to: newMethodName selector
		permutation: argumentPermutation! !

!NautilusRefactoring methodsFor: 'private-source' stamp: ''!
privateInlineMethodBetween: anInterval from: aMethod

	^ RBInlineMethodRefactoring
		model: environment
		inline: anInterval
		inMethod: aMethod selector
		forClass: aMethod methodClass! !

!NautilusRefactoring methodsFor: 'method' stamp: ''!
moveMethodFor: aMethod
	| refactoring | 
	
	aMethod ifNil: [ ^ self ].
	refactoring := self privateMoveMethodFor: aMethod.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'private-method' stamp: ''!
privatePullUpMethodsFor: aCollection
	| selectors class |
	selectors := aCollection collect: #selector.
	class := aCollection first methodClass.
	(aCollection allSatisfy: [:e | e methodClass == class ]) ifFalse: [ ^ nil ].
	
	^ RBPullUpMethodRefactoring
		model: environment
		pullUp: selectors
		from: class! !

!NautilusRefactoring methodsFor: 'class' stamp: 'BenjaminVanRyseghem 7/13/2012 16:09'!
generateSuperClass
	"Execute the refactoring of the receiver."

	| refactoring |
	refactoring := self privateGenerateSuperClassFor: self model selectedClass theNonMetaClass.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring.! !

!NautilusRefactoring methodsFor: 'method' stamp: ''!
removeParameterFor: aMethod
	| refactoring | 
	
	aMethod ifNil: [ ^ self ].
	refactoring := self privateRemoveParameterMethodFor: aMethod.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'private-inst var' stamp: 'MarkRizun 7/23/2014 11:10'!
privateRenameInstVarFrom: aClass
	^ self
		class: aClass
		andInstVariable: [ :class :variable | 
			| name |
			name := self request: 'Enter the new variable name:' initialAnswer: variable.
			name ifNil: [ ^ nil ].
			RBRenameInstanceVariableRefactoring
				model: environment
				rename: variable
				to: name asSymbol
				in: class ]! !

!NautilusRefactoring methodsFor: '*SmartSuggestions' stamp: 'GiselaDecuzzi 4/19/2013 13:14'!
accessorsInstVarNamed: aVariableName from: aClass
	| refactoring |
	
	aClass ifNil: [ ^ self ].
	refactoring := self privateAccessorsInstVarNamed: aVariableName from:  aClass.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring.! !

!NautilusRefactoring methodsFor: 'option' stamp: 'GuillermoPolito 8/5/2013 16:15'!
shouldInlineExpression: aString

	^ self confirm: ('Do you want to inline the expression ''<1s>'' in the current method?' expandMacrosWith: aString)! !

!NautilusRefactoring methodsFor: 'private-class var' stamp: ''!
privatePullUpClassVarFrom: aClass

	^ self class: aClass andClassVariable: [ :class :variable | 
		RBPullUpClassVariableRefactoring 
			model: environment
			variable: variable
			class: class ]! !

!NautilusRefactoring methodsFor: 'rewrite code' stamp: ''!
typeClassTextFor: aCollectionOfClass

	^ String streamContents: [:s |
		aCollectionOfClass do: [:class |
			s << (RBRefactoryTyper new runOn: class) printString.
			s cr; cr ]]! !

!NautilusRefactoring methodsFor: 'class var' stamp: ''!
addClassVarFrom: aClass
	| refactoring |
	
	aClass ifNil: [ ^ self ].
	refactoring := self privateAddClassVarFrom: aClass.
	
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'class var' stamp: ''!
renameClassVarFrom: aClass
	| refactoring |
	
	aClass ifNil: [ ^ self ].
	refactoring := self privateRenameClassVarFrom: aClass.

	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'rewrite code' stamp: ''!
classRegex

	self model sourceCode: self classRegexText! !

!NautilusRefactoring methodsFor: 'rewrite code' stamp: 'NicolaiHess 11/30/2014 21:30'!
searchCode
	
	self model searchCode: self searchCodeText! !

!NautilusRefactoring methodsFor: 'private-inst var' stamp: 'BenjaminVanRyseghem 4/18/2012 16:57'!
privateRenameInstVarNamed: variable from: aClass
	| name |
	
	name := self 
		request: 'Enter the new variable name:'
		initialAnswer: variable.

	name ifNil: [ ^ nil ].

	^ RBRenameInstanceVariableRefactoring
		model: environment
		rename: variable
		to: name asSymbol
		in: aClass! !

!NautilusRefactoring methodsFor: 'class' stamp: 'BenjaminVanRyseghem 4/18/2012 17:11'!
changeSuperclassOf: aClass 
	
	"should be implemented if it really makes sense"
	self model sourceTextArea flash! !

!NautilusRefactoring methodsFor: 'source' stamp: ''!
extractBetween: anInterval from: aMethod
	| refactoring | 
	
	aMethod ifNil: [ ^ self ].
	refactoring := self privateExtractBetween: anInterval from: aMethod.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'performing' stamp: 'SeanDeNigris 3/2/2015 11:25'!
internalPerformRefactorings: aCollectionRefactoring
	"Try to properly label aRefactoring and perform it or open the changes browser, depending on the preferences of the user."

		self promptOnRefactoring
			ifFalse: [ aCollectionRefactoring do: [:e |
												self refactoringOptions: e.
												e execute ]]
			ifTrue: [
				aCollectionRefactoring do: [:e |
												self refactoringOptions: e.
												e primitiveExecute ].
				aCollectionRefactoring ifEmpty: [ ^ self ].
		
				(ChangesBrowser changes: aCollectionRefactoring) open ].! !

!NautilusRefactoring methodsFor: 'class var' stamp: ''!
removeClassVarFrom: aClass
	| refactoring |
	
	aClass ifNil: [ ^ self ].
	refactoring := self privateRemoveClassVarFrom: aClass.
	
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'undo-redo' stamp: ''!
redoLabel
	| stream |
	stream := WriteStream with: 'Redo'.
	self changeManager hasRedoableOperations ifFalse: [ ^ stream contents ].
	
	stream nextPut: $ ; nextPutAll: self changeManager redoChange name.
	stream position > 40
		ifTrue: [ stream position: 40; nextPutAll: '...' ].
		
	^ stream contents! !

!NautilusRefactoring methodsFor: 'display' stamp: ''!
handleMethodNameRequest: aMethodName

	^ (MethodNameEditor openOn: aMethodName) methodName! !

!NautilusRefactoring methodsFor: 'class' stamp: ''!
generateAccessors

	| refactorings |
	refactorings := self privateGenerateAccessorsFor: self model selectedClass.
	refactorings ifNil: [ ^ self ].
	refactorings do: [:each | each model environment: self model browsedEnvironment ].
	self performRefactorings: refactorings! !

!NautilusRefactoring methodsFor: '*SmartSuggestions' stamp: 'GiselaDecuzzi 4/19/2013 13:12'!
privateAccessorsInstVarNamed: aVariableName from:  aClass.
	^RBCreateAccessorsForVariableRefactoring 
			model: environment
			variable: aVariableName
			class: aClass
			classVariable: false! !

!NautilusRefactoring methodsFor: 'private-class' stamp: 'NicolaiHess 12/1/2014 21:40'!
privateGenerateSubclassFor: class
	| subclassName |
	subclassName := self request: 'Enter new subclass name:'.
	subclassName isEmptyOrNil ifTrue: [ ^ nil ].
	
	^ RBAddClassRefactoring
		model: environment
		addClass: subclassName
		superclass: class
		subclasses: (self chooseMultipleFrom: class subclasses title: 'Select subclasses of ' , subclassName , ':')
		category: class category! !

!NautilusRefactoring methodsFor: 'display' stamp: ''!
class: aClass andClassVariable: aBlock
	| variables index variable class |
	
	variables := aClass theNonMetaClass allClassVarNames asArray sort.
	index := UIManager default chooseFrom: variables.
	variable := variables at: index ifAbsent: [ ^ nil ].
	class := aClass theNonMetaClass whichClassDefinesClassVar: variable.
	^ aBlock value: class value: variable! !

!NautilusRefactoring methodsFor: 'private-class var' stamp: 'BenjaminVanRyseghem 4/18/2012 16:58'!
privateRenameClassVarFrom: aClass

	^ self class: aClass andClassVariable: [ :class :variable || name |
		name := self 
			request: 'Enter the new variable name:'
			initialAnswer: variable.
			
		name ifNil: [ ^ nil ].	
			
		RBRenameClassVariableRefactoring
			model: environment
			rename: variable
			to: name asSymbol
			in: class ]! !

!NautilusRefactoring methodsFor: 'class' stamp: 'BenjaminVanRyseghem 7/13/2012 16:13'!
realizeClass

	| refactoring |
	refactoring := self privateRealizeClassFor: self model selectedClass theNonMetaClass.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring ! !

!NautilusRefactoring methodsFor: 'rewrite code' stamp: ''!
sourceRegexText

	^ 'RBSourceRegexRefactoring new
	
	"Example 1: Replace symbols with strings"
	replace: ''#(\w+)'' with: ''''''$1'''''' ignoreCase: false;
	
	"Example 2: Replace 4 spaces with tabs"
	replace: ''    '' with: ''	'' ignoreCase: false;

	yourself'! !

!NautilusRefactoring methodsFor: 'source' stamp: ''!
moveVariableDefinitionBetween: anInterval from: aMethod
	| refactoring | 
	
	aMethod ifNil: [ ^ self ].
	refactoring := self privateMoveVariableDefinitionBetween: anInterval from: aMethod.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'private-source' stamp: ''!
privateExtractBetween: anInterval from: aMethod

	^ RBExtractMethodRefactoring
		model: environment
		extract: anInterval
		from: aMethod selector
		in: aMethod methodClass! !

!NautilusRefactoring methodsFor: 'class var' stamp: 'BenjaminVanRyseghem 4/18/2012 16:57'!
renameClassVarNamed: aName from: aClass
	| refactoring |
	
	aClass ifNil: [ ^ self ].
	refactoring := self privateRenameClassVarNamed: aName from: aClass.

	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'method' stamp: ''!
removeMethodsFor: aCollection
	| refactoring | 
	
	aCollection ifEmpty: [ ^ self ].
	refactoring := self privateRemoveMethodsFor: aCollection.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'private-inst var' stamp: 'MarkRizun 7/24/2014 14:55'!
privateMoveInstVarToClass: aClass
	| newClass |
	newClass := (SearchFacade classSearchInEnvironment: Smalltalk) chooseFromOwner: World.
	^ self class: aClass andInstVariable: [ :class :variable | 
		RBMoveInstVarToClassRefactoring 
			model: environment
			variable: variable
			class: newClass
			oldClass: aClass ]! !

!NautilusRefactoring methodsFor: 'display' stamp: ''!
request: aString

	^ UIManager default request: aString initialAnswer: ''! !

!NautilusRefactoring methodsFor: 'method' stamp: ''!
inlineParameterFor: aMethod
	| refactoring | 
	
	aMethod ifNil: [ ^ self ].
	refactoring := self privateInlineParameterFor: aMethod.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'source' stamp: ''!
inlineTemporaryBetween: anInterval from: aMethod
	| refactoring | 
	
	aMethod ifNil: [ ^ self ].
	refactoring := self privateInlineTemporaryBetween: anInterval from: aMethod.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'private-inst var' stamp: 'StephaneDucasse 7/6/2014 15:18'!
privateAddInstVarFrom: aClass
	| name |
	name := self
				request: 'Enter the new variable name:'
				initialAnswer: 'inst'.
	name ifNil: [ ^ nil ].
	^ RBAddInstanceVariableRefactoring
		model: environment
		variable: name
		class: aClass theNonMetaClass! !

!NautilusRefactoring methodsFor: 'display' stamp: ''!
requestMethodNameFor: aMethodName

	^ self handleMethodNameRequest: aMethodName! !

!NautilusRefactoring methodsFor: 'rewrite code' stamp: 'DanielUber 10/26/2012 23:39'!
typeClass
	
	self model sourceCode: (self typeClassTextFor: self model selectedClasses)! !

!NautilusRefactoring methodsFor: 'option' stamp: 'BenjaminVanRyseghem 8/5/2012 21:51'!
shouldExtractAssignmentTo: aString

	^ self confirm: ('Do you want to extract the assignment of <1s> at the end of selection?' expandMacrosWith: aString)! !

!NautilusRefactoring methodsFor: 'source' stamp: ''!
temporaryToInstanceVariableNamed: name Between: anInterval from: aMethod
	| refactoring | 
	
	aMethod ifNil: [ ^ self ].
	refactoring := self privateTemporaryToInstanceVariableNamed: name Between: anInterval from: aMethod.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'inst var' stamp: ''!
abstractInstVarFrom: aClass
	| refactoring |
	
	aClass ifNil: [ ^ self ].
	refactoring := self privateAbstractInstVarFrom: aClass.
	
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'accessing' stamp: ''!
model
	
	^ model! !

!NautilusRefactoring methodsFor: 'private-method' stamp: ''!
privatePushDownMethodsFor: aCollection
	| selectors class |
	selectors := aCollection collect: #selector.
	class := aCollection first methodClass.
	(aCollection allSatisfy: [:e | e methodClass == class ]) ifFalse: [ ^ nil ].
	
	^ RBPushDownMethodRefactoring
		model: environment
		pushDown: selectors
		from: class! !

!NautilusRefactoring methodsFor: 'rewrite code' stamp: 'BenjaminVanRyseghem 4/16/2013 17:24'!
rewriteCode

	self model rewriteCode: self rewriteCodeText! !

!NautilusRefactoring methodsFor: 'option' stamp: 'MarcusDenker 11/28/2014 10:28'!
selectVariableToMoveMethodTo: aSelector class: aClass
	| parseTree nameList | 
	parseTree := aClass parseTreeFor: aSelector.
	parseTree isNil ifTrue: [ 
		parseTree := RBMethodNode 
			selector: #value
			body: (RBSequenceNode statements: #()) ].
	nameList := OrderedCollection new.
	nameList
		addAll: parseTree argumentNames sorted;
		addAll: aClass allInstanceVariableNames sorted.
	^ self 
		chooseFrom: nameList 
		title: 'Select variable to move method into:'
		lines: (Array with: parseTree argumentNames size)! !

!NautilusRefactoring methodsFor: 'rewrite code' stamp: ''!
protocolRegex

	self model sourceCode: self protocolRegexText! !

!NautilusRefactoring methodsFor: 'method' stamp: ''!
addAParameterFor: aMethod
	| refactoring | 
	
	aMethod ifNil: [ ^ self ].
	refactoring := self privateAddAParameterFor: aMethod.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: '*SmartSuggestions' stamp: 'GiselaDecuzzi 4/22/2013 15:36'!
privateAccessorsClassVarNamed: aVariableName from:  aClass.
	^RBCreateAccessorsForVariableRefactoring 
			model: environment
			variable: aVariableName
			class: aClass
			classVariable: true! !

!NautilusRefactoring methodsFor: 'private-inst var' stamp: 'StephaneDucasse 6/28/2013 10:34'!
privatePullUpInstVarFrom: aClass

	^ self class: aClass andInstVariable: [ :class :variable | 
		RBPullUpInstanceVariableRefactoring 
			model: environment
			variable: variable
			class: class superclass ]! !

!NautilusRefactoring methodsFor: 'private-method' stamp: 'MarcusDenker 4/21/2013 18:39'!
privateInlineParameterFor: aMethod
	| arguments parameter |
	arguments :=  aMethod argumentNames ifEmpty: [ ^ nil ].
	parameter := (UIManager default chooseFrom: arguments) ifNil: [ ^ nil ].
	
	^ RBInlineParameterRefactoring
		model: environment
		inlineParameter: (arguments at: parameter ifAbsent: [ ^ nil ])
		in: aMethod methodClass
		selector: aMethod selector! !

!NautilusRefactoring methodsFor: 'private-class' stamp: ''!
privateSplitClassFor: aClass
	| class |

	class := aClass theNonMetaClass.
	^ RBSplitClassRefactoring
		model: environment
		class: class
		instanceVariables: (self 
			chooseMultipleFrom: class instVarNames
			title: 'Select variables to extract:')
		newClassName: (self request: 'Enter new class name:')
		referenceVariableName: (self request: 'Enter new variable name where requests will be forwarded:')! !

!NautilusRefactoring methodsFor: 'display' stamp: ''!
chooseFrom: anArray title: aString lines: aCollection 
	anArray isEmpty
		ifTrue: [ ^ nil ].
	anArray size = 1
		ifTrue: [ ^ anArray first ].
		
	^ UIManager default chooseOrRequestFrom: anArray lines: aCollection title: aString.! !

!NautilusRefactoring methodsFor: 'rewrite code' stamp: ''!
sourceRegex
	
	self model sourceCode: self sourceRegexText! !

!NautilusRefactoring methodsFor: 'private-class' stamp: ''!
privateRealizeClassFor: aClass
	
	^ RBRealizeClassRefactoring model: environment className: aClass theNonMetaClass name! !

!NautilusRefactoring methodsFor: 'rewrite code' stamp: ''!
classRegexText

	^ 'RBClassRegexRefactoring new

	"Example 1: Change class prefixes"
	renameClasses;
	replace: ''^AB(.*)$'' with: ''CD$1'' ignoreCase: false;

	"Example 2: Generate empty test classes"
	createClasses;
	rootClass: TestCase;
	replace: ''^.*$'' with: ''$0Test'' ignoreCase: false;

	"Example 3: Copy classes"
	copyClasses;
	replace: ''^.*$'' with: ''$0Plus'' ignoreCase: false;

	yourself'! !

!NautilusRefactoring methodsFor: 'private-method' stamp: 'TorstenBergmann 8/24/2014 20:15'!
privateMoveMethodToClassFor: aMethod
	| class |
	class := (SearchFacade classSearchInEnvironment: Smalltalk) chooseFromOwner: World.
	class ifNil: [ ^nil ].
	^ RBMoveMethodToClassRefactoring
		model: environment
		method: aMethod
		class: class! !

!NautilusRefactoring methodsFor: 'undo-redo' stamp: ''!
changeManager
	
	^ RBRefactoryChangeManager instance! !

!NautilusRefactoring methodsFor: 'option' stamp: ''!
openEnvironment: anEnvironment for: aRefactoring
	
	anEnvironment isEmpty
		ifTrue: [ ^ self inform: 'Empty scope' ].
	
	Smalltalk tools browser fullOnEnvironment: anEnvironment! !

!NautilusRefactoring methodsFor: 'option' stamp: ''!
shouldOverride: aSelector in: aClass 

	^ self confirm: ('<1s> is already defined in the <2p> hierarchy. Extracting it to an existing selector may change behavior. Do you wish to use <1s> anyway?' expandMacrosWith: aSelector with: aClass)! !

!NautilusRefactoring methodsFor: 'method' stamp: 'MarkRizun 7/24/2014 10:41'!
moveMethodToClassFor: aMethod
	| refactoring | 
	
	aMethod ifNil: [ ^ self ].
	refactoring := self privateMoveMethodToClassFor: aMethod.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'option' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
selectVariableTypesFrom: aCollectionOfTypes selected: aSelectedCollection for: aRefactoring
	| stream result |
	stream := WriteStream on: String new.
	aCollectionOfTypes
		do: [ :each | stream nextPutAll: each name ]
		separatedBy: [ stream cr ].
	result := Smalltalk ui theme
		textEditorIn: self model window
		text: 'Select classes to move to: (one class per line)'
		title: 'Select classes to move to:'
		entryText: stream contents
		entryHeight: 300.
	
	result ifNil: [ ^ nil ].
	^ (result asString findTokens: String crlf)
		collect: [ :each | aRefactoring model classFor: (Smalltalk classNamed: each trimBoth) ]
		! !

!NautilusRefactoring methodsFor: 'source' stamp: 'BenjaminVanRyseghem 4/18/2012 16:47'!
renameTextSelection

	self model selectedMethod 
		ifNotNil: [ ^ self renameTextSelectionForMethod ].
	
	(self model  selectedCategory isNil and: [ self model selectedClass notNil ])	
		ifTrue: [ " we are editing a class definition " 
			^ self renameTextSelectionForClass ].! !

!NautilusRefactoring methodsFor: 'private-source' stamp: ''!
privateTemporaryToInstanceVariableNamed: name Between: anInterval from: aMethod

	^ RBTemporaryToInstanceVariableRefactoring
		model: environment
		class: aMethod methodClass
		selector: aMethod selector
		variable: name! !

!NautilusRefactoring methodsFor: 'display' stamp: 'CamilloBruni 10/7/2012 23:24'!
handleWarning: anException
	self inform: anException messageText.
	anException resume.! !

!NautilusRefactoring methodsFor: 'private-method' stamp: 'SebastianTleye 7/31/2013 12:58'!
privateAddAParameterFor: aMethod
	| initializer newSelector initialAnswer oldSelector |
	
	oldSelector := aMethod selector.
	
	initialAnswer := oldSelector numArgs = 0
		ifTrue: [ oldSelector , ':' ]
		ifFalse: [ oldSelector ].
		
	newSelector := self request: 'Enter new selector:' initialAnswer: initialAnswer.
	newSelector isEmptyOrNil ifTrue: [ ^ nil ].
	
	initializer := self request: 'Enter default value for parameter:' initialAnswer: 'nil'.
	initializer isEmpty ifTrue: [ ^ nil ].

	^ RBAddParameterRefactoring
		model: environment
		addParameterToMethod: aMethod selector
		in: aMethod origin
		newSelector: newSelector asSymbol
		initializer: initializer
! !

!NautilusRefactoring methodsFor: 'class' stamp: 'BenjaminVanRyseghem 7/13/2012 16:09'!
generateSubclass

	| refactoring |
	refactoring := self privateGenerateSubclassFor: self model selectedClass theNonMetaClass.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring ! !

!NautilusRefactoring methodsFor: 'method' stamp: ''!
inlineAllSendersFor: aMethod
	| refactoring | 
	
	aMethod ifNil: [ ^ self ].
	refactoring := self privateInlineAllSendersFor: aMethod.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'private-inst var' stamp: ''!
privatePushDownInstVarFrom: aClass

	^ self class: aClass andInstVariable: [ :class :variable | 
		RBPushDownInstanceVariableRefactoring
			model: environment
			variable: variable
			class: class ]! !

!NautilusRefactoring methodsFor: 'inst var' stamp: 'MarkRizun 7/23/2014 11:05'!
renameInstVarFrom: aClass
	| refactoring |
	aClass ifNil: [ ^ self ].
	refactoring := self privateRenameInstVarFrom: aClass.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'source' stamp: 'BenjaminVanRyseghem 4/18/2012 17:06'!
renameTextSelectionForClass
	| selectedInterval selection class |
	
	class := self model selectedClass.
	selection := self model sourceTextArea selectedContents asString.
	selectedInterval := self model sourceTextArea selectionInterval.
	
	selectedInterval isEmpty 				ifTrue: [ ^ self model sourceTextArea flash ].
	(selection includes: Character space) 	ifTrue: [ ^ self model sourceTextArea flash ].
		
	"Try to rename the superclass"
	selectedInterval first = 1
		ifTrue: [ self changeSuperclassOf: class ].
		
	"Rename the selected class"
	selection = class name
		ifTrue: [ self renameClass: class ].
		
	"Rename a variable"
	self renameVariable: selection.! !

!NautilusRefactoring methodsFor: 'source' stamp: ''!
extractToComponentBetween: anInterval from: aMethod
	| refactoring | 
	
	aMethod ifNil: [ ^ self ].
	refactoring := self privateExtractToComponentBetween: anInterval from: aMethod.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'class var' stamp: ''!
accessorsClassVarFrom: aClass
	| refactoring |
	
	aClass ifNil: [ ^ self ].
	refactoring := self privateAccessorsClassVarFrom: aClass.
	
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'private-class var' stamp: 'BenjaminVanRyseghem 4/18/2012 16:58'!
privateRenameClassVarNamed: variable from: aClass
	| name |

	name := self 
		request: 'Enter the new variable name:'
		initialAnswer: variable.
	
	name ifNil: [ ^ nil ].
		
	^ RBRenameClassVariableRefactoring
		model: environment
		rename: variable
		to: name asSymbol
		in: aClass! !

!NautilusRefactoring methodsFor: 'source' stamp: ''!
inlineMethodFromComponentBetween: anInterval from: aMethod
	| refactoring | 
	
	aMethod ifNil: [ ^ self ].
	refactoring := self privateInlineMethodFromComponentBetween: anInterval from: aMethod.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'source' stamp: ''!
inlineMethodBetween: anInterval from: aMethod
	| refactoring | 
	
	aMethod ifNil: [ ^ self ].
	refactoring := self privateInlineMethodBetween: anInterval from: aMethod.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'private-method' stamp: 'VincentBlondeau 2/1/2015 00:06'!
privateDeprecateMethodFor: aMethod
	| class selector newMethod |
	class := aMethod methodClass.
	selector := aMethod selector.
	newMethod := (SearchFacade messageSearchFor: aMethod methodClass) chooseFromOwner: self model window.
	^ RBDeprecateMethodRefactoring
		model: environment
		deprecateMethod: selector
		in: class
		using: newMethod selector! !

!NautilusRefactoring methodsFor: 'private-inst var' stamp: ''!
privateAbstractInstVarFrom: aClass

	^ self class: aClass andInstVariable: [ :class :variable | 
		RBAbstractInstanceVariableRefactoring
			model: environment
			variable: variable
			class: class ]! !

!NautilusRefactoring methodsFor: 'private-class var' stamp: ''!
privateAccessorsClassVarFrom: aClass

	^ self class: aClass andClassVariable: [ :class :variable | 
		RBCreateAccessorsForVariableRefactoring 
			model: environment
			variable: variable
			class: class
			classVariable: true ]! !

!NautilusRefactoring methodsFor: 'private-method' stamp: ''!
privateInlineAllSendersFor: aMethod
	
	^ RBInlineAllSendersRefactoring
		model: environment
		sendersOf: aMethod selector
		in: aMethod methodClass! !

!NautilusRefactoring methodsFor: 'private-class var' stamp: ''!
privatePushDownClassVarFrom: aClass

	^ self class: aClass andClassVariable: [ :class :variable | 
		RBPushDownClassVariableRefactoring
			model: environment
			variable: variable
			class: class ]! !

!NautilusRefactoring methodsFor: 'source' stamp: 'BenjaminVanRyseghem 4/18/2012 16:57'!
renameVariable: aString 
	| class |
	class := self model selectedClass.
	
	(class instVarNames includes: aString)
		ifTrue: [ ^ self renameInstVarNamed: aString from: class].
		
	(class classVarNames includes: aString)
		ifTrue: [ ^ self renameClassVarNamed: aString from: class].
		
	self model sourceTextArea flash! !

!NautilusRefactoring methodsFor: 'option' stamp: ''!
refactoringOptions: aRefactoring
	aRefactoring
		setOption: #implementorToInline
		toUse: [ :ref :imps | self requestImplementorToInline: imps ];
		setOption: #methodName
		toUse: [ :ref :name | self requestMethodNameFor: name ];
		setOption: #selfArgumentName
		toUse: [ :ref | self requestSelfArgumentName ];
		setOption: #selectVariableToMoveTo
		toUse: [ :ref :class :selector | self selectVariableToMoveMethodTo: selector class: class ];
		setOption: #variableTypes
		toUse: [ :ref :types :selected | self selectVariableTypesFrom: types selected: selected for: ref ];
		setOption: #extractAssignment
		toUse: [ :ref :string | self shouldExtractAssignmentTo: string ];
		setOption: #inlineExpression
		toUse: [ :ref :string | self shouldInlineExpression: string ];
		setOption: #alreadyDefined
		toUse: [ :ref :class :selector | self shouldOverride: selector in: class ];
		setOption: #useExistingMethod
		toUse: [ :ref :selector | self shouldUseExistingMethod: selector ];
		setOption: #openBrowser
		toUse: [ :ref :env | self openEnvironment: env  for: ref]! !

!NautilusRefactoring methodsFor: 'display' stamp: 'CamilloBruni 10/8/2012 11:38'!
handleError: anException
	anException actionBlock isNil
		ifTrue: [ self inform: anException messageText ]
		ifFalse: [ 
			(self confirm: anException messageText) 
				ifTrue: [ anException actionBlock value ] ].
	anException resume! !

!NautilusRefactoring methodsFor: 'accessing' stamp: ''!
model: aNautilusUI
	
	model := aNautilusUI.
	
	environment := (RBNamespace onEnvironment: aNautilusUI browsedEnvironment)
						name: self printString;
						yourself.! !

!NautilusRefactoring methodsFor: 'class' stamp: 'MarkRizun 7/23/2014 16:27'!
insertSuperclass

	| refactoring |
	refactoring := self privateInsertSuperclassFor: self model selectedClass theNonMetaClass.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring ! !

!NautilusRefactoring methodsFor: 'private-inst var' stamp: 'NicolaiHess 8/4/2014 23:57'!
privateAccessorsInstVarFrom: aClass

	^ self class: aClass andInstVariable: [ :class :variable | 
		RBCreateAccessorsForVariableRefactoring 
			model: environment
			variable: variable
			class: class
			classVariable: false ]! !

!NautilusRefactoring methodsFor: 'source' stamp: ''!
splitCascadeBetween: anInterval from: aMethod
	| refactoring | 
	
	aMethod ifNil: [ ^ self ].
	refactoring := self privateSplitCascadeBetween: anInterval from: aMethod.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'source' stamp: 'GuillermoPolito 11/7/2013 14:13'!
formatSourceCode
	| textArea |
	
	self model ifNil: [ ^ self ].
	
	textArea := self model sourceTextArea.
	textArea formatSourceCode.! !

!NautilusRefactoring methodsFor: 'inst var' stamp: ''!
addInstVarFrom: aClass
	| refactoring |
	
	aClass ifNil: [ ^ self ].
	refactoring := self privateAddInstVarFrom: aClass.
	
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'private-method' stamp: ''!
privateMoveMethodFor: aMethod
	| instVars instVar |
	instVars := aMethod methodClass instVarNames.
	instVars ifNil: [ ^ nil ].
	instVar := UIManager default chooseFrom: instVars.
	instVar ifNil: [ ^ nil ].
	
	
	^ RBMoveMethodRefactoring
		model: environment
		selector: aMethod selector
		class: aMethod methodClass
		variable: (instVars at: instVar ifAbsent: [ ^ nil ])! !

!NautilusRefactoring methodsFor: 'private-class' stamp: 'NicolaiHess 12/1/2014 21:41'!
privateInsertSubclassFor: class

	| subclassName |
	subclassName := self request: 'Enter new subclass name:'.
	subclassName isEmptyOrNil ifTrue:[^ nil].
	^ RBAddClassRefactoring
		model: environment
		addClass: subclassName
		superclass: class
		subclasses: class subclasses
		category: class category! !

!NautilusRefactoring methodsFor: 'inst var' stamp: ''!
pushDownInstVarFrom: aClass
	| refactoring |
	
	aClass ifNil: [ ^ self ].
	refactoring := self privatePushDownInstVarFrom: aClass.
	
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'method' stamp: ''!
swapMethodFor: aCollection
	| refactorings | 
	
	aCollection ifEmpty: [ ^ self ].
	refactorings := self privateSwapMethodFor: aCollection.
	refactorings isEmptyOrNil ifTrue: [ ^ self ].
	refactorings do: [:e | e model environment: self model browsedEnvironment ].
	self performRefactorings: refactorings! !

!NautilusRefactoring methodsFor: 'undo-redo' stamp: ''!
undoEnabled

	^ self changeManager hasUndoableOperations! !

!NautilusRefactoring methodsFor: 'private-inst var' stamp: ''!
privateRemoveInstVarFrom: aClass

	^ self class: aClass andInstVariable: [ :class :variable | 
		RBRemoveInstanceVariableRefactoring
			model: environment
			variable: variable
			class: class ]! !

!NautilusRefactoring methodsFor: 'private-source' stamp: ''!
privateRenameTemporaryNamed: oldname Between: anInterval from: aMethod
	| name |
	name := (self
				request: 'Enter the new variable name:' 
				initialAnswer: oldname).
	name ifNil: [ ^ nil ].

	^ RBRenameTemporaryRefactoring
		model: environment
		renameTemporaryFrom: anInterval
		to: name
		in: aMethod methodClass
		selector: aMethod selector
! !

!NautilusRefactoring methodsFor: 'undo-redo' stamp: ''!
redoEnabled

	^ self changeManager hasRedoableOperations! !

!NautilusRefactoring methodsFor: 'source' stamp: 'BenjaminVanRyseghem 4/18/2012 17:45'!
extractToMethodTextSelection
	| aMethod selectedInterval textArea |
	
	textArea := self model sourceTextArea.
	aMethod := self model selectedMethod.
	aMethod ifNil: [ ^ textArea flash ].
	textArea selectedContents asString ifEmpty: [ ^ textArea flash ].
	
	selectedInterval := textArea selectionInterval.
	self extractBetween: selectedInterval from: aMethod! !

!NautilusRefactoring methodsFor: 'private-class' stamp: 'NicolaiHess 12/1/2014 21:39'!
privateGenerateSuperClassFor: class

	| superclassName subclasses |
	superclassName := self request: 'Enter new superclass name:'.
	superclassName isEmptyOrNil ifTrue: [ ^ nil ].
	subclasses := self
						chooseMultipleFrom: class subclasses
						title: 'Select subclasses of ' , superclassName , ':'.
						
	subclasses ifNil: [ ^ self ].					
	
	^ RBChildrenToSiblingsRefactoring 
		model: environment
		name: superclassName
		class: class
		subclasses: subclasses! !

!NautilusRefactoring methodsFor: 'private-source' stamp: ''!
privateSplitCascadeBetween: anInterval from: aMethod

	^ RBSplitCascadeRefactoring
		model: environment
		split: anInterval
		from: aMethod selector
		in: aMethod methodClass! !

!NautilusRefactoring methodsFor: 'class var' stamp: ''!
pushDownClassVarFrom: aClass
	| refactoring |
	
	aClass ifNil: [ ^ self ].
	refactoring := self privatePushDownClassVarFrom: aClass.
	
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'class' stamp: 'StephaneDucasse 1/31/2015 20:29'!
removeClasses: aCollection
	"Execute the refactoring of the receiver."

	| refactoring |
	refactoring := self classRemovalRefactoringObjectFor: aCollection.
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring.
	^ true! !

!NautilusRefactoring methodsFor: 'class' stamp: ''!
splitClass: aClass
	| refactoring |
	
	aClass ifNil: [ ^ self ].
	refactoring := self privateSplitClassFor: aClass.
	
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'display' stamp: 'StephaneDucasse 5/18/2012 14:54'!
shouldUseExistingMethod: aMethodName
	"for now we always want to use the existing method."
	^ true! !

!NautilusRefactoring methodsFor: '*SmartSuggestions' stamp: 'GiselaDecuzzi 4/22/2013 15:37'!
accessorsClassVarNamed: aVariableName from: aClass
	| refactoring |
	
	aClass ifNil: [ ^ self ].
	refactoring := self privateAccessorsClassVarNamed: aVariableName from:  aClass.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring.! !

!NautilusRefactoring methodsFor: 'rewrite code' stamp: ''!
rewriteCodeText
	
	^ 'RBParseTreeRewriter new
	replace: ''`@object'' with: ''`@object'';
	replace: ''`@object'' with: ''`@object'' when: [ :node | true ];
	replace: ''`@object'' withValueFrom: [ :node | node ];
	replace: ''`@object'' withValueFrom: [ :node | node ] when: [ :node | true ];
	replaceMethod: ''`@method: `@args | `@temps | `@.statements'' with: ''`@method: `@args | `@temps | `@.statements'';
	replaceMethod: ''`@method: `@args | `@temps | `@.statements'' with: ''`@method: `@args | `@temps | `@.statements'' when: [ :node | true ];
	replaceMethod: ''`@method: `@args | `@temps | `@.statements'' withValueFrom: [ :node | node ];
	replaceMethod: ''`@method: `@args | `@temps | `@.statements'' withValueFrom: [ :node | node ] when: [ :node | true ];
	yourself'! !

!NautilusRefactoring methodsFor: 'private-method' stamp: 'SebastianTleye 7/31/2013 13:34'!
privateRemoveMethodsFor: aCollection
	| selectors class |

	selectors := aCollection collect: #selector.
	class := aCollection first origin.
	(aCollection allSatisfy: [:e | e origin == class ]) ifFalse: [ ^ nil ].
	
	^ RBRemoveMethodRefactoring
		model: environment
		removeMethods: selectors
		from: class! !

!NautilusRefactoring methodsFor: 'private-class var' stamp: ''!
privateAbstractClassVarFrom: aClass

	^ self class: aClass andClassVariable: [ :class :variable | 
		RBAbstractClassVariableRefactoring
			model: environment
			variable: variable
			class: class ]! !

!NautilusRefactoring methodsFor: 'rewrite code' stamp: ''!
categoryRegexText

	^ 'RBCategoryRegexRefactoring new
	replace: ''^Kernel-(.*)$'' with: ''System-$1'' ignoreCase: false;
	yourself'! !

!NautilusRefactoring methodsFor: 'private-class var' stamp: ''!
privateRemoveClassVarFrom: aClass

	^ self class: aClass andClassVariable: [ :class :variable | 
		RBRemoveClassVariableRefactoring
			model: environment
			variable: variable
			class: class ]! !

!NautilusRefactoring methodsFor: 'option' stamp: ''!
promptOnRefactoring

	^ self class promptOnRefactoring! !

!NautilusRefactoring methodsFor: 'source' stamp: ''!
createCascadeBetween: anInterval from: aMethod
	| refactoring | 
	
	aMethod ifNil: [ ^ self ].
	refactoring := self privateCreateCascadeBetween: anInterval from: aMethod.
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'display' stamp: 'GuillermoPolito 3/19/2015 14:43'!
class: aClass andInstVariable: aBlock
	| variables index variable class |
	
	variables := aClass instanceVariables sorted.
	index := UIManager default chooseFrom: variables.
	variable := variables at: index ifAbsent: [ ^ nil ].
	class := aClass whichClassDefinesInstVar: variable.
	class := class isMeta not
				ifTrue: [ RBClass existingNamed: class name ] 
				ifFalse: [ RBMetaclass existingNamed: class theNonMetaClass name ].
	class model: environment.
	^ aBlock value: class value: variable! !

!NautilusRefactoring methodsFor: 'class var' stamp: ''!
abstractClassVarFrom: aClass
	| refactoring |
	
	aClass ifNil: [ ^ self ].
	refactoring := self privateAbstractClassVarFrom: aClass.
	
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'performing' stamp: ''!
performRefactoring: aRefactoring
	"Try to properly label aRefactoring and perform it or open the changes browser, depending on the preferences of the user."

	self performRefactorings: {aRefactoring}! !

!NautilusRefactoring methodsFor: 'source' stamp: 'BenjaminVanRyseghem 4/18/2012 17:44'!
extractToTempTextSelection
	| aMethod selectedInterval textArea |
	
	textArea := self model sourceTextArea.
	aMethod := self model selectedMethod.
	aMethod ifNil: [ ^ textArea flash ].
	textArea selectedContents asString ifEmpty: [ ^ textArea flash ].
	
	selectedInterval := textArea selectionInterval.
	self extractToTemporaryBetween: selectedInterval from: aMethod! !

!NautilusRefactoring methodsFor: 'private-source' stamp: ''!
privateMoveVariableDefinitionBetween: anInterval from: aMethod

	^ RBMoveVariableDefinitionRefactoring
		model: environment
		bindTight: anInterval
		in: aMethod methodClass
		selector: aMethod selector! !

!NautilusRefactoring methodsFor: 'undo-redo' stamp: ''!
undoOperation 

	self changeManager undoOperation! !

!NautilusRefactoring methodsFor: 'display' stamp: 'CamilloBruni 10/8/2012 11:37'!
handleFailure: anException
	anException actionBlock isNil
		ifTrue: [ self inform: anException messageText ]
		ifFalse: [ 
			(self confirm: anException messageText) 
				ifTrue: [ anException actionBlock value ] ].
	anException return! !

!NautilusRefactoring methodsFor: 'inst var' stamp: 'BenjaminVanRyseghem 4/18/2012 16:55'!
renameInstVarNamed: aName from: aClass
	| refactoring |
	
	aClass ifNil: [ ^ self ].
	refactoring := self privateRenameInstVarNamed: aName from:  aClass.
	
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'class' stamp: ''!
renameClass: aClass
	| refactoring |
	
	aClass ifNil: [ ^ self ].
	refactoring := self buildRenameRefactoringEngineFor: aClass.
	
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring ! !

!NautilusRefactoring methodsFor: 'class var' stamp: ''!
pullUpClassVarFrom: aClass
	| refactoring |
	
	aClass ifNil: [ ^ self ].
	refactoring := self privatePullUpClassVarFrom: aClass.
	
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'private-source' stamp: ''!
privateExtractToTemporaryBetween: anInterval from: aMethod
	| name |
	
	name := (self request: 'Enter the new variable name:').
	name ifNil: [ ^ nil ].

	^ RBExtractToTemporaryRefactoring
		model: environment
		extract: anInterval
		to: name
		from: aMethod selector
		in: aMethod methodClass! !

!NautilusRefactoring methodsFor: 'private-class' stamp: ''!
privateGenerateAccessorsFor: class

	^ class instVarNames collect: [:aVarName | 
				RBCreateAccessorsForVariableRefactoring
					model: environment
					variable: aVarName
					class: class
					classVariable: false ]! !

!NautilusRefactoring methodsFor: 'inst var' stamp: 'MarkRizun 7/24/2014 14:09'!
moveInstVarToClass: aClass
	| refactoring |
	
	aClass ifNil: [ ^ self ].
	refactoring := self privateMoveInstVarToClass: aClass.
	
	refactoring ifNil: [ ^ self ].
	refactoring model environment: self model browsedEnvironment.
	self performRefactoring: refactoring! !

!NautilusRefactoring methodsFor: 'private-method' stamp: ''!
privateSwapMethodFor: aCollection
	
	^ aCollection collect: [:aMethod | 
			RBSwapMethodRefactoring
				model: environment
				swapMethod: aMethod selector
				in: aMethod methodClass ]! !

!NautilusRefactoring methodsFor: 'private-class' stamp: ''!
classObjectFor: anObject 

	(anObject isBehavior or: [anObject isTrait]) ifTrue: [ ^ environment classFor: anObject ].
	anObject isSymbol ifTrue: [ ^ environment classNamed: anObject ].
	^ anObject! !

!NautilusRefactoring methodsFor: 'display' stamp: ''!
chooseMultipleFrom: anArray

	^ self chooseMultipleFrom: anArray title: ''! !

!NautilusRefactoring methodsFor: 'undo-redo' stamp: ''!
undoLabel
	| stream |
	stream := WriteStream with: 'Undo'.
	self changeManager hasUndoableOperations ifFalse: [ ^ stream contents ].
	
	stream nextPut: $ ; nextPutAll: self changeManager undoChange name.
	stream position > 40
		ifTrue: [ stream position: 40; nextPutAll: '...' ].
		
	^ stream contents! !

!NautilusRefactoring methodsFor: 'source' stamp: 'BenjaminVanRyseghem 4/18/2012 17:25'!
renameTextSelectionForMethod
	| selectedInterval selection method |
	
	method := self model selectedMethod.
	selection := self model sourceTextArea selectedContents asString.
	selectedInterval := self model sourceTextArea selectionInterval.
	
	selectedInterval first = 1 
		ifTrue: [ ^ self renameMethodFor: method ].
		
	self renameTemporaryNamed: selection Between: selectedInterval from: method! !

!NautilusRefactoring class methodsFor: 'shortcuts' stamp: 'BenjaminVanRyseghem 6/27/2012 13:27'!
buildRefactoringShortcutsOn: aBuilder
	<keymap>	

	(aBuilder shortcut: #generateAccessors)
		category: #NautilusGlobalShortcuts
		default: $h command,  $a command
		do: [:target | target refactor generateAccessors ]
		description: 'Generate the accessors for the selected class'.
		
	(aBuilder shortcut: #generateSubclass)
		category: #NautilusGlobalShortcuts
		default: $h command,  $n command, $s command
		do: [:target | target refactor generateSubclass ]
		description: 'Generate a subclass for the selected class'.! !

!NautilusRefactoring class methodsFor: 'accessing' stamp: ''!
promptOnRefactoring

	^ PromptOnRefactoring ifNil: [ PromptOnRefactoring := true ]! !

!NautilusRefactoring class methodsFor: 'menu' stamp: 'SebastianTleye 8/8/2013 18:00'!
refactoringMethodMenu: aBuilder
	<nautilusGlobalMethodMenu>

	| target |
	target := aBuilder model.
	target selectedMethod ifNil:[ ^ target ].
	
	target selectedMethod origin instanceSide refactoringMethod: aBuilder.! !

!NautilusRefactoring class methodsFor: 'menu' stamp: 'SebastianTleye 8/8/2013 17:54'!
instVarRefactoringSubmenu: aBuilder
	<nautilusGlobalClassMenu>
	| target selectedClass |
	
	target := aBuilder model.
	selectedClass := target selectedClass.
	selectedClass ifNil: [^target].
	
	selectedClass instVarRefactoring: aBuilder.! !

!NautilusRefactoring class methodsFor: 'menu' stamp: 'SebastianTleye 7/30/2013 16:10'!
classVarRefactoringSubmenu: aBuilder
	<nautilusGlobalClassMenu>
	| target selectedClass |
	target := aBuilder model.
	selectedClass := target selectedClass.
	selectedClass ifNil: [ ^ target ].
	
	selectedClass varRefactoringSubMenu: aBuilder.

	! !

!NautilusRefactoring class methodsFor: 'menu' stamp: 'SebastianTleye 7/30/2013 13:35'!
refactoringClassMenu: aBuilder
	<nautilusGlobalClassMenu>
	| target |
	target := aBuilder model.
	target selectedClass ifNil: [^target].
	target selectedClass refactoringMenu: aBuilder.! !

!NautilusRefactoring class methodsFor: 'menu' stamp: 'EstebanLorenzano 10/3/2013 16:16'!
groupRefactoringMenu: aBuilder
	<nautilusGlobalGroupMenu>
	| target |
	target := aBuilder model.
	target selectedClass ifNotNil: [
		target selectedClass groupRefactoring: aBuilder ].! !

!NautilusRefactoring class methodsFor: 'shortcuts' stamp: 'BenjaminVanRyseghem 6/24/2012 22:29'!
buildRefactoringMethodShortcutsOn: aBuilder
	<keymap>	

	(aBuilder shortcut: #rename)
		category: #NautilusGlobalShortcuts
		default: $r command,  $m command
		do: [:target || scroll |
				scroll := target methodWidget vScrollValue.
				target refactor renameMethodFor: target selectedMethod.
				target methodWidget vScrollValue: scroll]
		description: 'Rename the seleted method'
		! !

!NautilusRefactoring class methodsFor: 'shortcuts' stamp: 'BenjaminVanRyseghem 1/25/2013 17:49'!
buildSourceCodeShortcutsOn: aBuilder
	<keymap>	

	(aBuilder shortcut: #rename)
		category: #NautilusSourceCodeShortcuts
		default: $r command
		do: [:target | (target sourceTextArea hasUnacceptedEdits not)
							ifTrue: [ target refactor renameTextSelection ]]
		description: 'Rename the current selection'.
		
	(aBuilder shortcut: #extractToTemp)
		category: #NautilusSourceCodeShortcuts
		default: $x command shift
		do: [:target | (target sourceTextArea hasUnacceptedEdits not)
							ifTrue: [ target refactor extractToTempTextSelection ]]
		description: 'Extract to temp the current selection'.
		
	(aBuilder shortcut: #extractToMethod)
		category: #NautilusSourceCodeShortcuts
		default: $m command shift
		do: [:target | (target sourceTextArea hasUnacceptedEdits not)
							ifTrue: [ target refactor extractToMethodTextSelection ]]
		description: 'Extract to method the current selection'.
	
	(aBuilder shortcut: #format) 
		category: #NautilusSourceCodeShortcuts
		default: $u command shift
		do: [ :target | target refactor formatSourceCode ].! !

!NautilusRefactoring class methodsFor: 'menu' stamp: 'SebastianTleye 8/8/2013 17:55'!
methodRefactoringSubMenu: aBuilder
	<nautilusGlobalMethodMenu>
	| target selectedMethod |

	target := aBuilder model.
	selectedMethod := target selectedMethod.
	selectedMethod ifNil:[ ^ target ].
	
	selectedMethod origin instanceSide methodRefactoring: aBuilder.! !

!NautilusRefactoring class methodsFor: 'menu' stamp: 'NicolaiHess 1/31/2015 00:46'!
sourceCodeRefactoringMenuHolder: aBuilder
	<nautilusGlobalSourceCodeMenu>
	| target |
	target := aBuilder model.	
	target selectedMethod ifNil:[^ self].
	target selectedClass ifNotNil: [:selectedClass |  selectedClass sourceCodeRefactoringMenu: aBuilder ].! !

!NautilusRefactoring class methodsFor: 'menu' stamp: 'SebastianTleye 7/30/2013 15:22'!
classRefactoringSubmenu: aBuilder
	<nautilusGlobalClassMenu>
	| target |
	target := aBuilder model.
	target selectedClass ifNil: [^target].
	
	target selectedClass refactoringSubmenu: aBuilder.! !

!NautilusRefactoring class methodsFor: 'menu' stamp: 'EstebanLorenzano 10/10/2013 13:24'!
packageRefactoringMenu: aBuilder
	<nautilusGlobalPackageMenu>
	
	| target |
	
	target := aBuilder model.
	
	(aBuilder item: #'Rewrite Code')
		order:  100;
		withSeparatorAfter.
	
	(aBuilder item: #'Rewrite Code')
		action: [ target refactor rewriteCode ];
		parent: #'Rewrite Code';
		order: 0.

	(aBuilder item: #'Search Code')
		action: [ target refactor searchCode ];
		parent: #'Rewrite Code';
		order: 100.
	! !

!NautilusRefactoring class methodsFor: 'instance creation' stamp: ''!
model: model

	^ self new
		model: model;
		yourself! !

!NautilusRefactoring class methodsFor: 'menu' stamp: 'NicolaiHess 1/31/2015 00:46'!
sourceCodeRefactoringSubMenu: aBuilder
	<nautilusGlobalSourceCodeMenu>
	| target |
	target := aBuilder model.	
	target selectedMethod ifNil:[^ self].
	target selectedClass ifNotNil: [:selectedClass | selectedClass sourceCodeRefactoring: aBuilder ]! !

!NautilusRefactoring class methodsFor: 'menu' stamp: 'SebastianTleye 8/8/2013 17:52'!
codeRewritingClassSubmenu: aBuilder
	<nautilusGlobalClassMenu>
	| target |
	target := aBuilder model.
	target selectedClass ifNil: [^target].
	
	target selectedClass codeRewritingClass: aBuilder.! !

!NautilusShowCategoriesChanged commentStamp: '<historical>'!
A NautilusShowCategoriesChanged is raised the value showCategories changed!
!NautilusShowCommentChanged commentStamp: '<historical>'!
A NautilusShowCommentChanged is raised when showComment is switched!
!NautilusShowGroupsChanged commentStamp: '<historical>'!
A NautilusShowGroupsChanged is raised when the value showGroups is switched!
!NautilusShowHierarchyChanged commentStamp: '<historical>'!
A NautilusShowHierarchyChanged is raised when the value of howHierarchy is switched!
!NautilusShowInstanceChanged commentStamp: '<historical>'!
A NautilusShowInstanceChanged is raised when the value of showInstances is changed!
!NautilusShowPackagesChanged commentStamp: '<historical>'!
A NautilusShowPackagesChanged is raised when the value of showPackages changed!
!NautilusTest commentStamp: '<historical>'!
A NautilusTest is a test class for testing the behavior of Nautilus!
!NautilusTest methodsFor: 'tests' stamp: 'BenjaminVanRyseghem 2/16/2013 15:24'!
testSelectedCategory

	self assert: nautilus selectedMethod isNil.
	nautilus selectedMethod: (Object>>#at:).
	nautilus selectedCategory: 'test'.
	self assert: (nautilus selectedCategory = 'test').
	self assert: (nautilus selectedMethod isNil).! !

!NautilusTest methodsFor: 'running' stamp: ''!
tearDown

	nautilus := nil.! !

!NautilusTest methodsFor: 'tests' stamp: 'BenjaminVanRyseghem 2/16/2013 15:06'!
testCorrespondingMethods

	self assert: ((Dictionary>>#associations) == (DictionaryTest>>#testAssociations) correspondingMethods first).
	self assert: ((Dictionary>>#add:) == (DictionaryTest>>#testAdd) correspondingMethods first).
	self assert: ((Dictionary>>#at:put:) == (DictionaryTest>>#testAtPut) correspondingMethods first).! !

!NautilusTest methodsFor: 'tests' stamp: 'BenjaminVanRyseghem 2/16/2013 15:22'!
testCorrespondingTestClass
	self assert: (Behavior correspondingForTest == BehaviorTest).
	self assert: (BehaviorTest correspondingForTest == Behavior).! !

!NautilusTest methodsFor: 'tests' stamp: ''!
testCorrespondingTestMethod

	self assert: ((Dictionary>>#associations) correspondingTestMethod == (DictionaryTest>>#testAssociations)).
	self assert: ((Dictionary>>#add:) correspondingTestMethod == (DictionaryTest>>#testAdd)).
	self assert: ((Dictionary>>#at:put:) correspondingTestMethod == (DictionaryTest>>#testAtPut)).! !

!NautilusTest methodsFor: 'tests' stamp: 'BenjaminVanRyseghem 4/20/2012 00:17'!
testSelectedClass

	self assert: nautilus selectedMethod isNil.
	nautilus selectedMethod: (Object>>#at:).
	nautilus selectedCategory: 'test'.
	self assert: (nautilus selectedCategory = 'test').
	self assert: (nautilus selectedMethod isNil).
	
	nautilus selectedClass: Morph.
	self assert: (nautilus selectedClass = Morph).
	self assert: (nautilus selectedCategory isNil).
	self assert: (nautilus selectedMethod isNil).! !

!NautilusTest methodsFor: 'tests' stamp: 'BenjaminVanRyseghem 4/19/2012 23:47'!
testSelectedMethod

	self assert: nautilus selectedMethod isNil.
	nautilus selectedMethod: (Object>>#at:).
	self assert: (nautilus selectedMethod = (Object>>#at:))! !

!NautilusTest methodsFor: 'running' stamp: ''!
setUp

	nautilus := Nautilus new.! !

!NautilusTextDisplayerChanged commentStamp: '<historical>'!
A NautilusTextDisplayerChanged is raised when the way to display the method changed.!
!NautilusTextDisplayerChanged methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/13/2012 21:15'!
displayerSymbol
	^ displayerSymbol! !

!NautilusTextDisplayerChanged methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/13/2012 21:15'!
displayerSymbol: anObject
	displayerSymbol := anObject! !

!NautilusTextDisplayerChanged class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 6/13/2012 21:19'!
displayerSymbol: anObject

	^ self new
		displayerSymbol: anObject;
		yourself! !

!NautilusUI commentStamp: '<historical>'!
A UI for an instance of Nautilus!
!NautilusUI methodsFor: 'selection' stamp: 'NicolaiHess 8/9/2014 21:12'!
resetMethodsListSelection

	methodWidget resetMethodSelection! !

!NautilusUI methodsFor: 'selection' stamp: 'NicolaiHess 8/9/2014 21:54'!
resetAllListSelections

	self resetPackageGroupsListSelection.
	self resetClassesListSelection.
	self resetCategoriesListSelection.
	self resetMethodsListSelection.! !

!NautilusUI methodsFor: 'widget category' stamp: ''!
categoriesLabel

	^ categoryWidget categoriesLabel! !

!NautilusUI methodsFor: 'widget method' stamp: ''!
buildTestSelectorFor: aMethod

	^ String streamContents: [:s || capitalize |
		capitalize := true.
		s << 'test'.
		aMethod selector do: [:c |
			c = $:
				ifTrue: [ capitalize := true ]
				ifFalse: [ capitalize
							ifTrue: [ 
								capitalize := false.
								s << c asUppercase. ]
							ifFalse:[ s << c ]]]]
			! !

!NautilusUI methodsFor: 'menus behavior' stamp: 'NicolaiHess 8/2/2014 21:54'!
removeCategories

	self selectedClass 
		ifNotNil: [:class |
			self selectedCategories
				ifNotEmpty: [:items || removeACategory scroll |
					scroll := categoryWidget vScrollValue.
					removeACategory := false.
					items do: [:item || needToUpdate |
						needToUpdate := self removeCategory: item inClass: class.
						(needToUpdate and: [ removeACategory not ]) ifTrue: [ removeACategory := true].
						needToUpdate ifTrue: [ self updateCategoryAndMethodList ]].

					removeACategory ifTrue: [ self selectedCategory: nil ].
					self updateCategoryAndMethodList.
					categoryWidget vScrollValue: scroll. ]]! !

!NautilusUI methodsFor: 'group' stamp: 'BenjaminVanRyseghem 4/14/2012 12:10'!
addMethodsInGroup: aCollection

	(DialogGroupAdder new
		groups: self groupsManager;
		elementsToAdd: (aCollection sort: [:a :b | a name < b name]))
		open! !

!NautilusUI methodsFor: 'system announcements' stamp: 'CamilleTeruel 9/4/2014 16:37'!
methodRemoved: anAnnouncement
	
	| method |
	window ifNil: [ ^ self ].
	window isDisplayed ifFalse: [ ^ self ].
		
	method := anAnnouncement method.
	((method methodClass = self selectedClass) or: [ method methodClass users includes: self selectedClass  ])
		ifTrue: [ 
			self selectedMethod = anAnnouncement method
				ifTrue: [ self selectedMethod: nil ].
			self resetMethodsListSelection.
			self removeAllFromMethodsIconsCache: method.
			method isTestMethod
				ifTrue: [ "Should update class icon"
					ClassesIconsCache removeKey: method methodClass ifAbsent: [].
					self updateClassView ].
			self updateCategoryAndMethodList.
			(method methodClass isMeta and: [ method methodClass hasMethods not ])
				ifTrue: [ self changed: #instanceButtonLabel ] ]! !

!NautilusUI methodsFor: 'selection' stamp: 'NicolaiHess 8/9/2014 21:18'!
resetClassesListSelection

	classWidget resetClassSelection ! !

!NautilusUI methodsFor: 'widget package' stamp: 'NicolaiHess 7/27/2014 13:44'!
buildPackageWidget
	| packagesList |
	packagesList := packageWidget buildPackagesList.
	self setShortcuts: #NautilusPackageShortcuts to: packagesList.
	^ packagesList! !

!NautilusUI methodsFor: 'debugging actions' stamp: 'BenjaminVanRyseghem 5/2/2012 10:33'!
buildTestSuiteFor: aMethod

	^ TestSuite new
		addTest: (aMethod methodClass selector: aMethod selector);
		yourself! !

!NautilusUI methodsFor: 'initialization' stamp: 'StephaneDucasse 2/13/2015 20:53'!
initialize
	super initialize.
	categoryWidget := CategoryWidget model: self.
	methodWidget := MethodWidget model: self.
	classWidget := ClassWidget model:self.
	packageWidget := PackageListWidget model: self.! !

!NautilusUI methodsFor: 'widget method' stamp: ''!
methodsInSystemEnvironmentForCategory: aCategory  in: class
	
	aCategory = self allLabel
		ifTrue: [ ^ class methods asOrderedCollection ].
	
	^ (class methodsInProtocol: aCategory) asOrderedCollection! !

!NautilusUI methodsFor: 'widget category' stamp: ''!
selectedCategories

	^ categoryWidget selectedCategories! !

!NautilusUI methodsFor: 'widget category' stamp: ''!
getMethods

	^ methodWidget getMethods! !

!NautilusUI methodsFor: 'group' stamp: ''!
addProtocolsInGroup: aCollection
	| class mthds |
	
	(class := self selectedClass) ifNil: [ ^ self ].
	
	mthds := self showGroups
				ifTrue: [ self methodsForCategoriesInGroup: aCollection ]
				ifFalse:[ self methodsForCategories: aCollection ].

	(DialogGroupAdder new
		groups:	self groupsManager;
		elementsToAdd: (mthds sort: [:a :b | a name < b name]))
		open! !

!NautilusUI methodsFor: 'system announcements' stamp: 'NicolaiHess 8/2/2014 21:54'!
methodAdded: anAnnouncement
	
	| method |
	window ifNil: [ ^ self ].
	window isDisplayed ifFalse: [ ^ self ].
	
	method := anAnnouncement method.
	((method methodClass = self selectedClass) or: [ method methodClass users includes: self selectedClass  ])
		ifTrue: [ 
			self resetMethodsListSelection.
			self removeAllFromMethodsIconsCache: method.
			self updateCategoryAndMethodList.
			(method methodClass isMeta and: [ method methodClass methods size = 1 ])
				ifTrue: [ self changed: #instanceButtonLabel ] ]! !

!NautilusUI methodsFor: 'focus' stamp: 'NicolaiHess 7/26/2014 00:50'!
giveFocusToClass

	self giveFocusTo: self classWidget! !

!NautilusUI methodsFor: 'widget method' stamp: 'EstebanLorenzano 2/6/2013 17:12'!
buildMethodWidget
	| methodsList |
	
	methodsList := methodWidget buildMethodsList.	
	
	self 
		setShortcuts: #NautilusMethodShortcuts 
		to: methodsList. 
	
	^methodsList	
! !

!NautilusUI methodsFor: 'menus behavior' stamp: 'NicolaiHess 8/9/2014 21:59'!
findAllMethod
	"Search for a method in the lookup of the selected class"

	| foundMethod class |
	self okToChange ifFalse: [^ self flashPackage ].
	
	class := self selectedClass.
	class ifNil: [ ^ self ].
	
	foundMethod := (SearchFacade allMessageSearchFor: class) chooseFromOwner: self window.
	foundMethod ifNil: [^ self ].
	
	self showGroupsSilently: false.
	self resetCategoriesList.
	self resetMethodsListSelection.
	self categoryWidget selectProtocol: foundMethod category.
 	self model package: class package class: class category: foundMethod protocol method: foundMethod.
	
	self updatePackageGroupAndClassList.
	self updateCategoryAndMethodList.
	self changed: #sourceCodeFrom:! !

!NautilusUI methodsFor: 'widget method' stamp: ''!
removeAllFromMethodsIconsCache: aMethod

	methodWidget removeAllFromMethodsIconsCache: aMethod! !

!NautilusUI methodsFor: 'menus behavior' stamp: 'NicolaiHess 7/28/2014 22:42'!
runTestForAMethodWithAnHalt: aMethod
	| testMethod  color vScroll testClass testResult  |
	
	testMethod := aMethod correspondingTestMethod.
	testMethod ifNil: [ ^ self ].

	vScroll := methodWidget vScrollValue.
	
	testClass := testMethod methodClass.
	testResult := testClass run: testMethod selector.
	testResult updateResultsInHistory.
		
	(testResult failures isEmpty not or: [ testResult errors isEmpty not ])
		ifTrue: [ 
			testClass debug: testMethod selector ].
	ClassesIconsCache removeKey: aMethod methodClass ifAbsent: []. 
	UIManager default defer:  [ methodWidget vScrollValue: vScroll ].
	color := Color gray.
	aMethod hasPassedTest ifTrue: [ color :=  Color green ].
	aMethod hasFailedTest ifTrue: [ color :=  Color yellow ].
	aMethod hasErrorTest ifTrue: [ color :=  Color red ].

	self
		notifyTitle: 'Test Finished' 
		contents: 'Method: ',testMethod methodClass asString, '>>#',testMethod selector asString
		color: color! !

!NautilusUI methodsFor: 'menus behavior' stamp: ''!
fileOutMethods

	self fileOutMethods: self selectedMethods! !

!NautilusUI methodsFor: 'menus behavior' stamp: 'NicolaiHess 8/9/2014 22:00'!
findProtocol
	"Search for a method in the lookup of the selected class"

	| foundProtocol class |
	
	class := self selectedClass.
	class ifNil: [ ^ self ].
	self okToChange ifFalse: [^ self flashPackage ].

	foundProtocol := (SearchFacade protocolSearchFor: class) chooseFromOwner: self window.
	foundProtocol ifNil: [^ self ].
		
	self showGroupsSilently: false.
	self resetCategoriesListSelection.
	self categoryWidget selectProtocol: foundProtocol.
 	self model package: class package class: class category: foundProtocol method: nil.
	
	self updatePackageGroupAndClassList.
	self updateCategoryAndMethodList.
	self changed: #sourceCodeFrom:! !

!NautilusUI methodsFor: 'widget method' stamp: ''!
methodsSelection

	^ methodWidget methodsSelection! !

!NautilusUI methodsFor: 'history behavior' stamp: 'BenjaminVanRyseghem 10/18/2013 16:36'!
wrapHistory: anEntry
	
	^ GoBackStringMorph contents: anEntry key asHistoryString! !

!NautilusUI methodsFor: 'widget method' stamp: 'BenjaminVanRyseghem 4/17/2012 13:40'!
methodsIconsCache
	
	^ self methodWidget methodsIconsCache! !

!NautilusUI methodsFor: 'group' stamp: 'BenjaminVanRyseghem 4/14/2012 12:17'!
addMethodsInGroup

	self selectedMethods ifNotNil: [:mthds | self addMethodsInGroup: mthds ]! !

!NautilusUI methodsFor: 'widget method' stamp: 'IgorStasenko 8/30/2012 15:59'!
methodsInARestrictedEnvironment: env forCategory: aCategory  in: class
	| mthds selectors |
	
	aCategory = self allLabel
		ifTrue: [ ^ class methods asOrderedCollection select: [:e | env includesSelector: e selector in: class ]].
	selectors := env selectorsFor: aCategory in: class.
	mthds := OrderedCollection new.
	selectors do: [:s | mthds add: (class compiledMethodAt: s) ].
	^ mthds! !

!NautilusUI methodsFor: 'system announcements' stamp: 'NicolaiHess 8/2/2014 21:54'!
methodModified: anAnnouncement 
	| collection nonMetaMethodClass |

	window ifNil: [ ^ self ].
	window isDisplayed ifFalse: [ ^ self ].
	
	collection := self classWidget getClassesList.
	nonMetaMethodClass:=anAnnouncement methodClass.
	self showInstance ifFalse:[nonMetaMethodClass:=nonMetaMethodClass theNonMetaClass].
	((collection includes: nonMetaMethodClass) or: [ anAnnouncement methodClass users includes: self selectedClass  ])
		ifTrue: [
			| method selectedMethod oldMethod |
			method := anAnnouncement newMethod.
			selectedMethod := self selectedMethod.
			self removeFromMethodsIconsCache: method.
			method isTestMethod
				ifTrue: [ "Should update class icon"
					ClassesIconsCache removeKey: method methodClass ifAbsent: []].
			self updateClassView.
			oldMethod := anAnnouncement oldMethod.
			(selectedMethod = oldMethod)
				ifTrue: [
					sourceTextArea hasUnacceptedEdits
						ifTrue: [ | sourceCode |
							sourceCode := sourceTextArea text.
							self forceSelectedMethod: method.
							self updateCategoryAndMethodList.
							self highlightCategory: method.
							sourceTextArea setText: sourceCode.
							sourceTextArea hasEditingConflicts: true.
							sourceTextArea update: #codeChangedElsewhere ]
						ifFalse: [
							self selectedMethod: method.
							self updateCategoryAndMethodList ]]]! !

!NautilusUI methodsFor: 'widget method' stamp: ''!
methodsForCategoryInGroup: aCategory
	| class group env mthds |

	(class := self selectedClass) ifNil: [ ^ {} ].
	(group := self selectedGroup) ifNil: [ ^ {} ].
	env := self browsedEnvironment.
	mthds := env isSystem
		ifTrue: [
			aCategory = self allLabel
				ifTrue: [ (group methodsFor: class) asOrderedCollection ]
				ifFalse: [ (group methodsFor: class categorised: aCategory) asOrderedCollection ]]
		ifFalse: [
			aCategory = self allLabel
				ifTrue: [ (group methodsFor: class) asOrderedCollection select: [:e | env includesSelector: e selector in: class ]]
				ifFalse: [(group methodsFor: class categorised: aCategory) asOrderedCollection select: [:e | env includesSelector: e selector in: class ]]].
	^ mthds sort: [:a :b | a selector < b selector ]! !

!NautilusUI methodsFor: '*SmartSuggestions' stamp: 'GiselaDecuzzi 5/2/2013 09:52'!
sugsContext
	^ SugsNautilusContext model: self.! !

!NautilusUI methodsFor: 'selection' stamp: 'NicolaiHess 8/9/2014 22:04'!
resetPackageGroupsListSelection
	self packageWidget resetPackagesSelection.
	self packageWidget resetGroupsSelection.! !

!NautilusUI methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/18/2013 17:55'!
selectedCategoryInternally: anObject

	self resetMethodsListSelection.
	anObject ifNotNil: [ self giveFocusTo: categoryWidget ].
	self changed: #sourceCodeFrom:! !

!NautilusUI methodsFor: 'displaying' stamp: 'JurajKubelka 2/4/2015 12:04'!
open
	| focus |
	super open.
	window takeKeyboardFocus.
	focus := self packageWidget.
	self selectedClass 
		ifNotNil: [ 
			acceptor := ClassOrMethodDefinitionAcceptor model: self. 
			focus := self classWidget ].
	self selectedCategory ifNotNil: [:cat |  
		categoryWidget selectProtocol: cat.
		self resetMethodsList.
		acceptor := MethodDefinitionAcceptor model: self. 
		focus := categoryWidget ].
	self selectedMethod ifNotNil: [:meth | 
		methodWidget selectMethod: meth.
		acceptor := MethodDefinitionAcceptor model: self. 
		focus := methodWidget ].
	self selectedClass ifNotNil: [ methodWidget updateMethodList ].
	self giveFocusTo: focus.
	! !

!NautilusUI methodsFor: 'selection' stamp: 'NicolaiHess 8/9/2014 22:02'!
resetMethodsList
	self methodWidget resetMethodList! !

!NautilusUI methodsFor: 'menus behavior' stamp: 'NicolaiHess 8/2/2014 21:54'!
removeMethod: aMethod inClass: aClass
	"If a message is selected, create a Confirmer so the user can verify that  
	the currently selected message should be removed from the system. If 
	so, remove it. "
	
	| result |
	self okToChange ifFalse: [^ false].
	result := super removeMethod: aMethod inClass: aClass.
	result ifTrue: [ self updateCategoryAndMethodList ].
	^result! !

!NautilusUI methodsFor: 'widget category' stamp: ''!
enableCategorySingleSelection

	^ self selectedCategories size <= 1! !

!NautilusUI methodsFor: '*NodeNavigation' stamp: 'GiselaDecuzzi 5/13/2013 13:33'!
isWorkspace
	^ false! !

!NautilusUI methodsFor: 'private' stamp: ''!
nextButtonState
	^ true! !

!NautilusUI methodsFor: 'widget method' stamp: ''!
methodsForCategoriesInGroup: aCollection

	| mthds |
	mthds := aCollection gather: [:e | self methodsForCategoryInGroup: e ].
	^ mthds sort: [:a :b | a selector < b selector ]! !

!NautilusUI methodsFor: 'drag and drop' stamp: ''!
dropMethod: aCollectionOfMethods inARow: aRow

	| newProtocol |
	
	newProtocol := self getCategories at: aRow.
	aCollectionOfMethods do: [:aMethod | self move: aMethod from: aMethod category to: newProtocol isCopy: false ].
	self selectedMethod: nil! !

!NautilusUI methodsFor: 'menus behavior' stamp: 'NicolaiHess 7/28/2014 22:42'!
runTestForAMethod: aMethod notifying: aBoolean priority: aPriority
	| testMethod testSemaphoreForMethod blockToEvaluate shouldAnnounce |
	
	testMethod := aMethod correspondingTestMethod.
	testSemaphoreForMethod := Semaphore new. 
	shouldAnnounce := aBoolean.
	testMethod ifNil: [ ^ self ].

	blockToEvaluate := [
		| vScroll testClass testResult |
		vScroll := methodWidget vScrollValue.
		
		testClass := testMethod methodClass.
		testResult := [ testClass run: testMethod selector ]
							on: Halt
							do: [ :e | 
								aBoolean
									ifTrue: [ 
										[ self runTestForAMethodWithAnHalt: aMethod ] fork.
										shouldAnnounce := false.
										TestAsserter classForTestResult new ]
									ifFalse: [
										TestAsserter classForTestResult new
											addFailure: (testClass selector: testMethod selector);
											yourself ]].
		testResult updateResultsInHistory.
		
		testSemaphoreForMethod signal.
						
		(aBoolean and: [testResult failures isEmpty not or: [ testResult errors isEmpty not ]])
			ifTrue: [ 
				testClass debug: testMethod selector ].
				
		ClassesIconsCache removeKey: aMethod methodClass ifAbsent: []. 
		UIManager default defer: [ methodWidget vScrollValue: vScroll ]].
	
	aBoolean 
		ifTrue: [ blockToEvaluate forkAt: aPriority. ]
		ifFalse: [ blockToEvaluate value ].
	
	testSemaphoreForMethod wait.
	
	shouldAnnounce
		ifTrue: [| color |
			color := Color gray.
			testMethod hasPassedTest ifTrue: [ color :=  Color green ].
			testMethod hasFailedTest ifTrue: [ color :=  Color yellow ].
			testMethod hasErrorTest ifTrue: [ color :=  Color red ].
			self
				notifyTitle: 'Test Finished' 
				contents: 'Method: ',testMethod methodClass asString, '>>#',testMethod selector asString
				color: color ].
	aBoolean ifFalse: [ testSemaphore signal ]! !

!NautilusUI methodsFor: 'widget category' stamp: ''!
getCategories

	^ categoryWidget getCategories! !

!NautilusUI methodsFor: 'menus behavior' stamp: 'NicolaiHess 8/9/2014 22:00'!
findMethod
	"Search for a method in the lookup of the selected class"

	| foundMethod class |
	self okToChange ifFalse: [^ self flashPackage ].
	
	class := self selectedClass.
	class ifNil: [ ^ self ].
	
	foundMethod := (SearchFacade messageSearchFor: class) chooseFromOwner: self window.
	foundMethod ifNil: [^ self ].
	
	self showGroupsSilently: false.
	self resetCategoriesListSelection .
	self resetMethodsListSelection.
	self categoryWidget selectProtocol: foundMethod category.
 	self model package: self selectedPackage class: self selectedClass category: foundMethod protocol method: foundMethod.
	
	self updateCategoryAndMethodList.
	self changed: #sourceCodeFrom:! !

!NautilusUI methodsFor: 'menus behavior' stamp: 'MarcusDenker 10/8/2014 09:55'!
moveMethodToPackage
	"Search for a package from a pattern or from the recent list"	
	
	| foundPackage  |	
	self okToChange ifFalse: [^ self flashPackage ].
	foundPackage := SearchFacade rPackageSearch chooseFromOwner: self window.
	foundPackage ifNil: [ ^self ].
	self selectedMethods do: [ :each | self moveMethod: each inPackage: foundPackage ].
	self updateCategoryAndMethodList.
		
! !

!NautilusUI methodsFor: 'private' stamp: 'NicolaiHess 7/26/2014 11:53'!
unselectClass
	commentTextArea ifNotNil: [ commentTextArea disable ].
	acceptor := ClassDefinitionAcceptor model: self.
	self resetClassesListSelection.
	self model
		package: self selectedPackage
		class: nil
		category: nil
		method: nil.
	self updateOnClassSelection! !

!NautilusUI methodsFor: 'menus behavior' stamp: 'NicolaiHess 9/7/2014 19:11'!
fullBrowse

	^ self model class 
		openOnPackage: self selectedPackage
		class: self selectedClass
		category: self selectedCategory
		method: self selectedMethod
		group: self selectedGroup
		showGroups: self showGroups
		sortHierarchically: self sortHierarchically
		showHierarchy: self showHierarchy
		showComment: self showComment 
		showInstance: self showInstance 
		showCategories: true
! !

!NautilusUI methodsFor: 'widget method' stamp: ''!
selectedMethods

	^ methodWidget selectedMethods! !

!NautilusUI methodsFor: 'private' stamp: 'EstebanLorenzano 10/14/2013 15:48'!
parentOfClass: aClass
	^ self model parentOfClass: aClass! !

!NautilusUI methodsFor: '*NautilusRefactoring' stamp: ''!
refactor

	^ NautilusRefactoring model: self! !

!NautilusUI methodsFor: 'history behavior' stamp: 'BenjaminVanRyseghem 10/18/2013 17:45'!
currentHistoryIndex

	| index item |
	
	index := 1 min: self getHistoryList size.
	index = 0 ifTrue: [ ^ 0 ].
	
	item := (self getHistoryList at: index) key.
	self selectedClass = item selectedClass ifFalse: [ ^ 0 ].
	
	self selectedMethod ifNil: [ ^ 0 ].
	
	self selectedMethod selector = item selectedMethod
		ifTrue: [ ^ index ]
		ifFalse: [ ^ 0 ]! !

!NautilusUI methodsFor: 'private' stamp: 'StephaneDucasse 3/22/2015 10:15'!
updateOnClassSelection
	| previousMethod |
	previousMethod := self methodWidget selectedMethods ifNotEmpty: [:c | c first ] ifEmpty: [nil].	
		"note that the model of nautilus is not consistent with the widget hence we cannot write selection: self selectedMethod"
		
	self changed: #hierarchyButtonEnabled.
	self setWindowTitle.
	self resetCategoriesListSelection.
	self resetMethodsListSelection.
	"self updateCategoryAndMethodList: previousMethod
		led to 14890 and was reverted"
	self updateCategoryAndMethodList.
	self changed: #isAClassSelected.
	self changed: #getComments.
	self changed: #instanceButtonLabel.
	self changed: #sourceCodeFrom:! !

!NautilusUI methodsFor: 'menu-packages' stamp: 'EstebanLorenzano 2/21/2014 12:42'!
demoteSelectedPackageAsPackageWithTag
	| package |

	package := self selectedPackage item.
	(package name includes: $-) ifFalse: [  ^ self inform: 'Package {1} does not have levels to downgrade.' ].
	
	package demoteToRPackageNamed: (package name copyUpToLast: $-)! !

!NautilusUI methodsFor: 'widget category' stamp: ''!
keyPressedOnElement: anEvent

		^ self methodWidget keyPressedOnElement: anEvent! !

!NautilusUI methodsFor: 'focus' stamp: 'BenjaminVanRyseghem 6/22/2012 18:00'!
giveFocusToMethod

	self giveFocusTo: methodWidget! !

!NautilusUI methodsFor: 'menus behavior' stamp: ''!
fileOutCategories

	self fileOutCategories: self selectedCategories from: self selectedClass! !

!NautilusUI methodsFor: 'private' stamp: ''!
previousButtonState
	^ true! !

!NautilusUI methodsFor: 'source code area' stamp: 'NicolaiHess 8/2/2014 21:54'!
compileAMethodFromCategory: aCategory withSource: aString notifying: aController

	| category selector class scroll method|
	category := aCategory.
	class := self selectedClass ifNil: [ ^ Error signal: 'Should not happen!!' ].
	scroll := sourceTextArea scrollValue y.
	(category = self noMethodsString or: [ category = self allLabel ])
		ifTrue: [ category := self asYetUnclassifiedString ].
	
	"sourceTextArea update: #clearUserEdits."
	selector := self compileANewMethodInClass: class categorized: category from: aString notifyng: aController.
	
	selector ifNil: [ ^ sourceTextArea hasUnacceptedEdits: true ].
	method := (class methodNamed: selector).
	
	sourceTextArea update: #clearUserEdits.
	sourceTextArea vScrollValue: scroll.
	"self selectedCategory: cat."
	"methodsTree setSelectedNodeItem: method."
	( self selectedMethod notNil and: [(self selectedClass = class) and: [ self selectedMethod selector = selector]])
		ifFalse: [
			self selectedMethod: method.
			self updateCategoryAndMethodList.
			sourceTextArea vScrollValue: scroll.]! !

!NautilusUI methodsFor: '*NautilusRefactoring' stamp: 'BenjaminVanRyseghem 4/16/2013 17:35'!
rewriteCode: aText

	acceptor := CodeRewritingAcceptor model: self.
	self sourceCode: aText! !

!NautilusUI methodsFor: 'widget method' stamp: ''!
enableMethodSingleSelection

	^ self selectedMethods size <= 1! !

!NautilusUI methodsFor: '*NautilusRefactoring' stamp: ''!
renameClassWithRefactoringEngine: aClass

	self refactor renameClass: aClass ! !

!NautilusUI methodsFor: 'drag and drop' stamp: 'CD 10/18/2013 17:22'!
move: item from: oldCategory to: newCategory isCopy: isCopy

	| category |
	category := newCategory.
	category = self allLabel
		ifTrue: [ category := self asYetUnclassifiedString ].
	isCopy
		ifFalse: [
			item methodClass organization
				classify: item selector
				under: category 
				suppressIfDefault: true.
			self selectedMethod: item ] ! !

!NautilusUI methodsFor: 'widget class' stamp: 'NicolaiHess 7/26/2014 00:51'!
classWidget

	^ classWidget! !

!NautilusUI methodsFor: 'menus behavior' stamp: 'NicolaiHess 8/2/2014 21:54'!
categorizeMethod

	"Present a choice of categories or prompt for a new category name and add it before the current selection, or at the end if no current selection"
	| aCollection aClass |
	self okToChange ifFalse: [^ self].
	(aCollection := self selectedMethods) ifEmpty: [^ self].
	(aClass := self selectedClass) ifNil: [^self].	

	self categorizeMethods: aCollection of: aClass from: aCollection first category.

	self updateCategoryAndMethodList.! !

!NautilusUI methodsFor: 'widget method' stamp: ''!
selectedMethod

	^ self model selectedMethod ! !

!NautilusUI methodsFor: 'group' stamp: ''!
addProtocolsInGroup

	self selectedCategories ifNotNil: [:ctgrs | self addProtocolsInGroup: ctgrs ].! !

!NautilusUI methodsFor: 'widget method' stamp: 'BenjaminVanRyseghem 4/17/2012 15:05'!
methodWidget

	^ methodWidget! !

!NautilusUI methodsFor: 'widget category' stamp: ''!
categoriesSelection

	^ categoryWidget categoriesSelection! !

!NautilusUI methodsFor: 'menus behavior' stamp: 'NicolaiHess 8/9/2014 23:09'!
removeMethods

	self selectedClass 
		ifNotNil: [:class |
			self selectedMethods
				ifNotEmpty: [:items || scroll needToUpdate |
					scroll := methodWidget vScrollValue.
					needToUpdate := self removeMethods: items inClass: class.
					
					needToUpdate ifTrue: [ 
						self resetMethodsListSelection.
						methodWidget updateMethodList ].
					
					(class methods includes: self selectedMethod)
						ifFalse: [ self selectedMethod: nil ].
						
					self resetMethodsListSelection.
					methodWidget
						updateMethodList;
						vScrollValue: scroll. ]]! !

!NautilusUI methodsFor: 'widget method' stamp: 'BernardoContreras 3/7/2015 21:08'!
signatureFor: aSelector

	^ (aSelector includes: $:)
		ifTrue: [ | col |
			col := aSelector substrings: ':'.
			String streamContents: [:s |
					col doWithIndex: [:e :i |
						i == 1 
							ifTrue: [ s << e << $: << ' anObject ' ]
							ifFalse: [ s << e << $: << ' anObject'<< (i-1) printString << ' ' ]]]]
		ifFalse: [ aSelector ]! !

!NautilusUI methodsFor: '*NautilusRefactoring' stamp: 'NicolaiHess 11/30/2014 22:10'!
searchCode: aText
	acceptor := CodeSearchingAcceptor model: self.
	self setStylerClass: nil.
	self pendingText: aText! !

!NautilusUI methodsFor: 'widget method' stamp: ''!
methodsForCategory: aCategory 
	| methds class env |
	
	class := self selectedClass.
	class ifNil: [ ^ #() ].
	env := self browsedEnvironment.
	methds := env isSystem
		ifTrue: [ self methodsInSystemEnvironmentForCategory: aCategory  in: class ]
		ifFalse: [ self methodsInARestrictedEnvironment: env forCategory: aCategory  in: class ].
	^ methds sort: [:a :b | a selector < b selector ].! !

!NautilusUI methodsFor: 'private' stamp: 'NicolaiHess 8/9/2014 22:03'!
selectedClass: aClass withSelection: aPackage
	self model
		package: aPackage
		class: aClass
		category: nil
		method: nil.
	self resetPackageGroupsListSelection.
	self packageWidget selectPackage: aPackage.
	self updatePackageGroupAndClassList! !

!NautilusUI methodsFor: 'widget method' stamp: 'IgorStasenko 10/13/2013 19:07'!
notifyTitle: title contents: contents

	 GrowlMorph 
		openWithLabel: title
		contents: contents! !

!NautilusUI methodsFor: 'widget method' stamp: ''!
methodsForCategories: aCollection

	^ aCollection gather: [:e | self methodsForCategory: e ]! !

!NautilusUI methodsFor: 'source code area' stamp: 'MarcusDenker 9/27/2013 18:05'!
compileSource: aText notifying: aController

	acceptor accept: aText asString notifying: aController.! !

!NautilusUI methodsFor: 'remove me' stamp: 'NicolaiHess 8/9/2014 23:08'!
incrementMethodsListIndex

	| index |
	self resetMethodsListSelection.
	index := (methodWidget selectedMethodIndex + 1).
	index > methodWidget getMethods size ifTrue: [ index := 1 ].
	methodWidget selectedMethodIndex: index.
	sourceTextArea takeKeyboardFocus ! !

!NautilusUI methodsFor: 'widget category' stamp: ''!
categoriesMenu: aMenu shifted: b

	^ aMenu becomeForward: (self categoryMenuBuilder menu)! !

!NautilusUI methodsFor: 'widget package' stamp: 'NicolaiHess 1/15/2014 11:40'!
selectedPackageIncludes: aClass
^ (self selectedPackage notNil) and:[
	 (self selectedPackage classes includes: aClass ) or:[
		self selectedPackage classes includes: aClass class ].
	]! !

!NautilusUI methodsFor: 'widget category' stamp: 'EstebanLorenzano 2/6/2013 17:01'!
buildCategoryWidget
	| categoriesList |
	
	categoriesList := categoryWidget buildCategoriesList.	
	
	self 
		setShortcuts: #NautilusProtocolShortcuts 
		to: categoriesList. 
	
	^categoriesList! !

!NautilusUI methodsFor: 'selection' stamp: 'NicolaiHess 8/9/2014 21:57'!
resetCategoriesList
	self categoryWidget resetCategoryList! !

!NautilusUI methodsFor: 'widget category' stamp: 'NicolaiHess 8/9/2014 22:02'!
categorySelectionChanged

	self resetMethodsList
	methodWidget updateMethodList.! !

!NautilusUI methodsFor: 'menus behavior' stamp: 'BenjaminVanRyseghem 4/18/2012 18:43'!
implementSelector

	| selection |
	
	selection := sourceTextArea selectedContents asString.
	selection ifEmpty: [ ^ sourceTextArea flash ].
	
	self implementSelector: selection findSelector! !

!NautilusUI methodsFor: 'widget class' stamp: 'NicolaiHess 7/27/2014 13:43'!
buildClassWidget
	| classesList |
	classesList := classWidget buildClassesList.
	self setShortcuts: #NautilusClassShortcuts to: classesList.
	^ classesList! !

!NautilusUI methodsFor: 'widget category' stamp: ''!
categoryWidget

	^ categoryWidget! !

!NautilusUI methodsFor: '*NautilusRefactoring' stamp: 'CamilloBruni 10/7/2012 23:27'!
basicRenameClass: aClass
	" Override to set the class rename with RB by default "

	self renameClassWithRefactoringEngine: aClass! !

!NautilusUI methodsFor: 'history behavior' stamp: ''!
getHistoryList

	^ self model historyEntries reversed! !

!NautilusUI methodsFor: 'history behavior' stamp: 'NicolaiHess 12/30/2013 23:19'!
setHistory: anIndex
	| entry |
	
	anIndex == self currentHistoryIndex ifTrue: [ ^ self ].
	entry := self getHistoryList at: anIndex ifAbsent: [ nil ].
	entry ifNil: [ ^ self ].
	self okToChange ifTrue:[self model adopt: entry.].
	self changed: #currentHistoryIndex.! !

!NautilusUI methodsFor: 'widget method' stamp: ''!
methodsLabel

	^ methodWidget methodsLabel! !

!NautilusUI methodsFor: 'history behavior' stamp: 'CamilloBruni 10/4/2012 11:33'!
previous
	self model hasPrevious 
		ifFalse: [ ^ self ].
	"show the previous item in the history"
	self model previous! !

!NautilusUI methodsFor: 'widget package' stamp: 'NicolaiHess 7/26/2014 22:10'!
packageWidget

	^ packageWidget! !

!NautilusUI methodsFor: 'widget method' stamp: 'IgorStasenko 10/13/2013 18:36'!
notifyTitle: title contents: contents color: aColor

	 GrowlMorph 
		openWithLabel: title
		contents: contents
		backgroundColor: aColor
		labelColor: Color black
				
	! !

!NautilusUI methodsFor: 'widget method' stamp: 'NicolaiHess 8/9/2014 21:09'!
highlightCategory: aMethod

		aMethod 
			ifNotNil: [ | category index |
				category := aMethod protocol.
				category = self selectedCategory
					ifFalse:[ 
						index := self getCategories indexOf: ( category ).
						index > 0 ifTrue: [
							categoryWidget searchedElement: index] ] ]! !

!NautilusUI methodsFor: 'widget category' stamp: 'BenjaminVanRyseghem 4/17/2012 14:59'!
selectedCategory

	^ (self model 
			ifNil: [ ^ nil ]) selectedCategory! !

!NautilusUI methodsFor: 'history behavior' stamp: 'CamilloBruni 10/4/2012 11:19'!
next
	self model hasNext 
		ifFalse: [ ^ self ].
	"show the next item in history"
	self model next! !

!NautilusUI methodsFor: 'remove me' stamp: 'NicolaiHess 8/9/2014 23:08'!
decrementMethodsListIndex

	| index |
	self resetMethodsListSelection.
	index :=(methodWidget selectedMethodIndex - 1).
	index < 1 ifTrue: [ index := methodWidget methodListSize ]. 
	methodWidget selectedMethodIndex: index.
	sourceTextArea takeKeyboardFocus! !

!NautilusUI methodsFor: 'menus behavior' stamp: 'EstebanLorenzano 8/3/2012 15:16'!
removeNonLocalSelector: aSymbol
	| traits isAlias |
	traits := self selectedClassOrMetaClass traitsProvidingSelector: aSymbol.
	isAlias := self selectedClassOrMetaClass isLocalAliasSelector: aSymbol.
	isAlias
		ifTrue: [
			[traits size = 1] assert.
			self selectedClassOrMetaClass removeAlias: aSymbol of: traits first]
		ifFalse: [
			traits do: [:each |
				self selectedClassOrMetaClass addExclusionOf: aSymbol to: each ]]
	! !

!NautilusUI methodsFor: 'events handling' stamp: 'NicolaiHess 7/26/2014 22:12'!
keyStroke: anEvent fromSourceCodeMorph: aMorph
	"Here I received each key stroke in the source code text morph"

	| string |
	(self selectedMethod isNil and: [ self selectedCategory isNil ])
		ifTrue: [
			(sourceTextArea text isEmpty or: [ sourceTextArea text first isLowercase])
				ifTrue: [ self setStylerClass: self selectedClass ]
				ifFalse: [ self setStylerClass: nil ]].

	string := anEvent keyString.

	string = '<Ctrl-Cmd-right>'
		ifTrue: [ ^ self giveFocusTo: packageWidget ].
	
	string = '<Ctrl-Cmd-left>'
		ifTrue: [ ^ self giveFocusTo: methodWidget ].
	
	string =  '<Cmd-Shift-up>'
		ifTrue: [ ^ self decrementMethodsListIndex ].
	
	string =  '<Cmd-Shift-down>'
		ifTrue: [ ^ self incrementMethodsListIndex ].
		
	self aKeyHasBeenPressed: anEvent keyCharacter.
	! !

!NautilusUI methodsFor: 'widget method' stamp: 'NicolaiHess 7/28/2014 22:12'!
generateTestMethodFor: aMethod

	"generate a test method for aMethod and return the generated method"
	| class testMethodName|
	testMethodName := aMethod methodClass name, 'Test'.
	class := self model classes detect: [:e | e name = testMethodName] ifNone: [ self createTestForClass: aMethod methodClass ].
	class
		ifNotNil:[ 
			class compile: (self generateSourceCodeForTestFrom: aMethod) classified: 'tests-',aMethod category.
			^ class >> (self buildTestSelectorFor: aMethod) asSymbol ].
	^ nil! !

!NautilusUI methodsFor: 'updating' stamp: 'StephaneDucasse 2/13/2015 21:34'!
updateCategoryAndMethodList: aMethodOrNil
	self resetCategoriesList.
	categoryWidget updateCategoryList.
	self resetMethodsList.
	methodWidget updateMethodList: aMethodOrNil! !

!NautilusUI methodsFor: 'menus behavior' stamp: 'BenjaminVanRyseghem 5/5/2012 23:53'!
runTestForAMethod: aMethod notifying: aBoolean
	
	self runTestForAMethod: aMethod notifying: aBoolean priority: Processor userBackgroundPriority! !

!NautilusUI methodsFor: 'private' stamp: 'EstebanLorenzano 10/16/2013 13:15'!
isSelectedPackage: package 
	^ package = self selectedPackage.! !

!NautilusUI methodsFor: 'widget method' stamp: 'BenjaminVanRyseghem 4/16/2013 17:11'!
selectedMethod: aMethod 

	self okToChange
		ifTrue: [
			self forceSelectedMethod: aMethod.
			self setWindowTitle.
			self highlightCategory: aMethod.
			aMethod 
				ifNil: [ 
					acceptor := self selectedCategory 
						ifNil: [ ClassOrMethodDefinitionAcceptor model: self ]
						ifNotNil:[ MethodDefinitionAcceptor model: self ]]
				ifNotNil: [ 
					acceptor := MethodDefinitionAcceptor model: self.
					self giveFocusTo: methodWidget ].
			self changed: #sourceCodeFrom:.
			multipleMethodsEditor giveFocusToDefault.
			^ true].
	^false ! !

!NautilusUI methodsFor: 'menu-packages' stamp: 'EstebanLorenzano 2/19/2014 16:33'!
promoteSelectedPackageTagAsPackage
	self selectedPackage item promoteAsRPackage! !

!NautilusUI methodsFor: 'widget method' stamp: 'TorstenBergmann 9/9/2014 15:48'!
enableMethodDualSelection

	^ self selectedMethods size = 2! !

!NautilusUI methodsFor: 'selection' stamp: 'NicolaiHess 8/9/2014 21:46'!
resetCategoriesListSelection

	categoryWidget resetCategorySelection! !

!NautilusUI methodsFor: 'menus behavior' stamp: 'NicolaiHess 8/2/2014 21:53'!
generateTestMethodsAndFocus: aBoolean

	"generate testing methods for the selected methods in the test class"
	"I assume the test class is named #{MyClassName}Test"
	| focus |
	self selectedMethods ifEmpty: [^ self].
	self selectedMethods reverse do: [:method | focus := self generateTestMethodFor: method ].
	focus ifNil: [ ^ self ].
	(aBoolean and: [ self okToChange ])
		ifTrue: [
			self showGroups: false.
			self selectedPackage: (self parentOfClass: focus methodClass).
			self selectedClass: focus methodClass.
			self selectedCategory: 'tests'.
			methodWidget selectMethod: focus.
			self selectedMethod: focus.
			self updatePackageGroupAndClassList ]! !

!NautilusUI methodsFor: 'menus behavior' stamp: 'TorstenBergmann 9/10/2014 10:58'!
compareTwoMethods
	
	(DiffModel new
		showOptions: true;
		leftText: self selectedMethods first sourceCode;
		rightText: self selectedMethods second sourceCode;
		contextClass: self selectedMethods first methodClass;
		openWithSpec) title: 'Compare methods in ', self selectedMethods first methodClass name
	
	! !

!NautilusUI methodsFor: 'widget method' stamp: ''!
generateSourceCodeForTestFrom: aMethod

	^ self buildTestSelectorFor: aMethod.! !

!NautilusUI methodsFor: 'private' stamp: 'BenjaminVanRyseghem 2/8/2013 16:32'!
contentsSelectionFrom: aTextMorph 

	^ (contentSelection notNil and: [ aTextMorph == sourceTextArea  ])
		ifTrue: [ | result |
			result := contentSelection.
			contentSelection := nil.
			result ]
		ifFalse: [ self contentSelectionFor: aTextMorph ]! !

!NautilusUI methodsFor: 'system announcements' stamp: 'NicolaiHess 8/2/2014 21:54'!
methodRecategorized: anAnnouncement
	
	window ifNil: [ ^ self ].
	window isDisplayed ifFalse: [ ^ self ].
	
	((anAnnouncement methodClass = self selectedClass) or: [ anAnnouncement methodClass users includes: self selectedClass  ])
		ifTrue: [self updateCategoryAndMethodList ]! !

!NautilusUI methodsFor: 'category-method methods' stamp: 'BenjaminVanRyseghem 8/3/2012 18:07'!
selectedMethodWithoutAsking: aMethod 

	self okToChange
		ifTrue: [
			self forceSelectedMethod: aMethod.
			self setWindowTitle.
			self highlightCategory: aMethod.
			aMethod ifNotNil: [ self giveFocusTo: methodWidget ].
			self changed: #sourceCodeFrom:.
			^ true].
	^false ! !

!NautilusUI methodsFor: 'widget category' stamp: ''!
elementsMenu: aMenu shifted: b

	^ aMenu becomeForward: (self methodMenuBuilder menu)! !

!NautilusUI methodsFor: 'widget category' stamp: 'NicolaiHess 8/9/2014 22:02'!
selectedCategory: protocol

	self okToChange
		ifTrue: [
			self resetMethodsList.
			self model package: self selectedPackage class: self selectedClass category: protocol method: nil.
			self resetMethodsListSelection.
			protocol 
				ifNil: [ acceptor := ClassOrMethodDefinitionAcceptor model: self ]
				ifNotNil: [ 
					acceptor := MethodDefinitionAcceptor model: self.
					self giveFocusTo: categoryWidget ].
			categoryWidget changed: #selectedCategoryIndex.
			self changed: #sourceCodeFrom:.
			^ true].
	^ false! !

!NautilusUI methodsFor: 'menus behavior' stamp: 'NicolaiHess 8/2/2014 21:54'!
implementSelector: aSelector
	| behavior method category head source |
	
	category := Protocol unclassified.
	behavior := SearchFacade classSearch chooseFromOwner: self window.
	aSelector ifNil: [ ^ sourceTextArea flash ].
	behavior ifNil: [ ^ sourceTextArea flash ].
	
	(behavior includesSelector: aSelector)
		ifFalse: [ 
			head := (self signatureFor: aSelector).
			source := head,'

	^ self shouldBeImplemented'.
			method := behavior compile: source classified: category notifying: sourceTextArea ].

	method := (behavior methodNamed: aSelector).
	self showInstance: true.
	self showGroups: false.

	self model
		package: behavior package 
		class: behavior
		category: category
		method: method.
		
	self updateCategoryAndMethodList.
	self updatePackageGroupAndClassList.
	self changed: #sourceCodeFrom:.
	self giveFocusTo: sourceTextArea.
	head
		ifNotNil: [ sourceTextArea selectFrom: head size + 4 to: source size ].! !

!NautilusUI methodsFor: '*NautilusRefactoring' stamp: ''!
removeClassWithRefactoringEngine: aCollection

	^ self refactor removeClasses: aCollection ! !

!NautilusUI methodsFor: 'menus behavior' stamp: 'NicolaiHess 8/2/2014 21:54'!
addCategory
	"Present a choice of categories or prompt for a new category name and add it before the current selection, or at the end if no current selection"
	| newName |
	
	self okToChange ifFalse: [^ self].
	self selectedClass ifNil: [^ self].

	newName := self 
		addCategoryIn: self selectedClass 
		before: self selectedCategory.
	self resetCategoriesListSelection.
	categoryWidget selectProtocol: newName.
	self selectedCategory: newName.
	newName ifNil: [ ^ self ].
	self 
		updateCategoryAndMethodList;
		giveFocusToSourceCode.! !

!NautilusUI methodsFor: 'accessing' stamp: 'StephaneDucasse 2/13/2015 21:12'!
"protocol: accessing"
selectedClassWithoutChangingSelection: aClass

	self resetCategoriesList.
	self okToChangeSourceAndComment
		ifFalse: [ ^ self ].
	aClass
		ifNil: [ self unselectClass ]
		ifNotNil: [ 
			acceptor := ClassOrMethodDefinitionAcceptor model: self.
			self classWidget selectClass: aClass.
			commentTextArea ifNotNil: [ commentTextArea enable ].
			((self selectedPackageIncludes: aClass theNonMetaClass) or: [ model showHierarchy ])
				ifTrue: [ 
					self model
						package: self selectedPackage
						class: aClass
						category: nil
						method: nil ]
				ifFalse: [ self selectedClass: aClass withSelection: (self parentOfClass: aClass) ].
			self updateOnClassSelection ]! !

!NautilusUI methodsFor: 'selection' stamp: 'NicolaiHess 8/9/2014 21:49'!
resetClassesList
	self classWidget resetClassList! !

!NautilusUI methodsFor: 'widget method' stamp: 'EstebanLorenzano 5/28/2013 14:40'!
allLabel

	^ AllProtocol defaultName! !

!NautilusUI methodsFor: 'focus' stamp: 'BenjaminVanRyseghem 6/22/2012 17:59'!
giveFocusToProtocol

	self giveFocusTo: categoryWidget! !

!NautilusUI methodsFor: 'widget method' stamp: 'BenjaminVanRyseghem 6/22/2012 17:00'!
addMethod
	
	self okToChange ifFalse: [ 
		sourceTextArea flash.
		^ self ].
	sourceTextArea setText: ''.
	self giveFocusTo: sourceTextArea.! !

!NautilusUI methodsFor: 'accessing' stamp: 'NicolaiHess 9/7/2014 18:59'!
selectedClassWithoutChangingSelectionInternally: aClass
	| package packageChanged |
		package := self selectedPackage.
		(self showHierarchy or: [ self showGroups ])
			ifTrue: [ aClass ifNotNil: [ package := aClass package ] ].
		aClass 
			ifNil: [ self resetClassesListSelection ].

		aClass ifNotNil: [ self giveFocusTo: self classWidget ].	
			
		packageChanged := (package ~= self selectedPackage).
		self classWidget selectClass: aClass.
		self model selectedClass: aClass.
		self setWindowTitle.
		
		packageChanged ifTrue: [
			self resetPackageGroupsListSelection.
			self packageWidget selectPackage: package.
			self showGroups
				ifTrue: [ self updateClassView ]
				ifFalse: [ self updatePackageGroupAndClassList ] ].
			
		self resetCategoriesListSelection.
		self resetMethodsListSelection.
		self updateCategoryAndMethodList.
		self changed: #isAClassSelected.
		self changed: #getComments.
		self changed: #sourceCodeFrom:! !

!NautilusUI methodsFor: 'history behavior' stamp: 'CamilloBruni 10/4/2012 10:49'!
historyChanged

	self setWindowTitle.
	self changed: #getHistoryList.
	self changed: #currentHistoryIndex! !

!NautilusUI methodsFor: 'updating' stamp: 'NicolaiHess 8/9/2014 22:03'!
updateCategoryAndMethodList
	self resetCategoriesList.
	categoryWidget updateCategoryList.
	self resetMethodsList.
	methodWidget updateMethodList! !

!NautilusUI methodsFor: 'widget method' stamp: ''!
forceSelectedMethod: aMethod 
	
	self model package: self selectedPackage class: self selectedClass category: self selectedCategory method: aMethod.! !

!NautilusUI methodsFor: 'menus behavior' stamp: 'NicolaiHess 8/2/2014 21:54'!
renameCategory
	"Prompt for a new category name and add it before the
	current selection, or at the end if no current selection"

	| category newName vScroll |
	
	self okToChange ifFalse: [^ self].
	
	category := self selectedCategory.
	vScroll := categoryWidget vScrollValue.
	newName := self renameCategory: category from: self selectedClass.
	newName ifNil: [ ^ self ].
	categoryWidget deselectProtocol: category.
	self selectedCategory: newName.
	categoryWidget selectProtocol: newName.
	self updateCategoryAndMethodList.
	categoryWidget vScrollValue: vScroll! !

!NautilusUI class methodsFor: 'keymapping' stamp: 'CamilloBruni 10/4/2012 11:13'!
buildHistoryShortcutsOn: aBuilder
	<keymap>

	(aBuilder shortcut: #previous)
		category: #NautilusGlobalShortcuts
		default: $[ command 
		do: [:target| target previous ]
		description: 'Go back in the navigation history.'.
		
	(aBuilder shortcut: #next)
		category: #NautilusGlobalShortcuts
		default: $] command 
		do: [:target| target next ]
		description: 'Go forward in the navigation history'.
	! !

!NautilusUI class methodsFor: 'initialize' stamp: 'BenjaminVanRyseghem 4/8/2012 13:11'!
initializeCache
	"self initializeCache"
	| collection instance |
	collection := Smalltalk allClassesAndTraits.
	instance := self new model: Nautilus new.
	
	collection
		do: [:cls | 
			instance classIconFor: cls.
			cls methodDict 
				do: [:m | instance methodWidget methodIconFor: m ]
				displayingProgress: [:m | 'Filing up cache for ', m dragAndDropPrint ]]
		displayingProgress: [:cls | 'Filing up cache for ', cls name ]! !

!NautilusUITest commentStamp: '<historical>'!
A NautilusUITest is a test class for testing the behavior of NautilusUI!
!NautilusUITest methodsFor: 'initialization' stamp: ''!
setUp
	"Setting up code for NautilusUITest"


	nautilusUI := NautilusUI on: Nautilus new.! !

!NautilusUITest methodsFor: 'initialization' stamp: ''!
tearDown
	"Tearing down code for NautilusUITest"


	nautilusUI := nil.! !

!NautilusUITest methodsFor: 'tests' stamp: 'BenjaminVanRyseghem 2/16/2013 14:54'!
testBuildTestSelectorFor

	| method selector |
	method := MorphicEventHandler >> #keyStroke:fromMorph:.
	selector := nautilusUI buildTestSelectorFor: method.
	self assert: selector equals: 'testKeyStrokeFromMorph'! !

!NautilusWindow commentStamp: '<historical>'!
I am a subclass of StandardWindow with my own icon

Maybe I'm useless, but right now I'm not on the top of the to do list!
!NautilusWindow methodsFor: 'about' stamp: 'BenjaminVanRyseghem 8/27/2012 11:05'!
aboutText

	^'Nautilus is a new browser for Pharo Smalltalk based on RPackage and Announcements with fancy goodies:
	- groups
	- multi-selections
	- environments
	- iconic buttons
	- hierarchy
	- pragma based menus
	- KeyMapping shortcuts
	- Ring compliant
	- refactorings support
	- stateless shortcuts
	- multiple source code panel
	- direct feedback (method too long, class uncommented ...)

Made by Benjamin Van Ryseghem and friends'! !

!NautilusWindow methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 1/22/2012 00:08'!
hasFocus

	^ ActiveHand keyboardFocus == self! !

!NautilusWindow methodsFor: 'open/close' stamp: 'BenjaminVanRyseghem 9/14/2012 14:39'!
delete
	
	| mod |
	mod := self model.
	super delete.
	mod 
		ifNotNil: [ mod announce: (WindowClosed new window: self) ]! !

!NautilusWindow methodsFor: 'about' stamp: 'BenjaminVanRyseghem 2/20/2012 16:59'!
aboutTitle

	^'About Nautilus'! !

!NautilusWindow methodsFor: 'open/close' stamp: 'BenjaminVanRyseghem 12/20/2012 12:47'!
initialExtent

	^ 850@600! !

!NavigationHistory commentStamp: '<historical>'!
I act as a web browser history!
!NavigationHistory methodsFor: 'private' stamp: 'BenjaminVanRyseghem 5/24/2011 13:42'!
checkSize
	
	[ storage size >= self maxSize ]
		whileTrue: [ 
			storage removeFirst.
			index := index -1].! !

!NavigationHistory methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 3/13/2012 04:03'!
entries

	^ storage! !

!NavigationHistory methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 4/11/2011 15:09'!
last

	^ storage last! !

!NavigationHistory methodsFor: 'testing' stamp: 'CamilloBruni 10/4/2012 11:17'!
hasNext

	^ index < storage size! !

!NavigationHistory methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/18/2013 17:36'!
removeEntry: anEntry
	| toRemove |
	
	"we know that toRemove will always contains one element"
	toRemove := (storage select: [:e | e key == anEntry ]).
	toRemove ifEmpty: [ ^ self ].
	toRemove := toRemove first.
	storage remove: toRemove.
	storage addLast: toRemove! !

!NavigationHistory methodsFor: 'protocol' stamp: 'SvenVanCaekenberghe 1/9/2014 20:34'!
basicAdd: anEntry
	
	( storage isEmpty not and: [ storage last = anEntry ] ) ifTrue: [ ^ self ].
	anEntry = self current key ifTrue: [ ^ self ].
	self checkSize.
	index := index +1.
	index > storage size
		ifTrue: [ storage addLast:  (anEntry -> DateAndTime now)]
		ifFalse: [ 
			storage := storage copyFrom: 1 to: index.
			storage at: index put: (anEntry -> DateAndTime now)]! !

!NavigationHistory methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 4/11/2011 15:09'!
back

	index := ((index - 1) max: 0)! !

!NavigationHistory methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/12/2011 12:25'!
next

	index := ((index + 1) min: storage size).
	^ storage at: index! !

!NavigationHistory methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/18/2013 18:00'!
removeLastEntry

	self isPaused ifTrue: [ ^ self ].
	storage ifEmpty: [ ^ self ].
	
	storage remove: storage last.	
	index := index -1! !

!NavigationHistory methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/18/2013 17:48'!
addEntry: anEntry
	
	self isPaused ifTrue: [ ^ self ].
	
	self basicAdd: anEntry! !

!NavigationHistory methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 4/14/2011 22:53'!
maxSize: anInteger

	maxSize := anInteger! !

!NavigationHistory methodsFor: 'initialization' stamp: 'CamilloBruni 10/4/2012 11:29'!
initialize

	storage := OrderedCollection new.
	index := 0.
	paused := false.! !

!NavigationHistory methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 5/12/2011 13:01'!
hasPrevious

	^ index > 1! !

!NavigationHistory methodsFor: 'collection compatibility' stamp: 'BenjaminVanRyseghem 3/13/2012 16:13'!
add: anEntry

	self addEntry: anEntry! !

!NavigationHistory methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 4/19/2011 11:05'!
maxSize

	^ maxSize ifNil: [ maxSize := self class defaultMaxSize ].! !

!NavigationHistory methodsFor: 'testing' stamp: 'CamilloBruni 10/4/2012 11:30'!
isPaused
	^ paused! !

!NavigationHistory methodsFor: 'protocol' stamp: 'CamilloBruni 9/20/2013 22:12'!
previous

	index := index-1 max: 1.
	^ storage at: index! !

!NavigationHistory methodsFor: 'protocol' stamp: 'SvenVanCaekenberghe 1/9/2014 20:35'!
replaceCurrentWith: anEntry
	"Change the current history item to the given object"
	storage at: index put: (anEntry -> DateAndTime now)! !

!NavigationHistory methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 4/11/2011 16:11'!
current

	^ storage at: index ifAbsent: [ nil -> nil ]! !

!NavigationHistory methodsFor: 'protocol' stamp: 'CamilloBruni 10/4/2012 11:32'!
pauseDuring: aBlock
	| previousPausedValue |
	"Don't accept any new entries while executing aBlock"
	previousPausedValue := paused.
	paused := true.
	aBlock ensure: [ paused := previousPausedValue ]! !

!NavigationHistory class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/13/2012 16:37'!
defaultMaxSize

	^ 15! !

!NetNameResolver commentStamp: '<historical>'!
This class implements TCP/IP style network name lookup and translation facilities.

Attempt to keep track of whether there is a network available.
HaveNetwork	true if last attempt to contact the network was successful.
LastContact		Time of that contact (totalSeconds).
haveNetwork	returns true, false, or #expired.  True means there was contact in the last 30 minutes.  False means contact failed or was false last time we asked.  Get out of false state by making contact with a server in some way (FileList or updates).!
!NetNameResolver class methodsFor: 'network initialization' stamp: 'ar 2/2/2001 15:09'!
primInitializeNetwork: resolverSemaIndex
	"Initialize the network drivers on platforms that need it, such as the Macintosh, and return nil if network initialization failed or the reciever if it succeeds. Since mobile computers may not always be connected to a network, this method should NOT be called automatically at startup time; rather, it should be called when first starting a networking application. It is a noop if the network driver has already been initialized. If non-zero, resolverSemaIndex is the index of a VM semaphore to be associated with the network name resolver. This semaphore will be signalled when the resolver status changes, such as when a name lookup query is completed."
	"Note: some platforms (e.g., Mac) only allow only one name lookup query at a time, so a manager process should be used to serialize resolver lookup requests."

	<primitive: 'primitiveInitializeNetwork' module: 'SocketPlugin'>
	^ nil  "return nil if primitive fails"
! !

!NetNameResolver class methodsFor: 'primitives' stamp: 'janniklaval 2/10/2011 11:32'!
primGetAddressInfoNext

	<primitive: 'primitiveResolverGetAddressInfoNext' module: 'SocketPlugin'>
	self primitiveFailed! !

!NetNameResolver class methodsFor: 'primitives' stamp: 'janniklaval 2/10/2011 11:33'!
primGetNameInfoServiceSize
 
 	<primitive: 'primitiveResolverGetNameInfoServiceSize' module: 'SocketPlugin'>
 	self primitiveFailed! !

!NetNameResolver class methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primNameLookupResult
	"Return the host address found by the last host name lookup. Returns nil if the last lookup was unsuccessful."

	<primitive: 'primitiveResolverNameLookupResult' module: 'SocketPlugin'>
	self primitiveFailed
! !

!NetNameResolver class methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primStartLookupOfName: hostName
	"Look up the given host name in the Domain Name Server to find its address. This call is asynchronous. To get the results, wait for it to complete or time out and then use primNameLookupResult."

	<primitive: 'primitiveResolverStartNameLookup' module: 'SocketPlugin'>
	self primitiveFailed
! !

!NetNameResolver class methodsFor: 'private' stamp: 'HenrikSperreJohansen 2/16/2012 15:54'!
resolverMutex
	"This must have been initialized by class initialization. 
	If a failure occurs due to mutex not being properly initialized, do NOT solve it by lazy initialization, or you WILLl introduce a race condition"
	^ResolverMutex! !

!NetNameResolver class methodsFor: 'lookups' stamp: 'mir 2/22/2002 15:50'!
localHostAddress
	"Return the local address of this host."
	"NetNameResolver localHostAddress"

	self initializeNetwork.
	^ self primLocalAddress
! !

!NetNameResolver class methodsFor: 'primitives' stamp: 'janniklaval 2/10/2011 11:32'!
primGetAddressInfoResult: socketAddress

	<primitive: 'primitiveResolverGetAddressInfoResult' module: 'SocketPlugin'>
	self primitiveFailed! !

!NetNameResolver class methodsFor: 'lookups' stamp: 'ls 9/5/1998 01:14'!
addressForName: aString
	^self addressForName: aString timeout: 60! !

!NetNameResolver class methodsFor: 'initialization' stamp: 'CamilloBruni 1/14/2013 22:15'!
initialize
	"NetNameResolver initialize"
	"Note: On the Mac, the name resolver is asynchronous (i.e., Squeak can do other things while it is working), but can only handle one request at a time. On other platforms, such as Unix, the resolver is synchronous; a call to, say, the name lookup primitive will block all Squeak processes until it returns."

	"Resolver Status Values"
	ResolverUninitialized := 0.	"network is not initialized"
	ResolverReady := 1.			"resolver idle, last request succeeded"
	ResolverBusy := 2.			"lookup in progress"
	ResolverError := 3.			"resolver idle, last request failed"

	DefaultHostName := ''.
	HaveNetwork := nil.
	ResolverMutex := Mutex new
	
! !

!NetNameResolver class methodsFor: 'network initialization' stamp: 'HenrikSperreJohansen 2/16/2012 15:47'!
initializeNetwork
	"Initialize the network drivers and record the semaphore to be used by the resolver. Do nothing if the network is already initialized.."
	"NetNameResolver initializeNetwork"

	| successful  sema|
	 "network is already initialized"
	(self resolverStatus = ResolverUninitialized)
		ifFalse: [^true].
	"No real message sends allowed in the atomic check, so pre-create a semaphore"
	sema := Semaphore forMutualExclusion.
	"Atomically check if another process is in the progress of initializing network.
	If so, block untill it is done and retry, otherwise start setting it up.
	Not doing so could lead to
	- External semaphore leakage (if we both try to set up simultaneously)
	- Returning an incorrect result (if we return a value independent of whether the other process was successful)"
	HaveNetwork == nil ifTrue: [HaveNetwork := sema].
	"Then, enter critical section where other process has initialized, or we need to do it."
	HaveNetwork critical: [ |semaIndex| 
		"If other process initialized while we were blocked, retry to see if it were successful"
		HaveNetwork ifNil: [^self initializeNetwork].
		"If the network has previously been initialized, but now unavailable, we need to unregister semaphore"
		ResolverSemaphore ifNotNil: [Smalltalk unregisterExternalObject: ResolverSemaphore].
		ResolverSemaphore := Semaphore new.
		semaIndex := Smalltalk registerExternalObject: ResolverSemaphore.
		successful := (self primInitializeNetwork: semaIndex) notNil.
		HaveNetwork := nil.].	
	^successful or: [NoNetworkError signal: 'failed network initialization']
	
! !

!NetNameResolver class methodsFor: 'address string utils' stamp: 'lr 3/13/2010 15:07'!
stringFromAddress: addr
	"Return a string representing the given host address as four decimal bytes delimited with decimal points."
	"NetNameResolver stringFromAddress: NetNameResolver localHostAddress"

	| s |
	s := String new writeStream.
	1 to: 3 do: [ :i | (addr at: i) printOn: s. s nextPut: $.].
	(addr at: 4) printOn: s.
	^ s contents
! !

!NetNameResolver class methodsFor: 'lookups' stamp: 'NouryBouraqadi 10/1/2010 16:08'!
loopBackName
	^'localhost'! !

!NetNameResolver class methodsFor: 'primitives' stamp: 'janniklaval 2/10/2011 11:32'!
primGetAddressInfoSize

	<primitive: 'primitiveResolverGetAddressInfoSize' module: 'SocketPlugin'>
	self primitiveFailed! !

!NetNameResolver class methodsFor: 'primitives' stamp: 'janniklaval 2/10/2011 11:32'!
primGetAddressInfoType

	<primitive: 'primitiveResolverGetAddressInfoType' module: 'SocketPlugin'>
	self primitiveFailed! !

!NetNameResolver class methodsFor: 'primitives' stamp: 'janniklaval 2/10/2011 11:32'!
primGetAddressInfoHost: hostName service: servName flags: flags family: family type: type protocol: protocol

	<primitive: 'primitiveResolverGetAddressInfo' module: 'SocketPlugin'>
	self primitiveFailed! !

!NetNameResolver class methodsFor: 'primitives' stamp: 'janniklaval 2/10/2011 11:33'!
primHostNameResult: aString
 
 	<primitive: 'primitiveResolverHostNameResult' module: 'SocketPlugin'>
 	self primitiveFailed! !

!NetNameResolver class methodsFor: 'private' stamp: 'SvenVanCaekenberghe 11/2/2012 13:24'!
waitForResolverNonBusyUntil: deadline
	"Wait up to the given number of seconds for the resolver to be non busy.
	Return the resolver state."

	| status passed |
	status := self resolverStatus.
	[ status = ResolverBusy and: [ (passed := Time millisecondsSince: deadline key) < deadline value] ]
		whileTrue: [
			"wait for resolver to be available"
			ResolverSemaphore waitTimeoutMSecs: (deadline value - passed).
			status := self resolverStatus ].
	^ status! !

!NetNameResolver class methodsFor: 'primitives' stamp: 'janniklaval 2/10/2011 11:33'!
primGetNameInfoHostSize

 	<primitive: 'primitiveResolverGetNameInfoHostSize' module: 'SocketPlugin'>
 	self primitiveFailed! !

!NetNameResolver class methodsFor: 'lookups' stamp: 'NouryBouraqadi 10/1/2010 16:08'!
loopBackAddress
	^self addressForName: self loopBackName! !

!NetNameResolver class methodsFor: 'address string utils' stamp: 'ClementBera 7/26/2013 16:27'!
addressFromString: addressString 
	"Return the internet address represented by the given string. The string should contain four positive decimal integers delimited by periods, commas, or spaces, where each integer represents one address byte. Return nil if the string is not a host address in an acceptable format."
	"NetNameResolver addressFromString: '1.2.3.4'"
	"NetNameResolver addressFromString: '1,2,3,4'"
	"NetNameResolver addressFromString: '1 2 3 4'"
	| newAddr s byte delimiter |
	newAddr := ByteArray new: 4.
	s := addressString readStream.
	s skipSeparators.
	1 
		to: 4
		do: 
			[ :i | 
			byte := self readDecimalByteFrom: s.
			byte ifNil: [ ^ nil ].
			newAddr 
				at: i
				put: byte.
			i < 4 ifTrue: 
				[ delimiter := s next.
				(delimiter = $. or: [ delimiter = $, or: [ delimiter = $  ] ]) ifFalse: [ ^ nil ] ] ].
	^ newAddr! !

!NetNameResolver class methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primAddressLookupResult
	"Return the host name found by the last host address lookup. Returns nil if the last lookup was unsuccessful."

	<primitive: 'primitiveResolverAddressLookupResult' module: 'SocketPlugin'>
	self primitiveFailed
! !

!NetNameResolver class methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primNameResolverStatus
	"Return an integer reflecting the status of the network name resolver. For a list of possible values, see the comment in the 'initialize' method of this class."

	<primitive: 'primitiveResolverStatus' module: 'SocketPlugin'>
	self primitiveFailed
! !

!NetNameResolver class methodsFor: 'lookups' stamp: 'jm 9/15/97 16:52'!
localAddressString
	"Return a string representing the local host address as four decimal bytes delimited with decimal points."
	"NetNameResolver localAddressString"

	^ NetNameResolver stringFromAddress: NetNameResolver localHostAddress
! !

!NetNameResolver class methodsFor: 'private' stamp: 'lr 3/13/2010 15:07'!
readDecimalByteFrom: aStream
	"Read a positive, decimal integer from the given stream. Stop when a non-digit or end-of-stream is encountered. Return nil if stream is not positioned at a decimal digit or if the integer value read exceeds 255.
JMM - 000503 fixed didn't work correctly"

	| digitSeen value digit |
	digitSeen := false.
	value := 0.
	[aStream atEnd] whileFalse: 
		[digit := aStream next digitValue.
		(digit < 0 or: [digit > 9]) ifTrue: [
			aStream skip: -1.
			(digitSeen not or: [value > 255]) ifTrue: [^ nil].
			^ value].
		digitSeen := true.
		value := (value * 10) + digit].
	(digitSeen not or: [value > 255]) ifTrue: [^ nil].
	^ value
! !

!NetNameResolver class methodsFor: 'lookups' stamp: 'SvenVanCaekenberghe 11/2/2012 13:13'!
nameForAddress: hostAddress timeout: secs
	"Look up the given host address and return its name. Return nil if the lookup fails or is not completed in the given number of seconds. Depends on the given host address being known to the gateway, which may not be the case for dynamically allocated addresses."
	"NetNameResolver
		nameForAddress: (NetNameResolver addressFromString: '128.111.92.2')
		timeout: 30"

	| deadline result |
	self initializeNetwork.
	deadline := Time millisecondClockValue -> (secs * 1000).
	"Protect the execution of this block, as the ResolverSemaphore is used for both parts of the transaction."
	self resolverMutex
		critical: [
			result := (self waitForResolverReadyUntil: deadline)
				ifTrue: [
					self primStartLookupOfAddress: hostAddress.
					(self waitForCompletionUntil: deadline)
						ifTrue: [self primAddressLookupResult]
						ifFalse: [nil]]
				ifFalse: [nil]].
	^result
! !

!NetNameResolver class methodsFor: 'lookups' stamp: 'JMM 5/3/2000 11:25'!
resolverError
	^self primNameResolverError
! !

!NetNameResolver class methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/14/2013 20:01'!
isConnected
	"Dirty, but avoids fixing the plugin bug"

	[ NetNameResolver addressForName: 'www.esug.org' ]
		on: NameLookupFailure
		do: [ :exception | ^ false ].
	^ true! !

!NetNameResolver class methodsFor: 'primitives' stamp: 'janniklaval 2/10/2011 11:32'!
primGetAddressInfoProtocol

	<primitive: 'primitiveResolverGetAddressInfoProtocol' module: 'SocketPlugin'>
	self primitiveFailed! !

!NetNameResolver class methodsFor: 'primitives' stamp: 'janniklaval 2/10/2011 11:34'!
primHostNameSize
 
 	<primitive: 'primitiveResolverHostNameSize' module: 'SocketPlugin'>
 	self primitiveFailed! !

!NetNameResolver class methodsFor: 'primitives' stamp: 'janniklaval 2/10/2011 11:33'!
primGetNameInfoServiceResult: aString
 
 	<primitive: 'primitiveResolverGetNameInfoServiceResult' module: 'SocketPlugin'>
 	self primitiveFailed! !

!NetNameResolver class methodsFor: 'private' stamp: 'SvenVanCaekenberghe 11/2/2012 13:24'!
waitForCompletionUntil: deadline
	"Wait up to the given number of seconds for the resolver to be ready to accept a new request. Return true if the resolver is ready, false if the network is not initialized or the resolver does not become free within the given time period."

	| status |
	status := self waitForResolverNonBusyUntil: deadline.
	status = ResolverReady
		ifTrue: [^ true]
		ifFalse: [
			status = ResolverBusy ifTrue: [self primAbortLookup].
			^ false].
! !

!NetNameResolver class methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primStartLookupOfAddress: hostAddr
	"Look up the given host address in the Domain Name Server to find its name. This call is asynchronous. To get the results, wait for it to complete or time out and then use primAddressLookupResult."

	<primitive: 'primitiveResolverStartAddressLookup' module: 'SocketPlugin'>
	self primitiveFailed
! !

!NetNameResolver class methodsFor: 'lookups' stamp: 'lr 3/13/2010 15:07'!
localHostName
	"Return the local name of this host."
	"NetNameResolver localHostName"

	| hostName |
	hostName := NetNameResolver
		nameForAddress: self localHostAddress
		timeout: 5.
	^hostName
		ifNil: [self localAddressString]
		ifNotNil: [hostName]! !

!NetNameResolver class methodsFor: 'primitives' stamp: 'janniklaval 2/10/2011 11:33'!
primGetNameInfoHostResult: aString
 
 	<primitive: 'primitiveResolverGetNameInfoHostResult' module: 'SocketPlugin'>
 	self primitiveFailed! !

!NetNameResolver class methodsFor: 'lookups' stamp: 'ClementBera 7/26/2013 16:27'!
addressForName: hostName timeout: secs
	"Look up the given host name and return its address. Return nil if the address is not found in the given number of seconds."
	"NetNameResolver addressForName: 'create.ucsb.edu' timeout: 30"
	"NetNameResolver addressForName: '100000jobs.de' timeout: 30"
	"NetNameResolver addressForName: '1.7.6.4' timeout: 30"
	"NetNameResolver addressForName: '' timeout: 30"

	| deadline result |
	self initializeNetwork.
	"check if this is a valid numeric host address (e.g. 1.2.3.4)"
	result := self addressFromString: hostName.
	result ifNotNil: [ ^ result asSocketAddress ].

	"Look up a host name, including ones that start with a digit (e.g. 100000jobs.de or www.pharo-project.org)"
	deadline := Time millisecondClockValue -> (secs * 1000).
	"Protect the execution of this block, as the ResolverSemaphore is used for both parts of the transaction."
	self resolverMutex
		critical: [
			(self waitForResolverReadyUntil: deadline)
				ifTrue: [
					self primStartLookupOfName: hostName.
					(self waitForCompletionUntil: deadline)
						ifTrue: [ result := self primNameLookupResult ]
						ifFalse: [ ^ NameLookupFailure signalFor: hostName ] ]
				ifFalse: [ ^ NameLookupFailure signalFor: hostName ] ].
	^ result asSocketAddress! !

!NetNameResolver class methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primLocalAddress
	"Return the local address of this host."

	<primitive: 'primitiveResolverLocalAddress' module: 'SocketPlugin'>
	self primitiveFailed
! !

!NetNameResolver class methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primNameResolverError
	"Return an integer reflecting the error status of the last network name resolver request. Zero means no error."

	<primitive: 'primitiveResolverError' module: 'SocketPlugin'>
	self primitiveFailed
! !

!NetNameResolver class methodsFor: 'lookups' stamp: 'MarcusDenker 10/9/2013 16:32'!
promptUserForHostAddressDefault: defaultName
	"Ask the user for a host name and return its address. If the default name is the empty string, use the last host name as the default."

	"NetNameResolver promptUserForHostAddressDefault: ''"

	| default hostName serverAddr |
	default := defaultName isEmpty
		ifTrue: [ DefaultHostName ]
		ifFalse: [ defaultName ].
	hostName := UIManager default request: 'Host name or address?' initialAnswer: default.
	hostName isEmptyOrNil
		ifTrue: [ ^ 0 ].
	serverAddr := NetNameResolver addressForName: hostName timeout: 15.
	hostName size > 0
		ifTrue: [ DefaultHostName := hostName ].
	^ serverAddr! !

!NetNameResolver class methodsFor: 'primitives' stamp: 'janniklaval 2/10/2011 11:32'!
primGetAddressInfoFamily

	<primitive: 'primitiveResolverGetAddressInfoFamily' module: 'SocketPlugin'>
	self primitiveFailed! !

!NetNameResolver class methodsFor: 'lookups' stamp: 'JMM 5/3/2000 11:25'!
resolverStatus
	^self primNameResolverStatus
! !

!NetNameResolver class methodsFor: 'private' stamp: 'SvenVanCaekenberghe 11/2/2012 13:24'!
waitForResolverReadyUntil: deadline
	"Wait up to the given number of seconds for the resolver to be ready to accept a new request. Return true if the resolver is not busy, false if the network is not initialized or the resolver does not become free within the given time period."

	| status |
	status := self resolverStatus.
	status = ResolverUninitialized ifTrue: [^ false].
	status := self waitForResolverNonBusyUntil: deadline.
	^ status ~= ResolverBusy
! !

!NetNameResolver class methodsFor: 'lookups' stamp: 'jm 9/17/97 16:26'!
promptUserForHostAddress
	"Ask the user for a host name and return its address."
	"NetNameResolver promptUserForHostAddress"

	^ NetNameResolver promptUserForHostAddressDefault: ''
! !

!NetNameResolver class methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primAbortLookup
	"Abort the current lookup operation, freeing the name resolver for the next query."

	<primitive: 'primitiveResolverAbortLookup' module: 'SocketPlugin'>
	self primitiveFailed
! !

!NetNameResolverTest commentStamp: 'TorstenBergmann 2/5/2014 10:12'!
SUnit tests for NetNameResolver !
!NetNameResolverTest methodsFor: 'accessing' stamp: 'NouryBouraqadi 10/1/2010 16:29'!
localHostNameIsLoopBackName
		^NetNameResolver localHostName = NetNameResolver loopBackName! !

!NetNameResolverTest methodsFor: 'testing' stamp: 'NouryBouraqadi 10/1/2010 16:41'!
testLocalHostAddress
	NetNameResolver isConnected
		ifTrue: [self deny: self localHostAddressIsLoopBackAddress]
		ifFalse: [self assert: self localHostAddressIsLoopBackAddress]! !

!NetNameResolverTest methodsFor: 'testing' stamp: 'NouryBouraqadi 10/1/2010 16:45'!
testLocalHostName
	self deny: NetNameResolver localHostName isNil.
	NetNameResolver isConnected
		ifTrue: [self deny: self localHostNameIsLoopBackName]
		ifFalse: [self assert: self localHostNameIsLoopBackName]! !

!NetNameResolverTest methodsFor: 'accessing' stamp: 'NouryBouraqadi 10/1/2010 16:27'!
localHostAddressIsLoopBackAddress
		^NetNameResolver localHostAddress = NetNameResolver loopBackAddress! !

!NetworkError commentStamp: 'mir 5/12/2003 18:12'!
Abstract super class for all network related exceptions.!
!NetworkSystemSettings commentStamp: '<historical>'!
I am NetworkSystemSettings, a class side API to manage various system network settings, mostly related to HTTP proxying.!
!NetworkSystemSettings class methodsFor: 'settings' stamp: 'SvenVanCaekenberghe 9/6/2012 17:04'!
proxyPassword: aPassword
	"Set the HTTP proxy password. Can be empty or nil to reset"
	
	ProxyPassword := aPassword ifNotNil: [ aPassword base64Encoded ]
! !

!NetworkSystemSettings class methodsFor: 'settings' stamp: 'SvenVanCaekenberghe 9/6/2012 17:03'!
httpProxyPort: aPortNumber
	"Set the HTTP Proxy port to use to aPortNumber, use nil to reset"
	
	aPortNumber = HTTPProxyPort ifTrue: [ ^ self ].
	LastHTTPProxyPort := HTTPProxyPort.
	HTTPProxyPort := aPortNumber
! !

!NetworkSystemSettings class methodsFor: 'settings' stamp: 'SvenVanCaekenberghe 9/6/2012 17:08'!
useHTTPProxy: aBoolean
	"Set whether an HTTP proxy should be used. This is a global switch."

	UseHTTPProxy = aBoolean ifTrue: [ ^ self ].
	UseHTTPProxy := aBoolean.
	self useHTTPProxy
		ifTrue: [
			self httpProxyPort: self lastHTTPProxyPort.
			self httpProxyServer: self lastHTTPProxyServer ]
		ifFalse: [
			self httpProxyPort: nil.
			self httpProxyServer: nil ]! !

!NetworkSystemSettings class methodsFor: 'settings' stamp: 'SvenVanCaekenberghe 9/6/2012 17:14'!
httpProxyServer: aServerName
	"Set the hostname of the HTTP proxy server to use to aServerName.
	Can be nil or empty, when no HTTP proxy should be used."

	aServerName = HTTPProxyServer ifTrue: [ ^ self ].
	LastHTTPProxyServer := HTTPProxyServer.
	HTTPProxyServer := aServerName ifNotNil: [ aServerName trimBoth ]
! !

!NetworkSystemSettings class methodsFor: 'settings' stamp: 'SvenVanCaekenberghe 9/6/2012 17:08'!
useNetworkAuthentification: aBoolean
	"Set whether authentication should be used when accessing the HTTP proxy.
	This is a switch over username/password."

	UseNetworkAuthentification := aBoolean! !

!NetworkSystemSettings class methodsFor: 'settings' stamp: 'SantiagoBragagnolo 9/16/2012 23:51'!
manageHttpProxyExceptions
	^ LastHTTPProxyExceptions ifNil:[ LastHTTPProxyExceptions := ''].
! !

!NetworkSystemSettings class methodsFor: 'settings' stamp: 'SvenVanCaekenberghe 9/6/2012 14:20'!
httpProxyPort  
	"Return the HTTP proxy port to use, an Integer"
	
	^ HTTPProxyPort ifNil: [ HTTPProxyPort := 80 ]! !

!NetworkSystemSettings class methodsFor: 'private' stamp: 'SvenVanCaekenberghe 9/6/2012 14:23'!
lastHTTPProxyPort
	^ LastHTTPProxyPort ifNil: [ LastHTTPProxyPort := HTTPProxyPort ]
! !

!NetworkSystemSettings class methodsFor: 'settings' stamp: 'SvenVanCaekenberghe 9/6/2012 17:04'!
proxyPassword
	"Return the HTTP proxy password to use, if any. Can be empty."

	^ ProxyPassword 
		ifNil: [ '' ]
		ifNotNil: [ ProxyPassword base64Decoded ]! !

!NetworkSystemSettings class methodsFor: 'settings' stamp: 'SantiagoBragagnolo 9/16/2012 23:49'!
manageHttpProxyExceptions: aStringWithExceptions
	self removeAllHttpProxyExceptions.
	aStringWithExceptions	ifNotNil:[
		LastHTTPProxyExceptions := aStringWithExceptions.
		( ';' split: aStringWithExceptions) do: [
			:domain  | 
			self addHttpProxyException: domain
		].
	].! !

!NetworkSystemSettings class methodsFor: 'private' stamp: 'SvenVanCaekenberghe 9/6/2012 14:23'!
lastHTTPProxyServer
	^ LastHTTPProxyServer ifNil: [ LastHTTPProxyServer := HTTPProxyServer ]
! !

!NetworkSystemSettings class methodsFor: 'settings' stamp: 'SvenVanCaekenberghe 9/6/2012 15:25'!
removeHttpProxyException: domainName
	"Remove a (partial, wildcard) domain name from the list of proxy exceptions"

	self httpProxyExceptions remove: domainName ifAbsent: []! !

!NetworkSystemSettings class methodsFor: 'settings' stamp: 'SvenVanCaekenberghe 9/6/2012 17:00'!
httpProxyExceptions
	"Return a list of partial, wildcard domain name strings that define which servers should not be proxied"

	^ HTTPProxyExceptions ifNil: [ HTTPProxyExceptions := OrderedCollection new ]! !

!NetworkSystemSettings class methodsFor: 'settings' stamp: 'SvenVanCaekenberghe 9/6/2012 17:07'!
useNetworkAuthentification
	"Should authentication be used when accessing the HTTP proxy ?
	This is a switch over username/password."

	^ UseNetworkAuthentification ifNil: [ UseNetworkAuthentification := false ]! !

!NetworkSystemSettings class methodsFor: 'settings' stamp: 'SvenVanCaekenberghe 9/6/2012 16:52'!
httpProxyServer
	"Return the hostname of the HTTP proxy server to use, a String.
	Can be empty, when no HTTP proxy should be used."
	
	^ HTTPProxyServer ifNil: [ '' ]! !

!NetworkSystemSettings class methodsFor: 'settings' stamp: 'SvenVanCaekenberghe 9/6/2012 17:06'!
useHTTPProxy
	"Should an HTTP proxy be used ? This is a global switch."

	^ UseHTTPProxy ifNil: [ UseHTTPProxy := false ]! !

!NetworkSystemSettings class methodsFor: 'settings' stamp: 'SvenVanCaekenberghe 9/6/2012 13:45'!
blabEmail: aBlabEmailString
	BlabEmail := aBlabEmailString! !

!NetworkSystemSettings class methodsFor: 'settings' stamp: 'SvenVanCaekenberghe 9/6/2012 13:45'!
blabEmail
	^ BlabEmail ifNil: [ BlabEmail := '' ]! !

!NetworkSystemSettings class methodsFor: 'settings' stamp: 'SantiagoBragagnolo 11/2/2012 15:35'!
isAnExceptionFor: anUrl
	^ HTTPProxyExceptions contains: [ :domain | anUrl host = domain.].! !

!NetworkSystemSettings class methodsFor: 'settings' stamp: 'SvenVanCaekenberghe 9/6/2012 15:10'!
addHttpProxyException: domainName
	"Add a (partial, wildcard) domain name to the list of proxy exceptions"
	"HTTPSocket addProxyException: '*.online.disney.com'."

	self httpProxyExceptions add: domainName! !

!NetworkSystemSettings class methodsFor: 'settings' stamp: 'StephaneDucasse 11/11/2014 18:45'!
networkSettingsOn: aBuilder 
	<systemsettings> 
	(aBuilder group: #network) 
		label: 'Network';
		description: 'All network related settings';
		noOrdering;
		with: [ 
			(aBuilder setting: #useHTTPProxy)      
				label: 'Use HTTP proxy' ;   
				noOrdering;
		 		description: 'If checked then the you will be able to set a port number and a server name. If unchecked, then no http proxy is used.';
				with: [
					(aBuilder setting: #httpProxyPort)
						label: 'Port' ;
						description: 'The HTTP proxy port'.
					(aBuilder setting: #httpProxyServer)
						label: 'Server' ;
						description: 'The HTTP proxy server (i.e. proxy.univ-brest.fr)'.
					(aBuilder setting: #manageHttpProxyExceptions)
						label: 'Exceptions' ;
						target: NetworkSystemSettings;
						description: 'Domains to avoid to proxy (separated by ;)'
				].
			(aBuilder setting: #useNetworkAuthentification) 
				label: 'Proxy authentication' ;
				noOrdering;
		 		description: 'If checked then you will be able to enter a user name and a password for network authentification. Store  HTTP 1.0 basic authentication credentials. Note: this is an ugly hack that stores your password in your image.  It''s just enought to get you going if you use a firewall that requires authentication';
				with: [
					(aBuilder setting: #proxyUser)
						label: 'User name' ;
						description: 'The proxy user name'.
					(aBuilder setting: #proxyPassword)
						type: #Password;
						label: 'Password' ;
						description: 'The user password'].
			(aBuilder setting: #blabEmail)
				label: 'Blab email' ;
				ghostHelp: 'somebody@some.where';
				description: 'Enter blab email of the form ''somebody@some.where''. It can be empty']! !

!NetworkSystemSettings class methodsFor: 'settings' stamp: 'SvenVanCaekenberghe 9/6/2012 17:05'!
proxyUser
	"Return the HTTP proxy user to use, if any. Can be empty."

	^ ProxyUser
		ifNil: [ '' ]
		ifNotNil: [ ProxyUser base64Decoded ]! !

!NetworkSystemSettings class methodsFor: 'settings' stamp: 'SvenVanCaekenberghe 9/6/2012 17:05'!
proxyUser: aUser
	"Set the HTTP proxy user. Can be empty or nil to reset"
	
	ProxyUser := aUser ifNotNil: [ aUser base64Encoded ]

! !

!NetworkSystemSettings class methodsFor: 'settings' stamp: 'GabrielOmarCotelli 11/28/2013 19:23'!
isHttpProxyException: serverName
	"Return true when serverName matches any of our HTTP proxy exceptions, else return false"

	^ self httpProxyExceptions anySatisfy: [ :domainName | domainName match: serverName ]! !

!NetworkSystemSettings class methodsFor: 'settings' stamp: 'SantiagoBragagnolo 9/16/2012 23:51'!
removeAllHttpProxyExceptions
	HTTPProxyExceptions removeAll.! !

!NewArrayNode commentStamp: '<historical>'!
I represent a node for the genPushNewArray: opcode.!
!NewArrayNode methodsFor: 'code generation (closures)' stamp: 'eem 6/16/2008 09:31'!
analyseTempsWithin: scopeBlock "<BlockNode>" rootNode: rootNode "<MethodNode>" assignmentPools: assignmentPools "<Dictionary>"
	"This is a no-op except in TempVariableNode"
	^self! !

!NewArrayNode methodsFor: 'accessing' stamp: 'eem 5/25/2008 14:58'!
numElements
	^numElements! !

!NewArrayNode methodsFor: 'code generation' stamp: 'eem 5/25/2008 14:58'!
sizeCodeForValue: encoder
	^encoder sizePushNewArray: numElements! !

!NewArrayNode methodsFor: 'visiting' stamp: 'eem 9/6/2009 12:35'!
accept: aVisitor
	^aVisitor visitNewArrayNode: self! !

!NewArrayNode methodsFor: 'accessing' stamp: 'eem 5/25/2008 14:59'!
numElements: n
	numElements := n! !

!NewArrayNode methodsFor: 'code generation' stamp: 'eem 5/25/2008 14:58'!
emitCodeForValue: stack encoder: encoder
	encoder genPushNewArray: numElements.
	stack push: 1! !

!NewHandleMorph methodsFor: 'all' stamp: 'ar 8/16/2001 15:48'!
followHand: aHand forEachPointDo: block1 lastPointDo: block2 withCursor: aCursor
	hand := aHand.
	hand showTemporaryCursor: aCursor "hotSpotOffset: aCursor offset negated".
	borderWidth := 0.
	color := Color transparent.
	pointBlock := block1.
	lastPointBlock := block2.
	self position: hand lastEvent cursorPoint - (self extent // 2)! !

!NewHandleMorph methodsFor: 'stepping and presenter' stamp: 'IgorStasenko 1/2/2012 18:06'!
step

	| eventSource |
	eventSource := hand lastEvent.
	eventSource anyButtonPressed
		ifTrue: [waitingForClickInside := false.
				self position: eventSource cursorPoint - (self extent // 2).
				pointBlock value: self center]
		ifFalse: [waitingForClickInside
					ifTrue: [(self containsPoint: eventSource cursorPoint)
								ifFalse: ["mouse wandered out before clicked"
										^ self delete]]
					ifFalse: [lastPointBlock value: self center.
							^ self delete]]! !

!NewHandleMorph methodsFor: 'initialization' stamp: 'marcus.denker 11/19/2008 13:47'!
initialize
	"initialize the state of the receiver"

	super initialize.
	waitingForClickInside := true.
	! !

!NewHandleMorph methodsFor: 'submorphs-add/remove' stamp: 'ar 8/16/2001 15:38'!
delete
	hand ifNotNil:[
		hand showTemporaryCursor: nil.
	].
	super delete.! !

!NewHandleMorph methodsFor: 'all' stamp: 'di 5/18/1998 15:27'!
followHand: aHand forEachPointDo: block1 lastPointDo: block2
	hand := aHand.
	pointBlock := block1.
	lastPointBlock := block2.
	self position: hand lastEvent cursorPoint - (self extent // 2)! !

!NewHandleMorph methodsFor: 'dropping/grabbing' stamp: 'di 4/30/1999 14:06'!
justDroppedInto: aMorph event: anEvent
	"No dropping behavior because stepping will delete me.
	Moreover it needs to be done that way to evaluate lastPointBlock"
! !

!NewHandleMorph methodsFor: 'wiw support' stamp: 'RAA 1/10/2001 10:15'!
morphicLayerNumber

	^1		"handles are very front-like - e.g. the spawn reframe logic actually asks if the first submorph of the world is one of us before deciding to create one"! !

!NewList commentStamp: '<historical>'!
NewList is a new morph as replacement for PluggableListMorph.

The API used is hardcoded, but NewListAdapter has been introduced to hold this "pluggable" behavior!
!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:30'!
drawColor: anObject
	drawColor value: anObject! !

!NewList methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 11/27/2012 01:13'!
rawItemAtIndex: index

	^ self model getRawItemAt: index! !

!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:30'!
selectionWithKeys: anObject
	selectionWithKeys value: anObject! !

!NewList methodsFor: 'looks & colors' stamp: 'BenjaminVanRyseghem 5/1/2013 08:22'!
color: aColor

	self drawColor: aColor! !

!NewList methodsFor: 'protocol - events' stamp: 'BenjaminVanRyseghem 11/24/2012 01:12'!
whenItemsChangedDo: aBlock

	listCache whenChangedDo: aBlock! !

!NewList methodsFor: 'initialization' stamp: 'EstebanLorenzano 5/15/2014 13:33'!
initialize

	renderer := nil asValueHolder.
	super initialize.
	
	lastKeystrokeTime := 0.
	lastKeystrokes := ''.
	
	drawColor := self theme backgroundColor asValueHolder.
	model := nil asValueHolder.
	isInitialized := false asValueHolder.
	isMultipleSelection := false asValueHolder.
	listCache := OrderedCollection new asValueHolder.
	selectedIndex := 0 asValueHolder.
	selectedIndexes := Dictionary new asValueHolder.
	listSize := nil asValueHolder.
	headerHeight := 0 asValueHolder.
	headerTitle := '' asValueHolder.
	clickOnHeader := nil asValueHolder.
	secondSelection := nil asValueHolder.
	displayListCache := OrderedCollection new asValueHolder.
	runningProcesses := Array new asValueHolder.
	deSelectOnReclick := false asValueHolder.
	selectionWithKeys := true asValueHolder.
	selectedItem := nil asValueHolder.
	selectedItems := OrderedCollection new asValueHolder.
	unselectOnChange := false asValueHolder.
	iconCache := Dictionary new asValueHolder.
	iconMaxSize := nil asValueHolder.
	enabled := true asValueHolder.
	allowToSelect := true asValueHolder.! !

!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:30'!
headerTitle: anObject
	headerTitle value: anObject! !

!NewList methodsFor: 'updating - private' stamp: 'BenjaminVanRyseghem 11/29/2012 19:51'!
retrieveSelectedItems

	^ self selectedIndexes collect: [:e | self rawItemAtIndex: e ]! !

!NewList methodsFor: 'updating - private' stamp: 'BenjaminVanRyseghem 11/29/2012 19:51'!
retrieveSelectedItem

	^ self rawItemAtIndex: self selectedIndex! !

!NewList methodsFor: 'events - keyboard' stamp: 'BenjaminVanRyseghem 11/25/2012 00:31'!
handlesKeyStroke: anEvet

	^ true! !

!NewList methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/29/2012 17:50'!
toggleAtIndexes: anIndex
	| bool |

	bool := selectedIndexes at: anIndex ifAbsent: [ false ].
	selectedIndexes at: anIndex put: bool not! !

!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:29'!
isMultipleSelection
	^ isMultipleSelection value! !

!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:28'!
selectedIndex

	^ selectedIndex value! !

!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:29'!
headerHeight
	^ headerHeight value! !

!NewList methodsFor: 'menu' stamp: 'BenjaminVanRyseghem 11/27/2012 01:02'!
getMenu: shiftKeyState
	
	^ self model getMenu: shiftKeyState.! !

!NewList methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 12/13/2012 11:36'!
drawOn: aCanvas

	aCanvas
		fillRectangle: self fullBounds
		color: self drawColor.! !

!NewList methodsFor: 'updating - private' stamp: 'BenjaminVanRyseghem 10/17/2013 16:30'!
updateDisplayListCache

	"self runningProcesses do: [:e | e ifNotNil: [:process | process terminate ]]."
	displayListCache value: (Array new: self listSize).
	self runningProcesses: (Array new: self listSize).! !

!NewList methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/10/2015 18:26'!
drawOnAthensCanvas: anAthensCanvas
	anAthensCanvas setPaint: self drawColor.
	anAthensCanvas drawShape: self fullBounds! !

!NewList methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/25/2012 02:32'!
takesKeyboardFocus
	"Answer whether the receiver can normally take keyboard focus."

	^true! !

!NewList methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 11/26/2012 21:10'!
handlesDoubleClick

	^ self model handlesDoubleClick! !

!NewList methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 5/1/2013 07:59'!
acceptDroppingMorph: aMorph atIndex: index event: evt inMorph: source
	^ self model
		acceptDroppingMorph: aMorph
		atIndex: index
		event: evt
		inMorph: source! !

!NewList methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/25/2012 00:11'!
itemHalfOffSet

	^ 1! !

!NewList methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 1/28/2013 13:27'!
itemAtIndex: index

	^ (displayListCache at: index)
		ifNil: [ | item rawItem icon |
			(runningProcesses at: index) ifNotNil: [:process | 
				process terminate.
				runningProcesses remove: process ].
			rawItem := self rawItemAtIndex: index.
			icon := self iconForItem: rawItem at: index. 
			rawItem := self model getDisplayForItem: rawItem at: index.
			item := rawItem.
			displayListCache at: index put: item.
			item ]! !

!NewList methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 11/26/2012 21:02'!
retrieveHeaderTitle

	^ self model getHeaderTitle! !

!NewList methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:28'!
setIndex: index

	| oldIndex newIndex |

	oldIndex := selectedIndex value.
	newIndex := index.
	self secondSelection: 0.
	self setViewToIndex: index.
	
	selectedIndex value: newIndex.
	(self deSelectOnReclick and: [ oldIndex == newIndex ])
		ifTrue: [ self toggleAtIndexes: newIndex ]
		ifFalse: [ self addAtIndexes: newIndex ]! !

!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:29'!
isInitialized
	^ isInitialized value! !

!NewList methodsFor: 'events - keyboard' stamp: 'BenjaminVanRyseghem 11/29/2012 17:52'!
navigationKey: anEvent

	self isMultipleSelection
		ifTrue: [ | keyString |
			keyString := anEvent keyString.
			keyString = '<Cmd-a>'
				ifTrue: [ 
					self selectAll.
					^ true ].	
			keyString = '<Cmd-i>'
				ifTrue: [ 
					self inverseSelection.
					^ true ].
			keyString = '<Cmd-A>'
				ifTrue: [ 
					self deselectAll.
					^ true ]	].
				
	^ super navigationKey: anEvent! !

!NewList methodsFor: 'updating - private' stamp: 'BenjaminVanRyseghem 10/17/2013 16:30'!
updateHeaderHeight
	self isInitialized ifFalse: [ ^ self ].
	
	headerHeight value: self model getHeaderHeight.! !

!NewList methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 12/17/2012 14:44'!
updateScrollbars

	self setScrollDeltas.
	self scrollBar changed.
	hScrollBar changed.! !

!NewList methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 5/1/2013 10:02'!
retrieveAllowToSelect

	^ self model allowToSelect! !

!NewList methodsFor: 'events - mouse' stamp: 'BenjaminVanRyseghem 12/16/2012 17:07'!
mouseUp: event
	
	| newEvent |
	newEvent := event translatedBy: self topLeft negated .
	
	self renderer mouseUp: newEvent.! !

!NewList methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 10/17/2013 16:28'!
retrieveItems

	^ self model getItems	ifNil: [ selectedItems value ]! !

!NewList methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 10/17/2013 16:31'!
updateListSize

	self isInitialized ifFalse: [ ^ self ].

	listSize value: self retrieveListSize! !

!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/27/2012 01:03'!
runningProcesses
	^ runningProcesses! !

!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:30'!
isInitialized: anObject
	isInitialized value: anObject! !

!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/13/2012 13:37'!
private_selectedIndexes

	^ selectedIndexes! !

!NewList methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/25/2012 01:31'!
setViewToIndex: index

	index isZero ifTrue: [ ^ self ].
	self scrollToShow: (self renderer drawBoundsForIndex: index)! !

!NewList methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 11/5/2013 11:21'!
transferFor: draggedItem from: aMorph

	^ self model transferFor: draggedItem from: aMorph! !

!NewList methodsFor: 'protocol' stamp: 'StephaneDucasse 1/4/2014 22:27'!
cacheAt: index

	^ listCache value at: index ifAbsent: [ nil ]! !

!NewList methodsFor: 'communication with model' stamp: 'ClementBera 5/3/2013 15:08'!
keyStrokeAction: anEvent

	^ self model keyStrokeAction: anEvent! !

!NewList methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 12/13/2012 11:09'!
invalidateIconCacheFor: anItem

	iconCache removeKey: anItem! !

!NewList methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 11/25/2012 01:47'!
isSecondSelectedIndex: anIndex
	
	^ self secondSelection == anIndex! !

!NewList methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 12/16/2012 17:52'!
selectSecondSelection

	 ActiveEvent commandKeyPressed ifFalse: [ selectedIndexes removeAll ].
	self setIndex: self secondSelection! !

!NewList methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/25/2012 01:14'!
scrollToShow: aRectangle
	"scroll to include as much of aRectangle as possible, where aRectangle is in the scroller's local space"
	| range |
	
	((aRectangle top - scroller offset y - self headerHeight) >= 0 and: [
		(aRectangle bottom - scroller offset y) <= (self innerBounds height) ])
		ifTrue: [ "already visible"
			^self ].

	range := self vLeftoverScrollRange.
	scrollBar value: (range > 0
		ifTrue: [((aRectangle top-self headerHeight) / self vLeftoverScrollRange)
							truncateTo: scrollBar scrollDelta]
		ifFalse: [0]).
	scroller offset: -3 @ (range * scrollBar value).! !

!NewList methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:30'!
inverseSelection

	self isMultipleSelection ifFalse: [ ^ self ].
	
	1 to: self listSize do: [: i | self toggleAtIndexes: i ].
	self secondSelection: 0.
	selectedIndex value: self selectedIndexes first.
	self changed.! !

!NewList methodsFor: 'events - mouse' stamp: 'BenjaminVanRyseghem 11/25/2012 02:10'!
mouseDownOnItemAt: index event: anEvent
	
	| item |
	item := self itemAtIndex: index.
	(item respondsTo: #mouseDown:)
		ifTrue: [ item mouseDown: anEvent ]! !

!NewList methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:29'!
adoptIndexes: aDictionary

	selectedIndexes value: aDictionary! !

!NewList methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 12/17/2012 14:57'!
invalidateIconCache

	iconCache removeAll! !

!NewList methodsFor: 'protocol - events' stamp: 'BenjaminVanRyseghem 11/29/2012 19:46'!
whenSelectedItemChangedDo: aBlock

	selectedItem whenChangedDo: aBlock! !

!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:28'!
model

	^ model value! !

!NewList methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 10/17/2013 16:28'!
listSize

	^ listSize value ifNil: [ self retrieveListSize ]! !

!NewList methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/29/2012 19:17'!
hasMultipledSelected
	| int |
	
	int := 0.
	selectedIndexes do: [:ass |
		ass value ifTrue: [ int := int + 1 ].
		int = 2 ifTrue: [ ^ true ]].
	^ false! !

!NewList methodsFor: 'private' stamp: 'BenjaminVanRyseghem 5/1/2013 09:21'!
hasHeader: aBoolean

	self renderer hasHeader: aBoolean! !

!NewList methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/25/2012 00:46'!
numberOfDisplayedItems

	^ (self innerBounds height // self itemHeight) min: self listSize! !

!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:28'!
secondSelection
	^ secondSelection value! !

!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:29'!
deSelectOnReclick
	^ deSelectOnReclick value! !

!NewList methodsFor: 'protocol - events' stamp: 'BenjaminVanRyseghem 11/29/2012 19:34'!
whenSelectedIndexesChangedDo: aBlock

	selectedIndexes whenChangedDo: aBlock! !

!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:30'!
deSelectOnReclick: anObject
	deSelectOnReclick value: anObject! !

!NewList methodsFor: 'events - mouse' stamp: 'BenjaminVanRyseghem 10/17/2013 16:30'!
mouseDownOnHeader: anEvent

	"Just to rise an announcement"
	clickOnHeader value: anEvent! !

!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:29'!
headerTitle
	^ headerTitle value! !

!NewList methodsFor: 'events - keyboard' stamp: 'BenjaminVanRyseghem 11/29/2012 19:10'!
keyStroke: event 
	"Process keys 
	specialKeys are things like up, down, etc. ALWAYS HANDLED 
	modifierKeys are regular characters either 1) accompanied with ctrl, 
	cmd or 2) any character if the list doesn't want to handle basic 
	keys (handlesBasicKeys returns false) 
	basicKeys are any characters"
	| aChar |

	(self scrollByKeyboard: event) ifTrue: [ ^ self ].
	(self navigationKey: event) ifTrue: [ ^ self ].
	
	(self keyStrokeAction: event) ifTrue: [ ^ self ].
	
	aChar := event keyCharacter.
	aChar asciiValue < 32 ifTrue: [^ self specialKeyPressed: event ].
	
	^ self basicKeyPressed: aChar! !

!NewList methodsFor: 'events - keyboard' stamp: 'BenjaminVanRyseghem 11/29/2012 19:14'!
specialKeyPressed: anEvent
	"A special key with the given ascii-value was pressed; dispatch it"
	| keyString max nextSelection oldSelection howManyItemsShowing |
	
	keyString := anEvent keyString.
	keyString = '<escape>'
		ifTrue: [" escape key"
			^ ActiveEvent shiftPressed
				ifTrue: [ ActiveWorld invokeWorldMenuFromEscapeKey ]
				ifFalse: [ (self yellowButtonActivity: false) ifTrue: [ ^ self ]]].

	keyString = '<cr>'
		ifTrue: [ 
			"enter pressed" 
			self selectSecondSelection ].
		
	max := self listSize.
	max > 0 ifFalse: [ ^ self ].
	nextSelection := oldSelection := self selectedIndex.
	
	(keyString = '<down>' or: [ keyString = '<Shift-down>' ])
		ifTrue: [" down arrow"
			"self resetListSelectionSilently."
			nextSelection := oldSelection + 1.
			nextSelection := nextSelection min: max ].
	
	(keyString = '<up>' or: [ keyString = '<Shift-up>' ])
		ifTrue: [ " up arrow"
			"self resetListSelectionSilently."
			oldSelection = 0 
				ifTrue: [ nextSelection := self listSize ]
				ifFalse: [
					nextSelection := oldSelection - 1.
					nextSelection := 1 max: nextSelection ]].
		
	keyString = '<home>'
		ifTrue: [" home"
			"self resetListSelectionSilently."
			nextSelection := 1].
		
	keyString = '<end>' 
		ifTrue: [" end"
			"self resetListSelectionSilently."
			nextSelection := max].
	
	howManyItemsShowing := self numberOfDisplayedItems.
	
	keyString = '<pageUp>'
		ifTrue: 	[" page up"
			"self resetListSelectionSilently."
			nextSelection := 1 max: oldSelection - howManyItemsShowing].
	keyString = '<pageDown>'
		ifTrue: [" page down"
			"self resetListSelectionSilently."
			nextSelection := oldSelection + howManyItemsShowing min: max].

	(self enabled and: [model okToChange]) ifFalse: [ ^ self ].
	
	"No change if model is locked"
	
	oldSelection = nextSelection ifTrue: [ ^ self ].
	((anEvent shiftPressed not and: [ anEvent commandKeyPressed not ]) and: [ self selectionWithKeys ]) ifTrue: [ self resetSelectionIndexes ].
	self setIndex: nextSelection.
	anEvent shiftPressed ifTrue: [ self addAtIndexes: nextSelection ]! !

!NewList methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 12/17/2012 14:57'!
updateIconCache

	self invalidateIconCache! !

!NewList methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 12/13/2012 09:44'!
retrieveIconMaxSize

	^ self model iconMaxSize
		ifNil: [ 0@0 ]! !

!NewList methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 6/21/2013 00:07'!
separatorAfter: item at: index

	^ self model separatorAfter: item at: index! !

!NewList methodsFor: 'accessing' stamp: 'CamilloBruni 11/8/2013 16:36'!
allowToSelect

	^ allowToSelect value! !

!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:30'!
renderer: anObject
	renderer value: anObject! !

!NewList methodsFor: 'protocol - events' stamp: 'BenjaminVanRyseghem 11/29/2012 19:46'!
whenSelectedItemsChangedDo: aBlock

	selectedItems whenChangedDo: aBlock! !

!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:30'!
unselectOnChange: anObject
	unselectOnChange value: anObject! !

!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:30'!
headerHeight: anObject
	headerHeight value: anObject! !

!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:28'!
selectionWithKeys
	^ selectionWithKeys value! !

!NewList methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/29/2012 17:50'!
addAtIndexes: anIndex
	
	selectedIndexes at: anIndex put: true! !

!NewList methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 12/16/2012 17:49'!
resetListSelectionSilently
	
	selectedIndexes removeAll! !

!NewList methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 11/26/2012 18:54'!
adapter

	^ self model! !

!NewList methodsFor: 'looks & colors' stamp: 'EstebanLorenzano 4/30/2014 15:28'!
defaultItemColor
	^ self theme textColor! !

!NewList methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 1/28/2013 13:20'!
on: eventName send: selector to: recipient

	renderer on: eventName send: selector to: recipient! !

!NewList methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 10/17/2013 16:31'!
updateHeaderTitle

	self isInitialized ifFalse: [ ^ self ].

	headerTitle value: self retrieveHeaderTitle.! !

!NewList methodsFor: 'events - keyboard' stamp: 'MarcusDenker 10/16/2013 18:01'!
basicKeyPressed: aChar 
	| nextSelection milliSeconds slowKeyStroke oldSelection |
	
	nextSelection := oldSelection := self selectedIndex.
	milliSeconds := Time millisecondClockValue.
	slowKeyStroke := milliSeconds - lastKeystrokeTime > 500.
	lastKeystrokeTime := milliSeconds.
	
	aChar = Character space
		ifTrue: [ 
			self clickOnSelectedItem.
			^ self secondSelection: 0 ].
	
	self ensureFullDisplayListCache.
		
	slowKeyStroke
		ifTrue: ["forget previous keystrokes and search in following elements"
			lastKeystrokes := aChar asLowercase asString.]
		ifFalse: ["append quick keystrokes but don't move selection if it still matches"
			lastKeystrokes :=String streamContents: [:s | s << lastKeystrokes << aChar asLowercase asString ]].
	"Get rid of blanks and style used in some lists"
	nextSelection := displayListCache findFirst: [:a | a 
												ifNil: [ false "in case it's not loaded yet" ]
												ifNotNil: [:e | e beginsWith: lastKeystrokes fromList: self ]].
	nextSelection isZero ifTrue: [ ^ self secondSelection: 0 ].
	
	"No change if model is locked"
	model okToChange ifFalse: [ ^ self ].	"No change if model is locked"

	"The following line is a workaround around the behaviour of OBColumn>>selection:,
	 which deselects when called twice with the same argument."
	oldSelection = nextSelection ifTrue: [ ^ self ].
	
	self secondSelection: nextSelection. ! !

!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:29'!
drawColor
	^ drawColor value! !

!NewList methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/29/2012 16:29'!
resetSelectionIndexes

	selectedIndexes removeAll! !

!NewList methodsFor: 'initialize' stamp: 'BenjaminVanRyseghem 10/17/2013 16:30'!
endOfInitialization

	isInitialized value: true.

	self updateItems.
	self updateDisplayListCache.
	self updateListSize.
	self updateHeaderTitle.
	self updateHeaderHeight.
	self updateAllowToSelect.
	
	self updateRenderer.
	
	selectedItem value: self retrieveSelectedItem.
	selectedItems value: self retrieveSelectedItems.
	
	listCache whenChangedDo: [:e |
			listSize value: e size.
			self updateDisplayListCache.
			self unselectOnChange
				ifTrue: [ self deselectAll ].
			self updateScrollbars ].
	listSize whenChangedDo: [:e | self updateRenderer ].
	headerTitle whenChangedDo:[:e | self updateHeaderHeight ].
	secondSelection whenChangedDo: [:idx | 
		self setViewToIndex: idx. 
		self renderer updateRectFor: idx ].
	selectedIndex whenChangedDo: [:newIndex :oldIndex | 
		selectedItem value: self retrieveSelectedItem.
		self renderer updateRectFor: oldIndex. ].
	selectedIndexes whenChangedDo: [:newIndex :oldIndex | selectedItems value: self retrieveSelectedItems ].
	headerTitle whenChangedDo: [:t | self renderer invalidHeader ].! !

!NewList methodsFor: 'looks & colors' stamp: 'BenjaminVanRyseghem 11/23/2012 16:05'!
font

	^ self theme listFont! !

!NewList methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:43'!
selectAll

	self isMultipleSelection ifFalse: [ ^ self ].
	
	1 to: self listSize do: [: i | selectedIndexes value at: i put: true ].
	selectedIndexes valueChanged.
	self secondSelection: 0.
	selectedIndex value: self listSize.
	self changed.! !

!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:28'!
model: anObject
	
	model value ifNotNil: [:m | m removeDependent: self ].
	anObject ifNotNil: [anObject addDependent: self ].

	model value: anObject! !

!NewList methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 10/17/2013 16:31'!
updateIconMaxSize

	iconMaxSize value: self retrieveIconMaxSize! !

!NewList methodsFor: 'layout' stamp: 'BenjaminVanRyseghem 12/17/2012 14:10'!
privateFullBounds
	^  self bounds! !

!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:28'!
renderer
	^ renderer value! !

!NewList methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/25/2012 02:21'!
clickOnSelectedItem
	| item |

	item := self itemAtIndex: self selectedIndex.
	(item respondsTo: #click:)
		ifTrue: [ item click: MouseEvent new ]! !

!NewList methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 5/1/2013 08:53'!
wantsDroppedMorph: aMorph event: anEvent inMorph: source
	self dropEnabled
		ifFalse: [ ^ false ].
	^ self model wantsDroppedMorph: aMorph event: anEvent inMorph: source! !

!NewList methodsFor: 'updating - private' stamp: 'BenjaminVanRyseghem 10/17/2013 16:31'!
updateRenderer

	| morph |
	self flag: 'Can we keep the same instead of removing it ?'.

	self scroller removeAllMorphs.
	morph := NewListRenderer on: self.
	morph
		color: self color;
		width: self scroller width" +10";
		hasHeader: self hasHeader;
		height: (self listSize*self itemHeight+self headerHeight).
				
	self scroller addMorph: morph.
	renderer value: morph.! !

!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:30'!
listSize: anObject
	listSize value: anObject! !

!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:30'!
isMultipleSelection: anObject
	isMultipleSelection value: anObject! !

!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:28'!
unselectOnChange
	^ unselectOnChange value! !

!NewList methodsFor: 'looks & colors' stamp: 'EstebanLorenzano 4/29/2014 16:47'!
selectedBackgroundColor

	^ self theme selectionColor! !

!NewList methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/13/2012 09:46'!
itemHeight

	^ (self font height max: self iconMaxSize y) + (2*self itemHalfOffSet)! !

!NewList methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 12/16/2012 17:19'!
retrieveListSize
	
	^ self model getListSize ifNil:  [ listCache size ]! !

!NewList methodsFor: 'events - mouse' stamp: 'BenjaminVanRyseghem 12/13/2012 14:40'!
mouseUpOnItemAt: index event: anEvent
	
	| item |
	index isZero ifTrue: [ ^ self ].
	index > self listSize ifTrue: [ ^ self ].
	item := self itemAtIndex: index.
	(item respondsTo: #mouseDown:)
		ifTrue: [ item mouseDown: anEvent ]! !

!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:29'!
enabled: aBoolean
	"Set the value of enabled"

	enabled value = aBoolean ifTrue: [^self].
	enabled value: aBoolean.
	self changed: #enabled.
	self
		adoptPaneColor: self paneColor;
		changed! !

!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/29/2012 19:55'!
selectedIndexes

	^ (selectedIndexes select: [:ass | ass value ]) keys sort! !

!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:30'!
secondSelection: anObject
	secondSelection value: anObject! !

!NewList methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 10/17/2013 16:30'!
updateAllowToSelect

	allowToSelect value: self retrieveAllowToSelect! !

!NewList methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 11/29/2012 16:30'!
isSelectedIndex: index

	^ self isMultipleSelection
 		ifTrue: [ selectedIndexes at: index ifAbsent: [ ^false ]]
		ifFalse: [ self selectedIndex = index ]! !

!NewList methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/17/2013 16:30'!
deselectAll

	selectedIndex value: 0.

	self isMultipleSelection 
		ifTrue: [
			selectedIndexes removeAll.
			self secondSelection: 0 ].
			
	self changed.! !

!NewList methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 10/17/2013 16:31'!
updateItems

	self isInitialized ifFalse: [ ^ self ].

	listCache value: self retrieveItems! !

!NewList methodsFor: 'geometry' stamp: 'BenjaminVanRyseghem 11/24/2012 01:32'!
extent: newExtent
	super extent: newExtent.
	
	"Change listMorph's bounds to the new width. It is either the size
	of the widest list item, or the size of self, whatever is bigger"
	self renderer ifNil: [ ^ self  ].
	self renderer width: ((self width-40) max: (self renderer maxWidth))! !

!NewList methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 7/18/2013 14:25'!
update: aParameter

	aParameter == #getItems 					ifTrue: [ ^ self updateItems ].
	aParameter == #getListSize 				ifTrue: [ ^ self updateListSize ].
	aParameter == #getHeaderTitle 			ifTrue: [ ^ self updateHeaderTitle ].
	aParameter == #iconMaxSize 				ifTrue: [ ^ self updateIconMaxSize ].
	aParameter == #iconForItem:at: 			ifTrue: [ ^ self updateIconCache ].
	aParameter == #resetSelectedIndexes 	ifTrue: [ ^ self deselectAll ].
	aParameter == #allowToSelect			ifTrue: [ ^ self updateAllowToSelect ].
	aParameter == #invalidateIcons 			ifTrue: [ ^ self invalidateIconCache ].
				
	aParameter isArray ifFalse: [ ^ self ].
	aParameter size == 2 ifFalse: [ ^ self ].
	
	aParameter first = #deSelectOnReclick: ifTrue: [ self deSelectOnReclick: aParameter second ].
	aParameter first = #isMultipleSelection: ifTrue: [ self isMultipleSelection: aParameter second ].
	aParameter first = #unselectOnChange: ifTrue: [ self unselectOnChange: aParameter second ].
	aParameter first = #hasHeader: ifTrue: [ self hasHeader: aParameter second ].
	aParameter first = #setIndex: ifTrue: [ self setIndex: aParameter second ].! !

!NewList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:30'!
runningProcesses: aCollection
	runningProcesses value: aCollection! !

!NewList methodsFor: 'protocol - events' stamp: 'BenjaminVanRyseghem 11/24/2012 19:07'!
whenHeaderIsClickedDo: aBlock

	clickOnHeader whenChangedDo: aBlock! !

!NewList methodsFor: 'looks & colors' stamp: 'EstebanLorenzano 4/29/2014 14:43'!
colorForItem: item at: index

	^ (self isSelectedIndex: index)
		ifTrue: [ self theme selectionTextColor ]
		ifFalse: [ self defaultItemColor ]! !

!NewList methodsFor: 'icons' stamp: 'BenjaminVanRyseghem 10/17/2013 16:29'!
iconMaxSize

	^ iconMaxSize value ifNil: [ 
		iconMaxSize value: self retrieveIconMaxSize ]! !

!NewList methodsFor: 'looks & colors' stamp: 'EstebanLorenzano 4/30/2014 15:28'!
secondSelectionColor

	^ self theme secondarySelectionColor! !

!NewList methodsFor: 'icons' stamp: 'BenjaminVanRyseghem 1/26/2013 01:53'!
iconForItem: anItem at: anIndex

	^ iconCache 
		at: anItem
		ifAbsentPut: [ (self model iconForItem: anItem at: anIndex) asMorph ]! !

!NewList methodsFor: 'private' stamp: 'BenjaminVanRyseghem 10/17/2013 16:29'!
hasHeader

	^ headerHeight value ~~ 0! !

!NewList methodsFor: 'updating - private' stamp: 'BenjaminVanRyseghem 11/27/2012 01:33'!
ensureFullDisplayListCache

	[ listCache doWithIndex: [:e :i || process |
		process := [ | item |
			item := self model getDisplayForItem: e at: i.
			(displayListCache at: i) ifNil: [
			displayListCache at: i put: item ]] fork.
		
		runningProcesses at: i put: process ]] fork. ! !

!NewList methodsFor: 'events - mouse' stamp: 'BenjaminVanRyseghem 5/1/2013 08:42'!
doubleClick: event

	self model doubleClick: event! !

!NewList methodsFor: 'protocol - events' stamp: 'BenjaminVanRyseghem 11/26/2012 18:47'!
whenSelectedIndexChangedDo: aBlock

	selectedIndex whenChangedDo: aBlock! !

!NewList class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 11/26/2012 18:38'!
adapterOn: aModel

	^ NewListAdapter on: aModel! !

!NewList class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 11/26/2012 18:35'!
on: aListModel

	^ self new
		model: aListModel;
		yourself! !

!NewList class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 11/26/2012 18:51'!
on: aModel getItemsSelector: getItems setIndexSelector: setIndex getDisplaySelector: getDisplay
	
	| listModel instance |
	listModel := self adapterOn: aModel.
	
	listModel
		on: aModel 
		getItemsSelector: getItems 
		setIndexSelector: setIndex 
		getDisplaySelector: getDisplay.
	
	instance := self on: listModel.
	listModel list: instance.
	
	^ instance! !

!NewList class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 12/13/2012 12:25'!
on: aModel getItemsSelector: getItems getDisplaySelector: getDisplay
	
	| listModel instance |
	listModel := self adapterOn: aModel.
	
	listModel
		on: aModel 
		getItemsSelector: getItems
		getDisplaySelector: getDisplay.
	
	instance := self on: listModel.
	listModel list: instance.
	
	^ instance! !

!NewListAdapter commentStamp: '<historical>'!
NewListAdapter is used to link the model and the list.

It holds the "pluggable" part of the widget, aka the definition of the API!
!NewListAdapter methodsFor: 'list protocol' stamp: 'BenjaminVanRyseghem 11/26/2012 20:28'!
deSelectOnReclick: aBoolean

	self list deSelectOnReclick: aBoolean! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:35'!
getItemsSelector: anObject
	getItemsSelector value: anObject! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:34'!
getListSizeSelector

	^ getListSizeSelector value! !

!NewListAdapter methodsFor: 'list protocol' stamp: 'BenjaminVanRyseghem 11/26/2012 20:27'!
dragEnabled: aBoolean

	self list dragEnabled: aBoolean! !

!NewListAdapter methodsFor: 'list protocol' stamp: 'BenjaminVanRyseghem 11/26/2012 20:28'!
dropEnabled: aBoolean

	self list dropEnabled: aBoolean! !

!NewListAdapter methodsFor: 'list protocol' stamp: 'StephaneDucasse 1/4/2014 22:46'!
separatorAfter: item at: index
	"returns whether there should be a separator after an item displayed at a given index."
	
	^ separatorSelector value
		ifNotNil: [ self model perform: separatorSelector with: item with: index ]
		ifNil: [ false ]! !

!NewListAdapter methodsFor: 'list protocol' stamp: 'BenjaminVanRyseghem 5/1/2013 08:45'!
color: aColor

	self list color: aColor! !

!NewListAdapter methodsFor: 'list protocol' stamp: 'BenjaminVanRyseghem 11/26/2012 20:55'!
getDisplayForItem: item at: index

	^ self getDisplaySelector 
			ifNil: [ item printString ]
			ifNotNil: [ :s | self model perform: s withEnoughArguments: {item. index} ]! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:33'!
getDisplaySelector

	^ getDisplaySelector value! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:35'!
getIndexSelector: anObject
	getIndexSelector value: anObject! !

!NewListAdapter methodsFor: 'list protocol' stamp: 'BenjaminVanRyseghem 11/26/2012 21:26'!
getRawItemAt: index

	^ self getItemAtIndexSelector
		ifNil: [ self list cacheAt: index ]
		ifNotNil: [:selector | self model perform: selector with: index ]! !

!NewListAdapter methodsFor: 'initialize' stamp: 'BenjaminVanRyseghem 1/24/2014 16:07'!
initialize
	"Initialization code for NewListAdapter"

	super initialize.

	doubleClickSelector := nil asValueHolder.
	dragItemSelector := nil asValueHolder.
	dropItemSelector := nil asValueHolder.
	getDisplaySelector := nil asValueHolder.
	getHeaderTitleSelector := nil asValueHolder.
	getMenuSelector := nil asValueHolder.
	getIndexSelector := nil asValueHolder.
	getItemAtIndexSelector := nil asValueHolder.
	getItemsSelector := nil asValueHolder.
	getListSizeSelector := nil asValueHolder.
	keyStrokeSelector := nil asValueHolder.
	lastKeystrokeTime := nil asValueHolder.
	lastKeystrokes := nil asValueHolder.
	model := nil asValueHolder.
	list := nil asValueHolder.
	setIndexSelector := nil asValueHolder.
	wantsDropSelector := nil asValueHolder.
	getMenuTitleSelector := nil asValueHolder.
	getIconSelector := nil asValueHolder.
	getIconMaxSizeSelector := nil asValueHolder.
	getIndexesSelector := nil asValueHolder.
	separatorSelector := nil asValueHolder! !

!NewListAdapter methodsFor: 'list protocol' stamp: 'BenjaminVanRyseghem 5/1/2013 09:52'!
allowToSelect

	^ self allowToSelectSelector
		ifNil: [ true ]
		ifNotNil: [ :s | self model perform: s ]! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:34'!
value! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:33'!
dragItemSelector
	^ dragItemSelector value! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:35'!
keyStrokeSelector: anObject
	keyStrokeSelector value: anObject! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:34'!
list
	^ list value! !

!NewListAdapter methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 12/16/2012 20:09'!
setIndexFromModel

	| index |
	index := self getIndexSelector 
				ifNil: [ ^ self ]
				ifNotNil: [:s | self model perform: s ].
			
	self list setIndex: index.! !

!NewListAdapter methodsFor: 'list protocol' stamp: 'BenjaminVanRyseghem 11/29/2012 20:06'!
unselectOnChange: aBoolean

	self list unselectOnChange: aBoolean! !

!NewListAdapter methodsFor: 'list protocol' stamp: 'MarcusDenker 10/16/2013 18:02'!
getMenu: shiftKeyState
	"Answer the menu for this text view, supplying an empty menu to be filled in. If the menu selector takes an extra argument, pass in the current state of the shift key."

	| menu aMenu aTitle |
	self getMenuSelector isNil
		ifTrue: [ ^ nil ].
	menu := UIManager default newMenuIn: self for: self model.
	aTitle := self getMenuTitleSelector ifNotNil: [ self model perform: self getMenuTitleSelector ].
	self getMenuSelector numArgs = 1
		ifTrue: [ 
			aMenu := self model perform: self getMenuSelector with: menu.
			aTitle ifNotNil: [ aMenu addTitle: aTitle ].
			^ aMenu ].
	self getMenuSelector numArgs = 2
		ifTrue: [ 
			aMenu := self model perform: self getMenuSelector with: menu with: shiftKeyState.
			aTitle ifNotNil: [ aMenu addTitle: aTitle ].
			^ aMenu ].
	^ self error: 'The getMenuSelector must be a 1- or 2-keyword symbol'! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:35'!
getMenuTitleSelector: anObject
	getMenuTitleSelector value: anObject! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:35'!
getMenuSelector: aSelector

	getMenuSelector value: aSelector! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:35'!
getIconMaxSizeSelector: anObject
	getIconMaxSizeSelector value: anObject! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:34'!
getHeaderTitleSelector: anObject
	getHeaderTitleSelector value: anObject! !

!NewListAdapter methodsFor: 'list protocol' stamp: 'BenjaminVanRyseghem 11/26/2012 21:10'!
handlesDoubleClick

	^ self doubleClickSelector notNil! !

!NewListAdapter methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 11/26/2012 18:54'!
on: aModel getItemsSelector: getItems setIndexSelector: setIndex getDisplaySelector: getDisplay

	^ self
		model: aModel;
		getItemsSelector: getItems;
		setIndexSelector: setIndex;
		getDisplaySelector: getDisplay;
		yourself! !

!NewListAdapter methodsFor: 'list protocol' stamp: 'BenjaminVanRyseghem 5/1/2013 08:00'!
acceptDroppingMorph: aMorph atIndex: index event: evt inMorph: source

	self dropItemSelector 
		ifNotNil: [| item |
			item := aMorph passenger first.
			self model perform: self dropItemSelector with: item with: index ]
		ifNil: [ 
			self model
				acceptDroppingMorph: aMorph
				event: evt
				inMorph: source ]! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:34'!
doubleClickSelector: anObject
	doubleClickSelector value: anObject! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:34'!
getItemsSelector
	^ getItemsSelector value! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:33'!
getIndexSelector
	^ getIndexSelector value! !

!NewListAdapter methodsFor: 'initialize' stamp: 'BenjaminVanRyseghem 10/17/2013 16:33'!
endOfInitialization

	getItemsSelector whenChangedDo: [:e | self list updateItems ].
	setIndexSelector value ifNotNil: [:s |
		self list whenSelectedIndexChangedDo: [:a :b :c :d | 
			self model perform: s withEnoughArguments: {a. b. c. d } ]].

	getHeaderTitleSelector whenChangedDo: [:s | self list hasHeader: (s notNil) ].
	self list endOfInitialization! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:35'!
getItemAtIndexSelector: aSelector

	getItemAtIndexSelector value: aSelector! !

!NewListAdapter methodsFor: 'list protocol' stamp: 'BenjaminVanRyseghem 11/26/2012 21:05'!
getHeaderHeight

	self flag: '25 should not be hardcoded'.
	 ^ self getHeaderTitleSelector 
		ifNil: [ 0 ]
		ifNotNil: [:s | 25 ]! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:34'!
model: anObject
	
	model value ifNotNil: [:m | m removeDependent: self ].
	anObject ifNotNil: [anObject addDependent: self ].

	model value: anObject! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:33'!
dropItemSelector
	^ dropItemSelector value! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:34'!
wantsDropSelector
	^ wantsDropSelector value! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:34'!
getItemAtIndexSelector

	^ getItemAtIndexSelector value! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:34'!
getMenuTitleSelector
	
	^ getMenuTitleSelector value! !

!NewListAdapter methodsFor: 'accessing' stamp: 'StephaneDucasse 1/4/2014 22:51'!
separatorSelector
	"return selector to be executed to get the separator between two list items."
	^ separatorSelector value! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:33'!
getIconMaxSizeSelector

	^ getIconMaxSizeSelector value! !

!NewListAdapter methodsFor: 'list protocol' stamp: 'BenjaminVanRyseghem 5/1/2013 08:53'!
wantsDroppedMorph: aMorph event: anEvent inMorph: source

	^ aMorph dragTransferType == #dragTransfer 
		ifTrue: [ 
			self dropItemSelector ifNil: [ ^ false ].
			self wantsDropSelector ifNil: [ ^ true ].
			(self model perform: self wantsDropSelector with: aMorph passenger) ]
		ifFalse: [ self model wantsDroppedMorph: aMorph event: anEvent inMorph: source ]! !

!NewListAdapter methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 11/5/2013 11:21'!
transferFor: draggedItem from: aMorph

	^ self model transferFor: draggedItem from: aMorph! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:35'!
separatorSelector: anObject
	separatorSelector value: anObject! !

!NewListAdapter methodsFor: 'list protocol' stamp: 'BenjaminVanRyseghem 11/26/2012 21:03'!
getHeaderTitle

	 ^ self getHeaderTitleSelector 
		ifNil: [ '' ]
		ifNotNil: [:s | self model perform: s ]! !

!NewListAdapter methodsFor: 'list protocol' stamp: 'BenjaminVanRyseghem 11/29/2012 16:42'!
isMultipleSelection: aBoolean

	self list isMultipleSelection: aBoolean! !

!NewListAdapter methodsFor: 'list protocol' stamp: 'BenjaminVanRyseghem 1/28/2013 13:33'!
keyStrokeAction: anEvent

	^ self keyStrokeSelector 
		ifNil: [ false ]
		ifNotNil: [:s | (self model perform: s withEnoughArguments: { anEvent. ActiveHand shiftPressed}) = true ]! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:33'!
getHeaderTitleSelector

	^ getHeaderTitleSelector value! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:35'!
setIndexSelector: anObject
	setIndexSelector value: anObject! !

!NewListAdapter methodsFor: 'list protocol' stamp: 'BenjaminVanRyseghem 12/16/2012 17:17'!
getListSize

	^ self getListSizeSelector
		ifNil: [ nil ]
		ifNotNil: [:s | self model perform: s ]! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:35'!
getIndexesSelector: aSelector

	getIndexesSelector value: aSelector! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:35'!
wantsDropSelector: anObject
	wantsDropSelector value: anObject! !

!NewListAdapter methodsFor: 'list protocol' stamp: 'BenjaminVanRyseghem 11/26/2012 21:27'!
draggedItemAtIndex: anIndex

	^ self dragItemSelector
			ifNil: [ self getRawItemAt: anIndex ]
			ifNotNil: [:s | self model perform: s with: anIndex  ]! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:34'!
dropItemSelector: anObject
	dropItemSelector value: anObject! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:35'!
getIconSelector: anObject
	getIconSelector value: anObject! !

!NewListAdapter methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 12/17/2012 14:56'!
update: aSymbol

	aSymbol == self getItemsSelector 			ifTrue: [ ^ self changed: #getItems ].
	aSymbol == self getListSizeSelector 		ifTrue: [ ^ self changed: #getListSize ].
	aSymbol == self getHeaderTitleSelector 		ifTrue: [ ^ self changed: #getHeaderTitle ].
	aSymbol == self getIconSelector 			ifTrue: [ ^ self changed: #iconForItem:at: ].
	aSymbol == self getIndexSelector 			ifTrue: [ ^ self setIndexFromModel ].
	aSymbol == self getIndexesSelector 		ifTrue: [ ^ self setIndexesFromModel ].
	aSymbol == #resetSelectedIndexes 		ifTrue: [ ^ self changed: #resetSelectedIndexes ].
	aSymbol == #invalidateIcons 				ifTrue: [ ^ self changed: #invalidateIcons ]! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:34'!
getMenuSelector
	^ getMenuSelector value! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:34'!
dragItemSelector: anObject

	dragItemSelector value: anObject! !

!NewListAdapter methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 12/16/2012 20:38'!
setIndexesFromModel

	| indexes |
	
	indexes := self getIndexesSelector 
				ifNil: [ ^ self ]
				ifNotNil: [:s | self model perform: s ].
	
	self list adoptIndexes: indexes.! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/1/2013 09:52'!
allowToSelectSelector

	^ allowToSelectSelector! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:34'!
keyStrokeSelector
	
	^ keyStrokeSelector value! !

!NewListAdapter methodsFor: 'list protocol' stamp: 'BenjaminVanRyseghem 12/16/2012 18:39'!
dragPassengersFor: antem inMorph: aMorph

	^ self model dragPassengersFor: antem inMorph: aMorph! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/1/2013 09:52'!
allowToSelectSelector: aSelector

	allowToSelectSelector := aSelector! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:33'!
doubleClickSelector
	^ doubleClickSelector value! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:33'!
getIndexesSelector

	^ getIndexesSelector value! !

!NewListAdapter methodsFor: 'list protocol' stamp: 'BenjaminVanRyseghem 12/13/2012 11:26'!
iconForItem: anItem at: anIndex

	^ self getIconSelector
		ifNil: [ nil ]
		ifNotNil: [:s | self model perform: s withEnoughArguments: {anItem . anIndex} ]! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:35'!
list: anObject
	list value: anObject! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:34'!
model

	^ model value! !

!NewListAdapter methodsFor: 'list protocol' stamp: 'BenjaminVanRyseghem 12/13/2012 09:18'!
iconMaxSize

	^ self getIconMaxSizeSelector
		ifNil: [ nil ]
		ifNotNil: [:s | self model perform: s ]! !

!NewListAdapter methodsFor: 'list protocol' stamp: 'BenjaminVanRyseghem 12/16/2012 17:17'!
getItems

	^ self getItemsSelector 
		ifNil: [ nil ]
		ifNotNil: [:s | self model perform: s ]! !

!NewListAdapter methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 12/13/2012 12:26'!
on: aModel getItemsSelector: getItems getDisplaySelector: getDisplay

	^ self
		model: aModel;
		getItemsSelector: getItems;
		getDisplaySelector: getDisplay;
		yourself! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:35'!
getListSizeSelector: aSelector

	getListSizeSelector value: aSelector! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:34'!
getDisplaySelector: anObject
	getDisplaySelector value: anObject! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:34'!
setIndexSelector
	^ setIndexSelector value! !

!NewListAdapter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:33'!
getIconSelector
	^ getIconSelector value! !

!NewListAdapter methodsFor: 'list protocol' stamp: 'BenjaminVanRyseghem 5/1/2013 08:43'!
doubleClick: event

	self model perform: self doubleClickSelector withEnoughArguments: { event }! !

!NewListAdapter class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 11/26/2012 18:50'!
on: aModel

	^ self new
		model: aModel;
		yourself! !

!NewListExample commentStamp: '<historical>'!
I am an example of how to use the NewList.

I also provide so comparision with the old List implementation.

NewListExample new
	withNewList;
	openInWindow.

NewListExample new
	withOldList;
	openInWindow.!
!NewListExample methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/23/2012 15:47'!
listMorph: anObject
	listMorph := anObject! !

!NewListExample methodsFor: 'morphic' stamp: 'BenjaminVanRyseghem 5/1/2013 09:27'!
headerTitle

	^ 'My Title'! !

!NewListExample methodsFor: 'initialize' stamp: 'BenjaminVanRyseghem 11/29/2012 19:36'!
buildTextMorph

	^ PluggableTextMorph new! !

!NewListExample methodsFor: 'initialize' stamp: 'MarcusDenker 10/16/2013 18:00'!
openInWorld

	| panel |
	panel := PanelMorph new.
	panel 
		changeProportionalLayout;
		addMorph: listMorph fullFrame: ((0@0 corner: 1@0.5) asLayoutFrame);
		addMorph: textMorph fullFrame: ((0@0.5 corner: 1@1) asLayoutFrame).
	panel openInWorld! !

!NewListExample methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/24/2012 19:36'!
toggleTitle

	toggleTitle := toggleTitle not.
	self changed: #title.
	self changed: #getItems.! !

!NewListExample methodsFor: 'morphic' stamp: 'EstebanLorenzano 5/15/2013 11:16'!
iconFor: item at:  anIndex
	| icon |
	icon := Smalltalk ui icons iconNamed: #testGreenIcon.
	"^ icon"
	^  IconicButton new 
						target: self;
						actionSelector: #halt;
						labelGraphic: icon ;
						color: Color transparent;
						extent: 12 @ 12;
						helpText: 'Run the tests';
						borderWidth: 0.! !

!NewListExample methodsFor: 'morphic' stamp: 'BenjaminVanRyseghem 11/23/2012 17:47'!
getIndex

	^ index! !

!NewListExample methodsFor: 'morphic' stamp: 'BenjaminVanRyseghem 5/21/2013 18:03'!
displayItem: anItem

	^ anItem asStringMorph color: Color red; yourself"
	^ TextInputFieldModel new
				ghostText: anItem asString."! !

!NewListExample methodsFor: 'morphic' stamp: 'BenjaminVanRyseghem 12/13/2012 09:19'!
iconMaxSize

	^ 16@16! !

!NewListExample methodsFor: 'morphic' stamp: 'BenjaminVanRyseghem 5/1/2013 09:53'!
allowToSelect

	^ false.! !

!NewListExample methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 23:06'!
initialize

	super initialize.

	pluggable := false.
	index := 0.
	toggleTitle := true.
	rawList := (1 to: 10) asOrderedCollection.
	textMorph := self buildTextMorph! !

!NewListExample methodsFor: 'initialize' stamp: 'BenjaminVanRyseghem 5/1/2013 09:53'!
buildMorph
	| list |
	list :=  NewList
			on: self 
			getItemsSelector: #getItems 
			setIndexSelector: #setIndex:
			getDisplaySelector: #displayItem:.

	list adapter 
		getHeaderTitleSelector: #title;
		getMenuSelector: #menu:shifted:;
		dragEnabled: true;
		dropEnabled: true;
		allowToSelectSelector: #allowToSelect;
		isMultipleSelection: true;
		deSelectOnReclick: true;
		getHeaderTitleSelector: #headerTitle;
		doubleClickSelector: #halt;
		dropItemSelector: #drop:at:;
		getIconSelector: #iconFor:at:;
		getIconMaxSizeSelector: #iconMaxSize;
		endOfInitialization.

	list whenHeaderIsClickedDo: [ self toggleTitle ].
	list whenSelectedItemsChangedDo: [:items |
		textMorph ifNotNil: [
			textMorph setText: (String streamContents: [:s | 
				items do: [:e | s << e printString ; cr ]] )]] .
	^ list! !

!NewListExample methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/23/2012 15:47'!
listMorph
	^ listMorph! !

!NewListExample methodsFor: 'morphic' stamp: 'BenjaminVanRyseghem 11/25/2012 22:22'!
drop: anItem at: anIndex

	rawList remove: anItem.
	rawList add: anItem beforeIndex: anIndex.
	self changed: #getItems! !

!NewListExample methodsFor: 'morphic' stamp: 'BenjaminVanRyseghem 11/25/2012 22:21'!
getItems

	^ toggleTitle 
		ifTrue: [ rawList ]
		ifFalse: [ rawList reversed ]! !

!NewListExample methodsFor: 'initialize' stamp: 'MarcusDenker 10/16/2013 18:00'!
openInWindow

	| panel |
	panel := PanelMorph new.
	panel 
		changeProportionalLayout;
		addMorph: listMorph fullFrame: ((0@0 corner: 1@0.5) asLayoutFrame);
		addMorph: textMorph fullFrame: ((0@0.5 corner: 1@1) asLayoutFrame).
	panel openInWindow! !

!NewListExample methodsFor: 'morphic' stamp: 'MarcusDenker 10/16/2013 18:02'!
setIndex: idx
	pluggable
		ifFalse: [ ^ self ].
	index := idx = index
		ifTrue: [ 0 ]
		ifFalse: [ idx ].
	self changed: #getIndex! !

!NewListExample methodsFor: 'morphic' stamp: 'BenjaminVanRyseghem 11/25/2012 22:21'!
title

	^ toggleTitle
		ifTrue: [ 'Title' ]
		ifFalse: [ 'Title (reversed)' ]! !

!NewListExample methodsFor: 'initialize' stamp: 'BenjaminVanRyseghem 11/26/2012 17:14'!
withNewList

	listMorph := self buildMorph.! !

!NewListExample methodsFor: 'initialize' stamp: 'BenjaminVanRyseghem 11/26/2012 17:15'!
withOldList

	listMorph := self buildMorphWithOld.! !

!NewListExample methodsFor: 'initialize' stamp: 'MarcusDenker 10/16/2013 18:02'!
buildMorphWithOld
	pluggable := true.
	
	^ PluggableListMorph 
		on: self list: #getItems selected: #getIndex changeSelected: #setIndex: menu: #menu:shifted:! !

!NewListExample methodsFor: 'morphic' stamp: 'BenjaminVanRyseghem 11/25/2012 03:04'!
menu: aMenu shifted: aBoolean
	aMenu
		add: 'Foo' 
		target: self 
		selector: #halt.
	^ aMenu! !

!NewListModel commentStamp: '<historical>'!
| m |

m := NewListModel new.


m items: (10 to: 50) asOrderedCollection.
m headerTitle: 'Fubu'.
m setSelectedIndex: 5.

m openWithSpec.!
!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:05'!
resetSelection
	"<api: #do>"
	"Unselect every items"

	self changed: #resetSelectedIndexes! !

!NewListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
deSelectOnReclick: aBoolean

	deSelectOnReclick value: aBoolean! !

!NewListModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:34'!
whenAllowToSelectChanged: aBlock
	"Set a block to value when the value of allowToSelect has changed"
	
	allowToSelect whenChangedDo: aBlock! !

!NewListModel methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 11/12/2013 10:44'!
registerEvents

	items whenChangedDo: [ self changed: #getItems ].
	
	headerTitle whenChangedDo: [ :title | 
		self changed: #getHeaderTitle.
		self changed: { #hasHeader: . title notNil } ].
	deSelectOnReclick whenChangedDo: [ :bool | self changed: { #deSelectOnReclick: . bool } ].
	isMultipleSelection whenChangedDo: [ :bool | self changed: { #isMultipleSelection: . bool } ].
	unselectOnChange whenChangedDo: [ :bool | self changed: { #unselectOnChange: . bool } ].
	handlesDoubleClick whenChangedDo: [ :bool | self changed: { #handlesDoubleClick . bool } ].
	
	menuHolder whenChangedDo: [ :aMenuModel :oldMenu | 
		(oldMenu isNil or: [ oldMenu isBlock ]) ifFalse: [ oldMenu neglect: self ].
		(aMenuModel isNil or: [ aMenuModel isBlock ]) ifFalse: [ aMenuModel applyTo: self ] ]! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:53'!
setSelectedIndex: anIndex
	"<api: #integer min: 0 max: #listSize getter: #selectedIndex registration: #whenSelectionIndexChanged:>"
	"Set the index of the item you want to be selected"
	
	self widget
		ifNil: [ selectedIndex value: anIndex ]
		ifNotNil: [ self changed: { #setIndex: .anIndex } ]! !

!NewListModel methodsFor: 'api-events' stamp: 'johanfabry 3/11/2015 16:01'!
whenSelectionChanged: aBlock
	"<api: #event>"
	"Set a block to value when the selection of the list has changed"

	"The method should be used only if you are interested in the fact that there was a change, without caring about what has changed
	If you are interested in the items, use whenSelectedItemChanged:
	If you are interested in the index, use whenSelectionIndexChanged:"

	self whenSelectionIndexChanged: aBlock.! !

!NewListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 6/21/2013 00:10'!
separatorAfter: item at: index

	^ self separatorBlock cull: item cull: index! !

!NewListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
separatorBlock: aBlock

	separatorBlock value: aBlock! !

!NewListModel methodsFor: 'list api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
selectedItem: anIndex

	selectedItem value: anIndex! !

!NewListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
getDisplayForItem: item at: index

	^ displayBlock value cull: item cull: index! !

!NewListModel methodsFor: 'initialization' stamp: 'DucasseStephane 9/10/2014 09:59'!
initialize
	"Initialization code for NewListModel"

	super initialize.
	
	items := #() asValueHolder.
	deSelectOnReclick := false asValueHolder.
	draggedItemAtIndex := [ :index | self getRawItemAt: index ] asValueHolder.
	displayBlock := [ :object | object asStringOrText ] asValueHolder.
	headerHeight := 0 asValueHolder.
	headerTitle := nil asValueHolder.
	menuTitle := nil asValueHolder.
	menuHolder := nil asValueHolder.
	handlesDoubleClick := false asValueHolder.
	doubleClick := [  ] asValueHolder.
	iconHolder := [ nil ] asValueHolder.
	iconMaxSize := nil asValueHolder.
	keyStrokeAction := [ false ] asValueHolder.
	isMultipleSelection := false asValueHolder.
	unselectOnChange := false asValueHolder.
	sortingBlock := self defaultSortingBlock asValueHolder.
	filteringBlock := self defaultFilteringBlock asValueHolder.
	allowToSelect := true asValueHolder.
	listAnnouncer := Announcer new.
	headerClicked := [] asValueHolder.
	selectedIndex := 0 asValueHolder.
	selectedItem := nil asValueHolder.
	selectedIndexes := #() asValueHolder.
	selectedItems := #() asValueHolder.
	separatorBlock := [ false ] asValueHolder.
	
	self registerEvents! !

!NewListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
getRawItemAt: index

	^ items value at: index ifAbsent: [ nil ]! !

!NewListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
allowToSelect

	^ allowToSelect value! !

!NewListModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:35'!
whenMultiSelectionChanged: aBlock
	"Set a block to value when the multiSelection value has changed"
	
	isMultipleSelection whenChangedDo: aBlock! !

!NewListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
headerTitle: aTitle

	headerTitle value: aTitle! !

!NewListModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 17:04'!
whenListChanged: aBlock
	"Specify a block to value after the contents of the list has changed"
	"Basically when you set a new list of items"
	"<api: #event>"
	| block |
	block := [ :announcement :ann | 
	aBlock
		cull: announcement newValue
		cull: announcement oldValue
		cull: announcement
		cull: ann ].
	listAnnouncer
		when: ValueChanged
		do: block! !

!NewListModel methodsFor: 'list api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
selectedIndex: anIndex

	selectedIndex value: anIndex! !

!NewListModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:35'!
whenSelectedItemChanged: aBlock
	"Set a block to value when the select item is changed"
	
	selectedItem whenChangedDo: aBlock! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:54'!
allowToSelect: aBoolean
	"<api: #boolean getter: #allowToSelect registration: #whenAllowToSelectChanged:>"
	"Set if the list items can be selected or not"

	allowToSelect value: aBoolean.
	aBoolean 
		ifFalse: [ self resetSelection ].! !

!NewListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
isMultipleSelection

	^ isMultipleSelection value! !

!NewListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
unselectOnChange: aBoolean

	unselectOnChange value: aBoolean.! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:03'!
selectedIndex
	"<api: #inspect>"
	"Return the index of the selected item
	In the case of a multiple selection list, it returns the last selected item"

	^ selectedIndex value! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:18'!
filteringBlock
	"<api: #inspect>"
	"Return the filtering of the items"
	
	^ filteringBlock value! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 9/30/2014 13:21'!
getMenu: shiftKeyState
	| menu |
	menuHolder value ifNil: [ ^ nil ].
	menuHolder value isBlock ifFalse: [ ^ menuHolder value ].
	menu := MenuModel new.
	menuHolder value cull: menu cull: shiftKeyState.
	menuTitle value ifNotNil: [ :title | menu addTitle: title ].
	^ menu
! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:21'!
filteringBlock: aBlock
	"<api: #block getter: #filteringBlock registration: #whenFilteringBlockChanged:>"
	"To set the filtering of the items"
	
	filteringBlock value: aBlock! !

!NewListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
handlesDoubleClick

	^ handlesDoubleClick value! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:18'!
selectedItems
	"<api: #inspect>"
	"Return all the selected items in the case of a multiple selection list"

	^ selectedItems value! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:19'!
sortingBlock
	"<api: #inspect>"
	"Return the ordering of the items"
	
	^ sortingBlock value! !

!NewListModel methodsFor: 'list api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
selectedItems: anIndex

	selectedItems value: anIndex! !

!NewListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
icons: aBlock

	iconHolder value: aBlock! !

!NewListModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:36'!
whenSortingBlockChanged: aBlock
	"Set a block to value when the sorting block has changed"
	
	sortingBlock whenChangedDo: aBlock! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:54'!
sortingBlock: aBlock
	"<api: #block getter: #sortingBlock registration: #whenSortingBlockChanged:>"
	"To set the ordering of the items"
	
	sortingBlock value: aBlock! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:52'!
setSelectedItem: anItem
	"<api: #st getter: #selectedItem registration: #whenSelectedItemChanged:>"
	"Set the item you want to be selected"
	| index |

	index := self listItems identityIndexOf: anItem ifAbsent: [ ^ self ].

	self setSelectedIndex: index! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:18'!
resetSortingBlock
	"<api: #do>"
	"Reset the sortering block with the default value which consists in not sorting"

	sortingBlock value: self defaultSortingBlock! !

!NewListModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:34'!
whenHandlesDoubleClickChanged: aBlock
	"Set a block to value when the handlesDoubleClick value has changed"
	
	handlesDoubleClick whenChangedDo: aBlock! !

!NewListModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:34'!
whenDisplayBlockChanged: aBlock
	"Set a block to value when the filtering block block has changed"
	
	displayBlock whenChangedDo: aBlock! !

!NewListModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
headerClicked: aBlock

	headerClicked value: aBlock! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:47'!
items: aList
	"Set the items of the list.
	aList is a collection of your domain specific items.
	Use a two stages notification (issue 7420)."

	"<api: #st getter: #listItems registration: #whenListChanged:>"
	| oldContents |
	oldContents := items value.
	items value: (aList sorted: sortingBlock value).
	listAnnouncer announce: (ValueChanged oldValue: oldContents newValue: items value)! !

!NewListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
getHeaderHeight

	^ headerHeight value! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:19'!
beSingleSelection
	"<api: #do>"
	"Make list selection single"

	self isMultipleSelection: false! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:49'!
multiSelection: aBoolean
	"<api: #boolean getter: #multiSelection registration: #whenMultiSelectionChanged:>"
	"Make the list seelction become multiple if aBoolean is true.
	Otherwise set the selection as single"
	
	isMultipleSelection value: aBoolean.
	! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:17'!
updateList
	"<api: #do>"
	"Refresh the list"
	
	self changed: #getItems.! !

!NewListModel methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 5/1/2013 09:12'!
defaultSortingBlock 
	^ [:a :b | true]! !

!NewListModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:34'!
whenFilteringBlockChanged: aBlock
	"Set a block to value when the filtering block block has changed"
	
	filteringBlock whenChangedDo: aBlock! !

!NewListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
separatorBlock

	^ separatorBlock value! !

!NewListModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:35'!
whenMenuChanged: aBlock
	"Set a block to value when the menu block has changed"
	
	menuHolder whenChangedDo: aBlock! !

!NewListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
isMultipleSelection: aBoolean

	isMultipleSelection value: aBoolean! !

!NewListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
unselectOnChange

	^ unselectOnChange value! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:02'!
doubleClickAction
	"<api: #inspect>"
	"Return the block evaluated on double click"
	
	^ doubleClick value! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:54'!
handlesDoubleClick: aBoolean
	"<api: #block getter:#handlesDoubleClick registration: #whenHandlesDoubleClickChanged:>"
	"Enable or disable double click on the list."
	
	handlesDoubleClick value: aBoolean! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:19'!
menu: aBlock
	"<api: #block getter: #menu registration: #whenMenuChanged:>"
	"Set the block used to defined the menu"
	
	menuHolder value: aBlock! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:22'!
doubleClickAction: aBlock
	"<api: #block getter:#doubleClickAction registration: #whenDoubleClickActionChanged:>"
	"Set the block evaluated on double click."
	
	doubleClick value: aBlock! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:15'!
resetFilteringBlock
	"<api: #do>"
	"Reset the filtering block with the default value which consists in showing everything"

	filteringBlock value: self defaultFilteringBlock! !

!NewListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
keyStrokeAction: anEvent

	^ keyStrokeAction value cull: anEvent! !

!NewListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 5/1/2013 08:29'!
getListSize

	^ self getItems size! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:18'!
selectedItem
	"<api: #inspect>"
	"Return the selected item.
	In the case of a multiple selection list, it returns the last selected item"
	
	^ selectedItem value! !

!NewListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
getHeaderTitle

	 ^ headerTitle value! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:15'!
beMultipleSelection
	"<api: #do>"
	"Make list selection multiple"

	self isMultipleSelection: true! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:02'!
selectedIndexes
	"<api: #inspect>"
	"Return the indexes of selected items on the case of a multiple selection list"
	
	^ selectedIndexes value! !

!NewListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
draggedItemAtIndex: anIndex

	^ draggedItemAtIndex value cull: anIndex.! !

!NewListModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:34'!
whenDoubleClickActionChanged: aBlock
	"Set a block to value when the doubleClick value has changed"
	
	doubleClick whenChangedDo: aBlock! !

!NewListModel methodsFor: 'list api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
selectedIndexes: anIndex

	selectedIndexes value: anIndex! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:01'!
menu
	"<api: #inspect>"
	"Return the block used to defined the menu"
	
	^ menuHolder value! !

!NewListModel methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 5/1/2013 09:12'!
defaultFilteringBlock 
	^ [:col | col]! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:56'!
listItems
	"<api: #inspect>"
	"Return the items of the list. They are your domain specific items"
	
	^ listItemsCache ifNil: [ listItemsCache :=  filteringBlock value value: items value ]
	! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:48'!
displayBlock: aBlock
	"<api: #block getter:#displayBlock registration: #whenDisplayBlockChanged:>"
	"Set the one argument block used to wrap your domain specific items.
	The block should return something that can be displayed in a list - like a String or a Text"
	
	displayBlock value: aBlock! !

!NewListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
iconMaxSize

	^ iconMaxSize value! !

!NewListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
iconForItem: anItem at: anIndex

	^ iconHolder value cull: anItem cull: anIndex! !

!NewListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
hasHeader

	^ headerTitle value notNil! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:02'!
listSize
	"<api: #inspect>"
	"Return the size of the list"
	
	^ self listItems size! !

!NewListModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:35'!
whenSelectedIndexChanged: aBlock
	"Set a block to value when the selection index has changed"
	
	selectedIndex whenChangedDo: aBlock! !

!NewListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
getItems

	^ items value! !

!NewListModel methodsFor: 'list api-events' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
headerClicked

	headerClicked value value! !

!NewListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
iconMaxSize: aPoint

	iconMaxSize value: aPoint! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:13'!
displayBlock
	"<api: #inspect>"
	"Return the one argument block used to wrap your domain specific items.
	The block should return something that can be displayed in a list - like a String or a Text"
	
	^ displayBlock value! !

!NewListModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:04'!
multiSelection
	"<api: #inspect>"
	"Return true if the list has a multiple selection.
	False if the list has a single selection"
	
	^ isMultipleSelection value! !

!NewListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
deSelectOnReclick

	^ deSelectOnReclick value! !

!NewListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
doubleClick: event

	doubleClick value cull: event! !

!NewListModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/1/2013 13:39'!
defaultSpec
	<spec: #default>
	
	^ #(NewListAdapter
		adapt: #(model))! !

!NewListModel class methodsFor: 'examples' stamp: 'StephaneDucasse 9/30/2014 13:21'!
exampleWithMenu
	"self exampleWithMenu"
	| menu group1 item11 item12 group2 item21 item22 model|

	menu := MenuModel new.
	group1 := MenuGroupModel new.
	item11 := MenuItemModel new
		name: [ DateAndTime now asString  ];
		enabled: [ DateAndTime now seconds even ];
		yourself.
		
	item12 := MenuItemModel new
		name: 'item2';
		shortcut: $b shift command mac | $b alt shift win | $b alt shift unix;
		action: [ self halt ];
		enabled: true;
		yourself.
		
	group1 addMenuItem: item11.
	group1 addMenuItem: item12.
	group1 autoRefresh: true.


	group2 := MenuGroupModel new.
	item21 := MenuItemModel new
		name: 'item3';
		state: [ DateAndTime now seconds odd ];
		description: [ DateAndTime now asString  ];
		yourself.
		
	item22 := MenuItemModel new
		name: 'item4';
		subMenu: (MenuModel new 
			autoRefresh: true;
			addGroup: [ :g |
				g addItem: [ :i| i 
					name: [ 'sub' , ((Character value: (DateAndTime now seconds + 60))) asString ];
					action: [ self halt ];
					shortcut: $d shift command mac | $d alt shift win | $d alt shift unix
					]];
					
				yourself);
		yourself.	
	group2 addMenuItem: item21.
	group2 addMenuItem: item22.
	menu addMenuGroup: group1.
	menu addMenuGroup: group2.
	menu addTitle: 'Test'.
	model := NewListModel new.
	model menu: menu.
	model openWithSpec! !

!NewListModel class methodsFor: 'examples' stamp: 'BenjaminVanRyseghem 11/12/2013 10:43'!
exampleWithMenu2
	"self exampleWithMenu2"
	| oddMenu evenMenu model |

	oddMenu := MenuModel new
		addGroup: [ :group | 
			group addItem: [ :item |
				item 
					name: 'Odd';
					shortcut: $o command;
					action: [ self logCr: 'o' ] ] ].

	evenMenu := MenuModel new
		addGroup: [ :group | 
			group addItem: [ :item |
				item 
					name: 'Even';
					shortcut: $e command;
					action: [ self logCr: 'e' ] ] ].

	model := NewListModel new.
	model openWithSpec.
	model items: (1 to: 10) asOrderedCollection.
	model whenSelectedItemChanged: [ :number |
		number odd
			ifTrue: [ model menu: oddMenu ]
			ifFalse: [ model menu: evenMenu ] ]! !

!NewListModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/13/2014 15:23'!
adapterName

	^ #NewListAdapter! !

!NewListRenderer commentStamp: '<historical>'!
NewListRenderer is the morph contained by a NewList used to render all the items and manage mouse events.!
!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 11/25/2012 22:17'!
rawItemAtIndex: index

	^ self listSource rawItemAtIndex: index! !

!NewListRenderer methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 5/1/2013 07:47'!
drawHeaderOn: aCanvas
	| drawBounds top item itemColor backgroundColor height width deltaY deltaX |
	drawBounds := self owner bounds.
	top := self topDifference.
	drawBounds := -3 @ top corner: drawBounds right @ top + self headerHeight.
	aCanvas
		fillRectangle: drawBounds
		fillStyle:
			((GradientFillStyle
				ramp:
					{(0 -> (Color r: 0.854 g: 0.836 b: 0.806)).
					(1 -> Color gray muchLighter lighter)})
				origin: drawBounds left @ drawBounds bottom;
				direction: 0 @ self headerHeight negated asFloat;
				normal: 0 @ 1;
				radial: false;
				yourself).
	item := self headerTitle.
	itemColor := Color black.
	backgroundColor := self backgroundColorForIndex: 0.
	height := item heightToDisplayInList: self.
	width := item widthToDisplayInList: self.
	deltaY := ((drawBounds height - height) / 2) asInteger.
	deltaX := ((self owner width - width) / 2) asInteger.
	drawBounds := drawBounds translateBy: deltaX @ deltaY.
	item
		listRenderOn: aCanvas
		atRow: 0
		bounds: drawBounds
		color: itemColor
		backgroundColor: backgroundColor
		from: self! !

!NewListRenderer methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/25/2012 15:58'!
releaseKeyboardFocus

	ActiveHand releaseKeyboardFocus.
	self listSource changed! !

!NewListRenderer methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:32'!
potentialDropIndex: anInteger

	potentialDropIndex value: anInteger! !

!NewListRenderer methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 1/24/2014 16:07'!
initialize

	super initialize.
	
	wantsSteps := false.
	listSource := nil asValueHolder.
	itemHeight := nil asValueHolder.
	maxWidth := 0 asValueHolder.
	hasHeader := false asValueHolder.
	potentialDropIndex := 0 asValueHolder.
	steppingTime := 100.
	mouseDownIndex := 0 asValueHolder.
	listSource whenChangedDo: [:e | 
		itemHeight value: e itemHeight.
		e whenItemsChangedDo: [ maxWidth value: 0 ]].
	potentialDropIndex whenChangedDo: [:new :old | self updateRectFor: new and: old ].
	mouseDownIndex whenChangedDo: [:new :old |
		(old ~~ 0 and: [ new ~~ 0 ]) 
			ifTrue: [ self updateRectFor: old and: new ]
			ifFalse: [
				old isZero ifFalse: [self updateRectFor: old ].
				new isZero ifFalse: [self updateRectFor: new ]]].! !

!NewListRenderer methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:33'!
mouseDownIndex

	^ mouseDownIndex value! !

!NewListRenderer methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:32'!
maxWidth: anInteger

	maxWidth value: anInteger! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 11/25/2012 19:41'!
dropEnabled

	^ self listSource dropEnabled! !

!NewListRenderer methodsFor: 'drawing - private' stamp: 'BenjaminVanRyseghem 12/13/2012 09:06'!
gapBetweenIconAndItem

	^ self listSource iconMaxSize 
		ifNil: [ 0 ]
		ifNotNil: [ 4 ]! !

!NewListRenderer methodsFor: 'drawing - private' stamp: 'BenjaminVanRyseghem 11/25/2012 19:41'!
isPotentialDrop: anIndex

	^ anIndex == self potentialDropIndex! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 11/25/2012 16:02'!
dragItemSelector

	^ self listSource dragItemSelector! !

!NewListRenderer methodsFor: 'stepping and presenter' stamp: 'BenjaminVanRyseghem 11/25/2012 21:04'!
stepTime

	^ steppingTime! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 12/16/2012 17:44'!
takeKeyboardFocus

	self listSource takeKeyboardFocus! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 11/25/2012 02:34'!
isMultipleSelection

	^ self listSource isMultipleSelection! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 11/25/2012 00:53'!
selectedIndex

	^ self listSource selectedIndex! !

!NewListRenderer methodsFor: 'drawing - private' stamp: 'BenjaminVanRyseghem 11/29/2012 19:23'!
drawBackgroundForItem: item at: index on: aCanvas color: aColor
	| frame  |
	
 	frame := self selectionFrameForItem: item at: index.
	
	aCanvas
		fillRectangle: frame
		color: aColor! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 11/24/2012 13:33'!
headerHeight

	^ self listSource headerHeight! !

!NewListRenderer methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 6/21/2013 00:06'!
drawOn: aCanvas
	| first last |

	aCanvas
		fillRectangle: self fullBounds
		color: self drawColor.
	
	first := self topVisibleIndexForCanvas: aCanvas.
	last := self bottomVisibleIndexForCanvas: aCanvas.
	self listSize isZero ifTrue: [ last := 0 ].
	
	first
		to: last 
		do: [ :index || item |
			item := self itemAtIndex: index.
			self drawBackgroundForItem: item at: index on: aCanvas.
			self drawItem: item at: index on: aCanvas.
			(self separatorAfter: item at: index)
				ifTrue: [ self drawSeparatorForItem: item at: index on: aCanvas ]].
		
	self hasHeader ifTrue: [ self drawHeaderOn: aCanvas ].! !

!NewListRenderer methodsFor: 'menu' stamp: 'BenjaminVanRyseghem 11/25/2012 02:59'!
getMenu: shiftKeyState
	"Answer the menu for this text view, supplying an empty menu to be filled in. If the menu selector takes an extra argument, pass in the current state of the shift key."

	| aMenu |
	aMenu := self listSource getMenu: shiftKeyState.
	aMenu ifNotNil: [ aMenu commandKeyHandler: self ].
	^ aMenu! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'MarcusDenker 9/30/2014 17:20'!
commandKeyTypedIntoMenu: evt
	^ self listSource keyStroke: evt! !

!NewListRenderer methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/23/2015 13:32'!
drawOnAthensCanvas: anAthensCanvas
	self drawOnCanvasWrapperFor: anAthensCanvas! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 5/1/2013 08:42'!
handlesDoubleClick

	^ self listSource handlesDoubleClick! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 11/25/2012 00:12'!
itemHalfOffSet

	^ self listSource itemHalfOffSet! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 11/24/2012 00:34'!
itemAtIndex: index

	^ self listSource itemAtIndex: index! !

!NewListRenderer methodsFor: 'stepping and presenter' stamp: 'BenjaminVanRyseghem 1/28/2013 17:32'!
step

	|  stepBounds mousePosition delta |
	ActiveHand hasSubmorphs ifFalse: [ ^ wantsSteps := false ].
	mousePosition := ActiveHand position.
	stepBounds := self listSource fullBoundsInWorld.
	(stepBounds containsPoint: mousePosition) ifFalse: [ ^ wantsSteps := false ].
	delta := stepBounds top + self headerHeight + 10 - mousePosition y.
	(mousePosition y > (stepBounds top + self headerHeight-10) and: [ 0 < delta])
		ifTrue: [ ^ self listSource scrollBar scrollUp: delta//2 ].
		
	delta := stepBounds top - self headerHeight + self listSource height - 5 - mousePosition y.
	( 0 > delta )
		ifTrue: [ ^ self listSource scrollBar scrollDown: delta negated // 3].
		
	self stopStepping.! !

!NewListRenderer methodsFor: 'drawing - private' stamp: 'BenjaminVanRyseghem 6/21/2013 00:17'!
separatorColor
	
	^ Color black! !

!NewListRenderer methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:32'!
itemHeight: anInteger

	itemHeight value: anInteger! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 11/25/2012 19:21'!
dropItemSelector

	^ self listSource dropItemSelector! !

!NewListRenderer methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 12/13/2012 10:07'!
drawSubmorphsOn: aCanvas 
	"Do nothing please"! !

!NewListRenderer methodsFor: 'events' stamp: 'BenjaminVanRyseghem 5/1/2013 09:55'!
mouseUp: event
	| previousIndex index |	
	
	self listSource wantsKeyboardFocus ifTrue: [ self listSource takeKeyboardFocus ].

	(event position y < (self topDifference + self headerHeight)) 
		ifTrue: [ ^ self mouseDownOnHeader: event ].

	self allowToSelect ifFalse: [ ^ self ].

	index := self indexAtLocation: event position.
	previousIndex := self selectedIndex.
	
	((event shiftPressed not and: [ event commandKeyPressed not ]) and: [ self selectionWithKeys ])
		ifTrue: [ self resetSelectionIndexes ].

	self mouseDownIndex: 0.
	( self deSelectOnReclick and: [ previousIndex == index ])
		ifTrue: [ 
			self listSource private_selectedIndexes at: index put: false.
			index := 0 ].
	self listSource setIndex: index.
	self listSource mouseUpOnItemAt: index event: event.	
	
	event commandKeyPressed ifTrue: [	previousIndex = index ifTrue: [ previousIndex := 0 ]].
	event shiftPressed ifTrue: [
		| start end |
		start := previousIndex min: index.
		end := previousIndex max: index.
		
		start to: end do: [:e | self listSource addAtIndexes: e ]]! !

!NewListRenderer methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/10/2015 17:47'!
drawSubmorphsOnAthensCanvas: anAthensCanvas
	"like drawSubmorphsOn:, do nothing"! !

!NewListRenderer methodsFor: 'drawing - background' stamp: 'BenjaminVanRyseghem 11/29/2012 19:27'!
drawBackgroundForItem: item at: index on: aCanvas

	(self isSelectedIndex: index)
		ifTrue: [ self drawSelectedBackgroundForItem: item at: index on: aCanvas ]
		ifFalse: [ 
			(self isSecondSelectedIndex: index)
				ifTrue: [ self drawSecondSelectedItem: item at: index on: aCanvas ]
				ifFalse: [ self drawDefaultBackgroundForItem: item at: index on: aCanvas ] ].
			
	(self isPotentialDrop: index)
		ifTrue: [ self drawPotentialDropBackroundForItem: item at: index on: aCanvas ].
		
	self drawMouseDownBackgroundFor: item at: index on: aCanvas! !

!NewListRenderer methodsFor: 'drawing - private' stamp: 'BenjaminVanRyseghem 12/13/2012 09:14'!
iconColor

	^ Color transparent! !

!NewListRenderer methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/25/2012 19:31'!
resetPotentialDropIndex

	self potentialDropIndex: 0! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 11/24/2012 00:36'!
isSecondSelectedIndex: index 

	^ self listSource isSecondSelectedIndex: index! !

!NewListRenderer methodsFor: 'drawing - private' stamp: 'BenjaminVanRyseghem 11/25/2012 19:44'!
potentialDropColor

	^ Color blue! !

!NewListRenderer methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 5/1/2013 08:00'!
acceptDroppingMorph: aMorph event: evt
	"This message is sent when a morph is dropped onto a morph that has     
	agreed to accept the dropped morph by responding 'true' to the     
	wantsDroppedMorph:Event: message. The default implementation just     
	adds the given morph to the receiver."

	"Here we let the model do its work."

	[ 
	self listSource
		acceptDroppingMorph: aMorph
		atIndex: self potentialDropIndex
		event: evt
		inMorph: self ]
		ensure: [ 
			self resetPotentialDropIndex.
			evt hand releaseMouseFocus: self.
			Cursor normal show ]! !

!NewListRenderer methodsFor: 'events' stamp: 'BenjaminVanRyseghem 11/25/2012 19:54'!
mouseLeaveDragging: evt

	self resetPotentialDropIndex.
	super mouseLeaveDragging: evt! !

!NewListRenderer methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 11/5/2013 11:20'!
startDrag: evt 
	| transferMorph draggedIndex draggedItem passenger |

	evt hand hasSubmorphs ifTrue: [^ self]. 
	self dragEnabled ifFalse: [ ^ self ].
	ActiveHand anyButtonPressed ifFalse: [ ^ self ].
			
	draggedIndex := self indexAtLocation: evt position.
	draggedItem := self listSource model draggedItemAtIndex: draggedIndex.
	draggedItem ifNil: [ ^ self ].
	passenger := self listSource transferFor: draggedItem from: self listSource.
	passenger ifNil: [ ^ self ].
		
	self releaseKeyboardFocus.
	transferMorph := self listSource withPassenger: passenger from: self.
	transferMorph dropNotifyRecipient: self.
	transferMorph align: transferMorph draggedMorph bottomLeft  with: ((evt position) translateBy: (self listSource bounds left)@(self listSource bounds top - self topDifference + self headerHeight - (3*self itemHeight/2))).
	
	"self mouseDownRow: nil."
	transferMorph dragTransferType: ((self model dragTransferTypeForMorph: self) ifNil: [ #dragTransfer ]).
	
	[evt hand grabMorph: transferMorph ] 
		ensure: [
			Cursor normal show.
			evt hand releaseMouseFocus: self] ! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 10/17/2013 16:32'!
listSource: anObject
	
	listSource value: anObject.
	! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 11/24/2012 00:33'!
listSize
	"could be cached"
	
	^ self listSource listSize! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 11/29/2012 19:17'!
hasMultipledSelected

	^ self listSource hasMultipledSelected! !

!NewListRenderer methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:32'!
hasHeader: aBoolean

	hasHeader value: aBoolean! !

!NewListRenderer methodsFor: 'events' stamp: 'BenjaminVanRyseghem 5/1/2013 08:41'!
mouseDown: event

	| selectors |
	
	(self enabled and: [ event yellowButtonPressed ])  "First check for option (menu) click"
		ifTrue: [
			self isMultipleSelection
				ifTrue: [ 
					event commandKeyPressed
						ifFalse: [ "right click" 
							(self yellowButtonActivity: event shiftPressed) 
								ifTrue: [ ^ self ]]]
				ifFalse: [ (self yellowButtonActivity: event shiftPressed) 
				ifTrue: [ ^ self ]]].	

	self mouseDownIndex: (self indexAtLocation: event position).

	selectors := Array 
		with: #click:
		with: (self handlesDoubleClick ifTrue: [ #doubleClick: ])
		with: nil
		with: (self dragEnabled ifTrue: [ #startDrag: ] ifFalse:[ nil ]).
		
	event hand waitForClicksOrDrag: self event: event selectors: selectors threshold: 10.! !

!NewListRenderer methodsFor: 'drawing - item' stamp: 'BenjaminVanRyseghem 5/21/2013 18:01'!
drawItem: item at: index on: aCanvas
	"Display the given item at the given row on the given
	canvas."

	| itemColor drawBounds itemBounds backgroundColor |
	
	drawBounds := self drawBoundsForItem: item at: index.
	itemBounds := drawBounds translateBy: (self iconMaxSize x + self gapBetweenIconAndItem) @ (2 * self itemHalfOffSet).
	itemColor := self colorForItem: item at: index.
	backgroundColor := self backgroundColorForIndex: index.
	
	item
		listRenderOn: aCanvas
		atRow: index
		bounds: itemBounds
		color: itemColor
		backgroundColor: backgroundColor
		from: self.
		
	self drawIconOn: aCanvas forAt: index from: drawBounds.
	self flag: 'should be	item drawAsListItemOn: aCanvas row: index bounds: drawBounds list: self '! !

!NewListRenderer methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:33'!
potentialDropIndex

	^ potentialDropIndex value! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 11/29/2012 18:35'!
deSelectOnReclick

	^ self listSource deSelectOnReclick! !

!NewListRenderer methodsFor: 'drawing - background' stamp: 'BenjaminVanRyseghem 11/25/2012 19:44'!
drawPotentialDropBackroundForItem: item at: index on: aCanvas
	| drawBounds  |
	
	drawBounds := self drawBoundsForItem: item at: index.
	drawBounds := self ensureFrame: drawBounds.
	aCanvas frameRectangle: drawBounds color: self potentialDropColor! !

!NewListRenderer methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:33'!
maxWidth

	^ maxWidth value! !

!NewListRenderer methodsFor: 'events' stamp: 'BenjaminVanRyseghem 11/24/2012 19:08'!
mouseDownOnHeader: anEvent

	self listSource mouseDownOnHeader: anEvent! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 11/24/2012 13:48'!
headerTitle

	^ self listSource headerTitle! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 6/21/2013 00:07'!
separatorAfter: item at: index
	
	^ self listSource separatorAfter: item at: index! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 5/1/2013 09:56'!
allowToSelect

	^ self listSource allowToSelect! !

!NewListRenderer methodsFor: 'drawing - private' stamp: 'BenjaminVanRyseghem 6/21/2013 00:17'!
separatorSize
	
	^ 1! !

!NewListRenderer methodsFor: 'drawing - private' stamp: 'BenjaminVanRyseghem 11/25/2012 01:30'!
drawBoundsForIndex: index
	"calculate the bounds that row should be drawn at.  This might be outside our bounds!!"

	| topLeft drawBounds |
	
	topLeft := self topLeft x @ (self topLeft y + self headerHeight + ((index - 1) * self itemHeight)).
	drawBounds := topLeft extent: self width @ self itemHeight.
	^ drawBounds! !

!NewListRenderer methodsFor: 'drawing - background' stamp: 'BenjaminVanRyseghem 12/5/2012 14:45'!
drawDefaultBackgroundForItem: item at: index on: aCanvas

	"Nothing to do"! !

!NewListRenderer methodsFor: 'drawing - item' stamp: 'BenjaminVanRyseghem 2/21/2013 23:23'!
drawIconOn: aCanvas forAt: index from: itemBounds
	| item icon maxSize drawBounds xOffset yOffset backgroundColor |
	
	item := self rawItemAtIndex: index.
	icon := self listSource iconForItem: item at: index.
	icon ifNil: [ ^ self ].
	
	maxSize := self iconMaxSize.
	drawBounds := itemBounds topLeft extent: maxSize.
	xOffset := (maxSize x - icon width) / 2.
	yOffset := (maxSize y - icon height) / 2 + self itemHalfOffSet.
	drawBounds := drawBounds translateBy: xOffset @ yOffset.
	backgroundColor := self backgroundColorForIndex: index.
	
	icon
		listRenderOn: aCanvas
		atRow: index
		bounds: drawBounds
		color: self iconColor
		backgroundColor: backgroundColor
		from: self! !

!NewListRenderer methodsFor: 'drawing - private' stamp: 'EstebanLorenzano 1/28/2013 16:10'!
basicRemoveAllMorphs
	submorphs := EmptyArray ! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 11/29/2012 16:59'!
selectionWithKeys

	^ self listSource selectionWithKeys! !

!NewListRenderer methodsFor: 'drawing - private' stamp: 'BenjaminVanRyseghem 12/13/2012 13:53'!
drawBoundsForItem: item at: index
	"calculate the bounds that row should be drawn at.  This might be outside our bounds!!"

	| topLeft drawBounds width |
	
	width := (item widthToDisplayInList: self) + self iconMaxSize x + self gapBetweenIconAndItem.
	(width > self maxWidth) ifTrue: [ 
		self maxWidth: width.
		self width: width ].
	topLeft := self topLeft x @ (self topLeft y + self headerHeight + ((index - 1) * self itemHeight)).
	drawBounds := topLeft extent: width @ self itemHeight.
	^ drawBounds! !

!NewListRenderer methodsFor: 'drawing - item' stamp: 'BenjaminVanRyseghem 6/21/2013 00:18'!
drawSeparatorForItem: item at: index on: aCanvas
	| frame rectangle height separatorColor |
	
	height := self separatorSize.
	separatorColor := self separatorColor.
	frame := self selectionFrameForItem: item at: index.
	rectangle := (frame left@(frame bottom - height)) corner: (frame right@frame bottom).
	aCanvas fillRectangle: rectangle color: separatorColor! !

!NewListRenderer methodsFor: 'drawing - private' stamp: 'BenjaminVanRyseghem 11/25/2012 19:30'!
updateRectFor: index and: anotherIndex

	self flag: 'Could be optimized'.
	self listSource changed.
	
	"| item  |
	index isZero
		ifFalse: [
			item := self itemAtIndex: index. 
			self invalidRect:  (self selectionFrameForItem: item at: index) ]"! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 12/16/2012 17:09'!
drawColor

	^ self listSource drawColor! !

!NewListRenderer methodsFor: 'drawing - background' stamp: 'BenjaminVanRyseghem 11/29/2012 19:28'!
drawMouseDownBackgroundFor: item at: index on: aCanvas

	index == self mouseDownIndex
		ifTrue: [	aCanvas 
					frameRectangle: (self selectionFrameForItem: item at: index)
					width: 1
					colors: {Color gray. Color transparent}
					dashes: #(1 1)]! !

!NewListRenderer methodsFor: 'events' stamp: 'BenjaminVanRyseghem 11/25/2012 19:58'!
handleMouseMove: anEvent
	"System level event handling."
	anEvent wasHandled ifTrue: [ ^ self ]. "not interested"

	anEvent wasHandled: true.
	self mouseMove: anEvent.
	(self handlesMouseStillDown: anEvent) ifTrue:[
		"Step at the new location"
		self startStepping: #handleMouseStillDown: 
			at: Time millisecondClockValue
			arguments: {anEvent copy resetHandlerFields}
			stepTime: self mouseStillDownStepRate ].
	^ self eventHandler ifNotNil: [:handler | handler mouseMove: anEvent fromMorph: self ]
! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 11/29/2012 16:29'!
resetSelectionIndexes

	self listSource resetSelectionIndexes! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 11/24/2012 00:36'!
font

	^ self listSource font! !

!NewListRenderer methodsFor: 'drawing - private' stamp: 'BenjaminVanRyseghem 11/24/2012 19:22'!
invalidHeader

	| rect |
	rect := self bounds.
	rect := rect topLeft extent: rect width@self headerHeight.
	self invalidRect: rect! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 11/25/2012 19:13'!
wantsDropSelector

	^ self listSource wantsDropSelector! !

!NewListRenderer methodsFor: 'layout' stamp: 'BenjaminVanRyseghem 12/17/2012 14:09'!
privateFullBounds
	^  self bounds! !

!NewListRenderer methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 11/29/2012 19:33'!
dropAcceptedMorph:  transferMorph from: sourceMorph

	self mouseDownIndex: 0.! !

!NewListRenderer methodsFor: 'drawing - private' stamp: 'BenjaminVanRyseghem 11/24/2012 13:28'!
indexAtLocation: aPoint
	"return the number of the row at aPoint"
	"Here we assume that all the item have the same height"
	| y |
	y := aPoint y.
	(y < (self top + self headerHeight)) ifTrue: [ ^ 1 ].
	^((y - self top - self headerHeight // self itemHeight) + 1) min: self listSize max: 1! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 10/17/2013 16:32'!
listSource
	^ listSource value! !

!NewListRenderer methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 5/1/2013 08:53'!
wantsDroppedMorph: aMorph event: anEvent inMorph: source
	^ self listSource wantsDroppedMorph: aMorph event: anEvent inMorph: source! !

!NewListRenderer methodsFor: 'drawing - private' stamp: 'BenjaminVanRyseghem 11/24/2012 15:11'!
bottomVisibleIndexForCanvas: aCanvas
        "return the top visible index in aCanvas's clip rectangle"
        
	 | rect |
	rect := aCanvas clipRect.
	^self indexAtLocation: (rect left @ rect bottom + self headerHeight).! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 11/24/2012 00:51'!
selectedBackgroundColor

	^ self listSource selectedBackgroundColor! !

!NewListRenderer methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:32'!
itemHeight

	^ itemHeight value! !

!NewListRenderer methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 11/29/2012 19:33'!
dropRejectedMorph: aTransferMorp

	self resetPotentialDropIndex.
	self mouseDownIndex: 0.! !

!NewListRenderer methodsFor: 'drawing - private' stamp: 'BenjaminVanRyseghem 11/25/2012 00:06'!
topVisibleIndexForCanvas: aCanvas
        "return the top visible index in aCanvas's clip rectangle"
        | rect |

	rect := aCanvas clipRect.
	^ self indexAtLocation: (rect left @ self topDifference + self headerHeight)! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 12/16/2012 17:25'!
selectedIndexes

	^ self listSource selectedIndexes! !

!NewListRenderer methodsFor: 'events' stamp: 'BenjaminVanRyseghem 5/1/2013 08:53'!
mouseMove: evt
	| index |
	"Check if the mouse is currently dragging an object"
	evt isDraggingEvent
		ifFalse: [ ^ super mouseMove: evt ].	"Check if we are interested in this object"
	self dropEnabled
		ifFalse: [ ^ super mouseMove: evt ].
	(self wantsDroppedMorph: (evt hand submorphs at: 1 ifAbsent: [ ^ super mouseMove: evt ]) event: evt inMorph: self)
		ifFalse: [ ^ super mouseMove: evt ].
	self isScrolling
		ifTrue: [ ^ self ].
	index := self indexAtLocation: evt position.
	self potentialDropIndex: index.
	(evt position y > (self topDifference + self headerHeight - 10)
		and: [ evt position y < (self topDifference + self headerHeight + 10) ])
		ifTrue: [ wantsSteps := true ].
	evt position y > (self topDifference - self headerHeight + self listSource height - 5)
		ifTrue: [ wantsSteps := true ]! !

!NewListRenderer methodsFor: 'drawing - private' stamp: 'BenjaminVanRyseghem 5/1/2013 08:08'!
backgroundColorForIndex: anIndex

	^ (self isSelectedIndex: anIndex)
		ifTrue: [ self selectedBackgroundColor ]
		ifFalse: [ Color transparent ]! !

!NewListRenderer methodsFor: 'events' stamp: 'BenjaminVanRyseghem 11/25/2012 19:55'!
handlesMouseOverDragging: evt
	"Yes, for mouse down highlight."
	
	^true! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 11/24/2012 00:35'!
isSelectedIndex: index

	^ self listSource isSelectedIndex: index! !

!NewListRenderer methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:32'!
mouseDownIndex: anInteger

	self allowToSelect ifFalse: [ ^ self ].

	mouseDownIndex value: anInteger! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 11/25/2012 02:43'!
getMenuSelector

	^ self listSource getMenuSelector! !

!NewListRenderer methodsFor: 'drawing - private' stamp: 'BenjaminVanRyseghem 11/24/2012 23:42'!
topDifference
	| ownerTop top |
	
	ownerTop := self listSource top.
	top := (self bounds: self fullBounds in: self listSource) top.
	
	^ ownerTop - top +1! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 11/24/2012 14:47'!
colorForItem: item at: index 
	
	^ self listSource colorForItem: item at: index ! !

!NewListRenderer methodsFor: 'drawing - background' stamp: 'BenjaminVanRyseghem 11/24/2012 00:29'!
drawSelectedBackgroundForItem: item at: index on: aCanvas

	self drawBackgroundForItem: item at: index on: aCanvas color: self selectedBackgroundColor! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 12/13/2012 09:44'!
iconMaxSize

	^ self listSource iconMaxSize! !

!NewListRenderer methodsFor: 'drawing - background' stamp: 'BenjaminVanRyseghem 11/24/2012 00:29'!
drawSecondSelectedItem: item at: index on: aCanvas
	
	self drawBackgroundForItem: item at: index on: aCanvas color: self secondSelectionColor.! !

!NewListRenderer methodsFor: 'drawing - private' stamp: 'BenjaminVanRyseghem 11/24/2012 19:18'!
selectionFrameForItem: item at: index
	"Answer the selection frame rectangle."

	| frame |
	frame := self drawBoundsForItem: item at: index.
	^ self ensureFrame: frame.! !

!NewListRenderer methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:32'!
hasHeader

	^ hasHeader value! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 11/25/2012 01:48'!
secondSelectionColor

	^ self listSource secondSelectionColor! !

!NewListRenderer methodsFor: 'stepping and presenter' stamp: 'BenjaminVanRyseghem 1/28/2013 17:31'!
wantsSteps

	^ wantsSteps! !

!NewListRenderer methodsFor: 'drawing - private' stamp: 'BenjaminVanRyseghem 11/25/2012 02:20'!
updateRectFor: index

	self flag: 'Could be optimized'.
	self listSource changed.
	
	"| item  |
	index isZero
		ifFalse: [
			item := self itemAtIndex: index. 
			self invalidRect:  (self selectionFrameForItem: item at: index) ]"! !

!NewListRenderer methodsFor: 'communication with model' stamp: 'BenjaminVanRyseghem 11/25/2012 15:51'!
dragEnabled

	^ self listSource dragEnabled! !

!NewListRenderer methodsFor: 'drawing - private' stamp: 'IgorStasenko 12/22/2012 03:02'!
ensureFrame: aFrame 
	| frame |
	
	frame := aFrame.	
"??? forgot to use result ??? frame intersect: (self bounds bottom: (self bounds bottom +self headerHeight)). " 
	frame := self bounds: frame in: self listSource.
	frame := self
		bounds: ((frame left: self listSource innerBounds left) right: self listSource innerBounds right)
		from: self listSource. 
	^ frame! !

!NewListRenderer methodsFor: 'events' stamp: 'BenjaminVanRyseghem 5/1/2013 08:42'!
doubleClick: event

	self listSource doubleClick: event! !

!NewListRenderer methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/25/2012 21:16'!
isScrolling

	^ self isStepping! !

!NewListRenderer class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 11/24/2012 00:30'!
on: aNewList

	^ self new
		listSource: aNewList;
		yourself! !

!NewValueHolder commentStamp: 'BenjaminVanRyseghem 1/24/2014 19:04'!
I am a class holding any object inside its unique instance variable. 
Each time the instance variable value changes, an announcement is emitted. 

The instance variable is accessed through `value` and `value:` while the registration is done by `whenChangedDo: aBlock`. 

In addition, infinite loops of propagation are prevented. 
Use case: you have two lists A, and B, and you want to keep their selection synchronised. 
So when A selection changes, you set B selection. 
But since B selection changes, you set A selection, and so on… 

This case is prevented by the use of a `lock` variable.

/ !! \ IMPORTANT / !! \
NewValueHolder will soon be replaced by ReactiveVariable
=============================================
Within Spec itself, NewValueHolder has been renamed to ReactiveVariable (during the beta phase of Pharo 3).
Since Pharo 3 was already in beta, NewValueHolder has been kept untouched.
For new code (and all code in future versions of Pharo), use the following two hook methods:
	asReactiveVariable - use wherever you would have used asValueHolder, which will soon be deprecated. For now, it returns a NewValueHolder. In the future it will return a (polymorphic) ReactiveVariable
	selectionReactiveVariable - as above, returns a SelectionValueHolder for now. This extension method allows the two different packages to coexist without having direct references from the Spec model.!
!NewValueHolder methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 17:00'!
valueChanged
	
	announcer announce: (ValueChanged newValue: value)! !

!NewValueHolder methodsFor: 'announcements' stamp: 'MarcusDenker 9/14/2013 10:28'!
addDependent: aDependent

	self error: 'Former API, should be changed'.! !

!NewValueHolder methodsFor: 'private' stamp: 'BenjaminVanRyseghem 1/23/2014 12:35'!
handleCircularReferencesWhile: aBlock
	"Used to handle circular references as explained in the class comment"

	lock ifTrue: [ ^ self ].
	lock := true.
	
	aBlock ensure: [ lock := false ].! !

!NewValueHolder methodsFor: 'announcements' stamp: 'BenjaminVanRyseghem 10/17/2013 17:01'!
whenChangedDo: aBlock

	| block |
	block := [:announcement :ann | aBlock cull: announcement newValue cull: announcement oldValue cull: announcement cull: ann ].
	announcer when: ValueChanged do: block! !

!NewValueHolder methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 17:02'!
valueChanged: oldValue to: newValue
	
	announcer announce: (ValueChanged oldValue: oldValue newValue: newValue)! !

!NewValueHolder methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 8/20/2012 11:38'!
initialize

	super initialize.
	
	announcer := Announcer new.
	lock := false.! !

!NewValueHolder methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:48'!
value

	^ value! !

!NewValueHolder methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/23/2014 12:34'!
value: anObject
	
	self handleCircularReferencesWhile: [ | oldValue |
		oldValue := value.
		value := anObject.
		self valueChanged: oldValue ].

	^ value! !

!NewValueHolder methodsFor: 'announcements' stamp: 'BernardoContreras 10/23/2014 17:13'!
whenChangedSend: aSelector to: aReceiver

	announcer when: ValueChanged send: aSelector to: aReceiver! !

!NewValueHolder methodsFor: 'printing' stamp: 'BenjaminVanRyseghem 10/17/2013 17:10'!
printOn: aStream
	super printOn: aStream.
	
	aStream 
		nextPutAll: '[ '; 
		print: self value;
		nextPutAll: ' ]'! !

!NewValueHolder methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/29/2014 17:20'!
rawValue: aValue

	value := aValue! !

!NewValueHolder methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 17:02'!
valueChanged: oldValue
	
	announcer announce: (ValueChanged oldValue: oldValue newValue: value)! !

!NewValueHolder methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 6/18/2014 23:27'!
gtInspectorPresentationsIn: composite inContext: aGTInspector
	composite 
		updateOn: Announcement from: announcer.
	super gtInspectorPresentationsIn: composite inContext: aGTInspector! !

!NewValueHolder methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 10/5/2014 21:46'!
gtAnnouncer
	^ announcer! !

!NewValueHolder class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 10/17/2013 16:23'!
value: contents

	^ self new
		value: contents;
		yourself! !

!NewVersionBrowser commentStamp: '<historical>'!
A NewVersionBrowser is a tool made for browsing the several versions of the provided method.!
!NewVersionBrowser methodsFor: 'menu' stamp: 'MarcusDenker 11/3/2014 15:36'!
compareToOtherVersion
	| labels versions index selected |
	versions := self buildChangeList.
	labels := versions collect: [ :version | version stamp ].
	index := UIManager default chooseFrom: labels.
	index > 0
		ifFalse: [ ^ self ].
	selected := versions at: index.
	self compareTo: selected withLabel: selected stamp! !

!NewVersionBrowser methodsFor: 'instance creation' stamp: 'NicolaiHess 12/21/2014 23:11'!
buildBrowser
	| changeList b |

	changeList := self buildChangeList.
	
	self browserForList: changeList.
	
	b := browser
		messages: changeList;
		title: 'Recent versions of ' , rgMethod asString;
		openWithSpec.
		
	self showDiffMorphWithConverter: (DiffMorphChangeRecordConverter 
		methodReference: browser textConverter method 
		referencesList: changeList).
		
	^ b	! !

!NewVersionBrowser methodsFor: 'menu' stamp: 'NicolaiHess 12/21/2014 23:09'!
browseImplementors
	SystemNavigation new browseAllImplementorsOf: rgMethod selector! !

!NewVersionBrowser methodsFor: 'menu' stamp: 'NicolaiHess 12/21/2014 23:12'!
compareToCurrentVersion
	self compareTo: rgMethod withLabel:'current version'! !

!NewVersionBrowser methodsFor: 'instance creation' stamp: 'NicolaiHess 12/21/2014 23:52'!
revert: aChangeRecord
	aChangeRecord 
		ifNil: [self inform: 'nothing selected, so nothing done']
		ifNotNil: [ rgMethod realClass compile: aChangeRecord sourceCode classified: aChangeRecord category withStamp: aChangeRecord stamp notifying:nil].
		
	"reinitialize me"	
	rgMethod := rgMethod realClass >> (rgMethod selector).

	browser 
		messages: self buildChangeList;
		setSelectedIndex: 1.! !

!NewVersionBrowser methodsFor: 'instance creation' stamp: 'NicolaiHess 1/19/2014 17:15'!
showDiffMorphWithConverter: aConverter
	| behavior |
	
	behavior := browser textModel behavior.
	browser instantiateModels: #(textModel DiffModel).
	browser needRebuild: false.
	browser openWithSpec.
	browser textConverter: aConverter.
	browser textModel behavior: behavior! !

!NewVersionBrowser methodsFor: 'instance creation' stamp: 'NicolaiHess 12/21/2014 23:27'!
browseVersionsOf: aMethod

	rgMethod := aMethod asRingDefinition asHistorical.
	^ self buildBrowser! !

!NewVersionBrowser methodsFor: 'instance creation' stamp: 'NicolaiHess 12/21/2014 23:16'!
buildChangeList
	rgMethod sourcePointer ifNil:[^#[]].
		
	^ self
		scanVersionsOf: rgMethod
		class: rgMethod realClass theNonMetaClass
		meta: rgMethod realClass isMeta
		category: rgMethod category
		selector: rgMethod selector.! !

!NewVersionBrowser methodsFor: 'menu' stamp: 'NicolaiHess 12/21/2014 23:19'!
browseSenders
	SystemNavigation new browseSendersOf: rgMethod selector name: 'Senders of ' , rgMethod selector autoSelect: rgMethod selector! !

!NewVersionBrowser methodsFor: 'private' stamp: 'NicolaiHess 1/20/2014 01:55'!
scanVersionsOf: method class: aClass meta: meta category: cat selector: aSelector

	^( ChangeSet scanVersionsOf: method class: aClass meta: meta category: cat selector: aSelector) collectWithIndex:[:c :i | |rg| rg:= c asRingDefinition. rg annotationNamed:#versionIndex put:i ]
! !

!NewVersionBrowser methodsFor: 'menu' stamp: 'NicolaiHess 1/21/2014 09:51'!
compareTo:anOtherVersion withLabel:aLabel
	| diff versions selected|
	selected := browser selectedMessage.
	versions := Array with:anOtherVersion with: (selected).
	diff := DiffModel new.
	diff	title: ('Comparison from {1} to {2}' format:{selected stamp . aLabel}).
	diff text:(DiffMorphChangeRecordConverter 
		methodReference: anOtherVersion 
		referencesList: versions) getText.
      diff openWithSpec.
! !

!NewVersionBrowser methodsFor: 'accessing' stamp: 'NicolaiHess 1/20/2014 00:03'!
browser
	^ browser! !

!NewVersionBrowser methodsFor: 'accessing' stamp: 'GuillermoPolito 3/4/2015 14:38'!
displayStringsFor: aMethodVersion
	| author version cleanStampParts |
	
	"a stamp is a string in the form  'GuillermoPolito 3/4/2015 14:33'"
	"It may be incomplete, empty or even start with spaces."
	cleanStampParts := aMethodVersion stamp trim substrings.
	
	author := cleanStampParts ifEmpty: [ '' ] ifNotEmpty: [ :parts | parts first ].
	version := cleanStampParts ifEmpty: [ '' ] ifNotEmpty: [ :parts | parts allButFirst joinUsing: ' ' ].
	
	^ {author.
	version.
	(aMethodVersion realClass name).
	(aMethodVersion selector).
	('{' , aMethodVersion category , '}')}! !

!NewVersionBrowser methodsFor: 'instance creation' stamp: 'NicolaiHess 12/21/2014 23:17'!
browseVersionsOf: method class: aClass meta: meta category: msgCategory selector: aSelector

	rgMethod := method asRingDefinition asHistorical.
	^ self buildBrowser! !

!NewVersionBrowser methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 10/18/2013 14:51'!
showSourceWithConverter: aConverter
	| behavior |
	
	behavior := browser textModel behavior.
	browser instantiateModels: #(textModel TextModel).
	browser needRebuild: false.
	browser openWithSpec.
	browser textConverter: aConverter.
	browser textModel behavior: behavior! !

!NewVersionBrowser methodsFor: 'instance creation' stamp: 'NicolaiHess 1/21/2014 11:05'!
browserForList: aList

	browser :=  MessageBrowser new.
	browser
		topologicSort: false;
		refreshingBlock: [:m | false];
		sortingBlock: [:a :b | (a annotationNamed:#versionIndex ifAbsent:[0]) < (b annotationNamed:#versionIndex ifAbsent:[0]) ];
		displayBlock: [:changeRecord | self displayStringsFor: changeRecord].
										
	browser toolbarModel
		emptyDropList;
		addItemLabeled: 'Side By Side' do: [ 
			self showDiffMorphWithConverter: (DiffMorphChangeRecordConverter 
				methodReference: browser textConverter method 
				referencesList: aList) ];
		addItemLabeled: 'Source' do: [ 
			self showSourceWithConverter: (SourceMethodConverter method: browser textConverter method) ];
		addItemLabeled: 'Diff' do: [ 
			self showSourceWithConverter: (DiffChangeRecordConverter 
				methodReference: browser textConverter method 
				referencesList: aList) ].
		
	browser toolbarModel versionModel 
		label: 'Revert';
		action: [ self revert: browser selectedItem ].
	browser listModel menu:[:menu | menu addAllFromPragma:'newVersionBrowserListMenu' target:self].
	^ browser.! !

!NewVersionBrowser class methodsFor: 'api' stamp: 'NicolaiHess 12/21/2014 23:28'!
browseVersionsForClass: aClass selector: aSelector 
	| method |
	method := (aClass compiledMethodAt: aSelector) ifNil: [ ^self ].
	
	^ self new
		browseVersionsOf: method
		! !

!NewVersionBrowser class methodsFor: 'tool registry' stamp: 'MarcusDenker 6/27/2014 16:11'!
registerToolsOn: registry
	"Add ourselves to registry. See [Smalltalk tools]" 
	registry register: self as: #versionBrowser
! !

!NewVersionBrowser class methodsFor: 'menu' stamp: 'NicolaiHess 12/13/2014 01:38'!
versionsBrowserListMenu: aBuilder
	<contextMenu>
	<newVersionBrowserListMenu>
	| tool browser model |
	model := aBuilder model.
	browser := aBuilder model browser.
	tool := browser model.
	browser selectedMessage notNil
		ifTrue: [ 
			| message |
			message := browser selectedMessage compiledMethod.
			(aBuilder item: #'Compare to current')
				help: 'Compare selected version to the current version';
				target: model;
				selector: #compareToCurrentVersion.
			(aBuilder item: #'Compare to version...')
				help: 'Compare selected version to another selected version';
				target: model;
				selector: #compareToOtherVersion.
			(aBuilder item: #'Revert to selected version')
				help: 'Resubmit the selected version, so that it becomes the current version';
				action: [ model revert: browser selectedItem ]].
	(aBuilder item: #Senders)
		keyText: 'n';
		help: 'Browse all senders of this selector';
		action: [ model browseSenders ].
	(aBuilder item: #Implementors)
		keyText: 'm';
		help: 'Browse all implementors of this selector';
		action: [ model browseImplementors ];
		withSeparatorAfter ! !

!NoNetworkError commentStamp: 'mir 5/12/2003 18:17'!
Signals that no network was found. This could happen, e.g., on dial-up connection when no connection was established when Squeak tried to access it.

!
!NonBooleanReceiver commentStamp: '<historical>'!
Some constructs are optimized in the compiler :
#whileTrue:
#whileFalse:
#ifTrue:
#ifFalse:
#ifTrue:ifFalse:
#ifFalse:ifTrue:
So you cannot by default use them on non boolean objects.
	
If you really need to use optimized constructs, you can enable Opal compiler and do one of the following :
		- recompile your method with the pragma : <compilerOptions: #(+ optIlineNone)>
		- recompile your class with the method : MyClass class>>compiler 
			^ super compiler options: #(+ optIlineNone)
		- call from this method by Object>>#mustBeBooleanInMagic:"!
!NonBooleanReceiver methodsFor: 'accessing' stamp: 'hmm 7/29/2001 21:30'!
object: anObject
	object := anObject! !

!NonBooleanReceiver methodsFor: 'accessing' stamp: 'hmm 7/29/2001 21:30'!
object
	^object! !

!NonBooleanReceiver methodsFor: 'signaledexception' stamp: 'hmm 7/29/2001 21:37'!
isResumable

	^true! !

!NonInteractiveTranscript commentStamp: '<historical>'!
I am NonInteractiveTranscript, a replacement for Transcript, writing everything to a file or stdout.

This is useful when running headless.

	NonInteractiveTranscript file install.
	
To connect to the output stream of the virtual machine process choose stdout.

	NonInteractiveTranscript stdout install.

or 

	NonInteractiveTranscript stderr install
!
!NonInteractiveTranscript methodsFor: 'streaming' stamp: 'SvenVanCaekenberghe 9/28/2011 19:30'!
ensureCr! !

!NonInteractiveTranscript methodsFor: 'initialize-release' stamp: 'CamilloBruni 10/12/2013 16:40'!
close
	self critical: [ 
		stream ifNotNil: [ 
			(self isStdout or: [ self isStderr ])
				ifTrue: [ stream flush ]
				ifFalse: [ stream close ].
			stream := nil ] ]! !

!NonInteractiveTranscript methodsFor: 'streaming' stamp: 'SvenVanCaekenberghe 9/28/2011 21:23'!
print: anObject
	self nextPutAll: anObject asString! !

!NonInteractiveTranscript methodsFor: 'testing' stamp: 'CamilloBruni 9/13/2013 23:56'!
isStderr
	
	^ fileName = #stderr! !

!NonInteractiveTranscript methodsFor: 'streaming' stamp: 'SvenVanCaekenberghe 9/28/2011 19:30'!
<< anObject
	self show: anObject! !

!NonInteractiveTranscript methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 9/28/2011 21:22'!
initialize
	super initialize.
	accessSemaphore := Mutex new! !

!NonInteractiveTranscript methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/4/2011 17:49'!
fileName
	"The file name that I will write to.
	Lazy initialized to a default.
	When I connect to the standard output stream of the 
	virtual machine process I return #stdout."
	
	^ fileName ifNil: [ fileName := self class defaultLogFileName ]! !

!NonInteractiveTranscript methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/4/2011 17:46'!
isStdout
	"Answer true when I am setup to be connected to the special
	standard output stream of the virtual machine process."
	
	^ fileName = #stdout! !

!NonInteractiveTranscript methodsFor: 'streaming' stamp: 'SvenVanCaekenberghe 9/30/2011 10:19'!
nextPutAll: aCollection
	^ self critical: [ 
		self stream nextPutAll: aCollection ]! !

!NonInteractiveTranscript methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 9/28/2011 19:26'!
printOn: aStream
	self == Transcript ifFalse: [ ^ super printOn: aStream ].
	aStream nextPutAll: 'Transcript'! !

!NonInteractiveTranscript methodsFor: 'streaming' stamp: 'SvenVanCaekenberghe 9/28/2011 20:02'!
show: anObject
	self critical: [
		self 
			print: anObject; 
			endEntry ]! !

!NonInteractiveTranscript methodsFor: 'streaming' stamp: 'SvenVanCaekenberghe 9/30/2011 10:18'!
cr 
	self critical: [ 
		self stream cr ]! !

!NonInteractiveTranscript methodsFor: 'streaming' stamp: 'SvenVanCaekenberghe 9/30/2011 10:19'!
tab 
	^ self critical: [ 
		self stream tab ]! !

!NonInteractiveTranscript methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/30/2011 10:32'!
stream
	"The file stream I am writing to.
	Lazy initialized so as not to create the file when it is not used."
	
	^ stream ifNil: [ self initializeStream ]! !

!NonInteractiveTranscript methodsFor: 'streaming' stamp: 'SvenVanCaekenberghe 9/28/2011 19:29'!
clear! !

!NonInteractiveTranscript methodsFor: 'streaming' stamp: 'SvenVanCaekenberghe 9/28/2011 19:48'!
endEntry
	self flush! !

!NonInteractiveTranscript methodsFor: 'private' stamp: 'SvenVanCaekenberghe 9/28/2011 19:55'!
critical: block
	^ accessSemaphore 
		critical: block ! !

!NonInteractiveTranscript methodsFor: 'streaming' stamp: 'SvenVanCaekenberghe 9/30/2011 10:18'!
nextPut: aCharacter
	^ self critical: [ 
		self stream nextPut: aCharacter ]! !

!NonInteractiveTranscript methodsFor: 'streaming' stamp: 'SvenVanCaekenberghe 9/28/2011 19:29'!
reset! !

!NonInteractiveTranscript methodsFor: 'streaming' stamp: 'SvenVanCaekenberghe 9/30/2011 10:19'!
space 
	^ self critical: [ 
		self stream space ]! !

!NonInteractiveTranscript methodsFor: 'private' stamp: 'MarcusDenker 8/20/2014 10:03'!
stepGlobal
	"ignored"! !

!NonInteractiveTranscript methodsFor: 'installation' stamp: 'SvenVanCaekenberghe 12/4/2011 17:31'!
install
	"Install me as a replacement for Transcript"
	
	Smalltalk globals 
		at: #Transcript 
		put: self! !

!NonInteractiveTranscript methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 7/6/2012 10:42'!
fileName: anObject
	"Initialize me to write to a file stream described by anObject.
	anObject is either a String naming a file or the special #stdout value
	for using the standard output stream of the virtual machine process."
	
	self close.
	fileName := anObject! !

!NonInteractiveTranscript methodsFor: 'streaming' stamp: 'SvenVanCaekenberghe 9/28/2011 20:02'!
crShow: anObject
	self critical: [
		self
			cr; 
			show: anObject ]! !

!NonInteractiveTranscript methodsFor: 'streaming' stamp: 'SvenVanCaekenberghe 9/30/2011 10:18'!
flush
	self critical: [ 
		self stream flush ]! !

!NonInteractiveTranscript methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 9/28/2011 19:26'!
isSelfEvaluating
	self == Transcript ifTrue: [ ^ true ].
	^ super isSelfEvaluating! !

!NonInteractiveTranscript methodsFor: 'private' stamp: 'CamilloBruni 9/13/2013 23:57'!
initializeStream
	"Open the file stream that I write to or connect to #stdout.
	I use the proper line end convention.
	I will append to regular files."
	
	stream := self isStdout 
		ifTrue: [ FileStream stdout ]
		ifFalse: [ 
			self isStderr
				ifTrue: [ FileStream stderr ]
				ifFalse: [ FileStream fileNamed: self fileName ]].
	stream wantsLineEndConversion: true.
	(self isStdout or: [ self isStderr ])
		ifTrue: [ stream converter "Force lazy initialization of converter" ] 
		ifFalse: [ stream setToEnd ].
	^ stream
	! !

!NonInteractiveTranscript class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 12/4/2011 17:34'!
file
	"Create a new NonInteractiveTranscript that will output 
	to the default file named by #defaultLogFileName."
	
	^ self onFileNamed: self defaultLogFileName ! !

!NonInteractiveTranscript class methodsFor: 'class initialization' stamp: 'SvenVanCaekenberghe 7/6/2012 10:46'!
initialize
	"Make sure to cleanup on shutdown"
	
	Smalltalk addToShutDownList: self	! !

!NonInteractiveTranscript class methodsFor: 'system startup' stamp: 'SvenVanCaekenberghe 7/6/2012 10:54'!
shutDown
	"Send close to all our instances.
	Their streams will be reopened on first use later on."
	
	self allInstances do: [ :each | each close ]! !

!NonInteractiveTranscript class methodsFor: 'constants' stamp: 'SvenVanCaekenberghe 9/30/2011 10:29'!
defaultLogFileName
	"The default file name that will be used to write to.
	This should probably become a system setting."
	
	^ 'PharoTranscript.log'! !

!NonInteractiveTranscript class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 12/4/2011 17:33'!
onFileNamed: fileName
	"Create a NonInteractiveTranscript that will write to fileName."
	
	^ self new
		fileName: fileName;
		yourself! !

!NonInteractiveTranscript class methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 7/6/2012 10:43'!
isInstalled
	^ Transcript class = self! !

!NonInteractiveTranscript class methodsFor: 'instance creation' stamp: 'CamilloBruni 9/13/2013 23:57'!
stderr
	"Create a new NonInteractiveTranscript that will output 
	to the special standard error output stream of the virtual machine process."
	
	^ self onFileNamed: #stderr! !

!NonInteractiveTranscript class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 12/4/2011 17:33'!
stdout
	"Create a new NonInteractiveTranscript that will output 
	to the special standard output stream of the virtual machine process."
	
	^ self onFileNamed: #stdout! !

!NonInteractiveUIManager commentStamp: 'IgorStasenko 1/24/2011 15:36'!
This is a non-interactive UI manager, i.e. a UI manager which doesn't provides any kind of interactivity with users.

For most of requests, it throws an ErrorNonInteractive exception, which can be handled by various tools to do things differently when UI is not avaliable. For example:

response := [ UIManager default request: 'what is your name?' ] on: ErrorNonInteractive do: [:ex | ex resume: 'Mr. John Smith' ].

You can replace the default UI Manager with my instance in cases, when you need to guarantee that your task(s) will run in fully automated mode. This is useful for things like:
  - when image runs as a persistent application on a server
  - image runs headless from command-line with some batch scripts/commands

!
!NonInteractiveUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 7/24/2012 16:31'!
chooseOrRequestFrom: labelList values: valueList lines: linesArray title: aString
	 ^ self nonInteractiveWarning: (String streamContents: [ :s|
			s nextPutAll: 'Choice Request: '; nextPutAll: aString; cr.
			labelList with: valueList do: [ :label :value| 
				s tab; nextPutAll: label asString; nextPutAll: ':'; tab; print: value; cr ]])! !

!NonInteractiveUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 7/24/2012 16:12'!
confirm: queryString trueChoice: trueChoice falseChoice: falseChoice 
	^  self nonInteractiveRequest: queryString! !

!NonInteractiveUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 7/24/2012 16:18'!
chooseFrom: labelList values: valueList lines: linesArray title: aString
	"Choose an item from the given list. Answer the selected item."
	^ self chooseOrRequestFrom: labelList values: valueList lines: linesArray title: aString! !

!NonInteractiveUIManager methodsFor: 'errors' stamp: 'IgorStasenko 1/24/2011 10:34'!
nonInteractive: anException
	^ ErrorNonInteractive signalForException: anException! !

!NonInteractiveUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 7/24/2012 16:02'!
request: queryString initialAnswer: defaultAnswer
	^ self request: queryString initialAnswer: defaultAnswer title: nil entryCompletion: nil. ! !

!NonInteractiveUIManager methodsFor: 'events' stamp: 'CamilloBruni 7/24/2012 16:05'!
onDebug: process context: context title: title full: bool

	^ self nonInteractiveWarning: 'Opening Debugger'! !

!NonInteractiveUIManager methodsFor: 'default actions' stamp: 'IgorStasenko 1/24/2011 14:37'!
fileExistsDefaultAction: anException

	^ self nonInteractive: anException ! !

!NonInteractiveUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 7/24/2012 16:10'!
multiLineRequest: queryString initialAnswer: defaultAnswer answerHeight: answerHeight
	^  self nonInteractiveRequest: queryString! !

!NonInteractiveUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 7/24/2012 16:02'!
request: aStringOrText initialAnswer: defaultAnswer title: aTitle
	^ self request: aStringOrText initialAnswer: defaultAnswer title: aTitle entryCompletion: nil. ! !

!NonInteractiveUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 2/21/2012 02:05'!
syntaxErrorNotificationDefaultAction: aSyntaxErrorNotification
	
	"display and log the syntax error"
	super syntaxErrorNotificationDefaultAction: aSyntaxErrorNotification.
	
	"in noninteractive mode simply quit"
	^ self exitFailure! !

!NonInteractiveUIManager methodsFor: 'events' stamp: 'FernandoOlivero 3/16/2012 16:24'!
onSnapshot: resuming
	"The resuming argument is true when image boots from disk,
	and false, if user just did an image snapshot."
	
	resuming ifTrue: [
		Smalltalk isHeadless ifFalse: [
			"restore old, or nil, so it will be set in #default "
			uiManager beDefault.  
			UIManager default onSnapshot: resuming.
			^ self ].
		Smalltalk isInteractive ifTrue: [
			"use a headless but interactive manager"
			^ self headlessManager onSnapshot: resuming ]].
	
	
	" this flag set to true only if we are saving a snapshot before quitting "
	doNotQuitOnRestart ifTrue: [
		Smalltalk snapshot: false andQuit: true].! !

!NonInteractiveUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 7/24/2012 16:12'!
confirm: aString orCancel: cancelBlock
	^  self nonInteractiveRequest: aString! !

!NonInteractiveUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 7/24/2012 16:06'!
fontFromUser: priorFont	
	^self nonInteractiveWarning: 'Font Choose Request'! !

!NonInteractiveUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 7/24/2012 16:10'!
request: aStringOrText initialAnswer: defaultAnswer title: aTitle entryCompletion: anEntryCompletion
	(ProvideAnswerNotification signal: aStringOrText)
		ifNotNil: [:answer | 
			^ answer = #default ifTrue: [ defaultAnswer ] ifFalse: [ answer ]].
		
	^ self nonInteractiveRequest: aStringOrText title: aTitle! !

!NonInteractiveUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 7/24/2012 16:12'!
confirm: queryString trueChoice: trueChoice falseChoice: falseChoice cancelChoice: cancelChoice default: aSymbol
	^  self nonInteractiveRequest: queryString! !

!NonInteractiveUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 7/24/2012 16:12'!
confirm: queryString label: titleString
	^  self nonInteractiveRequest: queryString title: titleString! !

!NonInteractiveUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 7/24/2012 16:12'!
confirm: queryString
	(ProvideAnswerNotification signal: queryString) ifNotNil: [:answer |
		^ answer].
	
	^  self nonInteractiveWarning: 'Confirming: ', queryString! !

!NonInteractiveUIManager methodsFor: 'errors' stamp: 'IgorStasenko 1/21/2011 16:25'!
nonInteractive
	^ ErrorNonInteractive signal! !

!NonInteractiveUIManager methodsFor: 'errors' stamp: 'EstebanLorenzano 10/28/2014 15:05'!
nonInteractiveWarning: aWarnMessage
	^ ProvideAnswerNotification signal: aWarnMessage! !

!NonInteractiveUIManager methodsFor: 'errors' stamp: 'CamilloBruni 7/24/2012 16:11'!
nonInteractiveRequest: aStringOrText
	^ self nonInteractiveRequest: aStringOrText title: nil! !

!NonInteractiveUIManager methodsFor: '*Morphic-Base' stamp: 'IgorStasenko 1/25/2011 17:57'!
currentWorld

	" err.. we should probably prohibit this message.. but lets play nice"
	
	uiManager ifNotNil: [ ^ uiManager currentWorld ].
	
	ActiveWorld ifNotNil: [^ActiveWorld].
	^World! !

!NonInteractiveUIManager methodsFor: 'default actions' stamp: 'MarcusDenker 9/10/2013 12:12'!
lowSpaceWatcherDefaultAction: preemptedProcess
	| ctx |
	"yeah.. space is low.. quit!!!! :)"
	
	ctx := preemptedProcess ifNotNil: [  preemptedProcess suspendedContext ].
	ctx ifNil: [ ctx := thisContext sender ]. 
	self quitFrom: ctx withMessage: 'Low space signal received.'.
	
	self error. "what else we can do? "! !

!NonInteractiveUIManager methodsFor: 'errors' stamp: 'CamilloBruni 7/24/2012 16:09'!
nonInteractiveRequest: aStringOrText title: aTitle
	 ^ self nonInteractiveWarning: (String streamContents: [ :s|
			s nextPutAll: 'Interactive Request: '.
			aTitle ifNotNil: [ s nextPutAll: '[ '; nextPutAll: aTitle asString; nextPutAll: ' ] ' ].
			s nextPutAll: aStringOrText asString.
		])! !

!NonInteractiveUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 7/24/2012 16:08'!
edit: aText label: labelString accept: anAction
	"Open an editor on the given string/text"
	^self nonInteractiveWarning: (String streamContents: [ :s |
		s  nextPutAll: 'Editing Text: '.
		labelString ifNotNil: [ s nextPutAll: '[ '; nextPutAll: labelString; nextPutAll: ' ] '].
		s cr; nextPutAll: aText])! !

!NonInteractiveUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 7/24/2012 16:18'!
chooseFrom: aList lines: linesArray title: aString
	"Choose an item from the given list. Answer the index of the selected item."
	^ self chooseOrRequestFrom: aList values: aList lines: linesArray title: aString! !

!NonInteractiveUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 7/24/2012 15:56'!
requestPassword: queryString
	^self nonInteractiveWarning: 'Requesting Password'.! !

!NonInteractiveUIManager methodsFor: 'default actions' stamp: 'IgorStasenko 1/24/2011 10:33'!
fileDoesNotExistsDefaultAction: anException

	^ self nonInteractive: anException ! !

!NonInteractiveUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 7/24/2012 16:19'!
chooseFullFileNameMatching: patterns label: labelString
	"Let the user choose a file matching the given patterns"
	^ self nonInteractiveWarning: (String streamContents: [ :s|
			s 
				nextPutAll: 'Interactive File Choice Request: ';
				nextPutAll: '[ '; nextPutAll: labelString asString; nextPutAll: ' ] ';
				print: patterns.
		])! !

!NonInteractiveUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 7/24/2012 16:20'!
chooseFileMatching: patterns label: labelString
	"Let the user choose a file matching the given patterns"
	^ self chooseFullFileNameMatching: patterns label: labelString! !

!NonInteractiveUIManager methodsFor: '*Deprecated40' stamp: 'MarcusDenker 10/7/2014 11:08'!
request: queryString initialAnswer: defaultAnswer centerAt: aPoint
	"Create an instance of me whose question is queryString with the given initial answer. Answer the string the user accepts. Answer the empty string if the user cancels."
	
	self 
		deprecated: 'Use #request:initialAnswer: instead'
		on: 	'7 October 2014' 
		in: 'UIManager'.
	^ self request: queryString initialAnswer: defaultAnswer title: nil entryCompletion: nil. ! !

!NonInteractiveUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 7/24/2012 16:02'!
request: queryString initialAnswer: defaultAnswer entryCompletion: anEntryCompletion
	^ self request: queryString initialAnswer: defaultAnswer title: nil entryCompletion: anEntryCompletion. ! !

!NonInteractiveUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 7/24/2012 16:21'!
chooseDirectory: label from: dir
	"Let the user choose a directory"
	^ self nonInteractiveWarning: (String streamContents: [ :s|
			s 
				nextPutAll: 'Interactive Directory Choice Request: ';
				nextPutAll: '[ '; nextPutAll: label asString; nextPutAll: ' ] from '; print: dir
		])! !

!NonInteractiveUIManager methodsFor: 'non-interactive' stamp: 'CamilloBruni 2/13/2012 19:02'!
nonInteractiveManager
	" Answer an instance of non-interactive manager, which will be used when image runs headless.
	  We put it here, so subclasses can override it. 
	
	We already non-interactive. Just answer self
	"
	^ self! !

!NonReentrantWeakMessageSend commentStamp: 'LaurentLaffont 4/15/2011 20:18'!
NonReentrantWeakMessageSend does what it says, while the message is being executed, additional evaluations will be discarded.
It's used by when:sendOnce:to: protocol from Polymorph events, but unused in the base image.
when:send:to:exclusive: is used one place though.

It's useful when objects are mutually registered to each other's events, but the actions may lead to the others action being triggered.
Examples are 
- two lists whose contents update based on the selection in the other
- The DiffMorph (Uses ExclusiveWeakMessageSend)

ExclusiveWeakMessageSend are used when the decision whether to process an event is shared between multiple objects.
IE 2 objects respond to different events, but if received simultaneously, only the first of them should have it's action executed.

With Announcement, the corresponding functionality to non-reentrancy would be achieved using:
VW - AnnouncementCollection>>suspendWhile:  anActionBlock
Pharo - Announcer >> suspend: aSubscriber while: anActionBlock (As we neither have a specific AnnouncementCollection class, nor access to Registry itself. Not implemented yet though :P)

The shared state required to achieve Exclusivity would probably have to recide outside of the framework.!
!NonReentrantWeakMessageSend methodsFor: 'initialization' stamp: 'gvc 10/25/2006 18:04'!
initialize
	"Initialize the receiver."

	super initialize.
	self executing: false! !

!NonReentrantWeakMessageSend methodsFor: 'evaluating' stamp: 'gvc 10/24/2006 11:42'!
value
	"Answer the superclass value or nil if already executing."

	^self execute: [super value]! !

!NonReentrantWeakMessageSend methodsFor: 'evaluating' stamp: 'gvc 10/24/2006 11:56'!
valueWithArguments: anArray
	"Answer the superclass value or nil if already executing."

	^self execute: [super valueWithArguments: anArray]! !

!NonReentrantWeakMessageSend methodsFor: 'evaluating' stamp: 'gvc 10/24/2006 11:56'!
valueWithEnoughArguments: anArray
	"Answer the superclass value or nil if already executing."

	^self execute: [super valueWithEnoughArguments: anArray]! !

!NonReentrantWeakMessageSend methodsFor: 'accessing' stamp: 'gvc 10/25/2006 18:03'!
executing
	"Answer the value of executing"

	^ executing! !

!NonReentrantWeakMessageSend methodsFor: 'testing' stamp: 'gvc 10/25/2006 18:15'!
isValid
	"Answer the superclass vlaue of isValid or false if
	executing is true."

	^self executing
		ifTrue: [false]
		ifFalse: [super isValid]! !

!NonReentrantWeakMessageSend methodsFor: 'evaluating' stamp: 'gvc 10/25/2006 18:03'!
execute: aBlock
	"Answer the value of the block or nil if already executing."

	self executing ifTrue: [^nil].
	self executing: true.
	^aBlock ensure: [self executing: false]! !

!NonReentrantWeakMessageSend methodsFor: 'accessing' stamp: 'gvc 10/25/2006 18:03'!
executing: anObject
	"Set the value of executing"

	executing := anObject! !

!NotFound commentStamp: 'SvenVanCaekenberghe 4/18/2011 14:32'!
I am NotFound, an exception to indicate that something is not found in a collection.
I am an Error and thus Exception.

Typically, the thing not found is in my object instance variable.
The collection where this thing was not found is in my inherited signaler instance variable.

[ NotFound signalFor: 10 in: #(1 2 3) ] on: NotFound do: [ :exception | exception ]!
!NotFound methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/18/2011 14:30'!
object: anObject
	"Set the object that was not found"
	
	object := anObject! !

!NotFound methodsFor: 'private' stamp: 'nice 12/2/2011 23:35'!
standardMessageText
	"Generate a standard textual description"
	
	^ String streamContents: [ :stream |
		stream print: self object.
		stream << ' not found in '.
		stream print: self collection class ]! !

!NotFound methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/18/2011 14:29'!
object
	"Return the object that was not found"
	
	^ object! !

!NotFound methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/18/2011 14:27'!
collection: aCollection
	"Set the collection where something is not found in"
	
	self signaler: aCollection! !

!NotFound methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/18/2011 14:27'!
collection
	"Return the collection where something is not found in"
	
	^ self signaler! !

!NotFound methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/18/2011 14:35'!
messageText
	"Overwritten to initialiaze the message text to a standard text if it has not yet been set"
	
	^ messageText ifNil: [ messageText := self standardMessageText ]! !

!NotFound class methodsFor: 'instance creation' stamp: 'MartinDias 10/23/2013 14:47'!
signalFor: anObject
	"Create and signal a NotFound exception for anObject in the default receiver."
	
	^ self new
		object: anObject;
		signal! !

!NotFound class methodsFor: 'instance creation' stamp: 'MartinDias 10/23/2013 14:47'!
signalFor: anObject in: aCollection
	"Create and signal a NotFound exception for anObject in aCollection."

	^ self new
		object: anObject;
		collection: aCollection;
		signal! !

!NotYetImplemented commentStamp: '<historical>'!
I am NotYetImplement, an exception signaled when a method is a stub for code that will be implemented in the future.

This is used in incremental development, for example when doing Test First development.
It is similar to ShouldBeImplemented, with a slightly different meaning.!
!NotYetImplemented methodsFor: 'printing' stamp: 'MarcusDenker 5/24/2012 10:08'!
standardMessageText
	"Generate a standard textual description"
	
	^ String streamContents: [ :stream |
		stream print: self selector.
		stream << ' is not yet implemented in '.
		stream print: self signaler class]! !

!Notification commentStamp: '<historical>'!
A Notification is an indication that something interesting has occurred.  If it is not handled, it will pass by without effect.!
!Notification methodsFor: 'exceptiondescription' stamp: 'pnm 8/16/2000 15:04'!
defaultAction
	"No action is taken. The value nil is returned as the value of the message that signaled the exception."

	^nil! !

!NullCanvas commentStamp: '<historical>'!
A canvas which ignores all drawing commands.!
!NullCanvas methodsFor: 'accessing' stamp: 'ls 3/20/2000 21:12'!
form
	^Form extent: self extent! !

!NullCanvas methodsFor: 'accessing' stamp: 'ls 3/20/2000 21:11'!
extent
	^100@100! !

!NullCanvas methodsFor: 'accessing' stamp: 'ls 3/20/2000 21:13'!
origin
	^0@0! !

!NullCanvas methodsFor: 'drawing-support' stamp: 'ls 3/27/2000 21:39'!
transformBy: aDisplayTransform clippingTo: aClipRect during: aBlock smoothing: cellSize
	"do this in order that timing runs work better"
	aBlock value: self! !

!NullCanvas methodsFor: 'accessing' stamp: 'ls 3/20/2000 21:11'!
clipRect
	^1@1 extent: 99@99! !

!NullCanvas methodsFor: 'drawing-support' stamp: 'ls 3/27/2000 21:40'!
translateBy: delta during: aBlock
	"do this in order that timing runs work better"
	aBlock value: self! !

!NullCanvas methodsFor: 'copying' stamp: 'ls 3/20/2000 21:26'!
copyClipRect: clipRect
	"who cares what the clipping rectangle is?"
	^self! !

!NullCanvas methodsFor: 'drawing-support' stamp: 'ls 3/27/2000 21:41'!
clipBy: region during: aBlock
	"do this in order that timing runs work better"
	aBlock value: self! !

!NullSound commentStamp: 'TorstenBergmann 2/5/2014 10:29'!
The NullSound means silence !
!NullSound class methodsFor: 'playing' stamp: 'gvc 7/30/2009 17:55'!
play
	"Do nothing for the null sound."! !

!NullSoundTheme commentStamp: 'TorstenBergmann 2/5/2014 10:30'!
A silent sound theme!
!NullSoundTheme methodsFor: 'initialize-release' stamp: 'gvc 7/30/2009 17:56'!
defaultDefaultSound
	"Answer the default default sound!!"

	^NullSound! !

!NullSoundTheme class methodsFor: 'as yet unclassified' stamp: 'gvc 7/30/2009 17:57'!
themeName
	"Answer the friendly name of the theme."

	^'No Sounds'! !

!NullStream commentStamp: '<historical>'!
I am a stream that does nothing i.e. generates and consumes an infinite number of elements (NullObject pattern). I can be used as an equivalent of /dev/null (for example 
a logging in off mode) or for performance benchmarks.!
!NullStream methodsFor: 'positioning' stamp: 'StephaneDucasse 3/13/2010 11:08'!
skip: anInteger 
	"Set the receiver's position to be the current position+anInteger. A 
	subclass might choose to be more helpful and select the minimum of the 
	receiver's size and position+anInteger, or the maximum of 1 and 
	position+anInteger for the repositioning."

	self position: position + anInteger! !

!NullStream methodsFor: 'accessing' stamp: 'StephaneDucasse 3/13/2010 11:05'!
element
	"The element returned by the stream"

	^binary ifTrue: [0] ifFalse: [Character value: 0]! !

!NullStream methodsFor: 'accessing' stamp: 'StephaneDucasse 3/13/2010 11:05'!
binary
	"Switches the stream to binary mode"

	binary := true! !

!NullStream methodsFor: 'reading' stamp: 'StephaneDucasse 3/13/2010 11:07'!
nextInto: aCollection
	"Read the next elements of the receiver into aCollection.
	Return aCollection or a partial copy if less than aCollection
	size elements have been read."

	^self next: aCollection size into: aCollection startingAt: 1.! !

!NullStream methodsFor: 'accessing' stamp: 'StephaneDucasse 3/13/2010 11:05'!
collectionSpecies
	"The type of collection returned by the stream"

	^binary ifTrue: [ByteArray] ifFalse: [ByteString]! !

!NullStream methodsFor: 'reading' stamp: 'StephaneDucasse 3/13/2010 11:06'!
next
	"Answer the next object accessible by the receiver."

	position := position + 1.
	^self element! !

!NullStream methodsFor: 'reading' stamp: 'StephaneDucasse 3/13/2010 11:06'!
next: n into: aCollection
	"Read n objects into the given collection.
	Return aCollection or a partial copy if less than
	n elements have been read."

	^self next: n into: aCollection startingAt: 1! !

!NullStream methodsFor: 'testing' stamp: 'ClementBera 7/29/2013 14:37'!
isBinary
	"Return true if the receiver is a binary byte stream"

	^binary ! !

!NullStream methodsFor: 'reading' stamp: 'StephaneDucasse 3/13/2010 11:07'!
nextInto: aCollection startingAt: startIndex
	"Read the next elements of the receiver into aCollection.
	Return aCollection or a partial copy if less than aCollection
	size elements have been read."

	^self next: (aCollection size - startIndex +1) into: aCollection startingAt: startIndex.! !

!NullStream methodsFor: 'positioning' stamp: 'StephaneDucasse 3/13/2010 11:08'!
position: anInteger 
	"Set the current position for accessing the objects to be anInteger, as long 
	as anInteger is within the bounds of the receiver's contents. If it is not, 
	create an error notification."

	(anInteger >= 0)
		ifTrue: [position := anInteger]
		ifFalse: [self positionError]! !

!NullStream methodsFor: 'initialization' stamp: 'StephaneDucasse 3/13/2010 11:06'!
initialize
	"Initialize the receiver"

	binary := false.
	position := 0.! !

!NullStream methodsFor: 'reading' stamp: 'DamienCassou 3/27/2014 16:51'!
peekLast
	^ lastElement! !

!NullStream methodsFor: 'printing' stamp: 'MilanMimica 11/4/2011 21:22'!
printOn: aStream
	aStream nextPutAll: 'a '; nextPutAll: self class name.! !

!NullStream methodsFor: 'writing' stamp: 'DamienCassou 3/27/2014 17:20'!
nextPutAll: aCollection
	"Append the elements of aCollection to the sequence of objects accessible 
	by the receiver. Answer aCollection."

	position := position + aCollection size.
	aCollection isEmpty
		ifFalse: [ lastElement := aCollection last ].
	^ aCollection! !

!NullStream methodsFor: 'accessing' stamp: 'StephaneDucasse 3/13/2010 11:04'!
ascii
	"Switches the stream to ascii mode"

	binary := false.! !

!NullStream methodsFor: 'writing' stamp: 'DamienCassou 3/27/2014 16:53'!
cr
	^ self nextPut: Character cr! !

!NullStream methodsFor: 'writing' stamp: 'StephaneDucasse 3/13/2010 11:08'!
peek
	"Answer what would be returned if the message next were sent to the 
	receiver. If the receiver is at the end, answer nil."

	^self element! !

!NullStream methodsFor: 'writing' stamp: 'DamienCassou 3/27/2014 17:15'!
tab
	^ self nextPut: Character tab! !

!NullStream methodsFor: 'writing' stamp: 'DamienCassou 3/27/2014 16:53'!
lf
	^ self nextPut: Character lf! !

!NullStream methodsFor: 'testing' stamp: 'StephaneDucasse 3/13/2010 11:05'!
isEmpty
	"Answer whether the receiver's contents has no elements."

	^false
! !

!NullStream methodsFor: 'writing' stamp: 'DamienCassou 3/27/2014 16:54'!
nextPut: anObject 
	"Insert the argument, anObject, as the next object accessible by the 
	receiver. Answer anObject."

	position := position + 1.
	lastElement := anObject.
	^anObject! !

!NullStream methodsFor: 'writing' stamp: 'StephaneDucasse 3/13/2010 11:07'!
next: anInteger putAll: aCollection
	"Store the next anInteger elements from the given collection."

	^self next: anInteger putAll: aCollection startingAt: 1! !

!NullStream methodsFor: 'testing' stamp: 'StephaneDucasse 3/13/2010 11:05'!
atEnd
	"Answer whether the receiver can access any more objects."

	^false! !

!NullStream methodsFor: 'positioning' stamp: 'StephaneDucasse 3/13/2010 11:08'!
reset
	"Set the receiver's position to the beginning of the sequence of objects."

	position := 0! !

!NullStream methodsFor: 'reading' stamp: 'StephaneDucasse 3/13/2010 11:06'!
next: anInteger 
	"Answer the next anInteger elements of my collection. Must override 
	because default uses self contents species, which might involve a large 
	collection."

	position := position + anInteger.
	^self collectionSpecies new: anInteger! !

!NullStream methodsFor: 'writing' stamp: 'DamienCassou 3/27/2014 17:15'!
space
	^ self nextPut: Character space! !

!NullStream methodsFor: 'positioning' stamp: 'StephaneDucasse 3/13/2010 11:08'!
position
	"Answer the current position of accessing the sequence of objects."

	^position! !

!NullStream methodsFor: 'writing' stamp: 'DamienCassou 3/27/2014 17:02'!
next: anInteger putAll: aCollection startingAt: startIndex
	"Store the next anInteger elements from the given collection."

	position := position + anInteger.
	lastElement := aCollection at: anInteger + startIndex - 1.
	^aCollection! !

!NullStream methodsFor: 'reading' stamp: 'StephaneDucasse 3/13/2010 11:07'!
next: n into: aCollection startingAt: startIndex
	"Read n objects into the given collection. 
	Return aCollection or a partial copy if less than
	n elements have been read."

	position := position + n.
	^aCollection! !

!NullStream methodsFor: 'accessing' stamp: 'StephaneDucasse 3/13/2010 11:05'!
contents
	"Answer all of the contents of the receiver."

	self shouldNotImplement! !

!NullStream methodsFor: 'reading' stamp: 'SvenVanCaekenberghe 4/26/2011 09:19'!
readInto: collection startingAt: startIndex count: n
	"Read n objects into the given collection. 
	Return number of elements that have been read."

	position := position + n.
	^ n! !

!NullStream class methodsFor: 'instance creation' stamp: 'StephaneDucasse 3/13/2010 11:09'!
new
	"Creates a new instance"

	^self basicNew initialize! !

!NullStreamTest methodsFor: 'tests' stamp: 'DamienCassou 3/27/2014 17:21'!
testNextPutAllEmpty
	self assert: stream position equals: 0.
	self assert: stream peekLast equals: nil.
	stream nextPutAll: ''.
	self assert: stream position equals: 0.
	self assert: stream peekLast equals: nil.! !

!NullStreamTest methodsFor: 'tests' stamp: 'DamienCassou 3/27/2014 17:14'!
testPeekLast
	self assert: stream peekLast equals: nil.
	stream nextPut: $a.
	self assert: stream peekLast equals: $a.
	stream nextPutAll: 'bcd'.
	self assert: stream peekLast equals: $d.
	stream cr.
	self assert: stream peekLast equals: Character cr.
	stream lf.
	self assert: stream peekLast equals: Character lf.
	stream space.
	self assert: stream peekLast equals: Character space.
	stream tab.
	self assert: stream peekLast equals: Character tab.
	stream next: 4 putAll: 'abcdefgh' startingAt: 3.
	self assert: stream peekLast equals: $f.! !

!NullStreamTest methodsFor: 'tests' stamp: 'DamienCassou 3/27/2014 17:18'!
testCounting
	| expectedPosition |
	expectedPosition := 0.
	self assert: stream position equals: expectedPosition.
	
	stream nextPut: $a.
	expectedPosition := expectedPosition + 1.
	self assert: stream position equals: expectedPosition.
	
	stream nextPutAll: 'bcd'.
	expectedPosition := expectedPosition + 3.
	self assert: stream position equals: expectedPosition.
	
	stream cr.
	expectedPosition := expectedPosition + 1.
	self assert: stream position equals: expectedPosition.
	
	stream lf.
	expectedPosition := expectedPosition + 1.
	self assert: stream position equals: expectedPosition.
	
	stream space.
	expectedPosition := expectedPosition + 1.
	self assert: stream position equals: expectedPosition.
	
	stream tab.
	expectedPosition := expectedPosition + 1.
	self assert: stream position equals: expectedPosition.
	
	stream next: 4 putAll: 'abcdefgh' startingAt: 3.
	expectedPosition := expectedPosition + 4.
	self assert: stream position equals: expectedPosition.! !

!NullStreamTest methodsFor: 'running' stamp: 'DamienCassou 3/27/2014 16:46'!
setUp
	super setUp.
	stream := NullStream new.! !

!NullTaskList commentStamp: 'SeanDeNigris 1/23/2014 11:53'!
I stand in when the task list is not open in the world.!
!NullTaskList methodsFor: 'private' stamp: 'SeanDeNigris 1/22/2014 19:56'!
world: aWorldMorph 

	world := aWorldMorph.! !

!NullTaskList methodsFor: 'event handling' stamp: 'SeanDeNigris 1/23/2014 12:00'!
handleEvent: aKeyboardEvent 

	aKeyboardEvent isWindowNavigation ifFalse: [ ^ false ].
	world theme openTaskListIn: world from: aKeyboardEvent.
	^ true.! !

!NullTaskList class methodsFor: 'instance creation' stamp: 'SeanDeNigris 1/22/2014 19:56'!
in: world

	^ self new
		world: world;
		yourself.! !

!NullTextStyler commentStamp: 'BenjaminVanRyseghem 8/1/2010 22:53'!
This class is a styler NullObject!
!NullTextStyler methodsFor: 'formatting' stamp: 'BenjaminVanRyseghem 8/1/2010 14:26'!
format: aText
	^aText! !

!NullTextStyler methodsFor: 'accessing' stamp: 'AlainPlantec 5/11/2011 11:03'!
workspace: aWorkspace
! !

!NullTextStyler methodsFor: 'private' stamp: 'AlainPlantec 9/19/2011 19:32'!
stylingEnabled
	^ false! !

!NullTextStyler methodsFor: 'accessing' stamp: 'AlainPlantec 8/27/2011 14:15'!
environment: anObject
! !

!NullTextStyler methodsFor: 'accessing' stamp: 'AlainPlantec 5/11/2011 11:02'!
view: aViewOrMorph

! !

!NullTextStyler methodsFor: 'styling' stamp: 'BenjaminVanRyseghem 8/1/2010 14:27'!
style: aText! !

!NullTextStyler methodsFor: 'styling' stamp: 'StephaneDucasse 8/10/2010 12:35'!
unstyledTextFrom: aText
	^aText! !

!NullTextStyler methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 8/2/2010 16:17'!
classOrMetaClass: aBehavior! !

!NullTextStyler methodsFor: 'styling' stamp: 'AlainPlantec 5/11/2011 10:36'!
styleInBackgroundProcess: aText
! !

!NullTextStyler methodsFor: 'private' stamp: 'AlainPlantec 9/19/2011 19:32'!
stylingEnabled: aBoolean
! !

!NullTextStyler methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 8/2/2010 16:17'!
font: aFont! !

!Number commentStamp: '<historical>'!
Class Number holds the most general methods for dealing with numbers. Subclasses Float, Fraction, and Integer, and their subclasses, provide concrete representations of a numeric quantity.

All of Number's subclasses participate in a simple type coercion mechanism that supports mixed-mode arithmetic and comparisons.  It works as follows:  If
	self<typeA> op: arg<typeB>
fails because of incompatible types, then it is retried in the following guise:
	(arg adaptTypeA: self) op: arg adaptToTypeA.
This gives the arg of typeB an opportunity to resolve the incompatibility, knowing exactly what two types are involved.  If self is more general, then arg will be converted, and viceVersa.  This mechanism is extensible to any new number classes that one might wish to add to Pharo.  The only requirement is that every subclass of Number must support a pair of conversion methods specific to each of the other subclasses of Number.

Implementation notes
----------------------------------
The implementation of #degreeCos and #degreeSin is such that results are exact for any multiple of 90.

Care is also taken to evaluate the sine between -90° and 90°, this will avoid #degreesToRadians and i386 FPU sine function to accumulate round off errors due to approximate representation of pi.
We can thus evaluate 240 degreeCos with at most 1 ulp error. It's not perfect, but better than previous implementation.

For cosine, we know that:
	cosd(x)=cosd(abs(x))
	cosd(x)=sind(90-x)
thus the trick is to evaluate:
	cosd(x)=sind(90-abs(x)) after appropriate modulo in [-180,180[
This way, we are sure to evaluate the sine between -90° and 90°
The #degreesToRadians and #sin are used rather than #degreeSin to avoid cycles.

For sine, it would be necessary to evaluate either
sind(x) if abs(x) <=90
or sind(180-x) if abs(x) >= 90
A possible implementation would be:
	| x |
	x := 90 + self \\ 360 - 90.
	x >= 180 ifTrue: [x := 180 - x].
	^x degreesToRadians sin
We prefer evaluating cosd(90-x) thus providing a branch free implementation.!
!Number methodsFor: 'testing' stamp: 'di 4/23/1998 11:02'!
strictlyPositive
	"Answer whether the receiver is mathematically positive."

	^ self > 0! !

!Number methodsFor: 'converting' stamp: 'SeanDeNigris 3/19/2015 11:03'!
percent

	^ self / 100! !

!Number methodsFor: '*Kernel-Chronology' stamp: 'tbn 10/24/2012 15:32'!
hour
 
 	^ self hours! !

!Number methodsFor: 'mathematical functions' stamp: 'CamilloBruni 7/10/2012 22:24'!
** exponent 
	" A shortcut methog for raisedTo: "
	^ self raisedTo: exponent! !

!Number methodsFor: 'intervals' stamp: 'tao 1/30/1999 08:58'!
to: stop by: step do: aBlock 
	"Normally compiled in-line, and therefore not overridable.
	Evaluate aBlock for each element of the interval (self to: stop by: 
step)."
	| nextValue |
	nextValue := self.
	step = 0 ifTrue: [self error: 'step must be non-zero'].
	step < 0
		ifTrue: [[stop <= nextValue]
				whileTrue: 
					[aBlock value: nextValue.
					nextValue := nextValue + step]]
		ifFalse: [[stop >= nextValue]
				whileTrue: 
					[aBlock value: nextValue.
					nextValue := nextValue + step]]! !

!Number methodsFor: 'mathematical functions' stamp: 'jmv 10/13/2011 08:36'!
nthRoot: aPositiveInteger
	"Answer the nth root of the receiver."

	self subclassResponsibility! !

!Number methodsFor: 'mathematical functions' stamp: 'nice 10/31/2010 22:03'!
degreeCos
	"Answer the cosine of the receiver taken as an angle in degrees."
	
	^ (90 - (180 + self \\ 360 - 180) abs) degreesToRadians sin! !

!Number methodsFor: 'intervals' stamp: ''!
to: stop by: step
	"Answer an Interval from the receiver up to the argument, stop, 
	incrementing by step."

	^Interval from: self to: stop by: step! !

!Number methodsFor: 'arithmetic' stamp: ''!
\\ aNumber 
	"modulo. Remainder defined in terms of //. Answer a Number with the 
	same sign as aNumber. e.g. 9\\4 = 1, -9\\4 = 3, 9\\-4 = -3, 0.9\\0.4 = 0.1."

	^self - (self // aNumber * aNumber)! !

!Number methodsFor: 'testing' stamp: 'tao 10/10/97 16:36'!
isNaN
	^ false! !

!Number methodsFor: 'converting' stamp: 'ar 5/20/2001 01:40'!
asB3DVector3
	^self@self@self! !

!Number methodsFor: 'printing' stamp: 'nice 3/29/2011 21:48'!
printOn: aStream showingDecimalPlaces: placesDesired
	"Print a representation of the receiver on aStream in decimal notation with prescribed number of places after decimal separator."

	| rounder rounded roundedFractionPart |
	placesDesired <= 0 ifTrue: [^ self rounded printOn: aStream].
	rounder := 10 raisedToInteger: placesDesired.
	rounded := self roundTo: rounder reciprocal.
	rounded negative ifTrue: [aStream nextPut: $-].
	rounded := rounded abs.
	rounded integerPart truncated printOn: aStream.
	aStream nextPut: $..
	roundedFractionPart := (rounded fractionPart * rounder) truncated.
	roundedFractionPart printOn: aStream base: 10 length: placesDesired padded: true! !

!Number methodsFor: 'arithmetic' stamp: ''!
// aNumber 
	"Integer quotient defined by division with truncation toward negative 
	infinity. 9//4 = 2, -9//4 = -3. -0.9//0.4 = -3. \\ answers the remainder 
	from this division."

	^(self / aNumber) floor! !

!Number methodsFor: '*Kernel-Chronology' stamp: 'tbn 10/29/2012 15:12'!
second
 
 	^ self seconds
 ! !

!Number methodsFor: 'mathematical functions' stamp: 'jsp 2/24/1999 15:20'!
arcTan: denominator
	"The receiver is the tangent of an angle. Answer the angle measured in 
	radians."

	^(self asFloat) arcTan: denominator.! !

!Number methodsFor: 'intervals' stamp: ''!
to: stop
	"Answer an Interval from the receiver up to the argument, stop, 
	incrementing by 1."

	^Interval from: self to: stop by: 1! !

!Number methodsFor: 'arithmetic' stamp: ''!
negated
	"Answer a Number that is the negation of the receiver."

	^0 - self! !

!Number methodsFor: 'mathematical functions' stamp: ''!
exp
	"Answer the exponential of the receiver as a floating point number."

	^self asFloat exp! !

!Number methodsFor: '*Kernel-Chronology' stamp: 'tbn 10/29/2012 16:00'!
milliSecond
 
 	^ self milliSeconds
 ! !

!Number methodsFor: 'converting' stamp: 'di 11/6/1998 13:45'!
adaptToString: rcvr andSend: selector
	"If I am involved in arithmetic with a String, convert it to a Number."
	^ rcvr asNumber perform: selector with: self! !

!Number methodsFor: 'converting' stamp: 'nice 5/16/2009 22:46'!
asScaledDecimal: scale 
	"Answer the receiver converted to a ScaledDecimal."
	
	^ ScaledDecimal newFromNumber: self scale: scale! !

!Number methodsFor: 'truncation and round off' stamp: 'StephaneDucasse 5/8/2010 17:14'!
fractionPart
	"Added for ANSI compatibility"
	^self - self integerPart! !

!Number methodsFor: 'mathematical functions' stamp: ''!
sign
	"Answer 1 if the receiver is greater than 0, -1 if less than 0, else 0."

	self > 0 ifTrue: [^1].
	self < 0 ifTrue: [^-1].
	^0! !

!Number methodsFor: 'arithmetic' stamp: ''!
+ aNumber 
	"Answer the sum of the receiver and aNumber."

	self subclassResponsibility! !

!Number methodsFor: 'mathematical functions' stamp: ''!
tan
	"The receiver represents an angle measured in radians. Answer its 
	tangent."

	^self asFloat tan! !

!Number methodsFor: 'converting' stamp: ''!
asInteger
	"Answer an Integer nearest the receiver toward zero."

	^self truncated! !

!Number methodsFor: 'converting' stamp: ''!
degreesToRadians
	"The receiver is assumed to represent degrees. Answer the conversion to 
	radians."

	^self asFloat degreesToRadians! !

!Number methodsFor: 'mathematical functions' stamp: ''!
log: aNumber 
	"Answer the log base aNumber of the receiver."

	^self ln / aNumber ln! !

!Number methodsFor: 'printing' stamp: 'laza 3/29/2004 12:53'!
printOn: aStream
	self printOn: aStream base: 10! !

!Number methodsFor: 'mathematical functions' stamp: 'Janniklaval 10/23/2010 13:47'!
sign: aNumber
 	"Return a Number with the same sign as aNumber"
 
 	^ aNumber copySignTo: self.! !

!Number methodsFor: 'printing' stamp: 'laza 3/30/2004 10:50'!
printString
	^self printStringBase: 10! !

!Number methodsFor: 'converting' stamp: 'dtl 9/25/2004 11:47'!
asScaledDecimal
	"Answer a scaled decimal number approximating the receiver."
	#Numeric.

	^ self asScaledDecimal: 8
! !

!Number methodsFor: 'converting' stamp: 'nice 1/4/2009 20:31'!
adaptToFloat: rcvr andCompare: selector 
	"If I am involved in comparison with a Float, convert rcvr to a
	Fraction. This way, no bit is lost and comparison is exact."
	
	rcvr isFinite
		ifFalse: [
			selector == #= ifTrue: [^false].
			selector == #~= ifTrue: [^true].
			rcvr isNaN ifTrue: [^ false].
			(selector = #< or: [selector = #'<='])
				ifTrue: [^ rcvr positive not].
			(selector = #> or: [selector = #'>='])
				ifTrue: [^ rcvr positive].
			^self error: 'unknow comparison selector'].

	^ rcvr asTrueFraction perform: selector with: self! !

!Number methodsFor: 'truncation and round off' stamp: 'GabrielOmarCotelli 5/26/2009 21:57'!
integerPart
	"Added for ANSI compatibility"
	^self truncated! !

!Number methodsFor: '*Kernel-Chronology' stamp: 'tbn 10/29/2012 16:07'!
minute
 
 	^ self minutes
 ! !

!Number methodsFor: '*Kernel-Chronology' stamp: 'brp 5/16/2003 07:56'!
days
 
 	^ Duration days: self! !

!Number methodsFor: 'converting' stamp: 'di 11/6/1998 13:44'!
adaptToPoint: rcvr andSend: selector
	"If I am involved in arithmetic with a Point, convert me to a Point."
	^ rcvr perform: selector with: self@self! !

!Number methodsFor: 'truncation and round off' stamp: 'di 10/4/1999 08:08'!
roundTo: quantum 
	"Answer the nearest number that is a multiple of quantum."

	^(self / quantum) rounded * quantum! !

!Number methodsFor: '*monticellofiletree-core' stamp: 'dkh 4/6/2012 15:56:14'!
writeCypressJsonOn: aStream forHtml: forHtml indent: startIndent
    "by default ignore <forHtml> ... <forHtml> is used for Dictionary and Array, i.e., container objects and String which actually encodes itself differently for HTML"

    aStream nextPutAll: self printString! !

!Number methodsFor: 'mathematical functions' stamp: 'nice 10/31/2010 22:01'!
degreeSin
	"Answer the sine of the receiver taken as an angle in degrees."
	
	^(90 - self) degreeCos! !

!Number methodsFor: 'mathematical functions' stamp: 'jmv 10/11/2011 08:34'!
sqrt
	"Answer the square root of the receiver."

	self subclassResponsibility! !

!Number methodsFor: 'printing' stamp: 'laza 3/29/2004 12:50'!
storeOn: aStream 
	self printOn: aStream! !

!Number methodsFor: 'testing' stamp: 'di 4/23/1998 11:18'!
negative
	"Answer whether the receiver is mathematically negative."

	^ self < 0! !

!Number methodsFor: 'printing' stamp: 'sw 7/1/1998 12:33'!
stringForReadout
	^ self rounded printString! !

!Number methodsFor: 'mathematical functions' stamp: 'jmv 10/13/2011 08:50'!
raisedTo: aNumber 
	"Answer the receiver raised to aNumber."

	aNumber isInteger ifTrue: [
		"Do the special case of integer power"
		^ self raisedToInteger: aNumber].
	aNumber isFraction ifTrue: [
		"Special case for fraction power"
		^ (self nthRoot: aNumber denominator) raisedToInteger: aNumber numerator ].
	self < 0 ifTrue: [
		^ ArithmeticError signal: 'Negative numbers can''t be raised to float powers.' ].
	0 = aNumber ifTrue: [^ self class one].	"Special case of exponent=0"
	1 = aNumber ifTrue: [^ self].	"Special case of exponent=1"
	0 = self ifTrue: [				"Special case of self = 0"
		aNumber < 0
			ifTrue: [^ (ZeroDivide dividend: self) signal]
			ifFalse: [^ self]].
	^ (aNumber * self ln) exp		"Otherwise use logarithms"! !

!Number methodsFor: 'printing' stamp: 'nice 9/25/2007 02:35'!
storeOn: aStream base: base
	"This method should print a representation of the number for the given base,
	including the base prefix (with letter r for radix)"
	
	^self subclassResponsibility! !

!Number methodsFor: 'printing' stamp: 'nice 3/29/2011 21:39'!
printShowingDecimalPlaces: placesDesired
	"Print the receiver showing precisely the given number of places desired.  If placesDesired is positive, a decimal point and that many digits after the decimal point will always be shown.  If placesDesired is zero, a whole number will be shown, without a decimal point."

	^String new: placesDesired + 10 streamContents: [:aStream |
		self printOn: aStream showingDecimalPlaces: placesDesired]
"
23 printShowingDecimalPlaces: 2
23.5698 printShowingDecimalPlaces: 2
-234.567 printShowingDecimalPlaces: 5
23.4567 printShowingDecimalPlaces: 0
23.5567 printShowingDecimalPlaces: 0
-23.4567 printShowingDecimalPlaces: 0
-23.5567 printShowingDecimalPlaces: 0
100000000 printShowingDecimalPlaces: 1
0.98 printShowingDecimalPlaces: 5
-0.98 printShowingDecimalPlaces: 2
2.567 printShowingDecimalPlaces: 2
-2.567 printShowingDecimalPlaces: 2
0 printShowingDecimalPlaces: 2
"! !

!Number methodsFor: 'mathematical functions' stamp: 'ar 8/31/2000 20:05'!
interpolateTo: aNumber at: param
	^self + (aNumber - self * param)! !

!Number methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 3/8/2012 08:20'!
asFloat
	"Answer a floating-point number approximating the receiver."

	self subclassResponsibility! !

!Number methodsFor: '*Kernel-Chronology' stamp: 'brp 5/16/2003 08:52'!
nanoSeconds
 
 	^ Duration nanoSeconds: self.! !

!Number methodsFor: 'truncation and round off' stamp: 'di 2/19/98 21:58'!
detentBy: detent atMultiplesOf: grid snap: snap
	"Map all values that are within detent/2 of any multiple of grid to that multiple.  Otherwise, if snap is true, return self, meaning that the values in the dead zone will never be returned.  If snap is false, then expand the range between dead zones so that it covers the range between multiples of the grid, and scale the value by that factor."
	| r1 r2 |
	r1 := self roundTo: grid.  "Nearest multiple of grid"
	(self roundTo: detent) = r1 ifTrue: [^ r1].  "Snap to that multiple..."
	snap ifTrue: [^ self].  "...or return self"

	r2 := self < r1  "Nearest end of dead zone"
		ifTrue: [r1 - (detent asFloat/2)]
		ifFalse: [r1 + (detent asFloat/2)].
	"Scale values between dead zones to fill range between multiples"
	^ r1 + ((self - r2) * grid asFloat / (grid - detent))
"
	(170 to: 190 by: 2) collect: [:a | a detentBy: 10 atMultiplesOf: 90 snap: true] 	(170 to: 190 by: 2) collect: [:a | a detentBy: 10 atMultiplesOf: 90 snap: false]
	(3.9 to: 4.1 by: 0.02) collect: [:a | a detentBy: 0.1 atMultiplesOf: 1.0 snap: true] 	(-3.9 to: -4.1 by: -0.02) collect: [:a | a detentBy: 0.1 atMultiplesOf: 1.0 snap: false]
"! !

!Number methodsFor: 'converting' stamp: 'di 11/6/1998 13:44'!
adaptToInteger: rcvr andSend: selector
	"If I am involved in arithmetic with a Integer, convert us and evaluate exprBlock."
	^ self subclassResponsibility! !

!Number methodsFor: '*Kernel-Chronology' stamp: 'tbn 10/29/2012 16:23'!
year
 
 	^self years! !

!Number methodsFor: 'arithmetic' stamp: ''!
* aNumber 
	"Answer the result of multiplying the receiver by aNumber."

	self subclassResponsibility! !

!Number methodsFor: 'testing' stamp: ''!
isNumber
	^ true! !

!Number methodsFor: '*Kernel-Chronology' stamp: 'CamilloBruni 6/22/2012 21:48'!
asSeconds
	^ Duration milliSeconds: self * 1000! !

!Number methodsFor: 'arithmetic' stamp: ''!
rem: aNumber 
	"Remainder defined in terms of quo:. Answer a Number with the same 
	sign as self. e.g. 9 rem: 4 = 1, -9 rem: 4 = -1. 0.9 rem: 0.4 = 0.1."

	^self - ((self quo: aNumber) * aNumber)! !

!Number methodsFor: 'converting' stamp: 'di 11/6/1998 13:43'!
adaptToCollection: rcvr andSend: selector
	"If I am involved in arithmetic with a Collection, return a Collection of
	the results of each element combined with me in that expression."

	^ rcvr collect: [:element | element perform: selector with: self]! !

!Number methodsFor: 'mathematical functions' stamp: 'GabrielOmarCotelli 5/26/2009 19:49'!
raisedToInteger: anInteger

	"The 0 raisedToInteger: 0 is an special case. In some contexts must be 1 and in others must
	be handled as an indeterminate form.
	I take the first context because that's the way that was previously handled.
	Maybe further discussion is required on this topic."
	
	|bitProbe result|

	anInteger negative ifTrue: [^(self raisedToInteger: anInteger negated) reciprocal].
	bitProbe := 1 bitShift: anInteger highBit - 1.
 	result := self class one.
  	[
		(anInteger bitAnd: bitProbe) = 0 ifFalse: [result := result * self].
       bitProbe := bitProbe bitShift: -1.
		bitProbe > 0 ]
	whileTrue: [result := result * result].
	
	^result! !

!Number methodsFor: '*Kernel-Chronology' stamp: 'tbn 10/29/2012 16:23'!
nanoSecond
 
 	^ self nanoSeconds
 ! !

!Number methodsFor: 'truncation and round off' stamp: 'AlexandreBergel 8/21/2011 17:45'!
ceiling
       "Answer the integer nearest the receiver toward  infinity."

       | truncation |
       truncation := self truncated.
       self <= 0 ifTrue: [ ^ truncation ].
       ^ self = truncation
               ifTrue: [ truncation ]
               ifFalse: [ truncation + 1 ]! !

!Number methodsFor: 'converting' stamp: ''!
radiansToDegrees
	"The receiver is assumed to represent radians. Answer the conversion to 
	degrees."

	^self asFloat radiansToDegrees! !

!Number methodsFor: '*Kernel-Chronology' stamp: 'md 8/28/2013 15:37'!
asDuration
 
 	^ Duration seconds: self asInteger
 ! !

!Number methodsFor: 'converting' stamp: ''!
asPoint
	"Answer a Point with the receiver as both coordinates; often used to 
	supply the same value in two dimensions, as with symmetrical gridding 
	or scaling."

	^self @ self! !

!Number methodsFor: 'converting' stamp: 'di 11/6/1998 13:44'!
adaptToFraction: rcvr andSend: selector
	"If I am involved in arithmetic with a Fraction, convert us and evaluate exprBlock."
	^ self subclassResponsibility! !

!Number methodsFor: 'converting' stamp: 'nice 10/5/2009 21:28'!
asSmallPositiveDegrees
	"Return the receiver normalized to lie within the range (0, 360)"

	^self \\ 360! !

!Number methodsFor: 'mathematical functions' stamp: 'CamilloBruni 7/13/2012 17:37'!
% aNumber 
	"modulo. Remainder defined in terms of //. Answer a Number with the 
	same sign as aNumber. e.g. 9\\4 = 1, -9\\4 = 3, 9\\-4 = -3, 0.9\\0.4 = 0.1."
	^ self \\ aNumber! !

!Number methodsFor: 'converting' stamp: ''!
@ y 
	"Primitive. Answer a Point whose x value is the receiver and whose y 
	value is the argument. Optional. No Lookup. See Object documentation 
	whatIsAPrimitive."

	<primitive: 18>
	^Point x: self y: y! !

!Number methodsFor: 'truncation and round off' stamp: 'CamilloBrui 7/8/2011 12:17'!
roundDownTo: aNumber
	"Answer the next multiple of aNumber toward negative infinity that is nearest the receiver. 
	Examples:
               3.1479 roundDownTo: 0.01 -> 3.14
               3.1479 roundDownTo: 0.1 -> 3.1
               1923 roundDownTo: 10 -> 1920
               3.1479 roundDownTo: 0.005 -> 3.145
               -3.1479 roundDownTo: 0.01 -> -3.15"
	
	^(self / aNumber) floor * aNumber! !

!Number methodsFor: 'arithmetic' stamp: ''!
abs
	"Answer a Number that is the absolute value (positive magnitude) of the 
	receiver."

	self < 0
		ifTrue: [^self negated]
		ifFalse: [^self]! !

!Number methodsFor: '*Kernel-Chronology' stamp: 'brp 5/16/2003 07:56'!
hours
 
 	^ Duration hours: self! !

!Number methodsFor: 'mathematical functions' stamp: ''!
arcTan
	"The receiver is the tangent of an angle. Answer the angle measured in 
	radians."

	^self asFloat arcTan! !

!Number methodsFor: 'mathematical functions' stamp: ''!
sin
	"The receiver represents an angle measured in radians. Answer its sine."

	^self asFloat sin! !

!Number methodsFor: 'mathematical functions' stamp: ''!
squared
	"Answer the receiver multipled by itself."

	^self * self! !

!Number methodsFor: 'mathematical functions' stamp: 'nice 12/11/2012 19:18'!
floorLog: radix
	"Answer the floor of the log base radix of the receiver."

	^(self log: radix) floor! !

!Number methodsFor: 'converting' stamp: 'di 11/6/1998 13:21'!
adaptToFloat: rcvr andSend: selector 
	"If I am involved in arithmetic with a Float, convert me to a Float."
	^ rcvr perform: selector with: self asFloat! !

!Number methodsFor: 'mathematical functions' stamp: 'di 9/8/1998 17:10'!
log
	"Answer the base-10 log of the receiver."

	^self asFloat log! !

!Number methodsFor: 'arithmetic' stamp: 'GabrielOmarCotelli 5/23/2009 20:20'!
reciprocal
	"Returns the reciprocal of self.
	In case self is 0 the / signals ZeroDivide"
	
	^1 / self! !

!Number methodsFor: '*Kernel-Chronology' stamp: 'brp 9/25/2003 13:16'!
milliSeconds
 
 	^ Duration milliSeconds: self
 ! !

!Number methodsFor: 'testing' stamp: 'di 4/23/1998 11:17'!
positive
	"Answer whether the receiver is positive or equal to 0. (ST-80 protocol).
	See also strictlyPositive"

	^ self >= 0! !

!Number methodsFor: 'printing' stamp: ''!
printStringBase: base
	^ String streamContents:
		[:strm | self printOn: strm base: base]! !

!Number methodsFor: '*Kernel-Chronology' stamp: 'tbn 10/29/2012 15:51'!
day
 
 	^ self days! !

!Number methodsFor: 'printing' stamp: ''!
storeStringBase: base
	^ String streamContents: [:strm | self storeOn: strm base: base]! !

!Number methodsFor: 'testing' stamp: ''!
odd
	"Answer whether the receiver is an odd number."

	^self even == false! !

!Number methodsFor: 'truncation and round off' stamp: ''!
rounded
	"Answer the integer nearest the receiver."

	^(self + (self sign / 2)) truncated! !

!Number methodsFor: 'arithmetic' stamp: ''!
/ aNumber 
	"Answer the result of dividing the receiver by aNumber."

	self subclassResponsibility! !

!Number methodsFor: '*Kernel-Chronology' stamp: 'brp 5/16/2003 07:56'!
minutes
 
 	^ Duration minutes: self! !

!Number methodsFor: '*Kernel-Chronology' stamp: 'brp 5/16/2003 07:57'!
seconds
 
 	^ Duration seconds: self! !

!Number methodsFor: 'arithmetic' stamp: 'CamilloBruni 7/13/2012 19:09'!
quo: aNumber 
	"Integer quotient defined by division with truncation toward zero. 
	
	-9 quo: 4 = -2.
	-0.9 quo: 0.4 = -2. 
	
	rem: answers the remainder from this division."

	^(self / aNumber) truncated! !

!Number methodsFor: 'comparing' stamp: 'nice 12/26/2009 18:46'!
closeTo: num
	"are these two numbers close?"

	num isFloat ifTrue: [^ num closeTo: self asFloat].
	^[self = num] ifError: [false]! !

!Number methodsFor: 'mathematical functions' stamp: ''!
arcCos 
	"The receiver is the cosine of an angle. Answer the angle measured in 
	radians."

	^self asFloat arcCos! !

!Number methodsFor: 'truncation and round off' stamp: ''!
floor
	"Answer the integer nearest the receiver toward negative infinity."

	| truncation |
	truncation := self truncated.
	self >= 0 ifTrue: [^truncation].
	self = truncation
		ifTrue: [^truncation]
		ifFalse: [^truncation - 1]! !

!Number methodsFor: 'arithmetic' stamp: ''!
- aNumber 
	"Answer the difference between the receiver and aNumber."

	self subclassResponsibility! !

!Number methodsFor: 'converting' stamp: 'nice 4/23/2011 02:25'!
withNegativeSign
	"Answer a number with same magnitude than receiver and negative sign."
	^self abs negated! !

!Number methodsFor: 'mathematical functions' stamp: ''!
cos
	"The receiver represents an angle measured in radians. Answer its cosine."

	^self asFloat cos! !

!Number methodsFor: 'intervals' stamp: ''!
to: stop do: aBlock 
	"Normally compiled in-line, and therefore not overridable.
	Evaluate aBlock for each element of the interval (self to: stop by: 1)."
	| nextValue |
	nextValue := self.
	[nextValue <= stop]
		whileTrue: 
			[aBlock value: nextValue.
			nextValue := nextValue + 1]! !

!Number methodsFor: 'truncation and round off' stamp: ''!
truncated
	"Answer an integer nearest the receiver toward zero."

	^self quo: 1! !

!Number methodsFor: 'truncation and round off' stamp: ''!
reduce
    "If self is close to an integer, return that integer"
    ^ self! !

!Number methodsFor: 'printing' stamp: 'nice 9/25/2007 02:36'!
printOn: aStream base: base
	"This method should print a representation of the number for the given base,
	excluding the base prefix (and the letter r for radix)"
	
	^self subclassResponsibility! !

!Number methodsFor: 'truncation and round off' stamp: 'CamilloBrui 7/8/2011 12:17'!
truncateTo: aNumber 
	"Answer the next multiple of aNumber toward zero that is nearest the receiver.
	Examples:
               3.1479 truncateTo: 0.01 -> 3.14
               3.1479 truncateTo: 0.1 -> 3.1
               1923 truncateTo: 10 -> 1920
               3.1479 truncateTo: 0.005 -> 3.145
               -3.1479 truncateTo: 0.01 -> -3.14"

	^(self quo: aNumber) * aNumber! !

!Number methodsFor: 'converting' stamp: 'sw 2/16/1999 18:15'!
asNumber
	^ self! !

!Number methodsFor: 'mathematical functions' stamp: ''!
ln
	"Answer the natural log of the receiver."

	^self asFloat ln! !

!Number methodsFor: 'testing' stamp: 'sw 12/30/1998 13:21'!
isDivisibleBy: aNumber
	aNumber = 0 ifTrue: [^ false].
	aNumber isInteger ifFalse: [^ false].
	^ (self \\ aNumber) = 0! !

!Number methodsFor: 'truncation and round off' stamp: 'CamilloBrui 7/8/2011 12:17'!
roundUpTo: aNumber 
	"Answer the next multiple of aNumber toward infinity that is nearest the receiver.
	Examples:
               3.1479 roundUpTo: 0.01 -> 3.15
               3.1479 roundUpTo: 0.1 -> 3.2
               1923 roundUpTo: 10 -> 1930
               3.1479 roundUpTo: 0.005 -> 3.15
               -3.1479 roundUpTo: 0.01 -> -3.14"

	^(self / aNumber) ceiling * aNumber! !

!Number methodsFor: 'converting' stamp: 'sw 9/8/97 16:30'!
asSmallAngleDegrees
	"Return the receiver normalized to lie within the range (-180, 180)"

	| pos |
	pos := self \\ 360.
	pos > 180 ifTrue: [pos := pos - 360].
	^ pos

"#(-500 -300 -150 -5 0 5 150 300 500 1200) collect: [:n | n asSmallAngleDegrees]"! !

!Number methodsFor: 'mathematical functions' stamp: ''!
arcSin
	"The receiver is the sine of an angle. Answer the angle measured in 
	radians."

	^self asFloat arcSin! !

!Number methodsFor: '*Kernel-Chronology' stamp: 'brp 5/16/2003 07:57'!
weeks
 
 	^ Duration weeks: self! !

!Number methodsFor: 'mathematical functions' stamp: 'nice 4/23/2011 02:26'!
copySignTo: aNumber
	"Return a number with same magnitude as aNumber and same sign as self."

	^ self positive
		ifTrue: [aNumber abs]
		ifFalse: [aNumber withNegativeSign].! !

!Number methodsFor: '*Kernel-Chronology' stamp: 'CamilloBruni 9/22/2012 10:48'!
years
 
 	^ Duration years: self! !

!Number methodsFor: 'testing' stamp: 'tao 4/19/98 23:33'!
isInfinite

	^ false! !

!Number methodsFor: 'testing' stamp: ''!
even
	"Answer whether the receiver is an even number."

	^self \\ 2 = 0! !

!Number methodsFor: '*Morphic-Base' stamp: 'cb 6/25/2013 13:24'!
defaultLabel
	"Answer the default label to be used for an Inspector window on the receiver."

	^ super defaultLabel, ': ', self printString! !

!Number methodsFor: 'truncation and round off' stamp: 'GuillermoPolito 6/22/2012 14:49'!
round: numberOfWishedDecimal
	self subclassResponsibility! !

!Number methodsFor: 'converting' stamp: 'StephaneDucasse 9/7/2013 13:10'!
asMargin
	^ Margin fromNumber: self.! !

!Number methodsFor: 'testing' stamp: ''!
isZero
	^self = 0! !

!Number methodsFor: '*Kernel-Chronology' stamp: 'tbn 10/29/2012 15:15'!
week
 
 	^ self weeks
 ! !

!Number class methodsFor: '*AST-Core-Parser' stamp: 'YuriyTymchuk 10/29/2013 11:10'!
squeezeNumberOutOfString: stringOrStream
	"Try and find a number in this string. First, look if the string 
	starts with a number. Then, see if it ends with a number. Then,
	remove a character from the front and see if the remaining 
	string makes a number. Repeat the process until no characters
	are left or the number has been found. As soon as a number is
	found, it is returned. Otherwise, the method fails."
	^ NumberParser squeezeNumberOutOfString: stringOrStream! !

!Number class methodsFor: '*AST-Core-Parser' stamp: 'YuriyTymchuk 10/29/2013 11:14'!
readFrom: stringOrStream 
	"Answer a number as described on aStream.  The number may
	be any accepted Smalltalk literal Number format.
	It can include a leading radix specification, as in 16rFADE.
	It can as well be NaN, Infinity or -Infinity for conveniency.
	If stringOrStream does not start with a valid number description, fail."
	
	^(NumberParser on: stringOrStream) nextNumber! !

!Number class methodsFor: '*AST-Core-Parser' stamp: 'YuriyTymchuk 10/29/2013 11:10'!
squeezeNumberOutOfString: stringOrStream ifFail: aBlock
	"Try and find a number in this string. First, look if the string 
	starts with a number. Then, see if it ends with a number. Then,
	remove a character from the front and see if the remaining 
	string makes a number. Repeat the process until no characters
	are left or the number has been found. As soon as a number is
	found, it is returned. Otherwise, the method fails."
	^ NumberParser squeezeNumberOutOfString: stringOrStream onError: aBlock! !

!Number class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:09'!
gtExampleFourtyTwo
	<gtExample: '42'>
	^ 42! !

!Number class methodsFor: '*AST-Core-Parser' stamp: 'MarcusDenker 11/15/2013 10:54'!
readFrom: stringOrStream ifFail: aBlock
	"Answer a number as described on aStream.  The number may
	be any accepted Smalltalk literal Number format.
	It can include a leading radix specification, as in 16rFADE.
	It can as well be NaN, Infinity or -Infinity for conveniency.
	If input does not represent a valid number, then execute fail block
	and leave the stream positioned before offending character"
	
	^(NumberParser on: stringOrStream) failBlock: aBlock; nextNumber! !

!Number class methodsFor: 'deprecated' stamp: 'dtl 7/3/2006 17:41'!
readExponent: baseValue base: base from: aStream
	"Complete creation of a number, reading exponent from aStream. Answer the
	number, or nil if parsing fails.
	<number>(e|d|q)<exponent>>"

	| sign exp value |
	('edq' includes: aStream next) ifFalse: [^ nil].
	sign := ((aStream peek) == $-)
		ifTrue: [aStream next. -1]
		ifFalse: [1].
	(aStream atEnd or: [(aStream peek digitValue between: 0 and: 9) not])
		ifTrue: [^ nil]. "Avoid throwing an error"
	exp := (Integer readFrom: aStream base: 10) * sign.
	value := baseValue * (base raisedTo: exp).
	^ value
! !

!Number class methodsFor: 'deprecated' stamp: 'CamilloBruni 8/1/2012 16:14'!
readRemainderOf: integerPart from: aStream base: base withSign: sign 
	"Read optional fractional part and exponent or decimal scale, and return the final result"
	"Number readFrom: '3r-22.2'"

	| value fractionDigits fracpos fractionPart fraction pos v foundDecimal |
	value := integerPart.
	fractionDigits := 0.
	foundDecimal := false.
	(aStream peekFor: $.)
		ifTrue: ["<integer>.<fraction>"
			foundDecimal := true.
			(aStream atEnd not
					and: [aStream peek digitValue between: 0 and: base - 1])
				ifTrue: [fracpos := aStream position.
					fractionPart := Integer readFrom: aStream base: base.
					fraction := fractionPart asFloat
								/ (base raisedTo: aStream position - fracpos).
					fractionDigits := aStream position - fracpos.
					value := value asFloat + fraction]].

	pos := aStream position.
	(v := self readScaledDecimal: integerPart
			fractionPart: fractionPart
			digits: fractionDigits
			base: base
			sign: sign
			from: aStream)
		ifNil: [aStream position: pos]
		ifNotNil: [^ v "<number>s<scale>>"].

	pos := aStream position.
	(v := self readExponent: value base: base from: aStream)
		ifNil: [aStream position: pos.
			(foundDecimal and: [fractionDigits = 0])
				ifTrue: ["oops - just <integer>."
							aStream skip: -1.
							"un-gobble the period"
							^ value * sign]]
		ifNotNil: [value := v "<number>(e|d|q)<exponent>>"].

	(value isFloat
			and: [value = 0.0
					and: [sign = -1]])
		ifTrue: [^ Float negativeZero]
		ifFalse: [^ value * sign]! !

!Number class methodsFor: '*Tools' stamp: 'SeanDeNigris 5/28/2013 17:48'!
canonicalArgumentName

	^ 'aNumber'.! !

!Number class methodsFor: 'constants' stamp: 'GabrielOmarCotelli 5/23/2009 20:46'!
one

	^1! !

!Number class methodsFor: '*AST-Core-Parser' stamp: 'YuriyTymchuk 10/29/2013 11:10'!
readFrom: stringOrStream base: base
	"Answer a number as described on aStream in the given number base.
	If stringOrStream does not start with a valid number description, answer 0 for backward compatibility. This is not clever and should better be changed."

	^(NumberParser on: stringOrStream) nextNumberBase: base! !

!Number class methodsFor: '*System-Settings-Browser' stamp: 'alain.plantec 3/18/2009 15:09'!
settingInputWidgetForNode: aSettingNode
	^ aSettingNode inputWidgetForNumber! !

!Number class methodsFor: 'deprecated' stamp: 'ClementBera 7/26/2013 16:28'!
readScaledDecimal: integerPart fractionPart: fractionPart digits: fractionDigits base: base sign: sign from: aStream 
	"Complete creation of a ScaledDecimal, reading scale from aStream. Answer
	a ScaledDecimal, or nil if parsing fails.
	<number>s[<scale>]"

	| scale decimalMultiplier decimalFraction |
	aStream atEnd ifTrue: [^ nil].
	(aStream next == $s) ifFalse: [^ nil].
	"<number>s<scale>"
	(aStream atEnd not and: [aStream peek digitValue between: 0 and: 9])
		ifTrue: [scale := Integer readFrom: aStream]
		ifFalse: [^ nil].
	scale 
		ifNil: ["<number>s"
			fractionDigits = 0
				ifTrue: ["<integer>s"
					scale := 0]
				ifFalse: ["<integer>.<fraction>s"
					scale := fractionDigits]].
	fractionPart 
		ifNil: [^integerPart * sign asScaledDecimal: scale]
		ifNotNil: [decimalMultiplier := base raisedTo: fractionDigits.
			decimalFraction := integerPart * decimalMultiplier + fractionPart * sign / decimalMultiplier.
			^decimalFraction asScaledDecimal: scale]! !

!NumberParser commentStamp: 'nice 2/13/2010 00:31'!
NumberParser is an abstract class for parsing and building numbers from string/stream.
It offers a framework with utility methods and exception handling.

Number syntax is not defined and should be subclassResponsibility.

Instance variables:
sourceStream <Stream> the stream of characters from which the number is read
base <Integer> the radix in which to interpret digits
neg <Boolean> true in case of minus sign
integerPart <Integer> the integer part of the number
fractionPart <Integer> the fraction part of the number if any
exponent <Integer> the exponent used in scientific notation if any
scale <Integer> the scale used in case of ScaledDecimal number if any
nDigits <Integer> number of digits read to form an Integer
lasNonZero <Integer> position of last non zero digit, starting at 1 from left, 0 if all digits are zero
requestor <?> could eventually be used to insert an error message in a text editor
failBlock <BlockClosure> Block to execute whenever an error occurs!
!NumberParser methodsFor: 'accessing' stamp: 'YuriyTymchuk 10/29/2013 11:08'!
exponentLetters
	"answer the list of possible exponents for Numbers.
	Note: this parser will not honour precision attached to the exponent.
	different exponent do not lead to different precisions.
	only IEEE 754 floating point numbers will be created"
	
	^'edq'! !

!NumberParser methodsFor: 'parsing-private' stamp: 'nice 10/7/2009 01:40'!
makeScaledDecimalWithNumberOfNonZeroFractionDigits: numberOfNonZeroFractionDigits andNumberOfTrailingZeroInFractionPart: numberOfTrailingZeroInFractionPart
	"at this point integerPart fractionPart and scale have been read out (in inst var).
	Form a ScaledDecimal.
	Care of eliminating trailing zeroes from the fractionPart"
	
	| decimalMultiplier decimalFraction |
	decimalMultiplier := base raisedToInteger: numberOfNonZeroFractionDigits.
	decimalFraction := integerPart * decimalMultiplier + (fractionPart // (base raisedTo: numberOfTrailingZeroInFractionPart)) / decimalMultiplier.
	neg
		ifTrue: [decimalFraction := decimalFraction negated].
	^decimalFraction asScaledDecimal: scale! !

!NumberParser methodsFor: 'error' stamp: 'nice 2/25/2010 02:39'!
expected: aString 
	| errorString |
	errorString := aString , ' expected'.
	requestor isNil
		ifFalse: [requestor
				notify: errorString
				at: sourceStream position + 1
				in: sourceStream].
	failBlock ifNotNil: [^failBlock cull: errorString cull: sourceStream position + 1].
	self error: 'Reading a number failed: ' , errorString! !

!NumberParser methodsFor: 'parsing-large int' stamp: 'nice 3/15/2010 00:14'!
nextElementaryLargeIntegerBase: aRadix
	"Form an unsigned integer with incoming digits from sourceStream.
	Return this integer, or zero if no digits found.
	Stop reading if end of digits or if a LargeInteger is formed.
	Count the number of digits and the position of lastNonZero digit and store them in instVar."

	| value digit char |
	value := 0.
	nDigits := 0.
	lastNonZero := 0.
	[value isLarge or: [(char := sourceStream next) == nil
		or: [digit := char digitValue.
			(0 > digit or: [digit >= aRadix])
				and: [sourceStream skip: -1.
					true]]]]
		whileFalse: [
			nDigits := nDigits + 1.
			0 = digit
				ifFalse: [lastNonZero := nDigits].
			value := value * aRadix + digit].
	^value! !

!NumberParser methodsFor: 'parsing-private' stamp: 'nice 7/26/2009 00:22'!
makeFloatFromMantissa: m exponent: k base: aRadix 
	"Convert infinite precision arithmetic into Floating point.
	This alogrithm rely on correct IEEE rounding mode
	being implemented in Integer>>asFloat and Fraction>>asFloat"

	^(k positive
		ifTrue: [m * (aRadix raisedToInteger: k)]
		ifFalse: [Fraction numerator: m denominator: (aRadix raisedToInteger: k negated)]) asFloat! !

!NumberParser methodsFor: 'parsing-public' stamp: 'NicolaiHess 3/24/2015 08:45'!
nextNumberBase: b
	"Method for reading a number without radix prefix.
	This one can read Float Integer and ScaledDecimal"
	
	| numberOfTrailingZeroInIntegerPart |
	base := b.
	neg := sourceStream peekFor: $-.
	integerPart := self nextUnsignedIntegerOrNilBase: base.
	integerPart ifNil: [
		"This is not a regular number beginning with a digit
		It is time to check for exceptional condition NaN and Infinity"
		^self readNamedFloatOrFail].
	numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero.
	^ (sourceStream peekFor: $.)
		ifTrue: [self readNumberWithFractionPartNumberOfTrailingZeroInIntegerPart: numberOfTrailingZeroInIntegerPart]
		ifFalse: [self makeIntegerOrScaledIntegerOrFloat]! !

!NumberParser methodsFor: 'parsing-public' stamp: 'nice 3/15/2014 15:46'!
nextScaledDecimal
	"Main method for reading a (scaled) decimal number.
	Good Gracious, do not accept a decimal in another base than 10!!
	In other words, do not accept radix notation like 2r1.1, even not 10r5.3
	Do not accept exponent notation neither, like 1.0e-3"
	
	| numberOfNonZeroFractionDigits numberOfTrailingZeroInFractionPart |
	base := 10.
	neg := sourceStream peekFor: $-.
	integerPart := self nextUnsignedIntegerBase: base.
	(sourceStream peekFor: $.)
		ifTrue: [fractionPart := self nextUnsignedIntegerOrNilBase: base.
			fractionPart ifNil: ["Oops, the decimal point seems not part of this number"
							sourceStream skip: -1.
							^ neg
								ifTrue: [integerPart negated asScaledDecimal: 0]
								ifFalse: [integerPart asScaledDecimal: 0]].
			numberOfNonZeroFractionDigits := lastNonZero.
			numberOfTrailingZeroInFractionPart := nDigits - lastNonZero.
			(self readScaleWithDefaultNumberOfDigits: nDigits)
				ifFalse: ["No scale were provided. use number of digits after decimal point as scale"
					scale := nDigits].
			^self makeScaledDecimalWithNumberOfNonZeroFractionDigits: numberOfNonZeroFractionDigits andNumberOfTrailingZeroInFractionPart: numberOfTrailingZeroInFractionPart].
	self readScaleWithDefaultNumberOfDigits: 0.
	neg	ifTrue: [integerPart := integerPart negated].
	^integerPart asScaledDecimal: scale! !

!NumberParser methodsFor: 'parsing-private' stamp: 'NicolaiHess 3/24/2015 08:43'!
makeIntegerOrScaledIntegerOrFloat
	"at this point, there is no digit, nor fractionPart.
	maybe it can be a scaled decimal with fraction omitted...
	integer with negative exponent can be floats not fractions"
	
	neg
		ifTrue: [integerPart := integerPart negated].
	self readExponent ifTrue:
		["Check that the result is an integer, otherwise answer a Float.  Fractions are /not/ valid literals."
		 (exponent >= 0 or: [(integerPart * (base raisedToInteger: exponent)) isInteger]) ifFalse:
			[base := base asFloat].
		^integerPart * (base raisedToInteger: exponent)].
	(self readScaleWithDefaultNumberOfDigits: 0)
		ifTrue: [^integerPart asScaledDecimal: scale].
	^ integerPart! !

!NumberParser methodsFor: 'parsing-public' stamp: 'NicolaiHess 3/24/2015 08:44'!
nextNumber
	"main method for reading a number.
	This one can read Float Integer and ScaledDecimal"
	
	| numberOfTrailingZeroInIntegerPart |
	base := 10.
	neg := self peekSignIsMinus.
	integerPart := self nextUnsignedIntegerOrNilBase: base.
	integerPart ifNil: [
		"This is not a regular number beginning with a digit
		It is time to check for exceptional condition NaN and Infinity"
		^self readNamedFloatOrFail].
	numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero.
	(sourceStream peekFor: $r)
		ifTrue: ["<base>r<integer>"
			(base := integerPart) < 2
				ifTrue: [
					sourceStream skip: -1.
					^ self expected: 'an integer greater than 1 as valid radix'].
			self peekSignIsMinus
				ifTrue: [neg := neg not].
			integerPart := self nextUnsignedIntegerBase: base.
			numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero].
	^ (sourceStream peekFor: $.)
		ifTrue: [self readNumberWithFractionPartNumberOfTrailingZeroInIntegerPart: numberOfTrailingZeroInIntegerPart]
		ifFalse: [self makeIntegerOrScaledIntegerOrFloat]! !

!NumberParser methodsFor: 'parsing-private' stamp: 'NicolaiHess 3/24/2015 08:47'!
makeIntegerOrScaledInteger
	"at this point, there is no digit, nor fractionPart.
	maybe it can be a scaled decimal with fraction omitted..."
	self flag:'to be removed in favor of makeIntegerOrScaledIntegerOrFloat'.
	neg
		ifTrue: [integerPart := integerPart negated].
	self readExponent
		ifTrue: [^integerPart * (base raisedToInteger: exponent)].
	(self readScaleWithDefaultNumberOfDigits: 0)
		ifTrue: [^integerPart asScaledDecimal: scale].
	^ integerPart! !

!NumberParser methodsFor: 'parsing-public' stamp: 'nice 10/30/2011 16:11'!
nextFraction
	| numerator denominator |
	numerator := self nextInteger.
	(sourceStream peekFor: $/) ifFalse: [^numerator].
	denominator := self nextInteger.
	^numerator / denominator! !

!NumberParser methodsFor: 'parsing-public' stamp: 'nice 4/2/2010 20:25'!
nextIntegerBase: aRadix
	"Form an integer with following digits.
	Fail if no digit found"
	
	| isNeg value |
	isNeg := self peekSignIsMinus.
	value := self nextUnsignedIntegerBase: aRadix.
	^isNeg
		ifTrue: [value negated]
		ifFalse: [value]! !

!NumberParser methodsFor: 'accessing' stamp: 'nice 5/1/2006 01:58'!
failBlock: aBlockOrNil
	failBlock := aBlockOrNil! !

!NumberParser methodsFor: 'initialize-release' stamp: 'damiencassou 5/30/2008 10:56'!
on: aStringOrStream 
	sourceStream := aStringOrStream isString 
		ifTrue: [ aStringOrStream readStream ]
		ifFalse: [ aStringOrStream ].
	base := 10.
	neg := false.
	integerPart := fractionPart := exponent := scale := 0.
	requestor := failBlock := nil! !

!NumberParser methodsFor: 'accessing' stamp: 'nice 5/1/2006 01:59'!
requestor: anObjectOrNil
	requestor := anObjectOrNil! !

!NumberParser methodsFor: 'parsing-public' stamp: 'MarcusDenker 7/23/2014 22:29'!
nextInteger
	"Main method for reading an Integer.
	This won't try to read a Float nor a ScaledDecimal."
	
	base := 10.
	neg := self peekSignIsMinus.
	integerPart := self nextUnsignedIntegerOrNilBase: base.
	integerPart ifNil: [self fail].
	(sourceStream peekFor: $r)
		ifTrue: ["<base>r<integer>"
			| oldNeg pos |
			pos := sourceStream position.
			(base := integerPart) < 2
				ifTrue: ["A radix currently need to be greater than 1, ungobble the r and return the integer part"
					sourceStream skip: -1.
					^neg
						ifTrue: [base negated]
						ifFalse: [base]].
			oldNeg := neg.
			self peekSignIsMinus ifTrue: [neg := neg not].
			integerPart := self nextUnsignedIntegerOrNilBase: base.
			integerPart ifNil: [self fail]].
	neg
		ifTrue: [integerPart := integerPart negated].
	self readExponent
		ifTrue: [^integerPart * (base raisedToInteger: exponent)].
	^ integerPart! !

!NumberParser methodsFor: 'parsing-public' stamp: 'nice 7/26/2009 00:21'!
nextUnsignedIntegerOrNilBase: aRadix
	"Form an unsigned integer with incoming digits from sourceStream.
	Answer this integer, or nil if no digit found.
	Count the number of digits and the position of lastNonZero digit and store them in instVar"
	
	| nPackets high nDigitsHigh lastNonZeroHigh low |
	"read no more digits than one elementary LargeInteger"
	high :=  self nextElementaryLargeIntegerBase: aRadix.
	nDigits = 0 ifTrue: [^nil].
	
	"Not enough digits to form a LargeInteger, stop iteration"
	high isLarge ifFalse: [^high].

	"We now have to engage arithmetic with LargeInteger
	Decompose the integer in a high and low packets of growing size:"
	nPackets := 1.
	nDigitsHigh := nDigits.
	lastNonZeroHigh := lastNonZero.
	[
	low := self nextLargeIntegerBase: aRadix nPackets: nPackets .
	high := high * (aRadix raisedToInteger: nDigits) + low.
	lastNonZero = 0 ifFalse: [lastNonZeroHigh := lastNonZero + nDigitsHigh].
	nDigitsHigh := nDigitsHigh + nDigits.
	low isLarge]
		whileTrue: [nPackets := nPackets * 2].

	nDigits := nDigitsHigh.
	lastNonZero := lastNonZeroHigh.
	^high! !

!NumberParser methodsFor: 'parsing-private' stamp: 'nice 3/15/2014 15:43'!
readScaleWithDefaultNumberOfDigits: anInteger
	"Read the scale if any and store it into scale instance Variable.
	Answer true if found, answer false if none.
	The scale is specified by letter s, optionnally followed by a positive integer in base 10.
	If no integer is specified, that means using as many digits as provided after the fraction separator, as provided by parameter anInteger.
	A letter s followed by another letter is not considered as a scale specification, because it could be part of a message."

	scale := 0.
	sourceStream atEnd
		ifTrue: [ ^ false ].
	(sourceStream peekFor: $s)
		ifFalse: [ ^ false ].
	scale := self nextUnsignedIntegerOrNilBase: 10.
	scale
		ifNil: [ 
			scale := anInteger.
			(sourceStream peek ifNil: [ false ] ifNotNil: [ :nextChar | nextChar isLetter ])
				ifTrue: [ 
					sourceStream skip: -1.	"ungobble the s"
					^ false ]
				ifFalse: [ ^ true ] ].
	^ true! !

!NumberParser methodsFor: 'parsing-private' stamp: 'nice 2/13/2010 16:03'!
readExponent
	"read the exponent if any (stored in instVar).
	Answer true if found, answer false if none.
	If exponent letter is not followed by a digit,
	this is not considered as an error.
	Exponent are always read in base 10."
	
	| eneg epos |
	exponent := 0.
	sourceStream atEnd ifTrue: [^ false].
	(self exponentLetters includes: sourceStream peek)
		ifFalse: [^ false].
	sourceStream next.
	eneg := sourceStream peekFor: $-.
	epos := eneg not and: [self allowPlusSignInExponent and: [sourceStream peekFor: $+]].
	exponent := self nextUnsignedIntegerOrNilBase: 10.
	exponent ifNil: ["Oops, there was no digit after the exponent letter.Ungobble the letter"
		exponent := 0.
		sourceStream
						skip: ((eneg or: [epos])
								ifTrue: [-2]
								ifFalse: [-1]).
					^ false].
	eneg
		ifTrue: [exponent := exponent negated].
	^ true! !

!NumberParser methodsFor: 'accessing' stamp: 'nice 2/12/2010 23:56'!
allowPlusSignInExponent
	"return a boolean indicating if plus sign is allowed or not in exponent"

	^self allowPlusSign! !

!NumberParser methodsFor: 'accessing' stamp: 'YuriyTymchuk 10/29/2013 11:08'!
allowPlusSign
	"return a boolean indicating if plus sign is allowed or not"

	^false! !

!NumberParser methodsFor: 'parsing-private' stamp: 'YuriyTymchuk 10/29/2013 11:08'!
readNamedFloatOrFail
	"This method is used when there is no digit encountered:
	It try and read a named Float NaN or Infinity.
	Negative sign for -Infinity has been read before sending this method, and is indicated in the neg inst.var.
	Fail if no named Float is found"
		
	neg ifFalse: [(sourceStream nextMatchAll: 'NaN')
			ifTrue: [^ Float nan]].
	(sourceStream nextMatchAll: 'Infinity')
		ifTrue: [^ neg
			ifTrue: [Float infinity negated]
			ifFalse: [Float infinity]].
	^self expected: 'a digit between 0 and ' , (String with: (Character digitValue: base - 1))! !

!NumberParser methodsFor: 'parsing-public' stamp: 'nice 10/16/2008 01:05'!
nextUnsignedIntegerBase: aRadix 
	"Form an unsigned integer with incoming digits from sourceStream.
	Fail if no digit found.
	Count the number of digits and the lastNonZero digit and store int in instVar "
	
	| value |
	value := self nextUnsignedIntegerOrNilBase: aRadix.
	value ifNil: [^self expected: ('a digit between 0 and ' copyWith: (Character digitValue: aRadix - 1))].
	^value! !

!NumberParser methodsFor: 'parsing-large int' stamp: 'nice 1/14/2014 03:27'!
nextLargeIntegerBase: aRadix nPackets: nPackets 
	"Form a Large integer with incoming digits from sourceStream.
	Return this integer, or zero if no digits found.
	Stop reading when no more digits or when nPackets elementary LargeInteger have been encountered.
	Count the number of digits and the lastNonZero digit and store them in instVar"
	
	| high nDigitsHigh lastNonZeroHigh low nDigitsLow halfPackets |
	halfPackets := nPackets bitShift: -1.
	halfPackets = 0 ifTrue: [^self nextElementaryLargeIntegerBase: aRadix].
	high := self nextLargeIntegerBase: aRadix nPackets: halfPackets.
	high isLarge ifFalse: [^high].
	nDigitsHigh := nDigits.
	lastNonZeroHigh := lastNonZero.
	low := self nextLargeIntegerBase: aRadix nPackets: halfPackets.
	nDigitsLow := nDigits.
	nDigits := nDigitsHigh + nDigitsLow.
	lastNonZero := lastNonZero = 0
		ifTrue: [lastNonZeroHigh]
		ifFalse: [lastNonZero + nDigitsHigh].
	^high * (aRadix raisedToInteger: nDigitsLow) + low! !

!NumberParser methodsFor: 'parsing-public' stamp: 'nice 8/27/2010 20:51'!
nextIntegerBase: aRadix ifFail: aBlock
	"Form an integer with optional sign and following digits from sourceStream."
	
	| isNeg value |
	isNeg := self peekSignIsMinus.
	value := self nextUnsignedIntegerOrNilBase: aRadix.
	value ifNil: [^aBlock value].
	^isNeg
		ifTrue: [value negated]
		ifFalse: [value]! !

!NumberParser methodsFor: 'parsing-public' stamp: 'nice 10/16/2008 01:05'!
nextUnsignedIntegerBase: aRadix ifFail: errorBlock
	"Form an unsigned integer with incoming digits from sourceStream.
	Answer this integer, or execute errorBlock if no digit found.
	Count the number of digits and the position of lastNonZero digit and store them in instVar"
	
	| value |
	value := self nextUnsignedIntegerOrNilBase: aRadix.
	value ifNil: [^errorBlock value].
	^value! !

!NumberParser methodsFor: 'parsing-private' stamp: 'nice 3/15/2014 15:45'!
readNumberWithFractionPartNumberOfTrailingZeroInIntegerPart: numberOfTrailingZeroInIntegerPart
	"at this stage, sign integerPart and a decimal point have been read.
	try and form a number with a fractionPart"
	
	| numberOfNonZeroFractionDigits numberOfTrailingZeroInFractionPart mantissa value |
	fractionPart := self nextUnsignedIntegerOrNilBase: base.
	fractionPart ifNil: ["No fractionPart found,ungobble the decimal point and return the integerPart"
					sourceStream skip: -1.
					^ neg
						ifTrue: [integerPart negated]
						ifFalse: [integerPart]].
	numberOfNonZeroFractionDigits := lastNonZero.
	numberOfTrailingZeroInFractionPart := nDigits - lastNonZero.
	self readExponent
		ifFalse: [(self readScaleWithDefaultNumberOfDigits: nDigits)
				ifTrue: [^self makeScaledDecimalWithNumberOfNonZeroFractionDigits: numberOfNonZeroFractionDigits
					andNumberOfTrailingZeroInFractionPart: numberOfTrailingZeroInFractionPart]].

	fractionPart isZero
		ifTrue: [mantissa := integerPart
						// (base raisedToInteger: numberOfTrailingZeroInIntegerPart).
			exponent := exponent + numberOfTrailingZeroInIntegerPart]
		ifFalse: [mantissa := integerPart
						* (base raisedToInteger: numberOfNonZeroFractionDigits) + (fractionPart // (base raisedToInteger: numberOfTrailingZeroInFractionPart)).
			exponent := exponent - numberOfNonZeroFractionDigits].

	value := self makeFloatFromMantissa: mantissa exponent: exponent base: base.
	^ neg
		ifTrue: [value isZero
				ifTrue: [Float negativeZero]
				ifFalse: [value negated]]
		ifFalse: [value]! !

!NumberParser methodsFor: 'error' stamp: 'NikoSchwarz 10/17/2009 10:45'!
fail
	failBlock ifNotNil: [^failBlock value].
	self error: 'Reading a number failed'! !

!NumberParser methodsFor: 'parsing-private' stamp: 'nice 2/12/2010 23:57'!
peekSignIsMinus
	"Peek an optional sign from sourceStream.
	Answer true if it is minus sign"

	| isMinus |
	isMinus := sourceStream peekFor: $-.
	isMinus ifFalse: [self allowPlusSign ifTrue: [sourceStream peekFor: $+]].
	^isMinus! !

!NumberParser class methodsFor: 'instance creation' stamp: 'nice 5/1/2006 02:02'!
parse: aStringOrStream onError: failBlock 
	^(self new)
		on: aStringOrStream;
		failBlock: failBlock;
		nextNumber! !

!NumberParser class methodsFor: 'instance creation' stamp: 'MarcusDenker 8/28/2013 10:44'!
parse: aStringOrStream 
	^self new
		on: aStringOrStream;
		nextNumber! !

!NumberParser class methodsFor: 'instance creation' stamp: 'nice 5/1/2006 00:45'!
on: aStringOrStream
	^self new on: aStringOrStream! !

!NumberParser class methodsFor: 'instance creation' stamp: 'NikoSchwarz 10/23/2009 13:21'!
squeezeNumberOutOfString: stringOrStream
	"Try and find a number in this string. First, look if the string 
	starts with a number. Then, see if it ends with a number. Then,
	remove a character from the front and see if the remaining 
	string makes a number. Repeat the process until no characters
	are left or the number has been found. As soon as a number is
	found, it is returned. Otherwise, the method fails."
	^ self squeezeNumberOutOfString: stringOrStream onError: [self error: 'Reading a number failed']! !

!NumberParser class methodsFor: 'instance creation' stamp: 'MarcusDenker 12/2/2013 14:07'!
squeezeNumberOutOfString: stringOrStream onError: errorBlock
	"Try and find a number in this string. First, look if the string 
	starts with a number. Then, see if it ends with a number. Then,
	remove a character from the front and see if the remaining 
	string makes a number. Repeat the process until no characters
	are left or the number has been found. As soon as a number is
	found, it is returned. Otherwise, the method fails."
	
	| string |

	string := stringOrStream.
				
	stringOrStream size timesRepeat: [
		(self parse: string onError: [ nil ])
			ifNotNil: [ :result| ^ result ].
		string := string allButFirst ].
	
	^ errorBlock value! !

!NumberParserTest commentStamp: 'nice 5/7/2006 17:54'!
Provide tests for new clas aimed at parsing numbers.

It duplicates NumberParsingTest, with few more tests.!
!NumberParserTest methodsFor: 'tests - Float' stamp: 'nice 1/15/2014 00:00'!
testFloatmin
	"Note that these are originally tests cases for former bugs of libc dtoa from netlib.
	ref http://www.exploringbinary.com/gays-strtod-returns-zero-for-inputs-just-above-2-1075/
	ref http://gcc.gnu.org/viewcvs/gcc/trunk/gcc/testsuite/gcc.dg/float-exact-1.c?view=markup&pathrev=205119
	They are also non regression for a bug of NumberParser related to incorrect position of last non zero digit.
	ref https://pharo.fogbugz.com/f/cases/12642/bug-in-NumberParser-when-reading-a-number-with-fraction-part"
	| halfMin moreThanHalfmin |
	halfMin := NumberParser parse: (Float fmin asTrueFraction / 2 printShowingDecimalPlaces: 1 - Float fmin exponent).
	self assert: halfMin = 0.0 description: 'nearest even of 0.5*Float fmin is zero'.
	moreThanHalfmin := NumberParser parse: (Float fmin asTrueFraction / 2 + (10 raisedTo: Float fmin exponent - 4) printShowingDecimalPlaces: 4 - Float fmin exponent).
	self assert: moreThanHalfmin = Float fmin description: 'nearest Float of a Fraction > 0.5*Float fmin is Float fmin'.! !

!NumberParserTest methodsFor: 'tests - Float' stamp: 'YuriyTymchuk 10/29/2013 11:10'!
testFloatGradualUnderflow
	"Gradual underflow are tricky.
	This is a non regression test for http://bugs.squeak.org/view.php?id=6976"

	| float trueFraction str |
	
	"as a preamble, use a base 16 representation to avoid round off error and check that number parsing is correct"
	trueFraction := 16r2D2593D58B4FC4 / (16 raisedTo: 256+13).
	"Parse the number in base 16 if possible - it is impossible if lowercase letter are allowed digits due to exponent letter ambiguity."
	float := self areLowercaseDigitsAllowed
		ifFalse: [NumberParser parse: '16r2.D2593D58B4FC4e-256']
		ifTrue: [trueFraction asFloat]..
	self assert: float asTrueFraction = trueFraction.
	self assert: float = trueFraction asFloat.

	"now print in base 10"
	str := (String new: 32) writeStream.
	float absPrintExactlyOn: str base: 10.
	
	"verify if SqNumberParser can read it back"
	self assert: (NumberParser parse: str contents) = float. ! !

!NumberParserTest methodsFor: 'tests - squeezing' stamp: 'BenjaminVanRyseghem 7/1/2012 02:03'!
testSqueezingOutNumbers
	"test that SqNumberParser squeezeNumberOutOfString finds numbers."
	
	self assert: '123blabla' squeezeOutNumber equals: 123.
	self assert: 'blabla123' squeezeOutNumber equals: 123.
	self assert: 'blabla12blabla' squeezeOutNumber equals: 12.
	self assert: ('12.3bla' squeezeOutNumber -12.3 ) abs < 0.0001.
	self assert: '.1' squeezeOutNumber > 0.
	
	self assert: 'blabla1230' squeezeOutNumber equals: 1230.! !

!NumberParserTest methodsFor: 'tests - Float' stamp: 'YuriyTymchuk 10/29/2013 11:10'!
testFloatReadWithRadix
	"This covers parsing in Number>>readFrom:
	Note: In most Smalltalk dialects, the radix notation is not used for numbers
	with exponents. In Squeak, a string with radix and exponent can be parsed,
	and the exponent is always treated as base 10 (not the base indicated in the
	radix prefix). I am not sure if this is a feature, a bug, or both, but the
	Squeak behavior is documented in this test. -dtl"
	| rs |
	self assert: (NumberParser parse: '2r1.0101e9') = (1.3125 * (2 raisedTo: 9)).
	rs := '2r1.0101e9e9' readStream.
	self assert: (NumberParser parse: rs) = 672.0.
	self assert: rs upToEnd = 'e9'! !

!NumberParserTest methodsFor: 'tests - Float' stamp: 'NicolaiHess 3/24/2015 08:51'!
testIntegerWithNegExponentIsAFloat
	"Make sure a float literal like 1e(some possible neg exponent)
	isn't evaluated to the non-literal Fraction"

	| rs aFloat |
	rs := '1e-14' readStream.
	aFloat := NumberParser parse: rs.
	self assert: aFloat class = Float.

	rs := '1e-14' readStream.
	aFloat := (NumberParser on: rs ) nextNumberBase: 10.
	self assert: aFloat class = Float.

! !

!NumberParserTest methodsFor: 'tests - fail' stamp: 'YuriyTymchuk 10/29/2013 11:10'!
testFail
	"Verify that the value of a failblock is returned."
	self assert: (NumberParser parse: 'blablabla' onError: [42]) equals: 42! !

!NumberParserTest methodsFor: 'tests - Float' stamp: 'YuriyTymchuk 10/29/2013 11:10'!
testFloatPrintString
	"self debug: #testFloatPrintString"
	
	| f r bases |
	f := Float basicNew: 2.
	r := Random new seed: 1234567.
	"printing a Float in base other than 10 is broken if lowercase digits are allowed"
	bases := self areLowercaseDigitsAllowed
		ifTrue: [#(10)]
		ifFalse: [#(2 8 10 16)].
	100
		timesRepeat: [f basicAt: 1 put: (r nextInt: 16r100000000)- 1.
			f basicAt: 2 put: (r nextInt: 16r100000000) - 1.
			bases
				do: [:base | | str |
						str := (String new: 64) writeStream.
						f negative ifTrue: [str nextPut: $-].
						str print: base; nextPut: $r.
						f absPrintExactlyOn: str base: base.
						self assert: (NumberParser parse: str contents) = f]].
	"test big num near infinity"
	10
		timesRepeat: [f basicAt: 1 put: 16r7FE00000 + ((r nextInt: 16r100000) - 1).
			f basicAt: 2 put: (r nextInt: 16r100000000) - 1.
			bases
				do: [:base | | str |
						str := (String new: 64) writeStream.
						f negative ifTrue: [str nextPut: $-].
						str print: base; nextPut: $r.
						f absPrintExactlyOn: str base: base.
						self assert: (NumberParser parse: str contents) = f]].
	"test infinitesimal (gradual underflow)"
	10
		timesRepeat: [f basicAt: 1 put: 0 + ((r nextInt: 16r100000) - 1).
			f basicAt: 2 put: (r nextInt: 16r100000000) - 1.
			bases
				do: [:base | | str |
						str := (String new: 64) writeStream.
						f negative ifTrue: [str nextPut: $-].
						str print: base; nextPut: $r.
						f absPrintExactlyOn: str base: base.
						self assert: (NumberParser parse: str contents) = f]].! !

!NumberParserTest methodsFor: 'utility' stamp: 'YuriyTymchuk 10/29/2013 11:10'!
areLowercaseDigitsAllowed
	"Answer true if lowercase letter are allowed digits."
	
	^(NumberParser parse: '16re' onError: [-1]) = 16rE! !

!NumberParserTest methodsFor: 'tests - Float' stamp: 'YuriyTymchuk 10/29/2013 11:10'!
testFloatReadError
	"This covers parsing in Number>>readFrom:"

	| rs num |
	rs := '1e' readStream.
	num := NumberParser parse: rs.
	self assert: 1 = num.
	self assert: rs upToEnd = 'e'.
	
	rs := '1s' readStream.
	num := NumberParser parse: rs.
	self assert: 1 = num.
	self assert: rs upToEnd = ''.

	rs := '1.' readStream.
	num := NumberParser parse: rs.
	self assert: 1 = num.
	self assert: num isInteger.
	self assert: rs upToEnd = '.'.
	
	rs := '' readStream.
	self should: [NumberParser parse: rs] raise: Error.
	
	rs := 'foo' readStream.
	self should: [NumberParser parse: rs] raise: Error.

	rs := 'radix' readStream.
	self should: [NumberParser parse: rs] raise: Error.
	
	rs := '.e0' readStream.
	self should: [NumberParser parse: rs] raise: Error.
	
	rs := '-.e0' readStream.
	self should: [NumberParser parse: rs] raise: Error.
	
	rs := '--1' readStream.
	self should: [NumberParser parse: rs] raise: Error.! !

!NumberParserTest methodsFor: 'tests - Integer' stamp: 'YuriyTymchuk 10/29/2013 11:10'!
testIntegerReadFrom
	"Ensure remaining characters in a stream are not lost when parsing an integer."
	| rs i s |
	rs := '123s could be confused with a ScaledDecimal' readStream.
	i := NumberParser parse: rs.
	self assert: i = 123.
	s := rs upToEnd.
	self assert: ' could be confused with a ScaledDecimal' = s.
	rs := '123.s could be confused with a ScaledDecimal' readStream.
	i := NumberParser parse: rs.
	self assert: i = 123.
	s := rs upToEnd.
	self assert: '.s could be confused with a ScaledDecimal' = s! !

!NumberParserTest methodsFor: 'tests - Integer' stamp: 'YuriyTymchuk 10/29/2013 11:10'!
testcheckForCoverage
	"self debug: #testcheckForCoverage"
	"Tests for old semantics of Number>>readFrom:"
	
	self should: [(NumberParser parse: '.') = 0 ] raise: Error.
	self should: [(NumberParser parse: '.1') asNumber = 0.1] raise: Error.
	self assert: (NumberParser parse: '0.0') asNumber = 0.
	self assert: (NumberParser parse: '0.1') asNumber = 0.1.
	self assert: (NumberParser parse: '1.1') asNumber = 1.1.
	self assert: (NumberParser parse: '-1') asNumber = -1.! !

!NumberParserTest methodsFor: 'tests - Float' stamp: 'YuriyTymchuk 10/29/2013 11:10'!
testFloatFromStreamAsNumber
	"This covers parsing in Number>>readFrom:"

	| rs aFloat |
	rs := '10r-12.3456' readStream.
	aFloat := NumberParser parse: rs.
	self assert: -12.3456 = aFloat.
	self assert: rs atEnd.

	rs := '10r-12.3456e2' readStream.
	aFloat := NumberParser parse: rs.
	self assert: -1234.56 = aFloat.
	self assert: rs atEnd.

	rs := '10r-12.3456e2e2' readStream.
	aFloat := NumberParser parse: rs.
	self assert: -1234.56 = aFloat.
	self assert: rs upToEnd = 'e2'.

	rs := '10r-12.3456d2' readStream.
	aFloat := NumberParser parse: rs.
	self assert: -1234.56 = aFloat.
	self assert: rs atEnd.

	rs := '10r-12.3456q2' readStream.
	aFloat := NumberParser parse: rs.
	self assert: -1234.56 = aFloat.
	self assert: rs atEnd.

	rs := '-12.3456q2' readStream.
	aFloat := NumberParser parse: rs.
	self assert: -1234.56 = aFloat.
	self assert: rs atEnd.

	rs := '12.3456q2' readStream.
	aFloat := NumberParser parse: rs.
	self assert: 1234.56 = aFloat.
	self assert: rs atEnd.

	rs := '12.3456z2' readStream.
	aFloat := NumberParser parse: rs.
	self assert: 12.3456 = aFloat.
	self assert: rs upToEnd = 'z2'.
! !

!NumberParserTest methodsFor: 'tests - ScaledDecimal' stamp: 'nice 3/15/2014 15:50'!
testScaledDecimalWithoutScaleSpecification
	self assert: (NumberParser parse: '0.050s') = (1/20).
	self assert: (NumberParser parse: '0.050s') scale= 3.! !

!NumberParserTest methodsFor: 'tests - Float' stamp: 'YuriyTymchuk 10/29/2013 11:10'!
testFloatFromStreamWithExponent
	"This covers parsing in Number>>readFrom:"

	| rs aFloat |
	rs := '1.0e-14' readStream.
	aFloat := NumberParser parse: rs.
	self assert: 1.0e-14 = aFloat.
	self assert: rs atEnd.

	rs := '1.0e-14 1' readStream.
	aFloat := NumberParser parse: rs.
	self assert: 1.0e-14 = aFloat.
	self assert: rs upToEnd = ' 1'.

	rs := '1.0e-14eee' readStream.
	aFloat := NumberParser parse: rs.
	self assert: 1.0e-14 = aFloat.
	self assert: rs upToEnd = 'eee'.

	rs := '1.0e14e10' readStream.
	aFloat := NumberParser parse: rs.
	self assert: 1.0e14 = aFloat.
	self assert: rs upToEnd = 'e10'.

	rs := '1.0e+14e' readStream. "Plus sign is not parseable"
	aFloat := NumberParser parse: rs.
	self assert: 1.0 = aFloat.
	self assert: rs upToEnd = 'e+14e'.

	rs := '1.0e' readStream.
	aFloat := NumberParser parse: rs.
	self assert: 1.0 = aFloat.
	self assert: rs upToEnd = 'e'.! !

!NumberParserTest methodsFor: 'tests - Integer' stamp: 'YuriyTymchuk 10/29/2013 11:10'!
testIntegerReadWithRadix
	"This covers parsing in Number>>readFrom:
	Note: In most Smalltalk dialects, the radix notation is not used for numbers
	with exponents. In Squeak, a string with radix and exponent can be parsed,
	and the exponent is always treated as base 10 (not the base indicated in the
	radix prefix). I am not sure if this is a feature, a bug, or both, but the
	Squeak behavior is documented in this test. -dtl"

	| rs |
	self assert: (NumberParser parse: '2r1e26') = (2 raisedTo: 26).
	rs := '2r1e26eee' readStream.
	self assert: (NumberParser parse: rs) = 67108864.
	self assert: rs upToEnd = 'eee'
! !

!NumberParserTest methodsFor: 'tests - ScaledDecimal' stamp: 'YuriyTymchuk 10/29/2013 11:10'!
testScaledDecimalWithTrailingZeroes
	"This is a non regression tests for http://bugs.squeak.org/view.php?id=7169"
	
	self assert: (NumberParser parse: '0.50s2') = (1/2).
	self assert: (NumberParser parse: '0.500s3') = (1/2).
	self assert: (NumberParser parse: '0.050s3') = (1/20).! !

!NumberParsingTest commentStamp: 'dtl 11/24/2004 15:35'!
Tests to verify parsing of numbers from streams and strings.

Note: ScaledDecimalTest contains related tests for parsing ScaledDecimal.!
!NumberParsingTest methodsFor: 'tests - Float' stamp: 'YuriyTymchuk 10/29/2013 11:15'!
testFloatFromStreamWithExponent
	"This covers parsing in Number>>readFrom:"

	| rs aFloat |
	rs := '1.0e-14' readStream.
	aFloat := Number readFrom: rs.
	self assert: 1.0e-14 = aFloat.
	self assert: rs atEnd.

	rs := '1.0e-14 1' readStream.
	aFloat := Number readFrom: rs.
	self assert: 1.0e-14 = aFloat.
	self assert: rs upToEnd = ' 1'.

	rs := '1.0e-14eee' readStream.
	aFloat := Number readFrom: rs.
	self assert: 1.0e-14 = aFloat.
	self assert: rs upToEnd = 'eee'.

	rs := '1.0e14e10' readStream.
	aFloat := Number readFrom: rs.
	self assert: 1.0e14 = aFloat.
	self assert: rs upToEnd = 'e10'.

	rs := '1.0e+14e' readStream.
	aFloat := Number readFrom: rs.
	self assert: 1.0 = aFloat.
	self assert: rs upToEnd = 'e+14e'.

	rs := '1.0e' readStream.
	aFloat := Number readFrom: rs.
	self assert: 1.0 = aFloat.
	self assert: rs upToEnd = 'e'.! !

!NumberParsingTest methodsFor: 'tests - Float' stamp: 'damiencassou 5/30/2008 11:09'!
testFloatReadWithRadix
	"This covers parsing in Number>>readFrom:
	Note: In most Smalltalk dialects, the radix notation is not used for numbers
	with exponents. In Squeak, a string with radix and exponent can be parsed,
	and the exponent is always treated as base 10 (not the base indicated in the
	radix prefix). I am not sure if this is a feature, a bug, or both, but the
	Squeak behavior is documented in this test. -dtl"
	| aNumber rs |
	aNumber := '2r1.0101e9' asNumber.
	self assert: 672.0 = aNumber.
	self assert: (Number readFrom: '2r1.0101e9') = (1.3125 * (2 raisedTo: 9)).
	rs := '2r1.0101e9e9' readStream.
	self assert: (Number readFrom: rs) = 672.0.
	self assert: rs upToEnd = 'e9'! !

!NumberParsingTest methodsFor: 'tests - Float' stamp: 'YuriyTymchuk 10/29/2013 11:14'!
testNumberReadOnlyDigit
	"This covers parsing in Number>>readFrom:"

	| rs num |
	rs := '1e' readStream.
	num := Number readFrom: rs.
	self assert: 1 = num.
	self assert: rs upToEnd = 'e'.
	
	rs := '1s' readStream.
	num := Number readFrom: rs.
	self assert: 1 = num.
	self assert: rs upToEnd = ''.

	rs := '1.' readStream.
	num := Number readFrom: rs.
	self assert: 1 = num.
	self assert: num isInteger.
	self assert: rs upToEnd = '.'.! !

!NumberParsingTest methodsFor: 'tests - Float' stamp: 'AdrianLienhard 6/5/2010 16:32'!
testNumberReadExactlyError
	"This covers parsing in Number>>readExactlyFrom:"

	| rs |
	
	rs := '' readStream.
	self should: [Number readFrom: rs] raise: Error.
	
	rs := 'foo' readStream.
	self should: [Number readFrom: rs] raise: Error.

	rs := 'radix' readStream.
	self should: [Number readFrom: rs] raise: Error.
	
	rs := '.e0' readStream.
	self should: [Number readFrom: rs] raise: Error.
	
	rs := '-.e0' readStream.
	self should: [Number readFrom: rs] raise: Error.
	
	rs := '--1' readStream.
	self should: [Number readFrom: rs] raise: Error.! !

!NumberParsingTest methodsFor: 'tests - Float' stamp: 'dtl 11/24/2004 14:07'!
testFloatFromStringAsNumber
	"This covers parsing in Number>>readFrom:"

	| aFloat |
	aFloat := '10r-12.3456' asNumber.
	self assert: -12.3456 = aFloat.
	aFloat := '10r-12.3456e2' asNumber.
	self assert: -1234.56 = aFloat.
	aFloat := '10r-12.3456d2' asNumber.
	self assert: -1234.56 = aFloat.
	aFloat := '10r-12.3456q2' asNumber.
	self assert: -1234.56 = aFloat.
	aFloat := '-12.3456q2' asNumber.
	self assert: -1234.56 = aFloat.
	aFloat := '12.3456q2' asNumber.
	self assert: 1234.56 = aFloat.
! !

!NumberParsingTest methodsFor: 'tests - ScaledDecimal' stamp: 'nice 3/15/2014 15:51'!
testScaledDecimalWithoutScaleSpecification
	self assert: (Number readFrom: '0.050s') = (1/20).
	self assert: (Number readFrom: '0.050s') scale= 3.
	
	self assert: (ScaledDecimal readFrom: '0.050') = (1/20).
	self assert: (ScaledDecimal readFrom: '0.050') scale= 3.! !

!NumberParsingTest methodsFor: 'tests - Integer' stamp: 'YuriyTymchuk 11/3/2013 11:55'!
testIntegerReadFrom
	"Ensure remaining characters in a stream are not lost when parsing an integer."
	| rs i s |
	rs := '123s could be confused with a ScaledDecimal' readStream.
	i := Integer readFrom: rs.
	self assert: i = 123.
	s := rs upToEnd.
	self assert: 's could be confused with a ScaledDecimal' = s.
	rs := '123.s could be confused with a ScaledDecimal' readStream.
	i := Integer readFrom: rs.
	self assert: i = 123.
	s := rs upToEnd.
	self assert: '.s could be confused with a ScaledDecimal' = s.
	rs := '123sA has unary message sA' readStream.
	i := Number readFrom: rs.
	self assert: i = 123.
	s := rs upToEnd.
	self assert: 'sA has unary message sA' = s.
	rs := '123sB has unary message sB' readStream.
	i := Number readFrom: rs.
	self assert: i = 123.
	s := rs upToEnd.
	self assert: 'sB has unary message sB' = s! !

!NumberParsingTest methodsFor: 'tests - Float' stamp: 'YuriyTymchuk 10/29/2013 11:20'!
testFloatFromStringWithExponent
	"This covers parsing in Number>>readFrom:"

	| aFloat |
	aFloat := '1.0e-14' asNumber.
	self assert: 1.0e-14 = aFloat.
	aFloat := '1.0e-14 1' asNumber.
	self assert: 1.0e-14 = aFloat.
	aFloat := '1.0e-14e' asNumber.
	self assert: 1.0e-14 = aFloat.
	aFloat := '1.0e14e' asNumber.
	self assert: 1.0e14 = aFloat.! !

!NumberParsingTest methodsFor: 'tests - Float' stamp: 'dtl 11/24/2004 14:29'!
testFloatFromStreamAsNumber
	"This covers parsing in Number>>readFrom:"

	| rs aFloat |
	rs := '10r-12.3456' readStream.
	aFloat := Number readFrom: rs.
	self assert: -12.3456 = aFloat.
	self assert: rs atEnd.

	rs := '10r-12.3456e2' readStream.
	aFloat := Number readFrom: rs.
	self assert: -1234.56 = aFloat.
	self assert: rs atEnd.

	rs := '10r-12.3456e2e2' readStream.
	aFloat := Number readFrom: rs.
	self assert: -1234.56 = aFloat.
	self assert: rs upToEnd = 'e2'.

	rs := '10r-12.3456d2' readStream.
	aFloat := Number readFrom: rs.
	self assert: -1234.56 = aFloat.
	self assert: rs atEnd.

	rs := '10r-12.3456q2' readStream.
	aFloat := Number readFrom: rs.
	self assert: -1234.56 = aFloat.
	self assert: rs atEnd.

	rs := '-12.3456q2' readStream.
	aFloat := Number readFrom: rs.
	self assert: -1234.56 = aFloat.
	self assert: rs atEnd.

	rs := '12.3456q2' readStream.
	aFloat := Number readFrom: rs.
	self assert: 1234.56 = aFloat.
	self assert: rs atEnd.

	rs := '12.3456z2' readStream.
	aFloat := Number readFrom: rs.
	self assert: 12.3456 = aFloat.
	self assert: rs upToEnd = 'z2'.
! !

!NumberParsingTest methodsFor: 'tests - Integer' stamp: 'Janniklaval 10/23/2010 13:40'!
testNegativeZero
      "This test ensure that -0.0 will produce a negativeZero"

      | negativeZero |
      negativeZero := Number readFrom: '-0.0' readStream.

      "If it is a negative zero, it must behave like a negative zero... IEEE 754 tells how it should behave"
      self deny: (negativeZero at: 1) = 0 description: 'In IEEE 754, a negative zero has its sign bit set to 1'..
      self assert: negativeZero = 0 description: 'In IEEE 754, a negative zero cannot be distinguished from zero'.! !

!NumberParsingTest methodsFor: 'tests - ScaledDecimal' stamp: 'nice 8/29/2008 22:04'!
testScaledDecimalWithTrailingZeroes
	"This is a non regression tests for http://bugs.squeak.org/view.php?id=7169"
	
	self assert: (Number readFrom: '0.50s2') = (1/2).
	self assert: (Number readFrom: '0.500s3') = (1/2).
	self assert: (Number readFrom: '0.050s3') = (1/20).! !

!NumberParsingTest methodsFor: 'tests - Integer' stamp: 'StephaneDucasse 5/28/2011 13:41'!
testIntegerFromString
	"This covers parsing in Number>>readFrom:
	Trailing decimal points should be ignored."

	self assert: ('123' asNumber = 123).
	self assert: ('-123' asNumber = -123).
	self assert: ('123.' asNumber = 123).
	self assert: ('-123.' asNumber = -123).
	self assert: ('123This is not to be read' asNumber = 123).
	self assert: ('123s could be confused with a ScaledDecimal' asNumber = 123).
	self assert: ('123e could be confused with a Float' asNumber = 123).
! !

!NumberParsingTest methodsFor: 'tests - Integer' stamp: 'VeronicaUquillas 6/11/2010 14:42'!
testIntegerReadWithRadix
	"This covers parsing in Number>>readFrom:
	Note: In most Smalltalk dialects, the radix notation is not used for numbers
	with exponents. In Squeak, a string with radix and exponent can be parsed,
	and the exponent is always treated as base 10 (not the base indicated in the
	radix prefix). I am not sure if this is a feature, a bug, or both, but the
	Squeak behavior is documented in this test. -dtl"

	| aNumber rs |
	aNumber := '2r1e26' asNumber.
	self assert: 67108864 = aNumber.
	self assert: (Number readFrom: '2r1e26') = (2 raisedTo: 26).
	rs := '2r1e26eee' readStream.
	self assert: (Number readFrom: rs) = 67108864.
	self assert: rs upToEnd = 'eee'
! !

!NumberTest commentStamp: 'TorstenBergmann 2/5/2014 08:41'!
SUnit tests for numbers!
!NumberTest methodsFor: 'tests' stamp: 'GabrielOmarCotelli 5/25/2009 16:41'!
testRaisedToInteger

	self 
		assert: (2 raisedToInteger: 0) = 1;
		assert: (2 raisedToInteger: 1) = 2;
		assert: (2 raisedToInteger: 4) = 16;
		assert: (0 raisedToInteger: 0) = 1;
		assert: (0 raisedToInteger: 2) = 0;
		assert: (2 raisedToInteger: -1) = (1/2);
		assert: (2 raisedToInteger: -4) = (1/16).
	
	self 
		assert: (-3 raisedTo: 0) = 1;
		assert: (-3 raisedTo: 1) = -3;
		assert: (-3 raisedTo: 2) = 9;
		assert: (-3 raisedTo: 3) = -27;
		assert: (-3 raisedTo: -2) = (1/9);
		assert: (-3 raisedTo: -3) = (-1/27).
	
	self should: [ 0 raisedTo: -1 ] raise: ZeroDivide! !

!NumberTest methodsFor: 'tests' stamp: 'nice 12/6/2007 21:24'!
testRaisedTo
	"this is a test related to http://bugs.squeak.org/view.php?id=6781"
	
	self should: [0 raisedTo: -1] raise: ZeroDivide.
	self should: [0 raisedTo: -1.0] raise: ZeroDivide.! !

!NumberTest methodsFor: 'tests' stamp: 'GabrielOmarCotelli 5/23/2009 20:49'!
testOne

	self 
		assert: Integer one = 1;
		assert: Float one = 1.0;
		assert: Fraction one = 1! !

!NumberTest methodsFor: 'tests' stamp: 'adrian_lienhard 1/7/2009 17:55'!
testPrintShowingDecimalPlaces
	self assert: (111.2 printShowingDecimalPlaces: 2) = '111.20'.
	self assert: (111.2 printShowingDecimalPlaces: 0) = '111'.
	self assert: (111 printShowingDecimalPlaces: 0) = '111'.
	self assert: (111111111111111 printShowingDecimalPlaces: 2) = '111111111111111.00'.
	self assert: (10 printShowingDecimalPlaces: 20) ='10.00000000000000000000'.
	self assert: (0.98 printShowingDecimalPlaces: 2) = '0.98'.
	self assert: (-0.98 printShowingDecimalPlaces: 2) = '-0.98'.
	self assert: (2.567 printShowingDecimalPlaces: 2) = '2.57'.
	self assert: (-2.567 printShowingDecimalPlaces: 2) = '-2.57'.
	self assert: (0.01 printShowingDecimalPlaces: 2) = '0.01'.
	self assert: (-0.001 printShowingDecimalPlaces: 2) = '0.00'.! !

!NumberTest methodsFor: 'tests' stamp: 'nice 4/24/2008 00:58'!
testPrintShowingDecimalPlaces3
	"This problem were reported at http://bugs.squeak.org/view.php?id=7028
	unfortunate inversion of left / right padding"

	self assert: (1.009 printShowingDecimalPlaces: 3) = '1.009'.
	self assert: (35.900 printShowingDecimalPlaces: 3) = '35.900'.
	self assert: (-0.097 printShowingDecimalPlaces: 3) = '-0.097'.! !

!NumberTest methodsFor: 'tests' stamp: 'GabrielOmarCotelli 5/26/2009 21:57'!
testFractionPart

	self 
		assert: 2 fractionPart = 0;
		assert: (1/2) fractionPart = (1/2);
		assert: (4/3) fractionPart = (1/3);
		assert: 2.0 fractionPart = 0.0;
		assert: 0.5 fractionPart = 0.5;
		assert: 2.5 fractionPart = 0.5
! !

!NumberTest methodsFor: 'tests' stamp: 'SeanDeNigris 2/18/2015 12:57'!
testPercent

	self assert: (20 / 40) = 50 percent! !

!NumberTest methodsFor: 'tests' stamp: 'GabrielOmarCotelli 5/23/2009 19:26'!
testReciprocal

	self 
		assert: 1 reciprocal = 1;
		assert: 2 reciprocal = (1/2);
		assert: -1 reciprocal = -1;
		assert: -3 reciprocal = (-1/3).
		
	self should: [ 0 reciprocal ] raise: ZeroDivide! !

!NumberTest methodsFor: 'tests' stamp: 'GabrielOmarCotelli 5/25/2009 16:46'!
testRaisedToIntegerWithFloats

	self 
		assert: (2.0 raisedToInteger: 0) = 1.0;
		assert: (2.0 raisedToInteger: 1) = 2.0;
		assert: (2.0 raisedToInteger: 4) = 16.0;
		assert: (0.0 raisedToInteger: 0) = 1.0;
		assert: (0.0 raisedToInteger: 2) = 0.0;
		assert: (2.0 raisedToInteger: -1) = 0.5;
		assert: (2.0 raisedToInteger: -4) = 0.0625.
	
	self 
		assert: (-3.0 raisedTo: 0) = 1.0;
		assert: (-3.0 raisedTo: 1) = -3.0;
		assert: (-3.0 raisedTo: 2) = 9.0;
		assert: (-3.0 raisedTo: 3) = -27.0;
		assert: (-2.0 raisedTo: -2) = 0.25;
		assert: (-2.0 raisedTo: -3) = -0.125.
	
	self should: [ 0.0 raisedTo: -1 ] raise: ZeroDivide! !

!NumberTest methodsFor: 'tests' stamp: 'JohanBrichau 8/26/2010 14:18'!
testReadFrom
	
	self assert: 1.0e-14	= (Number readFrom: '1.0e-14').
	self assert: 2r1e26	= (Number readFrom: '2r1e26').
	self should: [Number readFrom: 'foo'] raise: Error! !

!NumberTest methodsFor: 'tests' stamp: 'GabrielOmarCotelli 5/26/2009 21:55'!
testIntegerPart

	self 
		assert: 2 integerPart = 2;
		assert: (1/2) integerPart = 0;
		assert: (4/3) integerPart = 1;
		assert: 2.0 integerPart = 2.0;
		assert: 0.5 integerPart = 0.0;
		assert: 2.5 integerPart = 2.0
! !

!NumberTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:23'!
testPrintShowingDecimalPlaces2
	"This tests problems related to Float>>rounded and Float>>roundTo::
	- Float>>#rounded is inexact
	- Float>>#roundTo: might overflow"

	"5000000000000001.0 asTrueFraction = 5000000000000001.
	5000000000000001 highBit = 53.
	This number is represented exactly asFloat, it should print exactly"

	self assert: (5000000000000001.0 printShowingDecimalPlaces: 0) = '5000000000000001'.	"50000000000001.25 asTrueFraction = (200000000000005/4).
	200000000000005 highBit = 48, 4 isPowerOfTwo,
	So this number is also represented exactly as Float, it should print exactly.
	Beware: (50000000000001.25 / 0.01) rounded exhibit the same problem as above."
	self assert: (50000000000001.25 printShowingDecimalPlaces: 2) = '50000000000001.25'.	"This number is close to maximum float value"
	1.0e306 printShowingDecimalPlaces: 3! !

!OCASTCheckerTest methodsFor: 'testing - simple' stamp: 'CamilloBruni 8/31/2013 20:23'!
testSemanticAnalysisOnNonMethodNode
	| ast |
	{[ 1 + 2 ].
	thisContext.
	(OCOpalExamples >> #exampleReturn1)}
		do: [ :object | 
			ast := object sourceNode.
			ast doSemanticAnalysis ].
	#('1' 'true' 'nil' '1 + 2' '^1' '1 + 2. 2 + 3' '#(1 true)' '{ #foo . 1 }' '1+2;+3')
		do: [ :source | 
			ast := RBExplicitVariableParser parseExpression: source.
			ast doSemanticAnalysis ].
	ast := RBExplicitVariableParser parseMethod: 'foo 1 + 2'.
	ast doSemanticAnalysis! !

!OCASTCheckerTest methodsFor: 'testing - variables' stamp: 'MarcusDenker 7/2/2012 10:45'!
testSingleRemoteDifferentBlocksSameArgumentName
	| ast assignment vars |
	ast := (OCOpalExamples>>#singleRemoteDifferentBlocksSameArgumentName) parseTree.
	self nameAnalysisNoClosureIn: OCOpalExamples for: ast.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 3.
	
	self deny: (ast scope lookupVar: 'b') isEscaping.
	self deny: (ast scope lookupVar: 'c') isEscaping.
	self assert: (ast scope lookupVar: 'z') isEscaping.


! !

!OCASTCheckerTest methodsFor: 'testing - variables' stamp: 'MarcusDenker 6/29/2012 16:03'!
testInstanceVar
	| ast assignment vars |
	ast := (OCOpalExamples>>#exampleiVar) parseTree.
	self nameAnalysisNoClosureIn: OCOpalExamples for: ast.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars isEmpty.
	
	self assert: ast scope outerScope isInstanceScope.
	self assert: (ast scope outerScope lookupVar: 'iVar') isInstance.
	
	assignment := RBParseTreeSearcher treeMatching: '`var := ``@anything' in: ast. 
	self assert: assignment variable isInstance.! !

!OCASTCheckerTest methodsFor: 'testing - variables' stamp: 'MarcusDenker 7/2/2012 10:45'!
testNoRemoteBlockArgument
	| ast assignment vars |
	ast := (OCOpalExamples>>#noRemoteBlockArgument) parseTree.
	self nameAnalysisNoClosureIn: OCOpalExamples for: ast.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 3.
	
	self deny: (ast scope lookupVar: 'block') isEscaping .
	self deny: (ast scope lookupVar: 'block1') isEscaping.
	self deny: (ast scope lookupVar: 'block2') isEscaping.


! !

!OCASTCheckerTest methodsFor: 'testing - blocks - optimized' stamp: 'MarcusDenker 6/7/2013 13:06'!
testExampleToDoArgument
	| ast |
	ast := (OCOpalExamples>>#exampleToDoArgument) parseTree.
	self nameAnalysisNoClosureIn: OCOpalExamples for: ast.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 0.! !

!OCASTCheckerTest methodsFor: 'testing - variables' stamp: 'MarcusDenker 7/2/2012 10:45'!
testNoRemoteMethodTemp
	| ast assignment vars |
	ast := (OCOpalExamples>>#noRemoteMethodTemp) parseTree.
	self nameAnalysisNoClosureIn: OCOpalExamples for: ast.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 2.
	
	self deny: (ast scope lookupVar: 'block1') isEscaping.
	self deny: (ast scope lookupVar: 'block2') isEscaping.
	


! !

!OCASTCheckerTest methodsFor: 'testing - variables' stamp: 'MarcusDenker 5/25/2013 16:44'!
testOptimizedBlockWrittenAfterClosedOverCase1
	| ast scopes |
	ast := (OCOpalExamples>>#optimizedBlockWrittenAfterClosedOverCase1) parseTree.
	self nameAnalysisNoClosureIn: OCOpalExamples for: ast.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 1.
	
	self deny: (ast scope lookupVar: 'index') isEscaping. 
	self assert: (ast scope lookupVar: 'index') definingScope  = ast scope.
	
	scopes := (OCScopesCollector new visitNode: ast) scopes.
	
	self assert: (scopes third lookupVar: 'temp') isWrite.
	self assert: (scopes third lookupVar: 'temp') isEscaping.

! !

!OCASTCheckerTest methodsFor: 'testing - variables' stamp: 'MarcusDenker 7/2/2012 10:43'!
testDoubleRemoteAnidatedBlocks
	| ast assignment vars scopes |
	ast := (OCOpalExamples>>#doubleRemoteAnidatedBlocks) parseTree.
	self nameAnalysisNoClosureIn: OCOpalExamples for: ast.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 2.
	
	self assert:  (ast scope lookupVar: 'last') isEscaping.
	self assert: (ast scope lookupVar: 'val') isEscaping.
	
	scopes := (OCScopesCollector new visitNode: ast) scopes.
	self assert: scopes size = 4.
	
	self assert: (scopes second lookupVar: 'i') isEscaping. "This is due to the inlined block."

	
	self assert: scopes third tempVars size = 1.
	self deny: (scopes third lookupVar: 'continue') isEscaping. "It is not escaping since is being accessed in an optimized block."


! !

!OCASTCheckerTest methodsFor: 'testing - variables' stamp: 'MarcusDenker 7/2/2012 10:45'!
testNoRemoteBlockTemp
	| ast assignment vars |
	ast := (OCOpalExamples>>#noRemoteBlockTemp) parseTree.
	self nameAnalysisNoClosureIn: OCOpalExamples for: ast.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 3.
	
	self deny: (ast scope lookupVar: 'block') isEscaping.
	self deny: (ast scope lookupVar: 'block1') isEscaping.
	self deny: (ast scope lookupVar: 'block2') isEscaping.


! !

!OCASTCheckerTest methodsFor: 'testing - variables' stamp: 'MarcusDenker 5/25/2013 16:46'!
testsingleRemoteTempVarWhileWithTempNotInlined
	| ast |
	ast := (OCOpalExamples>>#exampleWhileWithTempNotInlined) parseTree.
	self nameAnalysisNoClosureIn: OCOpalExamples for: ast.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 2.
	
	self assert: (ast scope lookupVar: 'index') isEscaping.
	self assert: (ast scope lookupVar: 'index') definingScope = ast scope.
	self deny: (ast scope lookupVar: 'block') isEscaping.
	self assert: (ast scope lookupVar: 'block') isTemp.


! !

!OCASTCheckerTest methodsFor: 'testing - variables' stamp: 'MarcusDenker 5/22/2013 16:50'!
testExampleSuper
	| ast assignment vars |
	ast := (OCOpalExamples>>#exampleSuper) parseTree.
	self nameAnalysisNoClosureIn: OCOpalExamples for: ast.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 1.
	self assert: (ast scope lookupVar: 'super') isSuper.
	
	assignment := RBParseTreeSearcher treeMatching: '`var := ``@anything' in: ast. 
	self assert: assignment value binding isSuper.! !

!OCASTCheckerTest methodsFor: 'testing - simple' stamp: 'MarcusDenker 7/2/2012 10:44'!
testReturn1
	| ast |
	ast := (OCOpalExamples>>#exampleReturn1) parseTree.
	self nameAnalysisNoClosureIn: OCOpalExamples for: ast.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars isEmpty.! !

!OCASTCheckerTest methodsFor: 'testing - primitives' stamp: 'MarcusDenler 12/10/2012 16:17'!
testExamplePrimitiveErrorCode
	| method ast ir newMethod |
	ast := (OCOpalExamples>>#examplePrimitiveErrorCode) parseTree.
	self nameAnalysisNoClosureIn: OCOpalExamples for: ast.

	self assert: (ast scope lookupVar: 'code') isTemp.

	! !

!OCASTCheckerTest methodsFor: 'testing - variables' stamp: 'MarcusDenker 5/22/2013 16:50'!
testExampleThisContext 
	| ast assignment vars |
	ast := (OCOpalExamples>>#exampleThisContext) parseTree.
	self nameAnalysisNoClosureIn: OCOpalExamples for: ast.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 1.
	self assert: (ast scope lookupVar: 'thisContext') isContext.
	
	assignment := RBParseTreeSearcher treeMatching: '`var := ``@anything' in: ast. 
	self assert: assignment value binding isContext.! !

!OCASTCheckerTest methodsFor: 'testing - variables' stamp: 'MarcusDenker 10/1/2013 15:08'!
testsingleRemoteTempVarWrittenAfterClosedOver
	| ast |
	ast := (OCOpalExamples>>#singleRemoteTempVarWrittenAfterClosedOver) parseTree.
	self nameAnalysisNoClosureIn: OCOpalExamples for: ast.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 2.
	
	self assert: (ast scope lookupVar: 'index') isWrite.
	self assert: (ast scope lookupVar: 'index') definingScope = ast scope.
	self deny: (ast scope lookupVar: 'block') isEscaping.
	self assert: (ast scope lookupVar: 'block') isTemp.

! !

!OCASTCheckerTest methodsFor: 'tools' stamp: 'MarcusDenker 5/18/2013 10:13'!
nameAnalysisNoClosureIn: class for: ast
	"Look up vars in classOrScope.  My tree will be annotated with bindings to Scopes and Variables."

	OCASTSemanticAnalyzer new
		compilationContext: class compiler compilationContext;
		visitNode: ast.! !

!OCASTCheckerTest methodsFor: 'testing - blocks - optimized' stamp: 'MarcusDenker 7/2/2012 10:44'!
testExampleInlineBlockCollectionLR3
	| ast |
	ast := (OCOpalExamples>>#exampleInlineBlockCollectionLR3) parseTree.
	self nameAnalysisNoClosureIn: OCOpalExamples for: ast.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 1. "index is a temp of the outer method due to optimized block"! !

!OCASTCheckerTest methodsFor: 'testing - variables' stamp: 'MarcusDenker 5/22/2013 16:50'!
testExampleSelf
	| ast assignment vars |
	ast := (OCOpalExamples>>#exampleSelf) parseTree.
	self nameAnalysisNoClosureIn: OCOpalExamples for: ast.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 1.
	self assert: (ast scope lookupVar: 'self') isSelf.
	
	assignment := RBParseTreeSearcher treeMatching: '`var := ``@anything' in: ast. 
	self assert: assignment value binding isSelf.! !

!OCASTCheckerTest methodsFor: 'testing - variables' stamp: 'MarcusDenker 7/2/2012 10:45'!
testSingleRemoteMethodArgument
	| ast assignment vars |
	ast := (OCOpalExamples>>#singleRemoteMethodArgument) parseTree.
	self nameAnalysisNoClosureIn: OCOpalExamples for: ast.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 2.
	
	self deny: (ast scope lookupVar: 'block') isEscaping.
	self assert: (ast scope lookupVar: 'temp') isEscaping.
	self assert: (ast scope lookupVar: 'temp') isWrite.


! !

!OCASTCheckerTest methodsFor: 'testing - variables' stamp: 'MarcusDenker 7/2/2012 10:45'!
testNoRemoteBlockReturn
	| ast assignment vars |
	ast := (OCOpalExamples>>#noRemoteBlockReturn) parseTree.
	self nameAnalysisNoClosureIn: OCOpalExamples for: ast.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 0.
	


! !

!OCASTCheckerTest methodsFor: 'testing - variables' stamp: 'MarcusDenker 7/2/2012 10:45'!
testOptimizedBlocksAndSameNameTemps
	| ast assignment vars scopes |
	ast := (OCOpalExamples>>#optimizedBlocksAndSameNameTemps) parseTree.
	self nameAnalysisNoClosureIn: OCOpalExamples for: ast.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 2.
	
	self deny: (ast scope lookupVar: 's') isRemote.
	self deny: (ast scope lookupVar: 'c') isRemote.
	
	scopes := (OCScopesCollector new visitNode: ast) scopes.
	
	self deny: (scopes second lookupVar: 'a') isRemote.
	self deny: (scopes fourth lookupVar: 'i') isRemote.


! !

!OCASTCheckerTest methodsFor: 'testing - variables' stamp: 'MarcusDenker 5/25/2013 16:45'!
testOptimizedBlockWrittenAfterClosedOverCase2
	| ast scopes |
	ast := (OCOpalExamples>>#optimizedBlockWrittenAfterClosedOverCase2) parseTree.
	self nameAnalysisNoClosureIn: OCOpalExamples for: ast.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 1.
	
	self deny: (ast scope lookupVar: 'index') isEscaping. 
	self assert: (ast scope lookupVar: 'index') definingScope= ast scope.
	
	scopes := (OCScopesCollector new visitNode: ast) scopes.
	
	self assert: ( scopes third lookupVar: 'temp') isEscapingWrite.
	self assert: ( scopes third lookupVar: 'temp') isEscaping.

! !

!OCASTCheckerTest methodsFor: 'testing - variables' stamp: 'MarcusDenker 10/1/2013 15:07'!
testSingleRemoteTempVar
	| ast |
	ast := (OCOpalExamples>>#singleRemoteTempVar) parseTree.
	self nameAnalysisNoClosureIn: OCOpalExamples for: ast.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 3.
	
	self assert: (ast scope lookupVar: 'index') isEscaping.
	self assert: (ast scope lookupVar: 'index') definingScope = ast scope.
	self deny: (ast scope lookupVar: 'block') isEscaping.
	self assert: (ast scope lookupVar: 'theCollection') isEscaping.
	self assert: (ast scope lookupVar: 'block') isTemp.
	self assert: (ast scope lookupVar: 'theCollection') isTemp.
	self deny: (ast scope lookupVar: 'theCollection') isInstance.
	self deny: (ast scope lookupVar: 'index') isInstance.
	self deny: (ast scope lookupVar: 'block') isInstance.

! !

!OCASTCheckerTest methodsFor: 'testing - simple' stamp: 'MarcusDenker 7/2/2012 10:44'!
testExampleIfNotNilReturnNil
	| ast |
	ast := (OCOpalExamples>>#exampleIfNotNilReturnNil) parseTree.
	self nameAnalysisNoClosureIn: OCOpalExamples for: ast.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 0.! !

!OCASTClosureAnalyzer commentStamp: 'MarcusDenker 8/11/2014 10:10'!
I visit the AST of method a second time (after OCASTSemanticAnalyzer) to analyze temps related to closures.!
!OCASTClosureAnalyzer methodsFor: 'visiting' stamp: 'MarcusDenker 5/22/2013 16:51'!
visitVariableNode: aVariableNode
	"re-lookup the temorary variables..."
	
	| var |
	aVariableNode isTemp ifFalse: [^self].
	var := scope lookupVar: aVariableNode name.
	aVariableNode binding: var.
	var isTempVectorTemp ifTrue: [scope addCopyingTempToAllScopesUpToDefVector: var vectorName].
	var isCopying ifTrue: [scope addCopyingTempToAllScopesUpToDefTemp: var].! !

!OCASTClosureAnalyzer methodsFor: 'visiting' stamp: 'MarcusDenker 4/11/2013 15:11'!
visitBlockNode: aBlockNode
	"here look at the temps and make copying vars / tempVector out of them"
	scope := aBlockNode scope.	
	self doRemotes; doCopying.
	self visitNode: aBlockNode body.
	scope := scope popScope.! !

!OCASTClosureAnalyzer methodsFor: 'variables' stamp: 'JorgeRessia 9/23/2010 15:59'!
doCopying
	| copying |
	copying := scope tempVars select: [ :each | each isEscapingRead].	
	copying do: [ :each | scope addCopyingTemp: each]! !

!OCASTClosureAnalyzer methodsFor: 'variables' stamp: 'JorgeRessia 9/22/2010 16:16'!
doRemotes
	| remotes |
	remotes := scope tempVars select: [ :each | each isEscapingWrite].
	remotes do: [ :each | scope moveToVectorTemp: each].	
	! !

!OCASTClosureAnalyzer methodsFor: 'visiting' stamp: 'MarcusDenker 4/11/2013 15:11'!
visitMethodNode: aMethodNode
	"here look at the temps and make copying vars / tempVector out of them"

	scope := aMethodNode scope.	
	self doRemotes; doCopying.
	self visitNode: aMethodNode body.
	scope := scope popScope.! !

!OCASTClosureAnalyzerTest methodsFor: 'tests - special cases' stamp: 'MarcusDenker 11/20/2012 15:46'!
testSingleRemoteDifferentBlocksSameArgumentName
	| ast assignment vars |
	ast := (OCOpalExamples>>#singleRemoteDifferentBlocksSameArgumentName) parseTree.
	ast doSemanticAnalysis.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 2.
	self assert: ast scope tempVector size = 1.
	
	self deny: (ast scope lookupVar: 'b') isRemote.
	self deny: (ast scope lookupVar: 'c') isRemote.
	self assert: (ast scope lookupVar: 'z') isRemote.
! !

!OCASTClosureAnalyzerTest methodsFor: 'tests - special cases' stamp: 'MarcusDenker 4/29/2013 17:39'!
testDoubleRemoteAnidatedBlocks
	| ast assignment vars scopes |
	ast := (OCOpalExamples>>#doubleRemoteAnidatedBlocks) parseTree.
	ast doSemanticAnalysis.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 0.
	self assert: ast scope tempVector size = 2.
	
	scopes := (OCScopesCollector new visitNode: ast) scopes.
	
	self assert: (ast scope lookupVar: 'last') isRemote.
	self assert: (ast scope lookupVar: 'val') isRemote.
	self assert: (ast scope lookupVar: 'val') vectorName = '0vector0'.
	self deny: (scopes second  lookupVar: 'i') isRemote. 
	

	
	


! !

!OCASTClosureAnalyzerTest methodsFor: 'tests - optimized blocks' stamp: 'MarcusDenker 5/22/2013 16:50'!
testExampleSimpleBlockLocalIf
	| ast  assignment var |
	ast := (OCOpalExamples>>#exampleSimpleBlockLocalIf) parseTree.
	ast doSemanticAnalysis.

	assignment := RBParseTreeSearcher treeMatching: '`var := ``@anything' in: ast. 	
	var := assignment variable binding.
	self assert: var isWrite.
	self deny: var isEscaping.! !

!OCASTClosureAnalyzerTest methodsFor: 'tests - special cases' stamp: 'MarcusDenker 11/20/2012 15:46'!
testSingleRemoteReadNestedBlocks
	| ast assignment vars |
	ast := (OCOpalExamples>>#singleRemoteReadNestedBlocks) parseTree.
	ast doSemanticAnalysis.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 0.
	self assert: ast scope tempVector size = 1.
	
	self assert: (ast scope lookupVar: 'a') isRemote.

! !

!OCASTClosureAnalyzerTest methodsFor: 'tests - special cases' stamp: 'MarcusDenker 10/1/2013 15:08'!
testsingleRemoteTempVarWrittenAfterClosedOver
	| ast |
	ast := (OCOpalExamples>>#singleRemoteTempVarWrittenAfterClosedOver) parseTree.
	ast doSemanticAnalysis.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 1.
	self assert: ast scope tempVector size = 1.
	
	self assert: (ast scope lookupVar: 'index') isRemote.
	self assert: (ast scope lookupVar: 'index') definingScope = ast scope.
	self deny: (ast scope lookupVar: 'block') isRemote.

! !

!OCASTClosureAnalyzerTest methodsFor: 'tests - special cases' stamp: 'MarcusDenker 11/20/2012 15:46'!
testOptimizedBlockWriteInNestedBlockCase2
	| ast assignment vars scopes |
	ast := (OCOpalExamples>>#optimizedBlockWriteInNestedBlockCase2) parseTree.
	ast doSemanticAnalysis.
	self assert: ast scope isMethodScope.
	
	self assert: ast scope tempVars size = 1.
	self assert: ast scope tempVector size = 0.
	self deny: (ast scope lookupVar: 't1') isRemote.
	self assert: ast scope copiedVars size = 0.
	


	

	
	


! !

!OCASTClosureAnalyzerTest methodsFor: 'tests - special cases' stamp: 'MarcusDenker 11/20/2012 15:45'!
testNestedBlocksRemoteInBlockCase3
	| ast assignment vars scopes |
	ast := (OCOpalExamples>>#nestedBlocksRemoteInBlockCase3) parseTree.
	ast doSemanticAnalysis.
	self assert: ast scope isMethodScope.
	
	self assert: ast scope tempVars size = 0.
	self assert: ast scope tempVector size = 1.
	self assert: (ast scope lookupVar: 'block') isRemote.
	
	scopes := (OCScopesCollector new visitNode: ast) scopes.
	
	self assert: scopes second tempVars size = 0.
	self assert: scopes second tempVector size = 0.
	
	self assert: scopes third tempVars size = 0.
	self assert: scopes third tempVector size = 1.
	self assert: (scopes third tempVector at: 'a') isRemote.
	
	self assert: scopes fourth tempVars size = 0.
	self assert: scopes fourth tempVector size = 0.
	
	self assert: scopes fifth tempVars size = 0.
	self assert: scopes fifth tempVector size = 1.
	self assert: (scopes fifth tempVector at: 'b') isRemote.


	

	
	


! !

!OCASTClosureAnalyzerTest methodsFor: 'tests - special cases' stamp: 'MarcusDenker 11/20/2012 15:45'!
testOptimizedBlockReadInBlock
	| ast assignment vars scopes |
	ast := (OCOpalExamples>>#optimizedBlockReadInBlock) parseTree.
	ast doSemanticAnalysis.
	self assert: ast scope isMethodScope.
	
	self assert: ast scope tempVars size = 1.
	self assert: ast scope tempVector size = 0.
	self deny: (ast scope lookupVar: 't1') isRemote.
	


	

	
	


! !

!OCASTClosureAnalyzerTest methodsFor: 'tests - special cases' stamp: 'MarcusDenker 11/20/2012 15:45'!
testNoRemoteBlockArgument
	| ast assignment vars |
	ast := (OCOpalExamples>>#noRemoteBlockArgument) parseTree.
	ast doSemanticAnalysis.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 3.
	
	self deny: (ast scope lookupVar: 'block') isRemote .
	self deny: (ast scope lookupVar: 'block1') isRemote.
	self deny: (ast scope lookupVar: 'block2') isRemote.


! !

!OCASTClosureAnalyzerTest methodsFor: 'tests - special cases' stamp: 'MarcusDenker 11/20/2012 15:45'!
testExampleSimpleBlockNested
	| ast assignment vars scopes |
	ast := (OCOpalExamples>>#exampleSimpleBlockNested) parseTree.
	ast doSemanticAnalysis.
	self assert: ast scope isMethodScope.
	
	self assert: ast scope tempVars size = 2.
	self assert: ast scope tempVector size = 1.
	self deny: (ast scope lookupVar: 'a') isRemote.
	self deny: (ast scope lookupVar: 'dict') isRemote.
	self assert: (ast scope lookupVar: 'match') isRemote.
	
	scopes := (OCScopesCollector new visitNode: ast) scopes.
	
	self assert: scopes second tempVars size = 2.
	self assert: scopes second tempVector size = 0.
	self deny: (scopes second lookupVar: 'each') isRemote.
	self deny: (scopes second lookupVar: 'index') isRemote.
	
	self assert: scopes second copiedVars size = 3


	

	
	


! !

!OCASTClosureAnalyzerTest methodsFor: 'tests - special cases' stamp: 'MarcusDenker 11/20/2012 15:45'!
testNestedBlocksRemoteInBlockCase2
	| ast assignment vars scopes |
	ast := (OCOpalExamples>>#nestedBlocksRemoteInBlockCase2) parseTree.
	ast doSemanticAnalysis.
	self assert: ast scope isMethodScope.
	
	self assert: ast scope tempVars size = 1.
	self assert: ast scope tempVector size = 0.
	self deny: (ast scope lookupVar: 'block') isRemote.
	
	scopes := (OCScopesCollector new visitNode: ast) scopes.
	
	self assert: scopes second tempVars size = 0.
	self assert: scopes second tempVector size = 0.
	
	self assert: scopes third tempVars size = 0.
	self assert: scopes third tempVector size = 1.
	self assert: (scopes third tempVector at: 'a') isRemote.
	
	self assert: scopes fourth tempVars size = 0.
	self assert: scopes fourth tempVector size = 0.
	
	self assert: scopes fifth tempVars size = 0.
	self assert: scopes fifth tempVector size = 1.
	self assert: (scopes fifth tempVector at: 'b') isRemote.


	

	
	


! !

!OCASTClosureAnalyzerTest methodsFor: 'tests - special cases' stamp: 'MarcusDenker 11/20/2012 15:45'!
testNoRemoteReadInBlock
	| ast assignment vars scopes |
	ast := (OCOpalExamples>>#noRemoteReadInBlock) parseTree.
	ast doSemanticAnalysis.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 1.
	self assert: ast scope tempVector size = 0.
	
	self deny: (ast scope lookupVar: 'a') isRemote.

	

	
	


! !

!OCASTClosureAnalyzerTest methodsFor: 'tests - special cases' stamp: 'MarcusDenker 11/20/2012 15:46'!
testOptimizedBlockWrittenAfterClosedOverCase1
	| ast assignment vars scopes |
	ast := (OCOpalExamples>>#optimizedBlockWrittenAfterClosedOverCase1) parseTree.
	ast doSemanticAnalysis.
	self assert: ast scope isMethodScope.
	
	self assert: ast scope tempVars size = 1.
	self assert: ast scope tempVector size = 0.
	
	scopes := (OCScopesCollector new visitNode: ast) scopes.
	
	self assert: scopes third  tempVars size = 0.
	self assert: scopes third  tempVector size = 1.
	
	self deny: (scopes third lookupVar: 'index') isRemote.
		"problem: as block is optimized, this var does not need to be remote"
	self assert: (scopes third tempVector at: 'temp') isRemote.

	
	


! !

!OCASTClosureAnalyzerTest methodsFor: 'tests - blocks' stamp: 'MarcusDenker 11/20/2012 15:45'!
testExampleWhileModificationBefore
	| ast assignment vars blockScope blockScope2 |
	ast := (OCOpalExamples>>#exampleWhileModificationBefore) parseTree.
	ast doSemanticAnalysis.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 0.
	self assert: ast scope tempVector size = 1.
	self assert: ast scope copiedVars size = 1.
	
	self assert: (ast scope lookupVar: 'index') isRemote. 
	

	


! !

!OCASTClosureAnalyzerTest methodsFor: 'tests - special cases' stamp: 'MarcusDenker 11/20/2012 15:45'!
testNoRemoteReadNestedBlocks
	| ast assignment vars scopes |
	ast := (OCOpalExamples>>#noRemoteReadNestedBlocks) parseTree.
	ast doSemanticAnalysis.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 0.
	self assert: ast scope tempVector size = 0.
	
	scopes := (OCScopesCollector new visitNode: ast) scopes.
	self assert: scopes second tempVars size = 1.
	self assert: scopes second tempVector size = 0.
	self deny: (scopes second lookupVar: 'a') isRemote.

	

	
	


! !

!OCASTClosureAnalyzerTest methodsFor: 'tests - special cases' stamp: 'MarcusDenker 11/20/2012 15:46'!
testWrittenAfterClosedOver
	| ast assignment vars scopes |
	ast := (OCOpalExamples>>#writtenAfterClosedOver) parseTree.
	ast doSemanticAnalysis.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 0.
	self assert: ast scope tempVector size = 1.
	
	self assert: (ast scope lookupVar: 'a') isRemote.

	

	
	


! !

!OCASTClosureAnalyzerTest methodsFor: 'tests - special cases' stamp: 'MarcusDenker 5/25/2013 16:48'!
testsingleRemoteTempVarWhileWithTempNotInlined
	| ast |
	ast := (OCOpalExamples>>#exampleWhileWithTempNotInlined) parseTree.
	ast doSemanticAnalysis.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 1.
	self assert: ast scope tempVector size = 1.
	
	self assert: (ast scope lookupVar: 'index') isRemote.
	self assert: (ast scope lookupVar: 'index') definingScope = ast scope.
	self deny: (ast scope lookupVar: 'block') isRemote.



! !

!OCASTClosureAnalyzerTest methodsFor: 'tests - blocks' stamp: 'NicolaiHess 10/24/2014 00:33'!
testExampleWhileNoModification
"A block in an optimized loop with no modification on temp vars in the loop
only needs to copy the tempvars. No write -> no indirection vector."
	| ast |
	ast := (OCOpalExamples>>#exampleWhileNoModification) parseTree.
	ast doSemanticAnalysis.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 3.
	self assert: ast scope tempVector size = 0.
	self assert: ast scope copiedVars size = 3.
	self deny: (ast scope lookupVar: 'a') isRemote. 
	self deny: (ast scope lookupVar: 'b') isRemote. 
	self deny: (ast scope lookupVar: 'c') isRemote. 
	

	


! !

!OCASTClosureAnalyzerTest methodsFor: 'tests - special cases' stamp: 'MarcusDenker 11/20/2012 15:45'!
testExampleSimpleBlockLocalWhile
	| ast assignment vars scopes |
	ast := (OCOpalExamples>>#exampleSimpleBlockLocalWhile) parseTree.
	ast doSemanticAnalysis.
	self assert: ast scope isMethodScope.
	
	self assert: ast scope tempVars size = 0.
	self assert: ast scope tempVector size = 1.
	self assert: (ast scope lookupVar: 'a') isRemote.
	
	scopes := (OCScopesCollector new visitNode: ast) scopes.
	
	self assert: scopes second tempVars size = 1.
	self assert: scopes second tempVector size = 0.
	self deny: (scopes second lookupVar: 'b') isRemote.
	self assert: (scopes second lookupVar: 'b') isArg.
	self deny: (scopes fourth lookupVar: 'hallo') isRemote.
	


	

	
	


! !

!OCASTClosureAnalyzerTest methodsFor: 'tests - special cases' stamp: 'MarcusDenker 11/20/2012 15:46'!
testOptimizedBlockWriteInNestedBlockCase4
	| ast assignment vars scopes |
	ast := (OCOpalExamples>>#optimizedBlockWriteInNestedBlockCase4) parseTree.
	ast doSemanticAnalysis.
	self assert: ast scope isMethodScope.
	
	self assert: ast scope tempVars size = 0.
	self assert: ast scope tempVector size = 1.
	self assert: (ast scope lookupVar: 't1') isRemote.
	self assert: ast scope copiedVars size = 1. "Is this correct, I think that the copied vars should be empty."
	
	scopes := (OCScopesCollector new visitNode: ast) scopes.
	self assert: scopes second tempVars size = 0.
	self assert: scopes second tempVector size = 0.
	self assert: scopes second copiedVars size = 1.
	scopes second copiedVars at: '0vector0' ifAbsent: [self fail]
	

	
	


! !

!OCASTClosureAnalyzerTest methodsFor: 'tests - special cases' stamp: 'MarcusDenker 11/20/2012 15:46'!
testSingleRemoteMethodArgument
	| ast assignment vars |
	ast := (OCOpalExamples>>#singleRemoteMethodArgument) parseTree.
	ast doSemanticAnalysis.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 1.
	self assert: ast scope tempVector size = 1.
	
	self deny: (ast scope lookupVar: 'block') isRemote.
	self assert: (ast scope lookupVar: 'temp') isRemote.

! !

!OCASTClosureAnalyzerTest methodsFor: 'tests - special cases' stamp: 'MarcusDenker 11/20/2012 15:46'!
testOptimizedBlockWriteInNestedBlockCase3
	| ast assignment vars scopes |
	ast := (OCOpalExamples>>#optimizedBlockWriteInNestedBlockCase3) parseTree.
	ast doSemanticAnalysis.
	self assert: ast scope isMethodScope.
	
	self assert: ast scope tempVars size = 0.
	self assert: ast scope tempVector size = 1.
	self assert: (ast scope lookupVar: 't1') isRemote.
	self assert: ast scope copiedVars size = 1. "Is this correct, I think that the copied vars should be empty."
	
	scopes := (OCScopesCollector new visitNode: ast) scopes.
	self assert: scopes second tempVars size = 0.
	self assert: scopes second tempVector size = 0.
	self assert: scopes second copiedVars size = 1.
	scopes second copiedVars at: '0vector0' ifAbsent: [self fail].
	self assert: ((scopes second copiedVars at: '0vector0') isStoringTempVector).	

	
	


! !

!OCASTClosureAnalyzerTest methodsFor: 'tests - special cases' stamp: 'MarcusDenker 5/3/2013 13:11'!
testNestedBlocksRemoteInBlockCase1
	| ast scopes |
	ast := (OCOpalExamples>>#nestedBlocksRemoteInBlockCase1) parseTree.
	ast doSemanticAnalysis.
	self assert: ast scope isMethodScope.
	
	self assert: ast scope tempVars size = 1.
	self assert: ast scope tempVector size = 0.
	self deny: (ast scope lookupVar: 'block') isRemote.
	
	scopes := (OCScopesCollector new visitNode: ast) scopes.
	
	self assert: scopes second tempVars size = 0.
	self assert: scopes second tempVector size = 2.
	self assert: (scopes second tempVector at: 'a') isRemote.
	self assert: (scopes second tempVector at: 'b') isRemote.


	

	
	


! !

!OCASTClosureAnalyzerTest methodsFor: 'tests - special cases' stamp: 'MarcusDenker 11/20/2012 15:47'!
testOptimizedBlockWriteInNestedBlock
	| ast assignment vars scopes |
	ast := (OCOpalExamples>>#optimizedBlockWriteInNestedBlock) parseTree.
	ast doSemanticAnalysis.
	self assert: ast scope isMethodScope.
	
	self assert: ast scope tempVars size = 0.
	self assert: ast scope tempVector size = 1.
	self assert: (ast scope lookupVar: 't1') isRemote.
	


	

	
	


! !

!OCASTClosureAnalyzerTest methodsFor: 'tests - special cases' stamp: 'MarcusDenker 11/20/2012 15:46'!
testOptimizedBlockWrittenAfterClosedOverCase2
	| ast assignment vars scopes |
	ast := (OCOpalExamples>>#optimizedBlockWrittenAfterClosedOverCase2) parseTree.
	ast doSemanticAnalysis.
	self assert: ast scope isMethodScope.
	
	self assert: ast scope tempVars size = 1.
	self assert: ast scope tempVector size =0.
	self deny: (ast scope lookupVar: 'index') isRemote.
	
	scopes := (OCScopesCollector new visitNode: ast) scopes.
	self assert: (scopes third tempVector at: 'temp') isRemote.

	
	


! !

!OCASTClosureAnalyzerTest methodsFor: 'tests - special cases' stamp: 'MarcusDenker 5/25/2013 16:47'!
testSingleRemoteTempVar
	| ast |
	ast := (OCOpalExamples>>#singleRemoteTempVar) parseTree.
	ast doSemanticAnalysis.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 2.
	self assert: ast scope tempVector size = 1.
	
	self assert: (ast scope lookupVar: 'index') isRemote.
	self assert: (ast scope lookupVar: 'index') definingScope = ast scope.
	self deny: (ast scope lookupVar: 'block') isRemote.
	self deny: (ast scope lookupVar: 'collection') isRemote.


! !

!OCASTClosureAnalyzerTest methodsFor: 'tests - blocks' stamp: 'MarcusDenker 11/20/2012 15:44'!
testExampleBlockArgument
	| ast assignment vars blockScope blockScope2 |
	ast := (OCOpalExamples>>#exampleBlockArgument) parseTree.
	ast doSemanticAnalysis.
	self assert: ast scope isMethodScope.
	self assert: ast scope tempVars size = 3.
	self assert: ast scope tempVector size = 0.
	self assert: ast scope copiedVars size = 0.
	
	self deny: (ast scope lookupVar: 'block') isRemote. 
	self deny: (ast scope lookupVar: 'block1') isRemote. 
	self deny: (ast scope lookupVar: 'block2') isRemote. 
	
	blockScope := (OCScopesCollector new visitNode: ast) scopes second.
	
	self assert: blockScope tempVars size = 2.
	self assert: blockScope tempVector size = 0.
	self assert: blockScope copiedVars size = 1.
	self deny: (blockScope lookupVar: 'temp') isRemote.
	self assert: (blockScope lookupVar: 'temp') isEscapingRead.
	self assert: (blockScope lookupVar: 'temp') isWrite.
	self deny: (blockScope lookupVar: 'temp') isEscapingWrite.
	self deny: (blockScope lookupVar: 'arg') isRemote.
	
	
	blockScope2 := (OCScopesCollector new visitNode: ast) scopes third.
	self assert: blockScope2 tempVars size = 0.
	self assert: blockScope2 tempVector size = 0.
	self assert: blockScope2 copiedVars size = 1.
	
	
	
	


! !

!OCASTClosureAnalyzerTest methodsFor: 'tests - special cases' stamp: 'MarcusDenker 11/20/2012 15:45'!
testOptimizedBlockWriteInBlock
	| ast assignment vars scopes |
	ast := (OCOpalExamples>>#optimizedBlockWriteInBlock) parseTree.
	ast doSemanticAnalysis.
	self assert: ast scope isMethodScope.
	
	self assert: ast scope tempVars size = 1.
	self assert: ast scope tempVector size = 0.
	self deny: (ast scope lookupVar: 't1') isRemote.
	


	

	
	


! !

!OCASTSemanticAnalyzer commentStamp: '<historical>'!
I visit each node in the abstract syntax tree while growing and shrinking a scope chain. Each method and block node is linked with its corresponding scope object, and each variable def and ref is linked with its corresponding OCVariable. Exceptions are raised for undefined variable references and so on (see subclasses of OCSemanticWarning).
!
!OCASTSemanticAnalyzer methodsFor: 'variables' stamp: 'md 11/14/2013 17:11'!
declareVariableNode: aVariableNode
	| name var |
	name := aVariableNode name.
	var := scope lookupVarForDeclaration: name.
	var
		ifNotNil: [ 
			self variable: aVariableNode shadows: var.
			(var scope ~= scope)
				ifTrue: [ 
					"Create new var that shadows outer one"
					var := scope addTemp: name ]
				]
		ifNil: [ 
			"new var"
			var := scope addTemp: name ].
	aVariableNode binding: var.
	^ var! !

!OCASTSemanticAnalyzer methodsFor: 'error handling' stamp: 'NicolaiHess 10/3/2014 00:03'!
storeIntoSpecialVariable: variableNode

	^ OCStoreIntoSpecialVariableError new
		node: variableNode;
		compilationContext: compilationContext;
		messageText: 'Cannot store into';
		signal! !

!OCASTSemanticAnalyzer methodsFor: 'variables' stamp: 'MarcusDenker 10/6/2014 10:39'!
lookupVariableForWrite: aVariableNode

	| var |
	
	var := scope lookupVar: aVariableNode name.

	var ifNil: [^var].
	var isSpecialVariable ifTrue: [ self storeIntoSpecialVariable: aVariableNode ].
	var isWritable ifFalse: [ self storeIntoReadOnlyVariable: aVariableNode ].
	
	var isTemp ifTrue: [
		(var scope outerNotOptimizedScope ~= scope outerNotOptimizedScope) "only escaping when they will end up in different closures"
			ifTrue: [ var markEscapingWrite]].
	^var! !

!OCASTSemanticAnalyzer methodsFor: 'visitor' stamp: 'PabloHerrero 1/5/2015 18:57'!
visitMessageNode: aMessageNode

	(aMessageNode isCascaded not or: [aMessageNode isFirstCascaded]) 
		ifTrue: [self visitNode: aMessageNode receiver].
	aMessageNode arguments do: [:each | self visitNode: each].
	
	! !

!OCASTSemanticAnalyzer methodsFor: 'error handling' stamp: 'MarcusDenker 5/22/2013 16:50'!
uninitializedVariable: variableNode
	variableNode binding markRead.
	^ OCUninitializedVariableWarning new
		node: variableNode;
		compilationContext: compilationContext;
		signal! !

!OCASTSemanticAnalyzer methodsFor: 'visitor' stamp: 'MarcusDenker 5/18/2013 10:44'!
visitMethodNode: aMethodNode
	

	scope := compilationContext scope newMethodScope. 
	aMethodNode scope: scope.  scope node: aMethodNode.
	aMethodNode arguments do: [:node | (self declareVariableNode: node) markArg].
	aMethodNode pragmas do: [:each | self visitNode: each].
	self visitNode: aMethodNode body.
	scope := scope outerScope.
! !

!OCASTSemanticAnalyzer methodsFor: 'visitor' stamp: 'CamilloBruni 2/26/2014 16:45'!
visitSequenceNode: aSequenceNode
	
	aSequenceNode temporaries do: [ :node | self declareVariableNode: node ].
	aSequenceNode parent isMethod
		ifTrue: [ 
			aSequenceNode parent pragmas
				detect: [ :pragma | pragma isPrimitiveError ]
				ifFound: [ :pragma | 
					self declareVariableNode: (RBVariableNode named: (pragma argumentAt: #error:) value asString) ] ].
	aSequenceNode statements do: [ :each | self visitNode: each ].
	aSequenceNode temporaries
		reverseDo: [ :node | 
			node binding isUnused
				ifTrue: [ self unusedVariable: node ] ]! !

!OCASTSemanticAnalyzer methodsFor: 'visitor' stamp: 'MarcusDenker 5/18/2013 10:23'!
visitBlockNode: aBlockNode
	blockcounter := self blockcounter + 1.

	aBlockNode isInlined ifTrue: [^ self visitInlinedBlockNode: aBlockNode ].	
	scope := scope newBlockScope: blockcounter. 
	aBlockNode scope: scope. scope node: aBlockNode.
	
	aBlockNode arguments do: [:node | (self declareVariableNode: node) markArg].
	self visitNode: aBlockNode body.
	scope := scope popScope.! !

!OCASTSemanticAnalyzer methodsFor: 'visitor' stamp: 'NicolaiHess 10/24/2014 00:30'!
visitVariableNode: aVariableNode
	| var |
	var := (self lookupVariableForRead: aVariableNode) ifNil: [(self undeclaredVariable: aVariableNode)].
	(var isTemp and: [var isEscaping and: [scope outerScope isInsideOptimizedLoop]])
		ifTrue: [
			 "only variables written within the loop needs to be marked as escaping write"
			var isRepeatedWrite ifTrue: [var markEscapingWrite].
			var isRead ifTrue: [var markEscapingRead]].
	aVariableNode binding: var.
	var isUninitialized ifTrue: [self uninitializedVariable: aVariableNode].! !

!OCASTSemanticAnalyzer methodsFor: 'error handling' stamp: 'NicolaiHess 10/3/2014 21:25'!
storeIntoReadOnlyVariable: variableNode

	^ OCStoreIntoReadOnlyVariableError new
		node: variableNode;
		compilationContext: compilationContext;
		messageText: 'Cannot store into';
		signal! !

!OCASTSemanticAnalyzer methodsFor: 'error handling' stamp: 'MarcusDenker 5/17/2013 16:26'!
unusedVariable: variableNode

	^ OCUnusedVariableWarning new
		node: variableNode;
		compilationContext: compilationContext;
		signal! !

!OCASTSemanticAnalyzer methodsFor: 'accessing' stamp: 'ClementBera 5/16/2013 13:59'!
compilationContext
	^ compilationContext! !

!OCASTSemanticAnalyzer methodsFor: 'variables' stamp: 'MarcusDenker 5/18/2013 10:32'!
lookupVariableForRead: aVariableNode

	| var |
	var := scope lookupVar: aVariableNode name.
	var ifNil: [^var].
	(var isTemp and: [var scope outerNotOptimizedScope ~= scope outerNotOptimizedScope] )  "only escaping when they will end up in different closures"
		ifTrue: [var markEscapingRead].
	^var! !

!OCASTSemanticAnalyzer methodsFor: 'error handling' stamp: 'MarcusDenker 5/17/2013 16:26'!
variable: variableNode shadows: semVar

	^ OCShadowVariableWarning new
		node: variableNode;
		shadowedVar: semVar;
		compilationContext: compilationContext;
		signal! !

!OCASTSemanticAnalyzer methodsFor: 'error handling' stamp: 'MarcusDenker 5/17/2013 16:26'!
undeclaredVariable: variableNode

	^ OCUndeclaredVariableWarning new
		node: variableNode;
		compilationContext: compilationContext;
		signal! !

!OCASTSemanticAnalyzer methodsFor: 'visitor' stamp: 'NicolaiHess 10/24/2014 00:30'!
visitAssignmentNode: anAssignmentNode
	| var |
	self visitNode: anAssignmentNode value.
	var := (self lookupVariableForWrite: anAssignmentNode variable)
		ifNil: [ self undeclaredVariable: anAssignmentNode variable ].
	scope isInsideOptimizedLoop
		ifTrue: [ var markRepeatedWrite ]
		ifFalse: [ var markWrite ].
	anAssignmentNode variable binding: var! !

!OCASTSemanticAnalyzer methodsFor: 'accessing' stamp: 'MarcusDenker 5/18/2013 10:23'!
blockcounter
	^blockcounter ifNil: [0]! !

!OCASTSemanticAnalyzer methodsFor: 'initialize-release' stamp: 'MarcusDenker 9/4/2010 09:53'!
scope: aSemScope
	scope := aSemScope! !

!OCASTSemanticAnalyzer methodsFor: 'accessing' stamp: 'MarcusDenker 5/7/2013 08:56'!
compilationContext: aCompilationContext
	compilationContext := aCompilationContext! !

!OCASTSemanticAnalyzer methodsFor: 'api' stamp: 'MarcusDenker 7/10/2013 15:55'!
analyze: aNode
	self visitNode: aNode.
	OCASTClosureAnalyzer new visitNode: aNode! !

!OCASTSemanticAnalyzer methodsFor: 'visitor' stamp: 'MarcusDenker 5/14/2013 16:32'!
visitPragmaNode: aPragmaNode
	super visitPragmaNode: aPragmaNode.
	aPragmaNode isCompilerOption
		ifTrue: [ aPragmaNode asPragma sendTo: aPragmaNode methodNode compilationContext ].! !

!OCASTSemanticAnalyzer methodsFor: 'visitor' stamp: 'MarcusDenker 5/18/2013 10:23'!
visitInlinedBlockNode: aBlockNode
	scope := scope newOptimizedBlockScope: blockcounter.
	aBlockNode isInlinedLoop ifTrue: [scope markInlinedLoop]. 
	aBlockNode scope: scope. scope node: aBlockNode.
	aBlockNode arguments do: [:node | (self declareVariableNode: node ) markArg.].
	self visitNode: aBlockNode body.
	scope := scope popScope.! !

!OCASTTranslator commentStamp: 'ajh 3/24/2003 22:19'!
I visit an abstract syntax tree and generate IR (intermediate representation) instructions for each node by sending the appropriate message to my methodBuilder (an IRBuilder).  I hold onto my two subclasses one for generating instructions for value, the other for generating instructions for effect.!
!OCASTTranslator methodsFor: 'inline messages' stamp: 'ClementBera 7/10/2013 14:13'!
emitIfFalse: aMessageNode

	self shouldBeSentToValueOrEffectTranslator! !

!OCASTTranslator methodsFor: 'visitor' stamp: 'MarcusDenker 5/18/2013 17:41'!
emitMessageNode: aMessageNode

	aMessageNode isCascaded ifFalse: [
		valueTranslator visitNode: aMessageNode receiver].
	aMessageNode arguments do: [:each | 
		valueTranslator visitNode: each].
	aMessageNode isSuperSend
		ifTrue: [methodBuilder send: aMessageNode selector toSuperOf: self compilationContext getClass]
		ifFalse: [methodBuilder send: aMessageNode selector].
! !

!OCASTTranslator methodsFor: 'errors' stamp: 'nice 5/1/2013 18:03'!
shouldBeSentToValueOrEffectTranslator
	self error: 'should be sent only to valueTranslator or effectTranslator'! !

!OCASTTranslator methodsFor: 'inline messages' stamp: 'MarcusDenker 9/20/2013 15:04'!
emitToByDo: aMessageNode 

	| step |
	
	step := aMessageNode arguments second.
	step isLiteralNode ifFalse: [self error: 'should not have been inlined'].
	step := step value.

	self emitToDo: aMessageNode step: step! !

!OCASTTranslator methodsFor: 'inline messages' stamp: 'ClementBera 6/26/2014 17:41'!
emitIfNotNilIfNil: aMessageNode
	self emitIfNil: aMessageNode boolean: true! !

!OCASTTranslator methodsFor: 'visitor-double dispatching' stamp: 'nice 5/1/2013 16:13'!
visitCascadeNode: aCascadeNode 

	valueTranslator visitNode: aCascadeNode receiver.
	aCascadeNode messages allButLastDo: [:node |
		methodBuilder pushDup.
		effectTranslator visitNode: node.
	].
	self visitNode: aCascadeNode messages last.
! !

!OCASTTranslator methodsFor: 'visitor-double dispatching' stamp: 'ClementBera 11/20/2013 19:36'!
visitMessageNode: aMessageNode
	aMessageNode isInlined ifTrue: [
		methodBuilder addLiteral: aMessageNode selector. "so searching for senders will work"
		^self 
			perform: (OptimizedMessages at: aMessageNode selector)
			with: aMessageNode].
	^ self emitMessageNode: aMessageNode! !

!OCASTTranslator methodsFor: 'visitor' stamp: 'cb 6/27/2013 16:53'!
visitMethodNode: aMethodNode
	
	aMethodNode arguments size > 15 ifTrue: [self backendError: 'Too many arguments' forNode: aMethodNode ].

	methodBuilder compilationContext: aMethodNode compilationContext.
	methodBuilder addTemps: aMethodNode scope tempVarNames.
		
	methodBuilder properties: aMethodNode properties.
	methodBuilder irPrimitive: aMethodNode primitiveFromPragma.
	aMethodNode pragmas do: [:each | self visitPragmaNode: each].
	methodBuilder numArgs: aMethodNode arguments size.
	
	aMethodNode scope tempVector ifNotEmpty: [
		methodBuilder 
			createTempVectorNamed: aMethodNode scope tempVectorName 
			withVars: (aMethodNode scope tempVector collect: [:each| each name]) asArray.
	].
	effectTranslator visitNode: aMethodNode body.
	aMethodNode body lastIsReturn ifFalse:  [methodBuilder pushReceiver; returnTop]! !

!OCASTTranslator methodsFor: 'visitor-double dispatching' stamp: 'MarcusDenker 7/10/2013 16:20'!
visitArrayNode: anArrayNode 

	| elementNodes |
	
	anArrayNode statements size > 32 ifTrue: [^ self visitLargeArrayNode: anArrayNode ].
	
	elementNodes := anArrayNode children.
	elementNodes do: [:node | valueTranslator visitNode: node].
	methodBuilder pushConsArray: elementNodes size.! !

!OCASTTranslator methodsFor: 'visitor' stamp: 'MarcusDenker 5/22/2013 16:50'!
visitVariableNode: aVariableNode
	aVariableNode binding emitValue: methodBuilder
	
	! !

!OCASTTranslator methodsFor: 'visitor-double dispatching' stamp: 'cb 9/26/2013 14:27'!
visitBlockNode: aBlockNode
	| tempNames argumentNames copiedNames |
	aBlockNode arguments size >15 ifTrue: [self backendError: 'Too many arguments' forNode: aBlockNode ].
	
	aBlockNode isInlined ifTrue: [^ self visitInlinedBlockNode: aBlockNode ].
	"uncomment to enable clean blocks
	aBlockNode isClean ifTrue: [^ self visitCleanBlockNode: aBlockNode ]."
	
	argumentNames := aBlockNode argumentNames asArray.
	tempNames := (aBlockNode scope tempVars asArray collect: [ :each | each name]) copyWithoutAll: argumentNames.
	copiedNames := (aBlockNode scope  inComingCopiedVars asArray collect: [:each | each name]).
	methodBuilder
			pushClosureCopyCopiedValues: copiedNames
			args: argumentNames
			jumpTo:  #block.
	 
	aBlockNode scope tempVector ifNotEmpty: [
		methodBuilder 
			createTempVectorNamed: aBlockNode scope tempVectorName 
			withVars: (aBlockNode scope tempVector collect: [:each| each name]) asArray.
	].
	methodBuilder addTemps: tempNames.
	valueTranslator visitNode: aBlockNode body.
	methodBuilder addBlockReturnTopIfRequired.
	self flag: 'why dont we just add a blockReturnTop here... it could be removed or ignored in IRTranslator'.
	methodBuilder jumpAheadTarget: #block.		

! !

!OCASTTranslator methodsFor: 'inline messages factored' stamp: 'ClementBera 6/26/2014 17:42'!
emitIf: aMessageNode boolean: aBoolean

	valueTranslator visitNode: aMessageNode receiver.
	
	self emitCondition: aMessageNode arguments boolean: aBoolean! !

!OCASTTranslator methodsFor: 'visitor-double dispatching' stamp: 'ClementBera 7/19/2013 14:24'!
visitLargeArrayNode: aRBArrayNode 
	"Long form: generates (Array braceStream: N) nextPut: a; nextPut: b; ...; braceArray"
	methodBuilder pushLiteralVariable: Array binding.
	methodBuilder pushLiteral: aRBArrayNode statements size.
	methodBuilder send: #braceStream:.
	aRBArrayNode statements do: [ :each |
		methodBuilder pushDup.
		valueTranslator visitNode: each.
		methodBuilder send: #nextPut:.
		methodBuilder popTop.
		].
	methodBuilder send: #braceArray.
				! !

!OCASTTranslator methodsFor: 'initialization' stamp: 'ClementBera 12/11/2012 11:35'!
initialize

	methodBuilder := IRBuilder new.
	effectTranslator := self as: OCASTTranslatorForEffect.
	valueTranslator := self as: OCASTTranslatorForValue.
	effectTranslator instVarNamed: #effectTranslator put: effectTranslator.
	effectTranslator instVarNamed: #valueTranslator put: valueTranslator.
	valueTranslator instVarNamed: #valueTranslator put: valueTranslator.
! !

!OCASTTranslator methodsFor: 'visitor-double dispatching' stamp: 'MarcusDenker 4/11/2013 15:12'!
visitLiteralArrayNode: aRBLiteralArrayNode 
	 
	methodBuilder pushLiteral: aRBLiteralArrayNode value.
! !

!OCASTTranslator methodsFor: 'inline messages' stamp: 'ClementBera 7/10/2013 14:11'!
emitWhileTrue: aMessageNode

	self emitWhile: aMessageNode boolean: false! !

!OCASTTranslator methodsFor: 'inline messages factored' stamp: 'ClementBera 7/10/2013 14:10'!
emitWhile: aMessageNode boolean: aBoolean

	methodBuilder jumpBackTarget: #begin.
	valueTranslator visitInlinedBlockNode: aMessageNode receiver.
	methodBuilder jumpAheadTo: #end if: aBoolean.
	aMessageNode arguments ifNotEmpty: [ 
			effectTranslator visitInlinedBlockNode: aMessageNode arguments first].
	methodBuilder jumpBackTo: #begin.
	methodBuilder jumpAheadTarget: #end.! !

!OCASTTranslator methodsFor: 'inline messages factored' stamp: 'ClementBera 7/10/2013 15:04'!
emitAllButLastCases: cases

	|  assocMessageNode  |
	
	1 to: cases size - 1 do: [:i |
		methodBuilder pushDup.
		assocMessageNode := cases at: i.
		valueTranslator visitInlinedBlockNode: assocMessageNode receiver.
		methodBuilder send: #=.
		methodBuilder jumpAheadTo: #next if: false.
		methodBuilder popTop.
		self visitInlinedBlockNode: assocMessageNode arguments first.
		methodBuilder jumpAheadTo: #end.
		methodBuilder jumpAheadTarget: #next.
	]! !

!OCASTTranslator methodsFor: 'testing' stamp: 'pmm 7/19/2006 11:52'!
isValueTranslator
	^self == valueTranslator! !

!OCASTTranslator methodsFor: 'visitor' stamp: 'CamilloBruni 2/26/2014 16:45'!
visitPragmaNode: aPragmaNode
	methodBuilder addPragma: aPragmaNode asPragma.
	aPragmaNode isPrimitiveError ifTrue: [
		methodBuilder storeTemp: (aPragmaNode argumentAt: #error:) value ].
! !

!OCASTTranslator methodsFor: 'testing' stamp: 'pmm 7/19/2006 11:54'!
isEffectTranslator
	^self == effectTranslator! !

!OCASTTranslator methodsFor: 'visitor-double dispatching' stamp: 'MarcusDenker 4/11/2013 15:12'!
visitInlinedBlockNode: anOptimizedBlockNode

	"We are visiting a scope that is not a block, but inlined in the outer context.
	This means: 
			- we do not create a Block
			- we call IRBuilder to add temps
	"
	
	| argumentNames tempNames  copiedNames  |
	argumentNames := anOptimizedBlockNode argumentNames asArray.
	tempNames := (anOptimizedBlockNode scope tempVars collect: [ :each | each name asSymbol]) copyWithoutAll: argumentNames.
	copiedNames := (anOptimizedBlockNode scope inComingCopiedVars collect: [:each | each name]) asArray.
	
	
	anOptimizedBlockNode scope tempVector ifNotEmpty: [
		methodBuilder 
			createTempVectorNamed: anOptimizedBlockNode scope tempVectorName 
			withVars: (anOptimizedBlockNode scope tempVector collect: [:each| each name]) asArray.
	].
	
	methodBuilder addTemps: tempNames.
	methodBuilder addTemps: copiedNames.
	methodBuilder addTemps: argumentNames.
	anOptimizedBlockNode isInlinedLoop ifTrue: [
		tempNames do: [ :tempName |
			methodBuilder pushLiteral: nil.
			methodBuilder storeTemp: tempName.
			methodBuilder popTop.
		 ]].
	
	self visitNode: anOptimizedBlockNode body.! !

!OCASTTranslator methodsFor: 'inline messages factored' stamp: 'ClementBera 6/26/2014 17:45'!
emitIfNil: aMessageNode boolean: aBoolean
	| args notNilBlock |
	
	valueTranslator visitNode: aMessageNode receiver.
	
	"emits the == nil code and push correct value on stack if the ifNotNil block has an argument"
	args := aMessageNode arguments.
	notNilBlock := aBoolean ifTrue: [args first] ifFalse: [args last].
	notNilBlock arguments ifNotEmpty: [ notNilBlock arguments first binding emitStore: methodBuilder ].
	methodBuilder pushLiteral: nil.
	methodBuilder send: #==.
	
	self emitCondition: args boolean: aBoolean! !

!OCASTTranslator methodsFor: 'inline messages factored' stamp: 'ClementBera 6/26/2014 17:46'!
emitCondition: args boolean: aBoolean
	"emits the jumps so that one of the 2 blocks in args is evaluated depending on boolean"
	
	methodBuilder jumpAheadTo: #else if: aBoolean.
	self visitInlinedBlockNode: args first.
	methodBuilder jumpAheadTo: #end.
	methodBuilder jumpAheadTarget: #else.
	self visitInlinedBlockNode: args last.
	methodBuilder jumpAheadTarget: #end.! !

!OCASTTranslator methodsFor: 'visitor-double dispatching' stamp: 'ClementBera 8/5/2013 11:09'!
visitCleanBlockNode: aBlockNode
! !

!OCASTTranslator methodsFor: 'inline messages' stamp: 'ClementBera 7/10/2013 14:11'!
emitWhileFalse: aMessageNode

	self emitWhile: aMessageNode boolean: true! !

!OCASTTranslator methodsFor: 'inline messages' stamp: 'ClementBera 7/10/2013 15:04'!
emitCaseOf: aMessageNode

	| cases assocMessageNode  |
	
	cases := aMessageNode arguments first statements.
	cases ifEmpty: [ self backendError: 'At least one case required' forNode: aMessageNode ].
	valueTranslator visitNode: aMessageNode receiver.
	self emitAllButLastCases: cases.
	
	"last case without otherwise"
	methodBuilder pushDup.
	assocMessageNode := cases last.
	valueTranslator visitInlinedBlockNode: assocMessageNode receiver.
	methodBuilder send: #=.
	methodBuilder jumpAheadTo: #next if: false.
	methodBuilder popTop.
	self visitInlinedBlockNode: assocMessageNode arguments first.
	methodBuilder jumpAheadTo: #end.
	methodBuilder jumpAheadTarget: #next.
	methodBuilder send: #caseError.
	aMessageNode lastIsReturn 
		ifTrue: [
			(aMessageNode owningScope) isBlockScope 
				ifTrue: [methodBuilder blockReturnTop] 
				ifFalse: [methodBuilder returnTop]] 
		ifFalse: [self isEffectTranslator ifTrue: [methodBuilder popTop]].

	cases size timesRepeat: [methodBuilder jumpAheadTarget: #end].! !

!OCASTTranslator methodsFor: 'errors' stamp: 'MarcusDenker 5/15/2013 14:49'!
backendError: aMessage forNode: aNode
		
	SyntaxErrorNotification 	
		inClass: Object
		category: nil
		withCode: aNode methodNode source
		doitFlag: false
		errorMessage: aMessage
		location: aNode startWithoutParentheses! !

!OCASTTranslator methodsFor: 'visitor-double dispatching' stamp: 'nice 5/2/2013 00:22'!
visitSequenceNode: aSequenceNode 

	self shouldBeSentToValueOrEffectTranslator! !

!OCASTTranslator methodsFor: 'inline messages' stamp: 'ClementBera 7/10/2014 16:26'!
emitOr: aMessageNode

	valueTranslator visitNode: aMessageNode receiver.
	methodBuilder jumpAheadTo: #else if: false.
	methodBuilder pushLiteral: true. 
	methodBuilder jumpAheadTo: #end.
	methodBuilder jumpAheadTarget: #else.
	valueTranslator visitInlinedBlockNode: aMessageNode arguments first.
	methodBuilder jumpAheadTarget: #end.! !

!OCASTTranslator methodsFor: 'visitor' stamp: 'JorgeRessia 5/6/2010 10:00'!
visitNode: aNode
	methodBuilder mapToNode: aNode.
	super visitNode: aNode.
	methodBuilder popMap.
! !

!OCASTTranslator methodsFor: 'inline messages factored' stamp: 'MarcusDenker 9/20/2013 15:04'!
emitToDo: aMessageNode step: step
	| limit block iterator limitEmit |
	
	limit := aMessageNode arguments first.
	block := aMessageNode arguments last.
	iterator := block arguments first binding.
	
	limitEmit := [valueTranslator visitNode: limit].
	limit isLiteralNode | limit isSelf | limit isSuper ifFalse: [
		valueTranslator visitNode: limit.
		methodBuilder addTemp: (iterator name, #limit).
		methodBuilder storeTemp: (iterator name, #limit).
		methodBuilder popTop.
		limitEmit := [methodBuilder pushTemp: (iterator name, #limit)]].

	"push start. allocate and initialize iterator"
	valueTranslator visitNode: aMessageNode receiver.
	iterator emitStore: methodBuilder.	
	self isEffectTranslator ifTrue: [methodBuilder popTop]. 
	methodBuilder jumpBackTarget: #start.
	iterator emitValue: methodBuilder.	
	limitEmit value.
	methodBuilder send: (step > 0 ifTrue: [#<=] ifFalse: [#>=]).
	methodBuilder jumpAheadTo: #done if: false.

	effectTranslator visitInlinedBlockNode: block.
	iterator emitValue: methodBuilder.
	methodBuilder pushLiteral: step.
	methodBuilder send: #+.
	iterator emitStore: methodBuilder.
	methodBuilder popTop.
	methodBuilder jumpBackTo: #start.
	methodBuilder jumpAheadTarget: #done.! !

!OCASTTranslator methodsFor: 'accessing' stamp: 'MarcusDenker 5/18/2013 17:38'!
compilationContext
	^methodBuilder compilationContext ! !

!OCASTTranslator methodsFor: 'inline messages' stamp: 'ClementBera 7/10/2013 14:13'!
emitIfTrue: aMessageNode

	self shouldBeSentToValueOrEffectTranslator! !

!OCASTTranslator methodsFor: 'inline messages' stamp: 'ClementBera 7/10/2013 15:04'!
emitCaseOfOtherwise: aMessageNode

	| cases assocMessageNode  |
	
	cases := aMessageNode arguments first statements.
	cases ifEmpty: [ self backendError: 'At least one case required' forNode: aMessageNode ].
	valueTranslator visitNode: aMessageNode receiver.
	self emitAllButLastCases: cases.
	
	"last case with otherwise"
	assocMessageNode := cases last.
	valueTranslator visitInlinedBlockNode: assocMessageNode receiver.
	methodBuilder send: #=.
	methodBuilder jumpAheadTo: #next if: false.
	self visitInlinedBlockNode: assocMessageNode arguments first.
	methodBuilder jumpAheadTo: #end.
	methodBuilder jumpAheadTarget: #next.
	self visitInlinedBlockNode: aMessageNode arguments last.

	cases size timesRepeat: [methodBuilder jumpAheadTarget: #end].! !

!OCASTTranslator methodsFor: 'visitor-double dispatching' stamp: 'MarcusDenker 6/11/2013 15:52'!
visitAssignmentNode: anAssignmentNode 

	valueTranslator visitNode: anAssignmentNode value.
	anAssignmentNode variable binding emitStore: methodBuilder
! !

!OCASTTranslator methodsFor: 'inline messages' stamp: 'ClementBera 7/10/2014 16:26'!
emitAnd: aMessageNode

	valueTranslator visitNode: aMessageNode receiver.
	methodBuilder jumpAheadTo: #else if: false.
	valueTranslator visitInlinedBlockNode: aMessageNode arguments first.
	methodBuilder jumpAheadTo: #end.
	methodBuilder jumpAheadTarget: #else.
	methodBuilder pushLiteral: false. 
	methodBuilder jumpAheadTarget: #end.! !

!OCASTTranslator methodsFor: 'inline messages' stamp: 'ClementBera 7/10/2013 14:08'!
emitToDo: aMessageNode 
	
	self emitToDo: aMessageNode step: 1! !

!OCASTTranslator methodsFor: 'inline messages' stamp: 'MarcusDenker 4/11/2013 15:12'!
emitIfNil: aMessageNode

	valueTranslator visitNode: aMessageNode receiver.
	self isValueTranslator ifTrue: [ methodBuilder pushDup ].
	methodBuilder pushLiteral: nil.
	methodBuilder send: #==.
	methodBuilder jumpAheadTo: #else if: false.
	self isValueTranslator ifTrue: [ methodBuilder popTop ].
	self visitInlinedBlockNode: aMessageNode arguments first.
	methodBuilder jumpAheadTarget: #else.
! !

!OCASTTranslator methodsFor: 'visitor-double dispatching' stamp: 'MarcusDenker 4/11/2013 15:12'!
visitLiteralNode: aLiteralNode

	methodBuilder pushLiteral: aLiteralNode value.
! !

!OCASTTranslator methodsFor: 'visitor' stamp: 'MarcusDenker 4/11/2013 15:12'!
visitReturnNode: aReturnNode 

	valueTranslator visitNode: aReturnNode value.
	methodBuilder returnTop.
		
! !

!OCASTTranslator methodsFor: 'inline messages' stamp: 'ClementBera 7/26/2013 14:05'!
emitTimesRepeat: aMessageNode 
	| limit block limitEmit |
	
	limit := aMessageNode receiver.
	block := aMessageNode arguments last.
	
	limitEmit := [valueTranslator visitNode: limit].
	limit isLiteral | limit isSelf | limit isSuper ifFalse: [
		valueTranslator visitNode: limit.
		methodBuilder addTemp: #limit.
		methodBuilder storeTemp: #limit.
		methodBuilder popTop.
		limitEmit := [methodBuilder pushTemp: #limit]].

	"push start. allocate and initialize iterator"
	self isValueTranslator ifTrue: [ limitEmit value ].
	methodBuilder pushLiteral: 1.
	methodBuilder addTemp: #iterator.
	methodBuilder storeTemp: #iterator.
	methodBuilder popTop. 
	methodBuilder jumpBackTarget: #start.
	methodBuilder pushTemp: #iterator.
	limitEmit value.
	methodBuilder send: #<=.
	methodBuilder jumpAheadTo: #done if: false.

	effectTranslator visitInlinedBlockNode: block.
	methodBuilder pushTemp: #iterator.
	methodBuilder pushLiteral: 1.
	methodBuilder send: #+.
	methodBuilder storeTemp: #iterator.
	methodBuilder popTop.
	methodBuilder jumpBackTo: #start.
	methodBuilder jumpAheadTarget: #done.! !

!OCASTTranslator methodsFor: 'inline messages' stamp: 'ClementBera 7/10/2013 14:33'!
emitIfFalseIfTrue: aMessageNode

	self emitIf: aMessageNode boolean: true! !

!OCASTTranslator methodsFor: 'inline messages' stamp: 'ClementBera 6/26/2014 17:41'!
emitIfNilIfNotNil: aMessageNode
	self emitIfNil: aMessageNode boolean: false! !

!OCASTTranslator methodsFor: 'inline messages' stamp: 'nice 5/1/2013 21:01'!
emitIfNotNil: aMessageNode

	self shouldBeSentToValueOrEffectTranslator! !

!OCASTTranslator methodsFor: 'inline messages' stamp: 'ClementBera 7/10/2013 14:33'!
emitIfTrueIfFalse: aMessageNode
	
	self emitIf: aMessageNode boolean: false! !

!OCASTTranslator methodsFor: 'accessing' stamp: 'ajh 3/10/2003 17:59'!
ir

	^ methodBuilder ir! !

!OCASTTranslator class methodsFor: 'initialize' stamp: 'ClementBera 11/26/2013 13:17'!
initialize
	"OCASTTranslator initialize"
	
	super initialize.
	
	OptimizedMessages := { 
	#caseOf: -> #emitCaseOf: .
	#caseOf:otherwise: -> #emitCaseOfOtherwise: .
	#ifFalse: -> #emitIfFalse: .
	#ifFalse:ifTrue: -> #emitIfFalseIfTrue: .
	#ifNil: -> #emitIfNil: .
	#ifNil:ifNotNil: -> #emitIfNilIfNotNil: .
	#ifNotNil: -> #emitIfNotNil: .
	#ifNotNil:ifNil: -> #emitIfNotNilIfNil: .
	#ifTrue: -> #emitIfTrue: .
	#ifTrue:ifFalse: -> #emitIfTrueIfFalse: .
	#or: -> #emitOr: .
	#and: -> #emitAnd: .
	#timesRepeat: -> #emitTimesRepeat: .
	#to:by:do: -> #emitToByDo: .
	#to:do: -> #emitToDo: .
	#whileFalse: -> #emitWhileFalse: .
	#whileTrue: -> #emitWhileTrue: .
	#whileFalse -> #emitWhileFalse: .
	#whileTrue -> #emitWhileTrue:
	 } asDictionary! !

!OCASTTranslatorForEffect commentStamp: 'ajh 3/24/2003 22:20'!
I override some methods in my super to generate instructions for effect only.!
!OCASTTranslatorForEffect methodsFor: 'inline messages' stamp: 'MarcusDenker 4/11/2013 15:12'!
emitIfFalse: aMessageNode

	valueTranslator visitNode: aMessageNode receiver.
	methodBuilder jumpAheadTo: #else if: true.
		self visitInlinedBlockNode: aMessageNode arguments first.
	methodBuilder jumpAheadTarget: #else.
! !

!OCASTTranslatorForEffect methodsFor: 'visitor-double dispatching' stamp: 'MarcusDenker 10/14/2010 15:50'!
emitMessageNode: aMessageNode 

	super emitMessageNode: aMessageNode.
	methodBuilder popTop.
! !

!OCASTTranslatorForEffect methodsFor: 'visitor-double dispatching' stamp: 'nice 5/2/2013 00:21'!
visitSequenceNode: aSequenceNode 
	aSequenceNode statements do: [:each | self visitNode: each].! !

!OCASTTranslatorForEffect methodsFor: 'visitor-double dispatching' stamp: 'ClementBera 10/22/2013 13:09'!
visitArrayNode: anArrayNode 
	"An arrayNode may have side effect, for example: '{self foo}'. So we cannot just generate nothing for this node."

	super visitArrayNode: anArrayNode.
	methodBuilder popTop.
! !

!OCASTTranslatorForEffect methodsFor: 'inline messages' stamp: 'ClementBera 7/10/2014 16:26'!
emitOr: aMessageNode

	super emitOr: aMessageNode.
	methodBuilder popTop.! !

!OCASTTranslatorForEffect methodsFor: 'visitor-double dispatching' stamp: 'ClementBera 10/22/2013 13:04'!
visitBlockNode: aBlockNode 

	"A block has no side effect, so a block translated for effect just doesn't generate anything" 
! !

!OCASTTranslatorForEffect methodsFor: 'visitor-double dispatching' stamp: 'ClementBera 7/8/2014 16:30'!
visitVariableNode: aVariableNode
	"when visiting a variable for effect, we could push it and then pop it, but we do nothing"
	| binding |
	binding := aVariableNode binding.
	(binding isLiteralVariable or: [ binding isUndeclared ])
		ifTrue: [ methodBuilder addLiteral: binding assoc ]! !

!OCASTTranslatorForEffect methodsFor: 'inline messages' stamp: 'MarcusDenker 4/11/2013 15:12'!
emitIfTrue: aMessageNode

	valueTranslator visitNode: aMessageNode receiver.
	methodBuilder jumpAheadTo: #else if: false.	
		self visitInlinedBlockNode: aMessageNode arguments first.
	methodBuilder jumpAheadTarget: #else.! !

!OCASTTranslatorForEffect methodsFor: 'visitor-double dispatching' stamp: 'ClementBera 7/8/2014 16:27'!
visitLiteralArrayNode: aLiteralNode
	"when visiting a literal array for effect, we could push it and then pop it, but we do nothing"
	methodBuilder addLiteral: aLiteralNode value! !

!OCASTTranslatorForEffect methodsFor: 'visitor-double dispatching' stamp: 'MarcusDenker 4/11/2013 15:12'!
visitAssignmentNode: anAssignmentNode 

	super visitAssignmentNode: anAssignmentNode .
	methodBuilder popTop. ! !

!OCASTTranslatorForEffect methodsFor: 'inline messages' stamp: 'ClementBera 7/10/2014 16:26'!
emitAnd: aMessageNode
	
	super emitAnd: aMessageNode.
	methodBuilder popTop.! !

!OCASTTranslatorForEffect methodsFor: 'visitor-double dispatching' stamp: 'ClementBera 7/8/2014 16:27'!
visitLiteralNode: aLiteralNode
	"when visiting a literal for effect, we could push it and then pop it, but we do nothing"
	methodBuilder addLiteral: aLiteralNode value! !

!OCASTTranslatorForEffect methodsFor: 'inline messages' stamp: 'MarcusDenker 5/22/2013 16:50'!
emitIfNotNil: aMessageNode
	| args |
	valueTranslator visitNode: aMessageNode receiver.
	args := aMessageNode arguments.
	args first arguments ifNotEmpty: [ args first arguments first binding emitStore: methodBuilder ].
	methodBuilder pushLiteral: nil.
	methodBuilder send: #==.
	methodBuilder jumpAheadTo: #end if: true.
	self visitInlinedBlockNode: args first.
	methodBuilder jumpAheadTarget: #end.
	! !

!OCASTTranslatorForValue commentStamp: 'ajh 3/24/2003 22:20'!
I override some methods in my super to generate instructions for effect and value only.!
!OCASTTranslatorForValue methodsFor: 'inline messages' stamp: 'nice 5/1/2013 23:02'!
emitIfFalse: aMessageNode
	
	self visitNode: aMessageNode receiver.
	methodBuilder jumpAheadTo: #false if: false.
		methodBuilder pushLiteral: nil.
		methodBuilder jumpAheadTo: #end.
		methodBuilder jumpAheadTarget: #false.
	self visitInlinedBlockNode: aMessageNode arguments first.
	methodBuilder jumpAheadTarget: #end.! !

!OCASTTranslatorForValue methodsFor: 'visitor-double dispatching' stamp: 'nice 5/2/2013 00:21'!
visitSequenceNode: aSequenceNode 
	| statements |
	statements := aSequenceNode statements.
	statements ifEmpty: [
		methodBuilder pushLiteral: nil.
		^self].
	statements allButLastDo: [:each | effectTranslator visitNode: each].
	self visitNode: statements last.! !

!OCASTTranslatorForValue methodsFor: 'inline messages' stamp: 'MarcusDenker 6/23/2012 12:09'!
emitWhileTrue: aMessageNode

	super emitWhileTrue: aMessageNode.
	methodBuilder pushLiteral: nil.
! !

!OCASTTranslatorForValue methodsFor: 'inline messages' stamp: 'MarcusDenker 6/23/2012 12:09'!
emitWhileFalse: aMessageNode

	super emitWhileFalse: aMessageNode.
	methodBuilder pushLiteral: nil.
! !

!OCASTTranslatorForValue methodsFor: 'inline messages' stamp: 'MarcusDenker 6/11/2013 15:52'!
emitIfNotNil: aMessageNode
	| args |
	self visitNode: aMessageNode receiver.
	args := aMessageNode arguments.
	args first arguments ifNotEmpty: [ args first arguments first binding emitStore: methodBuilder ].
	methodBuilder pushDup.
	methodBuilder pushLiteral: nil.
	methodBuilder send: #==.
	methodBuilder jumpAheadTo: #end if: true.
	methodBuilder popTop.
	self visitInlinedBlockNode: args first.
	methodBuilder jumpAheadTarget: #end.! !

!OCASTTranslatorForValue methodsFor: 'inline messages' stamp: 'nice 5/1/2013 23:03'!
emitIfTrue: aMessageNode
	
	self visitNode: aMessageNode receiver.
	methodBuilder jumpAheadTo: #else if: false.
	self visitInlinedBlockNode:  aMessageNode arguments first.
	methodBuilder jumpAheadTo: #end.
	methodBuilder jumpAheadTarget: #else.
	methodBuilder pushLiteral: nil.
	methodBuilder jumpAheadTarget: #end.! !

!OCASTTranslatorTest methodsFor: 'testing - blocks - optimized' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleToDoInsideTemp
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleToDoInsideTemp) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleToDoInsideTemp.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - misc' stamp: 'ClementBera 6/28/2013 13:38'!
testPushBigArray
	| ast ir aCompiledMethod instance |
	ast := (OCOpalExamples>>#examplePushBigArray) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new .
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance examplePushBigArray.! !

!OCASTTranslatorTest methodsFor: 'testing - blocks' stamp: 'ClementBera 5/21/2013 14:54'!
testExampleBlockExternal
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleBlockExternal) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new. 
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleBlockExternal.
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks - optimized' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleIfTrueAssign
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleIfTrueAssign) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = 1.
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleSimpleBlockEmpty
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleSimpleBlockEmpty) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleSimpleBlockEmpty .
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks - optimized' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleToDoOutsideTemp
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleToDoOutsideTemp) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleToDoOutsideTemp.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - simple' stamp: 'MarcusDenker 6/29/2012 16:16'!
testNewArray
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleNewArray) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleNewArray.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - primitives' stamp: 'MarcusDenler 12/10/2012 16:20'!
testExamplePrimitiveErrorCode
	| method ast ir newMethod |
	method := (OCOpalExamples>>#examplePrimitiveErrorCode).
	ast := method parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.

	newMethod := ir compiledMethod.
	self assert: method primitive = newMethod primitive. 

	

	
	

	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleSimpleBlockReturn
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleSimpleBlockReturn) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleSimpleBlockReturn.
	! !

!OCASTTranslatorTest methodsFor: 'testing - variables' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleThisContext
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleThisContext) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: OCOpalExamples new exampleThisContext isContext.
	self assert: ((OCOpalExamples>>#exampleThisContext) valueWithReceiver: instance arguments: #()) isContext.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) isContext.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleBlockExternal2
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleBlockExternal2) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleBlockExternal2.
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleBlockInternal
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleBlockInternal) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleBlockInternal.
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleSimpleBlock
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleSimpleBlock) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) value = instance exampleSimpleBlock value.
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleSimpleBlockLocal
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleSimpleBlockLocal) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleSimpleBlockLocal .
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleSimpleBlockLocalIfNested
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleSimpleBlockLocalIfNested) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleSimpleBlockLocalIfNested.
	! !

!OCASTTranslatorTest methodsFor: 'testing - misc' stamp: 'MarcusDenker 11/20/2012 16:29'!
testTodoValue
	| ast ir aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleToDoValue) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new .
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleToDoValue.! !

!OCASTTranslatorTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleBlockMethodArgument
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleBlockMethodArgument:) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #(2)) = 4.
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks - optimized' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleIfNotNilArg
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleIfNotNilArg) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleIfNotNilArg.
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks - optimized' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleIfTrue
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleIfTrue) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = 'result'.
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleMethodTempInNestedBlock
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleMethodTempInNestedBlock) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: ((aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleMethodTempInNestedBlock)
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleSimpleBlockArgument4
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleSimpleBlockArgument4) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleSimpleBlockArgument4 .
	! !

!OCASTTranslatorTest methodsFor: 'testing - misc' stamp: 'ClementBera 7/8/2014 16:31'!
testExampleEffectValues
	| cm |
	cm := OCOpalExamples compiler compile: (OCOpalExamples>>#exampleEffectValues) sourceCode.
	self assert: (cm literals includes: #getMe).
	self assert: (cm literals includes: Class binding).
	self assert: (cm literals includes: #( got that ? )).! !

!OCASTTranslatorTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleSimpleBlockNested
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleSimpleBlockNested) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleSimpleBlockNested.
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks - optimized' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleToDoArgument
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleToDoArgument) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleToDoArgument.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks - optimized' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleToDoInsideTempNotInlined
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleToDoInsideTempNotInlined) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleToDoInsideTempNotInlined.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks - optimized' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleWhileModificationBeforeNotInlined
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleWhileModificationBeforeNotInlined) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleWhileModificationBeforeNotInlined.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleBlockNested
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleBlockNested) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleBlockNested.
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleWhileModificationBefore
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleWhileModificationBefore) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: OCOpalExamples new arguments: #()) = instance exampleWhileModificationBefore.
	! !

!OCASTTranslatorTest methodsFor: 'testing - misc' stamp: 'MarcusDenker 6/29/2012 16:16'!
testPushArray
	| ast ir aCompiledMethod instance |
	ast := (OCOpalExamples>>#examplePushArray) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new .
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance examplePushArray.! !

!OCASTTranslatorTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleSimpleBlockArgument5
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleSimpleBlockArgument5) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleSimpleBlockArgument5 .
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks - optimized' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleWhileModificationAfterNotInlined
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleWhileModificationAfterNotInlined) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleWhileModificationAfterNotInlined.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks - optimized' stamp: 'ClementBera 7/26/2013 14:25'!
testExampleTimesRepeatEffect
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleTimesRepeatEffect) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleTimesRepeatEffect.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - variables' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleSuper
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleSuper) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleSuper.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - simple' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleIfFalseIfTrue
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleIfFalseIfTrue) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleIfFalseIfTrue.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks - optimized' stamp: 'ClementBera 7/26/2013 14:26'!
testExampleTimesRepeatValue
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleTimesRepeatValue) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleTimesRepeatValue.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks - optimized' stamp: 'MarcusDenker 12/7/2012 15:32'!
testExampleToDoArgumentLimitIsExpression
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleToDoArgumentLimitIsExpression) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleToDoArgumentLimitIsExpression.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks - optimized' stamp: 'ClementBera 7/10/2014 16:29'!
testExampleAndOr2
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleAndOr2) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleAndOr2.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - variables' stamp: 'MarcusDenker 6/29/2012 16:16'!
testiVar
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleiVar) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleiVar.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks - optimized' stamp: 'ClementBera 7/10/2014 16:29'!
testExampleAndOr3
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleAndOr3) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleAndOr3.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks - optimized' stamp: 'ClementBera 7/16/2014 11:10'!
testExampleAndOr5
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleAndOr5) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleAndOr5.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleBlockExternalNested
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleBlockExternalNested) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleBlockExternalNested.
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleBlockExternalArg
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleBlockExternalArg) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleBlockExternalArg.
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleWhileWithTemp
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleWhileWithTemp) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleWhileWithTemp.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleWhileWithTempNotInlined
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleWhileWithTempNotInlined) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleWhileWithTempNotInlined.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks - optimized' stamp: 'ClementBera 7/10/2014 16:29'!
testExampleAndOr
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleAndOr) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleAndOr.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks - optimized' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleToDoArgumentNotInlined
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleToDoArgumentNotInlined) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleToDoArgumentNotInlined.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 11/20/2012 15:47'!
testExampleBlockArgument
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleBlockArgument) parseTree.
	ir := ast doSemanticAnalysis ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleBlockArgument.
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleSimpleBlockArgument3
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleSimpleBlockArgument3) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleSimpleBlockArgument3.
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks - optimized' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleIfNotNilReturnNil
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleIfNotNilReturnNil) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleIfNotNilReturnNil.
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleSimpleBlockiVar
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleSimpleBlockiVar) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: ((aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleSimpleBlockiVar)
	! !

!OCASTTranslatorTest methodsFor: 'testing - simple' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleIfFalse
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleIfFalse) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleIfFalse.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks - optimized' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleMethodWithOptimizedBlocksA
	| ir ast aCompiledMethod instance |
	ast  := (OCOpalExamples>>#exampleMethodWithOptimizedBlocksA) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new .
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleMethodWithOptimizedBlocksA.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleSimpleBlockArgument1
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleSimpleBlockArgument1) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleSimpleBlockArgument1.
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleSimpleBlockArgument2
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleSimpleBlockArgument2) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleSimpleBlockArgument2.
	! !

!OCASTTranslatorTest methodsFor: 'testing - misc' stamp: 'MarcusDenker 12/7/2012 15:51'!
testTodoValueLimitExpression
	| ast ir aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleToDoValueLimitExpression) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new .
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleToDoValueLimitExpression.! !

!OCASTTranslatorTest methodsFor: 'testing - blocks - optimized' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleSimpleBlockLocalIf
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleSimpleBlockLocalIf) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleSimpleBlockLocalIf.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks - optimized' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleToDoOutsideTempNotInlined
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleToDoOutsideTempNotInlined) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleToDoOutsideTempNotInlined.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - simple' stamp: 'MarcusDenker 6/29/2012 16:16'!
testReturn1
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleReturn1) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleReturn1.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks - optimized' stamp: 'ClementBera 7/16/2014 11:11'!
testExampleAndOr6
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleAndOr6) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleAndOr6.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleInlineBlockCollectionLR3
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleInlineBlockCollectionLR3) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = (2 to: 12) asArray.
	! !

!OCASTTranslatorTest methodsFor: 'testing - variables' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleSelf
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleSelf) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleSelf.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - primitives' stamp: 'MarcusDenler 12/10/2012 15:27'!
testExamplePrimitiveErrorCodeModule
	| method ast ir newMethod |
	method := (OCOpalExamples>>#examplePrimitiveErrorCodeModule).
	ast := method parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.

	newMethod := ir compiledMethod.
	
	self assert: method primitive = newMethod primitive. 
	self assert: method pragmas printString  = newMethod pragmas printString
	

	
	

	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks - optimized' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleIfTrueIfFalse
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleIfTrueIfFalse) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = 'result'.
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleNestedBlockScoping
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleNestedBlockScoping) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleNestedBlockScoping.
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks - optimized' stamp: 'ClementBera 7/10/2014 16:29'!
testExampleAndOr4
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleAndOr4) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleAndOr4.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks - optimized' stamp: 'MarcusDenker 6/29/2012 16:16'!
testExampleSimpleBlockLocalWhile
	| ir ast aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleSimpleBlockLocalWhile) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleSimpleBlockLocalWhile.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - simple' stamp: 'MarcusDenker 6/29/2012 16:16'!
testOnePlusTwo
	| ast ir aCompiledMethod instance |
	ast  := (OCOpalExamples>>#exampleReturn1plus2) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new.
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleReturn1plus2.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - blocks - optimized' stamp: 'MarcusDenler 12/11/2012 15:03'!
testExampleOptimizedBlockWrittenAfterClosedOverCase1
	| ir ast aCompiledMethod instance |
	ast  := (OCOpalExamples>>#optimizedBlockWrittenAfterClosedOverCase1) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new .
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance optimizedBlockWrittenAfterClosedOverCase1.
	
	! !

!OCASTTranslatorTest methodsFor: 'testing - simple' stamp: 'MarcusDenker 6/29/2012 16:16'!
testEmptyMethod
	| ast ir aCompiledMethod instance |
	ast := (OCOpalExamples>>#exampleEmptyMethod) parseTree.
	ir := (ast doSemanticAnalysisIn: OCOpalExamples) ir.
	instance := OCOpalExamples new .
	
	aCompiledMethod := ir compiledMethod.
	self assert: (aCompiledMethod valueWithReceiver: instance arguments: #()) = instance exampleEmptyMethod.
	
	! !

!OCAbstractLocalVariable commentStamp: '<historical>'!
I am an argument or temporary variable of a method or block.

index is not the index in the bytecode but just used for sorting
(see tempVars). to be fixed...!
!OCAbstractLocalVariable methodsFor: 'read/write usage' stamp: 'MarcusDenker 10/16/2013 15:28'!
isUninitialized
	usage ifNil: [ ^true ].
	self isArg ifTrue: [ ^false ]. "arguments are never unitialized"
	^self isRead! !

!OCAbstractLocalVariable methodsFor: 'initializing' stamp: 'jorgeRessia 11/14/2009 10:56'!
name: string
	name := string! !

!OCAbstractLocalVariable methodsFor: 'read/write usage' stamp: 'MarcusDenker 9/5/2010 20:13'!
markArg

	usage := #arg! !

!OCAbstractLocalVariable methodsFor: 'testing' stamp: 'ms 7/31/2007 00:42'!
isLocal

	^true! !

!OCAbstractLocalVariable methodsFor: 'accessing' stamp: 'ajh 6/23/2004 22:51'!
name

	^ name! !

!OCAbstractLocalVariable methodsFor: 'read/write usage' stamp: 'MarcusDenker 9/5/2010 20:13'!
isArg

	^usage = #arg! !

!OCAbstractMethodScope commentStamp: '<historical>'!
I am an abstract superclass for Block and Method scopes!
!OCAbstractMethodScope methodsFor: 'temp vars' stamp: 'MarcusDenker 12/17/2012 15:18'!
allTempNames
	^self allTemps collect: #name.! !

!OCAbstractMethodScope methodsFor: 'initializing' stamp: 'MarcusDenker 9/9/2010 17:25'!
id: int
	id := int! !

!OCAbstractMethodScope methodsFor: 'temp vars' stamp: 'MarcusDenker 9/22/2010 10:51'!
addCopyingTempToAllScopesUpToDefVector: aName
		
	(self hasCopyingTempNamed: aName) ifFalse: [self addCopyingTempNamed: aName].
	self tempVectorName = aName  ifTrue: [^ self].
	^ self outerScope addCopyingTempToAllScopesUpToDefVector: aName.! !

!OCAbstractMethodScope methodsFor: 'temp vars' stamp: 'JorgeRessia 9/7/2010 20:24'!
copiedVars
	^ copiedVars! !

!OCAbstractMethodScope methodsFor: 'temp vars' stamp: 'JorgeRessia 9/7/2010 20:25'!
tempVector
	^ tempVector ! !

!OCAbstractMethodScope methodsFor: 'temp vars' stamp: 'MarcusDenker 8/13/2014 10:10'!
addTemp: name
	^ tempVars
		at: name
		put: (OCTempVariable new
				name: name;
				scope: self;
				yourself)! !

!OCAbstractMethodScope methodsFor: 'temp vars' stamp: 'MarcusDenker 8/17/2014 13:23'!
addVectorTemp: aTemp
	^ tempVector 
		at:  aTemp name
		put: (OCVectorTempVariable new
			name: aTemp name;
			vectorName: self tempVectorName;
			scope: self;
			usage: aTemp usage;
			escaping: aTemp escaping;
			yourself)! !

!OCAbstractMethodScope methodsFor: 'scope' stamp: 'ClementBera 8/5/2013 10:49'!
outerOffsetTo: aScope
	"return how many scopes up from me aScope is. We ignore optimized scopes so the resulting offset maps to
	 contexts"

	| offset scope |
	offset := 0.
	scope := self.
	[scope == aScope] whileFalse: [
		scope isOptimizedBlockScope 
			ifTrue: [scope := scope outerNotOptimizedScope]
			ifFalse: [ 
			offset := offset + 1. 
			scope isInstanceScope ifTrue: [^0]. 
			scope := scope outerScope ] ].
	^offset.
	! !

!OCAbstractMethodScope methodsFor: 'scope' stamp: 'MarcusDenker 10/7/2010 10:05'!
newOptimizedBlockScope: int
	^ OCOptimizedBlockScope new 
			outerScope: self; 
			id: int;
			yourself.! !

!OCAbstractMethodScope methodsFor: 'lookup' stamp: 'GuillermoPolito 4/10/2015 10:54'!
lookupVar: name inContext: aContext
	"We lookup a variable in a context. If it not in this context, we look in the outer context using the corresponding outer scope"
	
	| variable theValue |
	variable := self
		variableNamed: name
		ifAbsent: [ ^ self outerScope lookupVar: name inContext: aContext outerContext ].
	theValue := variable readFromContext: aContext scope: self.
	^ theValue! !

!OCAbstractMethodScope methodsFor: 'debugging' stamp: 'GuillermoPolito 4/9/2015 13:18'!
methodScope

	^ self outerScope methodScope! !

!OCAbstractMethodScope methodsFor: 'scope' stamp: 'ajh 7/8/2004 14:19'!
popScope
	"Propogate free var usages to their outer vars, then return outer scope"

	^ self outerScope! !

!OCAbstractMethodScope methodsFor: '*TxText-Styler' stamp: 'IgorStasenko 11/10/2014 17:54'!
findVariable: aBlock ifNone: aNotFound

	(aBlock value: thisContextVar) ifTrue: [^ thisContextVar].
	self allTemps do: [ :var | (aBlock value: var) ifTrue: [ ^ var ] ].
	
	outerScope ifNotNil: [
		^  outerScope findVariable: aBlock ifNone: aNotFound ]! !

!OCAbstractMethodScope methodsFor: 'initialization' stamp: 'MarcusDenker 8/17/2014 13:29'!
initialize

	tempVars :=  OrderedDictionary new.
	tempVector  := Dictionary new.
	copiedVars := OCKeyedSet keyBlock: [:var | var name].
	id := 0.
	
	thisContextVar := OCSpecialVariable new
		name: 'thisContext';
		scope: self; yourself.
! !

!OCAbstractMethodScope methodsFor: 'printing' stamp: 'ajh 3/20/2003 11:29'!
printOn: stream

	super printOn: stream.
	stream space.
	self scopeLevel printOn: stream.
! !

!OCAbstractMethodScope methodsFor: 'lookup' stamp: 'GuillermoPolito 4/10/2015 10:55'!
lookupTempVector: name inContext: aContext
	"Similar to lookupVariable:inContext: but looks for a temp vector. If we don't find the temp vector (because it was nilled or not created), we lookup in the outer context with the corresponding outer scope"
	
	| variable theVector |
	variable := self
		variableNamed: name
		ifAbsent: [ ^ self outerScope lookupVar: name inContext: aContext outerContext ].
	theVector := variable readFromContext: aContext scope: self.
	theVector ifNil: [ ^ self outerScope lookupTempVector: name inContext: aContext outerContext ].
	^ { variable . theVector }! !

!OCAbstractMethodScope methodsFor: 'temp vars' stamp: 'ClementBera 7/9/2013 18:05'!
allTemps
	"return all temps defined, even the ones in the outer scope that are not used in the current.
	 This includes the arguments
	 We do not need to care about shadowed temps as temp shadowing is not allowed."
	| temps |
	temps := OrderedCollection new.
	self outerScope allTemps do: [ :var |
	 	(self localTempNames includes: var name) ifFalse: [
			temps add: var.]
		].
	temps addAll: self localTemps.
	^temps asArray.
	! !

!OCAbstractMethodScope methodsFor: 'lookup' stamp: 'MarcusDenker 6/5/2013 13:53'!
lookupVarForDeclaration: name
	tempVars at: name ifPresent: [:v | ^ v].
	name = 'thisContext' ifTrue: [^ thisContextVar].
	^self outerScope lookupVarForDeclaration: name
	! !

!OCAbstractMethodScope methodsFor: 'temp vars' stamp: 'MarcusDenker 10/14/2010 13:46'!
tempVarNames

	^ self tempVars collect: [:each| each name]! !

!OCAbstractMethodScope methodsFor: 'temp vars' stamp: 'MarcusDenker 12/17/2012 15:14'!
localTempNames
	^self localTemps collect: [:each | each name]! !

!OCAbstractMethodScope methodsFor: 'lookup' stamp: 'MarcusDenker 9/22/2010 10:39'!
lookupVar: name
	copiedVars at: name ifPresent: [:v | ^ v].
	tempVector  at: name ifPresent: [:v | ^ v].
	tempVars at: name ifPresent: [:v | ^ v].
	name = 'thisContext' ifTrue: [^ thisContextVar].
	^self outerScope lookupVar: name
	! !

!OCAbstractMethodScope methodsFor: 'temp vars' stamp: 'GuillermoPolito 4/9/2015 15:05'!
addCopiedTempToAllScopesUpToDefVector: aVariable
		
	(self hasCopyingTempNamed: aVariable name)
		ifFalse: [self addCopyingTemp: aVariable ].
	self tempVectorName = aVariable name ifTrue: [^ self].
	^ self outerScope addCopiedTempToAllScopesUpToDefVector: aVariable.! !

!OCAbstractMethodScope methodsFor: 'temp vars' stamp: 'MarcusDenker 11/15/2012 16:08'!
tempVectorName
	"the name of the tempVector is not a valid name of a temp variable
	 This way we avoid name clashes "
	^'0vector', id asString! !

!OCAbstractMethodScope methodsFor: 'temp vars' stamp: 'MarcusDenker 9/10/2010 08:46'!
hasCopyingTempNamed: name
	^self copiedVars anySatisfy: [:each | each name = name]! !

!OCAbstractMethodScope methodsFor: 'scope' stamp: 'MarcusDenker 10/7/2010 10:06'!
newBlockScope: int
	^ OCBlockScope new outerScope: self; id: int; yourself.! !

!OCAbstractMethodScope methodsFor: 'scope' stamp: 'MarcusDenker 5/18/2013 16:40'!
outerNotOptimizedScope
	^self! !

!OCAbstractMethodScope methodsFor: 'temp vars' stamp: 'MarcusDenker 8/13/2014 10:10'!
addCopyingTemp: aTempVar
	^ copiedVars add: (OCCopyingTempVariable new
			originalVar: aTempVar originalVar;
			name: aTempVar name;
			escaping: aTempVar escaping;
			usage: aTempVar usage;
			scope: self;
			yourself)! !

!OCAbstractMethodScope methodsFor: 'temp vars' stamp: 'MarcusDenker 8/13/2014 10:08'!
tempVars

	^ tempVars! !

!OCAbstractMethodScope methodsFor: 'temp vars' stamp: 'MarcusDenker 9/22/2010 11:07'!
moveToVectorTemp: aTempVar

	self addVectorTemp: aTempVar.
	self removeTemp: aTempVar.	! !

!OCAbstractMethodScope methodsFor: 'temp vars' stamp: 'ClementBera 7/9/2013 18:10'!
localTemps
	"all temps accessed in the context... for tempVectors, it takes all the vars even those not used here"
	| localVars |
	localVars := OrderedCollection new.
	self copiedVars do:  [:var |
		var isStoringTempVector 
			ifTrue: [var tempVectorForTempStoringIt do: [:tempVectorVars | localVars add: tempVectorVars]]
	].
	self tempVars do:  [:var | localVars add: var].
	^localVars asArray! !

!OCAbstractMethodScope methodsFor: 'temp vars' stamp: 'MarcusDenker 9/22/2010 11:10'!
addCopyingTempToAllScopesUpToDefTemp: aVar

	(self hasCopyingTempNamed: aVar name) ifFalse: [self addCopyingTemp: aVar].
	tempVars at: aVar name ifPresent: [:v | ^ self].
	^ self outerScope addCopyingTempToAllScopesUpToDefTemp: aVar.
				! !

!OCAbstractMethodScope methodsFor: 'temp vars' stamp: 'MarcusDenker 8/13/2014 10:10'!
addCopyingTempNamed: name
	^ copiedVars add: (OCCopyingTempVariable new
			name: name;
			scope: self;
			yourself)! !

!OCAbstractMethodScope methodsFor: 'temp vars' stamp: 'MarcusDenker 8/13/2014 10:08'!
removeTemp: tempVar

	tempVars removeKey: tempVar name! !

!OCAbstractMethodScope methodsFor: 'lookup' stamp: 'GuillermoPolito 4/9/2015 17:15'!
variableNamed: name ifAbsent: aBlock
	copiedVars at: name ifPresent: [:v | ^ v].
	tempVector  at: name ifPresent: [:v | ^ v].
	tempVars at: name ifPresent: [:v | ^ v].
	name = 'thisContext' ifTrue: [^ thisContextVar].
	
	^ aBlock value.! !

!OCAbstractScope commentStamp: 'ajh 3/24/2003 21:53'!
I am a symbol table where variable names are associated with SemVars.  Each context (method/closure) get a fresh scope that inherits from its outer scope.!
!OCAbstractScope methodsFor: 'accessing' stamp: 'GuillermoPolito 4/9/2015 17:16'!
variableNamed: aName

	^ self variableNamed: aName ifAbsent: [ nil ]! !

!OCAbstractScope methodsFor: 'testing' stamp: 'JorgeRessia 9/23/2010 19:15'!
isInstanceScope
	^ false! !

!OCAbstractScope methodsFor: 'lookup' stamp: 'GuillermoPolito 4/10/2015 10:53'!
lookupVar: name inContext: aContext

	^ self outerScope lookupVar: name inContext: aContext outerContext! !

!OCAbstractScope methodsFor: 'testing' stamp: 'JorgeRessia 9/23/2010 19:15'!
isInsideOptimizedLoop
	^ false! !

!OCAbstractScope methodsFor: 'initializing' stamp: 'MarcusDenker 10/16/2014 11:19'!
addChild: aScope
	self children add: aScope! !

!OCAbstractScope methodsFor: 'accessing' stamp: 'MarcusDenker 12/18/2012 13:39'!
node
	^node! !

!OCAbstractScope methodsFor: 'lookup' stamp: 'ajh 3/11/2003 20:19'!
lookupVar: name
	"subclass responsibility"

	^ self outerScope lookupVar: name! !

!OCAbstractScope methodsFor: 'accessing' stamp: 'MarcusDenker 12/18/2012 13:32'!
node: aNode
	node := aNode! !

!OCAbstractScope methodsFor: 'testing' stamp: 'NicolaiHess 8/24/2014 00:16'!
isBlockScope

	^false! !

!OCAbstractScope methodsFor: 'decompiling' stamp: 'ms 7/11/2007 11:16'!
instanceScope

	^self outerScope instanceScope! !

!OCAbstractScope methodsFor: 'accessing' stamp: 'MarcusDenker 10/16/2014 11:27'!
children
	^children ifNil: [ children := OrderedCollection new ]! !

!OCAbstractScope methodsFor: '*OpalTools' stamp: 'MarcusDenker 10/16/2014 11:22'!
gtInspectorSourceCodeIn: composite
	<gtInspectorPresentationOrder: 30> 

	^ composite smalltalkCode 
		title: 'Source';
		display: [ self node methodNode sourceCode ];
		smalltalkClass: [ self node methodNode  methodClass ]; 
		initialize: [ :presentation | 
			presentation selectionInterval: self sourceInterval ];
		act: [ self method compiledMethod browse ] icon: GLMUIThemeExtraIcons glamorousBrowse entitled: 'Browse'! !

!OCAbstractScope methodsFor: 'levels' stamp: 'ajh 3/20/2003 11:27'!
scopeLevel

	outerScope ifNil: [^ 0].
	^ outerScope scopeLevel + 1! !

!OCAbstractScope methodsFor: 'levels' stamp: 'ajh 2/26/2003 13:44'!
outerScope

	^ outerScope! !

!OCAbstractScope methodsFor: 'lookup' stamp: 'ajh 2/25/2003 22:41'!
lookupSelector: name

	Symbol hasInterned: name ifTrue: [ :sym | ^ sym].
	^ nil! !

!OCAbstractScope methodsFor: 'initializing' stamp: 'MarcusDenker 10/16/2014 11:16'!
outerScope: aSemScope

	outerScope := aSemScope.
	aSemScope addChild: self. ! !

!OCAbstractScope methodsFor: 'lookup' stamp: 'MarcusDenker 6/5/2013 13:53'!
lookupVarForDeclaration: name
	"subclass responsibility"

	^ self outerScope lookupVarForDeclaration: name! !

!OCAbstractScope methodsFor: 'testing' stamp: 'MarcusDenker 12/20/2012 14:38'!
isOptimizedBlockScope
	^false! !

!OCAbstractScope methodsFor: 'testing' stamp: 'NicolaiHess 8/24/2014 00:16'!
isMethodScope

	^false! !

!OCAbstractScope methodsFor: 'lookup' stamp: 'ajh 2/25/2003 22:40'!
possibleSelectorsFor: string

	^ Symbol possibleSelectorsFor: string! !

!OCAbstractScope methodsFor: '*OpalTools' stamp: 'MarcusDenker 10/16/2014 11:23'!
sourceInterval
	^self node sourceInterval! !

!OCAbstractScope class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 17:44'!
gtExampleMethodScope
	<gtExample: 'Method scope'>
	^ (self class >> #gtExampleMethodScope) ast scope! !

!OCAbstractVariable commentStamp: '<historical>'!
I am an entry in a Scope that gets associated with variable nodes of the same name. !
!OCAbstractVariable methodsFor: 'read/write usage' stamp: 'MarcusDenker 4/9/2013 10:39'!
isUninitialized

	^ false! !

!OCAbstractVariable methodsFor: 'read/write usage' stamp: 'NicolaiHess 10/24/2014 00:05'!
markRepeatedWrite
	"blocks in a loop have to know if write usage happens outside (just #write) or
	in the loop -> #repeatedWrite"
	usage := #repeatedWrite.! !

!OCAbstractVariable methodsFor: 'emitting' stamp: 'JorgeRessia 4/19/2010 09:35'!
emitStore: methodBuilder

	self subclassResponsibility! !

!OCAbstractVariable methodsFor: '*SmartSuggestions' stamp: 'GiselaDecuzzi 5/22/2013 15:40'!
specialCommands
	^{}.! !

!OCAbstractVariable methodsFor: 'testing' stamp: 'ms 7/31/2007 00:42'!
isLocal

	^false! !

!OCAbstractVariable methodsFor: 'testing' stamp: 'MarcusDenker 9/1/2010 14:44'!
isSelf
	^false! !

!OCAbstractVariable methodsFor: 'testing' stamp: 'NicolaiHess 8/24/2014 00:27'!
isWritable
	^ true! !

!OCAbstractVariable methodsFor: 'testing' stamp: 'MarcusDenker 4/16/2013 15:55'!
isSpecialVariable
	^false! !

!OCAbstractVariable methodsFor: 'testing' stamp: 'MarcusDenker 8/27/2010 11:16'!
isInstance
	^false
! !

!OCAbstractVariable methodsFor: 'testing' stamp: 'ajh 7/8/2004 16:25'!
isGlobal

	^ false! !

!OCAbstractVariable methodsFor: 'read/write usage' stamp: 'MarcusDenker 10/16/2013 15:25'!
isRead
	^usage = #read or: [ usage = #arg ] "we treat arguments as read by default"
! !

!OCAbstractVariable methodsFor: 'accessing' stamp: 'ClementBera 5/21/2013 14:52'!
originalVar
	^ self! !

!OCAbstractVariable methodsFor: 'testing' stamp: 'MarcusDenker 6/14/2013 15:42'!
isUndeclared

	^ false! !

!OCAbstractVariable methodsFor: 'emitting' stamp: 'JorgeRessia 4/19/2010 09:35'!
emitValue: methodBuilder

	self subclassResponsibility! !

!OCAbstractVariable methodsFor: 'printing' stamp: 'ajh 2/27/2003 00:38'!
printOn: stream

	stream nextPutAll: self name! !

!OCAbstractVariable methodsFor: 'testing' stamp: 'ajh 3/18/2003 11:13'!
isTemp

	^ false! !

!OCAbstractVariable methodsFor: 'accessing' stamp: 'ajh 6/23/2004 22:52'!
scope

	^ scope! !

!OCAbstractVariable methodsFor: 'read/write usage' stamp: 'NicolaiHess 10/24/2014 00:10'!
isWrite
	^ usage = #write or: [ self isRepeatedWrite ]! !

!OCAbstractVariable methodsFor: 'accessing' stamp: 'ajh 3/16/2003 20:08'!
asString

	^ self name! !

!OCAbstractVariable methodsFor: 'read/write usage' stamp: 'NicolaiHess 10/24/2014 00:10'!
isRepeatedWrite
	^usage = #repeatedWrite
! !

!OCAbstractVariable methodsFor: 'accessing' stamp: 'MarcusDenker 9/22/2010 11:05'!
usage: anObject

	usage := anObject! !

!OCAbstractVariable methodsFor: 'accessing' stamp: 'ClementBera 5/21/2013 14:53'!
definingScope
	^ scope! !

!OCAbstractVariable methodsFor: 'testing' stamp: 'MarcusDenker 9/20/2013 13:28'!
isLiteralVariable
	^false! !

!OCAbstractVariable methodsFor: 'accessing' stamp: 'MarcusDenker 6/13/2013 14:59'!
isArg
	^false! !

!OCAbstractVariable methodsFor: 'read/write usage' stamp: 'MarcusDenker 10/16/2013 15:25'!
markRead
	"reading does not change a #write, nor an #arg"
	usage ifNil: [usage := #read]! !

!OCAbstractVariable methodsFor: 'testing' stamp: 'MarcusDenker 9/1/2010 15:30'!
isSuper
	^false! !

!OCAbstractVariable methodsFor: 'read/write usage' stamp: 'MarcusDenker 10/16/2013 15:27'!
isUnused
	"when the var is never read or written, it is not used.
	Note: we have a special #arg use which means arguments are never unused"
	^ usage isNil! !

!OCAbstractVariable methodsFor: 'initializing' stamp: 'ajh 7/8/2004 16:17'!
scope: aLexicalScope

	scope := aLexicalScope! !

!OCAbstractVariable methodsFor: 'accessing' stamp: 'MarcusDenker 9/5/2010 20:13'!
usage

	^ usage! !

!OCAbstractVariable methodsFor: 'read/write usage' stamp: 'MarcusDenker 10/16/2013 15:26'!
markWrite
	"write is the strongest use: a read is turned into a write"
	usage := #write.! !

!OCAbstractVariable methodsFor: 'testing' stamp: 'MarcusDenker 9/21/2010 16:02'!
isRemote
	^false! !

!OCAbstractVariable methodsFor: 'accessing' stamp: 'ajh 6/23/2004 22:47'!
name

	^ self subclassResponsibility! !

!OCArrayLiteralTest methodsFor: 'tests' stamp: 'avi 2/16/2004 21:08'!
testReservedIdentifiers
	self class compile: 'array ^ #(nil true false)'.
	self assert: self array = {nil. true. false}.! !

!OCArrayLiteralTest methodsFor: 'tests' stamp: 'lr 1/29/2009 20:32'!
testByteArrayRange
	self class compile: 'array ^ #[ 0 255 ]'.
	self assert: (self array isKindOf: ByteArray).
	self assert: (self array size = 2).
	self assert: (self array first = 0).
	self assert: (self array last = 255)! !

!OCArrayLiteralTest methodsFor: 'tests' stamp: 'lr 1/29/2009 20:45'!
testByteArrayLong
	self class compile: 'array ^ #[ ' , ((0 to: 255) inject: ' ' into: [ :r :e | r , ' ' , e asString ]) , ' ]'.
	self assert: (self array isKindOf: ByteArray).
	self assert: (self array size = 256).
	0 to: 255 do: [ :index | self assert: (self array at: index + 1) = index ]! !

!OCArrayLiteralTest methodsFor: 'initialization' stamp: 'avi 2/16/2004 21:09'!
tearDown
	self class removeSelector: #array! !

!OCArrayLiteralTest methodsFor: 'tests' stamp: 'Henrik Sperre Johansen 3/23/2009 13:55'!
testByteArrayWithinArray
	self class compile: 'array ^ #( #[1] #[2] )'.
	self assert: (self array isKindOf: Array).
	self assert: (self array size = 2).
	self assert: (self array first isKindOf: ByteArray).
	self assert: (self array first first = 1).
	self assert: (self array last isKindOf: ByteArray).
	self assert: (self array last first = 2)
	
! !

!OCArrayLiteralTest methodsFor: 'running' stamp: 'MarcusDenker 5/13/2013 13:21'!
runCase

	SystemAnnouncer uniqueInstance suspendAllWhile: [ super runCase ]
! !

!OCArrayLiteralTest methodsFor: 'tests' stamp: 'lr 1/29/2009 20:36'!
testByteArrayLiteral
	self class compile: 'array ^ #[ 1 2 3 4 ]'.
	self assert: (self array = self array).
	self assert: (self array == self array)! !

!OCArrayLiteralTest methodsFor: 'tests' stamp: 'lr 1/29/2009 20:34'!
testByteArrayBase
	self class compile: 'array ^ #[2r1010 8r333 16rFF]'.
	self assert: (self array isKindOf: ByteArray).
	self assert: (self array size = 3).
	self assert: (self array first = 10).
	self assert: (self array second = 219).
	self assert: (self array last = 255)
	
! !

!OCArrayLiteralTest methodsFor: 'tests' stamp: 'avi 2/16/2004 21:09'!
testSymbols
	self class compile: 'array ^ #(#nil #true #false #''nil'' #''true'' #''false'')'.
	self assert: self array = {#nil. #true. #false. #nil. #true. #false}.! !

!OCArrayLiteralTest methodsFor: 'tests' stamp: 'lr 1/29/2009 20:35'!
testByteArrayEmpty
	self class compile: 'array ^ #[]'.
	self assert: (self array isKindOf: ByteArray).
	self assert: (self array isEmpty)! !

!OCBlockScope commentStamp: '<historical>'!
I modelt the scope of a block!
!OCBlockScope methodsFor: 'accessing' stamp: 'MarcusDenker 10/14/2010 10:13'!
inComingCopiedVars
	^ copiedVars select: [:each | outerScope copiedVars includes: each].! !

!OCBlockScope methodsFor: 'testing' stamp: 'JorgeRessia 9/7/2010 18:39'!
isBlockScope
	^ true! !

!OCBlockScope methodsFor: 'testing' stamp: 'MarcusDenker 8/17/2014 13:20'!
hasEscapingVars
	^ (copiedVars isEmpty and: [tempVector isEmpty]) not! !

!OCBlockScope methodsFor: 'testing' stamp: 'MarcusDenker 12/14/2012 11:51'!
isInsideOptimizedLoop
	^ self outerScope isInsideOptimizedLoop! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-misc' stamp: 'MarcusDenker 11/20/2012 16:47'!
testExamplePushArray
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#examplePushArray) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance examplePushArray! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks-optimized' stamp: 'MarcusDenker 11/20/2012 16:50'!
testExampleToDoInsideTemp
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleToDoInsideTemp) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleToDoInsideTemp! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks' stamp: 'MarcusDenker 11/20/2012 16:42'!
testExampleBlockExternal
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleBlockExternal) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleBlockExternal.
! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks-optimized' stamp: 'MarcusDenker 11/20/2012 16:45'!
testExampleIfIfNotNilReturnNil
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleIfNotNilReturnNil) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleIfNotNilReturnNil! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks' stamp: 'MarcusDenker 11/20/2012 16:49'!
testExampleSimpleBlockEmpty
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleSimpleBlockEmpty) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleSimpleBlockEmpty! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-simple' stamp: 'MarcusDenker 11/20/2012 16:47'!
testExampleReturn1
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleReturn1) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleReturn1! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks-optimized' stamp: 'MarcusDenker 11/20/2012 16:50'!
testExampleToDoOutsideTemp
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleToDoOutsideTemp) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleToDoOutsideTemp! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-variables' stamp: 'MarcusDenker 11/20/2012 16:50'!
testExampleThisContext
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleThisContext) parseTree generate.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) isContext! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks' stamp: 'MarcusDenker 11/20/2012 16:49'!
testExampleSimpleBlockReturn
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleSimpleBlockReturn) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleSimpleBlockReturn! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks' stamp: 'MarcusDenker 11/20/2012 16:43'!
testExampleBlockExternal2
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleBlockExternal2) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleBlockExternal2.
! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks' stamp: 'MarcusDenker 11/20/2012 16:43'!
testExampleBlockInternal
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleBlockInternal) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleBlockInternal.! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks' stamp: 'MarcusDenker 11/20/2012 16:48'!
testExampleSimpleBlock
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleSimpleBlock) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) value = instance exampleSimpleBlock value! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks' stamp: 'MarcusDenker 11/20/2012 16:49'!
testExampleSimpleBlockLocal
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleSimpleBlockLocal) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleSimpleBlockLocal! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks-optimized' stamp: 'MarcusDenker 11/20/2012 16:45'!
testExampleIfNotNilArg
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleIfNotNilArg) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleIfNotNilArg.! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-simple' stamp: 'MarcusDenker 11/20/2012 16:45'!
testExampleEmptyMethod
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleEmptyMethod) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleEmptyMethod.! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks-optimized' stamp: 'MarcusDenker 11/20/2012 16:46'!
testExampleIfTrue
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleIfTrue) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleIfTrue! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks' stamp: 'MarcusDenker 11/20/2012 16:47'!
testExampleMethodTempInNestedBlock
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleMethodTempInNestedBlock) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleMethodTempInNestedBlock! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks' stamp: 'MarcusDenker 11/20/2012 16:48'!
testExampleSimpleBlockArgument4
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleSimpleBlockArgument4) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleSimpleBlockArgument4! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks' stamp: 'MarcusDenker 11/20/2012 16:49'!
testExampleSimpleBlockNested
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleSimpleBlockNested) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleSimpleBlockNested! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks-optimized' stamp: 'MarcusDenker 11/20/2012 16:50'!
testExampleToDoArgument
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleToDoArgument) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleToDoArgument! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks-optimized' stamp: 'MarcusDenker 11/20/2012 16:50'!
testExampleToDoInsideTempNotInlined
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleToDoInsideTempNotInlined) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleToDoInsideTempNotInlined! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks-optimized' stamp: 'MarcusDenker 11/20/2012 16:44'!
testExampleWhileModificationBeforeNotInlined
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleWhileModificationBeforeNotInlined) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleWhileModificationBeforeNotInlined! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks' stamp: 'MarcusDenker 11/20/2012 16:43'!
testExampleBlockNested
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleBlockNested) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleBlockNested.! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks-optimized' stamp: 'MarcusDenker 11/20/2012 16:44'!
testExampleWhileModificationBefore
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleWhileModificationBefore) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleWhileModificationBefore! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks' stamp: 'MarcusDenker 11/20/2012 16:48'!
testExampleSimpleBlockArgument5
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleSimpleBlockArgument5) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleSimpleBlockArgument5! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks-optimized' stamp: 'MarcusDenker 11/20/2012 16:51'!
testExampleWhileModificationAfterNotInlined
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleWhileModificationAfterNotInlined) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleWhileModificationAfterNotInlined! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-variables' stamp: 'MarcusDenker 11/20/2012 16:50'!
testExampleSuper
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleSuper) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleSuper! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks-optimized' stamp: 'MarcusDenker 11/20/2012 16:45'!
testExampleIfFalseIfTrue
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleIfFalseIfTrue) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleIfFalseIfTrue.! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-misc' stamp: 'MarcusDenker 11/20/2012 16:42'!
testExampleToDoValue
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleToDoValue) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleToDoValue! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks' stamp: 'MarcusDenker 11/20/2012 16:43'!
testExampleBlockExternalNested
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleBlockExternalNested) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleBlockExternalNested.
! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks' stamp: 'MarcusDenker 11/20/2012 16:43'!
testExampleBlockExternalArg
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleBlockExternalArg) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleBlockExternalArg.
! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-variables' stamp: 'MarcusDenker 11/20/2012 16:44'!
testExampleiVar
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleiVar) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleiVar! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks-optimized' stamp: 'MarcusDenker 11/20/2012 16:44'!
testExampleWhileWithTemp
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleWhileWithTemp) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleWhileWithTemp! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks-optimized' stamp: 'MarcusDenker 11/20/2012 16:44'!
testExampleWhileWithTempNotInlined
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleWhileWithTempNotInlined) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleWhileWithTempNotInlined! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks-optimized' stamp: 'MarcusDenker 11/20/2012 16:50'!
testExampleToDoArgumentNotInlined
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleToDoArgumentNotInlined) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleToDoArgumentNotInlined! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks' stamp: 'MarcusDenker 11/20/2012 16:42'!
testExampleBlockArgument
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleBlockArgument) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleBlockArgument.
! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks-optimized' stamp: 'MarcusDenker 11/20/2012 16:45'!
testExampleIfFalse
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleIfFalse) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleIfFalse.! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks' stamp: 'MarcusDenker 11/20/2012 16:48'!
testExampleSimpleBlockArgument3
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleSimpleBlockArgument3) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleSimpleBlockArgument3! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks' stamp: 'MarcusDenker 11/20/2012 16:49'!
testExampleSimpleBlockiVar
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleSimpleBlockiVar) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleSimpleBlockiVar! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks' stamp: 'MarcusDenker 11/20/2012 16:49'!
testExampleSimpleBlockLocalNested
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleSimpleBlockNested) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleSimpleBlockNested! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks-optimized' stamp: 'MarcusDenker 11/20/2012 16:47'!
testExampleMethodWithOptimizedBlocksA
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleMethodWithOptimizedBlocksA) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleMethodWithOptimizedBlocksA! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-simple' stamp: 'MarcusDenker 11/20/2012 16:48'!
testExampleReturn1plus2
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleReturn1plus2) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleReturn1plus2! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks' stamp: 'MarcusDenker 11/20/2012 16:48'!
testExampleSimpleBlockArgument1
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleSimpleBlockArgument1) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleSimpleBlockArgument1! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks' stamp: 'MarcusDenker 11/20/2012 16:48'!
testExampleSimpleBlockArgument2
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleSimpleBlockArgument2) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleSimpleBlockArgument2! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks-optimized' stamp: 'MarcusDenker 11/20/2012 16:49'!
testExampleSimpleBlockLocalIf
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleSimpleBlockLocalIf) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleSimpleBlockLocalIf! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks-optimized' stamp: 'MarcusDenker 11/20/2012 16:51'!
testExampleToDoOutsideTempNotInlined
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleToDoOutsideTempNotInlined) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleToDoOutsideTempNotInlined! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-variables' stamp: 'MarcusDenker 11/20/2012 16:48'!
testExampleSelf
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleSelf) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleSelf! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks-optimized' stamp: 'MarcusDenker 11/20/2012 16:46'!
testExampleIfTrueIfFalse
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleIfTrueIfFalse) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleIfTrueIfFalse! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks' stamp: 'MarcusDenker 11/20/2012 16:47'!
testExampleNestedBlockScoping
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleNestedBlockScoping) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleNestedBlockScoping! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-simple' stamp: 'MarcusDenker 11/20/2012 16:47'!
testExampleNewArray
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleNewArray) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleNewArray! !

!OCBytecodeDecompilerExamplesTest methodsFor: 'tests-blocks-optimized' stamp: 'MarcusDenker 11/20/2012 16:49'!
testExampleSimpleBlockLocalWhile
	| ir method newMethod instance |
	
	method := (OCOpalExamples>>#exampleSimpleBlockLocalWhile) parseTree generate.
	instance := OCOpalExamples new.
	
	ir := IRBytecodeDecompiler new decompile: method.
	newMethod := ir compiledMethod.
	
	self assert: (newMethod valueWithReceiver: instance arguments: #()) = instance exampleSimpleBlockLocalWhile! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'NicolaiHess 11/6/2014 20:35'!
testBugOffset

	|  iRMethod aCompiledMethod ir method |

	iRMethod := IRBuilder new
		addTemps: #(#a #b);
		pushTemp: #b;
		pushTemp: #a;
		returnTop;
		ir.
	aCompiledMethod := iRMethod compiledMethod.

	ir :=  aCompiledMethod decompileIR.
	method := ir compiledMethod.
	
	self assert: (aCompiledMethod symbolic = method symbolic).
	
	
	! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 7/16/2012 16:07'!
testLiteralBoolean
	| ir1 ir2 method |
	
	ir1 := IRBuilderTest new testLiteralBoolean.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'examples' stamp: 'MarcusDenker 8/27/2010 13:23'!
pushClosureCopyNoCopiedArg

^IRBuilder new
		pushReceiver;
		pushClosureCopyCopiedValues: #() args: #(d) jumpTo: #block;
		pushLiteral: 1;
		pushTemp: #d;
		send: #+;
	      blockReturnTop;
		jumpAheadTarget: #block;	
		pushLiteral: 1;
		send: #value:;
		returnTop;
		ir.
! !

!OCBytecodeDecompilerTest methodsFor: 'examples' stamp: 'MarcusDenker 8/27/2010 13:23'!
pushClosureCopyNoCopied

	| iRMethod aCompiledMethod |
	^ IRBuilder new
		pushReceiver;
		pushClosureCopyCopiedValues: #() args: #() jumpTo: #block;
		pushLiteral: 1;
		pushLiteral: 2;
		send: #+;
	      blockReturnTop;
		jumpAheadTarget: #block;	
		send: #value;
		returnTop;
		ir.

	! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 7/16/2012 16:07'!
testLiteralVariableClass
	| ir1 ir2 method |
	
	ir1 := IRBuilderTest new testLiteralVariableClass.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'examples' stamp: 'MarcusDenker 8/27/2010 13:22'!
remoteTemp

	| iRMethod aCompiledMethod |
	iRMethod := IRBuilder new
		
		createTempVectorNamed:#methodVector withVars: #(b);      "b we know will be written to, so make a tempvector entry" 
		addTemps: #(a);  "we have one real temp"
		pushLiteral: 1;
		storeTemp: #a;
		popTop;
		pushClosureCopyCopiedValues: #(#a #methodVector) args: #() jumpTo: #block;
			pushTemp: #a;                                                                                             "a is just read, so we copy it to the block"
			pushLiteral: 1;
			send: #+;
			storeRemoteTemp: #b inVector: #methodVector;							      "b comes from tempvetor, as we do write to it"
			popTop;
	     	 	blockReturnTop;
		jumpAheadTarget: #block;	
		send: #value;
		pushRemoteTemp: #b inVector: #methodVector;				
		returnTop;
		ir.
	
	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
	self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2).
	^iRMethod
	! !

!OCBytecodeDecompilerTest methodsFor: 'tests - blocks' stamp: 'MarcusDenker 9/20/2013 15:05'!
testBlockWithTemp
	| method ir |
	method := ClassTestCase>>#targetClass.
	
	ir := method ir.
	
	"the block sequence of the block with the temp should not have
	a pushNil, as this is inserted later again"
	self assert: (ir allSequences at: 5) first isPushLiteral not.! !

!OCBytecodeDecompilerTest methodsFor: 'tests - blocks' stamp: 'MarcusDenker 7/16/2012 16:05'!
testPushClosureCopyOneCopiedArg
	| ir1 ir2 method |
	
	ir1 := self pushClosureCopyOneCopiedArg.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 7/16/2012 16:07'!
testPushSelf
	| ir1 ir2 method |
	
	ir1 := IRBuilderTest new testPushSelf.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'examples' stamp: 'MarcusDenker 8/27/2010 13:24'!
pushClosureCopyOneCopiedArg

^IRBuilder new
		addTemps: #(a);
		pushReceiver;
		pushLiteral: 1;
		storeTemp: #a;
		popTop;
		pushClosureCopyCopiedValues: #(a) args: #(d) jumpTo: #block;
		pushTemp: #a;
		pushTemp: #d;
		send: #+;
		blockReturnTop;
		jumpAheadTarget: #block;	
		pushLiteral: 1;
		send: #value:;
		returnTop;
		ir.
! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 7/16/2012 16:07'!
testLiteralVariableClassVariable
	| ir1 ir2 method |
	
	ir1 := IRBuilderTest new testLiteralVariableClassVariable.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 7/16/2012 16:07'!
testStoreIntoVariable
	| ir1 ir2 method |
	
	ir1 := IRBuilderTest new testStoreIntoVariable.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 7/16/2012 16:07'!
testLiteralVariableGlobale
	| ir1 ir2 method |
	
	ir1 := IRBuilderTest new testLiteralVariableGlobale.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 7/16/2012 16:07'!
testReturnTop
	| ir1 ir2 method |
	
	ir1 := IRBuilderTest new testReturnTop.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 7/16/2012 16:07'!
testSendSuper
	| ir1 ir2 method |
	
	ir1 := IRBuilderTest new testSendSuper.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 7/16/2012 16:07'!
testPopTop
	| ir1 ir2 method |
	
	ir1 := IRBuilderTest new testPopTop.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'NicolaiHess 11/6/2014 20:36'!
testInstVar
	| ir1 ir2 method method2 |
	
	ir1 := IRBuilderTest new testInstVar.
	method := ir1 compiledMethod.
	
	ir2 :=  method decompileIR.
	method2 := ir2 compiledMethod.
	
	self deny: method2 == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: method2 = method.! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 7/16/2012 16:07'!
testLiteralArray
	| ir1 ir2 method |
	
	ir1 := IRBuilderTest new testLiteralArray.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'tests - blocks' stamp: 'MarcusDenker 7/16/2012 16:05'!
testPushClosureCopyNoCopied
	| ir1 ir2 method |
	
	ir1 := self pushClosureCopyNoCopied.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 7/16/2012 16:07'!
testLiteralNil
	| ir1 ir2 method |
	
	ir1 := IRBuilderTest new testLiteralNil.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 7/16/2012 16:07'!
testLiteralString
	| ir1 ir2 method |
	
	ir1 := IRBuilderTest new testLiteralString.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'tests - examples' stamp: 'CamilloBruni 8/31/2013 20:23'!
testDecompileBytecodeDecompilerTestClass
	| decompiledIR aCompiledMethod |
	self class methodDict
		do: [ :each | 
			decompiledIR := IRBytecodeDecompiler new decompile: each.
			aCompiledMethod := decompiledIR compiledMethod ]! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 7/16/2012 16:07'!
testJumpAheadTo
	| ir1 ir2 method |
	
	ir1 := IRBuilderTest new testJumpAheadTo.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 7/16/2012 16:07'!
testJumpBackTo
	| ir1 ir2 method |
	
	ir1 := IRBuilderTest new testJumpBackTo.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 7/16/2012 16:07'!
testDup
	| ir1 ir2 method |
	
	ir1 := IRBuilderTest new testDup.
	method := ir1 compiledMethod.
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	self assert: (ir2 compiledMethod) symbolic = method symbolic.! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 7/16/2012 16:07'!
testPushConsArray
	| ir1 ir2 method |
	
	ir1 := IRBuilderTest new testPushConsArray.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 7/16/2012 16:07'!
testPushConsArray2
	| ir1 ir2 method |
	
	ir1 := IRBuilderTest new testPushConsArray2.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'tests - examples' stamp: 'CamilloBruni 8/31/2013 20:23'!
testWhileTrue
	| cm decompiledIR aCompiledMethod |
	cm := self class >> #testWhileTrue.
	decompiledIR := IRBytecodeDecompiler new decompile: cm.
	aCompiledMethod := decompiledIR compiledMethod! !

!OCBytecodeDecompilerTest methodsFor: 'tests - examples' stamp: 'CamilloBruni 8/31/2013 20:23'!
testDecompilerOrderedCollectionDo
	| cm decompiledIR |
	cm := OrderedCollection >> #do:.
	decompiledIR := IRBytecodeDecompiler new decompile: cm.
	decompiledIR compiledMethod! !

!OCBytecodeDecompilerTest methodsFor: 'examples' stamp: 'MarcusDenker 8/27/2010 13:23'!
pushClosureCopyOneCopiedTemp

	^IRBuilder new
		addTemps: #(a);
		pushReceiver;
		pushLiteral: 1;
		storeTemp: #a;
		popTop;
		pushClosureCopyCopiedValues: #(a) args: #() jumpTo: #block;
		addTemps: #(d);  "the temp"
		pushTemp: #a;
		pushLiteral: 1;
		send: #+;
		storeTemp:  #d;
		popTop;
		pushTemp: #d;
		blockReturnTop;
		jumpAheadTarget: #block;	
		send: #value;
		returnTop;
		ir.
! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 7/16/2012 16:07'!
testLiteralCharacter
	| ir1 ir2 method |
	
	ir1 := IRBuilderTest new testLiteralCharacter.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'tests - blocks' stamp: 'MarcusDenker 7/16/2012 16:05'!
testPushClosureCopyOneCopiedTemp
	| ir1 ir2 method |
	
	ir1 := self pushClosureCopyOneCopiedTemp.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'setUp - tearDown' stamp: 'MarcusDenker 5/13/2013 14:51'!
tearDown
	SmalltalkImage compilerClass: currentCompiler.! !

!OCBytecodeDecompilerTest methodsFor: 'tests - blocks' stamp: 'MarcusDenker 7/16/2012 16:05'!
testPushClosureCopyNoCopiedArg
	| ir1 ir2 method |
	
	ir1 := self pushClosureCopyNoCopiedArg.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: ir2 compiledMethod symbolic = method symbolic .
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'tests - examples' stamp: 'CamilloBruni 8/31/2013 20:23'!
testDecompileIRBuilderTestClass
	| decompiledIR aCompiledMethod |
	IRBuilderTest methodDict
		do: [ :each | 
			decompiledIR := IRBytecodeDecompiler new decompile: each.
			aCompiledMethod := decompiledIR compiledMethod ]! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 7/16/2012 16:07'!
testLiteralInteger
	| ir1 ir2 method |
	
	ir1 := IRBuilderTest new testLiteralInteger.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'setUp - tearDown' stamp: 'MarcusDenker 5/13/2013 14:51'!
setUp
	currentCompiler := SmalltalkImage compilerClass.
	SmalltalkImage compilerClass: OpalCompiler.! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 7/16/2012 16:07'!
testLiteralSymbol
	| ir1 ir2 method |
	
	ir1 := IRBuilderTest new testLiteralSymbol.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 7/16/2012 16:05'!
testRemoteTempNested
	| ir1 ir2 method |
	
	ir1 := self remoteTempNested.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'tests - examples' stamp: 'CamilloBruni 8/31/2013 20:23'!
testDecompileBytecodeGeneratorTest
	| decompiledIR aCompiledMethod |
	OCBytecodeGeneratorTest methodDict
		do: [ :each | 
			decompiledIR := IRBytecodeDecompiler new decompile: each.
			aCompiledMethod := decompiledIR compiledMethod ]! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 7/16/2012 16:07'!
testLiteralFloat
	| ir1 ir2 method |
	
	ir1 := IRBuilderTest new testLiteralFloat.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: ir2 compiledMethod  = method .! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 7/16/2012 16:07'!
testPushTempTemp
	| ir1 ir2 method |
	
	ir1 := IRBuilderTest new testPushTempTemp.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 7/16/2012 16:07'!
testPushThisContext
	| ir1 ir2 method |
	
	ir1 := IRBuilderTest new testPushThisContext.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic.
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 7/16/2012 16:07'!
testJumpAheadToIf
	| ir1 ir2 method |
	
	ir1 := IRBuilderTest new testJumpAheadToIf.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.

	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 7/16/2012 16:07'!
testPushTempArgument
	| ir1 ir2 method |
	
	ir1 := IRBuilderTest new testPushTempArgument.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 7/16/2012 16:05'!
testRemoteTemp
	| ir1 ir2 method |
	
	ir1 := self remoteTemp.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 7/16/2012 16:07'!
testStoreTemp
	| ir1 ir2 method |
	
	ir1 := IRBuilderTest new testStoreTemp.
	method := ir1 compiledMethod.
	
	ir2 := IRBytecodeDecompiler new decompile: method.
	
	self deny: ir2 compiledMethod == method.
	
	self assert: (ir2 compiledMethod) symbolic = method symbolic .
	self assert: ir2 compiledMethod = method.! !

!OCBytecodeDecompilerTest methodsFor: 'examples' stamp: 'MarcusDenker 8/27/2010 13:23'!
remoteTempNested

	| iRMethod aCompiledMethod |

		iRMethod := IRBuilder new
		createTempVectorNamed:#methodVector withVars: #(b);      "b we know will be written to, so make a tempvector entry" 
		addTemps: #(a);  "we have one real temp"
		
		pushLiteral: 1;
		storeTemp: #a;
		popTop;
		pushClosureCopyCopiedValues: #(methodVector a) args: #() jumpTo: #block;
		createTempVectorNamed:#blockVector withVars: #(f);    
			pushTemp: #a;                                                                                             "a is just read, so we copy it to the block"
				pushClosureCopyCopiedValues: #(methodVector) args: #()  jumpTo: #block2;
				pushLiteral: 1;
				storeRemoteTemp: #b inVector: #methodVector;							      "f comes from tempvetor, as we do write to it"
				blockReturnTop;		
				jumpAheadTarget: #block2;	
			send: #value;
			send: #+;
			storeRemoteTemp: #b inVector: #methodVector;							      "b comes from tempvetor, as we do write to it"
	     	 	blockReturnTop;
			
		jumpAheadTarget: #block;	
		send: #value;
		pushRemoteTemp: #b inVector: #methodVector;				
		returnTop;
		ir.
	
	aCompiledMethod := iRMethod compiledMethod.
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
	self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #()) = 2).
	^iRMethod
	! !

!OCBytecodeEncodingError commentStamp: 'ClementBera 6/11/2014 13:22'!
This error is raised when the BytecodeGenerator cannot encode in the bytecode the IR nodes.!
!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:27'!
testStoreInstVar
	| gen cm symbolic |
	
	gen := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		pushLiteral: 1;
		storeInstVar: 1;
		returnTop.
	cm := gen compiledMethod.
	symbolic := String streamContents: [:str | cm longPrintOn: str ].

	self assert: gen stackFrameSize = 1.
	self assert: cm isCompiledMethod.
	self assert: symbolic =  '13 <76> pushConstant: 1
14 <81 00> storeIntoRcvr: 0
16 <7C> returnTop'! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:22'!
testBlockReturnTop
	| cm |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		blockReturnTop;
		compiledMethod.

	self testMethod: cm against: '13 <7D> blockReturn'.
	! !

!OCBytecodeGeneratorTest methodsFor: 'tests - execution' stamp: 'ClementBera 10/13/2014 10:12'!
testExample
	| cm |
	
	cm := self newBytecodeGen
		numArgs: 1;
		numTemps: 1;
		pushTemp: 1;
		pushInstVar: 2;
		send: #>;
		if: false goto: #else;
		pushLiteral: 'yes';
		returnTop ;
		label: #else;
		pushLiteral: 'no';
		returnTop;
		compiledMethod.
	cm methodClass: self class.
	cm selector: #test.

	self assert: (cm isKindOf: CompiledMethod).
	self assert: (cm valueWithReceiver: 2@2 arguments: #(1)) = 'no' .
	self assert: (cm valueWithReceiver: 2@2  arguments: #(3)) = 'yes' .	
	^cm
	! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:26'!
testPushLiteralVariable
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		pushLiteralVariable: (LookupKey key: '1');
		returnTop;
		compiledMethod.

	self testMethod: cm against:  '17 <40> pushLit: 1
18 <7C> returnTop'
	! !

!OCBytecodeGeneratorTest methodsFor: 'helper' stamp: 'ClementBera 1/28/2015 09:27'!
newBytecodeGen
	^ IRBytecodeGenerator newWithEncoderClass: EncoderForV3PlusClosures! !

!OCBytecodeGeneratorTest methodsFor: 'tests - errors' stamp: 'cb 1/27/2015 13:33'!
testStoreRemoteTempInVectorAtOutOfRange
	
	self should: [ self newBytecodeGen
					numArgs: 0;
					storeRemoteTemp: 1 inVectorAt: 257 ] 
		raise: Error ! !

!OCBytecodeGeneratorTest methodsFor: 'tests - errors' stamp: 'cb 1/27/2015 13:33'!
testStoreRemoteTempOutOfRangeInVectorAt
	
	self should: [ self newBytecodeGen
					numArgs: 0;
					storeRemoteTemp: 257 inVectorAt: 1 ] 
		raise: Error ! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:26'!
testPushNewArray
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		pushNewArray: 1;
		returnTop;
		compiledMethod.

	self testMethod: cm against:  '13 <8A 01> push: (Array new: 1)
15 <7C> returnTop'
	! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:26'!
testSend
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		pushLiteral: 1;
		send: #a;
		returnTop;
		compiledMethod.

	self testMethod: cm against:  '17 <76> pushConstant: 1
18 <D0> send: a
19 <7C> returnTop'	! !

!OCBytecodeGeneratorTest methodsFor: 'tests - errors' stamp: 'cb 1/27/2015 13:33'!
testPushRemoteTempOutOfRangeInVectorAt
	
	self should: [ self newBytecodeGen
					numArgs: 0;
					pushRemoteTemp: 257 inVectorAt: 1 ] 
		raise: Error ! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:27'!
testStoreLiteralVariable
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		pushLiteral: 1;
		storeIntoLiteralVariable: OCBytecodeGeneratorTest binding;
		returnTop;
		compiledMethod.
	self testMethod: cm against:  '17 <76> pushConstant: 1
18 <81 C0> storeIntoLit: OCBytecodeGeneratorTest
20 <7C> returnTop'! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:26'!
testReturnTop
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		pushLiteral: 1;
		returnTop;
		compiledMethod.

	self testMethod: cm against:   '13 <76> pushConstant: 1
14 <7C> returnTop'! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'ClementBera 10/13/2014 10:18'!
testReturnReceiver
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		returnReceiver;
		compiledMethod.

	self testMethod: cm against:  'Quick return self'
	! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:25'!
testPopTop
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		pushLiteral: 1;
		pushLiteral: 1;
		popTop;
		returnTop;
		compiledMethod.

	self testMethod: cm against:  '13 <76> pushConstant: 1
14 <76> pushConstant: 1
15 <87> pop
16 <7C> returnTop'! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:27'!
testStorePopInstVar
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		pushLiteral: 1;
		pushLiteral: 1;
		storePopInstVar: 1;
		returnTop;
		compiledMethod.

	self testMethod: cm against:   '13 <76> pushConstant: 1
14 <76> pushConstant: 1
15 <60> popIntoRcvr: 0
16 <7C> returnTop'! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:25'!
testIfGoToOtherWise
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 1;
		pushTemp: 1;
		pushLiteral: 1;
		if: true goto: #return otherwise: #other;
		label: #other;
		returnTop;
		label: #return;
		returnTop;
		compiledMethod.

	self testMethod: cm against:  '13 <10> pushTemp: 0
14 <76> pushConstant: 1
15 <A8 01> jumpTrue: 18
17 <7C> returnTop
18 <7C> returnTop'! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:27'!
testStorePopRemoteTempInVectorAt
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		pushLiteral: 1;
		pushLiteral: 1;
		storePopRemoteTemp: 1 inVectorAt: 1;
		returnTop;
		compiledMethod.

	self testMethod: cm against:  '13 <76> pushConstant: 1
14 <76> pushConstant: 1
15 <8E 00 00> popIntoTemp: 0 inVectorAt: 0
18 <7C> returnTop'! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:26'!
testPushConsArray
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		pushLiteral: 1;
		pushConsArray: 1;
		returnTop;
		compiledMethod.

	self testMethod: cm against:   '13 <76> pushConstant: 1
14 <8A 81> pop 1 into (Array new: 1)
16 <7C> returnTop'
	! !

!OCBytecodeGeneratorTest methodsFor: 'tests - execution' stamp: 'ClementBera 10/13/2014 10:12'!
testClosureExample
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		pushClosureCopyNumCopiedValues: 0 numArgs: 0 to: #end;
		pushReceiver;
		blockReturnTop;
		label: #end;
		returnTop;
		compiledMethod.
	
		
	cm methodClass: self class.
	cm selector: #test.

	self assert: (cm isKindOf: CompiledMethod).
	self assert: ((cm valueWithReceiver: 2@2 arguments: #()) isKindOf: BlockClosure).
	self assert: ((cm valueWithReceiver: 2@2 arguments: #()) value = (2@2)).
	^cm
	! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:27'!
testStorePopIntoLiteralVariable
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		pushLiteral: 1;
		pushLiteral: 1;
		storePopIntoLiteralVariable: (#test->1);
		returnTop;
		compiledMethod.

	self testMethod: cm against:  '17 <76> pushConstant: 1
18 <76> pushConstant: 1
19 <82 C0> popIntoLit: test
21 <7C> returnTop'! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'ClementBera 10/13/2014 10:18'!
testReturnConstant
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		returnConstant: 1;
		compiledMethod.

	self testMethod: cm against:  'Quick return 1'
	! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:27'!
testStorePopTemp
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		pushLiteral: 1;
		pushLiteral: 1;
		storePopTemp: 1;
		returnTop;
		compiledMethod.

	self testMethod: cm against:  '13 <76> pushConstant: 1
14 <76> pushConstant: 1
15 <68> popIntoTemp: 0
16 <7C> returnTop'! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:28'!
testPushClosureCopyNumCopiedValuesNumArgsTo
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		pushClosureCopyNumCopiedValues: 0 numArgs: 0 to: #end;
		pushReceiver;
		blockReturnTop;
		label: #end;
		returnTop;
		compiledMethod.

	self testMethod: cm against:   '13 <8F 00 00 02> closureNumCopied: 0 numArgs: 0 bytes 17 to 18
17 <70> self
18 <7D> blockReturn
19 <7C> returnTop'! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:26'!
testPushRemoteTempInVectorAt
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		pushRemoteTemp: 1 inVectorAt: 1;
		returnTop;
		compiledMethod.

	self testMethod: cm against:   '13 <8C 00 00> pushTemp: 0 inVectorAt: 0
16 <7C> returnTop'! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:26'!
testSendToSuperOf
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		pushLiteral: 1;
		send: #a toSuperOf: Object;
		returnTop;
		compiledMethod.

	self testMethod: cm against:  '17 <76> pushConstant: 1
18 <85 00> superSend: a
20 <7C> returnTop'! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:26'!
testPushLiteral
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		pushLiteral: 1;
		returnTop;
		compiledMethod.

	self testMethod: cm against:  '13 <76> pushConstant: 1
14 <7C> returnTop'
	! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:26'!
testPushInstVar
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		pushInstVar: 1;
		returnTop;
		compiledMethod.

	self testMethod: cm against:  '13 <00> pushRcvr: 0
14 <7C> returnTop'
	! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:25'!
testIfGoTo
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 1;
		pushTemp: 1;
		pushLiteral: 1;
		if: true goto: #return;
		returnTop;
		label: #return;
		returnTop;
		compiledMethod.

	self testMethod: cm against:   '13 <10> pushTemp: 0
14 <76> pushConstant: 1
15 <A8 01> jumpTrue: 18
17 <7C> returnTop
18 <7C> returnTop'! !

!OCBytecodeGeneratorTest methodsFor: 'tests - errors' stamp: 'cb 1/27/2015 13:33'!
testPushRemoteTempInVectorAtOutOfRange
	
	self should: [ self newBytecodeGen
					numArgs: 0;
					pushRemoteTemp: 1 inVectorAt: 257 ] 
		raise: Error 
	! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:25'!
testGoTo
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		pushLiteral: 1;
		label: #back;
		pushLiteral: 1;
		returnTop;
		goto: #back;
		compiledMethod.

	self testMethod: cm against:  '13 <76> pushConstant: 1
14 <76> pushConstant: 1
15 <7C> returnTop
16 <A3 FC> jumpTo: 14'
! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:26'!
testPushReceiver
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		pushReceiver;
		returnTop;
		compiledMethod.

	self testMethod: cm against:  '13 <70> self
14 <7C> returnTop'! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:26'!
testPushTemp
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 1;
		pushTemp: 1;
		returnTop;
		compiledMethod.

	self testMethod: cm against:  '13 <10> pushTemp: 0
14 <7C> returnTop'! !

!OCBytecodeGeneratorTest methodsFor: 'helper' stamp: 'ClementBera 10/13/2014 10:12'!
testMethod: cm against: string

	| symbolic |
	self assert: cm isCompiledMethod.
	symbolic := String streamContents: [:str | cm longPrintOn: str ].
	self assert: symbolic = string
	! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:25'!
testLabel
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		pushLiteral: 1;
		label: #back;
		pushLiteral: 1;
		returnTop;
		goto: #back;
		compiledMethod.

	self testMethod: cm against:   '13 <76> pushConstant: 1
14 <76> pushConstant: 1
15 <7C> returnTop
16 <A3 FC> jumpTo: 14'! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'ClementBera 12/29/2014 11:05'!
testPushThisContext
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		pushThisContext ;
		returnTop;
		compiledMethod.

	self testMethod: cm against:  '13 <89> pushThisContext
14 <7C> returnTop'! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:26'!
testPushDup
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		pushDup;
		returnTop;
		compiledMethod.

	self testMethod: cm against:  '13 <88> dup
14 <7C> returnTop'
	! !

!OCBytecodeGeneratorTest methodsFor: 'tests - execution' stamp: 'ClementBera 10/13/2014 10:12'!
testExample2
	| cm |
	
	cm := self newBytecodeGen
		numArgs: 1;
		numTemps: 1;
		pushInstVar: 2;
		pushTemp: 1;
		send: #<;
		if: false goto: #else;
		pushLiteral: 'yes';
		returnTop ;
		label: #else;
		pushLiteral: 'no';
		returnTop;
		compiledMethod.

	self assert: (cm isKindOf: CompiledMethod).
	self assert: (cm valueWithReceiver: 2@2 arguments: #(1)) = 'no' .
	self assert: (cm valueWithReceiver: 2@2  arguments: #(3)) = 'yes' .	
	^cm
	! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:23'!
testStoreTemp
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 1;
		pushLiteral: 1;
		storeTemp: 1;
		returnTop;
		compiledMethod.

	self testMethod: cm against:  '13 <76> pushConstant: 1
14 <81 40> storeIntoTemp: 0
16 <7C> returnTop'! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'ClementBera 10/13/2014 10:18'!
testReturnInstVar
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		returnInstVar: 1;
		compiledMethod.

	self testMethod: cm against:  'Quick return field 0 (0-based)'
	! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:27'!
testStoreIntoLiteralVariable
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		pushLiteral: 1;
		storeIntoLiteralVariable: (LookupKey key: '1');
		returnTop;
		compiledMethod.

	self testMethod: cm against:   '17 <76> pushConstant: 1
18 <81 C0> storeIntoLit: 1
20 <7C> returnTop'! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:25'!
testGoToIf
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 1;
		pushTemp: 1;
		pushLiteral: 1;
		if: true goto: #return;
		returnTop;
		label: #return;
		returnTop;
		compiledMethod.

	self testMethod: cm against:   '13 <10> pushTemp: 0
14 <76> pushConstant: 1
15 <A8 01> jumpTrue: 18
17 <7C> returnTop
18 <7C> returnTop'! !

!OCBytecodeGeneratorTest methodsFor: 'tests - instructions' stamp: 'MarcusDenker 10/15/2014 17:27'!
testStoreRemoteTempInVectorAt
	| cm  |
	
	cm := self newBytecodeGen
		numArgs: 0;
		numTemps: 0;
		pushLiteral: 1;
		storeRemoteTemp: 1 inVectorAt: 1;
		returnTop;
		compiledMethod.

	self testMethod: cm against:  '13 <76> pushConstant: 1
14 <8D 00 00> storeIntoTemp: 0 inVectorAt: 0
17 <7C> returnTop'! !

!OCBytecodeGeneratorTest class methodsFor: 'accessing' stamp: 'lr 8/21/2010 10:06'!
packageNamesUnderTest
	^ #('OpalCompiler')! !

!OCCaseOfTest methodsFor: 'tests' stamp: 'ClementBera 7/10/2013 15:00'!
testCaseOfOtherwiseValue
	| temp |
	
	temp := #case1 
		caseOf: {
			[#case1]->[ 1 ].
 			[#case2]->[ 2 ] }
		otherwise: [ 3 ].
	self assert: temp equals: 1.
	
	temp := #case2
		caseOf: {
			[#case1]->[ 1 ].
 			[#case2]->[ 2 ] }
		otherwise: [ 3 ].
	self assert: temp equals: 2.
	
	temp := #case3 
		caseOf: {
			[#case1]->[ 1 ].
 			[#case2]->[ 2 ] }
		otherwise: [ 3 ].
	self assert: temp equals: 3
	
	
! !

!OCCaseOfTest methodsFor: 'tests' stamp: 'ClementBera 7/10/2013 15:01'!
testCaseOfOtherwiseEffect
	| temp |
	
	#case1 
		caseOf: {
			[#case1]->[ temp := 1 ].
 			[#case2]->[ temp := 2 ] }
		otherwise: [ temp := 3 ].
	self assert: temp equals: 1.
	
	#case2
		caseOf: {
			[#case1]->[ temp := 1 ].
 			[#case2]->[ temp := 2 ] }
		otherwise: [ temp := 3 ].
	self assert: temp equals: 2.
	
	#case3 
		caseOf: {
			[#case1]->[ temp := 1 ].
 			[#case2]->[ temp := 2 ] }
		otherwise: [ temp := 3 ].
	self assert: temp equals: 3
	
	
! !

!OCCaseOfTest methodsFor: 'tests' stamp: 'ClementBera 7/10/2013 15:02'!
testCaseOfEffect
	| temp |
	
	#case1 caseOf: {
		[#case1]->[ temp := 1 ].
 		[#case2]->[ temp := 2 ] }.
	self assert: temp equals: 1.
	
	#case2 caseOf: {
		[#case1]->[ temp := 1 ].
 		[#case2]->[ temp := 2 ] }.
	self assert: temp equals: 2.
	
	self should: [ 
		#case3 caseOf: {
			[#case1]->[ 1 ].
 			[#case2]->[ 2 ] }
		] raise: Error! !

!OCCaseOfTest methodsFor: 'tests' stamp: 'ClementBera 7/10/2013 15:09'!
testCompilationError
	self should: [ self compile: 'methodPattern 1 caseOf: { }' ] raise: SyntaxErrorNotification.
	self should: [ self compile: 'methodPattern 1 caseOf: { } otherwise: [ 42 ]' ] raise: SyntaxErrorNotification.! !

!OCCaseOfTest methodsFor: 'tests' stamp: 'ClementBera 7/10/2013 15:02'!
testCaseOfValue
	| temp |
	
	temp := #case1 caseOf: {
		[#case1]->[ 1 ].
 		[#case2]->[ 2 ] }.
	self assert: temp equals: 1.
	
	temp := #case2 caseOf: {
		[#case1]->[ 1 ].
 		[#case2]->[ 2 ] }.
	self assert: temp equals: 2.
	
	self should: [ 
		temp := #case3 caseOf: {
			[#case1]->[ 1 ].
 			[#case2]->[ 2 ] }
		] raise: Error
! !

!OCCaseOfTest methodsFor: 'helper' stamp: 'ClementBera 7/10/2013 15:08'!
compile: source
	^OpalCompiler new 
		class: self class; 
		source: source; 
		compile! !

!OCClassScope commentStamp: 'ajh 3/24/2003 21:44'!
I include all variable enries for class, pool and global vars.!
!OCClassScope methodsFor: '*TxText-Styler' stamp: 'IgorStasenko 11/11/2014 11:55'!
findVariable: lookupBlock ifNone: notFoundBlock 
	| var |
	class classPool associationsDo: [ :assoc |
		var := OCLiteralVariable new 
			assoc: assoc; 
			scope: self; 
			yourself.
			
		(lookupBlock value: var) ifTrue: [ ^ var ].
		 ].
	
	class sharedPools do: [ :pool |
		pool classPool associationsDo: [ :assoc | 
			var := OCLiteralVariable new 
			assoc: assoc; 
			scope: self; 
			yourself.
			(lookupBlock value: var) ifTrue: [ ^ var ].
			 ].
		 ].

	^ class environment findVariable: lookupBlock ifNone: notFoundBlock 
! !

!OCClassScope methodsFor: 'initializing' stamp: 'ajh 2/25/2003 20:10'!
class: aBehavior

	class := aBehavior! !

!OCClassScope methodsFor: 'lookup' stamp: 'GuillermoPolito 4/10/2015 10:58'!
lookupVar: name inContext: aContext
	"I'll lookup a variable in a class. The context does not play any role in here because variables in classes are statically defined"

	^ self lookupVar: name! !

!OCClassScope methodsFor: 'printing' stamp: 'MarcusDenker 6/18/2013 10:00'!
printOn: stream

	class printOn: stream.! !

!OCClassScope methodsFor: 'lookup' stamp: 'MarcusDenker 6/5/2013 13:52'!
lookupVarForDeclaration: name
	^self lookupVar: name! !

!OCClassScope methodsFor: 'lookup' stamp: 'MarcusDenker 6/14/2013 15:22'!
lookupVar: name
	"Return a SemVar for my pool var with this name.  Return nil if none found"

	^(class bindingOf: name asSymbol) ifNotNil: [:assoc | 
		OCLiteralVariable new 
			assoc: assoc; 
			scope: self; 
			yourself]
! !

!OCClassScope methodsFor: 'levels' stamp: 'MarcusDenker 8/27/2010 12:35'!
newMethodScope
	^ self instanceScope newMethodScope! !

!OCClassScope methodsFor: 'levels' stamp: 'MarcusDenker 6/25/2014 16:45'!
instanceScope

	^ OCInstanceScope new
		slots: class allSlots;
		outerScope: self;
		yourself! !

!OCClassScope methodsFor: 'lookup' stamp: 'GuillermoPolito 4/9/2015 17:15'!
variableNamed: name ifAbsent: aBlock
	"Return a SemVar for my pool var with this name.  Return nil if none found"

	^(class bindingOf: name asSymbol) ifNotNil: [:assoc | 
		OCLiteralVariable new 
			assoc: assoc; 
			scope: self; 
			yourself] ifNil: aBlock! !

!OCClassScope class methodsFor: 'instance creation' stamp: 'MarcusDenker 8/21/2010 18:39'!
for: aClass
	^self new 
		class: aClass;
		yourself! !

!OCCleanBockTest methodsFor: 'tests' stamp: 'ClementBera 8/5/2013 11:06'!
testBlockIsClean
	self assert: [  ] sourceNode isClean.
	self assert: [ 1 + 2 ] sourceNode isClean.
	self assert: [ :a | a + 2 ] sourceNode isClean.
	self assert: [ :a :b | a + b + 3 ] sourceNode isClean.
	self assert: [ | a | a := 1. a + 3 ] sourceNode isClean.
	 ! !

!OCCleanBockTest methodsFor: 'tests' stamp: 'ClementBera 8/5/2013 11:11'!
testBlockIsNotClean
	| escpWrite escpRead |
	escpRead := escpWrite := 1.
	self deny: [ self foo ] sourceNode isClean.
	self deny: [ ^ 1 ] sourceNode isClean.
	self deny: [ instVar foo ] sourceNode isClean.
	self deny: [ escpRead foo ] sourceNode isClean.
	self deny: [ escpWrite := 2 ] sourceNode isClean.
	 
	self deny: [[ self foo ]] sourceNode isClean.
	self deny: [[ ^ 1 ]] sourceNode isClean.
	self deny: [[ instVar foo ]] sourceNode isClean.
	self deny: [[ escpRead foo ]] sourceNode isClean.
	self deny: [[ escpWrite := 2 ]] sourceNode isClean.! !

!OCClosureCompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 9/30/2014 11:41'!
testDebuggerTempAccess
	self doTestDebuggerTempAccessWith: 1 with: 2! !

!OCClosureCompilerTest methodsFor: 'running' stamp: 'MarcusDenker 9/30/2014 11:41'!
evaluate: aString in: aContext to: anObject
	^self class compiler source: aString;
		context: aContext;
		receiver: anObject;
		evaluate! !

!OCClosureCompilerTest methodsFor: 'running' stamp: 'MarcusDenker 5/23/2013 13:45'!
tearDown
	SmalltalkImage compilerClass: currentCompiler.! !

!OCClosureCompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 5/23/2013 13:45'!
testInlineBlockCollectionLR3
	| col |
	col := OrderedCollection new.
	1 to: 11 do: [ :each | | i | i := each. col add: [ i ]. i := i + 1 ].
	self assert: (col collect: [ :each | each value ]) asArray = (2 to: 12) asArray! !

!OCClosureCompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 5/23/2013 13:45'!
testInlineBlockCollectionSD1
	| a1 b1 a2 b2 |
	b1 := OrderedCollection new.
	1 to: 3 do:
		[:i |
		a1 := i.
		b1 add: [a1]].
	b1 := b1 asArray collect: [:b | b value].
	b2 := OrderedCollection new.
	1 to: 3 do:
		[:i |
		a2 := i.
		b2 add: [a2]] yourself. "defeat optimization"
	b2 := b2 asArray collect: [:b | b value].
	self assert: b1 = b2! !

!OCClosureCompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 5/23/2013 13:45'!
testInlineBlockCollectionLR1
	"Test case from Lukas Renggli"
	| col |
	col := OrderedCollection new.
	1 to: 11 do: [ :each | col add: [ each ] ].
	self assert: (col collect: [ :each | each value ]) asArray = (1 to: 11) asArray! !

!OCClosureCompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 5/23/2013 13:45'!
testInlineBlockCollectionLR2
	"Test case from Lukas Renggli"
	| col |
	col := OrderedCollection new.
	1 to: 11 do: [ :each | #(1) do: [:ignored| col add: [ each ]] ].
	self assert: (col collect: [ :each | each value ]) asArray = (1 to: 11) asArray! !

!OCClosureCompilerTest methodsFor: 'running' stamp: 'MarcusDenker 5/23/2013 13:46'!
setUp
	currentCompiler := SmalltalkImage compilerClass.
	SmalltalkImage compilerClass: OpalCompiler.! !

!OCClosureCompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 9/30/2014 11:41'!
doTestDebuggerTempAccessWith: one with: two 
	"Test debugger access for temps"
	| outerContext local1 remote1 |
	outerContext := thisContext.
	local1 := 3.
	remote1 := 1/2.
	self assert: (self evaluate: 'one' in: thisContext to: self) == one.
	self assert: (self  evaluate: 'two' in: thisContext to: self) == two.
	self assert: (self  evaluate: 'local1' in: thisContext to: self) == local1.
	self assert: (self  evaluate: 'remote1' in: thisContext to: self) == remote1.
	self  evaluate: 'local1 := -3.0' in: thisContext to: self.
	self assert: local1 = -3.0.
	(1 to: 2) do:
		[:i| | local2 r1 r2 r3 r4 |
		local2 := i * 3.
		remote1 := local2 / 7.
		self assert: thisContext ~~ outerContext.
		self assert: (r1 := self  evaluate: 'one' in: thisContext to: self) == one.
		self assert: (r2 := self  evaluate: 'two' in: thisContext to: self) == two.
		self assert: (r3 := self  evaluate: 'i' in: thisContext to: self) == i.
		self assert: (r4 := self  evaluate: 'local2' in: thisContext to: self) == local2.
		self assert: (r4 := self  evaluate: 'remote1' in: thisContext to: self) == remote1.
		self assert: (r4 := self  evaluate: 'remote1' in: outerContext to: self) == remote1.
		self  evaluate: 'local2 := 15' in: thisContext to: self.
		self assert: local2 = 15.
		self  evaluate: 'local1 := 25' in: thisContext to: self.
		self assert: local1 = 25.
		{ r1. r2. r3. r4 } "placate the compiler"].
	self assert: local1 = -3.0.
	"this is not 25 as the var is a local, non escaping variable that was copied into the block,
	If the compiler would have known about the write, it would have made the var escaping".
	self assert: remote1 = (6/7)! !

!OCClosureCompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 5/23/2013 13:45'!
testOptimizedBlockLocalNilling2
	"Whether a block is optimized or not a block-local temp
	 should be nil at the start of each evaluation of the block."

	1 to: 6 do: [:i| | j k |
		self assert: j isNil.
		self assert: k isNil.
		i even
			ifTrue: [j := i + 2]
			ifFalse: [k := i + 1].
		self assert: (j isNil or: [k isNil]).
		self assert: (j isNil not or: [k isNil not])]! !

!OCClosureCompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 5/23/2013 13:45'!
testInlineBlockCollectionEM1
	| a1 b1 i1 a2 b2 i2 we wb |
	b1 := OrderedCollection new.
	i1 := 1.
	[a1 := i1.
	 i1 <= 3] whileTrue:
		[b1 add: [a1].
		i1 := i1 + 1].
	b1 := b1 asArray collect: [:b | b value].
	b2 := OrderedCollection new.
	i2 := 1.
	we := [a2 := i2. i2 <= 3].
	wb := [b2 add: [a2]. i2 := i2 + 1].
	we whileTrue: wb. "defeat optimization"
	b2 := b2 asArray collect: [:b | b value].
	self assert: b1 = b2! !

!OCClosureCompilerTest methodsFor: 'tests' stamp: 'MarcusDenker 5/23/2013 13:45'!
testOptimizedBlockLocalNilling1
	"Whether a block is optimized or not a block-local temp
	 should be nil at the start of each evaluation of the block."

	1 to: 3 do: [:i| | j |
		self assert: j isNil.
		j := i + 1.
		self assert: j isNil not]! !

!OCClosureCompilerTest methodsFor: 'source' stamp: 'MarcusDenker 5/23/2013 13:45'!
closureCases
	^#(
'| n |
n := 1.
^n + n'

'[:c :s| | mn |
mn := Compiler new
		compile: (c sourceCodeAt: s)
		in: c
		notifying: nil
		ifFail: [self halt].
mn generate: #(0 0 0 0).
{mn blockExtentsToTempsMap.
  mn encoder schematicTempNames}]
			value: AbstractInstructionTests
			value: #runBinaryConditionalJumps:'

'inject: thisValue into: binaryBlock
	| nextValue |
	nextValue := thisValue.
	self do: [:each | nextValue := binaryBlock value: nextValue value: each].
	^nextValue'

'mapFromBlockStartsIn: aMethod toTempVarsFrom: schematicTempNamesString constructor: aDecompilerConstructor
	| map |
	map := aMethod
				mapFromBlockKeys: aMethod startpcsToBlockExtents keys asSortedCollection
				toSchematicTemps: schematicTempNamesString.
	map keysAndValuesDo:
		[:startpc :tempNameTupleVector| | subMap tempVector numTemps |
		subMap := Dictionary new.
		tempNameTupleVector do:
			[:tuple|
			tuple last isArray
				ifTrue:
					[subMap at: tuple last first put: tuple last last.
					 numTemps := tuple last first]
				ifFalse:
					[numTemps := tuple last]].
		tempVector := Array new: numTemps.
		subMap keysAndValuesDo:
			[:index :size|
			tempVector at: index put: (Array new: size)].
		tempNameTupleVector do:
			[:tuple| | itv |
			tuple last isArray
				ifTrue:
					[itv := tempVector at: tuple last first.
					 itv at: tuple last last
						put: (aDecompilerConstructor
								codeTemp: tuple last last - 1
								named: tuple first)]
				ifFalse:
					[tempVector
						at: tuple last
						put: (aDecompilerConstructor
								codeTemp: tuple last - 1
								named: tuple first)]].
		subMap keysAndValuesDo:
			[:index :size|
			tempVector
				at: index
				put: (aDecompilerConstructor
						codeRemoteTemp: index
						remoteTemps: (tempVector at: index))].
		map at: startpc put: tempVector].
	^map'

 'gnuifyFrom: inFileStream to: outFileStream

	| inData beforeInterpret inInterpret inInterpretVars beforePrimitiveResponse inPrimitiveResponse |

	inData := inFileStream upToEnd withSqueakLineEndings.
	inFileStream close.

	outFileStream
		nextPutAll: ''/* This file has been post-processed for GNU C */'';
		cr; cr; cr.

	beforeInterpret := true.    "whether we are before the beginning of interpret()"
	inInterpret := false.     "whether we are in the middle of interpret"
	inInterpretVars := false.    "whether we are in the variables of interpret"
	beforePrimitiveResponse := true.  "whether we are before the beginning of primitiveResponse()"
	inPrimitiveResponse := false.   "whether we are inside of primitiveResponse"
	''Gnuifying''
		displayProgressAt: Sensor cursorPoint
		from: 1 to: (inData occurrencesOf: Character cr)
		during:
			[:bar | | lineNumber |
			lineNumber := 0.
			inData linesDo:
				[ :inLine | | outLine extraOutLine caseLabel |
				bar value: (lineNumber := lineNumber + 1).
				outLine := inLine. 	"print out one line for each input line; by default, print out the line that was input, but some rules modify it"
				extraOutLine := nil.   "occasionally print a second output line..."
				beforeInterpret ifTrue: [
					inLine = ''#include "sq.h"'' ifTrue: [
						outLine := ''#include "sqGnu.h"'' ].
					inLine = ''interpret(void) {'' ifTrue: [
						"reached the beginning of interpret"
						beforeInterpret := false.
						inInterpret := true.
						inInterpretVars := true ] ]
				ifFalse: [
				inInterpretVars ifTrue: [
					(inLine findString: ''register struct foo * foo = &fum;'') > 0 ifTrue: [
						outLine := ''register struct foo * foo FOO_REG = &fum;'' ].
					(inLine findString: '' localIP;'') > 0 ifTrue: [
						outLine := ''    char* localIP IP_REG;'' ].
					(inLine findString: '' localFP;'') > 0 ifTrue: [
						outLine := ''    char* localFP FP_REG;'' ].
					(inLine findString: '' localSP;'') > 0 ifTrue: [
						outLine := ''    char* localSP SP_REG;'' ].
					(inLine findString: '' currentBytecode;'') > 0 ifTrue: [
						outLine := ''    sqInt currentBytecode CB_REG;'' ].
					inLine isEmpty ifTrue: [
						"reached end of variables"
						inInterpretVars := false.
						outLine := ''    JUMP_TABLE;''.
						extraOutLine := inLine ] ]
				ifFalse: [
				inInterpret ifTrue: [
					"working inside interpret(); translate the switch statement"
					(inLine beginsWith: ''		case '') ifTrue: [
						caseLabel := (inLine findTokens: ''	 :'') second.
						outLine := ''		CASE('', caseLabel, '')'' ].
					inLine = ''			break;'' ifTrue: [
						outLine := ''			BREAK;'' ].
					inLine = ''}'' ifTrue: [
						"all finished with interpret()"
						inInterpret := false ] ]
				ifFalse: [
				beforePrimitiveResponse ifTrue: [
					(inLine beginsWith: ''primitiveResponse('') ifTrue: [
						"into primitiveResponse we go"
						beforePrimitiveResponse := false.
						inPrimitiveResponse := true.
						extraOutLine := ''    PRIM_TABLE;'' ] ]
				ifFalse: [
				inPrimitiveResponse ifTrue: [
					inLine = ''	switch (primitiveIndex) {'' ifTrue: [
						extraOutLine := outLine.
						outLine := ''	PRIM_DISPATCH;'' ].
					inLine = ''	switch (GIV(primitiveIndex)) {'' ifTrue: [
						extraOutLine := outLine.
						outLine := ''	PRIM_DISPATCH;'' ].
					(inLine beginsWith: ''	case '') ifTrue: [
						caseLabel := (inLine findTokens: ''	 :'') second.
						outLine := ''	CASE('', caseLabel, '')'' ].
					inLine = ''}'' ifTrue: [
						inPrimitiveResponse := false ] ]
				] ] ] ].

				outFileStream nextPutAll: outLine; cr.
				extraOutLine ifNotNil: [
					outFileStream nextPutAll: extraOutLine; cr ]]].

	outFileStream close' )! !

!OCClosureCompilerTest class methodsFor: 'code examples' stamp: 'MarcusDenker 5/23/2013 13:45'!
methodWithCopiedTemps
	| a b c r |
	a := 1.
	b := 2.
	c := 4.
	r := [a + b + c] value.
	b := nil.
	r

	"Parser new
		parse: (self class sourceCodeAt: #methodWithCopiedTemps)
		class: self class"

	"(Parser new
		encoderClass: EncoderForV3;
		parse: (self class sourceCodeAt: #methodWithCopiedTemps)
		class: self class) generateUsingClosures: #(0 0 0 0)"! !

!OCClosureCompilerTest class methodsFor: 'code examples' stamp: 'MarcusDenker 5/23/2013 13:45'!
methodWithCopiedAndAssignedTemps
	| blk "0w" a "0w" b "0w" c "0w" t "0w" r1 "0w" r2 "0w" |
	a := 1. "1w"
	b := 2. "1w"
	c := 4. "1w"
	t := 0. "1w"
	blk "5w" := ["2" t  "3w" := t "3r" + a "3r" + b "3r" + c "3r" ] "4".
	r1 "5w" := blk "5r" value.
	b "5w" := -100.
	r2 "5w" := blk "5r" value.
	^r1 "5r" -> r2 "5r" -> t "5r"

	"a: main(read(),write(0,1)), block(read(3),write()) => copy; no writes follow read
	 b: main(read(),write(0,1,5)), block(read(3),write()) => remote; write follows contained read
	 blk: main(read(5),write(0,5)), block(read(),write()) => no copy in blocks < 5
	 c: main(read(),write(0,1)), block(read(3),write()) => copy; no writes follow read
	 r1: main(read(5),write(0,5)), block(read(),write()) => no copy in blocks < 5
	 r2: main(read(5),write(0,5)), block(read(),write()) => no copy in blocks < 5
	 t: main(read(5),write(0,1)), block(read(3),write(3)) => remote; read follows contained write"


	"(Parser new
		encoderClass: EncoderForV3;
		parse: (self class sourceCodeAt: #methodWithCopiedAndAssignedTemps)
		class: self class) generateUsingClosures: #(0 0 0 0)"! !

!OCClosureCompilerTest class methodsFor: 'code examples' stamp: 'MarcusDenker 5/23/2013 13:45'!
methodWithOptimizedBlocks
	| s c |
	s := self isNil
			ifTrue: [| a | a := 'isNil'. a]
			ifFalse: [| b | b := 'notNil'. b].
	c := String new: s size.
	1 to: s size do:
		[:i| c at: i put: (s at: i)].
	^c

	"Parser new
		parse: (self class sourceCodeAt: #methodWithOptimizedBlocks)
		class: self class"! !

!OCClosureCompilerTest class methodsFor: 'code examples' stamp: 'MarcusDenker 5/23/2013 13:45'!
methodWithVariousTemps
	| classes total totalLength |
	classes := self withAllSuperclasses.
	total := totalLength := 0.
	classes do: [:class| | className |
		className := class name.
		total := total + 1.
		totalLength := totalLength + className size].
	^total -> totalLength

	"Parser new
		parse: (self class sourceCodeAt: #methodWithVariousTemps)
		class: self class"! !

!OCClosureCompilerTest class methodsFor: 'code examples' stamp: 'MarcusDenker 5/23/2013 13:45'!
methodWithOptimizedBlocksA
	| s c |
	s := self isNil
			ifTrue: [| a | a := 'isNil'. a]
			ifFalse: [| a | a := 'notNil'. a].
	c := String new: s size.
	1 to: s size do:
		[:i| c at: i put: (s at: i)].
	^c

	"Parser new
		parse: (self class sourceCodeAt: #methodWithOptimizedBlocksA)
		class: self class"! !

!OCClosureCompilerTest class methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 5/23/2013 13:50'!
compilerClass
	^OpalCompiler! !

!OCClosureCompilerTest class methodsFor: 'code examples' stamp: 'MarcusDenker 5/23/2013 13:45'!
methodWithCopiedAndPostClosedOverAssignedTemps
	| blk a b c r1 r2 |
	a := 1.
	b := 2.
	c := 4.
	blk := [a + b + c].
	r1 := blk value.
	b := nil.
	r2 := blk value.
	r1 -> r2

	"(Parser new
		encoderClass: EncoderForV3;
		parse: (self class sourceCodeAt: #methodWithCopiedAndPostClosedOverAssignedTemps)
		class: self class) generateUsingClosures: #(0 0 0 0)"! !

!OCClosureTests methodsFor: 'testing-empty' stamp: 'MarcusDenker 5/2/2013 11:25'!
testEmptyBlockTwoArguments
	self
		assert: (self class compiler evaluate: '[ :a :b ] value: 1 value: 2') isNil
		description: 'Empty blocks in ST-80 should return nil'.
	self
		assert: (self class compiler evaluate: '[ :a :b | ] value: 1 value: 2') isNil
		description: 'Empty blocks in ST-80 should return nil'.
	self
		assert: (self class compiler evaluate: '[ :a :b | | t | ] value: 1 value: 2') isNil
		description: 'Empty blocks in ST-80 should return nil'! !

!OCClosureTests methodsFor: 'testing-while' stamp: 'StephaneDucasse 7/3/2010 22:21'!
testWhileWithTempIsNil
	"self debug: #testWhileWithTempIsNil"
	| index |
	index := 0.
	[ index < 5 ] whileTrue: [
		| temp |
		collection add: temp.
		temp := index := index + 1. 
		collection add: temp].
	self assertValues: #(nil 1 nil 2 nil 3 nil 4 nil 5)! !

!OCClosureTests methodsFor: 'testing' stamp: 'lr 3/11/2009 17:36'!
testMethodTemp
	| block1 block2 |
	block1 := self methodArgument: 1.
	block2 := self methodArgument: 2.
	self assert: block1 value = 1.
	self assert: block2 value = 2! !

!OCClosureTests methodsFor: 'testing' stamp: 'lr 3/11/2009 17:33'!
testBlockTemp
	| block block1 block2 |
	block := [ :arg | [ arg ] ].
	block1 := block value: 1.
	block2 := block value: 2.
	self assert: block1 value = 1.
	self assert: block2 value = 2! !

!OCClosureTests methodsFor: 'testing-while' stamp: 'lr 3/10/2009 14:29'!
testWhileModificationAfter
	| index |
	index := 0.
	[ index < 5 ] whileTrue: [
		collection add: [ index ].
		index := index + 1 ].
	self assertValues: #(5 5 5 5 5)! !

!OCClosureTests methodsFor: 'testing' stamp: 'sd 6/8/2012 23:31'!
testIsClean
	 | local |
	 local := #testIsClean.
	self assert: [] isClean. "closes over nothing at all"
	self assert: [:a :b| a < b] isClean. "accesses only arguments"
	self assert: [:a :b| | s | s := a + b. s even] isClean. "accesses only local variables"
	self deny: [^nil] isClean. "closes over home (^-return)"
	self deny: [self] isClean. "closes over the receiver"
	self deny: [collection] isClean. "closes over the receiver (to access the inst var collection)"
	self deny: [local] isClean. "closes over local variable of outer context"! !

!OCClosureTests methodsFor: 'utilities' stamp: 'StefanMarr 3/16/2012 01:36'!
assertValues: anArray
	| values |
	values := collection collect: [ :each | each value ].
	self 
		assert: anArray asArray = values asArray
		description: ['Expected: ' , anArray asArray printString , 
			', but got ' , values asArray printString]! !

!OCClosureTests methodsFor: 'testing' stamp: 'lr 3/11/2009 17:35'!
methodArgument: anObject
	^ [ anObject ]
	! !

!OCClosureTests methodsFor: 'testing-todo' stamp: 'lr 3/10/2009 14:51'!
testToDoOutsideTemp
	| temp |
	1 to: 5 do: [ :index | 
		temp := index. 
		collection add: [ temp ] ].
	self assertValues: #(5 5 5 5 5)! !

!OCClosureTests methodsFor: 'testing-todo' stamp: 'lr 3/10/2009 14:51'!
testToDoOutsideTempNotInlined
	| block temp |
	block := [ :index | 
		temp := index. 
		collection add: [ temp ] ].
	1 to: 5 do: block.
	self assertValues: #(5 5 5 5 5)! !

!OCClosureTests methodsFor: 'testing-while' stamp: 'lr 3/10/2009 14:29'!
testWhileModificationAfterNotInlined
	| index block |
	index := 0.
	block := [ 
		collection add: [ index ].
		index := index + 1 ].
	[ index < 5 ] whileTrue: block.
	self assertValues: #(5 5 5 5 5)! !

!OCClosureTests methodsFor: 'running' stamp: 'lr 3/9/2009 16:48'!
setUp
	super setUp.
	collection := OrderedCollection new! !

!OCClosureTests methodsFor: 'testing-todo' stamp: 'lr 3/10/2009 14:51'!
testToDoInsideTempNotInlined
	| block |
	block := [ :index | 
		| temp | 
		temp := index. 
		collection add: [ temp ] ].
	1 to: 5 do: block.
	self assertValues: #(1 2 3 4 5)! !

!OCClosureTests methodsFor: 'testing-while' stamp: 'lr 3/10/2009 14:29'!
testWhileModificationBefore
	| index |
	index := 0.
	[ index < 5 ] whileTrue: [ 
		index := index + 1.
		collection add: [ index ] ].
	self assertValues: #(5 5 5 5 5)! !

!OCClosureTests methodsFor: 'testing-while' stamp: 'lr 3/10/2009 14:29'!
testWhileModificationBeforeNotInlined
	| index block |
	index := 0.
	block := [ 
		index := index + 1.
		collection add: [ index ] ].
	[ index < 5 ] whileTrue: block.
	self assertValues: #(5 5 5 5 5)! !

!OCClosureTests methodsFor: 'testing-while' stamp: 'lr 3/10/2009 14:52'!
testWhileWithTemp
	| index |
	index := 0.
	[ index < 5 ] whileTrue: [
		| temp |
		temp := index := index + 1.
		collection add: [ temp ] ].
	self assertValues: #(1 2 3 4 5)! !

!OCClosureTests methodsFor: 'testing-while' stamp: 'lr 3/10/2009 14:53'!
testWhileWithTempNotInlined
	| index block |
	index := 0.
	block := [
		| temp |
		temp := index := index + 1.
		collection add: [ temp ] ].
	[ index < 5 ] whileTrue: block.
	self assertValues: #(1 2 3 4 5)! !

!OCClosureTests methodsFor: 'testing-empty' stamp: 'MarcusDenker 5/2/2013 11:25'!
testEmptyBlockOneArgument
	self
		assert: (self class compiler evaluate: '[ :a ] value: 1') isNil
		description: 'Empty blocks in ST-80 should return nil'.
	self
		assert: (self class compiler evaluate: '[ :a | ] value: 1') isNil
		description: 'Empty blocks in ST-80 should return nil'.
	self
		assert: (self class compiler evaluate: '[ :a | | t | ] value: 1') isNil
		description: 'Empty blocks in ST-80 should return nil'! !

!OCClosureTests methodsFor: 'testing-empty' stamp: 'MarcusDenker 5/2/2013 11:25'!
testEmptyBlockZeroArguments
	self
		assert: (self class compiler evaluate: '[ ] value') isNil
		description: 'Empty blocks in ST-80 should return nil'.
	self
		assert: (self class compiler evaluate: '[ | t | ] value') isNil
		description: 'Empty blocks in ST-80 should return nil'! !

!OCClosureTests methodsFor: 'testing-todo' stamp: 'lr 3/10/2009 14:51'!
testToDoArgument
	1 to: 5 do: [ :index |
		collection add: [ index ] ].
	self assertValues: #(1 2 3 4 5)! !

!OCClosureTests methodsFor: 'testing' stamp: 'lr 3/11/2009 17:33'!
testBlockArgument
	| block block1 block2 |
	block := [ :arg | | temp | temp := arg. [ temp ] ].
	block1 := block value: 1.
	block2 := block value: 2.
	self assert: block1 value = 1.
	self assert: block2 value = 2! !

!OCClosureTests methodsFor: 'testing-todo' stamp: 'lr 3/10/2009 14:51'!
testToDoArgumentNotInlined
	| block |
	block := [ :index |
		collection add: [ index ] ].
	1 to: 5 do: block.
	self assertValues: #(1 2 3 4 5)! !

!OCClosureTests methodsFor: 'testing' stamp: 'lr 3/11/2009 17:36'!
testMethodArgument
	| temp block |
	temp := 0.
	block := [ [ temp ] ].
	temp := 1.
	block := block value.
	temp := 2.
	self assert: block value = 2! !

!OCClosureTests methodsFor: 'testing-todo' stamp: 'lr 3/10/2009 14:51'!
testToDoInsideTemp
	1 to: 5 do: [ :index | 
		| temp | 
		temp := index. 
		collection add: [ temp ] ].
	self assertValues: #(1 2 3 4 5)! !

!OCCompiledMethodIntegrityTests methodsFor: 'test' stamp: 'MarcusDenker 9/5/2013 14:43'!
testBlockTemps

	| newCompiledMethod originalCompiledMethod |
	
	(Smalltalk hasClassNamed: #Compiler) ifFalse: [^self skip].
	
	newCompiledMethod := OpalCompiler new 
								source: 'ascentOf: aCharacter
											^ [ | temp1 temp2 temp3 | 1= temp1. 2 = temp2. 3 = temp3].';
								class: OCMockCompilationClass;
								compile.
								

	originalCompiledMethod := (Smalltalk classNamed: #Compiler) new 
								source: 'ascentOf: aCharacter
											^ [ | temp1 temp2 temp3 | 1= temp1. 2 = temp2. 3 = temp3].';
								class: OCMockCompilationClass;
								compile.
							
	self assert: newCompiledMethod numArgs = originalCompiledMethod numArgs.
	self assert: newCompiledMethod numLiterals = originalCompiledMethod numLiterals.
	self assert: newCompiledMethod numTemps = originalCompiledMethod numTemps.
	self assert: newCompiledMethod primitive = originalCompiledMethod primitive.
	self assert: newCompiledMethod header = originalCompiledMethod header! !

!OCCompiledMethodIntegrityTests methodsFor: 'test' stamp: 'MarcusDenker 9/5/2013 14:45'!
testPrimitive

	| newCompiledMethod originalCompiledMethod |
	
	(Smalltalk hasClassNamed: #Compiler) ifFalse: [^self skip].
	
	newCompiledMethod := OpalCompiler new 
								source: 'size
											<primitive: 62>
											^ self basicSize.';
								class: OCMockCompilationClass;
								compile.

	originalCompiledMethod := (Smalltalk classNamed: #Compiler) new 
								source: 'size
											<primitive: 62>
											^ self basicSize.';
								class: OCMockCompilationClass;
								compile.
							
	self assert: newCompiledMethod numArgs = originalCompiledMethod numArgs.
	self assert: newCompiledMethod numLiterals = originalCompiledMethod numLiterals.
	self assert: newCompiledMethod numTemps = originalCompiledMethod numTemps.
	self assert: newCompiledMethod primitive = originalCompiledMethod primitive.
	self assert: newCompiledMethod header = originalCompiledMethod header! !

!OCCompiledMethodIntegrityTests methodsFor: 'test' stamp: 'MarcusDenker 9/5/2013 14:44'!
testNotUsedArgument

	| newCompiledMethod originalCompiledMethod |
	
	(Smalltalk hasClassNamed: #Compiler) ifFalse: [^self skip].
	
	newCompiledMethod := OpalCompiler new 
								source: 'ascentOf: aCharacter
											^ self ascent.';
								class: OCMockCompilationClass;
								compile.

	originalCompiledMethod := (Smalltalk classNamed: #Compiler) new 
								source: 'ascentOf: aCharacter
											^ self ascent.';
								class: OCMockCompilationClass;
								compile.
					
	self assert: newCompiledMethod numArgs = originalCompiledMethod numArgs.
	self assert: newCompiledMethod numLiterals = originalCompiledMethod numLiterals.
	self assert: newCompiledMethod numTemps = originalCompiledMethod numTemps.
	self assert: newCompiledMethod primitive = originalCompiledMethod primitive.
	self assert: newCompiledMethod header = originalCompiledMethod header! !

!OCCompiledMethodIntegrityTests methodsFor: 'test' stamp: 'MarcusDenker 9/5/2013 14:45'!
testPragmas

	| newCompiledMethod originalCompiledMethod |
	
	(Smalltalk hasClassNamed: #Compiler) ifFalse: [^self skip].
	
	newCompiledMethod := OpalCompiler new 
									source: 'methodDoublePragma
											<hello: 5>
											<hello: 2>';
									class: OCMockCompilationClass;
									compile.

	originalCompiledMethod := (Smalltalk classNamed: #Compiler) new 
									source: 'methodDoublePragma
											<hello: 5>
											<hello: 2>';
									class: OCMockCompilationClass;
									compile.

							
	self assert: newCompiledMethod numArgs = originalCompiledMethod numArgs.
	self assert: newCompiledMethod numLiterals = originalCompiledMethod numLiterals.
	
	"AdditionalState assertions"
	self assert: newCompiledMethod literals first selector = originalCompiledMethod literals first selector.
	self assert:  (newCompiledMethod literals first analogousCodeTo: originalCompiledMethod literals first).
	self assert: (newCompiledMethod literals first instVarNamed: 'method') = newCompiledMethod.
		
	self assert: newCompiledMethod literals second = originalCompiledMethod literals second.
	self assert: newCompiledMethod numTemps = originalCompiledMethod numTemps.
	self assert: newCompiledMethod primitive = originalCompiledMethod primitive.
	self assert: newCompiledMethod header = originalCompiledMethod header! !

!OCCompiledMethodIntegrityTests methodsFor: 'test' stamp: 'MarcusDenker 9/5/2013 14:46'!
testRemoteTempInVector

	| newCompiledMethod originalCompiledMethod |


	(Smalltalk hasClassNamed: #Compiler) ifFalse: [^self skip].
	
	"Here the problem was that the Scope kept both the remote temp answer and the new remote <?> this caused
	that the number of temps were more than the correnct"
	
	newCompiledMethod := OpalCompiler new 
											source: 'value
													    | answer |
 													   self do:
       														 [:each |
        															answer := each value].
   													 ^answer';
											class: Object;
											compile.

	originalCompiledMethod := (Smalltalk classNamed: #Compiler) new 
												source: 'value
													    | answer |
 													   self do:
       														 [:each |
        															answer := each value].
   													 ^answer';
											class: Object;
											compile.
							
	self assert: newCompiledMethod numArgs = originalCompiledMethod numArgs.
	self assert: newCompiledMethod numLiterals = originalCompiledMethod numLiterals.
	self assert: newCompiledMethod numTemps = originalCompiledMethod numTemps.
	self assert: newCompiledMethod primitive = originalCompiledMethod primitive.
	self assert: newCompiledMethod header = originalCompiledMethod header! !

!OCCompilerASTPlugin commentStamp: 'MarcusDenker 2/28/2015 15:00'!
I am an abtract superclass for compiler plugings.

The compiler consists of multiple passes:

source 
	- [ Scanner/Parser ]  -> 
AST 
	- [ SemCheck ] -> 
AST   <<HERE>>
	- [ ASTTranslator ] -> 
IR 
	- [ IRBuilder ] ->
 CompiledMethod


These plugins are called <<HERE>>, that is, after semantic analysis before generating the IR.
They are sorted by #priority and handed a *copy* of the AST.


!
!OCCompilerASTPlugin methodsFor: 'api' stamp: 'MarcusDenker 2/28/2015 15:03'!
transform: anRBMethodNode
	"by default do nothing"
	^ ast := anRBMethodNode.! !

!OCCompilerASTPlugin methodsFor: 'api' stamp: 'MarcusDenker 2/28/2015 15:01'!
priority
	^100 "default. Priority 0 is used by Reflectivity to be the last"! !

!OCCompilerASTPlugin methodsFor: 'accessing' stamp: 'MarcusDenker 2/28/2015 15:57'!
ast: anAst
	ast := anAst! !

!OCCompilerASTPlugin class methodsFor: 'instance creation' stamp: 'MarcusDenker 2/28/2015 15:56'!
transform: ast
	^self new
		ast: ast;
		transform.! !

!OCCompilerExceptionsTest methodsFor: 'setUp' stamp: 'MarcusDenker 5/25/2013 16:16'!
tearDown
	self removeGeneratedMethods.
	SmalltalkImage compilerClass: currentCompiler.! !

!OCCompilerExceptionsTest methodsFor: 'tests' stamp: 'MarcusDenker 5/25/2013 11:21'!
testUndefinedVariable

	self
		compiling: 'griffle | goo | ^ goo' shouldRaise: OCUninitializedVariableWarning ;
		compiling: 'griffle [ | goo | ^ goo ] value' shouldRaise: OCUninitializedVariableWarning! !

!OCCompilerExceptionsTest methodsFor: 'emulating' stamp: 'MarcusDenker 5/25/2013 11:17'!
selectionInterval
	^ 1 to: 0! !

!OCCompilerExceptionsTest methodsFor: 'setUp' stamp: 'MarcusDenker 5/25/2013 16:16'!
setUp

	currentCompiler := SmalltalkImage compilerClass.
	SmalltalkImage compilerClass: OpalCompiler.
! !

!OCCompilerExceptionsTest methodsFor: 'compiling' stamp: 'MarcusDenker 5/25/2013 11:17'!
compiling: sourceCode shouldRaise: exceptionClass

	self should: [ self compile: sourceCode ] raise: exceptionClass! !

!OCCompilerExceptionsTest methodsFor: 'compiling' stamp: 'StephaneDucasse 8/29/2013 21:06'!
removeGeneratedMethods

	self class removeProtocol: 'generated'! !

!OCCompilerExceptionsTest methodsFor: 'compiling' stamp: 'MarcusDenker 5/25/2013 11:17'!
interactive 
	^ true! !

!OCCompilerExceptionsTest methodsFor: 'emulating' stamp: 'MarcusDenker 5/25/2013 11:17'!
selectFrom: start to: end 
	! !

!OCCompilerExceptionsTest methodsFor: 'tests' stamp: 'MarcusDenker 5/25/2013 11:22'!
testUndeclaredVariable

	self
		compiling: 'griffle ^ goo' shouldRaise: OCUndeclaredVariableWarning  ;
		compiling: 'griffle ^ [ goo ] value' shouldRaise: OCUndeclaredVariableWarning! !

!OCCompilerExceptionsTest methodsFor: 'emulating' stamp: 'MarcusDenker 5/25/2013 11:17'!
text
	^ text! !

!OCCompilerExceptionsTest methodsFor: 'compiling' stamp: 'MarcusDenker 5/25/2013 11:17'!
compile: sourceString

       text := sourceString.
       self class
               compileSilently: text
               classified: 'generated'
               notifying: self! !

!OCCompilerExceptionsTest methodsFor: 'tests' stamp: 'MarcusDenker 5/25/2013 11:21'!
testUnusedVariable

       self
               compiling: 'griffle | goo | ^nil' shouldRaise: OCUnusedVariableWarning.! !

!OCCompilerExceptionsTest methodsFor: 'emulating' stamp: 'MarcusDenker 5/25/2013 11:17'!
select
	! !

!OCCompilerNotifyingTest commentStamp: '<historical>'!
A CompilerNotifyingTest is a TestCase for checking that Compiler/Parser notifications are inserted at the right place in a TextEditor.

Instance Variables
	expectedErrorPositions:		<Array of: Integer>
	expectedErrors:		<Array of: String>
	failure:		<Object>
	morph:		<TextMorph>
	text:		<String>

errorPositions
	- the position where error text should be inserted for each chunk of text evaluated

errors
	- the error text that should be inserted on evaluation of each chunk of text evaluated

failure
	- an object returned in case of evaluation error and whose identity can be uniquely recognized as a failure
	
morph
	- the Morph holding the text
	
text
	- the string containing all the chunks to be evaluated (separated by %)
	  and the expected error messages (`enclosed in back quotes`)
	  this text will be stripped of the error messages before being evaluated.

!
!OCCompilerNotifyingTest methodsFor: 'testing-byteCode limits' stamp: 'md 5/23/2013 10:27'!
testTooManyArguments
	self setUpForErrorsIn: '^ ` Too many arguments ->`[:x1 :x2 :x3 :x4 :x5 :x6 :x7 :x8 :x9 :x10 :x11 :x12 :x13 :x14 :x15 :x16 :x17 | ]'.
	self enumerateAllSelections.! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'MarcusDenker 3/27/2014 11:08'!
testExtraneousStatementAfterAReturnInABlock
	self setUpForErrorsIn: '[ ^1 ` End of statement list encountered ->`2]'.
	self enumerateAllSelections.! !

!OCCompilerNotifyingTest methodsFor: 'private' stamp: 'ClementBera 4/16/2013 10:38'!
numberOfSelections
	^(text occurrencesOf: $%) + 1! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'MarcusDenker 4/16/2013 15:29'!
testUnmatchedLocalTempDeclaration

	self setUpForErrorsIn: '| x y ` ''|'' expected ->`'.
	self enumerateAllSelections.! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'MarcusDenker 4/16/2013 15:23'!
testMissingExpressionAfterAReturn

	self setUpForErrorsIn: '^ ` Variable or expression expected ->`. 1 + 2'.
	self enumerateAllSelections.! !

!OCCompilerNotifyingTest methodsFor: 'private' stamp: 'ClementBera 5/14/2013 13:22'!
evaluateSelection
	^ OpalCompiler new
		source: morph editor selectionAsStream;
		requestor: morph editor;
		failBlock: [^failure];
		evaluate

	! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'MarcusDenker 4/16/2013 15:17'!
testMissingBlockArgumentName

	self setUpForErrorsIn: '[ :x : ` Variable name expected ->`1]'.
	self enumerateAllSelections! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'MarcusDenker 4/16/2013 15:29'!
testUnmatchedExpressionParenthesis

	self setUpForErrorsIn: '1+(2 ` '')'' expected ->`. '.
	self enumerateAllSelections.! !

!OCCompilerNotifyingTest methodsFor: 'initialize-release' stamp: 'ClementBera 4/16/2013 10:38'!
initializeTextWithoutError
	"Remove the errors from the text to be compiled and answer the text without errors.
	Meanwhile, collect the expected error messages and their expected position."

	| input output errorStream positionStream |
	input := text readStream.
	output := (String new: text size) writeStream.
	errorStream := (Array new: self numberOfSelections) writeStream.
	positionStream := (Array new: self numberOfSelections) writeStream.
	
	[output nextPutAll: (input upTo: $`).
	input atEnd]
		whileFalse:
			[positionStream nextPut: output position + 1.
			errorStream nextPut: (input upTo: $`)].
	expectedErrors := errorStream contents.
	expectedErrorPositions := positionStream contents.
	^output contents! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'MarcusDenker 3/27/2014 11:08'!
testExpectedExpressionInBraceArray
	
	self setUpForErrorsIn: '{ 1. 2 ` End of statement list encountered ->`3 }'.
	self enumerateAllSelections.
	self setUpForErrorsIn: '{ 1. 2. ` Variable or expression expected ->`| x | x}'.
	self enumerateAllSelections.! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'MarcusDenker 4/16/2013 15:25'!
testMissingSeparatorBetweenBlockArgumentAndStatements
	
	self setUpForErrorsIn: '[ :x ` ''|'' expected ->`x + 1 ]'.
	self enumerateAllSelections! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'MarcusDenker 4/16/2013 15:28'!
testUnmatchedByteArrayBracket

	self setUpForErrorsIn: '#[ 1 2 ` '']'' expected ->`'.
	self enumerateAllSelections! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'MarcusDenker 4/16/2013 15:29'!
testUnmatchedLocalTempDeclarationInABlock

	self setUpForErrorsIn: '[:z | | x y ` ''|'' expected ->`]'.
	self enumerateAllSelections.! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'MarcusDenker 4/16/2013 15:28'!
testUnmatchedBlockBracket
	self setUpForErrorsIn: 'nil yourself. [` '']'' expected ->`'.
	self enumerateAllSelections.! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'MarcusDenker 4/25/2013 16:45'!
testInvalidRadix

	self setUpForErrorsIn: '1` Reading a number failed: an integer greater than 1 as valid radix expected ->`r0'.
	self enumerateAllSelections.! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'md 5/23/2013 10:25'!
testInvalidLiteralCharacter
	self setUpForErrorsIn: '^ #yourself , #)` Expecting a literal type ->` , #end'.
	self enumerateAllSelections.! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'MarcusDenker 4/16/2013 15:24'!
testMissingMessageAfterACascade
	
	self setUpForErrorsIn: 'nil yourself; ` Message expected ->`^ 2'.
	self enumerateAllSelections! !

!OCCompilerNotifyingTest methodsFor: 'private' stamp: 'ClementBera 4/16/2013 13:21'!
evaluateSelectionNumber: n
	| i start stop |
	i := start := 1.
	[stop := morph text indexOf: $% startingAt: start + 1 ifAbsent: morph text size + 1.
	i = n]
		whileFalse:
			[i := i + 1.
			start := stop + 1].
	morph editor selectFrom: start to: stop - 1.
	^self evaluateSelection
	! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'MarcusDenker 3/27/2014 11:08'!
testMissingPeriodSeparatorBetweenStatements

	self setUpForErrorsIn: '1 + 2 ` End of statement list encountered ->`^nil'.
	self enumerateAllSelections.! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'MarcusDenker 4/16/2013 15:29'!
testUnmatchedLiteralParenthesis

	self setUpForErrorsIn: '#( 1 2` '')'' expected ->`'.
	self enumerateAllSelections.
	self setUpForErrorsIn: '#( 1 2 ` '')'' expected ->`'.
	self enumerateAllSelections.! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'MarcusDenker 4/25/2013 16:33'!
testDigitTooLargeForARadix

	self setUpForErrorsIn: '2r` Reading a number failed: a digit between 0 and 1 expected ->`3'.
	self enumerateAllSelections! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'MarcusDenker 4/16/2013 15:21'!
testMissingArgumentAfterABinaryMessage
	self setUpForErrorsIn: '1 +` Variable or expression expected ->`'.
	self enumerateAllSelections.
	self setUpForErrorsIn: '1 + ` Variable or expression expected ->`* 2 + 3'.
	self enumerateAllSelections! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'MarcusDenker 4/25/2013 17:04'!
testUnmatchedStringQuote

	self setUpForErrorsIn: '^nil printString ,  ''unfinished string` Unmatched '' in string literal. ->`'.
	self enumerateAllSelections! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'MarcusDenker 4/16/2013 15:28'!
testUnmatchedBraceArray
	self setUpForErrorsIn: '{ 1. 2` expected } ->`'.
	self enumerateAllSelections.
	self setUpForErrorsIn: '{ 1. 2 ` expected } ->`'.
	self enumerateAllSelections! !

!OCCompilerNotifyingTest methodsFor: 'initialize-release' stamp: 'ClementBera 4/16/2013 10:38'!
setUpForErrorsIn: aTextWithErrorsEnclosedInBackQuote
  "Extract the expectedErrors, the expectedErrorPositions and set up a TextMorph containing the text without errors.
  each section separated by % in aTextWithErrorsEnclosedInBackQuote will be evaluated separately.
  The expected error message should lie in aTextWithErrorsEnclosedInBackQuote at the expected position, and enclosed in back quotes."
  text := aTextWithErrorsEnclosedInBackQuote.
  morph := MockSourceEditor new contents: self initializeTextWithoutError asText.! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'MarcusDenker 4/16/2013 15:22'!
testMissingExpression

	
	self setUpForErrorsIn: '| x | x := ` Variable or expression expected ->'.
	self enumerateAllSelections! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'ClementBera 4/16/2013 14:26'!
testInvalidPrimitive
	"Not implemented yet.
	##primitive:error: #primitive:module:error: skipped, cannot be evaluated"! !

!OCCompilerNotifyingTest methodsFor: 'initialize-release' stamp: 'ClementBera 4/16/2013 10:37'!
setUp
	failure := Object new.! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'ClementBera 4/16/2013 14:26'!
testInvalidPragma
	"Not implemented yet.
	#pragmaLiteral: #pragmaSequence #pragmaStatement #pragmaPrimitives skipped, cannot be evaluated"! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'MarcusDenker 4/16/2013 16:07'!
testAssignmentOfSelf

	self setUpForErrorsIn: '` Cannot store into ->`self := 1. ^self'.
	self enumerateAllSelections.! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'ClementBera 4/16/2013 14:26'!
testInvalidExternalFunctionDeclaration
	"Not implemented yet.
	#externalFunctionDeclaration skipped, cannot be evaluated"! !

!OCCompilerNotifyingTest methodsFor: 'private' stamp: 'MarcusDenker 5/23/2013 10:39'!
enumerateAllSelections
	1 to: self numberOfSelections do: [:n |
		self assert: (self evaluateSelectionNumber: n) == failure.
		self assert: morph editor selection asString equals: (expectedErrors at: n).  
		self assert: (expectedErrorPositions at: n) equals: morph editor startIndex.
		morph editor cut].! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'ClementBera 4/16/2013 13:41'!
testEmptyCaseStatement
	self flag: 'Opal has the correct behavior but the error is not caught'

	"self setUpForErrorsIn: '^ nil caseOf: { ` At least one case required ->`} '.
	self enumerateAllSelections."! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'MarcusDenker 4/16/2013 15:27'!
testTooLargeAnIntegerInALiteralByteArray

	self setUpForErrorsIn: '#[ 1 2 ` Expecting 8-bit integer ->`256 4 5]'.
	self enumerateAllSelections! !

!OCCompilerNotifyingTest methodsFor: 'testing-byteCode limits' stamp: 'ClementBera 5/23/2013 15:28'!
testTooManyLiterals
	self setUpForErrorsIn: '{#(1). #(2). #(3). #(4). #(5). #(6). #(7). #(8). #(9). #(10). #(11). #(12). #(13). #(14). #(15). #(16). #(17). #(18). #(19). #(20). #(21). #(22). #(23). #(24). #(25). #(26). #(27). #(28). #(29). #(30). #(31). #(32). #(33). #(34). #(35). #(36). #(37). #(38). #(39). #(40). #(41). #(42). #(43). #(44). #(45). #(46). #(47). #(48). #(49). #(50). #(51). #(52). #(53). #(54). #(55). #(56). #(57). #(58). #(59). #(60). #(61). #(62). #(63). #(64). #(65). #(66). #(67). #(68). #(69). #(70). #(71). #(72). #(73). #(74). #(75). #(76). #(77). #(78). #(79). #(80). #(81). #(82). #(83). #(84). #(85). #(86). #(87). #(88). #(89). #(90). #(91). #(92). #(93). #(94). #(95). #(96). #(97). #(98). #(99). #(100). #(101). #(102). #(103). #(104). #(105). #(106). #(107). #(108). #(109). #(110). #(111). #(112). #(113). #(114). #(115). #(116). #(117). #(118). #(119). #(120). #(121). #(122). #(123). #(124). #(125). #(126). #(127). #(128). #(129). #(130). #(131). #(132). #(133). #(134). #(135). #(136). #(137). #(138). #(139). #(140). #(141). #(142). #(143). #(144). #(145). #(146). #(147). #(148). #(149). #(150). #(151). #(152). #(153). #(154). #(155). #(156). #(157). #(158). #(159). #(160). #(161). #(162). #(163). #(164). #(165). #(166). #(167). #(168). #(169). #(170). #(171). #(172). #(173). #(174). #(175). #(176). #(177). #(178). #(179). #(180). #(181). #(182). #(183). #(184). #(185). #(186). #(187). #(188). #(189). #(190). #(191). #(192). #(193). #(194). #(195). #(196). #(197). #(198). #(199). #(200). #(201). #(202). #(203). #(204). #(205). #(206). #(207). #(208). #(209). #(210). #(211). #(212). #(213). #(214). #(215). #(216). #(217). #(218). #(219). #(220). #(221). #(222). #(223). #(224). #(225). #(226). #(227). #(228). #(229). #(230). #(231). #(232). #(233). #(234). #(235). #(236). #(237). #(238). #(239). #(240). #(241). #(242). #(243). #(244). #(245). #(246). #(247). #(248). #(249). #(250). #(251). #(252). #(253). #(254). #(255). #(256). `More than 256 literals referenced. 
You must split or otherwise simplify this method.
The 257th literal is: ->`#(257)}'.
	self should: [ self enumerateAllSelections ] raise: Error.
	[ self enumerateAllSelections ]
		on: Error 
		do: [ :exc |
			exc class = Error.
			exc messageText = 'too many literals (>256)' ]! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'MarcusDenker 4/16/2013 15:22'!
testMissingArgumentAfterAMessageKey
	self setUpForErrorsIn: '1 to: ` Variable or expression expected ->`:='.
	self enumerateAllSelections! !

!OCCompilerNotifyingTest methodsFor: 'testing-block arguments' stamp: 'MarcusDenker 5/23/2013 10:46'!
testifTrueBlockWithArgument

	self setUpForErrorsIn: '` ifTrue:ifFalse: takes zero-arg blocks ->`true ifTrue: [:x | 1 + 1 ]'.
	self enumerateAllSelections.
	self setUpForErrorsIn: '` ifTrue:ifFalse: takes zero-arg blocks ->`true ifTrue: [:x :y | 1 + 1 ]'.
	self enumerateAllSelections.! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'ClementBera 4/16/2013 14:26'!
testInvalidPattern
	"Not implemented yet.
	#pattern:inContext: skipped, cannot be evaluated"! !

!OCCompilerNotifyingTest methodsFor: 'testing' stamp: 'MarcusDenker 4/25/2013 17:03'!
testUnmatchedCommentQuote

	self setUpForErrorsIn: '1+2   "unfinished comment` Unmatched " in comment. ->`'.
	self enumerateAllSelections! !

!OCCompilerNotifyingTest methodsFor: 'testing-byteCode limits' stamp: 'ClementBera 5/14/2013 14:42'!
testTooManyTemporaries
	self setUpForErrorsIn: '| a1 a2 a3 a4 a5 a6 a7 a8 a9 b1 b2 b3 b4 b5 b6 b7 b8 b9 c1 c2 c3 c4 c5 c6 c7 c8 c9 d1 d2 d3 d4 d5 d6 d7 d8 d9 e1 e2 e3 e4 e5 e6 e7 e8 e9 f1 f2 f3 f4 f5 f6 f7 f8 f9 g1 g2 g3 g4 g5 g6 g7 g8 g9 |
	a1 := a2 := a3 := a4 := a5 := a6 := a7 := a8 := a9 := b1 := b2 := b3 := b4 := b5 := b6 := b7 := b8 := b9 := c1 := c2 := c3 := c4 := c5 := c6 := c7 := c8 := c9 := d1 := d2 := d3 := d4 := d5 := d6 := d7 := d8 := d9 := e1 := e2 := e3 := e4 := e5 := e6 := e7 := e8 := e9 := f1 := f2 := f3 := f4 := f5 := f6 := f7 := f8 := f9 := g1 := g2 := g3 := g4 := g5 := g6 := g7 := g8 := g9 := 1'.
	self flag: 'fail on jenkins but works on my computer with both compiler I dont know why'.
	"self should: [ self enumerateAllSelections ] raise: Error.
	[ self enumerateAllSelections ] on: Error do: [ :ex | self assert: ex messageText equals: 'Cannot compile -- stack including temps is too deep' ]"! !

!OCCompilerSyntaxErrorNotifyingTest commentStamp: 'nice 2/23/2012 22:09'!
A CompilerSyntaxErrorNotifyingTest is a specialization for testing correct handling of non interactive compiler notification.
Non interactive is a very relative notion in Smalltalk...
Here it means that user interaction will not happen directly in the TextEditor holding source code, but rather thru a SyntaxError window that will pop-up.
This test intercept the Notification before the pop-up is raised.
!
!OCCompilerSyntaxErrorNotifyingTest methodsFor: 'private' stamp: 'MarcusDenker 5/23/2013 09:49'!
enumerateAllSelections
	"This method intercepts the SyntaxErrorNotification and prevent the SyntaxError morph to open.
	The notification errorCode hold the source of evaluated sub-selection with inserted error message.
	This can be compared to expected error notification."
	1 to: self numberOfSelections do: [:n |
		| result |
		result := [self evaluateSelectionNumber: n] on: SyntaxErrorNotification do: [:exc |
			| expectedNotification expectedNotificationLocation |
			expectedNotification := (expectedErrors at: n) allButFirst allButLast: 3.
			expectedNotificationLocation := (expectedErrorPositions at: n) - (morph editor startIndex - 1).
			self assert: expectedNotificationLocation equals: exc location.
			self assert: expectedNotification equals: exc errorMessage asString.
			exc return: nil]].! !

!OCCompilerSyntaxErrorNotifyingTest methodsFor: 'private' stamp: 'ClementBera 5/14/2013 13:31'!
evaluateSelection
	^ OpalCompiler new
		source: morph editor selection readStream;
		"Note subtle difference versus  (morph editor selectionAsStream). 
		The later does not answer the same contents and would raise a SyntaxErrorNotification with wrong sub-selection"
		failBlock: [^failure];
		evaluate! !

!OCCompilerSyntaxErrorNotifyingTest class methodsFor: 'testing' stamp: 'nice 2/22/2012 22:54'!
shouldInheritSelectors
	"This class can recycle all of super tests, it just has to refine internal Compiler evaluation machinery"
	^true! !

!OCCompilerTest commentStamp: 'nice 12/3/2007 22:15'!
CompilerTest is a holder for SUnit test of Compiler!
!OCCompilerTest methodsFor: 'test shadowing' stamp: 'MarcusDenker 5/25/2013 15:04'!
testInBlockTempShadowing

	interactive := true.
	self initializeErrorMessage.
	text := 'temp |var2| [:temp| |var2|]'.

	self compileWithFailBlock: [
				self assert: (errorMessage = 'Name already defined ->').
				self assert: (errorLocation = 22).
				self assert: (errorSource contents = 'temp |var2| [:temp| |var2|]').
				^nil].
	self fail.


! !

!OCCompilerTest methodsFor: 'test shadowing' stamp: 'MarcusDenker 9/5/2013 14:46'!
testNotInteractiveInBlockArgumentInstanceVariableShadowing

	interactive := false.
	self initializeErrorMessage.

	OpalCompiler new 
		source: 'temp [:var1 | ]';
		class: MockForCompilation;
		translate.
	
		self assert: ( newTranscript contents = '
MockForCompilation>>temp(var1 is shadowed)').
! !

!OCCompilerTest methodsFor: 'running' stamp: 'EstebanLorenzano 8/3/2012 15:28'!
runCase
	SystemAnnouncer uniqueInstance suspendAllWhile: [ super runCase ]
! !

!OCCompilerTest methodsFor: 'test shadowing' stamp: 'MarcusDenker 9/5/2013 14:54'!
testNotInteractiveSiblingBlocksTempShadowing

	interactive := false.
	self initializeErrorMessage.

	OpalCompiler new
		source: 'temp [:temp | ]. [:temp | ]';
		class: MockForCompilation;
		requestor: self;
		failBlock: [self fail.
						^nil];
		translate.
	self assert: ( newTranscript contents = '').



	
					

! !

!OCCompilerTest methodsFor: 'test shadowing' stamp: 'MarcusDenker 9/5/2013 14:56'!
testSiblingBlocksInstanceVariableShadowing

	interactive := true.
	self initializeErrorMessage.
	
	OpalCompiler new
		source: 'temp [:temp | ].[:temp | |var1|]';
		class: MockForCompilation;
		requestor: self;
		failBlock: [
				self assert: (errorMessage = 'Name already defined ->').
				self assert: (errorLocation = 27).
				^nil];
		translate.
	self fail.


	! !

!OCCompilerTest methodsFor: 'mocking' stamp: 'ClementBera 5/14/2013 13:50'!
text
	^ text! !

!OCCompilerTest methodsFor: 'running' stamp: 'ClementBera 5/14/2013 13:54'!
compile
	^ self compileWithFailBlock: [^ nil]! !

!OCCompilerTest methodsFor: 'test shadowing' stamp: 'MarcusDenker 9/5/2013 14:48'!
testNotInteractiveInBlockTempInstanceVariableShadowing
	
	interactive := false.
	self initializeErrorMessage.

	OpalCompiler new
		source: 'temp [:temp | |var1|]';
		class: MockForCompilation;
		requestor: self;
		failBlock: [self fail.
				^nil];
		translate.

	self assert: ( newTranscript contents = '
MockForCompilation>>temp(var1 is shadowed)').
	! !

!OCCompilerTest methodsFor: 'mocking' stamp: 'JorgeRessia 3/4/2010 12:48'!
initializeErrorMessage
	errorMessage := nil.
	errorLocation := nil.
	errorSource := nil! !

!OCCompilerTest methodsFor: 'test shadowing' stamp: 'MarcusDenker 9/5/2013 14:57'!
testSiblingBlocksTempShadowing

	interactive := true.
	self initializeErrorMessage.

	OpalCompiler new
		source: 'temp [:temp | ]. [:temp | ]';
		class: MockForCompilation;
		failBlock: [self fail.
						^nil];
		translate.
				



	
					

! !

!OCCompilerTest methodsFor: 'test shadowing' stamp: 'MarcusDenker 5/25/2013 15:40'!
testEmptyCharacterFail! !

!OCCompilerTest methodsFor: 'test shadowing' stamp: 'MarcusDenker 9/5/2013 14:49'!
testNotInteractiveInBlockTempShadowing
	
	interactive := false.
	self initializeErrorMessage.

	OpalCompiler new
		source: 'temp |var2| [:temp| |var2|]';
		class: MockForCompilation;
		requestor: self;
		failBlock: [self fail];
		translate.
	
	self assert: newTranscript contents equals:  '
MockForCompilation>>temp(var2 is shadowed)'

! !

!OCCompilerTest methodsFor: 'test shadowing' stamp: 'MarcusDenker 5/25/2013 15:13'!
testNoShadowing
	interactive := true.
	self initializeErrorMessage.
	text := 'temp |var2|  var2:=1'.

	self compileWithFailBlock: [
		self fail.
		^nil ].
	

! !

!OCCompilerTest methodsFor: 'test shadowing' stamp: 'MarcusDenker 5/25/2013 15:01'!
testInBlockArgumentInstanceVariableShadowing
	interactive := true.
	self initializeErrorMessage.
	text := 'temp [:var1 | ]'.
	
	self compile.
	
	self flag: 'display menu instead of going into failblock'.
	
	self assert: (errorMessage = 'Name already defined ->').
				self assert: (errorLocation = 8).
				self assert: (errorSource contents = 'temp [:var1 | ]').
				
! !

!OCCompilerTest methodsFor: 'mocking' stamp: 'JorgeRessia 3/4/2010 12:49'!
notify: aString at: aSmallInteger in: aReadStream 
	errorMessage := aString.
	errorLocation := aSmallInteger.
	errorSource := aReadStream.
	! !

!OCCompilerTest methodsFor: 'test shadowing' stamp: 'MarcusDenker 9/5/2013 14:50'!
testNotInteractiveNoShadowing

	interactive := false.
	self initializeErrorMessage.

	OpalCompiler new
		source: 'temp |var2|';
		class: MockForCompilation;
		requestor: self;
		failBlock: [self fail.
				^nil];
		translate.
			
	self assert: ( newTranscript contents = '').
	


! !

!OCCompilerTest methodsFor: 'literals' stamp: 'MarcusDenker 12/7/2013 23:51'!
testScaledDecimalLiterals
	"Equal ScaledDecimal with different scales should use different slots
	This is related to http://bugs.squeak.org/view.php?id=6797"
	
	"This correctly works when evaluated separately"
	self deny: (Smalltalk evaluate: '0.5s1') scale = (Smalltalk evaluate: '0.5s2') scale.
	
	"But not when evaluated together if literal reduction is too agressive"
	self deny: (Smalltalk evaluate: '0.5s1 scale =  0.5s2 scale').! !

!OCCompilerTest methodsFor: 'test shadowing' stamp: 'MarcusDenker 9/5/2013 14:55'!
testReservedNameAsBlockArgumentShadowing
	
	interactive := true.
	#( 'self' 'super' 'thisContext' 'true' 'false' 'nil' ) do: [ :each |
		self initializeErrorMessage.
		[ :exit | 
			OpalCompiler new 
				source: 'temp ^ [ :' , each , ' | ^ ' , each , ' ]';
				class: MockForCompilation;
				requestor: self;
				failBlock: [ exit value ];
				translate.
			self fail ] valueWithExit.
		self assert: ((errorMessage = 'Variable name expected ->' )or: [ errorMessage =  'Name already defined ->' ]).
		self assert: errorLocation = 11 ]! !

!OCCompilerTest methodsFor: 'running' stamp: 'simon.denier 6/11/2010 14:24'!
tearDown
	Smalltalk globals at: #Transcript put: originalTranscript.
	
	! !

!OCCompilerTest methodsFor: 'test shadowing' stamp: 'MarcusDenker 9/5/2013 14:55'!
testReservedNameAsMethodArgumentShadowing

	interactive := true.
	#( 'self' 'super' 'thisContext' 'true' 'false' 'nil' ) do: [ :each |
		self initializeErrorMessage.
		[ :exit | 
			OpalCompiler new 
				source: 'temp: ' , each , ' ^ ' , each;
				class:  MockForCompilation;
				requestor: self;
				failBlock: [ exit value ];
				translate.
			self fail ] valueWithExit.
		self assert: ((errorMessage = 'Variable name expected ->' )or: [ errorMessage =  'Name already defined ->' ]).
		self assert: errorLocation = 7 ]! !

!OCCompilerTest methodsFor: 'test shadowing' stamp: 'MarcusDenker 9/5/2013 14:58'!
testTraitTempShadowing

	self initializeErrorMessage.

	OpalCompiler new 
	source: 'testReplaceFromToWithStartingAt
	| result  repStart collection replacementCollection firstIndex secondIndex |
		replacementCollection := 1.';
	class: ArrayTest;
	failBlock: [self fail.];
	translate.
	self assert: ( newTranscript contents =  '
ArrayTest>>testReplaceFromToWithStartingAt(replacementCollection is shadowed)
ArrayTest>>testReplaceFromToWithStartingAt(firstIndex is shadowed)
ArrayTest>>testReplaceFromToWithStartingAt(secondIndex is shadowed)').! !

!OCCompilerTest methodsFor: 'running' stamp: 'simon.denier 6/11/2010 14:24'!
setUp
	originalTranscript := Transcript.
	newTranscript := MockTranscript new.
	Smalltalk globals at: #Transcript put: newTranscript.
	
	! !

!OCCompilerTest methodsFor: 'test shadowing' stamp: 'MarcusDenker 5/25/2013 15:03'!
testInBlockTempInstanceVariableShadowing
	interactive := true.
	self initializeErrorMessage.
	text := 'temp [:temp | |var1|]'.

	self compileWithFailBlock: [
				self assert: (errorMessage = 'Name already defined ->').
				self assert: (errorLocation = 16).
				self assert: (errorSource contents = 'temp [:temp | |var1|]').
				^nil].
	self fail.! !

!OCCompilerTest methodsFor: 'test shadowing' stamp: 'MarcusDenker 9/5/2013 14:51'!
testNotInteractiveShadowingOfTemp

	interactive := false.
	self initializeErrorMessage.

	OpalCompiler new 
		source: 'temp |temp1 temp1| ';
		class: MockForCompilation;
		requestor: self;
		translate.
			
	self assert: ( newTranscript contents =  '
MockForCompilation>>temp(temp1 is shadowed)').
	! !

!OCCompilerTest methodsFor: 'mocking' stamp: 'JorgeRessia 3/4/2010 12:49'!
interactive
	^interactive! !

!OCCompilerTest methodsFor: 'test shadowing' stamp: 'MarcusDenker 5/25/2013 15:03'!
testInBlockTempArgumentShadowing
	interactive := true.
	self initializeErrorMessage.
	text := 'temp [:temp | |temp|]'.

	self compileWithFailBlock: [
				self assert: (errorMessage = 'Name already defined ->').
				self assert: (errorLocation = 16).
				self assert: (errorSource contents = 'temp [:temp | |temp|]').
						^nil].
	self fail.
! !

!OCCompilerTest methodsFor: 'test shadowing' stamp: 'MarcusDenker 9/5/2013 14:47'!
testNotInteractiveInBlockTempArgumentShadowing
	
	interactive := false.
	self initializeErrorMessage.

	OpalCompiler new
		source: 'temp [:temp | |temp|]';
		class: MockForCompilation;
		requestor: self;
		translate.
	self assert: newTranscript contents equals:   '
MockForCompilation>>temp(temp is shadowed)'
! !

!OCCompilerTest methodsFor: 'literals' stamp: 'ClementBera 5/14/2013 14:03'!
testNegativeZero
	self assert: (OpalCompiler evaluate: '-0.0') hex = Float negativeZero hex.! !

!OCCompilerTest methodsFor: 'test shadowing' stamp: 'MarcusDenker 5/25/2013 15:05'!
testInstanceVariableShadowing

	interactive := true.
	self initializeErrorMessage.
	text := 'var1 |var1|'.

	self compileWithFailBlock: [
					self assert: (errorMessage = 'Name already defined ->').
					self assert: (errorLocation = 7).
					self assert: (errorSource contents = 'var1 |var1|').
					^nil].
	self fail.

! !

!OCCompilerTest methodsFor: 'test shadowing' stamp: 'MarcusDenker 9/5/2013 14:51'!
testNotInteractiveSiblingBlocksInstanceVariableShadowing

	interactive := false.
	self initializeErrorMessage.
	
	OpalCompiler new
		source: 'temp [:temp | ].[:temp | |var1|]';
		class:  MockForCompilation;
		requestor: self;
		failBlock: [self fail.
				^nil];
		translate.
	
	self assert: ( newTranscript contents = '
MockForCompilation>>temp(var1 is shadowed)').


	! !

!OCCompilerTest methodsFor: 'running' stamp: 'MarcusDenker 5/25/2013 14:53'!
compileWithFailBlock: aBlock
	^ OpalCompiler new 
		source: text;
		class: MockForCompilation;
		requestor: self;
		failBlock: aBlock;
		translate.
! !

!OCContextTempMappingTest commentStamp: 'GuillermoPolito 4/10/2015 10:50'!
This testcase tests that we can correctly get the value of the temp vars from a context. That is,

 - it finds the correct context where the variable is defined to get the value
 - it handles well copying and temp vectors

Probably tests are missing covering all possible combinations of 
  - temps
  - copying temps
  - temp vectors
  - nested blocks
  - blocks from dead contexts
  - optimized blocks

However this class is a starting point for this.!
!OCContextTempMappingTest methodsFor: 'tests' stamp: 'GuillermoPolito 4/9/2015 15:19'!
testAccessingVariablesInOptimizedBlock2

	| a b |

	a:=1.
	b:=2.
	
	a < b ifTrue:[ |c|
		c:=50.
		self assert: (thisContext tempNamed: 'a') == 1.
		self assert: (thisContext tempNamed: 'b') == 2.
		self assert: (thisContext tempNamed: 'c') == 50.
	].! !

!OCContextTempMappingTest methodsFor: 'tests' stamp: 'GuillermoPolito 4/9/2015 14:46'!
testAccessingTempsVectorInBlock

	[ | temp |
		[ temp := 1.
		self assert: ((thisContext tempNamed: 'temp') == 1) ] value.
	] value! !

!OCContextTempMappingTest methodsFor: 'tests' stamp: 'GuillermoPolito 4/9/2015 13:26'!
testAccessingMultipleVariablesInVector
	| t1 t2 t3 t4 t5 t6 |
	t1 := 1.
	t2 := 2.
	t3 := 3.
	t4 := 4. 
	t5 := 5 .
	t6 := 6.
	[t5 := 50.
	    t6 := 60.
	    t3 + t4.
	] value.
	
	self assert: t1 == (thisContext tempNamed: 't1').
	self assert: t2 == (thisContext tempNamed: 't2').
	self assert: t3 == (thisContext tempNamed: 't3').
	self assert: t4 == (thisContext tempNamed: 't4').
	self assert: t5 == (thisContext tempNamed: 't5').
	self assert: t6 == (thisContext tempNamed: 't6').! !

!OCContextTempMappingTest methodsFor: 'tests' stamp: 'GuillermoPolito 4/9/2015 14:05'!
testAccessingVariablesInOptimizedBlock
	
	1 to: 2 do: [ :index | |optimizedTemp|
		optimizedTemp := index.
		self assert: (thisContext tempNamed: 'optimizedTemp') == index
	]! !

!OCContextTempMappingTest methodsFor: 'tests' stamp: 'GuillermoPolito 4/10/2015 11:03'!
testAccessingTempsVectorInBlock3

	|a b r |
	a := [ r := 'failure'].
	[ b :='success'.
	self assert: (thisContext tempNamed: 'a') equals: a. 
	] on: Error do: a.
	self assert: (thisContext tempNamed: 'r') equals: nil.
	self assert: (thisContext tempNamed: 'b') equals: 'success'.! !

!OCContextTempMappingTest methodsFor: 'tests' stamp: 'GuillermoPolito 4/9/2015 15:03'!
testAccessingVariablesInBlock
	| theContext |
	[ | t1 |
		t1 := true.
		theContext := thisContext.
		self assert: (thisContext tempNamed: 'theContext') == thisContext.
		self assert: (theContext tempNamed: 't1').
	] value
	! !

!OCContextTempMappingTest methodsFor: 'tests' stamp: 'GuillermoPolito 4/9/2015 21:04'!
testAccessingTempsVectorInBlock2

	|a b r |
	a := [ r := 'failure'].
	[ b :='success'.
	r := thisContext ] on: Error do: a.

	self assert: r == (r tempNamed: 'r').
	self assert: (r tempNamed: 'a') == a.
	self assert: (r tempNamed: 'b') == b.! !

!OCCopyingTempVariable commentStamp: 'MarcusDenker 8/11/2014 10:20'!
A copying temp is a temp that is copied into a block that later reads this variable.

Not: the temp vector is passed as a copying temp, too.!
!OCCopyingTempVariable methodsFor: 'accessing' stamp: 'ClementBera 5/21/2013 14:47'!
originalVar: anObject
	originalVar := anObject! !

!OCCopyingTempVariable methodsFor: 'accessing' stamp: 'ClementBera 5/21/2013 14:47'!
originalVar
	^ originalVar! !

!OCCopyingTempVariable methodsFor: 'temp vector' stamp: 'MarcusDenker 11/15/2012 17:09'!
tempVectorForTempStoringIt
	"If I am stroring a temp Vector, this method returns this victor.
	useful for analysis e.g. which variables are active in a context"
	
	| searchScope |
	self isStoringTempVector ifFalse: [^nil].
	searchScope := scope.
	
	[searchScope isInstanceScope or: [searchScope tempVectorName = name]] 
		whileFalse: [searchScope := searchScope outerScope].
	searchScope isInstanceScope 
		ifTrue: [ ^nil] "not found"
		ifFalse: [^ searchScope tempVector]
	! !

!OCCopyingTempVariable methodsFor: 'debugging' stamp: 'GuillermoPolito 4/9/2015 13:19'!
indexInTempVectorFromIR: aName
	^(scope methodScope node irInstruction tempVectorNamed: name) indexForVarNamed: aName.! !

!OCCopyingTempVariable methodsFor: 'testing' stamp: 'MarcusDenker 9/9/2010 16:06'!
isCopying
	^true! !

!OCCopyingTempVariable methodsFor: 'debugging' stamp: 'MarcusDenker 12/18/2012 15:08'!
writeFromContext: aContext scope: contextScope value: aValue
	| myContext myScope |
	"take care to set the copy correctly up to the definition"
	
	myContext := aContext. myScope := contextScope.
	[myScope hasCopyingTempNamed: name] whileTrue:  [ 
		super writeFromContext: myContext scope: myScope value: aValue.
		myContext := myContext outerContext.
		myScope := myScope outerScope.
		myScope isInstanceScope ifTrue: [^aValue]
		].
	^aValue.
	
	! !

!OCCopyingTempVariable methodsFor: 'temp vector' stamp: 'GuillermoPolito 4/9/2015 16:01'!
indexFromIR

	^ scope node irInstruction indexForVarNamed: name! !

!OCDecompiler commentStamp: 'ClementBera 7/10/2014 11:09'!
I decompile a method in three phases:
	Reverser: postfix byte codes -> prefix symbolic codes (nodes and atoms)
	Parser: prefix symbolic codes -> node tree (same as the compiler)
	Printer: node tree -> text (done by the nodes)
	

instance vars:

	constructor <DecompilerConstructor> an auxiliary knowing how to generate Abstract Syntax Tree (node tree)
	method <CompiledMethod> the method being decompiled
	instVars <Array of: String> the instance variables of the class implementing method
	tempVars <String | (OrderedCollection of: String)> hold the names of temporary variables (if known)
		NOTE: POLYMORPHISM WILL BE RESOLVED IN #initSymbols:
	constTable <Collection of: ParseNode> parse node associated with byte encoded constants (nil true false 0 1 -1 etc...)
	stack <OrderedCollection of: (ParseNode | String | Integer) > multipurpose...
	statements <OrderedCollection of: ParseNode> the statements of the method being decompiled 
	lastPc <Integer>
	exit <Integer>
	caseExits <OrderedCollection of: Integer> - stack of exit addresses that have been seen in the branches of caseOf:'s
	lastJumpPc <Integer>
	lastReturnPc <Integer>
	limit <Integer>
	hasValue <Boolean>
	blockStackBase <Integer>
	numLocaltemps <Integer | Symbol> - number of temps local to a block; also a flag indicating decompiling a block
	blockStartsToTempVars <Dictionary key: Integer value: (OrderedCollection of: String)>
	tempVarCount <Integer> number of temp vars used by the method
	lastJumpIfPcStack <OrderedCollection of: Integer> the value of program counter just before the last encountered conditional jumps!
!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 7/10/2014 11:09'!
pushConstant: value

	| node |
	node := value == true ifTrue: [constTable at: 2]
		ifFalse: [value == false ifTrue: [constTable at: 3]
		ifFalse: [value == nil ifTrue: [constTable at: 4]
		ifFalse: [constructor codeAnyLiteral: value]]].
	stack addLast: node! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 7/10/2014 11:09'!
send: selector super: superFlag numArgs: numArgs

	| args rcvr selNode msgNode messages |
	args := Array new: numArgs.
	(numArgs to: 1 by: -1) do:
		[:i | args at: i put: stack removeLast].
	rcvr := stack removeLast.
	superFlag ifTrue: [rcvr := constructor codeSuper].
	((#(closureCopy:copiedValues:) includes: selector)
	  and: [self checkForBlock: rcvr selector: selector arguments: args]) ifFalse:
		[selNode := constructor codeAnySelector: selector.
		rcvr == CascadeFlag
			ifTrue:
				["May actually be a cascade or an ifNil: for value."
				self willJumpIfFalse
					ifTrue: "= generated by a case macro"
						[selector == #= ifTrue:
							[" = signals a case statement..."
							statements addLast: args first.
							stack addLast: rcvr. "restore CascadeFlag"
							^ self].
						selector == #== ifTrue:
							[" == signals an ifNil: for value..."
							stack removeLast; removeLast.
							rcvr := stack removeLast.
							stack addLast: IfNilFlag;
								addLast: (constructor
									codeMessage: rcvr
									selector: selNode
									arguments: args).
							^ self]]
					ifFalse:
						[(self willJumpIfTrue and: [selector == #==]) ifTrue:
							[" == signals an ifNotNil: for value..."
							stack removeLast; removeLast.
							rcvr := stack removeLast.
							stack addLast: IfNilFlag;
								addLast: (constructor
									codeMessage: rcvr
									selector: selNode
									arguments: args).
							^ self]].
				msgNode := constructor
								codeCascadedMessage: selNode
								arguments: args.
				stack last == CascadeFlag ifFalse:
					["Last message of a cascade"
					statements addLast: msgNode.
					messages := self popTo: stack removeLast.  "Depth saved by first dup"
					msgNode := constructor
									codeCascade: stack removeLast
									messages: messages]]
			ifFalse:
				[msgNode := constructor
							codeMessage: rcvr
							selector: selNode
							arguments: args].
		stack addLast: msgNode]! !

!OCDecompiler methodsFor: 'private' stamp: 'ClementBera 7/10/2014 11:09'!
decompile: aSelector in: aClass method: aMethod

	^self
		decompile: aSelector
		in: aClass
		method: aMethod
		using: (self constructorForMethod: aMethod)! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 7/10/2014 16:37'!
jump: dist if: condition

	| savePc sign elsePc elseStart end cond ifExpr thenBlock elseBlock
	  thenJump elseJump condHasValue isIfNil saveStack blockBody |
	lastJumpIfPcStack addLast: lastPc.
	stack last == CascadeFlag ifTrue: [^ [self case: dist] ensure: [lastJumpIfPcStack removeLast]].
	elsePc := lastPc.
	elseStart := pc + dist.
	end := limit.
	"Check for bfp-jmp to invert condition.
	Don't be fooled by a loop with a null body."
	sign := condition.
	savePc := pc.
	self interpretJump ifNotNil:
		[ :elseDist |
		 (elseDist >= 0 and: [elseStart = pc]) ifTrue:
			 [sign := sign not.  elseStart := pc + elseDist]].
	pc := savePc.
	ifExpr := stack removeLast.
	(isIfNil := stack size > 0 and: [stack last == IfNilFlag]) ifTrue:
		[stack removeLast].
	saveStack := stack.
	stack := OrderedCollection new.
	thenBlock := self blockTo: elseStart.
	condHasValue := hasValue or: [isIfNil].
	"ensure jump is within block (in case thenExpr returns)"
	thenJump := exit <= end ifTrue: [exit] ifFalse: [elseStart].
	"if jump goes back, then it's a loop"
	thenJump < elseStart
		ifTrue:
			["Must be a while loop...
			  thenJump will jump to the beginning of the while expr.  In the case of while's
			  with a block in the condition, the while expr should include more than just
			  the last expression: find all the statements needed by re-decompiling."
			stack := saveStack.
			pc := thenJump.
			blockBody := self statementsTo: elsePc.
			"discard unwanted statements from block"
			blockBody size - 1 timesRepeat: [statements removeLast].
			statements addLast:
				(constructor
					codeMessage: (constructor codeBlock: blockBody returns: false)
					selector: (constructor
								codeSelector: (sign
												ifTrue: [#whileFalse:]
												ifFalse: [#whileTrue:])
								code: #macro)
					arguments: { thenBlock }).
			pc := elseStart.
			self convertToDoLoop]
		ifFalse:
			["Must be a conditional..."
			elseBlock := self blockTo: thenJump.
			elseJump := exit.
			"if elseJump is backwards, it is not part of the elseExpr"
			elseJump < elsePc ifTrue:
				[pc := lastPc].
			cond := isIfNil
						ifTrue:
							[constructor
								codeMessage: ifExpr ifNilReceiver
								selector: (constructor
											codeSelector: (sign ifTrue: [#ifNotNil:] ifFalse: [#ifNil:])
											code: #macro)
								arguments: (Array with: thenBlock)]
						ifFalse:
							[constructor
								codeMessage: ifExpr
								selector: (constructor codeSelector: #ifTrue:ifFalse: code: #macro)
								arguments:	(sign
												ifTrue: [{elseBlock. thenBlock}]
												ifFalse: [{thenBlock. elseBlock}])].
			stack := saveStack.
			condHasValue
				ifTrue: [stack addLast: cond]
				ifFalse: [statements addLast: cond]].
	lastJumpIfPcStack removeLast.! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 7/17/2014 10:01'!
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
	| copiedValues |
	copiedValues := ((1 to: numCopied) collect: [:ign| stack removeLast]) reversed.
	self doClosureCopyCopiedValues: copiedValues numArgs: numArgs blockSize: blockSize! !

!OCDecompiler methodsFor: 'private' stamp: 'ClementBera 8/1/2014 10:03'!
quickMethod
	method isReturnSpecial
		ifTrue: [^ constructor codeBlock:
				(Array with: (constTable at: method primitive - 255)) returns: true].
	method isReturnField
		ifTrue: [^ constructor codeBlock:
				(Array with: (constructor codeInst: method returnField)) returns: true].
	self error: 'improper short method'! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 7/10/2014 11:09'!
storeIntoLiteralVariable: assoc

	self pushLiteralVariable: assoc; doStore: stack! !

!OCDecompiler methodsFor: 'initialize-release' stamp: 'ClementBera 7/10/2014 11:09'!
mapFromBlockStartsIn: aMethod toTempVarsFrom: schematicTempNamesString constructor: aDecompilerConstructor
	| map |
	map := aMethod debuggerMap
				mapFromBlockKeys: (aMethod debuggerMap startpcsToBlockExtents: aMethod) keys asArray sort
				toSchematicTemps: schematicTempNamesString
				method: aMethod.
	map keysAndValuesDo:
		[:startpc :tempNameTupleVector|
		tempNameTupleVector isEmpty ifFalse:
			[| subMap numTemps tempVector |
			subMap := Dictionary new.
			"Find how many temp slots there are (direct & indirect temp vectors)
			 and for each indirect temp vector find how big it is."
			tempNameTupleVector do:
				[:tuple|
				tuple last isArray
					ifTrue:
						[subMap at: tuple last first put: tuple last last.
						 numTemps := tuple last first]
					ifFalse:
						[numTemps := tuple last]].
			"create the temp vector for this scope level."
			tempVector := Array new: numTemps.
			"fill it in with any indirect temp vectors"
			subMap keysAndValuesDo:
				[:index :size|
				tempVector at: index put: (Array new: size)].
			"fill it in with temp nodes."
			tempNameTupleVector do:
				[:tuple| | itv |
				tuple last isArray
					ifTrue:
						[itv := tempVector at: tuple last first.
						 itv at: tuple last last
							put: (aDecompilerConstructor
									codeTemp: tuple last last - 1
									named: tuple first)]
					ifFalse:
						[tempVector
							at: tuple last
							put: (aDecompilerConstructor
									codeTemp: tuple last - 1
									named: tuple first)]].
			"replace any indirect temp vectors with proper RemoteTempVectorNodes"
			subMap keysAndValuesDo:
				[:index :size|
				tempVector
					at: index
					put: (aDecompilerConstructor
							codeRemoteTemp: index
							remoteTemps: (tempVector at: index))].
			"and update the entry in the map"
			map at: startpc put: tempVector]].
	^map! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 7/17/2014 10:01'!
pushNewArrayOfSize: size
	stack addLast: #pushNewArray -> (Array new: size)! !

!OCDecompiler methodsFor: 'private' stamp: 'cb 7/29/2014 18:39'!
convertToDoLoop
	"If statements contains the pattern
		var := startExpr.
		[var <= limit] whileTrue: [...statements... var := var + incConst]
	then replace this by
		startExpr to: limit by: incConst do: [:var | ...statements...]"
	| leaveOnStack initStmt toDoStmt limitStmt |
	leaveOnStack := false.
	(stack notEmpty
	 and: [stack last isAssignment])
		ifTrue:
			[initStmt := stack last.
			 (toDoStmt := statements last toDoFromWhileWithInit: initStmt) ifNil:
				[^self].
			 stack removeLast.
			 statements removeLast; addLast: toDoStmt.
			 leaveOnStack := true]
		ifFalse: [ 
			statements size < 2 ifTrue: [^ self].
			initStmt := statements at: statements size-1. 
			(toDoStmt := statements last toDoFromWhileWithInit: initStmt)
				ifNil: [^ self].
			statements removeLast; removeLast; addLast: toDoStmt ].
	"Attempt further conversion of the pattern
		limitVar := limitExpr.
		startExpr to: limitVar by: incConst do: [:var | ...statements...]
	to
		startExpr to: limitExpr by: incConst do: [:var | ...statements...]"
	statements size < 2 ifTrue: [
		leaveOnStack ifTrue: [ stack addLast: statements removeLast ].
			 ^ self ] .
	limitStmt := statements last.
	((limitStmt isMemberOf: AssignmentNode)
		and: [limitStmt variable isTemp
		and: [limitStmt variable == toDoStmt arguments first ]]) ifFalse:
			[limitStmt := statements at: statements size-1.
			((limitStmt isMemberOf: AssignmentNode)
				and: [limitStmt variable isTemp
				and: [limitStmt variable == toDoStmt arguments first]]) ifFalse:
					[leaveOnStack ifTrue:
						[stack addLast: statements removeLast].
					^self]].
	(self blockScopeRefersOnlyOnceToTemp: limitStmt variable fieldOffset)
		ifFalse: [^ self].
	toDoStmt arguments at: 1 put: limitStmt value.
	tempVars := tempVars asOrderedCollection.
	statements removeLast; removeLast; addLast: toDoStmt.

! !

!OCDecompiler methodsFor: 'private' stamp: 'ClementBera 7/10/2014 11:09'!
blockScopeRefersOnlyOnceToTemp: offset
	| nRefs byteCode extension scanner scan |
	scanner := InstructionStream on: method.
	nRefs := 0.
	scan := offset <= 15
				ifTrue:
					[byteCode := 16 + offset.
					 [:instr |
					  instr = byteCode ifTrue:
						[nRefs := nRefs + 1].
					  nRefs > 1]]
				ifFalse:
					[extension := 64 + offset.
					 [:instr |
					  (instr = 128 and: [scanner followingByte = extension]) ifTrue:
						[nRefs := nRefs + 1].
					   nRefs > 1]].
	self scanBlockScopeFor: pc from: method initialPC to: method endPC with: scan scanner: scanner.
	^nRefs = 1! !

!OCDecompiler methodsFor: 'control' stamp: 'ClementBera 7/17/2014 10:10'!
statementsTo: end
	^ self statementsTo: end case: false! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 7/10/2014 11:09'!
methodReturnTop
	| last |
	last := stack removeLast "test test" asReturnNode.
	stack size > blockStackBase  "get effect of elided pop before return"
		ifTrue: [statements addLast: stack removeLast].
	exit := pc.
	lastJumpPc := lastReturnPc := lastPc.
	statements addLast: last! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 7/10/2014 11:09'!
popIntoReceiverVariable: offset

	self pushReceiverVariable: offset; doStore: statements! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 7/17/2014 10:01'!
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
	self pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex; doStore: statements! !

!OCDecompiler methodsFor: 'initialize-release' stamp: 'ClementBera 7/17/2014 13:51'!
initSymbols: aClass
	constructor method: method class: aClass literals: method literals.
	constTable := constructor codeConstants.
	instVars := Array new: aClass instSize.
	tempVarCount := method numTemps.
	"(tempVars isNil
	 and: [method holdsTempNames]) ifTrue:
		[tempVars := method tempNamesString]."
	tempVars isString
		ifTrue:
			[blockStartsToTempVars := self mapFromBlockStartsIn: method
											toTempVarsFrom: tempVars
											constructor: constructor.
			 tempVars := blockStartsToTempVars at: method initialPC]
		ifFalse:
			[| namedTemps |
			namedTemps := tempVars ifNil: [(1 to: tempVarCount) collect: [:i| 't', i printString]].
			tempVars := (1 to: tempVarCount) collect:
							[:i | i <= namedTemps size
								ifTrue: [constructor codeTemp: i - 1 named: (namedTemps at: i)]
								ifFalse: [constructor codeTemp: i - 1]]].! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 7/10/2014 11:09'!
pushActiveContext

	stack addLast: constructor codeThisContext! !

!OCDecompiler methodsFor: 'private' stamp: 'ClementBera 7/10/2014 14:18'!
decompile: aSelector in: aClass method: aMethod using: aConstructor

	| block node |
	constructor := aConstructor.
	method := aMethod.
	self initSymbols: aClass.  "create symbol tables"
	method isQuick
		ifTrue: [block := self quickMethod]
		ifFalse: 
			[stack := OrderedCollection new: method frameSize.
			lastJumpIfPcStack := OrderedCollection new.
			caseExits := OrderedCollection new.
			statements := OrderedCollection new: 20.
			numLocalTemps := 0.
			super method: method pc: method initialPC.
			"skip primitive error code store if necessary"
			(method isPrimitive and: [self willStore]) ifTrue:
				[pc := pc + 2.
				 tempVars := tempVars asOrderedCollection].
			block := self blockTo: method endPC + 1.
			stack isEmpty ifFalse: [self error: 'stack not empty']].
	node := constructor
				codeMethod: aSelector
				block: block
				tempVars: tempVars
				primitive: method primitive
				class: aClass.
	method isPrimitive ifTrue:
		[node removeAndRenameLastTempIfErrorCode].
	^node! !

!OCDecompiler methodsFor: 'private' stamp: 'ClementBera 7/10/2014 11:10'!
constructorForMethod: aMethod
	^ OCDecompilerConstructor new! !

!OCDecompiler methodsFor: 'control' stamp: 'ClementBera 7/17/2014 11:29'!
statementsTo: end case: isCaseOf
	"Decompile the method from pc up to end and return an array of
	expressions. If at run time this block will leave a value on the stack,
	set hasValue to true. If the block ends with a jump or return, set exit
	to the destination of the jump, or the end of the method; otherwise, set
	exit = end. Leave pc = end.
	
	Note that stack may initially contains a CaseFlag which will be removed by
	a subsequent Pop instruction, so adjust the StackPos accordingly."

	| blockPos stackPos  |
	blockPos := statements size.
	stackPos := stack size - isCaseOf asBit. "Adjust for CaseFlag"
	[ pc < end ] whileTrue: [
			lastPc := pc.  limit := end.  "for performs"
			self interpretNextInstructionFor: self ].
	"If there is an additional item on the stack, it will be the value
	of this block."
	(hasValue := stack size > stackPos) ifTrue:
			[stack last == CaseFlag ifFalse: [ statements addLast: stack removeLast ] ].
	lastJumpPc = lastPc ifFalse: [exit := pc].
	isCaseOf ifTrue: [ caseExits add: exit ].
	^self popTo: blockPos! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 7/10/2014 11:09'!
pushReceiverVariable: offset

	| var |
	(var := instVars at: offset + 1 ifAbsent: []) == nil
		ifTrue:
			["Not set up yet"
			var := constructor codeInst: offset.
			instVars size < (offset + 1) ifTrue: [
				instVars := (Array new: offset + 1)
					replaceFrom: 1 to: instVars size with: instVars; yourself ].
			instVars at: offset + 1 put: var].
	stack addLast: var! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 7/17/2014 10:01'!
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
	stack addLast: ((tempVars at: tempVectorIndex + 1) remoteTemps at: remoteTempIndex + 1)! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 7/10/2014 11:09'!
storeIntoTemporaryVariable: offset

	self pushTemporaryVariable: offset; doStore: stack! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 7/10/2014 11:09'!
storeIntoReceiverVariable: offset

	self pushReceiverVariable: offset; doStore: stack! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 7/10/2014 11:09'!
methodReturnReceiver

	self pushReceiver; methodReturnTop! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'cb 7/29/2014 18:36'!
popIntoTemporaryVariable: offset
	| maybeTVTag tempVector start |
	maybeTVTag := stack last.
	((maybeTVTag isMemberOf: Association)
	 and: [maybeTVTag key == #pushNewArray]) ifTrue:
		[blockStartsToTempVars notNil "implies we were intialized with temp names."
			ifTrue: "Use the provided temps"
				[[(tempVector := tempVars at: offset + 1 ifAbsent: [RBProgramNode basicNew]) isTemp
							 and: [tempVector isIndirectTempVector
							 and: [tempVector remoteTemps size = maybeTVTag value size]]] assert]
			ifFalse: "Synthesize some remote temps"
				[tempVector := maybeTVTag value.
				 offset + 1 <= tempVars size
					ifTrue:
						[start := 2.
						 tempVector at: 1 put: (tempVars at: offset + 1)]
					ifFalse:
						[tempVars := (Array new: offset + 1)
										replaceFrom: 1
										to: tempVars size
										with: tempVars.
						start := 1].
				 start to: tempVector size do:
					[:i|
					tempVector
						at: i
						put: (constructor
								codeTemp: numLocalTemps + offset + i - 1
								named: 't', (tempVarCount + i) printString)].
				tempVars at: offset + 1 put: (constructor codeRemoteTemp: offset + 1 remoteTemps: tempVector)].
		 tempVarCount := tempVarCount + maybeTVTag value size.
		 stack removeLast.
		 ^self].
	self pushTemporaryVariable: offset; doStore: statements! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 7/10/2014 11:09'!
pushReceiver

	stack addLast: (constTable at: 1)! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 7/10/2014 11:09'!
blockReturnTop
	"No action needed"! !

!OCDecompiler methodsFor: 'public access' stamp: 'ClementBera 7/10/2014 11:09'!
tempAt: offset
	"Needed by BraceConstructor<PopIntoTemporaryVariable"

	^tempVars at: offset + 1! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 7/10/2014 11:09'!
doStore: stackOrBlock
	"Only called internally, not from InstructionStream. StackOrBlock is stack
	for store, statements for storePop."

	| var expr |
	var := stack removeLast.
	expr := stack removeLast.
	stackOrBlock addLast: (expr == ArgumentFlag
		ifTrue: [var]
		ifFalse: [constructor codeAssignTo: var value: expr])! !

!OCDecompiler methodsFor: 'public access' stamp: 'ClementBera 7/10/2014 11:09'!
decompileMethod: aMethod

	^self
		decompile: aMethod selector
		in: aMethod methodClass
		method: aMethod! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 7/10/2014 11:09'!
popIntoLiteralVariable: value

	self pushLiteralVariable: value; doStore: statements! !

!OCDecompiler methodsFor: 'control' stamp: 'ClementBera 7/17/2014 10:09'!
blockForCaseTo: end
	^ self blockTo: end case: true! !

!OCDecompiler methodsFor: 'control' stamp: 'ClementBera 12/29/2014 12:00'!
doClosureCopyCopiedValues: blockCopiedValues numArgs: numArgs blockSize: blockSize
	| startpc savedTemps savedTempVarCount savedNumLocalTemps
	  jump blockArgs blockTemps blockTempsOffset block |
	savedTemps := tempVars.
	savedTempVarCount := tempVarCount.
	savedNumLocalTemps := numLocalTemps.
	jump := blockSize + (startpc := pc).
	numLocalTemps := method encoderClass numLocalTempsForBlockAt: startpc in: method.
	blockTempsOffset := numArgs + blockCopiedValues size.
	(blockStartsToTempVars notNil "implies we were intialized with temp names."
	 and: [blockStartsToTempVars includesKey: pc])
		ifTrue:
			[tempVars := blockStartsToTempVars at: pc]
		ifFalse:
			[blockArgs := (1 to: numArgs) collect:
							[:i| (constructor
									codeTemp: i - 1
									named: 't', (tempVarCount + i) printString) ].
			blockTemps := (1 to: numLocalTemps) collect:
							[:i| constructor
									codeTemp: i + blockTempsOffset - 1
									named: 't', (tempVarCount + i + numArgs) printString].
			tempVars := blockArgs, blockCopiedValues, blockTemps].
	numLocalTemps timesRepeat:
		[self interpretNextInstructionFor: self.
		 stack removeLast].
	tempVarCount := tempVarCount + numArgs + numLocalTemps.
	block := self blockTo: jump.
	stack addLast: (constructor
						codeArguments: (tempVars copyFrom: 1 to: numArgs)
						temps: (tempVars copyFrom: blockTempsOffset + 1 to: blockTempsOffset + numLocalTemps)
						block: block).
	tempVars := savedTemps.
	tempVarCount := savedTempVarCount.
	numLocalTemps := savedNumLocalTemps! !

!OCDecompiler methodsFor: 'control' stamp: 'ClementBera 7/17/2014 10:09'!
blockTo: end
	^ self blockTo: end case: false! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 7/10/2014 11:09'!
doPop

	stack isEmpty ifTrue:
		["Ignore pop in first leg of ifNil for value"
		^ self].
	stack last == CaseFlag
		ifTrue: [stack removeLast]
		ifFalse: [statements addLast: stack removeLast].! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 7/10/2014 11:09'!
pushTemporaryVariable: offset

	stack addLast: (tempVars at: offset + 1)! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 12/28/2014 17:31'!
blockReturnConstant: value 
	self pushConstant: value;
		 blockReturnTop
! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 7/17/2014 10:01'!
pushConsArrayWithElements: numElements 
	| array |
	array := Array new: numElements.
	numElements to: 1 by: -1 do:
		[:i|
		array at: i put: stack removeLast].
	stack addLast: (constructor codeBrace: array)! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 7/10/2014 11:09'!
jump: dist
	| blockBody destPc nextPC |
	destPc := pc + dist.
	(lastJumpIfPcStack isEmpty or: [dist < 0 and: [destPc > lastJumpIfPcStack last]])
		ifTrue:
			["Rule: aBackward jump not crossing a Bfp/Btp must be a repeat"
			nextPC := pc.
			pc := destPc.
			blockBody := self statementsTo: lastPc.
			blockBody size timesRepeat: [statements removeLast].
			pc := nextPC.
			statements addLast:
				(constructor
					codeMessage: (constructor codeBlock: blockBody returns: false)
					selector: (constructor
								codeSelector: #repeat
								code: #macro)
					arguments: #()).
			]
		ifFalse:
			[exit := destPc.
			lastJumpPc := lastPc]! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 7/10/2014 11:09'!
methodReturnConstant: value

	self pushConstant: value; methodReturnTop! !

!OCDecompiler methodsFor: 'control' stamp: 'ClementBera 7/17/2014 10:12'!
checkForClosureCopy: receiver arguments: arguments
	"We just saw a closureCopy:copiedValues: message. Check for and construct a following block."

	| savePc jump |
	receiver == constructor codeThisContext ifFalse: [ ^ false ].
	savePc := pc.
	(jump := self interpretJump) ifNil: [pc := savePc. ^ nil ].
	"Definitely a block"
	self doClosureCopyCopiedValues: arguments last "<BraceNode>" elements
		numArgs: arguments first key
		blockSize: jump.
	^ true! !

!OCDecompiler methodsFor: 'private' stamp: 'ClementBera 7/10/2014 11:09'!
popTo: oldPos

	| t |
	t := Array new: statements size - oldPos.
	(t size to: 1 by: -1) do:
		[:i | t at: i put: statements removeLast].
	^t! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 7/17/2014 10:01'!
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
	self pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex; doStore: stack! !

!OCDecompiler methodsFor: 'control' stamp: 'ClementBera 7/17/2014 10:08'!
blockTo: end case: isCaseOf
	"Decompile a range of code as in statementsForCaseTo:, but return a block node."
	| exprs block oldBase |
	oldBase := blockStackBase.
	blockStackBase := stack size.
	exprs := self statementsTo: end case: isCaseOf.
	block := constructor codeBlock: exprs returns: lastReturnPc = lastPc.
	blockStackBase := oldBase.
	lastReturnPc := -1.  "So as not to mislead outer calls"
	^block! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 7/10/2014 11:09'!
case: dist
	"statements = keyStmts CascadeFlag keyValueBlock ... keyStmts"

	| nextCase thenJump stmtStream elements b node cases otherBlock myExits |
	nextCase := pc + dist.

	"Now add CascadeFlag & keyValueBlock to statements"
	statements addLast: stack removeLast.
	stack addLast: CaseFlag. "set for next pop"
	statements addLast: (self blockForCaseTo: nextCase).

	stack last == CaseFlag
		ifTrue: "Last case"
			["ensure jump is within block (in case thenExpr returns wierdly I guess)"
			stack removeLast. "get rid of CaseFlag"
			stmtStream := (self popTo: stack removeLast) readStream.
			
			elements := OrderedCollection new.
			b := OrderedCollection new.
			[stmtStream atEnd] whileFalse:
				[(node := stmtStream next) == CascadeFlag
					ifTrue:
						[elements addLast: (constructor
							codeMessage: (constructor codeBlock: b returns: false)
							selector: (constructor codeSelector: #-> code: #macro)
							arguments: (Array with: stmtStream next)).
						 b := OrderedCollection new]
					ifFalse: [b addLast: node]].
			b size > 0 ifTrue: [self error: 'Bad cases'].
			cases := constructor codeBrace: elements.
			
			"try find the end of the case"
			myExits := caseExits removeLast: elements size.
			myExits := myExits reject: [ :e | e isNil or: [ e < 0 or: [ e > method endPC ] ] ].
			thenJump := myExits isEmpty
							ifTrue: [ nextCase ]
							ifFalse: [ myExits max ].
			
			otherBlock := self blockTo: thenJump.
			stack addLast:
				(constructor
					codeMessage: stack removeLast
					selector: (constructor codeSelector: #caseOf:otherwise: code: #macro)
					arguments: (Array with: cases with: otherBlock))].! !

!OCDecompiler methodsFor: 'control' stamp: 'ClementBera 7/10/2014 11:09'!
checkForBlock: receiver selector: selector arguments: arguments
	[selector == #closureCopy:copiedValues:] assert.
	^self checkForClosureCopy: receiver arguments: arguments! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 7/10/2014 11:09'!
pushLiteralVariable: assoc

	stack addLast: (constructor codeAnyLitInd: assoc)! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 7/10/2014 15:37'!
doDup

	stack last == CascadeFlag
		ifFalse:
			["Save position and mark cascade"
			stack addLast: statements size.
			stack addLast: CascadeFlag].
	stack addLast: CascadeFlag.! !

!OCDecompiler methodsFor: 'instruction decoding' stamp: 'ClementBera 11/1/2014 13:44'!
callPrimitive: primNumber
	"nothing to do. Handled as any other pragmas when creating the method node."! !

!OCDecompiler methodsFor: 'private' stamp: 'ClementBera 7/10/2014 11:09'!
scanBlockScopeFor: refpc from: startpc to: endpc with: scan scanner: scanner
	| bsl maybeBlockSize |
	bsl := BlockStartLocator new.
	scanner pc: startpc.
	[scanner pc <= endpc] whileTrue:
		[refpc = scanner pc ifTrue:
			[scanner pc: startpc.
			 [scanner pc <= endpc] whileTrue:
				[(scan value: scanner firstByte) ifTrue:
					[^endpc].
				 (maybeBlockSize := scanner interpretNextInstructionFor: bsl) isInteger ifTrue:
					[scanner pc: scanner pc + maybeBlockSize]].
			   ^self].
		 (maybeBlockSize := scanner interpretNextInstructionFor: bsl) isInteger ifTrue:
			[refpc <= (scanner pc + maybeBlockSize)
				ifTrue: [^self scanBlockScopeFor: refpc from: scanner pc to: scanner pc + maybeBlockSize with: scan scanner: scanner]
				ifFalse: [scanner pc: scanner pc + maybeBlockSize]]]! !

!OCDecompiler class methodsFor: 'initialization' stamp: 'ClementBera 7/10/2014 15:00'!
initialize

	CascadeFlag := 'cascade'.  "A unique object"
	CaseFlag := 'case'. "Ditto"
	ArgumentFlag := 'argument'.  "Ditto"
	IfNilFlag := 'ifNil'.  "Ditto"

	"OCDecompiler initialize"! !

!OCDecompiler class methodsFor: 'public' stamp: 'ClementBera 7/23/2014 12:16'!
decompile: aCompiledMethod
	"Answers a decompiled AST for the compiled method"
	^ self new decompileMethod: aCompiledMethod! !

!OCDecompilerConstructor commentStamp: 'ClementBera 7/10/2014 11:44'!
I construct the node tree for a Decompiler.!
!OCDecompilerConstructor methodsFor: 'constructor' stamp: 'ClementBera 7/10/2014 15:43'!
codeTemp: index
	^ RBTemporaryNode named:  't' , (index + 1) printString! !

!OCDecompilerConstructor methodsFor: 'constructor' stamp: 'ClementBera 7/10/2014 13:29'!
codeThisContext
	^ RBThisContextNode named: 'thisContext'! !

!OCDecompilerConstructor methodsFor: 'constructor' stamp: 'ClementBera 7/10/2014 13:29'!
codeConstants
	"Answer with an array of the objects representing self, true, false, nil,
	-1, 0, 1, 2."
	
	^ { RBSelfNode named: 'self' } , (#(true false nil) collect: [ :each | RBLiteralNode value: each ]) , ((-1 to: 2) collect: [ :each | RBLiteralNode value: each ])! !

!OCDecompilerConstructor methodsFor: 'constructor' stamp: 'ClementBera 7/10/2014 14:04'!
codeCascadedMessage: selector arguments: arguments 
	"The receiver will be assigned at the end of the cascaded messages"
	^self
		codeMessage: (RBLiteralNode value: nil)
		selector: selector
		arguments: arguments! !

!OCDecompilerConstructor methodsFor: 'constructor' stamp: 'ClementBera 7/10/2014 11:42'!
codeAnyLiteral: literal
	 
	^ RBLiteralNode value: literal! !

!OCDecompilerConstructor methodsFor: 'constructor' stamp: 'ClementBera 7/10/2014 15:01'!
codeInst: int 
	^ RBVariableNode named: (method methodClass allInstVarNames at: int + 1)! !

!OCDecompilerConstructor methodsFor: 'constructor' stamp: 'ClementBera 8/1/2014 10:14'!
codeMethod: selector block: block tempVars: vars primitive: primitive class: class

	| methodNode visibleTemps arguments temporaries |
	tempVars := vars.
	visibleTemps := OrderedCollection new.
	tempVars do: [ :t |
				   t isIndirectTempVector
						ifTrue: [ t remoteTemps do: [ :remote | visibleTemps addLast: remote ] ]
						ifFalse: [visibleTemps addLast: t] ].
	arguments := visibleTemps copyFrom: 1 to: nArgs.
	temporaries := visibleTemps copyFrom: nArgs + 1 to: visibleTemps size.
	temporaries := temporaries reject: [ :e | e propertyAt: #hidden ifAbsent: false ].
	methodNode := RBMethodNode 
		selector: selector
		arguments: arguments
		body: block body.
	methodNode body temporaries: temporaries.
	methodNode pragmas: (self pragmasForMethod: primitive).
	methodNode properties: method properties copy.
	methodNode properties method: methodNode.
	^methodNode! !

!OCDecompilerConstructor methodsFor: 'constructor' stamp: 'ClementBera 7/16/2014 13:23'!
codeRemoteTemp: index remoteTemps: tempVector 

	^ (RBTempVectorNode new temps: tempVector) yourself! !

!OCDecompilerConstructor methodsFor: 'testing' stamp: 'ClementBera 7/10/2014 11:06'!
isForClosures
	^ true! !

!OCDecompilerConstructor methodsFor: 'constructor' stamp: 'ClementBera 7/10/2014 11:43'!
codeSelector: aString code: aString2 
	^ aString! !

!OCDecompilerConstructor methodsFor: 'constructor' stamp: 'ClementBera 7/10/2014 12:40'!
codeTemp: anInteger named: aString 
	^ RBTemporaryNode named: aString! !

!OCDecompilerConstructor methodsFor: 'initialize' stamp: 'ClementBera 7/10/2014 11:05'!
method: aMethod class: aClass literals: literals

	method := aMethod.
	instVars := aClass allInstVarNames.
	nArgs := method numArgs.
	literalValues := literals! !

!OCDecompilerConstructor methodsFor: 'constructor' stamp: 'ClementBera 7/10/2014 14:44'!
codeBlock: statementsCollection returns: returnBool 
	|  block |
	block := RBBlockNode new.
	block body: (RBSequenceNode statements:
		(statementsCollection size = 0
						ifTrue: [Array with: (RBLiteralNode value: nil)]
						ifFalse: [statementsCollection])).
	block arguments: #().
	block body temporaries: #().
	returnBool ifTrue: [ statementsCollection at: statementsCollection size put: statementsCollection last asReturnNode].
	^ block ! !

!OCDecompilerConstructor methodsFor: 'constructor' stamp: 'ClementBera 7/10/2014 17:24'!
codeIf: receiver selector: selector arguments: arguments

	(receiver isMessage 
		and: [ receiver selector == #== 
			and: [ receiver arguments anyOne isLiteral 					
				and: [ receiver arguments anyOne value == nil ] ] ]) ifTrue: [ 
					selector == #ifTrue:ifFalse: ifTrue: [ 
						^ RBMessageNode 
							receiver: receiver receiver
							selector: #ifNil:ifNotNil:
							arguments: arguments ].
					selector == #ifFalse:ifTrue: ifTrue: [ 
						^ RBMessageNode 
							receiver: receiver receiver
							selector:  #ifNotNil:ifNil:
							arguments: arguments ] ].
					
	selector == #ifTrue:ifFalse: ifTrue: [ 		
						
	(arguments last isJust: nil) ifTrue:
		[^ RBMessageNode
			receiver: receiver
			selector: #ifTrue:
			arguments: (Array with: arguments first)].
	(arguments last isJust: false) ifTrue:
		[^ RBMessageNode
			receiver: receiver
			selector: #and:
			arguments: (Array with: arguments first)].
	(arguments first isJust: nil) ifTrue:
		[^ RBMessageNode
			receiver: receiver
			selector: #ifFalse:
			arguments: (Array with: arguments last)].
	(arguments first isJust: true) ifTrue:
		[^ RBMessageNode
			receiver: receiver
			selector: #or:
			arguments: (Array with: arguments last)].
	].
					
	"regular message"
	^ RBMessageNode 
			receiver: receiver 
			selector: selector 
			arguments: arguments ! !

!OCDecompilerConstructor methodsFor: 'constructor' stamp: 'cb 7/29/2014 18:41'!
codeArguments: args temps: temps block: block 
	| temporaries |
	block arguments: args.
	temporaries := temps reject: [ :e | e propertyAt: #hidden ifAbsent: false ].
	block body temporaries: (temporaries collect: [ :e | e isIndirectTempVector ifTrue: [ e remoteTemps ] ifFalse: [ e ] ]) flattened.
	^ block! !

!OCDecompilerConstructor methodsFor: 'constructor' stamp: 'ClementBera 7/10/2014 12:46'!
codeAssignTo: variable value: expression 
	
	^ RBAssignmentNode variable: variable value: expression! !

!OCDecompilerConstructor methodsFor: 'private' stamp: 'ClementBera 7/16/2014 11:31'!
braceSelector: argumentSize
	^ #(braceWithNone braceWith: braceWith:with: braceWith:with:with: braceWith:with:with:with:) at: argumentSize + 1 ifAbsent: [ nil ]! !

!OCDecompilerConstructor methodsFor: 'constructor' stamp: 'ClementBera 7/10/2014 14:09'!
codeSuper
	^ RBSuperNode named: 'super'! !

!OCDecompilerConstructor methodsFor: 'private' stamp: 'PabloHerrero 1/7/2015 23:53'!
pragmasForMethod: primitive
	"self flag: 'sometimes the image could not have additional method state ?'
	(primitive > 0 and: [ method pragmas isEmpty ])
		ifTrue: [ primitive = 117 ifFalse: [ 
				^ RBPragmaNode 
					selectorParts: #(primitive:) 
					arguments: {RBLiteralNode value: primitive} ].
			self shouldBeImplemented. self flag: 'should fetch in the literal array the module / error and recreate the named primitive.' ]."
		
	^ method pragmas collect: [ :each |
		RBPragmaNode 
			selector: each keyword
			arguments: (each arguments collect: [ :arg | RBLiteralNode value: arg ]) ]! !

!OCDecompilerConstructor methodsFor: 'constructor' stamp: 'ClementBera 7/10/2014 13:17'!
codeAnyLitInd: anAssociation 
	
	^ (RBVariableNode named: anAssociation key)
		binding: anAssociation;
		yourself! !

!OCDecompilerConstructor methodsFor: 'constructor' stamp: 'ClementBera 7/10/2014 11:16'!
codeAnySelector: aString 
	^ aString! !

!OCDecompilerConstructor methodsFor: 'constructor' stamp: 'ClementBera 7/18/2014 15:25'!
codeCascade: receiver messages: messages 
	
	"caseOf no otherwise"
	(messages allSatisfy: [ :m | m isMessage  ]) ifFalse: [ ^ self codeCaseOf: receiver messages: messages ].
	
	"check for big array"
	(receiver isMessageSend 
		and: [ receiver selector == #braceStream: 
			and: [ receiver arguments anyOne isLiteral 
				and:  [ receiver arguments anyOne value isInteger
					and: [ messages last selector == #braceArray 
						and: [ messages allButLast allSatisfy: [ :each | each selector == #nextPut: ] ] ] ] ] ])
							ifTrue: [ ^ RBArrayNode statements: (messages collect: [ :e | e arguments anyOne ]) ].

	"real cascade"
	messages do: [ :each | each receiver: receiver ].
	^ RBCascadeNode messages: messages ! !

!OCDecompilerConstructor methodsFor: 'constructor' stamp: 'ClementBera 7/10/2014 13:03'!
codeBrace: aCollection 
	^ RBArrayNode statements: aCollection! !

!OCDecompilerConstructor methodsFor: 'constructor' stamp: 'ClementBera 7/18/2014 15:43'!
codeCaseOf: receiver messages: messages 
	| collection iterator cascadeFlag |
	iterator := 1 negated.
	cascadeFlag := OCDecompiler classVarNamed: #CascadeFlag.
	collection := Array new: (messages sum: [ :each | (each == cascadeFlag) asBit ]).
	1 to: collection size do: [ :i |
		| firstBlockStatements |
		iterator := iterator + 2.
		firstBlockStatements := OrderedCollection new.
		[(messages at: iterator) == cascadeFlag] whileFalse: [ 
			firstBlockStatements add: (messages at: iterator). 
			iterator := iterator + 1. ].
		collection at: i put: 
			(RBMessageNode
				receiver: (self codeBlock: firstBlockStatements returns: false) 
				selector: #-> 
				arguments: {messages at: iterator + 1}) ]. 
	^ RBMessageNode 
		receiver: receiver 
		selector: #caseOf: 
		arguments: {RBArrayNode statements: collection}! !

!OCDecompilerConstructor methodsFor: 'constructor' stamp: 'ClementBera 7/10/2014 17:26'!
codeMessage: receiver selector: selector arguments: aCollection 
	"big arrays."
	((self braceSelector: selector numArgs) == selector) ifTrue: [ 1halt "does this happen ?" ].
	
	"ifnil, and , or. ..."
	(selector == #ifTrue:ifFalse: or: [ selector == #ifFalse:ifTrue: ]) ifTrue: [ ^ self codeIf: receiver selector: selector arguments: aCollection ].
							
	"regular message"
	^ RBMessageNode 
			receiver: receiver 
			selector: selector 
			arguments: aCollection ! !

!OCDecompilerTest commentStamp: 'ClementBera 7/10/2014 11:55'!
tests created with: 

OCOpalExamples methods do: [ :each |
	OCDecompilerTest compile: ('test' , (each selector numArgs > 0 ifTrue: [ each selector capitalized allButLast ] ifFalse: [each selector capitalized] ) , String cr, String tab, 'self checkMethod: ' , each printString) classified: each category ]!
!OCDecompilerTest methodsFor: 'examples-misc' stamp: 'ClementBera 7/10/2014 11:55'!
testExamplePushArray
	self checkMethod: OCOpalExamples>>#examplePushArray! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleToDoInsideTemp
	self checkMethod: OCOpalExamples>>#exampleToDoInsideTemp! !

!OCDecompilerTest methodsFor: 'examples-misc' stamp: 'ClementBera 7/10/2014 11:55'!
testExamplePushBigArray
	self checkMethod: OCOpalExamples>>#examplePushBigArray! !

!OCDecompilerTest methodsFor: 'examples-blocks' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleBlockExternal
	self checkMethod: OCOpalExamples>>#exampleBlockExternal! !

!OCDecompilerTest methodsFor: 'examples-pragmas' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleDoublePrimitive
	self checkMethod: OCOpalExamples>>#exampleDoublePrimitive! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleIfTrueAssign
	self checkMethod: OCOpalExamples>>#exampleIfTrueAssign! !

!OCDecompilerTest methodsFor: 'examples-blocks' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleSimpleBlockEmpty
	self checkMethod: OCOpalExamples>>#exampleSimpleBlockEmpty! !

!OCDecompilerTest methodsFor: 'examples-simple' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleReturn1
	self checkMethod: OCOpalExamples>>#exampleReturn1! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleToDoOutsideTemp
	self checkMethod: OCOpalExamples>>#exampleToDoOutsideTemp! !

!OCDecompilerTest methodsFor: 'examples-misc' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleToDoValueLimitExpression
	self checkMethod: OCOpalExamples>>#exampleToDoValueLimitExpression! !

!OCDecompilerTest methodsFor: 'examples-pragmas' stamp: 'ClementBera 7/10/2014 11:55'!
testExamplePrimitiveErrorCode
	self checkMethod: OCOpalExamples>>#examplePrimitiveErrorCode! !

!OCDecompilerTest methodsFor: 'examples-blocks' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleSimpleBlockReturn
	self checkMethod: OCOpalExamples>>#exampleSimpleBlockReturn! !

!OCDecompilerTest methodsFor: 'examples-variables' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleThisContext
	self checkMethod: OCOpalExamples>>#exampleThisContext! !

!OCDecompilerTest methodsFor: 'examples' stamp: 'ClementBera 7/10/2014 11:55'!
testNoRemoteBlockTemp
	self checkMethod: OCOpalExamples>>#noRemoteBlockTemp! !

!OCDecompilerTest methodsFor: 'examples-blocks' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleBlockExternal2
	self checkMethod: OCOpalExamples>>#exampleBlockExternal2! !

!OCDecompilerTest methodsFor: 'examples-blocks' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleBlockInternal
	self checkMethod: OCOpalExamples>>#exampleBlockInternal! !

!OCDecompilerTest methodsFor: 'examples-blocks' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleSimpleBlock
	self checkMethod: OCOpalExamples>>#exampleSimpleBlock! !

!OCDecompilerTest methodsFor: 'examples-blocks' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleSimpleBlockLocal
	self checkMethod: OCOpalExamples>>#exampleSimpleBlockLocal! !

!OCDecompilerTest methodsFor: 'examples-blocks' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleSimpleBlockLocalIfNested
	self checkMethod: OCOpalExamples>>#exampleSimpleBlockLocalIfNested! !

!OCDecompilerTest methodsFor: 'examples' stamp: 'ClementBera 7/10/2014 11:55'!
testSingleRemoteReadNestedBlocks
	self checkMethod: OCOpalExamples>>#singleRemoteReadNestedBlocks! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleIfNotNilArg
	self checkMethod: OCOpalExamples>>#exampleIfNotNilArg! !

!OCDecompilerTest methodsFor: 'examples-blocks' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleBlockMethodArgument
	self checkMethod: OCOpalExamples>>#exampleBlockMethodArgument:! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleIfTrue
	self checkMethod: OCOpalExamples>>#exampleIfTrue! !

!OCDecompilerTest methodsFor: 'examples-simple' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleEmptyMethod
	self checkMethod: OCOpalExamples>>#exampleEmptyMethod! !

!OCDecompilerTest methodsFor: 'examples-blocks' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleMethodTempInNestedBlock
	self checkMethod: OCOpalExamples>>#exampleMethodTempInNestedBlock! !

!OCDecompilerTest methodsFor: 'examples-blocks' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleEffectValues
	self checkMethod: OCOpalExamples>>#exampleEffectValues! !

!OCDecompilerTest methodsFor: 'examples-blocks' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleSimpleBlockArgument4
	self checkMethod: OCOpalExamples>>#exampleSimpleBlockArgument4! !

!OCDecompilerTest methodsFor: 'examples' stamp: 'ClementBera 7/10/2014 11:55'!
testOptimizedBlockReadInBlock
	self checkMethod: OCOpalExamples>>#optimizedBlockReadInBlock! !

!OCDecompilerTest methodsFor: 'examples-blocks' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleSimpleBlockNested
	self checkMethod: OCOpalExamples>>#exampleSimpleBlockNested! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleToDoArgument
	self checkMethod: OCOpalExamples>>#exampleToDoArgument! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleToDoInsideTempNotInlined
	self checkMethod: OCOpalExamples>>#exampleToDoInsideTempNotInlined! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleWhileModificationBeforeNotInlined
	self checkMethod: OCOpalExamples>>#exampleWhileModificationBeforeNotInlined! !

!OCDecompilerTest methodsFor: 'examples-blocks' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleBlockNested
	self checkMethod: OCOpalExamples>>#exampleBlockNested! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleTimesRepeatValue
	self checkMethod: OCOpalExamples>>#exampleTimesRepeatValue! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleWhileModificationBefore
	self checkMethod: OCOpalExamples>>#exampleWhileModificationBefore! !

!OCDecompilerTest methodsFor: 'examples-blocks' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleSimpleBlockArgument5
	self checkMethod: OCOpalExamples>>#exampleSimpleBlockArgument5! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/23/2014 14:54'!
testExampleAndOr2
	self checkMethod: OCOpalExamples>>#exampleAndOr2 ! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleTimesRepeatEffect
	self checkMethod: OCOpalExamples>>#exampleTimesRepeatEffect! !

!OCDecompilerTest methodsFor: 'examples-variables' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleSuper
	self checkMethod: OCOpalExamples>>#exampleSuper! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 16:31'!
testExampleAndOr3
	self checkMethod: OCOpalExamples>>#exampleAndOr3! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleIfFalseIfTrue
	self checkMethod: OCOpalExamples>>#exampleIfFalseIfTrue! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleToDoArgumentLimitIsExpression
	self checkMethod: OCOpalExamples>>#exampleToDoArgumentLimitIsExpression! !

!OCDecompilerTest methodsFor: 'examples-misc' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleToDoValue
	self checkMethod: OCOpalExamples>>#exampleToDoValue! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleWhileModificationAfterNotInlined
	self checkMethod: OCOpalExamples>>#exampleWhileModificationAfterNotInlined! !

!OCDecompilerTest methodsFor: 'examples' stamp: 'ClementBera 7/10/2014 11:55'!
testNoRemoteMethodTemp
	self checkMethod: OCOpalExamples>>#noRemoteMethodTemp! !

!OCDecompilerTest methodsFor: 'examples' stamp: 'ClementBera 7/10/2014 11:55'!
testNoRemoteReadInBlock
	self checkMethod: OCOpalExamples>>#noRemoteReadInBlock! !

!OCDecompilerTest methodsFor: 'examples-blocks' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleBlockExternalNested
	self checkMethod: OCOpalExamples>>#exampleBlockExternalNested! !

!OCDecompilerTest methodsFor: 'examples-blocks' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleBlockExternalArg
	self checkMethod: OCOpalExamples>>#exampleBlockExternalArg! !

!OCDecompilerTest methodsFor: 'examples-variables' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleiVar
	self checkMethod: OCOpalExamples>>#exampleiVar! !

!OCDecompilerTest methodsFor: 'examples' stamp: 'ClementBera 7/10/2014 11:55'!
testNestedBlocksRemoteInBlockCase1
	self checkMethod: OCOpalExamples>>#nestedBlocksRemoteInBlockCase1! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleWhileWithTemp
	self checkMethod: OCOpalExamples>>#exampleWhileWithTemp! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleWhileWithTempNotInlined
	self checkMethod: OCOpalExamples>>#exampleWhileWithTempNotInlined! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 16:31'!
testExampleAndOr
	self checkMethod: OCOpalExamples>>#exampleAndOr! !

!OCDecompilerTest methodsFor: 'examples-blocks' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleBlockArgument
	self checkMethod: OCOpalExamples>>#exampleBlockArgument! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleIfNotNilReturnNil
	self checkMethod: OCOpalExamples>>#exampleIfNotNilReturnNil! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleIfFalse
	self checkMethod: OCOpalExamples>>#exampleIfFalse! !

!OCDecompilerTest methodsFor: 'examples-blocks' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleSimpleBlockArgument3
	self checkMethod: OCOpalExamples>>#exampleSimpleBlockArgument3! !

!OCDecompilerTest methodsFor: 'examples-blocks' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleSimpleBlockiVar
	self checkMethod: OCOpalExamples>>#exampleSimpleBlockiVar! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleToDoArgumentNotInlined
	self checkMethod: OCOpalExamples>>#exampleToDoArgumentNotInlined! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleMethodWithOptimizedBlocksA
	self checkMethod: OCOpalExamples>>#exampleMethodWithOptimizedBlocksA! !

!OCDecompilerTest methodsFor: 'examples-simple' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleReturn1plus2
	self checkMethod: OCOpalExamples>>#exampleReturn1plus2! !

!OCDecompilerTest methodsFor: 'examples-blocks' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleSimpleBlockArgument1
	self checkMethod: OCOpalExamples>>#exampleSimpleBlockArgument1! !

!OCDecompilerTest methodsFor: 'examples' stamp: 'ClementBera 7/10/2014 11:55'!
testNoRemoteReadNestedBlocks
	self checkMethod: OCOpalExamples>>#noRemoteReadNestedBlocks! !

!OCDecompilerTest methodsFor: 'examples-blocks' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleSimpleBlockArgument2
	self checkMethod: OCOpalExamples>>#exampleSimpleBlockArgument2! !

!OCDecompilerTest methodsFor: 'examples' stamp: 'ClementBera 7/10/2014 11:55'!
testDoubleRemoteAnidatedBlocks
	self checkMethod: OCOpalExamples>>#doubleRemoteAnidatedBlocks! !

!OCDecompilerTest methodsFor: 'examples' stamp: 'ClementBera 7/10/2014 11:55'!
testOptimizedBlockWriteInBlock
	self checkMethod: OCOpalExamples>>#optimizedBlockWriteInBlock! !

!OCDecompilerTest methodsFor: 'examples' stamp: 'ClementBera 7/10/2014 11:55'!
testOptimizedBlockWriteInNestedBlock
	self checkMethod: OCOpalExamples>>#optimizedBlockWriteInNestedBlock! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleSimpleBlockLocalIf
	self checkMethod: OCOpalExamples>>#exampleSimpleBlockLocalIf! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleToDoOutsideTempNotInlined
	self checkMethod: OCOpalExamples>>#exampleToDoOutsideTempNotInlined! !

!OCDecompilerTest methodsFor: 'examples' stamp: 'ClementBera 7/10/2014 11:55'!
testOptimizedBlockWriteInNestedBlockCase3
	self checkMethod: OCOpalExamples>>#optimizedBlockWriteInNestedBlockCase3! !

!OCDecompilerTest methodsFor: 'examples' stamp: 'ClementBera 7/10/2014 11:55'!
testOptimizedBlockWriteInNestedBlockCase4
	self checkMethod: OCOpalExamples>>#optimizedBlockWriteInNestedBlockCase4! !

!OCDecompilerTest methodsFor: 'examples' stamp: 'ClementBera 7/10/2014 11:55'!
testOptimizedBlockWriteReadInBlock
	self checkMethod: OCOpalExamples>>#optimizedBlockWriteReadInBlock! !

!OCDecompilerTest methodsFor: 'examples' stamp: 'ClementBera 7/10/2014 11:55'!
testSingleRemoteDifferentBlocksSameArgumentName
	self checkMethod: OCOpalExamples>>#singleRemoteDifferentBlocksSameArgumentName! !

!OCDecompilerTest methodsFor: 'examples' stamp: 'ClementBera 7/10/2014 11:55'!
testSingleRemoteTempVar
	self checkMethod: OCOpalExamples>>#singleRemoteTempVar! !

!OCDecompilerTest methodsFor: 'examples' stamp: 'ClementBera 7/10/2014 11:55'!
testSingleRemoteTempVarWrittenAfterClosedOver
	self checkMethod: OCOpalExamples>>#singleRemoteTempVarWrittenAfterClosedOver! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleInlineBlockCollectionLR3
	self checkMethod: OCOpalExamples>>#exampleInlineBlockCollectionLR3! !

!OCDecompilerTest methodsFor: 'examples-variables' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleSelf
	self checkMethod: OCOpalExamples>>#exampleSelf! !

!OCDecompilerTest methodsFor: 'examples' stamp: 'ClementBera 7/10/2014 11:55'!
testOptimizedBlockWriteInNestedBlockCase2
	self checkMethod: OCOpalExamples>>#optimizedBlockWriteInNestedBlockCase2! !

!OCDecompilerTest methodsFor: 'examples' stamp: 'ClementBera 7/10/2014 11:55'!
testNestedBlocksRemoteInBlockCase3
	self checkMethod: OCOpalExamples>>#nestedBlocksRemoteInBlockCase3! !

!OCDecompilerTest methodsFor: 'examples-pragmas' stamp: 'ClementBera 7/10/2014 11:55'!
testExamplePrimitiveErrorCodeModule
	self checkMethod: OCOpalExamples>>#examplePrimitiveErrorCodeModule! !

!OCDecompilerTest methodsFor: 'examples' stamp: 'ClementBera 7/10/2014 11:55'!
testNoRemoteBlockArgument
	self checkMethod: OCOpalExamples>>#noRemoteBlockArgument! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleIfTrueIfFalse
	self checkMethod: OCOpalExamples>>#exampleIfTrueIfFalse! !

!OCDecompilerTest methodsFor: 'examples' stamp: 'ClementBera 7/10/2014 11:55'!
testNestedBlocksRemoteInBlockCase2
	self checkMethod: OCOpalExamples>>#nestedBlocksRemoteInBlockCase2! !

!OCDecompilerTest methodsFor: 'examples' stamp: 'ClementBera 7/10/2014 11:55'!
testOptimizedBlockWrittenAfterClosedOverCase1
	self checkMethod: OCOpalExamples>>#optimizedBlockWrittenAfterClosedOverCase1! !

!OCDecompilerTest methodsFor: 'examples-blocks' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleNestedBlockScoping
	self checkMethod: OCOpalExamples>>#exampleNestedBlockScoping! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 16:31'!
testExampleAndOr4
	self checkMethod: OCOpalExamples>>#exampleAndOr4! !

!OCDecompilerTest methodsFor: 'examples-simple' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleNewArray
	self checkMethod: OCOpalExamples>>#exampleNewArray! !

!OCDecompilerTest methodsFor: 'examples' stamp: 'ClementBera 7/10/2014 11:55'!
testWrittenAfterClosedOver
	self checkMethod: OCOpalExamples>>#writtenAfterClosedOver! !

!OCDecompilerTest methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 11:55'!
testExampleSimpleBlockLocalWhile
	self checkMethod: OCOpalExamples>>#exampleSimpleBlockLocalWhile! !

!OCDecompilerTest methodsFor: 'tests' stamp: 'ClementBera 7/10/2014 11:56'!
checkMethod: method
	"This code should not raise any error."
	| ast |
	ast := OCDecompiler new decompileMethod: method.
	ast printString.  ! !

!OCDecompilerTest methodsFor: 'examples' stamp: 'ClementBera 7/10/2014 11:55'!
testSingleRemoteMethodArgument
	self checkMethod: OCOpalExamples>>#singleRemoteMethodArgument! !

!OCDecompilerTest methodsFor: 'examples' stamp: 'ClementBera 7/10/2014 11:55'!
testNoRemoteBlockReturn
	self checkMethod: OCOpalExamples>>#noRemoteBlockReturn! !

!OCDecompilerTest methodsFor: 'examples' stamp: 'ClementBera 7/10/2014 11:55'!
testOptimizedBlocksAndSameNameTemps
	self checkMethod: OCOpalExamples>>#optimizedBlocksAndSameNameTemps! !

!OCDecompilerTest methodsFor: 'examples' stamp: 'ClementBera 7/10/2014 11:55'!
testOptimizedBlockWrittenAfterClosedOverCase2
	self checkMethod: OCOpalExamples>>#optimizedBlockWrittenAfterClosedOverCase2! !

!OCDecompilerTest methodsFor: 'initialization' stamp: 'ClementBera 7/10/2014 11:55'!
testInitialize
	self checkMethod: OCOpalExamples>>#initialize! !

!OCIfNotNilTests methodsFor: 'tests' stamp: 'GabrielOmarCotelli 5/25/2010 21:22'!
testIfNotNil1Arg
	self assert: (5 ifNotNil: [ :a | a printString ]) = '5'.
	self assert: (nil ifNotNil: [ :a | a printString ]) isNil! !

!OCIfNotNilTests methodsFor: 'tests' stamp: 'MarcusDenker 5/13/2013 13:12'!
testIfNilIfNotNil0Arg

	self assert: (5 ifNil: [#foo] ifNotNil: [#bar]) = #bar.
	self assert: (nil ifNil: [#foo] ifNotNil: [#bar]) = #foo! !

!OCIfNotNilTests methodsFor: 'tests' stamp: 'GabrielOmarCotelli 5/25/2010 21:22'!
testIfNotNil1ArgAsVar
	| block |
	block := [ :a | a printString ].
	self assert: (5 ifNotNil: block) = '5'.
	self assert: (nil ifNotNil: block) isNil! !

!OCIfNotNilTests methodsFor: 'tests' stamp: 'GabrielOmarCotelli 5/25/2010 21:22'!
testIfNotNil0Arg
	self assert: (5 ifNotNil: [ #foo ]) = #foo.
	self assert: (nil ifNotNil: [ #foo ]) isNil! !

!OCIfNotNilTests methodsFor: 'tests' stamp: 'vb 4/16/2007 11:36'!
testIfNotNilIfNil1ArgAsVar

	| block1 block2 |
	block1 := [#foo].
	block2 := [:a | a printString].
	self assert: (5 ifNotNil: block2 ifNil: block1) = '5'.
	self assert: (nil ifNotNil: block2 ifNil: block1) = #foo! !

!OCIfNotNilTests methodsFor: 'tests' stamp: 'GabrielOmarCotelli 5/25/2010 21:22'!
testIfNotNil0ArgAsVar
	| block |
	block := [ #foo ].
	self assert: (5 ifNotNil: block) = #foo.
	self assert: (nil ifNotNil: block) isNil! !

!OCIfNotNilTests methodsFor: 'tests' stamp: 'vb 4/16/2007 11:33'!
testIfNilIfNotNil1ArgAsVar

	| block1 block2 |
	block1 := [#foo].
	block2 := [:a | a printString].
	self assert: (5 ifNil: block1 ifNotNil: block2) = '5'.
	self assert: (nil ifNil: block1 ifNotNil: block2) = #foo! !

!OCIfNotNilTests methodsFor: 'tests' stamp: 'vb 4/15/2007 12:25'!
testIfNilIfNotNil1Arg

	self assert: (5 ifNil: [#foo] ifNotNil: [:a | a printString]) = '5'.
	self assert: (nil ifNil: [#foo] ifNotNil: [:a | a printString]) = #foo! !

!OCIfNotNilTests methodsFor: 'tests' stamp: 'vb 4/16/2007 11:43'!
testIfNilIfNotNil0ArgAsVar

	| block1 block2 |
	block1 := [#foo].
	block2 := [#bar].
	self assert: (5 ifNil: block1 ifNotNil: block2) = #bar.
	self assert: (nil ifNil: block1 ifNotNil: block2) = #foo! !

!OCIfNotNilTests methodsFor: 'tests' stamp: 'vb 4/16/2007 11:35'!
testIfNotNilIfNil0Arg

	self assert: (5 ifNotNil: [#foo] ifNil: [#bar]) = #foo.
	self assert: (nil ifNotNil: [#foo] ifNil: [#bar]) = #bar! !

!OCIfNotNilTests methodsFor: 'tests' stamp: 'vb 4/16/2007 11:36'!
testIfNotNilIfNil0ArgAsVar

	| block1 block2 |
	block1 := [#foo].
	block2 := [#bar].
	self assert: (5 ifNotNil: block2 ifNil: block1) = #bar.
	self assert: (nil ifNotNil: block2 ifNil: block1) = #foo! !

!OCIfNotNilTests methodsFor: 'tests' stamp: 'vb 4/16/2007 11:35'!
testIfNotNilIfNil1Arg

	self assert: (5 ifNotNil: [:a | a printString] ifNil: [#foo]) = '5'.
	self assert: (nil ifNotNil: [:a | a printString] ifNil: [#foo]) = #foo! !

!OCIfNotNilTests methodsFor: 'tests' stamp: 'MarcusDenker 4/17/2013 15:02'!
testIfNotNil1ArgWithStatement
	self assert: (5 ifNotNil: [ :a | 3. a ]) = 5.
	self assert: (5 ifNotNil: [ :a | a. 3 ]) = 3.! !

!OCInstanceScope commentStamp: 'MarcusDenker 8/11/2014 10:18'!
I include all variable enries for slots, self, super.!
!OCInstanceScope methodsFor: '*TxText-Styler' stamp: 'IgorStasenko 11/10/2014 17:55'!
findVariable: lookupBlock ifNone: notFoundBlock 

	(lookupBlock value: selfVar) ifTrue: [ ^ selfVar ].
	(lookupBlock value: superVar) ifTrue: [ ^ superVar ].
	
	vars valuesDo: [ :var | (lookupBlock value: var) ifTrue: [ ^ var ] ].

	^ outerScope findVariable: lookupBlock ifNone: notFoundBlock ! !

!OCInstanceScope methodsFor: 'testing' stamp: 'ajh 7/8/2004 20:26'!
isInstanceScope

	^ true! !

!OCInstanceScope methodsFor: 'initialization' stamp: 'MarcusDenker 8/17/2014 13:17'!
initialize
  
	vars := Dictionary new.
	selfVar := OCSpecialVariable new
		name: 'self';
		scope: self;
		yourself.
	superVar := OCSpecialVariable new
		name: 'super';
		scope: self;
		yourself.! !

!OCInstanceScope methodsFor: 'lookup' stamp: 'GuillermoPolito 4/9/2015 17:13'!
lookupVar: name inContext: aContext
	"Return a ScopeVar for my inst var with this name.  Return nil if none found"

	name = 'self' ifTrue: [^ selfVar].
	name = 'super' ifTrue: [^ superVar].
	^ vars at: name ifAbsent: [self outerScope lookupVar: name inContext: aContext ]! !

!OCInstanceScope methodsFor: 'initializing' stamp: 'MarcusDenker 8/17/2014 13:18'!
slots: slotCollection

	slotCollection do: [ :slot |
		vars at: slot name put:
			(OCSlotVariable new
				slot: slot;
				scope: self;
				yourself)].
! !

!OCInstanceScope methodsFor: 'acessing' stamp: 'MarcusDenker 12/17/2012 15:18'!
allTemps
	^#()! !

!OCInstanceScope methodsFor: 'lookup' stamp: 'MarcusDenker 9/1/2010 15:32'!
lookupVar: name
	"Return a ScopeVar for my inst var with this name.  Return nil if none found"

	name = 'self' ifTrue: [^ selfVar].
	name = 'super' ifTrue: [^ superVar].
	^ vars at: name ifAbsent: [self outerScope lookupVar: name]! !

!OCInstanceScope methodsFor: 'lookup' stamp: 'MarcusDenker 6/14/2013 13:34'!
lookupVarForDeclaration: name
	"Return a ScopeVar for my inst var with this name.  Return nil if none found"
	name = 'self' ifTrue: [^ selfVar].
	name = 'super' ifTrue: [^ superVar].
	^ vars at: name ifAbsent: [self outerScope lookupVarForDeclaration: name]! !

!OCInstanceScope methodsFor: 'scope' stamp: 'MarcusDenker 9/9/2010 17:22'!
newMethodScope

	^ OCMethodScope new outerScope: self! !

!OCInstanceScope methodsFor: 'acessing' stamp: 'ms 7/10/2007 17:58'!
instanceScope
	^self! !

!OCInstanceScope methodsFor: 'lookup' stamp: 'GuillermoPolito 4/9/2015 17:17'!
variableNamed: name ifAbsent: aBlock
	"Return a ScopeVar for my inst var with this name.  Return nil if none found"

	name = 'self' ifTrue: [^ selfVar].
	name = 'super' ifTrue: [^ superVar].
	^ vars at: name ifAbsent: aBlock! !

!OCKeyedSet commentStamp: '<historical>'!
Like Set except a key of every element is used for hashing and searching instead of the element itself.  keyBlock gets the key of an element.!
!OCKeyedSet methodsFor: 'adding' stamp: 'MarcusDenker 5/12/2011 13:43'!
like: anObject
	"Answer an object in the receiver that is equal to anObject,
	nil if no such object is found. Relies heavily on hash properties"

	| index |

	^(index := self scanFor: (keyBlock value: anObject)) = 0
		ifFalse: [array at: index]
		ifTrue: [nil]! !

!OCKeyedSet methodsFor: 'testing' stamp: 'CamilloBruni 7/3/2013 13:20'!
isHealthy
	"Opal developers plan to remove this class so for the moment we just return true/"

	^ true! !

!OCKeyedSet methodsFor: 'adding' stamp: 'ajh 12/4/2001 05:27'!
addAll: aCollection 
 	"Include all the elements of aCollection as the receiver's elements"
 
 	(aCollection respondsTo: #associationsDo:)
 		ifTrue: [aCollection associationsDo: [:ass | self add: ass]]
 		ifFalse: [aCollection do: [:each | self add: each]].
 	^ aCollection! !

!OCKeyedSet methodsFor: 'initialization' stamp: 'MarcusDenker 8/20/2010 11:22'!
initialize: n
 	super initialize: n.
 	keyBlock := [:element | element key].
 ! !

!OCKeyedSet methodsFor: 'private' stamp: 'MarcusDenker 8/12/2010 15:55'!
scanFor: anObject
	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
	| element start finish |
	finish := array size.
	start := (anObject hash \\ finish) + 1.

	"Search from (hash mod size) to the end."
	start to: finish do:
		[:index | ((element := array at: index) isNil or: [(keyBlock value: element) = anObject])
			ifTrue: [^ index ]].

	"Search from 1 to where we started."
	1 to: start-1 do:
		[:index | ((element := array at: index) isNil or: [(keyBlock value: element) = anObject])
			ifTrue: [^ index ]].

	^ 0  "No match AND no empty slot"! !

!OCKeyedSet methodsFor: 'removing' stamp: 'MarcusDenker 8/12/2010 15:55'!
removeKey: key ifAbsent: aBlock
 
 	| index obj |
 	index := self findElementOrNil: key.
 	(obj := array at: index) ifNil: [ ^ aBlock value ].
 	array at: index put: nil.
 	tally := tally - 1.
 	self fixCollisionsFrom: index.
 	^ obj! !

!OCKeyedSet methodsFor: 'accessing' stamp: 'ajh 9/5/2000 03:58'!
at: key ifPresent: aBlock
 	"Lookup the given key in the receiver. If it is present, answer the value of evaluating the given block with the value associated with the key. Otherwise, answer nil."
 
 	| v |
 	v := self at: key ifAbsent: [^ nil].
 	^ aBlock value: v
 ! !

!OCKeyedSet methodsFor: 'accessing' stamp: 'ajh 9/5/2000 03:57'!
at: key 
 	"Answer the value associated with the key."
 
 	^ self at: key ifAbsent: [self errorKeyNotFound]! !

!OCKeyedSet methodsFor: 'adding' stamp: 'md 3/14/2006 12:37'!
add: newObject
	"Include newObject as one of the receiver's elements, but only if
	not already present. Answer newObject."

	| index |
	newObject ifNil: [self error: 'Sets cannot meaningfully contain nil as an element'].
	index := self findElementOrNil: (keyBlock value: newObject).
	(array at: index) ifNil: [self atNewIndex: index put: newObject].
	^ newObject! !

!OCKeyedSet methodsFor: 'accessing' stamp: 'MarcusDenker 8/18/2010 19:13'!
at: key ifAbsent: aBlock 
 	"Answer the value associated with the key or, if key isn't found,
 	answer the result of evaluating aBlock."
 
 	^(array at: (self findElementOrNil: key)) 
		ifNil: [aBlock value]
		ifNotNil: [:o | o].
 	! !

!OCKeyedSet methodsFor: 'private' stamp: 'ajh 3/29/2001 19:04'!
errorKeyNotFound
 
 	self error: 'key not found'! !

!OCKeyedSet methodsFor: 'testing' stamp: 'MarcusDenker 8/13/2010 11:38'!
includesKey: key
	^ (array at: (self findElementOrNil: key)) notNil! !

!OCKeyedSet methodsFor: 'initialize' stamp: 'ajh 9/5/2000 03:36'!
keyBlock: oneArgBlock
 	"When evaluated return the key of the argument which will be an element of the set"
 
 	keyBlock := oneArgBlock! !

!OCKeyedSet methodsFor: 'private' stamp: 'MarcusDenker 8/12/2010 15:55'!
fixCollisionsFrom: start
	"The element at start has been removed and replaced by nil.
	This method moves forward from there, relocating any entries
	that had been placed below due to collisions with this one"

	| element index |
	index := start.
	[ (element := array at: (index := index \\ array size + 1)) isNil ] whileFalse: [
		| newIndex |
		(newIndex := self findElementOrNil: (keyBlock value: element)) = index ifFalse: [
			array swap: index with: newIndex ] ]! !

!OCKeyedSet methodsFor: 'accessing' stamp: 'ajh 12/10/2000 15:42'!
at: key ifAbsentPut: aBlock 
 	"Answer the value associated with the key or, if key isn't found,
 	add the result of evaluating aBlock to self"
 
 	^ self at: key ifAbsent: [self add: aBlock value]! !

!OCKeyedSet methodsFor: 'private' stamp: 'ajh 12/13/2001 00:17'!
rehash
 	| newSelf |
 	newSelf := self species new: self size.
 	newSelf keyBlock: keyBlock.
 	self do: [:each | newSelf noCheckAdd: each].
 	array := newSelf array! !

!OCKeyedSet methodsFor: 'accessing' stamp: 'ajh 7/3/2004 17:55'!
keys
 
 	| keys |
 	keys := Set new.
 	self keysDo: [:key | keys add: key].
 	^ keys! !

!OCKeyedSet methodsFor: 'copying' stamp: 'nice 6/16/2009 20:56'!
copyEmpty
	^super copyEmpty
		keyBlock: keyBlock copy! !

!OCKeyedSet methodsFor: 'adding' stamp: 'ajh 6/3/2002 10:11'!
member: newObject
 	"Include newObject as one of the receiver's elements, if already exists just return it"
 
 	| index |
 	newObject ifNil: [self error: 'Sets cannot meaningfully contain nil as an element'].
 	index := self findElementOrNil: (keyBlock value: newObject).
 	(array at: index) ifNotNil: [^ array at: index].
 	self atNewIndex: index put: newObject.
 	^ newObject! !

!OCKeyedSet methodsFor: 'removing' stamp: 'MarcusDenker 8/12/2010 15:55'!
remove: oldObject ifAbsent: aBlock
 
 	| index |
 	index := self findElementOrNil: (keyBlock value: oldObject).
 	(array at: index) ifNil: [ ^ aBlock value ].
 	array at: index put: nil.
 	tally := tally - 1.
 	self fixCollisionsFrom: index.
 	^ oldObject! !

!OCKeyedSet methodsFor: 'removing' stamp: 'ajh 3/29/2001 19:03'!
removeKey: key 
 
 	^ self removeKey: key ifAbsent: [self errorKeyNotFound]! !

!OCKeyedSet methodsFor: 'testing' stamp: 'MarcusDenker 8/13/2010 11:38'!
includes: anObject
	^ (array at: (self findElementOrNil: (keyBlock value: anObject))) notNil! !

!OCKeyedSet methodsFor: 'accessing' stamp: 'ajh 7/3/2004 17:54'!
keysDo: block
 
 	self do: [:item | block value: (keyBlock value: item)]! !

!OCKeyedSet methodsFor: 'private' stamp: 'ajh 9/5/2000 03:46'!
noCheckAdd: anObject
 	array at: (self findElementOrNil: (keyBlock value: anObject)) put: anObject.
 	tally := tally + 1! !

!OCKeyedSet methodsFor: 'removing' stamp: 'nice 12/30/2008 19:01'!
removeAll
	"See super."
	
	| tmp |
	tmp := keyBlock.
	super removeAll.
	keyBlock := tmp! !

!OCKeyedSet class methodsFor: 'instance creation' stamp: 'ajh 10/23/2000 23:16'!
keyBlock: oneArgBlock
 	"Create a new KeySet whose way to access an element's key is by executing oneArgBlock on the element"
 
 	^ self new keyBlock: oneArgBlock! !

!OCLiteralList commentStamp: 'ajh 3/25/2003 00:31'!
Holds a unique ordered collection of literals!
!OCLiteralList methodsFor: 'accessing' stamp: 'ajh 1/21/2003 12:21'!
indexOf: anElement startingAt: start ifAbsent: exceptionBlock

	start to: self size do:
		[:index | ((self at: index) literalEqual: anElement) ifTrue: [^ index]].
	^ exceptionBlock value! !

!OCLiteralList methodsFor: 'adding' stamp: 'ajh 3/6/2003 18:00'!
addLast: object
	"Only add if not already in list"

	(equalitySet includes: object) ifTrue: [^ object].
	equalitySet add: object.
	super addLast: object.
	^ object
! !

!OCLiteralList methodsFor: 'private' stamp: 'MarcusDenker 8/21/2010 13:05'!
setCollection: anArray

	super setCollection: anArray.
	equalitySet := OCLiteralSet new: anArray size.
! !

!OCLiteralSet commentStamp: 'ajh 3/25/2003 00:33'!
Holds a unique set of literals.  Literal objects are equal if they are #= plus they are the same class.  This set uses this rule for finding elements.

Example:
	Set new add: 'anthony'; add: #anthony; size  "= 1"
	LiteralSet new add: 'anthony'; add: #anthony; size  "= 2"
!
!OCLiteralSet methodsFor: 'private' stamp: 'MarcusDenker 8/12/2010 15:54'!
scanFor: anObject
	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
	| element start finish |
	start := (anObject hash \\ array size) + 1.
	finish := array size.

	"Search from (hash mod size) to the end."
	start to: finish do:
		[:index | ((element := array at: index) isNil
					or: [element literalEqual: anObject])
					ifTrue: [^ index ]].

	"Search from 1 to where we started."
	1 to: start-1 do:
		[:index | ((element := array at: index) isNil
					or: [element literalEqual: anObject])
					ifTrue: [^ index ]].

	^ 0  "No match AND no empty slot"! !

!OCLiteralSet methodsFor: 'adding' stamp: 'ajh 12/9/2001 16:03'!
add: newObject
	"Include newObject as one of the receiver's elements.  If equivalent is already present don't add and return equivalent object"

	| index |
	newObject ifNil: [self error: 'Sets cannot meaningfully contain nil as an element'].
	index := self findElementOrNil: newObject.
	^ (array at: index) 
		ifNil: [self atNewIndex: index put: newObject. newObject]
		ifNotNil: [array at: index]! !

!OCLiteralVariable commentStamp: 'ajh 3/24/2003 21:53'!
I am a global, pool, or class variable.!
!OCLiteralVariable methodsFor: 'accessing' stamp: 'ms 8/5/2006 14:35'!
value
	^assoc value! !

!OCLiteralVariable methodsFor: 'emitting' stamp: 'MarcusDenker 7/18/2014 07:22'!
emitStore: methodBuilder

	 assoc emitStore: methodBuilder

! !

!OCLiteralVariable methodsFor: 'initializing' stamp: 'ajh 2/26/2003 17:31'!
assoc: anAssociation

	assoc := anAssociation! !

!OCLiteralVariable methodsFor: 'emitting' stamp: 'MarcusDenker 7/18/2014 07:23'!
emitValue: methodBuilder
	assoc emitValue: methodBuilder! !

!OCLiteralVariable methodsFor: 'accessing' stamp: 'GiselaDecuzzi 5/22/2013 15:06'!
assoc
	^ assoc! !

!OCLiteralVariable methodsFor: '*SmartSuggestions' stamp: 'MarcusDenker 9/20/2013 15:05'!
specialCommands
	(self isLiteralVariable and: [Smalltalk globals  includesAssociation: self assoc ])
		ifTrue:[ ^SugsSuggestionFactory commandsForClass].
	(self isLiteralVariable and: [(Smalltalk globals  includesAssociation: self assoc ) not])
		ifTrue:[^SugsSuggestionFactory commandsForClassVariable].
! !

!OCLiteralVariable methodsFor: 'testing' stamp: 'MarcusDenker 9/20/2013 13:28'!
isLiteralVariable
	^true.! !

!OCLiteralVariable methodsFor: 'testing' stamp: 'ajh 7/8/2004 16:25'!
isGlobal

	^ true! !

!OCLiteralVariable methodsFor: 'accessing' stamp: 'ajh 7/2/2004 14:15'!
name

	^ assoc name! !

!OCMethodScope commentStamp: '<historical>'!
I am the scope for a Method!
!OCMethodScope methodsFor: 'testing' stamp: 'GuillermoPolito 4/9/2015 13:18'!
methodScope

	^ self! !

!OCMethodScope methodsFor: 'testing' stamp: 'MarcusDenker 8/27/2010 11:31'!
isMethodScope 
	^true! !

!OCNewCompilerWithChangesFunctionalTests methodsFor: 'test - block returning' stamp: 'BernardoContreras 2/12/2015 00:31'!
testBlockReturning
	
	| aCompiledMethod bytecode index |
	aCompiledMethod := OpalCompiler new 
									source: 'open
	(self announcements at: self index ifAbsent: [ ^ self ]) 
		open';
									class: OCMockCompilationClass;
									compile.
									
	bytecode := aCompiledMethod symbolic asString substrings: String cr.
	index := 0.
	self assert: (bytecode at: (index := index + 1)) = '29 <70> self'.
	self assert: (bytecode at: (index := index + 1)) = '30 <D0> send: announcements'.
	self assert: (bytecode at: (index := index + 1)) = '31 <70> self'.
	self assert: (bytecode at: (index := index + 1)) = '32 <D1> send: index'.
	self assert: (bytecode at: (index := index + 1)) = '33 <8F 00 00 01> closureNumCopied: 0 numArgs: 0 bytes 37 to 37'.
	self assert: (bytecode at: (index := index + 1)) = '37 <78> returnSelf'.
	self assert: (bytecode at: (index := index + 1)) = '38 <F2> send: at:ifAbsent:'.
	self assert: (bytecode at: (index := index + 1)) = '39 <D3> send: open'.
	self assert: (bytecode at: (index := index + 1)) = '40 <87> pop'.
	self assert: (bytecode at: (index := index + 1)) = '41 <78> returnSelf'.


! !

!OCNewCompilerWithChangesFunctionalTests methodsFor: 'other-tests' stamp: 'BernardoContreras 2/12/2015 00:29'!
testDifferentBlocksWithSameArgumentName
	
	| aCompiledMethod bytecode index |
	aCompiledMethod := OpalCompiler new 
									source: 'exampleNestedBlock
												| b c z |
												b := [:a | 
														z := 2.
														z + a].
												c := [:a |
														z + a].
											^ (b value: 2) + (c value: 1)';
									class: OCMockCompilationClass;
									compile.
									
	bytecode := aCompiledMethod symbolic asString substrings: String cr.
	index := 0.
	self assert: (bytecode at: (index := index + 1)) = '13 <8A 01> push: (Array new: 1)'.
	self assert: (bytecode at: (index := index + 1)) = '15 <6A> popIntoTemp: 2'.
	self assert: (bytecode at: (index := index + 1)) = '16 <12> pushTemp: 2'.
	self assert: (bytecode at: (index := index + 1)) = '17 <8F 11 00 0A> closureNumCopied: 1 numArgs: 1 bytes 21 to 30'.
	self assert: (bytecode at: (index := index + 1)) = '21 <77> pushConstant: 2'.
	self assert: (bytecode at: (index := index + 1)) = '22 <8E 00 01> popIntoTemp: 0 inVectorAt: 1'.
	self assert: (bytecode at: (index := index + 1)) = '25 <8C 00 01> pushTemp: 0 inVectorAt: 1'.
	self assert: (bytecode at: (index := index + 1)) = '28 <10> pushTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '29 <B0> send: +'.
	self assert: (bytecode at: (index := index + 1)) = '30 <7D> blockReturn'.
	self assert: (bytecode at: (index := index + 1)) = '31 <68> popIntoTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '32 <12> pushTemp: 2'.
	self assert: (bytecode at: (index := index + 1)) = '33 <8F 11 00 06> closureNumCopied: 1 numArgs: 1 bytes 37 to 42'.
	self assert: (bytecode at: (index := index + 1)) = '37 <8C 00 01> pushTemp: 0 inVectorAt: 1'.
	self assert: (bytecode at: (index := index + 1)) = '40 <10> pushTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '41 <B0> send: +'.
	self assert: (bytecode at: (index := index + 1)) = '42 <7D> blockReturn'.
	self assert: (bytecode at: (index := index + 1)) = '43 <69> popIntoTemp: 1'.
	self assert: (bytecode at: (index := index + 1)) = '44 <10> pushTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '45 <77> pushConstant: 2'.
	self assert: (bytecode at: (index := index + 1)) = '46 <CA> send: value:'.
	self assert: (bytecode at: (index := index + 1)) = '47 <11> pushTemp: 1'.
	self assert: (bytecode at: (index := index + 1)) = '48 <76> pushConstant: 1'.
	self assert: (bytecode at: (index := index + 1)) = '49 <CA> send: value:'.
	self assert: (bytecode at: (index := index + 1)) = '50 <B0> send: +'.
	self assert: (bytecode at: (index := index + 1)) = '51 <7C> returnTop'.! !

!OCNewCompilerWithChangesFunctionalTests methodsFor: 'tests' stamp: 'BernardoContreras 2/12/2015 00:39'!
testSteamContentsLimitedToSequenceableCollectionClass
	| aCompiledMethod bytecode index |
	
	aCompiledMethod := OpalCompiler new 
									source: 'streamContents: blockWithArg limitedTo: sizeLimit
												| stream |
												stream := LimitedWriteStream on: (self new: (100 min: sizeLimit)).
												stream setLimit: sizeLimit limitBlock: [^ stream contents].
												blockWithArg value: stream.
												^ stream contents';
									class: SequenceableCollection class;
									compile.
									
	bytecode := aCompiledMethod symbolic asString substrings: String cr.
	index := 0.
	self assert: (bytecode at: (index := index + 1)) = '37 <40> pushLit: LimitedWriteStream'.
	self assert: (bytecode at: (index := index + 1)) = '38 <70> self'.
	self assert: (bytecode at: (index := index + 1)) = '39 <21> pushConstant: 100'.
	self assert: (bytecode at: (index := index + 1)) = '40 <11> pushTemp: 1'.
	self assert: (bytecode at: (index := index + 1)) = '41 <E2> send: min:'.
	self assert: (bytecode at: (index := index + 1)) = '42 <CD> send: new:'.
	self assert: (bytecode at: (index := index + 1)) = '43 <E3> send: on:'.
	self assert: (bytecode at: (index := index + 1)) = '44 <6A> popIntoTemp: 2'.
	self assert: (bytecode at: (index := index + 1)) = '45 <12> pushTemp: 2'.
	self assert: (bytecode at: (index := index + 1)) = '46 <11> pushTemp: 1'.
	self assert: (bytecode at: (index := index + 1)) = '47 <12> pushTemp: 2'.
	self assert: (bytecode at: (index := index + 1)) = '48 <8F 10 00 03> closureNumCopied: 1 numArgs: 0 bytes 52 to 54'.
	self assert: (bytecode at: (index := index + 1)) = '52 <10> pushTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '53 <D4> send: contents'.
	self assert: (bytecode at: (index := index + 1)) = '54 <7C> returnTop'.
	self assert: (bytecode at: (index := index + 1)) = '55 <F5> send: setLimit:limitBlock:'.
	self assert: (bytecode at: (index := index + 1)) = '56 <87> pop'.
	self assert: (bytecode at: (index := index + 1)) = '57 <10> pushTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '58 <12> pushTemp: 2'.
	self assert: (bytecode at: (index := index + 1)) = '59 <CA> send: value:'.
	self assert: (bytecode at: (index := index + 1)) = '60 <87> pop'.
	self assert: (bytecode at: (index := index + 1)) = '61 <12> pushTemp: 2'.
	self assert: (bytecode at: (index := index + 1)) = '62 <D4> send: contents'.
	self assert: (bytecode at: (index := index + 1)) = '63 <7C> returnTop'.
	! !

!OCNewCompilerWithChangesFunctionalTests methodsFor: 'tests' stamp: 'BernardoContreras 2/12/2015 00:26'!
testMethodTemp
	
	| aCompiledMethod bytecode index |
	aCompiledMethod := OpalCompiler new 
									source: 'testMethodTemp
													| block1 block2 |
													block1 := self methodArgument: 1.
													block2 := self methodArgument: 2.
													self assert: block1 value = 1.
													self assert: block2 value = 2';
									class: OCMockCompilationClass;
									compile.
									
	bytecode := aCompiledMethod symbolic asString substrings: String cr.
	index := 0.
	self assert: (bytecode at: (index := index + 1)) = '21 <70> self'.
	self assert: (bytecode at: (index := index + 1)) = '22 <76> pushConstant: 1'.
	self assert: (bytecode at: (index := index + 1)) = '23 <E0> send: methodArgument:'.
	self assert: (bytecode at: (index := index + 1)) = '24 <68> popIntoTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '25 <70> self'.
	self assert: (bytecode at: (index := index + 1)) = '26 <77> pushConstant: 2'.
	self assert: (bytecode at: (index := index + 1)) = '27 <E0> send: methodArgument:'.
	self assert: (bytecode at: (index := index + 1)) = '28 <69> popIntoTemp: 1'.
	self assert: (bytecode at: (index := index + 1)) = '29 <70> self'.
	self assert: (bytecode at: (index := index + 1)) = '30 <10> pushTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '31 <C9> send: value'.
	self assert: (bytecode at: (index := index + 1)) = '32 <76> pushConstant: 1'.
	self assert: (bytecode at: (index := index + 1)) = '33 <B6> send: ='.
	self assert: (bytecode at: (index := index + 1)) = '34 <E1> send: assert:'.
	self assert: (bytecode at: (index := index + 1)) = '35 <87> pop'.
	self assert: (bytecode at: (index := index + 1)) = '36 <70> self'.
	self assert: (bytecode at: (index := index + 1)) = '37 <11> pushTemp: 1'.
	self assert: (bytecode at: (index := index + 1)) = '38 <C9> send: value'.
	self assert: (bytecode at: (index := index + 1)) = '39 <77> pushConstant: 2'.
	self assert: (bytecode at: (index := index + 1)) = '40 <B6> send: ='.
	self assert: (bytecode at: (index := index + 1)) = '41 <E1> send: assert:'.
	self assert: (bytecode at: (index := index + 1)) = '42 <87> pop'.
	self assert: (bytecode at: (index := index + 1)) = '43 <78> returnSelf'.

! !

!OCNewCompilerWithChangesFunctionalTests methodsFor: 'tests' stamp: 'BernardoContreras 2/12/2015 00:25'!
testBlockTemp
	
	| aCompiledMethod bytecode index |
	aCompiledMethod := OpalCompiler new 
									source: 'testBlockTemp
	| block block1 block2 |
	block := [ :arg | [ arg ] ].
	block1 := block value: 1.
	block2 := block value: 2.
	self assert: block1 value = 1.
	self assert: block2 value = 2';
									class: OCMockCompilationClass;
									compile.
									
	bytecode := aCompiledMethod symbolic asString substrings: String cr.
	index := 0.
	self assert: (bytecode at: (index := index + 1)) = '17 <8F 01 00 08> closureNumCopied: 0 numArgs: 1 bytes 21 to 28'.
self assert: (bytecode at: (index := index + 1)) = '21 <10> pushTemp: 0'.
self assert: (bytecode at: (index := index + 1)) = '22 <8F 10 00 02> closureNumCopied: 1 numArgs: 0 bytes 26 to 27'.
self assert: (bytecode at: (index := index + 1)) = '26 <10> pushTemp: 0'.
self assert: (bytecode at: (index := index + 1)) = '27 <7D> blockReturn'.
self assert: (bytecode at: (index := index + 1)) = '28 <7D> blockReturn'.
self assert: (bytecode at: (index := index + 1)) = '29 <68> popIntoTemp: 0'.
self assert: (bytecode at: (index := index + 1)) = '30 <10> pushTemp: 0'.
self assert: (bytecode at: (index := index + 1)) = '31 <76> pushConstant: 1'.
self assert: (bytecode at: (index := index + 1)) = '32 <CA> send: value:'.
self assert: (bytecode at: (index := index + 1)) = '33 <69> popIntoTemp: 1'.
self assert: (bytecode at: (index := index + 1)) = '34 <10> pushTemp: 0'.
self assert: (bytecode at: (index := index + 1)) = '35 <77> pushConstant: 2'.
self assert: (bytecode at: (index := index + 1)) = '36 <CA> send: value:'.
self assert: (bytecode at: (index := index + 1)) = '37 <6A> popIntoTemp: 2'.
self assert: (bytecode at: (index := index + 1)) = '38 <70> self'.
self assert: (bytecode at: (index := index + 1)) = '39 <11> pushTemp: 1'.
self assert: (bytecode at: (index := index + 1)) = '40 <C9> send: value'.
self assert: (bytecode at: (index := index + 1)) = '41 <76> pushConstant: 1'.
self assert: (bytecode at: (index := index + 1)) = '42 <B6> send: ='.
self assert: (bytecode at: (index := index + 1)) = '43 <E0> send: assert:'.
self assert: (bytecode at: (index := index + 1)) = '44 <87> pop'.
self assert: (bytecode at: (index := index + 1)) = '45 <70> self'.
self assert: (bytecode at: (index := index + 1)) = '46 <12> pushTemp: 2'.
self assert: (bytecode at: (index := index + 1)) = '47 <C9> send: value'.
self assert: (bytecode at: (index := index + 1)) = '48 <77> pushConstant: 2'.
self assert: (bytecode at: (index := index + 1)) = '49 <B6> send: ='.
self assert: (bytecode at: (index := index + 1)) = '50 <E0> send: assert:'.
self assert: (bytecode at: (index := index + 1)) = '51 <87> pop'.
self assert: (bytecode at: (index := index + 1)) = '52 <78> returnSelf'.

! !

!OCNewCompilerWithChangesFunctionalTests methodsFor: 'other-tests' stamp: 'BernardoContreras 2/12/2015 00:30'!
testModulePrimitive
	
	| aCompiledMethod bytecode index |
	aCompiledMethod := OpalCompiler new 
	source: 'copyBitsAgain
	"Primitive. See BitBlt|copyBits, also a Primitive. Essential. See Object
	documentation whatIsAPrimitive."

	<primitive: ''primitiveCopyBits'' module: ''BitBltPlugin''>
	self primitiveFailed';
	class: BitBlt;
	compile.
									
	bytecode := aCompiledMethod symbolic asString substrings: String cr.
	index := 0.
	self assert: (bytecode at: (index := index + 1)) = '<primitive: ''primitiveCopyBits'' module: ''BitBltPlugin''>'.
	self assert: (bytecode at: (index := index + 1)) = '21 <70> self'.
	self assert: (bytecode at: (index := index + 1)) = '22 <D1> send: primitiveFailed'.
	self assert: (bytecode at: (index := index + 1)) = '23 <87> pop'.
	self assert: (bytecode at: (index := index + 1)) = '24 <78> returnSelf'.! !

!OCNewCompilerWithChangesFunctionalTests methodsFor: 'tests' stamp: 'BernardoContreras 2/12/2015 00:38'!
testToDoOutsideTempNotInlined
	"there seems to be a better indexzation of the temps we have one more"
	| aCompiledMethod bytecode index |
	aCompiledMethod := OpalCompiler new 
										source: 'testToDoOutsideTempNotInlined
														| block temp |
														block := [ :index | 
																	temp := index. 
																	collection add: [ temp ] ].
														1 to: 5 do: block.
														self assertValues: #(5 5 5 5 5)';
	class: OCMockCompilationClass;
	compile.
									
	bytecode := aCompiledMethod symbolic asString substrings: String cr.
	index := 0.
	self assert: (bytecode at: (index := index + 1)) = '33 <8A 01> push: (Array new: 1)'.
	self assert: (bytecode at: (index := index + 1)) = '35 <69> popIntoTemp: 1'.
	self assert: (bytecode at: (index := index + 1)) = '36 <11> pushTemp: 1'.
	self assert: (bytecode at: (index := index + 1)) = '37 <8F 11 00 10> closureNumCopied: 1 numArgs: 1 bytes 41 to 56'.
	self assert: (bytecode at: (index := index + 1)) = '41 <10> pushTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '42 <8E 00 01> popIntoTemp: 0 inVectorAt: 1'.
	self assert: (bytecode at: (index := index + 1)) = '45 <00> pushRcvr: 0'.
	self assert: (bytecode at: (index := index + 1)) = '46 <11> pushTemp: 1'.
	self assert: (bytecode at: (index := index + 1)) = '47 <8F 10 00 04> closureNumCopied: 1 numArgs: 0 bytes 51 to 54'.
	self assert: (bytecode at: (index := index + 1)) = '51 <8C 00 00> pushTemp: 0 inVectorAt: 0'.
	self assert: (bytecode at: (index := index + 1)) = '54 <7D> blockReturn'.
	self assert: (bytecode at: (index := index + 1)) = '55 <E0> send: add:'.
	self assert: (bytecode at: (index := index + 1)) = '56 <7D> blockReturn'.
	self assert: (bytecode at: (index := index + 1)) = '57 <68> popIntoTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '58 <76> pushConstant: 1'.
	self assert: (bytecode at: (index := index + 1)) = '59 <21> pushConstant: 5'.
	self assert: (bytecode at: (index := index + 1)) = '60 <10> pushTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '61 <F2> send: to:do:'.
	self assert: (bytecode at: (index := index + 1)) = '62 <87> pop'.
	self assert: (bytecode at: (index := index + 1)) = '63 <70> self'.
	self assert: (bytecode at: (index := index + 1)) = '64 <23> pushConstant: #(5 5 5 5 5)'.
	self assert: (bytecode at: (index := index + 1)) = '65 <E4> send: assertValues:'.
	self assert: (bytecode at: (index := index + 1)) = '66 <87> pop'.
	self assert: (bytecode at: (index := index + 1)) = '67 <78> returnSelf'.

	

! !

!OCNewCompilerWithChangesFunctionalTests methodsFor: 'tests' stamp: 'BernardoContreras 2/12/2015 00:28'!
testWhileModificationAfterNotInlined
	"The bytecodes integers are different in some cases."
	| aCompiledMethod bytecode index |
	aCompiledMethod := OpalCompiler new 
										source: 'testWhileModificationAfterNotInlined
														| index block |
														index := 0.
														block := [ 
															collection add: [ index ].
															index := index + 1 ].
														[ index < 5 ] whileTrue: block.
														self assertValues: #(5 5 5 5 5)';
	class: OCMockCompilationClass;
	compile.
									
	bytecode := aCompiledMethod symbolic asString substrings: String cr.
	index := 0.
	self assert: (bytecode at: (index := index + 1)) = '33 <8A 01> push: (Array new: 1)'.
	self assert: (bytecode at: (index := index + 1)) = '35 <69> popIntoTemp: 1'.
	self assert: (bytecode at: (index := index + 1)) = '36 <75> pushConstant: 0'.
	self assert: (bytecode at: (index := index + 1)) = '37 <8E 00 01> popIntoTemp: 0 inVectorAt: 1'.
	self assert: (bytecode at: (index := index + 1)) = '40 <11> pushTemp: 1'.
	self assert: (bytecode at: (index := index + 1)) = '41 <8F 10 00 15> closureNumCopied: 1 numArgs: 0 bytes 45 to 65'.
	self assert: (bytecode at: (index := index + 1)) = '45 <00> pushRcvr: 0'.
	self assert: (bytecode at: (index := index + 1)) = '46 <10> pushTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '47 <8F 10 00 04> closureNumCopied: 1 numArgs: 0 bytes 51 to 54'.
	self assert: (bytecode at: (index := index + 1)) = '51 <8C 00 00> pushTemp: 0 inVectorAt: 0'.
	self assert: (bytecode at: (index := index + 1)) = '54 <7D> blockReturn'.
	self assert: (bytecode at: (index := index + 1)) = '55 <E0> send: add:'.
	self assert: (bytecode at: (index := index + 1)) = '56 <87> pop'.
	self assert: (bytecode at: (index := index + 1)) = '57 <8C 00 00> pushTemp: 0 inVectorAt: 0'.
	self assert: (bytecode at: (index := index + 1)) = '60 <76> pushConstant: 1'.
	self assert: (bytecode at: (index := index + 1)) = '61 <B0> send: +'.
	self assert: (bytecode at: (index := index + 1)) = '62 <8D 00 00> storeIntoTemp: 0 inVectorAt: 0'.
	self assert: (bytecode at: (index := index + 1)) = '65 <7D> blockReturn'.
	self assert: (bytecode at: (index := index + 1)) = '66 <68> popIntoTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '67 <11> pushTemp: 1'.
	self assert: (bytecode at: (index := index + 1)) = '68 <8F 10 00 06> closureNumCopied: 1 numArgs: 0 bytes 72 to 77'.
	self assert: (bytecode at: (index := index + 1)) = '72 <8C 00 00> pushTemp: 0 inVectorAt: 0'.
	self assert: (bytecode at: (index := index + 1)) = '75 <21> pushConstant: 5'.
	self assert: (bytecode at: (index := index + 1)) = '76 <B2> send: <'.
	self assert: (bytecode at: (index := index + 1)) = '77 <7D> blockReturn'.
	self assert: (bytecode at: (index := index + 1)) = '78 <10> pushTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '79 <E2> send: whileTrue:'.
	self assert: (bytecode at: (index := index + 1)) = '80 <87> pop'.
	self assert: (bytecode at: (index := index + 1)) = '81 <70> self'.
	self assert: (bytecode at: (index := index + 1)) = '82 <23> pushConstant: #(5 5 5 5 5)'.
	self assert: (bytecode at: (index := index + 1)) = '83 <E4> send: assertValues:'.
	self assert: (bytecode at: (index := index + 1)) = '84 <87> pop'.
	self assert: (bytecode at: (index := index + 1)) = '85 <78> returnSelf'.

	
	

! !

!OCNewCompilerWithChangesFunctionalTests methodsFor: 'tests' stamp: 'BernardoContreras 2/12/2015 00:23'!
testWhileModificationBeforeNotInlined
	"The bytecodes integers are different in some cases."
	| aCompiledMethod bytecode index |
	aCompiledMethod := OpalCompiler new 
										source: 'testWhileModificationBeforeNotInlined
														| index block |
														index := 0.
														block := [ 
																index := index + 1.
																collection add: [ index ] ].
														[ index < 5 ] whileTrue: block.
														self assertValues: #(5 5 5 5 5)';
	class: OCMockCompilationClass;
	compile.
									
	bytecode := aCompiledMethod symbolic asString substrings: String cr.
	index := 0.
	self assert: (bytecode at: (index := index + 1)) = '33 <8A 01> push: (Array new: 1)'.
	self assert: (bytecode at: (index := index + 1)) = '35 <69> popIntoTemp: 1'.
	self assert: (bytecode at: (index := index + 1)) = '36 <75> pushConstant: 0'.
	self assert: (bytecode at: (index := index + 1)) = '37 <8E 00 01> popIntoTemp: 0 inVectorAt: 1'.
	self assert: (bytecode at: (index := index + 1)) = '40 <11> pushTemp: 1'.
	self assert: (bytecode at: (index := index + 1)) = '41 <8F 10 00 14> closureNumCopied: 1 numArgs: 0 bytes 45 to 64'.
	self assert: (bytecode at: (index := index + 1)) = '45 <8C 00 00> pushTemp: 0 inVectorAt: 0'.
	self assert: (bytecode at: (index := index + 1)) = '48 <76> pushConstant: 1'.
	self assert: (bytecode at: (index := index + 1)) = '49 <B0> send: +'.
	self assert: (bytecode at: (index := index + 1)) = '50 <8E 00 00> popIntoTemp: 0 inVectorAt: 0'.
	self assert: (bytecode at: (index := index + 1)) = '53 <00> pushRcvr: 0'.
	self assert: (bytecode at: (index := index + 1)) = '54 <10> pushTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '55 <8F 10 00 04> closureNumCopied: 1 numArgs: 0 bytes 59 to 62'.
	self assert: (bytecode at: (index := index + 1)) = '59 <8C 00 00> pushTemp: 0 inVectorAt: 0'.
	self assert: (bytecode at: (index := index + 1)) = '62 <7D> blockReturn'.
	self assert: (bytecode at: (index := index + 1)) = '63 <E0> send: add:'.
	self assert: (bytecode at: (index := index + 1)) = '64 <7D> blockReturn'.
	self assert: (bytecode at: (index := index + 1)) = '65 <68> popIntoTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '66 <11> pushTemp: 1'.
	self assert: (bytecode at: (index := index + 1)) = '67 <8F 10 00 06> closureNumCopied: 1 numArgs: 0 bytes 71 to 76'.
	self assert: (bytecode at: (index := index + 1)) = '71 <8C 00 00> pushTemp: 0 inVectorAt: 0'.
	self assert: (bytecode at: (index := index + 1)) = '74 <21> pushConstant: 5'.
	self assert: (bytecode at: (index := index + 1)) = '75 <B2> send: <'.
	self assert: (bytecode at: (index := index + 1)) = '76 <7D> blockReturn'.
	self assert: (bytecode at: (index := index + 1)) = '77 <10> pushTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '78 <E2> send: whileTrue:'.
	self assert: (bytecode at: (index := index + 1)) = '79 <87> pop'.
	self assert: (bytecode at: (index := index + 1)) = '80 <70> self'.
	self assert: (bytecode at: (index := index + 1)) = '81 <23> pushConstant: #(5 5 5 5 5)'.
	self assert: (bytecode at: (index := index + 1)) = '82 <E4> send: assertValues:'.
	self assert: (bytecode at: (index := index + 1)) = '83 <87> pop'.
	self assert: (bytecode at: (index := index + 1)) = '84 <78> returnSelf'.

	
	

! !

!OCNewCompilerWithChangesFunctionalTests methodsFor: 'tests' stamp: 'BernardoContreras 2/12/2015 00:43'!
testWhileWithTempNotInlined
	"The bytecodes integers are different in some cases."
	| aCompiledMethod bytecode index |
	aCompiledMethod := OpalCompiler new 
										source: 'testWhileWithTempNotInlined
	| index block |
	index := 0.
	block := [
		| temp |
		temp := index := index + 1.
		collection add: [ temp ] ].
	[ index < 5 ] whileTrue: block.
	self assertValues: #(1 2 3 4 5)';
	class: OCMockCompilationClass;
	compile.
	
									
	bytecode := aCompiledMethod symbolic asString substrings: String cr.
	index := 0.
	self assert: (bytecode at: (index := index + 1)) = '33 <8A 01> push: (Array new: 1)'.
	self assert: (bytecode at: (index := index + 1)) = '35 <69> popIntoTemp: 1'.
	self assert: (bytecode at: (index := index + 1)) = '36 <75> pushConstant: 0'.
	self assert: (bytecode at: (index := index + 1)) = '37 <8E 00 01> popIntoTemp: 0 inVectorAt: 1'.
	self assert: (bytecode at: (index := index + 1)) = '40 <11> pushTemp: 1'.
	self assert: (bytecode at: (index := index + 1)) = '41 <8F 10 00 14> closureNumCopied: 1 numArgs: 0 bytes 45 to 64'.
	self assert: (bytecode at: (index := index + 1)) = '45 <73> pushConstant: nil'.
	self assert: (bytecode at: (index := index + 1)) = '46 <8C 00 00> pushTemp: 0 inVectorAt: 0'.
	self assert: (bytecode at: (index := index + 1)) = '49 <76> pushConstant: 1'.
	self assert: (bytecode at: (index := index + 1)) = '50 <B0> send: +'.
	self assert: (bytecode at: (index := index + 1)) = '51 <8D 00 00> storeIntoTemp: 0 inVectorAt: 0'.
	self assert: (bytecode at: (index := index + 1)) = '54 <69> popIntoTemp: 1'.
	self assert: (bytecode at: (index := index + 1)) = '55 <00> pushRcvr: 0'.
	self assert: (bytecode at: (index := index + 1)) = '56 <11> pushTemp: 1'.
	self assert: (bytecode at: (index := index + 1)) = '57 <8F 10 00 02> closureNumCopied: 1 numArgs: 0 bytes 61 to 62'.
	self assert: (bytecode at: (index := index + 1)) = '61 <10> pushTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '62 <7D> blockReturn'.
	self assert: (bytecode at: (index := index + 1)) = '63 <E0> send: add:'.
	self assert: (bytecode at: (index := index + 1)) = '64 <7D> blockReturn'.
	self assert: (bytecode at: (index := index + 1)) = '65 <68> popIntoTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '66 <11> pushTemp: 1'.
	self assert: (bytecode at: (index := index + 1)) = '67 <8F 10 00 06> closureNumCopied: 1 numArgs: 0 bytes 71 to 76'.
	self assert: (bytecode at: (index := index + 1)) = '71 <8C 00 00> pushTemp: 0 inVectorAt: 0'.
	self assert: (bytecode at: (index := index + 1)) = '74 <21> pushConstant: 5'.
	self assert: (bytecode at: (index := index + 1)) = '75 <B2> send: <'.
	self assert: (bytecode at: (index := index + 1)) = '76 <7D> blockReturn'.
	self assert: (bytecode at: (index := index + 1)) = '77 <10> pushTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '78 <E2> send: whileTrue:'.
	self assert: (bytecode at: (index := index + 1)) = '79 <87> pop'.
	self assert: (bytecode at: (index := index + 1)) = '80 <70> self'.
	self assert: (bytecode at: (index := index + 1)) = '81 <23> pushConstant: #(1 2 3 4 5)'.
	self assert: (bytecode at: (index := index + 1)) = '82 <E4> send: assertValues:'.
	self assert: (bytecode at: (index := index + 1)) = '83 <87> pop'.
	self assert: (bytecode at: (index := index + 1)) = '84 <78> returnSelf'.

	
	

! !

!OCNewCompilerWithChangesFunctionalTests methodsFor: 'tests' stamp: 'BernardoContreras 2/12/2015 00:27'!
testToDoInsideTempNotInlined
	"Some instructions are the same but we have a different number at he begining, and the storeTemp and popIntoTemp issue"
	| aCompiledMethod bytecode index |
	aCompiledMethod := OpalCompiler new 
										source: 'testToDoInsideTempNotInlined
														| block |
														block := [ :index | 
																		| temp | 
																		temp := index. 
																		collection add: [ temp ] ].
														1 to: 5 do: block.
														self assertValues: #(1 2 3 4 5)';
	class: OCMockCompilationClass;
	compile.
									
	bytecode := aCompiledMethod symbolic asString substrings: String cr.
	index := 0.
	self assert: (bytecode at: (index := index + 1)) = '33 <8F 01 00 0D> closureNumCopied: 0 numArgs: 1 bytes 37 to 49'.
	self assert: (bytecode at: (index := index + 1)) = '37 <73> pushConstant: nil'.
	self assert: (bytecode at: (index := index + 1)) = '38 <10> pushTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '39 <69> popIntoTemp: 1'.
	self assert: (bytecode at: (index := index + 1)) = '40 <00> pushRcvr: 0'.
	self assert: (bytecode at: (index := index + 1)) = '41 <11> pushTemp: 1'.
	self assert: (bytecode at: (index := index + 1)) = '42 <8F 10 00 02> closureNumCopied: 1 numArgs: 0 bytes 46 to 47'.
	self assert: (bytecode at: (index := index + 1)) = '46 <10> pushTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '47 <7D> blockReturn'.
	self assert: (bytecode at: (index := index + 1)) = '48 <E0> send: add:'.
	self assert: (bytecode at: (index := index + 1)) = '49 <7D> blockReturn'.
	self assert: (bytecode at: (index := index + 1)) = '50 <68> popIntoTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '51 <76> pushConstant: 1'.
	self assert: (bytecode at: (index := index + 1)) = '52 <21> pushConstant: 5'.
	self assert: (bytecode at: (index := index + 1)) = '53 <10> pushTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '54 <F2> send: to:do:'.
	self assert: (bytecode at: (index := index + 1)) = '55 <87> pop'.
	self assert: (bytecode at: (index := index + 1)) = '56 <70> self'.
	self assert: (bytecode at: (index := index + 1)) = '57 <23> pushConstant: #(1 2 3 4 5)'.
	self assert: (bytecode at: (index := index + 1)) = '58 <E4> send: assertValues:'.
	self assert: (bytecode at: (index := index + 1)) = '59 <87> pop'.
	self assert: (bytecode at: (index := index + 1)) = '60 <78> returnSelf'.



! !

!OCNewCompilerWithChangesFunctionalTests methodsFor: 'tests' stamp: 'BernardoContreras 2/12/2015 00:33'!
testSetUp
	
	| aCompiledMethod bytecode index |
	aCompiledMethod := OpalCompiler new 
									source: 'setUp
												super setUp.
												collection := OrderedCollection new';
									class: OCMockCompilationClass;
									compile.
	
	bytecode := aCompiledMethod symbolic asString substrings: String cr.
	index := 0.
	self assert: (bytecode at: (index := index + 1)) =  '21 <70> self'.
	self assert: (bytecode at: (index := index + 1)) =  '22 <85 00> superSend: setUp'.
	self assert: (bytecode at: (index := index + 1)) =  '24 <87> pop'.
	self assert: (bytecode at: (index := index + 1)) =  '25 <41> pushLit: OrderedCollection'.
	self assert: (bytecode at: (index := index + 1)) =  '26 <CC> send: new'.
	self assert: (bytecode at: (index := index + 1)) =  '27 <60> popIntoRcvr: 0'.
	self assert: (bytecode at: (index := index + 1)) =  '28 <78> returnSelf'.
! !

!OCNewCompilerWithChangesFunctionalTests methodsFor: 'tests' stamp: 'BernardoContreras 2/12/2015 00:31'!
testToDoArgumentNotInlined
	
	| aCompiledMethod bytecode index |
	aCompiledMethod := OpalCompiler new 
									source: 'testToDoArgumentNotInlined
													| block |
													block := [ :index |
														collection add: [ index ] ].
													1 to: 5 do: block.
													self assertValues: #(1 2 3 4 5)';
									class: OCMockCompilationClass;
									compile.
	bytecode := aCompiledMethod symbolic asString substrings: String cr.
	index := 0.
	self assert: (bytecode at: (index := index + 1)) = '33 <8F 01 00 0A> closureNumCopied: 0 numArgs: 1 bytes 37 to 46'.
	self assert: (bytecode at: (index := index + 1)) = '37 <00> pushRcvr: 0'.
	self assert: (bytecode at: (index := index + 1)) = '38 <10> pushTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '39 <8F 10 00 02> closureNumCopied: 1 numArgs: 0 bytes 43 to 44'.
	self assert: (bytecode at: (index := index + 1)) = '43 <10> pushTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '44 <7D> blockReturn'.
	self assert: (bytecode at: (index := index + 1)) = '45 <E0> send: add:'.
	self assert: (bytecode at: (index := index + 1)) = '46 <7D> blockReturn'.
	self assert: (bytecode at: (index := index + 1)) = '47 <68> popIntoTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '48 <76> pushConstant: 1'.
	self assert: (bytecode at: (index := index + 1)) = '49 <21> pushConstant: 5'.
	self assert: (bytecode at: (index := index + 1)) = '50 <10> pushTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '51 <F2> send: to:do:'.
	self assert: (bytecode at: (index := index + 1)) = '52 <87> pop'.
	self assert: (bytecode at: (index := index + 1)) = '53 <70> self'.
	self assert: (bytecode at: (index := index + 1)) = '54 <23> pushConstant: #(1 2 3 4 5)'.
	self assert: (bytecode at: (index := index + 1)) = '55 <E4> send: assertValues:'.
	self assert: (bytecode at: (index := index + 1)) = '56 <87> pop'.
	self assert: (bytecode at: (index := index + 1)) = '57 <78> returnSelf'.
! !

!OCNewCompilerWithChangesFunctionalTests methodsFor: 'tests' stamp: 'BernardoContreras 2/12/2015 00:29'!
testMethodArgument
	
	| aCompiledMethod bytecode index |
	aCompiledMethod := OpalCompiler new 
											source: 'testMethodArgument
															| temp block |
															temp := 0.
															block := [ [ temp ] ].
															temp := 1.
															block := block value.
															temp := 2.
															self assert: block value = 2';
											class: OCMockCompilationClass;
											compile.
									
	bytecode := aCompiledMethod symbolic asString substrings: String cr.
	index := 0.
	self assert: (bytecode at: (index := index + 1)) = '17 <8A 01> push: (Array new: 1)'.
	self assert: (bytecode at: (index := index + 1)) = '19 <69> popIntoTemp: 1'.
	self assert: (bytecode at: (index := index + 1)) = '20 <75> pushConstant: 0'.
	self assert: (bytecode at: (index := index + 1)) = '21 <8E 00 01> popIntoTemp: 0 inVectorAt: 1'.
	self assert: (bytecode at: (index := index + 1)) = '24 <11> pushTemp: 1'.
	self assert: (bytecode at: (index := index + 1)) = '25 <8F 10 00 0A> closureNumCopied: 1 numArgs: 0 bytes 29 to 38'.
	self assert: (bytecode at: (index := index + 1)) = '29 <10> pushTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '30 <8F 10 00 04> closureNumCopied: 1 numArgs: 0 bytes 34 to 37'.
	self assert: (bytecode at: (index := index + 1)) = '34 <8C 00 00> pushTemp: 0 inVectorAt: 0'.
	self assert: (bytecode at: (index := index + 1)) = '37 <7D> blockReturn'.
	self assert: (bytecode at: (index := index + 1)) = '38 <7D> blockReturn'.
	self assert: (bytecode at: (index := index + 1)) = '39 <68> popIntoTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '40 <76> pushConstant: 1'.
	self assert: (bytecode at: (index := index + 1)) = '41 <8E 00 01> popIntoTemp: 0 inVectorAt: 1'.
	self assert: (bytecode at: (index := index + 1)) = '44 <10> pushTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '45 <C9> send: value'.
	self assert: (bytecode at: (index := index + 1)) = '46 <68> popIntoTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '47 <77> pushConstant: 2'.
	self assert: (bytecode at: (index := index + 1)) = '48 <8E 00 01> popIntoTemp: 0 inVectorAt: 1'.
	self assert: (bytecode at: (index := index + 1)) = '51 <70> self'.
	self assert: (bytecode at: (index := index + 1)) = '52 <10> pushTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '53 <C9> send: value'.
	self assert: (bytecode at: (index := index + 1)) = '54 <77> pushConstant: 2'.
	self assert: (bytecode at: (index := index + 1)) = '55 <B6> send: ='.
	self assert: (bytecode at: (index := index + 1)) = '56 <E0> send: assert:'.
	self assert: (bytecode at: (index := index + 1)) = '57 <87> pop'.
	self assert: (bytecode at: (index := index + 1)) = '58 <78> returnSelf'.


! !

!OCNewCompilerWithChangesFunctionalTests methodsFor: 'test - array compilation' stamp: 'BernardoContreras 2/12/2015 00:30'!
testSimpleArray
	
	| aCompiledMethod bytecode index |
	aCompiledMethod := OpalCompiler new 
									source: 'method
	^{1}';
									class: OCMockCompilationClass;
									compile.
									
	bytecode := aCompiledMethod symbolic asString substrings: String cr.
	index := 0.
	self assert: (bytecode at: (index := index + 1)) = '13 <76> pushConstant: 1'.
	self assert: (bytecode at: (index := index + 1)) = '14 <8A 81> pop 1 into (Array new: 1)'.
	self assert: (bytecode at: (index := index + 1)) = '16 <7C> returnTop'.
! !

!OCNewCompilerWithChangesFunctionalTests methodsFor: 'test - array compilation' stamp: 'BernardoContreras 2/12/2015 00:40'!
testMultiElementArray
	| aCompiledMethod bytecode index |
	aCompiledMethod := OpalCompiler new 
									source: 'method
	^{1. 2. 3. 4. 5. 6 }';
									class: OCMockCompilationClass;
									compile.
	bytecode := aCompiledMethod symbolic asString substrings: String cr.
	index := 0.
	self assert: (bytecode at: (index := index + 1)) = '29 <76> pushConstant: 1'.
	self assert: (bytecode at: (index := index + 1)) = '30 <77> pushConstant: 2'.
	self assert: (bytecode at: (index := index + 1)) = '31 <20> pushConstant: 3'.
	self assert: (bytecode at: (index := index + 1)) = '32 <21> pushConstant: 4'.
	self assert: (bytecode at: (index := index + 1)) = '33 <22> pushConstant: 5'.
	self assert: (bytecode at: (index := index + 1)) = '34 <23> pushConstant: 6'.
	self assert: (bytecode at: (index := index + 1)) = '35 <8A 86> pop 6 into (Array new: 6)'.
	self assert: (bytecode at: (index := index + 1)) = '37 <7C> returnTop'.
! !

!OCNewCompilerWithChangesFunctionalTests methodsFor: 'tests' stamp: 'BernardoContreras 2/12/2015 00:32'!
testOneFloat
	
	| aCompiledMethod bytecode index |
	aCompiledMethod := OpalCompiler new 
	source: 'one
	
	^1.0';
	class: Float class;
	compile.

									
	bytecode := aCompiledMethod symbolic asString substrings: String cr.
	index := 0.
	self assert: (bytecode at: (index := index + 1)) = '17 <20> pushConstant: 1.0'.
	self assert: (bytecode at: (index := index + 1)) = '18 <7C> returnTop'.
	! !

!OCNewCompilerWithChangesFunctionalTests methodsFor: 'tests' stamp: 'BernardoContreras 2/12/2015 00:42'!
testReturnBlockInMethod
	
	| aCompiledMethod bytecode index |
	aCompiledMethod := OpalCompiler new 
											source: 'methodArgument: anObject
														^ [ anObject ]';
											class: OCMockCompilationClass;
											compile.
									
	bytecode := aCompiledMethod symbolic asString substrings: String cr.
	index := 0.
	self assert: (bytecode at: (index := index + 1)) = '13 <10> pushTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '14 <8F 10 00 02> closureNumCopied: 1 numArgs: 0 bytes 18 to 19'.
	self assert: (bytecode at: (index := index + 1)) = '18 <10> pushTemp: 0'.
	self assert: (bytecode at: (index := index + 1)) = '19 <7D> blockReturn'.
	self assert: (bytecode at: (index := index + 1)) = '20 <7C> returnTop'.


! !

!OCNewCompilerWithChangesFunctionalTests methodsFor: 'tests' stamp: 'BernardoContreras 2/12/2015 00:41'!
testPragma
	
	| aCompiledMethod bytecode index |
	aCompiledMethod := OpalCompiler new 
									source: 'methodDoublePragma
											<hello: 5>
											<hello: 2>';
									class:  OCMockCompilationClass;
									compile.
									
	bytecode := aCompiledMethod symbolic asString substrings: String cr.
	index := 0.
	self assert: (bytecode at: (index := index + 1)) = 'Quick return self'.

! !

!OCOpalExamples commentStamp: '<historical>'!
I am the central place for example code used in tests!
!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 16:25'!
exampleAndOr4
	| t1 t2 |
	t1 := true.
	t2 := false.  
	^ t2 or: [ t1 ] "value"  ! !

!OCOpalExamples methodsFor: 'examples' stamp: 'MarcusDenker 7/2/2012 10:43'!
noRemoteReadNestedBlocks   
	 [ |a| a := 1.
       [ a ]]
! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 16:22'!
exampleAndOr
	| t1 t2 |
	t1 := true.
	t2 := false.
	t1 and: [ t2. '1' logCr ]. "effect"   ! !

!OCOpalExamples methodsFor: 'examples' stamp: 'MarcusDenker 7/2/2012 10:43'!
optimizedBlockWriteInNestedBlockCase4
	| t1 |
	[(true) whileTrue: [ [ t1 < 5 ] whileTrue: [ t1 := 1 ] ] ]
! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/26/2013 14:08'!
exampleTimesRepeatEffect
	| foo |
	foo := 1.
	5 timesRepeat: [ foo := foo + 3 ] . 
	^ foo! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'MarcusDenker 6/5/2012 17:15'!
exampleIfTrueIfFalse
	 1 <2 ifTrue: [^'result'] ifFalse: [2].
	! !

!OCOpalExamples methodsFor: 'initialization' stamp: 'MarcusDenker 8/25/2010 15:49'!
initialize
	collection := OrderedCollection new! !

!OCOpalExamples methodsFor: 'examples-blocks' stamp: 'MarcusDenker 8/25/2010 13:32'!
exampleBlockArgument
	| block block1 block2 |
	block := [ :arg | | temp | temp := arg. [ temp ] ].
	block1 := block value: 1.
	block2 := block value: 2.
	self assert: block1 value = 1.
	self assert: block2 value = 2.
	^block1 value + block2 value.! !

!OCOpalExamples methodsFor: 'examples' stamp: 'MarcusDenker 7/2/2012 10:43'!
optimizedBlockWriteReadInBlock
	| t1 |
	[ t1 < 5 ] whileTrue: [ t1 := 1. [ t1 ] ].
! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'MarcusDenker 8/20/2010 16:09'!
exampleSimpleBlockLocalIf
	^true ifTrue: [ | hallo |  hallo := 1 . hallo].! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/16/2014 11:10'!
exampleAndOr6
	| t1 t2 |
	t1 := true.
	t2 := false.  
	^ t1 and: [ t2 or: [ t1 ] ]! !

!OCOpalExamples methodsFor: 'examples-blocks' stamp: 'MarcusDenker 8/20/2010 16:10'!
exampleBlockExternal2
	| t1 t2 |
	t1 :=  t2 := 1.
	^[t1 + t2] value.! !

!OCOpalExamples methodsFor: 'examples-blocks' stamp: 'MarcusDenker 8/20/2010 16:09'!
exampleSimpleBlockArgument5
	^[:a :b :c :d :e| a + b + c  + d + e] valueWithArguments: #(1 1 1 1 1). ! !

!OCOpalExamples methodsFor: 'examples' stamp: 'MarcusDenker 7/2/2012 10:42'!
noRemoteReadInBlock
	| a |
	a := 1.
	[ a ]

! !

!OCOpalExamples methodsFor: 'examples-variables' stamp: 'MarcusDenker 8/20/2010 15:22'!
exampleiVar
	iVar := 1.
	^iVar.! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'MarcusDenker 8/25/2010 16:20'!
exampleMethodWithOptimizedBlocksA
	| s c |
	s := self isNil
			ifTrue: [| a | a := 'isNil'. a]
			ifFalse: [| a | a := 'notNil'. a].
	c := String new: s size.
	1 to: s size do:
		[:i| c at: i put: (s at: i)].
	^c. "notNil"! !

!OCOpalExamples methodsFor: 'examples-blocks' stamp: 'MarcusDenker 8/20/2010 16:09'!
exampleSimpleBlockLocal
	^[ :each | | t |  t:= each. t   ] value: 5.! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'MarcusDenker 8/25/2010 13:54'!
exampleToDoInsideTempNotInlined
	| block |
	block := [ :index | 
		| temp | 
		temp := index. 
		collection add: [ temp ] ].
	1 to: 5 do: block.
	^collection "#(1 2 3 4 5)"! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'MarcusDenker 9/22/2010 11:14'!
exampleWhileModificationBefore
	| index |
	collection := OrderedCollection new.
	index := 0.
	[ index < 5 ] whileTrue: [ 
		index := index + 1.
		collection add: [ index ] ].
	 ^collection collect: #value.
	"#(5 5 5 5 5)"! !

!OCOpalExamples methodsFor: 'examples' stamp: 'MarcusDenker 7/2/2012 10:42'!
nestedBlocksRemoteInBlockCase1
	| block |
	block := [ | a b |
		[ a := b ].
		[ b := a ] ]! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 16:24'!
exampleAndOr3
	| t1 t2 |
	t1 := true.
	t2 := false.  
	^ t1 and: [ t2 ] "value" ! !

!OCOpalExamples methodsFor: 'examples-blocks' stamp: 'MarcusDenker 5/17/2013 15:57'!
exampleBlockExternal
	| t |
	t := 1.
	^[t] value.! !

!OCOpalExamples methodsFor: 'examples' stamp: 'MarcusDenker 7/2/2012 10:43'!
optimizedBlockWriteInNestedBlockCase3
	| t1 |
	[(true) ifTrue: [ [ t1 < 5 ] whileTrue: [ t1 := 1 ] ] ]
! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'MarcusDenker 8/25/2010 13:53'!
exampleToDoOutsideTemp
	| temp |
	1 to: 5 do: [ :index | 
		temp := index. 
		collection add: [ temp ] ].
	^collection "#(5 5 5 5 5)"! !

!OCOpalExamples methodsFor: 'examples-blocks' stamp: 'MarcusDenker 8/20/2010 16:09'!
exampleSimpleBlockiVar
	^[iVar] value.! !

!OCOpalExamples methodsFor: 'examples-blocks' stamp: 'MarcusDenker 8/20/2010 16:09'!
exampleSimpleBlockArgument3
	^[:a :b :c | a + b + c ] value: 1 value: 1 value: 1.! !

!OCOpalExamples methodsFor: 'examples-blocks' stamp: 'MarcusDenker 8/21/2010 15:05'!
exampleSimpleBlockReturn
	[^1] value.! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'MarcusDenker 12/7/2012 15:11'!
exampleToDoArgumentLimitIsExpression
	| count sum |
	count := 10.
	sum := 0.
	1 to: count - 1 do: [ :each | sum := sum + each].
	^sum! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'MarcusDenker 8/25/2010 13:55'!
exampleToDoInsideTemp
	1 to: 5 do: [ :index | 
		| temp | 
		temp := index. 
		collection add: [ temp ] ].
	^collection "#(1 2 3 4 5)"! !

!OCOpalExamples methodsFor: 'examples' stamp: 'MarcusDenker 10/1/2013 15:07'!
singleRemoteTempVarWrittenAfterClosedOver
	| index block |
	index := 0.
	block := [ index ].
	index := index + 1.
! !

!OCOpalExamples methodsFor: 'examples' stamp: 'MarcusDenker 10/1/2013 15:05'!
singleRemoteTempVar
	| index block theCollection |
	index := 0.
	block := [ 
		theCollection add: [ index ].
		index := index + 1 ].
	[ index < 5 ] whileTrue: block.
	self assertValues: #(5 5 5 5 5)! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'MarcusDenker 8/25/2010 13:52'!
exampleToDoArgumentNotInlined
	| block |
	block := [ :index |
		collection add: [ index ] ].
	1 to: 5 do: block.
	^collection "#(1 2 3 4 5)"! !

!OCOpalExamples methodsFor: 'examples-simple' stamp: 'MarcusDenker 8/21/2010 15:59'!
exampleEmptyMethod! !

!OCOpalExamples methodsFor: 'examples-pragmas' stamp: 'MarcusDenler 12/10/2012 15:53'!
examplePrimitiveErrorCode
	
	<primitive: 60 error: code >
	
	^ code

! !

!OCOpalExamples methodsFor: 'examples' stamp: 'MarcusDenker 7/2/2012 10:43'!
optimizedBlockWriteInNestedBlock
	| t1 |
	^[ [ t1 < 5 ] whileTrue: [ t1 := 1 ] ]
! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/10/2014 16:23'!
exampleAndOr2
	| t1 t2 |
	t1 := true.
	t2 := false.  
	t2 or: [ t1. '2' logCr ]. "effect" ! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'MarcusDenker 2/3/2011 12:19'!
exampleIfTrueAssign
	| a |
	a := 1 <2 ifTrue: [1] ifFalse: [2].
	^a ! !

!OCOpalExamples methodsFor: 'examples' stamp: 'MarcusDenker 7/2/2012 10:43'!
optimizedBlockWrittenAfterClosedOverCase2
	| index |
	index := 0.
	[ index < 5 ] whileTrue: [
		| temp |
		temp := index := index + 1.
		 [ temp ] ].
! !

!OCOpalExamples methodsFor: 'examples-blocks' stamp: 'MarcusDenker 8/20/2010 16:10'!
exampleBlockExternalArg
	| t  |
	t := 1.
	^[:a | t + a] value: 1.! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'MarcusDenker 9/22/2010 11:14'!
exampleToDoArgument
	collection := OrderedCollection new.
	1 to: 5 do: [ :index |
		collection add:  [index]  ].
	 ^collection collect: #value. 
	"#(1 2 3 4 5)"! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'MarcusDenker 8/25/2010 13:47'!
exampleWhileWithTempNotInlined
	| index block |
	index := 0.
	block := [
		| temp |
		temp := index := index + 1.
		collection add: [ temp ] ].
	[ index < 5 ] whileTrue: block.
	^collection "#(1 2 3 4 5)"! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'MarcusDenker 8/25/2010 13:53'!
exampleToDoOutsideTempNotInlined
	| block temp |
	block := [ :index | 
		temp := index. 
		collection add: [ temp ] ].
	1 to: 5 do: block.
	^collection "#(5 5 5 5 5)"! !

!OCOpalExamples methodsFor: 'examples-blocks' stamp: 'MarcusDenker 8/20/2010 16:09'!
exampleSimpleBlockArgument4
	^[:a :b :c :d | a + b + c  + d] value: 1 value: 1 value: 1 value: 1. ! !

!OCOpalExamples methodsFor: 'examples-blocks' stamp: 'MarcusDenker 8/20/2010 16:10'!
exampleBlockExternalNested
	| t s |
	t := s := 1.
	^[[s] value +   t   ] value.! !

!OCOpalExamples methodsFor: 'examples' stamp: 'MarcusDenker 7/2/2012 10:42'!
noRemoteBlockArgument
	| block block1 block2 |
	block := [ :arg | | temp | temp := arg. [ temp ] ].
	block1 := block value: 1.
	block2 := block value: 2.

! !

!OCOpalExamples methodsFor: 'examples' stamp: 'MarcusDenker 7/2/2012 10:42'!
noRemoteBlockReturn
	(self announcements at: self index ifAbsent: [ ^ self ]) 
		open.

! !

!OCOpalExamples methodsFor: 'examples' stamp: 'MarcusDenker 7/2/2012 10:43'!
optimizedBlockReadInBlock
	| t1 |
	[ t1 < 5 ] whileTrue: [ [ t1 ] ].
! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'MarcusDenker 8/21/2010 13:30'!
exampleIfNotNilArg
	^1 even ifNotNil: [ :arg | arg not ]! !

!OCOpalExamples methodsFor: 'examples-simple' stamp: 'MarcusDenker 2/28/2015 15:53'!
exampleReturn42
	^42! !

!OCOpalExamples methodsFor: 'examples' stamp: 'MarcusDenker 7/2/2012 10:43'!
writtenAfterClosedOver
	| a |      
	[ a ].
	a := 1! !

!OCOpalExamples methodsFor: 'examples-misc' stamp: 'MarcusDenker 12/5/2012 15:52'!
exampleToDoValue

	^ 1 to: 2 do: [:each | each]
	
! !

!OCOpalExamples methodsFor: 'examples-blocks' stamp: 'MarcusDenker 8/21/2010 15:57'!
exampleSimpleBlockEmpty
	^[] value.! !

!OCOpalExamples methodsFor: 'examples' stamp: 'MarcusDenker 7/2/2012 10:43'!
optimizedBlocksAndSameNameTemps
	| s c |
	s := self isNil
			ifTrue: [| a | a := 1. a]
			ifFalse: [| a | a := 2. a].
	c := String new: s size.
	1 to: s size do:
		[:i| c at: i put: (s at: i)].
	^c! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'MarcusDenker 8/25/2010 16:29'!
exampleIfFalse
	true ifFalse: [^1].
	^2! !

!OCOpalExamples methodsFor: 'examples-blocks' stamp: 'MarcusDenker 8/20/2010 16:09'!
exampleSimpleBlockLocalIfNested
	^true ifTrue: [| hallo |  [  hallo := 1 . hallo] value] .! !

!OCOpalExamples methodsFor: 'examples' stamp: 'MarcusDenker 7/2/2012 10:43'!
singleRemoteReadNestedBlocks   
	|a| 
	[  a := 1.
       [ a ]]
! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'MarcusDenker 2/3/2011 15:04'!
exampleInlineBlockCollectionLR3
	| col |
	col := OrderedCollection new.
	1 to: 11 do: [ :each | | i | i := each. col add: [ i ]. i := i + 1 ].
	^ (col collect: [ :each | each value ]) asArray "= (2 to: 12) asArray"
! !

!OCOpalExamples methodsFor: 'examples-misc' stamp: 'MarcusDenker 10/12/2010 12:27'!
examplePushArray
	| t |

	{1 .t:=1}.
	^t! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/16/2014 11:10'!
exampleAndOr5
	| t1 t2 |
	t1 := true.
	t2 := false.  
	^ t2 or: [ t1 and: [ t2 ] ]! !

!OCOpalExamples methodsFor: 'examples-blocks' stamp: 'MarcusDenker 8/20/2010 16:10'!
exampleBlockInternal
	
	^[ | t | t := 1. t] value! !

!OCOpalExamples methodsFor: 'examples-blocks' stamp: 'MarcusDenker 8/25/2010 13:31'!
exampleMethodTempInNestedBlock
	| temp block |
	temp := 0.
	block := [ [ temp ] ].
	temp := 1.
	block := block value.
	temp := 2.
	"self assert: block value = 2."
	^block value.! !

!OCOpalExamples methodsFor: 'examples-blocks' stamp: 'MarcusDenker 8/20/2010 16:09'!
exampleSimpleBlockArgument2
	^[:a :b | a + b ] value: 1 value: 1.! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'MarcusDenker 8/25/2010 13:51'!
exampleWhileModificationAfterNotInlined
	| index block |
	index := 0.
	block := [ 
		collection add: [ index ].
		index := index + 1 ].
	[ index < 5 ] whileTrue: block.
	^collection "#(5 5 5 5 5)"! !

!OCOpalExamples methodsFor: 'examples-variables' stamp: 'MarcusDenker 9/1/2010 15:25'!
exampleSuper
	| t |
	t := super.
	^super.! !

!OCOpalExamples methodsFor: 'examples' stamp: 'MarcusDenker 7/2/2012 10:42'!
noRemoteBlockTemp
	| block block1 block2 |
	block := [ :arg | [ arg ] ].
	block1 := block value: 1.
	block2 := block value: 2.


! !

!OCOpalExamples methodsFor: 'examples' stamp: 'MarcusDenler 12/11/2012 15:02'!
optimizedBlockWrittenAfterClosedOverCase1
	| index |
	index := 0.
	[ index < 5 ] whileTrue: [
		| temp |
		[ temp ].
		temp := index := index + 1].
	^index
! !

!OCOpalExamples methodsFor: 'examples-blocks' stamp: 'MarcusDenker 8/20/2010 16:09'!
exampleSimpleBlockArgument1
	^[:a | a ] value: 1.! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'MarcusDenker 8/25/2010 13:49'!
exampleWhileWithTemp
	| index |
	index := 0.
	[ index < 5 ] whileTrue: [
		| temp |
		temp := index := index + 1.
		collection add: [ temp ] ].
	^collection "#(1 2 3 4 5)"! !

!OCOpalExamples methodsFor: 'examples' stamp: 'MarcusDenker 7/2/2012 15:47'!
nestedBlocksRemoteInBlockCase3
	| block |
	block := [ 
		[ |a| block := [ a := 1] ].
		[ |b| block := [ b := 2] ] ].! !

!OCOpalExamples methodsFor: 'examples-simple' stamp: 'MarcusDenker 8/20/2010 21:00'!
exampleNewArray

	| temp |
	
	temp := Array new: 3.
	^temp! !

!OCOpalExamples methodsFor: 'examples' stamp: 'MarcusDenker 7/2/2012 10:43'!
optimizedBlockWriteInBlock
	| t1 |
	[ t1 < 5 ] whileTrue: [ t1 := 1 ].
! !

!OCOpalExamples methodsFor: 'examples-blocks' stamp: 'MarcusDenker 8/20/2010 16:09'!
exampleSimpleBlockNested
	| a match dict | 

	a  := #(a b c d).
	dict := Dictionary new.


	a doWithIndex: [:each :index |
		(match := a indexOf: each) > 0 ifTrue:
			[dict at: index put: (a at: match)]].

	^ dict.! !

!OCOpalExamples methodsFor: 'examples' stamp: 'MarcusDenker 7/2/2012 10:42'!
doubleRemoteAnidatedBlocks
	| val last |	
	val := 0. 
	1 to: 10 do: [ :i |
		[ :continue |
			i = 4 ifTrue: [continue value].
			val := val + 1.
			last := i
		] valueWithExit.
	].
	self assert: val = 9.
	self assert: last = 10.

! !

!OCOpalExamples methodsFor: 'examples' stamp: 'MarcusDenker 7/2/2012 10:43'!
optimizedBlockWriteInNestedBlockCase2
	| t1 |
	(true) ifTrue: [ [ t1 < 5 ] whileTrue: [ t1 := 1 ] ]
! !

!OCOpalExamples methodsFor: 'examples-pragmas' stamp: 'MarcusDenker 5/13/2011 14:41'!
exampleDoublePrimitive
	<primitive: 1>! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'NicolaiHess 10/24/2014 10:23'!
exampleWhileNoModification
	"tempvars aren't modified in the loop, therefore they don't need to be in a indirection vector.
	  number of temps = declared temps "

	| a b c |
	a := 1.
	b := 2.
	c := 3.
	[ false ]
		whileTrue: [ 
			[ a class.
			  b class.
			  c class ]	"<- block in optimized loop" ]! !

!OCOpalExamples methodsFor: 'examples-misc' stamp: 'ClementBera 6/28/2013 13:39'!
examplePushBigArray
	"This array should have a size more than 127 elements"
	{ 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 .  255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 . 255 }.
	^ 1! !

!OCOpalExamples methodsFor: 'examples-blocks' stamp: 'MarcusDenker 8/25/2010 13:42'!
exampleNestedBlockScoping

	| b c z |
	b := [:a | 
			z := 2.
			z + a].
	c := [:a |
			z + a].
	^ (b value: 2) + (c value: 1)! !

!OCOpalExamples methodsFor: 'examples-simple' stamp: 'MarcusDenker 8/20/2010 15:07'!
exampleReturn1
	^1! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'MarcusDenker 6/5/2012 17:11'!
exampleIfTrue
	 1  < 2 ifTrue: [^'result'].
	! !

!OCOpalExamples methodsFor: 'examples' stamp: 'MarcusDenker 7/2/2012 10:42'!
noRemoteMethodTemp
	| block1 block2 |
	block1 := self methodArgument: 1.
	block2 := self methodArgument: 2.

! !

!OCOpalExamples methodsFor: 'examples' stamp: 'MarcusDenker 7/2/2012 10:43'!
singleRemoteDifferentBlocksSameArgumentName
	| b c z |
	b := [:a | 
		z := 2.
		z + a].
	c := [:a |
		z + a].
	^ (b value: 2) + (c value: 1)

! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'MarcusDenker 8/21/2010 13:29'!
exampleIfNotNilReturnNil
	^nil ifNotNil: [ :arg | arg not ]! !

!OCOpalExamples methodsFor: 'examples' stamp: 'MarcusDenker 7/2/2012 10:42'!
nestedBlocksRemoteInBlockCase2
	| block |
	block := [ 
		[ |a| [ a := 1] ].
		[ |b| [ b := 2] ] ]! !

!OCOpalExamples methodsFor: 'examples-pragmas' stamp: 'MarcusDenler 12/10/2012 15:27'!
examplePrimitiveErrorCodeModule
	"Primitive. Attempt to load a module of the given name.
	Fail if module cannot be found, or cannot be loaded,
	or failed to initialize"

	<primitive: 'primLoadModule'  module: '' error: #errorCode >
	^ self primitiveFailed! !

!OCOpalExamples methodsFor: 'examples-variables' stamp: 'MarcusDenker 9/1/2010 14:42'!
exampleSelf
	| t |
	t := self.
	^self.! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'ClementBera 7/26/2013 14:08'!
exampleTimesRepeatValue
	^ 5 timesRepeat: [ 1 + 2 ]   ! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'MarcusDenker 8/25/2010 16:29'!
exampleIfFalseIfTrue
	true ifFalse: [^1] ifTrue: [^2].! !

!OCOpalExamples methodsFor: 'examples-simple' stamp: 'MarcusDenker 8/20/2010 20:25'!
exampleReturn1plus2
	^1+2! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'MarcusDenker 8/20/2010 16:09'!
exampleSimpleBlockLocalWhile
	|a|
	a := true.
	^[: b | [a] whileTrue: [ | hallo |  a := false. hallo := 1 . hallo]]value: 1.! !

!OCOpalExamples methodsFor: 'examples-misc' stamp: 'MarcusDenker 12/5/2012 16:16'!
exampleToDoValueLimitExpression

	^ 2 to: 3+4 do: [:each | each]
	
! !

!OCOpalExamples methodsFor: 'examples-blocks' stamp: 'MarcusDenker 8/20/2010 16:09'!
exampleSimpleBlock
	^[1].! !

!OCOpalExamples methodsFor: 'examples-blocks' stamp: 'MarcusDenker 8/21/2010 16:26'!
exampleBlockNested
	
	^[ [1] value] value! !

!OCOpalExamples methodsFor: 'examples' stamp: 'MarcusDenker 7/2/2012 10:43'!
singleRemoteMethodArgument
	| temp block |
	temp := 0.
	block := [ [ temp ] ].
	temp := 1.
	block := block value.
	temp := 2.
! !

!OCOpalExamples methodsFor: 'examples-variables' stamp: 'MarcusDenker 9/1/2010 15:25'!
exampleThisContext
	| t |
	t := thisContext.
	^thisContext.! !

!OCOpalExamples methodsFor: 'examples-blocks' stamp: 'ClementBera 7/8/2014 16:22'!
exampleEffectValues
	#getMe.
	#( got that ? ).
	Class.
	! !

!OCOpalExamples methodsFor: 'examples-blocks' stamp: 'MarcusDenker 2/3/2011 10:26'!
exampleBlockMethodArgument: arg
	|  block |
	block := [ :blockarg | blockarg + arg].
	self assert: ((block value: 2) = (arg + 2)).
	^block value: 2! !

!OCOpalExamples methodsFor: 'examples-blocks-optimized' stamp: 'MarcusDenker 8/25/2010 13:49'!
exampleWhileModificationBeforeNotInlined
	| index block |
	index := 0.
	block := [ 
		index := index + 1.
		collection add: [ index ] ].
	[ index < 5 ] whileTrue: block.
	^collection.
	"#(5 5 5 5 5)"! !

!OCOpalExamples class methodsFor: 'compiler' stamp: 'MarcusDenker 5/26/2013 14:37'!
compilerClass
	^OpalCompiler! !

!OCOptimizedBlockScope commentStamp: '<historical>'!
In Smalltalk, methods like ifTrue: are inlined an there is no Block for the arguments of these message sends.
To be consistent, these blocks need nevertheless a scope.

!
!OCOptimizedBlockScope methodsFor: 'testing' stamp: 'JorgeRessia 9/11/2010 08:08'!
isOptimizedBlockScope
	^ true! !

!OCOptimizedBlockScope methodsFor: 'initialization' stamp: 'JorgeRessia 9/23/2010 13:16'!
initialize
	super initialize.
	isInlinedLoop := false! !

!OCOptimizedBlockScope methodsFor: 'accessing' stamp: 'GuillermoPolito 4/10/2015 10:57'!
lookupVar: name inContext: aContext
	"I work as OCAbstractMethodScope>>lookupVar:inContext:, looking up in the outer scope but staying in the same context because I'm optimized"
	
	| variable theValue |
	variable := self
		variableNamed: name
		ifAbsent: [ ^ self outerScope lookupVar: name inContext: aContext ].
	theValue := variable readFromContext: aContext scope: self.
	^ theValue! !

!OCOptimizedBlockScope methodsFor: 'private' stamp: 'MarcusDenker 12/14/2012 11:25'!
markInlinedLoop
	isInlinedLoop := true! !

!OCOptimizedBlockScope methodsFor: 'testing' stamp: 'JorgeRessia 9/23/2010 13:21'!
isInsideOptimizedLoop
	^ isInlinedLoop
		ifTrue: [true]
		ifFalse: [self outerScope isInsideOptimizedLoop]! !

!OCOptimizedBlockScope methodsFor: 'accessing' stamp: 'JorgeRessia 9/23/2010 14:00'!
outerNotOptimizedScope
	^self outerScope outerNotOptimizedScope! !

!OCPerformTest commentStamp: 'HenrikSperreJohansen 5/19/2010 02:33'!
I test a primitive failure with perform:withArguments: which was raised when selectors with many arguments was called from methods with small stack sizes.!
!OCPerformTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testPerformWithArgsLargeFrame
	self doPerformOldLargeFrame! !

!OCPerformTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testPerformWithArgsSmallFrame
	self doPerformOldSmallFrame! !

!OCPerformTest methodsFor: 'helper methods' stamp: 'HenrikSperreJohansen 5/19/2010 02:28'!
doPerformOldSmallFrame
	"The perform primitive reuses the current stack frame.
	When this was small, it would cause the perform primitive to fail, when the amount of arguments were too high"
	
	^self perform: #a1:a2:a3:a4:a5:a6:a7:a8:a9:a10:a11:a12:a13:a14:a15:
		withArguments: (Array new: 15).

! !

!OCPerformTest methodsFor: 'helper methods' stamp: 'Igor.Stasenko 5/19/2010 00:21'!
a1: a1 a2: a2 a3: a3 a4: a4 a5: a5 a6: a6 a7: a7 a8:a8 a9: a9 a10: a10 
a11: a11 a12: a12 a13: a13 a14: a14 a15: a15 

	^ true! !

!OCPerformTest methodsFor: 'helper methods' stamp: 'MarcusDenker 6/17/2012 15:06'!
doPerformOldLargeFrame
	| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 |
	"The perform primitive reuses the current stack frame.
	When this was big,the following perform would succeed, since the stack frame was large enough to fit all the arguments"
	
	t1 := t2 := t3 := t4 := t5 := t6 := t7 := t8 := t9 := t10 := t11 := t12 := t13 := 1.
	
	self perform: #a1:a2:a3:a4:a5:a6:a7:a8:a9:a10:a11:a12:a13:a14:a15:
		withArguments: (Array new: 15).

	^ t1! !

!OCPragmaTest methodsFor: 'testing' stamp: 'MarcusDenker 9/5/2013 13:13'!
testIsPrimitve
	| aRBMethode |

	aRBMethode := OpalCompiler new parse: self methodPrimitive.
	self assert: aRBMethode isPrimitive! !

!OCPragmaTest methodsFor: 'testing' stamp: 'MarcusDenker 9/5/2013 13:14'!
testPrimitiveNumber
	| aRBMethode |

	aRBMethode := OpalCompiler new parse: self methodPrimitive.
	self assert: (aRBMethode compiledMethod primitive = 4)! !

!OCPragmaTest methodsFor: 'testing' stamp: 'MarcusDenker 9/5/2013 13:13'!
testDoublePragma
	| aRBMethode |
	"self debug: #testDoublePragma"
	aRBMethode := OpalCompiler new parse: self methodDoublePragma.
	
	self assert: (aRBMethode compiledMethod pragmas first keyword = #hello:).
	self assert: (aRBMethode compiledMethod pragmas second keyword = #hello:)! !

!OCPragmaTest methodsFor: 'method-tested' stamp: 'ms 7/16/2006 21:05'!
methodPrimitivePragma
	^'methodPrimitivePragma
		<hello: 1>
		<primitive: 4>
		<hello: 1>'! !

!OCPragmaTest methodsFor: 'method-tested' stamp: 'ms 7/22/2006 13:33'!
methodPrimitiveStringModule
	^'methodPrimitiveStringModule
		<primitive: ''aFunctionName'' module: ''aModuleName''>'! !

!OCPragmaTest methodsFor: 'testing' stamp: 'MarcusDenker 9/5/2013 13:14'!
testPrimitiveStringModule
	| aRBMethode |

	aRBMethode := OpalCompiler new parse: self methodPrimitiveStringModule.
	
	self assert: (aRBMethode compiledMethod primitive = 117)! !

!OCPragmaTest methodsFor: 'method-tested' stamp: 'ms 7/26/2006 22:53'!
methodNoPragma
	^'methodNoPragma: aNum
		^aNum'! !

!OCPragmaTest methodsFor: 'testing' stamp: 'MarcusDenker 9/5/2013 13:13'!
testCdecl
	| aRBMethode |
	
	Smalltalk globals at: #ExternalFunction ifAbsent:[^self].
	
	aRBMethode := OpalCompiler new parse: self methodCdecl.
	
	self assert: ((aRBMethode compiledMethod literalAt: 1) isKindOf: (Smalltalk globals at: #ExternalFunction )).
	self assert: (aRBMethode compiledMethod primitive = 120)! !

!OCPragmaTest methodsFor: 'method-tested' stamp: 'ms 7/19/2006 00:12'!
methodApicall
	^'methodApicall: aHWND
		<apicall: Win32HDC ''GetDC'' (Win32Window bool bool*) module: ''user32.dll''>
		^self externalCallFailed'! !

!OCPragmaTest methodsFor: 'testing' stamp: 'MarcusDenker 9/5/2013 13:14'!
testPragmaTwoParam
	"self debug: #testPragmaAfterBeforTemp"
	| aRBMethode |
	aRBMethode := OpalCompiler new parse: self methodPragmaTwoParam.


	self assert: (aRBMethode compiledMethod pragmas first keyword = #hello:by:)
	! !

!OCPragmaTest methodsFor: 'testing' stamp: 'MarcusDenker 9/5/2013 13:14'!
testPragmaUnarayMessage
	| aRBMethode |

	aRBMethode := OpalCompiler new parse: self methodPragmaUnarayMessage.
	
	self assert: (aRBMethode compiledMethod pragmas first keyword = #hello)! !

!OCPragmaTest methodsFor: 'method-tested' stamp: 'ms 7/16/2006 21:04'!
methodPragmaAfterBeforTemps
	^'methodPragmaAfterBeforTemps
		<hello: 5>
		| aTemp |
		<world: #ok>
		<blue: true>'! !

!OCPragmaTest methodsFor: 'testing' stamp: 'MarcusDenker 9/5/2013 13:14'!
testPrimitivePragmaNumber
	| aRBMethode |

	aRBMethode := OpalCompiler new parse: self methodPrimitivePragma.
	self assert: (aRBMethode compiledMethod primitive = 4)! !

!OCPragmaTest methodsFor: 'method-tested' stamp: 'ms 7/20/2006 20:49'!
methodPragmaTwoParam
	^'methodDoublePragma
		<hello: 5 by: 2>'! !

!OCPragmaTest methodsFor: 'testing' stamp: 'MarcusDenker 9/5/2013 13:14'!
testPragmaAfterBeforTemp
	"self debug: #testPragmaAfterBeforTemp"
	| aRBMethode |
	aRBMethode := OpalCompiler new parse: self methodPragmaAfterBeforTemps.


	self assert: (aRBMethode compiledMethod pragmas first keyword = #hello:).
	self assert: (aRBMethode compiledMethod pragmas second keyword = #world:)
	! !

!OCPragmaTest methodsFor: 'method-tested' stamp: 'ms 7/25/2006 08:36'!
methodCdeclNoModule
	^'ffiTestShort: c1 with: c2 with: c3 with: c4
		"FFITester ffiTestShort: $A with: 65 with: 65.0 with: $A"
		<cdecl: short ''ffiTestShorts'' (short short short short)>
		^self externalCallFailed'! !

!OCPragmaTest methodsFor: 'method-tested' stamp: 'ms 7/16/2006 21:05'!
methodPrimitive
	^'methodPrimitive
		<primitive: 4>'! !

!OCPragmaTest methodsFor: 'method-tested' stamp: 'ms 7/25/2006 07:56'!
methodPragmaUnarayMessage
	^'methodPragmaUnarayMessage
		<hello>'! !

!OCPragmaTest methodsFor: 'testing' stamp: 'MarcusDenker 9/5/2013 13:14'!
testSinglePragma
	| aRBMethode |
	aRBMethode := OpalCompiler new parse: self methodSinglePragma.
	self assert: (aRBMethode compiledMethod pragmas first keyword = #hello:)
	! !

!OCPragmaTest methodsFor: 'method-tested' stamp: 'ms 7/16/2006 21:03'!
methodDoublePragma
	^'methodDoublePragma
		<hello: 5>
		<hello: 2>'! !

!OCPragmaTest methodsFor: 'method-tested' stamp: 'ms 7/16/2006 21:06'!
methodSinglePragma
	^'methodSinglePragma
		<hello: 5>'! !

!OCPragmaTest methodsFor: 'testing' stamp: 'MarcusDenker 9/5/2013 13:14'!
testPrimitiveString
	| aRBMethode |

	aRBMethode := OpalCompiler new parse: self methodPrimitiveString.
	
	self assert: (aRBMethode compiledMethod primitive = 117)! !

!OCPragmaTest methodsFor: 'method-tested' stamp: 'ms 7/19/2006 00:15'!
methodCdecl
	^'XCloseDisplay: aDisplay
		<cdecl: void ''XCloseDisplay'' (X11Display*) module:''X11''>
		^self externalCallFailed'! !

!OCPragmaTest methodsFor: 'testing' stamp: 'MarcusDenker 9/5/2013 13:13'!
testCdeclNoModule
	| aRBMethode |
	
	Smalltalk globals at: #ExternalFunction ifAbsent:[^self].
	aRBMethode := OpalCompiler new parse: self methodCdeclNoModule.
	
	self assert: ((aRBMethode compiledMethod literalAt: 1) isKindOf: (Smalltalk globals at: #ExternalFunction)).
	self assert: (aRBMethode compiledMethod primitive = 120)! !

!OCPragmaTest methodsFor: 'testing' stamp: 'MarcusDenker 9/5/2013 13:12'!
testApicall
	| aRBMethode |
	
	Smalltalk globals at: #ExternalFunction ifAbsent:[^self].
	
	aRBMethode := OpalCompiler new parse: self methodApicall.
	self assert: ((aRBMethode compiledMethod literalAt: 1) isKindOf: (Smalltalk globals at: #ExternalFunction)).
	self assert: (aRBMethode compiledMethod primitive = 120)! !

!OCPragmaTest methodsFor: 'method-tested' stamp: 'ms 7/22/2006 13:31'!
methodPrimitiveString
	^'methodPrimitiveString
		<primitive: ''aFunctionName''>'! !

!OCPragmaTest methodsFor: 'testing' stamp: 'MarcusDenker 9/5/2013 13:14'!
testNoPragma
	"self debug: #testDoublePrimitive"

	OpalCompiler new parse: self methodNoPragma! !

!OCRequestorScope commentStamp: 'MarcusDenker 8/11/2014 10:18'!
A special scope for tools: variables in the worspace have their own scope, for example!
!OCRequestorScope methodsFor: 'lookup' stamp: 'MarcusDenker 12/2/2013 14:08'!
lookupVar: name

	name = 'self' ifTrue: [  ^outerScope lookupVar: name].
	name = 'super' ifTrue: [  ^outerScope lookupVar: name].
	name first isUppercase ifTrue: [ ^outerScope lookupVar: name ]. 
	
	(requestor bindingOf: name asSymbol) ifNotNil: [:assoc | 
		^ OCLiteralVariable new assoc: assoc; scope: self; yourself].
	^ super lookupVar: name.
! !

!OCRequestorScope methodsFor: 'accessing' stamp: 'MarcusDenker 4/11/2013 14:37'!
requestor: anObject
	requestor := anObject! !

!OCRequestorScope methodsFor: 'lookup' stamp: 'MarcusDenker 5/18/2013 13:52'!
newMethodScope
	 
	^ OCMethodScope new outerScope: (self outerScope: outerScope instanceScope) ! !

!OCRequestorScope methodsFor: 'accessing' stamp: 'MarcusDenker 4/11/2013 14:37'!
requestor
	^ requestor! !

!OCRequestorScope methodsFor: 'lookup' stamp: 'GuillermoPolito 4/9/2015 17:12'!
lookupVar: name inContext: context

	name = 'self' ifTrue: [  ^outerScope lookupVar: name inContext: context outerContext].
	name = 'super' ifTrue: [  ^outerScope lookupVar: name inContext: context outerContext].
	name first isUppercase ifTrue: [ ^outerScope lookupVar: name inContext: context outerContext]. 
	
	(requestor bindingOf: name asSymbol) ifNotNil: [:assoc | 
		^ OCLiteralVariable new assoc: assoc; scope: self; yourself].
	^ super lookupVar: name inContext: context outerContext.! !

!OCRequestorScope methodsFor: 'lookup' stamp: 'GuillermoPolito 4/9/2015 17:17'!
variableNamed: name ifAbsent: aBlock

	name = 'self' ifTrue: [  ^outerScope lookupVar: name].
	name = 'super' ifTrue: [  ^outerScope lookupVar: name].
	name first isUppercase ifTrue: [ ^outerScope lookupVar: name ]. 
	
	(requestor bindingOf: name asSymbol) ifNotNil: [:assoc | 
		^ OCLiteralVariable new assoc: assoc; scope: self; yourself].

	^ aBlock value! !

!OCScannerTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testAmbiguousSelector
	"Non regression test.
	See http://code.google.com/p/pharo/issues/detail?id=2271
	and http://bugs.squeak.org/view.php?id=7491"

	'1@-1' parseLiterals.
	self assert: ('1@-1' parseLiterals at: 2) asString = '@-'! !

!OCScannerTest methodsFor: 'testing' stamp: 'MarcusDenker 5/19/2013 16:45'!
testLiteralSymbols
		
	((((32 to: 126) collect: [:ascii | Character value: ascii])) copyWithout: $`) , "backtick is not suppored by OBParser"
	#(':x:yourself' '::' 'x:yourself' '123' 'x0:1:2:' 'x.y.z' '1abc' 'a1b0c2' ' x' 'x ' '+x-y' '||' '--' '++' '+-' '+/-' '-/+' '<|>' '#x' '()' '[]' '{}' '')
		do: [:str |
			self assert: (self class compiler evaluate: str asSymbol printString) = str asSymbol
				description: 'in all case, a Symbol must be printed in an interpretable fashion']! !

!OCScopesCollector commentStamp: '<historical>'!
I am a helper class to simplify tests related to scopes. I collect all scopes of the AST.
This way one can easily check for scopes and variables even when the scopes are deeply nested.
Simple example (with just a method scope):

|ast scopes ivar|
ast := (OCOpalExamples>>#exampleiVar) 
		parseTree doSemanticAnalysisIn: OCOpalExamples.
scopes := (OCScopesCollector new visitNode: ast) scopes.
ivar := scopes first lookupVar: #iVar!
!OCScopesCollector methodsFor: 'accessing' stamp: 'JorgeRessia 9/7/2010 16:21'!
scopes 
	^scopes! !

!OCScopesCollector methodsFor: 'initialization' stamp: 'JorgeRessia 9/7/2010 16:20'!
initialize 
	scopes := OrderedCollection new.
	super initialize! !

!OCScopesCollector methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 4/11/2013 15:12'!
visitBlockNode: aBlockNode
	scopes add: aBlockNode owningScope.
	super visitBlockNode: aBlockNode! !

!OCScopesCollector methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 4/11/2013 15:12'!
visitMethodNode: aMethodNode
	scopes add: aMethodNode owningScope.
	super visitMethodNode: aMethodNode! !

!OCSemanticError commentStamp: '<historical>'!
Raises a semantic error during semantic analysis!
!OCSemanticError methodsFor: 'exceptiondescription' stamp: 'MarcusDenker 5/17/2013 16:33'!
defaultAction
	^self notify:  messageText at: node start.! !

!OCSemanticError methodsFor: 'accessing' stamp: 'MarcusDenker 5/17/2013 16:33'!
methodNode
	^node methodNode! !

!OCSemanticError methodsFor: 'accessing' stamp: 'MarcusDenker 5/17/2013 16:33'!
node
	^ node! !

!OCSemanticError methodsFor: 'accessing' stamp: 'MarcusDenker 5/17/2013 11:41'!
compilationContext: anObject
	compilationContext := anObject! !

!OCSemanticError methodsFor: 'accessing' stamp: 'MarcusDenker 5/17/2013 16:33'!
node: aNode
	node := aNode! !

!OCSemanticError methodsFor: 'accessing' stamp: 'MarcusDenker 5/17/2013 11:44'!
methodClass
	^self methodNode methodClass! !

!OCSemanticError methodsFor: 'error handling' stamp: 'MarcusDenker 5/23/2013 10:35'!
notify: aString at: location
	"Refer to the comment in Object|notify:."

	^compilationContext requestor 
		ifNil: [SyntaxErrorNotification
					inClass: self methodClass 
					category: self methodClass  category
					withCode: self methodNode source
					doitFlag: false
					errorMessage: aString
					location: location]
		ifNotNil: [compilationContext requestor
					notify: aString , ' ->'
					at: location
					in: compilationContext requestor text]! !

!OCSemanticError methodsFor: 'accessing' stamp: 'MarcusDenker 5/17/2013 11:41'!
compilationContext
	^ compilationContext! !

!OCSemanticWarning commentStamp: 'ajh 7/7/2004 17:36'!
If a variable is not found or some other problem occurs during checking (ASTChecker) than a particular subclass instance of me is signal, usually causing a notification to the user. If not handled, the default handling is done, and compiling continues.!
!OCSemanticWarning methodsFor: 'accessing - compatibility' stamp: 'CamilloBruni 7/17/2013 15:37'!
errorCode
	self requestor ifNil: [
		^ self node methodNode asString ].
	^ self requestor contents! !

!OCSemanticWarning methodsFor: 'accessing - compatibility' stamp: 'CamilloBruni 7/10/2013 16:19'!
errorMessage
	^ self messageText! !

!OCSemanticWarning methodsFor: 'correcting' stamp: 'MarcusDenker 5/18/2013 16:26'!
openMenuIn: aBlock
	self subclassResponsibility! !

!OCSemanticWarning methodsFor: 'accessing' stamp: 'MarcusDenker 5/17/2013 16:31'!
node
	^node ! !

!OCSemanticWarning methodsFor: 'accessing' stamp: 'MarcusDenker 5/17/2013 16:26'!
node: anObject
	node := anObject! !

!OCSemanticWarning methodsFor: 'correcting' stamp: 'MarcusDenker 5/17/2013 16:25'!
methodClass
	^node methodNode methodClass! !

!OCSemanticWarning methodsFor: 'accessing - compatibility' stamp: 'CamilloBruni 7/10/2013 16:18'!
location
	^ self node sourceInterval first! !

!OCSemanticWarning methodsFor: 'accessing' stamp: 'MarcusDenker 6/25/2014 16:47'!
compilationContext
	^ compilationContext ! !

!OCSemanticWarning methodsFor: 'correcting' stamp: 'MarcusDenker 5/23/2013 10:35'!
notify: aString at: location
	"Refer to the comment in Object|notify:."

	^self requestor 
		ifNil: [SyntaxErrorNotification
					inClass: self methodClass 
					category: self methodClass category
					withCode: self methodNode source
					doitFlag: false
					errorMessage: aString
					location: location]
		ifNotNil: [self requestor
					notify: aString , ' ->'
					at: location
					in: self requestor text]! !

!OCSemanticWarning methodsFor: 'correcting' stamp: 'MarcusDenker 5/17/2013 15:02'!
defaultAction
	
	self errorNotification ifFalse: [ ^nil ].
	^self openMenuIn: 
		[:labels :lines :caption | 
		UIManager default chooseFrom: labels lines: lines title: caption]! !

!OCSemanticWarning methodsFor: 'correcting' stamp: 'MarcusDenker 5/17/2013 16:25'!
methodNode
	^node methodNode! !

!OCSemanticWarning methodsFor: 'accessing' stamp: 'MarcusDenker 5/17/2013 14:45'!
requestor
	^ compilationContext requestor! !

!OCSemanticWarning methodsFor: 'accessing' stamp: 'MarcusDenker 5/17/2013 12:41'!
compilationContext: anObject
	compilationContext := anObject! !

!OCSemanticWarning methodsFor: 'accessing' stamp: 'ClementBera 11/26/2013 13:31'!
errorNotification

	^ compilationContext interactive and: [ compilationContext warningAllowed ]! !

!OCShadowVariableWarning commentStamp: 'ajh 3/24/2003 22:21'!
I get signalled when a variable in a block or method scope shadows a variable of the same name in an outer scope.  The default action is to allow it.!
!OCShadowVariableWarning methodsFor: 'correcting' stamp: 'MarcusDenker 10/7/2014 18:07'!
variable: varNode shadows: semVar
	compilationContext interactive
		ifTrue: [ 
			OCSemanticError new
				node: node;
				compilationContext: compilationContext;
				messageText: self stringMessage;
				signal ]
		ifFalse: [ 
			Transcript
				cr;
				show: self methodClass name;
				show: '>>';
				show: varNode methodNode selector;
				show: '(';
				show: varNode name;
				show: ' is shadowed)']! !

!OCShadowVariableWarning methodsFor: 'correcting' stamp: 'MarcusDenker 5/17/2013 16:29'!
defaultAction 

	^ self resume: (self variable: self node shadows: self shadowedVar)
	! !

!OCShadowVariableWarning methodsFor: 'accessing' stamp: 'MarcusDenker 5/23/2013 10:41'!
stringMessage
	^ 'Name already defined'! !

!OCShadowVariableWarning methodsFor: 'correcting' stamp: 'MarcusDenker 5/18/2013 16:43'!
openMenuIn: aBlock
	self error: 'should not be called'! !

!OCShadowVariableWarning methodsFor: 'accessing' stamp: 'MarcusDenker 10/11/2010 16:08'!
shadowedVar: aVar

	shadowedVar := aVar! !

!OCShadowVariableWarning methodsFor: 'accessing' stamp: 'MarcusDenker 5/17/2013 16:27'!
node: aVariableNode

	super node: aVariableNode.
	messageText := 'Temp shadows: ', aVariableNode name.
! !

!OCShadowVariableWarning methodsFor: 'accessing' stamp: 'ajh 3/19/2003 13:32'!
shadowedVar

	^ shadowedVar! !

!OCSlotVariable commentStamp: 'MarcusDenker 7/2/2014 14:26'!
I am a slot in a class. 

Actual code generation is forwarded to the Slot class.

e.g. an InstanceVariableSlot will generate bytecode for reading and writing an ivar, while other Slots either just call the reflective operations of the Slot (#read: and #write:to) or do their own code generation.!
!OCSlotVariable methodsFor: 'accessing' stamp: 'CamilleTeruel 4/17/2014 15:51'!
slot: aSlot
	slot := aSlot! !

!OCSlotVariable methodsFor: 'emitting' stamp: 'CamilleTeruel 4/17/2014 15:36'!
emitStore: methodBuilder

	slot emitStore: methodBuilder! !

!OCSlotVariable methodsFor: '*SmartSuggestions' stamp: 'MarcusDenker 6/26/2014 13:34'!
specialCommands
	^  SugsSuggestionFactory commandsForInstanceVariable.! !

!OCSlotVariable methodsFor: 'accessing' stamp: 'CamilleTeruel 4/17/2014 16:50'!
name: aString
	slot name: aString asSymbol! !

!OCSlotVariable methodsFor: 'emitting' stamp: 'CamilleTeruel 4/17/2014 15:38'!
emitValue: methodBuilder

	slot emitValue: methodBuilder! !

!OCSlotVariable methodsFor: 'accessing' stamp: 'CamilleTeruel 4/17/2014 15:51'!
slot
	^ slot! !

!OCSlotVariable methodsFor: 'testing' stamp: 'CamilleTeruel 4/17/2014 16:00'!
isInstance
	^ true! !

!OCSlotVariable methodsFor: 'accessing' stamp: 'CamilleTeruel 4/17/2014 16:46'!
name
	^ slot name! !

!OCSourceCode2BytecodeTest commentStamp: 'kwl 10/14/2006 10:43'!
I provide at least one test which corresponds to a message sent by InstructionStream>>#interpretNextInstructionFor: to its client.!
!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimNewWith
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodeNewWith self new: 3') selector.
	scanner := InstructionStream on:  method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#new:. false. 1}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimDoWith
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodeDoWith self do: #something') selector.
	scanner := InstructionStream on:  method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#do:. false. 1}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimQuo
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodePrimQuo 3 // 4') selector.
	scanner := InstructionStream on:  method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#//. false. 1}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimAdd
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodePrimAdd 3 + 4') selector.
	scanner := InstructionStream on:  method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#+. false. 1}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'ClementBera 7/23/2014 12:21'!
testStoreAndPopLiteralVariableBytecode
	| selector method scanner did |
	selector := (method := self compile2method: 'storeAndPopLiteralVariableBytecode ClassVar := nil') selector.
	scanner := InstructionStream on: method.
	self
		assert: (did := scanner nextInstruction; peekInstruction) selector == #popIntoLiteralVariable:
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimLessThan
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodePrimLessThan 3 < 4') selector.
	scanner := InstructionStream on:  method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#<. false. 1}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimNotEqual
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodePrimNotEqual 3 ~= 4') selector.
	scanner := InstructionStream on: method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#~=. false. 1}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimGreaterOrEqual
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodePrimGreaterOrEqual 3 >= 4') selector.
	scanner := InstructionStream on:  method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#'>='. false. 1}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimBitShift
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodePrimBitShift 3 bitShift: 4') selector.
	scanner := InstructionStream on:  method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#bitShift:. false. 1}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testDoDup
	| selector method scanner |
	method := self compile2method: 'duplicateTopBytecode 3 + 4; yourself'.
	selector := method selector.
	scanner := InstructionStream on:  method.
	1
		timesRepeat: [scanner nextInstruction].
	self assert: scanner peekInstruction selector == #doDup description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testStoreAndPopTemporaryVariableBytecode
	| selector method scanner did |
	selector := (method:= self compile2method: 'storeAndPopTemporaryVariableBytecode | t0 t1 | t1 := t0') selector.
	scanner := InstructionStream on: method.
	self
		assert: ((did := scanner nextInstruction; peekInstruction) selector == #popIntoTemporaryVariable:
				and: [did arguments first == 1])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimValueWith
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodeValueWith self value: 3') selector.
	scanner := InstructionStream on: method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#value:. false. 1}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimAtPut
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodePrimAtPut self at: 3 put: 4') selector.
	scanner := InstructionStream on:  method.
	3
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#at:put:. false. 2}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPushConstantOneBytecode
	| selector method scanner did |
	selector := (method := self compile2method: 'pushConstantOneBytecode 1 yourself') selector.
	scanner := InstructionStream on:  method.
	self
		assert: ((did := scanner peekInstruction) selector == #pushConstant:
				and: [did arguments first == 1])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPushConstantTrueBytecode
	| selector method scanner did |
	selector := (method := self compile2method: 'pushConstantTrueBytecode true yourself') selector.
	scanner := InstructionStream on: method.
	self assert: ((did := scanner peekInstruction) selector == #pushConstant:
					and: [did arguments first])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testReturnTrueBytecode
	| selector method scanner did |
	selector := (method := self compile2method: 'returnTrueBytecode 3 + 4. ^ true') selector.
	scanner := InstructionStream on: method.
	4
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #methodReturnConstant:
				and: [did arguments first])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPushLiteralConstantBytecode
	| selector method scanner did |
	selector := (method := self compile2method: 'pushLiteralConstantBytecode #() yourself') selector.
	scanner := InstructionStream on: method.
	self assert: ((did := scanner peekInstruction) selector == #pushConstant:
					and: [did arguments first = #()])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimPointX
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodePrimPointX self x') selector.
	scanner := InstructionStream on: method.
	1
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#x. false. 0}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimSubtract
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodePrimSubtract 3 - 4') selector.
	scanner := InstructionStream on:  method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#-. false. 1}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimValue
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodePrimValue self value') selector.
	scanner := InstructionStream on:  method.
	1
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#value. false. 0}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPushActiveContextBytecode
	| selector method scanner |
	selector := (method := self compile2method: 'pushActiveContextBytecode thisContext yourself') selector.
	scanner := InstructionStream on: method.
	self assert: scanner peekInstruction selector == #pushActiveContext
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimAtEnd
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodePrimSize self atEnd') selector.
	scanner := InstructionStream on:  method.
	1
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#atEnd. false. 0}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimMultiply
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodePrimMultiply 3 * 4') selector.
	scanner := InstructionStream on:  method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#'*'. false. 1}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimDivide
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodePrimDivide 3 / 4') selector.
	scanner := InstructionStream on:  method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#/. false. 1}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimBitOr
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodePrimBitOr 3 bitOr: 4') selector.
	scanner := InstructionStream on:  method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#bitOr:. false. 1}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimNext
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodePrimSize self next') selector.
	scanner := InstructionStream on:  method.
	1
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#next. false. 0}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimNew
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodePrimNew super new') selector.
	scanner := InstructionStream on:  method.
	1
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#new. true. 0}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimAt
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodePrimAt self at: 3') selector.
	scanner := InstructionStream on: method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#at:. false. 1}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimIdentity
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodePrimIdentity 3 == 4') selector.
	scanner := InstructionStream on:  method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#==. false. 1}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPushConstantMinusOneBytecode
	| selector method scanner did |
	selector := (method := self compile2method: 'pushConstantMinusOneBytecode -1 yourself') selector.
	scanner := InstructionStream on: method.
	self
		assert: ((did := scanner peekInstruction) selector == #pushConstant:
				and: [did arguments first == -1])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPushConstantTwoBytecode
	| selector method scanner did |
	selector := (method := self compile2method: 'pushConstantTwoBytecode 2 yourself') selector.
	scanner := InstructionStream on: method.
	self
		assert: ((did := scanner peekInstruction) selector == #pushConstant:
				and: [did arguments first == 2])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPushConstantZeroBytecode
	| selector method scanner did |
	selector := (method := self compile2method: 'pushConstantZeroBytecode 0 yourself') selector.
	scanner := InstructionStream on: method.
	self
		assert: ((did := scanner peekInstruction) selector == #pushConstant:
				and: [did arguments first == 0])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimEqual
	| selector method scanner did |
	selector := (method  := self compile2method: 'bytecodePrimEqual 3 = 4') selector.
	scanner := InstructionStream on:  method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#'='. false. 1}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimNextPut
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodePrimNextPut self nextPut: 3') selector.
	scanner := InstructionStream on: method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#nextPut:. false. 1}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'ClementBera 7/23/2014 12:21'!
testPushLiteralVariableBytecode
	| selector method scanner did |
	selector := (method := self compile2method: 'pushLiteralVariableBytecode ClassVar yourself') selector.
	scanner := InstructionStream on: method.
	self
		assert: (did := scanner peekInstruction) selector == #pushLiteralVariable:
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPushConstantNilBytecode
	| selector method scanner did |
	selector := (method := self compile2method: 'pushConstantNilBytecode nil yourself') selector.
	scanner := InstructionStream on: method.
	self
		assert: ((did := scanner peekInstruction) selector == #pushConstant:
				and: [did arguments first isNil])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testReturnFalseBytecode
	| selector method scanner did |
	selector := (method := self compile2method: 'returnFalseBytecode 3 + 4. ^ false') selector.
	scanner := InstructionStream on: method.
	4
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #methodReturnConstant:
				and: [did arguments first not])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testReturnReceiver
	| selector method scanner |
	selector := (method := self compile2method: 'returnReceiver 3 + 4. ^ self') selector.
	scanner := InstructionStream on: method.
	4
		timesRepeat: [scanner nextInstruction].
	self assert: scanner peekInstruction selector == #methodReturnReceiver
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPushConstantFalseBytecode
	| selector method scanner did |
	selector := (method := self compile2method: 'pushConstantFalseBytecode false yourself') selector.
	scanner := InstructionStream on: method.
	self
		assert: ((did := scanner peekInstruction) selector == #pushConstant:
				and: [did arguments first not])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testReturnTopFromBlock
	| selector method scanner |
	
	selector := (method := self compile2method: 'returnTopFromBlock |ia| ^[ia]') selector.
	scanner := InstructionStream on: method.
	3 timesRepeat: [scanner nextInstruction].
	self assert: scanner peekInstruction selector == #blockReturnTop
		description: ('Failed ' , selector)! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimMakePoint
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodePrimMakePoint 3 @ 4') selector.
	scanner := InstructionStream on:  method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#'@'. false. 1}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testDoPop
	| selector method scanner |
	selector := (method := self compile2method: 'popStackBytecode 3 + 4') selector.
	scanner := InstructionStream on:  method.
	3
		timesRepeat: [scanner nextInstruction].
	self assert: scanner peekInstruction selector == #doPop description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testStoreAndPopReceiverVariableBytecode
	| selector method scanner did |
	selector := (method := self compile2method: 'storeAndPopReceiverVariableBytecode instVar := self') selector.
	scanner := InstructionStream on: method.
	self
		assert: ((did := scanner nextInstruction; peekInstruction) selector == #popIntoReceiverVariable:
				and: [did arguments first == 2])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimPointY
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodePrimPointY self y') selector.
	scanner := InstructionStream on: method.
	1
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#y. false. 0}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimSize
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodePrimSize self size') selector.
	scanner := InstructionStream on: method.
	1
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#size. false. 0}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testStoreIntoReceiverVariableBytecode
	| selector method scanner did |
	selector := (method := self compile2method: 'storeIntoReceiverVariableBytecode ^ (instVar := self)') selector.
	scanner := InstructionStream on: method.
	self
		assert: ((did := scanner nextInstruction; peekInstruction) selector == #storeIntoReceiverVariable:
				and: [did arguments first == 2])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPushReceiverBytecode
	| selector method scanner |
	selector := (method := self compile2method: 'pushReceiverBytecode ^ self yourself') selector.
	scanner := InstructionStream on: method.
	self assert: scanner peekInstruction selector == #pushReceiver
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimLessOrEqual
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodePrimLessOrEqual 3 <= 4') selector.
	scanner := InstructionStream on:  method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#<=. false. 1}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimMod
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodePrimMod 3 \\ 4') selector.
	scanner := InstructionStream on:  method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#\\. false. 1}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimBitAnd
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodePrimBitAnd 3 bitAnd: 4') selector.
	scanner := InstructionStream on: method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#bitAnd:. false. 1}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testStoreIntoTemporaryVariableBytecode
	| selector method scanner did |
	selector := (method := self compile2method: 'storeIntoTemporaryVariableBytecode | t0 t1 | ^ (t1 := t0)') selector.
	scanner := InstructionStream on: method.
	self
		assert: ((did := scanner nextInstruction; peekInstruction) selector == #storeIntoTemporaryVariable:
				and: [did arguments first == 1])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testReturnTopFromMethod
	| selector method scanner |
	selector := (method := self compile2method: 'returnTopFromMethod ^ 3 + 4') selector.
	scanner := InstructionStream on: method.
	3
		timesRepeat: [scanner nextInstruction].
	self assert: scanner peekInstruction selector == #methodReturnTop
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testSuperSendWith
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodeSuperSendWith super new: 0') selector.
	scanner := InstructionStream on: method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#new:. true. 1}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPushReceiverVariableBytecode
	| selector method scanner did |
	selector := (method := self compile2method: 'pushReceiverVariableBytecode instVar yourself') selector.
	scanner := InstructionStream on: method.
	self
		assert: ((did := scanner peekInstruction) selector == #pushReceiverVariable:
				and: [did arguments first == 2])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'compiling' stamp: 'MarcusDenker 9/5/2013 14:22'!
compile2method: sourceStream 
			"Compile code without logging the source in the changes file"
			^OpalCompiler new
						source: sourceStream;
						class: self class;			
						compile.
		! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testSuperSend
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodeSuperSend super yourself') selector.
	scanner := InstructionStream on: method.
	1
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#yourself. true. 0}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPushTemporaryVariableBytecode
	| selector method scanner did |
	selector := (method := self compile2method: 'pushTemporaryVariableBytecode: t0 t0 yourself') selector.
	scanner := InstructionStream on: method.
	self
		assert: ((did := scanner peekInstruction) selector == #pushTemporaryVariable:
				and: [did arguments first == 0])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testPrimGreaterThan
	| selector method scanner did |
	selector := (method := self compile2method: 'bytecodePrimGreaterThan 3 > 4') selector.
	scanner := InstructionStream on:  method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#>. false. 1}])
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'ClementBera 7/23/2014 12:21'!
testStoreIntoLiteralVariableBytecode
	| selector method scanner did |
	selector := (method := self compile2method: 'storeIntoLiteralVariableBytecode ^ (ClassVar := nil)') selector.
	scanner := InstructionStream on: method.
	self
		assert: (did := scanner nextInstruction; peekInstruction) selector == #storeIntoLiteralVariable:
		description: 'Failed ' , selector! !

!OCSourceCode2BytecodeTest methodsFor: 'tests' stamp: 'MarcusDenker 9/5/2013 14:22'!
testReturnNilBytecode
	| selector method scanner did |
	selector := (method := self compile2method: 'returnNilBytecode 3 + 4. ^ nil') selector.
	scanner := InstructionStream on: method.
	4
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #methodReturnConstant:
				and: [did arguments first isNil])
		description: 'Failed ' , selector! !

!OCSourceCodeChanged commentStamp: 'BenComan 3/6/2014 02:40'!
An OCSourceCodeChanged is used to pass corrected source code from OCUndeclaredVariableWarning back to OpalCompiler>>compile  so that parsing can be restarted,. Introduced to resolve Case 12954.!
!OCSourceCodeChanged methodsFor: 'accessing' stamp: 'BenComan 3/3/2014 09:06'!
newSourceCode: aString
	newSourceCode := aString! !

!OCSourceCodeChanged methodsFor: 'accessing' stamp: 'BenComan 3/3/2014 09:06'!
newSourceCode
	^newSourceCode! !

!OCSpecialVariable commentStamp: '<historical>'!
I model self, thisContext and super!
!OCSpecialVariable methodsFor: 'testing' stamp: 'MarcusDenker 4/9/2013 10:39'!
isUninitialized

	^ false! !

!OCSpecialVariable methodsFor: 'testing' stamp: 'MarcusDenker 9/3/2010 16:09'!
isContext
	^name = 'thisContext'! !

!OCSpecialVariable methodsFor: 'emitting' stamp: 'MarcusDenker 9/3/2010 15:46'!
emitStore: methodBuilder

	self shouldNotImplement! !

!OCSpecialVariable methodsFor: 'emitting' stamp: 'MarcusDenker 9/3/2010 16:15'!
emitValue: methodBuilder

	self isContext 
		ifTrue: [methodBuilder pushThisContext]
		ifFalse:[methodBuilder pushReceiver]
	! !

!OCSpecialVariable methodsFor: 'testing' stamp: 'MarcusDenker 9/3/2010 16:09'!
isSuper
	^name = 'super'! !

!OCSpecialVariable methodsFor: 'testing' stamp: 'MarcusDenker 9/3/2010 15:51'!
isSelf
	^name = 'self'! !

!OCSpecialVariable methodsFor: 'testing' stamp: 'NicolaiHess 8/24/2014 00:27'!
isWritable
	^ false! !

!OCSpecialVariable methodsFor: 'testing' stamp: 'MarcusDenker 4/16/2013 15:55'!
isSpecialVariable
	^true! !

!OCStoreIntoReadOnlyVariableError commentStamp: 'NicolaiHess 10/3/2014 21:25'!
Error when trying to assign to a non writeble Variable.
(method arguments). For backward compatibility this error does not signal if the compilation context is not  interactive.!
!OCStoreIntoReadOnlyVariableError methodsFor: 'signaling' stamp: 'NicolaiHess 10/3/2014 21:24'!
signal
	compilationContext interactive
		ifFalse: [ ^ self crTrace ].
	^ super signal! !

!OCStoreIntoReadOnlyVariableError methodsFor: 'accessing' stamp: 'NicolaiHess 10/3/2014 21:24'!
description
	"Return a textual description of the exception."

	^ String
		streamContents: [ :stream | 
			stream << super description asString.
			stream cr.
			stream << self methodClass asString.
			stream cr.
			stream << self methodNode asString ]! !

!OCStoreIntoSpecialVariableError commentStamp: 'NicolaiHess 10/3/2014 21:24'!
Error when trying to assign to a special Variable.
(like self ).!
!OCTempVariable commentStamp: 'MarcusDenker 8/11/2014 10:19'!
I model temp variables. With Closures, there are two kinds: Copying and those that are stores in a so called temp vector, a heap allocated array that itself is stored in an un-named copying temp variable.!
!OCTempVariable methodsFor: 'escaping' stamp: 'NicolaiHess 10/24/2014 00:07'!
markRepeatedWrite
	"same as write"
	self markWrite.
	super markRepeatedWrite.! !

!OCTempVariable methodsFor: 'escaping' stamp: 'NicolaiHess 10/24/2014 00:26'!
markEscapingWrite
	escaping := #escapingWrite.
	self isRepeatedWrite ifFalse:[usage := #write]! !

!OCTempVariable methodsFor: 'emitting' stamp: ''!
emitStore: methodBuilder

	methodBuilder storeTemp: name. ! !

!OCTempVariable methodsFor: '*SmartSuggestions' stamp: 'GiselaDecuzzi 5/22/2013 15:43'!
specialCommands
	^SugsSuggestionFactory commandsForTemporaryVariable.! !

!OCTempVariable methodsFor: 'comparing' stamp: 'MarcusDenker 11/16/2012 11:26'!
hash

	^ name hash bitXor: (usage hash bitXor: scope hash).! !

!OCTempVariable methodsFor: 'testing' stamp: 'NicolaiHess 8/24/2014 00:06'!
isWritable
	^ self isArg not! !

!OCTempVariable methodsFor: 'escaping' stamp: 'MarcusDenker 9/21/2010 16:22'!
isEscapingWrite
	^escaping = #escapingWrite
! !

!OCTempVariable methodsFor: 'debugging' stamp: 'GuillermoPolito 4/9/2015 17:38'!
readFromContext: aContext scope: contextScope
	"Usually the loop is useless, the first case with i = offset returns the correct result. 
	However, the loop is required for specific case as Debugger restart feature."

	^ aContext tempAt: (contextScope outerNotOptimizedScope node irInstruction indexForVarNamed: name)! !

!OCTempVariable methodsFor: 'escaping' stamp: 'MarcusDenker 9/21/2010 16:22'!
isEscapingRead
	^escaping = #escapingRead
! !

!OCTempVariable methodsFor: 'escaping' stamp: 'MarcusDenker 9/21/2010 18:06'!
markEscapingRead
	escaping = #escapingWrite ifFalse: [escaping := #escapingRead]! !

!OCTempVariable methodsFor: 'testing' stamp: ''!
isTempVectorTemp
	^false! !

!OCTempVariable methodsFor: 'debugging' stamp: 'GuillermoPolito 4/9/2015 15:58'!
writeFromContext: aContext scope: contextScope value: aValue
	
	"offset := contextScope outerOffsetTo: scope.
	contextForRead := aContext.
	offset timesRepeat: [contextForRead := contextForRead outerContext].
	"^aContext tempAt: self indexFromIR put: aValue! !

!OCTempVariable methodsFor: 'escaping' stamp: 'MarcusDenker 9/22/2010 11:04'!
escaping
	^escaping! !

!OCTempVariable methodsFor: 'initialization' stamp: 'MarcusDenker 9/5/2010 20:18'!
initialize
	super initialize.
	escaping := false.! !

!OCTempVariable methodsFor: 'comparing' stamp: 'MarcusDenker 11/16/2012 11:24'!
= aTempVar

	^aTempVar class = self class 
		and: [aTempVar scope = self scope 
		and: [aTempVar name = self name
		and: [aTempVar usage = self usage]]].

	! !

!OCTempVariable methodsFor: 'emitting' stamp: ''!
emitValue: methodBuilder

	methodBuilder pushTemp: name.! !

!OCTempVariable methodsFor: 'escaping' stamp: 'MarcusDenker 9/22/2010 11:04'!
escaping: anObject
	escaping := anObject! !

!OCTempVariable methodsFor: 'testing' stamp: 'ajh 6/23/2004 23:18'!
isTemp

	^ true! !

!OCTempVariable methodsFor: 'testing' stamp: 'MarcusDenker 9/9/2010 16:07'!
isCopying
	^false! !

!OCTempVariable methodsFor: 'escaping' stamp: 'MarcusDenker 5/18/2011 16:00'!
markWrite

	"if an escaping var is wrote to later, it needs to be remote"
	self isEscaping 
		ifTrue: [self markEscapingWrite].
	super markWrite.! !

!OCTempVariable methodsFor: 'escaping' stamp: 'MarcusDenker 9/21/2010 16:06'!
isEscaping
	^escaping = #escapingRead or: [escaping = #escapingWrite]! !

!OCTempVariable methodsFor: 'testing' stamp: 'MarcusDenker 11/15/2012 16:37'!
isStoringTempVector
	"I am a temp that stores a temp vector. Those generated temps have a invalid name starting with 0"
	^name first = $0.! !

!OCTempVariable methodsFor: 'debugging' stamp: 'GuillermoPolito 4/9/2015 17:52'!
searchFromContext: aContext scope: contextScope
	"Usually the loop is useless, the first case with i = offset returns the correct result. 
	However, the loop is required for specific case as Debugger restart feature."

	^ contextScope lookupVar: name inContext: aContext! !

!OCTempVariable methodsFor: 'debugging' stamp: 'GuillermoPolito 4/9/2015 15:58'!
indexFromIR

	^scope outerNotOptimizedScope node irInstruction indexForVarNamed: name! !

!OCUndeclaredVariable commentStamp: 'MarcusDenker 7/2/2014 14:27'!
I am a Variable that is not declared.

I am like a global an association, but instead of Smalltalk globals, I live in the Undeclared global dictionary.!
!OCUndeclaredVariable methodsFor: 'testing' stamp: 'MarcusDenker 6/14/2013 15:42'!
isUndeclared

	^ true! !

!OCUndeclaredVariable methodsFor: 'emitting' stamp: 'MarcusDenker 6/14/2013 15:36'!
emitStore: methodBuilder

	methodBuilder storeIntoLiteralVariable:  self assoc

! !

!OCUndeclaredVariable methodsFor: 'accessing' stamp: 'MarcusDenker 6/14/2013 15:33'!
name: anObject
	name := anObject! !

!OCUndeclaredVariable methodsFor: 'emitting' stamp: 'MarcusDenker 6/14/2013 15:36'!
emitValue: methodBuilder

	methodBuilder pushLiteralVariable: self assoc.
! !

!OCUndeclaredVariable methodsFor: 'accessing' stamp: 'MarcusDenker 6/14/2013 15:36'!
assoc
	^Undeclared associationAt: name! !

!OCUndeclaredVariable methodsFor: 'accessing' stamp: 'MarcusDenker 6/14/2013 15:33'!
name
	^ name! !

!OCUndeclaredVariableWarning commentStamp: '<historical>'!
I get signalled when a temporary variable is used that is not defined.  My default action is to create an Undeclared binding and add it to the Undeclared dictionary.!
!OCUndeclaredVariableWarning methodsFor: 'correcting' stamp: 'MarcusDenker 7/25/2014 17:04'!
declareClassVar

	self methodClass theNonMetaClass
		addClassVarNamed: node name asSymbol.
	^ self lookUpVariable! !

!OCUndeclaredVariableWarning methodsFor: 'correcting' stamp: 'MarcusDenker 7/25/2014 17:05'!
declareInstVar: name
	"Declare an instance variable."
	self methodClass addInstVarNamed: name.
	"We are changing a class after the scope hierarchy was created, so we need to update the
	Instance Scope"
	self methodNode scope instanceScope slots: self methodClass allSlots.
	^ self lookUpVariable! !

!OCUndeclaredVariableWarning methodsFor: 'correcting' stamp: 'MarcusDenker 7/9/2013 13:27'!
defaultAction
	| varName className selector |
	
 	className  :=  self methodClass name .
	selector := self methodNode selector. 
	varName := node name.

	self methodNode selector ifNotNil: [self crTrace: className, '>>', selector, ' ']
			ifNil: [self traceCr:''].
	self traceCr: '(' , varName , ' is Undeclared) '.

	^super defaultAction ifNil: [
		Undeclared at: varName asSymbol put: nil.
		OCUndeclaredVariable new name: varName asSymbol]! !

!OCUndeclaredVariableWarning methodsFor: 'correcting' stamp: 'MarcusDenker 5/17/2013 16:25'!
possibleVariablesFor: proposedVariable 
	| results class |
	class := node methodNode methodClass .
	
	results := proposedVariable correctAgainst: node temporaryVariables
								continuedFrom: nil.
	proposedVariable first canBeGlobalVarInitial ifTrue:
		[ results := class possibleVariablesFor: proposedVariable
						continuedFrom: results ].
	^ proposedVariable correctAgainst: nil continuedFrom: results.
! !

!OCUndeclaredVariableWarning methodsFor: 'correcting' stamp: 'BenComan 3/3/2014 09:17'!
openMenuIn: aBlock 
	| alternatives labels actions lines caption choice name interval |
	interval := node sourceInterval.
	name := node name.
	alternatives := self possibleVariablesFor: name.
	labels := OrderedCollection new.
	actions := OrderedCollection new.
	lines := OrderedCollection new.
	name first isLowercase 
		ifTrue: 
			[labels add: 'Declare new temporary variable'.
			actions add: [self declareTempAndPaste: name].
			labels add: 'Declare new instance variable'.
			actions add: [self declareInstVar: name]]
		ifFalse: 
			[labels add: 'Define new class'.
			actions add: [self defineClass: name].
			labels add: 'Declare new global'.
			actions add: [self declareGlobal].
			labels add: 'Declare new class variable'.
			actions add: [self declareClassVar]].
	lines add: labels size.
	alternatives do: 
		[:each | 
		labels add: each.
		actions add: 
		[	self substituteVariable: each atInterval: interval.
			(OCSourceCodeChanged new newSourceCode: self requestor text) signal.
		]].
	lines add: labels size.
	labels add: 'Cancel'.
	caption := 'Unknown variable: ' , name , ' please correct, or cancel:'.
	choice := aBlock value: labels value: lines value: caption.
	choice ifNotNil: [self resume: (actions at: choice ifAbsent: [compilationContext failBlock value]) value]! !

!OCUndeclaredVariableWarning methodsFor: 'correcting' stamp: 'NicolaiHess 9/10/2014 12:05'!
declareTempAndPaste: name
	| insertion delta theTextString characterBeforeMark tempsMark newMethodNode |

	"Below we are getting the text that is actually seen in the morph. This is rather ugly. Maybe there is a better way to do this."
	theTextString := self requestor textMorph editor paragraph text.

	"We parse again the method displayed in the morph. The variable methodNode has the first version of the method, without temporary declarations. "
	newMethodNode := RBParser parseMethod: theTextString.
	
	"We check if there is a declaration of temporary variables"
	tempsMark :=  newMethodNode body  rightBar ifNil: [ self methodNode body start ].	
	
	characterBeforeMark := theTextString at: tempsMark-1 ifAbsent: [$ ].

	(theTextString at: tempsMark) = $| ifTrue:  [
  		"Paste it before the second vertical bar"
		insertion := name, ' '.
		
		characterBeforeMark isSeparator ifFalse: [insertion := ' ', insertion].
		delta := 0.
	] ifFalse: [
		"No bars - insert some with CR, tab"
		insertion := '| ' , name , ' |',String cr.
		delta := 2.	"the bar and CR"
		characterBeforeMark = Character tab ifTrue: [
			insertion := insertion , String tab.
			delta := delta + 1.	"the tab" ]
		].
	tempsMark := tempsMark +
		(self substituteWord: insertion
			wordInterval: (tempsMark to: tempsMark-1)
			offset: 0) - delta.
	" we can not guess at this point where the tempvar should be stored,
	tempvars vs. tempvector therefore -> reparse"
	(OCSourceCodeChanged new newSourceCode: self requestor text) signal! !

!OCUndeclaredVariableWarning methodsFor: 'correcting' stamp: 'MarcusDenker 5/18/2013 16:27'!
defineClass: className 
	"Prompts the user to define a new class."
	
	| classSymbol systemCategory classDefinition |
	classSymbol := className asSymbol.
	systemCategory := self methodClass category
		ifNil: [ 'Unknown' ].
	classDefinition := 'Object subclass: #' , classSymbol , '
		instanceVariableNames: '''' 
		classVariableNames: ''''
		poolDictionaries: ''''
		category: ''' , systemCategory , ''''.
	classDefinition := UIManager default 
		multiLineRequest: 'Edit class definition:'
		initialAnswer: classDefinition
		answerHeight: 150.
	(classDefinition isNil or: [ classDefinition isEmpty ])
		ifTrue: [ ^ self error ].
	self class compiler evaluate: classDefinition.
	^ (node owningScope lookupVar: className)
		ifNil: [self error: 'should be not happen']! !

!OCUndeclaredVariableWarning methodsFor: 'correcting' stamp: 'MarcusDenker 7/25/2014 17:04'!
lookUpVariable
	^ (node owningScope lookupVar: node name)
		ifNil: [self error: 'should be found']! !

!OCUndeclaredVariableWarning methodsFor: 'accessing' stamp: 'MarcusDenker 5/17/2013 16:27'!
node: aVariableNode

	super node: aVariableNode.
	messageText := 'Undeclared temp: ', aVariableNode name.
! !

!OCUndeclaredVariableWarning methodsFor: 'correcting' stamp: 'MarcusDenker 7/25/2014 17:05'!
declareGlobal

	Smalltalk at: node name asSymbol put: nil.
	^self lookUpVariable! !

!OCUndeclaredVariableWarning methodsFor: 'correcting' stamp: 'MarcusDenker 5/17/2013 14:45'!
substituteWord: correctWord wordInterval: spot offset: o
	"Substitute the correctSelector into the (presuamed interactive) receiver."

	self requestor correctFrom: (spot first + o)
					to: (spot last + o)
					with: correctWord.

	^ o + correctWord size - spot size! !

!OCUndeclaredVariableWarning methodsFor: 'correcting' stamp: 'BenComan 3/3/2014 14:28'!
substituteVariable: varName atInterval: anInterval 
	self 
		substituteWord: varName
		wordInterval: anInterval
		offset: 0.
	self methodNode source: self requestor text.
	node replaceWith:((RBVariableNode named: varName) binding: (node owningScope lookupVar: varName)).
	^ (node owningScope lookupVar: varName)
		ifNil: [self error: 'should be found'].! !

!OCUninitializedVariableWarning commentStamp: 'ajh 3/24/2003 22:34'!
I get signalled when a temporary variable is used before it is assigned to.  My default action is to allow it since all temps get initialized to nil.!
!OCUninitializedVariableWarning methodsFor: 'correcting' stamp: 'NicolaiHess 2/5/2014 10:07'!
openMenuIn: aBlock
	| caption index |
	caption := node name, ' appears to be 
uninitialized at this point.
Proceed anyway?'.
	index := aBlock value: #('yes' 'no') value: #() value: caption.
	(index = 1) ifFalse:[^self compilationContext failBlock value].
	^ self resume: true.! !

!OCUninitializedVariableWarning methodsFor: 'accessing' stamp: 'MarcusDenker 5/17/2013 16:27'!
node: aVariableNode

	super node: aVariableNode.
	messageText := 'Uninitialized temp: ', aVariableNode name.
! !

!OCUnusedVariableWarning commentStamp: 'ajh 3/24/2003 22:35'!
I get signalled when a temporary variable is declared but never used.  My default action is to allow it since it is benign.!
!OCUnusedVariableWarning methodsFor: 'accessing' stamp: 'MarcusDenker 5/17/2013 16:27'!
node: aVariableNode
	
	super node: aVariableNode.
	messageText := 'Unused temp: ', aVariableNode name.
! !

!OCUnusedVariableWarning methodsFor: 'correcting' stamp: 'NicolaiHess 2/3/2014 21:44'!
defaultAction
	| answer |
	
	self errorNotification ifFalse: [ ^nil ].

	answer := UIManager default 
		chooseFrom: #('yes' 'no')
		lines: #() 
		title: node name asWideString, ' appears to be unused in this method. OK to remove it?' withCRs.
	
	(answer = 2 ) ifTrue: [ ^self].
      (answer = 0 ) ifTrue: [ self compilationContext failBlock value].
	self node parent scope removeTemp: (self node parent scope lookupVar:(node name)).
	self node parent removeTemporaryNamed: node name.
	self requestor correctFrom: node start to: node stop with: ''.

	
	
	
	
	
	
	
	
		
! !

!OCVectorTempVariable commentStamp: 'MarcusDenker 8/11/2014 10:20'!
I model a temp variable that is stored in a temp vector.!
!OCVectorTempVariable methodsFor: 'emitting' stamp: 'MarcusDenker 12/18/2012 16:42'!
emitStore: methodBuilder

	methodBuilder storeRemoteTemp: name inVector: vectorName.! !

!OCVectorTempVariable methodsFor: 'emitting' stamp: 'MarcusDenker 12/18/2012 16:42'!
emitValue: methodBuilder

	methodBuilder pushRemoteTemp: name inVector: vectorName.! !

!OCVectorTempVariable methodsFor: 'accessing' stamp: 'MarcusDenker 12/18/2012 16:43'!
vectorName: anObject
	vectorName := anObject! !

!OCVectorTempVariable methodsFor: 'testing' stamp: 'MarcusDenker 9/5/2010 17:13'!
isRemote
	^true! !

!OCVectorTempVariable methodsFor: 'accessing' stamp: 'MarcusDenker 12/18/2012 16:44'!
vectorName
	^ vectorName! !

!OCVectorTempVariable methodsFor: 'debugging' stamp: 'GuillermoPolito 4/9/2015 17:26'!
readFromContext: aContext scope: contextScope

	| offset pairVariableVector |
	pairVariableVector := contextScope lookupTempVector: vectorName inContext: aContext.
	offset := pairVariableVector first indexInTempVectorFromIR: name.
	^pairVariableVector second at: offset.! !

!OCVectorTempVariable methodsFor: 'testing' stamp: 'MarcusDenker 9/9/2010 16:11'!
isTempVectorTemp
	^true! !

!OCVectorTempVariable methodsFor: 'debugging' stamp: 'NicolaiHess 10/26/2014 01:27'!
writeFromContext: aContext scope: contextScope value: aValue
	| tempVectorVar theVector offset |
	tempVectorVar := contextScope lookupVar: vectorName.
	theVector := tempVectorVar readFromContext: aContext scope: tempVectorVar scope.
	offset := tempVectorVar indexInTempVectorFromIR: name.
	^theVector at: offset put: aValue.! !

!OCVectorTempVariable methodsFor: 'debugging' stamp: 'GuillermoPolito 4/9/2015 17:34'!
searchFromContext: aContext scope: contextScope

	| offset pairVariableVector |
	pairVariableVector := contextScope lookupTempVector: vectorName inContext: aContext.
	offset := pairVariableVector first indexInTempVectorFromIR: name.
	^pairVariableVector second at: offset.! !

!OCVectorTempVariable methodsFor: 'debugging' stamp: 'GuillermoPolito 4/9/2015 13:29'!
indexFromIR
	^scope methodScope node irInstruction indexForVarNamed: name! !

!OSButtonState commentStamp: 'IgorStasenko 7/30/2014 17:09'!
I am holding a set of mouse buttons state (pressed or not).
Used by various mouse events.!
!OSButtonState methodsFor: 'accessing' stamp: 'RonieSalgado 1/8/2014 13:23'!
button5
	^ (buttons & 16) ~=0! !

!OSButtonState methodsFor: 'accessing' stamp: 'RonieSalgado 1/8/2014 13:22'!
button1
	^ (buttons & 1) ~=0! !

!OSButtonState methodsFor: 'accessing' stamp: 'RonieSalgado 1/8/2014 13:24'!
button4: aBoolean
	self setBit: 8 value: aBoolean! !

!OSButtonState methodsFor: 'accessing' stamp: 'RonieSalgado 1/8/2014 13:22'!
button2
	^ (buttons & 2) ~=0! !

!OSButtonState methodsFor: 'accessing' stamp: 'RonieSalgado 1/8/2014 13:24'!
button5: aBoolean
	self setBit: 16 value: aBoolean! !

!OSButtonState methodsFor: 'accessing' stamp: 'RonieSalgado 1/8/2014 13:27'!
anyPressed
	^ buttons isZero not! !

!OSButtonState methodsFor: 'accessing' stamp: 'RonieSalgado 1/8/2014 13:24'!
button1: aBoolean
	self setBit: 1 value: aBoolean! !

!OSButtonState methodsFor: 'accessing' stamp: 'RonieSalgado 1/8/2014 13:23'!
button3
	^ (buttons & 4) ~=0! !

!OSButtonState methodsFor: 'initialization' stamp: 'RonieSalgado 1/8/2014 13:22'!
initialize
	buttons := 0! !

!OSButtonState methodsFor: 'private' stamp: 'RonieSalgado 1/8/2014 13:26'!
setBit: bit value: aBoolean
	
	buttons := buttons - (buttons bitAnd: bit) + (aBoolean ifTrue: [ bit  ] ifFalse: [ 0 ])! !

!OSButtonState methodsFor: 'accessing' stamp: 'RonieSalgado 1/8/2014 13:24'!
button3: aBoolean
	self setBit: 4 value: aBoolean! !

!OSButtonState methodsFor: 'accessing' stamp: 'RonieSalgado 1/8/2014 13:23'!
button4
	^ (buttons & 8) ~=0! !

!OSButtonState methodsFor: 'accessing' stamp: 'RonieSalgado 1/8/2014 13:24'!
button2: aBoolean
	self setBit: 2 value: aBoolean! !

!OSEnvironment commentStamp: '<historical>'!
I represent the user environment variables.
See  `man environ` for more details.!
!OSEnvironment methodsFor: 'accessing' stamp: 'CamilloBruni 4/29/2013 16:16'!
at: key ifAbsentPut: aBlock 
	"Return the value at the given key. 
	If key is not included in the receiver store the result 
	of evaluating aBlock as new value."

	^ self at: key ifAbsent: [ self at: key put: aBlock value ]! !

!OSEnvironment methodsFor: 'enumeration' stamp: 'CamilloBruni 4/29/2013 17:42'!
keysAndValuesDo: aBlock withAssociationString: associationString
	| equalsIndex |
	equalsIndex := associationString indexOf: $=.
	aBlock 
		value: (associationString first: equalsIndex-1) 
		value: (associationString allButFirst: equalsIndex).
		! !

!OSEnvironment methodsFor: 'private' stamp: 'CamilloBruni 4/29/2013 15:43'!
getEnv: string
	"This method calls the Standard C Library getenv() function"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode >
	 ^ self nbCall: #( String getenv (String string) ) module: NativeBoost CLibrary! !

!OSEnvironment methodsFor: 'private' stamp: 'CamilloBruni 4/29/2013 15:52'!
unsetEnv: string
	"This method calls the Standard C Library getenv() function"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode >
	 ^ self nbCall: #( int unsetenv (String string) ) module: NativeBoost CLibrary! !

!OSEnvironment methodsFor: 'accessing' stamp: 'CamilloBruni 4/29/2013 16:16'!
at: key ifPresent: oneArgBlock ifAbsent: absentBlock
	"Lookup the given key in the receiver. If it is present, answer the value of evaluating the oneArgBlock with the value associated with the key, otherwise answer the value of absentBlock."
	
	self at: key ifPresent: [ :v | ^oneArgBlock value: v ].
	^absentBlock value! !

!OSEnvironment methodsFor: 'accessing' stamp: 'CamilloBruni 4/29/2013 16:18'!
keys
	"Answer an Array containing the receiver's keys."
	
	^Array streamContents: [ :s | self keysDo: [ :key | s nextPut: key]]! !

!OSEnvironment methodsFor: 'accessing' stamp: 'CamilloBruni 5/4/2013 15:25'!
removeKey: key
	^ self unsetEnv: key! !

!OSEnvironment methodsFor: 'enumeration' stamp: 'CamilloBruni 4/29/2013 16:21'!
associationsDo: aBlock
	^ self keysAndValuesDo: [ :key :value |
		aBlock value: key -> value ]! !

!OSEnvironment methodsFor: 'testing' stamp: 'CamilloBruni 5/4/2013 15:27'!
includes: anObject

	self do: [:each | anObject = each ifTrue: [^true]].
	^false! !

!OSEnvironment methodsFor: 'enumeration' stamp: 'CamilloBruni 4/29/2013 16:21'!
keysDo: aBlock
	^ self keysAndValuesDo: [ :key :value |
		aBlock value: key ]! !

!OSEnvironment methodsFor: 'accessing' stamp: 'CamilloBruni 4/29/2013 16:50'!
platform
	^ platform! !

!OSEnvironment methodsFor: 'accessing' stamp: 'CamilloBruni 5/4/2013 15:29'!
at: aKey ifPresent: aBlock
	^ aBlock value: (self at: aKey ifAbsent: [ ^ nil ])! !

!OSEnvironment methodsFor: 'accessing' stamp: 'CamilloBrunui 5/6/2013 16:37'!
at: aKey put: aValue
	^ self setEnv: aKey value: aValue! !

!OSEnvironment methodsFor: 'accessing' stamp: 'CamilloBruni 4/29/2013 16:14'!
at: aKey
	^ self at: aKey ifAbsent: [ KeyNotFound signalFor: aKey ]! !

!OSEnvironment methodsFor: 'enumeration' stamp: 'CamilloBruni 5/4/2013 15:31'!
do: aBlock

	^self valuesDo: aBlock! !

!OSEnvironment methodsFor: 'accessing' stamp: 'CamilloBruni 4/29/2013 16:14'!
at: aKey ifAbsent: aBlock
	^ (self getEnv: aKey) ifNil: aBlock! !

!OSEnvironment methodsFor: 'enumeration' stamp: 'CamilloBruni 4/29/2013 16:22'!
valuesDo: aBlock
	^ self keysAndValuesDo: [ :key :value |
		aBlock value: value ]! !

!OSEnvironment methodsFor: 'converting' stamp: 'CamilloBruni 4/29/2013 16:24'!
asDictionary
	| dictionary |
	dictionary := Dictionary new.
	self keysAndValuesDo: [ :key :value |
		dictionary at: key put: value ].
	^ dictionary! !

!OSEnvironment methodsFor: 'accessing' stamp: 'CamilloBruni 4/29/2013 16:17'!
associations
	"Answer a Collection containing the receiver's associations."
	
	^Array streamContents: [ :stream |
		self associationsDo: [ :each | stream nextPut: each ]]! !

!OSEnvironment methodsFor: 'enumeration' stamp: 'CamilloBruni 4/29/2013 17:43'!
keysAndValuesDo: aBlock
	self subclassResponsibility! !

!OSEnvironment methodsFor: 'testing' stamp: 'CamilloBruni 5/4/2013 15:30'!
includesKey: aKey
	^ self at: aKey ifPresent: [ :value | true ] ifAbsent: [ false ].! !

!OSEnvironment methodsFor: 'initialize-release' stamp: 'CamilloBruni 4/29/2013 16:50'!
initializeWith: anOSPlatform
	super initialize.
	platform := anOSPlatform! !

!OSEnvironment methodsFor: 'accessing' stamp: 'CamilloBruni 4/29/2013 16:19'!
values
	"Answer a Collection containing the receiver's values."
	^ Array streamContents: [ :stream|
		self valuesDo: [ :value | stream nextPut: value ]]! !

!OSEnvironment class methodsFor: 'testing' stamp: 'EstebanLorenzano 1/24/2014 16:38'!
isDefaultFor: aPlatform
	^ false! !

!OSEnvironment class methodsFor: 'instance creation' stamp: 'CamilloBruni 4/29/2013 15:47'!
default
	^ self new! !

!OSEnvironment class methodsFor: 'testing' stamp: 'EstebanLorenzano 1/24/2014 16:38'!
isAvailable
	^ NativeBoost isAvailable! !

!OSEnvironment class methodsFor: 'accessing' stamp: 'EstebanLorenzano 1/24/2014 16:37'!
environmentFor: aPlatform
	| environmentClass |
	
	environmentClass := self allSubclasses
		detect: [ :each | each isDefaultFor: aPlatform ]
		ifNone: [ nil ].
		
	^ (environmentClass notNil and: [ environmentClass isAvailable  ])  
		ifTrue: [ environmentClass platform: aPlatform ]
		ifFalse: [ PlatformIndependentEnvironment platform: aPlatform ]! !

!OSEnvironment class methodsFor: 'instance creation' stamp: 'CamilloBruni 4/29/2013 16:50'!
platform: anOSPlatform
	^ self basicNew initializeWith: anOSPlatform ! !

!OSEnvironmentTest commentStamp: '<historical>'!
This tests the OSEnvironment. The tests assume that there is at least 1 environment variable given.!
!OSEnvironmentTest methodsFor: 'tests' stamp: 'CamilloBruni 5/4/2013 15:25'!
testAtPut
	| key value env |
	
	env := self instance.
	value := 1000 atRandom asString.
	key := 'OSEnvironmentTest >> #testAtPut >> ', value.
	
	env at: key put: value.
	self assert: (env at: key) equals: value.
	
	env removeKey: key.
	self deny: (env includesKey: key)! !

!OSEnvironmentTest methodsFor: 'tests' stamp: 'CamilloBruni 5/4/2013 15:24'!
testAssociations
	| associations |
	associations := self instance associations.
	self deny: associations isEmpty.
	self assert: associations anyOne key isString.
	self assert: associations anyOne value isString.! !

!OSEnvironmentTest methodsFor: 'helper' stamp: 'cami 7/22/2013 18:17'!
instance
	^ Smalltalk os environment! !

!OSEnvironmentTest methodsFor: 'tests' stamp: 'CamilloBruni 5/4/2013 15:28'!
testKeys
	| env keys |
	
	env := self instance.
	keys := env keys.
	
	self deny: keys isEmpty.
	self assert: keys anyOne isString.
	self assert: (env includesKey: keys anyOne)! !

!OSEnvironmentTest methodsFor: 'tests' stamp: 'PavelKrivanek 7/17/2014 13:10'!
testEnvironmentFor
	
	| compareDictionary |
	
	compareDictionary := ((Smalltalk hasClassNamed: #UnixEnvironment) and: [Smalltalk hasClassNamed: #Win32Environment])
		ifTrue: [ "NativeBoost is present in the image"
			{ 	MacOSPlatform -> #UnixEnvironment. 
	 		  	MacOSXPlatform -> #UnixEnvironment. 
				UnixPlatform -> #UnixEnvironment. 
				Win32Platform -> #Win32Environment  } asDictionary ]
		ifFalse: [ "NativeBoost is NOT present in the image"
			{ 	MacOSPlatform -> #PlatformIndependentEnvironment. 
	 		  	MacOSXPlatform -> #PlatformIndependentEnvironment. 
				UnixPlatform -> #PlatformIndependentEnvironment. 
				Win32Platform -> #PlatformIndependentEnvironment  } asDictionary ].

	compareDictionary keysAndValuesDo: [ :platformClass :envClassName |
		self 
			assert:  (OSEnvironment environmentFor: platformClass new) class name
			equals: envClassName ] ! !

!OSEnvironmentTest methodsFor: 'tests' stamp: 'CamilloBruni 5/4/2013 15:30'!
testValues
	| env values |
	
	env := self instance.
	values := env values.
	
	self deny: values isEmpty.
	self assert: values anyOne isString.
	self assert: (env includes: values anyOne)! !

!OSEnvironmentTest methodsFor: 'tests' stamp: 'CamilloBruni 5/4/2013 15:19'!
testAsDictionary
	self assert: self instance asDictionary isDictionary! !

!OSEvent commentStamp: 'IgorStasenko 7/30/2014 17:13'!
I am a basic class of OSEvent hierarchy.
The specific events are coming from operating system and converted to corresponding OSEvent subinstance(s) in order to handle them.

Events can implement a default action, which will be performed after dispatch on event handling,
unless they are suppressed using #suppressDefaultAction message.!
!OSEvent methodsFor: 'dispatching' stamp: 'RonieSalgado 1/7/2014 16:37'!
deliver
	"deliver an event to its handler(s)"
	
	^ window deliverEvent: self! !

!OSEvent methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 16:40'!
window: anOSWindow 
	window := anOSWindow! !

!OSEvent methodsFor: 'initialization' stamp: 'RonieSalgado 1/7/2014 16:42'!
initialize
	suppressDefaultAction := false! !

!OSEvent methodsFor: 'default actions' stamp: 'RonieSalgado 1/7/2014 16:45'!
defaultAction
	"do nothing by default"! !

!OSEvent methodsFor: 'visitor' stamp: 'RonieSalgado 1/7/2014 15:32'!
accept: aVisitor
	self subclassResponsibility ! !

!OSEvent methodsFor: 'default actions' stamp: 'RonieSalgado 1/7/2014 16:45'!
performDefaultAction
	suppressDefaultAction ifFalse: [  self defaultAction ]! !

!OSEvent methodsFor: 'default actions' stamp: 'RonieSalgado 1/7/2014 16:43'!
suppressDefaultAction 
	suppressDefaultAction  := true! !

!OSEvent class methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 1/7/2014 16:36'!
for: aWindow
	^ self new window: aWindow; yourself! !

!OSKeyDownEvent commentStamp: 'IgorStasenko 7/30/2014 17:14'!
This event is delivered when user pressing down a key!
!OSKeyDownEvent methodsFor: 'visitor' stamp: 'RonieSalgado 1/7/2014 17:26'!
accept: aVisitor
	^ aVisitor visitKeyDownEvent: self! !

!OSKeySymbols commentStamp: 'RonieSalgado 5/15/2014 23:22'!
This pool contains all the platform independent key symbols. They are the same used by SDL2 to avoid having to perform any kind of translation.!
!OSKeySymbols class methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 5/15/2014 23:23'!
initializeKeycodes2
	OSK_CAPSLOCK	:= 16r40000039.
	OSK_F1	:= 16r4000003A.
	OSK_F2	:= 16r4000003B.
	OSK_F3	:= 16r4000003C.
	OSK_F4	:= 16r4000003D.
	OSK_F5	:= 16r4000003E.
	OSK_F6	:= 16r4000003F.
	OSK_F7	:= 16r40000040.
	OSK_F8	:= 16r40000041.
	OSK_F9	:= 16r40000042.
	OSK_F10	:= 16r40000043.
	OSK_F11	:= 16r40000044.
	OSK_F12	:= 16r40000045.
	OSK_PRINTSCREEN	:= 16r40000046.
	OSK_SCROLLLOCK	:= 16r40000047.
	OSK_PAUSE	:= 16r40000048.
	OSK_INSERT	:= 16r40000049.
	OSK_HOME	:= 16r4000004A.
	OSK_PAGEUP	:= 16r4000004B.
	OSK_DELETE	:= 16r007F.
	OSK_END	:= 16r4000004D.
	OSK_PAGEDOWN	:= 16r4000004E.
	OSK_RIGHT	:= 16r4000004F.
	OSK_LEFT	:= 16r40000050.
	OSK_DOWN	:= 16r40000051.
	OSK_UP	:= 16r40000052.
	OSK_NUMLOCKCLEAR	:= 16r40000053.
	OSK_KP_DIVIDE	:= 16r40000054.
	OSK_KP_MULTIPLY	:= 16r40000055.
	OSK_KP_MINUS	:= 16r40000056.
	OSK_KP_PLUS	:= 16r40000057.
	OSK_KP_ENTER	:= 16r40000058.
	OSK_KP_1	:= 16r40000059.
	OSK_KP_2	:= 16r4000005A.
	OSK_KP_3	:= 16r4000005B.
	OSK_KP_4	:= 16r4000005C.
	OSK_KP_5	:= 16r4000005D.
	OSK_KP_6	:= 16r4000005E.
	OSK_KP_7	:= 16r4000005F.
	OSK_KP_8	:= 16r40000060.
	OSK_KP_9	:= 16r40000061.
	OSK_KP_0	:= 16r40000062.
	OSK_KP_PERIOD	:= 16r40000063.
	OSK_APPLICATION	:= 16r40000065.
	OSK_POWER	:= 16r40000066.
	OSK_KP_EQUALS	:= 16r40000067.
	OSK_F13	:= 16r40000068.
	OSK_F14	:= 16r40000069.
	OSK_F15	:= 16r4000006A.
	OSK_F16	:= 16r4000006B.
	OSK_F17	:= 16r4000006C.
	OSK_F18	:= 16r4000006D.
	OSK_F19	:= 16r4000006E.
	OSK_F20	:= 16r4000006F.
	OSK_F21	:= 16r40000070.
	OSK_F22	:= 16r40000071.
	OSK_F23	:= 16r40000072.
	OSK_F24	:= 16r40000073.
	OSK_EXECUTE	:= 16r40000074.
	OSK_HELP	:= 16r40000075.
	OSK_MENU	:= 16r40000076.
	OSK_SELECT	:= 16r40000077.
	OSK_STOP	:= 16r40000078.
	OSK_AGAIN	:= 16r40000079.
	OSK_UNDO	:= 16r4000007A.
	OSK_CUT	:= 16r4000007B.
	OSK_COPY	:= 16r4000007C.
	OSK_PASTE	:= 16r4000007D.
	OSK_FIND	:= 16r4000007E.
	OSK_MUTE	:= 16r4000007F.
	OSK_VOLUMEUP	:= 16r40000080.
	OSK_VOLUMEDOWN	:= 16r40000081.
	OSK_KP_COMMA	:= 16r40000085.
	OSK_KP_EQUALSAS400	:= 16r40000086.! !

!OSKeySymbols class methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 5/15/2014 23:52'!
initialize
	"
	self initialize
	"
	self initializeKeycodes.
	self initializeKeycodes2.
	self initializeKeycodes3.! !

!OSKeySymbols class methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 5/15/2014 23:22'!
initializeKeycodes
	OSK_UNKNOWN	:= 16r0000.
	OSK_RETURN	:= 16r000D.
	OSK_ESCAPE	:= 16r001B.
	OSK_BACKSPACE	:= 16r0008.
	OSK_TAB	:= 16r0009.
	OSK_SPACE	:= 16r0020.
	OSK_EXCLAIM	:= 16r0021.
	OSK_QUOTEDBL	:= 16r0022.
	OSK_HASH	:= 16r0023.
	OSK_PERCENT	:= 16r0025.
	OSK_DOLLAR	:= 16r0024.
	OSK_AMPERSAND	:= 16r0026.
	OSK_QUOTE	:= 16r0027.
	OSK_LEFTPAREN	:= 16r0028.
	OSK_RIGHTPAREN	:= 16r0029.
	OSK_ASTERISK	:= 16r002A.
	OSK_PLUS	:= 16r002B.
	OSK_COMMA	:= 16r002C.
	OSK_MINUS	:= 16r002D.
	OSK_PERIOD	:= 16r002E.
	OSK_SLASH	:= 16r002F.
	OSK_0	:= 16r0030.
	OSK_1	:= 16r0031.
	OSK_2	:= 16r0032.
	OSK_3	:= 16r0033.
	OSK_4	:= 16r0034.
	OSK_5	:= 16r0035.
	OSK_6	:= 16r0036.
	OSK_7	:= 16r0037.
	OSK_8	:= 16r0038.
	OSK_9	:= 16r0039.
	OSK_COLON	:= 16r003A.
	OSK_SEMICOLON	:= 16r003B.
	OSK_LESS	:= 16r003C.
	OSK_EQUALS	:= 16r003D.
	OSK_GREATER	:= 16r003E.
	OSK_QUESTION	:= 16r003F.
	OSK_AT	:= 16r0040.
	OSK_LEFTBRACKET	:= 16r005B.
	OSK_BACKSLASH	:= 16r005C.
	OSK_RIGHTBRACKET	:= 16r005D.
	OSK_CARET	:= 16r005E.
	OSK_UNDERSCORE	:= 16r005F.
	OSK_BACKQUOTE	:= 16r0060.
	OSK_a	:= 16r0061.
	OSK_b	:= 16r0062.
	OSK_c	:= 16r0063.
	OSK_d	:= 16r0064.
	OSK_e	:= 16r0065.
	OSK_f	:= 16r0066.
	OSK_g	:= 16r0067.
	OSK_h	:= 16r0068.
	OSK_i	:= 16r0069.
	OSK_j	:= 16r006A.
	OSK_k	:= 16r006B.
	OSK_l	:= 16r006C.
	OSK_m	:= 16r006D.
	OSK_n	:= 16r006E.
	OSK_o	:= 16r006F.
	OSK_p	:= 16r0070.
	OSK_q	:= 16r0071.
	OSK_r	:= 16r0072.
	OSK_s	:= 16r0073.
	OSK_t	:= 16r0074.
	OSK_u	:= 16r0075.
	OSK_v	:= 16r0076.
	OSK_w	:= 16r0077.
	OSK_x	:= 16r0078.
	OSK_y	:= 16r0079.
	OSK_z	:= 16r007A.! !

!OSKeySymbols class methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 5/15/2014 23:51'!
initializeKeycodes3
	OSK_ALTERASE	:= 16r40000099.
	OSK_SYSREQ	:= 16r4000009A.
	OSK_CANCEL	:= 16r4000009B.
	OSK_CLEAR	:= 16r4000009C.
	OSK_PRIOR	:= 16r4000009D.
	OSK_RETURN2	:= 16r4000009E.
	OSK_SEPARATOR	:= 16r4000009F.
	OSK_OUT	:= 16r400000A0.
	OSK_OPER	:= 16r400000A1.
	OSK_CLEARAGAIN	:= 16r400000A2.
	OSK_CRSEL	:= 16r400000A3.
	OSK_EXSEL	:= 16r400000A4.
	OSK_KP_00	:= 16r400000B0.
	OSK_KP_000	:= 16r400000B1.
	OSK_THOUSANDSSEPARATOR	:= 16r400000B2.
	OSK_DECIMALSEPARATOR	:= 16r400000B3.
	OSK_CURRENCYUNIT	:= 16r400000B4.
	OSK_CURRENCYSUBUNIT	:= 16r400000B5.
	OSK_KP_LEFTPAREN	:= 16r400000B6.
	OSK_KP_RIGHTPAREN	:= 16r400000B7.
	OSK_KP_LEFTBRACE	:= 16r400000B8.
	OSK_KP_RIGHTBRACE	:= 16r400000B9.
	OSK_KP_TAB	:= 16r400000BA.
	OSK_KP_BACKSPACE	:= 16r400000BB.
	OSK_KP_A	:= 16r400000BC.
	OSK_KP_B	:= 16r400000BD.
	OSK_KP_C	:= 16r400000BE.
	OSK_KP_D	:= 16r400000BF.
	OSK_KP_E	:= 16r400000C0.
	OSK_KP_F	:= 16r400000C1.
	OSK_KP_XOR	:= 16r400000C2.
	OSK_KP_POWER	:= 16r400000C3.
	OSK_KP_PERCENT	:= 16r400000C4.
	OSK_KP_LESS	:= 16r400000C5.
	OSK_KP_GREATER	:= 16r400000C6.
	OSK_KP_AMPERSAND	:= 16r400000C7.
	OSK_KP_DBLAMPERSAND	:= 16r400000C8.
	OSK_KP_VERTICALBAR	:= 16r400000C9.
	OSK_KP_DBLVERTICALBAR	:= 16r400000CA.
	OSK_KP_COLON	:= 16r400000CB.
	OSK_KP_HASH	:= 16r400000CC.
	OSK_KP_SPACE	:= 16r400000CD.
	OSK_KP_AT	:= 16r400000CE.
	OSK_KP_EXCLAM	:= 16r400000CF.
	OSK_KP_MEMSTORE	:= 16r400000D0.
	OSK_KP_MEMRECALL	:= 16r400000D1.
	OSK_KP_MEMCLEAR	:= 16r400000D2.
	OSK_KP_MEMADD	:= 16r400000D3.
	OSK_KP_MEMSUBTRACT	:= 16r400000D4.
	OSK_KP_MEMMULTIPLY	:= 16r400000D5.
	OSK_KP_MEMDIVIDE	:= 16r400000D6.
	OSK_KP_PLUSMINUS	:= 16r400000D7.
	OSK_KP_CLEAR	:= 16r400000D8.
	OSK_KP_CLEARENTRY	:= 16r400000D9.
	OSK_KP_BINARY	:= 16r400000DA.
	OSK_KP_OCTAL	:= 16r400000DB.
	OSK_KP_DECIMAL	:= 16r400000DC.
	OSK_KP_HEXADECIMAL	:= 16r400000DD.
	OSK_LCTRL	:= 16r400000E0.
	OSK_LSHIFT	:= 16r400000E1.
	OSK_LALT	:= 16r400000E2.
	OSK_LGUI	:= 16r400000E3.
	OSK_RCTRL	:= 16r400000E4.
	OSK_RSHIFT	:= 16r400000E5.
	OSK_RALT	:= 16r400000E6.
	OSK_RGUI	:= 16r400000E7.
	OSK_MODE	:= 16r40000101.
	OSK_AUDIONEXT	:= 16r40000102.
	OSK_AUDIOPREV	:= 16r40000103.
	OSK_AUDIOSTOP	:= 16r40000104.
	OSK_AUDIOPLAY	:= 16r40000105.
	OSK_AUDIOMUTE	:= 16r40000106.
	OSK_MEDIASELECT	:= 16r40000107.
	OSK_WWW	:= 16r40000108.
	OSK_MAIL	:= 16r40000109.
	OSK_CALCULATOR	:= 16r4000010A.
	OSK_COMPUTER	:= 16r4000010B.
	OSK_AC_SEARCH	:= 16r4000010C.
	OSK_AC_HOME	:= 16r4000010D.
	OSK_AC_BACK	:= 16r4000010E.
	OSK_AC_FORWARD	:= 16r4000010F.
	OSK_AC_STOP	:= 16r40000110.
	OSK_AC_REFRESH	:= 16r40000111.
	OSK_AC_BOOKMARKS	:= 16r40000112.
	OSK_BRIGHTNESSDOWN	:= 16r40000113.
	OSK_BRIGHTNESSUP	:= 16r40000114.
	OSK_DISPLAYSWITCH	:= 16r40000115.
	OSK_KBDILLUMTOGGLE	:= 16r40000116.
	OSK_KBDILLUMDOWN	:= 16r40000117.
	OSK_KBDILLUMUP	:= 16r40000118.
	OSK_EJECT	:= 16r40000119.
	OSK_SLEEP	:= 16r4000011A.! !

!OSKeyUpEvent commentStamp: 'IgorStasenko 7/30/2014 17:15'!
This event is delivered when user releases previously pressed key!
!OSKeyUpEvent methodsFor: 'visitor' stamp: 'RonieSalgado 1/7/2014 17:26'!
accept: aVisitor
	^ aVisitor visitKeyUpEvent: self! !

!OSKeyboardEvent commentStamp: 'IgorStasenko 7/30/2014 17:19'!
i am the root of keyboard events hierarchy.

The scan code represents an unique number identifying a key and comes directly from OS.
Some keys can be directly translated to corresponding character(s) by OS and thus such events will carry character ~= nil. !
!OSKeyboardEvent methodsFor: 'accessing' stamp: 'RonieSalgado 1/8/2014 16:50'!
symbol
	
	^ symbol! !

!OSKeyboardEvent methodsFor: 'initialization' stamp: 'RonieSalgado 1/8/2014 16:59'!
initialize
	super initialize.
	modifiers := OSStateModifiers new.! !

!OSKeyboardEvent methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:27'!
scanCode
	
	^ scanCode! !

!OSKeyboardEvent methodsFor: 'accessing' stamp: 'RonieSalgado 1/8/2014 17:26'!
characterCode
	"answer the unicode value"
	
	^ character ifNil: [0] ifNotNil: [ character charCode ] ! !

!OSKeyboardEvent methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:27'!
character
	
	^ character! !

!OSKeyboardEvent methodsFor: 'accessing' stamp: 'RonieSalgado 1/8/2014 17:08'!
printOn: stream
	super printOn: stream.
	stream space; nextPutAll: 'scanCode: '; print: scanCode.
	stream space; nextPutAll: 'symbol '; print: symbol.
	stream space; nextPutAll: 'character '; print: character! !

!OSKeyboardEvent methodsFor: 'accessing' stamp: 'RonieSalgado 1/8/2014 17:17'!
position
	
	^ position! !

!OSKeyboardEvent methodsFor: 'accessing' stamp: 'RonieSalgado 1/8/2014 16:50'!
symbol: anObject
	
	symbol := anObject! !

!OSKeyboardEvent methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:27'!
character: anObject
	
	character := anObject! !

!OSKeyboardEvent methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:27'!
scanCode: anObject
	
	scanCode := anObject! !

!OSKeyboardEvent methodsFor: 'accessing' stamp: 'RonieSalgado 1/8/2014 17:17'!
position: anObject
	
	position := anObject! !

!OSKeyboardEvent methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:27'!
modifiers
	
	^ modifiers! !

!OSMouseButtonEvent commentStamp: 'IgorStasenko 7/30/2014 17:22'!
i am the root of various mouse button events.!
!OSMouseButtonEvent methodsFor: 'printing' stamp: 'RonieSalgado 1/8/2014 13:04'!
printOn: stream
	super printOn: stream.
	stream space; nextPutAll: button asString! !

!OSMouseButtonEvent methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 16:58'!
button
	
	^ button! !

!OSMouseButtonEvent methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 16:58'!
button: anObject
	
	button := anObject! !

!OSMouseButtonPressEvent commentStamp: 'IgorStasenko 7/30/2014 17:23'!
i am delivered when user presses a mouse button!
!OSMouseButtonPressEvent methodsFor: 'visitor' stamp: 'RonieSalgado 1/7/2014 17:26'!
accept: aVisitor
	^ aVisitor visitMouseButtonPressEvent: self! !

!OSMouseButtonReleaseEvent commentStamp: 'IgorStasenko 7/30/2014 17:23'!
i am delivered when user releases a mouse button!
!OSMouseButtonReleaseEvent methodsFor: 'visitor' stamp: 'RonieSalgado 1/7/2014 17:27'!
accept: aVisitor
	^ aVisitor visitMouseButtonReleaseEvent: self! !

!OSMouseEvent commentStamp: 'IgorStasenko 7/30/2014 17:39'!
i am the root of various mouse events.

Note, that my subclasses care to represent only the most basic events, not the synthethic ones, like click or double-click, which are result of interpreting the sequence of raw events.!
!OSMouseEvent methodsFor: 'initialize' stamp: 'RonieSalgado 1/8/2014 13:47'!
initialize
	super initialize.
	modifiers := OSStateModifiers new! !

!OSMouseEvent methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 16:58'!
delta: anObject
	
	delta := anObject! !

!OSMouseEvent methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 16:58'!
position
	
	^ position! !

!OSMouseEvent methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 16:58'!
delta
	
	^ delta! !

!OSMouseEvent methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 16:58'!
position: anObject
	
	position := anObject! !

!OSMouseEvent methodsFor: 'accessing' stamp: 'RonieSalgado 1/8/2014 13:32'!
buttons
	^ modifiers buttons! !

!OSMouseEvent methodsFor: 'accessing' stamp: 'RonieSalgado 1/8/2014 13:30'!
modifiers
	^ modifiers ! !

!OSMouseMoveEvent commentStamp: 'IgorStasenko 7/30/2014 17:23'!
i am delivered when user moves a mouse!
!OSMouseMoveEvent methodsFor: 'visitor' stamp: 'RonieSalgado 1/7/2014 17:23'!
accept: aVisitor
	^ aVisitor visitMouseMoveEvent: self! !

!OSMouseWheelEvent commentStamp: 'IgorStasenko 7/30/2014 17:23'!
i am delivered when user scrolling the mouse wheel!
!OSMouseWheelEvent methodsFor: 'accessing' stamp: 'RonieSalgado 5/8/2014 20:29'!
scrollHorizontal
	
	^ scrollHorizontal! !

!OSMouseWheelEvent methodsFor: 'accessing' stamp: 'RonieSalgado 5/8/2014 20:29'!
scrollVertical: anObject
	
	scrollVertical := anObject! !

!OSMouseWheelEvent methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 5/8/2014 20:29'!
accept: aVisitor
	^ aVisitor visitMouseWheelEvent: self! !

!OSMouseWheelEvent methodsFor: 'accessing' stamp: 'RonieSalgado 5/8/2014 20:29'!
scrollVertical
	
	^ scrollVertical! !

!OSMouseWheelEvent methodsFor: 'accessing' stamp: 'RonieSalgado 5/8/2014 20:29'!
scrollHorizontal: anObject
	
	scrollHorizontal := anObject! !

!OSNullFormRenderer commentStamp: 'IgorStasenko 7/30/2014 17:02'!
i just a stub for rendering nothing , so that all update requests (like from Morhpic), are simply ignored!
!OSNullFormRenderer methodsFor: 'updating screen' stamp: 'RonieSalgado 5/8/2014 20:54'!
updateRectangle: aRectangle
	"Do nothing"! !

!OSNullFormRenderer methodsFor: 'updating screen' stamp: 'RonieSalgado 5/8/2014 20:54'!
updateAll
	"Do nothing"! !

!OSNullFormRenderer methodsFor: 'size' stamp: 'RonieSalgado 5/8/2014 20:53'!
newExtent: anExtent! !

!OSNullFormRenderer methodsFor: 'morphic integration' stamp: 'RonieSalgado 5/8/2014 20:54'!
updateAreas: allDamage immediate: forceToScreen
	"Do Nothing"! !

!OSNullWindowDriver commentStamp: 'IgorStasenko 7/30/2014 16:37'!
I provide a mock (or null) driver, which can create a valid OSWindow instances, despite the fact that underlaying OS may not support any notion of windows or even graphical user interface.

I can be used for testing (by picking as a preferrable driver in window attributes),
or as a default driver while running image in headless mode.

Using null driver allows most of the code which relies on existance of at least single main window to work flawlessly, by simply ignoring all requests/commands passed to it.!
!OSNullWindowDriver methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 1/7/2014 16:32'!
createWindowWithAttributes: anOSWindowAttributes osWindow: osWindow
	^ OSNullWindowHandle fromAttributes: anOSWindowAttributes for: osWindow! !

!OSNullWindowDriver methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 1/15/2014 14:50'!
isNullDriver
	^ true! !

!OSNullWindowDriver class methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 1/15/2014 14:46'!
isSupported
	"Yep, i am always supported"
	^ true! !

!OSNullWindowHandle commentStamp: 'IgorStasenko 7/30/2014 16:41'!
i am a handle for null window , created using OSNullWindowDriver.!
!OSNullWindowHandle methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 1/2/2014 09:40'!
extent
	^ attributes extent! !

!OSNullWindowHandle methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 1/2/2014 09:38'!
isValid
	^ true! !

!OSNullWindowHandle methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 1/2/2014 09:39'!
extent: newExtent
	attributes extent: newExtent! !

!OSNullWindowHandle methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 5/8/2014 20:55'!
newFormRenderer: form
	^ renderer := OSNullFormRenderer new form: form! !

!OSNullWindowHandle methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 1/2/2014 09:42'!
destroy! !

!OSNullWindowHandle methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 1/2/2014 09:35'!
attributes: newAttributes
	attributes := newAttributes! !

!OSNullWindowHandle class methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 1/10/2014 15:09'!
fromAttributes: attributes for: anOSWindow 
	^ self new attributes: attributes! !

!OSPlatform commentStamp: 'michael.rueger 2/25/2009 18:29'!
An OSPlatform is an abstract representation of a 'OS platform'.
Platforms can be hierarchical, e.g., a "general" platform as superclass and more specific platforms as subclasses as long as the subclasses provide sufficient means to identify themselves.
The original implementation was for Tweak.

Current		holds the current OSPlatform subclass

Architectural considerations:
most platform specific methods that need to be added to the platform class should be in the form of extensions rather then adding them directly to this package. Otherwise the platform class will degenerate very quickly into a dependence hub for all kinds of sub systems.!
!OSPlatform methodsFor: '*System-Clipboard' stamp: 'AlainPlantec 3/2/2010 14:41'!
clipboardClass
	^Clipboard! !

!OSPlatform methodsFor: 'initialize' stamp: 'VeronicaUquillas 6/11/2010 14:40'!
startUp: resuming
	"Pharo is starting up. If this platform requires specific intialization, this is a great place to put it."
! !

!OSPlatform methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/12/2013 14:16'!
lineEnding

	^ self subclassResponsibility! !

!OSPlatform methodsFor: 'compatbility' stamp: 'cami 7/22/2013 18:33'!
platformFamily
	^ self family! !

!OSPlatform methodsFor: 'accessing' stamp: 'CamilloBruni 5/9/2013 22:40'!
version
	"Return the version number string of the platform we're running on"

	^ self class currentVersion! !

!OSPlatform methodsFor: 'private' stamp: 'EstebanLorenzano 1/24/2014 16:38'!
createEnvironment
	^ OSEnvironment environmentFor: self! !

!OSPlatform methodsFor: 'testing' stamp: 'CamilloBruni 5/9/2013 22:25'!
isMacOSX
	^ false! !

!OSPlatform methodsFor: 'testing' stamp: 'cami 7/22/2013 18:27'!
isWindows
	^ false! !

!OSPlatform methodsFor: 'accessing' stamp: 'EstebanLorenzano 1/24/2014 16:39'!
environment
	^ environment ifNil: [ environment := self createEnvironment ]! !

!OSPlatform methodsFor: 'testing' stamp: 'CamilloBruni 5/9/2013 22:25'!
isMacOS
	^ false! !

!OSPlatform methodsFor: '*Glamour-Core' stamp: 'EstebanLorenzano 12/10/2014 22:44'!
menuShortcutModifierString
	^ self subclassResponsibility! !

!OSPlatform methodsFor: 'accessing' stamp: 'cami 7/22/2013 18:33'!
family
	"Returns a symbol specific to the platform family (MacOSX, Windows, Unix, RiscOS).
	This may need to be extended if there are new platforms added or significant differences within a platform family arise (as was the case between MacOS 9 and X)."

	self subclassResponsibility! !

!OSPlatform methodsFor: 'accessing' stamp: 'CamilloBruni 5/9/2013 22:22'!
subtype
	"Return the subType of the platform we're running on"

	^ (Smalltalk vm getSystemAttribute: 1003)! !

!OSPlatform methodsFor: '*Files' stamp: 'DamienCassou 11/7/2013 16:18'!
potentialLocationsOfSourcesFile
	"Return a collection of directories where the PharoVXX.sources should be searched."
	^ self subclassResponsibility! !

!OSPlatform methodsFor: 'accessing' stamp: 'CamilloBruni 5/9/2013 22:32'!
virtualKey: virtualKeyCode
	"Subclass responsibility to override if necessary"
	^nil! !

!OSPlatform methodsFor: 'testing' stamp: 'CamilloBruni 5/9/2013 22:25'!
isWin32
	^ false! !

!OSPlatform methodsFor: 'initialize' stamp: 'VeronicaUquillas 6/11/2010 14:40'!
shutDown: quitting
	"Pharo is shutting down. If this platform requires specific shutdown code, this is a great place to put it."
! !

!OSPlatform methodsFor: 'testing' stamp: 'CamilloBruni 5/9/2013 22:25'!
isUnix
	^ false! !

!OSPlatform methodsFor: 'testing' stamp: 'CamilloBruni 5/9/2013 22:30'!
isX11
	^ self windowSystemName = 'X11'! !

!OSPlatform methodsFor: '*Keymapping-KeyCombinations' stamp: 'BenjaminVanRyseghem 11/29/2013 16:01'!
defaultModifier

	^ self subclassResponsibility! !

!OSPlatform methodsFor: 'compatbility' stamp: 'cami 7/22/2013 18:37'!
platformName
	^ self name! !

!OSPlatform methodsFor: 'accessing' stamp: 'cami 7/22/2013 18:17'!
current
	^ self! !

!OSPlatform methodsFor: 'accessing' stamp: 'CamilloBruni 5/9/2013 22:37'!
name
	"Return the name of the platform we're running on"

	^ self class currentPlatformName! !

!OSPlatform methodsFor: 'accessing' stamp: 'CamilloBruni 5/9/2013 22:30'!
windowSystemName			
	"Return the name of the window system currently being used for display."

	^ Smalltalk vm getSystemAttribute: 1005! !

!OSPlatform class methodsFor: 'class initialization' stamp: 'CamilloBruni 5/9/2013 22:40'!
initialize
	"Initialize the receiver"
	"OSPlatform initialize"

	Smalltalk 
		removeFromStartUpList: self;
		addToStartUpList: self after: Delay;
		removeFromShutDownList: self;
		addToShutDownList: self after: DisplayScreen.
	self startUp: true.! !

!OSPlatform class methodsFor: 'private' stamp: 'ar 12/11/2004 22:22'!
isActivePlatform
	"Answer whether the receiver is the active platform"
	^false! !

!OSPlatform class methodsFor: 'system attributes' stamp: 'CamilloBruni 5/9/2013 22:38'!
currentVersion
	"Return the version number string of the platform we're running on"

	^ (Smalltalk vm getSystemAttribute: 1002) asString! !

!OSPlatform class methodsFor: 'private' stamp: 'EstebanLorenzano 1/24/2014 16:39'!
determineActivePlatform
	"Look for the matching platform class"
	^ self allSubclasses 
		detect: [ :any | any isActivePlatform ].
! !

!OSPlatform class methodsFor: 'class initialization' stamp: 'EstebanLorenzano 1/24/2014 16:39'!
shutDown: quitting
	"The system is going down"
	Current ifNotNil: [ Current shutDown: quitting ].
! !

!OSPlatform class methodsFor: 'system attributes' stamp: 'CamilloBruni 5/9/2013 22:37'!
currentPlatformName
	"Return the name of the platform we're running on"

	^ Smalltalk vm getSystemAttribute: 1001! !

!OSPlatform class methodsFor: 'accessing' stamp: 'ar 12/11/2004 23:04'!
current
	"Answer the current platform"
	^Current! !

!OSPlatform class methodsFor: 'class initialization' stamp: 'EstebanLorenzano 1/24/2014 16:39'!
startUp: resuming
	"Determine the current platform."
	
	resuming ifFalse: [  ^ self ].
	
	Current := self determineActivePlatform new.
	Current startUp: resuming! !

!OSPlatformTest methodsFor: 'testing' stamp: 'LaurentLaffont 5/25/2010 21:53'!
testStartUpList
	"This test documents issue http://code.google.com/p/pharo/issues/detail?id=838"
	
	self should: [ ((SmalltalkImage classPool at: 'StartUpList') indexOf: #OSPlatform) < ((SmalltalkImage classPool at: 'StartUpList') indexOf: #InputEventSensor) ]! !

!OSPlatformTest methodsFor: 'testing' stamp: 'cami 7/22/2013 18:35'!
testAPI
	"A test to make sure the full API will work"
	Smalltalk os
		isMacOS;
		isMacOSX;
		isWin32;
		isWindows;
		isX11;
		name;
		subtype;
		family.! !

!OSSDL2Driver commentStamp: 'IgorStasenko 7/30/2014 18:21'!
A window driver used for running things using SDL2 library!
!OSSDL2Driver methodsFor: 'events-processing' stamp: 'RonieSalgado 4/17/2014 21:45'!
eventLoopProcessWithoutPlugin
	| event session |
	event := SDL_Event new.
	session := Smalltalk session.
	
	[ session  == Smalltalk session] whileTrue: [
		[ (SDL2 pollEvent: event) > 0 ] whileTrue: [
			self processEvent: event
		].
	
		(Delay forMilliseconds: 5) wait.
	]! !

!OSSDL2Driver methodsFor: 'initialization' stamp: 'RonieSalgado 3/25/2014 01:29'!
initialize
	inputSemaphore := Semaphore new.
	eventQueue := AtomicSharedQueue new.
	windowMap := WeakValueDictionary new.
	SDL2 initVideo.
	self setupEventLoop! !

!OSSDL2Driver methodsFor: 'events-processing' stamp: 'RonieSalgado 3/25/2014 03:58'!
convertEvent: sdlEvent
	| mappedEvent window |
	
	mappedEvent := sdlEvent mapped ifNil: [ ^ nil ].
	mappedEvent windowID ifNil: [ ^ nil ].
	
	window := windowMap at: mappedEvent windowID ifAbsent: [ ^ nil ].
	window handleNewSDLEvent: mappedEvent.
	^ nil
	! !

!OSSDL2Driver methodsFor: 'events-processing' stamp: 'RonieSalgado 4/17/2014 17:23'!
setupEventLoop
	EventLoopProcess ifNotNil: [ EventLoopProcess terminate ].
	
	self class hasPlugin  ifTrue: [
		EventLoopProcess := [ self eventLoopProcessWithPlugin ] forkAt: Processor lowIOPriority.
	] ifFalse: [
		EventLoopProcess := [ self eventLoopProcessWithoutPlugin ] forkAt: Processor lowIOPriority.
	].
	EventLoopProcess name:  'SDL2 Event loop'; resume.! !

!OSSDL2Driver methodsFor: 'window creation and deletion' stamp: 'RonieSalgado 5/8/2014 22:44'!
createWindowWithAttributes: attributes osWindow: osWindow
	| flags handle window glAttributes |
	flags := SDL_WINDOW_SHOWN | SDL_WINDOW_RESIZABLE.
	attributes fullscreen ifTrue: [ flags := flags | SDL_WINDOW_FULLSCREEN ].
	
	" Set the OpenGL attributes."
	glAttributes := attributes glAttributes.
	glAttributes ifNotNil: [ 
		flags := SDL_WINDOW_OPENGL.
		self setGLAttributes: glAttributes.
	].
	
	"Create the window"
	handle := SDL2 createWindow: attributes title
				x: attributes x
				y: attributes y
				width: attributes width 
				height: attributes height flags: flags.
	window := OSSDL2WindowHandle newWithHandle: handle attributes: attributes.
	window osWindow: osWindow.
	windowMap at: handle windowID put: window.
	^ window! !

!OSSDL2Driver methodsFor: 'events-processing' stamp: 'RonieSalgado 5/9/2014 02:46'!
eventLoopProcessWithPlugin
	| event session semaIndex |
	event := SDL_Event new.
	session := Smalltalk session.
	
	semaIndex := (Smalltalk registerExternalObject: inputSemaphore).
	self primSetupInputSemaphore: semaIndex.
	[
		[ inputSemaphore wait; consumeAllSignals. session  == Smalltalk session] whileTrue: [
			[ (SDL2 pollEvent: event) > 0 ] whileTrue: [
				self processEvent: event
			].
		]
	] ensure:  [ Smalltalk unregisterExternalObject: inputSemaphore ]! !

!OSSDL2Driver methodsFor: 'window creation and deletion' stamp: 'RonieSalgado 5/8/2014 22:52'!
setGLAttributes: glAttributes
	SDL2 glSetAttribute: SDL_GL_RED_SIZE value: glAttributes redSize.
	SDL2 glSetAttribute: SDL_GL_BLUE_SIZE value: glAttributes blueSize.
	SDL2 glSetAttribute: SDL_GL_GREEN_SIZE value: glAttributes greenSize.
	SDL2 glSetAttribute: SDL_GL_ALPHA_SIZE value: glAttributes alphaSize.
	SDL2 glSetAttribute: SDL_GL_DEPTH_SIZE value: glAttributes depthSize.
	SDL2 glSetAttribute: SDL_GL_STENCIL_SIZE value: glAttributes stencilSize.
	SDL2 glSetAttribute: SDL_GL_DOUBLEBUFFER value: glAttributes doubleBuffer.! !

!OSSDL2Driver methodsFor: 'events-processing' stamp: 'RonieSalgado 4/17/2014 17:28'!
primSetupInputSemaphore: semaIndex
	<primitive: #primitiveSetSDL2Input module: #SDL2DisplayPlugin>
	^ nil! !

!OSSDL2Driver methodsFor: 'events-processing' stamp: 'RonieSalgado 4/17/2014 21:59'!
processEvent: sdlEvent
	| event |
	event := self convertEvent: sdlEvent.
	event ifNotNil: [ eventQueue nextPut: event ].! !

!OSSDL2Driver class methodsFor: 'testing' stamp: 'RonieSalgado 4/17/2014 17:20'!
isSuitable
	^ self isSupported and: [ self hasPlugin ]! !

!OSSDL2Driver class methodsFor: 'testing' stamp: 'RonieSalgado 3/25/2014 01:25'!
isSupported 
	^ SDL2 isAvailable! !

!OSSDL2Driver class methodsFor: 'testing' stamp: 'RonieSalgado 4/17/2014 21:38'!
hasPlugin
	<primitive: #primitiveHasDisplayPlugin module: #SDL2DisplayPlugin>
	^ false! !

!OSSDL2FormRenderer commentStamp: 'IgorStasenko 7/30/2014 18:22'!
My instances implement OSWindowFormRenderer interface using SDL2 library!
!OSSDL2FormRenderer methodsFor: 'updating screen' stamp: 'RonieSalgado 5/10/2014 00:49'!
updateRectangle: rectangle
	| intersection sdlRectangle |
	intersection :=  rectangle intersect: (0@0 corner: window extent) ifNone: [^ self ].
	self onRenderThreadBlocking: [
		self validate ifFalse: [ ^ self ].
	
		texture updateTexturePixels: form bits pitch: form width * 4.
		sdlRectangle := SDL_Rect newX: intersection left asInteger y: intersection top asInteger w: intersection width asInteger h: 		intersection height asInteger.
		renderer copy: texture.
		renderer present.
	]! !

!OSSDL2FormRenderer methodsFor: 'private' stamp: 'RonieSalgado 3/25/2014 02:27'!
createRenderer
	renderer := window handle createDefaultRenderer! !

!OSSDL2FormRenderer methodsFor: 'updating screen' stamp: 'RonieSalgado 5/9/2014 23:42'!
updateAll
	self onRenderThreadBlocking: [
		self validate ifFalse: [ ^ self ].

		texture updateTexturePixels: form bits pitch: form width * 4.
		renderer copy: texture.
		renderer present.
	]! !

!OSSDL2FormRenderer methodsFor: 'private' stamp: 'RonieSalgado 3/26/2014 03:46'!
createTexture
	texture ifNotNil: [ texture destroy ].
	texture := renderer createTextureFormat: SDL_PIXELFORMAT_XRGB8888
						access: SDL_TEXTUREACCESS_STREAMING width: form width height: form height.
	extent := form extent! !

!OSSDL2FormRenderer methodsFor: 'private' stamp: 'RonieSalgado 3/26/2014 03:49'!
validate
	form ifNil: [ ^ false ].
	renderer ifNil: [ self createRenderer ].
	((texture == nil) or: [form extent ~= extent]) ifTrue: [ self createTexture ].
	^ true! !

!OSSDL2FormRenderer methodsFor: 'initialize' stamp: 'RonieSalgado 3/25/2014 02:20'!
destroy
	(texture isNil or: [ renderer isNil ]) ifTrue: [ ^ self ].
	texture destroy.
	renderer destroy.! !

!OSSDL2GLRenderer commentStamp: 'IgorStasenko 7/30/2014 18:22'!
My instances implement OSWindowGLRenderer interface using SDL2 library!
!OSSDL2GLRenderer methodsFor: 'updating screen' stamp: 'RonieSalgado 5/9/2014 20:48'!
updateAll
	"Do nothing here"
! !

!OSSDL2GLRenderer methodsFor: 'misc' stamp: 'RonieSalgado 5/10/2014 00:39'!
createContext
	self onRenderThreadBlocking: [
		renderer := window handle createDefaultRenderer.
		context := SDL2 glCreateContext: window handle.
	]
! !

!OSSDL2GLRenderer methodsFor: 'initialize' stamp: 'RonieSalgado 5/10/2014 02:44'!
destroy
	self onRenderThreadBlocking: [
		context ifNotNil: [ context delete ].
		renderer destroy.
		context := nil.
	]
	! !

!OSSDL2GLRenderer methodsFor: 'misc' stamp: 'RonieSalgado 5/10/2014 00:54'!
getProcAddress: procName
	self checkThread.
	^ SDL2 glGetProcAddress: procName! !

!OSSDL2GLRenderer methodsFor: 'misc' stamp: 'RonieSalgado 5/10/2014 02:45'!
makeCurrent
	context ifNil: [ ^ false ].
	
	self checkThread.
	renderer clear. "Hack for using SDL2 renderers and OpenGL at the same time."
	(SDL2 glMakeCurrent: window handle context: context) == 0
		ifTrue:  [ ^ true ]
		ifFalse:  [ ^ false ]
	! !

!OSSDL2GLRenderer methodsFor: 'updating screen' stamp: 'RonieSalgado 5/9/2014 20:48'!
updateRectangle: rectangle
	"Do nothing here"! !

!OSSDL2GLRenderer methodsFor: 'misc' stamp: 'RonieSalgado 5/10/2014 01:06'!
swapBuffers
	self checkThread.
	SDL2 glSwapWindow: window handle.! !

!OSSDL2GLRenderer methodsFor: 'misc' stamp: 'RonieSalgado 5/10/2014 00:54'!
checkThread
	OSWindowRenderThread isThisThread ifFalse: [ ^ 'GL Renderer must be used inside the OSWindowRenderThread' ]! !

!OSSDL2WindowHandle commentStamp: 'IgorStasenko 7/30/2014 18:23'!
i am the OSWindowHandle interface implemented using SDL2 library!
!OSSDL2WindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 5/8/2014 21:35'!
bounds
	^ self position extent: self extent ! !

!OSSDL2WindowHandle methodsFor: 'event handling' stamp: 'RonieSalgado 5/8/2014 20:37'!
visitMouseWheelEvent: sdlEvent
	| osEvent |
	osEvent := OSMouseWheelEvent for: osWindow.
	osEvent position: self mousePosition;
			scrollHorizontal: sdlEvent x;
			scrollVertical: sdlEvent y.
			
	self convertButtonState: SDL2 mouseState modState: SDL2 modState modifiers: osEvent modifiers.
	^ osEvent deliver.! !

!OSSDL2WindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 3/26/2014 03:38'!
bounds: newBounds
	self position: newBounds origin;
		extent: newBounds extent.! !

!OSSDL2WindowHandle methodsFor: 'event handling' stamp: 'RonieSalgado 3/25/2014 17:40'!
visitKeyDownEvent: event
	| osEvent keysym |
	keysym := event keysym.
	osEvent := OSKeyDownEvent for: osWindow.
	osEvent scanCode: keysym scancode;
			symbol: keysym sym;
			position: self mousePosition;
			character: (self mapSpecialCharacter: keysym sym).
			
	self convertButtonState: SDL2 mouseState modState: keysym mod modifiers: osEvent modifiers.
	^ osEvent deliver.! !

!OSSDL2WindowHandle methodsFor: 'event handling' stamp: 'RonieSalgado 3/25/2014 16:58'!
visitTextInputEvent: event
	| osEvent |
	osEvent := OSTextInputEvent for: osWindow.
	osEvent text: (ZnUTF8Encoder new decodeBytes: event text);
			position: self mousePosition.
			
	self convertButtonState: SDL2 mouseState modState: SDL2 modState modifiers: osEvent modifiers.
	^ osEvent deliver.! !

!OSSDL2WindowHandle methodsFor: 'event handling' stamp: 'RonieSalgado 3/25/2014 17:39'!
mapSpecialCharacter: symbol
	^ SDL2SpecialCharacterMapping mapKeySymbol: symbol ifAbsent: [ ^ nil ]! !

!OSSDL2WindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 3/26/2014 03:34'!
position: newPosition
	handle setPositionX: newPosition x y: newPosition y.! !

!OSSDL2WindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 3/26/2014 03:41'!
setMouseCursor: cursorWithMask! !

!OSSDL2WindowHandle methodsFor: 'initialize' stamp: 'RonieSalgado 3/25/2014 02:27'!
handle
	^ handle! !

!OSSDL2WindowHandle methodsFor: 'instance creation' stamp: 'RonieSalgado 5/8/2014 23:04'!
newOpenGLRenderer
	^ renderer := OSSDL2GLRenderer new 
		window: self;
		createContext;
		yourself! !

!OSSDL2WindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 3/26/2014 15:05'!
fullscreen: aBoolean
	aBoolean ifTrue: [
		handle fullscreen: SDL_WINDOW_FULLSCREEN
	] ifFalse: [ 
		handle fullscreen: 0
	]! !

!OSSDL2WindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 3/26/2014 03:26'!
title! !

!OSSDL2WindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 3/26/2014 03:38'!
title: aTitle
	handle title: aTitle! !

!OSSDL2WindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 3/26/2014 04:20'!
clipboardText
	^ SDL2 clipboardText! !

!OSSDL2WindowHandle methodsFor: 'initialize' stamp: 'RonieSalgado 3/26/2014 15:28'!
initWithHandle: aHandle attributes: attributes
	handle := aHandle.
	attributes applyTo: self! !

!OSSDL2WindowHandle methodsFor: 'event handling' stamp: 'RonieSalgado 3/25/2014 16:46'!
visitKeyUpEvent: event
	| osEvent keysym |
	keysym := event keysym.
	osEvent := OSKeyUpEvent for: osWindow.
	osEvent scanCode: keysym scancode;
			symbol: keysym sym;
			position: self mousePosition.
			
	self convertButtonState: SDL2 mouseState modState: keysym mod modifiers: osEvent modifiers.
	^ osEvent deliver.! !

!OSSDL2WindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 3/25/2014 02:03'!
isValid
	^ true! !

!OSSDL2WindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 3/26/2014 03:26'!
show: aBoolean
! !

!OSSDL2WindowHandle methodsFor: 'event handling' stamp: 'RonieSalgado 5/9/2014 02:22'!
visitWindowEvent: windowEvent
	windowEvent event = SDL_WINDOWEVENT_EXPOSED ifTrue: [
		^ ((OSWindowExposeEvent for: osWindow) timeStamp: windowEvent timestamp)deliver.
	].
	windowEvent event = SDL_WINDOWEVENT_CLOSE ifTrue: [ 
		^ (OSWindowCloseEvent for: osWindow) deliver.
	].
	windowEvent event = SDL_WINDOWEVENT_MOVED ifTrue: [ 
		^ (OSWindowMoveEvent for: osWindow) deliver
	].
	windowEvent event = SDL_WINDOWEVENT_RESIZED ifTrue: [ 
		^ (OSWindowResizeEvent for: osWindow) deliver
	].
	windowEvent event = SDL_WINDOWEVENT_ENTER ifTrue: [ 
		^ (OSWindowMouseEnterEvent for: osWindow) deliver
	].
	windowEvent event = SDL_WINDOWEVENT_LEAVE ifTrue: [ 
		^ (OSWindowMouseLeaveEvent for: osWindow) deliver
	].
	windowEvent event = SDL_WINDOWEVENT_FOCUS_GAINED ifTrue: [ 
		^ (OSWindowFocusInEvent for: osWindow) deliver
	].
	windowEvent event = SDL_WINDOWEVENT_FOCUS_LOST ifTrue: [ 
		^ (OSWindowFocusOutEvent for: osWindow) deliver
	].
! !

!OSSDL2WindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 3/26/2014 03:36'!
extent: newExtent
	handle setSizeW: newExtent x h: newExtent y! !

!OSSDL2WindowHandle methodsFor: 'initialize' stamp: 'RonieSalgado 3/25/2014 02:13'!
destroy
	handle ifNotNil: [
		renderer ifNotNil: [ renderer destroy ].
		handle destroy.
		handle := nil.
	]! !

!OSSDL2WindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 3/26/2014 04:20'!
clipboardText: aText
	SDL2 clipboardText: aText! !

!OSSDL2WindowHandle methodsFor: 'event handling' stamp: 'RonieSalgado 3/25/2014 14:45'!
visitMouseMotionEvent: sdlEvent
	| osEvent |
	osEvent := OSMouseMoveEvent for: osWindow.
	osEvent position: sdlEvent x @ sdlEvent y.

	self convertButtonState: sdlEvent state modState: SDL2 modState modifiers: osEvent modifiers.
	^ osEvent deliver.! !

!OSSDL2WindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 3/26/2014 15:41'!
icon: aForm
	| convertedIcon surface |
	aForm ifNil: [ ^self ].
	
	convertedIcon := aForm unhibernate; asFormOfDepth: 32.
	surface := SDL2 createRGBSurfaceFromPixels: convertedIcon bits
			width: convertedIcon width height: convertedIcon height
			depth: 32 pitch: convertedIcon width *4
			rmask: 16r00ff0000 
			gmask: 16r000ff00
			bmask: 16r00000ff
			amask: 16rff000000.
	handle icon: surface.
	SDL2 freeSurface: surface! !

!OSSDL2WindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 3/26/2014 03:35'!
extent
	| w h |
	w := OSSDLIntValue new.
	h := OSSDLIntValue new.
	handle getSizeW: w h: h.
	^ w value @ h value! !

!OSSDL2WindowHandle methodsFor: 'event handling' stamp: 'RonieSalgado 3/25/2014 14:46'!
visitMouseButtonDownEvent: event
	| osEvent |
	osEvent := OSMouseButtonPressEvent for: osWindow.
	osEvent button: event button;
			position: event x @ event y.
	
	self convertButtonState: SDL2 mouseState modState: SDL2 modState modifiers: osEvent modifiers.
	^ osEvent deliver.! !

!OSSDL2WindowHandle methodsFor: 'event handling' stamp: 'RonieSalgado 3/25/2014 16:46'!
mousePosition
	| x y |
	x := OSSDLIntValue new.
	y := OSSDLIntValue new.
	SDL2 mouseStateX: x y: y.
	^ ( x value ) @ (y value)! !

!OSSDL2WindowHandle methodsFor: 'event handling' stamp: 'RonieSalgado 3/25/2014 03:59'!
handleNewSDLEvent: sdlEvent
	^ sdlEvent accept: self! !

!OSSDL2WindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 3/26/2014 03:34'!
position
	| x y |
	x := OSSDLIntValue new.
	y := OSSDLIntValue new.
	handle getPositionX: x y: y.
	^ x value @ y value! !

!OSSDL2WindowHandle methodsFor: 'event handling' stamp: 'RonieSalgado 5/8/2014 20:25'!
convertButtonState: mouseState modState: modState modifiers: modifiers
	| shift ctrl alt |
	modifiers buttons button1: (mouseState bitAnd: SDL_BUTTON_LMASK) ~= 0.
	modifiers buttons button2: (mouseState bitAnd: SDL_BUTTON_MMASK) ~= 0.
	modifiers buttons button3: (mouseState bitAnd: SDL_BUTTON_RMASK) ~= 0.
	modifiers buttons button4: (mouseState bitAnd: SDL_BUTTON_X1MASK) ~= 0.
	modifiers buttons button5: (mouseState bitAnd: SDL_BUTTON_X2MASK) ~= 0.

	shift := (modState bitAnd: KMOD_SHIFT) ~= 0.
	ctrl := (modState bitAnd: KMOD_CTRL) ~= 0.
	alt := (modState bitAnd: KMOD_LALT) ~= 0.
	modifiers leftShift: shift; rightShift: shift;
			   leftCtrl: ctrl; rightCtrl: ctrl;
			   leftAlt: alt; rightAlt: alt.! !

!OSSDL2WindowHandle methodsFor: 'instance creation' stamp: 'RonieSalgado 3/25/2014 02:09'!
newFormRenderer: form
	^ renderer := OSSDL2FormRenderer new 
		form: form;
		window: self;
		yourself! !

!OSSDL2WindowHandle methodsFor: 'event handling' stamp: 'RonieSalgado 3/25/2014 14:45'!
visitMouseButtonUpEvent: event
	| osEvent |
	osEvent := OSMouseButtonReleaseEvent for: osWindow.
	osEvent button: event button;
			position: event x @ event y.
	
	self convertButtonState: SDL2 mouseState modState: SDL2 modState modifiers: osEvent modifiers.
	^ osEvent deliver.! !

!OSSDL2WindowHandle class methodsFor: 'instance creation' stamp: 'RonieSalgado 3/25/2014 02:00'!
newWithHandle: handle attributes: attributes.
	^ self basicNew initWithHandle: handle attributes: attributes; yourself! !

!OSSDLIntValue commentStamp: 'IgorStasenko 7/30/2014 18:23'!
Dummy class for integer values!
!OSSDLIntValue methodsFor: '*generated-code-non-existing-package' stamp: 'CiprianTeodorov 4/9/2013 19:46'!
value
	"Note, this method used as a template for my anonymous subclasses. "
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self emitRead! !

!OSSDLIntValue methodsFor: '*generated-code-non-existing-package' stamp: 'CiprianTeodorov 4/9/2013 19:46'!
value: value
	"Note, this method used as a template for my anonymous subclasses. "
	
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	
	^ self emitWrite ! !

!OSSDLIntValue class methodsFor: 'class initialization' stamp: 'RonieSalgado 3/25/2014 16:45'!
initialize
	"self initialize"
	self initValueType: 'int'! !

!OSStateModifiers commentStamp: 'IgorStasenko 7/30/2014 17:42'!
i holding a collection of various key/button modifier flags, usually carried by certain events and accessible through #modifiers message.!
!OSStateModifiers methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:22'!
rightCtrl: anObject
	
	rightCtrl := anObject! !

!OSStateModifiers methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:23'!
alt
	^ leftAlt or: [  rightAlt ]! !

!OSStateModifiers methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:22'!
leftCtrl
	
	^ leftCtrl! !

!OSStateModifiers methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:22'!
leftAlt
	
	^ leftAlt! !

!OSStateModifiers methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:22'!
rightShift
	
	^ rightShift! !

!OSStateModifiers methodsFor: 'initialization' stamp: 'RonieSalgado 1/8/2014 13:48'!
initialize
	leftAlt := leftCmd := leftCtrl := leftShift := rightAlt := rightCmd := rightCtrl := rightShift :=
	capsLock := numLock := false.
	buttons := OSButtonState new.! !

!OSStateModifiers methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:22'!
leftAlt: anObject
	
	leftAlt := anObject! !

!OSStateModifiers methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:22'!
rightCmd: anObject
	
	rightCmd := anObject! !

!OSStateModifiers methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:24'!
cmd
	^ leftCmd or: [  rightCmd ]! !

!OSStateModifiers methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:22'!
rightCmd
	
	^ rightCmd! !

!OSStateModifiers methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:22'!
numLock: anObject
	
	numLock := anObject! !

!OSStateModifiers methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:22'!
capsLock
	
	^ capsLock! !

!OSStateModifiers methodsFor: 'accessing' stamp: 'RonieSalgado 1/8/2014 13:20'!
buttons
	^ buttons! !

!OSStateModifiers methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:22'!
leftShift
	
	^ leftShift! !

!OSStateModifiers methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:22'!
leftShift: anObject
	
	leftShift := anObject! !

!OSStateModifiers methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:22'!
leftCmd: anObject
	
	leftCmd := anObject! !

!OSStateModifiers methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:23'!
shift
	^ leftShift or: [  rightShift ]! !

!OSStateModifiers methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:22'!
capsLock: anObject
	
	capsLock := anObject! !

!OSStateModifiers methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:22'!
rightAlt
	
	^ rightAlt! !

!OSStateModifiers methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:22'!
leftCtrl: anObject
	
	leftCtrl := anObject! !

!OSStateModifiers methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:23'!
ctrl
	^ leftCtrl or: [  rightCtrl ]! !

!OSStateModifiers methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:22'!
rightShift: anObject
	
	rightShift := anObject! !

!OSStateModifiers methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:22'!
numLock
	
	^ numLock! !

!OSStateModifiers methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:22'!
rightAlt: anObject
	
	rightAlt := anObject! !

!OSStateModifiers methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:22'!
rightCtrl
	
	^ rightCtrl! !

!OSStateModifiers methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:22'!
leftCmd
	
	^ leftCmd! !

!OSTextInputEvent commentStamp: 'IgorStasenko 7/30/2014 17:24'!
i am delivered when user enters some text!
!OSTextInputEvent methodsFor: 'initialize' stamp: 'RonieSalgado 3/25/2014 16:54'!
initialize
	super initialize.
	modifiers := OSStateModifiers new.! !

!OSTextInputEvent methodsFor: 'accessing' stamp: 'RonieSalgado 3/25/2014 16:53'!
modifiers: anObject
	
	modifiers := anObject! !

!OSTextInputEvent methodsFor: 'visitor' stamp: 'RonieSalgado 3/25/2014 16:53'!
accept: aVisitor
	^ aVisitor visitTextInputEvent: self! !

!OSTextInputEvent methodsFor: 'accessing' stamp: 'RonieSalgado 3/25/2014 16:53'!
position
	
	^ position! !

!OSTextInputEvent methodsFor: 'accessing' stamp: 'RonieSalgado 3/25/2014 16:53'!
position: anObject
	
	position := anObject! !

!OSTextInputEvent methodsFor: 'accessing' stamp: 'RonieSalgado 3/25/2014 16:53'!
text: anObject
	
	text := anObject! !

!OSTextInputEvent methodsFor: 'accessing' stamp: 'RonieSalgado 3/25/2014 16:53'!
modifiers
	
	^ modifiers! !

!OSTextInputEvent methodsFor: 'accessing' stamp: 'RonieSalgado 3/25/2014 16:53'!
text
	
	^ text! !

!OSUnknownEvent commentStamp: 'IgorStasenko 7/30/2014 17:25'!
I am delivered , when driver don't knows how to interpret the event which comes from OS.
Useful for debugging.!
!OSUnknownEvent methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:32'!
data: anObject
	
	data := anObject! !

!OSUnknownEvent methodsFor: 'visitor' stamp: 'RonieSalgado 1/7/2014 17:27'!
accept: aVisitor
	^ aVisitor visitUnknownEvent: self! !

!OSUnknownEvent methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 15:32'!
data
	
	^ data! !

!OSVMFormRenderer commentStamp: 'IgorStasenko 7/30/2014 18:01'!
My instances implement OSWindowFormRenderer interface for OSVMWindowHandle.!
!OSVMFormRenderer methodsFor: 'updating screen' stamp: 'RonieSalgado 1/10/2014 16:42'!
updateAll
	self updateRectangle: (0@0 extent: form extent)! !

!OSVMFormRenderer methodsFor: 'private' stamp: 'RonieSalgado 1/10/2014 16:38'!
beDisplay
	Smalltalk specialObjectsArray at: 15 put: form! !

!OSVMFormRenderer methodsFor: 'other' stamp: 'RonieSalgado 1/10/2014 17:17'!
forceDisplayUpdate
	<primitive: 231>
	"do nothing if primitive fails"! !

!OSVMFormRenderer methodsFor: 'morphic integration' stamp: 'RonieSalgado 1/10/2014 17:30'!
deferUpdatesWhile: aBlock

	self primitiveDeferUpdates: true.
	aBlock ensure: [  self primitiveDeferUpdates: false. ]! !

!OSVMFormRenderer methodsFor: 'private' stamp: 'RonieSalgado 1/10/2014 16:41'!
primShowRectLeft: l right: r top: t bottom: b
	"Copy the given rectangular section of the Display to to the screen. This primitive is not implemented on all platforms. If this fails, retry integer coordinates."

	<primitive: 127>
	"if this fails, coerce coordinates to integers and try again"
	self primRetryShowRectLeft: l truncated
		right: r rounded
		top: t truncated
		bottom: b rounded.
! !

!OSVMFormRenderer methodsFor: 'updating screen' stamp: 'RonieSalgado 1/10/2014 17:16'!
updateRectangle: aRectangle
	self primShowRectLeft: aRectangle left truncated
		right: aRectangle right rounded
		top: aRectangle top truncated
		bottom: aRectangle bottom rounded.
! !

!OSVMFormRenderer methodsFor: 'deferring' stamp: 'RonieSalgado 1/10/2014 17:28'!
primitiveDeferUpdates: aBoolean
	"Set the deferUpdates flag in the virtual machine. When this flag is true, BitBlt operations on the Display are not automatically propagated to the screen. If this underlying platform does not support deferred updates, this primitive will fail. Answer the receiver if the primitive succeeds, nil if it fails."

	<primitive: 126>
	^ nil  "answer nil if primitive fails"
! !

!OSVMFormRenderer methodsFor: 'morphic integration' stamp: 'RonieSalgado 1/10/2014 17:36'!
updateAreas: allDamage immediate: forceToScreen

	"Force all the damage rects to the screen."
	allDamage do: [ :r| self updateRectangle: r ].
	
	 ! !

!OSVMFormRenderer methodsFor: 'private' stamp: 'RonieSalgado 1/10/2014 16:41'!
primRetryShowRectLeft: l right: r top: t bottom: b
	"Copy the given rectangular section of the Display to to the screen. This primitive is not implemented on all platforms. Do nothing if it fails. "

	<primitive: 127>
	"do nothing if primitive fails"
! !

!OSVMFormRenderer methodsFor: 'accessing' stamp: 'RonieSalgado 1/10/2014 17:16'!
form: aForm
	super form: aForm.
	self beDisplay! !

!OSVMWindowHandle commentStamp: 'IgorStasenko 7/30/2014 17:58'!
An OSVMWindowHandle is created by VMWindowDriver.
 !
!OSVMWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/10/2014 15:42'!
bounds
	^ self position corner: self extent! !

!OSVMWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/10/2014 15:39'!
extent: extent
	self depth: self screenDepth width: extent x height: extent y fullscreen: fullscreen! !

!OSVMWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/10/2014 15:38'!
screenDepth
	<primitive: #primitiveScreenDepth >
	^ self renderer form depth! !

!OSVMWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/10/2014 15:42'!
bounds: bounds
	self position: bounds origin.
	self extent: bounds extent! !

!OSVMWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/15/2014 15:54'!
clipboardText: aString
	<primitive: 141>! !

!OSVMWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/10/2014 15:41'!
position: newPosition
	"Ignored"! !

!OSVMWindowHandle methodsFor: 'initialize' stamp: 'RonieSalgado 1/10/2014 15:52'!
initWithAttributes: attributes
	self extent: attributes extent! !

!OSVMWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/15/2014 15:30'!
setMouseCursor: cursorWithMask
	^ cursorWithMask oldPrimitiveBeCursor! !

!OSVMWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/10/2014 15:36'!
extent
	<primitive: 106>
	^ 640@480! !

!OSVMWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/10/2014 15:40'!
initialize
	super initialize.
	fullscreen := false! !

!OSVMWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/17/2014 18:04'!
fullscreen: aBoolean! !

!OSVMWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/10/2014 15:43'!
title
	^ ''! !

!OSVMWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/10/2014 15:43'!
title: newTitle
	"Ignored"! !

!OSVMWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/15/2014 15:55'!
clipboardText
	<primitive: 141>
	^ ''! !

!OSVMWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/10/2014 15:39'!
depth: depthInteger width: widthInteger height: heightInteger fullscreen: aBoolean
	"Force Pharo's window (if there's one) into a new size and depth."
	"DisplayScreen depth: 8 width: 1024 height: 768 fullscreen: false"

	<primitive: 92>
	self primitiveFailed ! !

!OSVMWindowHandle methodsFor: 'testing' stamp: 'RonieSalgado 1/10/2014 15:55'!
isValid
	^ true! !

!OSVMWindowHandle methodsFor: 'instance-creation' stamp: 'RonieSalgado 1/10/2014 17:21'!
newFormRenderer: form 
	^ renderer := OSVMFormRenderer new 
		form: form;
		window: self;
		yourself! !

!OSWindow commentStamp: 'IgorStasenko 7/30/2014 16:01'!
I am a central class, which provides a top-level API for creating/controlling an operating-system windows.

To create a new OS window with default attributes, just use

OSWindow new.

For better control of window creation, use 

OSWindow createWithAttributes: ...

message. (See OSWindowAttributes for description).

A newly created OSWindow instance can be used and controlled by application.
To handle events (mouse/keyboard) of newly created window, one must 
bind own event handler to it (#eventHandler:) which must understand #handleEvent: message.

To render on window's surface, first application must obtain an OSWindowRenderer instance.
Currently there's two kinds of renderers available:
- form renderer (to use existing form for updating window's contents)
- opengl renderer (to render using OpenGL).

OSWindow instance and its handle: 
 - all operations with window (like hiding/showing/resizing etc) is possible only if its handle is valid. If window gets destroyed, or image opened in a new session while window was created in previous session, the handle becomes invalid, and any operations will lead to error. 
To test if window is still valid, you can just use #isValid message.!
!OSWindow methodsFor: 'accessing' stamp: 'RonieSalgado 1/2/2014 09:10'!
bounds
	^ self validHandle bounds! !

!OSWindow methodsFor: 'accessing' stamp: 'RonieSalgado 1/6/2014 15:04'!
renderer
	^ handle renderer! !

!OSWindow methodsFor: 'accessing' stamp: 'RonieSalgado 5/10/2014 01:59'!
animated: anObject
	
	animated := anObject! !

!OSWindow methodsFor: 'accessing' stamp: 'RonieSalgado 1/2/2014 09:10'!
bounds: newBounds
	self validHandle bounds: newBounds! !

!OSWindow methodsFor: 'private' stamp: 'RonieSalgado 5/10/2014 01:58'!
registerWindow
	OSWindowRenderThread createdWindow: self.! !

!OSWindow methodsFor: 'accessing' stamp: 'RonieSalgado 1/2/2014 09:09'!
position: newPosition
	self validHandle position: newPosition! !

!OSWindow methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 16:46'!
eventHandler
	
	^ eventHandler! !

!OSWindow methodsFor: 'private' stamp: 'RonieSalgado 1/13/2014 17:11'!
setMouseCursor: cursorWithMask
	self validHandle setMouseCursor: cursorWithMask! !

!OSWindow methodsFor: 'accessing' stamp: 'RonieSalgado 1/6/2014 15:10'!
handle
	^ handle! !

!OSWindow methodsFor: 'factory' stamp: 'RonieSalgado 5/8/2014 22:30'!
newOpenGLRenderer
	^ handle newOpenGLRenderer! !

!OSWindow methodsFor: 'accessing' stamp: 'RonieSalgado 1/17/2014 14:44'!
fullscreen: aBoolean
	self validHandle fullscreen: aBoolean! !

!OSWindow methodsFor: 'visibility' stamp: 'RonieSalgado 1/2/2014 09:04'!
show
	self show: true! !

!OSWindow methodsFor: 'accessing' stamp: 'RonieSalgado 1/16/2014 16:28'!
title: aString
	self validHandle title: aString! !

!OSWindow methodsFor: 'clipboard handling' stamp: 'RonieSalgado 1/15/2014 16:01'!
clipboardText
	^ self validHandle clipboardText! !

!OSWindow methodsFor: 'private' stamp: 'RonieSalgado 1/2/2014 09:10'!
validHandle
	self checkIsValid.
	^ handle! !

!OSWindow methodsFor: 'testing' stamp: 'RonieSalgado 1/3/2014 13:56'!
isValid
	 ^ handle notNil and: [ handle isValid ]! !

!OSWindow methodsFor: 'visibility' stamp: 'RonieSalgado 1/2/2014 09:05'!
show: aBoolean
	self checkIsValid.
	handle show: aBoolean! !

!OSWindow methodsFor: 'accessing' stamp: 'RonieSalgado 1/3/2014 15:00'!
renderer: aRenderer
	handle renderer: aRenderer! !

!OSWindow methodsFor: 'dispatching events' stamp: 'RonieSalgado 1/15/2014 14:28'!
deliverEvent: anEvent
	"TODO..."
	TraceEvents == true ifTrue: [ Transcript show: anEvent; cr ].
	
	eventHandler ifNotNil: [

		 eventHandler handleEvent: anEvent
		 ].
	
	anEvent performDefaultAction
! !

!OSWindow methodsFor: 'accessing' stamp: 'RonieSalgado 1/2/2014 09:09'!
extent: newExtent
	self validHandle extent: newExtent! !

!OSWindow methodsFor: 'private' stamp: 'RonieSalgado 5/10/2014 01:57'!
destroy
	OSWindowRenderThread destroyedWindow: self.
	self validHandle destroy.
	handle := nil.
	eventHandler := nil.! !

!OSWindow methodsFor: 'clipboard handling' stamp: 'RonieSalgado 1/15/2014 16:02'!
clipboardText: aString
	^ self validHandle clipboardText: aString! !

!OSWindow methodsFor: 'visibility' stamp: 'RonieSalgado 1/2/2014 09:05'!
hide
	self show: false! !

!OSWindow methodsFor: 'accessing' stamp: 'RonieSalgado 1/7/2014 16:46'!
eventHandler: anObject
	
	eventHandler := anObject! !

!OSWindow methodsFor: 'private' stamp: 'RonieSalgado 1/7/2014 16:31'!
createWindow
	handle ifNotNil: [ self error: 'The window is already created.' ].
	
	handle := initialAttributes createWindowHandleFor: self.
	handle isValid  ifTrue: [ 
		NBExternalResourceManager addResource: self data: handle
	]! !

!OSWindow methodsFor: 'testing' stamp: 'RonieSalgado 5/10/2014 02:25'!
initWithAttributes: attributes
	initialAttributes := attributes.
	
	self animated: attributes animated.
	self createWindow.
	self registerWindow.! !

!OSWindow methodsFor: 'event handling' stamp: 'RonieSalgado 1/3/2014 15:41'!
processPendingEvents
	handle processPendingEvents! !

!OSWindow methodsFor: 'accessing' stamp: 'RonieSalgado 1/16/2014 17:49'!
icon: aForm
	self validHandle icon: aForm! !

!OSWindow methodsFor: 'accessing' stamp: 'RonieSalgado 5/15/2014 19:53'!
extent
	^ self validHandle extent! !

!OSWindow methodsFor: 'accessing' stamp: 'RonieSalgado 5/10/2014 01:59'!
animated
	
	^ animated! !

!OSWindow methodsFor: 'private' stamp: 'RonieSalgado 1/2/2014 09:06'!
checkIsValid

	(handle isNil or: [ handle isValid not ]) ifTrue: [ self invalidHandle ].! !

!OSWindow methodsFor: 'accessing' stamp: 'RonieSalgado 1/2/2014 09:08'!
position
	^ self validHandle position! !

!OSWindow methodsFor: 'private' stamp: 'RonieSalgado 1/2/2014 09:07'!
invalidHandle
	self error: 'Invalid window handle'! !

!OSWindow methodsFor: 'factory' stamp: 'RonieSalgado 1/6/2014 15:16'!
newFormRenderer: form
	^ handle newFormRenderer: form! !

!OSWindow class methodsFor: '*OSWindow-VM' stamp: 'RonieSalgado 1/10/2014 15:59'!
vmWindow
	| attributes |
	^ VMWindow ifNil: [ 
		attributes := OSWindowAttributes new.
		attributes preferableDriver: VMWindowDriver new.
		attributes extent: 640@480.
		VMWindow := OSWindow createWithAttributes: attributes
	] ! !

!OSWindow class methodsFor: 'tracing' stamp: 'RonieSalgado 1/15/2014 14:24'!
traceEvents: aBoolean
	TraceEvents := aBoolean! !

!OSWindow class methodsFor: '*OSWindow-VM' stamp: 'RonieSalgado 1/10/2014 17:22'!
resetVMWindow
	"self resetVMWindow"
	VMWindow := nil.
	
! !

!OSWindow class methodsFor: 'instance creation' stamp: 'RonieSalgado 1/2/2014 09:37'!
new
	^ self createWithAttributes: OSWindowAttributes new! !

!OSWindow class methodsFor: 'clipboard handling' stamp: 'RonieSalgado 1/15/2014 15:54'!
clipboardText: aString
	self validHandle clipboardText: aString! !

!OSWindow class methodsFor: 'defaults' stamp: 'RonieSalgado 1/2/2014 08:23'!
defaultExtent
	^ 100@100! !

!OSWindow class methodsFor: 'clipboard handling' stamp: 'RonieSalgado 1/15/2014 15:54'!
clipboardText
	^ self validHandle clipboardText! !

!OSWindow class methodsFor: 'instance creation' stamp: 'RonieSalgado 1/2/2014 08:39'!
createWithAttributes: attributes
	^ self basicNew initWithAttributes: attributes! !

!OSWindow class methodsFor: 'finalization' stamp: 'RonieSalgado 1/3/2014 14:21'!
finalizeResourceData: windowHandle
	windowHandle destroy.! !

!OSWindowAttributes commentStamp: 'IgorStasenko 7/30/2014 16:18'!
My instances hold a number of various attributes, used during initial window creation and its initialization:

- initial bounds
- title
- icon
- screen id
- fullscreen or not
- etc...

Please note, that depending on driver used, some attributes can be ignored by driver and will have no any effect.  

The preferableDriver attribute is special, that it allows user to bypass the default driver selection mechanism and tell directly, which driver shall be used for creating a window.!
!OSWindowAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 1/2/2014 08:28'!
bounds
	
	^ bounds! !

!OSWindowAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 1/3/2014 13:59'!
x
	^ bounds left! !

!OSWindowAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 5/10/2014 01:59'!
animated: anObject
	
	animated := anObject! !

!OSWindowAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 1/2/2014 08:28'!
bounds: anObject
	
	bounds := anObject! !

!OSWindowAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 1/16/2014 17:52'!
applyTo: window
	window title: self title;
		icon: self icon.
	! !

!OSWindowAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 1/2/2014 09:27'!
preferableDriver
	
	^ preferableDriver! !

!OSWindowAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 1/3/2014 14:00'!
height
	^ bounds height! !

!OSWindowAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 1/2/2014 09:02'!
screenId: newScreenId
	screenId := newScreenId! !

!OSWindowAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 1/3/2014 13:59'!
y
	^ bounds top! !

!OSWindowAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 1/2/2014 08:28'!
fullscreen
	
	^ fullscreen! !

!OSWindowAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 5/10/2014 02:00'!
initialize
	animated := false.
	bounds := self class defaultBounds.
	fullscreen := self class defaultFullscreen.
	title := self class defaultTitle.
	glAttributes := nil.! !

!OSWindowAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 1/2/2014 08:28'!
fullscreen: anObject
	
	fullscreen := anObject! !

!OSWindowAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 5/8/2014 22:30'!
glAttributes: anObject
	
	glAttributes := anObject! !

!OSWindowAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 1/2/2014 08:28'!
title
	
	^ title! !

!OSWindowAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 1/2/2014 08:28'!
title: anObject
	
	title := anObject! !

!OSWindowAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 5/8/2014 22:30'!
glAttributes
	
	^ glAttributes! !

!OSWindowAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 1/2/2014 09:40'!
extent: newExtent
	bounds := bounds origin extent: newExtent! !

!OSWindowAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 1/3/2014 14:00'!
width
	^ bounds width! !

!OSWindowAttributes methodsFor: 'private' stamp: 'RonieSalgado 1/7/2014 16:31'!
createWindowHandleFor: osWindow
	^ (preferableDriver ifNil: [ OSWindowDriver current ]) createWindowWithAttributes: self osWindow: osWindow! !

!OSWindowAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 1/16/2014 16:46'!
icon: anObject
	
	icon := anObject! !

!OSWindowAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 1/2/2014 09:41'!
extent
	^ bounds extent! !

!OSWindowAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 5/10/2014 01:59'!
animated
	
	^ animated! !

!OSWindowAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 1/2/2014 09:27'!
preferableDriver: anObject
	
	preferableDriver := anObject! !

!OSWindowAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 1/2/2014 09:02'!
screenId
	^ screenId! !

!OSWindowAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 1/16/2014 16:46'!
icon
	
	^ icon! !

!OSWindowAttributes class methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 1/2/2014 08:31'!
initialize
	"
	self initialize
	"
	DefaultBounds := 0@0 rectangle: 100@100.
	DefaultFullscreen  := false.
	DefaultTitle := 'New Window'! !

!OSWindowAttributes class methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 1/2/2014 08:30'!
defaultFullscreen
	^ DefaultFullscreen! !

!OSWindowAttributes class methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 1/2/2014 08:29'!
defaultTitle
	^ DefaultTitle! !

!OSWindowAttributes class methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 1/2/2014 08:29'!
defaultBounds
	^ DefaultBounds! !

!OSWindowAttributesTest commentStamp: '<historical>'!
An OSWindowAttributesTest is a test class for testing the behavior of OSWindowAttributes!
!OSWindowAttributesTest methodsFor: 'tests' stamp: 'RonieSalgado 1/2/2014 08:34'!
testDefaults
	| attributes |
	attributes := OSWindowAttributes new.
	self assert: attributes bounds = attributes class defaultBounds.
	self assert: attributes fullscreen  = attributes class defaultFullscreen.
	self assert: attributes title = attributes class defaultTitle.! !

!OSWindowClipboard commentStamp: 'IgorStasenko 7/30/2014 16:20'!
This is a private class for handling clipboard text. There's no direct use of it.
For setting/retrieving clipboard text, use clipboardText/clipboardText: accessors of OSWindow instances.!
!OSWindowClipboard methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 1/17/2014 17:43'!
chooseRecentClipping
	^ nil! !

!OSWindowClipboard methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 1/17/2014 17:43'!
noteRecentClipping: text! !

!OSWindowClipboard methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 1/17/2014 17:57'!
clipboardText: aString
	World osWindow clipboardText: aString asString! !

!OSWindowClipboard methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 1/17/2014 17:44'!
clipboardText
	^ World osWindow clipboardText! !

!OSWindowCloseEvent commentStamp: 'IgorStasenko 7/30/2014 17:30'!
I am delivered when user closing the window.
The default action (unless suppressed) will also destroy the window.!
!OSWindowCloseEvent methodsFor: 'visitor' stamp: 'RonieSalgado 1/7/2014 17:27'!
accept: aVisitor
	^ aVisitor visitWindowCloseEvent: self! !

!OSWindowCloseEvent methodsFor: 'default actions' stamp: 'RonieSalgado 1/7/2014 16:38'!
defaultAction
	window destroy! !

!OSWindowDriver commentStamp: 'IgorStasenko 7/30/2014 16:33'!
I am a basic (abstract) class, which represents an OS window driver.
The driver connects an OSWindow instances with underlaying operating system window(s) through managing OSWindowHandle(s). Driver provides an implemenation of all OSWindow functionality, starting from its creation, setting/retrieving its attributes, and finishing with event handling and/or rendering window's contents on screen.

The driver connects OSWindow(s) with operating system windows by providing the handle (see OSWindowHandle). The way how various OSWindow features and API are implemented is up to the concrete driver and thus considered private.

The driver(s) responsible for initial window creation , proper setup and and managing external resources. 
Again, most of driver's functionality is considered private and application-level code should not rely on any of its features. 

Driver selection mechanism:

 - on session change, i scan all of my subclasses to pick a most suitable driver which will be used on current platform (see #current on my class side)!
!OSWindowDriver methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 1/7/2014 16:31'!
createWindowWithAttributes: anOSWindowAttributes osWindow: osWindow
	self subclassResponsibility! !

!OSWindowDriver methodsFor: 'testing' stamp: 'RonieSalgado 1/15/2014 14:50'!
isNullDriver
	^ false! !

!OSWindowDriver class methodsFor: 'testing' stamp: 'RonieSalgado 1/15/2014 14:50'!
isSuitable
	"Answer true if receiver is most suitable for using in current session/platform"
	^ false! !

!OSWindowDriver class methodsFor: 'testing' stamp: 'RonieSalgado 1/15/2014 15:11'!
isSupported
	"Answer true if receiver is most suitable for using in current session/platform"
	^ false! !

!OSWindowDriver class methodsFor: 'accessing' stamp: 'RonieSalgado 1/2/2014 09:22'!
current
	^ Session == Smalltalk session ifTrue: [ Current ifNil: [Current := self pickDriver ]]
		ifFalse: [ 
			Session := Smalltalk session.
			Current := self pickDriver
	]
	! !

!OSWindowDriver class methodsFor: 'driver selection' stamp: 'RonieSalgado 1/15/2014 14:49'!
pickDriver
	self subclassesDo: [ :s | s isSuitable ifTrue: [ ^ s new ] ].
	^ OSNullWindowDriver new! !

!OSWindowDropEvent commentStamp: 'IgorStasenko 7/30/2014 17:31'!
I am delivered when user drop something into the window (of course, if there's a drag and drop support by underlaying platform).!
!OSWindowDropEvent methodsFor: 'visitor' stamp: 'RonieSalgado 1/7/2014 17:27'!
accept: aVisitor
	^ aVisitor visitWindowDropEvent: self! !

!OSWindowEvent commentStamp: 'IgorStasenko 7/30/2014 17:28'!
i am the root of various window events hierarchy!
!OSWindowEvent methodsFor: 'visitor' stamp: 'IgorStasenko 7/30/2014 17:29'!
accept: aVisitor
	self subclassResponsibility ! !

!OSWindowEventVisitor commentStamp: 'IgorStasenko 7/30/2014 17:45'!
i am a abstract visitor for handling events.. 
serving just to cover complete protocol, which user(s) will need to implement in order to act as an OSWindow event handler.!
!OSWindowEventVisitor methodsFor: 'visiting' stamp: 'RonieSalgado 1/7/2014 17:15'!
visitMouseButtonPressEvent: anEvent! !

!OSWindowEventVisitor methodsFor: 'visiting' stamp: 'RonieSalgado 1/7/2014 17:15'!
visitWindowDropEvent: anEvent! !

!OSWindowEventVisitor methodsFor: 'visiting' stamp: 'RonieSalgado 5/9/2014 01:45'!
visitWindowExposeEvent: anEvent! !

!OSWindowEventVisitor methodsFor: 'visiting' stamp: 'RonieSalgado 1/7/2014 17:15'!
visitMouseButtonReleaseEvent: anEvent! !

!OSWindowEventVisitor methodsFor: 'visiting' stamp: 'RonieSalgado 1/7/2014 17:14'!
visitKeyDownEvent: anEvent! !

!OSWindowEventVisitor methodsFor: 'visiting' stamp: 'RonieSalgado 5/8/2014 20:30'!
visitMouseWheelEvent: anEvent! !

!OSWindowEventVisitor methodsFor: 'visiting' stamp: 'RonieSalgado 1/9/2014 16:23'!
visitWindowFocusOutEvent: anEvent! !

!OSWindowEventVisitor methodsFor: 'visiting' stamp: 'RonieSalgado 5/10/2014 02:26'!
visitWindowFrameEvent: anEvent
! !

!OSWindowEventVisitor methodsFor: 'visiting' stamp: 'RonieSalgado 3/25/2014 16:56'!
visitTextInputEvent: anEvent! !

!OSWindowEventVisitor methodsFor: 'visiting' stamp: 'RonieSalgado 1/7/2014 17:15'!
visitWindowCloseEvent: anEvent! !

!OSWindowEventVisitor methodsFor: 'visiting' stamp: 'RonieSalgado 3/25/2014 15:21'!
visitWindowMouseEnterEvent: anEvent! !

!OSWindowEventVisitor methodsFor: 'visiting' stamp: 'RonieSalgado 1/7/2014 17:16'!
visitWindowResizeEvent: anEvent! !

!OSWindowEventVisitor methodsFor: 'visiting' stamp: 'RonieSalgado 1/9/2014 16:23'!
visitWindowFocusInEvent: anEvent! !

!OSWindowEventVisitor methodsFor: 'visiting' stamp: 'RonieSalgado 1/7/2014 17:16'!
visitWindowMoveEvent: anEvent! !

!OSWindowEventVisitor methodsFor: 'visiting' stamp: 'RonieSalgado 1/7/2014 17:14'!
visitKeyUpEvent: anEvent! !

!OSWindowEventVisitor methodsFor: 'visiting' stamp: 'RonieSalgado 3/25/2014 15:21'!
visitWindowMouseLeaveEvent: anEvent! !

!OSWindowEventVisitor methodsFor: 'events' stamp: 'RonieSalgado 5/9/2014 01:52'!
handleEvent: event
	event accept: self! !

!OSWindowEventVisitor methodsFor: 'visiting' stamp: 'RonieSalgado 1/7/2014 17:15'!
visitMouseMoveEvent: anEvent! !

!OSWindowEventVisitor methodsFor: 'visiting' stamp: 'RonieSalgado 1/7/2014 17:15'!
visitUnknownEvent: anEvent! !

!OSWindowExposeEvent commentStamp: 'IgorStasenko 7/30/2014 17:32'!
I am delivered when part (or whole) window are exposed on the desktop and needs refreshing.!
!OSWindowExposeEvent methodsFor: 'accessing' stamp: 'RonieSalgado 5/9/2014 02:18'!
timeStamp: anObject
	
	timeStamp := anObject! !

!OSWindowExposeEvent methodsFor: 'accessing' stamp: 'RonieSalgado 5/9/2014 02:18'!
timeStamp
	
	^ timeStamp! !

!OSWindowExposeEvent methodsFor: 'default actions' stamp: 'RonieSalgado 5/10/2014 00:27'!
defaultAction
	window renderer ifNotNil: [ window renderer exposed: timeStamp ]! !

!OSWindowExposeEvent methodsFor: 'visitor' stamp: 'RonieSalgado 5/9/2014 02:18'!
accept: aVisitor
	^ aVisitor visitWindowExposeEvent: self! !

!OSWindowFocusInEvent commentStamp: 'IgorStasenko 7/30/2014 17:32'!
I am delivered when window obtains a user input focus.!
!OSWindowFocusInEvent methodsFor: 'visitor' stamp: 'RonieSalgado 1/9/2014 16:22'!
accept: aVisitor
	^ aVisitor visitWindowFocusInEvent: self! !

!OSWindowFocusOutEvent commentStamp: 'IgorStasenko 7/30/2014 17:32'!
I am delivered when window loses the user input focus.!
!OSWindowFocusOutEvent methodsFor: 'visitor' stamp: 'RonieSalgado 1/9/2014 16:23'!
accept: aVisitor
	^ aVisitor visitWindowFocusOutEvent: self! !

!OSWindowFormRenderer commentStamp: 'IgorStasenko 7/30/2014 17:04'!
I provide a way of delivering form's bits to window's contents.
To obtain my instance, first one create a valid OSWindow and then use #newFormRenderer: .

Then you can render on form, and form's contents will serve as medium which will be displayed inside a window.!
!OSWindowFormRenderer methodsFor: 'accessing' stamp: 'RonieSalgado 1/6/2014 15:03'!
form
	
	^ form! !

!OSWindowFormRenderer methodsFor: 'size' stamp: 'RonieSalgado 1/13/2014 16:45'!
newExtent: newExtent
	form setExtent: newExtent depth: form depth! !

!OSWindowFormRenderer methodsFor: 'accessing' stamp: 'RonieSalgado 1/10/2014 18:02'!
getCanvas
	^ form getCanvas! !

!OSWindowFormRenderer methodsFor: 'morphic integration' stamp: 'RonieSalgado 5/9/2014 23:17'!
forceDisplayUpdate! !

!OSWindowFormRenderer methodsFor: 'morphic integration' stamp: 'RonieSalgado 3/25/2014 01:52'!
deferUpdatesWhile: aBlock

	aBlock value! !

!OSWindowFormRenderer methodsFor: 'morphic integration' stamp: 'RonieSalgado 3/25/2014 01:52'!
updateAreas: allDamage immediate: forceToScreen
	"Force all the damage rects to the screen."
	allDamage do: [ :r| self updateRectangle: r ].! !

!OSWindowFormRenderer methodsFor: 'accessing' stamp: 'RonieSalgado 1/6/2014 15:03'!
form: anObject
	
	form := anObject! !

!OSWindowFrameEvent commentStamp: 'IgorStasenko 7/30/2014 17:33'!
Some strange event nobody knows what it does.??!
!OSWindowFrameEvent methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 5/10/2014 02:19'!
accept: aVisitor
	^ aVisitor visitWindowFrameEvent: self! !

!OSWindowGLAttributes commentStamp: 'IgorStasenko 7/30/2014 16:38'!
I holding a set of OpenGL attributes, used to initialize an opengl rendering context for a window.!
!OSWindowGLAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 5/8/2014 22:23'!
alphaSize
	
	^ alphaSize! !

!OSWindowGLAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 5/8/2014 22:23'!
greenSize: anObject
	
	greenSize := anObject! !

!OSWindowGLAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 5/8/2014 22:23'!
redSize
	
	^ redSize! !

!OSWindowGLAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 5/8/2014 22:23'!
swapControl: anObject
	
	swapControl := anObject! !

!OSWindowGLAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 5/8/2014 22:23'!
blueSize
	
	^ blueSize! !

!OSWindowGLAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 5/8/2014 22:23'!
depthSize: anObject
	
	depthSize := anObject! !

!OSWindowGLAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 5/8/2014 22:23'!
doubleBuffer
	
	^ doubleBuffer! !

!OSWindowGLAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 5/8/2014 22:27'!
stencilSize
	^ stencilSize! !

!OSWindowGLAttributes methodsFor: 'initialization' stamp: 'RonieSalgado 5/8/2014 22:29'!
initialize
	redSize := DefaultRedSize.
	greenSize := DefaultGreenSize.
	blueSize := DefaultBlueSize.
	alphaSize := DefaultAlphaSize.
	depthSize := DefaultDepthSize.
	stencilSize := DefaultStencilSize.
	doubleBuffer := DefaultDoubleBuffer.
	swapControl := DefaultSwapControl.! !

!OSWindowGLAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 5/8/2014 22:23'!
greenSize
	
	^ greenSize! !

!OSWindowGLAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 5/8/2014 22:23'!
depthSize
	
	^ depthSize! !

!OSWindowGLAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 5/8/2014 22:23'!
doubleBuffer: anObject
	
	doubleBuffer := anObject! !

!OSWindowGLAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 5/8/2014 22:23'!
redSize: anObject
	
	redSize := anObject! !

!OSWindowGLAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 5/8/2014 22:27'!
stencilSize: aStencilSize
	stencilSize := aStencilSize! !

!OSWindowGLAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 5/8/2014 22:23'!
swapControl
	
	^ swapControl! !

!OSWindowGLAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 5/8/2014 22:23'!
blueSize: anObject
	
	blueSize := anObject! !

!OSWindowGLAttributes methodsFor: 'accessing' stamp: 'RonieSalgado 5/8/2014 22:23'!
alphaSize: anObject
	
	alphaSize := anObject! !

!OSWindowGLAttributes class methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 5/8/2014 22:55'!
initialize
	"
	self initialize
	"
	super initialize.
	
	DefaultRedSize := 5.
	DefaultGreenSize := 5.
	DefaultBlueSize := 5.
	DefaultAlphaSize := 5.
	DefaultDepthSize := 16.
	DefaultDoubleBuffer := 1.
	DefaultStencilSize := 0.
	DefaultSwapControl := 0.! !

!OSWindowGLAttributes class methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 5/8/2014 22:23'!
defaultRedSize
	^ DefaultRedSize! !

!OSWindowGLAttributes class methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 5/8/2014 22:24'!
defaultAlphaSize
	^ DefaultAlphaSize! !

!OSWindowGLAttributes class methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 5/8/2014 22:24'!
defaultDoubleBuffer
	^ DefaultDoubleBuffer! !

!OSWindowGLAttributes class methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 5/8/2014 22:24'!
defaultDepthSize
	^ DefaultDepthSize! !

!OSWindowGLAttributes class methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 5/8/2014 22:23'!
defaultGreenSize
	^ DefaultGreenSize! !

!OSWindowGLAttributes class methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 5/8/2014 22:23'!
defaultBlueSize
	^ DefaultBlueSize! !

!OSWindowGLAttributes class methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 5/8/2014 22:24'!
defaultStencilSize
	^ DefaultStencilSize! !

!OSWindowGLAttributes class methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 5/8/2014 22:25'!
defaultSwapControl
	^ DefaultSwapControl! !

!OSWindowGLRenderer commentStamp: 'IgorStasenko 7/30/2014 17:48'!
i am abstract OpenGL renderer facade. !
!OSWindowGLRenderer methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 5/8/2014 22:36'!
getProcAddress: procName
	"Gets an OpenGL procedure address."
	self subclassResponsibility! !

!OSWindowGLRenderer methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 5/8/2014 22:35'!
swapBuffers
	self subclassResponsibility! !

!OSWindowGLRenderer methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 5/8/2014 22:36'!
makeCurrent
	"Makes the current context"
	self subclassResponsibility! !

!OSWindowHandle commentStamp: 'IgorStasenko 7/30/2014 16:40'!
I am abstract class, representing an OSWindow handle.
Each instance of OSWindow holds a handle, through which it communicates with underlaying operating system.

The implementation of OSWindowHandle (and subclasses) is highly driver-specific and therefore considered private.!
!OSWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/10/2014 15:29'!
bounds
	self subclassResponsibility ! !

!OSWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/10/2014 15:31'!
extent: newExtent
	self subclassResponsibility ! !

!OSWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/10/2014 15:27'!
renderer
	
	^ renderer! !

!OSWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/10/2014 15:30'!
bounds: newBounds
	self subclassResponsibility ! !

!OSWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/15/2014 16:01'!
clipboardText: aString
	self subclassResponsibility ! !

!OSWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/10/2014 15:27'!
osWindow
	
	^ osWindow! !

!OSWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/10/2014 15:32'!
position: newPosition
	self subclassResponsibility ! !

!OSWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 3/26/2014 03:42'!
setMouseCursor: cursorWithMask! !

!OSWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 3/26/2014 03:39'!
icon: aForm! !

!OSWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/10/2014 15:30'!
extent
	^ self bounds extent! !

!OSWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 3/26/2014 15:02'!
fullscreen: aBoolean! !

!OSWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/10/2014 15:40'!
title
	self subclassResponsibility ! !

!OSWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/10/2014 15:31'!
position
	^ self bounds origin! !

!OSWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/15/2014 16:01'!
clipboardText
	self subclassResponsibility ! !

!OSWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/10/2014 15:27'!
osWindow: anObject
	
	osWindow := anObject! !

!OSWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/10/2014 15:40'!
title: aTitle
	self subclassResponsibility ! !

!OSWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/10/2014 15:30'!
isValid
	self subclassResponsibility ! !

!OSWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/10/2014 15:32'!
show: aBoolean
	self subclassResponsibility ! !

!OSWindowHandle methodsFor: 'accessing' stamp: 'RonieSalgado 1/10/2014 15:27'!
renderer: anObject
	
	renderer := anObject! !

!OSWindowMorphicEventHandler commentStamp: 'IgorStasenko 7/30/2014 17:46'!
I can be used to convert OSWindow-level events to Morphic events.
So, that installing my instance as event handler for specific window would allow running Morphic World in it.

Later, the Morphic can be integrated with OSWindow API to avoid unnecessary conversion and thus eliminating the need in having this class.!
!OSWindowMorphicEventHandler methodsFor: 'visiting' stamp: 'RonieSalgado 1/15/2014 14:22'!
visitMouseButtonPressEvent: anEvent
	anEvent button > 3 ifTrue: [ 
		^ MouseWheelEvent new 
					setType: #mouseWheel
					position: anEvent position
					direction: (anEvent button = 4 ifTrue: [#up] ifFalse: [#down])
					buttons: (self convertModifiers: anEvent modifiers)
					hand: morphicWorld activeHand
					stamp: Time millisecondClockValue
	].
	^ MouseButtonEvent basicNew
		setType: #mouseDown 
		position: anEvent position 
		which: (self convertButton: anEvent button)
		buttons: (self convertModifiers: anEvent modifiers) | (self convertButton: anEvent button)
		hand: morphicWorld activeHand
		stamp: Time millisecondClockValue! !

!OSWindowMorphicEventHandler methodsFor: 'accessing' stamp: 'RonieSalgado 1/9/2014 18:23'!
morphicWorld
	^ morphicWorld! !

!OSWindowMorphicEventHandler methodsFor: 'visiting' stamp: 'RonieSalgado 1/15/2014 14:22'!
visitMouseButtonReleaseEvent: anEvent
	anEvent button > 3 ifTrue: [ ^ nil ].

	^ MouseButtonEvent basicNew
		setType: #mouseUp
		position: anEvent position 
		which: (self convertButton: anEvent button)
		buttons: (self convertModifiers: anEvent modifiers)
		hand: morphicWorld activeHand
		stamp: Time millisecondClockValue! !

!OSWindowMorphicEventHandler methodsFor: 'visiting' stamp: 'RonieSalgado 5/8/2014 20:26'!
visitKeyDownEvent: anEvent
	| keyEvent keyEvent2 |

	keyEvent := KeyboardEvent new
		setType: #keyDown
		buttons: (self convertModifiers: anEvent modifiers)
		position: anEvent position
		keyValue: anEvent characterCode
		charCode: anEvent characterCode
		hand:  morphicWorld activeHand
		stamp: Time millisecondClockValue.
	keyEvent scanCode: anEvent scanCode.
	
	self dispatchMorphicEvent: keyEvent.
	anEvent character ifNil: [ ^ nil ].
	
	keyEvent2 := KeyboardEvent new
		setType: #keystroke
		buttons: (self convertModifiers: anEvent modifiers)
		position: anEvent position
		keyValue: anEvent characterCode
		charCode: anEvent characterCode
		hand:  morphicWorld activeHand
		stamp: Time millisecondClockValue.
	keyEvent2 scanCode: anEvent scanCode.

	^ keyEvent2! !

!OSWindowMorphicEventHandler methodsFor: 'visiting' stamp: 'RonieSalgado 5/8/2014 20:31'!
visitMouseWheelEvent: anEvent
	| vertical |
	vertical := anEvent scrollVertical.
	vertical = 0 ifTrue: [ ^ nil ].
	
	^ MouseWheelEvent new 
		setType: #mouseWheel
		position: anEvent position
		direction: (vertical > 0 ifTrue: [#up] ifFalse: [#down])
		buttons: (self convertModifiers: anEvent modifiers)
		hand: morphicWorld activeHand
		stamp: Time millisecondClockValue! !

!OSWindowMorphicEventHandler methodsFor: 'converting' stamp: 'RonieSalgado 1/9/2014 16:41'!
convertModifiers: modifiers
	| buttons |
	buttons := 0.
	modifiers alt ifTrue: [ buttons := buttons | 2r01000000 ]. "Alt/Option key"
	modifiers ctrl ifTrue: [ buttons := buttons | 2r00010000 ]. "Control key"
	modifiers shift ifTrue: [ buttons := buttons | 8 ]. "Shift key"
	modifiers buttons button1 ifTrue:  [ buttons := buttons | MouseButtonEvent redButton ].
	modifiers buttons button2 ifTrue:  [ buttons := buttons | MouseButtonEvent blueButton ].
	modifiers buttons button3 ifTrue:  [ buttons := buttons | MouseButtonEvent yellowButton ].
	^ buttons! !

!OSWindowMorphicEventHandler methodsFor: 'visiting' stamp: 'RonieSalgado 3/25/2014 17:15'!
visitTextInputEvent: anEvent
	| keyEvent char |
	anEvent text ifNil: [ ^ nil ].
	char := anEvent text first.
	char ifNil: [ ^ nil ].
	
	keyEvent := KeyboardEvent new
		setType: #keystroke
		buttons: (self convertModifiers: anEvent modifiers)
		position: anEvent position
		keyValue: char charCode
		charCode: char charCode
		hand:  morphicWorld activeHand
		stamp: Time millisecondClockValue.
	^ keyEvent! !

!OSWindowMorphicEventHandler methodsFor: 'visiting' stamp: 'RonieSalgado 4/17/2014 22:30'!
visitWindowCloseEvent: anEvent
	anEvent suppressDefaultAction
	"TODO: Ask to quit"! !

!OSWindowMorphicEventHandler methodsFor: 'events' stamp: 'RonieSalgado 1/9/2014 18:29'!
dispatchMorphicEvent: anEvent

	morphicWorld defer: [  		
			morphicWorld activeHand handleEvent: anEvent ]. 
	
	! !

!OSWindowMorphicEventHandler methodsFor: 'accessing' stamp: 'RonieSalgado 1/9/2014 18:23'!
morphicWorld: aMorphicWorld
	morphicWorld := aMorphicWorld! !

!OSWindowMorphicEventHandler methodsFor: 'visiting' stamp: 'RonieSalgado 1/15/2014 14:22'!
visitKeyUpEvent: anEvent
	| keyEvent |
	keyEvent := KeyboardEvent new
		setType: #keyUp
		buttons: (self convertModifiers: anEvent modifiers)
		position: anEvent position
		keyValue: anEvent characterCode
		charCode: (anEvent characterCode ifNil: [0])
		hand:  morphicWorld activeHand
		stamp: Time millisecondClockValue.
	keyEvent scanCode: anEvent scanCode.
	^ keyEvent! !

!OSWindowMorphicEventHandler methodsFor: 'converting' stamp: 'RonieSalgado 1/8/2014 14:32'!
convertButton: osButton
	osButton = 1 ifTrue: [ ^ MouseButtonEvent redButton ].
	osButton = 2 ifTrue: [ ^ MouseButtonEvent blueButton ].
	osButton = 3 ifTrue: [ ^ MouseButtonEvent yellowButton ].! !

!OSWindowMorphicEventHandler methodsFor: 'events' stamp: 'IgorStasenko 7/30/2014 17:46'!
handleEvent: anEvent
	
	"convert the event to morphic one, and dispatch it whatever..."
	| morphicEvent |
	
	morphicEvent := anEvent accept: self.
	
	morphicEvent isMorphicEvent ifTrue: [  
		self dispatchMorphicEvent: morphicEvent ]. 
	
	! !

!OSWindowMorphicEventHandler methodsFor: 'visiting' stamp: 'RonieSalgado 1/9/2014 18:27'!
visitMouseMoveEvent: anEvent
	| oldPos |
	oldPos := morphicWorld activeHand position.

	^ MouseMoveEvent basicNew
		setType: #mouseMove 
		startPoint: oldPos
		endPoint: anEvent position 
		trail: { oldPos. anEvent position }
		buttons: (self convertModifiers: anEvent modifiers)
		hand: morphicWorld  activeHand
		stamp: Time millisecondClockValue! !

!OSWindowMorphicEventHandler methodsFor: 'visiting' stamp: 'RonieSalgado 1/7/2014 17:34'!
visitUnknownEvent: anEvent

	Transcript show: 'Unknown event: ', anEvent data printString; cr! !

!OSWindowMorphicEventHandler class methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 1/9/2014 18:22'!
for: morphicWorld
	^ self new morphicWorld: morphicWorld; yourself! !

!OSWindowMouseEnterEvent commentStamp: 'IgorStasenko 7/30/2014 17:34'!
I am delivered when mouse enters the area , covered by a window!
!OSWindowMouseEnterEvent methodsFor: 'visitor' stamp: 'RonieSalgado 3/25/2014 15:20'!
accept: aVisitor
	^ aVisitor visitWindowMouseEnterEvent: self! !

!OSWindowMouseLeaveEvent commentStamp: 'IgorStasenko 7/30/2014 17:34'!
I am delivered when mouse leaves the area , covered by a window!
!OSWindowMouseLeaveEvent methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 3/25/2014 15:21'!
accept: aVisitor
	^ aVisitor visitWindowMouseLeaveEvent: self! !

!OSWindowMoveEvent commentStamp: 'IgorStasenko 7/30/2014 17:34'!
I am delivered when window moved by user or OS/window manager.!
!OSWindowMoveEvent methodsFor: 'visitor' stamp: 'RonieSalgado 1/7/2014 17:27'!
accept: aVisitor
	^ aVisitor visitWindowMoveEvent: self! !

!OSWindowRenderThread commentStamp: '<historical>'!
I am a pharo process that performs all rendering calls. !
!OSWindowRenderThread class methodsFor: 'render thread' stamp: 'RonieSalgado 5/10/2014 02:50'!
enqueueOperation: operation
	self enqueueOperation: operation blocking: false! !

!OSWindowRenderThread class methodsFor: 'render thread' stamp: 'RonieSalgado 5/10/2014 03:05'!
executeRenderOperations
	| operation  |
	[ operation := RenderThreadQueue nextOrNil.
	  operation  ~~ nil ] whileTrue: [ 
		operation execute
	].
! !

!OSWindowRenderThread class methodsFor: 'session management' stamp: 'RonieSalgado 5/9/2014 23:43'!
checkSession
	RenderSession ~~ Smalltalk session ifTrue: [ 
		self createRenderThread.
		RenderSession := Smalltalk session.
	]
! !

!OSWindowRenderThread class methodsFor: 'window animation' stamp: 'RonieSalgado 5/11/2014 23:21'!
createdWindow: window
	self checkSession.
	RegisteredWindowsMutex critical: [
		RegisteredWindows add: window
	]
! !

!OSWindowRenderThread class methodsFor: 'render thread' stamp: 'RonieSalgado 5/10/2014 00:53'!
isThisThread
	^ Processor activeProcess == RenderThreadProcess

! !

!OSWindowRenderThread class methodsFor: 'render thread' stamp: 'RonieSalgado 5/10/2014 03:03'!
renderThreadProcess
	| session |
	session := Smalltalk session.
	
	[session == Smalltalk session] whileTrue: [
		"Execute the enqueued rendering operations"
		OperationAvailableSemaphore consumeAllSignals.
		self executeRenderOperations.
		
		"Animations must be refreshed periodically"
		self performAnimationFrames
	]


! !

!OSWindowRenderThread class methodsFor: 'window animation' stamp: 'RonieSalgado 5/10/2014 03:05'!
animationStep
	^ 10! !

!OSWindowRenderThread class methodsFor: 'window animation' stamp: 'RonieSalgado 5/10/2014 02:37'!
performAnimationFrames
	| windows hasAnimated |
	
	" Copy the registered windows. "
	RegisteredWindowsMutex critical: [ 
		windows := RegisteredWindows copy.
	].

	" Try to animate them. "
	hasAnimated := false.
	windows do: [ :window |
		(window isValid and: [window animated == true]) ifTrue: [ 
			hasAnimated := true.
			self doAnimationFrameFor: window.
		]
	].

	"Wait for another operation event or a time out."
	hasAnimated ifTrue:  [ 
		OperationAvailableSemaphore waitTimeoutMSecs: self animationStep.
	] ifFalse: [ 
		OperationAvailableSemaphore wait.
	]! !

!OSWindowRenderThread class methodsFor: 'render thread' stamp: 'RonieSalgado 5/10/2014 03:09'!
createRenderThread
	RenderThreadProcess ifNotNil: [ RenderThreadProcess terminate ].
	
	RenderThreadQueue := AtomicSharedQueue new.
	OperationAvailableSemaphore := Semaphore new.
	
	RegisteredWindows := WeakSet new.
	RegisteredWindowsMutex := Semaphore forMutualExclusion.
	
	RenderThreadProcess := [ self renderThreadProcess ] forkAt: Processor userSchedulingPriority.
	RenderThreadProcess name:  'OS Window Renderer Loop'; resume.
! !

!OSWindowRenderThread class methodsFor: 'render thread' stamp: 'RonieSalgado 5/10/2014 02:49'!
enqueueOperation: operation blocking: blocking
	" If this is in the RenderThread, execute directly"
	| operationHandle |
	Processor activeProcess == RenderThreadProcess ifTrue: [ operation value ].
	
	"Enqueue for execution in the render thread."
	self checkSession.
	
	"Enqueue the operation"
	operationHandle := OSWindowRenderThreadOperation new: operation blocking: blocking.
	RenderThreadQueue nextPut: operationHandle.
	OperationAvailableSemaphore signal.

	"Wait for blocking operations."
	blocking ifTrue: [ operationHandle wait ]
	! !

!OSWindowRenderThread class methodsFor: 'render thread' stamp: 'RonieSalgado 5/10/2014 02:50'!
enqueueBlockingOperation: operation
	self enqueueOperation: operation blocking: true! !

!OSWindowRenderThread class methodsFor: 'window animation' stamp: 'RonieSalgado 5/10/2014 02:20'!
doAnimationFrameFor: window
	"TODO: Handle errors produced here"
	(OSWindowFrameEvent for: window) deliver! !

!OSWindowRenderThread class methodsFor: 'window animation' stamp: 'RonieSalgado 5/11/2014 23:21'!
destroyedWindow: window
	self checkSession.
	RegisteredWindowsMutex critical:  [ 
		RegisteredWindows remove: window ifAbsent: [ nil ]
	]! !

!OSWindowRenderThreadOperation commentStamp: '<historical>'!
I am a render operation, used to send commands (which can be asynchronous or synchronous) to the render thread. !
!OSWindowRenderThreadOperation methodsFor: 'waiting' stamp: 'RonieSalgado 5/10/2014 02:52'!
blocking
	^ blocking! !

!OSWindowRenderThreadOperation methodsFor: 'waiting' stamp: 'RonieSalgado 5/9/2014 23:49'!
wait
	semaphore wait! !

!OSWindowRenderThreadOperation methodsFor: 'initialize' stamp: 'RonieSalgado 5/9/2014 23:49'!
initWithOperation: anOperation
	semaphore := Semaphore new.
	operation := anOperation.
	
	! !

!OSWindowRenderThreadOperation methodsFor: 'initialize' stamp: 'RonieSalgado 5/10/2014 02:47'!
initWithOperation: anOperation blocking: isBlocking
	semaphore := Semaphore new.
	operation := anOperation.
	blocking := isBlocking
	
	! !

!OSWindowRenderThreadOperation methodsFor: 'execute' stamp: 'RonieSalgado 5/9/2014 23:49'!
execute
	[ 
		operation value
	] ensure: [ semaphore signal ]! !

!OSWindowRenderThreadOperation class methodsFor: 'instance creation' stamp: 'RonieSalgado 5/10/2014 02:47'!
new: anOperation
	^ self new: anOperation blocking: false! !

!OSWindowRenderThreadOperation class methodsFor: 'instance creation' stamp: 'RonieSalgado 5/10/2014 02:47'!
new: anOperation blocking: isBlocking
	^ self basicNew initWithOperation: anOperation blocking: isBlocking; yourself! !

!OSWindowRenderer commentStamp: 'IgorStasenko 7/30/2014 17:01'!
My instances are used for updating the OSWindow contents by rendering on it.
There is no way to obtain a valid instance of window renderer other than asking a valid instance of OSWindow for window renderer instance.
See newFormRenderer: / newOpenGLRenderer factory methods.!
!OSWindowRenderer methodsFor: 'accessing' stamp: 'RonieSalgado 1/6/2014 15:17'!
window
	
	^ window! !

!OSWindowRenderer methodsFor: 'accessing' stamp: 'RonieSalgado 1/6/2014 15:17'!
window: anObject
	
	window := anObject! !

!OSWindowRenderer methodsFor: 'updating screen' stamp: 'RonieSalgado 5/8/2014 23:22'!
initialize
	lastExposeTime := 0! !

!OSWindowRenderer methodsFor: 'updating screen' stamp: 'RonieSalgado 1/10/2014 16:11'!
updateAll
		"do something to update whole contents of the window"
		
		self subclassResponsibility ! !

!OSWindowRenderer methodsFor: 'initialize' stamp: 'RonieSalgado 3/25/2014 02:14'!
destroy
	"Called when the window associated with the renderer is destroyed"! !

!OSWindowRenderer methodsFor: 'updating screen' stamp: 'RonieSalgado 1/3/2014 15:45'!
updateRectangle: rectangle
		"do something to update given portion of the window"
		
		self subclassResponsibility ! !

!OSWindowRenderer methodsFor: 'render thread' stamp: 'RonieSalgado 5/9/2014 23:54'!
onRenderThreadBlocking: aBlock
	OSWindowRenderThread enqueueBlockingOperation: aBlock
! !

!OSWindowRenderer methodsFor: 'updating screen' stamp: 'RonieSalgado 5/8/2014 23:24'!
exposed: exposeTime
	(lastExposeTime notNil and: [ exposeTime <= lastExposeTime]) ifTrue: [ ^ self ].
	lastExposeTime := exposeTime.
	self exposed! !

!OSWindowRenderer methodsFor: 'updating screen' stamp: 'RonieSalgado 5/8/2014 23:16'!
exposed
	self updateAll! !

!OSWindowRenderer methodsFor: 'render thread' stamp: 'RonieSalgado 5/9/2014 23:51'!
onRenderThread: aBlock
	"OSWindowRenderThread enqueue: aBlock"
	aBlock value
! !

!OSWindowResizeEvent commentStamp: 'IgorStasenko 7/30/2014 17:41'!
I am delivered when window resized by user or OS/window manager.!
!OSWindowResizeEvent methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 1/7/2014 17:27'!
accept: aVisitor
	^ aVisitor visitWindowResizeEvent: self! !

!OSWindowTest commentStamp: '<historical>'!
An OSWindowTest is a test class for testing the behavior of OSWindow!
!OSWindowTest methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 1/2/2014 09:32'!
testCreatingWindow

	| window attributes |
	attributes := OSWindowAttributes new.
	attributes preferableDriver: OSNullWindowDriver new.
	window := OSWindow createWithAttributes: attributes.

	self assert: (window isValid).
! !

!OSWindowTest methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 4/10/2015 10:40'!
testSettingUpWindow

	| window |
	
	self skip. "not yet working in Windows"
	window := OSWindow new.
	
	[
		window extent: 100@100.
		self assert: (window extent = (100@100)).	
		self assert: (window isValid).
	] ensure: [ window destroy ].
	self assert: (window isValid not)! !

!OSWindowTest methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 4/10/2015 10:39'!
testNewWindowDefaults

	| window |
	self skip. "not yet working on windows"
	
	window := OSWindow new.

	[
		self assert: (window isValid).
		self assert: window extent = window class defaultExtent.
	] ensure: [ window destroy ]
		
	! !

!Object commentStamp: '<historical>'!
Object is the root class for almost all of the other classes in the class hierarchy. The exceptions are ProtoObject (the superclass of Object) and its subclasses.

Class Object provides default behavior common to all normal objects, such as access, copying, comparison, error handling, message sending, and reflection. Also utility messages that all objects should respond to are defined here.

Object has no instance variables, nor should any be added. This is due to several classes of objects that inherit from Object that have special implementations (SmallInteger and UndefinedObject for example) or the VM knows about and depends on the structure and layout of certain standard classes.

Class Variables:
	DependentsFields		an IdentityDictionary
		Provides a virtual 'dependents' field so that any object may have one
		or more dependent views, synchronized by the changed:/update: protocol.
		Note that class Model has a real slot for its dependents, and overrides
		the associated protocol with more efficient implementations.

Because Object is the root of the inheritance tree, methods are often defined in Object to give all objects special behaviors needed by certain subsystems or applications, or to respond to certain general test messages such as isMorph.





Miscellanous Discussions.

About at: index accepting float and not only integers
 
This behavior is also free in the sense that the failure code is only invoked when the
primitive fails and so adds nothing to the cost of successful accesses,
which are the high dynamic frequency operation.  It will also show up under
profiling if one is concerned about efficiency, and so isn't a hidden cost.

It is also in keeping with Smalltalk's mixed mode/arbitrary precision
implicit coercion number system that one *can* use fractions or floats as
indices.  Stripping out coercions like this will make the system more brittle.  So 
please do *not* remove this "hack".  I think it's a feature and a useful  one.

Can you give me an example that demonstrates the usefulness of this
feature?

| a r |
a := Array new: 10 withAll: 0.
r := Random new.
100 timesRepeat: [| v | v := r next * 10 + 1. a at: v put: (a at: v) + 1].
a

i.e. I didn't have to provide an explicit rounding step.  That's useful.  But in general anywhere 
where an index is derived by some calculation not having to provide the rounding step could be 
useful/helpful/more concise.  e.g. (n roundTo: 0.1) * 10 vs ((n roundTo: 0.1) * 10) asInteger.

Some thought went into the original choice.  It is not a hack but there by intent.  The integers are 
simply a subset of the reals and forcing the programmer to use them is favouring the machine 
above the programmer.

But I think you should justify getting rid of it rather than my having to justify keeping it.  Getting 
rid of it risks breaking code.  If it is there but does not harm then why get rid of it?

best Eliot Miranda 

!
!Object methodsFor: 'memory usage' stamp: 'GuillermoPolito 6/28/2013 11:06'!
sizeInMemory
    "Answer the number of bytes consumed by this instance including object header."
    | contentBytes |

	contentBytes := Smalltalk wordSize. "base header"
	contentBytes := contentBytes + (self class instSize * Smalltalk wordSize). "instance vars"

	self class isVariable ifTrue:[ | bytesPerElement | "indexed elements"
		bytesPerElement := self class isBytes ifTrue: [1] ifFalse: [4].
		contentBytes := (contentBytes + (self basicSize * bytesPerElement)).
		"If we are not filling an ammount of bytes multiple of the wordSize, we do it"
		(contentBytes \\ Smalltalk wordSize) = 0 ifFalse: [
			| extraBytesToFillAWord |
			extraBytesToFillAWord := Smalltalk wordSize - (contentBytes \\ Smalltalk wordSize).
			contentBytes := contentBytes + extraBytesToFillAWord.
		]
	].

	contentBytes > 255 ifTrue:	[ contentBytes := contentBytes +  (2 * Smalltalk wordSize) ]
						ifFalse:	[ self class isCompact
									ifFalse: [ contentBytes := contentBytes + Smalltalk wordSize]
								].
	^contentBytes! !

!Object methodsFor: 'drag and drop' stamp: ''!
acceptDroppingMorph: transferMorph event: evt inMorph: dstListMorph 
	
	^false.! !

!Object methodsFor: 'literal testing' stamp: 'md 1/20/2006 17:09'!
hasLiteralSuchThat: testBlock
	"This is the end of the imbedded structure path so return false."

	^ false! !

!Object methodsFor: 'message performing' stamp: 'ClementBera 4/21/2013 14:49'!
perform: selector withArguments: argArray 
	"Send the selector, aSymbol, to the receiver with arguments in argArray.
	Fail if the number of arguments expected by the selector 
	does not match the size of argArray.
	Primitive. Optional. See Object documentation whatIsAPrimitive."
	
	<reflective: #object:performMessageWithArgs:>
	<primitive: 84>
	^ self perform: selector withArguments: argArray inSuperclass: self class! !

!Object methodsFor: 'introspection' stamp: 'eem 5/14/2008 13:20'!
instVarNamed: aString
	"Return the value of the instance variable in me with that name.  Slow and unclean, but very useful. "

	^ self instVarAt: (self class
						instVarIndexFor: aString asString
						ifAbsent: [self error: 'no such inst var'])


! !

!Object methodsFor: 'flagging' stamp: 'sw 8/4/97 16:49'!
isThisEverCalled
	^ self isThisEverCalled: thisContext sender printString! !

!Object methodsFor: 'converting' stamp: 'nice 3/28/2006 23:29'!
adaptToInteger: rcvr andCompare: selector 
	"If I am involved in comparison with an Integer.
	Default behaviour is to process comparison as any other selectors."
	^ self adaptToInteger: rcvr andSend: selector! !

!Object methodsFor: '*NativeBoost-core' stamp: 'IgorStasenko 11/24/2012 16:07'!
nbCall: fnSpec options: callOptions
	" you can override this method if you need to"

	^ (self nbCalloutIn: thisContext sender)
		convention: self nbCallingConvention;
		options: callOptions;
		function: fnSpec module: self nbLibraryNameOrHandle ! !

!Object methodsFor: 'user interface' stamp: 'sw 10/5/1998 14:39'!
addModelMenuItemsTo: aCustomMenu forMorph: aMorph hand: aHandMorph 
	"The receiver serves as the model for aMorph; a menu is being constructed for the morph, and here the receiver is able to add its own items"
! !

!Object methodsFor: '*Tool-Base' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
defaultBackgroundColor
	"Answer the color to be used as the base window color for a window whose model is an object of the receiver's class"
	
	"I don't want to do a self theme  because otherwise I will need to implement it on Object"
	^  Smalltalk ui theme windowColorFor: self! !

!Object methodsFor: 'reflective operations' stamp: 'MartinDias 7/1/2013 14:55'!
becomeForward: otherObject copyHash: copyHash
	"Primitive. All variables in the entire system that used to point to the receiver now point to the argument.
	If copyHash is true, the argument's identity hash bits will be set to those of the receiver.
	Fails if either argument is a SmallInteger."

	(Array with: self)
		elementsForwardIdentityTo: (Array with: otherObject)
		copyHash: copyHash! !

!Object methodsFor: '*Kernel-Exceptions-debugging' stamp: 'BenComan 1/28/2015 00:21'!
haltIf: condition
	<debuggerCompleteToSender>
	Halt if: condition.! !

!Object methodsFor: 'printing' stamp: 'di 6/20/97 09:12'!
storeString
	"Answer a String representation of the receiver from which the receiver 
	can be reconstructed."

	^ String streamContents: [:s | self storeOn: s]! !

!Object methodsFor: '*Monticello-Storing' stamp: 'tk 4/8/1999 12:05'!
readDataFrom: aDataStream size: varsOnDisk
	"Fill in the fields of self based on the contents of aDataStream.  Return self.
	 Read in the instance-variables written by Object>>storeDataOn:.
	 NOTE: This method must send beginReference: before reading any objects from aDataStream that might reference it.
	 Allow aDataStream to have fewer inst vars.  See SmartRefStream."
	| cntInstVars cntIndexedVars |

	cntInstVars := self class instSize.
	self class isVariable
		ifTrue: [cntIndexedVars := varsOnDisk - cntInstVars.
				cntIndexedVars < 0 ifTrue: [
					self error: 'Class has changed too much.  Define a convertxxx method']]
		ifFalse: [cntIndexedVars := 0.
				cntInstVars := varsOnDisk]. 	"OK if fewer than now"

	aDataStream beginReference: self.
	1 to: cntInstVars do:
		[:i | self instVarAt: i put: aDataStream next].
	1 to: cntIndexedVars do:
		[:i | self basicAt: i put: aDataStream next].
	"Total number read MUST be equal to varsOnDisk!!"
	^ self	"If we ever return something other than self, fix calls 
			on (super readDataFrom: aDataStream size: anInteger)"! !

!Object methodsFor: 'nil testing' stamp: 'MarcusDenker 12/2/2013 14:15'!
ifNotNilDo: aBlock ifNil: nilBlock
	"please use #ifNotNil:ifNil: "

	^ aBlock value: self
! !

!Object methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
metacelloIntegerLessThanSelf: anInteger

	^self error: 'Invalid Metacello verson component - should be String or Integer.'! !

!Object methodsFor: '*System-Settings-Browser' stamp: 'alain.plantec 3/24/2009 23:21'!
settingFixedDomainValueNodeFrom: aSettingNode 
	^ aSettingNode fixedDomainValueNodeForObject: self! !

!Object methodsFor: '*Glamour-Helpers' stamp: ' 4/5/09 22:18'!
glamourValueWithArgs: anArray 
	 
	^self! !

!Object methodsFor: 'finalization' stamp: 'ar 3/21/98 16:27'!
finalize
	"Finalize the resource associated with the receiver. This message should only be sent during the finalization process. There is NO garantuee that the resource associated with the receiver hasn't been free'd before so take care that you don't run into trouble - this all may happen with interrupt priority."! !

!Object methodsFor: '*Monticello-Storing' stamp: 'CamilloBruni 8/1/2012 16:02'!
comeFullyUpOnReload: smartRefStream
	"Normally this read-in object is exactly what we want to store."

	^ self! !

!Object methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 1/22/2015 21:33'!
phlowValue: anObject value: otherObject

	^ self! !

!Object methodsFor: '*GT-Spotter' stamp: 'TudorGirba 3/22/2015 13:54'!
spotterPreviewIn: aComposite inContext: aSpotter

	| pragmas |
	pragmas := Pragma 
				allNamed: #spotterPreview: 
				from: self class 
				to: Object
				sortedUsing: [: x :y | (x argumentAt: 1) < (y argumentAt: 1)].
	"We iterate through all pragmas and execute the corresponding methods
	to ensure that all possible previews are taken into account.
	Even though at this moment we only display one preview, we still have to go through
	all pragmas because it can happen that the method has a guarding if and thus, the actual
	preview would not be triggered."
	pragmas do: [ :eachPragma | 
		(eachPragma selector findTokens: $:) size = 1 
			ifTrue: [ self perform: eachPragma selector with: aComposite ]. 
		(eachPragma selector findTokens: $:) size = 2
			ifTrue: [ self perform: eachPragma selector with: aComposite with: aSpotter ].
		aComposite hasSubbricks ifTrue: [ ^ self ]]! !

!Object methodsFor: '*Kernel-Exceptions-debugging' stamp: 'BenComan 1/28/2015 00:20'!
halt: aString 
	<debuggerCompleteToSender>
	Halt now: aString! !

!Object methodsFor: 'drag and drop' stamp: 'panda 4/28/2000 16:11'!
dragTransferType
	^nil! !

!Object methodsFor: 'testing' stamp: 'ar 9/13/2000 15:37'!
isMorphicEvent
	^false! !

!Object methodsFor: 'message performing' stamp: 'ClementBera 4/21/2013 14:53'!
perform: aSymbol 
	"Send the unary selector, aSymbol, to the receiver.
	Fail if the number of arguments expected by the selector is not zero.
	Primitive. Optional. See Object documentation whatIsAPrimitive."
	
	<reflective: #object:performMessageWith:>
	<primitive: 83>
	^ self perform: aSymbol withArguments: (Array new: 0)! !

!Object methodsFor: 'introspection' stamp: 'MarcusDenker 6/26/2014 16:21'!
readSlotNamed: aName
	^self readSlot: (self class slotNamed: aName)! !

!Object methodsFor: 'events-accessing' stamp: 'reThink 2/25/2001 08:50'!
updateableActionMap

	^EventManager updateableActionMapFor: self! !

!Object methodsFor: 'testing' stamp: 'sw 1/12/98 18:09'!
haltIfNil! !

!Object methodsFor: 'events-registering' stamp: 'gvc 10/24/2006 11:50'!
when: anEventSelector
sendOnce: aMessageSelector
to: anObject
 
    self
        when: anEventSelector
        evaluate: (NonReentrantWeakMessageSend
            receiver: anObject
            selector: aMessageSelector)! !

!Object methodsFor: '*Kernel-Exceptions-debugging' stamp: 'BenComan 1/28/2015 00:18'!
halt
	"This is the typical message to use for inserting breakpoints during debugging."
	<debuggerCompleteToSender>
	Halt now! !

!Object methodsFor: 'evaluating' stamp: 'reThink 2/18/2001 15:23'!
valueWithArguments: aSequenceOfArguments

	^self! !

!Object methodsFor: 'events-registering' stamp: 'reThink 2/18/2001 15:04'!
when: anEventSelector evaluate: anAction 

	| actions |
	actions := self actionSequenceForEvent: anEventSelector.
	(actions includes: anAction)
		ifTrue: [^ self].
	self 
		setActionSequence: (actions copyWith: anAction)
		forEvent: anEventSelector! !

!Object methodsFor: 'pointing to' stamp: 'G.C 10/22/2008 09:59'!
refersToLiteral: literal 
	"Answer true if literal is identical to any literal in this array, even if imbedded in further structures.  This is the end of the imbedded structure path so return false."
	^ false! !

!Object methodsFor: '*NativeBoost-core' stamp: 'IgorStasenko 11/24/2012 16:07'!
nbCall: fnSpec module: aModuleNameOrHandle
	" you can override this method if you need to"

	^ (self nbCalloutIn: thisContext sender)
		convention: self nbCallingConvention;
		function: fnSpec module: aModuleNameOrHandle ! !

!Object methodsFor: '*Collections-Abstract-splitjoin' stamp: 'onierstrasz 4/12/2009 19:58'!
joinTo: stream
	"double dispatch for join:"
	^ stream nextPut: self! !

!Object methodsFor: 'private' stamp: 'yo 6/29/2004 11:37'!
errorNotIndexable
	"Create an error notification that the receiver is not indexable."

	self error: ('Instances of {1} are not indexable' translated format: {self class name})! !

!Object methodsFor: '*Morphic-Base' stamp: 'MarcusDenker 7/20/2012 14:57'!
asStringMorph
	"Open a StringMorph, as best one can, on the receiver"

	^ self asString asStringMorph
! !

!Object methodsFor: 'events-accessing' stamp: 'gk 8/14/2007 23:53'!
hasActionsWithReceiver: anObject

	^self actionMap keys anySatisfy:
		[:eachEventSelector |
			(self actionSequenceForEvent: eachEventSelector)
				anySatisfy: [:anAction | anAction receiver == anObject]]! !

!Object methodsFor: 'set implementation' stamp: 'Igor.Stasenko 11/13/2009 07:19'!
enclosedSetElement
	"The receiver is included into a set as an element. 
	Since some objects require wrappers (see SetElement) to be able to be included into a Set,
	a set sends this message to its element to make sure it getting real object,
	instead of its wrapper.
	Only SetElement instance or its subclasses allowed to answer something different than receiver itself"
	
! !

!Object methodsFor: 'testing' stamp: 'ar 8/17/1999 19:43'!
isCollection
	"Return true if the receiver is some sort of Collection and responds to basic collection messages such as #size and #do:"
	^false! !

!Object methodsFor: '*Spec-Core' stamp: 'BenjaminVanRyseghem 6/18/2012 05:26'!
isSpecLayout

	^ false! !

!Object methodsFor: 'error handling' stamp: 'al 9/16/2005 14:12'!
requirement
	self error: 'Implicitly required method'! !

!Object methodsFor: 'user interface' stamp: ''!
modelWakeUp
	"A window with me as model is being entered or expanded.  Default response is no-op"  ! !

!Object methodsFor: 'block support' stamp: 'CamilleTeruel 7/29/2014 15:44'!
mustBeBoolean
	"Catches attempts to test truth of non-Booleans.  This message is sent from the VM.  The sending context is rewound to just before the jump causing this exception."

	^ self mustBeBooleanInMagic: thisContext sender! !

!Object methodsFor: 'message performing' stamp: 'ClementBera 4/21/2013 14:53'!
perform: aSymbol with: anObject 
	"Send the selector, aSymbol, to the receiver with anObject as its argument.
	Fail if the number of arguments expected by the selector is not one.
	Primitive. Optional. See Object documentation whatIsAPrimitive."
	
	<reflective: #object:performMessageWith:>
	<primitive: 83>
	^ self perform: aSymbol withArguments: (Array with: anObject)! !

!Object methodsFor: '*Morphic-Base' stamp: 'AlainPlantec 12/19/2009 23:13'!
hasModelYellowButtonMenuItems
	^Morph cmdGesturesEnabled! !

!Object methodsFor: '*Morphic-Base' stamp: 'dgd 9/25/2004 23:17'!
iconOrThumbnailOfSize: aNumberOrPoint 
	"Answer an appropiate form to represent the receiver"
	^ nil! !

!Object methodsFor: '*Collections-Abstract-splitjoin' stamp: 'CamilloBruni 1/19/2013 12:38'!
split: aSequenceableCollection do: aBlock
	"optimized version for single delimiters:
	Example:
		$/ split: '/foo/bar' indicesDo: [ :item | ]"
	self split: aSequenceableCollection indicesDo: [ :start :end | 
		aBlock value: (aSequenceableCollection copyFrom: start to: end) ]! !

!Object methodsFor: '*Morphic-Base' stamp: 'BenjaminVanRyseghem 10/11/2013 15:28'!
tail

	^ nil! !

!Object methodsFor: 'testing' stamp: 'MarcusDenker 10/17/2013 12:05'!
isClass
	^ false! !

!Object methodsFor: '*GT-Spotter' stamp: 'TudorGirba 11/26/2014 14:35'!
asSpotterCandidateLink

	^ GTSpotterCandidateLink value: self! !

!Object methodsFor: 'copying' stamp: 'StephaneDucasse 2/20/2010 21:43'!
veryDeepFixupWith: deepCopier
	"I have no fields and no superclass.  Catch the super call."
	
	"avoid to use me we will deprecate it in the future"! !

!Object methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 2/26/2015 23:14'!
brickAlert

	GLMAlertBrick alert: self! !

!Object methodsFor: 'reflective operations' stamp: ''!
someObject
	"Primitive. Answer the first object in the enumeration of all
	 objects."

	<primitive: 138>
	self primitiveFailed.! !

!Object methodsFor: '*GT-Spotter' stamp: 'StefanReichhart 3/23/2015 18:27'!
spotterActDefault: aStep
	aStep exit.
	self spotterActDefault! !

!Object methodsFor: 'block support' stamp: 'ClementBera 6/28/2013 10:20'!
mustBeBooleanIn: context
	"context is the where the non-boolean error occurred. Rewind context to before jump then raise error."
	
	"Some constructs are optimized in the compiler :
	#whileTrue:
	#whileFalse:
	#ifTrue:
	#ifFalse:
	#ifTrue:ifFalse:
	#ifFalse:ifTrue:
	So you cannot by default use them on non boolean objects."
	
	"If you really need to use optimized constructs, you can enable Opal compiler and do one of the following :
		- recompile your method with the pragma : <compilerOptions: #(+ optIlineNone)>
		- recompile your class with the method : MyClass class>>compiler 
			^ super compiler options: #(+ optIlineNone)
		- call from this method by Object>>#mustBeBooleanInMagic:"

	| proceedValue |
	
	context skipBackBeforeJump.
	proceedValue := NonBooleanReceiver new
		object: self;
		signal: 'proceed for truth.'.
	^ proceedValue ~~ false! !

!Object methodsFor: 'finalization' stamp: 'BenjaminVanRyseghem 7/31/2013 15:40'!
actAsExecutor
	"Do nothing"! !

!Object methodsFor: 'printing' stamp: 'sma 6/1/2000 09:22'!
printString
	"Answer a String whose characters are a description of the receiver. 
	If you want to print without a character limit, use fullPrintString."

	^ self printStringLimitedTo: 50000! !

!Object methodsFor: 'tracing' stamp: 'StephaneDucasse 11/6/2011 23:56'!
crTrace
      self crTrace: self printString! !

!Object methodsFor: '*necompletion-extensions' stamp: 'EstebanLorenzano 4/11/2012 15:47'!
isCodeCompletionAllowed
	^false! !

!Object methodsFor: 'events-registering' stamp: 'gvc 10/25/2006 18:18'!
when: anEventSelector
send: aMessageSelector
to: anObject
exclusive: aValueHolder
 
	self
		when: anEventSelector
		evaluate: ((ExclusiveWeakMessageSend
					receiver: anObject
					selector: aMessageSelector)
						basicExecuting: aValueHolder)! !

!Object methodsFor: '*Morphic-Base' stamp: 'BenjaminVanRyseghem 5/16/2013 12:27'!
isTransferable

	^ false! !

!Object methodsFor: 'drag and drop' stamp: ''!
dragPassengerFor: item inMorph: dragSource 
	^item! !

!Object methodsFor: 'logging-Deprecated' stamp: 'StephaneDucasse 11/7/2011 22:43'!
crLog
      self crTrace: self printString! !

!Object methodsFor: 'finalization' stamp: 'StephaneDucasse 3/21/2010 15:13'!
toFinalizeSend: aSelector to: aFinalizer with: aResourceHandle
	"When I am finalized (e.g., garbage collected) close the associated resource handle by sending aSelector to the appropriate finalizer (the guy who knows how to get rid of the resource).
	WARNING: Neither the finalizer nor the resource handle are allowed to reference me. If they do, then I will NEVER be garbage collected. Since this cannot be validated here, it is up to the client to make sure this invariant is not broken."
	self == aFinalizer ifTrue:[self error: 'I cannot finalize myself'].
	self == aResourceHandle ifTrue:[self error: 'I cannot finalize myself'].
	^self finalizationRegistry add: self executor:
		(ObjectFinalizer new
			receiver: aFinalizer
			selector: aSelector
			argument: aResourceHandle)! !

!Object methodsFor: 'accessing' stamp: ''!
basicAt: index 
	"Primitive. Assumes receiver is indexable. Answer the value of an 
	indexable element in the receiver. Fail if the argument index is not an 
	Integer or is out of bounds. Essential. Do not override in a subclass. See 
	Object documentation whatIsAPrimitive."

	<primitive: 60>
	index isInteger ifTrue: [self errorSubscriptBounds: index].
	index isNumber
		ifTrue: [^self basicAt: index asInteger]
		ifFalse: [self errorNonIntegerIndex]! !

!Object methodsFor: '*Polymorph-TaskbarIcons' stamp: ''!
taskbarIcon
	"Answer the icon for the receiver in a task bar
	or nil for the default."

	^self class taskbarIcon! !

!Object methodsFor: '*Spec-Core' stamp: 'BenjaminVanRyseghem 11/26/2013 17:18'!
isSpecAdapter

	^ false! !

!Object methodsFor: 'accessing' stamp: 'di 3/29/1999 13:10'!
size
	"Primitive. Answer the number of indexable variables in the receiver. 
	This value is the same as the largest legal subscript. Essential. See Object 
	documentation whatIsAPrimitive."

	<primitive: 62>
	self class isVariable ifFalse: [self errorNotIndexable].
	^ 0! !

!Object methodsFor: '*GT-Inspector' stamp: 'TudorGirba 12/23/2013 09:12'!
gtDisplayOn: stream
	"This offers a means to customize how the object is shown in the inspector"
	^ self printOn: stream! !

!Object methodsFor: '*Morphic-Base' stamp: 'BenjaminVanRyseghem 11/27/2013 14:52'!
wantsVisualFeedback

	^ true! !

!Object methodsFor: 'printing' stamp: ''!
isLiteral
	"Answer whether the receiver has a literal text form recognized by the 
	compiler."

	^false! !

!Object methodsFor: 'accessing' stamp: 'md 5/16/2006 12:34'!
yourself
	"Answer self."
	^self! !

!Object methodsFor: '*Spec-Inspector' stamp: 'MarcusDenker 9/28/2013 15:53'!
inspectorClass
	"Answer the class of the inspector to be used on the receiver.  Called by inspect; 
	use basicInspect to get a normal (less useful) type of inspector."

	^ Smalltalk tools inspectorClass! !

!Object methodsFor: 'testing' stamp: ''!
notNil
	"Coerces nil to false and everything else to true."

	^true! !

!Object methodsFor: 'class membership' stamp: ''!
isKindOf: aClass 
	"Answer whether the class, aClass, is a superclass or class of the receiver."

	self class == aClass
		ifTrue: [^true]
		ifFalse: [^self class inheritsFrom: aClass]! !

!Object methodsFor: 'testing' stamp: 'rhi 8/12/2003 09:52'!
isInterval

	^ false! !

!Object methodsFor: '*Collections-Abstract-splitjoin' stamp: 'CamilloBruni 1/19/2013 12:38'!
split: aSequenceableCollection
	"optimized version for single delimiters:
	Example:
		$/ split: '/foo/bar'"
		
	| result position oldPosition |
	
	result := OrderedCollection new: (aSequenceableCollection size / 2) asInteger.
	self split: aSequenceableCollection do: [ :item |
		result add: item ].
	^ result
! !

!Object methodsFor: 'error handling' stamp: 'PabloHerrero 6/7/2014 03:15'!
explicitRequirement
	"If one of the superclasses can perform the selector, we execute the method of that class, otherwise, the explicit requirement error is thrown"

	| originalMethod originalArguments errorBlock originalReceiver callingContext originalSelector |
	errorBlock := [ ^ self error: 'Explicitly required method' ].
	callingContext := thisContext sender.
	originalMethod := callingContext method.
	originalMethod isFromTrait
		ifFalse: errorBlock.
		
	originalReceiver := callingContext receiver.
	originalSelector := originalMethod selector.
	originalArguments := callingContext arguments.
	
	originalReceiver class superclass
		withAllSuperclassesDo: [ :superClass | 
			superClass
				compiledMethodAt: originalSelector
				ifPresent: [ :method | 
					(method isProvided or: [ method isFromTrait not ])
						ifTrue: [ 
							callingContext return: (method valueWithReceiver: originalReceiver arguments: originalArguments) ] ]
				ifAbsent: [  ] ].

	errorBlock value! !

!Object methodsFor: 'converting' stamp: 'Igor.Stasenko 11/13/2009 06:03'!
asSetElement
	"Answer an object, which can be put into a Set as element , wrapped
	by one of SetElement instance, if necessary. 
	Default implementation is to answer self"
! !

!Object methodsFor: '*GT-Spotter' stamp: 'StefanReichhart 3/22/2015 16:58'!
gtListFilter
	^ GTFilterSubstring new! !

!Object methodsFor: '*Glamour-Helpers' stamp: ' 4/5/09 22:18'!
renderGlamorouslyOn: aRenderer 
	 
	^aRenderer renderObject: self! !

!Object methodsFor: 'printing' stamp: 'tk 10/19/2001 11:18'!
longPrintOn: aStream limitedTo: sizeLimit indent: indent
	"Append to the argument, aStream, the names and values of all of the receiver's instance variables.  Limit is the length limit for each inst var."

	self class allInstVarNames doWithIndex:
		[:title :index |
		indent timesRepeat: [aStream tab].
		aStream nextPutAll: title;
		 nextPut: $:;
		 space;
		 tab;
		 nextPutAll: 
			((self instVarAt: index) printStringLimitedTo: (sizeLimit -3 -title size max: 1));
		 cr]! !

!Object methodsFor: 'updating' stamp: ''!
okToChange
	"Allows a controller to ask this of any model"
	^ true! !

!Object methodsFor: 'testing' stamp: 'gm 2/22/2003 12:56'!
isMorphicModel
	"Return true if the receiver is a morphic model"
	^false
! !

!Object methodsFor: 'events-accessing' stamp: 'SqR 6/28/2001 13:19'!
actionsDo: aBlock

	self actionMap do: aBlock! !

!Object methodsFor: '*GT-Inspector' stamp: 'TudorGirba 2/27/2014 10:36'!
gtInspectorActions
	"This is a utility method that allows each object to define a set of actions 
	specific for itself. These actions are used when the object appears in the inspector.

	The actions are collected based on the #gtInspectorAction pragma that are defined in
	unary methods corresponding to the body of the actions"
	
	| all |
	all := (Pragma 
				allNamed: #gtInspectorAction
				from: self class 
				to: Object) collect: [:eachPragma |
					self perform: eachPragma selector ].
	^ all asSortedCollection: [:a :b | 
		| first second |
		first := a isCategorized ifTrue: [a category, a title] ifFalse: [a title].
		second := b isCategorized ifTrue: [b category, b title] ifFalse: [b title].
		first < second]! !

!Object methodsFor: '*GT-Inspector' stamp: 'TudorGirba 2/27/2014 21:42'!
gtInspectorActionBrowse
	<gtInspectorAction>
	^ GLMGenericAction new
		action: [ self browse ];
		icon: GLMUIThemeExtraIcons glamorousBrowse;
		title: 'Browse'! !

!Object methodsFor: '*metacello-core' stamp: 'dkh 6/21/2012 20:08'!
metacelloSemanticIntegerLessThanSelf: anInteger
    ^ self error: 'Invalid Metacello verson component - should be String or Integer.'! !

!Object methodsFor: '*GT-Spotter' stamp: 'TudorGirba 11/26/2014 14:35'!
asSpotterProcessorLink

	^ GTSpotterProcessorLink value: self! !

!Object methodsFor: '*Spec-Tools' stamp: 'BenjaminVanRyseghem 10/3/2012 13:57'!
subObjectsToInspect

	^ (1 to: self class allInstVarNames size) collect: [:i | self instVarAt: i ]! !

!Object methodsFor: '*Morphic-Base' stamp: 'StephaneDucasse 10/22/2014 21:27'!
addModelYellowButtonMenuItemsTo: aCustomMenu forMorph: aMorph hand: aHandMorph 
	"The receiver serves as the model for aMorph; a menu is being constructed for the morph, and here the receiver is able to add its own items"
	Morph cmdGesturesEnabled ifTrue: [ 
		aCustomMenu add: 'inspect model'  target: self selector: #inspect.
	].
	^aCustomMenu
! !

!Object methodsFor: 'reflective operations' stamp: 'ar 3/2/2001 01:34'!
primitiveChangeClassTo: anObject
	"Primitive. Change the class of the receiver into the class of the argument given that the format of the receiver matches the format of the argument's class. Fail if receiver or argument are SmallIntegers, or the receiver is an instance of a compact class and the argument isn't, or when the argument's class is compact and the receiver isn't, or when the format of the receiver is different from the format of the argument's class, or when the arguments class is fixed and the receiver's size differs from the size that an instance of the argument's class should have.
	Note: The primitive will fail in most cases that you think might work. This is mostly because of a) the difference between compact and non-compact classes, and b) because of differences in the format. As an example, '(Array new: 3) primitiveChangeClassTo: Morph basicNew' would fail for three of the reasons mentioned above. Array is compact, Morph is not (failure #1). Array is variable and Morph is fixed (different format - failure #2). Morph is a fixed-field-only object and the array is too short (failure #3).
	The facility is really provided for certain, very specific applications (mostly related to classes changing shape) and not for casual use."

	<primitive: 115>
	self primitiveFailed! !

!Object methodsFor: 'dependencies' stamp: 'sma 2/29/2000 20:23'!
removeDependent: anObject
	"Remove the given object as one of the receiver's dependents."

	| dependents |
	dependents := self dependents reject: [:each | each == anObject].
	self myDependents: (dependents isEmpty ifFalse: [dependents]).
	^ anObject! !

!Object methodsFor: 'error handling' stamp: 'SvenVanCaekenberghe 4/20/2011 13:25'!
shouldNotImplement
	"Announce that, although the receiver inherits this message, 
	it should not implement it."

	ShouldNotImplement signalFor: thisContext sender selector! !

!Object methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 1/20/2015 17:22'!
brickValue: aBrick

	^ self! !

!Object methodsFor: 'events-accessing' stamp: 'ClementBera 9/27/2013 17:54'!
setActionSequence: actionSequence
forEvent: anEventSelector

    | action |
    action := actionSequence asMinimalRepresentation.
    action 
	  ifNil:
            [self removeActionsForEvent: anEventSelector]
        ifNotNil:
            [self updateableActionMap
                at: anEventSelector asSymbol
                put: action]! !

!Object methodsFor: '*Spec-Inspector' stamp: 'EstebanLorenzano 3/20/2015 16:42'!
basicInspect
	^ Smalltalk tools basicInspector inspect: self! !

!Object methodsFor: '*System-Support' stamp: 'MarcusDenker 7/12/2012 17:58'!
systemNavigation

	^ SystemNavigation new! !

!Object methodsFor: 'stepping' stamp: 'sw 10/19/1999 08:22'!
stepTimeIn: aSystemWindow
	
	^ 1000 "milliseconds -- default backstop for objects serving as models of system windows"! !

!Object methodsFor: 'primitive failure' stamp: 'StephaneDucasse 12/5/2009 21:06'!
primitiveFail
	"primitiveFail may be invoked by certain methods whose code is translated in C. In such a case primitiveFail and not primitiveFailed
	 should be invoked. The reason is that this code is translated to C by VMMaker. #primitiveFail is 
	implemented in Interpreter of VMMaker."

	^ self primitiveFailed! !

!Object methodsFor: '*NativeBoost-core' stamp: 'IgorStasenko 11/22/2012 18:32'!
nbAddress
	"Return the native address"
	<primitive: 'primitiveNativeCall' module: 'NativeBoostPlugin'>

	^ self nbCallout  
		function: #( int ( void ) )  
		emit: [:gen :proxy :asm | proxy receiver ]! !

!Object methodsFor: '*rubric' stamp: 'AlainPlantec 4/16/2013 17:44'!
isParagraphProvider
	^ false! !

!Object methodsFor: 'introspection' stamp: 'MarcusDenker 6/26/2014 16:19'!
readSlot: aSlot
	^aSlot read: self! !

!Object methodsFor: 'streaming' stamp: 'MPW 1/1/1901 00:49'!
putOn:aStream
	^aStream nextPut:self.
! !

!Object methodsFor: 'events-accessing' stamp: 'SqR 2/19/2001 14:04'!
hasActionForEvent: anEventSelector
    "Answer true if there is an action associated with anEventSelector"

    ^(self actionForEvent: anEventSelector) notNil! !

!Object methodsFor: 'private' stamp: ''!
errorImproperStore
	"Create an error notification that an improper store was attempted."

	self error: 'Improper store into indexable object'! !

!Object methodsFor: '*NativeBoost-core' stamp: 'JavierPimas 11/17/2011 11:12'!
nbCallingConvention
	^#cdecl
! !

!Object methodsFor: 'asserting' stamp: 'CamilloBruni 5/27/2013 16:20'!
assert: aBlock description: aStringOrBlock
	"Throw an assertion error if aBlock does not evaluates to true."
	
	aBlock value 
		ifFalse: [ AssertionFailure signal: aStringOrBlock value ]! !

!Object methodsFor: 'user interface' stamp: 'sw 10/4/1999 08:13'!
addModelItemsToWindowMenu: aMenu
	"aMenu is being constructed to be presented to the user in response to the user's pressing on the menu widget in the title bar of a morphic window.  Here, the model is given the opportunity to add any model-specific items to the menu, whose default target is the SystemWindow itself."! !

!Object methodsFor: '*Morphic-Base' stamp: 'AlainPlantec 10/20/2009 10:14'!
asMorph
	"Open a morph, as best one can, on the receiver"

	^ self asStringMorph

	"
234 asMorph.
(MenuIcons tinyMenuIcon) asMorph.
'fred' asMorph.
"

! !

!Object methodsFor: 'updating' stamp: 'nk 2/17/2004 11:13'!
update: anAspect with: anObject
	"Receive a change notice from an object of whom the receiver is a 
	dependent. The default behavior is to call update:,
	which by default does nothing; a subclass might want 
	to change itself in some way."

	^ self update: anAspect! !

!Object methodsFor: 'testing' stamp: 'ar 12/23/1999 15:43'!
isStream
	"Return true if the receiver responds to the stream protocol"
	^false
! !

!Object methodsFor: 'message performing' stamp: 'MarcusDenker 7/23/2014 22:37'!
perform: aSymbol with: firstObject with: secondObject with: thirdObject 
	"Send the selector, aSymbol, to the receiver with the given arguments.
	Fail if the number of arguments expected by the selector is not three.
	Primitive. Optional. See Object documentation whatIsAPrimitive."
	
	<reflective: #object:performMessageWith:>
	<primitive: 83>
	^ self perform: aSymbol
		withArguments: {firstObject . secondObject . thirdObject}! !

!Object methodsFor: 'testing' stamp: ''!
isMorph

	^ false! !

!Object methodsFor: 'printing' stamp: 'sma 6/1/2000 09:28'!
longPrintOn: aStream
	"Append to the argument, aStream, the names and values of all 
	of the receiver's instance variables."

	self class allInstVarNames doWithIndex:
		[:title :index |
		aStream nextPutAll: title;
		 nextPut: $:;
		 space;
		 tab;
		 print: (self instVarAt: index);
		 cr]! !

!Object methodsFor: 'private' stamp: 'SvenVanCaekenberghe 4/21/2011 13:00'!
errorSubscriptBounds: index 
	"Create an error notification that an improper integer was used as an index."

	SubscriptOutOfBounds signalFor: index! !

!Object methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/31/2009 15:52'!
taskbarLabel
	"Answer the label string for the receiver in a task bar
	or nil for the default."

	^self class taskbarLabel! !

!Object methodsFor: 'updating' stamp: 'MarcusDenker 6/11/2010 11:36'!
changed: anAspect with: anObject
	"Receiver changed. The change is denoted by the argument anAspect. 
	Usually the argument is a Symbol that is part of the dependent's change 
	protocol. Inform all of the dependents. Also pass anObject for additional information."

	self dependents do: [:aDependent | aDependent update: anAspect with: anObject]! !

!Object methodsFor: 'testing' stamp: 'di 11/6/1998 08:04'!
isPoint
	"Overridden to return true in Point."

	^ false! !

!Object methodsFor: 'private' stamp: ''!
errorNonIntegerIndex
	"Create an error notification that an improper object was used as an index."

	self error: 'only integers should be used as indices'! !

!Object methodsFor: '*NativeBoost-Examples' stamp: 'IgorStasenko 11/23/2012 14:02'!
nbOopHeader
" This method provided only for educational purposes. 
 Do not rely on it, if you wanna keep your code portable among various object memory formats "
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin >
	
	" simply return an object header word in a form which it is "
	
	^ self nbCallout   
		function:  #( uint (oop self) )
		emit: [:gen :proxy :asm |  
			asm 
				pop: asm EAX;
				push: asm EAX.
				
			proxy isIntegerObject: asm EAX.
			asm or: asm EAX with: asm EAX;
				jne: #notOop;
				pop: asm EAX;
				mov: asm EAX ptr to: asm EAX; "load the header"
				jmp: #exitt;
				label: #notOop;
				mov: 0 to: asm EAX;
			label: #exitt
		].! !

!Object methodsFor: '*System-Settings-Browser' stamp: 'alain.plantec 3/19/2009 09:50'!
settingStoreOn: aStream
	^ self storeOn: aStream! !

!Object methodsFor: '*Spec-Core' stamp: 'BenjaminVanRyseghem 10/1/2013 13:46'!
asWidget

	^ self! !

!Object methodsFor: 'events-accessing' stamp: 'nk 12/20/2002 17:48'!
actionForEvent: anEventSelector
    "Answer the action to be evaluated when <anEventSelector> has been triggered."

	| actions |
	actions := self actionMap
		at: anEventSelector asSymbol
		ifAbsent: [nil].
	actions ifNil: [^nil].
	^ actions asMinimalRepresentation! !

!Object methodsFor: 'copying' stamp: 'eem 6/11/2008 17:52'!
copySameFrom: otherObject
	"Copy to myself all instance variables named the same in otherObject.
	This ignores otherObject's control over its own inst vars."

	| myInstVars otherInstVars |
	myInstVars := self class allInstVarNames.
	otherInstVars := otherObject class allInstVarNames.
	myInstVars doWithIndex: [:each :index | | match |
		(match := otherInstVars indexOf: each) > 0 ifTrue:
			[self instVarAt: index put: (otherObject instVarAt: match)]].
	1 to: (self basicSize min: otherObject basicSize) do: [:i |
		self basicAt: i put: (otherObject basicAt: i)].
! !

!Object methodsFor: '*GT-Inspector' stamp: 'AndreiChis 1/14/2015 14:22'!
gtInspectorPresentationsIn: composite inContext: aGTInspector
	"This is a utility method that collects all presentations for the current object.
	By default, it simply looks for the #gtInspectorPresentationOrder: pragma.
	The inspector can decice whether or not a presentation should be dispayed.
	Subclasses might want to override it for more special behavior."
	| pragmas |
	pragmas := Pragma 
				allNamed: #gtInspectorPresentationOrder: 
				from: self class 
				to: Object
				sortedUsing: [: x :y | (x argumentAt: 1) < (y argumentAt: 1)].
	pragmas := pragmas select: [ :aPragma | 
		aGTInspector shouldDisplayPresentationCreateBy: aPragma method ].
	pragmas do: [ :eachPragma | 
		(eachPragma selector findTokens: $:) size = 1 
			ifTrue: [ self perform: eachPragma selector with: composite ]. 
		(eachPragma selector findTokens: $:) size = 2
			ifTrue: [ self perform: eachPragma selector with: composite with: aGTInspector ] ]! !

!Object methodsFor: 'converting' stamp: 'di 11/9/1998 12:15'!
adaptToFloat: rcvr andSend: selector
	"If no method has been provided for adapting an object to a Float,
	then it may be adequate to simply adapt it to a number."
	^ self adaptToNumber: rcvr andSend: selector! !

!Object methodsFor: '*GT-Spotter' stamp: 'StefanReichhart 3/20/2015 11:29'!
gtIterator
	^ Error signal: 'This is not a spotter iterator'! !

!Object methodsFor: 'introspection' stamp: 'MarcusDenker 6/26/2014 16:23'!
writeSlot: aSlot value: anObject
	^aSlot write: anObject to: self! !

!Object methodsFor: 'error handling' stamp: 'stephane.ducasse 6/1/2009 13:51'!
notify: aString 
	"Create and schedule a Notifier with the argument as the message in 
	order to request confirmation before a process can proceed."

	Warning signal: aString! !

!Object methodsFor: 'testing' stamp: 'adrian-lienhard 6/21/2009 23:52'!
isTrait
	^false! !

!Object methodsFor: '*GT-Spotter' stamp: 'StefanReichhart 2/24/2015 14:51'!
gtFilter
	^ GTFilterBlock gtFilter
		! !

!Object methodsFor: 'flagging' stamp: 'sw 3/7/2001 13:14'!
nominallyUnsent: aSelectorSymbol
	"From within the body of a method which is not formally sent within the system, but which you intend to have remain in the system (for potential manual invocation, or for documentation, or perhaps because it's sent by commented-out-code that you anticipate uncommenting out someday, send this message, with the selector itself as the argument.

This will serve two purposes:

	(1)  The method will not be returned by searches for unsent selectors (because it, in a manner of speaking, sends itself).
	(2)	You can locate all such methods by browsing senders of #nominallyUnsent:"

	false ifTrue: [self flag: #nominallyUnsent:]    "So that this method itself will appear to be sent"
! !

!Object methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 8/24/2012 15:28'!
at: index put: value 
	"Primitive. Assumes receiver is indexable. Store the argument value in 
	the indexable element of the receiver indicated by index. Fail if the 
	index is not an Integer or is out of bounds. Or fail if the value is not of 
	the right type for this kind of collection. Answer the value that was 
	stored. Essential. See Object documentation whatIsAPrimitive."

	<primitive: 61>
	index isInteger ifTrue:
		[self class isVariable
			ifTrue: [(index >= 1 and: [index <= self size])
					ifTrue: [self errorImproperStore]
					ifFalse: [self errorSubscriptBounds: index]]
			ifFalse: [self errorNotIndexable]].
	index isNumber
		ifTrue: [^self at: index asInteger put: value]
		ifFalse: [self errorNonIntegerIndex]! !

!Object methodsFor: 'copying' stamp: 'MarianoMartinezPeck 8/24/2012 15:58'!
postCopy
	"I'm a hook method in the sense of Design Patterns TemplateHook/Methods. I'm called by copy. self is a shallow copy, subclasses should copy fields as necessary to complete the full copy"

	^ self ! !

!Object methodsFor: '*Deprecated40' stamp: 'DucasseStephane 9/10/2014 10:00'!
asReactiveVariable
	"See NewValueHolder class comment"
	
	self deprecated: 'Use asValueHolder'.
	^ NewValueHolder value: self! !

!Object methodsFor: '*Glamour-Helpers' stamp: ' 4/5/09 22:18'!
glamourValue: anObject 
	 
	| args | 
	args := anObject asGlamorousArray. 
	^self glamourValueWithArgs: args! !

!Object methodsFor: 'message performing' stamp: 'ClementBera 4/21/2013 14:41'!
perform: selector withArguments: argArray inSuperclass: lookupClass
	"NOTE:  This is just like perform:withArguments:, except that
	the message lookup process begins, not with the receivers's class,
	but with the supplied superclass instead.  It will fail if lookupClass
	cannot be found among the receiver's superclasses.
	Primitive. Essential. See Object documentation whatIsAPrimitive."
	
	<reflective: #object:performMessageInSuperclass:>
	<primitive: 100>
	(selector isSymbol)
		ifFalse: [^ self error: 'selector argument must be a Symbol'].
	(selector numArgs = argArray size)
		ifFalse: [^ self error: 'incorrect number of arguments'].
	(self class == lookupClass or: [self class inheritsFrom: lookupClass])
		ifFalse: [^ self error: 'lookupClass is not in my inheritance chain'].
	self primitiveFailed! !

!Object methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
metacelloStringLessThanSelf: anInteger

	^self error: 'Invalid Metacello verson component - should be String or Integer.'! !

!Object methodsFor: 'pointing to' stamp: 'IgorStasenko 9/2/2012 02:24'!
pointsOnlyWeaklyTo: anObject
	"Assume, we already know that receiver points to an object,
	answer true if receiver points only weakly to it "
	
	self class isWeak ifFalse: [ ^ false ].
	1 to: self class instSize do:
		[:i | (self instVarAt: i) == anObject ifTrue: [^ false]].
	^ true! !

!Object methodsFor: 'printing' stamp: 'tk 5/7/1999 16:20'!
printStringLimitedTo: limit
	"Answer a String whose characters are a description of the receiver.
	If you want to print without a character limit, use fullPrintString."
	| limitedString |
	limitedString := String streamContents: [:s | self printOn: s] limitedTo: limit.
	limitedString size < limit ifTrue: [^ limitedString].
	^ limitedString , '...etc...'! !

!Object methodsFor: 'testing' stamp: 'sw 11/13/2001 07:26'!
wantsDiffFeedback
	"Answer whether the receiver, serving as the model of a text-bearing entity, would like for 'diffs' green pane-border feedback to be shown"

	^ false! !

!Object methodsFor: 'testing' stamp: 'md 11/21/2003 12:14'!
isCompiledMethod

	^ false! !

!Object methodsFor: '*UIManager' stamp: 'pavel.krivanek 11/21/2008 16:50'!
primitiveError: aString 
	"This method is called when the error handling results in a recursion in 
	calling on error: or halt or halt:."

	UIManager default onPrimitiveError: aString.! !

!Object methodsFor: 'converting' stamp: 'nice 3/28/2006 23:29'!
adaptToFraction: rcvr andCompare: selector 
	"If I am involved in comparison with a Fraction.
	Default behaviour is to process comparison as any other selectors."
	^ self adaptToFraction: rcvr andSend: selector! !

!Object methodsFor: 'dependencies' stamp: 'sma 2/29/2000 19:58'!
dependents
	"Answer a collection of objects that are 'dependent' on the receiver;
	 that is, all objects that should be notified if the receiver changes."

	^ self myDependents ifNil: [#()]! !

!Object methodsFor: 'casing-To be deprecated' stamp: 'StephaneDucasse 8/12/2013 21:27'!
caseOf: aBlockAssociationCollection
	"DO NOT USE THIS METHOD!! It will be removed from Pharo."

	"The elements of aBlockAssociationCollection are associations between blocks.
	 Answer the evaluated value of the first association in aBlockAssociationCollection
	 whose evaluated key equals the receiver.  If no match is found, report an error."

	^ self caseOf: aBlockAssociationCollection otherwise: [self caseError]

"| z | z := {[#a]->[1+1]. ['b' asSymbol]->[2+2]. [#c]->[3+3]}. #b caseOf: z"
"| z | z := {[#a]->[1+1]. ['d' asSymbol]->[2+2]. [#c]->[3+3]}. #b caseOf: z"
"The following are compiled in-line:"
"#b caseOf: {[#a]->[1+1]. ['b' asSymbol]->[2+2]. [#c]->[3+3]}"
"#b caseOf: {[#a]->[1+1]. ['d' asSymbol]->[2+2]. [#c]->[3+3]}"! !

!Object methodsFor: 'dependencies' stamp: 'sma 2/29/2000 19:53'!
breakDependents
	"Remove all of the receiver's dependents."

	self myDependents: nil! !

!Object methodsFor: '*Fuel' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper

	"Be careful because the order is important. For example, weak are also variable, but we need that weak objects send #visitWeakObject: and not #visitVariableObject: "
	self class isFixed
		ifTrue: [ ^ aGeneralMapper visitFixedObject: self ].
	self class isWeak
		ifTrue: [ ^ aGeneralMapper visitWeakObject: self ].
	self class isPointers
		ifTrue: [ ^ aGeneralMapper visitVariableObject: self ].
	self class isBytes
		ifTrue: [ ^ aGeneralMapper visitBytesObject: self ].
	self class isWords
		ifTrue: [	^ aGeneralMapper visitWordsObject: self ].
	self error: 'Something is wrong!!'! !

!Object methodsFor: 'user interface' stamp: 'rbb 3/1/2005 09:27'!
confirm: aString orCancel: cancelBlock
	"Put up a yes/no/cancel menu with caption aString. Answer true if  
	the response is yes, false if no. If cancel is chosen, evaluate  
	cancelBlock. This is a modal question--the user must respond yes or no."

	^ UIManager default confirm: aString orCancel: cancelBlock! !

!Object methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 1/11/2015 15:19'!
asBrick

	^ GLMMorphBrick on: self asMorph! !

!Object methodsFor: 'message performing' stamp: 'st 11/5/2004 16:19'!
perform: selector orSendTo: otherTarget
	"If I wish to intercept and handle selector myself, do it; else send it to otherTarget"
	^ (self respondsTo: selector) ifTrue: [self perform: selector] ifFalse: [otherTarget perform: selector]! !

!Object methodsFor: 'private' stamp: ''!
storeAt: offset inTempFrame: aContext
	"This message had to get sent to an expression already on the stack
	as a Block argument being accessed by the debugger.
	Just re-route it to the temp frame."
	^ aContext tempAt: offset put: self! !

!Object methodsFor: 'printing' stamp: 'tk 10/16/2001 19:41'!
longPrintString
	"Answer a String whose characters are a description of the receiver."
	
	| str |
	str := String streamContents: [:aStream | self longPrintOn: aStream].
	"Objects without inst vars should return something"
	^ str isEmpty ifTrue: [self printString, String cr] ifFalse: [str]! !

!Object methodsFor: 'testing' stamp: 'yo 8/28/2002 13:41'!
isCharacter

	^ false.
! !

!Object methodsFor: '*Spec-Inspector' stamp: 'MarcusDenker 9/28/2013 16:26'!
inspectWithLabel: aLabel
	"Create and schedule an Inspector in which the user can examine the receiver's variables."
	^Smalltalk tools inspector inspect: self label: aLabel! !

!Object methodsFor: 'flagging' stamp: 'jm 3/18/98 17:23'!
logEntry

	Transcript show: 'Entered ', thisContext sender printString; cr.
! !

!Object methodsFor: 'copying' stamp: 'CamilloBruni 10/2/2013 19:39'!
veryDeepCopyWith: deepCopier
	"Copy me and the entire tree of objects I point to.  An object in the tree twice is copied once, and both references point to him.  deepCopier holds a dictionary of objects we have seen.  Some classes refuse to be copied.  Some classes are picky about which fields get deep copied."
	
	| class selfNumberOfInstanceVariables fieldOfSelf copyOfSelf currentClass hasVeryDeepInnerMethod currentNumberOfInstanceVariables |
	
	deepCopier references at: self ifPresent: [ :newer | 	"already copied" ^ newer].
	class := self class.
	class isMeta ifTrue: [ "a metaclass" ^ self ].
	copyOfSelf := self shallowCopy.
	deepCopier references at: self put: copyOfSelf.	"remember"
		
	(class isVariable and: [class isPointers]) ifTrue: [
		self basicSize to: 1 by: -1 do: [ :i |
			fieldOfSelf := self basicAt: i. 
			copyOfSelf 
				basicAt: i
				put: (deepCopier references 
					at: fieldOfSelf
					ifAbsent: [ fieldOfSelf veryDeepCopyWith: deepCopier ])]].
	
	"Ask each superclass if it wants to share (weak copy) any inst vars"
	copyOfSelf veryDeepInner: deepCopier.

	"other superclasses want all instance variables deep copied"
	currentClass := class.  
	selfNumberOfInstanceVariables := class instSize.
	
	[ selfNumberOfInstanceVariables == 0 ] whileFalse: [
		hasVeryDeepInnerMethod := currentClass includesSelector: #veryDeepInner:.
		currentNumberOfInstanceVariables := currentClass instSize - currentClass superclass instSize.
		hasVeryDeepInnerMethod 
			ifTrue: ["skip inst vars"
				selfNumberOfInstanceVariables := selfNumberOfInstanceVariables - currentNumberOfInstanceVariables]	
			ifFalse: [ 
				currentNumberOfInstanceVariables timesRepeat: [ 
					fieldOfSelf := self instVarAt: selfNumberOfInstanceVariables.
					copyOfSelf 
						instVarAt: selfNumberOfInstanceVariables 
						put: (deepCopier references 
							at: fieldOfSelf 
							ifAbsent: [ fieldOfSelf veryDeepCopyWith: deepCopier ]).
					selfNumberOfInstanceVariables := selfNumberOfInstanceVariables - 1 ]].
		currentClass := currentClass superclass ].
		
	^ copyOfSelf
! !

!Object methodsFor: 'logging-Deprecated' stamp: 'StephaneDucasse 5/27/2011 19:07'!
logCrTab: aString
	"Log the argument. Use self logCr: 'something' instead of Transcript show: 'something'  ; cr ; tab"
	
	Transcript show: aString ; cr ; tab! !

!Object methodsFor: 'testing' stamp: 'nk 4/25/2002 08:04'!
isMessageSend
	^false
! !

!Object methodsFor: '*Morphic-Base' stamp: 'nk 2/26/2004 13:35'!
asTextMorph
	"Open a TextMorph, as best one can, on the receiver"

	^ TextMorph new contentsAsIs: self asStringOrText
! !

!Object methodsFor: 'copying' stamp: 'stephane.ducasse 6/1/2009 13:49'!
veryDeepCopy
	"Do a complete tree copy using a dictionary.  An object in the tree twice is only copied once.  All references to the object in the copy of the tree will point to the new copy."

	| copier new |
	copier := DeepCopier new initialize: 4096 "self initialDeepCopierSize".
	new := self veryDeepCopyWith: copier.
	copier references associationsDo: [:assoc | 
		assoc value veryDeepFixupWith: copier].
	copier fixDependents.
	^ new! !

!Object methodsFor: 'asserting' stamp: 'jannik.laval 5/2/2010 16:34'!
assert: aBlock
	"Throw an assertion error if aBlock does not evaluates to true."
	
	aBlock value ifFalse: [AssertionFailure signal: 'Assertion failed']! !

!Object methodsFor: '*Morphic-Base' stamp: 'CamilloBruni 10/21/2012 23:38'!
asDraggableMorph
	^ self asStringMorph ! !

!Object methodsFor: '*Tool-Base' stamp: 'BenjaminVanRyseghem 1/7/2012 18:04'!
browseHierarchy

	self systemNavigation browseHierarchy: self class! !

!Object methodsFor: 'comparing' stamp: 'ajh 2/2/2002 15:02'!
literalEqual: other

	^ self class == other class and: [self = other]! !

!Object methodsFor: 'copying' stamp: 'StephaneDucasse 2/20/2010 21:40'!
deepCopy
	"Answer a copy of the receiver with its own copy of each instance variable. deepCopy does a deep copy. It should never be overridden and only be used if you want to get these very specific semantics.
It doesn't handle cycles, #veryDeepCopy does. In the future we will make it handle cycles and deprecate veryDeepCopy"


	| newObject class index |
	class := self class.
	(class == Object) ifTrue: [^self].
	class isVariable
		ifTrue: 
			[index := self basicSize.
			newObject := class basicNew: index.
			[index > 0]
				whileTrue: 
					[newObject basicAt: index put: (self basicAt: index) deepCopy.
					index := index - 1]]
		ifFalse: [newObject := class basicNew].
	index := class instSize.
	[index > 0]
		whileTrue: 
			[newObject instVarAt: index put: (self instVarAt: index) deepCopy.
			index := index - 1].
	^newObject! !

!Object methodsFor: 'copying' stamp: 'StephaneDucasse 2/20/2010 21:42'!
shallowCopy
	"Answer a copy of the receiver which shares the receiver's instance variables. It should never be overridden. I'm invoked from the copy template method. Subclasses that need to specialize the copy should specialize the postCopy hook method."
	
	| class newObject index |
	<primitive: 148>
	class := self class.
	class isVariable
		ifTrue: 
			[index := self basicSize.
			newObject := class basicNew: index.
			[index > 0]
				whileTrue: 
					[newObject basicAt: index put: (self basicAt: index).
					index := index - 1]]
		ifFalse: [newObject := class basicNew].
	index := class instSize.
	[index > 0]
		whileTrue: 
			[newObject instVarAt: index put: (self instVarAt: index).
			index := index - 1].
	^ newObject! !

!Object methodsFor: 'events-accessing' stamp: 'rw 2/10/2002 13:05'!
createActionMap

	^IdentityDictionary new! !

!Object methodsFor: '*Spec-Inspector' stamp: 'MarcusDenker 9/28/2013 16:11'!
inspector
	^ Smalltalk tools inspector inspector: self! !

!Object methodsFor: 'tracing' stamp: 'StephaneDucasse 11/6/2011 23:56'!
traceCr: aString
	"Log the argument. Use self traceCr: 'something' instead of Transcript show: 'something'  ; cr "
	
	Transcript show: aString ; cr! !

!Object methodsFor: '*System-Caching' stamp: 'SvenVanCaekenberghe 12/16/2013 20:12'!
asDoubleLink
	^ DoubleLink value: self! !

!Object methodsFor: 'events-accessing' stamp: 'nk 12/20/2002 17:48'!
actionForEvent: anEventSelector
ifAbsent: anExceptionBlock
    "Answer the action to be evaluated when <anEventSelector> has been triggered."

	| actions |
	actions := self actionMap
		at: anEventSelector asSymbol
		ifAbsent: [nil].
	actions ifNil: [^anExceptionBlock value].
	^ actions asMinimalRepresentation! !

!Object methodsFor: 'events-removing' stamp: 'reThink 2/18/2001 15:36'!
removeActionsWithReceiver: anObject
forEvent: anEventSelector

    self
        removeActionsSatisfying:
            [:anAction |
            anAction receiver == anObject]
        forEvent: anEventSelector! !

!Object methodsFor: '*Tool-Finder' stamp: 'pmm 3/13/2010 11:33'!
copyTwoLevel
	"one more level than a shallowCopy"
	"do not use this method we will deprecated soon"

	| newObject class index |
	class := self class.
	newObject := self shallowCopy.
	newObject == self ifTrue: [^ self].
	class isVariable
		ifTrue: 
			[index := self basicSize.
			[index > 0]
				whileTrue: 
					[newObject basicAt: index put: (self basicAt: index) shallowCopy.
					index := index - 1]].
	index := class instSize.
	[index > 0]
		whileTrue: 
			[newObject instVarAt: index put: (self instVarAt: index) shallowCopy.
			index := index - 1].
	^newObject! !

!Object methodsFor: 'error handling' stamp: 'al 12/16/2003 16:16'!
traitConflict
	self error: 'A class or trait does not properly resolve a conflict between multiple traits it uses.'! !

!Object methodsFor: 'events-triggering' stamp: 'MarcusDenker 7/23/2014 22:37'!
triggerEvent: anEventSelector
with: anObject

    ^self 
		triggerEvent: anEventSelector
		withArguments: { anObject }! !

!Object methodsFor: '*Monticello-Storing' stamp: 'MarianoMartinezPeck 5/21/2012 22:52'!
storeDataOn: aDataStream
	"Store myself on a DataStream.  Answer self.  This is a low-level DataStream/ReferenceStream method. See also objectToStoreOnDataStream.  NOTE: This method must send 'aDataStream beginInstance:size:' and then (nextPut:/nextPutWeak:) its subobjects.  readDataFrom:size: reads back what we write here."
	| cntInstVars cntIndexedVars |

	cntInstVars := self class instSize.
	cntIndexedVars := self basicSize.
	aDataStream
		beginInstance: self class
		size: cntInstVars + cntIndexedVars.
	1 to: cntInstVars do:
		[:i | aDataStream nextPut: (self instVarAt: i)].

	"Write fields of a variable length object. "
	(self class isBits) ifFalse: [
		1 to: cntIndexedVars do:
			[:i | aDataStream nextPut: (self basicAt: i)]].
! !

!Object methodsFor: 'stepping' stamp: 'sw 10/19/1999 08:26'!
wantsStepsIn: aSystemWindow
	
	^ self wantsSteps! !

!Object methodsFor: '*Collections-Abstract-splitjoin' stamp: 'CamilloBruni 1/19/2013 12:38'!
split: aSequenceableCollection indicesDo: aBlock
	"optimized version for single delimiters:
	Example:
		$/ split: '/foo/bar' indicesDo: [ :start :end | ]"
		
	|  position oldPosition |
	
	position := 1.
	oldPosition := position.
	
	position := aSequenceableCollection indexOf: self startingAt: position.
	[ position > 0 ] whileTrue: [
		aBlock value: oldPosition value: position - 1.
		position := position + 1.
		oldPosition := position.
		position := aSequenceableCollection indexOf: self startingAt: position.
	].

	aBlock value: oldPosition value: aSequenceableCollection size.
! !

!Object methodsFor: 'testing' stamp: ''!
isText
	^ false! !

!Object methodsFor: 'events-accessing' stamp: 'reThink 2/18/2001 14:43'!
actionMap

	^EventManager actionMapFor: self! !

!Object methodsFor: 'finalization' stamp: 'Igor.Stasenko 5/25/2010 04:59'!
hasMultipleExecutors
	"All objects, except ObjectFinalizerCollection instances should answer false to this message"
	^ false! !

!Object methodsFor: 'updating' stamp: 'sw 10/31/1999 00:15'!
noteSelectionIndex: anInteger for: aSymbol
	"backstop"! !

!Object methodsFor: '*Morphic-Base' stamp: 'cb 6/25/2013 13:23'!
defaultLabel
	"Answer the default label to be used in morphs."

	^ self class name! !

!Object methodsFor: 'tracing' stamp: 'StephaneDucasse 11/6/2011 23:55'!
trace: aString
	"Log the argument. Use self trace: instead of Transcript show: "
	
	Transcript show: aString.! !

!Object methodsFor: '*Glamour-Helpers' stamp: 'tg 9/9/2009 01:02'!
asGlamorousMultiValue
	^ GLMMultiValue with: self! !

!Object methodsFor: 'reflective operations' stamp: 'di 1/9/1999 15:19'!
becomeForward: otherObject 
	"Primitive. All variables in the entire system that used to point
	to the receiver now point to the argument.
	Fails if either argument is a SmallInteger."

	(Array with: self)
		elementsForwardIdentityTo:
			(Array with: otherObject)! !

!Object methodsFor: 'printing' stamp: 'BG 11/7/2004 13:39'!
longPrintStringLimitedTo: aLimitValue
	"Answer a String whose characters are a description of the receiver."
	
	| str |
	str := String streamContents: [:aStream | self longPrintOn: aStream limitedTo: aLimitValue indent: 0].
	"Objects without inst vars should return something"
	^ str isEmpty ifTrue: [self printString, String cr] ifFalse: [str]! !

!Object methodsFor: 'primitive failure' stamp: 'StephaneDucasse 3/27/2010 23:07'!
primitiveFailed
	"Announce that a primitive has failed and there is no appropriate Smalltalk code to run."

	self primitiveFailed: thisContext sender selector! !

!Object methodsFor: '*MenuRegistration-Core' stamp: 'SeanDeNigris 6/16/2013 13:38'!
fallbackMenuOn: aMenuMorph
	"When pragma menu building goes wrong, a fallback menu is created. To add custom items to that menu, override me in subclasses. See WorldState>>#fallbackMenuOn: for an example"! !

!Object methodsFor: '*monticellofiletree-core' stamp: 'dkh 4/6/2012 15:56:14'!
writeCypressJsonForHtmlOn: aStream indent: startIndent
    self writeCypressJsonOn: aStream forHtml: true indent: startIndent! !

!Object methodsFor: 'testing' stamp: 'ajh 1/21/2003 13:15'!
isBlock

	^ false! !

!Object methodsFor: 'testing' stamp: 'md 10/2/2005 21:52'!
isRectangle
	^false! !

!Object methodsFor: 'converting' stamp: 'sma 5/12/2000 17:39'!
asOrderedCollection
	"Answer an OrderedCollection with the receiver as its only element."

	^ OrderedCollection with: self! !

!Object methodsFor: 'converting' stamp: 'HenrikSperreJohansen 10/18/2009 15:58'!
asLink
	"Answer a string that represents the receiver."

	^ ValueLink value: self! !

!Object methodsFor: '*Graphics-Display Objects' stamp: 'sw 3/26/2001 12:12'!
printDirectlyToDisplay
	"For debugging: write the receiver's printString directly to the display at (0, 100); senders of this are detected by the check-for-slips mechanism."

	self asString displayAt: 0@100

"StringMorph someInstance printDirectlyToDisplay"! !

!Object methodsFor: '*Morphic-Base' stamp: 'HenrikSperreJohansen 6/28/2010 12:24'!
externalName
	"Answer an external name by which the receiver is known. Generic
	implementation here is a transitional backstop. probably"
	^ [(self asString copyWithout: Character cr)
		truncateTo: 27]
		ifError: [ ^ self class name printString] ! !

!Object methodsFor: 'testing' stamp: 'eem 11/26/2008 20:22'!
isContext
	^false! !

!Object methodsFor: '*Polymorph-Widgets-Themes' stamp: 'YuriyTymchuk 12/20/2013 11:14'!
systemIcon

	^ Smalltalk ui icons iconNamed: #classIcon! !

!Object methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 1/23/2015 21:46'!
phlowValue: anObject withEnoughArguments: aCollection

	^ self! !

!Object methodsFor: '*NativeBoost-core' stamp: 'IgorStasenko 11/22/2012 14:25'!
nbCallout

	^ NBFFICalloutAPI inContext: thisContext sender! !

!Object methodsFor: 'accessing' stamp: ''!
basicAt: index put: value 
	"Primitive. Assumes receiver is indexable. Store the second argument 
	value in the indexable element of the receiver indicated by index. Fail 
	if the index is not an Integer or is out of bounds. Or fail if the value is 
	not of the right type for this kind of collection. Answer the value that 
	was stored. Essential. Do not override in a subclass. See Object 
	documentation whatIsAPrimitive."

	<primitive: 61>
	index isInteger
		ifTrue: [(index >= 1 and: [index <= self size])
					ifTrue: [self errorImproperStore]
					ifFalse: [self errorSubscriptBounds: index]].
	index isNumber
		ifTrue: [^self basicAt: index asInteger put: value]
		ifFalse: [self errorNonIntegerIndex]! !

!Object methodsFor: 'stepping' stamp: 'sw 10/19/1999 08:21'!
stepTime
	
	^ 1000 "milliseconds -- default backstop for objects serving as models of system windows"! !

!Object methodsFor: '*GT-Spotter' stamp: 'StefanReichhart 3/20/2015 11:48'!
hasDynamicItems
	^ false! !

!Object methodsFor: 'dependencies' stamp: 'sma 2/29/2000 19:55'!
myDependents
	"Private. Answer a list of all the receiver's dependents."

	^ DependentsFields at: self ifAbsent: []! !

!Object methodsFor: 'associating' stamp: 'md 7/22/2005 16:03'!
-> anObject
	"Answer an Association between self and anObject"

	^Association basicNew key: self value: anObject! !

!Object methodsFor: 'dependencies' stamp: ''!
release
	"Remove references to objects that may refer to the receiver. This message 
	should be overridden by subclasses with any cycles, in which case the 
	subclass should also include the expression super release."

	self releaseActionMap! !

!Object methodsFor: 'events-registering' stamp: 'rww 12/30/2002 10:37'!
when: anEventSelector
send: aMessageSelector
to: anObject
 
    self
        when: anEventSelector
        evaluate: (WeakMessageSend
            receiver: anObject
            selector: aMessageSelector)! !

!Object methodsFor: 'converting' stamp: 'rw 4/27/2002 07:48'!
asActionSequence

	^WeakActionSequence with: self! !

!Object methodsFor: 'deprecation' stamp: 'MarcusDenker 3/26/2013 13:17'!
deprecated: anExplanationString
	"this is not itself deprecated, but a compatibility method for old-style deprecation"
	
	(Deprecation
		method: thisContext sender method
		explanation: anExplanationString
		on: 'unknown'
		in: 'unknown') signal! !

!Object methodsFor: 'stepping' stamp: 'sw 10/19/1999 08:16'!
stepIn: aWindow

	^ self step! !

!Object methodsFor: 'deprecation' stamp: 'AndrewBlack 9/6/2009 08:58'!
deprecated: anExplanationString on: date in: version
	"Warn that the sending method has been deprecated"
	
	(Deprecation
		method: thisContext sender method
		explanation: anExplanationString
		on: date
		in: version) signal! !

!Object methodsFor: 'tracing' stamp: 'StephaneDucasse 11/6/2011 23:57'!
crTrace: aString
	"Log the argument. Use self crTrace: instead of Transcript cr; show: "
	
	Transcript cr; show: aString.! !

!Object methodsFor: '*Morphic-Base' stamp: 'BenjaminVanRyseghem 10/11/2013 15:27'!
head

	^ self! !

!Object methodsFor: 'literal testing' stamp: 'ul 11/23/2010 13:28'!
shouldBePrintedAsLiteral

	^self isLiteral! !

!Object methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
metacelloVersionComponentLessThan: aMetacelloVersonComponent

	^self error: 'Invalid Metacello verson component - should be String or Integer.'! !

!Object methodsFor: '*NativeBoost-core' stamp: 'IgorStasenko 11/24/2012 16:07'!
nbCall: fnSpec module: aModuleNameOrHandle options: callOptions
	" you can override this method if you need to"

	^ (self nbCalloutIn: thisContext sender)
		convention: self nbCallingConvention;
		options: callOptions;
		function: fnSpec module: aModuleNameOrHandle ! !

!Object methodsFor: '*NewValueHolder' stamp: 'BenjaminVanRyseghem 1/24/2014 18:46'!
asValueHolder
	"See NewValueHolder class comment"

	^ NewValueHolder value: self! !

!Object methodsFor: 'copying' stamp: 'tpr 2/14/2004 21:53'!
copyFrom: anotherObject
	"Copy to myself all instance variables I have in common with anotherObject.  This is dangerous because it ignores an object's control over its own inst vars.  "

	| mine his |
	<primitive: 168>
	mine := self class allInstVarNames.
	his := anotherObject class allInstVarNames.
	1 to: (mine size min: his size) do: [:ind |
		(mine at: ind) = (his at: ind) ifTrue: [
			self instVarAt: ind put: (anotherObject instVarAt: ind)]].
	self class isVariable & anotherObject class isVariable ifTrue: [
		1 to: (self basicSize min: anotherObject basicSize) do: [:ind |
			self basicAt: ind put: (anotherObject basicAt: ind)]].! !

!Object methodsFor: 'finalization' stamp: 'ar 5/19/2003 20:10'!
finalizationRegistry
	"Answer the finalization registry associated with the receiver."
	^WeakRegistry default! !

!Object methodsFor: 'events-registering' stamp: 'gvc 10/24/2006 11:49'!
when: anEventSelector
sendOnce: aMessageSelector
to: anObject
with: anArg
 
    self
        when: anEventSelector
        evaluate: (NonReentrantWeakMessageSend
            receiver: anObject
            selector: aMessageSelector
		arguments: (Array with: anArg))! !

!Object methodsFor: 'casing-To be deprecated' stamp: 'StephaneDucasse 8/12/2013 21:27'!
caseOf: aBlockAssociationCollection otherwise: aBlock
	"DO NOT USE THIS METHOD!! It will be removed from Pharo."
	
	"The elements of aBlockAssociationCollection are associations between blocks.
	 Answer the evaluated value of the first association in aBlockAssociationCollection
	 whose evaluated key equals the receiver.  If no match is found, answer the result
	 of evaluating aBlock."

	aBlockAssociationCollection associationsDo:
		[:assoc | (assoc key value = self) ifTrue: [^assoc value value]].
	^ aBlock value

"| z | z := {[#a]->[1+1]. ['b' asSymbol]->[2+2]. [#c]->[3+3]}. #b caseOf: z otherwise: [0]"
"| z | z := {[#a]->[1+1]. ['d' asSymbol]->[2+2]. [#c]->[3+3]}. #b caseOf: z otherwise: [0]"
"The following are compiled in-line:"
"#b caseOf: {[#a]->[1+1]. ['b' asSymbol]->[2+2]. [#c]->[3+3]} otherwise: [0]"
"#b caseOf: {[#a]->[1+1]. ['d' asSymbol]->[2+2]. [#c]->[3+3]} otherwise: [0]"! !

!Object methodsFor: 'printing' stamp: 'di 6/20/97 08:57'!
fullPrintString
	"Answer a String whose characters are a description of the receiver."

	^ String streamContents: [:s | self printOn: s]! !

!Object methodsFor: 'updating' stamp: ''!
changed: aParameter 
	"Receiver changed. The change is denoted by the argument aParameter. 
	Usually the argument is a Symbol that is part of the dependent's change 
	protocol. Inform all of the dependents."

	self dependents do: [:aDependent | aDependent update: aParameter]! !

!Object methodsFor: 'events-accessing' stamp: 'rw 4/27/2002 08:35'!
actionSequenceForEvent: anEventSelector

    ^(self actionMap
        at: anEventSelector asSymbol
        ifAbsent: [^WeakActionSequence new])
            asActionSequence! !

!Object methodsFor: 'dependencies' stamp: 'sma 2/29/2000 19:26'!
canDiscardEdits
	"Answer true if none of the views on this model has unaccepted edits that matter."

	self dependents
		do: [:each | each canDiscardEdits ifFalse: [^ false]]
		without: self.
	^ true! !

!Object methodsFor: 'testing' stamp: 'ar 7/9/1999 18:18'!
isBehavior
	"Return true if the receiver is a behavior.
	Note: Do not override in any class except behavior."
	^false! !

!Object methodsFor: 'events-removing' stamp: 'reThink 2/18/2001 15:33'!
releaseActionMap

	EventManager releaseActionMapFor: self! !

!Object methodsFor: 'events-removing' stamp: 'MarcusDenker 10/2/2013 20:15'!
removeActionsSatisfying: aBlock

	self actionMap keysDo:
		[:eachEventSelector |
			self
   				removeActionsSatisfying: aBlock
				forEvent: eachEventSelector
		]! !

!Object methodsFor: 'nil testing' stamp: 'MarcusDenker 12/2/2013 14:15'!
ifNil: nilBlock ifNotNilDo: aBlock 
	"please use #ifNil:ifNotNil: "

	^ aBlock value: self
! !

!Object methodsFor: 'class membership' stamp: ''!
respondsTo: aSymbol 
	"Answer whether the method dictionary of the receiver's class contains 
	aSymbol as a message selector."

	^self class canUnderstand: aSymbol! !

!Object methodsFor: 'events-removing' stamp: 'reThink 2/18/2001 15:33'!
removeActionsForEvent: anEventSelector

    | map |
    map := self actionMap.
    map removeKey: anEventSelector asSymbol ifAbsent: [].
    map isEmpty
        ifTrue: [self releaseActionMap]! !

!Object methodsFor: 'accessing' stamp: ''!
basicSize
	"Primitive. Answer the number of indexable variables in the receiver. 
	This value is the same as the largest legal subscript. Essential. Do not 
	override in any subclass. See Object documentation whatIsAPrimitive."

	<primitive: 62>
	"The number of indexable fields of fixed-length objects is 0"
	^0	! !

!Object methodsFor: '*GT-Inspector' stamp: 'TommasoDalSasso 1/30/2015 16:32'!
gtInspectorVariableValuePairs
	"This is a helper method that returns a collection of 
		variable_name -> value
	for the current object.
	Subclasses can override it to specialize what appears in the variables presentation"
	| bindings |
	bindings := OrderedCollection new.
					
	1 to: (self basicSize min: 21) do: [ :index | 
		bindings add: (index "asString""asTwoCharacterString" -> (self basicAt: index)) ].
	
	((self basicSize - 20) max: 22) to: (self basicSize) do: [ :index | "self haltIf: [ index = 99 ]."
		bindings add: (index "asString" -> (self basicAt: index)) ].
	
	bindings
		addAll: ((self class allSlots 
					collect: [ :slot | slot name -> (slot read: self) ]) sort asOrderedCollection).
	^ bindings! !

!Object methodsFor: 'private' stamp: 'eem 5/9/2008 09:04'!
species
	"Answer the preferred class for reconstructing the receiver.  For example, 
	collections create new collections whenever enumeration messages such as 
	collect: or select: are invoked.  The new kind of collection is determined by 
	the species of the original collection.  Species and class are not always the 
	same.  For example, the species of Interval is Array."
	<primitive: 111>
	^self class! !

!Object methodsFor: 'testing' stamp: 'eem 5/8/2008 11:13'!
isArray
	^false! !

!Object methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 1/22/2015 21:13'!
phlowValue: anObject

	^ self! !

!Object methodsFor: 'testing' stamp: 'ar 8/14/2001 23:19'!
isVariableBinding
	"Return true if I represent a literal variable binding"
	^false
	! !

!Object methodsFor: 'events-registering' stamp: 'gvc 10/25/2006 18:17'!
when: anEventSelector
send: aMessageSelector
to: anObject
with: anArg
exclusive: aValueHolder
 
    self
        when: anEventSelector
        evaluate: ((ExclusiveWeakMessageSend
 		receiver: anObject
		selector: aMessageSelector
		arguments: (Array with: anArg))
			basicExecuting: aValueHolder)! !

!Object methodsFor: '*metacello-core' stamp: 'dkh 6/21/2012 20:08'!
metacelloSemanticVersionComponentLessThan: aMetacelloVersonComponent
    ^ self error: 'Invalid Metacello verson component - should be String or Integer.'! !

!Object methodsFor: 'message performing' stamp: 'ClementBera 4/21/2013 14:53'!
perform: aSymbol with: firstObject with: secondObject 
	"Send the selector, aSymbol, to the receiver with the given arguments.
	Fail if the number of arguments expected by the selector is not two.
	Primitive. Optional. See Object documentation whatIsAPrimitive."

	<reflective: #object:performMessageWith:>
	<primitive: 83>
	^ self perform: aSymbol withArguments: (Array with: firstObject with: secondObject)! !

!Object methodsFor: 'events-removing' stamp: 'reThink 2/18/2001 15:31'!
removeActionsSatisfying: aOneArgBlock 
forEvent: anEventSelector

    self
        setActionSequence:
            ((self actionSequenceForEvent: anEventSelector)
                reject: [:anAction | aOneArgBlock value: anAction])
        forEvent: anEventSelector! !

!Object methodsFor: '*NativeBoost-core' stamp: 'IgorStasenko 1/17/2012 16:04'!
nbGetSymbolAddress: aName module: aModuleNameOrHandle
	"Lookup for given symbol in external module and answer its address
	(an instance of NBExternalAddress), or nil if not found.
	
	A default implementation,
	first we try to use OS-specific symbol lookup mechanism,
	and if not found, we try to lookup a symbol from VM registered plugin(s)"
	
	| addr |
	
	addr := NativeBoost loadSymbol: aName fromModule: aModuleNameOrHandle.

	^ addr ifNil: [ 
		"loadfunction takes only names, not handles"
		aModuleNameOrHandle isString 
			ifFalse: [ nil ] 
			ifTrue: [ NativeBoost loadFunction: aName from: aModuleNameOrHandle ]]! !

!Object methodsFor: '*GT-Spotter' stamp: 'StefanReichhart 3/17/2015 15:48'!
spotterProcessorsFor: aSpotterStep pragma: aPragma
	" if there is a problem with the definition of one or more processors, let the other processors continue to work "
	 [ self perform: aPragma selector with: aSpotterStep ]
		on: Error 
		do: [ :exception | 
			aSpotterStep exceptionHandler
				handleException: exception
				do: [ 	('[Spotter] Exception while collecting processors for <', self class name, '>: ', exception asString) logCr ] ]! !

!Object methodsFor: '*GT-Inspector' stamp: 'TudorGirba 6/28/2014 22:18'!
gtInspectorInterestingObject
	^ self! !

!Object methodsFor: 'updating' stamp: ''!
changed
	"Receiver changed in a general way; inform all the dependents by 
	sending each dependent an update: message."

	self changed: self! !

!Object methodsFor: 'reading' stamp: 'damiencassou 5/30/2008 10:56'!
readFromString: aString 
	"Create an object based on the contents of aString."
	^ self readFrom: aString readStream! !

!Object methodsFor: 'reflective operations' stamp: 'CamilloBruni 8/1/2012 16:26'!
doesNotUnderstand: aMessage 
	 "Handle the fact that there was an attempt to send the given message to the receiver but the receiver does not understand this message (typically sent from the machine when a message is sent to the receiver and no method is defined for that selector)."
	"Testing: (3 activeProcess)"
		
	| exception resumeValue |
	(exception := MessageNotUnderstood new)
		message: aMessage;
		receiver: self.
	resumeValue := exception signal.
	^exception reachedDefaultHandler
		ifTrue: [aMessage sentTo: self]
		ifFalse: [resumeValue]! !

!Object methodsFor: '*Morphic-Base' stamp: 'BenjaminVanRyseghem 5/16/2013 12:21'!
transferFor: passenger from: aMorph

	^ TransferMorph withPassenger: passenger from: aMorph! !

!Object methodsFor: '*Spec-Core' stamp: 'ChristopheDemarey 11/20/2013 14:38'!
isTreeNodeModel

	^ false! !

!Object methodsFor: 'testing' stamp: 'nk 4/17/2004 19:43'!
isColorForm
	^false! !

!Object methodsFor: '*UIManager' stamp: 'rbb 3/1/2005 09:26'!
confirm: queryString
	"Put up a yes/no menu with caption queryString. Answer true if the 
	response is yes, false if no. This is a modal question--the user must 
	respond yes or no."

	"nil confirm: 'Are you hungry?'"

	^ UIManager default confirm: queryString! !

!Object methodsFor: 'printing' stamp: 'MarianoMartinezPeck 8/24/2012 15:28'!
printOn: aStream
	"Append to the argument, aStream, a sequence of characters that  
	identifies the receiver."

	| title |
	title := self class name.
	aStream
		nextPutAll: (title first isVowel ifTrue: ['an '] ifFalse: ['a ']);
		nextPutAll: title! !

!Object methodsFor: 'events-triggering' stamp: 'reThink 2/18/2001 15:21'!
triggerEvent: anEventSelector
withArguments: anArgumentList

    ^(self actionForEvent: anEventSelector)
        valueWithArguments: anArgumentList! !

!Object methodsFor: 'converting' stamp: 'nice 3/28/2006 23:29'!
adaptToFloat: rcvr andCompare: selector 
	"If I am involved in comparison with a Float.
	Default behaviour is to process comparison as any other selectors."
	^ self adaptToFloat: rcvr andSend: selector! !

!Object methodsFor: 'logging-Deprecated' stamp: 'StephaneDucasse 5/23/2011 22:09'!
log: aString
	"Log the argument. Use self log: instead of Transcript show: "
	
	Transcript show: aString.! !

!Object methodsFor: '*NativeBoost-core' stamp: 'IgorStasenko 11/24/2012 16:07'!
nbCall: fnSpec
	" you can override this method if you need to"
	
	^ (self nbCalloutIn: thisContext sender)
		convention: self nbCallingConvention;
		function: fnSpec module: self nbLibraryNameOrHandle ! !

!Object methodsFor: '*monticellofiletree-core' stamp: 'ChristopheDemarey 9/8/2013 18:34'!
writeCypressJsonOn: aStream forHtml: forHtml indent: startIndent
    "by default ignore <forHtml> ... <forHtml> is used for Dictionary and Array, i.e., container objects and String which actually encodes itself differently for HTML"

    ^ SubclassResponsibility signalFor: thisContext sender selector! !

!Object methodsFor: '*GT-Spotter' stamp: 'TudorGirba 11/18/2014 23:22'!
spotterActDefault
	^ self inspect! !

!Object methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 2/21/2015 21:56'!
gtInspectorActionSpot
	<gtInspectorAction>
	^ GLMGenericAction new
		action: [ 
			GTSpotterMorph new
				extent: 400@500;
				doLayout;
				spotterModel: (GTSpotter on: self);
				openCenteredInWorld
			 ];
		icon: GLMUIThemeExtraIcons glamorousSearch;
		condition: [ 
				| fakeStep |
				fakeStep := GTSpotter new newStep origin: self.
				self spotterProcessorsFor: fakeStep.
				fakeStep processors notEmpty ];
		title: 'Search'! !

!Object methodsFor: 'error handling' stamp: 'tfei 4/12/1999 12:55'!
error: aString 
	"Throw a generic Error exception."

	^Error new signal: aString! !

!Object methodsFor: 'primitive failure' stamp: 'SvenVanCaekenberghe 4/20/2011 13:26'!
primitiveFailed: selector
	"Announce that a primitive has failed and there is no appropriate Smalltalk code to run."
	
	PrimitiveFailed signalFor: selector! !

!Object methodsFor: '*Spec-Inspector' stamp: 'CamilloBruni 9/20/2013 19:27'!
additionalInspectorClasses
	"Answer addtional inspector classes that are used to show alternative views of instances of myself"

	^ { }! !

!Object methodsFor: 'events-registering' stamp: 'gvc 10/25/2006 18:17'!
when: anEventSelector
send: aMessageSelector
to: anObject
withArguments: anArgArray
exclusive: aValueHolder
 
    self
        when: anEventSelector
        evaluate: ((ExclusiveWeakMessageSend
		receiver: anObject
		selector: aMessageSelector
		arguments: anArgArray)
			basicExecuting: aValueHolder)! !

!Object methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	"Append to the argument aStream a sequence of characters that is an 
	expression whose evaluation creates an object similar to the receiver."

	aStream nextPut: $(.
	self class isVariable
		ifTrue: [aStream nextPutAll: '(', self class name, ' basicNew: ';
					store: self basicSize;
					nextPutAll: ') ']
		ifFalse: [aStream nextPutAll: self class name, ' basicNew'].
	1 to: self class instSize do:
		[:i |
		aStream nextPutAll: ' instVarAt: ';
			store: i;
			nextPutAll: ' put: ';
			store: (self instVarAt: i);
			nextPut: $;].
	1 to: self basicSize do:
		[:i |
		aStream nextPutAll: ' basicAt: ';
			store: i;
			nextPutAll: ' put: ';
			store: (self basicAt: i);
			nextPut: $;].
	aStream nextPutAll: ' yourself)'
! !

!Object methodsFor: 'events-triggering' stamp: 'reThink 2/18/2001 15:22'!
triggerEvent: anEventSelector
	"Evaluate all actions registered for <anEventSelector>. Return the value of the last registered action."

    ^(self actionForEvent: anEventSelector) value! !

!Object methodsFor: 'casing-To be deprecated' stamp: 'StephaneDucasse 8/12/2013 21:27'!
caseError
	"DO NOT USE THIS METHOD!! It will be removed from Pharo."
	"Report an error from an in-line or explicit case statement."

	self error: 'Case not found (', self printString, '), and no otherwise clause'! !

!Object methodsFor: 'error handling' stamp: 'SvenVanCaekenberghe 4/20/2011 13:26'!
shouldBeImplemented
	"Announce that this message should be implemented"

	ShouldBeImplemented signalFor: thisContext sender selector! !

!Object methodsFor: 'dependencies' stamp: 'ar 2/11/2001 01:55'!
addDependent: anObject
	"Make the given object one of the receiver's dependents."

	| dependents |
	dependents := self dependents.
	(dependents includes: anObject) ifFalse:
		[self myDependents: (dependents copyWithDependent: anObject)].
	^ anObject! !

!Object methodsFor: '*UIManager' stamp: 'CamilloBruni 8/1/2012 16:09'!
inform: aString
	"Display a message for the user to read and then dismiss."

	aString isEmptyOrNil ifFalse: [UIManager default inform: aString]! !

!Object methodsFor: 'introspection' stamp: 'sw 10/16/2000 10:59'!
className
	"Answer a string characterizing the receiver's class, for use in list views for example"

	^ self class name asString! !

!Object methodsFor: 'logging-Deprecated' stamp: 'StephaneDucasse 5/27/2011 19:09'!
crLog: aString
	"Log the argument. Use self log: instead of Transcript cr; show: "
	
	Transcript cr; show: aString.! !

!Object methodsFor: 'tracing' stamp: 'StephaneDucasse 11/6/2011 23:56'!
traceCr
      self traceCr: self printString! !

!Object methodsFor: '*OpalCompiler-Core' stamp: 'CamilleTeruel 10/16/2014 17:38'!
mustBeBooleanInMagic: context
	"Permits to redefine methods inlined by compiler.
	Take the ast node corresponding to the mustBeBoolean error, compile it on the with Opal fly and executes it as a DoIt. Then resume the execution of the context."

	| sendNode methodNode method |
	"go back before the jump"
	context skipBackBeforeJump.
	"get the node that triggered mustBeBoolean"
	sendNode := context sourceNode sourceNodeForPC: context pc.
	"Build method node"
	methodNode := RBMethodNode 
		selector: #ExecuteUnOptimizedIn: 
		arguments: { RBVariableNode named:'ThisContext' } 
		body: sendNode copy asSequenceNode.
	"Rewrite temps for context"
	methodNode rewriteTempsForContext: context.
	"Rewrite non-local returns to return to the correct context"
	RBParseTreeRewriter new 
		replace: '^ ``@value' with: 'ThisContext home return: ``@value';
		executeTree: methodNode.
	"Add a return to the method body"
	methodNode body transformLastToReturn.	
	"Keep same compilation context than the sender node's"
	methodNode compilationContext: sendNode methodNode compilationContext copy.
	"Disable inlining"
	methodNode compilationContext compilerOptions: #(- optionInlineIf optionInlineAndOr optionInlineWhile).
	"Generate the method"	
	method := methodNode generate.
	"jump to the instruction after jump"
	context pc: sendNode irInstruction nextBytecodeOffsetAfterJump.
	"Execute the generated method"
	^ context receiver withArgs: {context} executeMethod: method! !

!Object methodsFor: '*Fuel' stamp: 'MaxLeske 5/3/2013 15:18'!
fuelReplacement
	^ self! !

!Object methodsFor: 'stepping' stamp: 'sw 10/20/1999 14:52'!
stepAt: millisecondClockValue in: aWindow

	^ self stepIn: aWindow! !

!Object methodsFor: '*Kernel-Exceptions-debugging' stamp: 'BenComan 1/28/2015 00:21'!
haltOnCount: anInteger 
	<debuggerCompleteToSender>
	Halt onCount: anInteger.! !

!Object methodsFor: 'comparing' stamp: 'MarianoMartinezPeck 8/24/2012 15:58'!
= anObject 
	"Answer whether the receiver and the argument represent the same 
	object. If = is redefined in any subclass, consider also redefining the 
	message hash."

	^self == anObject ! !

!Object methodsFor: '*Kernel-Exceptions-debugging' stamp: 'BenComan 1/28/2015 00:21'!
haltIfShiftPressed
	<debuggerCompleteToSender>
	Halt ifShiftPressed.! !

!Object methodsFor: 'converting' stamp: 'di 11/9/1998 12:15'!
adaptToInteger: rcvr andSend: selector
	"If no method has been provided for adapting an object to a Integer,
	then it may be adequate to simply adapt it to a number."
	^ self adaptToNumber: rcvr andSend: selector! !

!Object methodsFor: 'events-removing' stamp: 'reThink 2/18/2001 15:31'!
removeAction: anAction
forEvent: anEventSelector

    self
        removeActionsSatisfying: [:action | action = anAction]
        forEvent: anEventSelector! !

!Object methodsFor: 'testing' stamp: 'md 4/30/2003 15:30'!
isSymbol
	^ false ! !

!Object methodsFor: 'testing' stamp: 'md 8/11/2005 16:45'!
isDictionary
	^false! !

!Object methodsFor: 'testing' stamp: 'rhi 8/14/2003 08:51'!
isHeap

	^ false! !

!Object methodsFor: 'error handling' stamp: 'md 1/20/2006 16:24'!
handles: exception
	"This method exists in case a non exception class is the first arg in an on:do: (for instance using a exception class that is not loaded). We prefer this to raising an error during error handling itself. Also, semantically it makes sense that the exception handler is not active if its exception class is not loaded"

	^ false! !

!Object methodsFor: 'events-registering' stamp: 'MarcusDenker 7/23/2014 22:37'!
when: anEventSelector
send: aMessageSelector
to: anObject
with: anArg
 
    self
        when: anEventSelector
        evaluate: (WeakMessageSend
            receiver: anObject
            selector: aMessageSelector
		arguments: {anArg})! !

!Object methodsFor: 'introspection' stamp: 'MarcusDenker 6/26/2014 16:29'!
writeToSlot: aSlot of: anObject
	^anObject writeSlot: aSlot value: self! !

!Object methodsFor: 'error handling' stamp: 'md 8/2/2005 22:17'!
error
	"Throw a generic Error exception."

	^self error: 'Error!!'.! !

!Object methodsFor: 'comparing' stamp: ''!
~= anObject 
	"Answer whether the receiver and the argument do not represent the 
	same object."

	^self = anObject == false! !

!Object methodsFor: 'introspection' stamp: ''!
instVarAt: index 
	"Primitive. Answer a fixed variable in an object. The numbering of the 
	variables corresponds to the named instance variables. Fail if the index 
	is not an Integer or is not the index of a fixed variable. Essential. See 
	Object documentation whatIsAPrimitive."

	<primitive: 73>
	"Access beyond fixed variables."
	^self basicAt: index - self class instSize		! !

!Object methodsFor: 'testing' stamp: ''!
isNumber
	"Overridden to return true in Number, natch"
	^ false! !

!Object methodsFor: 'testing' stamp: 'jam 3/9/2003 15:10'!
isSystemWindow
"answer whatever the receiver is a SystemWindow"
	^ false! !

!Object methodsFor: 'events-removing' stamp: 'rw 7/29/2003 17:18'!
removeActionsWithReceiver: anObject

	self actionMap copy keysDo:
		[:eachEventSelector |
			self
   				removeActionsSatisfying: [:anAction | anAction receiver == anObject]
				forEvent: eachEventSelector
		]! !

!Object methodsFor: '*Fuel' stamp: 'MartinDias 8/27/2011 19:03'!
fuelAfterMaterialization
	"Materialization process will send this message after materializing instances of my class"! !

!Object methodsFor: '*GT-Spotter' stamp: 'AliakseiSyrel 3/21/2015 23:43'!
spotterPreviewRawIn: aComposite
	<spotterPreview: 40>

	aComposite table
		title: [ self gtDisplayString ];
		display: [ :anObject | (anObject gtInspectorVariableValuePairs asSortedCollection asOrderedCollection yourself) addFirst: 'self' -> anObject; yourself ];
		column: 'Variable'
			evaluated: [:assoc |	GTObjectPrinter new asNonTruncatedTextFrom: assoc key ]
			styled: [ :aBrick | aBrick textPosition: #rightCenter; margin: #(0 15 0 0); textColor: aComposite themer textLightColor; height: 30 ];
		column: 'Value'
			evaluated: [:assoc | GTObjectPrinter new asTruncatedTextFrom: assoc value ]
			styled: [ :aBrick | aBrick margin: #(0 0 0 15); height: 30 ];
		entity: self.
		
	self flag: 'move "entity: self" somewhere else, maybe'! !

!Object methodsFor: 'updating' stamp: 'MarianoMartinezPeck 8/24/2012 15:28'!
windowIsClosing
	"This message is used to inform a models that its window is closing. Most models do nothing, but some, such as the Debugger, must do some cleanup. Note that this mechanism must be used with care by models that support multiple views, since one view may be closed while others left open."
! !

!Object methodsFor: 'flagging' stamp: 'MarcusDenker 9/14/2013 10:28'!
isThisEverCalled: msg
	"Send this message, with some useful printable argument, from methods or branches of methods which you believe are never reached."

	self error: 'This is indeed called: ', msg printString! !

!Object methodsFor: 'events-registering' stamp: 'rww 12/30/2002 10:37'!
when: anEventSelector
send: aMessageSelector
to: anObject
withArguments: anArgArray
 
    self
        when: anEventSelector
        evaluate: (WeakMessageSend
            receiver: anObject
            selector: aMessageSelector
		arguments: anArgArray)! !

!Object methodsFor: 'user interface' stamp: 'sw 10/16/1999 22:45'!
modelWakeUpIn: aWindow
	"A window with me as model is being entered or expanded.  Default response is no-op" 
	self modelWakeUp! !

!Object methodsFor: 'user interface' stamp: 'RAA 3/31/1999 12:13'!
withoutListWrapper

	^self! !

!Object methodsFor: '*GT-Inspector-Examples' stamp: 'AndreiChis 10/30/2014 14:24'!
isGTExample
	
	^ false! !

!Object methodsFor: 'error handling' stamp: ''!
notify: aString at: location
	"Create and schedule a Notifier with the argument as the message in 
	order to request confirmation before a process can proceed. Subclasses can
	override this and insert an error message at location within aString."

	self notify: aString

	"nil notify: 'confirmation message' at: 12"! !

!Object methodsFor: 'converting' stamp: 'di 11/9/1998 12:14'!
adaptToFraction: rcvr andSend: selector
	"If no method has been provided for adapting an object to a Fraction,
	then it may be adequate to simply adapt it to a number."
	^ self adaptToNumber: rcvr andSend: selector! !

!Object methodsFor: '*Tool-Base' stamp: 'MarcusDenker 7/30/2014 17:14'!
browse
	^ Smalltalk tools browser fullOnClass: self class! !

!Object methodsFor: '*monticellofiletree-core' stamp: 'dkh 4/6/2012 15:56:14'!
writeCypressJsonOn: aStream indent: startIndent
    self writeCypressJsonOn: aStream forHtml: false indent: startIndent! !

!Object methodsFor: 'finalization' stamp: 'ar 3/21/98 18:38'!
retryWithGC: execBlock until: testBlock
	"Retry execBlock as long as testBlock returns false. Do an incremental GC after the first try, a full GC after the second try."
	| blockValue |
	blockValue := execBlock value.
	(testBlock value: blockValue) ifTrue:[^blockValue].
	Smalltalk garbageCollectMost.
	blockValue := execBlock value.
	(testBlock value: blockValue) ifTrue:[^blockValue].
	Smalltalk garbageCollect.
	^execBlock value.! !

!Object methodsFor: 'testing' stamp: 'sma 6/15/2000 15:48'!
isString
	"Overridden to return true in String, natch"
	^ false! !

!Object methodsFor: 'evaluating' stamp: 'MarianoMartinezPeck 8/24/2012 15:58'!
value

	^self! !

!Object methodsFor: '*Glamour-Helpers' stamp: ' 4/5/09 22:18'!
asGlamorousArray 
	 
	^Array with: self! !

!Object methodsFor: '*GT-Inspector' stamp: 'TudorGirba 12/28/2013 21:59'!
gtDisplayString
	"This offers a means to customize how the object is shown in the inspector.
	Do not override this method. Override gtDisplayOn: instead"
		
	| limitedString limit |
	limit := 1000.
	limitedString := String streamContents: [:s | self gtDisplayOn: s] limitedTo: limit.
	limitedString size < limit ifTrue: [^ limitedString].
	^ limitedString , ' ...'! !

!Object methodsFor: '*Spec-Inspector' stamp: 'MarcusDenker 9/28/2013 15:39'!
explore
	^Smalltalk tools inspector explore: self! !

!Object methodsFor: 'drag and drop' stamp: ''!
dragTransferTypeForMorph: dragSource 
	^nil! !

!Object methodsFor: 'flagging' stamp: 'jm 3/18/98 17:22'!
logExit

	Transcript show:  'Exited ', thisContext sender printString; cr.
! !

!Object methodsFor: 'tracing' stamp: 'StephaneDucasse 11/6/2011 23:58'!
trace
      self trace: self printString! !

!Object methodsFor: 'testing' stamp: 'MarcusDenker 4/9/2013 14:25'!
isNotNil
	"Coerces nil to false and everything else to true."

	^true! !

!Object methodsFor: 'copying' stamp: 'StephaneDucasse 2/20/2010 21:43'!
veryDeepInner: deepCopier
	"No special treatment for inst vars of my superclasses.  Override when some need to be weakly copied.  Object>>veryDeepCopyWith: will veryDeepCopy any inst var whose class does not actually define veryDeepInner:"

	"avoid to use me we will deprecate it in the future"! !

!Object methodsFor: 'nil testing' stamp: 'MarcusDenker 12/2/2013 14:14'!
ifNotNilDo: aBlock
	"Please use #ifNotNil: instead"

	^ aBlock value: self
! !

!Object methodsFor: 'binding' stamp: ''!
bindingOf: aString
	^nil! !

!Object methodsFor: 'logging-Deprecated' stamp: 'StephaneDucasse 11/5/2011 10:49'!
logCr
      self logCr: self printString! !

!Object methodsFor: 'converting' stamp: 'MarianoMartinezPeck 8/24/2012 15:58'!
asString
	"Answer a string that represents the receiver."

	^ self printString ! !

!Object methodsFor: '*GT-Inspector' stamp: 'AndreiChis 12/13/2014 11:00'!
gtInspectorMetaIn: composite
	"This presentation offers the methods of the class of the current object"
	<gtInspectorPresentationOrder: 1000>
	<gtInspectorTag: #basic>
	^ composite custom: (GTSimpleMethodsBrowser new startOn: self) ! !

!Object methodsFor: '*NativeBoost-core' stamp: 'IgorStasenko 11/22/2012 14:25'!
nbCalloutIn: aContext

	^ NBFFICalloutAPI inContext: aContext! !

!Object methodsFor: 'logging-Deprecated' stamp: 'StephaneDucasse 5/23/2011 22:09'!
logCr: aString
	"Log the argument. Use self logCr: 'something' instead of Transcript show: 'something'  ; cr "
	
	Transcript show: aString ; cr! !

!Object methodsFor: '*GT-Spotter' stamp: 'StefanReichhart 2/25/2015 15:41'!
spotterProcessorsFor: aSpotterStep
	
	^ ((Pragma 
		allNamed: #spotterOrder:
		from: self class 
		to: Object)
			sort: [ :first :second | (first argumentAt: 1) < (second argumentAt: 1) ])
			do: [ :pragma | self spotterProcessorsFor: aSpotterStep pragma: pragma ]! !

!Object methodsFor: '*Spec-Inspector' stamp: 'SeanDeNigris 1/23/2013 22:22'!
inspectOnce
	"Inspect unless we have already done it once."
	
	Halt isHaltOnceEnabled ifTrue: [
		Halt disableHaltOnce.
		^ self inspect ].! !

!Object methodsFor: '*Morphic-Base' stamp: 'nk 9/1/2004 10:41'!
currentHand
	"Return a usable HandMorph -- the one associated with the object's current environment.  This method will always return a hand, even if it has to conjure one up as a last resort.  If a particular hand is actually handling events at the moment (such as a remote hand or a ghost hand), it will be returned."

	^ActiveHand ifNil: [ self currentWorld primaryHand ]! !

!Object methodsFor: '*Ring-Core-Kernel' stamp: 'StephaneDucasse 7/16/2011 22:53'!
isRingObject

	^false! !

!Object methodsFor: 'testing' stamp: 'md 2/19/2006 11:24'!
isMethodProperties
	^false! !

!Object methodsFor: 'asserting' stamp: 'jannik.laval 5/2/2010 16:59'!
assert: aBlock descriptionBlock: descriptionBlock
	"Throw an assertion error if aBlock does not evaluate to true."
	
	aBlock value ifFalse: [AssertionFailure signal: descriptionBlock value asString ]! !

!Object methodsFor: 'testing' stamp: ''!
isInteger
	"Overridden to return true in Integer."

	^ false! !

!Object methodsFor: 'testing' stamp: 'len 1/13/98 21:18'!
isFraction
	"Answer true if the receiver is a Fraction."

	^ false! !

!Object methodsFor: 'testing' stamp: ''!
isColor
	"Answer true if receiver is a Color. False by default."

	^ false
! !

!Object methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 2/17/2015 12:33'!
brickValue: anObject withEnoughArguments: aCollection

	^ self! !

!Object methodsFor: 'testing' stamp: 'eem 5/23/2008 13:47'!
isClosure
	^false! !

!Object methodsFor: '*Morphic-Base' stamp: 'ar 3/18/2001 00:03'!
currentEvent
	"Answer the current Morphic event.  This method never returns nil."
	^ActiveEvent ifNil:[self currentHand lastEvent]! !

!Object methodsFor: '*Fuel' stamp: 'CamilloBruni 6/14/2013 09:59'!
serializeToFileNamed: aFilename
	^ FLSerializer serialize: self toFileNamed: aFilename! !

!Object methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 8/24/2012 15:58'!
name
	"Answer a name for the receiver.  This is used generically in the title of certain inspectors, such as the referred-to inspector, and specificially by various subsystems.  By default, we let the object just print itself out..  "

	^ self printString ! !

!Object methodsFor: '*metacello-core' stamp: 'dkh 6/21/2012 20:09'!
metacelloSemanticStringLessThanSelf: anInteger
    ^ self error: 'Invalid Metacello verson component - should be String or Integer.'! !

!Object methodsFor: '*rubric' stamp: 'AlainPlantec 4/18/2013 18:33'!
unplug
! !

!Object methodsFor: '*Tool-Finder' stamp: 'MarcusDenker 9/20/2011 10:19'!
closeTo: anObject
	"Do not use this Method!! It is a workaround for MethodFinder"

	^[self = anObject] ifError: [false]! !

!Object methodsFor: '*Shout-Parsing' stamp: 'SeanDeNigris 6/22/2012 18:24'!
shoutParser: anSHParserST80
	"Tools can define this method to customize the parser"! !

!Object methodsFor: 'introspection' stamp: ''!
instVarAt: anInteger put: anObject 
	"Primitive. Store a value into a fixed variable in the receiver. The 
	numbering of the variables corresponds to the named instance variables. 
	Fail if the index is not an Integer or is not the index of a fixed variable. 
	Answer the value stored as the result. Using this message violates the 
	principle that each object has sovereign control over the storing of 
	values into its instance variables. Essential. See Object documentation 
	whatIsAPrimitive."

	<primitive: 74>
	"Access beyond fixed fields"
	^self basicAt: anInteger - self class instSize put: anObject! !

!Object methodsFor: 'drag and drop' stamp: ''!
wantsDroppedMorph: aMorph event: anEvent inMorph: destinationLM 
	^false ! !

!Object methodsFor: 'testing' stamp: 'di 11/9/1998 09:38'!
isFloat
	"Overridden to return true in Float, natch"
	^ false! !

!Object methodsFor: 'introspection' stamp: 'eem 5/14/2008 13:20'!
instVarNamed: aString put: aValue
	"Store into the value of the instance variable in me of that name.  Slow and unclean, but very useful. "

	^self
		instVarAt: (self class
						instVarIndexFor: aString asString
						ifAbsent: [self error: 'no such inst var'])
		put: aValue
! !

!Object methodsFor: 'testing' stamp: 'MarcusDenker 10/17/2013 12:05'!
isClassOrTrait
	^ false! !

!Object methodsFor: 'dependencies' stamp: 'sma 2/29/2000 19:52'!
myDependents: aCollectionOrNil
	"Private. Set (or remove) the receiver's dependents list."

	aCollectionOrNil
		ifNil: [DependentsFields removeKey: self ifAbsent: []]
		ifNotNil: [DependentsFields at: self put: aCollectionOrNil]! !

!Object methodsFor: 'class membership' stamp: ''!
isMemberOf: aClass 
	"Answer whether the receiver is an instance of the class, aClass."

	^self class == aClass! !

!Object methodsFor: 'converting' stamp: 'MarcusDenker 7/20/2012 14:59'!
asStringOrText
	"Answer a string that represents the receiver."

	^ self asString ! !

!Object methodsFor: 'error handling' stamp: 'SvenVanCaekenberghe 4/20/2011 13:25'!
subclassResponsibility
	"This message sets up a framework for the behavior of the class' subclasses.
	Announce that the subclass should have implemented this message."

	SubclassResponsibility signalFor: thisContext sender selector! !

!Object methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 8/24/2012 15:29'!
at: index 
	"Primitive. Assumes receiver is indexable. Answer the value of an 
	indexable element in the receiver. Fail if the argument index is not an 
	Integer or is out of bounds. Essential. See Object documentation 
	whatIsAPrimitive. Read the class comment for a discussion about that the fact
	that the index can be a float."

	<primitive: 60>
	index isInteger ifTrue:
		[self class isVariable
			ifTrue: [self errorSubscriptBounds: index]
			ifFalse: [self errorNotIndexable]].
	index isNumber
		ifTrue: [^self at: index asInteger]
		ifFalse: [self errorNonIntegerIndex]! !

!Object methodsFor: 'introspection' stamp: 'MarcusDenker 6/26/2014 16:27'!
writeSlotNamed: aName value: anObject
	^(self class slotNamed: aName) write: anObject to: self! !

!Object methodsFor: '*NativeBoost-core' stamp: 'CamilloBruni 1/13/2013 18:20'!
nbLibraryNameOrHandle
	self flag: 'HACK: avoid direct subclassResponsibility to not break RB test cases..'.
	^ SubclassResponsibility signalFor: thisContext selector
! !

!Object methodsFor: 'converting' stamp: ''!
as: aSimilarClass
	"Create an object of class aSimilarClass that has similar contents to the receiver."

	^ aSimilarClass newFrom: self! !

!Object methodsFor: 'error handling' stamp: 'MarcusDenker 5/24/2012 10:37'!
notYetImplemented
	"Announce that this message is not yet implemented"

	NotYetImplemented signalFor: thisContext sender selector! !

!Object methodsFor: '*Morphic-Core' stamp: 'JuanVuletich 11/1/2010 15:18'!
currentWorld
	"Answer a morphic world that is the current UI focus."
	^UIManager default currentWorld! !

!Object methodsFor: '*GT-Inspector' stamp: 'AndreiChis 1/14/2015 15:34'!
gtInspectorExampleSourceIn: composite inContext: aGTInspector
	<gtInspectorPresentationOrder: 900>
	<gtInspectorTag: #examples>
	
	| previousRawSelection |
	(aGTInspector panes size > 1) 
		ifFalse: [ ^ self ].	
	previousRawSelection := (aGTInspector panes reversed second port: #rawSelection) value.
	((previousRawSelection isGTExample) "and: [
		aGTInspector first lastActivePresentation pane ~= aGTInspector panes reversed second ]")
			ifTrue: [ 
				(previousRawSelection gtDisplaySourceIn: composite) 
					title: 'E.g. source' ]! !

!Object methodsFor: 'events-registering' stamp: 'gvc 10/24/2006 11:49'!
when: anEventSelector
sendOnce: aMessageSelector
to: anObject
withArguments: anArgArray
 
    self
        when: anEventSelector
        evaluate: (NonReentrantWeakMessageSend
            receiver: anObject
            selector: aMessageSelector
		arguments: anArgArray)! !

!Object methodsFor: '*Spec-Tools' stamp: 'BenjaminVanRyseghem 10/3/2012 13:57'!
displaySubObjectAt: index

	^ self class allInstVarNames at: index! !

!Object methodsFor: 'comparing' stamp: 'MarianoMartinezPeck 8/24/2012 15:58'!
hash
	"Answer a SmallInteger whose value is related to the receiver's identity.
	May be overridden, and should be overridden in any classes that define = "

	^ self identityHash ! !

!Object methodsFor: 'updating' stamp: ''!
update: aParameter 
	"Receive a change notice from an object of whom the receiver is a 
	dependent. The default behavior is to do nothing; a subclass might want 
	to change itself in some way."

	^ self! !

!Object methodsFor: 'message performing' stamp: 'nk 4/11/2002 14:13'!
perform: selector withEnoughArguments: anArray
	"Send the selector, aSymbol, to the receiver with arguments in argArray.
	Only use enough arguments for the arity of the selector; supply nils for missing ones."
	| numArgs args |
	numArgs := selector numArgs.
	anArray size == numArgs
		ifTrue: [ ^self perform: selector withArguments: anArray asArray ].

	args := Array new: numArgs.
	args replaceFrom: 1
		to: (anArray size min: args size)
		with: anArray
		startingAt: 1.

	^ self perform: selector withArguments: args! !

!Object methodsFor: 'flagging' stamp: 'jm 3/18/98 17:23'!
logExecution

	Transcript show: 'Executing ', thisContext sender printString; cr.
! !

!Object methodsFor: 'copying' stamp: 'MarcusDenker 9/27/2010 15:28'!
copy
	"Answer another instance just like the receiver. Subclasses typically override postCopy; they typically do not override shallowCopy. Copy is a template method in the sense of Design Patterns. So do not override it. Override postCopy instead. Pay attention that normally you should call postCopy of your superclass too."

	^self shallowCopy postCopy! !

!Object methodsFor: '*Morphic-Base' stamp: 'BenjaminVanRyseghem 10/7/2011 21:36'!
dragPassengersFor: item inMorph: dragSource 

	^ { item }! !

!Object methodsFor: '*Kernel-Exceptions-debugging' stamp: 'BenComan 1/28/2015 00:21'!
haltOnce
	<debuggerCompleteToSender>
	Halt once.! !

!Object methodsFor: '*Spec-Inspector' stamp: 'MarcusDenker 9/28/2013 15:49'!
inspect
	"Create and schedule an Inspector in which the user can examine the receiver's variables."
	^ Smalltalk tools inspector inspect: self! !

!Object methodsFor: 'user interface' stamp: 'RAA 8/2/1999 12:41'!
complexContents

	^self! !

!Object methodsFor: 'evaluating' stamp: 'ajh 1/21/2003 12:59'!
in: aBlock
	"Evaluate the given block with the receiver as its argument."

	^ aBlock value: self
! !

!Object methodsFor: 'testing' stamp: 'ar 10/30/2000 23:22'!
isForm
	^false! !

!Object methodsFor: 'stepping' stamp: 'di 1/8/1999 15:04'!
wantsSteps
	"Overridden by morphic classes whose instances want to be stepped,
	or by model classes who want their morphic views to be stepped."

	^ false! !

!Object methodsFor: '*Morphic-Base' stamp: 'BenjaminVanRyseghem 2/7/2014 15:19'!
asAlphaImageMorph

	^ self asMorph! !

!Object methodsFor: 'finalization' stamp: 'ar 3/20/98 22:19'!
executor
	"Return an object which can act as executor for finalization of the receiver"
	^self shallowCopy actAsExecutor! !

!Object methodsFor: '*Collections-Abstract-splitjoin' stamp: 'onierstrasz 4/10/2009 22:50'!
join: aSequenceableCollection
	^ (Array with: self) join: aSequenceableCollection! !

!Object methodsFor: '*GT-Inspector' stamp: 'AndreiChis 12/13/2014 11:00'!
gtInspectorRawIn: composite
	"This is the most basic presentation showing the state of the object"
	<gtInspectorPresentationOrder: 10>
	<gtInspectorTag: #basic>
	^ composite custom: GTObjectVariablesBrowser new! !

!Object methodsFor: 'self evaluating' stamp: 'sd 7/31/2005 21:47'!
isSelfEvaluating
	^ self isLiteral! !

!Object methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/10/2007 11:41'!
okToClose
	"Sent to models when a window closing.
	Allows this check to be independent of okToChange."
	
	^true! !

!Object methodsFor: '*Collections-Abstract-splitjoin' stamp: 'onierstrasz 4/12/2009 19:58'!
appendTo: aCollection
	"double dispatch for join:"
	^ aCollection addLast: self! !

!Object class methodsFor: '*System-FileRegistry' stamp: 'CamilloBruni 2/3/2013 17:21'!
fileReaderServicesForFile: fullName suffix: suffix
	<fileService>
	"Backstop"
	^#()! !

!Object class methodsFor: '*Polymorph-TaskbarIcons' stamp: ''!
taskbarIcon
	"Answer the icon for an instance of the receiver in a task bar
	or nil for the default."

	^nil ! !

!Object class methodsFor: 'class initialization' stamp: 'rw 2/10/2002 13:09'!
flushEvents
	"Object flushEvents"

	EventManager flushEvents. ! !

!Object class methodsFor: 'instance creation' stamp: 'MarcusDenker 5/2/2013 11:24'!
readFrom: textStringOrStream
	"Create an object based on the contents of textStringOrStream."

	| object |
	object := self class compiler evaluate: textStringOrStream.
	(object isKindOf: self) ifFalse: [self error: self name, ' expected'].
	^object! !

!Object class methodsFor: 'class initialization' stamp: 'ar 2/11/2001 01:41'!
initializeDependentsFields
	"Object initialize"
	DependentsFields := WeakIdentityKeyDictionary new.
! !

!Object class methodsFor: '*Tools-Debugger' stamp: 'SeanDeNigris 5/28/2013 17:57'!
canonicalArgumentName

	| prefix |
	prefix := self name first isVowel
		ifTrue: [ 'an' ]
		ifFalse: [ 'a' ].
	^ prefix, self name.! !

!Object class methodsFor: 'documentation' stamp: 'MarcusDenker 6/9/2014 16:41'!
howToModifyPrimitives
	"You are allowed to write methods which specify primitives, but please use 
	caution.  If you make a subclass of a class which contains a primitive method, 
	the subclass inherits the primitive.  The message which is implemented 
	primitively may be overridden in the subclass (E.g., see at:put: in String's 
	subclass Symbol).  The primitive behavior can be invoked using super (see 
	Symbol string:). 
	 
	A class which attempts to mimic the behavior of another class without being 
	its subclass may or may not be able to use the primitives of the original class.  
	In general, if the instance variables read or written by a primitive have the 
	same meanings and are in the same fields in both classes, the primitive will 
	work.  

	For certain frequently used 'special selectors', the compiler emits a 
	send-special-selector bytecode instead of a send-message bytecode.  
	Special selectors were created because they offer two advantages.  Code 
	which sends special selectors compiles into fewer bytes than normal.  For 
	some pairs of receiver classes and special selectors, the interpreter jumps 
	directly to a primitive routine without looking up the method in the class.  
	This is much faster than a normal message lookup. 
	 
	A selector which is a special selector solely in order to save space has a 
	normal behavior.  Methods whose selectors are special in order to 
	gain speed contain the comment, 'No Lookup'.  When the interpreter 
	encounters a send-special-selector bytecode, it checks the class of the 
	receiver and the selector.  If the class-selector pair is a no-lookup pair, 
	then the interpreter swiftly jumps to the routine which implements the 
	corresponding primitive.  (A special selector whose receiver is not of the 
	right class to make a no-lookup pair, is looked up normally).  The pairs are 
	listed below.  No-lookup methods contain a primitive number specification, 
	<primitive: xx>, which is redundant.  Since the method is not normally looked 
	up, deleting the primitive number specification cannot prevent this 
	primitive from running.  If a no-lookup primitive fails, the method is looked 
	up normally, and the expressions in it are executed. 
	 
	No Lookup pairs of (class, selector) 
	 
	SmallInteger with any of		+ - * /  \\  bitOr: bitShift: bitAnd:  // 
	SmallInteger with any of		=  ~=  >  <  >=  <= 
	Any class with					== 
	Any class with 					@ 
	Point with either of				x y 
	Context with					blockCopy: 
	BlockContext with either of 		value value:
	"

	self error: 'comment only'! !

!Object class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:05'!
gtExampleBasic
	<gtExample>
	^ self new! !

!Object class methodsFor: 'documentation' stamp: ''!
whatIsAPrimitive
	"Some messages in the system are responded to primitively. A primitive   
	response is performed directly by the interpreter rather than by evaluating   
	expressions in a method. The methods for these messages indicate the   
	presence of a primitive response by including <primitive: xx> before the   
	first expression in the method.   
	  
	Primitives exist for several reasons. Certain basic or 'primitive' 
	operations cannot be performed in any other way. Smalltalk without 
	primitives can move values from one variable to another, but cannot add two 
	SmallIntegers together. Many methods for arithmetic and comparison 
	between numbers are primitives. Some primitives allow Smalltalk to 
	communicate with I/O devices such as the disk, the display, and the keyboard. 
	Some primitives exist only to make the system run faster; each does the same 
	thing as a certain Smalltalk method, and its implementation as a primitive is 
	optional.  
	  
	When the Smalltalk interpreter begins to execute a method which specifies a 
	primitive response, it tries to perform the primitive action and to return a 
	result. If the routine in the interpreter for this primitive is successful, 
	it will return a value and the expressions in the method will not be evaluated. 
	If the primitive routine is not successful, the primitive 'fails', and the 
	Smalltalk expressions in the method are executed instead. These 
	expressions are evaluated as though the primitive routine had not been 
	called.  
	  
	The Smalltalk code that is evaluated when a primitive fails usually 
	anticipates why that primitive might fail. If the primitive is optional, the 
	expressions in the method do exactly what the primitive would have done (See 
	Number @). If the primitive only works on certain classes of arguments, the 
	Smalltalk code tries to coerce the argument or appeals to a superclass to find 
	a more general way of doing the operation (see SmallInteger +). If the 
	primitive is never supposed to fail, the expressions signal an error (see 
	SmallInteger asFloat).  
	  
	Each method that specifies a primitive has a comment in it. If the primitive is 
	optional, the comment will say 'Optional'. An optional primitive that is not 
	implemented always fails, and the Smalltalk expressions do the work 
	instead.  
	 
	If a primitive is not optional, the comment will say, 'Essential'. Some 
	methods will have the comment, 'No Lookup'. See Object 
	howToModifyPrimitives for an explanation of special selectors which are 
	not looked up.  
	  
	For the primitives for +, -, *, and bitShift: in SmallInteger, and truncated 
	in Float, the primitive constructs and returns a 16-bit 
	LargePositiveInteger when the result warrants it. Returning 16-bit 
	LargePositiveIntegers from these primitives instead of failing is 
	optional in the same sense that the LargePositiveInteger arithmetic 
	primitives are optional. The comments in the SmallInteger primitives say, 
	'Fails if result is not a SmallInteger', even though the implementor has the 
	option to construct a LargePositiveInteger. For further information on 
	primitives, see the 'Primitive Methods' part of the chapter on the formal 
	specification of the interpreter in the Smalltalk book."

	self error: 'comment only'! !

!Object class methodsFor: '*Tools-FileList' stamp: 'md 2/15/2006 17:20'!
services
	"Backstop"
	^#()! !

!Object class methodsFor: 'class initialization' stamp: 'MarianoMartinezPeck 8/24/2012 15:31'!
initialize
	"Object initialize"
	DependentsFields ifNil:[self initializeDependentsFields].! !

!Object class methodsFor: 'instance creation' stamp: 'StephaneDucasse 2/20/2010 21:38'!
newFrom: aSimilarObject
	"Create an object that has similar contents to aSimilarObject. If the classes have any instance varaibles with the same names, copy them across. If this is bad for a class, override this method."

	^ (self isVariable
		ifTrue: [self basicNew: aSimilarObject basicSize]
		ifFalse: [self basicNew]) copySameFrom: aSimilarObject! !

!Object class methodsFor: '*System-Support' stamp: 'MarianoMartinezPeck 8/24/2012 15:58'!
registerToolsOn: aToolRegistry

	" Override to register any tools for Smalltalk tools registry. " ! !

!Object class methodsFor: 'class initialization' stamp: 'ar 2/11/2001 01:45'!
reInitializeDependentsFields
	"Object reInitializeDependentsFields"
	| oldFields |
	oldFields := DependentsFields.
	DependentsFields := WeakIdentityKeyDictionary new.
	oldFields keysAndValuesDo:[:obj :deps|
		deps do:[:d| obj addDependent: d]].
! !

!Object class methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
lastMetacelloVersionLoad
	"Answer the last version loaded and the list of packages loaded for that version.
	 See MetacelloConfigTemplate."

	^nil -> 'default'! !

!Object class methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
metacelloVersion: versionString loads: anArrayOrString
	"Stash the last version loaded and the list of packages loaded for that version. The list
	 of packages will be used by the tools when doing 'Load Package Version'.
	See MetacelloConfigTemplate for example"
	
	"noop by default"! !

!Object class methodsFor: '*System-FileRegistry' stamp: 'CamilloBruni 2/3/2013 17:27'!
fileReaderServicesForDirectory: aFileDirectory
	<directoryService>
	"Backstop"
	^#()! !

!Object class methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/31/2009 15:53'!
taskbarLabel
	"Answer the label string for the receiver in a task bar
	or nil for the default."

	^nil! !

!Object class methodsFor: 'class initialization' stamp: 'ar 2/11/2001 02:00'!
flushDependents
	DependentsFields keysAndValuesDo:[:key :dep|
		key ifNotNil:[key removeDependent: nil].
	].
	DependentsFields finalizeValues.! !

!Object class methodsFor: '*NewValueHolder' stamp: 'BenjaminVanRyseghem 1/24/2014 18:46'!
selectionReactiveVariable
	"See NewValueHolder class comment"

	^  SelectionValueHolder new! !

!ObjectFinalizer commentStamp: 'jcg 4/27/2010 01:01'!
Represents an action that is to be taken when a target object (not referenced by the ObjectFinalizer) is garbage-collected.!
!ObjectFinalizer methodsFor: 'finalization' stamp: 'IgorStasenko 8/17/2011 15:43'!
finalize
	"Finalize the resource associated with the receiver. This message should only be sent during the finalization process. There is NO garantuee that the resource associated with the receiver hasn't been free'd before so take care that you don't run into trouble - this all may happen with interrupt priority."
	self value! !

!ObjectFinalizer methodsFor: 'initialize' stamp: 'jcg 1/15/2010 01:36'!
receiver: anObject selector: aSymbol argument: aParameter
	"Not really necessary now that we're a subclass of MessageSend, but we keep it around because existing code might expect it."
	self 
		receiver: anObject;
		selector: aSymbol;
		arguments: (Array with: aParameter).! !

!ObjectFinalizerCollection commentStamp: 'ul 2/26/2010 14:23'!
An ObjectFinalizerCollection is simple collection which is intended to hold ObjectFinalizers and be used by WeakRegistry.!
!ObjectFinalizerCollection methodsFor: 'finalization' stamp: 'ul 2/25/2010 16:53'!
finalize
	"Finalize all elements in this collection. The elements are expected to be ObjectFinalizers, but can be any object which understands #finalize."

	self do: #finalize! !

!ObjectFinalizerCollection methodsFor: 'testing' stamp: 'Igor.Stasenko 5/25/2010 04:58'!
hasMultipleExecutors
	^ true! !

!ObjectFinalizerTests methodsFor: 'tests' stamp: 'HenrikSperreJohansen 3/30/2010 15:48'!
testFinalizationOfMultipleResources
	"Test that finalizers for multiple resources registered will be ran when
	object is finalized"
	| objToFinalize resource1 resource2 resourceCleanBlock |
	objToFinalize := Object new.
	resource1 := Array with: false.
	resource2 := Array with: false.
	resourceCleanBlock := [:array | array at: 1 put: true].
	objToFinalize
		toFinalizeSend: #value:
		to: resourceCleanBlock
		with: resource1.
	objToFinalize
		toFinalizeSend: #value:
		to: resourceCleanBlock
		with: resource2.
	self deny: resource1 first.
	self deny: resource2 first.
	"Trigger finalization"
	objToFinalize := nil.
	Smalltalk garbageCollect.
	self assert: resource1 first.
	self assert: resource2 first! !

!ObjectLayout commentStamp: '<historical>'!
I am the superclass of standard layouts for Objects.!
!ObjectLayout methodsFor: 'comparing' stamp: 'MartinDias 4/12/2013 13:27'!
hash
	^ super hash bitXor: self compactClassIndex! !

!ObjectLayout methodsFor: 'extending' stamp: 'MartinDias 7/24/2013 13:21'!
extendByte
	self hasFields ifTrue: [
		IncompatibleLayoutConflict new
			layout: self;
			subType: #byte;
			signal ].
	^ ByteLayout new! !

!ObjectLayout methodsFor: 'initialize-release' stamp: 'ToonVerwaest 4/1/2011 01:53'!
initializeInstance: anInstance
	self subclassResponsibility! !

!ObjectLayout methodsFor: 'accessing' stamp: 'MartinDias 3/28/2013 12:00'!
compactClassIndex
	^ compactClassIndex! !

!ObjectLayout methodsFor: 'reshaping' stamp: 'MartinDias 8/28/2013 15:48'!
reshapeFrom: oldScope to: newParentLayout
	"Answer the reshaped version of me for a new parent layout."

	| newScope |
	newScope := self slotScope 
		rebase: oldScope 
		to: newParentLayout slotScope.
	^ newParentLayout extendAgain: self with: newScope.! !

!ObjectLayout methodsFor: 'extending' stamp: 'MartinDias 7/24/2013 13:21'!
extendCompiledMethod
	self hasFields ifTrue: [
		IncompatibleLayoutConflict new
			layout: self;
			subType: #compiledMethod;
			signal ].
	^ CompiledMethodLayout new! !

!ObjectLayout methodsFor: 'extending' stamp: 'MartinDias 7/24/2013 13:21'!
extendVariable: aScope
	IncompatibleLayoutConflict new
		layout: self;
		subType: #variable;
		signal! !

!ObjectLayout methodsFor: 'initialization' stamp: 'ToonVerwaest 4/1/2011 01:34'!
initialize
	compactClassIndex := 0! !

!ObjectLayout methodsFor: 'comparing' stamp: 'MartinDias 4/12/2013 13:27'!
= other
	^ super = other
		ifFalse: [ false ]
		ifTrue: [ self compactClassIndex = other compactClassIndex ]! !

!ObjectLayout methodsFor: 'extending' stamp: 'MartinDias 7/24/2013 13:21'!
extend: aScope
	IncompatibleLayoutConflict new
		layout: self;
		subType: #slot;
		signal! !

!ObjectLayout methodsFor: 'accessing' stamp: 'ToonVerwaest 4/1/2011 01:35'!
compactClassIndex: anIndex
	compactClassIndex := anIndex.
	host setFormat: self format! !

!ObjectLayout methodsFor: 'extending' stamp: 'MartinDias 9/5/2013 15:49'!
extend
	"Answer a default extension of me."

	^ self subclassResponsibility! !

!ObjectLayout methodsFor: 'extending' stamp: 'MartinDias 7/24/2013 13:21'!
extendWord
	self hasFields ifTrue: [
		IncompatibleLayoutConflict new
			layout: self;
			subType: #word;
			signal ].
	^ WordLayout new! !

!ObjectLayout methodsFor: 'format' stamp: 'MartinDias 7/3/2013 18:00'!
format
	"Answer an Integer that encodes this layout in the way that VM expects it."
	
	| fieldSize sizeHiBits format |
	fieldSize := self fieldSize + 1.
	sizeHiBits := fieldSize // 64.
	format := sizeHiBits.
	format := (format bitShift: 5) + compactClassIndex.
	format := (format bitShift: 4) + self instanceSpecification.
	format := (format bitShift: 6) + (fieldSize \\ 64).
	format := (format bitShift: 1).
	^ format! !

!ObjectLayout methodsFor: 'reshaping' stamp: 'CamilloBruni 7/17/2013 13:42'!
reshapeTo: aModification
	^ self class 
		extending: aModification layout
		scope: LayoutEmptyScope instance
		host: self host! !

!ObjectLayout methodsFor: 'diff' stamp: 'ToonVerwaest 4/1/2011 02:22'!
computeChangesFrom: other in: modification
	other hasSlots ifTrue: [
		modification removals: other allSlots asArray ]! !

!ObjectLayout methodsFor: 'extending' stamp: 'MarcusDenker 11/20/2014 16:58'!
extendSmallInteger
	self hasFields ifTrue: [
		IncompatibleLayoutConflict new
			layout: self;
			subType: #compiledMethod;
			signal ].
	^ SmallIntegerLayout new! !

!ObjectLayout class methodsFor: 'instance creation' stamp: 'MartinDias 7/11/2013 16:01'!
extending: superLayout scope: aScope host: aClass
	self subclassResponsibility! !

!ObjectStringConverter commentStamp: 'GaryChambers 3/9/2011 13:37'!
Generic object<->string converter for use with PluggableTextFieldMorph.
Optional regex matching for validation.
Optional transform blocks for each conversion direction.!
!ObjectStringConverter methodsFor: 'conversion' stamp: 'GaryChambers 3/9/2011 13:41'!
configureForIntegers
	"Configure the receiver to match/convert positive or negative integers only."

	self
		objectClass: Integer;
		regexString: '[-]?[0-9]+';
		stringTransformBlock: [:s |
			(s beginsWith: '-')
				ifTrue: ['-', (s select: [:c | c isDigit])]
				ifFalse: [s select: [:c | c isDigit]]]! !

!ObjectStringConverter methodsFor: 'accessing' stamp: 'gvc 7/30/2009 14:09'!
objectClass: aClass
	"Set the class of object we are dealing with."

	objectClass := aClass! !

!ObjectStringConverter methodsFor: 'conversion' stamp: 'GaryChambers 4/18/2012 18:05'!
objectAsString: anObject
	"Answer the given object in string form."

	^(self objectTransformBlock value: anObject)
		ifNotNil: [:o | o asString]! !

!ObjectStringConverter methodsFor: 'accessing' stamp: 'GaryChambers 3/8/2011 11:41'!
regex

	^ regex! !

!ObjectStringConverter methodsFor: 'accessing' stamp: 'GaryChambers 3/8/2011 11:41'!
regex: anObject

	regex := anObject! !

!ObjectStringConverter methodsFor: 'accessing' stamp: 'GaryChambers 3/9/2011 13:31'!
objectTransformBlock: anObject

	objectTransformBlock := anObject! !

!ObjectStringConverter methodsFor: 'accessing' stamp: 'gvc 9/18/2006 12:10'!
objectClass
	"Answer the class of object we are dealing with."

	^objectClass! !

!ObjectStringConverter methodsFor: 'accessing' stamp: 'GaryChambers 3/8/2011 11:49'!
regexString: aString
	"Setup the regex based on the given string."

	self regex: aString asRegex! !

!ObjectStringConverter methodsFor: 'conversion' stamp: 'GaryChambers 4/18/2012 18:09'!
stringAsObject: aString
	"Answer the given string in object form."

	|transformed|
	transformed := self stringTransformBlock value: aString.
	^(transformed notNil and: [self needsConversion])
		ifTrue: [self objectClass readFromString: transformed]
		ifFalse: [transformed]! !

!ObjectStringConverter methodsFor: 'initialization' stamp: 'GaryChambers 3/9/2011 13:33'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		objectTransformBlock: [:obj | obj];
		stringTransformBlock: [:string | string]! !

!ObjectStringConverter methodsFor: 'accessing' stamp: 'GaryChambers 3/9/2011 13:31'!
objectTransformBlock

	^ objectTransformBlock! !

!ObjectStringConverter methodsFor: 'conversion' stamp: 'GaryChambers 3/9/2011 13:42'!
configureForPositiveIntegers
	"Configure the receiver to match/convert positive integers only."

	self
		objectClass: Integer;
		regexString: '[0-9]+';
		stringTransformBlock: [:s |
			s select: [:c | c isDigit]]! !

!ObjectStringConverter methodsFor: 'conversion' stamp: 'GaryChambers 3/8/2011 12:42'!
needsConversion
	"Answer whether conversion is required for the receiver's object class."

	^self objectClass notNil and: [(self objectClass includesBehavior: String) not]! !

!ObjectStringConverter methodsFor: 'accessing' stamp: 'GaryChambers 3/9/2011 13:31'!
stringTransformBlock: anObject

	stringTransformBlock := anObject! !

!ObjectStringConverter methodsFor: 'accessing' stamp: 'GaryChambers 3/9/2011 13:31'!
stringTransformBlock

	^ stringTransformBlock! !

!ObjectStringConverter methodsFor: 'conversion' stamp: 'GaryChambers 3/8/2011 12:34'!
isStringValid: aString
	"Answer whether the given string is valid for conversion."

	^(self regex isNil or: [self regex matches: aString]) and: [
		[self stringAsObject: aString. true] on: Error do: [false]]! !

!ObjectStringConverter class methodsFor: 'as yet unclassified' stamp: 'gvc 9/18/2006 12:11'!
forClass: aClass
	"Answer a new instance of the receiver that converts to and from
	the given class of object and a string."

	^self new objectClass: aClass! !

!ObjectTest commentStamp: 'TorstenBergmann 2/5/2014 08:41'!
SUnit tests for objects!
!ObjectTest methodsFor: 'tests' stamp: 'md 11/26/2004 16:36'!
testBecomeForward
	"self debug: #testBecomeForward"
	"this test should that all the variables pointing to an object are pointing now to another one.
	Not that this inverse is not true. This kind of become is called oneWayBecome in VW"

	| pt1 pt2 pt3 |
	pt1 := 0@0.
	pt2 := pt1.
	pt3 := 100@100.
	pt1 becomeForward: pt3.
	self assert: pt2 = (100@100).
	self assert: pt3 == pt2.
	self assert: pt1 = (100@100)! !

!ObjectTest methodsFor: 'tests - debugging' stamp: 'SeanDeNigris 8/29/2011 18:04'!
testHaltIf

	self shouldHaltWhen: [self haltIf: true].
	self shouldntHaltWhen: [self haltIf: false].

	self shouldHaltWhen: [self haltIf: [true]].
	self shouldntHaltWhen: [self haltIf: [false]].

	self shouldHaltWhen: [self haltIf: #testHaltIf].
	self shouldntHaltWhen: [self haltIf: #teadfasdfltIf].

	self shouldHaltWhen: [self a].
	self shouldntHaltWhen: [self a1].

	self shouldHaltWhen: [self haltIf: [:receiver | receiver class = self class]].
	self shouldntHaltWhen: [self haltIf: [:receiver | receiver class ~= self class]].! !

!ObjectTest methodsFor: 'tests - introspection' stamp: 'MarcusDenker 6/26/2014 16:27'!
testWriteSlotNamedValue
	| object |
	object := 5@6.
	
	self assert: (object writeSlotNamed: #x value: 7) = 7.
	self assert: object = (7@6).! !

!ObjectTest methodsFor: 'private' stamp: 'md 10/15/2004 13:46'!
a1
	self b1.! !

!ObjectTest methodsFor: 'tests - introspection' stamp: 'MarcusDenker 6/26/2014 16:21'!
testReadSlotNamed
	self assert: (5@3 readSlotNamed: #x) = 5! !

!ObjectTest methodsFor: 'private' stamp: 'md 10/15/2004 13:46'!
b1
	self haltIf: #testasdasdfHaltIf.! !

!ObjectTest methodsFor: 'private' stamp: 'md 10/15/2004 13:45'!
b
	self haltIf: #testHaltIf.! !

!ObjectTest methodsFor: 'tests' stamp: 'md 11/26/2004 16:37'!
testBecome
	"self debug: #testBecome"
	"this test should that all the variables pointing to an object are pointing now to another one, and all
      object pointing to the other are pointing to the object"

	| pt1 pt2 pt3 |
	pt1 := 0@0.
	pt2 := pt1.
	pt3 := 100@100.

	pt1 become: pt3.
	self assert: pt2 = (100@100).
	self assert: pt3 = (0@0).
	self assert: pt1 = (100@100).! !

!ObjectTest methodsFor: 'tests - introspection' stamp: 'MarcusDenker 6/26/2014 16:30'!
testWriteToSlotOf
	| object |
	object := 5@6.
	
	self assert: (7 writeToSlot: (Point slotNamed: #x) of: object) = 7.
	self assert: object = (7@6).! !

!ObjectTest methodsFor: 'tests - debugging' stamp: 'CamilloBruni 8/31/2013 20:23'!
testHaltOnce
	| anObject |
	anObject := Object new.
	Halt enableHaltOnce.
	self should: [ anObject haltOnce ] raise: Halt.
	Halt disableHaltOnce.
	anObject haltOnce! !

!ObjectTest methodsFor: 'assertions-halt' stamp: 'SeanDeNigris 8/28/2011 17:18'!
shouldntHaltWhen: aBlock

	self shouldnt: aBlock raise: Halt.! !

!ObjectTest methodsFor: 'assertions-halt' stamp: 'SeanDeNigris 8/28/2011 17:22'!
shouldHaltAfter: aNumber times: aBlock
	
	self shouldHaltWhen: [ aNumber timesRepeat: aBlock ].! !

!ObjectTest methodsFor: 'assertions-halt' stamp: 'SeanDeNigris 8/28/2011 17:18'!
shouldHaltWhen: aBlock

	self should: aBlock raise: Halt.! !

!ObjectTest methodsFor: 'private' stamp: 'md 10/15/2004 13:45'!
a
	self b.! !

!ObjectTest methodsFor: 'tests - introspection' stamp: 'MarcusDenker 6/26/2014 16:20'!
testReadSlot
	self assert: (5@3 readSlot: (Point slotNamed: #x)) = 5! !

!ObjectTest methodsFor: 'assertions-halt' stamp: 'SeanDeNigris 8/28/2011 17:23'!
shouldntHaltAfter: aNumber times: aBlock
	
	self shouldntHaltWhen: [ aNumber timesRepeat: aBlock ].! !

!ObjectTest methodsFor: 'tests - debugging' stamp: 'SeanDeNigris 8/29/2011 18:05'!
testHaltOnCount

	| anObject |
	anObject := Object new.
	
	"Halts regardless of whether HaltOnce is false for the image"
	Halt disableHaltOnce.
	self shouldHaltWhen: [ anObject haltOnCount: 1 ].

	"Should halt if executed enough times"	
	self shouldHaltAfter: 2 times: [ anObject haltOnCount: 2 ].
	
	"Should not halt if not executed enough times"	
	self shouldntHaltAfter: 2 times: [ anObject haltOnCount: 3 ].
	Halt stopCounting.

	"Should ignore new count given while previous count is in progress"
	anObject haltOnCount: 2.
	self shouldHaltWhen: [ anObject haltOnCount: 5 ].! !

!ObjectTest methodsFor: 'tests - introspection' stamp: 'MarcusDenker 6/26/2014 16:26'!
testWriteSlotValue
	| object |
	object := 5@6.
	
	self assert: (object writeSlot: (Point slotNamed: #x) value: 7) = 7.
	self assert: object = (7@6).! !

!ObjectsAsMethodsExample methodsFor: 'as yet unclassified' stamp: 'ar 5/17/2003 20:16'!
answer42
	^42! !

!ObjectsAsMethodsExample methodsFor: 'as yet unclassified' stamp: 'md 3/1/2006 19:37'!
run: oldSelector with: arguments in: aReceiver
	^self perform: oldSelector withArguments: arguments! !

!ObjectsAsMethodsExample methodsFor: 'as yet unclassified' stamp: 'ar 5/17/2003 20:16'!
add: a with: b
	^a + b! !

!ObsoleteTest commentStamp: 'SteveFreeman 7/17/2010 11:31'!
Example class for ClassTest!
!ObsoleteTest methodsFor: 'tests' stamp: 'MarcusDenker 3/21/2015 09:55'!
testTraitObsolete
	| aClass obj aTrait |
	self skip.
	Smalltalk globals at: #ClassForObsoleteTest ifPresent: [ :cls | cls removeFromSystem ].
	Smalltalk globals at: #TraitForObsoleteTest ifPresent: [ :tr | tr removeFromSystem ].
	
	aTrait := Trait named: #TraitForObsoleteTest.
	aClass := Object subclass: #ClassForObsoleteTest uses: {aTrait}.

	obj := aClass new.
	self deny: aTrait isObsolete.
	aTrait removeFromSystem.
	self assert: aTrait isObsolete.
	self deny: aClass isObsolete.
	
	Smalltalk globals at: #ClassForObsoleteTest ifPresent: [ :cls | cls removeFromSystem ].
	Smalltalk globals at: #TraitForObsoleteTest ifPresent: [ :tr | tr removeFromSystem ].
! !

!ObsoleteTest methodsFor: 'tests' stamp: 'MarcusDenker 3/21/2015 09:55'!
testClassObsolete
	| aClass obj |
	self skip.
	Smalltalk globals at: #ClassForObsoleteTest ifPresent: [ :cls | cls removeFromSystem ].
	aClass := Object subclass: #ClassForObsoleteTest.
	obj := aClass new.
	self deny: aClass isObsolete.
	self deny: aClass class isObsolete.
	aClass removeFromSystem.
	self assert: aClass isObsolete.
	self assert: aClass class isObsolete! !

!ObsoleteTest methodsFor: 'tests' stamp: 'MarcusDenker 3/21/2015 12:42'!
testFixObsoleteSharedPools
	| poolClass obsoletePoolName testClass preFixObsoleteClassNames postFixObsoleteClassNames |
	self skip.
	poolClass := classFactory newClass. "provides unique name over time via class variable counter"
	testClass := classFactory  
		newSubclassOf: classFactory defaultSuperclass 
		uses: { }
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: poolClass name asString
		category: classFactory defaultCategory.		
	classFactory deleteClass: poolClass.
	obsoletePoolName := poolClass name. 
	poolClass := nil.
	3 timesRepeat: [ Smalltalk garbageCollect ].
	
	preFixObsoleteClassNames := SystemNavigation default obsoleteClasses collect: #name.
	self assert: (preFixObsoleteClassNames includes: obsoletePoolName).
	self assert: testClass sharedPoolNames size equals: 1.
	self assert: (testClass sharedPoolNames includes: obsoletePoolName ).
	self assert: (testClass sharedPoolsString beginsWith: 'AnObsolete').
	
	Smalltalk fixObsoleteSharedPools.
	
	postFixObsoleteClassNames := SystemNavigation default obsoleteClasses collect: #name.
	self deny: (postFixObsoleteClassNames includes: obsoletePoolName).
	self assert: testClass sharedPoolNames isEmpty.
	self assert: testClass sharedPoolsString isEmpty! !

!ObsoleteTest methodsFor: 'running' stamp: 'MaxLeske 9/30/2014 19:58'!
setUp
	super setUp.
	classFactory := ClassFactoryForTestCase new! !

!ObsoleteTest methodsFor: 'running' stamp: 'MaxLeske 9/30/2014 21:14'!
tearDown
	super tearDown.
	classFactory cleanUp.
	Smalltalk fixObsoleteReferences! !

!OkCancelToolbar commentStamp: '<historical>'!
An OkCancelToolbar is a model for a basic Ok-Cancel toolbar!
!OkCancelToolbar methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
cancelAction

	^ cancelAction value! !

!OkCancelToolbar methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
cancelled

	^ cancelled value! !

!OkCancelToolbar methodsFor: 'initialization' stamp: 'DucasseStephane 9/10/2014 09:59'!
initialize

	cancelled := false asValueHolder.
	cancelAction := [ true ] asValueHolder.
	super initialize.! !

!OkCancelToolbar methodsFor: 'accessing' stamp: ''!
cancelButton

	^ cancelButton! !

!OkCancelToolbar methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
cancelAction: aBlock

	^ cancelAction value: aBlock! !

!OkCancelToolbar methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 11/27/2013 15:11'!
initializePresenter

	super initializePresenter.
	cancelButton action: [ self performCancelAction ]! !

!OkCancelToolbar methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/27/2013 15:11'!
performCancelAction

	^ cancelAction value value == false
		ifFalse: [ 
			cancelled value: true.
			owner ifNil: [ self delete ] ifNotNil: [ owner delete ] ]! !

!OkCancelToolbar methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/27/2013 15:11'!
triggerCancelAction

	self performCancelAction! !

!OkCancelToolbar methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 6/12/2012 18:03'!
registerCancelButtonEvents

	cancelButton 
		label: 'Cancel';
		enabled: true;
		state: false! !

!OkCancelToolbar methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 6/12/2012 18:07'!
initializeWidgets

	super initializeWidgets.
	self instantiateModels: #( cancelButton ButtonModel ).

	self registerCancelButtonEvents.
	self focusOrder
		add: cancelButton! !

!OkCancelToolbar methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
cancelled: aBoolean

	cancelled value: aBoolean! !

!OkCancelToolbar methodsFor: 'api' stamp: 'BenjaminVanRyseghem 12/6/2013 18:35'!
cancel

	self cancelled: true! !

!OkCancelToolbar class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/17/2013 11:58'!
defaultSpec
	<spec>
	
	^ SpecLayout composed
		add: #okButton origin: 1@0 corner: 1@1 offsetOrigin: (2*(self buttonWidth negated))@0 offsetCorner: (self buttonWidth negated)@0;
		add: #cancelButton origin: 1@0 corner: 1@1 offsetOrigin: (self buttonWidth negated)@0 offsetCorner: 0@0;
		send: #vShrinkWrap;
		yourself! !

!OkCancelToolbar class methodsFor: 'specs' stamp: ''!
title

	^ 'Ok Cancel'! !

!OkState commentStamp: '<historical>'!
I am the state showing everything is ok!
!OkState methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/26/2013 23:23'!
image

	^ Smalltalk ui icons smallOkIcon asMorph! !

!OkToolbar commentStamp: '<historical>'!
An OkCancelToolbar is a model for a basic Ok toolbar!
!OkToolbar methodsFor: 'private' stamp: 'IgorStasenko 12/20/2012 14:03'!
addAll: aWindow  withSpec: aSpec

	aWindow
		addMorph: (self buildWithSpec: aSpec)
		fullFrame: ((0@0 corner: 1@0) asLayoutFrame bottomOffset: 30).! !

!OkToolbar methodsFor: 'api' stamp: 'BenjaminVanRyseghem 4/26/2013 14:09'!
triggerOkAction

	self okActionBlock value! !

!OkToolbar methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 6/12/2012 18:01'!
registerOkButtonEvents

	okButton 
		label: 'Ok';
		enabled: true;
		state: false! !

!OkToolbar methodsFor: 'api' stamp: 'BenjaminVanRyseghem 12/6/2013 18:48'!
triggerCancelAction
	
	self cancel! !

!OkToolbar methodsFor: 'api' stamp: 'BenjaminVanRyseghem 12/6/2013 18:48'!
cancel
	
	owner 
		ifNil: [ self delete ] 
		ifNotNil: [ owner delete ]! !

!OkToolbar methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 6/12/2012 18:02'!
initializeWidgets
	
	
	self instantiateModels:  #( okButton ButtonModel ).
	self registerOkButtonEvents.
	
	self focusOrder
		add: okButton! !

!OkToolbar methodsFor: 'initialization' stamp: 'DucasseStephane 9/10/2014 09:59'!
initialize

	super initialize.
	okAction := [ true ] asValueHolder.! !

!OkToolbar methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
okAction

	^ okAction value! !

!OkToolbar methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 4/26/2013 14:09'!
initializePresenter

	okButton action: self okActionBlock! !

!OkToolbar methodsFor: 'private' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
okActionBlock

	^ [ okAction value value == false
		ifFalse: [ owner 
			ifNil: [ self delete ] 
			ifNotNil: [ owner delete ] ] ]! !

!OkToolbar methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
okAction: aBlock

	^ okAction value: aBlock! !

!OkToolbar methodsFor: 'private' stamp: 'BenjaminVanRyseghem 5/10/2012 13:05'!
hFill

	^ Morph new
		color: Color transparent;
		height: 0;
		vResizing: #rigid;
		hResizing: #spaceFill! !

!OkToolbar methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/10/2012 13:05'!
okButton

	^ okButton! !

!OkToolbar class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/17/2013 11:58'!
defaultSpec
	<spec>
	
	^ SpecLayout composed
		add: #okButton origin: 1@0 corner: 1@1 offsetOrigin: (self buttonWidth negated)@0 offsetCorner: 0@0;
		send: #vShrinkWrap;
		yourself! !

!OkToolbar class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 5/10/2012 13:07'!
title

	^ 'Ok Toolbar'! !

!OldClassBuilderAdapter commentStamp: '<historical>'!
I am an adapter of a Slot class builder to the traditional class building protocol.!
!OldClassBuilderAdapter methodsFor: 'adapted api' stamp: 'MarcusDenker 7/12/2014 17:52'!
name: name inEnvironment: environment subclassOf: superClass type: type instanceVariableNames: instanceVariablesString classVariableNames: classVariablesString poolDictionaries: sharedPoolsString category: category
	"Define a new class in the given environment"
	^ self slotClassInstaller make: [ :builder |
		builder
			superclass: superClass;
			name: name;
			layoutClass: (self layoutForType: type);
			slots: instanceVariablesString asSlotCollection;
			sharedVariablesFromString: classVariablesString;
			sharedPools: sharedPoolsString;
			category: category;
			environment: environment;
			copyTraitCompositionFromExistingClass;
			copyClassSlotsFromExistingClass ].
! !

!OldClassBuilderAdapter methodsFor: 'adapted api' stamp: 'MartinDias 6/14/2013 18:11'!
superclass: newSuper
	subclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s category: cat 
	"This is the standard initialization message for creating a new class as a 
	subclass of an existing class."
	^self 
		name: t
		inEnvironment: newSuper environment
		subclassOf: newSuper
		type: newSuper typeOfClass
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: cat! !

!OldClassBuilderAdapter methodsFor: 'adapted api' stamp: 'MartinDias 6/14/2013 18:00'!
superclass: aClass
	variableSubclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s category: cat
	"This is the standard initialization message for creating a new class as a 
	subclass of an existing class in which the subclass is to 
	have indexable pointer variables."
	aClass isBits 
		ifTrue: [^self error: 'cannot make a pointer subclass of a class with non-pointer fields'].
	^self 
		name: t
		inEnvironment: aClass environment
		subclassOf: aClass
		type: #variable
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: cat! !

!OldClassBuilderAdapter methodsFor: 'adapted api' stamp: 'MartinDias 6/14/2013 17:58'!
superclass: aClass
	weakSubclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s category: cat
	"This is the standard initialization message for creating a new class as a 
	subclass of an existing class (the receiver) in which the subclass is to 
	have weak indexable pointer variables."
	aClass isBits 
		ifTrue: [^self error: 'cannot make a pointer subclass of a class with non-pointer fields'].
	^self 
		name: t
		inEnvironment: aClass environment
		subclassOf: aClass
		type: #weak
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: cat! !

!OldClassBuilderAdapter methodsFor: 'accessing' stamp: 'MartinDias 12/9/2013 11:38'!
layoutForType: typeSymbol
	typeSymbol = #compiledMethod 
		ifTrue: [ ^ CompiledMethodLayout ].
	typeSymbol = #bytes 
		ifTrue: [ ^ ByteLayout ].
	typeSymbol = #words 
		ifTrue: [ ^ WordLayout ].
	typeSymbol = #weak 
		ifTrue: [ ^ WeakLayout ].
	typeSymbol = #variable 
		ifTrue: [ ^ VariableLayout ].
	typeSymbol = #normal 
		ifTrue: [ ^ FixedLayout ].
	Error signal: 'Invalid layout type: ', typeSymbol asString.! !

!OldClassBuilderAdapter methodsFor: '*Deprecated40' stamp: 'maxmattone 3/5/2015 15:06'!
becomeCompact: aClass
	"Make the class compact.
	This means: 
	- to find a free slot in 'Smalltalk compactClassArray'
	- add the class in that array
	- update the format of the class with the index
	- update the instances of the class
	"

	| compactClassesArray index |
	self deprecated: 'Moved to TClassDescription. Use instead "aClass becomeCompact"'.
	aClass isWeak 
		ifTrue: [^ self error: 'You must not make a weak class compact'].
	compactClassesArray := Smalltalk compactClassesArray.
	(aClass isCompact or: [compactClassesArray includes: aClass])
		ifTrue: [^ self error: aClass name , 'is already compact'].
	index := compactClassesArray indexOf: nil
		ifAbsent: [^ self error: 'compact class table is full'].
	"Install this class in the compact class table"
	compactClassesArray at: index put: aClass.

	"Update instspec so instances will be compact. 
	The layout has the responsibility for setting the format."
	aClass layout compactClassIndex: index.

	"Make up new instances and become old ones into them"
	aClass updateInstancesFrom: aClass.
	"Purge any old instances"
	Smalltalk garbageCollect.! !

!OldClassBuilderAdapter methodsFor: 'adapted api' stamp: 'MartinDias 6/14/2013 18:01'!
superclass: aClass
	variableByteSubclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s category: cat
	"This is the standard initialization message for creating a new class as a 
	subclass of an existing class in which the subclass is to 
	have indexable byte-sized nonpointer variables."
	| oldClassOrNil actualType |
	(aClass instSize > 0)
		ifTrue: [^self error: 'cannot make a byte subclass of a class with named fields'].
	(aClass isVariable and: [aClass isWords])
		ifTrue: [^self error: 'cannot make a byte subclass of a class with word fields'].
	(aClass isVariable and: [aClass isPointers])
		ifTrue: [^self error: 'cannot make a byte subclass of a class with pointer fields'].
	oldClassOrNil := aClass environment at: t ifAbsent:[nil].
	actualType := (oldClassOrNil notNil
				   and: [oldClassOrNil typeOfClass == #compiledMethod])
					ifTrue: [#compiledMethod]
					ifFalse: [#bytes].
	^self 
		name: t
		inEnvironment: aClass environment
		subclassOf: aClass
		type: actualType
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: cat! !

!OldClassBuilderAdapter methodsFor: 'accessing' stamp: 'MartinDias 6/14/2013 17:42'!
slotClassInstaller
	^ PharoClassInstaller! !

!OldClassBuilderAdapter methodsFor: '*Deprecated40' stamp: 'maxmattone 3/5/2015 15:10'!
becomeCompact: aClass simplyAt: index
	"The same as #becomeCompact: but without updating the instances."

	| compactClassesArray |
	self deprecated: 'Moved to TClassDescription. Use instead "aClass becomeCompactSimplyAt: index"'.
	aClass isWeak 
		ifTrue: [^ self error: 'You must not make a weak class compact'].
	compactClassesArray := Smalltalk compactClassesArray.
	(aClass isCompact or: [compactClassesArray includes: aClass])
		ifTrue: [^ self error: aClass name, 'is already compact'].		
	(compactClassesArray at: index) ifNotNil: [^ self error: 'compact table slot already in use'].
	"Install this class in the compact class table"
	compactClassesArray at: index put: aClass.

	"Update instspec so instances will be compact. 
	The layout has the responsibility for setting the format."
	aClass layout compactClassIndex: index.! !

!OldClassBuilderAdapter methodsFor: 'slots' stamp: 'MarcusDenker 1/12/2015 16:06'!
class: oldClass slots: slots
	"This is the basic initialization message to change the definition of an existing Metaclass"

	| theClass |
	theClass := oldClass theNonMetaClass.
	
	theClass := self slotClassInstaller make: [ :builder |
		builder
			superclass: theClass superclass;
			name: theClass name;
			layoutClass: theClass layout class;
			slots: theClass slots;
			sharedVariablesFromString: theClass classVariablesString;
			sharedPools: theClass sharedPoolsString;
			traitComposition: theClass traitComposition;
			category: theClass category asString;
			classSlots: slots].
	^ theClass theMetaClass! !

!OldClassBuilderAdapter methodsFor: '*Deprecated40' stamp: 'MarcusDenker 2/19/2015 15:14'!
anonymousSubclassOf: superClass
	self deprecated: 'use aClass newAnonymousSubclass instead' on: '19 February 2015' in: 'Pharo4'.
	^superClass newAnonymousSubclass! !

!OldClassBuilderAdapter methodsFor: '*Deprecated40' stamp: 'maxmattone 3/5/2015 15:09'!
becomeUncompact: aClass
	"The inverse of #becomeCompact. However, some classes can not be uncompact: see #checkCanBeUncompact."

	| compactClassesArray index |
	self deprecated: 'Moved to TClassDescription. Use instead "aClass becomeUncompact"'.
	compactClassesArray := Smalltalk compactClassesArray.
	(index := aClass indexIfCompact) = 0
		ifTrue: [^ self].
	self assert:[compactClassesArray includes: aClass].
	aClass checkCanBeUncompact.

	"Update instspec so instances will be compact. 
	The layout has the responsibility for setting the format."
	aClass layout compactClassIndex: 0.
	
	"Make up new instances and become old ones into them"
	aClass updateInstancesFrom: aClass.
	"Make sure there are no compact ones left around"
	Smalltalk garbageCollect.
	"Remove this class from the compact class table"
	compactClassesArray at: index put: nil.
! !

!OldClassBuilderAdapter methodsFor: 'adapted api' stamp: 'MartinDias 6/14/2013 17:59'!
superclass: aClass
	variableWordSubclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s category: cat
	"This is the standard initialization message for creating a new class as a 
	subclass of an existing class in which the subclass is to 
	have indexable word-sized nonpointer variables."
	(aClass instSize > 0)
		ifTrue: [^self error: 'cannot make a word subclass of a class with named fields'].
	(aClass isVariable and: [aClass isBytes])
		ifTrue: [^self error: 'cannot make a word subclass of a class with byte fields'].
	(aClass isVariable and: [aClass isPointers])
		ifTrue: [^self error: 'cannot make a word subclass of a class with pointer fields'].

	^self 
		name: t
		inEnvironment: aClass environment
		subclassOf: aClass
		type: #words
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: cat! !

!OpalCompiler commentStamp: '<historical>'!
I provide the API of the whole Compiler Package.

-> parsing: just parse
-> translate: parse and generate code so we get all error messages
-> compile: translate but return the CompiledMethod 

!
!OpalCompiler methodsFor: 'private' stamp: 'GiselaDecuzzi 6/11/2013 14:41'!
parseExpression
	| parseClass |
	
	parseClass := self compilationContext parserClass.

	^self useFaultyForParsing 
		ifTrue: [parseClass parseFaultyExpression: source contents]
		ifFalse: [parseClass parseExpression: source contents]! !

!OpalCompiler methodsFor: 'public access' stamp: 'IgorStasenko 8/28/2013 10:36'!
translate
	[ self compile ] on: ReparseAfterSourceEditing do: [ :ex |
		self source: ex newSource readStream.
		self compile
	 ] .
	^ ast! !

!OpalCompiler methodsFor: 'accessing' stamp: 'ClementBera 6/7/2013 09:58'!
compiledMethodTrailer: bytes
	self compilationContext compiledMethodTrailer: bytes! !

!OpalCompiler methodsFor: 'accessing' stamp: 'GiselaDecuzzi 6/11/2013 13:55'!
useFaultyForParsing: anObject
	useFaultyForParsing := anObject! !

!OpalCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 5/26/2013 09:55'!
logged: aBoolean
	self compilationContext logged:  aBoolean.! !

!OpalCompiler methodsFor: 'public access' stamp: 'ClementBera 11/18/2014 15:39'!
decompileMethod: aCompiledMethod
	^ Smalltalk globals 
		at: #OCDecompiler 
		ifPresent: [ :decompilerClass | [ decompilerClass decompile: aCompiledMethod ]
			on: Error 
			do: [ RBMethodNode errorMethodNode: aCompiledMethod selector errorMessage: 'Decompilation failed'.  ] ]
		ifAbsent: [ RBMethodNode errorMethodNode: aCompiledMethod selector errorMessage: 'No decompiler available'. ]

! !

!OpalCompiler methodsFor: 'public access' stamp: 'MarcusDenker 2/28/2015 15:29'!
compile
	| cm |
	[ 	[	ast := self parse.
			self doSemanticAnalysis. 
			self callPlugins.  
		] 	on: OCSourceCodeChanged 
			do: 
			[  	:notification | 
				self source: notification newSourceCode. 
				notification retry. 
			]. 
		cm := ast generate: self compilationContext compiledMethodTrailer 
	]	on: SyntaxErrorNotification 
		do: [ :exception | 
			self compilationContext requestor
                ifNotNil: [
						self compilationContext requestor 
							notify: exception errorMessage , ' ->'
							at: exception location
							in: exception errorCode.
                    ^ self compilationContext failBlock value ]
                ifNil: [ exception pass ]].
	^cm! !

!OpalCompiler methodsFor: 'private' stamp: 'MarcusDenker 2/28/2015 16:05'!
callPlugins
	| plugins  |
	plugins := compilationContext astTransformPlugins ifEmpty: [ ^self ].
	plugins sort: [:a :b | a priority > b priority]. "priority 0 is sorted last"
	ast := ast copy.
	plugins do: [ :each | ast := each transform: ast]. ! !

!OpalCompiler methodsFor: 'public access' stamp: 'MarcusDenker 5/26/2013 09:55'!
options: anOptionsArray
	self compilationContext parseOptions: anOptionsArray! !

!OpalCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 5/26/2013 09:50'!
environment: anSmallTalkImage
	self compilationContext environment: anSmallTalkImage ! !

!OpalCompiler methodsFor: 'public access' stamp: 'MarcusDenker 9/5/2013 15:35'!
compile: textOrString 
	
	^self
		source: textOrString;
		compile.! !

!OpalCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 10/7/2014 18:12'!
requestor: aRequestor
	self compilationContext requestor: aRequestor.
	self compilationContext interactive: (UIManager default interactiveParserFor: aRequestor).! !

!OpalCompiler methodsFor: 'accessing' stamp: 'ClementBera 6/7/2013 09:49'!
failBlock: aBlock
	self compilationContext failBlock: aBlock.! !

!OpalCompiler methodsFor: 'plugins' stamp: 'MarcusDenker 2/28/2015 15:33'!
addPlugin: aClass 
	compilationContext addASTTransformationPlugin: aClass! !

!OpalCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 5/26/2013 09:53'!
compilationContextClass: aClass
	compilationContextClass := aClass.! !

!OpalCompiler methodsFor: 'private' stamp: 'ClementBera 6/7/2013 09:49'!
doSemanticAnalysis
	^[ast doSemanticAnalysisInContext: self compilationContext] 
		on: OCSemanticError 
		do: [ :ex | ex defaultAction. ^ self compilationContext failBlock value ]! !

!OpalCompiler methodsFor: 'public access' stamp: 'CamilleTeruel 7/29/2014 16:04'!
parse
	| expression selector arguments method |
	self compilationContext noPattern ifFalse: [ ^ self parseMethod ].
	expression := self parseExpression asSequenceNode transformLastToReturn.
	context
		ifNil: [ 
			selector := #DoIt.
			arguments := #() ] 
		ifNotNil: [ 
			selector := #DoItIn:.
			arguments := { RBVariableNode named: 'ThisContext' } ].
	method := RBMethodNode selector: selector arguments: arguments body: expression.
	context ifNotNil: [ method rewriteTempsForContext: context ].
	^ method! !

!OpalCompiler methodsFor: 'accessing' stamp: 'ClementBera 6/7/2013 09:59'!
context: aContext
	context  := aContext! !

!OpalCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 5/26/2013 09:55'!
noPattern: aBoolean
	self compilationContext noPattern: aBoolean.
	! !

!OpalCompiler methodsFor: 'public access' stamp: 'MarcusDenker 6/14/2013 15:48'!
parseLiterals: aString
	^RBExplicitVariableParser parseLiterals: aString! !

!OpalCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 5/12/2013 11:20'!
receiver: anObject
	receiver := anObject.! !

!OpalCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 6/17/2013 12:51'!
compilationContext
	^ compilationContext ifNil: [ compilationContext := self compilationContextClass default ]! !

!OpalCompiler methodsFor: 'private' stamp: 'GiselaDecuzzi 6/11/2013 14:36'!
parseMethod
	| parseClass |
	
	parseClass := self compilationContext parserClass.

	^self useFaultyForParsing 
		ifTrue: [parseClass parseFaultyMethod: source contents]
		ifFalse: [parseClass parseMethod: source contents]! !

!OpalCompiler methodsFor: 'public access' stamp: 'MarcusDenker 8/28/2013 10:31'!
format: textOrString 
	
	^self
		source: textOrString;
		format! !

!OpalCompiler methodsFor: 'public access' stamp: 'MarcusDenker 8/28/2013 15:31'!
parse: textOrString 
	
	^self
		source: textOrString;
		parse! !

!OpalCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 7/5/2013 15:41'!
class: aClass
	self compilationContext class: aClass.! !

!OpalCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 5/26/2013 09:36'!
compilationContextClass
	^compilationContextClass ifNil: [ CompilationContext  ]! !

!OpalCompiler methodsFor: 'public access' stamp: 'ClementBera 11/18/2014 11:22'!
evaluate
	"Compiles the sourceStream into a parse tree, then generates code into
	 a method. If aContext is not nil, the text can refer to temporaries in that
	 context (the Debugger uses this). If aRequestor is not nil, then it will receive
	 a notify:at: message before the attempt to evaluate is aborted. Finally, the 
	 compiled method is invoked from here via withArgs:executeMethod:, hence
	 the system no longer creates Doit method litter on errors."

	| value selectedSource itsSelection itsSelectionString |
	self class: (context 
				ifNil: [ receiver class ]
				ifNotNil: [ context method methodClass ]).
	self noPattern: true.
	selectedSource := ((self compilationContext requestor respondsTo: #selection)
		and: [ 
			(itsSelection := self compilationContext requestor selection) notNil
				and: [ (itsSelectionString := itsSelection asString) isEmptyOrNil not ] ])
		ifTrue: [ itsSelectionString ]
		ifFalse: [ source ].
	self source: selectedSource.
	value := receiver withArgs: (context ifNil: [ #() ] ifNotNil: [ {context} ]) executeMethod:  self translate generateWithSource.
	self compilationContext logged
		ifTrue: [ Smalltalk globals 
			at: #SystemAnnouncer 
			ifPresent: [ :sysAnn | 
				sysAnn uniqueInstance evaluated: selectedSource contents context: context ] ].
	^ value! !

!OpalCompiler methodsFor: 'public access' stamp: 'MarcusDenker 4/27/2013 19:40'!
format
	^self parse formattedCode.! !

!OpalCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 5/13/2013 14:36'!
compilationContext: anObject
	compilationContext := anObject! !

!OpalCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 4/27/2013 12:45'!
source: aString
	source := aString readStream.! !

!OpalCompiler methodsFor: 'accessing' stamp: 'GiselaDecuzzi 6/11/2013 13:56'!
useFaultyForParsing
	^ useFaultyForParsing ifNil: [ useFaultyForParsing := false ]! !

!OpalCompiler methodsFor: 'public access' stamp: 'MarcusDenker 6/14/2013 15:48'!
parseSelector: aString 
	"Answer the message selector for the argument, aString, which should parse successfully up to the temporary declaration or the end of the method header."
	
	^[RBExplicitVariableParser parseMethodPattern: aString] on: Error do: [nil].! !

!OpalCompiler methodsFor: 'accessing' stamp: 'MarcusDenker 5/26/2013 09:49'!
category: aCategory
	self compilationContext category: aCategory.! !

!OpalCompiler class methodsFor: 'old - public' stamp: 'MarcusDenker 4/27/2013 22:23'!
evaluate: textOrString logged: logFlag 
	"See Compiler|evaluate:for:notifying:logged:. If a compilation error occurs, 
	a Syntax Error view is created rather than notifying any requestor. 
	Compilation is carried out with respect to nil, i.e., no object."

	^ self new
		source: textOrString;
		logged: logFlag;
		evaluate
	
			! !

!OpalCompiler class methodsFor: 'public' stamp: 'MarcusDenker 11/16/2012 15:35'!
debuggerMethodMapForMethod: aMethod
	^ DebuggerMethodMapOpal forMethod: aMethod! !

!OpalCompiler class methodsFor: 'old - public' stamp: 'MarcusDenker 4/27/2013 22:23'!
evaluate: textOrString for: anObject notifying: aController logged: logFlag
	"Compile and execute the argument, textOrString with respect to the class 
	of anObject. If a compilation error occurs, notify aController. If both 
	compilation and execution are successful then, if logFlag is true, log 
	(write) the text onto a system changes file so that it can be replayed if 
	necessary."

	^ self new
		source: textOrString;
		logged: logFlag;
		receiver: anObject;
		requestor: aController;
		evaluate
	
			! !

!OpalCompiler class methodsFor: 'old - public' stamp: 'MarcusDenker 4/27/2013 22:23'!
evaluate: textOrString notifying: aController logged: logFlag 
	"See Compiler|evaluate:for:notifying:logged:. Compilation is carried out 
	with respect to nil, i.e., no object."

	^ self new
		source: textOrString;
		logged: logFlag;
		requestor: aController;
		evaluate
	
			! !

!OpalCompiler class methodsFor: 'options' stamp: 'ClementBera 10/27/2014 11:25'!
defaultOptions
	^ #(
	"by default we inline all optimized constructs"
	+ optionInlineIf
	+ optionInlineIfNil
	+ optionInlineAndOr
	+ optionInlineWhile
	+ optionInlineToDo
	+ optionInlineCase
	- optionInlineTimesRepeat
	
	- optionInlineNone "to turn off all. Overrides the others" 	
	- optionLongIvarAccessBytecodes "special for Contexts"
	+ optionOptimizeIR 
	)! !

!OpalCompiler class methodsFor: 'public' stamp: 'MarcusDenker 10/1/2013 14:22'!
recompileAll
	"Recompile all classes and traits in the system."

	Smalltalk image recompile


! !

!OpalCompiler class methodsFor: 'old - public' stamp: 'MarcusDenker 4/30/2013 10:28'!
evaluate: textOrString 
	
	^self new
		source: textOrString;
		evaluate! !

!OpalCompiler class methodsFor: 'public' stamp: 'MarcusDenker 5/23/2013 07:47'!
isActive
	^Smalltalk compilerClass == self! !

!OpalCompiler class methodsFor: 'old - public' stamp: 'MarcusDenker 4/27/2013 21:29'!
evaluate: textOrString for: anObject logged: logFlag 
	"See Compiler|evaluate:for:notifying:logged:. If a compilation error occurs, 
	a Syntax Error view is created rather than notifying any requestor."

	^self new
		source: textOrString;
		logged: logFlag;
		receiver: anObject;
		evaluate! !

!OpalCompiler class methodsFor: 'old - public' stamp: 'MarcusDenker 4/27/2013 21:27'!
format: textOrStream in: aClass notifying: aRequestor
	^self new
		source: textOrStream;
		class: aClass;
		requestor: aRequestor;
		format
		! !

!OpenToolTest commentStamp: 'TorstenBergmann 2/4/2014 20:46'!
SUnit tests for opening of tools!
!OpenToolTest methodsFor: 'test inspect' stamp: 'ClementBera 6/28/2013 11:16'!
testInspectClass
	| inspector |
	inspector := Object inspector.
	inspector changed.
	inspector close.! !

!OpenToolTest methodsFor: 'test browse' stamp: 'MarcusDenker 2/3/2014 09:46'!
testOpenBrowseOnInstalledTraitMethod
	| browser |
	browser := (Class>>#hasClassSide) browse.
	browser changed.
	browser close.! !

!OpenToolTest methodsFor: 'test inspect' stamp: 'ClementBera 6/28/2013 11:16'!
testInspectDictionary
	| inspector |
	inspector := (Dictionary new) inspector.
	inspector changed.
	inspector close.! !

!OpenToolTest methodsFor: 'test inspect' stamp: 'ClementBera 6/28/2013 11:16'!
testInspectArray
	| inspector |
	inspector := (1 to: 1000) asArray inspector.
	inspector changed.
	inspector close.! !

!OpenToolTest methodsFor: 'test browse' stamp: 'CamilloBruni 9/21/2012 14:10'!
testOpenBrowseOnMethod
	| browser |
	browser := (Object>>#name) browse.
	browser changed.
	browser close.! !

!OpenToolTest methodsFor: 'test browse' stamp: 'CamilloBruni 9/21/2012 14:09'!
testOpenBrowseOnClass
	| browser |
	browser := Object browse.
	browser changed.
	browser close.! !

!OpenToolTest methodsFor: 'test browse' stamp: 'SebastianTleye 7/22/2013 13:46'!
testOpenBrowseOnTraitMethod
	| browser |
	browser := (TBehavior>>#name) browse.
	browser changed.
	browser close.! !

!OpenToolTest methodsFor: 'test inspect' stamp: 'ClementBera 6/28/2013 11:16'!
testInspectInteger
	| inspector |
	inspector := 1 inspector.
	inspector changed.
	inspector close.! !

!OpenToolTest methodsFor: 'test senders' stamp: 'CamilloBruni 9/21/2012 14:22'!
testSendersOfAt
	| senders |
	senders := SystemNavigation default browseAllSendersOf: #name.
	senders changed.
	senders close.! !

!OpenToolTest methodsFor: 'test inspect' stamp: 'SebastianTleye 7/9/2013 18:43'!
testInspectTraitClass
	| inspector |
	inspector := TBehavior inspector.
	inspector changed.
	inspector close.! !

!OptimizedBlockLocalTempReadBeforeWrittenVisitor commentStamp: 'StephaneDucasse 11/29/2011 22:25'!
Answer the set of temporary variables that are read before they are written in the visited parse tree.  Used by the compiler to detect those block-local temporaries of blocks in optimized loops that require nilling to prevent a value from a previous iteration persisting into a subsequent one.!
!OptimizedBlockLocalTempReadBeforeWrittenVisitor methodsFor: 'initialization' stamp: 'eem 9/5/2009 21:03'!
initialize
	inOptimizedBlock := false! !

!OptimizedBlockLocalTempReadBeforeWrittenVisitor methodsFor: 'visiting' stamp: 'eem 9/5/2009 22:09'!
visitBlockNode: aBlockNode
	| savedWritten |
	"If we're in the optimized block in one side of an optimized ifTrue:ifFalse: et al
	 leave it to the enclosing visitMessageNode: activation to handle merging written."
	inOptimizedBlock ifTrue:
		[^super visitBlockNode: aBlockNode].
	"If we're not then don't update written because without evaluating the guard(s)
	 we can't tell if the block is evaluated or not, and we must avoid false positives."
	savedWritten := written copy.
	super visitBlockNode: aBlockNode.
	written := savedWritten! !

!OptimizedBlockLocalTempReadBeforeWrittenVisitor methodsFor: 'visiting' stamp: 'eem 9/8/2008 14:43'!
visitTempVariableNode: aTempVariableNode
	(aTempVariableNode isArg
	 or: [written notNil
		and: [written includes: aTempVariableNode]]) ifTrue:
		[^self].
	readBeforeWritten ifNil:
		[readBeforeWritten := IdentitySet new].
	readBeforeWritten add: aTempVariableNode! !

!OptimizedBlockLocalTempReadBeforeWrittenVisitor methodsFor: 'visiting' stamp: 'eem 9/10/2008 15:28'!
visitAssignmentNode: anAssignmentNode
	anAssignmentNode value accept: self.
	anAssignmentNode variable isTemp
		ifTrue:
			[written ifNil: [written := IdentitySet new].
			 written add: anAssignmentNode variable]
		ifFalse:
			[anAssignmentNode variable accept: self]! !

!OptimizedBlockLocalTempReadBeforeWrittenVisitor methodsFor: 'visiting' stamp: 'eem 9/5/2009 22:03'!
visitMessageNode: aMessageNode
	| savedWritten writtenPostFirstArm |
	(aMessageNode isOptimized
	 and: [#(ifTrue:ifFalse: ifFalse:ifTrue: ifNil:ifNotNil: ifNotNil:ifNil:) includes: aMessageNode selector key]) ifFalse:
		[^super visitMessageNode: aMessageNode].
	aMessageNode receiver accept: self.
	aMessageNode selector accept: self.
	savedWritten := written copy.
	aMessageNode argumentsInEvaluationOrder
		do: [:argument|
			argument isBlockNode
				ifTrue: [| savedIOB |
					savedIOB := inOptimizedBlock.
					inOptimizedBlock := true.
					[argument accept: self]
						ensure: [inOptimizedBlock := savedIOB]]
				ifFalse: [argument accept: self]]
		separatedBy:
			[writtenPostFirstArm := written.
			 written := savedWritten].
	(written notNil
	 and: [writtenPostFirstArm notNil]) ifTrue:
		[written := written intersection: writtenPostFirstArm]! !

!OptimizedBlockLocalTempReadBeforeWrittenVisitor methodsFor: 'accessing' stamp: 'eem 9/8/2008 14:30'!
readBeforeWritten
	^readBeforeWritten ifNil: [IdentitySet new]! !

!OrderedCollection commentStamp: '<historical>'!
I represent a collection of objects ordered by the collector.!
!OrderedCollection methodsFor: 'copying' stamp: 'nice 10/5/2009 10:18'!
copyFrom: startIndex to: endIndex 
	"Answer a copy of the receiver that contains elements from position
	startIndex to endIndex."

	^self shallowCopy postCopyFrom: startIndex to: endIndex! !

!OrderedCollection methodsFor: 'enumerating' stamp: 'di 8/31/1999 13:13'!
with: otherCollection collect: twoArgBlock 
	"Collect and return the result of evaluating twoArgBlock with 
	corresponding elements from this collection and otherCollection."
	| result |
	otherCollection size = self size ifFalse: [self error: 'otherCollection must be the same size'].
	result := self species new: self size.
	1 to: self size do:
		[:index | result addLast: (twoArgBlock value: (self at: index)
									value: (otherCollection at: index))].
	^ result! !

!OrderedCollection methodsFor: 'adding' stamp: 'sma 5/12/2000 11:26'!
addAll: aCollection 
	"Add each element of aCollection at my end. Answer	aCollection."

	^ self addAllLast: aCollection! !

!OrderedCollection methodsFor: 'adding' stamp: 'sw 3/1/2001 11:03'!
addAllFirstUnlessAlreadyPresent: anOrderedCollection 
	"Add each element of anOrderedCollection at the beginning of the receiver, preserving the order, but do not add any items that are already in the receiver.  Answer anOrderedCollection."

	anOrderedCollection reverseDo:
		[:each | (self includes: each) ifFalse: [self addFirst: each]].
	^ anOrderedCollection! !

!OrderedCollection methodsFor: 'private' stamp: 'BG 1/9/2004 12:26'!
find: oldObject
  "  This method answers an index in the range firstIndex .. lastIndex, which is meant for internal use only.
     Never use this method in your code, the methods for public use are:
        #indexOf:
        #indexOf:ifAbsent: "

	| index |
	index := firstIndex.
	[index <= lastIndex]
		whileTrue:
			[(array at: index) = oldObject ifTrue: [^ index].
			index := index + 1].
	self errorNotFound: oldObject! !

!OrderedCollection methodsFor: 'private' stamp: 'cmm 10/25/2010 22:27'!
growAtFirst
	"Add new empty slots to the front of array, while keeping the empty slots at the end."

	| newArray newFirstIndex newLastIndex |
	newArray := self class arrayType new: (array size * 2 max: 1).
	newFirstIndex := newArray size - array size + firstIndex.
	newLastIndex := newFirstIndex + lastIndex - firstIndex.
	newArray 
		replaceFrom: newFirstIndex
		to: newLastIndex
		with: array
		startingAt: firstIndex.
	array := newArray.
	firstIndex := newFirstIndex.
	lastIndex := newLastIndex! !

!OrderedCollection methodsFor: 'adding' stamp: 'ar 7/15/2008 23:05'!
add: newObject beforeIndex: index 
	"Add the argument, newObject, as an element of the receiver. Put it in 
	the sequence just before index. Answer newObject."
	(index between: 1 and: self size+1) ifFalse:[^self errorSubscriptBounds: index].
	self insert: newObject before: firstIndex + index - 1.
	^ newObject! !

!OrderedCollection methodsFor: 'adding' stamp: ''!
addLast: newObject 
	"Add newObject to the end of the receiver. Answer newObject."

	lastIndex = array size ifTrue: [self makeRoomAtLast].
	lastIndex := lastIndex + 1.
	array at: lastIndex put: newObject.
	^ newObject! !

!OrderedCollection methodsFor: 'enumerating' stamp: 'CamilloBruni 3/22/2013 23:52'!
reject: rejectBlock 
	"Optimized version of Collection>>#reject:"

	| newCollection element |
	
	newCollection := self copyEmpty.
	
	firstIndex to: lastIndex do: [ :index |
		(rejectBlock value: (element := array at: index))
			ifFalse: [ newCollection addLast: element ]].
		
	^ newCollection! !

!OrderedCollection methodsFor: 'converting' stamp: 'TorstenBergmann 11/19/2014 11:01'!
asOrderedCollection 

	self species == OrderedCollection ifTrue: [ ^self ].
	^super asOrderedCollection ! !

!OrderedCollection methodsFor: 'removing' stamp: 'ar 5/22/2000 12:19'!
removeAt: index
	| removed |
	removed := self at: index.
	self removeIndex: index + firstIndex - 1.
	^removed! !

!OrderedCollection methodsFor: 'adding' stamp: 'StephaneDucasse 12/25/2009 12:13'!
addAllLast: aCollection 
	"Add each element of aCollection at the end of the receiver. 
	Answer aCollection."

	aCollection do: [:each | self addLast: each].
	^aCollection! !

!OrderedCollection methodsFor: 'adding' stamp: 'ajh 5/22/2003 12:03'!
at: index ifAbsentPut: block
	"Return value at index, however, if value does not exist (nil or out of bounds) then add block's value at index (growing self if necessary)"

	| v |
	index <= self size ifTrue: [
		^ (v := self at: index)
			ifNotNil: [v]
			ifNil: [self at: index put: block value]
	].
	[self size < index] whileTrue: [self add: nil].
	^ self at: index put: block value! !

!OrderedCollection methodsFor: 'removing' stamp: ''!
removeFirst
	"Remove the first element of the receiver and answer it. If the receiver is 
	empty, create an error notification."
	| firstObject |
	self emptyCheck.
	firstObject := array at: firstIndex.
	array at: firstIndex put: nil.
	firstIndex := firstIndex + 1.
	^ firstObject! !

!OrderedCollection methodsFor: 'accessing' stamp: 'sma 5/12/2000 11:42'!
capacity
	"Answer the current capacity of the receiver."

	^ array size! !

!OrderedCollection methodsFor: 'converting' stamp: 'stephane.ducasse 8/8/2009 10:48'!
asArray
	^ (Array new: self size) replaceFrom: 1 to: self size with: array startingAt: firstIndex.! !

!OrderedCollection methodsFor: 'copying' stamp: ''!
copyReplaceFrom: start to: stop with: replacementCollection 
	"Answer a copy of the receiver with replacementCollection's elements in
	place of the receiver's start'th to stop'th elements. This does not expect
	a 1-1 map from replacementCollection to the start to stop elements, so it
	will do an insert or append."

	| newOrderedCollection delta startIndex stopIndex |
	"if start is less than 1, ignore stop and assume this is inserting at the front. 
	if start greater than self size, ignore stop and assume this is appending. 
	otherwise, it is replacing part of me and start and stop have to be within my 
	bounds. "
	delta := 0.
	startIndex := start.
	stopIndex := stop.
	start < 1
		ifTrue: [startIndex := stopIndex := 0]
		ifFalse: [startIndex > self size
				ifTrue: [startIndex := stopIndex := self size + 1]
				ifFalse: 
					[(stopIndex < (startIndex - 1) or: [stopIndex > self size])
						ifTrue: [self errorOutOfBounds].
					delta := stopIndex - startIndex + 1]].
	newOrderedCollection := 
		self species new: self size + replacementCollection size - delta.
	1 to: startIndex - 1 do: [:index | newOrderedCollection add: (self at: index)].
	1 to: replacementCollection size do: 
		[:index | newOrderedCollection add: (replacementCollection at: index)].
	stopIndex + 1 to: self size do: [:index | newOrderedCollection add: (self at: index)].
	^newOrderedCollection! !

!OrderedCollection methodsFor: 'private' stamp: 'apb 10/15/2000 18:10'!
setContents: anArray
	array := anArray.
	firstIndex := 1.
	lastIndex := array size.! !

!OrderedCollection methodsFor: 'removing' stamp: 'ul 2/24/2011 14:33'!
reset
	"Quickly remove all elements. The objects will be still referenced, but will not be 	accessible."
	
	self resetTo: 1! !

!OrderedCollection methodsFor: 'adding' stamp: ''!
addFirst: newObject 
	"Add newObject to the beginning of the receiver. Answer newObject."

	firstIndex = 1 ifTrue: [self makeRoomAtFirst].
	firstIndex := firstIndex - 1.
	array at: firstIndex put: newObject.
	^ newObject! !

!OrderedCollection methodsFor: '*GroupManager' stamp: 'BenjaminVanRyseghem 4/14/2012 12:08'!
removeDuplicates
	| iterator |
	"Remove the copies of elements, but keep the same order"
	
	self ifEmpty: [ ^ self ].
	iterator := 1.
	[ iterator <= self size ]
		whileTrue: [ | each newIndex |
			each := self at: iterator.			
			[ newIndex := (self indexOf: each startingAt: iterator+1).
			newIndex > 0 ]
				whileTrue: [ self removeAt: newIndex ].
			iterator := iterator + 1.
	 ]! !

!OrderedCollection methodsFor: 'private' stamp: 'MarianoMartinezPeck 8/3/2011 14:37'!
makeRoomAtLast
	"Make some empty slots at the end of the array. If we have more than 50% free space, then just move the elements, so that the last 50% of the slots are free, otherwise add new free slots to the end by growing. Precondition: lastIndex = array size"
	
	| tally newFirstIndex newLastIndex |
	tally := self size.
	tally * 2 >= lastIndex ifTrue: [ ^self growAtLast ].
	tally = 0 ifTrue: [ ^self resetTo: 1 ].
	newLastIndex := lastIndex // 2.
	newFirstIndex := newLastIndex - lastIndex + firstIndex.
	array 
		replaceFrom: newFirstIndex
		to: newLastIndex
		with: array
		startingAt: firstIndex.
	array from: newLastIndex + 1 to: lastIndex put: nil.
	firstIndex := newFirstIndex.
	lastIndex := newLastIndex! !

!OrderedCollection methodsFor: 'enumerating' stamp: 'CamilloBruni 3/22/2013 23:51'!
reject: rejectBlock thenCollect: collectBlock
    " Optimized version of Collection>>#reject:thenCollect: "

	| newCollection |

    newCollection := self copyEmpty.

    firstIndex to: lastIndex do: [ :index |
		| element |
		element := array at: index.
		(rejectBlock value: element) 
			ifFalse: [ newCollection addLast: (collectBlock value: element) ]].

    ^ newCollection! !

!OrderedCollection methodsFor: 'private' stamp: ''!
errorConditionNotSatisfied

	self error: 'no element satisfies condition'! !

!OrderedCollection methodsFor: 'private' stamp: 'di 11/14/97 12:54'!
setCollection: anArray
	array := anArray.
	self reset! !

!OrderedCollection methodsFor: 'adding' stamp: 'CamilloBruni 4/12/2011 13:52'!
add: newObject afterIndex: index 
	"Add the argument, newObject, as an element of the receiver. Put it in 
	the sequence just after index. Answer newObject."
	(index between: 0 and: self size) ifFalse:[^self errorSubscriptBounds: index].
	self insert: newObject before: firstIndex + index.
	^ newObject! !

!OrderedCollection methodsFor: 'accessing' stamp: 'CamilloBruni 4/11/2011 15:39'!
at: anInteger put: anObject 
	"Put anObject at element index anInteger. at:put: cannot be used to
	append, front or back, to an ordered collection; it is used by a
	knowledgeable client to replace an element."
	self ensureBoundsFrom: anInteger to: anInteger.
	^array at: anInteger + firstIndex - 1 put: anObject! !

!OrderedCollection methodsFor: 'enumerating' stamp: 'sma 2/5/2000 15:22'!
collect: aBlock 
	"Evaluate aBlock with each of my elements as the argument. Collect the 
	resulting values into a collection that is like me. Answer the new 
	collection. Override superclass in order to use addLast:, not at:put:."

	| newCollection |
	newCollection := self species new: self size.
	firstIndex to: lastIndex do:
		[:index |
		newCollection addLast: (aBlock value: (array at: index))].
	^ newCollection! !

!OrderedCollection methodsFor: 'copying' stamp: 'nice 10/5/2009 08:50'!
postCopy
	array := array copy! !

!OrderedCollection methodsFor: 'enumerating' stamp: 'SvenVanCaekenberghe 9/10/2014 09:00'!
reverseDo: aBlock
	"Override the superclass for performance reasons."

	lastIndex to: firstIndex by: -1 do: [ :index | 
		aBlock value: (array at: index) ]! !

!OrderedCollection methodsFor: 'private' stamp: 'cmm 10/25/2010 22:27'!
growAtLast
	"Add new empty slots to the end of array, while keeping the empty slots at the front."

	| newArray |
	newArray := self class arrayType new: (array size * 2 max: 1).
	newArray 
		replaceFrom: firstIndex
		to: lastIndex
		with: array
		startingAt: firstIndex.
	array := newArray! !

!OrderedCollection methodsFor: 'enumerating' stamp: 'pmm 3/13/2010 11:33'!
sort: aSortBlock 
	"Sort this array using aSortBlock. The block should take two arguments
	and return true if the first element should preceed the second one."

	self size <= 1 ifTrue: [^ self].  "nothing to do"
	array
		mergeSortFrom: firstIndex
		to: lastIndex 
		src: array shallowCopy 
		dst: array 
		by: aSortBlock! !

!OrderedCollection methodsFor: 'private' stamp: 'BG 1/9/2004 12:28'!
removeIndex: removedIndex
  "  removedIndex is an index in the range firstIndex .. lastIndex, such an index is not known from outside the collection.
    Never use this method in your code, it is meant for private use by OrderedCollection only.
     The method for public use is:
        #removeAt: "

	array 
		replaceFrom: removedIndex 
		to: lastIndex - 1 
		with: array 
		startingAt: removedIndex+1.
	array at: lastIndex put: nil.
	lastIndex := lastIndex - 1.! !

!OrderedCollection methodsFor: 'removing' stamp: 'cmm 10/25/2010 22:26'!
removeAll
	"remove all the elements from this collection.
	Keep same amount of storage"
	
	self setCollection: (self class arrayType new: array size)! !

!OrderedCollection methodsFor: 'private' stamp: 'ar 4/16/1999 07:59'!
resetTo: index
	firstIndex := index.
	lastIndex := firstIndex - 1! !

!OrderedCollection methodsFor: '*Fuel' stamp: 'MarianoMartinezPeck 7/26/2012 17:42'!
fuelAccept: aGeneralMapper
	"Since we have subclasses of OrderedCollection that behave differently, we cannot use the visitSimpleCollection: for all of them."
	^ (self class == OrderedCollection ) 
		ifTrue: [ aGeneralMapper visitSimpleCollection: self ]
		ifFalse: [ super fuelAccept: aGeneralMapper ] 
	! !

!OrderedCollection methodsFor: 'copying' stamp: 'sw 1/26/96'!
reversed
	"Answer a copy of the receiver with element order reversed.  "
	| newCol |
	newCol := self species new.
	self reverseDo:
		[:elem | newCol addLast: elem].
	^ newCol

"#(2 3 4 'fred') reversed"! !

!OrderedCollection methodsFor: 'adding' stamp: ''!
add: newObject after: oldObject 
	"Add the argument, newObject, as an element of the receiver. Put it in 
	the sequence just succeeding oldObject. Answer newObject."
	
	| index |
	index := self find: oldObject.
	self insert: newObject before: index + 1.
	^newObject! !

!OrderedCollection methodsFor: 'accessing' stamp: 'CamilloBruni 4/11/2011 15:36'!
at: anInteger 
	"Answer my element at index anInteger. at: is used by a knowledgeable
	client to access an existing element"

	self ensureBoundsFrom: anInteger to: anInteger.
	^ array at: anInteger + firstIndex - 1! !

!OrderedCollection methodsFor: 'adding' stamp: ''!
add: newObject

	^self addLast: newObject! !

!OrderedCollection methodsFor: 'enumerating' stamp: 'bf 5/16/2000 16:30'!
withIndexCollect: elementAndIndexBlock 
	"Just like with:collect: except that the iteration index supplies the second argument to the block. Override superclass in order to use addLast:, not at:put:."

	| newCollection |
	newCollection := self species new: self size.
	firstIndex to: lastIndex do:
		[:index |
		newCollection addLast: (elementAndIndexBlock
			value: (array at: index)
			value: index - firstIndex + 1)].
	^ newCollection! !

!OrderedCollection methodsFor: 'adding' stamp: ''!
add: newObject before: oldObject 
	"Add the argument, newObject, as an element of the receiver. Put it in 
	the sequence just preceding oldObject. Answer newObject."
	
	| index |
	index := self find: oldObject.
	self insert: newObject before: index.
	^newObject! !

!OrderedCollection methodsFor: 'private' stamp: 'MarianoMartinezPeck 8/3/2011 14:37'!
makeRoomAtFirst
	"Make some empty slots at the front of the array. If we have more than 50% free space, then just move the elements, so that the first 50% of the slots are free, otherwise add new free slots to the front by growing. Precondition: firstIndex = 1"
	
	| tally newFirstIndex newLastIndex |
	tally := self size.
	tally * 2 >= array size ifTrue: [ ^self growAtFirst ].
	tally = 0 ifTrue: [ ^self resetTo: array size + 1 ].
	newFirstIndex := array size // 2 + 1.
	newLastIndex := newFirstIndex - firstIndex + lastIndex.
	0 to: tally - 1 do: [ :offset |
		array at: newLastIndex - offset put: (array at: lastIndex - offset) ].
	array from: firstIndex to: newFirstIndex - 1 put: nil.
	firstIndex := newFirstIndex.
	lastIndex := newLastIndex! !

!OrderedCollection methodsFor: 'private' stamp: ''!
collector  "Private"
	^ array! !

!OrderedCollection methodsFor: 'enumerating' stamp: 'CamilloBruni 3/22/2013 23:52'!
collect: collectBlock thenSelect: selectBlock
    "Optimized version Collection>>#collect:thenSelect:"

    | newCollection newElement |

    newCollection := self copyEmpty.
    firstIndex to: lastIndex do: [ :index | 
		newElement := collectBlock value: (array at: index).
		(selectBlock value: newElement) 
			ifTrue: [ newCollection addLast: newElement ]].
    ^ newCollection! !

!OrderedCollection methodsFor: 'copying' stamp: ''!
copyWith: newElement 
	"Answer a copy of the receiver that is 1 bigger than the receiver and 
	includes the argument, newElement, at the end."

	| newCollection |
	newCollection := self copy.
	newCollection add: newElement.
	^newCollection! !

!OrderedCollection methodsFor: 'enumerating' stamp: 'CamilloBruni 3/22/2013 23:52'!
select: selectBlock thenCollect: collectBlock
    " Optimized version Collection>>#select:thenCollect: "

	| newCollection element |

    newCollection := self copyEmpty.

    firstIndex to: lastIndex do: [ :index |
		element := array at: index.
		(selectBlock value: element) 
			ifTrue: [ newCollection addLast: (collectBlock value: element) ]].

    ^ newCollection! !

!OrderedCollection methodsFor: 'accessing' stamp: 'sma 5/12/2000 11:39'!
size
	"Answer how many elements the receiver contains."

	^ lastIndex - firstIndex + 1! !

!OrderedCollection methodsFor: 'copying' stamp: ''!
copyEmpty
	"Answer a copy of the receiver that contains no elements."

	^self species new! !

!OrderedCollection methodsFor: 'removing' stamp: ''!
remove: oldObject ifAbsent: absentBlock

	| index |
	index := firstIndex.
	[index <= lastIndex]
		whileTrue: 
			[oldObject = (array at: index)
				ifTrue: 
					[self removeIndex: index.
					^ oldObject]
				ifFalse: [index := index + 1]].
	^ absentBlock value! !

!OrderedCollection methodsFor: 'private' stamp: 'BG 1/9/2004 12:29'!
insert: anObject before: spot

  "  spot is an index in the range firstIndex .. lastIndex, such an index is not known from outside the collection. 
     Never use this method in your code, it is meant for private use by OrderedCollection only.
     The methods for use are:
        #add:before:   to insert an object before another object
        #add:beforeIndex:   to insert an object before a given position. "
	| "index" delta spotIndex|
	spotIndex := spot.
	delta := spotIndex - firstIndex.
	firstIndex = 1
		ifTrue: 
			[self makeRoomAtFirst.
			spotIndex := firstIndex + delta].
	firstIndex := firstIndex - 1.
	array
		replaceFrom: firstIndex
		to: spotIndex - 2
		with: array
		startingAt: firstIndex + 1.
	array at: spotIndex - 1 put: anObject.
"	index := firstIndex := firstIndex - 1.
	[index < (spotIndex - 1)]
		whileTrue: 
			[array at: index put: (array at: index + 1).
			index := index + 1].
	array at: index put: anObject."
	^ anObject! !

!OrderedCollection methodsFor: 'enumerating' stamp: 'CamilloBruni 4/11/2011 15:34'!
collect: aBlock from: fromIndex to: toIndex
	"Override superclass in order to use addLast:, not at:put:."
	| result |
	self ensureBoundsFrom: fromIndex to: toIndex.
	result := self species new: toIndex - fromIndex + 1.
	firstIndex + fromIndex - 1 to: firstIndex + toIndex - 1 do:
		[:index | result addLast: (aBlock value: (array at: index))].
	^ result
! !

!OrderedCollection methodsFor: 'removing' stamp: 'cmm 10/25/2010 22:26'!
removeFirst: n 
	"Remove first n object into an array"
	| list |
	list := self class arrayType new: n.
	1
		to: n
		do:
			[ : i | list
				at: i
				put: self removeFirst ].
	^ list! !

!OrderedCollection methodsFor: 'adding' stamp: ''!
addAllFirst: anOrderedCollection 
	"Add each element of anOrderedCollection at the beginning of the 
	receiver. Answer anOrderedCollection."

	anOrderedCollection reverseDo: [:each | self addFirst: each].
	^anOrderedCollection! !

!OrderedCollection methodsFor: 'enumerating' stamp: 'CamilloBruni 3/22/2013 23:51'!
select: selectBlock 
	"Optimized version of Collection>>#select: "

	| newCollection element |
	
	newCollection := self copyEmpty.
	
	firstIndex to: lastIndex do: [ :index |
		(selectBlock value: (element := array at: index))
			ifTrue: [ newCollection addLast: element ]].
		
	^ newCollection! !

!OrderedCollection methodsFor: 'enumerating' stamp: 'SvenVanCaekenberghe 9/10/2014 09:00'!
do: aBlock
	"Override the superclass for performance reasons."

	firstIndex to: lastIndex do: [ :index | 
		aBlock value: (array at: index) ]! !

!OrderedCollection methodsFor: 'removing' stamp: ''!
removeLast
	"Remove the last element of the receiver and answer it. If the receiver is 
	empty, create an error notification."
	| lastObject |
	self emptyCheck.
	lastObject := array at: lastIndex.
	array at: lastIndex put: nil.
	lastIndex := lastIndex - 1.
	^ lastObject! !

!OrderedCollection methodsFor: 'splitjoin' stamp: 'onierstrasz 4/12/2009 19:44'!
join: aCollection 
	| result |
	result := self class new.
	aCollection
		do: [:each | each appendTo: result]
		separatedBy: [self appendTo: result].
	^ result! !

!OrderedCollection methodsFor: 'copying' stamp: 'nice 5/28/2008 21:02'!
postCopyFrom: startIndex to: endIndex 
	"finish copying the array in a certain range."

	endIndex < startIndex ifFalse: [
		"Because actual size of the array may be greater than used size,
		postCopyFrom:to: may fail to fail and answer an incorrect result
		if this sanity check were not applied"
		(startIndex between: 1 and: self size) ifFalse: [^self error: 'startIndex is out of bounds'].
		(endIndex between: 1 and: self size) ifFalse: [^self error: 'endIndex is out of bounds']].
	
	"Add a protection that lacks in Array>>postcopy"
	array := array copyFrom: startIndex + firstIndex - 1 to: (endIndex max: startIndex - 1) + firstIndex - 1.
	firstIndex := 1.
	lastIndex := array size! !

!OrderedCollection methodsFor: 'removing' stamp: 'cmm 10/25/2010 22:26'!
removeLast: n 
	"Remove last n object into an array with last in last position"
	| list |
	list := self class arrayType new: n.
	n
		to: 1
		by: -1
		do:
			[ : i | list
				at: i
				put: self removeLast ].
	^ list! !

!OrderedCollection methodsFor: 'private' stamp: 'CamilloBruni 4/11/2011 15:34'!
ensureBoundsFrom: fromIndex to: toIndex
	(fromIndex < 1)
		ifTrue: [^self errorSubscriptBounds: fromIndex].
	(toIndex + firstIndex - 1 > lastIndex)
		ifTrue: [^self errorSubscriptBounds: toIndex].! !

!OrderedCollection methodsFor: 'removing' stamp: 'StephaneDucasse 10/18/2010 14:51'!
removeAllSuchThat: aBlock 
	"Remove each element of the receiver for which aBlock evaluates to true.
	The method in Collection is O(N^2), this is O(N)."

	| n |
	n := firstIndex.
	firstIndex to: lastIndex do: [:index |
	    (aBlock value: (array at: index)) ifFalse: [
			array at: n put: (array at: index).
			n := n + 1]].
	array from: n to: lastIndex put: nil.
	lastIndex := n - 1! !

!OrderedCollection class methodsFor: 'instance creation' stamp: 'cmm 10/25/2010 22:27'!
new: anInteger 
	^ self basicNew setCollection: (self arrayType new: anInteger)! !

!OrderedCollection class methodsFor: 'stream creation' stamp: 'CamilloBruni 9/5/2011 15:48'!
new: size streamContents: aBlock
	^ self withAll: (super new: size streamContents: aBlock)! !

!OrderedCollection class methodsFor: 'accessing' stamp: 'CamilloBruni 9/5/2011 15:38'!
streamSpecies
	^ Array! !

!OrderedCollection class methodsFor: 'instance creation' stamp: 'sma 5/12/2000 17:41'!
new
	^ self new: 10! !

!OrderedCollection class methodsFor: 'instance creation' stamp: ''!
newFrom: aCollection 
	"Answer an instance of me containing the same elements as aCollection."

	| newCollection |
	newCollection := self new: aCollection size.
	newCollection addAll: aCollection.
	^newCollection

"	OrderedCollection newFrom: {1. 2. 3}
	{1. 2. 3} as: OrderedCollection
	{4. 2. 7} as: SortedCollection
"! !

!OrderedCollection class methodsFor: 'instance creation' stamp: 'apb 10/15/2000 22:02'!
ofSize: n
	"Create a new collection of size n with nil as its elements.
	This method exists because OrderedCollection new: n creates an
	empty collection,  not one of size n."
	| collection |
	collection := self new: n.
	collection setContents: (collection collector).
	^ collection
! !

!OrderedCollection class methodsFor: 'private' stamp: 'cmm 10/25/2010 22:26'!
arrayType
	^ Array! !

!OrderedCollection class methodsFor: 'instance creation' stamp: 'cmm 10/25/2010 22:28'!
new: anInteger withAll: anObject
	^ self basicNew setContents: (self arrayType new: anInteger withAll: anObject)! !

!OrderedCollectionTest commentStamp: 'BG 1/10/2004 22:07'!
These test cases demonstrate addition of items into an OrderedCollection as well as item removal.

Some of the assertions are quite complicated and use a lot of collection protocol. Such methods do not test one single method, but protocol in general.!
!OrderedCollectionTest methodsFor: 'tests - index access' stamp: ''!
testLastIndexOfStartingAt
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection last.
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size
			ifAbsent: [ 99 ]) = collection size.
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size - 1
			ifAbsent: [ 99 ]) = 99.
	self assert: (collection 
			lastIndexOf: self elementNotInForIndexAccessing
			startingAt: collection size
			ifAbsent: [ 99 ]) = 99! !

!OrderedCollectionTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButLast
	"self debug: #testAllButLast"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButLast.
	self deny: abf last = col last.
	self assert: abf size + 1 = col size! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'SebastianTleye 6/28/2013 14:37'!
simpleCollection
	^simpleCollection.! !

!OrderedCollectionTest methodsFor: 'tests - begins ends with' stamp: ''!
testsEndsWith
	
	self assert: (self nonEmpty endsWith: self nonEmpty copyWithoutFirst).
	self assert: (self nonEmpty endsWith: self nonEmpty).
	self deny: (self nonEmpty endsWith: (self nonEmpty copyWith: self nonEmpty first)).! !

!OrderedCollectionTest methodsFor: 'tests - copying with replacement' stamp: ''!
testCopyReplaceAllWith1Occurence
	| result  firstIndexesOfOccurrence index endPartIndexResult endPartIndexCollection |
	
	result := self collectionWith1TimeSubcollection  copyReplaceAll: self oldSubCollection with: self replacementCollection .
	
	"detecting indexes of olSubCollection"
	firstIndexesOfOccurrence  := self firstIndexesOf: self oldSubCollection in: self collectionWith1TimeSubcollection .
	index:= firstIndexesOfOccurrence at: 1.
	
	"verify content of 'result' : "
	"first part of 'result'' : '"

	1 to: (index -1) do: 
		[
		:i |  
		self assert: (self collectionWith1TimeSubcollection  at:i)=(result at: i)
		].

	" middle part containing replacementCollection : "
	
	index to: (index + self replacementCollection size-1) do: 
		[
		:i |
		self assert: ( result at: i )=(self replacementCollection at: ( i - index + 1 ))
		].
	
	" end part :"
	
	endPartIndexResult :=  index + self replacementCollection  size .
	endPartIndexCollection :=   index + self oldSubCollection size  .
	
	1 to: (result size - endPartIndexResult - 1 ) do:
		[ 
		:i |
		self assert: (result at: ( endPartIndexResult + i - 1 ) ) = (self collectionWith1TimeSubcollection  at: ( endPartIndexCollection + i - 1 ) ).
		].
	
	
	! !

!OrderedCollectionTest methodsFor: 'tests - equality' stamp: ''!
testHasEqualElementsOfIdenticalCollectionObjects
	"self debug: #testHasEqualElementsOfIdenticalCollectionObjects"
	
	self assert: (self empty hasEqualElements: self empty). 
	self assert: (self nonEmpty hasEqualElements: self nonEmpty). 
	! !

!OrderedCollectionTest methodsFor: 'tests - index access' stamp: ''!
testLastIndexOf
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection lastIndexOf: element) = 1.
	self assert: (collection lastIndexOf: self elementNotInForIndexAccessing) = 0! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyWithReplacementTest
	self replacementCollection.
	self oldSubCollection.
	self collectionWith1TimeSubcollection.
	self assert: (self howMany: self oldSubCollection in: self collectionWith1TimeSubcollection) = 1! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 10:52'!
moreThan4Elements

" return a collection including at leat 4 elements"
	^ indexCollection ! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 15:42'!
secondIndex
" return an index between 'nonEmpty' bounds that is > to 'second index' "
	^2! !

!OrderedCollectionTest methodsFor: 'tests - subcollections access' stamp: ''!
testFirstNElements
	"self debug: #testFirstNElements"
	| result |
	result := self moreThan3Elements first: self moreThan3Elements size - 1.
	1 
		to: result size
		do: [ :i | self assert: (result at: i) = (self moreThan3Elements at: i) ].
	self assert: result size = (self moreThan3Elements size - 1).
	self 
		should: [ self moreThan3Elements first: self moreThan3Elements size + 1 ]
		raise: Error! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 14:27'!
collectionWith2TimeSubcollection
" return a collection including 'oldSubCollection'  two or many time "
	^ (((OrderedCollection new add: elementNotIn; yourself),self oldSubCollection ) add: elementNotIn;yourself),self  oldSubCollection! !

!OrderedCollectionTest methodsFor: 'tests - adding' stamp: ''!
testTWrite
	| added collection elem |
	collection := self otherCollection  .
	elem := self element .
	added := collection  write: elem .
	
	self assert: added == elem .	"test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection  includes: elem )	.
	self assert: (collection  includes: elem ).
	
	! !

!OrderedCollectionTest methodsFor: 'tests - puting with indexes' stamp: ''!
testFromToPut
	
	| collection index |
	index := self indexArray anyOne.
	collection := self nonEmpty copy.
	collection from: 1 to: index  put: self aValue..
	1 to: index do:
		[:i | self assert: (collection at: i)= self aValue].
	(index +1) to: collection size do:
		[:i | self assert: (collection at:i)= (self nonEmpty at:i)].! !

!OrderedCollectionTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithoutFirst

	| result |
	result := self nonEmpty copyWithoutFirst.
	
	self assert: result size = (self nonEmpty size - 1).
	
	1 to: result size do:
		[:i |
		self assert: (result at: i)= (self nonEmpty at: (i + 1))].! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0TStructuralEqualityTest
	self empty.
	self nonEmpty.
	self assert: self empty isEmpty.
	self deny: self nonEmpty isEmpty! !

!OrderedCollectionTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionTwoSimilarElementsInIntersection
	"self debug: #testIntersectionBasic"
	| inter |
	inter := self collection intersection: (self collectionClass with: self anotherElementOrAssociationIn).
	self assert: (self collection occurrencesOf: self anotherElementOrAssociationIn) = self numberOfSimilarElementsInIntersection.
	self assert: (inter includes: self anotherElementOrAssociationIn value)! !

!OrderedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testBefore
	"self debug: #testBefore"
	self assert: (self moreThan4Elements before: (self moreThan4Elements at: 2)) = (self moreThan4Elements at: 1).
	self 
		should: [ self moreThan4Elements before: (self moreThan4Elements at: 1) ]
		raise: Error.
	self 
		should: [ self moreThan4Elements before: 66 ]
		raise: Error! !

!OrderedCollectionTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testLastIndexOfDuplicate
	"self debug: #testLastIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection first.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'lastIndexOf: should return the position of the last occurrence :'"
	self assert: (collection lastIndexOf: element) = collection size! !

!OrderedCollectionTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAnyNoneThere
	"self debug: #testIncludesAnyOfNoneThere'"
	
	self deny: (self nonEmpty includesAny: self empty).
	self deny: (self nonEmpty includesAny: { self elementNotIn. self anotherElementNotIn })! !

!OrderedCollectionTest methodsFor: 'testing-public methods' stamp: 'StephaneDucasse 3/22/2010 21:17'!
testAddBeforeIndex
	"self run: #testAddBeforeIndex"
	| l |
	l := #(1 2 3 4) asOrderedCollection.
	l add: 77 beforeIndex: 1.
	self assert: (l =  #(77 1 2 3 4) asOrderedCollection).
	l add: 88 beforeIndex: 3.
	self assert: (l =  #(77 1 88 2 3 4) asOrderedCollection). 
	l add: 99 beforeIndex: l size+1.
	self assert: (l =  #(77 1 88 2 3 4 99) asOrderedCollection). 
	self should:[l add: 666 beforeIndex: 0] raise: Error.
	self should:[l add: 666 beforeIndex: l size+2] raise: Error.
	
	"Now make room by removing first two and last two elements,
	and see if the illegal bounds test still fails"
	(l first: 2) , (l last: 2) reversed do: [:e | l remove: e].
	self should:[l add: 666 beforeIndex: 0] raise: Error.
	self should:[l add: 666 beforeIndex: l size+2] raise: Error.

! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 10:56'!
collectionOfFloat
	^ collectionOfFloat ! !

!OrderedCollectionTest methodsFor: 'tests - adding' stamp: 'zz 12/7/2005 19:00'!
testAdd
	| l |
	l := #(1 2 3 4) asOrderedCollection.
	l add: 88.
	self assert: (l =  #(1 2 3 4 88) asOrderedCollection).
	l add: 99.
	self assert: (l =  #(1 2 3 4 88 99) asOrderedCollection). 

! !

!OrderedCollectionTest methodsFor: 'tests - sequence isempty' stamp: ''!
testSequenceIfNotEmptyifEmpty

	self assert: (self nonEmpty ifEmpty: [false] ifNotEmpty: [:s | (self accessValuePutInOn: s) = self valuePutIn])! !

!OrderedCollectionTest methodsFor: 'test - creation' stamp: ''!
testWith
	"self debug: #testWith"
	
	| aCol anElement |
	anElement := self collectionMoreThan5Elements anyOne.
	aCol := self collectionClass with: anElement.
	self assert: (aCol includes: anElement).! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'CamilloBruni 9/9/2011 12:12'!
collectionWithoutEqualElements

" return a collection not including equal elements "
	^ withoutEqualElements ! !

!OrderedCollectionTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedArray
	| result collection |
	collection := self collectionWithSortableElements .
	result := collection  asArray sort.
	self assert: (result class includesBehavior: Array).
	self assert: result isSorted.
	self assert: result size = collection size! !

!OrderedCollectionTest methodsFor: 'tests - converting' stamp: ''!
testAsArray
	"self debug: #testAsArray3"
	self 
		assertSameContents: self collectionWithoutEqualElements
		whenConvertedTo: Array! !

!OrderedCollectionTest methodsFor: 'tests - set arithmetic' stamp: ''!
testUnionOfEmpties
	"self debug: #testUnionOfEmpties"
	
	self assert:  (self empty union: self empty) isEmpty.
	
	! !

!OrderedCollectionTest methodsFor: 'tests - adding' stamp: ''!
testTWriteTwice
	| added oldSize collection elem |
	collection := self collectionWithElement .
	elem := self element .
	oldSize := collection  size.
	added := collection 
		write: elem ;
		write: elem .
	self assert: added == elem .	"test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection  includes: elem ).
	self assert: collection  size = (oldSize + 2)! !

!OrderedCollectionTest methodsFor: 'tests - copying part of sequenceable for multipliness' stamp: ''!
testCopyUpToWithDuplicate
	| result element  collection |
	collection := self collectionWithSameAtEndAndBegining .
	element := collection  last.
	
	" collectionWithSameAtEndAndBegining first and last elements are equals.
	'copyUpTo:' should copy until the first occurence :"
	result := collection   copyUpTo: (element ).
	
	"verifying content: "
	self assert: result isEmpty.

! !

!OrderedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindFirst

	| element result |
	element := self nonEmptyMoreThan1Element   at:1.
	 result:=self nonEmptyMoreThan1Element  findFirst: [:each | each =element].
	
	self assert: result=1. ! !

!OrderedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithIndexCollect
	
	| result index collection |
	index := 0.
	collection := self nonEmptyMoreThan1Element .
	result := collection  withIndexCollect: [:each :i | 
		self assert: i = (index := index + 1).	
		self assert: i = (collection  indexOf: each) .
		each] . 
	
	1 to: result size do:[: i | self assert: (result at:i)= (collection at: i)].
	self assert: result size = collection size.! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 15:41'!
firstIndex
" return an index between 'nonEmpty' bounds that is < to 'second index' "
	^1! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
testOFixtureReplacementSequencedTest

	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	
	self elementInForReplacement.
	self assert: (self nonEmpty includes: self elementInForReplacement ) .
	
	self newElement.
	
	self firstIndex.
	self assert: (self firstIndex >= 1 & self firstIndex <= self nonEmpty size).
	
	self secondIndex.
	self assert: (self secondIndex >= 1 & self secondIndex <= self nonEmpty size).
	
	self assert: self firstIndex <=self secondIndex .
	
	self replacementCollection.
	
	self replacementCollectionSameSize.
	self assert: (self secondIndex  - self firstIndex +1)= self replacementCollectionSameSize size
	! !

!OrderedCollectionTest methodsFor: 'tests - copy' stamp: ''!
testCopyNotSame
	"self debug: #testCopySameClass"
	"A copy of a collection should always be of the same class as the instance it copies"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: copy  == self nonEmpty.! !

!OrderedCollectionTest methodsFor: 'tests - adding' stamp: ''!
testTAddAll
	| added collection toBeAdded |
	collection := self collectionWithElement .
	toBeAdded := self otherCollection .
	added := collection addAll: toBeAdded .
	self assert: added == toBeAdded .	"test for identiy because #addAll: has not reason to copy its parameter."
	self assert: (collection includesAll: toBeAdded )! !

!OrderedCollectionTest methodsFor: 'tests - printing' stamp: ''!
testPrintElementsOn

	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printElementsOn: aStream .
	allElementsAsString:=(result findBetweenSubStrs: ' ' ).
	1 to: allElementsAsString size do:
		[:i | 
		self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString).
			].! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'DamienCassou 8/23/2013 10:30'!
unsortedCollection
	^ OrderedCollection new
		add: 3;
		add: 1;
		add: 20;
		add: 4;
		add: 2;
		yourself! !

!OrderedCollectionTest methodsFor: 'tests - adding' stamp: ''!
testTAddWithOccurences
	| added oldSize collection anElement |
	collection := self collectionWithElement .
	anElement := self element .
	oldSize := collection  size.
	added := collection  add: anElement withOccurrences: 5.
	
	self assert: added == anElement.	"test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection  includes: anElement).
	self assert: collection  size = (oldSize + 5)! !

!OrderedCollectionTest methodsFor: 'tests - begins ends with' stamp: ''!
testsEndsWithEmpty
	
	self deny: (self nonEmpty endsWith: self empty).
	self deny: (self empty endsWith: self nonEmpty).
	! !

!OrderedCollectionTest methodsFor: 'tests - removing' stamp: 'sd 3/21/2006 22:39'!
testRemoveFirst
	"Allows one to remove n element of a collection at the first"
	"self run:#testRemoveFirst" 
	
	| c1 |
	c1 := #(2 3 4 6) asOrderedCollection.
	c1 removeFirst: 1.
	self assert: (c1 = #(3 4 6) asOrderedCollection).
	c1 removeFirst: 2.
	self assert: (c1 = #(6) asOrderedCollection).
	self should: [c1 removeFirst: 10] raise: Error.
	
	! !

!OrderedCollectionTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithSequenceable

	| result index element |
	index := self indexInNonEmpty .
	element := self nonEmpty at: index.
	result := self nonEmpty copyWith: (element ).
	
	self assert: result size = (self nonEmpty size + 1).
	self assert: result last = element .
	
	1 to: (result size - 1) do:
	[ :i |
	self assert: (result at: i) = ( self nonEmpty at: ( i  ))].! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIterateSequencedReadableTest

	| res |
	
	self nonEmptyMoreThan1Element.
	self assert: self nonEmptyMoreThan1Element  size > 1.
	
	
	self empty.
	self assert: self empty isEmpty .
	
	res := true.
	self nonEmptyMoreThan1Element    
	detect: [ :each | (self nonEmptyMoreThan1Element    occurrencesOf: each) > 1 ]
	ifNone: [ res := false ].
	self assert: res = false.! !

!OrderedCollectionTest methodsFor: 'tests - concatenation' stamp: ''!
testConcatenationWithEmpty
	| result |
	result:= self empty,self secondCollection .
	
	1 to: self secondCollection size do:
		[:i | 
		self assert: (self secondCollection at:i)= (result at:i).
		].
	"size : "
	self assert: result size = ( self secondCollection size).! !

!OrderedCollectionTest methodsFor: 'tests - puting with indexes' stamp: ''!
testSwapWith
	"self debug: #testSwapWith"
	| result index |
	index := self indexArray anyOne.
	result:= self nonEmpty copy .
	result swap: index with: 1.
	self assert: (result at: index) = (self nonEmpty at:1).
	self assert: (result at: 1) = (self nonEmpty at: index).
	! !

!OrderedCollectionTest methodsFor: 'tests - copying part of sequenceable for multipliness' stamp: ''!
testCopyUpToLastWithDuplicate
	| result element  collection |
	collection := self collectionWithSameAtEndAndBegining .
	element := collection  first.
	
	" collectionWithSameAtEndAndBegining first and last elements are equals.
	'copyUpToLast:' should copy until the last occurence :"
	result := collection   copyUpToLast: (element ).
	
	"verifying content: "
	1 to: result size do:
		[:i |
		self assert: (result at: i ) = ( collection at: i )  
		].
	
	self assert: result size = (collection size - 1).

! !

!OrderedCollectionTest methodsFor: 'tests - includes' stamp: 'stephane.ducasse 11/21/2008 14:57'!
anotherElementNotIn
	^ 42! !

!OrderedCollectionTest methodsFor: 'tests - puting with indexes' stamp: ''!
testAtAllIndexesPut
	
	self nonEmpty atAllPut: self aValue.
	self nonEmpty do:[ :each| self assert: each = self aValue].
	! !

!OrderedCollectionTest methodsFor: 'tests - removing' stamp: 'sd 3/21/2006 22:39'!
testRemoveIfAbsent
	"Allows one to remove an element from a collection and to copy it in another collection."
	"If the element isn't in the first collection, the second collection copy the element after ifAbsent"
	"self run:#testRemoveIfAbsent"
	
	| c1 c2 |
	c1 := #(1 2 3 4) asOrderedCollection.
	c2 := OrderedCollection new.
	
	c2 add: (c1 remove: 2 ifAbsent: [6]).
	self assert: (c1 = #(1 3 4) asOrderedCollection).
	self assert: (c2 = #(2) asOrderedCollection).
	
	c2 add: (c1 remove: 18 ifAbsent: [6]).
	self assert: (c1 = #(1 3 4) asOrderedCollection).
	self assert: (c2 = #(2 6) asOrderedCollection).! !

!OrderedCollectionTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterLastEmpty

	| delim emptyStream |
	delim := ', '.
	emptyStream := ReadWriteStream on: ''.
	self empty asStringOn: emptyStream delimiter: delim last:'and'.
	self assert: emptyStream contents = ''.
! !

!OrderedCollectionTest methodsFor: 'tests - adding' stamp: 'zz 12/7/2005 18:59'!
testAddLast
	| l |
	l := #(1 2 3 4) asOrderedCollection.
	l addLast: 88.
	self assert: (l =  #(1 2 3 4 88) asOrderedCollection).
	l addLast: 99.
	self assert: (l =  #(1 2 3 4 88 99) asOrderedCollection). 

! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 13:40'!
collectionWith1TimeSubcollection
" return a collection including 'oldSubCollection'  only one time "
	^ ((OrderedCollection new add: elementNotIn; yourself),self oldSubCollection) add: elementNotIn;yourself   ! !

!OrderedCollectionTest methodsFor: 'tests - puting with indexes' stamp: ''!
testAtAllPut
	| |
	self nonEmpty atAll: self indexArray put: self aValue..
	
	self indexArray do:
		[:i | self assert: (self nonEmpty at: i)=self aValue ].
	! !

!OrderedCollectionTest methodsFor: 'tests - converting' stamp: 'TorstenBergmann 11/19/2014 12:33'!
testAsOrderedCollectionReturnsOrderedCollection
	
	self assert: #(5 4 3 ) asSortedCollection asOrderedCollection species == OrderedCollection ! !

!OrderedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testAtOutOfBounds
	"self debug: #testAtOutOfBounds"
	self 
		should: [ self moreThan4Elements at: self moreThan4Elements size + 1 ]
		raise: Error.
	self 
		should: [ self moreThan4Elements at: -1 ]
		raise: Error! !

!OrderedCollectionTest methodsFor: 'test - creation' stamp: ''!
testOfSize
	"self debug: #testOfSize"
	
	| aCol |
	aCol := self collectionClass ofSize: 3.
	self assert: (aCol size = 3).
! !

!OrderedCollectionTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOfEmpty
	| result |
	result := self empty occurrencesOf: (self collectionWithoutEqualElements anyOne).
	self assert: result = 0! !

!OrderedCollectionTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyEmpty
	"self debug: #testCopyEmpty"
	
	| copy | 
	copy := self empty copy.
	self assert: copy isEmpty.! !

!OrderedCollectionTest methodsFor: 'tests - enumerating' stamp: 'cm 3/8/2006 10:02'!
testWithCollect
	"Allows one to collect some element of two collections into another collection with element corresponding to the condition in the blocks"
	"self run: #testWithCollect"
	
	| c1 c2 res |
	c1 := #(-1 2 -3 4 -5 6 -7 8) asOrderedCollection.
	c2 := #(-9 10 -11 12 -13 14 -15 16) asOrderedCollection.
	res := c1 with: c2 collect: [:each1 :each2 | each1 < each2
		ifTrue: [each1]
		ifFalse: [each2]].
	self assert: (res = #(-9 2 -11 4 -13 6 -15 8) asOrderedCollection).
	! !

!OrderedCollectionTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterLastOne

	| delim oneItemStream result |
	
	delim := ', '.
	result:=''.
	oneItemStream := ReadWriteStream on: result.
	self nonEmpty1Element  asStringOn: oneItemStream delimiter: delim last: 'and'.
	oneItemStream do:[:each | self assert: each = (self nonEmpty1Element first asString)].
	

	! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSetAritmeticTest
	self collection.
	self deny: self collection isEmpty.
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self anotherElementOrAssociationNotIn.
	self collection isDictionary
		ifTrue: [ self deny: (self collection associations includes: self anotherElementOrAssociationNotIn key) ]
		ifFalse: [ self deny: (self collection includes: self anotherElementOrAssociationNotIn) ].
	self collectionClass! !

!OrderedCollectionTest methodsFor: 'tests - printing' stamp: ''!
testPrintOnDelimiter
	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printOn: aStream delimiter: ', ' .
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString).
			].! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 11:03'!
elementInCollectionOfFloat
	^ collectionOfFloat anyOne.! !

!OrderedCollectionTest methodsFor: 'tests - adding' stamp: ''!
testTAddTwice
	| added oldSize collection anElement |
	collection := self collectionWithElement .
	anElement := self element .
	oldSize := collection  size.
	added := collection 
		add: anElement ;
		add: anElement .
	self assert: added == anElement .	"test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection  includes: anElement ).
	self assert: collection  size = (oldSize + 2)! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/23/2009 11:17'!
collectionWithoutNilElements
" return a collection that doesn't includes a nil element  and that doesn't includes equal elements'"
	^ withoutEqualElements ! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixturePutTest
	self aValue.
	self anotherValue.
	
	self anIndex.
	self nonEmpty isDictionary 
		ifFalse:[self assert: (self anIndex >=1 & self anIndex <= self nonEmpty size).].
	
	self empty.
	self assert: self empty isEmpty .
	
	self nonEmpty.
	self deny: self nonEmpty  isEmpty.! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureTConvertTest
	"a collection of number without equal elements:"

	| res |
	self collectionWithoutEqualElements.
	res := true.
	self collectionWithoutEqualElements
		detect: [ :each | (self collectionWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false! !

!OrderedCollectionTest methodsFor: 'tests - replacing' stamp: ''!
testReplaceFromToWithStartingAt
	| result  repStart collection replacementCollec firstInd secondInd |
	collection := self nonEmpty .
	result := collection copy.
	replacementCollec := self replacementCollectionSameSize .
	firstInd := self firstIndex .
	secondInd := self secondIndex .
	repStart := replacementCollec  size - ( secondInd  - firstInd   + 1 ) + 1.
	result replaceFrom: firstInd  to: secondInd with: replacementCollec  startingAt: repStart   .
	
	"verify content of 'result' : "
	"first part of 'result'' : '" 
	
	1 to: ( firstInd  - 1 ) do: [ :i | self assert: ( collection  at:i ) = ( result at: i ) ].
	
	" middle part containing replacementCollection : "
	
	( firstInd ) to: ( replacementCollec   size - repStart +1 ) do: 
		[:i|
		self assert: (result at: i)=( replacementCollec   at: ( repStart  + ( i  - firstInd  ) ) ) ].
	
	" end part :"
	( firstInd  + replacementCollec   size ) to: ( result size ) do:
		[ :i |
		self assert: ( result at: i ) = ( collection  at: ( secondInd  + 1 - ( firstInd  + replacementCollec   size ) + i ) ) ].! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: ''!
valueArray
" return a collection (with the same size than 'indexArray' )of values to be put in 'nonEmpty'  at indexes in 'indexArray' "
	| result |
	result := Array new: self indexArray size.
	1 to: result size do:
		[:i |
		result at:i put: (self aValue ).
		].
	^ result.! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIncludeWithIdentityTest
	| anElement |
	self collectionWithCopyNonIdentical.
	anElement := self collectionWithCopyNonIdentical anyOne.
	self deny: anElement == anElement copy! !

!OrderedCollectionTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterMore

	| delim multiItemStream result index |
	"delim := ', '.
	multiItemStream := '' readWrite.
	self oneTwoThreeItemCol asStringOn: multiItemStream delimiter: ', '.
	self assert: multiItemStream contents = '1, 2, 3'."
	
	delim := ', '.
	result:=''.
	multiItemStream := ReadWriteStream on:result.
	self nonEmpty  asStringOn: multiItemStream delimiter: ', '.
	
	index:=1.
	(result findBetweenSubStrs: ', ' )do:
		[:each |
		self assert: each= ((self nonEmpty at:index)asString).
		index:=index+1
		].! !

!OrderedCollectionTest methodsFor: 'tests - remove' stamp: ''!
testRemoveElementThatExists
	"self debug: #testRemoveElementThatExists"

	| el res |
	el := self nonEmptyWithoutEqualElements anyOne.
	res := self nonEmptyWithoutEqualElements remove: el.
	self assert: res == el! !

!OrderedCollectionTest methodsFor: 'helpers' stamp: 'stephane.ducasse 1/12/2009 17:13'!
anIndex

	^ 2! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 13:59'!
collectionMoreThan5Elements
" return a collection including at least 5 elements"
	
	^collection5Elements ! !

!OrderedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testDetectSequenced
" testing that detect keep the first element returning true for sequenceable collections "

	| element result |
	element := self nonEmptyMoreThan1Element   at:1.
	result:=self nonEmptyMoreThan1Element  detect: [:each | each notNil ].
	self assert: result = element. ! !

!OrderedCollectionTest methodsFor: 'tests - includes' stamp: ''!
testIdentityIncludesNonSpecificComportement
	" test the same comportement than 'includes: '  "
	| collection |	
	collection := self nonEmpty  .
	
	self deny: (collection identityIncludes: self elementNotIn ).
	self assert:(collection identityIncludes: collection anyOne)
! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureAsStringCommaAndDelimiterTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty.
	self nonEmpty1Element.
	self assert: self nonEmpty1Element size = 1! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/23/2009 15:16'!
collectionMoreThan1NoDuplicates
	" return a collection of size 5 without equal elements"
	^ withoutEqualElements ! !

!OrderedCollectionTest methodsFor: 'tests - enumerating' stamp: 'sd 3/21/2006 22:41'!
testCollect
	"Allows one to collect some element of a collection into another collection"
	"self run: #testCollect"
	 
	| c1 c2 res |
	c1 := #(-1 2 -3 4) asOrderedCollection.
	c2 := #(1 2 3 4) asOrderedCollection.
	res := c1 collect: [:each | each abs].
	self assert: (c2 = res).! !

!OrderedCollectionTest methodsFor: 'tests - enumerating' stamp: ''!
testFlattened

	self assert: self simpleCollection flattened equals: #(1 8 3).
	self assert: self collectionOfCollectionsOfInts flattened equals: #( 1 2 3 4 5 6 ).
	self assert: self collectionWithCharacters flattened equals: #($a $x $d $c $m).
	self assert: self collectionOfCollectionsOfStrings flattened equals: #('foo' 'bar' 'zorg').! !

!OrderedCollectionTest methodsFor: 'as yet unclassified' stamp: ''!
testSorted
	| result tmp unsorted |
	unsorted := self unsortedCollection.
	result := unsorted sorted.
	self deny: unsorted == result.
	tmp := result at: 1.
	result
		do: [ :each | 
			self assert: each >= tmp.
			tmp := each ]! !

!OrderedCollectionTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAnyAllThere
	"self debug: #testIncludesAnyOfAllThere'"
	self deny: (self nonEmpty includesAny: self empty).
	self assert: (self nonEmpty includesAny: { self nonEmpty anyOne }).
	self assert: (self nonEmpty includesAny: self nonEmpty).! !

!OrderedCollectionTest methodsFor: 'test - copy' stamp: 'delaunay 4/17/2009 15:26'!
elementToAdd
	^ 55! !

!OrderedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testPairsDo
	| index |
	index:=1.
	
	self nonEmptyMoreThan1Element  pairsDo: 
		[:each1 :each2 | 
		self assert:(self nonEmptyMoreThan1Element at:index)=each1.
		self assert:(self nonEmptyMoreThan1Element at:(index+1))=each2.
		index:=index+2].
	
	self nonEmptyMoreThan1Element size odd
		ifTrue:[self assert: index=self nonEmptyMoreThan1Element size]
		ifFalse:[self assert: index=(self nonEmptyMoreThan1Element size+1)].! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: ''!
collectionWithCopy
	"return a collection of type 'self collectionWIithoutEqualsElements class' containing no elements equals ( with identity equality)
	but  2 elements only equals with classic equality"
	| result collection |
	collection := OrderedCollection withAll: self elementsCopyNonIdenticalWithoutEqualElements.
	collection add: collection first copy.
	result := self elementsCopyNonIdenticalWithoutEqualElements class withAll: collection.
	^ result! !

!OrderedCollectionTest methodsFor: 'tests - subcollections access' stamp: ''!
testLastNElements
	"self debug: #testLastNElements"
	| result |
	result := self moreThan3Elements last: self moreThan3Elements size - 1.
	1 
		to: result size
		do: [ :i | self assert: (result at: i) = (self moreThan3Elements at: i + 1) ].
	self assert: result size = (self moreThan3Elements size - 1).
	self 
		should: [ self moreThan3Elements last: self moreThan3Elements size + 1 ]
		raise: Error! !

!OrderedCollectionTest methodsFor: 'tests - enumerating' stamp: 'cm 3/8/2006 09:09'!
testCollectFromTo
	"Allows one to collect some element of a collection into another collection between a first index and an end index for the collect"
	"self run: #testCollectFromTo"
	
	| c1 res |
	c1 := #(-1 2 -3 4 -5 6 -7 8) asOrderedCollection.
	res := c1 collect: [:each | each abs] from: 1 to: 3.
	self assert: (res = #(1 2 3) asOrderedCollection).
	self should: [c1 collect: [:each | each abs] from: 10 to: 13] raise: Error.
	self should: [c1 collect: [:each | each abs] from: 5 to: 2] raise: Error.! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'stephane.ducasse 10/30/2008 19:03'!
accessCollection

	^ indexCollection! !

!OrderedCollectionTest methodsFor: 'tests - enumerating' stamp: ''!
testFlatCollect

	self assert: (self simpleCollection flatCollect: [ :x | { x } ]) equals: self simpleCollection.
	self assert: (self simpleCollection flatCollect: [ :x | { x } ]) species = self simpleCollection species.
	
	self 
		assert: (self collectionOfCollectionsOfInts flatCollect: [ :x | { x } ]) 
		equals: self collectionOfCollectionsOfInts.
	self 
		assert: (self collectionWithCharacters flatCollect: [ :x | { x } ]) 
		equals: self collectionWithCharacters.
	self 
		assert: (self collectionOfCollectionsOfStrings flatCollect: [ :x | { x } ]) 
		equals: self collectionOfCollectionsOfStrings! !

!OrderedCollectionTest methodsFor: 'tests - printing' stamp: ''!
testPrintNameOn

	| aStream result |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printNameOn: aStream .
	Transcript show: result asString.
	self nonEmpty class name first isVowel
		ifTrue:[ self assert: aStream contents =('an ',self nonEmpty class name ) ]
		ifFalse:[self assert: aStream contents =('a ',self nonEmpty class name)].! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0SortingArrayedTest
	| tmp sorted |
	" an unsorted collection of number "
	self unsortedCollection.
	self unsortedCollection do: [ :each | each isNumber ].
	sorted := true.
	self unsortedCollection
		pairsDo: [ :each1 :each2 | 
			each2 < each1
				ifTrue: [ sorted := false ] ].
	self assert: sorted = false.	" a collection of number sorted in an ascending order"
	self sortedInAscendingOrderCollection.
	self sortedInAscendingOrderCollection do: [ :each | each isNumber ].
	tmp := self sortedInAscendingOrderCollection at: 1.
	self sortedInAscendingOrderCollection
		do: [ :each | 
			self assert: each >= tmp.
			tmp := each ]! !

!OrderedCollectionTest methodsFor: 'tests - copying with replacement' stamp: ''!
testCopyReplaceAllWithManyOccurence
	| result firstIndexesOfOccurrence resultBetweenPartIndex collectionBetweenPartIndex diff |
	" testing fixture here as this method may be not used for collection that can't contain equals element :"
	self collectionWith2TimeSubcollection.
	self assert: (self howMany: self oldSubCollection in: self collectionWith2TimeSubcollection) = 2.	" test :"
	diff := self replacementCollection size - self oldSubCollection size.
	result := self collectionWith2TimeSubcollection copyReplaceAll: self oldSubCollection with: self replacementCollection.	"detecting indexes of olSubCollection"
	firstIndexesOfOccurrence := self firstIndexesOf: self oldSubCollection in: self collectionWith2TimeSubcollection.	" verifying that replacementCollection has been put in places of oldSubCollections "
	firstIndexesOfOccurrence
		do: [ :each | 
			(firstIndexesOfOccurrence indexOf: each) = 1
				ifTrue: [ each to: self replacementCollection size do: [ :i | self assert: (result at: i) = (self replacementCollection at: i - each + 1) ] ]
				ifFalse: [ each + diff to: self replacementCollection size do: [ :i | self assert: (result at: i) = (self replacementCollection at: i - each + 1) ] ] ].	" verifying that the 'between' parts correspond to the initial collection : "
	1 to: firstIndexesOfOccurrence size do: [ :i | 
		i = 1
			ifTrue: [ 1 to: (firstIndexesOfOccurrence at: i) - 1 do: [ :j | self assert: (result at: i) = (self collectionWith2TimeSubcollection at: i) ] ]
			ifFalse: [ 
				resultBetweenPartIndex := (firstIndexesOfOccurrence at: i - 1) + self replacementCollection size.
				collectionBetweenPartIndex := (firstIndexesOfOccurrence at: i - 1) + self oldSubCollection size.
				1 to: (firstIndexesOfOccurrence at: i) - collectionBetweenPartIndex - 1 do: [ :j | 
					self
						assert:
							(result at: resultBetweenPartIndex + i - 1)
								= (self collectionWith2TimeSubcollection at: collectionBetweenPartIndex + i - 1) ] ]	" specific comportement for the begining of the collection :"	" between parts till the end : " ].	"final part :"
	1 to: self collectionWith2TimeSubcollection size - (firstIndexesOfOccurrence last + self oldSubCollection size) do: [ :i | 
		self
			assert:
				(result at: firstIndexesOfOccurrence last + self replacementCollection size - 1 + i)
					= (self collectionWith2TimeSubcollection at: firstIndexesOfOccurrence last + self oldSubCollection size - 1 + i) ]! !

!OrderedCollectionTest methodsFor: 'test - equality' stamp: ''!
testEqualSignIsTrueForNonIdenticalButEqualCollections
	"self debug: #testEqualSignIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty = self empty copy). 
	self assert: (self empty copy = self empty).
	self assert: (self empty copy = self empty copy).
		
	self assert: (self nonEmpty = self nonEmpty copy). 
	self assert: (self nonEmpty copy = self nonEmpty).
	self assert: (self nonEmpty copy = self nonEmpty copy).! !

!OrderedCollectionTest methodsFor: 'tests - adding' stamp: 'CamilloBruni 8/31/2013 20:23'!
testAtIfAbsentPut
	"Allows one to add an element at an index if no element exist at this index"

	"self run:#testAtIfAbsentPut"

	| c |
	c := #(1 2 3 4) asOrderedCollection.
	c at: 2 ifAbsentPut: [ 5 ].
	self assert: c = #(1 2 3 4) asOrderedCollection.
	c at: 5 ifAbsentPut: [ 5 ].
	self assert: c = #(1 2 3 4 5) asOrderedCollection.
	c at: 7 ifAbsentPut: [ 7 ].
	self assert: c = #(1 2 3 4 5 nil 7) asOrderedCollection! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 11:42'!
elementInForElementAccessing
" return an element inculded in 'accessCollection '"
	^ self accessCollection anyOne! !

!OrderedCollectionTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testIndexOfStartingAtDuplicate
	"self debug: #testLastIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection last.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'indexOf:ifAbsent:startingAt: should return the position of the first occurrence :'"
	self assert: (collection 
			indexOf: element
			startingAt: 1
			ifAbsent: [ 55 ]) = 1.
	self assert: (collection 
			indexOf: element
			startingAt: 2
			ifAbsent: [ 55 ]) = collection size! !

!OrderedCollectionTest methodsFor: 'tests - copying with replacement' stamp: ''!
testCopyReplaceFromToWithInsertion
	| result  indexOfSubcollection |
	
	indexOfSubcollection := (self firstIndexesOf: self oldSubCollection  in:  self collectionWith1TimeSubcollection) at: 1. 
	
	result := self collectionWith1TimeSubcollection  copyReplaceFrom: indexOfSubcollection  to: ( indexOfSubcollection - 1 ) with: self replacementCollection .
	
	"verify content of 'result' : "
	"first part of 'result'' : '"
	
	1 to: (indexOfSubcollection -1) do: 
		[
		:i | 
		self assert: (self collectionWith1TimeSubcollection  at:i)=(result at: i)
		].
	
	" middle part containing replacementCollection : "
	indexOfSubcollection  to: (indexOfSubcollection  + self replacementCollection size-1) do: 
		[
		:i |
		self assert: ( result at: i )=(self replacementCollection at: ( i - indexOfSubcollection +1 ))
		].
	
	" end part :"
	(indexOfSubcollection  + self replacementCollection size) to: (result size) do:
		[:i|
		self assert: (result at: i)=(self collectionWith1TimeSubcollection  at: (i-self replacementCollection size))].
	
	" verify size: "	
	self assert: result size=(self collectionWith1TimeSubcollection  size + self replacementCollection size).
	

	

	
	! !

!OrderedCollectionTest methodsFor: 'tests - replacing' stamp: ''!
testReplaceFromToWith
	| result  collection replacementCollec firstInd secondInd |
	collection := self nonEmpty .
	replacementCollec := self replacementCollectionSameSize .
	firstInd := self firstIndex .
	secondInd := self secondIndex .
	result := collection  copy.
	result replaceFrom: firstInd  to: secondInd  with: replacementCollec .
	
	"verify content of 'result' : "
	"first part of 'result'' : '"
	
	1 to: ( firstInd - 1 ) do: [ :i | self assert: (collection  at:i ) = ( result at: i ) ].
	
	" middle part containing replacementCollection : "
	
	( firstInd ) to: ( firstInd  + replacementCollec size - 1 ) do: 
		[ :i |
		self assert: ( result at: i ) = ( replacementCollec  at: ( i - firstInd  +1 ) ) 
		].
	
	" end part :"
	( firstInd  + replacementCollec   size) to: (result size) do:
		[:i|
		self assert: ( result at: i ) = ( collection at: ( secondInd  + 1 - ( firstInd + replacementCollec size ) + i ) ) ].
	
	! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 15:42'!
newElement
"return an element that will be put in the collection in place of another"
	^999! !

!OrderedCollectionTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsCommaStringMore

	"self assert: self oneTwoThreeItemCol asCommaString = '1, 2, 3'.
	self assert: self oneTwoThreeItemCol asCommaStringAnd = '1, 2 and 3'
"

	| result resultAnd index allElementsAsString |
	result:= self nonEmpty asCommaString .
	resultAnd:= self nonEmpty asCommaStringAnd .
 
	index := 1.
	(result findBetweenSubStrs: ',' )do:
		[:each |
		index = 1
			ifTrue: [self assert: each= ((self nonEmpty at:index)asString)]
			ifFalse: [self assert: each= (' ',(self nonEmpty at:index) asString)].
		index:=index+1
		].
	
	"verifying esultAnd :"
	allElementsAsString:=(resultAnd findBetweenSubStrs: ',' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size )
			ifTrue: [
			i = 1
				ifTrue:[self assert: (allElementsAsString at:i)=((self nonEmpty at:i) asString)]
				ifFalse:[self assert: (allElementsAsString at:i)=(' ',(self nonEmpty at:i) asString)]
				].
		i=(allElementsAsString size)
			ifTrue:[ 
			i = 1
				ifTrue:[self assert: (allElementsAsString at:i)=( (self nonEmpty at:i ) asString ,' and ', (self nonEmpty at: ( i + 1) ) asString )]
				ifFalse:[self assert: (allElementsAsString at:i)=( ' ' , (self nonEmpty at:i ) asString ,' and ', (self nonEmpty at: ( i + 1) ) asString )]
				].
		
		
			].! !

!OrderedCollectionTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWith
	"self debug: #testCopyNonEmptyWith"
	| res anElement |
	anElement := self elementToAdd .
	res := self nonEmpty copyWith: anElement.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self assert: (res includes: (anElement value)).
	self nonEmpty do: [ :each | res includes: each ]! !

!OrderedCollectionTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfterLastEmpty
	| result |
	result := self empty copyAfterLast: self collectionWithoutEqualElements first.
	self assert: result isEmpty.! !

!OrderedCollectionTest methodsFor: 'tests - adding' stamp: 'sd 3/21/2006 22:36'!
testAddAllFirstUnlessAlreadyPresent
	"Allows one to add each element of an orderedCollection at the beginning of
	another orderedCollection preserving the order but no duplicate element"
	"self run:#testAddAllFirstUnlessAlreadyPresent" 
	
	| c1 c2 c3 |
	c1 := #(1 2 3 4 ) asOrderedCollection.
	c2 := #(5 6 7 8 9 ) asOrderedCollection.
	c3 := #(0 1 ) asOrderedCollection.
	c2 addAllFirstUnlessAlreadyPresent: c1.
	self assert: c2 = #(1 2 3 4 5 6 7 8 9 ) asOrderedCollection.
	c1 addAllFirstUnlessAlreadyPresent: c3.
	self deny: c1 = #(0 1 1 2 3 4 ) asOrderedCollection.
	self assert: c1 = #(0 1 2 3 4 ) asOrderedCollection.
	! !

!OrderedCollectionTest methodsFor: 'tests - copy' stamp: 'delaunay 3/30/2009 10:33'!
testCopyNonEmptyWithoutAllNotIncluded
	! !

!OrderedCollectionTest methodsFor: 'tests - index access' stamp: ''!
testIdentityIndexOfIAbsent
	| collection element |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			identityIndexOf: element
			ifAbsent: [ 0 ]) = 1.
	self assert: (collection 
			identityIndexOf: self elementNotInForIndexAccessing
			ifAbsent: [ 55 ]) = 55! !

!OrderedCollectionTest methodsFor: 'tests - puting with indexes' stamp: ''!
testAtAllPutAll

	| aValueArray |
	aValueArray := self valueArray .
	self nonEmpty atAll: self indexArray putAll: aValueArray  .
	
	1 to: self indexArray size do:
		[:i |
		self assert: (self nonEmpty at:(self indexArray at: i))= (aValueArray  at:i) ]! !

!OrderedCollectionTest methodsFor: 'testsRemoving' stamp: 'nice 9/14/2009 20:57'!
testRemoveAll
	"Allows one to remove all elements of a collection" 
	
	| c1 c2 s2 |
	c1 := #(2 3 4 6) asOrderedCollection.
	c1 addAll: (1 to: 200).
	c2 := c1 copy.
	s2 := c2 size.
	
	c1 removeAll.
	
	self assert: c1 size = 0.
	self assert: c2 size = s2 description: 'the copy has not been modified'
	! !

!OrderedCollectionTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyEmptyMethod
	| result |
	result := self collectionWithoutEqualElements  copyEmpty .
	self assert: result isEmpty .
	self assert: result class= self nonEmpty class.! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 5/13/2009 16:10'!
collectionWithEqualElements
" return a collecition including atLeast two elements equal"

^collectionWithDuplicateElement ! !

!OrderedCollectionTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfSubCollectionStartingAt
	"self debug: #testIndexOfIfAbsent"
	| subcollection index collection |
	collection := self collectionMoreThan1NoDuplicates.
	subcollection := self collectionMoreThan1NoDuplicates.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 1.
	self assert: index = 1.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 2.
	self assert: index = 0! !

!OrderedCollectionTest methodsFor: 'tests - adding' stamp: 'zz 12/7/2005 18:58'!
testAddFirst
	| l |
	l := #(1 2 3 4) asOrderedCollection.
	l addFirst: 88.
	self assert: (l =  #(88 1 2 3 4) asOrderedCollection).
	l addFirst: 99.
	self assert: (l =  #(99 88 1 2 3 4) asOrderedCollection). 

! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/24/2009 10:24'!
collectionWithSortableElements
" return a collection elements that can be sorte ( understanding message ' < '  or ' > ')"
	^ collectionOfFloat ! !

!OrderedCollectionTest methodsFor: 'tests - copying part of sequenceable for multipliness' stamp: ''!
testCopyAfterWithDuplicate
	| result element  collection |
	collection := self collectionWithSameAtEndAndBegining .
	element := collection  last.
	
	" collectionWithSameAtEndAndBegining first and last elements are equals.
	'copyAfter:' should copy after the first occurence :"
	result := collection   copyAfter: (element ).
	
	"verifying content: "
	1 to: result size do: 
		[:i |
		self assert: (collection  at:(i + 1 )) = (result at: (i))
		].

	"verify size: "
	self assert: result size = (collection size - 1).! !

!OrderedCollectionTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedCollectionWithSortBlock
	| result tmp |
	result := self collectionWithSortableElements  asSortedCollection: [:a :b | a > b].
	self assert: (result class includesBehavior: SortedCollection).
	result do: 
		[ :each | 
		self assert: (self collectionWithSortableElements   occurrencesOf: each) = (result occurrencesOf: each) ].
	self assert: result size = self collectionWithSortableElements  size.
	tmp:=result at: 1.
	result do: [:each| self assert: tmp>=each. tmp:=each].
	! !

!OrderedCollectionTest methodsFor: 'tests - enumerating' stamp: ''!
testFlatCollectAs

	self 
		assert: (self simpleCollection flatCollect: [ :x | { x }, { x } ] as: IdentitySet) 
		equals: self simpleCollection asIdentitySet! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:23'!
test0FixtureTConvertAsSetForMultiplinessTest
	"a collection ofFloat with equal elements:"

	| res |
	self withEqualElements.
	self withEqualElements do: [ :each | self assert: each class = Float ].
	res := true.
	self withEqualElements detect: [ :each | (self withEqualElements occurrencesOf: each) > 1 ] ifNone: [ res := false ].
	self assert: res = true.	"a collection of Float without equal elements:"
	self elementsCopyNonIdenticalWithoutEqualElements.
	self elementsCopyNonIdenticalWithoutEqualElements do: [ :each | self assert: each class = Float ].
	res := true.
	self elementsCopyNonIdenticalWithoutEqualElements
		detect: [ :each | (self elementsCopyNonIdenticalWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false! !

!OrderedCollectionTest methodsFor: 'tests - sorting' stamp: ''!
testSortedUsingBlock
	| result tmp |
	result := self unsortedCollection sorted:  [:a :b | a>b]..
	tmp := result at: 1.
	result do:
		[:each | self assert: each<=tmp. tmp:= each. ].! !

!OrderedCollectionTest methodsFor: 'tests - adding' stamp: 'zz 12/7/2005 19:07'!
testAddItem2
	| collection |
	collection := #('Jim' 'Mary' 'John' 'Andrew' ) asOrderedCollection.
	collection add: 'James' before: 'Jim'.
	collection add: 'Margaret' before: 'Andrew'.
	self assert: (collection indexOf: 'James')
			+ 1
			= (collection indexOf: 'Jim').
	self assert: (collection indexOf: 'Margaret')
			+ 1
			= (collection indexOf: 'Andrew')! !

!OrderedCollectionTest methodsFor: 'tests - index access' stamp: ''!
testIdentityIndexOf
	"self debug: #testIdentityIndexOf"
	| collection element |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection identityIndexOf: element) = (collection indexOf: element)! !

!OrderedCollectionTest methodsFor: 'test - creation' stamp: ''!
testWithAll
	"self debug: #testWithAll"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection .
	aCol := self collectionClass withAll: collection  .
	
	collection do: [ :each | self assert: (aCol occurrencesOf: each ) = ( collection occurrencesOf: each ) ].
	
	self assert: (aCol size = collection size ).! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIndexAccessTest
	| res collection element |
	self collectionMoreThan1NoDuplicates.
	self assert: self collectionMoreThan1NoDuplicates size > 1.
	res := true.
	self collectionMoreThan1NoDuplicates
		detect: [ :each | (self collectionMoreThan1NoDuplicates occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false.
	self elementInForIndexAccessing.
	self
		assert: ((collection := self collectionMoreThan1NoDuplicates) includes: (element := self elementInForIndexAccessing)).
	self elementNotInForIndexAccessing.
	self deny: (self collectionMoreThan1NoDuplicates includes: self elementNotInForIndexAccessing)! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureOccurrencesTest
	| tmp |
	self empty.
	self assert: self empty isEmpty.
	self collectionWithoutEqualElements.
	self deny: self collectionWithoutEqualElements isEmpty.
	tmp := OrderedCollection new.
	self collectionWithoutEqualElements
		do: [ :each | 
			self deny: (tmp includes: each).
			tmp add: each ].
	self elementNotInForOccurrences.
	self deny: (self collectionWithoutEqualElements includes: self elementNotInForOccurrences)! !

!OrderedCollectionTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyCreatesNewObject
	"self debug: #testCopyCreatesNewObject"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: self nonEmpty == copy.
	! !

!OrderedCollectionTest methodsFor: 'tests - adding' stamp: 'zz 12/7/2005 18:57'!
testAddBefore

	| l |
	l := #(1 2 3 4) asOrderedCollection.
	l add: 88 before: 1.
	self assert: (l =  #(88 1 2 3 4) asOrderedCollection).
	l add: 99 before: 2.
	self assert: (l =  #(88 1 99 2 3 4) asOrderedCollection). 

! !

!OrderedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithDo
	
	| firstCollection secondCollection index |

	firstCollection := self nonEmptyMoreThan1Element.
	secondCollection := firstCollection copy.
	index := 0.
	
	firstCollection  with: secondCollection do:
		[:a :b |
		( index := index + 1).
		self assert: (firstCollection at: index) equals:  a. 
		self assert: (secondCollection at: index) equals:  b.]
	
	! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 12/18/2009 13:11'!
secondCollection
" return a collection that will be the second part of the concatenation"
	^ collectionWith4Elements ! !

!OrderedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithDoError
	
	self should: [self nonEmptyMoreThan1Element with: self empty do:[:a :b | ]] raise: Error.! !

!OrderedCollectionTest methodsFor: 'tests - adding' stamp: 'sd 6/5/2005 09:21'!
testAddItem1

   | collection size |
   collection := #('Jim' 'Mary' 'John' 'Andrew' ) asOrderedCollection.
   size := collection size.
   collection add: 'James' before: 'Jim'.
   collection add: 'Margaret' before: 'Andrew'.
   self assert: size + 2 = collection size.
! !

!OrderedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testAtWrap
	"self debug: #testAt"
	"
	self assert: (self accessCollection at: 1) = 1.
	self assert: (self accessCollection at: 2) = 2.
	"
	| index |
	index := self moreThan4Elements indexOf: self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: index) = self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: index + self moreThan4Elements size) = self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: index - self moreThan4Elements size) = self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: 1 + self moreThan4Elements size) = (self moreThan4Elements at: 1)! !

!OrderedCollectionTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithout
	"self debug: #testCopyNonEmptyWithout"
	
	| res anElementOfTheCollection |
	anElementOfTheCollection :=  self nonEmpty anyOne.
	res := (self nonEmpty copyWithout: anElementOfTheCollection).
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self deny: (res includes: anElementOfTheCollection).
	self nonEmpty do:
		[:each | (each = anElementOfTheCollection) 
					ifFalse: [self assert: (res includes: each)]].
	
! !

!OrderedCollectionTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutNotIncluded
	"self debug: #testCopyNonEmptyWithoutNotIncluded"
	| res |
	res := self nonEmpty copyWithout: self elementToAdd.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self nonEmpty do: [ :each | self assert: (res includes: each) ]! !

!OrderedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testAllButFirstDo
	
	| result |
	result:= OrderedCollection  new.
	
	self nonEmptyMoreThan1Element  allButFirstDo: [:each | result add: each].
	
	1 to: (result size) do:
		[:i|
		self assert: (self nonEmptyMoreThan1Element  at:(i +1))=(result at:i)].
	
	self assert: result size=(self nonEmptyMoreThan1Element  size-1).! !

!OrderedCollectionTest methodsFor: 'tests - concatenation' stamp: ''!
testConcatenation
	| result index |
	result:= self firstCollection,self secondCollection .
	"first part : "
	index := 1.
	self firstCollection do: 
		[:each | 
		self assert: (self firstCollection at: index)=each.
		index := index+1.].
	"second part : "
	1 to: self secondCollection size do:
		[:i | 
		self assert: (self secondCollection at:i)= (result at:index).
		index:=index+1].
	"size : "
	self assert: result size = (self firstCollection size + self secondCollection size).! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'DamienCassou 8/23/2013 10:28'!
sortedInAscendingOrderCollection
	" return a collection sorted in an acsending order"

	^ OrderedCollection new
		add: 1;
		add: 2;
		add: 3;
		add: 4;
		add: 5;
		yourself! !

!OrderedCollectionTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionItself
	"self debug: #testIntersectionItself"
	
	| result |
	result :=  (self collectionWithoutEqualElements intersection: self collectionWithoutEqualElements).
	self assert: result size  = self collectionWithoutEqualElements size.
	self collectionWithoutEqualElements do: [ :each|
		self assert: (result includes: each) ].
	! !

!OrderedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testKeysAndValuesDo
	"| result |
	result:= OrderedCollection new.
	
	self nonEmptyMoreThan1Element  keysAndValuesDo: 
		[:i :value|
		result add: (value+i)].
	
	1 to: result size do:
		[:i|
		self assert: (result at:i)=((self nonEmptyMoreThan1Element at:i)+i)]"
	|  indexes elements |
	indexes:= OrderedCollection new.
	elements := OrderedCollection new.
	
	self nonEmptyMoreThan1Element  keysAndValuesDo: 
		[:i :value|
		indexes  add: (i).
		elements add: value].
	
	(1 to: self nonEmptyMoreThan1Element size )do:
		[ :i |
		self assert: (indexes at: i) = i.
		self assert: (elements at: i) = (self nonEmptyMoreThan1Element at: i).	
		].
	
	self assert: indexes size = elements size. 
	self assert: indexes size = self nonEmptyMoreThan1Element size . 
	
	! !

!OrderedCollectionTest methodsFor: 'tests - converting' stamp: ''!
testAsOrderedCollection
	
	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: OrderedCollection! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 5/13/2009 16:10'!
elementTwiceInForOccurrences
" return an element included exactly two time in # collectionWithEqualElements"
^ duplicateElement ! !

!OrderedCollectionTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOf
	| collection |
	collection := self collectionWithoutEqualElements .
	
	collection do: [ :each | self assert: (collection occurrencesOf: each) = 1 ].! !

!OrderedCollectionTest methodsFor: 'setup' stamp: 'stephane.ducasse 10/6/2008 16:29'!
emptyButAllocatedWith20 

	^ emptyButAllocatedWith20! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0CopyTest
	self empty.
	self assert: self empty size = 0.
	self nonEmpty.
	self assert: (self nonEmpty size = 0) not.
	self collectionWithElementsToRemove.
	self assert: (self collectionWithElementsToRemove size = 0) not.
	self collectionWithElementsToRemove do: [ :each | self assert: (self nonEmpty includes: each) ].
	self elementToAdd.
	self deny: (self nonEmpty includes: self elementToAdd).
	self collectionNotIncluded.
	self collectionNotIncluded do: [ :each | self deny: (self nonEmpty includes: each) ]! !

!OrderedCollectionTest methodsFor: 'tests - streaming' stamp: ''!
testStreamContentsProtocol
	| result index |
	result:= self collectionClass << [ :s|
		s 
			nextPutAll: self firstCollection;
			nextPutAll: self secondCollection ].
	self assert: result equals: self firstCollection, self secondCollection.! !

!OrderedCollectionTest methodsFor: 'tests - copying' stamp: 'stephane.ducasse 1/12/2009 15:02'!
testCopyEmptyOld
	"Allows one to create a copy of the receiver that contains no elements"
	"self run:#testCopyEmpty"
	
	| c1 c2 |
	c1 := #(1 2 3 4 ) asOrderedCollection.
	c2 := c1 copyEmpty.
	self assert: (c2 size = 0).! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 14:16'!
collectionWithNonIdentitySameAtEndAndBegining
	" return a collection with elements at end and begining equals only with classic equality (they are not the same object).
(others elements of the collection are not equal to those elements)"
	^ floatCollectionWithSameBeginingEnd ! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 14:44'!
indexInNonEmpty
" return an index between bounds of 'nonEmpty' "

	^ 2! !

!OrderedCollectionTest methodsFor: 'test - remove' stamp: ''!
testRemoveElementThatExistsTwice
	"self debug: #testRemoveElementThatDoesExistsTwice"

	| size |
	size := self nonEmpty size.
	self assert: (self nonEmpty includes: self elementTwiceIn).
	self nonEmpty remove: self elementTwiceIn.
	self assert: size - 1 = self nonEmpty size.
	
	self assert: (self nonEmpty includes: self elementTwiceIn).
	self nonEmpty remove: self elementTwiceIn.
	self assert: size - 2 = self nonEmpty size! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 12/18/2009 12:05'!
result

^ collectResult ! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 10:22'!
collectionWithCopyNonIdentical
	" return a collection that include elements for which 'copy' return a different object (this is not the case of SmallInteger)"
	^ collectionOfFloat! !

!OrderedCollectionTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWithout
	"self debug: #testCopyEmptyWithout"
	| res |
	res := self empty copyWithout: self elementToAdd.
	self assert: res size = self empty size.
	self deny: (res includes: self elementToAdd)! !

!OrderedCollectionTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedCollection

	| aCollection result |
	aCollection := self collectionWithSortableElements .
	result := aCollection asSortedCollection.
	
	self assert: (result class includesBehavior: SortedCollection).
	result do: 
		[ :each | 
		self assert: (aCollection occurrencesOf: each) = (result occurrencesOf: each) ].
	
	self assert: result size = aCollection size.! !

!OrderedCollectionTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testIdentityIndexOfDuplicate
	"self debug: #testIdentityIndexOf"

	| collection element |
	"testing fixture here as this method may not be used by some collections testClass"
	self collectionWithNonIdentitySameAtEndAndBegining.
	collection := self collectionWithNonIdentitySameAtEndAndBegining.
	self assert: collection first = collection last.
	self deny: collection first == collection last.
	1 to: collection size do: [ :i | 
		i > 1 & (i < collection size)
			ifTrue: [ self deny: (collection at: i) = collection first ] ].
	element := collection last.	" floatCollectionWithSameAtEndAndBegining first and last elements are equals but are not the same object"
	self assert: (collection identityIndexOf: element) = collection size! !

!OrderedCollectionTest methodsFor: 'test - creation' stamp: 'stephane.ducasse 12/9/2008 18:31'!
collectionClass 
	
	^ OrderedCollection! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 14:57'!
nonEmpty1Element
" return a collection of size 1 including one element"
	^ OrderedCollection new add:( self nonEmpty anyOne); yourself.! !

!OrderedCollectionTest methodsFor: 'tests - begins ends with' stamp: ''!
testsBeginsWith
	
	self assert: (self nonEmpty beginsWith:(self nonEmpty copyUpTo: self nonEmpty last)).
	self assert: (self nonEmpty beginsWith:(self nonEmpty )).
	self deny: (self nonEmpty beginsWith:(self nonEmpty copyWith:self nonEmpty first)).! !

!OrderedCollectionTest methodsFor: 'tests - set arithmetic' stamp: ''!
testUnion
	"self debug: #testUnionOfEmpties"
	
	| union |
	union := self empty union: self nonEmpty.
	self containsAll: union of: self empty andOf: self nonEmpty.
	union := self nonEmpty union: self empty.
	self containsAll: union of: self empty andOf: self nonEmpty.
	union := self collection union: self nonEmpty.
	self containsAll: union of: self collection andOf: self nonEmpty.! !

!OrderedCollectionTest methodsFor: 'tests - copying' stamp: 'sd 3/21/2006 22:41'!
testCopyReplaceFromToWith
	"Allows one to create a copy from the receiver which elements between start and end of the 	receiver being replace by 	element of the collection after with:"
	"self run:#testCopyReplaceFromToWith"

	| c1 c2 c3 c4 |
	c1 := #(1 2 3 4) asOrderedCollection.
	c2 := #(5 6 7 8 9) asOrderedCollection.
	c3 := (c2 copyReplaceFrom: 1 to: 2 with: c1).
	self assert: c3 = #(1 2 3 4 7 8 9) asOrderedCollection.
	self should: [c2 copyReplaceFrom: 3 to: 1 with: c1] raise: Error.
	
	c4 := (c2 copyReplaceFrom: 10 to: 25 with: c1).
	self assert: c4 = #(5 6 7 8 9 1 2 3 4) asOrderedCollection.
	
	! !

!OrderedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testDo! !

!OrderedCollectionTest methodsFor: 'tests - begins ends with' stamp: ''!
testsBeginsWithEmpty
	
	self deny: (self nonEmpty beginsWith:(self empty)).
	self deny: (self empty beginsWith:(self nonEmpty )).
! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSequencedConcatenationTest
	self empty.
	self assert: self empty isEmpty.
	self firstCollection.
	self secondCollection! !

!OrderedCollectionTest methodsFor: 'tests - equality' stamp: ''!
testHasEqualElements
	"self debug: #testHasEqualElements"

	self deny: (self empty hasEqualElements: self nonEmpty).
	self deny: (self nonEmpty hasEqualElements: self nonEmpty asSet). 
	self deny: (self nonEmpty reversed hasEqualElements: self nonEmpty).
	self deny: (self nonEmpty hasEqualElements: self nonEmpty reversed).! !

!OrderedCollectionTest methodsFor: 'testing-public methods' stamp: 'StephaneDucasse 3/22/2010 21:18'!
testAddAfterIndex
	"self run: #testAddAfterIndex"
	| l |
	l := #(1 2 3 4) asOrderedCollection.
	l add: 77 afterIndex: 0.
	self assert: (l =  #(77 1 2 3 4) asOrderedCollection).
	l add: 88 afterIndex: 2.
	self assert: (l =  #(77 1 88 2 3 4) asOrderedCollection). 
	l add: 99 afterIndex: l size.
	self assert: (l =  #(77 1 88 2 3 4 99) asOrderedCollection). 
	self should:[l add: 666 afterIndex: -1] raise: Error.
	self should:[l add: 666 afterIndex: l size+1] raise: Error.
	
	"Now make room by removing first two and last two elements,
	and see if the illegal bounds test still fails"
	(l first: 2) , (l last: 2) reversed do: [:e | l remove: e].
	self should: [l add: 666 afterIndex: -1] raise: Error.
	self should: [l add: 666 afterIndex: l size+1] raise: Error.! !

!OrderedCollectionTest methodsFor: 'parameters' stamp: 'stephane.ducasse 10/5/2008 12:38'!
selectorToAccessValuePutIn
	"return the selector of the method that should be invoked to access an element"
	
	^ #first! !

!OrderedCollectionTest methodsFor: 'tests - copying same contents' stamp: ''!
testShuffled
	| result |
	result := self nonEmpty shuffled .
	
	"verify content of 'result: '"
	result do: [:each | self assert: (self nonEmpty occurrencesOf: each)=(result occurrencesOf: each)].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!OrderedCollectionTest methodsFor: 'tests - equality' stamp: ''!
testHasEqualElementsIsTrueForNonIdenticalButEqualCollections
	"self debug: #testHasEqualElementsIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty hasEqualElements: self empty copy). 
	self assert: (self empty copy hasEqualElements: self empty).
	self assert: (self empty copy hasEqualElements: self empty copy).
		
	self assert: (self nonEmpty hasEqualElements: self nonEmpty copy). 
	self assert: (self nonEmpty copy hasEqualElements: self nonEmpty).
	self assert: (self nonEmpty copy hasEqualElements: self nonEmpty copy).! !

!OrderedCollectionTest methodsFor: 'tests - as identity set' stamp: ''!
testAsIdentitySetWithIdentityEqualsElements
	| result |
	result := self collectionWithIdentical asIdentitySet.
	" Only one element should have been removed as two elements are equals with Identity equality"
	self assert: result size = (self collectionWithIdentical size - 1).
	self collectionWithIdentical do: 
		[ :each | 
		(self collectionWithIdentical occurrencesOf: each) > 1 
			ifTrue: 
				[ "the two elements equals only with classic equality shouldn't 'have been removed"
				self assert: (result asOrderedCollection occurrencesOf: each) = 1
				" the other elements are still here" ]
			ifFalse: [ self assert: (result asOrderedCollection occurrencesOf: each) = 1 ] ].
	self assert: result class = IdentitySet! !

!OrderedCollectionTest methodsFor: 'test - equality' stamp: ''!
testEqualSign
	"self debug: #testEqualSign"

	self deny: (self empty = self nonEmpty).! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0TSequencedStructuralEqualityTest
	self nonEmpty at: 1	"Ensures #nonEmpty is sequenceable"! !

!OrderedCollectionTest methodsFor: 'tests - copy' stamp: ''!
testCopySameClass
	"self debug: #testCopySameClass"
	"A copy of a collection should always be of the same class as the instance it copies"
	
	| copy | 
	copy := self empty copy.
	self assert: copy class == self empty class.! !

!OrderedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testAfter
	"self debug: #testAfter"
	self assert: (self moreThan4Elements after: (self moreThan4Elements at: 1)) = (self moreThan4Elements at: 2).
	self 
		should: 
			[ self moreThan4Elements after: (self moreThan4Elements at: self moreThan4Elements size) ]
		raise: Error.
	self 
		should: [ self moreThan4Elements after: self elementNotInForElementAccessing ]
		raise: Error! !

!OrderedCollectionTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfter
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyAfter: (collection  at:index ).
	
	"verifying content: "
	(1) to: result size do: 
		[:i |
		self assert: (collection   at:(i + index ))=(result at: (i))].

	"verify size: "
	self assert: result size = (collection   size - index).! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureAsSetForIdentityMultiplinessTest
	"a collection (of elements for which copy is not identical ) without equal elements:"

	| anElement res |
	self elementsCopyNonIdenticalWithoutEqualElements.
	anElement := self elementsCopyNonIdenticalWithoutEqualElements anyOne.
	self deny: anElement copy == anElement.
	res := true.
	self elementsCopyNonIdenticalWithoutEqualElements
		detect: [ :each | (self elementsCopyNonIdenticalWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 13:38'!
oldSubCollection
" return a subCollection included in collectionWith1TimeSubcollection .
ex :   subCollection := #( 2 3 4) and collectionWith1TimeSubcollection := #(1 2 3 4 5)"
	^ nonEmpty ! !

!OrderedCollectionTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButFirstNElements
	"self debug: #testAllButFirst"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButFirst: 2.
	1 
		to: abf size
		do: [ :i | self assert: (abf at: i) = (col at: i + 2) ].
	self assert: abf size + 2 = col size! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixturePrintTest
	self nonEmpty! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'SebastianTleye 6/26/2013 11:23'!
collectionOfCollectionsOfInts
	^collectionOfCollectionsOfInts.! !

!OrderedCollectionTest methodsFor: 'tests - sorting' stamp: ''!
testIsSortedBy
	self assert: (self sortedInAscendingOrderCollection isSortedBy: [:a :b | a<b]).
	self deny: (self sortedInAscendingOrderCollection isSortedBy: [:a :b | a>b]).
! !

!OrderedCollectionTest methodsFor: 'tests - adding' stamp: 'zz 12/7/2005 13:42'!
testAddBeforeAndRemove

	| l initialCollection |
	l := #(1 2 3 4) asOrderedCollection.
	initialCollection := l shallowCopy.
	l add: 88 before: 1.
	self assert: (l =  #(88 1 2 3 4) asOrderedCollection).
	l add: 99 before: 2.
	self assert: (l =  #(88 1 99 2 3 4) asOrderedCollection). 
	l remove: 99.
	l remove: 88.
	self assert: l = initialCollection.

! !

!OrderedCollectionTest methodsFor: 'tests - copying' stamp: 'sd 3/21/2006 22:41'!
testCopyFromTo
	"Allows one to create a copy of the receiver that contains elements from position start to end"
	"self run: #testCopyFromTo"
	
	| c1 c2 c3 | 
	c1 := #(1 2 3 4) asOrderedCollection.
	c2 := (c1 copyFrom: 1 to: 2).
	self assert: c2 = #(1 2) asOrderedCollection.
	self should: [c1 copyFrom: 10 to: 20] raise: Error.
	
	c3 := c1 copyFrom: 4 to: 2.
	self assert: c3 isEmpty.
	
	self should: [c1 copyFrom: 4 to: 5 ] raise: Error.
	
	
	
! !

!OrderedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testReverseWithDo
	
	| firstCollection secondCollection index |

	firstCollection := self nonEmptyMoreThan1Element.
	secondCollection := firstCollection copy.
	index := firstCollection size.
	
	firstCollection  reverseWith: secondCollection do:
		[:a :b |
	
		self assert: (firstCollection at: index) equals:  a. 
		self assert: (secondCollection at: index) equals:  b.
			( index := index - 1).]
	
	
	! !

!OrderedCollectionTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAllNoneThere
	"self debug: #testIncludesAllOfNoneThere'"
	self deny: (self empty includesAll: self nonEmpty ).
	self deny: (self nonEmpty includesAll: { self elementNotIn. self anotherElementNotIn })! !

!OrderedCollectionTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfStartingAt
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			indexOf: element
			startingAt: 2
			ifAbsent: [ 99 ]) = 99.
	self assert: (collection 
			indexOf: element
			startingAt: 1
			ifAbsent: [ 99 ]) = 1.
	self assert: (collection 
			indexOf: self elementNotInForIndexAccessing
			startingAt: 1
			ifAbsent: [ 99 ]) = 99! !

!OrderedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testKeysAndValuesDoEmpty
	| result |
	result:= OrderedCollection new.
	
	self empty  keysAndValuesDo: 
		[:i :value|
		result add: (value+i)].
	
	self assert: result isEmpty .! !

!OrderedCollectionTest methodsFor: 'tests - enumerating' stamp: ''!
testFlatCollectAsSet

	self 
		assert: (self simpleCollection flatCollectAsSet: [ :x | { x }, { x } ]) 
		equals: self simpleCollection asSet! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 11:42'!
elementNotInForElementAccessing
" return an element not included in 'accessCollection' "
	^ elementNotIn ! !

!OrderedCollectionTest methodsFor: 'tests - as set tests' stamp: ''!
testAsSetWithEqualsElements
	| result |
	result := self withEqualElements asSet.
	self withEqualElements do: [ :each | self assert: (result occurrencesOf: each) = 1 ].
	self assert: result class = Set! !

!OrderedCollectionTest methodsFor: 'tests - printing' stamp: ''!
testPrintOnDelimiterLast

	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printOn: aStream delimiter: ', ' last: 'and'.
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 )
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString)].
		i=(allElementsAsString size-1)
			ifTrue:[ self deny: (allElementsAsString at:i)=('and')asString].
		i=(allElementsAsString size)
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:(i-1))asString)].
			].! !

!OrderedCollectionTest methodsFor: 'tests - converting' stamp: ''!
testAsBag

	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: Bag! !

!OrderedCollectionTest methodsFor: 'tests - copying part of sequenceable for multipliness' stamp: ''!
testCopyAfterLastWithDuplicate
	| result element  collection |
	collection := self collectionWithSameAtEndAndBegining .
	element := collection  first.
	
	" collectionWithSameAtEndAndBegining first and last elements are equals.
	'copyAfter:' should copy after the last occurence of element :"
	result := collection   copyAfterLast: (element ).
	
	"verifying content: "
	self assert: result isEmpty.

! !

!OrderedCollectionTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWith
	"self debug: #testCopyWith"
	| res anElement |
	anElement := self elementToAdd.
	res := self empty copyWith: anElement.
	self assert: res size = (self empty size + 1).
	self assert: (res includes: (anElement value))! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 14:35'!
indexInForCollectionWithoutDuplicates
" return an index between 'collectionWithoutEqualsElements'  bounds"
	^ 2! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
howMany: aSubCollection in: collection
" return an integer representing how many time 'subCollection'  appears in 'collection'  "
	| tmp nTime |
	tmp := collection.
	nTime:= 0.
	
	[tmp isEmpty ]whileFalse:
		[
		(tmp beginsWith: aSubCollection)
			ifTrue: [ 	
				nTime := nTime + 1.
				1 to: aSubCollection size do: [:i | tmp := tmp copyWithoutFirst.]
				]
			ifFalse: [tmp := tmp copyWithoutFirst.]
		 ].
	
	^ nTime.
	! !

!OrderedCollectionTest methodsFor: 'tests - removing' stamp: 'sd 3/21/2006 22:39'!
testRemoveAt
	"Allows one to remove an element from a collection at an index"
	"self run:#testRemoveAt" 
	
	| c1 |
	c1 := #(2 3 4 6) asOrderedCollection.
	c1 removeAt: 2.
	self assert: (c1 = #(2 4 6) asOrderedCollection).
	self should: [c1 removeAt: 10] raise: Error.
	self should: [c1 removeAt: -1] raise: Error.
	! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/22/2009 10:21'!
collectionWith5Elements
" return a collection of size 5 including 5 elements"
^ indexCollection ! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureConverAsSortedTest
	self collectionWithSortableElements.
	self deny: self collectionWithSortableElements isEmpty! !

!OrderedCollectionTest methodsFor: 'tests - printing' stamp: ''!
testStoreOn
" for the moment work only for collection that include simple elements such that Integer"

"| string str result cuttedResult index elementsAsStringExpected elementsAsStringObtained tmp |
string := ''.
str := ReadWriteStream  on: string.
elementsAsStringExpected := OrderedCollection new.
elementsAsStringObtained := OrderedCollection new.
self nonEmpty do: [ :each | elementsAsStringExpected  add: each asString].

self nonEmpty storeOn: str.
result := str contents .
cuttedResult := ( result findBetweenSubStrs: ';' ).

index := 1.

cuttedResult do:
	[ :each |
	index = 1 
		ifTrue: [ self assert: (each beginsWith: ( tmp := '((' , self nonEmpty class asString , ' new) add: '           )).
				tmp := each copyFrom: ( tmp size + 1) to: ( each size ).
				elementsAsStringObtained add: tmp.
				index := index + 1. ]
		ifFalse:  [ 
		 index < cuttedResult size
			ifTrue:[self assert: (each beginsWith: ( tmp:=  ' add: '   )).
				tmp := each copyFrom: ( tmp size + 1) to: ( each size ).
				elementsAsStringObtained add: tmp.
					index := index + 1.]
			ifFalse: [self assert: ( each = ' yourself)' ) ].
			]
	
	].


	elementsAsStringExpected do: [ :each | self assert: (elementsAsStringExpected occurrencesOf: each ) = ( elementsAsStringObtained occurrencesOf: each) ]"

! !

!OrderedCollectionTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfStartingAtIfAbsent
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			indexOf: element
			startingAt: 2
			ifAbsent: [ 99 ]) = 99.
	self assert: (collection 
			indexOf: element
			startingAt: 1
			ifAbsent: [ 99 ]) = 1.
	self assert: (collection 
			indexOf: self elementNotInForIndexAccessing
			startingAt: 1
			ifAbsent: [ 99 ]) = 99! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'SebastianTleye 6/26/2013 12:43'!
collectionOfCollectionsOfStrings
	^collectionOfCollectionsOfStrings.! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 14:37'!
integerCollection
" return a collection only including SmallInteger elements"
	^ indexCollection ! !

!OrderedCollectionTest methodsFor: 'tests - replacing' stamp: ''!
testReplaceAllWith
	| result  collection oldElement newElement oldOccurrences |
	collection := self nonEmpty .
	result := collection  copy.
	oldElement := self elementInForReplacement .
	newElement := self newElement .
	oldOccurrences := (result occurrencesOf: oldElement) + (result occurrencesOf: newElement).
	result replaceAll: oldElement  with: newElement  .
	
	self assert: oldOccurrences = (result occurrencesOf: newElement)! !

!OrderedCollectionTest methodsFor: 'tests - set arithmetic' stamp: ''!
numberOfSimilarElementsInIntersection
	^ self collection occurrencesOf: self anotherElementOrAssociationIn! !

!OrderedCollectionTest methodsFor: 'tests - occurrencesOf for multipliness' stamp: ''!
testOccurrencesOfForMultipliness

| collection elem |
collection := self collectionWithEqualElements .
elem := self elementTwiceInForOccurrences .

self assert: (collection occurrencesOf: elem ) = 2.  ! !

!OrderedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testAtAll
	"self debug: #testAtAll"
	"	self flag: #theCollectionshouldbe102030intheFixture.
	
	self assert: (self accessCollection atAll: #(2 1)) first = self accessCollection second.
	self assert: (self accessCollection atAll: #(2)) first = self accessCollection second."
	| result |
	result := self moreThan4Elements atAll: #(2 1 2 ).
	self assert: (result at: 1) = (self moreThan4Elements at: 2).
	self assert: (result at: 2) = (self moreThan4Elements at: 1).
	self assert: (result at: 3) = (self moreThan4Elements at: 2).
	self assert: (self moreThan4Elements atAll: #()) = self moreThan4Elements species new! !

!OrderedCollectionTest methodsFor: 'tests - remove' stamp: ''!
testRemoveElementReallyRemovesElement
	"self debug: #testRemoveElementReallyRemovesElement"
	| size |
	size := self nonEmptyWithoutEqualElements size.
	self nonEmptyWithoutEqualElements remove: self nonEmptyWithoutEqualElements anyOne.
	self assert: size - 1 = self nonEmptyWithoutEqualElements size! !

!OrderedCollectionTest methodsFor: 'tests - converting' stamp: ''!
assertNonDuplicatedContents: aCollection whenConvertedTo: aClass 
	| result |
	result := aCollection perform: ('as' , aClass name) asSymbol.
	self assert: (result class includesBehavior: aClass).
	result do: 
		[ :each | 
		self assert: (aCollection occurrencesOf: each) = (result occurrencesOf: each) ].
	^ result! !

!OrderedCollectionTest methodsFor: 'tests - copying same contents' stamp: ''!
testShallowCopy
	| result |
	result := self nonEmpty shallowCopy .
	
	"verify content of 'result: '"
	1 to: self nonEmpty size do:
		[:i | self assert: ((result at:i)=(self nonEmpty at:i))].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!OrderedCollectionTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfIfAbsent
	"self debug: #testIndexOfIfAbsent"
	| collection |
	collection := self collectionMoreThan1NoDuplicates.
	self assert: (collection 
			indexOf: collection first
			ifAbsent: [ 33 ]) = 1.
	self assert: (collection 
			indexOf: self elementNotInForIndexAccessing
			ifAbsent: [ 33 ]) = 33! !

!OrderedCollectionTest methodsFor: 'tests - streaming' stamp: ''!
testStreamContentsSized
	| result |
	result:= self collectionClass new: 1 streamContents: [ :s|
		s 
			nextPutAll: self firstCollection;
			nextPutAll: self secondCollection ].
	self assert: result equals: self firstCollection, self secondCollection.
	
	result:= self collectionClass new: 1000 streamContents: [ :s|
		s 
			nextPutAll: self firstCollection;
			nextPutAll: self secondCollection ].
	self assert: result equals: self firstCollection, self secondCollection.! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyPartOfSequenceableTest
	self collectionWithoutEqualElements.
	self collectionWithoutEqualElements
		do: [ :each | self assert: (self collectionWithoutEqualElements occurrencesOf: each) = 1 ].
	self indexInForCollectionWithoutDuplicates.
	self
		assert:
			(self indexInForCollectionWithoutDuplicates > 0 & self indexInForCollectionWithoutDuplicates)
				< self collectionWithoutEqualElements size.
	self empty.
	self assert: self empty isEmpty! !

!OrderedCollectionTest methodsFor: 'test - creation' stamp: ''!
testWithWithWith
	"self debug: #testWithWithWith"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom:1 to: 3 .
	aCol := self collectionClass with: (collection at:1) with: ( collection at:2 ) with: ( collection at: 3).

	1 to: 3 do: [ :i | self assert: ( aCol occurrencesOf: ( collection at: i ) ) = ( collection occurrencesOf: ( collection at: i ) ) ].! !

!OrderedCollectionTest methodsFor: 'tests - converting' stamp: ''!
testAsIdentitySet
	"test with a collection without equal elements :"
	self 
		assertSameContents: self collectionWithoutEqualElements
		whenConvertedTo: IdentitySet.
! !

!OrderedCollectionTest methodsFor: 'tests - converting' stamp: ''!
testAsByteArray
	| res |
	self integerCollectionWithoutEqualElements.
	self integerCollectionWithoutEqualElements do: [ :each | self assert: each class = SmallInteger ].
	res := true.
	self integerCollectionWithoutEqualElements
		detect: [ :each | (self integerCollectionWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false.
	self assertSameContents: self integerCollectionWithoutEqualElements whenConvertedTo: ByteArray! !

!OrderedCollectionTest methodsFor: 'tests - converting' stamp: ''!
testAsSet
	| |
	"test with a collection without equal elements :"
	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: Set.
	! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyWithOrWithoutSpecificElementsTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self indexInNonEmpty.
	self assert: self indexInNonEmpty > 0.
	self assert: self indexInNonEmpty <= self nonEmpty size! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 11:32'!
elementNotInForIndexAccessing

	^ elementNotIn ! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 15:12'!
firstCollection
" return a collection that will be the first part of the concatenation"
	^ nonEmpty 	! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 11:00'!
collectionInForIncluding
	^ self nonEmpty copyWithoutFirst.! !

!OrderedCollectionTest methodsFor: 'parameters' stamp: ''!
accessValuePutIn
	"return access the element put in the non-empty collection"
	
	^ self perform: self selectorToAccessValuePutIn! !

!OrderedCollectionTest methodsFor: 'parameters' stamp: ''!
valuePutIn
	"the value that we will put in the non empty collection"
	
	^ #x! !

!OrderedCollectionTest methodsFor: 'tests - includes' stamp: ''!
testIncludesElementIsThere
	"self debug: #testIncludesElementIsThere"
	
	self assert: (self nonEmpty includes: self nonEmpty anyOne).! !

!OrderedCollectionTest methodsFor: 'tests - sorting' stamp: ''!
testSortUsingSortBlock
	| result tmp |
	result := self unsortedCollection sort: [:a :b | a>b].
	tmp := result at: 1.
	result do:
		[:each | self assert: each<=tmp. tmp:= each. ].! !

!OrderedCollectionTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifferenceWithSeparateCollection
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifferenceWithSeparateCollection"
	| res separateCol |
	
	separateCol := self collectionClass with: self anotherElementOrAssociationNotIn.
	res := self collectionWithoutEqualElements difference: separateCol.
	
	self deny: (res includes: self anotherElementOrAssociationNotIn).
	self assert: res size equals: self collectionWithoutEqualElements size.
	
	self collectionWithoutEqualElements do: [ :each|
		self assert: (res includes: each)].
	
	res := separateCol difference: self collection.
	self deny: (res includes: self collection anyOne).
	self assert: res equals: separateCol! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureEmptySequenceableTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!OrderedCollectionTest methodsFor: 'tests - adding' stamp: 'sd 3/21/2006 22:36'!
testAddAllFirst
	"Allows one to add each element of an orderedCollection at the beginning of another
	orderedCollection "
	"self run:#testAddAllFirst" 
	
	| c1 c2 |
	c1 := #(1 2 3 4 ) asOrderedCollection.
	c2 := #(5 6 7 8 9 ) asOrderedCollection.
	c2 addAllFirst: c1.
	self assert: c2 = #(1 2 3 4 5 6 7 8 9) asOrderedCollection! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'sd 1/28/2009 16:29'!
collectionWithElement
	"Returns a collection that already includes what is returned by #element."
	^ collectionWithElement! !

!OrderedCollectionTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfSubCollectionStartingAtIfAbsent
	"self debug: #testIndexOfIfAbsent"
	| index absent subcollection collection |
	collection := self collectionMoreThan1NoDuplicates.
	subcollection := self collectionMoreThan1NoDuplicates.
	absent := false.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 1
		ifAbsent: [ absent := true ].
	self assert: absent = false.
	absent := false.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 2
		ifAbsent: [ absent := true ].
	self assert: absent = true! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 14:11'!
withEqualElements
	" return a collection of float including equal elements (classic equality)"
	^ collectionOfFloat , collectionOfFloat! !

!OrderedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testAtLastError
	"self debug: #testAtLast"
	self 
		should: [ self moreThan4Elements atLast: self moreThan4Elements size + 1 ]
		raise: Error! !

!OrderedCollectionTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpToLastEmpty
	| result |
	result := self empty copyUpToLast: self collectionWithoutEqualElements first.
	self assert: result isEmpty.! !

!OrderedCollectionTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpToLast
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyUpToLast: (collection  at:index).
	
	"verify content of 'result' :"
	1 to: result size do: [:i| self assert: (collection   at:i)=(result at:i)].
	
	"verify size of 'result' :"
	self assert: result size = (index-1).! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCloneTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!OrderedCollectionTest methodsFor: 'tests - adding' stamp: ''!
testTAddIfNotPresentWithElementAlreadyIn

	| added oldSize collection anElement |
	collection := self collectionWithElement .
	oldSize := collection size.
	anElement := self element .
	self assert: (collection  includes: anElement ).
	
	added := collection  addIfNotPresent: anElement .
	
	self assert: added == anElement .	"test for identiy because #add: has not reason to copy its parameter."
	self assert: collection  size = oldSize! !

!OrderedCollectionTest methodsFor: 'tests - printing' stamp: ''!
testPrintOn
	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printOn: aStream .
	allElementsAsString:=(result findBetweenSubStrs: ' ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i=1
			ifTrue:[
			self accessCollection class name first isVowel 
				ifTrue:[self assert: (allElementsAsString at:i)='an' ]
				ifFalse:[self assert: (allElementsAsString at:i)='a'].].
		i=2
			ifTrue:[self assert: (allElementsAsString at:i)=self accessCollection class name].
		i>2
			ifTrue:[self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString).].	
			].! !

!OrderedCollectionTest methodsFor: 'tests - at put' stamp: ''!
testAtPutTwoValues
	"self debug: #testAtPutTwoValues"
	
	self nonEmpty at: self anIndex put: self aValue.
	self nonEmpty at: self anIndex put: self anotherValue.
	self assert: (self nonEmpty at: self anIndex) = self anotherValue.! !

!OrderedCollectionTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpTo
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyUpTo: (collection  at:index).
	
	"verify content of 'result' :"
	1 to: result size do: [:i| self assert: (collection   at:i)=(result at:i)].
	
	"verify size of 'result' :"
	self assert: result size = (index-1).
	! !

!OrderedCollectionTest methodsFor: 'tests - remove' stamp: ''!
testRemoveElementFromEmpty
	"self debug: #testRemoveElementFromEmpty"
	self 
		should: [ self empty remove: self nonEmptyWithoutEqualElements anyOne ]
		raise: Error! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 11:22'!
collectionWithElementsToRemove
	^ nonEmpty copyWithoutFirst.! !

!OrderedCollectionTest methodsFor: 'tests - copying' stamp: 'zz 12/7/2005 13:47'!
testReversed
	| collection1 collection2 |
	collection1 := #('Jim' 'Mary' 'John' 'Andrew' ) asOrderedCollection.
	collection2 := collection1 reversed.
	self assert: collection2 first = 'Andrew'.
	self assert: collection2 last = 'Jim'! !

!OrderedCollectionTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterLastMore

	| delim multiItemStream result last allElementsAsString |
	
	delim := ', '.
	last := 'and'.
	result:=''.
	multiItemStream := ReadWriteStream on:result.
	self nonEmpty  asStringOn: multiItemStream delimiter: ', ' last: last.
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 )
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString)].
		i=(allElementsAsString size-1)
			ifTrue:[ self deny: (allElementsAsString at:i)=(last)asString].
		i=(allElementsAsString size)
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:(i-1))asString)].
			].
	
! !

!OrderedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testLast
	"self debug: #testLast"
	self assert: self moreThan4Elements last = (self moreThan4Elements at: self moreThan4Elements size)! !

!OrderedCollectionTest methodsFor: 'tests - converting' stamp: 'TorstenBergmann 11/19/2014 10:28'!
testAsOrderedCollectionKeepsIdentity
	
	|x y|
	x := (1 to: 5) asOrderedCollection.
	y := x asOrderedCollection.
	self assert: y identityHash = x identityHash  ! !

!OrderedCollectionTest methodsFor: 'test - iterate' stamp: 'luc.fabresse 11/29/2008 23:09'!
expectedSizeAfterReject
	^1! !

!OrderedCollectionTest methodsFor: 'test - remove' stamp: 'damienpollet 1/30/2009 17:16'!
elementTwiceIn
	^ super elementTwiceIn! !

!OrderedCollectionTest methodsFor: 'tests - adding' stamp: ''!
testTAdd
	| added collection |
	collection :=self otherCollection .
	added := collection add: self element.
	
	self assert: added == self element.	"test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection includes: self element)	.
	self assert: (self collectionWithElement includes: self element).
	
	! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIncludeTest
	| anElementIn |
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self elementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self elementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self anotherElementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self anotherElementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self empty.
	self assert: self empty isEmpty! !

!OrderedCollectionTest methodsFor: 'tests - includes' stamp: 'CamilloBruni 8/31/2013 20:23'!
testIdentityIncludes
	" test the comportement in presence of elements 'includes' but not 'identityIncludes' "

	" can not be used by collections that can't include elements for wich copy doesn't return another instance "

	| collection element |
	self collectionWithCopyNonIdentical.
	collection := self collectionWithCopyNonIdentical.
	element := collection anyOne copy.	"self assert: (collection includes: element)."
	self deny: (collection identityIncludes: element)! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIndexAccessFotMultipliness
	self collectionWithSameAtEndAndBegining.
	self assert: self collectionWithSameAtEndAndBegining first = self collectionWithSameAtEndAndBegining last.
	self assert: self collectionWithSameAtEndAndBegining size > 1.
	1 to: self collectionWithSameAtEndAndBegining size do: [ :i | 
		i > 1 & (i < self collectionWithSameAtEndAndBegining size)
			ifTrue: [ self deny: (self collectionWithSameAtEndAndBegining at: i) = self collectionWithSameAtEndAndBegining first ] ]! !

!OrderedCollectionTest methodsFor: 'tests - includes' stamp: 'delaunay 4/2/2009 11:53'!
testIncludesElementIsNotThere
	"self debug: #testIncludesElementIsNotThere"
	self deny: (self nonEmpty includes: self elementNotInForOccurrences).
	self assert: (self nonEmpty includes: self nonEmpty anyOne).
	self deny: (self empty includes: self elementNotInForOccurrences)! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 12/18/2009 13:09'!
replacementCollection
" return a collection that will be used to replace 'oldSubcollection' in ' collectionWith1TimeSubcollection'  " 
	^ collectionWith4Elements! !

!OrderedCollectionTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithoutIndex
	| result index |
	index := self indexInNonEmpty .
	result := self nonEmpty copyWithoutIndex: index .
	
	"verify content of 'result:'"
	1 to: result size do:
		[:i | 
		i<( index ) ifTrue: [self assert: ((result at:i )= (self nonEmpty at:i))].
		i>=( index ) ifTrue: [self assert: (result at:i )= (self nonEmpty at:(i+1))]].
	
	"verify size of result : "
	self assert: result size=(self nonEmpty size -1).! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/22/2009 11:14'!
collectionWithSameAtEndAndBegining
" return a collection with elements at end and begining equals .
(others elements of the collection are not equal to those elements)"
	^ floatCollectionWithSameBeginingEnd ! !

!OrderedCollectionTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testLastIndexOfStartingAtDuplicate
	"self debug: #testLastIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection last.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'lastIndexOf:ifAbsent:startingAt: should return the position of the last occurrence :'"
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size
			ifAbsent: [ 55 ]) = collection size.
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size - 1
			ifAbsent: [ 55 ]) = 1! !

!OrderedCollectionTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfterEmpty
	| result |
	result := self empty copyAfter: self collectionWithoutEqualElements first.
	self assert: result isEmpty.
	! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 15:01'!
integerCollectionWithoutEqualElements
" return a collection of integer without equal elements"
	^ withoutEqualElements ! !

!OrderedCollectionTest methodsFor: 'tests - puting with indexes' stamp: ''!
testAtWrapPut
	"self debug: #testAtWrapPut"
	| index |
	index := self indexArray anyOne.
	
	self nonEmpty atWrap: 0 put: self aValue.
	self assert: (self nonEmpty at:(self nonEmpty size))=self aValue.
	
	self nonEmpty atWrap: (self nonEmpty size+1) put: self aValue.
	self assert: (self nonEmpty at:(1))=self aValue.
	
	self nonEmpty atWrap: (index  ) put: self aValue.
	self assert: (self nonEmpty at: index ) = self aValue.
	
	self nonEmpty atWrap: (self nonEmpty size+index  ) put: self aValue .
	self assert: (self nonEmpty at:(index ))=self aValue .! !

!OrderedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testReverseDo
	| result |
	result:= OrderedCollection new.
	self nonEmpty reverseDo: [: each | result add: each].
	
	1 to: result size do:
		[:i|
		self assert: (result at: i)=(self nonEmpty at:(self nonEmpty size-i+1))].! !

!OrderedCollectionTest methodsFor: 'tests - adding' stamp: 'zz 12/7/2005 13:43'!
testAddDuplicateItem1
	| collection |
	collection := #('Jim' 'Mary' 'John' 'Andrew' ) asOrderedCollection.
	collection add: 'John' before: 'John'.
	self
		assert: ((collection asBag occurrencesOf: 'John')
					= 2
				and: [(collection at: (collection indexOf: 'John')
							+ 1)
						= (collection
								at: (collection indexOf: 'John'))])! !

!OrderedCollectionTest methodsFor: 'tests - copy' stamp: ''!
testCopyEquals
	"self debug: #testCopySameClass"
	"A copy should be equivalent to the things it's a copy of"
	
	| copy | 
	copy := self nonEmpty copy.
	self assert: copy  = self nonEmpty.! !

!OrderedCollectionTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testIndexOfDuplicate
	"self debug: #testIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection last.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'indexOf: should return the position of the first occurrence :'"
	self assert: (collection indexOf: element) = 1! !

!OrderedCollectionTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWithoutAll
	"self debug: #testCopyEmptyWithoutAll"
	| res |
	res := self empty copyWithoutAll: self collectionWithElementsToRemove.
	self assert: res size = self empty size.
	self collectionWithElementsToRemove do: [ :each | self deny: (res includes: each) ]! !

!OrderedCollectionTest methodsFor: 'tests - adding' stamp: ''!
testTAddIfNotPresentWithNewElement

	| added oldSize collection elem |
	collection := self otherCollection .
	oldSize := collection  size.
	elem := self element .
	self deny: (collection  includes: elem ).
	
	added := collection  addIfNotPresent: elem .
	self assert: added == elem . "test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection  size = (oldSize + 1)).

	! !

!OrderedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testAtPin
	"self debug: #testAtPin"
	self assert: (self moreThan4Elements atPin: 2) = self moreThan4Elements second.
	self assert: (self moreThan4Elements atPin: 99) = self moreThan4Elements last.
	self assert: (self moreThan4Elements atPin: -99) = self moreThan4Elements first! !

!OrderedCollectionTest methodsFor: 'tests - sequence isempty' stamp: ''!
testSequenceIfNotEmpty

	self assert: (self nonEmpty 
					ifNotEmpty: [:s | self accessValuePutInOn: s]) = self valuePutIn! !

!OrderedCollectionTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutAll
	"self debug: #testCopyNonEmptyWithoutAll"
	| res |
	res := self nonEmpty copyWithoutAll: self collectionWithElementsToRemove.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self collectionWithElementsToRemove do: [ :each | self deny: (res includes: (each)) ].
	self nonEmpty do: 
		[ :each | 
		(self collectionWithElementsToRemove includes: each) ifFalse: [ self assert: (res includes: each) ] ]! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 13:46'!
elementsCopyNonIdenticalWithoutEqualElements
	" return a collection that does niot incllude equal elements ( classic equality )"
	^ collectionOfFloat! !

!OrderedCollectionTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfterLast
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyAfterLast: (collection  at:index ).
	
	"verifying content: "
	(1) to: result size do: 
		[:i |
		self assert: (collection   at:(i + index ))=(result at: (i))].

	"verify size: "
	self assert: result size = (collection   size - index).! !

!OrderedCollectionTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButLastNElements
	"self debug: #testAllButFirst"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButLast: 2.
	1 
		to: abf size
		do: [ :i | self assert: (abf at: i) = (col at: i) ].
	self assert: abf size + 2 = col size! !

!OrderedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testAtLastIfAbsent
	"self debug: #testAtLastIfAbsent"
	self assert: (self moreThan4Elements 
			atLast: 1
			ifAbsent: [ nil ]) = self moreThan4Elements last.
	self assert: (self moreThan4Elements 
			atLast: self moreThan4Elements size + 1
			ifAbsent: [ 222 ]) = 222! !

!OrderedCollectionTest methodsFor: 'tests - copying' stamp: 'sd 3/21/2006 22:41'!
testCopyWith
	"Allows one to create a copy of the receiver that contains the new element at the end"
	"self run: #testCopyWith"
	
	| c1 | 
	c1 := #(1 2 3 4) asOrderedCollection.
	c1 := c1 copyWith: 6.
	self assert: c1 = #(1 2 3 4 6) asOrderedCollection.
	
	

	
	
	
! !

!OrderedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindFirstNotIn

	| result |
	
	 result:=self empty findFirst: [:each | true].
	
	self assert: result=0. ! !

!OrderedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testAfterIfAbsent
	"self debug: #testAfterIfAbsent"
	self assert: (self moreThan4Elements 
			after: (self moreThan4Elements at: 1)
			ifAbsent: [ 33 ]) = (self moreThan4Elements at: 2).
	self assert: (self moreThan4Elements 
			after: (self moreThan4Elements at: self moreThan4Elements size)
			ifAbsent: [ 33 ]) = 33.
	self assert: (self moreThan4Elements 
			after: self elementNotInForElementAccessing
			ifAbsent: [ 33 ]) = 33! !

!OrderedCollectionTest methodsFor: 'tests - converting' stamp: ''!
assertNoDuplicates: aCollection whenConvertedTo: aClass 
	| result |
	result := self collectionWithEqualElements asIdentitySet.
	self assert: (result class includesBehavior: IdentitySet).
	self collectionWithEqualElements do: [ :initial | self assert: (result occurrencesOf: initial) = 1 ]! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureOccurrencesForMultiplinessTest
	| cpt anElement collection |
	self collectionWithEqualElements.
	self collectionWithEqualElements.
	self elementTwiceInForOccurrences.
	anElement := self elementTwiceInForOccurrences.
	collection := self collectionWithEqualElements.
	cpt := 0.	" testing with identity check ( == ) so that identy collections can use this trait : "
	self collectionWithEqualElements
		do: [ :each | 
			each == self elementTwiceInForOccurrences
				ifTrue: [ cpt := cpt + 1 ] ].
	self assert: cpt = 2! !

!OrderedCollectionTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsCommaStringEmpty

	self assert: self empty asCommaString = ''.
	self assert: self empty asCommaStringAnd = ''.
	
! !

!OrderedCollectionTest methodsFor: 'test - equality' stamp: ''!
testEqualSignIsTrueForEmptyButNonIdenticalCollections
	"self debug: #testEqualSignIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty = self empty copy). 
	self assert: (self empty copy = self empty).
	self assert: (self empty copy = self empty copy).
		
! !

!OrderedCollectionTest methodsFor: 'setup' stamp: 'stephane.ducasse 10/5/2008 12:10'!
nonEmpty
	
	^ nonEmpty! !

!OrderedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindLast

	| element result |
	element := self nonEmptyMoreThan1Element  at:self nonEmptyMoreThan1Element  size.
	 result:=self nonEmptyMoreThan1Element  findLast: [:each | each =element].
	
	self assert: result=self nonEmptyMoreThan1Element  size. ! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCreationWithTest
	self collectionMoreThan5Elements.
	self assert: self collectionMoreThan5Elements size >= 5! !

!OrderedCollectionTest methodsFor: 'tests - streaming' stamp: ''!
testNewStreamContentsReturnsCollectionOfCorrectSize
	| result item originalSize |
	originalSize := 10.
	item := self firstCollection first.
	result := self collectionClass
		new: originalSize
		streamContents: [ :stream | 
			1 to: originalSize + 1 do: [ :each | stream nextPut: item ].
			stream position: originalSize ].
	self assert: result size equals: originalSize! !

!OrderedCollectionTest methodsFor: 'tests - accessing' stamp: 'sd 3/21/2006 22:38'!
testAtPut
	"Allows one to replace an element but not at an off range index"
	"self run:#testAtPut"
	| c |
	c := #(1 2 3 4 ) asOrderedCollection.
	c at: 2 put: 5.
	self assert: c = #(1 5 3 4 ) asOrderedCollection.
	self
		should: [c at: 5 put: 8]
		raise: Error.
	self deny: c = #(1 5 3 4 8 ) asOrderedCollection! !

!OrderedCollectionTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyNonEmpty
	"self debug: #testCopyNonEmpty"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: copy isEmpty.
	self assert: copy size = self nonEmpty size.
	self nonEmpty do: 
		[:each | copy includes: each]! !

!OrderedCollectionTest methodsFor: 'tests - remove' stamp: ''!
testRemoveAllFoundIn
	"self debug: #testRemoveElementThatExists"
	| el aSubCollection res |
	el := self nonEmptyWithoutEqualElements anyOne.
	aSubCollection := (self nonEmptyWithoutEqualElements copyWithout: el) copyWith: self elementNotIn.
	res := self nonEmptyWithoutEqualElements removeAllFoundIn: aSubCollection.
	self assert: self nonEmptyWithoutEqualElements size = 1.
	self nonEmptyWithoutEqualElements do: [ :each | self assert: each = el ]! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureRequirementsOfTAddTest
	self collectionWithElement.
	self otherCollection.
	self element.
	self assert: (self collectionWithElement includes: self element).
	self deny: (self otherCollection includes: self element)! !

!OrderedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testReverseDoEmpty
	| result |
	result:= OrderedCollection new.
	self empty reverseDo: [: each | result add: each].
	
	self assert: result isEmpty .! !

!OrderedCollectionTest methodsFor: 'test - creation' stamp: ''!
testWithWith
	"self debug: #testWithWith"
	
	| aCol collection element1 element2 |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom: 1 to: 2  .
	element1 := collection at: 1.
	element2 := collection at:2.
	
	aCol := self collectionClass with: element1  with: element2 .
	self assert: (aCol occurrencesOf: element1 ) = ( collection occurrencesOf: element1).
	self assert: (aCol occurrencesOf: element2 ) = ( collection occurrencesOf: element2).
	
	! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: ''!
collectionWithIdentical
	"return a collection of type : 'self collectionWIithoutEqualsElements class containing two elements equals ( with identity equality)"
	| result collection anElement |
	collection := OrderedCollection withAll: self elementsCopyNonIdenticalWithoutEqualElements.
	anElement := collection first.
	collection add: anElement.
	result := self elementsCopyNonIdenticalWithoutEqualElements class withAll: collection.
	^ result! !

!OrderedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testFirstSecondThird
	"self debug: #testFirstSecondThird"
	self assert: self moreThan4Elements first = (self moreThan4Elements at: 1).
	self assert: self moreThan4Elements second = (self moreThan4Elements at: 2).
	self assert: self moreThan4Elements third = (self moreThan4Elements at: 3).
	self assert: self moreThan4Elements fourth = (self moreThan4Elements at: 4)! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureTRemoveTest
	| duplicate |
	self empty.
	self nonEmptyWithoutEqualElements.
	self deny: self nonEmptyWithoutEqualElements isEmpty.
	duplicate := true.
	self nonEmptyWithoutEqualElements
		detect: [ :each | (self nonEmptyWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ duplicate := false ].
	self assert: duplicate = false.
	self elementNotIn.
	self assert: self empty isEmpty.
	self deny: self nonEmptyWithoutEqualElements isEmpty.
	self deny: (self nonEmptyWithoutEqualElements includes: self elementNotIn)! !

!OrderedCollectionTest methodsFor: 'setup' stamp: 'cyrille.delaunay 12/18/2009 13:09'!
sizeCollection

	^ collectionWith4Elements! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'SebastianTleye 6/26/2013 12:45'!
collectionWithCharacters
	^withCharacters.! !

!OrderedCollectionTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithFirst

	| index element result |
	index:= self indexInNonEmpty .
	element:= self nonEmpty at: index.
	
	result := self nonEmpty copyWithFirst: element.	
	
	self assert: result size = (self nonEmpty size + 1).
	self assert: result first = element .
	
	2 to: result size do:
	[ :i |
	self assert: (result at: i) = ( self nonEmpty at: ( i - 1 ))].! !

!OrderedCollectionTest methodsFor: 'helpers' stamp: 'stephane.ducasse 1/12/2009 17:13'!
aValue

	^ 33! !

!OrderedCollectionTest methodsFor: 'setup' stamp: 'stephane.ducasse 10/5/2008 12:10'!
empty
	
	^ empty! !

!OrderedCollectionTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterEmpty

	| delim emptyStream |
	delim := ', '.
	emptyStream := ReadWriteStream on: ''.
	self empty asStringOn: emptyStream delimiter: delim.
	self assert: emptyStream contents = ''.
! !

!OrderedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testAtLast
	"self debug: #testAtLast"
	| index |
	self assert: (self moreThan4Elements atLast: 1) = self moreThan4Elements last.
	"tmp:=1.
	self do:
		[:each | 
		each =self elementInForIndexAccessing 
			ifTrue:[index:=tmp].
		tmp:=tmp+1]."
	index := self moreThan4Elements indexOf: self elementInForElementAccessing.
	self assert: (self moreThan4Elements atLast: index) = (self moreThan4Elements at: self moreThan4Elements size - index + 1)! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 11:49'!
indexArray
	^ indexArray .! !

!OrderedCollectionTest methodsFor: 'setup' stamp: 'cyrille.delaunay 12/18/2009 13:03'!
collection

	^ collectionWith4Elements! !

!OrderedCollectionTest methodsFor: 'tests - puting with indexes' stamp: ''!
testAtLastPut
	| result index |
	index := self indexArray anyOne.
	result := self nonEmpty atLast: index  put: self aValue.
	
	self assert: (self nonEmpty at: (self nonEmpty size +1 - index)) = self aValue .! !

!OrderedCollectionTest methodsFor: 'tests' stamp: 'StephaneDucasse 12/23/2009 21:41'!
testSort
	"self run: #testSort"
	
	| ord |
	ord := OrderedCollection new addAll: #(2 1 3 6 7 10 6); yourself.
	self assert: ord sort asArray = #(1 2 3 6 6 7 10). 
	self assert: ord sort = (OrderedCollection new addAll:#(1 2 3 6 6 7 10); yourself). 
	self assert: (ord sort: [:a :b | a > b]) asArray = #(10 7 6 6 3 2 1).
	ord := OrderedCollection new.
	self assert: ord sort asArray = #(). 
! !

!OrderedCollectionTest methodsFor: 'tests - enumerating' stamp: 'sd 6/5/2005 09:21'!
testIndexOfWithDuplicates

   | collection indices bagOfIndices |
   collection := #('Jim' 'Mary' 'John' 'Andrew' 'Mary' 'John' 'Jim' 'Micheal') asOrderedCollection.
   indices := collection collect: [:item | collection indexOf: item].
   self assert: indices asSet size = collection asSet size.
   bagOfIndices := indices asBag.
   self assert: (indices asSet 
                    allSatisfy: [:index | (bagOfIndices occurrencesOf: index)
	                                       = (collection occurrencesOf: (collection at: index))]).

  "  indexOf:  returns the index of the first occurrence of an item.
     For an item with n occurrences, the index of its first occurrence
     is found  n  times. "! !

!OrderedCollectionTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionEmpty
	"self debug: #testIntersectionEmpty"
	
	| inter |
	inter := self empty intersection: self empty.
	self assert: inter isEmpty. 
	inter := self empty intersection: self collection .
	self assert: inter =  self empty.
	! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 12:04'!
anotherElementOrAssociationIn
	" return an element (or an association for Dictionary ) present  in 'collection' "
	^ self collection  anyOne! !

!OrderedCollectionTest methodsFor: 'tests begin ' stamp: 'StephaneDucasse 3/28/2010 21:07'!
testEndsWithAnyOf
	"We can't test SequenceableCollection directly. However, we can test a sampling of its descendants."
	"self debug: #testEndsWithAnyOf"
	| la oc |
	la := #(6 5 4 3 2 1).
	oc := OrderedCollection new.
	oc add: 3; add: 2; add: 1.
	
	self assert: (la endsWithAnyOf: #((17) (1) (42))).
	self assert: (la endsWithAnyOf: #((17) (2 1) (42))).
	self assert: (la endsWithAnyOf: #((17) (3 2 1) (42))).
	self deny: (la endsWithAnyOf: #()).
	self deny: (la endsWithAnyOf: #(())).
	self deny: (la endsWithAnyOf: #((42))).! !

!OrderedCollectionTest methodsFor: 'tests - sorting' stamp: ''!
testIsSorted
	self assert: self sortedInAscendingOrderCollection isSorted.
	self deny: self unsortedCollection isSorted! !

!OrderedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testAtRandom
	| result |
	result := self nonEmpty atRandom .
	self assert: (self nonEmpty includes: result).! !

!OrderedCollectionTest methodsFor: 'tests - converting' stamp: ''!
assertSameContents: aCollection whenConvertedTo: aClass 
	| result |
	result := self assertNonDuplicatedContents: aCollection whenConvertedTo: aClass.
	self assert: result size = aCollection size! !

!OrderedCollectionTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testIdentityIndexOfIAbsentDuplicate
	"self debug: #testIdentityIndexOfIfAbsent"
	| collection element elementCopy |
	collection := self collectionWithNonIdentitySameAtEndAndBegining .
	element := collection last.
	elementCopy := element copy.
	self deny: element  == elementCopy .
	self assert: (collection 
			identityIndexOf: element
			ifAbsent: [ 0 ]) = collection size.
	self assert: (collection 
			identityIndexOf: elementCopy
			ifAbsent: [ 55 ]) = 55! !

!OrderedCollectionTest methodsFor: 'tests - equality' stamp: ''!
testEqualSignForSequenceableCollections
	"self debug: #testEqualSign"

	self deny: (self nonEmpty = self nonEmpty asSet). 
	self deny: (self nonEmpty reversed = self nonEmpty).
	self deny: (self nonEmpty = self nonEmpty reversed).! !

!OrderedCollectionTest methodsFor: 'tests - streaming' stamp: ''!
testStreamContents
	| result index |
	result:= self collectionClass streamContents: [ :s|
		s 
			nextPutAll: self firstCollection;
			nextPutAll: self secondCollection ].
	self assert: result equals: self firstCollection, self secondCollection.! !

!OrderedCollectionTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOfNotIn
	| result |
	result := self collectionWithoutEqualElements occurrencesOf: self elementNotInForOccurrences.
	self assert: result = 0! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureBeginsEndsWithTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self assert: self nonEmpty size > 1.
	self empty.
	self assert: self empty isEmpty! !

!OrderedCollectionTest methodsFor: 'tests begin ' stamp: 'StephaneDucasse 3/28/2010 21:07'!
testBeginsWithAnyOf
	"We can't test SequenceableCollection directly. However, we can test a sampling of its descendants."
	"self debug: #testBeginsWithAnyOf"
	
	| la oc |
	la := #(1 2 3 4 5 6).
	oc := OrderedCollection new.
	oc add: 1; add: 2; add: 3.
	
	self assert: (la beginsWithAnyOf: #((17) (1) (42))).
	self assert: (la beginsWithAnyOf: #((17) (1 2) (42))).
	self assert: (la beginsWithAnyOf: #((17) (1 2 3) (42))).
	self deny: (la beginsWithAnyOf: #()).
	self deny: (la beginsWithAnyOf: #(())).
	self deny: (la beginsWithAnyOf: #((42))).! !

!OrderedCollectionTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifferenceWithNonNullIntersection
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifferenceWithNonNullIntersection"
	"	#(1 2 3) difference: #(2 4) 
	->  #(1 3)"
	| res overlapping |
	overlapping := self collectionClass 
		with: self anotherElementOrAssociationNotIn
		with: self anotherElementOrAssociationIn.
	res := self collection difference: overlapping.
	self deny: (res includes: self anotherElementOrAssociationIn).
	overlapping do: [ :each | self deny: (res includes: each) ]! !

!OrderedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testAtIfAbsent
	"self debug: #testAt"
	| absent |
	absent := false.
	self moreThan4Elements 
		at: self moreThan4Elements size + 1
		ifAbsent: [ absent := true ].
	self assert: absent = true.
	absent := false.
	self moreThan4Elements 
		at: self moreThan4Elements size
		ifAbsent: [ absent := true ].
	self assert: absent = false! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 11:26'!
collectionNotIncluded
	^ OrderedCollection new add: elementNotIn ; add: elementNotIn ; yourself.! !

!OrderedCollectionTest methodsFor: 'tests - includes' stamp: 'delaunay 4/2/2009 11:53'!
elementNotInForOccurrences
	^ 666! !

!OrderedCollectionTest methodsFor: 'test - equality' stamp: ''!
testEqualSignOfIdenticalCollectionObjects
	"self debug: #testEqualSignOfIdenticalCollectionObjects"
	
	self assert: (self empty = self empty). 
	self assert: (self nonEmpty = self nonEmpty). 
	! !

!OrderedCollectionTest methodsFor: 'tests - index access' stamp: ''!
testIndexOf
	"self debug: #testIndexOf"
	| tmp index collection |
	collection := self collectionMoreThan1NoDuplicates.
	tmp := collection size.
	collection reverseDo: 
		[ :each | 
		each = self elementInForIndexAccessing ifTrue: [ index := tmp ].
		tmp := tmp - 1 ].
	self assert: (collection indexOf: self elementInForIndexAccessing) = index! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSubcollectionAccessTest
	self moreThan3Elements.
	self assert: self moreThan3Elements size > 2! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 12:04'!
anotherElementOrAssociationNotIn
	" return an element (or an association for Dictionary )not present  in 'collection' "
	^ elementNotIn ! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 13:27'!
elementInForIndexAccessing

^ self accessCollection  anyOne.! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSequencedElementAccessTest
	self moreThan4Elements.
	self assert: self moreThan4Elements size >= 4.
	self subCollectionNotIn.
	self subCollectionNotIn detect: [ :each | (self moreThan4Elements includes: each) not ] ifNone: [ self assert: false ].
	self elementNotInForElementAccessing.
	self deny: (self moreThan4Elements includes: self elementNotInForElementAccessing).
	self elementInForElementAccessing.
	self assert: (self moreThan4Elements includes: self elementInForElementAccessing)! !

!OrderedCollectionTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testLastIndexOfIfAbsentDuplicate
	"self debug: #testIndexOfIfAbsent"
	"self debug: #testLastIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection first.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'lastIndexOf: should return the position of the last occurrence :'"
	self assert: (collection 
			lastIndexOf: element
			ifAbsent: [ 55 ]) = collection size! !

!OrderedCollectionTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionBasic
	"self debug: #testIntersectionBasic"
	| inter |
	inter := self collection intersection: (self collectionClass with: self anotherElementOrAssociationIn).
	self deny: inter isEmpty.
	self assert: (inter includes: self anotherElementOrAssociationIn value)! !

!OrderedCollectionTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifference
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifference"
	
	| difference |
	self assert: (self collectionWithoutEqualElements difference: self collectionWithoutEqualElements) isEmpty.
	self assert: (self empty difference: self collectionWithoutEqualElements) isEmpty.
	difference := (self collectionWithoutEqualElements difference: self empty).
	self assert: difference size = self collectionWithoutEqualElements	 size.
	self collectionWithoutEqualElements do: [ :each |
		self assert: (difference includes: each)].
! !

!OrderedCollectionTest methodsFor: 'helpers' stamp: 'stephane.ducasse 1/12/2009 17:19'!
anotherValue

	^ 66! !

!OrderedCollectionTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButFirst
	"self debug: #testAllButFirst"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButFirst.
	self deny: abf first = col first.
	self assert: abf size + 1 = col size! !

!OrderedCollectionTest methodsFor: 'tests - as set tests' stamp: ''!
testAsIdentitySetWithEqualsElements
	| result collection |
	collection := self withEqualElements .
	result := collection asIdentitySet.
	collection do: [ :each | self assert: (result occurrencesOf: each) = 1 ].
	self assert: result class = IdentitySet.! !

!OrderedCollectionTest methodsFor: 'tests - adding' stamp: 'sd 3/21/2006 22:36'!
testAddAll
	"Allows one to add each element of an orderedCollection at the end of another
	orderedCollection "
	"self run:#testAddAll" 
	
	| c1 c2 |
	c1 := #(1 2 3 4 ) asOrderedCollection.
	c2 := #(5 6 7 8 9 ) asOrderedCollection.
	c1 addAll: c2.
	self assert: c1 = #(1 2 3 4 5 6 7 8 9) asOrderedCollection! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'DamienCassou 8/26/2013 15:59'!
element
	"Returns an object that can be added to the collection returned by #collection."
	^ 5! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'stephane.ducasse 10/8/2008 16:04'!
otherCollection
	^ otherCollection! !

!OrderedCollectionTest methodsFor: 'tests - removing' stamp: 'zz 12/7/2005 19:05'!
testRemoveAllSuchThat
	| collection |
	collection := (1 to: 10) asOrderedCollection.
	collection
		removeAllSuchThat: [:e | e even].
	self assert: collection = (1 to: 10 by: 2) asOrderedCollection! !

!OrderedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testAllButLastDo
	
	| result |
	result:= OrderedCollection  new.
	
	self nonEmptyMoreThan1Element  allButLastDo: [:each | result add: each].
	
	1 to: (result size) do:
		[:i|
		self assert: (self nonEmptyMoreThan1Element  at:(i ))=(result at:i)].
	
	self assert: result size=(self nonEmptyMoreThan1Element  size-1).! !

!OrderedCollectionTest methodsFor: 'tests - adding' stamp: 'zz 12/7/2005 18:52'!
testAddAfter

	| l |
	l := #(1 2 3 4) asOrderedCollection.
	l add: 88 after: 1.
	self assert: (l =  #(1 88 2 3 4) asOrderedCollection).
	l add: 99 after: 2.
	self assert: (l =  #(1 88 2 99 3 4) asOrderedCollection). 

! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyPartOfForMultipliness
	self collectionWithSameAtEndAndBegining.
	self assert: self collectionWithSameAtEndAndBegining first = self collectionWithSameAtEndAndBegining last.
	self assert: self collectionWithSameAtEndAndBegining size > 1.
	1 to: self collectionWithSameAtEndAndBegining size do: [ :i | 
		i > 1 & (i < self collectionWithSameAtEndAndBegining size)
			ifTrue: [ self deny: (self collectionWithSameAtEndAndBegining at: i) = self collectionWithSameAtEndAndBegining first ] ]! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 11:29'!
nonEmptyWithoutEqualElements
" return a collection without equal elements "
	^ withoutEqualElements ! !

!OrderedCollectionTest methodsFor: 'tests - removing' stamp: 'sd 3/21/2006 22:39'!
testRemoveLast
	"Allows one to remove n element of a collection at the end"
	"self run:#testRemoveLast" 
	
	| c1 |
	c1 := #(2 3 4 6) asOrderedCollection.
	c1 removeLast: 1.
	self assert: (c1 = #(2 3 4) asOrderedCollection).
	c1 removeLast: 2.
	self assert: (c1 = #(2) asOrderedCollection).
	self should: [c1 removeLast: 10] raise: Error.! !

!OrderedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testPairsCollect
	
	| index result |
	index:=0.
	
	result:=self nonEmptyMoreThan1Element  pairsCollect: 
		[:each1 :each2 | 
		self assert: ( self nonEmptyMoreThan1Element indexOf: each2 ) = (index := index + 2).
		(self nonEmptyMoreThan1Element indexOf: each2) = ((self nonEmptyMoreThan1Element indexOf: each1) + 1).
		].
	
	result do: 
		[:each | self assert: each = true].
	
! !

!OrderedCollectionTest methodsFor: 'tests - copying same contents' stamp: ''!
testShallowCopyEmpty
	| result |
	result := self empty shallowCopy .
	self assert: result isEmpty .! !

!OrderedCollectionTest methodsFor: 'parameters' stamp: ''!
accessValuePutInOn: s

	"return access the element put in the non-empty collection"
	
	^ s perform: self selectorToAccessValuePutIn! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 11:02'!
subCollectionNotIn

	^ self collectionNotIncluded .! !

!OrderedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithIndexDo
	
	"| result |
	result:=Array new: self nonEmptyMoreThan1Element size.
	self nonEmptyMoreThan1Element  withIndexDo: [:each :i | result at:i put:(each+i)].
	
	1 to: result size do:[: i | self assert: (result at:i)= ((self nonEmptyMoreThan1Element at: i) + i)]"
	|  indexes elements |
	indexes:= OrderedCollection new.
	elements := OrderedCollection new.
	
	self nonEmptyMoreThan1Element  withIndexDo: 
		[:value :i  |
		indexes  add: (i).
		elements add: value].
	
	(1 to: self nonEmptyMoreThan1Element size )do:
		[ :i |
		self assert: (indexes at: i) = i.
		self assert: (elements at: i) = (self nonEmptyMoreThan1Element at: i).	
		].
	
	self assert: indexes size = elements size. 
	self assert: indexes size = self nonEmptyMoreThan1Element size . 
	! !

!OrderedCollectionTest methodsFor: 'tests - copying same contents' stamp: ''!
testReverse

	| result |
	result := self nonEmpty reversed.	
	"verify content of 'result: '"
	1 to: result size do:
		[:i | self assert: ((result at: i) 
			= (self nonEmpty at: (self nonEmpty size - i + 1)))].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!OrderedCollectionTest methodsFor: 'test - creation' stamp: ''!
testWithWithWithWith
	"self debug: #testWithWithWithWith"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom: 1 to: 4.
	aCol := self collectionClass with: (collection at:1) with: ( collection at:2 ) with: ( collection at: 3) with: ( collection at: 4).

	1 to: 3 do: [ :i | self assert: ( aCol occurrencesOf: ( collection at: i ) ) = ( collection occurrencesOf: ( collection at: i ) ) ].! !

!OrderedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testBeforeIfAbsent
	"self debug: #testBefore"
	self assert: (self moreThan4Elements 
			before: (self moreThan4Elements at: 1)
			ifAbsent: [ 99 ]) = 99.
	self assert: (self moreThan4Elements 
			before: (self moreThan4Elements at: 2)
			ifAbsent: [ 99 ]) = (self moreThan4Elements at: 1)! !

!OrderedCollectionTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpToEmpty
	| result |
	result := self empty copyUpTo: self collectionWithoutEqualElements first.
	self assert: result isEmpty.
	! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixturePutOneOrMoreElementsTest
	self aValue.

	
	self indexArray.
	self indexArray do: [
		:each| 
		self assert: each class = SmallInteger. 
		self assert: (each>=1 & each<= self nonEmpty size).
		].
	
	self assert: self indexArray size = self valueArray size.
	
	self empty.
	self assert: self empty isEmpty .
	
	self nonEmpty.
	self deny: self nonEmpty  isEmpty.! !

!OrderedCollectionTest methodsFor: 'tests - as identity set' stamp: ''!
testAsIdentitySetWithoutIdentityEqualsElements
	| result collection |
	collection := self collectionWithCopy.
	result := collection asIdentitySet.
	" no elements should have been removed as no elements are equels with Identity equality"
	self assert: result size = collection size.
	collection do: 
		[ :each | 
		(collection occurrencesOf: each) = (result asOrderedCollection occurrencesOf: each) ].
	self assert: result class = IdentitySet! !

!OrderedCollectionTest methodsFor: 'test - iterate' stamp: 'stephane.ducasse 10/6/2008 17:38'!
speciesClass
	
	^ OrderedCollection! !

!OrderedCollectionTest methodsFor: 'tests - accessing' stamp: 'stephane.ducasse 10/6/2008 16:32'!
testCapacityFromAsOrderedCollection
	"Allows one to check the current capacity of an Ordered collection"
	"self run:#testCapacityFromAsOrderedCollection"
	
	| c1 c2 c3 |
	c1 := #(1 2 ) asOrderedCollection.
	self assert: (c1 capacity =  2).
	c2 := OrderedCollection new: 10.
	c2 add: 3.
	self assert: (c2 capacity = 10).	
	c3 := OrderedCollection new.
	self deny: (c3 capacity =  0).
	! !

!OrderedCollectionTest methodsFor: 'tests - set arithmetic' stamp: ''!
containsAll: union of: one andOf: another
			
	self assert: (one allSatisfy: [:each | union includes: each]).
	self assert: (another allSatisfy: [:each | union includes: each])! !

!OrderedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindLastNotIn

	| result |
	
	 result:=self empty findFirst: [:each | true].
	
	self assert: result=0. ! !

!OrderedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopySameContentsTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!OrderedCollectionTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsCommaStringOne
	
	"self assert: self oneItemCol asCommaString = '1'.
	self assert: self oneItemCol asCommaStringAnd = '1'."

	self assert: self nonEmpty1Element  asCommaString = (self nonEmpty1Element first asString).
	self assert: self nonEmpty1Element  asCommaStringAnd = (self nonEmpty1Element first asString).
	! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 13:48'!
floatCollectionWithSameAtEndAndBegining
" return a collection with elements at end and begining equals only with classic equality (they are not the same object).
(others elements of the collection are not equal to those elements)"
	^ floatCollectionWithSameBeginingEnd ! !

!OrderedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFromToDo
	
	| result |
	result:= OrderedCollection  new.
	
	self nonEmptyMoreThan1Element  from: 1 to: (self nonEmptyMoreThan1Element  size -1) do: [:each | result add: each].
	
	1 to: (self nonEmptyMoreThan1Element  size -1) do:
		[:i|
		self assert: (self nonEmptyMoreThan1Element  at:i )=(result at:i)].
	self assert: result size=(self nonEmptyMoreThan1Element  size-1).! !

!OrderedCollectionTest methodsFor: 'tests - adding' stamp: 'sd 3/21/2006 22:36'!
testAddAllLast
	"Allows one to add each element of an orderedCollection at the beginning of another
	orderedCollection "
	"self run:#testAddAllLast" 
	
	| c1 c2 |
	c1 := #(1 2 3 4 ) asOrderedCollection.
	c2 := #(5 6 7 8 9 ) asOrderedCollection.
	c1 addAllLast: c2.
	self assert: c1 = #(1 2 3 4 5 6 7 8 9) asOrderedCollection! !

!OrderedCollectionTest methodsFor: 'tests - accessing' stamp: 'zz 12/7/2005 18:50'!
testAt
	| collection |
	collection := #('Jim' 'Mary' 'John' 'Andrew' ) asOrderedCollection.
	self assert: (collection at:1) = 'Jim'.
	self assert: (collection at:2) = 'Mary'! !

!OrderedCollectionTest methodsFor: 'setup' stamp: 'SebastianTleye 6/28/2013 14:38'!
setUp

	
	nonEmpty := OrderedCollection new  add: self valuePutIn; add: self elementTwiceIn; add: self elementTwiceIn; yourself.
	empty := OrderedCollection new. 
	elementNotIn := 99.
	collectionWith4Elements := OrderedCollection new add: 1; add: -2; add: 3; add: 1; yourself.
	indexArray := { 3. 1.}.
	indexCollection := OrderedCollection new add: 1; add: 2;add: 3; add: 4; add:5;  yourself.
	otherCollection := OrderedCollection new add: 1;add: 20; add: 30; yourself.
	withoutEqualElements := OrderedCollection new add: 1;add: 20; add: 30; yourself.
	collectResult := OrderedCollection new add: SmallInteger; add: SmallInteger; add: SmallInteger; yourself.
	collectionOfCollectionsOfStrings:= OrderedCollection new add: (OrderedCollection new add: (OrderedCollection new add: 'foo'; yourself); add: (OrderedCollection new add: 'bar'; yourself); yourself); add: 'zorg'; yourself.
	simpleCollection := OrderedCollection new add: 1; add: 8; add: 3; yourself.
	collectionOfCollectionsOfInts := OrderedCollection new add: 1; add: (OrderedCollection new add: 2; add: 3; yourself); add: (OrderedCollection new add: 4; add: (OrderedCollection new add: 5; add: 6; yourself); yourself); yourself.
	withCharacters := OrderedCollection new add: $a; add: $x; add: $d; add: $c; add: $m; yourself.
	emptyButAllocatedWith20 := OrderedCollection new: 20. 
	collectionWithElement := OrderedCollection new add: self element; yourself.
	collectionOfFloat := OrderedCollection new add: 4.1; add: 7.2; add: 2.5; yourself.
	floatCollectionWithSameBeginingEnd := OrderedCollection new add: 4.1; add: 7.2; add: 4.1 copy ; yourself.
	duplicateElement := 2.
	collectionWithDuplicateElement := OrderedCollection new add: duplicateElement ; add: duplicateElement ; add:4 ; yourself.	

	collection5Elements := OrderedCollection new add: 1; add: 2;  add: 3;  add: 4;  add: 5; yourself.! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 11:02'!
elementNotIn
	^ elementNotIn ! !

!OrderedCollectionTest methodsFor: 'test - creation' stamp: ''!
testWithWithWithWithWith
	"self debug: #testWithWithWithWithWith"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom: 1 to: 5 .
	aCol := self collectionClass with: (collection at:1) with: ( collection at:2 ) with: ( collection at: 3) with: (collection at: 4 ) with: ( collection at: 5 ).

	1 to: 3 do: [ :i | self assert: ( aCol occurrencesOf: ( collection at: i ) ) = ( collection occurrencesOf: ( collection at: i ) ) ].! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 10:52'!
moreThan3Elements
	" return a collection including atLeast 3 elements"
	^ indexCollection ! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 15:45'!
replacementCollectionSameSize
" return a collection of size (secondIndex - firstIndex + 1)"

| res |
res := OrderedCollection new.
1 to: (self secondIndex - self firstIndex + 1) do:
	[
	:i |
	res add: 99.
	].
	^res.! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/23/2009 14:05'!
nonEmptyMoreThan1Element
" return a collection with more than one element"
	^ withoutEqualElements  .! !

!OrderedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testMiddle
	"self debug: #testMiddle"
	self assert: self moreThan4Elements middle = (self moreThan4Elements at: self moreThan4Elements size // 2 + 1)! !

!OrderedCollectionTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testIndexOfIfAbsentDuplicate
	"self debug: #testIndexOfIfAbsent"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection last.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'indexOf:ifAbsent: should return the position of the first occurrence :'"
	self assert: (collection 
			indexOf: element
			ifAbsent: [ 55 ]) = 1! !

!OrderedCollectionTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterOne

	| delim oneItemStream result |
	"delim := ', '.
	oneItemStream := '' readWrite.
	self oneItemCol asStringOn: oneItemStream delimiter: delim.
	self assert: oneItemStream contents = '1'."
	
	delim := ', '.
	result:=''.
	oneItemStream := ReadWriteStream on: result.
	self nonEmpty1Element  asStringOn: oneItemStream delimiter: delim.
	oneItemStream do:[:each | self assert: each = (self nonEmpty1Element first asString)].
	

	! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: ''!
elementInForReplacement
" return an element included in 'nonEmpty' "
^ self nonEmpty anyOne.! !

!OrderedCollectionTest methodsFor: 'tests - at put' stamp: ''!
testAtPutOutOfBounds
	"self debug: #testAtPutOutOfBounds"
	
	self should: [self empty at: self anIndex put: self aValue] raise: Error
	! !

!OrderedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 11:03'!
elementInForIncludesTest
" return an element included in nonEmpty "
	^ self nonEmpty anyOne! !

!OrderedCollectionTest methodsFor: 'tests - copying with replacement' stamp: ''!
firstIndexesOf: aSubCollection in: collection
" return an OrderedCollection with the first indexes of the occurrences of subCollection in  collection "
	| tmp result currentIndex |
	tmp:= collection.
	result:= OrderedCollection new.
	currentIndex := 1.
	
	[tmp isEmpty ]whileFalse:
		[
		(tmp beginsWith: aSubCollection)
			ifTrue: [ 	
				result add: currentIndex.
				1 to: aSubCollection size do: 
					[:i | 
					tmp := tmp copyWithoutFirst.
					currentIndex := currentIndex + 1]
				]
			ifFalse: [
				tmp := tmp copyWithoutFirst.
				currentIndex := currentIndex +1.
				]
		 ].
	
	^ result.
	! !

!OrderedCollectionTest methodsFor: 'tests - index access' stamp: ''!
testLastIndexOfIfAbsent
	"self debug: #testIndexOfIfAbsent"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			lastIndexOf: element
			ifAbsent: [ 99 ]) = 1.
	self assert: (collection 
			lastIndexOf: self elementNotInForIndexAccessing
			ifAbsent: [ 99 ]) = 99! !

!OrderedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithCollectError
	self should: [self nonEmptyMoreThan1Element with: self empty collect:[:a :b | ]] raise: Error.! !

!OrderedCollectionTest methodsFor: 'tests - remove' stamp: ''!
testRemoveAllError
	"self debug: #testRemoveElementThatExists"
	| el aSubCollection |
	el := self elementNotIn.
	aSubCollection := self nonEmptyWithoutEqualElements copyWith: el.
	self 
		should: [ | res | res := self nonEmptyWithoutEqualElements removeAll: aSubCollection ]
		raise: Error! !

!OrderedDictionary commentStamp: 'monty 11/21/2014 03:57'!
This class is a dictionary that uses key insertion order when enumerating, printing, or returing collections of keys/values/associations, but not when testing for equality.

Insertion, updating, and inclusion testing have O(1) complexity while removing has O(n) worst-case.!
!OrderedDictionary methodsFor: 'private' stamp: 'monty 2/4/2014 07:32'!
orderedKeys
	^ orderedKeys! !

!OrderedDictionary methodsFor: 'adding' stamp: 'monty 11/21/2014 04:03'!
addAll: anAssociationCollection
	"Since Collection implements #associationsDo, this method can accept any collection
	of associations including Arrays and OrderedCollections and not just Dictionaries"

	anAssociationCollection associationsDo: [:each | self add: each].
	^ anAssociationCollection.! !

!OrderedDictionary methodsFor: 'testing' stamp: 'JAAyer 8/4/2010 17:41'!
includesIdentity: anObject
	^ dictionary includesIdentity: anObject! !

!OrderedDictionary methodsFor: 'accessing' stamp: 'monty 11/21/2014 01:38'!
keyAtIdentityValue: aValue
	^ dictionary keyAtIdentityValue: aValue! !

!OrderedDictionary methodsFor: 'initialization' stamp: 'monty 11/20/2014 18:21'!
initialize: aCapacity
	dictionary := self dictionaryClass new: aCapacity.
	orderedKeys := Array new: aCapacity.! !

!OrderedDictionary methodsFor: 'accessing' stamp: 'JAAyer 8/4/2010 19:12'!
keyForIdentity: anObject
	^ dictionary keyForIdentity: anObject! !

!OrderedDictionary methodsFor: 'removing' stamp: 'monty 11/21/2014 01:42'!
removeKey: aKey ifAbsent: aBlock
	self deleteOrderedKey: aKey.
	^ dictionary removeKey: aKey ifAbsent: aBlock.! !

!OrderedDictionary methodsFor: 'accessing' stamp: 'JAAyer 8/4/2010 19:21'!
at: aKey ifPresent: aBlock
	^ dictionary at: aKey ifPresent: aBlock! !

!OrderedDictionary methodsFor: 'private' stamp: 'monty 11/13/2014 03:51'!
growOrderedKeys
	orderedKeys :=
		(Array new: ((orderedKeys size * 1.5) asInteger max: 10))
			replaceFrom: 1
			to: orderedKeys size
			with: orderedKeys
			startingAt: 1.! !

!OrderedDictionary methodsFor: 'enumerating' stamp: 'JAAyer 8/4/2010 18:03'!
valuesDo: aBlock
	self keysDo: [:each | aBlock value: (self at: each)]! !

!OrderedDictionary methodsFor: 'enumerating' stamp: 'monty 11/14/2014 16:26'!
associationsSelect: aBlock
	^ self speciesNewFrom: (self associations select: aBlock)! !

!OrderedDictionary methodsFor: 'printing' stamp: 'monty 11/21/2014 04:59'!
printElementsOn: aStream
	aStream nextPut: $(.
	self size > 100
		ifTrue: [
			aStream nextPutAll: 'size '.
			self size printOn: aStream]
		ifFalse: [
			self associations doWithIndex: [:associaiton :i |
				aStream
					print: associaiton key;
					nextPutAll: '->';
					print: associaiton value.
				(i < self size)
					ifTrue: [aStream space]]].
	aStream nextPut: $).! !

!OrderedDictionary methodsFor: 'testing' stamp: 'JAAyer 8/4/2010 17:40'!
includesKey: aKey
	^ dictionary includesKey: aKey! !

!OrderedDictionary methodsFor: 'accessing' stamp: 'JAAyer 8/4/2010 17:25'!
values
	^ self associations collect: [:each | each value]! !

!OrderedDictionary methodsFor: 'accessing' stamp: 'JAAyer 8/4/2010 17:17'!
at: aKey ifAbsentPut: aBlock
	^ self at: aKey ifAbsent: [self at: aKey put: aBlock value]! !

!OrderedDictionary methodsFor: 'private' stamp: 'monty 11/20/2014 18:51'!
speciesNewFrom: anAssociationCollection
	^ self species newFrom: anAssociationCollection! !

!OrderedDictionary methodsFor: 'testing' stamp: 'JAAyer 8/4/2010 17:41'!
includesAssociation: anAssociation
	^ dictionary includesAssociation: anAssociation! !

!OrderedDictionary methodsFor: 'accessing' stamp: 'monty 11/13/2014 03:43'!
keyAtIndex: anIndex ifAbsent: aBlock
	(anIndex > 0 and: [anIndex <= self size])
		ifTrue: [^ orderedKeys at: anIndex]
		ifFalse: [^ aBlock value]! !

!OrderedDictionary methodsFor: 'accessing' stamp: 'JAAyer 8/4/2010 17:31'!
capacity
	^ dictionary capacity! !

!OrderedDictionary methodsFor: 'accessing' stamp: 'monty 10/18/2014 08:47'!
dictionaryClass
	^ Dictionary! !

!OrderedDictionary methodsFor: 'accessing' stamp: 'monty 11/3/2014 16:57'!
associationAt: aKey ifPresent: aBlock
	"squeak does not have associationAt:ifPresent:"
	^ aBlock cull: (dictionary associationAt: aKey ifAbsent: [^ nil])! !

!OrderedDictionary methodsFor: '*NewValueHolder' stamp: 'MarcusDenker 11/19/2014 09:37'!
asValueHolder

	^ DictionaryValueHolder value: self
! !

!OrderedDictionary methodsFor: 'removing' stamp: 'monty 11/21/2014 01:43'!
removeKey: aKey
	self deleteOrderedKey: aKey.
	^ dictionary removeKey: aKey.! !

!OrderedDictionary methodsFor: 'accessing' stamp: 'monty 10/14/2014 09:13'!
at: aKey put: aValue
	| oldSize newSize |

	oldSize := dictionary size.
	dictionary at: aKey put: aValue.
	(newSize := dictionary size) > oldSize
		ifTrue: [
			 newSize > orderedKeys size
				ifTrue: [self growOrderedKeys].
			orderedKeys at: newSize put: aKey].
	^ aValue.! !

!OrderedDictionary methodsFor: 'copying' stamp: 'JAAyer 8/4/2010 19:17'!
postCopy
	orderedKeys := orderedKeys copy.
	dictionary := dictionary copy.! !

!OrderedDictionary methodsFor: 'accessing' stamp: 'JAAyer 8/4/2010 17:31'!
keysSortedSafely
	^ dictionary keysSortedSafely! !

!OrderedDictionary methodsFor: 'enumerating' stamp: 'monty 11/14/2014 16:26'!
collect: aBlock
	^ self speciesNewFrom:
		(self associations collect: [:each |
			each key -> (aBlock value: each value)])! !

!OrderedDictionary methodsFor: 'private' stamp: 'JAAyer 10/15/2010 14:07'!
dictionary
	^ dictionary! !

!OrderedDictionary methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 3/25/2015 09:09'!
gtInspectorItemsIn: composite
	^ (composite table)
		title: 'Items';
		display: [ self associations ];
		children: [ :each | 
			(each value isDictionary) 
				ifTrue: [ each value associations ] 
				ifFalse: [ (each value isArray and: [ each value allSatisfy: #isDictionary ])
						ifTrue: [ each value collectWithIndex: [:x :i | i -> x ] ]
						ifFalse: [ #() ] ] ];
		column: 'Key' 
			evaluated: [:each | GTObjectPrinter new asTruncatedTextFrom: each key ];
		column: 'Value' 
			evaluated: [:each | GTObjectPrinter new asTruncatedTextFrom: each value ];
		selectionAct: [ :table |
			table rawSelection do: [ :assoc | self removeKey: assoc key ].
			table update ]
			entitled: 'Remove item(s)';
		selectionPopulate: #selection 
			entitled: 'Open key'
			with: [ :table | (table rawSelection collect: #key) gtInspectorInterestingObject ];
		beMultiple;
		withSmalltalkSearch;
		send: [ :selection | 
			(selection notNil and: [ selection size = 1 ]) 
				ifTrue: [ selection anyOne value ] 
				ifFalse: [ selection collect: #value ] ];
		showOnly: 50;
		helpMessage: 'Quick selection field. Given your INPUT, it executes: self select: [:each | INPUT ]'! !

!OrderedDictionary methodsFor: 'accessing' stamp: 'JAAyer 8/4/2010 19:05'!
associations
	| associations i |

	associations := Array new: self size.
	i := 1.
	self associationsDo: [:each |
		associations at: i put: each.
		i := i + 1].
	^ associations.! !

!OrderedDictionary methodsFor: 'accessing' stamp: 'JAAyer 8/4/2010 17:30'!
keyAtIdentityValue: aValue ifAbsent: aBlock
	^ dictionary keyAtIdentityValue: aValue ifAbsent: aBlock! !

!OrderedDictionary methodsFor: 'removing' stamp: 'monty 11/13/2014 02:51'!
removeAll
	1 to: self size do: [:i | orderedKeys at: i put: nil].
	dictionary removeAll.! !

!OrderedDictionary methodsFor: 'accessing' stamp: 'monty 11/3/2014 18:43'!
indexOfKey: aKey
	^ self indexOfKey: aKey ifAbsent: [0]! !

!OrderedDictionary methodsFor: 'removing' stamp: 'JAAyer 8/4/2010 20:39'!
keysAndValuesRemove: aTwoArgumentBlock
	| removedAssociations |

	removedAssociations := OrderedCollection new.
	self associationsDo: [:each |
		(aTwoArgumentBlock value: each key value: each value)
			ifTrue: [removedAssociations add: each]].
	removedAssociations do: [:each | self removeKey: each key].! !

!OrderedDictionary methodsFor: 'accessing' stamp: 'monty 10/19/2014 09:05'!
at: aKey ifPresent: aPresentBlock ifAbsent: anAbsentBlock
	^ dictionary
		at: aKey
		ifPresent: aPresentBlock
		ifAbsent: anAbsentBlock! !

!OrderedDictionary methodsFor: 'enumerating' stamp: 'JAAyer 8/4/2010 18:04'!
associationsDo: aBlock
	self keysDo: [:each | aBlock value: (self associationAt: each)]! !

!OrderedDictionary methodsFor: 'accessing' stamp: 'JAAyer 8/4/2010 17:11'!
associationAt: aKey ifAbsent: aBlock
	^ dictionary associationAt: aKey ifAbsent: aBlock! !

!OrderedDictionary methodsFor: 'accessing' stamp: 'monty 11/21/2014 01:38'!
at: aKey
	^ dictionary at: aKey! !

!OrderedDictionary methodsFor: 'adding' stamp: 'monty 10/14/2014 09:15'!
add: anAssociation
	| oldSize newSize |

	oldSize := dictionary size.
	dictionary add: anAssociation.
	(newSize := dictionary size) > oldSize
		ifTrue: [
			 newSize > orderedKeys size
				ifTrue: [self growOrderedKeys].
			orderedKeys at: newSize put: anAssociation key].
	^ anAssociation.! !

!OrderedDictionary methodsFor: 'accessing' stamp: 'JAAyer 8/4/2010 17:14'!
at: aKey ifAbsent: aBlock
	^ dictionary at: aKey ifAbsent: aBlock! !

!OrderedDictionary methodsFor: 'accessing' stamp: 'monty 11/20/2014 18:30'!
identityIndexOfKey: aKey ifAbsent: aBlock
	1 to: self size do: [:i |
		(orderedKeys at: i) == aKey
			ifTrue: [^ i]].
	^ aBlock value.! !

!OrderedDictionary methodsFor: 'comparing' stamp: 'JAAyer 8/4/2010 17:37'!
hash
	^ dictionary hash! !

!OrderedDictionary methodsFor: 'accessing' stamp: 'JAAyer 8/4/2010 17:27'!
size
	^ dictionary size! !

!OrderedDictionary methodsFor: 'accessing' stamp: 'monty 11/21/2014 02:03'!
keyAtIndex: anIndex
	^ self keyAtIndex: anIndex ifAbsent: [self errorInvalidIndex: anIndex]! !

!OrderedDictionary methodsFor: 'private' stamp: 'monty 11/21/2014 02:04'!
errorInvalidIndex: anIndex
	"squeak does not have SubscriptOutOfBounds."
	(Smalltalk
		at: #SubscriptOutOfBounds
		ifAbsent: [Error signal: 'Invalid index: ', anIndex printString]) signalFor: anIndex! !

!OrderedDictionary methodsFor: 'accessing' stamp: 'monty 10/14/2014 20:44'!
keys
	^ orderedKeys copyFrom: 1 to: self size! !

!OrderedDictionary methodsFor: 'removing' stamp: 'JAAyer 8/4/2010 18:11'!
remove: anObject ifAbsent: aBlock
	self shouldNotImplement! !

!OrderedDictionary methodsFor: 'accessing' stamp: 'JAAyer 8/4/2010 17:19'!
keyAtValue: aValue ifAbsent: aBlock
	^ dictionary keyAtValue: aValue ifAbsent: aBlock! !

!OrderedDictionary methodsFor: 'testing' stamp: 'JAAyer 8/4/2010 17:40'!
includes: anObject
	^ dictionary includes: anObject! !

!OrderedDictionary methodsFor: 'enumerating' stamp: 'monty 10/14/2014 20:44'!
keysDo: aBlock
	1 to: self size do: [:i | aBlock value: (orderedKeys at: i)]! !

!OrderedDictionary methodsFor: 'enumerating' stamp: 'monty 11/14/2014 16:32'!
select: aBlock
	^ self speciesNewFrom:
		(self associations select: [:each | aBlock value: each value])! !

!OrderedDictionary methodsFor: 'comparing' stamp: 'monty 10/25/2014 12:31'!
= anObject
	self == anObject
		ifTrue: [^ true].

	(anObject isDictionary and: [anObject size = self size])
		ifFalse: [^ false].

	dictionary associationsDo: [:each |
		(anObject at: each key ifAbsent: [^ false]) = each value
			ifFalse: [^ false]].
	^ true.! !

!OrderedDictionary methodsFor: 'enumerating' stamp: 'JAAyer 8/4/2010 17:44'!
do: aBlock
	self valuesDo: aBlock! !

!OrderedDictionary methodsFor: 'accessing' stamp: 'monty 11/21/2014 01:39'!
keyAtValue: aValue
	^ dictionary keyAtValue: aValue! !

!OrderedDictionary methodsFor: 'accessing' stamp: 'monty 11/13/2014 02:53'!
indexOfKey: aKey ifAbsent: aBlock
	1 to: self size do: [:i |
		(orderedKeys at: i) = aKey
			ifTrue: [^ i]].
	^ aBlock value.! !

!OrderedDictionary methodsFor: 'testing' stamp: 'JAAyer 8/4/2010 17:09'!
isDictionary
	^ true! !

!OrderedDictionary methodsFor: 'enumerating' stamp: 'JAAyer 3/6/2010 23:03'!
keysAndValuesDo: aBlock
	self keysDo: [:each | aBlock value: each value: (self at: each)]! !

!OrderedDictionary methodsFor: 'accessing' stamp: 'monty 11/21/2014 01:38'!
associationAt: aKey
	^ dictionary associationAt: aKey! !

!OrderedDictionary methodsFor: 'private' stamp: 'monty 11/21/2014 01:43'!
deleteOrderedKey: aKey
	| index |

	index := self indexOfKey: aKey ifAbsent: [^ self].
	orderedKeys
		replaceFrom: index
		to: self size - 1
		with: orderedKeys
		startingAt: index + 1.
	orderedKeys at: self size put: nil.! !

!OrderedDictionary class methodsFor: 'instance creation' stamp: 'monty 11/20/2014 18:21'!
new: aCapacity
	^ self basicNew initialize: aCapacity! !

!OrderedDictionary class methodsFor: 'inspecting' stamp: 'monty 10/25/2014 19:35'!
inspectorClass
	^ Dictionary inspectorClass! !

!OrderedDictionary class methodsFor: 'instance creation' stamp: 'JAAyer 12/4/2010 20:36'!
new
	^ self new: 10! !

!OrderedDictionary class methodsFor: 'instance creation' stamp: 'monty 11/20/2014 18:22'!
newFrom: anAssociationCollection
	| newDictionary |

	newDictionary := self new: anAssociationCollection size.
	anAssociationCollection associationsDo: [:each |
		newDictionary
			at: each key
			put: each value].
	^ newDictionary.! !

!OrderedDictionary class methodsFor: 'instance creation' stamp: 'monty 11/14/2014 17:51'!
newFromPairs: aSequenceableCollection
	| newDictionary |

	newDictionary := self new: (aSequenceableCollection size / 2) floor.
	1 to: aSequenceableCollection size - 1 by: 2 do: [:i |
		newDictionary
			at: (aSequenceableCollection at: i)
			put: (aSequenceableCollection at: i + 1)].
	^ newDictionary.! !

!OrderedDictionaryTest commentStamp: '<historical>'!
This class tests the OrderPreservingDictionary class using an empty dictionary, one with a single association and one with multiple associations.!
!OrderedDictionaryTest methodsFor: 'tests' stamp: 'monty 10/18/2014 11:10'!
testAtPut
	| dictionary keyToUpdate oldValue |

	dictionary := self emptyDictionary.
	self assert:
		(self dictionaryAssociations allSatisfy: [:each |
			(dictionary at: each key put: each value) = each value]).
	self assert: dictionary associations = self dictionaryAssociations.

	keyToUpdate := self dictionaryKeys anyOne.
	oldValue := dictionary at: keyToUpdate.
	self
		assert: (dictionary at: keyToUpdate put: self newValue) = self newValue;
		assert: (dictionary at: keyToUpdate) = self newValue;
		assert:
			(dictionary associations =
				(self dictionaryAssociations collect: [:each |
					(each value = oldValue)
						ifTrue: [each key -> self newValue]
						ifFalse: [each]])).! !

!OrderedDictionaryTest methodsFor: 'assertions' stamp: 'JAAyer 12/6/2010 14:19'!
assertSelector: aSelector enumerates: aCollection from: aDictionary
	| enumerated |

	enumerated := OrderedCollection new.
	self emptyDictionary perform: aSelector with: [:each | enumerated add: each].
	self assert: enumerated isEmpty.

	aDictionary perform: aSelector with: [:each | enumerated add: each].
	self assert: enumerated asArray = aCollection asArray.! !

!OrderedDictionaryTest methodsFor: 'accessing' stamp: 'monty 10/18/2014 09:43'!
internalDictionaryWithAssociations
	^ self internalDictionaryClass newFrom: self dictionaryAssociations! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'monty 11/14/2014 16:18'!
testKeysAndValuesRemove
	| dictionary keys |

	dictionary := self dictionaryWithAssociations.
	keys := self dictionaryKeys.
	dictionary keysAndValuesRemove: [:key :value | keys first = key or: [keys third = key]].

	self
		deny: (dictionary includesKey: keys first);
		deny: (dictionary includesKey: keys third);
		assert:
			(((keys copyWithout: keys first) copyWithout: keys third)
				allSatisfy: [:each | dictionary includesKey: each]).! !

!OrderedDictionaryTest methodsFor: 'accessing' stamp: 'JAAyer 1/16/2011 01:09'!
singleKey
	^ self singleAssociation key! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'JAAyer 1/16/2011 13:59'!
testAtIfAbsentPut
	| dictionary |

	dictionary := self dictionaryWithSingleAssociation.
	self
		assert: (dictionary at: self singleKey ifAbsentPut: [self newValue]) = self singleValue;
		assert: (dictionary at: self newKey ifAbsentPut: [self newValue]) = self newValue.! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'JAAyer 1/18/2011 20:29'!
testHash
	self assert: self emptyDictionary hash = self emptyDictionary hash.
	self assert:
		self dictionaryWithSingleAssociation hash =
			self dictionaryWithSingleAssociation hash.
	self assert:
		self dictionaryWithAssociations hash =
			self dictionaryWithAssociations hash.
	self assert:
		self dictionaryWithAssociations hash =
			(self dictionaryClass newFrom: self dictionaryAssociations reversed) hash.

	self
		deny: self emptyDictionary hash = self dictionaryWithSingleAssociation hash;
		deny: self emptyDictionary hash = self dictionaryWithAssociations hash;
		deny: self dictionaryWithSingleAssociation hash = self dictionaryWithAssociations hash.! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'JAAyer 12/6/2010 14:20'!
testValuesDo
	self
		assertSelector: #valuesDo:
		enumerates: self dictionaryValues
		from: self dictionaryWithAssociations! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'JAAyer 1/16/2011 14:27'!
testIncludes
	| dictionary |

	dictionary := self emptyDictionary.
	self deny: (self dictionaryValues anySatisfy: [:each | dictionary includes: each]).

	dictionary addAll: self dictionaryAssociations.
	self assert: (self dictionaryValues allSatisfy: [:each | dictionary includes: each]).! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'JAAyer 12/6/2010 14:20'!
testAssociationsDo
	self
		assertSelector: #associationsDo:
		enumerates: self dictionaryAssociations
		from: self dictionaryWithAssociations! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'JAAyer 12/6/2010 14:18'!
testKeysSortedSafely
	"The keys are all strings, so the default #sorted implementation will suffice."
	self
		assertSelector: #keysSortedSafely
		collects: self dictionaryKeys sorted
		from: self dictionaryWithAssociations! !

!OrderedDictionaryTest methodsFor: 'assertions' stamp: 'monty 10/18/2014 08:53'!
assertDictionary: aDictionary equals: aSecondDictionary
	self
		assert: aDictionary = aDictionary;
		assert: aSecondDictionary = aSecondDictionary;
		assert: aDictionary = aSecondDictionary;
		assert: aSecondDictionary = aDictionary! !

!OrderedDictionaryTest methodsFor: 'assertions' stamp: 'JAAyer 1/19/2011 20:18'!
assertIsDictionary: anObject includesAll: anAssociationCollection
	self
		assert: (anObject isMemberOf: self dictionaryClass);
		assert: (anAssociationCollection allSatisfy: [:each | anObject includesAssociation: each])! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'monty 11/20/2014 18:50'!
testAssociationAt
	| dictionary |

	dictionary := self dictionaryWithSingleAssociation.
	self
		should: [dictionary associationAt: self absentKey] raise: Error;
		assert: (dictionary associationAt: self singleKey) = self singleAssociation.! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'JAAyer 1/18/2011 21:05'!
testIncludesIdentity
	| dictionary associations values |

	dictionary := self emptyDictionary.

	"Need to save references to the exact objects for identity tests"
	associations := self dictionaryAssociations.
	values := associations collect: [:each | each value].
	self deny: (values anySatisfy: [:each | dictionary includesIdentity: each ]).

	dictionary addAll: associations.
	self
		assert: (values allSatisfy: [:each | dictionary includesIdentity: each]);
		deny: (values anySatisfy: [:each | dictionary includesIdentity: each copy]).! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'monty 10/19/2014 09:04'!
testAssociationAtIfPresent
	| dictionary |

	dictionary := self dictionaryWithSingleAssociation.
	self
		assert: (dictionary associationAt: self absentKey ifPresent: [self absentValue]) isNil;
		assert: (dictionary associationAt: self singleKey ifPresent: [self newValue]) = self newValue.! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'JAAyer 1/16/2011 01:00'!
testRemoveKeyIfAbsent
	| dictionary |

	dictionary := self dictionaryWithSingleAssociation.
	self
		assert: (dictionary removeKey: self absentKey ifAbsent: [self absentValue]) = self absentValue;
		assert: (dictionary removeKey: self singleKey ifAbsent: [self absentValue]) = self singleValue;
		deny: (dictionary includesKey: self singleKey).! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'monty 11/13/2014 15:46'!
testRemoveAll
	| dictionary |

	dictionary := self dictionaryWithAssociations.
	self deny: dictionary isEmpty.
	dictionary removeAll.
	self
		assert: dictionary isEmpty;
		assert: (dictionary orderedKeys allSatisfy: [:each | each isNil]).
	dictionary addAll: self dictionaryAssociations.
	self deny: dictionary isEmpty.! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'monty 11/14/2014 17:52'!
testNewFromPairs
	| pairs |

	pairs := OrderedCollection new.
	self dictionaryAssociations do: [:each |
		pairs
			add: each key;
			add: each value].
	0 to: pairs size do: [:i |
		self
			assertDictionary:
				(self dictionaryClass newFromPairs: (pairs copyFrom: 1 to: i))
			equals:
				(self dictionaryClass newFrom:
					(self dictionaryAssociations copyFrom: 1 to: (i / 2) floor))].! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'monty 11/20/2014 19:20'!
testRemoveKey
	| dictionary associationsToRemove |

	dictionary := self dictionaryWithAssociations.
	self should: [dictionary removeKey: self absentKey] raise: Error.
	associationsToRemove := self dictionaryAssociations asOrderedCollection.
	[associationsToRemove notEmpty]
		whileTrue: [ | removed |
			removed := associationsToRemove removeFirst.
			self
				assert: (dictionary removeKey: removed key) = removed value;
				should: [dictionary removeKey: removed key] raise: Error;
				deny: (dictionary includesKey: removed key);
				deny: (dictionary keys identityIncludes: removed key);
				deny: (dictionary orderedKeys identityIncludes: removed key);
				assert: dictionary keys = (associationsToRemove collect: [:each | each key]) asArray].! !

!OrderedDictionaryTest methodsFor: 'accessing' stamp: 'JAAyer 1/16/2011 13:58'!
dictionaryWithSingleAssociation
	^ self dictionaryClass with: self singleAssociation! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'monty 10/19/2014 00:07'!
testIncludesKey
	| dictionary associations |

	dictionary := self emptyDictionary.
	self deny: (self dictionaryKeys anySatisfy: [:each | dictionary includesKey: each]).

	associations := self dictionaryAssociations asOrderedCollection.
	[associations notEmpty]
		whileTrue: [| addedAssociation |
			addedAssociation := dictionary add: associations removeFirst.
			self assert: (dictionary includesKey: addedAssociation key).

			associations do: [:each |
				self deny: (dictionary includesKey: each key)]].! !

!OrderedDictionaryTest methodsFor: 'accessing' stamp: 'JAAyer 12/5/2010 12:28'!
dictionaryKeys
	^ self dictionaryAssociations collect: [:each | each key]! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'JAAyer 12/6/2010 14:18'!
testAssociations
	self
		assertSelector: #associations
		collects: self dictionaryAssociations
		from: self dictionaryWithAssociations! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'JAAyer 12/5/2010 02:58'!
testIncludesAssociation
	| dictionary |

	dictionary := self emptyDictionary.
	self deny: (self dictionaryAssociations anySatisfy: [:each | dictionary includesAssociation: each]).

	dictionary addAll: self dictionaryAssociations.
	self assert: (self dictionaryAssociations allSatisfy: [:each | dictionary includesAssociation: each])! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'JAAyer 1/19/2011 20:20'!
testAdd
	| dictionary associationToReplace replacementAssociation |

	dictionary := self emptyDictionary.
	self
		deny: (self dictionaryAssociations anySatisfy: [:each | dictionary includesAssociation: each]);
		assert: (self dictionaryAssociations allSatisfy: [:each | (dictionary add: each) == each]);
		assert: (self dictionaryAssociations allSatisfy: [:each | dictionary includesAssociation: each]);
		assert: dictionary associations = self dictionaryAssociations.

	associationToReplace := self dictionaryAssociations anyOne.
	replacementAssociation := associationToReplace copy.
	replacementAssociation value: self newValue.
	self
		assert: (dictionary add: replacementAssociation) == replacementAssociation;
		assert: (dictionary includesAssociation: replacementAssociation);
		deny: (dictionary includesAssociation: associationToReplace).
	self
		assertIsDictionary: dictionary
		withAssociations: 
			(self dictionaryAssociations
				replaceAll: associationToReplace
				with: replacementAssociation).! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'monty 10/18/2014 09:41'!
testAtIfPresent
	| dictionary |

	dictionary := self dictionaryWithSingleAssociation.
	self assert:
		(dictionary
			at: self singleKey
			ifPresent: [:each |
				each = self singleValue
					ifTrue: [self newValue]
					ifFalse: [nil]]) = self newValue.
	self assert:
		(dictionary
			at: self absentKey
			ifPresent: [:each | self signalFailure: 'Block should not have been evaluated']) isNil.! !

!OrderedDictionaryTest methodsFor: 'accessing' stamp: 'MarcusDenker 7/4/2014 09:47'!
dictionaryClass
	^ OrderedDictionary! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'JAAyer 12/6/2010 14:18'!
testValues
	self
		assertSelector: #values
		collects: self dictionaryValues
		from: self dictionaryWithAssociations! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'JAAyer 1/16/2011 01:05'!
testKeyForIdentity
	| dictionary value |

	dictionary := self dictionaryWithSingleAssociation.
	value := dictionary at: self singleKey.
	self
		assert: (dictionary keyForIdentity: value) = self singleKey;
		assert: (dictionary keyForIdentity: value copy) isNil;
		assert: (dictionary keyForIdentity: self absentValue) isNil.! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'JAAyer 12/6/2010 16:54'!
testSize
	| dictionary |

	dictionary := self emptyDictionary.
	self assert: dictionary size isZero.

	self dictionaryAssociations doWithIndex: [:each :i |
		dictionary add: each.
		self assert: dictionary size = i].

	self dictionaryAssociations size to: 1 by: -1 do: [:i |
		dictionary removeKey: (self dictionaryKeys at: i).
		self assert: dictionary size = (i - 1)].! !

!OrderedDictionaryTest methodsFor: 'accessing' stamp: 'JAAyer 12/5/2010 12:28'!
dictionaryValues
	^ self dictionaryAssociations collect: [:each | each value]! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'JAAyer 1/16/2011 00:50'!
testAtIfAbsent
	| dictionary |

	dictionary := self dictionaryWithSingleAssociation.
	self
		assert: (dictionary at: self absentKey ifAbsent: [self absentValue]) = self absentValue;
		assert: (dictionary at: self singleKey ifAbsent: [self absentValue]) = self singleValue.! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'monty 10/18/2014 09:45'!
testEqualsDictionary
	| orderedDictionary unorderedDictionary |

	"Comparisons with Dictionaries that contain the same associations should work too"
	orderedDictionary := self emptyDictionary.
	unorderedDictionary := self internalDictionaryClass new.
	self assertDictionary: orderedDictionary equals: unorderedDictionary.

	orderedDictionary addAll: self dictionaryAssociations.
	self assertDictionary: orderedDictionary doesNotEqual: unorderedDictionary.
	
	"Dictionary>>addAll: can only accept keyed collections as an argument, so newFrom: is
	used instead."
	unorderedDictionary := self internalDictionaryWithAssociations.
	self assertDictionary: orderedDictionary equals: unorderedDictionary.
	unorderedDictionary := self internalDictionaryClass newFrom: self dictionaryAssociations reversed.
	self assertDictionary: orderedDictionary equals: unorderedDictionary.! !

!OrderedDictionaryTest methodsFor: 'accessing' stamp: 'JAAyer 1/16/2011 01:09'!
singleAssociation
	^ self dictionaryAssociations first! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'JAAyer 12/6/2010 14:18'!
testKeys
	self
		assertSelector: #keys
		collects: self dictionaryKeys
		from: self dictionaryWithAssociations! !

!OrderedDictionaryTest methodsFor: 'accessing' stamp: 'JAAyer 12/5/2010 02:17'!
dictionaryWithAssociations
	^ self dictionaryClass newFrom: self dictionaryAssociations! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'monty 11/20/2014 19:09'!
testCopy
	| dictionary copy |

	dictionary := self dictionaryWithAssociations.
	copy := dictionary copy.
	self
		assertDictionary: dictionary equals: copy;
		deny: dictionary == copy;
		deny: dictionary dictionary == copy dictionary;
		deny: dictionary orderedKeys == copy orderedKeys.

	dictionary at: self singleKey put: self newValue.
	self deny: (copy at: self singleKey) = self newValue.! !

!OrderedDictionaryTest methodsFor: 'accessing' stamp: 'JAAyer 1/19/2011 20:09'!
absentKey
	^ 'absentKey'! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'monty 11/20/2014 18:59'!
testKeyAtValue
	| dictionary |

	dictionary := self dictionaryWithSingleAssociation.
	self
		should: [dictionary keyAtValue: self absentValue] raise: Error;
		assert: (dictionary keyAtValue: self singleValue) = self singleKey.! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'JAAyer 12/6/2010 14:21'!
testKeysAndValuesDo
	self
		assertSelector: #keysAndValuesDo:
		enumerates: self dictionaryKeys
		and: self dictionaryValues
		from: self dictionaryWithAssociations! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'monty 11/20/2014 18:55'!
testCapacity
	"The current Dictionary implementation allocations more than specified; the amount allocated may
	change in the future, but it likely won't ever be less than specified, so a >= test is used instead."
	| defaultCapacity |

	defaultCapacity := self defaultCapacity.
	self
		assert: (self dictionaryClass new) capacity >= defaultCapacity;
		assert:
			(self dictionaryClass new: (defaultCapacity / 2) asInteger) capacity >=
				(defaultCapacity / 2) asInteger;
		assert:
			(self dictionaryClass newFrom: self dictionaryAssociations)
				capacity >= self dictionaryAssociations size.

	0 to: self dictionaryAssociations size - 1 do: [:i |
		self
			shouldnt: [(self dictionaryClass new: i) addAll: self dictionaryAssociations]
			raise: Error].! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'JAAyer 1/19/2011 20:20'!
testAddAll
	| dictionary |

	dictionary := self emptyDictionary.
	self deny:
		(self dictionaryAssociations anySatisfy: [:each |
			dictionary includesAssociation: each]).

	self
		assert: (dictionary addAll: self dictionaryAssociations) = self dictionaryAssociations;
		assert: dictionary associations = self dictionaryAssociations.

	"ensure adding the same associations doesn't change the order"
	self assert:
		(dictionary addAll: self dictionaryAssociations reversed) =
			self dictionaryAssociations reversed.
	self assertIsDictionary: dictionary withAssociations: self dictionaryAssociations.! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'JAAyer 12/6/2010 12:11'!
testIsDictionary
	self assert: self dictionaryClass new isDictionary! !

!OrderedDictionaryTest methodsFor: 'accessing' stamp: 'monty 10/18/2014 09:06'!
internalDictionaryClass
	^ Dictionary! !

!OrderedDictionaryTest methodsFor: 'assertions' stamp: 'JAAyer 12/6/2010 14:17'!
assertSelector: aSelector collects: aCollection from: aDictionary
	self
		assert: (self emptyDictionary perform: aSelector) = #();
		assert: (aDictionary perform: aSelector) = aCollection asArray! !

!OrderedDictionaryTest methodsFor: 'assertions' stamp: 'JAAyer 12/6/2010 14:21'!
assertSelector: aSelector enumerates: aFirstCollection and: aSecondCollection from: aDictionary
	| firstEnumerated secondEnumerated|

	firstEnumerated := OrderedCollection new.
	secondEnumerated := OrderedCollection new.
	self emptyDictionary perform: aSelector with: [:first :second |
		firstEnumerated add: first.
		secondEnumerated add: second].
	self
		assert: firstEnumerated isEmpty;
		assert: secondEnumerated isEmpty.

	aDictionary perform: aSelector with: [:first :second |
		firstEnumerated add: first.
		secondEnumerated add: second].
	self
		assert: firstEnumerated asArray = aFirstCollection asArray;
		assert: secondEnumerated asArray = aSecondCollection asArray.! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'monty 10/18/2014 11:27'!
testEquals
	| dictionaryOne dictionaryTwo |

	dictionaryOne := self emptyDictionary.
	dictionaryTwo := self emptyDictionary.
	self assertDictionary: dictionaryOne equals: dictionaryTwo.

	"For equality, order will not matter"
	self dictionaryAssociations
		with: self dictionaryAssociations reversed
		do: [:firstAssociation :secondAssociation |
			dictionaryOne add: firstAssociation.
			dictionaryTwo add: secondAssociation.
			self
				assertDictionary: dictionaryOne doesNotEqual: self emptyDictionary;
				assertDictionary: dictionaryTwo doesNotEqual: self emptyDictionary.
			dictionaryOne size < self dictionaryAssociations size
				ifTrue: [self assertDictionary: dictionaryOne doesNotEqual: dictionaryTwo]].

	self assertDictionary: dictionaryOne equals: dictionaryTwo.! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'monty 11/20/2014 18:51'!
testAssociationsSelect
	| dictionary selectedAssociations rejectedAssociation |

	rejectedAssociation := self dictionaryAssociations anyOne.
	selectedAssociations := self dictionaryAssociations copyWithout: rejectedAssociation.
	dictionary :=
		self dictionaryWithAssociations
			associationsSelect: [:each | each ~= rejectedAssociation].
	self
		assertIsDictionary: dictionary withAssociations: selectedAssociations;
		deny: (dictionary includesAssociation: rejectedAssociation).

	(dictionary associationsSelect: [:each | true])
		at: selectedAssociations anyOne key
		put: self newValue.
	self assertIsDictionary: dictionary withAssociations: selectedAssociations.! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'monty 11/20/2014 19:10'!
testCopyEmpty
	| dictionary copy |

	dictionary := self dictionaryWithAssociations.
	copy := dictionary copyEmpty.
	self
		assertDictionary: dictionary doesNotEqual: copy;
		assert: copy isEmpty;
		deny: dictionary isEmpty.! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'monty 11/20/2014 19:14'!
testNewFrom
	| dictionaryOne dictionaryTwo dictionaryThree |
	
	dictionaryOne := self dictionaryClass newFrom: self dictionaryAssociations.
	dictionaryTwo := self dictionaryClass newFrom: dictionaryOne.
	dictionaryThree := self dictionaryClass newFrom: self internalDictionaryWithAssociations.
	self
		assertIsDictionary: dictionaryOne withAssociations: self dictionaryAssociations;
		assertIsDictionary: dictionaryTwo withAssociations: self dictionaryAssociations;
		assertIsDictionary: dictionaryThree includesAll: self dictionaryAssociations.

	(self dictionaryClass newFrom: dictionaryOne)
		at: self singleKey put: self newValue.
	self deny: (dictionaryOne at: self singleKey) = self newValue.! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'monty 11/3/2014 17:08'!
testKeyAtIndexIfAbsent
	| dictionary |

	dictionary := self emptyDictionary.
	self
		assert: (dictionary keyAtIndex: 0 ifAbsent: [self newKey]) = self newKey;
		assert: (dictionary keyAtIndex: 1 ifAbsent: [self newKey]) = self newKey.

	dictionary := self dictionaryWithAssociations.
	self dictionaryKeys withIndexDo: [:each :i |
		self assert: (dictionary keyAtIndex: i ifAbsent: [self newKey]) = each].
	self assert:
		(dictionary
			keyAtIndex: 0
			ifAbsent: [self newKey]) = self newKey.
	self assert:
			(dictionary
				keyAtIndex: dictionary size + 1
				ifAbsent: [self newKey]) = self newKey.! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'JAAyer 1/16/2011 00:44'!
testAssociationAtIfAbsent
	| dictionary |

	dictionary := self dictionaryWithSingleAssociation.
	self
		assert: (dictionary associationAt: self absentKey ifAbsent: [self absentValue]) = self absentValue;
		assert: (dictionary associationAt: self singleKey ifAbsent: [self absentValue]) = self singleAssociation.! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'monty 10/19/2014 09:10'!
testAtIfPresentIfAbsent
	| dictionary |

	dictionary := self dictionaryWithSingleAssociation.
	self assert:
		(dictionary
			at: self singleKey
			ifPresent: [:value |
				value = self singleValue
					ifTrue: [self newValue]
					ifFalse: [nil]]
			ifAbsent: [self signalFailure: 'Block should not have been evaluated']) = self newValue.
	self assert:
		(dictionary
			at: self absentKey
			ifPresent: [self signalFailure: 'Block should not have been evaluated']
			ifAbsent: [self newValue]) = self newValue.! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'JAAyer 12/6/2010 14:20'!
testDo
	self
		assertSelector: #do:
		enumerates: self dictionaryValues
		from: self dictionaryWithAssociations! !

!OrderedDictionaryTest methodsFor: 'accessing' stamp: 'JAAyer 1/19/2011 20:09'!
absentValue
	^ 'absentValue'! !

!OrderedDictionaryTest methodsFor: 'accessing' stamp: 'monty 11/13/2014 15:15'!
dictionaryAssociations
	"Associations are grouped out of their natural sort order and
	are copied so can be modified in one test without affecting others,
	but the keys and values are identical each time for identity tests."
	dictionaryAssociations ifNil: [
		dictionaryAssociations :=
		Array
			with: 'testKey'->'testValue'
			with: 'testKey3'->'testValue3'
			with: 'testKey2'->'testValue2'
			with: 'testKey4'->'testValue4'].
	^ dictionaryAssociations collect: [:each | each copy].! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'monty 11/20/2014 19:07'!
testKeyAtIndex
	| dictionary |

	self
		should: [self emptyDictionary keyAtIndex: 0] raise: Error;
		should: [self emptyDictionary keyAtIndex: 1] raise: Error.

	dictionary := self dictionaryWithAssociations.
	self dictionaryKeys withIndexDo: [:each :i |
		self assert: (dictionary keyAtIndex: i) = each].
	self
		should: [dictionary keyAtIndex: 0] raise: Error;
		should: [dictionary keyAtIndex: dictionary size + 1] raise: Error.! !

!OrderedDictionaryTest methodsFor: 'accessing' stamp: 'monty 11/20/2014 18:55'!
defaultCapacity
	^ self internalDictionaryClass new capacity! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'JAAyer 1/16/2011 04:19'!
testKeyAtIdentityValueIfAbsent
	| dictionary value |

	dictionary := self dictionaryWithSingleAssociation.
	value := dictionary at: self singleKey.
	self
		assert: (dictionary keyAtIdentityValue: self absentValue ifAbsent: [self absentKey]) = self absentKey;
		assert: (dictionary keyAtIdentityValue: value copy ifAbsent: [self absentKey]) = self absentKey;
		assert: (dictionary keyAtValue: value) = self singleKey.! !

!OrderedDictionaryTest methodsFor: 'accessing' stamp: 'monty 11/20/2014 19:26'!
identityDictionaryAssociations
	"associations are copied so can be modified in one test without affecting others,
	but the keys and values are identical each time for identity tests."
	dictionaryAssociations
		ifNil: [| key |
			key := 'testKey'.
			dictionaryAssociations :=
				Array
					with: (key := key copy) -> 'testValue'
					with: (key := key copy) -> 'testValue3'
					with: (key := key copy) -> 'testValue2'
					with: (key := key copy) -> 'testValue4'].
	^ dictionaryAssociations collect: [:each | each copy].! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'JAAyer 1/16/2011 00:59'!
testKeyAtValueIfAbsent
	| dictionary |

	dictionary := self dictionaryWithSingleAssociation.
	self
		assert: (dictionary keyAtValue: self absentValue ifAbsent: [self absentKey]) = self absentKey;
		assert: (dictionary keyAtValue: self singleValue ifAbsent: [self absentKey]) = self singleKey.! !

!OrderedDictionaryTest methodsFor: 'accessing' stamp: 'JAAyer 1/19/2011 20:09'!
newValue
	^ 'newValue'! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'JAAyer 12/6/2010 14:20'!
testKeysDo
	self
		assertSelector: #keysDo:
		enumerates: self dictionaryKeys
		from: self dictionaryWithAssociations! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'JAAyer 1/16/2011 17:34'!
testOccurancesOf
	| dictionary |

	dictionary := self emptyDictionary.
	self assert: (dictionary occurrencesOf: self absentValue) isZero.

	dictionary add: (self dictionaryAssociations first value: self newValue).
	self assert: (dictionary occurrencesOf: self newValue) = 1.

	dictionary add: (self dictionaryAssociations second value: self newValue) .
	self assert: (dictionary occurrencesOf: self newValue) = 2.! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'monty 11/20/2014 18:53'!
testAt
	| dictionary |

	dictionary := self dictionaryWithSingleAssociation.
	self
		should: [dictionary at: self absentKey] raise: Error;
		assert: (dictionary at: self singleKey) = self singleValue.! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'monty 11/3/2014 18:42'!
testIndexOfKey
	| dictionary |

	dictionary := self dictionaryWithAssociations.
	dictionary keys withIndexDo: [:each :i |
		self assert: (dictionary indexOfKey: each) = i].
	self assert: (dictionary indexOfKey: self absentKey) isZero.! !

!OrderedDictionaryTest methodsFor: 'accessing' stamp: 'JAAyer 12/5/2010 01:04'!
emptyDictionary
	^ self dictionaryClass new! !

!OrderedDictionaryTest methodsFor: 'assertions' stamp: 'JAAyer 1/19/2011 20:18'!
assertIsDictionary: anObject withAssociations: anAssociationCollection
	self
		assert: (anObject isMemberOf: self dictionaryClass);
		assert: anObject associations = anAssociationCollection! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'monty 11/20/2014 19:08'!
testCollect
	| dictionary |

	dictionary := self dictionaryWithAssociations.
	self
		assertIsDictionary: (dictionary collect: [:each | self newValue])
		withAssociations:
			(self dictionaryAssociations collect: [:each | each value: self newValue]).! !

!OrderedDictionaryTest methodsFor: 'accessing' stamp: 'monty 11/20/2014 19:19'!
identityAbsentKey
	^ self singleKey copy! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'monty 11/3/2014 18:49'!
testIndexOfKeyIfAbsent
	| dictionary |

	dictionary := self dictionaryWithAssociations.
	dictionary keys withIndexDo: [:each :i |
		self assert: (dictionary indexOfKey: each ifAbsent: [self newValue]) = i].

	self assert:
		(dictionary
			indexOfKey: self absentKey
			ifAbsent: [self newValue]) = self newValue.! !

!OrderedDictionaryTest methodsFor: 'accessing' stamp: 'JAAyer 1/19/2011 20:09'!
newKey
	^ 'newKey'! !

!OrderedDictionaryTest methodsFor: 'accessing' stamp: 'JAAyer 1/16/2011 01:09'!
singleValue
	^ self singleAssociation value! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'monty 11/20/2014 18:56'!
testSelect
	| dictionary |

	dictionary := self dictionaryWithAssociations.
	self
		assertIsDictionary: (dictionary select: [:each | each ~= self singleValue])
		withAssociations: (self dictionaryAssociations copyWithout: self singleAssociation).

	(dictionary select: [:each | true]) at: self singleKey put: self newValue.
	self deny: (dictionary at: self singleKey) = self newValue.! !

!OrderedDictionaryTest methodsFor: 'tests' stamp: 'monty 11/20/2014 19:05'!
testKeyAtIdentityValue
	| dictionary value |

	dictionary := self dictionaryWithSingleAssociation.
	value := dictionary at: self singleKey.
	self
		should: [dictionary keyAtIdentityValue: self absentValue] raise: Error;
		should: [dictionary keyAtIdentityValue: value copy] raise: Error;
		assert: (dictionary keyAtValue: value) = self singleKey.! !

!OrderedDictionaryTest methodsFor: 'assertions' stamp: 'JAAyer 12/4/2010 21:14'!
assertDictionary: aDictionary doesNotEqual: aSecondDictionary
	self
		deny: aDictionary = aSecondDictionary;
		deny: aSecondDictionary = aDictionary! !

!OrderedIdentityDictionary commentStamp: 'monty 11/21/2014 03:46'!
An IdentityDictionary version that uses == instead of = for key comparing.!
!OrderedIdentityDictionary methodsFor: 'accessing' stamp: 'monty 10/18/2014 08:47'!
dictionaryClass
	^ IdentityDictionary! !

!OrderedIdentityDictionary methodsFor: 'accessing' stamp: 'monty 11/20/2014 19:35'!
indexOfKey: aKey ifAbsent: aBlock
	^ self identityIndexOfKey: aKey ifAbsent: aBlock! !

!OrderedIdentityDictionaryTest methodsFor: 'accessing' stamp: 'monty 11/20/2014 19:25'!
dictionaryAssociations
	^ self identityDictionaryAssociations! !

!OrderedIdentityDictionaryTest methodsFor: 'accessing' stamp: 'monty 11/20/2014 19:25'!
absentKey
	^ self identityAbsentKey! !

!OrderedIdentityDictionaryTest methodsFor: 'accessing' stamp: 'monty 10/18/2014 09:07'!
internalDictionaryClass
	^ IdentityDictionary! !

!OrderedIdentityDictionaryTest methodsFor: 'accessing' stamp: 'monty 11/14/2014 19:06'!
dictionaryClass
	^ OrderedIdentityDictionary! !

!OrderedIdentityDictionaryTest class methodsFor: 'testing' stamp: 'monty 10/18/2014 09:38'!
shouldInheritSelectors
	^ true! !

!OrientedFillStyle commentStamp: '<historical>'!
OrientedFill is an abstract superclass for fills which can be aligned appropriately.

Instance variables:
	origin	<Point>	The point at which to align the fill.
	direction <Point>	The direction in which the fill is defined
	normal	<Point>	Typically, just the direction rotated by 90 degrees.!
!OrientedFillStyle methodsFor: '*Morphic-Base-Balloon' stamp: 'StephaneDucasse 10/26/2014 11:16'!
addFillStyleMenuItems: aMenu hand: aHand from: aMorph
	"Add the items for changing the current fill style of the receiver"
	aMenu add: 'change origin' target: self selector: #changeOriginIn:event: argument: aMorph.
	aMenu add: 'change orientation' target: self selector: #changeOrientationIn:event: argument: aMorph.! !

!OrientedFillStyle methodsFor: 'testing' stamp: 'ar 6/18/1999 07:57'!
isOrientedFill
	"Return true if the receiver keeps an orientation (e.g., origin, direction, and normal)"
	^true! !

!OrientedFillStyle methodsFor: 'comparing' stamp: 'gvc 7/24/2007 12:20'!
hash
	"Hash is implemented because #= is implemented."
	
	^self species hash
		bitXor: (self origin hash
		bitXor: (self direction hash
		bitXor: (self normal hash)))! !

!OrientedFillStyle methodsFor: 'comparing' stamp: 'gvc 7/24/2007 12:19'!
= anOrientedFillStyle
	"Answer whether equal."

	^self species = anOrientedFillStyle species
		and: [self origin = anOrientedFillStyle origin
		and: [self direction = anOrientedFillStyle direction
		and: [self normal = anOrientedFillStyle normal]]]! !

!OrientedFillStyle methodsFor: 'accessing' stamp: 'ar 11/11/1998 22:38'!
origin
	^origin! !

!OrientedFillStyle methodsFor: 'accessing' stamp: 'ar 8/25/2001 17:03'!
direction
	^direction ifNil:[direction := normal y @ normal x negated]! !

!OrientedFillStyle methodsFor: 'accessing' stamp: 'ar 11/11/1998 22:37'!
direction: aPoint
	direction := aPoint! !

!OrientedFillStyle methodsFor: '*Morphic-Base-Balloon' stamp: 'ar 6/18/1999 07:41'!
changeOrientationIn: aMorph event: evt
	"Interactively change the origin of the receiver"
	| handle |
	handle := HandleMorph new forEachPointDo:[:pt|
		self direction: pt - self origin.
		self normal: nil.
		aMorph changed].
	evt hand attachMorph: handle.
	handle startStepping.! !

!OrientedFillStyle methodsFor: '*Morphic-Base-Balloon' stamp: 'ar 6/18/1999 07:28'!
changeOriginIn: aMorph event: evt
	"Interactively change the origin of the receiver"
	| handle |
	handle := HandleMorph new forEachPointDo:[:pt|
		self origin: pt.
		aMorph changed].
	evt hand attachMorph: handle.
	handle startStepping.! !

!OrientedFillStyle methodsFor: 'accessing' stamp: 'ar 11/14/1998 23:31'!
normal
	^normal ifNil:[normal := direction y negated @ direction x]! !

!OrientedFillStyle methodsFor: 'accessing' stamp: 'ar 11/11/1998 22:38'!
origin: aPoint
	origin := aPoint.! !

!OrientedFillStyle methodsFor: 'accessing' stamp: 'ar 11/11/1998 22:37'!
normal: aPoint
	normal := aPoint! !

!OutOfMemory commentStamp: 'StephaneDucasse 12/18/2009 12:01'!
OutOfMemory is signaled when an allocation fails due to not having enough memory. Its default action signals the low-space semaphore.
Originally suggested by A. Raab.!
!OutOfMemory methodsFor: 'handling' stamp: 'StephaneDucasse 12/18/2009 11:57'!
defaultAction
	Smalltalk signalLowSpace.! !

!OutOfMemory methodsFor: 'testing' stamp: 'StephaneDucasse 12/18/2009 11:57'!
isResumable

	^true! !

!OverflowRowMorph commentStamp: 'gvc 1/12/2010 13:32'!
Instances of this class accept, via #baseMorph:, a morph that is expected to be row-like containing submorphs.
Based on the receiver's layout, the base morphs that are able to fit within the receiver (subject to minExtents) are layed out along with, if necessary, a button to pop-up a column of any remaining, unfittable, base morphs.
Handy for button bars etc.

Example:

(OverflowRowMorph new
	baseMorph: (UITheme builder newRow: ((1 to: 6) collect: [:i | |label|
		label := 'Button ', i asString.
		(UITheme builder
			newButtonFor: Transcript
			getState: nil
			action: #show:
			arguments: {label}
			getEnabled: nil
			label: label
			help: nil)
			hResizing: #spaceFill]))) openInWindow
		
	!
!OverflowRowMorph methodsFor: 'instance creation' stamp: 'FernandoOlivero 4/12/2011 10:11'!
newPotentialMorph
	"Answer a morph for trialing potential layout."

	|potential|
	potential := self theme builder newRow: self baseMorphs.
	potential extent: potential minExtent.
	^potential! !

!OverflowRowMorph methodsFor: 'initialize' stamp: 'gvc 1/11/2010 12:47'!
outOfWorld: aWorld
	"Get rid of the more column if visible."

	self hideMore.
	^super outOfWorld: aWorld! !

!OverflowRowMorph methodsFor: 'private' stamp: 'gvc 1/11/2010 18:54'!
buttonWidth
	"Answer the width for the more button."

	^self theme scrollbarThickness + 3! !

!OverflowRowMorph methodsFor: 'as yet unclassified' stamp: 'gvc 1/11/2010 18:35'!
moreButtonLabel
	"Answer the label for the more button."

	^AlphaImageMorph new image: (
		ScrollBar
			arrowOfDirection: #right
			size: self buttonWidth
			color: self paneColor darker)! !

!OverflowRowMorph methodsFor: 'accessing' stamp: 'gvc 1/18/2010 16:41'!
adoptPaneColor: paneColor
	"Pass on to the list morph and border too."
	
	super adoptPaneColor: paneColor.
	paneColor ifNil: [^self].
	self moreButton cornerStyle: self cornerStyle.
	self changed: #moreButtonLabel.
	self moreMorphs do: [:m |
		m adoptPaneColor: paneColor]! !

!OverflowRowMorph methodsFor: 'accessing' stamp: 'gvc 1/8/2010 19:13'!
baseMorphs
	"Answer the value of baseMorphs"

	^ baseMorphs! !

!OverflowRowMorph methodsFor: 'as yet unclassified' stamp: 'gvc 7/1/2010 15:02'!
moreMorphs
	"Answer those base morphs that are not currently part of the
	receiver's submorphs."

	^self baseMorphs
		ifEmpty: [#()]
		ifNotEmpty: [self baseMorphs copyFrom: self submorphs size to: self baseMorphs size]! !

!OverflowRowMorph methodsFor: 'as yet unclassified' stamp: 'gvc 7/1/2010 13:29'!
fitBaseMorphs
	"Replace the receiver's submorphs with the base morphs that
	can fit in the receiver's bounds. Critically, morphs must be replaced in
	one go to avoid #extent: recursion."

	|proposed|
	self hideMore.
	proposed := self newPotentialMorph.
	[proposed width <= self width or: [proposed submorphCount = 0]] whileFalse: [
		proposed
			removeMorph: proposed lastSubmorph;
			extent: proposed minExtent].
	proposed submorphCount < self baseMorphs size ifTrue: [
		self moreButton hResizing: #shrinkWrap.
		proposed
			addMorphBack: self moreButton;
			extent: proposed minExtent].
	[proposed width > self width and: [proposed submorphCount > 1]] whileTrue: [
		proposed
			removeMorph: (proposed submorphs at: proposed submorphs size - 1);
			extent: proposed minExtent].
	(proposed submorphCount = 1 and: [self moreButton owner notNil]) ifTrue: [
		self moreButton hResizing: #spaceFill].
	self
		removeAllMorphs;
		addAllMorphs: proposed submorphs
	! !

!OverflowRowMorph methodsFor: 'instance creation' stamp: 'gvc 1/12/2010 13:14'!
newMoreButton
	"Answer a new button for popping up the base morphs that are currently
	unable to fit in the allotted space."

	^(ControlButtonMorph
			on: self
			getState: nil
			action: #popMore
			label: #moreButtonLabel)
		hResizing: #rigid;
		vResizing: #spaceFill;
		cornerStyle: #square;
		extent: self buttonWidth asPoint! !

!OverflowRowMorph methodsFor: 'initialization' stamp: 'gvc 7/1/2010 15:01'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		baseMorphs: #();
		moreButton: self newMoreButton;
		changeTableLayout;
		listDirection: #leftToRight;
		vResizing: #shrinkWrap! !

!OverflowRowMorph methodsFor: 'as yet unclassified' stamp: 'gvc 1/11/2010 18:37'!
showMore
	"Show the morphs that don't fit."

	self hideMore.
	self recreateMoreMorph.
	self world addMorphInLayer: self moreMorph! !

!OverflowRowMorph methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 7/9/2013 12:39'!
hideMore
	"Hide the morphs that don't fit."

	self moreVisible ifTrue: [
		self moreMorph delete.
		self defer: [self world ifNotNil: [:w |
				w invalidRect: self moreMorph bounds]]]! !

!OverflowRowMorph methodsFor: 'stepping' stamp: 'gvc 1/11/2010 12:48'!
stepTime
	"Answer the desired time between steps in milliseconds."

	^100! !

!OverflowRowMorph methodsFor: 'as yet unclassified' stamp: 'gvc 1/18/2010 15:25'!
popMore
	"Hide / show the unshown base morphs."

	(self moreMorph isNil or: [self moreMorph owner isNil])
		ifTrue: [self showMore]
		ifFalse: [self hideMore]! !

!OverflowRowMorph methodsFor: 'as yet unclassified' stamp: 'gvc 7/1/2010 12:26'!
desiredMoreMorphPosition
	"Answer the position the more morph should be placed."

	^self moreButton boundsInWorld bottom + self moreMorph height > self world height
		ifTrue: [self moreButton boundsInWorld topRight - (self moreMorph width@self moreMorph height)]
		ifFalse: [self moreButton boundsInWorld bottomRight - (self moreMorph width@0)]! !

!OverflowRowMorph methodsFor: 'accessing' stamp: 'gvc 1/8/2010 20:01'!
moreMorph: anObject
	"Set the value of moreMorph"

	moreMorph := anObject! !

!OverflowRowMorph methodsFor: 'accessing' stamp: 'gvc 1/8/2010 20:01'!
moreMorph
	"Answer the value of moreMorph"

	^ moreMorph! !

!OverflowRowMorph methodsFor: 'geometry' stamp: 'AlainPlantec 7/9/2013 12:38'!
extent: aPoint
	"Refit the base morphs and potential 'more' button'"

	super extent: aPoint.
	self fitBaseMorphs.
	self defer: [self layoutChanged]
		"since possibly changing actual submorphs during layout processing"! !

!OverflowRowMorph methodsFor: 'as yet unclassified' stamp: 'gvc 1/11/2010 18:55'!
baseMorph: aRowMorph
	"Configure the receiver to match the specifications for the given morph and
	store the given morph's submorphs for later reallocation."
	
	self baseMorphs: aRowMorph submorphs.
	self
		cellInset: aRowMorph cellInset;
		layoutInset: aRowMorph layoutInset;
		height: aRowMorph minExtent y;
		minHeight: self height.
	self fitBaseMorphs! !

!OverflowRowMorph methodsFor: 'as yet unclassified' stamp: 'gvc 1/11/2010 12:48'!
moreVisible
	"Answer whether the more column is visible."

	^(self moreMorph ifNil: [^false]) owner notNil! !

!OverflowRowMorph methodsFor: 'accessing' stamp: 'gvc 1/8/2010 19:13'!
baseMorphs: anObject
	"Set the value of baseMorphs"

	baseMorphs := anObject! !

!OverflowRowMorph methodsFor: 'stepping and presenter' stamp: 'MarcusDenker 4/29/2011 00:37'!
step
	"Move the more column if it is showing."

	self moreVisible ifTrue: [
		self window ifNotNil: [:w |
			w isActive ifFalse: [self hideMore]].
		self moreMorph position = self desiredMoreMorphPosition
			ifFalse: [self hideMore]]! !

!OverflowRowMorph methodsFor: 'accessing' stamp: 'gvc 1/8/2010 19:14'!
moreButton
	"Answer the value of moreButton"

	^ moreButton! !

!OverflowRowMorph methodsFor: 'as yet unclassified' stamp: 'FernandoOlivero 4/12/2011 10:11'!
recreateMoreMorph
	"Answer a new morph showing the undisplayed base morphs.
	Assign to moreMorph."

	self moreMorph: (self theme builder newColumn: self moreMorphs).
	self moreMorph
		setProperty: #morphicLayerNumber toValue: 6;
		layoutInset: 4;
		borderStyle: (self theme taskbarThumbnailNormalBorderStyleFor: self moreMorph);
		extent: self moreMorph minExtent;
		position: self desiredMoreMorphPosition;
		paneColor: self paneColor;
		color: self paneColor.
	^self moreMorph! !

!OverflowRowMorph methodsFor: 'accessing' stamp: 'gvc 1/8/2010 19:14'!
moreButton: anObject
	"Set the value of moreButton"

	moreButton := anObject! !

!PNGReadWriter commentStamp: '<historical>'!
I am a subclass of ImageReadWriter that decodes Portable Network Graphics
(PNG) images.

Submitted by Duane Maxwell!
!PNGReadWriter methodsFor: 'miscellaneous' stamp: 'jmv 4/15/2010 10:19'!
grayColorsFor: d
	"return a color table for a gray image"

	palette := Array new: 1<<d.
	d = 1 ifTrue: [
		palette at: 1 put: Color black.
		palette at: 2 put: Color white.
		^  palette
		].
	d = 2 ifTrue: [
		palette at: 1 put: Color black.
		palette at: 2 put: (Color gray: 85.0 / 255.0).
		palette at: 3 put: (Color gray: 170.0 / 255.0).
		palette at: 4 put: Color white.
		^ palette
		].
	d = 4 ifTrue: [
		0 to: 15 do: [ :g |
			palette at: g+1 put: (Color gray: (g/15) asFloat) ].
		^ palette
		].
	d = 8 ifTrue: [
		0 to: 255 do: [ :g |
			palette at: g+1 put: (Color gray: (g/255) asFloat) ].
		^ palette
		].
! !

!PNGReadWriter methodsFor: 'chunks' stamp: 'lr 7/4/2009 10:42'!
processIHDRChunk
	width := chunk 
		longAt: 1
		bigEndian: true.
	height := chunk 
		longAt: 5
		bigEndian: true.
	bitsPerChannel := chunk at: 9.
	colorType := chunk at: 10.
	"compression := chunk at: 11."	"TODO - validate compression"
	"filterMethod := chunk at: 12."	"TODO - validate filterMethod"
	interlaceMethod := chunk at: 13.	"TODO - validate interlace method"
	(#(2 4 6 ) includes: colorType) ifTrue: [ depth := 32 ].
	(#(0 3 ) includes: colorType) ifTrue: 
		[ depth := bitsPerChannel min: 8.
		colorType = 0 ifTrue: 
			[ "grayscale"
			palette := self grayColorsFor: depth ] ].
	bitsPerPixel := (BPP at: colorType + 1) at: bitsPerChannel highBit.
	bytesPerScanline := (width * bitsPerPixel + 7) // 8.
	rowSize := width * depth + 31 >> 5! !

!PNGReadWriter methodsFor: 'filtering' stamp: 'DSM 3/25/2000 17:55'!
filterNone: count
! !

!PNGReadWriter methodsFor: 'pixel copies' stamp: 'StephaneDucasse 10/25/2013 16:18'!
copyPixelsGrayAlpha: y at: startX by: incX 
	"Handle interlaced grayscale with alpha color mode (colorType = 4)"
	| i pixel gray b |
	b := BitBlt bitPokerToForm: form.
	bitsPerChannel = 8 
		ifTrue: 
			[ startX 
				to: width - 1
				by: incX
				do: 
					[ :x | 
					i := (x // incX << 1) + 1.
					gray := thisScanline at: i.
					pixel := ((thisScanline at: i + 1) << 24) + (gray << 16) + (gray << 8) + gray.
					b 
						pixelAt: x @ y
						put: pixel ] ]
		ifFalse: 
			[ startX 
				to: width - 1
				by: incX
				do: 
					[ :x | 
					i := (x // incX << 2) + 1.
					gray := thisScanline at: i.
					pixel := ((thisScanline at: i + 2) << 24) + (gray << 16) + (gray << 8) + gray.
					b 
						pixelAt: x @ y
						put: pixel ] ]! !

!PNGReadWriter methodsFor: 'chunks' stamp: 'SvenVanCaekenberghe 10/26/2013 10:17'!
processNonInterlaced
	| z filter temp copyMethod debug |
	debug := self debugging.
	copyMethod := #(
		#copyPixelsGray:
		nil
		#copyPixelsRGB:
		#copyPixelsIndexed:
		#copyPixelsGrayAlpha:
		nil
		#copyPixelsRGBA:
	) at: colorType + 1.
 	debug ifTrue: [ Transcript cr; nextPutAll: 'NI chunk size='; print: idatChunkStream position ].
 	z := ZLibReadStream 
 		on: idatChunkStream originalContents
 		from: 1
 		to: idatChunkStream position.
	prevScanline := ByteArray new: bytesPerScanline.
	thisScanline := ByteArray new: bytesPerScanline.
	0 
		to: height - 1
		do: 
			[ :y | 
			filter := z next.
			debug ifTrue: [ filtersSeen add: filter ].
			thisScanline := z 
				next: bytesPerScanline
				into: thisScanline
				startingAt: 1.
			(debug and: [ thisScanline size < bytesPerScanline ]) ifTrue: 
				[ Transcript
					nextPutAll: ('wanted {1} but only got {2}' format: {  bytesPerScanline. (thisScanline size)  });
					cr ].
			filter = 0 ifFalse: 
				[ self 
					filterScanline: filter
					count: bytesPerScanline ].
			self 
				perform: copyMethod
				with: y.
			temp := prevScanline.
			prevScanline := thisScanline.
			thisScanline := temp ].
	z atEnd ifFalse: [ self error: 'Unexpected data' ].
	debug ifTrue: 
		[ Transcript
			nextPutAll: ' compressed size=';
			print: z position ]! !

!PNGReadWriter methodsFor: 'pixel copies' stamp: 'nice 5/10/2014 15:07'!
copyPixelsRGB: y at: startX by: incX
	"Handle interlaced RGB color mode (colorType = 2)"

	| i pixel tempForm tempBits xx loopsToDo |

	tempForm := Form extent: width@1 depth: 32.
	tempBits := tempForm bits.
	pixel := LargePositiveInteger new: 4.
	pixel at: 4 put: 16rFF.
	loopsToDo := width - startX + incX - 1 // incX.
	bitsPerChannel = 8
		ifTrue:
			[i := (startX // incX * 3) + 1.
			xx := startX+1.
			1 to: loopsToDo do:
				[ :j |
				pixel
					at: 3 put: (thisScanline at: i);
					at: 2 put: (thisScanline at: i+1);
					at: 1 put: (thisScanline at: i+2).
				tempBits at: xx put: pixel.
				i := i + 3.
				xx := xx + incX].
			transparentPixelValue
				ifNotNil: [startX to: width-1 by: incX do: [ :x |
					(tempBits at: x+1) = transparentPixelValue
						ifTrue: [	tempBits at: x+1 put: 0]]]]
		ifFalse:
			[i := (startX // incX * 6) + 1.
			xx := startX+1.
			1 to: loopsToDo do:
				[ :j |
				(transparentPixelValue == nil or: [(1 to: 6) anySatisfy: [:k | (transparentPixelValue digitAt: k) ~= (thisScanline at: i + 6 - k)]])
					ifTrue:
						[pixel
							at: 3 put: (thisScanline at: i);
							at: 2 put: (thisScanline at: i+2);
							at: 1 put: (thisScanline at: i+4).
						tempBits at: xx put: pixel.]
					ifFalse:
						[tempBits at: xx put: 0].
				i := i + 6.
				xx := xx + incX]].
	tempForm displayOn: form at: 0@y rule: Form over.

! !

!PNGReadWriter methodsFor: 'pixel copies' stamp: 'nice 5/10/2014 14:58'!
copyPixelsRGB: y
	"Handle non-interlaced RGB color mode (colorType = 2)"

	| i pixel tempForm tempBits |
	(transparentPixelValue isNil and: [ bitsPerChannel = 8 ]) ifTrue: [ "Do the same trick as in #copyPixelsRGBA:"
		| targetIndex |
		tempBits := ByteArray new: thisScanline size * 4 // 3 withAll: 16rFF.
		tempForm := Form extent: width@1 depth: 32 bits: tempBits.
		targetIndex := 1.
		1 to: thisScanline size by: 3 do: [ :index |
			tempBits
				at: targetIndex put: (thisScanline at: index);
				at: targetIndex + 1 put: (thisScanline at: index + 1);
				at: targetIndex + 2 put: (thisScanline at: index + 2).
			targetIndex := targetIndex + 4 ].
		cachedDecoderMap 
			ifNil:[cachedDecoderMap := self rgbaDecoderMapForDepth: depth].
		(BitBlt toForm: form)
			sourceForm: tempForm;
			destOrigin: 0@y;
			combinationRule: Form over;
			colorMap: cachedDecoderMap;
			copyBits.
		^self ].
	tempForm := Form extent: width@1 depth: 32.
	tempBits := tempForm bits.
	pixel := LargePositiveInteger new: 4.
	pixel at: 4 put: 16rFF.
	bitsPerChannel = 8
		ifTrue:
			[i := 1.
			1 to: width do:
				[ :x |
				pixel
					at: 3 put: (thisScanline at: i);
					at: 2 put: (thisScanline at: i+1);
					at: 1 put: (thisScanline at: i+2).
				tempBits at: x put: pixel.
				i := i + 3].
			transparentPixelValue
				ifNotNil:
					[1 to: width do: [ :x |
						(tempBits at: x) = transparentPixelValue
							ifTrue: [tempBits at: x put: 0]]]]
		ifFalse:
			[i := 1.
			1 to: width do:
				[ :x |
				(transparentPixelValue == nil or: [(1 to: 6) anySatisfy: [:k | (transparentPixelValue digitAt: k) ~= (thisScanline at: i + 6 - k)]])
					ifTrue:
						[pixel
							at: 3 put: (thisScanline at: i);
							at: 2 put: (thisScanline at: i+2);
							at: 1 put: (thisScanline at: i+4).
						tempBits at: x put: pixel]
					ifFalse:
						[tempBits at: x put: 0].
				i := i + 6]].
	
	tempForm displayOn: form at: 0@y rule: Form over.
! !

!PNGReadWriter methodsFor: 'writing' stamp: 'ar 2/19/2004 00:10'!
writeType6DataOn: zStream
	"Write RGBA data."
	| scanline hack hackBlt cm miscBlt |
	scanline := ByteArray new: bytesPerScanline.
	hack := Form extent: width@1 depth: 32 bits: scanline.
	form depth = 16 ifTrue:[
		"Expand 16 -> 32"
		miscBlt := BitBlt toForm: hack.
		miscBlt sourceForm: form.
		miscBlt combinationRule: Form over.
		miscBlt destOrigin: 0@0.
		miscBlt width: width; height: 1.
	].
	hackBlt := BitBlt toForm: hack.
	hackBlt sourceForm: (miscBlt ifNil:[form] ifNotNil:[hack]).
	hackBlt combinationRule: Form over.
	hackBlt destOrigin: 0@0.
	hackBlt width: width; height: 1.
	bigEndian ifTrue:[
		cm := ColorMap 
			shifts: #(8 8 8 -24) 
			masks: #(16rFF0000 16rFF00 16rFF 16rFF000000).
	] ifFalse:[
		cm := ColorMap 
			shifts: #(-16 0 16 0) 
			masks: #(16rFF0000 16rFF00 16rFF 16rFF000000).
	].
	hackBlt colorMap: cm.
	0 to: height-1 do:[:i|
		miscBlt ifNil:[
			hackBlt sourceOrigin: 0@i; copyBits.
		] ifNotNil:[
			miscBlt sourceOrigin: 0@i; copyBits.
			hack fixAlpha.
			hackBlt copyBits.
		].
		zStream nextPut: 0. "filterType"
		zStream nextPutAll: scanline.
	].
	zStream close.! !

!PNGReadWriter methodsFor: 'writing' stamp: 'ar 12/12/2003 18:29'!
writeSBITChunkOn: aStream
	"Write the IDAT chunk"
	aStream nextPutAll: 'sBIT' asByteArray.
	form depth = 16 ifFalse:[self error: 'Unimplemented feature'].
	aStream nextPut: 5.
	aStream nextPut: 5.
	aStream nextPut: 5.
	aStream nextPut: 1.! !

!PNGReadWriter methodsFor: 'chunks' stamp: 'lr 7/4/2009 10:42'!
processPLTEChunk
	| colorCount i |
	colorCount := chunk size // 3.	"TODO - validate colorCount against depth"
	palette := Array new: colorCount.
	0 
		to: colorCount - 1
		do: 
			[ :index | 
			i := index * 3 + 1.
			palette 
				at: index + 1
				put: (Color 
						r: (chunk at: i) / 255.0
						g: (chunk at: i + 1) / 255.0
						b: (chunk at: i + 2) / 255.0) ]! !

!PNGReadWriter methodsFor: 'pixel copies' stamp: 'ar 2/19/2004 00:10'!
rgbaDecoderMapForDepth: decoderDepth
	bigEndian ifTrue:[
		depth = 16 ifTrue:[
			"Big endian, 32 -> 16 color mapping."
			^ColorMap
				shifts: #(-17 -14 -11 0)
				masks: #(16rF8000000 16rF80000 16rF800 16r00)
		] ifFalse:[
			"Big endian, 32 -> 32 color mapping"
			^ColorMap 
				shifts: #(-8 -8 -8 24) 
				masks: #(16rFF000000 16rFF0000 16rFF00 16rFF).
		].
	].
	depth = 16 ifTrue:[
		"Little endian, 32 -> 16 color mapping."
		^ColorMap
			shifts: #(7 -6 -19 0)
			masks: #(16rF8 16rF800 16rF80000 0)
	] ifFalse:[
		"Little endian, 32 -> 32 color mapping"
		^ColorMap 
			shifts: #(-16 0 16 0) 
			masks: #(16rFF0000 16rFF00 16rFF 16rFF000000).
	].! !

!PNGReadWriter methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/26/2013 10:08'!
nextImage
	bigEndian := Smalltalk isBigEndian.
	filtersSeen := Bag new.
	idatChunkStream := nil.
	transparentPixelValue := nil.
	unknownChunks := Set new.
	stream reset.
	stream binary.
	stream skip: 8.
	[stream atEnd] whileFalse: [self processNextChunk].
	"Set up our form"
	palette ifNotNil: 
			["Dump the palette if it's the same as our standard palette"

			palette = (StandardColors copyFrom: 1 to: palette size) 
				ifTrue: [palette := nil]].
	(depth <= 8 and: [palette notNil]) 
		ifTrue: 
			[form := ColorForm extent: width @ height depth: depth.
			form colors: palette]
		ifFalse: [form := Form extent: width @ height depth: depth].
	backColor ifNotNil: [form fillColor: backColor].
 	idatChunkStream 
 		ifNil: [ self error: 'image data is missing' ]
 		ifNotNil: [ self processIDATChunk ].
	unknownChunks isEmpty 
		ifFalse: 
			["Transcript show: ' ',unknownChunks asSortedCollection asArray printString."].
	self debugging 
		ifTrue: 
			[Transcript
				cr;
				show: 'form = ' , form printString.
			Transcript
				cr;
				show: 'colorType = ' , colorType printString.
			Transcript
				cr;
				show: 'interlaceMethod = ' , interlaceMethod printString.
			Transcript
				cr;
				show: 'filters = ' , filtersSeen sortedCounts asArray printString].
	^form! !

!PNGReadWriter methodsFor: 'writing' stamp: 'ar 12/12/2003 17:08'!
writeIENDChunkOn: aStream
	"Write the IEND chunk"
	aStream nextPutAll: 'IEND' asByteArray.! !

!PNGReadWriter methodsFor: 'pixel copies' stamp: 'lr 7/4/2009 10:42'!
copyPixels: y 
	"Handle non-interlaced pixels of supported colorTypes"
	| s |
	s := #(
		#copyPixelsGray:
		nil
		#copyPixelsRGB:
		#copyPixelsIndexed:
		#copyPixelsGrayAlpha:
		nil
		#copyPixelsRGBA:
	) at: colorType + 1.
	self 
		perform: s asSymbol
		with: y! !

!PNGReadWriter methodsFor: 'writing' stamp: 'ar 1/1/1970 20:58'!
writeType3DataOn: zStream
	"Write color indexed data."
	| scanline hack hackBlt swizzleBlt swizzleHack hackDepth |
	scanline := ByteArray new: bytesPerScanline + 3 // 4 * 4.
	hackDepth := bigEndian ifTrue:[form depth] ifFalse:[form depth negated].
	hack := Form extent: width@1 depth: hackDepth bits: scanline.
	hackBlt := BitBlt toForm: hack.
	hackBlt sourceForm: form.
	hackBlt combinationRule: Form over.
	hackBlt destOrigin: 0@0.
	hackBlt width: width; height: 1.
	(form depth < 8 and:[bigEndian not]) ifTrue:[
		swizzleHack := Form new hackBits: scanline.
		swizzleBlt := BitBlt toForm: swizzleHack.
		swizzleBlt sourceForm: swizzleHack.
		swizzleBlt combinationRule: Form over.
		swizzleBlt colorMap: (StandardSwizzleMaps at: form depth).
	].
	0 to: height-1 do:[:i|
		hackBlt sourceOrigin: 0@i; copyBits.
		swizzleBlt ifNotNil:[swizzleBlt copyBits].
		zStream nextPut: 0. "filterType"
		zStream next: bytesPerScanline putAll: scanline startingAt: 1.
	].
	zStream close.! !

!PNGReadWriter methodsFor: 'chunks' stamp: 'ar 12/12/2003 18:33'!
processSBITChunk
	| rBits gBits bBits aBits |
	colorType = 6 ifFalse:[^self].
	rBits := chunk at: 1.
	gBits := chunk at: 2.
	bBits := chunk at: 3.
	aBits := chunk at: 4.
	(rBits = 5 and:[gBits = 5 and:[bBits = 5 and:[aBits = 1]]]) ifTrue:[
		depth := 16.
	].! !

!PNGReadWriter methodsFor: 'chunks' stamp: 'RAA 11/4/2000 17:00'!
processIDATChunk

	interlaceMethod = 0
		ifTrue: [ self processNonInterlaced ]
		ifFalse: [ self processInterlaced ]
! !

!PNGReadWriter methodsFor: 'chunks' stamp: 'RAA 11/5/2000 11:24'!
processPhysicalPixelChunk

	"Transcript show: '  PHYSICAL: ',chunk printString."
! !

!PNGReadWriter methodsFor: 'filtering' stamp: 'lr 7/4/2009 10:42'!
paethPredictLeft: a above: b aboveLeft: c 
	"Predicts the value of a pixel based on nearby pixels, based on
Paeth (GG II, 1991)"
	| pa pb pc |
	pa := b > c 
		ifTrue: [ b - c ]
		ifFalse: [ c - b ].
	pb := a > c 
		ifTrue: [ a - c ]
		ifFalse: [ c - a ].
	pc := a + b - c - c.
	pc < 0 ifTrue: [ pc := pc * -1 ].
	(pa <= pb and: [ pa <= pc ]) ifTrue: [ ^ a ].
	pb <= pc ifTrue: [ ^ b ].
	^ c! !

!PNGReadWriter methodsFor: 'writing' stamp: 'ar 12/12/2003 17:21'!
writeIHDRChunkOn: aStream
	"Write the IHDR chunk"
	aStream nextPutAll: 'IHDR' asByteArray.
	aStream nextInt32Put: width.
	aStream nextInt32Put: height.
	aStream nextNumber: 1 put: bitsPerChannel.
	aStream nextNumber: 1 put: colorType.
	aStream nextNumber: 1 put: 0. "compression"
	aStream nextNumber: 1 put: 0. "filter method"
	aStream nextNumber: 1 put: 0. "interlace method"
! !

!PNGReadWriter methodsFor: 'writing' stamp: 'nk 2/17/2004 16:51'!
updateCrc: oldCrc from: start to: stop in: aCollection
	^ZipWriteStream updateCrc: oldCrc from: start to: stop in: aCollection! !

!PNGReadWriter methodsFor: 'pixel copies' stamp: 'StephaneDucasse 10/25/2013 16:18'!
copyPixelsIndexed: y at: startX by: incX 
	"Handle interlaced indexed color mode (colorType = 3)"
	| offset bits pixPerByte shifts blitter pixel mask pixelNumber |
	offset := y * rowSize + 1.
	bits := form bits.
	bitsPerChannel = 8 ifTrue: 
		[ startX 
			to: width - 1
			by: incX
			do: 
				[ :x | | w b | 
				w := offset + (x >> 2).
				b := (3 - (x \\ 4)) * 8.
				pixel := (thisScanline at: x // incX + 1) << b.
				mask := (255 << b) bitInvert32.
				bits 
					at: w
					put: (((bits at: w) bitAnd: mask) bitOr: pixel) ].
		^ self ].
	bitsPerChannel = 1 ifTrue: 
		[ pixPerByte := 8.
		mask := 1.
		shifts := #(7 6 5 4 3 2 1 0 ) ].
	bitsPerChannel = 2 ifTrue: 
		[ pixPerByte := 4.
		mask := 3.
		shifts := #(6 4 2 0 ) ].
	bitsPerChannel = 4 ifTrue: 
		[ pixPerByte := 2.
		mask := 15.
		shifts := #(4 0 ) ].
	blitter := BitBlt bitPokerToForm: form.
	pixelNumber := 0.
	startX 
		to: width - 1
		by: incX
		do: 
			[ :x | | rawByte | 
			rawByte := thisScanline at: pixelNumber // pixPerByte + 1.
			pixel := rawByte >> (shifts at: pixelNumber \\ pixPerByte + 1) bitAnd: mask.
			blitter 
				pixelAt: x @ y
				put: pixel.
			pixelNumber := pixelNumber + 1 ]! !

!PNGReadWriter methodsFor: 'filtering' stamp: 'lr 7/4/2009 10:42'!
filterHorizontal: count 
	"Use the pixel to the left as a predictor"
	| delta |
	delta := bitsPerPixel // 8 max: 1.
	delta + 1 
		to: count
		do: 
			[ :i | 
			thisScanline 
				at: i
				put: ((thisScanline at: i) + (thisScanline at: i - delta) bitAnd: 255) ]! !

!PNGReadWriter methodsFor: 'pixel copies' stamp: 'nice 5/10/2014 12:11'!
copyPixelsGray: y 
	"Handle non-interlaced grayscale color mode (colorType = 0)"

	| base bits bytesLeft word |
	bitsPerChannel = 16 ifTrue: [
		"Warning: This is extremely slow. Besides we are downsampling to 8 bits!!"
		| blitter |
		blitter := BitBlt bitPokerToForm: form.
		0 to: width - 1 do: [ :x |
			| high low value |
			high := thisScanline at: x * 2 + 1.
			low := thisScanline at: x * 2 + 2.
			value := (high * 256 + low = transparentPixelValue)
				ifTrue: [0 "transparent"]
				ifFalse: [high max: 1].
			blitter pixelAt: x @ y put: value ].
			^self ].

	"Just copy the bits"

	"This Smalltalk version might be easier to understand than the others below."
	base := y * (form width * bitsPerChannel + 31 // 32) + 1.
	bits := form bits.
	0 to: thisScanline size // 4 - 1 do: [ :i |
		| ii |
		ii := i * 4.
		"This somewhat weird mixture of (#* and #+) with (#bitShift: and #bitOr:) 
		is to make use of faster arithmetic bytecodes, but not of slow largeintegers."
		word :=
			(((thisScanline at: ii + 1) * 256 + 
			(thisScanline at: ii + 2) * 256 + 
			(thisScanline at: ii + 3)) bitShift: 8) bitOr: 
			(thisScanline at: ii + 4).
		bits at: base + i put: word ].	
	(bytesLeft := thisScanline size bitAnd: 3) = 0 ifFalse: [
		word := 0.
		thisScanline size - bytesLeft + 1 to: thisScanline size do: [ :ii |
			word := word * 256 + (thisScanline at: ii) ].
		word := word bitShift: 8 * (4 - bytesLeft).
		bits at: base + (thisScanline size // 4) put: word ].

	"This interesting technique (By Andreas Raab) is faster for very large images, but might be slower for small ones"
	"^self copyPixelsGrayWeirdBitBltHack: y ".
	"It uses the following method:
	PNGReadWriter >> copyPixelsGrayWeirdBitBltHack: y 
	""Handle non-interlaced black and white color mode (colorType = 0)
	By Andreas Raab""
	
	| source dest cmap |
	source := Form extent: 1 @ (thisScanline size // 4) depth: 32 bits: thisScanline.
	dest := Form extent: 1 @ (form bits size) depth: 32 bits: form bits.
	cmap := Smalltalk isLittleEndian
		ifTrue:[ColorMap 
					shifts: #(-24 -8 8 24) 
					masks: #(16rFF000000 16r00FF0000 16r0000FF00 16r000000FF)].
	(BitBlt toForm: dest)
		sourceForm: source;
		destX: 0 destY: (y * form width*bitsPerChannel//32) width: 1 height: (form width+31*bitsPerChannel//32);
		colorMap: cmap;
		combinationRule: 3;
		copyBits."
		
	"This interesting technique  (By Yoshiki Ohshima) is faster for very large images, but might be slower for small ones"
	"form bits copyFromByteArray2: thisScanline to: y * (form width* bitsPerChannel // 32)".
	"It uses the following method:
	BitMap >> copyFromByteArray2: byteArray to: i
	""This method should work with either byte orderings""

	| myHack byteHack |
	myHack := Form new hackBits: self.
	byteHack := Form new hackBits: byteArray.
	Smalltalk  isLittleEndian ifTrue: [byteHack swapEndianness].
	byteHack displayOn: myHack at:  0@i"! !

!PNGReadWriter methodsFor: 'filtering' stamp: 'lr 7/4/2009 10:42'!
filterAverage: count 
	"Use the average of the pixel to the left and the pixel above as a predictor"
	| delta |
	delta := bitsPerPixel // 8 max: 1.
	1 
		to: delta
		do: 
			[ :i | 
			thisScanline 
				at: i
				put: ((thisScanline at: i) + ((prevScanline at: i) // 2) bitAnd: 255) ].
	delta + 1 
		to: count
		do: 
			[ :i | 
			thisScanline 
				at: i
				put: ((thisScanline at: i) + (((prevScanline at: i) + (thisScanline at: i - delta)) // 2) bitAnd: 255) ]! !

!PNGReadWriter methodsFor: 'chunks' stamp: 'lr 7/4/2009 10:42'!
processBackgroundChunk
	"Transcript show: '  BACKGROUND: ',chunk printString."
	| val red green blue max |
	colorType = 3 ifTrue: 
		[ backColor := palette at: chunk first + 1.
		^ self ].
	max := (2 raisedTo: bitsPerChannel) - 1.
	(colorType = 0 or: [ colorType = 4 ]) ifTrue: 
		[ val := chunk 
			unsignedShortAt: 1
			bigEndian: true.
		backColor := Color gray: val / max.
		^ self ].
	(colorType = 2 or: [ colorType = 6 ]) ifTrue: 
		[ red := chunk 
			unsignedShortAt: 1
			bigEndian: true.
		green := chunk 
			unsignedShortAt: 3
			bigEndian: true.
		blue := chunk 
			unsignedShortAt: 5
			bigEndian: true.
		backColor := Color 
			r: red / max
			g: green / max
			b: blue / max.
		^ self ]
	"self halt."

	"====
The bKGD chunk specifies a default background color to present the image against. Note that viewers are not bound to honor this chunk; a viewer can choose to use a different background. 

For color type 3 (indexed color), the bKGD chunk contains: 


   Palette index:  1 byte

The value is the palette index of the color to be used as background. 

For color types 0 and 4 (grayscale, with or without alpha), bKGD contains: 


   Gray:  2 bytes, range 0 .. (2^bitdepth)-1

(For consistency, 2 bytes are used regardless of the image bit depth.) The value is the gray level to be used as background. 

For color types 2 and 6 (truecolor, with or without alpha), bKGD contains: 


   Red:   2 bytes, range 0 .. (2^bitdepth)-1
   Green: 2 bytes, range 0 .. (2^bitdepth)-1
   Blue:  2 bytes, range 0 .. (2^bitdepth)-1

(For consistency, 2 bytes per sample are used regardless of the image bit depth.) This is the RGB color to be used as background. 

When present, the bKGD chunk must precede the first IDAT chunk, and must follow the PLTE chunk, if any. 
==="! !

!PNGReadWriter methodsFor: 'chunks' stamp: 'SvenVanCaekenberghe 10/26/2013 10:11'!
processNextChunk
	| length chunkType crc chunkCrc |
	length := self nextLong.
	chunkType := (self next: 4) asString.
 	(chunk isNil or: [ chunk size ~= length ])
 		ifTrue: [ chunk := self next: length ]
 		ifFalse: [ stream next: length into: chunk startingAt: 1 ].
	chunkCrc := self nextLong bitXor: 4294967295.
	crc := self 
		updateCrc: 4294967295
		from: 1
		to: 4
		in: chunkType.
	crc := self 
		updateCrc: crc
		from: 1
		to: length
		in: chunk.
	crc = chunkCrc ifFalse: [ self error: 'PNGReadWriter crc error in chunk ' , chunkType ].
	chunkType = 'IEND' ifTrue: [ ^ self	"*should* be the last chunk" ].
	chunkType = 'sBIT' ifTrue: 
		[ ^ self processSBITChunk	"could indicate unusual sample depth in original" ].
	chunkType = 'gAMA' ifTrue: [ ^ self	"indicates gamma correction value" ].
	chunkType = 'bKGD' ifTrue: [ ^ self processBackgroundChunk ].
	chunkType = 'pHYs' ifTrue: [ ^ self processPhysicalPixelChunk ].
	chunkType = 'tRNS' ifTrue: [ ^ self processTransparencyChunk ].
	chunkType = 'IHDR' ifTrue: [ ^ self processIHDRChunk ].
	chunkType = 'PLTE' ifTrue: [ ^ self processPLTEChunk ].
	chunkType = 'IDAT' ifTrue: 
		[ "---since the compressed data can span multiple
		chunks, stitch them all together first. later,
		if memory is an issue, we need to figure out how
		to do this on the fly---"
 		idatChunkStream
 			ifNil: [ idatChunkStream := WriteStream with: chunk copy ]
 			ifNotNil: [ idatChunkStream nextPutAll: chunk ].
		^ self ].
	unknownChunks add: chunkType! !

!PNGReadWriter methodsFor: 'filtering' stamp: 'lr 7/4/2009 10:42'!
filterPaeth: count 
	"Select one of (the pixel to the left, the pixel above and the pixel to above left) to
	predict the value of this pixel"
	| delta |
	delta := bitsPerPixel // 8 max: 1.
	1 
		to: delta
		do: 
			[ :i | 
			thisScanline 
				at: i
				put: ((thisScanline at: i) + (prevScanline at: i) bitAnd: 255) ].
	delta + 1 
		to: count
		do: 
			[ :i | 
			thisScanline 
				at: i
				put: ((thisScanline at: i) + (self 
						paethPredictLeft: (thisScanline at: i - delta)
						above: (prevScanline at: i)
						aboveLeft: (prevScanline at: i - delta)) bitAnd: 255) ]! !

!PNGReadWriter methodsFor: 'writing' stamp: 'lr 7/4/2009 10:42'!
writeIDATChunkOn: aStream 
	"Write the IDAT chunk"
	| z |
	aStream nextPutAll: 'IDAT' asByteArray.
	z := ZLibWriteStream on: aStream.
	form depth <= 8 
		ifTrue: [ self writeType3DataOn: z ]
		ifFalse: [ self writeType6DataOn: z ].
	self debugging ifTrue: 
		[ Transcript
			cr;
			nextPutAll: 'compressed size=';
			print: aStream position;
			nextPutAll: ' uncompressed size=';
			print: z position ]! !

!PNGReadWriter methodsFor: 'writing' stamp: 'ar 12/12/2003 16:37'!
nextPutImage: aForm
	"Write out the given form. We're keeping it simple here, no interlacing, no filters."
	^self nextPutImage: aForm interlace: 0 filter: 0. "no filtering"! !

!PNGReadWriter methodsFor: 'writing' stamp: 'ar 12/12/2003 17:34'!
writeTRNSChunkOn: aStream
	"Write out tRNS chunk"
	aStream nextPutAll: 'tRNS' asByteArray.
	form colors do:[:aColor|
		aStream nextPut: (aColor alpha * 255) truncated.
	].! !

!PNGReadWriter methodsFor: 'pixel copies' stamp: 'lr 7/4/2009 10:42'!
copyPixelsRGBA: y 
	"Handle non-interlaced RGBA color modes (colorType = 6)"
	| i pixel tempForm tempBits ff |
	bitsPerChannel = 8 ifTrue: 
		[ ff := Form 
			extent: width @ 1
			depth: 32
			bits: thisScanline.
		cachedDecoderMap ifNil: [ cachedDecoderMap := self rgbaDecoderMapForDepth: depth ].
		(BitBlt toForm: form)
			sourceForm: ff;
			destOrigin: 0 @ y;
			combinationRule: Form over;
			colorMap: cachedDecoderMap;
			copyBits.
		^ self ].
	tempForm := Form 
		extent: width @ 1
		depth: 32.
	tempBits := tempForm bits.
	pixel := LargePositiveInteger new: 4.
	i := -7.
	0 
		to: width - 1
		do: 
			[ :x | 
			i := i + 8.
			pixel
				at: 4
					put: (thisScanline at: i + 6);
				at: 3
					put: (thisScanline at: i);
				at: 2
					put: (thisScanline at: i + 2);
				at: 1
					put: (thisScanline at: i + 4).
			tempBits 
				at: x + 1
				put: pixel ].
	tempForm 
		displayOn: form
		at: 0 @ y
		rule: Form over! !

!PNGReadWriter methodsFor: 'writing' stamp: 'lr 7/4/2009 10:42'!
writeChunk: crcStream 
	| bytes length crc debug |
	debug := self debugging.
	bytes := crcStream originalContents.
	length := crcStream position.
	crc := self 
		updateCrc: 4294967295
		from: 1
		to: length
		in: bytes.
	crc := crc bitXor: 4294967295.
	debug ifTrue: 
		[ Transcript
			cr;
			print: stream position;
			space;
			nextPutAll: (bytes 
					copyFrom: 1
					to: 4) asString;
			nextPutAll: ' len=';
			print: length;
			nextPutAll: ' crc=0x';
			nextPutAll: crc printStringHex ].
	stream 
		nextNumber: 4
		put: length - 4.	"exclude chunk name"
	stream 
		next: length
		putAll: bytes
		startingAt: 1.
	stream 
		nextNumber: 4
		put: crc.
	debug ifTrue: 
		[ Transcript
			nextPutAll: ' afterPos=';
			print: stream position ].
	crcStream resetToStart! !

!PNGReadWriter methodsFor: 'miscellaneous' stamp: 'DSM 4/27/2000 13:09'!
doPass: pass
	"Certain interlace passes are skipped with certain small image
dimensions"

	pass = 1 ifTrue: [ ^ true ].
	((width = 1) and: [height = 1]) ifTrue: [ ^ false ].
	pass = 2 ifTrue: [ ^ width >= 5 ].
	pass = 3 ifTrue: [ ^ height >= 5 ].
	pass = 4 ifTrue: [ ^ (width >=3 ) or: [height >= 5] ].
	pass = 5 ifTrue: [ ^ height >=3 ].
	pass = 6 ifTrue: [ ^ width >=2 ].
	pass = 7 ifTrue: [ ^ height >=2 ].

! !

!PNGReadWriter methodsFor: 'chunks' stamp: 'SvenVanCaekenberghe 10/26/2013 10:09'!
processInterlaced
	| z filter bytesPerPass startingCol colIncrement rowIncrement startingRow cx sc temp |
	startingCol := #(0 4 0 2 0 1 0 ).
	colIncrement := #(8 8 4 4 2 2 1 ).
	rowIncrement := #(8 8 8 4 4 2 2 ).
	startingRow := #(0 0 4 0 2 0 1 ).
 	z := ZLibReadStream 
 		on: idatChunkStream originalContents
 		from: 1
 		to: idatChunkStream position.
	1 
		to: 7
		do: 
			[ :pass | 
			(self doPass: pass) ifTrue: 
				[ cx := colIncrement at: pass.
				sc := startingCol at: pass.
				bytesPerPass := ((width - sc + cx - 1) // cx * bitsPerPixel + 7) // 8.
				prevScanline := ByteArray new: bytesPerPass.
				thisScanline := ByteArray new: bytesPerScanline.
				(startingRow at: pass) 
					to: height - 1
					by: (rowIncrement at: pass)
					do: 
						[ :y | 
						filter := z next.
						filtersSeen add: filter.
						(filter isNil or: [ (filter 
							between: 0
							and: 4) not ]) ifTrue: [ ^ self ].
						thisScanline := z 
							next: bytesPerPass
							into: thisScanline
							startingAt: 1.
						self 
							filterScanline: filter
							count: bytesPerPass.
						self 
							copyPixels: y
							at: sc
							by: cx.
						temp := prevScanline.
						prevScanline := thisScanline.
						thisScanline := temp ] ] ].
	z atEnd ifFalse: [ self error: 'Unexpected data' ]! !

!PNGReadWriter methodsFor: 'writing' stamp: 'StephaneDucasse 2/2/2010 12:15'!
writeFileSignature
	stream nextPutAll: #[16r89 16r50 16r4E  16r47 16r0D 16r0A 16r1A 16r0A]! !

!PNGReadWriter methodsFor: 'filtering' stamp: 'eat 9/11/2000 20:08'!
filterScanline: filterType count: count

	self
		perform: (
			#(filterNone: filterHorizontal: filterVertical: filterAverage: filterPaeth:)
				at: filterType+1)
		with: count.

! !

!PNGReadWriter methodsFor: 'writing' stamp: 'StephaneDucasse 3/17/2010 21:16'!
nextPutImage: aForm interlace: aMethod filter: aFilterType 
	"Note: For now we keep it simple - interlace and filtering are simply ignored"

	| crcStream |
	bigEndian := Smalltalk isBigEndian.
	form := aForm.
	width := aForm width.
	height := aForm height.
	aForm depth <= 8 
		ifTrue: 
			[bitsPerChannel := aForm depth.
			colorType := 3.
			bytesPerScanline := (width * aForm depth + 7) // 8]
		ifFalse: 
			[bitsPerChannel := 8.
			colorType := 6.
			bytesPerScanline := width * 4].
	self writeFileSignature.
	crcStream := (ByteArray new: 1000) writeStream.
	crcStream resetToStart.
	self writeIHDRChunkOn: crcStream.
	self writeChunk: crcStream.
	form depth <= 8 
		ifTrue: 
			[crcStream resetToStart.
			self writePLTEChunkOn: crcStream.
			self writeChunk: crcStream.
			form isColorForm 
				ifTrue: 
					[crcStream resetToStart.
					self writeTRNSChunkOn: crcStream.
					self writeChunk: crcStream]].
	form depth = 16 
		ifTrue: 
			[crcStream resetToStart.
			self writeSBITChunkOn: crcStream.
			self writeChunk: crcStream].
	crcStream resetToStart.
	self writeIDATChunkOn: crcStream.
	self writeChunk: crcStream.
	crcStream resetToStart.
	self writeIENDChunkOn: crcStream.
	self writeChunk: crcStream! !

!PNGReadWriter methodsFor: 'pixel copies' stamp: 'lr 7/4/2009 10:42'!
copyPixelsRGBA: y at: startX by: incX 
	"Handle interlaced RGBA color modes (colorType = 6)"
	| i pixel tempForm tempBits |
	tempForm := Form 
		extent: width @ 1
		depth: 32.
	tempBits := tempForm bits.
	pixel := LargePositiveInteger new: 4.
	bitsPerChannel = 8 
		ifTrue: 
			[ i := (startX // incX << 2) + 1.
			startX 
				to: width - 1
				by: incX
				do: 
					[ :x | 
					pixel
						at: 4
							put: (thisScanline at: i + 3);
						at: 3
							put: (thisScanline at: i);
						at: 2
							put: (thisScanline at: i + 1);
						at: 1
							put: (thisScanline at: i + 2).
					tempBits 
						at: x + 1
						put: pixel.
					i := i + 4 ] ]
		ifFalse: 
			[ i := (startX // incX << 3) + 1.
			startX 
				to: width - 1
				by: incX
				do: 
					[ :x | 
					pixel
						at: 4
							put: (thisScanline at: i + 6);
						at: 3
							put: (thisScanline at: i);
						at: 2
							put: (thisScanline at: i + 2);
						at: 1
							put: (thisScanline at: i + 4).
					tempBits 
						at: x + 1
						put: pixel.
					i := i + 8 ] ].
	tempForm 
		displayOn: form
		at: 0 @ y
		rule: Form paintAlpha! !

!PNGReadWriter methodsFor: 'pixel copies' stamp: 'StephaneDucasse 10/25/2013 16:18'!
copyPixelsGrayAlpha: y 
	"Handle non-interlaced grayscale with alpha color mode (colorType = 4)"
	| i pixel gray b |
	b := BitBlt bitPokerToForm: form.
	bitsPerChannel = 8 
		ifTrue: 
			[ 0 
				to: width - 1
				do: 
					[ :x | 
					i := (x << 1) + 1.
					gray := thisScanline at: i.
					pixel := ((thisScanline at: i + 1) << 24) + (gray << 16) + (gray << 8) + gray.
					b 
						pixelAt: x @ y
						put: pixel ] ]
		ifFalse: 
			[ 0 
				to: width - 1
				do: 
					[ :x | 
					i := (x << 2) + 1.
					gray := thisScanline at: i.
					pixel := ((thisScanline at: i + 2) << 24) + (gray << 16) + (gray << 8) + gray.
					b 
						pixelAt: x @ y
						put: pixel ] ]! !

!PNGReadWriter methodsFor: 'writing' stamp: 'nice 1/5/2010 15:59'!
writePLTEChunkOn: aStream
	"Write the PLTE chunk"
	| colors |
	aStream nextPutAll: 'PLTE' asByteArray.
	(form isColorForm) 
		ifTrue:[colors := form colors]
		ifFalse:[colors := Color indexedColors copyFrom: 1 to: (1 bitShift: form depth)].
	colors do:[:aColor| | r g b |
		r := (aColor red * 255) truncated.
		g := (aColor green * 255) truncated.
		b := (aColor blue * 255) truncated.
		aStream nextPut: r; nextPut: g; nextPut: b.
	].! !

!PNGReadWriter methodsFor: 'chunks' stamp: 'nice 5/10/2014 14:59'!
processTransparencyChunk

	"Transcript show: '  TRANSPARENCY ',chunk printString."
	colorType = 0
		ifTrue:
			[transparentPixelValue := chunk unsignedShortAt: 1 bigEndian: true.
			bitsPerChannel <= 8
				ifTrue: [palette at: transparentPixelValue + 1 put: Color transparent]
				ifFalse: [palette at: 1 put: Color transparent].
			^self].
	colorType = 2
		ifTrue:
			[| red green blue |
			red :=  chunk unsignedShortAt: 1 bigEndian: true.
			green :=  chunk unsignedShortAt: 3 bigEndian: true.
			blue :=  chunk unsignedShortAt: 5 bigEndian: true.
			transparentPixelValue := bitsPerChannel <= 8
				ifTrue: [16rFF00 + red << 8 + green << 8 + blue]
				ifFalse: [red << 16 + green << 16 + blue].
			^self].
	colorType = 3
		ifTrue:
			[chunk withIndexDo: [ :alpha :index |
				palette at: index put: ((palette at: index) alpha: alpha/255)].
			^self].
! !

!PNGReadWriter methodsFor: 'pixel copies' stamp: 'ar 1/1/1970 21:00'!
copyPixelsIndexed: y
	"Handle non-interlaced indexed color mode (colorType = 3)"
	| hack hackBlt swizzleHack swizzleBlt scanline hackDepth |
	scanline := ByteArray new: bytesPerScanline + 3 // 4 * 4.
	scanline replaceFrom: 1 to: thisScanline size with: thisScanline startingAt: 1.
	hackDepth := bigEndian ifTrue:[form depth] ifFalse:[form depth negated].
	hack := Form extent: width@1 depth: hackDepth bits: scanline.
	hackBlt := BitBlt toForm: form.
	hackBlt sourceForm: hack.
	hackBlt combinationRule: Form over.
	hackBlt destOrigin: 0@y.
	hackBlt width: width; height: 1.

	(form depth < 8 and:[bigEndian not]) ifTrue:[
		swizzleHack := Form new hackBits: scanline.
		swizzleBlt := BitBlt toForm: swizzleHack.
		swizzleBlt sourceForm: swizzleHack.
		swizzleBlt combinationRule: Form over.
		swizzleBlt colorMap: (StandardSwizzleMaps at: form depth).
		swizzleBlt copyBits.
	].

	hackBlt copyBits.! !

!PNGReadWriter methodsFor: 'pixel copies' stamp: 'nice 5/10/2014 13:54'!
copyPixelsGray: y at: startX by: incX
	"Handle interlaced grayscale color mode (colorType = 0)"

	| offset bits blitter pixPerByte shifts b pixel mask pixelNumber |
	bitsPerChannel = 16
		ifTrue: [
			"Warning: This is extremely slow. Besides we are downsampling to 8 bits!!"
			blitter := BitBlt bitPokerToForm: form.
			startX to: width-1 by: incX do: [ :x |
				| high low value |
				high := thisScanline at: x//incX<<1 + 1.
				low := thisScanline at: x//incX<<1 + 2.
				value := (high * 256 + low = transparentPixelValue)
					ifTrue: [0 "transparent"]
					ifFalse: [high max: 1].
				blitter pixelAt: x @ y put: value ].
				^self ].
	offset := y*rowSize+1.
	bits := form bits.
	bitsPerChannel = 8 ifTrue: [
		startX to: width-1 by: incX do: [ :x | | w |
			w := offset + (x>>2).
			b := 3- (x \\ 4) * 8.
			pixel := (thisScanline at: x // incX + 1)<<b.
			mask := (255<<b) bitInvert32.
			bits at: w put: (((bits at: w) bitAnd: mask) bitOr: pixel)
		].
		^ self
	].
	bitsPerChannel = 1 ifTrue: [
		pixPerByte := 8.
		mask := 1.
		shifts := #(7 6 5 4 3 2 1 0).
	].
	bitsPerChannel = 2 ifTrue: [
		pixPerByte := 4.
		mask := 3.
		shifts := #(6 4 2 0).
	].
	bitsPerChannel = 4 ifTrue: [
		pixPerByte := 2.
		mask := 15.
		shifts := #(4 0).
	].

	blitter := BitBlt bitPokerToForm: form.
	pixelNumber := 0.
	startX to: width-1 by: incX do: [ :x | | rawByte |
		rawByte := thisScanline at: (pixelNumber // pixPerByte) + 1.
		pixel := (rawByte >> (shifts at: (pixelNumber \\ pixPerByte) + 1)) bitAnd: mask.
		blitter pixelAt: (x@y) put: pixel.
		pixelNumber := pixelNumber + 1.
	].
! !

!PNGReadWriter methodsFor: 'pixel copies' stamp: 'lr 7/4/2009 10:42'!
copyPixels: y at: startX by: incX 
	"Handle interlaced pixels of supported colorTypes"
	| s |
	s := #(
		#copyPixelsGray:at:by:
		nil
		#copyPixelsRGB:at:by:
		#copyPixelsIndexed:at:by:
		#copyPixelsGrayAlpha:at:by:
		nil
		#copyPixelsRGBA:at:by:
	) at: colorType + 1.
	self 
		perform: s asSymbol
		with: y
		with: startX
		with: incX! !

!PNGReadWriter methodsFor: 'accessing' stamp: 'DSM 3/24/2000 01:12'!
understandsImageFormat
	#(137 80 78 71 13 10 26 10) do: [ :byte |
		stream next = byte ifFalse: [^ false]].
	^ true
! !

!PNGReadWriter methodsFor: 'filtering' stamp: 'DSM 3/25/2000 17:54'!
filterVertical: count
	"Use the pixel above as a predictor"

	1 to: count do: [ :i |
		thisScanline at: i put: (((thisScanline at: i) +
(prevScanline at: i)) bitAnd: 255) ]

! !

!PNGReadWriter methodsFor: 'accessing' stamp: 'RAA 11/7/2000 09:20'!
debugging

	^Debugging == true! !

!PNGReadWriter class methodsFor: 'initialize' stamp: 'lr 7/4/2009 10:42'!
initialize
	"
	PNGReadWriter initialize
	"
	BPP := { 
		#(1 2 4 8 16 ).
		#(0 0 0 0 0 ).
		#(0 0 0 24 48 ).
		#(1 2 4 8 0 ).
		#(0 0 0 16 32 ).
		#(0 0 0 0 0 ).
		#(0 0 0 32 64 ).
		#(0 0 0 0 0 )
	 }.
	BlockHeight := #(8 8 4 4 2 2 1 ).
	BlockWidth := #(8 4 4 2 2 1 1 ).
	StandardColors := Color indexedColors collect: 
		[ :aColor | 
		Color 
			r: (aColor red * 255) truncated / 255
			g: (aColor green * 255) truncated / 255
			b: (aColor blue * 255) truncated / 255 ].
	StandardSwizzleMaps := Array new: 4.
	#(1 2 4 ) do: 
		[ :i | 
		StandardSwizzleMaps 
			at: i
			put: (self computeSwizzleMapForDepth: i) ]! !

!PNGReadWriter class methodsFor: 'utilities' stamp: 'ar 2/11/2004 00:54'!
computeSwizzleMapForDepth: depth
	"Answer a map that maps pixels in a word to their opposite location. Used for 'middle-endian' forms where the byte-order is different from the bit order (good joke, eh?)."
	| map swizzled |
	map := Bitmap new: 256.
	depth = 4 ifTrue:[
		0 to: 255 do:[:pix|
			swizzled := 0.
			swizzled := swizzled bitOr: (((pix bitShift: 0) bitAnd: 15) bitShift: 4).
			swizzled := swizzled bitOr: (((pix bitShift: -4) bitAnd: 15) bitShift: 0).
			map at: pix+1 put: swizzled.
		].
		^ColorMap colors: map
	].

	depth = 2 ifTrue:[
		0 to: 255 do:[:pix|
			swizzled := 0.
			swizzled := swizzled bitOr: (((pix bitShift: 0) bitAnd: 3) bitShift: 6).
			swizzled := swizzled bitOr: (((pix bitShift: -2) bitAnd: 3) bitShift: 4).
			swizzled := swizzled bitOr: (((pix bitShift: -4) bitAnd: 3) bitShift: 2).
			swizzled := swizzled bitOr: (((pix bitShift: -6) bitAnd: 3) bitShift: 0).
			map at: pix+1 put: swizzled.
		].
		^ColorMap colors: map
	].

	depth = 1 ifTrue:[
		0 to: 255 do:[:pix|
			swizzled := 0.
			swizzled := swizzled bitOr: (((pix bitShift: 0) bitAnd: 1) bitShift: 7).
			swizzled := swizzled bitOr: (((pix bitShift: -1) bitAnd: 1) bitShift: 6).
			swizzled := swizzled bitOr: (((pix bitShift: -2) bitAnd: 1) bitShift: 5).
			swizzled := swizzled bitOr: (((pix bitShift: -3) bitAnd: 1) bitShift: 4).
			swizzled := swizzled bitOr: (((pix bitShift: -4) bitAnd: 1) bitShift: 3).
			swizzled := swizzled bitOr: (((pix bitShift: -5) bitAnd: 1) bitShift: 2).
			swizzled := swizzled bitOr: (((pix bitShift: -6) bitAnd: 1) bitShift: 1).
			swizzled := swizzled bitOr: (((pix bitShift: -7) bitAnd: 1) bitShift: 0).
			map at: pix+1 put: swizzled.
		].
		^ColorMap colors: map
	].
	self error: 'Unrecognized depth'! !

!PNGReadWriter class methodsFor: 'instance creation' stamp: 'lr 7/4/2009 10:42'!
createAFormFrom: data 
	| error f |
	error := ''.
	f := [ self formFromStream: (RWBinaryOrTextStream with: data) ] ifError: 
		[ :a :b | 
		error := a printString , '  ' , b printString.
		(StringMorph contents: error)
			color: Color red;
			imageForm ].
	^ {  f. error  }! !

!PNGReadWriter class methodsFor: 'initialize' stamp: 'lr 7/4/2009 10:42'!
debugging: aBoolean 
	Debugging := aBoolean! !

!PNGReadWriter class methodsFor: 'image reading/writing' stamp: 'nk 7/16/2003 17:57'!
typicalFileExtensions
	"Answer a collection of file extensions (lowercase) which files that I can read might commonly have"
	^#('png')! !

!PNGReadWriterTest methodsFor: 'tests - bits' stamp: 'ar 2/11/2004 00:39'!
test1BitDisplay
	self encodeAndDecodeDisplay: 1! !

!PNGReadWriterTest methodsFor: 'tests - decoding' stamp: 'ar 2/19/2004 00:19'!
coloredFiles8
	"Created by
		{Color red. Color green. Color blue. Color black} collect:[:fillC|
			| ff bytes |
			ff := Form extent: 32@32 depth: 8.
			ff fillColor: fillC.
			bytes := WriteStream on: ByteArray new.
			PNGReadWriter putForm: ff onStream: bytes.
			fillC ->
				(Base64MimeConverter mimeEncode: (bytes contents readStream)) contents
		].
	"
	^{Color red->
'iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAMAAABEpIrGAAADAFBMVEX///8AAAD///9/f3//
AAAA/wAAAP8A/////wD/AP8fHx8/Pz9fX1+fn5+/v7/f398HBwcPDw8XFxcnJycvLy83NzdH
R0dPT09XV1dnZ2dvb293d3eHh4ePj4+Xl5enp6evr6+3t7fHx8fPz8/X19fn5+fv7+/39/cA
AAAAMgAAZQAAmAAAywAA/wAAADIAMjIAZTIAmDIAyzIA/zIAAGUAMmUAZWUAmGUAy2UA/2UA
AJgAMpgAZZgAmJgAy5gA/5gAAMsAMssAZcsAmMsAy8sA/8sAAP8AMv8AZf8AmP8Ay/8A//8y
AAAyMgAyZQAymAAyywAy/wAyADIyMjIyZTIymDIyyzIy/zIyAGUyMmUyZWUymGUyy2Uy/2Uy
AJgyMpgyZZgymJgyy5gy/5gyAMsyMssyZcsymMsyy8sy/8syAP8yMv8yZf8ymP8yy/8y//9l
AABlMgBlZQBlmABlywBl/wBlADJlMjJlZTJlmDJlyzJl/zJlAGVlMmVlZWVlmGVly2Vl/2Vl
AJhlMphlZZhlmJhly5hl/5hlAMtlMstlZctlmMtly8tl/8tlAP9lMv9lZf9lmP9ly/9l//+Y
AACYMgCYZQCYmACYywCY/wCYADKYMjKYZTKYmDKYyzKY/zKYAGWYMmWYZWWYmGWYy2WY/2WY
AJiYMpiYZZiYmJiYy5iY/5iYAMuYMsuYZcuYmMuYy8uY/8uYAP+YMv+YZf+YmP+Yy/+Y///L
AADLMgDLZQDLmADLywDL/wDLADLLMjLLZTLLmDLLyzLL/zLLAGXLMmXLZWXLmGXLy2XL/2XL
AJjLMpjLZZjLmJjLy5jL/5jLAMvLMsvLZcvLmMvLy8vL/8vLAP/LMv/LZf/LmP/Ly//L////
AAD/MgD/ZQD/mAD/ywD//wD/ADL/MjL/ZTL/mDL/yzL//zL/AGX/MmX/ZWX/mGX/y2X//2X/
AJj/Mpj/ZZj/mJj/y5j//5j/AMv/Msv/Zcv/mMv/y8v//8v/AP//Mv//Zf//mP//y/////9E
CiHUAAAAGklEQVR4XmO4cwc/YLgz8hWMfAUjX8EIVQAAbnlwLukXXkcAAAAASUVORK5CYII='.

	Color green->
'iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAMAAABEpIrGAAADAFBMVEX///8AAAD///9/f3//
AAAA/wAAAP8A/////wD/AP8fHx8/Pz9fX1+fn5+/v7/f398HBwcPDw8XFxcnJycvLy83NzdH
R0dPT09XV1dnZ2dvb293d3eHh4ePj4+Xl5enp6evr6+3t7fHx8fPz8/X19fn5+fv7+/39/cA
AAAAMgAAZQAAmAAAywAA/wAAADIAMjIAZTIAmDIAyzIA/zIAAGUAMmUAZWUAmGUAy2UA/2UA
AJgAMpgAZZgAmJgAy5gA/5gAAMsAMssAZcsAmMsAy8sA/8sAAP8AMv8AZf8AmP8Ay/8A//8y
AAAyMgAyZQAymAAyywAy/wAyADIyMjIyZTIymDIyyzIy/zIyAGUyMmUyZWUymGUyy2Uy/2Uy
AJgyMpgyZZgymJgyy5gy/5gyAMsyMssyZcsymMsyy8sy/8syAP8yMv8yZf8ymP8yy/8y//9l
AABlMgBlZQBlmABlywBl/wBlADJlMjJlZTJlmDJlyzJl/zJlAGVlMmVlZWVlmGVly2Vl/2Vl
AJhlMphlZZhlmJhly5hl/5hlAMtlMstlZctlmMtly8tl/8tlAP9lMv9lZf9lmP9ly/9l//+Y
AACYMgCYZQCYmACYywCY/wCYADKYMjKYZTKYmDKYyzKY/zKYAGWYMmWYZWWYmGWYy2WY/2WY
AJiYMpiYZZiYmJiYy5iY/5iYAMuYMsuYZcuYmMuYy8uY/8uYAP+YMv+YZf+YmP+Yy/+Y///L
AADLMgDLZQDLmADLywDL/wDLADLLMjLLZTLLmDLLyzLL/zLLAGXLMmXLZWXLmGXLy2XL/2XL
AJjLMpjLZZjLmJjLy5jL/5jLAMvLMsvLZcvLmMvLy8vL/8vLAP/LMv/LZf/LmP/Ly//L////
AAD/MgD/ZQD/mAD/ywD//wD/ADL/MjL/ZTL/mDL/yzL//zL/AGX/MmX/ZWX/mGX/y2X//2X/
AJj/Mpj/ZZj/mJj/y5j//5j/AMv/Msv/Zcv/mMv/y8v//8v/AP//Mv//Zf//mP//y/////9E
CiHUAAAAGUlEQVR4XmPQ1cUPGHRHvoKRr2DkKxihCgBZ3bQBCq5u/AAAAABJRU5ErkJggg=='.

	Color blue->
'iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAMAAABEpIrGAAADAFBMVEX///8AAAD///9/f3//
AAAA/wAAAP8A/////wD/AP8fHx8/Pz9fX1+fn5+/v7/f398HBwcPDw8XFxcnJycvLy83NzdH
R0dPT09XV1dnZ2dvb293d3eHh4ePj4+Xl5enp6evr6+3t7fHx8fPz8/X19fn5+fv7+/39/cA
AAAAMgAAZQAAmAAAywAA/wAAADIAMjIAZTIAmDIAyzIA/zIAAGUAMmUAZWUAmGUAy2UA/2UA
AJgAMpgAZZgAmJgAy5gA/5gAAMsAMssAZcsAmMsAy8sA/8sAAP8AMv8AZf8AmP8Ay/8A//8y
AAAyMgAyZQAymAAyywAy/wAyADIyMjIyZTIymDIyyzIy/zIyAGUyMmUyZWUymGUyy2Uy/2Uy
AJgyMpgyZZgymJgyy5gy/5gyAMsyMssyZcsymMsyy8sy/8syAP8yMv8yZf8ymP8yy/8y//9l
AABlMgBlZQBlmABlywBl/wBlADJlMjJlZTJlmDJlyzJl/zJlAGVlMmVlZWVlmGVly2Vl/2Vl
AJhlMphlZZhlmJhly5hl/5hlAMtlMstlZctlmMtly8tl/8tlAP9lMv9lZf9lmP9ly/9l//+Y
AACYMgCYZQCYmACYywCY/wCYADKYMjKYZTKYmDKYyzKY/zKYAGWYMmWYZWWYmGWYy2WY/2WY
AJiYMpiYZZiYmJiYy5iY/5iYAMuYMsuYZcuYmMuYy8uY/8uYAP+YMv+YZf+YmP+Yy/+Y///L
AADLMgDLZQDLmADLywDL/wDLADLLMjLLZTLLmDLLyzLL/zLLAGXLMmXLZWXLmGXLy2XL/2XL
AJjLMpjLZZjLmJjLy5jL/5jLAMvLMsvLZcvLmMvLy8vL/8vLAP/LMv/LZf/LmP/Ly//L////
AAD/MgD/ZQD/mAD/ywD//wD/ADL/MjL/ZTL/mDL/yzL//zL/AGX/MmX/ZWX/mGX/y2X//2X/
AJj/Mpj/ZZj/mJj/y5j//5j/AMv/Msv/Zcv/mMv/y8v//8v/AP//Mv//Zf//mP//y/////9E
CiHUAAAAGUlEQVR4XmNwc8MPGNxGvoKRr2DkKxihCgCl7xgQRbPxcwAAAABJRU5ErkJggg=='.

	Color black->
'iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAMAAABEpIrGAAADAFBMVEX///8AAAD///9/f3//
AAAA/wAAAP8A/////wD/AP8fHx8/Pz9fX1+fn5+/v7/f398HBwcPDw8XFxcnJycvLy83NzdH
R0dPT09XV1dnZ2dvb293d3eHh4ePj4+Xl5enp6evr6+3t7fHx8fPz8/X19fn5+fv7+/39/cA
AAAAMgAAZQAAmAAAywAA/wAAADIAMjIAZTIAmDIAyzIA/zIAAGUAMmUAZWUAmGUAy2UA/2UA
AJgAMpgAZZgAmJgAy5gA/5gAAMsAMssAZcsAmMsAy8sA/8sAAP8AMv8AZf8AmP8Ay/8A//8y
AAAyMgAyZQAymAAyywAy/wAyADIyMjIyZTIymDIyyzIy/zIyAGUyMmUyZWUymGUyy2Uy/2Uy
AJgyMpgyZZgymJgyy5gy/5gyAMsyMssyZcsymMsyy8sy/8syAP8yMv8yZf8ymP8yy/8y//9l
AABlMgBlZQBlmABlywBl/wBlADJlMjJlZTJlmDJlyzJl/zJlAGVlMmVlZWVlmGVly2Vl/2Vl
AJhlMphlZZhlmJhly5hl/5hlAMtlMstlZctlmMtly8tl/8tlAP9lMv9lZf9lmP9ly/9l//+Y
AACYMgCYZQCYmACYywCY/wCYADKYMjKYZTKYmDKYyzKY/zKYAGWYMmWYZWWYmGWYy2WY/2WY
AJiYMpiYZZiYmJiYy5iY/5iYAMuYMsuYZcuYmMuYy8uY/8uYAP+YMv+YZf+YmP+Yy/+Y///L
AADLMgDLZQDLmADLywDL/wDLADLLMjLLZTLLmDLLyzLL/zLLAGXLMmXLZWXLmGXLy2XL/2XL
AJjLMpjLZZjLmJjLy5jL/5jLAMvLMsvLZcvLmMvLy8vL/8vLAP/LMv/LZf/LmP/Ly//L////
AAD/MgD/ZQD/mAD/ywD//wD/ADL/MjL/ZTL/mDL/yzL//zL/AGX/MmX/ZWX/mGX/y2X//2X/
AJj/Mpj/ZZj/mJj/y5j//5j/AMv/Msv/Zcv/mMv/y8v//8v/AP//Mv//Zf//mP//y/////9E
CiHUAAAAGUlEQVR4XmNgZMQPGBhHvoKRr2DkKxihCgBEmAQBphO0cAAAAABJRU5ErkJggg=='
}! !

!PNGReadWriterTest methodsFor: 'helpers' stamp: 'on 6/10/2008 16:36'!
encodeAndDecodeAlpha: original
	fileName := 'testAlpha', original depth printString,'.png'.
	self encodeAndDecode: original.
	self deleteFile.! !

!PNGReadWriterTest methodsFor: 'tests - bits' stamp: 'ar 2/11/2004 00:39'!
test16BitDisplay
	self encodeAndDecodeDisplay: 16! !

!PNGReadWriterTest methodsFor: 'tests - bits' stamp: 'ar 2/12/2004 22:50'!
test2Bit
	self encodeAndDecodeForm: (self drawStuffOn: (Form extent: 33@33 depth: 2))! !

!PNGReadWriterTest methodsFor: 'tests - decoding' stamp: 'nice 1/5/2010 15:59'!
decodeColors: colorsAndFiles depth: requiredDepth
	
	colorsAndFiles do:[:assoc| | bytes color form |
		color := assoc key.
		bytes := Base64MimeConverter mimeDecodeToBytes: assoc value readStream.
		form := PNGReadWriter formFromStream: bytes.
		self assert: form depth = requiredDepth.
		self assert: (form pixelValueAt: 1@1) = (color pixelValueForDepth: requiredDepth).
	].! !

!PNGReadWriterTest methodsFor: 'tests - decoding' stamp: 'nice 1/5/2010 15:59'!
encodeColors: colorsAndFiles depth: requiredDepth
	
	colorsAndFiles do:[:assoc| | original encoded color ff |
		color := assoc key.
		original := Base64MimeConverter mimeDecodeToBytes: assoc value readStream.
		ff := Form extent: 32@32 depth: requiredDepth.
		ff fillColor: color.
		encoded := ByteArray new writeStream.
		PNGReadWriter putForm: ff onStream: encoded.
		self assert: (encoded contents = original contents).
	].! !

!PNGReadWriterTest methodsFor: 'helpers' stamp: 'nice 1/5/2010 15:59'!
encodeAndDecode: original
	"Make sure that the given form is encoded and decoded correctly"
	| stream bytes decoded |
	"encode"
	stream := ByteArray new writeStream.
	(PNGReadWriter on: stream) nextPutImage: original; close.
	bytes := stream contents.

	self writeEncoded: bytes.

	"decode"
	stream := self readEncoded: bytes.
	decoded := (PNGReadWriter new on: stream) nextImage.
	decoded display.

	"compare"
	self assert: original width = decoded width.
	self assert: original height = decoded height.
	self assert: original depth = decoded depth.
	self assert: original bits = decoded bits.
	self assert: original class == decoded class.
	(original isColorForm) ifTrue:[
		original colors with: decoded colors do:[:c1 :c2| | maxErr |
			"we must round here due to encoding errors"
			maxErr := 1. "max. error for 8bit rgb component"
			self assert: ((c1 red * 255) truncated - (c2 red * 255) truncated) abs <= maxErr.
			self assert: ((c1 green * 255) truncated - (c2 green * 255) truncated) abs <= maxErr.
			self assert: ((c1 blue * 255) truncated - (c2 blue * 255) truncated) abs <= maxErr.
			self assert: ((c1 alpha * 255) truncated - (c2 alpha * 255) truncated) abs <= maxErr.
		].
	].! !

!PNGReadWriterTest methodsFor: 'helpers' stamp: 'on 6/10/2008 16:36'!
encodeAndDecodeColor: aColor depth: aDepth
	| aForm |
	fileName := 'testColor', aColor name, aDepth printString,'.png'.
	aForm := Form extent: 32@32 depth: aDepth.
	aForm fillColor: aColor.
	self encodeAndDecode: aForm.
	self deleteFile.
! !

!PNGReadWriterTest methodsFor: 'helpers' stamp: 'nk 2/17/2004 11:10'!
readEncoded: bytes
	"Answer a ReadStream on the file named by fileName, if possible; else a ReadStream on bytes"

	fileName ifNil:[^ bytes readStream ].
	^(FileStream oldFileOrNoneNamed: fileName) ifNil: [ 
		Transcript nextPutAll: 'can''t open ', fileName; cr.
		bytes readStream ].
! !

!PNGReadWriterTest methodsFor: 'tests - colors' stamp: 'ar 2/18/2004 23:50'!
testBlue8
	self encodeAndDecodeColor: Color blue depth: 8! !

!PNGReadWriterTest methodsFor: 'helpers' stamp: 'stephane.ducasse 6/14/2008 15:26'!
encodeAndDecodeDisplay: depth
	| form |
	fileName := 'testDisplay', depth printString,'.png'.
	form := Form extent: (Display extent min: 560@560) depth: depth.
	World fullDrawOn: form getCanvas.
	self encodeAndDecode: form.
	self deleteFile.! !

!PNGReadWriterTest methodsFor: 'tests - decoding' stamp: 'ar 2/19/2004 00:28'!
testPngEncodingColors32
	self encodeColors: self coloredFiles32 depth: 32.! !

!PNGReadWriterTest methodsFor: 'helpers' stamp: 'StephaneDucasse 6/17/2013 15:54'!
deleteFile
	fileName asFileReference ensureDelete! !

!PNGReadWriterTest methodsFor: 'tests - bits' stamp: 'ar 2/12/2004 22:49'!
testAlphaCoding
	self encodeAndDecodeAlpha: (self drawTransparentStuffOn: (Form extent: 33@33 depth: 32))! !

!PNGReadWriterTest methodsFor: 'helpers' stamp: 'on 6/10/2008 16:36'!
encodeAndDecodeForm: original
	fileName := 'testForm', original depth printString,'.png'.
	self encodeAndDecode: original.
	self deleteFile.! !

!PNGReadWriterTest methodsFor: 'helpers' stamp: 'nk 2/17/2004 18:18'!
encodeAndDecodeStream: file
	| aForm |
	file reset.
	(PNGReadWriter new on: file) understandsImageFormat ifFalse:[^self error: 'don''t understand format!!' ].
	file reset.
	aForm := (PNGReadWriter new on: file) nextImage.
	aForm ifNil:[^self error: 'nil form' ].
	aForm display.
	self encodeAndDecode: aForm.
! !

!PNGReadWriterTest methodsFor: 'tests - bits' stamp: 'ar 2/11/2004 00:44'!
test8BitColors
	self encodeAndDecodeWithColors: (self drawStuffOn: (Form extent: 33@33 depth: 8))! !

!PNGReadWriterTest methodsFor: 'tests - bits' stamp: 'ar 2/11/2004 00:39'!
test8BitDisplay
	self encodeAndDecodeDisplay: 8! !

!PNGReadWriterTest methodsFor: 'tests - bits' stamp: 'ar 2/11/2004 00:39'!
test32BitDisplay
	self encodeAndDecodeDisplay: 32! !

!PNGReadWriterTest methodsFor: 'tests - bits' stamp: 'ar 2/11/2004 00:43'!
test1BitColors
	self encodeAndDecodeWithColors: (self drawStuffOn: (Form extent: 33@33 depth: 1))! !

!PNGReadWriterTest methodsFor: 'tests - decoding' stamp: 'ar 2/19/2004 00:28'!
testPngEncodingColors16
	self encodeColors: self coloredFiles16 depth: 16.! !

!PNGReadWriterTest methodsFor: 'tests - bits' stamp: 'ar 2/11/2004 01:56'!
test4BitReversed
	self encodeAndDecodeReverse: (self drawStuffOn: (Form extent: 33@33 depth: 4))! !

!PNGReadWriterTest methodsFor: 'tests - bits' stamp: 'ar 2/12/2004 22:50'!
test8Bit
	self encodeAndDecodeForm: (self drawStuffOn: (Form extent: 33@33 depth: 8))! !

!PNGReadWriterTest methodsFor: 'tests - bits' stamp: 'ar 2/11/2004 00:43'!
test2BitColors
	self encodeAndDecodeWithColors: (self drawStuffOn: (Form extent: 33@33 depth: 2))! !

!PNGReadWriterTest methodsFor: 'helpers' stamp: 'lr 3/7/2010 12:05'!
drawTransparentStuffOn: aForm
	"Draw stuff on aForm. Avoid any symmetry."

	| canvas |
	canvas := FormCanvas on: aForm.
	canvas
		frameAndFillRectangle: (1 @ 1 corner: aForm extent - 15)
		fillColor: (Color red alpha: 0.25)
		borderWidth: 3
		borderColor: (Color green alpha: 0.5).
	canvas
		fillOval: (aForm boundingBox topRight - (15 @ -5) extent: 20 @ 20)
		color: (Color white alpha: 0.75)
		borderWidth: 1
		borderColor: Color blue.
	^ aForm	"(PNGReadWriterTest new drawStuffOn: (Form extent: 32@32 depth: 16)) display"! !

!PNGReadWriterTest methodsFor: 'tests - bits' stamp: 'ar 2/12/2004 22:50'!
test32Bit
	self encodeAndDecodeForm: (self drawStuffOn: (Form extent: 33@33 depth: 32))! !

!PNGReadWriterTest methodsFor: 'tests - colors' stamp: 'ar 2/18/2004 23:50'!
testBlue32
	self encodeAndDecodeColor: Color blue depth: 32! !

!PNGReadWriterTest methodsFor: 'tests - colors' stamp: 'ar 2/18/2004 23:50'!
testGreen32
	self encodeAndDecodeColor: Color green depth: 32! !

!PNGReadWriterTest methodsFor: 'helpers' stamp: 'lr 3/7/2010 12:05'!
drawStuffOn: aForm
	"Draw stuff on aForm. Avoid any symmetry."

	| canvas |
	canvas := FormCanvas on: aForm.
	canvas
		frameAndFillRectangle: (1 @ 1 corner: aForm extent - 15)
		fillColor: Color red
		borderWidth: 3
		borderColor: Color green.
	canvas
		fillOval: (aForm boundingBox topRight - (15 @ -5) extent: 20 @ 20)
		color: Color blue
		borderWidth: 1
		borderColor: Color white.
	^ aForm	"(PNGReadWriterTest new drawStuffOn: (Form extent: 32@32 depth: 16)) display"! !

!PNGReadWriterTest methodsFor: 'tests - colors' stamp: 'ar 2/18/2004 23:50'!
testBlack16
	self encodeAndDecodeColor: Color blue depth: 16! !

!PNGReadWriterTest methodsFor: 'tests - bits' stamp: 'ar 2/12/2004 22:50'!
test16Bit
	self encodeAndDecodeForm: (self drawStuffOn: (Form extent: 33@33 depth: 16))! !

!PNGReadWriterTest methodsFor: 'helpers' stamp: 'StephaneDucasse 2/10/2010 18:54'!
writeEncoded: bytes
	
	fileName ifNil:[^self].
	FileStream forceNewFileNamed: fileName do: [:file | file nextPutAll: bytes]! !

!PNGReadWriterTest methodsFor: 'tests - bits' stamp: 'ar 2/11/2004 01:57'!
test8BitReversed
	self encodeAndDecodeReverse: (self drawStuffOn: (Form extent: 33@33 depth: 8))! !

!PNGReadWriterTest methodsFor: 'tests - bits' stamp: 'ar 2/11/2004 01:57'!
test32BitReversed
	self encodeAndDecodeReverse: (self drawStuffOn: (Form extent: 33@33 depth: 32))! !

!PNGReadWriterTest methodsFor: 'tests - bits' stamp: 'ar 2/12/2004 22:50'!
test4Bit
	self encodeAndDecodeForm: (self drawStuffOn: (Form extent: 33@33 depth: 4))! !

!PNGReadWriterTest methodsFor: 'tests - decoding' stamp: 'ar 2/19/2004 00:28'!
testPngEncodingColors8
	self encodeColors: self coloredFiles8 depth: 8.! !

!PNGReadWriterTest methodsFor: 'helpers' stamp: 'ar 2/29/2004 03:55'!
encodeAndDecodeWithError: aStream
	self should:[self encodeAndDecodeStream: aStream] raise: Error! !

!PNGReadWriterTest methodsFor: 'tests - decoding' stamp: 'ar 2/19/2004 00:20'!
testPngDecodingColors16
	self decodeColors: self coloredFiles16 depth: 16.! !

!PNGReadWriterTest methodsFor: 'tests - bits' stamp: 'ar 2/11/2004 01:57'!
test16BitReversed
	self encodeAndDecodeReverse: (self drawStuffOn: (Form extent: 33@33 depth: 16))! !

!PNGReadWriterTest methodsFor: 'tests - bits' stamp: 'ar 2/11/2004 00:44'!
test4BitColors
	self encodeAndDecodeWithColors: (self drawStuffOn: (Form extent: 33@33 depth: 4))! !

!PNGReadWriterTest methodsFor: 'tests - bits' stamp: 'StephaneDucasse 1/19/2010 22:57'!
testPngSuite
	"Requires the suite from 
		ftp://swrinde.nde.swri.edu/pub/png/images/suite/PngSuite.zip
	to be present as PngSuite.zip"
	| file |
	file := [ FileStream readOnlyFileNamed: 'PngSuite.zip'] on: Error do:[:ex| ex return].
	file ifNil:[^self].
	[ | zip entries |zip := ZipArchive new readFrom: file.
	entries := zip members select:[:mbr| mbr fileName asLowercase endsWith: '.png'].
	entries do:[:mbr| 
		(mbr fileName asLowercase first = $x)
			ifTrue: [self encodeAndDecodeWithError: mbr contentStream ]
			ifFalse: [self encodeAndDecodeStream: mbr contentStream ] ].
	] ensure:[file close].! !

!PNGReadWriterTest methodsFor: 'tests - decoding' stamp: 'ar 2/19/2004 00:20'!
testPngDecodingColors32
	self decodeColors: self coloredFiles32 depth: 32.! !

!PNGReadWriterTest methodsFor: 'helpers' stamp: 'nk 2/17/2004 11:29'!
tearDown
	World changed.! !

!PNGReadWriterTest methodsFor: 'tests - colors' stamp: 'ar 2/18/2004 23:50'!
testBlue16
	self encodeAndDecodeColor: Color blue depth: 16! !

!PNGReadWriterTest methodsFor: 'tests - colors' stamp: 'ar 2/18/2004 23:50'!
testGreen16
	self encodeAndDecodeColor: Color green depth: 16! !

!PNGReadWriterTest methodsFor: 'tests - bits' stamp: 'ar 2/11/2004 01:56'!
test2BitReversed
	self encodeAndDecodeReverse: (self drawStuffOn: (Form extent: 33@33 depth: 2))! !

!PNGReadWriterTest methodsFor: 'tests - colors' stamp: 'ar 2/18/2004 23:49'!
testRed16
	self encodeAndDecodeColor: Color red depth: 16! !

!PNGReadWriterTest methodsFor: 'tests - decoding' stamp: 'ar 2/19/2004 00:25'!
coloredFiles16
	"Created by
		{Color red. Color green. Color blue. Color black} collect:[:fillC|
			| ff bytes |
			ff := Form extent: 32@32 depth: 16.
			ff fillColor: fillC.
			bytes := WriteStream on: ByteArray new.
			PNGReadWriter putForm: ff onStream: bytes.
			fillC ->
				(Base64MimeConverter mimeEncode: (bytes contents readStream)) contents
		].
	"
	^{Color red-> 
'iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABHNCSVQFBQUBSsjp7wAAADZJ
REFUeF7lziEBAAAMAjD6J8b9MRAT80uT65Af8AN+wA/4AT/gB/yAH/ADfsAP+AE/4AfmgQdc
z9xqBS2pdAAAAABJRU5ErkJggg=='.
	Color green->
'iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABHNCSVQFBQUBSsjp7wAAADVJ
REFUeF7lziEBAAAMAjD6J77jMRAT80sunfIDfsAP+AE/4Af8gB/wA37AD/gBP+AH/MA68HyT
3Gqf2I6NAAAAAElFTkSuQmCC'.
		Color blue->
'iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABHNCSVQFBQUBSsjp7wAAADVJ
REFUeF7lziEBAAAMAjD6J77jMRAT80ty3fIDfsAP+AE/4Af8gB/wA37AD/gBP+AH/MA48JxX
3GpYhihrAAAAAElFTkSuQmCC'.
	Color black->
'iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABHNCSVQFBQUBSsjp7wAAADVJ
REFUeF7lziEBAAAMAjDk+xfmMRAT80ty3fIDfsAP+AE/4Af8gB/wA37AD/gBP+AH/MA48LbT
HD3MKH3GAAAAAElFTkSuQmCC'
}! !

!PNGReadWriterTest methodsFor: 'helpers' stamp: 'nice 1/5/2010 15:59'!
encodeAndDecodeReverse: original
	"Make sure that the given form is encoded and decoded correctly"
	| stream bytes decoded reversed |
	fileName := 'testReverse', original depth printString,'.png'.
	self assert: original class == Form. "won't work with ColorForm"
	"Switch pixel order"
	reversed := Form extent: original extent depth: original depth negated.
	original displayOn: reversed.
	self assert: original width = reversed width.
	self assert: original height = reversed height.
	self assert: original depth = reversed depth.
	self deny: original nativeDepth = reversed nativeDepth.
	original depth = 32
		ifTrue:[self assert: original bits = reversed bits]
		ifFalse:[self deny: original bits = reversed bits].

	"encode"
	stream := ByteArray new writeStream.
	(PNGReadWriter on: stream) nextPutImage: reversed; close.
	bytes := stream contents.
	self writeEncoded: bytes.

	"decode"
	stream := bytes readStream.
	decoded := (PNGReadWriter new on: stream) nextImage.
	decoded display.

	"compare"
	self assert: original width = decoded width.
	self assert: original height = decoded height.
	self assert: original depth = decoded depth.
	self assert: original bits = decoded bits.
	self assert: original class == decoded class.
	(original isColorForm) ifTrue:[
		original colors with: decoded colors do:[:c1 :c2| | maxErr |
			"we must round here due to encoding errors"
			maxErr := 1. "max. error for 8bit rgb component"
			self assert: ((c1 red * 255) truncated - (c2 red * 255) truncated) abs <= maxErr.
			self assert: ((c1 green * 255) truncated - (c2 green * 255) truncated) abs <= maxErr.
			self assert: ((c1 blue * 255) truncated - (c2 blue * 255) truncated) abs <= maxErr.
			self assert: ((c1 alpha * 255) truncated - (c2 alpha * 255) truncated) abs <= maxErr.
		].
	].
	self deleteFile.! !

!PNGReadWriterTest methodsFor: 'helpers' stamp: 'ar 2/12/2004 22:45'!
setUp
	fileName := nil.! !

!PNGReadWriterTest methodsFor: 'tests - bits' stamp: 'ar 2/11/2004 00:39'!
test2BitDisplay
	self encodeAndDecodeDisplay: 2! !

!PNGReadWriterTest methodsFor: 'tests - colors' stamp: 'ar 2/18/2004 23:49'!
testRed8
	self encodeAndDecodeColor: Color red depth: 8! !

!PNGReadWriterTest methodsFor: 'tests - decoding' stamp: 'HenrikSperreJohansen 6/6/2010 22:33'!
coloredFiles32
	"Created by
		{Color red. Color green. Color blue. Color black} collect:[:fillC|
			| ff bytes |
			ff := Form extent: 32@32 depth: 32.
			ff fillColor: fillC.
			bytes := WriteStream on: ByteArray new.
			PNGReadWriter putForm: ff onStream: bytes.
			fillC ->
				(Base64MimeConverter mimeEncode: (bytes contents readStream)) contents
		].
	"
	^{
		Color red -> 'iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAANUlEQVR4XuXOIQEAAAwEoe9f
+hZjAoFnbfVo+QE/4Af8gB/wA37AD/gBP+AH/IAf8AN+4DlwVA34ajP6EEoAAAAASUVORK5C
YII='.
		Color green -> 'iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAAM0lEQVR4XuXOMQ0AAAACIPuX
1hgejAIkPfMDfsAP+AE/4Af8gB/wA37AD/gBP+AH/MA7MFfR+Grvv2BdAAAAAElFTkSuQmCC'.

	Color blue->
'iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAANElEQVR4XuXOIQEAAAACIP+f
1hkGAp0k7Zcf8AN+wA/4AT/gB/yAH/ADfsAP+AE/4AfOgQFblfhqnnPWHAAAAABJRU5ErkJg
gg=='.
		Color black -> 'iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAANklEQVR4XuXOsQ0AAAzCMP5/
uvQLBkfK7nw33gf4AB/gA3yAD/ABPsAH+AAf4AN8gA/wAVtAAbe1/C5AK87lAAAAAElFTkSu
QmCC'
}! !

!PNGReadWriterTest methodsFor: 'tests - decoding' stamp: 'ar 2/19/2004 00:20'!
testPngDecodingColors8
	self decodeColors: self coloredFiles8 depth: 8.! !

!PNGReadWriterTest methodsFor: 'tests - bits' stamp: 'ar 2/11/2004 00:39'!
test4BitDisplay
	self encodeAndDecodeDisplay: 4! !

!PNGReadWriterTest methodsFor: 'tests - bits' stamp: 'ar 2/11/2004 01:56'!
test1BitReversed
	self encodeAndDecodeReverse: (self drawStuffOn: (Form extent: 33@33 depth: 1))! !

!PNGReadWriterTest methodsFor: 'tests - colors' stamp: 'ar 2/18/2004 23:50'!
testBlack8
	self encodeAndDecodeColor: Color blue depth: 8! !

!PNGReadWriterTest methodsFor: 'tests - colors' stamp: 'ar 2/18/2004 23:49'!
testGreen8
	self encodeAndDecodeColor: Color green depth: 8! !

!PNGReadWriterTest methodsFor: 'tests - bits' stamp: 'ar 2/12/2004 22:50'!
test1Bit
	self encodeAndDecodeForm: (self drawStuffOn: (Form extent: 33@33 depth: 1))! !

!PNGReadWriterTest methodsFor: 'tests - colors' stamp: 'ar 2/18/2004 23:50'!
testBlack32
	self encodeAndDecodeColor: Color blue depth: 32! !

!PNGReadWriterTest methodsFor: 'tests - colors' stamp: 'ar 2/18/2004 23:48'!
testRed32
	self encodeAndDecodeColor: Color red depth: 32! !

!PNGReadWriterTest methodsFor: 'helpers' stamp: 'PeterHugossonMiller 9/3/2009 10:12'!
encodeAndDecodeWithColors: aColorForm
	"Screw around with aColorForm colors"
	| colors nColors indexedColors max myRandom |
	fileName := 'testColors', aColorForm depth printString,'.png'.
	indexedColors := Color indexedColors.
	nColors := 1 bitShift: aColorForm depth.
	colors := Array new writeStream.

	"Make first half translucent"
	max := nColors // 2.
	1 to: max do:[:i|
		colors nextPut: ((indexedColors at: i) alpha: i / max asFloat).
	].

	"Make random choices for second half"
	myRandom := Random seed: 42315.
	max to: nColors do:[:i|
		colors nextPut: (indexedColors atRandom: myRandom).
	].
	self deleteFile.
! !

!POP3Client commentStamp: 'mir 5/12/2003 17:57'!
This class implements POP3 (Post Office Protocol 3) as specified in RFC 1939.  (see http://www.ietf.org/rfc.html)

You can use it to download email from the mail server to your personal mail program.

To see an example of it's use, see POPSocket class>>example.!
!POP3Client methodsFor: 'private testing' stamp: 'mir 11/11/2002 15:44'!
responseIsWarning
	^self lastResponse beginsWith: '-'! !

!POP3Client methodsFor: 'private testing' stamp: 'mir 3/7/2002 13:43'!
responseIsError
	^self lastResponse beginsWith: '-'! !

!POP3Client methodsFor: 'private protocol' stamp: 'mir 4/7/2003 17:38'!
clearTextLogin

	[self sendCommand: 'USER ', self user.
	self checkResponse.
	self logProgress: self lastResponse.

	self sendCommand: 'PASS ', self password.
	self checkResponse.
	self logProgress: self lastResponse]
		on: TelnetProtocolError
		do: [:ex |
			"Neither authentication worked.  Indicate an error and close up"
			self close.
			ex resignalAs: ((LoginFailedException protocolInstance: self) signal: 'Login failed.')]! !

!POP3Client methodsFor: 'private' stamp: 'mir 3/8/2002 11:41'!
loginMethod: aSymbol
	^self connectionInfo at: #loginMethod put: aSymbol! !

!POP3Client methodsFor: 'private' stamp: 'mir 11/11/2002 16:20'!
loginMethod
	^self connectionInfo at: #loginMethod ifAbsent: [nil]! !

!POP3Client methodsFor: 'public protocol' stamp: 'mir 3/7/2002 14:35'!
deleteMessage: num
	"delete the numbered message"

	self ensureConnection.
	self sendCommand: 'DELE ', num printString.
	self checkResponse.
	self logProgress: self lastResponse! !

!POP3Client methodsFor: 'private protocol' stamp: 'mir 4/7/2003 17:39'!
login
	self loginMethod
		ifNil: [^self].
	self loginMethod == #clearText
		ifTrue: [^self clearTextLogin].
	self loginMethod == #APOP
		ifTrue: [^self apopLogin].
	(POP3LoginError protocolInstance: self) signal: 'Unsupported login procedure.'! !

!POP3Client methodsFor: 'public protocol' stamp: 'nice 1/5/2010 15:59'!
messageCount
	"Query the server and answer the number of messages that are in the user's mailbox."

	| numMessages |
	self ensureConnection.
	self sendCommand: 'STAT'.
	self checkResponse.
	self logProgress: self lastResponse.

	[ | answerString |answerString := (self lastResponse findTokens: Character separators) second.
	numMessages := answerString asNumber asInteger]
		on: Error
		do: [:ex | (ProtocolClientError protocolInstance: self) signal: 'Invalid STAT response.'].
	^numMessages! !

!POP3Client methodsFor: 'public protocol' stamp: 'mir 3/7/2002 14:35'!
retrieveMessage: number
	"retrieve the numbered message"

	self ensureConnection.
	self sendCommand: 'RETR ', number printString.
	self checkResponse.
	self logProgress: self lastResponse.

	^self getMultilineResponse! !

!POP3Client methodsFor: 'public protocol' stamp: 'len 12/14/2002 17:50'!
quit
	"QUIT <CRLF>"

	self sendCommand: 'QUIT'.
	self checkResponse.! !

!POP3Client methodsFor: 'public protocol' stamp: 'mir 3/8/2002 11:40'!
loginUser: userName password: password loginMethod: aLoginMethod

	self user: userName.
	self password: password.
	self loginMethod: aLoginMethod.
	self login! !

!POP3Client methodsFor: 'public protocol' stamp: 'mir 3/7/2002 14:57'!
loginUser: userName password: password

	self loginUser: userName password: password loginMethod: #clearText! !

!POP3Client methodsFor: 'public protocol' stamp: 'mir 3/7/2002 14:58'!
apopLoginUser: userName password: password

	self loginUser: userName password: password loginMethod: #APOP! !

!POP3Client methodsFor: 'private protocol' stamp: 'CamilloBruni 5/25/2012 18:19'!
apopLogin
	"Attempt to authenticate ourselves to the server without sending the password as cleartext."

	"For secure authentication, we look for a timestamp in the initial response string we get from the server, and then try the APOP command as specified in RFC 1939.  If the initial response from the server is
	+OK POP3 server ready <1896.697170952@dbc.mtview.ca.us>
we extract the timestamp
	<1896.697170952@dbc.mtview.ca.us>
then form a string of the form
	<1896.697170952@dbc.mtview.ca.us>USERPASSWORD
and then send only the MD5 hash of that to the server.  Thus the password never hits the wire"

	[ 
	| hash timestamp |
	"Look for a timestamp in the response we received from the server"
	timestamp := self lastResponse findTokens: '<>' includes: '@'.
	timestamp ifNil: [ (POP3LoginError protocolInstance: self) signal: 'APOP not supported.' ].
	(Smalltalk globals includesKey: #MD5)
		ifTrue: [ 
			hash := ((Smalltalk globals at: #MD5) hashMessage: '<' , timestamp , '>' , self password) storeStringHex asLowercase.	"trim starting 16r and zero pad it to 32 characters if needed"
			hash := hash padLeftTo: 32 with: $0 ]
		ifFalse: [ (POP3LoginError protocolInstance: self) signal: 'APOP (MD5) not supported.' ].
	self sendCommand: 'APOP ' , self user , ' ' , hash.
	self checkResponse.
	self logProgress: self lastResponse ]
		on: ProtocolClientError
		do: [ :ex | 
			self close.
			(LoginFailedException protocolInstance: self) signal: 'Login failed.' ]! !

!POP3Client methodsFor: 'private protocol' stamp: 'PeterHugossonMiller 9/3/2009 10:12'!
getMultilineResponse
	"Get a multiple line response to the last command, filtering out LF characters. A multiple line response ends with a line containing only a single period (.) character."

	| response done chunk |
	response := String new writeStream.
	done := false.
	[done] whileFalse: [
		chunk := self stream nextLine.
		(chunk beginsWith: '.')
			ifTrue: [response nextPutAll: (chunk copyFrom: 2 to: chunk size); cr ]
			ifFalse: [response nextPutAll: chunk; cr ].
		done := (chunk = '.') ].

	^ response contents
! !

!POP3Client class methodsFor: 'accessing' stamp: 'mir 3/7/2002 12:51'!
defaultPortNumber
	^110! !

!POP3Client class methodsFor: 'example' stamp: 'rbb 3/1/2005 11:05'!
example
	"POP3Client example"
	"download a user's messages into an OrderedCollection and inspect the OrderedCollection"

	| ps messages userName password |
	userName := (UIManager default request: 'POP username').
	password := (UIManager default request: 'POP password').
	ps := POP3Client openOnHostNamed: (UIManager default request: 'POP server').
	[
	ps loginUser: userName password: password.
	ps logProgressToTranscript.

	messages := OrderedCollection new.
	1 to: ps messageCount do: [ :messageNr |
		messages add: (ps retrieveMessage: messageNr) ]]
		ensure: [ps close].

	messages inspect.! !

!POP3Client class methodsFor: 'accessing' stamp: 'mir 3/7/2002 12:52'!
logFlag
	^#pop! !

!POP3LoginError commentStamp: 'mir 5/12/2003 17:58'!
Exception for signaling POP3 login failures.!
!PSMCChangeWrapper methodsFor: 'accessing' stamp: 'gvc 10/30/2006 11:22'!
operation
	"Answer the underlying operation."

	self subclassResponsibility ! !

!PSMCChangeWrapper methodsFor: 'testing' stamp: 'gvc 7/6/2007 14:41'!
isConflict
	"Answer whether the receiver is a conflict item."

	^false! !

!PSMCChangeWrapper methodsFor: 'accessing' stamp: 'gvc 1/14/2009 12:42'!
actualClass
	"Answer the class represented in the receiver."

	^(self operation ifNil: [^nil]) targetClass! !

!PSMCChangeWrapper methodsFor: 'accessing' stamp: 'IgorStasenko 6/24/2011 17:29'!
preferredColor

	| op |
	op := self operation.
	op ifNil: [ ^ nil ].
	(op isConflict and: [ op isResolved not ] ) ifTrue: [  ^ Color red ].
	op remoteChosen ifFalse: [ ^ Color gray ].
	^ nil "use default color "! !

!PSMCChangeWrapper methodsFor: 'accessing' stamp: 'gvc 7/30/2009 13:44'!
model: anObject
	"Set the model."

	model := anObject! !

!PSMCChangeWrapper methodsFor: 'accessing' stamp: 'EstebanLorenzano 9/19/2013 13:11'!
icon
	"Answer a form with an icon to represent the receiver"
	|o|
	o := self operation.
	o isNil ifTrue: [^ Smalltalk ui icons changeEmptyIcon ].
	o isAddition ifTrue: [^ Smalltalk ui icons changeAddIcon ].
	o isRemoval ifTrue: [^ Smalltalk ui icons changeRemoveIcon ].
	^ Smalltalk ui icons changeUpdateIcon! !

!PSMCChangesGrouper commentStamp: 'GuillermoPolito 8/21/2014 17:09'!
I am a visitor on MCDefinition objects. I will group a collection of definitions into a tree that will be shown in the PSMCPatchMorph.!
!PSMCChangesGrouper methodsFor: 'grouping' stamp: 'GuillermoPolito 8/21/2014 17:23'!
ensureClassChangeWrapperNamed: aClassName
	
	(classes includes: aClassName)
		ifFalse: [ classes add: aClassName.
				classChanges add: (PSMCClassChangeWrapper with: aClassName model: model ) ]! !

!PSMCChangesGrouper methodsFor: 'visitor' stamp: 'GuillermoPolito 8/25/2014 10:41'!
visitClassDefinition: aMCClassDefinition 
	
	self ensureClassChangeWrapperNamed: aMCClassDefinition fullClassName! !

!PSMCChangesGrouper methodsFor: 'visitor' stamp: 'GuillermoPolito 8/25/2014 10:41'!
visitMethodDefinition: aMCMethodDefinition 
	
	self ensureClassChangeWrapperNamed: aMCMethodDefinition fullClassName! !

!PSMCChangesGrouper methodsFor: 'visitor' stamp: 'GuillermoPolito 8/21/2014 17:04'!
visitMetaclassDefinition: aMCClassDefinition 
	
	"Do nothing for metaclasses"! !

!PSMCChangesGrouper methodsFor: 'grouping' stamp: 'GuillermoPolito 8/21/2014 17:20'!
visit: aMCOperation

	| previous |
	previous := currentOperation.
	currentOperation := aMCOperation.
	currentOperation definition accept: self.
	currentOperation := previous.! !

!PSMCChangesGrouper methodsFor: 'visitor' stamp: 'GuillermoPolito 8/21/2014 17:23'!
visitOrganizationDefinition: aMCOrganizationDefinition 
	
	nonClassChanges add: (currentOperation patchWrapper model: model)! !

!PSMCChangesGrouper methodsFor: 'initialization' stamp: 'GuillermoPolito 8/21/2014 17:23'!
initialize

	super initialize.
	classChanges := OrderedCollection new.
	nonClassChanges := OrderedCollection new.
	classes := Set new.! !

!PSMCChangesGrouper methodsFor: 'visitor' stamp: 'GuillermoPolito 8/25/2014 10:43'!
visitTraitDefinition: aMCTraitDefinition 
	
	self ensureClassChangeWrapperNamed: aMCTraitDefinition fullClassName! !

!PSMCChangesGrouper methodsFor: 'visitor' stamp: 'GuillermoPolito 8/21/2014 17:07'!
visitScriptDefinition: aMCScriptDefinition

	self visitDefaultDefinition: aMCScriptDefinition! !

!PSMCChangesGrouper methodsFor: 'grouping' stamp: 'GuillermoPolito 8/21/2014 17:27'!
group

	model do: [:operation | self visit: operation ].
	^ (nonClassChanges sorted: [:a :b | a item <= b item]),
		(classChanges sorted: [:a :b | a item <= b item])! !

!PSMCChangesGrouper methodsFor: 'visitor' stamp: 'MarcusDenker 11/20/2014 12:37'!
visitClassTraitDefinition: aMCClassTraitDefinition 
	
	"Do nothing for class traits (similar to #visitMetaclassDefinition:)"! !

!PSMCChangesGrouper methodsFor: 'grouping' stamp: 'GuillermoPolito 8/21/2014 17:27'!
model: aCollection 

	model := aCollection.! !

!PSMCChangesGrouper methodsFor: 'visitor' stamp: 'GuillermoPolito 8/25/2014 10:41'!
visitDefaultDefinition: aDefinition

	nonClassChanges add: aDefinition! !

!PSMCChangesGrouper class methodsFor: 'helper methods' stamp: 'GuillermoPolito 8/21/2014 17:28'!
group: aCollectionOfPatches

	^ self new
		model: aCollectionOfPatches;
		group! !

!PSMCClassChangeWrapper methodsFor: 'accessing' stamp: 'GabrielOmarCotelli 11/30/2013 16:18'!
operation
	"Answer the patch operation for the class itself or nil if none."

	^ self model detect: [ :i | i targetClassName = self item and: [ i definition isClassDefinition ] ] ifNone: [ nil ]! !

!PSMCClassChangeWrapper methodsFor: 'testing' stamp: 'StephaneDucasse 6/24/2011 16:18'!
isConflict
	"Answer whether the receiver is a conflict item."

	| op |
	op := self operation.
	^ op notNil and: [op isConflict ]! !

!PSMCClassChangeWrapper methodsFor: 'testing' stamp: 'StephaneDucasse 6/24/2011 16:18'!
localChosen
	"Answer whether the local version is chosen."

	^self operation localChosen! !

!PSMCClassChangeWrapper methodsFor: 'choosing' stamp: 'StephaneDucasse 6/24/2011 16:22'!
chooseLocal
	"Choose the local version."

	self operation chooseLocal! !

!PSMCClassChangeWrapper methodsFor: 'accessing' stamp: 'lr 3/14/2010 21:13'!
actualClass
	"Answer the class represented in the receiver."

	^ super actualClass ifNil: [ Smalltalk globals classNamed: self item ]! !

!PSMCClassChangeWrapper methodsFor: 'accessing' stamp: 'gvc 4/1/2009 13:30'!
gatherContents
	"Answer the contents of the change from the model."

	^((self model select: [:i | i targetClassName = self item and: [
			i definition isClassDefinition not]])
		collect: [:o |  o patchWrapper model: self model]) asSortedCollection: [:a :b |
			a asString <= b asString]! !

!PSMCClassChangeWrapper methodsFor: 'choosing' stamp: 'StephaneDucasse 6/24/2011 16:22'!
clearChoice
	"Choose neither version (be in conflict)."

	self operation clearChoice! !

!PSMCClassChangeWrapper methodsFor: 'testing' stamp: 'gvc 7/6/2007 15:42'!
remoteChosen
	"Answer whether the remote version is chosen."

	^self conflict remoteChosen! !

!PSMCClassChangeWrapper methodsFor: 'choosing' stamp: 'StephaneDucasse 6/24/2011 16:22'!
chooseRemote
	"Choose the remote version."

	self operation chooseRemote! !

!PSMCClassChangeWrapper methodsFor: 'accessing' stamp: 'gvc 4/1/2009 13:30'!
contents
	"Answer the contents of the change."

	^contents ifNil: [contents := self gatherContents]! !

!PSMCClassChangeWrapper methodsFor: 'accessing' stamp: 'CamilloBruni 9/19/2013 19:43'!
icon
	"Answer a form with an icon to represent the receiver"
	
	self isConflict ifTrue: [
		self localChosen 
			ifTrue: [ ^ Smalltalk ui icons changeBlockIcon ]].
	^ super icon! !

!PSMCMergeMorph commentStamp: '<historical>'!
A PSMCMergeMorph is a graphical tool to navigate changes and select changes in case of conflicts.!
!PSMCMergeMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 2/4/2010 16:49'!
initialColorInSystemWindow: aSystemWindow
	"Answer the colour the receiver should be when added to a SystemWindow."

	^Color transparent! !

!PSMCMergeMorph methodsFor: 'accessing' stamp: 'gvc 10/29/2006 18:28'!
codeMorph
	"Answer the value of codeMorph"

	^ codeMorph! !

!PSMCMergeMorph methodsFor: 'actions' stamp: 'gvc 1/9/2009 15:43'!
cancel
	"Delete the window to cancel."

	self window delete! !

!PSMCMergeMorph methodsFor: 'as yet unclassified' stamp: 'gvc 1/12/2009 17:12'!
compositeText: aString
	"Save the new method text for the selected method.
	Yet to be implemented."
	
	UIManager default inform: 'Saving of replacement methods is not yet imlemented.'! !

!PSMCMergeMorph methodsFor: 'instance-creation' stamp: 'gvc 1/29/2009 12:43'!
newButtonsMorph
	"Answer a new buttons morph."

	^(self newRow: {
			self newConflictsButton.
			self newToolSpacer hResizing: #spaceFill.
			self newMergeButton.
			self newCancelButton})
		removeProperty: #fillStyle;
		listCentering: #bottomRight;
		layoutInset: 4! !

!PSMCMergeMorph methodsFor: 'instance-creation' stamp: 'gvc 11/1/2006 11:53'!
newCodeMorph
	"Answer a new code morph."

	^(self newTextEditorFor: self
		getText: #compositeText
		setText: #compositeText:
		getEnabled: nil)
		wrapFlag: false;
		setText: ''! !

!PSMCMergeMorph methodsFor: 'initialization' stamp: 'IgorStasenko 12/19/2012 17:35'!
initialize
	"Initialize the receiver."

	|buttons buttonsHeight|
	super initialize.
	buttons := self newButtonsMorph.
	buttonsHeight := buttons minExtent y.
	self
		merged: false;
		patchMorph: self newPatchMorph;
		codeMorph: self newCodeMorph;
		changeProportionalLayout;
		addMorph: self patchMorph
		fullFrame: (0@0 corner: 1@0.6) asLayoutFrame ;
		addMorph: self codeMorph
		fullFrame: ((0@0.6 corner: 1@1) asLayoutFrame bottomOffset: buttonsHeight negated);
		addMorph: self newButtonsMorph
		fullFrame: ((0@1 corner: 1@1) asLayoutFrame topOffset: buttonsHeight negated);
		addPaneSplitters! !

!PSMCMergeMorph methodsFor: 'instance-creation' stamp: 'gvc 1/29/2009 12:54'!
newConflictsButton
	"Answer a new button for displaying the count
	of outstanding conflicts and navigating to each.
	It will be disabled if all conflicts are resolved."

	^(self
		newButtonFor: self
		getState: nil
		action:  #selectNextConflict
		arguments: #()
		getEnabled: #notAllConflictsResolved
		getLabel:  #conflictCountString
		help: 'Select the next conflict in the tree' translated)
		vResizing: #spaceFill "workaround until table  layout fixed"! !

!PSMCMergeMorph methodsFor: 'actions' stamp: 'gvc 1/9/2009 15:44'!
merge
	"Do the merge and close if no conflicts."
	
	^self model isMerged
		ifTrue: [self merged: true.
				self window delete]
		ifFalse: [self inform: 'You must resolve all conflicts first.' translated]! !

!PSMCMergeMorph methodsFor: 'as yet unclassified' stamp: 'gvc 1/29/2009 12:46'!
notAllConflictsResolved
	"Answer whether any conflicts are unresolved."
	
	^self allConflictsResolved not! !

!PSMCMergeMorph methodsFor: 'instance-creation' stamp: 'gvc 11/1/2006 14:26'!
newPatchMorph
	"Answer a new patch morph."

	^PSMCMergePatchMorph new
		borderWidth: 0;
		addDependent: self;
		yourself! !

!PSMCMergeMorph methodsFor: 'actions' stamp: 'gvc 11/1/2006 11:53'!
compositeText
	"Answer the composite text from the patch morph."

	^self patchMorph compositeText! !

!PSMCMergeMorph methodsFor: 'instance-creation' stamp: 'gvc 1/29/2009 12:42'!
newMergeButton
	"Answer a new button for performing the merge.
	It will be disabled if any conflicts are unresolved."

	^self
		newButtonFor: self
		action:  #merge
		getEnabled:  #allConflictsResolved
		label:  'Merge' translated
		help: 'Merge the version into the image' translated! !

!PSMCMergeMorph methodsFor: 'updating' stamp: 'gvc 1/29/2009 13:22'!
update: aspect
	"A join has probably changed its selection state."

	super update: aspect.
	aspect == #compositeText
		ifTrue: [self updateCode].
	aspect == #changes
		ifTrue: [self
				changed: #conflictCountString;
				changed: #allConflictsResolved;
				changed: #notAllConflictsResolved]! !

!PSMCMergeMorph methodsFor: 'accessing' stamp: 'gvc 10/29/2006 18:28'!
patchMorph
	"Answer the value of patchMorph"

	^ patchMorph! !

!PSMCMergeMorph methodsFor: 'as yet unclassified' stamp: 'gvc 11/1/2006 11:54'!
updateCode
	"Update the code morph to match selected differences."

	self changed: #compositeText! !

!PSMCMergeMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/30/2006 09:47'!
defaultTitle
	"Answer the default title label for the receiver."

	^'Merge' translated! !

!PSMCMergeMorph methodsFor: 'accessing' stamp: 'gvc 1/8/2009 17:42'!
merged
	"Answer the value of merged. Indicates whether
	the merge button was pressed with no conflicts remaining."

	^ merged! !

!PSMCMergeMorph methodsFor: 'actions' stamp: 'gvc 2/3/2010 16:05'!
fromDescription: aString
	"Set the description for the left-hand side of the merge,
	typically 'currently in image'."

	self patchMorph fromDescription: aString! !

!PSMCMergeMorph methodsFor: 'actions' stamp: 'gvc 2/3/2010 16:05'!
toDescription: aString
	"Set the description for the right-hand side of the merge,
	typically 'incoming'."

	self patchMorph toDescription: aString! !

!PSMCMergeMorph methodsFor: 'as yet unclassified' stamp: 'gvc 1/29/2009 12:50'!
conflictCountString
	"Answer a string describing the number of conflicts."

	|count|
	count := self conflictCount.
	^count = 1
		ifTrue: ['1 conflict' translated]
		ifFalse: ['{1} conflicts' translated format: {count}]! !

!PSMCMergeMorph methodsFor: 'as yet unclassified' stamp: 'gvc 1/29/2009 12:52'!
conflictCount
	"Answer the number of conflicts that are unresolved."

	^(self model ifNil: [^0]) conflicts count: [:c | c isResolved not]! !

!PSMCMergeMorph methodsFor: 'as yet unclassified' stamp: 'gvc 1/9/2009 15:18'!
allConflictsResolved
	"Answer whether all conflicts were resolved."
	
	^(self model ifNil: [^false]) isMerged! !

!PSMCMergeMorph methodsFor: 'accessing' stamp: 'gvc 10/29/2006 18:28'!
patchMorph: anObject
	"Set the value of patchMorph"

	patchMorph := anObject! !

!PSMCMergeMorph methodsFor: 'accessing' stamp: 'gvc 10/29/2006 18:28'!
codeMorph: anObject
	"Set the value of codeMorph"

	codeMorph := anObject! !

!PSMCMergeMorph methodsFor: 'as yet unclassified' stamp: 'gvc 1/29/2009 12:57'!
selectNextConflict
	"Select the next conflict in the tree."
	
	self patchMorph selectNextConflict! !

!PSMCMergeMorph methodsFor: 'initialization' stamp: 'StephaneDucasse 6/24/2011 15:08'!
model: aMerger
	"Set the model and update the window."

	|grouped sorted|
	super model: aMerger.
	grouped := aMerger operations
		groupBy: [:o | o targetClassName ifNil: [o shortSummary]]
		having: [:g | true].
	sorted := OrderedCollection new.
	grouped keys asSortedCollection do: [:k |
		sorted addAll: ((grouped at: k) asSortedCollection: [:a :b | a shortSummary <= b shortSummary])].		
	self patchMorph model: sorted! !

!PSMCMergeMorph methodsFor: 'accessing' stamp: 'gvc 1/8/2009 17:42'!
merged: anObject
	"Set the value of merged"

	merged := anObject! !

!PSMCMergeMorph class methodsFor: 'as yet unclassified' stamp: 'gvc 10/30/2006 10:31'!
forMerger: aMerger
	"Answer a new instance of the receiver
	with the given merger as the model."
	
	^ self new model: aMerger! !

!PSMCMergePatchMorph methodsFor: 'as yet unclassified' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
changesMenu: m
	"Answer the changes menu."

	|menu|
	menu := super changesMenu: m.
	menu addLine.
	menu addToggle: 'Apply this change' translated
		target: self
		selector: #toggleApplySelectedChange
		getStateSelector: #selectionIsRemoteChosen
		enablementSelector: #selectionIsNotNil.
	menu
		addToggle: 'Keep current version' translated
		target: self
		selector: #keepCurrentVersion
		getStateSelector: nil
		enablementSelector: #selectionIsNotNil.
	menu lastItem
	 	font: self theme menuFont;
		icon: Smalltalk ui icons smallBackIcon;
		keyText: 'Cmd+c'.	
	menu
		addToggle: 'Use incoming version' translated
		target: self
		selector: #useIncomingVersion
		getStateSelector: nil
		enablementSelector: #selectionIsNotNil.
	menu lastItem
	 	font: self theme menuFont;
		icon: Smalltalk ui icons smallForwardIcon;
		keyText: 'Cmd+g'.
	menu
		addToggle: 'Mark as conflict' translated
		target: self
		selector: #markAsConflict
		getStateSelector: nil
		enablementSelector: #selectionIsNotNil.
	menu lastItem
	 	font: self theme menuFont;
		icon: Smalltalk ui icons smallCancelIcon;
		keyText: 'Cmd+x'.
	menu
		addToggle: 'All conflicts' translated
		target: self
		selector: nil
		getStateSelector: nil
		enablementSelector: #hasConflicts.
	menu lastItem
	 	font: self theme menuFont;
		subMenu: self allConflictsMenu.
	menu addLine.
	menu
		addToggle: 'Select next conflict' translated
		target: self
		selector: #selectNextConflict
		getStateSelector: nil
		enablementSelector: #notAllConflictsResolved.
	menu lastItem
	 	font: self theme menuFont;
		icon: Smalltalk ui icons smallRightFlushIcon;
		keyText: 'Cmd+f'.	
	^menu! !

!PSMCMergePatchMorph methodsFor: 'hooks' stamp: 'gvc 11/1/2006 14:25'!
diffMorphClass
	"Answer a the class to use for a new diff morph."

	^MergeDiffMorph! !

!PSMCMergePatchMorph methodsFor: 'as yet unclassified' stamp: 'gvc 1/12/2009 14:06'!
updateSource
	"Update the source difference morph."

	|sel|
	sel := self selectedChangeWrapper.
	self diffMorph allowJoinClicks: (sel notNil and: [
		sel isConflict and: [sel operation isModification]]).
	super updateSource.
	(sel isNil or: [sel isConflict not]) ifTrue: [^self].
	sel localChosen
		ifTrue: [self diffMorph indicateSrc]
		ifFalse: [self diffMorph indicateDst]! !

!PSMCMergePatchMorph methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 6/24/2011 16:08'!
changeTreeKey: aCharacter
	"Handle change tree key strokes."

	super changeTreeKey: aCharacter.
	(aCharacter == $a and: [ self selectionIsNotNil]) ifTrue: [
		^ self toggleApplySelectedChange.
		].
	(aCharacter == $c and: [self selectionIsNotNil]) ifTrue: [
		^self keepCurrentVersion].
	(aCharacter == $g and: [self selectionIsNotNil]) ifTrue: [
		^self useIncomingVersion].
	(aCharacter == $x and: [self selectionIsNotNil]) ifTrue: [
		^self markAsConflict].
	(aCharacter == $f and: [self notAllConflictsResolved]) ifTrue: [
		^self selectNextConflict].
	
	(aCharacter == $C and: [self hasAnyNonKeptConflicts]) ifTrue: [
		^self keepAllCurrentVersion].
	(aCharacter == $G and: [self hasAnyNonIncomingConflicts]) ifTrue: [
		^self useAllIncomingVersion].
	(aCharacter == $X and: [self hasAnyNonConflictConflicts]) ifTrue: [
		^self markAllAsConflict]! !

!PSMCMergePatchMorph methodsFor: 'as yet unclassified' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
allConflictsMenu
	"Answer the all conflicts menu."

	|menu|
	menu := UIManager default newMenuIn: self for: self.
		menu
		addToggle: 'Keep current version of all' translated
		target: self
		selector: #keepAllCurrentVersion
		getStateSelector: nil
		enablementSelector: #hasAnyNonKeptConflicts.
	menu lastItem
	 	font: self theme menuFont;
		icon: Smalltalk ui icons smallBackIcon;
		keyText: 'Shift+Cmd+c'.	
	menu
		addToggle: 'Use incoming version of all' translated
		target: self
		selector: #useAllIncomingVersion
		getStateSelector: nil
		enablementSelector: #hasAnyNonIncomingConflicts.
	menu lastItem
	 	font: self theme menuFont;
		icon: Smalltalk ui icons smallForwardIcon;
		keyText: 'Shift+Cmd+g'.
	menu
		addToggle: 'Mark all as conflict' translated
		target: self
		selector: #markAllAsConflict
		getStateSelector: nil
		enablementSelector: #hasAnyNonConflictConflicts.
	menu lastItem
	 	font: self theme menuFont;
		icon: Smalltalk ui icons smallCancelIcon;
		keyText: 'Shift+Cmd+x'.
	^menu! !

!PSMCMergePatchMorph methodsFor: 'as yet unclassified' stamp: 'gvc 2/25/2010 10:17'!
markAllAsConflict
	"Mark all conflicts as unresolved."
	
	self allConflicts do: [:c | c clearChoice].
	self changed: #changes.
	self updateSource! !

!PSMCMergePatchMorph methodsFor: 'as yet unclassified' stamp: 'gvc 2/25/2010 10:21'!
allConflicts
	"Answer all conflicts in the model."

	^self model select: [:op | op isConflict]! !

!PSMCMergePatchMorph methodsFor: 'as yet unclassified' stamp: 'gvc 2/25/2010 13:51'!
hasAnyNonConflictConflicts
	"Answer whether there are any conflicts not marked as a conflict."

	^self allConflicts anySatisfy: [:conflict |
		conflict isResolved]! !

!PSMCMergePatchMorph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 6/24/2011 17:28'!
toggleApplySelectedChange

	self selectedChange remoteChosen 
		ifTrue: [ self selectedChange chooseLocal ]
		ifFalse: [ self selectedChange chooseRemote ].
	self changed: #changes.
	self updateSource! !

!PSMCMergePatchMorph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 6/22/2011 17:51'!
selectionIsNotNil

	^ self selectedChange notNil! !

!PSMCMergePatchMorph methodsFor: 'as yet unclassified' stamp: 'gvc 2/25/2010 13:38'!
hasConflicts
	"Answer whether there are any conflicts."

	^self allConflicts notEmpty! !

!PSMCMergePatchMorph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 6/24/2011 17:30'!
selectionIsRemoteChosen
	self selectedChange ifNil: [ ^ false].
	^ self selectedChange remoteChosen! !

!PSMCMergePatchMorph methodsFor: 'as yet unclassified' stamp: 'gvc 2/9/2010 14:18'!
nextConflict
	"Answer the next (unresolved) conflict or, nil if none."

	|coll current index|
	current := self selectedChangeWrapper.
	index := current isNil
		ifTrue: [0]
		ifFalse: [self model indexOf: current item].
	coll := (self model
			copyFrom: index + 1
			to: self model size),
		(self model copyFrom: 1 to: index).
	^coll detect: [:item | item isConflict and: [item isResolved not]] ifNone: [nil]! !

!PSMCMergePatchMorph methodsFor: 'as yet unclassified' stamp: 'gvc 7/6/2007 15:46'!
useIncomingVersion
	"Mark the conflict as remote."
	
	self selectedChangeWrapper chooseRemote.
	self changed: #changes.
	self updateSource! !

!PSMCMergePatchMorph methodsFor: 'as yet unclassified' stamp: 'gvc 2/25/2010 10:18'!
useAllIncomingVersion
	"Mark all conflicts as remote."
	
	self allConflicts do: [:c | c chooseRemote].
	self changed: #changes.
	self updateSource! !

!PSMCMergePatchMorph methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 6/24/2011 16:07'!
markAsConflict
	"Mark the operation as unresolved conflict."
	
	self selectedChangeWrapper operation beConflict.
	self changed: #changes.
	self updateSource.! !

!PSMCMergePatchMorph methodsFor: 'as yet unclassified' stamp: 'gvc 2/25/2010 13:51'!
hasAnyNonKeptConflicts
	"Answer whether there are any conflicts not marked as keep."

	^self allConflicts anySatisfy: [:conflict |
		conflict isResolved not or: [conflict remoteChosen]]! !

!PSMCMergePatchMorph methodsFor: 'as yet unclassified' stamp: 'gvc 7/6/2007 15:46'!
keepCurrentVersion
	"Mark the conflict as local."
	
	self selectedChangeWrapper chooseLocal.
	self changed: #changes.
	self updateSource! !

!PSMCMergePatchMorph methodsFor: 'as yet unclassified' stamp: 'gvc 4/2/2009 13:03'!
selectNextConflict
	"Select the next conflict after the current selection, if any."

	|next op def path|
	next := self nextConflict ifNil: [^self].
	op := next operation.
	def := next remoteDefinition ifNil: [next localDefinition].
	path := {#changes. #openPath}.
	def isMethodDefinition ifTrue: [path := path, {def fullClassName}].
	path := path, {op shortSummary}.
	self changed: path! !

!PSMCMergePatchMorph methodsFor: 'as yet unclassified' stamp: 'gvc 2/25/2010 13:50'!
hasAnyNonIncomingConflicts
	"Answer whether there are any conflicts not marked as incoming."

	^self allConflicts anySatisfy: [:conflict |
		conflict isResolved not or: [conflict localChosen]]! !

!PSMCMergePatchMorph methodsFor: 'as yet unclassified' stamp: 'gvc 1/29/2009 14:26'!
notAllConflictsResolved
	"Answer whether any conflicts are unresolved."
	
	^self model anySatisfy: [:item | item isConflict and: [item isResolved not]]! !

!PSMCMergePatchMorph methodsFor: 'as yet unclassified' stamp: 'gvc 2/25/2010 10:18'!
keepAllCurrentVersion
	"Mark all conflicts as local."
	
	self allConflicts do: [:c | c chooseLocal].
	self changed: #changes.
	self updateSource! !

!PSMCPatchMorph commentStamp: 'LaurentLaffont 2/23/2011 20:21'!
I'm a Monticello tool based on polymorph used to browse diffs.
Activate me with the setting named 'Use Polymorph difference tools'.!
!PSMCPatchMorph methodsFor: 'accessing' stamp: 'GuillermoPolito 8/21/2014 17:28'!
changes
	"Answer the changes tree roots."
	
	^ PSMCChangesGrouper group: self model! !

!PSMCPatchMorph methodsFor: 'accessing' stamp: 'gvc 11/1/2006 12:18'!
selectedChangeWrapper: aWrapper
	"Set the selected change."

	selectedChangeWrapper := aWrapper.
	self
		changed: #selectedChangeWrapper;
		updateSource;
		changed: #compositeText! !

!PSMCPatchMorph methodsFor: 'actions' stamp: 'MarcusDenker 6/28/2014 11:28'!
browseVersions
	"Browse the method versions."

	Smalltalk tools versionBrowser 
			browseVersionsForClass: self selectedChangeWrapper actualClass 
			selector: self selectedMessageName
			! !

!PSMCPatchMorph methodsFor: 'instance creation' stamp: 'gvc 2/22/2010 17:52'!
newChangeTreeMorph
	"Answer a new morph for the tree of changes."

	^(self
		newTreeFor: self
		list: #changes
		selected: #selectedChangeWrapper
		changeSelected: #selectedChangeWrapper:)
		getMenuSelector: #changesMenu:;
		keystrokeActionSelector: #changeTreeKey:! !

!PSMCPatchMorph methodsFor: 'updating' stamp: 'CamilloBruni 9/14/2013 16:35'!
expandChangeTree
	self flag: #TODO. "We should only expand the nodes wich have partial changes, if a class was added or removed there is no need to show the complete tree expanded"
	self changeTree expandAll.! !

!PSMCPatchMorph methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 1/11/2012 22:53'!
selectionIsMethodChange
	"Answer whether the currently selected change is for a method."

	^self selectedChange notNil and: [ 
		self selectedChange definition isMethodDefinition and: [ 
			self selectedChange definition isLoadable ] ]! !

!PSMCPatchMorph methodsFor: 'actions' stamp: 'BenjaminVanRyseghem 2/8/2012 17:09'!
browseClass
	"Browse the class of the selected item."

	^ Smalltalk tools browser
		fullOnClass: self selectedChangeWrapper actualClass
		selector: self selectedMessageName! !

!PSMCPatchMorph methodsFor: 'initialization' stamp: 'CamilloBruni 9/14/2013 16:29'!
initialize
	"Initialize the receiver."

	|descriptionHeight|
	super initialize.
	self
		diffMorph: self newDiffMorph;
		changeTree: self newChangeTreeMorph;
		descriptionMorph: self newDescriptionMorph.
	descriptionHeight := self descriptionMorph minExtent y.
	self
		changeProportionalLayout;
		addMorph: self descriptionMorph
		fullFrame: ((0.3@0 corner: 1@0) asLayoutFrame leftOffset: ProportionalSplitterMorph splitterWidth; bottomOffset: descriptionHeight);
		addMorph: self changeTree
		fullFrame: (0@0 corner: 0.3@1) asLayoutFrame;
		addMorph: self diffMorph
		fullFrame: ((0.3@0 corner: 1@1) asLayoutFrame topLeftOffset: ProportionalSplitterMorph splitterWidth @ descriptionHeight);
		addPaneSplitters.
	self updateDescriptionFillStyle: self paneColor.
	self splitters first delete.
	self onAnnouncement: MorphOpened do: [ self expandChangeTree ]
! !

!PSMCPatchMorph methodsFor: 'actions' stamp: 'MarcusDenker 10/13/2013 07:57'!
browseSenders
	"Browse the method senders."

	self systemNavigation
		browseAllSendersOf: (self selectedMessageName ifNil: [^self])! !

!PSMCPatchMorph methodsFor: 'accessing' stamp: 'gvc 10/26/2006 11:58'!
selectedChange
	"Answer the selected change."

	^(self selectedChangeWrapper ifNil: [^nil]) operation! !

!PSMCPatchMorph methodsFor: 'menus' stamp: 'MarcusDenker 8/15/2010 11:38'!
loadMethodSelection
	"Install the selected change"
	
	self selectedChange ifNil: [ ^self ].
	self selectedChange definition load.! !

!PSMCPatchMorph methodsFor: 'accessing' stamp: 'gvc 10/26/2006 11:57'!
selectedChangeWrapper
	"Answer the selected change."

	^selectedChangeWrapper! !

!PSMCPatchMorph methodsFor: 'protocol' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
changesMenu: m
	"Answer the changes menu."

	|menu|
	menu := self newMenu
		addTitle: 'Changes'
		icon: Smalltalk ui icons smallCopyIcon.		
	menu
		addToggle: 'Browse class...' translated
		target: self
		selector: #browseClass
		getStateSelector: nil
		enablementSelector: #selectionHasAcutalClass.
	menu lastItem
	 	font: self theme menuFont;
		icon: Smalltalk tools browser taskbarIcon;
		keyText: 'Cmd+b'.
	menu addLine.
	menu
		addToggle: 'Versions...' translated
		target: self
		selector: #browseVersions
		getStateSelector: nil
		enablementSelector: #selectionIsMethodChange.
	menu lastItem
	 	font: self theme menuFont;
		icon: Smalltalk ui icons smallJustifiedIcon;
		keyText: 'Cmd+v'.	
	menu
		addToggle: 'Senders...' translated
		target: self
		selector: #browseSenders
		getStateSelector: nil
		enablementSelector: #selectionIsMethodChange.
	menu lastItem
	 	font: self theme menuFont;
		icon: Smalltalk ui icons smallForwardIcon;
		keyText: 'Cmd+n'.	
	menu
		addToggle: 'Implementors...' translated
		target: self
		selector: #browseImplementors
		getStateSelector: nil
		enablementSelector: #selectionIsMethodChange.
	menu lastItem
	 	font: self theme menuFont;
		icon: Smalltalk ui icons smallDoItIcon;
		keyText: 'Cmd+m'.
	menu
		addToggle: 'Install incoming version' translated
		target: self
		selector: #loadMethodSelection
		getStateSelector: nil
		enablementSelector: #selectionIsMethodChange.
	menu lastItem
	 	font: self theme menuFont;
		icon: Smalltalk ui icons smallUpdateIcon.
	menu
		add: 'Expand All' translated
		target: self model
		selector: #expandAll.
	menu
		add: 'Collapse All' translated
		target: self model
		selector: #collapseAll.
	^menu! !

!PSMCPatchMorph methodsFor: 'accessing' stamp: 'gvc 1/29/2009 13:17'!
changeTree: anObject
	"Set the value of changeTree"

	changeTree := anObject! !

!PSMCPatchMorph methodsFor: 'actions' stamp: 'gvc 11/1/2006 12:02'!
compositeText
	"Answer the composite text based on the selection state
	of the joins."

	^self diffMorph compositeText! !

!PSMCPatchMorph methodsFor: 'actions' stamp: 'gvc 1/14/2009 12:47'!
browseImplementors
	"Browse the method implementors."

	self systemNavigation
		browseAllImplementorsOf: (self selectedMessageName ifNil: [^self])! !

!PSMCPatchMorph methodsFor: 'updating' stamp: 'gvc 10/30/2006 15:30'!
update: aspect
	"A join has probably changed its selection state."

	super update: aspect.
	aspect == #selectedDifferences
		ifTrue: [self changed: #compositeText]! !

!PSMCPatchMorph methodsFor: 'as yet unclassified' stamp: 'gvc 2/22/2010 17:57'!
changeTreeKey: aCharacter
	"Handle change tree key strokes."

	(aCharacter == $b and: [self selectionHasAcutalClass]) ifTrue: [
		^self browseClass].
	(aCharacter == $v and: [self selectionIsMethodChange]) ifTrue: [
		^self browseVersions].
	(aCharacter == $m and: [self selectionIsMethodChange]) ifTrue: [
		^self browseImplementors].
	(aCharacter == $n and: [self selectionIsMethodChange]) ifTrue: [
		^self browseSenders]! !

!PSMCPatchMorph methodsFor: 'accessing' stamp: 'gvc 10/29/2006 18:18'!
defaultTitle
	"Answer the default title label for the receiver."

	^'Changes' translated! !

!PSMCPatchMorph methodsFor: 'accessing' stamp: 'gvc 1/29/2009 13:17'!
changeTree
	"Answer the value of changeTree"

	^ changeTree! !

!PSMCPatchMorph methodsFor: 'accessing' stamp: 'gvc 10/26/2006 15:52'!
selectedMessageName
	"Answer the method selector or nil if no method change
	is selected.."

	^self selectionIsMethodChange
		ifTrue: [self selectedChange definition selector]
		! !

!PSMCPatchMorph methodsFor: 'initialization' stamp: 'GuillermoPolito 8/21/2014 17:26'!
model

	^ super model ifNil: [ #() ]! !

!PSMCPatchMorph methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 12/2/2013 14:14'!
selectionHasAcutalClass
	"Answer whether the currently selected change has an actual
	class in the image."

	^self selectedChangeWrapper
		ifNil: [false]
		ifNotNil: [:w | w actualClass notNil]! !

!PSMCPatchMorph methodsFor: 'as yet unclassified' stamp: 'gvc 1/14/2009 13:28'!
updateSource
	"Update the source difference morph."

	|sel|
	sel := self selectedChange.
	sel isNil
		ifTrue: [self diffMorph
				from: ''
				to: '']
		ifFalse: [self diffMorph
					from: sel diffFromSource
					to: sel diffToSource
					contextClass: (sel isClassPatch ifTrue: [nil] ifFalse: [sel targetClass])]! !

!PSMCPatchMorph methodsFor: 'initialization' stamp: 'gvc 10/30/2006 11:08'!
model: aCollection
	"Set the model and update the window."

	super model: aCollection.
	self changed: #changes! !

!PSMCPatchMorph class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
taskbarIcon
	"Answer the icon for the receiver in a task bar."

	^ Smalltalk ui icons smallForwardIcon! !

!PSMCPatchMorph class methodsFor: 'settings' stamp: 'gvc 2/9/2010 14:03'!
usedByDefault: aBoolean
	"Specify whether the Polymorph diff tools should be used with Monticello."
	
	UsedByDefault := aBoolean! !

!PSMCPatchMorph class methodsFor: 'settings' stamp: 'gvc 2/9/2010 14:04'!
usedByDefault
	"Answer whether the Polymorph diff tools should be used with Monticello."

	^UsedByDefault ifNil: [UsedByDefault := true]! !

!PSMCPatchMorph class methodsFor: 'settings' stamp: 'StephaneDucasse 11/11/2014 18:47'!
defaultDiffToolsSettingOn: aBuilder
	<systemsettings>  
	(aBuilder setting: #polymorphDiffToolsUsedByDefault)
		label: 'Use Polymorph difference tools';
		description: 'When enabled the Polymorph diff tools will be used with Monticello. When disabled, the original tools are used.';
		parent: #differator;
		target: PSMCPatchMorph;
		selector: #usedByDefault! !

!PSMCPatchMorph class methodsFor: 'instance creation' stamp: 'gvc 10/30/2006 11:08'!
forPatch: aPatch
	"Answer a new instance of the receiver
	with the given patch as the model."
	
	^ self new model: aPatch operations! !

!PSMCPatchOperationWrapper methodsFor: 'accessing' stamp: 'gvc 10/26/2006 12:00'!
operation
	"Answer the pacth operation for the receiver or nil if none."

	^self item! !

!PSMCPatchOperationWrapper methodsFor: 'testing' stamp: 'StephaneDucasse 6/24/2011 15:47'!
isConflict
	"Answer whether the receiver is a conflict item."

	^ self operation isConflict! !

!PSMCPatchOperationWrapper methodsFor: 'testing' stamp: 'StephaneDucasse 6/24/2011 15:48'!
localChosen
	"Answer whether the local version is chosen."

	^self operation localChosen! !

!PSMCPatchOperationWrapper methodsFor: 'accessing' stamp: 'StephaneDucasse 6/24/2011 15:52'!
chooseLocal
	"Choose the local version."

	self operation chooseLocal! !

!PSMCPatchOperationWrapper methodsFor: 'converting' stamp: 'GaryChambers 10/26/2011 16:19'!
asString
	"Answer the method name."
	
	^self item definition summary! !

!PSMCPatchOperationWrapper methodsFor: 'testing' stamp: 'StephaneDucasse 6/24/2011 15:51'!
clearChoice
	"Choose neither version (be in conflict)."

	self operation clearChoice! !

!PSMCPatchOperationWrapper methodsFor: 'testing' stamp: 'StephaneDucasse 6/24/2011 15:51'!
remoteChosen
	"Answer whether the remote version is chosen."

	^self operation remoteChosen! !

!PSMCPatchOperationWrapper methodsFor: 'accessing' stamp: 'StephaneDucasse 6/24/2011 15:52'!
chooseRemote
	"Choose the remote version."

	self operation chooseRemote! !

!PSMCPatchOperationWrapper methodsFor: 'accessing' stamp: 'CamilloBruni 9/19/2013 19:43'!
icon
	"Answer a form with an icon to represent the receiver"
	
	self item localChosen 
		ifTrue: [ ^ Smalltalk ui icons changeBlockIcon ].
	^ super icon! !

!PackageAPIHelpBuilder commentStamp: 'TorstenBergmann 2/4/2014 21:17'!
A builder for the API of the various packages!
!PackageAPIHelpBuilder methodsFor: 'building' stamp: 'EstebanLorenzano 7/21/2014 13:48'!
buildPackageTopic: pTopic
 
	| classTopic classes |
	classes := (RPackageSet named: pTopic title) classes 
		asSortedCollection: [:cl1 :cl2 | cl1 name < cl2 name].
	classes do: [ :aClass | 
		classTopic := ClassAPIHelpBuilder 
			buildHierarchicalHelpTopicFrom: aClass 
			withSubclasses: false 
			withMethods: true.
		pTopic addSubtopic: classTopic ]! !

!PackageAPIHelpBuilder methodsFor: 'building' stamp: 'StephanEggermont 12/9/2013 19:52'!
build 
	|pTopic|
	topicToBuild := (HelpTopic named: rootToBuildFrom bookName).
	rootToBuildFrom helpPackages do: [:package|
		pTopic := HelpTopic named: package.
		topicToBuild addSubtopic: pTopic.
		self buildPackageTopic: pTopic.
		
	]
! !

!PackageAbstractNodeExample commentStamp: 'TorstenBergmann 2/3/2014 23:56'!
Example for abstract package nodes!
!PackageAbstractNodeExample methodsFor: 'accessing' stamp: 'AlainPlantec 1/16/2010 09:52'!
browseItem
	! !

!PackageAbstractNodeExample methodsFor: 'accessing' stamp: 'AlainPlantec 1/16/2010 09:52'!
inspectItem
	self inspect! !

!PackageAbstractNodeExample methodsFor: 'accessing' stamp: 'AlainPlantec 2/25/2011 17:06'!
keyStroke: anEvent from: aTreeMorph
	| c |
	c := anEvent keyCharacter.
	c = $b
		ifTrue: [self browseItem. ^ true].
	c = $i
		ifTrue: [self inspectItem. ^ true].
	c = $I
		ifTrue: [self exploreItem. ^ true].
	^ false
! !

!PackageAbstractNodeExample methodsFor: 'accessing' stamp: 'AlainPlantec 1/16/2010 09:52'!
exploreItem
	self explore! !

!PackageAbstractNodeExample methodsFor: 'accessing' stamp: 'AlainPlantec 1/16/2010 09:52'!
doubleClick
	self browseItem! !

!PackageAbstractNodeExample methodsFor: 'menu' stamp: 'AlainPlantec 1/15/2010 14:53'!
contents
	^ contents ifNil: [contents := super contents]! !

!PackageAbstractNodeExample methodsFor: 'accessing' stamp: 'StephaneDucasse 10/22/2014 22:06'!
menu: menu shifted: b 
	menu
		add: 'Expand all' 
		target: self
		selector: #expandAll.
	menu
		add: 'Browse (b)' 
		target: self
		selector: #browseItem.
	menu
		add: 'Inspect (i)' 
		target: self
		selector: #inspectItem.
	menu
		add: 'Explore (I)' 
		target: self
		selector: #exploreItem.
! !

!PackageAndClassChooser commentStamp: '<historical>'!
I am a widget to select classes and packages from a tree.!
!PackageAndClassChooser methodsFor: 'updating' stamp: 'CamilloBruni 10/1/2013 12:50'!
update
	updateProcess ifNotNil: [ updateProcess terminate ].
	updateProcess := [ |roots| 
			roots := self roots.
			UIManager default defer: [ self tree roots: roots ].
		] fork.! !

!PackageAndClassChooser methodsFor: 'accessing' stamp: 'CamilloBruni 11/18/2013 21:00'!
searchField
	^ searchField ifNil: [ 
		searchField := SearchMorph new
			model: self;
			updateSelector: #searchUpdate:;
			on: (Character arrowDown asKeyCombination) do: [ :arg :arg2 :keystroke | 
				self tree spec instance handleKeystroke: keystroke ];
			yourself.
		searchField := searchField asSpecAdapter ]! !

!PackageAndClassChooser methodsFor: 'updating' stamp: 'CamilloBruni 10/1/2013 12:27'!
searchUpdate: aString
	searchPattern := nil.
	
	aString isEmptyOrNil ifFalse: [
		searchPattern := [aString asRegexIgnoringCase] on: RegexSyntaxError do: [ aString ]].
	
	self update.! !

!PackageAndClassChooser methodsFor: 'actions' stamp: 'CamilloBruni 11/20/2013 17:02'!
chooseModalTo: parentWindow
	"Open this this package class chooser as a dialog modal to the given window"
	| dialog result |
	
	dialog := self openDialogWithSpec.
	result := nil.
	dialog 
		okAction: [ result := self selectedItems ];
		cancelAction: [ result := nil ].
	parentWindow openModal: dialog window.
	^ result! !

!PackageAndClassChooser methodsFor: 'accessing - tree' stamp: 'CamilloBruni 9/26/2013 14:30'!
childrenFor: aPackageOrClass
	| result name |
	name := aPackageOrClass name.
	aPackageOrClass isBehavior 
		ifTrue: [ ^ #() ].
	
	aPackageOrClass isTrait 
		ifTrue: [ ^ #() ].
	result := Set new.
	RPackageOrganizer default packagesDo: [ :each | | tempName |
			tempName := each name.
			(tempName size > name size 
			and: [ (tempName at: name size + 1) = $- 
			and: [ (tempName beginsWith: name) ]])
				ifTrue: [ result add: each ]]. 
			
	result := result asSortedCollection: [ :a :b | a name <= b name ].
	result addAll: aPackageOrClass definedClasses.
	^ result
					! !

!PackageAndClassChooser methodsFor: 'testing' stamp: 'CamilloBruni 10/1/2013 12:32'!
hasSearch
	^ self searchPattern isNil not! !

!PackageAndClassChooser methodsFor: 'initialization' stamp: 'CamilloBruni 10/1/2013 12:24'!
initializeWidgets

	self
		setFocus;
		update.! !

!PackageAndClassChooser methodsFor: 'accessing - tree' stamp: 'CamilloBruni 10/1/2013 12:28'!
roots
	| rootNames organizer|
	
	self hasSearch 
		ifTrue: [ ^ self filteredRoots ].
		
	organizer := RPackageOrganizer default.
	rootNames := (organizer packageNames collect: [ :name |
		name copyUpTo: $- ]) asSet asSortedCollection.
	
	^ rootNames collect: [  :name|
		organizer 
			packageNamed: name
			ifAbsent: [ RPackage named: name ]]! !

!PackageAndClassChooser methodsFor: 'accessing' stamp: 'CamilloBruni 9/26/2013 01:54'!
selectedItems
	^ self tree selectedItems! !

!PackageAndClassChooser methodsFor: 'accessing' stamp: 'CamilloBruni 11/17/2013 15:46'!
tree
	^ tree ifNil: [ 
		tree := self instantiate: TreeModel.
		tree
			isCheckList: true;
			multiSelection: true;
			autoMultiSelection: true;
		"	rootNodeHolder: [ :item | 
				TreeNodeModel with: item model: tree ];"
	
			displayBlock:  [ :aPackageOrClass |
				self labelFor: aPackageOrClass ];
			childrenBlock: [ :aPackageOrClass | 
				self childrenFor: aPackageOrClass ];
			iconBlock: [ :treeNode | 
				self iconFor: treeNode content ];
			
			whenSelectedItemChanged: [ :selection | self selectionChanged ];
			doubleClick: [
				 Nautilus openOnPackage: tree selectedItem ]]! !

!PackageAndClassChooser methodsFor: 'accessing - tree' stamp: 'CamilloBruni 10/1/2013 12:42'!
labelFor: aPackageOrClass 

	self hasSearch
		ifTrue: [ ^ aPackageOrClass name ].
	
	^ (aPackageOrClass name copyAfterLast: $-)
		ifEmpty: [ aPackageOrClass name ]! !

!PackageAndClassChooser methodsFor: 'actions' stamp: 'CamilloBruni 9/26/2013 19:48'!
choose
	^ self chooseModalTo: World! !

!PackageAndClassChooser methodsFor: 'accessing - tree' stamp: 'CamilloBruni 11/18/2013 20:59'!
iconFor: anRPackageOrClass
	
	anRPackageOrClass isBehavior
		ifTrue: [ ^ Smalltalk ui icons classIcon ].
	
	RPackageOrganizer default 
		packageNamed: anRPackageOrClass name
		ifAbsent: [ ^ Smalltalk ui icons emptyPackageIcon ].

	^ Smalltalk ui icons packageIcon! !

!PackageAndClassChooser methodsFor: 'accessing - tree' stamp: 'CamilloBruni 9/26/2013 02:07'!
selectionChanged
	"Synchronize the selected items"! !

!PackageAndClassChooser methodsFor: 'accessing' stamp: 'CamilloBruni 9/26/2013 02:00'!
selectedItem
	^ self tree selectedItem! !

!PackageAndClassChooser methodsFor: 'initialization' stamp: 'CamilloBruni 10/1/2013 12:24'!
setFocus
	
	self focusOrder
		add: self searchField;
		add: self tree.
	! !

!PackageAndClassChooser methodsFor: 'accessing - tree' stamp: 'CamilloBruni 10/1/2013 12:40'!
filteredRoots
	|  roots |
	roots := RPackageOrganizer default packages 
		select: [ :package | searchPattern search: package name ].
	roots := roots asSortedCollection: [ :a :b | a name <= b name ].
	Smalltalk allClassesAndTraitsDo: [ :class | 
		(searchPattern search: class name)
			ifTrue: [ roots add: class ]].
	^ roots! !

!PackageAndClassChooser methodsFor: 'accessing' stamp: 'CamilloBruni 10/1/2013 12:32'!
searchPattern
	^ searchPattern! !

!PackageAndClassChooser class methodsFor: 'specs' stamp: 'CamilloBruni 10/1/2013 12:21'!
defaultSpec
	<spec: #default>
	
	^ SpecLayout composed
		newColumn: [ :c |
			c 
				add: #searchField height: 25;
				add: #tree
		];
		yourself! !

!PackageChecker commentStamp: 'TorstenBergmann 2/12/2014 22:57'!
Utility class to check packages!
!PackageChecker methodsFor: 'check' stamp: 'StephaneDucasse 7/30/2010 14:03'!
check
	"self new check"
	
	"only work for top level package overlapping.
	Foo and Foo-Core, but not Foo-Core and Foo-Core-Test"
	| packageNames dict overlappingPackages |
	overlappingPackages := OrderedCollection new.
	packageNames := MCWorkingCopy allManagers collect: [:each | each packageName].
	dict := packageNames groupedBy: [:each | each copyUpTo: $-].
	dict copy keysAndValuesDo: [:k :v | v size = 1 ifTrue: [ dict removeKey: k]].
	dict keysAndValuesDo: [:k :v | (v includes: k) 
									ifTrue: [
										overlappingPackages add: v.
										Warning signal: 'Overlapping packages: ', v printString]].
	^ overlappingPackages ! !

!PackageClassNodeExample commentStamp: 'TorstenBergmann 2/3/2014 23:55'!
Example for a package class node!
!PackageClassNodeExample methodsFor: 'menu' stamp: 'StephaneDucasse 8/29/2013 20:55'!
methodsInCategory: aCat
	^ self item  selectorsInProtocol: aCat! !

!PackageClassNodeExample methodsFor: 'accessing' stamp: 'StephaneDucasse 10/15/2011 20:57'!
browseItem
	Smalltalk tools browser
		fullOnClass: self item  selector: nil! !

!PackageClassNodeExample methodsFor: 'menu' stamp: 'AlainPlantec 1/29/2010 12:16'!
childrenItems
	^ self item organization categories 
! !

!PackageClassNodeExample methodsFor: 'menu' stamp: 'AlainPlantec 2/8/2010 09:39'!
childNodeClassFromItem: anItem
	^PackageMethodCategoryNodeExample! !

!PackageListWidget commentStamp: 'NicolaiHess 7/27/2014 13:18'!
PackageWidget is the basic implementation of a wiget managing packages as list!
!PackageListWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/28/2014 21:49'!
updateList
	packagesList updateList! !

!PackageListWidget methodsFor: 'protocol' stamp: 'NicolaiHess 8/9/2014 23:11'!
resetPackageGroupList
	packagesListElements  := nil.! !

!PackageListWidget methodsFor: 'private list model' stamp: 'NicolaiHess 7/28/2014 22:14'!
packageSelectionAt: anIndex 
	| elt |
	elt := self getPackagesList at: anIndex ifAbsent: [ ^ false ].
	^ (packagesSelection at: elt ifAbsent: [ false ])! !

!PackageListWidget methodsFor: 'private' stamp: 'NicolaiHess 7/27/2014 00:51'!
getPackagesList
	^ packagesListElements ifNil: [ packagesListElements := self loadPackagesListElements ].! !

!PackageListWidget methodsFor: 'item creation' stamp: 'NicolaiHess 7/28/2014 22:26'!
buildPackagesList
	packagesList := PluggableIconListMorph new
		basicWrapSelector: #packageItemWrapper:;
		keystrokeSelector: #keyPressedOnList:shifted:;
		getIconSelector: #packageListItemIcon:;
		getListSizeSelector: #packageListSize;
		resetListSelector: #resetPackagesSelection;
		autoDeselect: true;
		dropEnabled: true;
		doubleClickSelector: #doubleClick;
		dropItemSelector: #dropInPackageList:inARow:;
		dragEnabled: true;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		model: self;
		getIndexSelector: #selectedPackageIndex;
		setIndexSelector: #selectedPackageIndex:;
		getSelectionListSelector: #packageSelectionAt:;
		setSelectionListSelector: #packageSelectionAt:put:;
		getMenuSelector: #menu:shifted:;
		beMultipleSelection;
		basicGetListElementSelector: #getPackageItem:;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		yourself.
	^ packagesList! !

!PackageListWidget methodsFor: 'private list model' stamp: 'NicolaiHess 7/26/2014 21:52'!
keyPressedOnList: anEvent shifted: aBoolean
	| aCharacter |
	aCharacter := anEvent keyCharacter.
	aCharacter == self model class nextFocusKey
		ifTrue: [ ^ self model giveFocusTo: self model classWidget ].
	aCharacter == self model class previousFocusKey
		ifTrue: [ ^ self model giveFocusTo: self model sourceTextArea ]! !

!PackageListWidget methodsFor: 'private list model' stamp: 'NicolaiHess 7/27/2014 00:54'!
selectedPackageIndex

	| item |
	item :=  self model
				ifGroups: [ self model selectedGroup ]
				ifNot: [ self model selectedPackage ].
				
	^self getPackagesList indexOf: item.! !

!PackageListWidget methodsFor: 'private' stamp: 'NicolaiHess 7/27/2014 00:51'!
loadPackagesListElements
	^ self model loadList! !

!PackageListWidget methodsFor: 'private list model' stamp: 'NicolaiHess 7/30/2014 12:11'!
packageListItemIcon: anItem

	" I return the icon corresponding to anItem in the leftmost list "
	^ self model showGroups
		ifTrue: [ self model groupIconFor: anItem ]
		ifFalse: [
			" if I do not show groups, I have to know if I show packages or classes "
			self model packageIconFor: anItem]! !

!PackageListWidget methodsFor: 'private list model' stamp: 'NicolaiHess 7/26/2014 21:50'!
packageItemWrapper: anElement
	anElement = 0
		ifTrue: [ ^ '' ].
	^ self model
		ifGroups: [ anElement name ]
		ifNot: [ 
			anElement name]! !

!PackageListWidget methodsFor: 'private list model' stamp: 'NicolaiHess 7/27/2014 00:54'!
packageListSize
	^ self getPackagesList size! !

!PackageListWidget methodsFor: 'private list model' stamp: 'NicolaiHess 7/27/2014 00:54'!
getPackageItem: anIndex
	^ self getPackagesList at: anIndex! !

!PackageListWidget methodsFor: 'private list model' stamp: 'NicolaiHess 7/27/2014 00:55'!
selectedPackageIndex: anInteger
	| selection |
	
	self model resetClassesList.
	selection := self getPackagesList at: anInteger ifAbsent: [nil].
	self model
		ifGroups: [ self model selectedGroupWithoutChangingSelection: selection ]
		ifNot: [ self model selectedPackageWithoutChangingSelection: selection ].
	
	self changed: #selectedPackage.
	self model changed: #currentHistoryIndex.! !

!PackageListWidget methodsFor: 'private list model' stamp: 'NicolaiHess 7/28/2014 22:09'!
dropInPackageList: aCollection inARow: aRow
	| receiver |
	
	(aRow = 0) ifTrue: [ ^ self ].
	receiver := self getPackagesList at: aRow.
	receiver isClass
		ifTrue: [ 
			receiver := 
			self model selectedClass isMeta
					ifTrue: [ receiver theMetaClass ]
					ifFalse: [ receiver theNonMetaClass ]].
	
	self model dropInAPackage: aCollection into: receiver! !

!PackageListWidget methodsFor: 'private list model' stamp: 'NicolaiHess 7/26/2014 21:55'!
doubleClick

	self model
		ifGroups: [ self model doubleClickOnGroup ]
		ifNot: [ self model doubleClickOnPackage ]! !

!PackageListWidget methodsFor: 'private list model' stamp: 'NicolaiHess 7/27/2014 00:54'!
packageSelectionAt: anIndex put: aBoolean

	| elt |
	elt := self getPackagesList at: anIndex ifAbsent: [ ^ self ].
	packagesSelection at: elt put: aBoolean.
	self model changed: #hasSelectedSelections! !

!PackageListWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/28/2014 21:46'!
enabled: aTrue 
	packagesList enabled: aTrue! !

!PackageListWidget methodsFor: 'private list model' stamp: 'NicolaiHess 7/26/2014 21:59'!
menu: aMenu shifted: aBoolean 
	
	self model showGroups
			ifTrue: [self model groupsMenu: aMenu shifted: aBoolean]
			ifFalse: [self model packagesMenu: aMenu shifted: aBoolean].
	^ aMenu! !

!PackageManifest commentStamp: 'ChristopheDemarey 11/20/2014 11:15'!
I store meta-data for a package. I'm the common superclass of all package Manifest.!
!PackageManifest methodsFor: 'comparing' stamp: 'ChristopheDemarey 11/24/2014 13:58'!
hash
	^ self class hash! !

!PackageManifest methodsFor: 'comparing' stamp: 'ChristopheDemarey 11/21/2014 15:14'!
= anObject

	^ anObject class = self class! !

!PackageManifest methodsFor: 'code-critics' stamp: 'ChristopheDemarey 11/20/2014 11:37'!
rejectRules
	^ #()! !

!PackageManifest methodsFor: 'code-critics' stamp: 'ChristopheDemarey 11/20/2014 11:37'!
rejectClasses
	^ #()! !

!PackageManifest class methodsFor: 'testing' stamp: 'ChristopheDemarey 11/20/2014 11:26'!
isManifest
	^ (self = PackageManifest) not! !

!PackageMethodCategoryNodeExample commentStamp: 'TorstenBergmann 2/3/2014 23:55'!
Example for a package method node!
!PackageMethodCategoryNodeExample methodsFor: 'accessing' stamp: 'StephaneDucasse 8/29/2013 20:55'!
childrenItems
	^ self parentNode item selectorsInProtocol: self item! !

!PackageMethodCategoryNodeExample methodsFor: 'accessing' stamp: 'AlainPlantec 2/8/2010 09:39'!
childNodeClassFromItem: anItem
	^ PackageMethodNodeExample! !

!PackageMethodNodeExample commentStamp: 'TorstenBergmann 2/3/2014 23:55'!
Example for a package method node!
!PackageMethodNodeExample methodsFor: 'accessing' stamp: 'AlainPlantec 1/26/2010 13:49'!
selector
	^ self item! !

!PackageMethodNodeExample methodsFor: 'accessing' stamp: 'StephaneDucasse 10/15/2011 20:57'!
browseItem
	Smalltalk tools browser
		fullOnClass: self itemClass  selector: self selector ! !

!PackageMethodNodeExample methodsFor: 'results' stamp: 'AlainPlantec 1/26/2010 14:03'!
compiledMethod
	^ self itemClass
		compiledMethodAt: self selector
		ifAbsent: [self itemClass class
				compiledMethodAt: self selector
				ifAbsent: []]! !

!PackageMethodNodeExample methodsFor: 'private' stamp: 'AlainPlantec 1/26/2010 13:49'!
itemClass
	^ self parentNode parentNode item.
! !

!PackageNodeExample commentStamp: 'TorstenBergmann 2/3/2014 23:55'!
Example for a pakage node!
!PackageNodeExample methodsFor: 'accessing' stamp: 'AlainPlantec 2/8/2010 09:39'!
childNodeClassFromItem: anItem
	^  PackageClassNodeExample ! !

!PackageNodeExample methodsFor: 'accessing' stamp: 'AlainPlantec 1/29/2010 12:17'!
childrenItems
	^ self item classes ! !

!PackageNodeExample methodsFor: 'accessing' stamp: 'AlainPlantec 1/15/2010 15:15'!
asString
	^ self item packageName! !

!PackageRemotesManager commentStamp: 'ChristopheDemarey 1/8/2014 16:53'!
I am an user interface used to link mcpackages and remotes

PackageRemotesManager new openWithSpec!
!PackageRemotesManager methodsFor: 'private' stamp: 'ChristopheDemarey 12/19/2013 17:32'!
change: selected forRemote: remote
	| selectedPackage group |
	
	selectedPackage := packages selectedItem.
	selectedPackage ifNil: [ ^ self ].
	
	group := selectedPackage content repositoryGroup.
	
	selected
		ifTrue: [ group addRepository: remote ]
		ifFalse: [ group removeRepository: remote ]! !

!PackageRemotesManager methodsFor: 'accessing' stamp: 'ChristopheDemarey 1/8/2014 16:55'!
remotes

	^ remotes! !

!PackageRemotesManager methodsFor: 'initialization' stamp: 'ChristopheDemarey 1/8/2014 16:57'!
initializeWidgets

	packages := self instantiate: SearchableTree.
	remotes := self instantiate: RemotesManager.

	packages displayBlock: [ :each | each packageName ].
	
	remotes selectedRemotes: self selectedPackageRepositories.
		
	self focusOrder
		add: packages;
		add: remotes! !

!PackageRemotesManager methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 12/4/2013 13:12'!
initializeDialogWindow: aWindow

	aWindow
		toolbar: OkToolbar new! !

!PackageRemotesManager methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/30/2013 22:05'!
doIfNotSilent: aBlock

	silent ifTrue: [ ^ self ].
	aBlock value! !

!PackageRemotesManager methodsFor: 'accessing' stamp: 'ChristopheDemarey 1/8/2014 16:55'!
packages

	^ packages! !

!PackageRemotesManager methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/30/2013 20:02'!
packages: mcPackages

	packages roots: mcPackages! !

!PackageRemotesManager methodsFor: 'initialization' stamp: 'ChristopheDemarey 12/17/2013 17:24'!
initialize

	super initialize.
	silent := false.! !

!PackageRemotesManager methodsFor: 'accessing' stamp: 'ChristopheDemarey 1/8/2014 16:55'!
remotesTree

	^ remotes remotes! !

!PackageRemotesManager methodsFor: 'initialization' stamp: 'ChristopheDemarey 12/19/2013 16:36'!
initializePresenter

	packages whenSelectedItemChanged: [ :item |	self updateRemoteSelectionFrom: item ].
		
	packages whenRootsChanged: [ :nodes | 
		nodes ifNotEmpty: [ nodes first takeHighlight ] ].
	
	remotes selectedChangedBlock: [:remote :selected | 
		self doIfNotSilent: [ self change: selected forRemote: remote ]].
	
	self whenBuiltDo: [ | nodes |
		nodes := packages roots.
		nodes ifNotEmpty: [
			packages selectedItem: (
			nodes first 
				selected: true;
				takeHighlight;
				yourself ) ] ]! !

!PackageRemotesManager methodsFor: 'api' stamp: 'BenjaminVanRyseghem 12/1/2013 00:29'!
title

	^ 'Remotes manager'! !

!PackageRemotesManager methodsFor: 'private' stamp: 'ChristopheDemarey 1/8/2014 16:55'!
selectedPackageRepositories

	^ packages selectedItem
		ifNil: [ #() ]
		ifNotNil: [ :item | item content repositoryGroup repositories ].! !

!PackageRemotesManager methodsFor: 'private' stamp: 'ChristopheDemarey 12/19/2013 17:30'!
updateRemoteSelectionFrom: aPackage
	| repositories |
	
	aPackage 
		ifNil: [ repositories := #() ]
		ifNotNil: [ repositories := aPackage repositoryGroup repositories ].

	self remotesTree roots do: [ :node |
		self silentWhile: [ 
			node selected: (repositories includes: node content remote) ] ]! !

!PackageRemotesManager methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/30/2013 22:04'!
silentWhile: aBlock
	| oldSilent |
	
	oldSilent := silent.
	silent := true.
	aBlock ensure: [ silent := oldSilent ]! !

!PackageRemotesManager methodsFor: 'api' stamp: 'BenjaminVanRyseghem 12/4/2013 10:18'!
initialExtent

	^  700@460! !

!PackageRemotesManager class methodsFor: 'specs' stamp: 'ChristopheDemarey 12/17/2013 16:44'!
defaultSpec
	<spec: #default>
	
	^ SpecLayout composed
		newRow: [ :row |
			row
				add: #packages;
				addSplitter;
				add: #remotes
		];
		yourself! !

!PackageTasksPlugin commentStamp: '<historical>'!
This plugin shows the tasks in the current package.

A task is a method which sends #flag: to mark it as #todo, or #fixme, or whatever task you want to fix.
Clicking in the specific task makes you jump to the marked method.!
!PackageTasksPlugin methodsFor: 'display' stamp: 'GuillermoPolito 5/2/2012 13:32'!
selectedIndex
	^index! !

!PackageTasksPlugin methodsFor: 'initialization' stamp: 'GuillermoPolito 5/2/2012 13:46'!
initialize
	tasks := OrderedCollection new.
	index := 0.
	panel := PanelMorph new
				changeTableLayout;
				listDirection: #leftToRight;
				addMorph: self buildTaskList;
				addMorph: ((StringMorph contents: 'Tasks:') width: 50; height: 50; yourself);
				hResizing: #spaceFill;
				vResizing: #shrinkWrap;
				yourself.
! !

!PackageTasksPlugin methodsFor: 'announcement' stamp: 'StephaneDucasse 10/30/2014 07:48'!
packageSelected: anAnnouncement
	
	| package |
	package := anAnnouncement package package.
	package
		ifNil: [ tasks removeAll ]
		ifNotNil: [ tasks := (self systemNavigation allCallsOn: #flag:) 
									select: [ :m | package includesMethod: m selector ofClass: m methodClass ] ].
	
	self changed: #tasks.! !

!PackageTasksPlugin methodsFor: 'display' stamp: 'GuillermoPolito 5/2/2012 12:38'!
index
	^index! !

!PackageTasksPlugin methodsFor: 'display' stamp: 'GuillermoPolito 5/2/2012 13:33'!
selectedIndex: anIndex
	index := anIndex.
	self updateMethodSelection: (tasks at: index ifAbsent: [ ^self ]).! !

!PackageTasksPlugin methodsFor: 'display' stamp: 'StephaneDucasse 10/30/2014 08:00'!
updateMethodSelection: aMethod

	model ui categoryWidget
		resetCategoryList;
		resetCategorySelection.

	model ui categoryWidget
		categoriesSelection at: aMethod category put: true.

	model ui methodWidget 
		resetMethodList;
		resetMethodSelection.
		
	model ui methodWidget 
		methodsSelection at: aMethod category put: true.

	model ui resetClassesListSelection.
	model ui classWidget selectClass: aMethod methodClass.
	model  
		package: model selectedPackage 
		class: aMethod methodClass 
		category: aMethod category 
		method: aMethod method.
	model ui 
		updateClassView;
		updateCategoryAndMethodList;
		updateOnClassSelection
	! !

!PackageTasksPlugin methodsFor: 'display' stamp: 'StephaneDucasse 10/30/2014 07:44'!
buildTaskList
	^ (PluggableListMorph
		on: self
		list: #tasks
		selected: #selectedIndex
		changeSelected: #selectedIndex:
		menu: nil
		keystroke: nil)
		height: 50;
		hResizing: #spaceFill;
		yourself! !

!PackageTasksPlugin methodsFor: 'display' stamp: 'GuillermoPolito 5/2/2012 12:38'!
tasks
	^tasks! !

!PackageTasksPlugin methodsFor: 'display' stamp: 'GuillermoPolito 5/2/2012 13:37'!
display
	^panel! !

!PackageTasksPlugin class methodsFor: 'position' stamp: 'GuillermoPolito 5/2/2012 12:49'!
defaultPosition

	^ #top! !

!PackageTasksPlugin class methodsFor: 'position' stamp: 'GuillermoPolito 5/2/2012 13:53'!
description
	^self comment! !

!PackageTreeExample commentStamp: '<historical>'!
PackageTreeExample new open!
!PackageTreeExample methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 2/7/2010 22:44'!
rootNodeClassFromItem: anItem
	^ PackageNodeExample! !

!PackageTreeExample methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 10/11/2011 14:57'!
defaultTreeMorph
	^ super defaultTreeMorph
			doubleClickSelector: #doubleClick;
			nodeStringGetter: #asString;
			getMenuSelector: #menu:shifted:.
! !

!PackageTreeExample methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 10/7/2011 11:39'!
open
	^ self openDialogWindowIn: World title: 'Packages'.
! !

!PackageTreeExample methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 2/25/2011 17:06'!
keyStroke: anEvent from: aTreeMorph 
	self selectedNode
		ifNotNil: [:current | current keyStroke: anEvent from: aTreeMorph]! !

!PackageTreeExample methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 12/15/2009 20:11'!
doubleClick
	self selectedNode ifNotNil: [:n | n doubleClick]! !

!PackageTreeExample methodsFor: 'as yet unclassified' stamp: 'EstebanLorenzano 7/21/2014 13:40'!
rootItems
	^ RPackageOrganizer default packages ! !

!PackageTreeExample methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 12/15/2009 15:10'!
menu: menu shifted: b 
	"Set up the menu to apply to the receiver's, 
	honoring the #shifted boolean"
	self selectedNode ifNotNil: [:current | current menu: menu shifted: b].
	^ menu! !

!PackageTreeExample class methodsFor: 'examples' stamp: 'TorstenBergmann 9/30/2014 20:12'!
example

	^PackageTreeExample new open! !

!PackageTreeGroupNodeModel commentStamp: '<historical>'!
I'm a group node model.!
!PackageTreeGroupNodeModel methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/3/2013 15:32'!
icon 
	^ self model groupIconFor: self item.! !

!PackageTreeGroupNodeModel methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/3/2013 15:31'!
rowMorphForColumn: aTreeColumn
	^ self item name asMorph! !

!PackageTreeGroupNodeModel methodsFor: 'converting' stamp: 'EstebanLorenzano 10/14/2013 13:16'!
asNautilusSelection 
	^ PackageTreeGroupSelection node: self! !

!PackageTreeGroupSelection commentStamp: '<historical>'!
I'm a group selection.!
!PackageTreeGroupSelection methodsFor: 'testing' stamp: 'EstebanLorenzano 10/3/2013 15:36'!
includesClass: aClass 
	^ self definedClasses includes: aClass! !

!PackageTreeGroupSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/9/2013 12:56'!
menu: aMenu shifted: aBoolean target: aTarget
	^ aTarget groupsMenu: aMenu shifted: aBoolean! !

!PackageTreeGroupSelection methodsFor: 'testing' stamp: 'EstebanLorenzano 10/3/2013 16:09'!
isGroup 
	^ true! !

!PackageTreeGroupSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 11/25/2013 14:48'!
protocolsFor: class 
	^ self item protocolsFor: class! !

!PackageTreeGroupSelection methodsFor: 'testing' stamp: 'NicolasPetton 2/14/2014 15:22'!
includesCategory: aSymbol
	^ self item packages anySatisfy: [ :each | each name == aSymbol ]! !

!PackageTreeGroupSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/14/2013 13:14'!
definedClasses
	^ self item classes! !

!PackageTreeGroupSelection methodsFor: 'testing' stamp: 'EstebanLorenzano 11/29/2013 14:47'!
removable 
	^ self item removable ! !

!PackageTreeGroupSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 12/12/2013 18:13'!
categoryName 
	^ ''! !

!PackageTreeGroupSelection methodsFor: 'accessing' stamp: 'NicolaiHess 1/16/2014 09:56'!
classes
	^ self definedClasses! !

!PackageTreeGroupSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/9/2013 17:35'!
registerSelectionTarget: aTarget 
	aTarget registerSelectionGroup: self.! !

!PackageTreeGroupSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/14/2013 13:15'!
package 
	^ self item packages 
		ifNotEmpty: [ :packages | packages first ]! !

!PackageTreeGroupSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 11/25/2013 14:48'!
methodsFor: class categorised: aCategory
	^ self item 
		methodsFor: class 
		categorised: aCategory! !

!PackageTreeGroupSelection methodsFor: 'testing' stamp: 'EstebanLorenzano 11/29/2013 14:47'!
isReadOnly 
	^ self item isReadOnly ! !

!PackageTreeGroupSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 11/25/2013 14:47'!
methodsFor: class 
	^ self item methodsFor: class! !

!PackageTreeGroupSelection class methodsFor: 'instance creation' stamp: 'EstebanLorenzano 10/14/2013 16:11'!
group: aGroup
	^ self node: (PackageTreeGroupNodeModel with: aGroup)! !

!PackageTreeModel commentStamp: '<historical>'!
I'm a tree model for managing grouos, packages and tags.!
!PackageTreeModel methodsFor: 'drag and drop' stamp: 'EstebanLorenzano 11/29/2013 13:26'!
acceptDroppingMorph: aMorph event: evt inMorph: aTreeMorph
	| target items |
	
	target := (aTreeMorph scrollerSubMorphFromPoint: evt position) complexContents item.
	items := aMorph passenger.
	target ifNotNil: [ 
		model 
			dropInAPackage: items 
			into: target ]! !

!PackageTreeModel methodsFor: 'help-text' stamp: 'monty 3/28/2015 06:26'!
helpTextFor: aRPackage
	"We try to get a configuration class with the same name of the package"

	| possibleConfigurationNames |
	aRPackage name ifEmpty: [ ^ nil ].
	possibleConfigurationNames := OrderedCollection new.
	(aRPackage name beginsWith: 'ConfigurationOf')
		ifTrue: [ possibleConfigurationNames addLast: aRPackage name ]
		ifFalse: [ 
			| stream |
			"'ConfigurationOf' size"
			stream := (String new: aRPackage name size + 15) writeStream.
			stream nextPutAll: 'ConfigurationOf'.
			$-
				split: aRPackage name
				do: [ :each | 
					(each = 'Core' or: [ each = 'Tests' ])
						ifFalse: [ 
							stream nextPutAll: each.
							possibleConfigurationNames addLast: stream contents ] ] ].
	"try longeset match first"
	possibleConfigurationNames
		reverseDo: [ :each | 
			each asSymbol
				asClassIfPresent: [ :configuration | 
					"If the configuration has a catalog description we show it, if not we don't"
					(configuration respondsTo: #catalogDescription)
						ifTrue: [ ^ configuration catalogDescription ]
						ifFalse: [ ^ nil ] ] ].
	^ nil.! !

!PackageTreeModel methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/2/2013 19:10'!
packageIconFor: aPackage 
	^ self model packageIconFor: aPackage.! !

!PackageTreeModel methodsFor: 'drag and drop' stamp: 'NicolaiHess 2/13/2014 11:19'!
wantsDroppedMorph: aMorph event: anEvent inMorph: destMorph
	"TODO: Filter out to avoid drag and drop of different objet types. Here, we don't know what the target may be so filtering is limited."

	aMorph dragTransferType ifNil: [ ^ false ].
	^ destMorph model == self! !

!PackageTreeModel methodsFor: 'accessing' stamp: 'NicolaiHess 7/27/2014 14:42'!
rootNodes 

	self model showGroups 
		ifTrue: [ ^ self groupsAsNodes ].

	^ PackageTreeNautilus showGroupsOnTop 
		ifTrue: [ self groupsAsNodes, (self packagesAsNodes) ]
		ifFalse: [ self packagesAsNodes ].	
! !

!PackageTreeModel methodsFor: 'keyboard managing' stamp: 'EstebanLorenzano 3/19/2014 13:44'!
arrowEvent: event key: aChar target: aMorph
	"Transmit flow to next column"
	^ self model keyPressedOnTree: event target: aMorph.! !

!PackageTreeModel methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/3/2013 15:32'!
groupIconFor: aPackage 
	^ self model groupIconFor: aPackage.! !

!PackageTreeModel methodsFor: 'package filter' stamp: 'JurajKubelka 11/15/2013 16:16'!
packageMatchPattern: aRPackage 
	
	^ self model packageMatchPattern: aRPackage! !

!PackageTreeModel methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/2/2013 18:46'!
model
	^ model! !

!PackageTreeModel methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/2/2013 19:20'!
tagIconFor: aTag 
	^ nil! !

!PackageTreeModel methodsFor: 'private' stamp: 'EstebanLorenzano 11/27/2013 13:19'!
packagesAsNodes
	^ ((self model packages
		select: [ :each | self packageMatchPattern: each ]
		thenCollect: [ :each | each asNautilusNodeWithModel: self ])
		sorted: [ :a :b | a name < b name ]) ! !

!PackageTreeModel methodsFor: 'updating' stamp: 'NicolaiHess 8/4/2014 08:43'!
okToChange
	^ self model okToChange! !

!PackageTreeModel methodsFor: 'private' stamp: 'EstebanLorenzano 10/3/2013 15:24'!
groupsAsNodes
	^ (self model groups
		collect: [ :each | PackageTreeGroupNodeModel with: each model: self ])
		sorted: [ :a :b | a name < b name ]! !

!PackageTreeModel methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/2/2013 18:46'!
model: anObject
	model := anObject! !

!PackageTreeModel methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/3/2013 13:18'!
menu: menu shifted: b
	^ self model menu: menu shifted: b! !

!PackageTreeNautilus commentStamp: '<historical>'!
I'm a model for Nautilus with package tree.!
!PackageTreeNautilus methodsFor: 'accessing' stamp: 'EstebanLorenzano 11/25/2013 14:34'!
defaultUIClass 
	^ PackageTreeNautilusUI! !

!PackageTreeNautilus methodsFor: 'package filter' stamp: 'JurajKubelka 12/26/2013 14:23'!
packagePatternString: aString 
	
	self ui packagePatternString: aString! !

!PackageTreeNautilus class methodsFor: 'settings' stamp: 'EstebanLorenzano 11/25/2013 13:39'!
showGroupsOnTop 
	^ ShowGroupsOnTop ifNil: [ ShowGroupsOnTop := true ]! !

!PackageTreeNautilus class methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/14/2013 15:51'!
parentOfClass: aClass
	"I can answer an RPackage or an RPackageTag, depending on the presence of Tags in package. 
	 This is an UI optimization to not show a tree RPackage->RPackageTag when there is just 
	 one tag in package, named in the same way as his parent"	

	| package tag |
	
	package := aClass package.
	tag := package classTagForClass: aClass.
	^ (((tag name = package name) and: [ package classTags size <= 1 ]) 
		ifTrue: [ package ]
		ifFalse: [ tag ])
		asNautilusSelection! !

!PackageTreeNautilus class methodsFor: 'settings' stamp: 'StephaneDucasse 11/11/2014 18:44'!
nautilusSettingsOn: aBuilder
	<systemsettings>
	
	(aBuilder setting: #showGroupsOnTop)
		parent: #Nautilus;
		target: self;
		label: 'Show groups on top ?';
		description: 'If true, Nautilus will show groups on top of package pane'.! !

!PackageTreeNautilus class methodsFor: 'settings' stamp: 'EstebanLorenzano 11/25/2013 13:40'!
showGroupsOnTop: aBoolean
	ShowGroupsOnTop := aBoolean! !

!PackageTreeNautilus class methodsFor: 'class initialization' stamp: 'StephaneDucasse 6/26/2014 09:25'!
registerToolsOn: registry
	"Add ourselves to registry. See [Smalltalk tools]" 
	registry register: self as: #browser
! !

!PackageTreeNautilusTest methodsFor: 'accessing' stamp: 'JurajKubelka 2/4/2015 11:37'!
compiledMethod: aCompiledMethod
	compiledMethod := aCompiledMethod.
	expectedMethodCategory := compiledMethod category.
	expectedCompiledMethod := compiledMethod.! !

!PackageTreeNautilusTest methodsFor: 'tests' stamp: 'JurajKubelka 2/3/2015 15:14'!
testOpenOnMethodLastValueIsNil
	lastValue := SharedPackageFilterPatternsHolder instance lastValue.
	SharedPackageFilterPatternsHolder instance lastValue: nil.
	self testOpenOnMethod.! !

!PackageTreeNautilusTest methodsFor: 'tests' stamp: 'JurajKubelka 2/4/2015 08:59'!
testFullBrowseLastValueNotNilSelectedCategoryIsNil
	| newNautilus |
	self compiledMethod: self class >> #testFullBrowseLastValueNotNil.
	self testOpenOnMethodLastValueNotNil.
	nautilus selectedCategory: nil.
	nautilus selectedMethod: compiledMethod. 
	self assert: nautilus selectedCategory isNil.
	self assert: nautilus selectedMethod equals: compiledMethod.
	expectedMethodCategory := nil.
	newNautilus := nautilus ui fullBrowse.
	nautilus close.
	nautilus := newNautilus.
	self assertSelectedCompiledMethod.! !

!PackageTreeNautilusTest methodsFor: 'tests' stamp: 'JurajKubelka 2/3/2015 15:13'!
testOpenOnMethodLastValueNotNil
	lastValue := SharedPackageFilterPatternsHolder instance lastValue.
	SharedPackageFilterPatternsHolder instance lastValue: 'AAATest'.
	self testOpenOnMethod.! !

!PackageTreeNautilusTest methodsFor: 'running' stamp: 'JurajKubelka 2/3/2015 15:12'!
tearDown
	nautilus ifNotNil: [ :aNautilus | 
		aNautilus ui ifNotNil: [ :aUI | aUI close ] ].
	lastValue ifNotNil: [ :aValue |
		SharedPackageFilterPatternsHolder instance lastValue: aValue ].
	super tearDown! !

!PackageTreeNautilusTest methodsFor: 'tests' stamp: 'JurajKubelka 2/4/2015 11:48'!
testFullBrowseOnClass
	| newNautilus |
	self testOpenOnMethodLastValueIsNil.
	nautilus ui browseClass: compiledMethod methodClass.
	expectedMethodCategory := nil.
	expectedCompiledMethod := nil.
	newNautilus := nautilus ui fullBrowse.
	nautilus close.
	nautilus := newNautilus.
	self assertSelectedCompiledMethod.! !

!PackageTreeNautilusTest methodsFor: 'tests' stamp: 'JurajKubelka 2/4/2015 09:59'!
testFullBrowseLastValueNotNil
	| newNautilus |
	self testOpenOnMethodLastValueNotNil.
	newNautilus := nautilus ui fullBrowse.
	nautilus close.
	nautilus := newNautilus.
	self assertSelectedCompiledMethod.! !

!PackageTreeNautilusTest methodsFor: 'tests' stamp: 'JurajKubelka 2/4/2015 08:11'!
testOpenLastValueNotNil
	lastValue := SharedPackageFilterPatternsHolder instance lastValue.
	SharedPackageFilterPatternsHolder instance lastValue: 'K'.
	nautilus := PackageTreeNautilus open.
	nautilus packagePatternString: 'H'.
	nautilus packagePatternString: 'anything long'.
	nautilus packagePatternString: ''.
! !

!PackageTreeNautilusTest methodsFor: 'tests' stamp: 'JurajKubelka 2/4/2015 09:59'!
testPackagePatternString
	lastValue := SharedPackageFilterPatternsHolder instance lastValue.
	SharedPackageFilterPatternsHolder instance lastValue: ''.
	nautilus := PackageTreeNautilus openOnMethod: compiledMethod.
	self assertSelectedCompiledMethod.
	nautilus packagePatternString: 'H'.
	self assertSelectedCompiledMethod.
	nautilus packagePatternString: 'anything long'.
	self assertSelectedCompiledMethod.
	nautilus packagePatternString: ''.
	self assertSelectedCompiledMethod.! !

!PackageTreeNautilusTest methodsFor: 'tests' stamp: 'JurajKubelka 2/4/2015 08:58'!
testPackagePatternStringRootPackageTag
	lastValue := SharedPackageFilterPatternsHolder instance lastValue.
	SharedPackageFilterPatternsHolder instance lastValue: ''.
	self compiledMethod: (PackageManifest>>#=).
	nautilus := PackageTreeNautilus openOnMethod: compiledMethod.
	self assertSelectedCompiledMethod.
	nautilus packagePatternString: 'H'.
	self assertSelectedCompiledMethod.
	nautilus packagePatternString: 'anything long'.
	self assertSelectedCompiledMethod.
	nautilus packagePatternString: ''.
	self assertSelectedCompiledMethod.! !

!PackageTreeNautilusTest methodsFor: 'tests' stamp: 'JurajKubelka 2/5/2015 02:09'!
setUp
	super setUp.
	self compiledMethod: (PackageTreeNautilusUI>>#addClassIn:).
	lastValue := SharedPackageFilterPatternsHolder instance lastValue.! !

!PackageTreeNautilusTest methodsFor: 'asserting' stamp: 'JurajKubelka 2/4/2015 10:05'!
assertPackageMorph: eachMorph
	| tagMorph tag |
	self assert: eachMorph isExpanded.
	eachMorph children ifEmpty: [ ^ self ]. 
	tag := compiledMethod package classTagForClass: compiledMethod methodClass.
	tagMorph := eachMorph children select: [ :eachChild | eachChild complexContents item = tag ].
	self assert: tagMorph size equals: 1.
	^ self assert: tagMorph first isSelected! !

!PackageTreeNautilusTest methodsFor: 'tests' stamp: 'JurajKubelka 2/4/2015 09:59'!
testOpenOnMethod
	nautilus := PackageTreeNautilus openOnMethod: compiledMethod.
	self assertSelectedCompiledMethod.! !

!PackageTreeNautilusTest methodsFor: 'tests' stamp: 'JurajKubelka 2/4/2015 09:59'!
testFullBrowseLastValueIsNil
	| newNautilus |
	self testOpenOnMethodLastValueIsNil.
	newNautilus := nautilus ui fullBrowse.
	nautilus close.
	nautilus := newNautilus.
	self assertSelectedCompiledMethod.! !

!PackageTreeNautilusTest methodsFor: 'tests' stamp: 'JurajKubelka 2/4/2015 12:23'!
testOpen
	| allPackages filteredPackages |
	SharedPackageFilterPatternsHolder instance lastValue: nil.
	nautilus := PackageTreeNautilus open.
	allPackages := nautilus packages copy.  
	allPackages := nautilus ui packageWidget packagesList nodeList copy.
	nautilus packagePatternString: 'H'.
	filteredPackages := nautilus ui packageWidget packagesList nodeList copy.
	self assert: allPackages size > filteredPackages size.
! !

!PackageTreeNautilusTest methodsFor: 'tests' stamp: 'JurajKubelka 2/4/2015 08:57'!
testFullBrowseLastValueNotNil2
	| newNautilus |
	self compiledMethod: self class >> #testFullBrowseLastValueNotNil.
	self testOpenOnMethodLastValueNotNil.
	newNautilus := nautilus ui fullBrowse.
	nautilus close.
	nautilus := newNautilus.
	self assertSelectedCompiledMethod.! !

!PackageTreeNautilusTest methodsFor: 'asserting' stamp: 'JurajKubelka 2/4/2015 10:01'!
assertPackageWidget
	| packageNodeList packageMorphList |
	packageNodeList := nautilus ui packageWidget packagesList nodeList
		select: [ :eachNode | eachNode item = compiledMethod package ].
	packageMorphList := nautilus ui packageWidget packagesList scroller submorphs
		select: [ :eachMorph | packageNodeList anySatisfy: [ :eachNode | eachMorph complexContents = eachNode ] ].
	self assert: packageNodeList size equals: packageMorphList size.
	self assert: packageNodeList size <= 1.
	packageMorphList do: [ :eachMorph | self assertPackageMorph: eachMorph ]! !

!PackageTreeNautilusTest methodsFor: 'asserting' stamp: 'JurajKubelka 2/4/2015 11:41'!
assertSelectedCompiledMethod
	| aText |
	self 
		assert: nautilus selectedPackage package 
			equals: compiledMethod package;
		assert: nautilus selectedPackage item categoryName 
			equals: compiledMethod methodClass category;
		assert: nautilus selectedClass
			equals: compiledMethod methodClass;
		assert: nautilus selectedCategory 
			equals: expectedMethodCategory;
		assert: nautilus selectedMethod 
			equals: expectedCompiledMethod;
		assert: nautilus ui packageWidget selectedPackage package 
			equals: compiledMethod package;
		assert: nautilus ui packageWidget selectedPackage item categoryName 
			equals: compiledMethod methodClass category;
		assert: nautilus ui classWidget selectedClass 
			equals: compiledMethod methodClass;
		assert: nautilus ui methodWidget selectedMethods asArray 
			equals: ((Array with: expectedCompiledMethod) copyWithout: nil).

	aText := nautilus ui sourceCodeContainer submorphs first submorphs first submorphs first getText.
	nautilus selectedMethod 
		ifNotNil: [ self assert: aText equals: compiledMethod sourceCode ].
		
	self assertPackageWidget.
	self assertMethodWidget.! !

!PackageTreeNautilusTest methodsFor: 'asserting' stamp: 'NicolaiHess 3/20/2015 08:40'!
assertMethodWidget
	| index item |
	"test result changed because nautilus behavior has changed.
	issue 14890 (nhe)"
	self assert: nautilus ui methodWidget methodsList listMorph submorphs notEmpty.
	index := nautilus ui methodWidget methodsList listMorph selectedRow.
	nautilus selectedMethod ifNotNil: [ 
		self assert: index notNil.
		item := nautilus ui methodWidget methodsList listMorph item: index.
		self assert: item originalObject equals: compiledMethod ].
! !

!PackageTreeNautilusTest methodsFor: 'tests' stamp: 'JurajKubelka 2/4/2015 08:10'!
testOpenLastValueIsNil
	lastValue := SharedPackageFilterPatternsHolder instance lastValue.
	SharedPackageFilterPatternsHolder instance lastValue: nil.
	nautilus := PackageTreeNautilus open.
	nautilus packagePatternString: 'H'.
	nautilus packagePatternString: 'anything long'.
	nautilus packagePatternString: ''.
! !

!PackageTreeNautilusUI commentStamp: '<historical>'!
I'm the UI representation of Nautilus with Package tree. 
I redefine the category column to add a tree who can manage groups, packages and tags.

I try to redefine just the basic, and for that reason there are some concepts that changed for bad (they are now less understandable). 
#selectedPackage now answers not a package but a "selection", and instance of a child of PackageTreeSelection who can be: 
- a package, like before 
- a package tag 
- a group

!
!PackageTreeNautilusUI methodsFor: 'private' stamp: 'NicolaiHess 7/27/2014 13:33'!
listClearSelection
	self packageWidget deselectAll.! !

!PackageTreeNautilusUI methodsFor: 'package filter' stamp: 'JurajKubelka 12/17/2014 20:56'!
useLastPackagePatternString
	self packagePatternString: SharedPackageFilterPatternsHolder instance lastValue! !

!PackageTreeNautilusUI methodsFor: 'package' stamp: 'EstebanLorenzano 2/21/2014 13:07'!
addPackageBasedOn: aPackage
	[ ^ super addPackageBasedOn: aPackage ]
	on: RPackageConflictError 
	do: [ :e | UIManager default inform: e messageText, '. You need to use promote/demote options instead.' ].
	
	^ nil! !

!PackageTreeNautilusUI methodsFor: 'private dispatch' stamp: 'EstebanLorenzano 11/19/2013 19:32'!
renamePackageCategory: package
	self basicRenamePackage: package! !

!PackageTreeNautilusUI methodsFor: 'accessing' stamp: 'NicolaiHess 8/9/2014 20:57'!
selectedFromPackageGroupView: aNode
	| selections |

	selections := aNode selectedNodes collect: [ :each |each asNautilusSelection].
	"leave if selection contains no node that isn't already selected"
	(selections allSatisfy:[:each | self isSelectedPackage:each]) ifTrue:[^ self].
	
	self clearPackageSelections.

	selections do:[: each |  self selectedPackageWithoutChangingSelection: each].
	
	self changed: #currentHistoryIndex.
! !

!PackageTreeNautilusUI methodsFor: 'package' stamp: 'EstebanLorenzano 10/10/2013 13:19'!
addPackagesAsGroup: aCollection
	| group |
	
	aCollection isEmptyOrNil ifTrue: [ ^ nil ].
	
	group := super addPackagesAsGroup: aCollection.
	self updatePackageView.
	^ group! !

!PackageTreeNautilusUI methodsFor: 'initialization' stamp: 'NicolaiHess 7/27/2014 00:30'!
initialize

	super initialize.

	packagePattern := nil.
	searchWidget := nil.
	packageWidget := PackageTreeWidget model: self.! !

!PackageTreeNautilusUI methodsFor: 'class' stamp: 'EstebanLorenzano 12/12/2013 21:37'!
addTraitIn: aPackage
	super addTraitIn: aPackage asNautilusSelection item.! !

!PackageTreeNautilusUI methodsFor: 'package filter' stamp: 'JurajKubelka 11/15/2013 16:41'!
ensureSafePackagePattern: aPattern
	^ [ aPattern asRegexIgnoringCase ]
		on: RegexSyntaxError
		do: [ :ex | self fixPackagePattern: aPattern ex: ex ]! !

!PackageTreeNautilusUI methodsFor: 'private' stamp: 'NicolaiHess 7/27/2014 13:51'!
updatePackageView 
	self packageWidget updatePackageView! !

!PackageTreeNautilusUI methodsFor: 'package filter' stamp: 'JurajKubelka 12/26/2013 14:54'!
packagePatternString: aStringOrNil
	
	aStringOrNil ifNil: [ ^ self ].
	searchWidget content: aStringOrNil! !

!PackageTreeNautilusUI methodsFor: 'package filter' stamp: 'JurajKubelka 12/17/2014 20:56'!
useLastPackagePatternStringForClass: aClass
	| patternString |
	patternString := SharedPackageFilterPatternsHolder instance lastValue.
	patternString ifNil: [ ^ self ].
	(self class: aClass matchPackagePatternString: patternString)
		ifFalse: [ patternString := patternString, '|', aClass package name ].
	self packagePatternString: patternString.! !

!PackageTreeNautilusUI methodsFor: 'accessing' stamp: 'NicolaiHess 8/2/2014 21:54'!
selectedPackageWithoutChangingSelection: aSelection
	| class |
	
	self okToChange ifFalse: [ ^ self ].
	
	class := self selectedClass.
	(class notNil and: [ 
		aSelection isNil or: [ (aSelection includesClass: class) not ] ])
		ifTrue: [ self selectedClass: nil ].
	
	aSelection ifNotNil: [ 
		aSelection registerSelectionTarget: self ].
	
	self updateClassView.
	self updateCategoryAndMethodList.	
	self changed: #getComments.
	self changed: #sourceCodeFrom:.! !

!PackageTreeNautilusUI methodsFor: 'package' stamp: 'NicolaiHess 2/2/2014 20:39'!
alertCategoryName: tagName exitstsAlreadyIn: package
	| errorMessage |
	errorMessage := String
		streamContents: [ :stream | stream << 'Category named ' << tagName << ' already exists in package ' << package name ].
	UIManager default inform: errorMessage! !

!PackageTreeNautilusUI methodsFor: 'private' stamp: 'NicolaiHess 7/27/2014 00:40'!
listSelectItem: anObject 
	| selection |
	
	selection := anObject asNautilusSelection.
	self packageWidget  
		expandAllFromNode: selection nodePath first;
		selectItems: { selection item }.
	self packageWidget scrollSelectionIntoView.! !

!PackageTreeNautilusUI methodsFor: 'accessing' stamp: 'NicolaiHess 1/19/2014 12:09'!
groupsAreVisible
^ self showGroups or:[ PackageTreeNautilus showGroupsOnTop]! !

!PackageTreeNautilusUI methodsFor: 'private' stamp: 'NicolaiHess 8/2/2014 21:53'!
updatePackageGroupAndClassList
	| selectedPackage selectedClass |
	
	
	selectedPackage := self selectedPackage.
	selectedClass := self selectedClass.
	super updatePackageGroupAndClassList.
	"I need to restore selection (otherwise, nothing goes to the right position)"
	self packageWidget updateList.
	self selectedPackage: selectedPackage.
	self selectedClass: selectedClass.! !

!PackageTreeNautilusUI methodsFor: 'events handling' stamp: 'NicolaiHess 7/26/2014 00:51'!
keyPressedOnTree: anEvent target: aMorph 
	(anEvent keyCharacter == self class nextFocusKey
		and: [ (aMorph canExpand not or: [ aMorph isExpanded ]) ]) 
		ifTrue: [  
			self giveFocusTo: self classWidget.
			^ true ].
	
		^ false
! !

!PackageTreeNautilusUI methodsFor: 'menus behavior' stamp: 'EstebanLorenzano 11/27/2013 14:29'!
restrictedBrowsePackages: selections
	^ super restrictedBrowsePackages: (selections collect: [ :each | each asNautilusSelection item ])! !

!PackageTreeNautilusUI methodsFor: 'menus behavior' stamp: 'EstebanLorenzano 10/15/2013 18:24'!
addClassCategory 
	| package |

	package := self addClassCategoryBasedOn: self selectedPackage.
	package ifNotNil: [
		self selectedPackage: package.
		self updatePackageView ]! !

!PackageTreeNautilusUI methodsFor: 'private' stamp: 'NicolaiHess 8/9/2014 22:05'!
clearPackageSelections
	self resetPackageGroupsList.
	self resetClassesList.
	self resetPackageGroupsListSelection.
! !

!PackageTreeNautilusUI methodsFor: 'build ui lists' stamp: 'NicolaiHess 7/31/2014 09:58'!
buildFirstColumn: aWindow
	| buttons |

	buttons := PanelMorph new.

	self setShortcuts: #NautilusPackageShortcuts to: buttons.
		
	buttons 
		changeProportionalLayout;
		addMorph: self buildGroupsButton 
			fullFrame: ((0@0 corner: 0.5@1) asLayoutFrame 
				rightOffset: -2);
		addMorph: self buildHierarchyButton
			fullFrame: ((0.5@0 corner: 1@1) asLayoutFrame
				topLeftOffset: 2@0);
		hResizing: #spaceFill;
		vResizing: #spaceFill.
		
	^ PanelMorph new
		changeProportionalLayout;
		addMorph: self buildPackageWidget 
			fullFrame: (LayoutFrame identity
				topOffset: 30;
				bottomOffset: -30);
		addMorph: self buildPackageSearch 
			fullFrame: (LayoutFrame identity
				bottomFraction: 0;
				bottomOffset: 25;
				leftOffset: -1;
				rightOffset: 1);
		addMorph: buttons 
			fullFrame: ((0@1 corner: 1@1) asLayoutFrame 
				topOffset: -25;
				bottomOffset: -1);
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		yourself.! !

!PackageTreeNautilusUI methodsFor: 'system announcements' stamp: 'EstebanLorenzano 10/14/2013 16:48'!
classAdded: anAnnouncement 
	| class |
	
	window ifNil: [ ^ self ].
	window isDisplayed ifFalse: [ ^ self ].
	
	class := anAnnouncement classAdded.
	((self parentOfClass: class) nodePath 
		anySatisfy: [ :node | node item = class package ]) 
		ifTrue: [ 
			self updateClassView.
			self removeFromPackagesIconsCache: class package ]
			! !

!PackageTreeNautilusUI methodsFor: 'accessing' stamp: 'NicolaiHess 3/21/2015 00:10'!
showGroups: aBoolean
	self okToChange ifFalse: [ ^ self ].
	self showGroups = aBoolean ifTrue: [ ^ self ].
	self model showHierarchy ifTrue: [ ^ self ].
	self model selectedPackage: nil.
	self clearPackageSelections.
	self listClearSelection.
	self model showGroups: aBoolean.
	self updatePackageView.
	self updateClassView.
	self changed: #groupsButtonLabel.
	! !

!PackageTreeNautilusUI methodsFor: 'source code area' stamp: 'MarcusDenker 1/7/2015 16:42'!
defaultClassDescriptor
	| string |
	
	string := Slot showSlotClassDefinition 
		ifTrue: [  
'Object subclass: #NameOfSubclass
	slots: {}
	classVariables: {}
	category: ''']
		ifFalse: [
'Object subclass: #NameOfSubclass
	instanceVariableNames: ''''
	classVariableNames: ''''
	category: ''' ].
	
	^ self selectedPackage
		ifNotNil: [ :package | string, package categoryName, '''' ]
		ifNil: [ string, '''' ]
		! !

!PackageTreeNautilusUI methodsFor: 'private dispatch' stamp: 'EstebanLorenzano 12/18/2013 17:08'!
removeClassCategory: packageTag 
	self basicRemoveClasses: packageTag classes.
	packageTag asNautilusSelection item removeFromPackage.! !

!PackageTreeNautilusUI methodsFor: 'private dispatch' stamp: 'NicolaiHess 2/2/2014 20:36'!
renameClassCategory: packageTag
	| newName oldName |

	oldName := packageTag name.
	newName := UIManager default 
		request: ('New name of category {1}' format: { packageTag name }) 
		initialAnswer: oldName
		title: 'Rename a category'.
	newName = oldName ifTrue: [ ^ self ].
	
	(self isValidPackageName: newName)
		ifFalse: [ ^ self alertInvalidPackageName:newName ].		
	(self category:newName existsIn:packageTag package)
		ifTrue:[ ^  self alertCategoryName:newName exitstsAlreadyIn:packageTag package].
	packageTag renameTo: newName.

! !

!PackageTreeNautilusUI methodsFor: 'menu pragmas' stamp: 'EstebanLorenzano 10/15/2013 18:37'!
packageFixPragma
	^ 'nautilusGlobalPackageTreeFixMenu'! !

!PackageTreeNautilusUI methodsFor: 'events handling' stamp: 'NicolaiHess 7/27/2014 00:15'!
keyPressedOnList: anEvent shifted: aBoolean
	(anEvent keyCharacter == self class nextFocusKey
		and: [ (self packageWidget canExpand not or: [ self packageWidget isExpanded ]) ]) 
		ifTrue: [  
			self giveFocusTo: self classWidget.
			^ true ].
	
		^ false
! !

!PackageTreeNautilusUI methodsFor: 'class' stamp: 'EstebanLorenzano 12/12/2013 21:37'!
addClassIn: aPackage
	super addClassIn: aPackage asNautilusSelection item.! !

!PackageTreeNautilusUI methodsFor: 'accessing' stamp: 'NicolaiHess 8/9/2014 22:05'!
selectedPackage: aPackage
	" Force package selection, not used by the lists "
	
	self okToChange ifFalse: [ ^ self ].

	acceptor := ClassDefinitionAcceptor model: self.
			
	self resetPackageGroupsListSelection.
	self packageWidget selectPackage: aPackage.
		
	aPackage 
		ifNotNil: [ 
			self basicSelectPackage: aPackage ]
		ifNil: [
			self selectedPackageWithoutChangingSelection: nil.
			self listClearSelection ].	
		
	! !

!PackageTreeNautilusUI methodsFor: 'private' stamp: 'EstebanLorenzano 2/21/2014 13:07'!
addClassCategoryBasedOn: aSelection
	| name package packageTag |

	packageTag := nil.
	package := aSelection package.
	name := UIManager default 
		request: ('New category: {1}-' format: { package name }) 
		initialAnswer: '' 
		title: 'Create a new category'.
	
	[ (self isValidPackageName: name)
		ifTrue: [ packageTag := package addClassTag: name ]
		ifFalse: [ self alertInvalidPackageName: name ] ]
	on: RPackageConflictError 
	do: [ :e | UIManager default inform: e messageText, '. You need to use promote/demote options instead.' ].
	
	^ packageTag! !

!PackageTreeNautilusUI methodsFor: 'private dispatch' stamp: 'NicolaiHess 9/7/2014 19:11'!
fullBrowseFromTag: aPackageTag
	
	self model class 
		openOnPackage: aPackageTag asNautilusSelection
		class: self selectedClass
		category: self selectedCategory
		method: self selectedMethod
		group: self selectedGroup
		showGroups: self showGroups
		sortHierarchically: self sortHierarchically
		showHierarchy: self showHierarchy
		showComment: self showComment 
		showInstance: self showInstance 
		showCategories: true
! !

!PackageTreeNautilusUI methodsFor: 'package filter' stamp: 'JurajKubelka 2/3/2015 15:34'!
packageSearchUpdate: aPatternString
	packagePatternString = aPatternString ifTrue: [ ^ self ].
	packagePatternString := aPatternString.
	packagePattern := self createPackagePattern: aPatternString.
	SharedPackageFilterPatternsHolder instance lastValue: aPatternString.
	self updatePackages! !

!PackageTreeNautilusUI methodsFor: 'package filter' stamp: 'JurajKubelka 12/17/2014 13:19'!
class: aClass matchPackagePatternString: aString 
	| pattern |
	pattern := self createPackagePattern: aString.
	^ self package: aClass package matchPackagePattern: pattern! !

!PackageTreeNautilusUI methodsFor: 'private dispatch' stamp: 'NicolaiHess 9/7/2014 19:11'!
fullBrowseFromPackage: aPackage 
	
	self model class 
		openOnPackage: aPackage
		class: self selectedClass
		category: self selectedCategory
		method: self selectedMethod
		group: self selectedGroup
		showGroups: self showGroups
		sortHierarchically: self sortHierarchically
		showHierarchy: self showHierarchy
		showComment: self showComment 
		showInstance: self showInstance 
		showCategories: true
! !

!PackageTreeNautilusUI methodsFor: 'package' stamp: 'EstebanLorenzano 12/11/2013 16:52'!
fileOutPackages: aCollection
	self 
		do: [ :package | package asNautilusSelection item fileOut ]
		on: aCollection
		displaying: 'Filing out packages...'.! !

!PackageTreeNautilusUI methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/3/2013 16:57'!
groups
	^ self model groupsManager groups.! !

!PackageTreeNautilusUI methodsFor: 'package filter' stamp: 'JurajKubelka 12/26/2013 14:20'!
packagePatternString
	
	^ searchWidget searchString! !

!PackageTreeNautilusUI methodsFor: 'package filter' stamp: 'JurajKubelka 12/17/2014 20:56'!
buildPackageSearch
	"It is an search dialog which filters package list"
	| textMorph |
	
	searchWidget := SearchMorph new
		model: self;
		updateSelector: #packageSearchUpdate:;
		ghostText: 'Type: Pkg1|^Pkg2|Pk.*Core$';
		list: SharedPackageFilterPatternsHolder instance;
		useSelectionIndex: false;
		setIndexSelector: #packageSearchUpdate:;
		yourself.
		
	searchWidget contentMorph autoAccept: true.
	textMorph := searchWidget contentMorph textMorph.	
	self setShortcuts: #NautilusGlobalShortcuts to: textMorph.
	textMorph bindKeyCombination: Character tab asKeyCombination toAction: [ textMorph navigateFocusForward ].
	
	
	^ searchWidget! !

!PackageTreeNautilusUI methodsFor: 'package filter' stamp: 'JurajKubelka 11/15/2013 16:51'!
fixPackagePattern: aPattern ex: anException
	| fixedPattern |
	fixedPattern := aPattern copyReplaceAll: '*' with: '.*' .

	^  [ fixedPattern asRegexIgnoringCase ]
		on: RegexSyntaxError
		do: [ :ex | '.*' asRegexIgnoringCase ]! !

!PackageTreeNautilusUI methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/2/2013 19:09'!
packages 
	^ self model packages! !

!PackageTreeNautilusUI methodsFor: 'private' stamp: 'EstebanLorenzano 1/3/2014 09:55'!
basicRenamePackage: aPackage 

	| newName |
	newName := UIManager default 
		request: 'New name of the package' 
		initialAnswer: aPackage name 
		title: 'Rename a package'.
	newName = aPackage name ifTrue: [ ^ self ].
	
	(self isValidPackageName: newName)
		ifTrue: [ aPackage renameTo: newName ]
		ifFalse: [ self alertInvalidPackageName:newName ].! !

!PackageTreeNautilusUI methodsFor: 'test creation' stamp: 'EstebanLorenzano 12/12/2013 18:09'!
buildTestPackageNameFrom:aClass
	^ aClass package categoryName asString, '-Tests' ! !

!PackageTreeNautilusUI methodsFor: 'menus behavior' stamp: 'JurajKubelka 2/4/2015 08:05'!
fullBrowse
	
	^ super fullBrowse
			packagePatternString: self packagePatternString;
			yourself! !

!PackageTreeNautilusUI methodsFor: 'accessing' stamp: 'EstebanLorenzano 11/29/2013 16:09'!
selectedProtocol
	^ self selectedCategory 
		ifNotNil: [ :protocolName | self selectedClass organization protocolNamed: protocolName ]! !

!PackageTreeNautilusUI methodsFor: 'private' stamp: 'NicolaiHess 1/2/2014 20:42'!
isSelectedPackage: aSelection 
         aSelection 
      ifNil:[^ self selectedPackage isNil]
	ifNotNil:[^ aSelection asNautilusSelection = self selectedPackage ]	! !

!PackageTreeNautilusUI methodsFor: 'private' stamp: 'NicolaiHess 8/12/2014 20:26'!
selectPackageFor: aClass
	"I'm called to properly select a class pache/tag.
	 Since we are showing root tags as packages when their are the only ones, we need to determine 
	 if we are going to select the package or the tag..."

	self model showGroups
		ifTrue: [ self selectedPackage: self packageWidget selectedGroup ]
		ifFalse: [ 
			| package tag |
			package := aClass package.
			tag := package classTagForClass: aClass.
			self
				selectedPackage:
					((tag isRoot and: [ package classTags size = 1 ])
						ifTrue: [ tag package ]
						ifFalse: [ tag ]) ]! !

!PackageTreeNautilusUI methodsFor: 'private dispatch' stamp: 'NicolaiHess 7/27/2014 13:27'!
registerSelectionPackage: aSelection

	self model 	
		package: aSelection
		class: self selectedClass 
		category: nil 
		method: nil.
		
	self packageWidget selectPackage: aSelection item.! !

!PackageTreeNautilusUI methodsFor: 'private dispatch' stamp: 'EstebanLorenzano 2/21/2014 12:33'!
removePackageCategory: package
	self basicRemoveClasses: package definedClasses.
	self browsedEnvironment packageOrganizer unregisterPackage: package	asNautilusSelection item ! !

!PackageTreeNautilusUI methodsFor: 'private' stamp: 'EstebanLorenzano 10/16/2013 15:02'!
renamePackage: aSelection
	aSelection asNautilusSelection renameTarget: self. 
! !

!PackageTreeNautilusUI methodsFor: 'menus behavior' stamp: 'TommasoDalSasso 12/20/2013 12:30'!
removePackages
	| names packages |
	
	packages := self selectedPackages. 
	packages ifEmpty: [ ^ self ].
	
	names := (packages 
		collect: [:package | package name ])
		joinUsing: String cr.

	(UIManager default 
		confirm: ('Are you sure you want to delete the selection(s) named ', String cr, names, ' and their classes ?'))
		ifTrue: [ packages do: [ :each | each asNautilusSelection removeTarget: self ].
			self updatePackageView ]! !

!PackageTreeNautilusUI methodsFor: 'accessing' stamp: 'NicolaiHess 7/27/2014 00:15'!
basicSelectPackage: aPackage
	| selection |
			
	selection := aPackage asNautilusSelection.
	self giveFocusTo: self packageWidget.
	self selectedPackageWithoutChangingSelection: selection.
	self listSelectItem: selection.! !

!PackageTreeNautilusUI methodsFor: 'menus' stamp: 'EstebanLorenzano 10/9/2013 12:57'!
menu: aMenu shifted: aBoolean 
	self selectedPackage ifNil: [ ^ aMenu ].

	^ self selectedPackage 
		menu: aMenu 
		shifted: aBoolean
		target: self! !

!PackageTreeNautilusUI methodsFor: 'accessing' stamp: 'NicolaiHess 1/23/2015 21:48'!
showHierarchy: aBoolean
	self okToChange ifFalse: [ ^ nil ].

	self packageWidget enabled: aBoolean not.
	aBoolean ifTrue: [ self basicShowHierarchy ].
		
	self resetPackageGroupsList.
	self resetClassesList.
	
	self classWidget showHierarchy: aBoolean.
	"If showPackages false(Hierarchy)-->true(Flat) then selected package needs to synch to that of selected class"
	((aBoolean not and: [ self model showHierarchy]) and: [self selectedClass notNil]) 
		ifTrue: [
			self selectPackageFor: self selectedClass ].
	self model showHierarchy: aBoolean.

	self changed: #groupsButtonLabel.
	self updateClassView.
	self changed: #hierarchyButtonState.
	self changed: #hierarchyButtonLabel.
	self changedLabels.! !

!PackageTreeNautilusUI methodsFor: 'private' stamp: 'EstebanLorenzano 10/9/2013 17:40'!
updateGroupView 
	self updatePackageView! !

!PackageTreeNautilusUI methodsFor: 'package filter' stamp: 'JurajKubelka 2/4/2015 12:18'!
updatePackages
	| package |
	package := self selectedPackage.
	package 
		ifNotNil: [ 
			self packageWidget 
					updateContentsWithPreviouslyExpanded: package item asNautilusItemPath;
					scrollSelectionIntoView ]
		ifNil: [ self packageWidget updateContentsWithPreviouslyExpanded: #() ]! !

!PackageTreeNautilusUI methodsFor: 'package' stamp: 'NicolaiHess 2/2/2014 20:36'!
category: aClassTag existsIn: aPackage
	aPackage classTagNamed: aClassTag ifPresent:[^ true].
	^ false.! !

!PackageTreeNautilusUI methodsFor: 'private' stamp: 'vincentBlondeau 12/12/2014 13:59'!
runPackagesTestsNotifying: aBoolean
	| packages classes label |

	(packages := self selectedPackages) ifNil: [ ^ self ].
	label := 
	packages size > 1
		ifTrue: [ 'Packages: ' ]
		ifFalse: [ 'Package: ' ].
		
	classes := packages gather: [ :package | package asNautilusSelection definedClasses ].
	classes := classes select: [ :class | class isTestCase ].
	
	self runClassTests: classes notifying: false.

	aBoolean ifTrue: [ 
		| color |
		color := Color gray.
		(classes anySatisfy:[:e  | e hasPassedTest ]) ifTrue: [ color := Color green ].
		(classes anySatisfy:[:e  | e hasFailedTest ]) ifTrue: [ color := Color yellow ].
		(classes anySatisfy:[:e  | e hasErrorTest ]) ifTrue: [ color := Color red ].
		self 
			notifyTitle: 'Test Finished'
			contents: label , ((packages collect: #name) joinUsing: ', ')
			color: color ].! !

!PackageTreeNautilusUI methodsFor: 'package filter' stamp: 'JurajKubelka 12/17/2014 13:18'!
createPackagePattern: aPatternString
	^ (aPatternString isNil or: [ aPatternString trimBoth isEmpty ])
		ifTrue: [ nil ]
		ifFalse: [ self ensureSafePackagePattern: aPatternString ]! !

!PackageTreeNautilusUI methodsFor: 'package filter' stamp: 'JurajKubelka 12/17/2014 13:15'!
package: aRPackage matchPackagePattern: aPattern 
	^ aPattern
		ifNil: [ true ]
		ifNotNil: [ :pattern | pattern search: aRPackage name ]! !

!PackageTreeNautilusUI methodsFor: 'package filter' stamp: 'JurajKubelka 12/17/2014 13:16'!
packageMatchPattern: aRPackage 
	^ self package: aRPackage matchPackagePattern: self packagePattern! !

!PackageTreeNautilusUI methodsFor: 'private' stamp: 'EstebanLorenzano 10/16/2013 17:01'!
basicRemoveClasses: aCollection 
		aCollection do: #removeFromSystem.! !

!PackageTreeNautilusUI methodsFor: 'private dispatch' stamp: 'NicolaiHess 7/27/2014 20:59'!
registerSelectionGroup: aSelection
	self model selectedGroup: aSelection item.
	
	self flag: #todo. "I need to refactor to remove the need of groups"
	"I select also group-as-a-package, because I will be filtering with package selection, 
	 not with group selection (which actually does not has much sense now)"
	self model 	
		package: aSelection
		class: self selectedClass 
		category: nil 
		method: nil.
	
	self packageWidget selectGroup: aSelection item.
! !

!PackageTreeNautilusUI methodsFor: 'menus behavior' stamp: 'EstebanLorenzano 10/10/2013 13:34'!
removeGroups
	self okToChange ifFalse: [ ^ self ].
	
	super removeGroups.
	self updatePackageView.! !

!PackageTreeNautilusUI methodsFor: 'package filter' stamp: 'JurajKubelka 12/17/2014 12:51'!
packagePattern
	^ packagePattern! !

!PackageTreeNautilusUI methodsFor: 'menus behavior' stamp: 'EstebanLorenzano 11/29/2013 16:11'!
renameCategory
	| protocol |

	protocol  := self selectedProtocol. 
	protocol ifNil: [ ^ self ].
	
	protocol canBeRenamed 
		ifFalse: [ ^ self inform: ('You can not rename "{1}" protocol.' format: { protocol name })  ].
	
	^ super renameCategory.! !

!PackageTreeNautilusUI methodsFor: 'accessing' stamp: 'NicolaiHess 8/9/2014 22:05'!
selectedGroup: aGroup
	" Force package selection, not used by the lists "

	self okToChange ifFalse: [ ^ self ].
			
	acceptor := ClassDefinitionAcceptor model: self.
			
	self resetPackageGroupsListSelection.
	self packageWidget selectGroup: aGroup.
		
	aGroup 
		ifNotNil: [ 
			self basicSelectPackage: aGroup ]
		ifNil: [
			self selectedPackageWithoutChangingSelection: nil. 
			self listClearSelection ].	
		

	! !

!PackageTreeNautilusUI methodsFor: 'private' stamp: 'NicolaiHess 8/9/2014 21:28'!
basicShowHierarchy
	"Prepares the class panel to show hierarchies"
	self resetClassesListSelection.
	self classWidget selectClass: self selectedClass.
	self resetPackageGroupsList.
	self resetClassesList.	! !

!PackageTreeNautilusUI class methodsFor: 'menu' stamp: 'EstebanLorenzano 2/19/2014 16:44'!
packagesFixMenu: aBuilder
	<contextMenu>
	<nautilusGlobalPackageTreeFixMenu>
	
	| target |
	
	target := aBuilder model.
	
	(aBuilder item: #'Find Class...')
		keyText: 'f, c' if: Nautilus useOldStyleKeys not;
		keyText: 'f' if: Nautilus useOldStyleKeys;
		action: [target findClass];
		order: 0;
		help: 'Search for a class by name'.
		
	(aBuilder item: #'Find Package...')
		keyText: 'f, p' if: Nautilus useOldStyleKeys not;
		keyText: 'F' if: Nautilus useOldStyleKeys;
		action: [ target findPackage ];
		order: 100;
		help: 'Search for a package by name';
		withSeparatorAfter.
		
	(aBuilder item: #'Add package...')
		keyText: 'n, p' if: Nautilus useOldStyleKeys not;
		keyText: 'n' if: Nautilus useOldStyleKeys;
		action: [target addPackage];
		order: 200;
		help: 'Add a package'.
		
	(aBuilder item: #'Add tag...')
		action: [ target addClassCategory ];
		order: 210;
		help: 'Add a tag/category in package';
		withSeparatorAfter.
		
	(aBuilder item: #'Browse full')
		keyText: 'b, f' if: Nautilus useOldStyleKeys not;
		keyText: 'b' if: Nautilus useOldStyleKeys;
		action: [target fullBrowse];
		order: 999;
		help: 'Open the same browser'.! !

!PackageTreeNodeModel commentStamp: '<historical>'!
I'm a generic model for package tree nodes. !
!PackageTreeNodeModel methodsFor: 'comparing' stamp: 'EstebanLorenzano 10/14/2013 15:02'!
hash
	^ self class hash bitXor: self item hash! !

!PackageTreeNodeModel methodsFor: 'comparing' stamp: 'NicolaiHess 7/28/2014 22:22'!
= aNode 
	^ (self class = aNode class) and:[ self item = aNode item]! !

!PackageTreeNodeModel methodsFor: 'converting' stamp: 'EstebanLorenzano 10/10/2013 16:46'!
asNautilusSelection
	"Answers a pair RPackage->Tag to express the correct selection"
	^ self subclassResponsibility! !

!PackageTreeNodeModel methodsFor: 'converting' stamp: 'EstebanLorenzano 11/26/2013 12:51'!
asString
	^ self item name! !

!PackageTreePackageNodeModel commentStamp: '<historical>'!
I'm a package node model.!
!PackageTreePackageNodeModel methodsFor: 'accessing' stamp: 'EstebanLorenzano 12/13/2013 15:40'!
childrenItems
	| tags |

	tags := self item classTags.
	"If there is just one, do not show"
	^ (tags size = 1 and: [ tags anyOne name = self item name ])
		ifTrue: [ #() ]
		ifFalse: [ tags sorted: [ :a :b | a categoryName < b categoryName ] ]! !

!PackageTreePackageNodeModel methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/2/2013 19:06'!
rowMorphForColumn: aTreeColumn
	^ self item name asMorph! !

!PackageTreePackageNodeModel methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/2/2013 19:22'!
icon 
	^ self model packageIconFor: self item.! !

!PackageTreePackageNodeModel methodsFor: 'converting' stamp: 'EstebanLorenzano 10/10/2013 16:46'!
asNautilusSelection 
	^ PackageTreePackageSelection package: self item 
		! !

!PackageTreePackageNodeModel methodsFor: 'accessing' stamp: 'GuillermoPolito 11/7/2013 15:56'!
helpText
	^ self model helpTextFor: self item.! !

!PackageTreePackageNodeModel methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/2/2013 19:29'!
childNodeClassFromItem: anItem 
	^ PackageTreeTagNodeModel! !

!PackageTreePackageSelection commentStamp: '<historical>'!
I'm a package selection.!
!PackageTreePackageSelection methodsFor: 'testing' stamp: 'EstebanLorenzano 10/14/2013 13:22'!
includesClass: aClass 
	^ self item includesClass: aClass! !

!PackageTreePackageSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 11/27/2013 11:33'!
classTags 
	^ self item classTags! !

!PackageTreePackageSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/9/2013 12:56'!
menu: aMenu shifted: aBoolean target: aTarget
	^ aTarget packagesMenu: aMenu shifted: aBoolean! !

!PackageTreePackageSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/16/2013 15:01'!
renameTarget: target   
	target renamePackageCategory: self item.! !

!PackageTreePackageSelection methodsFor: 'testing' stamp: 'NicolasPetton 2/14/2014 15:23'!
includesCategory: aSymbol
	^ self package name == aSymbol! !

!PackageTreePackageSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/14/2013 13:18'!
definedClasses 
	^ self item definedClasses! !

!PackageTreePackageSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/14/2013 13:18'!
extendedClasses
	^ self item extendedClasses! !

!PackageTreePackageSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 12/12/2013 18:12'!
categoryName 
	^ self item categoryName! !

!PackageTreePackageSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/14/2013 13:18'!
classes 
	^ self item classes! !

!PackageTreePackageSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/9/2013 17:36'!
registerSelectionTarget: aTarget 
	aTarget registerSelectionPackage: self.! !

!PackageTreePackageSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/14/2013 13:18'!
extensionClasses
	^ self item extensionClasses! !

!PackageTreePackageSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/14/2013 16:06'!
package 
	^ self item! !

!PackageTreePackageSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/16/2013 16:48'!
removeTarget: target 
	target removePackageCategory: self.! !

!PackageTreePackageSelection class methodsFor: 'instance creation' stamp: 'EstebanLorenzano 10/14/2013 13:21'!
package: aPackage 
	^ self node: (PackageTreePackageNodeModel with: aPackage)! !

!PackageTreeSelection commentStamp: '<historical>'!
I'm a base selection of an item from package tree. 
!
!PackageTreeSelection methodsFor: 'testing' stamp: 'EstebanLorenzano 10/3/2013 14:42'!
includesClass: aClass 
	^ self subclassResponsibility! !

!PackageTreeSelection methodsFor: 'initialization' stamp: 'EstebanLorenzano 10/14/2013 13:13'!
initializeNode: aNode 
	self initialize.
	node := aNode. ! !

!PackageTreeSelection methodsFor: 'comparing' stamp: 'EstebanLorenzano 10/16/2013 13:19'!
hash
	^ self class hash bitXor: self item hash! !

!PackageTreeSelection methodsFor: 'converting' stamp: 'EstebanLorenzano 10/10/2013 16:00'!
asNautilusSelection
	^ self! !

!PackageTreeSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/9/2013 12:56'!
menu: aMenu shifted: aBoolean target: aTarget
	^ self subclassResponsibility! !

!PackageTreeSelection methodsFor: 'testing' stamp: 'EstebanLorenzano 10/3/2013 16:09'!
isGroup 
	^ false! !

!PackageTreeSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/16/2013 15:01'!
renameTarget: target ! !

!PackageTreeSelection methodsFor: 'testing' stamp: 'NicolasPetton 2/14/2014 15:21'!
includesCategory: aSymbol
	^ false! !

!PackageTreeSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/14/2013 13:13'!
node 
	^ node! !

!PackageTreeSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/3/2013 14:17'!
definedClasses
	^ self subclassResponsibility! !

!PackageTreeSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/3/2013 14:21'!
extendedClasses
	^ #()! !

!PackageTreeSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 12/12/2013 18:13'!
categoryName 
	^ self subclassResponsibility! !

!PackageTreeSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/9/2013 12:52'!
registerSelectionTarget: aTarget 
	self subclassResponsibility! !

!PackageTreeSelection methodsFor: 'comparing' stamp: 'NicolaiHess 7/28/2014 22:21'!
= other 
	^ (self class = other class) and:[ self item = other item].
! !

!PackageTreeSelection methodsFor: 'converting' stamp: 'EstebanLorenzano 10/14/2013 14:43'!
nodePath 
	^ self node path! !

!PackageTreeSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/3/2013 15:34'!
extensionClasses
	^ #()! !

!PackageTreeSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/14/2013 13:14'!
item 
	^ self node item.! !

!PackageTreeSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/16/2013 16:47'!
removeTarget: target 
	self subclassResponsibility.! !

!PackageTreeSelection methodsFor: 'testing' stamp: 'GuillermoPolito 2/14/2014 11:06'!
isPackageTag

	^ false! !

!PackageTreeSelection methodsFor: 'converting' stamp: 'MarcusDenker 9/4/2014 17:27'!
withClassesIn: anEnvironment createHierarchySorter: aHierarchyClass 
	| classes defined extensions |
	classes := self definedClasses collect: #theNonMetaClass.
	anEnvironment isSystem
		ifFalse: [ classes := classes intersection: anEnvironment classes ].

	defined := aHierarchyClass buildHierarchyForClasses: classes.
	
	classes := self extensionClasses collect: #theNonMetaClass.
	anEnvironment isSystem
		ifFalse: [ classes := classes intersection: anEnvironment classes ].
	
	extensions := aHierarchyClass buildHierarchyForClasses: classes asSet.

	^ defined, extensions! !

!PackageTreeSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/14/2013 13:23'!
name 
	^ self item name! !

!PackageTreeSelection methodsFor: 'accessing' stamp: 'MarcusDenker 7/16/2014 17:29'!
mcPackage 
	^ self package mcPackage! !

!PackageTreeSelection class methodsFor: 'instance creation' stamp: 'EstebanLorenzano 10/14/2013 13:13'!
node: aNode 
	^ self basicNew 
		initializeNode: aNode;
		yourself! !

!PackageTreeSelection class methodsFor: 'instance creation' stamp: 'EstebanLorenzano 10/14/2013 13:19'!
new 
	self error: 'Use #node:'! !

!PackageTreeTagNodeModel commentStamp: '<historical>'!
I'm a tag node model.!
!PackageTreeTagNodeModel methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/2/2013 19:21'!
icon 
	^ self model tagIconFor: self item! !

!PackageTreeTagNodeModel methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/10/2013 14:37'!
rowMorphForColumn: aTreeColumn
	^ self item name asMorph! !

!PackageTreeTagNodeModel methodsFor: 'converting' stamp: 'EstebanLorenzano 10/14/2013 13:23'!
asNautilusSelection 
	^ PackageTreeTagSelection node: self! !

!PackageTreeTagSelection commentStamp: '<historical>'!
I'm a tag selection.!
!PackageTreeTagSelection methodsFor: 'testing' stamp: 'EstebanLorenzano 10/14/2013 13:16'!
includesClass: aClass 
	^ self item classNames includes: aClass instanceSide name.! !

!PackageTreeTagSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 11/27/2013 11:34'!
classTags 
	^ #()! !

!PackageTreeTagSelection methodsFor: 'testing' stamp: 'GuillermoPolito 2/14/2014 11:05'!
isPackageTag

	^ true! !

!PackageTreeTagSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/16/2013 15:02'!
renameTarget: target 
	target renameClassCategory: self item.! !

!PackageTreeTagSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/3/2013 14:19'!
extensionClasses
	^ #()! !

!PackageTreeTagSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/14/2013 16:07'!
package 
	^ self item package! !

!PackageTreeTagSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/16/2013 16:48'!
removeTarget: target 
	target removeClassCategory: self.! !

!PackageTreeTagSelection methodsFor: 'testing' stamp: 'NicolasPetton 2/14/2014 15:31'!
includesCategory: aSymbol
	^ self categoryName asSymbol == aSymbol! !

!PackageTreeTagSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/14/2013 13:16'!
definedClasses 
	^ self item classes! !

!PackageTreeTagSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/3/2013 14:21'!
extendedClasses
	^ #()! !

!PackageTreeTagSelection methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/3/2013 16:14'!
classes 
	^ self definedClasses! !

!PackageTreeTagSelection class methodsFor: 'instance creation' stamp: 'EstebanLorenzano 10/14/2013 14:56'!
tag: aTag 
	^ self node: ((PackageTreeTagNodeModel with: aTag)
		parentNode: (PackageTreePackageNodeModel with: aTag package);
		yourself)! !

!PackageTreeWidget commentStamp: 'NicolaiHess 7/27/2014 00:53'!
PackageWidget is the basic implementation of a wiget managing packages as tree list!
!PackageTreeWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 00:39'!
updateList
	packagesList model updateList! !

!PackageTreeWidget methodsFor: 'updating' stamp: 'JurajKubelka 2/4/2015 11:19'!
updateContentsWithPreviouslyExpanded: aCollection 
	packagesList updateContentsWithPreviouslyExpanded: aCollection! !

!PackageTreeWidget methodsFor: 'protocol' stamp: 'NicolaiHess 8/9/2014 23:12'!
resetPackageGroupList
	packagesListElements  := nil.! !

!PackageTreeWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 00:40'!
selectItems: aCollection 
	packagesList model selectItems: aCollection ! !

!PackageTreeWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 00:41'!
scrollSelectionIntoView
	packagesList scrollSelectionIntoView! !

!PackageTreeWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 00:40'!
expandAllFromNode: aPackageTreePackageNodeModel 
	packagesList model expandAllFromNode: aPackageTreePackageNodeModel ! !

!PackageTreeWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/30/2014 10:06'!
selectedPackageGroup
	^ self model showGroups
		ifTrue: [ self selectedGroup ]
		ifFalse: [ self selectedPackage ifNil:[self selectedGroup]]! !

!PackageTreeWidget methodsFor: 'item creation' stamp: 'NicolaiHess 8/9/2014 20:57'!
buildPackagesList
		| treeModel |

	treeModel := PackageTreeModel new  
		model: self model ;
		yourself.

	packagesList := (MorphTreeMorph on: treeModel)
		multiSelection: true;
		dropEnabled: true;
		getMenuSelector: #menu:shifted:;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		yourself.
				
	treeModel announcer 
		when: MorphTreeSelectionChanged do: [ :ann | self model selectedFromPackageGroupView: ann selection  ].
				
	packagesList buildContents.
	self model selectedPackage ifNotNil: [ 
		self model listSelectItem: self model selectedPackage ].
	
	^ packagesList.
! !

!PackageWidget commentStamp: 'NicolaiHess 7/27/2014 13:17'!
PackageWidget is the basic implementation of a wiget managing Packages and Groups!
!PackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 13:33'!
deselectAll
	packagesList model deselectAll! !

!PackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 20:57'!
selectedGroups

	| associations |
	associations := groupsSelection associations select: [:assoc | assoc value ].
	associations := associations collect: [:assoc | assoc key ].
	^ associations select: [:each | each notNil ]! !

!PackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 14:06'!
resetPackagesSelection
	packagesSelection removeAll! !

!PackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/30/2014 01:01'!
selectedGroup
	^ self selectedGroups ifEmpty: [ nil ] ifNotEmpty: [ :col | col first ]! !

!PackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 13:21'!
selectPackage: aPackage
	self packagesSelection at: aPackage put: true! !

!PackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 20:56'!
resetGroupsSelection
	groupsSelection removeAll! !

!PackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 13:25'!
selectedPackages
	| associations |
	associations := packagesSelection associations select: [ :assoc | assoc value ].
	associations := associations collect: [ :assoc | assoc key ].
	^ associations select: [ :each | each notNil ]! !

!PackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 13:58'!
setShortcuts: aSymbol
	self model setShortcuts: aSymbol to: packagesList! !

!PackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 20:54'!
selectGroup: aGroup
	groupsSelection at: aGroup put: true! !

!PackageWidget methodsFor: 'initialization' stamp: 'NicolaiHess 7/27/2014 20:53'!
initialize

	super initialize.

	packagesList := nil.
	packagesListElements := nil.
	packagesSelection := Dictionary new.
	groupsSelection := Dictionary new.! !

!PackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 14:15'!
buildContents
	packagesList buildContents! !

!PackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 13:38'!
hasFocus
	^ packagesList hasKeyboardFocus ! !

!PackageWidget methodsFor: 'private' stamp: 'NicolaiHess 7/27/2014 13:35'!
packagesSelection
	^ packagesSelection ! !

!PackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 13:51'!
updatePackageView
	packagesList model changed:#rootNodes! !

!PackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 14:01'!
removeShortcuts: aSymbol
	self model removeShortcuts: aSymbol from: packagesList! !

!PackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/30/2014 12:11'!
selectedPackage

	^ self selectedPackages ifEmpty: [ nil ] ifNotEmpty: [ :col | col first ]! !

!PackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 21:05'!
enabled: aTrue 
	packagesList model enabled: aTrue! !

!PackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/27/2014 13:37'!
takeKeyboardFocus
	packagesList takeKeyboardFocus ! !

!PackageWidget methodsFor: 'protocol' stamp: 'NicolaiHess 7/30/2014 01:01'!
selectedPackageGroup
	^ self model showGroups
		ifTrue: [ self selectedGroup ]
		ifFalse: [ self selectedPackage ]! !

!PackageWidget methodsFor: 'private' stamp: 'JurajKubelka 2/4/2015 11:20'!
packagesList
	^ packagesList ! !

!PaginatedMorphTreeModel commentStamp: 'TorstenBergmann 9/5/2014 15:20'!
A morphic based tree model with pagination!
!PaginatedMorphTreeModel methodsFor: 'accessing' stamp: 'AlainPlantec 10/17/2013 09:38'!
pageSize: anIntegerOrNil
	self setPageSize: anIntegerOrNil.
	self announce: (MorphTreeChangeRequest pageSize: anIntegerOrNil)
! !

!PaginatedMorphTreeModel methodsFor: 'pager managing' stamp: 'AlainPlantec 10/10/2011 11:22'!
pageSize
	^ pageSize
! !

!PaginatedMorphTreeModel methodsFor: 'accessing' stamp: 'AlainPlantec 10/10/2011 11:25'!
rootNodes
	| computedRootNodes |
	computedRootNodes := super rootNodes.
	self defaultChunkSize 
		ifNotNil: [computedRootNodes size > self defaultChunkSize
			ifTrue: [self chunkSize: self defaultChunkSize]]
		ifNil: [
			self defaultPageSize 
				ifNotNil: [computedRootNodes size > self defaultPageSize
					ifTrue: [self pageSize: self defaultPageSize]]].
	^ computedRootNodes
! !

!PaginatedMorphTreeModel methodsFor: 'accessing' stamp: 'AlainPlantec 10/17/2013 09:38'!
chunkSize: anIntegerOrNil
	self setPageSize: anIntegerOrNil.
	self announce: (MorphTreeChangeRequest chunkSize: anIntegerOrNil)
! !

!PaginatedMorphTreeModel methodsFor: 'pager managing' stamp: 'AlainPlantec 10/10/2011 11:22'!
setPageSize: anIntegerOrNil
	pageSize := anIntegerOrNil.
! !

!PaginatedMorphTreeModel methodsFor: 'pager managing' stamp: 'AlainPlantec 10/10/2011 11:22'!
chunkSize
	^ pageSize ! !

!PaginatedMorphTreeModel methodsFor: 'accessing' stamp: 'AlainPlantec 10/10/2011 11:29'!
treeMorphClass
	^ PaginatedMorphTreeMorph ! !

!PaginatedMorphTreeModel class methodsFor: 'examples' stamp: 'TorstenBergmann 9/5/2014 15:21'!
example
	"This test demonstrate a paginating morphTreeMorph in action."

	"self example."

	| treeMorph aWindow aModel |
	aModel := self itemsList: (1 to: 100) asArray.
	aWindow := aModel theme newWindowIn: World for: aModel title: 'Example'.
	treeMorph := aModel defaultTreeMorph.
	treeMorph pageSize: 30.
	treeMorph buildContents.
	aWindow addMorph: treeMorph fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 1) offsets: (0 @ 0 corner: 0 @ 0)).
	aWindow open.
	aModel expandItemPath: {40}.
	self assert: treeMorph pager currentPage == 2! !

!PaginatedMorphTreeMorph commentStamp: 'TorstenBergmann 9/5/2014 15:31'!
A paginated tree morph!
!PaginatedMorphTreeMorph methodsFor: 'pager managing' stamp: 'AlainPlantec 10/10/2011 11:12'!
pagerColor
	^ self color darker alpha: 0.6! !

!PaginatedMorphTreeMorph methodsFor: 'expanding-collapsing' stamp: 'AlainPlantec 10/18/2013 11:02'!
expandItemPath: anItemPath
	| rest |
	rest := anItemPath asOrderedCollection.
	[ rest notEmpty ]
		whileTrue: [ 
			| res |
			res := (1 to: self nodeList size) select: [ :li | (self nodeList at: li) item = rest first ].
			res isEmpty
				ifTrue: [ ^ self ].
			self pager nextPage: res first.
			(self allNodeMorphs at: 1 ifAbsent: [ ^ self ]) openItemPath: {(rest first)}.
			rest := rest copyWithoutFirst ].
	^ self! !

!PaginatedMorphTreeMorph methodsFor: 'geometry' stamp: 'AlainPlantec 10/10/2011 11:08'!
extent: newExtent
	self extent = newExtent ifTrue: [^ self].
	super extent: newExtent.
	self updatePager.
! !

!PaginatedMorphTreeMorph methodsFor: 'accessing colors' stamp: 'AlainPlantec 10/10/2011 10:52'!
adoptPaneColor: paneColor
	"Pass on to the selection, the border and on the eventual pager too."
	
	super adoptPaneColor: paneColor.
	paneColor ifNil: [^self].
	self pager ifNotNil: [:p | p color: self pagerColor]! !

!PaginatedMorphTreeMorph methodsFor: 'pager managing' stamp: 'AlainPlantec 10/10/2011 10:57'!
addNavigationPane: aNavigPane
	pager := aNavigPane.
	self addMorph: pager.
	pager buildPanel.
	self updatePager.
	self changed! !

!PaginatedMorphTreeMorph methodsFor: 'geometry' stamp: 'AlainPlantec 10/10/2011 11:06'!
innerBounds
	| inner |
	inner := super innerBounds.
	inner := inner withBottom: inner bottom - self pagerHeight.
	^ inner! !

!PaginatedMorphTreeMorph methodsFor: 'pager managing' stamp: 'AlainPlantec 10/10/2011 10:55'!
pageSize: aPageSize 
	self pager
		ifNil: [aPageSize ifNotNil: [self addNavigationPane: (MorphTreePager on: self pageSize: aPageSize)]]
		ifNotNil: [aPageSize 
			ifNil: [self removePager]
			ifNotNil: [self pager changePageSize: aPageSize]]! !

!PaginatedMorphTreeMorph methodsFor: 'pager managing' stamp: 'AlainPlantec 10/10/2011 10:58'!
updatePager
	self pager
		ifNotNil: [self pager buildPanel]! !

!PaginatedMorphTreeMorph methodsFor: 'updating' stamp: 'AlainPlantec 10/10/2011 11:08'!
updateContentsWithPreviouslyExpanded: aNodeList
	super updateContentsWithPreviouslyExpanded: aNodeList.
	self updatePager! !

!PaginatedMorphTreeMorph methodsFor: 'pager managing' stamp: 'AlainPlantec 10/10/2011 10:55'!
pagerHeight
	^ self pager
		ifNil: [0]
		ifNotNil: [pager computedHeight]! !

!PaginatedMorphTreeMorph methodsFor: 'accessing' stamp: 'AlainPlantec 10/10/2011 10:54'!
currentNodelist
	"The nodeList currently viewed (not the full node list if a pager is used)"
	^ self pager
		ifNil: [super nodeList]
		ifNotNil: [self pager currentNodelist]! !

!PaginatedMorphTreeMorph methodsFor: 'updating' stamp: 'AlainPlantec 10/10/2011 11:07'!
buildContents
	super buildContents.
	self updatePager! !

!PaginatedMorphTreeMorph methodsFor: 'geometry' stamp: 'AlainPlantec 10/10/2011 11:06'!
vScrollBarHeight
	^ super vScrollBarHeight - self pagerHeight! !

!PaginatedMorphTreeMorph methodsFor: 'pager managing' stamp: 'AlainPlantec 10/10/2011 10:57'!
chunkSize: aPageSize 
	self pager
		ifNil: [aPageSize ifNotNil: [self addNavigationPane: (MorphTreeChunkPager on: self pageSize: aPageSize)]]
		ifNotNil: [aPageSize 
			ifNil: [self removePager]
			ifNotNil: [self pager changePageSize: aPageSize]]! !

!PaginatedMorphTreeMorph methodsFor: 'pager managing' stamp: 'AlainPlantec 10/10/2011 10:55'!
pager
	^ pager
	! !

!PaginatedMorphTreeMorph methodsFor: 'scrolling' stamp: 'AlainPlantec 10/10/2011 10:56'!
vScrollBarValue: scrollValue
	super vScrollBarValue: scrollValue.
	self pager ifNotNil: [:p | p vScrollBarValue: scrollValue]! !

!PaginatedMorphTreeMorph methodsFor: 'geometry' stamp: 'AlainPlantec 10/10/2011 11:05'!
hResizeScrollBar
	super hResizeScrollBar.
	hScrollBar bounds: ((hScrollBar bounds withTop: (hScrollBar top - self pagerHeight)) withBottom: (hScrollBar bottom - self pagerHeight))! !

!PaginatedMorphTreeMorph methodsFor: 'pager managing' stamp: 'AlainPlantec 10/10/2011 10:56'!
removePager
	self pager ifNotNil: [
		self removeMorph: self pager.
		pager := nil.
		self updateList.
		self resizerChanged].
! !

!PaginatedMorphTreeMorphTests methodsFor: 'tests' stamp: 'AlainPlantec 10/18/2013 11:05'!
testPager
	"This test demonstrate a paginating morphTreeMorph in action."

	| treeMorph aWindow aModel |
	aModel := PaginatedMorphTreeModel itemsList: (1 to: 100) asArray.
	aWindow := aModel theme newWindowIn: World for: aModel title: 'test'.
	treeMorph := aModel defaultTreeMorph.
	treeMorph pageSize: 30.
	treeMorph buildContents.
	aWindow addMorph: treeMorph fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 1) offsets: (0 @ 0 corner: 0 @ 0)).
	aWindow open.
	aModel expandItemPath: { 40 }.
	self assert: treeMorph pager currentPage == 2.
	aWindow close! !

!PaneScrolling commentStamp: '<historical>'!
I am an announcement raised when a scroll pane is scrolled.

My two attributes are
	- step: a point representing the scrollbar movement
	- scrollPane: a pointer to the widget raising the announcement!
!PaneScrolling methodsFor: 'accessing' stamp: 'MartinDias 7/16/2013 17:52'!
step
	^ step! !

!PaneScrolling methodsFor: 'accessing' stamp: 'MartinDias 7/16/2013 17:53'!
scrollPane
	^ scrollPane! !

!PaneScrolling methodsFor: 'accessing' stamp: 'MartinDias 7/16/2013 17:52'!
step: anObject
	step := anObject! !

!PaneScrolling methodsFor: 'accessing' stamp: 'MartinDias 7/16/2013 17:53'!
scrollPane: anObject
	scrollPane := anObject! !

!PanelMorph commentStamp: 'gvc 5/18/2007 12:38'!
A container morph that tracks the owner's pane colour unless an explicit fillStyle is specified. Additionally allows hooking of mouseOver events (no button down).!
!PanelMorph methodsFor: 'initialization' stamp: 'gvc 4/12/2007 10:49'!
initialColorInSystemWindow: aSystemWindow
	"Answer the colour the receiver should be when added to a SystemWindow."

	^Color transparent! !

!PanelMorph methodsFor: 'initialize' stamp: 'gvc 7/27/2006 10:36'!
defaultColor
	"Answer the default color for the receiver."

	^Color transparent! !

!PanelMorph methodsFor: 'protocol' stamp: 'gvc 3/4/2010 12:21'!
interactionState: aSymbol
	"Pass on to submorphs."

	self submorphsDo: [:m |
		(m respondsTo: #interactionState:) ifTrue: [
			m interactionState: aSymbol]]! !

!PanelMorph methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 4/1/2014 13:05'!
isResizeableMorph: submorph forSplitter: e
	| done |
	done := e splitsTopAndBottom
		ifTrue: [ submorph layoutFrame isVerticallyResizeable ]
		ifFalse: [ submorph layoutFrame isHorizontallyResizeable ].
	^ done! !

!PanelMorph methodsFor: 'protocol' stamp: 'IgorStasenko 12/19/2012 18:00'!
newHSplitterAt: anIndex

	| above frame splitter index size |
	size := submorphs size.
	index := size - anIndex + 2.
	above := self submorphs at: index.
	frame := above layoutFrame.
	splitter := self newHSplitter.
	splitter  layoutFrame:  ((frame leftFraction @ frame bottomFraction corner: frame rightFraction @ frame bottomFraction) asLayoutFrame 
										bottomOffset: 4).			
	self privateAddMorph: splitter atIndex: (size - anIndex + 2)! !

!PanelMorph methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 4/1/2014 13:19'!
checkMorphsLeftOrTopFrom: splitter
	| index size |
	
	size := submorphs size.
	index := submorphs identityIndexOf: splitter.
	
	index := index + 1.
	
	[ index <= size ] whileTrue: [ 
		| submorph done |
		submorph := submorphs at: index.
		splitter addLeftOrTop: submorph.
		done := self isResizeableMorph: submorph forSplitter: splitter.
		done
			ifTrue: [ index := size + 1 ].
		index := index + 1 ]! !

!PanelMorph methodsFor: 'accessing' stamp: 'gvc 9/11/2009 17:54'!
adoptPaneColor: paneColor
	"Change our color too."
	
	super adoptPaneColor: paneColor.
	paneColor ifNil: [^self].
	self assureExtension.
	extension fillStyle ifNil: [self color: paneColor].
	self borderStyle baseColor: paneColor darker! !

!PanelMorph methodsFor: 'protocol' stamp: 'gvc 5/1/2007 17:26'!
mouseOver: anEvent
	"Handle a mouseOver event, meaning the mouse just moved within the receiver
	with no button pressed. The default response is to let my eventHandler, if any, handle it."

	self eventHandler ifNotNil:
		[self eventHandler mouseOver: anEvent fromMorph: self]! !

!PanelMorph methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/31/2012 15:47'!
newHSplitter

	^ ProportionalSplitterMorph new
			beSplitsTopAndBottom;
			setProperty: #model toValue: self.! !

!PanelMorph methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 4/1/2014 13:18'!
checkSplitters
		
	(self submorphsSatisfying: [ :e | e isKindOf: ProportionalSplitterMorph ])
		do: [ :splitter |
			self checkMorphsLeftOrTopFrom: splitter.
			self checkMorphsRightOrBottomFrom: splitter ]! !

!PanelMorph methodsFor: 'initialization' stamp: 'gvc 1/16/2007 12:33'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		clipSubmorphs: true;
		beSticky "stop being grabbed"! !

!PanelMorph methodsFor: 'protocol' stamp: 'IgorStasenko 12/19/2012 18:01'!
newVSplitterAt: anIndex
	| left frame splitter index size |

	size := submorphs size.
	index := size - anIndex + 2.
	left := self submorphs at: index.
	frame := left layoutFrame.
	
	splitter := self newVSplitter.
	splitter 
		layoutFrame: ((frame rightFraction @ frame topFraction corner: frame rightFraction @ frame bottomFraction) asLayoutFrame
							 rightOffset: 4).

	self privateAddMorph: splitter atIndex: (size - anIndex + 2)! !

!PanelMorph methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 4/1/2014 13:17'!
checkMorphsLeftOrTopFrom: splitter size: size
	| index |
	
	index := submorphs identityIndexOf: splitter.
	
	index := index + 1.
	
	[ index <= size ] whileTrue: [ 
		| submorph done |
		submorph := submorphs at: index.
		splitter addLeftOrTop: submorph.
		done := self isResizeableMorph: submorph forSplitter: splitter.
		done
			ifTrue: [ index := size + 1 ].
		index := index + 1 ]! !

!PanelMorph methodsFor: 'protocol' stamp: 'StephaneDucasse 5/31/2013 17:50'!
enabled: aBoolean
	"Pass on to submorphs."

	self submorphsDo: [:m | m enabled: aBoolean]! !

!PanelMorph methodsFor: 'events-processing' stamp: 'GaryChambers 7/29/2011 15:29'!
handleMouseOver: anEvent
	"System level event handling."
	
	super handleMouseOver: anEvent.
	(self handlesMouseOver: anEvent) ifTrue:[
		anEvent wasHandled: true.
		self mouseOver: anEvent]! !

!PanelMorph methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 4/1/2014 13:16'!
checkMorphsRightOrBottomFrom: splitter
	| index |
	
	index := submorphs identityIndexOf: splitter.
	index := index - 1.
	
	[ index > 0 ] whileTrue: [ | submorph done |
		submorph := submorphs at: index.
		splitter addRightOrBottom: submorph.
		done := self isResizeableMorph: submorph forSplitter: splitter.
		done ifTrue: [ index := 0 ].
		index := index - 1 ]! !

!PanelMorph methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/31/2012 15:47'!
newVSplitter

	^ ProportionalSplitterMorph new
			setProperty: #model toValue: self.! !

!PanelMorph methodsFor: 'initialization' stamp: 'gvc 7/26/2006 17:31'!
defaultBorderWidth
	"Answer the default border width for the receiver."
	
	^0! !

!PanelMorphWithSplitters commentStamp: '<historical>'!
A PanelMorphWithSplitters is which add splitters the way SystemWindow do it!
!PanelMorphWithSplitters methodsFor: 'private' stamp: 'IgorStasenko 12/19/2012 18:13'!
addPaneHSplitterBetween: topMorphs and: bottomMorphs
	"Add a horizontal splitter for the given morphs that share a common bottom fraction.
	If there is a horizontal discontinuity apply the splitter to the first contiguous group.
	Answer the morphs to which the splitter was applied."
	
	|targetY fixed rightFraction leftFrame rightFrame sorted morph topGroup bottomGroup splitter offset|
	topMorphs ifEmpty: [^self].
	targetY := topMorphs first layoutFrame bottomFraction.
	fixed := topMorphs select: [:m | m layoutFrame topFraction = m layoutFrame bottomFraction].
		"fixed morphs appear in both top and bottom"
	sorted := ((topMorphs reject: [:m | m layoutFrame topFraction = m layoutFrame bottomFraction])
		asSortedCollection: [:a :b | a layoutFrame rightFraction = b layoutFrame rightFraction
			ifTrue: [a layoutFrame leftFraction <= b layoutFrame leftFraction]
			ifFalse: [a layoutFrame rightFraction <= b layoutFrame rightFraction]]) readStream.
	sorted contents ifEmpty: [^fixed].
	topGroup := OrderedCollection new.
	rightFraction := sorted contents first layoutFrame leftFraction.
	[sorted atEnd or: [morph := sorted next.
			(morph layoutFrame leftFraction ~= rightFraction and: [
				morph layoutFrame rightFraction ~= rightFraction])]] whileFalse: [
		topGroup add: morph.
		rightFraction := morph layoutFrame rightFraction].
	leftFrame := topGroup first layoutFrame.
	rightFrame := topGroup last layoutFrame.
	bottomGroup := (bottomMorphs 
			reject: [:m | m layoutFrame topFraction = m layoutFrame bottomFraction])
			select: [:m |
		(m layoutFrame leftFraction
			between: leftFrame leftFraction
			and: rightFrame rightFraction) or: [
		m layoutFrame rightFraction
			between: leftFrame leftFraction
			and: rightFrame rightFraction]].
	offset := (topGroup collect: [:m | m layoutFrame bottomOffset]) max.
	splitter := ProportionalSplitterMorph new beSplitsTopAndBottom.
	splitter layoutFrame: ( (leftFrame leftFraction @ targetY corner: rightFrame rightFraction @ targetY) asLayoutFrame 
								leftOffset: leftFrame leftOffset;
								rightOffset: rightFrame rightOffset;
								topOffset: offset;
								bottomOffset: 4+offset ).
	topGroup := topGroup, fixed.
	topGroup do: [:m | splitter addLeftOrTop: m].
	bottomGroup do: [:m | splitter addRightOrBottom: m].
	self addMorphBack: splitter.
	^topGroup! !

!PanelMorphWithSplitters methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 23:06'!
initialize

	super initialize.

	paneMorphs := OrderedCollection new.! !

!PanelMorphWithSplitters methodsFor: 'private' stamp: ''!
addPaneHSplitters
	"Add the horizontal pane splitters."

	|remaining targetBottom sameBottom sameTop|
	remaining := paneMorphs reject: [:each |
			each layoutFrame bottomFraction = 1 or: [
				each layoutFrame bottomFraction = 0]].
	[remaining notEmpty] whileTrue: [
		targetBottom := remaining first layoutFrame bottomFraction.
		sameBottom := remaining select: [:each |
			each layoutFrame bottomFraction = targetBottom].
		sameTop := paneMorphs select: [:each |
			each layoutFrame topFraction = targetBottom].
		remaining := remaining
			copyWithoutAll: (self addPaneHSplitterBetween: sameBottom and: sameTop)]! !

!PanelMorphWithSplitters methodsFor: 'private' stamp: 'IgorStasenko 12/19/2012 18:13'!
addPaneVSplitterBetween: leftMorphs and: rightMorphs
	"Add a vertical splitter for the given morphs that share a common right fraction.
	If there is a vertical discontinuity apply the splitter to the first contiguous group.
	Answer the morphs to which the splitter was applied."
	
	|targetX fixed bottomFraction topFrame bottomFrame sorted morph leftGroup rightGroup splitter offset|
	leftMorphs ifEmpty: [^self].
	targetX := leftMorphs first layoutFrame rightFraction.
	fixed := leftMorphs select: [:m | m layoutFrame leftFraction = m layoutFrame rightFraction].
		"fixed morphs appear in both top and bottom"
	sorted := ((leftMorphs reject: [:m | m layoutFrame leftFraction = m layoutFrame rightFraction])
		asSortedCollection: [:a :b | a layoutFrame bottomFraction = b layoutFrame bottomFraction
			ifTrue: [a layoutFrame topFraction <= b layoutFrame topFraction]
			ifFalse: [a layoutFrame bottomFraction <= b layoutFrame bottomFraction]]) readStream.
	sorted contents ifEmpty: [^fixed].
	leftGroup := OrderedCollection new.
	bottomFraction := sorted contents first layoutFrame topFraction.
	[sorted atEnd or: [morph := sorted next.
			morph layoutFrame topFraction ~= bottomFraction and: [
				morph layoutFrame bottomFraction ~= bottomFraction]]] whileFalse: [
		leftGroup add: morph.
		bottomFraction := morph layoutFrame bottomFraction].
	topFrame := leftGroup first layoutFrame.
	bottomFrame := leftGroup last layoutFrame.
	rightGroup := (rightMorphs
			reject: [:m | m layoutFrame leftFraction = m layoutFrame rightFraction])
			select: [:m |
		m layoutFrame topFraction
			between: topFrame topFraction
			and: bottomFrame bottomFraction].
	offset := (leftGroup collect: [:m | m layoutFrame rightOffset]) max.
	splitter := ProportionalSplitterMorph new.
	splitter layoutFrame:  ((targetX @ topFrame topFraction corner: targetX @ bottomFrame bottomFraction) asLayoutFrame 
								leftOffset: offset;
								topOffset: topFrame topOffset;
								rightOffset: 4+offset;
								bottomOffset: bottomFrame bottomOffset).
	leftGroup := leftGroup, fixed.
	leftGroup do: [:m | splitter addLeftOrTop: m].
	rightGroup do: [:m | splitter addRightOrBottom: m].
	self addMorphBack: splitter.
	^leftGroup! !

!PanelMorphWithSplitters methodsFor: 'submorphs-add/remove' stamp: ''!
addMorph: aMorph fullFrame: aLayout

	paneMorphs add: aMorph.
	super addMorph: aMorph fullFrame: aLayout! !

!PanelMorphWithSplitters methodsFor: 'private' stamp: 'BenjaminVanRyseghem 3/23/2012 17:01'!
addPaneSplitters
	"Add the vertical and horizontal pane splitters."

	self removePaneSplitters.
	self addPaneVSplitters.
	self addPaneHSplitters.
	self linkSplittersToSplitters! !

!PanelMorphWithSplitters methodsFor: 'private' stamp: ''!
addPaneVSplitters
	"Add the vertical pane splitters."

	|remaining targetRight sameRight sameLeft |
	remaining := paneMorphs reject: [:each |
			each layoutFrame rightFraction = 1 or: [
				each layoutFrame rightFraction = 0]].
	[remaining notEmpty] whileTrue: [
		targetRight := remaining first layoutFrame rightFraction.
		sameRight := remaining select: [:each |
			each layoutFrame rightFraction = targetRight].
		sameLeft := paneMorphs select: [:each |
			each layoutFrame leftFraction = targetRight and: [
				each layoutFrame rightFraction ~= targetRight]].
		remaining := remaining
			copyWithoutAll: (self addPaneVSplitterBetween: sameRight and: sameLeft)]! !

!PanelMorphWithSplitters methodsFor: 'private' stamp: ''!
linkSplittersToSplitters
	"The pane morphs are already linked. Cross link the splitters as appropriate."
	
	self splitters do: [:each |
		each splitsTopAndBottom
			ifTrue: [self splitters do: [:eachMorph |
					eachMorph splitsTopAndBottom ~= each splitsTopAndBottom ifTrue: [
						eachMorph layoutFrame bottomFraction = each layoutFrame topFraction
							ifTrue: [each addLeftOrTop: eachMorph].
						eachMorph layoutFrame topFraction = each layoutFrame bottomFraction
							ifTrue: [each addRightOrBottom: eachMorph]]]]
			ifFalse: [self splitters do: [:eachMorph |
					eachMorph splitsTopAndBottom ~= each splitsTopAndBottom ifTrue: [
						eachMorph layoutFrame rightFraction = each layoutFrame leftFraction
							ifTrue: [each addLeftOrTop: eachMorph].
						eachMorph layoutFrame leftFraction = each layoutFrame rightFraction
							ifTrue: [each addRightOrBottom: eachMorph]]]].
				
		each comeToFront.]! !

!PanelMorphWithSplitters methodsFor: 'submorphs-add/remove' stamp: 'BenjaminVanRyseghem 3/23/2012 17:00'!
addMorph: aMorph

	paneMorphs add: aMorph.
	^ super addMorph: aMorph! !

!PanelMorphWithSplitters methodsFor: 'layout-properties' stamp: ''!
layoutFrame: aFrame

	self activate.
	super layoutFrame: aFrame! !

!Paragraph commentStamp: 'AlainPlantec 9/15/2011 16:13'!
A Paragraph represents text that has been laid out, or composed, in some container.
I also display the different kinds of text selection (secondary, find-replace and selection bar).

Class collaborations
   SelectionBlock instances are built by myself and stored in the extraSelectionBlocks instance variable in order to display supplementary selections

Class main API
   no particular main API.

Instance Variables
   extraSelectionBlocks: <Collection of SelectionBlock>
   findReplaceSelectionRegex: <RxMatcher>
   presentationLines: <Object>
   presentationText: <Object>
   refreshExtraSelection: <Boolean>
   secondarySelection: <String>

extraSelectionBlocks
   - a collection of SelectionBlock for the drowing of the differents kind of text selection

findReplaceSelectionRegex
   - the find/replace matcher that is set from the editor of by the FindReplaceService

presentationLines
   - created for debugging purpose, should be removed ?

presentationText
   - created for debugging purpose, should be removed ?

refreshExtraSelection
   - a boolean that is set to tru when there is a need to refresh selections

secondarySelection
   - the string of the secondary selection that is set from the editor when a portion of text is selected

	text 		A Text with encoded per-character emphasis.
	textStyle	A TextStyle with font set, line height and horizontal alignment.
	firstCharacterIndex    The starting index in text for this paragraph, allowing
				composition of a long text into a number of containers.
	container	A Rectangle or TextContainer that determines where text can go.
	lines		An Array of TextLines comprising the final layout of the text
				after it has been composed within its container.
	positionWhenComposed   As its name implies.  Allows display at new locations
				without the need to recompose the text.
Lines are ordered vertically.  However, for a given y, there may be several lines in left to right order.  Lines must never be empty, even if text is empty.

Notes on yet another hack - 5 Feb 2001

We really need to clean up #composeLinesFrom:to:delta:into:priorLines:atY:!!!!!!

I added one more habdful of code to correct:

This is an annoying bug that's been around for a couple of years, but I finally figured out how to duplicate the problem, so I figured I'd just report it now.  (It doesn't necessarily have to be fixed for 3.0 if it looks messy, but if it's a simple fix, it would be worth it.)

In Morphic, if you have the following text in a workspace:

This is line 1
This is line 2

**and** you have a return character after line 2, you will normally be able to click the mouse two times below line 2 in order to select all the text.  If you edit line 2 (e.g. so that it reads "line number 2"), you can still select all the text by clicking below the second line.  However, if you edit line 1, you will not be able to select all the text from the bottom in the same way.  Things get messed up such that the last return character seems to be gone.  In this state, if you position the cursor immediately after the 2, and press the right arrow, the cursor jumps to the beginning of line 2... oof. (report by Doug Way)

While I don't have a very deep understanding of the above mentioned method, I was able to determine that text ending in a CR worked better in the editor when the last entry in <lines> had a start of text size + 1 and a stop of text size. I have accordingly added code near the end to ensure this. It seems to have fixed the problem, but we do need to clean this baby up some day. - Bob


!
!Paragraph methodsFor: 'private' stamp: 'di 10/21/97 21:36'!
positionWhenComposed: pos
	positionWhenComposed := pos! !

!Paragraph methodsFor: 'alignment' stamp: 'di 10/25/97 19:26'!
rightFlush 
	textStyle rightFlush! !

!Paragraph methodsFor: 'private' stamp: 'di 5/21/1998 21:47'!
textStyle: ts lines: l text: t
	"Private -- just a service for deepCopy"
	textStyle := ts.
	lines := l.
	text := t.! !

!Paragraph methodsFor: 'editing' stamp: 'GabrielOmarCotelli 11/30/2013 17:08'!
actionAttributesUnder: aClickPoint event: anEvent do: aBlock
	| startBlock |
	startBlock := self characterBlockAtPoint: aClickPoint.
	(text attributesAt: startBlock stringIndex forStyle: textStyle)
		select: [ :attribute | attribute mayActOnEvent: anEvent ]
		thenDo: [ :attribute | 
			| range boxes |
			"find the boxes for the current attribute range"
			range := text rangeOf: attribute startingAt: startBlock stringIndex.
			boxes := self
				selectionRectsFrom: (self characterBlockForIndex: range first)
				to: (self characterBlockForIndex: range last + 1).
			boxes detect: [ :each | each containsPoint: aClickPoint ] ifFound: [ aBlock cull: attribute cull: boxes ] ]! !

!Paragraph methodsFor: 'editing' stamp: 'CamilloBruni 2/2/2012 00:19'!
move: anEvent for: model controller: editor
	"Give sensitive text a chance to fire.  Display flash: (100@100 extent: 100@100)."
	
	| action clickPoint |
	
	clickPoint := anEvent cursorPoint.
	action := false.
	
	self actionAttributesUnder: clickPoint event: anEvent do: [ :attribute| |target|
		"evaluate the attribute action"
		target := (model ifNil: [editor morph]).
		(attribute actOnMove: anEvent for: target in: self editor: editor) == true 	
			ifTrue: [ ^ true ]].
	
	(action and: [ Cursor currentCursor == Cursor webLink]) 
		ifTrue:[ Cursor normal show ].
	
	^ action! !

!Paragraph methodsFor: 'composition' stamp: 'AlainPlantec 9/20/2011 10:08'!
recomposeFrom: start to: stop delta: delta 
	"Recompose this paragraph. The altered portion is between start and
	stop. Recomposition may continue to the end of the text, due to a
	ripple effect.
	Delta is the amount by which the current text is longer than it was
	when its current lines were composed."
	"Have to recompose line above in case a word-break was affected."
	| startLine newLines |
	startLine := (self lineIndexForCharacter: start)
				- 1 max: 1.
	[startLine > 1
		and: [(lines at: startLine - 1) top = (lines at: startLine) top]]
		whileTrue: [startLine := startLine - 1].
	"Find leftmost of line pieces"
	newLines := OrderedCollection new: lines size + 1.
	1
		to: startLine - 1
		do: [:i | newLines
				addLast: (lines at: i)].
	text string isOctetString ifTrue: [
		^ self composeLinesFrom: (lines at: startLine) first to: stop delta: delta
			into: newLines priorLines: lines
			atY: (lines at: startLine) top.
	].
	self
		multiComposeLinesFrom: (lines at: startLine) first
		to: stop
		delta: delta
		into: newLines
		priorLines: lines
		atY: (lines at: startLine) top! !

!Paragraph methodsFor: 'access' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
theme
	^ Smalltalk ui theme! !

!Paragraph methodsFor: '*Athens-Morphic' stamp: 'IgorStasenko 10/8/2012 04:21'!
drawOnAthensCanvas: aCanvas bounds: aRectangle 
	"do nothing"! !

!Paragraph methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 10:12'!
initialize
	super initialize.
	self positionWhenComposed: 0 @ 0! !

!Paragraph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/15/2015 00:24'!
drawOnAthensCanvas: anAthensCanvas bounds: aRectangle color: aColor
	self displayCaretAndSelectionOnAthensCanvas: anAthensCanvas.
	self displayExtraSelectionOnAthensCanvas: anAthensCanvas.
	anAthensCanvas setPaint: aColor.
	self displayTextOnAthensCanvas: anAthensCanvas in: aRectangle.
! !

!Paragraph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/14/2015 00:00'!
displaySelectionBarOnAthensCanvas: anAthensCanvas
	| visibleRectangle line |
	selectionStart ifNil: [ ^ self ].
	selectionStop ifNil: [ ^ self ].
	visibleRectangle := anAthensCanvas clipRect.
	selectionStart textLine = selectionStop textLine
		ifFalse: [ ^ self ].
	line := selectionStart textLine.
	anAthensCanvas setPaint: self selectionBarColor.
	anAthensCanvas drawShape: (visibleRectangle left @ line top corner: visibleRectangle right @ line bottom)! !

!Paragraph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/15/2015 21:13'!
drawCaretOnAthensCanvas: anAthensCanvas
	| rect |
	(self showCaret not or: [ selectionStart isNil ])
		ifTrue: [ ^ self ].
	rect := selectionStart origin corner: selectionStart corner.
	caretRect := rect topLeft extent: 1 @ rect height.
	anAthensCanvas setStrokePaint: self insertionPointColor.
	anAthensCanvas drawShape: self caretRect! !

!Paragraph methodsFor: 'selection' stamp: 'AlainPlantec 9/15/2011 15:57'!
secondarySelection: aSubString
	secondarySelection := aSubString.
! !

!Paragraph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/14/2015 01:06'!
displayExtraSelectionOnAthensCanvas: anAthensCanvas
	| visibleRectangle |
	visibleRectangle := anAthensCanvas clipRect.
	refreshExtraSelection = true
		ifTrue: [ self buildSelectionBlocksFrom: visibleRectangle topLeft to: visibleRectangle bottomRight.
			refreshExtraSelection := false ].
		
	extraSelectionBlocks
		ifNotNil: [ 
			self forLinesIn: visibleRectangle	do: [ :line | 
					extraSelectionBlocks
						do: [ :selblock | self displaySelectionBlock: selblock inLine: line onAthensCanvas: anAthensCanvas ] ] ]! !

!Paragraph methodsFor: 'private' stamp: 'di 4/14/98 13:17'!
fastFindFirstLineSuchThat: lineBlock
	"Perform a binary search of the lines array and return the index
	of the first element for which lineBlock evaluates as true.
	This assumes the condition is one that goes from false to true for
	increasing line numbers (as, eg, yval > somey or start char > somex).
	If lineBlock is not true for any element, return size+1."
	| index low high |
	low := 1.
	high := lines size.
	[index := high + low // 2.
	low > high]
		whileFalse: 
			[(lineBlock value: (lines at: index))
				ifTrue: [high := index - 1]
				ifFalse: [low := index + 1]].
	^ low! !

!Paragraph methodsFor: 'private' stamp: 'di 4/14/98 13:11'!
lineIndexForCharacter: index
	"Answer the index of the line in which to select the character at index."
	^ (self fastFindFirstLineSuchThat: [:line | line first > index]) - 1 max: 1! !

!Paragraph methodsFor: 'access' stamp: 'RAA 5/6/2001 15:04'!
wantsColumnBreaks

	^wantsColumnBreaks! !

!Paragraph methodsFor: 'composition' stamp: 'di 10/22/97 11:13'!
compositionRectangle
	^ container! !

!Paragraph methodsFor: 'access' stamp: 'jm 11/19/97 20:27'!
textOwner: ignored  "See TextOnCurve"! !

!Paragraph methodsFor: 'private' stamp: 'edc 6/18/2004 09:10'!
moveBy: delta
	lines do: [:line | line moveBy: delta].
	positionWhenComposed ifNotNil:[
	positionWhenComposed := positionWhenComposed + delta].
	container := container translateBy: delta! !

!Paragraph methodsFor: 'private' stamp: 'FernandoOlivero 6/15/2010 13:46'!
adjustBottomY
	| heights  bottomY verticalSize |
	heights := lines collect:[:each| each lineHeight ].
	verticalSize := heights sum.
	bottomY := container top + verticalSize.
	container := container withBottom: bottomY.! !

!Paragraph methodsFor: 'selection' stamp: 'nice 10/29/2013 02:37'!
characterBlockAtPoint: aPoint 
	"Answer a CharacterBlock for the character in the text at aPoint."
	| line |
	line := lines at: (self lineIndexForPoint: aPoint).
	^ (CharacterBlockScanner new text: text textStyle: textStyle)
		characterBlockAtPoint: aPoint index: nil
		in: line! !

!Paragraph methodsFor: 'display' stamp: 'tbn 8/5/2009 10:01'!
displaySelectionInLine: line on: aCanvas 
	| leftX rightX w caretColor |
	selectionStart ifNil: [^self].	"No selection"
	aCanvas isShadowDrawing ifTrue: [ ^self ].	"don't draw selection with shadow"
	selectionStart = selectionStop 
		ifTrue: 
			["Only show caret on line where clicked"

			selectionStart textLine ~= line ifTrue: [^self]]
		ifFalse: 
			["Test entire selection before or after here"

			(selectionStop stringIndex < line first 
				or: [selectionStart stringIndex > (line last + 1)]) ifTrue: [^self].	"No selection on this line"
			(selectionStop stringIndex = line first 
				and: [selectionStop textLine ~= line]) ifTrue: [^self].	"Selection ends on line above"
			(selectionStart stringIndex = (line last + 1) 
				and: [selectionStop textLine ~= line]) ifTrue: [^self]].	"Selection begins on line below"
	leftX := (selectionStart stringIndex < line first 
				ifTrue: [line ]
				ifFalse: [selectionStart ])left.
	rightX := (selectionStop stringIndex > (line last + 1) or: 
					[selectionStop stringIndex = (line last + 1) 
						and: [selectionStop textLine ~= line]]) 
				ifTrue: [line right]
				ifFalse: [selectionStop left].
	selectionStart = selectionStop 
		ifTrue: 
			[rightX := rightX + 1.
			w := self caretWidth.
			caretRect := (leftX-w) @ line top corner: (rightX+w)@ line bottom.
			self showCaret ifFalse:[^self].
			caretColor := self insertionPointColor.
			1 to: w
				do: 
					[:i | 
					"Draw caret triangles at top and bottom"

					aCanvas fillRectangle: ((leftX - w + i - 1) @ (line top + i - 1) 
								extent: ((w - i) * 2 + 3) @ 1)
						color: caretColor.
					aCanvas fillRectangle: ((leftX - w + i - 1) @ (line bottom - i) 
								extent: ((w - i) * 2 + 3) @ 1)
						color: caretColor].
			aCanvas fillRectangle: (leftX @ line top corner: rightX @ line bottom)
				color: caretColor]
		ifFalse: 
			[caretRect := nil.
			aCanvas fillRectangle: (leftX @ line top corner: rightX @ line bottom)
				color: self selectionColor]! !

!Paragraph methodsFor: 'display' stamp: 'AlainPlantec 9/15/2011 15:57'!
displayExtraSelectionOn: aCanvas 
	"Send all visible lines to the displayScanner for display"

	| visibleRectangle line |
	visibleRectangle := aCanvas clipRect.
	refreshExtraSelection = true 
		ifTrue: [self buildSelectionBlocksFrom: visibleRectangle topLeft to: visibleRectangle bottomRight.
			refreshExtraSelection := false].
	extraSelectionBlocks ifNotNil: [
		(self lineIndexForPoint: visibleRectangle topLeft)
			to: (self lineIndexForPoint: visibleRectangle bottomRight)
			do: [:i | line := lines at: i.
				extraSelectionBlocks
					do: [:selblock | self displaySelectionBlock: selblock inLine: line on: aCanvas]]]! !

!Paragraph methodsFor: 'selection' stamp: 'IgorStasenko 1/14/2011 13:44'!
selectionColor: aColor 
	"ignored"! !

!Paragraph methodsFor: 'access' stamp: 'AlainPlantec 10/24/2010 14:30'!
caretWidth
	^ Editor dumbbellCursor		
			ifTrue: [ 2 ]		
			ifFalse: [ 0 ]! !

!Paragraph methodsFor: 'access' stamp: 'sbw 10/13/1999 22:31'!
numberOfLines

	^lines size! !

!Paragraph methodsFor: 'access' stamp: 'di 10/23/97 21:01'!
lastCharacterIndex
	^ lines last last! !

!Paragraph methodsFor: 'selection' stamp: 'di 12/2/97 19:57'!
selectionStart: startBlock selectionStop: stopBlock
	selectionStart := startBlock.
	selectionStop := stopBlock.! !

!Paragraph methodsFor: 'access' stamp: 'di 10/24/97 17:38'!
extent
	^ container width @ (lines last bottom - lines first top)! !

!Paragraph methodsFor: 'editing' stamp: 'CamilloBruni 2/2/2012 00:19'!
click: anEvent for: model controller: editor
	"Give sensitive text a chance to fire.  Display flash: (100@100 extent: 100@100)."
	
	| action clickPoint |
	
	clickPoint := anEvent cursorPoint.
	action := false.
	self actionAttributesUnder: clickPoint event: anEvent do: [ :attribute| |target|
		"evaluate the attribute action"
		target := (model ifNil: [editor morph]).
		(attribute actOnClick: anEvent for: target in: self editor: editor) == true 	
			ifTrue: [ ^ true ]].
	
	(action and: [ Cursor currentCursor == Cursor webLink]) 
		ifTrue:[ Cursor normal show ].
	
	^ action! !

!Paragraph methodsFor: 'private' stamp: 'di 11/8/97 15:47'!
adjustLineIndicesBy: delta
	firstCharacterIndex := firstCharacterIndex + delta.
	lines do: [:line | line slide: delta].
! !

!Paragraph methodsFor: 'selection' stamp: 'AlainPlantec 9/15/2011 15:57'!
selectionBarColor
	^ self theme  selectionBarColor! !

!Paragraph methodsFor: 'private' stamp: 'RAA 8/30/1998 15:04'!
lineIndexOfCharacterIndex: characterIndex 
	"Answer the line index for a given characterIndex."
	"apparently the selector changed with NewParagraph"

	^self lineIndexForCharacter: characterIndex 
! !

!Paragraph methodsFor: 'private' stamp: 'di 10/26/97 15:57'!
adjustRightX
	| shrink |
	shrink := container right - maxRightX.
	lines do: [:line | line paddingWidth: (line paddingWidth - shrink)].
	container := container withRight: maxRightX! !

!Paragraph methodsFor: 'selection' stamp: 'di 10/5/1998 12:59'!
defaultCharacterBlock
	^ (CharacterBlock new stringIndex: firstCharacterIndex text: text
			topLeft: lines first topLeft extent: 0 @ 0)
		textLine: lines first! !

!Paragraph methodsFor: 'access' stamp: 'di 11/8/97 15:41'!
firstCharacterIndex
	^ firstCharacterIndex! !

!Paragraph methodsFor: 'selection' stamp: 'AlainPlantec 9/15/2011 15:57'!
extraSelectionChanged
	refreshExtraSelection := true! !

!Paragraph methodsFor: 'private' stamp: 'di 4/14/98 13:13'!
lineIndexForPoint: aPoint
	"Answer the index of the line in which to select the character nearest to aPoint."
	| i py |
	py := aPoint y truncated.

	"Find the first line at this y-value"
	i := (self fastFindFirstLineSuchThat: [:line | line bottom > py]) min: lines size.

	"Now find the first line at this x-value"
	[i < lines size and: [(lines at: i+1) top = (lines at: i) top
				and: [aPoint x >= (lines at: i+1) left]]]
		whileTrue: [i := i + 1].
	^ i! !

!Paragraph methodsFor: 'display' stamp: 'AlainPlantec 9/15/2011 15:57'!
displaySelectionBlock: aSelBlock inLine: line on: aCanvas 
	"Display a SelectionBlock if it does not overlap vith the regular selection"
	
	(selectionStart notNil and: [selectionStop notNil and: [selectionStart ~= selectionStop]])
		ifTrue: [	| startIdx stopIdx selSartIdx selStopIdx selBlockRange selRange |
			startIdx := aSelBlock first stringIndex.
			stopIdx := aSelBlock last stringIndex.
			selSartIdx := selectionStart stringIndex.
			selStopIdx := selectionStop stringIndex.
			selBlockRange := (startIdx) to: (stopIdx).
			selRange := (selSartIdx) to: (selStopIdx).
			((selBlockRange rangeIncludes: selSartIdx + 1) or: [(selBlockRange rangeIncludes: selStopIdx - 1) 
				or: [(selRange rangeIncludes: startIdx + 1) or: [selRange rangeIncludes: stopIdx - 1]]])
				ifTrue: [^ self]]. "regular selection and this selection block overlap"
	aSelBlock displayInLine: line on: aCanvas
! !

!Paragraph methodsFor: 'selection' stamp: 'CamilloBruni 2/6/2012 23:28'!
selectionContainsPoint: aPoint
	"return whether the current selection contains the given point"
	^ self selectionRects anySatisfy: [ :rect| rect containsPoint: aPoint ]! !

!Paragraph methodsFor: 'private' stamp: 'nice 11/17/2009 00:59'!
indentationOfLineIndex: lineIndex ifBlank: aBlock
	"Answer the number of leading tabs in the line at lineIndex.  If there are
	 no visible characters, pass the number of tabs to aBlock and return its value.
	 If the line is word-wrap overflow, back up a line and recur."

	| arrayIndex first last crlf |
	crlf := CharacterSet crlf.
	arrayIndex := lineIndex.
	[first := (lines at: arrayIndex) first.
	 first > 1 and: [crlf includes: (text string at: first - 1)]] whileTrue: "word wrap"
		[arrayIndex := arrayIndex - 1].
	last := (lines at: arrayIndex) last.
	
	^(text string copyFrom: first to: last) indentationIfBlank: aBlock.
! !

!Paragraph methodsFor: 'access' stamp: 'AlainPlantec 9/15/2011 17:15'!
composer
	^ composer ifNil: [composer := TextComposer new]! !

!Paragraph methodsFor: 'editing' stamp: 'di 4/28/1999 10:14'!
replaceFrom: start to: stop with: aText displaying: displayBoolean 
	"Edit the text, and then recompose the lines." 
	text replaceFrom: start to: stop with: aText.
	self recomposeFrom: start to: start + aText size - 1 delta: aText size - (stop-start+1)! !

!Paragraph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/14/2015 00:47'!
displayCaretAndSelectionOnAthensCanvas: anAthensCanvas
	selectionStart ifNil: [ ^ self ].
	selectionStart = selectionStop
		ifTrue: [ self drawCaretOnAthensCanvas: anAthensCanvas ]
		ifFalse: [ 
			| selection |
			caretRect := nil.
			selection := ParagraphSelectionBlock first: selectionStart last: selectionStop color: self selectionColor.
			self forLinesIn: anAthensCanvas clipRect do: [ :line | selection displayInLine: line onAthensCanvas: anAthensCanvas ] ]! !

!Paragraph methodsFor: 'private' stamp: 'di 10/24/97 17:40'!
lines
	^ lines! !

!Paragraph methodsFor: 'composition' stamp: 'AlainPlantec 9/15/2011 15:56'!
multiComposeLinesFrom: start to: stop delta: delta into: lineColl priorLines: priorLines atY: startingY 
	"While the section from start to stop has changed, composition may
	ripple all the way to the end of the text. However in a rectangular
	container, if we ever find a line beginning with the same character as
	before (ie corresponding to delta in the old lines), then we can just
	copy the old lines from there to the end of the container, with
	adjusted indices and y-values"
	| newResult |
	newResult := self composer
				multiComposeLinesFrom: start
				to: stop
				delta: delta
				into: lineColl
				priorLines: priorLines
				atY: startingY
				textStyle: textStyle
				text: text
				container: container
				wantsColumnBreaks: wantsColumnBreaks == true.
	lines := newResult first asArray.
	"maxRightX printString displayAt: 0@0."
	^ maxRightX := newResult second.

! !

!Paragraph methodsFor: 'access' stamp: 'sw 1/13/98 21:31'!
string
	^ text string! !

!Paragraph methodsFor: 'access' stamp: 'di 11/16/97 09:02'!
adjustedFirstCharacterIndex
	"Return the index in the text where this paragraph WOULD begin if nothing had changed, except the size of the text -- ie if there have only been an insertion of deletion in the preceding morphs"
	offsetToEnd ifNil: [^ -1].
	^ text size - offsetToEnd! !

!Paragraph methodsFor: 'selection' stamp: 'AlainPlantec 9/15/2011 15:57'!
findReplaceSelectionColor
	^  self theme currentSettings findReplaceSelectionColor
! !

!Paragraph methodsFor: 'access' stamp: 'di 10/21/97 14:39'!
text
	^ text! !

!Paragraph methodsFor: 'alignment' stamp: 'di 10/25/97 19:26'!
leftFlush 
	textStyle leftFlush! !

!Paragraph methodsFor: 'selection' stamp: 'EstebanLorenzano 4/29/2014 16:48'!
selectionColor
	^ self focused 
		ifTrue: [ self theme selectionColor]
		ifFalse: [ self theme unfocusedSelectionColor ].
! !

!Paragraph methodsFor: 'composition' stamp: 'di 11/8/97 15:31'!
compose: t style: ts from: startingIndex in: textContainer
	text := t.
	textStyle := ts.
	firstCharacterIndex := startingIndex.
	offsetToEnd := text size - firstCharacterIndex.
	container := textContainer.
	self composeAll! !

!Paragraph methodsFor: 'composition' stamp: 'AlainPlantec 9/15/2011 13:40'!
composeAll
	^ self
		multiComposeLinesFrom: firstCharacterIndex
		to: text size
		delta: 0
		into: OrderedCollection new
		priorLines: Array new
		atY: container top ! !

!Paragraph methodsFor: 'composition' stamp: 'AlainPlantec 9/15/2011 17:16'!
composeLinesFrom: start to: stop delta: delta into: lineColl priorLines: priorLines
	atY: startingY
	"While the section from start to stop has changed, composition may ripple all the way to the end of the text.  However in a rectangular container, if we ever find a line beginning with the same character as before (ie corresponding to delta in the old lines), then we can just copy the old lines from there to the end of the container, with adjusted indices and y-values"

	| newResult |

	newResult := self composer
		composeLinesFrom: start 
		to: stop 
		delta: delta 
		into: lineColl 
		priorLines: priorLines
		atY: startingY
		textStyle: textStyle 
		text: text 
		container: container
		wantsColumnBreaks: wantsColumnBreaks == true.
	lines := newResult first asArray.
	^ maxRightX := newResult second.
! !

!Paragraph methodsFor: 'selection' stamp: 'nice 10/29/2013 02:38'!
characterBlockForIndex: index 
	"Answer a CharacterBlock for the character in text at index."
	| line |
	line := lines at: (self lineIndexForCharacter: index).
	^ (CharacterBlockScanner new text: text textStyle: textStyle)
		characterBlockAtPoint: nil index: ((index max: line first) min: text size+1)
		in: line! !

!Paragraph methodsFor: 'access' stamp: 'rr 3/22/2004 12:41'!
focused: aBoolean
	focused := aBoolean! !

!Paragraph methodsFor: 'selection' stamp: 'AlainPlantec 9/15/2011 15:57'!
hasExtraSelection
	"Return true if I've some findReplace or secondary selection"
	^ extraSelectionBlocks isEmptyOrNil not
! !

!Paragraph methodsFor: 'selection' stamp: 'StephaneDucasse 10/13/2013 17:23'!
selectionRectsFrom: characterBlock1 to: characterBlock2 
	"Return an array of rectangles representing the area between the two character blocks given as arguments."
	| line1 line2 rects cb1 cb2 w |
	characterBlock1 <= characterBlock2
		ifTrue: [cb1 := characterBlock1.  cb2 := characterBlock2]
		ifFalse: [cb2 := characterBlock1.  cb1 := characterBlock2].
	cb1 = cb2 ifTrue:
		[w := self caretWidth.
		^ Array with: (cb1 topLeft - (w@0) corner: cb1 bottomLeft + ((w+1)@0))].
	line1 := self lineIndexForCharacter: cb1 stringIndex.
	line2 := self lineIndexForCharacter: cb2 stringIndex.
	line1 = line2 ifTrue:
		[^ Array with: (cb1 topLeft corner: cb2 bottomRight)].
	rects := OrderedCollection new.
	rects addLast: (cb1 topLeft corner: (lines at: line1) bottomRight).
	line1+1 to: line2-1 do: [ :i |
		| line |
		line := lines at: i.
		(line left = rects last left and: [ line right = rects last right ])
			ifTrue: [ "new line has same margins as old one -- merge them, so that the caller gets as few rectangles as possible"
					| lastRect |
					lastRect := rects removeLast.
					rects add: (lastRect bottom: line bottom) ]
			ifFalse: [ "differing margins; cannot merge"
					rects add: line rectangle ] ].

	rects addLast: ((lines at: line2) topLeft rectangle: cb2 bottomLeft).
	^ rects! !

!Paragraph methodsFor: 'access' stamp: 'RAA 5/6/2001 15:03'!
wantsColumnBreaks: aBoolean

	wantsColumnBreaks := aBoolean! !

!Paragraph methodsFor: 'composition' stamp: 'di 11/15/97 09:21'!
composeAllStartingAt: characterIndex
	firstCharacterIndex := characterIndex.
	offsetToEnd := text size - firstCharacterIndex.
	self composeAll! !

!Paragraph methodsFor: 'access' stamp: 'tbn 8/5/2009 09:50'!
caretRect
	"The rectangle in which the caret was last drawn,
	 or nil if the last drawing drew a range-selection rather than insertion point."
	^ caretRect! !

!Paragraph methodsFor: 'selection' stamp: 'EstebanLorenzano 4/29/2014 17:29'!
secondarySelectionColor
	^  self theme secondarySelectionColor
! !

!Paragraph methodsFor: 'display' stamp: 'AlainPlantec 11/17/2010 19:48'!
displayOn: aCanvas using: displayScanner at: somePosition
	"Send all visible lines to the displayScanner for display"
	| visibleRectangle offset leftInRun line |
	visibleRectangle := aCanvas clipRect.
	offset := (somePosition - positionWhenComposed) truncated.
	leftInRun := 0.
	(self lineIndexForPoint: visibleRectangle topLeft)
		to: (self lineIndexForPoint: visibleRectangle bottomRight)
		do: [:i | line := lines at: i.
			self displaySelectionInLine: line on: aCanvas.
			line first <= line last ifTrue:
				[leftInRun := displayScanner displayLine: line offset: offset leftInRun: leftInRun]].
! !

!Paragraph methodsFor: 'selection' stamp: 'jm 11/19/97 22:56'!
containsPoint: aPoint
	^ (lines at: (self lineIndexForPoint: aPoint)) rectangle
		containsPoint: aPoint! !

!Paragraph methodsFor: 'selection' stamp: 'AlainPlantec 9/15/2011 15:57'!
findReplaceSelectionRegex: aRegex
	findReplaceSelectionRegex := aRegex.
! !

!Paragraph methodsFor: 'access' stamp: 'di 10/21/97 14:39'!
textStyle
	^ textStyle! !

!Paragraph methodsFor: 'editing' stamp: 'FernandoOlivero 3/14/2010 22:29'!
replaceFrom: start to: stop with: aText
	"Edit the text, and then recompose the lines." 
	text replaceFrom: start to: stop with: aText.
	self recomposeFrom: start to: start + aText size - 1 delta: aText size - (stop-start+1)! !

!Paragraph methodsFor: 'alignment' stamp: 'di 10/25/97 19:26'!
centered 
	textStyle centered! !

!Paragraph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/14/2015 00:16'!
displaySelectionBlock: aSelBlock inLine: line onAthensCanvas: anAthensCanvas
	(selectionStart notNil and: [ selectionStop notNil and: [ selectionStart ~= selectionStop ] ])
		ifTrue: [ 
			| startIdx stopIdx selSartIdx selStopIdx selBlockRange selRange |
			startIdx := aSelBlock first stringIndex.
			stopIdx := aSelBlock last stringIndex.
			selSartIdx := selectionStart stringIndex.
			selStopIdx := selectionStop stringIndex.
			selBlockRange := startIdx to: stopIdx.
			selRange := selSartIdx to: selStopIdx.
			((selBlockRange rangeIncludes: selSartIdx + 1)
				or: [ 
					(selBlockRange rangeIncludes: selStopIdx - 1)
						or: [ (selRange rangeIncludes: startIdx + 1) or: [ selRange rangeIncludes: stopIdx - 1 ] ] ])
				ifTrue: [ ^ self ] ].	"regular selection and this selection block overlap"
	aSelBlock displayInLine: line onAthensCanvas: anAthensCanvas! !

!Paragraph methodsFor: 'copying' stamp: 'di 5/21/1998 21:45'!
deepCopy
	"Don't want to copy the container (etc) or fonts in the TextStyle."
	| new |
	new := self copy.
	new textStyle: textStyle copy
		lines: lines copy
		text: text deepCopy.
	^ new! !

!Paragraph methodsFor: 'display' stamp: 'AlainPlantec 9/15/2011 15:57'!
displaySelectionBarOn: aCanvas 
	| visibleRectangle line |
	selectionStart ifNil: [^ self].
	selectionStop ifNil: [^ self].
	visibleRectangle := aCanvas clipRect.
	selectionStart textLine = selectionStop textLine ifFalse: [^self].
	line := selectionStart textLine.
	aCanvas fillRectangle: (visibleRectangle left @ line top corner: visibleRectangle right @ line bottom) color: self selectionBarColor! !

!Paragraph methodsFor: 'settings' stamp: 'AlainPlantec 12/19/2009 23:47'!
insertionPointColor
	self focused ifFalse: [^ Color transparent].
	^ Display depth <= 2
		ifTrue: [Color black]
		ifFalse: [self class insertionPointColor]! !

!Paragraph methodsFor: 'selection' stamp: 'ThierryGoubier 1/8/2013 16:42'!
buildSelectionBlocksFrom: topLeft to: bottomRight
	| viewedString primary topLeftBlk bottomRightBlk findReplaceIntervals secondarySelectionIntervals startIdx stopIdx |
	Display depth = 1
		ifTrue: [ ^ self ].
	Display depth = 2
		ifTrue: [ ^ self ].
	primary := selectionStart notNil
		ifTrue: [ selectionStart stringIndex to: selectionStop stringIndex - 1 ]
		ifFalse: [ 0 to: -1 ].
	topLeftBlk := self characterBlockAtPoint: topLeft.
	bottomRightBlk := self characterBlockAtPoint: bottomRight.
	startIdx := topLeftBlk stringIndex.
	stopIdx := bottomRightBlk stringIndex.
	viewedString := (self text copyFrom: startIdx to: stopIdx) asString.
	self theme currentSettings haveSecondarySelectionTextColor
		ifTrue: [ self text removeAttribute: TextSelectionColor secondarySelection ].
	self theme currentSettings haveFindReplaceSelectionTextColor
		ifTrue: [ self text removeAttribute: TextSelectionColor findReplaceSelection ].
	findReplaceIntervals := #().
	extraSelectionBlocks := Array
		streamContents: [ :strm | 
			findReplaceSelectionRegex
				ifNotNil: [ 
					findReplaceIntervals := findReplaceSelectionRegex matchingRangesIn: viewedString.
					findReplaceIntervals := (findReplaceIntervals collect: [ :r | r + topLeftBlk stringIndex - 1 ])
						reject: [ :r | primary size > 0 and: [ (r includes: primary first) or: [ primary includes: r first ] ] ].
					findReplaceIntervals
						do: [ :r | 
							self theme currentSettings haveFindReplaceSelectionTextColor
								ifTrue: [ self text addAttribute: TextSelectionColor findReplaceSelection from: r first to: r last ].
							strm
								nextPut:
									(ParagraphSelectionBlock
										first: (self characterBlockForIndex: r first)
										last: (self characterBlockForIndex: r last + 1)
										color: self findReplaceSelectionColor) ] ].
			secondarySelection
				ifNotNil: [ 
					secondarySelectionIntervals := (secondarySelection
						reject: [ :i | (findReplaceIntervals includes: i) or: [ i = primary or: [ i first > self text size ] ] ])
						collect: [ :i | i first to: (i last min: self text size) ].
					secondarySelectionIntervals
						do: [ :r | 
							self theme currentSettings haveSecondarySelectionTextColor
								ifTrue: [ self text addAttribute: TextSelectionColor secondarySelection from: r first to: r last ].
							strm
								nextPut:
									(ParagraphSelectionBlock
										first: (self characterBlockForIndex: r first)
										last: (self characterBlockForIndex: r last + 1)
										color: self secondarySelectionColor) ] ] ].
	findReplaceSelectionRegex := nil.
	secondarySelection := nil! !

!Paragraph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/23/2015 13:46'!
displayTextOnAthensCanvas: anAthensCanvas in: aRectangle
	| athensDisplayScanner offset leftInRun |
	anAthensCanvas clipBy: aRectangle during:[
	anAthensCanvas pathTransform
		restoreAfter: [ 
			offset := aRectangle topLeft - positionWhenComposed.
			athensDisplayScanner := AthensDisplayScanner for: self on: anAthensCanvas.
			leftInRun := 0.
			self
				forLinesIn: anAthensCanvas clipRect
				do: [ :line | 
					line first <= line last
						ifTrue: [ leftInRun := athensDisplayScanner displayLine: line offset: offset leftInRun: leftInRun ] ] ] ]! !

!Paragraph methodsFor: 'access' stamp: 'AlainPlantec 11/17/2010 22:58'!
focused
	^ focused ifNil: [focused := false]
! !

!Paragraph methodsFor: 'selection' stamp: 'di 11/30/97 12:10'!
selectionRects
	"Return an array of rectangles representing the selection region."
	selectionStart ifNil: [^ Array new].
	^ self selectionRectsFrom: selectionStart to: selectionStop! !

!Paragraph methodsFor: 'access' stamp: 'di 10/23/97 19:33'!
textStyle: aTextStyle 
	"Set the style by which the receiver should display its text."
	textStyle := aTextStyle! !

!Paragraph methodsFor: 'selection' stamp: 'AlainPlantec 9/15/2011 15:57'!
extraSelectionRects
	"Return an array of rectangles representing the findReplace and the secondary selection regions."
	^ Array streamContents: [:strm |
		extraSelectionBlocks 
			ifNotNil: [:blocks | 
				blocks do: [:selBlock | strm nextPutAll: (self selectionRectsFrom: selBlock first to: selBlock last)]]]
! !

!Paragraph methodsFor: 'alignment' stamp: 'di 10/25/97 19:26'!
justified 
	textStyle justified! !

!Paragraph methodsFor: 'access' stamp: 'FernandoOlivero 6/18/2011 18:38'!
maxRightX
	^ maxRightX! !

!Paragraph methodsFor: 'access' stamp: 'tbn 8/5/2009 09:51'!
showCaret: aBool
	showCaret := aBool
! !

!Paragraph methodsFor: 'access' stamp: 'ThierryGoubier 12/20/2012 22:10'!
secondarySelection
	^ secondarySelection! !

!Paragraph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/14/2015 00:37'!
forLinesIn: aVisibleRect do: aBlock
	(self lineIndexForPoint: aVisibleRect topLeft) to: 
	(self lineIndexForPoint: aVisibleRect bottomRight) do: 
		[:i | aBlock value: (lines at: i) ]! !

!Paragraph methodsFor: 'access' stamp: 'tbn 8/5/2009 09:51'!
showCaret
	^showCaret ifNil:[true]
! !

!Paragraph class methodsFor: 'settings' stamp: 'AlainPlantec 12/19/2009 23:46'!
insertionPointColor: aColor
	InsertionPointColor := aColor! !

!Paragraph class methodsFor: 'settings' stamp: 'FernandoOlivero 9/18/2013 11:15'!
insertionPointColor
	^ InsertionPointColor ifNil: [InsertionPointColor := (Color r: 0.0 g: 0.0 b: 0.8 alpha: 0.8)]! !

!ParagraphSelectionBlock methodsFor: 'accessing' stamp: 'AlainPlantec 11/13/2010 09:13'!
last
	^ last! !

!ParagraphSelectionBlock methodsFor: 'displaying' stamp: 'AlainPlantec 11/13/2010 08:59'!
displayInLine: line on: aCanvas 
	"Display myself in the passed line."
	| startIdx stopIdx leftX rightX |
	startIdx := first stringIndex.
	stopIdx := last stringIndex.
	(stopIdx < line first or: [startIdx > (line last + 1)]) ifTrue: [^self].	"No selection on this line"
	(stopIdx = line first and: [last textLine ~= line]) ifTrue: [^self].	"Selection ends on line above"
	(startIdx = (line last + 1) and: [last textLine ~= line]) ifTrue: [^self].	"Selection begins on line below"
	leftX := (startIdx < line first 
		ifTrue: [line] 
		ifFalse: [first]) left.
	rightX := (stopIdx > (line last + 1) or: [stopIdx = (line last + 1) and: [last textLine ~= line]])  
				ifTrue: [line right]
				ifFalse: [last left].
	aCanvas fillRectangle: (leftX @ line top corner: rightX @ line bottom) color: color! !

!ParagraphSelectionBlock methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/14/2015 00:10'!
displayInLine: line onAthensCanvas: anAthensCanvas
	"Display myself in the passed line."

	| startIdx stopIdx leftX rightX |
	startIdx := first stringIndex.
	stopIdx := last stringIndex.
	(stopIdx < line first or: [ startIdx > (line last + 1) ])
		ifTrue: [ ^ self ].	"No selection on this line"
	(stopIdx = line first and: [ last textLine ~= line ])
		ifTrue: [ ^ self ].	"Selection ends on line above"
	(startIdx = (line last + 1) and: [ last textLine ~= line ])
		ifTrue: [ ^ self ].	"Selection begins on line below"
	leftX := (startIdx < line first
		ifTrue: [ line ]
		ifFalse: [ first ]) left.
	rightX := (stopIdx > (line last + 1) or: [ stopIdx = (line last + 1) and: [ last textLine ~= line ] ])
		ifTrue: [ line right ]
		ifFalse: [ last left ].
	anAthensCanvas setPaint: color.
	anAthensCanvas drawShape: (leftX @ line top corner: rightX @ line bottom)! !

!ParagraphSelectionBlock methodsFor: 'accessing' stamp: 'AlainPlantec 11/13/2010 09:13'!
first
	^ first! !

!ParagraphSelectionBlock methodsFor: 'initialize-release' stamp: 'AlainPlantec 11/13/2010 08:42'!
first: firstCharBlock last: lastCharBlock color: aColor
	first := firstCharBlock.
	last := lastCharBlock.
	color := aColor! !

!ParagraphSelectionBlock class methodsFor: 'instance creation' stamp: 'AlainPlantec 11/13/2010 08:43'!
first: firstCharBlock last: lastCharBlock color: aColor
	^ self new first: firstCharBlock last: lastCharBlock color: aColor! !

!ParseNode commentStamp: '<historical>'!
This superclass of most compiler/decompiler classes declares common class variables, default messages, and the code emitters for jumps. Some of the class variables are initialized here; the rest are initialized in class VariableNode.!
!ParseNode methodsFor: 'testing' stamp: ''!
isVariableReference

	^false! !

!ParseNode methodsFor: 'comment' stamp: ''!
comment: newComment

	comment := newComment! !

!ParseNode methodsFor: 'testing' stamp: 'md 7/27/2006 19:14'!
isMessage
	^false! !

!ParseNode methodsFor: 'testing' stamp: 'ar 11/19/2002 14:58'!
isVariableNode
	^false! !

!ParseNode methodsFor: 'code generation' stamp: 'nk 7/10/2004 10:04'!
pc
	"Used by encoder source mapping."

	^pc ifNil: [ 0 ]
! !

!ParseNode methodsFor: 'testing' stamp: 'MarcusDenker 5/20/2013 15:21'!
isReturn
	^false! !

!ParseNode methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
printSingleComment: aString on: aStream indent: indent 
	"Print the comment string, assuming it has been indented indent tabs.
	Break the string at word breaks, given the widths in the default
	font, at 450 points."

	| readStream word position lineBreak font wordWidth tabWidth spaceWidth lastChar |
	readStream := aString readStream.
	font := TextStyle default defaultFont.
	tabWidth := DefaultTab.
	spaceWidth := font widthOf: Character space.
	position := indent * tabWidth.
	lineBreak := 450.
	[readStream atEnd]
		whileFalse: 
			[word := self nextWordFrom: readStream setCharacter: [:lc | lastChar := lc].
			wordWidth := word inject: 0 into: [:width :char | width + (font widthOf: char)].
			position := position + wordWidth.
			position > lineBreak
				ifTrue: 
					[aStream skip: -1; crtab: indent.
					position := indent * tabWidth + wordWidth + spaceWidth.
					lastChar = Character cr
						ifTrue: [[readStream peekFor: Character tab] whileTrue].
					word isEmpty ifFalse: [aStream nextPutAll: word; space]]
				ifFalse: 
					[aStream nextPutAll: word.
					readStream atEnd
						ifFalse: 
							[position := position + spaceWidth.
							aStream space].
					lastChar = Character cr
						ifTrue: 
							[aStream skip: -1; crtab: indent.
							position := indent * tabWidth.
							[readStream peekFor: Character tab] whileTrue]]]! !

!ParseNode methodsFor: 'testing' stamp: ''!
isUnusedTemp
	^ false! !

!ParseNode methodsFor: 'printing' stamp: 'PeterHugossonMiller 9/3/2009 10:15'!
nodePrintOn: aStrm indent: nn
	| var aaStrm myLine |
	"Show just the sub nodes and the code."

	(aaStrm := aStrm) ifNil: [aaStrm := (String new: 500) writeStream].
	nn timesRepeat: [aaStrm tab].
	aaStrm nextPutAll: self class name; space.
	myLine := self printString copyWithout: Character cr.
	myLine := myLine copyFrom: 1 to: (myLine size min: 70).
	aaStrm nextPutAll: myLine; cr.
	1 to: self class instSize do: [:ii | 
		var := self instVarAt: ii.
		(var respondsTo: #asReturnNode) ifTrue: [var nodePrintOn: aaStrm indent: nn+1]].
	1 to: self class instSize do: [:ii | 
		var := self instVarAt: ii.
		(var isKindOf: SequenceableCollection) ifTrue: [
				var do: [:aNode | 
					(aNode respondsTo: #asReturnNode) ifTrue: [
						aNode nodePrintOn: aaStrm indent: nn+1]]]].
	^ aaStrm
! !

!ParseNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 16:38'!
emitCodeForEffect: stack encoder: encoder

	self emitCodeForValue: stack encoder: encoder.
	encoder genPop.
	stack pop: 1! !

!ParseNode methodsFor: 'comment' stamp: ''!
comment

	^comment! !

!ParseNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 17:13'!
sizeCode: encoder forBranchOn: condition dist: dist
	dist = 0 ifTrue: [^encoder sizePop].
	^condition
		ifTrue: [encoder sizeBranchPopTrue: dist]
		ifFalse: [encoder sizeBranchPopFalse: dist]! !

!ParseNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 16:38'!
emitCodeForReturn: stack encoder: encoder

	self emitCodeForValue: stack encoder: encoder.
	encoder genReturnTop! !

!ParseNode methodsFor: 'visiting' stamp: 'eem 9/6/2009 12:33'!
accept: aVisitor
	"Accept a visitor by double-dispatching to a type-specific method on the visitor, e.g. visitBlockNode:.
	 All such implementations under ParseNode should answer the result of the dispatch, e.g.
		^aVisitor visitBlockNode: self"
	^self subclassResponsibility! !

!ParseNode methodsFor: 'printing' stamp: 'ms 8/1/2006 16:47'!
shortPrintOn: aStream 
	self printOn: aStream indent: 0! !

!ParseNode methodsFor: 'testing' stamp: 'eem 2/3/2011 09:12'!
ensureCanCascade: encoder! !

!ParseNode methodsFor: 'testing' stamp: ''!
assignmentCheck: encoder at: location
	"For messageNodes masquerading as variables for the debugger.
	For now we let this through - ie we allow stores ev
	into args.  Should check against numArgs, though."
	^ -1! !

!ParseNode methodsFor: 'testing' stamp: ''!
isUndefTemp
	^ false! !

!ParseNode methodsFor: 'testing' stamp: ''!
isSpecialConstant
	^ false! !

!ParseNode methodsFor: 'printing' stamp: 'eem 9/5/2009 11:27'!
printCommentOn: aStream indent: indent 
	| thisComment |
	self comment == nil ifTrue: [^ self].
	1 to: self comment size
	   do: [:index |
		index > 1 ifTrue: [aStream crtab: indent].
		aStream nextPut: $".
		thisComment := self comment at: index.
		self printSingleComment: thisComment
			on: aStream
			indent: indent.
		aStream nextPut: $"]! !

!ParseNode methodsFor: 'encoding' stamp: 'MarcusDenker 6/24/2013 11:13'!
encodeSelector: aSelector

	^nil! !

!ParseNode methodsFor: 'private' stamp: 'PeterHugossonMiller 9/3/2009 10:14'!
nextWordFrom: aStream setCharacter: aBlock
	| outStream char |
	outStream := (String new: 16) writeStream.
	[(aStream peekFor: Character space) 
		or: [aStream peekFor: Character tab]] whileTrue.
	[aStream atEnd
		or:
			[char := aStream next.
			char = Character cr or: [char = Character space]]]
		whileFalse: [outStream nextPut: char].
	aBlock value: char.
	^ outStream contents! !

!ParseNode methodsFor: 'testing' stamp: ''!
isMessage: selSymbol receiver: rcvrPred arguments: argsPred
	"See comment in MessageNode."

	^false! !

!ParseNode methodsFor: 'converting' stamp: ''!
asReturnNode

	^ReturnNode new expr: self! !

!ParseNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 14:52'!
emitCodeForBlockValue: stack encoder: encoder
	"Generate code for evaluating the last statement in a block"
	^self emitCodeForValue: stack encoder: encoder! !

!ParseNode methodsFor: 'testing' stamp: ''!
isArg

	^false! !

!ParseNode methodsFor: 'code generation' stamp: 'eem 5/15/2008 09:52'!
sizeCode: encoder forJump: dist

	^dist = 0 ifTrue: [0] ifFalse: [encoder sizeJump: dist]! !

!ParseNode methodsFor: 'testing' stamp: 'md 1/20/2006 16:22'!
isDoIt
	"polymorphic with RBNodes; called by debugger"

	^ false! !

!ParseNode methodsFor: 'testing' stamp: 'tk 8/2/1999 18:39'!
isSelfPseudoVariable	
	"Overridden in VariableNode."
	^false! !

!ParseNode methodsFor: 'testing' stamp: 'eem 6/16/2008 09:37'!
isAssignmentNode
	^false! !

!ParseNode methodsFor: 'testing' stamp: ''!
nowHasRef  "Ignored in all but VariableNode"! !

!ParseNode methodsFor: 'testing' stamp: ''!
canCascade

	^false! !

!ParseNode methodsFor: 'private' stamp: 'ls 1/29/2004 21:17'!
ifNilReceiver
	"assuming this object is the receiver of an ifNil:, what object is being asked about?"
	^self! !

!ParseNode methodsFor: 'printing' stamp: 'NikoSchwarz 6/5/2010 17:48'!
printAsIfCompiledOn: aStream 
	"Refer to the comment in Object|printOn:."
	self printOn: aStream indent: 0.
! !

!ParseNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 16:39'!
emitCodeForJump: dist encoder: encoder

	dist = 0 ifFalse: [encoder genJump: dist]! !

!ParseNode methodsFor: 'testing' stamp: ''!
isConstantNumber  "Overridden in LiteralNode"
	^false! !

!ParseNode methodsFor: 'testing' stamp: ''!
toDoIncrement: ignored
	"Only meant for Messages or Assignments - else return nil"
	^ nil! !

!ParseNode methodsFor: 'testing' stamp: 'John M McIntosh 3/2/2009 19:58'!
isMessageNode
	^false! !

!ParseNode methodsFor: 'visiting' stamp: 'eem 7/20/2009 19:44'!
nodesDo: aBlock
	self accept: (ParseNodeEnumerator ofBlock: aBlock)! !

!ParseNode methodsFor: 'code generation' stamp: 'eem 8/4/2008 13:57'!
pc: anInteger
	"Used by encoder source mapping."

	pc := anInteger! !

!ParseNode methodsFor: 'testing' stamp: 'MarcusDenker 9/20/2013 13:27'!
isLiteralNode
	^false! !

!ParseNode methodsFor: 'testing' stamp: ''!
isReturningIf

	^false! !

!ParseNode methodsFor: 'printing' stamp: 'NikoSchwarz 6/5/2010 17:50'!
printOn: aStream 
	"Refer to the comment in Object|printOn:."

	aStream nextPut: ${.
	self printAsIfCompiledOn: aStream.
	aStream nextPut: $}.! !

!ParseNode methodsFor: 'testing' stamp: 'di 10/12/1999 15:28'!
isTemp
	^ false! !

!ParseNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 16:37'!
emitCodeForBranchOn: condition dist: dist pop: stack encoder: encoder
	stack pop: 1.
	dist = 0 ifTrue: [^encoder genPop].
	condition
		ifTrue: [encoder genBranchPopTrue: dist]
		ifFalse: [encoder genBranchPopFalse: dist]! !

!ParseNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 16:57'!
sizeCodeForReturn: encoder

	^(self sizeCodeForValue: encoder) + encoder sizeReturnTop! !

!ParseNode methodsFor: 'testing' stamp: ''!
isComplex
	"Used for pretty printing to determine whether to start a new line"

	^false! !

!ParseNode methodsFor: 'testing' stamp: 'eem 8/31/2010 11:34'!
isOnlySubnodeOf: aSubtree "<ParseNode>" in: aParseTree "<ParseNode>"
	"Answer if the receiver only occurs within aSubtree of aParseTree, not in the rest of aParseTree.
	 Assumes that aSubtree is in fact a subnode of aParseTree."
	| isSubnode |
	isSubnode := false.
	aSubtree accept: (ParseNodeEnumerator
							ofBlock: [:node| node == self ifTrue: [isSubnode := true]]).
	isSubnode ifFalse:
		[^false].
	aParseTree accept: (ParseNodeEnumerator
							ofBlock: [:node| node == self ifTrue: [^false]]
							select: [:node| node ~= aSubtree]).
	^true! !

!ParseNode methodsFor: 'printing' stamp: ''!
printOn: aStream indent: anInteger 
	"If control gets here, avoid recursion loop."

	super printOn: aStream! !

!ParseNode methodsFor: 'testing' stamp: ''!
isReturnSelf

	^false! !

!ParseNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 14:52'!
sizeCodeForBlockValue: encoder
	"Answer the size for evaluating the last statement in a block"
	^self sizeCodeForValue: encoder! !

!ParseNode methodsFor: 'printing' stamp: ''!
printOn: aStream indent: level precedence: p

	self printOn: aStream indent: level! !

!ParseNode methodsFor: 'testing' stamp: 'ls 1/29/2004 21:11'!
isJust: node
	^false! !

!ParseNode methodsFor: 'testing' stamp: ''!
nowHasDef  "Ignored in all but VariableNode"! !

!ParseNode methodsFor: 'testing' stamp: 'eem 9/25/2008 12:11'!
isBlockNode
	^false! !

!ParseNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 16:53'!
sizeCodeForEffect: encoder

	^(self sizeCodeForValue: encoder) + encoder sizePop! !

!ParseNode class methodsFor: 'accessing' stamp: 'ajh 8/12/2002 11:10'!
blockReturnCode

	^ EndRemote! !

!ParseNode class methodsFor: 'class initialization' stamp: ''!
initialize
	"ParseNode initialize. VariableNode initialize"
	LdInstType := 1.
	LdTempType := 2.
	LdLitType := 3.
	LdLitIndType := 4.
	SendType := 5.
	CodeBases := #(0 16 32 64 208 ).
	CodeLimits := #(16 16 32 32 16 ).
	LdSelf := 112.
	LdTrue := 113.
	LdFalse := 114.
	LdNil := 115.
	LdMinus1 := 116.
	LoadLong := 128.
	Store := 129.
	StorePop := 130.
	ShortStoP := 96.
	SendLong := 131.
	DblExtDoAll := 132.
	SendLong2 := 134.
	LdSuper := 133.
	Pop := 135.
	Dup := 136.
	LdThisContext := 137.
	EndMethod := 124.
	EndRemote := 125.
	Jmp := 144.
	Bfp := 152.
	JmpLimit := 8.
	JmpLong := 164.  "code for jmp 0"
	BtpLong := 168.
	SendPlus := 176.
	Send := 208.
	SendLimit := 16! !

!ParseNode class methodsFor: 'accessing' stamp: 'eem 5/21/2008 13:18'!
pushNilCode

	^LdNil! !

!ParseNode class methodsFor: 'accessing' stamp: 'ajh 8/6/2002 12:04'!
popCode

	^ Pop! !

!ParseNode class methodsFor: 'accessing' stamp: 'eem 8/4/2009 12:34'!
tempSortBlock
	"Answer a block that can sort a set of temporaries into a stable
	 order so that different compilations produce the same results."
	^[:t1 :t2| | be1 be2 bs1 bs2 |
	   t1 index < t2 index "simple sort by index."
	   or: [t1 index = t2 index "complex tie break" 
		  and: [t1 isRemote ~= t2 isRemote
				ifTrue: [t2 isRemote] "put direct temps before indirect temps"
				ifFalse: 
					[((be1 := t1 definingScope blockExtent) isNil
					  or: [(be2 := t2 definingScope blockExtent) isNil])
						ifTrue: [t1 name < t2 name] "only have the name left to go on"
						ifFalse: "put temps from outer scopes before those from inner scopes"
							[(bs1 := be1 first) < (bs2 := be2 first)
							 or: [bs1 = bs2 and: [t1 name < t2 name]]]]]]] "only have the name left to go on"! !

!ParseNodeEnumerator commentStamp: 'eem 8/31/2010 11:41'!
ParseNodeEnumerator implements ParseNode>>nodesDo:.  It can be used to enumerate an entire tree via
	aParseNode accept: (ParseNodeEnumerator ofBlock: aBlock)
or selectively, excluding the node and subnodes for which selectBlock answers false, via
	aParseNode accept: (ParseNodeEnumerator
							ofBlock: aBlock
							select: selectBlock)

Here's a doIt that generates and compiles the visiting methods:

self superclass selectors do:
	[:s|
	self compile: (String streamContents:
		[:str| | arg |
		arg := 'a', (s allButFirst: 5) allButLast.
		str nextPutAll: s, ' ', arg; crtab;
			nextPutAll: '(theSelectBlock isNil or: [theSelectBlock value: '; nextPutAll: arg; nextPutAll: ']) ifFalse:'; crtab;
			tab: 2; nextPutAll: '[^nil].'; crtab;
			nextPutAll: 'theBlock value: '; nextPutAll: arg; nextPut: $.; crtab;
			nextPutAll: '^super '; nextPutAll: s, ' ', arg])]!
!ParseNodeEnumerator methodsFor: 'visiting' stamp: 'eem 8/31/2010 11:13'!
visitCascadeNode: aCascadeNode
	(theSelectBlock isNil or: [theSelectBlock value: aCascadeNode]) ifFalse:
		[^nil].
	theBlock value: aCascadeNode.
	^super visitCascadeNode: aCascadeNode! !

!ParseNodeEnumerator methodsFor: 'visiting' stamp: 'eem 8/31/2010 11:13'!
visitFieldNode: aFieldNode
	(theSelectBlock isNil or: [theSelectBlock value: aFieldNode]) ifFalse:
		[^nil].
	theBlock value: aFieldNode.
	^super visitFieldNode: aFieldNode! !

!ParseNodeEnumerator methodsFor: 'visiting' stamp: 'eem 8/31/2010 11:13'!
visitLiteralVariableNode: aLiteralVariableNode
	(theSelectBlock isNil or: [theSelectBlock value: aLiteralVariableNode]) ifFalse:
		[^nil].
	theBlock value: aLiteralVariableNode.
	^super visitLiteralVariableNode: aLiteralVariableNode! !

!ParseNodeEnumerator methodsFor: 'visiting' stamp: 'eem 8/31/2010 11:13'!
visitMessageNode: aMessageNode
	(theSelectBlock isNil or: [theSelectBlock value: aMessageNode]) ifFalse:
		[^nil].
	theBlock value: aMessageNode.
	^super visitMessageNode: aMessageNode! !

!ParseNodeEnumerator methodsFor: 'visiting' stamp: 'eem 8/31/2010 11:13'!
visitMethodNode: aMethodNode
	(theSelectBlock isNil or: [theSelectBlock value: aMethodNode]) ifFalse:
		[^nil].
	theBlock value: aMethodNode.
	^super visitMethodNode: aMethodNode! !

!ParseNodeEnumerator methodsFor: 'visiting' stamp: 'eem 8/31/2010 11:13'!
visitBlockNode: aBlockNode
	(theSelectBlock isNil or: [theSelectBlock value: aBlockNode]) ifFalse:
		[^nil].
	theBlock value: aBlockNode.
	^super visitBlockNode: aBlockNode! !

!ParseNodeEnumerator methodsFor: 'visiting' stamp: 'eem 8/31/2010 11:13'!
visitNewArrayNode: aNewArrayNode
	(theSelectBlock isNil or: [theSelectBlock value: aNewArrayNode]) ifFalse:
		[^nil].
	theBlock value: aNewArrayNode.
	^super visitNewArrayNode: aNewArrayNode! !

!ParseNodeEnumerator methodsFor: 'visiting' stamp: 'IgorStasenko 1/11/2011 20:52'!
visitInstanceVariableNode: anInstanceVariableNode
	
	(self shouldVisit: anInstanceVariableNode) ifFalse:
		[^nil].
	theBlock value: anInstanceVariableNode.
	^super visitInstanceVariableNode: anInstanceVariableNode! !

!ParseNodeEnumerator methodsFor: 'visiting' stamp: 'eem 8/31/2010 11:13'!
visitSelectorNode: aSelectorNode
	(theSelectBlock isNil or: [theSelectBlock value: aSelectorNode]) ifFalse:
		[^nil].
	theBlock value: aSelectorNode.
	^super visitSelectorNode: aSelectorNode! !

!ParseNodeEnumerator methodsFor: 'visiting' stamp: 'eem 8/31/2010 11:13'!
visitVariableNode: aVariableNode
	(theSelectBlock isNil or: [theSelectBlock value: aVariableNode]) ifFalse:
		[^nil].
	theBlock value: aVariableNode.
	^super visitVariableNode: aVariableNode! !

!ParseNodeEnumerator methodsFor: 'visiting' stamp: 'eem 8/31/2010 11:13'!
visitBraceNode: aBraceNode
	(theSelectBlock isNil or: [theSelectBlock value: aBraceNode]) ifFalse:
		[^nil].
	theBlock value: aBraceNode.
	^super visitBraceNode: aBraceNode! !

!ParseNodeEnumerator methodsFor: 'visiting' stamp: 'eem 8/31/2010 11:13'!
visitFutureNode: aFutureNode
	(theSelectBlock isNil or: [theSelectBlock value: aFutureNode]) ifFalse:
		[^nil].
	theBlock value: aFutureNode.
	^super visitFutureNode: aFutureNode! !

!ParseNodeEnumerator methodsFor: 'visiting' stamp: 'eem 8/31/2010 11:13'!
visitTempVariableNode: aTempVariableNode
	(theSelectBlock isNil or: [theSelectBlock value: aTempVariableNode]) ifFalse:
		[^nil].
	theBlock value: aTempVariableNode.
	^super visitTempVariableNode: aTempVariableNode! !

!ParseNodeEnumerator methodsFor: 'testing' stamp: 'HenrikSperreJohansen 8/31/2010 23:36'!
shouldVisit: aNode
	^theSelectBlock isNil or: [theSelectBlock value: aNode]! !

!ParseNodeEnumerator methodsFor: 'visiting' stamp: 'eem 8/31/2010 11:13'!
visitAssignmentNode: anAssignmentNode
	(theSelectBlock isNil or: [theSelectBlock value: anAssignmentNode]) ifFalse:
		[^nil].
	theBlock value: anAssignmentNode.
	^super visitAssignmentNode: anAssignmentNode! !

!ParseNodeEnumerator methodsFor: 'visiting' stamp: 'eem 8/31/2010 11:13'!
visitRemoteTempVectorNode: aRemoteTempVectorNode
	(theSelectBlock isNil or: [theSelectBlock value: aRemoteTempVectorNode]) ifFalse:
		[^nil].
	theBlock value: aRemoteTempVectorNode.
	^super visitRemoteTempVectorNode: aRemoteTempVectorNode! !

!ParseNodeEnumerator methodsFor: 'visiting' stamp: 'eem 8/31/2010 11:13'!
visitCommentNode: aCommentNode
	(theSelectBlock isNil or: [theSelectBlock value: aCommentNode]) ifFalse:
		[^nil].
	theBlock value: aCommentNode.
	^super visitCommentNode: aCommentNode! !

!ParseNodeEnumerator methodsFor: 'initialize-release' stamp: 'eem 8/31/2010 11:24'!
ofBlock: aBlock select: aSelectBlock
	theBlock := aBlock.
	theSelectBlock := aSelectBlock! !

!ParseNodeEnumerator methodsFor: 'visiting' stamp: 'eem 8/31/2010 11:13'!
visitLiteralNode: aLiteralNode
	(theSelectBlock isNil or: [theSelectBlock value: aLiteralNode]) ifFalse:
		[^nil].
	theBlock value: aLiteralNode.
	^super visitLiteralNode: aLiteralNode! !

!ParseNodeEnumerator methodsFor: 'initialize-release' stamp: 'eem 7/20/2009 19:44'!
ofBlock: aBlock
	theBlock := aBlock! !

!ParseNodeEnumerator methodsFor: 'visiting' stamp: 'eem 8/31/2010 11:13'!
visitMessageNodeInCascade: aMessageNodeInCascade
	(theSelectBlock isNil or: [theSelectBlock value: aMessageNodeInCascade]) ifFalse:
		[^nil].
	theBlock value: aMessageNodeInCascade.
	^super visitMessageNodeInCascade: aMessageNodeInCascade! !

!ParseNodeEnumerator methodsFor: 'visiting' stamp: 'eem 8/31/2010 11:13'!
visitReturnNode: aReturnNode
	(theSelectBlock isNil or: [theSelectBlock value: aReturnNode]) ifFalse:
		[^nil].
	theBlock value: aReturnNode.
	^super visitReturnNode: aReturnNode! !

!ParseNodeEnumerator class methodsFor: 'instance creation' stamp: 'eem 7/20/2009 19:45'!
ofBlock: aBlock
	^self new ofBlock: aBlock! !

!ParseNodeEnumerator class methodsFor: 'instance creation' stamp: 'eem 8/31/2010 11:43'!
ofBlock: aBlock select: selectBlock
	^self new ofBlock: aBlock select: selectBlock! !

!ParseNodeVisitor commentStamp: '<historical>'!
I am an abstract superclass for ParseNode visitors that functions as a null visitor.  Here's the code that defines my interface:

(SystemNavigation new allImplementorsOf: #accept: localTo: ParseNode) do:
	[:methodReference|
	methodReference compiledMethod messages do:
		[:sel|
		((sel beginsWith: 'visit')
		and: [sel numArgs = 1]) ifTrue:
			[ParseNodeVisitor
				compile: (String streamContents:
							[:str|
							str nextPutAll: sel;
								space;
								nextPut: $a.
							methodReference classSymbol first isVowel ifTrue:
								[str nextPut: $n].
							str nextPutAll: methodReference classSymbol])
				classified: 'visiting']]]!
!ParseNodeVisitor methodsFor: 'visiting' stamp: 'eem 9/10/2008 16:13'!
visitCascadeNode: aCascadeNode
	aCascadeNode receiver accept: self.
	aCascadeNode messages do:
		[:message| self visitMessageNodeInCascade: message]! !

!ParseNodeVisitor methodsFor: 'visiting' stamp: 'eem 5/30/2008 10:07'!
visitFieldNode: aFieldNode! !

!ParseNodeVisitor methodsFor: 'visiting' stamp: 'eem 5/30/2008 10:07'!
visitLiteralVariableNode: aLiteralVariableNode! !

!ParseNodeVisitor methodsFor: 'visiting' stamp: 'eem 9/5/2009 20:08'!
visitMessageNode: aMessageNode
	aMessageNode receiver accept: self.
	"receiver notNil ifTrue: ''receiver is nil for cascades''
		[receiver accept: self]."
	aMessageNode selector accept: self.
	aMessageNode argumentsInEvaluationOrder do:
		[:argument| argument accept: self]! !

!ParseNodeVisitor methodsFor: 'visiting' stamp: 'eem 9/10/2008 15:53'!
visitMethodNode: aMethodNode
	aMethodNode block accept: self! !

!ParseNodeVisitor methodsFor: 'visiting' stamp: 'eem 9/10/2008 15:13'!
visitBlockNode: aBlockNode
	aBlockNode statements do:
		[:statement| statement accept: self]! !

!ParseNodeVisitor methodsFor: 'visiting' stamp: 'eem 5/30/2008 10:07'!
visitNewArrayNode: aNewArrayNode! !

!ParseNodeVisitor methodsFor: 'visiting' stamp: 'eem 5/30/2008 10:07'!
visitInstanceVariableNode: anInstanceVariableNode! !

!ParseNodeVisitor methodsFor: 'visiting' stamp: 'eem 5/30/2008 10:07'!
visitSelectorNode: aSelectorNode! !

!ParseNodeVisitor methodsFor: 'visiting' stamp: 'eem 5/30/2008 10:32'!
visitVariableNode: aVariableNode! !

!ParseNodeVisitor methodsFor: 'visiting' stamp: 'eem 9/10/2008 15:14'!
visitBraceNode: aBraceNode
	aBraceNode elements do:
		[:element| element accept: self]! !

!ParseNodeVisitor methodsFor: 'visiting' stamp: 'eem 5/30/2008 10:07'!
visitTempVariableNode: aTempVariableNode! !

!ParseNodeVisitor methodsFor: 'visiting' stamp: 'eem 9/10/2008 15:10'!
visitAssignmentNode: anAssignmentNode
	"N.B.  since assigment happens after the value is evaluated the value is visited first."
	anAssignmentNode value accept: self.
	anAssignmentNode variable accept: self! !

!ParseNodeVisitor methodsFor: 'visiting' stamp: 'eem 5/30/2008 10:07'!
visitRemoteTempVectorNode: aRemoteTempVectorNode! !

!ParseNodeVisitor methodsFor: 'visiting' stamp: 'eem 5/30/2008 10:07'!
visitCommentNode: aCommentNode! !

!ParseNodeVisitor methodsFor: 'visiting' stamp: 'eem 5/30/2008 10:07'!
visitLiteralNode: aLiteralNode! !

!ParseNodeVisitor methodsFor: 'visiting' stamp: 'eem 2/9/2009 10:04'!
visitMessageNodeInCascade: aMessageNode
	"receiver is nil for cascades"
	aMessageNode selector accept: self.
	aMessageNode argumentsInEvaluationOrder do:
		[:argument| argument accept: self]! !

!ParseNodeVisitor methodsFor: 'visiting' stamp: 'eem 9/10/2008 15:53'!
visitReturnNode: aReturnNode
	aReturnNode expr accept: self! !

!ParseStack commentStamp: '<historical>'!
I keep track of the current and high position of the stack that will be needed by code being compiled.!
!ParseStack methodsFor: 'accessing' stamp: ''!
pop: n

	(position := position - n) < 0 
		ifTrue: [self error: 'Parse stack underflow']! !

!ParseStack methodsFor: 'accessing' stamp: ''!
size

	^length! !

!ParseStack methodsFor: 'printing' stamp: ''!
printOn: aStream
	
	super printOn: aStream.
	aStream nextPutAll: ' at '; print: position; nextPutAll: ' of '; print: length! !

!ParseStack methodsFor: 'results' stamp: ''!
position

	^position! !

!ParseStack methodsFor: 'accessing' stamp: ''!
push: n

	(position := position + n) > length 
		ifTrue: [length := position]! !

!ParseStack methodsFor: 'initialization' stamp: ''!
init

	length := position := 0! !

!ParseStack methodsFor: 'accessing' stamp: 'eem 9/12/2008 10:31'!
position: n 
	(position := n) > length
		ifTrue: [length := position]! !

!Parser commentStamp: '<historical>'!
I parse Smalltalk syntax and create a MethodNode that is the root of the parse tree. I look one token ahead.!
!Parser methodsFor: 'scanning' stamp: 'nice 2/9/2012 14:02'!
advance
	| this |
	prevMark := hereMark.
	prevEnd := hereEnd.
	this := here.
	here := token.
	hereType := tokenType.
	hereMark := mark.
	hereEnd := source position - (aheadChar == DoItCharacter
		ifTrue: [hereChar == DoItCharacter
			ifTrue: [0]
			ifFalse: [1]]
		ifFalse: [2]).
	self scanToken.
	"Transcript show: 'here: ', here printString, ' mark: ', hereMark printString, ' end: ', hereEnd printString; cr."
	^this! !

!Parser methodsFor: 'primitives' stamp: 'lr 9/29/2010 08:12'!
primitive: anIntegerOrString
	"Create indexed primitive."
	
	<primitive>
	^self primitive: anIntegerOrString error: nil! !

!Parser methodsFor: 'expression types' stamp: 'StephaneDucasse 3/25/2011 17:54'!
pattern: fromDoit inContext: ctxt
	" unarySelector | binarySelector arg | keyword arg {keyword arg} =>
	{selector, arguments, precedence}."
	| args selector |
	doitFlag := fromDoit.
	fromDoit ifTrue:
		[^ctxt == nil
			ifTrue: [{#DoIt. {}. 1}]
			ifFalse: [{#DoItIn:. {encoder encodeVariable: encoder doItInContextName}. 3}]].

	hereType == #word ifTrue: [^ {self advance asSymbol. {}. 1}].

	(hereType == #binary or: [hereType == #verticalBar]) ifTrue: 
		[selector := self advance asSymbol.
		args := Array with: (encoder bindArg: self argumentName).
		^ {selector. args. 2}].

	hereType == #keyword ifTrue: 
		[selector := (String new: 32) writeStream.
		args := OrderedCollection new.
		[hereType == #keyword] whileTrue:[
			selector nextPutAll: self advance.
			args addLast: (encoder bindArg: self argumentName).
		].
		^ {selector contents asSymbol. args. 3}].
	^self expected: 'Message pattern'! !

!Parser methodsFor: 'expression types' stamp: ''!
argumentName

	hereType == #word
		ifFalse: [^self expected: 'Argument name'].
	^self advance! !

!Parser methodsFor: 'error handling' stamp: 'CamilloBruni 2/8/2012 23:20'!
notify: string at: location
	requestor isNil
		ifTrue: [(encoder == self or: [encoder isNil]) ifTrue: [^ self fail  "failure setting up syntax error"].
				SyntaxErrorNotification
					inClass: encoder classEncoding
					category: category
					withCode: source contents
					doitFlag: doitFlag
					errorMessage: string
					location: location]
		ifFalse: [requestor
					notify: string , ' ->'
					at: location
					in: source].
	^self fail! !

!Parser methodsFor: 'scanning' stamp: ''!
match: type 
	"Answer with true if next tokens type matches."

	hereType == type
		ifTrue: 
			[self advance.
			^true].
	^false! !

!Parser methodsFor: 'temps' stamp: ''!
bindArg: name

	^ self bindTemp: name! !

!Parser methodsFor: 'error correction' stamp: 'cwp 10/15/2007 22:58'!
possibleVariablesFor: proposedVariable 
	^encoder possibleVariablesFor: proposedVariable! !

!Parser methodsFor: 'primitives' stamp: 'ar 12/2/1999 16:49'!
externalType: descriptorClass
	"Parse an return an external type"
	| xType |
	xType := descriptorClass atomicTypeNamed: here.
	xType == nil ifTrue:["Look up from class scope"
		Symbol hasInterned: here ifTrue:[:sym|
			xType := descriptorClass structTypeNamed: sym]].
	xType == nil ifTrue:[
		"Raise an error if user is there"
		self interactive ifTrue:[^nil].
		"otherwise go over it silently"
		xType := descriptorClass forceTypeNamed: here].
	self advance.
	(self matchToken:#*)
		ifTrue:[^xType asPointerType]
		ifFalse:[^xType]! !

!Parser methodsFor: 'expression types' stamp: 'eem 2/3/2011 09:50'!
cascade
	" {; message} => CascadeNode."

	| rcvr msgs |
	parseNode canCascade ifFalse:
		[^self expected: 'Cascading not'].
	parseNode ensureCanCascade: encoder.
	rcvr := parseNode cascadeReceiver.
	msgs := OrderedCollection with: parseNode.
	[self match: #semicolon]
		whileTrue: 
			[parseNode := rcvr.
			(self messagePart: 3 repeat: false)
				ifFalse: [^self expected: 'Cascade'].
			parseNode canCascade ifFalse:
				[^self expected: '<- No special messages'].
			parseNode ensureCanCascade: encoder.
				parseNode cascadeReceiver.
			msgs addLast: parseNode].
	parseNode := CascadeNode new receiver: rcvr messages: msgs! !

!Parser methodsFor: 'error correction' stamp: 'nice 4/4/2010 21:45'!
ambiguousSelector: aString inRange: anInterval
	| correctedSelector userSelection offset intervalWithOffset |
	
	self interactive ifFalse: [
		"In non interactive mode, break backward compatibility: $- is part of selector"
		Transcript cr; nextPutAll: encoder classEncoding storeString; nextPutAll:#'>>'; nextPutAll: encoder selector storeString; show: ' will send ' , token , '-'.
		^super ambiguousSelector: aString inRange: anInterval].
	
	"handle the text selection"
	userSelection := requestor selectionInterval.
	intervalWithOffset := anInterval first + requestorOffset to: anInterval last + requestorOffset.
	requestor selectFrom: intervalWithOffset first to: intervalWithOffset last.
	requestor select.

	"Build the menu with alternatives"
	correctedSelector := AmbiguousSelector 
			signalName: aString
			inRange: intervalWithOffset.
	correctedSelector ifNil: [^self fail].

	"Execute the selected action"
	offset := self substituteWord: correctedSelector wordInterval: intervalWithOffset offset: 0.
	requestor deselect.
	requestor selectInvisiblyFrom: userSelection first to: userSelection last + offset.
	token := (correctedSelector readStream upTo: Character space) asSymbol! !

!Parser methodsFor: 'expression types' stamp: 'eem 5/30/2008 11:51'!
statements: argNodes innerBlock: inner

	^self statements: argNodes innerBlock: inner blockNode: BlockNode new! !

!Parser methodsFor: 'primitives' stamp: 'lr 9/29/2010 08:13'!
primitive: aNameString module: aModuleStringOrNil error: errorCodeVariableOrNil
	"Create named primitive with optional error code."
	
	<primitive>
	(aNameString isString and: [ aModuleStringOrNil isNil or: [ aModuleStringOrNil isString ] ])
		ifFalse: [ ^ self expected: 'Named primitive' ].
	self allocateLiteral: (Array 
		with: (aModuleStringOrNil isNil 
			ifFalse: [ aModuleStringOrNil asSymbol ])
		with: aNameString asSymbol
		with: 0 with: 0).
	errorCodeVariableOrNil ifNotNil:
		[encoder floatTemp: (encoder bindTemp: errorCodeVariableOrNil) nowHasDef].
	^117! !

!Parser methodsFor: 'error correction' stamp: 'StephaneDucasse 8/27/2010 11:33'!
declareInstVar: name
	"Declare an instance variable.  Since the variable will get added after any existing
	 inst vars its index is the instSize."
	encoder classEncoding addInstVarNamed: name.
	^InstanceVariableNode new name: name index: encoder classEncoding instSize
		! !

!Parser methodsFor: 'expression types' stamp: 'nice 3/5/2010 23:17'!
method: doit context: ctxt
	" pattern [ | temporaries ] block => MethodNode."

	| sap blk prim temps messageComment methodNode |
	properties := AdditionalMethodState new.
	sap := self pattern: doit inContext: ctxt.
	"sap={selector, arguments, precedence}"
	properties selector: (sap at: 1).
	encoder selector: (sap at: 1).
	(sap at: 2) do: [:argNode | argNode beMethodArg].
	doit ifFalse: [self pragmaSequence].
	temps := self temporaries.
	messageComment := currentComment.
	currentComment := nil.
	doit ifFalse: [self pragmaSequence].
	prim := self pragmaPrimitives.
	self statements: #() innerBlock: doit.
	blk := parseNode.
	doit ifTrue: [blk returnLast]
		ifFalse: [blk returnSelfIfNoOther: encoder].
	hereType == #doIt ifFalse: [^self expected: 'Nothing more'].
	self interactive ifTrue: [self removeUnusedTemps].
	methodNode := self newMethodNode comment: messageComment.
	^methodNode
		selector: (sap at: 1)
		arguments: (sap at: 2)
		precedence: (sap at: 3)
		temporaries: temps
		block: blk
		encoder: encoder
		primitive: prim
		properties: properties! !

!Parser methodsFor: 'private' stamp: 'nice 2/23/2010 17:48'!
init: sourceStream notifying: req failBlock: aBlock

	requestor := req.
	failBlock := aBlock.
	requestorOffset := 0.
	super scan: sourceStream.
	prevMark := hereMark := mark.
	self advance! !

!Parser methodsFor: 'pragmas' stamp: 'StephaneDucasse 6/2/2010 09:58'!
properties
	^ properties ifNil: [ properties := AdditionalMethodState new ]! !

!Parser methodsFor: 'expression types' stamp: 'di 11/19/1999 07:43'!
expression

	(hereType == #word and: [tokenType == #leftArrow])
		ifTrue: [^ self assignment: self variable].
	hereType == #leftBrace
		ifTrue: [self braceExpression]
		ifFalse: [self primaryExpression ifFalse: [^ false]].
	(self messagePart: 3 repeat: true)
		ifTrue: [hereType == #semicolon ifTrue: [self cascade]].
	^ true! !

!Parser methodsFor: 'private' stamp: 'PeterHugossonMiller 9/2/2009 16:11'!
initPattern: aString notifying: req return: aBlock

	| result |
	self
		init: aString asString readStream
		notifying: req
		failBlock: [^nil].
	encoder := self.
	result := aBlock value: (self pattern: false inContext: nil).
	encoder := failBlock := nil.  "break cycles"
	^result! !

!Parser methodsFor: 'error handling' stamp: ''!
notify: aString 
	"Notify problem at token before 'here'."

	^self notify: aString at: prevMark + requestorOffset! !

!Parser methodsFor: 'expression types' stamp: 'eem 7/20/2009 12:09'!
blockExpression
	"[ ({:var} |) (| {temps} |) (statements) ] => BlockNode."

	| blockNode variableNodes temporaryBlockVariables start |
	blockNode := BlockNode new.
	variableNodes := OrderedCollection new.
	start := prevMark + requestorOffset.
	"Gather parameters."
	[self match: #colon] whileTrue:
		[variableNodes addLast: (encoder bindBlockArg: self argumentName within: blockNode)].
	(variableNodes size > 0 & (hereType ~~ #rightBracket) and: [(self match: #verticalBar) not]) ifTrue:
		[^self expected: 'Vertical bar'].

	temporaryBlockVariables := self temporaryBlockVariablesFor: blockNode.
	self statements: variableNodes innerBlock: true blockNode: blockNode.
	blockNode temporaries: temporaryBlockVariables.

	(self match: #rightBracket) ifFalse: [^self expected: 'Period or right bracket'].

	blockNode noteSourceRangeStart: start end: self endOfLastToken encoder: encoder.

	"The scope of the parameters and temporary block variables is no longer active."
	temporaryBlockVariables do: [:variable | variable scope: -1].
	variableNodes do: [:variable | variable scope: -1]! !

!Parser methodsFor: 'error correction' stamp: 'BenjaminVanRyseghem 12/20/2012 14:47'!
correctVariable: proposedVariable interval: spot 
	"Correct the proposedVariable to a known variable, or declare it as a new
	variable if such action is requested.  We support declaring lowercase
	variables as temps or inst-vars, and uppercase variables as Globals or 
	ClassVars, depending on whether the context is nil (class=UndefinedObject).
	Spot is the interval within the test stream of the variable. "

	"Check if this is an i-var, that has been corrected already (ugly)"

	"Display the pop-up menu"

	| tempIvar binding userSelection action |
	(encoder classEncoding instVarNames includes: proposedVariable) ifTrue: 
		[^InstanceVariableNode new 
			name: proposedVariable
			index: (encoder classEncoding allInstVarNames indexOf: proposedVariable)].

	"If we can't ask the user for correction, make it undeclared"
	self interactive ifFalse: [^encoder undeclared: proposedVariable].

	"First check to see if the requestor knows anything about the variable"
	tempIvar := proposedVariable first isLowercase.
	(tempIvar and: [(binding := requestor bindingOf: proposedVariable) notNil]) 
		ifTrue: [^encoder global: binding name: proposedVariable].
	userSelection := requestor selectionInterval.
	requestor selectFrom: spot first to: spot last.
	"requestor select."

	"Build the menu with alternatives"
	action := UndeclaredVariable 
				signalFor: self
				name: proposedVariable
				inRange: spot.
	action ifNil: [^self fail].

	"Execute the selected action"
	requestor deselect.
	requestor selectInvisiblyFrom: userSelection first to: userSelection last.

	^action value! !

!Parser methodsFor: 'expression types' stamp: 'di 3/8/2000 09:36'!
braceExpression
	" { elements } => BraceNode."

	| elements locations loc more |
	elements := OrderedCollection new.
	locations := OrderedCollection new.
	self advance.
	more := hereType ~~ #rightBrace.
	[more]
		whileTrue: 
			[loc := hereMark + requestorOffset.
			self expression
				ifTrue: 
					[elements addLast: parseNode.
					locations addLast: loc]
				ifFalse:
					[^self expected: 'Variable or expression'].
			(self match: #period)
				ifTrue: [more := hereType ~~ #rightBrace]
				ifFalse: [more := false]].
	parseNode := BraceNode new elements: elements sourceLocations: locations.
	(self match: #rightBrace)
		ifFalse: [^self expected: 'Period or right brace'].
	^true! !

!Parser methodsFor: 'public access' stamp: 'jmv 3/2/2010 17:11'!
encoderClass: anEncoderClass
	encoder ifNotNil: [
		self error: 'encoder already set'].
	encoder := anEncoderClass new! !

!Parser methodsFor: 'expression types' stamp: 'di 12/4/1999 21:04'!
variable

	| varName varStart varEnd |
	varStart := self startOfNextToken + requestorOffset.
	varName := self advance.
	varEnd := self endOfLastToken + requestorOffset.
	^ encoder encodeVariable: varName
		sourceRange: (varStart to: varEnd)
		ifUnknown: [self correctVariable: varName interval: (varStart to: varEnd)]! !

!Parser methodsFor: 'primitives' stamp: ''!
allocateLiteral: lit
	encoder litIndex: lit! !

!Parser methodsFor: 'error correction' stamp: 'nice 1/5/2010 15:59'!
removeUnusedTemps
	"Scan for unused temp names, and prompt the user about the prospect of removing each one found"

	| str madeChanges | 
	"I disabled this option. I keep the old code just in case - Hernan Wilkinson"
	self warns ifFalse: [ ^ self ].
	
	madeChanges := false.
	str := requestor text asString.
	((tempsMark between: 1 and: str size)
		and: [(str at: tempsMark) = $|]) ifFalse: [^ self].
	encoder unusedTempNames do:
		[:temp | | start end |
		(UnusedVariable name: temp) ifTrue:
			[(encoder encodeVariable: temp) isUndefTemp
				ifTrue:
					[end := tempsMark.
					["Beginning at right temp marker..."
					start := end - temp size + 1.
					end < temp size or: [temp = (str copyFrom: start to: end)
							and: [(str at: start-1) isSeparator & (str at: end+1) isSeparator]]]
						whileFalse:
							["Search left for the unused temp"
							end := requestor nextTokenFrom: end direction: -1].
					end < temp size ifFalse:
						[(str at: start-1) = $  ifTrue: [start := start-1].
						requestor correctFrom: start to: end with: ''.
						str := str copyReplaceFrom: start to: end with: ''. 
						madeChanges := true.
						tempsMark := tempsMark - (end-start+1)]]
				ifFalse:
					[self inform:
'You''ll first have to remove the\statement where it''s stored into' withCRs]]].
	madeChanges ifTrue: [ReparseAfterSourceEditing signal]! !

!Parser methodsFor: 'error handling' stamp: 'HenrikSperreJohansen 5/31/2010 14:49'!
fail

	| exitBlock |
	(encoder isNil or: [encoder == self])
		ifFalse: [encoder release. encoder := nil]. "break cycle"
	exitBlock := failBlock.
	failBlock := nil.
	^exitBlock value! !

!Parser methodsFor: 'primitives' stamp: 'lr 9/29/2010 08:12'!
primitive: aNameString error: errorCodeVariableOrNil module: aModuleStringOrNil
	"Create named primitive with optional error code."
	
	<primitive>
	^self primitive: aNameString module: aModuleStringOrNil error: errorCodeVariableOrNil! !

!Parser methodsFor: 'expression types' stamp: 'ar 1/4/2002 00:23'!
temporaries
	" [ '|' (variable)* '|' ]"
	| vars theActualText |
	(self match: #verticalBar) ifFalse: 
		["no temps"
		doitFlag ifTrue: [self interactive
				ifFalse: [tempsMark := 1]
				ifTrue: [tempsMark := requestor selectionInterval first].
			^ #()].
		tempsMark := (prevEnd ifNil: [0]) + 1.
		tempsMark := hereMark	"formerly --> prevMark + prevToken".

		tempsMark > 0 ifTrue:
			[theActualText := source contents.
			[tempsMark < theActualText size and: [(theActualText at: tempsMark) isSeparator]]
				whileTrue: [tempsMark := tempsMark + 1]].
			^ #()].
	vars := OrderedCollection new.
	[hereType == #word]
		whileTrue: [vars addLast: (encoder bindTemp: self advance)].
	(self match: #verticalBar) ifTrue: 
		[tempsMark := prevMark.
		^ vars].
	^ self expected: 'Vertical bar'
! !

!Parser methodsFor: 'public access' stamp: 'nice 8/27/2010 20:54'!
encoder
	^encoder ifNil:
		[encoder := EncoderForV3PlusClosures new]! !

!Parser methodsFor: 'public access' stamp: 'eem 8/20/2008 20:55'!
parseSelector: aString 
	"Answer the message selector for the argument, aString, which should 
	 parse successfully up to the temporary declaration or the end of the 
	 method header."

	self initScannerForTokenization.
	^self
		initPattern: aString
		notifying: nil
		return: [:pattern | pattern at: 1]! !

!Parser methodsFor: 'expression types' stamp: 'eem 6/2/2009 10:26'!
assignment: varNode
	" var ':=' expression => AssignmentNode."
	| loc start |
	(loc := varNode assignmentCheck: encoder at: prevMark + requestorOffset) >= 0
		ifTrue: [^self notify: 'Cannot store into' at: loc].
	start := self startOfNextToken.
	self advance.
	self expression ifFalse: [^self expected: 'Expression'].
	parseNode := AssignmentNode new
				variable: varNode
				value: parseNode
				from: encoder
				sourceRange: (start to: self endOfLastToken).
	varNode nowHasDef.
	^true! !

!Parser methodsFor: 'expression types' stamp: 'eem 5/13/2008 14:32'!
temporariesIn: methodSelector
	" [ '|' (variable)* '|' ]"
	| vars theActualText |
	(self match: #verticalBar) ifFalse: 
		["no temps"
		doitFlag ifTrue: [self interactive
				ifFalse: [tempsMark := 1]
				ifTrue: [tempsMark := requestor selectionInterval first].
			^ #()].
		tempsMark := (prevEnd ifNil: [0]) + 1.
		tempsMark := hereMark	"formerly --> prevMark + prevToken".

		tempsMark > 0 ifTrue:
			[theActualText := source contents.
			[tempsMark < theActualText size and: [(theActualText at: tempsMark) isSeparator]]
				whileTrue: [tempsMark := tempsMark + 1]].
			^ #()].
	vars := OrderedCollection new.
	[hereType == #word]
		whileTrue: [vars addLast: (encoder bindTemp: self advance in: methodSelector)].
	(self match: #verticalBar) ifTrue: 
		[tempsMark := prevMark.
		^ vars].
	^ self expected: 'Vertical bar'! !

!Parser methodsFor: 'expression types' stamp: 'lr 3/12/2010 21:15'!
statements: argNodes innerBlock: inner blockNode: theBlockNode

	| stmts returns start |
	"give initial comment to block, since others trail statements"
	theBlockNode comment: currentComment.
	stmts := OrderedCollection new.
	returns := false.
	hereType ~~ #rightBracket ifTrue:
		[[theBlockNode startOfLastStatement: (start := self startOfNextToken).
		  (returns := self matchReturn)
			ifTrue: 
				[self expression ifFalse:
					[^self expected: 'Expression to return'].
				 self addComment.
				 stmts addLast: (parseNode isReturningIf
								ifTrue: [parseNode]
								ifFalse: [ReturnNode new
											expr: parseNode
											encoder: encoder
											sourceRange: (start to: self endOfLastToken)])]
			ifFalse: 
				[self expression
					ifTrue: 
						[self addComment.
						 stmts addLast: parseNode]
					ifFalse: 
						[self addComment.
						 stmts size = 0 ifTrue: 
							[stmts addLast: 
								(encoder encodeVariable:
									(inner ifTrue: ['nil'] ifFalse: ['self']))]]].
		  returns ifTrue: 
			[self match: #period.
			 (hereType == #rightBracket or: [hereType == #doIt]) ifFalse:
				[^self expected: 'End of block']].
		  returns not and: [self match: #period]] whileTrue].
	(inner and: [argNodes size > 0 and: [stmts isEmpty]]) ifTrue: [
		"A ST-80 empty block should return nil"
		stmts addLast: (encoder encodeVariable: 'nil' sourceRange: nil ifUnknown: [self error: 'Compiler internal error'])].
	theBlockNode
		arguments: argNodes
		statements: stmts
		returns: returns
		from: encoder.
	parseNode := theBlockNode.
	^true! !

!Parser methodsFor: 'private' stamp: ''!
addComment

	parseNode ~~ nil
		ifTrue: 
			[parseNode comment: currentComment.
			currentComment := nil]! !

!Parser methodsFor: 'pragmas' stamp: 'mha 9/1/2009 16:32'!
pragmaStatement
	"Read a single pragma statement. Parse all generic pragmas in the form of: <key1: val1 key2: val2 ...> and remember them, including primitives."
	
	| selector arguments words index keyword |
	(hereType = #keyword or: [ hereType = #word or: [ hereType = #binary ] ])
		ifFalse: [  ^ self expected: 'pragma declaration' ].

	" This is a ugly hack into the compiler of the FFI package. FFI should be changed to use propre pragmas that can be parsed with the code here. "
	(here = #apicall: or: [ here = #cdecl: ])
		ifTrue: [ ^ self externalFunctionDeclaration ].

	selector := String new.
	arguments := OrderedCollection new.
	words := OrderedCollection new.
	[ hereType = #keyword or: [ (hereType = #word or: [ hereType = #binary ]) and: [ selector isEmpty ] ] ] whileTrue: [
		index := self startOfNextToken + requestorOffset.
		selector := selector , self advance.
		words add: (index to: self endOfLastToken + requestorOffset).
		(selector last = $: or: [ selector first isLetter not ])
			ifTrue: [ arguments add: (self pragmaLiteral: selector) ] ].
	selector numArgs ~= arguments size
		ifTrue: [ ^ self expected: 'pragma argument' ].
	(Symbol hasInterned: selector 
		ifTrue: [ :value | keyword := value]) 
		ifFalse: [ 
			keyword := self 
				correctSelector: selector wordIntervals: words
				exprInterval: (words first first to: words last last)
				ifAbort: [ ^ self fail ] ].
	self addPragma: (Pragma keyword: keyword arguments: arguments asArray).
	^ true! !

!Parser methodsFor: 'expression types' stamp: 'nice 3/5/2010 22:16'!
primaryExpression 
	hereType == #word 
		ifTrue: 
			[parseNode := self variable.
			(parseNode isUndefTemp and: [self interactive])
				ifTrue: [ self warns ifTrue: [self queryUndefined]].
			parseNode nowHasRef.
			^ true].
	hereType == #leftBracket
		ifTrue: 
			[self advance.
			self blockExpression.
			^true].
	hereType == #leftBrace
		ifTrue: 
			[self braceExpression.
			^true].
	hereType == #leftParenthesis
		ifTrue: 
			[self advance.
			self expression ifFalse: [^self expected: 'expression'].
			(self match: #rightParenthesis)
				ifFalse: [^self expected: 'right parenthesis'].
			^true].
	(hereType == #string or: [hereType == #number or: [hereType == #literal]])
		ifTrue: 
			[parseNode := encoder encodeLiteral: self advance.
			^true].
	(here == #- and: [tokenType == #number and: [1 + hereEnd = mark]])
		ifTrue: 
			[self advance.
			parseNode := encoder encodeLiteral: self advance negated.
			^true].
	^false! !

!Parser methodsFor: 'expression types' stamp: 'eem 5/30/2008 14:16'!
temporaryBlockVariablesFor: aBlockNode
	"Scan and answer temporary block variables."

	| variables |
	(self match: #verticalBar) ifFalse:
		"There are't any temporary variables."
		[^#()].

	variables := OrderedCollection new.
	[hereType == #word] whileTrue:
		[variables addLast: (encoder bindBlockTemp: self advance within: aBlockNode)].
	^(self match: #verticalBar)
		ifTrue: [variables]
		ifFalse: [self expected: 'Vertical bar']! !

!Parser methodsFor: 'error handling' stamp: 'nice 2/22/2012 02:49'!
expected: aString 
	"Notify a problem at token 'here'."

	^ self notify: aString , ' expected' at: hereMark + requestorOffset! !

!Parser methodsFor: 'error correction' stamp: ''!
substituteSelector: selectorParts wordIntervals: spots
	"Substitute the correctSelector into the (presuamed interactive) receiver."
	| offset |
	offset := 0.
	selectorParts with: spots do:
		[ :word :interval |
		offset := self substituteWord: word wordInterval: interval offset: offset ]
! !

!Parser methodsFor: 'pragmas' stamp: 'lr 9/29/2010 08:25'!
pragmaPrimitives
	| primitiveSelectors primitives |
	properties isEmpty ifTrue:
		[^0].
	primitiveSelectors := self class primitivePragmaSelectors.
	primitives := properties pragmas select:
					[:pragma|
					primitiveSelectors includes: pragma keyword].
	primitives isEmpty ifTrue:
		[^0].
	primitives size > 1 ifTrue:
		[^self notify: 'Ambigous primitives'].
	^self perform: primitives first keyword withArguments: primitives first arguments! !

!Parser methodsFor: 'private' stamp: 'MarcusDenker 4/27/2013 08:45'!
warns
	"return whether the parser will ask the user for correction"
	^ true! !

!Parser methodsFor: 'error correction' stamp: 'eem 9/5/2009 14:41'!
substituteVariable: each atInterval: anInterval 
	self 
		substituteWord: each
		wordInterval: anInterval
		offset: 0.
	^encoder encodeVariable: each! !

!Parser methodsFor: 'scanning' stamp: 'di 6/7/2000 08:44'!
matchReturn

	^ self match: #upArrow! !

!Parser methodsFor: 'error correction' stamp: 'StephaneDucasse 8/27/2010 10:54'!
declareClassVar: name
	| sym class |
	sym := name asSymbol.
	class := encoder classEncoding.
	class := class theNonMetaClass.		"not the metaclass"
	class addClassVarNamed: name.
	^ encoder global: (class classPool associationAt: sym)
			name: sym! !

!Parser methodsFor: 'public access' stamp: 'pavel.krivanek 3/12/2009 09:40'!
parse: sourceStreamOrString class: behavior

	^ self parse: sourceStreamOrString readStream class: behavior
		noPattern: false context: nil notifying: nil ifFail: [ self fail ]! !

!Parser methodsFor: 'error correction' stamp: 'MarcusDenker 5/2/2013 11:34'!
defineClass: className 
	"Prompts the user to define a new class."
	
	| classSymbol systemCategory classDefinition |
	classSymbol := className asSymbol.
	systemCategory := self encoder classEncoding theNonMetaClass category
		ifNil: [ 'Unknown' ].
	classDefinition := 'Object subclass: #' , classSymbol , '
		instanceVariableNames: '''' 
		classVariableNames: ''''
		poolDictionaries: ''''
		category: ''' , systemCategory , ''''.
	classDefinition := UIManager default 
		multiLineRequest: 'Edit class definition:'
		initialAnswer: classDefinition
		answerHeight: 150.
	(classDefinition isNil or: [ classDefinition isEmpty ])
		ifTrue: [ ^ self fail ].
	self class compiler evaluate: classDefinition.
	^ encoder
		global: (Smalltalk globals associationAt: classSymbol)
		name: classSymbol! !

!Parser methodsFor: 'scanning' stamp: ''!
startOfNextToken
	"Return starting position in source of next token."

	hereType == #doIt ifTrue: [^source position + 1].
	^hereMark! !

!Parser methodsFor: 'pragmas' stamp: 'MarcusDenker 5/2/2013 11:35'!
pragmaLiteral: selectorSoFar
	"Read a pragma literal.  As a nicety we allow a variable name (rather
	 than a literal string) as the second argument to primitive:error:"

	(hereType == #string or: [ hereType == #literal or: [ hereType == #number ] ])
		ifTrue: [ ^ self advance ].
	(here == $# and: [ tokenType == #word ])
		ifTrue: [ ^ self advance ].
	(here == #- and: [ tokenType == #number ])
		ifTrue: [ ^ (self advance; advance) negated ].
	(here = 'true' or: [ here = 'false' or: [ here = 'nil' ] ])
		ifTrue: [ ^ self class compiler evaluate: self advance ].
	"This nicety allows one to supply a primitive error
	 temp as a variable name, rather than a string."
	((selectorSoFar beginsWith: 'primitive:')
	 and: [(selectorSoFar endsWith: 'error:')
	 and: [hereType == #word]]) ifTrue:
		[^self advance].
	^self expected: 'Literal constant'! !

!Parser methodsFor: 'error handling' stamp: 'eem 5/14/2008 13:34'!
addWarning: aString
	"ignored by the default compiler."! !

!Parser methodsFor: 'primitives' stamp: 'lr 9/29/2010 08:12'!
primitive: anIntegerOrString error: errorCodeVariableOrNil
	"Create indexed primitive with optional error code."
	
	<primitive>
	^anIntegerOrString isInteger
		ifTrue:
			[errorCodeVariableOrNil ifNotNil:
				[encoder floatTemp: (encoder bindTemp: errorCodeVariableOrNil) nowHasDef].
			 anIntegerOrString]
		ifFalse:
			[anIntegerOrString isString
				ifTrue: [self primitive: anIntegerOrString module: nil error: errorCodeVariableOrNil]
				ifFalse: [self expected: 'Indexed primitive']]! !

!Parser methodsFor: 'error correction' stamp: 'cwp 10/17/2007 22:38/eem 9/5/2009 11:10 - => :='!
queryUndefined
	| varStart varName | 
	varName := parseNode key.
	varStart := self endOfLastToken + requestorOffset - varName size + 1.
	requestor selectFrom: varStart to: varStart + varName size - 1; select.
	(UndefinedVariable name: varName) ifFalse: [^ self fail]! !

!Parser methodsFor: 'scanning' stamp: 'hmm 7/16/2001 19:23'!
endOfLastToken

	^ prevEnd ifNil: [mark]! !

!Parser methodsFor: 'public access' stamp: 'ar 9/27/2005 19:19'!
parse: sourceStream class: class noPattern: noPattern context: ctxt notifying: req ifFail: aBlock 
	^self parse: sourceStream class: class category: nil noPattern: noPattern context: ctxt notifying: req ifFail: aBlock ! !

!Parser methodsFor: 'scanning' stamp: ''!
matchToken: thing 
	"Matches the token, not its type."

	here = thing ifTrue: [self advance. ^true].
	^false! !

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

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

	userSelection := requestor selectionInterval.
	requestor selectFrom: spots first first to: spots last last.
	requestor select.

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

	requestor deselect.
	requestor selectInvisiblyFrom: userSelection first to: userSelection last.

	self substituteSelector: correctSelector keywords wordIntervals: spots.
	^(proposedKeyword last ~~ $:
	   and: [correctSelector last == $:])
		ifTrue: [abortAction value]
		ifFalse: [correctSelector]! !

!Parser methodsFor: 'primitives' stamp: 'lr 9/29/2010 08:12'!
primitive: aNameString module: aModuleStringOrNil
	"Create named primitive."
	
	<primitive>
	^self primitive: aNameString module: aModuleStringOrNil error: nil! !

!Parser methodsFor: 'error correction' stamp: 'RAA 6/5/2001 11:57'!
declareTempAndPaste: name
	| insertion delta theTextString characterBeforeMark |

	theTextString := requestor text string.
	characterBeforeMark := theTextString at: tempsMark-1 ifAbsent: [$ ].
	(theTextString at: tempsMark) = $| ifTrue: [
  		"Paste it before the second vertical bar"
		insertion := name, ' '.
		characterBeforeMark isSeparator ifFalse: [insertion := ' ', insertion].
		delta := 0.
	] ifFalse: [
		"No bars - insert some with CR, tab"
		insertion := '| ' , name , ' |',String cr.
		delta := 2.	"the bar and CR"
		characterBeforeMark = Character tab ifTrue: [
			insertion := insertion , String tab.
			delta := delta + 1.	"the tab"
		].
	].
	tempsMark := tempsMark +
		(self substituteWord: insertion
			wordInterval: (tempsMark to: tempsMark-1)
			offset: 0) - delta.
	^ encoder bindAndJuggle: name! !

!Parser methodsFor: 'expression types' stamp: 'PeterHugossonMiller 9/3/2009 10:15'!
messagePart: level repeat: repeat

	| start receiver selector args precedence words keywordStart |
	[receiver := parseNode.
	(hereType == #keyword and: [level >= 3])
		ifTrue: 
			[start := self startOfNextToken.
			selector := (String new: 32) writeStream.
			args := OrderedCollection new.
			words := OrderedCollection new.
			[hereType == #keyword]
				whileTrue: 
					[keywordStart := self startOfNextToken + requestorOffset.
					selector nextPutAll: self advance.
					words addLast: (keywordStart to: self endOfLastToken + requestorOffset).
					self primaryExpression ifFalse: [^self expected: 'Argument'].
					self messagePart: 2 repeat: true.
					args addLast: parseNode].
			(Symbol hasInterned: selector contents ifTrue: [ :sym | selector := sym])
				ifFalse: [ selector := self correctSelector: selector contents
										wordIntervals: words
										exprInterval: (start to: self endOfLastToken)
										ifAbort: [ ^ self fail ] ].
			precedence := 3]
		ifFalse: [((hereType == #binary or: [hereType == #verticalBar])
				and: [level >= 2])
				ifTrue: 
					[start := self startOfNextToken.
					selector := self advance asOctetString asSymbol.
					self primaryExpression ifFalse: [^self expected: 'Argument'].
					self messagePart: 1 repeat: true.
					args := Array with: parseNode.
					precedence := 2]
				ifFalse: [hereType == #word
						ifTrue: 
							[start := self startOfNextToken.
							selector := self advance.
							args := #().
							words := OrderedCollection with: (start  + requestorOffset to: self endOfLastToken + requestorOffset).
							(Symbol hasInterned: selector ifTrue: [ :sym | selector := sym])
								ifFalse: [ selector := self correctSelector: selector
													wordIntervals: words
													exprInterval: (start to: self endOfLastToken)
													ifAbort: [ ^ self fail ] ].
							precedence := 1]
						ifFalse: [^args notNil]]].
	parseNode := MessageNode new
				receiver: receiver
				selector: selector
				arguments: args
				precedence: precedence
				from: encoder
				sourceRange: (start to: self endOfLastToken).
	repeat]
		whileTrue: [].
	^true! !

!Parser methodsFor: 'error correction' stamp: 'eem 5/27/2009 09:27'!
declareGlobal: name
	| sym |
	sym := name asSymbol.
	^encoder
		global: (encoder environment
					at: sym put: nil;
					associationAt: sym)
		name: sym! !

!Parser methodsFor: 'primitives' stamp: 'nice 3/26/2011 23:15'!
externalFunctionDeclaration
	"Parse the function declaration for a call to an external library."

	| descriptorClass callType retType externalName args argType module |
	descriptorClass := Smalltalk globals at: #ExternalFunction ifAbsent: [ nil ].
	descriptorClass == nil 
		ifTrue: [ ^ false ].
	callType := descriptorClass callingConventionFor: here.
	callType == nil 
		ifTrue: [ ^ false ].	"Parse return type"
	self advance.
	retType := self externalType: descriptorClass.
	retType == nil 
		ifTrue: [ ^ self expected: 'return type' ].	"Parse function name or index"
	externalName := here.
	(self match: #string)
		ifTrue: [ externalName := externalName asSymbol ]
		ifFalse: [ (self match: #number)
						ifFalse: [ ^ self expected: 'function name or index' ] ].
	(self matchToken: #'(')
		ifFalse: [ ^ self expected: 'argument list' ].
	args := Array new writeStream.
	[ here == #')' ]
		whileFalse: [ 
			argType := self externalType: descriptorClass.
			argType == nil
				ifTrue: [ ^ self expected: 'argument' ].
			argType isVoid & argType isPointerType not
				ifFalse: [ args nextPut: argType ] ].
	(args position = self properties selector numArgs) ifFalse: [
		^self expected: 'Matching number of arguments'].
	(self matchToken: #')')
		ifFalse: [ ^ self expected: ')' ].
	(self matchToken: 'module:')
		ifTrue: [ 
			module := here.
			(self match: #string)
				ifFalse: [ ^ self expected: 'String' ].
			module := module asSymbol ].
	Smalltalk globals
		at: #ExternalLibraryFunction
		ifPresent: [ :xfn | 
			| fn |
			fn := xfn
				name: externalName
				module: module
				callType: callType
				returnType: retType
				argumentTypes: args contents.
			self allocateLiteral: fn ].
	self addPragma: (Pragma keyword: #primitive: arguments: #(120)).
	^ true! !

!Parser methodsFor: 'public access' stamp: 'BenjaminVanRyseghem 12/20/2012 14:48'!
parse: sourceStream class: class category: aCategory noPattern: noPattern context: ctxt notifying: req ifFail: aBlock 
	"Answer a MethodNode for the argument, sourceStream, that is the root of
	 a parse tree. Parsing is done with respect to the argument, class, to find
	 instance, class, and pool variables; and with respect to the argument,
	 ctxt, to find temporary variables. Errors in parsing are reported to the
	 argument, req, if not nil; otherwise aBlock is evaluated. The argument
	 noPattern is a Boolean that is true if the the sourceStream does not
	 contain a method header (i.e., for DoIts)."

	| methNode repeatNeeded myStream s p |
	category := aCategory.
	myStream := sourceStream.
	[repeatNeeded := false.
	 p := myStream position.
	 s := myStream upToEnd.
	 myStream position: p.
	self encoder init: class context: ctxt notifying: self.
	 self init: myStream notifying: req failBlock: [^ aBlock value].
	 doitFlag := noPattern.
	 failBlock:= aBlock.
	 [methNode := self
					method: noPattern
					context: ctxt] 
		on: ReparseAfterSourceEditing 
		do:	[ :ex |
			repeatNeeded := true.
			myStream := requestor text string readStream].
	 repeatNeeded] whileTrue:
		[encoder := self encoder class new].
	requestor 
		ifNil: [ methNode sourceText: s ]
		ifNotNil: [ methNode sourceText: requestor text string ].
	^methNode
! !

!Parser methodsFor: 'error correction' stamp: ''!
substituteWord: correctWord wordInterval: spot offset: o
	"Substitute the correctSelector into the (presuamed interactive) receiver."

	requestor correctFrom: (spot first + o)
					to: (spot last + o)
					with: correctWord.

	requestorOffset := requestorOffset + correctWord size - spot size.
	^ o + correctWord size - spot size! !

!Parser methodsFor: 'expression types' stamp: 'eem 5/29/2008 09:36'!
newMethodNode
	^self encoder methodNodeClass new! !

!Parser methodsFor: 'pragmas' stamp: 'lr 10/5/2006 09:47'!
pragmaSequence
	"Parse a sequence of method pragmas."
	
	[ true ] whileTrue: [
		(self matchToken: #<)
			ifFalse: [ ^ self ].
		self pragmaStatement.
		(self matchToken: #>)
			ifFalse: [ ^ self expected: '>' ] ]! !

!Parser methodsFor: 'error handling' stamp: 'pavel.krivanek 11/21/2008 16:57'!
interactive
	
	^ UIManager default interactiveParserFor: requestor! !

!Parser methodsFor: 'error handling' stamp: 'di 2/9/1999 15:43'!
offEnd: aString 
	"Notify a problem beyond 'here' (in lookAhead token). Don't be offEnded!!"

	requestorOffset == nil
		ifTrue: [^ self notify: aString at: mark]
		ifFalse: [^ self notify: aString at: mark + requestorOffset]
! !

!Parser methodsFor: 'error correction' stamp: 'cwp 10/15/2007 23:00'!
canDeclareClassVariable
	^encoder classEncoding ~~ UndefinedObject! !

!Parser methodsFor: 'temps' stamp: ''!
bindTemp: name

	^name! !

!Parser methodsFor: 'pragmas' stamp: 'eem 11/29/2008 16:44'!
addPragma: aPragma
	properties := properties copyWith: aPragma! !

!Parser methodsFor: 'temps' stamp: 'eem 5/13/2008 12:17'!
bindTemp: name in: methodSelector

	^name! !

!Parser class methodsFor: 'accessing' stamp: 'lr 9/29/2010 08:24'!
primitivePragmaSelectors
	"Answer the selectors of pragmas that specify VM primitives.
	 Needed for compile and decomple."

	^ (Pragma allNamed: #primitive from: self to: Parser)
		collect: [ :each | each selector ]! !

!ParserNotification commentStamp: 'TorstenBergmann 1/31/2014 11:18'!
Common superclass for parser notifications!
!ParserNotification methodsFor: 'as yet unclassified' stamp: 'cwp 8/25/2009 20:04'!
defaultAction
	
	self openMenuIn: 
		[:labels :lines :caption | 
		UIManager default chooseFrom: labels lines: lines title: caption]! !

!ParserNotification methodsFor: 'as yet unclassified' stamp: 'cwp 10/17/2007 21:36'!
openMenuIn: aBlock
	self subclassResponsibility! !

!ParserNotification methodsFor: 'as yet unclassified' stamp: 'cwp 10/17/2007 23:29/eem 9/5/2009 11:10 - => :='!
setName: aString
	name := aString! !

!ParserNotification class methodsFor: 'as yet unclassified' stamp: 'cwp 10/17/2007 23:31'!
name: aString
	^ (self new setName: aString) signal! !

!Password commentStamp: '<historical>'!
"Hold a password.  There are three ways to get the password.

If there is no password (sequence == nil), ask the user for it.

If the use supplied one during this session, return that.  It is cleared at shutDown.

If sequence is a number, get the server passwords off the disk.  File 'sqk.info' must be in the same folder 'Squeak.sources' file.  Decode the file.  Return the password indexed by sequence."!
!PasswordDialogWindow commentStamp: 'LaurentLaffont 4/15/2011 20:17'!
I'm a Dialog whose TextEditors characters are replaced by *. 

Example:
(UITheme builder openModal: 
        (PasswordDialogWindow new
                title: 'Authentification';
                textFont: StandardFonts defaultFont;
                text: 'Enter your password')) entryText explore!
!PasswordDialogWindow methodsFor: 'private' stamp: 'BenjaminVanRyseghem 5/4/2012 22:51'!
showPassword: aBoolean

	(showPassword := aBoolean)
		ifTrue: [ self beDecrypted ]
		ifFalse: [ self beEncrypted ].
	self changed: #showPassword! !

!PasswordDialogWindow methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/4/2012 22:42'!
beEncrypted

	textEditor font: (StrikeFont passwordFontSize: self theme textFont pointSize)! !

!PasswordDialogWindow methodsFor: 'private' stamp: 'BenjaminVanRyseghem 5/4/2012 22:52'!
showPasswordButton

	^ (CheckboxMorph 
			on: self 
			selected: #showPassword
			changeSelected: #showPassword:)
			label: 'Show password';
			labelClickable: true;
			height: 25.! !

!PasswordDialogWindow methodsFor: 'actions' stamp: 'BenjaminVanRyseghem 5/4/2012 22:47'!
newContentMorph
	"Answer a new content morph."

	self iconMorph: self newIconMorph.
	self textMorph: self newTextMorph.
	self textMorph wrapFlag: false.
	self textEditorMorph: self newTextEditorMorph.
	^self newGroupboxForAll: {
		self newRow: {self iconMorph. self textMorph}.
		self textEditorMorph.
		self showPasswordButton}! !

!PasswordDialogWindow methodsFor: 'creation' stamp: 'BenjaminVanRyseghem 5/4/2012 22:42'!
newTextEditorMorph
	"Answer a new morph for the text entry using a password font."

	textEditor := super newTextEditorMorph.
	self beEncrypted.
	^ textEditor! !

!PasswordDialogWindow methodsFor: 'private' stamp: 'BenjaminVanRyseghem 5/4/2012 22:48'!
showPassword
	
	^ showPassword ifNil: [ showPassword := false ]! !

!PasswordDialogWindow methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/4/2012 22:43'!
beDecrypted

	textEditor font: self theme textFont! !

!PasteUpMorph commentStamp: '<historical>'!
A morph whose submorphs comprise a paste-up of rectangular subparts which "show through".  Anything called a 'Playfield' is a PasteUpMorph.

Facilities commonly needed on pages of graphical presentations and on simulation playfields, such as the painting of new objects, turtle trails, gradient fills, background paintings, parts-bin behavior, collision-detection, etc., are (or will be) provided.




!
!PasteUpMorph methodsFor: 'world state' stamp: 'alain.plantec 5/30/2008 14:07'!
handleFatalDrawingError: errMsg
	"Handle a fatal drawing error."
	Display deferUpdates: false. "Just in case"
	self primitiveError: errMsg.

	"Hm... we should jump into a 'safe' worldState here, but how do we find it?!!"! !

!PasteUpMorph methodsFor: 'Morphic-Base-Windows' stamp: 'MarianoMartinezPeck 5/2/2012 23:49'!
closeAllWindowsDiscardingChanges
	World systemWindows do: [:w | [w delete] valueSupplyingAnswer: false]! !

!PasteUpMorph methodsFor: '*Morphic-Base' stamp: 'di 10/18/2001 02:58'!
grabLassoFromScreen: evt
	"Allow the user to specify a polygonal area of the Display, capture the pixels from that area, and use them to create a new drawing morph. Attach the result to the hand."

	self extractScreenRegion: (PolygonMorph fromHandFreehand: evt hand)
		andPutSketchInHand: evt hand
! !

!PasteUpMorph methodsFor: 'menu & halo' stamp: 'StephaneDucasse 6/5/2014 19:44'!
popUpContentsMenu: evt
	"Present a menu names of windows and naked morphs, and activate the one that gets chosen.  Collapsed windows appear below line, expand if chosen; naked morphs appear below second line; if any of them has been given an explicit name, that is what's shown, else the class-name of the morph shows; if a naked morph is chosen, bring it to front and have it don a halo."
	| menu |
	menu := UIManager default newMenuIn: self for: self.
	self contentsMenu: menu.
	menu addTitle: self contentsMenuTitle.
	menu popUpEvent: evt in: (self owner ifNil: [self]).! !

!PasteUpMorph methodsFor: 'submorphs-accessing' stamp: 'nk 7/4/2003 16:49'!
morphsInFrontOf: someMorph overlapping: aRectangle do: aBlock
	"Include hands if the receiver is the World"
	self handsDo:[:m|
		m == someMorph ifTrue:["Try getting out quickly"
			owner ifNil:[^self].
			^owner morphsInFrontOf: self overlapping: aRectangle do: aBlock].
		"The hand only overlaps if it's not the hardware cursor"
		m needsToBeDrawn ifTrue:[
			(m fullBoundsInWorld intersects: aRectangle)
				ifTrue:[aBlock value: m]]].
	^super morphsInFrontOf: someMorph overlapping: aRectangle do: aBlock! !

!PasteUpMorph methodsFor: 'world state' stamp: 'dgd 9/5/2004 19:46'!
restoreMainDockingBarDisplay
	"Restore the display of docking bars"
	self dockingBars
		do: [:each | each updateBounds]! !

!PasteUpMorph methodsFor: 'initialization' stamp: 'StephaneDucasse 7/18/2010 15:20'!
initialize
	"initialize the state of the receiver"
	
	super initialize.
	self enableDragNDrop.
	self clipSubmorphs: true! !

!PasteUpMorph methodsFor: 'dropping/grabbing' stamp: 'sw 2/4/2001 00:54'!
dropEnabled
	"Get this morph's ability to add and remove morphs via drag-n-drop."

	^ (self valueOfProperty: #dropEnabled) ~~ false
! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'tbn 11/4/2008 09:15'!
keyboardNavigationHandler
	"Answer the receiver's existing keyboardNavigationHandler, or nil if none."

	| aHandler |
	aHandler := self valueOfProperty: #keyboardNavigationHandler ifAbsent: [^ nil].
	(aHandler hasProperty: #moribund) ifTrue:  "got clobbered in another project"
		[self removeProperty: #keyboardNavigationHandler.
		^ nil].
	^ aHandler! !

!PasteUpMorph methodsFor: 'world state' stamp: 'PavelKrivanek 7/20/2014 14:39'!
restoreMorphicDisplay

	DisplayScreen startUp.

	self
		extent: Display extent;
		viewBox: Display boundingBox;
		handsDo: [:h | h visible: true; showTemporaryCursor: nil];
		resizeBackgroundMorph;
		restoreMainDockingBarDisplay;
		fullRepaintNeeded.
		
	self defer: [Cursor normal show].
		
	self layoutChanged.
! !

!PasteUpMorph methodsFor: 'viewing' stamp: 'dgd 4/4/2006 13:58'!
bringTopmostsToFront
	submorphs
		select:[:m| m wantsToBeTopmost]
		thenDo:[:m| self addMorphInLayer: m].! !

!PasteUpMorph methodsFor: 'options' stamp: 'ar 11/9/2000 12:49'!
resizeToFit
	^self vResizing == #shrinkWrap! !

!PasteUpMorph methodsFor: 'options' stamp: 'dgd 12/13/2003 19:30'!
resizeToFitString
	"Answer a string, to be used in a self-updating menu, to 
	represent whether the receiver is currently using resize-to-fit 
	or not"
	^ (self resizeToFit
		ifTrue: ['<yes>']
		ifFalse: ['<no>'])
		, 'resize to fit' translated! !

!PasteUpMorph methodsFor: '*Morphic-Base' stamp: 'di 10/18/2001 01:13'!
grabRubberBandFromScreen: evt
	"Allow the user to specify a polygonal area of the Display, capture the pixels from that area, and use them to create a new drawing morph. Attach the result to the hand."

	self extractScreenRegion: (PolygonMorph fromHand: evt hand)
		andPutSketchInHand: evt hand! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'IgorStasenko 1/2/2012 19:05'!
grabDrawingFromScreen: evt
	"Allow the user to specify a rectangular area of the Display, capture the pixels from that area, and use them to create a new drawing morph. Attach the result to the hand."
	| m |
	m := self drawingClass  withForm: Form fromUser.
	evt hand position: self activeHand cursorPoint.  "update hand pos after Sensor loop in fromUser"
	evt hand attachMorph: m.! !

!PasteUpMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/18/2007 14:36'!
systemWindows
	"Answer the system windows in the world."
	
	^self submorphsSatisfying: [:m | m isSystemWindow]! !

!PasteUpMorph methodsFor: 'accessing' stamp: 'ar 4/25/2001 17:15'!
useRoundedCorners
	"Somewhat special cased because we do have to fill Display for this"
	super useRoundedCorners.
	self == World ifTrue:[Display bits primFill: 0]. "done so that we *don't* get a flash"! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'AlainPlantec 2/17/2010 09:35'!
invokeWorldMenu: evt
	"Put up the world menu, triggered by the passed-in event."
	| menu |
	self bringTopmostsToFront.
	"put up screen menu"
	(menu := self worldMenu) popUpEvent: evt in: self.
	^ menu! !

!PasteUpMorph methodsFor: 'initialization' stamp: 'dgd 2/14/2003 22:38'!
defaultBorderWidth
	"answer the default border width for the receiver"
	^ 1! !

!PasteUpMorph methodsFor: 'recategorized' stamp: 'gvc 2/3/2010 17:59'!
resizeBackgroundMorph
	"Resize the background morph to fit the world."

	self backgroundMorph isNil ifFalse: [
		self backgroundMorph extent: self extent]! !

!PasteUpMorph methodsFor: '*Athens-Morphic' stamp: 'IgorStasenko 4/21/2011 14:33'!
drawOnAthensCanvas: aCanvas 
	"Draw in order:
	- background color
	- background sketch, if any
	- Update and draw the turtleTrails form. See the comment in updateTrailsForm.

	Later (in drawSubmorphsOn:) I will skip drawing the background sketch."

	"draw background fill"
	super drawOnAthensCanvas: aCanvas.

	backgroundMorph ifNotNil: [
		aCanvas clipBy: self clippingBounds
			during: [ aCanvas fullDrawMorph: backgroundMorph ]
	]				
! !

!PasteUpMorph methodsFor: 'wiw support' stamp: 'RAA 8/14/2000 12:10'!
shouldGetStepsFrom: aWorld

	(self isWorldMorph and: [owner notNil]) ifTrue: [
		^self outermostWorldMorph == aWorld
	].
	^super shouldGetStepsFrom: aWorld! !

!PasteUpMorph methodsFor: 'drawing' stamp: 'StephaneDucasse 6/27/2013 22:54'!
drawOn: aCanvas 
	"Draw in order:
	- background color
	- grid, if any
	- background sketch, if any
	Later (in drawSubmorphsOn:) I will skip drawing the background sketch."

	super drawOn: aCanvas.	
	self drawGridOn: aCanvas.
	self drawBackgroundSketchOn: aCanvas! !

!PasteUpMorph methodsFor: 'gridding' stamp: 'di 8/24/2000 16:48'!
griddingOnOff

	griddingOn := self griddingOn not.
	self changed! !

!PasteUpMorph methodsFor: '*Morphic-Widgets-Taskbar' stamp: 'MarcusDenker 3/23/2011 15:37'!
removeTaskbar
	"Remove the receiver's taskbars."
	
	self taskbars do: [:each | each removeFromWorld]! !

!PasteUpMorph methodsFor: 'Morphic-Base-Windows' stamp: 'BenComan 7/24/2014 01:51'!
closeAllUnchangedWindows
	(self  windowsSatisfying: [:w | w model canDiscardEdits])
		do: [:w | w delete]! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'dgd 9/11/2004 20:45'!
delayedInvokeWorldMenu: evt 
	self
		addAlarm: #invokeWorldMenu:
		with: evt
		after: 200! !

!PasteUpMorph methodsFor: 'testing' stamp: 'StephaneDucasse 6/28/2013 13:17'!
isEasySelecting
	"This is to isolate easySelection predicate. 
	Selectors in holders make no sense so we are limiting easy
	selection to the worldMorph.
	It would also make sense in playfield so feel free to adjust this
	predicate. Selection can always be forced by using the shift
	before mouse down."
	^ false! !

!PasteUpMorph methodsFor: '*Morphic-Base' stamp: 'StephaneDucasse 3/3/2010 15:32'!
drawingClass

	^ ImageMorph! !

!PasteUpMorph methodsFor: '*Polymorph-Widgets' stamp: 'SeanDeNigris 1/23/2014 11:58'!
navigationKey: aKeyboardEvent
	
	^ self taskList handleEvent: aKeyboardEvent.! !

!PasteUpMorph methodsFor: 'world state' stamp: 'di 7/15/1999 09:51'!
addMorph: aMorph centeredNear: aPoint
	"Add the given morph to this world, attempting to keep its center as close to the given point possible while also keeping the it entirely within the bounds of this world."

	| trialRect delta |
	trialRect := Rectangle center: aPoint extent: aMorph fullBounds extent.
	delta := trialRect amountToTranslateWithin: bounds.
	aMorph position: trialRect origin + delta.
	self addMorph: aMorph.
! !

!PasteUpMorph methodsFor: 'accessing' stamp: 'tak 3/15/2005 17:31'!
removeModalWindow
	self modalWindow: nil! !

!PasteUpMorph methodsFor: 'Morphic-Base-Windows' stamp: 'StephaneDucasse 10/22/2014 22:11'!
findWindow: evt
	"Present a menu names of windows and naked morphs, and activate the one that gets chosen.  Collapsed windows appear below line, expand if chosen; naked morphs appear below second line; if any of them has been given an explicit name, that is what's shown, else the class-name of the morph shows; if a naked morph is chosen, bring it to front and have it don a halo."
	| menu expanded collapsed nakedMorphs |
	menu := UIManager default newMenuIn: self for: self.
	expanded := self  windowsSatisfying: [:w | w isCollapsed not].
	collapsed := self  windowsSatisfying: [:w | w isCollapsed].
	nakedMorphs := self submorphsSatisfying:[:m | m isSystemWindow not].
	(expanded isEmpty and: [collapsed isEmpty and: [nakedMorphs isEmpty]]) ifTrue: [^ self inform: 'No morph in world'].
	(expanded asSortedCollection: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do:
		[:w | menu add: w label target: w selector: #activateAndForceLabelToShow.
			w model canDiscardEdits ifFalse: [menu lastItem color: Color red]].
	(expanded isEmpty or: [ collapsed isEmpty and: [ nakedMorphs isEmpty ]]) ifFalse: [menu addLine].
	(collapsed asSortedCollection: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do: 
		[:w | menu add: w label target: w selector: #collapseOrExpand.
		w model canDiscardEdits ifFalse: [menu lastItem color: Color red]].
	nakedMorphs isEmpty ifFalse: [menu addLine].
	(nakedMorphs asSortedCollection: [:w1 :w2 | w1 class name caseInsensitiveLessOrEqual: w2 class name]) do:
		[:w | menu add: w class name target: w selector: #comeToFrontAndAddHalo].
	menu addTitle: 'find window'.
	menu popUpEvent: evt in: self.! !

!PasteUpMorph methodsFor: 'world state' stamp: 'StephaneDucasse 10/25/2013 16:17'!
flashRects: rectangleList color: aColor
	"For testing. Flashes the given list of rectangles on the Display so you can watch incremental redisplay at work."
	"Details: Uses two reverses so that the display is restored to its original state. This is necessary when in deferred update mode."

	| blt |
	blt := (BitBlt toForm: Display)
		sourceForm: nil;
		sourceOrigin: 0@0;
		clipRect: self viewBox;
		combinationRule: Form reverse.
	rectangleList do: [:r | | screenRect |
		screenRect := r translateBy: self viewBox origin.
		blt destRect: screenRect; copyBits.
		Display forceToScreen: screenRect; forceDisplayUpdate.
		(Delay forMilliseconds: 15) wait.
		blt destRect: screenRect; copyBits.
		Display forceToScreen: screenRect; forceDisplayUpdate].
! !

!PasteUpMorph methodsFor: 'Morphic-Base-Windows' stamp: 'MarcusDenker 9/13/2013 16:28'!
bringWindowsFullOnscreen
	"Make ever SystemWindow on the desktop be totally on-screen, whenever possible."

	| r |
	bounds
		allAreasOutsideList: (self taskbars collect: [ :t | t bounds ])
		do: [ :e | 
			r isNil
				ifTrue: [ r := e ]
				ifFalse: [ 
					r area > e area
						ifTrue: [ r ]
						ifFalse: [ e ] ] ].
	(self windowsSatisfying: [ :w | true ])
		do: [ :aWindow | 
			aWindow right: (aWindow right min: r right).
			aWindow bottom: (aWindow bottom min: r bottom).
			aWindow left: (aWindow left max: r left).
			aWindow top: (aWindow top max: r top) ]! !

!PasteUpMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 5/29/2008 10:59'!
nextVisibleWindow
	"Answer the next (visible) window to navigate to."
	
	|sys|
	sys := self visibleSystemWindows.
	sys ifEmpty: [^nil].
	^sys after: self currentWindow ifAbsent: [sys first]! !

!PasteUpMorph methodsFor: 'gridding' stamp: 'dgd 12/13/2003 19:30'!
griddingString
	"Answer a string to use in a menu offering the user the 
	opportunity to start or stop using gridding"
	^ (self griddingOn
		ifTrue: ['<yes>']
		ifFalse: ['<no>'])
		, 'use gridding' translated! !

!PasteUpMorph methodsFor: 'halos and balloon help' stamp: 'sw 1/10/2000 16:44'!
defersHaloOnClickTo: aSubMorph
	"If a cmd-click on aSubMorph would make it a preferred recipient of the halo, answer true"
	^ true
	! !

!PasteUpMorph methodsFor: '*Morphic-Base' stamp: 'dgd 2/22/2003 14:11'!
modelWakeUp
	"I am the model of a SystemWindow, that has just been activated"

	| aWindow |
	owner isNil ifTrue: [^self].	"Not in Morphic world"
	(owner isKindOf: TransformMorph) ifTrue: [^self viewBox: self fullBounds].
	(aWindow := self containingWindow) ifNotNil: 
			[self viewBox = aWindow panelRect 
				ifFalse: [self viewBox: aWindow panelRect]]! !

!PasteUpMorph methodsFor: 'event handling' stamp: 'HenrikSperreJohansen 3/24/2015 11:58'!
windowEvent: anEvent
	self windowEventHandler ifNotNil: [ ^ self windowEventHandler windowEvent: anEvent ].
	"The window close dialog is modal, since the windowClose event originates from the system window button, we need to protect against opening multiple, otherwise we end up with the world in a locked state when one of them is cancelled"
	(anEvent type == #windowClose and: [ self valueOfProperty: #canOpenCloseDialog ifAbsent: true ])
		ifTrue: [ 
			self setProperty: #canOpenCloseDialog toValue: false.
			WorldState quitSession.
			self removeProperty: #canOpenCloseDialog ]! !

!PasteUpMorph methodsFor: 'drawing' stamp: 'StephaneDucasse 6/27/2013 19:19'!
drawSubmorphsOn: aCanvas
	"Display submorphs back to front, but skip my background sketch."

	| drawBlock |
	submorphs isEmpty
		ifTrue: [ ^ self ].
	drawBlock := [ :canvas | 
	submorphs
		reverseDo: [ :m | 
			m ~~ backgroundMorph
				ifTrue: [ canvas fullDrawMorph: m ] ] ].
	self clipSubmorphs
		ifTrue: [ aCanvas clipBy: (aCanvas clipRect intersect: self clippingBounds ifNone: [ ^ self ]) during: drawBlock ]
		ifFalse: [ drawBlock value: aCanvas ]! !

!PasteUpMorph methodsFor: '*Morphic-Base' stamp: 'TorstenBergmann 9/19/2014 17:01'!
makeAScreenshot
	| filePrefix |
	filePrefix :=  'PharoScreenshot'.
	(UIManager default
		chooseFrom: {'The entire world' translated. 'A selected area' translated}
		values: #(#world #area )
		message: 'What do you want to shoot? (File will be saved in image directory)' translated
		title: 'Make a screenshot')
		ifNotNil: [:choice | 
				|form name|
				form := choice = #world
							ifTrue: [World imageForm]
							ifFalse: [Form fromUser].		
				name := (FileSystem workingDirectory / filePrefix , 'png') nextVersion.					
				PNGReadWriter
						putForm: form
						onFileNamed: (FileSystem workingDirectory / filePrefix , 'png') nextVersion.
				UIManager default inform: 'Screenshot saved under ', name fullName ] 
							
		! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'StephaneDucasse 6/28/2013 13:20'!
discoveredWorldMenu
	^ owner discoveredWorldMenu
! !

!PasteUpMorph methodsFor: 'gridding' stamp: 'di 8/24/2000 16:11'!
gridVisible

	^ self hasProperty: #gridVisible! !

!PasteUpMorph methodsFor: 'Morphic-Base-Windows' stamp: 'AlainPlantec 1/9/2010 06:22'!
collapseAll
	"Collapse all windows"
	(self windowsSatisfying: [:w | w isCollapsed not])
		reverseDo: [:w | w collapseOrExpand.  self displayWorld].
	self collapseNonWindows! !

!PasteUpMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 5/29/2008 11:00'!
visibleSystemWindows
	"Answer the visible system windows in the world."
	
	^self submorphsSatisfying: [:m | m isSystemWindow and: [m visible]]! !

!PasteUpMorph methodsFor: 'accessing' stamp: 'PavelKrivanek 7/24/2014 10:28'!
currentWindow

	"Answer the top window or nil"
	
	^ #SystemWindow asClassIfPresent: [:systemWindow | systemWindow topWindow]! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'sw 3/13/2003 12:19'!
dispatchCommandKeyInWorld: aChar event: evt
	"Dispatch the desktop command key if possible.  Answer whether handled"

	| aMessageSend |
	aMessageSend := self commandKeySelectors at: aChar ifAbsent: [^ false].
	aMessageSend selector numArgs = 0
		ifTrue:
			[aMessageSend value]
		ifFalse:
			[aMessageSend valueWithArguments: (Array with: evt)].
	^ true
! !

!PasteUpMorph methodsFor: '*Morphic-Base' stamp: 'di 9/19/2000 22:17'!
dragThroughOnDesktop: evt
	"Draw out a selection rectangle"
	| selection |
	selection := SelectionMorph newBounds: (evt cursorPoint extent: 8@8).
	self addMorph: selection.
	^ selection extendByHand: evt hand
! !

!PasteUpMorph methodsFor: 'dropping/grabbing' stamp: 'StephaneDucasse 6/27/2013 19:32'!
wantsDroppedMorph: aMorph event: evt
	
	self visible ifFalse: [^ false].  "will be a call to #hidden again very soon"
	self dropEnabled ifFalse: [^ false].
	^ true! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'sw 3/18/2003 23:10'!
keyboardNavigationHandler: aHandler
	"Set the receiver's keyboard navigation handler as indicated.  A nil argument means to remove the handler"

	aHandler
		ifNil:
			[self removeProperty: #keyboardNavigationHandler]
		ifNotNil:
			[self setProperty: #keyboardNavigationHandler toValue: aHandler]! !

!PasteUpMorph methodsFor: 'gridding' stamp: 'di 8/24/2000 16:47'!
gridVisibleOnOff

	self setProperty: #gridVisible toValue: self gridVisible not.
	self changed! !

!PasteUpMorph methodsFor: '*Morphic-Widgets-Taskbar' stamp: 'MarcusDenker 3/23/2011 15:37'!
showWorldTaskbar: aBoolean
	"Change the receiver to show the taskbar."
	
	aBoolean
		ifTrue: [self createTaskbarIfNecessary]
		ifFalse: [self removeTaskbar]! !

!PasteUpMorph methodsFor: 'project state' stamp: 'StephaneDucasse 6/28/2013 13:14'!
viewBox: newViewBox 
	"I am now displayed within newViewBox; react."

	super position: newViewBox topLeft.
	fullBounds := bounds := newViewBox.

	! !

!PasteUpMorph methodsFor: '*Morphic-Base' stamp: 'GuillermoPolito 9/4/2010 17:37'!
keystrokeInWorld: evt
	"A keystroke was hit when no keyboard focus was set, so it is sent here to the world instead."

	|  aChar ascii |
	aChar := evt keyCharacter.
	(ascii := aChar asciiValue) = 27 ifTrue: "escape key"
		[^ self invokeWorldMenuFromEscapeKey].
	
	(self navigationKey: evt) ifTrue: [^self].
	
	(evt controlKeyPressed not
		and: [(#(1 4 8 28 29 30 31 32) includes: ascii)  "home, end, backspace, arrow keys, space"
			and: [self keyboardNavigationHandler notNil]])
				ifTrue: [self keyboardNavigationHandler navigateFromKeystroke: aChar].

	(evt commandKeyPressed and: [Editor cmdKeysInText])
		ifTrue: [^ self dispatchCommandKeyInWorld: aChar event: evt].

	"It was unhandled. Remember the keystroke."
	self lastKeystroke: evt keyString.
	self triggerEvent: #keyStroke! !

!PasteUpMorph methodsFor: '*Morphic-Base' stamp: 'StephaneDucasse 7/2/2013 17:26'!
acceptDroppingMorph: dropped event: evt
	"The supplied morph, known to be acceptable to the receiver, is now to be assimilated; the precipitating event is supplied"

	| aMorph |
	aMorph := self morphToDropFrom: dropped.
	super acceptDroppingMorph: aMorph event: evt.
	aMorph
		submorphsDo: [ :m | 
			(m isKindOf: HaloMorph)
				ifTrue: [ m delete ] ].
	self bringTopmostsToFront! !

!PasteUpMorph methodsFor: '*Polymorph-Widgets' stamp: 'FernandoOlivero 4/12/2011 10:11'!
backgroundImage: aForm layout: aSymbol
	"Set a background image, replacing the current background morph, if any,
	with the given layout (see AlphaImageMorph layoutSymbols). "

	self backgroundMorph: (
		(self theme builder
			newAlphaImage: aForm help: nil)
			autoSize: false;
			layout: aSymbol;
			lock)! !

!PasteUpMorph methodsFor: 'drawing' stamp: 'AlainPlantec 5/8/2010 00:31'!
gridFormOrigin: origin grid: smallGrid background: backColor line: lineColor

	| bigGrid gridForm gridOrigin |
	gridOrigin := origin \\ smallGrid.
	bigGrid := (smallGrid asPoint x) @ (smallGrid asPoint y).
	gridForm := Form extent: bigGrid depth: Display depth.
	backColor ifNotNil: [gridForm fillWithColor: backColor].
	gridOrigin x to: gridForm width by: smallGrid x do:
		[:x | gridForm fill: (x@0 extent: 1@gridForm height) fillColor: lineColor].
	gridOrigin y to: gridForm height by: smallGrid y do:
		[:y | gridForm fill: (0@y extent: gridForm width@1) fillColor: lineColor].
	^ InfiniteForm with: gridForm
! !

!PasteUpMorph methodsFor: '*Tool-Base' stamp: 'StephaneDucasse 7/20/2014 22:46'!
defaultDesktopCommandKeyTriplets
	"Answer a list of triplets of the form
		<key> <receiver> <selector>   [+ optional fourth element, a <description> for use in desktop-command-key-help]
that will provide the default desktop command key handlers.  If the selector takes an argument, that argument will be the command-key event"
	self flag: #problem. 
	"there is clearly a problem because not all the tools can be loaded."
 
	^ {
		{ $r.	ActiveWorld.						#restoreMorphicDisplay.					'Redraw the screen'}.		
		{ $b.	Smalltalk tools browser.			#open.										'Open a new System Browser'}.
		{ $k.	Smalltalk tools workspace.			#open.										'Open a new, blank Workspace'}.
		{ $t.	Smalltalk tools transcript.			#open.										'Make a System Transcript visible'}.
		{ $R.	Smalltalk tools recentMessageList.#open.										'Open a Recent Submissions browser'}.
		{ $W.	Smalltalk tools finder. 				#open.						         		  	'Open a new Finder'}.
		{ $Z.	Smalltalk tools changeList. 			#browseRecentLog.						'Browse recently-logged changes'}.
		{ $\.	SystemWindow. 					#sendTopWindowToBack.					'Send the top window to the back'}.
	}.
! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'nk 1/6/2004 12:38'!
extractScreenRegion: poly andPutSketchInHand: hand
	"The user has specified a polygonal area of the Display.
	Now capture the pixels from that region, and put in the hand as a Sketch."
	| screenForm outline topLeft innerForm exterior |
	outline := poly shadowForm.
	topLeft := outline offset.
	exterior := (outline offset: 0@0) anyShapeFill reverse.
	screenForm := Form fromDisplay: (topLeft extent: outline extent).
	screenForm eraseShape: exterior.
	innerForm := screenForm trimBordersOfColor: Color transparent.
	innerForm isAllWhite ifFalse:
		[hand attachMorph: (self drawingClass withForm: innerForm)]! !

!PasteUpMorph methodsFor: 'menu & halo' stamp: 'StephaneDucasse 7/2/2013 17:29'!
dispatchKeystroke: anEvent
	anEvent keyCharacter == Character tab
		ifTrue: [ 
			self tabAmongFields
				ifTrue: [ ^ self tabHitWithEvent: anEvent ] ]! !

!PasteUpMorph methodsFor: 'project state' stamp: 'MarcusDenker 9/13/2013 15:51'!
steppingMorphsNotInWorld
	| all |
	all := self allMorphs.
	^ self listOfSteppingMorphs reject: [ :m | all includes: m ]	"self currentWorld steppingMorphsNotInWorld do: [:m | m delete]"! !

!PasteUpMorph methodsFor: 'recategorized' stamp: 'gvc 2/3/2010 17:59'!
backgroundMorph
	"Answer the background morph if any."
	
	^backgroundMorph! !

!PasteUpMorph methodsFor: 'stepping' stamp: 'StephaneDucasse 11/7/2011 22:43'!
cleanseOtherworldlySteppers
	"If the current project is a morphic one, then remove from its steplist
	those morphs that are not really in the world"
	"Utilities cleanseOtherworldlySteppers"
	| old delta |
	old := self currentWorld stepListSize.
	self currentWorld steppingMorphsNotInWorld
		do: [:m | m delete].
	self currentWorld cleanseStepList.
	(delta := old - self currentWorld stepListSize) > 0
		ifTrue: [ self crTrace: delta asString , ' morphs removed from steplist' ]! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'StephaneDucasse 6/28/2013 13:04'!
worldMenu
	^ owner worldMenu
	! !

!PasteUpMorph methodsFor: 'menu & halo' stamp: 'StephaneDucasse 3/3/2010 15:49'!
addWorldHaloMenuItemsTo: aMenu hand: aHandMorph
	"Add standard halo items to the menu, given that the receiver is a World"

	self addFillStyleMenuItems: aMenu hand: aHandMorph.
	self addLayoutMenuItems: aMenu hand: aHandMorph.

	aMenu addLine.
	self addWorldToggleItemsToHaloMenu: aMenu.
	aMenu addLine.
	self addExportMenuItems: aMenu hand: aHandMorph.
	self addMiscExtrasTo: aMenu.
	self addDebuggingItemsTo: aMenu hand: aHandMorph.

	aMenu addLine.
	aMenu defaultTarget: aHandMorph.
! !

!PasteUpMorph methodsFor: 'gridding' stamp: 'di 8/24/2000 13:15'!
griddingOn

	^ griddingOn ifNil: [false]! !

!PasteUpMorph methodsFor: 'drawing' stamp: 'StephaneDucasse 6/27/2013 22:54'!
drawGridOn: aCanvas

	(self griddingOn and: [ self gridVisible ])
		ifTrue: [ 
			aCanvas
				fillRectangle: self bounds
				fillStyle:
					(self
						gridFormOrigin: self gridOrigin
						grid: self gridModulus
						background: nil
						line: Color lightGray) ]! !

!PasteUpMorph methodsFor: 'world state' stamp: 'ar 3/18/2001 00:35'!
restoreDisplay

	World restoreMorphicDisplay.	"I don't actually expect this to be called"! !

!PasteUpMorph methodsFor: 'dropping/grabbing' stamp: 'StephaneDucasse 6/18/2014 15:36'!
mouseDown: evt
	"Handle a mouse down event."
	| grabbedMorph handHadHalos |
	evt yellowButtonPressed
		ifTrue: [ ^ self popUpContentsMenu: evt ].

	grabbedMorph := self morphToGrab: evt.
	grabbedMorph ifNotNil: [
		grabbedMorph isSticky ifTrue: [^self].
		^evt hand grabMorph: grabbedMorph].

	(super handlesMouseDown: evt)
		ifTrue: [^super mouseDown: evt].

	handHadHalos := evt hand halo notNil.
	evt hand removeHalo. "shake off halos"
	evt hand releaseKeyboardFocus. "shake of keyboard foci"
 
	(evt shiftPressed not
			and: [ self isWorldMorph not 
				and: [ self wantsEasySelection not ]])
		ifTrue: [
		"explicitly ignore the event if we're not the world and we'll not select,
		so that we could be picked up if need be"
		evt wasHandled: false.
		^ self.
	].

	( evt shiftPressed or: [ self wantsEasySelection ] )
		 ifTrue: [
			"We'll select on drag, let's decide what to do on click"
			| clickSelector |
			evt shiftPressed 
				ifTrue: [ clickSelector := #popUpContentsMenu:.]
				ifFalse: [ clickSelector :=   #invokeWorldMenu: ].
			evt hand 
				waitForClicksOrDrag: self 
				event: evt 
				selectors: { clickSelector. nil. nil. #dragThroughOnDesktop: }
				threshold: 5 ]
		ifFalse: [
			"We wont select, just bring world menu if I'm the world"
			self invokeWorldMenu: evt ]
		
! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'sw 3/13/2003 13:52'!
commandKeySelectors
	"Answer my command-key table"

	| aDict |
	aDict := self valueOfProperty: #commandKeySelectors ifAbsentPut: [self initializeDesktopCommandKeySelectors].
	^ aDict! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'StephaneDucasse 6/28/2013 13:04'!
worldMenuAt: aMenuItemName
	^ owner worldMenuAt: aMenuItemName
		! !

!PasteUpMorph methodsFor: '*Polymorph-Widgets' stamp: 'MarcusDenker 4/29/2011 00:37'!
themeChanged
	"The theme has changed.
	Update the desktop wallpaper if appropriate."

	(self theme desktopImageFor: self) ifNotNil: [:aForm |
		self color: Color white.
		self backgroundImage: aForm layout: self theme desktopImageLayout].
	super themeChanged! !

!PasteUpMorph methodsFor: 'wiw support' stamp: 'dgd 8/31/2004 16:25'!
addMorphInLayer: aMorph
	super addMorphInLayer: aMorph.
	aMorph wantsToBeTopmost ifFalse:[self bringTopmostsToFront].! !

!PasteUpMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 6/27/2013 19:34'!
modalWindow: aMorph
	(self valueOfProperty: #modalWindow) ifNotNil: [ :morph | morph doCancel ].
	self setProperty: #modalWindow toValue: aMorph.
	aMorph ifNotNil: [ self when: #aboutToLeaveWorld send: #removeModalWindow to: self ]! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'AlainPlantec 12/13/2009 08:11'!
lastKeystroke	
	"Answer the last keystroke fielded by the receiver"	
	^ self valueOfProperty: #lastKeystroke ifAbsent: ['']! !

!PasteUpMorph methodsFor: 'event handling' stamp: 'StephaneDucasse 7/2/2013 17:28'!
keyStroke: anEvent
	"A keystroke has been made.  Service event handlers and, if it's a keystroke presented to the world, dispatch it to #unfocusedKeystroke:"

	super keyStroke: anEvent.	"Give event handlers a chance"
	self selectedObject ifNotNil: [ :selected | selected moveOrResizeFromKeystroke: anEvent ].
	self dispatchKeystroke: anEvent! !

!PasteUpMorph methodsFor: 'accessing' stamp: 'PavelKrivanek 7/24/2014 10:53'!
windowsSatisfying: windowBlock

	| windows |
	windows := OrderedCollection new.
	self submorphs do: [:m | 
		m embeddedWindowOrNil ifNotNil: [ 
			(windowBlock value: m) 
				ifTrue: [ windows addLast: m ] ] ].
		
	^ windows.		
		! !

!PasteUpMorph methodsFor: 'world state' stamp: 'StephaneDucasse 2/9/2011 17:59'!
deleteAllHalos
	"self halt.
	self haloMorphs
		do: [:each | (each target isKindOf: SelectionMorph)
				ifTrue: [each target delete]].
	self hands
		do: [:each | each removeHalo]"! !

!PasteUpMorph methodsFor: 'drawing' stamp: 'MarcusDenker 10/10/2013 23:47'!
drawBackgroundSketchOn: aCanvas
	backgroundMorph ifNil: [ ^ self ].
	self clipSubmorphs
		ifTrue: [ aCanvas clipBy: self clippingBounds during: [ :canvas | canvas fullDrawMorph: backgroundMorph ] ]
		ifFalse: [ aCanvas fullDrawMorph: backgroundMorph ]! !

!PasteUpMorph methodsFor: 'options' stamp: 'tk 10/30/2001 18:41'!
toggleResizeToFit
	"Toggle whether the receiver is set to resize-to-fit"

	self vResizeToFit: self resizeToFit not! !

!PasteUpMorph methodsFor: 'submorphs-add/remove' stamp: 'RAA 12/16/2000 18:37'!
addMorphFront: aMorph

	^self addMorphInFrontOfLayer: aMorph
! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'AlainPlantec 2/17/2010 01:53'!
invokeWorldMenuFromEscapeKey
	self invokeWorldMenu: ActiveEvent! !

!PasteUpMorph methodsFor: 'options' stamp: 'sw 7/6/1999 13:36'!
toggleOriginAtCenter
	| hasIt |
	hasIt := self hasProperty: #originAtCenter.
	hasIt
		ifTrue:
			[self removeProperty: #originAtCenter]
		ifFalse:
			[self setProperty: #originAtCenter toValue: true]! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'AlainPlantec 12/13/2009 08:12'!
lastKeystroke: aString	
	"Remember the last keystroke fielded by the receiver"	
	^ self setProperty: #lastKeystroke toValue: aString! !

!PasteUpMorph methodsFor: 'event handling' stamp: 'ar 10/3/2000 22:46'!
handlesMouseDown: evt
	^true! !

!PasteUpMorph methodsFor: 'private' stamp: 'nk 7/8/2003 09:18'!
privateRemoveMorph: aMorph
	backgroundMorph == aMorph ifTrue: [ backgroundMorph := nil ].
	^super privateRemoveMorph: aMorph.
! !

!PasteUpMorph methodsFor: 'initialization' stamp: 'dgd 2/14/2003 22:29'!
defaultColor
	"answer the default color/fill style for the receiver"
	^ Color
		r: 0.8
		g: 1.0
		b: 0.6! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'AlainPlantec 10/17/2009 17:32'!
nonWindows
	^ (self submorphs select: [:m | (m isSystemWindow) not and: [m wantsToBeTopmost not]])! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'AlainPlantec 1/9/2010 06:07'!
collapseNonWindows
	self nonWindows reject: [:m | m isSticky] thenDo: [:m | m collapse]! !

!PasteUpMorph methodsFor: 'gridding' stamp: 'di 8/24/2000 13:28'!
gridSpecPut: newSpec
	"Gridding rectangle provides origin and modulus"

	^ self setProperty: #gridSpec toValue: newSpec! !

!PasteUpMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/18/2007 16:18'!
previousWindow
	"Answer the previous window to navigate to."

	|sys|
	sys := self systemWindows.
	sys ifEmpty: [^nil].
	^sys before: self currentWindow ifAbsent: [sys last]! !

!PasteUpMorph methodsFor: 'event handling' stamp: 'ar 2/23/2001 16:44'!
morphToGrab: event
	"Return the morph to grab from a mouse down event. If none, return nil."
	self submorphsDo:[:m|
		((m rejectsEvent: event) not and:[m fullContainsPoint: event cursorPoint]) ifTrue:[^m].
	].
	^nil! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'StephaneDucasse 2/13/2010 11:38'!
showImage: aForm 
	"Show an image, possibly attached to the pointer for positioning"

       HandMorph attach: (World drawingClass withForm: aForm)! !

!PasteUpMorph methodsFor: 'dropping/grabbing' stamp: 'sw 7/6/1999 13:26'!
originAtCenter
	^ self hasProperty: #originAtCenter! !

!PasteUpMorph methodsFor: '*Morphic-Widgets-Taskbar' stamp: 'MarcusDenker 3/23/2011 15:29'!
moveCollapsedWindowsToTaskbar
	"Move collapsed windows to the taskbar."
	
	(self systemWindows select: [:w | w isCollapsed]) do: [:w |
		w restore; minimize]! !

!PasteUpMorph methodsFor: 'event handling' stamp: 'StephaneDucasse 7/2/2013 17:27'!
handlesKeyboard: evt
	^ evt keyCharacter == Character tab and: [ self tabAmongFields ]! !

!PasteUpMorph methodsFor: 'menu & halo' stamp: 'StephaneDucasse 8/23/2014 19:47'!
contentsMenu: aMenu
	"Build the menu used from PopUpContentsMenu:"
	(self submorphs asSortedCollection: [:w1 :w2 | w1 class name caseInsensitiveLessOrEqual: w2 class name]) do:
		[:w | aMenu add: w class name target: w selector: #comeToFront ].
	^ aMenu! !

!PasteUpMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/12/2007 17:01'!
modalUnlockFrom: aSystemWindow
	"Don't unlock the world!! Unlock the submorphs
	that were not originally locked."
	
	|lockStates|
	lockStates := self
		valueOfProperty: #submorphLockStates
		ifAbsent: [^self].
	self removeProperty: #submorphLockStates.
	lockStates keysAndValuesDo: [:m :locked |
		locked ifFalse: [m unlock]]! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'nice 1/5/2010 15:59'!
initializeDesktopCommandKeySelectors
	"Provide the starting settings for desktop command key selectors.  Answer the dictionary."

	"ActiveWorld initializeDesktopCommandKeySelectors"
	| dict |
	dict := IdentityDictionary new.
	self defaultDesktopCommandKeyTriplets do:
		[:trip | | messageSend |
			messageSend := MessageSend receiver: trip second selector: trip third.
			dict at: trip first put: messageSend].
	self setProperty: #commandKeySelectors toValue: dict.
	^ dict

! !

!PasteUpMorph methodsFor: 'event handling' stamp: 'PavelKrivanek 7/13/2014 13:43'!
dropFiles: anEvent
	"Handle a number of dropped files from the OS.
	TODO:
		- use a more general mechanism for figuring out what to do with the file (perhaps even offering a choice from a menu)
		- remember the resource location or (when in browser) even the actual file handle"
	| numFiles stream handler |
	
	UserManager default canDropOSFile ifFalse: [ ^ self ].
	
	numFiles := anEvent contents.
	1 to: numFiles do: [:i |
		(stream := FileStream requestDropStream: i) ifNotNil: [
			handler := ExternalDropHandler lookupExternalDropHandler: stream.
			[handler ifNotNil: [handler handle: stream in: self dropEvent: anEvent]]
				ensure: [stream close]]].! !

!PasteUpMorph methodsFor: 'event handling' stamp: 'tbn 3/12/2010 01:47'!
windowEventHandler
	"This is a class variable so it is global to all projects and does not get saved"
	^WindowEventHandler! !

!PasteUpMorph methodsFor: 'gridding' stamp: 'di 8/24/2000 13:28'!
gridOrigin

	^ self gridSpec origin! !

!PasteUpMorph methodsFor: '*Polymorph-Widgets' stamp: 'GaryChambers 6/10/2011 12:02'!
isWindowActive: aSystemWindow
	"Answer whether the given window is active.
	True if the current top window."
	
	^self currentWindow == aSystemWindow! !

!PasteUpMorph methodsFor: 'dropping/grabbing' stamp: 'stephane.ducasse 5/21/2009 15:15'!
positionNear: aPoint forExtent: anExtent adjustmentSuggestion: adjustmentPoint
	"Compute a plausible positioning for adding a subpart of size anExtent, somewhere near aPoint, using adjustmentPoint as the unit of adjustment"

	| adjustedPosition |
	adjustedPosition := aPoint.
	[((self morphsAt: (adjustedPosition + (anExtent // 2))) size > 1) and:  "that 1 is self here"
		[bounds containsPoint: adjustedPosition]]
	whileTrue:
		[adjustedPosition := adjustedPosition + adjustmentPoint].

	^ adjustedPosition! !

!PasteUpMorph methodsFor: '*Polymorph-Widgets' stamp: 'StephaneDucasse 3/10/2011 15:32'!
navigateVisibleWindowForward
	"Change the active window to the next visible and not collapsed window."
 
	self nextVisibleWindow
		ifNil: [SystemWindow passivateTopWindow]
		ifNotNil: [:m | m activate]
 ! !

!PasteUpMorph methodsFor: 'world state' stamp: 'IgorStasenko 1/2/2012 19:04'!
chooseClickTarget
	Cursor crossHair showWhile:
		[self activeHand waitButton].
	Cursor down showWhile:
		[self activeHand anyButtonPressed].
	^ (self morphsAt: self activeHand cursorPoint) first! !

!PasteUpMorph methodsFor: '*Morphic-Widgets-Taskbar' stamp: 'MarcusDenker 3/23/2011 15:30'!
createTaskbarIfNecessary
	"Private - create a new taskbar if not present."

	self taskbars ifEmpty: [
		TaskbarMorph new openInWorld: self.
		self moveCollapsedWindowsToTaskbar]! !

!PasteUpMorph methodsFor: 'stepping' stamp: 'ar 10/22/2000 16:39'!
startStepping: aMorph
	"Add the given morph to the step list. Do nothing if it is already being stepped."
	^self startStepping: aMorph at: Time millisecondClockValue selector: #stepAt: arguments: nil stepTime: nil! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'sw 3/13/2003 13:56'!
respondToCommand: aCharacter bySending: aSelector to: aReceiver
	"Respond to the command-key use of the given character by sending the given selector to the given receiver.  If the selector is nil, retract any prior such setting"

	aSelector
		ifNil:
			[self commandKeySelectors removeKey: aCharacter]
		ifNotNil:
			[self commandKeySelectors at: aCharacter put: (MessageSend receiver: aReceiver selector: aSelector)]! !

!PasteUpMorph methodsFor: 'Morphic-Base-Windows' stamp: 'stephane.ducasse 9/25/2008 13:33'!
expandAll
	"Expand all windows"
	(self  windowsSatisfying: [:w | w isCollapsed])
		reverseDo: [:w | w collapseOrExpand.  self displayWorld]! !

!PasteUpMorph methodsFor: '*Polymorph-Widgets' stamp: 'SeanDeNigris 1/23/2014 00:28'!
openModal: aSystemWindow
	"Open the given window locking the receiver until it is dismissed.
	Set the pane color to match the current theme.
	Answer the system window."
	
	aSystemWindow setWindowColor: self theme windowColor.
	^ super openModal: aSystemWindow! !

!PasteUpMorph methodsFor: 'gridding' stamp: 'di 8/24/2000 13:29'!
gridOrigin: newOrigin

	^ self gridSpecPut: (newOrigin extent: self gridModulus)! !

!PasteUpMorph methodsFor: 'thumbnail' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
icon
	^ Smalltalk ui icons homeIcon! !

!PasteUpMorph methodsFor: '*Morphic-Base' stamp: 'janniklaval 3/8/2011 12:31'!
fitAll
	"Fit all windows as visible"
	|allowedArea|
	allowedArea := RealEstateAgent maximumUsableAreaInWorld: World.
	(self  windowsSatisfying: [:w | w isCollapsed not])
		reverseDo:[:w | 
			w extent: w initialExtent.  
			w bounds:((w position extent: w initialExtent) translatedAndSquishedToBeWithin: allowedArea).
		].
	self displayWorld! !

!PasteUpMorph methodsFor: 'caching' stamp: 'StephaneDucasse 7/2/2013 17:33'!
releaseCachedState
	super releaseCachedState.
	self removeModalWindow.
! !

!PasteUpMorph methodsFor: 'menu & halo' stamp: 'StephaneDucasse 10/27/2014 20:19'!
addWorldToggleItemsToHaloMenu: aMenu
	"Add toggle items for the world to the halo menu"

	#(
	(hasDragAndDropEnabledString changeDragAndDrop 'whether I am open to having objects dropped into me')
	(roundedCornersString toggleCornerRounding 'whether the world should have rounded corners')) do:

		[:trip | aMenu addUpdating: trip first selector: trip second.
			aMenu balloonTextForLastItem: trip third]! !

!PasteUpMorph methodsFor: 'gridding' stamp: 'di 8/24/2000 13:26'!
gridSpec
	"Gridding rectangle provides origin and modulus"

	^ self valueOfProperty: #gridSpec ifAbsent: [0@0 extent: 8@8]! !

!PasteUpMorph methodsFor: '*Polymorph-Widgets' stamp: 'CamilloBruni 2/16/2012 11:52'!
modalLockTo: aSystemWindow
	"Don't lock the world nor the aSystemWindow!! Lock the submorphs."
	
	|lockStates|
	
	lockStates := IdentityDictionary new.
	"lock all submorphs"
	self submorphsDo: [:m |
		lockStates at: m put: m isLocked.
		m lock].
	"don't lock the given window"
	aSystemWindow unlock.
	lockStates at: aSystemWindow put: aSystemWindow isLocked.
	
	self
		setProperty: #submorphLockStates
		toValue: lockStates! !

!PasteUpMorph methodsFor: 'Morphic-Base-Windows' stamp: 'BenComan 7/24/2014 01:57'!
closeUnchangedWindows
	"Present a menu of window titles for all windows with changes,
	and activate the one that gets chosen."
	(self confirm:
'Do you really want to close all windows
except those with unaccepted edits?' translated)
		ifFalse: [^ self].

	self  closeAllUnchangedWindows.! !

!PasteUpMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/18/2007 16:18'!
nextWindow
	"Answer the next window to navigate to."

	|sys|
	sys := self systemWindows.
	sys ifEmpty: [^nil].
	^sys after: self currentWindow ifAbsent: [sys first]! !

!PasteUpMorph methodsFor: 'gridding' stamp: 'dgd 12/13/2003 19:30'!
gridVisibleString
	"Answer a string to be used in a menu offering the opportunity 
	to show or hide the grid"
	^ (self gridVisible
		ifTrue: ['<yes>']
		ifFalse: ['<no>'])
		, 'show grid when gridding' translated! !

!PasteUpMorph methodsFor: 'initialization' stamp: 'ClementBera 10/3/2013 10:30'!
becomeActiveDuring: aBlock
	"Make the receiver the ActiveWorld during the evaluation of aBlock.
	Note that this method does deliberately *not* use #ensure: to prevent
	re-installation of the world on project switches."
	| priorWorld priorHand priorEvent |
	priorWorld := ActiveWorld.
	priorHand := ActiveHand.
	priorEvent := ActiveEvent.
	ActiveWorld := self.
	ActiveHand := self hands first. "default"
	ActiveEvent := nil. "not in event cycle"
	aBlock
		on: Error
		do: [:ex | 
			ActiveWorld := priorWorld.
			ActiveEvent := priorEvent.
			ActiveHand := priorHand.
			ex pass]! !

!PasteUpMorph methodsFor: '*Polymorph-Widgets' stamp: 'MarcusDenker 12/11/2009 07:42'!
navigateWindowForward
	"Change the active window to the next window."

	self nextWindow ifNotNil: [:m |
		self currentWindow ifNotNil: [:w | w sendToBack].
		m isCollapsed ifTrue: [m collapseOrExpand].
		m activate]! !

!PasteUpMorph methodsFor: 'event handling' stamp: 'AlainPlantec 12/10/2009 11:38'!
wantsEasySelection
	"Answer if the receiver want easy selection mode"
	^ self isEasySelecting ! !

!PasteUpMorph methodsFor: 'recategorized' stamp: 'gvc 1/12/2007 17:06'!
handlerForMouseDown: anEvent
	"If we have a modal dialog then answer nil otherwise as usual.."
	
	^(self hasProperty: #submorphLockStates)
		ifFalse: [super handlerForMouseDown: anEvent]! !

!PasteUpMorph methodsFor: 'gridding' stamp: 'di 8/24/2000 13:29'!
gridModulus

	^ self gridSpec extent! !

!PasteUpMorph methodsFor: 'world state' stamp: 'MarcusDenker 9/13/2013 15:50'!
addMorphs: aMorphOrList 
	"Dump in submorphs, and stepList from aMorphOrList.  Used to bring a world, paste-up, or other morph in from an object file."

	aMorphOrList isMorph 
		ifTrue:  
			[
			aMorphOrList privateOwner: nil.
			aMorphOrList isWorldMorph 
					ifFalse:  
						[ 
						self firstHand attachMorph: aMorphOrList.
						self startSteppingSubmorphsOf: aMorphOrList]
					ifTrue: 
						[
						self addMorph: aMorphOrList ].
					aMorphOrList privateSubmorphs reverseDo: 
						[:m | 
							m privateOwner: nil.
							self addMorph: m.
							m changed].
				(aMorphOrList instVarNamed: 'stepList') 
							do: [:entry | entry first startSteppingIn: self]]
		ifFalse: 
			["list, add them all"
			aMorphOrList reverseDo: 
					[:m | 
					m privateOwner: nil.
					self addMorph: m.
					self startSteppingSubmorphsOf: m.	"It may not want this!!"
					m changed]]! !

!PasteUpMorph methodsFor: 'menu & halo' stamp: 'StephaneDucasse 6/5/2014 19:50'!
contentsMenuTitle
	^ 'Contents' translated! !

!PasteUpMorph methodsFor: 'event handling' stamp: 'StephaneDucasse 7/2/2013 17:28'!
wantsWindowEvent: anEvent
	^ self windowEventHandler notNil! !

!PasteUpMorph methodsFor: 'initialization' stamp: 'dgd 2/14/2003 22:35'!
defaultBorderColor
	"answer the default border color/fill style for the receiver"
	^ Color
		r: 0.861
		g: 1.0
		b: 0.722! !

!PasteUpMorph methodsFor: 'halos and balloon help' stamp: 'StephaneDucasse 2/19/2010 16:02'!
wantsHaloFromClick
	(owner isSystemWindow) ifTrue: [^ false].
	^ true.
! !

!PasteUpMorph methodsFor: 'world state' stamp: 'alain.plantec 2/6/2009 11:39'!
checkCurrentHandForObjectToPaste

	| response |
	self primaryHand pasteBuffer ifNil: [^self].
	response := self confirm: ('Hand is holding a Morph in its paste buffer:' translated, '\') withCRs,
			self primaryHand pasteBuffer printString, 
			('\', 'Delete it ?' translated) withCRs.
	response = 1 ifTrue: [self primaryHand pasteBuffer: nil].
! !

!PasteUpMorph methodsFor: 'dropping/grabbing' stamp: 'ar 10/11/2000 18:22'!
repelsMorph: aMorph event: ev
	(aMorph wantsToBeDroppedInto: self) ifFalse: [^ false].
	self dropEnabled ifFalse: [^ true].
	(self wantsDroppedMorph: aMorph event: ev) ifFalse: [^ true].
	^ super repelsMorph: aMorph event: ev "consults #repelling flag"! !

!PasteUpMorph methodsFor: '*Polymorph-Widgets' stamp: 'MarcusDenker 12/11/2009 07:41'!
navigateWindowBackward
	"Change the active window to the previous window."

	self previousWindow ifNotNil: [:m |
		m isCollapsed ifTrue: [m collapseOrExpand].
		m activate]! !

!PasteUpMorph methodsFor: 'event handling' stamp: 'tbn 3/12/2010 01:47'!
windowEventHandler: anObject
	"This is a class variable so it is global to all projects and does not get saved"
	WindowEventHandler := anObject
! !

!PasteUpMorph methodsFor: 'event handling' stamp: 'StephaneDucasse 7/18/2010 16:37'!
wantsKeyboardFocusFor: aSubmorph

	aSubmorph wouldAcceptKeyboardFocus ifTrue: [ ^ true].
	^ super wantsKeyboardFocusFor: aSubmorph! !

!PasteUpMorph methodsFor: 'gridding' stamp: 'di 8/24/2000 16:47'!
gridModulus: newModulus

	self gridSpecPut: (self gridOrigin extent: newModulus).
	self changed! !

!PasteUpMorph methodsFor: 'Morphic-Base-Basic' stamp: 'adrian_lienhard 7/19/2009 20:50'!
morphToDropFrom: aMorph 
	"Given a morph being carried by the hand, which the hand is about to drop, answer the actual morph to be deposited.  Normally this would be just the morph itself, but several unusual cases arise, which this method is designed to service."

	^aMorph ! !

!PasteUpMorph methodsFor: 'gridding' stamp: 'MarcusDenker 5/2/2013 11:35'!
setGridSpec
	"Gridding rectangle provides origin and modulus"
	| response result |
	response := UIManager default
			request: 'New grid origin (usually 0@0):' translated
			initialAnswer: self gridOrigin printString.
	response isEmpty ifTrue: [^ self].
	result := [self class compiler evaluate: response] ifError: [^ self].
	(result isPoint and: [(result >= (0@0))])
		ifTrue: [self gridOrigin: result]
		ifFalse: [self inform: ('Must be a Point with coordinates (for example 10@10)' translated )].

	response := UIManager default
			request: 'New grid spacing:' translated
			initialAnswer: self gridModulus printString.
	response isEmptyOrNil ifTrue: [^ self].
	result := [self class compiler evaluate: response] ifError: [^ self].
	(result isPoint and: [(result > (0@0)) ])
		ifTrue: [self gridModulus: result]
		ifFalse: [self inform: ('Must be a Point with coordinates (for example 10@10)' translated )].

! !

!PasteUpMorph methodsFor: '*Polymorph-Widgets' stamp: 'AlainPlantec 5/13/2011 09:16'!
backgroundMorph: aMorph
	"Set the background morph.
	Probably best if locked prior to adding."

	self backgroundMorph isNil ifFalse: [
		self backgroundMorph delete].
	backgroundMorph := aMorph.
	aMorph isNil ifFalse: [
		aMorph bounds: self bounds.
		self addMorphBack: aMorph]! !

!Path commentStamp: '<historical>'!
I'm a private and abstract filesystem path, independent of the string representation used to describe paths on a specific filesystem. I provide methods for navigating the filesystem hierarchy and working with absolute and relative paths. I only refer to a concrete file or directory with regard to a specific filesystem. Normally users should not use me directly. 

Path independent representation of delimiter is defined by DiskFileSystem current delimiter.

API instance creation:
#* and #/ are mnemonic to . and /
whose arguments should  be string file- or directory names, not fragments of Unix path notation intended to be parsed.

#/ and #* provide a mini-DSL for building up paths, while
#readFrom:delimiter: parses path strings.

Note that (Path with: 'parent/child/') isRelative returns true
because it creates to a relative path to a file/directory called
'parent/child'. In bash you'd escape the slashes like this: parent\/child\/

similarly 
(Path with: '/parent/child/') isRelative returns true
That's a relative path to '/parent/child'. In bash: /\parent\/child\/

(Path with: '') isRelative returns false

Because this is an absolute path to the root of the file system. Absolute paths
have an empty first element. If you consider $/ the separator,
'/usr/local/bin' has an empty first element.

!
!Path methodsFor: 'testing' stamp: 'cwp 2/26/2011 11:03'!
isRoot
	self subclassResponsibility ! !

!Path methodsFor: 'navigating' stamp: 'cwp 3/29/2011 16:25'!
resolve: anObject
	"Return a path in which the argument has been interpreted in the context of the receiver. Different 
	argument types have different resolution semantics, so we use double dispatch to resolve them correctly."
	
	^ anObject asResolvedBy: self! !

!Path methodsFor: 'comparing' stamp: 'CamilloBruni 9/5/2012 18:07'!
isContainedBy: anObject
	"DoubleDispatch helper for #contains:"
	^ anObject containsPath: self! !

!Path methodsFor: 'private' stamp: 'cwp 10/25/2009 19:53'!
isAllParents
	1 to: self size do: [:i | (self at: i) = '..' ifFalse: [^ false]].
	^ true! !

!Path methodsFor: 'comparing' stamp: 'cwp 10/25/2009 23:05'!
containsReference: aReference
	^ false! !

!Path methodsFor: 'testing' stamp: 'cwp 7/18/2009 00:42'!
isWorkingDirectory
	^ self size = 0! !

!Path methodsFor: 'navigating' stamp: 'cwp 3/29/2011 16:30'!
resolveString: aString
	"Treat strings as relative paths with a single element."
	
	^ self / aString! !

!Path methodsFor: 'navigating' stamp: 'cwp 10/25/2009 19:53'!
parent
	| size parent |
	self isRoot ifTrue: [^ self].
	self isAllParents ifTrue: [^ self / '..'].
	
	size := self size - 1.
	parent := self class new: size.
	1 to: size do: [:i | parent at: i put: (self at: i)].
	^ parent! !

!Path methodsFor: 'printing' stamp: 'cwp 2/26/2011 17:58'!
printOn: aStream delimiter: aCharacter
	(1 to: self size)
		do: [:index | aStream nextPutAll: (self at: index)]
		separatedBy: [aStream nextPut: aCharacter]! !

!Path methodsFor: 'accessing' stamp: 'SeanDeNigris 6/28/2012 00:09'!
extension
	"Return the extension of path basename i.e., /foo/gloops.taz extension is 'taz'"
	
	^ self basename copyAfterLast: self extensionDelimiter! !

!Path methodsFor: 'testing' stamp: 'DamienPollet 2/20/2011 04:00'!
isEmpty
	^ self size = 0! !

!Path methodsFor: 'accessing' stamp: 'sd 2/11/2011 21:02'!
fullName
	"Return the fullName of the receiver."
	
	^ self printString! !

!Path methodsFor: 'navigating' stamp: 'cwp 3/29/2011 16:23'!
relativeToReference: aReference 
	^ self relativeToPath: aReference path! !

!Path methodsFor: 'navigating' stamp: 'cwp 11/15/2009 00:00'!
relativeTo: anObject
	^ anObject makeRelative: self! !

!Path methodsFor: '*Network-Url' stamp: 'SvenVanCaekenberghe 10/25/2013 17:03'!
asUrl 
	^ self asZnUrl! !

!Path methodsFor: 'navigating' stamp: 'cwp 11/15/2009 00:00'!
makeRelative: anObject
	^ anObject relativeToPath: self! !

!Path methodsFor: 'navigating' stamp: 'cwp 11/17/2009 23:52'!
, extension 
	^ self withName: self basename extension: extension! !

!Path methodsFor: 'private' stamp: 'cwp 12/13/2008 21:08'!
copyFrom: aPath
	| size |
	size := aPath size min: self size.
	1 to: size do: [:i | self at: i put: (aPath at: i)].
	! !

!Path methodsFor: 'testing' stamp: 'cwp 12/13/2008 21:00'!
isRelative
	^ self isAbsolute not! !

!Path methodsFor: 'navigating' stamp: 'CamilloBruni 1/19/2012 14:31'!
resolvePath: aPath
	"Answers an absolute path created by resolving the argument against the receiver.
	If the argument is abolute answer the argument itself. Otherwise, concatenate the
	two paths, then process all parent references '..', and create a path with the remaining
	elements."
	
	| elements |
	
	aPath isAbsolute ifTrue: [^ aPath].
	elements := Array new: self size + aPath size.
	
	1 to: self size do: [:i | elements at: i put: (self at: i)].
	1 to: aPath size do: [:i | elements at: self size + i put: (aPath at: i)].
	
	^ self class withAll: (self class canonicalizeElements: elements)! !

!Path methodsFor: 'accessing' stamp: 'CamilloBruni 8/12/2011 20:16'!
segments
	"return an array with all the path segements separated"
	| segments index |
	segments := Array new: self size.
	index := 1.
	self do: [ :part|
		segments at: index put: part.
		index := index + 1 ].
	
	^ segments! !

!Path methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2010 18:06'!
base
	"Returns the base of the basename, i.e. /foo/gloops.taz basename is 'gloops'"
	^ self basename copyUpTo: self extensionDelimiter! !

!Path methodsFor: 'navigating' stamp: 'VincentBlondeau 2/1/2015 13:05'!
relativeToPath: aPath
	"Return the receiver as relative to the argument aPath"

	"(Path / 'griffle' / 'plonk' / 'nurp') 
		relativeToPath: (Path / 'griffle') 
			returns  plonk/nurp"

	| prefix relative |
	prefix := self lengthOfStemWith: aPath.
	relative := RelativePath parents: aPath size - prefix.
	prefix + 1 to: self size do: [ :i | relative := relative / (self at: i) ].
	^ relative! !

!Path methodsFor: 'private' stamp: 'cwp 11/17/2009 23:58'!
withName: name extension: extension
	| basename |
	basename :=String streamContents:
		[:out |
		out nextPutAll: name.
		out nextPut: self extensionDelimiter.
		out nextPutAll: extension].
	^ self copy 
		at: self size put: basename;
		yourself! !

!Path methodsFor: 'accessing' stamp: 'CamilloBruni 6/22/2012 18:22'!
basenameWithoutExtension
	"Returns the base of the basename but without its extension, 
		i.e. 
		/foo/gloops.taz basenameWithoutExtension is 'gloops'
		/ basenameWithoutExtension is '/'"
	
	^ self basename copyUpToLast: self extensionDelimiter! !

!Path methodsFor: 'accessing' stamp: 'CamilloBruni 8/9/2011 16:11'!
basename
	"Returns the base of the basename, 
		i.e. 
		/foo/gloops.taz basename is 'gloops.taz'
		/ basename is '/'"
	self size == 0
		"the root node"
		ifTrue: [ ^ '/'].
	^ self at: self size! !

!Path methodsFor: 'accessing' stamp: 'cwp 10/11/2009 11:05'!
delimiter
	^ $/! !

!Path methodsFor: 'navigating' stamp: 'CamilloBruni 8/15/2011 17:36'!
/ aString
	| path |

	aString isEmptyOrNil 
		ifTrue: [ Error signal: 'Path element cannot be empty or nil'].
		
	path := self class new: self size + 1.
	path copyFrom: self.
	path at: path size put: aString.
	^ path! !

!Path methodsFor: 'comparing' stamp: 'CamilloBruni 9/5/2012 18:05'!
contains: anObject
	"Return true if anObject is in a subfolder of me"
	^ anObject isContainedBy: self! !

!Path methodsFor: 'accessing' stamp: 'CamilloBruni 7/10/2012 17:41'!
basename: newBasename
	"change the basename"
	self size == 0
		"the root node"
		ifTrue: [ ^ Error signal: '0 length Path, cannot change basename'].
	self at: self size put: newBasename! !

!Path methodsFor: 'converting' stamp: 'cwp 10/10/2009 18:04'!
asPathWith: anObject
	^ self! !

!Path methodsFor: 'comparing' stamp: 'cwp 11/16/2009 09:06'!
isChildOf: anObject
	^ self parent = anObject! !

!Path methodsFor: 'printing' stamp: 'cwp 11/17/2009 10:22'!
printOn: aStream 
	self printOn: aStream delimiter: self delimiter.
! !

!Path methodsFor: 'comparing' stamp: 'cwp 10/25/2009 22:59'!
containsPath: aPath
	self size < aPath size ifFalse: [^ false].
	1	to: self size 
		do: [:i | (self at: i) = (aPath at: i) ifFalse: [^ false]].
	^ true! !

!Path methodsFor: 'printing' stamp: 'cwp 1/13/2009 21:27'!
printWithDelimiter: aCharacter
	^ String streamContents: [:out | self printOn: out delimiter: aCharacter]! !

!Path methodsFor: 'navigating' stamp: 'cwp 9/22/2009 09:06'!
resolveReference: aReference
	^ aReference! !

!Path methodsFor: 'comparing' stamp: 'cwp 12/14/2008 17:06'!
hash
	| hash |
	hash := self class identityHash.
	1 to: self size do:
		[:i | hash := String stringHash: (self at: i) initialHash: hash].
	^ hash! !

!Path methodsFor: 'navigating' stamp: 'cwp 11/17/2009 23:51'!
withExtension: extension 
	| basename name |
	basename := self basename.
	^ (basename endsWith: extension) 
		ifTrue: [ self ]
		ifFalse: 
			[name := basename copyUpToLast: self extensionDelimiter.
			self withName: name extension: extension]! !

!Path methodsFor: 'navigating' stamp: 'BernardoContreras 2/20/2015 15:53'!
parentUpTo: aParentDirName
	"Answers the path of the parent dir with name aParentDirName or root if not found."

	self withParents
		reverseDo: [ :dir | 
			dir basename = aParentDirName
				ifTrue: [ ^ dir ] ].
	^ Path root! !

!Path methodsFor: 'accessing' stamp: 'CamilloBruni 6/22/2012 18:18'!
extensions
	"Return the extensions of the receiver in order of appearance"
	"(Path from: '/foo/bar.tar.gz') extensions"
	^ (self extensionDelimiter split: self basename) allButFirst! !

!Path methodsFor: 'enumerating' stamp: 'cwp 3/29/2011 16:42'!
withParents
	| paths |
	paths := OrderedCollection new.
	1 to: self size -1 do: [ :index | paths add: ((self class new: index) copyFrom: self) ].
	paths add: self.
	
	^ paths! !

!Path methodsFor: 'private' stamp: 'CamilloBruni 8/12/2011 16:42'!
lengthOfStemWith: aPath
	| limit index |
	limit := self size min: aPath size.
	index := 1.
	[index <= limit and: [(self at: index) = (aPath at: index)]] 
		whileTrue: [index := index + 1].
	^ index - 1! !

!Path methodsFor: 'testing' stamp: 'cwp 2/26/2011 10:58'!
isAbsolute
	self subclassResponsibility ! !

!Path methodsFor: 'converting' stamp: 'EstebanLorenzano 4/12/2012 14:28'!
asFileReference
	^ FileSystem disk referenceTo: self! !

!Path methodsFor: 'navigating' stamp: 'cwp 9/22/2009 09:08'!
asResolvedBy: anObject
	^ anObject resolvePath: self! !

!Path methodsFor: 'comparing' stamp: 'cwp 12/14/2008 17:36'!
= other
	^ self species = other species
		and: [self size = other size
			and: [(1 to: self size) allSatisfy: [:i | (self at: i) = (other at: i)]]]! !

!Path methodsFor: 'enumerating' stamp: 'cwp 7/18/2009 01:13'!
do: aBlock 
	1 
		to: self size
		do: 
			[ :index || segment |
			segment := self at: index.
			segment isEmpty ifFalse: [ aBlock value: segment ] ]! !

!Path methodsFor: 'navigating' stamp: 'cwp 11/16/2009 10:19'!
resolve
	^ self! !

!Path methodsFor: 'accessing' stamp: 'cwp 12/23/2008 11:25'!
extensionDelimiter
	^ self class extensionDelimiter! !

!Path methodsFor: 'comparing' stamp: 'CamilloBruni 8/21/2013 17:51'!
<= other
	^ self fullName <= other fullName! !

!Path class methodsFor: 'instance creation' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
root
	"Answer the root path - ie, / on unix"
	
	^ AbsolutePath new! !

!Path class methodsFor: 'private' stamp: 'tbn 6/26/2012 21:02'!
isAbsoluteUnixPath: aString
	^aString first = $/ ! !

!Path class methodsFor: 'private' stamp: 'CamilloBruni 2/14/2014 14:28'!
canonicalizeElements: aCollection
	| result |
	result := OrderedCollection new.
	aCollection do: [ :element |
		self addElement: element to: result].
	^ result! !

!Path class methodsFor: 'private' stamp: 'BenComan 3/14/2014 23:29'!
absoluteWindowsPathRegex
	"Return a copy of the regex since it is not thread-safe.
	Note: That the #copy only makes a shallow copy which is fast and but sufficient.
	Note: The slow part is parsing the regular expression, which only happens once here"
	
	"Case13065 Force re-initialization of variable during integration. 
	Subsequently next line should be removed as step 2 of integration" 
	absoluteWindowsPathRegex := '([a-zA-Z]\:)?\\.*' asRegex. 
	
	^ (absoluteWindowsPathRegex ifNil: [ 
		absoluteWindowsPathRegex := '([a-zA-Z]\:)?\\.*' asRegex ]) copy! !

!Path class methodsFor: 'private' stamp: 'cwp 10/26/2009 13:41'!
addEmptyElementTo: result
	result isEmpty ifTrue: [result add: '']
		! !

!Path class methodsFor: 'instance creation' stamp: 'CamilloBruni 9/5/2012 11:25'!
/ aString
	"Answer an absolute path with aString as it's sole segment. The selector
	was chosen to allow path construction with Smalltalk syntax, which 
	neverthelesss resembles paths as they appear in a unix shell. Eg.
	Path / 'griffle' / 'plonk'."
	
	aString isEmptyOrNil 
		ifTrue: [ Error signal: 'Path element cannot be empty or nil'].
	^ AbsolutePath with: aString! !

!Path class methodsFor: 'private' stamp: 'CamilloBruni 5/30/2013 22:43'!
isAbsoluteWindowsPath: aString
	^ self absoluteWindowsPathRegex matches: aString! !

!Path class methodsFor: 'private' stamp: 'CamilloBruni 9/5/2012 11:28'!
with: aString
	"Answer a relative path of the given string. N.B. that the argument is not parsed; 
	it is the name of a single path element, and path separators in it do not have 
	special meaning."
	
	"(Path with: '/parent/child/') isRelative
	answers true because this is a relative path to a file or directory named 
	'/parent/child/'. In bash: \/parent\/child\/"

	| inst |
	inst := self new: 1.
	inst at: 1 put: aString.
	^ inst! !

!Path class methodsFor: 'private' stamp: 'CamilloBruni 2/14/2014 14:46'!
addParentElementTo: result
	(result isEmpty or: [ result last = '..' ])
		ifTrue: [ result add: '..' ]
		ifFalse: [ result removeLast ]
		! !

!Path class methodsFor: 'instance creation' stamp: 'CamilloBruni 5/7/2012 02:19'!
from: aString
	^ self from: aString delimiter: $/! !

!Path class methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 10/11/2013 12:54'!
cleanUp
	absoluteWindowsPathRegex := nil.! !

!Path class methodsFor: 'instance creation' stamp: 'CamilloBruni 2/14/2014 14:28'!
from: aString delimiter: aDelimiterCharacter 
	"Answer a path composed of several elements delimited by aCharacter"
	| pathClass |
	aString isEmpty
		ifTrue: [ ^ self root ].
	
	pathClass :=  ((self isAbsoluteUnixPath: aString) or: [self isAbsoluteWindowsPath: aString]) 
		ifTrue: [ AbsolutePath ]
		ifFalse:[ RelativePath ].
	
	^ pathClass withAll: (pathClass canonicalizeElements: (aDelimiterCharacter split: aString))! !

!Path class methodsFor: 'instance creation' stamp: 'cwp 11/15/2009 00:11'!
parents: anInteger
	| path |
	path := self new: anInteger.
	1 to: anInteger do: [:i | path at: i put: '..'].
	^ path! !

!Path class methodsFor: 'instance creation' stamp: 'EstebanLorenzano 4/2/2012 11:43'!
workingDirectory
	"Answer a path that will always resolve to the current working directory."
	
	^ RelativePath new! !

!Path class methodsFor: 'instance creation' stamp: 'EstebanLorenzano 4/2/2012 11:43'!
parent
	"Answer a path that resolves to the parent of the current
	working directory. This is similar to .. in unix, but doesn't
	rely on actual hardlinks being present in the filesystem."

	^ RelativePath with: '..'! !

!Path class methodsFor: 'private' stamp: 'CamilloBruni 2/14/2014 14:44'!
addElement: element to: result
	element = '..'
		ifTrue: [ ^ self addParentElementTo: result ].
	element = ''
		ifTrue: [ ^ self addEmptyElementTo: result ].
	element = '.'
		ifFalse: [ result add: element ]! !

!Path class methodsFor: 'private' stamp: 'CamilloBruni 5/8/2012 17:47'!
withAll: aCollection
	| inst |
	inst := self new: aCollection size.
	aCollection withIndexDo: [:segment :index |
		inst at: index put: segment].
	^ inst! !

!Path class methodsFor: 'instance creation' stamp: 'CamilloBruni 9/5/2012 11:25'!
* aString
	"Answer a relative path with aString as its sole segment. For example,
	Path * 'griffle' will produce the same result as ./griffle in a unix shell.
	The selector #* was chosen for it's visual similarity to $."
	
	"Note: aString is not parsed, so supplying a string like '/griffle/plonk'
	will not create an absolute path."
	
	^ RelativePath with: aString! !

!Path class methodsFor: 'encodings' stamp: 'StephaneDucasse 2/18/2011 22:31'!
extensionDelimiter
	"Return the extension delimiter character."
	^ $.! !

!PathShape commentStamp: 'LaurentLaffont 3/31/2011 21:05'!
I represent a model of an open sequence of connected points that can be queried for
enclosing bounds and whether a point lies along any segment.
 
I am typically used for drawing with a Canvas.

ps := PathShape new
        addVertex: 0@0;
        addVertex: 30@30;
        addVertex: 50@10.
        
self assert: (ps containsPoint: 24@24).
self assert: (ps containsPoint: 40@30) not.
Transcript show: ps calculatedBounds asString; cr.!
!PathShape methodsFor: 'accessing' stamp: 'gvc 10/31/2006 10:36'!
basicBounds
	"Answer the bounds of the receiver without lazy calculation."

	^bounds! !

!PathShape methodsFor: 'initialization' stamp: 'gvc 10/31/2006 10:35'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		vertices: OrderedCollection new! !

!PathShape methodsFor: 'as yet unclassified' stamp: 'gvc 6/25/2007 14:03'!
containsPoint: aPoint
	"Answer whether the receiver contains the given point."

	(self basicContainsPoint: aPoint) ifFalse: [^false].
	self segmentsDo: [:p1 :p2 |
		(aPoint onLineFrom: p1 to: p2 within: 0) ifTrue: [^true]].
	^false! !

!PathShape methodsFor: 'accessing' stamp: 'gvc 7/30/2009 13:40'!
bounds
	"Answer the bounds of the receiver."

	^bounds ifNil: [bounds := self calculatedBounds]! !

!PathShape methodsFor: 'accessing' stamp: 'gvc 10/31/2006 10:25'!
bounds: anObject
	"Set the value of bounds"

	bounds := anObject! !

!PathShape methodsFor: 'accessing' stamp: 'gvc 10/31/2006 10:24'!
vertices
	"Answer the value of vertices"

	^ vertices! !

!PathShape methodsFor: 'accessing' stamp: 'gvc 10/31/2006 11:08'!
vertices: aCollection
	"Set the value of vertices."

	vertices := aCollection asOrderedCollection.
	self bounds: nil! !

!PathShape methodsFor: 'as yet unclassified' stamp: 'gvc 10/31/2006 10:47'!
segmentsDo: aBlock
	"Evaluate the two-argument block with each vertex and its successor."

	self vertices size < 2 ifTrue: [^self].
	1 to: self vertices size - 1 do: [:i |
		aBlock
			value: (self vertices at: i)
			value: (self vertices at: i + 1)]! !

!PathShape methodsFor: 'as yet unclassified' stamp: 'gvc 6/25/2007 13:52'!
calculatedBounds
	"Answer the bounds of the receiver calculated from the
	receiver's vertices."

	|tl br|
	self vertices ifEmpty: [^nil].
	tl := br := self vertices first.
	self vertices allButFirstDo: [:v |
		tl := tl min: v.
		br := br max: v].
	^tl corner: br + 1! !

!PathShape methodsFor: 'as yet unclassified' stamp: 'gvc 10/31/2006 10:40'!
addVertex: aPoint
	"Add a vertex to the path."

	self vertices add: aPoint.
	self basicBounds ifNotNil: [
		self bounds: (self bounds quickMergePoint: aPoint)] ! !

!PathShape class methodsFor: 'as yet unclassified' stamp: 'gvc 10/31/2006 11:08'!
vertices: aCollection
	"Answer a new instance of the receiver with the
	given vertices."

	^self new
		vertices: aCollection! !

!PathTest commentStamp: 'TorstenBergmann 1/31/2014 11:44'!
SUnit tests for file system paths!
!PathTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testUnequalSize
	| a b |
	a := Path * 'plonk'.
	b := (Path * 'plonk') / 'griffle'.
	self deny: a = b.! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:39'!
testRelativeFromString

	| path |
	
	path := Path from: 'plonk/griffle'.
	
	self assert: path isRelative.
	self assert: path size equals: 2.
	self assert: (path at: 1) equals: 'plonk'.
	self assert: (path at: 2) equals: 'griffle'.! !

!PathTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testIsRelative
	self assert: (Path * 'plonk') isRelative! !

!PathTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testIsNotAbsolute
	self deny: (Path * 'plonk') isAbsolute! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:33'!
testRelativePrintString
	| path actual |
	path := Path * 'plonk' / 'griffle'.
	actual := path printString.
	self assert: actual equals: 'Path * ''plonk'' / ''griffle'''! !

!PathTest methodsFor: 'tests' stamp: 'VincentBlondeau 2/1/2015 13:09'!
testMakeRelativeFrom2RelativePaths
	"Related to issue: 14846 MakeRelative-method-applied-on-two-relative-paths-is-not-working"

	| parent child relative |
	parent := RelativePath new / 'griffle' / 'bibb'.
	child := RelativePath new / 'griffle' / 'plonk' / 'nurp'.
	relative := parent makeRelative: child.
	self assert: relative equals: Path parent / 'plonk' / 'nurp'! !

!PathTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testSiblingOfPath
	| griffle  nurb |
	griffle := Path / 'griffle'.
	nurb := Path / 'nurb'.
	self deny: (griffle isChildOf: nurb).
	self deny: (nurb isChildOf: griffle).! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:41'!
testRelativeFromStringNormalization

	| path |
	
	path := Path from: 'plonk/../griffle'.
	
	self assert: path isRelative.
	self assert: path size equals: 1.
	self assert: (path at: 1) equals: 'griffle'.! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:32'!
testParseBogus
	"self run: #testParseBogus"
	
	| path |
	path := Path from: 'parent?<>~ \child/grandChild' delimiter: $/.
	self assert: path size equals: 2.
	self assert: (path at: 1) equals: 'parent?<>~ \child'.
	self assert: (path at: 2) equals: 'grandChild'.
	
! !

!PathTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testRootParent
	| root |
	root := Path root.
	self assert: root parent == root! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:32'!
testExtensions
	self 
		assertCollection: (Path from: 'foo') extensions asArray
		equals: #().
	self
		assertCollection: (Path from: 'foo.tar') extensions asArray
		equals: #( 'tar' ).
	self
		assertCollection: (Path from: 'foo.tar.gz') extensions asArray
		equals: #( 'tar' 'gz').
	self
		assertCollection: (Path from: 'foo.1.tar.gz') extensions asArray
		equals: #( '1' 'tar' 'gz').! !

!PathTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/12/2012 14:26'!
testContainsLocator
	| ancestor descendent |
	ancestor := FileLocator imageDirectory resolve path.
	descendent := FileLocator image / 'griffle'.
	self deny: (ancestor contains: descendent).
	self deny: (descendent contains: ancestor)! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:32'!
testParentResolution
	| base relative absolute |
	base := Path / 'plonk' / 'pinto'.
	relative := Path parent / 'griffle' / 'zonk'.
	absolute := base resolve: relative.
	self assert: absolute isAbsolute.
	self assert: (absolute at: 1) equals: 'plonk'.
	self assert: (absolute at: 2) equals: 'griffle'.
	self assert: (absolute at: 3) equals: 'zonk'.
! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:33'!
testRelativeWithParents
	| path allPaths |
	path := Path * 'plonk' / 'griffle' / 'nurb'.
	allPaths := path withParents.
	
	self assert: allPaths size equals: 3.
	self assert: allPaths first basename equals: 'plonk'.
	self assert: allPaths first size equals: 1.
	self assert: allPaths second basename equals: 'griffle'.
	self assert: allPaths second size equals: 2.
	self assert: (allPaths second isChildOf: allPaths first).
	self assert: allPaths third basename equals: 'nurb'.
	self assert: allPaths third size equals: 3.
	self assert: (allPaths third isChildOf: allPaths second).
	self assert: allPaths third == path! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:35'!
testSimpleResolution
	| base relative absolute |
	base := Path / 'plonk'.
	relative := (Path * 'griffle') / 'zonk'.
	absolute := base resolve: relative.
	self assert: absolute isAbsolute.
	self assert: (absolute at: 1) equals: 'plonk'.
	self assert: (absolute at: 2) equals: 'griffle'.
	self assert: (absolute at: 3) equals: 'zonk'.
! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:30'!
testCommaAddsExtension
	| path result |
	path := Path * 'plonk' .
	result := path, 'griffle'.
	self assert: result basename equals: 'plonk.griffle'! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:35'!
testResolveString
	"self debug: #testResolveString"

	| path result |
	path := Path * 'plonk'.
	result := path resolve: 'griffle'.
	self assert: result class equals: path class.
	self assert: result size equals: 2.
	self assert: (result at: 1) equals: 'plonk'.
	self assert: (result at: 2) equals: 'griffle'.! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:33'!
testParseWindowsPathWithUnixDelimiters
	"self run: #testParse"
	
	| path |
	path := WindowsStore new pathFromString: 'C:\a/b/c'.
	self assert: path segments size equals: 4.
	self
		assertCollection: path segments
		equals: #('C:' 'a' 'b' 'c')
! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:30'!
testBasenameWithoutExtension
	"self debug: #testBasenameWithoutExtension"
	| path |
	path := Path * 'plonk' / 'griffle'.
	self assert: path basenameWithoutExtension equals: 'griffle'.
	
	path := Path * 'plonk' / 'griffle.taz'.
	self assert: path basenameWithoutExtension equals: 'griffle'.
	
	path := Path * 'plonk' / 'griffle.taz.zork'.
	self assert: path basenameWithoutExtension equals: 'griffle.taz'.! !

!PathTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testResolveAbsolute
	| path |
	path := Path / 'griffle'.
	self assert: path resolve == path.
	self assert: path isAbsolute! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:35'!
testWorkingDirPrintString
	| path actual |
	path := Path workingDirectory. 
	actual := path printString.
	self assert: actual equals: 'Path workingDirectory'! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:35'!
testSlash
	| path actual |
	path := Path * 'plonk'.
	actual := path / 'griffle'.
	self assert: actual class equals: path class.
	self assert: (actual printWithDelimiter: $/) equals: 'plonk/griffle'! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:33'!
testPrintRelativeWithParent
	| path |
	path := Path parent / 'foo'.
	self assert: (path printWithDelimiter: $/) equals: '../foo'! !

!PathTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:43'!
testIsChildOfReference
	| parent child |
	parent := Path / 'griffle'.
	child := (FileSystem memory referenceTo: parent / 'nurb').
	self deny: (child isChildOf: parent).
	self deny: (parent isChildOf: child)! !

!PathTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testUnequalContent
	| a b |
	a := Path * 'plonk'.
	b := Path * 'griffle'.
	self deny: a = b.! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:32'!
testParentParent
	| path  |
	path := (Path * '..') parent.
	self assert: path size equals: 2.
	self assert: (path at: 1) equals: '..'.
	self assert: (path at: 2) equals: '..'.! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:35'!
testRootPrintString
	| path actual |
	path := Path root.
	actual := path printString.
	self assert: actual equals: 'Path root'! !

!PathTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testGrandchildOfPath
	| griffle  nurb |
	griffle := Path / 'griffle'.
	nurb := griffle / 'plonk' / 'nurb'.
	self deny: (griffle isChildOf: nurb).
	self deny: (nurb isChildOf: griffle).! !

!PathTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testIsNotRoot
	self deny: (Path / 'plonk') isRoot! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:35'!
testWithExtentionReplacesExtension
	| path result |
	path := Path * 'plonk.griffle'.
	result := path withExtension: 'griffle'.
	self assert: result basename equals: 'plonk.griffle'! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:32'!
testParent
	| path parent |
	path := (Path * 'plonk') / 'griffle'.
	parent := path parent.
	self assert: parent isRelative.
	self assert: (parent at: 1) equals: 'plonk'! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:30'!
testAbsolutePrintString
	| path actual |
	path := Path / 'plonk' / 'griffle'.
	actual := path printString.
	self assert: actual equals: 'Path / ''plonk'' / ''griffle'''! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:41'!
testRelativeFromStringNormalizationParent

	| path |
	
	path := Path from: 'plonk/../../griffle'.
	
	self assert: path isRelative.
	self assert: path size equals: 2.
	self assert: (path at: 1) equals: '..'.
	self assert: (path at: 2) equals: 'griffle'.! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:32'!
testParse
	"self run: #testParse"
	
	| path |
	path := Path from: 'parent/child/grandChild' delimiter: $/.
	self assert: path size equals: 3.
	self assert: (path at: 1) equals: 'parent'.
	self assert: (path at: 2) equals: 'child'.
	self assert: (path at: 3) equals: 'grandChild'.
	
! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:31'!
testEqual
	| a b |
	a := Path * 'plonk'.
	b := Path * 'plonk'.
	self deny: a == b.
	self assert: a equals: b.! !

!PathTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testIsEmpty
	self assert: (Path workingDirectory) isEmpty! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:33'!
testRelativeToBranch
	| parent child relative |
	parent := Path / 'griffle' / 'bibb'.
	child := Path / 'griffle' / 'plonk' / 'nurp'.
	relative := child relativeTo: parent.
	self assert: relative  equals: (Path parent / 'plonk' / 'nurp')! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:35'!
testWorkingDirectoryParent
	| path |
	path := Path workingDirectory parent.
	self assert: path size equals: 1.
	self assert: (path at: 1) equals: '..'! !

!PathTest methodsFor: 'tests' stamp: 'tbn 6/26/2012 21:07'!
testUnixAbsolutePathName

	self assert: (Path from: '/test') isAbsolute.
	self assert: (Path from: '/etc/bin') isAbsolute.! !

!PathTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testIsNotRelative
	self deny: (Path / 'plonk') isRelative! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:30'!
testAbsoluteWithParents
	| path allPaths |
	path := Path / 'plonk' / 'griffle' / 'nurb'.
	allPaths := path withParents.
	
	self assert: allPaths size equals: 4.
	self assert: allPaths first isRoot.
	self assert: allPaths second basename equals: 'plonk'.
	self assert: allPaths second size equals: 1.
	self assert: (allPaths second isChildOf: allPaths first).
	self assert: allPaths third basename equals: 'griffle'.
	self assert: allPaths third size equals: 2.
	self assert: (allPaths third isChildOf: allPaths second).
	self assert: allPaths fourth basename equals: 'nurb'.
	self assert: allPaths fourth size equals: 3.
	self assert: (allPaths fourth isChildOf: allPaths third).
	
	self assert: allPaths fourth equals: path.
	self assert: allPaths fourth == path! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:33'!
testRelativeTo
	"self run: #testRelativeTo"
	"aPath relativeTo: aParent returns a new path relative to the parent"
	
	| parent child relative |
	parent := Path / 'griffle'.
	child := Path / 'griffle' / 'plonk' / 'nurp'.
	relative := child relativeTo: parent.
	self assert: relative equals: (Path * 'plonk' / 'nurp')! !

!PathTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testIsRoot
	self assert: Path root isRoot! !

!PathTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testIsChildOfPath
	| parent child |
	parent := Path / 'griffle'.
	child := parent / 'nurb'.
	self assert: (child isChildOf: parent).
	self deny: (parent isChildOf: child)! !

!PathTest methodsFor: 'tests' stamp: 'BernardoContreras 2/20/2015 22:59'!
testParentUpTo
	| a b c |
	a := Path / 'testParentUpTo' / 'A'.
	b := Path / 'testParentUpTo' / 'A' / 'B'.
	c := Path / 'testParentUpTo' / 'A' / 'B' / 'C'.
	self assert: b equals: (c parentUpTo: 'B').
	self assert: a equals: (c parentUpTo: 'A').
	self assert: Path / 'testParentUpTo' equals: (c parentUpTo: 'testParentUpTo').
	self assert: Path root equals: (c parentUpTo: 'notAParent')! !

!PathTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testResolveRelative
	| path |
	path := Path * 'griffle'.
	self assert: path resolve == path.
	self assert: path isRelative! !

!PathTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testIsAbsolute
	self assert: (Path / 'plonk') isAbsolute! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:41'!
testRelativeFromStringParent

	| path |
	
	path := Path from: '../..'.
	
	self assert: path isRelative.
	self assert: path size equals: 2.
	self assert: (path at: 1) equals: '..'.
	self assert: (path at: 2) equals: '..'.! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:32'!
testMakeRelative
	"self run: #testMakeRelative"
	
	| parent child relative |
	parent := Path / 'griffle' / 'bibb'.
	child := Path / 'griffle' / 'plonk' / 'nurp'.
	relative := parent makeRelative: child.
	self assert: relative equals: (Path parent / 'plonk' / 'nurp')! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:30'!
testCommaAddsExtensionAgain
	| path result |
	path := Path * 'plonk.griffle'.
	result := path, 'nurp'.
	self assert: result basename equals: 'plonk.griffle.nurp'! !

!PathTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:42'!
testContains
	| ancestor descendent |
	ancestor := Path / 'plonk'.
	descendent := Path / 'plonk' / 'griffle' / 'bork'.
	self assert: (ancestor contains: descendent).
	self deny: (descendent contains: ancestor)! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:30'!
testBasename
	| path |
	path := Path * 'plonk' / 'griffle'.
	self assert: path basename equals: 'griffle'! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:33'!
testPrintWithDelimiter
	| path |
	path := (Path * 'plonk') / 'griffle'.
	self assert: (path printWithDelimiter: $%) equals: 'plonk%griffle'! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:35'!
testWithExtentionAddsExtension
	| path result |
	path := Path * 'plonk'.
	result := path withExtension: 'griffle'.
	self assert: result basename equals: 'plonk.griffle'! !

!PathTest methodsFor: 'tests' stamp: 'tbn 6/26/2012 21:05'!
testWindowsAbsolutePathName
  
	self assert: (Path from: 'A:\') isAbsolute.
	self assert: (Path from: 'c:\') isAbsolute.
	self assert: (Path from: 'c:\test') isAbsolute.! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:29'!
testAbsolutePath

	| path |

	self assert: (AbsolutePath new isAbsolute).
	self assert: (Path root isAbsolute).
	
	path := AbsolutePath from: 'parent/child/grandChild' delimiter: $/.
	self assert: path size equals: 3.
	self assert: (path at: 1) equals: 'parent'.
	self assert: (path at: 2) equals: 'child'.
	self assert: (path at: 3) equals: 'grandChild'.
	
	path := AbsolutePath from: '/' delimiter: $/.
	self assert: path equals: Path root.
	
! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:30'!
testAsReference
	| path reference |
	path := Path * 'plonk'.
	reference := path asFileReference.
	self assert: reference class equals: FileReference.
	self assert: reference path equals: path! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:35'!
testResolvePath
	"self debug: #testResolvePath"
	
	| path |
	path := Path / 'grandfather' / 'father' / 'child'.
	self 
		assert: (path resolvePath: Path / 'grandfather') 
		equals: (Path / 'grandfather').
	self 
		assert: (path resolvePath: Path / 'child')
		equals: (Path / 'child').
	self
		assert: (path resolvePath: Path * 'grandfather')
		equals: (Path / 'grandfather' / 'father' / 'child' / 'grandfather').
	self
		assert: (path resolvePath: Path * 'child')
		equals: (Path / 'grandfather' / 'father' / 'child' / 'child').
	self
		assert: (path resolvePath: Path * 'grandfather')
		equals: (Path / 'grandfather' / 'father' / 'child' / 'grandfather').
	self
		assert: (path resolvePath: Path * 'child')
		equals: (Path / 'grandfather' / 'father' / 'child' / 'child').
	self
		assert:  (path resolvePath: (Path parent) / '..')
		equals: (Path / 'grandfather')! !

!PathTest methodsFor: 'tests' stamp: 'CamilloBruni 2/14/2014 14:33'!
testParseTrailingSlash
	| path |
	path := Path from: 'griffle/' delimiter: $/.
	self assert: path size equals: 1.
	self assert: (path at: 1) equals: 'griffle'! !

!PeelToFirstDebugAction commentStamp: '<historical>'!
A PeelToFirstDebugAction peels the stack back to the second occurance of the currently selected message.
!
!PeelToFirstDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/21/2013 22:00'!
id

	^ #peelToFirst! !

!PeelToFirstDebugAction methodsFor: 'actions' stamp: 'AndreiChis 9/21/2013 22:08'!
executeAction

	self session peelToFirstLike: self currentContext ! !

!PeelToFirstDebugAction methodsFor: 'testing' stamp: 'AndreiChis 9/21/2013 22:06'!
appliesToDebugger: aDebugger

	^ aDebugger session isInterruptedContextPostMortem not! !

!PeelToFirstDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/21/2013 22:01'!
defaultLabel

	^ 'Peel to first like this'! !

!PeelToFirstDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/21/2013 22:01'!
defaultOrder

	^ 45! !

!PeelToFirstDebugAction class methodsFor: 'registration' stamp: 'AndreiChis 9/21/2013 22:13'!
actionType
	<contextMenuDebuggingAction>! !

!PersonDataExample commentStamp: 'TorstenBergmann 2/3/2014 23:52'!
Data object for a grid example!
!PersonDataExample methodsFor: 'accessing' stamp: 'AlainPlantec 2/1/2010 11:51'!
married: anObject
	"Set the value of married"

	married := anObject! !

!PersonDataExample methodsFor: 'accessing' stamp: 'AlainPlantec 2/1/2010 11:51'!
firstName
	"Answer the value of firstName"

	^ firstName! !

!PersonDataExample methodsFor: 'accessing' stamp: 'AlainPlantec 2/1/2010 11:51'!
firstName: anObject
	"Set the value of firstName"

	firstName := anObject! !

!PersonDataExample methodsFor: 'accessing' stamp: 'AlainPlantec 2/1/2010 11:51'!
secondName
	"Answer the value of secondName"

	^ secondName! !

!PersonDataExample methodsFor: 'accessing' stamp: 'AlainPlantec 2/1/2010 11:51'!
age: anObject
	"Set the value of age"

	age := anObject! !

!PersonDataExample methodsFor: 'accessing' stamp: 'AlainPlantec 2/1/2010 11:51'!
married
	"Answer the value of married"

	^ married! !

!PersonDataExample methodsFor: 'accessing' stamp: 'AlainPlantec 2/1/2010 11:51'!
secondName: anObject
	"Set the value of secondName"

	secondName := anObject! !

!PersonDataExample methodsFor: 'accessing' stamp: 'AlainPlantec 2/1/2010 11:51'!
age
	"Answer the value of age"

	^ age! !

!PersonDataExample class methodsFor: 'instance creation' stamp: 'AlainPlantec 2/1/2010 11:53'!
firstName: fname secondName: sname age: age married: married
	^ (self new) firstName: fname; secondName: sname; age: age; married: married; yourself! !

!Pharo3DarkTheme commentStamp: 'EstebanLorenzano 5/14/2014 14:35'!
A dark theme for pharo, inspired on 

http://blog.jetbrains.com/blog/2013/06/11/inside-darcula-look-and-feel-an-interview-with-konstantin-bulenkov/

This theme works well with the "Dark" text styling. 
You can have "the full experience", executing: 

self installFullTheme.!
!Pharo3DarkTheme methodsFor: 'growl - specific' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
growlLabelColorFor: aGrowlMorph
	^ Color white twiceDarker! !

!Pharo3DarkTheme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
newWindowCloseOverForm
	"Answer a new form for a window menu box."

	^ self newWindowCloseForm! !

!Pharo3DarkTheme methodsFor: 'border-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
taskbarThumbnailNormalBorderStyleFor: aWindow
	^ self buttonNormalBorderStyleFor: aWindow! !

!Pharo3DarkTheme methodsFor: 'border-styles-scrollbars' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
scrollbarNormalThumbBorderStyleFor: aScrollbar
	"Return the normal thumb borderStyle for the given scrollbar."

	^ BorderStyle simple
		width: 0;
		baseColor: Color transparent! !

!Pharo3DarkTheme methodsFor: 'border-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
configureWindowDropShadowFor: aWindow

	aWindow hasDropShadow: false! !

!Pharo3DarkTheme methodsFor: 'fill-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
taskbarFillStyleFor: aTaskbar
	^ "self buttonNormalFillStyleFor: aTaskbar"
	SolidFillStyle color: Color transparent ! !

!Pharo3DarkTheme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
windowMaximizePassiveForm
	"Answer the form to use for passive (background) window maximize/restore buttons"

	^Pharo3UIThemeIcons windowMaximizeInactiveForm! !

!Pharo3DarkTheme methodsFor: 'fill-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
windowInactiveTitleFillStyleFor: aWindow
	"We do not want the lighting effect when the window goes inactive"
	^ SolidFillStyle color: Color transparent! !

!Pharo3DarkTheme methodsFor: 'initialize-release' stamp: 'EstebanLorenzano 4/30/2014 20:16'!
initialize
	"self beCurrent"

	super initialize.
	self windowActiveDropShadowStyle: #diffuse.
	self settings preferGradientFill: false.! !

!Pharo3DarkTheme methodsFor: 'border-styles-scrollbars' stamp: 'EstebanLorenzano 4/29/2014 22:14'!
scrollbarNormalFillStyleFor: aScrollbar
	"Return the normal scrollbar fillStyle for the given scrollbar."
	
	^ SolidFillStyle color: self backgroundColor lighter.! !

!Pharo3DarkTheme methodsFor: 'configure' stamp: 'EstebanLorenzano 4/30/2014 09:01'!
configureSystemWindow: aWindow
	! !

!Pharo3DarkTheme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
radioButtonForm
	"Answer the form to use for a normal radio button."

	^ Pharo3UIThemeIcons radioButtonUnselectedForm! !

!Pharo3DarkTheme methodsFor: 'fill-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
splitterPressedFillStyleFor: aSplitter
	"Return the pressed splitter fillStyle for the given splitter."
	
	|aColor|
	aColor := self glamorousBaseColorFor: aSplitter.
	^ (GradientFillStyle ramp: {0.0->aColor lighter. 0.9-> aColor})
		origin: aSplitter topLeft;
		direction: (aSplitter splitsTopAndBottom
			ifTrue: [0 @ aSplitter height]
			ifFalse: [aSplitter width @ 0]);
		radial: false! !

!Pharo3DarkTheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 4/29/2014 18:23'!
buttonColor
	^ self backgroundColor lighter lighter! !

!Pharo3DarkTheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 5/1/2014 11:38'!
textColorForNonStandardBackground
	^ Color black! !

!Pharo3DarkTheme methodsFor: 'private' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
glamorousLightColorFor: aButton
	^ self class lightBaseColor! !

!Pharo3DarkTheme methodsFor: 'growl - specific' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
growlBorderColorFor: aGrowlMorph
	^ Color white alpha: 0.5! !

!Pharo3DarkTheme methodsFor: 'initialize-release' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
initializeForms
	"Initialize the receiver's image forms."

	|inactiveForm|
	super initializeForms.
	inactiveForm := self newWindowInactiveControlForm.
	self forms
		at: #windowCloseOver put: self newWindowCloseOverForm;
		at: #windowMinimizeOver put: self newWindowMinimizeOverForm;
		at: #windowMaximizeOver put: self newWindowMaximizeOverForm;
		at: #windowClosePassive put: inactiveForm;
		at: #windowMinimizePassive put: inactiveForm;
		at: #windowMaximizePassive put: inactiveForm! !

!Pharo3DarkTheme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
newCheckboxMarkerForm
	"Answer a new checkbox marker form."

	^Pharo3UIThemeIcons checkboxMarkerForm! !

!Pharo3DarkTheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 4/29/2014 16:23'!
selectionTextColor
	^ Color r: 16rE0 g: 16rE2 b: 16rE4 range: 255! !

!Pharo3DarkTheme methodsFor: 'border-styles-buttons' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
buttonCornerStyleIn: aThemedMorph
	"If asked, we only allow square corners"
	
	^ #square! !

!Pharo3DarkTheme methodsFor: 'configure' stamp: 'EstebanLorenzano 4/29/2014 17:52'!
configurePluggableTextMorph: textMorph 
	textMorph 	
		color: self backgroundColor;
		textColor: self textColor;
		borderWidth: 1.! !

!Pharo3DarkTheme methodsFor: 'fill-styles-buttons' stamp: 'EstebanLorenzano 4/29/2014 18:19'!
buttonSelectedFillStyleFor: aButton
	"Return the normal button fillStyle for the given button."
	
	^ SolidFillStyle color: self selectionColor.
	"| top bottom |
	
	top := self secondarySelectionColor.
	bottom := self selectionColor.

	^(GradientFillStyle ramp: {
			0.0->top.
			0.7->bottom.})
		origin: aButton bounds origin;
		direction: 0 @ aButton height;
		radial: false"! !

!Pharo3DarkTheme methodsFor: 'fill-styles-buttons' stamp: 'EstebanLorenzano 5/1/2014 00:44'!
controlButtonNormalFillStyleFor: aButton
	"Return the normal control button fillStyle for the given button.
	Control buttons are generally used for drop-lists and expanders."
	
	^self buttonNormalFillStyleFor: aButton! !

!Pharo3DarkTheme methodsFor: 'configure' stamp: 'EstebanLorenzano 5/15/2014 13:23'!
configureScrollPane: aMorph 
	"aMorph color: self backgroundColor"! !

!Pharo3DarkTheme methodsFor: 'border-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
textEditorNormalBorderStyleFor: aTextEditor
	"Return the normal text editor borderStyle for the given text editor."

	^self buttonNormalBorderStyleFor: aTextEditor! !

!Pharo3DarkTheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 5/15/2014 19:06'!
menuBorderColor
	^ self borderColor! !

!Pharo3DarkTheme methodsFor: 'label-styles' stamp: 'EstebanLorenzano 4/29/2014 18:29'!
buttonLabelForText: aTextOrString
	"Answer the label to use for the given text."
	^aTextOrString isString
		ifTrue: [(LabelMorph contents: aTextOrString) color: self textColor ]
		ifFalse: [super buttonLabelForText: aTextOrString]! !

!Pharo3DarkTheme methodsFor: 'border-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
groupPanelBorderStyleFor: aGroupPanel
	"Answer the normal border style for a group panel."

	^ SimpleBorder new
		width: 1;
		baseColor: ((self glamorousBaseColorFor: aGroupPanel))! !

!Pharo3DarkTheme methodsFor: 'watcher window' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
watcherWindowInactiveFillStyleFor: aWindow

	^ SolidFillStyle color: (Color veryVeryLightGray alpha: 0.6)! !

!Pharo3DarkTheme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
checkboxSelectedForm
	"Answer the form to use for a selected checkbox."

	^Pharo3UIThemeIcons checkboxSelectedForm! !

!Pharo3DarkTheme methodsFor: 'fill-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
progressBarFillStyleFor: aProgressBar
	^ self glamorousBasePassiveBackgroundColorFor: aProgressBar! !

!Pharo3DarkTheme methodsFor: 'fill-styles' stamp: 'EstebanLorenzano 4/30/2014 11:54'!
windowActiveLabelFillStyleFor: aWindow
	^ self textColor! !

!Pharo3DarkTheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 5/15/2014 19:05'!
menuBorderWidth
	^ self borderWidth! !

!Pharo3DarkTheme methodsFor: 'fill-styles-buttons' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
tabLabelSelectedFillStyleFor: aTabLabel
	^ self buttonSelectedFillStyleFor: aTabLabel ! !

!Pharo3DarkTheme methodsFor: 'private' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
glamorousLightSelectionColorFor: aMorph
	^ self class lightSelectionColor! !

!Pharo3DarkTheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 5/1/2014 01:47'!
spotlightWindowColor 
	^ self windowColor! !

!Pharo3DarkTheme methodsFor: 'fill-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
dropListDisabledFillStyleFor: aDropList
	"Return the disabled fillStyle for the given drop list."
	
	^ self textEditorDisabledFillStyleFor: aDropList! !

!Pharo3DarkTheme methodsFor: 'fill-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
listDisabledFillStyleFor: aList
	"Return the disabled fillStyle for the given list."
	
	^ self textEditorDisabledFillStyleFor: aList! !

!Pharo3DarkTheme methodsFor: 'fill-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
sliderDisabledFillStyleFor: aSlider
	"Return the disabled fillStyle for the given slider."
	
	^ self textEditorDisabledFillStyleFor: aSlider! !

!Pharo3DarkTheme methodsFor: 'border-styles' stamp: 'EstebanLorenzano 4/30/2014 20:30'!
dropListNormalListBorderStyleFor: aDropList
	"Return the normal borderStyle for the list of the given given drop list"

	^BorderStyle inset
		width: 1;
		baseColor: self buttonColor lighter.! !

!Pharo3DarkTheme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
newWindowMinimizeOverForm
	"Answer a new form for a window menu box."

	^ self newWindowMinimizeForm! !

!Pharo3DarkTheme methodsFor: 'fill-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
windowActiveFillStyleFor: aWindow
	"We do not want the lighting effect when the window goes inactive"
	^SolidFillStyle color: self class baseColor! !

!Pharo3DarkTheme methodsFor: 'label-styles' stamp: 'EstebanLorenzano 4/30/2014 09:07'!
configureWindowLabelAreaFor: aWindow
	"Configure the label area for the given window."

	|padding|
	padding := 0.
	aWindow labelArea
		addMorphBack: (Morph new extent: aWindow class borderWidth @ 0).
	aWindow hasCloseBox ifTrue: [aWindow addCloseBox. padding := padding + 1].
	aWindow hasCollapseBox ifTrue: [aWindow addCollapseBox. padding := padding + 1].
	aWindow hasExpandBox ifTrue: [aWindow addExpandBox. padding := padding + 1].
	aWindow hasMenuBox ifTrue: [padding := padding - 1].
	aWindow labelArea
		addMorphBack: (Morph new extent: aWindow class borderWidth @ 0; hResizing: #spaceFill).
	aWindow basicLabel ifNotNil: [:label | 
		label color: self textColor.
		aWindow labelArea 
			addMorphBack: label; 
			hResizing: #shrinkWrap ].
	aWindow labelArea
		addMorphBack: (Morph new extent: aWindow class borderWidth @ 0; hResizing: #spaceFill).
	padding > 0 ifTrue: [
		aWindow labelArea
			addMorphBack: (Morph new extent: (aWindow boxExtent x * padding) @ 0)].
	aWindow hasMenuBox ifTrue: [aWindow addMenuControl].
	aWindow labelArea
		addMorphBack: (Morph new extent: aWindow class borderWidth @ 0)! !

!Pharo3DarkTheme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
newWindowMenuForm
	"Answer a new form for a window menu box."

	^ Pharo3UIThemeIcons windowMenuForm! !

!Pharo3DarkTheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 5/15/2014 19:00'!
borderColor 
	^ Color darkGray darker darker! !

!Pharo3DarkTheme methodsFor: 'initialize-release' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
newRadioMarkerForm
	"Answer a new checkbox marker form."

	^Form extent: 12@12 depth: 32! !

!Pharo3DarkTheme methodsFor: 'private' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
glamorousNormalFillStyleWithBaseColor: aColor for: aMorph height: anInteger	
	| top bottom |
	top := aColor darker.
	bottom := aColor.
	^(GradientFillStyle ramp: {
			0.0->top.
			0.7->bottom.})
		origin: aMorph bounds origin;
		direction: 0 @ anInteger;
		radial: false! !

!Pharo3DarkTheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 4/29/2014 17:31'!
secondarySelectionColor
	^ self selectionColor muchDarker! !

!Pharo3DarkTheme methodsFor: 'basic-colors' stamp: 'EstebanLorenzano 5/1/2014 10:53'!
taskbarButtonLabelColorForCollapsed: aButton
	"Answer the colour for the label of the given taskbar button, given that the corresponding window is collapsed."

	^ self textColor! !

!Pharo3DarkTheme methodsFor: 'border-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
taskbarThumbnailCornerStyleFor: aMorph
	"Answer the corner style for the taskbar thumbnail/tasklist."
	
	^#square! !

!Pharo3DarkTheme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
menuPinForm
	"Answer the form to use for the pin button of a menu."

	^ Pharo3UIThemeIcons menuPinForm! !

!Pharo3DarkTheme methodsFor: 'fill-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
morphTreeSplitterNormalFillStyleFor: aSplitter	
	^ self splitterNormalFillStyleFor: aSplitter! !

!Pharo3DarkTheme methodsFor: 'fill-styles-buttons' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
menuItemInDockingBarSelectedFillStyleFor: aMenuItem
	"Answer the selected fill style to use for the given menu item that is in a docking bar."
	^ self buttonSelectedFillStyleFor: aMenuItem! !

!Pharo3DarkTheme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
newWindowMinimizeForm
	"Answer a new form for a window minimize box."

	^ Pharo3UIThemeIcons windowMinimizeForm! !

!Pharo3DarkTheme methodsFor: 'fill-styles-buttons' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
tabLabelNormalFillStyleFor: aTabLabel
	^ self buttonNormalFillStyleFor: aTabLabel ! !

!Pharo3DarkTheme methodsFor: 'fill-styles' stamp: 'EstebanLorenzano 4/30/2014 11:55'!
windowActiveTitleFillStyleFor: aWindow
	"self glamorousNormalFillStyleFor: aWindow height: aWindow labelHeight"
	^ SolidFillStyle color: Color transparent! !

!Pharo3DarkTheme methodsFor: 'fill-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
morphTreeSplitterPressedFillStyleFor: aSplitter	
	^ self splitterPressedFillStyleFor: aSplitter! !

!Pharo3DarkTheme methodsFor: 'fill-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
splitterNormalFillStyleFor: aSplitter
	"Return the normal splitter fillStyle for the given splitter."
	
	^ SolidFillStyle color: Color transparent! !

!Pharo3DarkTheme methodsFor: 'label-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
windowMenuPassiveForm
	"Answer the form to use for passive (background) window menu buttons"

	^self newWindowMenuPassiveForm! !

!Pharo3DarkTheme methodsFor: 'private' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
glamorousBasePassiveBackgroundColorFor: aButton
	^ self class basePassiveBackgroundColor! !

!Pharo3DarkTheme methodsFor: 'growl - specific' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
growlFillColorFor: aGrowlMorph
	^ Color darkGray alpha: 0.5! !

!Pharo3DarkTheme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
newRadioButtonMarkerForm
	"Answer a new radio button marker form. We make it empty because we already have the selected radio button take care of the state."

	^Pharo3UIThemeIcons radioButtonMarkerForm  ! !

!Pharo3DarkTheme methodsFor: 'border-styles-scrollbars' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
scrollbarPagingAreaCornerStyleIn: aThemedMorph	
	^#square! !

!Pharo3DarkTheme methodsFor: 'fill-styles-scrollbars' stamp: 'EstebanLorenzano 5/15/2014 19:20'!
scrollbarNormalThumbFillStyleFor: aScrollbar
	"Return the normal scrollbar fillStyle for the given scrollbar."
	^ self glamorousNormalFillStyleFor: aScrollbar height: aScrollbar height! !

!Pharo3DarkTheme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
radioButtonSelectedForm
	"Answer the form to use for a selected radio button."

	^ Pharo3UIThemeIcons radioButtonSelectedForm ! !

!Pharo3DarkTheme methodsFor: 'private' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
glamorousDarkBaseColorFor: aButton
	^ self class darkBaseColor! !

!Pharo3DarkTheme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
checkboxUnselectedForm
	"Answer the form to use for a selected checkbox."

	^ Pharo3UIThemeIcons checkboxUnselectedForm! !

!Pharo3DarkTheme methodsFor: 'watcher window' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
configureWatcherWindowLabelAreaFor: aWindow
	"Configure the label area for the given Watcher window."

	|padding|
	padding := 0.
	aWindow labelArea
		addMorphBack: (Morph new extent: aWindow class borderWidth @ 0).
	aWindow hasCloseBox ifTrue: [aWindow addCloseBox. padding := padding + 1].
"	aWindow hasCollapseBox ifTrue: [aWindow addCollapseBox. padding := padding + 1].
	aWindow hasExpandBox ifTrue: [aWindow addExpandBox. padding := padding + 1].
	aWindow hasMenuBox ifTrue: [padding := padding - 1].
"	aWindow labelArea
		addMorphBack: (Morph new extent: aWindow class borderWidth @ 0; hResizing: #spaceFill).
	aWindow basicLabel ifNotNil: [:label | aWindow labelArea addMorphBack: label; hResizing: #shrinkWrap].
	aWindow labelArea
		addMorphBack: (Morph new extent: aWindow class borderWidth @ 0; hResizing: #spaceFill).
	padding > 0 ifTrue: [
		aWindow labelArea
			addMorphBack: (Morph new extent: (aWindow boxExtent x * padding) @ 0)].
"	aWindow hasMenuBox ifTrue: [aWindow addMenuControl]."
	aWindow labelArea
		addMorphBack: (Morph new extent: aWindow class borderWidth @ 0)! !

!Pharo3DarkTheme methodsFor: 'configure' stamp: 'EstebanLorenzano 5/1/2014 15:53'!
configureMorphTreeMorph: aMorph
	aMorph preferedPaneColor: self backgroundColor.
	aMorph 
		rowColorForEven: self backgroundColor
		odd: self backgroundColor.! !

!Pharo3DarkTheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 4/29/2014 22:07'!
scrollbarColor 
	^ self buttonColor! !

!Pharo3DarkTheme methodsFor: 'fill-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
separatorFillStyleFor: aSeparator
	"Return the separator fillStyle for the given separator."
	
	^ SolidFillStyle color: (self glamorousBaseColorFor: aSeparator) darker! !

!Pharo3DarkTheme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
newWindowMenuPassiveForm
	"Answer a new form for a window menu box."

	^ Pharo3UIThemeIcons windowMenuInactiveForm! !

!Pharo3DarkTheme methodsFor: 'border-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
dropListNormalBorderStyleFor: aDropList
	"Return the normal borderStyle for the given drop list"

	^ self buttonNormalBorderStyleFor: aDropList! !

!Pharo3DarkTheme methodsFor: 'fill-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
dockingBarNormalFillStyleFor: aToolDockingBar
	^ SolidFillStyle color: Color transparent! !

!Pharo3DarkTheme methodsFor: 'border-styles-scrollbars' stamp: 'EstebanLorenzano 5/15/2014 19:24'!
scrollbarPressedThumbFillStyleFor: aScrollbar
	"Return the normal scrollbar button fillStyle for the given scrollbar."
	
	^ self buttonSelectedFillStyleFor: aScrollbar! !

!Pharo3DarkTheme methodsFor: 'defaults' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
windowShadowColor
	"Answer the window shadow color to use."

	^ Color gray! !

!Pharo3DarkTheme methodsFor: 'watcher window' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
watcherWindowActiveFillStyleFor: aWindow

	^ SolidFillStyle color: (Color veryVeryLightGray alpha: 0.6)! !

!Pharo3DarkTheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 5/15/2014 14:09'!
lightBackgroundColor 
	^ Color r: 0.218 g: 0.217 b: 0.217! !

!Pharo3DarkTheme methodsFor: 'basic-colors' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
taskbarButtonLabelColorFor: aButton
	"Answer the colour for the label of the given taskbar button."

	^aButton model
		ifNil: [super taskbarButtonLabelColorFor: aButton]
		ifNotNil: [:win |
			win isActive
				ifTrue: [Color black]
				ifFalse: [Color gray darker]]! !

!Pharo3DarkTheme methodsFor: 'private' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
glamorousBaseColorFor: aButton
	^ self class baseColor
	"unfortunately, it looks like paneColor does not always return the wanted color"
	"aButton paneColorOrNil ifNil: [Color r: 200 g: 200 b: 200 range: 255]"! !

!Pharo3DarkTheme methodsFor: 'fill-styles' stamp: 'EstebanLorenzano 5/1/2014 00:47'!
dropListNormalListFillStyleFor: aDropList
	"Return the normal fillStyle for the list of the given drop list."
	
	^ self backgroundColor! !

!Pharo3DarkTheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 4/29/2014 16:18'!
disabledColor 
	^ Color veryLightGray muchLighter! !

!Pharo3DarkTheme methodsFor: 'fill-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
progressFillStyleFor: aProgress
	"Return the progress fillStyle for the given progress morph."
	^ self windowActiveFillStyleFor: aProgress  ! !

!Pharo3DarkTheme methodsFor: 'scrollbars' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
scrollBarButtonArrowVertices: aRectangle 
	^ self verticesForSimpleArrow: aRectangle! !

!Pharo3DarkTheme methodsFor: 'border-styles-buttons' stamp: 'EstebanLorenzano 4/29/2014 22:18'!
buttonNormalBorderStyleFor: aButton
	"Return the normal button borderStyle for the given button."
	
	(aButton valueOfProperty: #noBorder ifAbsent: [ false ]) 
		ifTrue: [ 
			^ SimpleBorder new 
				width: 0; 
				baseColor: Color transparent ].
	
	^ SimpleBorder new
		width: 1;
		baseColor: self buttonColor lighter! !

!Pharo3DarkTheme methodsFor: 'label-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
createMenuBoxFor: aSystemWindow
	"Answer a button for the window menu."
	
"	^aSystemWindow createBox
		labelGraphic: (self windowMenuIconFor: aSystemWindow);
		extent: aSystemWindow boxExtent;
		actWhen: #buttonDown;
		actionSelector: #offerWindowMenu;
		setBalloonText: 'window menu' translated"
	
	|form msb|
	form := self windowMenuForm.
	msb := MultistateButtonMorph new extent: form extent.
	msb activeEnabledNotOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowMenuPassiveForm.
	msb extent: form extent.
	msb activeDisabledNotOverUpFillStyle: (ImageFillStyle form: form).
	msb passiveEnabledNotOverUpFillStyle: (ImageFillStyle form: form).
	msb passiveDisabledNotOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowMenuForm.
	msb extent: form extent.
	msb
		activeEnabledOverUpFillStyle: (ImageFillStyle form: form);
		passiveEnabledOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowMenuPassiveForm.
	msb
		extent: form extent;
		activeEnabledOverDownFillStyle: (ImageFillStyle form: form);
		passiveEnabledOverDownFillStyle: (ImageFillStyle form: form);
		addUpAction: [aSystemWindow offerWindowMenu];
		setBalloonText: 'window menu' translated;
		extent: aSystemWindow boxExtent.
	^msb! !

!Pharo3DarkTheme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
windowClosePassiveForm
	"Answer the form to use for passive (background) window close buttons"

	^Pharo3UIThemeIcons windowCloseInactiveForm! !

!Pharo3DarkTheme methodsFor: 'fill-styles' stamp: 'EstebanLorenzano 4/29/2014 13:48'!
listNormalFillStyleFor: aList
	"Return the normal fillStyle for the given list."
	
	^ self backgroundColor! !

!Pharo3DarkTheme methodsFor: 'fill-styles' stamp: 'EstebanLorenzano 4/29/2014 22:40'!
dropListNormalFillStyleFor: aDropList
	"Return the normal fillStyle for the given drop list."
	
	^ self backgroundColor! !

!Pharo3DarkTheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 4/29/2014 13:12'!
textColor
	^ Color white! !

!Pharo3DarkTheme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
windowMinimizePassiveForm
	"Answer the form to use for passive (background) window minimize buttons"

	^Pharo3UIThemeIcons windowMinimizeInactiveForm! !

!Pharo3DarkTheme methodsFor: 'basic-colors' stamp: 'EstebanLorenzano 5/1/2014 10:53'!
taskbarButtonLabelColorForExpanded: aButton
	"Answer the colour for the label of the given taskbar button, given that the corresponding window is expanded."

	^ self textColor! !

!Pharo3DarkTheme methodsFor: 'fill-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
expanderTitleNormalFillStyleFor: anExpanderTitle
	"Return the normal expander title fillStyle for the given expander title."
	
	^ self buttonNormalFillStyleFor: anExpanderTitle! !

!Pharo3DarkTheme methodsFor: 'fill-styles' stamp: 'EstebanLorenzano 4/30/2014 19:54'!
textEditorNormalFillStyleFor: aTextEditor
	^ self backgroundColor! !

!Pharo3DarkTheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 4/29/2014 16:13'!
enabledColor 
	^ self textColor! !

!Pharo3DarkTheme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
newWindowMaximizeOverForm
	"Answer a new form for a window menu box."

	^ self newWindowMaximizeForm! !

!Pharo3DarkTheme methodsFor: 'label-styles' stamp: 'EstebanLorenzano 4/30/2014 09:12'!
windowLabelForText: aTextOrString
	^ (super windowLabelForText: aTextOrString)
		color: self textColor;
		yourself.! !

!Pharo3DarkTheme methodsFor: 'private' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
glamorousBaseSelectionColorFor: aButton
	^ self class baseSelectionColor! !

!Pharo3DarkTheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 5/1/2014 12:20'!
caretColor
	^ Color lightBlue.! !

!Pharo3DarkTheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 4/29/2014 12:53'!
backgroundColor
	^ Color darkGray muchDarker! !

!Pharo3DarkTheme methodsFor: 'defaults' stamp: 'NicolaiHess 12/5/2014 09:46'!
dialogWindowPreferredCornerStyleFor: aDialogWindow
	"Answer the preferred corner style for the given dialog."

	^ self windowPreferredCornerStyleFor:aDialogWindow! !

!Pharo3DarkTheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 4/29/2014 16:44'!
selectionColor
	^ Color r: 16r07 g: 16r63 b: 16rAD range: 255! !

!Pharo3DarkTheme methodsFor: 'morph creation' stamp: 'MarcusDenker 7/9/2014 21:38'!
newFocusIndicatorMorphFor: aMorph
	"Answer a new focus indicator for the given morph."

	^ BorderedMorph new
		fillStyle: Color transparent;
		borderStyle: (SimpleBorder new
			 width: 1;
			baseColor: (self glamorousBaseSelectionColorFor: aMorph));
		bounds: aMorph focusBounds! !

!Pharo3DarkTheme methodsFor: 'border-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
plainGroupPanelBorderStyleFor: aGroupPanel
	"Answer the normal border style for a plain group panel."

	^SimpleBorder new
		width: 1;
		baseColor: Color transparent! !

!Pharo3DarkTheme methodsFor: 'border-styles' stamp: 'EstebanLorenzano 5/15/2014 18:56'!
configureWindowBorderFor: aWindow
"	super configureWindowBorderFor: aWindow.
	aWindow roundedCorners: #()"
	| aStyle |
	
	aStyle := 
		SimpleBorder new 
			color: self borderColor;
			width: 1.
			
	aWindow borderStyle: aStyle.! !

!Pharo3DarkTheme methodsFor: '*Glamour-Morphic-Brick' stamp: 'MarkRizun 2/3/2015 14:32'!
brickThemer

	^ GLMBrickDarkThemer new! !

!Pharo3DarkTheme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
checkboxForm
	"Answer the form to use for a normal checkbox."

	^self  checkboxUnselectedForm! !

!Pharo3DarkTheme methodsFor: 'border-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
tabPanelBorderStyleFor: aTabGroup
	^ Pharo3TabPanelBorder new 
		width: 1;
		baseColor: ((self glamorousDarkBaseColorFor: aTabGroup));
		tabSelector: aTabGroup tabSelectorMorph! !

!Pharo3DarkTheme methodsFor: 'basic-colors' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
subgroupColorFrom: paneColor
	"Answer the colour for a subgroup given the pane colour."

	^ self glamorousLightColorFor: paneColor" self class baseColor"! !

!Pharo3DarkTheme methodsFor: 'fill-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
windowInactiveFillStyleFor: aWindow
	"We do not want the lighting effect when the window goes inactive"
	^self windowActiveFillStyleFor: aWindow! !

!Pharo3DarkTheme methodsFor: 'configure' stamp: 'EstebanLorenzano 5/1/2014 01:42'!
configureTextMorph: textMorph 
	textMorph 
		"backgroundColor: self backgroundColor;"
		color: self textColor.! !

!Pharo3DarkTheme methodsFor: 'private' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
glamorousNormalFillStyleFor: aMorph height: anInteger
	"Return the normal button fillStyle for the given button."
	
"	| baseColor |
	baseColor := self glamorousBaseColorFor: aMorph.
	^ self glamorousNormalFillStyleWithBaseColor: baseColor for: aMorph height: anInteger
"

	^ SolidFillStyle color: (self glamorousLightColorFor: aMorph)! !

!Pharo3DarkTheme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
newWindowMaximizeForm
	"Answer a new form for a window maximize box."

	^ Pharo3UIThemeIcons windowMaximizeForm! !

!Pharo3DarkTheme methodsFor: 'growl - specific' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
growlDismissHandleFor: aGrowlMorph
	| form image |
	form := self windowCloseForm.
	image := ImageMorph new.
	image image: form.
	image color: Color yellow.
	^ image! !

!Pharo3DarkTheme methodsFor: 'fill-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
progressBarProgressFillStyleFor: aProgressBar
	^ (self glamorousLightSelectionColorFor: aProgressBar)! !

!Pharo3DarkTheme methodsFor: 'fill-styles-scrollbars' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
scrollbarNormalButtonFillStyleFor: aScrollbar
	"Return the normal scrollbar button fillStyle for the given scrollbar."
	
	^ self scrollbarNormalThumbFillStyleFor: aScrollbar! !

!Pharo3DarkTheme methodsFor: 'border-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
tabLabelNormalBorderStyleFor: aTabLabel
"	^SimpleBorder new
		width: 0;
		baseColor: (self buttonBaseColorFor: aTabLabel) darker
"	^ self buttonNormalBorderStyleFor: aTabLabel! !

!Pharo3DarkTheme methodsFor: 'fill-styles' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
textEditorDisabledFillStyleFor: aTextEditor
	"Return the disabled fillStyle for the given text editor."
	
	^self glamorousBasePassiveBackgroundColorFor: aTextEditor! !

!Pharo3DarkTheme methodsFor: 'fill-styles-buttons' stamp: 'EstebanLorenzano 4/29/2014 18:21'!
buttonNormalFillStyleFor: aButton
	"Return the normal button fillStyle for the given button."
	
	(aButton valueOfProperty: #noFill ifAbsent: [false]) 
		ifTrue: [ ^ SolidFillStyle color: Color transparent ].
		
	^ SolidFillStyle color: self buttonColor.! !

!Pharo3DarkTheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 5/3/2014 14:13'!
listTextColor
	"Answer the list text color to use."

	^ self textColor! !

!Pharo3DarkTheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 5/1/2014 11:20'!
unfocusedSelectionColor
	^ self secondarySelectionColor! !

!Pharo3DarkTheme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
newWindowCloseForm
	"Answer a new form for a window close box."

	^ Pharo3UIThemeIcons windowCloseForm ! !

!Pharo3DarkTheme class methodsFor: 'private' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
importGlamorousIcons
	"utility method to import the icons necessary for the theme from the file system"
	"self importGlamorousIcons"
	| icons |
	icons := #(
		'glamorousMax'
		'glamorousMin'
		'glamorousClose'
		'glamorousMenu'
		'glamorousMaxInactive'
		'glamorousMinInactive'
		'glamorousCloseInactive'
		'glamorousMenuInactive'
		'glamorousMenuPin'
		'glamorousCheckboxSelected'
		'glamorousCheckboxUnselected'
		'glamorousRadioSelected'
		'glamorousRadioUnselected').
	self importIcons: icons fromFolder: 'icons' inClass: Pharo3UIThemeIcons category: '*glamour-morphic-theme'! !

!Pharo3DarkTheme class methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/15/2013 22:23'!
darkBaseColor
	^ Color veryDarkGray! !

!Pharo3DarkTheme class methodsFor: 'private' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
importIcons: icons fromFolder: aString inClass: aClass category: aCategory
	icons
		do: [:each |
			| method form |
			form := PNGReadWriter formFromFileNamed: aString, '/', each , '.png'.
			method := each , Character cr asString ,
				(aClass methodStart: each),		
				form storeString,
				aClass methodEnd.
			aClass class compile: method classified: aCategory ].
	aClass initialize! !

!Pharo3DarkTheme class methodsFor: 'testing' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
isAbstract
	"Answer whether the receiver is considered to be abstract."

	^false! !

!Pharo3DarkTheme class methodsFor: 'settings' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
setPreferredPreferences
	"NECPreferences 
		expandPrefixes: true;
		popupShowWithShortcut: Character tab asShortcut."! !

!Pharo3DarkTheme class methodsFor: 'installing' stamp: 'EstebanLorenzano 5/1/2014 12:19'!
installFullTheme
	"Installs full theme: 
		this theme
		dark forts
		desktop background
		completion list colors"
		
	self beCurrent.
	SHPreferences setStyleTable: SHTextStylerST80 darkStyleTable.
	PolymorphSystemSettings desktopColor: Color darkGray darker.
	NECPreferences backgroundColor: UITheme current windowColor. 
	Paragraph insertionPointColor: UITheme current caretColor.
	! !

!Pharo3DarkTheme class methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
lightSelectionColor
	^ Color r: 175 g: 213 b: 250 range: 255! !

!Pharo3DarkTheme class methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/15/2013 22:22'!
basePassiveBackgroundColor
	^ Color darkGray! !

!Pharo3DarkTheme class methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/15/2013 22:22'!
baseColor
	^ Color veryDarkGray! !

!Pharo3DarkTheme class methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
baseSelectionColor
	^ Color r: 97 g: 163 b: 225 range: 255! !

!Pharo3DarkTheme class methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/15/2013 22:23'!
lightBaseColor
	^ Color darkGray! !

!Pharo3DarkTheme class methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/15/2013 22:22'!
themeName
	^ 'Pharo3 Dark'! !

!Pharo3DarkTheme class methodsFor: 'settings' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
setPreferredWorldBackground
	"self setPreferredWorldBackground"
	World color: Color white! !

!Pharo3DarkTheme class methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
veryLightSelectionColor
	^ self lightSelectionColor muchLighter! !

!Pharo3DarkTheme class methodsFor: 'settings' stamp: 'EstebanLorenzano 10/15/2013 22:18'!
newDefaultSettings
	self setPreferredPreferences.
	
	BalloonMorph setBalloonColorTo: self lightSelectionColor.
	^super newDefaultSettings
		menuColor: self baseColor;
		menuTitleColor: self baseColor;
		windowColor: self baseColor;
		selectionColor: self lightSelectionColor;
		menuSelectionColor: self baseSelectionColor;
		progressBarColor: self baseColor;
		standardColorsOnly: true;
		autoSelectionColor: false;
		preferRoundCorner: false;
		fadedBackgroundWindows: false;
		secondarySelectionColor: self veryLightSelectionColor;
		flatMenu: true! !

!Pharo3TabPanelBorder commentStamp: '<historical>'!
Specialized border for TabGroup. Does not draw border beneath the selectd tab and only draws on top.!
!Pharo3TabPanelBorder methodsFor: 'drawing' stamp: 'tg 9/10/2010 07:42'!
frameRectangle: aRectangle on: aCanvas
	"Draw the border taking the currently selected tab into account.
	Only works for top-positioned tabs for the moment."
	
	|w h r tab|
	w := self width.
	w isPoint ifTrue: [h := w y. w := w x] ifFalse:[h := w].
	tab := self selectedTab.
	tab ifNil: [	
		r := aRectangle topLeft + (w@0) corner: aRectangle topRight - (w@h negated).
		aCanvas fillRectangle: r color: self color.
		^self]. "top"
	r := aRectangle topLeft + (w@0) corner: tab bounds left + w@(aRectangle top + h).
	aCanvas fillRectangle: r color: self color. "top 1"
	r := tab bounds left + w@ aRectangle top corner: tab bounds right - w@(aRectangle top + h).
	aCanvas fillRectangle: r color: tab paneColor. "top 2"
	r :=  tab bounds right - w@ aRectangle top corner: aRectangle topRight - (w@h negated).
	aCanvas fillRectangle: r color: self color. "top 3"! !

!Pharo3Theme commentStamp: '<historical>'!
The theme is developed in the context of the Glamour project, and its goal is to create a look that:
- does not look like a specific operating system. In particular, the icons should be operating system agnostic, because, for example, people in Windows are confused by the red, yellow, green buttons of apple.
- uses a limited amount of colors and effects.
- is fast.

self defaultSettings: nil.
self beCurrent. 

Is adopted as the theme for Pharo3, but it was renamed to avoid collisions with the glamour team,!
!Pharo3Theme methodsFor: 'growl - specific' stamp: 'TudorGirba 4/18/2012 09:12'!
growlLabelColorFor: aGrowlMorph
	^ Color white twiceDarker! !

!Pharo3Theme methodsFor: 'forms' stamp: 'FernandoOlivero 10/28/2010 14:18'!
newWindowCloseOverForm
	"Answer a new form for a window menu box."

	^ self newWindowCloseForm! !

!Pharo3Theme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/10/2013 17:36'!
radioButtonSelectedForm
	"Answer the form to use for a selected radio button."

	^ Pharo3UIThemeIcons radioButtonSelectedForm ! !

!Pharo3Theme methodsFor: 'private' stamp: 'tg 9/9/2010 22:50'!
glamorousDarkBaseColorFor: aButton
	^ self class darkBaseColor! !

!Pharo3Theme methodsFor: 'border-styles' stamp: 'tg 9/4/2010 20:56'!
taskbarThumbnailNormalBorderStyleFor: aWindow
	^ self buttonNormalBorderStyleFor: aWindow! !

!Pharo3Theme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/10/2013 17:36'!
checkboxUnselectedForm
	"Answer the form to use for a selected checkbox."

	^ Pharo3UIThemeIcons checkboxUnselectedForm! !

!Pharo3Theme methodsFor: 'watcher window' stamp: 'TudorGirba 5/23/2012 14:26'!
configureWatcherWindowLabelAreaFor: aWindow
	"Configure the label area for the given Watcher window."

	|padding|
	padding := 0.
	aWindow labelArea
		addMorphBack: (Morph new extent: aWindow class borderWidth @ 0).
	aWindow hasCloseBox ifTrue: [aWindow addCloseBox. padding := padding + 1].
"	aWindow hasCollapseBox ifTrue: [aWindow addCollapseBox. padding := padding + 1].
	aWindow hasExpandBox ifTrue: [aWindow addExpandBox. padding := padding + 1].
	aWindow hasMenuBox ifTrue: [padding := padding - 1].
"	aWindow labelArea
		addMorphBack: (Morph new extent: aWindow class borderWidth @ 0; hResizing: #spaceFill).
	aWindow basicLabel ifNotNil: [:label | aWindow labelArea addMorphBack: label; hResizing: #shrinkWrap].
	aWindow labelArea
		addMorphBack: (Morph new extent: aWindow class borderWidth @ 0; hResizing: #spaceFill).
	padding > 0 ifTrue: [
		aWindow labelArea
			addMorphBack: (Morph new extent: (aWindow boxExtent x * padding) @ 0)].
"	aWindow hasMenuBox ifTrue: [aWindow addMenuControl]."
	aWindow labelArea
		addMorphBack: (Morph new extent: aWindow class borderWidth @ 0)! !

!Pharo3Theme methodsFor: 'fill-styles' stamp: 'tg 9/4/2010 23:14'!
separatorFillStyleFor: aSeparator
	"Return the separator fillStyle for the given separator."
	
	^ SolidFillStyle color: (self glamorousBaseColorFor: aSeparator) darker! !

!Pharo3Theme methodsFor: 'border-styles-scrollbars' stamp: 'EstebanLorenzano 5/15/2014 16:21'!
scrollbarNormalThumbBorderStyleFor: aScrollbar
	"Return the normal thumb borderStyle for the given scrollbar."

	^ BorderStyle simple
		width: 1;
		baseColor: Color transparent! !

!Pharo3Theme methodsFor: 'fill-styles' stamp: 'TudorGirba 5/23/2012 15:32'!
taskbarFillStyleFor: aTaskbar
	^ "self buttonNormalFillStyleFor: aTaskbar"
	SolidFillStyle color: Color transparent ! !

!Pharo3Theme methodsFor: 'border-styles' stamp: 'TudorGirba 5/23/2012 14:24'!
configureWindowDropShadowFor: aWindow

	aWindow hasDropShadow: false! !

!Pharo3Theme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/10/2013 17:36'!
windowMaximizePassiveForm
	"Answer the form to use for passive (background) window maximize/restore buttons"

	^Pharo3UIThemeIcons windowMaximizeInactiveForm! !

!Pharo3Theme methodsFor: 'fill-styles' stamp: 'TudorGirba 5/31/2012 22:51'!
windowInactiveTitleFillStyleFor: aWindow
	"We do not want the lighting effect when the window goes inactive"
	^ SolidFillStyle color: Color transparent! !

!Pharo3Theme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/10/2013 17:36'!
newWindowMenuPassiveForm
	"Answer a new form for a window menu box."

	^ Pharo3UIThemeIcons windowMenuInactiveForm! !

!Pharo3Theme methodsFor: 'border-styles' stamp: 'tg 9/4/2010 22:55'!
dropListNormalBorderStyleFor: aDropList
	"Return the normal borderStyle for the given drop list"

	^ self buttonNormalBorderStyleFor: aDropList! !

!Pharo3Theme methodsFor: 'fill-styles-scrollbars' stamp: 'tg 9/4/2010 21:03'!
scrollbarNormalFillStyleFor: aScrollbar
	"Return the normal scrollbar fillStyle for the given scrollbar."
	
	^ "(self glamorousBaseColorFor: aScrollbar) muchLighter"
	Color r: 245 g: 245 b: 245 range: 255! !

!Pharo3Theme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/10/2013 17:36'!
radioButtonForm
	"Answer the form to use for a normal radio button."

	^ Pharo3UIThemeIcons radioButtonUnselectedForm! !

!Pharo3Theme methodsFor: 'fill-styles' stamp: 'TudorGirba 8/21/2011 16:46'!
splitterPressedFillStyleFor: aSplitter
	"Return the pressed splitter fillStyle for the given splitter."
	
	|aColor|
	aColor := self glamorousBaseColorFor: aSplitter.
	^ (GradientFillStyle ramp: {0.0->aColor lighter. 0.9-> aColor})
		origin: aSplitter topLeft;
		direction: (aSplitter splitsTopAndBottom
			ifTrue: [0 @ aSplitter height]
			ifFalse: [aSplitter width @ 0]);
		radial: false! !

!Pharo3Theme methodsFor: 'private' stamp: 'PhilippeBack 3/26/2014 09:37'!
glamorousVeryLightFillStyleFor: aMorph height: anInteger
	"Return the very light button fillStyle for the given button."
	
"	| baseColor |
	baseColor := self glamorousBaseColorFor: aMorph.
	^ self glamorousNormalFillStyleWithBaseColor: baseColor for: aMorph height: anInteger
"
	^ SolidFillStyle color: (self glamorousVeyLightSelectionColorFor: aMorph)! !

!Pharo3Theme methodsFor: 'fill-styles' stamp: 'tg 9/3/2010 12:30'!
dockingBarNormalFillStyleFor: aToolDockingBar
	^ SolidFillStyle color: Color transparent! !

!Pharo3Theme methodsFor: 'private' stamp: 'PhilippeBack 3/26/2014 11:39'!
glamorousSelectedFillStyleFor: aMorph height: anInteger
	

	^ SolidFillStyle color: (self glamorousLightSelectionColorFor:  aMorph)
! !

!Pharo3Theme methodsFor: 'forms' stamp: 'PhilippeBack 3/26/2014 11:38'!
scrollbarPressedThumbFillStyleFor: aScrollbar
	"Return the pressed scrollbar thumb fillStyle for the given scrollbar."
		"Return the normal scrollbar fillStyle for the given scrollbar."
	
	"^ (self glamorousNormalFillStyleWithBaseColor: aScrollbar paneColor for:  aScrollbar height: aScrollbar height)
		direction: (aScrollbar bounds isWide
			ifTrue: [0 @ aScrollbar height]
			ifFalse: [aScrollbar width @ 0])"
"	^ SolidFillStyle color: Color lightGray lighter."
	^ self glamorousSelectedFillStyleFor: aScrollbar height: aScrollbar height! !

!Pharo3Theme methodsFor: 'defaults' stamp: 'TudorGirba 5/19/2013 21:26'!
windowShadowColor
	"Answer the window shadow color to use."

	^ Color gray! !

!Pharo3Theme methodsFor: 'private' stamp: 'tg 9/9/2010 22:02'!
glamorousLightColorFor: aButton
	^ self class lightBaseColor! !

!Pharo3Theme methodsFor: 'growl - specific' stamp: 'TudorGirba 4/18/2012 09:32'!
growlBorderColorFor: aGrowlMorph
	^ Color white alpha: 0.5! !

!Pharo3Theme methodsFor: 'initialize-release' stamp: 'TudorGirba 4/8/2011 01:09'!
initializeForms
	"Initialize the receiver's image forms."

	|inactiveForm|
	super initializeForms.
	inactiveForm := self newWindowInactiveControlForm.
	self forms
		at: #windowCloseOver put: self newWindowCloseOverForm;
		at: #windowMinimizeOver put: self newWindowMinimizeOverForm;
		at: #windowMaximizeOver put: self newWindowMaximizeOverForm;
		at: #windowClosePassive put: inactiveForm;
		at: #windowMinimizePassive put: inactiveForm;
		at: #windowMaximizePassive put: inactiveForm! !

!Pharo3Theme methodsFor: 'watcher window' stamp: 'TudorGirba 5/23/2012 14:09'!
watcherWindowActiveFillStyleFor: aWindow

	^ SolidFillStyle color: (Color veryVeryLightGray alpha: 0.6)! !

!Pharo3Theme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/10/2013 17:36'!
newCheckboxMarkerForm
	"Answer a new checkbox marker form."

	^Pharo3UIThemeIcons checkboxMarkerForm! !

!Pharo3Theme methodsFor: 'basic-colors' stamp: 'tg 9/6/2010 15:03'!
taskbarButtonLabelColorFor: aButton
	"Answer the colour for the label of the given taskbar button."

	^aButton model
		ifNil: [super taskbarButtonLabelColorFor: aButton]
		ifNotNil: [:win |
			win isActive
				ifTrue: [Color black]
				ifFalse: [Color gray darker]]! !

!Pharo3Theme methodsFor: 'border-styles-buttons' stamp: 'tg 9/4/2010 23:06'!
buttonCornerStyleIn: aThemedMorph
	"If asked, we only allow square corners"
	
	^ #square! !

!Pharo3Theme methodsFor: 'private' stamp: 'tg 9/3/2010 12:32'!
glamorousBaseColorFor: aButton
	^ self class baseColor
	"unfortunately, it looks like paneColor does not always return the wanted color"
	"aButton paneColorOrNil ifNil: [Color r: 200 g: 200 b: 200 range: 255]"! !

!Pharo3Theme methodsFor: 'fill-styles-buttons' stamp: 'tg 9/13/2010 10:37'!
buttonSelectedFillStyleFor: aButton
	"Return the normal button fillStyle for the given button."
	
	| top bottom |
	top := self glamorousLightSelectionColorFor: aButton.
	bottom := self glamorousLightColorFor: aButton.

	^(GradientFillStyle ramp: {
			0.0->top.
			0.7->bottom.})
		origin: aButton bounds origin;
		direction: 0 @ aButton height;
		radial: false! !

!Pharo3Theme methodsFor: 'border-styles' stamp: 'tg 9/4/2010 23:09'!
textEditorNormalBorderStyleFor: aTextEditor
	"Return the normal text editor borderStyle for the given text editor."

	^self buttonNormalBorderStyleFor: aTextEditor! !

!Pharo3Theme methodsFor: 'fill-styles' stamp: 'TudorGirba 4/14/2011 10:28'!
progressFillStyleFor: aProgress
	"Return the progress fillStyle for the given progress morph."
	^ self windowActiveFillStyleFor: aProgress  ! !

!Pharo3Theme methodsFor: 'scrollbars' stamp: 'TudorGirba 5/19/2013 14:46'!
scrollBarButtonArrowVertices: aRectangle 
	^ self verticesForSimpleArrow: aRectangle! !

!Pharo3Theme methodsFor: 'label-styles' stamp: 'EstebanLorenzano 4/29/2014 18:29'!
buttonLabelForText: aTextOrString
	"Answer the label to use for the given text."
	^aTextOrString isString
		ifTrue: [(LabelMorph contents: aTextOrString) color: self textColor ]
		ifFalse: [super buttonLabelForText: aTextOrString]! !

!Pharo3Theme methodsFor: 'border-styles' stamp: 'tg 9/9/2010 23:51'!
groupPanelBorderStyleFor: aGroupPanel
	"Answer the normal border style for a group panel."

	^ SimpleBorder new
		width: 1;
		baseColor: ((self glamorousBaseColorFor: aGroupPanel))! !

!Pharo3Theme methodsFor: 'watcher window' stamp: 'TudorGirba 5/23/2012 14:10'!
watcherWindowInactiveFillStyleFor: aWindow

	^ SolidFillStyle color: (Color veryVeryLightGray alpha: 0.6)! !

!Pharo3Theme methodsFor: 'border-styles-buttons' stamp: 'MarcusDenker 7/9/2014 21:39'!
buttonNormalBorderStyleFor: aButton
	"Return the normal button borderStyle for the given button."

	| outerColor |
	(aButton valueOfProperty: #noBorder ifAbsent: [false]) ifTrue: [
		^ SimpleBorder new width: 0; baseColor: Color transparent ].
	outerColor := self glamorousDarkBaseColorFor: aButton.
	^SimpleBorder new
					width: 1;
					baseColor: outerColor! !

!Pharo3Theme methodsFor: 'label-styles' stamp: 'tg 9/3/2010 11:34'!
createMenuBoxFor: aSystemWindow
	"Answer a button for the window menu."
	
"	^aSystemWindow createBox
		labelGraphic: (self windowMenuIconFor: aSystemWindow);
		extent: aSystemWindow boxExtent;
		actWhen: #buttonDown;
		actionSelector: #offerWindowMenu;
		setBalloonText: 'window menu' translated"
	
	|form msb|
	form := self windowMenuForm.
	msb := MultistateButtonMorph new extent: form extent.
	msb activeEnabledNotOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowMenuPassiveForm.
	msb extent: form extent.
	msb activeDisabledNotOverUpFillStyle: (ImageFillStyle form: form).
	msb passiveEnabledNotOverUpFillStyle: (ImageFillStyle form: form).
	msb passiveDisabledNotOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowMenuForm.
	msb extent: form extent.
	msb
		activeEnabledOverUpFillStyle: (ImageFillStyle form: form);
		passiveEnabledOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowMenuPassiveForm.
	msb
		extent: form extent;
		activeEnabledOverDownFillStyle: (ImageFillStyle form: form);
		passiveEnabledOverDownFillStyle: (ImageFillStyle form: form);
		addUpAction: [aSystemWindow offerWindowMenu];
		setBalloonText: 'window menu' translated;
		extent: aSystemWindow boxExtent.
	^msb! !

!Pharo3Theme methodsFor: 'fill-styles' stamp: 'tg 9/5/2010 20:51'!
progressBarFillStyleFor: aProgressBar
	^ self glamorousBasePassiveBackgroundColorFor: aProgressBar! !

!Pharo3Theme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/10/2013 17:36'!
checkboxSelectedForm
	"Answer the form to use for a selected checkbox."

	^Pharo3UIThemeIcons checkboxSelectedForm! !

!Pharo3Theme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/10/2013 17:36'!
windowClosePassiveForm
	"Answer the form to use for passive (background) window close buttons"

	^Pharo3UIThemeIcons windowCloseInactiveForm! !

!Pharo3Theme methodsFor: 'fill-styles' stamp: 'tg 9/4/2010 23:04'!
dropListNormalFillStyleFor: aDropList
	"Return the normal fillStyle for the given drop list."
	
	^ SolidFillStyle color: Color white! !

!Pharo3Theme methodsFor: 'fill-styles-buttons' stamp: 'tg 8/31/2010 11:13'!
tabLabelSelectedFillStyleFor: aTabLabel
	^ self buttonSelectedFillStyleFor: aTabLabel ! !

!Pharo3Theme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/10/2013 17:36'!
windowMinimizePassiveForm
	"Answer the form to use for passive (background) window minimize buttons"

	^Pharo3UIThemeIcons windowMinimizeInactiveForm! !

!Pharo3Theme methodsFor: 'private' stamp: 'TudorGirba 4/12/2011 08:24'!
glamorousLightSelectionColorFor: aMorph
	^ self class lightSelectionColor! !

!Pharo3Theme methodsFor: 'fill-styles' stamp: 'TudorGirba 1/25/2011 15:39'!
expanderTitleNormalFillStyleFor: anExpanderTitle
	"Return the normal expander title fillStyle for the given expander title."
	
	^ self buttonNormalFillStyleFor: anExpanderTitle! !

!Pharo3Theme methodsFor: 'fill-styles' stamp: 'tg 9/5/2010 20:48'!
listDisabledFillStyleFor: aList
	"Return the disabled fillStyle for the given list."
	
	^ self textEditorDisabledFillStyleFor: aList! !

!Pharo3Theme methodsFor: 'fill-styles' stamp: 'tg 9/5/2010 20:47'!
dropListDisabledFillStyleFor: aDropList
	"Return the disabled fillStyle for the given drop list."
	
	^ self textEditorDisabledFillStyleFor: aDropList! !

!Pharo3Theme methodsFor: 'fill-styles' stamp: 'tg 9/5/2010 20:48'!
sliderDisabledFillStyleFor: aSlider
	"Return the disabled fillStyle for the given slider."
	
	^ self textEditorDisabledFillStyleFor: aSlider! !

!Pharo3Theme methodsFor: 'forms' stamp: 'FernandoOlivero 10/28/2010 14:18'!
newWindowMaximizeOverForm
	"Answer a new form for a window menu box."

	^ self newWindowMaximizeForm! !

!Pharo3Theme methodsFor: 'private' stamp: 'tg 9/5/2010 20:40'!
glamorousBaseSelectionColorFor: aButton
	^ self class baseSelectionColor! !

!Pharo3Theme methodsFor: 'forms' stamp: 'FernandoOlivero 10/28/2010 15:09'!
newWindowMinimizeOverForm
	"Answer a new form for a window menu box."

	^ self newWindowMinimizeForm! !

!Pharo3Theme methodsFor: 'defaults' stamp: 'NicolaiHess 12/5/2014 09:46'!
dialogWindowPreferredCornerStyleFor: aDialogWindow
	"Answer the preferred corner style for the given dialog."

	^ self windowPreferredCornerStyleFor:aDialogWindow! !

!Pharo3Theme methodsFor: 'fill-styles' stamp: 'TudorGirba 5/31/2012 22:28'!
windowActiveFillStyleFor: aWindow
	"We do not want the lighting effect when the window goes inactive"
	^SolidFillStyle color: self class baseColor! !

!Pharo3Theme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/10/2013 17:36'!
newWindowMenuForm
	"Answer a new form for a window menu box."

	^ Pharo3UIThemeIcons windowMenuForm! !

!Pharo3Theme methodsFor: 'morph creation' stamp: 'MarcusDenker 7/9/2014 21:38'!
newFocusIndicatorMorphFor: aMorph
	"Answer a new focus indicator for the given morph."

	^ BorderedMorph new
		fillStyle: Color transparent;
		borderStyle: (SimpleBorder new
			 width: 1;
			baseColor: (self glamorousBaseSelectionColorFor: aMorph));
		bounds: aMorph focusBounds! !

!Pharo3Theme methodsFor: 'border-styles' stamp: 'tg 9/3/2010 14:50'!
plainGroupPanelBorderStyleFor: aGroupPanel
	"Answer the normal border style for a plain group panel."

	^SimpleBorder new
		width: 1;
		baseColor: Color transparent! !

!Pharo3Theme methodsFor: 'initialize-release' stamp: 'tg 9/6/2010 14:38'!
newRadioMarkerForm
	"Answer a new checkbox marker form."

	^Form extent: 12@12 depth: 32! !

!Pharo3Theme methodsFor: 'private' stamp: 'TudorGirba 4/11/2011 01:37'!
glamorousNormalFillStyleWithBaseColor: aColor for: aMorph height: anInteger	
	| top bottom |
	top := aColor darker.
	bottom := aColor.
	^(GradientFillStyle ramp: {
			0.0->top.
			0.7->bottom.})
		origin: aMorph bounds origin;
		direction: 0 @ anInteger;
		radial: false! !

!Pharo3Theme methodsFor: 'border-styles' stamp: 'TudorGirba 6/1/2012 19:40'!
configureWindowBorderFor: aWindow
"	super configureWindowBorderFor: aWindow.
	aWindow roundedCorners: #()"
	| aStyle |
	
	aStyle := 
		SimpleBorder new 
			color: (Color lightGray);
			width: 1.
			
	aWindow borderStyle: aStyle.! !

!Pharo3Theme methodsFor: 'border-styles' stamp: 'tg 9/4/2010 20:23'!
taskbarThumbnailCornerStyleFor: aMorph
	"Answer the corner style for the taskbar thumbnail/tasklist."
	
	^#square! !

!Pharo3Theme methodsFor: 'forms' stamp: 'FernandoOlivero 10/28/2010 09:08'!
checkboxForm
	"Answer the form to use for a normal checkbox."

	^self  checkboxUnselectedForm! !

!Pharo3Theme methodsFor: 'border-styles' stamp: 'EstebanLorenzano 10/10/2013 17:36'!
tabPanelBorderStyleFor: aTabGroup
	^ Pharo3TabPanelBorder new 
		width: 1;
		baseColor: ((self glamorousDarkBaseColorFor: aTabGroup));
		tabSelector: aTabGroup tabSelectorMorph! !

!Pharo3Theme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/10/2013 17:36'!
menuPinForm
	"Answer the form to use for the pin button of a menu."

	^ Pharo3UIThemeIcons menuPinForm! !

!Pharo3Theme methodsFor: 'fill-styles' stamp: 'TudorGirba 8/21/2011 16:47'!
morphTreeSplitterNormalFillStyleFor: aSplitter	
	^ self splitterNormalFillStyleFor: aSplitter! !

!Pharo3Theme methodsFor: 'fill-styles-buttons' stamp: 'tg 9/10/2010 08:12'!
menuItemInDockingBarSelectedFillStyleFor: aMenuItem
	"Answer the selected fill style to use for the given menu item that is in a docking bar."
	^ self buttonSelectedFillStyleFor: aMenuItem! !

!Pharo3Theme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/10/2013 17:36'!
newWindowMinimizeForm
	"Answer a new form for a window minimize box."

	^ Pharo3UIThemeIcons windowMinimizeForm! !

!Pharo3Theme methodsFor: 'basic-colors' stamp: 'tg 9/13/2010 10:36'!
subgroupColorFrom: paneColor
	"Answer the colour for a subgroup given the pane colour."

	^ self glamorousLightColorFor: paneColor" self class baseColor"! !

!Pharo3Theme methodsFor: 'fill-styles-buttons' stamp: 'tg 8/31/2010 11:13'!
tabLabelNormalFillStyleFor: aTabLabel
	^ self buttonNormalFillStyleFor: aTabLabel ! !

!Pharo3Theme methodsFor: 'fill-styles' stamp: 'tg 9/2/2010 13:52'!
windowInactiveFillStyleFor: aWindow
	"We do not want the lighting effect when the window goes inactive"
	^self windowActiveFillStyleFor: aWindow! !

!Pharo3Theme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/10/2013 17:36'!
newWindowMaximizeForm
	"Answer a new form for a window maximize box."

	^ Pharo3UIThemeIcons windowMaximizeForm! !

!Pharo3Theme methodsFor: 'private' stamp: 'TudorGirba 4/11/2011 21:25'!
glamorousNormalFillStyleFor: aMorph height: anInteger
	"Return the normal button fillStyle for the given button."
	
"	| baseColor |
	baseColor := self glamorousBaseColorFor: aMorph.
	^ self glamorousNormalFillStyleWithBaseColor: baseColor for: aMorph height: anInteger
"

	^ SolidFillStyle color: (self glamorousLightColorFor: aMorph)! !

!Pharo3Theme methodsFor: 'fill-styles' stamp: 'TudorGirba 5/31/2012 22:51'!
windowActiveTitleFillStyleFor: aWindow
	^ "self glamorousNormalFillStyleFor: aWindow height: aWindow labelHeight"
	SolidFillStyle color: Color transparent! !

!Pharo3Theme methodsFor: 'border-styles' stamp: 'tg 8/31/2010 15:28'!
tabLabelNormalBorderStyleFor: aTabLabel
"	^SimpleBorder new
		width: 0;
		baseColor: (self buttonBaseColorFor: aTabLabel) darker
"	^ self buttonNormalBorderStyleFor: aTabLabel! !

!Pharo3Theme methodsFor: 'fill-styles' stamp: 'TudorGirba 8/21/2011 16:49'!
morphTreeSplitterPressedFillStyleFor: aSplitter	
	^ self splitterPressedFillStyleFor: aSplitter! !

!Pharo3Theme methodsFor: 'label-styles' stamp: 'tg 9/3/2010 10:52'!
windowMenuPassiveForm
	"Answer the form to use for passive (background) window menu buttons"

	^self newWindowMenuPassiveForm! !

!Pharo3Theme methodsFor: 'fill-styles' stamp: 'tg 9/5/2010 20:41'!
splitterNormalFillStyleFor: aSplitter
	"Return the normal splitter fillStyle for the given splitter."
	
	^ SolidFillStyle color: Color transparent! !

!Pharo3Theme methodsFor: 'private' stamp: 'tg 9/5/2010 20:40'!
glamorousBasePassiveBackgroundColorFor: aButton
	^ self class basePassiveBackgroundColor! !

!Pharo3Theme methodsFor: 'growl - specific' stamp: 'TudorGirba 4/18/2012 09:16'!
growlDismissHandleFor: aGrowlMorph
	| form image |
	form := self windowCloseForm.
	image := ImageMorph new.
	image image: form.
	image color: Color yellow.
	^ image! !

!Pharo3Theme methodsFor: 'fill-styles' stamp: 'tg 9/7/2010 13:52'!
progressBarProgressFillStyleFor: aProgressBar
	^ (self glamorousLightSelectionColorFor: aProgressBar)! !

!Pharo3Theme methodsFor: 'private' stamp: 'PhilippeBack 3/26/2014 09:33'!
glamorousVeyLightSelectionColorFor: aMorph
	^ self class veryLightSelectionColor! !

!Pharo3Theme methodsFor: 'fill-styles' stamp: 'tg 9/5/2010 20:46'!
textEditorDisabledFillStyleFor: aTextEditor
	"Return the disabled fillStyle for the given text editor."
	
	^self glamorousBasePassiveBackgroundColorFor: aTextEditor! !

!Pharo3Theme methodsFor: 'fill-styles-scrollbars' stamp: 'tg 9/13/2010 10:52'!
scrollbarNormalButtonFillStyleFor: aScrollbar
	"Return the normal scrollbar button fillStyle for the given scrollbar."
	
	^ self scrollbarNormalThumbFillStyleFor: aScrollbar! !

!Pharo3Theme methodsFor: 'fill-styles-buttons' stamp: 'tg 9/3/2010 12:21'!
buttonNormalFillStyleFor: aButton
	"Return the normal button fillStyle for the given button."
	
	(aButton valueOfProperty: #noFill ifAbsent: [false]) ifTrue: [^ SolidFillStyle color: Color transparent ].
	^ self glamorousNormalFillStyleFor: aButton height: aButton height! !

!Pharo3Theme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/10/2013 17:36'!
newRadioButtonMarkerForm
	"Answer a new radio button marker form. We make it empty because we already have the selected radio button take care of the state."

	^Pharo3UIThemeIcons radioButtonMarkerForm  ! !

!Pharo3Theme methodsFor: 'growl - specific' stamp: 'TudorGirba 4/18/2012 09:30'!
growlFillColorFor: aGrowlMorph
	^ Color darkGray alpha: 0.5! !

!Pharo3Theme methodsFor: 'border-styles-scrollbars' stamp: 'tg 8/31/2010 13:27'!
scrollbarPagingAreaCornerStyleIn: aThemedMorph	
	^#square! !

!Pharo3Theme methodsFor: 'fill-styles-scrollbars' stamp: 'EstebanLorenzano 5/15/2014 16:21'!
scrollbarNormalThumbFillStyleFor: aScrollbar
	"Return the normal scrollbar fillStyle for the given scrollbar."
	
	"^ (self glamorousNormalFillStyleWithBaseColor: aScrollbar paneColor for:  aScrollbar height: aScrollbar height)
		direction: (aScrollbar bounds isWide
			ifTrue: [0 @ aScrollbar height]
			ifFalse: [aScrollbar width @ 0])"
"	^ SolidFillStyle color: Color lightGray lighter."
	^ self  glamorousNormalFillStyleFor: aScrollbar height: aScrollbar height! !

!Pharo3Theme methodsFor: 'forms' stamp: 'EstebanLorenzano 10/10/2013 17:36'!
newWindowCloseForm
	"Answer a new form for a window close box."

	^ Pharo3UIThemeIcons windowCloseForm ! !

!Pharo3Theme class methodsFor: 'private' stamp: 'EstebanLorenzano 10/10/2013 17:36'!
importGlamorousIcons
	"utility method to import the icons necessary for the theme from the file system"
	"self importGlamorousIcons"
	| icons |
	icons := #(
		'glamorousMax'
		'glamorousMin'
		'glamorousClose'
		'glamorousMenu'
		'glamorousMaxInactive'
		'glamorousMinInactive'
		'glamorousCloseInactive'
		'glamorousMenuInactive'
		'glamorousMenuPin'
		'glamorousCheckboxSelected'
		'glamorousCheckboxUnselected'
		'glamorousRadioSelected'
		'glamorousRadioUnselected').
	self importIcons: icons fromFolder: 'icons' inClass: Pharo3UIThemeIcons category: '*glamour-morphic-theme'! !

!Pharo3Theme class methodsFor: 'accessing' stamp: 'TudorGirba 5/31/2012 22:33'!
darkBaseColor
	^ Color r: 200 g: 200 b: 200 range: 255! !

!Pharo3Theme class methodsFor: 'private' stamp: 'tg 9/3/2010 14:28'!
importIcons: icons fromFolder: aString inClass: aClass category: aCategory
	icons
		do: [:each |
			| method form |
			form := PNGReadWriter formFromFileNamed: aString, '/', each , '.png'.
			method := each , Character cr asString ,
				(aClass methodStart: each),		
				form storeString,
				aClass methodEnd.
			aClass class compile: method classified: aCategory ].
	aClass initialize! !

!Pharo3Theme class methodsFor: 'testing' stamp: 'TudorGirba 4/7/2011 23:45'!
isAbstract
	"Answer whether the receiver is considered to be abstract."

	^false! !

!Pharo3Theme class methodsFor: 'settings' stamp: 'TudorGirba 2/16/2011 20:56'!
setPreferredShoutColors
	"self setPreferredShoutColors"

	SHTextStylerST80 styleTable: 
		#(
			"(symbol color [emphasisSymbolOrArray [textStyleName [pixelHeight]]])" 
			(default 								black)
			(invalid 									red)
			(excessCode 							red)
			(comment 								(gray darker))
			(unfinishedComment 					(red muchDarker))
			(#'$' 									(red muchDarker))
			(character 								(red muchDarker))
			(integer 								(red muchDarker))
			(number 								(red muchDarker)) 
			(#- 										(red muchDarker))
			(symbol 								(magenta muchDarker)) 
			(stringSymbol 							(magenta muchDarker)) 
			(literalArray 							(magenta muchDarker))
			(string 									(magenta muchDarker) normal)
			(unfinishedString 						red normal)
			(assignment 							nil)
			(ansiAssignment 						nil)
			(literal 									nil italic)
			(keyword 								(black))
			(binary 									(black)) 
			(unary 									(black))
			(incompleteKeyword 					red)
			(incompleteBinary 						red) 
			(incompleteUnary 						red )
			(undefinedKeyword 					red)
			(undefinedBinary 						red) 
			(undefinedUnary 						red) 
			(patternKeyword 						nil bold)
			(patternBinary 							nil bold)
			(patternUnary 							nil bold) 
			(#self 									(cyan muchDarker ))
			(#super 								(cyan muchDarker ))
			(#true 									(red muchDarker))
			(#false 									(red muchDarker))
			(#nil 									(red muchDarker))
			(#thisContext 							(cyan muchDarker ))
			(#return 								(cyan muchDarker ) bold)
			(patternArg 							(blue muchDarker)) 
			(methodArg 							(blue muchDarker))
			(blockPatternArg 						(blue muchDarker))
			(blockArg 								(blue muchDarker))
			(argument 								(blue muchDarker))
			(blockArgColon 						black)
			(leftParenthesis 						black)
			(rightParenthesis 						black)
			(leftParenthesis1 						(green muchDarker))
			(rightParenthesis1 						(green muchDarker))
			(leftParenthesis2 						(magenta muchDarker))
			(rightParenthesis2 						(magenta muchDarker))
			(leftParenthesis3 						(red muchDarker))
			(rightParenthesis3 						(red muchDarker))
			(leftParenthesis4 						(green darker))
			(rightParenthesis4 						(green darker))
			(leftParenthesis5 						(orange darker))
			(rightParenthesis5 						(orange darker))
			(leftParenthesis6 						(magenta darker))
			(rightParenthesis6 						(magenta darker))
			(leftParenthesis7 						blue)
			(rightParenthesis7 						blue)
			(blockStart 								black)
			(blockEnd 								black)
			(blockStart1 							(green muchDarker))
			(blockEnd1 								(green muchDarker))
			(blockStart2 							(magenta muchDarker))
			(blockEnd2 								(magenta muchDarker))
			(blockStart3 							(red muchDarker))
			(blockEnd3 								(red muchDarker))
			(blockStart4 							(green darker))
			(blockEnd4 								(green darker))
			(blockStart5 							(orange darker))
			(blockEnd5 								(orange darker))
			(blockStart6 							(magenta darker))
			(blockEnd6 								(magenta darker))
			(blockStart7 							blue)
			(blockEnd7 								blue) 
			(arrayStart 								black)
			(arrayEnd 								black)
			(arrayStart1 							black)
			(arrayEnd1 								black)
			(leftBrace 								black)
			(rightBrace 								black)
			(cascadeSeparator 					black)
			(statementSeparator 					black)
			(externalCallType 						black)
			(externalCallTypePointerIndicator 		black)
			(primitiveOrExternalCallStart 			black bold)
			(primitiveOrExternalCallEnd 			black bold)
			(methodTempBar 						(black))
			(blockTempBar 						(black))
			(blockArgsBar 							(black))
			(primitive 								(green muchDarker))
			(pragmaKeyword 						(green muchDarker))
			(pragmaUnary 							(green muchDarker))
			(pragmaBinary 							(green muchDarker)) 
			(externalFunctionCallingConvention 	(green muchDarker) bold)
			(module 								(green muchDarker) bold)
			(blockTempVar 						(blue muchDarker))
			(blockPatternTempVar 					(blue muchDarker))
			(instVar 								(blue muchDarker))
			(workspaceVar 							(blue muchDarker))
			(undefinedIdentifier 					red)
			(incompleteIdentifier 					red)
			(tempVar 								(blue muchDarker))
			(patternTempVar 						(blue muchDarker))
			(poolConstant 							(blue muchDarker))
			(classVar 								(blue muchDarker))
			(globalVar 								(blue muchDarker)))
! !

!Pharo3Theme class methodsFor: 'settings' stamp: 'EstebanLorenzano 5/23/2013 20:21'!
setPreferredPreferences
	"NECPreferences 
		expandPrefixes: true;
		popupShowWithShortcut: Character tab asShortcut."! !

!Pharo3Theme class methodsFor: 'accessing' stamp: 'tg 9/7/2010 13:51'!
lightSelectionColor
	^ Color r: 175 g: 213 b: 250 range: 255! !

!Pharo3Theme class methodsFor: 'accessing' stamp: 'tg 9/5/2010 20:50'!
basePassiveBackgroundColor
	^ Color r: 245 g: 245 b: 245 range: 255! !

!Pharo3Theme class methodsFor: 'accessing' stamp: 'TudorGirba 5/31/2012 22:51'!
baseColor
	^ Color r: 210 g: 210 b: 210 range: 255! !

!Pharo3Theme class methodsFor: 'accessing' stamp: 'tg 9/5/2010 21:46'!
baseSelectionColor
	^ Color r: 97 g: 163 b: 225 range: 255! !

!Pharo3Theme class methodsFor: 'accessing' stamp: 'TudorGirba 5/31/2012 22:35'!
lightBaseColor
	^ Color r: 230 g: 230 b: 230 range: 255! !

!Pharo3Theme class methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/10/2013 17:44'!
themeName
	^ 'Pharo3'! !

!Pharo3Theme class methodsFor: 'settings' stamp: 'TudorGirba 4/8/2011 00:13'!
setPreferredWorldBackground
	"self setPreferredWorldBackground"
	World color: Color white! !

!Pharo3Theme class methodsFor: 'accessing' stamp: 'TudorGirba 11/29/2012 09:19'!
veryLightSelectionColor
	^ self lightSelectionColor muchLighter! !

!Pharo3Theme class methodsFor: 'settings' stamp: 'TudorGirba 1/16/2015 14:48'!
newDefaultSettings
	self setPreferredPreferences.
	
	BalloonMorph setBalloonColorTo: self lightBaseColor.
	^super newDefaultSettings
		menuColor: self baseColor;
		menuTitleColor: self baseColor;
		windowColor: self baseColor;
		selectionColor: self lightSelectionColor;
		menuSelectionColor: self baseSelectionColor;
		progressBarColor: self baseColor;
		standardColorsOnly: true;
		autoSelectionColor: false;
		preferRoundCorner: false;
		fadedBackgroundWindows: false;
		secondarySelectionColor: self veryLightSelectionColor;
		flatMenu: true! !

!Pharo3UIThemeIcons commentStamp: 'TudorGirba 1/30/2011 22:49'!
This class holds a set of icons to be used in the Glamorous UI Theme.!
!Pharo3UIThemeIcons methodsFor: 'see class side' stamp: 'TudorGirba 1/30/2011 22:49'!
seeClassSide! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:40'!
radioButtonSelectedForm
	^ self form16x16FromContents: self radioButtonSelectedFormContents! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:41'!
windowCloseForm
	^ self form16x16FromContents: self windowCloseFormContents ! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:40'!
checkboxUnselectedForm
	^ self form16x16FromContents: self checkboxUnselectedFormContents 
! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:41'!
windowMinimizeForm
	^self form16x16FromContents: self windowMinimizeFormContents ! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:26'!
menuPinFormContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 83886080 100663296 83886080 0 0 0 0 0 0 0 0 0 0 0 0 1291845632 3774873600 4194304000 3774873600 788529152 0 0 0 0 0 0 0 0 0 0 1107296256 4278190080 4278190080 4278190080 4278190080 4278190080 788529152 0 0 0 0 0 0 0 0 83886080 3992977408 4278190080 4278190080 4278190080 4278190080 4278190080 3774873600 83886080 0 0 0 0 0 0 0 100663296 4194304000 4278190080 4278190080 4278190080 4278190080 4278190080 4194304000 100663296 0 0 0 0 0 0 0 83886080 3774873600 4278190080 4278190080 4278190080 4278190080 4278190080 3992977408 83886080 0 0 0 0 0 0 0 0 1291845632 4261412864 4278190080 4278190080 4278190080 4261412864 1107296256 0 0 0 0 0 0 0 0 0 0 1107296256 3992977408 4194304000 3774873600 1291845632 0 0 0 0 0 0 0 0 0 0 0 0 83886080 100663296 83886080 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 14:10'!
checkboxSelectedFormContents
	^#( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 0 0 0 0 0 0 4278190080 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4278190080 0 0 0 0 0 0 4278190080 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4278190080 0 0 0 0 0 0 4278190080 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4278190080 0 0 0 0 0 0 4278190080 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4278190080 0 0 0 0 0 0 4278190080 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4278190080 0 0 0 0 0 0 4278190080 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4278190080 0 0 0 0 0 0 4278190080 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4278190080 0 0 0 0 0 0 4278190080 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4278190080 0 0 0 0 0 0 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:15'!
windowMenuInactiveFormContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 360282489 3565191296 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 3565191296 360282489 0 0 0 0 0 0 0 360282489 3565191296 4286611584 4286611584 4286611584 4286611584 3565191296 360282489 0 0 0 0 0 0 0 0 0 360282489 3565191296 4286611584 4286611584 3565191296 360282489 0 0 0 0 0 0 0 0 0 0 0 377520256 3565191296 3565191296 360282489 0 0 0 0 0 0 0 0 0 0 0 0 0 377520256 360282489 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/27/2010 15:13'!
radioUnselectedFormContents
	^#( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 50331648 0 0 50331648 0 0 0 0 0 0 0 0 0 0 0 1023410176 3238002688 3909091328 3909091328 3238002688 1023410176 0 0 0 0 0 0 0 0 0 2097152000 3976200192 1275068416 452984832 452984832 1275068416 3976200192 872415232 0 0 0 0 0 0 0 1023410176 4278190080 335544320 0 0 0 0 335544320 4278190080 1023410176 0 0 0 0 0 50331648 3238002688 1275068416 0 0 0 0 0 0 1275068416 3238002688 50331648 0 0 0 0 0 3909091328 452984832 0 0 0 0 0 0 452984832 3909091328 0 0 0 0 0 0 3909091328 452984832 0 0 0 0 0 0 452984832 3909091328 0 0 0 0 0 33554432 3238002688 1275068416 0 0 0 0 0 0 1275068416 3238002688 50331648 0 0 0 0 0 1006632960 3992977408 335544320 0 0 0 0 335544320 4278190080 1023410176 0 0 0 0 0 0 0 2097152000 4278190080 1275068416 452984832 452984832 1275068416 3976200192 2097152000 0 0 0 0 0 0 0 0 0 1006632960 3238002688 3909091328 3909091328 3238002688 1023410176 0 0 0 0 0 0 0 0 0 0 0 33554432 0 0 50331648 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: 0@0! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:27'!
radioButtonSelectedFormContents
	^#( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 50331648 0 0 50331648 0 0 0 0 0 0 0 0 0 0 0 1023410176 3422946822 4043572228 4043572228 3422946822 1023410176 0 0 0 0 0 0 0 0 0 2214987270 4161078533 4284045657 4285690482 4285690482 4284045657 4161078533 1058280468 0 0 0 0 0 0 0 1023410176 4278190080 4285887861 4286611584 4286611584 4286611584 4286611584 4285887861 4278190080 1023410176 0 0 0 0 0 50331648 3422946822 4284045657 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4284045657 3422946822 50331648 0 0 0 0 0 4043572228 4285690482 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4285690482 4043572228 0 0 0 0 0 0 4043572228 4285690482 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4285690482 4043572228 0 0 0 0 0 33554432 3422946822 4284045657 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4284045657 3422946822 50331648 0 0 0 0 0 1006632960 4161078533 4285887861 4286611584 4286611584 4286611584 4286611584 4285887861 4278190080 1023410176 0 0 0 0 0 0 0 2214987270 4278190080 4284045657 4285690482 4285690482 4284045657 4161078533 2214987270 0 0 0 0 0 0 0 0 0 1006632960 3422946822 4043572228 4043572228 3422946822 1023410176 0 0 0 0 0 0 0 0 0 0 0 33554432 0 0 50331648 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/27/2010 15:24'!
windowCloseFormContents
	^#( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 167772160 0 0 0 0 0 0 0 0 167772160 3875536896 4076863488 234881024 0 234881024 2919235584 3858759680 0 0 0 0 0 0 0 0 402653184 3674210304 4261412864 3758096384 671088640 3758096384 4261412864 4278190080 335544320 0 0 0 0 0 0 0 0 352321536 3758096384 4143972352 4211081216 4143972352 3758096384 352321536 0 0 0 0 0 0 0 0 0 0 671088640 4211081216 4261412864 4211081216 671088640 0 0 0 0 0 0 0 0 0 0 352321536 3758096384 4143972352 4211081216 4143972352 3758096384 352321536 0 0 0 0 0 0 0 0 335544320 4278190080 4244635648 3758096384 671088640 3758096384 4143972352 3724541952 402653184 0 0 0 0 0 0 0 0 3892314112 2919235584 234881024 0 234881024 4278190080 1761607680 167772160 0 0 0 0 0 0 0 0 167772160 67108864 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/27/2010 15:13'!
radioSelectedFormContents
	^#( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 50331648 0 0 50331648 0 0 0 0 0 0 0 0 0 0 0 1023410176 3422946822 4043572228 4043572228 3422946822 1023410176 0 0 0 0 0 0 0 0 0 2214987270 4161078533 4284045657 4285690482 4285690482 4284045657 4161078533 1058280468 0 0 0 0 0 0 0 1023410176 4278190080 4285887861 4286611584 4286611584 4286611584 4286611584 4285887861 4278190080 1023410176 0 0 0 0 0 50331648 3422946822 4284045657 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4284045657 3422946822 50331648 0 0 0 0 0 4043572228 4285690482 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4285690482 4043572228 0 0 0 0 0 0 4043572228 4285690482 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4285690482 4043572228 0 0 0 0 0 33554432 3422946822 4284045657 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4284045657 3422946822 50331648 0 0 0 0 0 1006632960 4161078533 4285887861 4286611584 4286611584 4286611584 4286611584 4285887861 4278190080 1023410176 0 0 0 0 0 0 0 2214987270 4278190080 4284045657 4285690482 4285690482 4284045657 4161078533 2214987270 0 0 0 0 0 0 0 0 0 1006632960 3422946822 4043572228 4043572228 3422946822 1023410176 0 0 0 0 0 0 0 0 0 0 0 33554432 0 0 50331648 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: 0@0! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:40'!
radioButtonUnselectedForm
	^ self form16x16FromContents: self radioButtonUnselectedFormContents ! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/27/2010 15:23'!
windowMaximizeInactiveFormContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:52'!
windowMenuFormContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 352321536 3556769792 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 3556769792 352321536 0 0 0 0 0 0 0 352321536 3556769792 4278190080 4278190080 4278190080 4278190080 3556769792 352321536 0 0 0 0 0 0 0 0 0 352321536 3556769792 4278190080 4278190080 3556769792 352321536 0 0 0 0 0 0 0 0 0 0 0 369098752 3556769792 3556769792 352321536 0 0 0 0 0 0 0 0 0 0 0 0 0 369098752 352321536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/27/2010 15:23'!
windowMinimizeInactiveFormContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 0 0 0 0 0 0 0 0 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:40'!
menuPinForm
	^self form16x16FromContents: self menuPinFormContents ! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:26'!
checkboxUnselectedFormContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:41'!
windowMaximizeInactiveForm
	^ self form16x16FromContents: self windowMaximizeInactiveFormContents ! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:07'!
windowMaximizeFormContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/27/2010 15:23'!
windowCloseInactiveFromContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 176193664 0 0 0 0 0 0 0 0 176193664 3883958400 4085284992 243302528 0 243302528 2927657088 3867181184 0 0 0 0 0 0 0 0 411074688 3682631808 4269834368 3766517888 679049593 3766517888 4269834368 4286611584 343965824 0 0 0 0 0 0 0 0 360282489 3766517888 4152328063 4219436927 4152393856 3766517888 360282489 0 0 0 0 0 0 0 0 0 0 679049593 4219436927 4269834368 4219436927 679049593 0 0 0 0 0 0 0 0 0 0 360282489 3766517888 4152393856 4219436927 4152328063 3766517888 360282489 0 0 0 0 0 0 0 0 343965824 4286611584 4253057152 3766517888 679049593 3766517888 4152328063 3732963456 411074688 0 0 0 0 0 0 0 0 3900735616 2927657088 243302528 0 243302528 4286611584 1769897598 176193664 0 0 0 0 0 0 0 0 176193664 75530368 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:41'!
windowCloseInactiveForm
	^ self form16x16FromContents: self windowCloseInactiveFromContents ! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:39'!
form16x16FromContents: aByteArray 
	^ Form
	extent: 16@16
	depth: 32
	fromArray: aByteArray 
	offset: 0@0! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:41'!
windowMaximizeForm
	^ self form16x16FromContents: self windowMaximizeFormContents ! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:42'!
windowMinimizeInactiveForm
	^self form16x16FromContents: self windowMinimizeInactiveFormContents ! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:52'!
windowMenuForm
	^self form16x16FromContents: self windowMenuFormContents ! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:22'!
checkboxMarkerForm
	"Answer a new radio button marker form. We make it empty because we already have the selected radio button take care of the state."

	^Form extent: 12@12 depth: 32! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/27/2010 15:14'!
radioUnselectedForm
	^ Form fromBinaryStream: ( Base64MimeConverter mimeDecodeToBytes: self radioUnselectedFormContents readStream)
 ! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/27/2010 15:14'!
radioSelectedForm
	^ Form fromBinaryStream: ( Base64MimeConverter mimeDecodeToBytes: self radioSelectedFormContents readStream)
 ! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 14:10'!
checkboxSelectedForm
	^ self form16x16FromContents: self checkboxSelectedFormContents 
! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 09:11'!
radioButtonMarkerForm
	"Answer a new radio button marker form. We make it empty because we already have the selected radio button take care of the state."

	^Form extent: 12@12 depth: 32! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:41'!
windowMenuInactiveForm
	^self form16x16FromContents: self windowMenuInactiveFormContents ! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:09'!
windowMinimizeFormContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 0 0 0 0 0 0 0 0 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!Pharo3UIThemeIcons class methodsFor: 'icons' stamp: 'FernandoOlivero 10/28/2010 13:27'!
radioButtonUnselectedFormContents
	^#( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 50331648 0 0 50331648 0 0 0 0 0 0 0 0 0 0 0 1023410176 3238002688 3909091328 3909091328 3238002688 1023410176 0 0 0 0 0 0 0 0 0 2097152000 3976200192 1275068416 452984832 452984832 1275068416 3976200192 872415232 0 0 0 0 0 0 0 1023410176 4278190080 335544320 0 0 0 0 335544320 4278190080 1023410176 0 0 0 0 0 50331648 3238002688 1275068416 0 0 0 0 0 0 1275068416 3238002688 50331648 0 0 0 0 0 3909091328 452984832 0 0 0 0 0 0 452984832 3909091328 0 0 0 0 0 0 3909091328 452984832 0 0 0 0 0 0 452984832 3909091328 0 0 0 0 0 33554432 3238002688 1275068416 0 0 0 0 0 0 1275068416 3238002688 50331648 0 0 0 0 0 1006632960 3992977408 335544320 0 0 0 0 335544320 4278190080 1023410176 0 0 0 0 0 0 0 2097152000 4278190080 1275068416 452984832 452984832 1275068416 3976200192 2097152000 0 0 0 0 0 0 0 0 0 1006632960 3238002688 3909091328 3909091328 3238002688 1023410176 0 0 0 0 0 0 0 0 0 0 0 33554432 0 0 50331648 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!PharoChangesCondenser commentStamp: 'CamilloBruni 2/21/2014 22:29'!
I create a new more compact changes files with a single version of each method in the image.!
!PharoChangesCondenser methodsFor: 'helper' stamp: 'CamilloBruni 2/21/2014 23:40'!
nextChunkDo: aBlock
	stream nextChunkPut: (String streamContents: aBlock)! !

!PharoChangesCondenser methodsFor: 'private - 1 writing' stamp: 'CamilloBruni 2/23/2014 21:39'!
stampOfMethod: aMethod
	"Optimized version of: aMethod stamp
	Reuse the same stream instead of reopening a new stream on each read"
	^ aMethod timeStampFromFile: (self sourceStreamOfMethod: aMethod).! !

!PharoChangesCondenser methodsFor: 'private - 1 writing' stamp: 'CamilloBruni 2/23/2014 21:52'!
sourceCodeOfMethod: aMethod
	"Optimized version of: aMethod sourceCode
	Reuse the same stream instead of reopening a new stream on each read"
	^ (self sourceStreamOfMethod: aMethod) nextChunk! !

!PharoChangesCondenser methodsFor: 'private - 2 swapping' stamp: 'CamilloBruni 2/22/2014 00:26'!
swapSourcePointers
	job 
		title: 'Swapping source pointers';
		currentValue: 0.
	
	Smalltalk allClassesAndTraitsDo: [ :classOrTrait |
		job increment.
		self swapSourcePointerOfClassOrTrait: classOrTrait ]
	! !

!PharoChangesCondenser methodsFor: 'accessing' stamp: 'CamilloBruni 2/23/2014 20:36'!
temporaryFile
	^ (Smalltalk changesFile, 'new') nextVersion.! !

!PharoChangesCondenser methodsFor: 'private' stamp: 'Camillobruni 4/28/2014 16:51'!
condenseClassOrTrait: classOrTrait
	self writeClassComment: classOrTrait.
	
	classOrTrait theNonMetaClass methodsDo: [ :method |
		(self shouldCondenseMethod: method)
			ifTrue: [ self writeMethodSource: method ]].
	
	classOrTrait theMetaClass methodsDo: [ :method |
		(self shouldCondenseMethod: method)
			ifTrue: [ self writeMethodSource: method ]]! !

!PharoChangesCondenser methodsFor: 'private - 2 swapping' stamp: 'MarcusDenker 4/29/2014 10:56'!
swapSourcePointerOfClassOrTrait: classOrTrait

	self swapClassComment: classOrTrait.
	
	classOrTrait methodsDo: [ :method | 
		self swapSourcePointerOfMethod: method ].
	
	classOrTrait classSide methodsDo: [ :method | 
		self swapSourcePointerOfMethod: method ]! !

!PharoChangesCondenser methodsFor: 'private - 3 installing' stamp: 'CamilloBruni 2/23/2014 20:35'!
backupOldChanges
	| changesFile |
	
	changesFile := self originalFile.
	changesFile moveTo: (changesFile , 'bak') nextVersion.
	! !

!PharoChangesCondenser methodsFor: 'public' stamp: 'CamilloBruni 2/22/2014 00:14'!
condense
	job := [ 
		newChangesFile writeStreamDo: [ :aStream |
			stream := aStream.
			self basicCondense ]] asJob.
	
	job 
		title: 'Condensing Changes';
		max: Smalltalk classNames size + Smalltalk traitNames size;
		run.! !

!PharoChangesCondenser methodsFor: 'accessing' stamp: 'CamilloBruni 2/23/2014 20:32'!
fileIndex
	"Return the index into the SourceFiles:
	1: the .sources file
	2. the .changes file"
	^ 2! !

!PharoChangesCondenser methodsFor: 'initialization' stamp: 'CamilloBruni 2/23/2014 20:34'!
initialize
	self reset.! !

!PharoChangesCondenser methodsFor: 'private - 3 installing' stamp: 'CamilloBruni 2/23/2014 21:27'!
installNewChangesFile
	
	(SourceFiles at: self fileIndex) close.
	self updateQuitPosition.
	stream flush close.
	
	self backupOldChanges.
	
	self originalFile ensureDelete.
	newChangesFile moveTo: self originalFile .
	
	Smalltalk openSourceFiles.! !

!PharoChangesCondenser methodsFor: 'private - 2 swapping' stamp: 'CamilloBruni 2/23/2014 20:30'!
swapClassComment: classOrTrait
	remoteStringMap 
		at: classOrTrait
		ifPresent: [ :remoteString | 
			classOrTrait organization comment: remoteString ]! !

!PharoChangesCondenser methodsFor: 'helper' stamp: 'CamilloBruni 2/21/2014 23:44'!
nextCommentChunkDo: aBlock
	stream cr; nextPut: $!!.
	self nextChunkDo: aBlock.
	stream cr! !

!PharoChangesCondenser methodsFor: 'private - testing' stamp: 'CamilloBruni 2/23/2014 20:27'!
shouldCondenseMethod: aMethod
	"Only write methods with changes in the current file (not .sources)"
	^ aMethod hasSourceCodeInChangesFile! !

!PharoChangesCondenser methodsFor: 'private - 1 writing' stamp: 'CamilloBruni 2/23/2014 21:40'!
sourceStreamOfMethod: aMethod
	| aStream |
	aStream := sourceStreams at: aMethod fileIndex.
	aStream position: aMethod filePosition.
	^ aStream ! !

!PharoChangesCondenser methodsFor: 'private' stamp: 'CamilloBruni 2/21/2014 23:25'!
condenseClassesAndTraits 
	Smalltalk allClassesAndTraitsDo: [ :classOrTrait | 
		self condenseClassOrTrait: classOrTrait	]
	! !

!PharoChangesCondenser methodsFor: 'initialization' stamp: 'CamilloBruni 2/23/2014 21:40'!
reset.
	remoteStringMap := IdentityDictionary new.
	newChangesFile := self temporaryFile.
	
	"Keep a copy of the source streams for performance"
	sourceStreams := Array
			with: PharoFilesOpener default sourcesFileOrNil
			with: PharoFilesOpener default changesFileOrNil! !

!PharoChangesCondenser methodsFor: 'private - 1 writing' stamp: 'MarcusDenker 7/5/2014 18:58'!
writeClassComment: aClass
	| organizer commentRemoteString stamp |
	
	organizer := aClass organization.
	commentRemoteString := organizer commentRemoteString.
	
	(commentRemoteString isNil or: [ commentRemoteString sourceFileNumber = 1 ])
		ifTrue: [ ^ self ].
		
	self nextCommentChunkDo: [ :strm |
		strm 
			nextPutAll: aClass name;
			nextPutAll: ' commentStamp: '.
		stamp := organizer commentStamp 
			ifNil: ['<historical>'].
		stamp storeOn: strm ].
	
	self 
		writeRemoteString: organizer classComment
		for: aClass! !

!PharoChangesCondenser methodsFor: 'private' stamp: 'CamilloBruni 2/23/2014 20:33'!
basicCondense
	self
		condenseClassesAndTraits;
		swapSourcePointers;
		installNewChangesFile;
		reset! !

!PharoChangesCondenser methodsFor: 'private - 1 writing' stamp: 'Camillobruni 4/28/2014 16:44'!
writeMethodSource: aMethod
	
	self nextCommentChunkDo: [ :strm |
		strm 
			nextPutAll: aMethod methodClass name;
			nextPutAll: ' methodsFor: ';
			store: aMethod category asString;
			nextPutAll: ' stamp: ';
			store: (self stampOfMethod: aMethod) ].
	
	self
		writeRemoteString: (self sourceCodeOfMethod: aMethod)
		for: aMethod.
		
	stream nextPutAll: ' !!'; cr.! !

!PharoChangesCondenser methodsFor: 'private - 3 installing' stamp: 'CamilloBruni 2/23/2014 20:39'!
updateQuitPosition
	
	Smalltalk lastQuitLogPosition: stream position.! !

!PharoChangesCondenser methodsFor: 'private - 2 swapping' stamp: 'CamilloBruni 2/22/2014 00:36'!
swapSourcePointerOfMethod: method

	remoteStringMap at: method ifPresent: [ :remoteString |
		method setSourcePointer: remoteString sourcePointer ]! !

!PharoChangesCondenser methodsFor: 'accessing' stamp: 'CamilloBruni 2/23/2014 20:35'!
originalFile
	^ Smalltalk changesFile! !

!PharoChangesCondenser methodsFor: 'private - 1 writing' stamp: 'CamilloBruni 2/23/2014 20:30'!
writeRemoteString: aString	for: reference
	| remoteString |
	
	remoteString := RemoteString 
			newString: aString 
			onFileNumber: self fileIndex
			toFile: stream.
	
	remoteStringMap at: reference put: remoteString.
	^ remoteString! !

!PharoChangesCondenser class methodsFor: 'helper' stamp: 'CamilloBruni 2/22/2014 00:07'!
condense
	^ self new
		condense! !

!PharoClassInstaller commentStamp: '<historical>'!
I am the default class installer.
I install a new or modified class in the globals dictionary and announce this change publicly.

The default environment can be changed to any SystemDictionary.

Example:
	PharoClassInstaller example!
!PharoClassInstaller methodsFor: 'notifications' stamp: 'MartinDias 6/28/2013 12:50'!
classAdded: aClass inCategory: aCategory
	" Install the new class in the system "
	environment at: aClass name put: aClass.
	environment flushClassNameCache.
	
	" Update the system's organization "
	environment organization classify: aClass name under: aCategory.
	aClass environment: environment.
	
	self systemAnnouncer classAdded: aClass inCategory: aCategory.
	" Inform superclass of new subclass "
	aClass superclass addSubclass: aClass.! !

!PharoClassInstaller methodsFor: 'migrating' stamp: 'CamilleTeruel 12/18/2013 13:56'!
fixClassBindings: newClass
	methodUpdateStrategy updateClassLiteralKeysIn: newClass! !

!PharoClassInstaller methodsFor: 'migrating' stamp: 'ToonVerwaest 3/22/2011 18:54'!
shallowCopyMethodsFrom: oldClass to: newClass using: classModification
	newClass methodDict: oldClass methodDict! !

!PharoClassInstaller methodsFor: 'notifications' stamp: 'MartinDias 1/28/2014 15:18'!
slotsChangedFrom: oldClass to: newClass by: classModification
	
	self
		classDefinitionChangedFrom: oldClass 
		to: newClass 
		by: classModification! !

!PharoClassInstaller methodsFor: 'private' stamp: 'MartinDias 4/26/2013 17:07'!
systemAnnouncer
	^ SystemAnnouncer uniqueInstance! !

!PharoClassInstaller methodsFor: 'accessing' stamp: 'ToonVerwaest 3/22/2011 17:03'!
classAt: aName ifAbsent: aBlock
	^ (environment at: aName ifAbsent: aBlock)
		ifNil: aBlock! !

!PharoClassInstaller methodsFor: 'notifications' stamp: 'MartinDias 1/28/2014 16:13'!
classDefinitionChangedFrom: oldClass to: newClass by: classModification
	
	self
		copyMethodsFrom: oldClass to: newClass using: classModification;
		basicClassDefinitionChangedFrom: oldClass to: newClass using: classModification;
		fixClassBindings: newClass
	! !

!PharoClassInstaller methodsFor: 'accessing' stamp: 'CamilloBruni 6/28/2013 14:03'!
environment
	^ environment! !

!PharoClassInstaller methodsFor: 'notifications' stamp: 'MartinDias 1/28/2014 16:13'!
shallowClassDefinitionChangedFrom: oldClass to: newClass by: classModification
	" Copy over the method organization "
	" Update the superclass links "
	self 
		shallowCopyMethodsFrom: oldClass to: newClass using: classModification;
		basicClassDefinitionChangedFrom: oldClass to: newClass using: classModification! !

!PharoClassInstaller methodsFor: 'initialization' stamp: 'MartinDias 7/30/2012 00:03'!
initialize
	super initialize.
	environment := nil environment.
	methodUpdateStrategy := MethodRecompileStrategy new.! !

!PharoClassInstaller methodsFor: 'notifications' stamp: 'MartinDias 7/1/2013 15:56'!
formatChangedFrom: oldClass to: newClass by: classModification

	self 
		classDefinitionChangedFrom: oldClass 
		to: newClass 
		by: classModification
	! !

!PharoClassInstaller methodsFor: 'notifications' stamp: 'EstebanLorenzano 4/11/2014 15:52'!
basicClassDefinitionChangedFrom: oldClass to: newClass using: classModification

	" Copy over the trait composition "
	self copyTraitCompositionFrom: oldClass to: newClass.		
	" Copy over the method organization "
	newClass organization: oldClass organization.
	" Update the subclass links "
	oldClass superclass == newClass superclass ifFalse: [ 
		oldClass superclass removeSubclass: oldClass.
		newClass superclass addSubclass: newClass ].
	" Announce if necessary "
	classModification isPropagation ifFalse: [ 
		self systemAnnouncer classDefinitionChangedFrom: oldClass to: newClass ].! !

!PharoClassInstaller methodsFor: 'notifications' stamp: 'MarcusDenker 3/11/2015 07:53'!
sharedVariableOrSharedPoolChangedFrom: oldClass to: newClass by: classModification 

	self 
		classDefinitionChangedFrom: oldClass 
		to: newClass 
		by: classModification.
	
	"for every class var in the classModification: if this exists in oldClass, copy value over"
	classModification classVariables do: [ :each | 
		(oldClass hasClassVarNamed: each name) ifTrue: [
			each write: (oldClass classVariableNamed: each name) value  ]].
	
	"Update subclasses. No need to propagate the modification to them."
	oldClass subclasses do: [ :each |
		each superclass: newClass.
		newClass addSubclass: each.
		each layout slotScope ifNotEmpty: [ :scope | scope parentScope: newClass layout slotScope ] ].! !

!PharoClassInstaller methodsFor: 'accessing' stamp: 'ToonVerwaest 3/22/2011 16:55'!
environment: anEnvironment
	environment := anEnvironment! !

!PharoClassInstaller methodsFor: 'migrating' stamp: 'maxmattone 3/5/2015 14:30'!
updateClass: oldClass to: newClass
	newClass layout compactClassIndex: oldClass layout compactClassIndex.
	newClass updateInstancesFrom: oldClass.! !

!PharoClassInstaller methodsFor: 'migrating' stamp: 'MartinDias 7/1/2013 15:58'!
migrateClasses: old to: new using: anInstanceModification
	instanceModification := anInstanceModification.
	old ifEmpty:  [ ^ self ].
	[
		1 to: old size do: [ :index |
			self updateClass: (old at: index) to: (new at: index)].
		old elementsForwardIdentityTo: new.
		" Garbage collect away the zombie instances left behind in garbage memory in #updateInstancesFrom: "
		" If we don't clean up this garbage, a second update would revive them with a wrong layout!! "
		" (newClass rather than oldClass, since they are now both newClass) "
		Smalltalk garbageCollect.
	] valueUnpreemptively! !

!PharoClassInstaller methodsFor: 'notifications' stamp: 'MartinDias 7/1/2013 15:55'!
superclassChangedFrom: oldClass to: newClass by: classModification

	self 
		shallowClassDefinitionChangedFrom: oldClass
		to: newClass
		by: classModification ! !

!PharoClassInstaller methodsFor: 'migrating' stamp: 'MartinDias 7/30/2012 00:08'!
copyMethodsFrom: oldClass to: newClass using: classModification
	methodUpdateStrategy
		transform: oldClass
		to: newClass
		using: classModification methodModification! !

!PharoClassInstaller methodsFor: 'notifications' stamp: 'SebastianTleye 8/26/2013 16:23'!
recategorize: aClass to: newCategory
	| oldCategory |
	
	oldCategory := aClass category.
	oldCategory asSymbol == newCategory asSymbol
		ifTrue: [ ^ self ].
		
	environment organization 
		classify: aClass name 
		under: newCategory.
		
	self systemAnnouncer 
		class: aClass 
		recategorizedFrom: oldCategory 
		to: newCategory! !

!PharoClassInstaller class methodsFor: 'example' stamp: 'MartinDias 7/1/2013 16:10'!
example
	^ PharoClassInstaller make: [ :aSlotClassBuilder |
		aSlotClassBuilder
			superclass: Object;
			name: #MyClass;
			slots: #(varA varB);
			category: 'My-Category' ].! !

!PharoClassInstaller class methodsFor: 'testing' stamp: 'MartinDias 11/6/2012 11:32'!
validateClassName: aString
	"Validate if a string can be the name of a new class. Raise an error if not."
	
	self new builder name: aString.! !

!PharoCommandLineHandler commentStamp: '<historical>'!
Usage: [--no-preferences|--preference-file=<FILE>][<subcommand>] [--help] [--copyright] [--version] [--list] [ --no-quit ]
	--help       print this help message
	--copyright  print the copyrights
	--version    print the version for the image and the vm
	--list       list a description of all active command line handlers
	--no-quit    keep the image running without activating any other command line handler
	<subcommand> a valid subcommand in --list
	
	Preference File Modification:
	--preference-file   load the preferences from the given <FILE>
	--no-default-preferences    do not load any preferences from the default locations
	
Documentation:
A PharoCommandLineHandler handles default command line arguments and options.
The PharoCommandLineHandler is activated before all other handlers. 
It first checks if another handler is available. If so it will activate the found handler.!
!PharoCommandLineHandler methodsFor: 'private - preferences' stamp: 'CamilloBruni 9/16/2013 01:37'!
changePreferences	
	| preferenceFile |
	
	self isOmittingPreferences
		ifTrue: [ 
			commandLine := commandLine copySubcommand.
			^ self ].
		
	preferenceFile := (self optionAt: 'preferences-file') asFileReference.
	commandLine := commandLine copySubcommand.
	
	StartupPreferencesLoader default load: { preferenceFile }.! !

!PharoCommandLineHandler methodsFor: 'commands' stamp: 'CamilloBruni 5/26/2013 14:08'!
default
	Smalltalk isHeadless 
		ifFalse: [ ^ self noQuit ].
	
	^ super default! !

!PharoCommandLineHandler methodsFor: 'private - preferences' stamp: 'CamilloBruni 9/16/2013 01:15'!
isChangingPreferences

	^ self isOverridingPreferences or: [ self isOmittingPreferences ]! !

!PharoCommandLineHandler methodsFor: 'private - preferences' stamp: 'SeanDeNigris 10/4/2013 13:15'!
isOmittingPreferences

	^ self hasOption: 'no-default-preferences'! !

!PharoCommandLineHandler methodsFor: 'private - preferences' stamp: 'CamilloBruni 9/16/2013 01:36'!
isOverridingPreferences

	^ self hasOption: 'preferences-file'! !

!PharoCommandLineHandler methodsFor: 'activation' stamp: 'CamilloBruni 9/16/2013 01:23'!
activate

	self isChangingPreferences
		ifTrue: [ self changePreferences ]
		ifFalse: [ self runPreferences ].
		
	^ super activate.! !

!PharoCommandLineHandler methodsFor: 'private - preferences' stamp: 'CamilloBruni 9/16/2013 01:18'!
runPreferences

	StartupPreferencesLoader default loadFromDefaultLocations! !

!PharoCommandLineHandler class methodsFor: 'handler selection' stamp: 'EstebanLorenzano 5/23/2013 15:15'!
isResponsibleFor: aCommandLine
	"I do not match ever, because my activation is manual"
	^ true! !

!PharoCommandLineHandler class methodsFor: 'instance creation' stamp: 'PavelKrivanek 7/13/2014 13:44'!
activateWith: aCommandLine

	
	UserManager default canRunStartupScript ifFalse: [ ^ self ].
	"Make sure that the PharoCommandLineHandler starts at the top of the stack in the main UI thread."
	UIManager default defer:  [ 
		super activateWith: aCommandLine ]! !

!PharoCommandLineHandler class methodsFor: 'accessing' stamp: 'CamilloBruni 5/31/2013 11:32'!
priority 
	"Highest priority"
	^ Float infinity! !

!PharoCommandLineHandler class methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/23/2013 14:28'!
description
	^ 'responsible for the default options and activating other commands'! !

!PharoCommonTools commentStamp: 'NicolaiHess 12/18/2014 09:15'!
A PharoCommonTools is a ToolRegistry that knows about common tools that may be replaced by other packages. It manages a list of the recently registered tools and provides settings for reregistering to a former registered tool.
!
!PharoCommonTools methodsFor: 'tools' stamp: 'NicolaiHess 12/18/2014 09:18'!
debuggerTool: aTool
	^ self register: aTool as: #debugger! !

!PharoCommonTools methodsFor: 'tools' stamp: 'NicolaiHess 12/17/2014 14:30'!
browserTool: aTool
	^ self register: aTool as: #browser! !

!PharoCommonTools methodsFor: 'tools' stamp: 'NicolaiHess 12/17/2014 14:30'!
inspectorTool: aTool
	^ self register: aTool as: #inspector! !

!PharoCommonTools methodsFor: 'registration' stamp: 'NicolaiHess 12/17/2014 14:32'!
recentBrowserTools
	^ self recentToolsFor: #browser! !

!PharoCommonTools methodsFor: 'registration' stamp: 'NicolaiHess 12/18/2014 09:08'!
recentFileListTools
	^ self recentToolsFor: #fileList! !

!PharoCommonTools methodsFor: 'tools' stamp: 'NicolaiHess 12/17/2014 14:30'!
workspaceTool: aTool
	^ self register: aTool as: #workspace! !

!PharoCommonTools methodsFor: 'registration' stamp: 'NicolaiHess 12/18/2014 09:11'!
recentDebuggerTools
	^ self recentToolsFor: #debugger! !

!PharoCommonTools methodsFor: 'tools' stamp: 'NicolaiHess 12/17/2014 14:24'!
inspectorTool
	^ self inspector! !

!PharoCommonTools methodsFor: 'tools' stamp: 'NicolaiHess 12/18/2014 09:19'!
messageListTool: aTool
	^ self register: aTool as: #messageList! !

!PharoCommonTools methodsFor: 'initialization' stamp: 'NicolaiHess 12/17/2014 15:28'!
initialize
	recentTools := Dictionary new.
	super initialize.
	! !

!PharoCommonTools methodsFor: 'tools' stamp: 'NicolaiHess 12/18/2014 09:17'!
messageListTool
	^ self messageList! !

!PharoCommonTools methodsFor: 'registration' stamp: 'NicolaiHess 12/17/2014 14:32'!
recentWorkspaceTools
	^ self recentToolsFor: #workspace! !

!PharoCommonTools methodsFor: 'registration' stamp: 'NicolaiHess 3/9/2015 00:19'!
register: anTool as: aNameSelector
	| usedToolSet |
	anTool ifNil:[ ^ self].
	super register: anTool as: aNameSelector.
	usedToolSet := recentTools at: aNameSelector ifAbsentPut: [ Set new ].
	usedToolSet add: anTool! !

!PharoCommonTools methodsFor: 'tools' stamp: 'NicolaiHess 12/18/2014 09:18'!
changeSorterTool: aTool
	^ self register: aTool as: #changeSorter! !

!PharoCommonTools methodsFor: 'registration' stamp: 'NicolaiHess 12/17/2014 14:31'!
recentInspectorTools
	^ self recentToolsFor: #inspector! !

!PharoCommonTools methodsFor: 'registration' stamp: 'NicolaiHess 12/18/2014 09:16'!
recentMessageListTools
	^ self recentToolsFor: #messageList! !

!PharoCommonTools methodsFor: 'tools' stamp: 'NicolaiHess 12/17/2014 14:24'!
debuggerTool
	^ self debugger! !

!PharoCommonTools methodsFor: 'registration' stamp: 'NicolaiHess 12/18/2014 09:18'!
recentChangeSorterTools
	^ self recentToolsFor: #changeSorter! !

!PharoCommonTools methodsFor: 'cleanup' stamp: 'MarcusDenker 3/13/2015 10:44'!
cleanUp
	recentTools keysAndValuesDo:[:name :toolSet|
		toolSet copy do:[:tool | tool isObsolete ifTrue:[ toolSet remove: tool]]]! !

!PharoCommonTools methodsFor: 'registration' stamp: 'MarcusDenker 3/13/2015 09:08'!
recentToolsFor: aName
	^ (recentTools at: aName ifAbsent: [ {} ]) reject: [ :tool | tool isObsolete ]! !

!PharoCommonTools methodsFor: 'tools' stamp: 'NicolaiHess 12/18/2014 09:17'!
fileListTool
	^ self fileList! !

!PharoCommonTools methodsFor: 'registration' stamp: 'NicolaiHess 12/18/2014 09:16'!
recentVersionBrowserTools
	^ self recentToolsFor: #versionBrowser! !

!PharoCommonTools methodsFor: 'tools' stamp: 'NicolaiHess 12/17/2014 14:24'!
browserTool
	^ self browser! !

!PharoCommonTools methodsFor: 'tools' stamp: 'NicolaiHess 12/18/2014 09:18'!
fileListTool: aTool
	^ self register: aTool as: #fileList! !

!PharoCommonTools methodsFor: 'tools' stamp: 'NicolaiHess 12/18/2014 09:19'!
versionBrowserTool: aTool
	^ self register: aTool as: #versionBrowser! !

!PharoCommonTools methodsFor: 'tools' stamp: 'NicolaiHess 12/17/2014 14:25'!
workspaceTool
	^ self workspace! !

!PharoCommonTools methodsFor: 'tools' stamp: 'NicolaiHess 12/18/2014 09:24'!
changeSorterTool
	^ self changeSorter! !

!PharoCommonTools methodsFor: 'tools' stamp: 'NicolaiHess 12/18/2014 09:17'!
versionBrowserTool
	^ self versionBrowser! !

!PharoCommonTools class methodsFor: 'cleanUp' stamp: 'NicolaiHess 12/18/2014 09:58'!
shutDown: aboutToQuit
	self allInstancesDo:#cleanUp! !

!PharoCommonTools class methodsFor: 'initialization' stamp: 'NicolaiHess 12/18/2014 09:53'!
initialize
	Smalltalk addToShutDownList: self.! !

!PharoCommonTools class methodsFor: 'settings' stamp: 'NicolaiHess 1/30/2015 00:23'!
settingsOn: aBuilder
	<systemsettings>
	Smalltalk tools class == self
		ifFalse: [ ^ self ].
	(aBuilder group: #pharoTools)
		parent: #pharoSystem;
		label: 'Recent Tools';
		description: 'Recently registered Tools';
		with: [ 
					(aBuilder pickOne: #browserTool)
						target: Smalltalk;
						targetSelector: #tools;
						getSelector: #browserTool;
						setSelector: #browserTool:;
						label: 'Systembrowser';
						domainValues: Smalltalk tools recentBrowserTools ];
		with: [ 
					(aBuilder pickOne: #inspectorTool)
						target: Smalltalk;
						targetSelector: #tools;
						getSelector: #inspectorTool;
						setSelector: #inspectorTool:;
						label: 'Inspector';
						domainValues: Smalltalk tools recentInspectorTools ];
		with: [ 
					(aBuilder pickOne: #workspaceTool)
						target: Smalltalk;
						targetSelector: #tools;
						getSelector: #workspaceTool;
						setSelector: #workspaceTool:;
						label: 'Workspace';
						domainValues: Smalltalk tools recentWorkspaceTools ];
		with: [ 
					(aBuilder pickOne: #debuggerTool)
						target: Smalltalk;
						targetSelector: #tools;
						label: 'Debugger';
						domainValues: Smalltalk tools recentDebuggerTools ];
		with: [ 
					(aBuilder pickOne: #messageListTool)
						target: Smalltalk;
						targetSelector: #tools;
						label: 'Messagelist';
						domainValues: Smalltalk tools recentMessageListTools ];
		with: [ 
					(aBuilder pickOne: #versionBrowserTool)
						target: Smalltalk;
						targetSelector: #tools;
						label: 'Versionbrowser';
						domainValues: Smalltalk tools recentVersionBrowserTools ];
		with: [ 
					(aBuilder pickOne: #fileListTool)
						target: Smalltalk;
						targetSelector: #tools;
						label: 'Filelist';
						domainValues: Smalltalk tools recentFileListTools];
		with: [ 
					(aBuilder pickOne: #changeSorterTool)
						target: Smalltalk;
						targetSelector: #tools;
						label: 'Changesorter';
						domainValues: Smalltalk tools recentChangeSorterTools]! !

!PharoEnvironmentHelp commentStamp: 'AndreiChis 3/24/2015 10:45'!
This is introductory help for the Pharo environment and tools. 

!! Keyboard Shortcuts

Pharo has a variety of useful keyboard shortcuts that help you navigate its environment without always using a mouse.

!!!! Browser Shortcuts

There are many keyboard shortcuts available in Pharo:

- A full list is available in the System Browser by clicking the window menu button (the triangle) at the top right of the browser title, and selecting the 'Shortcuts Description' menu item.  Alternatively you can evaluate (cmd-d) the following code now:

KMDescription new categories: #(NautilusGlobalShortcuts); openWithSpec.

- Shortcuts are typically multi-key combinations, where you hold a modifier key and press the listed secondary key. For example if something is listed as CMD-F, CMD-C you would press and hold the CMD key while typing  F and then C

- The modifier key varies between platforms:
 - Windows = ALT
 - Mac/OSX = CMD
 - Linux = CTRL

!!!! Spotter/Global search

Similar to the Spotlight search on OSX, or the Windows Search charm - Pharo has a global code search tool that is activated using:  Shift+Enter

This search tool shows a popup window on the center of the screen where you can incrementally search for classes, packages, symbols,  pragmas, files, folders and many other types of data.  As you type a search query  all available searches are performed at the same time and results are displayed as they are discovered and grouped based on the type of the search.

You can cursor/keyboard navigate through the results, or press enter to spawn a new tool to examine the selected result.
The following shortcuts are available:

	Ctrl+Arrow_right dives in and restricts the available types of searches only to the selected element.
	Ctrl+Shift+Arrow_right dives in and shows all the rearch results from a category.
	Ctrl+Arrow_left dives out to the previous search
	Ctrl+p toggles the preview pane
	Enter  spawns a new tool to examine the selected result
	Ctrl+Shift+Arrow_down/Ctrl+Shift+Arrow_down navigatew through different types of searches
	Shift highlights all butons from the UI (only works with newer VMs)

!!!! Visual Exploration

A useful way of discovering how things work in Pharo, is to point your mouse cursor at something on the screen (e.g. a browser button) and invoke a visual Halo selection by pressing: 

  Alt+Shift + left mouse click

If you continue clicking the left mouse button (while holding Alt+Shift), the halo will expand it's selection to the current item's parent. This is useful for traversing the lineage of graphical Morph's to see what contains what.

The halo has a series of icons, which if you hover over them will give you some balloon help about their operation. For exploring, the spanner icon is useful for letting you inspect or browse the current item to locate where the actual code is implemented.

To remove the halo,  simply click anywhere outside of the current halo.

It is possible to directly explore a visual object and bypass using the halo mechanism by pressing:

  Ctrl+Shift + left mouse click

This will give you a menu for the current item with options to inspect, debug etc.

!! Browsing and Navigating Code

Finding and navigating through code in Pharo is an important part of developing programs in Smalltalk.

!!!! System Browser (Nautilus)

The System Browser (available in the desktop World menu), is the primary way of viewing your source code. This browser framework has been rewritten in Pharo and is often referred to as Nautilus (see the other top level help item for more technical details)

!!!!!! Showing Hierarchies

Nautilus defaults to a simple 'Flat' display of the list of classes that are in the currently selected package (far left). If you want to see the hierarchy of a particular class, first select it and then press (toggle) the 'Flat' button, to show show its 'Hierarchy'. Pressing this button again will toggle back to the 'Flat' model.

!!!!!! Browser History

The browser records the history of methods and classes you have visited similar to a Web Browser. The dropdown list in the middle right of the panes (above the lower text pane) shows this history, and clicking on one of its items will navigate to that item. This is convenient if you have clicked on a different package, or navigated to superclass and want to return back to where you were. 

!!!!!! Customising

The system browser can also be configured with a different title as well as optional plugins. These are all available in the window dropdown menu in the top right of the title bar (normally a small triangle).

!!!! Spotter

Use the Shift+Enter global keystroke to activate a popup window that lets you incrementally search for methods, classes, packages, pragmas, files, folders and many other types of data.

!!!! Finder 

The code Finder browswer is available from the World | Tools menu. The Finder lets you enter some general text in top edit field and then categorize it as either text, or language construct in the dropdown list to refine your search. There are more detailed instructions in the bottom pane of the browser detailing the different options.

!!!! Workspace

In any workspace you can type or select any text and then perform an 'code search' (context menu item) that will look for matching senders, implementors, references or method source.

!! Icons

There are many icons that are visible in the envionment, each with different meanings.

!!!! General

An orange smudge in the top right of any editable text field indicatest that the field has been modified and should be saved with CMD+S.

!!!! Class Pane

In the System Browser class pane, you will see the following icons appear next to specific types of class objects:

- Red exclamation mark: a missing class comment. The pharo team reccommend that all classes should describe their intent with a comment. 
- Gray dot: a TestCase 
- Yellow Lightening bolt: an Exception 
- 3 Coloured Balls: a Collection 
- Blue Speech bubble: an Announcement 
- Blue Paragraph symbol: a String 
- Gray Epsilon symbol: a Magniture 
- Blue Matrix box: a graphcial Morph 
- Purple Ball with T: a Trait

!!!! Protocol Pane

In the System Browser protocol pane, you will see the following icons appear next to specific types of protocol objects:

- Yellow diamond: initialisation methods
- Red Square: private methods

!!!! Method Pane

In the System Browser methods pane, you will see the following icons appear next to specific types of method objects:

- Green Up Arrow: indicates this method overrides a method in a super class
- Green Down Arrow: indicates this method is overriden in a subclass

!!!! Source Pane

In the System Browser lower code source pane, you will see the following icons appear which have the following meaning:

- Orange Smudge top right: the source has changed and should be saved
- Yellow Stripe right margin: a long or complicated method that needs refactoring
- Yellow Padlock top right: when locked, indicates the current method source will be displayed stacked with other locked methods in the source pane

!! Getting More Help

If you need more detailed help, here are some additional places to look.
!!!! Pharo Tutorial

Try using the Pharo Smalltalk tutorial by evaluating (CMD+D) the code below: 
	PharoTutorial go.

!!!! Online Resources

You can find more information about Pharo by visiting: 
	http://www.pharo.org

In particular, you may also be interested in:

- Joining discussions and getting help at: http://pharo.org/community 
- The Pharo By Example book (available as a free PDF): http://www.pharobyexample.org
- Browsing the online documentation: http://www.pharo.org/documentation
- Reporting problems: http://pharo.org/contribute


!
!PharoEnvironmentHelp class methodsFor: 'help-text' stamp: 'TimMackinnon 8/9/2014 13:23'!
wikiStyleHelp
	<wikiStyleHelp: #'? Pharo Environment Help'>
	
	^ self comment! !

!PharoFilesOpener commentStamp: '<historical>'!
My role is to open the .sources and .changes files. My only public methods are in the 'public' protocol. The most important method is #checkAndOpenSourcesAndChanges.!
!PharoFilesOpener methodsFor: 'messages' stamp: 'DamienCassou 8/15/2013 11:28'!
badContentMsg
	^ '&fileRef
has been injured by an unpacking utility.  Crs were changed to CrLfs.
Please set the preferences in your decompressing program to 
"do not convert text files" and unpack the system again.'! !

!PharoFilesOpener methodsFor: 'public' stamp: 'DamienCassou 8/16/2013 10:34'!
setInformAboutReadOnlyChanges
	"Make sure the user is informed when the .changes file can not be written to."
	shouldInformAboutReadOnlyChanges := true! !

!PharoFilesOpener methodsFor: 'open sources' stamp: 'DamienCassou 8/15/2013 11:18'!
informCannotLocateSources
	| msg |
	msg := self cannotLocateMsg.
	Smalltalk os isMacOS
		ifTrue: [ 
			msg := msg
				,
					'
Make sure the sources file is not an Alias.' ].
	self inform: msg withSourceRef: self sourcesName! !

!PharoFilesOpener methodsFor: 'delegated' stamp: 'DamienCassou 8/15/2013 10:06'!
lastImagePath
	^ Smalltalk lastImagePath! !

!PharoFilesOpener methodsFor: 'public' stamp: 'MartinDias 11/4/2013 17:27'!
changesFileOrNil
	| changes |
	changes := self openChanges: self changesName.
	changes
		ifNil: [ 
			self informProblemInChanges: self cannotLocateMsg.
			^ nil ].
	(changes isReadOnly and: [ self shouldInformAboutReadOnlyChanges ])
		ifTrue: [ self informProblemInChanges: self cannotWriteMsg ].
	((changes next: 200) includesSubstring: String crlf)
		ifTrue: [ self informProblemInChanges: self badContentMsg ].
	^ changes! !

!PharoFilesOpener methodsFor: 'public' stamp: 'MarcusDenker 3/15/2015 17:50'!
sourcesFileOrNil
	| sources |
	sources := self openSources.
	^ (sources isNil or: [ sources atEnd ])
		ifTrue: [ 
			self informCannotLocateSources.
			nil ]
		ifFalse: [ sources ]! !

!PharoFilesOpener methodsFor: 'messages' stamp: 'DamienCassou 8/15/2013 10:16'!
cannotWriteMsg
	^ 'Pharo cannot write to &fileRef.

Please check that you have write permission for this file.

You won''t be able to save this image correctly until you fix this.'! !

!PharoFilesOpener methodsFor: 'open sources' stamp: 'SvenVanCaekenberghe 1/19/2014 19:08'!
openSources: fullSourcesName forImage: imagePath
	"Look in various places for a sources file, return an open stream to it."

	| sourcesFile sourcesName |
	sourcesFile := fullSourcesName asFileReference.
	sourcesName := sourcesFile basename.
	
	"look for the sources file or an alias to it in the VM's directory"
	OSPlatform current potentialLocationsOfSourcesFile do: [ :dir |
		self ignoreIfFail: [ 
			(sourcesFile := dir / sourcesName) exists
				ifTrue: [ sourcesFile readStream ifNotNil: [ :stream | ^ stream ] ] ] ].
			
	"look for the sources file or an alias to it in the image directory"
	(sourcesFile := imagePath asFileReference parent / sourcesName) exists
		ifTrue: [ ^ sourcesFile readStream ifNotNil: [ :stream | ^ stream ] ].
		
	"look for the sources in the current directory"
	(sourcesFile := sourcesName asFileReference) exists
		ifTrue: [ ^ sourcesFile readStream ifNotNil: [ :stream | ^ stream ] ].
		
	^ nil! !

!PharoFilesOpener methodsFor: 'user interaction' stamp: 'DamienCassou 8/15/2013 10:19'!
inform: msg withRef: fileRef
	self inform: (msg copyReplaceAll: '&fileRef' with: fileRef)! !

!PharoFilesOpener methodsFor: 'public' stamp: 'DamienCassou 8/16/2013 10:33'!
shouldInformAboutReadOnlyChanges
	"Answer true if and only if the user must be informed when the .changes file can not be written to."
	^ shouldInformAboutReadOnlyChanges ifNil: [ shouldInformAboutReadOnlyChanges := true ]! !

!PharoFilesOpener methodsFor: 'public' stamp: 'DamienCassou 8/16/2013 10:34'!
unsetInformAboutReadOnlyChanges
	"Make sure the user is *not* informed when the .changes file can not be written to."
	shouldInformAboutReadOnlyChanges := false! !

!PharoFilesOpener methodsFor: 'delegated' stamp: 'DamienCassou 8/15/2013 10:05'!
changesName
	^ Smalltalk changesName! !

!PharoFilesOpener methodsFor: 'user interaction' stamp: 'DamienCassou 8/15/2013 11:30'!
inform: msg withChangesRef: fileRef
	self inform: msg withRef: 'the changes file named ' , fileRef! !

!PharoFilesOpener methodsFor: 'user interaction' stamp: 'DamienCassou 8/15/2013 11:30'!
informProblemInChanges: msg
	self inform: msg withChangesRef: self changesName! !

!PharoFilesOpener methodsFor: 'delegated' stamp: 'DamienCassou 8/15/2013 10:07'!
sourcesName
	^ Smalltalk sourcesName! !

!PharoFilesOpener methodsFor: 'messages' stamp: 'DamienCassou 8/15/2013 10:15'!
cannotLocateMsg
	^ 'Pharo cannot locate &fileRef.

Please check that the file is named properly and is in the
same directory as this image.'! !

!PharoFilesOpener methodsFor: 'open changes' stamp: 'DamienCassou 9/13/2013 16:16'!
openChanges: changesPath
	| fileColocatedWithImage fileInWorkingDirectory locations |
	fileColocatedWithImage := changesPath asFileReference.
	fileInWorkingDirectory := FileSystem workingDirectory / fileColocatedWithImage basename.	"locations references all possible path where to search for the .changes file."
	locations := Array with: fileColocatedWithImage with: fileInWorkingDirectory.	
		
	"We first try to open a writeStream and, if we can't, we open a readStream. We have to use #ignoreIfFail: here because Pharo has no way to really tell us beforehand if opening a writeStream will work. Sending #isWritable is not enough because #isWritable does not check if the current user is the owner of the file or not."
	locations do: [ :file | self ignoreIfFail: [ ^ file writeStream ] ].
	locations do: [ :file | self ignoreIfFail: [ ^ file readStream ] ].
	^ nil! !

!PharoFilesOpener methodsFor: 'open sources' stamp: 'DamienCassou 8/15/2013 10:38'!
openSources
	^ self openSources: self sourcesName forImage: self lastImagePath! !

!PharoFilesOpener methodsFor: 'helper' stamp: 'DamienCassou 9/13/2013 16:16'!
ignoreIfFail: aBlock
	^ [ aBlock value ] ifError: [  ]! !

!PharoFilesOpener methodsFor: 'user interaction' stamp: 'DamienCassou 8/15/2013 11:30'!
inform: msg withSourceRef: fileRef
	self inform: msg withRef: 'the sources file named ' , fileRef! !

!PharoFilesOpener class methodsFor: 'singleton' stamp: 'DamienCassou 8/16/2013 10:04'!
reset
	Default := nil! !

!PharoFilesOpener class methodsFor: 'singleton' stamp: 'MarcusDenker 7/4/2014 11:00'!
default
	^ Default ifNil: [ Default := self new ]! !

!PharoShortcuts commentStamp: 'GuillermoPolito 8/10/2014 14:16'!
I am a class defining the current shortcuts of the system. My main purpose is to avoid the duplication of shortcut definition amongst basic tools and to allow to change the shortcuts from a single place.

Users may query me to know the key combinations used to accept or cancel an action, browse or inspect an object.

EXAMPLES

PharoShortcuts current browseShortcut => Cmd-B

ATTENTION - I'm not still finished. My #current method returns always a new instance of myself instead of a configured one.

NEXT Steps: Allow one to configure the shortcuts and to define several shortcut configurations via settings.!
!PharoShortcuts methodsFor: 'keymaps' stamp: 'GuillermoPolito 8/10/2014 13:59'!
doItShortcut

	^ $d command mac | $d ctrl win | $d ctrl unix! !

!PharoShortcuts methodsFor: 'keymaps' stamp: 'GuillermoPolito 8/10/2014 13:59'!
browseSendersShortcut

	^ $n command mac | $n ctrl win | $n ctrl unix! !

!PharoShortcuts methodsFor: 'keymaps' stamp: 'GuillermoPolito 8/10/2014 13:57'!
acceptShortcut

	^ $s ctrl win | $s ctrl unix | $s command mac! !

!PharoShortcuts methodsFor: 'keymaps' stamp: 'GuillermoPolito 8/10/2014 14:08'!
browseReferencesShortcut

	^ $b command shift mac | $b ctrl shift win | $b ctrl shift unix! !

!PharoShortcuts methodsFor: 'keymaps' stamp: 'RobertPergl 3/26/2015 17:29'!
formatCodeShortcut

	^ $f command shift mac | $f ctrl shift win | $f ctrl shift unix! !

!PharoShortcuts methodsFor: 'keymaps' stamp: 'GuillermoPolito 8/10/2014 14:07'!
removeShortcut

	^ $x command mac | $x ctrl win | $x ctrl unix! !

!PharoShortcuts methodsFor: 'keymaps' stamp: 'GuillermoPolito 8/10/2014 14:00'!
printItShortcut

	^ $p command mac | $p ctrl win | $p ctrl unix! !

!PharoShortcuts methodsFor: 'keymaps' stamp: 'GuillermoPolito 8/10/2014 14:12'!
cancelShortcut

	^ Character escape asKeyCombination! !

!PharoShortcuts methodsFor: 'keymaps' stamp: 'GuillermoPolito 8/10/2014 14:08'!
browseVersionsShortcut

	^ $v command mac | $v ctrl win | $v ctrl unix! !

!PharoShortcuts methodsFor: 'keymaps' stamp: 'GuillermoPolito 8/10/2014 13:59'!
browseImplementorsShortcut

	^ $m command mac | $m ctrl win | $m ctrl unix! !

!PharoShortcuts methodsFor: 'keymaps' stamp: 'GuillermoPolito 8/10/2014 13:58'!
browseShortcut

	^ $b command mac | $b ctrl win | $b ctrl unix! !

!PharoShortcuts methodsFor: 'keymaps' stamp: 'GuillermoPolito 8/10/2014 13:59'!
inspectItShortcut

	^ $i command mac | $i ctrl win | $i ctrl unix! !

!PharoShortcuts methodsFor: 'keymaps' stamp: 'GuillermoPolito 8/10/2014 14:03'!
closeWindowShortcut

	^ $w ctrl | $w command mac! !

!PharoShortcuts class methodsFor: 'accessing' stamp: 'GuillermoPolito 8/10/2014 13:56'!
current

	^ self new! !

!PharoSourcesCondenser commentStamp: 'CamilloBruni 2/23/2014 20:30'!
I create a more compact version of the .sources file.
I move the source code from all methods to a new .sources file where I keep only one version.
Additionally I will empty the current .changes file.!
!PharoSourcesCondenser methodsFor: 'public' stamp: 'CamilloBruni 2/23/2014 21:12'!
newSourceVersion: version
	"Create a new version of the .soruces file by copying the existing file to a new location"
	| originalSourcesFile newSourcesFile |
	
	"Create a copy with the new name"
	originalSourcesFile := self originalFile resolve.
	Smalltalk sourceFileVersionString: 'PharoV', version asString.
	newSourcesFile := Smalltalk sourcesFile.

	originalSourcesFile copyTo: newSourcesFile.
	"Use the new sources file"
	Smalltalk openSourceFiles.! !

!PharoSourcesCondenser methodsFor: 'accessing' stamp: 'CamilloBruni 2/23/2014 20:37'!
temporaryFile
	^ 'new.sources' asFileReference nextVersion! !

!PharoSourcesCondenser methodsFor: 'private - 3 installing' stamp: 'CamilloBruni 2/23/2014 20:45'!
installFreshChangesFile
	| changesFile |
	
	"install a new .changes file"
	changesFile := Smalltalk changesFile.
	changesFile moveTo: (changesFile , 'bak') nextVersion.
	
	"create a fresh changes file "
	changesFile writeStreamDo: [ :strm |
		 strm timeStamp ].! !

!PharoSourcesCondenser methodsFor: 'private - 3 installing' stamp: 'CamilloBruni 2/23/2014 20:39'!
updateQuitPosition
	
	"We use an empty .changes file, hence the last quit position is 0"
	
	Smalltalk lastQuitLogPosition: 0.! !

!PharoSourcesCondenser methodsFor: 'accessing' stamp: 'CamilloBruni 2/23/2014 20:37'!
originalFile
	^ Smalltalk sourcesFile! !

!PharoSourcesCondenser methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 4/13/2015 17:30'!
writeClassComment: aClass
	| organizer commentRemoteString stamp |
	
	organizer := aClass organization.
	commentRemoteString := organizer commentRemoteString.
	
	commentRemoteString isNil
		ifTrue: [ ^ self ].
		
	self nextCommentChunkDo: [ :strm |
		strm 
			nextPutAll: aClass name;
			nextPutAll: ' commentStamp: '.
		stamp := organizer commentStamp 
			ifNil: ['<historical>'].
		stamp storeOn: strm ].
	
	self 
		writeRemoteString: organizer classComment
		for: aClass! !

!PharoSourcesCondenser methodsFor: 'private - 3 installing' stamp: 'CamilloBruni 2/23/2014 20:41'!
backupOldChanges
	super backupOldChanges.
	self installFreshChangesFile.! !

!PharoSourcesCondenser methodsFor: 'private - testing' stamp: 'CamilloBruni 2/23/2014 21:52'!
shouldCondenseMethod: aCompiledMethod
	"The sources condenser moves ALL method sources to a new file"
	^ aCompiledMethod hasSourcePointer! !

!PharoSourcesCondenser methodsFor: 'accessing' stamp: 'CamilloBruni 2/23/2014 21:21'!
fileIndex
	"We are working on the .sources file which has index = 1"
	^ 1! !

!PharoSourcesCondenser class methodsFor: 'helper' stamp: 'CamilloBruni 2/23/2014 21:04'!
condenseNewSources
	| condenser |
	condenser := self new.
	condenser newSourceVersion: (SystemVersion current major) * 10.
	condenser condense.! !

!PharoSyntaxTutorial commentStamp: 'CamilloBruni 2/22/2014 19:04'!
The default Pharo tutorial to learn the Pharo syntax!
!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'CamilloBruni 2/22/2014 18:50'!
messageSyntaxExecutionOrderParentheses
	^ Lesson
title: 'Message syntax: Parentheses'
lesson: 
'"Use parentheses to change order of evaluation"

(2 + 3) squared.

(2 raisedTo: 3) + 2.

(0@0 extent: 100@200) bottomRight.

PharoTutorial next.'! !

!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'CamilloBruni 2/22/2014 18:49'!
blocks
	^ Lesson
title: 'Blocks' 
lesson: 
'"Cascade is cool !! Let''s talk about blocks.

Blocks are anonymous methods that can be stored into variables and executed on demand.

Blocks are delimited by square brackets: []"

[Browser open].

"does not open a Browser because the block is not executed.

Here is a block that adds 2 to its argument (its argument is named x):"

[:x | x+2].

"We can execute a block by sending it value messages."

[:x | x+2] value: 5.

[Browser open] value.

[:x | x+2] value: 10.

[:x :y| x + y] value:3 value:5.

[PharoTutorial next] value.'! !

!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'CamilloBruni 2/22/2014 19:04'!
pharoEnvironment
	^ Lesson
title: 'Pharo environment' 
lesson: 
'"Pharo is full of objects. There are windows, text, numbers, dates, colors, points and much more. You can interact with objects in a much more direct way than is possible with other programming languages.

Every object understands the message ''explore''. As a result, you get an Explorer window that shows details about the object."

Date today explore.

"This shows that the date object consists of a point in time (start) and a duration (one day long)."

PharoTutorial explore.

"You see, PharoTutorial class has a lot of objects. Let''s take a look at my code:"

PharoTutorial browse.

PharoTutorial next.'! !

!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'CamilloBruni 2/22/2014 18:51'!
reflectionContinued
	^ Lesson
title: 'Reflection continued' 
lesson: 
'"So cool, isn''t it ?  Before going further, let''s remove this method:"

PharoTutorial respondsTo: #goToNextLesson.

PharoTutorial class removeSelector: #goToNextLesson.

PharoTutorial respondsTo: #goToNextLesson.


"Then move forward:"

PharoTutorial default executeMethod: (PharoTutorial lookupSelector:#next).'! !

!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'SvenVanCaekenberghe 4/30/2014 15:52'!
inspecting
	^ Lesson
title: 'Inspecting' 
lesson: 
'"Now you''re a Do It and Print It master !! Let''s talk about inspecting. It''s a Do It which opens an Inspector on the result of evaluating the expression you''ve selected. 
The Inspector is a tool that allows you to have a look inside an object.

For example, select the text below, open the menu and click on ''inspect it (i)'':"

1 / 2.

"You''ve seen the letter ''i'' between parentheses next to ''inspect it'' ? It indicates the ALT- (or CMD- or CTRL-) shortcut to execute this command.

Try ALT-i (or CMD-i or CTRL-i) on the following expressions:"

DateAndTime today.

Float pi.

SystemVersion current.

PharoTutorial next.'! !

!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'CamilloBruni 2/22/2014 18:53'!
mathematicalPrecedence
	^ Lesson
title: 'Mathematical precedence'
lesson: 
'"Traditional precedence rules from mathematics do not apply in Pharo."

2 * 10 + 2.

"Here the message * is sent to 2, which answers 20, then 20 receive the message +

Remember that all messages always follow a simple left-to-right precedence rule, * without exceptions *."

2 + 2 * 10.

2 + (2 * 10).

8 - 5 / 2.

(8 - 5) / 2.

8 - (5 / 2).

PharoTutorial next.'! !

!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'CamilloBruni 2/22/2014 18:48'!
basicTypesDynamicArray
	^ Lesson
title: 'Basic types: Dynamic Array' 
lesson: 
'"Dynamic Arrays are created at execution time:"

{ (2+3) . (6*6) }.

{ (2+3) . (6*6) . ''hello'', '' Stef''} size.


{ PharoTutorial } first next.'! !

!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'CamilloBruni 2/22/2014 18:50'!
messageSyntaxBinary
	^ Lesson
title: 'Message syntax: Binary messages' 
lesson: 
'"Binary messages have the following form:
    anObject + anotherObject"

3 * 2.

Date today + 3 weeks.

false | false.

true & true.

true & false.

10 @ 100.

10 <= 12.

''ab'', ''cd''.

Date today < Date yesterday.

PharoTutorial next.'! !

!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'CamilloBruni 2/22/2014 18:48'!
basicTypesCharacters
	^ Lesson
title: 'Basic types: Characters' 
lesson: 
'"A Character can be instantiated using $ operator:"

$A.

$A class.

$B charCode.

Character cr.

Character space.

"You can print all 256 characters of the ASCII extended set:"

Character allByteCharacters.

PharoTutorial next.'! !

!PharoSyntaxTutorial methodsFor: 'initialize-release' stamp: 'LaurentLaffont 12/12/2010 17:18'!
initialize
	super initialize.
	self prepareDebuggerExample.! !

!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'CamilloBruni 2/22/2014 18:49'!
blocksAssignation
	^ Lesson
title: 'Block assignation' 
lesson: 
'"Blocks can be assigned to a variable then executed later.

Note that |b| is the declaration of a variable named ''b'' and that '':='' assigns a value to a variable.

Select the three lines then Print It:"

|b|
b := [:x | x+2].
b value: 12.


PharoTutorial next.'! !

!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'SvenVanCaekenberghe 4/30/2014 15:50'!
printing 
	^ Lesson
title: 'Printing' 
lesson: 
'"Now you''re a Do It master !! Let''s talk about printing. It''s a Do It which prints the result next to the expression you''ve selected.
For example, select the text below, open the menu and click on ''print it (p)'':"

1 + 2.

"You''ve seen the letter ''p'' between parentheses next to ''print it'' ? It indicates the ALT- (or CMD- or CTRL-) shortcut to execute this command.

Try ALT-p (or CMD-p or CTRL-p) on the following expressions:"

Date today.

Time now.

"The result is selected, so you can erase it using the backspace key. Try it !!"

SmalltalkImage current datedVersion.

PharoTutorial next.'! !

!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'MarcusDenker 3/30/2015 18:16'!
theEnd
	^ Lesson
title: 'Tutorial done !!' 
lesson: 
'"This tutorial is done. Enjoy programming with Pharo. 

Don''t forget to read ''Pharo By Example'' found here:  

	http://pharobyexample.org/

You can run this tutorial again by evaluating:"

PharoTutorial go.

"Do you want to create your own interactive tutorial with PharoTutorial ? That''s very easy!!!!  How ? There''s a PharoTutorial interactive tutorial for that :D
Just evaluate the following code:"

PharoTutorial goOn: HowToMakeYourOwnTutorial

"See you soon !!"
'! !

!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'CamilloBruni 2/22/2014 18:52'!
debugger
	^ Lesson
title: 'Debugger' 
lesson: '"The Debugger may be the most famous tool of Smalltalk environments. It will open as soon as an unmanaged Exception occurs. 

The following code will open the debugger on the message stack, select PharoSyntaxTutorial>>divideTwoByZero".

PharoSyntaxTutorial new divideTwoByZero. '! !

!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'CamilloBruni 2/22/2014 18:50'!
messageSyntaxCascade
	^ Lesson
title: 'Message syntax: Cascade' 
lesson: 
'"; is the cascade operator. It''s useful to send message to the SAME receiver
Open a Transcript (console):"

Transcript open.

"Then:"

Transcript show: ''hello''.
Transcript show: ''Pharo''.
Transcript cr.

"is equivalent to:"

Transcript 
	   show: ''hello'';
	   show: ''Pharo'' ;
	   cr.

"Try to go to the next lesson with a cascade of two ''next'' messages:"

PharoTutorial'.! !

!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'CamilloBruni 2/22/2014 18:49'!
basicTypesString
	^ Lesson
title: 'Basic types: Strings' 
lesson: 
'"A String is a collection of characters. Use single quotes to create a String object. Print these expressions:"

''PharoTutorial''.

''PharoTutorial'' size.

''abc'' asUppercase.

''Hello World'' reverse. 

"You can access each character using at: message"

''PharoTutorial'' at: 1.

"String concatenation uses the comma operator:"

''PharoTutorial'', '' is cool''.

PharoTutorial next.'! !

!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'CamilloBruni 2/22/2014 18:49'!
basicTypesSymbol
	^ Lesson
title: 'Basic types: Symbols' 
lesson: 
'"A Symbol is a String which is guaranteed to be globally unique. 

There is one and only one Symbol #PharoTutorial. There may be several ''PharoTutorial'' String objects.

(Message == returns true if the two objects are the SAME)"

''PharoTutorial'' asSymbol.

#PharoTutorial asString.

(2 asString) == (2 asString).

(2 asString) asSymbol == (2 asString) asSymbol.


(Smalltalk at: #PharoTutorial) next.'! !

!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'CamilloBruni 2/22/2014 18:50'!
messageSyntaxUnary
	^ Lesson
title: 'Message syntax: Unary messages' 
lesson: 
'"Messages are sent to objects. There are three types of message: Unary, Binary and Keyword.

Unary messages have the following form:
    anObject aMessage 

You''ve already sent unary messages. For example:"

1 class.

false not.

Time now.

Date today.

Float pi.

"And of course: "

PharoTutorial next.'! !

!PharoSyntaxTutorial methodsFor: 'interactive' stamp: 'EstebanLorenzano 9/3/2014 12:16'!
prepareDebuggerExample
	Author 
		useAuthor: 'AutoGenTutorial'
		during: [ 
			self class compileSilently: 'divideTwoByZero
			2/0.

			"Oups!! 2/0 raises a ZeroDivide exception.  So the debugger opens to let you fix the code.

			- Remove the line of code above.
			- Right-click and select ''Accept'' to compile the new version of the method
			- click the button ''Proceed'' to continue execution.
			".
			PharoTutorial next. '

			classified: 'interactive' ]! !

!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'CamilloBruni 2/22/2014 18:50'!
loops
	^ Lesson
title: 'Loops' 
lesson: 
'"Loops are high-level collection iterators, implemented as regular methods."

"Basic loops:
  to:do:
  to:by:do"

1 to: 100 do:
  [:i | Transcript show: i asString; cr ].

1 to: 100 by: 3 do: [:i | Transcript show: i asString; cr].

100 to: 0 by: -2 do: 
    [:i | Transcript show: i asString; cr].

1 to: 1 do: [:i | PharoTutorial next].'! !

!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'CamilloBruni 2/22/2014 18:51'!
welcome
	^ Lesson
title: 'Welcome' 
lesson: 
'"Hello!! I''m Professor Stef.

You must want me to help you learn Pharo.

So let''s go to the first lesson.  Select the text below, right-click and choose ''do it (d)''"

PharoTutorial next.'! !

!PharoSyntaxTutorial methodsFor: 'interactive' stamp: 'AutoGenTutorial 2/19/2015 10:54'!
divideTwoByZero
			2/0.

			"Oups!! 2/0 raises a ZeroDivide exception.  So the debugger opens to let you fix the code.

			- Remove the line of code above.
			- Right-click and select 'Accept' to compile the new version of the method
			- click the button 'Proceed' to continue execution.
			".
			PharoTutorial next. ! !

!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'CamilloBruni 2/22/2014 18:52'!
basicTypesNumbers
	^ Lesson
title: 'Basic types: Numbers' 
lesson: 
'"You now know how to execute Pharo code. 

Now let''s talk about basic objects.

1, 2, 100, 2/3 ... are Numbers, and respond to many messages evaluating mathematical expressions.
Evaluate these ones:"

2.

20 factorial.

1000 factorial / 999 factorial.

(1/3).

(1/3) + (4/5).

(1/3) asFloat.

1 class.

1 class maxVal class.

(1 class maxVal + 1) class.

PharoTutorial next.'! !

!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'CamilloBruni 2/22/2014 18:51'!
basicTypesArray
	^ Lesson
title: 'Basic types: Array' 
lesson: 
'"Literal arrays are created at parse time:"

#(1 2 3).

#( 1 2 3 #(4 5 6)) size.

#(1 2 4) isEmpty.

#(1 2 3) first.

#(''hello'' ''World'') at: 2 put: ''Pharo''; yourself.

PharoTutorial next.'! !

!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'CamilloBruni 2/22/2014 18:50'!
messageSyntaxCascadeShouldNotBeHere
	^ Lesson
title: 'Lost ?' 
lesson: 
'"Hey, you should not be here !!!! 

Go back and use a cascade !!"

PharoTutorial previous.'.! !

!PharoSyntaxTutorial methodsFor: 'tutorial' stamp: 'SvenVanCaekenberghe 3/26/2015 22:38'!
tutorial
^ #(
welcome
doingVSPrinting
printing
inspecting

basicTypesNumbers
basicTypesCharacters
basicTypesString
basicTypesSymbol
basicTypesArray
basicTypesDynamicArray

messageSyntaxUnary
messageSyntaxBinary
messageSyntaxKeyword
messageSyntaxExecutionOrder
messageSyntaxExecutionOrderParentheses
mathematicalPrecedence
messageSyntaxCascade
messageSyntaxCascadeShouldNotBeHere

blocks
blocksAssignation
conditionals
loops
iterators

instantiation

reflection
reflectionContinued

pharoEnvironment
debugger

theEnd
)! !

!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'CamilloBruni 2/22/2014 18:49'!
conditionals
	^ Lesson
title: 'Conditionals' 
lesson: 
'"Conditionals are just messages sent to Boolean objects"

1 < 2
  ifTrue: [100]
  ifFalse: [42].

"Here the message is ifTrue:ifFalse

Try this:"

Transcript open.

3 > 10 
	ifTrue: [Transcript show: ''maybe there''''s a bug ....'']
	ifFalse: [Transcript show: ''No : 3 is less than 10''].

3 = 3 ifTrue: [PharoTutorial next].'.! !

!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'CamilloBruni 2/22/2014 19:05'!
reflection
	^ Lesson
title: 'Reflection' 
lesson: 
'"You can inspect and change the system at runtime.

Take a look at method #ifFalse:ifTrue: source code of class True:"

(True>>#ifFalse:ifTrue:) definition.

"Or just its comment:"

(True>>#ifFalse:ifTrue:) comment.

"Here''s all the methods I implement:"

PharoTutorial selectors.


"Let''s create a new method to go to the next lesson:"

PharoTutorial class compile:''goToNextLesson
  self next''.

"Wow !! I can''t wait to use my new method !! "

PharoTutorial goToNextLesson.'! !

!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'CamilloBruni 2/22/2014 18:50'!
iterators
	^ Lesson
title: 'Iterators' 
lesson: 
'"The message do: is sent to a collection of objects (Array, Set, OrderedCollection), evaluating the block for each element.

Here we want to print all the numbers on the Transcript (a console)"

#(11 38 3 -2 10) do: [:each |
     Transcript show: each printString; cr].

"Some other really nice iterators"

#(11 38 3 -2 10) collect: [:each | each abs].

#(11 38 3 -2 10) collect: [:each | each odd].

#(11 38 3 -2 10) select: [:each | each odd].

#(11 38 3 -2 10) select: [:each | each > 10].

#(11 38 3 -2 10) reject: [:each | each > 10].

#(11 38 3 -2 10) 
     do: [:each | Transcript show: each printString]
     separatedBy: [Transcript show: ''.''].


PharoTutorial allInstances do: [:aPharoTutorial | aPharoTutorial next].'! !

!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'CamilloBruni 2/22/2014 18:50'!
messageSyntaxKeyword
	^ Lesson
title: 'Message syntax: Keyword messages' 
lesson: 
'"Keyword Messages are messages with arguments. They have the following form:
    anObject akey: anotherObject akey2: anotherObject2"

4 between: 0 and: 10.

"The message is between:and: sent to the Number 4"

1 max: 3.

Color r:1 g:0 b:0.

"The message is r:g:b: implemented on class Color. Note you can also write"

Color
	r:1
	g:1
	b:0.
	
PharoTutorial perform: #next.'! !

!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'SvenVanCaekenberghe 4/30/2014 15:51'!
doingVSPrinting 
	^ Lesson
title: 'Doing' 
lesson: 
'"Cool !! (I like to say Cooool :) ). You''ve just executed a Pharo expression. More precisely, you sent the message ''next'' to PharoTutorial class (it''s me !!).

Note you can run this tutorial again by evaluating: ''PharoTutorial go''. 
''PharoTutorial previous'' returns to the previous lesson.

You can also Do It using the keyboard shortcut ''ALT d''
(this varies according to your operating system/computer: it can be ''CMD d'' or ''CTRL d''). 

Try to evaluate these expressions:"

Browser open.

SmalltalkImage current aboutThisSystem.

"Then go to the next lesson:"

PharoTutorial next.'! !

!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'BernardoContreras 2/19/2015 10:55'!
instantiation
	^ Lesson
title: 'Instantiation' 
lesson: 
'"Objects are instances of their class. Usually, we send the message #new to a class for creating an instance of this class.

The message #allInstances sent to a class answers an Array with all instances of this class.

For example, let''s look at how many instances of SimpleButtonMorph exist:"

SimpleButtonMorph allInstances size.

"Now create a new instance of it:"

SimpleButtonMorph new
	label: ''A nice button'';
	openCenteredInWorld.

"See the button centered on the world ? The list of all instances should contains one more instance:"

SimpleButtonMorph allInstances size.

"Let''s play with it:"

SimpleButtonMorph allInstances last 
	label: ''PharoTutorial is cooooool !!'';
	color: Color cyan.
	
"Let''s delete it and ask the system to clean the memory:"

SimpleButtonMorph allInstances last delete.
Smalltalk garbageCollect.
SimpleButtonMorph allInstances size.

"Click on the button to go to next lesson:"

SimpleButtonMorph new
	label: ''Go to next lesson'';
	target: [PharoTutorial next. 
			SimpleButtonMorph allInstances last delete];
	actionSelector: #value;
	openCenteredInWorld.'! !

!PharoSyntaxTutorial methodsFor: 'lessons' stamp: 'CamilloBruni 2/22/2014 18:50'!
messageSyntaxExecutionOrder
	^ Lesson
title: 'Message syntax: Execution order' 
lesson: 
'"Unary messages are executed first, then binary messages and finally keyword messages:
    Unary > Binary > Keywords"

2 + 3 squared.

2 raisedTo: 3 + 2.
  
(0@0) class.

0@0 corner: 100@200.

(0@0 corner: 100@200) class.

"Between messages of similar precedence, expressions are executed from left to right"

-3 abs negated reciprocal.

PharoTutorial next.'! !

!PharoSyntaxTutorialTest commentStamp: 'CamilloBruni 2/22/2014 18:58'!
SUnit tests for PharoSyntaxTutorial!
!PharoSyntaxTutorialTest methodsFor: 'tests' stamp: ''!
testLessonAtReturnsCorrespondingLesson
	| answer |
	1 to: (self testedTutorial tutorial size) do: [:index|
		answer := self testedTutorial lessonAt: index.
		self assert: (answer isKindOf: Lesson)
	]
	! !

!PharoSyntaxTutorialTest methodsFor: 'requirements' stamp: 'CamilloBruni 2/22/2014 18:48'!
testedTutorial
	"Returns an instance of an AbstractTutorial subclass"
	^ PharoSyntaxTutorial new! !

!PharoSyntaxTutorialTest methodsFor: 'tests' stamp: ''!
testNotEmpty
	self assert: self testedTutorial tutorial notEmpty.! !

!PharoSyntaxTutorialTest methodsFor: 'tests' stamp: ''!
testEachSelectorReturnsALesson
	| answer |
	self testedTutorial tutorial do: [:aSelector|
		answer := (self testedTutorial perform: aSelector).
		self assert: (answer isKindOf: Lesson).
	]! !

!PharoSyntaxTutorialTest methodsFor: 'tests' stamp: 'LaurentLaffont 12/12/2010 22:20'!
testDivideTwoByZeroSignalsZeroDivide
	[self testedTutorial divideTwoByZero.
	self fail] 
	on: ZeroDivide 
	do: []! !

!PharoSyntaxTutorialTest methodsFor: 'tests' stamp: 'LaurentLaffont 2/1/2010 22:07'!
testEachSelectorExists
	self testedTutorial tutorial do: [:aSelector|
		self assert: (self testedTutorial respondsTo: aSelector) 
	]! !

!PharoSyntaxTutorialTest methodsFor: 'tests' stamp: ''!
testSizeReturnsNumberOfSelectors
	self assert: (self testedTutorial tutorial size) equals: self testedTutorial size.! !

!PharoTutorial commentStamp: 'CamilloBruni 2/22/2014 19:02'!
A PharoTutorial is the Pharo teacher. To start the tutorial, evaluate:
PharoTutorial go.

To go to the next lesson evaluate:
PharoTutorial next.

To execute your own tutorial:
PharoTutorial goOn: MyOwnTutorial

To see a table of contents with all defined tutorials:
PharoTutorial contents!
!PharoTutorial methodsFor: 'starting' stamp: 'CamilloBruni 2/22/2014 18:48'!
go
	^ self goOn: PharoSyntaxTutorial.! !

!PharoTutorial methodsFor: 'navigating' stamp: 'DannyChan 2/9/2010 19:28'!
last
	self player last.
	^ self showCurrentLesson.! !

!PharoTutorial methodsFor: 'gui' stamp: 'LaurentLaffont 1/21/2010 21:05'!
close
	self lessonView close! !

!PharoTutorial methodsFor: 'navigating' stamp: 'DannyChan 2/1/2010 19:23'!
tutorial: aTutorialClass lessonAt: lessonIndex
	self player tutorial: aTutorialClass new.
	self player tutorialPosition: lessonIndex.
	self showCurrentLesson.! !

!PharoTutorial methodsFor: 'navigating' stamp: 'DannyChan 2/9/2010 19:28'!
first
	self player first.
	^ self showCurrentLesson.! !

!PharoTutorial methodsFor: 'navigating' stamp: 'SvenVanCaekenberghe 4/30/2014 16:15'!
next
	self helpBrowserWindow 
		ifNotNil: [ :window | window model next ].
	self lessonView isOpenInWindow 
		ifTrue: [ 
			self player next.
			self showCurrentLesson ]! !

!PharoTutorial methodsFor: 'accessing' stamp: 'LaurentLaffont 1/21/2010 20:38'!
player 
	^ player ifNil: [player := TutorialPlayer new]! !

!PharoTutorial methodsFor: 'gui' stamp: 'CamilloBruni 2/22/2014 19:44'!
showCurrentLesson
	| progressInfo lesson |
	lesson := self player currentLesson.
	progressInfo := '(', self tutorialPositionString, '/', self tutorialSizeString, ')'. 
	^ self lessonView 
		showLesson: lesson 
		withTitle: lesson title, ' ', progressInfo.! !

!PharoTutorial methodsFor: 'accessing' stamp: 'LaurentLaffont 1/21/2010 20:37'!
tutorialPositionString
	^ player tutorialPosition asString.! !

!PharoTutorial methodsFor: 'accessing' stamp: 'LaurentLaffont 1/21/2010 20:38'!
tutorialSizeString
	^ self player size asString! !

!PharoTutorial methodsFor: 'navigating' stamp: 'DannyChan 2/1/2010 21:23'!
tutorial: aTutorialClass lesson: aSelector
	| tutorial |
	tutorial := aTutorialClass new.
	self player tutorial: tutorial.
	self tutorial: aTutorialClass lessonAt: (tutorial indexOfLesson: aSelector).! !

!PharoTutorial methodsFor: 'accessing' stamp: 'DannyChan 2/2/2010 19:16'!
lessonView: aLessonView
	lessonView := aLessonView.! !

!PharoTutorial methodsFor: 'accessing' stamp: 'DannyChan 2/2/2010 19:39'!
lessonView
	^ lessonView ifNil: [lessonView := LessonView new]! !

!PharoTutorial methodsFor: 'starting' stamp: 'tg 2/1/2010 16:02'!
goOn: aTutorialClass
	self player tutorial: aTutorialClass new.
	^ self open.! !

!PharoTutorial methodsFor: 'gui' stamp: 'tg 2/1/2010 16:02'!
open
	self player first.
	^ self showCurrentLesson.! !

!PharoTutorial methodsFor: 'accessing' stamp: 'LaurentLaffont 1/21/2010 20:39'!
player: aTutorialPlayer
	player := aTutorialPlayer.! !

!PharoTutorial methodsFor: 'navigating' stamp: 'SvenVanCaekenberghe 4/30/2014 16:16'!
previous
	self helpBrowserWindow 
		ifNotNil: [ :window | window model previous ].
	self lessonView isOpenInWindow 
		ifTrue: [ 
			self player previous.
			self showCurrentLesson ]! !

!PharoTutorial methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 3/27/2015 13:48'!
helpBrowserWindow
	"Yes this is a hack"
	
	^ World systemWindows 
		detect: [ :each | each model class = HelpBrowser ] 
		ifNone: [ nil ]! !

!PharoTutorial class methodsFor: 'zen' stamp: 'SvenVanCaekenberghe 3/27/2015 13:56'!
aboutPharoZen
	^ 'These are the Pharo Zen values.\\See:\\  PharoTutorial class>>#pharoZenValues\\Inspect:\\  PharoTutorial pharoZenValues' withCRs! !

!PharoTutorial class methodsFor: 'navigating' stamp: 'LaurentLaffont 9/18/2011 20:01'!
go
	^ self default go.! !

!PharoTutorial class methodsFor: 'navigating' stamp: 'DannyChan 2/9/2010 19:30'!
last
	^ self default last.! !

!PharoTutorial class methodsFor: 'starting' stamp: 'DannyChan 2/1/2010 19:23'!
tutorial: aTutorialClass lessonAt: lessonIndex
	self default tutorial: aTutorialClass lessonAt: lessonIndex.! !

!PharoTutorial class methodsFor: 'zen' stamp: 'SvenVanCaekenberghe 7/30/2014 13:52'!
menuCommandOn: aBuilder
	<worldMenu>
	(aBuilder item: #'Pharo Zen')
		parent: #Help;
		action: [ PharoTutorial openPharoZenWorkspace ];
		icon: (Smalltalk ui icons pharoIcon scaledToSize: 16@16)! !

!PharoTutorial class methodsFor: 'navigating' stamp: 'DannyChan 2/9/2010 19:30'!
first
	^ self default first.! !

!PharoTutorial class methodsFor: 'navigating' stamp: 'tg 2/1/2010 16:01'!
next
	^ self default next.! !

!PharoTutorial class methodsFor: 'zen' stamp: 'SvenVanCaekenberghe 3/27/2015 13:52'!
openPharoZenWorkspace
	"Open a Workspace showing the Pharo Zen values in random order"

	"self openPharoZenWorkspace"

	TextModel new
		text: self pharoZenValuesContents;
		title: 'Pharo Zen';
		aboutText: self aboutPharoZen;
		isCodeCompletionAllowed: false;
		menuHolder: [  ];
		openWithSpec! !

!PharoTutorial class methodsFor: 'class initialization' stamp: 'CamilloBruni 2/22/2014 19:45'!
reset 
	Instance := nil! !

!PharoTutorial class methodsFor: 'zen' stamp: 'SvenVanCaekenberghe 7/30/2014 13:51'!
pharoZenValuesContents
	"Return a string with CRs listing the Pharo Zen values in random order"
	
	"self pharoZenValuesContents"
	
	^ String streamContents: [ :stream | 
			stream << (self class>>#pharoZenValues) comment withoutQuoting; cr; cr.
			self pharoZenValues shuffled 
				do: [ :each | stream << each ] 
				separatedBy: [ stream cr ] ]! !

!PharoTutorial class methodsFor: 'class initialization' stamp: 'CamilloBruni 2/22/2014 19:45'!
default 
	^ Instance ifNil: [Instance := self new]! !

!PharoTutorial class methodsFor: 'starting' stamp: 'DannyChan 2/1/2010 19:23'!
tutorial: aTutorialClass lesson: aSelector
	self default tutorial: aTutorialClass lesson: aSelector.! !

!PharoTutorial class methodsFor: 'navigating' stamp: 'tg 2/1/2010 16:01'!
previous
	^ self default previous.! !

!PharoTutorial class methodsFor: 'navigating' stamp: 'LaurentLaffont 9/18/2011 20:01'!
goOn: aTutorialClass
	^ self default goOn: aTutorialClass.! !

!PharoTutorial class methodsFor: 'zen' stamp: 'SvenVanCaekenberghe 7/30/2014 13:51'!
pharoZenValues
	"Our values and convictions are condensed in this simple list."
	
	^ #(
		'Easy to understand, easy to learn from, easy to change.' 
		'Objects all the way down.' 
		'Examples to learn from.' 
		'Fully dynamic and malleable.' 
		'Beauty in the code, beauty in the comments.' 
		'Simplicity is the ultimate elegance.' 
		'Better a set of small polymorphic classes than a large ugly one.' 
		'Classes structure our vocabulary.' 
		'Messages are our vocabulary.' 
		'Polymorphism is our esperanto.' 
		'Abstraction and composition are our friends.' 
		'Tests are important but can be changed.' 
		'Explicit is better than implicit.' 
		'Magic only at the right place.' 
		'One step at a time.' 
		'There is no unimportant fix.' 
		'Learning from mistakes.' 
		'Perfection can kill movement.' 
		'Quality is an emerging property.' 
		'Simple processes to support progress.' 
		'Communication is key.' 
		'A system with robust abstractions that a single person can understand.' )! !

!PharoTutorialAPIHelp commentStamp: 'CamilloBruni 2/22/2014 18:59'!
I'm a PharoTutorial which builds a HelpSystem book by collecting comment from classes and method.!
!PharoTutorialAPIHelp class methodsFor: 'accessing' stamp: 'LaurentLaffont 9/19/2010 15:14'!
bookName 
	^ 'Reference'! !

!PharoTutorialAPIHelp class methodsFor: 'defaults' stamp: 'LaurentLaffont 9/19/2010 15:14'!
builder 
	^ PackageAPIHelpBuilder! !

!PharoTutorialAPIHelp class methodsFor: 'accessing' stamp: 'CamilloBruni 2/22/2014 19:17'!
helpPackages
	^ #('ProfStef-Core')! !

!PharoTutorialHelp commentStamp: 'CamilloBruni 2/22/2014 18:59'!
HelpSystem book documenting PharoTutorial!
!PharoTutorialHelp class methodsFor: 'testing' stamp: 'AlainPantec 2/23/2012 08:16'!
canHaveSyntaxHighlighting
	^ true ! !

!PharoTutorialHelp class methodsFor: 'pages' stamp: 'LaurentLaffont 9/19/2010 15:13'!
createATutorial
	^ HelpTopic 
		title: 'Create a tutorial'
		contents: 'See AbstractTutorial comment: ', AbstractTutorial comment.! !

!PharoTutorialHelp class methodsFor: 'pages' stamp: 'CamilloBruni 2/22/2014 18:59'!
listOfTutorials 
	|contents|
	
	contents := String streamContents: [:aStream|
		AbstractTutorial tutorials do: [:aTutorial|
			aStream 
				nextPutAll: aTutorial title; cr;
				tab; nextPutAll: 'PharoTutorial goOn:'; nextPutAll: aTutorial name;
				cr;cr.
		]
	].

	^ HelpTopic 
		title: 'List of tutorials' 
		contents: contents.! !

!PharoTutorialHelp class methodsFor: 'accessing' stamp: 'LaurentLaffont 9/19/2010 15:13'!
pages
	^ #(introduction listOfTutorials createATutorial)! !

!PharoTutorialHelp class methodsFor: 'pages' stamp: 'CamilloBruni 2/22/2014 18:59'!
introduction
	^ HelpTopic 
		title: 'Introduction'
		contents: 'PharoTutorial is a framework to create interactive tutorials'.! !

!PharoTutorialHelp class methodsFor: 'accessing' stamp: 'CamilloBruni 2/22/2014 18:59'!
bookName 
	^ 'Pharo Tutorial'! !

!PharoTutorialHelpTest commentStamp: 'CamilloBruni 2/22/2014 18:58'!
SUnit tests for PharoTutorialHelp!
!PharoTutorialHelpTest methodsFor: 'tests' stamp: 'CamilloBruni 2/22/2014 18:58'!
testCreateATutorial
	| helpTopic |
	helpTopic := PharoTutorialHelp createATutorial.
	self assert: helpTopic notNil.
	self assert: helpTopic class == HelpTopic.
	self assert: helpTopic title = 'Create a tutorial'! !

!PharoTutorialHelpTest methodsFor: 'tests' stamp: 'CamilloBruni 2/22/2014 18:58'!
testIntroduction
	| helpTopic |
	helpTopic := PharoTutorialHelp introduction.
	self assert: helpTopic notNil.
	self assert: helpTopic class == HelpTopic.
	self assert: helpTopic title = 'Introduction'! !

!PharoTutorialHelpTest methodsFor: 'tests' stamp: 'CamilloBruni 2/22/2014 18:58'!
testPages
	self assert: PharoTutorialHelp pages isCollection.
	self assert: (PharoTutorialHelp pages allSatisfy: #isSymbol).! !

!PharoTutorialHelpTest methodsFor: 'tests' stamp: 'CamilloBruni 2/22/2014 18:58'!
testBookName
	self assert: PharoTutorialHelp bookName isString! !

!PharoTutorialHelpTest methodsFor: 'tests' stamp: 'CamilloBruni 2/22/2014 18:58'!
testListOfTutorials
	| helpTopic |
	helpTopic  := PharoTutorialHelp listOfTutorials.
	self assert: (helpTopic notNil).
	self assert: (helpTopic title =  'List of tutorials'  )! !

!PharoTutorialHelpTutorialBuilder commentStamp: 'CamilloBruni 2/22/2014 18:59'!
I build HelpSystem topics to browse PharoTutorial tutorials!
!PharoTutorialHelpTutorialBuilder methodsFor: 'building' stamp: 'LaurentLaffont 9/19/2010 15:30'!
buildTutorialTopicFor: aTutorial
	|tutorialTopic|
	tutorialTopic := HelpTopic named: aTutorial title.	
	
	aTutorial new lessons do:[:aLesson|
		tutorialTopic addSubtopic: (HelpTopic 
									title: aLesson title 
									contents:  aLesson lesson)
	].

	^ tutorialTopic ! !

!PharoTutorialHelpTutorialBuilder methodsFor: 'building' stamp: 'LaurentLaffont 9/19/2010 15:25'!
build
	topicToBuild := HelpTopic named: rootToBuildFrom bookName.
	
	AbstractTutorial tutorials do: [:aTutorial| 
		topicToBuild addSubtopic: (self buildTutorialTopicFor: aTutorial)
	].

	^ topicToBuild.! !

!PharoTutorialHelpTutorialBuilder class methodsFor: 'instance creation' stamp: 'LaurentLaffont 4/26/2011 13:00'!
new
	"We prohibid new"
	^ (self class lookupSelector: #buildHelpTopicFrom:)  == thisContext sender method  
		ifFalse:[self error: 'Please use buildHelpTopicFrom: instead']
		ifTrue: [super new]! !

!PharoTutorialHelpTutorialBuilderTest commentStamp: 'CamilloBruni 2/22/2014 18:58'!
SUnit tests for PharoTutorialHelpTutorialBuilder!
!PharoTutorialHelpTutorialBuilderTest methodsFor: 'tests' stamp: 'CamilloBruni 2/22/2014 18:59'!
testInstantiation 
	self should: [ PharoTutorialHelpTutorialBuilder new ] raise: Error! !

!PharoTutorialHelpTutorialBuilderTest methodsFor: 'tests' stamp: 'CamilloBruni 2/22/2014 19:44'!
testBuild
	| helpTopic tutorial |
	tutorial := PharoTutorialsHelp.
	helpTopic := PharoTutorialHelpTutorialBuilder buildHelpTopicFrom: tutorial.
	self assert: helpTopic notNil! !

!PharoTutorialTestGo commentStamp: 'TorstenBergmann 2/12/2014 22:52'!
SUnit tests for tutorial navigation!
!PharoTutorialTestGo methodsFor: 'tests' stamp: 'CamilloBruni 2/22/2014 18:48'!
testGoOpenSmalltalkSyntaxTutorial
	| displayedText expected |
	PharoTutorial go.
	
	displayedText := PharoTutorial default lessonView text.
	expected := PharoSyntaxTutorial new welcome lesson.
 	self assert: displayedText equals: expected.! !

!PharoTutorialTestGo methodsFor: 'tests' stamp: 'CamilloBruni 2/22/2014 18:42'!
testGoOnMockTutorial
	| displayedText expected |
	PharoTutorial goOn: MockTutorial.
	
	displayedText := PharoTutorial default lessonView text.
	expected := MockTutorial new firstLesson lesson.
 	self assert: displayedText equals: expected.! !

!PharoTutorialTestGo methodsFor: 'tests' stamp: 'CamilloBruni 2/22/2014 18:48'!
testGoTwiceUseSameLessonView
	| firstLessonView |
	PharoTutorial go.
	firstLessonView := PharoTutorial default lessonView.
	PharoTutorial goOn: PharoSyntaxTutorial.
	self assert: (firstLessonView ==  PharoTutorial default lessonView).! !

!PharoTutorialTestGo methodsFor: 'running' stamp: 'CamilloBruni 2/22/2014 18:42'!
tearDown
	PharoTutorial default close! !

!PharoTutorialTestGo methodsFor: 'tests' stamp: 'CamilloBruni 2/22/2014 18:48'!
testGoTwiceShowLessonViewIfNotVisible
	| firstLessonView |
	PharoTutorial go.
	firstLessonView := PharoTutorial default lessonView.
	firstLessonView close.
	PharoTutorial goOn: PharoSyntaxTutorial.
	self assert:  (World systemWindows includes:  firstLessonView window).! !

!PharoTutorialTestGoOnMockTutorial commentStamp: 'TorstenBergmann 2/12/2014 22:52'!
SUnit tests for tutorial navigation!
!PharoTutorialTestGoOnMockTutorial methodsFor: 'running' stamp: 'CamilloBruni 2/22/2014 18:42'!
setUp
	PharoTutorial tutorial: MockTutorial lesson: #firstLesson ! !

!PharoTutorialTestGoOnMockTutorial methodsFor: 'tests' stamp: 'CamilloBruni 2/22/2014 18:42'!
testLastShouldGoToThirdLesson
	PharoTutorial last.
 	self assert:  'Third lesson' equals: PharoTutorial default lessonView text! !

!PharoTutorialTestGoOnMockTutorial methodsFor: 'tests' stamp: 'CamilloBruni 2/22/2014 18:42'!
testLastThenFirstShouldGoToFirstLesson
	PharoTutorial last; first.
 	self assert:  'First lesson' equals: PharoTutorial default lessonView text! !

!PharoTutorialTestGoOnMockTutorial methodsFor: 'tests' stamp: 'CamilloBruni 2/22/2014 18:42'!
testLastThenPreviousShouldGoToSecondLesson
	PharoTutorial last; previous.
 	self assert:  'Second lesson' equals: PharoTutorial default lessonView text! !

!PharoTutorialTestGoOnMockTutorial methodsFor: 'running' stamp: 'CamilloBruni 2/22/2014 18:42'!
tearDown
	PharoTutorial default close! !

!PharoTutorialTestGoOnMockTutorial methodsFor: 'tests' stamp: 'CamilloBruni 2/22/2014 18:42'!
testNextShouldGoToSecondLesson
	PharoTutorial next.
 	self assert:  'Second lesson' equals: PharoTutorial default lessonView text! !

!PharoTutorialTestGoOnMockTutorial methodsFor: 'tests' stamp: 'CamilloBruni 2/22/2014 18:42'!
testFirstLessonShouldBeDisplayed.
 	self assert:  'First lesson' equals: PharoTutorial default lessonView text! !

!PharoTutorialTestNavigation commentStamp: 'TorstenBergmann 2/12/2014 22:52'!
SUnit tests for tutorial navigation!
!PharoTutorialTestNavigation methodsFor: 'tests' stamp: 'LaurentLaffont 2/15/2011 22:11'!
testSequenceNextNextPreviousOpenSecondLesson
	prof next; next; previous.
	self assert: mockView title equals: 'second (2/3)'.
	self assert: mockView lesson lesson equals: 'Second lesson'.! !

!PharoTutorialTestNavigation methodsFor: 'tests' stamp: 'LaurentLaffont 2/15/2011 22:12'!
testShowingLessonByIndex
	prof tutorial: MockTutorial lessonAt: 2.
	self assert: mockView title equals: 'second (2/3)'.
	self assert: mockView lesson lesson equals: 'Second lesson'.! !

!PharoTutorialTestNavigation methodsFor: 'tests' stamp: 'LaurentLaffont 1/21/2010 16:27'!
testShowFirstLessonOnGo
	| lesson |
	lesson := mockView lesson.
	self assert: lesson title equals: 'first'.
	self assert: lesson lesson equals: 'First lesson'.! !

!PharoTutorialTestNavigation methodsFor: 'tests' stamp: 'LaurentLaffont 2/15/2011 22:13'!
testNextOpenSecondLesson
	prof next.
	self assert: mockView title equals: 'second (2/3)'.
	self assert: mockView lesson lesson equals: 'Second lesson'.! !

!PharoTutorialTestNavigation methodsFor: 'tests' stamp: 'LaurentLaffont 2/15/2011 22:12'!
testShowingLessonBySelector
	prof tutorial: MockTutorial lesson: #firstLesson.
	self assert: mockView title equals: 'first (1/3)'.
	self assert: mockView lesson lesson equals: 'First lesson'.! !

!PharoTutorialTestNavigation methodsFor: 'tests' stamp: 'LaurentLaffont 2/15/2011 22:12'!
testSequenceNextNextOpenThirdLesson
	prof next; next.
	self assert: mockView title equals: 'third (3/3)'.
	self assert: mockView lesson lesson equals: 'Third lesson'.! !

!PharoTutorialTestNavigation methodsFor: 'running' stamp: 'CamilloBruni 2/22/2014 18:42'!
setUp
	prof := PharoTutorial new.
	prof player: (
		TutorialPlayer new 
			tutorial: MockTutorial new; 
			yourself).
	mockView := MockLessonView new.
	prof lessonView: mockView.
	prof open.! !

!PharoTutorialsHelp commentStamp: 'CamilloBruni 2/22/2014 18:59'!
I'm a HelpSystem book which list all Pharo tutorials!
!PharoTutorialsHelp class methodsFor: 'accessing' stamp: 'LaurentLaffont 9/19/2010 15:16'!
bookName 
	^ 'Browse tutorials'! !

!PharoTutorialsHelp class methodsFor: 'defaults' stamp: 'CamilloBruni 2/22/2014 18:59'!
builder
	^ PharoTutorialHelpTutorialBuilder! !

!PharoTutorialsHelp class methodsFor: 'menu' stamp: 'CamilloBruni 2/22/2014 19:00'!
menuCommandOn: aBuilder 
	<worldMenu> 
	(aBuilder item: #'Pharo Tutorials')
			parent: #Help;
			action:[ HelpBrowser openOn: self ]; 
			help: 'Browse and create Pharo tutorials'.! !

!PharoUIThemeIcons commentStamp: 'TorstenBergmann 2/5/2014 10:30'!
Theme icons for Pharo UI!
!PharoUIThemeIcons methodsFor: 'forms' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
radioButtonSelectedForm
	^ self form16x16FromContents: self radioButtonSelectedFormContents! !

!PharoUIThemeIcons methodsFor: 'label-styles' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
windowCloseForm
	^ self form16x16FromContents: self windowCloseFormContents ! !

!PharoUIThemeIcons methodsFor: 'forms' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
checkboxUnselectedForm
	^ self form16x16FromContents: self checkboxUnselectedFormContents 
! !

!PharoUIThemeIcons methodsFor: 'label-styles' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
windowMinimizeForm
	^self form16x16FromContents: self windowMinimizeFormContents ! !

!PharoUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
menuPinFormContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 83886080 100663296 83886080 0 0 0 0 0 0 0 0 0 0 0 0 1291845632 3774873600 4194304000 3774873600 788529152 0 0 0 0 0 0 0 0 0 0 1107296256 4278190080 4278190080 4278190080 4278190080 4278190080 788529152 0 0 0 0 0 0 0 0 83886080 3992977408 4278190080 4278190080 4278190080 4278190080 4278190080 3774873600 83886080 0 0 0 0 0 0 0 100663296 4194304000 4278190080 4278190080 4278190080 4278190080 4278190080 4194304000 100663296 0 0 0 0 0 0 0 83886080 3774873600 4278190080 4278190080 4278190080 4278190080 4278190080 3992977408 83886080 0 0 0 0 0 0 0 0 1291845632 4261412864 4278190080 4278190080 4278190080 4261412864 1107296256 0 0 0 0 0 0 0 0 0 0 1107296256 3992977408 4194304000 3774873600 1291845632 0 0 0 0 0 0 0 0 0 0 0 0 83886080 100663296 83886080 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!PharoUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
checkboxSelectedFormContents
	^#( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 0 0 0 0 0 0 4278190080 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4278190080 0 0 0 0 0 0 4278190080 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4278190080 0 0 0 0 0 0 4278190080 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4278190080 0 0 0 0 0 0 4278190080 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4278190080 0 0 0 0 0 0 4278190080 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4278190080 0 0 0 0 0 0 4278190080 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4278190080 0 0 0 0 0 0 4278190080 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4278190080 0 0 0 0 0 0 4278190080 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4278190080 0 0 0 0 0 0 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!PharoUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
windowMenuInactiveFormContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 360282489 3565191296 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 3565191296 360282489 0 0 0 0 0 0 0 360282489 3565191296 4286611584 4286611584 4286611584 4286611584 3565191296 360282489 0 0 0 0 0 0 0 0 0 360282489 3565191296 4286611584 4286611584 3565191296 360282489 0 0 0 0 0 0 0 0 0 0 0 377520256 3565191296 3565191296 360282489 0 0 0 0 0 0 0 0 0 0 0 0 0 377520256 360282489 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!PharoUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
radioUnselectedFormContents
	^#( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 50331648 0 0 50331648 0 0 0 0 0 0 0 0 0 0 0 1023410176 3238002688 3909091328 3909091328 3238002688 1023410176 0 0 0 0 0 0 0 0 0 2097152000 3976200192 1275068416 452984832 452984832 1275068416 3976200192 872415232 0 0 0 0 0 0 0 1023410176 4278190080 335544320 0 0 0 0 335544320 4278190080 1023410176 0 0 0 0 0 50331648 3238002688 1275068416 0 0 0 0 0 0 1275068416 3238002688 50331648 0 0 0 0 0 3909091328 452984832 0 0 0 0 0 0 452984832 3909091328 0 0 0 0 0 0 3909091328 452984832 0 0 0 0 0 0 452984832 3909091328 0 0 0 0 0 33554432 3238002688 1275068416 0 0 0 0 0 0 1275068416 3238002688 50331648 0 0 0 0 0 1006632960 3992977408 335544320 0 0 0 0 335544320 4278190080 1023410176 0 0 0 0 0 0 0 2097152000 4278190080 1275068416 452984832 452984832 1275068416 3976200192 2097152000 0 0 0 0 0 0 0 0 0 1006632960 3238002688 3909091328 3909091328 3238002688 1023410176 0 0 0 0 0 0 0 0 0 0 0 33554432 0 0 50331648 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: 0@0! !

!PharoUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
radioButtonSelectedFormContents
	^#( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 50331648 0 0 50331648 0 0 0 0 0 0 0 0 0 0 0 1023410176 3422946822 4043572228 4043572228 3422946822 1023410176 0 0 0 0 0 0 0 0 0 2214987270 4161078533 4284045657 4285690482 4285690482 4284045657 4161078533 1058280468 0 0 0 0 0 0 0 1023410176 4278190080 4285887861 4286611584 4286611584 4286611584 4286611584 4285887861 4278190080 1023410176 0 0 0 0 0 50331648 3422946822 4284045657 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4284045657 3422946822 50331648 0 0 0 0 0 4043572228 4285690482 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4285690482 4043572228 0 0 0 0 0 0 4043572228 4285690482 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4285690482 4043572228 0 0 0 0 0 33554432 3422946822 4284045657 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4284045657 3422946822 50331648 0 0 0 0 0 1006632960 4161078533 4285887861 4286611584 4286611584 4286611584 4286611584 4285887861 4278190080 1023410176 0 0 0 0 0 0 0 2214987270 4278190080 4284045657 4285690482 4285690482 4284045657 4161078533 2214987270 0 0 0 0 0 0 0 0 0 1006632960 3422946822 4043572228 4043572228 3422946822 1023410176 0 0 0 0 0 0 0 0 0 0 0 33554432 0 0 50331648 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!PharoUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
radioSelectedFormContents
	^#( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 50331648 0 0 50331648 0 0 0 0 0 0 0 0 0 0 0 1023410176 3422946822 4043572228 4043572228 3422946822 1023410176 0 0 0 0 0 0 0 0 0 2214987270 4161078533 4284045657 4285690482 4285690482 4284045657 4161078533 1058280468 0 0 0 0 0 0 0 1023410176 4278190080 4285887861 4286611584 4286611584 4286611584 4286611584 4285887861 4278190080 1023410176 0 0 0 0 0 50331648 3422946822 4284045657 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4284045657 3422946822 50331648 0 0 0 0 0 4043572228 4285690482 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4285690482 4043572228 0 0 0 0 0 0 4043572228 4285690482 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4285690482 4043572228 0 0 0 0 0 33554432 3422946822 4284045657 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4284045657 3422946822 50331648 0 0 0 0 0 1006632960 4161078533 4285887861 4286611584 4286611584 4286611584 4286611584 4285887861 4278190080 1023410176 0 0 0 0 0 0 0 2214987270 4278190080 4284045657 4285690482 4285690482 4284045657 4161078533 2214987270 0 0 0 0 0 0 0 0 0 1006632960 3422946822 4043572228 4043572228 3422946822 1023410176 0 0 0 0 0 0 0 0 0 0 0 33554432 0 0 50331648 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: 0@0! !

!PharoUIThemeIcons methodsFor: 'forms' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
radioButtonUnselectedForm
	^ self form16x16FromContents: self radioButtonUnselectedFormContents ! !

!PharoUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
windowMaximizeInactiveFormContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 0 0 0 0 0 0 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!PharoUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
windowMenuFormContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 352321536 3556769792 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 3556769792 352321536 0 0 0 0 0 0 0 352321536 3556769792 4278190080 4278190080 4278190080 4278190080 3556769792 352321536 0 0 0 0 0 0 0 0 0 352321536 3556769792 4278190080 4278190080 3556769792 352321536 0 0 0 0 0 0 0 0 0 0 0 369098752 3556769792 3556769792 352321536 0 0 0 0 0 0 0 0 0 0 0 0 0 369098752 352321536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!PharoUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
windowMinimizeInactiveFormContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 0 0 0 0 0 0 0 0 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 4286611584 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!PharoUIThemeIcons methodsFor: 'forms' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
menuPinForm
	^self form16x16FromContents: self menuPinFormContents ! !

!PharoUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
checkboxUnselectedFormContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 4278190080 0 0 0 0 0 0 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!PharoUIThemeIcons methodsFor: 'forms' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
windowMaximizeInactiveForm
	^ self form16x16FromContents: self windowMaximizeInactiveFormContents ! !

!PharoUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
windowCloseInactiveFromContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 176193664 0 0 0 0 0 0 0 0 176193664 3883958400 4085284992 243302528 0 243302528 2927657088 3867181184 0 0 0 0 0 0 0 0 411074688 3682631808 4269834368 3766517888 679049593 3766517888 4269834368 4286611584 343965824 0 0 0 0 0 0 0 0 360282489 3766517888 4152328063 4219436927 4152393856 3766517888 360282489 0 0 0 0 0 0 0 0 0 0 679049593 4219436927 4269834368 4219436927 679049593 0 0 0 0 0 0 0 0 0 0 360282489 3766517888 4152393856 4219436927 4152328063 3766517888 360282489 0 0 0 0 0 0 0 0 343965824 4286611584 4253057152 3766517888 679049593 3766517888 4152328063 3732963456 411074688 0 0 0 0 0 0 0 0 3900735616 2927657088 243302528 0 243302528 4286611584 1769897598 176193664 0 0 0 0 0 0 0 0 176193664 75530368 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!PharoUIThemeIcons methodsFor: 'forms' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
windowCloseInactiveForm
	^ self form16x16FromContents: self windowCloseInactiveFromContents ! !

!PharoUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
form16x16FromContents: aByteArray 
	^ Form
	extent: 16@16
	depth: 32
	fromArray: aByteArray 
	offset: 0@0! !

!PharoUIThemeIcons methodsFor: 'label-styles' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
windowMaximizeForm
	^ self form16x16FromContents: self windowMaximizeFormContents ! !

!PharoUIThemeIcons methodsFor: 'label-styles' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
checkboxMarkerForm
	"Answer a new radio button marker form. We make it empty because we already have the selected radio button take care of the state."

	^Form extent: 12@12 depth: 32! !

!PharoUIThemeIcons methodsFor: 'forms' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
radioSelectedForm
	^ Form fromBinaryStream: ( Base64MimeConverter mimeDecodeToBytes: self radioSelectedFormContents readStream)
 ! !

!PharoUIThemeIcons methodsFor: 'label-styles' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
windowMenuForm
	^self form16x16FromContents: self windowMenuFormContents ! !

!PharoUIThemeIcons methodsFor: 'forms' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
radioUnselectedForm
	^ Form fromBinaryStream: ( Base64MimeConverter mimeDecodeToBytes: self radioUnselectedFormContents readStream)
 ! !

!PharoUIThemeIcons methodsFor: 'forms' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
checkboxSelectedForm
	^ self form16x16FromContents: self checkboxSelectedFormContents 
! !

!PharoUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
radioButtonUnselectedFormContents
	^#( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 50331648 0 0 50331648 0 0 0 0 0 0 0 0 0 0 0 1023410176 3238002688 3909091328 3909091328 3238002688 1023410176 0 0 0 0 0 0 0 0 0 2097152000 3976200192 1275068416 452984832 452984832 1275068416 3976200192 872415232 0 0 0 0 0 0 0 1023410176 4278190080 335544320 0 0 0 0 335544320 4278190080 1023410176 0 0 0 0 0 50331648 3238002688 1275068416 0 0 0 0 0 0 1275068416 3238002688 50331648 0 0 0 0 0 3909091328 452984832 0 0 0 0 0 0 452984832 3909091328 0 0 0 0 0 0 3909091328 452984832 0 0 0 0 0 0 452984832 3909091328 0 0 0 0 0 33554432 3238002688 1275068416 0 0 0 0 0 0 1275068416 3238002688 50331648 0 0 0 0 0 1006632960 3992977408 335544320 0 0 0 0 335544320 4278190080 1023410176 0 0 0 0 0 0 0 2097152000 4278190080 1275068416 452984832 452984832 1275068416 3976200192 2097152000 0 0 0 0 0 0 0 0 0 1006632960 3238002688 3909091328 3909091328 3238002688 1023410176 0 0 0 0 0 0 0 0 0 0 0 33554432 0 0 50331648 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!PharoUIThemeIcons methodsFor: 'label-styles' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
radioButtonMarkerForm
	"Answer a new radio button marker form. We make it empty because we already have the selected radio button take care of the state."

	^Form extent: 12@12 depth: 32! !

!PharoUIThemeIcons methodsFor: 'forms' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
windowMenuInactiveForm
	^self form16x16FromContents: self windowMenuInactiveFormContents ! !

!PharoUIThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
windowMinimizeFormContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 0 0 0 0 0 0 0 0 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!PharoUIThemeIcons methodsFor: 'forms' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
windowMinimizeInactiveForm
	^self form16x16FromContents: self windowMinimizeInactiveFormContents ! !

!PharoUIThemeIcons class methodsFor: 'private - icons' stamp: 'EstebanLorenzano 5/9/2013 19:34'!
radioButtonSelectedForm
	^ self current radioButtonSelectedForm.! !

!PharoUIThemeIcons class methodsFor: 'private - icons' stamp: 'EstebanLorenzano 5/9/2013 19:34'!
windowCloseForm
	^ self current windowCloseForm.! !

!PharoUIThemeIcons class methodsFor: 'private - icons' stamp: 'EstebanLorenzano 5/9/2013 19:34'!
checkboxUnselectedForm
	^ self current checkboxUnselectedForm.! !

!PharoUIThemeIcons class methodsFor: 'private - icons' stamp: 'EstebanLorenzano 5/9/2013 19:34'!
windowMinimizeForm
	^ self current windowMinimizeForm.! !

!PharoUIThemeIcons class methodsFor: 'private - icons' stamp: 'EstebanLorenzano 5/9/2013 19:34'!
windowMaximizeInactiveForm
	^ self current windowMaximizeInactiveForm.! !

!PharoUIThemeIcons class methodsFor: 'testing' stamp: 'EstebanLorenzano 10/17/2013 13:34'!
isAbstract 
	^ self ~= PharoUIThemeIcons! !

!PharoUIThemeIcons class methodsFor: 'private - icons' stamp: 'EstebanLorenzano 5/9/2013 19:34'!
windowCloseInactiveForm
	^ self current windowCloseInactiveForm.! !

!PharoUIThemeIcons class methodsFor: 'private - icons' stamp: 'EstebanLorenzano 5/9/2013 19:34'!
windowMaximizeForm
	^ self current windowMaximizeForm.! !

!PharoUIThemeIcons class methodsFor: 'private - icons' stamp: 'EstebanLorenzano 5/9/2013 19:34'!
radioButtonUnselectedForm
	^ self current radioButtonUnselectedForm.! !

!PharoUIThemeIcons class methodsFor: 'private - icons' stamp: 'EstebanLorenzano 5/9/2013 19:34'!
checkboxMarkerForm
	^ self current checkboxMarkerForm.! !

!PharoUIThemeIcons class methodsFor: 'private - icons' stamp: 'EstebanLorenzano 5/9/2013 19:34'!
windowMenuInactiveForm
	^ self current windowMenuInactiveForm.! !

!PharoUIThemeIcons class methodsFor: 'private - icons' stamp: 'EstebanLorenzano 5/9/2013 19:34'!
radioSelectedForm
	^ self current radioSelectedForm.! !

!PharoUIThemeIcons class methodsFor: 'private - icons' stamp: 'EstebanLorenzano 5/9/2013 19:34'!
radioUnselectedForm
	^ self current radioUnselectedForm.! !

!PharoUIThemeIcons class methodsFor: 'private - icons' stamp: 'EstebanLorenzano 5/9/2013 19:34'!
windowMenuForm
	^ self current windowMenuForm.! !

!PharoUIThemeIcons class methodsFor: 'private - icons' stamp: 'EstebanLorenzano 5/9/2013 19:34'!
checkboxSelectedForm
	^ self current checkboxSelectedForm.! !

!PharoUIThemeIcons class methodsFor: 'private - icons' stamp: 'EstebanLorenzano 5/9/2013 19:34'!
radioButtonMarkerForm
	^ self current radioButtonMarkerForm.! !

!PharoUIThemeIcons class methodsFor: 'private - icons' stamp: 'EstebanLorenzano 5/9/2013 19:34'!
windowMinimizeInactiveForm
	^ self current windowMinimizeInactiveForm.! !

!PharoUIThemeIcons class methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/17/2013 13:33'!
iconSetName 
	^ 'FamFamFam'! !

!PharoUIThemeIcons class methodsFor: 'private - icons' stamp: 'EstebanLorenzano 5/9/2013 19:34'!
menuPinForm
	^ self current menuPinForm.! !

!PharoUser commentStamp: '<historical>'!
A PharoUser is a simple object with a username and an avatar.

It also works as a factory to keep already generated instances!
!PharoUser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/11/2012 16:40'!
unlockedKeychain

	^ unlockedKeychain! !

!PharoUser methodsFor: 'permission' stamp: 'jeanbaptistearnaud 8/5/2014 09:56'!
canRunStartupScript
	^self permissions canRunStartupScript
	
	! !

!PharoUser methodsFor: 'accessing' stamp: 'PavelKrivanek 7/8/2014 15:45'!
avatar

	^ avatar! !

!PharoUser methodsFor: 'protocol-forward' stamp: 'BenjaminVanRyseghem 5/11/2012 16:40'!
userNameFor: aGroup

	^ self unlockedKeychain userNameFor: aGroup ! !

!PharoUser methodsFor: 'protocol-forward' stamp: 'BenjaminVanRyseghem 5/9/2012 16:11'!
setPassword: aString

	^ self keychain setPassword: aString ! !

!PharoUser methodsFor: 'protocol-forward' stamp: 'BenjaminVanRyseghem 5/9/2012 16:11'!
userNamePasswordFor: aGroup

	^ self keychain userNamePasswordFor: aGroup ! !

!PharoUser methodsFor: 'permission' stamp: 'jeanbaptistearnaud 8/5/2014 09:56'!
canEditUser
	^self permissions canEditUser
	
	
	! !

!PharoUser methodsFor: 'permission' stamp: 'jeanbaptistearnaud 8/5/2014 09:55'!
canInspect
	^self permissions canInspect
	
	
! !

!PharoUser methodsFor: 'permission' stamp: 'jeanbaptistearnaud 8/5/2014 09:56'!
canSaveImage
	^self permissions canSaveImage
	
	! !

!PharoUser methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/20/2012 03:25'!
lock

	^ keychain lock! !

!PharoUser methodsFor: 'error handling' stamp: 'BenjaminVanRyseghem 5/16/2012 15:04'!
doesNotUnderstand: aMessage

	^ [ self permissions perform: aMessage selector withEnoughArguments: aMessage arguments ] 
		on: MessageNotUnderstood 
		do: [ super doesNotUnderstand: aMessage ]! !

!PharoUser methodsFor: 'initialization' stamp: 'MarcusDenker 9/11/2013 13:52'!
initialize
	super initialize.

	avatar := self defaultAvatar.
	keychain := KeyChain new.
	unlockedKeychain := UnlockedKeyChain new.! !

!PharoUser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/9/2012 13:55'!
username: anObject
	username := anObject! !

!PharoUser methodsFor: 'accessing' stamp: 'PavelKrivanek 7/8/2014 15:45'!
avatar: anUrl

	avatar := anUrl! !

!PharoUser methodsFor: 'printing' stamp: 'BenjaminVanRyseghem 5/9/2012 14:03'!
printOn: aStream

	super printOn: aStream.
	aStream nextPut: $(.
	username printOn: aStream.
	aStream nextPut: $)! !

!PharoUser methodsFor: 'protocol-forward' stamp: 'BenjaminVanRyseghem 5/9/2012 16:11'!
setUserName: user password: pass forGroup: group

	^ self keychain setUserName: user password: pass forGroup: group! !

!PharoUser methodsFor: 'protocol-forward' stamp: 'BenjaminVanRyseghem 5/11/2012 16:40'!
setUserName: user forGroup: group

	^ self unlockedKeychain 
			setUserName: user 
			forGroup: group! !

!PharoUser methodsFor: 'accessing' stamp: 'PavelKrivanek 7/8/2014 15:44'!
defaultAvatar

	^ 'http://pharo.org/files/faces/noface.png'! !

!PharoUser methodsFor: 'permission' stamp: 'jeanbaptistearnaud 8/5/2014 09:55'!
canBrowse
	^self permissions canBrowse
	! !

!PharoUser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/9/2012 16:11'!
keychain

	^ keychain! !

!PharoUser methodsFor: 'permission' stamp: 'jeanbaptistearnaud 8/5/2014 09:55'!
canDropOSFile
	^self permissions canDropOSFile
	
! !

!PharoUser methodsFor: 'permission' stamp: 'jeanbaptistearnaud 8/5/2014 09:55'!
canEditCode
	^self permissions canEditCode
	
	! !

!PharoUser methodsFor: 'permission' stamp: 'jeanbaptistearnaud 8/5/2014 09:55'!
canEvaluateCode
	^self permissions canEvaluateCode
	
	! !

!PharoUser methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/11/2012 16:37'!
unlock

	^ keychain unlock! !

!PharoUser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/9/2012 13:55'!
username
	^ username! !

!PharoUser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/16/2012 15:02'!
permissions

	^ permissions ifNil: [ permissions := PharoUserPermissions new ]! !

!PharoUser methodsFor: 'permission' stamp: 'jeanbaptistearnaud 8/5/2014 09:56'!
canShowMorphHalo
	^self permissions canShowMorphHalo! !

!PharoUser methodsFor: 'permission' stamp: 'jeanbaptistearnaud 8/5/2014 09:55'!
canDebug
	^self permissions canDebug
	
	! !

!PharoUser class methodsFor: 'instance creation' stamp: 'PavelKrivanek 7/13/2014 13:44'!
username: username

	^ UserManager default users
		detect: [:e | e username = username ] 
		ifNone: [	
			self new
				username: username;
				yourself ]! !

!PharoUserPermissions commentStamp: '<historical>'!
A PharoUserPermissions is a wrapper which stores the permissions of a PharoUser!
!PharoUserPermissions methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/21/2012 11:35'!
canBrowse: anObject
	canBrowse := anObject! !

!PharoUserPermissions methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/21/2012 11:35'!
canDebug: anObject
	canDebug := anObject! !

!PharoUserPermissions methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/21/2012 11:35'!
canRunStartupScript
	^ canRunStartupScript! !

!PharoUserPermissions methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/21/2012 11:35'!
canBrowse
	^ canBrowse! !

!PharoUserPermissions methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/21/2012 11:35'!
canEditCode
	^ canEditCode! !

!PharoUserPermissions methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/21/2012 11:35'!
canDropOSFile
	^ canDropOSFile! !

!PharoUserPermissions methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/21/2012 11:35'!
canEditCode: anObject
	canEditCode := anObject! !

!PharoUserPermissions methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/21/2012 11:35'!
canEvaluateCode
	^ canEvaluateCode! !

!PharoUserPermissions methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/21/2012 11:35'!
canInspect
	^ canInspect! !

!PharoUserPermissions methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/21/2012 13:50'!
canEditUser

	^ canEditUser! !

!PharoUserPermissions methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/21/2012 11:35'!
canShowMorphHalo: anObject
	canShowMorphHalo := anObject! !

!PharoUserPermissions methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 1/24/2014 11:54'!
isRoot: aBoolean

	canBrowse := aBoolean.
	canDebug := aBoolean.
	canDropOSFile := aBoolean.
	canEditCode := aBoolean.
	canEvaluateCode := aBoolean.
	canInspect := aBoolean.
	canRunStartupScript := aBoolean.
	canShowMorphHalo := aBoolean.
	canEditUser := aBoolean.
	canSaveImage := aBoolean.! !

!PharoUserPermissions methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/7/2013 18:57'!
canSaveImage
	^ canSaveImage! !

!PharoUserPermissions methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/21/2012 11:35'!
canEvaluateCode: anObject
	canEvaluateCode := anObject! !

!PharoUserPermissions methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/21/2012 13:50'!
canEditUser: anObject
	canEditUser := anObject! !

!PharoUserPermissions methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 23:06'!
initialize

	super initialize.

	canBrowse := false.
	canDebug := false.
	canDropOSFile := false.
	canEditCode := false.
	canEvaluateCode := false.
	canInspect := false.
	canRunStartupScript := false.
	canShowMorphHalo := false.
	canEditUser := false.
	canSaveImage := false.! !

!PharoUserPermissions methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/7/2013 18:57'!
canSaveImage: anObject
	canSaveImage := anObject! !

!PharoUserPermissions methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/21/2012 11:35'!
canRunStartupScript: anObject
	canRunStartupScript := anObject! !

!PharoUserPermissions methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/21/2012 11:35'!
canShowMorphHalo
	^ canShowMorphHalo! !

!PharoUserPermissions methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/21/2012 11:35'!
canDebug
	^ canDebug! !

!PharoUserPermissions methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/21/2012 11:35'!
canDropOSFile: anObject
	canDropOSFile := anObject! !

!PharoUserPermissions methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/21/2012 11:35'!
canInspect: anObject
	canInspect := anObject! !

!PharoUserPermissionsTest commentStamp: 'jeromegarcia 10/21/2014 17:34'!
A PharoUserPermissionsTest is all tests about PharoUserPermission.
!
!PharoUserPermissionsTest methodsFor: 'tests' stamp: 'jeromegarcia 10/16/2014 17:39'!
testCanSaveImage
	| user |
	
	user:= PharoUser username:'user'.
	
	self deny: user canSaveImage.
	
	user canSaveImage:true.
	
	self assert: user canSaveImage.! !

!PharoUserPermissionsTest methodsFor: 'tests' stamp: 'jeromegarcia 10/16/2014 17:38'!
testCanEditUser
	| user |
	
	user:= PharoUser username:'user'.
	
	self deny: user canEditUser.
	
	user canEditUser:true.
	
	self assert: user canEditUser.! !

!PharoUserPermissionsTest methodsFor: 'tests' stamp: 'jeromegarcia 10/16/2014 17:39'!
testCanRunStartupScript
	| user |
	
	user:= PharoUser username:'user'.
	
	self deny: user canRunStartupScript.
	
	user canRunStartupScript:true.
	
	self assert: user canRunStartupScript.! !

!PharoUserPermissionsTest methodsFor: 'tests' stamp: 'jeromegarcia 10/16/2014 17:38'!
testCanEvaluateCode
	| user |
	
	user:= PharoUser username:'user'.
	
	self deny: user canEvaluateCode.
	
	user canEvaluateCode:true.
	
	self assert: user canEvaluateCode.! !

!PharoUserPermissionsTest methodsFor: 'tests' stamp: 'jeromegarcia 10/16/2014 17:41'!
testIsRoot
	| user |
	
	user:= PharoUser username:'user'.
	
	self deny: user canBrowse.
	self deny: user canDebug.
	self deny: user canDropOSFile.
	self deny: user canEditCode.
	self deny: user canEditUser.
	self deny: user canEvaluateCode.
	self deny: user canInspect.
	self deny: user canRunStartupScript.
	self deny: user canSaveImage.
	self deny: user canShowMorphHalo.
	
	user isRoot:true.
	
	self assert: user canBrowse.
	self assert: user canDebug.
	self assert: user canDropOSFile.
	self assert: user canEditCode.
	self assert: user canEditUser.
	self assert: user canEvaluateCode.
	self assert: user canInspect.
	self assert: user canRunStartupScript.
	self assert: user canSaveImage.
	self assert: user canShowMorphHalo.! !

!PharoUserPermissionsTest methodsFor: 'tests' stamp: 'jeromegarcia 10/16/2014 17:37'!
testCanDebug
	| user |
	
	user:= PharoUser username:'user'.
	
	self deny: user canDebug.
	
	user canDebug:true.
	
	self assert: user canDebug.! !

!PharoUserPermissionsTest methodsFor: 'tests' stamp: 'jeromegarcia 10/16/2014 17:37'!
testCanDropOSFile
	| user |
	
	user:= PharoUser username:'user'.
	
	self deny: user canDropOSFile.
	
	user canDropOSFile:true.
	
	self assert: user canDropOSFile.! !

!PharoUserPermissionsTest methodsFor: 'tests' stamp: 'jeromegarcia 10/16/2014 17:39'!
testCanShowMorphHalo
	| user |
	
	user:= PharoUser username:'user'.
	
	self deny: user canShowMorphHalo.
	
	user canShowMorphHalo:true.
	
	self assert: user canShowMorphHalo.! !

!PharoUserPermissionsTest methodsFor: 'tests' stamp: 'jeromegarcia 10/16/2014 17:35'!
testCanBrowse
	| user |
	user := PharoUser username: 'user'.
	
	self deny: user canBrowse.
	
	user canBrowse:true.
	
	self assert: user canBrowse.! !

!PharoUserPermissionsTest methodsFor: 'tests' stamp: 'jeromegarcia 10/16/2014 17:38'!
testCanInspect
	| user |
	
	user:= PharoUser username:'user'.
	
	self deny: user canInspect.
	
	user canInspect:true.
	
	self assert: user canInspect.! !

!PharoUserPermissionsTest methodsFor: 'tests' stamp: 'jeromegarcia 10/16/2014 17:37'!
testCanEditCode
	| user |
	
	user:= PharoUser username:'user'.
	
	self deny: user canEditCode.
	
	user canEditCode:true.
	
	self assert: user canEditCode.! !

!PharoUserTest commentStamp: 'jeromegarcia 10/21/2014 17:34'!
A PharoUserTest is all tests about PhraroUser.
!
!PharoUserTest methodsFor: 'tests' stamp: 'jeromegarcia 10/16/2014 17:41'!
testUsername
	| user |
	user := PharoUser username: 'user'.
	
	self assert: user username equals: 'user'.! !

!PickListModel commentStamp: '<historical>'!
A PickList is a tick list done using spec.!
!PickListModel methodsFor: 'api' stamp: ''!
resetSelection

	listModel resetSelection! !

!PickListModel methodsFor: 'api' stamp: ''!
itemFor: aCheckbox

	^ associationsWrapperToItem at: aCheckbox ifAbsent: [ nil ]! !

!PickListModel methodsFor: 'api-events' stamp: 'johanfabry 3/11/2015 16:04'!
whenSelectionChanged: aBlock

	"The method should be used only if you are interested in the fact that there was a change, without caring about what has changed
	If you are interested in the items, use whenSelectedItemChanged:
	If you are interested in the index, use whenSelectionIndexChanged:"

	listModel whenSelectionChanged: aBlock.! !

!PickListModel methodsFor: 'api' stamp: 'CamilloBruni 10/8/2012 21:56'!
setSelectedIndex: anIndex

	listModel setSelectedIndex: anIndex! !

!PickListModel methodsFor: 'accessing' stamp: ''!
listModel

	^ listModel! !

!PickListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
labelClickable
	
	^ labelClickableHolder value! !

!PickListModel methodsFor: 'accessing' stamp: ''!
wrapHolder

	^ wrapHolder! !

!PickListModel methodsFor: 'initialization' stamp: 'DucasseStephane 9/10/2014 09:59'!
initialize

	wrapHolder := [ :i | i printString ] asValueHolder. 
	pickedItemsHolder := OrderedCollection new asValueHolder.
	associationsWrapperToItem := Dictionary new asValueHolder.
	associationsItemToWrapper := Dictionary new asValueHolder.
	associationsIndexToWrapper := Dictionary new asValueHolder.
	labelClickableHolder := true asValueHolder.
	defaultValueHolder := false asValueHolder.
	blockToPerformOnWrappers := [:wrapper | ] asValueHolder.
	
	super initialize.! !

!PickListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 2/22/2013 00:25'!
indexFor: aCheckbox

	^ listModel listItems indexOf: aCheckbox.! !

!PickListModel methodsFor: 'initialization' stamp: 'CamilloBruni 10/8/2012 22:23'!
initializePresenter
	
	labelClickableHolder whenChangedDo: [:aBoolean | 
		associationsWrapperToItem keys do: [:e | e labelClickable: aBoolean ]].

	defaultValueHolder whenChangedDo: [:value | associationsWrapperToItem keysDo: [:cb | cb state: value ]].! !

!PickListModel methodsFor: 'api' stamp: ''!
checkboxFor: anItem

	^ associationsItemToWrapper at: anItem ifAbsent: [ nil ]! !

!PickListModel methodsFor: 'api-events' stamp: 'bvr 5/31/2012 13:34'!
whenListChanged: aBlock

	listModel whenListChanged: aBlock! !

!PickListModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
wrap: item at: index
	| checkBox |

	associationsIndexToWrapper 
		at: index
		ifPresent: [:cb | ^ cb ].

	checkBox := self instantiate: CheckBoxModel.
	blockToPerformOnWrappers value value: checkBox.
	checkBox label: (wrapHolder value cull: item cull: self).
	
	checkBox whenActivatedDo: [ 
		self addPicked: item.
		listModel setSelectedItem: checkBox.
		listModel takeKeyboardFocus ].
	
	checkBox whenDesactivatedDo: [ 
		self removePicked: item.
		listModel setSelectedItem: checkBox.
		listModel takeKeyboardFocus ].
	
	checkBox 
		state: self defaultValue;
		labelClickable: self labelClickable.
		
	associationsWrapperToItem at: checkBox put: item.
	associationsItemToWrapper at: item put: checkBox.
	associationsIndexToWrapper at: index put: checkBox.
	^ checkBox! !

!PickListModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 10/17/2013 16:46'!
addPicked: item

	pickedItemsHolder add: item.
	pickedItemsHolder valueChanged: true to: item.! !

!PickListModel methodsFor: 'api' stamp: ''!
selectedItem

	^ associationsWrapperToItem 
		at: listModel selectedItem
		ifAbsent: [ nil ]! !

!PickListModel methodsFor: 'api-events' stamp: 'bvr 5/31/2012 13:34'!
whenSelectedItemChanged: aBlock
	| newBlock |
	
	newBlock := [ :item | aBlock cull: (associationsWrapperToItem at: item ifAbsent: [ nil ])].
	listModel whenSelectedItemChanged: newBlock! !

!PickListModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
blockToPerformOnWrappers

	^ blockToPerformOnWrappers value! !

!PickListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 2/21/2013 23:45'!
wrappers

	^ associationsWrapperToItem keys! !

!PickListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
defaultValue

	^ defaultValueHolder value! !

!PickListModel methodsFor: 'api' stamp: ''!
selectedIndex

	^ listModel selectedIndex! !

!PickListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
pickedItems
	"Returns the selected items according to the order they have been picked"
	
	^ pickedItemsHolder value! !

!PickListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
labelClickable: aBoolean

	labelClickableHolder value: aBoolean! !

!PickListModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 1/24/2013 14:18'!
removePicked: item

	pickedItemsHolder remove: item ifAbsent: [ ^ self ].! !

!PickListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
defaultValue: aBoolean

	defaultValueHolder value: aBoolean! !

!PickListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
displayBlock: aBlock

	wrapHolder value: aBlock! !

!PickListModel methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 9/25/2013 18:24'!
initializeWidgets
	
	self instantiateModels: #( listModel #ListModel ).
	listModel displayBlock: [ :item | item ].
	self focusOrder add: listModel! !

!PickListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 2/6/2013 19:06'!
selectedItems
	"Returns the selected items according to the list order"
	| wrappers items |
	
	wrappers := listModel listItems.
	items := wrappers collect: [:e || value |
		value := associationsWrapperToItem at: e ifAbsent: [ nil ].
		(value isNil or: [ e state not ])
			ifTrue: [ nil ]
			ifFalse: [ value ]] thenSelect: [ :e | e notNil ].
	^ items! !

!PickListModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 1/24/2013 14:18'!
items: aCollection

	associationsWrapperToItem removeAll.
	pickedItemsHolder removeAll.
	listModel items: (aCollection collectWithIndex: [:e :i | self wrap: e at: i ]).! !

!PickListModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
blockToPerformOnWrappers: aBlock

	blockToPerformOnWrappers value: aBlock! !

!PickListModel methodsFor: 'api-events' stamp: 'bvr 5/31/2012 13:34'!
whenSelectionIndexChanged: aBlock

	listModel whenSelectionIndexChanged: aBlock! !

!PickListModel methodsFor: 'api-events' stamp: 'bvr 5/31/2012 13:34'!
whenPickedItemsChanged: aBlock

	pickedItemsHolder whenChangedDo: aBlock! !

!PickListModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 6/12/2012 18:32'!
defaultSpec
	<spec>
	
	^ SpecLayout composed 
		add: #listModel;
		yourself! !

!PickListModel class methodsFor: 'example' stamp: ''!
example
	"self example"
	| instance |
	
	instance := self new.
	instance openWithSpec.
	instance items: { {1. 2. 4}. 'Foo'. 123}! !

!PickListModel class methodsFor: 'specs' stamp: ''!
title

	^ 'Pick List Example'! !

!PickOneSettingDeclaration commentStamp: 'AlainPlantec 1/3/2011 10:53'!
A CheckListSettingDeclaration is a setting for which the value domain is a list. Each element of the list is an instance of FixedSettingValue. If domainValues is set, then the list of valid values is constant (initialized at declaration time). Instead, if getter is set, then the setting list is always dynamically computed. See SettingManager comment for more explanations. 

Instance Variables
!
!PickOneSettingDeclaration methodsFor: 'user interface' stamp: 'AlainPlantec 9/3/2010 11:19'!
defaultValue
	^ self default value ifNil: [self domainValues first realValue]
! !

!PickOneSettingDeclaration methodsFor: 'user interface' stamp: 'FernandoOlivero 4/12/2011 10:11'!
inputWidget
	| widget row |
	row := self theme newRowIn: World for: {
				widget := (self theme 
						newDropListIn: World
						for: self
						list: #domainValuesLabels
						getSelected: #index
						setSelected: #index:
						getEnabled: #enabled
						useIndex: true
						help: self description)
						extent: 1 @ 30}.
	widget hResizing: #rigid.
	widget width: (self maxNameWidthForFont: widget font) + 50.
	^ row! !

!PickOneSettingDeclaration methodsFor: 'user interface' stamp: 'AlainPlantec 11/30/2009 14:23'!
chooseValue
	| chosen |
	chosen := UIManager default
				chooseFrom: self domainValuesLabels
				values: self domainValues
				title: self label translated, ' choices' translated.
	chosen
		ifNotNil: [self realValue: chosen realValue]! !

!PickOneSettingDeclaration methodsFor: 'user interface' stamp: 'alain.plantec 10/17/2009 23:47'!
content
	^ (self domainValues
		detect: [:v | v realValue = self realValue]
		ifNone: [^ 'nil']) name! !

!PickOneSettingDeclaration methodsFor: 'user interface' stamp: 'alain.plantec 10/17/2009 23:39'!
index: anInteger
	self realValue: (self domainValues at: anInteger) realValue.
! !

!PickOneSettingDeclaration methodsFor: 'user interface' stamp: 'alain.plantec 10/17/2009 23:44'!
index
	self realValue ifNil: [self realValue: self default].
	^ self domainValues indexOf: (self domainValues detect: [:dv | dv realValue = self realValue] ifNone: [^ 0])! !

!PlainGroupboxMorph commentStamp: 'gvc 5/18/2007 12:36'!
Groupbox without title with a vertical layout. Appears in a lighter colour than the owner's pane colour.!
!PlainGroupboxMorph methodsFor: 'accessing' stamp: 'gvc 1/17/2008 11:45'!
adoptPaneColor: paneColor
	"Change our color too."
	
	super adoptPaneColor: (self theme subgroupColorFrom: paneColor).
	self borderStyle: (self theme plainGroupPanelBorderStyleFor: self)! !

!PlainGroupboxMorph methodsFor: 'initialization' stamp: 'StephaneDucasse 9/7/2013 12:39'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		borderStyle: (self theme plainGroupPanelBorderStyleFor: self);
		changeTableLayout; 
		layoutInset: 4;
		cellInset: 8;
		vResizing: #spaceFill;
		hResizing: #spaceFill! !

!PlainGroupboxMorph methodsFor: 'accessing' stamp: 'MarcusDenker 12/11/2009 07:41'!
paneColorOrNil
	"Answer the window's pane color or nil otherwise."

	^super paneColorOrNil ifNotNil: [:c | self theme subgroupColorFrom: c]! !

!PlatformIndependentEnvironment commentStamp: 'EstebanLorenzano 1/24/2014 16:41'!
I'm a platform independent environment who is intent to work when none other works. 
Specially, I'm intended to work as a replacement for environments when there is no NativeBoost present, therefore I provide stubs for method calls that answers just default values. 
!
!PlatformIndependentEnvironment methodsFor: 'private' stamp: 'EstebanLorenzano 1/24/2014 16:36'!
getEnv: aVariableName
	^ nil! !

!PlatformIndependentEnvironment methodsFor: 'enumeration' stamp: 'EstebanLorenzano 1/24/2014 16:36'!
keysAndValuesDo: aBlock
	"Do nothing"! !

!PlatformIndependentEnvironment methodsFor: 'private' stamp: 'EstebanLorenzano 1/24/2014 16:37'!
unsetEnv: aString
	^ self setEnv: aString value: nil! !

!PlatformIndependentEnvironment methodsFor: 'private' stamp: 'EstebanLorenzano 1/24/2014 16:37'!
setEnv: nameString value: valueString
	"Do nothing"! !

!PlatformIndependentEnvironment class methodsFor: 'testing' stamp: 'EstebanLorenzano 1/24/2014 16:40'!
isAvailable 
	^ true! !

!PlatformIndependentEnvironment class methodsFor: 'testing' stamp: 'EstebanLorenzano 1/24/2014 16:40'!
isDefaultFor: aPlatform 
	^ false! !

!PlatformResolver commentStamp: 'cwp 11/18/2009 11:56'!
I am an abstract superclass for platform-specific resolvers.!
!PlatformResolver methodsFor: 'origins' stamp: 'CamilloBruni 5/24/2012 12:07'!
preferences
	^ self subclassResponsibility! !

!PlatformResolver methodsFor: 'private' stamp: 'EstebanLorenzano 3/10/2015 15:27'!
directoryFromEnvVariableNamed: aString or: aBlock
	| envValue |
	envValue := [ Smalltalk os environment at: aString ifAbsent: [ nil ] ]
		on: Error
		do: [ ^ aBlock value ].
	^ envValue isEmptyOrNil
		ifTrue: [ aBlock value ]
		ifFalse: [ self resolveString: envValue ]! !

!PlatformResolver methodsFor: 'origins' stamp: 'cwp 10/27/2009 21:01'!
home
	^ self subclassResponsibility! !

!PlatformResolver methodsFor: 'origins' stamp: 'DamienCassou 6/28/2013 14:40'!
cache
	"Operating Systems often define standard locations for a personal cache directory. The cache directory is a user-specific non-essential (cached) place where data should be written."
	self subclassResponsibility! !

!PlatformResolver methodsFor: 'origins' stamp: 'lr 7/13/2010 15:35'!
desktop
	^ self subclassResponsibility! !

!PlatformResolver methodsFor: 'origins' stamp: 'DamienCassou 12/20/2013 11:50'!
temp
	"Where to put files that are not supposed to last long"
	^ self subclassResponsibility ! !

!PlatformResolver methodsFor: 'origins' stamp: 'lr 7/13/2010 15:35'!
documents
	^ self subclassResponsibility! !

!PlatformResolver methodsFor: 'resolving' stamp: 'DamienCassou 12/20/2013 11:51'!
supportedOrigins
	^ #(home desktop documents preferences cache temp)! !

!PlatformResolver methodsFor: 'private' stamp: 'DamienCassou 7/4/2013 15:44'!
cantFindOriginError
	^ Error signal: 'Can''t find the requested origin' ! !

!PlatformResolver methodsFor: 'private' stamp: 'DamienCassou 7/4/2013 15:47'!
directoryFromEnvVariableNamed: aString
	^ self directoryFromEnvVariableNamed: aString or: [ self cantFindOriginError ]! !

!PlatformResolver class methodsFor: 'private' stamp: 'CamilloBruni 8/12/2011 17:36'!
primitiveGetUntrustedUserDirectory
	<primitive: 'primitiveGetUntrustedUserDirectory' module: 'SecurityPlugin'>
	self primitiveFailed.
	self flag: 'use a more decent way to get a path in the users home directory'.! !

!PlatformResolver class methodsFor: 'accessing' stamp: 'cwp 10/27/2009 10:58'!
platformName
	^ nil! !

!PlatformResolver class methodsFor: 'instance creation' stamp: 'tg 11/8/2010 19:05'!
forCurrentPlatform
	| platformName |
	platformName :=  Smalltalk os platformName.
	^ (self allSubclasses detect: [:ea | ea platformName = platformName]) new! !

!PlatformResolverTest commentStamp: 'TorstenBergmann 1/31/2014 11:36'!
SUnit tests for PlatformResolver!
!PlatformResolverTest methodsFor: 'tests' stamp: 'DamienCassou 6/28/2013 14:38'!
testCache
	| cache |
	cache := self assertOriginResolves: #cache! !

!PlatformResolverTest methodsFor: 'running' stamp: 'EstebanLorenzano 4/2/2012 11:39'!
createResolver
	^ PlatformResolver forCurrentPlatform! !

!PlatformResolverTest methodsFor: 'tests' stamp: 'DamienCassou 6/28/2013 14:35'!
testHome
	| home |
	home := self assertOriginResolves: #home.
	self assert: home isDirectory! !

!PluggableButtonMorph commentStamp: '<historical>'!
A PluggableButtonMorph is a combination of an indicator for a boolean value stored in its model and an action button. The action of a button is often, but not always, to toggle the boolean value that it shows. Its pluggable selectors are:

		getStateSelector		fetch a boolean value from the model
		actionSelector		invoke this button's action on the model
		getLabelSelector		fetch this button's lable from the model
		getMenuSelector		fetch a pop-up menu for this button from the model

Any of the above selectors can be nil, meaning that the model does not supply behavior for the given action, and the default behavior should be used. For example, if getStateSelector is nil, then this button shows the state of a read-only boolean that is always false.

The model informs its view(s) of changes by sending #changed: to itself with getStateSelector as a parameter. The view tells the model when the button is pressed by sending actionSelector.

If the actionSelector takes one or more arguments, then the following are relevant:
		arguments			A list of arguments to provide when the actionSelector is called.
		argumentsProvider	The object that is sent the argumentSelector to obtain arguments, if dynamic
		argumentsSelector	The message sent to the argumentProvider to obtain the arguments.

Options:
	askBeforeChanging		have model ask user before allowing a change that could lose edits
	triggerOnMouseDown	do this button's action on mouse down (vs. up) transition
	shortcutCharacter		a place to record an optional shortcut key
!
!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 1/19/2007 13:04'!
contentHolder
	"Answer the alignment morph for extra control."

	^self submorphs first! !

!PluggableButtonMorph methodsFor: 'style' stamp: 'gvc 7/30/2007 15:54'!
selectedFillStyle
	"Return the selected fillStyle of the receiver."
	
	^self theme buttonSelectedFillStyleFor: self! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 7/18/2010 13:35'!
onColor: colorWhenOn offColor: colorWhenOff
	"Set the fill colors to be used when this button is on/off."

	onColor := colorWhenOn.
	offColor := colorWhenOff.
	self update: #onOffColor.
	self update: getStateSelector.


! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 7/30/2007 15:53'!
disabledBorderStyle
	"Return the disabled borderStyle of the receiver."
	
	^self theme buttonDisabledBorderStyleFor: self! !

!PluggableButtonMorph methodsFor: 'style' stamp: 'gvc 7/30/2007 15:54'!
pressedBorderStyle
	"Return the pressed borderStyle of the receiver."
	
	^self theme buttonPressedBorderStyleFor: self! !

!PluggableButtonMorph methodsFor: 'style' stamp: 'gvc 7/30/2007 15:54'!
selectedPressedBorderStyle
	"Return the selected pressed borderStyle of the receiver."
	
	^self theme buttonSelectedPressedBorderStyleFor: self! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 5/31/2013 13:10'!
color: aColor
	"Check to avoid repeats of the same color."

	aColor ifNil: [^self].
	(lastColor = aColor and: [
	self getModelState = (self valueOfProperty: #lastState)])
		ifTrue: [^self].
	super color: aColor.
	self class gradientButtonLook ifTrue: [self adoptColor: aColor]! !

!PluggableButtonMorph methodsFor: 'event handling' stamp: 'gvc 5/8/2006 13:40'!
handlesMouseOver: evt

	^ true! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/2/2012 11:40'!
performAction
	"backward compatibility"
	
	self performAction: nil! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'sw 12/28/2000 16:19'!
offColor: colorWhenOff
	"Set the fill colors to be used when this button is off."

	self onColor: onColor offColor: colorWhenOff
! !

!PluggableButtonMorph methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 1/5/2014 02:33'!
initialize
	"Initialize the state of the receiver."

	super initialize.
	self
		rubberBandCells: false;
		listDirection: #topToBottom;
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap;
		wrapCentering: #center;
		cellPositioning: #center.
	enabled := true.
	self initializeLabelMorph.	"this is a safe guard for enabled: among others."
	askBeforeChanging := false.
	triggerOnMouseDown := false.
	showSelectionFeedback := false.
	arguments := #().
	self
		layoutInset: (self theme buttonLabelInsetFor: self);
		borderStyle: BorderStyle thinGray;
		extent: 20 @ 15;
		setProperty: #lastState toValue: false;
		cornerStyle: (self theme buttonCornerStyleIn: nil).
	self clipSubmorphs: true! !

!PluggableButtonMorph methodsFor: 'style' stamp: 'gvc 7/30/2007 15:53'!
mouseOverBorderStyle
	"Return the mouse over borderStyle of the receiver."
	
	^self theme buttonMouseOverBorderStyleFor: self! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 1/23/2007 11:25'!
action
	"Answer the action selector."

	^self actionSelector! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 7/30/2007 15:54'!
selectedDisabledBorderStyle
	"Return the selected disabled borderStyle of the receiver."
	
	^self theme buttonSelectedDisabledBorderStyleFor: self! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 1/10/2007 12:17'!
isDefault: aBoolean
	"Set whether the button is to be considered default."

	aBoolean
		ifTrue: [self setProperty: #isDefault toValue: true]
		ifFalse: [self removeProperty: #isDefault].
	self changed! !

!PluggableButtonMorph methodsFor: 'style' stamp: 'gvc 7/30/2007 15:54'!
selectedPressedFillStyle
	"Return the selected pressed fillStyle of the receiver."
	
	^self theme buttonSelectedPressedFillStyleFor: self! !

!PluggableButtonMorph methodsFor: 'updating' stamp: 'gvc 3/2/2010 17:36'!
paneColorChanged
	"Use changed to update the appearance."

	self changed! !

!PluggableButtonMorph methodsFor: 'initialization' stamp: 'EstebanLorenzano 5/15/2014 19:01'!
defaultBorderWidth
	"answer the default border width for the receiver"
	^ self theme borderWidth! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/2/2012 11:20'!
performAction: event
	"Inform the model that this button has been pressed. Sent by the controller when this button is pressed. If the button's actionSelector takes any arguments, they are obtained dynamically by sending the argumentSelector to the argumentsProvider"

	enabled ifFalse: [^self].
	askBeforeChanging ifTrue: [model okToChange ifFalse: [^ self]].
	self actionBlock ifNotNil: [ ^ self actionBlock cull: event ].
	actionSelector ifNotNil:
		[actionSelector numArgs = 0
			ifTrue: [model perform: actionSelector]
			ifFalse: 
				[argumentsProvider ifNotNil:
					[arguments := argumentsProvider perform: argumentsSelector].
					model perform: actionSelector withArguments: arguments]]! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'jm 5/4/1998 17:47'!
feedbackColor: aColor
	"Set the color of this button's selection feedback border."

	feedbackColor := aColor.
	self changed.
! !

!PluggableButtonMorph methodsFor: 'private' stamp: 'GuillermoPolito 5/29/2011 14:52'!
getMenu: shiftPressed 
	"Answer the menu for this button, supplying an empty menu to be filled in. If the menu selector takes an extra argument, pass in the current state of the shift key."

	| menu |
	getMenuSelector isNil ifTrue: [^nil].
	menu := UIManager default newMenuIn: self for: model.
	getMenuSelector numArgs = 1 
		ifTrue: [^model perform: getMenuSelector with: menu].
	getMenuSelector numArgs = 2 
		ifTrue: 
			[^model 
				perform: getMenuSelector
				with: menu
				with: shiftPressed].
	^self error: 'The getMenuSelector must be a 1- or 2-keyword symbol'! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'AlainPlantec 12/13/2009 13:24'!
gradientLook: aBoolean
	gradientLook := aBoolean! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 7/18/2010 13:11'!
disable
	"Disable the button."

	self enabled: false! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 12/4/2007 16:23'!
focusBounds
	"Answer the bounds for drawing the focus indication."

	^self theme buttonFocusBoundsFor: self! !

!PluggableButtonMorph methodsFor: 'updating' stamp: 'gvc 7/24/2007 16:14'!
adoptColor: aColor
	"Go through paneColorChanged instead."
	
	self paneColorChanged! !

!PluggableButtonMorph methodsFor: 'keyboard' stamp: 'gvc 1/11/2007 12:30'!
takesKeyboardFocus
	"Answer whether the receiver can normally take keyboard focus."

	^true! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: ''!
action: aSymbol 
	"Set actionSelector to be the action defined by aSymbol."

	actionSelector := aSymbol.
! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 3/4/2010 12:16'!
availableBorderStyles
	"Return the selectors of the the available border styles for each state.
	Must match the order of interactionStates."
	
	^#(normalBorderStyle mouseOverBorderStyle pressedBorderStyle disabledBorderStyle
		selectedBorderStyle selectedPressedBorderStyle selectedMouseOverBorderStyle selectedDisabledBorderStyle)! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 7/18/2010 13:26'!
getColorSelector: aSymbol
	getColorSelector := aSymbol.
	self update: getColorSelector.! !

!PluggableButtonMorph methodsFor: 'event handling' stamp: 'StephaneDucasse 12/16/2011 17:57'!
mouseEnter: evt
	"Update the appearance."
	self setProperty: #mouseEntered toValue: true.
	
	self gradientLook
		ifTrue: [self changed]
		ifFalse: ["0.09375 is exact in floating point so no cumulative rounding error will occur"
				self color: (self color adjustBrightness: -0.09375)].
	super mouseEnter: evt! !

!PluggableButtonMorph methodsFor: 'keyboard' stamp: 'GuillermoPolito 5/23/2012 11:40'!
keyboardFocusChange: aBoolean
	"The message is sent to a morph when its keyboard focus changes.
	Update for focus feedback."
	super keyboardFocusChange: aBoolean.
	self focusChanged! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 4/25/2007 18:44'!
onColor
	"Answer the on color."
	
	^onColor
! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'sw 12/28/2000 16:17'!
actionSelector
	"Answer the receiver's actionSelector"

	^ actionSelector! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 7/1/2010 15:16'!
fillStyleToUse
	"Return the fillStyle to use for the receiver."
	
	^self perform: (self availableFillStyles at: (
			self interactionStates indexOf: self interactionState))
! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 6/8/2009 14:26'!
showSelectionFeedback
	"Answer whether the feedback should be shown for being pressed."

	^showSelectionFeedback! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'jm 4/2/98 17:43'!
shortcutCharacter
	"Return the Character to be used as a shortcut to turn on this switch, or nil if this switch doesn't have a keyboard shortcut."

	^ shortcutCharacter
! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 7/18/2010 13:29'!
getEnabledSelector: aSymbol
	getEnabledSelector := aSymbol.
	self update: aSymbol.! !

!PluggableButtonMorph methodsFor: 'drawing' stamp: 'StephaneDucasse 5/31/2013 17:51'!
drawSubmorphsOn: aCanvas 
	"Display submorphs back to front.
	Draw the focus here since we are using inset bounds
	for the focus rectangle."

	super drawSubmorphsOn: aCanvas.
	self hasKeyboardFocus ifTrue: [self drawKeyboardFocusOn: aCanvas]! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 1/11/2007 15:00'!
focusColor
	"Answer the keyboard focus indication color."

	^self color contrastingColor! !

!PluggableButtonMorph methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 5/2/2012 11:20'!
mouseUp: evt
	"Perform the button action if the mouse pointer is in a button in the group.
	Optimised feedback updates."
	
	|all|
	all := allButtons copy.
	all ifNotNil: [all do: [:m |
		m showSelectionFeedback ifTrue: [
			m showSelectionFeedback: false; changed; layoutChanged]]].
	all ifNil: [^ self].
	allButtons := nil.
	all do: [:m |
		(m containsPoint: evt cursorPoint) ifTrue: [m enabled ifTrue: [ m performAction: evt ]]].
	self showSelectionFeedback ifTrue: [self changed]
! !

!PluggableButtonMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/10/2015 17:40'!
drawSubmorphsOnAthensCanvas: anAthensCanvas
	super 	drawSubmorphsOnAthensCanvas: anAthensCanvas.
	self hasKeyboardFocus ifTrue: [self drawKeyboardFocusOnAthensCanvas: anAthensCanvas].
! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 2/11/2009 16:40'!
roundedCorners: anArray
	"Adjust the layout inset if necessary."

	super roundedCorners: anArray.
	self layoutInset: (self theme buttonLabelInsetFor: self)! !

!PluggableButtonMorph methodsFor: 'style' stamp: 'gvc 7/30/2007 15:53'!
mouseOverFillStyle
	"Return the mouse over fillStyle of the receiver."
	
	^self theme buttonMouseOverFillStyleFor: self! !

!PluggableButtonMorph methodsFor: 'private' stamp: 'RAA 6/12/2000 09:04'!
invokeMenu: evt
	"Invoke my menu in response to the given event."
	| menu |
	menu := self getMenu: evt shiftPressed.
	menu ifNotNil: [menu popUpEvent: evt in: self world]! !

!PluggableButtonMorph methodsFor: 'copying' stamp: 'tk 1/7/1999 16:53'!
veryDeepFixupWith: deepCopier
	"If fields were weakly copied, fix them here.  If they were in the tree being copied, fix them up, otherwise point to the originals!!!!"

super veryDeepFixupWith: deepCopier.
model := deepCopier references at: model ifAbsent: [model].
! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'jm 4/2/98 18:53'!
askBeforeChanging

	^ askBeforeChanging
! !

!PluggableButtonMorph methodsFor: 'updating' stamp: 'GaryChambers 4/13/2012 13:40'!
changed
	"Update the fillStyle here."

	|lc pc bs|
	self assureExtension.
	extension borderStyle: (bs := self borderStyleToUse).
	borderColor := bs style.
	borderWidth := bs width.
	extension fillStyle: self fillStyleToUse.
	self layoutInset: (self theme buttonLabelInsetFor: self).
	color := self fillStyle asColor.
	(self labelMorph respondsTo: #interactionState:)
		ifTrue: [self labelMorph interactionState: self interactionState]
		ifFalse: [(self labelMorph isNil
			or: [label isMorph]) ifFalse: [
				pc := self normalColor.
				lc := self enabled
					ifTrue: [pc contrastingColor]
					ifFalse: [pc contrastingColor muchDarker].
				self labelMorph color: lc]].
	super changed! !

!PluggableButtonMorph methodsFor: 'updating' stamp: 'StephaneDucasse 5/31/2013 18:27'!
updateLabelEnablement
	"Set the enabled state of the label if possible."
	
	self labelMorph enabled: self enabled! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 12/3/2008 17:22'!
minWidth
	"Consult the theme also."

	^super minWidth max: self theme buttonMinWidth! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 6/15/2009 12:23'!
showSelectionFeedback: aBoolean
	"Set the feedback."

	showSelectionFeedback := aBoolean! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'FernandoOlivero 4/12/2011 10:12'!
gradientLook
	^ gradientLook ifNil: [gradientLook := self theme currentSettings preferGradientFill]! !

!PluggableButtonMorph methodsFor: 'event handling' stamp: 'jrp 7/3/2005 18:13'!
mouseLeaveDragging: evt

	self mouseLeave: evt! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 7/30/2007 15:54'!
newLabel
	"Answer a new label for the receiver."

	^self theme buttonLabelFor: self! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'jm 4/7/98 19:17'!
askBeforeChanging: aBoolean
	"If this preference is turned on, then give the model an opportunity to ask the user before accepting a change that might cause unaccepted edits to be lost."

	askBeforeChanging := aBoolean.
! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 3/4/2010 12:15'!
availableFillStyles
	"Return the selectors of the the available fill styles for each state.
	Must match the order of interactionStates."
	
	^#(normalFillStyle mouseOverFillStyle pressedFillStyle disabledFillStyle
		selectedFillStyle selectedPressedFillStyle selectedMouseOverFillStyle selectedDisabledFillStyle)! !

!PluggableButtonMorph methodsFor: 'updating' stamp: 'gvc 6/8/2009 14:22'!
updateFeedbackForEvt: evt

	| newState |
	newState := self containsPoint: evt cursorPoint.
	newState = showSelectionFeedback ifFalse: [
		self showSelectionFeedback: newState.
		self changed; layoutChanged].
! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 2/11/2009 16:42'!
cornerStyle: aSymbol
	"Adjust the layout inset."

	super cornerStyle: aSymbol.
	self layoutInset: (self theme buttonLabelInsetFor: self)! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 4/24/2007 13:34'!
model
	"Answer the receiver's model."
	
	^model! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'jm 4/2/98 17:38'!
label
	"Answer the DisplayObject used as this button's label."

	^ label
! !

!PluggableButtonMorph methodsFor: 'compatibility' stamp: 'BenjaminVanRyseghem 7/25/2012 11:55'!
isMorphicModel 

	^ true! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 5/31/2013 18:05'!
label: aStringOrTextOrMorph font: aFont
	"Label this button with the given string or morph."

	| r |
	self removeAllMorphs.
	"nest label in a row for centering"
	r := AlignmentMorph newRow
		borderWidth: 0;
		layoutInset: 0;
		color: Color transparent;
		hResizing: #shrinkWrap;
		vResizing: #spaceFill;
		wrapCentering: #center;
		listCentering: #center;
		cellPositioning: #center.
	label := aStringOrTextOrMorph.	
	labelMorph := aStringOrTextOrMorph isMorph
						ifTrue: [ aStringOrTextOrMorph ]
						ifFalse: [ self newLabel: aFont ].
	r addMorph: labelMorph.
	self addMorph: r.
	self labelMorph enabled: self enabled.
	self updateLabelEnablement
! !

!PluggableButtonMorph methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 5/2/2012 11:20'!
mouseDown: evt
	"Details: If this button is triggered on mouse down or the event is the menu gesture, handle it immediately. Otherwise, make a list of buttons (including the receiver) for mouseMove feedback. This allows a simple radio-button effect among the button submorphs of a given morph."

	self enabled ifFalse: [^self].
	allButtons := nil.
	evt yellowButtonPressed ifTrue: [^ self invokeMenu: evt].
	self wantsKeyboardFocusOnMouseDown
		ifTrue: [self takeKeyboardFocus].
	triggerOnMouseDown
		ifTrue: [ self performAction: evt ]
		ifFalse: [
			allButtons := owner submorphs select: [:m | m class = self class].
			self updateFeedbackForEvt: evt].
! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 1/9/2009 17:47'!
focusIndicatorCornerRadius
	"Answer the corner radius preferred for the focus indicator
	for the receiver for themes that support this."

	^self theme buttonFocusIndicatorCornerRadiusFor: self ! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 1/23/2007 11:27'!
arguments
	"Answer the static arguments.
	SimpleButtonMorph cross-compatibility."

	^arguments! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'MarcusDenker 2/29/2012 17:28'!
target
	^model! !

!PluggableButtonMorph methodsFor: 'style' stamp: 'gvc 7/30/2007 15:54'!
selectedMouseOverBorderStyle
	"Return the selected mouse over borderStyle of the receiver."
	
	^self theme buttonSelectedMouseOverBorderStyleFor: self! !

!PluggableButtonMorph methodsFor: 'updating' stamp: 'MarcusDenker 11/22/2012 22:04'!
themeChanged
	"Set the border style to thin gray in the case of going to StandardSqueak."

	|labelColor|
	self
		layoutInset: (self theme buttonLabelInsetFor: self);
		cornerStyle: (self theme buttonCornerStyleIn: self window).
	(self labelMorph isNil or: [self label isMorph or: [self labelMorph isTextMorph]]) ifFalse: [
		labelColor := self labelMorph color.
		self label: self label font: self labelMorph font.
		self labelMorph color: labelColor].
	super themeChanged! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 7/18/2010 13:11'!
enabled
	^ enabled ifNil: [enabled := true]! !

!PluggableButtonMorph methodsFor: 'initialization' stamp: 'AlainPlantec 12/16/2009 12:32'!
defaultColor
	"answer the default color/fill style for the receiver"
	^ self containingWindow ifNil: [Color lightGreen] ifNotNil: [:w | w defaultBackgroundColor]! !

!PluggableButtonMorph methodsFor: 'keyboard' stamp: 'GaryChambers 7/5/2010 14:22'!
keyStroke: event 
	"Process spacebar for action and tab keys for navigation."
	
	(self navigationKey: event) ifTrue: [^self].
	(event keyCharacter = Character space or: [event keyCharacter = Character cr])
		ifTrue: [self performAction]! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 3/4/2010 12:14'!
interactionStates
	"Return all the states that the receiver may be in at any given moment."
	
	^#(normal mouseOver pressed disabled
		selected selectedPressed selectedMouseOver selectedDisabled)! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'jm 4/2/98 17:43'!
shortcutCharacter: aCharacter 
	"Set the character to be used as a keyboard shortcut for turning on this switch."

	shortcutCharacter := aCharacter.
! !

!PluggableButtonMorph methodsFor: 'event handling' stamp: 'jm 5/4/1998 16:57'!
handlesMouseDown: evt

	^ true
! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 7/18/2010 13:11'!
enable
	"Enable the button."

	self enabled: true! !

!PluggableButtonMorph methodsFor: 'drawing' stamp: 'AlainPlantec 12/10/2009 07:20'!
layoutBounds: aRectangle
	"Set the bounds for laying out children of the receiver.
	Update the fillstyle since it may depend on the bounds."
	
	super layoutBounds: aRectangle.
	self gradientLook ifTrue: [
		self fillStyle isOrientedFill
			ifTrue: [self fillStyle: self fillStyleToUse]]! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 5/28/2011 13:34'!
getModelState
	"Answer the result of sending the receiver's model the getStateSelector message.
	If the selector expects arguments then supply as for the actionSelector."

	model ifNil: [^ false].
	^getStateSelector ifNil: [false]
		ifNotNil: [getStateSelector numArgs = 0
					ifTrue: [model perform: getStateSelector]
					ifFalse: [argumentsProvider ifNotNil: [
								arguments := argumentsProvider perform: argumentsSelector].
							model perform: getStateSelector withEnoughArguments: arguments]]! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 8/21/2009 12:59'!
on: anObject getState: getStateSel action: actionSel label: labelSel menu: menuSel
	"Set up the pluggable parameters.
	Update label and state."
	
	self model: anObject.
	getStateSelector := getStateSel.
	actionSelector := actionSel.
	getLabelSelector := labelSel.
	getMenuSelector := menuSel.
	self
		update: labelSel;
		update: getStateSel
! !

!PluggableButtonMorph methodsFor: 'copying' stamp: 'sw 2/17/2002 05:29'!
veryDeepInner: deepCopier
	"Copy all of my instance variables.  Some need to be not copied at all, but shared.  	Warning!!!!  Every instance variable defined in this class must be handled.  We must also implement veryDeepFixupWith:.  See DeepCopier class comment."

super veryDeepInner: deepCopier.
"model := model.		Weakly copied"
label := label veryDeepCopyWith: deepCopier.
"getStateSelector := getStateSelector.		a Symbol"
"actionSelector := actionSelector.		a Symbol"
"getLabelSelector := getLabelSelector.		a Symbol"
"getMenuSelector := getMenuSelector.		a Symbol"
shortcutCharacter := shortcutCharacter veryDeepCopyWith: deepCopier.
askBeforeChanging := askBeforeChanging veryDeepCopyWith: deepCopier.
triggerOnMouseDown := triggerOnMouseDown veryDeepCopyWith: deepCopier.
offColor := offColor veryDeepCopyWith: deepCopier.
onColor := onColor veryDeepCopyWith: deepCopier.
feedbackColor := feedbackColor veryDeepCopyWith: deepCopier.
showSelectionFeedback := showSelectionFeedback veryDeepCopyWith: deepCopier.
allButtons := nil.		"a cache"
arguments := arguments veryDeepCopyWith: deepCopier.
argumentsProvider := argumentsProvider veryDeepCopyWith: deepCopier.
argumentsSelector := argumentsSelector.  " a Symbol" ! !

!PluggableButtonMorph methodsFor: 'initialization' stamp: 'EstebanLorenzano 4/29/2014 18:26'!
initializeLabelMorph
	labelMorph := LabelMorph new
		extent: 0 @ 0;
		yourself	"this is a safe guard for enabled: among others."! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 5/31/2013 18:26'!
label: aStringOrTextOrMorph
	"Label this button with the given string or morph."

	self label: aStringOrTextOrMorph font: self theme buttonFont! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 1/23/2007 11:26'!
actionSelector: aSymbol 
	"Set actionSelector to be the action defined by aSymbol.
	SimpleButtonMorph cross-compatibility"

	actionSelector := aSymbol.
! !

!PluggableButtonMorph methodsFor: 'event handling' stamp: 'gvc 1/11/2007 14:37'!
handlesKeyboard: evt
	"Answer true, we'll handle spacebar for pressing plus the usual
	tab navigation."
	
	^true! !

!PluggableButtonMorph methodsFor: 'keyboard' stamp: 'GaryChambers 10/17/2011 16:03'!
wantsKeyboardFocusOnMouseDown
	"Answer whether the receiver would like keyboard focus
	on a mouse down event. use a property here for apps that want to take keyboard
	focus when the button is pressed (so that other morphs can, e.g. accept on focus change)."

	^self wantsKeyboardFocus and: [self valueOfProperty: #wantsKeyboardFocusOnMouseDown ifAbsent: [false]]! !

!PluggableButtonMorph methodsFor: '*Keymapping-Core' stamp: 'ThierryGoubier 9/15/2012 22:53'!
initializeShortcuts: aKMDispatcher
	super initializeShortcuts: aKMDispatcher.
	aKMDispatcher attachCategory: #MorphFocusNavigation.
	aKMDispatcher attachCategory: #PluggableButtonMorph! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 7/30/2007 15:54'!
selectedBorderStyle
	"Return the selected borderStyle of the receiver."
	
	^self theme buttonSelectedBorderStyleFor: self! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'jm 4/2/98 19:26'!
triggerOnMouseDown

	^ triggerOnMouseDown
! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 4/13/2007 15:53'!
getMenuSelector: aSymbol
	"Set the menu selector."

	getMenuSelector := aSymbol! !

!PluggableButtonMorph methodsFor: 'style' stamp: 'gvc 7/30/2007 15:54'!
selectedMouseOverFillStyle
	"Return the selected mouse over fillStyle of the receiver."
	
	^self theme buttonSelectedMouseOverFillStyleFor: self! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 7/18/2010 13:17'!
actionBlock

	^ actionBlock ! !

!PluggableButtonMorph methodsFor: 'style' stamp: 'gvc 7/30/2007 15:54'!
selectedDisabledFillStyle
	"Return the selected disabled fillStyle of the receiver."
	
	^self theme buttonSelectedDisabledFillStyleFor: self! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 5/23/2007 14:40'!
newLabel: aFont
	"Answer a new label for the receiver with the given font."

	^self newLabel
		font: aFont! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'jm 5/4/1998 16:52'!
model: anObject
	"Set my model and make me me a dependent of the given object."

	model ifNotNil: [model removeDependent: self].
	anObject ifNotNil: [anObject addDependent: self].
	model := anObject.
! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 7/18/2010 13:19'!
actionBlock: aBlock
	"an action can be either specified by a block or a selector. If the block is set it takes priority over selector."
	
	actionBlock := aBlock! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 7/30/2007 15:54'!
normalColor
	"Return the normal colour for the receiver."
	
	^self theme buttonColorFor: self! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 7/30/2009 14:08'!
colorToUse
	"Answer the color we should use."

	|c|
	c := self getModelState
		ifTrue: [onColor
					ifNil: [self paneColor]
					ifNotNil: [onColor isTransparent
								ifTrue: [self paneColor]
								ifFalse: [onColor]]]
		ifFalse: [offColor
					ifNil: [self paneColor]
					ifNotNil: [offColor isTransparent
								ifTrue: [self paneColor]
								ifFalse: [offColor]]].
	^c! !

!PluggableButtonMorph methodsFor: 'style' stamp: 'gvc 7/30/2007 15:54'!
normalBorderStyle
	"Return the normal borderStyle of the receiver."
	
	^self theme buttonNormalBorderStyleFor: self! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 1/10/2007 12:13'!
isDefault
	"Answer whether the button is considered to be a default one."

	^self valueOfProperty: #isDefault ifAbsent: [false] ! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'sw 10/25/1999 14:36'!
offColor
	^ offColor
! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 12/16/2011 17:54'!
interactionState
	"Return the state that the receiver is in, #pressed, #normal etc.."
	
	|state mo|
	state := self getModelState.
	mo := (self valueOfProperty: #mouseEntered) == true.
	
	^(self enabled ifNil: [true])
		ifTrue: [showSelectionFeedback
			ifTrue: [state
				ifTrue: [#selectedPressed]
				ifFalse: [#pressed]]
			ifFalse: [mo
				ifTrue: [state
					ifTrue: [#selectedMouseOver]
					ifFalse: [#mouseOver]]
				ifFalse: [state
					ifTrue: [#selected]
					ifFalse: [#normal]]]]
		ifFalse: [state
			ifTrue: [#selectedDisabled]
			ifFalse: [#disabled]]! !

!PluggableButtonMorph methodsFor: 'updating' stamp: 'gvc 7/1/2010 15:13'!
adoptPaneColor: aColor

	super adoptPaneColor: aColor.
	aColor ifNil: [^self].
	self adoptColor: self colorToUse! !

!PluggableButtonMorph methodsFor: 'style' stamp: 'gvc 7/30/2007 15:54'!
normalFillStyle
	"Return the normal fillStyle of the receiver."
	
	^self theme buttonNormalFillStyleFor: self! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 7/18/2010 13:26'!
getColorSelector
	^getColorSelector! !

!PluggableButtonMorph methodsFor: 'arguments' stamp: 'sw 2/17/2002 05:29'!
argumentsProvider: anObject argumentsSelector: aSelector
	"Set the argument provider and selector"

	argumentsProvider := anObject.
	argumentsSelector := aSelector! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'GaryChambers 12/7/2011 17:57'!
enabled: aBoolean
	"Set the enabled state of the receiver."
	
	enabled = aBoolean ifTrue: [^self].
	enabled := aBoolean.
	self updateLabelEnablement.
	self changed! !

!PluggableButtonMorph methodsFor: 'event handling' stamp: 'gvc 5/8/2006 13:41'!
handlesMouseOverDragging: evt

	^ true! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'jm 4/7/98 19:16'!
triggerOnMouseDown: aBoolean
	"If this preference is turned on, then trigger my action immediately when the mouse goes down."

	triggerOnMouseDown := aBoolean.
! !

!PluggableButtonMorph methodsFor: 'private' stamp: 'MarcusDenker 5/5/2013 09:13'!
browseAction

	| classDefiningAction |
	classDefiningAction := self model class whichClassIncludesSelector: self actionSelector.
	Smalltalk tools browser newOnClass: classDefiningAction selector: self actionSelector.! !

!PluggableButtonMorph methodsFor: 'event handling' stamp: 'jm 5/4/1998 17:30'!
mouseMove: evt

	allButtons ifNil: [^ self].
	allButtons do: [:m | m updateFeedbackForEvt: evt].
! !

!PluggableButtonMorph methodsFor: 'keyboard' stamp: 'gvc 2/8/2007 13:43'!
wantsKeyboardFocusNavigation
	"Answer whether the receiver would like keyboard focus
	when navigated to by keyboard."

	^super wantsKeyboardFocusNavigation and: [
		self valueOfProperty: #wantsKeyboardFocusNavigation ifAbsent: [true]]! !

!PluggableButtonMorph methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 12/11/2013 15:18'!
update: aParameter 

	|state|
	aParameter  ifNil: [^self].
	getLabelSelector ifNotNil: [	aParameter == getLabelSelector ifTrue: [ self label: (model perform: getLabelSelector) ]].
	state := self getModelState.
	(state ~= (self valueOfProperty: #lastState) or: [
	getStateSelector isNil and: [aParameter == #onOffColor]])
		ifTrue: [self color: self colorToUse.
				self setProperty: #lastState toValue: state].
	aParameter == getEnabledSelector ifTrue: [^self enabled: (model perform: getEnabledSelector)].
	getColorSelector ifNotNil: [ | cc |
		color = (cc := model perform: getColorSelector) 
			ifFalse: [
				color := cc.
				self onColor: color offColor: color.
				self changed ]].
		
	aParameter isArray ifFalse: [ ^ self ].
	aParameter size == 2 ifFalse: [ ^ self ].
	
	aParameter first = #askBeforeChanging: ifTrue: [ self askBeforeChanging: aParameter second ]! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'AlainPlantec 12/10/2009 07:19'!
extent: aPoint 
	"Set the receiver's extent to value provided.
	Update the gradient fills."

	|answer|
	aPoint = self extent ifTrue: [^super extent: aPoint].
	answer := super extent: aPoint.
	self gradientLook ifTrue: [
		self fillStyle isOrientedFill
			ifTrue: [self fillStyle: self fillStyleToUse]].
	^answer! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 7/18/2010 13:29'!
getEnabledSelector
	^getEnabledSelector! !

!PluggableButtonMorph methodsFor: 'drawing' stamp: 'gvc 9/11/2009 17:56'!
indicateModalChild
	"Flash the button border."
	
	|fs c w d|
	fs := self fillStyle.
	c := self color alphaMixed: 0.5 with: Color black.
	w := self world.
	d := 0.
	self assureExtension.
	2 timesRepeat: [
		(Delay forDuration: d milliSeconds) wait.
		d := 200.
		extension fillStyle: c.
		color := c.
		self invalidRect: self bounds.
		w ifNotNil: [w displayWorldSafely].
		(Delay forDuration: d milliSeconds) wait.
		self fillStyle: fs.
		w ifNotNil: [w displayWorldSafely].
		self invalidRect: self bounds]
! !

!PluggableButtonMorph methodsFor: 'arguments' stamp: 'sw 2/17/2002 01:03'!
arguments: args
	"If the receiver takes argument(s) that are static, they can be filled by calling this.  If its argument(s) are to be dynamically determined, then use an argumentProvider and argumentSelector instead"

	arguments := args! !

!PluggableButtonMorph methodsFor: 'style' stamp: 'gvc 7/30/2007 15:54'!
pressedFillStyle
	"Return the pressed fillStyle of the receiver."
	
	^self theme buttonPressedFillStyleFor: self! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 5/31/2013 18:06'!
labelMorph
	"Answer the actual label morph."

	^ labelMorph! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 12/3/2008 17:23'!
minHeight
	"Consult the theme also."

	^super minHeight max: self theme buttonMinHeight! !

!PluggableButtonMorph methodsFor: 'event handling' stamp: 'StephaneDucasse 12/16/2011 17:57'!
mouseLeave: evt
	"Update the appearance."
	self setProperty: #mouseEntered toValue: false.
	self gradientLook
		ifTrue: [self changed]
		ifFalse: ["0.09375 is exact in floating point so no cumulative rounding error will occur"
				self color: (self color adjustBrightness: 0.09375).
				self update: nil].
	super mouseLeave: evt! !

!PluggableButtonMorph methodsFor: 'event handling' stamp: 'StephaneDucasse 10/27/2014 09:34'!
addStandardHaloMenuItemsTo: aMenu hand: aHandMorph

	aMenu add: 'browse action' selector: #browseAction.
	aMenu addLine.
	super addStandardHaloMenuItemsTo: aMenu hand: aHandMorph.! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'gvc 7/30/2007 15:53'!
disabledFillStyle
	"Return the disabled fillStyle of the receiver."
	
	^self theme buttonDisabledFillStyleFor: self! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'MarcusDenker 7/7/2014 12:13'!
borderStyleToUse
	"Return the borderStyle to use for the receiver."
	
	self gradientLook ifFalse:[^self borderStyle].
	^self perform: (self availableBorderStyles at: (
			self interactionStates indexOf: self interactionState))
! !

!PluggableButtonMorph class methodsFor: 'instance creation' stamp: 'StephaneDucasse 10/5/2014 14:45'!
newButtonFor: aModel 
	getState: stateSel 
	action: actionSel 
	arguments: args 
	getEnabled: enabledSel 
	label: label 
	help: helpText
	"Answer a new button."

	| b |
	b := self on: aModel getState: stateSel action: actionSel.
	b
		arguments: (args ifNil: [{b}]);
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap;
		label: label ;
		getEnabledSelector: enabledSel;
		setBalloonText: helpText;
		extent: b minExtent;
		hResizing: #rigid;
		vResizing: #rigid.
	^b! !

!PluggableButtonMorph class methodsFor: 'settings' stamp: 'AlainPlantec 12/10/2009 07:18'!
gradientButtonLook: aBoolean
	UseGradientLook := aBoolean! !

!PluggableButtonMorph class methodsFor: 'settings' stamp: 'FernandoOlivero 4/12/2011 10:12'!
gradientButtonLook 
	^ UseGradientLook ifNil: [UseGradientLook := self theme settings preferGradientFill]! !

!PluggableButtonMorph class methodsFor: 'shortcuts' stamp: 'GuillermoPolito 3/19/2013 19:12'!
buildPluggableButtonShortcutsOn: aBuilder
	<keymap>
	(aBuilder shortcut: #action1)
		category: #PluggableButtonMorph
		default: Character space asKeyCombination | Character cr asKeyCombination
		do: [ :target :morph :event | morph performAction ].! !

!PluggableButtonMorph class methodsFor: 'instance creation' stamp: 'jm 5/4/1998 15:28'!
on: anObject getState: getStateSel action: actionSel

	^ self new
		on: anObject
		getState: getStateSel
		action: actionSel
		label: nil
		menu: nil
! !

!PluggableButtonMorph class methodsFor: 'instance creation' stamp: 'jm 5/4/1998 15:29'!
on: anObject getState: getStateSel action: actionSel label: labelSel menu: menuSel

	^ self new
		on: anObject
		getState: getStateSel
		action: actionSel
		label: labelSel
		menu: menuSel
! !

!PluggableButtonMorph class methodsFor: 'examples' stamp: 'StephaneDucasse 10/5/2014 14:44'!
exampleButtonNoAction
	<exampleWidget>

	^ PluggableButtonMorph
		newButtonFor: nil
		action: nil
		label: 'A Button'
		help: 'This is a button'! !

!PluggableButtonMorph class methodsFor: 'instance creation' stamp: ''!
on: anObject

	^ self on: anObject getState: #isOn action: #switch
! !

!PluggableButtonMorph class methodsFor: 'instance creation' stamp: 'jm 5/4/1998 15:28'!
on: anObject getState: getStateSel action: actionSel label: labelSel

	^ self new
		on: anObject
		getState: getStateSel
		action: actionSel
		label: labelSel
		menu: nil
! !

!PluggableButtonMorph class methodsFor: 'instance creation' stamp: 'StephaneDucasse 10/5/2014 14:43'!
newButtonFor: aModel action: actionSel label: stringOrText help: helpText
	"Answer a new button."

	^self
		newButtonFor: aModel
		getState: nil
		action: actionSel
		arguments: nil
		getEnabled: nil 
		label: stringOrText
		help: helpText! !

!PluggableCanvas commentStamp: '<historical>'!
An abstract canvas which modifies the behavior of an underlying canvas in some way.  Subclasses should implement apply:, which takes a one argument block and an actual canvas to draw on.  See apply: for the specific definition.!
!PluggableCanvas methodsFor: 'canvas methods' stamp: 'RAA 7/28/2000 06:52'!
balloonFillRectangle: aRectangle fillStyle: aFillStyle

	self apply: [ :c | c balloonFillRectangle: aRectangle fillStyle: aFillStyle ]! !

!PluggableCanvas methodsFor: 'drawing-text' stamp: 'tween 3/10/2009 07:49'!
drawString: s from: firstIndex to: lastIndex in: boundsRect font: fontOrNil color: c underline: underline underlineColor: uc strikethrough: strikethrough strikethroughColor: sc
	self apply: [ :clippedCanvas |
		clippedCanvas drawString: s from: firstIndex to: lastIndex in: boundsRect font: fontOrNil color: c underline: underline underlineColor: uc strikethrough: strikethrough strikethroughColor: sc]! !

!PluggableCanvas methodsFor: 'accessing' stamp: 'RAA 8/13/2000 18:57'!
origin

	self apply: [ :c | ^c origin ].
! !

!PluggableCanvas methodsFor: 'drawing' stamp: 'ls 3/20/2000 20:31'!
line: pt1 to: pt2 width: w color: c
	self apply: [ :clippedCanvas |
		clippedCanvas line: pt1 to: pt2 width: w color: c ]! !

!PluggableCanvas methodsFor: '*Rubric-Editing-Core' stamp: 'AlainPlantec 3/26/2013 18:28'!
rubParagraph: paragraph bounds: bounds color: color
	self apply: [ :c |
		c paragraph: paragraph bounds: bounds color: color ]! !

!PluggableCanvas methodsFor: 'drawing-general' stamp: 'ar 12/30/2001 18:46'!
roundCornersOf: aMorph in: bounds during: aBlock
	aMorph wantsRoundedCorners ifFalse:[^aBlock value].
	(self seesNothingOutside: (CornerRounder rectWithinCornersOf: bounds))
		ifTrue: ["Don't bother with corner logic if the region is inside them"
				^ aBlock value].
	CornerRounder roundCornersOf: aMorph on: self in: bounds
		displayBlock: aBlock
		borderWidth: aMorph borderWidthForRounding
		corners: aMorph roundedCorners! !

!PluggableCanvas methodsFor: 'drawing-support' stamp: 'ls 3/20/2000 20:37'!
translateBy: delta during: aBlock
	self apply: [ :clippedCanvas |
		 clippedCanvas translateBy: delta during: aBlock ]! !

!PluggableCanvas methodsFor: 'other' stamp: 'ls 3/20/2000 21:16'!
flushDisplay
	self apply: [ :c |
		c flushDisplay ]! !

!PluggableCanvas methodsFor: 'drawing-ovals' stamp: 'ls 3/20/2000 20:03'!
fillOval: r color: c borderWidth: borderWidth borderColor: borderColor
	self apply: [ :clippedCanvas |
		clippedCanvas fillOval: r color: c borderWidth: borderWidth borderColor: borderColor ]! !

!PluggableCanvas methodsFor: 'drawing-rectangles' stamp: 'IgorStasenko 7/18/2011 18:21'!
fillRectangle: aRectangle basicFillStyle: aFillStyle
	"Fill the given rectangle with the given, non-composite, fill style."

	| pattern |

	(aFillStyle isKindOf: InfiniteForm) ifTrue: [
		^self infiniteFillRectangle: aRectangle fillStyle: aFillStyle
	].

	aFillStyle isSolidFill ifTrue:[ ^self fillRectangle: aRectangle color: aFillStyle asColor].

	"We have a very special case for filling with infinite forms"
	(aFillStyle isBitmapFill and:[aFillStyle origin = (0@0)]) ifTrue:[
		pattern := aFillStyle form.
		(aFillStyle direction = (pattern width @ 0) 
			and:[aFillStyle normal = (0@pattern height)]) ifTrue:[
				"Can use an InfiniteForm"
				^self fillRectangle: aRectangle color: (InfiniteForm with: pattern)].
	].
	"Use a BalloonCanvas instead"
	self balloonFillRectangle: aRectangle fillStyle: aFillStyle.
! !

!PluggableCanvas methodsFor: 'other' stamp: 'RAA 7/20/2000 16:49'!
forceToScreen: rect

	self apply: [ :c |
		c forceToScreen: rect ]! !

!PluggableCanvas methodsFor: 'drawing-text' stamp: 'ar 12/31/2001 02:28'!
drawString: s from: firstIndex to: lastIndex in: boundsRect font: fontOrNil color: c
	self apply: [ :clippedCanvas |
		clippedCanvas drawString: s from: firstIndex to: lastIndex in: boundsRect font: fontOrNil color: c]! !

!PluggableCanvas methodsFor: 'private' stamp: 'ls 3/20/2000 20:30'!
image: aForm at: aPoint sourceRect: sourceRect rule: rule
	self apply:  [ :c |
		c image: aForm at: aPoint sourceRect: sourceRect rule: rule ]! !

!PluggableCanvas methodsFor: 'private' stamp: 'ls 3/20/2000 20:46'!
apply: aBlock
	"evaluate aBlock with a canvas to do a drawing command on.  See implementors for examples"! !

!PluggableCanvas methodsFor: 'drawing' stamp: 'ls 3/20/2000 20:34'!
render: anObject
	self apply: [ :c |
		c render: anObject ]! !

!PluggableCanvas methodsFor: 'drawing-support' stamp: 'ls 3/20/2000 20:35'!
transformBy: aDisplayTransform clippingTo: aClipRect during: aBlock smoothing: cellSize

	self apply: [ :clippedCanvas |
		clippedCanvas transformBy: aDisplayTransform clippingTo: aClipRect during: aBlock smoothing: cellSize ]! !

!PluggableCanvas methodsFor: 'accessing' stamp: 'ls 3/20/2000 20:02'!
clipRect
	| innerClipRect |
	self apply: [ :c |
		innerClipRect := c clipRect ].
	^innerClipRect! !

!PluggableCanvas methodsFor: 'accessing' stamp: 'ls 3/26/2000 13:57'!
contentsOfArea: aRectangle into: aForm
	self apply: [ :c |
		c contentsOfArea: aRectangle into: aForm ].
	^aForm! !

!PluggableCanvas methodsFor: 'drawing-polygons' stamp: 'ls 3/20/2000 20:01'!
drawPolygon: vertices color: aColor borderWidth: bw borderColor: bc
	self apply: [ :c |
		c drawPolygon: vertices color: aColor borderWidth: bw borderColor: bc ]! !

!PluggableCanvas methodsFor: 'drawing-images' stamp: 'ls 3/20/2000 20:32'!
paintImage: aForm at: aPoint
	self apply: [ :c |
		c paintImage: aForm at: aPoint ]! !

!PluggableCanvas methodsFor: 'canvas methods' stamp: 'RAA 8/25/2000 13:34'!
infiniteFillRectangle: aRectangle fillStyle: aFillStyle

	self apply: [ :c | c infiniteFillRectangle: aRectangle fillStyle: aFillStyle ]! !

!PluggableCanvas methodsFor: 'drawing-ovals' stamp: 'IgorStasenko 7/18/2011 18:21'!
fillOval: aRectangle fillStyle: aFillStyle borderWidth: bw borderColor: bc
	"Fill the given oval."
	(aFillStyle isBitmapFill and:[aFillStyle isKindOf: InfiniteForm]) ifTrue:[
		self flag: #fixThis.
		^self fillOval: aRectangle color: aFillStyle borderWidth: bw borderColor: bc].
	(aFillStyle isSolidFill) ifTrue:[
		^self fillOval: aRectangle color: aFillStyle asColor borderWidth: bw borderColor: bc].
	"Use a BalloonCanvas instead"
	self balloonFillOval: aRectangle fillStyle: aFillStyle borderWidth: bw borderColor: bc! !

!PluggableCanvas methodsFor: 'drawing-images' stamp: 'ls 3/20/2000 20:32'!
paintImage: aForm at: aPoint sourceRect: sourceRect
	self apply: [ :c |
		c paintImage: aForm at: aPoint sourceRect: sourceRect ]! !

!PluggableCanvas methodsFor: 'drawing-images' stamp: 'ls 3/20/2000 20:35'!
stencil: stencilForm at: aPoint sourceRect: sourceRect color: aColor
	self apply: [ :c |
		c stencil: stencilForm at: aPoint sourceRect: sourceRect color: aColor ]! !

!PluggableCanvas methodsFor: 'accessing' stamp: 'ls 3/20/2000 21:14'!
shadowColor: color
	self apply: [ :c |
		c shadowColor: color ]! !

!PluggableCanvas methodsFor: 'accessing' stamp: 'RAA 8/13/2000 18:56'!
extent

	self apply: [ :c | ^c extent ].
! !

!PluggableCanvas methodsFor: 'other' stamp: 'ls 3/20/2000 20:37'!
translateBy: aPoint clippingTo: aRect during: aBlock
	self apply: [ :clippedCanvas |
		clippedCanvas translateBy: aPoint clippingTo: aRect during: aBlock ]! !

!PluggableCanvas methodsFor: 'canvas methods' stamp: 'RAA 11/6/2000 16:33'!
balloonFillOval: aRectangle fillStyle: aFillStyle borderWidth: bw borderColor: bc

	self apply: [ :c | 
		c balloonFillOval: aRectangle fillStyle: aFillStyle borderWidth: bw borderColor: bc
	]! !

!PluggableCanvas methodsFor: 'drawing' stamp: 'ls 3/20/2000 20:33'!
paragraph: paragraph bounds: bounds color: color
	self apply: [ :c |
		c paragraph: paragraph bounds: bounds color: color ]! !

!PluggableCanvas methodsFor: 'drawing-rectangles' stamp: 'ls 3/20/2000 20:04'!
frameAndFillRectangle: r fillColor: fillColor borderWidth: borderWidth borderColor: borderColor
	self apply: [ :c |
		c frameAndFillRectangle: r fillColor: fillColor borderWidth: borderWidth borderColor: borderColor ]! !

!PluggableCanvas methodsFor: 'initialization' stamp: 'ls 3/20/2000 21:16'!
flush
	self apply: [ :c |
		c flush ]! !

!PluggableCanvas methodsFor: 'canvas methods' stamp: 'ls 3/25/2000 15:53'!
showAt: pt invalidRects: updateRects
	self apply: [ :c |
		c showAt: pt invalidRects: updateRects ]! !

!PluggableCanvas methodsFor: 'drawing-support' stamp: 'ls 3/20/2000 19:59'!
clipBy: newClipRect during: aBlock
	self apply: [ :c |
		c clipBy: newClipRect during: aBlock ]! !

!PluggableDialogWindow commentStamp: 'gvc 8/8/2007 14:08'!
Pluggable form of dialog window supporting custom selector on model for applying changes along with configurable content and buttons.!
!PluggableDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 8/8/2007 14:06'!
useOKDefaultCancelButton
	"Set the buttons to be an OK button and a default cancel button.
	Only effective before the model is set."
	
	self buttons: {self newOKButton. self newCancelButton isDefault: true}! !

!PluggableDialogWindow methodsFor: 'accessing' stamp: 'gvc 8/8/2007 14:02'!
buttons: anObject
	"Set the value of buttons"

	buttons := anObject! !

!PluggableDialogWindow methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 10/9/2011 15:01'!
defaultFocusMorph: aMorph
	defaultFocusMorph := aMorph! !

!PluggableDialogWindow methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 10/9/2011 14:26'!
newContentMorph
	"Answer the plugged content."
	
	^self contentMorph  ! !

!PluggableDialogWindow methodsFor: 'as yet unclassified' stamp: 'jrd 12/1/2008 23:56'!
statusValue
	^statusValue! !

!PluggableDialogWindow methodsFor: 'accessing' stamp: 'gvc 2/9/2007 13:34'!
contentMorph: anObject
	"Set the value of contentMorph"

	contentMorph := anObject! !

!PluggableDialogWindow methodsFor: 'accessing' stamp: 'gvc 2/9/2007 13:34'!
contentMorph
	"Answer the value of contentMorph"

	^ contentMorph! !

!PluggableDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 8/8/2007 14:05'!
useDefaultOKButton
	"Set the buttons to be just an OK button.
	Only effective before the model is set."
	
	self buttons: {self newOKButton isDefault: true}! !

!PluggableDialogWindow methodsFor: 'initialization' stamp: 'gvc 8/8/2007 14:03'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		buttons: super newButtons! !

!PluggableDialogWindow methodsFor: 'accessing' stamp: 'gvc 2/12/2007 12:56'!
applyChangesSelector
	"Answer the value of applyChangesSelector"

	^ applyChangesSelector! !

!PluggableDialogWindow methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 10/9/2011 15:01'!
defaultFocusMorph
	^ defaultFocusMorph ifNil: [super defaultFocusMorph]! !

!PluggableDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 8/8/2007 14:02'!
newButtons
	"Answer  the plugged buttons."

	^self buttons! !

!PluggableDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 8/8/2007 14:06'!
useDefaultOKCancelButton
	"Set the buttons to be a default OK button and a cancel button.
	Only effective before the model is set."
	
	self buttons: super newButtons! !

!PluggableDialogWindow methodsFor: 'as yet unclassified' stamp: 'jrd 12/1/2008 23:56'!
statusValue: val
	statusValue := val! !

!PluggableDialogWindow methodsFor: 'accessing' stamp: 'gvc 8/8/2007 14:02'!
buttons
	"Answer the value of buttons"

	^ buttons! !

!PluggableDialogWindow methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 12/11/2009 07:41'!
applyChanges
	"Apply the changes."

	super applyChanges.
	self applyChangesSelector ifNotNil: [:s |
		self model perform: s withEnoughArguments: {self}]! !

!PluggableDialogWindow methodsFor: 'accessing' stamp: 'gvc 2/12/2007 12:56'!
applyChangesSelector: anObject
	"Set the value of applyChangesSelector"

	applyChangesSelector := anObject! !

!PluggableDictionary commentStamp: '<historical>'!
Class PluggableDictionary allows the redefinition of hashing and equality by clients. This is in particular useful if the clients know about specific properties of the objects stored in the dictionary. See the class comment of PluggableSet for an example.

Instance variables:
	hashBlock	<BlockContext>	A one argument block used for hashing the elements.
	equalBlock	<BlockContext>	A two argument block used for comparing the elements.
!
!PluggableDictionary methodsFor: 'accessing' stamp: 'ar 11/12/1998 18:46'!
hashBlock: aBlock
	"Set a new hash block. The block must accept one argument and must return the hash value of the given argument."
	hashBlock := aBlock.! !

!PluggableDictionary methodsFor: 'accessing' stamp: 'ar 11/27/1998 23:55'!
equalBlock: aBlock
	"Set a new equality block. The block must accept two arguments and return true if the argumets are considered to be equal, false otherwise"
	equalBlock := aBlock.! !

!PluggableDictionary methodsFor: 'copying' stamp: 'nice 10/5/2009 10:15'!
copyEmpty
	^super copyEmpty
		hashBlock: hashBlock;
		equalBlock: equalBlock! !

!PluggableDictionary methodsFor: 'accessing' stamp: 'ar 11/12/1998 18:46'!
hashBlock
	"Return the block used for hashing the elements in the receiver."
	^hashBlock! !

!PluggableDictionary methodsFor: 'accessing' stamp: 'ar 11/12/1998 18:46'!
equalBlock
	"Return the block used for comparing the elements in the receiver."
	^equalBlock! !

!PluggableDictionary methodsFor: 'private' stamp: 'dvf 6/11/2000 01:33'!
scanFor: anObject 
	"Scan the key array for the first slot containing either a nil
(indicating 
	  an empty slot) or an element that matches anObject. Answer the index 
	  
	of that slot or zero if no slot is found. This  method will be
overridden   
	in various subclasses that have different interpretations for matching 
 
	elements."
	| element start finish |
	start := (hashBlock ifNil: [anObject hash]
				ifNotNil: [hashBlock value: anObject])
				\\ array size + 1.
	finish := array size.
	"Search from (hash mod size) to the end."
	start to: finish do: [:index | ((element := array at: index) == nil or:
[equalBlock ifNil: [element key = anObject]
				ifNotNil: [equalBlock value: element key value: anObject]])
			ifTrue: [^ index]].
	"Search from 1 to where we started."
	1 to: start - 1 do: [:index | ((element := array at: index) == nil or:
[equalBlock ifNil: [element key = anObject]
				ifNotNil: [equalBlock value: element key value: anObject]])
			ifTrue: [^ index]].
	^ 0"No match AND no empty slot"! !

!PluggableDictionary methodsFor: 'private' stamp: 'HenrikSperreJohansen 9/1/2010 22:52'!
scanForEmptySlotFor: aKey
	"Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements."
	
	| index start |
	index := start := (hashBlock
		ifNil: [ aKey hash ]
		ifNotNil: [ hashBlock value: aKey ]) \\ array size + 1.
	[ 
		(array at: index) ifNil: [ ^index ].
		(index := index \\ array size + 1) = start ] whileFalse.
	self errorNoFreeSpace! !

!PluggableDictionary class methodsFor: 'as yet unclassified' stamp: 'dvf
6/10/2000 18:13'!
integerDictionary
	^ self new hashBlock: [:integer | integer hash \\ 1064164 * 1009]! !

!PluggableDictionaryTest commentStamp: 'TorstenBergmann 2/20/2014 15:21'!
SUnit tests for pluggable dictionaries!
!PluggableDictionaryTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 6/29/2009 12:35'!
classToBeTested

^ PluggableDictionary! !

!PluggableDictionaryTest class methodsFor: 'building suites' stamp: 'cyrille.delaunay 6/29/2009 13:28'!
shouldInheritSelectors

^true! !

!PluggableDictionaryTest class methodsFor: 'building suites' stamp: 'cyrille.delaunay 6/29/2009 12:36'!
classToBeTested

^ IdentitySet! !

!PluggableIconListMorph commentStamp: 'gvc 5/18/2007 12:31'!
A type of PluggableListMorph that supports a single icon (Form) for items. Useful for lists with icons.!
!PluggableIconListMorph methodsFor: 'accessing' stamp: 'gvc 1/8/2007 17:56'!
getIconSelector: anObject
	"Set the value of getIconSelector"

	getIconSelector := anObject! !

!PluggableIconListMorph methodsFor: 'model access' stamp: 'BenjaminVanRyseghem 11/29/2011 09:56'!
getList
	"Answer the list to be displayed.  Caches the returned list in the 'list' ivar"

	getListSelector isNil ifTrue: [^#()].
	list := model perform: getListSelector.
	list isNil ifTrue: [^ #()].
	list := list collectWithIndex: [ :item :index | self itemMorphFor: item index: index ].
	^list! !

!PluggableIconListMorph methodsFor: 'action' stamp: 'BenjaminVanRyseghem 8/23/2011 14:38'!
interactWithSelectedItem

	self selection
		ifNotNil: [: sel | sel submorphs do: [:each | each update: #interact ]]! !

!PluggableIconListMorph methodsFor: 'accessing' stamp: 'gvc 1/8/2007 17:56'!
getIconSelector
	"Answer the value of getIconSelector"

	^ getIconSelector! !

!PluggableIconListMorph methodsFor: 'model access' stamp: 'BenjaminVanRyseghem 4/25/2012 15:48'!
getListItem: index
	"get the index-th item in the displayed list"

	getListElementSelector ifNotNil: [
		^self itemMorphFor: (model perform: getListElementSelector with: index) index: index].
	(list notNil and: [list size >= index]) ifTrue: [ ^list at: index ].
	^ self wrapItem: (self getList at: index) index: index! !

!PluggableIconListMorph methodsFor: 'event' stamp: 'BenjaminVanRyseghem 5/5/2013 13:03'!
basicKeyPressed: aChar 
	
	^ aChar == Character space
		ifTrue: [ self interactWithSelectedItem ]
		ifFalse: [ super basicKeyPressed: aChar ]! !

!PluggableIconListMorph methodsFor: 'display' stamp: 'BenjaminVanRyseghem 5/6/2013 23:48'!
itemMorphFor: anObject index: anIndex
	"Answer a morph for the object with the appropriate icon."

	|item icon|
	item := IconicListItem new
		originalObject: anObject;
		yourself.
		
	icon := self getIconSelector ifNotNil: [self model perform: self getIconSelector withEnoughArguments: {anObject. anIndex}].
	icon ifNotNil: [
		item icon: icon asMorph].
	item morph: (self wrapItem: anObject index: anIndex) asMorph.
	^item! !

!PluggableListItemWrapper commentStamp: 'ar 10/14/2003 23:51'!
luggableListItemWrapper makes it more easy for clients to use hierarchical lists. Rather than having to write a subclass of ListItemWrapper, a PluggableListItemWrapper can be used to provide the appropriate information straight from the model:
	string - an explicit string representation (contrary to the 'item' which contains any kind of object)
	getStringSelector - a message invoked to retrieve the sting representation of its item dynamically from its model (when a constant representation is undesirable)
	hasContentsSelector - a message invoked in the model to answer whether the item has any children or not.
	getContentsSelector - a message invoked in the model to retrieve the contents for its item.

All callback selectors can have zero, one or two arguments with the item and the wrapper as first and second argument.!
!PluggableListItemWrapper methodsFor: 'accessing' stamp: 'ar 10/11/2003 21:49'!
getContentsSelector
	^getContentsSelector! !

!PluggableListItemWrapper methodsFor: 'accessing' stamp: 'ar 10/11/2003 21:48'!
getStringSelector
	^getStringSelector! !

!PluggableListItemWrapper methodsFor: 'accessing' stamp: 'ar 10/11/2003 23:39'!
string: aString
	string := aString! !

!PluggableListItemWrapper methodsFor: 'accessing' stamp: 'ar 10/11/2003 21:49'!
hasContentsSelector
	^hasContentsSelector! !

!PluggableListItemWrapper methodsFor: 'private' stamp: 'ar 10/11/2003 21:50'!
validateSelector: aSymbol
	(aSymbol numArgs between: 0 and: 2) ifFalse:[^self error: 'Invalid pluggable selector'].! !

!PluggableListItemWrapper methodsFor: 'accessing' stamp: 'ar 10/11/2003 23:39'!
string
	^string! !

!PluggableListItemWrapper methodsFor: 'accessing' stamp: 'ar 10/11/2003 21:49'!
hasContentsSelector: aSymbol
	self validateSelector: aSymbol.
	hasContentsSelector := aSymbol.! !

!PluggableListItemWrapper methodsFor: 'private' stamp: 'ar 10/11/2003 21:47'!
sendToModel: aSelector
	aSelector numArgs = 0 
		ifTrue:[^model perform: aSelector].
	aSelector numArgs = 1 
		ifTrue:[^model perform: aSelector with: item].
	aSelector numArgs = 2 
		ifTrue:[^model perform: aSelector with: item with: self].! !

!PluggableListItemWrapper methodsFor: 'accessing' stamp: 'ar 10/11/2003 21:49'!
getStringSelector: aSymbol
	self validateSelector: aSymbol.
	getStringSelector := aSymbol.! !

!PluggableListItemWrapper methodsFor: 'printing' stamp: 'ar 10/11/2003 23:21'!
printOn: aStream
	super printOn: aStream.
	aStream nextPut:$(; nextPutAll: self asString; nextPut:$).! !

!PluggableListItemWrapper methodsFor: 'accessing' stamp: 'ar 10/11/2003 21:50'!
getContentsSelector: aSymbol
	self validateSelector: aSymbol.
	getContentsSelector := aSymbol.! !

!PluggableListItemWrapper methodsFor: 'accessing' stamp: 'ar 10/11/2003 21:48'!
contents
	getContentsSelector ifNil:[^#()].
	^self sendToModel: getContentsSelector.! !

!PluggableListItemWrapper methodsFor: 'accessing' stamp: 'ar 10/11/2003 21:53'!
hasContents
	hasContentsSelector ifNil:[^super hasContents].
	^self sendToModel: hasContentsSelector
! !

!PluggableListItemWrapper methodsFor: 'accessing' stamp: 'ar 10/11/2003 23:39'!
asString
	string ifNotNil:[^string].
	getStringSelector ifNil:[^super asString].
	^self sendToModel: getStringSelector
! !

!PluggableListMorph commentStamp: '<historical>'!
...

When a PluggableListMorph is in focus, type in a letter (or several
letters quickly) to go to the next item that begins with that letter.
Special keys (up, down, home, etc.) are also supported.!
!PluggableListMorph methodsFor: '*glamour-morphic-widgets' stamp: 'cyrilledelaunay 6/6/2011 15:56'!
setOptimalResizing
	self hResizing: #rigid.
	self vResizing: #rigid! !

!PluggableListMorph methodsFor: 'menus' stamp: 'PeterHugossonMiller 9/3/2009 10:19'!
copyListToClipboard
	"Copy my items to the clipboard as a multi-line string"

	| stream |
	stream := (String new: self getList size * 40) writeStream.
	list do: [:ea | stream nextPutAll: ea asString] separatedBy: [stream nextPut: Character cr].
	Clipboard clipboardText: stream contents! !

!PluggableListMorph methodsFor: 'initialization' stamp: 'ls 2/9/2002 01:03'!
getListSelector: sel
	"Set the receiver's getListSelector as indicated, and trigger a recomputation of the list"

	getListSelector := sel.
	self changed.
	self updateList.! !

!PluggableListMorph methodsFor: 'obsolete' stamp: 'ar 3/17/2001 17:20'!
startDrag: evt onItem: itemMorph 
	self removeObsoleteEventHandlers.! !

!PluggableListMorph methodsFor: 'scrolling' stamp: 'gvc 2/19/2009 12:26'!
hUnadjustedScrollRange
	"Return the entire scrolling range."

	^self listMorph hUnadjustedScrollRange! !

!PluggableListMorph methodsFor: 'initialization' stamp: 'di 4/10/98 16:20'!
autoDeselect: trueOrFalse
	"Enable/disable autoDeselect (see class comment)"
	autoDeselect := trueOrFalse.! !

!PluggableListMorph methodsFor: 'accessing' stamp: ''!
getIndexSelector: aSelector

	getIndexSelector := aSelector! !

!PluggableListMorph methodsFor: 'initialization' stamp: ''!
initialize

	super initialize.
	self initForKeystrokes.! !

!PluggableListMorph methodsFor: 'initialization' stamp: 'ls 5/15/2001 22:21'!
font: aFontOrNil
	self listMorph font: aFontOrNil.
! !

!PluggableListMorph methodsFor: 'scroll cache' stamp: 'sps 4/3/2005 15:29'!
resetHScrollRangeIfNecessary

	hScrollRangeCache ifNil: [ ^self deriveHScrollRange ].

	(list isNil or: [list isEmpty]) 
		ifTrue:[^hScrollRangeCache := Array with: 0 with: 0 with: 0 with: 0 with: 0].

"Make a guess as to whether the scroll ranges need updating based on whether the size, first item, or last item of the list has changed"
	(
		(hScrollRangeCache third == list size) and: [
		(hScrollRangeCache fourth == list first) and: [
		(hScrollRangeCache fifth == list last)
	]])
		ifFalse:[self deriveHScrollRange].

! !

!PluggableListMorph methodsFor: 'separator' stamp: 'BenjaminVanRyseghem 5/7/2012 15:14'!
separatorAfterARow: aRow

	
	
	aRow ifNil: [ ^ false ].

	self separatorBlockOrSelector
		ifNotNil: [:blockOrSelector || anItem |
			anItem := getListElementSelector
						ifNil: [ list at: aRow ifAbsent: [ ^ false ]]
						ifNotNil: [ model perform: getListElementSelector with: aRow ].
						
			^ blockOrSelector isBlock
				ifTrue: [ blockOrSelector cull: anItem cull: aRow ]
				ifFalse: [
					blockOrSelector isSymbol
						ifTrue: [ blockOrSelector numArgs == 0
									ifTrue: [ anItem perform: blockOrSelector ]
									ifFalse: [ self model perform: blockOrSelector withEnoughArguments: { anItem. aRow} ]]
						ifFalse: [ false ]]].
	
	^ false! !

!PluggableListMorph methodsFor: 'wrapping' stamp: 'BenjaminVanRyseghem 11/29/2011 09:53'!
wrapItem: anItem index: anIndex
	"Use the wrapSelector to get the text or string representation of a list item."
	
	^ self wrapSelector 
		ifNil: [ anItem asStringOrText]
		ifNotNil: [:selector | 
			selector numArgs == 0
				ifTrue: [ anItem perform: selector ]
				ifFalse: [ self model perform: selector withEnoughArguments: { anItem. anIndex } ]].! !

!PluggableListMorph methodsFor: 'accessing' stamp: 'stephaneDucasse 7/17/2010 16:32'!
dragItemSelector
	^dragItemSelector! !

!PluggableListMorph methodsFor: 'drag and drop' stamp: 'ls 6/23/2001 00:10'!
potentialDropRow
	"return the row of the item that the most recent drop hovered over, or 0 if there is no potential drop target"
	^potentialDropRow ifNil: [ 0 ].
! !

!PluggableListMorph methodsFor: 'geometry' stamp: 'gvc 10/3/2008 13:05'!
optimalExtent
	"Answer the extent of the list morph."

	^self listMorph extent + (self borderWidth * 2) + self scrollBarThickness! !

!PluggableListMorph methodsFor: 'events' stamp: 'gvc 9/20/2006 10:24'!
mouseDownRow: anIntegerOrNil
	"Set the mouse down row or nil if none."

	self listMorph mouseDownRow: anIntegerOrNil! !

!PluggableListMorph methodsFor: 'multi-selection' stamp: 'BenjaminVanRyseghem 6/1/2011 11:26'!
isMultipleSelection

	^ self multipleSelection! !

!PluggableListMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/9/2012 11:28'!
getListElementSelector

	^ getListElementSelector! !

!PluggableListMorph methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 5/16/2013 12:26'!
startDragExtended: evt
	"This method was defined in PluggableListMorphPlus (a subclass that got merged)" 
	
	dragItemSelector ifNil: [^self].
	evt hand hasSubmorphs ifTrue: [^ self].
	[ | dragIndex draggedItem ddm ddRect |
	(self dragEnabled and: [model okToChange]) ifFalse: [^ self].
	dragIndex := self rowAtLocation: evt position.
	dragIndex = 0 ifTrue: [^self].
	draggedItem := model perform: dragItemSelector with: dragIndex.
	draggedItem ifNil: [^self].
	self mouseDownRow: nil.
	ddm := self model transferFor: draggedItem from: self.
	ddRect := ddm draggedMorph bounds.
	ddm position: evt position - (ddRect center - ddRect origin).
	ddm dragTransferType: #dragTransfer.
	evt hand grabMorph: ddm]
		ensure: [Cursor normal show.
			evt hand newMouseFocus: self]! !

!PluggableListMorph methodsFor: 'initialization' stamp: 'sw 1/18/2001 13:08'!
keystrokeActionSelector: keyActionSel
	"Set the keystroke action selector as specified"

	keystrokeActionSelector := keyActionSel! !

!PluggableListMorph methodsFor: 'menu' stamp: 'tk 12/10/2001 20:33'!
getMenu: shiftKeyState
	"Answer the menu for this text view, supplying an empty menu to be filled in. If the menu selector takes an extra argument, pass in the current state of the shift key."

	| aMenu |
	aMenu := super getMenu: shiftKeyState.
	aMenu ifNotNil: [aMenu commandKeyHandler: self].
	^ aMenu! !

!PluggableListMorph methodsFor: 'geometry' stamp: 'gvc 6/1/2009 15:18'!
focusBounds
	"Answer the bounds for drawing the focus indication."

	^self theme listFocusBoundsFor: self! !

!PluggableListMorph methodsFor: 'model access' stamp: 'GuillermoPolito 2/24/2012 12:37'!
commandKeyTypedIntoMenu: evt
	"The user typed a command-key into a menu which has me as its command-key handler"

	^ self modifierKeyPressed: evt! !

!PluggableListMorph methodsFor: 'event handling' stamp: 'gvc 1/11/2007 14:06'!
takesKeyboardFocus
	"Answer whether the receiver can normally take keyboard focus."

	^true! !

!PluggableListMorph methodsFor: 'searching' stamp: 'BenjaminVanRyseghem 4/4/2011 16:59'!
searchedElement

	^ searchedElement! !

!PluggableListMorph methodsFor: 'configuration' stamp: 'gvc 8/2/2007 13:34'!
disable
	"Disable the receiver."
	
	self enabled: false! !

!PluggableListMorph methodsFor: 'drawing' stamp: 'ls 5/17/2001 20:53'!
highlightSelection! !

!PluggableListMorph methodsFor: 'event handling' stamp: 'AlainPlantec 1/7/2010 22:32'!
mouseEnter: event
	"Changed to take keyboardFocusOnMouseDown  into account."
	
	super mouseEnter: event.
	self wantsKeyboardFocus ifFalse: [^self].
	self keyboardFocusOnMouseDown
		ifFalse: [self takeKeyboardFocus]! !

!PluggableListMorph methodsFor: 'separator' stamp: 'BenjaminVanRyseghem 9/16/2011 17:07'!
separatorColor

	^ separatorColor ifNil: [ separatorColor := Color gray ]! !

!PluggableListMorph methodsFor: 'scrolling' stamp: 'sps 12/24/2002 18:31'!
hExtraScrollRange
	"Return the amount of extra blank space to include to the right of the scroll content."
	^5 
! !

!PluggableListMorph methodsFor: 'events' stamp: 'BenjaminVanRyseghem 2/9/2012 18:17'!
navigationKey: anEvent

	self isMultipleSelection
		ifTrue: [ | keyString |
			keyString := anEvent keyString.
			keyString = '<Cmd-a>'
				ifTrue: [ 
					self selectAll.
					^ true ].
			keyString = '<Cmd-A>'
				ifTrue: [ 
					self deselectAll.
					^ true ]	].
				
	^ super navigationKey: anEvent! !

!PluggableListMorph methodsFor: 'event handling' stamp: 'GuillermoPolito 5/23/2012 11:40'!
keyboardFocusChange: aBoolean
	"The message is sent to a morph when its keyboard focus changes.
	Update for focus feedback."
	super keyboardFocusChange: aBoolean.
	self focusChanged! !

!PluggableListMorph methodsFor: 'events' stamp: 'ls 10/14/2001 13:08'!
handleBasicKeys: aBoolean
	"set whether the list morph should handle basic keys like arrow keys, or whether everything should be passed to the model"
	handlesBasicKeys := aBoolean! !

!PluggableListMorph methodsFor: 'scrolling' stamp: 'sps 12/26/2002 13:36'!
vUnadjustedScrollRange
	"Return the height extent of the receiver's submorphs."
	(scroller submorphs size > 0) ifFalse:[ ^0 ].
	^(scroller submorphs last fullBounds bottom)
! !

!PluggableListMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/10/2014 10:02'!
autoDeselect

	^ autoDeselect
		ifNil: [ self resetListSelector notNil ]
		ifNotNil: [ autoDeselect ]! !

!PluggableListMorph methodsFor: 'geometry' stamp: 'gvc 8/7/2007 12:39'!
fillStyleToUse
	"Answer the fillStyle that should be used for the receiver."
	
	^self enabled
		ifTrue: [self theme listNormalFillStyleFor: self]
		ifFalse: [self theme listDisabledFillStyleFor: self]! !

!PluggableListMorph methodsFor: 'model access' stamp: 'GuillermoPolito 9/1/2010 18:47'!
getCurrentSelectionIndex
	"Answer the index of the current selection."

	getIndexSelector ifNil: [^0].
	^model perform: getIndexSelector! !

!PluggableListMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 7/10/2014 16:04'!
getEnabledSelector: aSymbol
	"Set the value of getEnabledSelector"

	getEnabledSelector := aSymbol.
	self updateEnabled! !

!PluggableListMorph methodsFor: 'accessing' stamp: 'stephaneDucasse 7/17/2010 16:32'!
dropItemSelector
	^dropItemSelector! !

!PluggableListMorph methodsFor: 'initialization' stamp: 'EstebanLorenzano 9/21/2012 13:18'!
getListElementSelector: aSymbol
	"specify a selector that can be used to obtain a single element in the underlying list"
	self basicGetListElementSelector: aSymbol.
	list := nil.  "this cache will not be updated if getListElementSelector has been specified, so go ahead and remove it"
	self updateList.! !

!PluggableListMorph methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 6/1/2011 11:31'!
mouseUp: evt

	self isMultipleSelection
		ifTrue: [ self mouseUpOnMultiple: evt ]
		ifFalse: [ self mouseUpOnSingle: evt ]! !

!PluggableListMorph methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 6/1/2011 11:13'!
unhighlightSelection

	self searchedElement: nil.! !

!PluggableListMorph methodsFor: 'selection' stamp: 'BenjaminVanRyseghem 6/4/2011 15:21'!
resetListSelection

	self resetListSelectionSilently.
	self changed! !

!PluggableListMorph methodsFor: 'drag and drop' stamp: 'stephaneDucasse 7/18/2010 11:45'!
wantsDroppedMorph: aMorph event: anEvent
	^ aMorph dragTransferType == #dragTransfer 
		ifTrue: [ dropItemSelector ifNil: [^false].
			wantsDropSelector ifNil: [^true].
			(model perform: wantsDropSelector with: aMorph passenger)]
		ifFalse: [ self model wantsDroppedMorph: aMorph event: anEvent inMorph: self]! !

!PluggableListMorph methodsFor: 'event handling' stamp: 'GuillermoPolito 8/17/2012 14:36'!
mouseEnterDragging: evt
	"The mouse has entered with a button down.
	Workaround for apparent flaw in MouseOverHandler constantly
	sending this message when dragging.
	Do nothing if disabled."
	
	|row oldPDR|
	self enabled ifFalse: [^self].
	row := self rowAtLocation: evt position.
	(self dragEnabled or: [evt hand hasSubmorphs]) ifFalse: [
		row = 0 ifTrue: [ ^self ].
		self listMorph mouseDownRow: row].
	(evt hand hasSubmorphs and:[self dropEnabled]) ifFalse: ["no d&d"
		^super mouseEnterDragging: evt].
	potentialDropRow = row ifTrue: [^self].
	oldPDR := potentialDropRow.
	potentialDropRow := row.
	evt hand newMouseFocus: self.
	"above is ugly but necessary for now"
	(self wantsDroppedMorph: evt hand firstSubmorph event: evt )
		ifTrue: [self changed]
		ifFalse: [(oldPDR ifNil: [0]) > 0
				ifTrue: [self resetPotentialDropRow]
				ifFalse: [potentialDropRow := 0]]! !

!PluggableListMorph methodsFor: 'drag and drop' stamp: 'stephaneDucasse 7/18/2010 11:48'!
acceptDroppingMorph: aMorph event: evt 
	"This message is sent when a morph is dropped onto a morph that has     
	agreed to accept the dropped morph by responding 'true' to the     
	wantsDroppedMorph:Event: message. The default implementation just     
	adds the given morph to the receiver."
	"Here we let the model do its work."

	dropItemSelector 
		ifNotNil: [| item |
			dropItemSelector ifNil:[^self].
			item := aMorph passenger.
			model perform: dropItemSelector with: item with: potentialDropRow ]
		ifNil: [ 
			self model
				acceptDroppingMorph: aMorph
				event: evt
				inMorph: self ].			
	self resetPotentialDropRow.
	evt hand releaseMouseFocus: self.
	Cursor normal show.

! !

!PluggableListMorph methodsFor: 'accessing' stamp: 'stephaneDucasse 7/17/2010 16:33'!
wantsDropSelector: aSymbol
	wantsDropSelector := aSymbol! !

!PluggableListMorph methodsFor: 'event handling' stamp: 'gvc 9/12/2006 15:28'!
mouseLeaveDragging: anEvent
	"The mouse has left with a button down."
	
	(self dragEnabled or: [anEvent hand hasSubmorphs]) ifFalse: [
		self listMorph mouseDownRow: nil].
	(self dropEnabled and: [anEvent hand hasSubmorphs]) ifFalse: ["no d&d"
		^super mouseLeaveDragging: anEvent].
	self resetPotentialDropRow.
	anEvent hand releaseMouseFocus: self.
	"above is ugly but necessary for now"! !

!PluggableListMorph methodsFor: 'multi-selection' stamp: 'BenjaminVanRyseghem 6/1/2011 11:41'!
listSelectionAt: index put: value

	self searchedElement: nil.
	setSelectionListSelector ifNil:[^false].
	^model perform: setSelectionListSelector with: index with: value! !

!PluggableListMorph methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 5/16/2013 12:25'!
startDrag: evt 
	| transferMorph draggedItem passenger |

	dragItemSelector ifNotNil: [ ^self startDragExtended: evt ].
	evt hand hasSubmorphs ifTrue: [^ self]. 
	self dragEnabled ifFalse: [^ self].
	"Here I ensure at least one element is selected "
	ActiveHand anyButtonPressed ifFalse: [ ^self ].
			
	draggedItem := self getListItem: (self mouseDownRow ifNil: [ self lastNonZeroIndex ]).
	draggedItem ifNil: [ ^ self ].
	passenger := self model dragPassengersFor: draggedItem inMorph: self.
	passenger ifNil: [ ^ self ].
		
	transferMorph := self model transferFor: passenger from: self.
	transferMorph align: transferMorph draggedMorph bottomLeft  with: evt position.
	
	self mouseDownRow: nil.
	transferMorph dragTransferType: (self model dragTransferTypeForMorph: self).
	
	[evt hand grabMorph: transferMorph ] 
		ensure: [
			Cursor normal show.
			evt hand releaseMouseFocus: self] ! !

!PluggableListMorph methodsFor: 'selection' stamp: 'BenjaminVanRyseghem 6/1/2011 11:46'!
selection: item
	"Called from outside to request setting a new selection."

	self selectionIndex: (self getList indexOf: item)! !

!PluggableListMorph methodsFor: 'model access' stamp: 'BenjaminVanRyseghem 11/29/2011 09:57'!
getList
	"Answer the list to be displayed.  Caches the returned list in the 'list' ivar"
	getListSelector == nil ifTrue: [^ #()].
	list := model perform: getListSelector.
	list == nil ifTrue: [^ #()].
	list := list collectWithIndex: [ :item :index | self wrapItem: item index: index ].
	^ list! !

!PluggableListMorph methodsFor: 'initialization' stamp: 'EstebanLorenzano 9/21/2012 13:17'!
basicGetListElementSelector: aSymbol
	"specify a selector that can be used to obtain a single element in the underlying list"
	getListElementSelector := aSymbol.
! !

!PluggableListMorph methodsFor: 'accessing' stamp: 'stephaneDucasse 7/17/2010 16:33'!
dropItemSelector: aSymbol
	dropItemSelector := aSymbol.
	aSymbol ifNotNil:[self dropEnabled: true].! !

!PluggableListMorph methodsFor: 'submorphs-accessing' stamp: 'di 11/14/2001 13:57'!
allSubmorphNamesDo: nameBlock
	"Assume list morphs do not have named parts -- saves MUCH time"

	^ self! !

!PluggableListMorph methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 4/17/2012 16:51'!
initForKeystrokes
	canMove := true.
	lastKeystrokeTime := 0.
	lastKeystrokes := ''! !

!PluggableListMorph methodsFor: 'accessing' stamp: 'stephaneDucasse 7/17/2010 16:32'!
dragItemSelector: aSymbol
	dragItemSelector := aSymbol.
	aSymbol ifNotNil:[self dragEnabled: true].! !

!PluggableListMorph methodsFor: 'menus' stamp: 'StephaneDucasse 10/22/2014 22:04'!
addCustomMenuItems:  aMenu hand: aHandMorph
	"Add halo menu items to be handled by the invoking hand. The halo menu is invoked by clicking on the menu-handle of the receiver's halo."

	super addCustomMenuItems: aMenu hand: aHandMorph.
	aMenu addLine.
	aMenu add: 'list font...' target: self selector: #setListFont.
	aMenu add: 'copy list to clipboard' target: self selector: #copyListToClipboard.
	aMenu add: 'copy selection to clipboard' target: self selector: #copySelectionToClipboard! !

!PluggableListMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 7/10/2014 15:58'!
selectionColorToUse: aColor
	"Set the colour for selected items."

	aColor = self selectionColorToUse ifTrue: [^self].
	selectionColorToUse := aColor.
	self listMorph selectionFrameChanged! !

!PluggableListMorph methodsFor: 'accessing' stamp: ''!
setMultipleSelection: aBoolean

	multipleSelection := aBoolean! !

!PluggableListMorph methodsFor: 'searching' stamp: 'BenjaminVanRyseghem 5/10/2011 13:18'!
searchedElement: anInteger

	searchedElement := anInteger.
	anInteger
		ifNil: [
			" just for redrawn "
			self vScrollValue: (self scrollValue y) ]
		ifNotNil: [ self vScrollValue: ((anInteger-1)/self getListSize) ]! !

!PluggableListMorph methodsFor: 'searching' stamp: 'EstebanLorenzano 4/29/2014 17:29'!
secondarySelectionColor
	^ self theme secondarySelectionColor! !

!PluggableListMorph methodsFor: 'selection' stamp: 'di 6/21/1998 22:19'!
getListSelector
	^ getListSelector! !

!PluggableListMorph methodsFor: 'initialization' stamp: 'ls 5/17/2001 09:04'!
listMorphClass
	^LazyListMorph! !

!PluggableListMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/8/2011 15:14'!
wrapSelector

	^ wrapSelector! !

!PluggableListMorph methodsFor: 'accessing' stamp: 'ls 2/5/2004 18:01'!
listMorph
	listMorph ifNil: [
		"crate this lazily, in case the morph is legacy"
		listMorph := self listMorphClass new.
		listMorph listSource: self.
		listMorph width: self scroller width.
		listMorph color: self textColor ].

	listMorph owner ~~ self scroller ifTrue: [
		"list morph needs to be installed.  Again, it's done this way to accomodate legacy PluggableListMorphs"
		self scroller removeAllMorphs.
		self scroller addMorph: listMorph ].

	^listMorph! !

!PluggableListMorph methodsFor: 'multi-selection' stamp: 'GuillermoPolito 8/17/2012 13:58'!
mouseMoveOnSingle: evt
	"The mouse has moved with a button down.
	Do nothing if disabled."

	|row|
	self enabled ifFalse: [^self].
	row := self rowAtLocation: evt position.
	evt hand hasSubmorphs ifFalse: [
		((self containsPoint: evt position) and: [ row ~= 0 ]) 
			ifTrue: [self mouseDownRow: row]
			ifFalse: [self mouseDownRow: nil]].
	(self dropEnabled and:[evt hand hasSubmorphs]) 
		ifFalse: [^self eventHandler ifNotNil:
				[self eventHandler mouseMove: evt fromMorph: self]].
	(self containsPoint: evt position) 
		ifTrue: [self mouseEnterDragging: evt]
		ifFalse: [self mouseLeaveDragging: evt]! !

!PluggableListMorph methodsFor: 'initialization' stamp: 'nk 5/16/2003 14:40'!
textHighlightColor
	"Answer my default text highlight color."
	^self valueOfProperty: #textHighlightColor ifAbsent: [ Color red ].
! !

!PluggableListMorph methodsFor: 'event handling' stamp: 'GuillermoPolito 5/3/2013 10:53'!
mouseDown: evt
	"Changed to only take focus if wanted."

	| selectors row |
	row := self rowAtLocation: evt position.
	evt yellowButtonPressed
		ifTrue: [ 
			self isMultipleSelection
				ifTrue: [ 
					evt commandKeyPressed
						ifFalse: [ 
							"right click"
							(self yellowButtonActivity: evt shiftPressed)
								ifTrue: [ ^ super mouseDown: evt ] ] ]
				ifFalse: [ 
					(self yellowButtonActivity: evt shiftPressed)
						ifTrue: [ ^ super mouseDown: evt ] ] ].	"First check for option (menu) click"
	self enabled
		ifFalse: [ ^ super mouseDown: evt ].
	self wantsKeyboardFocus
		ifTrue: [ self takeKeyboardFocus ].
	row := self rowAtLocation: evt position.
	row = 0
		ifTrue: [ ^ super mouseDown: evt ].
	self mouseDownRow: row.
	self isMultipleSelection
		ifTrue: [ self mouseDownOnMultiple: evt forRow: row ].
	selectors := Array
		with: #click:
		with: (doubleClickSelector ifNotNil: [ #doubleClick: ])
		with: nil
		with:
			(self dragEnabled
				ifTrue: [ #startDrag: ]
				ifFalse: [ nil ]).
	evt hand
		waitForClicksOrDrag: self
		event: evt
		selectors: selectors
		threshold: 10.	"pixels"
	super mouseDown: evt! !

!PluggableListMorph methodsFor: '*FreeType-override' stamp: 'AlainPlantec 12/19/2009 23:59'!
setListFont
	"set the font for the list"

	StandardFonts chooseFontWithTitle: 'Choose the font for this list' translated  for: self setSelector: #font:  getSelector: #font
! !

!PluggableListMorph methodsFor: 'initialization' stamp: 'ls 5/22/2001 18:21'!
getListSizeSelector: aSymbol
	"specify a selector that can be used to specify the list's size"
	getListSizeSelector := aSymbol! !

!PluggableListMorph methodsFor: 'selection' stamp: 'ls 8/19/2001 14:20'!
selectedMorph
	"this doesn't work with the LargeLists patch!!  Use #selectionIndex and #selection instead."
	^self scroller submorphs at: self selectionIndex! !

!PluggableListMorph methodsFor: 'scrolling' stamp: 'adrian-lienhard 6/22/2009 00:00'!
numSelectionsInView
	"Answer the scroller's height based on the average number of submorphs."
		
	"ugly hack, due to code smell.
	PluggableListMorph added another level of indirection, 
	There is always only one submorph - a LazyListMorph which holds the actual list,
	but TransformMorph doesn't know that and we are left with a breach of interface."
		
	^scroller numberOfItemsPotentiallyInViewWith: scroller submorphs last getListSize.! !

!PluggableListMorph methodsFor: 'configuration' stamp: 'StephaneDucasse 7/10/2014 16:01'!
enabled
	"Answer the enablement state of the receiver."

	^enabled ifNil: [true]! !

!PluggableListMorph methodsFor: 'scroll cache' stamp: 'sps 4/3/2005 15:29'!
deriveHScrollRange

	|  unadjustedRange totalRange |
	(list isNil or: [list isEmpty]) 
		ifTrue:[hScrollRangeCache := Array with: 0 with: 0 with: 0 with: 0 with: 0 ]
		ifFalse:[ 
			unadjustedRange := self listMorph hUnadjustedScrollRange.
			totalRange := unadjustedRange + self hExtraScrollRange + self hMargin.
			hScrollRangeCache := Array 
										with: totalRange 
										with: unadjustedRange 
										with: list size 
										with: list first 
										with: list last .
		].
! !

!PluggableListMorph methodsFor: 'searching' stamp: 'BenjaminVanRyseghem 5/7/2012 15:01'!
listForSearching

	^ getListSelector
		ifNotNil: [ self getList ]
		ifNil: [ getListElementSelector
				ifNil: [ #() ]
				ifNotNil: [ 
					(1 to: self getListSize) collect: [:index | self getListItem: index ]]]
			! !

!PluggableListMorph methodsFor: 'updating' stamp: 'gvc 5/22/2007 14:48'!
themeChanged
	"Update the selection colour."

	self selectionColor ifNotNil: [
		self selectionColor: self theme selectionColor].
	super themeChanged! !

!PluggableListMorph methodsFor: 'selection' stamp: 'BenjaminVanRyseghem 12/20/2012 16:25'!
scrollSelectionIntoView
	"make sure that the current selection is visible"
	| row |
	row := self getCurrentSelectionIndex.
	self scrollSelectionToRow: row! !

!PluggableListMorph methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 2/9/2012 17:27'!
keyStroke: event 
	"Process keys 
	specialKeys are things like up, down, etc. ALWAYS HANDLED 
	modifierKeys are regular characters either 1) accompanied with ctrl, 
	cmd or 2) any character if the list doesn't want to handle basic 
	keys (handlesBasicKeys returns false) 
	basicKeys are any characters"
	| aChar |
	
	(self scrollByKeyboard: event) ifTrue: [^self].
	(self navigationKey: event) ifTrue: [^self].
	aChar := event keyCharacter.

	keystrokeSelector ifNotNil: [ 
		(self keystrokeAction: event) ifTrue: [ ^ self ] ].
	
	aChar asciiValue < 32 ifTrue: [^ self specialKeyPressed: event ].
	(event anyModifierKeyPressed or: [self handlesBasicKeys not])
		ifTrue: [^ self modifierKeyPressed: event].
	^ self basicKeyPressed: aChar! !

!PluggableListMorph methodsFor: 'selection' stamp: 'BenjaminVanRyseghem 12/20/2012 16:25'!
selectionIndex: index
	"Called internally to select the index-th item."
	| row |
	
	self unhighlightSelection.
	row := index ifNil: [ 0 ].
	row := row min: self maximumSelection.  "make sure we don't select past the end"
	self listMorph selectedRow: row.
	self highlightSelection.
	self scrollSelectionToRow: row.! !

!PluggableListMorph methodsFor: 'events' stamp: 'BenjaminVanRyseghem 4/17/2012 16:19'!
specialKeyPressed: anEvent
	"A special key with the given ascii-value was pressed; dispatch it"
	| keyString max nextSelection oldSelection howManyItemsShowing |
	
	keyString := anEvent keyString.
	keyString = '<escape>'
		ifTrue: [" escape key"
			^ ActiveEvent shiftPressed
				ifTrue:
					[ActiveWorld invokeWorldMenuFromEscapeKey]
				ifFalse:[ 
					(self yellowButtonActivity: false) 
						ifTrue: [ ^ self ]]].

	keyString = '<cr>'
		ifTrue: [ 
			"enter pressed" 
			self selectSearchedElement ].

	max := self maximumSelection.
	max > 0 ifFalse: [^ self].
	nextSelection := oldSelection := self getCurrentSelectionIndex.
	
	keyString = '<down>'
		ifTrue: [" down arrow"
			self resetListSelectionSilently.
			nextSelection := oldSelection + 1.
			nextSelection > max ifTrue: [nextSelection := max]].
	
	keyString = '<up>'
		ifTrue: [ " up arrow"
			self resetListSelectionSilently.
			nextSelection := oldSelection - 1.
			nextSelection < 1 ifTrue: [nextSelection := 1]].
	keyString = '<home>'
		ifTrue: [" home"
			self resetListSelectionSilently.
			nextSelection := 1].
		
	keyString = '<end>' 
		ifTrue: [" end"
			self resetListSelectionSilently.
			nextSelection := max].
	
	howManyItemsShowing := self numSelectionsInView.
	
	keyString = '<pageUp>'
		ifTrue: 	[" page up"
			self resetListSelectionSilently.
			nextSelection := 1 max: oldSelection - howManyItemsShowing].
	keyString = '<pageDown>'
		ifTrue: [" page down"
			self resetListSelectionSilently.
			nextSelection := oldSelection + howManyItemsShowing min: max].

	(self enabled and: [model okToChange]) ifFalse: [^ self].
	
	"No change if model is locked"
	
	oldSelection = nextSelection ifTrue: [^ self].
	^ self changeModelSelection: nextSelection! !

!PluggableListMorph methodsFor: 'multi-selection' stamp: 'BenjaminVanRyseghem 4/17/2012 17:14'!
mouseMoveOnMultiple: event

	"The mouse has moved, as characterized by the event provided.  Adjust the scrollbar, and alter the selection as appropriate"
	| oldIndex oldVal row |
	canMove ifFalse: [ ^ self ].
	
	event position y < self top 
		ifTrue: 
			[ scrollBar scrollUp: 1.
			row := self rowAtLocation: scroller topLeft + (1 @ 1)]
		ifFalse: 
			[ row := event position y > self bottom 
				ifTrue: 
					[scrollBar scrollDown: 1.
					self rowAtLocation: scroller bottomLeft + (1 @ -1)]
				ifFalse: [ self rowAtLocation: event position ]].
	
	row = 0 ifTrue: [ ^ super mouseDown: event ].

	(self potentialDropItem notNil and: [ self dropEnabled ]) ifTrue: [ ^ self ].
	
	dragOnOrOff ifNil: 
			["Was not set at mouse down, which means the mouse must have gone down in an area where there was no list item"
				dragOnOrOff := (self listSelectionAt: row) not ].

	"Set meaning for subsequent dragging of selection"
	oldIndex := self getCurrentSelectionIndex.
	oldIndex ~= 0 ifTrue: [ oldVal := self listSelectionAt: oldIndex ].

	"Need to restore the old one, due to how model works, and set new one."
	oldIndex ~= 0 ifTrue: [ self listSelectionAt: oldIndex put: oldVal ].
	self listSelectionAt: row put: dragOnOrOff.
	row changed! !

!PluggableListMorph methodsFor: 'obsolete' stamp: 'ar 3/17/2001 17:20'!
mouseLeaveDragging: anEvent onItem: aMorph 
	self removeObsoleteEventHandlers.! !

!PluggableListMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 7/10/2014 15:57'!
selectionColorToUse
	"Answer the colour to use for selected items."

	^ selectionColorToUse ifNil: [self theme settings selectionColor] ! !

!PluggableListMorph methodsFor: 'selection' stamp: 'ls 8/19/2001 14:29'!
selection 
	self selectionIndex = 0 ifTrue: [ ^nil ].
	list ifNotNil: [ ^list at: self selectionIndex ].
	^ self getListItem: self selectionIndex! !

!PluggableListMorph methodsFor: 'selection' stamp: 'di 5/6/1998 21:20'!
setSelectedMorph: aMorph
	self changeModelSelection: (scroller submorphs indexOf: aMorph)! !

!PluggableListMorph methodsFor: 'configuration' stamp: 'gvc 8/2/2007 13:34'!
enable
	"Enable the receiver."
	
	self enabled: true! !

!PluggableListMorph methodsFor: 'accessing' stamp: 'ls 5/17/2001 20:31'!
rowAtLocation: aPoint
	"Return the row at the given point or 0 if outside"
	| pointInListMorphCoords |
	pointInListMorphCoords := (self scroller transformFrom: self) transform: aPoint.
	^self listMorph rowAtLocation: pointInListMorphCoords.! !

!PluggableListMorph methodsFor: 'scroll cache' stamp: 'sps 4/3/2005 15:29'!
resetHScrollRange

	hScrollRangeCache := nil.
	self deriveHScrollRange.
! !

!PluggableListMorph methodsFor: 'debug and other' stamp: 'bf 2/17/2006 17:25'!
userString
	^list! !

!PluggableListMorph methodsFor: 'separator' stamp: 'BenjaminVanRyseghem 9/16/2011 17:07'!
separatorSize

	^ separatorSize ifNil: [ separatorSize := 1 ]! !

!PluggableListMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/23/2013 01:02'!
lastNonZeroIndex

	^ lastNonZeroIndex ifNil: [ lastNonZeroIndex := 0 ]! !

!PluggableListMorph methodsFor: 'multi-selection' stamp: 'BenjaminVanRyseghem 6/1/2011 11:26'!
isSingleSelection

	^ self multipleSelection not! !

!PluggableListMorph methodsFor: 'obsolete' stamp: 'ar 3/17/2001 17:20'!
removeObsoleteEventHandlers
	scroller submorphs do:[:m|
		m eventHandler: nil; highlightForMouseDown: false; resetExtension].! !

!PluggableListMorph methodsFor: 'background coloring' stamp: 'BenjaminVanRyseghem 9/16/2011 16:46'!
backgroundColoringBlockOrSelector

	^ backgroundColoringBlockOrSelector ! !

!PluggableListMorph methodsFor: 'event handling' stamp: 'ar 9/15/2000 22:57'!
handlesKeyboard: evt
	^true! !

!PluggableListMorph methodsFor: 'selection' stamp: 'BenjaminVanRyseghem 6/4/2011 15:21'!
resetListSelectionSilently

	self resetListSelector ifNotNil: [:sel | self model perform: sel ]! !

!PluggableListMorph methodsFor: '*Keymapping-Core' stamp: 'ThierryGoubier 9/15/2012 22:26'!
initializeShortcuts: aKMDispatcher
	super initializeShortcuts: aKMDispatcher.
	aKMDispatcher attachCategory: #MorphFocusNavigation! !

!PluggableListMorph methodsFor: 'updating' stamp: 'AlainPlantec 1/7/2010 22:32'!
verifyContents
	"Verify the contents of the receiver, reconstituting if necessary.  Called whenever window is reactivated, to react to possible structural changes.  Also called periodically in morphic if the smartUpdating setting is true"
	| newList existingSelection oldList |
	oldList := list ifNil: [ #() ].
	newList := self getList.
	((oldList == newList) "fastest" or: [oldList = newList]) ifTrue: [^ self].
	existingSelection := oldList isEmpty
		ifTrue: [self listMorph selectedRow]
		ifFalse: [(self selectionIndex between: 1 and: newList size)
					ifTrue: [self selectionIndex]
					ifFalse: [nil]].
	self updateList.
	existingSelection notNil
		ifTrue:
			[model noteSelectionIndex: existingSelection for: getListSelector.
			self selectionIndex: existingSelection]
		ifFalse:
			[self changeModelSelection: 0]! !

!PluggableListMorph methodsFor: 'menus' stamp: 'MarcusDenker 10/3/2013 23:48'!
copySelectionToClipboard
	"Copy my selected item to the clipboard as a string"

	self selection ifNotNil: [ Clipboard clipboardText: self selection asString ] ifNil: [ self flash ]! !

!PluggableListMorph methodsFor: 'updating' stamp: 'gvc 9/8/2009 13:25'!
updateEnabled
	"Update the enablement state."

	self model ifNotNil: [
		self getEnabledSelector ifNotNil: [
			self enabled: (self model perform: self getEnabledSelector)]]! !

!PluggableListMorph methodsFor: 'events' stamp: 'ls 10/14/2001 13:09'!
handlesBasicKeys
	" if ya don't want the list to automatically handle non-modifier key 
	(excluding shift key) input, return false"
	^ handlesBasicKeys ifNil: [ true ]! !

!PluggableListMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 7/10/2014 15:57'!
selectionColor: aColor
	"Set the colour for selected items."

	| w |
	selectionColor := aColor.
	w := self ownerThatIsA: SystemWindow.
	self selectionColorToUse:
			((self theme settings fadedBackgroundWindows not or: [ w isNil or: [ w isActive ] ])
				ifTrue: [ aColor ]
				ifFalse: [ self theme unfocusedSelectionColor ])! !

!PluggableListMorph methodsFor: 'separator' stamp: 'CamilloBruni 9/16/2011 16:24'!
separatorBlockOrSelector

	^ separatorBlockOrSelector! !

!PluggableListMorph methodsFor: 'scrolling' stamp: 'gvc 10/19/2006 15:24'!
vExtraScrollRange
	"Return the amount of extra blank space to include below the bottom of the scroll content."

	^8
! !

!PluggableListMorph methodsFor: 'event handling' stamp: 'MarcusDenker 7/26/2014 09:25'!
basicKeyPressed: aChar
	"Return the index of the element matching the keystrokes.
	Returns 0 if nothing found"

	| nextSelection milliSeconds slowKeyStroke oldSelection |
	nextSelection := oldSelection := self getCurrentSelectionIndex.
	milliSeconds := Time millisecondClockValue.
	slowKeyStroke := milliSeconds - lastKeystrokeTime > 500.
	lastKeystrokeTime := milliSeconds.
	self searchedElement: nil.
	lastKeystrokes := slowKeyStroke
		ifTrue: [ aChar asLowercase asString ]
		ifFalse: [ lastKeystrokes , aChar asLowercase asString ].	"forget previous keystrokes and search in following elements"	"append quick keystrokes but don't move selection if it still matches"	"Get rid of blanks and style used in some lists"
	nextSelection := self listForSearching findFirst: [ :a | a beginsWith: lastKeystrokes fromList: self ].
	nextSelection isZero
		ifTrue: [ ^ 0 ].	"No change if model is locked"
	model okToChange
		ifFalse: [ ^ 0 ].	"No change if model is locked"	"The following line is a workaround around the behaviour of OBColumn>>selection:,
	 which deselects when called twice with the same argument."
	oldSelection = nextSelection
		ifTrue: [ ^ 0 ].	"change scrollbarvalue"
	self searchedElement: nextSelection.
	^ nextSelection! !

!PluggableListMorph methodsFor: 'separator' stamp: 'BenjaminVanRyseghem 9/16/2011 16:57'!
separatorColor: aColor

	separatorColor := aColor! !

!PluggableListMorph methodsFor: 'obsolete' stamp: 'ar 3/17/2001 17:19'!
doubleClick: event onItem: aMorph
	self removeObsoleteEventHandlers.! !

!PluggableListMorph methodsFor: 'multi-selection' stamp: 'BenjaminVanRyseghem 6/1/2011 11:50'!
defaultMultipleSelectionValue

	^ false! !

!PluggableListMorph methodsFor: 'model access' stamp: 'MarcusDenker 9/13/2013 16:27'!
keystrokeAction: event 
	| returnValue |
	
	keystrokeSelector ifNil: [ ^ nil ].

	returnValue := model 
						perform: keystrokeSelector
						withEnoughArguments: { event. self }.
	
	^ returnValue = true! !

!PluggableListMorph methodsFor: 'separator' stamp: 'BenjaminVanRyseghem 9/16/2011 16:53'!
separatorBlockOrSelector: aBlockOrSelector

	separatorBlockOrSelector := aBlockOrSelector! !

!PluggableListMorph methodsFor: 'multi-selection' stamp: 'BenjaminVanRyseghem 6/1/2011 11:50'!
multipleSelection

	^ multipleSelection ifNil: [ multipleSelection := self defaultMultipleSelectionValue ]! !

!PluggableListMorph methodsFor: 'initialization' stamp: 'di 5/22/1998 00:32'!
listItemHeight
	"This should be cleaned up.  The list should get spaced by this parameter."
	^ 12! !

!PluggableListMorph methodsFor: 'initialization' stamp: 'sw 1/12/2000 16:22'!
doubleClickSelector: aSymbol
	doubleClickSelector := aSymbol! !

!PluggableListMorph methodsFor: 'multi-selection' stamp: 'BenjaminVanRyseghem 10/7/2011 20:06'!
listSelectionAt: index

	index isZero ifFalse:[ lastNonZeroIndex := index ].
	getSelectionListSelector ifNil:[^false].
	^model perform: getSelectionListSelector with: index! !

!PluggableListMorph methodsFor: 'initialization' stamp: 'ls 5/15/2001 22:21'!
font

	^ self listMorph font
! !

!PluggableListMorph methodsFor: 'background coloring' stamp: 'BenjaminVanRyseghem 1/6/2014 15:54'!
backgroundColorFor: aRow

	| return |
	aRow ifNil: [ ^ nil ].
	self enabled
		ifFalse: [ return := Color white darker darker ].
	self backgroundColoringBlockOrSelector
		ifNotNil: [:blockOrSelector || anItem |
			anItem := getListElementSelector
						ifNil: [ list at: aRow ifAbsent: [ ^ nil ]]
						ifNotNil: [ model perform: getListElementSelector with: aRow ].

			return := blockOrSelector isBlock
				ifTrue: [ blockOrSelector cull: anItem cull: aRow ]
				ifFalse: [
					blockOrSelector isSymbol
						ifTrue: [ blockOrSelector numArgs == 0
									ifTrue: [ anItem perform: blockOrSelector ]
									ifFalse: [ self model perform: blockOrSelector withEnoughArguments: { anItem. aRow} ]]
						ifFalse: [ nil ]]].
		
		^ return isColor
			ifTrue: [ return ]
			ifFalse: [ nil ]! !

!PluggableListMorph methodsFor: 'selection' stamp: 'BenjaminVanRyseghem 2/9/2012 17:32'!
selectAll

	self isMultipleSelection ifFalse: [ ^ self ].
	1 to: self maximumSelection do: [: i | self listSelectionAt: i put: true ]! !

!PluggableListMorph methodsFor: 'model access' stamp: 'BenjaminVanRyseghem 11/29/2011 09:57'!
getListItem: index
	"get the index-th item in the displayed list"
	| element |
	getListElementSelector ifNotNil: [ ^ self wrapItem: (model perform: getListElementSelector with: index) index: index ].
	list ifNotNil: [ ^ list at: index ].
	
	element := self getList at: index.
	^ self wrapItem: element index: index! !

!PluggableListMorph methodsFor: 'obsolete' stamp: 'ar 3/17/2001 17:20'!
mouseEnterDragging: anEvent onItem: aMorph 
	self removeObsoleteEventHandlers.! !

!PluggableListMorph methodsFor: 'event handling' stamp: 'ar 3/17/2001 16:16'!
handleMouseMove: anEvent
	"Reimplemented because we really want #mouseMove when a morph is dragged around"
	anEvent wasHandled ifTrue:[^self]. "not interested"
	(anEvent anyButtonPressed and:[anEvent hand mouseFocus == self]) ifFalse:[^self].
	anEvent wasHandled: true.
	self mouseMove: anEvent.
	(self handlesMouseStillDown: anEvent) ifTrue:[
		"Step at the new location"
		self startStepping: #handleMouseStillDown: 
			at: Time millisecondClockValue
			arguments: {anEvent copy resetHandlerFields}
			stepTime: 1].
! !

!PluggableListMorph methodsFor: 'drag and drop' stamp: 'ls 6/23/2001 00:01'!
resetPotentialDropRow
	potentialDropRow ifNotNil: [
	potentialDropRow ~= 0 ifTrue: [
		potentialDropRow := 0.
		self changed. ] ]! !

!PluggableListMorph methodsFor: 'updating' stamp: 'PhilippeBack 5/9/2014 18:40'!
updateList
	| index |
	"the list has changed -- update from the model"
	self listMorph listChanged.
	self setScrollDeltas.
	scrollBar setValue: 0.0.
	index := self getCurrentSelectionIndex.
	self resetPotentialDropRow.
	index ifNotNil: [ 
		index := index min: self getListSize.
		index > 0 ifTrue: [	self selectionIndex: index].
	].
	
	self searchedElement: nil.
! !

!PluggableListMorph methodsFor: 'accessing' stamp: 'stephaneDucasse 7/17/2010 16:33'!
wantsDropSelector
	^wantsDropSelector! !

!PluggableListMorph methodsFor: 'initialization' stamp: 'EstebanLorenzano 4/29/2014 15:45'!
textColor
	"Answer my default text color."
	^ self 
		valueOfProperty: #textColor 
		ifAbsent: [ self theme textColor ]
! !

!PluggableListMorph methodsFor: 'geometry' stamp: 'ls 5/17/2001 21:01'!
scrollDeltaHeight
	"Return the increment in pixels which this pane should be scrolled."
	^ self font height! !

!PluggableListMorph methodsFor: 'multi-selection' stamp: 'BenjaminVanRyseghem 6/1/2011 11:24'!
beSingleSelection

	multipleSelection := false! !

!PluggableListMorph methodsFor: 'drag and drop' stamp: 'ls 6/23/2001 00:01'!
potentialDropItem
	"return the item that the most recent drop hovered over, or nil if there is no potential drop target"
	self potentialDropRow = 0 ifTrue: [ ^self ].
	^self getListItem: self potentialDropRow! !

!PluggableListMorph methodsFor: 'multi-selection' stamp: 'BenjaminVanRyseghem 4/17/2012 17:14'!
mouseDownOnMultiple: event forRow: row

	| anInteger oldIndex oldVal valueKeeper |
	
	"Set meaning for subsequent dragging of selection"
	canMove ifFalse: [ ^ self ].
	canMove := false.
	model okToChange ifFalse: [ 
		canMove := true.
		^ self ].
	canMove := true.
	
	dragOnOrOff := (self listSelectionAt: row) not.
	valueKeeper := dragOnOrOff.
	" I store the value because #mouseUpOnMultiple: can reset dragOnOrOff before the end of this method (in case of halt by example)"
	(event shiftPressed not and: [event yellowButtonPressed not and: [ self autoDeselect ]])
		ifTrue: [ self resetListSelection ].
	oldIndex := self getCurrentSelectionIndex.
	oldIndex ~= 0 ifTrue: [oldVal := self listSelectionAt: oldIndex].

	"Set or clear new primary selection (listIndex)"
	anInteger := valueKeeper
					ifTrue: [ row ]
					ifFalse: [ 0 ].
	
	setIndexSelector ifNotNil:
		[ model perform: setIndexSelector with: anInteger ].
	
	"Need to restore the old one, due to how model works, and set new one."
	oldIndex ~= 0 ifTrue: [self listSelectionAt: oldIndex put: oldVal].
	
	event shiftPressed
		ifTrue: [((oldIndex max: 1) min: row) to: (oldIndex max: row) do: [:i |
					self listSelectionAt: i put: valueKeeper].
				self changed]
		ifFalse: [self listSelectionAt: row put: valueKeeper].! !

!PluggableListMorph methodsFor: 'selection' stamp: 'ls 6/22/2001 22:49'!
selectionIndex
	"return the index we have currently selected, or 0 if none"
	^self listMorph selectedRow ifNil: [ 0 ]! !

!PluggableListMorph methodsFor: 'model access' stamp: 'BenjaminVanRyseghem 2/23/2013 01:03'!
changeModelSelection: anInteger
	"Change the model's selected item index to be anInteger."

	setIndexSelector ifNotNil:
		[model perform: setIndexSelector with: anInteger].
	self isMultipleSelection
		ifTrue: [ 
			self listSelectionAt: self lastNonZeroIndex put: false.
			self listSelectionAt: anInteger put: true ]! !

!PluggableListMorph methodsFor: 'event handling' stamp: 'gvc 9/12/2006 14:52'!
handleFocusEvent: anEvent
	"Handle the given event. This message is sent if the receiver currently has the focus and is therefore receiving events directly from some hand."
	
	self processEvent: anEvent. "give submorphs a chance"
	(anEvent isMouse and: [anEvent isMouseDown and: [(self fullContainsPoint: anEvent position) not]])
		ifFalse: [^super handleFocusEvent: anEvent].
	"click outside - pass to event handler"
	self eventHandler
		ifNotNil: [self eventHandler mouseDown: anEvent fromMorph: self]! !

!PluggableListMorph methodsFor: 'multi-selection' stamp: 'BenjaminVanRyseghem 6/1/2011 11:47'!
resetListSelector

	^ resetListSelector! !

!PluggableListMorph methodsFor: 'selection' stamp: 'ls 5/17/2001 23:06'!
maximumSelection
	^ self getListSize! !

!PluggableListMorph methodsFor: 'drawing' stamp: 'AlainPlantec 2/11/2011 16:50'!
adoptPaneColor: paneColor
	"Pass on to the border too."
	
	super adoptPaneColor: paneColor.
	paneColor ifNil: [^self].
	self selectionColor: self selectionColor.
	self fillStyle: self fillStyleToUse.
	self borderWidth > 0 ifTrue: [
		self borderStyle: self borderStyleToUse]! !

!PluggableListMorph methodsFor: 'selection' stamp: 'di 5/22/1998 00:20'!
minimumSelection
	^ 1! !

!PluggableListMorph methodsFor: 'initialization' stamp: 'ls 2/5/2004 18:02'!
textColor: aColor
	"Set my default text color."
	self setProperty: #textColor toValue: aColor.
	self listMorph color: aColor.! !

!PluggableListMorph methodsFor: 'model access' stamp: 'CamilloBruni 8/11/2011 06:29'!
keystrokeSelector: aSymbol
	keystrokeSelector := aSymbol! !

!PluggableListMorph methodsFor: 'searching' stamp: 'BenjaminVanRyseghem 2/18/2012 16:14'!
selectSearchedElement

	self searchedElement ifNotNil: [: index |	
			 ActiveEvent commandKeyPressed	ifFalse: [ self resetListSelectionSilently ].
			self changeModelSelection: index.
			self isMultipleSelection
				ifTrue: [ self listSelectionAt: index put: true ].
			self vScrollValue: ((index-1)/self getListSize) ]! !

!PluggableListMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 7/10/2014 15:54'!
selectionColor
	"Answer the colour to use for selected items."

	^ selectionColor ifNil: [self theme selectionColor] ! !

!PluggableListMorph methodsFor: 'multi-selection' stamp: 'BenjaminVanRyseghem 6/1/2011 11:23'!
mouseUpOnMultiple: event
	"Reset the mouseDownRow."
	
	dragOnOrOff := nil.  "So improperly started drags will have not effect".
	event hand hasSubmorphs ifFalse: [
		self mouseDownRow: nil]! !

!PluggableListMorph methodsFor: 'accessing' stamp: ''!
setIndexSelector: aSelector

	setIndexSelector := aSelector! !

!PluggableListMorph methodsFor: 'accessing' stamp: 'ar 3/17/2001 15:32'!
itemFromPoint: aPoint
	"Return the list element (morph) at the given point or nil if outside"
	| ptY |
	scroller hasSubmorphs ifFalse:[^nil].
	(scroller fullBounds containsPoint: aPoint) ifFalse:[^nil].
	ptY := (scroller firstSubmorph point: aPoint from: self) y.
	"note: following assumes that submorphs are vertical, non-overlapping, and ordered"
	scroller firstSubmorph top > ptY ifTrue:[^nil].
	scroller lastSubmorph bottom < ptY ifTrue:[^nil].
	"now use binary search"
	^scroller 
		findSubmorphBinary:[:item|
			(item top <= ptY and:[item bottom >= ptY])
				ifTrue:[0] "found"
				ifFalse:[ (item top + item bottom // 2) > ptY ifTrue:[-1] ifFalse:[1]]]! !

!PluggableListMorph methodsFor: 'accessing' stamp: 'EstebanLorenzano 9/21/2012 13:13'!
wrapSelector: aSymbol

	self basicWrapSelector: aSymbol.
	self updateList.! !

!PluggableListMorph methodsFor: 'multi-selection' stamp: 'BenjaminVanRyseghem 6/1/2011 11:54'!
on: anObject list: listSel primarySelection: getSelectionSel changePrimarySelection: setSelectionSel listSelection: getListSel changeListSelection: setListSel menu: getMenuSel keystroke: keyActionSel
	"setup a whole load of pluggability options"
	getSelectionListSelector := getListSel.
	setSelectionListSelector := setListSel.
	self on: anObject list: listSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel.
	self beMultipleSelection.
	^ self
! !

!PluggableListMorph methodsFor: 'multi-selection' stamp: 'BenjaminVanRyseghem 6/1/2011 11:17'!
beMultipleSelection

	multipleSelection := true! !

!PluggableListMorph methodsFor: 'separator' stamp: 'BenjaminVanRyseghem 9/16/2011 16:57'!
separatorSize: anInteger

	separatorSize := anInteger! !

!PluggableListMorph methodsFor: 'model access' stamp: 'ls 5/17/2001 22:04'!
getListSize
	"return the current number of items in the displayed list"
	getListSizeSelector ifNotNil: [ ^model perform: getListSizeSelector ].
	^self getList size! !

!PluggableListMorph methodsFor: 'configuration' stamp: 'StephaneDucasse 7/10/2014 16:00'!
enabled: aBoolean
	"Set the enablement state of the receiver."

	aBoolean = self enabled
		ifFalse: [ enabled :=  aBoolean.
				self adoptPaneColor: self paneColor;
					changed]! !

!PluggableListMorph methodsFor: 'model access' stamp: 'BenjaminVanRyseghem 4/17/2012 15:34'!
itemSelectedAmongMultiple: index
	"return whether the index-th row is selected.  Always false in PluggableListMorph, but sometimes true in PluggableListMorphOfMany"

	^ self isMultipleSelection
		ifTrue: [ (self listSelectionAt: index) == true ]
		ifFalse: [ false ]! !

!PluggableListMorph methodsFor: 'initialization' stamp: 'nk 5/16/2003 14:37'!
textHighlightColor: aColor
	"Set my default text highlight color."
	self setProperty: #textHighlightColor toValue: aColor.
! !

!PluggableListMorph methodsFor: 'accessing' stamp: 'EstebanLorenzano 9/21/2012 13:13'!
basicWrapSelector: aSymbol
	wrapSelector := aSymbol.! !

!PluggableListMorph methodsFor: 'event handling' stamp: 'gvc 9/12/2006 14:23'!
handlesMouseOverDragging: evt
	"Yes, for mouse down highlight."
	
	^true! !

!PluggableListMorph methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 4/17/2012 16:44'!
mouseMove: evt

	self isMultipleSelection
		ifTrue: [ self mouseMoveOnMultiple: evt ]
		ifFalse: [ self mouseMoveOnSingle:evt ]! !

!PluggableListMorph methodsFor: 'selection' stamp: 'BenjaminVanRyseghem 2/9/2012 17:41'!
deselectAll

	self isMultipleSelection ifFalse: [ ^ self ].
	self resetListSelection! !

!PluggableListMorph methodsFor: 'model access' stamp: 'CamilloBruni 8/11/2011 06:42'!
modifierKeyPressed: event 
	| args aChar |
	aChar := event keyCharacter.
	keystrokeActionSelector ifNil: [ ^ nil ].
	args := keystrokeActionSelector numArgs.
	args = 1 ifTrue: [^ model perform: keystrokeActionSelector with: aChar].
	args = 2 
		ifTrue: 
			[^model 
				perform: keystrokeActionSelector
				with: aChar
				with: self].
	^self error: 'keystrokeActionSelector must be a 1- or 2-keyword symbol'! !

!PluggableListMorph methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 7/18/2013 14:20'!
update: aParameter 
	"Refer to the comment in View|update:."

	(aParameter == getListSelector or: [ aParameter == getListElementSelector ]) ifTrue: 
		[self updateList.
		^ self].
	aParameter == getIndexSelector ifTrue:
		[self selectionIndex: self getCurrentSelectionIndex.
		^ self].
	aParameter == #allSelections ifTrue:
		[self selectionIndex: self getCurrentSelectionIndex.
		^ self changed].
	
	aParameter isArray ifFalse: [ ^ self ].
	aParameter size == 2 ifFalse: [ ^ self ].
	
	aParameter first = #setMultipleSelection: ifTrue: [ self setMultipleSelection: aParameter second ]! !

!PluggableListMorph methodsFor: 'geometry' stamp: 'sps 3/9/2004 15:33'!
extent: newExtent
	super extent: newExtent.
	
	"Change listMorph's bounds to the new width. It is either the size
	of the widest list item, or the size of self, whatever is bigger"
	self listMorph width: ((self width max: listMorph hUnadjustedScrollRange) + 20). 
! !

!PluggableListMorph methodsFor: 'multi-selection' stamp: 'BenjaminVanRyseghem 1/10/2014 09:49'!
mouseUpOnSingle: event
	"The mouse came up within the list; take appropriate action"
	
	| row mdr |
	row := self rowAtLocation: event position.
	event hand hasSubmorphs ifFalse: [
		mdr := self mouseDownRow.
		 self mouseDownRow: nil.
		mdr ifNil: [^self]].

	(self enabled and: [model okToChange])
		ifFalse: [^ self].

	"No change if model is locked or receiver disabled"
	row == self selectionIndex
		ifTrue: [
			self autoDeselect 
				ifTrue: [ row = 0 ifFalse: [ self changeModelSelection: 0 ] ]
				ifFalse: [ self changeModelSelection: row ] ]
		ifFalse: [ self changeModelSelection: row ].
	Cursor normal show! !

!PluggableListMorph methodsFor: 'background coloring' stamp: 'CamilloBruni 9/16/2011 16:34'!
backgroundColoringBlockOrSelector: aSelector

	backgroundColoringBlockOrSelector := aSelector! !

!PluggableListMorph methodsFor: 'selection' stamp: 'BenjaminVanRyseghem 12/20/2012 16:25'!
scrollSelectionToRow: row
	"make sure that the current selection is visible"

	row = 0 ifTrue: [ ^ self ].
	self scrollToShow: (self listMorph drawBoundsForRow: row)! !

!PluggableListMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 7/10/2014 16:04'!
getEnabledSelector
	"Answer the value of getEnabledSelector"

	^ getEnabledSelector ifNil: [ nil ]! !

!PluggableListMorph methodsFor: 'obsolete' stamp: 'ar 3/17/2001 17:19'!
mouseDown: event onItem: aMorph
	self removeObsoleteEventHandlers.! !

!PluggableListMorph methodsFor: 'scrolling' stamp: 'gvc 8/27/2009 11:58'!
resizeScrollBars
	"Fixed to not use deferred message that incorrectly
	sets scroll deltas/interval."

	(self extent = self defaultExtent)
		ifFalse: [super resizeScrollBars]! !

!PluggableListMorph methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 6/1/2011 12:01'!
on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel 
	self model: anObject.
	getListSelector := getListSel.
	getIndexSelector := getSelectionSel.
	setIndexSelector := setSelectionSel.
	getMenuSelector := getMenuSel.
	keystrokeActionSelector := keyActionSel.
	self autoDeselect: true.
	self borderWidth: 1.
	self updateList.
	self selectionIndex: self getCurrentSelectionIndex.
	self initForKeystrokes! !

!PluggableListMorph methodsFor: 'accessing' stamp: 'gvc 9/20/2006 10:24'!
mouseDownRow
	"Answer the mouse down row or nil if none."

	^self listMorph mouseDownRow! !

!PluggableListMorph methodsFor: 'accessing' stamp: ''!
setSelectionListSelector: getListSel.

	setSelectionListSelector := getListSel! !

!PluggableListMorph methodsFor: 'accessing' stamp: ''!
getSelectionListSelector: getListSel.

	getSelectionListSelector := getListSel! !

!PluggableListMorph methodsFor: 'obsolete' stamp: 'ar 3/17/2001 17:20'!
mouseUp: event onItem: aMorph 
	self removeObsoleteEventHandlers.! !

!PluggableListMorph methodsFor: 'geometry' stamp: 'sps 3/9/2004 17:31'!
scrollDeltaWidth
"A guess -- assume that the width of a char is approx 1/2 the height of the font"
	^ self scrollDeltaHeight // 2

! !

!PluggableListMorph methodsFor: 'multi-selection' stamp: 'BenjaminVanRyseghem 6/1/2011 11:47'!
resetListSelector: aSelector

	resetListSelector := aSelector! !

!PluggableListMorph methodsFor: 'events' stamp: 'GuillermoPolito 9/1/2010 18:40'!
doubleClick: event
	| index |
	doubleClickSelector ifNil: [^super doubleClick: event].
	index := self rowAtLocation: event position.
	index = 0 ifTrue: [^super doubleClick: event].
	"selectedMorph ifNil: [self setSelectedMorph: aMorph]."
	^ self model perform: doubleClickSelector! !

!PluggableListMorph methodsFor: 'geometry' stamp: 'gvc 8/7/2007 12:42'!
borderStyleToUse
	"Answer the borderStyle that should be used for the receiver."
	
	^self enabled
		ifTrue: [self theme listNormalBorderStyleFor: self]
		ifFalse: [self theme listDisabledBorderStyleFor: self]! !

!PluggableListMorph class methodsFor: 'instance creation' stamp: 'md 7/13/2005 16:33'!
on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel
	"Create a 'pluggable' list view on the given model parameterized by the given message selectors."

	^ self new
		on: anObject
		list: getListSel
		selected: getSelectionSel
		changeSelected: setSelectionSel
		menu: getMenuSel
		keystroke: keyActionSel
! !

!PluggableListMorph class methodsFor: 'instance creation' stamp: 'md 7/13/2005 16:33'!
on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel
	"Create a 'pluggable' list view on the given model parameterized by the given message selectors."

	^ self new
		on: anObject
		list: getListSel
		selected: getSelectionSel
		changeSelected: setSelectionSel
		menu: nil
		keystroke: #arrowKey:from:		"default"! !

!PluggableListMorph class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 6/1/2011 11:47'!
on: anObject list: listSel primarySelection: getSelectionSel changePrimarySelection: setSelectionSel listSelection: getListSel changeListSelection: setListSel menu: getMenuSel keystroke: keyActionSel 
	^ self new
		on: anObject
		list: listSel
		primarySelection: getSelectionSel
		changePrimarySelection: setSelectionSel
		listSelection: getListSel
		changeListSelection: setListSel
		menu: getMenuSel
		keystroke: keyActionSel! !

!PluggableListMorph class methodsFor: 'instance creation' stamp: 'md 7/13/2005 16:33'!
on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel
	"Create a 'pluggable' list view on the given model parameterized by the given message selectors."

	^ self new
		on: anObject
		list: getListSel
		selected: getSelectionSel
		changeSelected: setSelectionSel
		menu: getMenuSel
		keystroke: #arrowKey:from:		"default"
! !

!PluggableListMorph class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 6/1/2011 11:47'!
on: anObject list: listSel primarySelection: getSelectionSel changePrimarySelection: setSelectionSel listSelection: getListSel changeListSelection: setListSel menu: getMenuSel
	^ self new
		on: anObject
		list: listSel
		primarySelection: getSelectionSel
		changePrimarySelection: setSelectionSel
		listSelection: getListSel
		changeListSelection: setListSel
		menu: getMenuSel
		keystroke: #arrowKey:from:		"default"! !

!PluggableMenuItemSpec commentStamp: 'StephaneDucasse 9/30/2014 20:22'!
I'm a spec for an item menu. The World menu pragma based registration uses it for now. I'm moved in this package so that later we can decide what to do with it. 
We could probably avoid MenuSpec and just use MenuMorph instead. !
!PluggableMenuItemSpec methodsFor: 'accessing' stamp: 'ar 2/28/2006 17:22'!
subMenu: aMenuSpec
	"Answer the receiver's subMenu"
	subMenu := aMenuSpec! !

!PluggableMenuItemSpec methodsFor: 'accessing' stamp: 'ar 2/28/2006 17:22'!
separator: aBool
	"Indicate whether the receiver should be followed by a separator"
	separator := aBool.! !

!PluggableMenuItemSpec methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/13/2011 17:24'!
enabled
	"Answer whether the receiver is enabled"
	^ enabledBlock
		ifNil:[enabled ifNil: [ true ]]
		ifNotNil: [ enabledBlock value ]! !

!PluggableMenuItemSpec methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/13/2011 17:23'!
enabledBlock

	^ enabledBlock! !

!PluggableMenuItemSpec methodsFor: 'accessing' stamp: 'ar 2/28/2006 17:22'!
subMenu
	"Answer the receiver's subMenu"
	^subMenu! !

!PluggableMenuItemSpec methodsFor: 'accessing' stamp: 'ar 2/28/2006 17:23'!
action
	"Answer the action associated with the receiver"
	^action! !

!PluggableMenuItemSpec methodsFor: 'accessing' stamp: 'EstebanLorenzano 1/30/2013 16:45'!
keyText
	^keyText! !

!PluggableMenuItemSpec methodsFor: '*Spec-Core' stamp: 'BenjaminVanRyseghem 11/29/2013 15:16'!
addToMenuGroupModel: aMenuGroupModel

	aMenuGroupModel addItem: [ :item | item fromSpec: self ]! !

!PluggableMenuItemSpec methodsFor: 'accessing' stamp: 'StephaneDucasse 9/30/2014 20:20'!
help: aSymbol 
	"Indicate the message to retrieve the help texts of this element."
	help := aSymbol! !

!PluggableMenuItemSpec methodsFor: 'accessing' stamp: 'ar 2/28/2006 17:21'!
enabled: aBool
	"Indicate whether the receiver is enabled"
	enabled := aBool! !

!PluggableMenuItemSpec methodsFor: 'morphic' stamp: 'StephaneDucasse 10/26/2014 17:27'!
morphClass
	^ ToggleMenuItemMorph! !

!PluggableMenuItemSpec methodsFor: 'accessing' stamp: 'ar 2/28/2006 17:21'!
label: aString
	"Set the receiver's label"
	label := aString! !

!PluggableMenuItemSpec methodsFor: '*Spec-Core' stamp: 'BenjaminVanRyseghem 11/29/2013 16:05'!
addToMenuItemModel: aMenuItemModel
	| en |
	
	en := self enabledBlock ifNil: [ self enabled ].
	
	aMenuItemModel
		name: self label;
		state: self checked;
		enabled: en;
		icon: self icon;
		shortcut: self keyText;
		subMenu:self subMenu;
		action: self action! !

!PluggableMenuItemSpec methodsFor: 'accessing' stamp: 'ar 2/28/2006 17:28'!
separator
	"Answer whether the receiver should be followed by a separator"
	^separator ifNil:[false]! !

!PluggableMenuItemSpec methodsFor: 'accessing' stamp: 'EstebanLorenzano 1/30/2013 16:44'!
keyText: aString
	keyText := aString.! !

!PluggableMenuItemSpec methodsFor: 'morphic' stamp: 'EstebanLorenzano 1/30/2013 16:45'!
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! !

!PluggableMenuItemSpec methodsFor: 'accessing' stamp: 'AlainPlantec 2/10/2010 08:19'!
hasCheckBox	
	^ checked notNil! !

!PluggableMenuItemSpec methodsFor: 'accessing' stamp: 'ar 2/28/2006 17:23'!
action: aMessageSend
	"Answer the action associated with the receiver"
	action := aMessageSend! !

!PluggableMenuItemSpec methodsFor: 'accessing' stamp: 'AlainPlantec 2/12/2010 22:22'!
icon: aForm
	 icon := aForm! !

!PluggableMenuItemSpec methodsFor: 'accessing' stamp: 'StephaneDucasse 9/30/2014 20:20'!
name: anObject
	name := anObject! !

!PluggableMenuItemSpec methodsFor: 'accessing' stamp: 'AlainPlantec 2/8/2010 11:16'!
checked
	"Answer whether the receiver is checked"
	^checked ! !

!PluggableMenuItemSpec methodsFor: 'accessing' stamp: 'ar 2/28/2006 17:20'!
label
	"Answer the receiver's label"
	^label! !

!PluggableMenuItemSpec methodsFor: 'accessing' stamp: 'StephaneDucasse 9/30/2014 20:20'!
help
	"Answer the message to get the help texts of this element."
	^ help! !

!PluggableMenuItemSpec methodsFor: 'accessing' stamp: 'ar 2/28/2006 17:21'!
checked: aBool
	"Indicate whether the receiver is checked"
	checked := aBool.! !

!PluggableMenuItemSpec methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/13/2011 17:23'!
enabledBlock: aBlock

	enabledBlock := aBlock! !

!PluggableMenuItemSpec methodsFor: 'accessing' stamp: 'StephaneDucasse 9/30/2014 20:20'!
name
	^ name! !

!PluggableMenuItemSpec methodsFor: 'accessing' stamp: 'AlainPlantec 2/12/2010 22:22'!
icon
	^ icon! !

!PluggableMenuSpec commentStamp: 'StephaneDucasse 9/30/2014 20:21'!
I'm a spec for a menu. The World menu pragma based registration uses it for now. I'm moved in this package so that later we can decide what to do with it. 
We could probably avoid MenuSpec and just use MenuMorph instead. !
!PluggableMenuSpec methodsFor: 'accessing' stamp: 'ar 2/28/2006 17:12'!
label: aString
	label := aString.! !

!PluggableMenuSpec methodsFor: 'construction' stamp: 'ar 2/28/2006 17:27'!
addMenuItem
	| item |
	item := self newMenuItem.
	self items add: item.
	^item! !

!PluggableMenuSpec methodsFor: 'construction' stamp: 'StephaneDucasse 10/26/2014 17:26'!
addSeparator
	self items isEmpty
		ifTrue: [ ^ nil ].
	self items last separator: true! !

!PluggableMenuSpec methodsFor: '*Spec-Core' stamp: 'StephaneDucasse 3/5/2014 10:10'!
addToMenuModel: aMenuModel
	| groups tmp |
	
	groups := OrderedCollection new.
	self label ifNotNil: [ aMenuModel title: self label ]. "only change the title when a new one is specified"
	
	tmp := OrderedCollection new.
	self items do: [ :each | 
		tmp add: each.
		each separator
			ifTrue: [ 
				groups add: tmp copy.
				tmp removeAll ] ].
	tmp ifNotEmpty: [ groups add: tmp copy ].
	
	groups do: [ :each | aMenuModel 
		addGroup: [ :group | each do: [ :spec | 
			group addItem: [ :item | item fromSpec: spec ] ] ] ]! !

!PluggableMenuSpec methodsFor: 'accessing' stamp: 'cwp 6/8/2005 23:36'!
model
	^ model! !

!PluggableMenuSpec methodsFor: 'construction' stamp: 'StephaneDucasse 10/27/2014 09:34'!
add: aString selector: aMessageSend
	| item |
	item := self addMenuItem.
	item label: aString translated.
	item action: aMessageSend.
	^item! !

!PluggableMenuSpec methodsFor: 'accessing' stamp: 'StephaneDucasse 10/26/2014 17:26'!
label
	^ label! !

!PluggableMenuSpec methodsFor: 'construction' stamp: 'StephaneDucasse 10/26/2014 17:26'!
add: aString selector: aSelector argumentList: anArray
	^ self add: aString action: (MessageSend receiver: model selector: aSelector arguments: anArray)! !

!PluggableMenuSpec methodsFor: 'morphic' stamp: 'StephaneDucasse 10/26/2014 17:24'!
asMenuMorph
	| prior menu myitems |
	prior := parentMenu.
	parentMenu := menu := self morphClass new.
	self label ifNotNil: [ parentMenu addTitle: self label ].
	prior ifNil: [ menu addStayUpIcons ].
	myitems := self items.
	myitems do: [ :each | each asMenuItemMorphFrom: parentMenu isLast: each = myitems last ].
	parentMenu := prior.
	^ menu! !

!PluggableMenuSpec methodsFor: 'morphic' stamp: 'StephaneDucasse 10/26/2014 17:25'!
buildWith: aBuilder
	^ self asMenuMorph! !

!PluggableMenuSpec methodsFor: 'construction' stamp: 'StephaneDucasse 10/26/2014 17:26'!
newMenuItem
	^ PluggableMenuItemSpec new! !

!PluggableMenuSpec methodsFor: 'construction' stamp: 'StephaneDucasse 10/26/2014 17:24'!
addList: aList
	"Add the given items to this menu, where each item is a pair (<string> <actionSelector>)..  If an element of the list is simply the symobl $-, add a line to the receiver.  The optional third element of each entry, if present, provides balloon help."

	aList
		do: [ :tuple | 
			tuple == #-
				ifTrue: [ self addSeparator ]
				ifFalse: [ 
					| item |
					item := self
								add: tuple first
								target: model
								selector: tuple second
								argumentList: #().
					(tuple size > 2 and: [ tuple third notNil ])
						ifTrue: [ item help: tuple third ].
					(tuple size > 3 and: [ tuple fourth notNil ])
						ifTrue: [ item icon: (self theme iconNamed: tuple fourth) ] ] ]! !

!PluggableMenuSpec methodsFor: 'construction' stamp: 'StephaneDucasse 10/22/2014 21:33'!
add: aString action: aMessageSend
	| item |
	item := self addMenuItem.
	item label: aString translated.
	item action: aMessageSend.
	^item! !

!PluggableMenuSpec methodsFor: 'construction' stamp: 'AlainPlantec 2/8/2010 11:23'!
add: aString
	^ self add: aString action: nil
	! !

!PluggableMenuSpec methodsFor: 'morphic' stamp: 'StephaneDucasse 10/26/2014 17:25'!
morphClass
	^ MenuMorph! !

!PluggableMenuSpec methodsFor: 'accessing' stamp: 'cwp 6/8/2005 23:36'!
model: anObject 
	model := anObject! !

!PluggableMenuSpec methodsFor: 'construction' stamp: 'StephaneDucasse 10/26/2014 17:25'!
add: aString target: anObject selector: aSelector argumentList: anArray
	^ self add: aString translated action: (MessageSend receiver: anObject selector: aSelector arguments: anArray)! !

!PluggableMenuSpec methodsFor: 'accessing' stamp: 'StephaneDucasse 10/26/2014 17:26'!
items
	^ items ifNil: [ items := OrderedCollection new ]! !

!PluggableMenuSpec class methodsFor: 'example' stamp: 'MarcusDenker 7/8/2012 12:12'!
exampleWithTwoSimpleItems
	"self exampleWithTwoSimpleItems"
	| s |
	s := (self withModel: Transcript ) label: 'Hello'. 
	s add: 'Print Hello' action: (MessageSend receiver: [Transcript show: 'Hello', String cr] selector: #value).
	s add: 'Print Hello again' selector: #show: argumentList: {'Hello again', String cr}.
	s asMenuMorph popUpInWorld! !

!PluggableMenuSpec class methodsFor: 'example' stamp: 'MarcusDenker 7/8/2012 12:13'!
exampleWithSubMenu
	"
	self exampleWithSubMenu
	"
	| s i sub |
	s := (self withModel: nil ) label: 'Tools'. 
	i := s add: 'Tools'.
	sub := (self withModel: nil ).
	sub add: 'System browser'  target: Smalltalk tools selector: #openClassBrowser argumentList: #().
	sub add: 'Workspace'  target: Smalltalk tools selector: #openWorkspace argumentList: #().
	i subMenu: sub.
	s asMenuMorph popUpInWorld! !

!PluggableMenuSpec class methodsFor: 'instance creation' stamp: 'cwp 6/9/2005 00:22'!
withModel: aModel
	^ self new model: aModel! !

!PluggableMenuSpec class methodsFor: 'example' stamp: 'MarcusDenker 7/8/2012 12:11'!
exampleWithOneSingleItem
	"self exampleWithOneSingleItem"
	
	| s |
	s := (self withModel: nil ) label: 'Hello'. 
	s add: 'Print Hello' action: (MessageSend receiver: [Transcript show: 'Hello', String cr] selector: #value).
	s asMenuMorph popUpInWorld! !

!PluggableMorphListMorph commentStamp: 'gvc 5/18/2007 12:30'!
A type of PluggableListMorph that supports morphs for items. Useful for lists with icons etc.!
!PluggableMorphListMorph methodsFor: 'geometry' stamp: 'gvc 5/3/2006 14:23'!
extent: newExtent
	"Change listMorph's bounds to the new width. It is either the size
	of the widest list item, or the size of self, whatever is bigger"

	super extent: newExtent.
	self listMorph width: (self innerBounds width max: listMorph hUnadjustedScrollRange). 
! !

!PluggableMorphListMorph methodsFor: 'scrolling' stamp: 'gvc 5/3/2006 14:24'!
hExtraScrollRange
	"Return the amount of extra blank space to include to the right of the scroll content."

	^12! !

!PluggableMorphListMorph methodsFor: 'initialization' stamp: 'gvc 5/3/2006 09:50'!
listMorphClass
	"Answer the class to use for the list morph."

	^LazyMorphListMorph! !

!PluggableMorphListMorph methodsFor: 'model access' stamp: 'gvc 10/17/2008 12:38'!
getList
	"Answer the list to be displayed.  Caches the returned list in the 'list' ivar"

	getListSelector isNil ifTrue: [^#()].
	list := model perform: getListSelector.
	list isNil ifTrue: [^ #()].
	^list! !

!PluggableMultiColumnListMorph commentStamp: '<historical>'!
This morph can be used to show a list having multiple columns,  The columns are self width sized to make the largest entry in each list fit.  In some cases the pane may then be too narrow.

Use it like a regular PluggableListMorph except pass in an array of lists instead of a single list.

There are base assumptions made here that each list in the array of lists is the same size.

Also, the highlight color for the selection is easy to modify in the #highlightSelection method.  I used blue
when testing just to see it work.!
!PluggableMultiColumnListMorph methodsFor: 'initialization' stamp: 'BenjmainVanRyseghem 11/5/2011 11:33'!
on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel  wrapSelector: wrapSel
	self model: anObject.
	getListSelector := getListSel.
	getIndexSelector := getSelectionSel.
	setIndexSelector := setSelectionSel.
	getMenuSelector := getMenuSel.
	keystrokeActionSelector := keyActionSel.
	wrapSelector := wrapSel.
	self autoDeselect: true.
	self borderWidth: 1.
	self updateList.
	self selectionIndex: self getCurrentSelectionIndex.
	self initForKeystrokes! !

!PluggableMultiColumnListMorph methodsFor: 'searching' stamp: 'BenjaminVanRyseghem 2/13/2012 17:38'!
listForSearching

	^ super listForSearching collect: #first! !

!PluggableMultiColumnListMorph methodsFor: 'accessing' stamp: 'nk 4/5/2001 23:18'!
itemFromPoint: aPoint
	"Return the list element (morph) at the given point or nil if outside"
	| ptY |
	scroller hasSubmorphs ifFalse:[^nil].
	(scroller fullBounds containsPoint: aPoint) ifFalse:[^nil].
	ptY := (scroller firstSubmorph point: aPoint from: self) y.
	"note: following assumes that submorphs are vertical, non-overlapping, and ordered"
	scroller firstSubmorph top > ptY ifTrue:[^nil].
	scroller lastSubmorph bottom < ptY ifTrue:[^nil].
	"now use binary search"
	^scroller submorphThat: [ :item | item top <= ptY and:[item bottom >= ptY] ] ifNone: [].
! !

!PluggableMultiColumnListMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/8/2011 13:01'!
gapSize

	^ gapSize ifNil: [ gapSize := 10 ]! !

!PluggableMultiColumnListMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/6/2011 15:40'!
getListSize
	| l |
	getListSizeSelector ifNotNil: [ ^model perform: getListSizeSelector ].

	l := self getList.
	l isEmpty ifTrue: [ ^ 0 ].
	^l size! !

!PluggableMultiColumnListMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/6/2011 13:42'!
getListRow: row
	"return the strings that should appear in the requested row"
	getListElementSelector ifNotNil: [ ^model perform: getListElementSelector with: row ].
	^self getList at: row! !

!PluggableMultiColumnListMorph methodsFor: 'accessing' stamp: 'ls 5/17/2001 20:01'!
listMorphClass
	^MulticolumnLazyListMorph! !

!PluggableMultiColumnListMorph methodsFor: 'model access' stamp: 'ls 11/14/2002 13:13'!
basicKeyPressed: aChar
	"net supported for multi-column lists; which column should be used?!!  The issue is that the base class implementation uses getList expecting a single collectino to come back instead of several of them"
	^self! !

!PluggableMultiColumnListMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/8/2011 13:09'!
gapSize: anInteger

	gapSize := anInteger.! !

!PluggableMultiColumnListMorph class methodsFor: 'instance creation' stamp: 'BenjmainVanRyseghem 11/5/2011 11:32'!
on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel wrapSelector: wrapSel
	"Create a 'pluggable' list view on the given model parameterized by the given message selectors."

	^ self new
		on: anObject
		list: getListSel
		selected: getSelectionSel
		changeSelected: setSelectionSel
		menu: getMenuSel
		keystroke: keyActionSel
		wrapSelector: wrapSel! !

!PluggableMultiColumnListMorph class methodsFor: 'instance creation' stamp: 'BenjmainVanRyseghem 11/5/2011 11:36'!
on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel wrapSelector: wrapSel
	"Create a 'pluggable' list view on the given model parameterized by the given message selectors."

	^ self new
		on: anObject
		list: getListSel
		selected: getSelectionSel
		changeSelected: setSelectionSel
		menu: getMenuSel
		keystroke: #arrowKey:from:	"default"
		wrapSelector: wrapSel! !

!PluggableSet commentStamp: 'MarcusDenker 3/23/2010 18:47'!
PluggableSets allow the redefinition of hashing and equality by clients. This is in particular useful if the clients know about specific properties of the objects stored in the set which in turn can heavily improve the performance of sets and dictionaries.

Note: As of Pharo 1.1#11284, using normal Dictionary is actually faster as the bench below shows... ;-)

Instance variables:
	hashBlock	<BlockContext>	A one argument block used for hashing the elements.
	equalBlock	<BlockContext>	A two argument block used for comparing the elements.

Example: Adding 1000 integer points in the range (0@0) to: (100@100) to a set.

	| rnd set max pt |
	set := Set new: 1000.
	rnd := Random new.
	max := 100.
	Time millisecondsToRun:[
		1 to: 1000 do:[:i|
			pt := (rnd next * max) truncated @ (rnd next * max) truncated.
			set add: pt.
		].
	].

The above is way slow since the default hashing function of points leads to an awful lot of collisions in the set. And now the same, with a somewhat different hash function:

	| rnd set max pt |
	set := PluggableSet new: 1000.
	set hashBlock:[:item| (item x bitShift: 16) + item y].
	rnd := Random new.
	max := 100.
	Time millisecondsToRun:[
		1 to: 1000 do:[:i|
			pt := (rnd next * max) truncated @ (rnd next * max) truncated.
			set add: pt.
		].
	].
!
!PluggableSet methodsFor: 'accessing' stamp: 'ar 11/12/1998 19:02'!
hashBlock: aBlock
	"Set a new hash block. The block must accept one argument and return the hash value of the given argument."
	hashBlock := aBlock.! !

!PluggableSet methodsFor: 'accessing' stamp: 'ar 11/27/1998 23:55'!
equalBlock: aBlock
	"Set a new equality block. The block must accept two arguments and return true if the argumets are considered equal, false otherwise"
	equalBlock := aBlock.! !

!PluggableSet methodsFor: 'copying' stamp: 'nice 10/5/2009 10:15'!
copyEmpty
	^super copyEmpty
		hashBlock: hashBlock;
		equalBlock: equalBlock! !

!PluggableSet methodsFor: 'accessing' stamp: 'ar 11/12/1998 18:43'!
hashBlock
	"Return the block used for hashing the elements in the receiver."
	^hashBlock! !

!PluggableSet methodsFor: 'accessing' stamp: 'ar 11/12/1998 18:43'!
equalBlock
	"Return the block used for comparing the elements in the receiver."
	^equalBlock! !

!PluggableSet methodsFor: 'private' stamp: 'IgorStasenko 5/30/2011 18:54'!
scanFor: anObject
	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."

	| index start |
	index := start := (hashBlock ifNil: [anObject hash] ifNotNil: [ hashBlock value: anObject]) \\ array size + 1.
	[ 
		| element |
		((element := array at: index) == nil or: [ 
			equalBlock ifNil: [element enclosedSetElement = anObject] ifNotNil: [ 
				equalBlock value: element enclosedSetElement value: anObject ]])
			ifTrue: [ ^index ].
		(index := index \\ array size + 1) = start ] whileFalse.
	self errorNoFreeSpace! !

!PluggableSet methodsFor: 'private' stamp: 'HenrikSperreJohansen 9/1/2010 22:52'!
scanForEmptySlotFor: aKey
	"Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements."
	
	| index start |
	index := start := (hashBlock
		ifNil: [ aKey hash ]
		ifNotNil: [ hashBlock value: aKey ]) \\ array size + 1.
	[ 
		(array at: index) ifNil: [ ^index ].
		(index := index \\ array size + 1) = start ] whileFalse.
	self errorNoFreeSpace! !

!PluggableSet class methodsFor: 'as yet unclassified' stamp: 'dvf
6/10/2000 18:13'!
integerSet
	^self new hashBlock: [:integer | integer hash \\ 1064164 * 1009]! !

!PluggableSetTest commentStamp: 'TorstenBergmann 2/20/2014 15:28'!
SUnit tests for pluggable sets!
!PluggableSetTest methodsFor: 'requirements' stamp: 'CamilloBruni 7/3/2013 12:58'!
classToBeTested

	^ PluggableSet! !

!PluggableSetTest class methodsFor: 'building suites' stamp: 'cyrille.delaunay 6/29/2009 12:34'!
classToBeTested

^ IdentitySet! !

!PluggableSliderMorph commentStamp: 'gvc 7/16/2007 13:57'!
A pluggable slider (rather than one that auto-generates access selectors). Needs to be themed...!
!PluggableSliderMorph methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/18/2012 16:14'!
updateLabel
	"Update the label."
	
	self model ifNotNil: [:m |
		self getLabelSelector ifNotNil: [:selector | 
			self label: (m perform: selector) ]]! !

!PluggableSliderMorph methodsFor: 'accessing' stamp: 'gvc 6/20/2007 14:31'!
getValueSelector
	"Answer the value of getValueSelector"

	^ getValueSelector! !

!PluggableSliderMorph methodsFor: 'initialization' stamp: 'gvc 6/20/2007 15:02'!
defaultColor
	"Answer the default color/fill style for the receiver."
	
	^Color white! !

!PluggableSliderMorph methodsFor: 'accessing' stamp: 'gvc 8/3/2007 15:19'!
enabled
	"Answer the value of enabled"

	^ enabled! !

!PluggableSliderMorph methodsFor: 'protocol' stamp: 'gvc 8/3/2007 15:25'!
borderStyleToUse
	"Answer the borderStyle that should be used for the receiver."
	
	^self enabled
		ifTrue: [self theme sliderNormalBorderStyleFor: self]
		ifFalse: [self theme sliderDisabledBorderStyleFor: self]! !

!PluggableSliderMorph methodsFor: 'accessing' stamp: 'gvc 8/9/2007 10:43'!
max
	"Answer the value of max"

	^ max! !

!PluggableSliderMorph methodsFor: 'event handling' stamp: 'gvc 6/20/2007 14:27'!
handlesMouseDown: evt
	"Answer true." 

	^true! !

!PluggableSliderMorph methodsFor: 'accessing' stamp: 'gvc 8/7/2007 11:58'!
adoptPaneColor: paneColor
	"Pass on to the border too."
	
	super adoptPaneColor: paneColor.
	paneColor ifNil: [^self].
	self
		fillStyle: self fillStyleToUse;
		borderStyle: self borderStyleToUse;
		sliderColor: (self enabled
			ifTrue: [paneColor twiceDarker]
			ifFalse: [self paneColor twiceDarker paler])! !

!PluggableSliderMorph methodsFor: 'accessing' stamp: 'gvc 6/20/2007 14:31'!
getValueSelector: anObject
	"Set the value of getValueSelector"

	getValueSelector := anObject! !

!PluggableSliderMorph methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 7/18/2012 16:05'!
initialize
	"Initialize the receiver."

	min := 0.
	max := 1.
	label := ''.
	super initialize.
	self enabled: true! !

!PluggableSliderMorph methodsFor: 'layout' stamp: 'gvc 8/3/2007 15:14'!
layoutBounds: aRectangle
	"Set the bounds for laying out children of the receiver.
	Note: written so that #layoutBounds can be changed without touching this method"
	
	super layoutBounds: aRectangle.
	self computeSlider! !

!PluggableSliderMorph methodsFor: 'scrolling' stamp: 'gvc 8/7/2007 10:37'!
scrollAbsolute: event
	"Ignore if disabled."
	
	self enabled ifFalse: [^self].
	^super scrollAbsolute: event! !

!PluggableSliderMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/18/2012 16:05'!
getLabelSelector

	^ getLabelSelector! !

!PluggableSliderMorph methodsFor: 'accessing' stamp: 'gvc 8/9/2007 11:14'!
quantum
	"Answer the value of quantum"

	^ quantum! !

!PluggableSliderMorph methodsFor: 'other events' stamp: 'gvc 8/7/2007 10:36'!
mouseDownInSlider: event
	"Ignore if disabled."
	
	self enabled ifFalse: [^self].
	^super mouseDownInSlider: event! !

!PluggableSliderMorph methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 7/18/2012 16:34'!
labelGap
	
	^ 2! !

!PluggableSliderMorph methodsFor: 'accessing' stamp: 'gvc 8/9/2007 11:18'!
setValueSelector
	"Answer the set selector."
	
	^setValueSelector! !

!PluggableSliderMorph methodsFor: 'accessing' stamp: 'gvc 8/9/2007 11:20'!
quantum: anObject
	"Set the value of quantum"

	quantum := anObject.
	self setValue: self value! !

!PluggableSliderMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/14/2013 15:44'!
label: aLabel

	label := aLabel.
	self changed.! !

!PluggableSliderMorph methodsFor: 'drawing' stamp: 'EstebanLorenzano 4/29/2014 15:44'!
fontColor

	^ self theme textColor! !

!PluggableSliderMorph methodsFor: 'event handling' stamp: 'gvc 6/20/2007 14:28'!
scrollPoint: event
	"Scroll to the event position."
	
	| r p |
	r := self roomToMove.
	bounds isWide
		ifTrue: [r width = 0 ifTrue: [^ self]]
		ifFalse: [r height = 0 ifTrue: [^ self]].
	p := event position - (self sliderThickness // 2) adhereTo: r.
	self descending
		ifFalse:
			[self setValue: (bounds isWide 
				ifTrue: [(p x - r left) asFloat / r width]
				ifFalse: [(p y - r top) asFloat / r height])]
		ifTrue:
			[self setValue: (bounds isWide
				ifTrue: [(r right - p x) asFloat / r width]
				ifFalse:	[(r bottom - p y) asFloat / r height])]! !

!PluggableSliderMorph methodsFor: 'protocol' stamp: 'gvc 8/3/2007 15:19'!
enable
	"Enable the receiver."
	
	self enabled: true! !

!PluggableSliderMorph methodsFor: 'accessing' stamp: 'gvc 8/3/2007 15:21'!
enabled: anObject
	"Set the value of enabled"

	enabled = anObject ifTrue: [^self].
	enabled := anObject.
	self changed: #enabled.
	self
		adoptPaneColor: self paneColor;
		changed! !

!PluggableSliderMorph methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/18/2013 14:34'!
update: aParameter

	aParameter = getEnabledSelector 		ifTrue: [ ^ self updateEnabled ].
	aParameter = getValueSelector 		ifTrue: [ ^ self updateValue ].
	aParameter = getLabelSelector 		ifTrue: [ ^ self updateLabel ].
			
	aParameter isArray ifFalse: [ ^ self ].
	aParameter size == 2 ifFalse: [ ^ self ].
	
	aParameter first = #max: ifTrue: [ self max: aParameter second ].
	aParameter first = #min: ifTrue: [ self min: aParameter second ].
	aParameter first = #quantum: ifTrue: [ self quantum: aParameter second ].
	aParameter first = #scaledValue: ifTrue: [ self scaledValue: aParameter second ].
	aParameter first = #value: ifTrue: [ self value: aParameter second ].! !

!PluggableSliderMorph methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 7/18/2012 16:32'!
drawOn: aCanvas

	super drawOn: aCanvas.
	aCanvas 
		drawString: self label
		in: self labelBounds
		font: self font
		color: self fontColor.
		
	
! !

!PluggableSliderMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/6/2015 18:08'!
drawOnAthensCanvas: aCanvas 

	super drawOnAthensCanvas: aCanvas.
	aCanvas 
		morphicDrawString: self label
		in: self labelBounds
		font: self font
		color: self fontColor.
		
	
! !

!PluggableSliderMorph methodsFor: 'protocol' stamp: 'gvc 8/3/2007 15:19'!
disable
	"Disable the receiver."
	
	self enabled: false! !

!PluggableSliderMorph methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/18/2012 16:14'!
updateEnabled
	"Update the enablement state."

	self model ifNotNil: [:m | 
		self getEnabledSelector ifNotNil: [:s |
			self enabled: (m perform: s)]]! !

!PluggableSliderMorph methodsFor: 'accessing' stamp: 'gvc 8/9/2007 11:21'!
min: anObject
	"Set the value of min"

	min := anObject.
	self setValue: self value! !

!PluggableSliderMorph methodsFor: 'accessing' stamp: 'gvc 8/9/2007 10:43'!
min
	"Answer the value of min"

	^ min! !

!PluggableSliderMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/13/2012 05:01'!
max: anObject
	"Set the value of max"

	max := anObject.
	self setValue: self value! !

!PluggableSliderMorph methodsFor: 'accessing' stamp: 'gvc 9/8/2009 13:03'!
getEnabledSelector
	"Answer the value of getEnabledSelector"

	^ getEnabledSelector! !

!PluggableSliderMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/18/2012 16:13'!
getLabelSelector: aSymbol

	getLabelSelector := aSymbol.
	self updateLabel! !

!PluggableSliderMorph methodsFor: 'instance creation' stamp: 'gvc 6/20/2007 14:29'!
on: anObject getValue: getSel setValue: setSel
	"Use the given selectors as the interface."

	self
		model: anObject;
		getValueSelector: getSel;
		setValueSelector: setSel;
		updateValue! !

!PluggableSliderMorph methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/18/2012 16:14'!
updateValue
	"Update the value."
	
	self model ifNotNil: [:m |
		self getValueSelector ifNotNil: [:s |
			self scaledValue: (m perform: s)]]! !

!PluggableSliderMorph methodsFor: 'accessing' stamp: 'GaryChambers 10/13/2011 17:46'!
scaledValue: newValue
	"Set the scaled value."

	|val|
	val := newValue.
	self quantum ifNotNil: [:q |
		val := val roundTo: q].
	self value: (self max <= self min
		ifTrue: [0]
		ifFalse: [val - self min / (self max - self min)])! !

!PluggableSliderMorph methodsFor: 'drawing' stamp: 'MarcusDenker 7/9/2014 21:36'!
labelBounds
	| deltaY deltaX labelWidth treshold bnd |
	bnd := self innerBounds.
	labelWidth := self font widthOfStringOrText: self label.
	deltaY := (self height - self font height) / 2.
	treshold := bnd left + self labelGap + labelWidth.
	deltaX := (slider left < treshold or: [ sliderShadow visible and: [ sliderShadow left < treshold ] ])
		ifTrue: [ bnd width - self labelGap - labelWidth ]
		ifFalse: [ self labelGap ].
	^ bnd translateBy: deltaX @ deltaY! !

!PluggableSliderMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/18/2012 16:07'!
label

	^ label! !

!PluggableSliderMorph methodsFor: 'accessing' stamp: 'MarcusDenker 12/11/2009 07:41'!
scaledValue
	"Answer the scaled value."

	|val|
	val := self value * (self max - self min) + self min.
	self quantum ifNotNil: [:q |
		val := val roundTo: q].
	^(val max: self min) min: self max! !

!PluggableSliderMorph methodsFor: 'accessing' stamp: 'gvc 8/3/2007 15:24'!
fillStyleToUse
	"Answer the fillStyle that should be used for the receiver."
	
	^self enabled
		ifTrue: [self theme sliderNormalFillStyleFor: self]
		ifFalse: [self theme sliderDisabledFillStyleFor: self]! !

!PluggableSliderMorph methodsFor: 'layout' stamp: 'gvc 8/8/2007 15:32'!
minHeight
	"Answer the receiver's minimum height.
	Give it a bit of a chance..."
	
	^8 max: super minHeight! !

!PluggableSliderMorph methodsFor: 'event handling' stamp: 'gvc 8/7/2007 10:35'!
mouseDown: anEvent
	"Set the value directly."
	
	self enabled ifTrue: [
		self
			scrollPoint: anEvent;
			computeSlider].
	super mouseDown: anEvent.
	self enabled ifFalse: [^self].
	anEvent hand newMouseFocus: slider event: anEvent.
	slider
		mouseEnter: anEvent copy;
		mouseDown: anEvent copy
! !

!PluggableSliderMorph methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 7/18/2012 16:18'!
font

	^ StandardFonts defaultFont! !

!PluggableSliderMorph methodsFor: 'initialization' stamp: 'gvc 6/20/2007 15:00'!
initializeSlider
	"Make the slider raised."
	
	super initializeSlider.
	slider borderStyle: (BorderStyle raised baseColor: slider color; width: 1)! !

!PluggableSliderMorph methodsFor: 'access' stamp: 'gvc 6/20/2007 14:57'!
sliderColor: newColor
	"Set the slider colour."
	
	super sliderColor: newColor.
	slider ifNotNil: [slider borderStyle baseColor: newColor]! !

!PluggableSliderMorph methodsFor: 'model access' stamp: 'BenjaminVanRyseghem 7/18/2012 15:21'!
setValue: newValue
	"Called internally for propagation to model."

	|scaled|
	value := newValue.
	self scaledValue: (scaled := self scaledValue).
	self model ifNotNil: [
		self setValueSelector ifNotNil: [:sel |
			self model perform: sel with: scaled]]! !

!PluggableSliderMorph methodsFor: 'accessing' stamp: 'gvc 9/10/2009 13:32'!
getEnabledSelector: aSymbol
	"Set the value of getEnabledSelector"

	getEnabledSelector := aSymbol.
	self updateEnabled! !

!PluggableSliderMorph class methodsFor: 'as yet unclassified' stamp: 'gvc 8/9/2007 11:28'!
on: anObject getValue: getSel setValue: setSel
	"Answer a new instance of the receiver with
	the given selectors as the interface."

	^self new
		on: anObject
		getValue: getSel
		setValue: setSel! !

!PluggableSliderMorph class methodsFor: 'as yet unclassified' stamp: 'gvc 8/9/2007 11:27'!
on: anObject getValue: getSel setValue: setSel min: min max: max quantum: quantum
	"Answer a new instance of the receiver with
	the given selectors as the interface."

	^self new
		min: min;
		max: max;
		quantum: quantum;
		on: anObject
		getValue: getSel
		setValue: setSel! !

!PluggableTabBarMorph commentStamp: 'KLC 9/17/2004 11:26'!
This morph manages a set of PluggableTabButtonMorphs.  Each tab should be added in the left to right order that they should be displayed.  Each tab will be evenly sized to fit the available space.  This morph intercepts mouse clicks, figures out which tab was clicked, pops up the new tab as the active tab and triggers the registered event.  See PluggableTabButtonMorph for information on what a tab can consist of.

Example:

(PluggableTabBarMorph on: nil)
	addTab: (Text fromString: 'Test') withAction: [Transcript show: 'Test'; cr];
	addTab: (Text fromString: 'Another') withAction: [Transcript show: 'Another'; cr];
	width: 200;
	openInHand
!
!PluggableTabBarMorph methodsFor: 'private - access' stamp: 'KLC 2/2/2004 13:25'!
tabs
	tabs ifNil: [ tabs := OrderedCollection new ].
	^ tabs! !

!PluggableTabBarMorph methodsFor: 'access' stamp: 'KLC 2/2/2004 17:36'!
color: aFillStyle
	color := aFillStyle.
	self tabs do: [ :anAssociation |
		anAssociation key color: aFillStyle ]
! !

!PluggableTabBarMorph methodsFor: 'actions' stamp: 'tlk 7/17/2004 14:35'!
performActiveTabAction
	"Look up the Symbol or Block associated with the currently active tab, and perform it."
	
	| tabActionAssoc aSymbolOrBlock |
	
	tabActionAssoc := self tabs detect: [ :assoc | assoc key = self activeTab.] ifNone: [ Association new ].
	aSymbolOrBlock := tabActionAssoc value.
	aSymbolOrBlock ifNil: [ ^ false ].
	^ aSymbolOrBlock isSymbol
		ifTrue: [ self target perform: aSymbolOrBlock ]
		ifFalse: [ aSymbolOrBlock value ].
	! !

!PluggableTabBarMorph methodsFor: 'drawing' stamp: 'KLC 2/24/2004 15:10'!
drawOn: aCanvas
	self tabs size > 0 ifFalse: [^ self ].
	self tabs do: [ :anAssociation | | tab |
		tab := anAssociation key.
		tab drawOn: aCanvas]! !

!PluggableTabBarMorph methodsFor: 'private - access' stamp: 'KLC 2/2/2004 14:17'!
activeTab
	activeTab ifNil: [
		self tabs size > 0 ifTrue: [
			activeTab := self tabs first key.
			activeTab active: true]].
	^ activeTab ! !

!PluggableTabBarMorph methodsFor: 'actions' stamp: 'KLC 2/2/2004 17:49'!
layoutChanged
	"Fix up our tabs bounds"
	| tabsCount |
	super layoutChanged.
	tabsCount := self tabs size.
	tabsCount isZero ifFalse: [ | tabInnerExtent count |
		tabInnerExtent := ((self width -
				((self tabs first key outerGap + self tabs last key outerGap) // 2)
					- tabsCount)
			 		// tabsCount)
			@ (self height).
		count := 1.
		self tabs do: [ :anAssociation | | tab |
			tab := anAssociation key.
			tab innerExtent: tabInnerExtent.
			count = 1
				ifTrue: [tab position: self position]
				ifFalse: [
					tab position:
						(self position translateBy:
							((tabInnerExtent x + 1) * (count - 1))@0)].
			count := count + 1  ]	].
	self changed.! !

!PluggableTabBarMorph methodsFor: 'actions' stamp: 'KLC 2/24/2004 15:14'!
mouseDown: anEvent
	| xPosition newTab |
	xPosition := anEvent cursorPoint x.
	newTab :=
		((self tabs detect: [ :anAssociation | | tabBounds |
				tabBounds := anAssociation key bounds.
				(tabBounds left <= xPosition) and: [ tabBounds right >= xPosition]]
			ifNone: [nil])
		key).
	newTab ifNil: [^ self].
	newTab = activeTab ifFalse: [ self activeTab: newTab ]
! !

!PluggableTabBarMorph methodsFor: 'access' stamp: 'KLC 2/24/2004 15:26'!
addTab: aStringOrTextOrMorph withAction: aSymbolOrBlock
	"Add a new tab.  The tab will be added onto the end of the list and displayed on the far right of previously added tabs.  The first argument can be a simple String, a Text, or any Morph.  The second argument is the action to be performed when the tab is selected. It can either be a symbol for a unary method on the target object or a block.  Each tab is stored as an Association with the created tab as the key and the selector as the value."
	| tabMorph |
	tabMorph := PluggableTabButtonMorph on: nil label: [ aStringOrTextOrMorph].
	tabMorph color: self color.
	self addMorphBack: tabMorph.
	self tabs ifEmpty: [ self activeTab: tabMorph ].
	self tabs add: (Association key: tabMorph value: aSymbolOrBlock).
	self layoutChanged.
	self changed.! !

!PluggableTabBarMorph methodsFor: 'private - access' stamp: 'BenjaminVanRyseghem 1/9/2012 18:26'!
activeTab: aTabMorph

	self activeTab ifNotNil: [self activeTab toggle].
	activeTab := aTabMorph.
	self activeTab toggle.
	aTabMorph delete.
	self addMorphFront: aTabMorph.
	aTabMorph takeKeyboardFocus.
	self performActiveTabAction.
	self changed.
! !

!PluggableTabBarMorph methodsFor: 'private - access' stamp: 'KLC 2/2/2004 10:37'!
target
	^ target! !

!PluggableTabBarMorph methodsFor: 'actions' stamp: 'KLC 2/2/2004 16:22'!
handlesMouseDown: anEvent
	^ true! !

!PluggableTabBarMorph methodsFor: 'access' stamp: 'KLC 2/2/2004 10:37'!
target: anObject
	target := anObject! !

!PluggableTabBarMorph class methodsFor: 'instance creation' stamp: 'MarcusDenker 7/7/2014 12:13'!
on: anObject
	^ self new target: anObject! !

!PluggableTabButtonMorph commentStamp: 'KLC 9/17/2004 11:27'!
This is a specialized pluggable button morph that is meant to represent a tab in a set of tabs arranged horizontally.  Each tab will overlap slightly when drawn.  All but one tab will be drawn in left to right order in the specified color, but lighter.  The active tab will be drawn last in the full color and slightly taller to indicate that it is selected.  Clicking the active tab has no effect but clicking any other tab will change the active tab to the clicked tab.

This morph does not itself accept any events.  The parent tab set will grab the mouse clicks and handle notifying the appropriate tabs that they have been activated or deactivated.

There is a single selector which provides the text for the button label and affects the width of the tab.  When the width changes the tab will inform its parent that it has changed and that the layout needs to be updated.  The model for the text selector of course should be the client for the tab set.

The button label can be a String, Text, or Morph.  Texts work better than plain Strings.!
!PluggableTabButtonMorph methodsFor: 'private - access' stamp: 'KLC 1/23/2004 14:36'!
arcLengths
	arcLengths ifNil: [ self calculateArcLengths ].
	^ arcLengths! !

!PluggableTabButtonMorph methodsFor: 'event' stamp: 'BenjaminVanRyseghem 1/9/2012 18:25'!
keyStroke: event

	(self navigationKey: event) ifTrue: [^self].
	super keyStroke: event! !

!PluggableTabButtonMorph methodsFor: 'access' stamp: 'KLC 1/22/2004 14:39'!
textSelector: aSymbol
	textSelector := aSymbol! !

!PluggableTabButtonMorph methodsFor: 'stepping' stamp: 'KLC 1/23/2004 17:31'!
stepTime
	^ self subMorph stepTime
! !

!PluggableTabButtonMorph methodsFor: 'access' stamp: 'KLC 1/22/2004 14:39'!
textSelector
	^ textSelector
! !

!PluggableTabButtonMorph methodsFor: 'drawing' stamp: 'KLC 9/17/2004 11:24'!
drawSubMorphOn: aCanvas
	| morphBounds |
	morphBounds := self bounds insetBy: (self cornerRadius + 3) @ (self topInactiveGap // 2 + 2).
	morphBounds := morphBounds translateBy: 0@(self topInactiveGap // 2 + 1).
	self active ifTrue: [
		morphBounds := morphBounds translateBy: 0@((self topInactiveGap // 2 + 1) negated)].
	self subMorph bounds height < (morphBounds height)
		ifTrue: [
			morphBounds := morphBounds
				insetBy: 0@((morphBounds height - self subMorph bounds height) // 2)].
	self subMorph bounds width < (morphBounds width)
		ifTrue: [
			morphBounds := morphBounds
				insetBy: ((morphBounds width - self subMorph bounds width) // 2)@0].

	self subMorph bounds: morphBounds.			
	aCanvas drawMorph: self subMorph! !

!PluggableTabButtonMorph methodsFor: 'event' stamp: 'BenjaminVanRyseghem 1/9/2012 18:23'!
handlesKeyboard: evt
	"Yes, we do it here."
	
	^true! !

!PluggableTabButtonMorph methodsFor: 'updating' stamp: 'MarcusDenker 7/26/2014 09:25'!
update: aSelector
	self textSelector
		ifNotNil: [ 
			aSelector = self textSelector
				ifTrue: [ 
					| morph |
					morph := (aSelector isSymbol and: [ model notNil ])
						ifTrue: [ (self model perform: aSelector) asMorph ]
						ifFalse: [ aSelector value asMorph ].
					self subMorph: morph ] ].
	self changed! !

!PluggableTabButtonMorph methodsFor: 'drawing' stamp: 'KLC 1/23/2004 15:49'!
drawOn: aCanvas
	self drawTabOn: aCanvas.
	self drawSubMorphOn: aCanvas! !

!PluggableTabButtonMorph methodsFor: '*Keymapping-Core' stamp: 'StephaneDucasse 6/22/2014 20:02'!
initializeShortcuts: aKMDispatcher

	super initializeShortcuts: aKMDispatcher.
	aKMDispatcher attachCategory: #MorphFocusNavigation! !

!PluggableTabButtonMorph methodsFor: 'private - access' stamp: 'KLC 1/23/2004 16:40'!
subMorph: aMorph
	subMorph := aMorph
! !

!PluggableTabButtonMorph methodsFor: 'event' stamp: 'BenjaminVanRyseghem 1/9/2012 18:04'!
takesKeyboardFocus
	"Answer whether the receiver can normally take keyboard focus."

	^true! !

!PluggableTabButtonMorph methodsFor: 'access' stamp: 'KLC 1/22/2004 14:25'!
active
	active ifNil: [ active := false ].
	^ active! !

!PluggableTabButtonMorph methodsFor: 'access' stamp: 'KLC 1/22/2004 14:26'!
active: aBoolean
	active := aBoolean.
	self changed.! !

!PluggableTabButtonMorph methodsFor: 'precalculations' stamp: 'KLC 1/23/2004 14:46'!
calculateArcLengths
	| array radius |
	radius := self cornerRadius.
	array := Array new: radius.
	
	1 to: radius do: [ :i | | x |
		x := i - 0.5.
		array at: i
		 	put: (radius - ((2 * x * radius) - (x * x)) sqrt) asInteger].
		
	self arcLengths: array! !

!PluggableTabButtonMorph methodsFor: 'access' stamp: 'KLC 2/2/2004 14:07'!
outerGap
	"The horizontal distance of the outer left and right edges of the tab excluding the inner visible part"
	^ self cornerRadius * 2! !

!PluggableTabButtonMorph methodsFor: 'stepping' stamp: 'KLC 2/2/2004 10:15'!
step
	self subMorph step.
	self changed.
! !

!PluggableTabButtonMorph methodsFor: 'private - access' stamp: 'KLC 1/23/2004 16:40'!
subMorph
	subMorph ifNil: [ self update: self textSelector ].
	^ subMorph! !

!PluggableTabButtonMorph methodsFor: 'private - access' stamp: 'KLC 1/23/2004 11:30'!
topInactiveGap
	^ 5! !

!PluggableTabButtonMorph methodsFor: 'drawing' stamp: 'KLC 2/2/2004 15:07'!
drawTabOn: aCanvas
	| top myColor cornerRadius myArcLengths myBounds |
	cornerRadius := self cornerRadius.
	myBounds := self bounds.
	self active
		ifTrue: [ top := myBounds top.
			myColor := self color ]
		ifFalse: [ top := myBounds top + self topInactiveGap.
			myColor := self color whiter whiter ].
	aCanvas fillRectangle:
		((myBounds left + cornerRadius)
				@ (top + cornerRadius)
			corner: (myBounds right - cornerRadius)
						@ self bottom)
		color: myColor.
	aCanvas fillRectangle:
		((myBounds left + (cornerRadius * 2)) @ top
			corner: (myBounds right - (cornerRadius * 2))
				@ (top + cornerRadius))
		color: myColor.
	aCanvas fillOval:
		((myBounds left + self cornerRadius) @ top
			corner: (myBounds left + (self cornerRadius * 3))
				@ (top + (self cornerRadius * 2)))
		color: myColor.
	aCanvas fillOval:
		((myBounds right - (self cornerRadius * 3)) @ top
			corner: (myBounds right - self cornerRadius)
				@ (top + (self cornerRadius * 2)))
		color: myColor.

	myArcLengths := self arcLengths.
	1 to: myArcLengths size do: [ :i | | length |
		length := myArcLengths at: i.
		aCanvas line: (myBounds left + cornerRadius - i) @ (myBounds bottom - 1 )
			to: (myBounds left + cornerRadius - i) @ (myBounds bottom - length - 1)
			color: myColor.
		aCanvas line: (myBounds right - cornerRadius + i - 1) @ (myBounds bottom - 1)
			to: (myBounds right - cornerRadius + i - 1) @ (myBounds bottom - length - 1)
			color: myColor]
	
! !

!PluggableTabButtonMorph methodsFor: 'stepping' stamp: 'KLC 1/23/2004 17:31'!
wantsSteps
	^ self subMorph wantsSteps! !

!PluggableTabButtonMorph methodsFor: 'access' stamp: 'KLC 1/22/2004 14:39'!
model
	^ model
! !

!PluggableTabButtonMorph methodsFor: 'private - access' stamp: 'KLC 1/23/2004 11:30'!
cornerRadius
	^ 5
! !

!PluggableTabButtonMorph methodsFor: 'actions' stamp: 'KLC 1/23/2004 15:38'!
toggle
	self active: self active not! !

!PluggableTabButtonMorph methodsFor: 'private - access' stamp: 'KLC 1/23/2004 14:37'!
arcLengths: anArrayOfIntegers
	arcLengths := anArrayOfIntegers
! !

!PluggableTabButtonMorph methodsFor: 'access' stamp: 'KLC 2/2/2004 14:05'!
innerExtent: aPoint
	"Set the extent based on the primary visible part of the tab.  In other words add twice the cornerRadius to this extent"
	self extent: (aPoint x + (self cornerRadius * 2)) @ (aPoint y)! !

!PluggableTabButtonMorph methodsFor: 'access' stamp: 'KLC 1/22/2004 14:39'!
model: anObject
	model := anObject! !

!PluggableTabButtonMorph class methodsFor: 'instance creation' stamp: 'TorstenBergmann 9/19/2014 16:45'!
on: anObject label: getTextSelector
	^self new
	      model: anObject;
		textSelector: getTextSelector;
		yourself.! !

!PluggableTextAttribute commentStamp: '<historical>'!
An attribute which evaluates an arbitrary block when it is selected.!
!PluggableTextAttribute methodsFor: 'accessing' stamp: 'ls 6/21/2001 18:06'!
evalBlock: aBlock
	evalBlock := aBlock! !

!PluggableTextAttribute methodsFor: 'evaluating' stamp: 'SeanDeNigris 11/5/2013 14:20'!
actOnClick: anEvent for: anObject in: paragraph editor: editor

	evalBlock ifNil: [ ^self ].
	evalBlock numArgs = 0 ifTrue: [ evalBlock value.  ^true ].
	evalBlock numArgs = 1 ifTrue: [ evalBlock value: anObject.  ^true ].
	self error: 'evalBlock should have 0 or 1 arguments'! !

!PluggableTextAttribute class methodsFor: 'instance creation' stamp: 'ls 6/21/2001 18:09'!
evalBlock: aBlock
	^super new evalBlock: aBlock! !

!PluggableTextEditorMorph commentStamp: 'GaryChambers 4/24/2012 13:52'!
Multi-line text editor with support for accepting on both each change and/or when keyboard focus changes. Also supports custom selection colour and clickable highlights.

Used for plain text, no styling, no code menu etc.

to see later 
uses: TEnableOnHaloMenu


!
!PluggableTextEditorMorph methodsFor: 'as yet unclassified' stamp: ''!
enabledString
	"Answer the string to be shown in a menu to represent the 'enabled' status"
	
	^ (self enabled) -> 'enabled' translated! !

!PluggableTextEditorMorph methodsFor: 'menu & halo' stamp: ''!
addToggleItemsToHaloMenu: aCustomMenu 
	"Add toggle-items to the halo menu"
	
	super addToggleItemsToHaloMenu: aCustomMenu.
	aCustomMenu
		addUpdating: #enabledString
		target: self
		selector: #toggleEnabled! !

!PluggableTextEditorMorph methodsFor: 'as yet unclassified' stamp: 'GaryChambers 12/21/2011 11:15'!
textMorphClass
	"Answer the class used to create the receiver's textMorph"
	
	^TextMorphForEditorView! !

!PluggableTextEditorMorph methodsFor: 'as yet unclassified' stamp: ''!
toggleEnabled
	"Toggle the enabled state."

	self enabled: self enabled not! !

!PluggableTextEditorMorph class methodsFor: 'as yet unclassified' stamp: 'GaryChambers 1/20/2012 14:37'!
stylingClass
	"No styling for plain text..."
	
	^nil! !

!PluggableTextFieldMorph commentStamp: 'gvc 5/18/2007 12:39'!
Single-line text field editor with DialogWindow key integration (return for default, escape for cancel) and keyboard focus navigation (tab/shift-tab). Additionally supports pluggable converters to translate between an object and its string form and vice-versa.!
!PluggableTextFieldMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/14/2009 11:29'!
ghostText: aText
	"Set the value of helpText"
	ghostText := aText ifNotNil: [aText asString]
! !

!PluggableTextFieldMorph methodsFor: 'styling' stamp: 'AlainPlantec 8/27/2011 16:03'!
okToStyle
	^ false! !

!PluggableTextFieldMorph methodsFor: 'encryption' stamp: 'BenjaminVanRyseghem 1/25/2013 15:24'!
beEncrypted

	self textMorph font: (StrikeFont passwordFontSize: self theme textFont pointSize).! !

!PluggableTextFieldMorph methodsFor: 'initialization' stamp: 'AlainPlantec 11/26/2010 18:09'!
outOfWorld: aWorld
	self closeChooser.
	super outOfWorld: aWorld! !

!PluggableTextFieldMorph methodsFor: 'accessing' stamp: 'gvc 9/18/2006 12:21'!
converter: anObject
	"Set the value of converter"

	converter := anObject! !

!PluggableTextFieldMorph methodsFor: 'accessing' stamp: 'gvc 9/18/2006 12:21'!
converter
	"Answer the value of converter"

	^ converter! !

!PluggableTextFieldMorph methodsFor: 'testing' stamp: 'GaryChambers 10/11/2011 13:58'!
hasValidText
	"Return true if the text is valid with respect to the converter."

	|string|
	self converter ifNil: [^super hasValidText].
	string := self text asString.
	^(string isEmpty and: [self default notNil]) or: [
		self converter isStringValid: string]! !

!PluggableTextFieldMorph methodsFor: 'model access' stamp: 'GaryChambers 3/8/2011 11:45'!
acceptTextInModel
	"Inform the model that the receiver's textMorph's
	text should be accepted.
	Answer true if the model accepted ok, false
	otherwise"
	| objectToAccept text |
	self hasValidText ifFalse: [^false].
	text := self text.
	objectToAccept := self converter
				ifNil: [text]
				ifNotNil: [self default
						ifNil: [self converter stringAsObject: text asString]
						ifNotNil: [text
								ifEmpty: [self default]
								ifNotEmpty: [self converter stringAsObject: text asString]]].
	^ setTextSelector isNil
		or: [setTextSelector numArgs = 2
				ifTrue: [model
						perform: setTextSelector
						with: objectToAccept
						with: self]
				ifFalse: [model perform: setTextSelector with: objectToAccept]]! !

!PluggableTextFieldMorph methodsFor: 'accessing' stamp: 'gvc 9/18/2006 15:00'!
maxLength
	"Answer the maximum number of characters that may be typed."

	^self textMorph maxLength! !

!PluggableTextFieldMorph methodsFor: 'encryption' stamp: 'BenjaminVanRyseghem 10/25/2012 14:23'!
encrypted: aBoolean

	aBoolean
		ifTrue: [ self beEncrypted ]
		ifFalse: [ self beDecrypted ]! !

!PluggableTextFieldMorph methodsFor: 'editor access' stamp: 'NicolaiHess 2/15/2014 01:01'!
scrollSelectionIntoView: event 
	"Scroll my text into view if necessary and return true, else return false.
	Redone here to deal with horizontal scrolling!!"
	
	| selRects delta selRect rectToTest transform cpHere |
	self selectionInterval: textMorph editor selectionInterval.
	selRects := textMorph paragraph selectionRects.
	selRects isEmpty ifTrue: [^ false].
	rectToTest := selRects first merge: selRects last.
	transform := scroller transformFrom: self.
	(event notNil and: [event anyButtonPressed]) ifTrue:  "Check for autoscroll"
		[cpHere := transform localPointToGlobal: event cursorPoint.
		cpHere x <= self left
			ifTrue: [rectToTest := selRects first topLeft extent: 2@2]
			ifFalse: [cpHere x >= self right
					ifTrue: [rectToTest := selRects last bottomRight extent: 2@2]
					ifFalse: [^ false]]].
	selRect := transform localBoundsToGlobal: rectToTest.
	selRect width > bounds width
		ifTrue: [^ false].  "Would not fit, even if we tried to scroll"
	(delta := selRect amountToTranslateWithin: self innerBounds) ~= (0@0) ifTrue:
		["Scroll end of selection into view if necessary"
		self scrollBy: delta truncated.
		^ true].
	^ false! !

!PluggableTextFieldMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 5/4/2012 17:07'!
textMorphClass
	"Answer the class used to create the receiver's textMorph"
	
	^ textMorphClass! !

!PluggableTextFieldMorph methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 11/26/2013 22:22'!
initialize

	textMorphClass := TextMorphForFieldView.
	super initialize.
	self beDecrypted! !

!PluggableTextFieldMorph methodsFor: 'geometry' stamp: 'AlainPlantec 11/27/2010 23:29'!
innerBounds
	| inb |
	inb := super innerBounds.
	endRow 
		ifNotNil: [inb := inb withRight: (inb right - endRow fullBounds width)].
	^ inb! !

!PluggableTextFieldMorph methodsFor: 'event handling' stamp: 'AlainPlantec 11/24/2010 20:46'!
mouseDownFromTextMorph: anEvent
	super mouseDownFromTextMorph: anEvent.
	entryCompletion ifNotNil: [entryCompletion mouseDownFromTextMorph: anEvent]! !

!PluggableTextFieldMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/28/2010 09:09'!
entryCompletion: anEntryCompletion
	entryCompletion := anEntryCompletion.
	entryCompletion 
		ifNotNil: [ entryCompletion chooseBlock isNil
			ifTrue: [entryCompletion chooseBlock: [:v | self setText: v. self acceptTextInModel ]]
			ifFalse: [ | blk | 
				blk := entryCompletion chooseBlock.
				entryCompletion chooseBlock: [:v | self setText: v. self acceptTextInModel. blk value: v]]].
! !

!PluggableTextFieldMorph methodsFor: 'initialization' stamp: 'AlainPlantec 11/27/2010 22:31'!
layoutChanged
	super layoutChanged.
	endRow 
		ifNotNil: [ | deltaY |
			deltaY := (self height - endRow fullBounds height) // 2.
			endRow position: self boundsInWorld topRight - (endRow fullBounds width @ deltaY negated)].
! !

!PluggableTextFieldMorph methodsFor: 'event handling' stamp: 'AlainPlantec 11/28/2010 10:07'!
keystrokeFromTextMorph: anEvent
	anEvent keyCharacter = Character cr
		ifTrue: [self closeChooser].
	^ (super keystrokeFromTextMorph: anEvent)
		or: [entryCompletion notNil and: [entryCompletion keystroke: anEvent from: self]]
			
	! !

!PluggableTextFieldMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/23/2010 22:18'!
closeChooser	
	entryCompletion
		ifNotNil: [entryCompletion closeChooser]! !

!PluggableTextFieldMorph methodsFor: 'initialization' stamp: 'MarcusDenker 9/29/2014 18:06'!
withDropListButton
	| downArrow downArrowBtn |
	endRow := AlignmentMorph newRow.
	downArrow := (self theme 
		basicCreateArrowOfDirection: #bottom 
		size: (textMorph textStyle defaultFont height)
		color: Color veryLightGray).
	downArrowBtn := IconicButton new labelGraphic: downArrow.
	downArrowBtn height: self innerBounds height.
	downArrowBtn borderWidth: 0.
	downArrowBtn color: Color transparent.
	downArrowBtn actionSelector:  #openChooserWithAllOrCloseFrom:.
	downArrowBtn target: entryCompletion.
	downArrowBtn arguments: (Array with: self).
	endRow height: downArrowBtn height.
	endRow width: downArrowBtn width.
	endRow color: Color transparent.
	endRow addMorph: downArrowBtn.
	self addMorph: endRow.! !

!PluggableTextFieldMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 9/7/2013 13:08'!
textMarginsWidth
	
	^ self textMorph margins asMargin left
	! !

!PluggableTextFieldMorph methodsFor: 'updating' stamp: 'gvc 6/21/2007 10:51'!
update: aSymbol
	"Update the receiver based on the given aspect.
	Override to not accept an #appendText for a text field
	since if broadcast by a model it will append to ALL
	text fields/editors."
	
	aSymbol == #appendEntry
		ifTrue: [^self].
	^super update: aSymbol! !

!PluggableTextFieldMorph methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 11/26/2013 23:07'!
drawOn: aCanvas 
	"Eventually draw the helpText"
	super drawOn: aCanvas.
	self ghostText
		ifNotEmpty: [
			self text isEmpty
				ifTrue: [| ghostBounds |
					ghostBounds := ((self scroller submorphBounds topLeft corner: self innerBounds bottomRight)
						translateBy: 0 @ (self scroller height - self theme textFont height / 2) rounded)
						insetBy: self textMarginsWidth @ 0.
					aCanvas 
						drawString: self ghostText
						in: ghostBounds
						font: self theme  textFont
						color: Color lightGray]].
	entryCompletion 
		ifNotNil: [entryCompletion closeIfNotNeeded: self].! !

!PluggableTextFieldMorph methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 9/8/2013 17:59'!
chooserHasFocus
	^ entryCompletion notNil and: [entryCompletion chooser notNil and: [entryCompletion chooser hasKeyboardFocus]]! !

!PluggableTextFieldMorph methodsFor: 'model access' stamp: 'GaryChambers 4/18/2012 17:56'!
getText
	"Retrieve the current model text. Set the converter to
	convert between the class of the returned object and string form."

	| newObj |
	getTextSelector isNil ifTrue: [^super getText].
	newObj := model perform: getTextSelector.
	(newObj isNil and: [self converter isNil]) ifTrue: [^Text new].
	self converter isNil
		ifTrue: [self convertTo: newObj class].
	^(self converter objectAsString: newObj)
		ifNil: ['']
		ifNotNil: [:s | s shallowCopy]! !

!PluggableTextFieldMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 2/26/2015 22:09'!
drawOnAthensCanvas: anAthensCanvas
	"Eventually draw the helpText"
	super drawOnAthensCanvas: anAthensCanvas.
	self ghostText
		ifNotEmpty: [
			self text isEmpty
				ifTrue: [| ghostBounds |
					ghostBounds := ((self scroller submorphBounds topLeft corner: self innerBounds bottomRight)
						translateBy: 0 @ (self scroller height - self theme textFont height / 2) rounded)
						insetBy: self textMarginsWidth @ 0.
					anAthensCanvas 
						morphicDrawString: self ghostText
						in: ghostBounds
						font: self theme textFont
						color: Color lightGray]].
	entryCompletion 
		ifNotNil: [entryCompletion closeIfNotNeeded: self].! !

!PluggableTextFieldMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/14/2009 11:29'!
default: anObject
	default := anObject! !

!PluggableTextFieldMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/14/2009 11:29'!
ghostText
	"Answer the value of helpText"

	^ ghostText ifNil: [ghostText := '']! !

!PluggableTextFieldMorph methodsFor: 'encryption' stamp: 'BenjaminVanRyseghem 1/25/2013 15:24'!
beDecrypted

	self textMorph font: TextStyle defaultFont.! !

!PluggableTextFieldMorph methodsFor: 'model access' stamp: 'gvc 9/18/2006 14:06'!
getSelection
	"Answer the model's selection interval.
	If not available keep the current selection."

	getSelectionSelector isNil ifFalse: [^super getSelection].
	^selectionInterval ifNil: [super getSelection]! !

!PluggableTextFieldMorph methodsFor: 'actions' stamp: 'BenjaminVanRyseghem 4/23/2013 00:34'!
accept

	self acceptBasic.
	acceptAction ifNotNil: [acceptAction value: textMorph contents asText].! !

!PluggableTextFieldMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/25/2010 19:01'!
openChooser	
	entryCompletion
		ifNotNil: [entryCompletion openChooserWith: textMorph text string from: self]! !

!PluggableTextFieldMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/14/2009 11:29'!
default
	^ default! !

!PluggableTextFieldMorph methodsFor: 'event handling' stamp: 'gvc 3/29/2008 16:59'!
handlesMouseWheel: evt
	"Do I want to receive mouseWheel events?." 

	^false! !

!PluggableTextFieldMorph methodsFor: 'focus' stamp: 'MarcusDenker 7/9/2014 21:39'!
focusChanged
	(self hasFocus or: [self chooserHasFocus])
		ifFalse: [self closeChooser].
	super focusChanged
! !

!PluggableTextFieldMorph methodsFor: 'accessing' stamp: 'gvc 9/18/2006 14:59'!
maxLength: anInteger
	"Set the maximum number of characters that may be typed."

	self textMorph maxLength: anInteger! !

!PluggableTextFieldMorph methodsFor: 'event handling' stamp: 'AlainPlantec 11/25/2010 18:34'!
textChanged
	super textChanged.
	self openChooser! !

!PluggableTextFieldMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 7/10/2014 16:19'!
textFont
	"We should clean"
	
	^ textFont ifNil: [ StandardFonts defaultFont  ]! !

!PluggableTextFieldMorph methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/15/2014 17:35'!
fillStyleToUse
	"Answer the fillStyle that should be used for the receiver."
	self color ifNotNil: [ ^ self color ].
	^self enabled
		ifTrue: [self theme textFieldNormalFillStyleFor: self]
		ifFalse: [self theme textFieldDisabledFillStyleFor: self]! !

!PluggableTextFieldMorph methodsFor: 'model access' stamp: 'gvc 9/18/2006 12:22'!
convertTo: aClass
	"Set the converter object class."

	self converter isNil
		ifTrue: [self converter: (ObjectStringConverter forClass: aClass)]
		ifFalse: [self converter objectClass: aClass]! !

!PluggableTextFieldMorph methodsFor: 'focus' stamp: 'GuillermoPolito 5/23/2012 11:40'!
keyboardFocusChange: aBoolean
	self closeChooser.
	super keyboardFocusChange: aBoolean.
! !

!PluggableTextFieldMorph methodsFor: 'event handling' stamp: 'gvc 1/4/2007 15:36'!
scrollByKeyboard: event 
	"If event is ctrl+up/down then scroll and answer true.
	Just don't, really!!"
	
	^false! !

!PluggableTextFieldMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/23/2013 00:43'!
hasUnacceptedEdits: aBoolean
	"Set the hasUnacceptedEdits flag to the given value. "
	
	aBoolean == hasUnacceptedEdits 
		ifFalse: [hasUnacceptedEdits := aBoolean. 
			self changed].
	aBoolean 
		ifFalse: [hasEditingConflicts := false].
	self okToStyle 
		ifTrue: [ self styler styleInBackgroundProcess: textMorph contents]! !

!PluggableTextFieldMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 7/10/2014 16:19'!
textFont: aFont
	"We should clean"
	
	textFont := aFont! !

!PluggableTextFieldMorph methodsFor: 'accessing' stamp: 'gvc 5/23/2007 13:08'!
borderStyleToUse
	"Answer the borderStyle that should be used for the receiver."
	
	^self enabled
		ifTrue: [self theme textFieldNormalBorderStyleFor: self]
		ifFalse: [self theme textFieldDisabledBorderStyleFor: self]! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'AlainPlantec 11/8/2010 22:10'!
methodNamesContainingIt
	self handleEdit: [textMorph editor methodNamesContainingIt]! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'EstebanLorenzano 3/20/2015 16:41'!
basicInspectIt
	self handleEdit:
		[textMorph editor evaluateSelectionAndDo: [:result | result basicInspect]].! !

!PluggableTextMorph methodsFor: '*NodeNavigation' stamp: 'GiselaDecuzzi 5/14/2013 15:38'!
standOutPreviousSelection
	self handleEdit: [
		NNavNavigation new 
			navigate: textMorph editor 
			direction: NNavDirectionPreviousSelection  
	]! !

!PluggableTextMorph methodsFor: '*glamour-morphic-widgets' stamp: 'cyrilledelaunay 6/6/2011 15:57'!
setOptimalResizing
	self hResizing: #rigid.
	self vResizing: #rigid! !

!PluggableTextMorph methodsFor: 'event handling' stamp: 'SeanDeNigris 2/2/2013 09:45'!
cursorEnd: aKeyboardEvent 

	^ textMorph editor cursorEnd: aKeyboardEvent.! !

!PluggableTextMorph methodsFor: 'settings' stamp: 'AlainPlantec 11/8/2010 22:10'!
replaceSelectionWith: aText
	^ textMorph editor replaceSelectionWith: aText! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'AlainPlantec 11/8/2010 22:10'!
tallyIt
	self handleEdit: [textMorph editor tallyIt]! !

!PluggableTextMorph methodsFor: 'scrolling' stamp: 'AlainPlantec 8/26/2011 13:05'!
classOrMetaClass: aBehavior
	"set the classOrMetaClass in the receiver's styler to aBehavior"
		
	self styler classOrMetaClass: aBehavior! !

!PluggableTextMorph methodsFor: 'private' stamp: 'AlainPlantec 11/8/2010 22:10'!
hUnadjustedScrollRange
"Return the width of the widest item in the list"

	textMorph ifNil: [ ^0 ].
	textMorph isWrapped ifTrue:[ ^0 ].

	^super hUnadjustedScrollRange
! !

!PluggableTextMorph methodsFor: 'initialization' stamp: 'AlainPlantec 8/26/2011 13:05'!
font: aFont
	textMorph beAllFont: aFont.
	self styler font: aFont! !

!PluggableTextMorph methodsFor: 'initialization' stamp: 'AlainPlantec 8/27/2011 14:32'!
initialize
	"initialize the state of the receiver"
	super initialize.
	
	hasUnacceptedEdits := false.
	hasEditingConflicts := false.
	askBeforeDiscardingEdits := true.
	enabled := true.
	highlights := OrderedCollection new! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'AlainPlantec 11/8/2010 22:10'!
browseIt
	self handleEdit: [textMorph editor browseIt]! !

!PluggableTextMorph methodsFor: '*Spec-MorphicAdapters' stamp: 'BernardoContreras 9/27/2014 10:36'!
registerScrollChanges: aSelector

	self announcer weak
		when: PaneScrolling 
		send: aSelector
		to: self model! !

!PluggableTextMorph methodsFor: 'event handling' stamp: 'CamilloBruni 9/2/2011 13:12'!
keystrokeFromTextMorph: anEvent
	self eventHandler ifNotNil:
		[^ self eventHandler keyStroke: anEvent fromMorph: self].
	^ false! !

!PluggableTextMorph methodsFor: 'settings' stamp: 'AlainPlantec 11/8/2010 22:10'!
bsText
	self changeText: (self text copyFrom: 1 to: (self text size - 1 max: 0))! !

!PluggableTextMorph methodsFor: 'styling' stamp: 'PavelKrivanek 7/13/2014 13:43'!
basicHasUnacceptedEdits: aBoolean
	"Set the hasUnacceptedEdits flag to the given value. "
	
	UserManager default canEditCode 
		ifFalse: [ aBoolean ifTrue: [ ^ self ]].
	aBoolean == hasUnacceptedEdits 
		ifFalse: [hasUnacceptedEdits := aBoolean. 
			self changed].
	aBoolean 
		ifFalse: [hasEditingConflicts := false].
	self okToStyle 
		ifTrue: [ self styler styleInBackgroundProcess: textMorph contents]! !

!PluggableTextMorph methodsFor: 'model access' stamp: 'johanfabry 3/21/2015 16:13'!
setTextBasic: aText

	((self textMorph contents size = 0) and: [self wrapFlag])
		ifTrue: [ 
			self textMorph
				contents: aText 
				wrappedTo: self innerExtent x ]
		ifFalse: [
			self textMorph newContents: aText].
	
	self hasUnacceptedEdits: false.
	self setScrollDeltas.! !

!PluggableTextMorph methodsFor: 'interactive error protocol' stamp: 'AlainPlantec 1/2/2011 10:33'!
nextTokenFrom: start direction: dir
	^ textMorph nextTokenFrom: start direction: dir! !

!PluggableTextMorph methodsFor: 'actions' stamp: 'AlainPlantec 2/21/2011 18:48'!
textExtent
	"Answer the text morph extent."
	
	^(textMorph ifNil: [^0@0]) extent! !

!PluggableTextMorph methodsFor: 'initialization' stamp: 'EstebanLorenzano 5/15/2014 14:21'!
defaultBorderWidth
	^ 1! !

!PluggableTextMorph methodsFor: 'interactive error protocol' stamp: 'AlainPlantec 11/8/2010 22:10'!
notify: aString at: anInteger in: aStream
	^ textMorph editor notify: aString at: anInteger in: aStream! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'SeanDeNigris 2/5/2013 14:55'!
cut
	self handleEdit: [textMorph editor cut].
	self autoAccept ifTrue: [ self accept ].! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'CamilloBruni 2/4/2012 14:48'!
yellowButtonActivity
	"Called when the shifted-menu's 'more' item is chosen"
	^ self yellowButtonActivity: false! !

!PluggableTextMorph methodsFor: 'drawing' stamp: 'AlainPlantec 2/21/2011 18:52'!
drawOn: aCanvas
	"Indicate unaccepted edits, conflicts etc."

	super drawOn: aCanvas. 
	self wantsFrameAdornments ifTrue: [
		self theme drawTextAdornmentsFor: self on: aCanvas].
	self drawHighlightsOn: aCanvas! !

!PluggableTextMorph methodsFor: 'actions' stamp: 'md 8/8/2014 10:22'!
acceptBasic
	"should be refactored with accept that comes from PluugableTextMorphPlus "
	"Inform the model of text to be accepted, and return true if OK."

	| ok saveSelection saveScrollerOffset |
	saveSelection := self selectionInterval copy.
	saveScrollerOffset := scroller offset copy.

	(self canDiscardEdits and: [self alwaysAccept not])
		ifTrue: [^ self flash].
 
	self hasEditingConflicts ifTrue:
		[(self confirm: 
'Caution!! This method may have been
changed elsewhere since you started
editing it here.  Accept anyway?' translated) ifFalse: [^ self flash]].
	ok := self acceptTextInModel.
	ok==true 
		ifTrue: [self setText: self getText.
		self hasUnacceptedEdits: false].

	["During the step for the browser, updateCodePaneIfNeeded is called, and 
		invariably resets the contents of the codeholding PluggableTextMorph
		at that time, resetting the cursor position and scroller in the process.
		The following line forces that update without waiting for the step, then restores the cursor and scrollbar"

	ok==true  ifTrue: "(don't bother if there was an error during compile)"
		[(model respondsTo: #updateCodePaneIfNeeded) 
			ifTrue: [model updateCodePaneIfNeeded].
		scroller offset: saveScrollerOffset.
		self setScrollDeltas.
		self selectFrom: saveSelection first to: saveSelection last]]

			on: Error do: []
! !

!PluggableTextMorph methodsFor: '*Polymorph-Widgets' stamp: 'AlainPlantec 11/8/2010 22:10'!
focusBounds
	"Answer the bounds for drawing the focus indication
	(when externalFocusForPluggableText is enabled)."

	^self theme textFocusBoundsFor: self! !

!PluggableTextMorph methodsFor: 'actions' stamp: 'AlainPlantec 2/21/2011 18:23'!
disable
	"Disable the receiver."
	
	self enabled: false! !

!PluggableTextMorph methodsFor: '*Polymorph-Widgets' stamp: 'AlainPlantec 11/8/2010 22:10'!
takesKeyboardFocus
	"Answer whether the receiver can normally take keyboard focus."

	^true! !

!PluggableTextMorph methodsFor: 'initialization' stamp: 'NicolaiHess 2/15/2014 00:01'!
on: anObject text: getTextSel accept: setTextSel readSelection: getSelectionSel menu: getMenuSel setSelection: setSelectionSel

	self model: anObject.
	getTextSelector := getTextSel.
	setTextSelector := setTextSel.
	getSelectionSelector := getSelectionSel.
	setSelectionSelector := setSelectionSel.
	getMenuSelector := getMenuSel.
	self borderWidth: 1.
	self setText: self getText.
	self setSelection: self getSelection.! !

!PluggableTextMorph methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 5/16/2013 13:06'!
handlesDoubleClick
	
	^ doubleClickSelector notNil! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'MarcusDenker 4/14/2011 10:55'!
exploreIt
	self handleEdit:
		[textMorph editor evaluateSelectionAndDo: [:result | result explore]].! !

!PluggableTextMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/23/2015 13:34'!
drawOnAthensCanvas: anAthensCanvas
	"Indicate unaccepted edits, conflicts etc."

	super drawOnAthensCanvas: anAthensCanvas. 
	self wantsFrameAdornments ifTrue: [
		self theme drawTextAdornmentsFor: self on: anAthensCanvas asCanvasWrapper].
	self drawHighlightsOn: anAthensCanvas asCanvasWrapper! !

!PluggableTextMorph methodsFor: 'model access' stamp: 'AlainPlantec 2/21/2011 18:24'!
drawHighlightsOn: aCanvas
	"Draw the highlights."
	
	|b o|
	b := self innerBounds.
	o := self scroller offset.
	aCanvas clipBy: self clippingBounds during: [:c |
	self highlights do: [:h |
		h
			drawOn: c 
			in: b
			offset: o]]! !

!PluggableTextMorph methodsFor: 'editor access' stamp: 'AlainPlantec 11/8/2010 22:10'!
setTextMorphToSelectAllOnMouseEnter
	"Tell my textMorph's editor to select all when the mouse enters"

	textMorph on: #mouseEnter send: #selectAll to: textMorph! !

!PluggableTextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 11/8/2010 22:10'!
mouseEnter: event
	"Changed to take keyboardFocusOnMouseDown into account."
	
	super mouseEnter: event.
	self textMorph ifNil: [^self].
	selectionInterval ifNotNil:
		[self textMorph editor selectInterval: selectionInterval; setEmphasisHere].
	self textMorph selectionChanged.
	self wantsKeyboardFocus ifFalse: [^self].
	self keyboardFocusOnMouseDown
		ifFalse: [self textMorph takeKeyboardFocus]! !

!PluggableTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/8/2010 22:10'!
getColorSelector: aSymbol
	getColorSelector := aSymbol.
	self update: getColorSelector.! !

!PluggableTextMorph methodsFor: '*Polymorph-Widgets' stamp: 'BenjaminVanRyseghem 9/26/2011 03:42'!
navigationKey: event
	"Check for tab key activity and change focus as appropriate.
	Must override here rather than in #tabKey: otherwise
	the tab will get passed to the window and change the focus."

	(event keyCharacter = Character tab and: [
		(event anyModifierKeyPressed or: [event shiftPressed]) not]) ifTrue: [^false].
	^super navigationKey: event! !

!PluggableTextMorph methodsFor: 'drawing' stamp: 'AlainPlantec 11/8/2010 22:10'!
wantsFrameAdornments: aBoolean 
	self setProperty: #wantsFrameAdornments toValue: aBoolean! !

!PluggableTextMorph methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/15/2014 17:35'!
fillStyleToUse
	"Answer the fillStyle that should be used for the receiver."
	self color ifNotNil: [ ^ self color ].
	^self enabled
		ifTrue: [self theme textEditorNormalFillStyleFor: self]
		ifFalse: [self theme textEditorDisabledFillStyleFor: self]! !

!PluggableTextMorph methodsFor: 'dependents access' stamp: 'ClementBera 9/30/2013 11:05'!
canDiscardEdits
	"Return true if this view either has no text changes or does not care."

	^ (hasUnacceptedEdits and: [askBeforeDiscardingEdits]) not
! !

!PluggableTextMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/18/2013 12:23'!
setSelectionSelector: aSelector

	setSelectionSelector := aSelector

	! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'AlainPlantec 11/8/2010 22:10'!
printerSetup
	self handleEdit: [textMorph editor printerSetup]! !

!PluggableTextMorph methodsFor: '*Polymorph-Widgets' stamp: 'GuillermoPolito 5/23/2012 11:40'!
keyboardFocusChange: aBoolean
	"Pass on to text morph."
	super keyboardFocusChange: aBoolean.
	aBoolean ifTrue: [self textMorph takeKeyboardFocus]! !

!PluggableTextMorph methodsFor: 'accessing' stamp: 'CamilloBruni 8/11/2011 04:28'!
changedAction: aBlock
	changedAction := aBlock! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'AlainPlantec 11/8/2010 22:10'!
chooseAlignment
	self handleEdit: [textMorph editor changeAlignment]! !

!PluggableTextMorph methodsFor: 'actions' stamp: 'AlainPlantec 2/21/2011 18:32'!
getEnabledSelector: anObject
	"Set the value of getEnabledSelector"

	getEnabledSelector := anObject.
	self updateEnabled! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'AlainPlantec 11/8/2010 22:10'!
implementorsOfIt
	self handleEdit: [textMorph editor implementorsOfIt]! !

!PluggableTextMorph methodsFor: 'scrolling' stamp: 'AlainPlantec 10/19/2011 13:29'!
styler: aStyler
	"Set the styler responsible for highlighting text in the receiver"
	styler := aStyler! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'AlainPlantec 11/8/2010 22:10'!
changeStyle
	self handleEdit: [textMorph editor changeStyle]! !

!PluggableTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/21/2011 18:16'!
acceptOnFocusChange
	"Answer whether the editor accepts its contents when it loses the keyboard focus."

	^acceptOnFocusChange ifNil: [false]! !

!PluggableTextMorph methodsFor: 'editor access' stamp: 'CamilloBruni 2/19/2014 18:20'!
handleEdit: editBlock
	| result |

	textMorph editor 
		selectFrom: selectionInterval first 
		to: selectionInterval last;
		model: model.  "For, eg, evaluateSelection"
	textMorph handleEdit: [result := editBlock value].   "Update selection after edit"
	self scrollSelectionIntoView.
	self textChanged.
	^ result! !

!PluggableTextMorph methodsFor: 'styling' stamp: 'BenjaminVanRyseghem 1/10/2014 12:19'!
hasUnacceptedEdits: aBoolean
	"Set the hasUnacceptedEdits flag to the given value. "
	
	(model respondsTo: #hasUnacceptedEdits:)
		ifTrue: [ model hasUnacceptedEdits: aBoolean ]
		ifFalse: [ self basicHasUnacceptedEdits: aBoolean ]! !

!PluggableTextMorph methodsFor: 'geometry' stamp: 'AlainPlantec 11/8/2010 22:10'!
extraScrollRange
	^ self height // 4! !

!PluggableTextMorph methodsFor: '*Shout' stamp: 'StephaneDucasse 6/22/2014 20:01'!
stylerStyled: styledCopyOfText 

	textMorph contents runs: styledCopyOfText runs.
	textMorph updateFromParagraph.
	selectionInterval
		ifNotNil: [textMorph editor selectInvisiblyFrom: selectionInterval first to: selectionInterval last;
				 storeSelectionInParagraph;
				 setEmphasisHere].
	textMorph editor blinkParen.
	self scrollSelectionIntoView! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'AlainPlantec 11/8/2010 22:10'!
copySelection
	self handleEdit: [textMorph editor copySelection]! !

!PluggableTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/28/2010 10:02'!
crAction: anAction
	self textMorph crAction: anAction! !

!PluggableTextMorph methodsFor: 'dropping/grabbing' stamp: 'AlainPlantec 11/8/2010 22:10'!
wantsDroppedMorph: aMorph event: anEvent 
	^ self model wantsDroppedMorph: aMorph event: anEvent inMorph: self! !

!PluggableTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/8/2010 22:10'!
acceptAction
	^acceptAction! !

!PluggableTextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 11/24/2010 21:03'!
mouseDownFromTextMorph: anEvent
	"Nothing to do here normally"! !

!PluggableTextMorph methodsFor: '*Polymorph-Widgets' stamp: 'AlainPlantec 11/8/2010 22:10'!
minWidth
	"Implemented here since extent: overriden."

	^super minWidth max: 36! !

!PluggableTextMorph methodsFor: 'layout' stamp: 'AlainPlantec 11/8/2010 22:10'!
acceptDroppingMorph: aMorph event: evt 
	"This message is sent when a morph is dropped onto a morph that has     
	agreed to accept the dropped morph by responding 'true' to the     
	wantsDroppedMorph:Event: message. The default implementation just     
	adds the given morph to the receiver."
	"Here we let the model do its work."

	self model
		acceptDroppingMorph: aMorph
		event: evt
		inMorph: self.

! !

!PluggableTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/8/2010 22:10'!
getTextSelector
	^getTextSelector! !

!PluggableTextMorph methodsFor: 'private' stamp: 'AlainPlantec 2/21/2011 18:50'!
vScrollBarValue: scrollValue
	super vScrollBarValue: scrollValue.
	textMorph ifNotNil: [textMorph selectionChanged].
	self triggerEvent: #vScroll with: scrollValue! !

!PluggableTextMorph methodsFor: 'drag and drop' stamp: 'BenjaminVanRyseghem 5/16/2013 14:06'!
startDrag: event
	| aTransferMorph itemMorph passenger |
	
	self dragEnabled ifFalse: [ ^ self ].

	itemMorph := self selectedContents asMorph.
	
	passenger := self model dragPassengerFor: itemMorph inMorph: self.
	passenger
		ifNotNil: [
			aTransferMorph := self model transferFor: passenger from: self.
				"Ask the draggedMorph otherwise the transferMorph has not yet its bounds"
			aTransferMorph align: aTransferMorph draggedMorph center with: event position.
			aTransferMorph
				dragTransferType: (self model dragTransferTypeForMorph: self).
			event hand grabMorph: aTransferMorph].
	event hand releaseMouseFocus: self! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'SeanDeNigris 2/5/2013 14:56'!
pasteRecent
	"Paste an item chosen from RecentClippings."

	| clipping |
	(clipping := Clipboard chooseRecentClipping) ifNil: [^ self].
	Clipboard clipboardText: clipping.
	self paste.! !

!PluggableTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/21/2011 18:12'!
autoAccept: aBoolean
	"Answer whether the editor accepts its contents on each change."

	autoAccept := aBoolean.
	self textMorph
		ifNotNil: [:t | t autoAccept: aBoolean]! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'AlainPlantec 11/8/2010 22:10'!
prettyPrint
	self handleEdit: [textMorph editor prettyPrint]! !

!PluggableTextMorph methodsFor: 'scrolling' stamp: 'AlainPlantec 8/27/2011 14:37'!
styler
	"The styler responsible for highlighting text in the receiver"
	^ styler ifNil: [styler := self defaultStyler]! !

!PluggableTextMorph methodsFor: 'scrolling' stamp: 'AlainPlantec 9/19/2011 19:34'!
styled: aBoolean

	self styler stylingEnabled: aBoolean
! !

!PluggableTextMorph methodsFor: 'event handling' stamp: 'SeanDeNigris 2/2/2013 09:45'!
cursorHome: aKeyboardEvent 

	^ textMorph editor cursorHome: aKeyboardEvent.! !

!PluggableTextMorph methodsFor: 'settings' stamp: 'AlainPlantec 11/8/2010 22:10'!
changeText: aText
	"The paragraph to be edited is changed to aText."
	self setText: aText! !

!PluggableTextMorph methodsFor: 'editor access' stamp: 'EstebanLorenzano 8/1/2012 11:20'!
textMorph: aTextMorph
	textMorph ifNotNil: [ 
		scrollBar removeMorph: textMorph ].
	textMorph := aTextMorph.
	self configureTextMorph: textMorph.! !

!PluggableTextMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 8/5/2012 21:09'!
scrollBy: delta
	"Move the contents in the direction delta."
	
	super scrollBy: delta.
	
	self triggerEvent: #hScroll with: self scrollValue x.
	self triggerEvent: #vScroll with: self scrollValue y
	! !

!PluggableTextMorph methodsFor: '*Polymorph-Widgets' stamp: 'BenjaminVanRyseghem 11/22/2012 17:54'!
addHighlightFrom: start to: end color:  col

	self highlights add: (
		(TextHighlight on: self)
			color: col;
			lineRange: (start to: end))! !

!PluggableTextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 11/8/2010 22:10'!
onKeyStrokeSend: sel to: recipient
	textMorph on: #keyStroke send: sel to: recipient.! !

!PluggableTextMorph methodsFor: 'scrolling' stamp: 'AlainPlantec 9/19/2011 19:39'!
defaultStyler
	^ self stylerClass new view: self! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'SeanDeNigris 2/5/2013 14:45'!
paste
	self handleEdit: [textMorph editor paste].
	self autoAccept ifTrue: [ self accept ].! !

!PluggableTextMorph methodsFor: 'actions' stamp: 'AlainPlantec 11/8/2010 22:10'!
wantsFrameAdornments
	"Answer whether the receiver wishes to have red borders, etc.,  
	used to show editing state"
	"A 'long-term temporary workaround': a nonmodular,  
	unsavory, but expedient way to get the desired effect, sorry.  
	Clean up someday."
	^ self
		valueOfProperty: #wantsFrameAdornments
		ifAbsent: [self showTextEditingState
					ifTrue: [(#(searchString infoViewContents ) includes: getTextSelector) not]
					ifFalse: [false]]! !

!PluggableTextMorph methodsFor: 'settings' stamp: 'AlainPlantec 11/8/2010 22:10'!
appendEntry
	"Append the text in the model's writeStream to the editable text. "
	textMorph asText size > model characterLimit ifTrue:
		["Knock off first half of text"
		self selectInvisiblyFrom: 1 to: textMorph asText size // 2.
		self replaceSelectionWith: Text new].
	self selectInvisiblyFrom: textMorph asText size + 1 to: textMorph asText size.
	self replaceSelectionWith: model contents asText.
	self selectInvisiblyFrom: textMorph asText size + 1 to: textMorph asText size! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'AlainPlantec 11/8/2010 22:10'!
offerFontMenu
	self handleEdit: [textMorph editor changeTextFont]! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'StephaneDucasse 2/11/2014 10:56'!
cancelWithoutConfirmation
	self setText: self getText.
	self setSelection: self getSelection.
! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'PavelKrivanek 7/13/2014 13:43'!
doIt

	UserManager default canEvaluateCode ifFalse: [ ^ false ].
	self handleEdit: [textMorph editor evaluateSelection]! !

!PluggableTextMorph methodsFor: 'styling' stamp: 'AlainPlantec 11/8/2010 22:10'!
hasEditingConflicts
	"Return true if a conflicting edit to the same code (typically) is known to have occurred after the current contents started getting edited"

	^ hasEditingConflicts == true! !

!PluggableTextMorph methodsFor: 'actions' stamp: 'AlainPlantec 2/21/2011 18:34'!
scrollToTop
	"Scroll to the top."
	
	self
		vScrollBarValue: 0;
		setScrollDeltas! !

!PluggableTextMorph methodsFor: 'interactive error protocol' stamp: 'AlainPlantec 11/8/2010 22:10'!
select
	^ textMorph editor select! !

!PluggableTextMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 8/5/2012 21:09'!
hScrollBarValue: scrollValue
	super hScrollBarValue: scrollValue.
	textMorph ifNotNil: [textMorph selectionChanged].
	
	self triggerEvent: #hScroll with: scrollValue! !

!PluggableTextMorph methodsFor: 'initialization' stamp: 'EstebanLorenzano 5/1/2014 15:34'!
defaultColor 
	^ self theme backgroundColor! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'AlainPlantec 11/8/2010 22:10'!
fileItIn
	self handleEdit: [textMorph editor fileItIn]! !

!PluggableTextMorph methodsFor: '*Polymorph-Widgets' stamp: 'AlainPlantec 11/8/2010 22:10'!
hasKeyboardFocus
	"Answer whether the receiver has keyboard focus."

	^super hasKeyboardFocus or: [(self textMorph ifNil: [^false]) hasKeyboardFocus]! !

!PluggableTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/21/2011 18:29'!
enabled
	"Answer whether the receiver is enabled."
	
	^enabled ifNil: [true]! !

!PluggableTextMorph methodsFor: 'editor access' stamp: 'AlainPlantec 11/11/2010 11:10'!
scrollSelectionIntoView
	"Scroll my text into view if necessary and return true, else return false"
	^ self scrollSelectionIntoView: nil! !

!PluggableTextMorph methodsFor: 'geometry' stamp: 'MarcusDenker 10/1/2013 21:25'!
resetExtent
	"Reset the extent while maintaining the current selection.  Needed when resizing while the editor is active (when inside the pane)."
	| tempSelection |
	textMorph notNil ifTrue:
		["the current selection gets munged by resetting the extent, so store it"
		tempSelection := self selectionInterval.
		super resetExtent. "adjust scroller"
		self extent: self extent.
		self setSelection: tempSelection]! !

!PluggableTextMorph methodsFor: 'accessing' stamp: 'CamilloBruni 8/11/2011 04:28'!
changedAction
	^ changedAction! !

!PluggableTextMorph methodsFor: '*NodeNavigation' stamp: 'GiselaDecuzzi 5/13/2013 17:56'!
standOutOverScope
	self handleEdit: [NNavNavigation new navigate: textMorph editor direction:  NNavDirectionParent] ! !

!PluggableTextMorph methodsFor: '*Polymorph-Widgets' stamp: 'GaryChambers 3/8/2011 12:00'!
hasValidText
	"Return true if the text is valid for acceptance."

	^true! !

!PluggableTextMorph methodsFor: 'model access' stamp: 'NicolaiHess 2/15/2014 01:01'!
setSelection: sel
	self selectionInterval: sel.
	textMorph editor selectFrom: sel first to: sel last.
	self scrollSelectionIntoView ifFalse: [scroller changed].! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'kilonalios 10/13/2013 13:58'!
cancel
	(self confirm:
'This action will cancel your changes.
Is it OK to cancel changes?' translated) ifTrue: [self setText: self getText.
	self setSelection: self getSelection.]! !

!PluggableTextMorph methodsFor: 'editor access' stamp: 'NicolaiHess 2/15/2014 00:59'!
scrollSelectionIntoView: event 
	"Scroll my text into view if necessary and return true, else return false"
	| selRects delta selRect rectToTest transform cpHere editor |
	editor := textMorph editor.
	self selectionInterval: editor selectionInterval.
	selRects := textMorph paragraph selectionRects.
	selRects isEmpty ifTrue: [^ false].
	rectToTest := selRects first merge: selRects last.
	transform := scroller transformFrom: self.
	(event notNil and: [event anyButtonPressed]) ifTrue:  "Check for autoscroll"
		[cpHere := transform localPointToGlobal: event cursorPoint.
		cpHere y <= self top
			ifTrue: [rectToTest := selRects first topLeft extent: 2@2]
			ifFalse: [cpHere y >= self bottom
					ifTrue: [rectToTest := selRects last bottomRight extent: 2@2]
					ifFalse: [^ false]]].
	selRect := transform localBoundsToGlobal: rectToTest.
	selRect height > bounds height
		ifTrue: [(editor pointIndex - editor markIndex) < 0
			ifTrue: [self scrollBy: 0@(self innerBounds top - selRect top)]
			ifFalse: [self scrollBy: 0@(self innerBounds bottom - selRect bottom)].
		^ true].
	(delta := selRect amountToTranslateWithin: self innerBounds) y ~= 0 ifTrue:
		["Scroll end of selection into view if necessary"
		self scrollBy: 0@delta y.
		^ true].
	^ false
! !

!PluggableTextMorph methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 9/13/2011 13:59'!
keyStroke: evt
	"A keystroke was hit while the receiver had keyboard focus.  Pass the keywtroke on to my textMorph, and and also, if I have an event handler, pass it on to that handler"

	self eventHandler ifNotNil:
		[self eventHandler keyStroke: evt fromMorph: self].
! !

!PluggableTextMorph methodsFor: 'editor access' stamp: 'LucFabresse 10/20/2013 00:52'!
toggleCommentOnSelectionOrLine
	"Tell my textMorph's editor to comment or uncomment current selection or line if no there is no selection"

	textMorph editor toggleCommentOnSelectionOrLine
	! !

!PluggableTextMorph methodsFor: 'styling' stamp: 'AlainPlantec 11/8/2010 22:10'!
askBeforeDiscardingEdits: aBoolean
	"Set the flag that determines whether the user should be asked before discarding unaccepted edits."

	askBeforeDiscardingEdits := aBoolean! !

!PluggableTextMorph methodsFor: '*NodeNavigation' stamp: 'GiselaDecuzzi 5/13/2013 18:03'!
standOutPreviousChild
	self handleEdit: [
		NNavNavigation new 
			navigate: textMorph editor 
			direction: NNavDirectionPreviousBrother 
	]! !

!PluggableTextMorph methodsFor: 'actions' stamp: 'AlainPlantec 2/21/2011 18:29'!
enable
	"Enable the receiver."
	
	self enabled: true! !

!PluggableTextMorph methodsFor: 'interactive error protocol' stamp: 'AlainPlantec 11/8/2010 22:10'!
selectInvisiblyFrom: start to: stop
	^ textMorph editor selectInvisiblyFrom: start to: stop! !

!PluggableTextMorph methodsFor: '*Polymorph-Widgets' stamp: 'BenjaminVanRyseghem 8/5/2012 22:40'!
layoutBounds: aRectangle
	"Set the bounds for laying out children of the receiver.
	Note: written so that #layoutBounds can be changed without touching this method"
	
	super layoutBounds: aRectangle.
	textMorph ifNotNil:
		[textMorph extent: (self innerExtent x)@self height].
	self setScrollDeltas
! !

!PluggableTextMorph methodsFor: 'actions' stamp: 'MarianoMartinezPeck 9/5/2012 14:08'!
wrapFlag
	"Answer the wrap flag on the text morph."
	
	^self textMorph wrapFlag! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'AlainPlantec 11/8/2010 22:10'!
findAgain
	self handleEdit: [textMorph editor findAgain]! !

!PluggableTextMorph methodsFor: 'styling' stamp: 'AlainPlantec 11/8/2010 22:10'!
promptForCancel
	"Ask for the appropriate action to take when unaccepted contents
	would be overwritten."

	| choice |
	choice := ( UIManager default
		confirm: 'Code has been modified.\What do you want to do?' translated withCRs
		trueChoice: 'Accept' translated
		falseChoice: 'Discard' translated
		cancelChoice: 'Cancel' translated
		default: nil ).
	choice ifNotNil: [
		choice
			ifTrue: [ self accept ]
			ifFalse: [ self model clearUserEditFlag ]]! !

!PluggableTextMorph methodsFor: 'initialization' stamp: 'NicolaiHess 2/15/2014 00:01'!
on: anObject text: getTextSel accept: setTextSel readSelection: getSelectionSel menu: getMenuSel

	self on: anObject text: getTextSel accept: setTextSel readSelection: getSelectionSel menu: getMenuSel setSelection: nil.
! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'AlainPlantec 11/8/2010 22:10'!
sendersOfIt
	self handleEdit: [textMorph editor sendersOfIt]! !

!PluggableTextMorph methodsFor: 'geometry' stamp: 'BenjaminVanRyseghem 8/5/2012 22:39'!
innerExtent
	^ self innerBounds extent - 6! !

!PluggableTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/21/2011 18:13'!
autoAccept
	"Answer whether the editor accepts its contents on each change."

	^autoAccept ifNil: [false]! !

!PluggableTextMorph methodsFor: 'updating' stamp: 'AlainPlantec 11/8/2010 22:10'!
scrollBarMenuButtonPressed: event
	"The menu button in the scrollbar was pressed; put up the menu"

	| menu |
	(menu := self getMenu: event shiftPressed) ifNotNil:
		["Set up to use perform:orSendTo: for model/view dispatch"
		menu setInvokingView: self.
		menu invokeModal]! !

!PluggableTextMorph methodsFor: '*Shout' stamp: ''!
stylerStyledInBackground: styledCopyOfText 
	textMorph contents string = styledCopyOfText string
		ifTrue: [self stylerStyled: styledCopyOfText]! !

!PluggableTextMorph methodsFor: 'interactive error protocol' stamp: 'AlainPlantec 11/8/2010 22:10'!
correctFrom: start to: stop with: aString
	unstyledAcceptText ifNotNil: [unstyledAcceptText replaceFrom: start to: stop with: aString ].
	^ self handleEdit: [textMorph editor correctFrom: start to: stop with: aString]! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'AlainPlantec 11/8/2010 22:10'!
acceptTextInModelBasic
	"Inform the model that the receiver's textMorph's text should be accepted.
	Answer true if the model accepted ok, false otherwise"
	
	| textToAccept |
	textToAccept := textMorph asText.
	^setTextSelector isNil or:
		[setTextSelector numArgs = 2
			ifTrue: [model perform: setTextSelector with: textToAccept with: self]
			ifFalse: [model perform: setTextSelector with: textToAccept]]
! !

!PluggableTextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 11/8/2010 22:10'!
handlesKeyboard: evt
	^true! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'AlainPlantec 11/8/2010 22:10'!
methodSourceContainingIt
	self handleEdit: [textMorph editor methodSourceContainingIt]! !

!PluggableTextMorph methodsFor: '*NodeNavigation' stamp: 'GiselaDecuzzi 5/13/2013 17:56'!
standOutIntoScope
	self handleEdit: [NNavNavigation new navigate: textMorph editor direction:  NNavDirectionChild]! !

!PluggableTextMorph methodsFor: 'actions' stamp: 'AlainPlantec 2/21/2011 18:34'!
updateEnabled
	"Update the enablement state."

	self model ifNotNil: [
		self getEnabledSelector ifNotNil: [
			self enabled: (self model perform: self getEnabledSelector)]]! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'MarcusDenker 12/2/2013 14:08'!
yellowButtonActivity: shiftKeyState 
	"Called when the shifted-menu's 'more' item is chosen"
	
	(self getMenu: shiftKeyState)
		ifNotNil: [ :menu|
			menu setInvokingView: self.
			menu invokeModal.
			^ true].
	^ false! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'AlainPlantec 11/8/2010 22:10'!
again
	self handleEdit: [textMorph editor again]! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'AlainPlantec 11/8/2010 22:10'!
setSearchString
	self handleEdit: [textMorph editor setSearchString]! !

!PluggableTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/21/2011 18:39'!
selectionColor: aColor
	"Set the colour to use for the text selection."

	selectionColor := aColor.
	self textMorph 
		ifNotNil: [:t | t selectionColor: aColor]! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'AlainPlantec 11/8/2010 22:10'!
methodStringsContainingit
	self handleEdit: [textMorph editor methodStringsContainingit]! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'nice 3/31/2011 22:43'!
inspectIt
	self handleEdit:
		[textMorph editor evaluateSelectionAndDo: [:result | result inspect]]! !

!PluggableTextMorph methodsFor: 'actions' stamp: 'AlainPlantec 2/21/2011 18:49'!
textExtent: newExtent
	"If autoFit is on then override to false for the duration of the extent call."
	
	textMorph ifNil: [^self].
	textMorph overrideExtent: newExtent! !

!PluggableTextMorph methodsFor: 'scrolling' stamp: 'FernandoOlivero 5/30/2011 09:26'!
scrollToBottom
	"Scroll to the bottom."
	
	self
		vScrollBarValue: self vTotalScrollRange;
		setScrollDeltas! !

!PluggableTextMorph methodsFor: '*Polymorph-Widgets' stamp: 'AlainPlantec 11/8/2010 22:10'!
wantsKeyboardFocus
	"Answer whether the receiver would like keyboard focus
	in the general case (mouse action normally). Even if disabled
	we allow for text morphs since can potentially copy text."

	^self takesKeyboardFocus and: [
		self visible and: [
			self enabled or: [self valueOfProperty: #wantsKeyboardFocusWhenDisabled ifAbsent: [true]]]]
! !

!PluggableTextMorph methodsFor: 'actions' stamp: 'PavelKrivanek 7/13/2014 13:43'!
accept
 
	UserManager default canEditCode 
		ifFalse: [ ^ self hasUnacceptedEdits: false ].
	self acceptBasic.
	acceptAction ifNotNil: [acceptAction value: textMorph contents asText].! !

!PluggableTextMorph methodsFor: 'scroll bar events' stamp: 'AlainPlantec 11/8/2010 22:10'!
showTextEditingState
	^ self class showTextEditingState! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'SeanDeNigris 2/5/2013 14:56'!
undo
	self handleEdit: [textMorph editor undo].
	self autoAccept ifTrue: [ self accept ].! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'AlainPlantec 11/8/2010 22:10'!
debugIt
	self handleEdit: [textMorph editor debugIt]! !

!PluggableTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/21/2011 18:15'!
acceptOnFocusChange: aBoolean
	"Set whether the editor accepts its contents when it loses the keyboard focus."

	acceptOnFocusChange := aBoolean.
	self textMorph ifNotNil: [:t | t acceptOnFocusChange: aBoolean]! !

!PluggableTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 9/19/2011 19:39'!
stylerClass
	^ self class stylingClass ifNil: [NullTextStyler]! !

!PluggableTextMorph methodsFor: 'interactive error protocol' stamp: 'FernandoOlivero 5/30/2011 09:47'!
selectedContents
	^ textMorph editor selection! !

!PluggableTextMorph methodsFor: '*Polymorph-Widgets' stamp: 'AlainPlantec 11/8/2010 22:10'!
appendText: aTextOrString
	"Append the given text to the receiver."

	self handleEdit: [
		self 
			selectInvisiblyFrom: textMorph asText size + 1 to: textMorph asText size;
			replaceSelectionWith: aTextOrString;
			selectFrom: textMorph asText size + 1 to: textMorph asText size;
			hasUnacceptedEdits: false;
			scrollSelectionIntoView;
			changed]! !

!PluggableTextMorph methodsFor: 'accessing' stamp: 'GaryChambers 4/24/2012 15:10'!
font
	"Answer the probable font"

	^self textMorph
		ifNil: [TextStyle defaultFont]
		ifNotNil: [:m | m font]! !

!PluggableTextMorph methodsFor: 'dependents access' stamp: 'AlainPlantec 11/8/2010 22:10'!
hasUnacceptedEdits
	"Return true if this view has unaccepted edits."

	^ hasUnacceptedEdits! !

!PluggableTextMorph methodsFor: 'actions' stamp: 'AlainPlantec 2/21/2011 18:33'!
highlights: aCollectionOfHighlight
	"Set the value of highlights"

	highlights := aCollectionOfHighlight! !

!PluggableTextMorph methodsFor: 'initialization' stamp: 'FernandoOlivero 5/10/2011 06:51'!
model: aModel
	"Update the enablement state too."
	super model: aModel.
	self updateEnabled! !

!PluggableTextMorph methodsFor: 'editor access' stamp: 'NicolaiHess 2/15/2014 00:59'!
selectAll
	"Tell my textMorph's editor to select all"

	self textMorph editor selectAll.
	self selectionInterval: self textMorph editor selectionInterval! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'SvenVanCaekenberghe 12/12/2012 09:49'!
printIt
	| oldEditor printString |
	textMorph editor
		selectFrom: selectionInterval first to: selectionInterval last;
		model: model.	"For, eg, evaluateSelection"
	textMorph
		handleEdit: [ 
			(oldEditor := textMorph editor)
				evaluateSelectionAndDo: [ :result | 
					printString := [ result printString ]
						on: Error
						do: [ '<error in printString: try ''Inspect it'' to debug>' ].
					selectionInterval := oldEditor selectionInterval.
					textMorph installEditorToReplace: oldEditor.
					textMorph handleEdit: [ oldEditor afterSelectionInsertAndSelect: printString ].
					selectionInterval := oldEditor selectionInterval.
					textMorph editor selectFrom: selectionInterval first to: selectionInterval last.
					self scrollSelectionIntoView ] ]! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'AlainPlantec 11/8/2010 22:10'!
referencesToIt
	self handleEdit: [textMorph editor referencesToIt]! !

!PluggableTextMorph methodsFor: 'geometry' stamp: 'AlainPlantec 11/8/2010 22:10'!
scrollDeltaHeight
	"Return the increment in pixels which this pane should be scrolled."
	^ scroller firstSubmorph defaultLineHeight
! !

!PluggableTextMorph methodsFor: 'formatting' stamp: 'GuillermoPolito 11/7/2013 13:22'!
formatSourceCode
	self
		handleEdit: [ 
			| source tree formatted |
			source := self textMorph text asString.
			tree := RBParser parseMethod: source onError: [ :msg :pos | ^ self ].
			formatted := tree formattedCode.
			formatted = source
				ifTrue: [ ^ self ].
			self
				editString: formatted;
				hasUnacceptedEdits: true ]! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'AlainPlantec 11/8/2010 22:10'!
classNamesContainingIt
	self handleEdit: [textMorph editor classNamesContainingIt]! !

!PluggableTextMorph methodsFor: '*NodeNavigation' stamp: 'GiselaDecuzzi 5/13/2013 18:04'!
standOutIntoFirstScope
	self handleEdit: [NNavNavigation new navigate: textMorph editor direction: NNavDirectionFirstChild ]! !

!PluggableTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/21/2011 18:57'!
alwaysAccept
	^ alwaysAccept ifNil: [false]! !

!PluggableTextMorph methodsFor: '*Polymorph-Widgets' stamp: 'AlainPlantec 2/21/2011 18:21'!
adoptPaneColor: paneColor
	"Pass on to the border too."
	
	super adoptPaneColor: paneColor.
	paneColor ifNil: [^self].
	self borderStyle baseColor: (self enabled ifTrue: [paneColor twiceDarker] ifFalse: [paneColor darker]).
	self fillStyle: self fillStyleToUse.
	self borderWidth > 0 
		ifTrue: [self borderStyle: self borderStyleToUse]! !

!PluggableTextMorph methodsFor: 'actions' stamp: 'AlainPlantec 2/22/2011 17:20'!
highlights
	"Answer the value of highlights"

	^ highlights ifNil: [#()]! !

!PluggableTextMorph methodsFor: 'model access' stamp: 'EstebanLorenzano 10/16/2013 00:05'!
textColor: aColor
	"Set the color of my text to the given color"

	self textMorph textColor: aColor! !

!PluggableTextMorph methodsFor: 'interactive error protocol' stamp: 'NicolaiHess 2/15/2014 01:01'!
selectFrom: start to: stop
	self textMorph editor selectFrom: start to: stop.
	self selectionInterval: self textMorph editor selectionInterval.
	^ self selectionInterval! !

!PluggableTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/8/2010 22:10'!
getColorSelector
	^getColorSelector! !

!PluggableTextMorph methodsFor: 'initialization' stamp: 'AlainPlantec 11/8/2010 22:10'!
editString: aString 
	"Jam some text in.  This is treated as clean text by default."

	self setText: aString asText! !

!PluggableTextMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/4/2012 14:14'!
alwaysAccept: aBoolean
	"Set the always accept flag."
	"This flag is used when there are unsaved changes in my text field and an exterior actor tries to modify me"
	"If the flag is true, I will accept to change even if I have pending modification instead of poping up the Accept/Discard/Cancel window"


	alwaysAccept := aBoolean
! !

!PluggableTextMorph methodsFor: 'unaccepted edits' stamp: 'AlainPlantec 11/8/2010 22:15'!
textMorphClass
	"Answer the class used to create the receiver's textMorph"
	
	^TextMorphForEditView ! !

!PluggableTextMorph methodsFor: 'styling' stamp: 'BenjaminVanRyseghem 6/19/2012 21:08'!
hasEditingConflicts: aBoolean

	hasEditingConflicts := aBoolean.
	self changed! !

!PluggableTextMorph methodsFor: 'actions' stamp: 'AlainPlantec 8/26/2011 10:49'!
acceptTextInModel 
	"#correctFrom:to:with: is sent when the method source is
	manipulated during compilation (removing unused temps,
	changing selectors etc). But 	#correctFrom:to:with: operates 
	on the textMorph's text, and we may be saving an unstyled 
	copy of the text. This means that these corrections will be lost
	unless we also apply the corrections to the unstyled copy that we are saving.
		So remember the unstyled copy in unstyledAcceptText, so
	that when #correctFrom:to:with: is received we can also apply
	the correction to it"
	| acceptedText |
	acceptedText := self styler unstyledTextFrom: textMorph asText.
	[^setTextSelector isNil or:
		[setTextSelector numArgs = 2
			ifTrue: [model perform: setTextSelector with: acceptedText with: self]
			ifFalse: [model perform: setTextSelector with: acceptedText]]
		] ensure: [unstyledAcceptText := nil]! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'BenjaminVanRyseghem 2/8/2013 23:52'!
redo
	self handleEdit: [ textMorph editor redo ].
	self autoAccept ifTrue: [ self accept ].! !

!PluggableTextMorph methodsFor: 'interactive error protocol' stamp: 'AlainPlantec 11/8/2010 22:10'!
correctSelectionWithString: aString
	| result newPosition |

	"I can't tell if this is a hack or if it's the right thing to do."
	self setSelection: selectionInterval. 

	result := self correctFrom: selectionInterval first to: selectionInterval last with: aString.
	newPosition := selectionInterval first + aString size.
	self setSelection: (newPosition to: newPosition - 1).
	^ result! !

!PluggableTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/21/2011 18:38'!
selectionColor
	"Answer the color to use for the text selection."

	^ selectionColor ! !

!PluggableTextMorph methodsFor: 'model access' stamp: 'AlainPlantec 11/8/2010 22:10'!
text
	^ textMorph contents! !

!PluggableTextMorph methodsFor: 'actions' stamp: 'AlainPlantec 2/21/2011 18:30'!
enabled: aBoolean
	"Set the value of enabled"

	enabled = aBoolean ifTrue: [^self].
	enabled := aBoolean.
	self changed: #enabled.
	self
		adoptPaneColor: self paneColor;
		changed! !

!PluggableTextMorph methodsFor: 'initialization' stamp: 'AlainPlantec 11/8/2010 22:10'!
acceptOnCR: trueOrFalse
	textMorph acceptOnCR: trueOrFalse! !

!PluggableTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/21/2011 18:51'!
wrapFlag: aBoolean
	self textMorph ifNil: [self setText: ''].
	textMorph wrapFlag: aBoolean! !

!PluggableTextMorph methodsFor: '*NodeNavigation' stamp: 'StephaneDucasse 6/22/2014 20:01'!
standOutHorizontalScope

	self handleEdit: [NNavNavigation new navigate: textMorph editor direction: NNavDirectionSibling ] ! !

!PluggableTextMorph methodsFor: 'geometry' stamp: 'BenjaminVanRyseghem 8/5/2012 22:39'!
extent: newExtent
	"The inner bounds may have changed due to scrollbar visibility."

	super extent: (newExtent max: 36 @ 16).
	textMorph
		ifNotNil: [ 
			self innerExtent = textMorph extent
				ifFalse: [ textMorph extent: self innerExtent ] ].
	self setScrollDeltas.
	(self fillStyle notNil and: [ self fillStyle isSolidFill not ])
		ifTrue: [ self fillStyle: self fillStyleToUse ]! !

!PluggableTextMorph methodsFor: 'transcript' stamp: 'MarcusDenker 7/26/2014 09:23'!
update: aSymbol 
	aSymbol ifNil: [^self].
	(aSymbol == getColorSelector)
		ifTrue: [^ self color: (model perform: getColorSelector)].
	aSymbol == #flash ifTrue: [^self flash].
	aSymbol == getTextSelector 
		ifTrue: 
			[self setText: self getText.
			^self setSelection: self getSelection].
	aSymbol == getSelectionSelector 
		ifTrue: [^self setSelection: self getSelection].
	aSymbol == #clearUserEdits ifTrue: [^self hasUnacceptedEdits: false].
	aSymbol == #wantToChange 
		ifTrue: 
			[self canDiscardEdits ifFalse: [^self promptForCancel].
			^self].
	aSymbol == #appendEntry 
		ifTrue: 
			[self handleEdit: [self appendEntry].
			^self ].
	aSymbol == #clearText 
		ifTrue: 
			[self handleEdit: [self changeText: Text new].
			^self ].
	aSymbol == #bs 
		ifTrue: 
			[self handleEdit: [self bsText].
			^self ].
	aSymbol == #codeChangedElsewhere 
		ifTrue: 
			[self hasEditingConflicts: true.
			^self].
	aSymbol == self getEnabledSelector 
		ifTrue: [self updateEnabled].
	^ self! !

!PluggableTextMorph methodsFor: 'scrolling' stamp: 'AlainPlantec 8/26/2011 17:18'!
shoutEnabled
	^ self class shoutEnabled! !

!PluggableTextMorph methodsFor: 'model access' stamp: 'BenjaminVanRyseghem 8/3/2012 17:52'!
getText
	"Retrieve the current model text"

	| newText |
	getTextSelector ifNil: [^Text new].
	newText := model perform: getTextSelector withEnoughArguments: {self}.
	newText ifNil: [^Text new].
	^newText shallowCopy! !

!PluggableTextMorph methodsFor: 'unaccepted edits' stamp: 'EstebanLorenzano 8/1/2012 11:17'!
configureTextMorph: aTextMorph
	"I prepare a text morph for use"
	aTextMorph setEditView: self.
	scroller addMorph: aTextMorph.
	aTextMorph 
		autoAccept: self autoAccept;
		selectionColor: self selectionColor.
	aTextMorph editor installKeymappingsOn: self.
! !

!PluggableTextMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/18/2013 12:23'!
setSelectionSelector

	^ setSelectionSelector! !

!PluggableTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/8/2010 22:10'!
acceptAction: anAction
	acceptAction := anAction! !

!PluggableTextMorph methodsFor: '*SmartSuggestions' stamp: 'StephaneDucasse 6/22/2014 20:01'!
smartSuggestions

	self handleEdit: [textMorph editor smartSuggestions]! !

!PluggableTextMorph methodsFor: 'actions' stamp: 'AlainPlantec 2/21/2011 18:32'!
getEnabledSelector
	"Answer the value of getEnabledSelector"

	^ getEnabledSelector! !

!PluggableTextMorph methodsFor: 'model access' stamp: 'AlainPlantec 8/26/2011 13:04'!
setText: aText
	self okToStyle
		ifFalse: [ self setTextBasic: aText ]
		ifTrue: [
			self setTextBasic: (self styler format: aText).
			aText size < 4096
				ifTrue: [ self styler style: textMorph contents ]
				ifFalse: [ self styler styleInBackgroundProcess: textMorph contents ] ]! !

!PluggableTextMorph methodsFor: 'interactive error protocol' stamp: 'AlainPlantec 11/8/2010 22:10'!
deselect
	^ textMorph editor deselect! !

!PluggableTextMorph methodsFor: 'model access' stamp: 'BenjaminVanRyseghem 8/4/2012 01:03'!
getSelection
	"Answer the model's selection interval."

	getSelectionSelector ifNil: [^1 to: 0].	"null selection"
	^model perform: getSelectionSelector withEnoughArguments: { self }! !

!PluggableTextMorph methodsFor: 'interactive error protocol' stamp: 'AlainPlantec 11/8/2010 22:10'!
selectionInterval
	^ textMorph editor selectionInterval! !

!PluggableTextMorph methodsFor: 'event handling' stamp: 'CamilloBruni 9/2/2011 13:01'!
textChanged
	"this is used in the case where we want to listen for live changes in a text morph. otherwise we're limited to the accept behavior"
	
	changedAction ifNotNil: [changedAction value: textMorph contents asText].! !

!PluggableTextMorph methodsFor: 'actions' stamp: 'BenjaminVanRyseghem 11/22/2012 18:08'!
setViewToFirstHighlight
	| min lines |
	
	min := (self highlights detectMin: [:e | e lineNumber ]) lineNumber.
	lines := self textMorph paragraph lines size.
	
	self vScrollValue: (min/lines)! !

!PluggableTextMorph methodsFor: '*Polymorph-Widgets' stamp: 'AlainPlantec 11/8/2010 22:10'!
minHeight
	"Implemented here since extent: overriden."

	^super minHeight max: 16! !

!PluggableTextMorph methodsFor: 'editor access' stamp: 'EstebanLorenzano 8/1/2012 11:19'!
textMorph
	^ textMorph ifNil: [ 
		self textMorph: self textMorphClass new.
		textMorph ]! !

!PluggableTextMorph methodsFor: 'model access' stamp: 'NicolaiHess 2/15/2014 00:02'!
selectionInterval: sel
	selectionInterval := sel.
	setSelectionSelector ifNotNil: [ model perform:setSelectionSelector with: sel ].! !

!PluggableTextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 11/8/2010 22:10'!
mouseLeave: event
	"The mouse has left the area of the receiver"

	textMorph ifNotNil: [selectionInterval := textMorph editor selectionInterval].
	super mouseLeave: event.
	self mouseOverForKeyboardFocus 
		ifTrue:	[event hand releaseKeyboardFocus: textMorph]! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'AlainPlantec 11/8/2010 22:10'!
classCommentsContainingIt
	self handleEdit: [textMorph editor classCommentsContainingIt]! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'AlainPlantec 11/8/2010 22:10'!
find
	self handleEdit: [textMorph editor find]! !

!PluggableTextMorph methodsFor: 'scrolling' stamp: 'StephaneDucasse 9/4/2011 22:23'!
okToStyle
	self shoutEnabled 
		ifFalse: [^ false].
	(model respondsTo: #shoutAboutToStyle:) 
		ifFalse: [^false].
	^model shoutAboutToStyle: self
! !

!PluggableTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/21/2011 18:23'!
borderStyleToUse
	"Answer the borderStyle that should be used for the receiver."
	
	^self enabled
		ifTrue: [self theme textEditorNormalBorderStyleFor: self]
		ifFalse: [self theme textEditorDisabledBorderStyleFor: self]! !

!PluggableTextMorph class methodsFor: 'accessing' stamp: 'AlainPlantec 8/26/2011 17:18'!
shoutEnabled
	^ (Smalltalk globals includesKey: #SHPreferences)
		and: [(Smalltalk globals at: #SHPreferences) enabled]! !

!PluggableTextMorph class methodsFor: 'accessing' stamp: 'AlainPlantec 8/27/2011 15:54'!
stylingClass

	^ StylingClass! !

!PluggableTextMorph class methodsFor: 'settings' stamp: 'AlainPlantec 11/8/2010 22:10'!
showTextEditingState: aBoolean
	ShowTextEditingState := aBoolean! !

!PluggableTextMorph class methodsFor: 'settings' stamp: 'AlainPlantec 11/8/2010 22:10'!
showTextEditingState
	^ ShowTextEditingState ifNil: [ShowTextEditingState := true]! !

!PluggableTextMorph class methodsFor: 'instance creation' stamp: 'AlainPlantec 11/8/2010 22:10'!
on: anObject text: getTextSel accept: setTextSel

	^ self on: anObject
		text: getTextSel
		accept: setTextSel
		readSelection: nil
		menu: nil! !

!PluggableTextMorph class methodsFor: 'instance creation' stamp: 'NicolaiHess 2/15/2014 00:01'!
on: anObject text: getTextSel accept: setTextSel readSelection: getSelectionSel menu: getMenuSel

	^ self new on: anObject
		text: getTextSel
		accept: setTextSel
		readSelection: getSelectionSel
		menu: getMenuSel
		setSelection: nil! !

!PluggableTextMorph class methodsFor: 'accessing' stamp: 'AlainPlantec 8/27/2011 15:54'!
stylingClass: aClass

	StylingClass := aClass! !

!PluggableTextMorph class methodsFor: 'instance creation' stamp: 'NicolaiHess 2/15/2014 00:00'!
on: anObject text: getTextSel accept: setTextSel readSelection: getSelectionSel menu: getMenuSel setSelection: setSelectionSel

	^ self new on: anObject
		text: getTextSel
		accept: setTextSel
		readSelection: getSelectionSel
		menu: getMenuSel
		setSelection: setSelectionSel! !

!PluggableTextMorphWithLimits commentStamp: '<historical>'!
I have a warningLimit ( 350 by default ) and an alertLimit ( 2* warningLimit by default ), and the number of characters of the text displayed is counted ( without space, tabs, cr etc).

If my text size is below the warning limit, the background is white ( or the default color ), if it is between warningLimit and alertLimit, the background turns more and more yellow, and if it's above the alertLimit, the background turns orange :)

Test it with: 

self example.

I am designed for editing method source code !!!
!PluggableTextMorphWithLimits methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 8/6/2012 01:26'!
alertLimit: anObject
	
	alertLimit := anObject! !

!PluggableTextMorphWithLimits methodsFor: 'icon' stamp: 'BenjaminVanRyseghem 8/6/2012 01:27'!
lockSelector

	^ lockSelector! !

!PluggableTextMorphWithLimits methodsFor: 'initialize' stamp: 'BenjaminVanRyseghem 8/27/2012 11:31'!
defaultOpenMorph

	^ (AlphaImageMorph new image: self defaultUnLockIcon)
			alpha: 0.6! !

!PluggableTextMorphWithLimits methodsFor: 'initialize' stamp: 'BenjaminVanRyseghem 8/27/2012 11:29'!
defaultLockIcon

	"^ UITheme current lockIcon"
	^(Form
	extent: 16@16
	depth: 32
	fromArray: #(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 536870912 1763976231 2152220746 2017213502 1090519040 0 0 0 0 0 0 0 0 16777217 0 1778384896 4202726023 4291019976 4291283147 4291217611 4289441201 3056480051 0 0 0 0 0 0 0 0 1107296256 4286678155 4291086543 3546177637 2671262270 2991016013 4288060064 4290823372 2887655202 0 0 0 0 0 0 0 3140168752 4290363850 3425776439 0 0 0 1828716544 4287928993 4135025795 570425344 0 0 0 0 0 0 3410315862 4287995304 1795820311 0 0 0 16777216 4284310124 4287797925 838860800 0 0 0 0 0 1510935808 4064757804 4287928968 3392352778 2519805440 2620666368 2587111936 2787714816 4284244555 4287731072 2819492352 33554432 0 0 0 0 4202126080 4294961683 4261409308 4294965029 4294964006 4294964261 4294964005 4294964262 4278187808 4227854104 4291404035 1342177280 0 0 0 0 4034548736 4294954779 4294958122 4278115368 4294958631 4294959657 4294959143 4294892583 4278115368 4227848229 4291400451 1325400064 0 0 0 0 4017705216 4294950663 4294887947 4294954762 4294559499 4268183567 4290943244 4294956298 4278110986 4227843593 4291267073 1308622848 0 0 0 0 4017704704 4294948352 4294819586 4278174209 4294952962 4281870593 4274821634 4278176001 4294951169 4227841281 4291266048 1308622848 0 0 0 0 4017704448 4294947584 4294818816 4294884608 4294951936 4289694976 4277977088 4278173184 4294950144 4227840256 4291265536 1308622848 0 0 0 0 4000992768 4294947584 4261198592 4261264640 4261198848 4261397248 4261264896 4261264640 4261199104 4210931712 4291199744 1308622848 0 0 0 0 4168239106 4294616837 4294290950 4294356998 4294356998 4294357254 4294356997 4294356998 4294356997 4294421509 4290542083 1308622848 0 0 0 0 1342966019 2367953415 2250709769 2250644233 2250644233 2250644233 2250644233 2250644233 2250644233 2250841097 2148929541 100663296 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: 0@0)! !

!PluggableTextMorphWithLimits methodsFor: 'private' stamp: ''!
textSize

	^ self class textSizeOf: self text! !

!PluggableTextMorphWithLimits methodsFor: 'drawing' stamp: 'CamilloBruni 10/9/2012 17:58'!
basicColor

	^ extension
		ifNil: [ color]
		ifNotNil: [ 
			extension fillStyle 
				ifNil: [ color ]
				ifNotNil: [ :fillStyle | fillStyle asColor ]].! !

!PluggableTextMorphWithLimits methodsFor: 'private' stamp: 'EstebanLorenzano 4/29/2014 15:46'!
stringColor
	| size |
	
	size := self textSize.
	self warningLimit negative ifTrue: [ ^ self theme textColor ].
	^ size >= self warningLimit
			ifTrue: [
				size >= self alertLimit
					ifTrue: [ Color red ]
					ifFalse: [ Color orange ]]
			ifFalse: [ self theme textColor ].! !

!PluggableTextMorphWithLimits methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 8/6/2012 01:26'!
alertLimit

	^ alertLimit ifNil: [ alertLimit := 2 * (self warningLimit) ]! !

!PluggableTextMorphWithLimits methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 8/4/2012 00:52'!
lock

	self locked: true! !

!PluggableTextMorphWithLimits methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 23:06'!
initialize

	super initialize.
	locked := false.
	lockIcon := self defaultOpenMorph.
	self addIcon.
	lockIcon on: #mouseEnter send: #colorize to: self.
	lockIcon on: #mouseLeave send: #decolorize to: self.
	lockIcon on: #click send: #toggleLock to: self! !

!PluggableTextMorphWithLimits methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 8/6/2012 01:27'!
warningLimit

	^ warningLimit ifNil: [ warningLimit := self class defaultWarningLimit ]! !

!PluggableTextMorphWithLimits methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 8/6/2012 01:30'!
forceRedraw

	self fullDrawOn: World canvas! !

!PluggableTextMorphWithLimits methodsFor: 'icon' stamp: 'MarcusDenker 7/7/2014 12:33'!
colorize

	self  locked ifTrue: [ ^ self ].
	
	lockIcon alpha: 1! !

!PluggableTextMorphWithLimits methodsFor: 'icon' stamp: 'MarcusDenker 7/7/2014 12:33'!
decolorize

	self  locked ifTrue: [ ^ self ].
	
	lockIcon alpha: 0.6! !

!PluggableTextMorphWithLimits methodsFor: 'icon' stamp: 'BenjaminVanRyseghem 8/5/2012 23:46'!
lockSelector: aSelector

	lockSelector := aSelector! !

!PluggableTextMorphWithLimits methodsFor: 'test' stamp: 'BenjaminVanRyseghem 8/5/2012 23:34'!
innerExtent
"self halt."
"	lock := lock +1.
"	
	^ (self innerBounds extent - 6" - (10+((self textSize printString size+1)*(self basicWidth)))")  max: 0@0! !

!PluggableTextMorphWithLimits methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 8/6/2012 00:24'!
canLockChangeSelector: aSelector

	canLockChangeSelector := aSelector! !

!PluggableTextMorphWithLimits methodsFor: 'geometry' stamp: 'MarcusDenker 7/26/2014 09:25'!
extent: newExtent
	"The inner bounds may have changed due to scrollbar visibility."

	| delta |
	super extent: newExtent.
	lockIcon ifNil: [ ^ self ].
	lockIcon extent: 16 @ 16.
	delta := self vIsScrollbarShowing
		ifTrue: [ 13 ]
		ifFalse: [ 0 ].
	lockIcon topRight: (self bounds right - 8 - delta) @ (self bounds top + 8)! !

!PluggableTextMorphWithLimits methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 8/6/2012 01:37'!
drawOn: aCanvas

	| rect stringColor size top bottom newRect |

	super drawOn: aCanvas.
	
	size := self textSize.
	rect := self buildRectFrom: self bounds.
	top := self bounds top + self borderWidth.
	bottom := self bounds bottom - self borderWidth.
	stringColor := self stringColor.
	newRect := (rect left-self basicWidth-10)@top corner: (rect right)@bottom.
	aCanvas
		fillRectangle: newRect
		fillStyle: (self backgroundColorFor: newRect ).
	self wantsFrameAdornments ifTrue: [
		self theme drawTextAdornmentsFor: self on: aCanvas].

	(self warningLimit negative or: [ self warningLimit isZero ])
		ifFalse: [ 
			aCanvas 
				drawString: size printString 
				in: rect
				font: TextStyle defaultFont 
				color: stringColor ].! !

!PluggableTextMorphWithLimits methodsFor: 'initialize' stamp: 'BenjaminVanRyseghem 8/27/2012 11:30'!
defaultUnLockIcon

	"^ UITheme current lockIcon"
	^(Form
	extent: 16@16
	depth: 32
	fromArray:  #(0 0 0 0 0 0 0 5592147 0 0 553648128 721420288 704643072 65332446 0 16843009 0 0 0 0 0 0 1117968 0 251658240 3121943830 4067060333 4187132310 4136011145 3794874930 1459617792 0 0 0 0 0 0 0 0 285212672 3962186029 4290954954 4291743700 4288849064 4289967289 4293323247 4284375141 1779503121 0 0 0 0 0 19474729 0 2434077717 4288389285 4287862940 3306558744 1728250885 2416774413 4283322451 4292007904 4030084923 0 0 0 0 0 0 0 3761057329 4289771971 3677040432 0 0 0 2097152000 4287797409 4284967793 187182949 704643072 671088640 671088640 671088640 738197504 469762048 4027519529 4289574351 3305178143 370154881 0 0 1308622848 4286482061 4219175047 3444196907 4287397895 4287792646 4287726598 4287726598 4287726854 4287595012 4288516623 4276410968 4288581898 4234040595 671088674 0 1493172224 4282928210 4282796368 4284962839 4294962178 4294957827 4294957571 4294957571 4294956802 4294957571 4294957825 4278177536 4294959105 4291141640 1375731713 0 490486844 1578768664 1528305431 4268053271 4294955008 4294950912 4294950913 4278107905 4294953992 4294886402 4278042624 4294950913 4294951936 4290810373 1275068417 0 0 0 0 4284895767 4278177025 4294819329 4294950656 4278174729 4279439628 4290284299 4278175744 4294819329 4294951424 4290875397 1275068417 0 0 0 0 4284960281 4278175236 4294752004 4294883076 4278172678 4285416465 4292910091 4278172676 4294817540 4294949892 4290873864 1258291200 0 0 0 0 4284893978 4278173194 4294684936 4277973000 4278170632 4292053266 4294289676 4278039048 4277973001 4294948104 4290806284 1275068416 0 15529452 0 0 4284695837 4244618773 4244616980 4244616980 4244616724 4244618515 4244616979 4244616724 4244616724 4244618260 4290673173 1442840588 0 0 0 0 2822188320 4285022227 4234952979 4251664659 4234887443 4234952723 4234887187 4218110227 4218110227 4268704530 3964153623 572797508 0 0 0 0 0 33554432 33554432 16777216 33554432 33554432 33554432 33554432 33554432 33554432 0 0 18487065 15529709 0 0 2040093 17630726 17498117 17432837 17498373 17563909 17498373 17563909 17563909 17498116 920589 16777215 0 0 0 0)
	offset: 0@0)! !

!PluggableTextMorphWithLimits methodsFor: 'initialize' stamp: 'IgorStasenko 12/19/2012 18:14'!
addIcon
	self addMorph: lockIcon fullFrame: ((1 @ 0 corner: 1 @ 0) asLayoutFrame leftOffset: -20; bottomOffset: 20)! !

!PluggableTextMorphWithLimits methodsFor: 'actions' stamp: 'CamilloBruni 9/21/2013 11:58'!
acceptBasic
	"should be refactored with accept that comes from PluggableTextMorphPlus "
	"Inform the model of text to be accepted, and return true if OK."

	| saveSelection saveScrollerOffset |
	
	self locked ifFalse: [ ^ super acceptBasic ].
	
	saveSelection := self selectionInterval copy.
	saveScrollerOffset := scroller offset copy.

	(self canDiscardEdits and: [self alwaysAccept not])
		ifTrue: [^ self flash].
 
	self hasEditingConflicts ifTrue:[
		(self confirm: 
'Caution!! This method may have been
changed elsewhere since you started
editing it here.  Accept anyway?' translated) 
			ifFalse: [^ self flash]].

	[ method methodClass 
		compile: (self styler unstyledTextFrom: textMorph asText)
		classified: method category
		notifying: self
	] ensure: [ unstyledAcceptText := nil ].

	self hasUnacceptedEdits: false.

	["During the step for the browser, updateCodePaneIfNeeded is called, and 
		invariably resets the contents of the codeholding PluggableTextMorph
		at that time, resetting the cursor position and scroller in the process.
		The following line forces that update without waiting for the step, then restores the cursor and scrollbar"

		(model respondsTo: #updateCodePaneIfNeeded) 
			ifTrue: [model updateCodePaneIfNeeded].
		scroller offset: saveScrollerOffset.
		self setScrollDeltas.
		self selectFrom: saveSelection first to: saveSelection last 
	] on: Error do: []! !

!PluggableTextMorphWithLimits methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 3/20/2012 17:30'!
buildRectFrom: rect

	| top bottom right left |
	top := (rect bottom - StandardFonts defaultFont height - 4).
	bottom := rect bottom.
	right := rect right.
	left := right - ((self textSize printString size+1)*(self basicWidth)).
	self vIsScrollbarShowing 
		ifTrue: [ 
			right := right - scrollBar width.
			left := left - scrollBar width ].
	
	^ (left-5@top corner: right-5@bottom)! !

!PluggableTextMorphWithLimits methodsFor: '*Deprecated40' stamp: 'MarcusDenker 7/7/2014 14:34'!
ifLocked: aBlock
	self deprecated: 'just use locked ifTrue:' on: '2 July 2014' in: 'Pharo40'.
	self locked ifTrue: aBlock ! !

!PluggableTextMorphWithLimits methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 8/4/2012 00:52'!
unlock

	self locked: false! !

!PluggableTextMorphWithLimits methodsFor: '*Deprecated40' stamp: 'MarcusDenker 7/7/2014 16:09'!
ifLocked: aBlock ifUnlocked: anotherBlock
	self deprecated: 'just use locked ifTrue:' on: '2 July 2014' in: 'Pharo40'.
	self locked ifTrue: aBlock ifFalse: anotherBlock! !

!PluggableTextMorphWithLimits methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 3/20/2012 16:46'!
basicWidth

	^ StandardFonts defaultFont widthOf: $2! !

!PluggableTextMorphWithLimits methodsFor: 'private' stamp: 'BenjaminVanRyseghem 8/5/2012 22:16'!
setBalloonTextFrom: aMethod
	| string |
	
	string := String streamContents: [:s | 
					s << aMethod methodClass name << '>>#' << aMethod selector ].
	self setBalloonText: string! !

!PluggableTextMorphWithLimits methodsFor: 'protocol' stamp: 'MarcusDenker 7/7/2014 12:31'!
toggleLock

	self canChangeLock ifFalse: [ ^ self ].
	
	self locked
		ifTrue: [
			self unlock.
			lockIcon image: self defaultUnLockIcon
			 ]
		ifFalse: [ 
			self lock.
			lockIcon image: self defaultLockIcon ].
		
	self model ifNotNil: [:m |
		self lockSelector ifNotNil: [:s |
			m perform: s withEnoughArguments: { self locked . self } ]]! !

!PluggableTextMorphWithLimits methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 8/3/2012 17:53'!
locked
	^ locked! !

!PluggableTextMorphWithLimits methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 8/5/2012 22:15'!
lockFrom: aMethod

	self lock.
	method := aMethod.
	self setBalloonTextFrom: aMethod ! !

!PluggableTextMorphWithLimits methodsFor: 'drawing' stamp: 'EstebanLorenzano 5/1/2014 01:56'!
backgroundColorFor: rect
	"Return the current fillStyle of the receiver."
	| basicColor defaultColor |

	defaultColor := self theme textEditorNormalFillStyleFor: self.
	
	"The next line is the minimal change to get Vistary Theme working for Case 
	13112 during Pharo 3 Beta. Case 13121 is logged to clean this further in Pharo 4"
	(defaultColor isKindOf: FillStyle) ifTrue: [ ^ defaultColor ].
	
	basicColor := self basicColor.
	
	self warningLimit negative ifTrue: [ ^ basicColor ].
	
	textMorph ifNotNil: [ | size |
		size := self textSize.
		( size >= self warningLimit )
			ifTrue: [ | overshoot transitionSpan transitionColor |
				transitionSpan := self warningLimit.
				transitionColor := Color yellow mixed: 0.6 with: self basicColor.
				( size >= self alertLimit )
					ifFalse: [ overshoot := size - self warningLimit ]
					ifTrue: [
						transitionSpan := self alertLimit - self warningLimit.
						basicColor := transitionColor mixed: 0.5 with: self basicColor.
						transitionColor := (Color orange mixed: 0.5 with: Color red) mixed: 0.5 with: self basicColor.
						overshoot := size - self alertLimit ].
				^ CompositeFillStyle fillStyles: {
					(GradientFillStyle 
						ramp: {0->transitionColor. 1 -> basicColor })
						origin: (rect width/2) asFloat @ rect bottom;
						direction: 0@((12+(2*rect height*overshoot / transitionSpan)) negated asFloat);
						normal: 0@1;
						radial: false;
						yourself.
					(GradientFillStyle 
						ramp: {0 -> defaultColor. 0.3->(defaultColor alpha: 0.01) })
						origin: rect left @ (rect height/2) asFloat;
						direction: (rect width)@0;
						normal: 1@0;
						radial: false;
						yourself } ] ].
	
	^ basicColor
! !

!PluggableTextMorphWithLimits methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 8/3/2012 17:53'!
locked: anObject
	locked := anObject! !

!PluggableTextMorphWithLimits methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 8/5/2012 23:56'!
canChangeLock

	self model
		ifNotNil: [:m |
			self canLockChangeSelector ifNotNil: [:s |
				^ m perform: s withEnoughArguments: { self } ]].
	^ true! !

!PluggableTextMorphWithLimits methodsFor: 'icon' stamp: 'BenjaminVanRyseghem 8/5/2012 23:56'!
canLockChangeSelector

	^ canLockChangeSelector! !

!PluggableTextMorphWithLimits methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 8/6/2012 01:27'!
warningLimit: anObject
	
	warningLimit := anObject! !

!PluggableTextMorphWithLimits class methodsFor: 'accessing' stamp: ''!
defaultWarningLimit: anInteger
	" self defaultWarningLimit:nil "

	DefaultWarningLimit := anInteger! !

!PluggableTextMorphWithLimits class methodsFor: 'text' stamp: ''!
textSizeOf: aText

	| result count ignoredCharacters |
	result := 0.
	count := true.
	ignoredCharacters := self ignoredCharacters.
	aText do: [:char |
		(char = $")
			ifTrue: [ count := count not ]
			ifFalse: [
				((ignoredCharacters includes: char) not and: [ count ])
					ifTrue: [ result := result + 1 ]]].
	^ result.! !

!PluggableTextMorphWithLimits class methodsFor: 'text' stamp: ''!
ignoredCharacters

	^ { Character space. Character tab. Character cr. $.. $;. $:. $'. $(. $) }! !

!PluggableTextMorphWithLimits class methodsFor: 'example' stamp: 'MarcusDenker 7/26/2014 09:26'!
example
	" self example "

	| window textMorph |
	textMorph := self on: self text: #getText accept: nil.
	window := StandardWindow new.
	window addMorph: textMorph frame: (0 @ 0 corner: 1 @ 1).
	window openInWorld.
	window title: 'PluggableTextMorphWithLimits example' translated! !

!PluggableTextMorphWithLimits class methodsFor: 'example' stamp: ''!
getText

	^ '
" an example to show that comments are not counted " 

asdasf
a
s

d

f

as d            kfj.
ha,sdkjhfaksdjhfakjsdhfakjsh.
df.kajhsdf.kajhsdf.kjahsd.fkj.
ahs.dkja.sdkfjha.sdkfjha.skdjfh.kasjdhf.kasjd


hf.aksjdhfakjsdhfwuelriuweliuqywerliquyerliqwuyerlqiwuyerliq
								wuyerliqwuyerlqiuweyrlqiwueyrlqwieuyrlqwiueyrlqwieuyrlqiweuyrlqwiuerylqiwueyrlqiwueyrlqiwueyrlqwiuerylqiwueyrlqiweuyrlqwieuyrlqwiueyrlqweiuyrlqwieuryqlwiehfgh
								
								
							
						((ENTER RANDOM CHARACTERS NOW))'! !

!PluggableTextMorphWithLimits class methodsFor: 'accessing' stamp: ''!
resetDefaultWarningLimit
	" self resetDefaultWarningLimit "

	self defaultWarningLimit: nil! !

!PluggableTextMorphWithLimits class methodsFor: 'accessing' stamp: ''!
defaultWarningLimit

	^ DefaultWarningLimit ifNil: [ DefaultWarningLimit := 350 ]! !

!PluggableThreePhaseButtonMorph commentStamp: '<historical>'!
A PluggableThreePhaseButtonMorph is an extesion of ThreePhaseButtonMorph to make it pluggable

Then a model can be defined, and queried for state, on image, off image and pressed image.!
!PluggableThreePhaseButtonMorph methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 1/21/2012 23:01'!
updatePressedImage

	self pressedImage: ( target perform: pressedImageSelector )! !

!PluggableThreePhaseButtonMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/21/2012 23:07'!
offImageSelector: anObject 

	offImageSelector := anObject! !

!PluggableThreePhaseButtonMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/21/2012 23:08'!
pressedImageSelector

	^ pressedImageSelector! !

!PluggableThreePhaseButtonMorph methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 1/21/2012 23:16'!
update: aSymbol

	aSymbol == stateSelector
		ifTrue: [ ^ self updateState ].
	aSymbol == onImageSelector
		ifTrue: [ ^ self updateOnImage ].
	aSymbol == offImageSelector
		ifTrue: [ ^ self updateOffImage ].
	aSymbol == pressedImageSelector
		ifTrue: [ ^ self updatePressedImage ].
				
	^ super update: aSymbol! !

!PluggableThreePhaseButtonMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/21/2012 23:08'!
offImageSelector

	^ offImageSelector! !

!PluggableThreePhaseButtonMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/21/2012 23:08'!
stateSelector: anObject 

	stateSelector := anObject! !

!PluggableThreePhaseButtonMorph methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 1/21/2012 23:01'!
updateOnImage

	self onImage: ( target perform: onImageSelector )! !

!PluggableThreePhaseButtonMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/21/2012 23:08'!
pressedImageSelector: anObject 

	pressedImageSelector := anObject! !

!PluggableThreePhaseButtonMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/21/2012 23:08'!
onImageSelector

	^ onImageSelector! !

!PluggableThreePhaseButtonMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/21/2012 23:25'!
balloonText

	^ self helpText! !

!PluggableThreePhaseButtonMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/21/2012 23:25'!
helpText: anObject 

	helpText := anObject! !

!PluggableThreePhaseButtonMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/21/2012 23:08'!
onImageSelector: anObject 

	onImageSelector := anObject! !

!PluggableThreePhaseButtonMorph methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 1/21/2012 23:15'!
updateState

	( target perform: stateSelector )
		ifTrue: [ self state: #on ]
		ifFalse:[ self state: #off ]! !

!PluggableThreePhaseButtonMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/21/2012 23:25'!
helpText

	^ helpText! !

!PluggableThreePhaseButtonMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/21/2012 23:08'!
stateSelector

	^ stateSelector! !

!PluggableThreePhaseButtonMorph methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 1/21/2012 23:01'!
updateOffImage

	self offImage: ( target perform: offImageSelector )! !

!PluggableThreePhaseButtonMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/21/2012 23:04'!
target: anObject

	target ifNotNil: [ target removeDependent: self ].
	anObject ifNotNil: [ anObject addDependent: self ].
	target := anObject.! !

!PluggableThreePhaseButtonMorph class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 1/21/2012 22:53'!
on: aModel

	^ self new 
			target: aModel;
			yourself! !

!PluggableTreeItemNode commentStamp: 'ar 2/12/2005 04:37'!
Tree item for PluggableTreeMorph.!
!PluggableTreeItemNode methodsFor: 'accessing' stamp: 'ar 2/12/2005 00:04'!
icon
	^model iconOfNode: self! !

!PluggableTreeItemNode methodsFor: 'accessing' stamp: 'ar 2/12/2005 00:16'!
balloonText
	^model balloonTextForNode: self! !

!PluggableTreeItemNode methodsFor: 'accessing' stamp: 'ar 2/12/2005 00:16'!
acceptDroppingObject: anotherItem
	^model dropNode: anotherItem on: self! !

!PluggableTreeItemNode methodsFor: 'accessing' stamp: 'ar 2/12/2005 00:02'!
canBeDragged
	^model isDraggableNode: self! !

!PluggableTreeItemNode methodsFor: 'accessing' stamp: 'ar 2/12/2005 00:16'!
wantsDroppedObject: anotherItem
	^model wantsDroppedNode: anotherItem on: self! !

!PluggableTreeItemNode methodsFor: 'accessing' stamp: 'ar 2/12/2005 00:16'!
hasContents
	^model hasNodeContents: self! !

!PluggableTreeItemNode methodsFor: 'accessing' stamp: 'ar 2/12/2005 00:03'!
contents
	^model contentsOfNode: self! !

!PluggableTreeItemNode methodsFor: 'accessing' stamp: 'ar 2/12/2005 00:16'!
asString
	^model printNode: self! !

!PluggableTreeMorph commentStamp: 'ar 2/12/2005 04:38'!
A pluggable tree morph.!
!PluggableTreeMorph methodsFor: 'accessing' stamp: 'ar 2/12/2005 00:26'!
dropItemSelector
	^dropItemSelector! !

!PluggableTreeMorph methodsFor: 'accessing' stamp: 'ar 2/12/2005 00:26'!
wantsDropSelector
	^wantsDropSelector! !

!PluggableTreeMorph methodsFor: 'accessing' stamp: 'ar 2/12/2005 00:24'!
getRootsSelector
	^getRootsSelector! !

!PluggableTreeMorph methodsFor: 'accessing' stamp: 'ar 2/12/2005 00:24'!
hasChildrenSelector
	^hasChildrenSelector! !

!PluggableTreeMorph methodsFor: 'updating' stamp: 'ar 2/12/2005 17:29'!
selectPath: path in: listItem
	path isEmpty ifTrue: [^self setSelectedMorph: nil].
	listItem withSiblingsDo: [:each | 
		(each complexContents item = path first) ifTrue: [
			each isExpanded ifFalse: [
				each toggleExpandedState.
				self adjustSubmorphPositions.
			].
			each changed.
			path size = 1 ifTrue: [
				^self setSelectedMorph: each
			].
			each firstChild ifNil: [^self setSelectedMorph: nil].
			^self selectPath: path allButFirst in: each firstChild
		].
	].
	^self setSelectedMorph: nil

! !

!PluggableTreeMorph methodsFor: 'node access' stamp: 'ar 2/12/2005 00:20'!
printNode: node
	getLabelSelector ifNil:[^node item printString].
	^model perform: getLabelSelector with: node item! !

!PluggableTreeMorph methodsFor: 'node access' stamp: 'ar 2/12/2005 00:19'!
balloonTextForNode: node
	getHelpSelector ifNil:[^nil].
	^model perform: getHelpSelector with: node item! !

!PluggableTreeMorph methodsFor: 'node access' stamp: 'ar 2/12/2005 01:13'!
contentsOfNode: node
	| children |
	getChildrenSelector ifNil:[^#()].
	children := model perform: getChildrenSelector with: node item.
	^children collect:[:item| PluggableTreeItemNode with: item model: self]! !

!PluggableTreeMorph methodsFor: 'accessing' stamp: 'ar 2/12/2005 03:33'!
getSelectedPathSelector: aSymbol
	getSelectedPathSelector := aSymbol.! !

!PluggableTreeMorph methodsFor: 'morphic' stamp: 'BenjaminVanRyseghem 3/25/2013 13:33'!
wantsDroppedMorph: aMorph event: anEvent
	
	aMorph dragTransferType == #dragTransfer ifFalse: [ ^ false ].
	
	^ wantsDropSelector 
		ifNil: [ model
			wantsDroppedMorph: aMorph 
			event: anEvent 
			inMorph: self ]
		ifNotNil: [
			model 
				perform: wantsDropSelector 
				with: aMorph passenger ]! !

!PluggableTreeMorph methodsFor: 'accessing' stamp: 'ar 2/12/2005 00:26'!
getHelpSelector: aSymbol
	getHelpSelector := aSymbol! !

!PluggableTreeMorph methodsFor: 'selection' stamp: 'LaurentLaffont 3/17/2010 21:41'!
setSelectedMorph: aMorph
	selectedWrapper := aMorph complexContents.
	self selection: selectedWrapper.
	setSelectionSelector ifNotNil:[
		model 
			perform: setSelectionSelector 
			with: (selectedWrapper ifNotNil:[selectedWrapper item]).
	].! !

!PluggableTreeMorph methodsFor: 'node access' stamp: 'BenjaminVanRyseghem 3/25/2013 13:33'!
wantsDroppedNode: srcNode on: dstNode
	dropItemSelector ifNil:[^false].
	wantsDropSelector ifNil:[^true].
	^(model perform: wantsDropSelector with: srcNode with: dstNode) == true! !

!PluggableTreeMorph methodsFor: 'node access' stamp: 'ar 2/12/2005 00:20'!
dropNode: srcNode on: dstNode
	dropItemSelector ifNil:[^nil].
	model perform: dropItemSelector with: srcNode item with: dstNode item! !

!PluggableTreeMorph methodsFor: 'accessing' stamp: 'ar 2/12/2005 00:24'!
getChildrenSelector
	^getChildrenSelector! !

!PluggableTreeMorph methodsFor: 'accessing' stamp: 'ar 2/12/2005 00:25'!
getLabelSelector
	^getLabelSelector! !

!PluggableTreeMorph methodsFor: 'accessing' stamp: 'mvdg 2/11/2007 13:53'!
dragItemSelector
	^dragItemSelector! !

!PluggableTreeMorph methodsFor: 'accessing' stamp: 'LaurentLaffont 3/17/2010 21:42'!
setSelectedSelector
	^setSelectionSelector! !

!PluggableTreeMorph methodsFor: 'morphic' stamp: 'BenjaminVanRyseghem 3/25/2013 13:16'!
acceptDroppingMorph: aMorph event: evt
	| item dropTarget |

	dropItemSelector 
		ifNil:[
			model 
				acceptDroppingMorph: aMorph 
				event: evt 
				inMorph: self ]
		ifNotNil: [
			item := aMorph passenger.
			dropTarget := (self itemFromPoint: evt position) withoutListWrapper.
			model perform: dropItemSelector with: item with: dropTarget ].
		
	evt hand releaseMouseFocus: self.
	Cursor normal show.
! !

!PluggableTreeMorph methodsFor: 'accessing' stamp: 'ar 2/12/2005 00:27'!
wantsDropSelector: aSymbol
	wantsDropSelector := aSymbol! !

!PluggableTreeMorph methodsFor: 'accessing' stamp: 'ar 2/12/2005 00:26'!
getHelpSelector
	^getHelpSelector! !

!PluggableTreeMorph methodsFor: 'morphic' stamp: 'BenjaminVanRyseghem 11/5/2013 11:22'!
startDrag: anEvent 
	| aTransferMorph itemMorph passenger |
	
	self dragEnabled
		ifTrue: [itemMorph := scroller submorphs
						detect: [:any | any highlightedForMouseDown]
						ifNone: []].
	(itemMorph isNil
			or: [anEvent hand hasSubmorphs])
		ifTrue: [^ self].
	itemMorph highlightForMouseDown: false.
	itemMorph ~= self selectedMorph
		ifTrue: [self setSelectedMorph: itemMorph].
		
	passenger := dragItemSelector
		ifNil: [ self model
			dragPassengerFor: itemMorph withoutListWrapper 
			inMorph: self ]
		ifNotNil: [
			self model 
				perform: dragItemSelector 
				withEnoughArguments: { itemMorph withoutListWrapper. self } ].
			
	passenger
		ifNotNil: [aTransferMorph := self model transferFor: passenger from: self.
			aTransferMorph dragTransferType: #dragTransfer.
			aTransferMorph align: aTransferMorph draggedMorph center with: anEvent position.
			anEvent hand grabMorph: aTransferMorph].
	anEvent hand releaseMouseFocus: self! !

!PluggableTreeMorph methodsFor: 'accessing' stamp: 'mvdg 2/9/2007 21:37'!
dropItemSelector: aSymbol
	dropItemSelector := aSymbol.
	aSymbol ifNotNil:[self dropEnabled: true].! !

!PluggableTreeMorph methodsFor: 'accessing' stamp: 'ar 2/12/2005 00:25'!
getIconSelector: aSymbol
	getIconSelector := aSymbol! !

!PluggableTreeMorph methodsFor: 'accessing' stamp: 'ar 2/12/2005 00:58'!
keystrokeActionSelector: aSymbol
	keystrokeActionSelector := aSymbol! !

!PluggableTreeMorph methodsFor: 'accessing' stamp: 'ar 2/12/2005 00:58'!
keystrokeActionSelector
	^keystrokeActionSelector! !

!PluggableTreeMorph methodsFor: 'updating' stamp: 'ar 2/12/2005 19:11'!
update: what
	what ifNil:[^self].
	what == getRootsSelector ifTrue:[
		self roots: (model perform: getRootsSelector)
	].
	what == getSelectedPathSelector ifTrue:[
		^self selectPath: (model perform: getSelectedPathSelector)
			in: (scroller submorphs at: 1 ifAbsent: [^self]) 
	].
	^super update: what! !

!PluggableTreeMorph methodsFor: 'accessing' stamp: 'mvdg 2/11/2007 13:53'!
dragItemSelector: aSymbol
	dragItemSelector := aSymbol.
	aSymbol ifNotNil:[self dragEnabled: true].! !

!PluggableTreeMorph methodsFor: 'accessing' stamp: 'ar 2/12/2005 01:11'!
roots: anArray
	roots := anArray collect:[:item| PluggableTreeItemNode with: item model: self].
	self list: roots.! !

!PluggableTreeMorph methodsFor: 'accessing' stamp: 'ar 2/12/2005 00:22'!
roots
	^roots! !

!PluggableTreeMorph methodsFor: 'accessing' stamp: 'ar 2/12/2005 03:33'!
getSelectedPathSelector
	^getSelectedPathSelector! !

!PluggableTreeMorph methodsFor: 'accessing' stamp: 'ar 2/12/2005 00:25'!
hasChildrenSelector: aSymbol
	hasChildrenSelector := aSymbol! !

!PluggableTreeMorph methodsFor: 'accessing' stamp: 'ar 2/12/2005 00:25'!
getLabelSelector: aSymbol
	getLabelSelector := aSymbol! !

!PluggableTreeMorph methodsFor: 'accessing' stamp: 'ar 2/12/2005 00:24'!
getRootsSelector: aSelector
	getRootsSelector := aSelector.
	self update: getRootsSelector.! !

!PluggableTreeMorph methodsFor: 'node access' stamp: 'ar 2/12/2005 00:20'!
iconOfNode: node
	getIconSelector ifNil:[^nil].
	^model perform: getIconSelector with: node item! !

!PluggableTreeMorph methodsFor: 'node access' stamp: 'ar 2/12/2005 00:11'!
hasNodeContents: node
	hasChildrenSelector ifNil:[^node contents isEmpty not].
	^model perform: hasChildrenSelector with: node item! !

!PluggableTreeMorph methodsFor: 'node access' stamp: 'ar 2/12/2005 00:02'!
isDraggableNode: node
	^true! !

!PluggableTreeMorph methodsFor: 'accessing' stamp: 'LaurentLaffont 3/17/2010 21:42'!
setSelectedSelector: aSymbol
	setSelectionSelector := aSymbol! !

!PluggableTreeMorph methodsFor: 'accessing' stamp: 'ar 2/12/2005 00:25'!
getIconSelector
	^getIconSelector! !

!PluggableTreeMorph methodsFor: 'accessing' stamp: 'ar 2/12/2005 00:24'!
getChildrenSelector: aSymbol
	getChildrenSelector := aSymbol.! !

!PluginBasedJPEGReadWriter commentStamp: '<historical>'!
I provide fast JPEG compression and decompression. I require the VM pluginJPEGReadWriter2Plugin, which is typically stored in same directory as the Squeak virtual machine.

JPEGReadWriter2Plugin is based on LIBJPEG library. This sentence applies to the plugin:
   "This software is based in part on the work of the Independent JPEG Group".

The LIBJPEG license allows it to be used free for any purpose so long as its origin and copyright are acknowledged. You can read more about LIBJPEG and get the complete source code at www.ijg.org.
!
!PluginBasedJPEGReadWriter methodsFor: 'testing' stamp: 'ar 11/27/2001 00:40'!
isPluginPresent
	^self primJPEGPluginIsPresent! !

!PluginBasedJPEGReadWriter methodsFor: 'primitives' stamp: 'ar 11/27/2001 00:39'!
primJPEGPluginIsPresent
	<primitive: 'primJPEGPluginIsPresent' module: 'JPEGReadWriter2Plugin'>
	^false! !

!PluginBasedJPEGReadWriter methodsFor: 'public access' stamp: 'jm 11/20/2001 10:21'!
nextPutImage: aForm
	"Encode the given Form on my stream with default quality."

	^ self nextPutImage: aForm quality: -1 progressiveJPEG: false
! !

!PluginBasedJPEGReadWriter methodsFor: 'primitives' stamp: 'jm 11/20/2001 10:35'!
primJPEGDecompressStructSize

	<primitive: 'primJPEGDecompressStructSize' module: 'JPEGReadWriter2Plugin'>
	self primitiveFailed
! !

!PluginBasedJPEGReadWriter methodsFor: 'primitives' stamp: 'jm 11/20/2001 10:35'!
primJPEGErrorMgr2StructSize

	<primitive: 'primJPEGErrorMgr2StructSize' module: 'JPEGReadWriter2Plugin'>
	self primitiveFailed
! !

!PluginBasedJPEGReadWriter methodsFor: 'public access' stamp: 'lr 7/4/2009 10:42'!
nextImageSuggestedDepth: depth 
	"Decode and answer a Form of the given depth from my stream. Close the stream if it is a file stream. Possible depths are 16-bit and 32-bit."
	| bytes width height form jpegDecompressStruct jpegErrorMgr2Struct depthToUse |
	bytes := stream upToEnd.
	stream close.
	jpegDecompressStruct := ByteArray new: self primJPEGDecompressStructSize.
	jpegErrorMgr2Struct := ByteArray new: self primJPEGErrorMgr2StructSize.
	self 
		primJPEGReadHeader: jpegDecompressStruct
		fromByteArray: bytes
		errorMgr: jpegErrorMgr2Struct.
	width := self primImageWidth: jpegDecompressStruct.
	height := self primImageHeight: jpegDecompressStruct.
	"Odd width images of depth 16 gave problems. Avoid them (or check carefully!!)"
	depthToUse := depth = 32 | width odd 
		ifTrue: [ 32 ]
		ifFalse: [ 16 ].
	form := Form 
		extent: width @ height
		depth: depthToUse.
	(width = 0 or: [ height = 0 ]) ifTrue: [ ^ form ].
	self 
		primJPEGReadImage: jpegDecompressStruct
		fromByteArray: bytes
		onForm: form
		doDithering: true
		errorMgr: jpegErrorMgr2Struct.
	^ form! !

!PluginBasedJPEGReadWriter methodsFor: 'public access' stamp: 'lr 7/4/2009 10:42'!
compress: aForm quality: quality 
	"Encode the given Form and answer the compressed ByteArray. Quality goes from 0 (low) to 100 (high), where -1 means default."
	| sourceForm jpegCompressStruct jpegErrorMgr2Struct buffer byteCount |
	aForm unhibernate.
	"odd width images of depth 16 give problems; avoid them."
	sourceForm := aForm depth = 32 | (aForm width even & (aForm depth = 16)) 
		ifTrue: [ aForm ]
		ifFalse: [ aForm asFormOfDepth: 32 ].
	jpegCompressStruct := ByteArray new: self primJPEGCompressStructSize.
	jpegErrorMgr2Struct := ByteArray new: self primJPEGErrorMgr2StructSize.
	buffer := ByteArray new: sourceForm width * sourceForm height + 1024.
	byteCount := self 
		primJPEGWriteImage: jpegCompressStruct
		onByteArray: buffer
		form: sourceForm
		quality: quality
		progressiveJPEG: false
		errorMgr: jpegErrorMgr2Struct.
	byteCount = 0 ifTrue: [ self error: 'buffer too small for compressed data' ].
	^ buffer 
		copyFrom: 1
		to: byteCount! !

!PluginBasedJPEGReadWriter methodsFor: 'public access' stamp: 'lr 7/4/2009 10:42'!
nextPutImage: aForm quality: quality progressiveJPEG: progressiveFlag 
	"Encode the given Form on my stream with the given settings. Quality goes from 0 (low) to 100 (high), where -1 means default. If progressiveFlag is true, encode as a progressive JPEG."
	| sourceForm jpegCompressStruct jpegErrorMgr2Struct buffer byteCount |
	aForm unhibernate.
	"odd width images of depth 16 give problems; avoid them."
	sourceForm := aForm depth = 32 | (aForm width even & (aForm depth = 16)) 
		ifTrue: [ aForm ]
		ifFalse: [ aForm asFormOfDepth: 32 ].
	jpegCompressStruct := ByteArray new: self primJPEGCompressStructSize.
	jpegErrorMgr2Struct := ByteArray new: self primJPEGErrorMgr2StructSize.
	buffer := ByteArray new: sourceForm width * sourceForm height + 1024.
	byteCount := self 
		primJPEGWriteImage: jpegCompressStruct
		onByteArray: buffer
		form: sourceForm
		quality: quality
		progressiveJPEG: progressiveFlag
		errorMgr: jpegErrorMgr2Struct.
	byteCount = 0 ifTrue: [ self error: 'buffer too small for compressed data' ].
	stream 
		next: byteCount
		putAll: buffer
		startingAt: 1.
	self close! !

!PluginBasedJPEGReadWriter methodsFor: 'primitives' stamp: 'jm 11/20/2001 10:35'!
primImageWidth: aJPEGCompressStruct

	<primitive: 'primImageWidth' module: 'JPEGReadWriter2Plugin'>
	self primitiveFailed
! !

!PluginBasedJPEGReadWriter methodsFor: 'public access' stamp: 'lr 7/4/2009 10:42'!
imageExtent: aByteArray 
	"Answer the extent of the compressed image encoded in the given ByteArray."
	| jpegDecompressStruct jpegErrorMgr2Struct w h |
	jpegDecompressStruct := ByteArray new: self primJPEGDecompressStructSize.
	jpegErrorMgr2Struct := ByteArray new: self primJPEGErrorMgr2StructSize.
	self 
		primJPEGReadHeader: jpegDecompressStruct
		fromByteArray: aByteArray
		errorMgr: jpegErrorMgr2Struct.
	w := self primImageWidth: jpegDecompressStruct.
	h := self primImageHeight: jpegDecompressStruct.
	^ w @ h! !

!PluginBasedJPEGReadWriter methodsFor: 'primitives' stamp: 'jm 11/20/2001 10:35'!
primJPEGReadHeader: aJPEGDecompressStruct fromByteArray: source errorMgr: aJPEGErrorMgr2Struct

	<primitive: 'primJPEGReadHeaderfromByteArrayerrorMgr' module: 'JPEGReadWriter2Plugin'>
	self primitiveFailed
! !

!PluginBasedJPEGReadWriter methodsFor: 'public access' stamp: 'lr 7/4/2009 10:42'!
uncompress: aByteArray into: aForm doDithering: ditherFlag 
	"Uncompress an image from the given ByteArray into the given Form. 
	Fails if the given Form has the wrong dimensions or depth.
	If aForm has depth 16 and ditherFlag = true, do ordered dithering."
	| jpegDecompressStruct jpegErrorMgr2Struct w h |
	aForm unhibernate.
	jpegDecompressStruct := ByteArray new: self primJPEGDecompressStructSize.
	jpegErrorMgr2Struct := ByteArray new: self primJPEGErrorMgr2StructSize.
	self 
		primJPEGReadHeader: jpegDecompressStruct
		fromByteArray: aByteArray
		errorMgr: jpegErrorMgr2Struct.
	w := self primImageWidth: jpegDecompressStruct.
	h := self primImageHeight: jpegDecompressStruct.
	aForm width = w & (aForm height = h) ifFalse: [ ^ self error: 'form dimensions do not match' ].

	"odd width images of depth 16 give problems; avoid them"
	w odd 
		ifTrue: 
			[ aForm depth = 32 ifFalse: [ ^ self error: 'must use depth 32 with odd width' ] ]
		ifFalse: 
			[ aForm depth = 16 | (aForm depth = 32) ifFalse: [ ^ self error: 'must use depth 16 or 32' ] ].
	self 
		primJPEGReadImage: jpegDecompressStruct
		fromByteArray: aByteArray
		onForm: aForm
		doDithering: ditherFlag
		errorMgr: jpegErrorMgr2Struct! !

!PluginBasedJPEGReadWriter methodsFor: 'public access' stamp: 'jm 11/20/2001 10:23'!
nextImage
	"Decode and answer a Form from my stream."

	^ self nextImageSuggestedDepth: Display depth
! !

!PluginBasedJPEGReadWriter methodsFor: 'primitives' stamp: 'jm 11/20/2001 10:35'!
primJPEGWriteImage: aJPEGCompressStruct onByteArray: destination form: form quality: quality progressiveJPEG: progressiveFlag errorMgr: aJPEGErrorMgr2Struct

	<primitive: 'primJPEGWriteImageonByteArrayformqualityprogressiveJPEGerrorMgr' module: 'JPEGReadWriter2Plugin'>
	self primitiveFailed
! !

!PluginBasedJPEGReadWriter methodsFor: 'primitives' stamp: 'jm 11/20/2001 10:35'!
primJPEGCompressStructSize

	<primitive: 'primJPEGCompressStructSize' module: 'JPEGReadWriter2Plugin'>
	self primitiveFailed
! !

!PluginBasedJPEGReadWriter methodsFor: 'primitives' stamp: 'jm 11/20/2001 10:34'!
primImageHeight: aJPEGCompressStruct

	<primitive: 'primImageHeight' module: 'JPEGReadWriter2Plugin'>
	self primitiveFailed
! !

!PluginBasedJPEGReadWriter methodsFor: 'testing' stamp: 'ar 11/27/2001 00:39'!
understandsImageFormat
	"Answer true if the image stream format is understood by this decoder."
	self isPluginPresent ifFalse:[^false]. "cannot read it otherwise"
	self next = 16rFF ifFalse: [^ false].
	self next = 16rD8 ifFalse: [^ false].
	^ true
! !

!PluginBasedJPEGReadWriter methodsFor: 'public access' stamp: 'lr 7/4/2009 10:42'!
uncompress: aByteArray into: aForm 
	"Uncompress an image from the given ByteArray into the given Form.
	Fails if the given Form has the wrong dimensions or depth.
	If aForm has depth 16, do ordered dithering."
	| jpegDecompressStruct jpegErrorMgr2Struct w h |
	aForm unhibernate.
	jpegDecompressStruct := ByteArray new: self primJPEGDecompressStructSize.
	jpegErrorMgr2Struct := ByteArray new: self primJPEGErrorMgr2StructSize.
	self 
		primJPEGReadHeader: jpegDecompressStruct
		fromByteArray: aByteArray
		errorMgr: jpegErrorMgr2Struct.
	w := self primImageWidth: jpegDecompressStruct.
	h := self primImageHeight: jpegDecompressStruct.
	aForm width = w & (aForm height = h) ifFalse: [ ^ self error: 'form dimensions do not match' ].

	"odd width images of depth 16 give problems; avoid them"
	w odd 
		ifTrue: 
			[ aForm depth = 32 ifFalse: [ ^ self error: 'must use depth 32 with odd width' ] ]
		ifFalse: 
			[ aForm depth = 16 | (aForm depth = 32) ifFalse: [ ^ self error: 'must use depth 16 or 32' ] ].
	self 
		primJPEGReadImage: jpegDecompressStruct
		fromByteArray: aByteArray
		onForm: aForm
		doDithering: true
		errorMgr: jpegErrorMgr2Struct! !

!PluginBasedJPEGReadWriter methodsFor: 'primitives' stamp: 'jmv 12/7/2001 13:45'!
primJPEGReadImage: aJPEGDecompressStruct fromByteArray: source onForm: form doDithering: ditherFlag errorMgr: aJPEGErrorMgr2Struct

	<primitive: 'primJPEGReadImagefromByteArrayonFormdoDitheringerrorMgr' module: 'JPEGReadWriter2Plugin'>
	self primitiveFailed
! !

!PluginBasedJPEGReadWriter class methodsFor: 'image reading/writing' stamp: 'usmanbhatti 11/5/2013 11:26'!
putForm: aForm quality: quality progressiveJPEG: progressiveFlag onFileNamed: fileName 
	"Store the given Form as a JPEG file of the given name, overwriting any existing file of that name. Quality goes from 0 (low) to 100 (high), where -1 means default. If progressiveFlag is true, encode as a progressive JPEG."
	| writer |
	fileName asFileReference ensureDelete.
	writer := self on: (FileStream newFileNamed: fileName) binary.
	Cursor write showWhile: 
		[ writer 
			nextPutImage: aForm
			quality: quality
			progressiveJPEG: progressiveFlag ].
	writer close! !

!PluginBasedJPEGReadWriter class methodsFor: 'image reading/writing' stamp: 'ar 6/16/2002 18:54'!
primJPEGPluginIsPresent
	<primitive: 'primJPEGPluginIsPresent' module: 'JPEGReadWriter2Plugin'>
	^false! !

!PluginBasedJPEGReadWriter class methodsFor: 'image reading/writing' stamp: 'nk 7/16/2003 17:56'!
typicalFileExtensions
	"Answer a collection of file extensions (lowercase) which files that I can read might commonly have"
	^#('jpg' 'jpeg')! !

!PluginTreeNode commentStamp: '<historical>'!
A PluginTreeNode is a node of a NautilusPluginManagerTree!
!PluginTreeNode methodsFor: 'private' stamp: 'BenjaminVanRyseghem 8/25/2011 15:04'!
getPositionsList

	^ self item 
		ifNil: [ {} ]
		ifNotNil: [:it | it first possiblePositions ]! !

!PluginTreeNode methodsFor: 'private' stamp: 'BenjaminVanRyseghem 8/25/2011 14:56'!
buildDropListFor: aSelector

	| dropList |
	dropList :=  self theme
					newDropListIn: World
					for: self
					list: #getPositionsList
					getSelected: #getSelectedPosition
					setSelected: #setSelectedPosition:
					getEnabled: nil
					useIndex: true
					help: 'Select the position where the plugin will be displayed'.
	dropList
		hResizing: #rigid.
	dropList width: 75.
	^ dropList! !

!PluginTreeNode methodsFor: 'morphs' stamp: 'BenjaminVanRyseghem 8/25/2011 14:17'!
firstMorph

	^ self item 
		ifNotNil: [:it | it first pluginName asStringMorph ]! !

!PluginTreeNode methodsFor: 'private' stamp: 'BenjaminVanRyseghem 8/25/2011 14:59'!
setSelectedPosition: anIndex

	| position |
	selectedPosition := anIndex.
	position := self getPositionsList at: anIndex.
	self item at: 2 put: position.
	self changed: #getSelectedPosition! !

!PluginTreeNode methodsFor: 'morphs' stamp: 'BenjaminVanRyseghem 8/25/2011 14:22'!
secondMorph
	
	^ self item 
		ifNotNil: [:it |	self buildDropListFor: it second ]! !

!PluginTreeNode methodsFor: 'private' stamp: 'BenjaminVanRyseghem 8/25/2011 14:50'!
getSelectedPosition

	^ selectedPosition ifNil: [| it |
		it := self item ifNotNil: [ self item second ].
		selectedPosition := self getPositionsList indexOf: it ]! !

!Point commentStamp: '<historical>'!
I represent an x-y pair of numbers usually designating a location on the screen.!
!Point methodsFor: 'accessing' stamp: ''!
x
	"Answer the x coordinate."

	^x! !

!Point methodsFor: 'polar coordinates' stamp: 'hk 11/10/2005 10:07'!
theta
	"Answer the angle the receiver makes with origin in radians. right is 0; 
	down is 90. 
	Corrected the constants from single precision to 64 Bit precision 
	and changed the sends in case of overflow to constants HK 2005-07-23"

	| tan theta |
	x = 0
		ifTrue: [y >= 0
				ifTrue: [^ 1.570796326794897 "90.0 degreesToRadians"]
				ifFalse: [^ 4.71238898038469 "270.0 degreesToRadians"]]
		ifFalse: 
			[tan := y asFloat / x asFloat.
			theta := tan arcTan.
			x >= 0
				ifTrue: [y >= 0
						ifTrue: [^theta]
						ifFalse: [^"360.0 degreesToRadians" 6.283185307179586 + theta]]
				ifFalse: [^"180.0 degreesToRadians" 3.141592653589793 + theta]]! !

!Point methodsFor: 'point functions' stamp: '6/9/97 14:51 di'!
quadrantOf: otherPoint
	"Return 1..4 indicating relative direction to otherPoint.
	1 is downRight, 2=downLeft, 3=upLeft, 4=upRight"
	^ x <= otherPoint x
		ifTrue: [y < otherPoint y ifTrue: [1] ifFalse: [4]]
		ifFalse: [y <= otherPoint y ifTrue: [2] ifFalse: [3]]
"
[Sensor anyButtonPressed] whileFalse:
	[(Display boundingBox center quadrantOf: Sensor cursorPoint) printString displayAt: 0@0]
"! !

!Point methodsFor: 'point functions' stamp: 'jm 2/24/98 08:34'!
onLineFrom: p1 to: p2 within: epsilon
	"Answer true if the receiver lies on the given line segment between p1 and p2 within a small epsilon."

	"is this point within the box spanning p1 and p2 expanded by epsilon? (optimized)"
	p1 x < p2 x
		ifTrue: [
			((x < (p1 x - epsilon)) or: [x > (p2 x + epsilon)]) ifTrue: [^ false]]
		ifFalse: [
			((x < (p2 x - epsilon)) or: [x > (p1 x + epsilon)]) ifTrue: [^ false]].
	p1 y < p2 y
		ifTrue: [
			((y < (p1 y - epsilon)) or: [y > (p2 y + epsilon)]) ifTrue: [^ false]]
		ifFalse: [
			((y < (p2 y - epsilon)) or: [y > (p1 y + epsilon)]) ifTrue: [^ false]].

	"it's in the box; is it on the line?"
	^ (self dist: (self nearestPointAlongLineFrom: p1 to: p2)) <= epsilon! !

!Point methodsFor: 'private' stamp: 'lr 7/4/2009 10:42'!
bitShiftPoint: bits 
	x := x bitShift: bits.
	y := y bitShift: bits! !

!Point methodsFor: 'comparing' stamp: ''!
< aPoint 
	"Answer whether the receiver is above and to the left of aPoint."

	^x < aPoint x and: [y < aPoint y]! !

!Point methodsFor: 'transforming' stamp: 'di 12/4/97 14:34'!
scaleFrom: rect1 to: rect2
	"Produce a point stretched according to the stretch from rect1 to rect2"
	^ rect2 topLeft + (((x-rect1 left) * rect2 width // rect1 width)
					@ ((y-rect1 top) * rect2 height // rect1 height))! !

!Point methodsFor: 'geometry' stamp: 'lr 7/4/2009 10:42'!
sideOf: otherPoint 
	"Returns #left, #right or #center if the otherPoint lies to the left, right 
	or on the line given by the vector from 0@0 to self"
	| side |
	side := (self crossProduct: otherPoint) sign.
	^ {  #right. #center. #left  } at: side + 2! !

!Point methodsFor: 'arithmetic' stamp: 'di 11/6/1998 14:02'!
\\ arg 
	"Answer a Point that is the mod of the receiver and arg."

	arg isPoint ifTrue: [^ (x \\ arg x) @ (y \\ arg y)].
	^ arg adaptToPoint: self andSend: #\\! !

!Point methodsFor: 'extent functions' stamp: 'StephaneDucasse 5/27/2010 22:11'!
scaleTo: anExtent
	"Return a Point scalefactor for shrinking a thumbnail of the receiver's extent to fit within anExtent"
	" self and anExtent are expected to have positive nonZero x and y. "
	|  factor  sX sY | 
	factor :=  3.0  reciprocal . "EccentricityThreshhold reciprical"
	sX := anExtent x / self  x asFloat  .
	sY :=  anExtent y / self  y asFloat  .
	sX = sY ifTrue: [ ^ sX @ sY ] . "Same aspect ratio"
	^ sX < sY 
		ifTrue: [ sX @ (sX max: sY * factor) ] 
		ifFalse: [ (sY max: sX * factor ) @ sY  ] ! !

!Point methodsFor: 'point functions' stamp: 'lr 7/4/2009 10:42'!
grid: aPoint 
	"Answer a Point to the nearest rounded grid modules specified by aPoint."
	| newX newY |
	newX := x + (aPoint x // 2) truncateTo: aPoint x.
	newY := y + (aPoint y // 2) truncateTo: aPoint y.
	^ newX @ newY! !

!Point methodsFor: 'arithmetic' stamp: 'di 11/6/1998 14:02'!
// arg 
	"Answer a Point that is the quotient of the receiver and arg."

	arg isPoint ifTrue: [^ (x // arg x) @ (y // arg y)].
	^ arg adaptToPoint: self andSend: #//! !

!Point methodsFor: 'converting' stamp: ''!
asIntegerPoint
	^ x asInteger @ y asInteger! !

!Point methodsFor: 'point functions' stamp: 'gvc 10/31/2006 11:01'!
directionToLineFrom: p1 to: p2
	"Answer the direction of the line from the receiver
	position.
	< 0 => left (receiver to right)
	= => on line
	> 0 => right (receiver to left)."

	^((p2 x - p1 x) * (self y - p1 y)) -
		((self x - p1 x) * (p2 y - p1 y))! !

!Point methodsFor: 'polar coordinates' stamp: ''!
r
	"Answer the receiver's radius in polar coordinate system."

	^(self dotProduct: self) sqrt! !

!Point methodsFor: 'point functions' stamp: 'gvc 2/17/2008 13:36'!
angleWith: aPoint
	"Answer the angle in radians between the vectors represented by
	the receiver and aPoint from the origin."

	|ar ap|
	ar := self angle.
	ap := aPoint angle.
	^ap >= ar
		ifTrue: [ap - ar]
		ifFalse: [Float pi * 2 - ar + ap]! !

!Point methodsFor: 'geometry' stamp: 'laza 1/24/2000 03:44'!
isInsideCircle: a with: b with: c 
	"Returns TRUE if self is inside the circle defined by the     
	points a, b, c. See Guibas and Stolfi (1985) p.107"
	^ (a dotProduct: a)
		* (b triangleArea: c with: self) - ((b dotProduct: b)
			* (a triangleArea: c with: self)) + ((c dotProduct: c)
			* (a triangleArea: b with: self)) - ((self dotProduct: self)
			* (a triangleArea: b with: c)) > 0.0! !

!Point methodsFor: 'comparing' stamp: ''!
>= aPoint 
	"Answer whether the receiver is neither above nor to the left of aPoint."

	^x >= aPoint x and: [y >= aPoint y]! !

!Point methodsFor: 'transforming' stamp: 'CamilloBruni 8/1/2012 16:12'!
negated
	"Answer a point whose x and y coordinates are the negatives of those of the receiver."
	^ (0 - x) @ (0 - y)! !

!Point methodsFor: 'transforming' stamp: ''!
translateBy: delta 
	"Answer a Point translated by delta (an instance of Point)."

	^(delta x + x) @ (delta y + y)! !

!Point methodsFor: 'point functions' stamp: 'lr 7/4/2009 10:42'!
squaredDistanceTo: aPoint 
	"Answer the distance between aPoint and the receiver."
	| delta |
	delta := aPoint - self.
	^ delta dotProduct: delta! !

!Point methodsFor: 'point functions' stamp: 'di 6/11/97 16:08'!
flipBy: direction centerAt: c
	"Answer a Point which is flipped according to the direction about the point c.
	Direction must be #vertical or #horizontal."
	direction == #vertical ifTrue: [^ x @ (c y * 2 - y)].
	direction == #horizontal ifTrue: [^ (c x * 2 - x) @ y].
	self error: 'unrecognizable direction'! !

!Point methodsFor: 'point functions' stamp: 'lr 7/4/2009 10:42'!
octantOf: otherPoint 
	"Return 1..8 indicating relative direction to otherPoint.  
	1=ESE, 2=SSE, ... etc. clockwise to 8=ENE"
	"[Sensor anyButtonPressed] whileFalse: [(Display boundingBox center 
	octantOf: Sensor cursorPoint) printString displayAt: 0@0]"
	| quad moreHoriz |
	(x = otherPoint x and: [ y > otherPoint y ]) ifTrue: [ ^ 6 ].
	"special case"
	(y = otherPoint y and: [ x < otherPoint x ]) ifTrue: [ ^ 8 ].
	quad := self quadrantOf: otherPoint.
	moreHoriz := (x - otherPoint x) abs >= (y - otherPoint y) abs.
	(quad even eqv: moreHoriz) 
		ifTrue: [ ^ quad * 2 ]
		ifFalse: [ ^ quad * 2 - 1 ]! !

!Point methodsFor: 'transforming' stamp: ''!
scaleBy: factor 
	"Answer a Point scaled by factor (an instance of Point)."

	^(factor x * x) @ (factor y * y)! !

!Point methodsFor: 'point functions' stamp: 'lr 7/4/2009 10:42'!
normalized
	"Optimized for speed -- ar 8/26/2001"
	| r |
	r := (x * x + (y * y)) sqrt.
	^ (x / r) @ (y / r)! !

!Point methodsFor: 'converting' stamp: 'di 11/9/1998 12:44'!
adaptToNumber: rcvr andSend: selector
	"If I am involved in arithmetic with an Integer, convert it to a Point."
	^ rcvr@rcvr perform: selector with: self! !

!Point methodsFor: 'point functions' stamp: 'di 12/1/97 12:12'!
onLineFrom: p1 to: p2
	^ self onLineFrom: p1 to: p2 within: 2! !

!Point methodsFor: 'converting' stamp: 'di 11/6/1998 13:47'!
adaptToString: rcvr andSend: selector
	"If I am involved in arithmetic with a String, convert it to a Number."
	^ rcvr asNumber perform: selector with: self! !

!Point methodsFor: 'point functions' stamp: 'FBS 1/5/2004 13:08'!
bearingToPoint: anotherPoint
    "Return the bearing, in degrees, from the receiver to anotherPoint.
     Adapted from Playground, where the ultimate provenance of the algorithm was a wild earlier method of Jay Fenton's which I never checked carefully, but the thing has always seemed to work"

    | deltaX deltaY  |
    deltaX := anotherPoint x -  x.
    deltaY := anotherPoint y - y.

    deltaX abs < 0.001
        ifTrue:
            [^ deltaY > 0 ifTrue: [180] ifFalse: [0]].

    ^ ((deltaX >= 0 ifTrue: [90] ifFalse: [270])
            - ((deltaY / deltaX) arcTan negated radiansToDegrees)) rounded
! !

!Point methodsFor: 'point functions' stamp: 'ar 4/18/1999 05:17'!
sortsBefore: otherPoint
	"Return true if the receiver sorts before the other point"
	^y = otherPoint y
		ifTrue:[x <= otherPoint x]
		ifFalse:[y <= otherPoint y]! !

!Point methodsFor: 'point functions' stamp: 'lr 7/4/2009 10:42'!
dist: aPoint 
	"Answer the distance between aPoint and the receiver."
	| dx dy |
	dx := aPoint x - x.
	dy := aPoint y - y.
	^ (dx * dx + (dy * dy)) sqrt! !

!Point methodsFor: 'point functions' stamp: 'StephaneDucasse 7/7/2010 23:38'!
sign
	^ (x sign @ y sign)! !

!Point methodsFor: 'arithmetic' stamp: 'di 11/6/1998 14:01'!
+ arg 
	"Answer a Point that is the sum of the receiver and arg."

	arg isPoint ifTrue: [^ (x + arg x) @ (y + arg y)].
	^ arg adaptToPoint: self andSend: #+! !

!Point methodsFor: 'polar coordinates' stamp: 'lr 7/4/2009 10:42'!
degrees
	"Answer the angle the receiver makes with origin in degrees. right is 0; down is 90."
	| tan theta |
	x = 0 
		ifTrue: 
			[ y >= 0 
				ifTrue: [ ^ 90.0 ]
				ifFalse: [ ^ 270.0 ] ]
		ifFalse: 
			[ tan := y asFloat / x asFloat.
			theta := tan arcTan.
			x >= 0 
				ifTrue: 
					[ y >= 0 
						ifTrue: [ ^ theta radiansToDegrees ]
						ifFalse: [ ^ 360.0 + theta radiansToDegrees ] ]
				ifFalse: [ ^ 180.0 + theta radiansToDegrees ] ]! !

!Point methodsFor: 'comparing' stamp: ''!
min: aMin max: aMax 

	^ (self min: aMin) max: aMax! !

!Point methodsFor: 'printing' stamp: 'StephaneDucasse 11/18/2011 22:38'!
printOn: aStream 
	"The receiver prints on aStream in terms of infix notation."
	
	aStream nextPut: $(.
	x printOn: aStream.
	aStream nextPut: $@.
	(y notNil and: [y negative])
		ifTrue: [
			"Avoid ambiguous @- construct"
			aStream space].
	y printOn: aStream.
	aStream nextPut: $).! !

!Point methodsFor: 'truncation and roundoff' stamp: 'wiz 1/11/2006 18:32'!
isIntegerPoint
^ x isInteger and: [ y isInteger ] ! !

!Point methodsFor: 'extent functions' stamp: 'wiz 8/9/2005 02:44'!
guarded
"Return a positive nonzero extent."
self max: 1@1 .! !

!Point methodsFor: 'truncation and round off' stamp: 'nice 2/5/2006 16:35'!
roundTo: grid
	"Answer a Point that is the receiver's x and y rounded to grid x and 
	grid y."
	
	| gridPoint |
	gridPoint := grid asPoint.
	^(x roundTo: gridPoint x) @ (y roundTo: gridPoint y)! !

!Point methodsFor: 'point functions' stamp: 'nice 3/5/2010 22:39'!
fourNeighbors
	^ Array with: self + (1 @ 0)
		with: self + (0 @ 1)
		with: self + (-1 @ 0)
		with: self + (0 @ -1)
! !

!Point methodsFor: 'point functions' stamp: 'StephaneDucasse 7/7/2010 23:58'!
eightNeighbors
	^ { self + (1 @ 0) . self + (1 @ 1) .  self + (0 @ 1) . self + (-1 @ 1) . self + (-1 @ 0) .
		 self + (-1 @ -1) . self + (0 @ -1) . self + (1 @ -1)}
! !

!Point methodsFor: 'private' stamp: 'lr 7/4/2009 10:42'!
setX: xValue setY: yValue 
	x := xValue.
	y := yValue! !

!Point methodsFor: 'printing' stamp: 'ar 7/8/2006 19:15'!
storeOn: aStream 
	"x@y printed form is good for storing too"
	aStream nextPut: $(.
	self printOn: aStream.
	aStream nextPut: $).
! !

!Point methodsFor: 'comparing' stamp: ''!
min: aPoint 
	"Answer the upper left corner of the rectangle uniquely defined by the 
	receiver and the argument, aPoint."

	^ (x min: aPoint x) @ (y min: aPoint y)! !

!Point methodsFor: 'arithmetic' stamp: 'gvc 10/12/2006 10:13'!
min
	"Answer a number that is the minimum
	of the x and y of the receiver."

	^self x min: self y! !

!Point methodsFor: 'transforming' stamp: 'di 4/30/1998 11:16'!
adhereTo: aRectangle
	"If the receiver lies outside aRectangle, return the nearest point on the boundary of the rectangle, otherwise return self."

	(aRectangle containsPoint: self) ifTrue: [^ self].
	^ ((x max: aRectangle left) min: aRectangle right)
		@ ((y max: aRectangle top) min: aRectangle bottom)! !

!Point methodsFor: 'interpolating' stamp: 'jsp 3/22/1999 16:31'!
interpolateTo: end at: amountDone
	"Interpolate between the instance and end after the specified amount has been done (0 - 1)."

	^ self + ((end - self) * amountDone).! !

!Point methodsFor: 'comparing' stamp: ''!
= aPoint

	self species = aPoint species
		ifTrue: [^x = aPoint 
	"Refer to the comment in Object|=." x and: [y = aPoint y]]
		ifFalse: [^false]! !

!Point methodsFor: 'geometry' stamp: 'laza 1/17/2000 15:47'!
triangleArea: b with: c
	"Returns twice the area of the oriented triangle (a, b, c), i.e., the   
	area is positive if the triangle is oriented counterclockwise"
	^ b x - self x * (c y - self y) - (b y - self y * (c x - self x))! !

!Point methodsFor: 'point functions' stamp: 'lr 7/4/2009 10:42'!
insideTriangle: p1 with: p2 with: p3 
	"Return true if the receiver is within the triangle defined by the three coordinates.
	Note: This method computes the barycentric coordinates for the receiver and tests those coordinates."
	| p0 b0 b1 b2 b3 |
	p0 := self.
	b0 := (p2 x - p1 x) * (p3 y - p1 y) - ((p3 x - p1 x) * (p2 y - p1 y)).
	b0 isZero ifTrue: [ ^ false ].	"degenerate"
	b0 := 1.0 / b0.
	b1 := ((p2 x - p0 x) * (p3 y - p0 y) - ((p3 x - p0 x) * (p2 y - p0 y))) * b0.
	b2 := ((p3 x - p0 x) * (p1 y - p0 y) - ((p1 x - p0 x) * (p3 y - p0 y))) * b0.
	b3 := ((p1 x - p0 x) * (p2 y - p0 y) - ((p2 x - p0 x) * (p1 y - p0 y))) * b0.
	b1 < 0.0 ifTrue: [ ^ false ].
	b2 < 0.0 ifTrue: [ ^ false ].
	b3 < 0.0 ifTrue: [ ^ false ].
	^ true! !

!Point methodsFor: 'arithmetic' stamp: 'di 11/6/1998 14:01'!
* arg 
	"Answer a Point that is the product of the receiver and arg."

	arg isPoint ifTrue: [^ (x * arg x) @ (y * arg y)].
	^ arg adaptToPoint: self andSend: #*! !

!Point methodsFor: 'geometry' stamp: 'laza 1/5/2000 11:50'!
to: end sideOf: otherPoint 
	"Returns #left, #right, #center if the otherPoint lies to the left, right or on the line given by the vector from self to end"
	^ end - self sideOf: otherPoint - self! !

!Point methodsFor: 'comparing' stamp: ''!
<= aPoint 
	"Answer whether the receiver is neither below nor to the right of aPoint."

	^x <= aPoint x and: [y <= aPoint y]! !

!Point methodsFor: 'geometry' stamp: 'lr 7/4/2009 10:42'!
to: end1 intersects: start2 to: end2 
	"Returns true if the linesegment from start1 (=self) to end1 intersects      
	    with the segment from start2 to end2, otherwise false."
	| start1 sideStart sideEnd |
	start1 := self.
	(((start1 = start2 or: [ end1 = end2 ]) or: [ start1 = end2 ]) or: [ start2 = end1 ]) ifTrue: [ ^ true ].
	sideStart := start1 
		to: end1
		sideOf: start2.
	sideEnd := start1 
		to: end1
		sideOf: end2.
	sideStart = sideEnd ifTrue: [ ^ false ].
	sideStart := start2 
		to: end2
		sideOf: start1.
	sideEnd := start2 
		to: end2
		sideOf: end1.
	sideStart = sideEnd ifTrue: [ ^ false ].
	^ true! !

!Point methodsFor: 'converting' stamp: 'di 11/6/1998 13:45'!
adaptToCollection: rcvr andSend: selector
	"If I am involved in arithmetic with a Collection, return a Collection of
	the results of each element combined with me in that expression."

	^ rcvr collect: [:element | element perform: selector with: self]! !

!Point methodsFor: 'arithmetic' stamp: 'gvc 10/12/2006 10:12'!
max
	"Answer a number that is the maximum
	of the x and y of the receiver."

	^self x max: self y! !

!Point methodsFor: 'private' stamp: 'lr 7/4/2009 10:42'!
setR: rho degrees: degrees 
	| radians |
	radians := degrees asFloat degreesToRadians.
	x := rho asFloat * radians cos.
	y := rho asFloat * radians sin! !

!Point methodsFor: 'truncation and roundoff' stamp: 'nice 2/5/2006 16:43'!
ceiling
	"Answer a Point that is the receiver's x and y ceiling. Answer the receiver if its coordinates are already integral."

	(x isInteger and: [y isInteger]) ifTrue: [^ self].
	^ x ceiling @ y ceiling
! !

!Point methodsFor: 'point functions' stamp: 'StephaneDucasse 7/7/2010 23:42'!
normal
	"Answer a Point representing the unit vector rotated 90 deg clockwise. For the zero point return -1@0."

	| n d |
	n := y negated @ x.
	(d := (n x * n x + (n y * n y))) = 0
		 ifTrue: [ ^ -1 @0].
	^n / d sqrt! !

!Point methodsFor: 'converting' stamp: ''!
asPoint
	"Answer the receiver itself."

	^self! !

!Point methodsFor: 'accessing' stamp: ''!
y
	"Answer the y coordinate."

	^y! !

!Point methodsFor: 'point functions' stamp: 'StephaneDucasse 8/15/2013 18:28'!
nearestPointOnLineFrom: p1 to: p2
	"This will not give points beyond the endpoints"
	^ (self nearestPointAlongLineFrom: p1 to: p2)
		adhereTo: (p1 rectangle: p2)! !

!Point methodsFor: 'truncation and roundoff' stamp: 'nice 2/5/2006 16:42'!
roundDownTo: grid
	"Answer a Point that is the receiver's x and y rounded to grid x and 
	grid y by lower value (toward negative infinity)."
	
	| gridPoint |
	gridPoint := grid asPoint.
	^(x roundDownTo: gridPoint x) @ (y roundDownTo: gridPoint y)! !

!Point methodsFor: 'arithmetic' stamp: ''!
abs
	"Answer a Point whose x and y are the absolute values of the receiver's x 
	and y."

	^ x abs @ y abs! !

!Point methodsFor: 'converting' stamp: 'di 11/6/1998 07:45'!
isPoint
	^ true! !

!Point methodsFor: 'geometry' stamp: 'gvc 2/17/2008 13:36'!
angle
	"Answer the angle in radians between the vectors represented by
	the receiver and (1, 0) from the origin."

	^self y arcTan: self x! !

!Point methodsFor: 'point functions' stamp: 'ar 11/12/1998 01:44'!
transposed
	^y@x! !

!Point methodsFor: 'arithmetic' stamp: 'TRee 6/3/2004 11:09'!
reciprocal
    " Answer a Point with coordinates that are the reciprocals of mine. "
    " Method was missing from release. "
    " 20040301 20:50:35 TRee(Squeak3.6-5429-tree07.38) "

    ^ x reciprocal @ y reciprocal.
! !

!Point methodsFor: 'point functions' stamp: 'lr 7/4/2009 10:42'!
rotateBy: direction centerAt: c 
	"Answer a Point which is rotated according to direction, about the point c.
	Direction must be one of #right (CW), #left (CCW) or #pi (180 degrees)."
	| offset |
	offset := self - c.
	direction == #right ifTrue: [ ^ offset y negated @ offset x + c ].
	direction == #left ifTrue: [ ^ offset y @ offset x negated + c ].
	direction == #pi ifTrue: [ ^ c - offset ].
	self error: 'unrecognizable direction'! !

!Point methodsFor: 'point functions' stamp: 'gvc 2/17/2008 13:36'!
reflectedAbout: aPoint
	"Answer a new point that is the reflection of the receiver about the given point."

	^(self - aPoint) negated + aPoint! !

!Point methodsFor: 'converting' stamp: ''!
corner: aPoint 
	"Answer a Rectangle whose origin is the receiver and whose corner is 
	aPoint. This is one of the infix ways of expressing the creation of a 
	rectangle."

	^Rectangle origin: self corner: aPoint! !

!Point methodsFor: 'converting' stamp: ''!
asFloatPoint
	^ x asFloat @ y asFloat! !

!Point methodsFor: 'converting' stamp: 'wiz 11/25/2004 12:48'!
asNonFractionalPoint
(x isFraction or: [y isFraction])
	ifTrue:[^ x asFloat @ y asFloat]! !

!Point methodsFor: 'truncation and round off' stamp: 'jm 6/3/1998 12:21'!
rounded
	"Answer a Point that is the receiver's x and y rounded. Answer the receiver if its coordinates are already integral."

	(x isInteger and: [y isInteger]) ifTrue: [^ self].
	^ x rounded @ y rounded
! !

!Point methodsFor: 'arithmetic' stamp: 'di 11/6/1998 14:02'!
/ arg 
	"Answer a Point that is the quotient of the receiver and arg."

	arg isPoint ifTrue: [^ (x / arg x) @ (y / arg y)].
	^ arg adaptToPoint: self andSend: #/! !

!Point methodsFor: 'transforming' stamp: 'lr 7/4/2009 10:42'!
rotateBy: angle about: center 
	"Even though Point.theta is measured CW, this rotates with the more conventional CCW interpretateion of angle."
	| p r theta |
	p := self - center.
	r := p r.
	theta := angle asFloat - p theta.
	^ (center x asFloat + (r * theta cos)) @ (center y asFloat - (r * theta sin))! !

!Point methodsFor: 'comparing' stamp: 'Alexandre Bergel 8/2/2010 12:20'!
closeTo: aPoint
 	^ (x closeTo: aPoint x) and: [ y closeTo: aPoint y ]! !

!Point methodsFor: '*Fuel' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper

	^ aGeneralMapper visitPoint: self
! !

!Point methodsFor: 'point functions' stamp: 'StephaneDucasse 7/7/2010 23:39'!
leftRotated
	"Return the receiver rotated 90 degrees. i.e., self rotateBy: #left centerAt: 0 asPoint.
Compare to transposed and normal."
	^y  @x negated! !

!Point methodsFor: 'truncation and roundoff' stamp: 'nice 2/5/2006 16:43'!
floor
	"Answer a Point that is the receiver's x and y floor. Answer the receiver if its coordinates are already integral."

	(x isInteger and: [y isInteger]) ifTrue: [^ self].
	^ x floor @ y floor
! !

!Point methodsFor: 'arithmetic' stamp: 'di 11/6/1998 14:02'!
- arg 
	"Answer a Point that is the difference of the receiver and arg."

	arg isPoint ifTrue: [^ (x - arg x) @ (y - arg y)].
	^ arg adaptToPoint: self andSend: #-! !

!Point methodsFor: 'converting' stamp: 'Sd 8/2/2014 16:28'!
rectangle: aPoint 
	"Answer a Rectangle that encompasses the receiver and aPoint. This is the most general infix way to create a rectangle."

	^ Rectangle 
		point: self
		point: aPoint! !

!Point methodsFor: 'copying' stamp: 'tk 8/19/1998 16:05'!
veryDeepCopyWith: deepCopier
	"Return self.  I am immutable in the Morphic world.  Do not record me."! !

!Point methodsFor: 'truncation and round off' stamp: 'jm 5/29/1998 15:53'!
truncated
	"Answer a Point whose x and y coordinates are integers. Answer the receiver if its coordinates are already integral."

	(x isInteger and: [y isInteger]) ifTrue: [^ self].
	^ x truncated @ y truncated
! !

!Point methodsFor: 'point functions' stamp: 'lr 7/4/2009 10:42'!
nearestPointAlongLineFrom: p1 to: p2 
	"Note this will give points beyond the endpoints.
	Streamlined by Gerardo Richarte 11/3/97"
	| x21 y21 t x1 y1 |
	p1 x = p2 x ifTrue: [ ^ p1 x @ y ].
	p1 y = p2 y ifTrue: [ ^ x @ p1 y ].
	x1 := p1 x asFloat.
	y1 := p1 y asFloat.
	x21 := p2 x asFloat - x1.
	y21 := p2 y asFloat - y1.
	t := ((y asFloat - y1) / x21 + ((x asFloat - x1) / y21)) / (x21 / y21 + (y21 / x21)).
	^ (x1 + (t * x21)) @ (y1 + (t * y21))
	"
	| old new |
	Pen new place: 200@100; goto: (old := 500@300).
	Display reverse: (old extent: 10@10).
	[Sensor anyButtonPressed] whileFalse:
		[(new := (Sensor cursorPoint nearestPointAlongLineFrom: 200@100 to: 500@300) )
			= old ifFalse:
				[Display reverse: (old extent: 10@10).
				Display reverse: ((old := new) extent: 10@10)]]
"! !

!Point methodsFor: 'truncation and round off' stamp: 'lr 7/4/2009 10:42'!
truncateTo: grid 
	"Answer a Point that is the receiver's x and y truncated to grid x and 
	grid y."
	| gridPoint |
	gridPoint := grid asPoint.
	^ (x truncateTo: gridPoint x) @ (y truncateTo: gridPoint y)! !

!Point methodsFor: 'comparing' stamp: 'SqR 11/3/2000 17:08'!
hash
	"Hash is reimplemented because = is implemented."

	^(x hash hashMultiply + y hash) hashMultiply! !

!Point methodsFor: 'comparing' stamp: ''!
> aPoint 
	"Answer whether the receiver is below and to the right of aPoint."

	^x > aPoint x and: [y > aPoint y]! !

!Point methodsFor: 'converting' stamp: ''!
extent: aPoint 
	"Answer a Rectangle whose origin is the receiver and whose extent is 
	aPoint. This is one of the infix ways of expressing the creation of a 
	rectangle."

	^Rectangle origin: self extent: aPoint! !

!Point methodsFor: 'copying' stamp: ''!
deepCopy
	"Implemented here for better performance."

	^x deepCopy @ y deepCopy! !

!Point methodsFor: 'truncation and roundoff' stamp: 'nice 2/5/2006 16:41'!
roundUpTo: grid
	"Answer a Point that is the receiver's x and y rounded to grid x and 
	grid y by upper value (toward infinity)."
	
	| gridPoint |
	gridPoint := grid asPoint.
	^(x roundUpTo: gridPoint x) @ (y roundUpTo: gridPoint y)! !

!Point methodsFor: 'point functions' stamp: 'StephaneDucasse 7/7/2010 23:40'!
fourDirections
	"Return vertices for a square centered at 0 asPoint with the receiver as first corner.
	Returns the four rotation of the reciever in counter clockwise order with the receiver appearing last."
	
	^ Array with: self leftRotated
			with: self negated
			with: self rightRotated
			with: self 
		
! !

!Point methodsFor: 'comparing' stamp: ''!
max: aPoint 
	"Answer the lower right corner of the rectangle uniquely defined by the 
	receiver and the argument, aPoint."

	^ (x max: aPoint x) @ (y max: aPoint y)! !

!Point methodsFor: 'point functions' stamp: 'StephaneDucasse 7/7/2010 23:38'!
rightRotated
	"Return the receiver rotated 90 degrees, i.e. self rotateBy: #right centerAt: 0 asPoint. Compare to transposed and normal."
	^y negated @x! !

!Point methodsFor: 'point functions' stamp: 'ar 10/30/1998 03:05'!
crossProduct: aPoint 
	"Answer a number that is the cross product of the receiver and the 
	argument, aPoint."

	^ (x * aPoint y) - (y * aPoint x)! !

!Point methodsFor: 'point functions' stamp: 'di 9/11/1998 16:22'!
dotProduct: aPoint 
	"Answer a number that is the dot product of the receiver and the 
	argument, aPoint. That is, the two points are multipled and the 
	coordinates of the result summed."

	^ (x * aPoint x) + (y * aPoint y)! !

!Point methodsFor: 'self evaluating' stamp: 'sd 7/31/2005 21:48'!
isSelfEvaluating
	^ self class == Point! !

!Point methodsFor: 'converting' stamp: 'StephaneDucasse 9/7/2013 13:10'!
asMargin
	^ Margin fromPoint: self.! !

!Point methodsFor: 'testing' stamp: 'ar 10/29/2000 19:02'!
isZero
	^x isZero and:[y isZero]! !

!Point class methodsFor: '*System-Settings-Browser' stamp: 'alain.plantec 4/21/2009 09:57'!
settingInputWidgetForNode: aSettingNode
	^ aSettingNode inputWidgetForPoint! !

!Point class methodsFor: 'instance creation' stamp: 'md 12/2/2004 23:44'!
x: xInteger y: yInteger 
	"Answer an instance of me with coordinates xInteger and yInteger."

	^self basicNew setX: xInteger setY: yInteger! !

!Point class methodsFor: 'instance creation' stamp: 'md 12/2/2004 23:44'!
r: rho degrees: degrees
	"Answer an instance of me with polar coordinates rho and theta."

	^self basicNew setR: rho degrees: degrees! !

!PointArray commentStamp: '<historical>'!
This class stores 32bit Integer points in place. It is used to pass data efficiently to the primitive level during high-bandwidth 2D graphics operations.!
!PointArray methodsFor: 'accessing' stamp: ''!
defaultElement 

	"Return the default element of the receiver"
	^0@0! !

!PointArray methodsFor: 'accessing' stamp: 'ar 11/2/1998 12:21'!
size
	"Return the number of elements in the receiver"
	^super size // 2! !

!PointArray methodsFor: 'accessing' stamp: ''!
at: index

	^(super at: index * 2 - 1) @ (super at: index * 2)! !

!PointArray methodsFor: 'accessing' stamp: ''!
bounds
	| min max |
	min := max := self at: 1.
	self do:[:pt|
		min := min min: pt.
		max := max max: pt].
	^min corner: max
		! !

!PointArray methodsFor: 'converting' stamp: 'NS 5/30/2001 20:54'!
asPointArray
	^ self! !

!PointArray methodsFor: 'accessing' stamp: ''!
at: index put: aPoint

	super at: index * 2 - 1 put: aPoint x asInteger.
	super at: index * 2 put: aPoint y asInteger.
	^aPoint! !

!PointArray class methodsFor: 'instance creation' stamp: 'ar 10/16/1998 00:04'!
new: n
	^super new: n*2! !

!PointArrayTest commentStamp: 'tbn 3/25/2011 15:06'!
SUnit Test for PointArray!
!PointArrayTest methodsFor: 'testing' stamp: 'hjo 1/17/2011 10:14'!
testAtPut

	pointArray at: 2 put: -1 @ -1.
	self assert: 0 @ 0 equals: (pointArray at: 1).
	self assert: -1 @ -1 equals: (pointArray at: 2)
	! !

!PointArrayTest methodsFor: 'testing' stamp: 'hjo 1/17/2011 12:05'!
testAtPutInt4

	pointArray at: 2 put: 405933 @ -405933.
	self assert: 405933@ -405933 equals: (pointArray at: 2)
	! !

!PointArrayTest methodsFor: 'testing' stamp: 'hjo 1/17/2011 11:59'!
testAtPutLargeInteger

	self should:  [pointArray at: 2 put: 123456789012345678901234567890@987654323456787654378989] raise: Error.	! !

!PointArrayTest methodsFor: 'testing' stamp: 'hjo 1/17/2011 10:15'!
testDefaultElement

	self assert: 0@0 equals: pointArray defaultElement
		! !

!PointArrayTest methodsFor: 'testing' stamp: 'hjo 1/17/2011 10:15'!
testBounds

	self assert: (0@0 corner: 10@3) equals: pointArray bounds
		! !

!PointArrayTest methodsFor: 'testing' stamp: 'hjo 1/17/2011 11:56'!
testAtPutFraction

	pointArray at: 2 put: 1/2 @ 51/5.
	self assert: 0 @ 10 equals: (pointArray at: 2)
	! !

!PointArrayTest methodsFor: 'testing' stamp: 'hjo 1/17/2011 10:16'!
testSize

	self assert: 2 equals: pointArray size
		! !

!PointArrayTest methodsFor: 'testing' stamp: 'hjo 1/17/2011 10:13'!
testAt

	self assert: 0@0 equals: (pointArray at: 1).
	self assert: 10@3 equals: (pointArray at: 2)
	! !

!PointArrayTest methodsFor: 'running' stamp: 'hjo 1/15/2011 19:54'!
setUp 

	super setUp.
	pointArray := PointArray with: 0@0 with: 10@3! !

!PointArrayTest methodsFor: 'testing' stamp: 'hjo 1/17/2011 11:54'!
testAtPutFloat

	pointArray at: 2 put: 1.2 @ 5.5.
	self assert: 1 @ 5 equals: (pointArray at: 2)
	! !

!PointTest commentStamp: 'StephaneDucasse 7/7/2010 23:43'!
This is the unit test for the class Point. !
!PointTest methodsFor: 'tests - testing' stamp: 'lr 3/7/2010 12:05'!
testBearingToPoint
	self assert: (0 @ 0 bearingToPoint: 0 @ 0) = 0.
	self assert: (0 @ 0 bearingToPoint: 0 @ -1) = 0.
	self assert: (0 @ 0 bearingToPoint: 1 @ 0) = 90.
	self assert: (0 @ 0 bearingToPoint: 0 @ 1) = 180.
	self assert: (0 @ 0 bearingToPoint: -1 @ 0) = 270.
	self assert: (0 @ 0 bearingToPoint: 1 @ 1) = 135.
	self assert: (0 @ 0 bearingToPoint: 0.01 @ 0) = 90.
	self assert: (0 @ 0 bearingToPoint: -2 @ -3) = 326.
	self assert: (0 @ 0 bearingToPoint: -0 @ 0) = 0.
	self assert: (-2 @ -3 bearingToPoint: 0 @ 0) = 146! !

!PointTest methodsFor: 'tests-point functions' stamp: 'JulesIVANIC 10/28/2013 20:14'!
testCrossProduct

	self assert: (0 @ 0 crossProduct: 0 @ 0) = 0.
	self assert: (1 @ 0 crossProduct: 1 @ 1) = 1.
	self assert: (3 @ 2 crossProduct: 6 @ 4) = 0.
	self assert: (1 @ 2 crossProduct: 3 @ 4) = -2.! !

!PointTest methodsFor: 'tests-truncation and roundoff' stamp: 'JulesIvanic 10/29/2013 21:25'!
testIsIntegerPoint

	self assert: (1 @ 1) isIntegerPoint.
	self assert: (-1 @ 1) isIntegerPoint.
	self assert: (1 @ -1) isIntegerPoint.
	self assert: (-1 @ -1) isIntegerPoint.
	
	self deny: (1 @ 1.2) isIntegerPoint.
	self deny: (1.2 @ 1) isIntegerPoint.
	self deny: (1.2 @ 1.2) isIntegerPoint.
	
	self deny: (-1 @ -1.2) isIntegerPoint.
	self deny: (-1.2 @ -1) isIntegerPoint.
	self deny: (-1.2 @ -1.2) isIntegerPoint.
	! !

!PointTest methodsFor: 'tests - testing' stamp: 'StephaneDucasse 7/8/2010 00:10'!
testRightRotated

	self assert: (10 @ 20) rightRotated = (-20@10)! !

!PointTest methodsFor: 'tests-converting' stamp: 'JulesIvanic 10/29/2013 21:41'!
testIsPoint

	self deny: nil isPoint.
	self deny: 'a' isPoint.
	self deny: 1 isPoint. 
	self deny: -1 isPoint. 
	'Test on a random class'.
	self deny: KernelClassesFilter new isPoint.
	self deny: Object new isPoint.
	self assert: Point new isPoint.
	self assert: (0 @ 0) isPoint.
	self assert: (-1 @ -1) isPoint.
	self assert: (1.2 @ 1.2) isPoint.
	self assert: (-1.2 @ -1.2) isPoint.! !

!PointTest methodsFor: 'tests - testing' stamp: 'StephaneDucasse 7/7/2010 23:59'!
testSign

	self assert: (-3 @ -2) sign = ( -1@ -1).
	self assert: (-3 @ 2) sign = ( -1@ 1).
	self assert: (3 @ -2) sign = ( 1@ -1).
	self assert: (3 @ 2) sign = ( 1@ 1).! !

!PointTest methodsFor: 'tests-point functions' stamp: 'JulesIVANIC 10/28/2013 20:10'!
testFlipByCenterAt

	| center a direction |
	
	center := 4 @ 5.
	
	a := 0 @ 0.
	direction := #vertical.
	self assert: (a flipBy: direction centerAt: center) = (0 @ 10).
	direction := #horizontal.
	self assert: (a flipBy: direction centerAt: center) = (8 @ 0).
	direction := #diagonal.
	self should: [ a flipBy: direction centerAt: center ] raise: Error description: 'unrecognizable direction'.
	
	a := 1 @ 2.
	direction := #vertical.
	self deny: (a flipBy: direction centerAt: center) = (0 @ 10).
	direction := #horizontal.
	self deny: (a flipBy: direction centerAt: center) = (8 @ 0).
	direction := #diagonal.
	self should: [ a flipBy: direction centerAt: center ] raise: Error description: 'unrecognizable direction'! !

!PointTest methodsFor: 'tests - testing' stamp: 'StephaneDucasse 7/7/2010 23:54'!
testBasicFourDirections
	"fourDirections returns the four rotation of the receiver in counter clockwise order with the receiver appearing last."
	
	| samples results rejects |
	self assert:  (0@0) fourDirections = {(0@0). (0@0). (0@0). (0@0)}.
	self assert: (0@0) eightNeighbors =  {(1@0). (1@1). (0@1). (-1@1). (-1@0). (-1@ -1). (0@ -1). (1@ -1)}.

	samples :=  {(1@0). (1@1). (0@1). (-1@1). (-1@0). (-1@ -1). (0@ -1). (1@ -1)}.
	results :=  { {0@ -1 . -1@0 . 0@1 . 1@0} 
 				. {1@ -1 . -1@ -1 . -1@1 . 1@1}  
 				. {1@0 . 0@ -1 . -1@0 . 0@1}  
 				. {1@1 . 1@ -1 . -1@ -1 . -1@1}  
 				. {0@1 . 1@0 . 0@ -1 . -1@0}  
 				. {-1@1 . 1@1 . 1@ -1 . -1@ -1}  
 				. {-1@0 . 0@1 . 1@0 . 0@ -1}  
 				. {-1@ -1 . -1@1 . 1@1 . 1@ -1} } .

	rejects := (1 to: samples size ) reject: [ :each |
											 (samples at: each) fourDirections = (results at: each) ].
	self assert: ( rejects isEmpty).
! !

!PointTest methodsFor: 'tests - testing' stamp: 'Alexandre Bergel 8/2/2010 12:22'!
testCloseTo

	| x y |
	x := 0.00001000001.
	y := 0.0000100000001.

	self assert: (x closeTo: 0.00001).
	self assert: (y closeTo: 0.00001).
	
	self assert: (x@y closeTo: (0.00001@0.00001))! !

!PointTest methodsFor: 'tests-converting' stamp: 'JulesIvanic 10/29/2013 21:36'!
testAsPoint

	self deny: 1 isPoint.
	self deny: 1.2 isPoint.
	self assert: 1 asPoint isPoint.
	self assert: -1 asPoint isPoint.
	self assert: 1.2 asPoint isPoint.
	self assert: -1.2 asPoint isPoint.
	self assert: 1 asPoint = (1 @ 1).
	self assert: -1 asPoint = (-1 @ -1).
	self assert: 1.2 asPoint = (1.2 @ 1.2).
	self assert: -1.2 asPoint = (-1.2 @ -1.2).
	self assert: (1 @ 1) asPoint = (1 @ 1).
	self assert: (-1 @ -1) asPoint = (-1 @ -1).
	self assert: (1.2 @ 1.2) asPoint = (1.2 @ 1.2).
	self assert: (-1.2 @ -1.2) asPoint = (-1.2 @ -1.2).! !

!PointTest methodsFor: 'tests-transforming' stamp: 'JulesIvanic 10/29/2013 21:33'!
testNegated

	self assert: (0 @ 0) negated = (0 @ 0).
	self deny: (0 @ 1) negated = (0 @ 0).
	self deny: (1 @ 0) negated = (0 @ 0).
	self deny: (1 @ 1) negated = (0 @ 0).
	self assert: (1 @ 1) negated = (-1 @ -1).
	self deny: (-1 @ -1) negated = (-1 @ -1).
	self deny: (1 @ -1) negated = (-1 @ -1).
	self deny: (-1 @ 1) negated = (-1 @ -1).
	self assert: (-1 @ -1) negated = (1 @ 1).
	self assert: (1 @ -1) negated = (-1 @ 1).
	self assert: (-1 @ 1) negated = (1 @ -1)! !

!PointTest methodsFor: 'tests - testing' stamp: 'nice 3/5/2010 22:39'!
testTheta
      | result dir tan x y |
	self assert: ((0 @ 1) theta - 90.0 degreesToRadians) abs < 1e-15.
	self assert: ((0 @ -1) theta - 270.0 degreesToRadians) abs < 1e-15.
	" See code of old and new theta"
	x := 1.0 . y := -1.0.
	tan := y  / x .
	dir := tan arcTan.
      result :=  360.0 degreesToRadians + dir.
      self assert: ((x @ y) theta - result) abs < 1e-15.
	x := -1.0. "Don't reuse old results whenyou want numeric precision!!"
	tan := y  / x .
	dir := tan arcTan.
      result :=  180.0 degreesToRadians + dir.
      self assert: ((x @ y) theta - result) abs < 1e-15.

	! !

!PointTest methodsFor: 'tests-arithmetic' stamp: 'JulesIVANIC 10/28/2013 20:11'!
testReciprocal

	self assert: (1 @ 1) reciprocal = (1 @ 1).
	self deny: (2 @ 2) reciprocal = (2 @ 2).
	self assert: (1 @ 5) reciprocal = (1 @ (1 / 5)).
	self should: [ (0 @ 0) reciprocal ] raise: ZeroDivide.
	self should: [ (1 @ 0) reciprocal ] raise: ZeroDivide.
	self should: [ (0 @ 1) reciprocal ] raise: ZeroDivide! !

!PointTest methodsFor: 'tests-point functions' stamp: 'JulesIVANIC 10/28/2013 20:00'!
testDist

	self assert: (0 @ 0 dist: 0 @ 0) = 0.
	self assert: (0 @ 0 dist: 0 @ 5) = 5.
	self assert: (5 @ 0 dist: 0 @ 0) = 5.
	self assert: (3 @ 0 dist: 0 @ 4) = 5.
	self assert: (5 @ 0 dist: 2 @ 4) = 5.
	self deny: (0 @ 0 dist: 0 @ 0) = 1.! !

!PointTest methodsFor: 'tests-point functions' stamp: 'AugustinPetre 10/30/2013 23:02'!
testInsideTriangleWithWith
	self assert:   ( (2 @ 3) insideTriangle:  (1 @ 1 ) with: (1 @ 7) with: (3 @ 3)).
	self deny:    ( (3 @ 1) insideTriangle:  (1 @ 1 ) with: (1 @ 7) with: (3 @ 3)).
	self deny:    ( (3 @ 15) insideTriangle:  (1 @ 1 ) with: (1 @ 7) with: (3 @ 3)).
	self deny:    ( (0 @ 6) insideTriangle:  (1 @ 1 ) with: (1 @ 7) with: (3 @ 3)).
	self assert:   ( (-2 @ -3) insideTriangle:  (-1 @ -1 ) with: (-1 @ -7) with: (-3 @ -3)).
	self deny:    ( (-3 @ -1) insideTriangle:  (-1 @ -1 ) with: (-1 @ -7) with: (-3 @ -3)).
	self deny:    ( (-3 @ -15) insideTriangle:  (-1 @ -1 ) with: (-1 @ -7) with: (-3 @ -3)).
	self deny:    ( (0 @ -6) insideTriangle:  (-1 @ -1 ) with: (-1 @ -7) with: (-3 @ -3)).! !

!PointTest methodsFor: 'tests - testing' stamp: 'sd 6/5/2005 10:16'!
testIsZero

	self assert: (0@0) isZero.	
	self deny:  (0@1) isZero.
	self deny:  (1@0) isZero.
	self deny:  (1@1) isZero.! !

!PointTest methodsFor: 'tests - testing' stamp: 'jeromegarcia 10/1/2014 14:28'!
testNormalized
	| pt |
	pt:= Point x:2 y:2.
	
	self assert: pt normalized =  ((2/(8 sqrt))@(2/(8 sqrt))).! !

!PointTest methodsFor: 'tests-geometry' stamp: 'AugustinPetre 10/31/2013 01:12'!
testToIntersectsTo

	self assert: ( (1 @ 1) to: ( 1 @ 6) intersects: (1 @ 1) to: (2 @ 9) ).
	self assert: ( (1 @ 1) to: ( 1 @ 6) intersects: (1 @ 2) to: (1 @6) ).
	self assert: ( (1 @ 1) to: ( 2 @ 6) intersects: (8 @ 6) to: (1 @ 1) ).
	self assert: ( (5 @ 1) to: ( 1 @ 6) intersects: (1 @ 6) to: (9 @ 1) ).
	self deny:  ( (1 @ 1) to: ( 1 @ 6) intersects: (2 @ 1) to: (2 @ 6) ). 
	self deny:  ( (1 @ 1) to: ( 1 @ 6) intersects: (0 @7) to: (5 @ 7) ). 
	self assert: ( (1 @ 1) to: ( 1 @ 6) intersects: (0 @ 2) to: (2 @ 2) ). 
	
	self assert: ( (-1 @ -1) to: (- 1 @ -6) intersects: (-1 @ -1) to: (-2 @ -9) ).
	self assert: ( (-1 @ -1) to: (- 1 @ -6) intersects: (-1 @ -2) to: (-1 @ -6) ).
	self assert: ( (-1 @ -1) to: ( -2 @ -6) intersects: (-8 @ -6) to: (-1 @ -1) ).
	self assert: ( (-5 @ -1) to: ( -1 @ -6) intersects: (-1 @ -6) to: (-9 @ -1) ).
	self deny:  ( (-1 @ -1) to: (-1 @ -6) intersects: (-2 @ -1) to: (-2 @ -6) ). 
	self deny:  ( (-1 @ -1) to: ( -1 @ -6) intersects: (-0 @ -7) to: (-5 @ -7) ). 
	self assert: ( (-1 @ -1) to: ( -1 @ -6) intersects: (-0 @ -2) to: (-2 @ -2) ). 
	
	"point line( 1@1 to: 1@1 ) not allowed "
	self deny: ( (1 @ 1) to: ( 1 @ 1) intersects: (1@ 0) to: (1 @ 2) )."should be true if point line alowed" 
	self assert: ( (1 @ 1) to: ( 1 @ 1) intersects: (1 @ 1) to: (1 @ 9) ). 
! !

!PointTest methodsFor: 'tests-converting' stamp: 'JulesIvanic 10/29/2013 21:20'!
testAsIntegerPoint

	self assert: (1 @ 1) asIntegerPoint = (1 @ 1).
	self assert: (1.2 @ 1) asIntegerPoint = (1 @ 1).
	self assert: (1 @ 1.2) asIntegerPoint = (1 @ 1).
	self assert: (1.2 @ 1.2) asIntegerPoint = (1 @ 1).
	self assert: (1.000000000000000001 @ 1.9999999999) asIntegerPoint = (1 @ 1).
	
	self assert: (-1 @ -1) asIntegerPoint = (-1 @ -1).
	self assert: (-1.2 @ -1) asIntegerPoint = (-1 @ -1).
	self assert: (-1 @ -1.2) asIntegerPoint = (-1 @ -1).
	self assert: (-1.2 @ -1.2) asIntegerPoint = (-1 @ -1).
	self assert: (-1.000000000000000001 @ -1.9999999999) asIntegerPoint = (-1 @ -1).
	
	self deny: (1.2 @ 1) asIntegerPoint = (1.2 @ 1).
	self deny: (1 @ 1.2) asIntegerPoint = (1 @ 1.2).
	self deny: (1.2 @ 1.2) asIntegerPoint = (1.2 @ 1.2).
	
	self deny: (-1.2 @ -1) asIntegerPoint = (-1.2 @ -1).
	self deny: (-1 @ -1.2) asIntegerPoint = (-1 @ -1.2).
	self deny: (-1.2 @ -1.2) asIntegerPoint = (-1.2 @ -1.2).
	! !

!PointTest methodsFor: 'tests-converting' stamp: 'JulesIvanic 10/29/2013 21:30'!
testAsFloatPoint

	self assert: (1 @ 1) asFloatPoint = (1.0 @ 1.0).
	self assert: (1.2 @ 1) asFloatPoint = (1.2 @ 1.0).
	self assert: (1 @ 1.2) asFloatPoint = (1.0 @ 1.2).
	self assert: (1.2 @ 1.2) asFloatPoint = (1.2 @ 1.2).
	self assert: (1.000000000000000001 @ 1.9999999999) asFloatPoint = (1.000000000000000001 @ 1.9999999999).
	
	self assert: (-1 @ -1) asFloatPoint = (-1.0 @ -1.0).
	self assert: (-1.2 @ -1) asFloatPoint = (-1.2 @ -1.0).
	self assert: (-1 @ -1.2) asFloatPoint = (-1.0 @ -1.2).
	self assert: (-1.2 @ -1.2) asFloatPoint = (-1.2 @ -1.2).
	self assert: (-1.000000000000000001 @ -1.9999999999) asFloatPoint = (-1.000000000000000001 @ -1.9999999999).
	
	self deny: (1.2 @ 1) asFloatPoint = (1 @ 1).
	self deny: (1 @ 1.2) asFloatPoint = (1 @ 1).
	self deny: (1.2 @ 1.2) asFloatPoint = (1 @ 1).
	
	self deny: (-1.2 @ -1) asFloatPoint = (-1 @ -1).
	self deny: (-1 @ -1.2) asFloatPoint = (-1 @ -1).
	self deny: (-1.2 @ -1.2) asFloatPoint = (-1 @ -1).! !

!PointTest methodsFor: 'tests-arithmetic' stamp: 'JulesIVANIC 10/28/2013 20:00'!
testAbs

	self assert: (0 @ 0) abs = (0 @ 0).
	self assert: (1 @ 1) abs = (1 @ 1).
	self assert: (-1 @ -1) abs = (1 @ 1).
	self assert: (-1 @ 1) abs = (1 @ 1).
	self deny: (1 @ -1) abs = (1 @ -1).
	self deny: (-1 @ -1) abs = (-1 @ -1).
	self deny: (-1 @ 1) abs = (-1 @ 1).
	self deny: (1 @ -1) abs = (1 @ -1).! !

!PointTest methodsFor: 'tests - testing' stamp: 'StephaneDucasse 7/8/2010 00:09'!
testLeftRotated

	self assert: (10 @ 20) leftRotated = (20@ -10)! !

!PointTest methodsFor: 'tests - testing' stamp: 'jeromegarcia 10/16/2014 17:06'!
testSideOf
	| p1 p2 p3 p4 p5 p6 o|
	
	p1:= 1@1.
	p2:= -1@(-1).
	p3:= -1@0.
	p4:= 0@1.
	p5:= 1@0.
	p6:=0@(-1).
	o := 0@0.
	
	self assert: (p1 sideOf:o) = #center.
	self assert: (p1 sideOf:p2) = #center.
	
	self assert: (p1 sideOf:p3) = #left.
	self assert:(p1 sideOf:p4) = #left.
	
	self assert: (p1 sideOf:p5) = #right.
	self assert:(p1 sideOf:p6) = #right.! !

!PointTest methodsFor: 'tests-point functions' stamp: 'AugustinPetre 10/31/2013 01:48'!
testEightNeighbors

	| x y |
	x := Point new.
 	x := (1 @ 1).
	y := x eightNeighbors.
	self assert: y = { (2 @ 1) . (2 @ 2) . (1 @ 2) . (0 @ 2) . (0 @ 1) . (0 @ 0) . (1 @ 0) . (2 @ 0)}.
	x := Point new.
	x := -2 @ -6.
	y := x eightNeighbors.
	self assert: y = { (-1 @ -6) . (-1 @ -5) . (-2 @ -5) . (-3 @ -5) . (-3 @ -6) . (-3 @ -7) . (-2 @ -7) . (-1 @ -7)}.
! !

!PointerEyeElement commentStamp: 'MarcusDenker 8/5/2014 10:37'!
I am an element that wraps host and value in a PointerWrapper. 

Following back pointers stops at the wrapper, not showing the framwork related references e.g. of the tree.!
!PointerEyeElement methodsFor: 'accessing' stamp: 'MarcusDenker 9/4/2014 16:19'!
selectedObjectDo: aBlock
	aBlock value: self selectedObject wrappedObject! !

!PointerEyeElement methodsFor: 'accessing' stamp: 'MarcusDenker 8/5/2014 08:21'!
value
	^value! !

!PointerEyeElement methodsFor: 'accessing' stamp: 'MarcusDenker 8/5/2014 10:42'!
value: anObject
 	value := (EyePointerWrapper wrap: anObject)! !

!PointerEyeElement methodsFor: 'accessing' stamp: 'MarcusDenker 9/4/2014 16:12'!
accessorCode
	^ self label ! !

!PointerEyeElement methodsFor: 'accessing' stamp: 'MarcusDenker 9/4/2014 15:59'!
label
 	^ value printString
! !

!PointerEyeElement methodsFor: 'accessing' stamp: 'MarcusDenker 8/5/2014 16:05'!
longLabel
 	^ value identityHash asString, ': ', value printString
! !

!PointerEyeElement methodsFor: 'accessing' stamp: 'MarcusDenker 8/5/2014 10:41'!
host: anObject
 	host := (EyePointerWrapper wrap: anObject)
	! !

!PointerEyeElement class methodsFor: 'instance creation' stamp: 'MarcusDenker 8/5/2014 08:21'!
host: anObject value: aValue
	^(self host: anObject) value: aValue! !

!PointerFinderTest commentStamp: 'TorstenBergmann 2/4/2014 20:46'!
SUnit tests for PointerFinder!
!PointerFinderTest methodsFor: 'as yet unclassified' stamp: 'AndyKellens 6/11/2010 14:16'!
testBasic1

	| myObject myArray |
	myObject := Object new.
	myArray := {myObject . myObject}.
	self assert: (myObject pointersTo) asArray = {myArray}! !

!PointerFinderTest methodsFor: 'as yet unclassified' stamp: 'AndyKellens 6/11/2010 14:17'!
testNoPointingObject

	| myObject |
	myObject := Object new.
	self assert: (myObject pointersTo) isEmpty! !

!PointerFinderTest methodsFor: 'as yet unclassified' stamp: 'AndyKellens 6/11/2010 14:17'!
testCycle

	| myObject myArray myArray2 pointingObjects |
	myObject := Object new.
	myArray := {myObject . myObject}.
	myArray2 := {myObject . myArray}.

	pointingObjects := (myObject pointersTo) asArray.
	self assert: pointingObjects size = 2.
	self assert: (pointingObjects includesAllOf: {myArray . myArray2}).
	
	"PointerFinder loops in presence of cycles"
"	myArray at: 1 put: myArray.
	pointingObjects := (PointerFinder pointersTo: myObject) asArray.
	self assert: pointingObjects = {myArray}.
"! !

!PointerLayout commentStamp: '<historical>'!
I am the superclass for all layouts with Slots.!
!PointerLayout methodsFor: 'extending' stamp: 'ToonVerwaest 4/2/2011 17:31'!
extendWeak: newScope
	^ WeakLayout new slotScope: newScope! !

!PointerLayout methodsFor: 'accessing' stamp: 'ToonVerwaest 4/7/2011 12:10'!
resolveSlot: aName
	^ slotScope atName: aName! !

!PointerLayout methodsFor: 'diff' stamp: 'ToonVerwaest 4/1/2011 02:45'!
popSlot: aSlot from: collection
	collection withIndexDo: [ :slot :index |
		slot name == aSlot name
			ifTrue: [ ^ collection removeAt: index ]].
	^ nil! !

!PointerLayout methodsFor: 'accessing' stamp: 'ToonVerwaest 4/4/2011 13:48'!
instanceVariables
	^ slotScope visibleSlotNames! !

!PointerLayout methodsFor: 'testing' stamp: 'ToonVerwaest 4/1/2011 01:16'!
hasFields
	^ slotScope hasFields! !

!PointerLayout methodsFor: 'accessing' stamp: 'MarcusDenker 6/25/2014 13:00'!
slots
	^ slotScope slots! !

!PointerLayout methodsFor: 'api' stamp: 'MarcusDenker 3/12/2015 10:09'!
definesSlotNamed: aString 
	^self resolveSlot: aString ifFound: [ true ] ifNone: [ false ].! !

!PointerLayout methodsFor: 'accessing' stamp: 'ToonVerwaest 4/1/2011 01:13'!
slotScope
	^ slotScope! !

!PointerLayout methodsFor: 'format' stamp: 'ToonVerwaest 4/1/2011 01:33'!
instanceSpecification
	| base |
	base := self instanceSpecificationBase.
	^ self hasFields
		ifTrue: [ base + 1 ]
		ifFalse: [ base ]! !

!PointerLayout methodsFor: 'testing' stamp: 'ToonVerwaest 4/1/2011 02:25'!
hasSlots
	^ slotScope hasSlots! !

!PointerLayout methodsFor: 'extending' stamp: 'CamilloBruni 4/4/2011 15:39'!
extend: aScope
	^ self species new slotScope: aScope! !

!PointerLayout methodsFor: 'accessing' stamp: 'ToonVerwaest 4/1/2011 01:13'!
slotScope: anObject
	slotScope := anObject! !

!PointerLayout methodsFor: 'accessing' stamp: 'ToonVerwaest 4/1/2011 01:28'!
fieldSize
	^ slotScope fieldSize! !

!PointerLayout methodsFor: 'validation' stamp: 'MartinDias 7/8/2013 17:21'!
checkIntegrity
	self
		checkSanity;
		checkParentScopes;
		checkInheritedSlots! !

!PointerLayout methodsFor: 'api' stamp: 'MarcusDenker 3/12/2015 10:16'!
slotNamed: aName 
	^self resolveSlot: aName asSymbol! !

!PointerLayout methodsFor: 'reshaping' stamp: 'ToonVerwaest 4/1/2011 17:24'!
reshapeTo: aModification
	| newScope |
	newScope := slotScope rebase: aModification originalScope to: aModification newScope.
	^ aModification newLayout extendAgain: self with: newScope.! !

!PointerLayout methodsFor: 'diff' stamp: 'ToonVerwaest 4/7/2011 11:53'!
computeChangesFrom: other in: modification
	| additions changes removals copies |
	other hasSlots ifFalse: [ ^ modification additions: self allSlots asArray ].
	
	additions := self allSlots.
	removals := OrderedCollection new.
	copies := modification copies.
	changes := modification changes.
	
	other allSlots do: [ :oldSlot |
		(self popSlot: oldSlot from: additions)
			ifNil: [ removals add: oldSlot ]
			ifNotNil: [ :newSlot |
				newSlot = oldSlot
					ifTrue: [ copies at: newSlot put: oldSlot ]
					ifFalse: [ changes at: newSlot put: oldSlot ]]].
			
	modification
		additions: additions asArray;
		removals: removals asArray.! !

!PointerLayout methodsFor: 'comparing' stamp: 'MartinDias 4/12/2013 13:24'!
hash
	^ self class hash bitXor: self slotScope hash! !

!PointerLayout methodsFor: 'testing' stamp: 'CamilloBruni 10/16/2011 20:20'!
size 
	^ slotScope fieldSize! !

!PointerLayout methodsFor: 'instance initialization' stamp: 'ToonVerwaest 4/1/2011 01:54'!
initializeInstance: anInstance
	self allSlotsDo: [ :slot | slot initialize: anInstance ]! !

!PointerLayout methodsFor: 'extending' stamp: 'ToonVerwaest 4/2/2011 17:31'!
extendVariable: newScope
	^ VariableLayout new slotScope: newScope! !

!PointerLayout methodsFor: 'accessing' stamp: 'maxmattone 1/26/2015 11:41'!
resolveSlot: aName ifFound: foundBlock ifNone: noneBlock
	^ slotScope atName: aName ifFound: foundBlock ifNone: noneBlock! !

!PointerLayout methodsFor: 'comparing' stamp: 'MartinDias 4/12/2013 13:23'!
= other
	^ super = other
		ifFalse: [  false ]
		ifTrue: [ self slotScope = other slotScope ]! !

!PointerLayout methodsFor: 'reshaping' stamp: 'MarcusDenker 7/21/2014 13:14'!
replaceSlot: oldSlot with: newSlot
	"used by the SlotWrapper to insert itself"
	| oldSlotIndex |
	oldSlotIndex := self slotScope indexOf: oldSlot.
	self slotScope at: oldSlotIndex put: newSlot.	! !

!PointerLayout methodsFor: 'validation' stamp: 'MartinDias 7/8/2013 15:52'!
checkSanity
	super checkSanity.
	self 
		checkSlotNames;
		checkSlotIndices! !

!PointerLayout methodsFor: 'extending' stamp: 'MartinDias 9/5/2013 15:49'!
extend
	"Answer a default layout extending me."

	^ self extend: self slotScope extend! !

!PointerLayout methodsFor: 'validation' stamp: 'MarcusDenker 1/6/2015 14:30'!
checkSlotIndices
	| slots current |
	slots := slotScope flatten select: [:each | each size > 0]. "skip slots that have no index"
	[ slots size > 1 ] whileTrue: [
		current := slots removeFirst.
			self assert: slots first index = (current index + current size) ]! !

!PointerLayout methodsFor: 'copying' stamp: 'ToonVerwaest 4/2/2011 21:00'!
postCopy
	slotScope := slotScope copy! !

!PointerLayout methodsFor: 'accessing' stamp: 'ToonVerwaest 4/1/2011 02:23'!
allSlots
	^ slotScope flatten! !

!PointerLayout methodsFor: 'reshaping' stamp: 'ToonVerwaest 4/1/2011 03:25'!
extendAgain: aLayout with: someScope
	| result |
	result := aLayout copy.
	result slotScope: someScope.
	^ result! !

!PointerLayout methodsFor: 'validation' stamp: 'MarcusDenker 3/10/2015 12:56'!
checkInheritedSlots
	
	self host superclass 
		ifNil: [ ^ self ].
	self host layout
		ifNil: [ ^ self ].
		
	self 
		assert: (self host superclass layout size <= self host layout size)
		description: [ (self host name, ' does not inherit all slots from ', self host superclass name) ].
	
	"check that the we have the same slots at the same indices as in the superclass"
	self host superclass layout allSlots withIndexDo: [ :slot :index|
		| localSlot |
		localSlot := (self host layout allSlots at: index).
		self 
			assert: slot = localSlot
			description: [ 'Slot "', localSlot name, '" index at position ', index asString, ' conflicts with slot "', slot name, '" in ', self host superclass asString ]].! !

!PointerLayout methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 1/22/2015 13:15'!
slotsDictionary
	
	^ slotScope slotsDictionary! !

!PointerLayout methodsFor: 'accessing' stamp: 'ToonVerwaest 4/4/2011 13:30'!
allVisibleSlots
	^ slotScope allVisibleSlots! !

!PointerLayout methodsFor: 'validation' stamp: 'MartinDias 7/24/2013 14:07'!
checkSlotNames
	| slots current |
	slots := slotScope allVisibleSlots.
	[ slots isEmpty ] whileFalse: [
		current := slots removeLast.
		slots do: [ :other |
			other name = current name
				ifTrue: [ 
					DuplicatedSlotName new
						oldSlot: current;
						newSlot: other;
						host: host;
						signal ]]]! !

!PointerLayout methodsFor: 'validation' stamp: 'CamilloBruni 7/17/2013 14:29'!
checkParentScopes
	| parentScope superclassScope |
	parentScope := self slotScope parentScope.
	self host superclass ifNil: [ ^ self ].
	superclassScope := self host superclass layout slotScope.
	self 
		assert: parentScope = superclassScope
		description: 'Parent slot scope is out of sync'! !

!Polygon commentStamp: 'LaurentLaffont 3/31/2011 21:05'!
I'm a Polygon PathShape (see PathShape).!
!Polygon methodsFor: 'as yet unclassified' stamp: 'gvc 10/31/2006 10:52'!
segmentsDo: aBlock
	"Evaluate the two-argument block with each vertex and its successor."

	self vertices size < 2 ifTrue: [^self].
	super segmentsDo: aBlock.
	aBlock
		value: self vertices last
		value: self vertices first! !

!Polygon methodsFor: 'as yet unclassified' stamp: 'gvc 6/25/2007 14:43'!
containsPoint: aPoint
	"Answer whether the receiver contains the given point."

	|wind|
	(self basicContainsPoint: aPoint) ifFalse: [^false].
	wind := 0.
	self segmentsDo: [:p1 :p2 |
		p1 y <= aPoint y
			ifTrue: [p2 y = aPoint y
						ifTrue: [(aPoint directionToLineFrom: p1 to: p2) = 0
							ifTrue: [^true]]
						ifFalse: [(p2 y > aPoint y and: [(aPoint directionToLineFrom: p1 to: p2) > 0])
							ifTrue: [wind := wind + 1]]]
			ifFalse: [p2 y = aPoint y
						ifTrue: [(aPoint directionToLineFrom: p1 to: p2) = 0
								ifTrue: [^true]].
					(p2 y < aPoint y and: [(aPoint directionToLineFrom: p1 to: p2) < 0])
							ifTrue: [wind := wind - 1]]].
	^wind ~= 0! !

!PolygonMorph commentStamp: 'md 2/24/2006 20:34'!
This class implements a morph which can behave as four different objects depending on the the following two facts:
- is it OPEN or CLOSED?
- is it SEGMENTED or SMOOTHED.

1. The OPEN and SEGMENTED variant looks like polyline.

2. The OPEN and SMOOTHED variant looks like spline (kind of curve)

3. The CLOSED and SEGMENTED variant looks like polygon. This is actually what you get when you do
	PolygonMorph new openInWorld
You get a triangle. See below how to manipulate these objects...

4. The CLOSED and SMOOTHED variant looks like blob (???)

Prototypes of this morph can also be found in "Object Catalog". Several (different variants) of this object are among "Basic" morphs.

Explore the assiciated morph-menu. It enables you
- to toggle showing of "handles". They make it possible to
	- reposition already existing vertices (by moving yellow handles)
	- create new vertices (by moving green handles)
	- delete already existing vertices (by dragging and dropping one yellow handle closely
	  nearby the adjacent yellow handle
  Handles can be made visible/hidden by shift+leftclicking the morph. This way it is possible
  to quickly show handles, adjust vertices and then again hide handles.
- making closed polygon open, i.e. converting it to a curve (and vice versa)
- toggle smoothed/segmented line/outline
- set up custom dashing (for line, curves or borders of closed polygons
- set up custom arrow-heads (for lines resp. curves)

------------------------------------------------------------------------------------------
Implementation notes:

This class combines the old Polygon and Curve classes.

The 1-bit fillForm to make display and containment tests reasonably fast.  However, this functionality is in the process of being supplanted by balloon capabilities, which should eventually provide anti-aliasing as well.

wiz 7/18/2004 21:26
s have made some changes to this class to

1) correct some bugs associated with one vertex polygons.

2) prepare for some enhancements with new curves.

3) add shaping items to menu.!
!PolygonMorph methodsFor: 'dashes' stamp: 'StephaneDucasse 12/22/2013 21:38'!
borderDashOffset
	borderDashSpec size < 4 ifTrue: [^0.0].
	^ (borderDashSpec fourth) asFloat! !

!PolygonMorph methodsFor: 'drawing' stamp: 'AlainPlantec 12/19/2009 23:37'!
drawArrowOn: aCanvas at: endPoint from: priorPoint 
	"Draw a triangle oriented along the line from priorPoint to  
	endPoint. Answer the wingBase."

	| pts spec wingBase |
	pts := self arrowBoundsAt: endPoint from: priorPoint.
	wingBase := pts size = 4 
				ifTrue: [pts third]
				ifFalse: [(pts copyFrom: 2 to: 3) average].
	spec := self valueOfProperty: #arrowSpec ifAbsent: [PolygonMorph defaultArrowSpec].
	spec x sign = spec y sign 
		ifTrue: [aCanvas drawPolygon: pts fillStyle: borderColor]
		ifFalse: 
			[aCanvas 
				drawPolygon: pts
				fillStyle: Color transparent
				borderWidth: (borderWidth + 1) // 2
				borderColor: borderColor].
	^wingBase! !

!PolygonMorph methodsFor: 'drawing' stamp: 'wiz 2/23/2006 19:19'!
drawArrowsOn: aCanvas 
	"Answer (possibly modified) endpoints for border drawing"
	"ArrowForms are computed only upon demand"
	| array |

	self hasArrows
		ifFalse: [^ #() ].
	"Nothing to do"

	array := Array with: vertices first with: vertices last.

	"Prevent crashes for #raised or #inset borders"
	borderColor isColor
		ifFalse: [ ^array ].

	(arrows == #forward or: [arrows == #both])
		ifTrue: [ array at: 2 put: (self
				drawArrowOn: aCanvas
				at: vertices last
				from: self nextToLastPoint) ].

	(arrows == #back or: [arrows == #both])
		ifTrue: [ array at: 1 put: (self
				drawArrowOn: aCanvas
				at: vertices first
				from: self nextToFirstPoint) ].

	^array! !

!PolygonMorph methodsFor: 'editing' stamp: 'jannik.laval 2/5/2010 21:40'!
addHandles
	"Put moving handles at the vertices. Put adding handles at
	edge midpoints.
	Moving over adjacent vertex and dropping will delete a
	vertex. "
	| tri |
	self removeHandles.
	handles := OrderedCollection new.
	tri := Array
				with: 0 @ -4
				with: 4 @ 3
				with: -3 @ 3.
	vertices
		withIndexDo: [:vertPt :vertIndex | | handle newVert | 
			handle := EllipseMorph
						newBounds: (Rectangle center: vertPt extent: 8 @ 8)
						color: (self handleColorAt: vertIndex) .
			handle
				on: #mouseMove
				send: #dragVertex:event:fromHandle:
				to: self
				withValue: vertIndex.
			handle
				on: #mouseUp
				send: #dropVertex:event:fromHandle:
				to: self
				withValue: vertIndex.
				handle
				on: #click
				send: #clickVertex:event:fromHandle:
				to: self
				withValue: vertIndex.
			self addMorph: handle.
			handles addLast: handle.
			(closed
					or: [1 = vertices size
						"Give a small polygon a chance to grow. 
						-wiz"
					or: [vertIndex < vertices size]])
				ifTrue: [newVert := PolygonMorph
								vertices: (tri
										collect: [:p | p + (vertPt
													+ (vertices atWrap: vertIndex + 1) // 2)])
								color: Color green
								borderWidth: 1
								borderColor: Color black.
					newVert
						on: #mouseDown
						send: #newVertex:event:fromHandle:
						to: self
						withValue: vertIndex.
					self addMorph: newVert.
					handles addLast: newVert]].
	self isCurvy
		ifTrue: [self updateHandles; layoutChanged].
	self changed! !

!PolygonMorph methodsFor: 'geometry' stamp: 'nice 1/5/2010 15:59'!
closestPointTo: aPoint 
	| closestPoint minDist |
	closestPoint := minDist := nil.
	self lineSegmentsDo: 
			[:p1 :p2 | | dist curvePoint | 
			curvePoint := aPoint nearestPointOnLineFrom: p1 to: p2.
			dist := curvePoint dist: aPoint.
			(closestPoint isNil or: [dist < minDist]) 
				ifTrue: 
					[closestPoint := curvePoint.
					minDist := dist]].
	^closestPoint! !

!PolygonMorph methodsFor: 'geometry' stamp: 'nk 7/18/2003 17:06'!
lineBorderColor: aColor
	self borderColor: aColor! !

!PolygonMorph methodsFor: 'rotate scale and flex' stamp: 'AlainPlantec 5/7/2010 21:26'!
prepareForScaling
	"When scaling from a halo, I can do this without a flex shell"

	^ self
! !

!PolygonMorph methodsFor: 'drawing' stamp: 'ar 11/26/2001 23:15'!
drawClippedBorderOn: aCanvas usingEnds: anArray 
	aCanvas clipBy: self bounds during:[:cc| self drawBorderOn: cc usingEnds: anArray].! !

!PolygonMorph methodsFor: 'private' stamp: 'di 9/7/2000 16:17'!
getVertices

	smoothCurve ifFalse: [^ vertices].

	"For curves, enumerate the full set of interpolated points"
	^ Array streamContents:
		[:s | self lineSegmentsDo: [:pt1 :pt2 | s nextPut: pt1]]! !

!PolygonMorph methodsFor: 'initialization' stamp: 'MarcusDenker 6/29/2014 16:46'!
initialize
	
	super initialize.
	vertices := Array
				with: 5 @ 0
				with: 20 @ 10
				with: 0 @ 20.
	closed := true.
	smoothCurve := false.
	arrows := #none.
	self computeBounds.
	self beSmoothCurve.
	self diamondOval.! !

!PolygonMorph methodsFor: 'accessing' stamp: 'dgd 12/11/2003 13:14'!
openOrClosePhrase
	| curveName |
	curveName := (self isCurve
				ifTrue: ['curve']
				ifFalse: ['polygon']) translated.
	^ closed
		ifTrue: ['make open {1}' translated format: {curveName}]
		ifFalse: ['make closed {1}' translated format: {curveName}]! !

!PolygonMorph methodsFor: 'drawing' stamp: 'nice 1/5/2010 15:59'!
drawDashedBorderOn: aCanvas usingEnds: anArray 
	"Display my border on the canvas. NOTE: mostly copied from  
	drawBorderOn:"
	| bevel topLeftColor bottomRightColor bigClipRect lineColor segmentOffset |
	(borderColor isNil
			or: [borderColor isColor
					and: [borderColor isTransparent]])
		ifTrue: [^ self].
	lineColor := borderColor.
	bevel := false.
	"Border colors for bevelled effects depend on CW ordering of  
	vertices"
	borderColor == #raised
		ifTrue: [topLeftColor := color lighter.
			bottomRightColor := color darker.
			bevel := true].
	borderColor == #inset
		ifTrue: [topLeftColor := owner colorForInsets darker.
			bottomRightColor := owner colorForInsets lighter.
			bevel := true].
	bigClipRect := aCanvas clipRect expandBy: self borderWidth + 1 // 2.
	segmentOffset := self borderDashOffset.
	self
		lineSegmentsDo: [:p1 :p2 | | p2i p1i | 
			p1i := p1 asIntegerPoint.
			p2i := p2 asIntegerPoint.
			self hasArrows
				ifTrue: ["Shorten line ends so as not to interfere with tip  
					of arrow."
					((arrows == #back
								or: [arrows == #both])
							and: [p1 = vertices first])
						ifTrue: [p1i := anArray first asIntegerPoint].
					((arrows == #forward
								or: [arrows == #both])
							and: [p2 = vertices last])
						ifTrue: [p2i := anArray last asIntegerPoint]].
			(closed
					or: ["bigClipRect intersects: (p1i rect: p2i)  
						optimized:"
						((p1i min: p2i)
							max: bigClipRect origin)
							<= ((p1i max: p2i)
									min: bigClipRect corner)])
				ifTrue: [bevel
						ifTrue: [lineColor := (p1i quadrantOf: p2i)
											> 2
										ifTrue: [topLeftColor]
										ifFalse: [bottomRightColor]].
					segmentOffset := aCanvas
								line: p1i
								to: p2i
								width: borderWidth
								color: lineColor
								dashLength: borderDashSpec first
								secondColor: borderDashSpec third
								secondDashLength: borderDashSpec second
								startingOffset: segmentOffset]]! !

!PolygonMorph methodsFor: 'menu' stamp: 'StephaneDucasse 10/27/2014 09:34'!
addPolyArrowMenuItems: aMenu hand: aHandMorph
	aMenu addLine.
	aMenu addWithLabel: '---' enablement: [ self isOpen and: [ arrows ~~ #none ] ] action: #makeNoArrows.
	aMenu addWithLabel: '-->' enablement: [ self isOpen and: [ arrows ~~ #forward ] ] action: #makeForwardArrow.
	aMenu addWithLabel: '<--' enablement: [ self isOpen and: [ arrows ~~ #back ] ] action: #makeBackArrow.
	aMenu addWithLabel: '<->' enablement: [ self isOpen and: [ arrows ~~ #both ] ] action: #makeBothArrows.
	aMenu add: 'customize arrows' selector: #customizeArrows:.
	(self hasProperty: #arrowSpec)
		ifTrue: [ aMenu add: 'standard arrows' selector: #standardArrows ]! !

!PolygonMorph methodsFor: 'geometry' stamp: 'nk 7/18/2003 16:47'!
lineWidth

	^self borderWidth! !

!PolygonMorph methodsFor: 'geometry' stamp: 'nk 3/30/2002 12:29'!
intersectionsWith: aRectangle
	"Answer a Set of points where the given Rectangle intersects with me.
	Ignores arrowForms."

	| retval |
	retval := IdentitySet new: 4.
	(self bounds intersects: aRectangle) ifFalse: [^ retval].

	self lineSegmentsDo: [ :lp1 :lp2 | | polySeg |
		polySeg := LineSegment from: lp1 to: lp2.
		aRectangle lineSegmentsDo: [ :rp1 :rp2 | | rectSeg int |
			rectSeg := LineSegment from: rp1 to: rp2.
			int := polySeg intersectionWith: rectSeg.
			int ifNotNil: [ retval add: int ].
		].
	].

	^retval
! !

!PolygonMorph methodsFor: 'rotate scale and flex' stamp: 'AlainPlantec 5/7/2010 21:26'!
prepareForRotating
	"When rotating from a halo, I can do this without a flex shell"

	^ self
! !

!PolygonMorph methodsFor: 'smoothing' stamp: 'nice 1/5/2010 15:59'!
lineSegmentsDo: endPointsBlock 
	"Emit a sequence of segment endpoints into endPointsBlock."
	"Unlike the method this one replaces we expect the curve 
	coefficents not the dirivatives"
	"Also unlike the replaced method the smooth closed curve
	does 
	not need an extra vertex. 
	We take care of the extra endpoint here. Just like for 
	segmented curves."
	| cs x y beginPoint |
	vertices size < 1
		ifTrue: [^ self].
	"test too few vertices first"
	self isCurvy
		ifFalse: [beginPoint := nil.
			"smoothCurve 
			ifTrue: [cs := self coefficients]."
			"some things still depend on smoothCurves having 
			curveState"
			vertices
				do: [:vert | 
					beginPoint
						ifNotNil: [endPointsBlock value: beginPoint value: vert].
					beginPoint := vert].
			(closed
					or: [vertices size = 1])
				ifTrue: [endPointsBlock value: beginPoint value: vertices first].
			^ self].
	"For curves we include all the interpolated sub segments."
	"self assert: [(vertices size > 2 )].	"
	cs := self coefficients.
	beginPoint := (x := cs first first) @ (y := cs fifth first).
	(closed
		ifTrue: [1 to: cs first size]
		ifFalse: [1 to: cs first size - 1])
		do: [:i | | t n x3 y3 x1 endPoint x2 y1 y2 | 
			"taylor series coefficients"
			x1 := cs second at: i.
			y1 := cs sixth at: i.
			x2 := cs third at: i.
			y2 := cs seventh at: i.
			x3 := cs fourth at: i.
			y3 := cs eighth at: i.
			n := cs ninth at: i.
			"guess n 
			n := 5 max: (x2 abs + y2 abs * 2.0 + (cs third atWrap:
			i 
			+ 1) abs + (cs seventh atWrap: i + 1) abs / 100.0) 
			rounded."
			1
				to: n - 1
				do: [:j | 
					t := j asFloat / n asFloat.
					endPoint := x3 * t + x2 * t + x1 * t + x @ (y3 * t + y2 * t + y1 * t + y).
					endPointsBlock value: beginPoint value: endPoint.
					beginPoint := endPoint].
			endPoint := (x := cs first atWrap: i + 1) @ (y := cs fifth atWrap: i + 1).
			endPointsBlock value: beginPoint value: endPoint.
			beginPoint := endPoint]! !

!PolygonMorph methodsFor: 'geometry' stamp: 'dgd 2/22/2003 18:57'!
mergeDropThird: mv in: hv from: shared 
	"We are merging two polygons.  In this case, they have at least three identical shared vertices.  Make sure they are sequential in each, and drop the middle one from vertex lists mv, hv, and shared.  First vertices on lists are identical already."

	"know (mv first = hv first)"

	| mdrop vv |
	(shared includes: (mv at: mv size - 2)) 
		ifTrue: [(shared includes: mv last) ifTrue: [mdrop := mv last]]
		ifFalse: 
			[(shared includes: mv last) 
				ifTrue: [(shared includes: mv second) ifTrue: [mdrop := mv first]]].
	(shared includes: (mv third)) 
		ifTrue: [(shared includes: mv second) ifTrue: [mdrop := mv second]].
	mdrop ifNil: [^nil].
	mv remove: mdrop.
	hv remove: mdrop.
	shared remove: mdrop.
	[shared includes: mv first] whileFalse: 
			["rotate them"

			vv := mv removeFirst.
			mv addLast: vv].
	[mv first = hv first] whileFalse: 
			["rotate him until same shared vertex is first"

			vv := hv removeFirst.
			hv addLast: vv]! !

!PolygonMorph methodsFor: 'attachments' stamp: 'nk 2/25/2001 17:19'!
lastVertex
	^vertices last! !

!PolygonMorph methodsFor: 'shaping' stamp: 'StephaneDucasse 12/22/2013 21:09'!
rectangleOval
	"Set my vertices to an array of corner vertices.
	Order of vertices is in the tradion of warpblt quads."

	self setVertices: self bounds corners.! !

!PolygonMorph methodsFor: 'testing' stamp: 'di 9/9/2000 09:24'!
stepTime

	^ 100! !

!PolygonMorph methodsFor: 'drawing' stamp: 'IgorStasenko 7/18/2011 18:30'!
drawOn: aCanvas 
	"Display the receiver, a spline curve, approximated by straight 
	line segments."
	| array |
	vertices size < 1
		ifTrue: [self error: 'a polygon must have at least one point'].
	closed ifTrue:
		[aCanvas drawPolygon: self getVertices fillStyle: self fillStyle ].
	array := self drawArrowsOn: aCanvas.
	self drawClippedBorderOn: aCanvas usingEnds: array.
! !

!PolygonMorph methodsFor: 'cubic support' stamp: 'FernandoOlivero 9/10/2013 10:53'!
transform: coefficients toCubicPointPolynomialAt: vIndex 
	"From curve information assemble a 4-array of points representing the coefficents for curve segment between to points. Beginning point is first point in array endpoint is the pointSum of the array. Meant to be sent to newcurves idea of curve coefficents." 
	| transformed |
	transformed := (1 to: 4) collect: [:i | 
			((coefficients at: i) at: vIndex) @ ((coefficients at: 4 + i) at: vIndex)].
	^ Cubic withAll: transformed! !

!PolygonMorph methodsFor: 'private' stamp: 'marcus.denker 11/10/2008 10:04'!
privateMoveBy: delta
	super privateMoveBy: delta.
	vertices := vertices collect: [:p | p + delta].
	self arrowForms do: [:f | f offset: f offset + delta].
	curveState := nil.  "Force recomputation"
	(self valueOfProperty: #referencePosition) ifNotNil:
		[:oldPos | self setProperty: #referencePosition toValue: oldPos + delta]! !

!PolygonMorph methodsFor: 'drawing' stamp: 'di 6/24/1998 14:36'!
areasRemainingToFill: aRectangle
	"Could be improved by quick check of inner rectangle"

	^ Array with: aRectangle! !

!PolygonMorph methodsFor: 'dashes' stamp: 'nk 2/27/2001 12:11'!
dashedBorder
	^borderDashSpec
	"A dash spec is a 3- or 5-element array with
		{ length of normal border color.
		length of alternate border color.
		alternate border color.
		starting offset.
		amount to add to offset at each step }
	Starting offset is usually = 0, but changing it moves the dashes along the curve."
! !

!PolygonMorph methodsFor: 'menu' stamp: 'AlainPlantec 12/19/2009 23:37'!
arrowSpec: specPt
	"Specify a custom arrow for this line.
	specPt x abs gives the length of the arrow (point to base) in terms of borderWidth.
	If specPt x is negative, then the base of the arrow will be concave.
	specPt y abs gives the width of the arrow.
	The standard arrow is equivalent to arrowSpec: PolygonMorph defaultArrowSpec.
	See arrowBoundsAt:From: for details."

	self setProperty: #arrowSpec toValue: specPt.
	self computeBounds! !

!PolygonMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 12/22/2013 21:33'!
step
	borderDashSpec ifNil: [^super step].
	borderDashSpec size < 5 ifTrue: [^super step].

	"Only for dashed lines with creep"
	borderDashSpec at: 4 put: (borderDashSpec fourth) + borderDashSpec fifth.
	self changed.
	^ super step! !

!PolygonMorph methodsFor: 'geometry' stamp: 'nice 1/5/2010 15:59'!
closestSegmentTo: aPoint
	"Answer the starting index of my (big) segment nearest to aPoint"
	| closestPoint minDist vertexIndex closestVertexIndex |
	vertexIndex := 0.
	closestVertexIndex := 0.
	closestPoint := minDist := nil.
	self lineSegmentsDo:
		[:p1 :p2 | | curvePoint dist | 
		(p1 = (self vertices at: vertexIndex + 1))
			ifTrue: [ vertexIndex := vertexIndex + 1 ].
		curvePoint := aPoint nearestPointOnLineFrom: p1 to: p2.
		dist := curvePoint dist: aPoint.
		(closestPoint isNil or: [dist < minDist])
			ifTrue: [closestPoint := curvePoint.
					minDist := dist.
					closestVertexIndex := vertexIndex. ]].
	^ closestVertexIndex! !

!PolygonMorph methodsFor: 'smoothing' stamp: 'GuillermoPolito 9/1/2010 18:41'!
computeNextToEndPoints
	| pointAfterFirst pointBeforeLast |
	pointAfterFirst := nil.
	self lineSegmentsDo: 
			[:p1 :p2 | 
			pointAfterFirst ifNil: [pointAfterFirst := p2 asIntegerPoint].
			pointBeforeLast := p1 asIntegerPoint].
	curveState at: 2 put: pointAfterFirst.
	curveState at: 3 put: pointBeforeLast! !

!PolygonMorph methodsFor: 'geometry' stamp: 'StephaneDucasse 12/22/2013 21:58'!
rotationCenter
	"Return the rotation center of the receiver. The rotation center defines the relative offset inside the receiver's bounds for locating the reference position."
	| refPos |
	refPos := self valueOfProperty: #referencePosition ifAbsent: [^ 0.5@0.5].
	^ (refPos - self bounds origin) / self bounds extent asFloatPoint! !

!PolygonMorph methodsFor: 'private' stamp: 'di 11/21/97 21:29'!
lineSegments
	| lineSegments |
	lineSegments := OrderedCollection new.
	self lineSegmentsDo: [:p1 :p2 | lineSegments addLast: (Array with: p1 with: p2)].
	^ lineSegments! !

!PolygonMorph methodsFor: 'menu' stamp: '6/9/97 21:32 di'!
makeNoArrows
	arrows := #none.
	self computeBounds! !

!PolygonMorph methodsFor: 'menu' stamp: '6/9/97 21:32 di'!
makeForwardArrow
	arrows := #forward.
	self computeBounds! !

!PolygonMorph methodsFor: 'menu' stamp: 'di 10/3/2000 07:12'!
standardArrows

	self removeProperty: #arrowSpec.
	self computeBounds! !

!PolygonMorph methodsFor: 'geometry' stamp: 'nk 7/18/2003 17:48'!
lineWidth: anInteger

	self borderWidth: (anInteger rounded max: 1)! !

!PolygonMorph methodsFor: 'smoothing' stamp: 'MarcusDenker 6/29/2014 16:47'!
slopes: knots 
	"Choose slopes according to state of polygon"
	self isCurvy ifFalse: [^ self segmentedSlopesOf: knots ].
	^ closed
		ifTrue: [ self closedCubicSlopesOf: knots ]
		ifFalse: [ self naturalCubicSlopesOf: knots ]! !

!PolygonMorph methodsFor: 'geometry' stamp: 'StephaneDucasse 12/22/2013 21:42'!
arrowsContainPoint: aPoint
	"Answer an Array of two Booleans that indicate whether the given point is inside either arrow"

	| retval f |
	retval := { false . false }.
	(super containsPoint: aPoint) ifFalse: [^ retval ].
	(closed or: [arrows == #none or: [vertices size < 2]]) ifTrue: [^ retval].

	(arrows == #forward or: [arrows == #both]) ifTrue: [	"arrowForms first has end form"
		f := self arrowForms first.
		retval at: 2 put: ((f pixelValueAt: aPoint - f offset) > 0)
	].
	(arrows == #back or: [arrows == #both]) ifTrue: [ "arrowForms last has start form"
		f := self arrowForms last.
		retval at: 1 put: ((f pixelValueAt: aPoint - f offset) > 0)
	].
	^retval.! !

!PolygonMorph methodsFor: 'initialization' stamp: 'di 9/8/2000 09:45'!
beStraightSegments

	smoothCurve == false ifFalse:
		[smoothCurve := false.
		self computeBounds]! !

!PolygonMorph methodsFor: 't-rotating' stamp: ''!
forwardDirection: newDirection
	"Set the receiver's forward direction (in eToy terms)"
	self setProperty: #forwardDirection toValue: newDirection.! !

!PolygonMorph methodsFor: 'menu' stamp: 'StephaneDucasse 5/28/2011 13:45'!
unrotatedLength
	"If the receiver bears rotation without a transformation morph, answer what its length in the direction it is headed is"

	vertices size = 2 ifTrue:
		[^ (vertices second - vertices first) r].

	^ ((PolygonMorph new setVertices: vertices) rotationDegrees: self rotationDegrees negated) height! !

!PolygonMorph methodsFor: 'geometry' stamp: 'StephaneDucasse 12/22/2013 21:58'!
rotationCenter: aPointOrNil
	"Set the new rotation center of the receiver. The rotation center defines the relative offset inside the receiver's bounds for locating the reference position."
	| box |
	aPointOrNil isNil
		ifTrue: [self removeProperty: #referencePosition]
		ifFalse: [box := self bounds.
				self setProperty: #referencePosition toValue: box origin + (aPointOrNil * box extent)]
! !

!PolygonMorph methodsFor: 'geometry' stamp: 'nk 4/27/2003 15:39'!
nextDuplicateVertexIndex
	vertices
		doWithIndex: [:vert :index | ((index between: 2 and: vertices size - 1)
					and: [| epsilon v1 v2 | 
						v1 := vertices at: index - 1.
						v2 := vertices at: index + 1.
						epsilon := ((v1 x - v2 x) abs max: (v1 y - v2 y) abs)
									// 32 max: 1.
						vert
							onLineFrom: v1
							to: v2
							within: epsilon])
				ifTrue: [^ index]].
	^ 0! !

!PolygonMorph methodsFor: 'attachments' stamp: 'nk 4/18/2001 11:43'!
endShapeColor: aColor
	self borderColor: aColor.
	self isClosed ifTrue: [ self color: aColor ].! !

!PolygonMorph methodsFor: 'geometry' stamp: 'nk 7/18/2003 16:48'!
lineColor
	^self borderColor! !

!PolygonMorph methodsFor: 'menu' stamp: 'dgd 8/30/2003 21:57'!
handlesShowingPhrase
	^ (self showingHandles
		ifTrue: ['hide handles']
		ifFalse: ['show handles']) translated! !

!PolygonMorph methodsFor: 'testing' stamp: 'StephaneDucasse 12/19/2011 18:45'!
isAnimated

	borderDashSpec ifNil: [^false].
	^ borderDashSpec size = 5 and: [(borderDashSpec fifth) > 0]! !

!PolygonMorph methodsFor: 'drawing' stamp: 'nice 1/5/2010 15:59'!
drawBorderOn: aCanvas usingEnds: anArray 
	"Display my border on the canvas."
	"NOTE: Much of this code is also copied in  
	drawDashedBorderOn:  
	(should be factored)"
	| bigClipRect style |
	borderDashSpec
		ifNotNil: [^ self drawDashedBorderOn: aCanvas usingEnds: anArray].
	style := self borderStyle.
	bigClipRect := aCanvas clipRect expandBy: self borderWidth + 1 // 2.
	self
		lineSegmentsDo: [:p1 :p2 | | p1i p2i | 
			p1i := p1 asIntegerPoint.
			p2i := p2 asIntegerPoint.
			self hasArrows
				ifTrue: ["Shorten line ends so as not to interfere with tip  
					of arrow."
					((arrows == #back
								or: [arrows == #both])
							and: [p1 = vertices first])
						ifTrue: [p1i := anArray first asIntegerPoint].
					((arrows == #forward
								or: [arrows == #both])
							and: [p2 = vertices last])
						ifTrue: [p2i := anArray last asIntegerPoint]].
			(closed
					or: ["bigClipRect intersects: (p1i rect: p2i)  
						optimized:"
						((p1i min: p2i)
							max: bigClipRect origin)
							<= ((p1i max: p2i)
									min: bigClipRect corner)])
				ifTrue: [style
						drawLineFrom: p1i
						to: p2i
						on: aCanvas]]! !

!PolygonMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 12/22/2013 21:35'!
borderWidth: anInteger

	borderColor ifNil: [ borderColor := Color black ].
	borderWidth := anInteger max: 0.
	self computeBounds! !

!PolygonMorph methodsFor: 'geometry' stamp: 'CamilloBruni 8/1/2012 16:28'!
reduceVertices
	"Reduces the vertices size, when 3 vertices are on the same line with a little epsilon."
	| dup |
	[ (dup := self nextDuplicateVertexIndex) > 0 ] whileTrue: [
		self setVertices: (vertices copyWithoutIndex: dup)
	].
	^vertices size.! !

!PolygonMorph methodsFor: 'accessing' stamp: 'sw 9/14/97 18:22'!
vertices
	^ vertices! !

!PolygonMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 12/22/2013 21:36'!
midVertices
	"Return and array of midpoints for this line or closed curve"
	| midPts nextVertIx tweens |
	vertices size < 2
		ifTrue: [^ vertices].
	midPts := OrderedCollection new.
	nextVertIx := 2.
	tweens := OrderedCollection new.
	tweens add: vertices first asIntegerPoint.
	"guarantee at least two points."
	self
		lineSegmentsDo: [:p1 :p2 | 
			tweens addLast: p2 asIntegerPoint.
			p2 = (vertices atWrap: nextVertIx)
				ifTrue: ["Found endPoint."
					midPts addLast: (tweens atWrap: tweens size + 1 // 2)
							+ (tweens at: tweens size // 2 + 1) // 2.
					tweens := OrderedCollection new.
					tweens add: p2 asIntegerPoint.
					"guarantee at least two points."
					nextVertIx := nextVertIx + 1]].
	^ midPts asArray! !

!PolygonMorph methodsFor: 'cubic support' stamp: 'MarcusDenker 9/13/2013 15:57'!
naturalCubicSlopesOf: knots 
	"Sent to knots returns the slopes of a natural cubic curve fit."
	"We solve the equation for knots with end conditions:  
	2*b1+b2 = 3(a1 - a0) 
	bN1+2*bN = 3*(aN-aN1)
	and inbetween:
	b2+4*b3+b4=3*(a4-a2)
	where a2 is (knots atWrap: index + 1) etc.
	and the b's are the slopes .
	N is the last index (knots size)
	N1 is N-1.
	 
	by using row operations to convert the matrix to upper  
	triangular and then back sustitution. The D[i] are the derivatives at the  
	knots."
	
	| x gamma delta D n1 |
	n1 := knots size.
	n1 < 3
		ifTrue: [self error: 'Less than 3 points makes a poor curve'].
	x := knots.
	gamma := Array new: n1.
	delta := Array new: n1.
	
	D := Array new: n1.
	gamma at: 1 put: 1.0 / 2.0.
	2 to: n1 - 1 do: [:i | gamma at: i put: 1.0 / (4.0
						- (gamma at: i - 1))].
	gamma at: n1 put: 1.0 / (2.0
				- (gamma at: n1 - 1)).
	delta at: 1 put: 3.0 * ((x at: 2)
				- (x at: 1))
			* (gamma at: 1).
	2 to: n1 - 1 do: [:i | delta at: i put: 3.0 * ((x at: i + 1)
						- (x at: i - 1))
					- (delta at: i - 1)
					* (gamma at: i)].
	delta at: n1 put: 3.0 * ((x at: n1)
				- (x at: n1 - 1))
			- (delta at: n1 - 1)
			* (gamma at: n1).
	D
		at: n1
		put: (delta at: n1).
	(1 to: n1 - 1)
		reverseDo: [:i | D at: i put: (delta at: i)
					- ((gamma at: i)
							* (D at: i + 1))].
	^ D! !

!PolygonMorph methodsFor: 'shaping' stamp: 'StephaneDucasse 12/22/2013 22:00'!
diamondOval
	"Set my vertices to an array of edge midpoint vertices. Order of vertices is in the tradion of warpblt quads."
	
	| b |
	b := self bounds.
	self setVertices: { b leftCenter. b bottomCenter. b rightCenter. b topCenter }! !

!PolygonMorph methodsFor: 'cubic support' stamp: 'StephaneDucasse 12/22/2013 21:37'!
closedCubicSlopesOf: knots 
	"Sent to knots returns the slopes of a closed cubic spline.
	From the same set of java sources as naturalCubic. This is a smalltalk  
	transliteration of the java code."
	"from java code NatCubicClosed extends NatCubic  
	solves for the set of equations for all knots: 
	b1+4*b2+b3=3*(a3-a1)
	where a1 is (knots atWrap: index + 1) etc.
	and the b's are the slopes .
	by decomposing the matrix into upper triangular and lower matrices  
	and then back sustitution. See Spath 'Spline Algorithms for Curves  
	and Surfaces' pp 19--21. The D[i] are the derivatives at the knots.  
	"
	
	| v w x y z n1  D F G H |
	n1 := knots size.
	n1 < 3
		ifTrue: [self error: 'Less than 3 points makes a poor curve'].
	v := Array new: n1.
	w := Array new: n1.
	y := Array new: n1.
	
	D := Array new: n1.
	x := knots.
	z := 1.0 / 4.0.
	v at: 2 put: z.
	w at: 2 put: z.
	y at: 1 put: z * 3.0 * ((x at: 2) - (x at: n1)).
	H := 4.0.
	F := 3 * ((x at: 1) - (x at: n1 - 1)).
	G := 1.
	2 to: n1 - 1 do: [:k | 
			z := 1.0 / (4.0 - (v at: k)).
			v at: k + 1 put: z.
			w at: k + 1 put: z negated
					* (w at: k).
			y at: k put: z * (3.0 * ((x at: k + 1) - (x at: k - 1)) - (y at: k - 1)).
			H := H - (G * (w at: k)).
			F := F - (G * (y at: k - 1)).
			G := (v at: k) negated * G].
	H := H - (G + 1 * ((v at: n1) + (w at: n1))).
	y at: n1 put: F - (G + 1 * (y at: n1 - 1)).
	D at: n1 put: (y at: n1) / H.
	D at: n1 - 1 put: (y at: n1 - 1) - ((v at: n1) + (w at: n1) * (D at: n1)).
	(1 to: n1 - 2)
		reverseDo: [:k | D at: k put: (y at: k)
					- ((v at: k + 1) * (D at: k + 1)) - ((w at: k + 1) * (D at: n1))].
	^ D 

! !

!PolygonMorph methodsFor: 'smoothing' stamp: 'StephaneDucasse 12/22/2013 22:00'!
coefficients
	curveState ifNotNil: [^ curveState at: 1].
	^ self vertices size < 1 
		ifTrue: [ self  ]
		ifFalse: [ self coefficientsForMoreThanThreePoints ].  ! !

!PolygonMorph methodsFor: 'editing' stamp: 'StephaneDucasse 6/28/2013 11:25'!
dragVertex: ix event: evt fromHandle: handle
	| p |
	p := evt cursorPoint.
	handle position: p - (handle extent // 2).
	self verticesAt: ix put: p! !

!PolygonMorph methodsFor: 'menu' stamp: 'di 9/24/2000 09:25'!
setRotationCenterFrom: aPoint
	"Polygons store their referencePosition."
	self setProperty: #referencePosition toValue: aPoint! !

!PolygonMorph methodsFor: 'menu' stamp: 'StephaneDucasse 10/27/2014 09:34'!
addCustomMenuItems: aMenu hand: aHandMorph 
	| |
	super addCustomMenuItems: aMenu hand: aHandMorph.
	aMenu
		addUpdating: #handlesShowingPhrase
		target: self
		selector: #showOrHideHandles.
	vertices size > 2
		ifTrue: [ self addPolyLIneCurveMenuItems: aMenu hand: aHandMorph ].
	aMenu add: 'specify dashed line' selector: #specifyDashedLine.
	self isOpen
		ifTrue: [self addPolyArrowMenuItems: aMenu hand: aHandMorph]
			ifFalse: [self addPolyShapingMenuItems: aMenu hand: aHandMorph]! !

!PolygonMorph methodsFor: 'accessing' stamp: 'MarcusDenker 4/13/2012 08:49'!
cornerStyle: aSymbol
	"Set the receiver's corner style.  But, in this case, do *not*"

	(extension isNil or: [self cornerStyle == aSymbol]) ifTrue: [^self].
	extension cornerStyle: nil.
	self changed! !

!PolygonMorph methodsFor: 't-rotating' stamp: ''!
heading
	"Return the receiver's heading"
	^ self owner 
		ifNil: [self forwardDirection]
		ifNotNil: [self forwardDirection + self owner degreesOfFlex]! !

!PolygonMorph methodsFor: 'drawing' stamp: 'nk 10/4/2000 12:23'!
drawDashedBorderOn: aCanvas 
	self
		drawDashedBorderOn: aCanvas
		usingEnds: (Array with: vertices first with: vertices last)! !

!PolygonMorph methodsFor: 'private' stamp: 'wiz 2/12/2006 02:58'!
curveBounds
	"Compute the bounds from actual curve traversal, with 
	leeway for borderWidth. 
	Also note the next-to-first and next-to-last points for arrow 
	directions."
	"wiz - to avoid roundoff errors we return unrounded curvebounds."
	"we expect our receiver to take responsibility for approriate rounding adjustment."
	"hint: this is most likely 'self curveBounds expanded' "
	| pointAfterFirst pointBeforeLast  oX oY cX cY |
	self isCurvy
		ifFalse: [^ (Rectangle encompassing: vertices)
				expandBy: borderWidth * 0.5 ].
	curveState := nil.
	"Force recomputation"
	"curveBounds := vertices first corner: vertices last."
	pointAfterFirst := nil.
	self
		lineSegmentsDo: [:p1 :p2 | 
			pointAfterFirst isNil
				ifTrue: [pointAfterFirst := p2 floor .
					oX := cX := p1 x.
					oY := cY := p1 y. ].
			"curveBounds := curveBounds encompass: p2 ."
			oX:= oX min: p2 x.
			cX := cX max: p2 x.
			oY := oY min: p2 y.
			cY := cY max: p2 y.
			pointBeforeLast := p1 floor ].
	curveState at: 2 put: pointAfterFirst.
	curveState at: 3 put: pointBeforeLast.
	^ ( oX @ oY corner: cX @ cY )  expandBy: borderWidth * 0.5 ! !

!PolygonMorph methodsFor: 'menu' stamp: 'CamilloBruni 8/1/2012 16:15'!
removeHandles
	handles ifNotNil: [
		handles do: [:h | h delete].
		handles := nil].! !

!PolygonMorph methodsFor: 'menu' stamp: 'sw 8/19/2000 15:17'!
showingHandles
	^ handles notNil! !

!PolygonMorph methodsFor: 'private' stamp: 'IgorStasenko 7/18/2011 18:45'!
borderForm
	"A form must be created for drawing the border whenever the borderColor is translucent."

	| borderCanvas |
	borderForm ifNotNil: [^ borderForm].
	borderCanvas := (Display defaultCanvasClass extent: bounds extent depth: 1)
		asShadowDrawingCanvas: Color black.
	borderCanvas translateBy: bounds topLeft negated
		during:[:tempCanvas| self drawBorderOn: tempCanvas].
	borderForm := borderCanvas form.
	self arrowForms do:
		[:f |  "Eliminate overlap between line and arrowheads if transparent."
		borderForm copy: f boundingBox from: f to: f offset - self position rule: Form erase].
	^ borderForm! !

!PolygonMorph methodsFor: 'private' stamp: 'StephaneDucasse 10/25/2013 16:18'!
computeArrowFormAt: endPoint from: priorPoint 
	"Compute a triangle oriented along the line from priorPoint to  
	endPoint. Then draw those lines in a form and return that  
	form, with appropriate offset"

	| p1 pts box arrowForm bb origin |
	pts := self arrowBoundsAt: endPoint from: priorPoint.
	box := ((pts first rectangle: pts last) encompass: (pts second)) expandBy: 1.
	arrowForm := Form extent: box extent asIntegerPoint.
	bb := (BitBlt toForm: arrowForm)
				sourceForm: nil;
				fillColor: Color black;
				combinationRule: Form over;
				width: 1;
				height: 1.
	origin := box topLeft.
	p1 := pts last - origin.
	pts do: 
			[:p | 
			bb drawFrom: p1 to: p - origin.
			p1 := p - origin].
	arrowForm convexShapeFill: Color black.
	^arrowForm offset: box topLeft! !

!PolygonMorph methodsFor: 'event handling' stamp: 'nk 8/8/2001 12:13'!
mouseDown: evt

	^ evt shiftPressed
		ifTrue: [((owner isKindOf: PolygonMorph) and: [owner includesHandle: self])
					ifTrue: ["Prevent insertion handles from getting edited"
							^ super mouseDown: evt].
				self toggleHandles.
				handles ifNil: [^ self].
				vertices withIndexDo:  "Check for click-to-drag at handle site"
					[:vertPt :vertIndex |
					((handles at: vertIndex*2-1 ifAbsent: [ ^self ]) containsPoint: evt cursorPoint) ifTrue:
						["If clicked near a vertex, jump into drag-vertex action"
						evt hand newMouseFocus: (handles at: vertIndex*2-1)]]]
		ifFalse: [super mouseDown: evt]! !

!PolygonMorph methodsFor: 'cubic support' stamp: 'FernandoOlivero 9/10/2013 10:45'!
segmentedSlopesOf: knots 
	"For a collection of floats. Returns the slopes for straight 
	segments between vertices."
	"last slope closes the polygon. Always return same size as 
	self. "
	^ knots collectWithIndex: [:x :i | (knots atWrap: i + 1) - x]! !

!PolygonMorph methodsFor: 'menu' stamp: 'marcus.denker 11/10/2008 10:04'!
customizeArrows: evt
	| handle origin aHand |
	aHand := evt ifNil: [self primaryHand] ifNotNil: [evt hand].
	origin := aHand position.
	handle := HandleMorph new
		forEachPointDo:
			[:newPoint | handle removeAllMorphs.
			handle addMorph:
				(LineMorph from: origin to: newPoint color: Color black width: 1).
			self arrowSpec: (newPoint - origin) / 5.0]
		lastPointDo:
			[:newPoint | handle deleteBalloon.
			self halo ifNotNil: [:halo | halo addHandles].].
	aHand attachMorph: handle.
	handle setProperty: #helpAtCenter toValue: true.
	handle showBalloon:
'Move cursor left and right
to change arrow length and style.
Move it up and down to change width.
Click when done.' hand: evt hand.
	handle startStepping! !

!PolygonMorph methodsFor: 'menu' stamp: 'nk 2/26/2001 20:11'!
arrows
	^arrows! !

!PolygonMorph methodsFor: 'private' stamp: 'di 8/31/2000 13:46'!
includesHandle: aMorph

	handles ifNil: [^ false].
	^ handles includes: aMorph! !

!PolygonMorph methodsFor: 'menu' stamp: 'StephaneDucasse 5/28/2011 13:45'!
unrotatedLength: aLength
	"If the receiver bears rotation without a transformation morph, answer what its length in the direction it is headed is"

	vertices size = 2 ifTrue: [^ self arrowLength: aLength].

	self setVertices: ((((PolygonMorph new setVertices: vertices) rotationDegrees: self rotationDegrees negated) height: aLength) rotationDegrees: 0) vertices! !

!PolygonMorph methodsFor: 'geometry' stamp: 'ar 10/6/2000 15:40'!
transformedBy: aTransform
	self setVertices: (self vertices collect:[:v| aTransform localPointToGlobal: v])! !

!PolygonMorph methodsFor: 'initialization' stamp: 'dgd 2/14/2003 22:30'!
defaultColor
	"answer the default color/fill style for the receiver"
	^ Color orange! !

!PolygonMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 12/22/2013 21:36'!
toggleOpenOrClosed
	"toggle the open/closed status of the receiver"
	closed ifTrue: [ self makeOpen ] ifFalse: [ self makeClosed ]! !

!PolygonMorph methodsFor: 'cubic support' stamp: 'StephaneDucasse 12/22/2013 21:37'!
changeInSlopes: slopes of: verts 
	"A message to knots of a spline. Returns an array with the 3rd cubic coeff."
	"The last nth item is correct iff this is a closed cubic.
	Presumably that is the only time we care.
	We always return the same sized array as self."
	| n slopeChanges |
	n := verts size.
	n = slopes size ifFalse: [^ self error: 'vertices and slopes differ in number'].
	slopeChanges := Array new: n.
	1 to: n do: [:i | slopeChanges at: i put: (verts atWrap: i + 1)
					- (verts at: i) * 3 - ((slopes at: i) * 2)
					- (slopes atWrap: i + 1)].
	^ slopeChanges! !

!PolygonMorph methodsFor: 'geometry' stamp: 'nk 7/18/2003 17:38'!
isBordered
	^false! !

!PolygonMorph methodsFor: 'editing' stamp: 'StephaneDucasse 12/22/2013 21:40'!
handleColorAt: vertIndex
      "This is a backstop for MixedCurveMorph"

	^ Color yellow
! !

!PolygonMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 12/22/2013 21:35'!
fillStyle

	^ self isOpen
		ifTrue: [ self borderColor  "easy access to line color from halo"]
		ifFalse: [ super fillStyle ]! !

!PolygonMorph methodsFor: 'event handling' stamp: 'di 8/20/2000 14:29'!
handlesMouseDown: evt

	^ (super handlesMouseDown: evt) or: [evt shiftPressed]! !

!PolygonMorph methodsFor: 't-rotating' stamp: ''!
forwardDirection
	"Return the receiver's forward direction (in eToy terms)"
	^self valueOfProperty: #forwardDirection ifAbsent:[0.0]! !

!PolygonMorph methodsFor: 'private' stamp: 'nk 3/27/2001 21:23'!
transformVerticesFrom: oldOwner to: newOwner
	| oldTransform newTransform world newVertices |
	world := self world.
	oldTransform := oldOwner
		ifNil: [ IdentityTransform new ]
		ifNotNil: [ oldOwner transformFrom: world ].
	newTransform := newOwner
		ifNil: [ IdentityTransform new ]
		ifNotNil: [ newOwner transformFrom: world ].
	newVertices := vertices collect: [ :ea | newTransform globalPointToLocal:
		(oldTransform localPointToGlobal: ea) ].
	self setVertices: newVertices.
! !

!PolygonMorph methodsFor: 'private' stamp: 'di 9/8/2000 10:36'!
setVertices: newVertices
	vertices := newVertices.
	handles ifNotNil: [self removeHandles; addHandles].
	self computeBounds! !

!PolygonMorph methodsFor: 'menu' stamp: 'sw 9/24/2002 19:23'!
arrowLength: aLength
	"Assumes that I have exactly two vertices"

	| theta horizontalOffset verticalOffset newTip delta |
	delta := vertices second - vertices first.
	theta := delta theta.
	horizontalOffset := aLength * (theta cos).
	verticalOffset := aLength * (theta sin).
	newTip := vertices first + (horizontalOffset @ verticalOffset).
	self verticesAt: 2 put: newTip! !

!PolygonMorph methodsFor: 'attachments' stamp: 'StephaneDucasse 12/22/2013 21:30'!
nudgeForLabel: aRectangle
	"Try to move the label off me. Prefer labels on the top and right."

	| i flags nudge |
	(self bounds intersects: aRectangle) ifFalse: [ ^ 0 @ 0 ].
	flags := 0.
	nudge := 0 @ 0.
	i := 1.
	aRectangle lineSegmentsDo: [ :rp1 :rp2 | | rectSeg |
		rectSeg := LineSegment from: rp1 to: rp2.
		self straightLineSegmentsDo: [ :lp1 :lp2 | 
			| polySeg int |
			polySeg := LineSegment from: lp1 to: lp2.
			int := polySeg intersectionWith: rectSeg.
			int ifNotNil: [ flags := flags bitOr: i ].
		].
		i := i * 2.
	].
	"Now flags has bitflags for which sides"
	nudge := flags caseOf: {
	"no intersection"
		[ 0 ] -> [ 0 @ 0 ].
		"2 adjacent sides only" 
		[ 9 ] -> [ 1 @ 1 ].
		[ 3 ] -> [ -1 @ 1 ].
		[ 12 ] -> [ 1 @ -1 ].
		[ 6 ] -> [ -1 @ -1 ].
		"2 opposite sides only" 
		[ 10 ] -> [ 0 @ -1 ].
		[ 5 ] -> [ 1 @ 0 ].
		"only 1 side" 
		[ 8 ] -> [ -1 @ 0 ].
		[ 1 ] -> [ 0 @ -1 ].
		[ 2 ] -> [ 1 @ 0 ].
		[ 4 ] -> [ 0 @ 1 ].
		"3 sides" 
		[ 11 ] -> [ 0 @ 1 ].
		[ 13 ] -> [ 1 @ 0 ].
		[ 14 ] -> [ 0 @ -1 ].
		[ 7 ] -> [ -1 @ 0 ].
 		"all sides" 
		[ 15 ] -> [ 1 @ -1 "move up and to the right" ].
	}.
	^nudge! !

!PolygonMorph methodsFor: 'geometry' stamp: 'AlainPlantec 5/8/2010 00:03'!
rotationDegrees: degrees 
	| flex center |
	(center := self valueOfProperty: #referencePosition) ifNil:
		[self setProperty: #referencePosition toValue: (center := self bounds center)].
	flex := (MorphicTransform offset: center negated)
			withAngle: (degrees - self forwardDirection) degreesToRadians.
	self setVertices: (vertices collect: [:v | (flex transform: v) - flex offset]).
	self forwardDirection: degrees.

! !

!PolygonMorph methodsFor: 'geometry' stamp: 'nk 7/18/2003 16:48'!
lineColor: aColor
	self borderColor: aColor! !

!PolygonMorph methodsFor: 'menu' stamp: 'StephaneDucasse 10/27/2014 08:13'!
addPolyShapingMenuItems: aMenu hand: aHandMorph
	aMenu addLine.
	aMenu addWithLabel: 'make inscribed diamondOval' enablement: [ self isClosed ] action: #diamondOval.
	aMenu addWithLabel: 'make enclosing rectangleOval' enablement: [ self isClosed ] action: #rectangleOval! !

!PolygonMorph methodsFor: 'smoothing' stamp: 'nk 4/23/2002 15:48'!
straightLineSegmentsDo: endPointsBlock
	"Emit a sequence of segment endpoints into endPointsBlock.
	Work the same way regardless of whether I'm curved."
	| beginPoint |
	beginPoint := nil.
		vertices do:
			[:vert | beginPoint ifNotNil:
				[endPointsBlock value: beginPoint
								value: vert].
			beginPoint := vert].
		(closed or: [vertices size = 1])
			ifTrue: [endPointsBlock value: beginPoint
									value: vertices first].! !

!PolygonMorph methodsFor: 'geometry' stamp: 'StephaneDucasse 12/22/2013 21:43'!
flipVAroundY: centerY
	"Flip me vertically around the center.  If centerY is nil, compute my center of gravity."

	| cent |
	cent := centerY 
		ifNil: [ bounds center y ]		"average is the center"
		ifNotNil: [ centerY ].
	self setVertices: (vertices collect: [:vv |
			vv x @ ((vv y - cent) * -1 + cent)]) reversed.! !

!PolygonMorph methodsFor: 'initialization' stamp: 'StephaneDucasse 12/22/2013 21:10'!
vertices: verts color: aColor borderWidth: borderWidthInteger borderColor: anotherColor 
	super initialize.
	vertices := verts.
	color := aColor.
	borderWidth := borderWidthInteger.
	borderColor := anotherColor.
	closed := vertices size > 2.
	arrows := #none.
	self computeBounds! !

!PolygonMorph methodsFor: 'smoothing' stamp: 'MarcusDenker 6/29/2014 16:47'!
coefficientsForMoreThanThreePoints 
	"Less than three points handled as segments by our lineSegmentsDo:"
	| verts coefficients vertXs slopeXs vertYs slopeYs bestSegments |
	verts := self vertices. 
	coefficients := {
		vertXs := verts collect: [:p | p x asFloat].
		slopeXs := self slopes: vertXs. 
		self changeInSlopes: slopeXs of: vertXs .
		self changeOfChangesInSlopes: slopeXs of: vertXs. 
		vertYs := verts collect: [:p | p y asFloat].
		slopeYs := self slopes: vertYs.
		self changeInSlopes: slopeYs of: vertYs.
		self changeOfChangesInSlopes: slopeYs of: vertYs. 
		Array new: verts size withAll: 12}.
		
		
	bestSegments := (1 to: verts size) collect: [:i | (self transform: coefficients toCubicPointPolynomialAt: i) bestSegments].
	coefficients at: 9 put:bestSegments.
	
	curveState := {coefficients. nil. nil}.
	self computeNextToEndPoints.
	^ coefficients! !

!PolygonMorph methodsFor: 'testing' stamp: 'di 9/7/2000 16:18'!
isCurve
	^ smoothCurve! !

!PolygonMorph methodsFor: 'editing' stamp: 'StephaneDucasse 12/22/2013 21:40'!
dropVertex: ix event: evt fromHandle: handle
	"Leave vertex in new position. If dropped ontop another vertex delete this one. Check for too few vertices before deleting. The alternative is not pretty"
	
	| p |
	p := vertices at: ix.
	(vertices size >= 2
			and: ["check for too few vertices before deleting. The alternative 
				is not pretty -wiz"
				((vertices atWrap: ix - 1)
						dist: p)
						< 3
					or: [((vertices atWrap: ix + 1)
							dist: p)
							< 3]])
		ifTrue: ["Drag a vertex onto its neighbor means delete"
				self deleteVertexAt: ix .].
	evt shiftPressed
		ifTrue: [self removeHandles]
		ifFalse: [self addHandles
			"remove then add to recreate"]! !

!PolygonMorph methodsFor: 'menu' stamp: '6/9/97 21:32 di'!
makeBothArrows
	arrows := #both.
	self computeBounds! !

!PolygonMorph methodsFor: 'menu' stamp: 'di 9/7/2000 15:43'!
toggleSmoothing

	smoothCurve := smoothCurve not.
	handles ifNotNil: [self removeHandles; addHandles].
	self computeBounds! !

!PolygonMorph methodsFor: 'private' stamp: 'wiz 6/22/2004 15:54'!
arrowForms
	"ArrowForms are computed only upon demand"
	arrowForms
		ifNotNil: [^ arrowForms].
	arrowForms := Array new.
	self hasArrows
		ifFalse: [^ arrowForms].
	(arrows == #forward
			or: [arrows == #both])
		ifTrue: [arrowForms := arrowForms
						copyWith: (self computeArrowFormAt: vertices last from: self nextToLastPoint)].
	(arrows == #back
			or: [arrows == #both])
		ifTrue: [arrowForms := arrowForms
						copyWith: (self computeArrowFormAt: vertices first from: self nextToFirstPoint)].
	^ arrowForms! !

!PolygonMorph methodsFor: 'menu' stamp: 'di 8/20/2000 14:31'!
toggleHandles

	handles ifNil: [self addHandles] ifNotNil: [self removeHandles].

! !

!PolygonMorph methodsFor: 'menu' stamp: 'NicolaiHess 9/8/2014 22:04'!
addPolyLIneCurveMenuItems: aMenu hand: aHandMorph 

	aMenu addLine;
				addUpdating: #openOrClosePhrase
				target: self
				selector: #toggleOpenOrClosed.
			
			aMenu
				addUpdating: #smoothOrSegmentedPhrase
				target: self
				selector: #toggleSmoothing.! !

!PolygonMorph methodsFor: 'attachments' stamp: 'nk 2/25/2001 17:19'!
firstVertex
	^vertices first! !

!PolygonMorph methodsFor: 'geometry' stamp: 'StephaneDucasse 12/22/2013 21:42'!
flipHAroundX: centerX
	"Flip me horizontally around the center.  If centerX is nil, compute my center of gravity."

	| cent |
	cent := centerX 
		ifNil: [ bounds center x ] "average is the center"
		ifNotNil: [ centerX ].
	self setVertices: (vertices collect: [ :vv | ((vv x - cent) * -1 + cent) @ vv y ]) reversed.! !

!PolygonMorph methodsFor: 'menu' stamp: 'sw 9/24/2002 18:18'!
unrotatedWidth: aWidth
	"If the receiver bears rotation without a transformation morph, answer what its length in the direction it is headed is"

	self borderWidth: aWidth! !

!PolygonMorph methodsFor: 'menu' stamp: 'di 8/20/2000 14:27'!
makeClosed
	closed := true.
	handles ifNotNil: [self removeHandles; addHandles].
	self computeBounds! !

!PolygonMorph methodsFor: 'testing' stamp: 'StephaneDucasse 12/22/2013 22:01'!
hasArrows
	"Are all the conditions meet for having arrows?"
	^ (closed or: [arrows == #none or: [vertices size < 2]]) not! !

!PolygonMorph methodsFor: 'menu' stamp: 'sw 8/19/2000 15:16'!
showOrHideHandles
	self showingHandles
		ifTrue:	[self removeHandles]
		ifFalse:	[self addHandles]! !

!PolygonMorph methodsFor: 'geometry' stamp: 'nk 7/18/2003 17:07'!
lineBorderWidth

	^self borderWidth! !

!PolygonMorph methodsFor: 'smoothing' stamp: 'wiz 11/16/2004 19:54'!
nextToFirstPoint
	"For arrow direction"
	self isCurvy
		ifTrue: [curveState
				ifNil: [self coefficients].
			^ curveState second]
		ifFalse: [^ vertices second]! !

!PolygonMorph methodsFor: 'menu' stamp: '6/9/97 21:32 di'!
makeBackArrow
	arrows := #back.
	self computeBounds! !

!PolygonMorph methodsFor: 'dashes' stamp: 'nk 2/25/2001 17:05'!
vertexAt: n
	^vertices at: (n min: vertices size).! !

!PolygonMorph methodsFor: 'testing' stamp: 'sw 8/25/2000 22:37'!
isClosed
	^ closed! !

!PolygonMorph methodsFor: 'editing' stamp: 'StephaneDucasse 12/22/2013 21:40'!
deleteVertexAt: anIndex
	"This acts as a backstop for MixedCurveMorph."
	self setVertices: (vertices
						copyReplaceFrom: anIndex
						to: anIndex
						with: #()).
						! !

!PolygonMorph methodsFor: 'private' stamp: 'wiz 2/12/2006 00:04'!
computeBounds
	| oldBounds delta excludeHandles |
	vertices ifNil: [^ self].

	self changed.
	oldBounds := bounds.
	self releaseCachedState.
	bounds := self curveBounds expanded.
	self arrowForms do:
		[:f | bounds := bounds merge: (f offset extent: f extent)].
	handles ifNotNil: [self updateHandles].

	"since we are directly updating bounds, see if any ordinary submorphs exist and move them accordingly"
	(oldBounds notNil and: [(delta := bounds origin - oldBounds origin) ~= (0@0)]) ifTrue: [
		excludeHandles := IdentitySet new.
		handles ifNotNil: [excludeHandles addAll: handles].
		self submorphsDo: [ :each |
			(excludeHandles includes: each) ifFalse: [
				each position: each position + delta
			].
		].
	].
	self layoutChanged.
	self changed.
! !

!PolygonMorph methodsFor: 'editing' stamp: 'nice 1/5/2010 15:59'!
updateHandles
	| newVert |
	self isCurvy
		ifTrue: [handles first center: vertices first.
			handles last center: vertices last.
			self midVertices
				withIndexDo: [:midPt :vertIndex | (closed
							or: [vertIndex < vertices size])
						ifTrue: [newVert := handles atWrap: vertIndex * 2.
							newVert position: midPt - (newVert extent // 2)]]]
		ifFalse: [vertices
				withIndexDo: [:vertPt :vertIndex | | oldVert | 
					oldVert := handles at: vertIndex * 2 - 1.
					oldVert position: vertPt - (oldVert extent // 2).
					(closed
							or: [vertIndex < vertices size])
						ifTrue: [newVert := handles at: vertIndex * 2.
							newVert position: vertPt
									+ (vertices atWrap: vertIndex + 1) - newVert extent // 2 + (1 @ -1)]]]! !

!PolygonMorph methodsFor: 'attachments' stamp: 'StephaneDucasse 12/22/2013 21:31'!
defaultAttachmentPointSpecs
	^{ 
		{ #firstVertex } .
		{ #midpoint } .
		{ #lastVertex }
		}! !

!PolygonMorph methodsFor: 'editing' stamp: 'StephaneDucasse 12/22/2013 21:40'!
insertVertexAt: anIndex put: aValue
	"This serves as a hook and a backstop for MixedCurveMorph."
	self setVertices: (vertices copyReplaceFrom: anIndex + 1 to: anIndex with: (Array with: aValue)).! !

!PolygonMorph methodsFor: 'geometry' stamp: 'nk 7/18/2003 17:06'!
lineBorderColor
	^self borderColor! !

!PolygonMorph methodsFor: 'cubic support' stamp: 'FernandoOlivero 9/10/2013 10:58'!
changeOfChangesInSlopes: slopes of: verts
	"A message to knots of a spline. Returns an array with the 4rd 
	cubic coeff."
	"The last nth item is correct iff this is a closed cubic. 
	Presumably that is the only time we care. 
	We always return the same sized array as self."
	| n changes |
	n := verts size.
	n = slopes size ifFalse: [^ self error: 'vertices and slopes differ in number'].
	changes := Array new: n.
	1 to: n do: [:i | changes at: i put: (verts at: i)
					- (verts atWrap: i + 1) * 2
					+ (slopes at: i)
					+ (slopes atWrap: i + 1)].
	^ changes! !

!PolygonMorph methodsFor: 'testing' stamp: 'jm 11/19/97 18:55'!
isOpen
	^ closed not! !

!PolygonMorph methodsFor: 'editing' stamp: 'wiz 2/7/2006 23:35'!
clickVertex: ix event: evt fromHandle: handle
	"Backstop for MixedCurveMorph"! !

!PolygonMorph methodsFor: 'geometry' stamp: 'nice 2/16/2008 02:30'!
bounds: newBounds
	"This method has to be reimplemented since self extent: will also change self bounds origin,
	super bounds would leave me in wrong position when container is growing.
	Always change extent first then position"
	
	self extent: newBounds extent; position: newBounds topLeft
! !

!PolygonMorph methodsFor: 'testing' stamp: 'wiz 5/2/2004 22:03'!
isCurvy
	"Test for significant curves.  
	Small smoothcurves in practice are straight."
	^ smoothCurve
		and: [vertices size > 2]! !

!PolygonMorph methodsFor: 'attachments' stamp: 'StephaneDucasse 3/20/2010 11:42'!
midpoint
	"Answer the midpoint along my segments"
	| middle |
	middle := self totalLength.
	middle < 2 ifTrue: [ ^ self center ].
	middle := middle / 2.
	self lineSegmentsDo: [ :a :b | | dist |
		dist := (a dist: b).
		middle < dist
			ifTrue: [ ^(a + ((b - a) * (middle / dist))) asIntegerPoint ].
		middle := middle - dist.
	].
	self error: 'can''t happen'! !

!PolygonMorph methodsFor: 'drawing' stamp: 'ar 11/26/2001 23:15'!
drawBorderOn: aCanvas 
	self
		drawClippedBorderOn: aCanvas
		usingEnds: (Array with: vertices first with: vertices last)! !

!PolygonMorph methodsFor: 'smoothing' stamp: 'dgd 2/22/2003 14:16'!
derivs: a first: point1 second: point2 third: point3 
	"Compute the first, second and third derivitives (in coeffs) from
	the Points in this Path (coeffs at: 1 and coeffs at: 5)."

	| len v anArray |
	len := a size.
	len < 2 ifTrue: [^self].
	len > 2 
		ifTrue: 
			[v := Array new: len.
			v at: 1 put: 4.0.
			anArray := Array new: len.
			anArray at: 1 put: 6.0 * (a first - (a second * 2.0) + (a third)).
			2 to: len - 2
				do: 
					[:i | 
					v at: i put: 4.0 - (1.0 / (v at: i - 1)).
					anArray at: i
						put: 6.0 * ((a at: i) - ((a at: i + 1) * 2.0) + (a at: i + 2)) 
								- ((anArray at: i - 1) / (v at: i - 1))].
			point2 at: len - 1 put: (anArray at: len - 2) / (v at: len - 2).
			len - 2 to: 2
				by: 0 - 1
				do: 
					[:i | 
					point2 at: i
						put: ((anArray at: i - 1) - (point2 at: i + 1)) / (v at: i - 1)]].
	point2 at: 1 put: (point2 at: len put: 0.0).
	1 to: len - 1
		do: 
			[:i | 
			point1 at: i
				put: (a at: i + 1) - (a at: i) 
						- (((point2 at: i) * 2.0 + (point2 at: i + 1)) / 6.0).
			point3 at: i put: (point2 at: i + 1) - (point2 at: i)]! !

!PolygonMorph methodsFor: 'caching' stamp: 'StephaneDucasse 12/22/2013 21:32'!
releaseCachedState

	super releaseCachedState.
	filledForm := nil.
	arrowForms := nil.
	borderForm := nil.
	curveState := nil.
	(self hasProperty: #flex) ifTrue:
		[self removeProperty: #flex].
! !

!PolygonMorph methodsFor: 'geometry' stamp: 'nk 3/6/2001 16:36'!
straighten
	self setVertices: { vertices first . vertices last }! !

!PolygonMorph methodsFor: 'geometry' stamp: 'nk 7/18/2003 17:46'!
lineBorderWidth: anInteger

	self borderWidth: anInteger! !

!PolygonMorph methodsFor: 'attachments' stamp: 'StephaneDucasse 12/22/2013 21:29'!
totalLength
	"Answer the full length of my segments. Can take a long time if I'm curved."
	| length |
	length := 0.
	self lineSegmentsDo: [ :a :b | length := length + (a dist: b) ].
	^ length.! !

!PolygonMorph methodsFor: 'editing' stamp: 'di 9/8/2000 10:39'!
verticesAt: ix put: newPoint
	vertices at: ix put: newPoint.
	self computeBounds! !

!PolygonMorph methodsFor: 'geometry' stamp: 'nk 4/27/2003 16:15'!
intersects: aRectangle 
	"Answer whether any of my segments intersects aRectangle, which is in World coordinates."
	| rect |
	(super intersects: aRectangle) ifFalse: [ ^false ].
	rect := self bounds: aRectangle in: self world.
	self
		lineSegmentsDo: [:p1 :p2 | (rect intersectsLineFrom: p1 to: p2)
				ifTrue: [^ true]].
	^ false! !

!PolygonMorph methodsFor: 'menu' stamp: 'StephaneDucasse 5/28/2011 13:45'!
unrotatedWidth
	"If the receiver bears rotation without a transformation morph, answer what its length in the direction it is headed is"
	
	vertices size = 2 ifTrue: [^ self borderWidth].
	^ ((PolygonMorph new setVertices: vertices) rotationDegrees: self rotationDegrees negated) width! !

!PolygonMorph methodsFor: 'smoothing' stamp: 'wiz 11/16/2004 19:51'!
nextToLastPoint
	"For arrow direction"
	self isCurvy
		ifTrue: [curveState
				ifNil: [self coefficients].
			^ curveState third]
		ifFalse: [^ vertices at: vertices size - 1]! !

!PolygonMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 12/22/2013 21:33'!
smoothOrSegmentedPhrase
	| lineName |
	lineName := (closed
					ifTrue: ['outline']
					ifFalse: ['line']) translated.
	^ self isCurve
		ifTrue: [ 'make segmented {1}' translated format: {lineName} ]
		ifFalse: [ 'make smooth {1}' translated format: {lineName} ].! !

!PolygonMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 12/22/2013 21:35'!
fillStyle: newColor

	^ self isOpen
		ifTrue: [ self borderColor: newColor asColor "easy access to line color from halo"]
		ifFalse: [ super fillStyle: newColor ]! !

!PolygonMorph methodsFor: 't-rotating' stamp: ''!
setDirectionFrom: aPoint
	| delta degrees |
	delta := (self transformFromWorld globalPointToLocal: aPoint) - self referencePosition.
	degrees := delta degrees + 90.0.
	self forwardDirection: (degrees \\ 360) rounded.
! !

!PolygonMorph methodsFor: 'testing' stamp: 'nk 10/13/2003 18:36'!
isLineMorph
	^closed not! !

!PolygonMorph methodsFor: 'private' stamp: 'StephaneDucasse 10/25/2013 16:18'!
filledForm
	"Note: The filled form is actually 2 pixels bigger than bounds, and the point corresponding to this morphs' position is at 1@1 in the form.  This is due to the details of the fillig routines, at least one of which requires an extra 1-pixel margin around the outside.  Computation of the filled form is done only on demand."
	| bb origin |
	closed ifFalse: [^ filledForm := nil].
	filledForm ifNotNil: [^ filledForm].
	filledForm := Form extent: bounds extent+2.

	"Draw the border..."
	bb := (BitBlt toForm: filledForm) sourceForm: nil; fillColor: Color black;
			combinationRule: Form over; width: 1; height: 1.
	origin := bounds topLeft asIntegerPoint-1.
	self lineSegmentsDo: [:p1 :p2 | bb drawFrom: p1 asIntegerPoint-origin
										to: p2 asIntegerPoint-origin].

	"Fill it in..."
	filledForm convexShapeFill: Color black.

	(borderColor isColor and: [borderColor isTranslucentButNotTransparent]) ifTrue:
		["If border is stored as a form, then erase any overlap now."
		filledForm copy: self borderForm boundingBox from: self borderForm
			to: 1@1 rule: Form erase].

	^ filledForm! !

!PolygonMorph methodsFor: 'private' stamp: 'AlainPlantec 12/19/2009 23:36'!
arrowBoundsAt: endPoint from: priorPoint 
	"Answer a triangle oriented along the line from priorPoint to endPoint."
	| d v angle wingBase arrowSpec length width |
	v := endPoint - priorPoint.
	angle := v degrees.
	d := borderWidth max: 1.
	arrowSpec := self valueOfProperty: #arrowSpec ifAbsent: [PolygonMorph defaultArrowSpec].
	length := arrowSpec x abs.  width := arrowSpec y abs.
	wingBase := endPoint + (Point r: d * length degrees: angle + 180.0).
	arrowSpec x >= 0
		ifTrue: [^ {	endPoint.
					wingBase + (Point r: d * width degrees: angle + 125.0).
					wingBase + (Point r: d * width degrees: angle - 125.0) }]
		ifFalse: ["Negative length means concave base."
				^ {	endPoint.
					wingBase + (Point r: d * width degrees: angle + 125.0).
					wingBase.
					wingBase + (Point r: d * width degrees: angle - 125.0) }]! !

!PolygonMorph methodsFor: 'testing' stamp: 'ClementBera 9/30/2013 11:03'!
containsPoint: aPoint
	(super containsPoint: aPoint) ifFalse: [^ false].

	(closed and: [color isTransparent not]) ifTrue:
		[ ^ (self filledForm pixelValueAt: aPoint - bounds topLeft + 1) > 0].

	self lineSegmentsDo:
		[ :p1 :p2 |
		(aPoint onLineFrom: p1 to: p2 within: (3 max: borderWidth+1//2) asFloat)
				ifTrue: [^ true]].

	self arrowForms do:
		[ :f | (f pixelValueAt: aPoint - f offset) > 0 ifTrue: [^ true]].

	^ false! !

!PolygonMorph methodsFor: 'menu' stamp: 'ClementBera 9/30/2013 11:04'!
specifyDashedLine

	| executableSpec newSpec |
	executableSpec := UIManager default
		request:
'Enter a dash specification as
{ major dash length. minor dash length. minor dash color }
The major dash will have the normal border color.
A blank response will remove the dash specification.
[Note: You may give 5 items as, eg, {10. 5. Color white. 0. 3}
where the 4th ityem is zero, and the 5th is the number of pixels
by which the dashes will move in each step of animation]' translated
		initialAnswer: '{ 10. 5. Color red }'.
	executableSpec isEmptyOrNil ifTrue:
		[^ self stopStepping; dashedBorder: nil].
	newSpec := [self class compiler evaluate: executableSpec] ifError:
		[^ self stopStepping; dashedBorder: nil].
	(newSpec first isNumber and: [newSpec second isNumber and: [newSpec third isColor]]) ifFalse:
		[^ self stopStepping; dashedBorder: nil].
	newSpec size = 3 ifTrue:
		[^ self stopStepping; dashedBorder: newSpec].
	(newSpec size = 5 and: [newSpec fourth isNumber and: [newSpec fifth isNumber]]) ifTrue:
		[^ self dashedBorder: newSpec; startStepping].
! !

!PolygonMorph methodsFor: 'dashes' stamp: 'di 9/9/2000 09:20'!
dashedBorder: dashSpec
	"A dash spec is a 3- or 5-element array with
		{ length of normal border color.
		length of alternate border color.
		alternate border color.
		starting offset.
		amount to add to offset at each step }
	Starting offset is usually = 0, but changing it moves the dashes along the curve."

	borderDashSpec := dashSpec.
	self changed! !

!PolygonMorph methodsFor: 'geometry' stamp: 'di 9/24/2000 08:44'!
extent: newExtent 
	"Not really advisable, but we can preserve most of the geometry if we don't
	shrink things too small."
	| safeExtent center |
	center := self referencePosition.
	safeExtent := newExtent max: 20@20.
	self setVertices: (vertices collect:
		[:p | p - center * (safeExtent asFloatPoint / (bounds extent max: 1@1)) + center])! !

!PolygonMorph methodsFor: 'drawing' stamp: 'StephaneDucasse 12/22/2013 21:39'!
drawOnFormCanvas: aCanvas 
	"Display the receiver, a spline curve, approximated by straight line segments."

	vertices size < 1 ifTrue: [self error: 'a polygon must have at least one point'].
	closed & color isTransparent not
		ifTrue: [aCanvas stencil: self filledForm at: bounds topLeft - 1 color: color].
	(borderColor isColor and: [borderColor isTranslucentButNotTransparent])
		ifTrue: [aCanvas stencil: self borderForm at: bounds topLeft color: borderColor]
		ifFalse: [self drawBorderOn: aCanvas].
	self arrowForms do:
		[:f | aCanvas 
				stencil: f 
				at: f offset
				color: (borderColor isColor ifTrue: [borderColor] ifFalse: [color])]! !

!PolygonMorph methodsFor: 'attachments' stamp: 'AlainPlantec 5/7/2010 23:35'!
endShapeWidth: aWidth
	| originalWidth originalVertices transform |
	originalWidth := self valueOfProperty: #originalWidth ifAbsentPut: [ self borderWidth isZero ifFalse: [ self borderWidth ] ifTrue: [ 2 ] ].
	self borderWidth: aWidth.
	originalVertices := self valueOfProperty: #originalVertices ifAbsentPut: [
		self vertices collect: [ :ea | (ea - (self referencePosition)) rotateBy: self heading degreesToRadians about: 0@0 ]
	].
	transform := MorphicTransform offset: 0@0 angle: self heading degreesToRadians scale: originalWidth / aWidth.
	self setVertices: (originalVertices collect: [ :ea |
		((transform transform: ea) + self referencePosition) asIntegerPoint
	]).
	self computeBounds.! !

!PolygonMorph methodsFor: 'initialization' stamp: 'di 9/8/2000 09:44'!
beSmoothCurve

	smoothCurve == true ifFalse:
		[smoothCurve := true.
		self computeBounds]! !

!PolygonMorph methodsFor: 'accessing' stamp: 'sw 11/24/1999 14:57'!
couldHaveRoundedCorners
	^ false! !

!PolygonMorph methodsFor: 'drawing' stamp: 'MarcusDenker 9/13/2013 16:25'!
drawDropShadowOn: aCanvas 
	"Display the receiver, a spline curve, approximated by straight 
	line segments."
	self assert: [vertices notEmpty] description: 'a polygon must have at least one point'.
	closed 
		ifTrue: [aCanvas drawPolygon: self getVertices fillStyle: self shadowColor].! !

!PolygonMorph methodsFor: 'editing' stamp: 'wiz 2/8/2006 18:25'!
newVertex: ix event: evt fromHandle: handle
	"Insert a new vertex and fix everything up!! Install the drag-handle of the new vertex as recipient of further mouse events."

	| pt |
	"(self hasProperty: #noNewVertices) ifFalse:
		[pt := evt cursorPoint.
		self setVertices: (vertices copyReplaceFrom: ix + 1 to: ix with: (Array with: pt)).
		evt hand newMouseFocus: (handles at: ((ix + 1) * 2) - 1)]"
	"modified to remove now vestigial test. see PolygonMorph class>>arrowprototype"
	pt := evt cursorPoint.
	self  insertVertexAt: ix put:  pt .
	evt hand newMouseFocus: (handles at: ((ix + 1) * 2) - 1)! !

!PolygonMorph methodsFor: 'initialization' stamp: 'dgd 2/14/2003 22:35'!
defaultBorderColor
	"answer the default border color/fill style for the receiver"
	^ Color
		r: 0.0
		g: 0.419
		b: 0.935! !

!PolygonMorph methodsFor: 'testing' stamp: 'StephaneDucasse 12/19/2011 18:46'!
wantsSteps
	super wantsSteps ifTrue: [^true].

	"For crawling ants effect of dashed line."
	^ self isAnimated! !

!PolygonMorph methodsFor: 'geometry' stamp: 'dgd 2/22/2003 18:56'!
merge: aPolygon 
	"Expand myself to enclose the other polygon.  (Later merge overlapping or disjoint in a smart way.)  For now, the two polygons must share at least two vertices.  Shared vertices must come one after the other in each polygon.  Polygons must not overlap."

	| shared mv vv hv xx |
	shared := vertices select: [:mine | aPolygon vertices includes: mine].
	shared size < 2 ifTrue: [^nil].	"not sharing a segment"
	mv := vertices asOrderedCollection.
	[shared includes: mv first] whileFalse: 
			["rotate them"

			vv := mv removeFirst.
			mv addLast: vv].
	hv := aPolygon vertices asOrderedCollection.
	[mv first = hv first] whileFalse: 
			["rotate him until same shared vertex is first"

			vv := hv removeFirst.
			hv addLast: vv].
	[shared size > 2] whileTrue: 
			[shared := shared asOrderedCollection.
			(self 
				mergeDropThird: mv
				in: hv
				from: shared) ifNil: [^nil]].
	"works by side effect on the lists"
	(mv second) = hv last 
		ifTrue: 
			[mv
				removeFirst;
				removeFirst.
			^self setVertices: (hv , mv) asArray].
	(hv second) = mv last 
		ifTrue: 
			[hv
				removeFirst;
				removeFirst.
			^self setVertices: (mv , hv) asArray].
	(mv second) = (hv second) 
		ifTrue: 
			[hv removeFirst.
			mv remove: (mv second).
			xx := mv removeFirst.
			^self setVertices: (hv , (Array with: xx) , mv reversed) asArray].
	mv last = hv last 
		ifTrue: 
			[mv removeLast.
			hv removeFirst.
			^self setVertices: (mv , hv reversed) asArray].
	^nil! !

!PolygonMorph methodsFor: 'geometry' stamp: 'di 9/24/2000 08:38'!
referencePosition 
	"Return the current reference position of the receiver"
	^ self valueOfProperty: #referencePosition ifAbsent: [super referencePosition]
! !

!PolygonMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 12/22/2013 21:36'!
borderColor: aColor 

	super borderColor: aColor.
	(borderColor isColor and: [borderColor isTranslucentButNotTransparent]) 
		== (aColor isColor and: [aColor isTranslucentButNotTransparent]) 
			ifFalse: 
				["Need to recompute fillForm and borderForm
					if translucency of border changes."

				self releaseCachedState ]! !

!PolygonMorph methodsFor: 'dashes' stamp: 'nk 4/5/2001 16:02'!
removeVertex: aVert
	"Make sure that I am not left with less than two vertices"
	| newVertices |
	vertices size < 2 ifTrue: [ ^self ].
	newVertices := vertices copyWithout: aVert.
	newVertices size caseOf: {
		[1] -> [ newVertices := { newVertices first . newVertices first } ].
		[0] -> [ newVertices := { aVert . aVert } ]
	} otherwise: [].
	self setVertices: newVertices 
! !

!PolygonMorph methodsFor: 'geometry' stamp: 'StephaneDucasse 12/22/2013 21:10'!
scale: scaleFactor 
	| flex center ratio |
	ratio := self scaleFactor / scaleFactor.
	self borderWidth: ((self borderWidth / ratio) rounded max: 0).
	center := self referencePosition.
	flex := (MorphicTransform offset: center negated) withScale: ratio.
	self setVertices: (vertices collect: [:v | (flex transform: v) - flex offset]).
	super scale: scaleFactor.! !

!PolygonMorph methodsFor: 'menu' stamp: 'di 8/20/2000 14:27'!
makeOpen
	closed := false.
	handles ifNotNil: [self removeHandles; addHandles].
	self computeBounds! !

!PolygonMorph methodsFor: 'rotate scale and flex' stamp: 'AlainPlantec 5/7/2010 23:53'!
rotationDegrees

	^ self forwardDirection! !

!PolygonMorph class methodsFor: 'instance creation' stamp: 'AlainPlantec 5/5/2010 09:16'!
vertices: verts color: c borderWidth: bw borderColor: bc
	"(PolygonMorph
		vertices: {261@400. 388@519. 302@595. 	222@500.	141@583. 34@444}
		color: Color blue
		borderWidth: 3
		borderColor: Color black) openInWorld"
	^ self basicNew beStraightSegments vertices: verts color: c borderWidth: bw borderColor: bc! !

!PolygonMorph class methodsFor: 'examples' stamp: 'StephaneDucasse 12/22/2013 21:01'!
example1
	"self example1"
	^ (PolygonMorph
		vertices: {261@400. 388@519. 302@595. 	222@500.	141@583. 34@444}
		color: Color blue
		borderWidth: 3
		borderColor: Color black) openInWorld! !

!PolygonMorph class methodsFor: 'instance creation' stamp: 'MarcusDenker 9/13/2013 16:26'!
fromHandFreehand: hand
	"Let the user draw a polygon, holding the mouse down, and ending by clicking within 5 of the first point..."
	"self fromHandFreehand: ActiveHand"
	
	| p1 poly pN opposite |
	"wait till guy will press the mouse button"
	hand captureEventsUntil: [:evt |
		evt isMouse ifTrue: [ p1 := evt cursorPoint].
		(evt isMouse and: [ evt anyButtonPressed ])  ].
	
	opposite := (Display colorAt: p1) negated.
	opposite = Color transparent ifTrue: [opposite := Color red].
	(poly := LineMorph from: p1 to: p1 color: opposite width: 2) openInWorld.
	
	hand captureEventsWhile: [:evt |
		
		evt isMouse ifTrue:[ 
			pN := evt cursorPoint.
			(pN dist: poly vertices last) > 3 ifTrue:
				[poly setVertices: (poly vertices copyWith: pN) ].
			
			evt anyButtonPressed 
			]
		ifFalse: [ true ]
	].
	^ (poly setVertices: (poly vertices copyWith: p1)) delete
! !

!PolygonMorph class methodsFor: 'instance creation' stamp: 'StephaneDucasse 12/22/2013 21:12'!
arrowPrototype
	"Answer an instance of the receiver that will serve as a prototypical arrow"
	"PolygonMorph arrowPrototype openInWorld"
	
	| aa |
	aa := self new. 
	aa vertices: (Array with: 0@0 with: 40@40) 
		color: Color black 
		borderWidth: 2 
		borderColor: Color black.
	aa makeForwardArrow.	
	aa computeBounds.
	^ aa! !

!PolygonMorph class methodsFor: 'examples' stamp: 'StephaneDucasse 12/22/2013 21:07'!
example2
	"self example2"
	| poly | 
	poly := PolygonMorph
		vertices: {261@400. 388@519. 302@595. 	222@500.	141@583. 34@444}
		color: Color blue
		borderWidth: 3
		borderColor: Color black.
	poly beSmoothCurve.
	poly openInWorld! !

!PolygonMorph class methodsFor: 'examples' stamp: 'StephaneDucasse 12/22/2013 21:06'!
example4
	"self example4"
	| poly | 
	poly :=  (PolygonMorph
		vertices: {261@400. 388@519. 302@595. 	222@500.	141@583. 34@444}
		color: Color blue
		borderWidth: 3
		borderColor: Color black).
	poly dashedBorder: { 5 .
		5.
		Color red.
		50 .
		0 }.
	poly openInWorld! !

!PolygonMorph class methodsFor: 'settings' stamp: 'AlainPlantec 12/19/2009 23:38'!
defaultArrowSpec
	^ 5@4! !

!PolygonMorph class methodsFor: 'instance creation' stamp: 'MarcusDenker 9/13/2013 16:26'!
fromHand: hand
	"Let the user draw a polygon, clicking at each vertex, and ending by clicking within 5 of the first point..."
	"self fromHand: ActiveHand"
	
	| p1 poly oldVerts pN opposite |
	"wait till guy will press the mouse button"
	hand captureEventsUntil: [:evt |
		evt isMouse ifTrue: [ p1 := evt cursorPoint].
		(evt isMouse and: [ evt anyButtonPressed ]) not ].
	
	opposite := (Display colorAt: p1) negated.
	opposite = Color transparent ifTrue: [opposite := Color red].
	(poly := LineMorph from: p1 to: p1 color: opposite width: 2) openInWorld.
	oldVerts := {p1}.
	
	[true] whileTrue: [
		"wait till button release"
		hand captureEventsWhile: [:evt |
			evt isMouse 
				ifTrue: [ 
					pN := evt cursorPoint.
					poly setVertices: (oldVerts copyWith: pN).
					evt anyButtonPressed ] 
				ifFalse: [ true ] ].

		(oldVerts size > 1 and: [(pN dist: p1) < 5]) 
			ifFalse: [
				oldVerts := poly vertices.
				"loop till button will be pressed"
				hand captureEventsUntil: [:evt | 		
					evt isMouse 
						ifTrue: [ 
							pN := evt cursorPoint.
							poly setVertices: (oldVerts copyWith: pN).
							evt anyButtonPressed ] 
					ifFalse: [ false ]]]
			ifTrue: [ ^ (poly setVertices: (poly vertices copyWith: p1)) delete].
	]! !

!PolygonMorph class methodsFor: 'examples' stamp: 'StephaneDucasse 12/22/2013 21:06'!
example5
	"self example5"
	| poly | 
	poly :=  (PolygonMorph
		vertices: {261@400. 388@519. 302@595. 	222@500.	141@583. 34@444}
		color: Color blue
		borderWidth: 3
		borderColor: Color black).
	poly dashedBorder: { 5 .
		5.
		Color red.
		50 .
		0 }.
	poly openInWorld! !

!PolygonMorph class methodsFor: 'examples' stamp: 'StephaneDucasse 12/22/2013 21:07'!
example3
	"self example3"
	| poly | 
	poly := PolygonMorph
				vertices: {261@400. 388@519. 302@595. 	222@500.	141@583. 34@444}
				color: Color blue
				borderWidth: 3
				borderColor: Color black.
	poly makeOpen.
	poly openInWorld! !

!PolygonMorphTest commentStamp: 'nice 2/16/2008 02:13'!
This class holds tests for PolygonMorph!
!PolygonMorphTest methodsFor: 'tests' stamp: 'IgorStasenko 12/20/2012 14:04'!
testBoundsBug1035
	"This is a non regression test for http://bugs.squeak.org/view.php?id=1035
	PolygonMorph used to position badly when container bounds were growing"
	
	| submorph aMorph |
	
	submorph := (PolygonMorph
		vertices: {0@0. 100@0. 0@100}
		color: Color red borderWidth: 0 borderColor: Color transparent)
			color: Color red.

	submorph bounds. "0@0 corner: 100@100"

	aMorph := Morph new
		color: Color blue;
		layoutPolicy: ProportionalLayout new;
		addMorph: submorph
		fullFrame: ((0.1 @ 0.1 corner: 0.9 @ 0.9) asLayoutFrame).

	submorph bounds. "0@0 corner: 100@100 NOT YET UPDATED"
	aMorph fullBounds. "0@0 corner: 50@40. CORRECT"
	submorph bounds. "5@4 corner: 45@36 NOW UPDATED OK"

	aMorph extent: 100@100.
	submorph bounds. "5@4 corner: 45@36 NOT YET UPDATED"
	aMorph fullBounds. "-10@-14 corner: 100@100 WRONG"
	submorph bounds. "-10@-14 corner: 70@66 NOW WRONG POSITION (BUT RIGHT EXTENT)"

	self assert: aMorph fullBounds = (0 @ 0 extent: 100@100).
	self assert: submorph bounds = (10 @ 10 corner: 90@90).
! !

!PolymorphSystemSettings commentStamp: 'LaurentLaffont 3/15/2011 20:46'!
I provide settings for Morphic appearance (theme, fonts, colors, ...) that can be found and changed in the Settings browser.!
!PolymorphSystemSettings class methodsFor: 'sound' stamp: 'AlainPlantec 1/10/2010 07:54'!
soundThemeClass: aSoundThemeClass
	aSoundThemeClass ifNil: [^ self].
	self soundThemeClass ~= aSoundThemeClass
		ifTrue: [aSoundThemeClass beCurrent]! !

!PolymorphSystemSettings class methodsFor: 'desktop' stamp: 'StephaneDucasse 11/12/2014 14:09'!
desktopSettingsOn: aBuilder 
	(aBuilder group: #desktopSettings)
		label: 'Desktop';
		target: self;
		noOrdering;
		with: [
			(aBuilder setting: #showDesktopLogo)
				label: 'Show logo' ;
				description: 'If true, then a logo if shown on the top left of the desktop' ;
				with: [
					(aBuilder setting: #desktopLogoFileName)
						type: #FilePathEncoder;
						description: 'The path of an image file for your own logo, the default pharo logo is used if empty.' ;
						label: 'Logo image file name'].
			self desktopColorSettingsOn: aBuilder.
			(aBuilder setting: #desktopImageFileName)
				type: #FilePathEncoder;
				description: 'The path of an image file which will be imported as a form and displayed as your desktop background';
				label: 'Desktop background image file name']
						! !

!PolymorphSystemSettings class methodsFor: 'desktop' stamp: 'AlainPlantec 9/11/2011 07:15'!
pharoLogo
	^ ImageMorph withForm: self pharoLogoForm! !

!PolymorphSystemSettings class methodsFor: 'desktop' stamp: 'AlainPlantec 11/28/2009 16:10'!
desktopGradientOrigin: aSymbol
	"#Radial #Vertical or #Horizontal"
	DesktopGradientOrigin := aSymbol.
	self desktopBackgroundChanged
! !

!PolymorphSystemSettings class methodsFor: 'morphic' stamp: 'StephaneDucasse 11/11/2014 18:47'!
morphicWindowsSettingsOn: aBuilder 
	(aBuilder group: #windows)
		label: 'Windows';
		description: 'All windows settings';
		noOrdering;
		with: [
			(aBuilder setting: #windowColor)
				target: UITheme;
				targetSelector: #currentSettings;
				label: 'Window color' ;
				description: 'The window color'.
			(aBuilder setting: #preferRoundCorner)
				target: UITheme;
				targetSelector: #currentSettings;
				label: 'Rounded corners';
				description: 'If true, then windows, menu and other popups will have their corners rounded.'.
			(aBuilder range: #fullscreenMargin) 
						target: SystemWindow;
						label: 'Fullscreen margin';
						description: 'Specify the amount of space that is let around a windows when it''s opened fullscreen';
						range: (-5 to: 100).
			(aBuilder setting: #fadedBackgroundWindows)
				target: UITheme;
				targetSelector: #currentSettings;
				label: 'Fade background windows';
				description: 'If true then, background windows appear more "washed out" to distinguish from the active window'.
			(aBuilder setting: #fastDragging)
				target: UITheme;
				targetSelector: #currentSettings;
				label: 'Fast dragging';
				description: 'If true, window drag will be done by dragging an outline of the window instead of the whole window. It is very convenient on a slow machine' .
			(aBuilder range: #textEntryFieldMinimumWidth)
				label: 'Text entry dialog width';
				target: TextEntryDialogWindow;
				selector: #minimumWidth;
				range: (100 to: 800);
				description: 'Set the default text field width of the text entry dialog window' ]
			
			
			
! !

!PolymorphSystemSettings class methodsFor: 'sound' stamp: 'AlainPlantec 1/10/2010 07:54'!
soundThemeClass
	^ SoundTheme current class
! !

!PolymorphSystemSettings class methodsFor: 'morphic' stamp: 'StephaneDucasse 11/11/2014 18:47'!
windowPositionStrategySettingsOn: aBuilder
	<systemsettings>
	(aBuilder pickOne: #usedStrategy) 
		label: 'Window position strategy';
		parent: #windows;
		target: RealEstateAgent;
		domainValues: {'Reverse Stagger' translated -> #staggerFor:initialExtent:world:. 'Cascade' translated -> #cascadeFor:initialExtent:world:. 'Standard' translated -> #standardFor:initialExtent:world:};
		description: 'If Reversed Stagger, windows are placed in free space,
if Cascade, windows are placed in cascade based on current active window or based on cursor position.' .! !

!PolymorphSystemSettings class methodsFor: 'morphic' stamp: 'StephaneDucasse 11/12/2014 14:08'!
morphicAnimationSettingsOn: aBuilder 
	(aBuilder setting: #useAnimation)
		label: 'Animation';
		target: UITheme;
		targetSelector: #currentAnimationSettings;
		description: 'If true, some animations will be use when opening and closing windows';
		noOrdering;
		with: [
			(aBuilder setting: #animateClosing)
				label: 'Animate closing';
				description: 'If true, then windows closing is animated'.
			(aBuilder range: #animationDelay) 
				label: 'Delay' ;
				description: 'The delay between each step of the window animation in milliseconds.';
				selector: #delay;
				range: (0 to: 30).
			(aBuilder range: #animationNumberOfSteps) 
				label: 'Number of steps';
				description: 'The number of steps in the window animation.';
				selector: #numberOfSteps;
				range: (0 to: 100).
		]! !

!PolymorphSystemSettings class methodsFor: 'desktop' stamp: 'AlainPlantec 9/11/2011 07:05'!
showDesktopLogo
	^ ShowDesktopLogo ifNil: [ShowDesktopLogo := true]! !

!PolymorphSystemSettings class methodsFor: 'desktop' stamp: 'AlainPlantec 9/11/2011 07:43'!
desktopLogoFileName: aFileName
	DesktopLogoFileName = aFileName ifTrue: [^ self].
	DesktopLogoFileName := aFileName.
	self desktopLogoChanged ! !

!PolymorphSystemSettings class methodsFor: 'desktop' stamp: 'AlainPlantec 1/10/2010 09:37'!
desktopColor
	^ DesktopColor ifNil: [DesktopColor := World defaultWorldColor] ! !

!PolymorphSystemSettings class methodsFor: 'desktop' stamp: 'AlainPlantec 9/11/2011 07:15'!
desktopLogo
	^ DesktopLogo ifNil: [self showDesktopLogo ifTrue: [DesktopLogo := self pharoLogo]]	! !

!PolymorphSystemSettings class methodsFor: 'desktop' stamp: 'AlainPlantec 9/11/2011 08:08'!
desktopLogoChanged
	self showDesktopLogo
		ifFalse: [self setDesktopLogoWith: nil.
			^ self].
	self desktopLogoFileName
		ifEmpty: [self setDesktopLogoWith: self pharoLogo]
		ifNotEmpty: [[self
				setDesktopLogoWith: (ImageMorph withForm: (Form fromFileNamed: self desktopLogoFileName))]
				on: Error
				do: [self setDesktopLogoWith: self pharoLogo]].
! !

!PolymorphSystemSettings class methodsFor: 'desktop' stamp: 'AlainPlantec 11/30/2009 06:31'!
useDesktopGradientFill
	^ UseDesktopGradientFill ifNil: [UseDesktopGradientFill := false]! !

!PolymorphSystemSettings class methodsFor: 'desktop' stamp: 'AlainPlantec 11/28/2009 15:50'!
desktopGradientFillColor: aColor 
	DesktopGradientFillColor := aColor.
	self desktopBackgroundChanged! !

!PolymorphSystemSettings class methodsFor: 'morphic' stamp: 'StephaneDucasse 11/11/2014 18:47'!
morphicSettingsOn: aBuilder 
	(aBuilder group: #morphic)
		label: 'Morphic';
		description: 'All morphic settings';
		noOrdering;
		with: [
			self morphicWindowsSettingsOn: aBuilder.
			self morphicMenuSettingsOn: aBuilder.
			self morphicHaloSettingsOn: aBuilder.
			self morphicAnimationSettingsOn: aBuilder.
			(aBuilder setting: #keyboardFocusOnMouseDown)
				label: 'Keyboard focus on mouse down';
				target: MorphicModel;
				description: 'When enabled the mouse button must be clicked within a morph for it to take the keyboard focus.' .
			(aBuilder setting: #mouseOverForKeyboardFocus)
				label: 'Lose keyboard focus when mouse leave';
				target: MorphicModel;
				description: 'When true, the mouse must be over a text or list pane in morphic for keystrokes to be felt, and when the mouse is out over the desktop, the so-called desktop-command-keys, such as cmd-b and cmd-R, are honored.  When false, list panes and text panes in morphic remain sensitive to keystrokes even after the mouse is no longer over the pane.' .
			(aBuilder setting: #showTextEditingState)
				label: 'Show text editing state';
				target: PluggableTextMorph;
				description: 'When enabled the editing state of PluggableTextMorphs is shown as a colored inset border.' .
			(aBuilder setting: #balloonHelpEnabled)
				label: 'Balloon help'; 
				target: UITheme;
				targetSelector: #currentSettings.
			(aBuilder setting: #editableStringMorph)
				label: 'String morphs are editable';
				target: StringMorph;
				description: 'If true, editing on StringMorph is possible if the shift key is pressed while selecting the morphs.' .
			(aBuilder setting: #defaultYellowButtonMenuEnabled)
				label: 'Show default action click menu';
				target: Morph;
				description: 'If true, populate an action click menu (default context menu).'.
			(aBuilder setting: #easySelectingWorld)
				label: 'Easy selection';
				target: WorldState;
				description: 'If true, select multiple Morphs in the world by dragging a selection box around them.']! !

!PolymorphSystemSettings class methodsFor: 'desktop' stamp: 'SvenVanCaekenberghe 4/25/2014 16:09'!
pharoLogoContents
	^ 'iVBORw0KGgoAAAANSUhEUgAAAWkAAAB5CAYAAAD72tBhAAAKQWlDQ1BJQ0MgUHJvZmlsZQAA
SA2dlndUU9kWh8+9N73QEiIgJfQaegkg0jtIFQRRiUmAUAKGhCZ2RAVGFBEpVmRUwAFHhyJj
RRQLg4Ji1wnyEFDGwVFEReXdjGsJ7601896a/cdZ39nnt9fZZ+9917oAUPyCBMJ0WAGANKFY
FO7rwVwSE8vE9wIYEAEOWAHA4WZmBEf4RALU/L09mZmoSMaz9u4ugGS72yy/UCZz1v9/kSI3
QyQGAApF1TY8fiYX5QKUU7PFGTL/BMr0lSkyhjEyFqEJoqwi48SvbPan5iu7yZiXJuShGlnO
Gbw0noy7UN6aJeGjjAShXJgl4GejfAdlvVRJmgDl9yjT0/icTAAwFJlfzOcmoWyJMkUUGe6J
8gIACJTEObxyDov5OWieAHimZ+SKBIlJYqYR15hp5ejIZvrxs1P5YjErlMNN4Yh4TM/0tAyO
MBeAr2+WRQElWW2ZaJHtrRzt7VnW5mj5v9nfHn5T/T3IevtV8Sbsz55BjJ5Z32zsrC+9FgD2
JFqbHbO+lVUAtG0GQOXhrE/vIADyBQC03pzzHoZsXpLE4gwnC4vs7GxzAZ9rLivoN/ufgm/K
v4Y595nL7vtWO6YXP4EjSRUzZUXlpqemS0TMzAwOl89k/fcQ/+PAOWnNycMsnJ/AF/GF6FVR
6JQJhIlou4U8gViQLmQKhH/V4X8YNicHGX6daxRodV8AfYU5ULhJB8hvPQBDIwMkbj96An3r
WxAxCsi+vGitka9zjzJ6/uf6Hwtcim7hTEEiU+b2DI9kciWiLBmj34RswQISkAd0oAo0gS4w
AixgDRyAM3AD3iAAhIBIEAOWAy5IAmlABLJBPtgACkEx2AF2g2pwANSBetAEToI2cAZcBFfA
DXALDIBHQAqGwUswAd6BaQiC8BAVokGqkBakD5lC1hAbWgh5Q0FQOBQDxUOJkBCSQPnQJqgY
KoOqoUNQPfQjdBq6CF2D+qAH0CA0Bv0BfYQRmALTYQ3YALaA2bA7HAhHwsvgRHgVnAcXwNvh
SrgWPg63whfhG/AALIVfwpMIQMgIA9FGWAgb8URCkFgkAREha5EipAKpRZqQDqQbuY1IkXHk
AwaHoWGYGBbGGeOHWYzhYlZh1mJKMNWYY5hWTBfmNmYQM4H5gqVi1bGmWCesP3YJNhGbjS3E
VmCPYFuwl7ED2GHsOxwOx8AZ4hxwfrgYXDJuNa4Etw/XjLuA68MN4SbxeLwq3hTvgg/Bc/Bi
fCG+Cn8cfx7fjx/GvyeQCVoEa4IPIZYgJGwkVBAaCOcI/YQRwjRRgahPdCKGEHnEXGIpsY7Y
QbxJHCZOkxRJhiQXUiQpmbSBVElqIl0mPSa9IZPJOmRHchhZQF5PriSfIF8lD5I/UJQoJhRP
ShxFQtlOOUq5QHlAeUOlUg2obtRYqpi6nVpPvUR9Sn0vR5Mzl/OX48mtk6uRa5Xrl3slT5TX
l3eXXy6fJ18hf0r+pvy4AlHBQMFTgaOwVqFG4bTCPYVJRZqilWKIYppiiWKD4jXFUSW8koGS
txJPqUDpsNIlpSEaQtOledK4tE20Otpl2jAdRzek+9OT6cX0H+i99AllJWVb5SjlHOUa5bPK
UgbCMGD4M1IZpYyTjLuMj/M05rnP48/bNq9pXv+8KZX5Km4qfJUilWaVAZWPqkxVb9UU1Z2q
bapP1DBqJmphatlq+9Uuq43Pp893ns+dXzT/5PyH6rC6iXq4+mr1w+o96pMamhq+GhkaVRqX
NMY1GZpumsma5ZrnNMe0aFoLtQRa5VrntV4wlZnuzFRmJbOLOaGtru2nLdE+pN2rPa1jqLNY
Z6NOs84TXZIuWzdBt1y3U3dCT0svWC9fr1HvoT5Rn62fpL9Hv1t/ysDQINpgi0GbwaihiqG/
YZ5ho+FjI6qRq9Eqo1qjO8Y4Y7ZxivE+41smsImdSZJJjclNU9jU3lRgus+0zwxr5mgmNKs1
u8eisNxZWaxG1qA5wzzIfKN5m/krCz2LWIudFt0WXyztLFMt6ywfWSlZBVhttOqw+sPaxJpr
XWN9x4Zq42Ozzqbd5rWtqS3fdr/tfTuaXbDdFrtOu8/2DvYi+yb7MQc9h3iHvQ732HR2KLuE
fdUR6+jhuM7xjOMHJ3snsdNJp9+dWc4pzg3OowsMF/AX1C0YctFx4bgccpEuZC6MX3hwodRV
25XjWuv6zE3Xjed2xG3E3dg92f24+ysPSw+RR4vHlKeT5xrPC16Il69XkVevt5L3Yu9q76c+
Oj6JPo0+E752vqt9L/hh/QL9dvrd89fw5/rX+08EOASsCegKpARGBFYHPgsyCRIFdQTDwQHB
u4IfL9JfJFzUFgJC/EN2hTwJNQxdFfpzGC4sNKwm7Hm4VXh+eHcELWJFREPEu0iPyNLIR4uN
FksWd0bJR8VF1UdNRXtFl0VLl1gsWbPkRoxajCCmPRYfGxV7JHZyqffS3UuH4+ziCuPuLjNc
lrPs2nK15anLz66QX8FZcSoeGx8d3xD/iRPCqeVMrvRfuXflBNeTu4f7kufGK+eN8V34ZfyR
BJeEsoTRRJfEXYljSa5JFUnjAk9BteB1sl/ygeSplJCUoykzqdGpzWmEtPi000IlYYqwK10z
PSe9L8M0ozBDuspp1e5VE6JA0ZFMKHNZZruYjv5M9UiMJJslg1kLs2qy3mdHZZ/KUcwR5vTk
muRuyx3J88n7fjVmNXd1Z752/ob8wTXuaw6thdauXNu5Tnddwbrh9b7rj20gbUjZ8MtGy41l
G99uit7UUaBRsL5gaLPv5sZCuUJR4b0tzlsObMVsFWzt3WazrWrblyJe0fViy+KK4k8l3JLr
31l9V/ndzPaE7b2l9qX7d+B2CHfc3em681iZYlle2dCu4F2t5czyovK3u1fsvlZhW3FgD2mP
ZI+0MqiyvUqvakfVp+qk6oEaj5rmvep7t+2d2sfb17/fbX/TAY0DxQc+HhQcvH/I91BrrUFt
xWHc4azDz+ui6rq/Z39ff0TtSPGRz0eFR6XHwo911TvU1zeoN5Q2wo2SxrHjccdv/eD1Q3sT
q+lQM6O5+AQ4ITnx4sf4H++eDDzZeYp9qukn/Z/2ttBailqh1tzWibakNml7THvf6YDTnR3O
HS0/m/989Iz2mZqzymdLz5HOFZybOZ93fvJCxoXxi4kXhzpXdD66tOTSna6wrt7LgZevXvG5
cqnbvfv8VZerZ645XTt9nX297Yb9jdYeu56WX+x+aem172296XCz/ZbjrY6+BX3n+l37L972
un3ljv+dGwOLBvruLr57/17cPel93v3RB6kPXj/Mejj9aP1j7OOiJwpPKp6qP6391fjXZqm9
9Oyg12DPs4hnj4a4Qy//lfmvT8MFz6nPK0a0RupHrUfPjPmM3Xqx9MXwy4yX0+OFvyn+tveV
0auffnf7vWdiycTwa9HrmT9K3qi+OfrW9m3nZOjk03dp76anit6rvj/2gf2h+2P0x5Hp7E/4
T5WfjT93fAn88ngmbWbm3/eE8/syOll+AAAACXBIWXMAAAsTAAALEwEAmpwYAABAAElEQVR4
AexdB4AU1fl/U3f3KnAcB4gKSL1eUCOKorGiJjEKJiZqjAU4ioLJX03++XuaajQi7SjGaKIx
ComJGk2MMTY0Frh+R5EOSq9Xtkz7/77Z22P3bu92d2aOkuyDvZl58973yrz3ve997TGWDMke
SPZAsgeSPZDsgWQPJHsg2QPJHkj2QLIHkj2Q7IFkD/wX9oBhGPx/arP/Yxv2n/rBku1K9kCy
ByJ7AAiaQ0x6ZOx/zlMSSf/nfMtkS5I98F/ZAxzHGWg4cLWJrP8r+yDZ6OPVAzTIkgPtePV2
spz/oB4gdgd+ff6DmtTRFNomJIOjPWBw5835t7tlZJqbU41UprNUXuKzNMHoI2pGCscbWZoh
pXJMdzFD78cxPl3n9BSeEzMZ01MEQRb8qv+O+vLCzY5WKwks2QP/4T0AJN0XTTzcTln/x7RW
/I9pyUnSkPzFDUO8XOZ2mecY5zq2BoocOEv4jwHEsOTT5gw1Dv54JgBf63hGesPQRZ7l4CGJ
pE+Sb5qsRu/2wOQVK4Tq3SWiSwhIPKdJsuAS/N6A4PL4TXasT/UYblFUfa2qriqC4h+wSxm6
janvVFysdqqZD8+UR+sUf0o/JpG0w5/PYAGXKKQwXdeCeLgDfnzjRjd0TtOE0zqyJW+SPfAf
1gOFC2uHYUdZIjDpPNAnYzfvM07LkALZgihLmDQiSBfenSIDN8kmleORqAM4NSVN0kHHKHog
Rz08UD1UurTpc0NRN6iC8G+OqWtAAK03jLfdSBzfZDtF+vUYqXeKVPhkr2bBwroClyzX6Xrn
RT7OmoPi1gx1Wu30wmVx5kgmS/bASdsD+YvrTxeYNpbnxQsEURyva9rZQMQZPA98TDtJg3aQ
tKeke9pZxhkwT0zkhZ0ph3uabwbjvOmi0NisqO/qmv6BprO6htkFm+KEeNImS1LSTn8ajqVx
PLrVKpKmoabxHqerlYSX7IHj1QOn/ezjrKyMtLt43rhDFMThjJPMnaWuHiNcdF2xVx0gdxOl
E25vJ5whdfe0KPo4oO1xkiTeKwN5Fy+u3wNe9e9VTZjfeHfednuFnpjcSSTtcL+LzEihYWMr
iFwSSdvqwGTm490D+b+qP110s1sEUfo6xCrFJHqhaWB5R2mrAYa5KBDXgxf4HFDac0XBmFu2
fG2Tqqh/M1T9mbq7ixpsFWEhMxaLdLBkmhPNmkTSifZYjPSgg9NsIWkMbI7DcE+GZA+c5D2Q
V9EocwP0MS5eeJhx/FeBmJmuBanlRDgXvdpMVMQw2lnUGsuVBDHXkLh7i5c2rmJK4EeCrH2y
Zuq4tt6sA5AzCTP747fPSjmm9NRKxmSe6D3AGUZ/A0JDywED3dCVQ5bzJzMme+A49EBBZc1t
7kFCvYsXqzFiv2qAvRdC0Meh+C5FdPCnwakO/euSCBE6ELaBhURg7AJBcr3NcenrSxbX3B8t
rRNxQNAy4GTht8+qamCvU9KlS9ZeweuBXjDZFJmma60Gx6n4Kq0qx1pETj3KfOxwzZySw050
sBUYhsBybDI7sFWzUnIyT7IHerkHKir4ouzrvyYI/E95ThhzYlgZx9pI6qzYueIf38I4faOh
qvsMnkthBqenynymz5CxI9WywL4mHdc+pnASqUlYCeQJQIjR9CGC6P45NEXu1nX9R3sF3/Nf
OERZowzaEaeinpYo6FBLex1JM874KxNJncb5IEDjOAiVYxIvwFaPMzTOp5ctbjiE+081jv3d
61X+vGFu8efOlx4dIgbMEPDkor+MKxaDTtAPxJU0mSjZA8epB3KX1JS4efcfwWgeBvVSTjeO
CQGPSxWIyQ1BoBnar6qqNKqc/rCvSXp5Y9ZohT3YLgwCHvDuWjt088HA/orGRu++pmzui7T0
Pikp8sVgJv5UFOWR5gLTzpNpX2wGioLw5CCW9ot+S2q+0zC9+K922gUEDbYnqsxxtueyuUuw
U5me8hYuqP0SVB//HVKz6Smto+/wQUktx/xkhDAFcauuqB8D+a2oemvty2zlFBv8iJ5rWrp0
/avMUK7pOVX3b3ksNgEt8LW68qJXuk+VfJPsgePTA6MXVg32SO55oLKmmLSnLQIkjjqbc5cI
X41oZJqnrRrPreV0vVHT9FpOYLvhqaPVrysNa2eWbusOIpAkaVdnA0l+0TlN/sL6cbLAXweh
4uVINy6SqAJKRB2APN5WFO3u+lmF9Z3zx3oGzAFIE0DZjuzoexVJl1TW/FgQ3P97ordFZqfS
SgzdTEUL+NCJP+b9amVvsEXKlq+rAc+rKNaH7O499En1gOIfXzez6OPu0iTjkz3Q+z1gcPlL
G65z8fIL4DeTkUnvFgmiCmO/VVEC+3he/41X0F9sWdu2Y+e88V4rBWOOE24rA6Jc3VP+oiX1
U2DhuFTTlb6RbaQdLakO+u6t7rduPpsSH2GHcgejPDJNd0wY2atIuqyyvho6MMWRK1VPXXY8
3qHzUQwnCNB511Yc8eydufW2i8mc1JEA3tZRkAGWefC8IKlKwFtcO7O40ZEKJYEkeyDBHhj+
izcz+/Q5/SWI2S4J7YLNnSngkCUtEFCCELtPzguQLWnqUd0wZmgB9mb/w/sPRDH37h5AD2+A
MIlY2o769iiIL1u2OlPT3b8WBekGXeukv02UPS/Waa1tXwVRt7WH4ojPPaK9vEBP6RJ951xv
dyp59CPr0lMz9S/wkYk3c1IGrNzwf6Qf1VTtttoZBRiU9sLw+avPyJQ920icYTXwosvnC/hG
Ncwo2GEVRjJfsges9kDR4poLeFH+K29wmaRnTII5zJMjGtNfNhTfKo6X7gHSy42kOi2URuxI
ULm6ojxYM7PwdQsQYmYB0iTB3dmo7/s9JiaqG3zs4sXV33LLnv8NaNqY8PbRAmUKHQ39xqrp
BSs6w0I5xFoZhd9GlOXv/N7uc6+p4Hnc3oH4uKR+ctIGkw2j6xmSKP6xZGnja3YrmiZK5wsC
lHvsBF3VxYCasMK7nSKTeZM9QD1QVFn3f5Kc+h74v5kcHITBjYwCwvnbvrZDo5mqK6LoXg6q
zhaCNhGeAf8bTP1a1dSxZ/cWgqb2AGGaO2Qg0Z4nZdAfNau++aw3/j2+rggi0at4UeqQjJqc
ALB7BMH1Ykll4wsEOxQAmwzPiGJf2xsImsrpNSSNFo00eVlUykkeSFoNMeyksmXr1pGgxHJ1
ee4KfDTL2WkAw8/XwZojh1ssA0lmTPZAoj1Q8bZYurRhhSRID+lqgEjnLxS/7xtV5XkyBHX9
3Cl9N0LIdjuxOuwEjhegp8w9f4DpOTXTCl+2AyuBvDuRNiOu9OnpmVzelEDdtLy/K17vOdDc
e4VDB4SCBn4Mz3M3Fi9t+jDj8Q/7Gc3NJCAcDuS8Gj87Kl2hIqJeew1Jg9c0HitQr7FTorbG
RiS5CoVEeXSq5Nk+dn71SCugBIMfH75NsgIDxjBbWFcXjFZAJfMkeyB2DxCCHpjzb9Brk4nA
AFLaFfBqpRCaCcWVDZug9rYAfNo0WwZaqAUvyG1QmZtVPX3st7aXF/bII45d6YRS7Efq8bFy
tFPEHcRR7ezi6prpY7+q6MoTkBN1ZCeqGsyP8/LS+65bc4TlATn3uuyo15A0NhuXd7TslLkB
FWzogsflem/Ego/iW33b25b3eGM/uFocbEdIyvHw5mWwd06Z7kpW9JTugbyKt9PGDR4MJGOM
g+onCb6mwfDsAsnNvyHy3O8FnhtuGzkDLkjzrYFD3tG1MwoXHe8OAxIl1mEftC01Rtk037ss
HnXlhXN0LXBjOEVNhJhf1bPvfP2LF0csbcyNAdf2695B0pMnw7JEL7ZduxMCgEQlbGCmmF4z
8WnTN21cteBcOhz1myagcaWPloioeew93ov2LhmX7AEne+CsxZ+c7hk4cCuQ8CioL/gDft8N
wD27NF7aBCegRfBrTkjbVpFgbygQOC5as2fFWXX3FRHb4USFj1BwXozCh+J9Bx86PC0JCwOq
cpHOCRAKhpgDwBOakt2HE2qL51X3Kq7rFSQ99uL7z4YA7dgeIbzFp8A9UcMwLx122DfgF/FW
V+SMfPDsbLWZJMj63gM0oJIh2QO91gODK1an9BHTPwVJkAXL3M8DfjVPEeAgV+Behp00kLNd
9ioQGeQr/oA6vnpq3ixWUWEXoK2+ADW9CQCGdAcEi5Eb7zJ64ivXzyx8b3Zxxs/82OqGBygf
iGJqyvv5C+rPCo938r5XkLTEYH7poC6lkw2OGxbxngT+7sJFVV+OJw/4VheCVRJP0m7TYEu1
qbHi4g6+WLcJky+SPWCxB8p+sTpz0KD0Wuic5WDbtsqv7h4jauoBDy88S7w2u8HUp+b5A/6A
r7hhVkGPhiR2ywrlB5KFe+CYQWtHxtESno3IbdFeUBzy9cXvxtvOlR43NO1CEoCi/zqSw7FU
mssl1hY8tnpMR6SDN84jaegc4gy/CeRt6lQPOMeKiZJ7IZTdY1PIunGlnfaaH93QGuzASOZN
9kCsHjD6pPwT+7URqqH8pao8d0LjjItbIIRZAUyUZuoCxwLQw3vwngGG+7Rq14sDGmeX1vaQ
1OlXhID7xwC6Ee8v6ZwG+QgHjsbvs87v6JkQNC5ww8q9yHEDWppmF71vGIGrsNMOS46e07VU
OT3tH2xFDHW/sFzx3jqOpPNWNsFlqzTCCVdu6BhQsxLUXqL8zHiox/QixU50BbQtxqoBscvH
De9g8KT6wPEWWRtZD/TRVT1pCm69B5M5Y/RA8dK1r2K+jMPcfLdmWsF1lDx/fvV4CKwvi5E1
5msSPOqcUcXxrecfb/YG8AQZkBwGQj0dP1c3lV2P+AK870xwEavDBxhdthFIW4h31DfP4dcR
qqYV/R3s+lupzRHB0E4vObCuLhFZVkT+bh7EbuItR6tbBBfryw104ixIcIY3wA/G83Da3aWe
HLm849hAaCeOFCRpCFDcIFDvHix9luseLaOJqEWxEu+65TlxonyhAH1KO57BYMnFFCNQFa0O
ybhkD9jtgdLFdXNAz1yD8fxh1fS8iQSvDHxUQxb+Qf6VbQUA1gz2r+ppeXGxBm2V1U1mIFlq
xA4gVkLEh/C8MzwpvUc8IepB+G0Pe0esjs1hz+Yt0l6ImzOR79nO7+i5elru74oqG86C57z/
C2nAIA9Y8UbuEd+Ax5GkPFo+K3FdkJ8VIOF5PLL3LKbJln1XdMAis1Fd/XNNeeFDHXHRbrC/
GrFwoyzyB9M8YtpN0Mh8FGPGZZc/3FEUOl4S5eFkLls7o3hVR3zYjS5pl8NtalhM4rcafAZo
mq8m8ZzJHMke6LkHiiurrxYkz+Mwxjhc9VYjIR9WUFnXVxfEVbyhp9oha4hNhymyb9+GQ9f0
XIvj8xZItR7IEu6CDdop/AXP4c17D3ETWP71fXKG5pzJGZK72estTfd4fhVeO+T9Np53dIeg
Q2lr+zc9XHJw7FCBl27pcCIHDS1BkKcXL6rfUjOz4NFQWjtXe5glWskucZLpfyrauwTiBPKr
oXOxKUt8hI2zR/rXzTz3AFbyhW1HD2aDub+MmPtOBaI0eE6MOggnr1ghwIjlHDvWWBgMYH7p
Wxvu+dIep+qchJPsAeoBHHGVxgnupyDc8uPfhJCbXpkXn8bkH0jUn60gCPDaqJ9n1VudrbK7
yYz5RFT0B/h9G+0bRskmVlSI2VdOn/HwM6+8mDN0UC3U6V4ZNiRrxa9fee/+M6d878+Zl02F
y1JDwu8OJCenTO9Svh4DPONVTyu4Fbbzb5E2Syjomh+yLOnHTml8HIMcKsH+9atAObYDqQFp
XCBhX67r77uguXpGwTQ4TbqPHCg5EUhnlBOlS6LB2rlzCA4lloZEexd/HEf60a/Fnz6ZMtkD
8fWANED7p8hxOS1+7z2hw1fJRwdQM468sifcN/nQiv+uhtkFpOJ2UgUg2b34EaviWiDey+o+
3vcyL8sPb9+931Uy6kzmC6is+Kwz2P4jLay1zXdBZp/0j+o371iI9B8h33uJNCbFS762uSPH
ND5od6G5JIGjhcJ2cBZJ08GU8Dpld3GmxoIy9TbMKFtrtYU1M/J/qWkaPpITSwZqoWmlEIh0
6a8DLKUfaks2/JYDpO2M+dmfLANIZkz2QJQeIF/Joug6V9G0FevvLl1KSUoWN3xTFOSH7LID
yQIP8+v+6hlFT0Up+mSKWvTzZ15+cObkKyedPnAA27m+mk0p7sumn7WDXZfnYelH1rP8nBR2
4xUXC9/48VNT5Ytu7SxYjNmWD+fktpyexl0drsSAhYHxopBTvKTxJzEBxEjgDKnZXkhJll6I
wx05OGmJUWyM19j+G7oRe7sRA8y+zzKm5oxtvRbsij4xksbx2hDys6//UgOr+DA8cZrELsCC
You3AlZK215Ns6ayBN8LI/p5Uvrxmebg0qRWTvSrgY8Hbm+N11F5eHtO+D1kDEMfeseVmj1A
9GvNvJqeExCbVWPjrBEBTAKbe/MT3rqEKzAUVq+uvYMkF+/HiZ6i0liRF9fkGv3IqnSwDJ/F
RAroqno/FXw2rAwNQXi+g3+acG2CGUBpgvbR1wX6c/Msgjhu2TKuKh+JYXPu/GtOY2/fOZCl
767DqYOwhP8y6K3B+9llbe+z+y84l9Wv+hnbrg1iu1Kzfw7bcFOdFoiW8CP9aG6F7smzZwiR
k5c92o40v/ytMR8WL2laLPH8DNp5U6CdisALP4R157JNM87ZYUZa+OMokjZ4Ix8ksIVqdM5C
c1F/uXNsos87553uza6sfwMddWOo4xKFEUrPwwWpZGhfwnMEkjYEcQqdvWbLSovj9rhFuTVU
VqzrkMc/9GSJ6d8URP06gxPyBZ7PMATJ/JY868NUWdHKDuQd0hbXr4aJ73NVM/JfjQXzRL7H
MWsTeIm/UtC587QlDadzA/qnkd6lW8zgdW+LH8eIamVLGtv0yrrdQNRN8K64ptkn/n3TvSel
z22OVUAqU2HdK1rxwrrJOLTzOvRHse4z+sDzBAThki6kGd6SyvrPdY57Ex5tn8fRTuuifjcs
dJ6ljc8Clcp+Tf9W/awiOO0yeJVvega7vqhZEokEFb3vsF8o3jhlZFwLRiKwnU57pqznvV70
T23AvjbRqD2bKWMvZ0xBtfudxthRhRlp5zCtehUb1a8/+8OVLvaulJ8y4VXjTkx3IuxoG34U
v634bcZvL370TJok+AyRREPhEuVhqBnMwLtjAQg7Q0j7J1uxItcq0eQoksZxJ7YEaKGWkfcM
XvW/GXq2c9U57WmBk260u70DZY/hzUWz0b+UtjZWA1loKZqyeeMsUEizu4dChyikZPqv4Zh8
K9boyzFAiJ6B2h8UFcnnhx5+yhBROlxfURSHQ81+Clyw7oL2yCJB8D+xxqGTkLuvaew3hUtq
B/CGcBXP8zegEROxwqXh9Asc8qyROYQJAEcKo5loBpxOUaBYnomgivgJBtQVM1M0VrqsaTfy
vg/K8DVFEN9unJq33Uxs80/p4sYRqMtpGm94OJXP4Hg9A58/FYt9Bnq6L8eEvqhVOhaSTFQw
E/6X01G/FOjUpwE991ONpgrQaw8lUo3ixY3FILtmY0s2GfnSCD0YPEYc/QNFRnPC/M8Jpwsc
/yVoFP2o7Ml12w2f/7aqWUX/Ci9r7IKaEYLHcw0ouer68rzn6V1u/6aLsZhfYkfATXBovAZU
9faNs8eQbvJJHTAvOQhK/+Fd7VY1MdPFtmJ46NVMOLOQOtesO8dlMXHsFGJnMsN7lE0cNHiN
KpiGLduQYA9mWVu8jaybXrS3tLJuKpQWloVwAl0xbkYW7sudhDFhiVhyFEnDeX4+qZLZDRBI
HATtsMsuHMqv7pE+4HNUGt82gzlNhoUDGf1E7Wj4KMmwM/BNM1pV/6DbrTyKLVzW9F0Qk4sE
3u0OHe9D6wIhLgrBa6cWIsExq099kCCIP+V04b78yvoJDeUFGC/HP5z2s4+zBvRJmQdK7Gb4
5SW5A3BssB5Gp3ETaltHAiQji7iIHYtuDET0ZPBdJ4sABP7fPwHnHrtHj3Ei/wQcvF8tYvED
AdteMi545kHWUz3MYAreCIEGA13J6k404jdsGlrxtrtPTs5voG/7Tfq2IVjHbkLfF2/M/8f6
gNOMM1TW1UeOSxJfAmoXVE25n2pGHhrdAv+GbnOXS2QBvtnsuhkFlpBNsJes/zWRbtfsaYgK
/cjqMKv9R2rAaYGrf5PC60skFvAxwwd862sFMsZcIRN48jp5eB8o6beZfmgXk3U/83nbPurz
0nXvIK+l0Np89A9pfbJ/hsOoqR5mABHBCTxbjgfS0U44OIqk8QGLEq5BlAygDndn7Gp2ZCsF
Hl5L6bLGL/BRBkcpKqEofNoI/e8UiRXQh2bmZE0IVEdiE/Ew7vWOiLAbCH5uFpeLD6OAobQi
hxB0WJK4b01JPsdlyLy0unhB9Yya2SVPxp3ZZsKxjzWd6UkzHgUC+wowjYsQLc0RpwLUy0xQ
oDAvNUS5oXRpYzX666fV0/MtCWOxawpous9y9YDWB8STuXRxw7WYvfQdcqx8W3iYY762SA2o
gvnVX4XLXDj7UldCr/8fVA/Zwy+E6Sz5Io2nWt2kAbXASft4obnXBIX4ZmT9RxaDRHEQbqJn
+hHZS3Kf0C+4cgbXL+IJ0zNdd+K3BT+iFGlQ+Nt+eLObX18311AVHGAgMtfXbweixn7tyBHG
pWMjpLiZMOJixg58wbQ17zPtUDOyWQ+kXVa8qO4FQZZnhBsJQdNsYGFl7QN15UU/TxS6Y0g6
d1FNHhBORqIV6Jye1HpUVW1w6jBKE77GduCz20bSgBUxyjnSj8Y2yVbQdK1O8laFwyh7bHV/
I83zDNiyV8OXbfgrW/eE6LHCS5InbTmU7bdC2f5NWwBjZB769BZ3pretHFTzr2jWQS0pRg57
r8Oo7BL03R9Llqx9V/MHptbdU0SWZvEHDnzgiC8df9bgEOFiIunSJXVT4Qh/qZ3vC4zlX39f
6RfhtZNcrnvBdtEUVf0FxY+ZVz0UOOwm89uHJ0zwnuNEpqj+p2pnjAM5ai+gLkT50pAg5Es/
6m0ZP+LZEXKld8ROOQjqnRCw5WCUDeaPCB6MPJmJU77DWvxu1vL2G0xMAaryyMyTV8Rafv8s
85SewzKvvIOletJOM1ZNd6Ncy6u0wvl+IhgiWRxSO8xg6AqTRXf5iAWfPU52HaH4eK6OIWmR
eIw2TaODFeYZeIHvx1P5eNOA/RSIZPHHmzMyHbaQHZ1uvpHkEobOtxN0nvuUTR3XAQTU83Uc
Lz+Nj5ppZwJ3XyeY8Kp+Ug/6R+HC2uF1JFTqhUAeweRA4DVYAQ0n5GwZ51msG00KTLSL5BRX
fdHi+t/goOFp8YLCWuaJ/NDx5gymgzyJEE+3oWRJw5OgrO6w+30hNN4WXkjugsYSHAM3ARTc
hrqZhdWkMup2iy8jDgukvS+Avc8eOO1/ILw8G/emkBzfx16lYlRgWUrKoOe2HJojs72e02+4
nckH/azp2Xksc9AI2D0cZoc+q2EF94xgR0aeyzb//jnmSk9lWWPP+0HhWbll6K8lqN+qGEVE
fd0445zdhYubZsqisPgYK5Q01tQhqZI+CZn+HDVjN5E9DqZu8kSNxikOXwmjZKKmiSfSwK5F
bg38M5608aZB9wT3w/Fm6CYdGA4HIl9p0QSJkUl6ejJxvvG3UBJoMDwm8sJLOhB0KK63roSE
BJf0AmavHXwUtXrYxs+R01PXYlACQdsihKLCjzsSiAlsBIhKxKmlS5vqyhbWFcSTF+zyCLZW
PHniTVOytOFXIGbusKsGZ5bHcRFI2iXpy4kw9TNlLog4oyDrmlGS4Mq1u4MhuQkEuQ/G28ZY
6Qg59zaC/nWGa4THw76A1PX72Vd+QzAEjjUumcfU5qPMk3Ma8+3ZjbHhY5ue+x3rX1zA0nOG
M82vsd1Vb2e9dd3VN713262PAFHfih/sPhI/zEPbZ/waYx87+GPTi1Yk3mCVsfqn83tHkDRc
eaaAW1RA/FW7AR3SvOZ749bZhROZn7OvJ02dbXBbQ3DHLKoZBQQXyz1iKHnUK1T3DN1vvE/9
h9PKq6HJcC9pahyPQMgTG8lzChbXT3CqvLwVjTIO6XyDF8XHg9Zs9seD/boRBQM2i6EXcC5X
dcHCuptiwUSt+8VKY+V9yaLGh+DnYa5dpGmWjfGoqQHiwZohf1n9WYLoLsSytKWhvOQ1ipR5
z+0aDvkO23UHEyf4F9oKPkNVT4iwMMGqdiSXJUPSQJtlFU1gms/P1v/hNyZHmzYU7qy+TPEe
hjhJYm37drC9H3/MhlxxFbAXBMOII2ej2/664nMsJL8FQGJ7lAMv5XYAj+OG9NmNgDqD1HOh
AaSRlg7wBbk+Hli8tI6o6biDI0ha04UBkIY75YHuw7hrH2dC9M3pcSbtNhl1Ms6hrwklcHHs
amLv2AlQOwtofKCZGSnVoFWKj22N7EBNJC8GDS88k0iO7tKOWFCV7TrEfSRw3OWOUIndFWQj
HlS1IEvS74uXNi7rEYxmU7YShY8KYdJdvCT8nxUBYbS6tlO3W0LvJI27AQ7JZOxeXqE48oGu
88ZMQgx2AqlAqor/r9WzInnfdmAej7x+6B3kFOFcaJCuO995mcF9slksB4m1nJnJVI04LkTl
cmz7my+D4OWZp+9gdJdmxvKMJx45sczqcVmEH44ENL6O3ziKjydUzS56Fd71m5DnIL7CGsCC
ph9OHGfiN+PJH0rjCJLmNOEMDJCQFU4ItqUrqPG3LWXsJhPp5GJ3ZYviJdCmMYzO1oSKwQqJ
M+HsUb3gDRuiKP8LbR5lF1aoXgldMYHh5nVYwdK6CxPK1ylx/hP1OemyqxbzoSRIQXdKcBI9
0iQUOeEuUPzvj35qVRe2xmmLPs4CRznWoaU9tMikmfaGJ4DHuTLJ5V5GfHKnApWi8sbmDng8
P4ucikEO/UeKUxXXzfDGRpoRtgI0XZprZhTeaAvICch87ae1PrXNt25v1bsmdRyqgsDDLgis
cLJ7CAVelNmWv77Ahl77NZroQNTGRkUXTcErpQFyVQlZ4/cSHr14j7lvetqLSaVpiu95qOlm
q4b6qanEG1w0vxoqO56rI0gavXAeqEDbsDDIdN6vfhBPxeNNI+jsSp5zYP3AV2lYlW865TfZ
O7yYZ5dKQRvc6LR0B+DE2x1d0hFlJ6p8QoMmHAhpD8ge8TOMe/jztrdohcPtzXui9KGEdUGa
krW686nwfXRpiH3HXNyRUP3zFjemuQTxn2BNIIooN2cCqZPBAbnJ7iipbPwKhIXvQPtic8id
Lliwl9B5hXaC6UDJ0H8MGKfGh21vLKbq4NThw1uqPv6oyOBcAcKLhJKBfpmYkcWMAJQrjuFo
803gyGG275PVLCu/lLWqbefcdvDoR+3gIi5A1I2I+At+1CeXo6zhEQk6PeB0p+U0L3B4iQ/i
83vJWx6o9vSCJXXf6pS020fbiNWEzHGXdVtCAi8wOZQ2Acx2pwIJxTjhm4YDckNOEOrYSpjE
IQQ0eaAIB7300U/5gBHMS+JEK+0YA6oz1eN6DxYOoEhPsb6gmctxo1L8MDkLC7wgloTJesLe
xH9raHqHIZYscq9hGNqXiXQq3kT6orgDCzwGpX4B0MA/kMTkG5P7XGCFXLvsM+oivy6s6FT0
Sf0IpEm7I196evq+CkxV3ZBaVaheq7COo5+cncPajh7FvWz+NDCg6aeDu7G7/kMmpmVB84Ol
9NTIdsr6C1xJ6E9sEBIuDsavyypcPbt0H3aXH2CX+TXR6/0DrGxVkPFwMcHu7amM8HeOIGnU
7NxwoJbuMTNU1d/aHPBFbBUtwWrPVPhYXQoOLT8HnWcHDE1mECVKx8oKcd8I8P4cIM/tVcup
3GABlLC7liXUnvOfWpeeyqc1oQ7g99vsX6cakiActPvzuu+fuyU8G44YLQ5/Tvwe+kk820T5
ipbWzMLkvJBYLE4HYivVv71uW9nyNaKh+Z+FRdu9YNO8TuVU7y4BR0foa6dM4tFCy+hfa2fm
brMD53jmxTxPmQoEDeR5sDIzs+/irIyzNU52a/CHpMM2hn5yTg478vle3Mv4AUHjav5IgUPM
YHsb6tjoydN/WJnqvvTJ1NScWPVHWZ/h9ynSkYCRkHXXBVll94C3P9TncQ8wFA1EKLEZPWOI
TRgLPr23jaQLFq4ew/EcKafbCiYnT2eNO+eO99oCFJaZT+XLYRptW1IPiTw07PU3Q6B5Xr4A
W5guq2bo/al35biionMvSKTeXr/6R+hAD3CSl06IAawzMAW4FuyA6iF0+QTb+k3g5WHiIR48
VycDlt63IuDBCRFOiC+0w1cnggAqfGsL59WWipx7gZP9E6orkAL10UZy4A9fLAr8mZ8myu4C
kflXURpD8Q2AlhAWT+uB2oHDVk0hpHUoxzfngkHDbiweeOZLywadvo1zZ+zlxcxPNNHl0WA5
rwlAxpjHEijp5r37QTkjDtSz+QM7VMdPw6+tpZXt+uCT6Z5+A99k7pTdT2XlbHkyK/u3i/sN
7rE/aWHA7xO0WEbfnYVfdqj1suHeAHZHm6AZk1WmwfoTxp+65uJ5fVQoTU9XMLbsBU5yXQGH
M1gb7LGtghM0KPSwV6Ng7rHzmgaBL/dLJyaJCoGP/6iLtpPBoLOrSOHxxARaG5wtm9SEQFWM
B+C342lT8eK65WALOKrFAVYXHLZp76mq9pP6mYXvhzdy8uQVwmcXjvwS2DLf4wUXylVSbPPx
qc2aHoGk83KbRO6QMAS7pHi6IXoawPWrvg2pKSl/RD2RpjfWcsDUNdrFmAE4GxaFbOcRf6ZG
EWke/lJ42RDsjBJsy9E9iimEDJZy8v6twNLe57QRb8HJ/kQNgj8cZkis32Cg+/b5QgsP1DBZ
2xEoVJkuT0JzqT0NdRjiD0OHOuPMYaxt8ybgU3GoyBlDeVUjqvfKdqjdXoCoiROwF2Vl4kdI
eOfU5Wu8a9T0raA/Juzf0HLlgFGZv0I8z8nyxbjSWO8xhJrSY6KeXkIAc75dAQXBJ2GOYOhv
9FRWIu88Kdx8aOAnkiVqWnPx0PVfr79vTLOZoGKFDARdGjVxb0USdQkqEkOJ3MStxU0zuU51
KgQXMiOubX7xsuqroQd9pzNqdtj20WQxuFd9LUdHVk/PuxwI+j20K+LDrQTFWDOr5IMqnHCt
+VtGYtL9zi7yA8kMib1RE9GHTYwOrYhrCxqRL+wBVHSzxOSfoU+hqkVIoDcCsVSENSZkUP+S
nHqZEmh9J2RuDAT9I3ulovt5fp/Iq4fswTk+uSsIfXD820Qtq1C106GtodFVCt6rost81iBs
1SUX80JvWpUoLZ7phzGoUl7EBfO5WPPBA0weOAgUuIh3YsDrEW5KpDVA1iQ8/gw/Y9ldZTlp
orpKktPyRmT6FewQ/0HyLDCz4xLY20LSE+FwHg7r852Q6gMZHl5dnqCPhW56rWxR/Wz4L5hM
K6fdgG2lonNyRQhOUfaoc+B60Fa/hWDFuppbfEE8iDMbnzW0wHlAYmLV1LzcqvL8DPg3ucbg
BZyJ6AwigM73yFj1gRn5MJ65/oopEStpzPcYxFh4xLaAzzutqjzvKw33xucUnfR117zV9F3b
QluOC7Tp4ufhFXUN0IdrhganDtYDhHXpoOhA2drvo+5qQeNaNIIykuLs+sdAVQ/EQkcIgeU8
WpuKnh1mZ+yTdosS8P/lZHBr210fdI6fu3PDw17Gv6kTWwNImpCuAnaGAiSs4UfPGiHo5lac
kw2kDcRMzwoQOP00IHRC0EHkLTM/jtfSwJYAt2Szn2NT5+7cebBzmbGeMcbJstKL385Jg+Qf
KwFvljBs4HBN8VYKKBPWZMVsMoi+GMEWsmkelC4DSYPysI8MsbrUxqhrXK/pyCBsIx53ZJIA
kWAB+qh2z6gOaT3Wv5hbnrgqGiMRqVhpuvr0dkU7s7q84Jaq8qIOwSVlrSkveA2uKMeTUNOJ
oHN6jxJtKkOU5KecQtC6wXsNVS+qnV3cs2FJlMYVTRz1ZXi8i/Imviha/HQl8Pm6mWMPhOeA
hsTV1qGGINHm2v58CEGLdkX9gabbNpvvOO6OYBrd5EcP8uiX4nSkaNkSiEMLNOMnCWQ4KZJ+
f0v9FW1+bpQicR8b7UiXEHb4r/VoC6hpdxBJYzEiZE0Udwd/mvjUQOgMfQj+9PQ9Z+eNnfP5
1mfsNvC+SSN3wofKobYA99VHC6VqKEmA3yHwBReMKYgF29aY9LVyg6H1AMGcTUQBRAM+YH2s
ysZ6XwSfESIvvkiWZbHSxvOeznFTNfX7HadsQMVGFPjxvSGtD9WHEAjUp7arinpJTXnhd/fN
yGsJvet8rS8v3IxV5FG7iNpEKgZLISu1zmWEngsW183BZ7o49Gz1araPcVsV/5FhVTPyNlqB
wxv8FVjUrWQN5qHxxoy/dwVgTLI9lrsCTTiGdhlEzbb3FfJjfiGOnmlMQgjll7TsvcULqydK
kiudjGS8fs8GsyBDxDbb3iIBQ499dbOLdiZc8ROcAb1k/GhnzWf3r6v5UoCJfzGRMxCuycoA
Nc2npbNWUNKG2x1kbbSzN1Rid5jsD0LoxCIB5S1KH87d2rS0YuXKgGPN4oXXvao66YqLCnbg
a/4bHxKOztiFseCLsRL09F50SVeamoH2xgStKPBDoJBk1FKg89w86X0rBYH/th3JfGThtHDo
L9TNLDINWOjdiIUbZd4tDnfKtDeyPJqH4PAz1uBqPXTOv+PUcgkE9OfcHmmubuA8CRuBmA++
XdGdv+UtazzDxYm/tN9uEznuPXzYW7z5/i8Rz85SgNbB5aRrajWAFQZtHeVPEfmxQMGJ/gWO
7MAiAMf/QMiZEySvpvh34riBV1WN/cOt+9Z+zvHeQTxLCWjcaYIolIIiKwkM1HzSXqmYxrth
8Ps2zB1tsm6ww77W7nfCuVDb4q/1yZlS8evTpQzXtboOJWhgb2xLGZ/Rh7X5FPCgaafRGWmR
8JBCMB6blXfNRwf/BAL+P0kCW0kgoSz9K1nXIZjl8mIVYQtJQwI8CcMKzerc4FjFdnpPvaMr
dZ1i43g0uLKlTfej+78HxkQ/5xA0yU0EvaXN+0B4JVxqINUwhAHhcU7dk2MXVVdXCLz320DQ
pBYQV5B4ZRfHuwMwy/fElaH7REbjIG/UDynqxiMGp9oaK4SAoJzm9ftbz958/zjLCLp4XnUf
mNIPtYOIgADV+rc3rgrvinzNNZb8O4QOEAh/19v3Qcs+1goK9iEcGruien/+jo7dW3vhu4PX
bbh8GKpPUWX98HZ5UMeOxM/037iYMDeIcEIpE7sCXdne1SZWYi+kHpq6Xz8i/Bluj4sNTndj
bzJE7teHHfliH1NdEjkXAz4+NtyD/YURSqha1xcGDOFnTteK9+ofCP3SuLHzq0e2KS1vyu6+
rSDLRpJBEii0Y5XpVLD1iYcvyS0xvowO6AQy8UeyjFJ5cShcSfp9irC3cUjuETYlaN0XDu28
x3d4vJ79OfAjMxwsW5yP13QbnJG7OQd9IlB5tNXEqnffujklW8PLx84J/qNtI8NwkOY9UdCg
nl6pmZm4j4R9qq8lW5P9QIKWHVzRQqtzamu4X+tQJQsW1V0IJ0zfsLsAgj2h+duaxzfOOWd7
CLaVq87zQzCN3FbyhvJAr7iWdIxDz3TlOT0XEzk8qtfvaeEC6ezDwvCUfy83N96TwEMVEzmu
P81s/LaE4gSoehPSDz8VJPQuvqupULs+vrQnb6qKd94hPcrJD5ReMUE22F8CArTH0jKgnrfX
5D+bn9pE0kEK2vwWir46oCp3/bjp/ereaFnd94v2liyuP5Ai8P3S93u3NA/qswWaUlkTH3pH
eCd42EHUYi0j6ZKFVWN5tyQ7Qnmgs+Cd7M9AjqpbUrWSA01+rrLhACTUB9GZELNiDvHcID9/
NEviU0R4tsLxc6rJG9CNuInOqB3QOdJEWIb2BpzhP9b5HS9qU8xTfWxstTvDJIVO7EQ+4qXA
DV3exRGRkypj58S1YKJ2tXSKI38oCSa3P3QfupL2zhFJnG8XQYOHSt6/ZgFBR6q8hQpK4GpI
xtnQp7Y8bkFakGVrl3rASVixxjk7lnpqFnmXA4beEtACl5qyhZ4Sd/NOBe9YgDEA2BMdBmDQ
SEghvjUxdKwEYHhDUfzkn+LEhRkvjGKLvxHksduoxf+Mm3SzJEu/U6CNhGMGmZTiwekf4AqK
wcWYaFc6EAGq1YehPXXj+tH93lq5cmXE4m2j+K5ZYa7P7eNEqHyMwMlTHxdW1n8ky+4rd/Yb
QqzKbj+Y5cGuSXIhWPFdK2IxBoiAw+QjwZVElBKQciYom+EmOLOWQGVA5k4cdNt9FVEyLxxS
9QO3REuDAzcmkQctpwJKwwQzNvK7vF9eU3HsdJZE4MOAgc8QfW6Q/4lk65IWSsNQ54sMh7Oz
S2ARUWynxbToQd7wKjRUlkRCt/YEnylX29EwMeUfhkJmvBFBkIR88Doi4nrrgRC0ZhjLa3av
mM4qKixvRYFQYelLspNj3vBkPgCPjzG1unpqGljcxxxE9ZSw1955AiZ/3Q787589aSDn8iz1
0z6DhK0QDH5heEBFA5kAMZN2EFhF+3U18MvmLGPBwr+96T/m49JOyT3knYLd25L6vThxbxil
gnuJnVBDTc1Wd/Ed/Koo2S0jaWDMUqiIRQHpTFRQz9MOeki8HjAY8So8K6ubej5ZDUWEsnmr
B8EQfEg4HysigYUHTpD9hrd1EhB0m4XsZhbBu0dmmf3A6rA8181By+tcV8qFY8+FBClW6wfx
9V6eNV9vOX+njLzGru7qxqZToh4eCUGKhtSVkmYs93iMNuwWwdnS7qmdnbeoh2rG98rQP4Us
47uCYJwRyqDr4lkgG0OPiV85Xhd4LUI1MXEgNnM8dgs5e7YV9PSMn2OHmUJkMo1hXpaYq+Uw
O4pdnSiJAdgZ/NZzcP3MisbG7rQ3iIZyfEgAh6yFX5Wx1Di4rACeMdyBVLKh6j5YJr8kUS62
hRi6r9MJeQOqBHxh5at1d47ZEq0ChiwViaQ/6VRAeX7FN6vm7hLTCMEqWMmVCSdSsuXvSOUS
Pw7UWMQWFyeYXCWKEvxcWx+nZCUJ1sL/kX8Jq+0Lz5e3pPYSJgq2+NEqXIYe0eUIJN3/kXXp
oM5N6ia8PGfvwfuk/lAC1zuCoFE5aKLQbp12mOTcJxh4PdUWboEQSw/A6fIpHuDmYGLQYCVo
pMJ7UlhzW4B0oF9Q/PyoR97/4109IGg2/eJvXtgbXQBayiMKYt8gbGEYPh6neIh50H2wQUnr
Rd2DPbXeYMuhaKp2U0+nZ4PZcrYzptBAirRF5bm/188ofNJuT/Gy3gd629a/Iyqgg2cHd5cR
En1REqZCB95W9eAi9iMcXpqwsUp3hUoa/207PlOCi5H+Ych8OlTO6emBCwzyOd4L3upCZYAv
j6PSfLfUzCp+ORRn9wreZn+omMFzDmsOwRKZWKTbWFixYpOKQ3fUZaiYk/p61VVXuRTdPZQW
MArkZkdISd3efLRt6rx3n4+iHx9MF/p795fvyNFE/Zd4PjcU59zV+NjgxVsInsAbcCSGf10Y
jZGlWZrcefMbz4AOca+ookVWr7efQN0IkH16AxNr7i7oUG2KViovyKVOnT8IPwOg2gP3RCsn
0ThB53JABtvSkSYVSkHROlQgz13wUYZqsK9ap6ExMURZC/jVGYm2p7v0pqENJ51vXWshCJnT
hb90LgNygSuhKeEkJyuiCNK2UBTlhtpZxXSyh2MBfkKAjk3XZukmULibRTOut7X7gRZOgMnd
GlA5VvleBDSADRhigAdtLmDYsaqa9vD3lj+0MCMjY3+sYm+/4vZ+MG6hnVawT2NlSPA9p5OH
R9OtKYlAdiB7zF1wzATR6iCI+mXEHjilAxAlx8uf6/7Wc2MhaLOdHF/iSHtRLva8D9Y55KcE
KjwloIRtfQz0xIGaOSWHQ+3zS6kP2xFEkkqhrio1dTNzq0Iw7V5bAmnZQEnD7cLRWKALJQuB
8KW9RkUTgla1X9TOKHAUQVM/gIgm3xDkR8wkmLIHX+ACv94S4RXqV+wWdRfMQUPPp+LVJfYZ
ZMD025BcR32aMWnx35Y9iEMAYtIcd1498wrZndqoS+JAXRRSb758muOEKD6ZC5PVpPHx8eIi
rix9UPgXuo5W8FM1kB60ZuifVO364nxWcXFMKcuox1b3x9b9TCfaC6pq12FdesQJWAQDWgIX
mbqINgACqXYIDcsqcPI7x99qV+0OiOnbNqrUJSu8iN0OlGRpvIaAwZrvoMh5d4ae6Uq7hoAg
YmfYG5odmIu6vqJ2Rn6EUVR4+XbuDQ1+ts1prptjMydbPx2qGUEMYAGwqa+vaevDF2wLYE54
Fr8k9INqm3GkueX8Z/+2pKG9Qt1+4JsLv5fqOktbKvDit0PKEESEwgBjBPJ2USKw00CB51tg
iDWaYOBg6wYw/2OO6ZgJOlcor6JR5nV2Dp3Ce6oFGoS0uMCy766arKbfsGmRBg3dtSclRbgc
RjMg5GLi8+5AmPFAEth6+ZZtnF3URSe5x4w9vOQ5Y4Kt9RKUGKin9aEi9CxXLrz8pdthK2A2
vFM/q3BdCKYTV1gJ3gufYvZA6fqe9F04RjosqCw1G5MTFrrdzuGw1PHfEoWrM25P25GDd8Sf
K7GUUMQ4nfjPvMH1pZxHjx7endUHrnTsBI5ts5P9ZMhrYNEFJlz+7GsLQgiaqtVF/ek7X7un
D9zcPSjx/HdhPZ6hEC8fc9QM+H5wcToS9z2yQYOJ4/8L4tAropgRs1538UbzF4aeqkoouScI
CW+TxRwlW5DkE3p4ak8NivbO3BJC9Qnf4J9+rXVQzfT8JxnpLMYZsCu50QlNFjiRaq2ZXvRQ
nMXGTFa2oP4s1K1/zIQ9JCC9YbhC7bCwMmT+a3iOaxsWDSwOAyBWxzPR3lmNK66svloUXZl2
tBZMvrDqq4IRQcRK6xe0s3rjKDRsZfWjbd4L1t93QYdQz2r7u81HAxsrNHjqJmbe/sCEQ7D6
2t5t+rheGClxJTs5EnEMBledq2II7iPPrHhkWigePHrCcx1I+lvf+p8hN9/4fz9hnvRD8Jh5
j8LzGaavaXILQN4n6Uc8bd49PATDqSu4EJfCBmT3xoWT/IxL6YtP2HZAzuqoW7RyujQwWqKI
OEU6zeA1B3XRIqA7+kCCU6JeNc1fB6ujmxum59eb0usESqGdAybCubbZO8QDZ0ZFAkXHTArr
u+t5yB1g4hMzbXcJyCWq7jvmgRDG+N+2Y7BDFqg4qdJR/iu07qYGT9vurhXxxPPQguDf7ZxS
5qRxZEjVOd7OMy1Umqr+YNPcso124MTMazDoE1PV9awRC153bZw9yQ89cPI/fkbMvN0l0J0/
NLe7ohyIN1jjvi5UqE9b+2In2NRJKml99O1/7jMSJ12ncaoruFojO+QGJgGAW0qIeYo/iMOA
6QTH/qNuDFMM7R0TkMCD2NVbswKHtK09QE64EoJIqmg4avNkDYQMwU+CTmobpt6fA5r3y9XT
C4oaygvqEkXQ1EShnzoAVFwfu6J/UHKKz+9d4Vi3kT4r4y6zy4JRAz7409VJms1KH18zAqv8
mVbrGGQnseedpB7zF9aPAyV0rdU6hfKRe1m/Gngj9By6gsaaGLp35EpsDlVfjwMaSIWrVwMQ
ymY6+gxjS5SMQSZiBvtjq/VCSfvOPG07DhDgPd217BjVjSPO4sjkfJJOPlioAJh2R7C0nlv+
0oBb7nz0wb4DLzzECa5vBDjmMilnLKZgjUAdln5Sxz1ZJeLkG9amBWyryHZuMDQc+/K68jeK
xyGHxRD+Hlyzq6xHKitxZMuLl9rZdkZUmnZrDgUMVBxUIuGIM20TGPLlR/xiv5ppeV+vm170
LztFYKuBM+9Mc3XLYIICmUBN493jtlsG0inj0Ge2ugTeNdaeuhX6n9cb4TviEIE3XNINxBaw
GqguOlPnW83fOR9Rh5LE/9mJ8Qae9t6o/W9w53Qu184zXBkonNJ2uRWCIOFyDQYvpuSJk2c4
fWM45dcCvldIMG4l0PczBH5I3uJGmJvHCtApWb6rw4hGGqjnx8pxIt5fd9svr3mrfuc2lRPv
h18TjwoCjo7LIraGbiLjIHuj4xnxnJyi+nX+upUrH3FsvobaDtoqDQdeHKRncGGG4ZSWHZ09
HobShq6Jf01DGx/KbOeKNduv64EfCJx4NrYbY+G4YwR4a6m03xBoq0HIghj54cFkwQERtBtZ
gO93gBO4RhyT/oGqKKvA6m+smVm6LTyL3Xs4Dh/PGfZ2DiTvUlT2Q7t1Cc8vH24ebHjE08Lj
rNyDGRak7jF64FfgIjuHsMIo6IDIvOHCGitV6siTIZ15J+jEIVh4O+Is3xjcW53z5s1ffQZ0
jXFgaOc31p4JYWrQ5qhxcDHuqSY6JE/mBh3jCzsgEE/sDdh076Z6WDUNx5mTkuRtJTlHS09l
B99VYPhg3Ex8SFAWfqM2dvrjm2Ly1PmvoMRrSWda8WE9AXI2WRmIpE8e1H2gOyxOuAiEuDVt
q6p4b1z53P9+gheOhjGLPs4SZE+W0ubFOaXwC/nk+lI1oH4cq5CEkDQNalAIA7ogz1ildHof
lHdoW2vLix8PfwWDhZRWThwi+QKDBFFEOSwV/Js+YA1hZ0/om+2FS8mjakDcsU/RN+35fpFt
G//w8qPd49Dky+1QqwQTFf+iYWbBm9HgW41LcXPfpQFnB79QXkFTVlId8lY2STAvH2nLqtLQ
tg/vt9m/xmqjwvIVw+cuem6hIwgai7vGtC5IWnBJE00WjR2/J2F1BqshgF1ch8Aq7FWv3EIF
77AhwgkiLEZBTefSxOcWrwGV5rFeHlmvyuJgANgaHxBQ1O9078EtPhjOprr85kdT09JSq8Du
hFsDnbXio9BpKzQRUduOACtb3BNaAcLmuMMBTV3+0lP33mdG9MKfFD7lNN3vDzTMLtg0gn3m
4lPlXEP1z4tVVEJIWpTFS2k7jLPeY8Ht8T3pcEPA1IU/2H7w5QZkpt9JEXCKx3m2KkI8Sjoq
x/kwNWy8WYIOyncfRu02yixsUyWWKVrWFGn3Lle9MgGtmW4rjROwBff6V+xQ9eGwyakRp6lV
4XF0DyQ3Ht6WOkdbejZ9v2ja9xpnFMRBgVoqoksmXRE+1+AnmTaYvCiNoYWWJyZrO+LpkiGO
CMxtbG6F2UjqqOpZHEU7liQlq89vVM0YFSQmgWuAmQ0BbKEgPsaHx4zEZ4cVMewMNCbgsAUU
/thLy+f06rfzwykdGC0mDZOt7uP9at8UprR8FKvhCfGkOUNw5Hgh4lziNJXXYlXuRL8vnF+b
j61jhp16EL8QOsdOEJcd1SheXH22JMj97exoTLVETd0IoYXJV9Rd/EAIhKHmZjFAgIWz6ru4
ALUCrWhA0zMQ9I2xkjdaHtCXAR5HUkW8w0Lg4oRi8lviRDA44ajhV591Ala8MBrn5h0EPt4U
JBH5LHXLIZcuwjlSCBnFCygiHVwlGOxoRNRJ9QCLptkru2W5XlH+6xHgP08xecygnoO8ZggF
2+9NISEd1Ct79gU47pdKizHopcoZFSsrZ/QqgqYudLs8BVgA/0H3gdShnKGqO+u+39XjJr0P
D3FT0pPhsHrTQR7+K+zzB+nIn1bN/W54RU7Ge7jnviKosWC9zeTwPqArpvaEU22E7w9oddhD
LmSco+jKmyGhBSjNAmIvWg9YenV/tfX8wZxwhP6AJIo3h+QOduGZrLWAsrt6Vsl+RvRhe5h4
5la5JSAMtsq7DcGhKwnq/Ip/fn2YaX34+968h3+Kv+Bsz3vRjkwhNe0MnIVx1BCsj1ezrgYb
1rXOocERzjDomqr3Y4DbDv2uW/637pKnwaQbxHJ7H4QJHEL8aAzUX77eZ9sD8fnyJh1rB46f
QsfoAe9kWVWvpD7ytW4d7PKkx0W8ESkUsAAAIIpJREFUxU1J72s9W8KxQ4Oc+Ag8J67r7InM
CbjOwqBBKUCQZm/A6wpOnTME28grvG2i4LrGroUc8XqNgPZ8CK4oC6UmQgtFJHgleFybvi3B
bBHJCxfX3i4L0s+cQtAEnBZZlen/wk0EX2PfoV0p2ARbZu9EVBwne9Tve6kiIu44PUCt8A+h
HZVLEL/dcGB/DfovYIflgeX2y0H7gLBGVLwjsIqHIJGMI8xZ4ZHueaE0jpTWkjzbg79pUZyg
gyVLFDNpbxggkhgEh4YI1gYvPQJuzuDXn/juffEg6Infedo9afbTt1qrZGSunO+9kQr2Yp8D
LN3c0Unu9NvgcsdUxYtM2fUpbkp6/8F92a7UNNuD2pT/6VpD16qcXDFly9agb1LH2ELSJj9a
39lYXrDbqdYVPlo7AKyA8+zQvFQXTje21N1TtD5ULzgiB3uBoEbgstDr2FfouDW28Za3yUUL
6i+XZfnXQaMVu607Vl1TrUzV/3AsJngnuFNHQTBiQ8LWDpHYPJr2u3gmfec6OPHcVxvQFODb
DoB/n4Uvdyt80TxgLG38KSwFHrIq8IaWA8eyW85H/d7uqGMnS82O+IgbEDaTH5LYvClehbEu
MoCIpL3wUAYvgFCvOx3sLdBXwbMLsc/BdFE/ONLCTf608psJzUMhy3UlbG+vR1WftlvdnKGD
78au+rONB0eYbBXgwTGQVj0XD9y4KWk+Je18fPS403dXOFSFMKj14/4Bu6tPd/Huw2luUGE5
3b2PJ54WJHSZo1odfBp3Lx39YysEJSgR/FNsm8+wAxO+XGDA5YkwuY4XXnFl7a2SS/47jtlC
FucQtFk+MFfdIfH9znWBmuck6K11jk742TQm0f0RfZkwEBsZhgz5N50Uv4kYyTgweBBpxSit
OpCKvS26qMuXJ14tVGJlBaj4ExM8/dLSOLcnQ4eQUCehoOg+gl3UZf/0rL3o08opCSHoi763
4jzBLf9Z48RhTrQGeG8CfPe+RuzF0Y+sSscwv9C/j98UD+y4R6mga5PtbIc7KgPLHsEwHOXR
dsB28OaQp3kE1NFsCQ2JkvHr2h+dqtaIBVDbYcLtZD1nJ5C2Q4D5SIc0LJD/B2A0qwFqn0Oh
IZlo9uLKhjtE0f0MdOYdxs7tNeHh4a8irwvigLbaJFvtBXiaDzD/Xlc9q3R1ou12Kj1p0/h1
dSWO0cLXQ30k4fL+zft3gVG+1moZZNoPTa4rSA5lFcaJyMeL6X2AnEUdrA1VEN48eHT/0Ld/
NvmtRHc5l9z/p+tEj+t9GL/QmYjkZMlWmFixxS2J0kWt/qPLCJAnNeMS8ED/FO/p8PFPKo67
xO6gpgoSvzGgCxFHNVH8yRZkwX29XawBKivQVzAcm8Au5h8DC2Dbxhc4KqvNqyqfRfS5Ydha
kICxhLTs/tkRMGM8lFTWL8ERXU8GedB2ezt6YUBbHSydjhTLVkvQty+zyg4IwSGZFAxKfhB6
PlHXHUd3PEWIlVQWoex+NTmRUv3+X5GKmeVgcHnbj4y1zd60XL6FjIos9tElWcaJ4L96r+Ka
y2ueuK3DR3q84C568K9PGympL2kYz2QarkuCNOGB1xMa153LOjyg+RYdpxRtmDv+c3oHdswE
pisPd07X3XNcSLpw4bph8N6EY5psUFpmDWj7r+1vvDtve3cVOlniYT16re268PzevUrKEdtw
2gHIMv9NTMa45QjRyiU9d81Q39g4+0sR/GMMHFsfF+5NmcgZV0Urs3Nc4cKPh5UtX/9v1GWa
k0LCzuUQO0NR1Q2d44tVIc8WAmsHKAjCEd/RI//sDP94Px954JpDmJqPm6wig11VUFnXt3ZW
4dPo281W6wLhoQzx4x1W85+IfKB6x/hU/dEPH7zye4mWf97Dr9100U/+uRk87e+o6EzzfEQS
OsopcFlqDEwUXnh6yAd+ic3vo6E4TDUBu68vQs+xrnEhaYH5C0iVzG6g7SHOzvyXXTi9nd/0
XWBwhXYWJeJH40TizyEoIEarQ8HAcVS2cCl2WQap3v20c4WAom2RsrqukCrazIlRXEeGyiKL
UlDP00Q5czPOT/ySXTXCENzurnRKKyZEFyQNhmVukC3fXc744gOqvna99/zW+FL3cirV/wtB
dnlJmwV+t39Cpfl9geuJtWWlZBoMWLj/B1SVrXFhpWyreQQmqx+pFz8Qb/7JcApV+uM3x47/
6b+qeTnt9+CJDQvqV8NNKbktJe0QsE7A7Ld8QgsWzEsFV4pbZdpHVK/RlfWF6FiToo63nnEh
abjtKwsKdeIFGz2dOSk55hiPNnop9mN5TSsTSOHdRjD9J3D6RyE9ZBugzKzFlXU3gfJMswsH
lnEbGmeUdJEJQLBhbzHB2oHZXHBkQP8oEusKvmRJ/b0cS92INixxQjc5nn4gN7W6wXXZtcHV
c6EG9oCdQLrRmMJ/c+r72qkL5a2eXbpP9be9Sfshl+y6ddSy1f3VDM8m7Fy9VmATgYKdQgZk
Bg9ayX8i8vj4tnfi/R7jHnnnsu3nDPlEcqfWaaJQjDM9TdNxFQabKu026ScG73UBXjAtBomX
ygO+tmUhJ2YezvgOzEMTwoFxbZ2hnlUM/1oWq3ksG3i0ulfzOe645FgJztyJol5IPD57gVTn
NWe2wrCO47imu8DQt1UlorIg6PprVCC6sQeerYZEfRdnJC3C2HHdWLq06UqON940dG4P6LGx
GP8XQCPF8dNPYlWL/JCIHN9lW8lJciEHS0PUy3IgrykKU1+0DKAXMrb6/XNS3eJXOFVNTeVS
b6m+fczjxUvq3hR56TorevWUBz50HixaUPN67ezik37eVv9g0r6eupW8KvZR+l7BOPE+qL+N
h8tMJIdRGHEJICINMvyCW8qQVxzSt9ZEzRJvvt+CzzIMPdCvVvTfSPUiwb+utzXWzRi7lZ7j
DfFR0rwBEj1ekN2ng/38gRRJ77Eju899/N4YnAQn//h4NoKG7b/qbfvQBoiOrOf2+ziNF4RS
O+wXAkYsK2xeX+oAHHaDLfJWkxYOi7Nya/rbMPRMQzNuAG9rBrbLl8D/yXFH0FR3XVVZi+Dv
gqThzCHX9nDWjH1OHSZspZ+j5dkw5+zNAsdWEeKBM4KbKY1fE39CFr6WAyhqXhZM9ollGBYz
ytNeyCemi8XsEdmKHl8zJVUfuEuX3S+rPDeeNDeCqnrktjTI2jBZHaCkzZNZoC0D4xe8Ax1L
SNxCOEP03wxkv55NHWfuUt2878K9mtZJqyo24JhIOu/xD/vBjHJobFBxpNC1XZ3PmIsj13FP
gjPvioFcbJULzuDGxrnjD9oC0p7ZJ6bfCqOadFuwwIRVAr49ODrsg2hwVN6Aiaq9NkeDe0Lj
sJnZMHXcgfA6jMDBs0BiZ4bHWbnX+ZNTthJQlcUCnZTN8cWFi9dcuRYntmMH1WCljZSHdkci
L19asLTuPKswuuYD4g0/MKBrAjOGk0U/rBytI2nwnPMX1swqWtK0ATygF5ko9NUI5xMCNpEx
XcPvCUHjHFJC2vQefGmwP9RmXX+1myoGoyuedkd7j71ait6qzQ29g77I8N0HSyLGY+hdT9eY
7A5BSr2Y+Ku2LO9QA9IqUFSlrvMZcz1V7kS8y5vcKOO0k1x7ZZue7960B+NYboEzHqJDWO2g
UBrp4Ed3SxFJAf1f5mHzx4o9pe9ISA0DHTJgiOi2NDFjAtmwQA3RevuoMw3NkV2S9UpEz9mm
p/yZU3xvSbzwZZ7z3Acs+4ZaWbtMEt0Lrbqh1TSFwzFjs1CiQ94cwVhYztqit+BYrH/B9RvZ
HQES2oFtlkCAfvfofYUXAmv9AW5Xc1QVIkGoa8FWHC5JQ3Do++MhbJdBM8wcFfhDVotg8x7V
A8r5OGmo624sBIaue91Q0TN2hhgmEJBLR/yZfF35yA6NDhhs3QPo78bLMw8HH5OSFgV+cuQw
D8+eyL1Z1KpEcpyQtBcqF4Py6PiUVupA2XUWeMdK3s55ChbVTQKbom+IR9b5fdzPvNB8mPd2
axkn8t61YKn03qGpcVc0mJD451DNSDBX5+R8FNaacbVdtg58z+iKHljdubST4Zl84viZcgec
vTKB5y4qXlYzQt0nLQd/GUjRRn9y7Jtj5lUPPb5tBDL/9U0JIeixj1WdOfZIyUeyJPyLE/gc
nPeIZhPDGT/0SZDFQVfykIcraXFAQEg/opyJ9WG43VC7k1YdPOobW3d3UcxdSArUuMIp/oAh
X5YueeeE+so0CtL1xtrpxZZ8+PSMpCGwgvAH2xwbPK32mpKVXEDQ/hWq+Ml6haBpit26QQ8e
bC8p5seNpxwZTnNIvc1OIHVATNKazbvKukXCnoPeNvC8t9opx6m8hKDhQvRP4GXvtw6T1O/U
vZ3zoycmhlNPnd/H9YzzKg1VA+V0coZ100u2tvn3DQUVvZ3TxeVk2aYy9oAdHE3sv1S31EEZ
nlwtD/KtcyvXX8WlpW2Ff+hxQUFpvLslLF4mUQBELkjb4FN7etO0MRN23BefLnPb8pt3hVs1
giIXgDffC/XRB03DXdiLWN6F9Iik8/s0ZIsed7ZdgRVVFqdHNK+dVvJZqOIn5RU6oSLPXUwD
0l7gAl61JSEKIFp5ZcuWSTi5+3q7OxnzRHBVWdTTVovYULqqvUaqZScyEFsMutzvVpfn34At
p99WXTQuAsmfC2k7joc6w+54xunz3kNuFgHbVj17IfPamedv8+n6baInbWLBwrqrMgztWRzM
0O0iHasKQfVZ/obSJY0zY6U97u/vWi4O/sUHX+Uk4XXaw5p1TaASQVVNeE/WtO/k9qk6Cwh6
aQLZO5IWLqgdUlJZdVHdtKJXa2YUBNlhIHT7p0pc44y8lo6ECd70iKRhOzsQFIOcIMzoyXne
8koSHaDzsSULq/tzomtgoh85vCbEC4VN7ufrZp6bsIAgHA7dq9r5/wu1Rdv9r+nq/tqZxSs6
w+/83KwFHrfrF6QzzESeaYEAq3glTtqeGMzH7Uokf5e0PAdm5LHg41sHgjdpqz9NKl8z1n0x
dVxMnuqxkk/MXeOM/LcVX/MKSXb9ahUOG9Z07SMan1YDzQuMx4V5OHTCKoxgPlC+odPFKyq6
4qCrXne5Zv9xUlgZPVd68F1av8zsOYmoqJrsNBAE0DH8FIvurc1tB7LXlY/9rZ2ThXhReItj
0qGwejMijOpsHvPXtYPCSoAaWgn0o9ES+wGI4qRndRiC6zTQ/LYmMW2bdI7ZFhqSdR5cRs4O
btvs9b+uc4/FA2EjDCKgFTDPFu8ynoKipcGEASn/26ppY4+xm9qP9oqWPHYcRq/BvohIpwtD
MZFtbRVocvOc9rcIuCfxQ830whthdTkWso274BfvcZM3a6O+5DfcLbp+e97jH3qsgwGveeWU
oNL/F6PIsVckEv7bJL/BBYLsJELmd684vaeyRvTbKOHklTPi2gGbAkFJ0Tm9SlECExrvHHHO
2mm5v9s5d7wlox+zXlhoSpY0fAKLT7WqvKCup7paedcjkuYl6SInjhcChUQyVNMs0kolj1ce
XYDTHU21tSjRVloQjD/brbMWcJ0D+SPUxewFXnQpmhq/Jz5vW+uj0OYBC/P4BdIeUpXAnVAP
/E5EqTq3LuI5wQf0X8Tk5yXuXCx6EXEJgiTePugW/fVE853I9HCR+R23J22R37/jE2hpRRGm
Jly7sW2e9E8SzhUtw/KbwDYKmpGEvw7MvymI7AiZz5+ynd38u1TwfaPiK5/qpvg0IPtwEBH3
xPIjMxWca/lYQNHGNN01pmzDjLxVEYkmr8jsoPAjXvT8UDxgym9EQTrb33L0mz2ntPY2aqND
oECLXBK6t3WFoIXTjO22YByHzDITJtrVooCwS2/27XzfdnVF4V5YPfb4fWKVwUHtSAl4G+h0
4lhpQ+/Xzhm3S1XavntceNOgauDoaLviN86rm1n061AdQlddUTc64fM5BA972wuP3Vu7A7sg
cCJdk1qpdc3Mot+qgVZR9pz5d07nKuywPKh8Op0cKn754E//1Ep9eswDyjmHEHLn0N/dx7O/
4Lxo+tVu8XMJaD7F3AF2xtO0s2X8HhhZPREIHMpsKh/1/Q3lozZ3Bk/P0un6UNbX44r2Lmoc
UdCVjUskSbq1zdda3HBP2TEq2kGfJ90igVGPre6PBe6MqJVLJBJ0iwFMwXxsbyLZTkRaTdMv
s12uIDZunD3JlsCrcP6n+aIgXGO3LkTVq7xG+q0JhdqZpc/CfPwXTniK665gUPhQGtKfM4yj
I+pm50bfZQlaI7kS6A5GrHjYykWOb0MbFytPzPecsDZmmpMwAcbCfIFnZ2tM+y6QtOU+DTWN
dtgQ7P6g6PGavFCcU9c9h6Fx2jnMm/J5lqRVsQ2jIuQMlEziM/ri5EPToITGPP1IfdPA5+c0
9j9Hdh8d3jh1zJzOnh87F6E8/o1atvzauGQNhU/Uji7JmbwOZvPTfGrLtxtnl3acu0jvRv/m
A1D2zoTIQRwGU3a7JuBs97AYa7d0WjbOBl9vl3lurfT4c5FklvQq488RPaWhBY6tptGTxI7l
5VZFVx82BPETGmxBZ03dfqpu4WEy1jdOL4lqYdhtpvYX1TPyH1A15ac4lw0xtjgEHUUR94F4
ulBRbMDJrVeDf3fzmnaT2Y5EYTfwWPIF2g79w65zNixZ97e63sGTHr2wdhh2FpYd5YQKAUXm
iGplCN7xutaUF87VGbddFMUyINjEB1OUigINMiHV9XyUV9aiyp8eaPKqXw1DlJNXeBjOGiSA
O3EsF3vnYpWVryDWRseg5HUjB6bvgjlXsBLB5zrc8bLlPOcf2FA+6tEvKpwV8hYvrrtT9siN
As+PBDGztH56ye9DDYYHzYEtnOhdf/sFljVpQrBC124/ligaX6ZG2/3BaoeUYl4NFXiyXtHh
l5tbfBttJvUxTWfVdttYN6toS+20vAer7xpz7v5DWj9NUX8IrYtNvCgH4t3+U12gY/+0nbrU
TM/7X43p1wG5eeMtt7vygGyxAeSOwlfvtDXTxhasnpkbk6/bd8+hParqPRBcpBIci8R/hIQv
VB8PDDuc+L6qrteEYJ5iV3iH9V0G9UbbVHRHu0Gxgr1XCA+HT3bE2bmpvG13KHv6jJey2Kzn
MoC0veyZ23zy3StuCr2DMyQILY/xsVWJjSRCQvUHiO98wOv1jls3bfTUhjsLbKvBdpRJNxjB
RQtrrpBcnmWQTdCicDjgYz8Mpcl/oj7HpakjNzvsLz86qYzK6Esb3w4EyGG6vW8KvUWR+fQX
Qw05Wa+6pm2BOfgcHbPQah2x9RF5Q/iT1fzR8m1/oPDQdsZ+hhHy87JlTacrinauJIs3YcP6
NVD+Jn8w2rwjpzp+w/u7aDATiauZmvuX4nnVgw236zaRE+4HJTyAxkQsrROYoGPe0KKlYvrw
b2iGsUBvVt5NZEdFutsFC6vuAHIdgzZ2INx46o9FildV471QWtjfbQSPe66aIJxQfrqKEodT
5Ngr4XGn0j3UMDdAZzpPkvhPsadJM9kCNhtAYw8WsXfAU96TiXjKI1/OK9O1HPabb3bsdsKr
0uxp8bGj3iBrY8afzgzMv54odi5t2u+yW1y+CB/eHBNzTVsA3fvCtnW1lb55k9ccg0UU9zGE
fiw+8buSpU2/FWTPTVrAx3GidNB3uOWcxv8ZZ/rnKZu3epAqaIVVs4rfSBxyzzk6tgw9J0u+
Pdl6YMSs113pY864EYch3ySIchHMX83TI2jSEEsBFPATNdPyO0xTnap//tL6y2SN/wZsqkoF
Xu4HDmAKKAwXWCsiJj1R+m0QoTdDJ3cd1N3eaObZHzdNLzrp5RFO9c+pAId4ppJHXoUVvr8T
iBqrMAL/j6ppuVfE3/4KPm1WblbLwildtU3uer4/6+P1s1/eHmIZUAlBntddKzJlmZ2hMW6I
5lOqyGx8VOXaV7Ho7FlfPuaOjvJJdQ+aIZ7yleO9rh3VbN5cyyp2Q6BumO3J/AzykdPIjoAT
5BZfW+sljfeUfErlEYtD5PTJteUFCzvKd/AmiaQd7MwTAgq7nrLlazxevzhalqVpsOO/VZA8
QttRf07j3Dxzle+NetEJLFvPHCqmtrWJaZrMqy54tPDvM1SXSOp7ypq7ykBCO0PB9Eb9/9th
0onVKWn9ngAX6rtOIGoiDEBTv39o967Lt1Zc7IurfysqRNaYK5ksjfAM3wKbY4CcziAsDI8O
v3ff/dLPfVLLT9hjt7SOXbLuybXVLeVsedAlaHi6IO86+jjMr1xTyLG2HfXlEw5F5jn2VLyw
4XycbbsUsoh8ioV1oq8toI2Bd8Ft9IydCU6tYlNq+6+rYDgUmOKcDkkk7XSPnmh4oCCKLskr
q52W+2kSSZ7oj3GSlw9vcWUHC1YBkTlylFkQURsfBJj/rsZppU1RW4/x6e4vnOlbcv3mqO8p
cvJkgeXlGayRiWzlgwq7+dkU9uwt7SyOIPtCnvPilMC8G1e45r4watSI3H3eV99p2zZ8cLFs
6NtawWVjnmYf25LeZgoiuymopLLuvexW46p/RLEILFrUdDMnGNMFjjuP1HJJ6A0+6Aa9LfD1
2rnFjQSyaEnDFeDnnV07s/An3RThSHQSSTvSjUkgyR44NXtgYsUWd/PAtr2gptOdaQHQGZQF
VM24tu+e3X8nuYJtuMS6yGsyWMWDpFtnBA1OmjwsOzeNce4stvgrQJpA3hUrJXZgN8cWzoYf
6hWy6xB/l3/+DYu6K3/Moqrz1s0s/TeDf43iATVXcZxUigIKeYNBiYDPgMIDwAJBQ76CS8PB
3XvODu0SShbVTkdL86pmFs7sDr5T8ZDuJEOyB5I98N/aA+9UDPMFmHYFqZTbNXIJ9iHoThw9
Bx/orx4dOPCz0sX1FZb6lhBzKKycosv7c/Oku/80w4wauBsKD7leSeAHyWIArisQZrw40nWU
v9RE0HiUDglFvF+Pavk78ekt7pLKhj/JTCouWtTwi7JB63fCpctfwXN+GMe83QBXwxnmaTbA
zEGHX+ypqrcaiglBT15hCMVLG/8K19TK8UDQ1LQkJU29kAzJHvgv74G8BQ1FLln8Gzb1g6Jp
C1ntHvgoB0fAeF/xaZMb7klAJW7WApeJcO9+PocFIJBe8q1DmTNfGeZ1tbgCzc2bXCzzjAyR
33PUJfzc0P1PdpiRhyr6naf75BePcwku/jZe10bi4IInRUE+YojCLKimfiaJ8k85Q/eYLBpo
IHUJZJ/A8X5F1ebWzcivpPcFy1aPEQ3PMghbflQ/LbdDc6hLXocjkkja4Q5Ngkv2wKnaA3Dq
lanrnp8LvDA96MPcOfQAo6hWaEZ8Aq2fN+B+97W66WHO9MknR0VFdNVXUNSpfVhB62nZDQys
E3H2H8arRuYatnCSX5z1x1+JIrfYN68rfzsX7lk9LteLoOrTiRQ1LVc5XoMAUCKWCQLKM45R
62EfzaSeGVvj97V+vfHucdvxiitdUncPDqX9VqD18OVOHYsXVmSPt859hR6LSb5M9kCyB06V
HihZXH87L4rkTqDI1PwgfOZAIKqVfkCOTDH0B92B5ic+nv2lo2wiLArfuc3HRsxysSFf10yr
wijlSbNeKmKCl4MN6iGcqpIe8B3ZzJZPbeuctHh+9UgxNXWNrgQS4rNT3WBw1QbfJAvgLvcH
VNGixfVfl0TxpxozPqyemnt757KOx3MSSR+PXk6WkeyBU7AHCpfUThcNfg4sXUfoOOfQySbA
NYDJbNVU/V2dqb+AcM7DFKWvLzVl5fodo1vZg6RS0a46N7lCNrU8QAG7Z794sU9orpWNvk8H
Wg7exX59ZxerwsLK2jtk0fUkHJTFXWWyRoWBVn1Lq/eSojM2H/p069DsrPSUpYwXr2aKdsH/
t3cuIVFFYRw/555774zjNCqmi4TUaBFoglFGUdHSTcvATYu2ThlC0LbHplWgFemylVi0q02r
JHsIafmAkF6SUMIsVEZz5s499/Q/dxwQUUm8M83oNzDcyzy+c85v4D+H73yP0StNI/9sLOAP
Bgo+4LmROSJABIqAQOuDiXPMNJ8ZnO/fQcLmhivRh5U6S0XLsX/lhoPTuhnsgr8iumIWUj7l
cctZSfKB6W9DUeyc/UYQZ5/8rpldTiVnLjemELMfTtQwJFNV1UsVno8Kbxg5040bDrjmxezY
OriOvU5J1ZVOJL+X10Q67XCkG6UYalGO4N7SvLw5feNILqlmzbcLd0siXTjWNBIRKFkCush/
KlIxiOiHdkQ+oFurltR8PlBMYLW0gC6n47oZbKzZPMohJBBZ4eDarCOmoe7JbPigFltfcP0d
uu+m2WR6fhQLFw7iUKakm76eVqGJiJC3sXXvNK2Qrm0+aWdUx0hX08ax3pvYzdfLJNL5Ikt2
icAuJNDSM94sbKtfCHEaLpD/sEJIllatbf5JaGHmBrqBey7KCKu+pYzsK0OmoC2sOMS5EjZt
lFaYQ+eZS4ZwhraqzljoRZNIF5o4jUcEdgGB448mzyvDuoMgiTOoAVLUK4K/2/E8NQwBfouj
S2FYdh0OBy/ivsx33xj8s3LdnrF4S38xLoREuhh/FZoTESgRAi0Pxy8I03oKwQsF7a8ODIFi
KPzF0sIM7UO8tA7AY9y0mYTfG1Em8an40ZeBjZUHQyTSeYBKJonAXiJw6O6HioqqcqRJs6tw
KhzQO+sgE2KCYKlrkmuPNYrsJpjkj13PGUDLtrEgbOfbBol0vgmTfSKwhwj4pWw9dk1Y4RPY
WVdni+MDwDZ9yDtGpk8bMSYSUyQSaRYyMjWqXHkfNbWf79h2gQ2QSBcYOA1HBPYCgZO9X2J/
+Eq9Jcx2ZBh2QDOP6Uw+/fAbRgQt2hjA8GOvsVtGmjfMT+JuMO25L8Km/IGDwMVS5U4iXaq/
HM2bCJQQgcO972NlZqyNM9mGeOtWCGqD4EL3JkTXWRnN7rThkNA7YF+V1kvTaiA11NcPvcPa
IcvLaAuzgIpOc1K5P+Fr/ojU8zGWZm8+dbculBCeLae6nsSWH6Y3iQARIAKBEECzCnaL8Yb6
V3Z5orbSiMo6U6oGzxAHlaliQhnVHvQ4Nxb3PBTmx5PzXxklZ9hyZjZmuovvuk9lGwzkshNz
X6ArESACRIAIEAEiQASIABEgAkSACBABIkAEiAARIAJEgAgQASKwbQJ/AQb4me4AfccBAAAA
AElFTkSuQmCC'! !

!PolymorphSystemSettings class methodsFor: 'desktop' stamp: 'AlainPlantec 9/11/2011 07:04'!
pharoLogoForm
	^ Form fromBinaryStream: self pharoLogoContents base64Decoded asByteArray readStream! !

!PolymorphSystemSettings class methodsFor: 'sound' stamp: 'StephaneDucasse 11/11/2014 18:28'!
soundSettingsOn: aBuilder
	(aBuilder setting: #soundEnabled)
		label: 'Sound'; 
		target: SoundSystem;
		noOrdering;
		with: [
			(aBuilder setting: #useThemeSounds)
				label: 'Use theme sounds';
				target: SoundTheme; 
				with: [
					(aBuilder pickOne: #soundThemeClass)
						label: 'Sound theme' ;
						target: self;
						domainValues: self soundThemeClassChoices]]! !

!PolymorphSystemSettings class methodsFor: 'desktop' stamp: 'AlainPlantec 11/30/2009 06:37'!
desktopGradientOrigin
	"#topLeft #topCenter #topRight #rightCenter #bottomRight #bottomCenter #bottomLeft #leftCenter #center"
	^ DesktopGradientOrigin ifNil: [DesktopGradientOrigin := #topLeft]! !

!PolymorphSystemSettings class methodsFor: 'desktop' stamp: 'AlainPlantec 11/30/2009 06:33'!
desktopGradientDirection
	"#Radial #Vertical or #Horizontal"
	^ DesktopGradientDirection ifNil: [DesktopGradientDirection := #Vertical]! !

!PolymorphSystemSettings class methodsFor: 'morphic' stamp: 'AlainPlantec 12/10/2009 16:02'!
uiThemeClassChoices
	^ UITheme allThemeClasses collect: [:c | c themeName -> c]! !

!PolymorphSystemSettings class methodsFor: 'desktop' stamp: 'AlainPlantec 9/11/2011 07:40'!
desktopLogoFileName
	^ DesktopLogoFileName ifNil: [DesktopLogoFileName := '']! !

!PolymorphSystemSettings class methodsFor: 'settings' stamp: 'NicolaiHess 11/17/2014 13:03'!
appearanceSettingsOn: aBuilder 
	<systemsettings>
	(aBuilder group: #appearance)
		label: 'Appearance' ;  
		description: 'All settings concerned with the look''n feel of your system';
		with: [
			(aBuilder pickOne: #uiThemeClass)
				label: 'User interface theme';
				target: self;
				default: UITheme standardThemeClass;
				order: 1;
				domainValues: self uiThemeClassChoices.
			self morphicSettingsOn: aBuilder.
			self desktopSettingsOn: aBuilder.
			self soundSettingsOn: aBuilder]! !

!PolymorphSystemSettings class methodsFor: 'desktop' stamp: 'StephaneDucasse 11/11/2014 18:45'!
desktopColorSettingsOn: aBuilder 
	(aBuilder setting: #desktopColor) label: 'Color';
		 description: 'This is the only color of your desktop if no gradient is used. If you make use of a gradient, then this color is the first one of the gradient';
		with: [(aBuilder setting: #useDesktopGradientFill) label: 'Gradient';
				 description: 'If true, then more settings will be available in order to define the desktop background color gradient';
				 noOrdering;
				with: [(aBuilder setting: #desktopGradientFillColor) label: 'Other color';
						 description: 'This is the second color of your gradient (the first one is given by the "Color" setting'.
					(aBuilder pickOne: #desktopGradientDirection) label: 'Direction';
						 domainValues: {#Horizontal. #Vertical. #Radial}.
					(aBuilder pickOne: #desktopGradientOrigin) label: 'Origin';
						 domainValues: {
							'Top left' translated -> #topLeft. 
							'Top' translated -> #topCenter. 
							'Top right' translated -> #topRight. 
							'Right' translated -> #rightCenter. 
							'Bottom right' translated -> #bottomRight. 
							'Bottom' translated -> #bottomCenter. 
							'Bottom left' translated -> #bottomLeft. 
							'Left' translated -> #leftCenter. 
							'Center' translated -> #center}]]! !

!PolymorphSystemSettings class methodsFor: 'desktop' stamp: 'AlainPlantec 11/28/2009 15:47'!
desktopImageFileName: aFileName
	DesktopImageFileName := aFileName.
	self desktopBackgroundChanged! !

!PolymorphSystemSettings class methodsFor: 'settings' stamp: 'StephaneDucasse 11/12/2014 14:08'!
morphicHaloSettingsOn: aBuilder 
	(aBuilder group: #halo)
		label: 'Halo';
		parent: #morphic;
		description: 'All halo settings';
		noOrdering;
		with: [
			(aBuilder setting: #cycleHalosBothDirections)
				label: 'Cycle both directions';
				target: Morph;
				description: 'By default, halos only cycle from front-most submorph to parent (shift key down). This setting enables halos to also cycle from top-level morph down through the submorphs (no shift key)'.
			(aBuilder setting: #haloEnclosesFullBounds)
				label: 'Encloses fullbounds';
				target: HaloMorph;
				description: 'If true, halos will enclose the full bounds of the target Morph, rather than just the bounds'.
			(aBuilder setting: #showBoundsInHalo)
				label: 'Exhibits bounds' ;
				target: HaloMorph;
				description: 'If true, halos will include a fine rectangle around the bounds of the target morph.'
		]! !

!PolymorphSystemSettings class methodsFor: 'desktop' stamp: 'AlainPlantec 11/28/2009 15:50'!
desktopColor: aColor
	DesktopColor := aColor.
	self desktopBackgroundChanged! !

!PolymorphSystemSettings class methodsFor: 'morphic' stamp: 'StephaneDucasse 11/11/2014 18:46'!
morphicMenuSettingsOn: aBuilder 
	(aBuilder group: #menu)
		label: 'Menu';
		parent: #morphic;
		description: 'All menu settings' ;
		target: UITheme;
		targetSelector: #currentSettings;
		noOrdering;
		with: [
			(aBuilder setting: #preferGradientFill)
				label: 'Gradient filling' ;
				description: 'If true, then menus will have a gradient look' .
			(aBuilder setting: #flatMenu)
				label: 'Flat appearance' ;
				description: 'If true, then menu will without 3D like borders.' .
			(aBuilder setting: #autoMenuColor)
				label: 'Computed color' ;
				description: 'If true, then the menu color will be computed from world dressing.' .
			(aBuilder setting: #menuColor)
				label: 'Menu color';
				description: 'The menu color to use if it is not computed automatically (see the ''Computed color'' setting)' .
			(aBuilder setting: #menuSelectionColor)
				label: 'Menu selection color' ;
				description: 'The background color of a selected menu item' .
			(aBuilder setting: #menuSelectionTextColor)
				description: 'The text color of a selected menu item' ;
				label: 'Menu selection text color' .
		]! !

!PolymorphSystemSettings class methodsFor: 'desktop' stamp: 'AlainPlantec 9/11/2011 07:16'!
desktopLogo: anImageMorph
	DesktopLogo := anImageMorph! !

!PolymorphSystemSettings class methodsFor: 'desktop' stamp: 'AlainPlantec 11/30/2009 06:32'!
desktopGradientFillColor
	^ DesktopGradientFillColor ifNil: [DesktopGradientFillColor := self desktopColor]! !

!PolymorphSystemSettings class methodsFor: 'desktop' stamp: 'AlainPlantec 9/11/2011 07:24'!
showDesktopLogo: aBoolean
	ShowDesktopLogo = aBoolean ifTrue: [^ self].
	ShowDesktopLogo := aBoolean.
	self desktopLogoChanged! !

!PolymorphSystemSettings class methodsFor: 'sound' stamp: 'AlainPlantec 1/10/2010 07:54'!
soundThemeClassChoices
	^ SoundTheme allThemeClasses collect: [:c | c themeName -> c]! !

!PolymorphSystemSettings class methodsFor: 'morphic' stamp: 'MarcusDenker 7/4/2014 09:55'!
uiThemeClass: aUIThemeClass
	| themeClass |
	themeClass := aUIThemeClass 
		ifNil: [ UITheme standardThemeClass ]. 
	 themeClass installFullTheme.! !

!PolymorphSystemSettings class methodsFor: 'desktop' stamp: 'AlainPlantec 11/28/2009 12:00'!
desktopImageFileName
	^ DesktopImageFileName ifNil: [DesktopImageFileName := '']! !

!PolymorphSystemSettings class methodsFor: 'desktop' stamp: 'AlainPlantec 11/28/2009 15:50'!
desktopGradientDirection: aSymbol
	"#Radial #Vertical or #Horizontal"
	DesktopGradientDirection := aSymbol.
	self desktopBackgroundChanged
! !

!PolymorphSystemSettings class methodsFor: 'morphic' stamp: 'EstebanLorenzano 5/10/2013 09:27'!
uiThemeClass
	^ UITheme current class
! !

!PolymorphSystemSettings class methodsFor: 'desktop' stamp: 'AlainPlantec 5/13/2011 09:20'!
desktopBackgroundChanged
	| fill |
	self desktopImageFileName
		ifEmpty: [UIManager default currentWorld world backgroundMorph: nil]
		ifNotEmpty: [^ [Form setBackgroundFromImageFileNamed: self desktopImageFileName]
				on: Error
				do: []].
	self useDesktopGradientFill
		ifTrue: [World fillStyle isGradientFill
				ifTrue: [fill := World fillStyle]
				ifFalse: [fill := GradientFillStyle new].
			fill colorRamp: {0.0 -> self desktopColor darker. 1.0 -> self desktopGradientFillColor lighter}.
			fill origin: (World perform: self desktopGradientOrigin).
			self desktopGradientDirection = #Vertical
				ifTrue: [fill radial: false.
					fill normal: World width @ 0.
					fill direction: 0 @ World height].
			self desktopGradientDirection = #Horizontal
				ifTrue: [fill radial: false.
					fill normal: 0 @ World height.
					fill direction: World width @ 0]. 
			self desktopGradientDirection = #Radial
				ifTrue: [
					fill radial: true.
					self desktopGradientOrigin = #center
						ifTrue: [fill direction: World width // 2 @ 0.
							fill normal: 0 @ (World height // 2)]
						ifFalse: [fill direction: World width @ 0.
							fill normal: 0 @ World height]].
			World fillStyle: fill]
		ifFalse: [World color: self desktopColor].
		World changed! !

!PolymorphSystemSettings class methodsFor: 'desktop' stamp: 'BenjaminVanRyseghem 6/25/2013 20:16'!
setDesktopLogoWith: aMorph
	self desktopLogo ifNotNil: [self desktopLogo delete].
	self desktopLogo: aMorph.
	self desktopLogo ifNotNil: [
		self desktopLogo 
			openInWorld; 
			top: HandMorph upperHandLimit;
			beSticky; 
			lock; 
			goBehind]! !

!PolymorphSystemSettings class methodsFor: 'desktop' stamp: 'AlainPlantec 11/28/2009 15:49'!
useDesktopGradientFill: aBoolean 
	UseDesktopGradientFill := aBoolean.
	self desktopBackgroundChanged! !

!PoolDefiner commentStamp: 'TorstenBergmann 2/5/2014 08:39'!
A pool used for testing purposes!
!PoolDefiner class methodsFor: 'initialize' stamp: 'StephaneDucasse 10/7/2011 21:17'!
initialize
	"self initialize"
	
	Gloups := 42.
	Author := 'Ducasse'.! !

!PoolDefiner2 commentStamp: 'TorstenBergmann 2/5/2014 08:39'!
A pool used for testing purposes!
!PoolDefiner2 class methodsFor: 'initialize' stamp: 'StephaneDucasse 12/13/2011 16:01'!
initialize
	"self initialize"
	
	VariableInPoolDefiner2 := 33.
	Author := 'NotDucasse'.! !

!PopupChoiceDialogWindow commentStamp: 'gvc 5/18/2007 12:26'!
Presents a list of options in a popup format. If the list is long it will split into multiple columns. If very long, the columns will be scrollable. Maximum extent of the content area is half the display extent.!
!PopupChoiceDialogWindow methodsFor: 'accessing' stamp: 'gvc 1/15/2007 15:49'!
labels
	"Answer the value of labels"

	^ labels! !

!PopupChoiceDialogWindow methodsFor: 'as yet unclassified' stamp: 'GabrielOmarCotelli 11/30/2013 17:04'!
switchToPreviousColumn
	"Give the previous embedded menu keyboard focus."

	(self choiceMenus isNil or: [ self choiceMenus isEmpty ])
		ifTrue: [ ^ self ].
	self choiceMenus detect: [ :m | m hasKeyboardFocus ] ifFound: [ :menuWithFocus | menuWithFocus navigateFocusBackward ].
	self choiceMenus detect: [ :m | m hasKeyboardFocus ] ifNone: [ self choiceMenus last takeKeyboardFocus ]! !

!PopupChoiceDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 1/15/2007 16:00'!
choose: index
	"Set the given choice and ok."

	self choice: (self model
		ifNil: [index]
		ifNotNil: [self model at: index]).
	self ok! !

!PopupChoiceDialogWindow methodsFor: 'event handling' stamp: 'AlainPlantec 11/22/2010 12:37'!
keyStroke: anEvent
	"Look for a matching item?"
	(super keyStroke: anEvent) ifTrue: [^true].
	anEvent keyCharacter = Character backspace
		ifTrue: [self filter ifNotEmpty: [self filter: self filter allButLast]].
	anEvent keyCharacter = Character arrowUp ifTrue: [self selectLastEnabledItem. ^true].
	anEvent keyCharacter = Character arrowDown ifTrue: [self selectFirstEnabledItem. ^true].
	anEvent keyCharacter = Character arrowLeft ifTrue: [self switchToPreviousColumn. ^true].
	anEvent keyCharacter = Character arrowRight ifTrue: [self switchToNextColumn. ^true].
	(anEvent keyCharacter ~= Character cr and: [
		anEvent keyCharacter < Character space]) ifTrue: [^false]. "ignore pageup/down etc."
	(anEvent keyCharacter = Character space or: [ anEvent keyCharacter = Character cr]) 
		ifTrue: [ ^self processEnter: anEvent ].
	anEvent keyCharacter = Character backspace ifFalse: [
		self filter: self filter, anEvent keyCharacter asString].
	^false! !

!PopupChoiceDialogWindow methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 11/21/2010 21:55'!
newContentMorph
	"Answer a new content morph."

	|sp choices|
	self choicesMorph: (choices := self newChoicesMorph).
	sp := (self newScrollPaneFor: choices)
		scrollTarget: choices;
		hResizing: #spaceFill;
		vResizing: #spaceFill.
	sp
		minWidth: ((choices width min: Display width // 2) + sp scrollBarThickness max: TextEntryDialogWindow minimumWidth);
		minHeight: (choices height min: Display height // 2).
	choices width > sp minWidth
		ifTrue: [sp minHeight: sp minHeight + sp scrollBarThickness].
	sp
		updateScrollbars.
	^self newGroupboxFor: sp! !

!PopupChoiceDialogWindow methodsFor: 'accessing' stamp: 'gvc 1/15/2007 15:49'!
lines
	"Answer the value of lines"

	^ lines! !

!PopupChoiceDialogWindow methodsFor: 'as yet unclassified' stamp: 'GabrielOmarCotelli 11/30/2013 17:03'!
switchToNextColumn
	"Give the next embedded menu keyboard focus."

	(self choiceMenus isNil or: [ self choiceMenus isEmpty ])
		ifTrue: [ ^ self ].
	self choiceMenus detect: [ :m | m hasKeyboardFocus ] ifFound: [ :menuWithFocus | menuWithFocus navigateFocusForward ].
	self choiceMenus detect: [ :m | m hasKeyboardFocus ] ifNone: [ self choiceMenus first takeKeyboardFocus ]! !

!PopupChoiceDialogWindow methodsFor: 'accessing' stamp: 'gvc 1/15/2007 15:49'!
lines: anObject
	"Set the value of lines"

	lines := anObject! !

!PopupChoiceDialogWindow methodsFor: 'accessing' stamp: 'gvc 1/15/2007 15:45'!
choice
	"Answer the value of choice"

	^ choice! !

!PopupChoiceDialogWindow methodsFor: 'accessing' stamp: 'gvc 2/6/2009 13:13'!
choicesMorph: anObject
	"Set the value of choicesMorph"

	choicesMorph := anObject! !

!PopupChoiceDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 1/16/2007 13:03'!
rootMenu
	"Answer the root menu. Answer self."

	^self! !

!PopupChoiceDialogWindow methodsFor: 'initialization' stamp: 'GaryChambers 7/5/2010 15:57'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		labels: #();
		lines: #();
		filter: ''! !

!PopupChoiceDialogWindow methodsFor: 'accessing' stamp: 'GaryChambers 7/5/2010 15:54'!
filter
	"Answer the value of filter"

	^ filter! !

!PopupChoiceDialogWindow methodsFor: 'event handling' stamp: 'MarcusDenker 12/11/2009 07:41'!
processEnter: anEvent
	self choiceMenus do: [:embeddedMenu | 
		embeddedMenu selectedItem ifNotNil: [:item |
			item invokeWithEvent: anEvent.
			^true ] ].
	^false! !

!PopupChoiceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 12/2/2010 16:52'!
choiceMenus
	"Answer the value of choiceMenus"

	^ choiceMenus ifNil: [#()] ! !

!PopupChoiceDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 7/30/2009 12:21'!
newButtons
	"Answer new buttons as appropriate."

	self filterMorph: self newFilterEntry.
	^{self filterMorph. self newCancelButton}! !

!PopupChoiceDialogWindow methodsFor: 'as yet unclassified' stamp: 'GaryChambers 7/5/2010 15:55'!
selectFirstEnabledItem
	"Select the first enabled item in any of the embedded menus"

	|found|
	found := false.
	(self choiceMenus ifNil: [^self]) do: [:embeddedMenu |
		embeddedMenu selectItem: nil event: nil]. "clear selection in other menus"
	self choiceMenus do: [:embeddedMenu | 
		(embeddedMenu selectMatch: self filter)
			ifNotNil: [:menuItem |
				found ifFalse: [
					embeddedMenu selectItem: menuItem event: nil.
					self activeHand newKeyboardFocus: embeddedMenu.
					found := true]]]! !

!PopupChoiceDialogWindow methodsFor: 'accessing' stamp: 'gvc 1/15/2007 15:45'!
choice: anObject
	"Set the value of choice"

	choice := anObject! !

!PopupChoiceDialogWindow methodsFor: 'accessing' stamp: 'gvc 2/6/2009 13:13'!
choicesMorph
	"Answer the value of choicesMorph"

	^ choicesMorph! !

!PopupChoiceDialogWindow methodsFor: 'accessing' stamp: 'gvc 7/30/2009 17:15'!
extent: aPoint
	"Make the choices area at least fill the scroll area."

	|m|
	super extent: aPoint.
	m := self choicesMorph.
	m ifNotNil: [m width: (m width max: self scrollPane width)]! !

!PopupChoiceDialogWindow methodsFor: 'accessing' stamp: 'gvc 2/27/2008 15:24'!
filterMorph
	"Answer the value of filterMorph"

	^ filterMorph! !

!PopupChoiceDialogWindow methodsFor: 'event handling' stamp: 'gvc 7/30/2009 12:44'!
handlesKeyboard: evt
	"True when either the filter morph doesn't have the focus and the key
	is a text key or backspace or no menus have the focus and is up or down arrow."
	
	^(super handlesKeyboard: evt) or: [
		(self choiceMenus anySatisfy: [:m | m hasKeyboardFocus])
			ifTrue: [evt keyCharacter = Character backspace
						or: [evt keyCharacter > Character space
						or: [evt keyCharacter = Character cr
						or: [evt keyCharacter = Character arrowLeft
						or: [evt keyCharacter = Character arrowRight]]]]]
			ifFalse: [evt keyCharacter = Character arrowUp
						or: [evt keyCharacter = Character arrowDown
						or: [self filterMorph hasKeyboardFocus not]]]]! !

!PopupChoiceDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 2/6/2009 13:12'!
newChoicesMorph
	"Answer a row of columns of buttons and separators based on the model."

	|answer morphs str maxLines|
	answer := self newRow
		cellPositioning: #topLeft;
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap.
	self labels ifEmpty: [^answer].
	maxLines := Display height - 100 // 2 // (self newChoiceButtonFor: 1) height.
	morphs := OrderedCollection new.
	1 to: self labels size do: [:i |
		morphs add: (self newChoiceButtonFor: i).
		(self lines includes: i) ifTrue: [
			morphs add: self newSeparator]].
	str := morphs readStream.
	[str atEnd] whileFalse: [
		answer
			addMorphBack: (self newMenuWith: (str next: maxLines));
			addMorphBack: self newVerticalSeparator].
	answer removeMorph: answer submorphs last.
	answer submorphs last
		hResizing: #spaceFill.
	self choiceMenus: (answer submorphs select: [:m| m isKindOf: MenuMorph]).
	^answer! !

!PopupChoiceDialogWindow methodsFor: 'as yet unclassified' stamp: 'GaryChambers 7/5/2010 15:55'!
selectLastEnabledItem
	"Select the last enabled item in any of the embedded menus"

	|found|
	found := false.
	(self choiceMenus ifNil: [^self]) do: [:embeddedMenu |
		embeddedMenu selectItem: nil event: nil]. "clear selection in other menus"
	self choiceMenus reverseDo: [:embeddedMenu | 
		(embeddedMenu selectLastMatch: self filter)
			ifNotNil: [:menuItem |
				found ifFalse: [
					embeddedMenu selectItem: menuItem event: nil.
					self activeHand newKeyboardFocus: embeddedMenu.
					found := true]]]! !

!PopupChoiceDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 1/16/2007 13:27'!
activate: evt
	"Backstop."
	! !

!PopupChoiceDialogWindow methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 11/25/2010 14:26'!
newFilterEntry
	"Answer a new filter entry field."

	|entry|
	entry := self
		newAutoAcceptTextEntryFor: self
		getText: #filter
		setText: #filter:
		getEnabled: nil
		help: 'Filters the options according to a matching substring' translated.
	entry acceptOnCR: false.
	entry textMorph crAction: (MessageSend receiver: self selector: #ok).
	^entry 
! !

!PopupChoiceDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 7/30/2009 16:27'!
newChoiceButtonFor: index
	"Answer a new choice button."

	^(ToggleMenuItemMorph new
		contents: (self labels at: index) asString;
		target: self;
		selector: #choose:;
		arguments: {index};
		getStateSelector: nil;
		enablementSelector: nil)
		cornerStyle: #square;
		hResizing: #spaceFill
		! !

!PopupChoiceDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 1/16/2007 14:24'!
newMenuWith: morphs
	"Answer menu with the given morphs."

	^(self newEmbeddedMenu addAllMorphs: morphs)
		borderWidth: 0;
		removeDropShadow;
		color: Color transparent;
		hResizing: #spaceFill;
		cornerStyle: #square;
		stayUp: true;
		beSticky;
		popUpOwner: (MenuItemMorph new privateOwner: self)! !

!PopupChoiceDialogWindow methodsFor: 'accessing' stamp: 'gvc 2/4/2008 15:43'!
choiceMenus: anObject
	"Set the value of choiceMenus"

	choiceMenus := anObject! !

!PopupChoiceDialogWindow methodsFor: 'accessing' stamp: 'gvc 1/15/2007 15:49'!
labels: anObject
	"Set the value of labels"

	labels := anObject! !

!PopupChoiceDialogWindow methodsFor: 'accessing' stamp: 'gvc 2/27/2008 15:24'!
filterMorph: anObject
	"Set the value of filterMorph"

	filterMorph := anObject! !

!PopupChoiceDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 5/18/2007 12:23'!
deleteIfPopUp: evt
	"For compatibility with MenuMorph."! !

!PopupChoiceDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 1/16/2007 16:07'!
scrollPane
	"Answer the scroll pane."

	^self findDeeplyA: GeneralScrollPane! !

!PopupChoiceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 12/2/2010 16:57'!
filter: aString
	"Set the value of filter, used to match the valid choices."

	filter := aString.
	self changed: #filter.
	self filterMorph ifNil: [^self].
	(self choiceMenus ifNil: [^self]) do: [:embeddedMenu |
		embeddedMenu selectItem: nil event: nil]. "clear selection in other menus"
	self choiceMenus do: [:embeddedMenu | 
		embeddedMenu selectMatch: self filter asLowercase].
	self filterMorph hasKeyboardFocus ifFalse: [
		self activeHand newKeyboardFocus: self filterMorph.
		self filterMorph selectFrom: filter size + 1 to: filter size + 1]! !

!PopupChoiceDialogWindow class methodsFor: 'instance creation' stamp: 'StephaneDucasse 10/27/2014 06:26'!
chooseIn: aThemedMorph title: title labels: labels values: values lines: lines
	"self chooseIn: World title: 'foo is the question'  labels: #('yes' 'no') values: #(true false) lines: #(1 2)"
	"self chooseIn: World title: 'foo is the question'  labels: #('yes' 'no') values: #(true false) lines: #()"
	| pd |
	pd := (self newWithTheme: aThemedMorph theme)
		title: (title isEmpty ifTrue: ['Choose' translated] ifFalse: [title asString]);
		labels: labels;
		lines: (lines ifNil: [#()]);
		model: values.
	^(aThemedMorph openModal: pd) choice! !

!PopupChoiceDialogWindow class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
taskbarIcon
	"Answer the icon for the receiver in a task bar."

	^ Smalltalk ui icons smallQuestionIcon! !

!PopupChoiceDialogWindow class methodsFor: 'instance creation' stamp: 'StephaneDucasse 10/27/2014 07:45'!
chooseFrom: aList lines: lines title: title
	"self chooseFrom: #('yes' 'no') lines: #(1 2)  title: 'Foo is the question'"
	"self chooseFrom: #('yes' 'no') lines: #()  title: 'Foo is the question'"
	| pd |
	pd := (self newWithTheme: World theme)
		title: (title isEmpty ifTrue: ['Choose' translated] ifFalse: [title asString]);
		labels: aList;
		lines: (lines ifNil: [#()]);
		model: aList.
	"World may be not the best choice because a window may want to be in controlaList 
	this point should be investigated based on UIManager default modalMorph"
	^(World openModal: pd) choice! !

!PopupChoiceDialogWindowWithMessage commentStamp: 'LaurentLaffont 3/4/2011 22:43'!
I'm a dialog which ask the user to select a element in a list. See me in action:

UIManager default inform:
        (UIManager default 
                chooseFrom: #(one two three) 
                values: #('1' '2' '3')  
                message: 'Select one' 
                title: 'PopupChoiceDialogWindowWithMessage example').!
!PopupChoiceDialogWindowWithMessage methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
icon
	"Answer an icon for the receiver."
	
	^ Smalltalk ui icons questionIcon! !

!PopupChoiceDialogWindowWithMessage methodsFor: 'accessing' stamp: 'alain.plantec 2/6/2009 09:34'!
iconMorph: anObject
	"Set the value of iconMorph"

	iconMorph := anObject! !

!PopupChoiceDialogWindowWithMessage methodsFor: 'as yet unclassified' stamp: 'alain.plantec 2/6/2009 10:04'!
newContentMorph
	| top bottom |
	self textMorph: self newTextMorph.
	self text: self message.
	self iconMorph: self newIconMorph.
	top := self newRow: {self iconMorph. self textMorph}.
	bottom := super newContentMorph.
	^ self newGroupboxFor: (self newColumn: {top. bottom}).! !

!PopupChoiceDialogWindowWithMessage methodsFor: 'accessing' stamp: 'alain.plantec 2/6/2009 10:08'!
message: aStringOrText
	
	message := aStringOrText! !

!PopupChoiceDialogWindowWithMessage methodsFor: 'accessing' stamp: 'alain.plantec 2/6/2009 09:34'!
textMorph: anObject
	"Set the value of textMorph"

	textMorph := anObject! !

!PopupChoiceDialogWindowWithMessage methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 5/23/2013 18:39'!
newIconMorph
	"Answer an icon for the receiver."
	
	^ImageMorph new form: self icon! !

!PopupChoiceDialogWindowWithMessage methodsFor: 'accessing' stamp: 'gvc 7/30/2009 14:07'!
text: aStringOrText
	"Set the text."
	
	|t|
	t := aStringOrText isString
		ifTrue: [aStringOrText asText addAttribute: (TextFontReference toFont: self textFont); yourself]
		ifFalse: [aStringOrText].
	t addAttribute: TextAlignment centered.
	self textMorph newContents: t! !

!PopupChoiceDialogWindowWithMessage methodsFor: 'as yet unclassified' stamp: 'alain.plantec 2/6/2009 09:32'!
newTextMorph
	"Answer a text morph."
	
	^self newText: ''! !

!PopupChoiceDialogWindowWithMessage methodsFor: 'accessing' stamp: 'alain.plantec 2/6/2009 09:41'!
textFont
	"Answer the text font."
	
	^textFont! !

!PopupChoiceDialogWindowWithMessage methodsFor: 'accessing' stamp: 'alain.plantec 2/6/2009 09:35'!
iconMorph
	"Answer the value of iconMorph"

	^ iconMorph! !

!PopupChoiceDialogWindowWithMessage methodsFor: 'accessing' stamp: 'alain.plantec 2/6/2009 09:34'!
textMorph
	"Answer the value of textMorph"

	^ textMorph! !

!PopupChoiceDialogWindowWithMessage methodsFor: 'accessing' stamp: 'alain.plantec 2/6/2009 10:08'!
message
	
	^ message! !

!PopupChoiceDialogWindowWithMessage methodsFor: 'accessing' stamp: 'alain.plantec 2/6/2009 09:41'!
textFont: aFont
	"Set the text font."
	
	textFont :=  aFont! !

!PopupChoiceDialogWindowWithMessage methodsFor: 'as yet unclassified' stamp: 'gvc 2/6/2009 13:41'!
initialExtent
	"Answer the initial extent for the receiver.
	Adjust the text if the text	would be wider than 1/2 the display width."
	
	|ext|
	ext := super initialExtent.
	self textMorph width > (Display width // 2) ifTrue: [
		self textMorph
			wrapFlag: true;
			hResizing: #rigid;
			extent: Display width // 2 @ 0.
		ext := super initialExtent].
	^ext! !

!PopupChoiceOrRequestDialogWindow methodsFor: 'accessing' stamp: 'EstebanLorenzano 11/21/2009 12:34'!
extent: aPoint
	"Make the choices area at least fill the scroll area."
	^super extent: (aPoint x max: self class minWidth)@(aPoint y).! !

!PopupChoiceOrRequestDialogWindow methodsFor: 'accessing' stamp: 'GaryChambers 7/5/2010 16:01'!
filterValue

	^filter isEmpty
		ifTrue: [ nil ]
		ifFalse: [ filter ]! !

!PopupChoiceOrRequestDialogWindow methodsFor: 'event handling' stamp: 'AlainPlantec 11/22/2010 12:33'!
processEnter: anEvent
	(super processEnter: anEvent)
		ifFalse: [ self okButton performAction ].
		
	^true! !

!PopupChoiceOrRequestDialogWindow methodsFor: 'private' stamp: 'EstebanLorenzano 11/21/2009 12:19'!
okButton: aMorph
	okButton := aMorph! !

!PopupChoiceOrRequestDialogWindow methodsFor: 'initialization' stamp: 'EstebanLorenzano 11/21/2009 12:18'!
newButtons
	"Answer new buttons as appropriate."
	self filterMorph: self newFilterEntry.
	self okButton: self newOKButton.
	^Array 
		with: self filterMorph
		with: self okButton
		with: self newCancelButton! !

!PopupChoiceOrRequestDialogWindow methodsFor: 'accessing' stamp: 'EstebanLorenzano 11/21/2009 12:19'!
okButton
	^okButton! !

!PopupChoiceOrRequestDialogWindow methodsFor: 'accessing' stamp: 'GaryChambers 7/5/2010 15:58'!
filter: aString
	"Set the value of filter used to match the choices.
	Clear any selected items here so that potential requests for
	non-listed items can be handled."
	
	super filter: aString.
	(self choiceMenus ifNil: [^self]) do: [:embeddedMenu |
		embeddedMenu selectItem: nil event: nil]. "clear selection in other menus"
! !

!PopupChoiceOrRequestDialogWindow class methodsFor: 'as yet unclassified' stamp: 'EstebanLorenzano 11/21/2009 12:34'!
minWidth
	^250! !

!PositionableStream commentStamp: '<historical>'!
I represent an accessor for a sequence of objects (a collection) that are externally named by indices so that the point of access can be repositioned. I am abstract in that I do not implement the messages next and nextPut: which are inherited from my superclass Stream.!
!PositionableStream methodsFor: 'accessing' stamp: 'CamilloBruni 8/1/2012 16:12'!
originalContents
	"Answer the receiver's actual contents collection, NOT a copy."

	^ collection! !

!PositionableStream methodsFor: '*System-Changes' stamp: 'tk 12/29/97 12:37'!
skipStyleChunk
	"Get to the start of the next chunk that is not a style for the previous chunk"

	| pos |
	pos := self position.
	self skipSeparators.
	self peek == $] 
		ifTrue: [(self upTo: $[) = ']text' 	"old -- no longer needed"
				"now positioned past the open bracket"
			ifFalse: [self nextChunk]]	"absorb ]style[ and its whole chunk"
				
		ifFalse: [self position: pos]	"leave untouched"
! !

!PositionableStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/26/2011 19:37'!
next: requestedCount into: aCollection startingAt: startIndex
	"Read requestedCount objects into the given collection. 
	Return aCollection or a partial copy if less elements have been read."

	| readCount |
	readCount := self readInto: aCollection startingAt: startIndex count: requestedCount.
	^ readCount = requestedCount
		ifTrue: [ ^ aCollection ]
		ifFalse: [ ^ aCollection copyFrom: 1 to: startIndex + readCount - 1 ]! !

!PositionableStream methodsFor: '*System-Changes' stamp: ''!
trailer
	"If the stream requires a standard trailer, override this message.  See HtmlFileStream"! !

!PositionableStream methodsFor: 'accessing' stamp: 'nice 12/7/2009 08:40'!
nextLine
	"Answer next line (may be empty) without line end delimiters, or nil if at end.
	Let the stream positioned after the line delimiter(s).
	Handle a zoo of line delimiters CR, LF, or CR-LF pair"

	self atEnd ifTrue: [^nil].
	^self upToAnyOf: CharacterSet crlf do: [:char | char = Character cr ifTrue: [self peekFor: Character lf]]! !

!PositionableStream methodsFor: 'positioning' stamp: 'SeanDeNigris 6/21/2012 08:42'!
untilEnd: aBlock displayingProgress: aString
	aString
		displayProgressFrom: 0 to: self size
		during:
			[:bar |
			[self atEnd] whileFalse:
				[bar current: self position.
				aBlock value]].! !

!PositionableStream methodsFor: 'accessing' stamp: 'ar 12/23/1999 14:53'!
nextInto: aCollection
	"Read the next elements of the receiver into aCollection.
	Return aCollection or a partial copy if less than aCollection
	size elements have been read."
	^self next: aCollection size into: aCollection startingAt: 1.! !

!PositionableStream methodsFor: 'nonhomogeneous accessing' stamp: 'tk 6/8/1998 21:01'!
nextStringOld
	"Read a string from the receiver. The first byte is the length of the 
	string, unless it is greater than 192, in which case the first *two* bytes 
	encode the length.  Max size 16K. "

	| aString length |
	length := self next.		"first byte."
	length >= 192 ifTrue: [length := (length - 192) * 256 + self next].
	aString := String new: length.
	1 to: length do: [:ii | aString at: ii put: self next asCharacter].
	^aString! !

!PositionableStream methodsFor: 'data get/put' stamp: 'jm 7/16/2001 15:15'!
int32
	"Answer the next signed, 32-bit integer from this (binary) stream."
	"Details: As a fast check for negative number, check the high bit of the first digit"

	| n firstDigit |
	n := firstDigit := self next.
	n := (n bitShift: 8) + self next.
	n := (n bitShift: 8) + self next.
	n := (n bitShift: 8) + self next.
	firstDigit >= 128 ifTrue: [n := -16r100000000 + n].  "decode negative 32-bit integer"
	^ n
! !

!PositionableStream methodsFor: 'accessing' stamp: 'ar 12/23/1999 14:58'!
next: n into: aCollection
	"Read n objects into the given collection.
	Return aCollection or a partial copy if less than
	n elements have been read."
	^self next: n into: aCollection startingAt: 1! !

!PositionableStream methodsFor: 'testing' stamp: 'ar 1/2/2000 17:24'!
isBinary
	"Return true if the receiver is a binary byte stream"
	^collection class == ByteArray! !

!PositionableStream methodsFor: 'accessing' stamp: ''!
peekFor: anObject 
	"Answer false and do not move over the next element if it is not equal to 
	the argument, anObject, or if the receiver is at the end. Answer true 
	and increment the position for accessing elements, if the next element is 
	equal to anObject."

	| nextObject |
	self atEnd ifTrue: [^false].
	nextObject := self next.
	"peek for matching element"
	anObject = nextObject ifTrue: [^true].
	"gobble it if found"
	position := position - 1.
	^false! !

!PositionableStream methodsFor: 'positioning' stamp: 'damiencassou 5/30/2008 11:45'!
backUpTo: subCollection 
	"Back up the position to he subCollection.  Position must be somewhere within the stream initially.  Leave it just after it.  Return true if succeeded.  No wildcards, and case does matter."
	"Example:
	| strm | strm := ReadStream on: 'zabc abdc'.
	strm setToEnd; backUpTo: 'abc'; position 
"
	| pattern startMatch |
	pattern := subCollection reversed readStream.
	startMatch := nil.
	[ pattern atEnd ] whileFalse: 
		[ self position = 0 ifTrue: [ ^ false ].
		self skip: -1.
		self next = pattern next 
			ifTrue: [ pattern position = 1 ifTrue: [ startMatch := self position ] ]
			ifFalse: 
				[ pattern position: 0.
				startMatch ifNotNil: 
					[ self position: startMatch - 1.
					startMatch := nil ] ].
		self skip: -1 ].
	self position: startMatch.
	^ true! !

!PositionableStream methodsFor: 'accessing' stamp: 'sw 3/10/98 13:55'!
contentsOfEntireFile
	"For non-file streams"
	^ self contents! !

!PositionableStream methodsFor: 'positioning' stamp: 'damiencassou 5/30/2008 11:45'!
match: subCollection 
	"Set the access position of the receiver to be past the next occurrence of the subCollection. Answer whether subCollection is found.  No wildcards, and case does matter."
	| pattern startMatch |
	pattern := subCollection readStream.
	startMatch := nil.
	[ pattern atEnd ] whileFalse: 
		[ self atEnd ifTrue: [ ^ false ].
		self next = pattern next 
			ifTrue: [ pattern position = 1 ifTrue: [ startMatch := self position ] ]
			ifFalse: 
				[ pattern position: 0.
				startMatch ifNotNil: 
					[ self position: startMatch.
					startMatch := nil ] ] ].
	^ true! !

!PositionableStream methodsFor: 'positioning' stamp: 'nice 3/10/2008 22:29'!
position: anInteger 
	"Set the current position for accessing the objects to be anInteger, as long 
	as anInteger is within the bounds of the receiver's contents. If it is not, 
	create an error notification."

	(anInteger >= 0 and: [anInteger <= readLimit])
		ifTrue: [position := anInteger]
		ifFalse: [self positionError]! !

!PositionableStream methodsFor: '*System-Changes' stamp: ''!
verbatim: aString
	"Do not attempt to translate the characters.  Use to override nextPutAll:"
	^ self nextPutAll: aString! !

!PositionableStream methodsFor: 'data get/put' stamp: 'ClementBera 9/30/2013 10:57'!
uint32: anInteger
	"Store the given unsigned, 32-bit integer on this (binary) stream."

	(anInteger < 0 or: [ anInteger >= 16r100000000 ])
		ifTrue: [self error: 'outside unsigned 32-bit integer range'].

	self nextPut: (anInteger digitAt: 4).
	self nextPut: (anInteger digitAt: 3).
	self nextPut: (anInteger digitAt: 2).
	self nextPut: (anInteger digitAt: 1).
! !

!PositionableStream methodsFor: 'nonhomogeneous accessing' stamp: 'stephane.ducasse 4/13/2009 20:31'!
nextLittleEndianNumber: n put: value
	"Answer the next n bytes as a positive Integer or LargePositiveInteger, where the bytes are ordered from least significant to most significant."
	| bytes |
	bytes := ByteArray new: n.
	1 to: n do: [:i | bytes at: i put: (value digitAt: i)].
	self nextPutAll: bytes! !

!PositionableStream methodsFor: 'private' stamp: ''!
on: aCollection

	collection := aCollection.
	readLimit := aCollection size.
	position := 0.
	self reset! !

!PositionableStream methodsFor: '*System-Changes' stamp: 'MarcusDenker 8/9/2014 13:32'!
backChunk
	"Answer the contents of the receiver back to the previous terminator character.  Doubled terminators indicate an embedded terminator character."

	| terminator out ch |
	terminator := $!!.
	out := (String new: 1000) writeStream.
	[ (ch := self back) isNil ]
		whileFalse: [ 
			ch == terminator
				ifTrue: [ 
					self oldPeekBack == terminator
						ifTrue: [ self oldBack	"skip doubled terminator" ]
						ifFalse: [ ^ out contents reversed	"we're done!!" ] ].
			out nextPut: ch ].
	^ out contents reversed! !

!PositionableStream methodsFor: 'data get/put' stamp: 'MarcusDenker 9/12/2014 13:02'!
int16: anInteger
	"Store the given signed, 16-bit integer on this (binary) stream."

	| n |
	(anInteger < -16r8000 or: [ anInteger >= 16r8000 ])
		ifTrue: [ self error: 'outside 16-bit integer range' ].
	n := anInteger < 0
		ifTrue: [ 16r10000 + anInteger ]
		ifFalse: [ anInteger ].
	self nextPut: (n digitAt: 2).
	self nextPut: (n digitAt: 1)! !

!PositionableStream methodsFor: 'accessing' stamp: ''!
peek
	"Answer what would be returned if the message next were sent to the 
	receiver. If the receiver is at the end, answer nil."

	| nextObject |
	self atEnd ifTrue: [^nil].
	nextObject := self next.
	position := position - 1.
	^nextObject! !

!PositionableStream methodsFor: 'nonhomogeneous accessing' stamp: 'sw 3/10/98 13:55'!
nextNumber: n put: v 
	"Append to the receiver the argument, v, which is a positive 
	SmallInteger or a LargePositiveInteger, as the next n bytes.
	Possibly pad with leading zeros."

	1 to: n do: [:i | self nextPut: (v digitAt: n+1-i)].
	^ v
! !

!PositionableStream methodsFor: 'accessing' stamp: 'pavel.krivanek 3/12/2009 11:01'!
oldBack
	"Go back one element and return it.  Use indirect messages in case I am a StandardFileStream"
	"The method is a misconception about what a stream is. A stream contains a pointer *between* elements with past and future elements. This method considers that the pointer is *on* an element. Please consider unit tests which verifies #back and #oldBack behavior. (Damien Cassou - 1 August 2007)"
	self position = 0 ifTrue: [self positionError].
	self position = 1 ifTrue: [self position: 0.  ^ nil].
	self skip: -2.
	^ self next
! !

!PositionableStream methodsFor: '*System-Changes' stamp: 'MarcusDenker 5/8/2013 19:26'!
decodeString: string andRuns: runsRaw
	| strm runLength runValues newString index |
	strm := ReadStream on: runsRaw from: 1 to: runsRaw size.
	(strm peekFor: $()
		ifFalse: [ ^ nil ].
	runLength := OrderedCollection new.
	[ 
	strm skipSeparators.
	strm peekFor: $) ] whileFalse: [ runLength add: (Number readFrom: strm) ].
	runValues := OrderedCollection new.
	[ strm atEnd ]
		whileFalse: [ 
			runValues add: (Number readFrom: strm).
			strm next ].
	newString := WideString new: string size.
	index := 1.
	runLength
		with: runValues
		do: [ :length :leadingChar | 
			index to: index + length - 1 do: [ :pos | newString at: pos put: (Character leadingChar: leadingChar code: (string at: pos) charCode) ].
			index := index + length ].
	^ newString! !

!PositionableStream methodsFor: 'accessing' stamp: 'ar 1/2/2000 15:32'!
next: anInteger putAll: aCollection
	"Store the next anInteger elements from the given collection."
	^self next: anInteger putAll: aCollection startingAt: 1! !

!PositionableStream methodsFor: 'data get/put' stamp: 'jm 9/5/2001 12:09'!
string: aString
	"Store the given string on this (binary) stream. The string must contain 65535 or fewer characters."

	aString size > 16rFFFF ifTrue: [self error: 'string too long for this format'].
	self uint16: aString size.
	self nextPutAll: aString asByteArray.
! !

!PositionableStream methodsFor: 'testing' stamp: 'damiencassou 5/15/2009 15:06'!
isEmpty
	"Answer whether the receiver's contents has no elements."

	"Returns true if both the set of past and future sequence values of
the receiver are empty. Otherwise returns false"

	^ self atEnd and: [position = 0]! !

!PositionableStream methodsFor: '*System-Changes' stamp: 'sumim 11/20/2003 18:13'!
nextChunkText
	"Deliver the next chunk as a Text.  Decode the following ]style[ chunk if present.  Position at start of next real chunk."
	| string runsRaw strm runs peek pos |
	"Read the plain text"
	string := self nextChunk.
	
	"Test for ]style[ tag"
	pos := self position.
	peek := self skipSeparatorsAndPeekNext.
	peek = $] ifFalse: [self position: pos. ^ string asText].  "no tag"
	(self upTo: $[) = ']style' ifFalse: [self position: pos. ^ string asText].  "different tag"

	"Read and decode the style chunk"
	runsRaw := self basicNextChunk.	"style encoding"
	strm := ReadStream on: runsRaw from: 1 to: runsRaw size.
	runs := RunArray scanFrom: strm.

	^ Text basicNew setString: string setRunsChecking: runs.
! !

!PositionableStream methodsFor: 'positioning' stamp: ''!
reset
	"Set the receiver's position to the beginning of the sequence of objects."

	position := 0! !

!PositionableStream methodsFor: 'accessing' stamp: 'sw 3/10/98 13:55'!
next: anInteger 
	"Answer the next anInteger elements of my collection. Must override 
	because default uses self contents species, which might involve a large 
	collection."

	| newArray |
	newArray := collection species new: anInteger.
	1 to: anInteger do: [:index | newArray at: index put: self next].
	^newArray! !

!PositionableStream methodsFor: 'positioning' stamp: 'sw 3/10/98 13:55'!
resetContents
	"Set the position and limits to 0."

	position := 0.
	readLimit := 0! !

!PositionableStream methodsFor: '*Graphics-Primitives' stamp: 'StephaneDucasse 10/25/2013 16:18'!
nextWordsInto: aBitmap 
	"Fill the word based buffer from my collection. 
	Stored on stream as Big Endian. Optimized for speed. 
	Read in BigEndian, then restoreEndianness."
	| blt pos source byteSize |
	collection class isBytes
		ifFalse: [^ self next: aBitmap size into: aBitmap startingAt: 1].

	byteSize := aBitmap byteSize.
	"is the test on collection basicSize \\ 4 necessary?"
	((self position bitAnd: 3) = 0 and: [ (collection basicSize bitAnd: 3) = 0])
		ifTrue: [source := collection.
			pos := self position.
			self skip: byteSize]
		ifFalse: ["forced to copy it into a buffer"
			source := self next: byteSize.
			pos := 0].

	"Now use BitBlt to copy the bytes to the bitmap."
	blt := (BitBlt
				toForm: (Form new hackBits: aBitmap))
				sourceForm: (Form new hackBits: source).
	blt combinationRule: Form over. "store"
	blt sourceX: 0;
		 sourceY: pos // 4;
		 height: byteSize // 4;
		 width: 4.
	blt destX: 0;
		 destY: 0.
	blt copyBits.

	"And do whatever the bitmap needs to do to convert from big-endian order."
	aBitmap restoreEndianness.

	^ aBitmap 	"May be WordArray, ColorArray, etc"
! !

!PositionableStream methodsFor: 'accessing' stamp: 'pavel.krivanek 3/12/2009 11:01'!
back
	"Go back one element and return it."

	self position = 0 ifTrue: [self positionError].
	self skip: -1.
	^ self peek! !

!PositionableStream methodsFor: 'accessing' stamp: 'nice 12/7/2009 08:30'!
upToAnyOf: subcollection do: aBlock
	"Answer a subcollection from the current access position to the occurrence (if any, but not inclusive) of any object in the collection.
	Evaluate aBlock with this occurence as argument.
	If no matching object is found, don't evaluate aBlock and answer the entire rest of the receiver."
	
	^self collectionSpecies new: 1000 streamContents: [ :stream |
		| ch |
		[ self atEnd or: [ (subcollection includes: (ch := self next)) and: [aBlock value: ch. true] ] ] 
			whileFalse: [ stream nextPut: ch ] ]! !

!PositionableStream methodsFor: 'nonhomogeneous accessing' stamp: 'sw 3/10/98 13:55'!
nextWord
	"Answer the next two bytes from the receiver as an Integer."

	| high low |
	high := self next.
		high==nil ifTrue: [^false].
	low := self next.
		low==nil ifTrue: [^false].
	^(high asInteger bitShift: 8) + low asInteger! !

!PositionableStream methodsFor: 'data get/put' stamp: 'ClementBera 9/30/2013 10:57'!
uint24: anInteger
	"Store the given unsigned, 24-bit integer on this (binary) stream."

	(anInteger < 0 or: [ anInteger >= 16r1000000 ])
		ifTrue: [self error: 'outside unsigned 24-bit integer range'].

	self nextPut: (anInteger digitAt: 3).
	self nextPut: (anInteger digitAt: 2).
	self nextPut: (anInteger digitAt: 1).
! !

!PositionableStream methodsFor: 'accessing' stamp: 'nice 12/7/2009 08:38'!
upToAnyOf: aCollection 
	"Answer a subcollection from the current access position to the 
	occurrence (if any, but not inclusive) of any object in the collection. If 
	no matching object is found, answer the entire rest of the receiver."
	^self upToAnyOf: aCollection do: [:matchingObject | ]! !

!PositionableStream methodsFor: 'private' stamp: ''!
setFrom: newStart to: newStop

	position := newStart - 1.
	readLimit := newStop! !

!PositionableStream methodsFor: 'positioning' stamp: ''!
position
	"Answer the current position of accessing the sequence of objects."

	^position! !

!PositionableStream methodsFor: '*System-Changes' stamp: 'StephaneDucasse 9/12/2010 09:45'!
copyMethodChunkFrom: aStream
	"Copy the next chunk from aStream (must be different from the receiver)."
	
	self nextChunkPut: aStream nextChunkText! !

!PositionableStream methodsFor: 'private' stamp: ''!
positionError
	"Since I am not necessarily writable, it is up to my subclasses to override 
	position: if expanding the collection is preferrable to giving this error."

	self error: 'Attempt to set the position of a PositionableStream out of bounds'! !

!PositionableStream methodsFor: 'converting' stamp: 'tk 2/7/2000 11:08'!
asBinaryOrTextStream
	"Convert to a stream that can switch between bytes and characters"

	^ (RWBinaryOrTextStream with: self contentsOfEntireFile) reset! !

!PositionableStream methodsFor: '*System-Changes' stamp: 'sumim 11/20/2003 18:11'!
parseLangTagFor: aString

	| string peek runsRaw pos |
	string := aString.
	"Test for ]lang[ tag"
	pos := self position.
	peek := self skipSeparatorsAndPeekNext.
	peek = $] ifFalse: [self position: pos. ^ string].  "no tag"
	(self upTo: $[) = ']lang' ifTrue: [
		runsRaw := self basicNextChunk.
		string := self decodeString: aString andRuns: runsRaw
	] ifFalse: [
		self position: pos
	].
	^ string.
! !

!PositionableStream methodsFor: 'data get/put' stamp: 'jm 10/5/2001 12:11'!
boolean: aBoolean
	"Store the given boolean value on this (binary) stream."

	self nextPut: (aBoolean ifTrue: [1] ifFalse: [0]).
! !

!PositionableStream methodsFor: 'positioning' stamp: ''!
skip: anInteger 
	"Set the receiver's position to be the current position+anInteger. A 
	subclass might choose to be more helpful and select the minimum of the 
	receiver's size and position+anInteger, or the maximum of 1 and 
	position+anInteger for the repositioning."

	self position: position + anInteger! !

!PositionableStream methodsFor: 'accessing' stamp: 'tk 7/18/1999 17:10'!
upToAll: aCollection
	"Answer a subcollection from the current access position to the occurrence (if any, but not inclusive) of aCollection. If aCollection is not in the stream, answer the entire rest of the stream."

	| startPos endMatch result |
	startPos := self position.
	(self match: aCollection) 
		ifTrue: [endMatch := self position.
			self position: startPos.
			result := self next: endMatch - startPos - aCollection size.
			self position: endMatch.
			^ result]
		ifFalse: [self position: startPos.
			^ self upToEnd]! !

!PositionableStream methodsFor: 'accessing' stamp: 'ajh 1/18/2002 01:02'!
peekBack
	"Return the element at the previous position, without changing position.  Use indirect messages in case self is a StandardFileStream."

	| element |
	element := self back.
	self skip: 1.
	^ element! !

!PositionableStream methodsFor: 'private' stamp: 'nice 11/22/2009 18:03'!
collectionSpecies
	"Answer the species of collection into which the receiver can stream"
	
	^collection species! !

!PositionableStream methodsFor: 'data get/put' stamp: 'jm 7/16/2001 14:43'!
int16
	"Answer the next signed, 16-bit integer from this (binary) stream."

	| n |
	n := self next.
	n := (n bitShift: 8) + (self next).
	n >= 16r8000 ifTrue: [n := n - 16r10000].
	^ n
! !

!PositionableStream methodsFor: 'data get/put' stamp: 'jm 9/5/2001 07:35'!
string
	"Answer the next string from this (binary) stream."

	| size |
	size := self uint16.
	^ (self next: size) asString
! !

!PositionableStream methodsFor: 'accessing' stamp: 'PeterHugossonMiller 9/3/2009 10:51'!
upToAny: aCollection 
	"Answer a subcollection from the current access position to the 
	occurrence (if any, but not inclusive) of any objects in the given collection in the receiver. If 
	any of these is not in the collection, answer the entire rest of the receiver."
	
	| newStream element |
	newStream := (collection species new: 100) writeStream.
	[self atEnd or: [aCollection includes: (element := self next)]]
		whileFalse: [newStream nextPut: element].
	^newStream contents! !

!PositionableStream methodsFor: 'positioning' stamp: ''!
skipTo: anObject 
	"Set the access position of the receiver to be past the next occurrence of 
	anObject. Answer whether anObject is found."

	[self atEnd]
		whileFalse: [self next = anObject ifTrue: [^true]].
	^false! !

!PositionableStream methodsFor: '*System-Changes' stamp: ''!
header
	"If the stream requires a standard header, override this message.  See HtmlFileStream"! !

!PositionableStream methodsFor: 'positioning' stamp: 'MarcusDenker 9/12/2014 13:02'!
untilEndWithFork: aBlock displayingProgress: aString
	| sem done result |
	sem := Semaphore new.
	done := false.
	[ 
	result := [ aBlock value ]
		ensure: [ 
			done := true.
			sem signal ] ] fork.
	self
		untilEnd: [ 
			done
				ifTrue: [ ^ result ].
			(Delay forSeconds: 0.2) wait ]
		displayingProgress: aString.
	sem wait.
	^ result! !

!PositionableStream methodsFor: 'data get/put' stamp: 'jm 8/20/2001 07:53'!
uint32
	"Answer the next unsigned, 32-bit integer from this (binary) stream."

	| n |
	n := self next.
	n := (n bitShift: 8) + self next.
	n := (n bitShift: 8) + self next.
	n := (n bitShift: 8) + self next.
	^ n
! !

!PositionableStream methodsFor: 'nonhomogeneous accessing' stamp: ''!
nextNumber: n 
	"Answer the next n bytes as a positive Integer or LargePositiveInteger."
	| s |
	s := 0.
	1 to: n do: 
		[:i | s := (s bitShift: 8) bitOr: self next asInteger].
	^ s normalize! !

!PositionableStream methodsFor: 'nonhomogeneous accessing' stamp: 'jm 4/9/98 21:36'!
nextLittleEndianNumber: n 
	"Answer the next n bytes as a positive Integer or LargePositiveInteger, where the bytes are ordered from least significant to most significant."

	| bytes s |
	bytes := self next: n.
	s := 0.
	n to: 1 by: -1 do: [:i | s := (s bitShift: 8) bitOr: (bytes at: i)].
	^ s
! !

!PositionableStream methodsFor: 'positioning' stamp: 'di 5/25/1998 15:16'!
padToNextLongPut: char 
	"Make position be on long word boundary, writing the padding 
	character, char, if necessary."
	[self position \\ 4 = 0]
		whileFalse: [self nextPut: char]! !

!PositionableStream methodsFor: 'accessing' stamp: 'ar 12/23/1999 14:59'!
nextInto: aCollection startingAt: startIndex
	"Read the next elements of the receiver into aCollection.
	Return aCollection or a partial copy if less than aCollection
	size elements have been read."
	^self next: (aCollection size - startIndex+1) into: aCollection startingAt: startIndex.! !

!PositionableStream methodsFor: 'data get/put' stamp: 'MarcusDenker 9/12/2014 13:02'!
int32: anInteger
	"Store the given signed, 32-bit integer on this (binary) stream."

	| n |
	(anInteger < -16r80000000 or: [ anInteger >= 16r80000000 ])
		ifTrue: [ self error: 'outside 32-bit integer range' ].
	n := anInteger < 0
		ifTrue: [ 16r100000000 + anInteger ]
		ifFalse: [ anInteger ].
	self nextPut: (n digitAt: 4).
	self nextPut: (n digitAt: 3).
	self nextPut: (n digitAt: 2).
	self nextPut: (n digitAt: 1)! !

!PositionableStream methodsFor: '*System-Changes' stamp: 'MarcusDenker 8/9/2014 13:32'!
basicNextChunk
	"Answer the contents of the receiver, up to the next terminator character. Doubled terminators indicate an embedded terminator character."

	| terminator out ch |
	terminator := $!!.
	out := (String new: 1000) writeStream.
	self skipSeparators.
	[ (ch := self next) isNil ]
		whileFalse: [ 
			ch == terminator
				ifTrue: [ 
					self peek == terminator
						ifTrue: [ self next	"skip doubled terminator" ]
						ifFalse: [ ^ out contents	"terminator is not doubled; we're done!!" ] ].
			out nextPut: ch ].
	^ out contents! !

!PositionableStream methodsFor: 'nonhomogeneous accessing' stamp: 'yo 4/16/2001 17:56'!
nextStringPut: s 
	"Append the string, s, to the receiver.  Only used by DataStream.  Max size of 64*256*256*256."

	| length |
	(length := s size) < 192
		ifTrue: [self nextPut: length]
		ifFalse: 
			[self nextPut: (length digitAt: 4)+192.
			self nextPut: (length digitAt: 3).
			self nextPut: (length digitAt: 2).
			self nextPut: (length digitAt: 1)].
	self nextPutAll: s asByteArray.
	^s! !

!PositionableStream methodsFor: 'accessing' stamp: 'damiencassou 11/23/2008 17:04'!
oldPeekBack
	"Return the element at the previous position, without changing position.  Use indirect messages in case self is a StandardFileStream."
	"The method is a misconception about what a stream is. A stream contains a pointer *between* elements with past and future elements. This method considers that the pointer is *on* an element. Please consider unit tests which verifies #peekBack and #oldPeekBack behavior. (Damien Cassou - 1 August 2007)"
	| element |
	element := self oldBack.
	self skip: 1.
	^ element
! !

!PositionableStream methodsFor: 'public' stamp: 'di 6/13/97 12:00'!
skipSeparators
	[self atEnd]
		whileFalse:
		[self next isSeparator ifFalse: [^ self position: self position-1]]! !

!PositionableStream methodsFor: 'accessing' stamp: 'PeterHugossonMiller 9/3/2009 10:50'!
nextDelimited: terminator
	"Answer the contents of the receiver, up to the next terminator character. Doubled terminators indicate an embedded terminator character.  For example: 'this '' was a quote'. Start postioned before the initial terminator."

	| out ch |
	out := (String new: 1000) writeStream.
	self atEnd ifTrue: [^ ''].
	self next == terminator ifFalse: [self skip: -1].	"absorb initial terminator"
	[(ch := self next) == nil] whileFalse: [
		(ch == terminator) ifTrue: [
			self peek == terminator ifTrue: [
				self next.  "skip doubled terminator"
			] ifFalse: [
				^ out contents  "terminator is not doubled; we're done!!"
			].
		].
		out nextPut: ch.
	].
	^ out contents! !

!PositionableStream methodsFor: 'positioning' stamp: 'damiencassou 5/30/2008 11:45'!
positionOfSubCollection: subCollection ifAbsent: exceptionBlock 
	"Return a position such that that element at the new position equals the first element of sub, and the next elements equal the rest of the elements of sub. Begin the search at the current position.
	If no such match is found, answer the result of evaluating argument, exceptionBlock."
	| pattern startPosition currentPosition |
	pattern := subCollection readStream.
	startPosition := self position.
	[ pattern atEnd ] whileFalse: 
		[ self atEnd ifTrue: [ ^ exceptionBlock value ].
		self next = pattern next ifFalse: 
			[ self position: self position - pattern position + 1.
			pattern reset ] ].
	currentPosition := self position.
	self position: startPosition.
	^ pattern atEnd 
		ifTrue: [ currentPosition + 1 - subCollection size ]
		ifFalse: [ exceptionBlock value ]! !

!PositionableStream methodsFor: 'public' stamp: 'di 1/13/98 16:08'!
skipSeparatorsAndPeekNext
	"A special function to make nextChunk fast"
	| peek |
	[self atEnd]
		whileFalse:
		[(peek := self next) isSeparator
			ifFalse: [self position: self position-1. ^ peek]]! !

!PositionableStream methodsFor: '*System-Changes' stamp: 'MarcusDenker 8/9/2014 13:35'!
copyPreamble: preamble from: aStream at: pos 
	"Look for a changeStamp for this method by peeking backward.
	Write a method preamble, with that stamp if found."
	| terminator last50 stamp i |
	terminator := $!!.

	"Look back to find stamp in old preamble, such as...
	Polygon methodsFor: 'private' stamp: 'di 6/25/97 21:42' prior: 34957598!! "
	aStream position: pos.
	aStream backChunk.	"to beginning of method"
	last50 := aStream backChunk.	"to get preamble"
	aStream position: pos.
	stamp := String new.
	(i := last50 
		findLastOccurrenceOfString: 'stamp:'
		startingAt: 1) > 0 ifTrue: 
		[ stamp := (last50 
			copyFrom: i + 8
			to: last50 size) copyUpTo: $' ].

	"Write the new preamble, with old stamp if any."
	self
		cr;
		nextPut: terminator.
	self nextChunkPut: (String streamContents: 
			[ :strm | 
			strm nextPutAll: preamble.
			stamp notEmpty ifTrue: 
				[ strm
					nextPutAll: ' stamp: ';
					print: stamp ] ]).
	self cr! !

!PositionableStream methodsFor: 'data get/put' stamp: 'jm 10/5/2001 12:09'!
boolean
	"Answer the next boolean value from this (binary) stream."

	^ self next ~= 0
! !

!PositionableStream methodsFor: 'data get/put' stamp: 'jm 8/20/2001 08:07'!
uint24
	"Answer the next unsigned, 24-bit integer from this (binary) stream."

	| n |
	n := self next.
	n := (n bitShift: 8) + self next.
	n := (n bitShift: 8) + self next.
	^ n
! !

!PositionableStream methodsFor: 'positioning' stamp: ''!
setToEnd
	"Set the position of the receiver to the end of the sequence of objects."

	position := readLimit! !

!PositionableStream methodsFor: 'nonhomogeneous accessing' stamp: 'yo 3/1/2005 06:03'!
nextString
	"Read a string from the receiver. The first byte is the length of the string, unless it is greater than 192, in which case the first four bytes encode the length.  I expect to be in ascii mode when called (caller puts back to binary)."

	| length aByteArray |

	"read the length in binary mode"
	self binary.
	length := self next.		"first byte."
	length >= 192 ifTrue: [length := length - 192.
		1 to: 3 do: [:ii | length := length * 256 + self next]].
	aByteArray := ByteArray new: length.

	self nextInto: aByteArray.
	^aByteArray asString.
! !

!PositionableStream methodsFor: 'positioning' stamp: 'mir 6/29/2004 17:35'!
positionOfSubCollection: subCollection
	"Return a position such that that element at the new position equals the first element of sub, and the next elements equal the rest of the elements of sub. Begin the search at the current position.
	If no such match is found, answer 0."

	^self positionOfSubCollection: subCollection ifAbsent: [0]! !

!PositionableStream methodsFor: '*Fuel' stamp: 'StephaneDucasse 10/25/2013 16:18'!
fuelNextWordsInto: aWordObject 
	"This method is the same as nextWordsInto: but the restoreEndianness is only done if needed"
	| blt pos source byteSize |

	byteSize := aWordObject byteSize.
	"is the test on collection basicSize \\ 4 necessary?"
	
	((self position bitAnd: 3) = 0 and: [ (collection basicSize bitAnd: 3) = 0])
		ifTrue: [source := collection.
			pos := self position.
			self skip: byteSize]
		ifFalse: ["forced to copy it into a buffer"
			source := self next: byteSize.
			pos := 0].

	"Now use BitBlt to copy the bytes to the bitmap."
	blt := (BitBlt
				toForm: (Form new hackBits: aWordObject))
				sourceForm: (Form new hackBits: source).
	blt combinationRule: Form over. "store"
	blt sourceX: 0;
		 sourceY: pos // 4;
		 height: byteSize // 4;
		 width: 4.
	blt destX: 0;
		 destY: 0.
	blt copyBits.

	^ aWordObject 	
! !

!PositionableStream methodsFor: 'positioning' stamp: 'mir 5/14/2003 18:45'!
pushBack: aString
	"Compatibility with SocketStreams"
	self skip: aString size negated! !

!PositionableStream methodsFor: 'testing' stamp: ''!
atEnd
	"Primitive. Answer whether the receiver can access any more objects.
	Optional. See Object documentation whatIsAPrimitive."

	<primitive: 67>
	^position >= readLimit! !

!PositionableStream methodsFor: 'data get/put' stamp: 'ClementBera 9/30/2013 10:57'!
uint16: anInteger
	"Store the given unsigned, 16-bit integer on this (binary) stream."

	(anInteger < 0 or: [ anInteger >= 16r10000 ])
		ifTrue: [self error: 'outside unsigned 16-bit integer range'].

	self nextPut: (anInteger digitAt: 2).
	self nextPut: (anInteger digitAt: 1).
! !

!PositionableStream methodsFor: '*System-Changes' stamp: 'MarcusDenker 8/9/2014 13:32'!
nextChunk
	"Answer the contents of the receiver, up to the next terminator character. Doubled terminators indicate an embedded terminator character."

	| terminator out ch |
	terminator := $!!.
	out := (String new: 1000) writeStream.
	self skipSeparators.
	[ (ch := self next) isNil ]
		whileFalse: [ 
			ch == terminator
				ifTrue: [ 
					self peek == terminator
						ifTrue: [ self next	"skip doubled terminator" ]
						ifFalse: [ ^ self parseLangTagFor: out contents	"terminator is not doubled; we're done!!" ] ].
			out nextPut: ch ].
	^ self parseLangTagFor: out contents! !

!PositionableStream methodsFor: 'nonhomogeneous accessing' stamp: 'sw 3/10/98 13:55'!
nextInt32Put: int32
	"Write a signed integer to the next 4 bytes"
	| pos |
	pos := int32 < 0
		ifTrue: [(0-int32) bitInvert32 + 1]
		ifFalse: [int32].
	1 to: 4 do: [:i | self nextPut: (pos digitAt: 5-i)].
	^ int32! !

!PositionableStream methodsFor: 'positioning' stamp: 'di 2/15/98 14:41'!
padTo: nBytes put: aCharacter 
	"Pad using the argument, aCharacter, to the next boundary of nBytes characters."
	| rem |
	rem := nBytes - (self position \\ nBytes).
	rem = nBytes ifTrue: [^ 0].
	self next: rem put: aCharacter.! !

!PositionableStream methodsFor: 'nonhomogeneous accessing' stamp: 'sw 3/10/98 13:55'!
nextInt32
	"Read a 32-bit signed integer from the next 4 bytes"
	| s |
	s := 0.
	1 to: 4 do: [:i | s := (s bitShift: 8) + self next].
	(s bitAnd: 16r80000000) = 0
		ifTrue: [^ s]
		ifFalse: [^ -1 - s bitInvert32]! !

!PositionableStream methodsFor: '*Compression' stamp: 'ar 1/2/2000 15:32'!
asZLibReadStream
	^ZLibReadStream on: collection from: position+1 to: readLimit! !

!PositionableStream methodsFor: 'accessing' stamp: 'PeterHugossonMiller 9/3/2009 10:51'!
upTo: anObject 
	"Answer a subcollection from the current access position to the 
	occurrence (if any, but not inclusive) of anObject in the receiver. If 
	anObject is not in the collection, answer the entire rest of the receiver."
	| newStream element |
	newStream := (collection species new: 100) writeStream.
	[self atEnd or: [(element := self next) = anObject]]
		whileFalse: [newStream nextPut: element].
	^newStream contents! !

!PositionableStream methodsFor: 'accessing' stamp: 'PeterHugossonMiller 9/3/2009 10:51'!
upToEnd
	"Answer a subcollection from the current access position through the last element of the receiver."

	| newStream |
	newStream := (collection species new: 100) writeStream.
	[self atEnd] whileFalse: [ newStream nextPut: self next ].
	^ newStream contents! !

!PositionableStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/26/2011 09:26'!
readInto: aCollection startingAt: startIndex count: n
	"Read n objects into the given collection. 
	Return number of elements that have been read."
	
	| obj |
	0 to: n - 1 do: [ :i |
		(obj := self next) == nil ifTrue: [ ^ i ].
		aCollection at: startIndex + i put: obj ].
	^ n! !

!PositionableStream methodsFor: 'data get/put' stamp: 'jm 8/20/2001 07:53'!
uint16
	"Answer the next unsigned, 16-bit integer from this (binary) stream."

	| n |
	n := self next.
	n := (n bitShift: 8) + (self next).
	^ n
! !

!PositionableStream methodsFor: 'accessing' stamp: ''!
contents
	"Answer with a copy of my collection from 1 to readLimit."

	^collection copyFrom: 1 to: readLimit! !

!PositionableStream methodsFor: 'nonhomogeneous accessing' stamp: 'sw 3/10/98 13:55'!
nextWordPut: aWord 
	"Append to the receiver an Integer as the next two bytes."

	self nextPut: ((aWord bitShift: -8) bitAnd: 255).
	self nextPut: (aWord bitAnd: 255).
	^aWord! !

!PositionableStream class methodsFor: 'instance creation' stamp: ''!
on: aCollection from: firstIndex to: lastIndex 
	"Answer an instance of me, streaming over the elements of aCollection 
	starting with the element at firstIndex and ending with the one at 
	lastIndex."

	^self basicNew on: (aCollection copyFrom: firstIndex to: lastIndex)! !

!PositionableStream class methodsFor: 'instance creation' stamp: ''!
on: aCollection 
	"Answer an instance of me, streaming over the elements of aCollection."

	^self basicNew on: aCollection! !

!PositionableStream class methodsFor: '*FuelTests' stamp: 'MaxLeske 8/5/2013 09:00'!
with: aCollectionOrStream do: aBlock
	"Evaluates a block with a new stream based on the collection or stream. Answers the result of the block evaluation. Follows the style of FileStream>>fileNamed:do:."
	| aStream |
	aStream := self on: aCollectionOrStream.
	[ ^ aBlock value: aStream ] ensure: [ aStream close ]! !

!PostorderGuide commentStamp: 'cwp 11/18/2009 12:16'!
I traverse the filesystem in depth-first post order. Given this hierarchy:

alpha
	beta
	gamma
delta
	epsilon

I would visit the nodes in the following order:  beta, gamma, alpha, epsilon, delta.

I use my work instance variable as a stack. I push messages that cause nodes to be traversed or visited, and execute them in reverse order.!
!PostorderGuide methodsFor: 'showing' stamp: 'CamilloBruni 8/12/2011 18:18'!
pushTraverse: aReference 
	self push: (Message 
				selector: #traverse:
				argument: aReference)! !

!PostorderGuide methodsFor: 'showing' stamp: 'CamilloBruni 4/10/2013 12:30'!
traverse: anEntry 
		
	self pushVisit: anEntry.
	
	anEntry isDirectory ifTrue: [ 
		(self shouldVisitChildrenOf: anEntry)
			ifFalse: [ ^ self ].
		anEntry reference entries reverseDo: [ :each | 
			self pushTraverse: each ]]! !

!PostorderGuide methodsFor: 'showing' stamp: 'CamilloBruni 8/12/2011 18:18'!
pushVisit: aReference 
	self push: (Message 
				selector: #visit:
				argument: aReference)! !

!PostorderGuide methodsFor: 'showing' stamp: 'CamilloBruni 4/10/2013 11:55'!
show: aReference 
	self pushTraverse: aReference entry.
	self whileNotDoneDo: [ self pop sendTo: self ]! !

!PostorderGuide methodsFor: 'showing' stamp: 'CamilloBruni 4/10/2013 12:25'!
visit: anEntry
	anEntry isDirectory
		ifTrue: [ visitor visitDirectory: anEntry ]
		ifFalse: [ visitor visitFile: anEntry ]! !

!PostorderGuideTest commentStamp: 'TorstenBergmann 1/31/2014 11:43'!
SUnit tests for class PostorderGuide!
!PostorderGuideTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:38'!
testAll
	guide := PostorderGuide for: self.
	guide show: (filesystem / 'alpha').
	self assertVisitedIs: #(
			'delta'
			'gamma'
			'beta'
			'zeta'
			'epsilon'
			'alpha'
		)! !

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

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

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

To browse all methods with pragmas in the system evaluate
	SystemNavigation new browseAllSelect: [:m| m pragmas notEmpty]
and to browse all nonprimitive methods with pragmas evaluate
	SystemNavigation new browseAllSelect: [:m| m primitive isZero and: [m pragmas notEmpty]]!
!Pragma methodsFor: 'accessing-method' stamp: 'eem 12/1/2008 10:43'!
selector
	"Answer the selector of the method containing the pragma.
	 Do not confuse this with the selector of the pragma's message pattern."
	
	^method selector! !

!Pragma methodsFor: 'comparing' stamp: 'eem 3/7/2009 11:54'!
analogousCodeTo: anObject 
	^self class == anObject class
	  and: [keyword == anObject keyword
	  and: [arguments = anObject arguments]]! !

!Pragma methodsFor: '*OpalCompiler-Core' stamp: 'MarcusDenker 5/23/2013 08:39'!
method: aCompiledMethod

	 method := aCompiledMethod! !

!Pragma methodsFor: 'testing' stamp: 'eem 11/29/2008 16:39'!
hasLiteral: aLiteral
	^keyword == aLiteral 
	   or: [arguments hasLiteral: aLiteral]! !

!Pragma methodsFor: 'initialization' stamp: 'lr 1/20/2006 00:53'!
setKeyword: aSymbol
	keyword := aSymbol! !

!Pragma methodsFor: 'accessing-method' stamp: 'lr 1/20/2006 02:08'!
methodClass
	"Answer the class of the method containing the pragma."
	
	^ method methodClass! !

!Pragma methodsFor: 'accessing-pragma' stamp: 'lr 1/20/2006 02:10'!
argumentAt: anInteger
	"Answer one of the arguments of the pragma."
	
	^ self arguments at: anInteger.! !

!Pragma methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 10/6/2013 22:09'!
gtInspectorSourceIn: composite
	<gtInspectorPresentationOrder: 30> 
	self method gtInspectorSourceIn: composite! !

!Pragma methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 12/15/2014 00:01'!
spotterActDefault
    ^ self method browse! !

!Pragma methodsFor: 'printing' stamp: 'lr 2/6/2006 19:56'!
printOn: aStream
	aStream nextPut: $<.
	self keyword precedence = 1
		ifTrue: [ aStream nextPutAll: self keyword ]
		ifFalse: [
			self keyword keywords with: self arguments do: [ :key :arg |
				aStream nextPutAll: key; space; print: arg; space ].
			aStream skip: -1 ].
	aStream nextPut: $>.! !

!Pragma methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 3/13/2015 18:19'!
spotterPreviewIn: composite
	<spotterPreview: 10>
   self method spotterPreviewCodeIn: composite! !

!Pragma methodsFor: 'accessing-pragma' stamp: 'lr 1/19/2006 20:55'!
message
	"Answer the message of the receiving pragma."
	
	^ Message selector: self keyword arguments: self arguments. ! !

!Pragma methodsFor: 'accessing-pragma' stamp: 'eem 12/1/2008 10:42'!
key
	"Answer the keyword of the pragma (the selector of its message pattern).
	 This accessor provides polymorphism with Associations used for properties."
	^keyword! !

!Pragma methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 12/7/2014 16:14'!
gtDisplayOn: stream
	self method gtDisplayOn: stream.
	stream space.
	self printOn: stream! !

!Pragma methodsFor: 'processing' stamp: 'lr 3/19/2007 11:37'!
withArgumentsDo: aBlock
	"Pass the arguments of the receiving pragma into aBlock and answer the result."
	
	^ aBlock valueWithArguments: self arguments! !

!Pragma methodsFor: 'comparing' stamp: 'GabrielBarbuto 11/30/2010 11:26'!
hash

	| hash |

	hash := self method hash bitXor: self keyword hash.
	1 to: self basicSize do: [:index | hash := hash bitXor: (self basicAt: index) hash].

	^hash.! !

!Pragma methodsFor: 'accessing-pragma' stamp: 'eem 12/1/2008 10:42'!
keyword
	"Answer the keyword of the pragma (the selector of its message pattern).
	 For a pragma defined as <key1: val1 key2: val2> this will answer #key1:key2:."
	
	^ keyword! !

!Pragma methodsFor: 'initialization' stamp: 'lr 1/19/2006 23:39'!
setMethod: aCompiledMethod
	method := aCompiledMethod! !

!Pragma methodsFor: 'processing' stamp: 'lr 3/19/2007 11:37'!
sendTo: anObject
	"Send the pragma keyword together with its arguments to anObject and answer the result."
	
	^ anObject perform: self keyword withArguments: self arguments! !

!Pragma methodsFor: 'accessing-method' stamp: 'lr 1/20/2006 02:04'!
method
	"Answer the compiled-method containing the pragma."
	
	^ method! !

!Pragma methodsFor: 'initialization' stamp: 'lr 1/20/2006 00:53'!
setArguments: anArray
	arguments := anArray! !

!Pragma methodsFor: 'comparing' stamp: 'GabrielBarbuto 11/30/2010 11:26'!
= aPragma

	self == aPragma ifTrue: [^true].
	self species == aPragma species ifFalse: [^false].

	self method = aPragma method ifFalse: [^false].
	self keyword = aPragma keyword ifFalse: [^false].
	self arguments = aPragma arguments ifFalse: [^false].

	^true.! !

!Pragma methodsFor: 'accessing-pragma' stamp: 'lr 1/20/2006 02:10'!
numArgs
	"Answer the number of arguments in the pragma."

	^ self arguments size.! !

!Pragma methodsFor: 'accessing-pragma' stamp: 'lr 1/19/2006 20:54'!
arguments
	"Answer the arguments of the receiving pragma. For a pragma defined as <key1: val1 key2: val2> this will answer #(val1 val2)."
	
	^ arguments! !

!Pragma methodsFor: 'testing' stamp: 'eem 11/29/2008 17:03'!
hasLiteralSuchThat: aBlock
	"Answer true if litBlock returns true for any literal in the receiver, even if embedded in further array structure.
	 This method is only intended for private use by CompiledMethod hasLiteralSuchThat:"
	^(aBlock value: keyword)
	   or: [arguments hasLiteralSuchThat: aBlock]! !

!Pragma class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/26/2015 18:13'!
gtExamplePragma
	<gtExample: 'Pragma'>
	^ (Pragma class >> #gtExamplePragma) pragmas anyOne! !

!Pragma class methodsFor: 'finding' stamp: 'lr 1/19/2006 20:12'!
allNamed: aSymbol from: aSubClass to: aSuperClass sortedUsing: aSortBlock
	"Answer a collection of all pragmas found in methods of all classes between aSubClass and aSuperClass (inclusive) whose keyword is aSymbol, sorted according to aSortBlock."
	
	^ (self allNamed: aSymbol from: aSubClass to: aSuperClass) sort: aSortBlock.! !

!Pragma class methodsFor: 'private' stamp: 'lr 1/20/2006 00:34'!
keyword: aSymbol arguments: anArray
	^ self new
		setKeyword: aSymbol;
		setArguments: anArray;
		yourself.! !

!Pragma class methodsFor: 'instance creation' stamp: 'eem 11/29/2008 14:00'!
for: aMethod selector: aSelector arguments: anArray
	^self new
		setMethod: aMethod;
		setKeyword: aSelector;
		setArguments: anArray;
		yourself! !

!Pragma class methodsFor: 'private' stamp: 'lr 1/20/2006 08:50'!
withPragmasIn: aClass do: aBlock
	aClass selectorsAndMethodsDo: [ :selector :method | method pragmas do: aBlock ].! !

!Pragma class methodsFor: 'finding' stamp: 'lr 1/19/2006 20:06'!
allNamed: aSymbol in: aClass sortedUsing: aSortBlock
	"Answer a collection of all pragmas found in methods of aClass whose keyword is aSymbol, sorted according to aSortBlock."
	
	^ (self allNamed: aSymbol in: aClass) sort: aSortBlock.! !

!Pragma class methodsFor: 'finding' stamp: 'lr 1/20/2006 18:16'!
allNamed: aSymbol in: aClass sortedByArgument: anInteger
	"Answer a collection of all pragmas found in methods of aClass whose keyword is aSymbol, sorted according to argument anInteger."

	^ self allNamed: aSymbol in: aClass sortedUsing: [ :a :b | (a argumentAt: anInteger) < (b argumentAt: anInteger) ].! !

!Pragma class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 10/4/2013 22:16'!
gtInspectorAnnotatedMethodsIn: composite
	<gtInspectorPresentationOrder: 30> 
	composite table 
		title: 'All';
		showOnly: 50;
		withSmalltalkSearch;
		display: [:anObject | 
			| pragmas |
			pragmas := OrderedCollection new.
			Object withAllSubclassesDo: [:each |
				Pragma withPragmasIn: each do: [:p |
					pragmas add: p]].
			(pragmas groupedBy: #keyword) associations sorted: [ :a :b | 
				a key < b key ]
		];
		column: 'Keyword' evaluated: [ :each | each key ];
		column: 'Instances' evaluated: [ :each | each value size asString ];
		send: #value! !

!Pragma class methodsFor: 'finding' stamp: 'lr 1/20/2006 08:55'!
allNamed: aSymbol in: aClass
	"Answer a collection of all pragmas found in methods of aClass whose keyword is aSymbol."
	
	^ Array streamContents: [ :stream |
		self withPragmasIn: aClass do: [ :pragma |
			pragma keyword = aSymbol
				ifTrue: [ stream nextPut: pragma ] ] ].! !

!Pragma class methodsFor: 'finding' stamp: 'lr 1/20/2006 08:54'!
allNamed: aSymbol from: aSubClass to: aSuperClass
	"Answer a collection of all pragmas found in methods of all classes between aSubClass and aSuperClass (inclusive) whose keyword is aSymbol."
	
	^ Array streamContents: [ :stream |
		aSubClass withAllSuperclassesDo: [ :class |
			self withPragmasIn: class do:  [ :pragma |
				pragma keyword = aSymbol
					ifTrue: [ stream nextPut: pragma ] ].
			aSuperClass = class
				ifTrue: [ ^ stream contents ] ] ].! !

!Pragma class methodsFor: 'finding' stamp: 'lr 1/20/2006 18:16'!
allNamed: aSymbol from: aSubClass to: aSuperClass sortedByArgument: anInteger
	"Answer a collection of all pragmas found in methods of all classes between aSubClass and aSuperClass (inclusive) whose keyword is aSymbol, sorted according to argument anInteger."

	^ self allNamed: aSymbol from: aSubClass to: aSuperClass sortedUsing: [ :a :b | (a argumentAt: anInteger) < (b argumentAt: anInteger) ].! !

!PragmaAdded commentStamp: 'alain.plantec 10/20/2009 11:34'!
A PragmaAdded is announced by a PragamColllector when a method defined with an acceptable pragma according to the PragmaCollector filter is added.

Instance Variables
!
!PragmaAnnouncement commentStamp: 'alain.plantec 10/20/2009 11:34'!
A PragmaAnnouncement is announced by a PragmaCollector when it adds, removes or updates a PragmaHandler.

Instance Variables
	pragma:		<Pragma>

pragma
	- the pragma which has been added, removed or updated
!
!PragmaAnnouncement methodsFor: 'accessing' stamp: 'alain.plantec 9/18/2009 22:39'!
pragma: aPragma
	pragma := aPragma! !

!PragmaAnnouncement methodsFor: 'accessing' stamp: 'alain.plantec 9/18/2009 22:39'!
pragma
	^ pragma! !

!PragmaAnnouncement class methodsFor: 'instance creation' stamp: 'alain.plantec 10/19/2009 10:47'!
pragma: aPragma
	^ self new pragma: aPragma! !

!PragmaCollector commentStamp: 'AlainPlantec 11/28/2009 01:09'!
A PragmaCollector is used in order to collect some Pragma instances. A PragmaCollector makes use of SystemChangeNotifier event notifications in order to maintain its contents up-to-date according to its filter: when a method is added, removed or updated, if the method is defined with a pragma which is acceptable according to its filter, then the collector contents is updated. A PragmaCollector makes use of an announcer in order to notify all registered listeners when a pragma is added, removed or updated. A PragmaAnnouncement is announced when a Pragma is added, removed or updated. Corresponding announcement classes are, respectiveley, PragmaAdded, PragmaRemoved and PragmaUpdated. 

Explore the result of the expression below. In the collected instance variable should be stored all pragmas of the system:
---------------------------
(PragmaCollector filter: [:pragma | true]) reset
---------------------------

In the following example, collected pragma are thoses with the 'primitive:' keyword (<primitive:>)
---------------------------
(PragmaCollector filter: [:prg | prg keyword = 'primitive:']) reset
---------------------------

Instance Variables	
	announcer:		<Announcer>	
	collected:		<Collection>
	filter:			<Block or MessageSend>
				
announcer
	the announcer which is used to announce the adding, the removing or the updating of a method with an acceptable pragma declaration

collected		
	the current collection of Pragma
	
filter
	a block or a message send which is used in order to filter the pragma. This is a one argument valuable. When evaluated, the candidate pragam is passed as argument and the result must be a boolean. 
	!
!PragmaCollector methodsFor: 'enumerating' stamp: 'alain.plantec 9/18/2009 15:26'!
detect: aBlock
	^ self collected detect: aBlock ifNone:[]
	! !

!PragmaCollector methodsFor: 'accessing' stamp: 'alain.plantec 10/20/2009 13:15'!
collected
	^ collected ifNil: [collected := OrderedCollection new] ! !

!PragmaCollector methodsFor: 'subscription' stamp: 'alain.plantec 10/19/2009 10:42'!
whenResetSend: aSelector to: anObject
	"record a change listener"
	self subscribe: PragmaCollectorReset send: aSelector to: anObject
! !

!PragmaCollector methodsFor: 'updating' stamp: 'alain.plantec 10/19/2009 10:48'!
removePragma: aPragma 
	"remove an handler an announce it"
	self collected remove: aPragma ifAbsent: [].
	self announce: (PragmaRemoved pragma: aPragma)! !

!PragmaCollector methodsFor: 'querying' stamp: 'alain.plantec 9/18/2009 15:30'!
pragmasOfClass: aClass 
	"return all handlers of class aClass"
	^ self	select: [:prag | prag methodClass = aClass ]! !

!PragmaCollector methodsFor: 'enumerating' stamp: 'alain.plantec 9/18/2009 15:26'!
reject: aBlock
	^ self collected reject: aBlock ! !

!PragmaCollector methodsFor: 'subscription' stamp: 'alain.plantec 9/18/2009 15:26'!
announce: anAnnouncement
	"see Announcements packages"
	self announcer ifNotNil: [announcer announce: anAnnouncement]! !

!PragmaCollector methodsFor: 'accessing' stamp: 'alain.plantec 10/19/2009 10:59'!
filter
	^ filter ifNil: [filter := [:prg | true]]! !

!PragmaCollector methodsFor: 'initialization' stamp: 'alain.plantec 9/18/2009 15:26'!
initialize
	super initialize.
	announcer := Announcer new.
	self installSystemNotifications! !

!PragmaCollector methodsFor: 'querying' stamp: 'alain.plantec 9/18/2009 15:44'!
pragmaWithSelector: aSelector inClass: aClass 
	"return the handler corresponding to a pragma method which selector is aSelector in class aClass"
	^ (self detect: [:prag | prag methodClass = aClass and: [prag  selector = aSelector]])
	! !

!PragmaCollector methodsFor: 'subscription' stamp: 'alain.plantec 9/18/2009 15:26'!
whenChangedSend: aSelector to: anObject
	"record a change listener"
	self subscribe: PragmaAnnouncement send: aSelector to: anObject
! !

!PragmaCollector methodsFor: 'system changes' stamp: 'GuillermoPolito 8/3/2012 14:41'!
modifiedEventOccurs: anEvent 
	"
	a method has been updated: try to update an handler:
	1 - I already have one for the method, then
	do nothing, 
	2 - I do not have one but method has an acceptable
	pragma in it, then I try to add a new handler
	3 - I have one but changed method has no more
	acceptable pragma in it, then the handler is removed.
	"
	Pragma
		withPragmasIn: anEvent methodClass
		do: [:pragma | pragma selector = anEvent selector
				ifTrue: [(self 
								detect: [:oldprag | oldprag selector = pragma selector
										and: [oldprag methodClass = anEvent methodClass]])
						ifNotNil: [:oldprag | ^ self updatePragma: oldprag].
					^ self addPragma: pragma]].
	"No pragma but an handler for the method"
	(self pragmaWithSelector: anEvent selector inClass: anEvent methodClass)
		ifNotNil: [:found | self removePragma: found]! !

!PragmaCollector methodsFor: 'system changes' stamp: 'alain.plantec 9/18/2009 15:26'!
noMoreAnnounceWhile: aBlock
	"unplug the announcer during aBlock"
	| oldAnnouncer |
	[oldAnnouncer := announcer.
	announcer := nil.
	aBlock value]
		ensure: [announcer := oldAnnouncer]! !

!PragmaCollector methodsFor: 'subscription' stamp: 'alain.plantec 9/18/2009 15:26'!
unsubscribe: anObject
	"see Announcements packages"
	self announcer unsubscribe: anObject

! !

!PragmaCollector methodsFor: 'dependents access' stamp: 'alain.plantec 9/18/2009 22:09'!
release
	self noMoreNotifications.
	announcer := nil.
	collected := nil.
	super release! !

!PragmaCollector methodsFor: 'enumerating' stamp: 'alain.plantec 9/18/2009 15:26'!
noneSatisfy: aBlock
	^ self collected noneSatisfy: aBlock! !

!PragmaCollector methodsFor: 'accessing' stamp: 'alain.plantec 9/18/2009 15:26'!
announcer
	^ announcer! !

!PragmaCollector methodsFor: 'testing' stamp: 'alain.plantec 9/18/2009 15:26'!
isNotEmpty
	^ self collected isNotEmpty! !

!PragmaCollector methodsFor: 'testing' stamp: 'alain.plantec 9/18/2009 15:26'!
isEmpty
	^ self collected isEmpty! !

!PragmaCollector methodsFor: 'updating' stamp: 'alain.plantec 10/19/2009 10:49'!
updatePragma: aPragma
	"only announce that the pragma has been updated"
	self announcer announce: (PragmaUpdated pragma: aPragma)! !

!PragmaCollector methodsFor: 'initializing' stamp: 'alain.plantec 10/19/2009 11:46'!
reset
	"reinitialize current system settings"
	self
		noMoreAnnounceWhile: [self collected copy
				do: [:pragma | self removePragma: pragma].
			self class allSystemPragmas
				do: [:pragma | self addPragma: pragma]].
	self announce: (PragmaCollectorReset collector: self)! !

!PragmaCollector methodsFor: 'system changes' stamp: 'BernardoContreras 10/7/2014 12:28'!
installSystemNotifications
	"Allows myself to be kept up-to-date regarding system changes"
	
	SystemAnnouncer uniqueInstance unsubscribe: self.
	
	SystemAnnouncer uniqueInstance weak
			when: ClassRemoved send: #classRemovedEventOccurs: to: self;
			when: MethodRemoved send: #removedEventOccurs: to: self;
			when: MethodAdded send: #addedEventOccurs: to: self;
			when: MethodModified send: #modifiedEventOccurs: to: self! !

!PragmaCollector methodsFor: 'system changes' stamp: 'alain.plantec 9/18/2009 15:26'!
noMoreNotificationsWhile: aBlock
	"don not receive any system change notification during aBloc"
	self noMoreNotifications.
	[ aBlock value ] ensure: [ self installSystemNotifications ]! !

!PragmaCollector methodsFor: 'updating' stamp: 'alain.plantec 10/19/2009 10:58'!
keepPragma: aPragma
	^ self filter value: aPragma
! !

!PragmaCollector methodsFor: 'subscription' stamp: 'alain.plantec 9/18/2009 15:26'!
subscribe: anAnnouncement send: aSelector to: anObject
	"see Announcements packages"
	self announcer subscribe: anAnnouncement send: aSelector to: anObject

! !

!PragmaCollector methodsFor: 'testing' stamp: 'alain.plantec 9/18/2009 15:26'!
ifNotEmpty: aBlock
	self collected ifNotEmpty: aBlock! !

!PragmaCollector methodsFor: 'enumerating' stamp: 'alain.plantec 9/18/2009 15:26'!
select: aBlock
	^ self collected select: aBlock
	! !

!PragmaCollector methodsFor: 'enumerating' stamp: 'VincentBlondeau 1/30/2015 16:10'!
collect: aBlock
	^ self collected collect: aBlock
	! !

!PragmaCollector methodsFor: 'enumerating' stamp: 'alain.plantec 9/18/2009 15:26'!
do: aBlock
	self collected do: aBlock
	! !

!PragmaCollector methodsFor: 'system changes' stamp: 'GuillermoPolito 8/3/2012 14:40'!
addedEventOccurs: anEvent
	"method adding event occured: if the 
	concerned method contains a pragma then 
	try to update myself with it"
	Pragma
		withPragmasIn: anEvent methodClass
		do: [:pragma | pragma selector = anEvent selector
				ifTrue: [self addPragma: pragma]] ! !

!PragmaCollector methodsFor: 'system changes' stamp: 'GuillermoPolito 8/3/2012 14:41'!
removedEventOccurs: anEvent
	"a method has been removed, remove any corresponding handler if found"
	(self
				detect: [:prag | prag selector = anEvent selector
						and: [prag methodClass = anEvent methodClass ]])
		ifNotNil: [:found | self removePragma: found]! !

!PragmaCollector methodsFor: 'system changes' stamp: 'GuillermoPolito 8/3/2012 14:42'!
classRemovedEventOccurs: anEvent
	"a class has been removed: first see if the class is not my class
	because then I must be unplugged from system event notifications"
	anEvent classRemoved = self class
		ifTrue: [^ self noMoreNotifications].
	"remove all handler which are from the removed class"
	(self pragmasOfClass: anEvent classRemoved class)
		do: [:handler | self removePragma: handler] ! !

!PragmaCollector methodsFor: 'system changes' stamp: 'EstebanLorenzano 8/3/2012 14:08'!
noMoreNotifications
	"Do not receiver any system change notification anymore"
	SystemAnnouncer uniqueInstance unsubscribe: self.! !

!PragmaCollector methodsFor: 'updating' stamp: 'alain.plantec 10/19/2009 10:54'!
addPragma: aPragma
	"if aPragma is to be kept, then add it and announce its adding"
	(self keepPragma: aPragma)
		ifTrue: [self collected add: aPragma.
			self announce: (PragmaAdded pragma: aPragma)]! !

!PragmaCollector methodsFor: 'accessing' stamp: 'alain.plantec 10/19/2009 11:00'!
filter: aOneArgValuable
	filter := aOneArgValuable! !

!PragmaCollector class methodsFor: 'utilities' stamp: 'MarcusDenker 7/12/2012 17:59'!
allSystemPragmas
	^ (Array
		streamContents: [:stream | SystemNavigation new
				allBehaviorsDo: [:behavior | Pragma
						withPragmasIn: behavior
						do: [:pragma | stream nextPut: pragma]]]) ! !

!PragmaCollector class methodsFor: 'instance creation' stamp: 'alain.plantec 10/19/2009 16:16'!
filter: aOneArgValuable
	^ self new filter: aOneArgValuable! !

!PragmaCollectorReset commentStamp: 'alain.plantec 10/20/2009 11:14'!
A PragmaCollectorReset is an announce which is announced by a PragamColllector when it is reset.
see PragmaCollector>>reset.

Instance Variables
	collector:		<PragmaCollector>

collector
	- the collector which is reset
!
!PragmaCollectorReset methodsFor: 'accessing' stamp: 'alain.plantec 10/19/2009 11:45'!
collector: aCollector
	collector := aCollector! !

!PragmaCollectorReset methodsFor: 'accessing' stamp: 'DanielAvivEstebanAllende 1/29/2013 10:45'!
collector
	^collector! !

!PragmaCollectorReset class methodsFor: 'instance creation' stamp: 'alain.plantec 10/19/2009 11:45'!
collector: aCollector
	^ self new collector: aCollector! !

!PragmaMenuAndShortcutRegistration commentStamp: '<historical>'!
A PragmaMenuAndShortcutRegistration is the list items holder!
!PragmaMenuAndShortcutRegistration methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/7/2012 22:36'!
currentRoot

	^ currentRoot! !

!PragmaMenuAndShortcutRegistration methodsFor: 'keymapping protocol' stamp: 'GuillermoPolito 9/24/2012 11:57'!
category: aByteSymbol shortcut: aKMModifiedShortcut do: aBlockClosure description: aByteString 
	
	self currentItem
		category: aByteSymbol;
		default: aKMModifiedShortcut;
		action: aBlockClosure;
		help: aByteString! !

!PragmaMenuAndShortcutRegistration methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 20:49'!
parent: aSymbol 
	
	self currentItem parent: aSymbol ! !

!PragmaMenuAndShortcutRegistration methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/7/2012 23:16'!
model: aModel

	model := aModel.! !

!PragmaMenuAndShortcutRegistration methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/7/2012 21:25'!
items

	^ items! !

!PragmaMenuAndShortcutRegistration methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 20:48'!
currentItem

	^ items last! !

!PragmaMenuAndShortcutRegistration methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/7/2012 22:37'!
currentRoot: aMenuRegistration 

	currentRoot := aMenuRegistration! !

!PragmaMenuAndShortcutRegistration methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 23:00'!
item: aSymbol 
	
	self createNewItem.
	self currentItem item: aSymbol! !

!PragmaMenuAndShortcutRegistration methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 23:06'!
initialize

	super initialize.

	items := OrderedCollection new.! !

!PragmaMenuAndShortcutRegistration methodsFor: 'keymapping protocol' stamp: 'YuriyTymchuk 12/20/2013 15:22'!
keyText: aString if: aBoolean
	aBoolean ifFalse: [ ^ self ].
	self keyText: aString! !

!PragmaMenuAndShortcutRegistration methodsFor: 'keymapping protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 23:27'!
description: aByteString 
	
	self currentItem
		help: aByteString! !

!PragmaMenuAndShortcutRegistration methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/7/2012 21:26'!
enabled: aBoolean
 
	self currentItem enabled: aBoolean! !

!PragmaMenuAndShortcutRegistration methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 20:49'!
label: aString
	
	self currentItem label: aString! !

!PragmaMenuAndShortcutRegistration methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 20:49'!
help: aString 
	
	self currentItem help: aString ! !

!PragmaMenuAndShortcutRegistration methodsFor: 'keymapping protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 23:12'!
platform: anArray
 
	anArray isEmpty
		ifTrue: [ platform := #all ]
		ifFalse: [ platform := anArray first ]! !

!PragmaMenuAndShortcutRegistration methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 21:19'!
target: aSymbol 

	self currentItem target: aSymbol ! !

!PragmaMenuAndShortcutRegistration methodsFor: 'initialization' stamp: 'SeanDeNigris 7/16/2012 12:36'!
attachShortcutCategory: aSymbol to: aClass 

	KMRepository default attachCategoryName: aSymbol to: aClass.! !

!PragmaMenuAndShortcutRegistration methodsFor: 'menu protocol' stamp: 'EstebanLorenzano 1/30/2013 16:47'!
keyText: aString
	self currentItem keyText: aString! !

!PragmaMenuAndShortcutRegistration methodsFor: 'keymapping protocol' stamp: 'GuillermoPolito 5/3/2013 15:49'!
setAsGlobalCategory: aGlobalCategory

	KMRepository default setAsGlobalCategory: aGlobalCategory! !

!PragmaMenuAndShortcutRegistration methodsFor: 'keymapping protocol' stamp: 'GuillermoPolito 9/24/2012 11:58'!
category: aByteSymbol default: aKMModifiedShortcut do: aBlockClosure description: aByteString 
	
	self currentItem
		category: aByteSymbol;
		default: aKMModifiedShortcut;
		action: aBlockClosure;
		help: aByteString! !

!PragmaMenuAndShortcutRegistration methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 23:00'!
group: aSymbol 
	
	self createNewItem.
	self currentItem group: aSymbol! !

!PragmaMenuAndShortcutRegistration methodsFor: 'keymapping protocol' stamp: 'GuillermoPolito 9/24/2012 11:57'!
category: aByteSymbol shortcut: aKMModifiedShortcut do: aBlockClosure 
	
	self currentItem
		category: aByteSymbol;
		default: aKMModifiedShortcut;
		action: aBlockClosure ! !

!PragmaMenuAndShortcutRegistration methodsFor: 'menu protocol' stamp: 'NicolaiHess 9/9/2014 12:32'!
with: aBlock
	| old itemOrGroup |
	old := self currentRoot.
	itemOrGroup := self currentItem item ifNil: [ self currentItem group ].
	self currentRoot: itemOrGroup.
	[ aBlock value ]
		ensure: [ self currentRoot: old ]! !

!PragmaMenuAndShortcutRegistration methodsFor: 'keymapping protocol' stamp: 'GuillermoPolito 9/24/2012 11:58'!
shortcut: aSymbol
	
	self createNewItem.
	self currentItem shortcut: aSymbol! !

!PragmaMenuAndShortcutRegistration methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 20:48'!
action: aBlock

	self currentItem action: aBlock! !

!PragmaMenuAndShortcutRegistration methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 23:00'!
createNewItem
	
	items add: self itemClass new.
	
	self currentItem
		platform: platform;
		parent: currentRoot! !

!PragmaMenuAndShortcutRegistration methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 21:17'!
arguments: anArray

	self currentItem arguments: anArray! !

!PragmaMenuAndShortcutRegistration methodsFor: 'keymapping protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 22:59'!
default: aKMModifiedShortcut
	
	self currentItem
		default: aKMModifiedShortcut! !

!PragmaMenuAndShortcutRegistration methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 21:06'!
selector: aSelector 
	
	self currentItem selector: aSelector! !

!PragmaMenuAndShortcutRegistration methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 20:49'!
icon: anIcon
	
	self currentItem icon: anIcon! !

!PragmaMenuAndShortcutRegistration methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/7/2012 23:16'!
model

	^ model! !

!PragmaMenuAndShortcutRegistration methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 20:49'!
withSeparatorAfter

	self currentItem withSeparatorAfter! !

!PragmaMenuAndShortcutRegistration methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 21:37'!
order: anInteger 
	
	self currentItem order: anInteger ! !

!PragmaMenuAndShortcutRegistration methodsFor: 'keymapping protocol' stamp: 'GuillermoPolito 9/24/2012 11:58'!
category: aByteSymbol default: aKMModifiedShortcut do: aBlockClosure 
	
	self currentItem
		category: aByteSymbol;
		default: aKMModifiedShortcut;
		action: aBlockClosure ! !

!PragmaMenuAndShortcutRegistration methodsFor: 'keymapping protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 23:27'!
do: aBlockClosure
	
	self currentItem
		action: aBlockClosure! !

!PragmaMenuAndShortcutRegistration methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 20:49'!
enabledBlock: aBlock

	self currentItem enabledBlock: aBlock! !

!PragmaMenuAndShortcutRegistration methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 21:45'!
precondition: aBlock 
	
	self currentItem precondition: aBlock ! !

!PragmaMenuAndShortcutRegistration methodsFor: 'private' stamp: 'BenjaminVanRyseghem 4/7/2012 20:50'!
itemClass

	^ PragmaMenuAndShortcutRegistrationItem! !

!PragmaMenuAndShortcutRegistration methodsFor: 'keymapping protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 22:59'!
category: aByteSymbol
	
	self currentItem
		category: aByteSymbol! !

!PragmaMenuAndShortcutRegistration class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 4/7/2012 23:16'!
model: aModel

	^ self new
		model: aModel;
		yourself! !

!PragmaMenuAndShortcutRegistrationItem commentStamp: '<historical>'!
A PragmaMenuAndShortcutRegistrationItem is an item of a menu or keymap!
!PragmaMenuAndShortcutRegistrationItem methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/7/2012 21:28'!
icon

	^ icon! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/7/2012 21:29'!
selector

	^ selector! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/7/2012 23:43'!
enabled

	^ enabled! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 20:47'!
parent: aSymbol 
	
	parent := aSymbol ! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/7/2012 21:48'!
with

	^ with! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 20:47'!
item: aSymbol 
	
	item := aSymbol! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/7/2012 23:11'!
platform

	^ platform! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/7/2012 23:43'!
enabledBlock
	
	^ enabledBlock! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 23:07'!
initialize

	super initialize.

	withSeparatorAfter := false.! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/7/2012 21:27'!
action
	
	^ action! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/7/2012 21:34'!
parent

	^ parent! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'accessing' stamp: 'EstebanLorenzano 1/30/2013 16:48'!
keyText
	^keyText! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/7/2012 21:26'!
enabled: aBoolean

	enabled := aBoolean! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 20:47'!
label: aString
	
	label := aString! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'protocol' stamp: 'GuillermoPolito 9/24/2012 11:56'!
shortcutName
	
	^shortcutName! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/7/2012 21:47'!
group
	
	^ group! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 21:19'!
target: aSymbol 
	
	target := aSymbol ! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 20:47'!
help: aString 
	
	help := aString ! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 23:11'!
platform: aSymbol 

	platform := aSymbol! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'menu protocol' stamp: 'EstebanLorenzano 1/30/2013 16:47'!
keyText: aString
	keyText := aString! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 21:41'!
group: aSymbol

	group := aSymbol! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 23:11'!
category

	^ category! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 21:52'!
with: aBlock
 
	with := aBlock! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/7/2012 21:29'!
isWithSeparatorAfter
	
	^ withSeparatorAfter! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 23:10'!
shortcut: aSymbol 
	
	shortcut := aSymbol! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 20:47'!
action: aBlock

	action := aBlock! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 23:11'!
default: aKMModifiedShortcut 

	default := aKMModifiedShortcut ! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 21:17'!
arguments: anArray

	arguments := anArray! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/7/2012 21:34'!
order

	^ order! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 21:07'!
selector: aSymbol 
	
	selector := aSymbol ! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 20:47'!
icon: anIcon
	
	icon := anIcon! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/7/2012 23:10'!
shortcut
	
	^ shortcut! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 21:19'!
withSeparatorAfter

	withSeparatorAfter := true! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/7/2012 23:11'!
default

	^ default! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/7/2012 21:28'!
label

	^ label! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/7/2012 21:27'!
item

	^ item! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 21:37'!
order: anInteger 

	order := anInteger! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'protocol' stamp: 'GuillermoPolito 9/24/2012 11:56'!
shortcutName: aSymbol 
	
	shortcutName := aSymbol! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/7/2012 21:28'!
help

	^ help! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 20:47'!
enabledBlock: aBlock

	enabledBlock := aBlock! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/7/2012 21:29'!
arguments
	
	^ arguments! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'menu protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 21:45'!
precondition: aBlock
	
	precondition := aBlock ! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/7/2012 21:29'!
target

	^ target! !

!PragmaMenuAndShortcutRegistrationItem methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 4/7/2012 23:11'!
category: aByteSymbol 
	
	category := aByteSymbol! !

!PragmaMenuBuilder commentStamp: 'AlainPlantec 11/16/2010 19:48'!
For the impatients, see MenuRegistrationExample class methods and try it with:
---------------
((PragmaMenuBuilder pragmaKeyword: MenuRegistrationExample pragmaKeyword model: nil) menuEntitled: 'World') popUpInWorld
---------------

PragmaMenuBuilder is for the dynamic building of menus based on pragmas. A PragmaMenuBuilder instance is the root of a tree of MenuRegistration instances.
The basic principle is that each menu sub-tree is specified by a method which is tagged by a specific pragma. Such methods are dynamically retrieved and then evaluated with a MenuRegistration passed as argument (see #retrieveRegistrations). The result is a tree of MenuRegistration which roots are stored in my itemList inst. var.
After the tree of MenuRegistration has been built, it is re-organized (re-organization is based on the parent declaration) and is re-ordered (based on the MenuRegistration order indications). Then the tree of MenuRegistration can serve as input for the building of a PluggableMenuSpec. The PluggableMenuSpec is itself used in order to build a MenuMorph with the help of the current ToolBuilder. (see MenuRegistration comment for more informations about how to specify menu entries).

The tree of MenuRegistration is built by #buildTree in three steps (1) the  collecting of the MenuRegistration instances (2) the re-organization and (3) the sorting:

1) The first step consists in evaluating all pragma methods by passing a builder (a PragmaMenuBuilder instance) as argument. Each pragma method invocation build a sub-tree which root is added to the builder itemList collection. (see #collectRegistrations).
As an example, this first step could produce a tree as follow (stored in a PragmaMenuBuilder itemList inst var) :
				#Tools						#'Other tool', parentName: #Tools
				/	\										|
	(#Worspace)	(#browser)						(#'Test runner' )

2) The second step consists is re-organizing the tree. A MenuRegistration can be declared with a particular parent name (by sending #parent: to it with a symbol as argument). If the parentName of a MenuRegistration X is the name of another MenuRegistration Z, then it means that X must be placed as a child of Z. This is the goal of this re-arrangement step which moves badly placed nodes at their good place. (see #arrangeRegistrations).
With previous example, the second step produces:
						#Tools								
				/		|			\
	(#Worspace)	(#browser)		#'Other tool' , parentName: #Tools
											|
									(#'Test runner')

2) The third step consists in sorting the tree according to the order inst. var. value of each MenuRegistration. This is done in two passes: the first pass tries to assign as much order inst. var. as possible (If an item is given with a specific order, then, previous and following items order can be automatically computed - see #assignOrderWithBlock: and #orderAssignBlock). The second pass consists in a smple sort according to a sort block given by #itemSortBlock.


Instance Variables
	model:		<Object>
	pragmaCollector:		<PragmaCollection>
	pragmaKeywords:		<Collection of Symbol>
	currentRoot: 			<MenuRegistration>

model
	- Serves as the default target for the menu. Note that a default target can also be declared at menu item level

pragmaKeywords
	- The list of pragma keywords used for the declaring of my menu items

pragmaCollector
	- The PragmaCollector associated with this builder. When a method declared with the same pragma as my pragmaKeyword is updated/added/removed my menu items are recomputed so that the resulting menu is always in sync with currently declared items.
	
currentRoot
	- the current MenuRegistration in which new items are to be added

!
!PragmaMenuBuilder methodsFor: 'registrations handling' stamp: 'BenjaminVanRyseghem 4/7/2012 22:19'!
collectRegistrations
	"Retrieve all pragma methods and evaluate them by passing the 
	MenuRegistration class as argument. The result is a list of trees
	stored in my itemList inst var"
	| menu |
	menu := PragmaMenuAndShortcutRegistration model: self model.
	self pragmaCollector
		do: [:prg | self
				currentRoot: self
				while: [ prg methodClass theNonMetaClass perform: prg selector with: menu ]].

	self interpretRegistration: menu.! !

!PragmaMenuBuilder methodsFor: 'registrations handling' stamp: 'AlainPlantec 2/18/2010 11:46'!
arrangeRegistrations.
	self allMisplacedItems do: [:item |
		(self itemNamed: item parentName)
			ifNotNil: [:newOwner | item owner removeItem: item.
				item owner: newOwner.
				newOwner addItem: item]].
! !

!PragmaMenuBuilder methodsFor: 'public menu building' stamp: 'StephaneDucasse 6/5/2011 22:48'!
menuSpecAt: aName
	"returns a PluggableMenuSpec build from my contents starting at 
	the inner MenuRegistration named aName or from here if aName is nil"
	| root |
	self buildTree.
	root := PluggableMenuSpec withModel: nil.
	(aName ifNil: [self] ifNotNil: [self itemNamed: aName]) 
		ifNotNil: [:top | top precondition value ifTrue: [top buildMenuSpec: root]].
	^ root! !

!PragmaMenuBuilder methodsFor: 'accessing' stamp: 'AlainPlantec 11/16/2010 20:53'!
pragmaKeyword
	"Deprecated"
	^  pragmaKeywords isEmptyOrNil ifFalse: [pragmaKeywords first]! !

!PragmaMenuBuilder methodsFor: 'registrations handling' stamp: 'AlainPlantec 11/16/2010 19:55'!
pragmaCollector
	"Return an up-to-date pragmaCollector which contains all pragmas which keyword is self pragmaKeyword"
	^ pragmaCollector 
		ifNil: [pragmaCollector:= (PragmaCollector filter: [:prg | 
				(self pragmaKeywords includes: prg keyword) and: [prg selector numArgs = 1]]).
			(self pragmaKeywords notNil and: [self pragmaKeywords notEmpty])  ifTrue: [pragmaCollector reset].
			pragmaCollector whenChangedSend: #reset to: self.
			pragmaCollector]! !

!PragmaMenuBuilder methodsFor: 'accessing' stamp: 'AlainPlantec 11/16/2010 19:45'!
pragmaKeywords: aCollection
	"Returns the pragma keyword used to select pragmas (see #pragmaCollector)"
	pragmaKeywords addAll: (aCollection collect: [:k | k asSymbol])! !

!PragmaMenuBuilder methodsFor: 'initialization' stamp: 'AlainPlantec 11/16/2010 19:55'!
initialize
	super initialize.
	isGroup := true.
	currentRoot := self.
	pragmaKeywords := OrderedCollection new.
	! !

!PragmaMenuBuilder methodsFor: 'private' stamp: 'SeanDeNigris 6/16/2013 13:48'!
fallbackMenu

	^ FallbackMenu when: self fails: model.! !

!PragmaMenuBuilder methodsFor: 'menu building' stamp: 'AlainPlantec 2/16/2010 16:36'!
currentRoot: anItem while: aBlock
	| old |
	old := currentRoot.
	currentRoot := anItem.
	[aBlock value] ensure: [currentRoot := old]! !

!PragmaMenuBuilder methodsFor: 'public menu building' stamp: 'SeanDeNigris 6/16/2013 14:24'!
menuAt: aName
	"returns a MenuMorph from my menuSpec"
	^ self menuFrom: [ self menuSpecAt: aName ].! !

!PragmaMenuBuilder methodsFor: 'accessing' stamp: 'AlainPlantec 11/16/2010 19:37'!
pragmaKeywords
	"Returns the pragma keyword used to select pragmas (see #pragmaCollector)"
	^  pragmaKeywords ! !

!PragmaMenuBuilder methodsFor: 'menu building' stamp: 'AlainPlantec 2/16/2010 16:58'!
newSubItem
	| reg |
	reg := MenuRegistration owner: currentRoot.
	currentRoot addItem: reg.
	^ reg! !

!PragmaMenuBuilder methodsFor: 'initialize-release' stamp: 'AlainPlantec 2/15/2010 11:21'!
release
	self pragmaCollector unsubscribe: self.
	pragmaCollector := nil.
	model := nil.
	super release
	! !

!PragmaMenuBuilder methodsFor: 'accessing' stamp: 'AlainPlantec 2/13/2010 12:52'!
builder
	^ self! !

!PragmaMenuBuilder methodsFor: 'public menu building' stamp: 'SeanDeNigris 6/16/2013 13:26'!
menu
	"returns a MenuMorph build from my menuSpec"
	
	^ self menuFrom: [ self menuSpec ].! !

!PragmaMenuBuilder methodsFor: 'public menu building' stamp: 'AlainPlantec 2/14/2010 14:09'!
menuSpec
	"returns a PluggableMenuSpec build from my contents"
	^ self menuSpecAt: nil! !

!PragmaMenuBuilder methodsFor: 'registrations handling' stamp: 'AlainPlantec 2/12/2010 23:21'!
sortRegistrations
	"Try to update MenuRegistration order inst. var and the sort the trees"
	self assignOrderWithBlock: self class orderAssignBlock.
	self sort: self class itemSortBlock! !

!PragmaMenuBuilder methodsFor: 'private' stamp: 'NicolaiHess 9/9/2014 12:31'!
interpretRegistration: aRegistration 
	| root |
	root := MenuRegistration owner: self.
	aRegistration items do: [:item || node |
			node := item group
					ifNil: [ root item: item item ]
					ifNotNil: [:grp | root group: grp ].
			item with
				ifNil: [
					item action
						ifNil: [ 
							node 
								target: item target;
								arguments: item arguments;
								selector: item selector ]
						ifNotNil:[ 
							node 
								action: item action ]].
			node
				keyText: item keyText;
				help: item help;
				icon: item icon;
				order: item order;
				parent: item parent.
			item enabled
				ifNil: [ node enabledBlock: item enabledBlock ]
				ifNotNil: [:boolean | node enabled: boolean ].	
			item label
				ifNotNil: [ node label: item label ].
			item default ifNotNil: [ :d |
				node label: node label, ' (', d asString, ')'].
			item isWithSeparatorAfter
				ifTrue: [ node withSeparatorAfter ]]! !

!PragmaMenuBuilder methodsFor: 'private' stamp: 'SeanDeNigris 6/16/2013 13:25'!
menuFrom: specBlock

	^ [ specBlock value asMenuMorph ]
			on: Error
			do: [
				self reset.
				self fallbackMenu ].! !

!PragmaMenuBuilder methodsFor: 'menu building' stamp: 'BenComan 10/15/2013 14:03'!
buildTree
	"Retrieve all menu registrations with the help of a PragmaCollector then, 
	reorganise the tree and sort it  - see class comment for more informations"
	itemList := OrderedCollection new.
	self collectRegistrations.
	self arrangeRegistrations.
	self sortRegistrations! !

!PragmaMenuBuilder methodsFor: 'registrations handling' stamp: 'AlainPlantec 2/12/2010 14:34'!
allMisplacedItems
	| misplaced |
	self collectMisplacedItemsIn: (misplaced := OrderedCollection new).
	^ misplaced
! !

!PragmaMenuBuilder methodsFor: 'public menu building' stamp: 'SeanDeNigris 6/16/2013 13:24'!
menuEntitled: aTitle 
	"returns a MenuMorph build from my menuSpec"
	^ self menuFrom: [ self menuSpec label: aTitle ].! !

!PragmaMenuBuilder methodsFor: 'accessing' stamp: 'AlainPlantec 2/13/2010 12:40'!
model
	^ model! !

!PragmaMenuBuilder methodsFor: 'accessing' stamp: 'AlainPlantec 11/16/2010 19:45'!
pragmaKeyword: aString
	"Set the pragma keyword used to select pragmas (see #pragmaCollector)"
	pragmaKeywords add: aString asSymbol.
	self pragmaCollector reset.! !

!PragmaMenuBuilder methodsFor: 'accessing' stamp: 'AlainPlantec 2/13/2010 12:57'!
itemReceiver
	^ model! !

!PragmaMenuBuilder methodsFor: 'accessing' stamp: 'AlainPlantec 2/13/2010 12:40'!
model: anObject
	model := anObject! !

!PragmaMenuBuilder class methodsFor: 'private' stamp: 'GabrielOmarCotelli 12/4/2013 08:39'!
orderAssignBlock
	"The block which is used to set MenuRegistration tree node order inst var (which is used to sort the tree)"

	^ [ :list | 
	list
		detect: [ :n | n order notNil ]
		ifFound: [ :firstWithOrder | 
			| idx order |
			"A menu registration with an order indication hase been found - then compute order of previous and next nodes"
			idx := list indexOf: firstWithOrder.
			order := firstWithOrder order.
			idx > 1
				ifTrue: [ 
					idx - 1 to: 1 do: [ :pos | 
						(list at: pos) order: order - 1.
						order := order - 1 ] ].
			order := firstWithOrder order.
			idx + 1 to: list size do: [ :pos | 
				(list at: pos) order ifNil: [ (list at: pos) order: order + 1 ] ifNotNil: [ order := (list at: pos) order ].
				order := order + 1 ].
			list ]
		ifNone: [ list ]	"No order has been set - do not touch anything, the list order is ok" ]! !

!PragmaMenuBuilder class methodsFor: 'private' stamp: 'AlainPlantec 2/16/2010 19:35'!
itemSortBlock
	"The block which is used to sort a menu tree"
	^ [:a :b | 
		((a order notNil and: [b order notNil]) and: [a order ~= b order])
			ifTrue: [a order < b order]
			ifFalse: [((a order isNil and: [b order isNil]) or: [a order = b order])
				ifTrue: [true]
				ifFalse: [a order ifNil: [false] ifNotNil: [true]]]]! !

!PragmaMenuBuilder class methodsFor: 'instance creation' stamp: 'AlainPlantec 11/16/2010 19:46'!
pragmaKeyword: aPragmaKeyword model: aModel
	"Build a builder using aPragmaKeyword as the pragma keyword and aModel a the model of the resulting builder"
	^ self withAllPragmaKeywords: (Array with: aPragmaKeyword) model: aModel! !

!PragmaMenuBuilder class methodsFor: 'instance creation' stamp: 'SeanDeNigris 6/16/2013 14:18'!
withAllPragmaKeywords: aCollection model: aModel
	"Build a builder using aPragmaKeyword as the pragma keyword and aModel a the model of the resulting builder"
	^ self new 
		pragmaKeywords: aCollection;
		model: aModel;
		yourself.! !

!PragmaRemoved commentStamp: 'alain.plantec 10/20/2009 11:33'!
A PragmaRemoved is announced by a PragamColllector when a method defined with an acceptable pragma according to the PragmaCollector filter is removed.

Instance Variables
!
!PragmaSetting commentStamp: 'AlainPlantec 1/3/2011 10:54'!
A PragmaSetting is a holder for a setting. A setting is declared in a class method which contains a pragma (as examples, <menu> or <setting>). 
Settings can be collected on the fly by a PragmaCollector and browsed by a SettingBrowser. Settings are organized in trees.

Instance Variables
	allowedInStyle:		<Object>
	description:		<Object>
	dialog:		<Object>
	icon:		<Object>
	label:		<Object>
	name:		<Object>
	order:		<Object>
	ordering:		<Object>
	precondition:		<Object>
	target:		<Object>
	targetSelector:		<Object>

allowedInStyle
	- xxxxx

description
	- xxxxx

dialog
	- xxxxx

icon
	- xxxxx

label
	- xxxxx

name
	- xxxxx

order
	- xxxxx

ordering
	- xxxxx

precondition
	- xxxxx

target
	- xxxxx

targetSelector
	- xxxxx
!
!PragmaSetting methodsFor: 'accessing' stamp: 'AlainPlantec 11/26/2009 21:15'!
targetSelector
	^ targetSelector! !

!PragmaSetting methodsFor: 'accessing' stamp: 'alain.plantec 10/18/2009 12:40'!
name
	^ name ifNil: [super name] ifNotNil: [name value]! !

!PragmaSetting methodsFor: 'user interface' stamp: 'alain.plantec 3/12/2009 12:58'!
enabled
	^ true! !

!PragmaSetting methodsFor: 'accessing' stamp: 'AlainPlantec 11/13/2009 15:52'!
description
	"Answer the value of description"

	^ description ifNil: [description := '']! !

!PragmaSetting methodsFor: 'accessing' stamp: 'AlainPlantec 11/26/2009 21:16'!
targetSelector: aSelector
	targetSelector := aSelector! !

!PragmaSetting methodsFor: 'accessing' stamp: 'AlainPlantec 1/29/2010 14:03'!
hasEditableList
	^ false! !

!PragmaSetting methodsFor: 'user interface' stamp: 'AlainPlantec 11/25/2009 08:27'!
icon
	^ icon ifNil: [icon := self defaultIcon]! !

!PragmaSetting methodsFor: 'user interface' stamp: 'AlainPlantec 1/29/2010 14:12'!
getFont
	^ FontChooser
		openWithWindowTitle: 'Font for ' , self name
		for: self
		setSelector: #realValue:
		getSelector: #realValue ! !

!PragmaSetting methodsFor: '*StartupPreferences' stamp: 'BenjaminVanRyseghem 8/1/2012 15:44'!
exportSettingAction
	
	^ nil! !

!PragmaSetting methodsFor: 'user interface' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
defaultIcon
	^ Smalltalk ui icons smallConfigurationIcon! !

!PragmaSetting methodsFor: 'user interface' stamp: 'AlainPlantec 2/11/2011 14:09'!
labelMorphFor: aContainer
	^ StringMorph contents: (aContainer model viewedLabelOfSetting: self)! !

!PragmaSetting methodsFor: 'user interface' stamp: 'AlainPlantec 1/30/2010 08:07'!
inputWidget
	"return the default widget for the input a the setting"
	^ self dialog
		ifNotNil: [:d | d numArgs = 0
				ifTrue: [d value]
				ifFalse: [d value: self]] ! !

!PragmaSetting methodsFor: 'accessing' stamp: 'StephaneDucasse 11/11/2014 18:39'!
description: aString
	"Set the value of description"

	description := aString translated! !

!PragmaSetting methodsFor: 'user interface' stamp: 'AlainPlantec 11/25/2009 08:18'!
ordering
	^ ordering ifNil: [ordering := true]! !

!PragmaSetting methodsFor: '*StartupPreferences' stamp: 'BenjaminVanRyseghem 2/5/2013 15:17'!
isExportable

	^ false! !

!PragmaSetting methodsFor: 'accessing' stamp: 'AlainPlantec 11/23/2009 14:11'!
label: aStringOrBlockOrMessageSend
	label := aStringOrBlockOrMessageSend! !

!PragmaSetting methodsFor: 'user interface' stamp: 'alain.plantec 3/11/2009 15:38'!
asString
	^ self name! !

!PragmaSetting methodsFor: 'accessing' stamp: 'AlainPlantec 11/26/2009 21:15'!
target: anObject
	target := anObject! !

!PragmaSetting methodsFor: 'user interface' stamp: 'AlainPlantec 1/29/2010 14:12'!
fontButtonLabel
	| emphases |
	emphases := IdentityDictionary new at: nil put: 'Regular' translated;
				 at: 0 put: 'Regular' translated;
				 at: 1 put: 'Bold' translated;
				 at: 2 put: 'Italic' translated;
				 at: 4 put: 'Underlined' translated;
				 at: 8 put: 'Narrow' translated; 
				 at: 16 put: 'StruckOut' translated;
				 yourself.
	^ StringMorph contents: self realValue familyName , ' '
			, (emphases
					at: self realValue emphasis
					ifAbsent: ['']) , ' ' , self realValue pointSize asString font: self realValue! !

!PragmaSetting methodsFor: 'comparing' stamp: 'alain.plantec 4/20/2009 15:19'!
hash
	^ self species hash bitXor: self name hash ! !

!PragmaSetting methodsFor: 'user interface' stamp: 'AlainPlantec 1/30/2010 07:59'!
dialog: aValuable
	dialog := aValuable! !

!PragmaSetting methodsFor: 'accessing' stamp: 'AlainPlantec 1/29/2010 14:02'!
hasDefault
	^ false! !

!PragmaSetting methodsFor: 'accessing' stamp: 'AlainPlantec 1/29/2010 10:47'!
settingReceiver
	^ self targetSelector ifNil: [self realTarget] ifNotNil: [self realTarget perform: self targetSelector]! !

!PragmaSetting methodsFor: 'user interface' stamp: 'FernandoOlivero 4/12/2011 10:13'!
chooseFileDirectory
	| result |
	result := self theme chooseDirectoryIn: World title: 'Choose a file' path: nil.
	result ifNotNil: [ self realValue: result fullName ].! !

!PragmaSetting methodsFor: 'accessing' stamp: 'lr 3/14/2010 21:13'!
realTarget
	^ target isSymbol
		ifTrue: [ Smalltalk globals at: target ifAbsent: [  ] ]
		ifFalse: [ target ]! !

!PragmaSetting methodsFor: 'accessing' stamp: 'AlainPlantec 1/29/2010 13:58'!
allowedInStyle
	^ allowedInStyle ifNil: [allowedInStyle := self hasValue]! !

!PragmaSetting methodsFor: 'accessing' stamp: 'alain.plantec 4/2/2009 11:59'!
order
	^ order! !

!PragmaSetting methodsFor: 'accessing' stamp: 'AlainPlantec 12/5/2009 08:42'!
precondition
	^ precondition ifNil: [precondition := [true]].! !

!PragmaSetting methodsFor: 'user interface' stamp: 'AlainPlantec 11/23/2009 22:18'!
icon: aForm 
	icon := aForm! !

!PragmaSetting methodsFor: 'comparing' stamp: 'alain.plantec 4/20/2009 15:18'!
= other 
	^ self species = other species
		and: [self name = other name]! !

!PragmaSetting methodsFor: 'accessing' stamp: 'StephaneDucasse 11/11/2014 18:14'!
label
	^ label ifNil: [self name translated] ifNotNil: [label value translated]! !

!PragmaSetting methodsFor: 'accessing' stamp: 'alain.plantec 10/18/2009 12:39'!
name: aNameOrBlockOrMessageSend
	name := aNameOrBlockOrMessageSend! !

!PragmaSetting methodsFor: 'user interface' stamp: 'AlainPlantec 11/25/2009 08:18'!
noOrdering
	ordering := false! !

!PragmaSetting methodsFor: 'accessing' stamp: 'alain.plantec 4/2/2009 10:53'!
order: aNumber
	order := aNumber! !

!PragmaSetting methodsFor: 'user interface' stamp: 'AlainPlantec 1/30/2010 08:07'!
dialog
	^ dialog! !

!PragmaSetting methodsFor: 'user interface' stamp: 'FernandoOlivero 4/12/2011 10:13'!
inputMorphFor: aContainer 
	^ self inputWidget
		ifNotNil: [:iw | 
			( self theme newRowIn: World for: {iw})
				 clipSubmorphs: true;
				 hResizing: #shrinkWrap;
				 cellInset: 0;
				 yourself]! !

!PragmaSetting methodsFor: 'accessing' stamp: 'AlainPlantec 1/29/2010 14:03'!
hasValue
	^ false! !

!PragmaSetting methodsFor: 'user interface' stamp: 'FernandoOlivero 4/12/2011 10:13'!
chooseFilePath
	| result |
	result := self theme fileOpenIn: World title: 'Choose a file' extensions: nil path: nil preview: true.
	result 
		ifNotNil: [
			self realValue: result name. 
			result close]! !

!PragmaSetting methodsFor: 'accessing' stamp: 'AlainPlantec 12/2/2009 16:40'!
target
	^ target! !

!PragmaSetting methodsFor: 'accessing' stamp: 'AlainPlantec 12/5/2009 08:43'!
precondition: aValuable
	precondition := aValuable! !

!PragmaSetting methodsFor: 'user interface' stamp: 'AlainPlantec 1/29/2010 14:04'!
notInStyle
	allowedInStyle := false! !

!PragmaTest commentStamp: 'TorstenBergmann 2/5/2014 08:42'!
SUnit tests for Pragma class!
!PragmaTest methodsFor: 'tests' stamp: 'GabrielBarbuto 11/30/2010 11:26'!
testEqual

	self assert: atPragma = atPragma.		"Reflexivity"

	self assert: atPragma = anotherAtPragma.		"Simmetry"
	self assert: anotherAtPragma = atPragma.

	self assert: atPragma = anotherAtPragma.		"Transitivity"
	self assert: anotherAtPragma = yetAnotherAtPragma.
	self assert: yetAnotherAtPragma = atPragma.

	self deny: atPragma = atPutPragma.! !

!PragmaTest methodsFor: 'tests' stamp: 'GabrielBarbuto 11/30/2010 11:26'!
testHash

	self assert: atPragma hash = atPragma hash.

	self assert: atPragma hash = anotherAtPragma hash.
	self assert: anotherAtPragma hash = atPragma hash.

	self assert: atPragma hash = anotherAtPragma hash.
	self assert: anotherAtPragma hash = yetAnotherAtPragma hash.
	self assert: yetAnotherAtPragma hash = atPragma hash.! !

!PragmaTest methodsFor: 'tests' stamp: 'GabrielBarbuto 11/30/2010 11:26'!
testCopy

	| copy |

	copy := atPragma copy.

	self deny: atPragma == copy.
	self assert: atPragma method == copy method.
	self assert: atPragma keyword == copy keyword.
	self assert: atPragma arguments == copy arguments.! !

!PragmaTest methodsFor: 'running' stamp: 'GabrielBarbuto 11/30/2010 11:25'!
setUp

	atPragma := Pragma for: (Object methodDict at: #at:) selector: #primitive: arguments: (Array with: 60).
	anotherAtPragma := Pragma for: (Object methodDict at: #at:) selector: #primitive: arguments: (Array with: 60).
	yetAnotherAtPragma := Pragma for: (Object methodDict at: #at:) selector: #primitive: arguments: (Array with: 60).
	atPutPragma := Pragma for: (Object methodDict at: #at:) selector: #primitive: arguments: (Array with: 61).
! !

!PragmaType commentStamp: 'TudorGirba 11/16/2014 12:57'!
This models the type of pragma instances.

It essentially knows the keyword that defines the Pragma, and can obtain all occurences of that Pragma.

!!!!Example

[[[
	PragmaType all
]]]!
!PragmaType methodsFor: 'ui' stamp: 'StefanReichhart 2/24/2015 14:46'!
spotterPragmasFor: aStep
	<spotterOrder: 40>
	^ aStep listProcessor
		title: 'Pragmas';
		allCandidates: [ self pragmas ];
		itemName: [ :pragma | pragma method printString , ' ' , pragma asString ];
		filter: GTFilterSubstring! !

!PragmaType methodsFor: 'accessing' stamp: 'TudorGirba 11/16/2014 10:07'!
keyword
	^ keyword! !

!PragmaType methodsFor: 'ui' stamp: 'TudorGirba 11/16/2014 12:53'!
printOn: stream
	stream nextPutAll: self keyword! !

!PragmaType methodsFor: 'as yet unclassified' stamp: 'StefanReichhart 3/22/2015 21:51'!
spotterSendersFor: aStep
	<spotterOrder: 50>
	^ aStep listProcessor
		title: 'Senders';
		allCandidates: [ (SystemNavigation default allSendersOf: self keyword) collect: #compiledMethod ];
		filter: GTFilterSubstring! !

!PragmaType methodsFor: 'accessing' stamp: 'TudorGirba 11/16/2014 12:52'!
pragmas: aCollection
	pragmas := aCollection! !

!PragmaType methodsFor: 'accessing' stamp: 'TudorGirba 11/16/2014 10:07'!
keyword: anObject
	keyword := anObject! !

!PragmaType methodsFor: 'accessing' stamp: 'TudorGirba 11/16/2014 12:58'!
pragmas
	^ pragmas ifNil: [
		pragmas := OrderedCollection new.
		Object withAllSubclassesDo: [ :each |
			Pragma withPragmasIn: each do: [ :p |
				p keyword = self keyword ifTrue: [ 
					pragmas add: p ] ] ].
		pragmas ]! !

!PragmaType methodsFor: 'ui' stamp: 'TudorGirba 11/16/2014 12:54'!
gtInspectorPragmasIn: composite
	<gtInspectorPresentationOrder: 40>
	composite list
		title: 'Pragmas';
		display: [ self pragmas ];
		format: #gtDisplayString! !

!PragmaType class methodsFor: 'examples' stamp: 'StefanReichhart 4/9/2015 12:00'!
gtExampleAnyOne
	<gtExample>
	^ self all anyOne! !

!PragmaType class methodsFor: 'accessing' stamp: 'TudorGirba 11/16/2014 12:52'!
all
	| pragmas |
	pragmas := OrderedCollection new.
	Object withAllSubclassesDo: [:each |
		Pragma withPragmasIn: each do: [:p |
			pragmas add: p]].
	^ (pragmas groupedBy: #keyword) associations collect: [ :association |
		PragmaType new
			keyword: association key; 
			pragmas: association value ] ! !

!PragmaUpdated commentStamp: 'alain.plantec 10/20/2009 11:33'!
A PragmaUpdated is announced by a PragamColllector when a method defined with an acceptable pragma according to the PragmaCollector filter is updated (recompiled).


Instance Variables
!
!PreDebugAction commentStamp: '<historical>'!
A PreDebugAction is a debugging actions sending a unary message to the pre debug window.
!
!PreDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/24/2013 18:20'!
preDebugWindow
	
	^ preDebugWindow! !

!PreDebugAction methodsFor: 'initialization' stamp: 'AndreiChis 9/25/2013 17:33'!
initialize

	super initialize.
	self needsUpdate: false.
	self needsValidation: false.! !

!PreDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/24/2013 18:20'!
preDebugWindow: anObject
	
	preDebugWindow := anObject! !

!PreDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/24/2013 18:05'!
receiver

	^ self preDebugWindow! !

!PreDebugAction class methodsFor: 'actions creation' stamp: 'AndreiChis 9/30/2013 17:23'!
debugActionsFor: aDebugger
	<preDebuggingAction>
	
	^ { 
		self new
			id: #abandonAction;
			selector: #close;
			order: 10;
			label: 'Abandon'.
		self new
			id: #openFullDebuggerAction;
			selector: #openFullDebugger;
			order: 15;
			label: 'Debug'
	}! !

!PreDebugDoesNotUnderstandAction commentStamp: '<historical>'!
A PreDebugDoesNotUnderstandAction adds the DoesNotUnderstandDebugAction debugging actions to the pre debug window. When executed, it will further close the pre debug window and open the full debugger. 

Instance Variables
	preDebugWindow:		<Object>

preDebugWindow
	- xxxxx
!
!PreDebugDoesNotUnderstandAction methodsFor: 'accessing' stamp: 'AndreiChis 9/24/2013 18:20'!
preDebugWindow
	
	^ preDebugWindow! !

!PreDebugDoesNotUnderstandAction methodsFor: 'accessing' stamp: 'AndreiChis 9/24/2013 18:14'!
id

	^ #preDebugDoesNotUnderstand! !

!PreDebugDoesNotUnderstandAction methodsFor: 'actions' stamp: 'AndreiChis 9/30/2013 17:24'!
executeAction

	"The create method from the session will trigger #contextChanged, which will
	make the debgger update the stack. Sof it safe to just open the debugger."
	super executeAction.
	self preDebugWindow openFullDebugger! !

!PreDebugDoesNotUnderstandAction methodsFor: 'initialization' stamp: 'AndreiChis 9/25/2013 17:32'!
initialize
	
	super initialize.
	self needsUpdate: false.
	self needsValidation: false! !

!PreDebugDoesNotUnderstandAction methodsFor: 'accessing' stamp: 'AndreiChis 9/24/2013 18:20'!
preDebugWindow: anObject
	
	preDebugWindow := anObject! !

!PreDebugDoesNotUnderstandAction class methodsFor: 'registration' stamp: 'AndreiChis 9/24/2013 18:16'!
actionType
	<preDebuggingAction>! !

!PreDebugResumeDebugAction commentStamp: '<historical>'!
A PreDebugResumeDebugAction adds the ResumeDebugAction to the pre debug window.

Instance Variables
	preDebugWindow:		<Object>

preDebugWindow
	- xxxxx
!
!PreDebugResumeDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/24/2013 18:21'!
preDebugWindow
	
	^ preDebugWindow! !

!PreDebugResumeDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/24/2013 17:42'!
id

	^ #preDebugResume! !

!PreDebugResumeDebugAction methodsFor: 'actions' stamp: 'AndreiChis 9/24/2013 17:44'!
executeAction

	self session 
		resume;
		clear.
	self preDebugWindow close. ! !

!PreDebugResumeDebugAction methodsFor: 'initialization' stamp: 'AndreiChis 9/25/2013 17:33'!
initialize

	super initialize.
	self needsUpdate: false.
	self needsValidation: false! !

!PreDebugResumeDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/24/2013 18:21'!
preDebugWindow: anObject
	
	preDebugWindow := anObject! !

!PreDebugResumeDebugAction class methodsFor: 'registration' stamp: 'AndreiChis 9/24/2013 18:15'!
actionType
	<preDebuggingAction>! !

!PreDebugSubclassResponsabilityAction commentStamp: '<historical>'!
A PreDebugSubclassResponsabilityAction adds the SubclassResponsabilityDebugAction debugging actions to the pre debug window. When executed, it will further close the pre debug window and open the full debugger. 

Instance Variables
	preDebugWindow:		<Object>

preDebugWindow
	- xxxxx
!
!PreDebugSubclassResponsabilityAction methodsFor: 'accessing' stamp: 'AndreiChis 9/24/2013 18:21'!
preDebugWindow
	
	^ preDebugWindow! !

!PreDebugSubclassResponsabilityAction methodsFor: 'accessing' stamp: 'AndreiChis 9/24/2013 17:53'!
id

	^ #preDebugSubclassResponsability! !

!PreDebugSubclassResponsabilityAction methodsFor: 'actions' stamp: 'AndreiChis 9/30/2013 17:24'!
executeAction
	
	super executeAction.
	self preDebugWindow openFullDebugger "Open the full debugger"! !

!PreDebugSubclassResponsabilityAction methodsFor: 'initialization' stamp: 'AndreiChis 9/25/2013 17:34'!
initialize

	super initialize.
	self needsUpdate: false.
	self needsValidation: false! !

!PreDebugSubclassResponsabilityAction methodsFor: 'accessing' stamp: 'AndreiChis 9/24/2013 18:21'!
preDebugWindow: anObject
	
	preDebugWindow := anObject! !

!PreDebugSubclassResponsabilityAction class methodsFor: 'registration' stamp: 'AndreiChis 9/24/2013 18:15'!
actionType
	<preDebuggingAction>! !

!PreorderGuide commentStamp: 'cwp 11/18/2009 12:18'!
I traverse the filesystem in depth-first pre order. Given this hierarchy:

alpha
	beta
	gamma
delta
	epsilon

I would visit the nodes in the following order: alpha, beta, gamma, delta, epsilon.

I use my work instance variable as a stack. I push nodes to be visited and visit them in reverse order.!
!PreorderGuide methodsFor: 'showing' stamp: 'CamilloBruni 4/10/2013 12:14'!
pushAll: aCollection 
	aCollection reverseDo: [ :each | work add: each ]! !

!PreorderGuide methodsFor: 'showing' stamp: 'CamilloBruni 4/10/2013 12:42'!
visitNextEntry: entry
	
	entry isFile
		ifTrue: [ visitor visitFile: entry ]
		ifFalse: [ 
			visitor visitDirectory: entry.
			(self shouldVisitChildrenOf: entry)
				ifTrue: [ self pushAll: entry reference entries ]]! !

!PreorderGuide methodsFor: 'showing' stamp: 'CamilloBruni 4/10/2013 12:39'!
show: aReference
	self push: aReference entry.
	self whileNotDoneDo: [ self visitNextEntry: self pop ]! !

!PreorderGuideTest commentStamp: 'TorstenBergmann 1/31/2014 11:44'!
SUnit tests for class PreorderGuide!
!PreorderGuideTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:38'!
testAll
	guide := PreorderGuide for: self.
	guide show: (filesystem / 'alpha').
	self assertVisitedIs: #(
			'alpha'
			'beta'
			'delta'
			'gamma'
			'epsilon'
			'zeta'
		)! !

!PrettyTextDiffBuilder commentStamp: 'HenrikSperreJohansen 5/21/2010 01:42'!
I'm like TextDiffBuilder, but I use the pretty-printed version of the source code if available.

Instance Variables
	sourceClass:		<Class>

sourceClass
	- this class provides the pretty-printer
!
!PrettyTextDiffBuilder methodsFor: 'initialize' stamp: 'MarcusDenker 8/28/2013 10:29'!
split: aString 
	| formatted trimmed |
	trimmed := aString asString trimBoth.
	trimmed isEmpty ifTrue: [ ^super split: '' ].
	formatted := [ sourceClass
				source: trimmed;
				class: sourceClass;
				format] on: Error do: [ :ex | trimmed ].
	^ super split: formatted! !

!PrettyTextDiffBuilder methodsFor: 'initialize' stamp: 'nk 10/29/2000 12:16'!
sourceClass: aClass
	sourceClass := aClass.! !

!PrettyTextDiffBuilder class methodsFor: 'instance creation' stamp: 'nk 10/29/2000 12:35'!
from: srcString to: dstString inClass: srcClass 
	^ (self new sourceClass: srcClass) from: srcString to: dstString
		! !

!PrimitiveFailed commentStamp: 'SvenVanCaekenberghe 4/21/2011 12:31'!
I am PrimitiveFailed, an exception signaled when a primitive fails.!
!PrimitiveFailed methodsFor: 'printing' stamp: 'nice 12/2/2011 23:36'!
standardMessageText
	"Generate a standard textual description"
	
	^ String streamContents: [ :stream |
		stream << 'primitive '.
		stream print: self selector.
		stream << ' in '.
		stream print: self signaler class.
		stream << ' failed' ]! !

!PrintVersionCommandLineHandler commentStamp: '<historical>'!
Usage: printVersion [ --numeric | --release ]
	--numeric   Print the full version number only (e.g. 12345)
	--release   Print the major relase number only (e.g. 1.2)
	
Documentation:
Prints the version number in an easy to parse format. This can be used in Jenkins with the "Description Setter" Plugin. Configure it like this:

Regular expression:  \[version\] (.*)
Description: \1


Examples:
	pharo Pharo.image printVersion
	#result will be something like:
	[version] 3.0 #30100

	pharo Pharo.image printVersion --numeric
	# will print a simpler version
	30100
	
	pharo Pharo.image printVersion --release
	# prints the Pharo release version
	3.0!
!PrintVersionCommandLineHandler methodsFor: 'actions' stamp: 'CamilloBruni 3/26/2013 21:09'!
printRelease
	self stdout 
		print: SystemVersion current major;
		nextPutAll: '.';
		print: SystemVersion current minor;
		lf.! !

!PrintVersionCommandLineHandler methodsFor: 'actions' stamp: 'CamilloBruni 3/26/2013 21:09'!
printVersion
	self stdout 
		nextPutAll: '[version] ';
		print: SystemVersion current major;
		nextPutAll: '.';
		print: SystemVersion current minor;
		nextPutAll: ' #' ;
		print: SystemVersion current highestUpdate;
		lf.! !

!PrintVersionCommandLineHandler methodsFor: 'actions' stamp: 'CamilloBruni 3/26/2013 21:09'!
printNumericVersion
	self stdout 
		print: SystemVersion current highestUpdate;
		lf! !

!PrintVersionCommandLineHandler methodsFor: 'activation' stamp: 'CamilloBruni 3/26/2013 21:13'!
activate
	self activateHelp
		ifTrue: [  ^ self ].
		
	(self hasOption: 'numeric')
		ifTrue: [ 
			self printNumericVersion.
			^ self exitSuccess].
	(self hasOption: 'release')
		ifTrue: [ 
			self printRelease.
			^ self exitSuccess ].
	self hasArguments
		ifFalse: [ 
			self printVersion.
			^ self exitSuccess ].
	
	self printHelp.
	^ self exitFailure! !

!PrintVersionCommandLineHandler class methodsFor: 'accessing' stamp: 'MarcusDenker 11/16/2012 14:50'!
description
	^ 'Print image version'! !

!PrintVersionCommandLineHandler class methodsFor: 'accessing' stamp: 'MarcusDenker 11/16/2012 14:50'!
commandName
	^ 'printVersion'! !

!ProceedDialogWindow commentStamp: 'gvc 5/18/2007 12:22'!
Yes/no dialog. Test result as to whether the dialog is cancelled (no) or not (yes).!
!ProceedDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 1/11/2007 17:34'!
no
	"Answer no."

	self cancel! !

!ProceedDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 1/11/2007 17:34'!
yes
	"Answer yes."

	self ok! !

!ProceedDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 1/29/2009 16:37'!
handlesKeyboard: evt
	"Return true if the receiver wishes to handle the given keyboard event"
	
	(super handlesKeyboard: evt) ifTrue: [^true].
	^evt keyCharacter = $y or: [
		evt keyCharacter = $n]
	! !

!ProceedDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 1/10/2007 13:50'!
newButtons
	"Answer new buttons as appropriate."

	^{self newOKButton. self newCancelButton isDefault: true}! !

!ProceedDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 1/29/2009 16:38'!
keyStroke: evt
	"Additionally check for y and n keys (aliases for ok and cancel)."

	(super keyStroke: evt) ifTrue: [^true].
	evt keyCharacter = $y ifTrue: [self yes. ^true].
	evt keyCharacter = $n ifTrue: [self no. ^true].
	^false! !

!ProceedDialogWindow methodsFor: 'as yet unclassified' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
icon
	"Answer an icon for the receiver."
	
	^ Smalltalk ui icons questionIcon! !

!ProceedDialogWindow class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
taskbarIcon
	"Answer the icon for the receiver in a task bar."

	^ Smalltalk ui icons smallQuestionIcon! !

!Process commentStamp: 'MarcusDenker 6/24/2014 10:13'!
I represent an independent path of control in the system. This path of control may be stopped (by sending the message suspend) in such a way that it can later be restarted (by sending the message resume). When any one of several paths of control can be advanced, the single instance of ProcessorScheduler named Processor determines which one will actually be advanced partly using the value of priority.

(If anyone ever makes a subclass of Process, be sure to use allSubInstances in anyProcessesAbove:.)


Process-specific storage: 

	An old implementation using #environmentAt: [ifAbsent:/put:] protocol are no longer supported.
	One must not use a process-specific storage (PSS) methods directly, and instead use ProcessSpecificVariable (or subclass) instances to access process-specific storage.
	
A new implemention is a revision towards making an access to PSS faster.

When new instance of ProcessSpecificVariable are created, it obtains an unique index, which is registered using #allocatePSKey: (see class side).
This allows to dynamically create as many process-specific variables as needed, and access them in fast manner via simple array index (instead of dictionary lookup,
as in previous implementation).

Another important aspect of new implementation is that all values in PSS are held weakly. This is done to prevent accidental memory leaks
as well as no need to manually unregistering a process-specific keys , once they are no longer in use.!
!Process methodsFor: 'testing' stamp: 'ajh 1/24/2003 19:44'!
isActiveProcess

	^ self == Processor activeProcess! !

!Process methodsFor: 'accessing' stamp: 'ajh 1/27/2003 18:39'!
copyStack

	^ self copy install: suspendedContext copyStack! !

!Process methodsFor: 'testing' stamp: 'MaxLeske 9/23/2014 10:05'!
isTerminated
	self isActiveProcess ifTrue: [ ^ false ].
	
	^ suspendedContext isNil or: [
		"If the suspendedContext is the bottomContext it is the block in Process>>newProcess.
		If so, and the pc is greater than the startpc, the block has already sent and returned
		from value and there is nothing more to do."
		suspendedContext isBottomContext and: [
			suspendedContext isDead or: [
				"The pc of the suspendedContext is set to nil in #terminate explicitly.
				Leaving this line in for safety."
  	  			suspendedContext pc > suspendedContext startpc ] ] ]
! !

!Process methodsFor: 'accessing' stamp: 'NorbertHartl 6/23/2014 23:39'!
effectiveProcess
	"effectiveProcess is a mechanism to allow process-faithful debugging.  The debugger executes code
	 on behalf of processes, so unless some effort is made the identity of Processor activeProcess is not
	 correctly maintained when debugging code.  The debugger uses evaluate:onBehalfOf: to assign the
	 debugged process as the effectiveProcess of the process executing the code, preserving process
	 identity."
	^effectiveProcess ifNil: [self] ! !

!Process methodsFor: 'initialization' stamp: 'MaxLeske 9/22/2014 09:53'!
initialize
	super initialize.
	
	terminating := false! !

!Process methodsFor: 'changing suspended state' stamp: 'ajh 1/23/2003 21:43'!
completeTo: aContext 
	"Resume self until aContext is on top"

	self suspendedContext == aContext ifTrue: [^ aContext].
	^ self complete: (self calleeOf: aContext)! !

!Process methodsFor: 'changing suspended state' stamp: 'eem 9/7/2009 11:10'!
stepToSendOrReturn

	^Processor activeProcess
		evaluate: [suspendedContext := suspendedContext stepToSendOrReturn]
		onBehalfOf: self! !

!Process methodsFor: 'accessing' stamp: ''!
suspendingList
	"Answer the list on which the receiver has been suspended."

	^myList! !

!Process methodsFor: 'accessing' stamp: ''!
suspendedContext
	"Answer the context the receiver has suspended."

	^suspendedContext! !

!Process methodsFor: 'private' stamp: 'eem 9/7/2009 11:10'!
evaluate: aBlock onBehalfOf: aProcess
	"Evaluate aBlock setting effectiveProcess to aProcess.  Used
	 in the execution simulation machinery to ensure that
	 Processor activeProcess evaluates correctly when debugging."
	| oldEffectiveProcess |
	oldEffectiveProcess := effectiveProcess.
	effectiveProcess := aProcess.
	^aBlock ensure: [effectiveProcess := oldEffectiveProcess]! !

!Process methodsFor: 'printing' stamp: 'MarcusDenker 7/23/2014 22:33'!
longPrintOn: stream
	| ctxt |
	super printOn: stream.
	stream cr.
	ctxt := self suspendedContext.
	[ ctxt isNil ]
		whileFalse: [ 
			stream space.
			ctxt printOn: stream.
			stream cr.
			ctxt := ctxt sender ]! !

!Process methodsFor: 'changing suspended state' stamp: 'BenComan 2/10/2015 00:11'!
complete: aContext 
	"Run self until aContext is popped or an unhandled error is raised.  Return self's new top context, unless an unhandled error was raised then return the signaler context (rather than open a debugger)."
	
	| ctxt pair error |
	ctxt := suspendedContext.
	suspendedContext := nil.  "disable this process while running its stack in active process below"
	pair := Processor activeProcess
				evaluate: [ctxt runUntilErrorOrReturnFrom: aContext]
				onBehalfOf: self.
	suspendedContext := pair first.
	error := pair second.
	error class = Halt ifTrue: [ 
		aContext methodNode 
			pragmaNamed: #debuggerCompleteToSender 
			ifPresent: [ ^ self completeTo: aContext sender ] ].
	error ifNotNil: [^ error signalerContext].
	^ suspendedContext! !

!Process methodsFor: 'private' stamp: 'GiovanniCorriga 8/30/2009 15:40'!
environmentKeyNotFound 
	self error: 'Environment key not found'! !

!Process methodsFor: 'changing suspended state' stamp: 'ajh 7/18/2003 22:13'!
stepToHome: aContext 
	"Resume self until the home of top context is aContext.  Top context may be a block context."

	| home ctxt |
	home := aContext home.
	[	ctxt := self step.
		home == ctxt home.
	] whileFalse: [
		home isDead ifTrue: [^ self suspendedContext].
	].
	^ self suspendedContext! !

!Process methodsFor: 'changing suspended state' stamp: 'nk 7/10/2004 11:16'!
restartTopWith: method
	"Rollback top context and replace with new method.  Assumes self is suspended"

	method isQuick 
		ifTrue: [ self popTo: suspendedContext sender ]
		ifFalse: [ suspendedContext privRefreshWith: method ].
! !

!Process methodsFor: 'changing suspended state' stamp: 'ajh 1/23/2003 20:40'!
restartTop
	"Rollback top context and replace with new method.  Assumes self is suspended"

	suspendedContext privRefresh! !

!Process methodsFor: 'process specific' stamp: 'IgorStasenko 11/2/2011 19:25'!
resetPSValueAt: index

	"NOTE: this method are PRIVATE. "

	env ifNil: [ ^ self ]. 
	index > env size ifTrue: [ ^ self ].
	
	env at: index put: nil! !

!Process methodsFor: 'process specific' stamp: 'SeanDeNigris 7/16/2012 07:42'!
psValueAt: index put: value
	"Set a value for given index in process-specific storage"

	"NOTE: this method are PRIVATE. Do not use it directly, instead use ProcessSpecificVariable (or its subclasses) "

	env ifNil: [ env := WeakArray new: PSKeys size ].
	env size < PSKeys size ifTrue: [ env := env grownBy: PSKeys size - env size ].
	^ env at: index put: value.! !

!Process methodsFor: 'printing' stamp: 'nk 10/28/2000 07:33'!
browserPrintString
	^self browserPrintStringWith: suspendedContext! !

!Process methodsFor: 'changing suspended state' stamp: 'eem 9/7/2009 11:19'!
step

	^Processor activeProcess
		evaluate: [suspendedContext := suspendedContext step]
		onBehalfOf: self! !

!Process methodsFor: 'process specific' stamp: 'IgorStasenko 11/2/2011 19:44'!
psValueAt: index
	"Answer a process-specific value at given index, or nil if value at given index is not defined"
	
	"NOTE: this method are PRIVATE. Do not use it directly, instead use ProcessSpecificVariable (or its subclasses) "
	env ifNil: [ ^ nil ].
	^ env at: index ifAbsent: nil! !

!Process methodsFor: 'accessing' stamp: 'svp 12/5/2002 14:42'!
name: aString

	name := aString! !

!Process methodsFor: 'debugging' stamp: 'CamilloBruni 9/21/2012 13:52'!
debug: context title: title full: bool
	
	^ Smalltalk tools debugger
						openOn: self 
						context: context 
						label: title 
						contents: nil 
						fullView: bool.
						! !

!Process methodsFor: 'accessing' stamp: 'ar 7/8/2001 17:04'!
priority: anInteger 
	"Set the receiver's priority to anInteger."
	(anInteger >= Processor lowestPriority and:[anInteger <= Processor highestPriority])
		ifTrue: [priority := anInteger]
		ifFalse: [self error: 'Invalid priority: ', anInteger printString]! !

!Process methodsFor: 'accessing' stamp: ''!
priority
	"Answer the priority of the receiver."

	^priority! !

!Process methodsFor: 'accessing' stamp: 'MartinMcClure 1/10/2010 17:54'!
name
 
 	^name ifNil: [ self hash asString forceTo: 10 paddingStartWith: $ ]! !

!Process methodsFor: 'printing' stamp: 'PeterHugossonMiller 9/3/2009 10:51'!
browserPrintStringWith: anObject 
	| stream |
	stream := (String new: 100) writeStream.
	stream nextPut: $(.
	priority printOn: stream.
	self isSuspended
		ifTrue: [stream nextPut: $s].
	stream nextPutAll: ') '.
	stream nextPutAll: self name.
	stream nextPut: $:.
	stream space.
	stream nextPutAll: anObject asString.
	^ stream contents! !

!Process methodsFor: 'debugging' stamp: 'CamilloBruni 9/21/2012 13:52'!
debugWithTitle: title
	"Open debugger on self"

	| context |
	context := self isActiveProcess ifTrue: [thisContext] ifFalse: [self suspendedContext].
	^ self debug: context title: title full: true.
! !

!Process methodsFor: 'testing' stamp: 'MaxLeske 9/22/2014 10:14'!
isTerminating
	"lazy initialization is a fallback only for processes that existed before this addition"
	^ terminating ifNil: [ false ]! !

!Process methodsFor: 'changing suspended state' stamp: 'ajh 1/24/2003 10:16'!
completeStep: aContext 
	"Resume self until aContext is on top, or if already on top, complete next step"

	| callee |
	self suspendedContext == aContext ifFalse: [
		^ self complete: (self calleeOf: aContext)].
	callee := self step.
	callee == aContext ifTrue: [^ callee].
	aContext isDead ifTrue: [^ self suspendedContext].  "returned"
	^ self complete: callee  "finish send"! !

!Process methodsFor: 'changing process state' stamp: 'MaxLeske 9/23/2014 18:57'!
terminate 
	"Stop the process that the receiver represents forever.  Unwind to execute pending ensure:/ifCurtailed: blocks before terminating."

	| ctxt unwindBlock oldList |
	terminating := self isTerminating
		ifTrue: [ ^ ProcessAlreadyTerminating signal ]
		ifFalse: [ true ].
		
	self isActiveProcess 
		ifTrue: [
			ctxt := thisContext.
			[ ctxt := ctxt findNextUnwindContextUpTo: nil.
			ctxt isNil ] whileFalse: 
				[ (ctxt tempAt: 2) ifNil:
					[ ctxt tempAt: 2 put: nil.
					unwindBlock := ctxt tempAt: 1.
					thisContext terminateTo: ctxt.
					unwindBlock value ] ].
			thisContext terminateTo: nil.
			self suspend ]
		ifFalse: [
			"Always suspend the process first so it doesn't accidentally get woken up"
			oldList := self suspend.
			suspendedContext ifNotNil: [
				"Figure out if we are terminating the process while waiting in Semaphore>>critical:
				In this case, pop the suspendedContext so that we leave the ensure: block inside
				Semaphore>>critical: without signaling the semaphore."
				(oldList class == Semaphore and: [
					suspendedContext method == (Semaphore compiledMethodAt: #critical:) ]) ifTrue: [
						suspendedContext := suspendedContext home ].

				"If we are terminating a process halfways through an unwind, try to complete that unwind block first."
				(suspendedContext findNextUnwindContextUpTo: nil) ifNotNil: [ :outer |
					(suspendedContext findContextSuchThat: [ :c | c closure == (outer tempAt: 1) ]) ifNotNil: [ :inner |
						"This is an unwind block currently under evaluation"
						suspendedContext runUntilErrorOrReturnFrom: inner ] ].		
			ctxt := self popTo: suspendedContext bottomContext.
			ctxt == suspendedContext bottomContext ifFalse: [
				self debug: ctxt title: 'Unwind error during termination' ].
			"The suspendedContext of process that has never run will have 
			a pc equal to the startpc. #isTerminate would thus answer false
			even though the process is dead. To prevent that we set the pc
			of the suspendedContext to nil (#isDead ---> true)."
			(suspendedContext notNil and: [
				suspendedContext isBottomContext ]) ifTrue: [
					suspendedContext pc: nil ] ] ]! !

!Process methodsFor: 'accessing' stamp: 'ajh 1/24/2003 14:53'!
calleeOf: aContext
	"Return the context whose sender is aContext.  Return nil if aContext is on top.  Raise error if aContext is not in process chain."

	suspendedContext == aContext ifTrue: [^ nil].
	^ (suspendedContext findContextSuchThat: [:c | c sender == aContext])
		ifNil: [self error: 'aContext not in process chain']! !

!Process methodsFor: 'changing process state' stamp: 'tpr 2/14/2001 10:00'!
primitiveResume
	"Primitive. Allow the process that the receiver represents to continue. Put 
	the receiver in line to become the activeProcess. Fail if the receiver is 
	already waiting in a queue (in a Semaphore or ProcessScheduler). 
	Essential. See Object documentation whatIsAPrimitive."

	<primitive: 87>
	self primitiveFailed! !

!Process methodsFor: 'signaling' stamp: 'ClementBera 5/27/2014 13:49'!
signalException: anException
	"Signal an exception in the receiver process...if the receiver is currently
	suspended, the exception will get signaled when the receiver is resumed.  If 
	the receiver is blocked on a Semaphore, it will be immediately re-awakened
	and the exception will be signaled; if the exception is resumed, then the receiver
	will return to a blocked state unless the blocking Semaphore has excess signals"
	| oldList |
	"If we are the active process, go ahead and signal the exception"
	self isActiveProcess ifTrue: [^anException signal].

	"Suspend myself first to ensure that I won't run away in the
	midst of the following modifications."
	myList ifNotNil:[oldList := self suspend].

	"Add a new method context to the stack that will signal the exception"
	suspendedContext := Context
		sender: suspendedContext
		receiver: self
		method: (self class lookupSelector: #pvtSignal:list:)
		arguments: (Array with: anException with: oldList).

	"If we are on a list to run, then suspend and restart the receiver 
	(this lets the receiver run if it is currently blocked on a semaphore).  If
	we are not on a list to be run (i.e. this process is suspended), then when the
	process is resumed, it will signal the exception"

	oldList ifNotNil: [self resume].
! !

!Process methodsFor: 'testing' stamp: 'dkh 4/25/2009 13:34'!
isSuspended
	^myList isNil or: [ myList isEmpty ]! !

!Process methodsFor: 'changing suspended state' stamp: 'eem 9/7/2009 11:52'!
stepToCallee
	"Step until top context changes"

	Processor activeProcess
		evaluate:
			[| ctxt |
			ctxt := suspendedContext.
			[ctxt == suspendedContext] whileTrue: [
				suspendedContext := suspendedContext step]]
		onBehalfOf: self.
	^suspendedContext! !

!Process methodsFor: 'printing' stamp: ''!
printOn: aStream

	super printOn: aStream.
	aStream nextPutAll: ' in '.
	suspendedContext printOn: aStream! !

!Process methodsFor: 'changing suspended state' stamp: 'eem 6/23/2014 10:19'!
popTo: aContext value: aValue
	"Replace the suspendedContext with aContext, releasing all contexts 
	 between the currently suspendedContext and it."

	self == Processor activeProcess ifTrue:
		[^self error: 'The active process cannot pop contexts'].
	^(self calleeOf: aContext)
		ifNil: [aContext]  "aContext is on top"
		ifNotNil:
			[:callee|
			 Processor activeProcess
				evaluate: [self return: callee value: aValue]
				onBehalfOf: self]! !

!Process methodsFor: 'changing suspended state' stamp: 'eem 3/15/2013 09:35'!
step: aContext 
	"Resume self until aContext is on top, or if already on top, do next step"

	^Processor activeProcess
		evaluate:
			[self suspendedContext == aContext
				ifTrue: [suspendedContext := suspendedContext step]
				ifFalse: [self complete: (self calleeOf: aContext)]]
		onBehalfOf: self! !

!Process methodsFor: 'private' stamp: ''!
suspendedContext: aContext

	suspendedContext := aContext! !

!Process methodsFor: 'signaling' stamp: 'svp 9/19/2003 18:41'!
pvtSignal: anException list: aList
	"Private. This method is used to signal an exception from another
	process...the receiver must be the active process.  If the receiver 
	was previously waiting on a Semaphore, then return the process
	to the waiting state after signaling the exception and if the Semaphore
	has not been signaled in the interim"

	"Since this method is not called in a normal way, we need to take care
	that it doesn't directly return to the caller (because I believe that could
	have the potential to push an unwanted object on the caller's stack)."

	| blocker |
	self isActiveProcess ifFalse: [^self].
	anException signal.
	blocker := Semaphore new.
	[self suspend.
	suspendedContext := suspendedContext swapSender: nil.
	aList class == Semaphore 
		ifTrue:
			[aList isSignaled
				ifTrue: 
					[aList wait.  "Consume the signal that would have restarted the receiver"
					self resume]
				ifFalse:
					["Add us back to the Semaphore's list (and remain blocked)"
					myList := aList.
					aList add: self]]
		ifFalse: [self resume]] fork.
	blocker wait.


! !

!Process methodsFor: 'changing suspended state' stamp: 'eem 6/23/2014 10:13'!
return: aContext value: value
	"Pop thread down to aContext's sender.  Execute any unwind blocks on the way.  See #popTo: comment and #runUntilErrorOrReturnFrom: for more details."

	suspendedContext == aContext ifTrue:
		[^Processor activeProcess
			evaluate: [suspendedContext := aContext return: value from: aContext]
			onBehalfOf: self].
	self activateReturn: aContext value: value.
	^self complete: aContext! !

!Process methodsFor: 'debugging' stamp: 'CamilloBruni 9/21/2012 13:52'!
debug: context title: title
	"Open debugger on self with context shown on top"

	^ self debug: context title: title full: false.
! !

!Process methodsFor: 'changing process state' stamp: 'tpr 2/14/2001 10:03'!
resume
	"Allow the process that the receiver represents to continue. Put  
	the receiver in line to become the activeProcess. Check for a nil 
	suspendedContext, which indicates a previously terminated Process that 
	would cause a vm crash if the resume attempt were permitted"

	suspendedContext ifNil: [^ self primitiveFailed].
	^ self primitiveResume! !

!Process methodsFor: 'changing suspended state' stamp: ''!
install: aContext 
	"Replace the suspendedContext with aContext."

	self == Processor activeProcess
		ifTrue: [^self error: 'The active process cannot install contexts'].
	suspendedContext := aContext! !

!Process methodsFor: 'changing process state' stamp: 'ajh 1/23/2003 23:02'!
run
	"Suspend current process and execute self instead"

	| proc |
	proc := Processor activeProcess.
	[	proc suspend.
		self resume.
	] forkAt: Processor highestPriority! !

!Process methodsFor: 'changing suspended state' stamp: 'eem 6/23/2014 10:19'!
popTo: aContext 
	"Pop self down to aContext by remote returning from aContext's callee.  Unwind blocks will be executed on the way.
	This is done by pushing a new context on top which executes 'aContext callee return' then resuming self until aContext is reached.  This way any errors raised in an unwind block will get handled by senders in self and not by senders in the activeProcess.
	If an unwind block raises an error that is not handled then the popping stops at the error and the signalling context is returned, othewise aContext is returned."

	self == Processor activeProcess ifTrue:
		[^self error: 'The active process cannot pop contexts'].
	^(self calleeOf: aContext)
		ifNil: [aContext]  "aContext is on top"
		ifNotNil:
			[:callee|
			 Processor activeProcess
				evaluate: [self return: callee value: callee receiver]
				onBehalfOf: self]! !

!Process methodsFor: 'changing process state' stamp: 'ar 12/7/2007 17:10'!
suspend
	"Primitive. Stop the process that the receiver represents in such a way 
	that it can be restarted at a later time (by sending the receiver the 
	message resume). If the receiver represents the activeProcess, suspend it. 
	Otherwise remove the receiver from the list of waiting processes.
	The return value of this method is the list the receiver was previously on (if any)."
	| oldList |
	<primitive: 88>
	"This is fallback code for VMs which only support the old primitiveSuspend which 
	would not accept processes that are waiting to be run."
	myList ifNil:[^nil]. "this allows us to use suspend multiple times"
	oldList := myList.
	myList := nil.
	oldList remove: self ifAbsent:[].
	^oldList! !

!Process methodsFor: 'debugging' stamp: 'CamilloBruni 9/21/2012 13:52'!
debug
	^ self debugWithTitle: 'Debug'.! !

!Process methodsFor: 'changing suspended state' stamp: 'eem 6/23/2014 10:13'!
activateReturn: aContext value: value
	"Activate 'aContext return: value', so execution will return to aContext's sender"

	^Processor activeProcess
		evaluate: [suspendedContext := suspendedContext activateReturn: aContext value: value]
		onBehalfOf: self! !

!Process class methodsFor: 'process specific' stamp: 'MarianoMartinezPeck 8/28/2012 14:53'!
allocatePSKey: anObject

	"Add a new process-specific key. 
	If an object already registered as a key, answer its index,
	if object is not registered, first search for an empty slot for insertion and if not found, grow an array to add new object"

	| index |
	PSKeysSema ifNil: [ PSKeysSema := Semaphore forMutualExclusion ].
	PSKeysSema critical: [
		PSKeys 
			ifNil: [ PSKeys := WeakArray with: anObject. index := 1 ]
			ifNotNil: [ 
				index := PSKeys indexOf: anObject.
				index = 0 ifTrue: [
					index := PSKeys indexOf: nil.
					index = 0 
						ifTrue: [
							index := (PSKeys := PSKeys copyWith: anObject) size ]
						ifFalse: [
							"Yes, this is slow, but we have to make sure that if we reusing index,
							all existing processes having value at given index reset to nil.
							We don't care if new processes will be created during this loop,
							since their env variable will be initially nil anyways, hence nothing to reset "
							Process allSubInstancesDo: [:p | p resetPSValueAt: index ].
							PSKeys at: index put: anObject.
							]
				]
			]
	].

	^ index! !

!Process class methodsFor: 'instance creation' stamp: ''!
forContext: aContext priority: anInteger 
	"Answer an instance of me that has suspended aContext at priority 
	anInteger."

	| newProcess |
	newProcess := self new.
	newProcess suspendedContext: aContext.
	newProcess priority: anInteger.
	^newProcess! !

!ProcessAlreadyTerminating commentStamp: 'MaxLeske 9/22/2014 09:56'!
I notify the sender of #terminate that the receiving process has already received a #terminate before.

Use Process>>isTerminating to check for this.!
!ProcessBrowser commentStamp: '<historical>'!
Change Set:		ProcessBrowser
Date:			14 March 2000
Author:			Ned Konz

email: ned@bike-nomad.com

This is distributed under the Squeak License.

Added 14 March:
	CPUWatcher integration
	automatically start and stop CPUWatcher
	added CPUWatcher to process list menu

Added 29 October:
	MVC version
	2.8, 2.7 compatibility
	rearranged menus
	added pointer inspection and chasing
	added suspend/resume
	recognized more well-known processes
	misc. bug fixes

Added 26 October: highlight pc in source code
Added 27 October: added 'signal semaphore'
added 'inspect receiver', 'explore receiver', 'message tally' to stack list menu
added 'find context', 'next context' to process list menu
added 'change priority' and 'debug' choices to process list menu

27 October mods by Bob Arning:

alters process display in Ned's ProcessBrowser to 
- show process priority
- drop 'a Process in' that appears on each line
- show in priority order
- prettier names for known processes
- fix to Utilities to forget update downloading process when it ends (1 less dead
process)
- correct stack dump for the active process
!
!ProcessBrowser methodsFor: 'stack list' stamp: 'eem 6/12/2008 12:44'!
pcRange
	"Answer the indices in the source code for the method corresponding to  
	the selected context's program counter value."
	(selectedContext isNil or: [methodText isEmptyOrNil])
		ifTrue: [^ 1 to: 0].
	^selectedContext debuggerMap
		rangeForPC: (selectedContext pc ifNotNil: [:pc| pc] ifNil: [selectedContext method endPC])
		contextIsActiveContext: stackListIndex = 1! !

!ProcessBrowser methodsFor: 'initialization' stamp: 'lr 3/14/2010 21:13'!
stopCPUWatcher
	| pw |
	pw := Smalltalk globals at: #CPUWatcher ifAbsent: [ ^ self ].
	pw
		ifNotNil: [ 
			pw stopMonitoring.
			self updateProcessList.
			startedCPUWatcher := false	"so a manual restart won't be killed later" ]! !

!ProcessBrowser methodsFor: 'initialization' stamp: 'nk 3/14/2001 08:03'!
windowIsClosing
	startedCPUWatcher ifTrue: [ CPUWatcher stopMonitoring ]! !

!ProcessBrowser methodsFor: 'accessing' stamp: 'sd 3/25/2012 20:53'!
selectedMethod
	^ methodText ifNil: [methodText := selectedContext
						ifNil: ['']
						ifNotNil: [| pcRange | 
							methodText := [ selectedContext sourceCode ]
								ifError: [ 'error getting method text' ].
							pcRange := self pcRange.
							methodText asText
								addAttribute: TextColor red
								from: pcRange first
								to: pcRange last;
								addAttribute: TextEmphasis bold
								from: pcRange first
								to: pcRange last]]! !

!ProcessBrowser methodsFor: 'updating' stamp: 'AlainPlantec 7/9/2013 12:40'!
setUpdateCallbackAfter: seconds

		deferredMessageRecipient ifNotNil: [ | d |
			d := Delay forSeconds: seconds.
			[  d wait.
				d := nil.
				deferredMessageRecipient defer: [self updateProcessList]
			] fork
		]! !

!ProcessBrowser methodsFor: 'process list' stamp: 'StephaneDucasse 5/18/2012 18:29'!
keyEventsDict

	^ keyEventsDict ifNil: [
		keyEventsDict := Dictionary newFromPairs:  #(
			$i #inspectProcess
			$I #exploreProcess
			$e #explorePointers
			$P #inspectPointers
			$t #terminateProcess
			$r #resumeProcess
			$s #suspendProcess
			$d #debugProcess
			$p #changePriority
			$m #messageTally
			$f #findContext
			$g #nextContext
			$a #toggleAutoUpdate
			$u #updateProcessList
			$S #signalSemaphore
			$k #moreStack			
			)
		]
! !

!ProcessBrowser methodsFor: 'stack list' stamp: 'EstebanLorenzano 1/31/2013 19:25'!
stackListMenu: aMenu 
	selectedContext ifNil: [^ aMenu].
	^aMenu addAllFromPragma: 'processBrowserStackListMenu' target: self! !

!ProcessBrowser methodsFor: 'accessing' stamp: ''!
processList
	^ processList! !

!ProcessBrowser methodsFor: 'initialization' stamp: 'StephaneDucasse 5/18/2012 18:08'!
initialize
	super initialize.
	self class registerWellKnownProcesses.
	methodText := ''.
	stackListIndex := 0.
	searchString := ''.
	lastUpdate := 0.
	startedCPUWatcher := CPUWatcher cpuWatcherEnabled and: [ self startCPUWatcher ].
	self updateProcessList; processListIndex: 1! !

!ProcessBrowser methodsFor: 'process actions' stamp: 'nk 10/29/2000 09:58'!
signalSemaphore
	(selectedProcess suspendingList isKindOf: Semaphore)
		ifFalse: [^ self].
	[selectedProcess suspendingList signal] fork.
	(Delay forMilliseconds: 300) wait.
	"Hate to make the UI wait, but it's convenient..."
	self updateProcessList! !

!ProcessBrowser methodsFor: 'stack list' stamp: 'nk 10/28/2000 12:13'!
moreStack
	self updateStackList: 2000! !

!ProcessBrowser methodsFor: 'process actions' stamp: 'DamienCassou 9/29/2009 13:07'!
changePriority
	| str newPriority nameAndRules |
	nameAndRules := self nameAndRulesForSelectedProcess.
	nameAndRules third
		ifFalse: [self inform: 'Nope, won''t change priority of ' , nameAndRules first.
			^ self].
	str := UIManager default 
				request: 'New priority' 
		  initialAnswer: selectedProcess priority asString.
	str ifNil: [str := String new].
	newPriority := str asNumber asInteger.
	newPriority
		ifNil: [^ self].
	(newPriority < 1
			or: [newPriority > Processor highestPriority])
		ifTrue: [self inform: 'Bad priority'.
			^ self].
	self class setProcess: selectedProcess toPriority: newPriority.
	self updateProcessList! !

!ProcessBrowser methodsFor: 'initialization' stamp: 'JuanVuletich 10/26/2010 14:05'!
mayBeStartCPUWatcher
	startedCPUWatcher ifTrue: [ self setUpdateCallbackAfter: 7 ].
! !

!ProcessBrowser methodsFor: 'accessing' stamp: 'EstebanLorenzano 1/31/2013 18:20'!
selectedProcess
	^selectedProcess! !

!ProcessBrowser methodsFor: '*Shout-Styling' stamp: 'AlainPlantec 8/27/2011 00:03'!
shoutAboutToStyle: aPluggableShoutMorphOrView

	selectedContext ifNil: [^false].
	aPluggableShoutMorphOrView classOrMetaClass: self selectedClass.
	^ true
! !

!ProcessBrowser methodsFor: 'stack list' stamp: 'BernardoContreras 8/15/2011 20:29'!
messageTally
	| secString secs |
	secString := UIManager default request: 'Profile for how many seconds?' initialAnswer: '4'.
	secString ifNil: [secString := String new].
	secs := secString asNumber asInteger.
	(secs isNil
			or: [secs isZero])
		ifTrue: [^ self].
	[ Smalltalk tools timeProfiler spyOnProcess: selectedProcess forMilliseconds: secs * 1000 ] forkAt: selectedProcess priority + 1.! !

!ProcessBrowser methodsFor: 'stack list' stamp: 'IgorStasenko 4/26/2011 15:35'!
browseContext
	selectedContext
		ifNil: [^ self].
		
	Smalltalk tools browser newOnClass: self selectedClass selector: self selectedSelector! !

!ProcessBrowser methodsFor: 'stack list' stamp: 'nk 7/8/2000 20:23'!
inspectContext
	selectedContext inspect! !

!ProcessBrowser methodsFor: 'process list' stamp: 'CamilloBruni 5/25/2012 18:19'!
processNameList
	"since processList is a WeakArray, we have to strengthen the result"

	| pw tally |
	pw := Smalltalk globals at: #CPUWatcher ifAbsent: [  ].
	tally := pw ifNotNil: [ pw current ifNotNil: [ pw current tally ] ].
	^ (processList asOrderedCollection copyWithout: nil)
		collect: [ :each | 
			| percent |
			percent := tally
				ifNotNil: [ (((tally occurrencesOf: each) * 100.0 / tally size roundTo: 1) asString padLeftTo: 2) , '% ' ]
				ifNil: [ '' ].
			percent , (self prettyNameForProcess: each) ]! !

!ProcessBrowser methodsFor: 'process actions' stamp: 'nk 3/8/2001 13:23'!
resumeProcess
	selectedProcess
		ifNil: [^ self].
	self class resumeProcess: selectedProcess.
	self updateProcessList! !

!ProcessBrowser methodsFor: 'process list' stamp: 'nk 10/28/2000 08:19'!
notify: errorString at: location in: aStream 
	"A syntax error happened when I was trying to highlight my pc. 
	Raise a signal so that it can be ignored."
	Warning signal: 'syntax error'! !

!ProcessBrowser methodsFor: 'updating' stamp: 'sd 11/20/2005 21:27'!
stopAutoUpdate
	autoUpdateProcess ifNotNil: [
		autoUpdateProcess terminate.
		autoUpdateProcess := nil].
	self updateProcessList! !

!ProcessBrowser methodsFor: 'updating' stamp: 'nk 10/28/2000 21:50'!
toggleAutoUpdate
	self isAutoUpdating
		ifTrue: [ self stopAutoUpdate ]
		ifFalse: [ self startAutoUpdate ].
! !

!ProcessBrowser methodsFor: 'process list' stamp: 'sd 11/20/2005 21:27'!
prettyNameForProcess: aProcess 
	| nameAndRules |
	aProcess ifNil: [ ^'<nil>' ].
	nameAndRules := self nameAndRulesFor: aProcess.
	^ aProcess browserPrintStringWith: nameAndRules first! !

!ProcessBrowser methodsFor: 'stack list' stamp: 'nk 10/27/2000 09:28'!
exploreContext
	selectedContext explore! !

!ProcessBrowser methodsFor: 'process actions' stamp: 'sd 11/20/2005 21:27'!
debugProcess
	| nameAndRules |
	nameAndRules := self nameAndRulesForSelectedProcess.
	nameAndRules third
		ifFalse: [self inform: 'Nope, won''t debug ' , nameAndRules first.
			^ self].
	self class debugProcess: selectedProcess.! !

!ProcessBrowser methodsFor: 'accessing' stamp: ''!
stackListIndex
	^ stackListIndex! !

!ProcessBrowser methodsFor: 'process actions' stamp: 'sd 11/20/2005 21:27'!
suspendProcess
	| nameAndRules |
	selectedProcess isSuspended
		ifTrue: [^ self].
	nameAndRules := self nameAndRulesForSelectedProcess.
	nameAndRules second
		ifFalse: [self inform: 'Nope, won''t suspend ' , nameAndRules first.
			^ self].
	self class suspendProcess: selectedProcess.
	self updateProcessList! !

!ProcessBrowser methodsFor: 'process list' stamp: 'DamienCassou 9/29/2009 13:07'!
findContext
	| initialProcessIndex initialStackIndex found |
	initialProcessIndex := self processListIndex.
	initialStackIndex := self stackListIndex.
	searchString := UIManager default 
			request: 'Enter a string to search for in the process stack lists'
	  initialAnswer: searchString.
	searchString isEmptyOrNil
		ifTrue: [^ false].
	self processListIndex: 1.
	self stackListIndex: 1.
	found := self nextContext.
	found
		ifFalse: [self processListIndex: initialProcessIndex.
			self stackListIndex: initialStackIndex].
	^ found! !

!ProcessBrowser methodsFor: 'accessing' stamp: 'md 2/17/2006 12:07'!
selectedSelector
	"Answer the class in which the currently selected context's method was  
	found."
	^ selectedSelector
		ifNil: [selectedSelector := selectedContext receiver
				ifNil: [selectedClass := selectedContext method methodClass
					   selectedContext method selector]
				ifNotNil: [selectedContext selector]]! !

!ProcessBrowser methodsFor: 'stack list' stamp: 'sd 11/20/2005 21:27'!
updateStackList: depth 
	| suspendedContext oldHighlight |
	selectedProcess
		ifNil: [^ self changeStackListTo: nil].
	(stackList notNil and: [ stackListIndex > 0 ])
		ifTrue: [oldHighlight := stackList at: stackListIndex].
	selectedProcess == Processor activeProcess
		ifTrue: [self
				changeStackListTo: (thisContext stackOfSize: depth)]
		ifFalse: [suspendedContext := selectedProcess suspendedContext.
			suspendedContext
				ifNil: [self changeStackListTo: nil]
				ifNotNil: [self
						changeStackListTo: (suspendedContext stackOfSize: depth)]].
	self
		stackListIndex: (stackList
				ifNil: [0]
				ifNotNil: [stackList indexOf: oldHighlight])! !

!ProcessBrowser methodsFor: 'process list' stamp: 'EstebanLorenzano 8/17/2012 16:40'!
nextContext
	| initialProcessIndex initialStackIndex found |
	searchString isEmpty ifTrue: [ ^false ].
	initialProcessIndex := self processListIndex.
	initialStackIndex := self stackListIndex.
	found := false.
	initialProcessIndex
		to: self processList size
		do: [:pi | found
				ifFalse: [self processListIndex: pi.
					self stackNameList
						withIndexDo: [:name :si | (found not
									and: [pi ~= initialProcessIndex
											or: [si > initialStackIndex]])
								ifTrue: [(name includesSubstring: searchString)
										ifTrue: [self stackListIndex: si.
											found := true]]]]].
	found
		ifFalse: [self processListIndex: initialProcessIndex.
			self stackListIndex: initialStackIndex].
	^ found! !

!ProcessBrowser methodsFor: 'process list' stamp: ''!
inspectProcess
	selectedProcess inspect! !

!ProcessBrowser methodsFor: 'accessing' stamp: 'sd 11/20/2005 21:27'!
processListIndex: index 
	processListIndex := index.
	selectedProcess := processList
				at: index
				ifAbsent: [].
	self updateStackList.
	self changed: #processListIndex.! !

!ProcessBrowser methodsFor: 'views' stamp: 'MarcusDenker 10/15/2012 21:21'!
openAsMorph 
	| window aTextMorph |
	window := (SystemWindow labelled: 'later')
				model: self.

	self deferredMessageRecipient: WorldState.
	window
		addMorph: ((PluggableListMorph
				on: self
				list: #processNameList
				selected: #processListIndex
				changeSelected: #processListIndex:
				menu: #processListMenu:
				keystroke: #processListKey:from:)
				enableDragNDrop: false)
		frame: (0 @ 0 extent: 0.5 @ 0.5).
	window
		addMorph: ((PluggableListMorph
				on: self
				list: #stackNameList
				selected: #stackListIndex
				changeSelected: #stackListIndex:
				menu: #stackListMenu:
				keystroke: #stackListKey:from:)
				enableDragNDrop: false)
		frame: (0.5 @ 0.0 extent: 0.5 @ 0.5).
	aTextMorph := PluggableTextMorph
				on: self
				text: #selectedMethod
				accept: nil
				readSelection: nil
				menu: nil.
	aTextMorph askBeforeDiscardingEdits: false.
	aTextMorph font: StandardFonts codeFont.
	window
		addMorph: aTextMorph
		frame: (0 @ 0.5 corner: 1 @ 1).
	window setUpdatablePanesFrom: #(#processNameList #stackNameList ).
	(window setLabel: 'Process Browser') openInWorld.
	self mayBeStartCPUWatcher.
	^ window! !

!ProcessBrowser methodsFor: 'accessing' stamp: 'nk 10/28/2000 08:36'!
text
	^methodText! !

!ProcessBrowser methodsFor: 'accessing' stamp: ''!
processListIndex
	^ processListIndex! !

!ProcessBrowser methodsFor: 'process actions' stamp: 'IgorStasenko 1/22/2012 14:42'!
explorePointers
	| saved |
	selectedProcess ifNil: [ ^ self ].
	saved := selectedProcess.
	[ 
	selectedProcess := nil.
	
	(Smalltalk tools hasToolNamed: #pointerExplorer)
		ifTrue: [ Smalltalk tools pointerExplorer openOn: saved ]
		ifFalse: [ self inspectPointers ] ] ensure: [ selectedProcess := saved ]! !

!ProcessBrowser methodsFor: 'process list' stamp: 'nk 10/27/2000 09:24'!
exploreProcess
	selectedProcess explore! !

!ProcessBrowser methodsFor: 'process list' stamp: 'StephaneDucasse 5/18/2012 18:31'!
processListKey: aKey from: aView 
	self perform: (self keyEventsDict at: aKey ifAbsent: [ ^ self ])! !

!ProcessBrowser methodsFor: 'stack list' stamp: 'nk 10/28/2000 16:18'!
stackNameList
	^ stackList
		ifNil: [#()]
		ifNotNil: [stackList
				collect: [:each | each asString]]! !

!ProcessBrowser methodsFor: 'accessing' stamp: 'eem 6/12/2008 12:41'!
stackListIndex: index 
	stackListIndex := index.
	selectedContext := (stackList notNil
						and: [index > 0]) ifTrue:
							[stackList at: index ifAbsent: []].
	selectedClass := nil.
	selectedSelector := nil.
	methodText := nil.
	self changed: #stackListIndex.
	self changed: #selectedMethod! !

!ProcessBrowser methodsFor: 'process actions' stamp: 'sd 11/20/2005 21:27'!
terminateProcess
	| nameAndRules |
	nameAndRules := self nameAndRulesForSelectedProcess.
	nameAndRules second
		ifFalse: [self inform: 'Nope, won''t kill ' , nameAndRules first.
			^ self].
	self class terminateProcess: selectedProcess.	
	self updateProcessList! !

!ProcessBrowser methodsFor: 'views' stamp: 'nk 10/28/2000 11:44'!
hasView
	^self dependents isEmptyOrNil not! !

!ProcessBrowser methodsFor: 'updating' stamp: 'AlainPlantec 7/9/2013 12:40'!
startAutoUpdate
	self isAutoUpdatingPaused ifTrue: [ ^autoUpdateProcess resume ].
	self isAutoUpdating
		ifFalse: [| delay | 
			delay := Delay forSeconds: 2.
			autoUpdateProcess := [[self hasView]
						whileTrue: [delay wait.
							deferredMessageRecipient ifNotNil: [
								deferredMessageRecipient defer: [self updateProcessList]]
							ifNil: [ self updateProcessList ]].
					autoUpdateProcess := nil] fork].
	self updateProcessList! !

!ProcessBrowser methodsFor: 'accessing' stamp: 'JuanVuletich 10/26/2010 14:01'!
deferredMessageRecipient: anObject
	deferredMessageRecipient := anObject! !

!ProcessBrowser methodsFor: 'process list' stamp: 'EstebanLorenzano 1/31/2013 19:25'!
processListMenu: menu
	^menu addAllFromPragma: 'processBrowserProcessListMenu' target: self! !

!ProcessBrowser methodsFor: 'stack list' stamp: 'nk 10/27/2000 09:41'!
inspectReceiver
	selectedContext
		ifNotNil: [selectedContext receiver inspect]! !

!ProcessBrowser methodsFor: 'accessing' stamp: 'md 2/17/2006 09:32'!
selectedClass
	"Answer the class in which the currently selected context's method was  
	found."
	^ selectedClass
		ifNil: [selectedClass := selectedContext receiver
				ifNil: [selectedSelector := selectedContext method selector.
					   selectedContext method methodClass]
				ifNotNil: [selectedContext methodClass]]! !

!ProcessBrowser methodsFor: 'views' stamp: 'StephaneDucasse 5/18/2012 18:37'!
stackListKey: aKey from: aView 
	aKey = $c ifTrue: [ self inspectContext].
	aKey = $C ifTrue: [ self exploreContext].
	aKey = $i ifTrue: [ self inspectReceiver].
	aKey = $I ifTrue: [ self exploreReceiver].
	aKey = $b ifTrue: [ self browseContext].

! !

!ProcessBrowser methodsFor: 'process actions' stamp: 'ClementBera 9/30/2013 09:51'!
inspectPointers
	| tc pointers |
	selectedProcess ifNil: [ ^ self ].
	tc := thisContext.
	pointers := selectedProcess pointersToExcept: { self processList. tc. self}.
	pointers ifEmpty: [ ^ self ].
	pointers inspectWithLabel: 'Objects pointing to ' , selectedProcess browserPrintString! !

!ProcessBrowser methodsFor: 'process actions' stamp: 'nk 3/8/2001 13:35'!
nameAndRulesFor: aProcess 
	"Answer a nickname and two flags: allow-stop, and allow-debug"
	aProcess == autoUpdateProcess ifTrue: [ ^{'my auto-update process'. true. true} ].
	^self class nameAndRulesFor: aProcess 
! !

!ProcessBrowser methodsFor: 'updating' stamp: 'nk 6/18/2003 07:20'!
isAutoUpdatingPaused
	^autoUpdateProcess notNil and: [ autoUpdateProcess isSuspended ]! !

!ProcessBrowser methodsFor: 'updating' stamp: 'nk 6/18/2003 07:20'!
pauseAutoUpdate
	self isAutoUpdating
		ifTrue: [ autoUpdateProcess suspend ].
	self updateProcessList! !

!ProcessBrowser methodsFor: 'accessing' stamp: ''!
stackList
	^ stackList! !

!ProcessBrowser methodsFor: 'updating' stamp: 'nk 10/28/2000 21:48'!
isAutoUpdating
	^autoUpdateProcess notNil and: [ autoUpdateProcess isSuspended  not ]! !

!ProcessBrowser methodsFor: 'process list' stamp: 'GuillermoPolito 9/4/2010 20:39'!
updateProcessList
	| oldSelectedProcess newIndex now |
	now := Time millisecondClockValue.
	now - lastUpdate < 500
		ifTrue: [^ self].
	"Don't update too fast"
	lastUpdate := now.
	oldSelectedProcess := selectedProcess.
	processList := selectedProcess := selectedSelector := nil.
	Smalltalk garbageCollectMost.
	"lose defunct processes"

	processList := Process allSubInstances
				reject: [:each | each isTerminated].
	processList := processList
				sort: [:a :b | a priority >= b priority].
	processList := WeakArray withAll: processList.
	newIndex := processList
				indexOf: oldSelectedProcess
				ifAbsent: [0].
	self changed: #processNameList.
	self processListIndex: newIndex! !

!ProcessBrowser methodsFor: 'stack list' stamp: 'nk 10/27/2000 09:41'!
exploreReceiver
	selectedContext ifNotNil: [ selectedContext receiver explore ]! !

!ProcessBrowser methodsFor: 'initialization' stamp: 'lr 3/14/2010 21:13'!
startCPUWatcher
	"Answers whether I started the CPUWatcher"

	| pw |
	pw := Smalltalk globals at: #CPUWatcher ifAbsent: [ ^ self ].
	pw
		ifNotNil: [ 
			pw isMonitoring
				ifFalse: [ 
					pw startMonitoringPeriod: 5 rate: 100 threshold: 0.85.
					self setUpdateCallbackAfter: 7.
					^ true ] ].
	^ false! !

!ProcessBrowser methodsFor: 'stack list' stamp: 'nk 7/8/2000 20:24'!
updateStackList
	self updateStackList: 20! !

!ProcessBrowser methodsFor: 'process actions' stamp: 'nk 10/29/2000 08:56'!
wasProcessSuspendedByProcessBrowser: aProcess
	^self class suspendedProcesses includesKey: aProcess! !

!ProcessBrowser methodsFor: 'process actions' stamp: 'nk 10/28/2000 20:31'!
nameAndRulesForSelectedProcess
	"Answer a nickname and two flags: allow-stop, and allow-debug"
	^self nameAndRulesFor: selectedProcess! !

!ProcessBrowser methodsFor: 'stack list' stamp: 'sd 11/20/2005 21:27'!
changeStackListTo: aCollection 

        stackList := aCollection.
        self changed: #stackNameList.
        self stackListIndex: 0! !

!ProcessBrowser class methodsFor: 'process control' stamp: 'GabrielOmarCotelli 11/30/2013 16:24'!
unregisterWellKnownProcess: aProcess
	"Remove the first registry entry that matches aProcess. Use
	with caution if more than one registry entry may match aProcess."

	"self unregisterWellKnownProcess: Smalltalk lowSpaceWatcherProcess"

	WellKnownProcesses detect: [ :e | e key value == aProcess ] ifFound: [ :entry | WellKnownProcesses remove: entry ]! !

!ProcessBrowser class methodsFor: 'process control' stamp: 'dtl 2/5/2005 09:07'!
registerWellKnownProcess: aBlockForProcess label: nickname allowStop: allowStop allowDebug: allowDebug
	"Add an entry to the registry of well known processes. aBlockForProcess
	evaluates to a known process to be identified by nickname, and allowStop
	and allowDebug are flags controlling allowable actions for this process
	in the browser."

	WellKnownProcesses add: aBlockForProcess->[{nickname . allowStop . allowDebug}]! !

!ProcessBrowser class methodsFor: '*Polymorph-Widgets' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
theme
	^ Smalltalk ui theme! !

!ProcessBrowser class methodsFor: 'CPU utilization' stamp: 'AlainPlantec 7/9/2013 12:40'!
tallyCPUUsageFor: seconds every: msec
	"Compute CPU usage using a msec millisecond sample for the given number of seconds,
	then dump the usage statistics on the Transcript. The UI is free to continue, meanwhile"
	"ProcessBrowser tallyCPUUsageFor: 10 every: 100"

	| promise |
	promise := Processor tallyCPUUsageFor: seconds every: msec.

	[ | tally |
		tally := promise value.
		UIManager default defer: [ self dumpTallyOnTranscript: tally ].
	] fork.! !

!ProcessBrowser class methodsFor: 'initialization' stamp: 'MarcusDenker 5/20/2011 08:32'!
initialize
	"ProcessBrowser initialize"
	SuspendedProcesses ifNil: [ SuspendedProcesses := IdentityDictionary new ].
	self registerWellKnownProcesses! !

!ProcessBrowser class methodsFor: 'CPU utilization' stamp: 'IgorStasenko 4/26/2011 15:52'!
dumpPigStackOn: aStream andClose: aBoolean
	"Must run forked on its own process, so the monitored behavior is not affected too much" 

	| promise tally process depth stack suspendedContext |
	promise := Processor tallyCPUUsageFor: 1 every: 10.
	tally := promise value.
	"WorldState addDeferredUIMessage: [self dumpTallyOnTranscript: tally]."
	aStream nextPutAll: '====Al processes===='; cr.
	self dumpTally: tally on: aStream.
	aStream cr; nextPutAll: '====Process using most CPU===='; cr.
	process := tally sortedCounts first value.
	(100.0 * (tally occurrencesOf: process) / tally size) rounded printOn: aStream.
	aStream
		nextPutAll: ' % ';
		nextPutAll: (process browserPrintStringWith: (self nameAndRulesFor: process) first);
		cr.
	depth := 20.
	stack := process == Processor activeProcess
		ifTrue: [thisContext stackOfSize: depth]
		ifFalse: [suspendedContext := process suspendedContext.
			suspendedContext
				ifNotNil: [suspendedContext stackOfSize: depth]].
	stack 
		ifNil: [ aStream nextPutAll: 'No context'; cr]
		ifNotNil: [
			stack do: [ :c | 
				c printOn: aStream.
				aStream cr]].
	aBoolean ifTrue: [aStream close]! !

!ProcessBrowser class methodsFor: 'tools registry' stamp: 'IgorStasenko 2/19/2011 03:01'!
registerToolsOn: registry
	"Add ourselves to registry. See [Smalltalk tools]" 
	registry register: self as: #processBrowser
! !

!ProcessBrowser class methodsFor: 'process control' stamp: 'nk 3/8/2001 17:09'!
debugProcess: aProcess
	self resumeProcess: aProcess.
	aProcess debugWithTitle: 'Interrupted from the Process Browser'.
! !

!ProcessBrowser class methodsFor: 'CPU utilization' stamp: 'jmv 5/22/2009 12:30'!
dumpTallyOnTranscript: tally
	"tally is from ProcessorScheduler>>tallyCPUUsageFor:
	Dumps lines with percentage of time, hash of process, and a friendly name"

	self dumpTally: tally on: Transcript.
	Transcript flush.! !

!ProcessBrowser class methodsFor: 'process control' stamp: 'sd 11/20/2005 21:28'!
setProcess: aProcess toPriority: priority
	| oldPriority |
	oldPriority := self suspendedProcesses at: aProcess ifAbsent: [ ].
	oldPriority ifNotNil: [ self suspendedProcesses at: aProcess put: priority ].
	aProcess priority: priority.
	^oldPriority! !

!ProcessBrowser class methodsFor: 'process control' stamp: 'CamilloBruni 8/21/2013 19:24'!
nameAndRulesFor: aProcess 
	"Answer a nickname and two flags: allow-stop, and allow-debug"
	| rules |
	rules := {nil. true. true}.
	WellKnownProcesses do: [:blockAndRules |
		blockAndRules key value == aProcess 
			ifTrue: [ rules := blockAndRules value value ]].
	rules first ifNil: [ 
		rules at: 1 put: aProcess suspendedContext asString ].
	^ rules! !

!ProcessBrowser class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/15/2013 13:50'!
taskbarIcon
	"Answer the icon for the receiver in a task bar."

	^ Smalltalk ui icons iconNamed: #processBrowserIcon! !

!ProcessBrowser class methodsFor: 'world menu' stamp: 'TorstenBergmann 2/12/2014 09:25'!
menuCommandOn: aBuilder 
	<worldMenu> 
	(aBuilder item: #'Process Browser')
		parent: #Tools;
		order: 0.42;
		action:[self open]; 
		icon: self taskbarIcon.! !

!ProcessBrowser class methodsFor: 'process control' stamp: 'sd 11/20/2005 21:28'!
suspendProcess: aProcess
	| priority |
	priority := aProcess priority.
	self suspendedProcesses at: aProcess put: priority.
	"Need to take the priority down below the caller's
	so that it can keep control after signaling the Semaphore"
	(aProcess suspendingList isKindOf: Semaphore)
		ifTrue: [aProcess priority: Processor lowestPriority.
			aProcess suspendingList signal].
	[aProcess suspend]
		on: Error
		do: [:ex | self suspendedProcesses removeKey: aProcess].
	aProcess priority: priority.
! !

!ProcessBrowser class methodsFor: 'menu' stamp: 'EstebanLorenzano 1/31/2013 18:25'!
menuStackList: aBuilder
	<contextMenu>
	<processBrowserStackListMenu>
	
	(aBuilder item: #'Inspect context')
		keyText: 'c';
		selector: #inspectContext.
	(aBuilder item: #'Explore context')
		keyText: 'C';
		selector: #exploreContext;
		withSeparatorAfter.
		
	(aBuilder item: #'Inspect receiver')
		keyText: 'i';
		selector: #inspectReceiver.
	(aBuilder item: #'Explore receiver')
		keyText: 'I';
		selector: #exploreReceiver;
		withSeparatorAfter.
		
	(aBuilder item: #'Browse')
		keyText: 'b';
		selector: #browseContext.! !

!ProcessBrowser class methodsFor: 'CPU utilization' stamp: 'nk 3/8/2001 12:49'!
tallyCPUUsageFor: seconds
	"Compute CPU usage using a 10-msec sample for the given number of seconds,
	then dump the usage statistics on the Transcript. The UI is free to continue, meanwhile"
	"ProcessBrowser tallyCPUUsageFor: 10"
	^self tallyCPUUsageFor: seconds every: 10! !

!ProcessBrowser class methodsFor: 'CPU utilization' stamp: 'stephane.ducasse 8/5/2009 17:07'!
dumpTally: tally on: aStream
	"tally is from ProcessorScheduler>>tallyCPUUsageFor:
	Dumps lines with percentage of time, hash of process, and a friendly name"

	tally sortedCounts do: [ :assoc | | procName |
		procName := (self nameAndRulesFor: assoc value) first.
		(((assoc key / tally size) * 100.0) roundTo: 1) printOn: aStream.
		aStream
			nextPutAll: '%   ';
			print: assoc value identityHash; space;
			nextPutAll: procName;
			cr.
	]! !

!ProcessBrowser class methodsFor: 'initialization' stamp: 'MarcusDenker 10/2/2013 20:17'!
cleanUp
 "Remove terminated processes from my suspended list"

       self suspendedProcesses keysDo: [:ea |
               ea isTerminated ifTrue: [self suspendedProcesses removeKey: ea]]! !

!ProcessBrowser class methodsFor: 'process control' stamp: 'nk 3/8/2001 13:26'!
wasProcessSuspendedByProcessBrowser: aProcess
	^self suspendedProcesses includesKey: aProcess! !

!ProcessBrowser class methodsFor: 'process control' stamp: 'sd 11/20/2005 21:28'!
suspendedProcesses
	"Answer a collection of processes that my instances have suspended.  
	This is so that they don't get garbage collected."
	^ SuspendedProcesses
		ifNil: [SuspendedProcesses := IdentityDictionary new]! !

!ProcessBrowser class methodsFor: 'menu' stamp: 'EstebanLorenzano 1/31/2013 18:18'!
menuProcessList: aBuilder 
	<contextMenu>
	<processBrowserProcessListMenu>

	| target selectedProcess |
	
	target := aBuilder model.
	selectedProcess := target selectedProcess.
	
	selectedProcess
		ifNotNil: [ 
			| nameAndRules |
			nameAndRules := target nameAndRulesForSelectedProcess.
			(aBuilder item: #'Inspect')
				keyText: 'i';
				selector: #inspectProcess.
			(aBuilder item: #'Explore')
				keyText: 'I';
				selector: #exploreProcess.
			(aBuilder item: #'Inspect Pointers')
				keyText: 'P';
				selector: #inspectPointers.
			(Smalltalk globals includesKey: #PointerExplorer)
				ifTrue: [ 
					(aBuilder item: #'Explore pointers')
						keyText: 'e';
						selector: #explorePointers ].
					
			nameAndRules second
				ifTrue: [ 
					(aBuilder item: #'Terminate')
						keyText: 't';
						selector: #terminateProcess.

					selectedProcess isSuspended
						ifTrue: [ 
							(aBuilder item: #'Resume')
								keyText: 'r';
								selector: #resumeProcess ]
						ifFalse: [ 
							(aBuilder item: #'Suspend')
								keyText: 's';
								selector: #suspendProcess ] ].
			
			nameAndRules third
				ifTrue: [ 
					(aBuilder item: #'Change priority')
						keyText: 'p';
						selector: #changePriority.
					(aBuilder item: #'Debug')
						keyText: 'd';
						selector: #debugProcess ].
			
			(aBuilder item: #'Profile messages')
				keyText: 'm';
				selector: #messageTally.

			(selectedProcess suspendingList isKindOf: Semaphore)
				ifTrue: [ 
					(aBuilder item: #'Signal Semaphore')
						keyText: 'S';
						selector: #signalSemaphore ].
					
			(aBuilder item: #'Full stack')
				keyText: 'k';
				selector: #moreStack;
				withSeparatorAfter ].

	(aBuilder item: #'Find context...')
		keyText: 'f';
		selector: #findContext.
	(aBuilder item: #'Find again')
		keyText: 'g';
		selector: #nextContext;
		withSeparatorAfter.
		
	(aBuilder item: (target isAutoUpdating
			ifTrue: [ #'Turn off auto-update' ]
			ifFalse: [ #'Turn on auto-update' ]))
		keyText: 'a';
		selector: #toggleAutoUpdate.
	(aBuilder item: #'Update list')
		keyText: 'u';
		selector: #updateProcessList.

	Smalltalk globals 
		at: #CPUWatcher 
		ifPresent: [ :pw | 
			aBuilder withSeparatorAfter.
			pw isMonitoring
				ifTrue: [ 
					(aBuilder item: #'Stop CPUWatcher')
						selector: #stopCPUWatcher ]
				ifFalse: [ 
					(aBuilder item: #'Start CPUWatcher')
						selector: #startCPUWatcher ] ].! !

!ProcessBrowser class methodsFor: 'instance creation' stamp: 'alain.plantec 6/1/2008 19:03'!
open
	"ProcessBrowser open"
	"Create and schedule a ProcessBrowser."
	Smalltalk garbageCollect.
	^ self new openAsMorph! !

!ProcessBrowser class methodsFor: 'process control' stamp: 'sd 11/20/2005 21:28'!
resumeProcess: aProcess
	| priority |
	priority := self suspendedProcesses
				removeKey: aProcess
				ifAbsent: [aProcess priority].
	aProcess priority: priority.
	aProcess suspendedContext ifNotNil: [ aProcess resume ]
! !

!ProcessBrowser class methodsFor: 'process control' stamp: 'nk 3/8/2001 13:25'!
terminateProcess: aProcess
	aProcess ifNotNil: [
		self suspendedProcesses
			removeKey: aProcess
			ifAbsent: [].
		aProcess terminate
	].
! !

!ProcessBrowser class methodsFor: 'initialization' stamp: 'CamilloBruni 8/21/2013 19:21'!
registerWellKnownProcesses
	"Associate each well-known process with a nickname and two flags: allow-stop, and allow-debug.
	Additional processes may be added to this list as required"

	WellKnownProcesses := OrderedCollection new.
	self
		registerWellKnownProcess: [  ]
		label: 'no process'
		allowStop: false
		allowDebug: false.
	self
		registerWellKnownProcess: [ Smalltalk lowSpaceWatcherProcess ]
		label: nil
		allowStop: false
		allowDebug: false.
	self
		registerWellKnownProcess: [ WeakArray runningFinalizationProcess ]
		label: nil
		allowStop: false
		allowDebug: false.
	self
		registerWellKnownProcess: [ Processor backgroundProcess ]
		label: nil
		allowStop: false
		allowDebug: false.
	self
		registerWellKnownProcess: [ InputEventFetcher default fetcherProcess ]
		label: nil
		allowStop: false
		allowDebug: false.
	self
		registerWellKnownProcess: [ UIManager default uiProcess ]
		label: nil
		allowStop: false
		allowDebug: false.
	self
		registerWellKnownProcess: [ Smalltalk globals at: #SoundPlayer ifPresent: [ :sp | sp playerProcess ] ]
		label: 'the Sound Player'
		allowStop: false
		allowDebug: false.
	self
		registerWellKnownProcess: [ Smalltalk globals at: #CPUWatcher ifPresent: [ :cw | cw currentWatcherProcess ] ]
		label: 'the CPUWatcher'
		allowStop: false
		allowDebug: false.
		
	self
		registerWellKnownProcess: [ Delay schedulingProcess ]
		label: nil
		allowStop: false
		allowDebug: false! !

!ProcessBrowser class methodsFor: 'process control' stamp: 'JuanVuletich 11/1/2010 10:13'!
isUIProcess: aProcess
	^ aProcess == UIManager default uiProcess! !

!ProcessLocalSlot commentStamp: 'GuillermoPolito 2/27/2015 11:47'!
A ProcessLocal is a slot that references different objects in different processes.

Internally it is implemented with a ProcessLocalVariable. Writing into the slot writes a field in the current process. 

myProcessLocalVariable value: anObject

Reading into the Slot reads the only field in the array.

myProcessLocalVariable value.

This slot inherits from IndexedSlot to guarantee that this slot has a real field inside an object.

This slot should be used wisely:

1) The value is stored weakly, an example of this would be:
obj := MyClass new.
obj local: Object new.
obj local. “anObject” <—— Now we see the object
Smalltalk garbageCollect.
obj local. “nil” <—— Now we don’t

2) This variable are stored in a WeakArray in the Process, so massive use of them will make the array in the processes start growing a lot and often.
!
!ProcessLocalSlot methodsFor: 'meta-object-protocol' stamp: 'GuillermoPolito 2/26/2015 18:36'!
write: aValue to: anObject

	(super read: anObject) value: aValue.
	^ aValue! !

!ProcessLocalSlot methodsFor: 'code generation' stamp: 'GuillermoPolito 2/26/2015 18:40'!
emitStore: aMethodBuilder
	| temp |
	temp := Object new.
	"We pop the value from the stack into a temp to push it back in the right order"
	aMethodBuilder addTemp: temp.
	aMethodBuilder storeTemp: temp.
	
	"Push the process local variable into the stack, then the value again, then send"
	aMethodBuilder pushInstVar: index.
	aMethodBuilder pushTemp: temp.
	aMethodBuilder send: #value:! !

!ProcessLocalSlot methodsFor: 'initialization' stamp: 'GuillermoPolito 2/26/2015 18:36'!
initialize: anObject
	super write: ProcessLocalVariable new to: anObject! !

!ProcessLocalSlot methodsFor: 'meta-object-protocol' stamp: 'GuillermoPolito 2/26/2015 18:37'!
read: anObject

	^ (super read: anObject) value.! !

!ProcessLocalSlot methodsFor: 'meta-object-protocol' stamp: 'GuillermoPolito 2/26/2015 18:37'!
wantsInitalization

	^ true! !

!ProcessLocalSlot methodsFor: 'code generation' stamp: 'GuillermoPolito 2/26/2015 18:38'!
emitValue: aMethodBuilder
	"Push the process local variable into the stack"
	aMethodBuilder pushInstVar: index.
	aMethodBuilder send: #value! !

!ProcessLocalVariable commentStamp: 'mvl 3/13/2007 12:28'!
My subclasses have values specific to the active process. They can be read with #value and set with #value:!
!ProcessLocalVariable methodsFor: 'evaluating' stamp: 'IgorStasenko 11/7/2011 11:20'!
value: anObject
	Processor activeProcess psValueAt: index put: anObject! !

!ProcessLocalVariable class methodsFor: 'accessing' stamp: 'IgorStasenko 11/2/2011 18:41'!
value: anObject
	^ self soleInstance value: anObject! !

!ProcessSpecificTest commentStamp: 'mvl 3/13/2007 13:52'!
A ProcessSpecificTest is a test case for process local and dynamic variables.
!
!ProcessSpecificTest methodsFor: 'testing' stamp: 'mvl 3/13/2007 14:13'!
checkLocal: value
	self assert: TestLocalVariable value = value! !

!ProcessSpecificTest methodsFor: 'testing' stamp: 'mvl 3/13/2007 15:03'!
testLocalVariable

	| s1 s2 p1stopped p2stopped |
	s1 := Semaphore new.
	s2 := Semaphore new.
	p1stopped := p2stopped := false.
	[
		self checkLocal: 0.
		TestLocalVariable value: 1.
		self checkLocal: 1.
		(Delay forMilliseconds: 30) wait.
		self checkLocal: 1.
		TestLocalVariable value: 2.
		self checkLocal: 2.
		p1stopped := true.
		s1 signal.
	] fork.

	[
		(Delay forMilliseconds: 30) wait.
		self checkLocal: 0.
		TestLocalVariable value: 3.
		self checkLocal: 3.
		(Delay forMilliseconds: 30) wait.
		self checkLocal: 3.
		TestLocalVariable value: 4.
		self checkLocal: 4.
		p2stopped := true.
		s2 signal.
	] fork.

	"Set a maximum wait timeout so that the test case will complete 
	 even if the processes fail to signal us."
	s1 waitTimeoutMSecs: 5000.
	s2 waitTimeoutMSecs: 5000.
	self assert: p1stopped.
	self assert: p2stopped.
! !

!ProcessSpecificTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/3/2012 21:52'!
testDynamicVariableBlockReturnValue
	| returnValue |
	returnValue := TestDynamicVariable value: 10 during: [ TestDynamicVariable value + 1 ].
	self assert: returnValue equals: 11! !

!ProcessSpecificTest methodsFor: 'testing' stamp: 'mvl 3/13/2007 14:13'!
checkDynamic: value
	self assert: TestDynamicVariable value = value! !

!ProcessSpecificTest methodsFor: 'testing' stamp: 'NorbertHartl 6/23/2014 23:40'!
testDynamicVariableAccessFromDifferentProcess
	| process sem result |
	
	sem := Semaphore new.
	process := [  
		TestDynamicVariable 
			value: 123 
			during: [ sem wait ] ] fork.
	Processor yield.
	Processor activeProcess 
		evaluate: [  result := TestDynamicVariable value ] 
		onBehalfOf: process.
	sem signal.
	self assert: result = 123! !

!ProcessSpecificTest methodsFor: 'testing' stamp: 'mvl 3/13/2007 15:02'!
testDynamicVariable

	| s1 s2 p1stopped p2stopped |
	s1 := Semaphore new.
	s2 := Semaphore new.
	p1stopped := p2stopped := false.
	[
		TestDynamicVariable value: 1 during:[
			self checkDynamic: 1.
			(Delay forMilliseconds: 30) wait.
			self checkDynamic: 1.
			TestDynamicVariable value: 3 during:[
				(Delay forMilliseconds: 30) wait.
				self checkDynamic: 3
			].
			self checkDynamic: 1.
		].
		self checkDynamic: nil.
		p1stopped := true.
		s1 signal.
	] fork.

	[
		TestDynamicVariable value: 2 during:[
			self checkDynamic: 2.
			(Delay forMilliseconds: 30) wait.
			self checkDynamic: 2.
		].
		self checkDynamic: nil.
		p2stopped := true.
		s2 signal.
	] fork.

	"Set a maximum wait timeout so that the test case will complete 
	 even if the processes fail to signal us."
	s1 waitTimeoutSeconds: 2.
	s2 waitTimeoutSeconds: 2.
	self assert: p1stopped.
	self assert: p2stopped.! !

!ProcessSpecificVariable commentStamp: 'mvl 3/13/2007 13:53'!
My subclasses (not instances of them) keep state specific to the current process.

There are two kinds of process-specific variables: process-local (state available
for read and write in all methods inside the process), and dynamic variables
(implementing dynamic scope).!
!ProcessSpecificVariable methodsFor: 'accessing' stamp: 'IgorStasenko 11/2/2011 19:26'!
value

	^ (Processor activeProcess psValueAt: index) ifNil: [ self default ]! !

!ProcessSpecificVariable methodsFor: 'accessing' stamp: 'IgorStasenko 11/2/2011 18:27'!
default
	"Answer the default value for the variable. The default for the default value is nil."
	^nil! !

!ProcessSpecificVariable methodsFor: 'accessing' stamp: 'IgorStasenko 11/2/2011 18:53'!
valueOrNil
	"a faster version, which doesn't using ifAbsent: to  avoid using block closure"
	^ Processor activeProcess psValueAt: index ! !

!ProcessSpecificVariable methodsFor: 'accessing' stamp: 'IgorStasenko 11/7/2011 11:18'!
index: anInteger
	index := anInteger! !

!ProcessSpecificVariable class methodsFor: 'accessing' stamp: 'IgorStasenko 11/2/2011 18:40'!
soleInstance
	^ soleInstance ifNil: [ soleInstance := self new ]! !

!ProcessSpecificVariable class methodsFor: 'class initialization' stamp: 'MarianoMartinezPeck 8/28/2012 14:53'!
initialize
	"Add Process::env if it is missing"
	
	(Process instVarNames includes: 'env')
	ifFalse: [ Process addInstVarNamed: 'env'].
	
	self resetSoleInstance.! !

!ProcessSpecificVariable class methodsFor: 'accessing' stamp: 'IgorStasenko 11/2/2011 18:40'!
value
	"Answer the current value for this variable in the current context."
	^ self soleInstance value! !

!ProcessSpecificVariable class methodsFor: 'instance creation' stamp: 'IgorStasenko 11/2/2011 18:19'!
new
	| instance |
	instance := super new.
	instance index: (Process allocatePSKey: instance).
	^ instance! !

!ProcessSpecificVariable class methodsFor: 'class initialization' stamp: 'MarianoMartinezPeck 8/28/2012 14:53'!
resetSoleInstance
	soleInstance := nil.! !

!ProcessTerminateBug commentStamp: 'TorstenBergmann 2/5/2014 08:42'!
SUnit tests for Process termination!
!ProcessTerminateBug methodsFor: 'tests' stamp: 'StephaneDucasse 3/7/2010 15:40'!
testUnwindFromActiveProcess
	"self debug: #testUnwindFromActiveProcess"
	
	| sema process |
	sema := Semaphore forMutualExclusion.
	self assert: (sema isSignaled).
	process := [ sema critical: 
						[ self deny: sema isSignaled.
						Processor activeProcess terminate.]] forkAt: Processor userInterruptPriority.
	self assert: sema isSignaled.! !

!ProcessTerminateBug methodsFor: 'tests' stamp: 'StephaneDucasse 3/7/2010 15:43'!
testTerminationDuringUnwind
	"An illustration of the issue of process termination during unwind.
	This uses a well-behaved unwind block that we should allow to complete
	if at all possible."
	"self debug: #testTerminationDuringUnwind"
	
	| unwindStarted unwindFinished p |
	unwindStarted := unwindFinished := false.
	p := [[] ensure:
			[ unwindStarted := true.
			Processor yield.
			unwindFinished := true. ]] fork.
	self deny: unwindStarted.
	Processor yield.
	self assert: unwindStarted.
	self deny: unwindFinished.
	p terminate.
	self assert: unwindFinished.! !

!ProcessTerminateBug methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:23'!
testUnwindFromForeignProcess
	"self debug:#testUnwindFromForeignProcess"

	| sema process |
	sema := Semaphore forMutualExclusion.
	self assert: sema isSignaled.
	process := [ 
	sema
		critical: [ 
			self deny: sema isSignaled.
			sema wait	"deadlock" ] ] forkAt: Processor userInterruptPriority.
	self deny: sema isSignaled.	"This is for illustration only - the BlockCannotReturn cannot 
	be handled here (it's truncated already)"
	process terminate.
	self assert: sema isSignaled! !

!ProcessTerminateBug methodsFor: 'tests' stamp: 'StephaneDucasse 3/7/2010 15:39'!
testSchedulerTermination
	"self debug: #testSchedulerTermination"
	
	| process sema gotHere sema2 |
	gotHere := false.
	sema := Semaphore new.
	sema2 := Semaphore new.
	process := [
		sema signal.
		sema2 wait.
		"will be suspended here"
		gotHere := true. "e.g., we must *never* get here" ] forkAt: Processor activeProcess priority.
	sema wait. "until process gets scheduled"
 	process terminate.
	sema2 signal.
	Processor yield. "will give process a chance to continue and
horribly screw up"
	self assert: gotHere not.
! !

!ProcessTest commentStamp: 'GiovanniCorriga 8/30/2009 14:56'!
A ProcessTest holds test cases for generic Process-related behaviour.!
!ProcessTest methodsFor: 'testing' stamp: 'SeanDeNigris 6/1/2012 22:52'!
testNewProcessWith

	| hasBlockRun block return passedArguments receivedArgument1 receivedArgument2 |
	hasBlockRun := false.
	block := [ :a :b |
		receivedArgument1 := a.
		receivedArgument2 := b.
		hasBlockRun := true ].
	passedArguments := #(1 2).
	return := block newProcessWith: passedArguments.
	
	"Returns immediately"
	self deny: hasBlockRun.
	
	self assert: (return isKindOf: Process).
	
	"Process has not been scheduled"
	self assert: return isSuspended.
	
	return resume.
	Processor yield.
	
	"Each element in the collection argument was passed separately to the block"
	self assert: { receivedArgument1. receivedArgument2 } equals: passedArguments.! !

!ProcessTest methodsFor: 'testing' stamp: 'SeanDeNigris 6/1/2012 00:55'!
testForkAtHigherPriority

	| hasBlockRun block return |
	hasBlockRun := false.
	block := [ hasBlockRun := true ].
	return := block forkAt: Processor activeProcess priority + 1.
	
	"Preempts current process"
	self assert: hasBlockRun.! !

!ProcessTest methodsFor: 'testing' stamp: 'MaxLeske 9/23/2014 10:23'!
testIsTerminatingNormalTermination
	| sem process unwound started terminator |
	sem := Semaphore new.
	unwound := false.
	started := false.
	process := [ 
		started := true.
		[ sem wait ] ensure: [
		terminator := Processor activeProcess.
		unwound := true ] 
	] fork.
	self deny: process isSuspended.
	self deny: process isTerminating.
	self deny: process isTerminated.
	self deny: started.
	self deny: unwound.
	
	sem signal.
	self waitForProcessTermination: process.
	"#terminate will be sent by the process itself after its context has finished (see BlockClosure>>newProcess)"
	self assert: process isSuspended.
	self assert: process isTerminating.
	self assert: process isTerminated.
	self assert: started.
	"When inside of an unwind context, that unwind context needs run through."
	self assert: unwound.
	"A process should terminte itself."
	self assert: terminator == process! !

!ProcessTest methodsFor: 'testing' stamp: 'MaxLeske 9/24/2014 11:47'!
testIsTerminatingForcedTermination
	| process unwound started terminator unwindChecks terminationSemaphore |
	unwound := false.
	started := false.
	terminationSemaphore := Semaphore new.
	terminationSemaphore signal.
	process := [ 
		started := true.
		[ terminationSemaphore wait; wait. ] ensure: [
			terminator := Processor activeProcess.
			unwindChecks value.
			unwound := true ] 
	] newProcess.
	process priority: Processor activePriority - 1.
	
	self assert: process isSuspended.
	self deny: process isTerminating.
	self deny: process isTerminated.
	self deny: started.
	self deny: unwound.
	
	process resume.
	[ terminationSemaphore isSignaled ] whileTrue: [ 50 milliSeconds asDelay wait ].
	self deny: process isSuspended.
	self deny: process isTerminating.
	self deny: process isTerminated.
	self assert: started.
	self deny: unwound.
	self deny: terminator == process.
	
	terminationSemaphore signal.
	"This will run the #ensure: block and block on the Semaphore."
	process terminate.
	"We want these checks to run during unwinding, so we need to cheat a bit."
	unwindChecks := [
		self assert: process isSuspended.
		"We're inside of #terminate."
		self assert: process isTerminating.
		"Still unwinding, so not finished."
		self deny: process isTerminated.
		self assert: started.
		"Not unwound yet."
		self deny: unwound.
		self assert: terminator == process ].
	
	[ process isTerminated ] whileFalse: [ 50 milliSeconds asDelay wait ].
	self assert: process isSuspended.
	self assert: process isTerminating.
	self assert: process isTerminated.
	self assert: started.
	self assert: unwound.
	self assert: terminator == process! !

!ProcessTest methodsFor: 'testing' stamp: 'SeanDeNigris 6/1/2012 00:52'!
testSchedulingIsFirstComeFirstServed

	| priorityWaitingLonger priorityWaitingLess |
	priorityWaitingLonger := [ ] fork.
	priorityWaitingLess := [ ] fork.
	
	self assert: Processor nextReadyProcess equals: priorityWaitingLonger.! !

!ProcessTest methodsFor: 'testing' stamp: 'SeanDeNigris 6/1/2012 22:56'!
testYield

	| lowerHasRun lowerPriority same1HasRun same2HasRun |
	lowerHasRun := same1HasRun := same2HasRun := false.
	lowerPriority := Processor activeProcess priority - 10 min: 10.
	[ lowerHasRun := true ] forkAt: lowerPriority.
	[ same1HasRun := true ] fork.
	[ same2HasRun := true ] fork.

	Processor yield.
	
	"All processes of same priority have been given a chance to execute"
	self assert: same1HasRun.
	self assert: same2HasRun.
	self deny: lowerHasRun.! !

!ProcessTest methodsFor: 'testing' stamp: 'SeanDeNigris 6/1/2012 22:48'!
testFork

	| hasBlockRun block return |
	hasBlockRun := false.
	block := [ hasBlockRun := true ].
	return := block fork.
	
	"Returns immediately"
	self deny: hasBlockRun.
	
	"Returns a process - Blue book specifies that it returns the block itself"
	self assert: (return isKindOf: Process).
	
	"Forked process has been scheduled"
	self assert: Processor nextReadyProcess equals: return.! !

!ProcessTest methodsFor: 'helpers' stamp: 'MaxLeske 9/23/2014 10:22'!
waitForProcessTermination: aProcess
	aProcess priority: Processor activePriority + 1.
	[ aProcess isTerminated ] whileFalse: [ Processor yield ]! !

!ProcessTest methodsFor: 'testing' stamp: 'MaxLeske 9/23/2014 10:21'!
testIsTerminatingForcedTerminationWithoutRunning
	| process unwound started terminator |
	unwound := false.
	started := false.
	process := [ 
		started := true.
		[ Semaphore new wait ] ensure: [
			terminator := Processor activeProcess.
			unwound := true ] 
	] newProcess.
	"This will prevent the process from getting a chance to run.
	Effectively the pc of suspendedContext will be equal to startpc."
	process priority: Processor systemBackgroundPriority.
	
	self assert: process isSuspended.
	self deny: process isTerminating.
	self deny: process isTerminated.
	self deny: started.
	self deny: unwound.
	
	process resume.
	self deny: process isSuspended.
	self deny: process isTerminating.
	self deny: process isTerminated.
	self deny: unwound.
	
	process terminate.
	self assert: process isSuspended.
	self assert: process isTerminating.
	self assert: process isTerminated.
	"The process never ran"
	self deny: started.
	"No unwind blocks were ever activated, so the next two lines can't be true."
	self deny: unwound.
	self deny: terminator == process! !

!ProcessTest methodsFor: 'testing' stamp: 'SeanDeNigris 6/1/2012 00:34'!
testNewProcess

	| hasBlockRun block return |
	hasBlockRun := false.
	block := [ hasBlockRun := true ].
	return := block newProcess.
	
	"Returns immediately"
	self deny: hasBlockRun.
	
	"Returns a process - Blue book specifies the block"
	self assert: (return isKindOf: Process).
	
	"Forked process has not been scheduled"
	self assert: return isSuspended.! !

!ProcessTest methodsFor: 'testing' stamp: 'SeanDeNigris 6/1/2012 00:52'!
testHighPriorityOverridesWaitTime

	| lowerPriorityWaitingLonger higherPriorityWaitingLess |
	lowerPriorityWaitingLonger := [ ] forkAt: 10.
	higherPriorityWaitingLess := [ ] forkAt: 12.
	
	self assert: Processor nextReadyProcess equals: higherPriorityWaitingLess.! !

!ProcessTest methodsFor: 'testing' stamp: 'SeanDeNigris 6/1/2012 22:54'!
testTerminateActive

	| lastStatementEvaluated block1HasRun block2HasRun |
	block1HasRun := block2HasRun := lastStatementEvaluated := false.
	[
		block1HasRun := true.
		Processor activeProcess terminate.
		lastStatementEvaluated := true ] fork.
	
	[
		block2HasRun := true.
		Processor terminateActive.
		lastStatementEvaluated := true ] fork.
	
	Processor yield.
	
	"Expressions following terminate are never executed"
	self assert: block1HasRun.
	self assert: block2HasRun.
	self deny: lastStatementEvaluated.! !

!ProcessTest methodsFor: 'testing' stamp: 'NouryBouraqadi 10/1/2009 07:45'!
testIsSelfEvaluating
	self assert: Processor printString = 'Processor'! !

!ProcessorScheduler commentStamp: '<historical>'!
My single instance, named Processor, coordinates the use of the physical processor by all Processes requiring service.!
!ProcessorScheduler methodsFor: 'priority names' stamp: 'ar 7/8/2001 17:02'!
lowestPriority
	"Return the lowest priority that is allowed with the scheduler"
	^SystemRockBottomPriority! !

!ProcessorScheduler methodsFor: 'process state change' stamp: 'tpr 4/28/2004 17:53'!
yield
	"Give other Processes at the current priority a chance to run."

	| semaphore |

	<primitive: 167>
	semaphore := Semaphore new.
	[semaphore signal] fork.
	semaphore wait! !

!ProcessorScheduler methodsFor: 'priority names' stamp: ''!
systemBackgroundPriority
	"Answer the priority at which system background processes should run. 
	Examples are an incremental garbage collector or status checker."

	^SystemBackgroundPriority! !

!ProcessorScheduler methodsFor: 'priority names' stamp: ''!
timingPriority
	"Answer the priority at which the system processes keeping track of real 
	time should run."

	^TimingPriority! !

!ProcessorScheduler methodsFor: 'accessing' stamp: 'ar 8/22/2001 17:33'!
preemptedProcess
	"Return the process that the currently active process just preempted."
	| list |
	activeProcess priority to: 1 by: -1 do:[:priority|
		list := quiescentProcessLists at: priority.
		list isEmpty ifFalse:[^list last].
	].
	^nil

	"Processor preemptedProcess"! !

!ProcessorScheduler methodsFor: 'CPU usage tally' stamp: 'nk 3/17/2001 10:06'!
tallyCPUUsageFor: seconds every: msec
	"Start a high-priority process that will tally the next ready process for the given
	number of seconds. Answer a Block that will return the tally (a Bag) after the task
	is complete" 
	| tally sem delay endDelay |
	tally := IdentityBag new: 200.
	delay := Delay forMilliseconds: msec truncated.
	endDelay := Delay forSeconds: seconds.
	endDelay schedule.
	sem := Semaphore new.
	[
		[ endDelay isExpired ] whileFalse: [
			delay wait.
			tally add: Processor nextReadyProcess
		].
		sem signal.
	] forkAt: self highestPriority.

	^[ sem wait. tally ]! !

!ProcessorScheduler methodsFor: 'priority names' stamp: ''!
userInterruptPriority
	"Answer the priority at which user processes desiring immediate service 
	should run. Processes run at this level will preempt the window 
	scheduler and should, therefore, not consume the processor forever."

	^UserInterruptPriority! !

!ProcessorScheduler methodsFor: 'priority names' stamp: ''!
userSchedulingPriority
	"Answer the priority at which the window scheduler should run."

	^UserSchedulingPriority! !

!ProcessorScheduler methodsFor: 'accessing' stamp: 'ar 7/8/2001 16:21'!
waitingProcessesAt: aPriority
	"Return the list of processes at the given priority level."
	^quiescentProcessLists at: aPriority! !

!ProcessorScheduler methodsFor: 'CPU usage tally' stamp: 'nk 3/8/2001 12:56'!
nextReadyProcess
	quiescentProcessLists reverseDo: [ :list |
		list isEmpty ifFalse: [ | proc |
			proc := list first.
			proc suspendedContext ifNotNil: [ ^proc ]]].
	^nil! !

!ProcessorScheduler methodsFor: 'accessing' stamp: ''!
highestPriority
	"Answer the number of priority levels currently available for use."

	^quiescentProcessLists size! !

!ProcessorScheduler methodsFor: 'printing' stamp: 'NouryBouraqadi 10/1/2009 07:48'!
printOn: aStream
	self isSelfEvaluating ifFalse: [^super printOn: aStream].
	aStream nextPutAll: #Processor! !

!ProcessorScheduler methodsFor: 'process state change' stamp: 'eem 4/9/2010 14:38'!
terminateActive
	"Terminate the process that is currently running."

	activeProcess effectiveProcess terminate! !

!ProcessorScheduler methodsFor: 'accessing' stamp: 'nk 10/27/2000 16:27'!
backgroundProcess
	"Answer the background process"
	^ BackgroundProcess! !

!ProcessorScheduler methodsFor: 'accessing' stamp: 'IgorStasenko 2/6/2012 13:18'!
scanSchedule: aBlock startingAt: topPriority
	"Iterate over scheduled processes  list, starting from topPriority down to lowest one. "

	topPriority to: 1 by: -1 do:[:priority | | list |
		list := quiescentProcessLists at: priority.
		list do: [:proc | 
			aBlock value: proc
		].
	].
! !

!ProcessorScheduler methodsFor: 'accessing' stamp: 'MarcusDenker 7/23/2014 22:29'!
highestPriority: newHighestPriority
	"Change the number of priority levels currently available for use."

	| newProcessLists |
	(quiescentProcessLists size > newHighestPriority
		and: [self anyProcessesAbove: newHighestPriority])
			ifTrue: [self error: 'There are processes with priority higher than '
													,newHighestPriority printString].
	newProcessLists := Array new: newHighestPriority.
	1 to: ((quiescentProcessLists size) min: (newProcessLists size)) do: 
		[:priority | newProcessLists at: priority put: (quiescentProcessLists at: priority)].
	quiescentProcessLists size to: newProcessLists size do: 
		[:priority | newProcessLists at: priority put: LinkedList new].
	quiescentProcessLists := newProcessLists! !

!ProcessorScheduler methodsFor: 'priority names' stamp: ''!
userBackgroundPriority
	"Answer the priority at which user background processes should run."

	^UserBackgroundPriority! !

!ProcessorScheduler methodsFor: 'removing' stamp: ''!
remove: aProcess ifAbsent: aBlock 
	"Remove aProcess from the list on which it is waiting for the processor 
	and answer aProcess. If it is not waiting, evaluate aBlock."

	(quiescentProcessLists at: aProcess priority)
		remove: aProcess ifAbsent: aBlock.
	^aProcess! !

!ProcessorScheduler methodsFor: 'CPU usage tally' stamp: 'nk 3/8/2001 12:48'!
tallyCPUUsageFor: seconds
	"Start a high-priority process that will tally the next ready process for the given
	number of seconds. Answer a Block that will return the tally (a Bag) after the task
	is complete" 
	^self tallyCPUUsageFor: seconds every: 10
! !

!ProcessorScheduler methodsFor: 'priority names' stamp: ''!
lowIOPriority
	"Answer the priority at which most input/output processes should run. 
	Examples are the process handling input from the user (keyboard, 
	pointing device, etc.) and the process distributing input from a network."

	^LowIOPriority! !

!ProcessorScheduler methodsFor: 'process state change' stamp: ''!
suspendFirstAt: aPriority ifNone: noneBlock 
	"Suspend the first Process that is waiting to run with priority aPriority. If 
	no Process is waiting, evaluate the argument, noneBlock."

	| aList |
	aList := quiescentProcessLists at: aPriority.
	aList isEmpty
		ifTrue: [^noneBlock value]
		ifFalse: [^aList first suspend]! !

!ProcessorScheduler methodsFor: 'priority names' stamp: ''!
highIOPriority
	"Answer the priority at which the most time critical input/output 
	processes should run. An example is the process handling input from a 
	network."

	^HighIOPriority! !

!ProcessorScheduler methodsFor: 'accessing' stamp: 'eem 9/7/2009 11:05'!
activeProcess
	"Answer the currently running Process."

	^activeProcess effectiveProcess! !

!ProcessorScheduler methodsFor: 'self evaluating' stamp: 'NouryBouraqadi 10/1/2009 07:47'!
isSelfEvaluating
	^self == Processor! !

!ProcessorScheduler methodsFor: 'process state change' stamp: ''!
suspendFirstAt: aPriority 
	"Suspend the first Process that is waiting to run with priority aPriority."

	^self suspendFirstAt: aPriority
		  ifNone: [self error: 'No Process to suspend']! !

!ProcessorScheduler methodsFor: 'accessing' stamp: 'eem 4/9/2010 14:43'!
activePriority
	"Answer the priority level of the currently running Process."

	^activeProcess effectiveProcess priority! !

!ProcessorScheduler methodsFor: 'private' stamp: 'tk 6/24/1999 11:27'!
anyProcessesAbove: highestPriority 
	"Do any instances of Process exist with higher priorities?"

	^(Process allInstances "allSubInstances" select: [:aProcess | 
		aProcess priority > highestPriority]) isEmpty
		"If anyone ever makes a subclass of Process, be sure to use allSubInstances."! !

!ProcessorScheduler class methodsFor: 'background process' stamp: 'jm 9/11/97 10:44'!
idleProcess
	"A default background process which is invisible."

	[true] whileTrue:
		[self relinquishProcessorForMicroseconds: 1000]! !

!ProcessorScheduler class methodsFor: 'class initialization' stamp: 'ar 7/8/2001 16:39'!
initialize
     
	SystemRockBottomPriority := 10.
	SystemBackgroundPriority := 20.
	UserBackgroundPriority := 30.
	UserSchedulingPriority := 40.
	UserInterruptPriority := 50.
	LowIOPriority := 60.
	HighIOPriority := 70.
	TimingPriority := 80.

	"ProcessorScheduler initialize."! !

!ProcessorScheduler class methodsFor: 'instance creation' stamp: ''!
new
	"New instances of ProcessorScheduler should not be created."

	self error:
'New ProcessSchedulers should not be created since
the integrity of the system depends on a unique scheduler'! !

!ProcessorScheduler class methodsFor: 'background process' stamp: 'ClementBera 9/27/2013 17:53'!
startUp
	"Install a background process of the lowest possible priority that is always runnable."
	"Details: The virtual machine requires that there is aways some runnable process that can be scheduled; this background process ensures that this is the case."

	Smalltalk installLowSpaceWatcher.
	BackgroundProcess ifNotNil: [BackgroundProcess terminate].
	BackgroundProcess := [self idleProcess] newProcess.
	BackgroundProcess priority: SystemRockBottomPriority.
	BackgroundProcess name: 'Idle Process'.
	BackgroundProcess resume.
! !

!ProcessorScheduler class methodsFor: 'background process' stamp: 'VeronicaUquillas 6/11/2010 12:57'!
relinquishProcessorForMicroseconds: anInteger
	"Platform specific. This primitive is used to return processor cycles to the host operating system when Pharo's idle process is running (i.e., when no other Pharo process is runnable). On some platforms, this primitive causes the entire Pharo application to sleep for approximately the given number of microseconds. No Pharo process can run while the Pharo application is sleeping, even if some external event makes it runnable. On the Macintosh, this primitive simply calls GetNextEvent() to give other applications a chance to run. On platforms without a host operating system, it does nothing. This primitive should not be used to add pauses to a Pharo process; use a Delay instead."

	<primitive: 230>
	"don't fail if primitive is not implemented, just do nothing"
! !

!ProfStef commentStamp: 'CamilloBruni 2/22/2014 19:01'!
I am here for backwards compatibility.
PharoTutorial was called ProfStef before.!
!ProgressBarMorph commentStamp: '<historical>'!
Instances of this morph get used by SystemProgressMorph or a JobProgressBar to display a bar (i.e., the rectangular part of a progress bar).

Here is an example of how to use it. 

| p |
p := ProgressBarMorph from: 0 to: 200.
p extent: 200@20.
p openInWorld.

[
	(1 to: 200) do: [ :i | p value: i.  (Delay forMilliseconds: 10) wait ].
	p delete ] fork


| p |
p := ProgressBarMorph from: 0 to: 200.
p extent: 600@7.
p openInWorld.

[
	(1 to: 200) do: [ :i | p value: i.  (Delay forMilliseconds: 5) wait ].
	p delete ] fork!
!ProgressBarMorph methodsFor: 't-rotating' stamp: ''!
forwardDirection: newDirection
	"Set the receiver's forward direction (in eToy terms)"
	self setProperty: #forwardDirection toValue: newDirection.! !

!ProgressBarMorph methodsFor: 'geometry' stamp: 'FernandoOlivero 4/12/2011 10:31'!
extent: aPoint
	"Update the bar fillStyle if appropriate."
	
	super extent: aPoint.
	self fillStyle isOrientedFill ifTrue: [
		self fillStyle: (self theme progressBarFillStyleFor: self)].
	self barFillStyle isOrientedFill ifTrue: [
		self barFillStyle: ( self theme progressBarProgressFillStyleFor: self)]! !

!ProgressBarMorph methodsFor: 'accessing' stamp: 'SeanDeNigris 5/14/2012 19:50'!
decrement

	self value: self value - 1.! !

!ProgressBarMorph methodsFor: 'drawing' stamp: 'ThierryGoubier 3/10/2015 07:05'!
drawOn: aCanvas
	"Draw the receiver with the fill style for the bar, clipping to the inner bounds."

	| area |
	area := self innerBounds.
	aCanvas fillRectangle: area fillStyle: self fillStyle.
	value > 0
		ifTrue: [ 
			cachedWidth := self completedWidth.
			area := area origin extent: cachedWidth @ area height.
			aCanvas fillRectangle: area fillStyle: self barFillStyle ].
	self borderStyle frameRectangle: self bounds on: aCanvas! !

!ProgressBarMorph methodsFor: 'private' stamp: 'SeanDeNigris 5/14/2012 20:13'!
completedWidth

	| range fraction progress |
	range := end - start.
	progress := value - start.
	fraction := progress / range.
	^ (fraction * self totalBarWidth) truncated.! !

!ProgressBarMorph methodsFor: 'private' stamp: 'gvc 4/23/2007 17:04'!
privateMoveBy: delta 
	"Update the bar fillStyle if appropriate."
	
	| fill |
	super privateMoveBy: delta.
	fill := self barFillStyle.
	fill isOrientedFill ifTrue: [fill origin: fill origin + delta]! !

!ProgressBarMorph methodsFor: 'private' stamp: 'SeanDeNigris 5/14/2012 15:36'!
endAt: aNumber 

	end := aNumber.! !

!ProgressBarMorph methodsFor: 't-rotating' stamp: ''!
heading
	"Return the receiver's heading"
	^ self owner 
		ifNil: [self forwardDirection]
		ifNotNil: [self forwardDirection + self owner degreesOfFlex]! !

!ProgressBarMorph methodsFor: 'private' stamp: 'SeanDeNigris 5/14/2012 20:01'!
startAt: aNumber 

	value := start := aNumber.! !

!ProgressBarMorph methodsFor: 't-rotating' stamp: ''!
forwardDirection
	"Return the receiver's forward direction (in eToy terms)"
	^self valueOfProperty: #forwardDirection ifAbsent:[0.0]! !

!ProgressBarMorph methodsFor: 'accessing' stamp: 'SeanDeNigris 5/14/2012 19:50'!
increment

	self value: self value + 1.! !

!ProgressBarMorph methodsFor: 'initialization' stamp: 'StephanEggermont 9/3/2013 16:07'!
initialize
	"Initialize the receiver from the current theme."
	
	super initialize.
	value := 0.
	start := 0.
	end := 100.
	height := DefaultHeight.
	width := DefaultWidth.
	cachedWidth := 0.
	self 
		fillStyle: (self theme progressBarFillStyleFor: self);
		borderStyle: (self theme progressBarBorderStyleFor: self);
		barFillStyle: (self theme progressBarProgressFillStyleFor: self);
		extent: width@height  + (2 * self borderWidth).! !

!ProgressBarMorph methodsFor: 'accessing' stamp: 'StephanEggermont 9/3/2013 16:07'!
value: aNumber
	|testWidth|
	value := aNumber.
	testWidth := self completedWidth.
	testWidth ~= cachedWidth ifTrue: [  
		cachedWidth := testWidth.
		self changed]! !

!ProgressBarMorph methodsFor: 'accessing' stamp: 'SeanDeNigris 5/14/2012 19:47'!
value
	
	^ value.! !

!ProgressBarMorph methodsFor: 'private' stamp: 'gvc 4/23/2007 17:04'!
barFillStyle: aFillStyle
	"Set the fillStyle for the bar."

	^self setProperty: #barFillStyle toValue: aFillStyle! !

!ProgressBarMorph methodsFor: 'private' stamp: 'SeanDeNigris 5/14/2012 19:41'!
totalBarWidth

	^ self width - (2 * self borderWidth).! !

!ProgressBarMorph methodsFor: 'private' stamp: 'CamilloBruni 9/1/2012 20:05'!
barFillStyle
	"Answer the fillStyle for the bar if present or
	the theme menuTitleColor otherwise."

	^ self 
		valueOfProperty: #barFillStyle 
		ifAbsent: [ self theme menuTitleColor ]! !

!ProgressBarMorph methodsFor: 't-rotating' stamp: ''!
setDirectionFrom: aPoint
	| delta degrees |
	delta := (self transformFromWorld globalPointToLocal: aPoint) - self referencePosition.
	degrees := delta degrees + 90.0.
	self forwardDirection: (degrees \\ 360) rounded.
! !

!ProgressBarMorph methodsFor: 't-rotating' stamp: ''!
rotationDegrees: degrees	
	"redefined in all morphs which are using myself"! !

!ProgressBarMorph methodsFor: 't-rotating' stamp: ''!
prepareForRotating
	"If I require a flex shell to rotate,
	then wrap it in one and return it.
	Polygons, eg, may override to do nothing."

	^ self addFlexShell! !

!ProgressBarMorph methodsFor: 't-rotating' stamp: ''!
rotationDegrees
	"Default implementation."

	^ 0.0
! !

!ProgressBarMorph class methodsFor: 'initialization' stamp: 'Sd 11/30/2012 20:16'!
defaultHeight: aNumber

	DefaultHeight := aNumber! !

!ProgressBarMorph class methodsFor: 'instance-creation' stamp: 'SeanDeNigris 5/14/2012 15:18'!
from: startNumber to: endNumber

	^ self new
		startAt: startNumber;
		endAt: endNumber.! !

!ProgressBarMorph class methodsFor: 'initialization' stamp: 'Sd 11/30/2012 21:59'!
initialize
	"ProgressBarMorph initialize"
	
	self defaultWidth: 120.
	self defaultHeight: 10.! !

!ProgressBarMorph class methodsFor: 'initialization' stamp: 'Sd 11/30/2012 20:15'!
defaultWidth: aNumber
	
	DefaultWidth := aNumber.
! !

!ProgressNotification commentStamp: '<historical>'!
Used to signal progress without requiring a specific receiver to notify. Caller/callee convention could be to simply count the number of signals caught or to pass more substantive information with #signal:.!
!ProgressNotification methodsFor: 'accessing' stamp: 'ar 3/2/2001 20:12'!
extraParam
	^extra! !

!ProgressNotification methodsFor: 'accessing' stamp: 'ar 3/2/2001 20:12'!
extraParam: anObject
	extra := anObject! !

!ProgressNotification methodsFor: 'accessing' stamp: 'ar 3/2/2001 20:11'!
done
	^done! !

!ProgressNotification methodsFor: 'accessing' stamp: 'ar 3/2/2001 20:11'!
amount
	^amount! !

!ProgressNotification methodsFor: 'accessing' stamp: 'ar 3/2/2001 20:12'!
amount: aNumber
	amount := aNumber! !

!ProgressNotification methodsFor: 'accessing' stamp: 'ar 3/2/2001 20:12'!
done: aNumber
	done := aNumber! !

!ProgressNotification class methodsFor: 'exceptioninstantiator' stamp: 'ajh 1/22/2003 23:51'!
signal: signalerText extra: extraParam
	"TFEI - Signal the occurrence of an exceptional condition with a specified textual description."

	| ex |
	ex := self new.
	ex extraParam: extraParam.
	^ex signal: signalerText! !

!PropertySlot commentStamp: 'MarcusDenker 2/7/2015 11:32'!
I am a Slot that does not allocate one field for each slot. Instead, all PropertySlots of the whole hierarchy are allocated in a dictionary that is stored in an invisible slot (see PropertyBaseSlot)

Keep in mind:
- I am slower than instance variables
- there is the overhead of the Dictionary. Only if there are multiple ones of me in the class hierarchy you will save memory!
!PropertySlot methodsFor: 'code generation' stamp: 'MarcusDenker 2/26/2015 17:27'!
emitStore: methodBuilder
	| tempName |

	tempName := Object new.
	methodBuilder
		addTemp: tempName;
		storeTemp: tempName;
		popTop;
		pushInstVar: baseSlot index;
		pushLiteral: self name;
		pushTemp: tempName;
		send: #at:put:
	! !

!PropertySlot methodsFor: 'code generation' stamp: 'MarcusDenker 2/26/2015 17:23'!
emitValue: methodBuilder

		methodBuilder
			pushInstVar: baseSlot index;
			pushLiteral: self name;
			pushLiteral: nil;
			send: #at:ifAbsent:
	
	! !

!PropertySlot methodsFor: 'meta-object-protocol' stamp: 'MarcusDenker 2/8/2015 19:52'!
write: aValue to: anObject
	^ (baseSlot read: anObject) at: self name put: aValue! !

!PropertySlot methodsFor: 'class building' stamp: 'MarcusDenker 4/1/2015 11:01'!
layoutChanged: aClass
	super layoutChanged: aClass.
	"we check on the slot level as the slot is hidden"
	(aClass layout hasSlotNamed: baseSlot name) ifTrue: [
		baseSlot := aClass layout slotNamed: baseSlot name. "make sure we all use the same baseSlot"
		^self. ].
	"here we need to be more clever: if a subclass defines it, 
	move the difiniton here"
	self flag: #TBD.
	aClass addSlot: (baseSlot := #'_propertyBaseSlot' => BaseSlot default: Dictionary new).
	! !

!PropertySlot methodsFor: 'meta-object-protocol' stamp: 'MarcusDenker 2/8/2015 19:52'!
read: anObject
	^ (baseSlot read: anObject) at: self name ifAbsent: nil! !

!PropertySlotTest methodsFor: 'tests' stamp: 'MarcusDenker 4/1/2015 11:00'!
testRemovePropertySlot
	
	| propertySlot |
	
	propertySlot := #prop => PropertySlot.
	
	aClass := self make: [ :builder |
		builder 
			slots: {propertySlot}
		].

	self assert: (aClass hasSlot: propertySlot).
	self assert: (aClass layout hasSlot: (propertySlot instVarNamed: 'baseSlot')).
	
	aClass := self make: [ :builder |
		builder 
			slots: {}
		].
	self deny: (aClass hasSlot: propertySlot).	
	self deny: (aClass layout hasSlot: (propertySlot instVarNamed: 'baseSlot')).
	self deny: (aClass layout hasSlotNamed: #'_propertyBaseSlot').! !

!PropertySlotTest methodsFor: 'tests' stamp: 'MarcusDenker 3/12/2015 10:12'!
testCreateClassWithTwoPropertySlots
	"Add instance variables using the builder interface"
	
	| propertySlot1 propertySlot2 |
	
	propertySlot1 := #prop1 => PropertySlot.
	propertySlot2 := #prop2 => PropertySlot.
	
	aClass := self make: [ :builder |
		builder 
			slots: {propertySlot1 . propertySlot2 }
		].

	self assert: (aClass hasSlot: propertySlot1).
	self assert: (aClass layout hasSlot: (propertySlot1 instVarNamed: 'baseSlot')).
	
	self assert: (aClass hasSlot: propertySlot2).
	self assert: (aClass layout  hasSlot: (propertySlot2 instVarNamed: 'baseSlot'))
	
	
	! !

!PropertySlotTest methodsFor: 'tests' stamp: 'MarcusDenker 3/23/2015 18:28'!
testCreateClassWithPropertySlotAddSecond
	"Add instance variables using the builder interface"
	
	| propertySlot1 propertySlot2|
	
	propertySlot1 := #prop1 => PropertySlot.
	propertySlot2 := #prop2 => PropertySlot.
	
	aClass := self make: [ :builder |
		builder 
			slots: {propertySlot1}
		].

	self assert: (aClass hasSlot: propertySlot1).
	self assert: (aClass layout hasSlot: (propertySlot1 instVarNamed: 'baseSlot')).
	
	aClass := self make: [ :builder |
		builder 
			slots: {propertySlot1. propertySlot2}
		].
	
	self assert: (aClass hasSlot: propertySlot1).
	self assert: (aClass layout hasSlot: (propertySlot2 instVarNamed: 'baseSlot')).
	
	self assert:  (propertySlot1 instVarNamed: 'baseSlot') == (propertySlot2 instVarNamed: 'baseSlot').
	
	self assert: (aClass hasSlot: propertySlot2).
	self assert: (aClass layout hasSlot: (propertySlot2 instVarNamed: 'baseSlot')).
! !

!PropertySlotTest methodsFor: 'tests' stamp: 'MarcusDenker 4/1/2015 11:00'!
testRemovePropertySlot2
	"add two property slots, remove one"
	
	| propertySlot1 propertySlot2 |
	
	propertySlot1 := #prop1 => PropertySlot.
	propertySlot2 := #prop2 => PropertySlot.
	
	aClass := self make: [ :builder |
		builder 
			slots: {propertySlot1 . propertySlot2 }
		].

	self assert: (aClass hasSlot: propertySlot1).
	self assert: (aClass layout hasSlot: (propertySlot1 instVarNamed: 'baseSlot')).
	
	self assert: (aClass hasSlot: propertySlot2).
	self assert: (aClass layout  hasSlot: (propertySlot2 instVarNamed: 'baseSlot')).
	
	aClass := self make: [ :builder |
		builder 
			slots: {propertySlot1}
		].
	
	self assert:	(aClass hasSlot: propertySlot1).
	self deny: 	(aClass hasSlot: propertySlot2).
	self assert:	(aClass layout hasSlotNamed:  #'_propertyBaseSlot'). 
		
	aClass := self make: [ :builder |
		builder 
			slots: {}
		].
	
	self deny:	(aClass hasSlot: propertySlot1).
	self deny: 	(aClass hasSlot: propertySlot2).
	self deny:	(aClass layout hasSlotNamed:  #'_propertyBaseSlot'). ! !

!PropertySlotTest methodsFor: 'tests' stamp: 'MarcusDenker 3/12/2015 10:12'!
testCreateClassWithPropertySlot
	"Add instance variables using the builder interface"
	
	| propertySlot |
	
	propertySlot := #prop => PropertySlot.
	
	aClass := self make: [ :builder |
		builder 
			slots: {propertySlot}
		].

	self assert: (aClass hasSlot: propertySlot).
	self assert: (aClass layout hasSlot: (propertySlot instVarNamed: 'baseSlot'))
	
! !

!ProportionalLayout commentStamp: '<historical>'!
I represent a layout that places all children of some morph in their given LayoutFrame.!
!ProportionalLayout methodsFor: 'layout' stamp: 'nice 1/5/2010 15:59'!
minExtentOf: aMorph in: newBounds
	"Return the minimal size aMorph's children would require given the new bounds"
	| min |
	min := 0@0.
	aMorph submorphsDo:[:m| | extent frame |
		"Map the minimal size of the child through the layout frame.
		Note: This is done here and not in the child because its specific
		for proportional layouts. Perhaps we'll generalize this for table
		layouts but I'm not sure how and when."
		extent := m minExtent.
		frame := m layoutFrame.
		frame ifNotNil:[extent := frame minExtentFrom: extent].
		min := min max: extent].
	^min! !

!ProportionalLayout methodsFor: 'testing' stamp: 'ar 10/29/2000 01:29'!
isProportionalLayout
	^true! !

!ProportionalLayout methodsFor: 'layout' stamp: 'ar 10/29/2000 01:24'!
layout: aMorph in: newBounds
	"Compute the layout for the given morph based on the new bounds"
	aMorph submorphsDo:[:m| m layoutProportionallyIn: newBounds].! !

!ProportionalSplitterMorph commentStamp: 'jmv 1/29/2006 17:16'!
I am the morph the user grabs to adjust pane splitters.!
!ProportionalSplitterMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 6/14/2007 13:32'!
overlapsVertical: aSplitter
	"Answer whether the receiver overlaps the given spiltter
	in the vertical plane."

	^aSplitter top <= self bottom and: [aSplitter bottom >= self top]! !

!ProportionalSplitterMorph methodsFor: 'accessing' stamp: 'jrp 8/6/2005 23:59'!
handleSize

	^ self class splitterWidth @ 30! !

!ProportionalSplitterMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 9/19/2008 15:31'!
mouseUp: anEvent
	"Change the cursor back to normal if necessary and change the color back to normal."
	
	(self bounds containsPoint: anEvent cursorPoint)
		ifFalse: [anEvent hand showTemporaryCursor: nil].
	self class fastSplitterResize
		ifTrue: [self updateFromEvent: anEvent].
	traceMorph ifNotNil: [traceMorph delete. traceMorph := nil].
	self adoptPaneColor: self paneColor.
	self triggerEvent: #mouseUp! !

!ProportionalSplitterMorph methodsFor: 'event handling' stamp: 'nice 1/5/2010 15:59'!
updateFromEvent: anEvent
	"Update the splitter and attached morph positions from the mouse event.
	Take into account the mouse down offset."
	
	| pNew pOld delta selfTop selfBottom selfLeft selfRight|
	pNew := anEvent cursorPoint - lastMouse second.
	pOld := lastMouse first - lastMouse second.
	delta := splitsTopAndBottom
		ifTrue: [0 @ ((self normalizedY: pNew y) - pOld y)]
		ifFalse: [(self normalizedX: pNew x) - pOld x @ 0].
	lastMouse at: 1 put: (splitsTopAndBottom
		ifTrue: [pNew x @ (self normalizedY: pNew y) + lastMouse second]
		ifFalse: [(self normalizedX: pNew x) @ pNew y + lastMouse second]).
	leftOrTop do: [:each | | firstRight firstBottom | 
		firstRight := each layoutFrame rightOffset
					ifNil: [0].
		firstBottom := each layoutFrame bottomOffset
					ifNil: [0].
		each layoutFrame rightOffset: firstRight + delta x.
		each layoutFrame bottomOffset: firstBottom + delta y.
		(each layoutFrame leftFraction = each layoutFrame rightFraction and: [
				each layoutFrame leftFraction ~= 0]) "manual splitter"
			ifTrue: [each layoutFrame leftOffset: (each layoutFrame leftOffset ifNil: [0]) + delta x].
		(each layoutFrame topFraction = each layoutFrame bottomFraction and: [
				each layoutFrame topFraction ~= 0]) "manual splitter"
			ifTrue: [each layoutFrame topOffset: (each layoutFrame topOffset ifNil: [0]) + delta y]].
	rightOrBottom do: [:each | | secondLeft secondTop | 
		secondLeft := each layoutFrame leftOffset
					ifNil: [0].
		secondTop := each layoutFrame topOffset
					ifNil: [0].
		each layoutFrame leftOffset: secondLeft + delta x.
		each layoutFrame topOffset: secondTop + delta y.
		(each layoutFrame leftFraction = each layoutFrame rightFraction and: [
				each layoutFrame rightFraction ~= 1]) "manual splitter"
			ifTrue: [each layoutFrame rightOffset: (each layoutFrame rightOffset ifNil: [0]) + delta x].
		(each layoutFrame topFraction = each layoutFrame bottomFraction and: [
				each layoutFrame bottomFraction ~= 1]) "manual splitter"
			ifTrue: [each layoutFrame bottomOffset: (each layoutFrame bottomOffset ifNil: [0]) + delta y]].
	selfTop := self layoutFrame topOffset ifNil: [0].
	selfBottom := self layoutFrame bottomOffset ifNil: [0].
	selfLeft := self layoutFrame leftOffset ifNil: [0].
	selfRight := self layoutFrame rightOffset ifNil: [0].
	self layoutFrame topOffset: selfTop + delta y.
	self layoutFrame bottomOffset: selfBottom + delta y.
	self layoutFrame leftOffset: selfLeft + delta x.
	self layoutFrame rightOffset: selfRight + delta x.
	self owner layoutChanged! !

!ProportionalSplitterMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 5/13/2008 10:32'!
shouldDraw
	"Answer whether the resizer should be drawn."
	
	^super shouldDraw or: [self class showSplitterHandles]! !

!ProportionalSplitterMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 6/14/2007 13:32'!
overlapsHorizontal: aSplitter
	"Answer whether the receiver overlaps the given spiltter
	in the horizontal plane."

	^aSplitter left <= self right and: [aSplitter right >= self left]! !

!ProportionalSplitterMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 5/9/2007 10:46'!
hasRightOrBottom: aMorph
	"Answer whether the reciver has the given morph
	as one of of its right or bottom morphs."

	^rightOrBottom includes: aMorph! !

!ProportionalSplitterMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 5/13/2008 10:36'!
shouldInvalidateOnMouseTransition
	"Answer whether the resizer should be invalidated
	when the mouse enters or leaves."
	
	^self class showSplitterHandles! !

!ProportionalSplitterMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/26/2007 10:22'!
adoptPaneColor: paneColor
	"Change our color too."
	
	super adoptPaneColor: paneColor.
	self fillStyle: self normalFillStyle! !

!ProportionalSplitterMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 7/30/2007 15:55'!
normalFillStyle
	"Return the normal fillStyle of the receiver."
	
	^self theme splitterNormalFillStyleFor: self! !

!ProportionalSplitterMorph methodsFor: 'operations' stamp: 'bvs 3/24/2004 16:39'!
beSplitsTopAndBottom

	splitsTopAndBottom := true.
	! !

!ProportionalSplitterMorph methodsFor: 'accessing' stamp: 'apl 7/8/2005 13:38'!
getOldColor
	^ oldColor ifNil: [Color transparent]! !

!ProportionalSplitterMorph methodsFor: 'initialization' stamp: 'jrp 7/5/2005 21:46'!
initialize

	super initialize.
	
	self hResizing: #spaceFill.
	self vResizing: #spaceFill.
	splitsTopAndBottom := false.
	
	leftOrTop := OrderedCollection new.
	rightOrBottom := OrderedCollection new! !

!ProportionalSplitterMorph methodsFor: 'testing' stamp: 'jrp 7/9/2005 17:44'!
isCursorOverHandle
	^ self class showSplitterHandles not or: [self handleRect containsPoint: ActiveHand cursorPoint]! !

!ProportionalSplitterMorph methodsFor: 'accessing' stamp: 'MarcusDenker 12/11/2009 09:58'!
leftBoundary
	"Answer the left boundary position by calculating the minimum
	of the minimum widths of the left morphs."
	
	|morphs|
	morphs := leftOrTop reject: [:m |
		m layoutFrame leftFraction ~= 0 and: [
			m layoutFrame leftFraction = m layoutFrame rightFraction]].
	morphs ifEmpty: [
		^(self splitterLeft
			ifNil: [self containingWindow panelRect left]
			ifNotNil: [:s | s left]) + 25].
	^(morphs collect: [:m |
		m left + m minExtent x +
			(self layoutFrame leftOffset ifNil: [0]) -
			(m layoutFrame rightOffset ifNil: [0])]) max! !

!ProportionalSplitterMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/31/2012 18:42'!
topBoundary
	"Answer the top boundary position by calculating the minimum
	of the minimum heights of the top morphs."
	
	|morphs|
	morphs := leftOrTop reject: [:m |
		m layoutFrame topFraction ~= 0 and: [
			m layoutFrame topFraction = m layoutFrame bottomFraction]].
	morphs ifEmpty: [
		^(self splitterAbove
			ifNil: [self containingWindow panelRect top]
			ifNotNil: [:s | s first top]) + 25].
	^(morphs collect: [:m |
		m top + m minExtent y +
			(self layoutFrame topOffset ifNil: [0]) -
			(m layoutFrame bottomOffset ifNil: [0])]) max! !

!ProportionalSplitterMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 5/9/2007 10:46'!
hideRightOrBottom
	"Hide the receiver and all right or bottom morphs."

	self hide.
	rightOrBottom do: [:m | m hide]! !

!ProportionalSplitterMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 5/9/2007 10:40'!
hideLeftOrTop
	"Hide the receiver and all left or top morphs."

	self hide.
	leftOrTop do: [:m | m hide]! !

!ProportionalSplitterMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/31/2012 18:42'!
bottomBoundary
	"Answer the bottom boundary position by calculating the minimum
	of the minimum heights of the bottom morphs."
	
	|morphs|
	morphs := rightOrBottom reject: [:m |
		m layoutFrame bottomFraction ~= 1 and: [
			m layoutFrame topFraction = m layoutFrame bottomFraction]].
	morphs ifEmpty: [
		^(self splitterBelow
			ifNil: [self containingWindow panelRect bottom]
			ifNotNil: [self splitterBelow first top]) - 25].
	^(morphs collect: [:m |
		m bottom - m minExtent y -
			(m layoutFrame topOffset ifNil: [0]) +
			(self layoutFrame bottomOffset ifNil: [0])]) min - self class splitterWidth! !

!ProportionalSplitterMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/31/2012 18:42'!
splitterLeft
	"Answer the splitter to the left of the receiver that overlaps in its vertical range."
	
	|splitters|
	splitters := ((self siblingSplitters select: [:each |
		each left < self left and: [self overlapsVertical: each]]) asSortedCollection: [:a :b | a left > b left]).
	
	^ splitters
		ifEmpty: [ nil ]
		ifNotEmpty: [:s | s first ]! !

!ProportionalSplitterMorph methodsFor: '*Polymorph-Widgets' stamp: 'AlainPlantec 7/9/2013 12:41'!
noteNewOwner: o
	"Update the fill style."
	
	super noteNewOwner: o.
	self defer: [self adoptPaneColor: self paneColor]! !

!ProportionalSplitterMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 5/9/2007 10:40'!
showLeftOrTop
	"Show the receiver and all left or top morphs."

	self show.
	leftOrTop do: [:m | m show]! !

!ProportionalSplitterMorph methodsFor: 'event handling' stamp: 'jrp 3/21/2006 23:11'!
mouseMove: anEvent 
	anEvent hand temporaryCursor
		ifNil: [^ self].
	self class fastSplitterResize
		ifFalse:  [self updateFromEvent: anEvent]
		ifTrue: [traceMorph
				ifNil: [traceMorph := Morph newBounds: self bounds.
					traceMorph borderColor: Color lightGray.
					traceMorph borderWidth: 1.
					self owner addMorph: traceMorph].
			splitsTopAndBottom
				ifTrue: [traceMorph position: traceMorph position x @ (self normalizedY: anEvent cursorPoint y)]
				ifFalse: [traceMorph position: (self normalizedX: anEvent cursorPoint x) @ traceMorph position y]]! !

!ProportionalSplitterMorph methodsFor: 'drawing' stamp: 'gvc 1/20/2009 11:47'!
drawOn: aCanvas 

	| dotBounds size alphaCanvas dotSize |
	self shouldDraw ifFalse: [^self].
	super drawOn: aCanvas.
	self class showSplitterHandles ifTrue: [
	size := self splitsTopAndBottom
				ifTrue: [self handleSize transposed]
				ifFalse: [self handleSize].
	dotSize := self splitsTopAndBottom
				ifTrue: [6 @ self class splitterWidth]
				ifFalse: [self class splitterWidth @ 6].
	alphaCanvas := aCanvas asAlphaBlendingCanvas: 0.7.
	dotBounds := Rectangle center: self bounds center extent: size.
	alphaCanvas fillRectangle: dotBounds color: self handleColor.
	dotBounds := Rectangle center: self bounds center extent: dotSize.
	alphaCanvas fillRectangle: dotBounds color: self dotColor]! !

!ProportionalSplitterMorph methodsFor: 'accessing' stamp: 'bvs 3/24/2004 17:25'!
splitsTopAndBottom

	^ splitsTopAndBottom! !

!ProportionalSplitterMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 5/9/2007 10:47'!
showRightOrBottom
	"Show the receiver and all right or bottom morphs."

	self show.
	rightOrBottom do: [:m | m show]! !

!ProportionalSplitterMorph methodsFor: 'accessing' stamp: 'MarcusDenker 12/11/2009 09:58'!
rightBoundary
	"Answer the right boundary position by calculating the minimum
	of the minimum widths of the right morphs."
	
	|morphs|
	morphs := rightOrBottom reject: [:m |
		m layoutFrame rightFraction ~= 1 and: [
			m layoutFrame leftFraction = m layoutFrame rightFraction]].
	morphs ifEmpty: [
		^(self splitterRight
			ifNil: [self containingWindow panelRect right]
			ifNotNil: [:s | s left]) + 25].
	^(morphs collect: [:m |
		m right - m minExtent x -
			(m layoutFrame leftOffset ifNil: [0]) +
			(self layoutFrame rightOffset ifNil: [0])]) min - self class splitterWidth! !

!ProportionalSplitterMorph methodsFor: 'operations' stamp: 'jrp 3/21/2006 23:12'!
normalizedY: y

	^ (y max: self topBoundary) min: self bottomBoundary! !

!ProportionalSplitterMorph methodsFor: 'operations' stamp: 'jrp 3/21/2006 22:45'!
normalizedX: x

	^ (x max: self leftBoundary) min: self rightBoundary! !

!ProportionalSplitterMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 4/27/2010 11:53'!
siblingSplitters

	^ self owner 
		submorphsSatisfying: [:each | (each isKindOf: self class) 
									and: [self splitsTopAndBottom = each splitsTopAndBottom and: [each ~= self]]]! !

!ProportionalSplitterMorph methodsFor: 'operations' stamp: 'bvs 3/24/2004 16:55'!
addRightOrBottom: aMorph

	rightOrBottom add: aMorph.
	
	! !

!ProportionalSplitterMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/31/2012 18:41'!
splitterBelow
	"Answer the splitter below the receiver that overlaps in its horizontal range."

	|splitters|
	splitters := ((self siblingSplitters select: [:each |
		each top < self top and: [self overlapsHorizontal: each]]) asSortedCollection: [:a :b | a top > b top]).
	
	^ splitters
		ifEmpty: [ nil ]
		ifNotEmpty: [:s | s first ]! !

!ProportionalSplitterMorph methodsFor: 'operations' stamp: 'bvs 3/24/2004 16:57'!
addLeftOrTop: aMorph

	leftOrTop add: aMorph! !

!ProportionalSplitterMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/31/2012 18:42'!
splitterRight
	"Answer the splitter to the right of the receiver that overlaps in its vertical range."
	
	|splitters|
	splitters := ((self siblingSplitters select: [:each |
		each left > self left and: [self overlapsVertical: each]]) asSortedCollection: [:a :b | a left < b left]).
	
	^ splitters
		ifEmpty: [ nil ]
		ifNotEmpty: [:s | s first ]! !

!ProportionalSplitterMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 5/9/2007 10:46'!
hasLeftOrTop: aMorph
	"Answer whether the reciver has the given morph
	as one of of its left or top morphs."

	^leftOrTop includes: aMorph! !

!ProportionalSplitterMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 7/30/2007 15:55'!
pressedFillStyle
	"Return the pressed fillStyle of the receiver."
	
	^self theme splitterPressedFillStyleFor: self! !

!ProportionalSplitterMorph methodsFor: 'actions' stamp: 'bvs 3/24/2004 16:39'!
resizeCursor

	^ Cursor resizeForEdge: (splitsTopAndBottom
		ifTrue: [#top]
		ifFalse: [#left])
		! !

!ProportionalSplitterMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/31/2012 18:41'!
splitterAbove
	"Answer the splitter above the receiver that overlaps in its horizontal range."
	
	|splitters|
	splitters := ((self siblingSplitters select: [:each |
		each top > self top and: [self overlapsHorizontal: each]]) asSortedCollection: [:a :b | a top < b top]).
	^ splitters
		ifEmpty: [ nil ]
		ifNotEmpty: [:s | s first ]! !

!ProportionalSplitterMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/26/2007 10:21'!
setGrabbedColor
	"Set the color of the receiver when it is grabbed."
	
	self fillStyle: self pressedFillStyle! !

!ProportionalSplitterMorph methodsFor: 'accessing' stamp: 'jrp 7/4/2005 10:50'!
handleRect

	^ Rectangle
		center: self bounds center 
		extent: (self splitsTopAndBottom
			ifTrue: [self handleSize transposed] 
			ifFalse: [self handleSize])! !

!ProportionalSplitterMorph methodsFor: 'event handling' stamp: 'gvc 6/15/2007 11:27'!
mouseDown: anEvent 
	"A mouse button has been pressed.
	Update the color for feedback and store the mouse
	position and relative offset to the receiver."
	
	|cp|
	(self class showSplitterHandles not
			and: [self bounds containsPoint: anEvent cursorPoint])
		ifTrue: [oldColor := self color.
			self setGrabbedColor].
	cp := anEvent cursorPoint.
	lastMouse := {cp. cp - self position}! !

!ProportionalSplitterMorph class methodsFor: 'preferences' stamp: 'AlainPlantec 12/14/2009 21:44'!
showSplitterHandles

	^ ShowHandles ifNil: [ShowHandles := false]! !

!ProportionalSplitterMorph class methodsFor: 'as yet unclassified' stamp: 'jrp 8/6/2005 23:59'!
splitterWidth

	^ 4! !

!ProportionalSplitterMorph class methodsFor: 'preferences' stamp: 'AlainPlantec 12/14/2009 21:36'!
fastSplitterResize
	
	^ self theme settings fastDragging! !

!ProportionalSplitterMorph class methodsFor: 'preferences' stamp: 'AlainPlantec 12/14/2009 21:45'!
showSplitterHandles: aBoolean

	ShowHandles := aBoolean! !

!ProtoObject commentStamp: '<historical>'!
ProtoObject establishes minimal behavior required of any object in Pharo, even objects that should balk at normal object behavior. 

Generally these are proxy objects designed to read themselves in from the disk, or to perform some wrapper behavior, before responding to a message. 

ProtoObject has no instance variables, nor should any be added.!
!ProtoObject methodsFor: 'executing' stamp: 'ClementBera 11/5/2013 10:21'!
executeMethod: compiledMethod
	^ self withArgs: #( ) executeMethod: compiledMethod! !

!ProtoObject methodsFor: 'debugging' stamp: 'simon.denier 6/11/2010 14:47'!
doOnlyOnce: aBlock
	"If the 'one-shot' mechanism is armed, evaluate aBlock once and disarm the one-shot mechanism.  To rearm the mechanism, evaluate  'self rearmOneShot' manually."

	(Smalltalk globals at: #OneShotArmed ifAbsent: [ true ])
		ifTrue: [ 
			Smalltalk globals at: #OneShotArmed put: false.
			aBlock value ]! !

!ProtoObject methodsFor: 'testing' stamp: 'HenrikSperreJohansen 6/1/2010 13:30'!
ifNotNil: ifNotNilBlock ifNil: nilBlock 
	"If I got here, I am not nil, so evaluate the block ifNotNilBlock"

	^ ifNotNilBlock cull: self! !

!ProtoObject methodsFor: 'reflective operations' stamp: 'ajh 10/9/2001 17:20'!
doesNotUnderstand: aMessage

	^ MessageNotUnderstood new 
		message: aMessage;
		receiver: self;
		signal! !

!ProtoObject methodsFor: 'initialization' stamp: 'MarianoMartinezPeck 8/24/2012 15:59'!
initialize
	"Subclasses should redefine this method to perform initializations on instance creation" ! !

!ProtoObject methodsFor: 'pointing to' stamp: 'MarcusDenker 7/28/2014 19:18'!
pointersToExcept: objectsToExclude
	"Find all objects in the system that hold a pointer to me, excluding those listed"
	| c pointers object objectsToAlwaysExclude |
	Smalltalk garbageCollect.
	pointers := OrderedCollection new.
	"SystemNavigation >> #allObjectsDo: is inlined here with a slight modification: the marker object is pointers. This gives better results, because the value of pointers, it's inner objects and transient method contexts will not be iterated over."
	object := self someObject.
	[ object == pointers ] whileFalse: [
		( object pointsTo: self ) ifTrue: [
			pointers add: object ].
		object := object nextObject ].
	objectsToAlwaysExclude := {
		thisContext.
		thisContext sender.
		thisContext sender sender.
		objectsToExclude.
	}.
	c := thisContext.
	^(pointers removeAllSuchThat: [ :ea |
		(ea == thisContext sender) or: [ "warning: this expression is dependent on closure structure of this method"
			(objectsToAlwaysExclude identityIncludes: ea)
				or: [objectsToExclude identityIncludes: ea ]] ]) asArray! !

!ProtoObject methodsFor: 'debugging' stamp: 'simon.denier 6/11/2010 14:47'!
rearmOneShot
	"Call this manually to arm the one-shot mechanism; use the mechanism in code by calling
		self doOnlyOnce: <a block>"

	Smalltalk globals at: #OneShotArmed put: true

	"self rearmOneShot"
! !

!ProtoObject methodsFor: 'testing' stamp: 'md 11/24/1999 19:23'!
ifNil: nilBlock
	"Return self, or evaluate the block if I'm == nil (q.v.)"

	^ self! !

!ProtoObject methodsFor: '*Fuel-Collections' stamp: 'MarianoMartinezPekc 1/10/2012 18:56'!
fuelPointsTo: anObject
	"This method returns true if self contains a pointer to anObject,
		and returns false otherwise"
	<primitive: 132>
	"This is the same as the following smalltalk code:
	1 to: self class instSize do:
		[:i | (self instVarAt: i) == anObject ifTrue: [^ true]].
	1 to: self basicSize do:
		[:i | (self basicAt: i) == anObject ifTrue: [^ true]].
	^ false"
! !

!ProtoObject methodsFor: 'class membership' stamp: 'MarcusDenker 3/22/2013 17:23'!
class
	"Primitive. Answer the object which is the receiver's class. Essential. See 
	Object documentation whatIsAPrimitive."

	<primitive: 111>
	self primitiveFailed! !

!ProtoObject methodsFor: 'testing' stamp: 'HenrikSperreJohansen 6/1/2010 13:29'!
ifNil: nilBlock ifNotNil: ifNotNilBlock
	"Evaluate the block, unless I'm == nil (q.v.)"

	^ ifNotNilBlock cull: self! !

!ProtoObject methodsFor: 'testing' stamp: 'HenrikSperreJohansen 6/1/2010 13:29'!
ifNotNil: ifNotNilBlock
	"Evaluate the block, unless I'm == nil (q.v.)"

	^ ifNotNilBlock cull: self! !

!ProtoObject methodsFor: 'comparing' stamp: 'SeanDeNigris 5/1/2012 15:16'!
~~ anObject
	"Answer whether the receiver and the argument are different objects
	(do not have the same object pointer)."

	"This seemingly redundant implementation is for performance (and possibly other) reasons. See http://forum.world.st/About-and-td3898409.html for more details"
	self == anObject
		ifTrue: [^ false]
		ifFalse: [^ true]! !

!ProtoObject methodsFor: 'pointing to' stamp: 'AndyKellens 6/11/2010 14:14'!
pointersTo
	^self pointersToExcept: #()! !

!ProtoObject methodsFor: 'introspection' stamp: 'MarianoMartinezPeck 12/22/2011 21:04'!
instVarsInclude: anObject
"Answers true if anObject is among my named or indexed instance variables, and false otherwise"

	<primitive: 132>
	1 to: self class instSize do:
		[:i | (self instVarAt: i) == anObject ifTrue: [^ true]].
	1 to: self basicSize do:
		[:i | (self basicAt: i) == anObject ifTrue: [^ true]].
	^ false! !

!ProtoObject methodsFor: '*Fuel-Collections' stamp: 'ul 12/18/2011 11:14'!
largeIdentityHash

	<primitive: 75>
	self primitiveFailed! !

!ProtoObject methodsFor: 'comparing' stamp: 'G.C 10/23/2008 10:13'!
== anObject 
	"Primitive. Answer whether the receiver and the argument are the same 
	object (have the same object pointer). Do not redefine the message == in 
	any other class!! Essential. No Lookup. Do not override in any subclass. 
	See Object documentation whatIsAPrimitive."

	<primitive: 110>
	self primitiveFailed! !

!ProtoObject methodsFor: 'memory scanning' stamp: 'md 11/24/1999 19:58'!
nextObject
	"Primitive. Answer the next object after the receiver in the 
	enumeration of all objects. Return 0 when all objects have been 
	enumerated."

	<primitive: 139>
	self primitiveFailed.! !

!ProtoObject methodsFor: 'flagging' stamp: 'marcus.denker 8/25/2008 09:12'!
flag: aSymbol

	"Send this message, with a relevant symbol as argument, to flag a message for subsequent retrieval.  For example, you might put the following line in a number of messages:
	self flag: #returnHereUrgently
	Then, to retrieve all such messages, browse all senders of #returnHereUrgently."! !

!ProtoObject methodsFor: 'memory scanning' stamp: 'md 11/24/1999 19:58'!
nextInstance
	"Primitive. Answer the next instance after the receiver in the 
	enumeration of all instances of this class. Fails if all instances have been 
	enumerated. Essential. See Object documentation whatIsAPrimitive."

	<primitive: 78>
	^nil! !

!ProtoObject methodsFor: 'executing' stamp: 'eem 4/8/2009 19:10'!
withArgs: argArray executeMethod: compiledMethod
	"Execute compiledMethod against the receiver and args in argArray"

	<primitive: 188>
	self primitiveFailed! !

!ProtoObject methodsFor: 'testing' stamp: 'md 11/24/1999 19:26'!
isNil
	"Coerces nil to true and everything else to false."

	^false! !

!ProtoObject methodsFor: 'pointing to' stamp: 'MarcusDenker 10/29/2013 21:21'!
pointsTo: anObject
	"Answers true if I hold a reference to anObject, or false otherwise
	an object points to a class via the header either directly or indirectly 
	via the compact classes array"

	^ (self instVarsInclude: anObject) or: [ ^self class == anObject]! !

!ProtoObject methodsFor: 'comparing' stamp: 'MartinMcClure 3/21/2010 16:40'!
identityHash
	"Answer a SmallInteger whose value is related to the receiver's identity.
	This method must not be overridden, except by SmallInteger.
	
	Do not override."

	^ self basicIdentityHash bitShift: 18! !

!ProtoObject methodsFor: 'reflective operations' stamp: 'MartinMcClure 1/12/2010 21:10'!
basicIdentityHash
	"Answer a SmallInteger whose value is related to the receiver's identity.
	This method must not be overridden, except by SmallInteger.
	Primitive. Fails if the receiver is a SmallInteger. Essential.
	See Object documentation whatIsAPrimitive.

	Do not override. Use #identityHash unless you really know what you're doing.'"

	<primitive: 75>
	self primitiveFailed! !

!ProtoObject methodsFor: 'reflective operations' stamp: 'md 11/24/1999 19:30'!
become: otherObject 
	"Primitive. Swap the object pointers of the receiver and the argument.
	All variables in the entire system that used to point to the 
	receiver now point to the argument, and vice-versa.
	Fails if either object is a SmallInteger"

	(Array with: self)
		elementsExchangeIdentityWith:
			(Array with: otherObject)! !

!ProtoObject methodsFor: 'reflective operations' stamp: 'ClementBera 9/27/2013 17:52'!
cannotInterpret: aMessage 
	 "Handle the fact that there was an attempt to send the given message to the receiver but a null methodDictionary was encountered while looking up the message selector.  Hopefully this is the result of encountering a stub for a swapped out class which induces this exception on purpose."

"If this is the result of encountering a swap-out stub, then simulating the lookup in Smalltalk should suffice to install the class properly, and the message may be resent."

	(self class lookupSelector: aMessage selector) ifNotNil:
		["Simulated lookup succeeded -- resend the message."
		^ aMessage sentTo: self].

	"Could not recover by simulated lookup -- it's an error"
	Error signal: 'MethodDictionary fault'.

	"Try again in case an error handler fixed things"
	^ aMessage sentTo: self! !

!ProtoObject methodsFor: 'apply primitives' stamp: 'ClementBera 5/27/2014 13:49'!
tryPrimitive: primIndex withArgs: argumentArray
	"This method is a template that the Smalltalk simulator uses to 
	execute primitives. See Object documentation whatIsAPrimitive."

	<primitive: 118 error: code >
	^ Context primitiveFailTokenFor: code! !

!ProtoObjectTest commentStamp: '<historical>'!
This is the unit test for the class ProtoObject. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see: 
	- http://www.c2.com/cgi/wiki?UnitTest
	- there is a chapter in the PharoByExample book (http://pharobyexample.org)
	- the sunit class category!
!ProtoObjectTest methodsFor: 'tests - testing' stamp: 'ul 12/18/2009 15:48'!
testIfNotNilIfNil

	| object returnValue block |
	object := ProtoObject new.
	returnValue := Object new.
	self should: [ object ifNotNil: [ self halt ] ifNil: [ self error ]  ] raise: Halt.
	self should: [ object ifNotNil: [ :o | self halt ] ifNil: [ self error ] ] raise: Halt.
	self assert: (object ifNotNil: [ :o | o == object ] ifNil: [ false ]).
	self assert: (object ifNotNil: [ returnValue ] ifNil: [ false ]) == returnValue.
	self assert: (object ifNotNil: [ :o | returnValue ] ifNil: [ false ]) == returnValue.
	"Now the same without inlining."
	block := [ self halt ].
	self should: [ object ifNotNil: block ifNil: [ self error ]  ] raise: Halt.
	block := [ :o | self halt ].
	self should: [ object ifNotNil: block ifNil: [ self error ] ] raise: Halt.
	block := [ :o | o == object ].
	self assert: (object ifNotNil: block ifNil: [ false ]).
	block := [ returnValue ].
	self assert: (object ifNotNil: block ifNil: [ false ]) == returnValue.
	block := [ :o | returnValue ].
	self assert: (object ifNotNil: block ifNil: [ false ]) == returnValue! !

!ProtoObjectTest methodsFor: 'tests - testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testIfNil
	| object block |
	object := ProtoObject new.
	object ifNil: [ self halt ].
	self assert: (object ifNil: [ nil ]) == object.	"Now the same without inlining."
	block := [ self halt ].
	object ifNil: block.
	block := [ nil ].
	self assert: (object ifNil: block) == object! !

!ProtoObjectTest methodsFor: 'tests - testing' stamp: 'SeanDeNigris 5/1/2012 14:50'!
testNotTheSame

	| object1 object2 |
	object1 := ProtoObject new.
	object2 := ProtoObject new.
	self assert: object1 ~~ object2.
	self deny: object1 ~~ object1.! !

!ProtoObjectTest methodsFor: 'tests - testing' stamp: 'ul 12/18/2009 15:48'!
testIsNil

	self deny: ProtoObject new isNil! !

!ProtoObjectTest methodsFor: 'tests - testing' stamp: 'ul 12/18/2009 15:49'!
testIfNilIfNotNil

	| object returnValue block |
	object := ProtoObject new.
	returnValue := Object new.
	self should: [ object ifNil: [ self error ] ifNotNil: [ self halt ] ] raise: Halt.
	self should: [ object ifNil: [ self error ] ifNotNil: [ :o | self halt ] ] raise: Halt.
	self assert: (object ifNil: [ false ] ifNotNil: [ :o | o == object ]).
	self assert: (object ifNil: [ nil ] ifNotNil: [ returnValue ]) == returnValue.
	self assert: (object ifNil: [ nil ] ifNotNil: [ :o | returnValue ]) == returnValue.
	"Now the same without inlining."
	block := [ self halt ].
	self should: [ object ifNil: [ self error ] ifNotNil: block ] raise: Halt.
	block := [ :o | self halt ].
	self should: [ object ifNil: [ self error ] ifNotNil: block ] raise: Halt.
	block := [ :o | o == object ].
	self assert: (object ifNil: [ false ] ifNotNil: block).
	block := [ returnValue ].
	self assert: (object ifNil: [ nil ] ifNotNil: block) = returnValue.
	block := [ :o | returnValue ].
	self assert: (object ifNil: [ nil ] ifNotNil: block) = returnValue! !

!ProtoObjectTest methodsFor: 'tests - testing' stamp: 'ul 12/18/2009 15:48'!
testIfNotNil

	| object returnValue block |
	object := ProtoObject new.
	returnValue := Object new.
	self should: [ object ifNotNil: [ self halt ] ] raise: Halt.
	self should: [ object ifNotNil: [ :o | self halt ] ] raise: Halt.
	self assert: (object ifNotNil: [ :o | o == object ]).
	self assert: (object ifNotNil: [ returnValue ]) == returnValue.
	self assert: (object ifNotNil: [ :o | returnValue ]) == returnValue.	
	"Now the same without inlining."
	block := [ self halt ].
	self should: [ object ifNotNil: block ] raise: Halt.
	block := [ :o | self halt ].
	self should: [ object ifNotNil: block ] raise: Halt.
	block := [ :o | o == object ].
	self assert: (object ifNotNil: block).
	block := [ returnValue ].
	self assert: (object ifNotNil: block) = returnValue.
	block := [ :o | returnValue ].
	self assert: (object ifNotNil: block) = returnValue! !

!ProtoObjectTest methodsFor: 'tests - testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testFlag
	ProtoObject new flag: #hallo! !

!Protocol commentStamp: '<historical>'!
A Protocol is a simple value holder representing a protocol.
It's composed of a name and a set of method selectors!
!Protocol methodsFor: 'testing' stamp: 'EstebanLorenzano 11/29/2013 16:04'!
canBeRenamed
	^ true! !

!Protocol methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/12/2012 14:12'!
rename: newName

	self name: newName! !

!Protocol methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 4/12/2012 16:27'!
isEmpty

	^ self methods isEmpty! !

!Protocol methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/12/2012 14:21'!
methods

	^ methods! !

!Protocol methodsFor: 'accessing' stamp: 'EstebanLorenzano 1/16/2014 11:23'!
addMethod: aSymbol
	^ methods add: aSymbol! !

!Protocol methodsFor: 'testing' stamp: 'EstebanLorenzano 6/27/2013 15:53'!
isVirtualProtocol
	"A virtual protocol is a calculated one (it does not have any methods by it self)"
	^ false! !

!Protocol methodsFor: 'accessing' stamp: 'SebastianTleye 8/28/2013 17:03'!
removeAllMethods

	^ methods removeAll.! !

!Protocol methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 23:07'!
initialize

	super initialize.

	methods := IdentitySet new..
	name := self class defaultName.! !

!Protocol methodsFor: 'accessing' stamp: 'SebastianTleye 8/28/2013 17:22'!
addAllMethodsFrom: aProtocol

	aProtocol methods do: [ :each | self addMethod: each ].! !

!Protocol methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/12/2012 14:02'!
methods: anObject
	
	methods := anObject! !

!Protocol methodsFor: 'accessing' stamp: 'EstebanLorenzano 11/29/2013 15:57'!
name: anObject
	name := anObject asSymbol! !

!Protocol methodsFor: 'printing' stamp: 'BenjaminVanRyseghem 4/12/2012 14:28'!
printOn: aStream

	aStream 
		nextPutAll: (self class name);
		nextPutAll: ' (';
		nextPutAll: (self name);
		nextPutAll: ') - ';
		nextPutAll: (self methods size asString);
		nextPutAll: ' selector(s)'.! !

!Protocol methodsFor: 'testing' stamp: 'EstebanLorenzano 6/28/2013 16:04'!
includesSelector: selector

	^ methods includes: selector! !

!Protocol methodsFor: 'private' stamp: 'EstebanLorenzano 6/17/2013 12:51'!
canBeRemoved
	^ self isEmpty ! !

!Protocol methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/12/2012 14:21'!
name

	^ name! !

!Protocol methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/12/2012 14:11'!
removeMethod: aSymbol

	^ methods remove: aSymbol! !

!Protocol methodsFor: 'testing' stamp: 'EstebanLorenzano 10/2/2013 16:23'!
isExtensionProtocol 
	^ self name first = $*.! !

!Protocol class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 4/12/2012 14:02'!
name: nm methods: methods 

	^ self new
		methods: methods;
		name: nm;
		yourself! !

!Protocol class methodsFor: 'instance creation' stamp: 'MarcusDenker 10/3/2013 17:49'!
empty 
	 ^ self name: #''! !

!Protocol class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 4/12/2012 14:06'!
name: nm

	^ self new
		name: nm;
		yourself! !

!Protocol class methodsFor: 'accessing' stamp: 'MarcusDenker 10/3/2013 17:49'!
nullCategory

	^ #'no messages'! !

!Protocol class methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/28/2013 14:16'!
defaultName

	^  self unclassified! !

!Protocol class methodsFor: 'instance creation' stamp: 'EstebanLorenzano 5/28/2013 13:21'!
ambiguous
	^ #ambiguous! !

!Protocol class methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/28/2013 14:15'!
unclassified
	^ #'as yet unclassified'! !

!ProtocolAdded commentStamp: '<historical>'!
This class is not used, but should be used when we hook into the addition and removal of protocols. Right now, we only get ClassReorganizedAnnouncement!
!ProtocolAnnouncement commentStamp: '<historical>'!
I'm an abstract announcement for protocols!
!ProtocolAnnouncement methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/3/2013 12:44'!
protocol
	^ protocol! !

!ProtocolAnnouncement methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/3/2013 11:59'!
classReorganized: anObject
	classReorganized := anObject! !

!ProtocolAnnouncement methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/3/2013 11:58'!
classAffected
	^self classReorganized! !

!ProtocolAnnouncement methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/3/2013 11:59'!
classReorganized
	^ classReorganized! !

!ProtocolAnnouncement methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/3/2013 12:44'!
protocol: aString
	protocol := aString! !

!ProtocolBrowser commentStamp: 'BenjaminVanRyseghem 1/21/2014 16:36'!
I am a complete UI used to view the protocol methods (via a ProtocolViewer) as well as their source code.

I am used to expose the construction of a spec UI in the Spec documentation.!
!ProtocolBrowser methodsFor: 'api' stamp: 'BenjaminVanRyseghem 1/21/2014 16:27'!
initialExtent

	^ 750@600! !

!ProtocolBrowser methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 1/21/2014 16:30'!
initializeWidgets

	text := self newText.
	viewer := self instantiate: ProtocolViewer.
	
	text aboutToStyle: true.

	self focusOrder 
		add: viewer;
		add: text! !

!ProtocolBrowser methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 1/27/2014 11:48'!
initializePresenter

	viewer whenClassChanged: [ :class | text behavior: class ].

	viewer whenProtocolChangedDo: [ :item | 
		item 
			ifNil: [ text text: '' ]
			ifNotNil: [ text text: item sourceCode ] ].
	viewer whenEventChangedDo: [ :item | 
		item 
			ifNil: [ text text: '' ]
			ifNotNil: [ text text: item sourceCode ] ]! !

!ProtocolBrowser methodsFor: 'api' stamp: 'BenjaminVanRyseghem 1/27/2014 17:24'!
title

	^ 'Protocols browser'! !

!ProtocolBrowser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/21/2014 15:48'!
text
	^ text! !

!ProtocolBrowser methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/21/2014 15:48'!
viewer
	^ viewer! !

!ProtocolBrowser class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/21/2014 15:57'!
defaultSpec
	<spec: #default>
	
	^ SpecLayout composed
		newColumn: [ :col | 
			col 
				newRow: [ :r | 
					r 
						add: #(viewer models);
					 	newColumn: [ :c | 
							c 
								add: #(viewer protocols);
								add: #(viewer events) ] ];
				add: #text
		];
		yourself! !

!ProtocolClient commentStamp: 'gk 12/13/2005 00:34'!
ProtocolClient is the abstract super class for a variety of network protocol clients.
It uses a stream rather than the direct network access so it could also work for streams on serial connections etc.

Structure:
	stream				stream representing the connection to and from the server
	connectInfo			information required for opening a connection
	lastResponse			remembers the last response from the server.
	progressObservers 	any object understanding #show: can be registered as a progress observer (login, transfer, etc)!
!ProtocolClient methodsFor: 'private' stamp: 'mir 3/7/2002 14:54'!
progressObservers
	progressObservers ifNil: [progressObservers := OrderedCollection new].
	^progressObservers! !

!ProtocolClient methodsFor: 'private protocol' stamp: 'mir 7/23/2003 16:50'!
fetchPendingResponse
	^pendingResponses
		ifNil: [self fetchNextResponse; lastResponse]
		ifNotNil: [self popResponse]! !

!ProtocolClient methodsFor: 'private' stamp: 'mir 3/8/2002 11:38'!
port: aPortNumber
	^self connectionInfo at: #port put: aPortNumber! !

!ProtocolClient methodsFor: 'private' stamp: 'mir 3/8/2002 11:40'!
openOnHost: hostIP port: portNumber
	self host: hostIP.
	self port: portNumber.
	self ensureConnection! !

!ProtocolClient methodsFor: 'actions' stamp: 'mir 3/7/2002 13:10'!
close
	self stream
		ifNotNil: [
			self stream close.
			stream := nil]! !

!ProtocolClient methodsFor: 'private testing' stamp: 'mir 3/7/2002 13:42'!
responseIsError
	self subclassResponsibility! !

!ProtocolClient methodsFor: 'accessing' stamp: 'mir 2/22/2002 17:33'!
stream: aStream
	stream := aStream! !

!ProtocolClient methodsFor: 'private' stamp: 'md 8/14/2005 18:27'!
ensureConnection
	self isConnected
		ifTrue: [^self].
	self stream
		ifNotNil: [self stream close].

	self stream: (SocketStream openConnectionToHost: self host port: self port).
	self checkResponse.
	self login! !

!ProtocolClient methodsFor: 'private' stamp: 'mir 3/7/2002 13:35'!
lastResponse: aString
	lastResponse := aString.
! !

!ProtocolClient methodsFor: 'private' stamp: 'mir 7/23/2003 16:55'!
popResponse
	| pendingResponse |
	pendingResponse := self pendingResponses removeFirst.
	pendingResponses isEmpty
		ifTrue: [pendingResponses := nil].
	^pendingResponse! !

!ProtocolClient methodsFor: 'private' stamp: 'mir 11/11/2002 16:19'!
user
	^self connectionInfo at: #user ifAbsent: [nil]! !

!ProtocolClient methodsFor: 'private protocol' stamp: 'mir 3/5/2002 14:31'!
sendStreamContents: aStream
	self stream sendStreamContents: aStream! !

!ProtocolClient methodsFor: 'actions' stamp: 'mir 3/7/2002 13:11'!
reopen
	self ensureConnection! !

!ProtocolClient methodsFor: 'private' stamp: 'mir 3/8/2002 11:35'!
connectionInfo
	connectInfo ifNil: [connectInfo := Dictionary new].
	^connectInfo! !

!ProtocolClient methodsFor: 'private protocol' stamp: 'BenjaminVanRyseghem 3/14/2013 14:29'!
checkResponse
	self
		checkResponseOnError: [:response | (TelnetProtocolError protocolInstance: self)
				signal: response]
		onWarning: [:response | (TelnetProtocolError protocolInstance: self)
				signal: response]! !

!ProtocolClient methodsFor: 'accessing' stamp: 'mir 5/9/2003 15:52'!
response
	^self protocolInstance lastResponse! !

!ProtocolClient methodsFor: 'accessing' stamp: 'mir 3/7/2002 14:55'!
logProgressToTranscript
	self progressObservers add: Transcript! !

!ProtocolClient methodsFor: 'private' stamp: 'mir 7/23/2003 16:45'!
pendingResponses
	pendingResponses ifNil: [pendingResponses := OrderedCollection new].
	^pendingResponses! !

!ProtocolClient methodsFor: 'private' stamp: 'mir 3/8/2002 11:37'!
host: hostId
	^self connectionInfo at: #host put: hostId! !

!ProtocolClient methodsFor: 'private' stamp: 'mir 3/8/2002 11:39'!
user: aString
	^self connectionInfo at: #user put: aString! !

!ProtocolClient methodsFor: 'private protocol' stamp: 'mir 7/23/2003 16:52'!
checkForPendingError
	"If data is waiting, check it to catch any error reports.
	In case the response is not an error, push it back."

	self stream isDataAvailable
		ifFalse: [^self].
	self fetchNextResponse.
	self
		checkResponse: self lastResponse
		onError: [:response | (TelnetProtocolError protocolInstance: self) signal]
		onWarning: [:response | (TelnetProtocolError protocolInstance: self) signal].
	"if we get here, it wasn't an error"
	self pushResponse: self lastResponse! !

!ProtocolClient methodsFor: 'private' stamp: 'mir 4/7/2003 16:56'!
host
	^self connectionInfo at: #host! !

!ProtocolClient methodsFor: 'private' stamp: 'mir 3/7/2002 13:35'!
lastResponse
	^lastResponse! !

!ProtocolClient methodsFor: 'private' stamp: 'mir 3/8/2002 11:35'!
resetConnectionInfo
	connectInfo := nil! !

!ProtocolClient methodsFor: 'accessing' stamp: 'mir 2/22/2002 17:33'!
stream
	^stream! !

!ProtocolClient methodsFor: 'private protocol' stamp: 'mir 5/12/2003 18:10'!
sendCommand: aString
	self stream sendCommand: aString.
! !

!ProtocolClient methodsFor: 'private testing' stamp: 'mir 3/7/2002 13:42'!
responseIsWarning
	self subclassResponsibility! !

!ProtocolClient methodsFor: 'private' stamp: 'mir 5/12/2003 18:10'!
logProgress: aString
	self progressObservers do: [:each | each show: aString].
! !

!ProtocolClient methodsFor: 'private' stamp: 'mir 7/23/2003 16:45'!
pushResponse: aResponse
	self pendingResponses add: aResponse! !

!ProtocolClient methodsFor: 'private protocol' stamp: 'mir 7/23/2003 16:51'!
checkResponse: aResponse onError: errorBlock onWarning: warningBlock
	"Get the response from the server and check for errors. Invoke one of the blocks if an error or warning is encountered. See class comment for classification of error codes."

	self responseIsError
		ifTrue: [errorBlock value: aResponse].
	self responseIsWarning
		ifTrue: [warningBlock value: aResponse].
! !

!ProtocolClient methodsFor: 'testing' stamp: 'mir 3/7/2002 14:33'!
isConnected
	^stream notNil
		and: [stream isConnected]! !

!ProtocolClient methodsFor: 'private protocol' stamp: 'mir 3/7/2002 13:16'!
fetchNextResponse
	self lastResponse: self stream nextLine! !

!ProtocolClient methodsFor: 'private' stamp: 'mir 4/7/2003 16:56'!
password
	^self connectionInfo at: #password! !

!ProtocolClient methodsFor: 'private' stamp: 'mir 2/25/2002 19:34'!
defaultPortNumber
	^self class defaultPortNumber! !

!ProtocolClient methodsFor: 'private' stamp: 'mir 3/8/2002 11:37'!
password: aString
	^self connectionInfo at: #password put: aString! !

!ProtocolClient methodsFor: 'private protocol' stamp: 'mir 7/23/2003 16:54'!
checkResponseOnError: errorBlock onWarning: warningBlock
	"Get the response from the server and check for errors. Invoke one of the blocks if an error or warning is encountered. See class comment for classification of error codes."

	self fetchPendingResponse.
	self checkResponse: self lastResponse onError: errorBlock onWarning: warningBlock! !

!ProtocolClient methodsFor: 'private' stamp: 'mir 4/7/2003 16:57'!
port
	^self connectionInfo at: #port! !

!ProtocolClient methodsFor: 'private' stamp: 'mir 2/25/2002 19:07'!
logFlag
	^self class logFlag! !

!ProtocolClient methodsFor: 'accessing' stamp: 'mir 5/9/2003 15:52'!
messageText
	^super messageText
		ifNil: [self response]! !

!ProtocolClient class methodsFor: 'accessing' stamp: 'mir 2/25/2002 16:00'!
defaultPortNumber
	self subclassResponsibility! !

!ProtocolClient class methodsFor: 'instance creation' stamp: 'gk 3/2/2004 11:10'!
openOnHostNamed: hostName
	"If the hostname uses the colon syntax to express a certain portnumber
	we use that instead of the default port number."

	| i |
	i := hostName indexOf: $:.
	i = 0 ifTrue: [
			^self openOnHostNamed: hostName port: self defaultPortNumber]
		ifFalse: [
			| s p | 
			s := hostName truncateTo: i - 1.
			p := (hostName copyFrom: i + 1 to: hostName size) asInteger.
			^self openOnHostNamed: s port: p]
	! !

!ProtocolClient class methodsFor: 'instance creation' stamp: 'mir 2/25/2002 15:59'!
openOnHost: hostIP port: portNumber
	^self new openOnHost: hostIP port: portNumber! !

!ProtocolClient class methodsFor: 'instance creation' stamp: 'mir 2/25/2002 15:58'!
openOnHostNamed: hostName port: portNumber
	| serverIP |
	serverIP := NetNameResolver addressForName: hostName timeout: 20.
	^self openOnHost: serverIP port: portNumber
! !

!ProtocolClient class methodsFor: 'accessing' stamp: 'mir 2/25/2002 19:07'!
logFlag
	self subclassResponsibility! !

!ProtocolClientError commentStamp: 'mir 5/12/2003 18:05'!
Abstract super class for protocol clients

	protocolInstance		reference to the protocol client throughing the exception. Exception handlers can access the client in order close, respond or whatever may be appropriate
!
!ProtocolClientError methodsFor: 'accessing' stamp: 'mir 10/30/2000 13:48'!
protocolInstance: aProtocolInstance
	protocolInstance := aProtocolInstance! !

!ProtocolClientError methodsFor: 'accessing' stamp: 'mir 5/16/2003 11:18'!
response
	^self protocolInstance lastResponse! !

!ProtocolClientError methodsFor: 'accessing' stamp: 'mir 5/16/2003 11:17'!
messageText
	^super messageText
		ifNil: [self response]! !

!ProtocolClientError methodsFor: 'accessing' stamp: 'mir 10/30/2000 13:48'!
protocolInstance
	^protocolInstance! !

!ProtocolClientError class methodsFor: 'instance creation' stamp: 'mir 10/30/2000 16:15'!
protocolInstance: aProtocolInstance
	^self new protocolInstance: aProtocolInstance! !

!ProtocolList commentStamp: 'BenjaminVanRyseghem 1/21/2014 16:35'!
I am widget displaying a list with a label.

I am used to expose the construction of a spec UI in the Spec documentation.!
!ProtocolList methodsFor: 'api' stamp: 'BenjaminVanRyseghem 1/21/2014 16:17'!
resetSelection

	protocols resetSelection! !

!ProtocolList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/21/2014 15:25'!
protocols
	^ protocols! !

!ProtocolList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/21/2014 15:25'!
label
	^ label! !

!ProtocolList methodsFor: 'api' stamp: 'BenjaminVanRyseghem 1/21/2014 16:37'!
title

	^ 'Protocol widget'! !

!ProtocolList methodsFor: 'api' stamp: 'BenjaminVanRyseghem 1/21/2014 16:19'!
displayBlock: aBlock

	protocols displayBlock: aBlock! !

!ProtocolList methodsFor: 'initialization' stamp: 'PeterUhnak 4/12/2015 18:33'!
initializeWidgets

	protocols := self newList.
	label := self newLabel.
	
	label label: 'Protocol'.
	
	self focusOrder add: protocols! !

!ProtocolList methodsFor: 'api' stamp: 'BenjaminVanRyseghem 1/21/2014 15:26'!
items: aCollection

	protocols items: aCollection! !

!ProtocolList methodsFor: 'api-events' stamp: 'BenjaminVanRyseghem 1/21/2014 16:16'!
whenSelectedItemChanged: aBlock

	protocols whenSelectedItemChanged: aBlock! !

!ProtocolList methodsFor: 'api' stamp: 'PeterUhnak 4/12/2015 18:34'!
label: aText

	label label: aText! !

!ProtocolList class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/27/2014 16:33'!
defaultSpec
	<spec: #default>

	^ SpecLayout composed
		newColumn: [ :column |
			column 
				add: #label
				height: self toolbarHeight;
				add: #protocols ];
		yourself! !

!ProtocolOrganizer commentStamp: '<historical>'!
A ProtocolOrganizer is part of a ClassOrganizer. 

It manages the protocols of the class that owns it!
!ProtocolOrganizer methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 4/24/2012 14:16'!
getProtocolNamed: aByteString ifNone: aBlockClosure 
	
	^ protocols detect: [:e | e name = aByteString ] ifNone: aBlockClosure ! !

!ProtocolOrganizer methodsFor: 'backward compatibility' stamp: 'EstebanLorenzano 11/29/2013 16:09'!
methodsInProtocolNamed: aName
	aName = AllProtocol defaultName 
		ifTrue: [ ^ self allMethods ].

	^ (self protocolNamed: aName) methods! !

!ProtocolOrganizer methodsFor: 'protocol - adding' stamp: 'BenjaminVanRyseghem 4/12/2012 14:11'!
addProtocol: aProtocol

	^ protocols add: aProtocol! !

!ProtocolOrganizer methodsFor: 'private' stamp: 'EstebanLorenzano 1/16/2014 11:22'!
moveMethodsFrom: fromProtocolNamed to: toProtocolNamed
	| fromProtocol toProtocol |
	
	fromProtocol := self protocolNamed: fromProtocolNamed.
	toProtocol := self protocolNamed: toProtocolNamed.
	
	toProtocol addAllMethodsFrom: fromProtocol.
	fromProtocol removeAllMethods.
	
	^ toProtocol.! !

!ProtocolOrganizer methodsFor: 'initialization' stamp: 'EstebanLorenzano 6/26/2013 18:01'!
importFrom: aClassOrganizer 
	
	aClassOrganizer categories do: [:cat || protocol methods |
		cat = Protocol nullCategory
			ifFalse: [
				methods := aClassOrganizer listAtCategoryNamed: cat. 
				protocol := self addProtocolNamed: cat asString.
				methods do: [:m |
					protocol  addMethod: m ]]].! !

!ProtocolOrganizer methodsFor: 'testing' stamp: 'EstebanLorenzano 6/27/2013 16:08'!
hasProtocolNamed: aString

	^ self allProtocols anySatisfy: [ :each | each name = aString ]! !

!ProtocolOrganizer methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/12/2012 14:19'!
allProtocol

	^ allProtocol! !

!ProtocolOrganizer methodsFor: 'protocol - adding' stamp: 'EstebanLorenzano 6/21/2013 14:37'!
addProtocolNamed: aName
	^ protocols add: (Protocol name: aName)! !

!ProtocolOrganizer methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 23:07'!
initialize

	super initialize.

	protocols := IdentitySet new.
	allProtocol := AllProtocol protocolOrganizer: self.! !

!ProtocolOrganizer methodsFor: 'protocol - adding' stamp: 'EstebanLorenzano 5/28/2013 14:11'!
classify: aSymbol inProtocolNamed: aProtocolName 
	| name protocol |
	
	name := aProtocolName.
	name = allProtocol name
		ifTrue: [ name := Protocol unclassified ].
		
	"maybe here we should check if this method already belong to another protocol"
	(self protocolsOfSelector: aSymbol) do: [:p | p removeMethod: aSymbol ].
	protocol := self getProtocolNamed: name ifNone: [ self addProtocolNamed: name ].
	
	protocol addMethod: aSymbol
	! !

!ProtocolOrganizer methodsFor: 'importing' stamp: 'BenjaminVanRyseghem 4/13/2012 13:45'!
fromSpec: aSpec
	
	aSpec do: [:spec || name methods |
		name := spec first asSymbol.
		methods := spec allButFirst asSet.
		self addProtocol: (Protocol 
								name: name
								methods: methods) ]! !

!ProtocolOrganizer methodsFor: 'testing' stamp: 'EstebanLorenzano 6/28/2013 16:03'!
includesSelector: selector 
	^ protocols anySatisfy: [ :each | each includesSelector: selector ]! !

!ProtocolOrganizer methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/24/2012 14:38'!
removeMethod: aSymbol

	(self protocolsOfSelector: aSymbol) do: [ :p | p removeMethod: aSymbol ]! !

!ProtocolOrganizer methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/12/2012 15:10'!
allProtocols

	^ { allProtocol }, protocols asArray! !

!ProtocolOrganizer methodsFor: 'accessing' stamp: 'EstebanLorenzano 1/16/2014 11:22'!
renameProtocol: oldName into: newName
	(self existsProtocolNamed: newName) 
		ifTrue: [ 
			self moveMethodsFrom: oldName to: newName.
			self removeProtocolNamed: oldName ] 
		ifFalse: [ 
			^ (self protocolNamed: oldName)
				name: newName;
				yourself ].! !

!ProtocolOrganizer methodsFor: 'protocol' stamp: 'EstebanLorenzano 6/28/2013 16:05'!
protocolsOfSelector: aSelector

	^ (self protocols select: [:each | each includesSelector: aSelector ]) asArray! !

!ProtocolOrganizer methodsFor: 'protocol - removing' stamp: 'EstebanLorenzano 11/29/2013 16:09'!
removeProtocolNamed: aName
	| protocolToRemove |
	
	protocolToRemove := self protocolNamed: aName.
	^ self removeProtocol: protocolToRemove! !

!ProtocolOrganizer methodsFor: 'protocol - removing' stamp: 'EstebanLorenzano 6/27/2013 16:10'!
removeProtocol: aProtocol
	
	aProtocol canBeRemoved
		ifFalse: [ 
			"Virtual protocols who cannot be removed should not raise an error"
			aProtocol isVirtualProtocol 
				ifTrue: [ ^ self ].
			ProtocolRemovalException signal ].
	
	^ protocols 
		remove: aProtocol
		ifAbsent: [ ]! !

!ProtocolOrganizer methodsFor: 'protocol' stamp: 'EstebanLorenzano 6/21/2013 14:51'!
protocolsSorted
	^ (self protocols collect: #name as: Array) sort
		copyWithFirst: allProtocol name! !

!ProtocolOrganizer methodsFor: 'private' stamp: 'MarcusDenker 10/5/2013 21:18'!
existsProtocolNamed: aProtocolName
	
	^self allProtocols anySatisfy: [ :e | e name = aProtocolName ] ! !

!ProtocolOrganizer methodsFor: 'accessing' stamp: 'EstebanLorenzano 11/29/2013 16:09'!
protocolNamed: aName

	^ self 
		protocolNamed: aName 
		ifAbsent: [ Protocol empty ]! !

!ProtocolOrganizer methodsFor: 'protocol - removing' stamp: 'BenjaminVanRyseghem 4/24/2012 14:38'!
removeEmptyProtocols
	
	(self protocols select: [:e | e isEmpty and: [ e canBeRemoved ] ]) 
		do: [:p | self removeProtocol: p ]! !

!ProtocolOrganizer methodsFor: 'accessing' stamp: 'MarcusDenker 11/26/2013 15:56'!
protocols

	^ protocols asArray! !

!ProtocolOrganizer methodsFor: 'protocol' stamp: 'EstebanLorenzano 6/21/2013 15:31'!
classify: aSymbol inProtocolNamed: aProtocolName suppressIfDefault: aBoolean
	| oldProtocols |
	
	oldProtocols := self protocolsOfSelector: aSymbol.

	self 
		classify: aSymbol 
		inProtocolNamed: aProtocolName.
		
	aBoolean ifTrue: [
		(oldProtocols 
			select: #canBeRemoved)
			do: [:e | self removeProtocol: e ] ].! !

!ProtocolOrganizer methodsFor: 'accessing' stamp: 'EstebanLorenzano 6/27/2013 18:03'!
protocolsNames

	^ protocols 
		collect: #name 
		as: Array! !

!ProtocolOrganizer methodsFor: 'accessing' stamp: 'EstebanLorenzano 11/29/2013 16:08'!
protocolNamed: aString ifAbsent: aBlock 
	^  self allProtocols 
		detect: [ :e | e name = aString ] 
		ifNone: aBlock! !

!ProtocolOrganizer methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/4/2013 14:45'!
extensionProtocols
	^ self protocols select: #isExtensionProtocol! !

!ProtocolOrganizer methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/12/2012 15:12'!
allProtocolsNames

	^ self allProtocols collect: #name! !

!ProtocolOrganizer methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/12/2012 14:17'!
allMethods

	^ self protocols gather: [:p | p methods ].! !

!ProtocolOrganizer methodsFor: 'backward compatibility - file in/out' stamp: 'BenjaminVanRyseghem 4/12/2012 18:10'!
stringForFileOut

	^ String streamContents: [:aStream | 
			self protocols do: [:p | 
				aStream << $( << p name printString.
				p methods do: [:m |
					aStream << ' ' << m asString ].
				aStream << $); cr ]]! !

!ProtocolOrganizer class methodsFor: 'import' stamp: 'BenjaminVanRyseghem 4/13/2012 13:45'!
fromSpec: aSpec
	
	^ self new
		fromSpec: aSpec;
		yourself! !

!ProtocolOrganizer class methodsFor: 'import' stamp: 'BenjaminVanRyseghem 4/12/2012 14:35'!
importFrom: aClassOrganizer
	
	^ self new
		importFrom: aClassOrganizer;
		yourself! !

!ProtocolRemovalException commentStamp: '<historical>'!
A ProtocolRemovalException is an error raised when someone try to remove a protocol that should not be removed!
!ProtocolRemoved commentStamp: '<historical>'!
This class is not used, but should be used when we hook into the addition and removal of protocols. Right now, we only get ClassReorganizedAnnouncement!
!ProtocolViewer commentStamp: 'BernardoContreras 3/7/2015 01:31'!
I am a widget gathering a list of models with two protocol list:one for the methods in 'api', the other for the methods in 'api-events'.

I am used to expose the construction of a spec UI in the Spec documentation.!
!ProtocolViewer methodsFor: 'api-events' stamp: 'BenjaminVanRyseghem 1/21/2014 16:16'!
whenEventChangedDo: aBlock

	events whenSelectedItemChanged: aBlock! !

!ProtocolViewer methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/21/2014 15:33'!
protocols
	^ protocols! !

!ProtocolViewer methodsFor: 'initialization' stamp: 'BernardoContreras 3/7/2015 01:31'!
initializePresenter

	models whenSelectedItemChanged: [ :class |
		protocols resetSelection.
		events resetSelection.
		class
			ifNil: [ 
				protocols items: #().
				events items: #() ]
			ifNotNil: [ 
				protocols items: (self methodsIn: class for: 'api').
				events items: (self methodsIn: class for: 'api-events') ] ].
	
	protocols whenSelectedItemChanged: [ :method | method ifNotNil: [ self resetEventSelection ] ].
	events whenSelectedItemChanged: [ :method | method ifNotNil: [ self resetProtocolSelection ] ].! !

!ProtocolViewer methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/21/2014 15:33'!
events
	^ events! !

!ProtocolViewer methodsFor: 'api' stamp: 'BenjaminVanRyseghem 1/21/2014 16:15'!
resetEventSelection

	events resetSelection! !

!ProtocolViewer methodsFor: 'private' stamp: 'BenjaminVanRyseghem 1/21/2014 16:21'!
methodsIn: class for: protocol

	^ (class methodsInProtocol: protocol)
		sorted: [ :a :b | a selector < b selector ]! !

!ProtocolViewer methodsFor: 'api' stamp: 'BenjaminVanRyseghem 1/21/2014 16:38'!
title

	^ 'Protocol viewer'! !

!ProtocolViewer methodsFor: 'api-events' stamp: 'BenjaminVanRyseghem 1/21/2014 16:22'!
whenClassChanged: aBlock

	models whenSelectedItemChanged: aBlock! !

!ProtocolViewer methodsFor: 'initialization' stamp: 'BernardoContreras 3/7/2015 01:32'!
initializeWidgets

	models := self instantiate: ModelList.
	protocols := self instantiate: ProtocolList.
	events := self instantiate: ProtocolList.
	
	protocols
		label: 'api';
		displayBlock: [ :m | m selector ].
	events
		label: 'api-events';
		displayBlock: [ :m | m selector ].
		
	self focusOrder 
		add: models;
		add: protocols;
		add: events
		! !

!ProtocolViewer methodsFor: 'api' stamp: 'BenjaminVanRyseghem 1/21/2014 16:15'!
resetProtocolSelection

	protocols resetSelection! !

!ProtocolViewer methodsFor: 'api-events' stamp: 'BenjaminVanRyseghem 1/21/2014 16:16'!
whenProtocolChangedDo: aBlock

	protocols whenSelectedItemChanged: aBlock! !

!ProtocolViewer methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/21/2014 15:33'!
models
	^ models! !

!ProtocolViewer class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/27/2014 16:33'!
defaultSpec
	<spec: #default>
	
	^ SpecLayout composed
		newColumn: [ :column |
			column 
				add: #models; 
				add: #protocols; 
				add: #events ];
		yourself! !

!PrototypeTester commentStamp: 'StephaneDucasse 12/28/2014 11:26'!
I am a simple holder of a prototype object and hand out copies when requested.
My subclasses should define resultFor: a!
!PrototypeTester methodsFor: 'operation' stamp: 'StephaneDucasse 12/28/2014 11:29'!
resultFor: runs 
	"Test that equality is the same over runs and answer the result"
	
	self subclassResponsibility! !

!PrototypeTester methodsFor: 'accessing' stamp: 'stephaneducasse 2/3/2006 22:39'!
prototype: aPrototype 
	"Set my prototype"
	prototype := aPrototype copy ! !

!PrototypeTester methodsFor: 'operation' stamp: 'mjr 8/20/2003 18:57'!
result
	"Perform the test the default number of times"
	^ self resultFor: self class defaultRuns ! !

!PrototypeTester methodsFor: 'accessing' stamp: 'mjr 8/20/2003 18:56'!
prototype
	"Get a prototype"
	^ prototype copy ! !

!PrototypeTester class methodsFor: 'default' stamp: 'StephaneDucasse 12/28/2014 11:28'!
defaultRuns
	"Returns the default number of times to test"
	^ 50! !

!PrototypeTester class methodsFor: 'instance creation' stamp: 'StephaneDucasse 12/28/2014 11:27'!
with: aPrototype
	^ self new prototype:aPrototype! !

!ProvideAnswerNotification commentStamp: 'TorstenBergmann 1/31/2014 11:56'!
Notify to provide an answer!
!PseudoClass commentStamp: '<historical>'!
I provide an inert model of a Class, used by FileContentsBrowser to manipulate filedout code. Instead of a method dictionary or selectors onto CompiledMethods, I have a dictionary ("source") of selectors onto ChangeRecords, which were, in the case of FileContentsBrowser, parsed from a source or change set file.!
!PseudoClass methodsFor: 'categories' stamp: ''!
removedCategoryName
	^'*** removed methods ***' asSymbol! !

!PseudoClass methodsFor: 'class' stamp: ''!
comment: aString
	self commentString: aString.! !

!PseudoClass methodsFor: 'filein/fileout' stamp: ''!
fileInCategory: aCategory
	^self fileInMethods: (self organization listAtCategoryNamed: aCategory)! !

!PseudoClass methodsFor: 'categories' stamp: ''!
removeCategory: selector
	(self organization listAtCategoryNamed: selector) do:[:sel|
		self organization removeElement: sel.
		self sourceCode removeKey: sel.
	].
	self organization removeCategory: selector.! !

!PseudoClass methodsFor: 'filein/fileout' stamp: 'PeterHugossonMiller 9/3/2009 10:52'!
fileOutCategory: categoryName

	| internalStream |
	internalStream := (String new: 1000) writeStream.
	self fileOutMethods: (self organization listAtCategoryNamed: categoryName)
			on: internalStream.
	FileStream writeSourceCodeFrom: internalStream baseName: (self name, '-', categoryName) isSt: true! !

!PseudoClass methodsFor: 'organization updating' stamp: 'MarcusDenker 10/3/2013 17:09'!
notifyOfRecategorizedSelector: aString from: aString2 to: aString3 
! !

!PseudoClass methodsFor: 'class' stamp: ''!
metaClass
	^metaClass ifNil:[metaClass := PseudoMetaclass new name: (self name)].! !

!PseudoClass methodsFor: 'accessing' stamp: 'nk 3/9/2004 10:24'!
instVarNames
	^ #()! !

!PseudoClass methodsFor: 'accessing' stamp: 'nk 4/29/2004 06:59'!
allCallsOn
	^ (self realClass ifNil: [ ^#() ]) allCallsOn! !

!PseudoClass methodsFor: 'filein/fileout' stamp: ''!
fileInMethods
	^self fileInMethods: self selectors! !

!PseudoClass methodsFor: 'class' stamp: 'MarcusDenker 7/5/2014 18:58'!
comment
	| rStr |
	rStr := self organization commentRemoteString.
	^rStr isNil
		ifTrue:[self name,' has not been commented in this file']
		ifFalse:[rStr string]! !

!PseudoClass methodsFor: 'categories' stamp: ''!
whichCategoryIncludesSelector: aSelector 
	"Answer the category of the argument, aSelector, in the organization of 
	the receiver, or answer nil if the receiver does not inlcude this selector."

	^ self organization categoryOfElement: aSelector! !

!PseudoClass methodsFor: 'removing' stamp: ''!
removeAllUnmodified
	| stClass |
	self exists ifFalse:[^self].
	self removeUnmodifiedMethods: self selectors.
	stClass := self realClass.
	(self hasDefinition and:[stClass definition = self definition]) ifTrue:[definition := nil].
	(self hasComment and:[stClass comment asString = self commentString]) ifTrue:[ self classComment: nil].
	metaClass isNil ifFalse:[metaClass removeAllUnmodified].! !

!PseudoClass methodsFor: 'testing' stamp: 'StephaneDucasse 2/20/2010 21:50'!
needsInitialize
	^self hasMetaclass 
		and: [self metaClass includesSelector: #initialize]! !

!PseudoClass methodsFor: 'filein/fileout' stamp: ''!
fileOutOn: aStream
	"FileOut the receiver"
	self fileOutDefinitionOn: aStream.
	metaClass ifNotNil:[metaClass fileOutDefinitionOn: aStream].
	self fileOutMethods: self selectors on: aStream.
	metaClass ifNotNil:[metaClass fileOutMethods: metaClass selectors on: aStream].! !

!PseudoClass methodsFor: 'accessing' stamp: 'wod 5/19/1998 17:42'!
theNonMetaClass
	"Sent to a class or metaclass, always return the class"

	^self! !

!PseudoClass methodsFor: 'private' stamp: 'MarcusDenker 8/28/2013 10:18'!
evaluate: aString
	
	^self compiler
		source: aString;
		logged: true;
		evaluate
	
! !

!PseudoClass methodsFor: 'private' stamp: 'lr 3/14/2010 21:13'!
makeSureSuperClassExists: aString
	| theClass |
	theClass := Smalltalk globals at: aString asSymbol ifAbsent: [ nil ].
	theClass ifNotNil: [ ^ true ].
	^ self confirm: 'The super class ' , aString , ' does not exist in the system. Use nil instead?'! !

!PseudoClass methodsFor: 'printing' stamp: 'MarcusDenker 11/1/2014 08:04'!
printSubclassesOn: aStream level: level 
	"As part of the algorithm for printing a description of the receiver, print the
	subclass on the file stream, aStream, indenting level times."

	| subclassNames |
	aStream crtab: level.
	aStream nextPutAll: self name.
	aStream space; print: self instVarNames.
	self == Class
		ifTrue: 
			[aStream crtab: level + 1; nextPutAll: '[ ... all the Metaclasses ... ]'.
			^self].
	subclassNames := self subclasses asSortedCollection:[:c1 :c2| c1 name <= c2 name].
	"Print subclasses in alphabetical order"
	subclassNames do:
		[:subclass | subclass printSubclassesOn: aStream level: level + 1]! !

!PseudoClass methodsFor: 'class' stamp: 'ar 2/5/2004 15:18'!
commentString
	^self comment asString! !

!PseudoClass methodsFor: 'testing' stamp: 'lr 3/14/2010 21:13'!
exists
	^ (Smalltalk globals at: self name asSymbol ifAbsent: [ ^ false ]) isKindOf: Behavior! !

!PseudoClass methodsFor: 'methods' stamp: ''!
removeMethod: selector
	self organization removeElement: selector.
	self sourceCode removeKey: selector.
! !

!PseudoClass methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/2/2013 14:47'!
organization
	^ organization ifNil: [organization := PseudoClassOrganization forClass: self ].
	! !

!PseudoClass methodsFor: 'testing method dictionary' stamp: 'marcus.denker 11/10/2008 10:04'!
bindingOf: varName
	self exists ifTrue:[
		(self realClass bindingOf: varName) ifNotNil:[:binding| ^binding].
	].
	^Smalltalk bindingOf: varName asSymbol! !

!PseudoClass methodsFor: 'methods' stamp: ''!
removeSelector: aSelector
	| catName |
	catName := self removedCategoryName.
	self organization addCategory: catName before: self organization categories first.
	self organization classify: aSelector under: catName.
	self sourceCodeAt: aSelector put:'methodWasRemoved' asText.! !

!PseudoClass methodsFor: 'private' stamp: 'StephaneDucasse 10/26/2014 18:08'!
confirmRemovalOf: aString
	^self confirm: 'Remove ',aString,' ?'! !

!PseudoClass methodsFor: 'accessing' stamp: ''!
fullName
	^self name! !

!PseudoClass methodsFor: 'testing' stamp: ''!
hasMetaclass
	^metaClass notNil! !

!PseudoClass methodsFor: 'accessing' stamp: 'nk 2/18/2004 18:32'!
allSuperclasses
	^ (self realClass ifNil: [ ^#() ]) allSuperclasses! !

!PseudoClass methodsFor: 'methods' stamp: ''!
sourceCodeTemplate
	^''! !

!PseudoClass methodsFor: 'accessing' stamp: 'StephaneDucasse 4/30/2011 21:38'!
allCallsOnIn: aSystemNavigation
	^ (self realClass ifNil: [ ^#() ]) allCallsOn! !

!PseudoClass methodsFor: 'private' stamp: 'nk 2/18/2004 18:33'!
allSubclassesWithLevelDo: classAndLevelBlock startingLevel: level
	^ (self realClass ifNil: [ ^self ])  allSubclassesWithLevelDo: classAndLevelBlock startingLevel: level! !

!PseudoClass methodsFor: '*MonticelloGUI' stamp: 'MartinDias 11/7/2013 18:11'!
asClassDefinition
	^ MCClassDefinition
		name: self name
		superclassName: self superclass name
		category: self category 
		instVarNames: self instVarNames
		classVarNames: self classVarNames asSortedCollection
		poolDictionaryNames: self sharedPoolNames
		classInstVarNames: self class instVarNames
		type: self typeOfClass
		comment: self organization classComment	 asString
		commentStamp: self organization commentStamp	! !

!PseudoClass methodsFor: 'accessing' stamp: ''!
name: anObject
	name := anObject! !

!PseudoClass methodsFor: 'class' stamp: ''!
commentString: aString
	self classComment: aString asText. "Just wrap it"! !

!PseudoClass methodsFor: 'filein/fileout' stamp: 'nice 1/5/2010 15:59'!
fileInMethods: aCollection
	"FileIn all methods with selectors taken from aCollection"
	| theClass |
	self exists ifFalse:[^self classNotDefined].
	theClass := self realClass.
	aCollection do:[:sel| | cat |
		cat := self organization categoryOfElement: sel.
		cat = self removedCategoryName ifFalse:[
			theClass 
				compile: (self sourceCodeAt: sel) 
				classified: cat
				withStamp: (self stampAt: sel)
				notifying: nil.
		].
	].! !

!PseudoClass methodsFor: 'filein/fileout' stamp: ''!
fileIn
	"FileIn the receiver"
	self hasDefinition ifTrue:[self fileInDefinition].
	self fileInMethods: self selectors.
	metaClass ifNotNil:[metaClass fileIn].
	self needsInitialize ifTrue:[
		self evaluate: self name,' initialize'.
	].! !

!PseudoClass methodsFor: 'methods' stamp: ''!
sourceCodeAt: sel
	^(self sourceCode at: sel) string! !

!PseudoClass methodsFor: 'accessing' stamp: ''!
name
	^name! !

!PseudoClass methodsFor: 'filein/fileout' stamp: 'PeterHugossonMiller 9/3/2009 10:52'!
fileOutMethod: selector
	| internalStream |

	internalStream := (String new: 1000) writeStream.

	self fileOutMethods: (Array with: selector) on: internalStream.

	FileStream writeSourceCodeFrom: internalStream baseName: (self name , '-' , (selector copyReplaceAll: ':' with: '')) isSt: true! !

!PseudoClass methodsFor: 'errors' stamp: ''!
classNotDefined
	^self inform: self name,' is not defined in the system.
You have to define this class first.'.! !

!PseudoClass methodsFor: 'filein/fileout' stamp: 'ar 2/7/2004 01:04'!
fileOutMethods: aCollection on: aStream
	"FileOut all methods with selectors taken from aCollection"
	| cat categories |
	categories := Dictionary new.
	aCollection do:[:sel|
		cat := self organization categoryOfElement: sel.
		cat = self removedCategoryName ifFalse:[
			(categories includesKey: cat) 
				ifFalse:[categories at: cat put: Set new].
			(categories at: cat) add: sel].
	].
	categories associationsDo:[:assoc|
		cat := assoc key.
		assoc value do:[:sel|
			aStream cr.
			(self sourceCode at: sel) fileOutOn: aStream.
		].
	].! !

!PseudoClass methodsFor: 'testing' stamp: 'MarcusDenker 7/5/2014 18:58'!
hasComment
	^self organization commentRemoteString notNil! !

!PseudoClass methodsFor: 'methods' stamp: 'sw 6/10/2003 17:31'!
stampAt: selector
	"Answer the authoring time-stamp of the change"

	| code |
	^ ((code := self sourceCode at: selector) isKindOf: ChangeRecord)
		ifTrue:
			[code stamp]
		ifFalse:
			[code string]! !

!PseudoClass methodsFor: 'class' stamp: 'di 1/13/1999 12:00'!
sharedPools 
	self exists ifFalse: [^ nil].
	^ self realClass sharedPools! !

!PseudoClass methodsFor: 'class' stamp: ''!
definition: aString
	definition := aString! !

!PseudoClass methodsFor: 'class' stamp: ''!
classComment: aChangeRecord
	self organization classComment: aChangeRecord! !

!PseudoClass methodsFor: 'methods' stamp: 'MarcusDenker 4/28/2013 11:15'!
addMethodChange: aChangeRecord
	| selector |
	selector := self compiler parseSelector: aChangeRecord string.
	self organization classify: selector under: aChangeRecord category.
	self sourceCodeAt: selector put: aChangeRecord! !

!PseudoClass methodsFor: 'filein/fileout' stamp: 'ar 7/16/2005 14:06'!
fileInDefinition
	self hasDefinition ifFalse:[^self].
	(self makeSureSuperClassExists: (definition copyUpTo: Character space)) ifFalse:[^self].
	self hasDefinition ifTrue:[
		Transcript cr; show:'Defining ', self name.
		self evaluate: self definition].
	self exists ifFalse:[^self].
	self hasComment ifTrue:[self realClass classComment: self comment].! !

!PseudoClass methodsFor: 'testing' stamp: 'marcus.denker 7/29/2009 15:27'!
hasChanges

	self sourceCode isEmpty ifFalse:[^true].
	self organization hasComment ifTrue:[^true].
	definition isNil ifFalse:[^true].
	metaClass isNil ifFalse:[^metaClass hasChanges].
	^false! !

!PseudoClass methodsFor: 'filein/fileout' stamp: ''!
fileOutMethodsOn: aStream
	^self fileOutMethods: self selectors on: aStream.! !

!PseudoClass methodsFor: 'filein/fileout' stamp: ''!
fileInMethod: selector
	^self fileInMethods: (Array with: selector)! !

!PseudoClass methodsFor: 'filein/fileout' stamp: 'MarcusDenker 7/19/2014 12:29'!
fileOutDefinitionOn: aStream
	self hasDefinition
		ifFalse: [ ^ self ].
	aStream
		nextChunkPut: self definition;
		cr.
	self hasComment
		ifFalse: [ ^ self ].
	aStream cr.
	self organization commentRemoteString fileOutOn: aStream! !

!PseudoClass methodsFor: 'printing' stamp: 'MarcusDenker 11/1/2014 08:04'!
printHierarchy
	"Answer a description containing the names and instance variable names 
	of all of the subclasses and superclasses of the receiver."

	| aStream index |
	index := 0.
	aStream := (String new: 16) writeStream.
	self allSuperclasses reverseDo: 
		[:aClass | 
		aStream crtab: index.
		index := index + 1.
		aStream nextPutAll: aClass name.
		aStream space.
		aStream print: aClass instVarNames].
	aStream cr.
	self printSubclassesOn: aStream level: index.
	^aStream contents! !

!PseudoClass methodsFor: 'accessing' stamp: 'NorbertHartl 6/20/2008 21:25'!
theMetaClass
	^ self metaClass! !

!PseudoClass methodsFor: 'testing' stamp: ''!
hasDefinition
	^definition notNil! !

!PseudoClass methodsFor: 'methods' stamp: ''!
methodChange: aChangeRecord
	aChangeRecord isMetaClassChange ifTrue:[
		^self metaClass addMethodChange: aChangeRecord.
	] ifFalse:[
		^self addMethodChange: aChangeRecord.
	].
! !

!PseudoClass methodsFor: 'accessing' stamp: 'jb 7/1/2011 10:54'!
compilerClass
	^ (Smalltalk globals at: name ifAbsent: [ ^ self class compilerClass ]) compilerClass! !

!PseudoClass methodsFor: 'printing' stamp: 'ar 2/5/2004 16:04'!
printOn: aStream
	super printOn: aStream.
	aStream nextPut:$(; print: name; nextPut:$)! !

!PseudoClass methodsFor: 'methods' stamp: 'StephaneDucasse 2/20/2010 21:53'!
includesSelector: aSymbol 
	"Answer whether the message whose selector is the argument is in the 
	method dictionary of the receiver's class."

	^ self exists
		ifTrue: [self realClass includesSelector: aSymbol]
		ifFalse: [false]
		
	"Note that this method is only used to check whether the class should initialized so returning false is better than raising an error"! !

!PseudoClass methodsFor: 'methods' stamp: ''!
sourceCode
	^source ifNil:[source := Dictionary new]! !

!PseudoClass methodsFor: 'class' stamp: 'LC 10/8/2001 04:46'!
definition
	| link linkText defText |
	^definition ifNil:
		[defText := Text fromString: 'There is no class definition for '.
		link := TextLink new.
		linkText := link analyze: self name with: 'Definition'.
		linkText := Text string: (linkText ifNil: ['']) attribute: link.
		defText append: linkText; append: ' in this file'].! !

!PseudoClass methodsFor: 'accessing' stamp: 'sma 6/16/1999 22:59'!
allInstVarNames
	^#()! !

!PseudoClass methodsFor: 'override' stamp: 'nk 2/18/2004 18:30'!
isMeta
	^false! !

!PseudoClass methodsFor: 'accessing' stamp: 'lr 3/14/2010 21:13'!
realClass
	^ Smalltalk globals at: self name asSymbol ifAbsent: [  ]! !

!PseudoClass methodsFor: 'class' stamp: 'di 1/13/1999 12:00'!
classPool 
	self exists ifFalse: [^ nil].
	^ self realClass classPool! !

!PseudoClass methodsFor: 'removing' stamp: ''!
removeUnmodifiedMethods: aCollection
	| stClass |
	self exists ifFalse:[^self].
	stClass := self realClass.
	aCollection do:[:sel|
		(self sourceCodeAt: sel) = (stClass sourceCodeAt: sel ifAbsent:['']) asString ifTrue:[
			self removeMethod: sel.
		].
	].
	self organization removeEmptyCategories.! !

!PseudoClass methodsFor: 'methods' stamp: ''!
sourceCodeAt: sel put: object
	self sourceCode at: sel put: object! !

!PseudoClass methodsFor: 'accessing' stamp: 'MarcusDenker 4/28/2013 20:05'!
compiler
	^ self compilerClass new! !

!PseudoClass methodsFor: 'class' stamp: 'nk 2/18/2004 18:30'!
renameTo: aString

	self hasDefinition ifTrue:[
		self isMeta ifTrue:[
			self definition: (self definition
				copyReplaceAll: name,' class'
				with: aString, ' class').
		] ifFalse:[
			self definition: (self definition 
					copyReplaceAll:'ubclass: #',name
					with:'ubclass: #', aString)]].
	name := aString.
	metaClass ifNotNil:[metaClass renameTo: aString].! !

!PseudoClass methodsFor: 'accessing' stamp: 'IgorStasenko 10/13/2013 21:00'!
users

	^ #()! !

!PseudoClass methodsFor: 'methods' stamp: 'StephaneDucasse 10/15/2013 22:19'!
selectors
	^self sourceCode keys sorted! !

!PseudoClass methodsFor: 'filein/fileout' stamp: 'PeterHugossonMiller 9/3/2009 10:52'!
fileOut
	| internalStream |
	internalStream := (String new: 1000) writeStream.
	self fileOutOn: internalStream.
	self needsInitialize ifTrue:[
		internalStream cr; nextChunkPut: self name,' initialize'.
	].

	FileStream writeSourceCodeFrom: internalStream baseName: self name isSt: true! !

!PseudoClass methodsFor: 'accessing' stamp: 'MarcusDenker 11/1/2014 08:08'!
subclasses
	^ (self realClass ifNil: [ ^#() ]) subclasses! !

!PseudoClassOrganization commentStamp: '<historical>'!
I'm a pseudo class organization. 
I override the use of RemoteString to store class coments. !
!PseudoClassOrganization methodsFor: 'comment accessing' stamp: 'EstebanLorenzano 10/2/2013 14:45'!
classComment: aChangeRecord
	comment := aChangeRecord! !

!PseudoClassOrganization methodsFor: 'comment accessing' stamp: 'EstebanLorenzano 10/2/2013 14:45'!
classComment
	"Answer the comment associated with the object that refers to the receiver."

	comment ifNil: [ ^ '' ].
	
	^ comment! !

!PseudoMetaclass commentStamp: 'TorstenBergmann 1/31/2014 10:17'!
I provide an inert model of a Metaclass, used by FileContentsBrowser to manipulate filedout code. !
!PseudoMetaclass methodsFor: 'accessing' stamp: ''!
realClass
	^super realClass class! !

!PseudoMetaclass methodsFor: 'accessing' stamp: 'FBS 3/4/2004 14:17'!
theNonMetaClass
	"Sent to a class or metaclass, always return the class"

	^self realClass theNonMetaClass! !

!PseudoMetaclass methodsFor: 'testing' stamp: 'nk 2/18/2004 18:30'!
isMeta
	^true! !

!PseudoMetaclass methodsFor: 'accessing' stamp: ''!
fullName
	^self name,' class'! !

!QSystemTally commentStamp: '<historical>'!
Tally for assembling system profiles. It's a subclass of Link so we can chain tallies together in the receivers list.!
!QSystemTally methodsFor: 'accessing' stamp: 'ar 6/11/2007 21:58'!
tally
	"Answer the tally count for this node"
	^tally! !

!QSystemTally methodsFor: 'report' stamp: 'AlexandreBergel 1/29/2013 11:11'!
getNewTabsFor: tabs
	^ tabs size < self maxTabs
		ifTrue: [ tabs ]
		ifFalse: [ (tabs select: [ :x | x = '[' ]) copyWith: '[' ]! !

!QSystemTally methodsFor: 'accessing' stamp: 'ar 6/11/2007 22:24'!
maxClassPlusSelectorSize
	"Return the default maximum width of the class plus selector together (not counting the '>>')"
	^60! !

!QSystemTally methodsFor: 'copying' stamp: 'ar 6/11/2007 22:31'!
copyWithTally: hitCount
	^ (QSystemTally new class: class method: method) bumpBy: hitCount! !

!QSystemTally methodsFor: 'accessing' stamp: 'bgf 3/6/2008 12:21'!
maxTabs
	"Return the default number of tabs after which leading white space is compressed"
	^36! !

!QSystemTally methodsFor: 'report' stamp: 'AlexandreBergel 1/29/2013 11:00'!
printOn: aStream total: total totalTime: totalTime tallyExact: isExact 
	| className myTally aClass percentage |
	isExact ifTrue:[
		myTally := tally.
		receivers ifNotNil: [ receivers asArray do: [ :r | myTally := myTally - r tally ] ].
		aStream print: myTally; space.
	] ifFalse:[
		percentage := tally asFloat / total * 100.0 roundTo: 0.1.
		aStream print: percentage; nextPutAll: ' (';
				nextPutAll: (percentage * totalTime / 100) rounded asStringWithCommas;
				nextPutAll: ')  '.
	].
	self isPrimitives ifTrue:[
		aStream nextPutAll: 'primitives'; cr
	] ifFalse:[
		aClass := method methodClass.
		className := aClass name contractTo: self maxClassNameSize.
		aStream nextPutAll: class name;
				nextPutAll: (aClass = class 
							ifTrue: ['  ']
							ifFalse: [' [' , aClass name , ']  ']);
				nextPutAll: (method selector
							contractTo: self maxClassPlusSelectorSize - className size);
				cr.
	].! !

!QSystemTally methodsFor: 'report' stamp: 'AlexandreBergel 1/29/2013 11:00'!
sonsOver: threshold
	"Answer the sons with tallys over the given threshold"
	"threshold is a number "
	receivers ifNil: [ ^ #() ].
	^ receivers asArray select: [ :son | son tally > threshold ].! !

!QSystemTally methodsFor: 'report' stamp: 'AlexandreBergel 1/29/2013 11:11'!
treePrintOn: aStream tabs: tabs thisTab: myTab total: total totalTime: totalTime tallyExact: isExact orThreshold: threshold
	"aStream contains the output of the print "

	"tabs is a collection of strings "

	| sons sonTab |
	tabs do: [ :tab | aStream nextPutAll: tab ].
	tabs size > 0
		ifTrue: [ 
			self
				printOn: aStream
				total: total
				totalTime: totalTime
				tallyExact: isExact ].
	sons := isExact
		ifTrue: [ receivers ]
		ifFalse: [ self sonsOver: threshold ].
	sons isNil
		ifTrue: [ ^ self ].
	sons notEmpty
		ifTrue: [ 
			tabs addLast: myTab.
			sons := self asSortedCollection: sons.
			1 to: sons size do: [ :i | 
				sonTab := i < sons size
					ifTrue: [ '  |' ]
					ifFalse: [ '  ' ].
				(sons at: i)
					treePrintOn: aStream
					tabs: (self getNewTabsFor: tabs)
					thisTab: sonTab
					total: total
					totalTime: totalTime
					tallyExact: isExact
					orThreshold: threshold ].
			tabs removeLast ]! !

!QSystemTally methodsFor: 'printing' stamp: 'MarcusDenker 4/21/2013 18:02'!
printOn: aStream
	aStream print: class; nextPutAll: '>>'; print: (method ifNotNil:[method selector]).
	aStream nextPutAll: ' -- '; print: tally.! !

!QSystemTally methodsFor: 'report' stamp: 'AlexandreBergel 1/29/2013 10:34'!
bump: hitCount fromSender: senderTally
	"Add this hitCount to the total, and include a reference to the
	sender responsible for the increment"
	self bumpBy: hitCount.
	senders ifNil: [ senders := OrderedCollection new ].
	senderTally ifNotNil: [ senders add: (senderTally copyWithTally: hitCount) ]! !

!QSystemTally methodsFor: 'report' stamp: 'AlexandreBergel 1/29/2013 11:43'!
leavesPrintOn: aStream tallyExact: isExact orThreshold: threshold time: totalTime
	"@TODO: Apparently, providing true as isExact will always produce an error "
	| dict |
	dict := IdentityDictionary new: 100.
	self leavesInto: dict fromSender: nil.
	isExact 
		ifTrue: [
			(self asSortedCollection: dict) do: [ :node |
				node printOn: aStream total: tally totalTime: nil tallyExact: isExact.
				node printSenderCountsOn: aStream ] ] 
		ifFalse:[
			((self asSortedCollection: dict)
				select: [ :node | node tally > threshold ]) do: [ :node |
					node printOn: aStream total: tally totalTime: totalTime tallyExact: isExact ] ]! !

!QSystemTally methodsFor: 'initialize' stamp: 'ar 6/11/2007 22:07'!
class: aClass method: aCompiledMethod
	class := aClass.
	method := aCompiledMethod.
	tally := 0.! !

!QSystemTally methodsFor: 'converting' stamp: 'AlexandreBergel 1/29/2013 10:33'!
asArray
	| link |
	^Array streamContents: [ :s |
		link := self.
		[link == nil] whileFalse: [
			s nextPut: link.
			link := link nextLink.
		].
	].! !

!QSystemTally methodsFor: 'tallying' stamp: 'ar 6/11/2007 21:54'!
bumpBy: count
	"Bump this tally by the specified amount"
	tally := tally + count! !

!QSystemTally methodsFor: 'report' stamp: 'ar 6/11/2007 22:28'!
fullPrintOn: aStream tallyExact: isExact orThreshold: perCent time: totalTime
	| threshold |  
	isExact ifFalse: [threshold := (perCent asFloat / 100 * tally) rounded].
	aStream nextPutAll: '**Tree**'; cr.
	self treePrintOn: aStream
		tabs: OrderedCollection new
		thisTab: ''
		total: tally
		totalTime: totalTime
		tallyExact: isExact
		orThreshold: threshold.
	aStream nextPut: Character newPage; cr.
	aStream nextPutAll: '**Leaves**'; cr.
	self leavesPrintOn: aStream
		tallyExact: isExact
		orThreshold: threshold
		time: totalTime.! !

!QSystemTally methodsFor: 'accessing' stamp: 'ar 6/11/2007 21:57'!
method
	"Answer the CompiledMethod associated with this tally"
	^method! !

!QSystemTally methodsFor: 'tallying' stamp: 'ar 2/27/2008 12:01'!
tallyMethod: aMethod by: count
	"Called explicitly and needs to decrement receiver's tally count"
	| node |
	node := receivers.
	[node == nil] whileFalse:[
		node method == aMethod ifTrue:[^node bumpBy: count].
		node := node nextLink.
	].
	node := QSystemTally new class: aMethod methodClass method: aMethod.
	node nextLink: receivers.
	receivers := node.
	^node bumpBy: count! !

!QSystemTally methodsFor: 'initialize' stamp: 'ar 6/11/2007 22:50'!
primitives: anInteger
	"Make the receiver be a node of unassigned primitives"
	tally := anInteger.
	method := nil. "indicates primitives"! !

!QSystemTally methodsFor: 'report' stamp: 'MarcusDenker 6/14/2014 12:24'!
into: leafDict fromSender: senderTally
	| leafNode |
	leafNode := leafDict at: method ifAbsentPut: [ QSystemTally new class: class method: method ].
	leafNode bump: tally fromSender: senderTally! !

!QSystemTally methodsFor: 'accessing' stamp: 'ar 6/11/2007 22:24'!
maxClassNameSize
	"Return the default maximum width of the class name alone"
	^30! !

!QSystemTally methodsFor: 'report' stamp: 'ar 6/11/2007 22:29'!
leavesInto: leafDict fromSender: senderTally
	| rcvrs |
	rcvrs := self sonsOver: 0.
	rcvrs size = 0
		ifTrue: [self into: leafDict fromSender: senderTally]
		ifFalse: [rcvrs do:[:node |
				node isPrimitives
					ifTrue: [node leavesInto: leafDict fromSender: senderTally]
					ifFalse: [node leavesInto: leafDict fromSender: self]]]! !

!QSystemTally methodsFor: 'tallying' stamp: 'MarcusDenker 6/14/2014 12:23'!
tallyPath: context by: count
	"Tally the context chain"

	| aMethod aTally |
	aMethod := context method.
	aTally := receivers.
	[ aTally isNil ]
		whileFalse: [ 
			aTally method == aMethod
				ifTrue: [ ^ aTally bumpBy: count ].
			aTally := aTally nextLink ].
	aTally := QSystemTally new class: context receiver class method: aMethod.
	aTally nextLink: receivers.
	receivers := aTally.
	^ aTally bumpBy: count! !

!QSystemTally methodsFor: 'testing' stamp: 'MarcusDenker 6/30/2014 13:28'!
isPrimitives
	"Detect pseudo node used to carry tally of local hits"

	^ method isNil! !

!QSystemTally methodsFor: 'tallying' stamp: 'ar 6/11/2007 22:01'!
tally: context by: count
	"Explicitly tally the specified context and its stack."
	| root |
	(root := context home sender) 
		ifNil:[^(self bumpBy: count) tallyPath: context by: count]
		ifNotNil:[^(self tally: root by: count) tallyPath: context by: count]! !

!QSystemTally methodsFor: 'converting' stamp: 'AlexandreBergel 1/29/2013 10:33'!
asSortedCollection: aCollection
	"Create a sorted collection from the given input"
	^aCollection asSortedCollection: [ :tA :tB | tA tally >= tB tally ]! !

!QSystemTally class methodsFor: 'LICENSE' stamp: 'RJT 1/23/2013 15:34'!
LICENSE
	^'Project Squeak

	In Memory of Andreas Raab.  Author, Friend, Colleague. 	http://forum.world.st/In-Memory-of-Andreas-Raab-td4663424.html
	Copyright (c) 2005-2013, 3D Immersive Collaboration Consulting, LLC., All Rights Reserved

	Redistributions in source code form must reproduce the above
	copyright and this condition.

Licensed under MIT License (MIT)
Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.'! !

!QuestionDialogWindow commentStamp: 'gvc 5/18/2007 12:20'!
A yes/no/cancel message dialog. Cancel (escape & return) is the default.!
!QuestionDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 1/10/2007 14:44'!
answer
	"Answer the value of answer"

	^ answer! !

!QuestionDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 1/10/2007 14:44'!
yes
	"Answer yes."

	self
		answer: true;
		ok! !

!QuestionDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 1/10/2007 14:44'!
newButtons
	"Answer new buttons as appropriate."

	^{self newYesButton. self newNoButton. self newCancelButton isDefault: true}! !

!QuestionDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 1/10/2007 14:44'!
answer: anObject
	"Set the value of answer"

	answer := anObject! !

!QuestionDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 1/11/2007 17:36'!
no
	"Answer no."

	self
		answer: false;
		ok! !

!QuestionWithoutCancelDialogWindow commentStamp: 'gvc 5/18/2007 12:20'!
A yes/no message dialog. Yes (return) is the default. Escape will answer no.!
!QuestionWithoutCancelDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 1/10/2007 14:44'!
escapePressed
	"Default is to cancel."

	self no! !

!QuestionWithoutCancelDialogWindow methodsFor: 'as yet unclassified' stamp: 'gvc 1/10/2007 14:45'!
newButtons
	"Answer new buttons as appropriate."

	^{self newYesButton isDefault: true. self newNoButton}! !

!QuotedPrintableMimeConverter commentStamp: '<historical>'!
I am QuotedPrintableMimeConverter.
I am a MimeConverter.

Quoted-Printable, or QP encoding, is an encoding using printable ASCII characters (alphanumeric and the equals sign "=") to transmit 8-bit data over a 7-bit data path or, generally, over a medium which is not 8-bit clean. It is defined as a MIME content transfer encoding for use in e-mail.

QP works by using the equals sign "=" as an escape character. It also limits line length to 76, as some software has limits on line length.

See also 

  http://en.wikipedia.org/wiki/Quoted-printable
  http://tools.ietf.org/html/rfc2045

I do quoted printable MIME decoding as specified in RFC 2045 "MIME Part One: Format of Internet Message Bodies".

Short version of RFC2045, Sect. 6.7:

	(1) Any octet, except a CR or LF that is part of a CRLF line break of the canonical (standard) form of the data being encoded, may be represented by an "=" followed by a two digit hexadecimal representation of the octet's value. [...]

	(2) Octets with decimal values of 33 through 60 inclusive, and 62 through 126, inclusive, MAY be represented as the US-ASCII characters which correspond to those octets [...].

	(3) Octets with values of 9 and 32 MAY be represented as US-ASCII TAB (HT) and SPACE characters,
 respectively, but MUST NOT be so represented at the end of an encoded line.  [...]

	(4) A line break in a text body, represented as a CRLF sequence in the text canonical form, must be represented by a (RFC 822) line break, which is also a CRLF sequence, in the Quoted-Printable encoding.  [...]

	(5) The Quoted-Printable encoding REQUIRES that encoded lines be no more than 76 characters long.  If longer lines are to be encoded with the Quoted-Printable encoding, "soft" line breaks
 must be used.  An equal sign as the last character on a encoded line indicates such a non-significant ("soft") line break in the encoded text.!
!QuotedPrintableMimeConverter methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 12/8/2013 23:25'!
initialize
	super initialize.
	newline := String cr! !

!QuotedPrintableMimeConverter methodsFor: 'conversion' stamp: 'SvenVanCaekenberghe 12/8/2013 23:26'!
mimeEncode
	| char charValue lineLength |
	lineLength := 0.
	[ dataStream atEnd ] whileFalse: [
		lineLength >= 74
			ifTrue: [
				mimeStream nextPut: $=; nextPutAll: newline.
				lineLength := 0].
		char := dataStream next.
		charValue := char asInteger.
		(charValue = 9 | (charValue between: 32 and: 60) | (charValue between: 62 and: 126))
			ifTrue: [
				mimeStream nextPut: char.
				lineLength := lineLength + 1 ]
			ifFalse: [
				(char = Character cr) | (char = Character lf)
					ifTrue: [
						mimeStream nextPutAll: '=0D=0A'.
						char = Character cr ifTrue: [ dataStream peekFor: Character lf ].
						lineLength := 0 ]
					ifFalse: [
						charValue > 255 ifTrue: [ self error: 'Character out of range' ].
						mimeStream nextPut: $=.
						char asInteger printOn: mimeStream base: 16 length: 2 padded: true.
						lineLength := lineLength + 3 ] ] ]! !

!QuotedPrintableMimeConverter methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 12/8/2013 23:33'!
newline: string
	"Set another newline convention, like CRLF or LF that I should use.
	By default I use CR."
	
	newline := string! !

!QuotedPrintableMimeConverter methodsFor: 'conversion' stamp: 'SvenVanCaekenberghe 12/8/2013 23:26'!
mimeDecode
	| char outChar previousChar |
	previousChar := nil.
	[ mimeStream atEnd ] whileFalse: [
		char := mimeStream next.
		outChar := (char = $=
			ifTrue: [
				((char := mimeStream next) = Character cr) | (char = Character lf)
					ifTrue: [
						char = Character cr ifTrue: [ mimeStream peekFor: Character lf ].
						nil ]
					ifFalse: [
						Character codePoint: char digitValue * 16 + mimeStream next digitValue ] ]
			ifFalse: [ char ]).
		outChar notNil 
			ifTrue: [ 
				(outChar = Character lf) & (previousChar = Character cr)
					ifTrue: [ dataStream nextPutAll: newline ]
					ifFalse: [ 
						(outChar = Character cr) | (outChar = Character lf) 
							ifFalse: [ dataStream nextPut: outChar ] ].
				previousChar := outChar ] ]! !

!QuotedPrintableMimeConverterTest commentStamp: 'TorstenBergmann 2/5/2014 10:12'!
SUnit tests for QuotedPrintableMimeConverter!
!QuotedPrintableMimeConverterTest methodsFor: 'accesing' stamp: 'SvenVanCaekenberghe 12/8/2013 23:10'!
decode: string
	^ coder mimeDecode: string as: String! !

!QuotedPrintableMimeConverterTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/8/2013 19:04'!
testDecodeDecodedStrings

	self 
		assert: (self decode: 'Hätten Hüte ein ß im Namen, wären sie möglicherweise keine Hüte mehr')
		equals: 'Hätten Hüte ein ß im Namen, wären sie möglicherweise keine Hüte mehr'! !

!QuotedPrintableMimeConverterTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/8/2013 19:04'!
testDecodeSoftLinebreakCRLF

	self 
		assert: (self decode: 'This is text may not be=', String crlf, ' decoded as two lines')
		equals: 'This is text may not be decoded as two lines'! !

!QuotedPrintableMimeConverterTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/8/2013 23:37'!
testDecodeCustomNewline
	| decoder output |
	decoder := coder new.
	output := String new writeStream.
	decoder 
		newline: String lf;
		mimeStream: 'foo=0D=0Abar' readStream;
		dataStream: output;
		mimeDecode.
	self 
		assert: output contents
		equals: 'foo', String lf, 'bar'
	! !

!QuotedPrintableMimeConverterTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/8/2013 19:05'!
testEncodeLF

	self 
		assert: (self encode: 'This is the first line', String lf, 'and this is the second')
		equals: 'This is the first line=0D=0Aand this is the second'! !

!QuotedPrintableMimeConverterTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/8/2013 19:05'!
testEncodeCR

	self 
		assert: (self encode: 'This is the first line', String cr, 'and this is the second')
		equals: 'This is the first line=0D=0Aand this is the second'! !

!QuotedPrintableMimeConverterTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/8/2013 19:05'!
testEncodeSimpleStrings

	self 
		assert: (self encode: 'Zürich')
		equals: 'Z=FCrich'.
	self 
		assert: (self encode: 'Über die Fährverbindungen nach Föhr wüßte ich nicht viel')
		equals: '=DCber die F=E4hrverbindungen nach F=F6hr w=FC=DFte ich nicht viel'! !

!QuotedPrintableMimeConverterTest methodsFor: 'running' stamp: 'SvenVanCaekenberghe 12/8/2013 23:09'!
setUp
	coder := QuotedPrintableMimeConverter! !

!QuotedPrintableMimeConverterTest methodsFor: 'accesing' stamp: 'SvenVanCaekenberghe 12/8/2013 23:10'!
encode: string
	^ coder mimeEncode: string! !

!QuotedPrintableMimeConverterTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/8/2013 19:04'!
testDecodeSoftLinebreakCR

	self 
		assert: (self decode: 'This is text may not be=', String cr, ' decoded as two lines')
		equals: 'This is text may not be decoded as two lines'! !

!QuotedPrintableMimeConverterTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/8/2013 19:05'!
testEncodeEncodedStrings

	"An = becomes =3D and is then not decodable any more (only if you know you have to do it twice ;-) )"
	self
		assert: (self encode: 'Z=FCrich')
		equals: 'Z=3DFCrich'! !

!QuotedPrintableMimeConverterTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/8/2013 19:04'!
testDecodeSimpleStrings

	self 
		assert: (self decode: 'Z=FCrich') 
		equals: 'Zürich'.
	self 
		assert: (self decode: 'H=E4tten H=FCte ein =DF im Namen, w=E4ren sie m=F6glicherweise keine H=FCte mehr') 
		equals: 'Hätten Hüte ein ß im Namen, wären sie möglicherweise keine Hüte mehr'! !

!QuotedPrintableMimeConverterTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/8/2013 19:05'!
testEncodeSoftLinebreak

	| original encoded |

	original :=
		'Cowards die many times before their deaths; The valiant never taste of death but once.
Of all the wonders that I yet have heard, it seems to me most strange that men should fear;
Seeing that death, a necessary end, will come when it will come'.

	encoded :=
		'Cowards die many times before their deaths; The valiant never taste of dea=
th but once.=0D=0AOf all the wonders that I yet have heard, it seems to me most strange that=
 men should fear;=0D=0ASeeing that death, a necessary end, will come when it will come'.

	self assert: (self encode: original) equals: encoded.
	
	self assert: (self decode: encoded) equals: original! !

!QuotedPrintableMimeConverterTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/8/2013 19:04'!
testDecodeCRLF

	self 
		assert: (self decode: 'This is the first line=0D=0A and this is the second')
		equals: 'This is the first line
 and this is the second'! !

!QuotedPrintableMimeConverterTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/8/2013 19:04'!
testDecodeSoftLinebreak

	self 
		assert: (self decode: 'This is text may not be=
 decoded as two lines')
		equals: 'This is text may not be decoded as two lines'! !

!QuotedPrintableMimeConverterTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/8/2013 19:05'!
testLongLine
	| input output |
	
	input := (String new: 74 withAll: $A), (String new: 47 withAll: $B).
	
	output := (String new: 74 withAll: $A), '=
', (String new: 47 withAll: $B).
	
	self 
		assert: (self encode: input)
		equals: output! !

!QuotedPrintableMimeConverterTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/8/2013 19:05'!
testEncodeCRLF

	self 
		assert: (self encode: 'This is the first line', String crlf, 'and this is the second')
		equals: 'This is the first line=0D=0Aand this is the second'! !

!QuotedPrintableMimeConverterTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/8/2013 23:18'!
testEncodeLongLine
	| input output |
	
	input := (String new: 74 withAll: $A), (String new: 47 withAll: $B).
	
	output := (String new: 74 withAll: $A), '=
', (String new: 47 withAll: $B).
	
	self 
		assert: (self encode: input)
		equals: output! !

!QuotedPrintableMimeConverterTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/8/2013 19:04'!
testDecodeSoftLinebreakLF

	self 
		assert: (self decode: 'This is text may not be=', String lf, ' decoded as two lines')
		equals: 'This is text may not be decoded as two lines'! !

!RBAbstractClass methodsFor: 'testing' stamp: ''!
directlyDefinesPoolDictionary: aString 
	self subclassResponsibility! !

!RBAbstractClass methodsFor: 'method accessing' stamp: ''!
allSelectors
	| class selectors |
	class := self.
	selectors := Set new.
	[class notNil] whileTrue: 
			[selectors addAll: class selectors.
			class := class superclass].
	^selectors! !

!RBAbstractClass methodsFor: 'testing' stamp: ''!
directlyDefinesMethod: aSelector 
	self isDefined 
		ifTrue: 
			[(self hasRemoved: aSelector) ifTrue: [^false].
			(self realClass includesSelector: aSelector) ifTrue: [^true]].
	^newMethods notNil and: [newMethods includesKey: aSelector]! !

!RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 1/18/2010 19:40'!
existingMethodsThatReferToInstanceVariable: aString
	| existingMethods |
	existingMethods := self realClass 
		whichSelectorsAccess: aString.
	(newMethods isNil and: [ removedMethods isNil ])
		ifTrue: [ ^ existingMethods ].
	^ existingMethods 
		reject: [ :each | (self hasRemoved: each) or: [ self newMethods includesKey: each ] ]! !

!RBAbstractClass methodsFor: 'testing' stamp: ''!
hierarchyDefinesInstanceVariable: aString 
	(self definesInstanceVariable: aString) ifTrue: [^true].
	^(self allSubclasses 
		detect: [:each | each directlyDefinesInstanceVariable: aString]
		ifNone: [nil]) notNil! !

!RBAbstractClass methodsFor: 'accessing' stamp: 'lr 10/26/2009 22:08'!
soleInstance
	^ self theNonMetaClass! !

!RBAbstractClass methodsFor: 'variable accessing' stamp: ''!
whoDefinesClassVariable: aString 
	| sprClass |
	(self directlyDefinesClassVariable: aString) ifTrue: [^self].
	sprClass := self superclass.
	^sprClass isNil 
		ifTrue: [nil]
		ifFalse: [sprClass whoDefinesClassVariable: aString]! !

!RBAbstractClass methodsFor: 'method accessing' stamp: ''!
whoDefinesMethod: aSelector 
	| sprClass |
	(self directlyDefinesMethod: aSelector) ifTrue: [^self].
	sprClass := self superclass.
	^sprClass isNil 
		ifTrue: [nil]
		ifFalse: [sprClass whoDefinesMethod: aSelector]! !

!RBAbstractClass methodsFor: 'initialization' stamp: ''!
initialize
	name := #'Unknown Class'! !

!RBAbstractClass methodsFor: 'accessing' stamp: ''!
instanceVariableNames
	^self privateInstanceVariableNames copy! !

!RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 3/17/2010 18:42'!
whichSelectorsReferToSymbol: aSymbol 
	| selectors |
	selectors := Set new.
	newMethods isNil ifFalse: [
		newMethods do: [ :each | 
			(each refersToSymbol: aSymbol)
				ifTrue: [ selectors add: each selector ] ] ].
	self isDefined 
		ifTrue: [ selectors addAll: (self existingMethodsThatReferTo: aSymbol) ].
	^ selectors! !

!RBAbstractClass methodsFor: 'accessing' stamp: 'lr 10/26/2009 22:08'!
theNonMetaClass
	^ model classNamed: self name! !

!RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 11/1/2009 23:47'!
compile: aString 
	^ self compile: aString withAttributesFrom: (self methodFor: (RBParser parseMethodPattern: aString))! !

!RBAbstractClass methodsFor: 'accessing' stamp: ''!
withAllSubclasses
	^(self allSubclasses)
		add: self;
		yourself! !

!RBAbstractClass methodsFor: 'method accessing' stamp: ''!
sourceCodeFor: aSelector 
	| class |
	class := self whoDefinesMethod: aSelector.
	class isNil ifTrue: [^nil].
	^(class methodFor: aSelector) source! !

!RBAbstractClass methodsFor: 'method accessing' stamp: 'md 1/17/2006 14:17'!
bindingOf: aString 
	^self realClass classPool associationAt: aString asSymbol
		ifAbsent: [self realClass classPool associationAt: aString asString ifAbsent: [nil]]! !

!RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 11/1/2009 23:47'!
compile: aString classified: aSymbolCollection 
	| change method |
	change := model 
				compile: aString
				in: self
				classified: aSymbolCollection.
	method := RBMethod 
				for: self
				source: aString
				selector: change selector.
	self addMethod: method.
	^ change! !

!RBAbstractClass methodsFor: 'method accessing' stamp: ''!
methodFor: aSelector 
	^self newMethods at: aSelector
		ifAbsent: 
			[| compiledMethod class |
			(self hasRemoved: aSelector) ifTrue: [^nil].
			class := self realClass.
			class isNil ifTrue: [^nil].
			compiledMethod := class compiledMethodAt: aSelector ifAbsent: [nil].
			compiledMethod isNil 
				ifTrue: [nil]
				ifFalse: 
					[RBMethod 
						for: self
						fromMethod: compiledMethod
						andSelector: aSelector]]! !

!RBAbstractClass methodsFor: 'testing' stamp: ''!
definesInstanceVariable: aString 
	(self directlyDefinesInstanceVariable: aString) ifTrue: [^true].
	^self superclass notNil 
		and: [self superclass definesInstanceVariable: aString]! !

!RBAbstractClass methodsFor: 'method accessing' stamp: ''!
parseTreeFor: aSelector 
	| class |
	class := self whoDefinesMethod: aSelector.
	class isNil ifTrue: [^nil].
	^(class methodFor: aSelector) parseTree! !

!RBAbstractClass methodsFor: 'testing' stamp: ''!
includesClass: aRBClass 
	| currentClass |
	currentClass := self.
	[currentClass notNil and: [currentClass ~= aRBClass]] 
		whileTrue: [currentClass := currentClass superclass].
	^currentClass = aRBClass! !

!RBAbstractClass methodsFor: 'private' stamp: ''!
addSubclass: aRBClass 
	self subclasses add: aRBClass! !

!RBAbstractClass methodsFor: 'method accessing' stamp: ''!
removeMethod: aSelector 
	self newMethods removeKey: aSelector ifAbsent: [].
	model removeMethod: aSelector from: self.
	self removedMethods add: aSelector! !

!RBAbstractClass methodsFor: 'testing' stamp: ''!
definesPoolDictionary: aSymbol 
	(self directlyDefinesPoolDictionary: aSymbol) ifTrue: [^true].
	^self inheritsPoolDictionaries and: 
			[self superclass notNil 
				and: [self superclass definesPoolDictionary: aSymbol]]! !

!RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 3/17/2010 18:43'!
whichSelectorsReferToClass: aRBClass 
	| selectors |
	selectors := Set new.
	newMethods isNil ifFalse: [
		newMethods do: [ :each | 
			(each refersToClassNamed: aRBClass name) 
				ifTrue: [ selectors add: each selector ] ] ].
	(self isDefined and: [ aRBClass isDefined ]) ifTrue: [
		selectors addAll: (self existingMethodsThatReferTo: aRBClass classBinding).
		selectors addAll: (self existingMethodsThatReferTo: aRBClass name) ].
	^ selectors! !

!RBAbstractClass methodsFor: 'method accessing' stamp: 'cwp 5/10/2010 23:49'!
existingMethodsThatReferTo: aSymbol 
	| existingMethods special byte |
	special := Smalltalk
		hasSpecialSelector: aSymbol
		ifTrueSetByte: [ :value | byte := value ].
	existingMethods := self realClass 
		thoroughWhichSelectorsReferTo: aSymbol 
		special: special byte: byte.
	(newMethods isNil and: [ removedMethods isNil ])
		ifTrue: [ ^ existingMethods ].
	^ existingMethods 
		reject: [ :each | (self hasRemoved: each) or: [ self newMethods includesKey: each ] ]! !

!RBAbstractClass methodsFor: 'variable accessing' stamp: ''!
whoDefinesInstanceVariable: aString 
	| sprClass |
	(self directlyDefinesInstanceVariable: aString) ifTrue: [^self].
	sprClass := self superclass.
	^sprClass isNil 
		ifTrue: [nil]
		ifFalse: [sprClass whoDefinesInstanceVariable: aString]! !

!RBAbstractClass methodsFor: 'accessing' stamp: ''!
allSuperclasses
	| supers sprClass |
	supers := OrderedCollection new.
	sprClass := self superclass.
	[sprClass notNil] whileTrue: 
			[supers add: sprClass.
			sprClass := sprClass superclass].
	^supers! !

!RBAbstractClass methodsFor: 'testing' stamp: ''!
isDefined
	^self realClass notNil! !

!RBAbstractClass methodsFor: 'testing' stamp: 'SebastianTleye 8/1/2013 16:11'!
directlyDefinesLocalMethod: aSelector 
	self isDefined 
		ifTrue: 
			[(self hasRemoved: aSelector) ifTrue: [^false].
			(self realClass includesLocalSelector: aSelector) ifTrue: [^true]].
	^newMethods notNil and: [newMethods includesKey: aSelector]! !

!RBAbstractClass methodsFor: 'private' stamp: ''!
privateInstanceVariableNames
	instanceVariableNames isNil 
		ifTrue: 
			[self isDefined 
				ifTrue: [self instanceVariableNames: self realClass instVarNames]
				ifFalse: [instanceVariableNames := OrderedCollection new]].
	^instanceVariableNames! !

!RBAbstractClass methodsFor: 'accessing' stamp: ''!
name: aSymbol 
	name := aSymbol! !

!RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 11/1/2009 23:16'!
compile: aString withAttributesFrom: aRBMethod 
	| change method |
	change := model 
		compile: aString
		in: self
		classified: aRBMethod protocols.
	method := RBMethod 
		for: self
		source: aString
		selector: change selector.
	self addMethod: method.
	^ change! !

!RBAbstractClass methodsFor: 'testing' stamp: ''!
hierarchyDefinesPoolDictionary: aString 
	(self definesPoolDictionary: aString) ifTrue: [^true].
	^(self allSubclasses 
		detect: [:each | each directlyDefinesPoolDictionary: aString]
		ifNone: [nil]) notNil! !

!RBAbstractClass methodsFor: 'private' stamp: ''!
superclass: aRBClass 
	self superclass notNil ifTrue: [self superclass removeSubclass: self].
	superclass := aRBClass.
	superclass notNil ifTrue: [superclass addSubclass: self].! !

!RBAbstractClass methodsFor: 'testing' stamp: ''!
definesMethod: aSelector 
	(self directlyDefinesMethod: aSelector) ifTrue: [^true].
	^self superclass notNil and: [self superclass definesMethod: aSelector]! !

!RBAbstractClass methodsFor: 'testing' stamp: ''!
hierarchyDefinesMethod: aSelector 
	(self definesMethod: aSelector) ifTrue: [^true].
	^self subclassRedefines: aSelector! !

!RBAbstractClass methodsFor: 'enumerating' stamp: 'MarcusDenker 9/18/2012 14:12'!
allSubclassesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the receiver's subclasses."

	self subclassesDo: 
		[:cl | 
		aBlock value: cl.
		cl allSubclassesDo: aBlock]! !

!RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 3/17/2010 18:42'!
whichSelectorsReferToInstanceVariable: aString 
	| selectors |
	selectors := Set new.
	newMethods isNil ifFalse: [
		newMethods do: [ :each | 
			(each refersToVariable: aString)
				ifTrue: [ selectors add: each selector ] ] ].
	self isDefined 
		ifTrue: [ selectors addAll: (self existingMethodsThatReferToInstanceVariable: aString) ].
	^ selectors! !

!RBAbstractClass methodsFor: 'accessing' stamp: ''!
name
	^name! !

!RBAbstractClass methodsFor: 'initialize-release' stamp: ''!
model: aRBSmalltalk
	model := aRBSmalltalk! !

!RBAbstractClass methodsFor: 'testing' stamp: ''!
hasRemoved: aSelector 
	^removedMethods notNil and: [removedMethods includes: aSelector]! !

!RBAbstractClass methodsFor: 'accessing' stamp: ''!
newMethods
	^newMethods isNil 
		ifTrue: [newMethods := IdentityDictionary new]
		ifFalse: [newMethods]! !

!RBAbstractClass methodsFor: 'accessing' stamp: ''!
removeSubclass: aRBClass 
	self subclasses remove: aRBClass ifAbsent: []! !

!RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 9/8/2011 20:25'!
protocolsFor: aSelector 
	| change |
	change := self isMeta 
				ifTrue: [model changes changeForMetaclass: name selector: aSelector]
				ifFalse: [model changes changeForClass: name selector: aSelector].
	^change isNil 
		ifTrue: 
			[self isDefined 
				ifTrue: 
					[Array with: (RBBrowserEnvironment new whichProtocolIncludes: aSelector in: self realClass)]
				ifFalse: [#(#accessing)]]
		ifFalse: [change protocols]! !

!RBAbstractClass methodsFor: 'testing' stamp: ''!
directlyDefinesVariable: aVariableName 
	^(self directlyDefinesClassVariable: aVariableName) 
		or: [self directlyDefinesInstanceVariable: aVariableName]! !

!RBAbstractClass methodsFor: 'variable accessing' stamp: ''!
renameInstanceVariable: oldName to: newName around: aBlock 
	self privateInstanceVariableNames 
		at: (self privateInstanceVariableNames indexOf: oldName asString)
		put: newName asString.
	model 
		renameInstanceVariable: oldName
		to: newName
		in: self
		around: aBlock! !

!RBAbstractClass methodsFor: 'testing' stamp: 'MarcusDenker 4/24/2013 10:51'!
canUnderstand: aSelector 
	^self definesMethod: aSelector! !

!RBAbstractClass methodsFor: 'method accessing' stamp: ''!
addMethod: aRBMethod 
	self newMethods at: aRBMethod selector put: aRBMethod.
	removedMethods notNil 
		ifTrue: [removedMethods remove: aRBMethod selector ifAbsent: []]! !

!RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 11/1/2009 23:48'!
compileTree: aRBMethodNode 
	^ (self methodFor: aRBMethodNode selector) compileTree: aRBMethodNode! !

!RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 1/18/2010 19:39'!
existingMethodsThatReferToClassVariable: aString
	| binding existingMethods |
	binding := (self bindingOf: aString)
		ifNil: [ ^ #() ].
	existingMethods := self realClass
		whichSelectorsReferTo: binding.
	(newMethods isNil and: [ removedMethods isNil ])
		ifTrue: [ ^ existingMethods ].
	^ existingMethods
		reject: [ :each | (self hasRemoved: each) or: [ self newMethods includesKey: each ] ]! !

!RBAbstractClass methodsFor: 'accessing' stamp: ''!
instanceVariableNames: aCollectionOfStrings 
	instanceVariableNames := aCollectionOfStrings asOrderedCollection! !

!RBAbstractClass methodsFor: 'testing' stamp: ''!
hierarchyDefinesClassVariable: aString 
	(self definesClassVariable: aString) ifTrue: [^true].
	^(self allSubclasses 
		detect: [:each | each directlyDefinesClassVariable: aString]
		ifNone: [nil]) notNil! !

!RBAbstractClass methodsFor: 'testing' stamp: ''!
hierarchyDefinesVariable: aString 
	(self definesVariable: aString) ifTrue: [^true].
	^(self allSubclasses 
		detect: [:each | each directlyDefinesVariable: aString]
		ifNone: [nil]) notNil! !

!RBAbstractClass methodsFor: 'printing' stamp: ''!
printOn: aStream 
	aStream nextPutAll: self name! !

!RBAbstractClass methodsFor: 'accessing' stamp: 'lr 10/26/2009 22:09'!
theMetaClass
	^ model metaclassNamed: self name! !

!RBAbstractClass methodsFor: 'testing' stamp: 'lr 1/3/2010 11:47'!
subclassRedefines: aSelector
	"Return true, if one of your subclasses redefines the method with name, aMethod"

	^ self allSubclasses anySatisfy: [ :each | each directlyDefinesMethod: aSelector ]! !

!RBAbstractClass methodsFor: 'variable accessing' stamp: ''!
typeOfClassVariable: aSymbol 
	^model classNamed: #Object! !

!RBAbstractClass methodsFor: 'variable accessing' stamp: ''!
removeInstanceVariable: aString 
	self privateInstanceVariableNames remove: aString.
	model removeInstanceVariable: aString from: self! !

!RBAbstractClass methodsFor: 'testing' stamp: ''!
directlyDefinesClassVariable: aString 
	self subclassResponsibility! !

!RBAbstractClass methodsFor: 'testing' stamp: ''!
definesVariable: aVariableName 
	^(self definesClassVariable: aVariableName) 
		or: [self definesInstanceVariable: aVariableName]! !

!RBAbstractClass methodsFor: 'accessing' stamp: 'NicolaiHess 11/21/2014 22:45'!
allSubclasses
	| allSubclasses index |
	index := 1.
	allSubclasses := OrderedCollection withAll: self subclasses.
	[index <= allSubclasses size] whileTrue: 
			[allSubclasses addAll: (allSubclasses at: index) subclasses.
			index := index + 1].
	^allSubclasses! !

!RBAbstractClass methodsFor: 'accessing' stamp: ''!
withAllSuperclasses
	^(self allSuperclasses)
		add: self;
		yourself! !

!RBAbstractClass methodsFor: 'enumerating' stamp: 'MarcusDenker 9/18/2012 14:12'!
subclassesDo: aBlock 
	self subclasses do: aBlock! !

!RBAbstractClass methodsFor: 'comparing' stamp: ''!
hash
	^self name hash bitXor: self class hash! !

!RBAbstractClass methodsFor: 'accessing' stamp: ''!
allClassVariableNames
	^self subclassResponsibility! !

!RBAbstractClass methodsFor: 'accessing' stamp: ''!
allPoolDictionaryNames
	^self subclassResponsibility! !

!RBAbstractClass methodsFor: 'testing' stamp: ''!
isAbstract
	(self whichSelectorsReferToSymbol: #subclassResponsibility) isEmpty 
		ifFalse: [^true].
	model allReferencesToClass: self do: [:each | ^false].
	^true! !

!RBAbstractClass methodsFor: 'testing' stamp: ''!
isMeta
	self subclassResponsibility! !

!RBAbstractClass methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPutAll: self name! !

!RBAbstractClass methodsFor: 'accessing' stamp: ''!
allInstanceVariableNames
	| sprClass |
	sprClass := self superclass.
	^sprClass isNil 
		ifTrue: [self instanceVariableNames]
		ifFalse: [sprClass allInstanceVariableNames , self instanceVariableNames]! !

!RBAbstractClass methodsFor: 'accessing' stamp: ''!
realClass
	^realClass! !

!RBAbstractClass methodsFor: 'accessing' stamp: ''!
removedMethods
	^removedMethods isNil 
		ifTrue: [removedMethods := Set new]
		ifFalse: [removedMethods]! !

!RBAbstractClass methodsFor: 'accessing' stamp: ''!
model
	^model! !

!RBAbstractClass methodsFor: 'accessing' stamp: ''!
realClass: aClass 
	realClass := aClass.
	superclass isNil ifTrue: [superclass := LookupSuperclass]! !

!RBAbstractClass methodsFor: 'comparing' stamp: ''!
= aRBClass 
	^self class = aRBClass class 
		and: [self name = aRBClass name and: [self model = aRBClass model]]! !

!RBAbstractClass methodsFor: 'variable accessing' stamp: ''!
addInstanceVariable: aString 
	self privateInstanceVariableNames add: aString.
	model addInstanceVariable: aString to: self! !

!RBAbstractClass methodsFor: 'accessing' stamp: 'lr 7/23/2010 08:02'!
classBinding
	^ Smalltalk globals associationAt: self name! !

!RBAbstractClass methodsFor: 'testing' stamp: 'dc 5/18/2007 14:53'!
definesClassVariable: aSymbol 
	self realClass isTrait ifTrue: [^false].
	(self directlyDefinesClassVariable: aSymbol) ifTrue: [^true].
	^self superclass notNil 
		and: [self superclass definesClassVariable: aSymbol]! !

!RBAbstractClass methodsFor: 'testing' stamp: ''!
inheritsPoolDictionaries
	^false! !

!RBAbstractClass methodsFor: 'accessing' stamp: ''!
superclass
	^superclass == LookupSuperclass 
		ifTrue: [model classFor: self realClass superclass]
		ifFalse: [superclass]! !

!RBAbstractClass methodsFor: 'method accessing' stamp: ''!
selectors
	| selectors |
	selectors := Set new.
	selectors addAll: self newMethods keys.
	self isDefined 
		ifTrue: 
			[selectors addAll: self realClass selectors.
			removedMethods notNil 
				ifTrue: [removedMethods do: [:each | selectors remove: each ifAbsent: []]]].
	^selectors! !

!RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 3/17/2010 18:42'!
whichSelectorsReferToClassVariable: aString 
	| selectors |
	selectors := Set new.
	newMethods isNil ifFalse: [
		newMethods do: [ :each | 
			(each refersToVariable: aString)
				ifTrue: [ selectors add: each selector ] ] ].
	self isDefined 
		ifTrue: [ selectors addAll: (self existingMethodsThatReferToClassVariable: aString) ].
	^ selectors! !

!RBAbstractClass methodsFor: 'testing' stamp: ''!
directlyDefinesInstanceVariable: aString 
	^self instanceVariableNames includes: aString! !

!RBAbstractClass methodsFor: 'accessing' stamp: 'lr 2/3/2008 13:33'!
subclasses
	^subclasses isNil 
		ifTrue: 
			[subclasses := self isDefined 
						ifTrue: 
							[((self realClass subclasses collect: [:each | model classFor: each]) 
								reject: [ :each | each isNil ])
								asOrderedCollection]
						ifFalse: [OrderedCollection new]]
		ifFalse: [subclasses]! !

!RBAbstractClass class methodsFor: 'class initialization' stamp: ''!
initialize
	LookupSuperclass := Object new! !

!RBAbstractClassRule commentStamp: '<historical>'!
See my #rationale.!
!RBAbstractClassRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'!
resultClass
	^ RBClassEnvironment! !

!RBAbstractClassRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 00:34'!
initialize
	super initialize.
	subclassResponsibilitySymbol := 'subclassResponsibility' asSymbol! !

!RBAbstractClassRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 11:22'!
category
	^ 'Potential Bugs'! !

!RBAbstractClassRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
rationale
	^ 'Checks for references to classes that have subclassResponsibility methods. Such references might be creating instances of the abstract class or more commonly being used as the argument to an isKindOf: message which is considered bad style.'! !

!RBAbstractClassRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Possible bugs'! !

!RBAbstractClassRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'References an abstract class'! !

!RBAbstractClassRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:47'!
checkClass: aClass 
	(aClass whichSelectorsReferTo: subclassResponsibilitySymbol) ifNotEmpty: 
		[ aClass allCallsOn ifNotEmpty: [ result addClass: aClass ] ]! !

!RBAbstractClassRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'AbstractClassRule'! !

!RBAbstractClassVariableRefactoring methodsFor: 'transforming' stamp: 'TestRunner 11/3/2009 09:40'!
abstractInstanceReferences
	| replacer |
	replacer := RBParseTreeRewriter 
		variable: variableName
		getter: 'class ' , self accessorsRefactoring getterMethod
		setter: 'class ' , self accessorsRefactoring setterMethod.
	self 
		convertClasses: class withAllSubclasses
		select: [ :aClass | aClass whichSelectorsReferToClassVariable: variableName ]
		using: replacer! !

!RBAbstractClassVariableRefactoring methodsFor: 'private-accessing' stamp: 'lr 9/8/2011 20:11'!
accessorsRefactoring
	^accessorsRefactoring isNil 
		ifTrue: 
			[accessorsRefactoring := RBCreateAccessorsForVariableRefactoring 
						model: self model
						variable: variableName asString
						class: class
						classVariable: true]
		ifFalse: [accessorsRefactoring]! !

!RBAbstractClassVariableRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'!
abstractClassReferences
	| replacer |
	replacer := RBParseTreeRewriter 
		variable: variableName
		getter: self accessorsRefactoring getterMethod
		setter: self accessorsRefactoring setterMethod.
	self 
		convertClasses: class theMetaClass withAllSubclasses
		select: 
			[ :aClass | 
			(aClass whichSelectorsReferToClassVariable: variableName) reject: 
				[ :each | 
				aClass == class theMetaClass and: 
					[ each == self accessorsRefactoring getterMethod or: [ each == self accessorsRefactoring setterMethod ] ] ] ]
		using: replacer! !

!RBAbstractClassVariableRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^(RBCondition isMetaclass: class) not 
		& (RBCondition directlyDefinesClassVariable: variableName asSymbol in: class) 
			& ((RBCondition withBlock: 
						[(#(#Object #Behavior #ClassDescription #Class) includes: class name) not]) 
					errorMacro: 'This refactoring does not work for Object, Behavior, ClassDescription, or Class')! !

!RBAbstractClassVariableRefactoring methodsFor: 'transforming' stamp: ''!
createAccessors
	self performComponentRefactoring: self accessorsRefactoring! !

!RBAbstractClassVariableRefactoring methodsFor: 'transforming' stamp: ''!
transform
	self createAccessors.
	self abstractInstanceReferences.
	self abstractClassReferences! !

!RBAbstractClassVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testMetaClassFailure
	self shouldFail: (RBAbstractClassVariableRefactoring 
			variable: #RecursiveSelfRule
			class: RBTransformationRuleTest class)! !

!RBAbstractClassVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testModelAbstractClassVariableOverridenMethodsInSubclass
	| refactoring meta class |
	class := model classNamed: #Foo.
	meta := class theMetaClass.
	refactoring := RBAbstractClassVariableRefactoring 
		model: model
		variable: 'ClassVarName2'
		class: class.
	self executeRefactoring: refactoring.
	self assert: (meta parseTreeFor: #classVarName21) = (RBParser parseMethod: 'classVarName21 ^ClassVarName2').
	self assert: (meta parseTreeFor: #classVarName21:) = (RBParser parseMethod: 'classVarName21: anObject ClassVarName2 := anObject')! !

!RBAbstractClassVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testModelAbstractClassVariable
	| refactoring meta class |
	class := model classNamed: #Foo.
	meta := class theMetaClass.
	refactoring := RBAbstractClassVariableRefactoring 
		model: model
		variable: 'ClassVarName1'
		class: class.
	self executeRefactoring: refactoring.
	self assert: (meta parseTreeFor: #classVarName1) = (RBParser parseMethod: 'classVarName1 ^ClassVarName1').
	self assert: (meta parseTreeFor: #classVarName1:) = (RBParser parseMethod: 'classVarName1: anObject ^ClassVarName1 := anObject').
	self assert: (meta parseTreeFor: #foo) = (RBParser parseMethod: 'foo
					^self classVarName1: self classVarName1 * self classVarName1 * self classVarName1').
	self assert: (class parseTreeFor: #classVarName1) = (RBParser parseMethod: 'classVarName1
							^self class classVarName1').
	self assert: (class parseTreeFor: #classVarName1:) = (RBParser parseMethod: 'classVarName1: anObject
							^self class classVarName1: anObject').
	self assert: (class parseTreeFor: #asdf) = (RBParser parseMethod: 'asdf
						^self classVarName1: (self class classVarName1: self class classVarName1 + 1)').
	self assert: ((model classNamed: #Bar) parseTreeFor: #foo) = (RBParser parseMethod: 'foo
					instVarName1 := instVarName1 + instVarName2 + self class classVarName1').
	self assert: ((model classNamed: #Bar) parseTreeFor: #foo) = (RBParser parseMethod: 'foo
						instVarName1 := instVarName1 + instVarName2 + self class classVarName1')! !

!RBAbstractClassVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testInheritedName
	self shouldFail: (RBAbstractClassVariableRefactoring 
			variable: #DependentsFields
			class: RBBasicLintRuleTest)! !

!RBAbstractClassVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testAbstractClassVariable
	| refactoring meta class |
	refactoring := RBAbstractClassVariableRefactoring 
		variable: 'RecursiveSelfRule'
		class: RBTransformationRuleTest.
	self executeRefactoring: refactoring.
	class := refactoring model classNamed: #RBTransformationRuleTest.
	meta := class theMetaClass.
	self assert: (meta parseTreeFor: #recursiveSelfRule) = (RBParser parseMethod: 'recursiveSelfRule ^RecursiveSelfRule').
	self assert: (meta parseTreeFor: #recursiveSelfRule:) = (RBParser parseMethod: 'recursiveSelfRule: anObject RecursiveSelfRule := anObject').
	self assert: (meta parseTreeFor: #nuke) = (RBParser parseMethod: 'nuke
							self recursiveSelfRule: nil').
	self assert: (meta parseTreeFor: #initializeAfterLoad1) = (RBParser parseMethod: 'initializeAfterLoad1
							self recursiveSelfRule: RBParseTreeSearcher new.
							self recursiveSelfRule
								addMethodSearches: #(''`@methodName: `@args | `@temps | self `@methodName: `@args'' ''`@methodName: `@args | `@temps | ^self `@methodName: `@args'')
										-> [:aNode :answer | true]').
	self assert: (class parseTreeFor: #checkMethod:) = (RBParser parseMethod: 'checkMethod: aSmalllintContext 
							class := aSmalllintContext selectedClass.
							(rewriteRule executeTree: aSmalllintContext parseTree) ifTrue: 
									[(self class recursiveSelfRule executeTree: rewriteRule tree initialAnswer: false)
										ifFalse: 
											[builder compile: rewriteRule tree printString
												in: class
												classified: aSmalllintContext protocols]]')! !

!RBAbstractClassVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testNonExistantName
	self shouldFail: (RBAbstractClassVariableRefactoring 
			variable: #Foo
			class: RBBasicLintRuleTest)! !

!RBAbstractClassVariableTest methodsFor: 'set up' stamp: 'CamilloBruni 8/27/2013 15:05'!
setUp
	super setUp.
	model := self abstractVariableTestData.! !

!RBAbstractCondition methodsFor: 'private' stamp: ''!
errorMacro
	^errorMacro isNil
		ifTrue: ['unknown']
		ifFalse: [errorMacro]! !

!RBAbstractCondition methodsFor: 'logical operations' stamp: ''!
| aCondition 
	"(A | B) = (A not & B not) not"

	^(self not & aCondition not) not! !

!RBAbstractCondition methodsFor: 'accessing' stamp: ''!
errorString
	^self errorStringFor: false! !

!RBAbstractCondition methodsFor: 'private' stamp: ''!
errorMacro: aString 
	errorMacro := aString! !

!RBAbstractCondition methodsFor: 'checking' stamp: ''!
check
	self subclassResponsibility! !

!RBAbstractCondition methodsFor: 'logical operations' stamp: ''!
& aCondition 
	^RBConjunctiveCondition new left: self right: aCondition! !

!RBAbstractCondition methodsFor: 'accessing' stamp: ''!
errorBlock
	^self errorBlockFor: false! !

!RBAbstractCondition methodsFor: 'logical operations' stamp: ''!
not
	^RBNegationCondition on: self! !

!RBAbstractCondition methodsFor: 'private' stamp: ''!
errorBlockFor: aBoolean 
	^nil! !

!RBAbstractCondition methodsFor: 'private' stamp: ''!
errorStringFor: aBoolean
	^self errorMacro expandMacrosWith: aBoolean! !

!RBAbstractInstanceVariableRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'!
abstractReferences
	| replacer |
	replacer := RBParseTreeRewriter 
				variable: variableName
				getter: self accessorsRefactoring getterMethod
				setter: self accessorsRefactoring setterMethod.
	self 
		convertClasses: class withAllSubclasses
		select: 
			[:aClass | 
			(aClass whichSelectorsReferToInstanceVariable: variableName) reject: 
					[:each | 
					aClass == class and: 
							[each == self accessorsRefactoring getterMethod 
								or: [each == self accessorsRefactoring setterMethod]]]]
		using: replacer! !

!RBAbstractInstanceVariableRefactoring methodsFor: 'private-accessing' stamp: 'lr 9/8/2011 20:11'!
accessorsRefactoring
	^accessorsRefactoring isNil 
		ifTrue: 
			[accessorsRefactoring := RBCreateAccessorsForVariableRefactoring 
						model: self model
						variable: variableName
						class: class
						classVariable: false]
		ifFalse: [accessorsRefactoring]! !

!RBAbstractInstanceVariableRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^RBCondition directlyDefinesInstanceVariable: variableName in: class! !

!RBAbstractInstanceVariableRefactoring methodsFor: 'transforming' stamp: ''!
createAccessors
	self performComponentRefactoring: self accessorsRefactoring! !

!RBAbstractInstanceVariableRefactoring methodsFor: 'transforming' stamp: ''!
transform
	self createAccessors.
	self abstractReferences! !

!RBAbstractInstanceVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testAbstractWithDefaultNamesUsed
	| refactoring class |
	class := model classNamed: #Foo.
	refactoring := RBAbstractInstanceVariableRefactoring 
				model: model
				variable: 'instVarName1'
				class: class.
	self executeRefactoring: refactoring.
	self 
		assert: (class parseTreeFor: #bar) = (RBParser 
						parseMethod: 'bar
						"Add one to instVarName1"

						self instVarName11: self instVarName11 + 1').
	self 
		assert: (class parseTreeFor: #instVarName11:) = (RBParser 
						parseMethod: 'instVarName11: anObject
						instVarName1 := anObject').
	self assert: (class parseTreeFor: #instVarName11) 
				= (RBParser parseMethod: 'instVarName11
						^instVarName1').
	self 
		assert: ((model classNamed: #Bar) parseTreeFor: #foo) = (RBParser 
						parseMethod: 'foo
						self instVarName11: self instVarName11 + instVarName2 + ClassVarName1')! !

!RBAbstractInstanceVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testAbstractWithAssignmentUsed
	| refactoring class |
	class := model classNamed: #Foo.
	refactoring := RBAbstractInstanceVariableRefactoring 
				model: model
				variable: 'instVarName2'
				class: class.
	self executeRefactoring: refactoring.
	self assert: (class parseTreeFor: #foo) 
				= (RBParser parseMethod: 'foo
						^self instVarName21: 3').
	self 
		assert: (class parseTreeFor: #instVarName2:) = (RBParser 
						parseMethod: 'instVarName2: anObject
						self instVarName21: anObject').
	self 
		assert: (class parseTreeFor: #instVarName21:) = (RBParser 
						parseMethod: 'instVarName21: anObject
						^instVarName2 := anObject').
	self assert: (class parseTreeFor: #instVarName2) 
				= (RBParser parseMethod: 'instVarName2
						^instVarName2').
	self 
		assert: ((model classNamed: #Bar) parseTreeFor: #foo) = (RBParser 
						parseMethod: 'foo
						instVarName1 := instVarName1 + self instVarName2 + ClassVarName1')! !

!RBAbstractInstanceVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testInheritedName
	self shouldFail: (RBAbstractInstanceVariableRefactoring 
			variable: 'name'
			class: RBBasicLintRuleTest)! !

!RBAbstractInstanceVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testAbstractInstanceVariable
	| refactoring class |
	refactoring := RBAbstractInstanceVariableRefactoring 
		variable: 'class'
		class: RBTransformationRuleTest.
	self executeRefactoring: refactoring.
	class := refactoring model classNamed: #RBTransformationRuleTest.
	self assert: (class parseTreeFor: #class1) = (RBParser parseMethod: 'class1 ^class').
	self assert: (class parseTreeFor: #class:) = (RBParser parseMethod: 'class: anObject
	class := anObject').
	self assert: (class parseTreeFor: #superSends) = (RBParser parseMethod: 'superSends
	| rule |
	rule := RBParseTreeRewriter new.
	rule addSearch: ''super `@message: ``@args'' 
				-> (
					[:aNode | 
					(self class1 withAllSubclasses 
						detect: [:each | each includesSelector: aNode selector]
						ifNone: [nil]) isNil] 
							-> ''self `@message: ``@args'').
	self rewriteUsing: rule').
	self assert: (class parseTreeFor: #checkMethod:) = (RBParser parseMethod: 'checkMethod: aSmalllintContext 
	self class: aSmalllintContext selectedClass.
	(rewriteRule executeTree: aSmalllintContext parseTree) 
		ifTrue: 
			[(RecursiveSelfRule executeTree: rewriteRule tree initialAnswer: false) 
				ifFalse: 
					[builder 
						compile: rewriteRule tree printString
						in: self class1
						classified: aSmalllintContext protocols]]')! !

!RBAbstractInstanceVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testNonExistantName
	self shouldFail: (RBAbstractInstanceVariableRefactoring 
			variable: 'foo'
			class: RBBasicLintRuleTest)! !

!RBAbstractInstanceVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testMetaclassInstanceVariables
	| refactoring class |
	class := model metaclassNamed: #Foo.
	class addInstanceVariable: 'foo'.
	class compile: 'zzz ^foo := foo + foo * 2' classified: #(#testing).
	refactoring := RBAbstractInstanceVariableRefactoring 
				model: model
				variable: 'foo'
				class: class.
	self executeRefactoring: refactoring.
	self assert: (class parseTreeFor: #foo1) 
				= (RBParser parseMethod: 'foo1
						^foo').
	self assert: (class parseTreeFor: #foo:) 
				= (RBParser parseMethod: 'foo: anObject
						^foo := anObject').
	self assert: (class parseTreeFor: #zzz) 
				= (RBParser parseMethod: 'zzz ^self foo: self foo1 + self foo1 * 2')! !

!RBAbstractInstanceVariableTest methodsFor: 'set up' stamp: 'CamilloBruni 8/27/2013 15:05'!
setUp
	super setUp.
	model := self abstractVariableTestData.! !

!RBAbstractVariablesRefactoring methodsFor: 'transforming' stamp: 'lr 10/26/2009 22:08'!
classVariableNames
	| nonMetaClass |
	nonMetaClass := fromClass theNonMetaClass.
	^ (nonMetaClass allClassVariableNames collect: [ :each | each asString ]) asSet! !

!RBAbstractVariablesRefactoring methodsFor: 'accessing' stamp: ''!
parseTree
	^tree! !

!RBAbstractVariablesRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^RBCondition empty! !

!RBAbstractVariablesRefactoring methodsFor: 'transforming' stamp: ''!
transform
	self hasVariablesToAbstract 
		ifTrue: 
			[self 
				refactoringWarning: 'This method has direct variable references which<n>will need to be converted to getter/setters.' 
						expandMacros].
	self abstractInstanceVariables.
	self abstractClassVariables! !

!RBAbstractVariablesRefactoring methodsFor: 'transforming' stamp: 'lr 9/8/2011 20:11'!
abstractInstanceVariable: aString 
	| refactoring rewriter |
	refactoring := RBCreateAccessorsForVariableRefactoring 
				model: self model
				variable: aString
				class: fromClass
				classVariable: false.
	self performComponentRefactoring: refactoring.
	rewriter := RBParseTreeRewriter new.
	rewriter
		replace: aString , ' := ``@object'
			with: ('self <1s> ``@object' expandMacrosWith: refactoring setterMethod);
		replace: aString with: 'self ' , refactoring getterMethod.
	(rewriter executeTree: tree) ifTrue: [tree := rewriter tree]! !

!RBAbstractVariablesRefactoring methodsFor: 'testing' stamp: 'lr 2/6/2010 13:34'!
hasVariablesToAbstract
	^ instVarReaders notEmpty or: [ instVarWriters notEmpty or: [ classVarReaders notEmpty or: [ classVarWriters notEmpty ] ] ]! !

!RBAbstractVariablesRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'!
computeVariablesToAbstract
	| searcher |
	instVarReaders := Set new.
	instVarWriters := Set new.
	classVarReaders := Set new.
	classVarWriters := Set new.
	searcher := RBParseTreeSearcher new.
	searcher
		matches: '`var := ``@anything'
			do: [:aNode :answer | self processAssignmentNode: aNode];
		matches: '`var' do: [:aNode :answer | self processReferenceNode: aNode].
	searcher executeTree: tree.
	self removeDefinedClassVariables! !

!RBAbstractVariablesRefactoring methodsFor: 'transforming' stamp: ''!
instanceVariableNames
	^fromClass allInstanceVariableNames asSet! !

!RBAbstractVariablesRefactoring methodsFor: 'transforming' stamp: ''!
processAssignmentNode: aNode 
	| varName |
	varName := aNode variable name.
	ignore = varName ifTrue: [^self].
	(aNode whoDefines: varName) notNil ifTrue: [^self].
	(self instanceVariableNames includes: varName) 
		ifTrue: [instVarWriters add: varName].
	(self classVariableNames includes: varName) 
		ifTrue: [classVarWriters add: varName]! !

!RBAbstractVariablesRefactoring methodsFor: 'transforming' stamp: 'lr 2/6/2010 13:34'!
abstractInstanceVariables
	| variables |
	(instVarReaders isEmpty and: [ instVarWriters isEmpty ])
		ifTrue: [ ^ self].
	variables := Set new.
	variables
		addAll: instVarReaders;
		addAll: instVarWriters.
	variables do: [ :each | self abstractInstanceVariable: each ]! !

!RBAbstractVariablesRefactoring methodsFor: 'transforming' stamp: 'lr 9/8/2011 20:11'!
abstractClassVariable: aString 
	| refactoring rewriter nonMetaClass |
	nonMetaClass := fromClass theNonMetaClass.
	refactoring := RBCreateAccessorsForVariableRefactoring 
		model: self model
		variable: aString
		class: nonMetaClass
		classVariable: true.
	self performComponentRefactoring: refactoring.
	rewriter := RBParseTreeRewriter new.
	fromClass isMeta 
		ifTrue: 
			[ rewriter
				replace: aString , ' := ``@object'
					with: ('self <1s> ``@object' expandMacrosWith: refactoring setterMethod);
				replace: aString
					with: 'self ' , refactoring getterMethod ]
		ifFalse: 
			[ rewriter
				replace: aString , ' := ``@object'
					with: ('self class <1s> ``@object' expandMacrosWith: refactoring setterMethod);
				replace: aString
					with: 'self class ' , refactoring getterMethod ].
	(rewriter executeTree: tree) ifTrue: [ tree := rewriter tree ]! !

!RBAbstractVariablesRefactoring methodsFor: 'transforming' stamp: ''!
processReferenceNode: aNode 
	| varName |
	varName := aNode name.
	ignore = varName ifTrue: [^self].
	(aNode whoDefines: varName) notNil ifTrue: [^self].
	(self instanceVariableNames includes: varName) 
		ifTrue: [instVarReaders add: varName].
	(self classVariableNames includes: varName) 
		ifTrue: [classVarReaders add: varName]! !

!RBAbstractVariablesRefactoring methodsFor: 'initialize-release' stamp: 'lr 9/8/2011 20:11'!
abstractVariablesIn: aBRProgramNode from: fromBehavior toAll: behaviorCollection ignoring: aVariableName 
	| poolRefactoring |
	tree := aBRProgramNode.
	fromClass := self classObjectFor: fromBehavior.
	toClasses := behaviorCollection 
				collect: [:each | self classObjectFor: each].
	ignore := aVariableName.
	poolRefactoring := RBExpandReferencedPoolsRefactoring 
				model: self model
				forMethod: tree
				fromClass: fromClass
				toClasses: toClasses.
	self performComponentRefactoring: poolRefactoring.
	self computeVariablesToAbstract! !

!RBAbstractVariablesRefactoring methodsFor: 'transforming' stamp: 'lr 10/26/2009 22:08'!
removeDefinedClassVariables
	| selectionBlock nonMetaClass |
	nonMetaClass := fromClass theNonMetaClass.
	selectionBlock := 
	[ :varName | 
	(toClasses 
		detect: 
			[ :each | 
			(each theNonMetaClass includesClass: (nonMetaClass whoDefinesClassVariable: varName)) not ]
		ifNone: [ nil ]) notNil ].
	classVarReaders := classVarReaders select: selectionBlock.
	classVarWriters := classVarWriters select: selectionBlock! !

!RBAbstractVariablesRefactoring methodsFor: 'transforming' stamp: 'lr 2/6/2010 13:33'!
abstractClassVariables
	| variables |
	(classVarReaders isEmpty and: [ classVarWriters isEmpty ])
		ifTrue: [ ^ self ].
	variables := Set new.
	variables
		addAll: classVarReaders;
		addAll: classVarWriters.
	variables do: [ :each | self abstractClassVariable: each ]! !

!RBAbstractVariablesRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBSmalltalk abstractVariablesIn: aBRProgramNode from: fromBehavior toAll: behaviorCollection ignoring: aVariableName 
	^(self new)
		model: aRBSmalltalk;
		abstractVariablesIn: aBRProgramNode
			from: fromBehavior
			toAll: behaviorCollection
			ignoring: aVariableName;
		yourself! !

!RBAbstractVariablesRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBSmalltalk abstractVariablesIn: aBRProgramNode from: fromBehavior toAll: behaviorCollection 
	^self 
		model: aRBSmalltalk
		abstractVariablesIn: aBRProgramNode
		from: fromBehavior
		toAll: behaviorCollection
		ignoring: nil! !

!RBAccessorClassRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^ self refactorings
		inject: RBCondition empty
		into: [ :result :each | result & each preconditions ]! !

!RBAccessorClassRefactoring methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/25/2012 18:02'!
refactorings
	| class |
	class := self classObjectFor: className asSymbol.
	^  class instanceVariableNames collect: [ :each | 
		RBCreateAccessorsForVariableRefactoring
			variable: each class: class classVariable: false ]! !

!RBAccessorClassRefactoring methodsFor: 'transforming' stamp: ''!
transform
	self refactorings do: [ :each | self performComponentRefactoring: each ]! !

!RBAddClassChange methodsFor: 'accessing' stamp: 'lr 9/30/2010 18:52'!
classVariableNames
	^ classVariableNames! !

!RBAddClassChange methodsFor: 'private' stamp: 'lr 10/2/2010 13:37'!
definitionClass
	^ Smalltalk globals at: (self superclassName ifNil: [ ^ ProtoObject ])! !

!RBAddClassChange methodsFor: 'accessing' stamp: 'lr 9/30/2010 18:52'!
superclassName
	^ superclassName! !

!RBAddClassChange methodsFor: 'accessing' stamp: 'lr 9/30/2010 18:52'!
instanceVariableNames
	^ instanceVariableNames! !

!RBAddClassChange methodsFor: 'accessing' stamp: 'lr 9/30/2010 18:52'!
category
	^ category! !

!RBAddClassChange methodsFor: '*NautilusRefactoring' stamp: ''!
nameToDisplay

	^ self changeString! !

!RBAddClassChange methodsFor: 'accessing' stamp: 'MartinDias 11/7/2013 18:11'!
sharedPoolNames
	^ poolDictionaryNames! !

!RBAddClassChange methodsFor: 'private' stamp: 'lr 10/1/2010 14:36'!
fillOutDefinition: aDictionary
	superclassName := (aDictionary at: '`@superclass')
		ifNotNil: [ :value | value asSymbol ].
	className := (aDictionary at: '`#className') asSymbol.
	instanceVariableNames := self namesIn: (aDictionary
		at: '`#instanceVariableNames'
		ifAbsent: [ String new ]).
	classVariableNames := self namesIn: (aDictionary
		at: '`#classVariableNames'
		ifAbsent: [ String new ]).
	poolDictionaryNames := self namesIn: (aDictionary
		at: '`#poolDictionaries'
		ifAbsent: [ String new ]).
	category := (aDictionary
		at: '`#category'
		ifAbsent: [ #Unclassified ])
			asSymbol! !

!RBAddClassChange methodsFor: '*NautilusRefactoring' stamp: ''!
textToDisplay

	^ self definition! !

!RBAddClassChange methodsFor: 'converting' stamp: 'lr 9/8/2011 20:10'!
asUndoOperation
	| class |
	class := Smalltalk globals
		at: self changeClassName
		ifAbsent: [ nil ].
	^ class isBehavior
		ifTrue: [ RBAddClassChange definition: class definition ]
		ifFalse: [ RBRemoveClassChange removeClassName: self changeClassName ]! !

!RBAddClassChange class methodsFor: 'private' stamp: 'lr 10/2/2010 13:32'!
definitionPatterns
	^ #('`@superclass subclass: `#className instanceVariableNames: `#instanceVariableNames classVariableNames: `#classVariableNames poolDictionaries: `#poolDictionaries category: `#category'
		'`@superclass subclass: `#className uses: `@traitComposition instanceVariableNames: `#instanceVariableNames classVariableNames: `#classVariableNames poolDictionaries: `#poolDictionaries category: `#category'
		'`@superclass variableByteSubclass: `#className instanceVariableNames: `#instanceVariableNames classVariableNames: `#classVariableNames poolDictionaries: `#poolDictionaries category: `#category'
		'`@superclass variableByteSubclass: `#className uses: `@traitComposition instanceVariableNames: `#instanceVariableNames classVariableNames: `#classVariableNames poolDictionaries: `#poolDictionaries category: `#category'
		'`@superclass variableSubclass: `#className instanceVariableNames: `#instanceVariableNames classVariableNames: `#classVariableNames poolDictionaries: `#poolDictionaries category: `#category'
		'`@superclass variableSubclass: `#className uses: `@traitComposition instanceVariableNames: `#instanceVariableNames classVariableNames: `#classVariableNames poolDictionaries: `#poolDictionaries category: `#category'
		'`@superclass variableWordSubclass: `#className instanceVariableNames: `#instanceVariableNames classVariableNames: `#classVariableNames poolDictionaries: `#poolDictionaries category: `#category'
		'`@superclass variableWordSubclass: `#className uses: `@traitComposition instanceVariableNames: `#instanceVariableNames classVariableNames: `#classVariableNames poolDictionaries: `#poolDictionaries category: `#category'
		'`@superclass weakSubclass: `#className instanceVariableNames: `#instanceVariableNames classVariableNames: `#classVariableNames poolDictionaries: `#poolDictionaries category: `#category'
		'`@superclass weakSubclass: `#className uses: `@traitComposition instanceVariableNames: `#instanceVariableNames classVariableNames: `#classVariableNames poolDictionaries: `#poolDictionaries category: `#category')
		gather: [ :each | Array with: each with: (each copyReplaceAll: '`@superclass' with: 'ProtoObject') , '. `className superclass: `@superclass' ]! !

!RBAddClassRefactoring methodsFor: 'initialize-release' stamp: ''!
addClass: aName superclass: aClass subclasses: aCollection category: aSymbol 
	self className: aName.
	superclass := self classObjectFor: aClass.
	subclasses := aCollection collect: [:each | self classObjectFor: each].
	category := aSymbol! !

!RBAddClassRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	| cond |
	cond := ((RBCondition isMetaclass: superclass) 
				errorMacro: 'Superclass must not be a metaclass') not.
	cond := subclasses inject: cond
				into: 
					[:sub :each | 
					sub 
						& ((RBCondition isMetaclass: each) 
								errorMacro: 'Subclass must <1?not :>be a metaclass') not 
							& (RBCondition isImmediateSubclass: each of: superclass)].
	^cond & (RBCondition isValidClassName: className) 
		& (RBCondition isGlobal: className in: self model) not 
			& (RBCondition isSymbol: category) 
			& ((RBCondition withBlock: [category isEmpty not]) 
					errorMacro: 'Invalid category name')! !

!RBAddClassRefactoring methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream
		nextPutAll: ' addClass: #';
		nextPutAll: className;
		nextPutAll: ' superclass: '.
	superclass storeOn: aStream.
	aStream nextPutAll: ' subclasses: '.
	subclasses asArray storeOn: aStream.
	aStream nextPutAll: ' category: '.
	category storeOn: aStream.
	aStream nextPut: $)! !

!RBAddClassRefactoring methodsFor: 'transforming' stamp: 'bh 4/10/2001 14:25'!
transform
	(self model)
		defineClass: ('<1p> subclass: #<2s> instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: <3p>' 
					expandMacrosWith: superclass
					with: className
					with: category asString);
		reparentClasses: subclasses to: (self model classNamed: className asSymbol)! !

!RBAddClassRefactoring class methodsFor: 'instance creation' stamp: ''!
addClass: aName superclass: aClass subclasses: aCollection category: aSymbol
	^self new
		addClass: aName
		superclass: aClass
		subclasses: aCollection
		category: aSymbol! !

!RBAddClassRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBSmalltalk addClass: aName superclass: aClass subclasses: aCollection category: aSymbol 
	^(self new)
		model: aRBSmalltalk;
		addClass: aName
			superclass: aClass
			subclasses: aCollection
			category: aSymbol;
		yourself! !

!RBAddClassTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testModelAddClass
	| refactoring newClass superClass subclass |
	subclass := model classNamed: #Bar.
	superClass := model classNamed: #Foo.
	refactoring := RBAddClassRefactoring 
		model: model
		addClass: #FooTest
		superclass: superClass
		subclasses: (Array with: subclass)
		category: #'Refactory-Testing'.
	self executeRefactoring: refactoring.
	newClass := model classNamed: #FooTest.
	self assert: newClass superclass = superClass.
	self assert: (superClass subclasses includes: newClass).
	self assert: newClass theMetaClass superclass = superClass theMetaClass.
	self assert: (superClass theMetaClass subclasses includes: newClass theMetaClass).
	self assert: subclass superclass = newClass.
	self assert: (newClass subclasses includes: subclass).
	self assert: subclass theMetaClass superclass = newClass theMetaClass.
	self assert: (newClass theMetaClass subclasses includes: subclass theMetaClass)! !

!RBAddClassTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testMetaClassFailure
	self shouldFail: (RBAddClassRefactoring 
				addClass: #Foo
				superclass: self class class
				subclasses: #()
				category: #'Refactory-Testing')! !

!RBAddClassTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testModelInvalidSubclass
	| refactoring |
	refactoring := RBAddClassRefactoring 
				model: model
				addClass: #Foo2
				superclass: Object
				subclasses: (Array with: (model classNamed: #Bar))
				category: #'Refactory-Tesing'.
	self shouldFail: refactoring! !

!RBAddClassTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testExistingName
	self shouldFail: (RBAddClassRefactoring 
				addClass: #Object
				superclass: self class
				subclasses: #()
				category: #'Refactory-Testing')! !

!RBAddClassTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testAddClass
	| refactoring newClass superClass classTest |
	refactoring := RBAddClassRefactoring 
		addClass: #FooTest
		superclass: RBRefactoringTest
		subclasses: (Array with: self class)
		category: #'Refactory-Testing'.
	self executeRefactoring: refactoring.
	newClass := refactoring model classNamed: #FooTest.
	superClass := refactoring model classNamed: #RBRefactoringTest.
	classTest := refactoring model classNamed: self class name.
	self assert: newClass superclass = superClass.
	self assert: (superClass subclasses includes: newClass).
	self assert: newClass theMetaClass superclass = superClass theMetaClass.
	self assert: (superClass theMetaClass subclasses includes: newClass theMetaClass).
	self assert: classTest superclass = newClass.
	self assert: (newClass subclasses includes: classTest).
	self assert: classTest theMetaClass superclass = newClass theMetaClass.
	self assert: (newClass theMetaClass subclasses includes: classTest theMetaClass)! !

!RBAddClassTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testInvalidSubclass
	self shouldFail: (RBAddClassRefactoring 
			addClass: #Foo
			superclass: RBCompositeLintRuleTest
			subclasses: (Array with: RBBasicLintRuleTest)
			category: #'Refactory-Tesing')! !

!RBAddClassTest methodsFor: 'set up' stamp: 'CamilloBruni 8/27/2013 15:05'!
setUp
	super setUp.
	model := self abstractVariableTestData.! !

!RBAddClassTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testModelExistingName
	| refactoring |
	refactoring := RBAddClassRefactoring 
				model: model
				addClass: #Foo
				superclass: Object
				subclasses: #()
				category: #'Refactory-Testing'.
	self shouldFail: refactoring! !

!RBAddClassTraitChange methodsFor: 'converting' stamp: 'lr 9/30/2010 19:47'!
asUndoOperation
	^ self class definition: self changeClass classTrait definition! !

!RBAddClassTraitChange methodsFor: 'private' stamp: 'lr 9/30/2010 19:47'!
definitionClass
	^ self changeClass! !

!RBAddClassTraitChange methodsFor: 'initialization' stamp: 'lr 10/1/2010 14:36'!
fillOutDefinition: aDictionary
	className := (aDictionary at: '`traitName') asSymbol! !

!RBAddClassTraitChange class methodsFor: 'private' stamp: 'lr 9/30/2010 19:46'!
definitionPatterns
	^ #('`traitName classTrait uses: `@traitComposition')! !

!RBAddClassVariableChange methodsFor: 'private' stamp: 'lr 3/20/2011 11:27'!
changeSymbol
	^ #addClassVarNamed:! !

!RBAddClassVariableChange methodsFor: 'accessing' stamp: 'lr 10/15/2010 08:31'!
changeClass: aBehavior
	super changeClass: aBehavior.
	isMeta := false! !

!RBAddClassVariableChange methodsFor: 'printing' stamp: 'lr 10/15/2010 09:37'!
changeString
	^ 'Add class variable <1s> to <2s>' 
		expandMacrosWith: self variable
		with: self displayClassName! !

!RBAddClassVariableChange methodsFor: 'converting' stamp: 'lr 9/8/2011 20:10'!
asUndoOperation
	^ RBRemoveClassVariableChange remove: self variable from: self changeClass! !

!RBAddClassVariableRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^(RBCondition isMetaclass: class) not 
		& (RBCondition isValidClassVarName: variableName for: class) 
			& (RBCondition hierarchyOf: class definesVariable: variableName asString) 
					not 
			& (RBCondition isGlobal: variableName in: self model) not! !

!RBAddClassVariableRefactoring methodsFor: 'transforming' stamp: ''!
transform
	class addClassVariable: variableName! !

!RBAddClassVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testMetaClassFailure
	self shouldFail: (RBAddClassVariableRefactoring 
			variable: #VariableName
			class: RBTransformationRuleTest class)! !

!RBAddClassVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testModelMetaclass
	| refactoring |
	refactoring := RBAddClassVariableRefactoring 
		model: model
		variable: #ClassVarName3
		class: (model classNamed: #Bar) theMetaClass.
	self shouldFail: refactoring! !

!RBAddClassVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testAlreadyExistingName
	self
		shouldFail: (RBAddClassVariableRefactoring 
				variable: #RecursiveSelfRule
				class: RBTransformationRuleTest);
		shouldFail: (RBAddClassVariableRefactoring 
				variable: self objectClassVariable
				class: RBTransformationRuleTest)! !

!RBAddClassVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testMetaclass
	| refactoring |
	refactoring := RBAddClassVariableRefactoring 
		variable: #ClassVarName3
		class: (model classNamed: #Object) theMetaClass.
	refactoring model: model.
	self shouldFail: refactoring! !

!RBAddClassVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testModelAddClassVariable
	| refactoring |
	refactoring := RBAddClassVariableRefactoring 
				model: model
				variable: #ClassVarName3
				class: (model classNamed: #Bar).
	self executeRefactoring: refactoring.
	self assert: ((model classNamed: #Bar) 
				directlyDefinesClassVariable: #ClassVarName3)! !

!RBAddClassVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testAddClassVariable
	| refactoring |
	refactoring := RBAddClassVariableRefactoring 
		variable: 'Asdf'
		class: RBTransformationRuleTest.
	self executeRefactoring: refactoring.
	self assert: ((refactoring model classNamed: #RBTransformationRuleTest) directlyDefinesClassVariable: #Asdf)! !

!RBAddClassVariableTest methodsFor: 'set up' stamp: 'CamilloBruni 8/27/2013 15:05'!
setUp
	super setUp.
	model := self abstractVariableTestData.! !

!RBAddClassVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testModelAlreadyExistingName
	| refactoring |
	refactoring := RBAddClassVariableRefactoring 
				model: model
				variable: #ClassVarName2
				class: (model classNamed: #Bar).
	self shouldFail: refactoring! !

!RBAddInstanceVariableChange methodsFor: 'printing' stamp: 'lr 10/14/2010 20:52'!
changeString
	^ 'Add instance variable <1s> to <2s>'
		expandMacrosWith: self variable
		with: self displayClassName! !

!RBAddInstanceVariableChange methodsFor: 'private' stamp: 'lr 3/20/2011 11:26'!
changeSymbol
	^ #addInstVarNamed:! !

!RBAddInstanceVariableChange methodsFor: 'converting' stamp: 'lr 9/8/2011 20:10'!
asUndoOperation
	^ RBRemoveInstanceVariableChange remove: self variable from: self changeClass! !

!RBAddInstanceVariableRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^(RBCondition isValidInstanceVariableName: variableName for: class) 
		& (RBCondition hierarchyOf: class definesVariable: variableName) not 
			& (RBCondition isGlobal: variableName in: self model) not! !

!RBAddInstanceVariableRefactoring methodsFor: 'transforming' stamp: ''!
transform
	class addInstanceVariable: variableName! !

!RBAddInstanceVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testAddToModel
	| refactoring |
	model := RBNamespace new.
	model name: 'Add instance variable'.
	model 
		defineClass: 'Object subclass: #FOOBAR 
				instanceVariableNames: ''fdsa'' 	
				classVariableNames: ''''
				poolDictionaries: ''''
				category: #''Refactory-Test data'''.
	refactoring := RBAddInstanceVariableRefactoring 
				model: model
				variable: 'asdf'
				class: (model classNamed: #FOOBAR).
	self executeRefactoring: refactoring.
	self assert: ((refactoring model classNamed: #FOOBAR) 
				directlyDefinesInstanceVariable: 'asdf')! !

!RBAddInstanceVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testNewExistingName
	| refactoring |
	model := RBNamespace new.
	model name: 'Add instance variable'.
	model 
		defineClass: 'Object subclass: #FOOBAR 
				instanceVariableNames: ''asdf'' 	
				classVariableNames: ''''
				poolDictionaries: ''''
				category: #''Refactory-Test data'''.
	refactoring := RBAddInstanceVariableRefactoring 
				model: model
				variable: 'asdf'
				class: (model classNamed: #FOOBAR).
	self shouldFail: refactoring! !

!RBAddInstanceVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testModelMetaclassAlreadyExistingName
	| refactoring |
	(model metaclassNamed: #Foo) addInstanceVariable: 'instVarName1'.
	refactoring := RBAddInstanceVariableRefactoring 
				model: model
				variable: 'instVarName1'
				class: (model classNamed: #Bar).
	self shouldFail: refactoring! !

!RBAddInstanceVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testNewHierarchyExistingName
	| refactoring |
	model := RBNamespace new.
	model name: 'Add instance variable'.
	model 
		defineClass: 'Object subclass: #FOOBAR 
				instanceVariableNames: ''asdf'' 	
				classVariableNames: ''''
				poolDictionaries: ''''
				category: #''Refactory-Test data'''.
	model 
		defineClass: 'FOOBAR subclass: #BARFOO 
				instanceVariableNames: '''' 	
				classVariableNames: ''''
				poolDictionaries: ''''
				category: ''Refactory-Test data'''.
	refactoring := RBAddInstanceVariableRefactoring 
				model: model
				variable: 'asdf'
				class: (model classNamed: #BARFOO).
	self shouldFail: refactoring! !

!RBAddInstanceVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testAlreadyExistingName
	self
		shouldFail: (RBAddInstanceVariableRefactoring 
				variable: 'class'
				class: RBTransformationRuleTest);
		shouldFail: (RBAddInstanceVariableRefactoring 
				variable: 'name'
				class: RBTransformationRuleTest)! !

!RBAddInstanceVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testAddInstanceVariable
	| refactoring |
	refactoring := RBAddInstanceVariableRefactoring 
		variable: 'asdf'
		class: RBTransformationRuleTest.
	self executeRefactoring: refactoring.
	self assert: ((refactoring model classNamed: #RBTransformationRuleTest) directlyDefinesInstanceVariable: 'asdf')! !

!RBAddInstanceVariableTest methodsFor: 'set up' stamp: 'CamilloBruni 8/27/2013 15:05'!
setUp
	super setUp.
	model := self abstractVariableTestData.! !

!RBAddInstanceVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testModelAlreadyExistingName
	| refactoring |
	refactoring := RBAddInstanceVariableRefactoring 
				model: model
				variable: 'instVarName1'
				class: (model classNamed: #Bar).
	self shouldFail: refactoring! !

!RBAddMetaclassChange methodsFor: 'private' stamp: 'lr 9/30/2010 14:21'!
definitionClass
	^ self changeClass! !

!RBAddMetaclassChange methodsFor: 'initialization' stamp: 'lr 10/1/2010 14:37'!
fillOutDefinition: aDictionary
	className := (aDictionary at: '`className') asSymbol.
	classInstanceVariableNames := self namesIn: (aDictionary
		at: '`#instanceVariableNames'
		ifAbsent: [ String new ])! !

!RBAddMetaclassChange methodsFor: 'converting' stamp: 'lr 9/30/2010 14:32'!
asUndoOperation
	^ self class definition: self changeClass class definition! !

!RBAddMetaclassChange methodsFor: 'accessing' stamp: 'lr 9/30/2010 18:57'!
classInstanceVariableNames
	^ classInstanceVariableNames! !

!RBAddMetaclassChange class methodsFor: 'private' stamp: 'lr 9/30/2010 19:19'!
definitionPatterns
	^ #('`className class instanceVariableNames: `#instanceVariableNames'
		'`className class uses: `@traitComposition instanceVariableNames: `#instanceVariableNames')! !

!RBAddMethodChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 21:24'!
selector
	selector isNil ifTrue: [ 
		selector := RBParser parseMethodPattern: source.
		selector isNil
			ifTrue: [ selector := #unknown ] ].
	^ selector! !

!RBAddMethodChange methodsFor: 'comparing' stamp: 'lr 9/6/2010 21:25'!
hash
	^ self parseTree hash! !

!RBAddMethodChange methodsFor: 'accessing' stamp: 'lr 9/7/2010 19:10'!
protocol
	^ self protocols first! !

!RBAddMethodChange methodsFor: 'private' stamp: 'lr 9/6/2010 21:27'!
parseTree
	^ RBParser parseMethod: source onError: [ :str :pos | ^ nil ]! !

!RBAddMethodChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 11:29'!
changeForMetaclass: aClassName selector: aSelector 
	^ (isMeta and: [ self selector = aSelector and: [ className = aClassName ] ])
		ifTrue: [ self ]
		ifFalse: [ nil ]! !

!RBAddMethodChange methodsFor: 'initialize-release' stamp: 'lr 9/8/2011 20:25'!
class: aClass source: aString contoller: aController
	self changeClass: aClass.
	source := aString.
	self protocols: (RBBrowserEnvironment new whichProtocolIncludes: self selector in: aClass).
	controller := aController! !

!RBAddMethodChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 11:28'!
changeForClass: aClassName selector: aSelector 
	^ (isMeta not and: [ self selector = aSelector and: [ className = aClassName ] ])
		ifTrue: [ self ]
		ifFalse: [ nil ]! !

!RBAddMethodChange methodsFor: 'initialize-release' stamp: 'EstebanLorenzano 6/28/2013 12:25'!
protocols: aCollectionOrString
	protocols := aCollectionOrString isString
		ifTrue: [ 	
			aCollectionOrString = Protocol unclassified 
				ifTrue: [ protocols := #(accessing) ]
				ifFalse: [ Array with: aCollectionOrString ] ]
		ifFalse: [ aCollectionOrString ].
		
! !

!RBAddMethodChange methodsFor: 'initialize-release' stamp: ''!
class: aClass protocol: aProtocol source: aString 
	self changeClass: aClass.
	self protocols: aProtocol.
	source := aString! !

!RBAddMethodChange methodsFor: 'printing' stamp: 'lr 4/7/2010 08:22'!
changeString
	^ self displayClassName , '>>' , self selector! !

!RBAddMethodChange methodsFor: '*NautilusRefactoring' stamp: 'MarcusDenker 9/5/2013 14:07'!
accept: aText notifying: aController
	"Just to make sure that it compiles, try with the standard compiler."
	
	| compiler |
	compiler := self changeClass
		ifNil: [ Object compiler ]
		ifNotNil: [:changeClass | changeClass compiler ].
		
	compiler
		source: aText asString;
		class:  self changeClass;
		requestor: aController;
		failBlock: [ ^ false ];
		translate.
	
		
	self 
		class: self changeClass
		protocol: self protocol
		source: aText asString.
		
	^ true! !

!RBAddMethodChange methodsFor: 'initialize-release' stamp: 'lr 9/30/2010 20:02'!
controller: aController 
	controller := aController! !

!RBAddMethodChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 21:24'!
protocols
	^ protocols! !

!RBAddMethodChange methodsFor: 'comparing' stamp: 'lr 9/6/2010 21:24'!
= anAddMethodChange
	super = anAddMethodChange
		ifFalse: [ ^ false ].
	^ self parseTree = anAddMethodChange parseTree! !

!RBAddMethodChange methodsFor: 'initialize-release' stamp: 'lr 9/30/2010 20:04'!
class: aClass protocol: aProtocol source: aString controller: aController 
	self changeClass: aClass.
	self protocols: aProtocol.
	source := aString.
	controller := aController! !

!RBAddMethodChange methodsFor: 'printing' stamp: 'StephaneDucasse 9/13/2013 21:43'!
printOn: aStream 
	aStream
		nextPut: $!!;
		nextPutAll: self displayClassName;
		nextPutAll: ' methodsFor: ''';
		nextPutAll: self protocol;
		nextPutAll: ''' stamp: ';
		print: self changeStamp;
		nextPut: $!!;
		cr;
		nextPutAll: (source copyReplaceAll: '!!' with: '!!!!');
		nextPutAll: '!! !!'! !

!RBAddMethodChange methodsFor: '*NautilusRefactoring' stamp: ''!
oldVersionTextToDisplay

	| class |
	class := Smalltalk 
				at: className asSymbol
				ifAbsent: [ ^ super oldVersionTextToDisplay ].
				
	^ class methodDict 
			at: self selector
			ifPresent: [:method | method sourceCode ]
			ifAbsent: [ super oldVersionTextToDisplay ]! !

!RBAddMethodChange methodsFor: 'accessing' stamp: 'lr 11/1/2009 23:25'!
source
	^ source! !

!RBAddMethodChange methodsFor: 'private' stamp: 'lr 9/30/2010 20:02'!
controller
	^ controller! !

!RBAddMethodChange methodsFor: 'accessing' stamp: 'lr 9/30/2010 20:02'!
definedSelector
	^ definedSelector! !

!RBAddMethodChange methodsFor: 'private' stamp: 'lr 10/14/2010 20:50'!
primitiveExecute
	definedSelector := self changeClass 
		compile: self source
		classified: self protocol
		notifying: self controller! !

!RBAddMethodChange methodsFor: '*NautilusRefactoring' stamp: ''!
textToDisplay

	^ self source! !

!RBAddMethodChange methodsFor: 'converting' stamp: 'lr 9/8/2011 20:25'!
asUndoOperation
	^ (self changeClass includesSelector: self selector)
		ifTrue: [ 
			| oldProtocol |
			oldProtocol := RBBrowserEnvironment new whichProtocolIncludes: self selector in: self changeClass.
			oldProtocol isNil
				ifTrue: [ oldProtocol := #accessing ].
			RBAddMethodChange compile: (self methodSourceFor: self selector) in: self changeClass classified: oldProtocol ]
		ifFalse: [ RBRemoveMethodChange remove: selector from: self changeClass ]! !

!RBAddMethodChange class methodsFor: 'instance creation' stamp: 'lr 9/30/2010 20:12'!
compile: aString in: aClass
	^ self compile: aString in: aClass for: nil! !

!RBAddMethodChange class methodsFor: 'instance creation' stamp: 'lr 9/30/2010 20:04'!
compile: aString in: aBehavior classified: aProtocol for: aController
	^ self new class: aBehavior protocol: aProtocol source: aString controller: aController! !

!RBAddMethodChange class methodsFor: 'instance creation' stamp: 'lr 9/30/2010 20:12'!
compile: aString in: aBehavior classified: aProtocol
	^ self compile: aString in: aBehavior classified: aProtocol for: nil! !

!RBAddMethodChange class methodsFor: 'instance creation' stamp: 'lr 9/30/2010 20:04'!
compile: aString in: aClass for: aController
	^ self new class: aClass source: aString contoller: aController! !

!RBAddMethodRefactoring methodsFor: 'initialize-release' stamp: ''!
addMethod: aString toClass: aClass inProtocols: protocolList 
	class := self classObjectFor: aClass.
	source := aString.
	protocols := protocolList! !

!RBAddMethodRefactoring methodsFor: 'preconditions' stamp: 'CamilloBruni 10/7/2012 23:57'!
preconditions
	| selector method |
	method := RBParser parseMethod: source
				onError: 
					[:string :position | 
					^RBCondition 
						withBlock: [self refactoringFailure: 'The sources could not be parsed']].
	selector := method selector.
	selector isNil ifTrue: [self refactoringFailure: 'Invalid source.'].
	^(RBCondition canUnderstand: selector in: class) not! !

!RBAddMethodRefactoring methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream
		nextPutAll: ' addMethod: ''';
		nextPutAll: source;
		nextPutAll: ''' toClass: '.
	class storeOn: aStream.
	aStream nextPutAll: ' inProtocols: '.
	protocols storeOn: aStream.
	aStream nextPut: $)! !

!RBAddMethodRefactoring methodsFor: 'transforming' stamp: ''!
transform
	class compile: source classified: protocols! !

!RBAddMethodRefactoring class methodsFor: 'instance creation' stamp: ''!
addMethod: aString toClass: aClass inProtocols: protocolList 
	^self new addMethod: aString
		toClass: aClass
		inProtocols: protocolList! !

!RBAddMethodRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBSmalltalk addMethod: aString toClass: aClass inProtocols: protocolList 
	^(self new)
		model: aRBSmalltalk;
		addMethod: aString
			toClass: aClass
			inProtocols: protocolList;
		yourself! !

!RBAddMethodTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testExistingSelector
	self shouldFail: (RBAddMethodRefactoring 
			addMethod: 'printString ^super printString'
			toClass: RBBasicLintRuleTest
			inProtocols: #(#accessing ))! !

!RBAddMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testModelAddMethod
	| refactoring class |
	class := model metaclassNamed: #Bar.
	refactoring := RBAddMethodRefactoring 
				model: model
				addMethod: 'printString1 ^super printString'
				toClass: class
				inProtocols: #(#accessing).
	self executeRefactoring: refactoring.
	self assert: (class parseTreeFor: #printString1) 
				= (RBParser parseMethod: 'printString1 ^super printString')! !

!RBAddMethodTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testModelExistingSelector
	| refactoring |
	refactoring := RBAddMethodRefactoring 
				model: model
				addMethod: 'classVarName1 ^super printString'
				toClass: (model classNamed: #Bar)
				inProtocols: #(#accessing).
	self shouldFail: refactoring! !

!RBAddMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testAddMethod
	| refactoring |
	refactoring := RBAddMethodRefactoring 
		addMethod: 'printString1 ^super printString'
		toClass: RBBasicLintRuleTest
		inProtocols: #(#accessing ).
	self executeRefactoring: refactoring.
	self assert: ((refactoring model classNamed: #RBBasicLintRuleTest) parseTreeFor: #printString1) = (RBParser parseMethod: 'printString1 ^super printString')! !

!RBAddMethodTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testBadMethod
	self shouldFail: (RBAddMethodRefactoring 
			addMethod: 'asdf ^super ^printString'
			toClass: RBBasicLintRuleTest
			inProtocols: #(#accessing ))! !

!RBAddMethodTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testModelInheritedSelector
	| refactoring |
	refactoring := RBAddMethodRefactoring 
				model: model
				addMethod: 'printString ^super printString'
				toClass: (model classNamed: #Bar)
				inProtocols: #(#accessing).
	self shouldFail: refactoring! !

!RBAddMethodTest methodsFor: 'set up' stamp: 'CamilloBruni 8/27/2013 15:05'!
setUp
	super setUp.
	model := self abstractVariableTestData.! !

!RBAddParameterRefactoring methodsFor: 'private' stamp: ''!
safeVariableNameFor: aClass temporaries: allTempVars 
	| baseString i newString |
	newString := baseString := 'anObject'.
	i := 0.
	
	[(allTempVars includes: newString) 
		or: [aClass definesInstanceVariable: newString]] 
			whileTrue: 
				[i := i + 1.
				newString := baseString , i printString].
	^newString! !

!RBAddParameterRefactoring methodsFor: 'private' stamp: ''!
newSelectorString
	| stream keywords |
	stream := WriteStream on: String new.
	keywords := newSelector keywords.
	1 to: keywords size
		do: 
			[:i | 
			stream nextPutAll: (keywords at: i).
			i == keywords size 
				ifTrue: 
					[stream
						nextPut: $(;
						nextPutAll: initializer;
						nextPut: $)]
				ifFalse: 
					[stream
						nextPutAll: ' ``@arg';
						nextPutAll: i printString].
			stream nextPut: $ ].
	^stream contents! !

!RBAddParameterRefactoring methodsFor: 'private' stamp: 'lr 2/21/2010 14:52'!
modifyImplementorParseTree: parseTree in: aClass 
	| name newArg allTempVars |
	allTempVars := parseTree allDefinedVariables.
	name := self safeVariableNameFor: aClass temporaries: allTempVars.
	newArg := RBVariableNode named: name.
	parseTree 
		renameSelector: newSelector
		andArguments: parseTree arguments , (Array with: newArg)! !

!RBAddParameterRefactoring methodsFor: 'preconditions' stamp: 'CamilloBruni 10/8/2012 00:13'!
verifyInitializationExpression
	| tree |
	tree := RBParser parseExpression: initializer
				onError: 
					[:msg :index | 
					self refactoringFailure: 'Illegal initialization code because:.' , msg].
	tree isValue 
		ifFalse: 
			[self 
				refactoringFailure: 'The initialization code cannot be a return node or a list of statements'].
	self checkVariableReferencesIn: tree! !

!RBAddParameterRefactoring methodsFor: 'preconditions' stamp: 'CamilloBruni 10/8/2012 00:13'!
myConditions
	^RBCondition withBlock: 
			[oldSelector numArgs + 1 = newSelector numArgs 
				ifFalse: 
					[self refactoringFailure: newSelector printString 
								, ' doesn''t have the proper number of arguments.'].
			self verifyInitializationExpression.
			true]! !

!RBAddParameterRefactoring methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream
		nextPutAll: ' addParameterToMethod: #';
		nextPutAll: oldSelector;
		nextPutAll: ' in: '.
	class storeOn: aStream.
	aStream
		nextPutAll: ' newSelector: #';
		nextPutAll: newSelector;
		nextPutAll: ' initializer: ''';
		nextPutAll: initializer;
		nextPutAll: ''')'! !

!RBAddParameterRefactoring methodsFor: 'private' stamp: ''!
senders
	senders isNil 
		ifTrue: 
			[senders := Set new.
			self model allReferencesTo: oldSelector
				do: [:each | senders add: each modelClass]].
	^senders! !

!RBAddParameterRefactoring methodsFor: 'private' stamp: 'lr 11/2/2009 00:14'!
parseTreeRewriter
	| rewriteRule oldString newString |
	rewriteRule := RBParseTreeRewriter new.
	oldString := self buildSelectorString: oldSelector.
	newString := self newSelectorString.
	rewriteRule replace: '``@object ' , oldString
		with: '``@object ' , newString.
	^rewriteRule! !

!RBAddParameterRefactoring methodsFor: 'initialize-release' stamp: 'md 3/15/2006 17:28'!
addParameterToMethod: aSelector in: aClass newSelector: newSel initializer: init 
	self 
		renameMethod: aSelector
		in: aClass
		to: newSel
		permutation: (1 to: newSel numArgs).
	initializer := init! !

!RBAddParameterRefactoring methodsFor: 'preconditions' stamp: ''!
checkSendersAccessTo: name 
	| violatorClass |
	(#('self' 'super') includes: name) ifTrue: [^self].
	violatorClass := self senders 
				detect: [:each | (self canReferenceVariable: name in: each) not]
				ifNone: [nil].
	violatorClass notNil 
		ifTrue: 
			[self refactoringError: ('<1s> doesn''t appear to be defined in <2p>' 
						expandMacrosWith: name
						with: violatorClass)]! !

!RBAddParameterRefactoring methodsFor: 'preconditions' stamp: 'lr 11/2/2009 00:14'!
checkVariableReferencesIn: aParseTree 
	| searcher |
	searcher := RBParseTreeSearcher new.
	searcher matches: '`var'
		do: 
			[:aNode :answer | 
			| name |
			name := aNode name.
			(aNode whoDefines: name) isNil ifTrue: [self checkSendersAccessTo: name]].
	searcher executeTree: aParseTree! !

!RBAddParameterRefactoring class methodsFor: 'instance creation' stamp: ''!
addParameterToMethod: aSelector in: aClass newSelector: newSelector initializer: init 
	^self new addParameterToMethod: aSelector
		in: aClass
		newSelector: newSelector
		initializer: init! !

!RBAddParameterRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBSmalltalk addParameterToMethod: aSelector in: aClass newSelector: newSelector initializer: init 
	^(self new)
		model: aRBSmalltalk;
		addParameterToMethod: aSelector
			in: aClass
			newSelector: newSelector
			initializer: init;
		yourself! !

!RBAddParameterTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testAddParameterForTwoArgumentMessage
	| refactoring class |
	refactoring := RBAddParameterRefactoring 
		addParameterToMethod: ('called:' , 'on:') asSymbol
		in: RBRefactoryTestDataApp
		newSelector: #called:bar:on:
		initializer: '#(1.0)'.
	self executeRefactoring: refactoring.
	class := refactoring model classNamed: #RBRefactoryTestDataApp.
	self assert: (class parseTreeFor: #called:bar:on:) = (RBParser parseMethod: 'called: anObject bar: aBlock on: anObject1
							Transcript
								show: anObject printString;
								cr.
								aBlock value').
	self assert: (class parseTreeFor: #caller) = (RBParser parseMethod: 'caller
							| anObject |
							anObject := 5.
							self 
								called: anObject + 1
								bar: [^anObject] on: #(1.0)').
	self deny: (class directlyDefinesMethod: ('called:' , 'on:') asSymbol)! !

!RBAddParameterTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testModelNonExistantName
	| refactoring |
	(model classNamed: #RBLintRuleTest) removeMethod: #name.
	refactoring := RBAddParameterRefactoring 
		model: model
		addParameterToMethod: #name
		in: RBLintRuleTest
		newSelector: #nameNew:
		initializer: 'nil'.
	self shouldFail: refactoring! !

!RBAddParameterTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testPrimitiveMethods
	| refactoring |
	(model classNamed: #Object) 
		compile: 'foo <primitive: 100> ^#() primitiveFailed'
		classified: #(#accessing).
	refactoring := RBAddParameterRefactoring 
				model: model
				addParameterToMethod: #foo
				in: Object
				newSelector: #foo123124321s:
				initializer: '1'.
	self shouldFail: refactoring.
	refactoring := RBAddParameterRefactoring 
				addParameterToMethod: #at:
				in: Object
				newSelector: #at:foo:
				initializer: '1'.
	self shouldFail: refactoring.
	! !

!RBAddParameterTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testBadInitializationCode
	self
		shouldFail: (RBAddParameterRefactoring 
				addParameterToMethod: #name
				in: RBLintRuleTest
				newSelector: #name:
				initializer: 'foo:');
		shouldFail: (RBAddParameterRefactoring 
				addParameterToMethod: #name
				in: RBLintRuleTest
				newSelector: #name:
				initializer: 'foo')! !

!RBAddParameterTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testAddParameterThatReferencesSelf
	| refactoring class |
	refactoring := RBAddParameterRefactoring 
		addParameterToMethod: ('test' , 'Foo:') asSymbol
		in: RBRefactoryTestDataApp
		newSelector: #testFoo:bar:
		initializer: 'self printString'.
	self executeRefactoring: refactoring.
	class := refactoring model classNamed: #RBRefactoryTestDataApp.
	self assert: (class parseTreeFor: #testFoo:bar:) = (RBParser parseMethod: 'testFoo: anObject bar: anObject1
								^self class + anObject').
	self assert: (class parseTreeFor: #callFoo) = (RBParser parseMethod: 'callFoo ^self testFoo: 5 bar: (self printString)').
	self deny: (class directlyDefinesMethod: ('test' , 'Foo:') asSymbol)! !

!RBAddParameterTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testAddParameterThatReferencesModelGlobal
	| refactoring class |
	refactoring := RBAddParameterRefactoring 
		model: model
		addParameterToMethod: ('test' , 'Foo:') asSymbol
		in: RBRefactoryTestDataApp
		newSelector: #testFoo:bar:
		initializer: 'Bar new'.
	self executeRefactoring: refactoring.
	class := refactoring model classNamed: #RBRefactoryTestDataApp.
	self assert: (class parseTreeFor: #testFoo:bar:) = (RBParser parseMethod: 'testFoo: anObject bar: anObject1
								^self class + anObject').
	self assert: (class parseTreeFor: #callFoo) = (RBParser parseMethod: 'callFoo ^self testFoo: 5 bar: (Bar new)').
	self deny: (class directlyDefinesMethod: ('test' , 'Foo:') asSymbol)! !

!RBAddParameterTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testModelBadInitializationCode
	| refactoring |
	model removeClassNamed: #RBRefactoring.
	refactoring := RBAddParameterRefactoring 
		model: model
		addParameterToMethod: #name1
		in: RBLintRuleTest
		newSelector: #name1:
		initializer: 'AddParameterRefactoring new'.
	self shouldFail: refactoring! !

!RBAddParameterTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testNonExistantName
	self shouldFail: (RBAddParameterRefactoring 
			addParameterToMethod: #name1
			in: RBLintRuleTest
			newSelector: #name1:
			initializer: 'nil')! !

!RBAddParameterTest methodsFor: 'set up' stamp: 'CamilloBruni 8/27/2013 15:06'!
setUp
	super setUp.
	model := self abstractVariableTestData.! !

!RBAddParameterTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testAddParameterThatReferencesGlobalAndLiteral
	| refactoring class |
	refactoring := RBAddParameterRefactoring 
		addParameterToMethod: ('test' , 'Foo:') asSymbol
		in: RBRefactoryTestDataApp
		newSelector: #testFoo:bar:
		initializer: 'OrderedCollection new: 5'.
	self executeRefactoring: refactoring.
	class := refactoring model classNamed: #RBRefactoryTestDataApp.
	self assert: (class parseTreeFor: #testFoo:bar:) = (RBParser parseMethod: 'testFoo: anObject bar: anObject1
								^self class + anObject').
	self assert: (class parseTreeFor: #callFoo) = (RBParser parseMethod: 'callFoo ^self testFoo: 5 bar: (OrderedCollection new: 5)').
	self deny: (class directlyDefinesMethod: ('test' , 'Foo:') asSymbol)! !

!RBAddPoolVariableChange methodsFor: 'private' stamp: 'lr 9/6/2010 21:30'!
changeSymbol
	^ #addSharedPool:! !

!RBAddPoolVariableChange methodsFor: 'accessing' stamp: 'lr 10/15/2010 08:31'!
changeClass: aBehavior
	super changeClass: aBehavior.
	isMeta := false! !

!RBAddPoolVariableChange methodsFor: 'printing' stamp: 'lr 4/7/2010 08:19'!
changeString
	^ 'Add pool variable <1s> to <2s>' 
		expandMacrosWith: self variable
		with: self displayClassName! !

!RBAddPoolVariableChange methodsFor: 'converting' stamp: 'lr 9/8/2011 20:10'!
asUndoOperation
	^ RBRemovePoolVariableChange remove: self variable from: self changeClass! !

!RBAddRemoveDependentsRule commentStamp: 'StephaneDucasse 11/29/2014 21:15'!
Check that the number of addDependent: message sends in a class is less than or equal to the number of removeDependent: messages. If there are more addDependent: messages that may signify that some dependents are not being released, which may lead to memory leaks.!
!RBAddRemoveDependentsRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'!
resultClass
	^ RBClassEnvironment! !

!RBAddRemoveDependentsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Possible bugs'! !

!RBAddRemoveDependentsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Number of addDependent: messages > removeDependent:'! !

!RBAddRemoveDependentsRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 14:11'!
category 
	^ 'Potential Bugs'! !

!RBAddRemoveDependentsRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:47'!
checkClass: aClass 
	| count |
	count := 0.
	((Set withAll: (aClass whichSelectorsReferTo: #addDependent:))
		addAll: (aClass whichSelectorsReferTo: #removeDependent:);
		yourself) do: 
		[ :sel | 
		(aClass compiledMethodAt: sel) messages do: 
			[ :each | 
			each = #addDependent: ifTrue: [ count := count + 1 ].
			each = #removeDependent: ifTrue: [ count := count - 1 ] ] ].
	count > 0 ifTrue: [ result addClass: aClass ]! !

!RBAddRemoveDependentsRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'AddRemoveDependentsRule'! !

!RBAddTraitChange methodsFor: 'private' stamp: 'lr 9/30/2010 19:39'!
definitionClass
	^ Trait! !

!RBAddTraitChange methodsFor: 'initialization' stamp: 'lr 10/1/2010 14:37'!
fillOutDefinition: aDictionary
	className := (aDictionary at: '`#traitName') asSymbol.
	category := (aDictionary at: '`#category' ifAbsent: [ #Unclassified ]) asSymbol! !

!RBAddTraitChange methodsFor: 'accessing' stamp: 'lr 9/30/2010 19:29'!
category
	^ category! !

!RBAddTraitChange methodsFor: 'converting' stamp: 'lr 9/8/2011 20:10'!
asUndoOperation
	| trait |
	trait := Smalltalk globals
		at: self changeClassName
		ifAbsent: [ nil ].
	^ trait isTrait
		ifTrue: [ RBAddTraitChange definition: trait definition ]
		ifFalse: [ RBRemoveClassChange removeClassName: self changeClassName ]! !

!RBAddTraitChange class methodsFor: 'private' stamp: 'lr 9/30/2010 19:46'!
definitionPatterns
	^ #('Trait named: `#traitName uses: `@traitComposition category: `#category')! !

!RBAllAnyNoneSatisfyRule commentStamp: 'StephaneDucasse 11/29/2014 17:33'!
Replace ad-hoc implementations (using explicit logic based on do:) of ==allSatisfy:==, ==anySatisfy:== and ==noneSatisfy:== by the adequate calls to ==allSatisfy:==, ==anySatisfy:== or ==noneSatisfy:==. 

For example 

[[[  
collection do: [ :each |
				...
				condition
					ifFalse: [ ^ false ] ]
]]]
is transformed into 

[[[  
collection allSatisfy: [ :each | condition ]
]]]!
!RBAllAnyNoneSatisfyRule methodsFor: 'initialization' stamp: 'lr 1/3/2010 12:04'!
initialize
	super initialize.
	self rewriteRule
	
		" allSatisfy: "
		replaceMethod: '`@method: `@args
			| `@temps |
			`@.statements.
			`@collection do: [ :`each |
				| `@blocktemps |
				`@.blockstatements.
				`@condition
					ifFalse: [ ^ false ] ].
			^ true'
		with: '`@method: `@args
			| `@temps |
			`@.statements. 
			^ `@collection allSatisfy: [ :`each |
				| `@blocktemps |
				`@.blockstatements.
				`@condition ]';

		" anySatisfy: "
		replaceMethod: '`@method: `@args
			| `@temps |
			`@.statements.
			`@collection do: [ :`each |
				| `@blocktemps |
				`@.blockstatements.
				`@condition
					ifTrue: [ ^ true ] ].
			^ false'
		with: '`@method: `@args
			| `@temps |
			`@.statements.
			^ `@collection anySatisfy: [ :`each | 
				| `@blocktemps |
				`@.blockstatements.
				`@condition ]';

		" noneSatisfy: "
		replaceMethod: '`@method: `@args
			| `@temps |
			`@.statements.
			`@collection do: [ :`each |
				| `@blocktemps |
				`@.blockstatements.
				`@condition
					ifTrue: [ ^ false ] ].
			^ true'
		with: '`@method: `@args
			| `@temps |
			`@.statements.
			^ `@collection noneSatisfy: [ :`each | 
				| `@blocktemps |
				`@.blockstatements.				
				`@condition ]'! !

!RBAllAnyNoneSatisfyRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 17:30'!
rationale
	^ 'Replace ad-hoc implementations (using explicit logic based on do:) of allSatisfy:, anySatisfy: and noneSatisfy: by the adequate calls to #allSatisfy:, #anySatisfy: or #noneSatisfy:. '! !

!RBAllAnyNoneSatisfyRule methodsFor: 'accessing' stamp: 'lr 1/3/2010 11:35'!
group
	^ 'Transformations'! !

!RBAllAnyNoneSatisfyRule methodsFor: 'accessing' stamp: 'KrisGybels 10/20/2014 10:40'!
name
	^ 'Replace with #allSatisfy:, #anySatisfy: or #noneSatisfy:'! !

!RBAllAnyNoneSatisfyRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:47'!
category 
	^ 'Coding Idiom Violation'! !

!RBAllAnyNoneSatisfyRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'AllAnyNoneSatisfyRule'! !

!RBAndEnvironment methodsFor: 'testing' stamp: ''!
includesClass: aClass 
	| doesntHaveSelectors |
	(environment includesClass: aClass) ifFalse: [^false].
	(andedEnvironment includesClass: aClass) ifFalse: [^false].
	doesntHaveSelectors := true.
	environment selectorsForClass: aClass
		do: 
			[:each | 
			doesntHaveSelectors := false.
			(andedEnvironment includesSelector: each in: aClass) ifTrue: [^true]].
	^doesntHaveSelectors! !

!RBAndEnvironment methodsFor: 'accessing' stamp: ''!
classesDo: aBlock 
	environment 
		classesDo: [:each | (self includesClass: each) ifTrue: [aBlock value: each]]! !

!RBAndEnvironment methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPut: $(.
	environment storeOn: aStream.
	aStream nextPutAll: ' & '.
	andedEnvironment storeOn: aStream.
	aStream nextPut: $)! !

!RBAndEnvironment methodsFor: 'testing' stamp: ''!
includesCategory: aCategory 
	^(self classNamesFor: aCategory) isEmpty not! !

!RBAndEnvironment methodsFor: 'private' stamp: ''!
andedEnvironment
	^andedEnvironment! !

!RBAndEnvironment methodsFor: 'testing' stamp: ''!
includesSelector: aSelector in: aClass 
	^(environment includesSelector: aSelector in: aClass) 
		and: [andedEnvironment includesSelector: aSelector in: aClass]! !

!RBAndEnvironment methodsFor: 'testing' stamp: 'YuriyTymchuk 7/3/2014 11:16'!
definesClass: aClass
	^ (environment definesClass: aClass) and: [ 
		andedEnvironment definesClass: aClass ]! !

!RBAndEnvironment methodsFor: 'initialize-release' stamp: ''!
andedEnvironment: aBrowserEnvironment 
	andedEnvironment := aBrowserEnvironment! !

!RBAndEnvironment methodsFor: 'testing' stamp: 'CamilloBruni 8/27/2013 02:09'!
includesProtocol: aProtocol in: aClass 
	^ (environment includesProtocol: aProtocol in: aClass)
		and: [ andedEnvironment includesProtocol: aProtocol in: aClass ]! !

!RBAndEnvironment methodsFor: 'accessing' stamp: ''!
problemCount
	^environment isClassEnvironment 
		ifTrue: [self numberClasses]
		ifFalse: [super problemCount]! !

!RBAndEnvironment methodsFor: 'printing' stamp: 'CamilloBruni 8/27/2013 02:29'!
printOn: aStream 
	environment printOn: aStream.
	aStream nextPutAll: ' & '.
	andedEnvironment printOn: aStream.! !

!RBAndEnvironment methodsFor: 'accessing' stamp: 'bh 5/8/2000 21:01'!
selectionIntervalFor: aString 
	| interval |
	interval := super selectionIntervalFor: aString.
	interval notNil ifTrue: [^interval].
	^andedEnvironment selectionIntervalFor: aString
! !

!RBAndEnvironment methodsFor: 'accessing' stamp: ''!
selectorsForClass: aClass do: aBlock 
	environment selectorsForClass: aClass
		do: 
			[:each | 
			(andedEnvironment includesSelector: each in: aClass) 
				ifTrue: [aBlock value: each]]! !

!RBAndEnvironment class methodsFor: 'instance creation' stamp: ''!
onEnvironment: anEnvironment and: anotherEnvironment 
	^(self onEnvironment: anEnvironment)
		andedEnvironment: anotherEnvironment;
		yourself! !

!RBArgumentNode commentStamp: '<historical>'!
I am a specific variable node for method and block arguments.!
!RBArgumentNode methodsFor: 'testing' stamp: 'CamilloBruni 12/15/2011 14:32'!
isArgument
	^ true! !

!RBArgumentNode methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:35'!
acceptVisitor: aProgramNodeVisitor 
	^aProgramNodeVisitor visitArgumentNode: self! !

!RBArrayNode commentStamp: '<historical>'!
A RBArrayNode is an AST node for runtime arrays.

Instance Variables
	left:	 <Integer | nil> position of {
	periods: <SequenceableCollection of: Integer> the positions of all the periods that separate the statements
	right: <Integer | nil> position of }
	statements: <SequenceableCollection of: RBStatementNode> the statement nodes!
!RBArrayNode methodsFor: 'testing' stamp: 'lr 10/18/2009 16:11'!
isArray
	^ true! !

!RBArrayNode methodsFor: 'accessing-token' stamp: 'lr 2/12/2010 19:23'!
periods: anArray
	periods := anArray! !

!RBArrayNode methodsFor: 'accessing' stamp: 'lr 11/1/2009 19:53'!
stopWithoutParentheses 
	^ right! !

!RBArrayNode methodsFor: 'adding nodes' stamp: 'lr 1/4/2012 21:44'!
addNodesFirst: aCollection
	statements := statements asOrderedCollection
		addAllFirst: aCollection;
		yourself.
	aCollection do: [ :each | each parent: self ].
	^ aCollection! !

!RBArrayNode methodsFor: 'accessing-token' stamp: 'lr 11/1/2009 19:52'!
right: anInteger
	right := anInteger! !

!RBArrayNode methodsFor: 'adding nodes' stamp: 'lr 1/4/2012 21:44'!
addNodes: aCollection before: anotherNode 
	aCollection do: [ :each | self addNode: each before: anotherNode ].
	^ aCollection! !

!RBArrayNode methodsFor: 'accessing-token' stamp: 'lr 11/1/2009 19:52'!
left
	^ left! !

!RBArrayNode methodsFor: 'accessing' stamp: 'lr 11/1/2009 18:36'!
children
	^ self statements! !

!RBArrayNode methodsFor: 'testing' stamp: 'GiselaDecuzzi 6/5/2013 10:29'!
isFaulty
	^self statements anySatisfy: #isFaulty! !

!RBArrayNode methodsFor: 'accessing-token' stamp: 'lr 11/1/2009 19:52'!
right
	^ right! !

!RBArrayNode methodsFor: 'initialization' stamp: 'lr 8/14/2011 12:01'!
initialize
	super initialize.
	statements := periods := #()! !

!RBArrayNode methodsFor: 'adding nodes' stamp: 'lr 1/4/2012 21:42'!
addNodeFirst: aNode
	statements := statements asOrderedCollection
		addFirst: aNode;
		yourself.
	aNode parent: self.
	^ aNode! !

!RBArrayNode methodsFor: 'accessing' stamp: 'ls 1/24/2000 00:32'!
statements
	^statements! !

!RBArrayNode methodsFor: 'accessing' stamp: 'lr 6/6/2008 16:16'!
statements: statements0 
	statements := statements0.
	statements do: [:statement | statement parent: self]! !

!RBArrayNode methodsFor: 'private' stamp: 'lr 5/15/2010 17:29'!
indexOfNode: aNode 
	"Try to find the node by first looking for ==, and then for ="

	^ (1 to: statements size) 
		detect: [ :each | (statements at: each) == aNode ]
		ifNone: [ statements indexOf: aNode ]! !

!RBArrayNode methodsFor: 'testing' stamp: 'lr 11/1/2009 18:39'!
references: aVariableName 
	^ statements anySatisfy: [ :each | each references: aVariableName ]! !

!RBArrayNode methodsFor: 'testing' stamp: 'ls 1/24/2000 00:28'!
lastIsReturn
	statements isEmpty ifTrue:[ ^false ].
	^statements last lastIsReturn! !

!RBArrayNode methodsFor: 'accessing-token' stamp: 'lr 11/1/2009 20:44'!
periods
	^ periods! !

!RBArrayNode methodsFor: 'comparing' stamp: 'lr 3/7/2010 13:48'!
hash
	^ self hashForCollection: self statements! !

!RBArrayNode methodsFor: 'matching' stamp: 'lr 11/24/2009 23:35'!
copyInContext: aDictionary 
	^ self class statements: (self copyList: self statements inContext: aDictionary)! !

!RBArrayNode methodsFor: 'accessing' stamp: 'lr 4/26/2010 20:44'!
precedence
	^0! !

!RBArrayNode methodsFor: 'testing' stamp: 'lr 11/1/2009 18:40'!
uses: aNode 
	^ (statements anySatisfy: [ :each | each == aNode ]) or: [ self isUsed ]! !

!RBArrayNode methodsFor: 'replacing' stamp: 'lr 6/6/2008 16:15'!
replaceNode: oldNode  withNode: newNode
	self statements: (statements collect: [ :statement |
		statement == oldNode 
			ifTrue: [ newNode ]
			ifFalse: [ statement ] ])! !

!RBArrayNode methodsFor: 'adding nodes' stamp: 'lr 1/4/2012 21:40'!
addNode: aNode before: anotherNode 
	| index |
	aNode isReturn 
		ifTrue: [ self error: 'Cannot add return node' ].
	index := self indexOfNode: anotherNode.
	index = 0 ifTrue: [ ^ self addNode: aNode ].
	statements := statements asOrderedCollection
		add: aNode beforeIndex: index;
		yourself.
	aNode parent: self.
	^ aNode! !

!RBArrayNode methodsFor: 'adding nodes' stamp: 'lr 1/4/2012 21:43'!
addNodes: aCollection
	statements := statements asOrderedCollection
		addAll: aCollection;
		yourself.
	aCollection do: [ :each | each parent: self ].
	^ aCollection! !

!RBArrayNode methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:36'!
acceptVisitor: aProgramNodeVisitor
	^ aProgramNodeVisitor visitArrayNode: self! !

!RBArrayNode methodsFor: 'adding nodes' stamp: 'lr 1/4/2012 21:40'!
addNode: aNode
	statements := statements asOrderedCollection
		add: aNode;
		yourself.
	aNode parent: self.
	^ aNode! !

!RBArrayNode methodsFor: 'accessing' stamp: 'lr 11/1/2009 19:52'!
startWithoutParentheses 
	^ left! !

!RBArrayNode methodsFor: 'comparing' stamp: 'lr 10/18/2009 16:15'!
equalTo: anObject withMapping: aDictionary 
	self class = anObject class 
		ifFalse: [ ^ false ].
	self statements size = anObject statements size 
		ifFalse: [ ^ false ].
	self statements with: anObject statements do: [ :first :second |
		(first equalTo: second withMapping: aDictionary)
			ifFalse: [ ^ false ] ].
	aDictionary values asSet size = aDictionary size 
		ifFalse: [ ^ false ].
	^ true! !

!RBArrayNode methodsFor: 'comparing' stamp: 'BernardoContreras 8/22/2014 17:47'!
= anObject 
	self == anObject ifTrue: [ ^ true ].
	self class = anObject class ifFalse: [ ^ false ].
	self statements size = anObject statements size ifFalse: [ ^ false ].
	self statements with: anObject statements do: [ :first :second | first = second ifFalse: [ ^ false ] ].
	^ true! !

!RBArrayNode methodsFor: 'copying' stamp: 'lr 11/1/2009 22:36'!
postCopy
	super postCopy.
	self statements: (self statements collect: [ :each | each copy ])! !

!RBArrayNode methodsFor: 'matching' stamp: 'lr 5/30/2010 11:34'!
match: aNode inContext: aDictionary 
	aNode class = self class ifFalse: [ ^ false ].
	^ self matchList: statements against: aNode statements inContext: aDictionary! !

!RBArrayNode methodsFor: 'accessing-token' stamp: 'lr 11/1/2009 19:52'!
left: anInteger
	left := anInteger! !

!RBArrayNode methodsFor: 'testing' stamp: 'lr 11/1/2009 20:24'!
needsParenthesis
	^ false! !

!RBArrayNode methodsFor: 'accessing' stamp: 'lr 11/1/2009 20:25'!
statementComments
	^self comments! !

!RBArrayNode class methodsFor: 'instance creation' stamp: 'ajh 3/4/2003 02:03'!
statements: statements
	^ self new statements: statements! !

!RBAsOrderedCollectionNotNeededRule commentStamp: 'StephaneDucasse 11/29/2014 17:36'!
A prior conversion to an Array or OrderedCollection is not necessary when adding all elements to a collection.
!
!RBAsOrderedCollectionNotNeededRule methodsFor: 'initialization' stamp: 'CAMILLETERUEL 3/29/2013 12:42'!
initialize
	super initialize.
	#('addAll:' 'withAll:' 'removeAll:' 'includesAll:' 'copyWithoutAll:')
		do: [ :collectionMessage | 
			#('asArray' 'asOrderedCollection' 'asSortedCollection')
				do: [ :conversionMessage | 
					| baseString |
					baseString := '``@receiver ' , collectionMessage , ' ``@arg '.
					self rewriteRule replace: baseString , conversionMessage with: baseString ] ]! !

!RBAsOrderedCollectionNotNeededRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Miscellaneous'! !

!RBAsOrderedCollectionNotNeededRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ '#asOrderedCollection/#asArray not needed'! !

!RBAsOrderedCollectionNotNeededRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 16:19'!
category
	^'Optimization'! !

!RBAsOrderedCollectionNotNeededRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'AsOrderedCollectionNotNeededRule'! !

!RBAssignmentInBlockRule commentStamp: 'StephaneDucasse 11/29/2014 17:27'!
Checks ensure:, ifCurtailed:, and showWhile: blocks for assignments or returns that are the last statement in the block. These assignments or returns can be moved outside the block since these messages return the value of the block.!
!RBAssignmentInBlockRule methodsFor: 'initialization' stamp: 'lr 11/19/2009 14:47'!
initialize
	super initialize.
	self matcher 
		matchesAnyOf: #(
			'`@cursor showWhile: [| `@temps | `@.Statements1. `var := `@object]'
			'`@cursor showWhile: [| `@temps | `@.Statements1. ^`@object]'
			'[| `@temps | `@.Statements. `var := `@object] ensure: `@block'
			'[| `@temps | `@.Statements. ^`@object] ensure: `@block'
			'[| `@temps | `@.Statements. `var := `@object] ifCurtailed: `@block'
			'[| `@temps | `@.Statements. ^`@object] ifCurtailed: `@block' )
		do: [ :node :answer | node ]! !

!RBAssignmentInBlockRule methodsFor: 'accessing' stamp: 'lr 11/19/2009 14:47'!
rationale
	^ 'Checks ensure:, ifCurtailed:, and showWhile: blocks for assignments or returns that are the last statement in the block. These assignments or returns can be moved outside the block since these messages return the value of the block.'! !

!RBAssignmentInBlockRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Miscellaneous'! !

!RBAssignmentInBlockRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Unnecessary assignment or return in block'! !

!RBAssignmentInBlockRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 16:20'!
category
	^'Coding Idiom Violation'! !

!RBAssignmentInBlockRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'AssignmentInBlockRule'! !

!RBAssignmentInIfTrueRule commentStamp: 'StephaneDucasse 11/29/2014 17:24'!
Moving assignements outside blocks leads to shorter and more efficient code.
For example:
test 
	ifTrue: [var := 1]
	ifFlase: [var:= 2]
is equivalent to:
var :=  test 
	ifTrue: [1]
	ifFlase: [2]!
!RBAssignmentInIfTrueRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:24'!
initialize
	super initialize.
	self rewriteRule
		replace: '``@Boolean ifTrue: [`variable := ``@true] ifFalse: [`variable := ``@false]'
		with: '`variable := ``@Boolean ifTrue: [``@true] ifFalse: [``@false]';
		replace: '``@Boolean ifFalse: [`variable := ``@true] ifTrue: [`variable := ``@false]'
		with: '`variable := ``@Boolean ifFalse: [``@true] ifTrue: [``@false]'! !

!RBAssignmentInIfTrueRule methodsFor: 'accessing' stamp: 'lr 9/7/2010 20:25'!
rationale
	^ 'Moving assignements outside blocks leads to shorter and more efficient code.'! !

!RBAssignmentInIfTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Transformations'! !

!RBAssignmentInIfTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Move variable assignment outside of single statement ifTrue:ifFalse: blocks'! !

!RBAssignmentInIfTrueRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:48'!
category 
	^ 'Optimization'! !

!RBAssignmentInIfTrueRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'AssignmentInIfTrueRule'! !

!RBAssignmentNode commentStamp: '<historical>'!
RBAssignmentNode is an AST node for assignment statements

Instance Variables:
	assignment	<Integer>	position of the :=
	value	<RBValueNode>	the value that we're assigning
	variable	<RBVariableNode>	the variable being assigned

!
!RBAssignmentNode methodsFor: 'testing' stamp: ''!
directlyUses: aNode 
	^aNode = value ifTrue: [true] ifFalse: [self isDirectlyUsed]! !

!RBAssignmentNode methodsFor: 'initialize-release' stamp: ''!
variable: aVariableNode value: aValueNode position: anInteger 
	self variable: aVariableNode.
	self value: aValueNode.
	assignment := anInteger! !

!RBAssignmentNode methodsFor: 'accessing' stamp: ''!
stopWithoutParentheses
	^value stop! !

!RBAssignmentNode methodsFor: '*OpalDecompiler' stamp: 'cb 7/29/2014 18:22'!
toDoIncrement: var
	var = variable ifFalse: [^ nil].
	^ value toDoIncrement: var! !

!RBAssignmentNode methodsFor: '*SmartSuggestions' stamp: 'GiselaDecuzzi 6/12/2013 13:49'!
specialCommands
	^ SugsSuggestionFactory commandsForAssignment.! !

!RBAssignmentNode methodsFor: 'querying' stamp: 'ClementBera 7/26/2013 17:15'!
bestNodeFor: anInterval 
	(self intersectsInterval: anInterval) ifFalse: [^nil].
	(self containedBy: anInterval) ifTrue: [^self].
	assignment ifNil: [^super bestNodeFor: anInterval].
	((anInterval first between: assignment and: assignment + 1) 
		or: [assignment between: anInterval first and: anInterval last]) 
			ifTrue: [^self].
	self children do: 
			[:each | 
			| node |
			node := each bestNodeFor: anInterval.
			node notNil ifTrue: [^node]]! !

!RBAssignmentNode methodsFor: 'accessing' stamp: ''!
children
	^Array with: value with: variable! !

!RBAssignmentNode methodsFor: 'testing' stamp: 'GiselaDecuzzi 6/10/2013 13:31'!
isFaulty
	^self variable isFaulty or: [ self value isFaulty].! !

!RBAssignmentNode methodsFor: 'replacing' stamp: 'lr 12/4/2009 15:23'!
replaceSourceWith: aNode 
	"Check if we need to convert the assignment. Also check if we are being replaced with a setter message send. If so, create the replacements to edit the original source."

	(aNode isAssignment and: [ aNode assignmentOperator ~= self assignmentOperator ]) ifTrue: [
		self addReplacement: (RBStringReplacement 
			replaceFrom: self assignmentPosition
			to: self assignmentPosition + self assignmentOperator size - 1
			with: aNode assignmentOperator).
		(aNode variable = variable and: [ aNode value = value ])
			ifTrue: [ ^ self ] ].
	aNode isMessage ifFalse: [^super replaceSourceWith: aNode].
	aNode receiver isVariable ifFalse: [^super replaceSourceWith: aNode].
	aNode numArgs = 1 ifFalse: [^super replaceSourceWith: aNode].
	(self mappingFor: self value) = aNode arguments first 
		ifFalse: [^super replaceSourceWith: aNode].
	(self value hasParentheses not 
		and: [aNode arguments first precedence >= aNode precedence]) 
			ifTrue: 
				[self
					addReplacement: (RBStringReplacement 
								replaceFrom: self value start
								to: self value start - 1
								with: '(');
					addReplacement: (RBStringReplacement 
								replaceFrom: self value stop + 1
								to: self value stop
								with: ')')].
	self addReplacement: (RBStringReplacement 
				replaceFrom: self variable start
				to: self assignmentPosition + 1
				with: aNode receiver name , ' ' , aNode selector)! !

!RBAssignmentNode methodsFor: 'accessing-token' stamp: 'lr 2/12/2010 19:23'!
assignment
	^ assignment! !

!RBAssignmentNode methodsFor: 'accessing' stamp: 'StephaneDucasse 3/29/2013 17:33'!
assignmentOperator
	^  ':=' ! !

!RBAssignmentNode methodsFor: 'accessing' stamp: ''!
value: aValueNode 
	value := aValueNode.
	value parent: self! !

!RBAssignmentNode methodsFor: 'accessing' stamp: ''!
value
	^value! !

!RBAssignmentNode methodsFor: 'testing' stamp: ''!
assigns: aVariableName 
	^variable name = aVariableName or: [value assigns: aVariableName]! !

!RBAssignmentNode methodsFor: 'comparing' stamp: ''!
hash
	^self variable hash bitXor: self value hash! !

!RBAssignmentNode methodsFor: 'matching' stamp: 'lr 11/24/2009 23:35'!
copyInContext: aDictionary 
	^ self class new
		variable: (self variable copyInContext: aDictionary);
		value: (self value copyInContext: aDictionary);
		yourself! !

!RBAssignmentNode methodsFor: 'accessing' stamp: ''!
variable: varNode 
	variable := varNode.
	variable parent: self! !

!RBAssignmentNode methodsFor: 'accessing' stamp: ''!
precedence
	^5! !

!RBAssignmentNode methodsFor: 'testing' stamp: ''!
uses: aNode 
	^aNode = value ifTrue: [true] ifFalse: [self isUsed]! !

!RBAssignmentNode methodsFor: 'accessing' stamp: ''!
startWithoutParentheses
	^variable start! !

!RBAssignmentNode methodsFor: 'comparing' stamp: ''!
equalTo: anObject withMapping: aDictionary 
	^self class = anObject class and: 
			[(self variable equalTo: anObject variable withMapping: aDictionary) 
				and: [self value equalTo: anObject value withMapping: aDictionary]]! !

!RBAssignmentNode methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:36'!
acceptVisitor: aProgramNodeVisitor 
	^aProgramNodeVisitor visitAssignmentNode: self! !

!RBAssignmentNode methodsFor: 'replacing' stamp: ''!
replaceNode: aNode withNode: anotherNode 
	value == aNode ifTrue: [self value: anotherNode].
	variable == aNode ifTrue: [self variable: anotherNode]! !

!RBAssignmentNode methodsFor: 'testing' stamp: ''!
isAssignment
	^true! !

!RBAssignmentNode methodsFor: 'comparing' stamp: ''!
= anObject 
	self == anObject ifTrue: [^true].
	self class = anObject class ifFalse: [^false].
	^self variable = anObject variable and: [self value = anObject value]! !

!RBAssignmentNode methodsFor: 'copying' stamp: 'lr 11/1/2009 22:35'!
postCopy
	super postCopy.
	self variable: self variable copy.
	self value: self value copy! !

!RBAssignmentNode methodsFor: 'accessing' stamp: ''!
variable
	^variable! !

!RBAssignmentNode methodsFor: 'matching' stamp: 'lr 5/30/2010 11:34'!
match: aNode inContext: aDictionary 
	aNode class = self class ifFalse: [^false].
	^(variable match: aNode variable inContext: aDictionary)
		and: [value match: aNode value inContext: aDictionary]! !

!RBAssignmentNode methodsFor: 'testing' stamp: 'ClementBera 7/26/2013 17:15'!
needsParenthesis
	^parent
		ifNil: [false]
		ifNotNil: [self precedence > parent precedence]! !

!RBAssignmentNode methodsFor: 'accessing' stamp: 'lr 11/2/2009 20:50'!
assignmentPosition
	^ assignment! !

!RBAssignmentNode methodsFor: 'accessing-token' stamp: 'lr 2/12/2010 19:24'!
assignment: anInteger
	assignment := anInteger! !

!RBAssignmentNode class methodsFor: 'instance creation' stamp: ''!
variable: aVariableNode value: aValueNode position: anInteger 
	^(self new)
		variable: aVariableNode
			value: aValueNode
			position: anInteger;
		yourself! !

!RBAssignmentNode class methodsFor: 'instance creation' stamp: ''!
variable: aVariableNode value: aValueNode 
	^self 
		variable: aVariableNode
		value: aValueNode
		position: nil! !

!RBAssignmentOnBlockArgumentRule commentStamp: 'StephaneDucasse 11/29/2014 21:15'!
Check for assignments on block arguments.
For example:

[:x :y|
	x:= x+y.
	]

The block argument "x" should not be written. This is considered bad style. And some compiler may reject that code.!
!RBAssignmentOnBlockArgumentRule methodsFor: 'accessing' stamp: 'NicolaiHess 8/23/2014 21:19'!
rationale
	^ 'Check for assignments on block arguments.
For example:

[:x :y|
	x:= x+y.
	]

The block argument "x" should not be written'! !

!RBAssignmentOnBlockArgumentRule methodsFor: 'accessing' stamp: 'NicolaiHess 8/23/2014 21:19'!
group
	^ 'Possible bugs'! !

!RBAssignmentOnBlockArgumentRule methodsFor: 'accessing' stamp: 'NicolaiHess 8/23/2014 21:19'!
name
	^ 'Assignments on block arguments'! !

!RBAssignmentOnBlockArgumentRule methodsFor: 'accessing' stamp: 'NicolaiHess 8/23/2014 21:17'!
category 
	^ 'Potential Bugs'! !

!RBAssignmentOnBlockArgumentRule methodsFor: 'running' stamp: 'MarcusDenker 10/27/2014 18:00'!
checkMethod: aMethod
	(RBFindBlockArgumentAssignment collectAssignments: aMethod ast)
		do: [ :item | 
			result addMethod: aMethod.
			result addSearchString: item ]! !

!RBAssignmentOnBlockArgumentRule class methodsFor: 'accessing' stamp: 'NicolaiHess 8/23/2014 21:17'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"

	^ 'AssignmentOnBlockArgumentRule'! !

!RBAssignmentToken commentStamp: 'md 8/9/2005 14:51'!
RBAssignmentToken is the first-class representation of the assignment token ':='
!
!RBAssignmentToken methodsFor: 'private' stamp: ''!
length
	^2! !

!RBAssignmentToken methodsFor: 'testing' stamp: ''!
isAssignment
	^true! !

!RBAssignmentWithoutEffectRule commentStamp: 'StephaneDucasse 11/29/2014 21:17'!
This smell arises when a statement such as x := x is found. This statement has not effect, it can be removed.!
!RBAssignmentWithoutEffectRule methodsFor: 'initialization' stamp: 'lr 3/13/2009 13:56'!
initialize
	super initialize.
	self matcher 
		matches: '`var := `var'
		do: [ :node :answer | node ]! !

!RBAssignmentWithoutEffectRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 13:55'!
rationale
	^ 'A statement such as x := x has no effect.'! !

!RBAssignmentWithoutEffectRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 13:55'!
group
	^ 'Unnecessary code'! !

!RBAssignmentWithoutEffectRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:09'!
severity
	^ #information! !

!RBAssignmentWithoutEffectRule methodsFor: 'accessing' stamp: 'Simon 8/30/2012 14:42'!
category
	^ 'Optimization'! !

!RBAssignmentWithoutEffectRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 13:55'!
name
	^ 'Assignment has no effect'! !

!RBAssignmentWithoutEffectRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'AssignmentWithoutEffectRule'! !

!RBAtIfAbsentRule commentStamp: 'StephaneDucasse 11/29/2014 17:37'!
Replaces at:ifAbsent: by at:ifAbsentPut:. Its leads to shorter and more readable code.

!
!RBAtIfAbsentRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:26'!
initialize
	super initialize.
	self rewriteRule
		replace: '``@dictionary at: ``@key 
					ifAbsent: [| `@temps | 
							``@.Statements1.
							``@dictionary at: ``@key put: ``@object.
							``@.Statements2.
							``@object]'
		with: '``@dictionary at: ``@key
					ifAbsentPut: [| `@temps |
							``@.Statements1.
							``@.Statements2.
							``@object]';
		replace: '``@dictionary at: ``@key
					ifAbsent: [| `@temps |
							``@.Statements.
							``@dictionary at: ``@key put: ``@object]'
		with: '``@dictionary at: ``@key
					ifAbsentPut: [| `@temps |
							``@.Statements.
							``@object]'! !

!RBAtIfAbsentRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Transformations'! !

!RBAtIfAbsentRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'at:ifAbsent: -> at:ifAbsentPut:'! !

!RBAtIfAbsentRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:48'!
category 
	^ 'Coding Idiom Violation'! !

!RBAtIfAbsentRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'AtIfAbsentRule'! !

!RBBadMessageRule commentStamp: 'StephaneDucasse 11/29/2014 21:14'!
This smell arises when methods send messages that perform low level things. You might want to limit the number of such messages in your application. Messages such as #isKindOf: can signify a lack of polymorphism. You can see which methods are "questionable" by editing the RBBadMessageRule>>badSelectors method. Some examples are: #respondsTo: #isMemberOf: #performMethod: and #performMethod:arguments:!
!RBBadMessageRule methodsFor: 'private' stamp: 'MarcusDenker 7/18/2014 16:11'!
badSelectors
	^ #( #become: #isKindOf: #respondsTo: #isMemberOf: #perform: #perform:arguments: #perform:with: #perform:with:with: #perform:with:with:with: #allOwners #instVarAt: #instVarAt:put: #nextInstance instVarsInclude: #nextObject #halt caseOf: caseOf:otherwise: caseError isThisEverCalled isThisEverCalled: becomeForward: instVarNamed: instVarNamed:put:  someObject primitiveChangeClassTo:)! !

!RBBadMessageRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 21:14'!
rationale
	^ 'Check methods that send messages that perform low level things.'! !

!RBBadMessageRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Miscellaneous'! !

!RBBadMessageRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Sends "questionable" message'! !

!RBBadMessageRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 09:59'!
category 	
	^ 'Coding Idiom Violation'! !

!RBBadMessageRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 16:47'!
checkMethod: aMethod 

	self badSelectors do: [ :badSelector | 
		(aMethod sendsSelector: badSelector)
			 ifTrue: [
				result
					addMethod: aMethod;
					searchStrings: self badSelectors ] ]
	! !

!RBBadMessageRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'BadMessageRule'! !

!RBBasicLintRule commentStamp: '<historical>'!
I am a rule that has a result. 
It is not clear why it is not merged with its superclass but this is ok too.!
!RBBasicLintRule methodsFor: 'accessing' stamp: 'lr 2/24/2009 08:28'!
resultClass
	self subclassResponsibility! !

!RBBasicLintRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 21:39'!
initialize
	super initialize.
	self resetResult
	! !

!RBBasicLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:40'!
problemCount
	^ self result problemCount! !

!RBBasicLintRule methodsFor: 'testing' stamp: 'lr 2/23/2009 21:37'!
isEmpty
	^ self result isEmpty! !

!RBBasicLintRule methodsFor: 'running' stamp: 'lr 2/23/2009 21:39'!
resetResult
	result := self resultClass new.
	result label: self name! !

!RBBasicLintRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'!
filteredResult
	"Be very careful when filtering results not to introduce new items and not to lose the dedicated browser environments. Try the following steps in order:
	
	- If this is a selector environment use the set-operations of the refactoring browser.
	- If this is a class environment, remove the classes that have a filter annotation in any of its methods.
	- If this is a variable environment, remove the classes and all its variables that have a filter annotation in any of its methods.
	- Otherwise return the unfiltered environment."

	| filter |
	result isEmpty
		ifTrue: [ ^ result ].
	filter := RBPragmaEnvironment
		onEnvironment: RBBrowserEnvironment new
		keywords: #( lint: lint:rationale: lint:rationale:author: lint:author: ignoreLintRule: ignoreLintRule:rationale: ignoreLintRule:rationale:author: ignoreLintRule:author: ).
	filter condition: [ :pragma |
		pragma arguments first = self name
			or: [ pragma arguments first = self group
			or: [ pragma arguments first = self class name ] ] ].
	result isSelectorEnvironment
		ifTrue: [ ^ (result & filter not) label: result label ].
	result isClassEnvironment
		ifTrue: [
			filter classesDo: [ :class |
				result
					removeClass: class theMetaClass;
					removeClass: class theNonMetaClass ] ]
		ifFalse: [
			result isVariableEnvironment ifTrue: [
				filter classesDo: [ :class |
					class classVarNames 
						do: [ :var | result removeClass: class classVariable: var ].
					class instVarNames 
						do: [ :var | result removeClass: class instanceVariable: var ] ] ] ].
	^ result! !

!RBBasicLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:40'!
result
	^ result! !

!RBBasicLintRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'BasicLintRule'! !

!RBBasicLintRuleTest methodsFor: 'initialize-release' stamp: ''!
methodBlock: aBlock
	methodBlock := aBlock! !

!RBBasicLintRuleTest methodsFor: 'initialize-release' stamp: 'MarkRizun 7/21/2014 16:35'!
newResultClass: aClass 
"New one:)"
	result := aClass new! !

!RBBasicLintRuleTest methodsFor: 'testing' stamp: ''!
isEmpty
	^result isEmpty! !

!RBBasicLintRuleTest methodsFor: 'private' stamp: 'MarkRizun 7/22/2014 11:07'!
method: anObject1 with: anObject2 lots: anObject3 of: anObject4 arguments: anObject5
	^ anObject5 + anObject1 > (anObject4 - anObject2 + anObject3)! !

!RBBasicLintRuleTest methodsFor: 'accessing' stamp: 'MarkRizun 7/22/2014 14:14'!
someDemoMethod
	^ self junk! !

!RBBasicLintRuleTest methodsFor: 'private' stamp: ''!
viewResults
	result openEditor! !

!RBBasicLintRuleTest methodsFor: 'initialize-release' stamp: 'MarkRizun 7/18/2014 10:39'!
classBlock
	^ self anInstVar + 5! !

!RBBasicLintRuleTest methodsFor: 'accessing' stamp: ''!
result
	^result! !

!RBBasicLintRuleTest methodsFor: 'accessing' stamp: ''!
checkMethod: aSmalllintContext 
	^methodBlock value: aSmalllintContext value: result! !

!RBBasicLintRuleTest methodsFor: 'accessing' stamp: ''!
checkClass: aSmalllintContext 
	^classBlock value: aSmalllintContext value: result! !

!RBBasicLintRuleTest methodsFor: 'initialization' stamp: 'MarkRizun 7/18/2014 10:42'!
initialize
	super initialize.
	self anInstVar: 1.
	classBlock := [:context :aResult | ].
	methodBlock := [:context :aResult | ].
	self resultClass: RBSelectorEnvironment! !

!RBBasicLintRuleTest methodsFor: 'accessing' stamp: ''!
problemCount
	^result problemCount! !

!RBBasicLintRuleTest methodsFor: 'initialize-release' stamp: ''!
resetResult
	result := result copyEmpty.
	result label: name! !

!RBBasicLintRuleTest methodsFor: 'initialize-release' stamp: 'MarkRizun 7/18/2014 10:40'!
anInstVar: anObject
	anInstVar := anObject! !

!RBBasicLintRuleTest methodsFor: 'initialize-release' stamp: ''!
resultClass: aClass 
	result := aClass new! !

!RBBasicLintRuleTest methodsFor: 'accessing' stamp: 'bh 4/3/2000 10:19'!
foobar

	^#( true false )! !

!RBBasicLintRuleTest methodsFor: 'initialize-release' stamp: 'MarkRizun 7/18/2014 10:39'!
anInstVar
	^ anInstVar! !

!RBBasicLintRuleTest methodsFor: 'initialize-release' stamp: 'MarkRizun 8/26/2014 13:19'!
classBlock: aBlock
	classBlock := aBlock testMethod1! !

!RBBasicLintRuleTest methodsFor: 'initialize-release' stamp: ''!
result: aResult 
	result := aResult copyEmpty! !

!RBBasicLintRuleTest class methodsFor: 'intention revealing' stamp: 'lr 11/2/2009 00:14'!
collectionMessagesToExternalObject
	| detector matcher |
	detector := self new.
	detector name: 'Sends add:/remove: to external collection'.
	matcher := RBParseTreeSearcher new.
	matcher
		addSearches: (#(#add: #remove: #addAll: #removeAll:)
				collect: [:each | ('(`@Object `@message: `@args) <1s> `@Arg' expandMacrosWith: each) asString])
					-> 
						[:aNode :answer | 
						answer or: 
								[(aNode receiver selector copyFrom: 1 to: (aNode receiver selector size min: 2))
									~= 'as' and: 
											[| receiver |
											receiver := aNode receiver receiver.
											receiver isVariable not or: 
													[((#('self' 'super') includes: receiver name)
														or: [Smalltalk includesKey: receiver name asSymbol]) not]]]].
	detector methodBlock: 
			[:context :result | 
			(matcher executeTree: context parseTree initialAnswer: false)
				ifTrue: [result addClass: context selectedClass selector: context selector]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'intention revealing' stamp: ''!
atIfAbsent
	^self createParseTreeRule: 
				#('`@object 
						at: `@atArg 
						ifAbsent: [| `@temps | `@.Statements. `@object at: `@atArg put: `@putArg]' 
				'`@object 
						at: `@atArg 
						ifAbsent: [| `@temps | 
								`@.Statements. 
								`@object at: `@atArg put: `@putArg. 
								`@.xStatements1. 
								`@putArg]') 
		name: 'Uses at:ifAbsent: instead of at:ifAbsentPut:'! !

!RBBasicLintRuleTest class methodsFor: 'possible bugs' stamp: 'lr 9/8/2011 20:32'!
collectionCopyEmpty
	| detector |
	detector := self new.
	detector
		name: 'Subclass of collection that has instance variable but doesn''t define copyEmpty'.
	detector resultClass: RBClassEnvironment.
	detector classBlock: 
			[:context :result | 
			(context selectedClass isVariable 
					and: [(context selectedClass includesSelector: #copyEmpty:) not 
						and: [context selectedClass instVarNames isEmpty not
							and: [context selectedClass inheritsFrom: Collection]]])
				ifTrue: [result addClass: context selectedClass]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'possible bugs' stamp: 'lr 11/2/2009 00:14'!
usesAdd
	| detector addSearcher |
	detector := self new.
	detector name: 'Uses the result of an add: message'.
	addSearcher := RBParseTreeSearcher usesResultOfAdd.
	detector methodBlock: 
			[:context :result | 
			(addSearcher executeTree: context parseTree initialAnswer: false)
				ifTrue: [result addClass: context selectedClass selector: context selector]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'intention revealing' stamp: ''!
collectionProtocol
	^self createParseTreeRule: 
			#('`@collection do: [:`each | | `@temps | `@.Statements1. `@object add: `@arg. `@.Statements2]' 
			'`@collection do: [:`each | | `@temps | 
					`@.Statements1. 
					`@condition ifTrue: [| `@blockTemps | 
							`@.BlockStatements1. 
							`@object add: `each. 
							`@.BlockStatements2]. 
					`@.Statements2]' 
			'`@collection do: [:`each | | `@temps | 
					`@.Statements1. 
					`@condition ifFalse: [| `@blockTemps | 
							`@.BlockStatements1. 
							`@object add: `each. 
							`@.BlockStatements2]. 
					`@.Statements2]') 
		name: 'Uses do: instead of collect: or select:''s'! !

!RBBasicLintRuleTest class methodsFor: 'miscellaneous' stamp: 'lr 10/26/2009 22:11'!
refersToClass
	| detector |
	detector := self new.
	detector name: 'Refers to class name instead of "self class"'.
	detector classBlock: 
			[:context :result | 
			| sels className |
			className := context selectedClass theNonMetaClass name.
			sels := context selectedClass
						whichSelectorsReferTo: (Smalltalk associationAt: className).
			sels isEmpty ifFalse: 
					[result addSearchString: className.
					sels do: [:each | result addClass: context selectedClass selector: each]]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'possible bugs' stamp: ''!
sentNotImplementedInApplication
	| detector |
	detector := self new.
	detector name: 'Messages sent but not implemented in application'.
	detector methodBlock: 
			[:context :result | 
			| message class block |
			message := context messages
						detect: [:each | (context isItem: each in: context application) not]
						ifNone: [nil].
			class := context selectedClass.
			block := 
					[:each | 
					| app |
					app := context application.
					(self canCall: each
						in: class
						from: app) not].
			message isNil ifTrue: [message := context selfMessages detect: block ifNone: [nil]].
			message isNil ifTrue: 
					[class := class superclass.
					class isNil
						ifTrue: 
							[context superMessages isEmpty ifFalse: [message := context superMessages asArray first]]
						ifFalse: [message := context superMessages detect: block ifNone: [nil]]].
			message notNil ifTrue: 
					[result addSearchString: message.
					result addClass: context selectedClass selector: context selector]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'intention revealing' stamp: ''!
guardingClause
	^self
		createParseTreeRule: 
				#('`@MethodName: `@args 
						| `@temps | 
						`@.Statements. 
						`@condition ifTrue: [| `@BlockTemps | `.Statement1. `.Statement2. `@.BStatements]' 
				'`@MethodName: `@args 
						| `@temps | 
						`@.Statements. 
						`@condition ifFalse: [| `@BlockTemps | `.Statement1. `.Statement2. `@.BStatements]')
		method: true
		name: 'Guarding clauses'! !

!RBBasicLintRuleTest class methodsFor: 'miscellaneous' stamp: 'lr 11/19/2009 14:47'!
assignmentInBlock
	^self createParseTreeRule: #(
			'`@cursor showWhile: [| `@temps | `@.Statements1. `var := `@object]' 
			'`@cursor showWhile: [| `@temps | `@.Statements1. ^`@object]' 
			'[| `@temps | `@.Statements. `var := `@object] ensure: `@block' 
			'[| `@temps | `@.Statements. ^`@object] ensure: `@block' 
			'[| `@temps | `@.Statements. `var := `@object] ifCurtailed: `@block' 
			'[| `@temps | `@.Statements. ^`@object] ifCurtailed: `@block' ) 
		name: 'Unnecessary assignment or return in block'! !

!RBBasicLintRuleTest class methodsFor: 'intention revealing' stamp: 'lr 9/5/2010 10:40'!
missingSubclassResponsibility
	| detector |
	detector := self new.
	detector name: 'Method defined in all subclasses, but not in superclass'.
	"detector resultClass: MultiEnvironment."
	detector classBlock: 
			[:context :result | 
			| subs |
			subs := context selectedClass subclasses.
			subs size > 1 & context selectedClass isMetaclass not ifTrue: 
					[| sels |
					sels := Bag new.
					subs do: [:each | sels addAll: each selectors].
					sels asSet do: 
							[:each | 
							((sels occurrencesOf: each) == subs size
								and: [(context selectedClass canUnderstand: each) not]) ifTrue: 
										[| envName |
										envName := context selectedClass name , '>>', each.
										subs do: 
												[:subClass | 
												result addClass: subClass
													selector: each
													into: envName]]]]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'possible bugs' stamp: ''!
returnsIfTrue
	^self createParseTreeRule: 
				#('^`@condition ifTrue: [| `@temps | `@.statements]' 
				'^`@condition ifFalse: [| `@temps | `@.statements]') 
		name: 'Returns value of ifTrue:/ifFalse: without ifFalse:/ifTrue: block'! !

!RBBasicLintRuleTest class methodsFor: 'private' stamp: ''!
metaclassShouldNotOverride
	^#(#name #comment)! !

!RBBasicLintRuleTest class methodsFor: 'possible bugs' stamp: 'lr 9/8/2011 20:32'!
definesEqualNotHash
	| detector |
	detector := self new.
	detector name: 'Defines = but not hash'.
	detector resultClass: RBClassEnvironment.
	detector classBlock: 
			[:context :result | 
			((context selectedClass includesSelector: #=)
				and: [(context selectedClass includesSelector: #hash) not])
				ifTrue: [result addClass: context selectedClass]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'possible bugs' stamp: 'lr 11/2/2009 00:14'!
tempVarOverridesInstVar
	| detector matcher vars varName |
	detector := self new.
	detector name: 'Instance variable overridden by temporary variable'.
	matcher := (RBParseTreeSearcher new) addArgumentSearch: '`xxxvar' -> 
								[:aNode :answer | 
								answer or: 
										[varName := aNode name.
										vars includes: varName]];
				yourself.
	detector methodBlock: 
			[:context :result | 
			vars := context instVarNames.
			(matcher executeTree: context parseTree initialAnswer: false) ifTrue: 
					[result addClass: context selectedClass selector: context selector.
					result addSearchString: varName]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'bugs' stamp: 'lr 9/8/2011 20:32'!
overridesSpecialMessage
	| detector |
	detector := self new.
	detector name: 'Overrides a "special" message'.
	detector resultClass: RBClassEnvironment.
	detector classBlock: 
			[:context :result | 
			((context selectedClass isMetaclass
				ifTrue: [self metaclassShouldNotOverride]
				ifFalse: [self classShouldNotOverride]) detect: 
						[:each | 
						context selectedClass superclass notNil and: 
								[(context selectedClass superclass canUnderstand: each)
									and: [context selectedClass includesSelector: each]]]
					ifNone: [nil]) notNil ifTrue: [result addClass: context selectedClass]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'miscellaneous' stamp: ''!
instVarInSubclasses
	| detector |
	detector := self new.
	detector name: 'Instance variables defined in all subclasses'.
	detector result: nil pullUpInstVar.
	detector classBlock: 
			[:context :result | 
			| subs |
			subs := context selectedClass subclasses.
			subs size > 1 ifTrue: 
					[| sels |
					sels := Bag new.
					subs do: [:each | sels addAll: each instVarNames].
					sels asSet do: 
							[:val | 
							(sels occurrencesOf: val) == subs size
								ifTrue: [result addInstVar: val for: context selectedClass]]]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'intention revealing' stamp: ''!
detectContains
	^self createParseTreeRule: 
			#('`@collection do: [:`each | | `@temps | 
					`@.Statements1. 
					`@condition ifFalse: [| `@BlockTemps | `@.BlockStatements1. ^`each]. 
					`@.Statements2]' 
			'`@collection do: [:`each | | `@temps | 
					`@.Statements1. 
					`@condition ifTrue: [| `@BlockTemps | `@.BlockStatements1.  ^`each]. 
					`@.Statements2]' 
			'`@collection do: [:`each | | `@temps | 
					`@.Statements1. 
					`@condition ifFalse: [| `@BlockTemps | `@.BlockStatements1. ^true]. 
					`@.Statements2]' 
			'`@Collection do: [:`each | | `@temps | 
					`@.Statements1. 
					`@condition ifTrue: [| `@BlockTemps | `@.BlockStatements1.  ^true]. 
					`@.Statements2]' 
			'`@collection do: [:`each | | `@temps | 
					`@.Statements1. 
					`@condition ifFalse: [| `@BlockTemps | `@.BlockStatements1. ^false]. 
					`@.Statements2]' 
			'`@collection do: [:`each | | `@temps | 
					`@.Statements1. 
					`@condition ifTrue: [| `@BlockTemps | `@.BlockStatements1.  ^false]. 
					`@.Statements2]') 
		name: 'Uses do: instead of contains: or detect:''s'! !

!RBBasicLintRuleTest class methodsFor: 'possible bugs' stamp: 'MarcusDenker 9/20/2013 15:06'!
returnsBooleanAndOther
	| detector matcher |
	detector := self new.
	detector name: 'Returns a boolean and non boolean'.
	matcher := RBParseTreeSearcher new.
	matcher addSearch: '^``@xObject' -> 
					[:aNode :answer | 
					answer add: aNode value;
						yourself].
	detector methodBlock: 
			[:context :result | 
			| hasBool hasSelf |
			hasBool := false.
			hasSelf := context parseTree lastIsReturn not.
			(matcher executeTree: context parseTree initialAnswer: Set new) do: 
					[:each | 
					hasBool := hasBool or: 
									[(each isLiteralNode and: [{true. false} includes: each value])
										or: [each isMessage and: [#(#and: #or:) includes: each selector]]].
					hasSelf := hasSelf or: 
									[(each isVariable and: [each name = 'self'])
										or: [each isLiteralNode and: [({true. false} includes: each value) not]]]].
			hasSelf & hasBool
				ifTrue: [result addClass: context selectedClass selector: context selector]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'private' stamp: 'lr 11/2/2009 00:14'!
createMatcherFor: codeStrings method: aBoolean 
	| matcher |
	matcher := RBParseTreeSearcher new.
	aBoolean
		ifTrue: [matcher addMethodSearches: codeStrings -> [:aNode :answer | true]]
		ifFalse: [matcher addSearches: codeStrings -> [:aNode :answer | true]].
	^matcher! !

!RBBasicLintRuleTest class methodsFor: 'unnecessary code' stamp: 'YuriyTymchuk 9/4/2014 10:33'!
classNotReferenced
	| detector |
	detector := self new.
	detector name: 'Class not referenced'.
	detector resultClass: RBClassEnvironment.
	detector classBlock: 
			[:context :result | 
			(context selectedClass isMetaclass
				or: [context isApplication
				or: [context selectedClass subclasses isEmpty not]])
					ifFalse: 
						[ context selectedClass allCallsOn ifEmpty:
								[result addClass: context selectedClass;
									addClass: context selectedClass class]]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'miscellaneous' stamp: 'lr 11/2/2009 00:14'!
precedence
	| detector matcher |
	detector := self new.
	detector name: 'Inspect instances of "A + B * C" might be "A + (B * C)"'.
	matcher := RBParseTreeSearcher new.
	matcher addSearches: #('``@A + ``@B * ``@C' '``@A - ``@B * ``@C')
				-> [:aNode :answer | answer or: [aNode receiver parentheses isEmpty]].
	detector methodBlock: 
			[:context :result | 
			(matcher executeTree: context parseTree initialAnswer: false)
				ifTrue: [result addClass: context selectedClass selector: context selector]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'possible bugs' stamp: 'lr 11/2/2009 00:14'!
missingYourself
	| detector matcher |
	detector := self new.
	detector name: 'Possible missing "; yourself"'.
	matcher := RBParseTreeSearcher new.
	matcher
		addSearch: '``@xobject `@messages: ``@args' -> 
					[:aNode :answer | 
					answer or: 
							[aNode parent isCascade
								and: [aNode isDirectlyUsed and: [aNode selector ~~ #yourself]]]].
	detector methodBlock: 
			[:context :result | 
			(matcher executeTree: context parseTree initialAnswer: false)
				ifTrue: [result addClass: context selectedClass selector: context selector]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'private' stamp: ''!
superMessages
	^#(#release #postCopy #postBuildWith: #preBuildWith: #postOpenWith: #noticeOfWindowClose: #initialize)! !

!RBBasicLintRuleTest class methodsFor: 'miscellaneous' stamp: 'lr 10/26/2009 22:11'!
classNameInSelector
	| detector |
	detector := self new.
	detector name: 'Redundant class name in selector'.
	detector methodBlock: 
			[:context :result | 
			(context selectedClass isMetaclass and: 
					[(context selector
						indexOfSubCollection: context selectedClass theNonMetaClass name
						startingAt: 1) > 0])
				ifTrue: [result addClass: context selectedClass selector: context selector]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'unnecessary code' stamp: 'YuriyTymchuk 9/4/2014 10:37'!
implementedNotSent
	| detector |
	detector := self new.
	detector name: 'Methods implemented but not sent'.
	detector methodBlock: 
			[:context :result | 
			context compiledMethod senders
				senders: [result addClass: context selectedClass selector: context selector]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'miscellaneous' stamp: 'MarcusDenker 9/20/2013 15:28'!
variableAssignedLiteral
	| detector |
	detector := self new.
	detector name: 'Variable is only assigned a single literal value'.
	detector result: nil references.
	detector classBlock: 
			[:context :result | 
			| allSubclasses |
			allSubclasses := context selectedClass withAllSubclasses.
			context selectedClass instVarNames do: 
					[:each | 
					| defClass selector |
					(allSubclasses inject: 0
						into: 
							[:sum :class | 
							| sels |
							sels := class whichSelectorsWrite: each.
							sels size == 1 ifTrue: 
									[selector := sels asArray first.
									defClass := class].
							sum + sels size])
							== 1 ifTrue: 
								[| tree searcher |
								searcher := RBParseTreeSearcher new.
								searcher addSearch: (each , ' := ``@object')
											-> [:aNode :answer | answer isNil and: [aNode value isLiteralNode]].
								tree := defClass parseTreeFor: selector.
								tree notNil ifTrue: 
										[(searcher executeTree: tree initialAnswer: nil) == true
											ifTrue: [result addInstVar: each for: context selectedClass]]]]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'unnecessary code' stamp: ''!
variableReferencedOnce
	| detector |
	detector := self new.
	detector 
		name: 'Variable referenced in only one method and always assigned first'.
	detector classBlock: 
			[:context :result | 
			| allSubclasses |
			allSubclasses := context selectedClass withAllSubclasses.
			context selectedClass instVarNames do: 
					[:each | 
					| defClass selector |
					(allSubclasses inject: 0
						into: 
							[:sum :class | 
							| sels |
							sels := class whichSelectorsAccess: each.
							sels size == 1 
								ifTrue: 
									[selector := sels asArray first.
									defClass := class].
							sum + sels size]) 
							== 1 
							ifTrue: 
								[| tree |
								tree := defClass parseTreeFor: selector.
								tree notNil 
									ifTrue: 
										[(RBReadBeforeWrittenTester readBeforeWritten: (Array with: each) in: tree) 
											isEmpty 
												ifTrue: 
													[result addClass: defClass selector: selector.
													result addSearchString: each]]]]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'accessing' stamp: 'MarcusDenker 9/4/2014 15:52'!
protocolsToCheck
	^#('bugs' 'possible bugs' 'unnecessary code' 'intention revealing' 'miscellaneous')! !

!RBBasicLintRuleTest class methodsFor: 'possible bugs' stamp: 'lr 9/4/2010 17:29'!
modifiesCollection
	| detector addSearcher |
	detector := self new.
	detector name: 'Modifies collection while iterating over it'.
	addSearcher := RBBasicLintRuleTest modifiesCollection.
	detector methodBlock: 
			[:context :result | 
			addSearcher executeTree: context parseTree initialAnswer: false.
			addSearcher answer 
				ifTrue: [result addClass: context selectedClass selector: context selector]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'instance creation' stamp: ''!
createParseTreeRule: codeStrings name: aName 
	^self createParseTreeRule: codeStrings
		method: false
		name: aName! !

!RBBasicLintRuleTest class methodsFor: 'private' stamp: ''!
classShouldNotOverride
	^#(#== #class)! !

!RBBasicLintRuleTest class methodsFor: 'possible bugs' stamp: 'lr 11/19/2009 14:48'!
fileBlocks
	^self createParseTreeRule: 
				#('[| `@temps | 
					`var := `@object.  
					`@.statements] 
							ensure: 
								[`var `@messages: `@args]' 
				'[| `@temps | 
					`var := `@object.  
					`@.statements] 
							ifCurtailed: 
								[`var `@messages: `@args]') 
		name: 'Assignment inside unwind blocks should be outside.'! !

!RBBasicLintRuleTest class methodsFor: 'intention revealing' stamp: 'lr 11/2/2009 00:14'!
toDo
	| detector matcher |
	detector := self new.
	detector name: 'Uses to:do: instead of do:, with:do: or timesRepeat:'.
	matcher := RBParseTreeSearcher new.
	matcher
		addSearch: '1 to: ``@object size do: [:`each | | `@temps | `@.Statements]' -> 
					[:aNode :answer | 
					answer or: 
							[| varName variableMatcher |
							varName := aNode arguments last arguments first name. "`each"
							variableMatcher := RBParseTreeSearcher new.
							variableMatcher addSearch: varName
										-> [:node :ans | ans and: [node parent isMessage and: [node parent selector == #at:]]].
							variableMatcher executeTree: aNode arguments last body initialAnswer: true]].
	detector methodBlock: 
			[:context :result | 
			(matcher executeTree: context parseTree initialAnswer: false)
				ifTrue: [result addClass: context selectedClass selector: context selector]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'unnecessary code' stamp: 'YuriyTymchuk 9/4/2014 10:35'!
unreferencedVariables
	| detector |
	detector := self new.
	detector name: 'Variables not referenced'.
	detector result: nil unreferenced.
	detector classBlock: 
			[:context :result | 
			| allSubclasses |
			allSubclasses := context selectedClass withAllSubclasses.
			context selectedClass instVarNames do: 
					[:each | 
					allSubclasses
						detect: [:class | (class whichSelectorsAccess: each) isEmpty not]
						ifNone: [result addInstVar: each for: context selectedClass]].
			context selectedClass isMetaclass ifFalse: 
					[context selectedClass classPool associationsDo: 
							[:each | 
							(SystemNavigation default allCallsOn: each) ifEmpty:  [result addClassVar: each key for: context selectedClass]]]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'unnecessary code' stamp: 'TommasoDalSasso 10/6/2013 01:37'!
onlyReadOrWritten
	| detector |
	detector := self new.
	detector name: 'Instance variables not read AND written'.
	detector result: nil references.
	detector classBlock: 
			[:context :result | 
			| allSubclasses |
			allSubclasses := context selectedClass withAllSubclasses.
			context selectedClass instVarNames do: 
					[:each | 
					| reads writes |
					reads := false.
					writes := false.
					allSubclasses detect: 
							[:class | 
							reads ifFalse: [reads := (class whichSelectorsRead: each) isEmpty not].
							writes ifFalse: [writes := (class whichSelectorsWrite: each) isEmpty not].
							reads & writes]
						ifNone: [result addInstVar: each for: context selectedClass]]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'miscellaneous' stamp: 'lr 11/2/2009 00:14'!
yourselfNotUsed
	| detector addSearcher |
	detector := self new.
	detector name: 'Doesn''t use the result of a yourself message'.
	addSearcher := RBParseTreeSearcher new.
	addSearcher addSearch: '`@object yourself'
				-> [:aNode :answer | answer or: [aNode isUsed not]].
	detector methodBlock: 
			[:context :result | 
			(addSearcher executeTree: context parseTree initialAnswer: false)
				ifTrue: [result addClass: context selectedClass selector: context selector]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'private' stamp: ''!
utilityProtocols
	"If a method is defined in one of these protocols, then don't check if its a utility method."

	^#('*utilit*')! !

!RBBasicLintRuleTest class methodsFor: 'possible bugs' stamp: 'YuriyTymchuk 9/4/2014 10:31'!
abstractClass
	| detector subclassResponsibilitySymbol |
	detector := self new.
	detector name: 'References an abstract class'.
	detector resultClass: RBClassEnvironment.
	subclassResponsibilitySymbol := 'subclassResponsibility' asSymbol.
	detector classBlock: 
			[:context :result | 
			(context selectedClass whichSelectorsReferTo: subclassResponsibilitySymbol)
				ifNotEmpty: 
						[(context whichSelectorsReferTo: subclassResponsibilitySymbol) ifNotEmpty:  [result addClass: context selectedClass]]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'unnecessary code' stamp: 'lr 11/2/2009 00:14'!
equalsTrue
	| detector matcher |
	detector := self new.
	detector name: 'Unnecessary "= true"'.
	matcher := (RBParseTreeSearcher new) addSearches: #('true' 'false') -> 
								[:aNode :answer | 
								answer or: 
										[aNode parent isMessage
											and: [#(#= #== #~= #~~) includes: aNode parent selector]]];
				yourself.
	detector methodBlock: 
			[:context :result | 
			(matcher executeTree: context parseTree initialAnswer: false)
				ifTrue: [result addClass: context selectedClass selector: context selector]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'possible bugs' stamp: 'lr 11/2/2009 00:14'!
tempsReadBeforeWritten
	| detector |
	detector := self new.
	detector name: 'Temporaries read before written'.
	detector methodBlock: 
			[:context :result | 
			| variables |
			variables := RBParseTreeSearcher nonBlockTempsIn: context parseTree.
			variables isEmpty 
				ifFalse: 
					[(RBReadBeforeWrittenTester variablesReadBeforeWrittenIn: context parseTree) 
						do: 
							[:each | 
							result addClass: context selectedClass selector: context selector.
							result addSearchString: each]]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'private' stamp: 'VanessaPena 1/29/2013 10:32'!
canCall: aSelector in: aClass from: anApplication
	"This method contains on purpose not implemented messages, such as rootApplication "
	| methodApp root |
	(aClass canUnderstand: aSelector) ifFalse: [^false].
	root := anApplication rootApplication.
	methodApp := ((aClass whichClassIncludesSelector: aSelector) compiledMethodAt: aSelector)
				application rootApplication.
	^methodApp == root or: [root isBasedOn: methodApp]! !

!RBBasicLintRuleTest class methodsFor: 'miscellaneous' stamp: 'lr 11/2/2009 00:14'!
utilityMethods
	| detector |
	detector := self new.
	detector name: 'Utility methods'.
	detector methodBlock: 
			[:context :result | 
			(context selectedClass isMetaclass | (context selector numArgs == 0) or: 
					[(context protocols detect: 
							[:each | 
							(self utilityProtocols detect: [:protocol | protocol match: each]
								ifNone: [nil]) notNil]
						ifNone: [nil]) notNil])
				ifFalse: 
					[(self subclassOf: context selectedClass overrides: context selector)
						ifFalse: 
							[(context superMessages isEmpty and: [context selfMessages isEmpty]) ifTrue: 
									[(RBParseTreeSearcher
										references: context selectedClass allInstVarNames
												, context selectedClass allClassVarNames asArray , #('self')
										in: context parseTree) isEmpty
										ifTrue: [result addClass: context selectedClass selector: context selector]]]]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'private' stamp: ''!
longMethodSize
	^10! !

!RBBasicLintRuleTest class methodsFor: 'miscellaneous' stamp: 'lr 11/2/2009 00:14'!
ifTrueBlocks
	| detector matcher |
	detector := self new.
	detector name: 'Non-blocks in ifTrue:/ifFalse: messages'.
	matcher := RBParseTreeSearcher new.
	matcher
		addSearches: #('``@condition ifTrue: ``@block' '``@condition ifFalse: ``@block' '``@condition ifTrue: ``@block1 ifFalse: ``@block2' '``@condition ifFalse: ``@block1 ifTrue: ``@block2')
				-> 
					[:aNode :answer | 
					answer or: 
							[(aNode arguments detect: [:each | each isBlock not] ifNone: [nil]) notNil]].
	detector methodBlock: 
			[:context :result | 
			(matcher executeTree: context parseTree initialAnswer: false)
				ifTrue: [result addClass: context selectedClass selector: context selector]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'intention revealing' stamp: ''!
whileTrue
	^self createParseTreeRule: 
			#('| `@temps | 
				`@.Statements1. 
				[`index <= `@stop] 
					whileTrue: 
						[| `@blockTemps | 
						`@.BlockStmts1. 
						`index := `index + 1].
				`@.Statements2' 
			'| `@temps | 
				`@.Statements1. 
				[`index < `@stop] 
					whileTrue: 
						[| `@blockTemps | 
						`@.BlockStmts1. 
						`index := `index + 1].
				`@.Statements2'
			'| `@temps | 
				`@.Statements1. 
				[`index >= `@stop] 
					whileTrue: 
						[| `@blockTemps | 
						`@.BlockStmts1. 
						`index := `index - 1].
				`@.Statements2' 
			'| `@temps | 
				`@.Statements1. 
				[`index > `@stop] 
					whileTrue: 
						[| `@blockTemps | 
						`@.BlockStmts1. 
						`index := `index - 1].
				`@.Statements2') 
		name: 'Uses whileTrue: instead of to:do:'! !

!RBBasicLintRuleTest class methodsFor: 'possible bugs' stamp: 'lr 11/2/2009 00:14'!
threeElementPoint
	| detector matcher |
	detector := self new.
	detector name: 'Possible three element point (e.g., x @ y + q @ r)'.
	matcher := (RBParseTreeSearcher new) addSearch: '``@x @ ``@y' -> 
								[:aNode :answer | 
								answer or: 
										[| current |
										current := aNode parent.
										[current isNil or: 
												[current isMessage
													and: [current selector == #@ or: [current selector isInfix not]]]]
											whileFalse: [current := current parent].
										(current isNil or: [current isMessage and: [current selector isInfix not]])
											not]];
				yourself.
	detector methodBlock: 
			[:context :result | 
			(matcher executeTree: context parseTree initialAnswer: false)
				ifTrue: [result addClass: context selectedClass selector: context selector]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'bugs' stamp: ''!
usesTrue
	| detector trueBinding falseBinding |
	detector := self new.
	trueBinding := Smalltalk associationAt: #True.
	falseBinding := Smalltalk associationAt: #False.
	detector name: 'Uses True/False instead of true/false'.
	detector methodBlock: 
			[:context :result | 
			| method |
			method := context compiledMethod.
			((method referencesLiteral: trueBinding)
				or: [method referencesLiteral: falseBinding]) ifTrue: 
						[result addClass: context selectedClass selector: context selector.
						result searchStrings: #('True' 'False')]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'miscellaneous' stamp: 'lr 11/2/2009 00:14'!
stringConcatenation
	| detector matcher concatenationMatcher |
	detector := self new.
	detector name: 'String concatenation instead of streams'.
	matcher := RBParseTreeSearcher new.
	concatenationMatcher := RBParseTreeSearcher new.
	concatenationMatcher
		addSearch: '`@receiver , `@argument' -> [:aNode :answer | true].
	matcher
		addSearches: #('``@collection do: [:`each | | `@temps | ``@.Statements]' '``@collection do: [:`each | | `@temps | ``@.Statements] separatedBy: [| `@temps1 | ``@.Statements1]' '``@number to: ``@endNumber do: [:`i | | `@temps | ``@.Statements]' '``@collection detect: [:`each | | `@temps | ``@.Statements]' '``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [| `@temps1 | ``@.Statements1]' '``@collection select: [:`each | | `@temps | ``@.Statements]' '``@collection inject: ``@value into: [:`each | | `@temps | ``@.Statements]')
				-> 
					[:aNode :answer | 
					answer or: 
							[(aNode arguments detect: 
									[:each | 
									each isBlock
										and: [concatenationMatcher executeTree: each initialAnswer: false]]
								ifNone: [nil]) notNil]].
	detector methodBlock: 
			[:context :result | 
			(matcher executeTree: context parseTree initialAnswer: false)
				ifTrue: [result addClass: context selectedClass selector: context selector]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'intention revealing' stamp: ''!
consistencyCheck
	^self createParseTreeRule: 
				#('`@object size == 0' 
				'`@object size = 0' 
				'`@object size > 0' 
				'`@object size >= 1' 
				'`@object == nil' 
				'`@object = nil') 
		name: 'Uses "size = 0" or "= nil" instead of "isEmpty" or "isNil"'! !

!RBBasicLintRuleTest class methodsFor: 'intention revealing' stamp: ''!
sizeCheck
	^self createParseTreeRule: (#(#do: #collect: #reject: #select:) collect: 
					[:each | 
					'`@object size > 0 ifTrue: [`@object ' , each
						, ' [:`each | | `@temps | `@.Statements1]. `@.Statements2]'])
				, (#(#do: #collect: #reject: #select:) collect: 
							[:each | 
							'`@object isEmpty ifFalse: [`@object ' , each
								, ' [:`each | | `@temps | `@.Statements1]. `@.Statements2]'])
		name: 'Unnecessary size check'! !

!RBBasicLintRuleTest class methodsFor: 'intention revealing' stamp: ''!
assignmentInIfTrue
	^self createParseTreeRule: 
			#('`@boolean 
					ifTrue: [| `@temps1 | `@.Statements1. `var := `@object1] 
					ifFalse: [| `@temps2 | `@.Statements2. `var := `@object2]' 
			'`@boolean 
					ifFalse: [| `@temps1 | `@.Statements1. `var := `@object1] 
					ifTrue: [| `@temps2 | `@.Statements2. `var := `@object2]') 
		name: 'Assignment to same variable and end of ifTrue:ifFalse: blocks'! !

!RBBasicLintRuleTest class methodsFor: 'unnecessary code' stamp: ''!
extraBlock
	^self
		createParseTreeRule: (#('value' 'value: `@value' 'value: `@value1 value: `@value2' 'value: `@value1 value: `value2 value: `@value3' 'valueWithArguments: `@values')
				collect: [:each | '[:`@params | | `@temps | `@.statements] ' , each])
		name: 'Block immediately evaluated'! !

!RBBasicLintRuleTest class methodsFor: 'possible bugs' stamp: ''!
superSends
	| detector |
	detector := self new.
	detector name: 'Missing super sends'.
	detector methodBlock: 
			[:context :result | 
			(context selectedClass isMetaclass not
				and: [self superMessages includes: context selector]) ifTrue: 
						[(context selectedClass superclass notNil
							and: [context selectedClass superclass canUnderstand: context selector])
								ifTrue: 
									[(context superMessages includes: context selector)
										ifFalse: [result addClass: context selectedClass selector: context selector]]]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'possible bugs' stamp: 'MarcusDenker 7/2/2014 09:17'!
addRemoveDependents
	| detector |
	detector := self new.
	detector resultClass: RBClassEnvironment.
	detector name: 'Number of addDependent: messages > removeDependent:'.
	detector classBlock: 
			[:context :result | 
			| count |
			count := 0.
			((Set
				withAll: (context selectedClass whichSelectorsReferTo: #addDependent:))
					addAll: (context selectedClass whichSelectorsReferTo: #removeDependent:);
				yourself) do: 
					[:sel | 
					(context selectedClass compiledMethodAt: sel) messages do: 
							[:each | 
							each == #addDependent: ifTrue: [count := count + 1].
							each == #removeDependent: ifTrue: [count := count - 1]]].
			count > 0 ifTrue: [result addClass: context selectedClass]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'possible bugs' stamp: ''!
sendsDifferentSuper
	| detector |
	detector := self new.
	detector name: 'Sends different super message'.
	detector methodBlock: 
			[:context :result | 
			| message |
			(message := context superMessages detect: [:each | each ~= context selector]
						ifNone: [nil]) notNil ifTrue: 
					[result addSearchString: message.
					result addClass: context selectedClass selector: context selector]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'bugs' stamp: ''!
subclassResponsibilityNotDefined
	| detector subclassResponsibilitySymbol |
	detector := self new.
	subclassResponsibilitySymbol := 'subclassResponsibility' asSymbol.
	detector name: 'Subclass responsibility not defined'.
	detector classBlock: 
			[:context :result | 
			(context selectedClass whichSelectorsReferTo: subclassResponsibilitySymbol)
				do: 
					[:each | 
					(context selectedClass withAllSubclasses detect: 
							[:class | 
							class subclasses isEmpty
								and: [(class whichClassIncludesSelector: each) == context selectedClass]]
						ifNone: [nil]) notNil
						ifTrue: [result addClass: context selectedClass selector: each]]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'bugs' stamp: ''!
booleanPrecedence
	^self createParseTreeRule: 
			#('`@object1 | `@object2 = `@object3'
			'`@object1 | `@object2 == `@object3'
			'`@object1 & `@object2 = `@object3'
			'`@object1 & `@object2 == `@object3'
			'`@object1 | `@object2 ~= `@object3'
			'`@object1 | `@object2 ~~ `@object3'
			'`@object1 & `@object2 ~= `@object3'
			'`@object1 & `@object2 ~~ `@object3')
		name: 'Uses A | B = C instead of A | (B = C)'! !

!RBBasicLintRuleTest class methodsFor: 'intention revealing' stamp: ''!
contains
	^self createParseTreeRule: 
			#('(`@object detect: [:`each | | `@temps| `@.Statements] ifNone: [nil]) isNil' 
			'(`@object detect: [:`each | | `@temps| `@.Statements] ifNone: [nil]) notNil' 
			'(`@object detect: [:`each | | `@temps| `@.Statements] ifNone: [nil]) = nil' 
			'(`@object detect: [:`each | | `@temps| `@.Statements] ifNone: [nil]) == nil' 
			'(`@object detect: [:`each | | `@temps| `@.Statements] ifNone: [nil]) ~= nil' 
			'(`@object detect: [:`each | | `@temps| `@.Statements] ifNone: [nil]) ~~ nil' 
			'`@object detect: [:`each | | `@temps| `@.Statements] ifNone: [| `@temps1 | `@.Statements2. ^`@anything]') 
		name: 'Uses detect:ifNone: instead of contains:'! !

!RBBasicLintRuleTest class methodsFor: 'miscellaneous' stamp: 'bh 4/8/2000 19:05'!
fullBlocks

"skip this test in squeak."

"	| detector |
	detector := self new.
	detector name: 'Method with full blocks'.
	detector methodBlock: 
			[:context :result | 
			context compiledMethod withAllBlockMethodsDo: 
					[:method | 
					method needsHybridFrame
						ifTrue: [result addClass: context selectedClass selector: context selector]]].
	^detector"! !

!RBBasicLintRuleTest class methodsFor: 'intention revealing' stamp: 'MarcusDenker 9/20/2013 15:05'!
ifTrueReturns
	| detector matcher |
	detector := self new.
	detector name: 'ifTrue:/ifFalse: returns instead of and:/or:''s'.
	matcher := RBParseTreeSearcher new.
	matcher addSearches:
		#('| `@temps | ``@.Statements. ``@object ifTrue: [^``@value1]. ^``@value2' 
		'| `@temps | ``@.Statements. ``@object ifFalse: [^``@value1]. ^``@value2') 
			-> [:aNode :answer | answer
				or: 
					[| node |
					node := (aNode statements at: aNode statements size - 1) arguments first body statements last value. "``@value1"
					(node isLiteralNode and: [{true. false} includes: node value])
						or: 
							[node := aNode statements last value.
							node isLiteralNode and: [{true. false} includes: node value]]]].
	detector methodBlock: [:context :result | (matcher executeTree: context parseTree initialAnswer: false)
			ifTrue: [result addClass: context selectedClass selector: context selector]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'miscellaneous' stamp: 'lr 11/2/2009 00:14'!
longMethods
	| detector matcher |
	detector := self new.
	detector name: 'Long methods'.
	matcher := RBParseTreeSearcher new.
	matcher
		addSearch: '`.Stmt' -> 
					[:aNode :answer | 
					(aNode children inject: answer
						into: [:sum :each | matcher executeTree: each initialAnswer: sum]) + 1].
	detector methodBlock: 
			[:context :result | 
			(matcher executeTree: context parseTree initialAnswer: 0)
				>= self longMethodSize
					ifTrue: [result addClass: context selectedClass selector: context selector]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'intention revealing' stamp: 'lr 11/2/2009 00:14'!
minMax
	| detector matcher |
	detector := self new.
	detector name: 'Uses ifTrue:/ifFalse: instead of min: or max:'.
	matcher := RBParseTreeSearcher new.
	matcher
		addSearches: #('(`x `message: `@y) `ifTrue: [`x := `@y]' '(`@x `message: `@y) `ifTrue: [`@x] `ifFalse: [`@y]')
				-> 
					[:aNode :answer | 
					answer or: 
							[(#(#ifTrue: #ifFalse: #ifTrue:ifFalse: #ifFalse:ifTrue:)
								includes: aNode selector)
									and: [#(#< #<= #> #>=) includes: aNode receiver selector]]].
	detector methodBlock: 
			[:context :result | 
			(matcher executeTree: context parseTree initialAnswer: false)
				ifTrue: [result addClass: context selectedClass selector: context selector]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'private' stamp: 'nk 2/23/2005 16:09'!
new
	^super new! !

!RBBasicLintRuleTest class methodsFor: 'private' stamp: ''!
subclassOf: aClass overrides: aSelector 
	| subs |
	subs := aClass subclasses.
	1 to: subs size
		do: 
			[:i | 
			| each |
			each := subs at: i.
			(each includesSelector: aSelector) ifTrue: [^true].
			(self subclassOf: each overrides: aSelector) ifTrue: [^true]].
	^false! !

!RBBasicLintRuleTest class methodsFor: 'unnecessary code' stamp: 'lr 11/2/2009 00:14'!
endTrueFalse
	| detector matcher |
	detector := self new.
	detector name: 'Check for same statements at end of ifTrue:ifFalse: blocks'.
	matcher := (RBParseTreeSearcher new) addSearches: 
				#('`@object 
						ifTrue: [| `@temps1 | `@.Statements1. `.Statement] 
						ifFalse: [| `@temps2 | `@.Statements2. `.Statement]' 
				'`@object 
						ifTrue: [| `@temps1 | `.Statement. `@.Statements1] 
						ifFalse: [| `@temps2 | `.Statement. `@.Statements2]' 
				'`@object 
						ifFalse: [| `@temps1 | `@.Statements1. `.Statement] 
						ifTrue: [| `@temps2 | `@.Statements2. `.Statement]' 
				'`@object 
						ifFalse: [| `@temps1 | `.Statement. `@.Statements1] 
						ifTrue: [| `@temps2 | `.Statement. `@.Statement2]') 
			-> [:aNode :answer | answer
						or: 
							[| node |
							node := aNode arguments first body statements last.
							(node isVariable and: [node = aNode arguments last body statements last]) not]]; yourself.
	detector methodBlock: [:context :result | (matcher executeTree: context parseTree initialAnswer: false)
			ifTrue: [result addClass: context selectedClass selector: context selector]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'unnecessary code' stamp: 'lr 11/2/2009 00:14'!
justSendsSuper
	| detector matcher |
	detector := self new.
	detector name: 'Method just sends super message'.
	matcher := RBParseTreeSearcher justSendsSuper.
	detector methodBlock: 
			[:context :result | 
			(context parseTree tag isNil
				and: [matcher executeMethod: context parseTree initialAnswer: false])
					ifTrue: [result addClass: context selectedClass selector: context selector]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'bugs' stamp: ''!
sentNotImplemented
	| detector |
	detector := self new.
	detector name: 'Messages sent but not implemented'.
	detector methodBlock: 
			[:context :result | 
			| message |
			message := context messages detect: [:each | (context implements: each) not]
						ifNone: [nil].
			message isNil ifTrue: 
					[message := context superMessages detect: 
									[:each | 
									context selectedClass superclass isNil
										or: [(context selectedClass superclass canUnderstand: each) not]]
								ifNone: [nil].
					message isNil ifTrue: 
							[message := context selfMessages
										detect: [:each | (context selectedClass canUnderstand: each) not]
										ifNone: [nil]]].
			message notNil ifTrue: 
					[result addSearchString: message.
					result addClass: context selectedClass selector: context selector]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'instance creation' stamp: ''!
createParseTreeRule: codeStrings method: aBoolean name: aName 
	| detector matcher |
	detector := self new.
	detector name: aName.
	matcher := self createMatcherFor: codeStrings method: aBoolean.
	detector methodBlock: 
			[:context :result | 
			(matcher executeTree: context parseTree initialAnswer: false)
				ifTrue: [result addClass: context selectedClass selector: context selector]].
	^detector! !

!RBBasicLintRuleTest class methodsFor: 'unnecessary code' stamp: ''!
equivalentSuperclassMethods
	| detector |
	detector := self new.
	detector name: 'Methods equivalently defined in superclass'.
	detector methodBlock: 
			[:context :result | 
			context selectedClass superclass notNil ifTrue: 
					[(context selectedClass superclass canUnderstand: context selector)
						ifTrue: 
							[(((context selectedClass superclass
								whichClassIncludesSelector: context selector)
									compiledMethodAt: context selector)
									equivalentTo: context compiledMethod)
									ifTrue: [result addClass: context selectedClass selector: context selector]]]].
	^detector! !

!RBBetweenAndRule commentStamp: 'StephaneDucasse 11/29/2014 17:38'!
Replaces "a >= b and: [a <= c]" by "a between: b and: c.!
!RBBetweenAndRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:29'!
initialize
	super initialize.
	self rewriteRule
		replace: '``@a >= ``@b and: [``@a <= ``@c]' with: '``@a between: ``@b and: ``@c';
		replace: '``@a >= ``@b & (``@a <= ``@c)' with: '``@a between: ``@b and: ``@c';
		replace: '``@b <= ``@a and: [``@a <= ``@c]' with: '``@a between: ``@b and: ``@c';
		replace: '``@b <= ``@a & (``@a <= ``@c)' with: '``@a between: ``@b and: ``@c';
		replace: '``@a <= ``@c and: [``@a >= ``@b]' with: '``@a between: ``@b and: ``@c';
		replace: '``@a <= ``@c & (``@a >= ``@b)' with: '``@a between: ``@b and: ``@c';
		replace: '``@c >= ``@a and: [``@a >= ``@b]' with: '``@a between: ``@b and: ``@c';
		replace: '``@c >= ``@a & (``@a >= ``@b)' with: '``@a between: ``@b and: ``@c';
		replace: '``@a >= ``@b and: [``@c >= ``@a]' with: '``@a between: ``@b and: ``@c';
		replace: '``@a >= ``@b & (``@c >= ``@a)' with: '``@a between: ``@b and: ``@c';
		replace: '``@b <= ``@a and: [``@c >= ``@a]' with: '``@a between: ``@b and: ``@c';
		replace: '``@b <= ``@a & (``@c >= ``@a)' with: '``@a between: ``@b and: ``@c';
		replace: '``@a <= ``@c and: [``@b <= ``@a]' with: '``@a between: ``@b and: ``@c';
		replace: '``@a <= ``@c & (``@b <= ``@a)' with: '``@a between: ``@b and: ``@c';
		replace: '``@c >= ``@a and: [``@b <= ``@a]' with: '``@a between: ``@b and: ``@c';
		replace: '``@c >= ``@a & (``@b <= ``@a)' with: '``@a between: ``@b and: ``@c'! !

!RBBetweenAndRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Transformations'! !

!RBBetweenAndRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ '"a >= b and: [a <= c]" -> "a between: b and: c"'! !

!RBBetweenAndRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:49'!
category 
	^ 'Coding Idiom Violation'! !

!RBBetweenAndRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'BetweenAndRule'! !

!RBBinarySelectorToken commentStamp: 'md 8/9/2005 14:51'!
RBBinarySelectorToken is the first-class representation of a binary selector (e.g. +)
!
!RBBinarySelectorToken methodsFor: 'testing' stamp: ''!
isBinary
	^true! !

!RBBlockLintRule commentStamp: '<historical>'!
I am a special kind of rule where the verification is specified using a block. The methods checkClass: and checkMethods are the hooks to specify such verifications.!
!RBBlockLintRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'!
resultClass
	^ RBSelectorEnvironment! !

!RBBlockLintRule class methodsFor: 'testing' stamp: 'lr 2/24/2009 17:09'!
isVisible
	^ self name ~= #RBBlockLintRule! !

!RBBlockLintRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'BlockLintRule'! !

!RBBlockNode commentStamp: '<historical>'!
RBBlockNode is an AST node that represents a block "[...]".

Instance Variables:
	arguments	<SequenceableCollection of: RBVariableNode>	the arguments for the block
	bar	<Integer | nil>	position of the | after the arguments
	body	<RBSequenceNode>	the code inside the block
	colons	<SequenceableCollection of: Integer>	positions of each : before each argument
	left	<Integer>	position of [
	right	<Integer>	position of ]

!
!RBBlockNode methodsFor: 'testing' stamp: 'CamilloBruni 12/15/2011 16:42'!
hasTemporaryNamed: aString	
	^ self temporaries anySatisfy: [ :temp| temp name = aString ]! !

!RBBlockNode methodsFor: '*opalcompiler-core' stamp: 'ClementBera 7/26/2013 15:18'!
isInlinedLoop
	parent isMessage ifFalse: [ ^ false ].
	parent isInlineToDo ifTrue: [^ true].
	parent isInlineWhile ifTrue: [^ true].
	parent isInlineTimesRepeat ifTrue: [^ true].
	(parent parent isArray and: [parent parent parent isMessage and: [parent parent parent isInlineCase]]) ifTrue: [^ true].
	parent isInlineCase ifTrue: [^ true].  "otherwise branch"
	^ false! !

!RBBlockNode methodsFor: 'accessing-token' stamp: 'lr 2/12/2010 19:25'!
right: anInteger
	right := anInteger! !

!RBBlockNode methodsFor: '*SmartSuggestions' stamp: 'MarcusDenker 10/24/2014 17:11'!
specialCommands
	^ SugsSuggestionFactory commandsForBlock! !

!RBBlockNode methodsFor: 'accessing' stamp: ''!
children
	^self arguments copyWith: self body! !

!RBBlockNode methodsFor: 'testing' stamp: ''!
isBlock
	^true! !

!RBBlockNode methodsFor: 'testing' stamp: ''!
isImmediateNode
	^true! !

!RBBlockNode methodsFor: 'accessing-token' stamp: 'lr 2/12/2010 19:25'!
colons: anArray 
	colons := anArray! !

!RBBlockNode methodsFor: 'testing' stamp: ''!
references: aVariableName 
	^body references: aVariableName! !

!RBBlockNode methodsFor: 'accessing' stamp: 'CamilloBruni 12/15/2011 16:28'!
scope
	^ scope! !

!RBBlockNode methodsFor: 'testing' stamp: ''!
isLast: aNode 
	^body isLast: aNode! !

!RBBlockNode methodsFor: 'accessing' stamp: ''!
precedence
	^0! !

!RBBlockNode methodsFor: 'testing' stamp: ''!
uses: aNode 
	aNode = body ifFalse: [^false].
	^parent isMessage 
		ifTrue: 
			[(#(#ifTrue:ifFalse: #ifTrue: #ifFalse: #ifFalse:ifTrue:) 
				includes: parent selector) not 
				or: [parent isUsed]]
		ifFalse: [self isUsed]! !

!RBBlockNode methodsFor: 'replacing' stamp: ''!
replaceNode: aNode withNode: anotherNode 
	body == aNode ifTrue: [self body: anotherNode].
	self arguments: (arguments 
				collect: [:each | each == aNode ifTrue: [anotherNode] ifFalse: [each]])! !

!RBBlockNode methodsFor: 'testing' stamp: ''!
defines: aName 
	^arguments anySatisfy: [:each | each name = aName]! !

!RBBlockNode methodsFor: 'accessing-token' stamp: 'lr 2/12/2010 19:25'!
bar: anInteger
	bar := anInteger! !

!RBBlockNode methodsFor: 'copying' stamp: 'lr 11/1/2009 22:36'!
postCopy
	super postCopy.
	self arguments: (self arguments collect: [ :each | each copy ]).
	self body: self body copy! !

!RBBlockNode methodsFor: 'matching' stamp: 'lr 5/30/2010 11:34'!
match: aNode inContext: aDictionary 
	aNode class = self class ifFalse: [^false].
	^(self 
		matchList: arguments
		against: aNode arguments
		inContext: aDictionary) 
			and: [body match: aNode body inContext: aDictionary]! !

!RBBlockNode methodsFor: 'accessing' stamp: 'CamilloBruni 12/15/2011 16:28'!
scope: aScopedNode
	scope := aScopedNode! !

!RBBlockNode methodsFor: 'testing' stamp: ''!
needsParenthesis
	^false! !

!RBBlockNode methodsFor: '*opalcompiler-core' stamp: 'ClementBera 7/26/2013 15:28'!
methodOrBlockNode
	"^ self"! !

!RBBlockNode methodsFor: 'testing' stamp: 'CamilloBruni 12/15/2011 16:42'!
hasArgumentNamed: aString	
	^ self arguments anySatisfy: [ :argument| argument name = aString ]! !

!RBBlockNode methodsFor: 'accessing' stamp: 'CamilloBruni 2/3/2012 17:18'!
temporaries
	^ self body temporaries! !

!RBBlockNode methodsFor: 'accessing' stamp: ''!
allDefinedVariables
	^(self argumentNames asOrderedCollection)
		addAll: super allDefinedVariables;
		yourself! !

!RBBlockNode methodsFor: 'accessing' stamp: ''!
body: stmtsNode 
	body := stmtsNode.
	body parent: self! !

!RBBlockNode methodsFor: 'testing' stamp: ''!
directlyUses: aNode 
	^false! !

!RBBlockNode methodsFor: 'accessing-token' stamp: 'lr 2/12/2010 19:25'!
bar
	^ bar! !

!RBBlockNode methodsFor: 'accessing' stamp: 'MarkRizun 10/31/2014 15:31'!
stopWithoutParentheses
	^ right! !

!RBBlockNode methodsFor: 'accessing-token' stamp: 'lr 2/12/2010 19:25'!
left
	^ left! !

!RBBlockNode methodsFor: 'testing' stamp: 'GiselaDecuzzi 6/5/2013 10:29'!
isFaulty
	^(self arguments anySatisfy:  #isFaulty ) or: [ self body isFaulty]! !

!RBBlockNode methodsFor: 'accessing-token' stamp: 'lr 2/12/2010 19:25'!
right
	^ right! !

!RBBlockNode methodsFor: 'accessing' stamp: 'CamilloBruni 12/8/2011 15:17'!
temporaryNames
	^ self body temporaryNames! !

!RBBlockNode methodsFor: '*opalcompiler-core' stamp: 'ClementBera 8/5/2013 11:03'!
isClean
	"a block is clean if it has no escaping vars, has no non local return and its children are clean"
	self isInlined ifTrue: [ ^ false ].
	self scope hasEscapingVars ifTrue: [ ^ false ].
	self lastIsReturn ifTrue: [ ^ false ].
	^ super isClean
	! !

!RBBlockNode methodsFor: 'accessing' stamp: ''!
allArgumentVariables
	^(self argumentNames asOrderedCollection)
		addAll: super allArgumentVariables;
		yourself! !

!RBBlockNode methodsFor: 'accessing' stamp: 'CamilloBruni 2/3/2012 16:43'!
statements
	^ self body statements! !

!RBBlockNode methodsFor: 'accessing' stamp: ''!
blockVariables
	| vars |
	vars := super blockVariables asOrderedCollection.
	vars addAll: self argumentNames.
	^vars! !

!RBBlockNode methodsFor: '*opalcompiler-core' stamp: 'ClementBera 8/5/2013 11:04'!
lastIsReturn
	^ self body lastIsReturn! !

!RBBlockNode methodsFor: 'comparing' stamp: 'lr 3/7/2010 13:48'!
hash
	^ (self hashForCollection: self arguments) bitXor: self body hash! !

!RBBlockNode methodsFor: 'matching' stamp: 'lr 11/24/2009 23:35'!
copyInContext: aDictionary 
	^ self class new
		arguments: (self copyList: self arguments inContext: aDictionary);
		body: (self body copyInContext: aDictionary);
		yourself! !

!RBBlockNode methodsFor: 'accessing' stamp: 'MarkRizun 10/31/2014 15:31'!
startWithoutParentheses
	^ left! !

!RBBlockNode methodsFor: 'accessing' stamp: ''!
arguments: argCollection 
	arguments := argCollection.
	arguments do: [:each | each parent: self]! !

!RBBlockNode methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:36'!
acceptVisitor: aProgramNodeVisitor 
	^aProgramNodeVisitor visitBlockNode: self! !

!RBBlockNode methodsFor: '*OpalDecompiler' stamp: 'ClementBera 7/10/2014 17:23'!
isJust: literal
	body  statements size = 1 ifFalse: [ ^ false ].
	body  statements anyOne isLiteralNode ifFalse: [ ^ false ].
	^ body  statements anyOne value == literal! !

!RBBlockNode methodsFor: 'comparing' stamp: 'BernardoContreras 8/23/2014 19:43'!
equalTo: anObject withMapping: aDictionary 
	self class = anObject class ifFalse: [^false].
	self arguments size = anObject arguments size ifFalse: [^false].
	self arguments
		with: anObject arguments
		do: [:first :second |	(first equalTo: second withMapping: aDictionary) ifFalse: [^false]].
	(self body equalTo: anObject body withMapping: aDictionary)
		ifFalse: [^false].
	self arguments do: [:each | aDictionary removeKey: each name].
	^true! !

!RBBlockNode methodsFor: '*opalcompiler-core' stamp: 'jorgeRessia 11/20/2009 16:40'!
owningScope

	^ self scope ifNil: ["inlined" ^ parent owningScope]! !

!RBBlockNode methodsFor: 'accessing' stamp: ''!
body
	^body! !

!RBBlockNode methodsFor: '*OpalCompiler-Core' stamp: 'CamilleTeruel 7/29/2014 16:26'!
sourceNodeForPC: anInteger 
	^ self method sourceNodeForPC: anInteger! !

!RBBlockNode methodsFor: 'comparing' stamp: 'BernardoContreras 8/23/2014 19:23'!
= anObject 
	self == anObject ifTrue: [^true].
	self class = anObject class ifFalse: [^false].
	self body = anObject body ifFalse: [^false].
	self arguments size = anObject arguments size ifFalse: [^false].
	self arguments with: anObject arguments do: [:first :second | first = second ifFalse: [^false]].
	^true! !

!RBBlockNode methodsFor: 'accessing-token' stamp: 'lr 2/12/2010 19:25'!
left: anInteger
	left := anInteger! !

!RBBlockNode methodsFor: 'accessing-token' stamp: 'lr 2/12/2010 19:25'!
colons
	^ colons! !

!RBBlockNode methodsFor: '*opalcompiler-core' stamp: 'ClementBera 7/26/2013 15:11'!
isInlined
	parent isMessage ifFalse: [ ^ false ].
	parent isInlineAndOr ifTrue: [^ true].
	parent isInlineIf ifTrue: [^ true].
	parent isInlineIfNil ifTrue: [^ true].
	^ self isInlinedLoop! !

!RBBlockNode methodsFor: 'accessing' stamp: ''!
arguments
	^arguments! !

!RBBlockNode methodsFor: 'accessing' stamp: ''!
statementComments
	^self comments! !

!RBBlockNode methodsFor: 'accessing' stamp: ''!
argumentNames
	^self arguments collect: [:each | each name]! !

!RBBlockNode methodsFor: '*opalcompiler-core' stamp: 'CamilleTeruel 2/14/2014 14:37'!
enclosingMethodOrBlockNode
	^ parent ifNotNil: [ parent methodOrBlockNode ]! !

!RBBlockNode class methodsFor: 'instance creation' stamp: ''!
arguments: argNodes body: sequenceNode 
	^(self new)
		arguments: argNodes;
		body: sequenceNode;
		yourself! !

!RBBlockNode class methodsFor: 'instance creation' stamp: ''!
body: sequenceNode 
	^self arguments: #() body: sequenceNode! !

!RBBlockReplaceRule commentStamp: 'md 8/9/2005 14:55'!
RBBlockReplaceRule replaces the matching node by the result of evaluating replaceBlock. This allows arbitrary computation to come up with a replacement.

Instance Variables:
	replaceBlock	<BlockClosure>	The block that returns the node to replace to matching node with.
!
!RBBlockReplaceRule methodsFor: 'initialization' stamp: ''!
initialize
	super initialize.
	replaceBlock := [:aNode | aNode]! !

!RBBlockReplaceRule methodsFor: 'initialize-release' stamp: ''!
searchFor: searchString replaceWith: aBlock 
	self searchString: searchString.
	replaceBlock := aBlock! !

!RBBlockReplaceRule methodsFor: 'initialize-release' stamp: ''!
searchForMethod: searchString replaceWith: aBlock 
	self methodSearchString: searchString.
	replaceBlock := aBlock! !

!RBBlockReplaceRule methodsFor: 'initialize-release' stamp: ''!
searchForTree: aBRProgramNode replaceWith: aBlock 
	searchTree := aBRProgramNode.
	replaceBlock := aBlock! !

!RBBlockReplaceRule methodsFor: 'initialize-release' stamp: ''!
searchForTree: aBRProgramNode replaceWith: replBlock when: verifyBlock 
	self searchForTree: aBRProgramNode replaceWith: replBlock.
	verificationBlock := verifyBlock! !

!RBBlockReplaceRule methodsFor: 'matching' stamp: ''!
foundMatchFor: aProgramNode 
	| newNode |
	newNode := replaceBlock value: aProgramNode.
	aProgramNode replaceMethodSource: newNode.
	^newNode! !

!RBBlockReplaceRule methodsFor: 'initialize-release' stamp: ''!
searchForMethod: searchString replaceWith: replBlock when: verifyBlock 
	self searchForMethod: searchString replaceWith: replBlock.
	verificationBlock := verifyBlock! !

!RBBlockReplaceRule methodsFor: 'initialize-release' stamp: ''!
searchFor: searchString replaceWith: replBlock when: verifyBlock 
	self searchFor: searchString replaceWith: replBlock.
	verificationBlock := verifyBlock! !

!RBBlockReplaceRule class methodsFor: 'instance creation' stamp: ''!
searchFor: searchString replaceWith: replaceBlock when: aBlock 
	^self new 
		searchFor: searchString
		replaceWith: replaceBlock
		when: aBlock! !

!RBBlockReplaceRule class methodsFor: 'instance creation' stamp: ''!
searchForMethod: searchString replaceWith: replaceBlock when: aBlock 
	^self new 
		searchForMethod: searchString
		replaceWith: replaceBlock
		when: aBlock! !

!RBBlockReplaceRule class methodsFor: 'instance creation' stamp: ''!
searchFor: searchString replaceWith: replaceBlock 
	^self new searchFor: searchString replaceWith: replaceBlock! !

!RBBlockReplaceRule class methodsFor: 'instance creation' stamp: ''!
searchForMethod: searchString replaceWith: replaceBlock 
	^self new searchForMethod: searchString replaceWith: replaceBlock! !

!RBBlockReplaceRule class methodsFor: 'instance creation' stamp: ''!
searchForTree: aRBProgramNode replaceWith: replaceBlock 
	^self new searchForTree: aRBProgramNode replaceWith: replaceBlock! !

!RBBlockReplaceRule class methodsFor: 'instance creation' stamp: ''!
searchForTree: aRBProgramNode replaceWith: replaceBlock when: aBlock 
	^self new 
		searchForTree: aRBProgramNode
		replaceWith: replaceBlock
		when: aBlock! !

!RBBooleanPrecedenceRule commentStamp: 'StephaneDucasse 11/29/2014 21:17'!
Checks precedence ordering of & and | with equality operators. Since | and & have the same precedence as =, there are common mistakes where parenthesis are missing around the equality operators.!
!RBBooleanPrecedenceRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:18'!
initialize
	super initialize.
	self matcher 
		matchesAnyOf: #(
			'`@object1 | `@object2 = `@object3'
			'`@object1 | `@object2 == `@object3'
			'`@object1 & `@object2 = `@object3'
			'`@object1 & `@object2 == `@object3'
			'`@object1 | `@object2 ~= `@object3'
			'`@object1 | `@object2 ~~ `@object3'
			'`@object1 & `@object2 ~= `@object3'
			'`@object1 & `@object2 ~~ `@object3' )
		do: [ :node :answer | node ]! !

!RBBooleanPrecedenceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Bugs'! !

!RBBooleanPrecedenceRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:03'!
severity
	^ #error! !

!RBBooleanPrecedenceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Uses A | B = C instead of A | (B = C)'! !

!RBBooleanPrecedenceRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 16:21'!
category 
	^ 'Potential Bugs'! !

!RBBooleanPrecedenceRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'BooleanPrecedenceRule'! !

!RBBrowserEnvironment methodsFor: 'private' stamp: 'lr 3/20/2011 11:30'!
systemDictionary
	"The root system dictionary as the source of all objects in this environment."

	^ Smalltalk globals! !

!RBBrowserEnvironment methodsFor: 'accessing-classes' stamp: 'YuriyTymchuk 9/29/2014 20:12'!
allNonMetaClasses
	"Answer all the unique non-metaclasses of all of all the non-metaclasses in this environment."

	^ self allClasses! !

!RBBrowserEnvironment methodsFor: 'accessing' stamp: ''!
classVariablesFor: aClass 
	^aClass classVarNames! !

!RBBrowserEnvironment methodsFor: 'accessing' stamp: ''!
searchStrings: aCollection 
	searchStrings := aCollection! !

!RBBrowserEnvironment methodsFor: 'accessing' stamp: ''!
instanceVariablesFor: aClass 
	^aClass instVarNames! !

!RBBrowserEnvironment methodsFor: 'accessing' stamp: 'lr 2/8/2009 12:28'!
addSearchString: aString 
	searchStrings isNil ifTrue: [
		searchStrings := SortedCollection sortBlock: [ :a :b | 
			(a indexOf: $: ifAbsent: [ a size ]) > (b indexOf: $: ifAbsent: [ b size ]) ] ].
	(searchStrings includes: aString)
		ifFalse: [ searchStrings add: aString ]! !

!RBBrowserEnvironment methodsFor: 'environments' stamp: 'lr 9/8/2011 20:32'!
forClasses: classCollection 
	| classes |
	classes := OrderedCollection new: classCollection size * 2.
	classCollection do: 
			[:each | 
			classes add: each;
				add: each class].
	^RBClassEnvironment onEnvironment: self classes: classes! !

!RBBrowserEnvironment methodsFor: 'private' stamp: 'BenjaminVanRyseghem 3/27/2011 15:45'!
packageOrganizer

	^ RPackageOrganizer default! !

!RBBrowserEnvironment methodsFor: '*NautilusCommon' stamp: 'SebastianTleye 4/23/2013 13:14'!
packagesWithoutExtensions

	^ self packageOrganizer packagesWithoutExtensions! !

!RBBrowserEnvironment methodsFor: 'environments' stamp: 'lr 9/8/2011 20:32'!
instVarRefsTo: instVarName in: aClass 
	^RBVariableEnvironment 
		on: self
		referencesToInstanceVariable: instVarName
		in: aClass! !

!RBBrowserEnvironment methodsFor: 'environments' stamp: 'lr 9/8/2011 20:32'!
not
	self isSystem ifTrue: [^RBSelectorEnvironment new].
	^RBNotEnvironment onEnvironment: self! !

!RBBrowserEnvironment methodsFor: 'accessing' stamp: ''!
searchStrings
	^searchStrings isNil
		ifTrue: [#()]
		ifFalse: [searchStrings]! !

!RBBrowserEnvironment methodsFor: '*NautilusCommon' stamp: 'BenjaminVanRyseghem 5/13/2012 19:45'!
traits
	| traits |
	traits := IdentitySet new: 4096.
	self traitsDo: [ :each | traits add: each ].
	^ traits! !

!RBBrowserEnvironment methodsFor: '*Nautilus' stamp: 'BenjaminVanRyseghem 10/17/2013 16:01'!
browse

	^ Smalltalk tools browser openInEnvironment: self! !

!RBBrowserEnvironment methodsFor: '*GT-SpotterExtensions-Core-private' stamp: 'StefanReichhart 3/23/2015 13:12'!
withClassesFixedForNautilus! !

!RBBrowserEnvironment methodsFor: 'testing' stamp: 'CamilloBruni 7/7/2013 18:37'!
includesPackage: packageName
	^ true! !

!RBBrowserEnvironment methodsFor: 'environments' stamp: 'lr 9/8/2011 20:32'!
implementorsMatching: aString 
	^RBSelectorEnvironment implementorsMatching: aString in: self! !

!RBBrowserEnvironment methodsFor: 'accessing' stamp: ''!
numberClasses
	^self classNames size! !

!RBBrowserEnvironment methodsFor: 'accessing-classes' stamp: 'YuriyTymchuk 9/29/2014 20:07'!
allClassesAndTraits
	" compatibility method with SystemDictionary "
	
	| allClassesAndTraits |
	allClassesAndTraits := OrderedCollection new: 4096.
	self allClassesAndTraitsDo: [ :each | 
		allClassesAndTraits add: each ].
	^ allClassesAndTraits asArray! !

!RBBrowserEnvironment methodsFor: 'environments' stamp: 'lr 9/8/2011 20:26'!
& anEnvironment 
	"If we or anEnvironment includes everything, then just include the other environment (optimization)"

	self isSystem ifTrue: [^anEnvironment].
	anEnvironment isSystem ifTrue: [^self].
	^RBAndEnvironment onEnvironment: self and: anEnvironment! !

!RBBrowserEnvironment methodsFor: 'accessing-classes' stamp: 'lr 11/25/2009 08:31'!
classNames
	| names |
	names := IdentitySet new: 4096.
	self classesDo: [ :each | names add: each theNonMetaClass name ].
	^ names! !

!RBBrowserEnvironment methodsFor: 'accessing' stamp: 'CamilloBruni 8/17/2013 22:29'!
methodsDo: aBlock
	
	self classesDo: [ :aClass|
		self selectorsForClass: aClass do: [ :selector |
			aBlock value: (aClass >> selector) ]]! !

!RBBrowserEnvironment methodsFor: 'private' stamp: 'lr 3/20/2011 11:19'!
rootEnvironment
	"The root environment representing everything."

	^ self! !

!RBBrowserEnvironment methodsFor: 'initialize-release' stamp: ''!
label: aString
	label := aString! !

!RBBrowserEnvironment methodsFor: 'accessing-packages' stamp: 'CamilloBruni 7/7/2013 18:55'!
packageAt: aName
	^ self packageAt: aName ifAbsent: [ NotFound signalFor: aName in: self ]! !

!RBBrowserEnvironment methodsFor: 'testing' stamp: 'lr 3/18/2011 21:08'!
includesClass: aClass
	^ true! !

!RBBrowserEnvironment methodsFor: '*manifest-core' stamp: 'SimonAllier 3/30/2012 11:42'!
isMultiEnvironment
	^ false! !

!RBBrowserEnvironment methodsFor: 'accessing-classes' stamp: 'YuriyTymchuk 9/29/2014 20:11'!
allClasses
	"Answer all the unique non-metaclasses of all the classes and metaclasses in this environment."

	| allClasses |
	allClasses := OrderedCollection new: 4096.
	self allClassesDo: [ :each | 
		allClasses add: each ].
	^ allClasses asArray! !

!RBBrowserEnvironment methodsFor: 'testing' stamp: 'lr 3/18/2011 21:08'!
isEmpty
	^ false! !

!RBBrowserEnvironment methodsFor: 'accessing' stamp: 'CamilloBruni 8/17/2013 22:29'!
methods
	| methods |
	methods := IdentitySet new: 4096.
	self methodsDo: [ :each | methods add: each ].
	^ methods! !

!RBBrowserEnvironment methodsFor: 'environments' stamp: 'lr 9/8/2011 20:32'!
implementorsOf: aSelector 
	^RBSelectorEnvironment implementorsOf: aSelector in: self! !

!RBBrowserEnvironment methodsFor: 'accessing' stamp: 'CT 9/2/2014 12:41'!
whichProtocolIncludes: aSelector in: aClass
	^aClass organization categoryOfElement: aSelector ifAbsent: [ Protocol unclassified ]! !

!RBBrowserEnvironment methodsFor: 'environments' stamp: 'lr 9/8/2011 20:32'!
classVarRefsTo: instVarName in: aClass 
	^ RBVariableEnvironment 
		on: self
		referencesToClassVariable: instVarName
		in: aClass! !

!RBBrowserEnvironment methodsFor: 'testing' stamp: 'lr 3/18/2011 21:08'!
includesSelector: aSelector in: aClass
	^ true! !

!RBBrowserEnvironment methodsFor: '*NautilusCommon' stamp: 'CamilleTeruel 5/28/2014 15:07'!
traitsDo: aBlock

	self systemDictionary allTraitsDo: [ :each | 
		(self includesClass: each)
			ifTrue: [ aBlock value: each ]  ]! !

!RBBrowserEnvironment methodsFor: '*NautilusCommon' stamp: 'CamilloBruni 8/29/2013 15:53'!
asSystemNavigationEnvironment

	| env globalsNames |
	"Optimization for the default environment AKA Smalltalk"
	self class == RBBrowserEnvironment 
		ifTrue: [ ^ Smalltalk globals ].
	
	env := SystemDictionary new.
	
	self classesDo: [:each | 
		env add: ( Smalltalk globals associationAt: each theNonMetaClass name )].
	self traitsDo:  [:each | 
		env add: ( Smalltalk globals associationAt: each name )].
	globalsNames := Smalltalk globals keys asOrderedCollection.
	globalsNames removeAll: ( Smalltalk globals classNames ).
	 globalsNames removeAll: ( Smalltalk globals traitNames ).
	globalsNames do: [:each | 
		env add: ( Smalltalk globals associationAt: each )].

	^ env! !

!RBBrowserEnvironment methodsFor: 'accessing' stamp: ''!
selectorsFor: aProtocol in: aClass
	^(aClass organization listAtCategoryNamed: aProtocol)
		select: [:each | self includesSelector: each in: aClass]! !

!RBBrowserEnvironment methodsFor: 'testing' stamp: 'lr 3/18/2011 21:08'!
includesProtocol: aProtocol in: aClass
	^ true! !

!RBBrowserEnvironment methodsFor: 'testing' stamp: 'lr 1/3/2010 11:11'!
isClassEnvironment
	^ false! !

!RBBrowserEnvironment methodsFor: 'testing' stamp: 'lr 8/7/2009 13:00'!
isSelectorEnvironment
	^ false! !

!RBBrowserEnvironment methodsFor: 'environments' stamp: 'lr 9/8/2011 20:32'!
instVarWritersTo: instVarName in: aClass 
	^RBVariableEnvironment 
		on: self
		writersOfInstanceVariable: instVarName
		in: aClass! !

!RBBrowserEnvironment methodsFor: 'environments' stamp: 'lr 9/8/2011 20:32'!
matches: aString 
	^RBSelectorEnvironment matches: aString in: self! !

!RBBrowserEnvironment methodsFor: 'testing' stamp: 'lr 3/18/2011 21:08'!
isSystem
	^ true! !

!RBBrowserEnvironment methodsFor: 'accessing' stamp: ''!
selectorsForClass: aClass do: aBlock 
	aClass selectorsAndMethodsDo: 
			[:each :meth | 
			(self includesSelector: each in: aClass) ifTrue: [aBlock value: each]]! !

!RBBrowserEnvironment methodsFor: 'accessing' stamp: 'lr 8/9/2011 21:00'!
categories
	^ self systemDictionary organization categories select: [ :each | self includesCategory: each ]! !

!RBBrowserEnvironment methodsFor: 'accessing-classes' stamp: 'lr 2/26/2009 14:45'!
classesDo: aBlock 
	self allClassesDo: [ :each |
		(self includesClass: each)
			ifTrue: [ aBlock value: each ] ]! !

!RBBrowserEnvironment methodsFor: 'accessing' stamp: 'EstebanLorenzano 6/28/2013 11:28'!
protocolsFor: aClass
	^aClass organization realCategories select: [:each | self includesProtocol: each in: aClass]! !

!RBBrowserEnvironment methodsFor: 'private' stamp: 'YuriyTymchuk 9/29/2014 19:36'!
allClassesAndTraitsDo: aBlock
	self systemDictionary allClassesAndTraitsDo: aBlock! !

!RBBrowserEnvironment methodsFor: 'testing' stamp: 'lr 3/18/2011 21:08'!
includesCategory: aCategory
	^ true! !

!RBBrowserEnvironment methodsFor: 'accessing' stamp: 'lr 8/9/2011 21:00'!
whichCategoryIncludes: aClassName
	^ self systemDictionary organization categoryOfElement: aClassName! !

!RBBrowserEnvironment methodsFor: 'accessing-packages' stamp: 'CamilloBruni 7/7/2013 19:01'!
packages

	^ self packageOrganizer packages
		select: [ :package |
			self includesCategory: package name ]! !

!RBBrowserEnvironment methodsFor: 'private' stamp: 'lr 3/18/2011 21:07'!
environment
	^ self! !

!RBBrowserEnvironment methodsFor: 'environments' stamp: ''!
referencesTo: aLiteral in: aClass 
	| classes |
	classes := aClass withAllSuperclasses asSet.
	classes
		addAll: aClass allSubclasses;
		addAll: aClass class withAllSuperclasses;
		addAll: aClass class allSubclasses.
	^(self forClasses: classes) referencesTo: aLiteral! !

!RBBrowserEnvironment methodsFor: 'accessing' stamp: 'lr 9/4/2010 15:45'!
selectionParseTreeIntervalFor: aString 
	| parseTree answerBlock |
	parseTree := RBParser
		parseMethod: aString
		onError: [ :str :pos | ^ nil ].
	answerBlock := [ :aNode :answer | ^ aNode sourceInterval ].
	self searchStrings do: [ :each | 
		| matcher tree |
		matcher := RBParseTreeSearcher new.
		matcher matchesTree: (RBLiteralNode value: each) do: answerBlock.
		each isSymbol 
			ifTrue: [
				tree := RBParseTreeSearcher buildSelectorTree: each.
				tree notNil ifTrue: [ matcher matchesTree: tree do: answerBlock ] ]
			ifFalse: [
				tree := RBVariableNode named: each.
				matcher
					matchesTree: tree do: answerBlock;
					matchesArgumentTree: tree do: answerBlock ].
		matcher executeTree: parseTree ].
	^ nil! !

!RBBrowserEnvironment methodsFor: 'accessing-classes' stamp: 'lr 3/20/2011 11:18'!
associationAt: aKey ifAbsent: aBlock
	| association class |
	association := self systemDictionary
		associationAt: aKey
		ifAbsent: [ ^ aBlock value ].
	class := association value isBehavior
		ifTrue: [ association value ]
		ifFalse: [ association value class ].
	^ ((self includesClass: class) or: [ self includesClass: class class ])
		ifTrue: [ association ]
		ifFalse: [ nil ]! !

!RBBrowserEnvironment methodsFor: 'private' stamp: 'YuriyTymchuk 9/29/2014 20:08'!
allClassesDo: aBlock
	self systemDictionary allClassesDo: aBlock! !

!RBBrowserEnvironment methodsFor: 'accessing-classes' stamp: 'lr 2/26/2009 14:46'!
at: aKey
	^ self at: aKey ifAbsent: [ self error: aKey printString , ' not found' ]! !

!RBBrowserEnvironment methodsFor: 'accessing-classes' stamp: 'lr 1/23/2010 17:15'!
at: aKey ifAbsent: aBlock
	| association |
	association := self
		associationAt: aKey 
		ifAbsent: [ nil ].
	^ association isNil
		ifTrue: [ aBlock value ]
		ifFalse: [ association value ]! !

!RBBrowserEnvironment methodsFor: 'accessing' stamp: 'CamilloBruni 7/2/2013 23:18'!
numberSelectors
	| total |
	total := 0.
	self selectorsDo: [:sel | total := total + 1 ].
	^total! !

!RBBrowserEnvironment methodsFor: 'printing' stamp: ''!
printOn: aStream
	aStream nextPutAll: self label! !

!RBBrowserEnvironment methodsFor: 'environments' stamp: 'lr 9/8/2011 20:32'!
referencesTo: aLiteral 
	^RBSelectorEnvironment referencesTo: aLiteral in: self! !

!RBBrowserEnvironment methodsFor: 'environments' stamp: 'lr 9/8/2011 20:32'!
forClass: aClass selectors: selectorCollection 
	^(RBSelectorEnvironment 
		onMethods: selectorCollection
		forClass: aClass
		in: self)
		label: aClass name , '>>' 
					, (selectorCollection detect: [:each | true] ifNone: ['']);
		yourself! !

!RBBrowserEnvironment methodsFor: 'environments' stamp: 'lr 9/8/2011 20:32'!
selectMethods: aBlock 
	| env |
	env := RBSelectorEnvironment onEnvironment: self.
	self classesAndSelectorsDo: 
			[:each :sel | 
			(aBlock value: (each compiledMethodAt: sel)) 
				ifTrue: [env addClass: each selector: sel]].
	^env! !

!RBBrowserEnvironment methodsFor: 'accessing' stamp: 'lr 2/26/2009 14:29'!
selectorsForClass: aClass 
	| selectors |
	selectors := IdentitySet new.
	self selectorsForClass: aClass do: [ :each | selectors add: each ].
	^ selectors! !

!RBBrowserEnvironment methodsFor: 'environments' stamp: 'lr 9/8/2011 20:32'!
forClass: aClass protocols: protocolCollection 
	^RBProtocolEnvironment onEnvironment: self
		class: aClass
		protocols: protocolCollection! !

!RBBrowserEnvironment methodsFor: 'accessing-classes' stamp: 'SebastianTleye 4/22/2013 13:59'!
classesAndTraitsDo: aBlock 
	self allClassesAndTraitsDo: [ :each |
		(self includesClass: each)
			ifTrue: [ aBlock value: each ] ]! !

!RBBrowserEnvironment methodsFor: 'environments' stamp: 'lr 9/8/2011 20:31'!
forCategories: categoryList 
	^RBCategoryEnvironment onEnvironment: self categories: categoryList! !

!RBBrowserEnvironment methodsFor: 'environments' stamp: 'lr 9/8/2011 20:32'!
| anEnvironment 
	"If we or anEnvironment includes everything, then return it instead of creating 
	an or that will include everything."

	self isSystem ifTrue: [^self].
	anEnvironment isSystem ifTrue: [^anEnvironment].
	^ RBOrEnvironment onEnvironment: self or: anEnvironment! !

!RBBrowserEnvironment methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'!
asSelectorEnvironment
	^(RBClassEnvironment onEnvironment: self classes: self classes) asSelectorEnvironment! !

!RBBrowserEnvironment methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream
		nextPutAll: self class name;
		nextPutAll: ' new'! !

!RBBrowserEnvironment methodsFor: 'testing' stamp: 'CamilloBruni 8/17/2013 22:15'!
includesMethod: aMethod
	^ self 
		includesSelector: aMethod selector
		in: aMethod methodClass! !

!RBBrowserEnvironment methodsFor: 'accessing' stamp: 'lr 8/9/2011 21:00'!
classNamesFor: aCategoryName
	^ (self systemDictionary organization listAtCategoryNamed: aCategoryName) select: [ :each |
		| class |
		class := self systemDictionary at: each ifAbsent: [ nil ].
		class notNil 
			and: [ (self includesClass: class)
			or: [ self includesClass: class class ] ] ]! !

!RBBrowserEnvironment methodsFor: 'copying' stamp: 'lr 2/26/2009 14:23'!
copyEmpty
	^ self class new! !

!RBBrowserEnvironment methodsFor: 'accessing-classes' stamp: 'lr 3/20/2011 11:18'!
keys
	| keys |
	keys := Set new.
	self systemDictionary keysAndValuesDo: [ :key :value | 
		| class |
		value isBehavior ifTrue: [
			(self includesClass: value) 
				ifTrue: [ keys add: key ] ].
			class := value class.
			(self includesClass: class) 
				ifTrue: [ keys add: key ] ].
	^ keys! !

!RBBrowserEnvironment methodsFor: 'accessing-packages' stamp: 'CamilloBruni 7/7/2013 18:57'!
packageAt: aName ifAbsent: absentBlock
	| package |
	package := self packageOrganizer 
		packageNamed: aName ifAbsent: absentBlock.
	
	^ (self includesCategory: aName)
		ifTrue: [ package ]
		ifFalse: absentBlock! !

!RBBrowserEnvironment methodsFor: 'accessing-classes' stamp: 'YuriyTymchuk 9/29/2014 20:12'!
allMetaClasses
	"Answer all the unique non-metaclasses of all metaclasses in this environment."

	| allMetaClasses |
	allMetaClasses := OrderedCollection new: 4096.
	self allClassesDo: [ :each | 
		allMetaClasses add: each theMetaClass ].
	^ allMetaClasses asArray! !

!RBBrowserEnvironment methodsFor: 'accessing-classes' stamp: 'lr 2/26/2009 14:45'!
classes
	| classes |
	classes := IdentitySet new: 4096.
	self classesDo: [ :each | classes add: each ].
	^ classes! !

!RBBrowserEnvironment methodsFor: 'testing' stamp: 'lr 11/25/2009 08:37'!
definesClass: aClass
	^ true! !

!RBBrowserEnvironment methodsFor: 'accessing' stamp: 'CamilloBruni 8/17/2013 22:32'!
classesAndSelectorsDo: aBlock 
	self classesDo: [ :class | 
		self selectorsForClass: class do: [ :sel | 
			aBlock value: class value: sel ]]! !

!RBBrowserEnvironment methodsFor: 'accessing-classes' stamp: 'YuriyTymchuk 9/29/2014 20:16'!
classesAndTraits
	
	| classesAndTraits |
	classesAndTraits := OrderedCollection new: 4096.
	self classesAndTraitsDo: [ :each | 
		classesAndTraits add: each ].
	^ classesAndTraits asArray! !

!RBBrowserEnvironment methodsFor: 'accessing' stamp: ''!
problemCount
	^self numberSelectors! !

!RBBrowserEnvironment methodsFor: 'private' stamp: 'lr 3/18/2011 21:07'!
label
	^ label isNil
		ifTrue: [ self defaultLabel ]
		ifFalse: [ label ]! !

!RBBrowserEnvironment methodsFor: 'private' stamp: 'lr 3/18/2011 21:07'!
defaultLabel
	^ 'Smalltalk'! !

!RBBrowserEnvironment methodsFor: 'environments' stamp: 'lr 9/8/2011 20:32'!
forPackages: aCollection
	^ RBPackageEnvironment onEnvironment: self packages: aCollection! !

!RBBrowserEnvironment methodsFor: 'accessing' stamp: 'bh 5/8/2000 21:02'!
selectionIntervalFor: aString 
	| interval |
	self searchStrings isEmpty ifTrue: [^nil].
	interval := self selectionParseTreeIntervalFor: aString.
	interval notNil ifTrue: [^interval].
	self searchStrings do: 
			[:each | 
			| search index |
			search := each isSymbol ifTrue: [each keywords first] ifFalse: [each].
			index := aString indexOfSubCollection: search startingAt: 1.
			index > 0 ifTrue: [^index to: index + search size - 1]].
	^nil! !

!RBBrowserEnvironment methodsFor: 'environments' stamp: 'lr 9/8/2011 20:32'!
forPackageNames: aCollection
	^ RBPackageEnvironment onEnvironment: self packageNames: aCollection! !

!RBBrowserEnvironment methodsFor: 'accessing' stamp: 'CamilloBruni 7/2/2013 23:18'!
selectors
	^ Array streamContents: [ :stream |
		self selectorsDo: [ :selector | 
			stream nextPut: selector ]]! !

!RBBrowserEnvironment methodsFor: 'accessing-classes' stamp: 'lr 1/23/2010 17:10'!
associationAt: aKey
	^ self associationAt: aKey ifAbsent: [ self error: aKey printString , ' not found' ]! !

!RBBrowserEnvironment methodsFor: 'environments' stamp: 'lr 9/8/2011 20:32'!
forPragmas: aKeywordCollection
	^ RBPragmaEnvironment onEnvironment: self keywords: aKeywordCollection! !

!RBBrowserEnvironment methodsFor: 'accessing' stamp: 'CamilloBruni 7/2/2013 23:17'!
selectorsDo: aBlock
	self allClassesDo: [ :each | 
		self selectorsForClass: each do: aBlock ].! !

!RBBrowserEnvironment methodsFor: 'testing' stamp: 'lr 1/3/2010 11:11'!
isVariableEnvironment
	^ false! !

!RBBrowserEnvironment methodsFor: 'environments' stamp: 'lr 9/8/2011 20:32'!
instVarReadersTo: instVarName in: aClass 
	^RBVariableEnvironment 
		on: self
		readersOfInstanceVariable: instVarName
		in: aClass! !

!RBBrowserEnvironment class methodsFor: 'accessing' stamp: 'CamilloBruni 7/2/2013 23:23'!
default
	^ RBBrowserEnvironment new! !

!RBBrowserEnvironmentTest methodsFor: 'testing-environments' stamp: 'lr 9/8/2011 20:26'!
testEnvironmentWrapper
	| printString wrapper |
	printString := RBBrowserEnvironment new referencesTo: #printString.
	wrapper := RBBrowserEnvironmentWrapper onEnvironment: printString.
	self assert: wrapper numberSelectors = printString numberSelectors.
	self assert: wrapper numberClasses = printString numberClasses.
	self assert: wrapper environment == printString! !

!RBBrowserEnvironmentTest methodsFor: 'testing-environments' stamp: 'lr 9/8/2011 20:32'!
testProtocolEnvironment
	| aProtocolEnvironment size |
	aProtocolEnvironment := RBProtocolEnvironment 
				onEnvironment: RBBrowserEnvironment new
				class: Object
				protocols: #(#printing #testing).
	self universalTestFor: aProtocolEnvironment.
	self 
		assert: (aProtocolEnvironment implementorsOf: #printString) numberSelectors 
				= 1.
	size := 0.
	aProtocolEnvironment classesDo: [:each | size := size + 1].
	self assert: size = 1.
	aProtocolEnvironment selectorsForClass: Object
		do: 
			[:each | 
			self assert: (#(#printing #testing) 
						includes: (RBBrowserEnvironment new whichProtocolIncludes: each in: Object))]! !

!RBBrowserEnvironmentTest methodsFor: 'private' stamp: 'lr 9/5/2010 10:11'!
protocolsFor: aBrowserEnvironment 
	aBrowserEnvironment classesAndSelectorsDo: [ :class :selector |
		| protocol |
		protocol := aBrowserEnvironment whichProtocolIncludes: selector in: class.
		self assert: (aBrowserEnvironment includesProtocol: protocol in: class) ]! !

!RBBrowserEnvironmentTest methodsFor: 'testing-environments' stamp: 'lr 9/8/2011 20:25'!
testBrowserEnvironment
	self universalTestFor: RBBrowserEnvironment new! !

!RBBrowserEnvironmentTest methodsFor: 'testing' stamp: 'lr 9/8/2011 20:25'!
testImplementorsMatching
	| print |
	print := RBBrowserEnvironment new implementorsMatching: '*print*'.
	self universalTestFor: print.
	self assert: (print implementorsOf: #printString) numberSelectors 
				= (RBBrowserEnvironment new implementorsOf: #printString) numberSelectors.
	print 
		classesAndSelectorsDo: [:class :sel | self assert: ('*print*' match: sel)]! !

!RBBrowserEnvironmentTest methodsFor: 'testing' stamp: 'lr 9/8/2011 20:32'!
testConstructedClassEnvironment
	| environment |
	environment := RBClassEnvironment new.
	environment
		addClass: Object;
		addClass: OrderedCollection;
		addClass: Collection.
	self assert: (environment includesClass: Object).
	self assert: (environment includesClass: OrderedCollection).
	self assert: (environment includesClass: Collection).
	self deny: (environment includesClass: Object class).
	environment removeClass: Collection.
	self assert: (environment includesClass: Object).
	self assert: (environment includesClass: OrderedCollection).
	self deny: (environment includesClass: Collection).
	self assert: environment numberClasses = 2.
	environment addClass: Object class.
	self assert: environment numberClasses = 2.
	self assert: (environment includesClass: Object class).
	environment removeClass: self class.
	self assert: environment numberClasses = 2! !

!RBBrowserEnvironmentTest methodsFor: 'testing-environments' stamp: 'CamilloBruni 8/27/2013 01:47'!
testPackageEnvironment
	| aPackageEnvironment |
	aPackageEnvironment := universalEnvironment
		forPackageNames: (Array with: 'Refactoring-Tests-Environment' with: 'Refactoring-Tests-Critics').
	self universalTestFor: aPackageEnvironment.
	self assert: (aPackageEnvironment implementorsOf: #testPackageEnvironment) numberSelectors equals: 1! !

!RBBrowserEnvironmentTest methodsFor: 'private' stamp: 'lr 9/5/2010 10:07'!
universalTestFor: aBrowserEnvironment 
	self labelFor: aBrowserEnvironment.
	self uniqueClassesIn: aBrowserEnvironment.
	self numberSelectorsFor: aBrowserEnvironment.
	self storeStringFor: aBrowserEnvironment.
	self classNamesFor: aBrowserEnvironment.
	self copyFor: aBrowserEnvironment.
	self categoriesFor: aBrowserEnvironment.
	self protocolsFor: aBrowserEnvironment.
	self classesFor: aBrowserEnvironment.
	self keysFor: aBrowserEnvironment.
	self assert: aBrowserEnvironment problemCount = 0 = aBrowserEnvironment isEmpty! !

!RBBrowserEnvironmentTest methodsFor: 'private' stamp: 'lr 9/8/2011 20:25'!
classesFor: aBrowserEnvironment 
	| allClasses |
	allClasses := aBrowserEnvironment classes asSet.
	allClasses addAll: aBrowserEnvironment not classes.
	RBBrowserEnvironment new allClassesDo: [:each | allClasses remove: each].
	self assert: allClasses isEmpty! !

!RBBrowserEnvironmentTest methodsFor: 'testing' stamp: 'lr 12/29/2011 17:30'!
testVariableEnvironmentInstVars
	| refs writers readers classRefs |
	refs := RBVariableEnvironment
		referencesToInstanceVariable: 'universalEnvironment'
		in: self class.
	writers := RBVariableEnvironment
		writersOfInstanceVariable: 'universalEnvironment'
		in: self class.
	readers := RBVariableEnvironment
		readersOfInstanceVariable: 'universalEnvironment'
		in: self class.
	classRefs := RBVariableEnvironment
		referencesToClassVariable: 'ClassVariable'
		in: self class.
	self universalTestFor: refs.
	self universalTestFor: writers.
	self universalTestFor: readers.
	self universalTestFor: classRefs.
	self deny: universalEnvironment isVariableEnvironment.
	self assert: refs isVariableEnvironment.
	self assert: refs numberSelectors = (writers | readers) numberSelectors! !

!RBBrowserEnvironmentTest methodsFor: 'testing' stamp: 'lr 9/8/2011 20:25'!
testMatches
	| envEnvironment environmentEnvironment |
	envEnvironment := RBBrowserEnvironment new matches: '*env*'.
	environmentEnvironment := RBBrowserEnvironment new 
				referencesTo: #environment.
	self assert: (envEnvironment referencesTo: #environment) numberSelectors 
				= environmentEnvironment numberSelectors! !

!RBBrowserEnvironmentTest methodsFor: 'mockup' stamp: 'lr 9/5/2010 09:55'!
classVariableReader
	^ ClassVariable! !

!RBBrowserEnvironmentTest methodsFor: 'testing' stamp: 'lr 9/8/2011 20:25'!
testSelectMethods
	| environment |
	environment := RBBrowserEnvironment new selectMethods: [:each | false].
	self assert: environment numberSelectors = 0.
	self assert: environment numberClasses = 0.
	environment := RBBrowserEnvironment new selectMethods: [:each | true].
	self assert: environment numberSelectors 
				= RBBrowserEnvironment new numberSelectors.
	environment := RBBrowserEnvironment new 
				selectMethods: [:each | each refersToLiteral: #environment].
	self assert: environment numberSelectors 
				= (RBBrowserEnvironment new referencesTo: #environment) numberSelectors! !

!RBBrowserEnvironmentTest methodsFor: 'private' stamp: 'MarcusDenker 4/25/2013 15:10'!
storeStringFor: aBrowserEnvironment
	| newEnvironment |
	newEnvironment := Smalltalk evaluate: aBrowserEnvironment storeString.
	self assert: newEnvironment numberSelectors = aBrowserEnvironment numberSelectors.
	self assert: (newEnvironment not & aBrowserEnvironment) numberSelectors = 0
	! !

!RBBrowserEnvironmentTest methodsFor: 'testing' stamp: 'lr 9/8/2011 20:25'!
testSystemIntegrity
	| classes environment |
	classes := IdentitySet new.
	environment := RBBrowserEnvironment new.
	environment allClassesDo: [ :class |
		(classes includes: class)
			ifFalse: [ classes add: class ]
			ifTrue: [ self error: 'The class ' , class name , ' that is available under two or more names. This causes problems with the refactoring browser.' ] ]! !

!RBBrowserEnvironmentTest methodsFor: 'private' stamp: 'lr 9/4/2010 17:33'!
keysFor: aBrowserEnvironment 
	| allKeys |
	allKeys := IdentitySet withAll: aBrowserEnvironment keys.
	allKeys addAll: aBrowserEnvironment not keys.
	allKeys removeAll: Smalltalk keys.
	self assert: allKeys isEmpty! !

!RBBrowserEnvironmentTest methodsFor: 'testing-environments' stamp: 'StephaneDucasse 8/29/2013 20:52'!
testOrEnvironment
	| env1 env2 orEnvironment |
	env2 := #printOn:.
	env2 := universalEnvironment forClass: Object selectors: #(#fullPrintString).
	env1 := universalEnvironment forClass: Object selectors: #(#printOn:).
	self assert: (env1 | env2) numberSelectors = 2.
	self assert: (env2 | env1) numberSelectors = 2.
	self universalTestFor: env1 | env2.
	self assert: (env1 | env1) numberSelectors = 1.
	orEnvironment := env1 | env1 not.
	self universalTestFor: orEnvironment.
	self assert: orEnvironment numberSelectors 
				= universalEnvironment numberSelectors.
	self assert: orEnvironment classNames asSortedCollection 
				= universalEnvironment classNames asSortedCollection.
	self assert: (orEnvironment protocolsFor: Object) 
				= ((universalEnvironment protocolsFor: Object) reject: [:each| (Object allSelectorsInProtocol: each) isEmpty ])
! !

!RBBrowserEnvironmentTest methodsFor: 'private' stamp: 'lr 9/4/2010 17:33'!
copyFor: aBrowserEnvironment 
	| newEnvironment |
	newEnvironment := aBrowserEnvironment copy.
	self assert: newEnvironment numberSelectors = aBrowserEnvironment numberSelectors.
	self assert: (newEnvironment not & aBrowserEnvironment) numberSelectors = 0! !

!RBBrowserEnvironmentTest methodsFor: 'testing' stamp: 'lr 9/8/2011 20:32'!
testConstructedSelectorEnvironment
	| environment newEnvironment |
	environment := RBSelectorEnvironment new.
	environment
		addClass: Object selector: #printString;
		addClass: OrderedCollection selector: #add:;
		addClass: Collection.
	self assert: (environment includesClass: Object).
	self assert: (environment selectorsForClass: Object) size = 1.
	self assert: (environment includesClass: OrderedCollection).
	self assert: (environment selectorsForClass: OrderedCollection) size = 1.
	self assert: (environment includesClass: Collection).
	self assert: (environment selectorsForClass: Collection) size 
				= Collection selectors size.
	self deny: (environment includesClass: Object class).
	newEnvironment := environment copy.
	newEnvironment
		removeClass: OrderedCollection;
		addClass: Object selector: #printOn:;
		removeClass: Object selector: #printString.
	self assert: (newEnvironment includesClass: Object).
	self deny: (newEnvironment includesSelector: #printString in: Object).
	self deny: (newEnvironment includesClass: OrderedCollection).
	self assert: (newEnvironment includesClass: Collection).
	self assert: newEnvironment numberClasses = 2.
	self 
		assert: newEnvironment numberSelectors + 1 = environment numberSelectors.
	newEnvironment addClass: Object class.
	self assert: newEnvironment numberClasses = 2.
	self assert: (newEnvironment includesClass: Object class).
	newEnvironment removeClass: self class.
	self assert: newEnvironment numberClasses = 2! !

!RBBrowserEnvironmentTest methodsFor: 'testing-environments' stamp: 'lr 9/5/2010 09:42'!
testPragmaEnvironment
	| aPragmaEnvironment |
	aPragmaEnvironment := universalEnvironment forPragmas: #(primitive:).
	self universalTestFor: aPragmaEnvironment! !

!RBBrowserEnvironmentTest methodsFor: 'private' stamp: 'lr 9/4/2010 17:33'!
categoriesFor: anEnvironment 
	| allCategories |
	allCategories := IdentitySet withAll: universalEnvironment categories.
	allCategories removeAll: anEnvironment categories.
	anEnvironment not categories 
		do: [ :each | allCategories remove: each ifAbsent: [ ] ].
	allCategories 
		do: [ :each | self assert: (universalEnvironment classNamesFor: each) isEmpty ]! !

!RBBrowserEnvironmentTest methodsFor: 'private' stamp: 'lr 9/4/2010 17:33'!
numberSelectorsFor: aBrowserEnvironment
	| numberSelectors numberSelectorsNot |
	numberSelectors := aBrowserEnvironment numberSelectors.
	numberSelectorsNot := aBrowserEnvironment not numberSelectors.
	self assert: numberSelectors + numberSelectorsNot = universalEnvironment numberSelectors.
	self assert: (aBrowserEnvironment & aBrowserEnvironment not) numberSelectors = 0.
	self assert: (universalEnvironment & aBrowserEnvironment) numberSelectors = numberSelectors.
	self assert: (aBrowserEnvironment & universalEnvironment) numberSelectors = numberSelectors! !

!RBBrowserEnvironmentTest methodsFor: 'private' stamp: 'lr 9/4/2010 17:33'!
classNamesFor: anEnvironment 
	| classNames allClassNames |
	classNames := IdentitySet new
		addAll: anEnvironment classNames asSet;
		addAll: anEnvironment not classNames;
		yourself.
	allClassNames := universalEnvironment classNames asSortedCollection.
	self assert: classNames asSortedCollection 	= allClassNames.
	self assert: (anEnvironment & anEnvironment not) classNames isEmpty.
	self assert: (anEnvironment | anEnvironment not) classNames asSortedCollection = allClassNames! !

!RBBrowserEnvironmentTest methodsFor: 'testing-environments' stamp: 'lr 9/5/2010 09:19'!
testAndEnvironment
	| originalEnvironment objectPrintStringEnvironment andEnvironment |
	originalEnvironment := universalEnvironment referencesTo: #printOn:.
	objectPrintStringEnvironment := universalEnvironment forClass: Object
				selectors: #(#fullPrintString).
	andEnvironment := objectPrintStringEnvironment & originalEnvironment.
	self universalTestFor: andEnvironment.
	self assert: andEnvironment numberSelectors = 1.
	self assert: andEnvironment classNames asArray = #(#Object).
	self assert: (andEnvironment protocolsFor: Object) size = 1.
	andEnvironment := originalEnvironment 
				& (universalEnvironment referencesTo: #printString).
	self assert: andEnvironment numberSelectors 
				= (originalEnvironment referencesTo: #printString) numberSelectors.
	self assert: andEnvironment classNames asSortedCollection 
				= (originalEnvironment referencesTo: #printString) classNames 
						asSortedCollection! !

!RBBrowserEnvironmentTest methodsFor: 'testing-environments' stamp: 'CamilloBruni 8/27/2013 01:55'!
testCategoryEnvironment
	| aCategoryEnvironment |
	self skip: 'Use RBPackageEnvironment instead.'.
	aCategoryEnvironment := RBCategoryEnvironment 
				onEnvironment: RBBrowserEnvironment new
				categories: #(#'Kernel-Objects').
	self universalTestFor: aCategoryEnvironment.
	self assert: (aCategoryEnvironment implementorsOf: #printString) numberSelectors equals: 1! !

!RBBrowserEnvironmentTest methodsFor: 'private' stamp: 'lr 9/4/2010 17:33'!
uniqueClassesIn: aBrowserEnvironment 
	| allClasses |
	allClasses := IdentitySet new.
	aBrowserEnvironment classesDo: [ :each | 
		self deny: (allClasses includes: each).
		allClasses add: each ]! !

!RBBrowserEnvironmentTest methodsFor: 'running' stamp: 'lr 9/8/2011 20:25'!
setUp
	super setUp.
	universalEnvironment := RBBrowserEnvironment new! !

!RBBrowserEnvironmentTest methodsFor: 'testing-environments' stamp: 'lr 9/5/2010 09:32'!
testNotEnvironment
	| notPrintStringEnvironment printStringEnvironment |
	printStringEnvironment := universalEnvironment referencesTo: #printString.
	notPrintStringEnvironment := printStringEnvironment not.
	self universalTestFor: notPrintStringEnvironment.
	self assert: (notPrintStringEnvironment referencesTo: #printString) isEmpty.
	self assert: (notPrintStringEnvironment not includesClass: RBBrowserEnvironmentTest).
	self assert: (notPrintStringEnvironment not 
			includesSelector: #testNotEnvironment
			in: RBBrowserEnvironmentTest)! !

!RBBrowserEnvironmentTest methodsFor: 'mockup' stamp: 'lr 9/5/2010 09:55'!
classVariableWriter
	ClassVariable := nil! !

!RBBrowserEnvironmentTest methodsFor: 'private' stamp: 'lr 9/5/2010 10:01'!
labelFor: aBrowserEnvironment 
	self deny: aBrowserEnvironment label isNil.
	self deny: aBrowserEnvironment label isEmpty.
	self deny: aBrowserEnvironment defaultLabel isNil.
	self deny: aBrowserEnvironment defaultLabel isEmpty! !

!RBBrowserEnvironmentTest methodsFor: 'testing' stamp: 'lr 9/8/2011 20:32'!
testRemoveSelectorByAndAndNot
	| aBrowserEnvironment objectPrintString |
	aBrowserEnvironment := RBBrowserEnvironment new.
	objectPrintString := RBSelectorEnvironment 
				onEnvironment: aBrowserEnvironment.
	objectPrintString addClass: Object selector: #printString.
	self assert: aBrowserEnvironment numberSelectors - 1 
				= (aBrowserEnvironment & objectPrintString not) numberSelectors.
	self universalTestFor: aBrowserEnvironment & objectPrintString not! !

!RBBrowserEnvironmentTest methodsFor: 'testing-environments' stamp: 'lr 9/8/2011 20:25'!
testSelectorEnvironment
	| printString |
	printString := RBBrowserEnvironment new referencesTo: #printString.
	self universalTestFor: printString.
	self deny: universalEnvironment isSelectorEnvironment.
	self assert: printString isSelectorEnvironment.
	self assert: printString numberSelectors = (printString referencesTo: #printString) numberSelectors.
	self assert: printString numberClasses = (printString referencesTo: #printString) numberClasses! !

!RBBrowserEnvironmentTest methodsFor: 'testing-environments' stamp: 'lr 9/8/2011 20:32'!
testClassEnvironment
	| aClassEnvironment |
	aClassEnvironment := RBClassEnvironment 
		onEnvironment: universalEnvironment 
		classes: (Array with: Object with: Object class).
	self universalTestFor: aClassEnvironment.
	self deny: (universalEnvironment isClassEnvironment).
	self assert: (aClassEnvironment isClassEnvironment).
	self assert: (aClassEnvironment implementorsOf: #printString) numberSelectors = 1! !

!RBBrowserEnvironmentTest methodsFor: 'testing' stamp: 'lr 9/8/2011 20:32'!
testVariableEnvironmentAddRemove
	| refs |
	refs := RBVariableEnvironment new.
	refs addClass: self class instanceVariable: 'universalEnvironment'.
	self assert: refs numberSelectors > 0.
	self assert: refs numberClasses = 1.
	refs removeClass: self class instanceVariable: 'universalEnvironment'.
	self assert: refs numberSelectors = 0.
	self assert: refs numberClasses = 0.
	refs addClass: self class instanceVariableReader: 'universalEnvironment'.
	self assert: refs numberSelectors > 0.
	self assert: refs numberClasses = 1.
	refs removeClass: self class instanceVariableReader: 'universalEnvironment'.
	self assert: refs numberSelectors = 0.
	self assert: refs numberClasses = 0.
	refs addClass: self class instanceVariableWriter: 'universalEnvironment'.
	self assert: refs numberSelectors > 0.
	self assert: refs numberClasses = 1.
	refs removeClass: self class instanceVariableWriter: 'universalEnvironment'.
	self assert: refs numberSelectors = 0.
	self assert: refs numberClasses = 0.
	refs addClass: self class classVariable: 'ClassVariable'.
	self assert: refs numberSelectors > 0.
	self assert: refs numberClasses = 1.
	refs removeClass: self class classVariable: 'ClassVariable'.
	self assert: refs numberSelectors = 0.
	self assert: refs numberClasses = 0
	! !

!RBBrowserEnvironmentTest class methodsFor: 'as yet unclassified' stamp: 'lr 9/5/2010 09:37'!
packageNamesUnderTest
	^ #('Refactoring-Environment')! !

!RBBrowserEnvironmentWrapper methodsFor: 'testing' stamp: ''!
includesClass: aClass
	^environment includesClass: aClass! !

!RBBrowserEnvironmentWrapper methodsFor: 'private' stamp: 'lr 3/20/2011 11:18'!
systemDictionary
	^ environment systemDictionary! !

!RBBrowserEnvironmentWrapper methodsFor: '*NautilusCommon' stamp: 'SebastianTleye 4/23/2013 18:05'!
packagesWithoutExtensions

	^ (self classes gather: [:each | each packagesWithoutExtensions]) asSet! !

!RBBrowserEnvironmentWrapper methodsFor: 'testing' stamp: ''!
isEmpty
	self classesDo: [:each | ^false].
	^true! !

!RBBrowserEnvironmentWrapper methodsFor: 'initialize-release' stamp: ''!
onEnvironment: anEnvironment
	environment := anEnvironment! !

!RBBrowserEnvironmentWrapper methodsFor: 'testing' stamp: ''!
includesCategory: aCategory
	^environment includesCategory: aCategory! !

!RBBrowserEnvironmentWrapper methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream
		nextPutAll: '(';
		nextPutAll: self class name;
		nextPutAll: ' onEnvironment: '.
	environment storeOn: aStream.
	aStream nextPut: $)! !

!RBBrowserEnvironmentWrapper methodsFor: 'testing' stamp: ''!
includesSelector: aSelector in: aClass
	^(self includesClass: aClass)
		and: [environment includesSelector: aSelector in: aClass]! !

!RBBrowserEnvironmentWrapper methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/10/2012 20:30'!
packages

	^ (self classes gather: [:each | each packages]) asSet! !

!RBBrowserEnvironmentWrapper methodsFor: 'testing' stamp: 'lr 11/25/2009 08:38'!
definesClass: aClass
	^ environment definesClass: aClass! !

!RBBrowserEnvironmentWrapper methodsFor: 'private' stamp: 'lr 3/18/2011 21:07'!
environment
	^ environment! !

!RBBrowserEnvironmentWrapper methodsFor: 'testing' stamp: ''!
includesProtocol: aProtocol in: aClass
	^(self includesClass: aClass)
		and: [environment includesProtocol: aProtocol in: aClass]! !

!RBBrowserEnvironmentWrapper methodsFor: 'accessing' stamp: 'bh 5/8/2000 21:03'!
selectionIntervalFor: aString 
	| interval |
	interval := super selectionIntervalFor: aString.
	^interval notNil 
		ifTrue: [interval]
		ifFalse: [environment selectionIntervalFor: aString]! !

!RBBrowserEnvironmentWrapper methodsFor: 'testing' stamp: ''!
isSystem
	^false! !

!RBBrowserEnvironmentWrapper methodsFor: 'private' stamp: 'lr 3/20/2011 11:17'!
rootEnvironment
	^ environment rootEnvironment! !

!RBBrowserEnvironmentWrapper class methodsFor: 'instance creation' stamp: ''!
onEnvironment: anEnvironment 
	^(self basicNew)
		initialize;
		onEnvironment: anEnvironment;
		yourself! !

!RBBrowserEnvironmentWrapper class methodsFor: 'instance creation' stamp: 'lr 9/8/2011 20:25'!
new
	^ self onEnvironment: RBBrowserEnvironment new! !

!RBCascadeNode commentStamp: '<historical>'!
RBCascadeNode is an AST node for cascaded messages (e.g., "self print1 ; print2").

Instance Variables:
	messages	<SequenceableCollection of: RBMessageNode>	the messages 
	semicolons	<SequenceableCollection of: Integer>	positions of the ; between messages

!
!RBCascadeNode methodsFor: 'testing' stamp: ''!
directlyUses: aNode 
	^messages last = aNode and: [self isDirectlyUsed]! !

!RBCascadeNode methodsFor: 'accessing' stamp: ''!
stopWithoutParentheses
	^messages last stop! !

!RBCascadeNode methodsFor: 'querying' stamp: ''!
bestNodeFor: anInterval 
	| selectedChildren |
	(self intersectsInterval: anInterval) ifFalse: [^nil].
	(self containedBy: anInterval) ifTrue: [^self].
	messages 
		reverseDo: [:each | (each containedBy: anInterval) ifTrue: [^each]].
	selectedChildren := (messages 
				collect: [:each | each bestNodeFor: anInterval]) 
					reject: [:each | each isNil].
	^selectedChildren detect: [:each | true] ifNone: [nil]! !

!RBCascadeNode methodsFor: 'accessing' stamp: ''!
children
	^self messages! !

!RBCascadeNode methodsFor: 'testing' stamp: 'GiselaDecuzzi 6/5/2013 10:29'!
isFaulty
	^self messages anySatisfy: #isFaulty! !

!RBCascadeNode methodsFor: 'accessing' stamp: ''!
messages
	^messages! !

!RBCascadeNode methodsFor: 'initialize-release' stamp: ''!
messages: messageNodes semicolons: integerCollection 
	self messages: messageNodes.
	semicolons := integerCollection! !

!RBCascadeNode methodsFor: 'accessing-token' stamp: 'lr 2/12/2010 19:26'!
semicolons: anArray
	semicolons := anArray! !

!RBCascadeNode methodsFor: 'accessing' stamp: ''!
messages: messageNodeCollection 
	messages := messageNodeCollection.
	messages do: [:each | each parent: self]! !

!RBCascadeNode methodsFor: 'comparing' stamp: 'lr 3/7/2010 13:49'!
hash
	^ self hashForCollection: self messages! !

!RBCascadeNode methodsFor: 'matching' stamp: 'lr 11/24/2009 23:36'!
copyInContext: aDictionary 
	^ self class new
		messages: (self copyList: self messages inContext: aDictionary);
		yourself! !

!RBCascadeNode methodsFor: 'querying' stamp: ''!
whichNodeIsContainedBy: anInterval 
	| selectedChildren |
	(self intersectsInterval: anInterval) ifFalse: [^nil].
	(self containedBy: anInterval) ifTrue: [^self].
	messages 
		reverseDo: [:each | (each containedBy: anInterval) ifTrue: [^each]].
	selectedChildren := (messages 
				collect: [:each | each whichNodeIsContainedBy: anInterval]) 
					reject: [:each | each isNil].
	^selectedChildren detect: [:each | true] ifNone: [nil]! !

!RBCascadeNode methodsFor: 'accessing' stamp: ''!
precedence
	^4! !

!RBCascadeNode methodsFor: 'accessing' stamp: ''!
startWithoutParentheses
	^messages first start! !

!RBCascadeNode methodsFor: 'accessing-token' stamp: 'lr 2/12/2010 19:26'!
semicolons
	^ semicolons! !

!RBCascadeNode methodsFor: 'accessing' stamp: ''!
receiver
	^self messages first receiver! !

!RBCascadeNode methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:36'!
acceptVisitor: aProgramNodeVisitor 
	^aProgramNodeVisitor visitCascadeNode: self! !

!RBCascadeNode methodsFor: 'testing' stamp: ''!
uses: aNode 
	^messages last = aNode and: [self isUsed]! !

!RBCascadeNode methodsFor: 'comparing' stamp: 'BernardoContreras 8/23/2014 20:41'!
equalTo: anObject withMapping: aDictionary 
	self class = anObject class ifFalse: [^false].
	self messages size = anObject messages size ifFalse: [^false].
	self messages
		with: anObject messages
		do: [:first :second | (first equalTo: second withMapping: aDictionary) ifFalse: [^false]].
	^true! !

!RBCascadeNode methodsFor: 'replacing' stamp: ''!
replaceNode: aNode withNode: anotherNode 
	self messages: (messages 
				collect: [:each | each == aNode ifTrue: [anotherNode] ifFalse: [each]])! !

!RBCascadeNode methodsFor: 'comparing' stamp: 'BernardoContreras 8/23/2014 20:39'!
= anObject 
	self == anObject ifTrue: [^true].
	self class = anObject class ifFalse: [^false].
	self messages size = anObject messages size ifFalse: [^false].
	self messages with: anObject messages do: [:first :second | first = second ifFalse: [^false]].
	^true! !

!RBCascadeNode methodsFor: 'copying' stamp: 'lr 11/1/2009 22:36'!
postCopy
	super postCopy.
	self messages: (self messages collect: [ :each | each copy ])! !

!RBCascadeNode methodsFor: 'matching' stamp: 'lr 5/30/2010 11:34'!
match: aNode inContext: aDictionary 
	aNode class = self class ifFalse: [^false].
	^self 
		matchList: messages
		against: aNode messages
		inContext: aDictionary! !

!RBCascadeNode methodsFor: 'testing' stamp: 'ClementBera 7/26/2013 17:15'!
needsParenthesis
	^parent 
		ifNil: [false]
		ifNotNil: [self precedence > parent precedence]! !

!RBCascadeNode methodsFor: 'testing' stamp: ''!
isCascade
	^true! !

!RBCascadeNode methodsFor: 'accessing' stamp: 'PabloHerrero 11/7/2013 11:13'!
statementComments
	| statementComments |
	statementComments := OrderedCollection withAll: self comments.
	statementComments addAll: messages first receiver statementComments.
	messages do: 
			[:each | 
			each arguments 
				do: [:arg | statementComments addAll: arg statementComments]].
	^statementComments asSortedCollection: [:a :b | a start < b start]! !

!RBCascadeNode class methodsFor: 'instance creation' stamp: ''!
messages: messageNodes 
	^self new messages: messageNodes! !

!RBCascadeNode class methodsFor: 'instance creation' stamp: ''!
messages: messageNodes semicolons: integerCollection 
	^self new messages: messageNodes semicolons: integerCollection! !

!RBCascadedNextPutAllsRule commentStamp: 'StephaneDucasse 11/29/2014 17:42'!
Use cascaded nextPutAll:''s instead of #, in #nextPutAll:.
Indeed this is really important to understand that the implementation of the concatenation of strings creates a new string for each uses of ,.
Therefore if you use five , to concatenate an expression you create 5 intermediate strings for nothing. Using nextPutAll: just add the string in the stream.

Have a look at  streamContents:. Here is an example

String streamContents: [ :s|
		s nextPutAll: '---'.
		s nextPutAll: self.
		s nextPutAll: '---' ].!
!RBCascadedNextPutAllsRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:29'!
initialize
	super initialize.
	self rewriteRule
		replace: '``@rcvr nextPutAll: ``@object1 , ``@object2' with: '``@rcvr nextPutAll: ``@object1; nextPutAll: ``@object2';
		replace: '``@rcvr show: ``@object1 , ``@object2' with: '``@rcvr show: ``@object1; show: ``@object2'! !

!RBCascadedNextPutAllsRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 17:43'!
rationale 
	^ 'Use cascaded nextPutAll:''s instead of #, in #nextPutAll:.'! !

!RBCascadedNextPutAllsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Transformations'! !

!RBCascadedNextPutAllsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Use cascaded nextPutAll:''s instead of #, in #nextPutAll:'! !

!RBCascadedNextPutAllsRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:50'!
category 
	^ 'Coding Idiom Violation'! !

!RBCascadedNextPutAllsRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'CascadedNextPutAllsRule'! !

!RBCategoryEnvironment methodsFor: 'testing' stamp: 'lr 11/25/2009 08:31'!
includesClass: aClass 
	^ (super includesClass: aClass) and: [ categories includes: aClass theNonMetaClass category ]! !

!RBCategoryEnvironment methodsFor: 'initialization' stamp: 'lr 2/26/2009 14:25'!
initialize
	super initialize.
	categories := IdentitySet new! !

!RBCategoryEnvironment methodsFor: 'adding' stamp: 'lr 2/8/2009 10:46'!
addCategory: aSymbol
	categories add: aSymbol! !

!RBCategoryEnvironment methodsFor: 'copying' stamp: 'lr 2/26/2009 14:21'!
postCopy
	super postCopy.
	categories := categories copy! !

!RBCategoryEnvironment methodsFor: 'testing' stamp: ''!
isEmpty
	^categories isEmpty! !

!RBCategoryEnvironment methodsFor: 'printing' stamp: ''!
storeOn: aStream
	aStream nextPut: $(.
	super storeOn: aStream.
	aStream nextPutAll: ' categories: '.
	categories asArray storeOn: aStream.
	aStream nextPut: $)! !

!RBCategoryEnvironment methodsFor: 'testing' stamp: ''!
includesCategory: aCategory
	^(categories includes: aCategory)
		and: [super includesCategory: aCategory]! !

!RBCategoryEnvironment methodsFor: 'private' stamp: ''!
defaultLabel
	| stream |
	stream := String new writeStream.
	categories do: [:each | stream nextPutAll: each; nextPut: $ ].
	^stream contents! !

!RBCategoryEnvironment methodsFor: 'accessing-classes' stamp: 'lr 2/26/2009 14:32'!
classNames
	^ self categories 
		inject: IdentitySet new
		into: [ :answer :each | 
			answer
				addAll: (self classNamesFor: each);
				yourself ]! !

!RBCategoryEnvironment methodsFor: 'testing' stamp: 'YuriyTymchuk 7/3/2014 11:18'!
definesClass: aClass 
	^ (super definesClass: aClass) and: [ categories includes: aClass theNonMetaClass category ]! !

!RBCategoryEnvironment methodsFor: 'initialize-release' stamp: 'lr 2/26/2009 14:25'!
categories: aCollection
	categories addAll: aCollection! !

!RBCategoryEnvironment class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/2/2013 23:23'!
onEnvironment: anEnvironment categories: aCollection
	^(self onEnvironment: anEnvironment)
		categories: aCollection;
		yourself! !

!RBCategoryEnvironment class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/2/2013 23:23'!
categories: aCollection
	^ self
		onEnvironment: self default
		categories: aCollection! !

!RBCategoryEnvironment class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/2/2013 23:24'!
category: aCategory
	^ self categories: { aCategory }! !

!RBCategoryRegexRefactoring methodsFor: 'transforming' stamp: ''!
transform
	| replacement |
	self model allClassesDo: [ :class |
		(class isNil or: [ class isMeta ]) ifFalse: [
			replacement := self execute: class category.
			replacement = class category asString ifFalse: [
				class category: replacement.
				self model defineClass: class definitionString ] ] ]! !

!RBChangeMethodNameRefactoring methodsFor: 'transforming' stamp: 'CamilloBruni 10/7/2012 23:59'!
renameImplementors
	self implementors do: 
			[:each | 
			| parseTree |
			parseTree := each parseTreeFor: oldSelector.
			parseTree isNil 
				ifTrue: [self refactoringFailure: 'Could not parse source code.'].
			self implementorsCanBePrimitives 
				ifFalse: 
					[parseTree isPrimitive 
						ifTrue: 
							[self refactoringFailure: ('<1p>''s implementation of #<2s> is a primitive' 
										expandMacrosWith: each
										with: oldSelector)]].
			self modifyImplementorParseTree: parseTree in: each.
			(each methodFor: oldSelector) compileTree: parseTree]! !

!RBChangeMethodNameRefactoring methodsFor: 'preconditions' stamp: 'CamilloBruni 10/7/2012 23:29'!
preconditions
	"This refactoring only preserves behavior if all implementors are renamed."

	| conditions |
	conditions := self myConditions 
				& (RBCondition definesSelector: oldSelector in: class) 
				& (RBCondition isValidMethodName: newSelector for: class).
					
	conditions := self implementors 
		inject: conditions into: [ :condition :each | 
			condition & (RBCondition hierarchyOf: each canUnderstand: newSelector) not ].
		
	^conditions & (RBCondition withBlock: 
		[self implementors size > 1 
			ifTrue: 
				[self refactoringWarning: ('This will modify all <1p> implementors.' 
							expandMacrosWith: self implementors size)].
		true])! !

!RBChangeMethodNameRefactoring methodsFor: 'preconditions' stamp: 'MarkRizun 7/17/2014 17:07'!
myConditions
	"^self subclassResponsibility"! !

!RBChangeMethodNameRefactoring methodsFor: 'transforming' stamp: 'lr 12/23/2009 20:00'!
transform
	self renameImplementors.
	self renameMessageSends.
	self removeRenamedImplementors! !

!RBChangeMethodNameRefactoring methodsFor: 'accessing' stamp: ''!
newSelector
	^newSelector! !

!RBChangeMethodNameRefactoring methodsFor: 'transforming' stamp: 'lr 12/23/2009 19:59'!
removeRenamedImplementors
	oldSelector = newSelector
		ifTrue: [ ^ self ].
	self implementors 
		do: [ :each | each removeMethod: oldSelector ]! !

!RBChangeMethodNameRefactoring methodsFor: 'initialize-release' stamp: 'md 3/15/2006 17:27'!
renameMethod: aSelector in: aClass to: newSel permutation: aMap 
	oldSelector := aSelector asSymbol.
	newSelector := newSel asSymbol.
	class := self classObjectFor: aClass.
	permutation := aMap! !

!RBChangeMethodNameRefactoring methodsFor: 'private' stamp: 'lr 11/23/2009 10:58'!
modifyImplementorParseTree: parseTree in: aClass 
	| oldArgs |
	oldArgs := parseTree arguments.
	parseTree renameSelector: newSelector andArguments: (permutation collect: [:each | oldArgs at: each]) ! !

!RBChangeMethodNameRefactoring methodsFor: 'private' stamp: 'lr 11/2/2009 00:14'!
parseTreeRewriter
	| rewriteRule oldString newString |
	rewriteRule := RBParseTreeRewriter new.
	oldString := self buildSelectorString: oldSelector.
	newString := self buildSelectorString: newSelector
				withPermuteMap: permutation.
	rewriteRule replace: '``@object ' , oldString
		with: '``@object ' , newString.
	^rewriteRule! !

!RBChangeMethodNameRefactoring methodsFor: 'testing' stamp: ''!
hasPermutedArguments
	oldSelector numArgs = newSelector numArgs ifFalse: [^true].
	1 to: oldSelector numArgs
		do: [:i | (permutation at: i) = i ifFalse: [^true]].
	^false! !

!RBChangeMethodNameRefactoring methodsFor: 'transforming' stamp: ''!
renameMessageSends
	self convertAllReferencesTo: oldSelector using: self parseTreeRewriter! !

!RBChangeMethodNameRefactoring methodsFor: 'private' stamp: ''!
implementors
	implementors isNil 
		ifTrue: [implementors := self model allImplementorsOf: oldSelector].
	^implementors! !

!RBChangeMethodNameRefactoring methodsFor: 'testing' stamp: ''!
implementorsCanBePrimitives
	^false! !

!RBChildrenToSiblingsRefactoring methodsFor: 'private-methods' stamp: ''!
computeSubclassSupersOf: aClass 
	| selectors |
	selectors := Set new.
	aClass subclasses do: 
			[:each | 
			each selectors 
				do: [:sel | selectors addAll: (each parseTreeFor: sel) superMessages]].
	^selectors! !

!RBChildrenToSiblingsRefactoring methodsFor: 'private-variables' stamp: 'MartinDias 11/7/2013 18:11'!
pullUpPoolVariables
	"Don't remove the pool variables from the subclass since they might be referenced there."

	| newSuperclass |
	newSuperclass := self abstractSuperclass.
	parent sharedPoolNames 
		do: [:each | newSuperclass addPoolDictionary: each]! !

!RBChildrenToSiblingsRefactoring methodsFor: 'private-methods' stamp: 'PabloHerrero 10/21/2013 17:37'!
subclassResponsibilityFor: aSelector in: aClass 
	| methodNode position source |
	source := aClass sourceCodeFor: aSelector.
	methodNode := RBParser parseMethod: source onError: [:err :pos | ^nil].
	position := methodNode arguments isEmpty 
				ifTrue: [methodNode keywordsIntervals last last ]
				ifFalse: [methodNode arguments last stop].
	^'<1s><n><t>self subclassResponsibility' 
		expandMacrosWith: (source copyFrom: 1 to: position)! !

!RBChildrenToSiblingsRefactoring methodsFor: 'private-methods' stamp: 'lr 10/26/2009 22:09'!
shouldPushUp: aSelector from: aClass 
	^ ((aClass isMeta 
		ifTrue: [ subclasses collect: [ :each | each theMetaClass ] ]
		ifFalse: [ subclasses ]) 
		detect: [ :each | (each directlyDefinesMethod: aSelector) not ]
		ifNone: [ nil ]) notNil! !

!RBChildrenToSiblingsRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^subclasses 
		inject: ((RBCondition isMetaclass: parent) 
				errorMacro: 'Superclass must not be a metaclass') not 
				& (RBCondition isValidClassName: className) 
					& (RBCondition isGlobal: className in: self model) not
		into: 
			[:sub :each | 
			sub 
				& ((RBCondition isMetaclass: each) 
						errorMacro: 'Subclass must <1?not :>be a metaclass') not 
					& (RBCondition isImmediateSubclass: each of: parent)]! !

!RBChildrenToSiblingsRefactoring methodsFor: 'private-variables' stamp: 'lr 9/8/2011 20:11'!
pullUpClassVariables
	| newSuperclass |
	newSuperclass := self abstractSuperclass.
	parent classVariableNames do: 
			[:each | 
			self performComponentRefactoring: (RBPullUpClassVariableRefactoring 
						model: self model
						variable: each
						class: newSuperclass)]! !

!RBChildrenToSiblingsRefactoring methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream
		nextPutAll: ' name: #';
		nextPutAll: className;
		nextPutAll: ' class: '.
	parent storeOn: aStream.
	aStream nextPutAll: ' subclasses: '.
	subclasses asArray storeOn: aStream.
	aStream nextPut: $)! !

!RBChildrenToSiblingsRefactoring methodsFor: 'private-variables' stamp: 'lr 9/8/2011 20:11'!
pullUpInstanceVariables
	| newSuperclass |
	newSuperclass := self abstractSuperclass.
	parent instanceVariableNames do: 
			[:each | 
			self performComponentRefactoring: (RBPullUpInstanceVariableRefactoring 
						model: self model
						variable: each
						class: newSuperclass)]! !

!RBChildrenToSiblingsRefactoring methodsFor: 'private-methods' stamp: ''!
selectorsToPushUpFrom: aClass 
	| superSelectors |
	superSelectors := self computeSubclassSupersOf: aClass.
	^aClass selectors select: 
			[:each | 
			(superSelectors includes: each) or: [self shouldPushUp: each from: aClass]]! !

!RBChildrenToSiblingsRefactoring methodsFor: 'private-accessing' stamp: ''!
abstractSuperclass
	^self model classNamed: className asSymbol! !

!RBChildrenToSiblingsRefactoring methodsFor: 'private-methods' stamp: ''!
pushUp: aSelector in: aClass 
	| source |
	source := aClass sourceCodeFor: aSelector.
	source isNil 
		ifFalse: 
			[aClass superclass compile: source
				classified: (aClass protocolsFor: aSelector)]! !

!RBChildrenToSiblingsRefactoring methodsFor: 'transforming' stamp: 'lr 7/17/2010 23:24'!
pullUpMethods
	self pushUpMethodsFrom: parent.
	self pushUpMethodsFrom: parent theMetaClass! !

!RBChildrenToSiblingsRefactoring methodsFor: 'transforming' stamp: ''!
reparentSubclasses
	self model reparentClasses: subclasses to: self abstractSuperclass! !

!RBChildrenToSiblingsRefactoring methodsFor: 'transforming' stamp: ''!
pushUpVariables
	self pullUpInstanceVariables.
	self pullUpClassInstanceVariables.
	self pullUpClassVariables.
	self pullUpPoolVariables! !

!RBChildrenToSiblingsRefactoring methodsFor: 'transforming' stamp: 'lr 7/17/2010 23:24'!
transform
	self
		addSuperclass;
		pushUpVariables;
		pullUpMethods;
		changeIsKindOfReferences;
		reparentSubclasses! !

!RBChildrenToSiblingsRefactoring methodsFor: 'private-methods' stamp: ''!
createSubclassResponsibilityFor: aSelector in: aClass 
	| source |
	(aClass superclass definesMethod: aSelector) ifTrue: [^self].
	source := self subclassResponsibilityFor: aSelector in: aClass.
	source isNil ifTrue: [^self].
	aClass superclass compile: source
		classified: (aClass protocolsFor: aSelector)! !

!RBChildrenToSiblingsRefactoring methodsFor: 'initialize-release' stamp: ''!
name: aClassName class: aClass subclasses: subclassCollection 
	className := aClassName asSymbol.
	parent := self model classFor: aClass.
	subclasses := subclassCollection 
				collect: [:each | self model classFor: each]! !

!RBChildrenToSiblingsRefactoring methodsFor: 'private-methods' stamp: ''!
pushUpMethodsFrom: aClass 
	| selectorsToPushUp |
	selectorsToPushUp := self selectorsToPushUpFrom: aClass.
	aClass selectors do: 
			[:each | 
			(selectorsToPushUp includes: each) 
				ifTrue: [self pushUp: each in: aClass]
				ifFalse: [self createSubclassResponsibilityFor: each in: aClass]].
	selectorsToPushUp do: [:each | aClass removeMethod: each]! !

!RBChildrenToSiblingsRefactoring methodsFor: 'private-variables' stamp: 'lr 9/8/2011 20:11'!
pullUpClassInstanceVariables
	| newSuperclass |
	newSuperclass := self abstractSuperclass theMetaClass.
	parent theMetaClass instanceVariableNames do: 
		[ :each | 
		self performComponentRefactoring: (RBPullUpInstanceVariableRefactoring 
				model: self model
				variable: each
				class: newSuperclass) ]! !

!RBChildrenToSiblingsRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'!
changeIsKindOfReferences
	| replacer |
	replacer := RBParseTreeRewriter new.
	replacer replace: '``@object isKindOf: ' , parent name
		with: '``@object isKindOf: ' , className.
	self convertAllReferencesToClass: parent using: replacer! !

!RBChildrenToSiblingsRefactoring methodsFor: 'transforming' stamp: 'lr 9/8/2011 20:11'!
addSuperclass
	self performComponentRefactoring: (RBAddClassRefactoring 
				model: self model
				addClass: className
				superclass: parent superclass
				subclasses: (Array with: parent)
				category: parent category)! !

!RBChildrenToSiblingsRefactoring class methodsFor: 'instance creation' stamp: ''!
name: aClassName class: aClass subclasses: subclassCollection 
	^(self new)
		name: aClassName
			class: aClass
			subclasses: subclassCollection;
		yourself! !

!RBChildrenToSiblingsRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBSmalltalk name: aClassName class: aClass subclasses: subclassCollection 
	^(self new)
		model: aRBSmalltalk;
		name: aClassName
			class: aClass
			subclasses: subclassCollection;
		yourself! !

!RBChildrenToSiblingsTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testBadName
	self shouldFail: (RBChildrenToSiblingsRefactoring 
			name: #'Obje ct'
			class: RBLintRuleTest
			subclasses: (Array 
					with: RBBasicLintRuleTest
					with: RBCompositeLintRuleTest))! !

!RBChildrenToSiblingsTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testModelChildrenToSibling
	| refactoring class subclass superclass |
	class := model classNamed: #ConcreteSuperclass.
	subclass := model classNamed: #ConcreteSubclass.
	refactoring := RBChildrenToSiblingsRefactoring 
		model: model
		name: #AbstractSuperclass
		class: class
		subclasses: (Array with: subclass).
	self executeRefactoring: refactoring.
	superclass := refactoring model classNamed: #AbstractSuperclass.
	self assert: class superclass = superclass.
	self assert: class theMetaClass superclass = superclass theMetaClass.
	self assert: subclass superclass = superclass.
	self assert: subclass theMetaClass superclass = superclass theMetaClass.
	self assert: (superclass parseTreeFor: #same) = (RBParser parseMethod: 'same ^self initialize isKindOf: AbstractSuperclass').
	self assert: (superclass parseTreeFor: #different) = (RBParser parseMethod: 'different self subclassResponsibility').
	self assert: (superclass parseTreeFor: #initialize) = (RBParser parseMethod: 'initialize
							instVarName1 := instVarName2 := ClassVarName1 := ClassVarName2 := 0').
	self assert: (superclass directlyDefinesInstanceVariable: 'instVarName1').
	self assert: (superclass directlyDefinesInstanceVariable: 'instVarName2').
	self assert: (superclass directlyDefinesClassVariable: 'ClassVarName1').
	self assert: (superclass directlyDefinesClassVariable: 'ClassVarName2').
	self assert: (superclass theMetaClass directlyDefinesInstanceVariable: 'classInstVarName1').
	self assert: (superclass theMetaClass parseTreeFor: #foo) = (RBParser parseMethod: 'foo
							^classInstVarName1 + ClassVarName1 + ClassVarName2').
	self assert: (superclass theMetaClass parseTreeFor: #new) = (RBParser parseMethod: 'new
							^super new initialize').
	self assert: (superclass theMetaClass parseTreeFor: #bar) = (RBParser parseMethod: 'bar
							self subclassResponsibility').
	self deny: (class directlyDefinesInstanceVariable: 'instVarName1').
	self deny: (class directlyDefinesInstanceVariable: 'instVarName2').
	self deny: (class directlyDefinesClassVariable: 'ClassVarName1').
	self deny: (class directlyDefinesClassVariable: 'ClassVarName2').
	self deny: (class theMetaClass directlyDefinesInstanceVariable: 'classInstVarName1').
	self deny: (class directlyDefinesMethod: #same).
	self deny: (class directlyDefinesMethod: #initialize).
	self deny: (class theMetaClass directlyDefinesMethod: #new).
	self assert: (class parseTreeFor: #different) = (RBParser parseMethod: 'different
							^instVarName1 + instVarName2').
	self assert: (class theMetaClass parseTreeFor: #bar) = (RBParser parseMethod: 'bar
							^self printString')! !

!RBChildrenToSiblingsTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testMetaClassFailure
	self shouldFail: (RBChildrenToSiblingsRefactoring 
			name: #Foo
			class: RBLintRuleTest class
			subclasses: (Array 
					with: RBBasicLintRuleTest class
					with: RBCompositeLintRuleTest class))! !

!RBChildrenToSiblingsTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testInvalidSubclass
	self shouldFail: (RBChildrenToSiblingsRefactoring 
			name: #Foo
			class: RBRefactoringTest
			subclasses: (Array 
					with: RBBasicLintRuleTest
					with: RBCompositeLintRuleTest))! !

!RBChildrenToSiblingsTest methodsFor: 'set up' stamp: 'MarcusDenker 4/25/2013 15:10'!
setUp
	super setUp.
	model := Smalltalk evaluate: self childrenToSiblingTestData! !

!RBChildrenToSiblingsTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testExistingName
	self
		shouldFail: (RBChildrenToSiblingsRefactoring 
				name: #Object
				class: RBLintRuleTest
				subclasses: (Array 
						with: RBBasicLintRuleTest
						with: RBCompositeLintRuleTest));
		shouldFail: (RBChildrenToSiblingsRefactoring 
				name: #Processor
				class: RBLintRuleTest
				subclasses: (Array 
						with: RBBasicLintRuleTest
						with: RBCompositeLintRuleTest))! !

!RBClass methodsFor: 'testing' stamp: 'MartinDias 11/7/2013 18:11'!
directlyDefinesPoolDictionary: aString 
	^self sharedPoolNames includes: aString asSymbol! !

!RBClass methodsFor: 'accessing' stamp: ''!
classVariableNames
	^self privateClassVariableNames copy! !

!RBClass methodsFor: 'accessing' stamp: 'lr 7/1/2008 10:55'!
comment: aString
	model comment: (comment := aString) in: self! !

!RBClass methodsFor: 'accessing' stamp: ''!
classVariableNames: aCollectionOfStrings 
	classVariableNames := (aCollectionOfStrings 
				collect: [:each | each asSymbol]) asOrderedCollection! !

!RBClass methodsFor: 'variable accessing' stamp: ''!
renameClassVariable: oldName to: newName around: aBlock 
	self privateClassVariableNames 
		at: (self privateClassVariableNames indexOf: oldName asSymbol)
		put: newName asSymbol.
	model 
		renameClassVariable: oldName
		to: newName
		in: self
		around: aBlock! !

!RBClass methodsFor: 'accessing' stamp: 'lr 7/1/2008 11:09'!
comment
	^ comment = LookupComment
		ifTrue: [
			comment := self isDefined
				ifTrue: [ self realClass comment ]
				ifFalse: [ nil ] ]
		ifFalse: [ comment ]! !

!RBClass methodsFor: 'initialization' stamp: 'lr 7/1/2008 10:58'!
initialize
	super initialize.
	comment := LookupComment! !

!RBClass methodsFor: 'accessing' stamp: 'lr 10/26/2009 22:08'!
theNonMetaClass
	^ self! !

!RBClass methodsFor: 'variable accessing' stamp: ''!
addClassVariable: aString 
	self privateClassVariableNames add: aString asSymbol.
	model addClassVariable: aString to: self! !

!RBClass methodsFor: 'testing' stamp: ''!
directlyDefinesClassVariable: aString 
	^self classVariableNames includes: aString asSymbol! !

!RBClass methodsFor: 'private' stamp: 'djr 3/31/2010 14:00'!
privatePoolDictionaryNames
	(self isDefined and: [poolDictionaryNames isNil]) 
		ifTrue: 
			[self poolDictionaryNames: (self realClass sharedPools 
						collect: [:each | self realClass environment keyAtValue: each])].
	^poolDictionaryNames! !

!RBClass methodsFor: 'variable accessing' stamp: ''!
removeClassVariable: aString 
	self privateClassVariableNames remove: aString asSymbol.
	model removeClassVariable: aString from: self! !

!RBClass methodsFor: 'accessing' stamp: ''!
allClassVariableNames
	| sprClass |
	sprClass := self superclass.
	^sprClass isNil 
		ifTrue: [self classVariableNames]
		ifFalse: [sprClass allClassVariableNames , self classVariableNames]! !

!RBClass methodsFor: 'accessing' stamp: 'MartinDias 11/7/2013 18:11'!
allPoolDictionaryNames
	| sprClass |
	sprClass := self superclass.
	^sprClass isNil 
		ifTrue: [self sharedPoolNames]
		ifFalse: [sprClass allPoolDictionaryNames , self sharedPoolNames]! !

!RBClass methodsFor: 'accessing' stamp: 'bh 11/8/2000 15:22'!
category
	^category isNil 
		ifTrue: 
			[self isDefined
				ifTrue: [category := self realClass category]
				ifFalse: [model environment whichCategoryIncludes: self name]]
		ifFalse: [category]
! !

!RBClass methodsFor: 'testing' stamp: ''!
isMeta
	^false! !

!RBClass methodsFor: 'private' stamp: ''!
privateClassVariableNames
	(self isDefined and: [classVariableNames isNil]) 
		ifTrue: [self classVariableNames: self realClass classVarNames].
	^classVariableNames! !

!RBClass methodsFor: 'accessing' stamp: 'MartinDias 11/7/2013 18:11'!
sharedPoolNames
	^self privatePoolDictionaryNames copy! !

!RBClass methodsFor: 'initialize-release' stamp: 'lr 7/23/2010 07:49'!
realName: aSymbol 
	self realClass: (self class environment at: aSymbol)! !

!RBClass methodsFor: 'variable accessing' stamp: ''!
addPoolDictionary: aString 
	self privatePoolDictionaryNames add: aString asSymbol.
	model addPool: aString to: self! !

!RBClass methodsFor: 'variable accessing' stamp: ''!
removePoolDictionary: aString 
	self privatePoolDictionaryNames remove: aString asSymbol! !

!RBClass methodsFor: 'accessing' stamp: 'MartinDias 11/7/2013 18:11'!
definitionString
	| definitionStream |
	definitionStream := WriteStream on: ''.
	definitionStream
		nextPutAll: self superclass printString;
		nextPutAll: ' subclass: #';
		nextPutAll: self name;
		nextPutAll: '
	instanceVariableNames: '''.
	self instanceVariableNames do: 
			[:each | 
			definitionStream
				nextPutAll: each;
				nextPut: $ ].
	definitionStream nextPutAll: '''
	classVariableNames: '''.
	self classVariableNames do: 
			[:each | 
			definitionStream
				nextPutAll: each;
				nextPut: $ ].
	definitionStream nextPutAll: '''
	poolDictionaries: '''.
	self sharedPoolNames do: 
			[:each | 
			definitionStream
				nextPutAll: each;
				nextPut: $ ].
	definitionStream nextPutAll: '''
	category: #'''.
	definitionStream nextPutAll: self category asString.
	definitionStream nextPut: $'.
	^definitionStream contents! !

!RBClass methodsFor: 'accessing' stamp: ''!
poolDictionaryNames: aCollectionOfStrings 
	poolDictionaryNames := (aCollectionOfStrings 
				collect: [:each | each asSymbol]) asOrderedCollection! !

!RBClass methodsFor: 'accessing' stamp: 'lr 7/23/2010 08:03'!
sharedPools
	^ self allPoolDictionaryNames collect: [ :each | Smalltalk globals at: each asSymbol ifAbsent: [ Dictionary new ] ]! !

!RBClass methodsFor: 'accessing' stamp: ''!
category: aSymbol 
	category := aSymbol! !

!RBClass class methodsFor: 'instance creation' stamp: ''!
existingNamed: aSymbol 
	^(self named: aSymbol)
		realName: aSymbol;
		yourself! !

!RBClass class methodsFor: 'class initialization' stamp: 'lr 7/1/2008 10:57'!
initialize
	LookupComment := Object new! !

!RBClass class methodsFor: 'instance creation' stamp: ''!
named: aSymbol 
	^(self new)
		name: aSymbol;
		yourself! !

!RBClassEnvironment methodsFor: 'testing' stamp: ''!
includesClass: aClass 
	^(aClass isMeta
		ifTrue: [metaClasses includes: aClass soleInstance name]
		ifFalse: [classes includes: aClass name])
			and: [super includesClass: aClass]! !

!RBClassEnvironment methodsFor: 'accessing-classes' stamp: 'YuriyTymchuk 9/29/2014 20:29'!
classesDo: aBlock 
	classes do: [ :each | 
		| class |
		class := self systemDictionary at: each ifAbsent: [ nil ].
		(class notNil and: [ environment includesClass: class ])
			ifTrue: [ aBlock value: class ] ].! !

!RBClassEnvironment methodsFor: 'printing' stamp: 'lr 3/20/2011 11:18'!
metaClassSelectorDictionary
	^ metaClasses 
		inject: (IdentityDictionary new: metaClasses size)
		into: [ :answer :class |
			answer
				at: class put: (self systemDictionary at: class) class selectors;
				yourself ]! !

!RBClassEnvironment methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'!
asSelectorEnvironment

	^RBSelectorEnvironment new
		searchStrings:#();
		label:self label;
		onEnvironment: self environment;
		classSelectors: self classSelectorDictionary metaClassSelectors: self metaClassSelectorDictionary;
		yourself.! !

!RBClassEnvironment methodsFor: 'testing' stamp: ''!
isEmpty
	^classes isEmpty and: [metaClasses isEmpty]! !

!RBClassEnvironment methodsFor: 'printing' stamp: ''!
storeOn: aStream
	aStream nextPut: $(.
	super storeOn: aStream.
	aStream nextPutAll: ' classes: (('.
	classes asArray storeOn: aStream.
	aStream nextPutAll: ' inject: OrderedCollection new into: [:sum :each | 
				| class |
				class := Smalltalk at: each ifAbsent: [nil].
				class notNil ifTrue: [sum add: class].
				sum]) , ('.
	metaClasses asArray storeOn: aStream.
	aStream nextPutAll: ' inject: OrderedCollection new into: [:sum :each | 
				| class |
				class := Smalltalk at: each ifAbsent: [nil].
				class notNil ifTrue: [sum add: class class].
				sum])))'! !

!RBClassEnvironment methodsFor: 'testing' stamp: 'CamilloBruni 7/7/2013 18:40'!
includesCategory: aCategory
	^ (super includesCategory: aCategory) and: [
		(environment classNamesFor: aCategory)
			inject: false
			into: [ :bool :each |
				bool or: [
					| class |
					class := self systemDictionary at: each ifAbsent: [ nil ].
					class notNil 
						and: [ (self includesClass: class)
						or: [ self includesClass: class class ]]]]]! !

!RBClassEnvironment methodsFor: 'testing' stamp: 'YuriyTymchuk 7/3/2014 11:12'!
definesClass: aClass
	
	^ self includesClass: aClass! !

!RBClassEnvironment methodsFor: '*GT-SpotterExtensions-Core-private' stamp: 'StefanReichhart 3/23/2015 13:12'!
withClassesFixedForNautilus
	classes ifEmpty: [ 
		metaClasses do: [ :each | 
			classes add: each ] ]! !

!RBClassEnvironment methodsFor: 'initialization' stamp: 'lr 2/26/2009 13:35'!
initialize
	super initialize.
	classes := IdentitySet new.
	metaClasses := IdentitySet new! !

!RBClassEnvironment methodsFor: 'printing' stamp: 'lr 3/20/2011 11:18'!
classSelectorDictionary
	^ classes 
		inject: (IdentityDictionary new: classes size)
		into: [ :answer :class |
			answer
				at: class put: (self systemDictionary at: class) selectors;
				yourself ]! !

!RBClassEnvironment methodsFor: 'initialize-release' stamp: 'lr 9/14/2010 13:06'!
classes: aCollection 
	aCollection do: [ :each | self addClass: each ]! !

!RBClassEnvironment methodsFor: 'private' stamp: ''!
defaultLabel
	| stream |
	stream := String new writeStream.
	classes do: 
			[:each | 
			stream nextPutAll: each;
				nextPut: $ ].
	^stream contents! !

!RBClassEnvironment methodsFor: 'adding' stamp: 'lr 9/14/2010 13:07'!
addClass: aClass 
	aClass isMeta
		ifTrue: [ metaClasses add: aClass soleInstance name ]
		ifFalse: [ classes add: aClass name ]! !

!RBClassEnvironment methodsFor: 'accessing-classes' stamp: 'lr 2/26/2009 14:24'!
classNames
	^ IdentitySet new
		addAll: classes;
		addAll: metaClasses;
		yourself! !

!RBClassEnvironment methodsFor: 'testing' stamp: ''!
isClassEnvironment
	^true! !

!RBClassEnvironment methodsFor: 'copying' stamp: 'lr 2/26/2009 14:24'!
postCopy
	super postCopy.
	classes := classes copy.
	metaClasses := metaClasses copy! !

!RBClassEnvironment methodsFor: 'accessing' stamp: ''!
problemCount
	^self numberClasses! !

!RBClassEnvironment methodsFor: '*manifest-core' stamp: 'YuriyTymchuk 10/10/2014 19:31'!
smallLintCritics
	^ self classes! !

!RBClassEnvironment methodsFor: 'removing' stamp: ''!
removeClass: aClass 
	aClass isMeta
		ifTrue: [metaClasses remove: aClass soleInstance name ifAbsent: []]
		ifFalse: [classes remove: aClass name ifAbsent: []]! !

!RBClassEnvironment class methodsFor: 'instance creation' stamp: ''!
onEnvironment: anEnvironment classes: aCollection
	^(self onEnvironment: anEnvironment)
		classes: aCollection; yourself! !

!RBClassEnvironment class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/2/2013 23:20'!
class: aClass
	^ self classes: { aClass }! !

!RBClassEnvironment class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/2/2013 23:22'!
classes: aCollection
	^ self
		onEnvironment: self default
		classes: aCollection! !

!RBClassInstVarNotInitializedRule commentStamp: 'StephaneDucasse 11/29/2014 21:13'!
Checks that all classes that have class instance variables also have an initialize method. This makes sure that all class instance variables are initialized properly when the class is filed-into a new image. Having well initialized instance variables also make sure that clients can rely on default values and to not have to spread their code with ifNil statement and cumbersome logic.!
!RBClassInstVarNotInitializedRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'!
resultClass
	^ RBClassEnvironment! !

!RBClassInstVarNotInitializedRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 21:13'!
rationale
	^ 'Checks that all classes that have class instance variables also have an initialize method.'! !

!RBClassInstVarNotInitializedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Possible bugs'! !

!RBClassInstVarNotInitializedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Has class instance variables but no initialize method'! !

!RBClassInstVarNotInitializedRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 10:00'!
category 	
	
	^ 'Potential Bugs'! !

!RBClassInstVarNotInitializedRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:48'!
checkClass: aClass 
	| definesVar class |
	aClass isMeta ifTrue: 
		[ class := aClass.
		definesVar := false.
		[ definesVar or: [ class isNil or: [ class isMeta not ] ] ] whileFalse: [
			definesVar := class instVarNames isEmpty not
				"TestCase defines Announcers but does not initialize it -> all tests are reported
				so we exclude it here"
				and: [ class ~= TestCase class
				and: [ aClass ~= TestCase ] ].
			class := class superclass ].
		(definesVar and: [ (aClass includesSelector: #initialize) not ]) ifTrue: [
			result addClass: aClass ] ]! !

!RBClassInstVarNotInitializedRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'ClassInstVarNotInitializedRule'! !

!RBClassNameInSelectorRule commentStamp: 'StephaneDucasse 11/29/2014 21:13'!
This smell arises when the class name is found in a selector. This is redundant since to call the you must already refer to the class name. For example, #openHierarchyBrowserFrom: is a redundant name for HierarchyBrowser.!
!RBClassNameInSelectorRule methodsFor: 'accessing' stamp: 'StephaneDucasse 12/23/2012 15:58'!
rationale
	^ 'Checks for the class name in a selector. This is redundant since to call the you must already refer to the class name. For example, openHierarchyBrowserFrom: is a redundant name for HierarchyBrowser. Avoiding selector including class name gives a chance to have more polymorphic methods.'! !

!RBClassNameInSelectorRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Miscellaneous'! !

!RBClassNameInSelectorRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Redundant class name in selector'! !

!RBClassNameInSelectorRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 10:01'!
category 
	^ 'Style'! !

!RBClassNameInSelectorRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 16:48'!
checkMethod: aMethod 
	(aMethod methodClass isMeta and: 
		[ (aMethod selector 
			indexOfSubCollection: aMethod methodClass soleInstance name
			startingAt: 1) > 0 ]) ifTrue: 
		[ result addMethod: aMethod ]! !

!RBClassNameInSelectorRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'ClassNameInSelectorRule'! !

!RBClassNotReferencedRule commentStamp: 'StephaneDucasse 11/29/2014 21:12'!
This smell arises when a class is not referenced either directly or indirectly by a symbol. If a class is not referenced, it can be removed.!
!RBClassNotReferencedRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'!
resultClass
	^ RBClassEnvironment! !

!RBClassNotReferencedRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 10:02'!
category 
	^ 'Design Flaws'! !

!RBClassNotReferencedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
rationale
	^ 'Check if a class is referenced either directly or indirectly by a symbol. If a class is not referenced, it can be removed.'! !

!RBClassNotReferencedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Unnecessary code'! !

!RBClassNotReferencedRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:09'!
severity
	^ #information! !

!RBClassNotReferencedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Class not referenced'! !

!RBClassNotReferencedRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:48'!
checkClass: aClass 
	(aClass isMeta or: [  aClass subclasses notEmpty or: [ aClass inheritsFrom: TestCase ] ] )
		ifTrue: [ ^ self ].
	aClass allCallsOn ifEmpty: [
		result
			addClass: aClass;
			addClass: aClass class ]! !

!RBClassNotReferencedRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'ClassNotReferencedRule'! !

!RBClassRefactoring methodsFor: 'initialize-release' stamp: ''!
className: aName
	className := aName! !

!RBClassRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBSmalltalk className: aName 
	^(self new)
		model: aRBSmalltalk;
		className: aName;
		yourself! !

!RBClassRefactoring class methodsFor: 'instance creation' stamp: ''!
className: aName
	^self new className: aName! !

!RBClassReference commentStamp: '<historical>'!
I am a specific variable node used for ClassReferences!
!RBClassRegexRefactoring methodsFor: 'private' stamp: 'MartinDias 11/7/2013 18:11'!
copyFrom: aSourceClass to: aTargetClass
	aSourceClass instanceVariableNames
		do: [ :each | aTargetClass addInstanceVariable: each ].
	aSourceClass isMeta ifFalse: [
		aSourceClass allClassVariableNames
			do: [ :each | aTargetClass addClassVariable: each ].
		aSourceClass sharedPoolNames
			do: [ :each | aTargetClass addPoolDictionary: each ] ].
	aSourceClass selectors do: [ :each |
		aTargetClass
			compile: (aSourceClass sourceCodeFor: each)
			classified: (aSourceClass protocolsFor: each) ]! !

!RBClassRegexRefactoring methodsFor: 'transforming' stamp: ''!
create: aClass name: aSymbol
	^ self duplicate: aClass name: aSymbol deep: false! !

!RBClassRegexRefactoring methodsFor: 'initialization' stamp: ''!
initialize
	super initialize.
	self createClasses! !

!RBClassRegexRefactoring methodsFor: 'actions' stamp: ''!
copyClasses
	mode := #copy:name:! !

!RBClassRegexRefactoring methodsFor: 'transforming' stamp: 'BenjaminVanRyseghem 4/25/2012 18:05'!
rename: aClass name: aSymbol
	^ RBRenameClassRefactoring 
		model: self model
		rename: aClass
		to: aSymbol! !

!RBClassRegexRefactoring methodsFor: 'transforming' stamp: ''!
transform
	| replacement refactoring |
	self model allClassesDo: [ :class |
		(class isNil or: [ class isMeta ]) ifFalse: [
			replacement := self execute: class name.
			replacement = class name asString ifFalse: [
				refactoring := self perform: mode
					with: class with: replacement asSymbol.
				(refactoring notNil and: [ refactoring preconditions check ])
					ifTrue: [ refactoring transform ] ] ] ]! !

!RBClassRegexRefactoring methodsFor: 'transforming' stamp: ''!
copy: aClass name: aSymbol
	^ self duplicate: aClass name: aSymbol deep: true! !

!RBClassRegexRefactoring methodsFor: 'initialization' stamp: ''!
rootClass: aClass
	rootClass := aClass theNonMetaClass! !

!RBClassRegexRefactoring methodsFor: 'private' stamp: ''!
duplicate: aClass name: aSymbol deep: aBoolean
	| superclass superclassName name class |
	(self model includesClassNamed: aSymbol)
		ifTrue: [ ^ nil ].
	superclass := aClass superclass 
		ifNil: [ self rootClass ].
	superclassName := (self model includesClassNamed: superclass name)
		ifFalse: [ superclass name ]
		ifTrue: [ 
			(name := self execute: superclass name) = superclass name
				ifFalse: [ self duplicate: superclass name: name deep: aBoolean ].
			name ].
	self model defineClass: ('<1s>
		subclass: #<2s>
		instanceVariableNames: ''''
		classVariableNames: ''''
		poolDictionaries: ''''
		category: <3p>' 
			expandMacrosWith: superclassName 
			with: aSymbol with: aClass category asString).
	aBoolean ifTrue: [
		(class := self model classNamed: aSymbol) 
			ifNil: [ ^ self ].
		self copyFrom: aClass to: class.
		self copyFrom: aClass theMetaClass to: class theMetaClass ].
	^ nil! !

!RBClassRegexRefactoring methodsFor: 'accessing' stamp: ''!
rootClass
	^ rootClass ifNil: [ Object ]! !

!RBClassRegexRefactoring methodsFor: 'actions' stamp: ''!
renameClasses
	mode := #rename:name:! !

!RBClassRegexRefactoring methodsFor: 'actions' stamp: ''!
createClasses
	mode := #create:name:! !

!RBClassTest methodsFor: 'method tests' stamp: 'lr 10/26/2009 22:09'!
testHierarchy
	| meta |
	meta := objectClass theMetaClass.
	self assert: (objectClass withAllSubclasses includes: meta).
	self assert: (meta withAllSuperclasses includes: objectClass)! !

!RBClassTest methodsFor: 'method tests' stamp: ''!
testDefinesInstanceVariable
	self deny: (objectClass definesInstanceVariable: 'instanceVariable1').
	self assert: (newClass definesInstanceVariable: 'instanceVariable1').
	self deny: (messageNodeClass definesInstanceVariable: 'instanceVariable1').
	self assert: (messageNodeClass definesInstanceVariable: 'parent').
	self assert: (messageNodeClass definesInstanceVariable: 'selector')! !

!RBClassTest methodsFor: 'method tests' stamp: ''!
testDefinesClassVariable
	self deny: (objectClass definesClassVariable: #ClassVariable1).
	self assert: (objectClass definesClassVariable: self objectClassVariable).
	self assert: (newClass definesClassVariable: #ClassVariable1).
	self deny: (messageNodeClass definesClassVariable: #ClassVariable1).
	self 
		assert: (messageNodeClass definesClassVariable: self objectClassVariable)! !

!RBClassTest methodsFor: 'tests' stamp: 'CamilloBruni 1/28/2013 17:29'!
testObjectIsNotAbstract
	self deny: objectClass isAbstract.
	self deny: objectClass theMetaClass isAbstract.! !

!RBClassTest methodsFor: 'method tests' stamp: ''!
testDefinesMethod
	self assert: (objectClass definesMethod: #printString).
	self assert: (newClass definesMethod: #printString).
	self assert: (messageNodeClass definesMethod: #printString)! !

!RBClassTest methodsFor: 'method tests' stamp: 'bh 4/3/2000 22:22'!
testDefinesPoolDictionary
	self deny: (objectClass definesPoolDictionary: #OpcodePool).
	self assert: (newClass definesPoolDictionary: #TextConstants).
	self deny: (messageNodeClass definesPoolDictionary: #OpcodePool).
	self assert: ((RBNamespace new classNamed: #Text) 
				definesPoolDictionary: #TextConstants)! !

!RBClassTest methodsFor: 'set up' stamp: 'bh 11/8/2000 14:12'!
setUp
	| st |
	super setUp.
	st := RBNamespace new.
	objectClass := st classNamed: #Object.
	messageNodeClass := st classNamed: #RBMessageNode.
	st defineClass: 'Object subclass: #SomeClassName
	instanceVariableNames: ''instanceVariable1 instanceVariable2''
	classVariableNames: ''ClassVariable1''
	poolDictionaries: ''TextConstants''
	category: #''Refactory-Testing'''.
	newClass := st classNamed: #SomeClassName! !

!RBClassToRename methodsFor: 'performing' stamp: ''!
method2
	^self method1! !

!RBClassToRename methodsFor: 'performing' stamp: ''!
method1
	^self method2! !

!RBClassVariableCapitalizationRule commentStamp: '<historical>'!
This smell arises when class or pool variable names do not start with an uppercase letter, which is a standard style in Smalltalk. In fact a lowercase character is used to represent variables with a local scope such as instance variables, temporary variables, method and block arguments. Uppercase is used to represent the case where the scope of a variable is either global (class name and global variables such as Transcript) or shared among different classes (class variables or pool variables).!
!RBClassVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'!
resultClass
	^ RBVariableEnvironment! !

!RBClassVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 7/3/2009 20:34'!
rationale
	^ 'Class and pool variable names should start with an uppercase letter.'! !

!RBClassVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Intention revealing'! !

!RBClassVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Class variable capitalization'! !

!RBClassVariableCapitalizationRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 10:02'!
category
	^ 'Style'! !

!RBClassVariableCapitalizationRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:48'!
checkClass: aClass 
	aClass isMeta
		ifTrue: [ ^ self ].
	aClass classVarNames do: [ :each | 
		each first isUppercase ifFalse: [
			result 
				addClass: aClass
				classVariable: each ] ].
	aClass sharedPoolNames do: [ :each | 
		each first isUppercase ifFalse: [ 
			result 
				addClass: aClass
				classVariable: each ] ]! !

!RBClassVariableCapitalizationRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'ClassVariableCapitalizationRule'! !

!RBCodeCruftLeftInMethodsRule commentStamp: 'StephaneDucasse 11/29/2014 17:59'!
This smell arises when a breakpoint,  logging statement,  etc is found in a method. This debugging code should not be left in production code.  Here are messages currently checked: clearHaltOnce,  doOnlyOnce: ,  halt, halt:   onCount:  object2, haltOnCount: , haltOnce, hatIf: , inspectOnCount: , inspectOnce, inspectUntilCount: , rearmOneShot, setHaltOnce, flag: , isThisEverCalled, isThisEverCalled: , logEntry, logExecution, logExit, needsWork and Transcript  messages.!
!RBCodeCruftLeftInMethodsRule methodsFor: 'initialization' stamp: 'KrisGybels 10/20/2014 10:40'!
initialize
	super initialize.
	#('`@object clearHaltOnce' '`@object doOnlyOnce: `@object1' '`@object halt' '`@object halt: `@object1 onCount: `@object2' '`@object haltOnCount: `@object1' '`@object haltOnce' '`@object haltIf: `@object1' '`@object inspectOnCount: `@object1' '`@object inspectOnce' '`@object inspectUntilCount: `@object1' '`@object rearmOneShot' '`@object setHaltOnce' '`@object flag: `@object1' '`@object isThisEverCalled' '`@object isThisEverCalled: `@object1' '`@object logEntry' '`@object logExecution' '`@object logExit' '`@object needsWork' 'Transcript `@message: `@object1')
		do: [ :matchingString | self rewriteRule replace: matchingString with: '' ]! !

!RBCodeCruftLeftInMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
rationale
	^ 'Breakpoints, logging statements, etc. should not be left in production code.'! !

!RBCodeCruftLeftInMethodsRule methodsFor: 'accessing' stamp: 'lr 3/17/2010 17:54'!
group
	^ 'Pharo bugs'! !

!RBCodeCruftLeftInMethodsRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:11'!
severity
	^ #error! !

!RBCodeCruftLeftInMethodsRule methodsFor: 'accessing' stamp: 'Simon 8/30/2012 14:49'!
category 
	^ 'Bugs'! !

!RBCodeCruftLeftInMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Debugging code left in methods'! !

!RBCodeCruftLeftInMethodsRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'CodeCruftLeftInMethodsRule'! !

!RBCollectSelectNotUsedRule commentStamp: 'StephaneDucasse 11/29/2014 21:23'!
Checks for senders of typical collection enumeration methods that return an unused result.

For example, check that the result of a select: or detect: is used.!
!RBCollectSelectNotUsedRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:20'!
initialize
	super initialize.
	self matcher 
		matches: '`{:node | node isMessage and: [(#(#select: #collect: #reject:) includes: node selector) and: [node isUsed not]]}'
		do: [ :node :answer | node ]! !

!RBCollectSelectNotUsedRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 17:34'!
rationale
	^ 'Checks for senders of typical collection enumeration methods that return an unused result.'! !

!RBCollectSelectNotUsedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Intention revealing'! !

!RBCollectSelectNotUsedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Doesn''t use the result of a collect:/select:'! !

!RBCollectSelectNotUsedRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 16:24'!
category 	
	^ 'Optimization'! !

!RBCollectSelectNotUsedRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'CollectSelectNotUsedRule'! !

!RBCollectionCopyEmptyRule commentStamp: 'StephaneDucasse 11/29/2014 21:11'!
Checks that all subclasses of the Collection classes that add an instance variable also redefine the copyEmpty method. This method is used when the collection grows. It copies over the necessary instance variables to the new larger collection.!
!RBCollectionCopyEmptyRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'!
resultClass
	^ RBClassEnvironment! !

!RBCollectionCopyEmptyRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Possible bugs'! !

!RBCollectionCopyEmptyRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Subclass of collection that has instance variable but doesn''t define copyEmpty'! !

!RBCollectionCopyEmptyRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 10:04'!
category 
	^ 'Potential Bugs'! !

!RBCollectionCopyEmptyRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:48'!
checkClass: aClass 
	((aClass inheritsFrom: Collection)
	and: [ aClass isVariable 
	and: [ (aClass includesSelector: #copyEmpty) not 
	and: [ aClass instVarNames isEmpty not ]]])
		ifTrue: [ result addClass: aClass ]! !

!RBCollectionCopyEmptyRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'CollectionCopyEmptyRule'! !

!RBCollectionMessagesToExternalObjectRule commentStamp: 'StephaneDucasse 11/29/2014 21:24'!
Checks for methods that appear to be modifying a collection that is owned by another object. Such modifications can cause problems especially if other variables are modified when the collection is modified. For example, CompositePart must set the containers of all its parts when adding a new component.!
!RBCollectionMessagesToExternalObjectRule methodsFor: 'initialization' stamp: 'lr 7/23/2010 08:03'!
initialize
	| queries |
	super initialize.
	queries := #( add: remove: addAll: removeAll: )
		collect: [ :each | '(`@Object `@message: `@args) <1s> `@Arg' expandMacrosWith: each ].
	self matcher 
		matchesAnyOf: queries
		do: [ :node :answer |
			answer isNil 
				ifTrue: [
					((node receiver selector copyFrom: 1 to: (node receiver selector size min: 2)) ~= 'as' 
						and: [
							| receiver |
							receiver := node receiver receiver.
							receiver isVariable not 
								or: [ ((#('self' 'super') includes: receiver name) 
								or: [ Smalltalk globals includesKey: receiver name asSymbol ]) not ] ]) 
							ifTrue: [ node ]
							ifFalse: [ nil ] ]
				ifFalse: [ answer ] ]! !

!RBCollectionMessagesToExternalObjectRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 21:24'!
rationale
	^ 'Checks for methods that appear to be modifying a collection that is owned by another object.'! !

!RBCollectionMessagesToExternalObjectRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Intention revealing'! !

!RBCollectionMessagesToExternalObjectRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Sends add:/remove: to external collection'! !

!RBCollectionMessagesToExternalObjectRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 16:21'!
category
	^'Coding Idiom Violation'! !

!RBCollectionMessagesToExternalObjectRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'CollectionMessagesToExternalObjectRule'! !

!RBCollectionProtocolRule commentStamp: 'StephaneDucasse 11/29/2014 21:25'!
Checks code using the do: method instead of using the collect: or select: methods. This often occurs with new people writing code. The collect: and select: variants express the source code''s intentions better.!
!RBCollectionProtocolRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:23'!
initialize
	super initialize.
	self matcher 
		matchesAnyOf: #(
			'`@collection do: [:`each | | `@temps | `@.Statements1. `@object add: `@arg. `@.Statements2]'
			'`@collection do: [:`each | | `@temps | 
				`@.Statements1. 
				`@condition ifTrue: [| `@blockTemps | 
						`@.BlockStatements1. 
						`@object add: `each. 
						`@.BlockStatements2]. 
				`@.Statements2]'
			'`@collection do: [:`each | | `@temps | 
				`@.Statements1. 
				`@condition ifFalse: [| `@blockTemps | 
						`@.BlockStatements1. 
						`@object add: `each. 
						`@.BlockStatements2]. 
				`@.Statements2]' )
		do: [ :node :answer | node ]! !

!RBCollectionProtocolRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 21:25'!
rationale
	^ 'Checks for code using the do: method instead of using the collect: or select: methods.'! !

!RBCollectionProtocolRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Intention revealing'! !

!RBCollectionProtocolRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Uses do: instead of collect: or select:''s'! !

!RBCollectionProtocolRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 16:22'!
category
	^'Coding Idiom Violation'! !

!RBCollectionProtocolRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'CollectionProtocolRule'! !

!RBComment commentStamp: '<historical>'!
A RBComment represents a text comment associated to an AST node.!
!RBComment methodsFor: 'accessing' stamp: 'PabloHerrero 1/5/2015 16:35'!
stop
	^ start + self size - 1! !

!RBComment methodsFor: 'accessing' stamp: 'PabloHerrero 1/5/2015 16:35'!
size
	^ contents size + 2 "must take into account quotation marks"! !

!RBComment methodsFor: 'initialize-release' stamp: 'PabloHerrero 11/7/2013 17:30'!
with: aString at: startPosition
	start := startPosition.
	contents := aString.
! !

!RBComment methodsFor: 'accessing' stamp: 'PabloHerrero 1/5/2015 11:03'!
start
	^ start.! !

!RBComment methodsFor: 'accessing' stamp: 'PabloHerrero 1/5/2015 11:03'!
contents
	^ contents! !

!RBComment class methodsFor: 'instance creation' stamp: 'PabloHerrero 11/7/2013 17:31'!
with: aString at: startPosition
	^ self new
		with: aString at: startPosition;
		yourself. 
	! !

!RBCommentChange methodsFor: 'accessing' stamp: 'lr 7/1/2008 10:41'!
comment: aString 
	comment := aString! !

!RBCommentChange methodsFor: 'printing' stamp: 'StephaneDucasse 9/13/2013 21:45'!
printOn: aStream 
	aStream
		nextPutAll: self displayClassName;
		nextPutAll: ' classComment: ';
		print: (self comment copyReplaceAll: '!!' with: '!!!!');
		nextPutAll: ' stamp: ';
		print: (self changeStamp);
		nextPutAll: '!!'! !

!RBCommentChange methodsFor: 'accessing' stamp: 'lr 7/1/2008 10:44'!
changeClass: aBehavior
	super changeClass: aBehavior.
	isMeta := false! !

!RBCommentChange methodsFor: 'private' stamp: 'StephaneDucasse 9/13/2013 21:45'!
primitiveExecute
	self changeClass 
		classComment: comment
		stamp: self changeStamp.
	SystemAnnouncer uniqueInstance 
		classCommented: self changeClass! !

!RBCommentChange methodsFor: 'printing' stamp: 'lr 7/1/2008 10:48'!
changeString
	^ 'Comment ' , self displayClassName! !

!RBCommentChange methodsFor: 'accessing' stamp: 'lr 7/1/2008 10:41'!
comment
	^ comment! !

!RBCommentChange methodsFor: 'converting' stamp: 'lr 9/6/2010 10:48'!
asUndoOperation
	^ self copy
		comment: self changeClass organization classComment;
		yourself! !

!RBCommentChange class methodsFor: 'instance creation' stamp: 'lr 7/1/2008 10:50'!
comment: aString in: aClass
	^ self new
		changeClass: aClass;
		comment: aString;
		yourself! !

!RBCompositeLintRule commentStamp: '<historical>'!
A RBCompositeLintRule is a composite rule holding rules.!
!RBCompositeLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:09'!
changes
	^ rules gather: [ :each  | each changes ]! !

!RBCompositeLintRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/21/2012 18:25'!
leaves

	^ rules gather: [ :rule | rule leaves ]	
! !

!RBCompositeLintRule methodsFor: 'testing' stamp: 'lr 2/23/2009 21:12'!
isEmpty
	^ rules allSatisfy: [ :each | each isEmpty ]! !

!RBCompositeLintRule methodsFor: 'testing' stamp: 'lr 2/23/2009 21:11'!
isComposite
	^ true! !

!RBCompositeLintRule methodsFor: 'testing' stamp: 'lr 2/23/2009 21:11'!
hasConflicts
	^ rules anySatisfy: [ :each | each hasConflicts ]! !

!RBCompositeLintRule methodsFor: 'adding/removing' stamp: 'StephaneDucasse 11/21/2012 18:25'!
removeRule: aRule

	(rules anySatisfy: [ :rule | rule name = aRule name] )
		ifTrue: [rules := rules reject:  [ :rule | rule name = aRule name]]
		 ifFalse: [rules do: [ :rule |
				rule isComposite 
					ifTrue: [rule removeRule: aRule]]] ! !

!RBCompositeLintRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 16:48'!
checkMethod: aMethod 
	rules do: [ :each | each checkMethod: aMethod ]! !

!RBCompositeLintRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:49'!
checkClass: aClass 
	rules do: [ :each | each checkClass: aClass ]! !

!RBCompositeLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:33'!
name: aString
	name := aString! !

!RBCompositeLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:11'!
problemCount
	^ rules inject: 0 into: [ :count :each | count + each problemCount ]! !

!RBCompositeLintRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 21:11'!
resetResult
	rules do: [ :each | each resetResult ]! !

!RBCompositeLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:32'!
rules: aCollection
	rules := aCollection! !

!RBCompositeLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:11'!
rules
	^ rules! !

!RBCompositeLintRule methodsFor: 'adding/removing' stamp: 'StephaneDucasse 3/21/2013 09:46'!
sort: aBlock
	
	rules first isComposite
		ifTrue: [ rules do: [ :rule | rule sort: aBlock ]] 
		ifFalse: [ self rules: (rules sort: aBlock) ]! !

!RBCompositeLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:32'!
name
	^ name! !

!RBCompositeLintRule class methodsFor: '*Manifest-Core' stamp: 'SimonAllier 9/7/2012 11:08'!
rulesClassifiedFor: aRuleClass
	| groups rules |
	groups := Dictionary new.
	(self rulesFor: aRuleClass) do: [ :each |
		(groups at: each category ifAbsentPut: [ OrderedCollection new ])
			addLast: each ].
	rules := SortedCollection sortBlock: [ :a :b | a name <= b name ].
	groups keysAndValuesDo: [ :group :elements |
		rules addLast: (RBCompositeLintRule 
			rules: elements asArray
			name: group) ].
	^ rules asArray! !

!RBCompositeLintRule class methodsFor: 'instance creation' stamp: 'lr 2/23/2009 21:55'!
rules: aCollection
	^ self new
		rules: aCollection;
		yourself! !

!RBCompositeLintRule class methodsFor: 'accessing' stamp: 'lr 2/23/2009 22:48'!
transformations
	^ self rules: (self rulesGroupedFor: RBTransformationRule) name: 'Transformations'! !

!RBCompositeLintRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'CompositeLintRule'! !

!RBCompositeLintRule class methodsFor: '*Manifest-Core' stamp: 'MarcusDenker 10/3/2013 22:26'!
removedRules
	^ {(RBCompositeLintRule new name: 'Spelling').  
		RBMissingTranslationsInMenusRule new. 
		RBGuardingClauseRule new. 
		RBAssignmentWithoutEffectRule new.
		RBUtilityMethodsRule new.
		RBMethodHasNoTimeStampRule new. }
	
! !

!RBCompositeLintRule class methodsFor: 'instance creation' stamp: 'lr 2/23/2009 21:56'!
rules: aCollection name: aString
	^ self new
		rules: aCollection;
		name: aString;
		yourself! !

!RBCompositeLintRule class methodsFor: 'instance creation' stamp: 'lr 2/23/2009 22:44'!
rulesGroupedFor: aRuleClass
	| groups rules |
	groups := Dictionary new.
	(self rulesFor: aRuleClass) do: [ :each |
		(groups at: each group ifAbsentPut: [ OrderedCollection new ])
			addLast: each ].
	rules := SortedCollection sortBlock: [ :a :b | a name <= b name ].
	groups keysAndValuesDo: [ :group :elements |
		rules addLast: (RBCompositeLintRule 
			rules: elements asArray
			name: group) ].
	^ rules asArray! !

!RBCompositeLintRule class methodsFor: 'accessing' stamp: 'lr 2/23/2009 22:50'!
allRules
	^ self rules: (Array with: self lintChecks with: self transformations) name: 'All checks'! !

!RBCompositeLintRule class methodsFor: 'accessing' stamp: 'lr 2/23/2009 22:48'!
lintChecks
	^ self rules: (self rulesGroupedFor: RBBasicLintRule) name: 'Lint checks'! !

!RBCompositeLintRule class methodsFor: '*Manifest-Core' stamp: 'StephaneDucasse 11/29/2014 17:18'!
allGoodRules
	| rules |
	rules := self rules: (self rulesClassifiedFor: RBLintRule) name: 'All Rules'.
	self removedRules do: [ :r | rules removeRule: r ].
	rules removeRule: (RBCompositeLintRule new name: 'Spelling').
	rules removeRule: RBMissingTranslationsInMenusRule new.
	rules removeRule: RBGuardingClauseRule new.
	^ rules! !

!RBCompositeLintRule class methodsFor: 'instance creation' stamp: 'lr 2/24/2009 17:11'!
rulesFor: aRuleClass
	| rules |
	rules := SortedCollection
		sortBlock: [ :a :b | a name <= b name ].
	aRuleClass withAllSubclassesDo: [ :each |
		each isVisible
			ifTrue: [ rules add: each new ] ].
	^ rules asArray! !

!RBCompositeLintRuleTest methodsFor: 'initialize-release' stamp: ''!
rules: aCollection
	rules := aCollection! !

!RBCompositeLintRuleTest methodsFor: 'accessing' stamp: ''!
problemCount
	^rules inject: 0 into: [:count :each | count + each problemCount]! !

!RBCompositeLintRuleTest methodsFor: 'testing' stamp: ''!
isEmpty
	^(rules detect: [:each | each isEmpty not] ifNone: [nil]) isNil! !

!RBCompositeLintRuleTest methodsFor: 'initialize-release' stamp: ''!
resetResult
	rules do: [:each | each resetResult]! !

!RBCompositeLintRuleTest methodsFor: 'accessing' stamp: ''!
rules
	^rules! !

!RBCompositeLintRuleTest methodsFor: 'testing' stamp: ''!
isComposite
	^true! !

!RBCompositeLintRuleTest methodsFor: 'accessing' stamp: ''!
failedRules
	^rules inject: OrderedCollection new into: [:oc :each | oc addAll: each failedRules; yourself]! !

!RBCompositeLintRuleTest methodsFor: 'testing' stamp: ''!
hasConflicts
	^(rules detect: [:each | each hasConflicts] ifNone: [nil]) notNil! !

!RBCompositeLintRuleTest methodsFor: 'private' stamp: ''!
viewResults
	rules do: [:each | each viewResults]! !

!RBCompositeLintRuleTest methodsFor: 'accessing' stamp: ''!
checkMethod: aSmalllintContext 
	rules do: 
			[:each | 
			each checkMethod: aSmalllintContext.
			Processor yield]! !

!RBCompositeLintRuleTest methodsFor: 'accessing' stamp: ''!
checkClass: aSmalllintContext 
	rules do: 
			[:each | 
			each checkClass: aSmalllintContext.
			Processor yield]! !

!RBCompositeLintRuleTest class methodsFor: 'instance creation' stamp: ''!
rules: aCollection name: aString 
	^(self new) rules: aCollection;
		name: aString;
		yourself! !

!RBCompositeLintRuleTest class methodsFor: 'instance creation' stamp: ''!
rules: aCollection 
	^self new rules: aCollection! !

!RBCompositeLintRuleTest class methodsFor: 'all checks' stamp: 'lr 2/26/2009 14:51'!
transformations
	^ self 
		ruleFor: RBTransformationRuleTest
		protocol: 'transformations'! !

!RBCompositeLintRuleTest class methodsFor: 'instance creation' stamp: 'lr 9/8/2011 20:25'!
ruleFor: aClass protocol: aProtocol 
	^self
		rules: (((RBBrowserEnvironment new selectorsFor: aProtocol asSymbol in: aClass class)
				collect: [:selector | aClass perform: selector])
					asSortedCollection: [:a :b | a name < b name])
		name: ((aProtocol asString copy) at: 1 put: aProtocol first asUppercase;
				yourself)! !

!RBCompositeLintRuleTest class methodsFor: 'instance creation' stamp: ''!
allRules
	^self ruleFor: self protocol: 'all checks'! !

!RBCompositeLintRuleTest class methodsFor: 'all checks' stamp: 'MarcusDenker 9/4/2014 15:52'!
lintChecks
	^ self 
		rules: (RBBasicLintRuleTest protocolsToCheck collect: 
			[ :each | 
			self 
				ruleFor: RBBasicLintRuleTest
				protocol: each ])
		name: 'Lint checks'! !

!RBCompositeRefactoryChange methodsFor: 'private-inspector accessing' stamp: 'lr 9/6/2010 17:28'!
changes
	^ changes! !

!RBCompositeRefactoryChange methodsFor: 'refactory-changes' stamp: 'lr 9/8/2011 20:10'!
addInstanceVariable: variableName to: aClass 
	^ self addChange: (RBAddInstanceVariableChange add: variableName to: aClass)! !

!RBCompositeRefactoryChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 11:30'!
changeForMetaclass: aClassName selector: aSelector 
	changes reverseDo: [ :each | 
		| change |
		change := each changeForMetaclass: aClassName selector: aSelector.
		change notNil ifTrue: [ ^ change ] ].
	^ nil! !

!RBCompositeRefactoryChange methodsFor: 'refactory-changes' stamp: 'lr 9/8/2011 20:10'!
compile: source in: class 
	^ self addChange: (RBAddMethodChange compile: source in: class)! !

!RBCompositeRefactoryChange methodsFor: 'private' stamp: 'lr 5/9/2010 11:31'!
executeNotifying: aBlock 
	| undos undo |
	undos := changes collect: [ :each | each executeNotifying: aBlock ].
	undo := self copy.
	undo changes: undos reversed.
	^ undo! !

!RBCompositeRefactoryChange methodsFor: 'refactory-changes' stamp: 'lr 9/8/2011 20:10'!
removeInstanceVariable: variableName from: aClass 
	^ self addChange: (RBRemoveInstanceVariableChange remove: variableName from: aClass)! !

!RBCompositeRefactoryChange methodsFor: 'refactory-changes' stamp: 'lr 9/8/2011 20:10'!
addClassVariable: variableName to: aClass 
	^ self addChange: (RBAddClassVariableChange add: variableName to: aClass)! !

!RBCompositeRefactoryChange methodsFor: 'initialization' stamp: ''!
initialize
	super initialize.
	changes := OrderedCollection new! !

!RBCompositeRefactoryChange methodsFor: 'refactory-changes' stamp: 'lr 9/8/2011 20:10'!
defineClass: aString 
	^ self addChange: (RBAddClassChange definition: aString)! !

!RBCompositeRefactoryChange methodsFor: 'printing' stamp: 'lr 9/6/2010 17:28'!
printOn: aStream 
	name isNil
		ifTrue: [ ^ super printOn: aStream ].
	aStream nextPutAll: name! !

!RBCompositeRefactoryChange methodsFor: 'private-inspector accessing' stamp: ''!
changes: aCollection 
	changes := aCollection! !

!RBCompositeRefactoryChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 17:27'!
addChange: aRefactoryChange 
	changes add: aRefactoryChange.
	^ aRefactoryChange! !

!RBCompositeRefactoryChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 13:56'!
renameChangesForClass: oldClassName to: newClassName
	^ self copy
		changes: (self changes 
			collect: [ :each | each renameChangesForClass: oldClassName to: newClassName ]);
		yourself! !

!RBCompositeRefactoryChange methodsFor: 'refactory-changes' stamp: 'lr 9/8/2011 20:10'!
removeClass: aClass 
	^ self addChange: (RBRemoveClassChange removeClassName: aClass name)! !

!RBCompositeRefactoryChange methodsFor: 'comparing' stamp: 'lr 9/6/2010 17:31'!
hash
	^ self class hash bitXor: self changes size hash! !

!RBCompositeRefactoryChange methodsFor: 'refactory-changes' stamp: 'lr 9/8/2011 20:10'!
comment: aString in: aClass 
	^ self addChange: (RBCommentChange comment: aString in: aClass)! !

!RBCompositeRefactoryChange methodsFor: 'refactory-changes' stamp: 'lr 9/8/2011 20:10'!
removeMethod: aSelector from: aClass 
	^ self addChange: (RBRemoveMethodChange remove: aSelector from: aClass)! !

!RBCompositeRefactoryChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 11:29'!
changeForClass: aClassName selector: aSelector 
	changes reverseDo: [ :each | 
		| change |
		change := each changeForClass: aClassName selector: aSelector.
		change notNil ifTrue: [ ^ change ] ].
	^ nil! !

!RBCompositeRefactoryChange methodsFor: 'refactory-changes' stamp: 'lr 9/8/2011 20:10'!
removeClassNamed: aSymbol 
	^ self addChange: (RBRemoveClassChange removeClassName: aSymbol)! !

!RBCompositeRefactoryChange methodsFor: 'refactory-changes' stamp: 'lr 9/8/2011 20:10'!
removePool: aPoolVariable from: aClass 
	^ self addChange: (RBRemovePoolVariableChange remove: aPoolVariable from: aClass)! !

!RBCompositeRefactoryChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 17:27'!
changesSize
	^ changes inject: 0 into: [ :sum :each | sum + each changesSize ]! !

!RBCompositeRefactoryChange methodsFor: 'refactory-changes' stamp: 'lr 9/8/2011 20:10'!
addPool: aPoolVariable to: aClass 
	^ self addChange: (RBAddPoolVariableChange add: aPoolVariable to: aClass)! !

!RBCompositeRefactoryChange methodsFor: 'refactory-changes' stamp: 'lr 9/8/2011 20:10'!
renameInstanceVariable: oldName to: newName in: aClass
	^ self addChange: (RBRenameInstanceVariableChange rename: oldName to: newName in: aClass)! !

!RBCompositeRefactoryChange methodsFor: 'refactory-changes' stamp: 'lr 9/8/2011 20:10'!
renameClass: class to: newName 
	^ self addChange: (RBRenameClassChange rename: class name to: newName)! !

!RBCompositeRefactoryChange methodsFor: 'refactory-changes' stamp: 'lr 9/8/2011 20:10'!
renameClassVariable: oldName to: newName in: aClass
	^ self addChange: (RBRenameClassVariableChange rename: oldName to: newName in: aClass)! !

!RBCompositeRefactoryChange methodsFor: 'comparing' stamp: 'lr 9/6/2010 17:27'!
= aRefactoryBuilder 
	self class = aRefactoryBuilder class
		ifFalse: [ ^ false ].
	changes size = aRefactoryBuilder changes size
		ifFalse: [ ^ false ].
	changes with: aRefactoryBuilder changes do: [ :first :second |
		first = second
			ifFalse: [ ^ false ] ].
	^ true! !

!RBCompositeRefactoryChange methodsFor: 'copying' stamp: 'lr 9/6/2010 17:27'!
postCopy
	super postCopy.
	changes := changes collect: [ :each | each copy ]! !

!RBCompositeRefactoryChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 17:27'!
problemCount
	^ self changesSize! !

!RBCompositeRefactoryChange methodsFor: 'refactory-changes' stamp: 'lr 9/8/2011 20:10'!
compile: source in: class classified: aProtocol 
	^ self addChange: (RBAddMethodChange compile: source in: class classified: aProtocol)! !

!RBCompositeRefactoryChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 17:29'!
removeChange: aChange 
	^ changes remove: aChange ifAbsent: [ nil ]! !

!RBCompositeRefactoryChange methodsFor: 'refactory-changes' stamp: 'lr 9/8/2011 20:10'!
removeClassVariable: variableName from: aClass 
	^ self addChange: (RBRemoveClassVariableChange remove: variableName from: aClass)! !

!RBCompositeRefactoryChange methodsFor: '*NautilusRefactoring' stamp: ''!
whatToDisplayIn: aBrowser

	^ self changes gather: [:each | each whatToDisplayIn: aBrowser ]! !

!RBCompositeRefactoryChange class methodsFor: 'instance creation' stamp: 'lr 9/7/2010 19:43'!
named: aString
	^ self new
		name: aString;
		yourself! !

!RBCondition methodsFor: 'printing' stamp: 'bh 4/10/2001 16:51'!
printOn: aStream 
	aStream nextPutAll: type asString! !

!RBCondition methodsFor: 'initialize-release' stamp: ''!
errorBlock: anObject
	errorBlock := anObject! !

!RBCondition methodsFor: 'initialize-release' stamp: 'lr 11/19/2009 11:45'!
type: aSymbol block: aBlock errorString: aString 
 	type := aSymbol.
	block := aBlock.
	self errorMacro: aString! !

!RBCondition methodsFor: 'accessing' stamp: ''!
errorBlockFor: aBoolean
	^errorBlock! !

!RBCondition methodsFor: 'checking' stamp: ''!
check
	^block value! !

!RBCondition methodsFor: 'initialize-release' stamp: ''!
withBlock: aBlock 
	block := aBlock.
	type := #(#generic)! !

!RBCondition class methodsFor: 'utilities' stamp: ''!
checkInstanceVariableName: aName in: aClass 
	| string |
	aName isString ifFalse: [^false].
	string := aName asString.
	string isEmpty ifTrue: [^false].
	(self reservedNames includes: string) ifTrue: [^false].
	string first isUppercase ifTrue: [^false].
	^RBScanner isVariable: string! !

!RBCondition class methodsFor: 'instance creation' stamp: ''!
isMetaclass: anObject 
	^self new type: (Array with: #IsMetaclass with: anObject)
		block: [anObject isMeta]
		errorString: anObject printString , ' is <1?:not >a metaclass'! !

!RBCondition class methodsFor: 'instance creation' stamp: ''!
isSymbol: aString
	^self new
		type: (Array with: #isSymbol with: aString)
		block: [aString isSymbol]
		errorString: aString , ' is <1?:not >a symbol'! !

!RBCondition class methodsFor: 'instance creation' stamp: ''!
withBlock: aBlock errorString: aString 
	^self new type: #unknown
		block: aBlock
		errorString: aString! !

!RBCondition class methodsFor: 'instance creation' stamp: 'lr 12/7/2011 21:48'!
isSubclass: subclass of: superClass
	^self new
		type: (Array with: #subclass with: superClass with: subclass)
		block: [subclass includesClass: superClass]
		errorString: subclass printString , ' is <1?:not >a subclass of ' , superClass printString! !

!RBCondition class methodsFor: 'instance creation' stamp: 'GiselaDecuzzi 4/22/2013 17:39'!
canUnderstand: aSelector in: aClass
	^self new
		type: (Array with: #understandsSelector with: aClass with: aSelector)
		block: [aClass canUnderstand: aSelector]
		errorString: aClass printString , ' <1?:does not >understand<1?s:> ' , aSelector printString! !

!RBCondition class methodsFor: 'instance creation' stamp: ''!
isValidInstanceVariableName: aString for: aClass 
	^self new 
		type: (Array 
				with: #validInstVarName
				with: aString
				with: aClass)
		block: [self checkInstanceVariableName: aString in: aClass]
		errorString: aString , ' is <1?:not >a valid instance variable name'! !

!RBCondition class methodsFor: 'instance creation' stamp: ''!
definesTempVar: aString in: aClass ignoreClass: subclass 
	| condition |
	condition := self new.
	condition 
		type: (Array with: #definesTempVarIgnoring with: aClass with: aString with: subclass)
		block: 
			[| method |
			method := self 
						methodDefiningTemporary: aString
						in: aClass
						ignore: [:class :aSelector | class includesClass: subclass].
			method notNil 
				ifTrue: 
					[condition errorMacro: method printString , ' defines variable ' , aString].
			method notNil]
		errorString: aClass printString 
				, ' <1?:does not >define<1?s:> temporary variable ' , aString.
	^condition! !

!RBCondition class methodsFor: 'instance creation' stamp: ''!
isEmptyClass: anObject 
	^self new type: (Array with: #IsEmptyClass with: anObject)
		block: 
			[anObject classVariableNames isEmpty
				and: [anObject instanceVariableNames isEmpty and: [anObject selectors isEmpty]]]
		errorString: anObject printString , ' is <1?:not > empty'! !

!RBCondition class methodsFor: 'instance creation' stamp: ''!
subclassesOf: aClass referToSelector: aSelector 
	^self new 
		type: (Array 
				with: #subclassReferences
				with: aClass
				with: aSelector)
		block: 
			[(aClass subclasses detect: 
					[:each | 
					(each selectors detect: 
							[:sel | 
							| tree |
							tree := each parseTreeFor: sel.
							tree notNil and: [tree superMessages includes: aSelector]]
						ifNone: [nil]) notNil]
				ifNone: [nil]) notNil]
		errorString: '<1?:no:a> subclass of ' , aClass printString , ' refers to ' 
				, aSelector printString! !

!RBCondition class methodsFor: 'instance creation' stamp: ''!
referencesInstanceVariable: aString in: aClass 
	^self new 
		type: (Array with: #referencesInstVar with: aClass with: aString)
		block: [(aClass whichSelectorsReferToInstanceVariable: aString) isEmpty not]
		errorString: aClass printString 
				, ' <1?:does not >reference<1?s:> instance variable ' , aString! !

!RBCondition class methodsFor: 'instance creation' stamp: ''!
isGlobal: aString in: aRBSmalltalk 
	^self new 
		type: (Array with: #isGlobal with: aString)
		block: [aRBSmalltalk includesGlobal: aString asSymbol]
		errorString: aString , ' is <1?:not >a class or global variable'! !

!RBCondition class methodsFor: 'instance creation' stamp: ''!
isValidClassName: aString
	^self new
		type: (Array with: #validClassName with: aString)
		block: [self validClassName: aString]
		errorString: aString , ' is <1?:not >a valid class name'! !

!RBCondition class methodsFor: 'instance creation' stamp: ''!
hierarchyOf: aClass canUnderstand: aSelector
	^self new
		type: (Array with: #hierarchyUnderstandsSelector with: aClass with: aSelector)
		block: [aClass hierarchyDefinesMethod: aSelector]
		errorString: aClass printString , ' <1?or a subclass:and all subclasses do not> understand<1?s:> ' , aSelector printString! !

!RBCondition class methodsFor: 'utilities' stamp: 'lr 11/2/2009 00:14'!
methodDefiningTemporary: aString in: aClass ignore: aBlock 
	| searcher method |
	searcher := RBParseTreeSearcher new.
	method := nil.	"Shut-up the warning"
	searcher matches: aString do: [:aNode :answer | ^method].
	aClass withAllSubclasses do: 
			[:class | 
			class selectors do: 
					[:each | 
					(aBlock value: class value: each) 
						ifFalse: 
							[| parseTree |
							method := class methodFor: each.
							parseTree := class parseTreeFor: each.
							parseTree notNil ifTrue: [searcher executeTree: parseTree]]]].
	^nil! !

!RBCondition class methodsFor: 'instance creation' stamp: ''!
empty
	"Returns an empty condition"

	^self new 
		type: (Array with: #empty)
		block: [true]
		errorString: 'Empty'! !

!RBCondition class methodsFor: 'instance creation' stamp: ''!
isValidMethodName: aString for: aClass
	^self new
		type: (Array with: #validMethodName with: aString with: aClass)
		block: [self checkMethodName: aString in: aClass]
		errorString: aString printString , ' is <1?:not >a valid method name'! !

!RBCondition class methodsFor: 'instance creation' stamp: ''!
hierarchyOf: aClass referencesInstanceVariable: aString 
	^self new 
		type: (Array 
				with: #hierarchyReferencesInstVar
				with: aClass
				with: aString)
		block: 
			[(aClass withAllSubclasses 
				detect: [:each | (each whichSelectorsReferToInstanceVariable: aString) isEmpty not]
				ifNone: [nil]) notNil]
		errorString: aClass printString 
				, ' or subclass <1?:does not >reference<1?s:> instance variable ' , aString! !

!RBCondition class methodsFor: 'instance creation' stamp: ''!
isAbstractClass: aClass 
	^self new 
		type: (Array with: #IsAbstractClass with: aClass)
		block: [aClass isAbstract]
		errorString: aClass printString , ' is <1?:not >an abstract class'! !

!RBCondition class methodsFor: 'utilities' stamp: ''!
checkMethodName: aName in: aClass 
	^aName isString and: [RBScanner isSelector: aName]! !

!RBCondition class methodsFor: 'instance creation' stamp: ''!
isImmediateSubclass: subclass of: superClass
	^self new
		type: (Array with: #immediateSubclass with: superClass with: subclass)
		block: [subclass superclass = superClass]
		errorString: subclass printString , ' is <1?:not >an immediate subclass of ' , superClass printString! !

!RBCondition class methodsFor: 'instance creation' stamp: ''!
hierarchyOf: aClass definesVariable: aString 
	^self new 
		type: (Array 
				with: #hierarchyDefinesInstVar
				with: aClass
				with: aString)
		block: [aClass hierarchyDefinesVariable: aString]
		errorString: aClass printString 
				, ' or one of its subclasses <1?:does not >define<1?s:> variable ' 
					, aString! !

!RBCondition class methodsFor: 'utilities' stamp: ''!
reservedNames
	^#('self' 'true' 'false' 'nil' 'thisContext' 'super')! !

!RBCondition class methodsFor: 'instance creation' stamp: ''!
isClass: anObject
	^self new
		type: (Array with: #IsClass with: anObject)
		block: [anObject isBehavior]
		errorString: anObject printString , ' is <1?:not >a behavior'! !

!RBCondition class methodsFor: 'utilities' stamp: ''!
validClassName: aString 
	"Class names and class variable names have the same restrictions"

	^self checkClassVarName: aString in: self! !

!RBCondition class methodsFor: 'instance creation' stamp: ''!
directlyDefinesInstanceVariable: aString in: aClass 
	^self new 
		type: (Array with: #directlyDefinesInstanceVariable with: aClass with: aString)
		block: [aClass directlyDefinesInstanceVariable: aString]
		errorString: aClass printString 
				, ' <1?:does not >directly define<1?s:> instance variable ' , aString! !

!RBCondition class methodsFor: 'instance creation' stamp: ''!
isValidClassVarName: aString for: aClass
	^self new
		type: (Array with: #validClassVarName with: aString with: aClass)
		block: [self checkClassVarName: aString in: aClass]
		errorString: aString , ' is <1?:not >a valid class variable name'! !

!RBCondition class methodsFor: 'instance creation' stamp: ''!
withBlock: aBlock
	^self new withBlock: aBlock! !

!RBCondition class methodsFor: 'instance creation' stamp: ''!
definesSelector: aSelector in: aClass 
	^self new
		type: (Array with: #definesSelector with: aClass with: aSelector)
		block: [aClass directlyDefinesMethod: aSelector]
		errorString: aClass printString , ' <1?:does not >define<1?s:> ' , aSelector printString! !

!RBCondition class methodsFor: 'instance creation' stamp: ''!
definesTemporaryVariable: aString in: aClass 
	| condition |
	condition := self new.
	condition 
		type: (Array with: #definesTempVar with: aClass with: aString)
		block: 
			[| method |
			method := self 
						methodDefiningTemporary: aString
						in: aClass
						ignore: [:class :selector | false].
			method notNil 
				ifTrue: 
					[condition errorMacro: method printString , ' defines variable ' , aString].
			method notNil]
		errorString: aClass printString 
				, ' <1?:does not >define<1?s:> temporary variable ' , aString.
	^condition! !

!RBCondition class methodsFor: '*SmartSuggestions' stamp: 'GiselaDecuzzi 4/23/2013 15:43'!
hasInstanceVariable: aClass 
	^self new 
		type: (Array with: aClass)
		block: [aClass allInstVarNames isEmpty not]
		errorString: aClass printString 
				, ' <1?:does not >define any instance variable ' , aClass asString 
! !

!RBCondition class methodsFor: 'utilities' stamp: ''!
checkClassVarName: aName in: aClass 
	| string |
	aName isString ifFalse: [^false].
	string := aName asString.
	(self reservedNames includes: string) ifTrue: [^false].
	string isEmpty ifTrue: [^false].
	string first isUppercase ifFalse: [^false].
	^RBScanner isVariable: string! !

!RBCondition class methodsFor: 'instance creation' stamp: ''!
definesClassVariable: aString in: aClass 
	^self new 
		type: (Array 
				with: #definesClassVar
				with: aClass
				with: aString)
		block: [aClass definesClassVariable: aString]
		errorString: aClass printString 
				, ' <1?:does not >define<1?s:> class variable ' , aString! !

!RBCondition class methodsFor: 'instance creation' stamp: ''!
definesInstanceVariable: aString in: aClass 
	^self new 
		type: (Array 
				with: #definesInstVar
				with: aClass
				with: aString)
		block: [aClass definesInstanceVariable: aString]
		errorString: aClass printString 
				, ' <1?:does not >define<1?s:> instance variable ' , aString! !

!RBCondition class methodsFor: 'instance creation' stamp: ''!
directlyDefinesClassVariable: aString in: aClass 
	^self new 
		type: (Array with: #directlyDefinesClassVar with: aClass with: aString)
		block: [aClass directlyDefinesClassVariable: aString]
		errorString: aClass printString 
				, ' <1?:does not >directly define<1?s:> class variable ' , aString! !

!RBCondition class methodsFor: 'instance creation' stamp: ''!
hasSubclasses: aClass
	^self new
		type: (Array with: #hasSubclasses with: aClass)
		block: [aClass subclasses isEmpty not]
		errorString: aClass printString , ' has <1?:no >subclasses'! !

!RBCondition class methodsFor: 'instance creation' stamp: ''!
hasSuperclass: aClass 
	^self new 
		type: (Array with: #hasSuperclass with: aClass)
		block: [aClass superclass isNil not]
		errorString: aClass printString , ' has <1?a:no> superclass'! !

!RBConfigurableFormatter commentStamp: '<historical>'!
RBConfigurableFormatter formats the Refactoring Browser's parse trees. It has many more formatting options than the default formatter used by the RB. To change the RB to use this formatter, execute "RBProgramNode formatterClass: RBConfigurableFormatter". For some refactorings the RB must reformat the code after the change, so it is good to have a formatter configured to your tastes.

Instance Variables:
	codeStream	<PositionableStream>	the stream we are writing our output to
	indent	<Integer>	how many times are we indenting a new line -- indents are normally tabs but could be any whitespace string
	lineStart	<Integer>	the position of the character that started the current line. This is used for calculating the line length.
	lookaheadCode	<Dictionary key: RBProgramNode value: String>	sometimes we need to lookahead while formatting, this dictionary contains the nodes that have already been formatted by lookahead
	originalSource	<String>	the original source before we started formatting. This is used to extract the comments from the original source.

!
!RBConfigurableFormatter methodsFor: 'private' stamp: 'CamilloBruni 10/31/2012 17:11'!
needsParenthesisFor: aNode 
	| parent grandparent |
	aNode ifNil: [ ^ false ].
	aNode isValue ifFalse: [ ^ false ].
	parent := aNode parent ifNil: [ ^ false ].
	(CascadedMessageInsideParentheses and: [ aNode isMessage and: [ parent isMessage and: [ parent receiver == aNode ] ] ]) ifTrue: [
		grandparent := parent parent.
		(grandparent notNil and: [ grandparent isCascade ])
			ifTrue: [ ^ true ] ].
	(aNode precedence < parent precedence) ifTrue: [ ^ false ].
	(aNode isAssignment and: [ parent isAssignment ]) ifTrue: [ ^ false ].
	(aNode isAssignment and: [ aNode isCascade ]) ifTrue: [ ^ true ].
	(aNode precedence = 0) ifTrue: [ ^ false ].
	(aNode isMessage) ifFalse: [ ^ true ].
	(aNode precedence = parent precedence) ifFalse: [ ^ true ].
	(aNode isUnary) ifTrue: [ ^ false ].
	(aNode isKeyword) ifTrue: [ ^ true ].
	(parent receiver == aNode) ifFalse: [ ^ true ].
	^ UseTraditionalBinaryPrecedenceForParentheses and: [ self precedenceOf: parent selector greaterThan: aNode selector ]! !

!RBConfigurableFormatter methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:56'!
visitCascadeNode: aCascadeNode 
	self visitNode: aCascadeNode receiver.
	self indentAround: 
			[NewLineBeforeFirstCascade ifTrue: [self newLine] ifFalse: [self space].
			aCascadeNode messages do: 
					[:each | 
					self indentAround: 
							[self 
								formatSelectorAndArguments: each
								firstSeparator: []
								restSeparator: ((self isMultiLineMessage: each) 
										ifTrue: [[self newLine]]
										ifFalse: [[self space]])]]
				separatedBy: 
					[codeStream nextPut: $;.
					NewLineAfterCascade ifTrue: [self newLine] ifFalse: [self space]]]! !

!RBConfigurableFormatter methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:56'!
visitPatternBlockNode: aRBPatternBlockNode 
	codeStream nextPut: $`.
	self 
		bracketWith: '{}' 
		around: [self formatBlock: aRBPatternBlockNode]! !

!RBConfigurableFormatter methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:55'!
visitArrayNode: anArrayNode
	self bracketWith: '{}' around: [ self formatArray: anArrayNode ]! !

!RBConfigurableFormatter methodsFor: 'private-formatting' stamp: 'PabloHerrero 10/22/2013 14:02'!
isMultiLineMessage: aMessageNode
	| messageStream |
	(MultiLineMessages includes: aMessageNode selector)
		ifTrue: [ ^ true ].
	(OneLineMessages includes: aMessageNode selector)
		ifTrue: [ ^ false ].
	(NumberOfArgumentsForMultiLine <= aMessageNode arguments size)
		ifTrue: [ ^ true ].
	(aMessageNode arguments 
		anySatisfy: [ :each | self indent: IndentsForKeywords + 1 around: [ self willBeMultiline: each ] ]) 
		ifTrue: [ ^ true ].
	aMessageNode isUnary
		ifTrue: [ ^ self isLineTooLong: aMessageNode selector ].
	messageStream := WriteStream on: (String new: 100).
	self  with: aMessageNode selectorParts and: aMessageNode arguments 
		do: [ :selector :arg | messageStream nextPutAll: selector; space; nextPutAll: (self formattedSourceFor: arg) ]
		separatedBy: [ messageStream space ].
	^ self isLineTooLong: messageStream contents! !

!RBConfigurableFormatter methodsFor: 'private-formatting' stamp: 'lr 11/2/2009 09:22'!
formatMethodBodyFor: aMethodNode 
	self
		indentAround: 
			[self newLines: NewLinesAfterMethodPattern.
			self formatMethodCommentFor: aMethodNode.
			self formatPragmasFor: aMethodNode.
			self visitNode: aMethodNode body]! !

!RBConfigurableFormatter methodsFor: 'private' stamp: ''!
formatTemporariesFor: aSequenceNode
	aSequenceNode temporaries isEmpty ifTrue: [^self].
	self
		bracketWith: '|'
		around:
			[self space.
			aSequenceNode temporaries
				do:
					[:each | 
					self visitNode: each.
					FormatCommentWithStatements ifTrue: [self formatCommentsFor: each].
					self space]].
	self newLines: NewLinesAfterTemporaries! !

!RBConfigurableFormatter methodsFor: 'private' stamp: ''!
indentAround: aBlock 
	self indent: 1 around: aBlock! !

!RBConfigurableFormatter methodsFor: 'private' stamp: 'lr 11/22/2009 17:17'!
isLineTooLong: aString 
	^ self currentLineLength + (aString indexOf: Character cr ifAbsent: [ aString size ]) >= MaxLineLength! !

!RBConfigurableFormatter methodsFor: 'initialization' stamp: ''!
initialize
	super initialize.
	lineStart := 0.
	indent := 0.
	lookaheadCode := IdentityDictionary new.
	codeStream := WriteStream on: (String new: 256)! !

!RBConfigurableFormatter methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:57'!
visitPragmaNode: aPragmaNode
	codeStream nextPut: $<.
	self 
		formatSelectorAndArguments: aPragmaNode 
		firstSeparator: [ 
			aPragmaNode selector isInfix
				ifTrue: [ self space ] ]
		restSeparator: [ self space ].
	codeStream nextPut: $>! !

!RBConfigurableFormatter methodsFor: 'private-formatting' stamp: 'PabloHerrero 11/7/2013 11:12'!
formatCommentsFor: aNode 
	originalSource isNil ifTrue: [^self].
	aNode comments do: 
			[:each | 
			codeStream
				space;
				nextPutAll: (originalSource copyFrom: each start to: each stop)]! !

!RBConfigurableFormatter methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:57'!
visitSequenceNode: aSequenceNode 
	self formatTemporariesFor: aSequenceNode.
	self formatSequenceCommentsFor: aSequenceNode.
	self formatSequenceNodeStatementsFor: aSequenceNode! !

!RBConfigurableFormatter methodsFor: 'private' stamp: 'PeterUhnak 11/5/2014 09:47'!
newLinesBeforeStartingAt: anIndex 
	| count cr lf index char |
	originalSource ifNil: [^0].
	(anIndex isNil or: [anIndex > originalSource size]) ifTrue: [^0].
	cr := Character value: 13.
	lf := Character value: 10.
	count := 0.
	index := anIndex - 1.
	[index > 0 and: [(char := originalSource at: index) isSeparator]] 
		whileTrue: 
			[char == lf 
				ifTrue: 
					[count := count + 1.
					(originalSource at: (index - 1 max: 1)) == cr ifTrue: [index := index - 1]].
			char == cr ifTrue: [count := count + 1].
			index := index - 1].
	^count! !

!RBConfigurableFormatter methodsFor: 'visiting' stamp: ''!
visitNode: aNode
	| needsParenthesis |
	(lookaheadCode includesKey: aNode)
		ifTrue: [^self writeString: (lookaheadCode at: aNode)].
	needsParenthesis := self needsParenthesisFor: aNode.
	self
		bracketWith:
			(needsParenthesis
				ifTrue: ['()']
				ifFalse: [''])
		around:
			[needsParenthesis ifTrue: [codeStream nextPutAll: StringInsideParentheses].
			super visitNode: aNode.
			(FormatCommentWithStatements or: [aNode isMethod or: [aNode isSequence]])
				ifFalse: [self formatCommentsFor: aNode].
			needsParenthesis
				ifTrue: [codeStream nextPutAll: StringInsideParentheses]]! !

!RBConfigurableFormatter methodsFor: 'private-formatting' stamp: ''!
formatSequenceNodeStatementsFor: aSequenceNode 
	| statements |
	statements := aSequenceNode statements.
	statements isEmpty ifTrue: [^self].
	1 to: statements size
		do: 
			[:i | 
			self visitNode: (statements at: i).
			(i < statements size or: 
					[aSequenceNode parent ifNil: [self class periodsAsTerminators]
						ifNotNil: 
							[:parent | 
							parent isBlock 
								ifTrue: [self class periodsAtEndOfBlock]
								ifFalse: [self class periodsAtEndOfMethod]]]) 
				ifTrue: [codeStream nextPut: $.].
			self formatStatementCommentsFor: (statements at: i).
			i < statements size 
				ifTrue: 
					[self addNewLinesBeforeStatementStartingAt: (statements at: i + 1) start]]! !

!RBConfigurableFormatter methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:55'!
visitAssignmentNode: anAssignmentNode 
	self visitNode: anAssignmentNode variable.
	codeStream space; nextPutAll: anAssignmentNode assignmentOperator; space.
	self visitNode: anAssignmentNode value! !

!RBConfigurableFormatter methodsFor: 'private' stamp: ''!
indent: anInteger around: aBlock 
	indent := indent + anInteger.
	^aBlock ensure: [indent := indent - anInteger]! !

!RBConfigurableFormatter methodsFor: 'private-formatting' stamp: 'PabloHerrero 10/22/2013 14:02'!
formatSelectorAndArguments: aMessageNode firstSeparator: firstBlock restSeparator: restBlock
	| separatorBlock |
	separatorBlock := firstBlock.
	aMessageNode isUnary
		ifTrue: [ self handleLineForSelector: aMessageNode selector withSeparatorBlock: separatorBlock.
				codeStream nextPutAll: aMessageNode selector ]
		ifFalse: [ 
			aMessageNode selectorParts
				with: aMessageNode arguments
				do: [ :selector :argument | 
					self handleLineForSelector:  selector withSeparatorBlock: separatorBlock.
					separatorBlock := restBlock.
					self
						indentAround: [ 
							codeStream nextPutAll: selector.
							(KeepBlockInMessage and: [ argument isBlock ])
								ifTrue: [ 
									self
										space;
										visitNode: argument ]
								ifFalse: [ 
									((self willBeMultiline: argument) or: [ self isLineTooLong: (self formattedSourceFor: argument) ])
										ifTrue: [ self newLine ]
										ifFalse: [ self space ].
									self visitNode: argument ] ] ] ]! !

!RBConfigurableFormatter methodsFor: 'visiting' stamp: 'PabloHerrero 2/16/2015 00:41'!
visitLiteralNode: aLiteralNode
	aLiteralNode value isLiteral
		ifFalse: [ self writeString: '''<an unprintable nonliteral value>''' ]
		ifTrue: [ self writeString: aLiteralNode sourceText ].! !

!RBConfigurableFormatter methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:57'!
visitReturnNode: aReturnNode 
	codeStream
		nextPut: $^;
		nextPutAll: StringFollowingReturn.
	self visitNode: aReturnNode value! !

!RBConfigurableFormatter methodsFor: 'private-formatting' stamp: 'lr 11/2/2009 09:31'!
formatArray: anArrayNode
	self formatSequenceCommentsFor: anArrayNode.
	self formatSequenceNodeStatementsFor: anArrayNode! !

!RBConfigurableFormatter methodsFor: 'private' stamp: ''!
precedenceOf: parentSelector greaterThan: childSelector 
	"Put parenthesis around things that are preceived to have 'lower' precedence. For example, 'a + b * c' 
	-> '(a + b) * c' but 'a * b + c' -> 'a * b + c'"

	| childIndex parentIndex |
	childIndex := 0.
	parentIndex := 0.
	1 to: TraditionalBinaryPrecedence size
		do: 
			[:i | 
			((TraditionalBinaryPrecedence at: i) includes: parentSelector first) 
				ifTrue: [parentIndex := i].
			((TraditionalBinaryPrecedence at: i) includes: childSelector first) 
				ifTrue: [childIndex := i]].
	^childIndex < parentIndex! !

!RBConfigurableFormatter methodsFor: 'private' stamp: ''!
currentLineLength
	^codeStream position - lineStart! !

!RBConfigurableFormatter methodsFor: 'utility' stamp: ''!
with: firstCollection and: secondCollection do: aBlock separatedBy: separatorBlock 
	firstCollection isEmpty ifTrue: [^self].
	aBlock
		value: firstCollection first
		value: secondCollection first.
	2
		to: firstCollection size
		do: 
			[:i | 
			separatorBlock value.
			aBlock
				value: (firstCollection at: i)
				value: (secondCollection at: i)]! !

!RBConfigurableFormatter methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:56'!
visitMessageNode: aMessageNode 
	self visitNode: aMessageNode receiver.
	self formatSelectorAndArguments: aMessageNode! !

!RBConfigurableFormatter methodsFor: 'private' stamp: ''!
willBeMultiline: aNode 
	^(self formattedSourceFor: aNode) includes: Character cr! !

!RBConfigurableFormatter methodsFor: 'private-formatting' stamp: 'PabloHerrero 11/7/2013 11:12'!
formatMethodCommentFor: aMethodNode
	originalSource isNil ifTrue: [^self].
	(FormatCommentWithStatements
		ifTrue: [aMethodNode methodComments]
		ifFalse: [aMethodNode comments])
		do:
			[:each | 
			codeStream
				nextPutAll:
					(originalSource
						copyFrom: each start
						to: each stop).
			self newLines: NewLinesAfterMethodComment]! !

!RBConfigurableFormatter methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:56'!
visitMethodNode: aMethodNode 
	self formatMethodPatternFor: aMethodNode.
	self formatMethodBodyFor: aMethodNode! !

!RBConfigurableFormatter methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:57'!
visitVariableNode: aVariableNode 
	codeStream nextPutAll: aVariableNode name! !

!RBConfigurableFormatter methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:56'!
visitBlockNode: aBlockNode
	self bracketWith: '[]' around: [self formatBlock: aBlockNode]! !

!RBConfigurableFormatter methodsFor: 'private-formatting' stamp: 'lr 2/28/2010 22:17'!
formatSelectorAndArguments: aMessageNode
	| newLineBetweenArguments |
	newLineBetweenArguments := self isMultiLineMessage: aMessageNode.
	self
		indent:
			(newLineBetweenArguments
				ifTrue: [ IndentsForKeywords ]
				ifFalse: [ 0 ])
		around: [ 
			self
				formatSelectorAndArguments: aMessageNode
				firstSeparator:
					((newLineBetweenArguments or: [ NewLineBeforeFirstKeyword ])
						ifTrue: [ [ self newLine ] ]
						ifFalse: [ [ self space ] ])
				restSeparator:
					(newLineBetweenArguments
						ifTrue: [ [ self newLine ] ]
						ifFalse: [ [ self space ] ]) ]! !

!RBConfigurableFormatter methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:56'!
visitLiteralArrayNode: aRBArrayLiteralNode 
	| brackets |
	codeStream nextPut: $#.
	brackets := aRBArrayLiteralNode isForByteArray 
				ifTrue: ['[]']
				ifFalse: ['()'].
	self bracketWith: brackets
		around: 
			[aRBArrayLiteralNode contents do: [:each | self visitNode: each]
				separatedBy: [self space]]! !

!RBConfigurableFormatter methodsFor: 'private' stamp: ''!
writeString: aString 
	| index |
	index := aString lastIndexOf: Character cr ifAbsent: [0].
	codeStream nextPutAll: aString.
	index > 0 
		ifTrue: [lineStart := codeStream position - (aString size - index)]! !

!RBConfigurableFormatter methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:56'!
visitPatternWrapperBlockNode: aRBPatternWrapperBlockNode
	self visitNode: aRBPatternWrapperBlockNode wrappedNode.
	codeStream nextPut: $`.
	self 
		bracketWith: '{}' 
		around: [self formatBlock: aRBPatternWrapperBlockNode]! !

!RBConfigurableFormatter methodsFor: 'private' stamp: ''!
newLines: anInteger 
	anInteger + IndentString size = 0 ifTrue: [codeStream space].
	anInteger timesRepeat: [codeStream cr].
	lineStart := codeStream position.
	indent timesRepeat: [codeStream nextPutAll: IndentString]! !

!RBConfigurableFormatter methodsFor: 'private-formatting' stamp: 'PabloHerrero 11/7/2013 11:12'!
formatSequenceCommentsFor: aSequenceNode
	originalSource isNil ifTrue: [^self].
	aSequenceNode comments
		do:
			[:each | 
			codeStream
				nextPutAll:
					(originalSource
						copyFrom: each start
						to: each stop).
			self newLine]! !

!RBConfigurableFormatter methodsFor: 'private-formatting' stamp: 'lr 11/2/2009 10:09'!
formatPragmasFor: aMethodNode
	aMethodNode pragmas do: [ :each | self visitNode: each; newLine ]! !

!RBConfigurableFormatter methodsFor: 'private-formatting' stamp: 'StephaneDucasse 3/29/2013 17:23'!
handleLineForSelector: selector withSeparatorBlock: aBlock

	^ (self isLineTooLong: selector)
		ifTrue: [ self newLine ]
		ifFalse: [ aBlock value ]! !

!RBConfigurableFormatter methodsFor: 'private' stamp: ''!
newLine
	self newLines: 1! !

!RBConfigurableFormatter methodsFor: 'private' stamp: ''!
addNewLinesBeforeStatementStartingAt: anInteger 
	| newLines |
	newLines := MinimumNewLinesBetweenStatements 
				max: (RetainBlankLinesBetweenStatements 
						ifTrue: [self newLinesBeforeStartingAt: anInteger]
						ifFalse: [0]).
	newLines = 0 ifTrue: [self space] ifFalse: [self newLines: newLines]! !

!RBConfigurableFormatter methodsFor: 'private' stamp: ''!
space
	codeStream space! !

!RBConfigurableFormatter methodsFor: 'public interface' stamp: ''!
format: aParseTree 
	originalSource := aParseTree source.
	self visitNode: aParseTree.
	^codeStream contents! !

!RBConfigurableFormatter methodsFor: 'private-formatting' stamp: 'lr 2/28/2010 21:54'!
formatBlock: aBlockNode
	(LineUpBlockBrackets and: [ self willBeMultiline: aBlockNode body ])
		ifTrue: [ self newLine ]
		ifFalse: [ codeStream nextPutAll: StringInsideBlocks ].
	self formatBlockArgumentsFor: aBlockNode.
	(self willBeMultiline: aBlockNode body)
		ifTrue: [ self newLine ].
	self visitNode: aBlockNode body.
	(LineUpBlockBrackets and: [ self willBeMultiline: aBlockNode body ])
		ifTrue: [ self newLine ]
		ifFalse: [ codeStream nextPutAll: StringInsideBlocks ]! !

!RBConfigurableFormatter methodsFor: 'private' stamp: ''!
formattedSourceFor: aNode 
	^lookaheadCode at: aNode
		ifAbsentPut: [self class format: aNode withIndents: indent]! !

!RBConfigurableFormatter methodsFor: 'private-formatting' stamp: 'lr 2/28/2010 21:59'!
formatBlockArgumentsFor: aBlockNode
	aBlockNode arguments isEmpty
		ifTrue: [ ^ self ].
	aBlockNode arguments
		do: [ :each | 
			codeStream nextPut: $:.
			self visitNode: each.
			FormatCommentWithStatements
				ifTrue: [ self formatCommentsFor: each ].
			self space ].
	codeStream nextPutAll: '| '! !

!RBConfigurableFormatter methodsFor: 'private' stamp: ''!
bracketWith: bracketString around: aBlock 
	bracketString isEmpty ifTrue: [^aBlock value].
	codeStream nextPut: bracketString first.
	^aBlock ensure: [codeStream nextPut: bracketString last]! !

!RBConfigurableFormatter methodsFor: 'private-formatting' stamp: 'PabloHerrero 1/5/2015 10:08'!
formatStatementCommentsFor: aStatementNode
	originalSource isNil
		ifTrue: [ ^ self ].
	FormatCommentWithStatements
		ifFalse: [ ^ self ].
	aStatementNode statementComments
		do: [ :each | 
			| count |
			count := self newLinesBeforeStartingAt: each start.
			RetainBlankLinesBeforeComments & (count > 0)
				ifTrue: [ self newLines: count ]
				ifFalse: [ codeStream tab ].

			codeStream nextPutAll: (originalSource copyFrom: each start to: each stop) ]! !

!RBConfigurableFormatter methodsFor: 'private-formatting' stamp: 'PabloHerrero 10/22/2013 14:02'!
formatMethodPatternFor: aMethodNode 
	aMethodNode arguments isEmpty
		ifTrue: [codeStream nextPutAll: aMethodNode selector]
		ifFalse: 
			[self
				with: aMethodNode selectorParts
				and: aMethodNode arguments
				do: 
					[:key :arg | 
					codeStream nextPutAll: key.
					self space.
					self visitNode: arg]
				separatedBy: 
					[MethodSignatureOnMultipleLines
						ifTrue: [self newLine]
						ifFalse: [self space]]]! !

!RBConfigurableFormatter methodsFor: 'initialize-release' stamp: ''!
indent: anInteger
	indent := anInteger! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 9/11/2010 17:20'!
oneLineMessages
	^ OneLineMessages printString! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 2/28/2010 21:50'!
keepBlockInMessage: aBoolean
	KeepBlockInMessage := aBoolean! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
minimumNewLinesBetweenStatements
	^ MinimumNewLinesBetweenStatements! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: ''!
stringFollowingReturn: aString
	StringFollowingReturn := aString! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
lineUpBlockBrackets
	^ LineUpBlockBrackets! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'PeterUhnak 8/21/2014 21:13'!
retainBlankLinesBeforeComments
	^ RetainBlankLinesBeforeComments! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
useTraditionalBinaryPrecedenceForParentheses
	^ UseTraditionalBinaryPrecedenceForParentheses! !

!RBConfigurableFormatter class methodsFor: 'initialization' stamp: 'PeterUhnak 8/21/2014 21:14'!
initialize
	CascadedMessageInsideParentheses := false.
	FormatCommentWithStatements := true.
	IndentString := String with: Character tab.
	IndentsForKeywords := 1.
	KeepBlockInMessage := true.
	LineUpBlockBrackets := false.
	MaxLineLength := 120.
	MethodSignatureOnMultipleLines := false.
	MinimumNewLinesBetweenStatements := 1.
	MultiLineMessages := #(#ifTrue:ifFalse: #ifFalse:ifTrue: #ifTrue: #ifFalse: #on:do: #ensure: #ifCurtailed:).
	NewLineAfterCascade := true.
	NewLineBeforeFirstCascade := true.
	NewLineBeforeFirstKeyword := false.
	NewLinesAfterMethodComment := 2.
	NewLinesAfterMethodPattern := 1.
	NewLinesAfterTemporaries := 1.
	NumberOfArgumentsForMultiLine := 4.
	OneLineMessages := #(#to: #to:do: #to:by: #to:by:do:).
	PeriodsAtEndOfBlock := false.
	PeriodsAtEndOfMethod := false.
	RetainBlankLinesBetweenStatements := false.
	RetainBlankLinesBeforeComments := false.
	StringFollowingReturn := ' '.
	StringInsideBlocks := ' '.
	StringInsideParentheses := ''.
	TraditionalBinaryPrecedence := #(#($| $& $?) #($= $~ $< $>) #($- $+) #($* $/ $% $\) #($@)).
	UseTraditionalBinaryPrecedenceForParentheses := true! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'MarcusDenker 4/30/2013 11:21'!
multiLineMessages: aString
	MultiLineMessages := self compiler evaluate: aString! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
stringInsideParentheses: aString
	StringInsideParentheses := aString! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: ''!
newLinesAfterMethodPattern: anInteger
	NewLinesAfterMethodPattern := anInteger! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: ''!
indentsForKeywords: anInteger
	IndentsForKeywords := anInteger! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
stringInsideBlocks: aString
	StringInsideBlocks := aString! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'MarcusDenker 4/30/2013 11:20'!
oneLineMessages: aString
	OneLineMessages := self compiler evaluate: aString! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
newLinesAfterTemporaries
	^ NewLinesAfterTemporaries! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
numberOfArgumentsForMultiLine
	^ NumberOfArgumentsForMultiLine! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
newLinesAfterMethodComment
	^ NewLinesAfterMethodComment! !

!RBConfigurableFormatter class methodsFor: 'public' stamp: 'lr 12/27/2009 13:05'!
format: aParseTree withIndents: anInteger 
	^ self new
		indent: anInteger;
		format: aParseTree! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
newLineBeforeFirstKeyword
	^ NewLineBeforeFirstKeyword! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
stringInsideBlocks
	^ StringInsideBlocks! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
formatCommentWithStatements: aBoolean
	FormatCommentWithStatements := aBoolean! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 7/25/2011 20:53'!
cascadedMessageInsideParentheses: aBoolean
	CascadedMessageInsideParentheses := aBoolean! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'PeterUhnak 8/21/2014 21:13'!
retainBlankLinesBeforeComments: aBoolean
	RetainBlankLinesBeforeComments := aBoolean! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
formatCommentWithStatements
	^ FormatCommentWithStatements! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 7/25/2011 20:53'!
cascadedMessageInsideParentheses
	^ CascadedMessageInsideParentheses! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: ''!
indentString: aString
	IndentString := aString! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
indentString
	^ IndentString! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: ''!
newLineBeforeFirstKeyword: aBoolean
	NewLineBeforeFirstKeyword := aBoolean! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: ''!
newLinesAfterTemporaries: anInteger
	NewLinesAfterTemporaries := anInteger! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
periodsAsTerminators: aBoolean
	PeriodsAtEndOfBlock := aBoolean.
	PeriodsAtEndOfMethod := aBoolean! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
stringInsideParentheses
	^ StringInsideParentheses! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 9/11/2010 17:20'!
traditionalBinaryPrecedence
	^ TraditionalBinaryPrecedence printString! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
methodSignatureOnMultipleLines
	^ MethodSignatureOnMultipleLines! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
minimumNewLinesBetweenStatements: anInteger
	MinimumNewLinesBetweenStatements := anInteger! !

!RBConfigurableFormatter class methodsFor: 'settings' stamp: 'PeterUhnak 8/21/2014 21:15'!
settingsOn: aBuilder
	<systemsettings>
	
	(aBuilder group: #configurableFormatter)
		target: self;
		parent: #codeBrowsing;
		label: 'Pretty Printing';
		description: 'Settings related to the formatter';
		with: [
			(aBuilder setting: #cascadedMessageInsideParentheses)
				label: 'Cascaded message inside parentheses'.
			(aBuilder setting: #formatCommentWithStatements)
				label: 'Format comment with statements'.
			(aBuilder setting: #indentString)
				label: 'Indent string'.
			(aBuilder setting: #indentsForKeywords)
				label: 'Indents for keywords'.
			(aBuilder setting: #keepBlockInMessage)
				label: 'Keep block in message'.
			(aBuilder setting: #lineUpBlockBrackets)
				label: 'Line up block brackets'.
			(aBuilder setting: #methodSignatureOnMultipleLines)
				label: 'Method signature on multiple lines'.
			(aBuilder setting: #maxLineLength)
				label: 'Max line length'.
			(aBuilder setting: #oneLineMessages)
				label: 'One line messages'.
			(aBuilder setting: #multiLineMessages)
				label: 'Multi line messages'.
			(aBuilder setting: #minimumNewLinesBetweenStatements)
				label: 'Minimum new lines between statements'.
			(aBuilder setting: #newLineAfterCascade)
				label: 'New line after cascade'.
			(aBuilder setting: #newLineBeforeFirstCascade)
				label: 'New line before first cascade'.
			(aBuilder setting: #newLineBeforeFirstKeyword)
				label: 'New line before first keyword'.
			(aBuilder setting: #newLinesAfterMethodComment)
				label: 'New lines after method comment'.
			(aBuilder setting: #newLinesAfterMethodPattern)
				label: 'New lines after method pattern'.
			(aBuilder setting: #newLinesAfterTemporaries)
				label: 'New lines after temporaries'.
			(aBuilder setting: #numberOfArgumentsForMultiLine)
				label: 'Number of arguments for multi line'.
			(aBuilder setting: #periodsAsTerminators)
				label: 'Periods as terminators'.
			(aBuilder setting: #periodsAtEndOfBlock)
				label: 'Periods at end of block'.
			(aBuilder setting: #periodsAtEndOfMethod)
				label: 'Periods at end of method'.
			(aBuilder setting: #retainBlankLinesBetweenStatements)
				label: 'Retain blank lines between statements'.
			(aBuilder setting: #retainBlankLinesBeforeComments)
				label: 'Retain blank lines before comments'.
			(aBuilder setting: #stringFollowingReturn)
				label: 'String following return'.
			(aBuilder setting: #stringInsideBlocks)
				label: 'String inside blocks'.
			(aBuilder setting: #stringInsideParentheses)
				label: 'String inside parentheses'.
			(aBuilder setting: #traditionalBinaryPrecedence)
				label: 'Traditional binary precedence'.
			(aBuilder setting: #useTraditionalBinaryPrecedenceForParentheses)
				label: 'Use traditional binary precedence for parentheses' ]! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
useTraditionalBinaryPrecedenceForParentheses: aBoolean
	UseTraditionalBinaryPrecedenceForParentheses := aBoolean! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 2/28/2010 21:49'!
keepBlockInMessage
	^ KeepBlockInMessage! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 9/11/2010 17:20'!
multiLineMessages
	^ MultiLineMessages printString! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: ''!
retainBlankLinesBetweenStatements: aBoolean
	RetainBlankLinesBetweenStatements := aBoolean! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'MarcusDenker 4/30/2013 11:22'!
traditionalBinaryPrecedence: aString
	TraditionalBinaryPrecedence := self compiler evaluate: aString! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
newLineAfterCascade
	^ NewLineAfterCascade! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: ''!
newLineAfterCascade: aBoolean
	NewLineAfterCascade := aBoolean! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
periodsAtEndOfMethod
	^ PeriodsAtEndOfMethod! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
newLineBeforeFirstCascade
	^ NewLineBeforeFirstCascade! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
stringFollowingReturn
	^ StringFollowingReturn! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
maxLineLength
	^ MaxLineLength! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: ''!
methodSignatureOnMultipleLines: aBoolean
	MethodSignatureOnMultipleLines := aBoolean! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
indentsForKeywords
	^ IndentsForKeywords! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
newLinesAfterMethodComment: anInteger
	NewLinesAfterMethodComment := anInteger! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
periodsAsTerminators
	^ PeriodsAtEndOfBlock and: [ PeriodsAtEndOfMethod ]! !

!RBConfigurableFormatter class methodsFor: 'public' stamp: ''!
format: aParseTree 
	^self format: aParseTree withIndents: 0! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
maxLineLength: anInteger
	MaxLineLength := anInteger! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: ''!
newLineBeforeFirstCascade: aBoolean
	NewLineBeforeFirstCascade := aBoolean! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
periodsAtEndOfBlock
	^ PeriodsAtEndOfBlock! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: ''!
numberOfArgumentsForMultiLine: anInteger
	NumberOfArgumentsForMultiLine := anInteger! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: ''!
lineUpBlockBrackets: aBoolean
	LineUpBlockBrackets := aBoolean! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
retainBlankLinesBetweenStatements
	^ RetainBlankLinesBetweenStatements! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
newLinesAfterMethodPattern
	^ NewLinesAfterMethodPattern! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
periodsAtEndOfBlock: aBoolean
	PeriodsAtEndOfBlock := aBoolean! !

!RBConfigurableFormatter class methodsFor: 'accessing' stamp: 'lr 12/27/2009 13:35'!
periodsAtEndOfMethod: aBoolean
	PeriodsAtEndOfMethod := aBoolean! !

!RBConjunctiveCondition methodsFor: 'private' stamp: ''!
unknownFailed
	^(left errorStringFor: false) , ' OR ' , (right errorStringFor: false)! !

!RBConjunctiveCondition methodsFor: 'private' stamp: ''!
errorMacro
	^errorMacro isNil
		ifTrue: [self longMacro]
		ifFalse: [super errorMacro]! !

!RBConjunctiveCondition methodsFor: 'private' stamp: ''!
rightFailed
	^right errorStringFor: false! !

!RBConjunctiveCondition methodsFor: 'printing' stamp: 'bh 4/10/2001 16:52'!
printOn: aStream 
	aStream nextPutAll: left asString;
		nextPutAll: ' & ';
		nextPutAll: right asString
! !

!RBConjunctiveCondition methodsFor: 'checking' stamp: ''!
check
	left check
		ifFalse: 
			[failed := #leftFailed.
			^false].
	right check
		ifFalse: 
			[failed := #rightFailed.
			^false].
	^true! !

!RBConjunctiveCondition methodsFor: 'initialize-release' stamp: ''!
left: aCondition right: aCondition2 
	left := aCondition.
	right := aCondition2.
	failed := #unknownFailed! !

!RBConjunctiveCondition methodsFor: 'private' stamp: ''!
leftFailed
	^left errorStringFor: false! !

!RBConjunctiveCondition methodsFor: 'private' stamp: ''!
neitherFailed
	^(left errorStringFor: true) , ' AND ' , (right errorStringFor: true)! !

!RBConjunctiveCondition methodsFor: 'private' stamp: 'lr 11/2/2009 23:38'!
errorBlockFor: aBoolean 
	^aBoolean
		ifTrue: [nil]
		ifFalse: 
			[failed = #leftFailed ifTrue: [left errorBlock] ifFalse: [right errorBlock]]! !

!RBConjunctiveCondition methodsFor: 'private' stamp: ''!
longMacro
	^'(' , left errorMacro , ') <1?AND:OR> (' , right errorMacro , ')'! !

!RBConjunctiveCondition methodsFor: 'private' stamp: ''!
errorStringFor: aBoolean 
	^aBoolean
		ifTrue: [self neitherFailed]
		ifFalse: [self perform: failed]! !

!RBConsistencyCheckRule commentStamp: 'StephaneDucasse 11/29/2014 21:26'!
Checks for code using equality tests instead of the message sends. Since the code "aCollection size = 0" works for all objects, it is more difficult for someone reading such code to determine that "aCollection" is a collection. Whereas, if you say "aCollection isEmpty" then aCollection must be a collection since isEmpty is only defined for collections.!
!RBConsistencyCheckRule methodsFor: 'initialization' stamp: 'MarcusDenker 7/22/2014 21:54'!
initialize
	super initialize.
	self matcher 
		matchesAnyOf: #(
			'`@object size == 0'
			'`@object size = 0'
			'`@object size > 0'
			'`@object size >= 1'
			'`@object == nil'
			'`@object = nil'
			'`@collection at: `@collection size' )
		do: [ :node :answer | node ]! !

!RBConsistencyCheckRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 21:26'!
rationale
	^ 'Checks for code using equality tests instead of the message sends.'! !

!RBConsistencyCheckRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Intention revealing'! !

!RBConsistencyCheckRule methodsFor: 'accessing' stamp: 'MarcusDenker 7/22/2014 21:56'!
name
	^ 'Uses "size = 0", "= nil"  instead of "isEmpty" and "isNil"'! !

!RBConsistencyCheckRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 16:24'!
category
	^'Coding Idiom Violation'! !

!RBConsistencyCheckRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'ConsistencyCheckRule'! !

!RBContainsRule commentStamp: 'StephaneDucasse 11/29/2014 21:26'!
Checks for the common code fragment: "(aCollection detect: [:each | ''some condition''] ifNone: [nil]) ~= nil". contains: can simplify this code to "aCollection contains: [:each | ''some condition'']". Not only is the contains: variant shorter, it better signifies what the code is doing!
!RBContainsRule methodsFor: 'initialization' stamp: 'CamilleTeruel 4/3/2013 17:22'!
initialize
	super initialize.
	self matcher 
		matchesAnyOf: #(
			'(`@object detect: [:`each | | `@temps| `@.Statements] ifNone: [nil]) isNil'
			'(`@object detect: [:`each | | `@temps| `@.Statements] ifNone: [nil]) notNil'
			'(`@object detect: [:`each | | `@temps| `@.Statements] ifNone: [nil]) = nil'
			'(`@object detect: [:`each | | `@temps| `@.Statements] ifNone: [nil]) == nil'
			'(`@object detect: [:`each | | `@temps| `@.Statements] ifNone: [nil]) ~= nil'
			'(`@object detect: [:`each | | `@temps| `@.Statements] ifNone: [nil]) ~~ nil'
			'`@object detect: [:`each | | `@temps| `@.Statements] ifNone: [| `@temps1 | `@.Statements2. ^`@anything]' )
		do: [ :node :answer | node ]! !

!RBContainsRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 21:26'!
rationale
	^ 'Checks for the common code fragment: "(aCollection detect: [:each | ''some condition''] ifNone: [nil]) ~= nil".'! !

!RBContainsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Intention revealing'! !

!RBContainsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Uses detect:ifNone: instead of contains:'! !

!RBContainsRule methodsFor: 'accessing' stamp: 'Simon 8/30/2012 14:51'!
category
	^ 'Optimization'! !

!RBContainsRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'ContainsRule'! !

!RBCreateAccessorsForVariableRefactoring methodsFor: 'testing' stamp: ''!
needsReturnForSetter
	needsReturn isNil 
		ifTrue: 
			[needsReturn := self 
						usesAssignmentOf: variableName
						in: class
						classVariable: classVariable].
	^needsReturn! !

!RBCreateAccessorsForVariableRefactoring methodsFor: 'private-accessing' stamp: ''!
possibleGetterSelectors
	^self methodsReferencingVariable select: [:each | each numArgs == 0]! !

!RBCreateAccessorsForVariableRefactoring methodsFor: 'private-accessing' stamp: 'lr 10/26/2009 22:09'!
definingClass
	^ classVariable 
		ifTrue: [ class theMetaClass ]
		ifFalse: [ class ]! !

!RBCreateAccessorsForVariableRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^classVariable 
		ifTrue: [RBCondition definesClassVariable: variableName asSymbol in: class]
		ifFalse: [RBCondition definesInstanceVariable: variableName in: class]! !

!RBCreateAccessorsForVariableRefactoring methodsFor: 'private-accessing' stamp: ''!
setterMethod
	^setterMethod! !

!RBCreateAccessorsForVariableRefactoring methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream nextPutAll: ' variable: '.
	variableName storeOn: aStream.
	aStream nextPutAll: ' class: '.
	class storeOn: aStream.
	aStream nextPutAll: ' classVariable: '.
	classVariable storeOn: aStream.
	aStream nextPut: $)! !

!RBCreateAccessorsForVariableRefactoring methodsFor: 'transforming' stamp: ''!
transform
	self
		createGetterAccessor;
		createSetterAccessor! !

!RBCreateAccessorsForVariableRefactoring methodsFor: 'private-accessing' stamp: ''!
methodsReferencingVariable
	^classVariable 
		ifTrue: [self definingClass whichSelectorsReferToClassVariable: variableName]
		ifFalse: 
			[self definingClass whichSelectorsReferToInstanceVariable: variableName]! !

!RBCreateAccessorsForVariableRefactoring methodsFor: 'private-accessing' stamp: 'lr 11/2/2009 00:14'!
findGetterMethod
	| definingClass matcher |
	definingClass := self definingClass.
	matcher := RBParseTreeSearcher getterMethod: variableName.
	^self possibleGetterSelectors detect: 
			[:each | 
			(self 
				checkClass: definingClass
				selector: each
				using: matcher) notNil 
				and: [(definingClass subclassRedefines: each) not]]
		ifNone: [nil]! !

!RBCreateAccessorsForVariableRefactoring methodsFor: 'initialize-release' stamp: ''!
classVariable: aBoolean 
	classVariable := aBoolean! !

!RBCreateAccessorsForVariableRefactoring methodsFor: 'private-accessing' stamp: ''!
getterMethod
	^getterMethod! !

!RBCreateAccessorsForVariableRefactoring methodsFor: 'transforming' stamp: ''!
createSetterAccessor
	setterMethod := self findSetterMethod.
	setterMethod isNil ifTrue: [setterMethod := self defineSetterMethod]! !

!RBCreateAccessorsForVariableRefactoring methodsFor: 'transforming' stamp: ''!
createGetterAccessor
	getterMethod := self findGetterMethod.
	getterMethod isNil ifTrue: [getterMethod := self defineGetterMethod]! !

!RBCreateAccessorsForVariableRefactoring methodsFor: 'private-accessing' stamp: ''!
possibleSetterSelectors
	^self methodsReferencingVariable select: [:each | each numArgs == 1]! !

!RBCreateAccessorsForVariableRefactoring methodsFor: 'transforming' stamp: 'dc 4/4/2007 16:41'!
defineSetterMethod
	| selector definingClass string |
	definingClass := self definingClass.
	string := self needsReturnForSetter 
				ifTrue: ['<1s> anObject<n><t>^ <2s> := anObject']
				ifFalse: ['<1s> anObject<n><t><2s> := anObject'].
	selector := self safeMethodNameFor: definingClass
				basedOn: variableName asString , ':'.
	definingClass 
		compile: (string expandMacrosWith: selector with: variableName)
		classified: #accessing.
	^selector! !

!RBCreateAccessorsForVariableRefactoring methodsFor: 'testing' stamp: 'lr 11/2/2009 00:14'!
usesAssignmentOf: aString in: aClass classVariable: isClassVar 
	| matcher definingClass |
	matcher := RBParseTreeSearcher new.
	matcher
		answer: false;
		matches: aString , ' := ``@object'
			do: [ :aNode :answer | answer or: [ aNode isUsed ] ].
	definingClass := isClassVar 
		ifTrue: [ aClass theNonMetaClass ]
		ifFalse: [ aClass ].
	^ (definingClass withAllSubclasses , (isClassVar 
			ifTrue: [ definingClass theMetaClass withAllSubclasses ]
			ifFalse: 
				[ #() ]) 
		detect: 
			[ :each | 
			((isClassVar 
				ifTrue: [ each whichSelectorsReferToClassVariable: aString ]
				ifFalse: [ each whichSelectorsReferToInstanceVariable: aString ]) 
				detect: 
					[ :sel | 
					self 
						checkClass: each
						selector: sel
						using: matcher ]
				ifNone: [ nil ]) notNil ]
		ifNone: [ nil ]) notNil! !

!RBCreateAccessorsForVariableRefactoring methodsFor: 'transforming' stamp: 'dc 4/4/2007 16:41'!
defineGetterMethod
	| selector definingClass |
	definingClass := self definingClass.
	selector := self safeMethodNameFor: definingClass
				basedOn: variableName asString.
	definingClass 
		compile: ('<1s><n><t>^ <2s>' expandMacrosWith: selector with: variableName)
		classified: #(#accessing).
	^selector! !

!RBCreateAccessorsForVariableRefactoring methodsFor: '*NautilusRefactoring' stamp: 'CamilloBruni 11/17/2013 16:00'!
whatToDisplayIn: aBrowser 

	^ (self changes changes 
		select: [:change | {getterMethod. setterMethod} includes: change selector ]) 
		gather: [:change | change whatToDisplayIn: aBrowser ]! !

!RBCreateAccessorsForVariableRefactoring methodsFor: 'private-accessing' stamp: 'lr 11/2/2009 00:14'!
findSetterMethod
	| definingClass matcher |
	definingClass := self definingClass.
	matcher := self needsReturnForSetter 
				ifTrue: [RBParseTreeSearcher returnSetterMethod: variableName]
				ifFalse: [RBParseTreeSearcher setterMethod: variableName].
	^self possibleSetterSelectors detect: 
			[:each | 
			(self 
				checkClass: definingClass
				selector: each
				using: matcher) notNil 
				and: [(definingClass subclassRedefines: each) not]]
		ifNone: [nil]! !

!RBCreateAccessorsForVariableRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBSmalltalk variable: aVarName class: aClass classVariable: aBoolean 
	^(self 
		model: aRBSmalltalk
		variable: aVarName
		class: aClass)
		classVariable: aBoolean;
		yourself! !

!RBCreateAccessorsForVariableRefactoring class methodsFor: 'instance creation' stamp: ''!
variable: aVarName class: aClass classVariable: aBoolean 
	^(self variable: aVarName class: aClass)
		classVariable: aBoolean; yourself! !

!RBCreateAccessorsForVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testNewInstanceVariableAccessors
	| ref class |
	ref := RBCreateAccessorsForVariableRefactoring 
		variable: 'foo1'
		class: RBLintRuleTest
		classVariable: false.
	self executeRefactoring: ref.
	class := ref model classNamed: #RBLintRuleTest.
	self deny: ref changes changes isEmpty.
	self assert: ref setterMethod == #foo1:.
	self assert: ref getterMethod == #foo1.
	self assert: (class parseTreeFor: #foo1) = (RBParser parseMethod: 'foo1 ^foo1').
	self assert: (class parseTreeFor: #foo1:) = (RBParser parseMethod: 'foo1: anObject foo1 := anObject')! !

!RBCreateAccessorsForVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testNonExistantName
	self
		shouldFail: (RBCreateAccessorsForVariableRefactoring 
				variable: #Foo
				class: RBBasicLintRuleTest
				classVariable: true);
		shouldFail: (RBCreateAccessorsForVariableRefactoring 
				variable: 'foo'
				class: RBBasicLintRuleTest
				classVariable: true)! !

!RBCreateAccessorsForVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testNewClassVariableAccessors
	| ref class |
	ref := RBCreateAccessorsForVariableRefactoring 
		variable: 'Foo1'
		class: RBLintRuleTest
		classVariable: true.
	self executeRefactoring: ref.
	class := ref model metaclassNamed: #RBLintRuleTest.
	self deny: ref changes changes isEmpty.
	self assert: ref setterMethod == #foo1:.
	self assert: ref getterMethod == #foo1.
	self assert: (class parseTreeFor: #foo1) = (RBParser parseMethod: 'foo1 ^Foo1').
	self assert: (class parseTreeFor: #foo1:) = (RBParser parseMethod: 'foo1: anObject Foo1 := anObject')! !

!RBCreateAccessorsForVariableTest methodsFor: 'set up' stamp: 'CamilloBruni 8/27/2013 15:06'!
setUp
	super setUp.
	model := self abstractVariableTestData.! !

!RBCreateAccessorsForVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testExistingInstanceVariableAccessors
	| ref |
	ref := RBCreateAccessorsForVariableRefactoring 
		variable: 'name'
		class: RBLintRuleTest
		classVariable: false.
	self executeRefactoring: ref.
	self assert: ref changes changes isEmpty.
	self assert: ref setterMethod == #name:.
	self assert: ref getterMethod == #name! !

!RBCreateCascadeRefactoring commentStamp: '<historical>'!
A RBCreateCascadeRefactoring is a refactoring used to generate cascades in source code.

Copied from OB-Refactory-Tools and should be moved into RB instead
!
!RBCreateCascadeRefactoring methodsFor: 'preconditions' stamp: 'CamilloBruni 10/8/2012 00:12'!
findSequenceNode
	"Find the sequence to be combined."

	sequenceNode := RBParser
		parseExpression: self selectedSource
		onError: [ :msg :pos | self refactoringFailure: 'Invalid source to rewrite' ].
	(sequenceNode isSequence and: [ sequenceNode statements size > 1 ])
		ifFalse: [ self refactoringFailure: 'You must select two or more statements' ]! !

!RBCreateCascadeRefactoring methodsFor: 'accessing' stamp: ''!
selectedSource
	^  self parseTree source copyFrom: selectedInterval first to: selectedInterval last! !

!RBCreateCascadeRefactoring methodsFor: 'preconditions' stamp: 'CamilloBruni 10/8/2012 00:13'!
addStatementNode: aNode
	aNode isMessage
		ifTrue: [ ^ statementNodes add: aNode ].
	aNode isCascade
		ifTrue: [ ^ statementNodes addAll: aNode messages ].
	self refactoringFailure: aNode formattedCode , ' is not a valid message'! !

!RBCreateCascadeRefactoring methodsFor: 'preconditions' stamp: ''!
findStatementNodes
	"Find the sequence to be combined."

	statementNodes := OrderedCollection new.
	sequenceNode statements do: [ :each |
		(sequenceNode isLast: each)
			ifFalse: [ self addStatementNode: each ]
			ifTrue: [
				| current |
				current := each.
				[ current isReturn or: [ current isAssignment ] ]
					whileTrue: [ current := current value ].
				self addStatementNode: current ] ]! !

!RBCreateCascadeRefactoring methodsFor: 'accessing' stamp: 'CamilloBruni 10/7/2012 23:59'!
parseTree
	parseTree isNil ifTrue: [
		parseTree := class parseTreeFor: selector.
		parseTree isNil
			ifTrue: [ self refactoringFailure: 'Could not parse sources' ] ].
	^ parseTree! !

!RBCreateCascadeRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^ (RBCondition definesSelector: selector in: class) & (RBCondition withBlock: [ 
		self findSequenceNode; findStatementNodes; findReceiverNode.
		true ])! !

!RBCreateCascadeRefactoring methodsFor: 'transforming' stamp: ''!
transform
	self combineMessages.
	self compileCode! !

!RBCreateCascadeRefactoring methodsFor: 'initialization' stamp: ''!
combine: anInterval from: aSelector in: aClass
	class := self classObjectFor: aClass.
	selector := aSelector.
	selectedInterval := anInterval! !

!RBCreateCascadeRefactoring methodsFor: 'transforming' stamp: ''!
combineMessages
	"This combines the messages and adds the assignements of the last statement to the cascade. This is not necessary if there is a return, because the refactoring engine automatically compensates for that."

	| expression |
	transformedNode := RBCascadeNode messages: (statementNodes
		collect: [ :each | each copy ]).
	expression := statementNodes last parent.
	[ expression isAssignment ] whileTrue: [
		transformedNode := RBAssignmentNode
			variable: expression variable
			value: transformedNode.
		expression := expression parent ]! !

!RBCreateCascadeRefactoring methodsFor: 'preconditions' stamp: ''!
findReceiverNode
	"Find the sequence to be combined."

	| receiverNodes |
	receiverNodes := statementNodes 
		collect: [ :each | each receiver ].
	receiverNodes asSet size = 1
		ifFalse: [ self refactoringError: 'All statements must have the same receiver' ].
	(receiverNodes first isLiteralNode or: [ receiverNodes first isVariable ])
		ifFalse: [ self refactoringWarning: 'The receiver is an expression. Proceed with caution' ]! !

!RBCreateCascadeRefactoring methodsFor: 'transforming' stamp: ''!
compileCode
	class compileTree: (RBParseTreeRewriter
		replaceStatements: sequenceNode formattedCode
		with: transformedNode formattedCode
		in: self parseTree
		onInterval: selectedInterval)! !

!RBCreateCascadeRefactoring class methodsFor: 'instance-creation' stamp: ''!
combine: anInterval from: aSelector in: aClass
	^ self new 
		combine: anInterval from: aSelector in: aClass;
		yourself! !

!RBCreateCascadeRefactoring class methodsFor: 'instance-creation' stamp: ''!
model: aNamespace combine: anInterval from: aSelector in: aClass
	^ self new 
		model: aNamespace; 
		combine: anInterval from: aSelector in: aClass;
		yourself! !

!RBDefinesEqualNotHashRule commentStamp: 'StephaneDucasse 11/29/2014 21:10'!
This smell arises when a class defines #= also and not #hash. If #hash is not defined then the instances of the class might not be able to be used in sets since equal element must have the same hash.

When a class defines = also and not hash, this can lead to really subtle bugs and behavior where sometimes it appears that an object is in a set and sometimes not. 

One pattern proposed by Kent Beck in Best Smalltalk Practices is to define hash in terms of instance variable hash xor. Here is an example:
	
	Book>>= anotherBook
		^ (self author = anotherBook author) and: [self title = anotherBook title]
	
	Book>>hash
		^ (self title hash bitXor: self title hash		!
!RBDefinesEqualNotHashRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'!
resultClass
	^ RBClassEnvironment! !

!RBDefinesEqualNotHashRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 21:11'!
rationale
	^ 'Checks that all classes that define = also define hash.'! !

!RBDefinesEqualNotHashRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Possible bugs'! !

!RBDefinesEqualNotHashRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Defines = but not hash'! !

!RBDefinesEqualNotHashRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 10:05'!
category 
	^ 'Potential Bugs'! !

!RBDefinesEqualNotHashRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:49'!
checkClass: aClass 
	((aClass includesSelector: #=) and: [ (aClass includesSelector: #hash) not ]) ifTrue: [ result addClass: aClass ]! !

!RBDefinesEqualNotHashRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'DefinesEqualNotHashRule'! !

!RBDeprecateMethodRefactoring commentStamp: 'MarkRizun 7/21/2014 16:06'!
A RBDeprecateMethodRefactoring is a class, that represents functionality of deprecate refactoring.

Instance Variables
	oldSelector	:	<Object>
	newSelector:		<Object>

oldSelector
	- is a selector which shouldn't be used anymore, it's deprecated
newSelector
	- is a selector which will be used instead of a deprecated one
	
Note: 
It is recommended to use this refactoring only if number of arguments is either equal in both selectors, or the new one has no arguments at all.
If new selector has fewer number of arguments than the old one, it may lead to unexpected results.
If you use it in other conditions an error may be be occured.!
!RBDeprecateMethodRefactoring methodsFor: 'transforming' stamp: 'PabloHerrero 1/5/2015 12:57'!
formRewriteRule
	| searchString oldKeywords oldArgs replaceString newKeywords newArgs |
	oldKeywords := (class methodFor: oldSelector) parseTree keywords asOrderedCollection ifNil: [ '' ].
	oldArgs := (class methodFor: oldSelector) parseTree arguments ifNil: [ '' ].
	newKeywords := (class methodFor: newSelector) parseTree keywords asOrderedCollection ifNil: [ '' ].
	newArgs := (class methodFor: newSelector) parseTree arguments ifNil: [ '' ].
	
	searchString := 'self '.
	
	(oldKeywords size >= 1 and: [ oldArgs size >= 1 ])
		ifTrue: [ 1 to: oldKeywords size do: [ :i | oldKeywords add: ' ``@arg' , i asString , ' ' afterIndex: 2 * i - 1 ] ].
	(oldKeywords size >= 1 and: [ oldArgs size >= 1 ])
		ifTrue: [ 1 to: oldKeywords size do: [ :i | searchString := searchString , (oldKeywords at: i) ] ]
		ifFalse: [ searchString := searchString , oldSelector asString ].
	replaceString := 'self '.
	(newKeywords size >= 1 and: [ newArgs size >= 1 ])
		ifTrue: [ 1 to: newKeywords size do: [ :i | newKeywords add: ' ``@arg' , i asString , ' ' afterIndex: 2 * i - 1 ] ].
	(newKeywords size >= 1 and: [ newArgs size >= 1 ])
		ifTrue: [ 1 to: newKeywords size do: [ :i | replaceString := replaceString , (newKeywords at: i) ] ]
		ifFalse: [ replaceString := replaceString , newSelector asString ].
	^ RBParseTreeRewriter new replace: searchString with: replaceString! !

!RBDeprecateMethodRefactoring methodsFor: 'transforming' stamp: 'MarkRizun 7/25/2014 10:08'!
formDeprecatedMethod
	| oldName protocol newName deprecatedSource category |
	oldName := self formOldName.
	newName := self formNewName.
	protocol := (class methodFor: newSelector) protocols.
	class isMeta ifTrue: [ category := class realClass category ] ifFalse: [ category := class category ].
	deprecatedSource := oldName , String cr , String tab
		,
			'self 
		deprecated: ''Use ' , newSelector asString
		,
			' instead''
		on: 	''' , Date today asString
		,
			''' 
		in: ''' , category asString
		,
			'''.
	^ self ' , newName.
	(model classNamed: class realClass name) compile: deprecatedSource classified: protocol! !

!RBDeprecateMethodRefactoring methodsFor: 'preconditions' stamp: 'MarkRizun 7/21/2014 15:36'!
preconditions
	| newCondition |
	newCondition := (RBCondition 
							withBlock: [oldSelector numArgs = newSelector numArgs or: [ newSelector numArgs = 0 ]]
							errorString: 'The new selectors should have the same number of arguments as the old one, or not have them at all').
	^newCondition! !

!RBDeprecateMethodRefactoring methodsFor: 'printing' stamp: 'MarkRizun 7/21/2014 10:34'!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream
		nextPutAll: ' deprecateMethod: #';
		nextPutAll: oldSelector;
		nextPutAll: ' in: '.
	class storeOn: aStream.
	aStream
		nextPutAll: ' using: #';
		nextPutAll: newSelector.
	aStream nextPut: $)! !

!RBDeprecateMethodRefactoring methodsFor: 'transforming' stamp: 'MarkRizun 7/22/2014 14:07'!
transform
	| methods subclassesMethods rewriter thisSubclasses |
	self formDeprecatedMethod.
	thisSubclasses := class allSubclasses.
	methods := class selectors asOrderedCollection.
	subclassesMethods := OrderedCollection new.
	rewriter := self formRewriteRule.
	methods
		do: [ :each | 
			(rewriter executeTree: (class methodFor: each) parseTree)
				ifTrue: [ class compileTree: rewriter tree ] ].
	thisSubclasses
		do: [ :eachSubclass | 
			eachSubclass selectors asOrderedCollection
				do: [ :each | 
					(rewriter executeTree: (eachSubclass methodFor: each) parseTree)
						ifTrue: [ eachSubclass compileTree: rewriter tree ] ] ]! !

!RBDeprecateMethodRefactoring methodsFor: 'transforming' stamp: 'PabloHerrero 1/5/2015 12:38'!
formNewName
	^ self formNameFor: newSelector! !

!RBDeprecateMethodRefactoring methodsFor: 'transforming' stamp: 'MarkRizun 7/21/2014 10:34'!
deprecateMethod: aSelector in: aClass using: newSel
	oldSelector := aSelector.
	newSelector := newSel.
	class := self classObjectFor: aClass! !

!RBDeprecateMethodRefactoring methodsFor: 'transforming' stamp: 'PabloHerrero 1/5/2015 12:38'!
formOldName
	^ self formNameFor: oldSelector! !

!RBDeprecateMethodRefactoring methodsFor: 'transforming' stamp: 'PabloHerrero 1/5/2015 12:44'!
formNameFor: aSelector
	| method keywords arguments |
	method := class methodFor: aSelector.
	keywords := method parseTree keywords asOrderedCollection ifNil: [ '' ].
	arguments := method parseTree arguments ifNil: [ '' ].

	(keywords size >= 1 and: [ arguments size >= 1 ]) 
		ifTrue: [ ^ String streamContents: [ :s| 
			keywords with: arguments do: [ :keyword :arg | s nextPutAll: keyword, ' ', arg name, ' ' ] ] ]
		ifFalse: [ ^ aSelector asString ].
	
! !

!RBDeprecateMethodRefactoring class methodsFor: 'as yet unclassified' stamp: 'MarkRizun 7/20/2014 20:49'!
model: aRBSmalltalk deprecateMethod: aSelector in: aClass using: newSelector
	^(self new)
		model: aRBSmalltalk;
		deprecateMethod: aSelector
			in: aClass
			using: newSelector;
		yourself! !

!RBDeprecateMethodTest methodsFor: 'tests' stamp: 'MarkRizun 7/22/2014 14:29'!
testSenderNotSelf
	| refactoring class |
	refactoring := RBDeprecateMethodRefactoring
		model: RBNamespace new
		deprecateMethod: #junk
		in: RBLintRuleTest
		using: #run.
	self executeRefactoring: refactoring.
	class := refactoring model classNamed: #RBLintRuleTest.
	self
		assert:
			(class parseTreeFor: #someOtherDemoMethod)
				=
					(RBParser
						parseMethod:
							'someOtherDemoMethod
	| temp |
	temp := self new.
	^ temp junk').
	self
		deny:
			(class parseTreeFor: #someOtherDemoMethod)
				=
					(RBParser
						parseMethod:
							'someOtherDemoMethod
	| temp |
	temp := self new.
	^ temp run')! !

!RBDeprecateMethodTest methodsFor: 'failure tests' stamp: 'MarkRizun 7/21/2014 16:29'!
testTooManyArguments
	self
		shouldFail:
			(RBDeprecateMethodRefactoring
				model: RBNamespace new
				deprecateMethod: #foobar
				in: RBBasicLintRuleTest
				using: #runOnEnvironment:)! !

!RBDeprecateMethodTest methodsFor: 'failure tests' stamp: 'MarkRizun 7/22/2014 11:07'!
testWrongNumberOfArguments
	self
		shouldFail:
			(RBDeprecateMethodRefactoring
				model: RBNamespace new
				deprecateMethod: #method:with:lots:of:arguments:
				in: RBBasicLintRuleTest
				using: #runOnEnvironment:)! !

!RBDeprecateMethodTest methodsFor: 'tests' stamp: 'MarkRizun 7/22/2014 11:15'!
testDeprecateMethod
	| refactoring class |
	refactoring := RBDeprecateMethodRefactoring
		model: RBNamespace new
		deprecateMethod: #checkMethod:
		in: RBBasicLintRuleTest
		using: #foobar.
	self executeRefactoring: refactoring.
	class := refactoring model classNamed: #RBBasicLintRuleTest.
	self
		assert:
			(class parseTreeFor: #checkMethod:)
				=
					(RBParser
						parseMethod:
							'checkMethod: aSmalllintContext 
	self 
		deprecated: ''Use foobar instead''
		on: 	''' , Date today asString
		,
			'''
		in: ''Refactoring-Tests-Core-Data''.
	^ self foobar' ).! !

!RBDeprecateMethodTest methodsFor: 'tests' stamp: 'MarkRizun 7/22/2014 13:18'!
testDeprecateMethodWithLotsOfArguments
	| refactoring class |
	refactoring := RBDeprecateMethodRefactoring
		model: RBNamespace new
		deprecateMethod: #method:with:lots:of:arguments:
		in: RBBasicLintRuleTest
		using: #resetResult.
	self executeRefactoring: refactoring.
	class := refactoring model classNamed: #RBBasicLintRuleTest.
	self
		assert:
			(class parseTreeFor: #method:with:lots:of:arguments:)
				=
					(RBParser
						parseMethod:
							'method: anObject1 with: anObject2 lots: anObject3 of: anObject4 arguments: anObject5 
	self 
		deprecated: ''Use resetResult instead''
		on: 	''' , Date today asString
		,
			''' 
		in: ''Refactoring-Tests-Core-Data''.
	^ self resetResult').! !

!RBDeprecateMethodTest methodsFor: 'tests' stamp: 'MarkRizun 7/25/2014 10:25'!
testDeprecateMethodOnClassSide
	| refactoring class |
	refactoring := RBDeprecateMethodRefactoring
		model: RBNamespace new
		deprecateMethod: #someFooMethod
		in: RBLintRuleTest class
		using: #someOtherFooMethod.
	self executeRefactoring: refactoring.
	class := refactoring model classNamed: RBBasicLintRuleTest class name.
	self
		assert:
			(class parseTreeFor: #someFooMethod)
				=
					(RBParser
						parseMethod:
							'someFooMethod
	self 
		deprecated: ''Use someOtherFooMethod instead''
		on: 	''' , Date today asString
								,
									''' 
		in: ''Refactoring-Tests-Core-Data''.
	^ self someOtherFooMethod')! !

!RBDeprecateMethodTest methodsFor: 'tests' stamp: 'MarkRizun 7/22/2014 14:23'!
testDeprecateMethodWithSendersInSubclass
	| refactoring class |
	refactoring := RBDeprecateMethodRefactoring
		model: RBNamespace new
		deprecateMethod: #junk
		in: RBLintRuleTest
		using: #run.
	self executeRefactoring: refactoring.
	class := refactoring model classNamed: #RBLintRuleTest.
	self
		assert:
			(class parseTreeFor: #junk)
				=
					(RBParser
						parseMethod:
							'junk 
	self 
		deprecated: ''Use run instead''
		on: 	''' , Date today asString
		,
			''' 
		in: ''Refactoring-Tests-Core-Data''.
	^ self run').
	self
		assert:
			((class subclasses at: 1) parseTreeFor: #someDemoMethod)
				=
					(RBParser
						parseMethod:
							'someDemoMethod
	^ self run')! !

!RBDeprecateMethodTest methodsFor: 'tests' stamp: 'MarkRizun 8/26/2014 13:53'!
testDeprecateMethodWithSenders
	| refactoring class |
	refactoring := RBDeprecateMethodRefactoring
		model: RBNamespace new
		deprecateMethod: #resultClass:
		in: RBBasicLintRuleTest
		using: #newResultClass:.
	self executeRefactoring: refactoring.
	class := refactoring model classNamed: #RBBasicLintRuleTest.
	self
		assert:
			(class parseTreeFor: #resultClass:)
				=
					(RBParser
						parseMethod:
							'resultClass: aClass 
	self 
		deprecated: ''Use newResultClass: instead''
		on: 	''' , Date today asString
		,
			''' 
		in: ''Refactoring-Tests-Core-Data''.
	^ self newResultClass: aClass ').
	self
		assert:
			(class parseTreeFor: #initialize)
				=
					(RBParser
						parseMethod:
							'initialize
	super initialize.
	self anInstVar: 1.
	classBlock := [:context :aResult | ].
	methodBlock := [:context :aResult | ].
	self newResultClass: RBSelectorEnvironment')! !

!RBDeprecateWithFirstCharacterDownshifted commentStamp: 'StephaneDucasse 11/29/2014 18:01'!
Use uncapitalized instead of withFirstCharacterDownshifted since withFirstCharacterDownshifted is ugly and is deprecated now.!
!RBDeprecateWithFirstCharacterDownshifted methodsFor: 'initialization' stamp: 'NicolaiHess 9/21/2014 18:36'!
initialize
	super initialize.
	self rewriteRule
		replace: '``@object withFirstCharacterDownshifted' with: '``@object uncapitalized'.

! !

!RBDeprecateWithFirstCharacterDownshifted methodsFor: 'accessing' stamp: 'NicolaiHess 9/21/2014 18:33'!
group
	^ 'Transformations'! !

!RBDeprecateWithFirstCharacterDownshifted methodsFor: 'accessing' stamp: 'NicolaiHess 9/21/2014 18:33'!
name
	^ 'use uncapitalized instead of withFirstCharacterDownshifted'! !

!RBDeprecateWithFirstCharacterDownshifted methodsFor: 'accessing' stamp: 'NicolaiHess 9/21/2014 18:33'!
category 
	^'Style'! !

!RBDeprecateWithFirstCharacterDownshifted class methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 17:59'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'FirstCharacterDownShifted'! !

!RBDetectContainsRule commentStamp: 'StephaneDucasse 11/29/2014 21:27'!
Checks for bytecodePrimEqual  using the do: method instead of using the contains: or detect: methods.!
!RBDetectContainsRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:24'!
initialize
	super initialize.
	self matcher 
		matchesAnyOf: #(
			'`@collection do: [:`each | | `@temps | 
				`@.Statements1. 
				`@condition ifFalse: [| `@BlockTemps | `@.BlockStatements1. ^`each]. 
				`@.Statements2]'
			'`@collection do: [:`each | | `@temps | 
				`@.Statements1. 
				`@condition ifTrue: [| `@BlockTemps | `@.BlockStatements1.  ^`each]. 
				`@.Statements2]'
			'`@collection do: [:`each | | `@temps | 
				`@.Statements1. 
				`@condition ifFalse: [| `@BlockTemps | `@.BlockStatements1. ^true]. 
				`@.Statements2]'
			'`@Collection do: [:`each | | `@temps | 
				`@.Statements1. 
				`@condition ifTrue: [| `@BlockTemps | `@.BlockStatements1.  ^true]. 
				`@.Statements2]'
			'`@collection do: [:`each | | `@temps | 
				`@.Statements1. 
				`@condition ifFalse: [| `@BlockTemps | `@.BlockStatements1. ^false]. 
				`@.Statements2]'
			'`@collection do: [:`each | | `@temps | 
				`@.Statements1. 
				`@condition ifTrue: [| `@BlockTemps | `@.BlockStatements1.  ^false]. 
				`@.Statements2]' )
		do: [ :node :answer | node ]! !

!RBDetectContainsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Intention revealing'! !

!RBDetectContainsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Uses do: instead of contains: or detect:''s'! !

!RBDetectContainsRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 16:24'!
category
	^'Coding Idiom Violation'! !

!RBDetectContainsRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'DetectContainsRule'! !

!RBDetectIfNoneRule commentStamp: 'StephaneDucasse 11/29/2014 18:04'!
Replaces detect:ifNone: when used with the semantics of anySatisfy: by anySatisfy:.

For example, 

[[[ 
collection detect: [:each | .... ] ifNone: [nil]) notNil	
]]]
is transformed into 

[[[ 
collection anySatisfy: [ :each | .... ])
]]]!
!RBDetectIfNoneRule methodsFor: 'initialization' stamp: 'StephaneDucasse 11/29/2014 18:04'!
initialize
	super initialize.
	self rewriteRule
		replace: '``@collection contains: [:`each | | `@temps | ``@.Statements]'
		with: '``@collection anySatisfy: [:`each | | `@temps | ``@.Statements]';
		
		replace: '(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) isNil'
		with: '(``@collection anySatisfy: [:`each | | `@temps | ``@.Statements]) not';
		
		replace: '(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) = nil'
		with: '(``@collection anySatisfy: [:`each | | `@temps | ``@.Statements]) not';
		
		replace: '(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) == nil'
		with: '(``@collection anySatisfy: [:`each | | `@temps | ``@.Statements]) not';
		
		replace: '(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) notNil'
		with: '``@collection anySatisfy: [:`each | | `@temps | ``@.Statements]';
		
		replace: '(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) ~= nil'
		with: '``@collection anySatisfy: [:`each | | `@temps | ``@.Statements]';
		
		replace: '(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) ~~ nil'
		with: '``@collection anySatisfy: [:`each | | `@temps | ``@.Statements]'! !

!RBDetectIfNoneRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 18:02'!
rationale 
	^ 'Replaces detect:ifNone: by anySatisfy:'! !

!RBDetectIfNoneRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Transformations'! !

!RBDetectIfNoneRule methodsFor: 'accessing' stamp: 'lr 1/3/2010 11:55'!
name
	^ '#detect:ifNone: -> anySatisfy:'! !

!RBDetectIfNoneRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:50'!
category 
	^ 'Coding Idiom Violation'! !

!RBDetectIfNoneRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'DetectIfNoneRule'! !

!RBDoNotSendSuperInitializeInClassSideRule commentStamp: 'StephaneDucasse 11/29/2014 18:14'!
Don't send super initialize in class side because the class initialize methods of your superclass  may maintain state level shared state and it can be dangerous to automatically reinitialize it. 

For example, 

[[[  
ZnServer class>>initialize
	ManagedServers := IdentitySet new.
	AlwaysRestart := true.
	Smalltalk addToStartUpList: self.
	Smalltalk addToShutDownList: self
]]]!
!RBDoNotSendSuperInitializeInClassSideRule methodsFor: 'initialization' stamp: 'MartinDias 9/26/2014 15:19'!
initialize
	super initialize.
	self rewriteRule 
		replace: '``@.statBefore. super initialize. ``@.statAfter.' 
		with: '``@.statBefore. ``@.statAfter.' 
		when: [ :node | class isMeta and: [ node methodNode selector = #initialize ] ]! !

!RBDoNotSendSuperInitializeInClassSideRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 18:06'!
rationale
	^ 'Don''t send super initialize in class side because some class initialize of class of the top of the hierarchy should not be reinitialized.'! !

!RBDoNotSendSuperInitializeInClassSideRule methodsFor: 'accessing' stamp: 'MartinDias 9/26/2014 12:28'!
group
	^ 'Transformations'! !

!RBDoNotSendSuperInitializeInClassSideRule methodsFor: 'accessing' stamp: 'MartinDias 9/26/2014 15:25'!
name
	^ 'Class-side #initialize should not send "super initialize".'! !

!RBDoNotSendSuperInitializeInClassSideRule methodsFor: 'accessing' stamp: 'MartinDias 9/26/2014 12:29'!
category 
	^ 'Potential Bugs'! !

!RBDoNotSendSuperInitializeInClassSideRule class methodsFor: 'accessing' stamp: 'MartinDias 9/26/2014 15:26'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'DoNotSendSuperInitializeInClassSideRule'! !

!RBEmptyExceptionHandlerRule commentStamp: 'StephaneDucasse 11/29/2014 21:28'!
Empty exception handler blocks hide potential bugs. The situation should be handled in a more robust way.

[  .... ]
	on: Error
	do: [  ]
	
having an empty block is a bad idea because the program silently fails.!
!RBEmptyExceptionHandlerRule methodsFor: 'initialization' stamp: 'lr 3/13/2009 14:12'!
initialize
	super initialize.
	self matcher 
		matches: '`@block 
			on: `{ :node |
				| class |
				node isVariable 
					and: [ (class := Smalltalk classNamed: node name) notNil
					and: [ (class includesBehavior: Exception)
					and: [ (class includesBehavior: Notification) not ] ] ] }
			do: [ :`@err | | `@temps | ]'
		do: [ :node :answer | node ]! !

!RBEmptyExceptionHandlerRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 14:05'!
rationale
	^ 'Empty exception handler blocks hide potential bugs. The situation should be handled in a more robust way.'! !

!RBEmptyExceptionHandlerRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 13:31'!
group
	^ 'Possible bugs'! !

!RBEmptyExceptionHandlerRule methodsFor: 'accessing' stamp: 'lr 3/9/2010 16:07'!
name
	^ 'Empty exception handler'! !

!RBEmptyExceptionHandlerRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 16:25'!
category
	^'Potential Bugs'! !

!RBEmptyExceptionHandlerRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'EmptyExceptionHandlerRule'! !

!RBEndTrueFalseRule commentStamp: 'StephaneDucasse 11/29/2014 21:29'!
Checks for ifTrue:ifFalse: blocks that have the same code at the beginning or end. While you might not originally write such code, as it is modified, it is easier to create such code. Instead of having the same code in two places, you should move it outside the blocks.

For example, 
test 
	ifTrue: [self foo. self bar ] 
	ifFalse: [ self foo. self baz ]
 is equivalent to: 

self foo.  
test 
	ifTrue: [ self bar ] 
	ifFalse: [ self baz ]!
!RBEndTrueFalseRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:27'!
initialize
	super initialize.
	self matcher
		matchesAnyOf: #(
			'`@object 
				ifTrue: [| `@temps1 | `@.Statements1. `.Statement] 
				ifFalse: [| `@temps2 | `@.Statements2. `.Statement]' 
			'`@object 
				ifTrue: [| `@temps1 | `.Statement. `@.Statements1] 
				ifFalse: [| `@temps2 | `.Statement. `@.Statements2]' 
			'`@object 
				ifFalse: [| `@temps1 | `@.Statements1. `.Statement] 
				ifTrue: [| `@temps2 | `@.Statements2. `.Statement]' 
			'`@object 
				ifFalse: [| `@temps1 | `.Statement. `@.Statements1] 
				ifTrue: [| `@temps2 | `.Statement. `@.Statement2]') 
			do: [ :node :answer | 
				answer isNil 
					ifTrue: [
						| statement |
						statement := node arguments first body statements last.
						(statement isVariable and: [ statement = node arguments last body statements last ]) 
							ifFalse: [ node ]
							ifTrue: [ nil ] ]
					ifFalse: [ answer ] ]! !

!RBEndTrueFalseRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 21:29'!
rationale
	^ 'Checks for ifTrue:ifFalse: blocks that have the same code at the beginning or end.'! !

!RBEndTrueFalseRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Unnecessary code'! !

!RBEndTrueFalseRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:09'!
severity
	^ #information! !

!RBEndTrueFalseRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 16:25'!
category
	^'Optimization'! !

!RBEndTrueFalseRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Check for same statements at end of ifTrue:ifFalse: blocks'! !

!RBEndTrueFalseRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'EndTrueFalseRule'! !

!RBEqualNilRule commentStamp: 'StephaneDucasse 11/29/2014 18:15'!
Replaces = nil and == nil by isNil, ~= nil and ~~ nil by notNil.
The compiler will then perform some optimizations. !
!RBEqualNilRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:31'!
initialize
	super initialize.
	self rewriteRule
		replace: '``@object = nil' with: '``@object isNil';
		replace: '``@object == nil' with: '``@object isNil';
		replace: '``@object ~= nil' with: '``@object notNil';
		replace: '``@object ~~ nil' with: '``@object notNil'! !

!RBEqualNilRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Transformations'! !

!RBEqualNilRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ '= nil -> isNil AND ~= nil -> notNil'! !

!RBEqualNilRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:50'!
category 
	^ 'Coding Idiom Violation'! !

!RBEqualNilRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'EqualNilRule'! !

!RBEqualNotUsedRule commentStamp: 'StephaneDucasse 11/29/2014 21:30'!
Checks for senders of comparator messages that do not use the result of the comparison.!
!RBEqualNotUsedRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:26'!
initialize
	super initialize.
	self matcher 
		matches: '`{:node | node isMessage and: [node isUsed not and: [#(#= #== #~= #~~ #< #> #<= #>=) includes: node selector]]}'
		do: [ :node :answer | node ]! !

!RBEqualNotUsedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Possible bugs'! !

!RBEqualNotUsedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Doesn''t use the result of a =, ~=, etc.'! !

!RBEqualNotUsedRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 16:27'!
category
	^'Potential Bugs'! !

!RBEqualNotUsedRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'EqualNotUsedRule'! !

!RBEqualsTrueRule commentStamp: 'StephaneDucasse 11/29/2014 21:31'!
Check for a =, ==, ~=, or ~~ message being sent to true/false or with true/false as the argument. Many times these can be eliminated since their receivers are already booleans. For example, "anObject isFoo == false" could be replaced with "anObject isFoo not" if isFoo always returns a boolean. Sometimes variables might refer to true, false, and something else, but this is considered bad style since the variable has multiple types.!
!RBEqualsTrueRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:27'!
initialize
	super initialize.
	self matcher 
		matchesAnyOf: #('true' 'false')
		do: [ :node :answer | 
			answer isNil 
				ifTrue: [
					(node parent isMessage and: [ #(#= #== #~= #~~) includes: node parent selector ]) 
						ifTrue: [ node ]
						ifFalse: [ nil ] ]
				ifFalse: [ answer ] ]! !

!RBEqualsTrueRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 21:33'!
rationale
	^ 'Check for a =, ==, ~=, or ~~ message being sent to true/false or with true/false as the argument.'! !

!RBEqualsTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Unnecessary code'! !

!RBEqualsTrueRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:09'!
severity
	^ #information! !

!RBEqualsTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Unnecessary "= true"'! !

!RBEqualsTrueRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 16:27'!
category
	^'Optimization'! !

!RBEqualsTrueRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'EqualsTrueRule'! !

!RBEquivalentSuperclassMethodsRule commentStamp: 'StephaneDucasse 11/29/2014 21:10'!
This smell arises when a method is equivalent to its superclass method. The methods are equivalent when they have the same abstract syntax tree, except for variables names. Such method does not add anything to the computation and can be removed since the superclass method have the same behaviour. 

Furthermore, the methods #new and #initialize are ignored once they are often overridden for compatilbity with other platforms. The ignored methods can be edited in RBEquivalentSuperclassMethodsRule>>ignoredSelectors!
!RBEquivalentSuperclassMethodsRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 11:22'!
category 	
	^ 'Design Flaws'! !

!RBEquivalentSuperclassMethodsRule methodsFor: 'accessing' stamp: 'lr 4/30/2010 12:08'!
ignoredSelectors
	"These methods are often overridden for compatilbity with other platforms."

	^ #( new initialize )! !

!RBEquivalentSuperclassMethodsRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 21:10'!
rationale
	^ 'Check for methods that are equivalent to their superclass methods.'! !

!RBEquivalentSuperclassMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Unnecessary code'! !

!RBEquivalentSuperclassMethodsRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:09'!
severity
	^ #information! !

!RBEquivalentSuperclassMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Methods equivalently defined in superclass'! !

!RBEquivalentSuperclassMethodsRule methodsFor: 'running' stamp: 'MarcusDenker 10/27/2014 18:00'!
checkMethod: aMethod
	| superclass supertree |
	(self ignoredSelectors includes: aMethod selector)
		ifTrue: [ ^ self ].
	aMethod methodClass superclass notNil ifTrue: [
		superclass := aMethod methodClass superclass 
			whichClassIncludesSelector: aMethod selector.
		superclass notNil ifTrue: [
			supertree := superclass parseTreeFor: aMethod selector.
			(supertree notNil and: [ supertree equalTo: aMethod ast exceptForVariables: supertree allDefinedVariables ]) 
				ifTrue: [ result addMethod: aMethod ] ] ]! !

!RBEquivalentSuperclassMethodsRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'EquivalentSuperclassMethodsRule'! !

!RBErrorToken commentStamp: '<historical>'!
I'm an scanned error.
I can have multiple causes.!
!RBErrorToken methodsFor: 'accessing' stamp: 'GiselaDecuzzi 6/10/2013 15:51'!
location
	^ location! !

!RBErrorToken methodsFor: 'testing' stamp: 'GiselaDecuzzi 6/10/2013 15:51'!
value: theValue start: tokenStart cause: errorCause location: errorPosition
	self value: theValue start: tokenStart .
	location := errorPosition.
	cause := errorCause .! !

!RBErrorToken methodsFor: 'accesing' stamp: 'GiselaDecuzzi 6/10/2013 10:48'!
cause
	^ cause! !

!RBErrorToken methodsFor: 'testing' stamp: 'GiselaDecuzzi 6/10/2013 10:40'!
isError
	^true! !

!RBErrorToken class methodsFor: 'instance creation' stamp: 'GiselaDecuzzi 6/10/2013 15:54'!
value: value start: tokenStart cause: errorCause location: thePosition
	^ self new
		value: value
			start: tokenStart
			cause: errorCause
			location: thePosition;
		yourself! !

!RBExcessiveArgumentsRule commentStamp: 'StephaneDucasse 11/29/2014 21:09'!
This smell arises when a method contains a long number of argument (five or more), which can indicate that a new object should be created to wrap the numerous parameters. The defined number of arguments can be edited in RBExcessiveArgumentsRule>>argumentsCount.

If the arguments are used in multiple methods this is a clear indication for the creation of an object representing the context in which the computation should occur. 
	
The defined number of arguments can be edited in #argumentsCount.!
!RBExcessiveArgumentsRule methodsFor: 'accessing' stamp: 'SeanDeNigris 1/31/2013 08:38'!
rationale
	^ 'Long argument lists (five or more) can indicate that a new object should be created to wrap the numerous parameters.'! !

!RBExcessiveArgumentsRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 15:52'!
group
	^ 'Miscellaneous'! !

!RBExcessiveArgumentsRule methodsFor: 'private' stamp: 'lr 6/15/2009 15:59'!
argumentsCount
	^ 5! !

!RBExcessiveArgumentsRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 10:06'!
category
	^ 'Design Flaws'! !

!RBExcessiveArgumentsRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 16:00'!
name
	^ 'Excessive number of arguments'! !

!RBExcessiveArgumentsRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 16:50'!
checkMethod: aMethod 
	aMethod numArgs >= self argumentsCount
		ifTrue: [ result addMethod: aMethod ]! !

!RBExcessiveArgumentsRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'ExcessiveArgumentsRule'! !

!RBExcessiveInheritanceRule commentStamp: 'StephaneDucasse 11/29/2014 21:08'!
This smell arises when a deep inheritance is found (depth of ten or more), which is usually a sign of a design flaw. It should be broken down and reduced to something manageable. The defined inheritance depth can be edited in RBExcessiveInheritanceRule>>inheritanceDepth.

Several possibilities can occur. Here are some hints:
- check whether some classes in the hierarchy just do not add enough behavior to require a class in itself
- check whether all the classes are the root of a kind of little inheritance hierarchy. 

Note that often a framework may already define a certain level of inheritance, with  other layers added by user code. This rule does not take these frameworks into account. 	
	
The defined inheritance depth can be edited in #inheritanceDepth.!
!RBExcessiveInheritanceRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'!
resultClass
	^ RBClassEnvironment! !

!RBExcessiveInheritanceRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 10:06'!
category
	^ 'Design Flaws'! !

!RBExcessiveInheritanceRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 21:09'!
rationale
	^ 'Deep inheritance (10+ depth) is usually a sign of a design flaw.'! !

!RBExcessiveInheritanceRule methodsFor: 'private' stamp: 'lr 6/15/2009 16:22'!
inheritanceDepth
	^ 10! !

!RBExcessiveInheritanceRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 16:03'!
group
	^ 'Miscellaneous'! !

!RBExcessiveInheritanceRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 16:03'!
name
	^ 'Excessive inheritance depth'! !

!RBExcessiveInheritanceRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:49'!
checkClass: aClass
	| count current |
	aClass isMeta
		ifTrue: [ ^ self ].
	count := 1.
	current := aClass.
	[ current isNil ] whileFalse: [
		self inheritanceDepth < count
			ifTrue: [ ^ result addClass: aClass; addClass: aClass class ].
		current := current superclass.
		count := count + 1 ]! !

!RBExcessiveInheritanceRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'ExcessiveInheritanceRule'! !

!RBExcessiveMethodsRule commentStamp: 'StephaneDucasse 11/29/2014 21:08'!
This smell arises when a large class is found (with 40 or more methods). Large classes are indications that it has too much responsibility. Try to break it down, and reduce the size to something manageable. The defined number of methods can be edit in RBExcessiveMethodsRule>>methodsCount.

A good design assigns one responsibility to a class. Ask yourself, "what is the key responsibility of this class?" Using the strategy design pattern may be a solution to structure and delegate some behavior. 

An indication that a class may have too many responsibilities is when different groups of methods access a subpart of the instance variables. In a large system, having some large classes is often inevitable; but when there are more than a couple of large classes, you should really reconsider your design. 
	
The defined number of methods can be edited in #methodsCount.!
!RBExcessiveMethodsRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'!
resultClass
	^ RBClassEnvironment! !

!RBExcessiveMethodsRule methodsFor: 'private' stamp: 'CamilleTeruel 3/29/2013 17:43'!
methodsCount
	^ 60! !

!RBExcessiveMethodsRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 10:06'!
category
	^ 'Design Flaws'! !

!RBExcessiveMethodsRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 21:08'!
rationale
	^ 'Large classes are indications that the class may be trying to do too much.'! !

!RBExcessiveMethodsRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 15:57'!
group
	^ 'Miscellaneous'! !

!RBExcessiveMethodsRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 15:58'!
name
	^ 'Excessive number of methods'! !

!RBExcessiveMethodsRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:49'!
checkClass: aClass 
	aClass selectors size >= self methodsCount
		ifTrue: [ result addClass: aClass ]! !

!RBExcessiveMethodsRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'ExcessiveMethodsRule'! !

!RBExcessiveVariablesRule commentStamp: 'StephaneDucasse 11/29/2014 21:07'!
Sometimes instance variables are used instead of method arguments or temporaries. You can check if an instance variable's value is always valid during the complete lifetime of an object. In addition, looking at methods used together by a group of methods may be an indication that a new object should be created. Large classes often exhibit a large number of instance variables. Some people also confuse classes and namespaces. 

The defined number of instance variables can be edited in #variablesCount.!
!RBExcessiveVariablesRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'!
resultClass
	^ RBClassEnvironment! !

!RBExcessiveVariablesRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 10:07'!
category
	^ 'Design Flaws'! !

!RBExcessiveVariablesRule methodsFor: 'accessing' stamp: 'SeanDeNigris 1/31/2013 08:48'!
rationale
	^ 'Classes that have too many instance variables (10+) could be redesigned to have fewer fields, possibly through some nested object grouping.'! !

!RBExcessiveVariablesRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 16:09'!
group
	^ 'Miscellaneous'! !

!RBExcessiveVariablesRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 16:09'!
name
	^ 'Excessive number of variables'! !

!RBExcessiveVariablesRule methodsFor: 'private' stamp: 'lr 6/15/2009 16:23'!
variablesCount
	^ 10! !

!RBExcessiveVariablesRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:49'!
checkClass: aClass
	(aClass instVarNames size >= self variablesCount
		or: [ aClass classVarNames size >= self variablesCount ])
			ifTrue: [ result addClass: aClass ]! !

!RBExcessiveVariablesRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'ExcessiveVariablesRule'! !

!RBExpandReferencedPoolsRefactoring methodsFor: 'transforming' stamp: ''!
movePoolVariables
	pools 
		do: [:poolDict | toClasses do: [:each | self movePool: poolDict toClass: each]]! !

!RBExpandReferencedPoolsRefactoring methodsFor: 'transforming' stamp: ''!
whichPoolDefines: varName 
	| currentClass |
	currentClass := fromClass.
	[currentClass isNil] whileFalse: 
			[currentClass allPoolDictionaryNames 
				do: [:each | ((self poolVariableNamesIn: each) includes: varName) ifTrue: [^each]].
			currentClass := currentClass superclass].
	^nil! !

!RBExpandReferencedPoolsRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'!
computePoolsToMove
	| poolVariables searcher |
	poolVariables := self poolVariableNamesFor: fromClass.
	pools := Set new.
	searcher := RBParseTreeSearcher new.
	searcher matches: '`var'
		do: 
			[:aNode :answer | 
			| varName pool |
			varName := aNode name.
			(aNode whoDefines: varName) isNil 
				ifTrue: 
					[(poolVariables includes: varName) 
						ifTrue: 
							[pool := self whichPoolDefines: varName.
							pool notNil ifTrue: [pools add: pool]]]].
	searcher executeTree: parseTree! !

!RBExpandReferencedPoolsRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^RBCondition empty! !

!RBExpandReferencedPoolsRefactoring methodsFor: 'transforming' stamp: ''!
transform
	self computePoolsToMove.
	self hasPoolsToMove 
		ifTrue: 
			[self 
				refactoringWarning: 'This method contains references to pools<n>which may need to be moved.' 
						expandMacros].
	self movePoolVariables! !

!RBExpandReferencedPoolsRefactoring methodsFor: 'transforming' stamp: 'lr 7/23/2010 08:04'!
poolVariableNamesIn: poolName 
	^(Smalltalk globals at: poolName ifAbsent: [Dictionary new]) keys 
		collect: [:name | name asString]! !

!RBExpandReferencedPoolsRefactoring methodsFor: 'transforming' stamp: 'lr 10/26/2009 22:08'!
movePool: aSymbol toClass: aClass 
	| nonMetaClass |
	nonMetaClass := aClass theNonMetaClass.
	(nonMetaClass definesPoolDictionary: aSymbol) ifFalse: [ nonMetaClass addPoolDictionary: aSymbol ]! !

!RBExpandReferencedPoolsRefactoring methodsFor: 'testing' stamp: ''!
hasPoolsToMove
	^pools isEmpty not! !

!RBExpandReferencedPoolsRefactoring methodsFor: 'initialize-release' stamp: ''!
forMethod: aParseTree fromClass: aClass toClasses: classCollection 
	fromClass := self model classFor: aClass.
	parseTree := aParseTree.
	toClasses := classCollection collect: [:each | self model classFor: each]! !

!RBExpandReferencedPoolsRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBNamespace forMethod: aParseTree fromClass: aClass toClasses: classCollection 
	^(self new)
		model: aRBNamespace;
		forMethod: aParseTree
			fromClass: aClass
			toClasses: classCollection;
		yourself! !

!RBExpandReferencedPoolsRefactoring class methodsFor: 'instance creation' stamp: ''!
forMethod: aParseTree fromClass: aClass toClasses: classCollection 
	^(self new)
		forMethod: aParseTree
			fromClass: aClass
			toClasses: classCollection;
		yourself! !

!RBExplicitRequirementMethodsRule commentStamp: 'MarcusDenker 12/1/2014 13:35'!
Classes that use traits with explicit requirement methods should either implement the method or inherit it.!
!RBExplicitRequirementMethodsRule methodsFor: 'accessing' stamp: 'SebastianTleye 7/19/2013 10:13'!
rationale
	^ 'Classes that use traits with explicit requirement methods should either implement the method or inherit it.'! !

!RBExplicitRequirementMethodsRule methodsFor: 'accessing' stamp: 'SebastianTleye 7/19/2013 10:15'!
name
	^ 'Explicit requirement methods'! !

!RBExplicitRequirementMethodsRule methodsFor: '*Manifest-Core' stamp: 'MarcusDenker 11/11/2014 16:03'!
category 
    ^ 'Coding Idiom Violation'! !

!RBExplicitRequirementMethodsRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:49'!
checkClass: aClass 

	| selectedClass explicitRequirementMethods |
	explicitRequirementMethods := Set new.
	selectedClass := aClass.
	
	selectedClass isTrait 
		ifTrue: [ ^ self ].
		
	selectedClass traitComposition allSelectors do: [ :selector | | method |
				method := selectedClass>>selector.
				 (method isRequired and: [ method isSubclassResponsibility not ]) 
						ifTrue: [ explicitRequirementMethods add: method ]].
	
	explicitRequirementMethods do: [ :method |
		aClass withAllSuperclasses 
			detect: [ :superclass | superclass canPerform: method selector ] ifNone: [result addClass: aClass selector: method selector]].! !

!RBExplicitVariableParser commentStamp: '<historical>'!
I am a specialized version of the RBParser that takes the specialized sublcasses of RBVariableNode into account.!
!RBExplicitVariableParser methodsFor: 'private-classes' stamp: 'CamilloBruni 12/15/2011 16:15'!
variableNodeClass
	^ currentVariableNodeClass ifNil: [ RBVariableNode ]! !

!RBExplicitVariableParser methodsFor: 'private-classes' stamp: 'CamilloBruni 12/15/2011 16:15'!
useVariable: aVariableNodeClass during: aBlock
	currentVariableNodeClass := aVariableNodeClass.
	^ aBlock ensure: [ currentVariableNodeClass := nil]! !

!RBExplicitVariableParser methodsFor: 'private-classes' stamp: 'CamilloBruni 12/15/2011 16:16'!
argumentNodeClass
	^ RBArgumentNode! !

!RBExplicitVariableParser methodsFor: 'private-parsing' stamp: 'PabloHerrero 10/23/2013 16:16'!
parsePrimitiveIdentifier
	| token node |
	token := currentToken.
	self step.
	node := (self lookupVariableNodeClass: token value) identifierNamed: token value at: token start.
	self addCommentsTo: node.
	^node! !

!RBExplicitVariableParser methodsFor: 'private-classes' stamp: 'CamilloBruni 12/15/2011 16:35'!
lookupVariableNodeClass: aName
	| scope |
	
	currentVariableNodeClass notNil ifTrue: [ ^ currentVariableNodeClass ].
	scope := currentScope.
	[ scope isNil ]  whileFalse: [
		(scope hasTemporaryNamed: aName) ifTrue: [ ^ RBTemporaryNode ].
		(scope hasArgumentNamed: aName) ifTrue: [ ^ RBArgumentNode ].
		scope := scope scope.
	].
	
	^ RBVariableNode! !

!RBExplicitVariableParser methodsFor: 'private-classes' stamp: 'CamilloBruni 12/15/2011 16:16'!
temporaryNodeClass
	^ RBTemporaryNode! !

!RBExplicitVariableParser methodsFor: 'private-parsing' stamp: 'CamilloBruni 10/31/2012 18:38'!
parseBlock
	| position node |
	position := currentToken start.
	self step.
	node := self blockNodeClass new. 
	self pushScope: node.
	
	self useVariable: RBArgumentNode during: [ self parseBlockArgsInto: node ].
	node left: position.
	
	node body: self sequenceNodeClass new.
	(self parseStatements: false into: node body).
	
	(currentToken isSpecial and: [currentToken value = $]])
		ifFalse: [  ^ self parserError: ''']'' expected'].
	node right: currentToken start.
	
	self step.
	self popScope.
	^node! !

!RBExplicitVariableParser methodsFor: 'scoping' stamp: 'CamilloBruni 12/15/2011 16:27'!
pushScope: aNode
	aNode scope: currentScope.
	currentScope := aNode! !

!RBExplicitVariableParser methodsFor: 'private-parsing' stamp: 'ClementBera 7/26/2013 17:10'!
parseMethod
	| methodNode | 
	
	self useVariable: RBArgumentNode during: [methodNode := self parseMessagePattern].
	
	self pushScope: methodNode.
	
	self parsePragmas.
	self addCommentsTo: methodNode.
	
	methodNode body: self sequenceNodeClass new.
	(self parseStatements: false into: methodNode body).
	
	pragmas ifNotNil: [ methodNode pragmas: pragmas ].
	^methodNode! !

!RBExplicitVariableParser methodsFor: 'scoping' stamp: 'CamilloBruni 12/15/2011 16:27'!
popScope
	currentScope := currentScope scope! !

!RBExplicitVariableParser methodsFor: 'private-parsing' stamp: 'CamilloBruni 12/15/2011 16:17'!
parseTemps
	| args |
	args := OrderedCollection new.
	self useVariable: RBTemporaryNode during: [
		[currentToken isIdentifier] whileTrue: [args add: self parseVariableNode]].
	^args! !

!RBExtraBlockRule commentStamp: 'StephaneDucasse 11/29/2014 21:34'!
Check for blocks that are immediately evaluated. Since the block is immediately evaluated, there is no need for the statements to be in a block.
For example, [:x | 1 + x] value: 4 is equivalent to 1 + 4!
!RBExtraBlockRule methodsFor: 'initialization' stamp: 'CAMILLETERUEL 3/29/2013 12:50'!
initialize
	super initialize.
	self matcher 
		matches: '`{:node | node isMessage and: [node receiver isBlock and: [node parent isCascade not and: [#(#value #value: #value:value: #value:value:value: #valueWithArguments:) includes: node selector]]]}'
		do: [ :node :answer | node ]! !

!RBExtraBlockRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 21:34'!
rationale
	^ 'Check for blocks that are immediately evaluated.'! !

!RBExtraBlockRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Unnecessary code'! !

!RBExtraBlockRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:09'!
severity
	^ #information! !

!RBExtraBlockRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 16:28'!
category
	^'Optimization'! !

!RBExtraBlockRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Block immediately evaluated'! !

!RBExtraBlockRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'ExtraBlockRule'! !

!RBExtractMethodRefactoring methodsFor: 'transforming' stamp: ''!
checkReturn
	needsReturn := self placeholderNode isUsed.
	extractedParseTree containsReturn ifFalse: [^self].
	extractedParseTree lastIsReturn ifTrue: [^self].
	(modifiedParseTree isLast: self placeholderNode) 
		ifFalse: 
			[self refactoringError: 'Couldn''t extract code since it contains a return.'].
	self checkSelfReturns! !

!RBExtractMethodRefactoring methodsFor: 'transforming' stamp: ''!
checkTemporaries
	| temps accesses assigned |
	temps := self remainingTemporaries.
	accesses := temps select: [:each | extractedParseTree references: each].
	assigned := accesses select: [:each | extractedParseTree assigns: each].
	assigned isEmpty ifFalse: [self checkAssignments: assigned].
	^parameters := (accesses asOrderedCollection)
				removeAll: assigned;
				yourself! !

!RBExtractMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'!
checkSelfReturns
	| searcher |
	searcher := RBParseTreeSearcher new.
	searcher
		matches: '^self' do: [:aNode :answer | answer];
		matches: '^`@anything' do: [:aNode :answer | true].
	(searcher executeTree: extractedParseTree initialAnswer: false) 
		ifTrue: [self placeholderNode asReturn]! !

!RBExtractMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/23/2009 11:00'!
nameNewMethod: aSymbol 
	| args newSend |
	args := parameters collect: [:parm | RBVariableNode named: parm].
	extractedParseTree renameSelector: aSymbol andArguments: args asArray.
	aSymbol numArgs = 0 
		ifTrue: 
			[modifiedParseTree := RBParseTreeRewriter 
						replace: self methodDelimiter
						with: 'self ' , aSymbol asString
						in: modifiedParseTree.
			^self].
	newSend := WriteStream on: ''.
	aSymbol keywords with: parameters
		do: 
			[:key :arg | 
			newSend
				nextPutAll: key asString;
				nextPut: $ ;
				nextPutAll: arg asString;
				nextPut: $ ].
	modifiedParseTree := RBParseTreeRewriter 
				replace: self methodDelimiter
				with: 'self ' , newSend contents
				in: modifiedParseTree! !

!RBExtractMethodRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^(RBCondition definesSelector: selector in: class) 
		& (RBCondition withBlock: 
					[self extractMethod.
					self checkSpecialExtractions.
					self checkReturn.
					needsReturn ifTrue: [extractedParseTree addReturn].
					self checkTemporaries.
					true])! !

!RBExtractMethodRefactoring methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream nextPutAll: ' extract: '.
	extractionInterval storeOn: aStream.
	aStream
		nextPutAll: ' from: #';
		nextPutAll: selector;
		nextPutAll: ' in: '.
	class storeOn: aStream.
	aStream nextPut: $)! !

!RBExtractMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/1/2009 23:04'!
transform
	| existingSelector |
	existingSelector := self existingSelector.
	self nameNewMethod: (existingSelector isNil 
				ifTrue: [self getNewMethodName]
				ifFalse: [existingSelector]).
	existingSelector isNil 
		ifTrue: 
			[class compile: extractedParseTree newSource
				withAttributesFrom: (class methodFor: selector)].
	class compileTree: modifiedParseTree! !

!RBExtractMethodRefactoring methodsFor: 'transforming' stamp: 'CamilloBruni 10/8/2012 00:11'!
getExtractedSource
	| source |
	source := class sourceCodeFor: selector.
	((extractionInterval first between: 1 and: source size) 
		and: [extractionInterval last between: 1 and: source size]) 
			ifFalse: [self refactoringFailure: 'Invalid interval'].
	^source copyFrom: extractionInterval first to: extractionInterval last! !

!RBExtractMethodRefactoring methodsFor: 'transforming' stamp: ''!
checkAssignments: variableNames 
	| node outsideVars removeAssigned |
	removeAssigned := variableNames copy.
	node := self placeholderNode.
	outsideVars := variableNames 
				select: [:each | (node whoDefines: each) references: each].
	outsideVars size == 1 
		ifTrue: [self checkSingleAssignment: outsideVars asArray first].
	outsideVars size > 1 
		ifTrue: 
			[self refactoringError: 'Cannot extract assignment without all references.'].
	removeAssigned removeAll: outsideVars.
	(RBReadBeforeWrittenTester readBeforeWritten: removeAssigned
		in: extractedParseTree) isEmpty 
		ifFalse: 
			[self refactoringError: 'Cannot extract assignment if read before written.'].
	removeAssigned 
		do: [:each | (node whoDefines: each) removeTemporaryNamed: each].
	self createTemporariesInExtractedMethodFor: variableNames! !

!RBExtractMethodRefactoring methodsFor: 'transforming' stamp: 'CamilloBruni 10/8/2012 00:12'!
checkSpecialExtractions
	| node |
	node := self placeholderNode parent.
	node isNil ifTrue: [^self].
	(node isAssignment and: [node variable = self placeholderNode]) ifTrue: 
			[self refactoringFailure: 'Cannot extract left hand side of an assignment'].
	node isCascade ifTrue: 
			[self refactoringError: 'Cannot extract first message of a cascaded message']! !

!RBExtractMethodRefactoring methodsFor: 'initialize-release' stamp: ''!
extract: anInterval from: aSelector in: aClass 
	class := self classObjectFor: aClass.
	selector := aSelector.
	extractionInterval := anInterval! !

!RBExtractMethodRefactoring methodsFor: 'transforming' stamp: ''!
methodDelimiter
	^'#''place.holder.for.method'''! !

!RBExtractMethodRefactoring methodsFor: 'transforming' stamp: 'bh 5/10/2000 21:58'!
existingSelector
	"Try to find an existing method instead of creating a new one"

	^class allSelectors detect: [:each | self isMethodEquivalentTo: each]
		ifNone: [nil]! !

!RBExtractMethodRefactoring methodsFor: 'transforming' stamp: 'CamilloBruni 10/8/2012 00:11'!
extractMethod
	| parseTree isSequence extractCode subtree newCode |
	extractCode := self getExtractedSource.
	extractedParseTree := RBParser parseExpression: extractCode
				onError: [:string :pos | self refactoringError: 'Invalid source to extract - ', string].
	extractedParseTree isNil 
		ifTrue: [self refactoringError: 'Invalid source to extract'].
	(extractedParseTree isSequence 
		and: [extractedParseTree statements isEmpty]) 
			ifTrue: [self refactoringError: 'Select some code to extract'].
	isSequence := extractedParseTree isSequence 
				or: [extractedParseTree isReturn].
	extractedParseTree := RBMethodNode 
				selector: #value
				arguments: #()
				body: (extractedParseTree isSequence 
						ifTrue: [extractedParseTree]
						ifFalse: 
							[RBSequenceNode temporaries: #()
								statements: (OrderedCollection with: extractedParseTree)]).
	extractedParseTree body temporaries isEmpty not 
		ifTrue: [extractedParseTree body temporaries: #()].
	extractedParseTree source: extractCode.
	parseTree := class parseTreeFor: selector.
	parseTree isNil 
		ifTrue: [self refactoringFailure: 'Could not parse ' , selector printString].
	subtree := isSequence 
				ifTrue: 
					[RBParseTreeSearcher 
						treeMatchingStatements: extractedParseTree body formattedCode
						in: parseTree]
				ifFalse: [RBParseTreeSearcher treeMatching: extractCode in: parseTree].
	subtree isNil 
		ifTrue: [self refactoringFailure: 'Could not extract code from method'].
	newCode := self methodDelimiter.
	isSequence 
		ifTrue: 
			[| stmts |
			stmts := extractedParseTree body statements.
			stmts isEmpty 
				ifFalse: 
					[stmts last isAssignment 
						ifTrue: 
							[| name |
							name := stmts last variable name.
							(self shouldExtractAssignmentTo: name) 
								ifFalse: 
									[newCode := '<1s> := <2s>' expandMacrosWith: name with: newCode.
									stmts at: stmts size put: stmts last value]]]].
	modifiedParseTree := isSequence 
				ifTrue: 
					[RBParseTreeRewriter 
						replaceStatements: subtree formattedCode
						with: newCode
						in: parseTree
						onInterval: extractionInterval]
				ifFalse: 
					[RBParseTreeRewriter 
						replace: subtree formattedCode
						with: newCode
						in: parseTree
						onInterval: extractionInterval]! !

!RBExtractMethodRefactoring methodsFor: 'transforming' stamp: ''!
createTemporariesInExtractedMethodFor: assigned 
	assigned do: [:each | extractedParseTree body addTemporaryNamed: each]! !

!RBExtractMethodRefactoring methodsFor: 'transforming' stamp: 'CamilloBruni 10/8/2012 00:10'!
reorderParametersToMatch: aSelector 
	| tree dictionary |
	tree := class parseTreeFor: aSelector.
	dictionary := Dictionary new.
	tree body equalTo: extractedParseTree body withMapping: dictionary.
	parameters := tree arguments collect: 
					[:each | 
					dictionary at: each name
						ifAbsent: 
							[self 
								refactoringFailure: 'An internal error occured, please report this error.']]! !

!RBExtractMethodRefactoring methodsFor: 'transforming' stamp: 'CamilloBruni 10/8/2012 00:11'!
getNewMethodName
	| newSelector methodName newMethodName |
	methodName := RBMethodName new.
	methodName arguments: parameters.
	
	[newMethodName := self requestMethodNameFor: methodName.
	newMethodName isNil 
		ifTrue: [self refactoringFailure: 'Did not extract code'].
	newSelector := newMethodName selector.
	(self checkMethodName: newSelector in: class) 
		ifFalse: 
			[self refactoringWarning: newSelector , ' is not a valid selector name.'.
			newSelector := nil].
	(class hierarchyDefinesMethod: newSelector asSymbol) 
		ifTrue: 
			[(self shouldOverride: newSelector in: class) ifFalse: [newSelector := nil]].
	newSelector isNil] 
			whileTrue: [].
	parameters := newMethodName arguments asOrderedCollection.
	^newSelector asSymbol! !

!RBExtractMethodRefactoring methodsFor: 'transforming' stamp: ''!
remainingTemporaries
	| temps |
	temps := modifiedParseTree allDefinedVariables asSet.
	extractedParseTree allDefinedVariables 
		do: [:each | temps remove: each ifAbsent: []].
	^temps! !

!RBExtractMethodRefactoring methodsFor: 'transforming' stamp: ''!
isMethodEquivalentTo: aSelector 
	selector == aSelector ifTrue: [^false].
	aSelector numArgs ~~ parameters size ifTrue: [^false].
	(self isParseTreeEquivalentTo: aSelector) ifFalse: [^false].
	self reorderParametersToMatch: aSelector.
	^true! !

!RBExtractMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'!
checkSingleAssignment: varName 
	((RBReadBeforeWrittenTester isVariable: varName
		readBeforeWrittenIn: extractedParseTree) 
			or: [extractedParseTree containsReturn]) 
			ifTrue: 
				[self 
					refactoringError: 'Cannot extract assignments to temporaries without all references'].
	extractedParseTree 
		addNode: (RBReturnNode value: (RBVariableNode named: varName)).
	modifiedParseTree := RBParseTreeRewriter 
				replace: self methodDelimiter
				with: varName , ' := ' , self methodDelimiter
				in: modifiedParseTree! !

!RBExtractMethodRefactoring methodsFor: 'transforming' stamp: ''!
isParseTreeEquivalentTo: aSelector 
	| tree definingClass |
	definingClass := class whoDefinesMethod: aSelector.
	tree := definingClass parseTreeFor: aSelector.
	tree isNil ifTrue: [^false].
	tree isPrimitive ifTrue: [^false].
	(tree body equalTo: extractedParseTree body
		exceptForVariables: (tree arguments collect: [:each | each name])) 
			ifFalse: [^false].
	(definingClass = class or: 
			[(tree superMessages detect: 
					[:each | 
					(class superclass whichClassIncludesSelector: aSelector) 
						~= (definingClass superclass whichClassIncludesSelector: each)]
				ifNone: [nil]) isNil]) 
		ifFalse: [^false].
	^self shouldUseExistingMethod: aSelector! !

!RBExtractMethodRefactoring methodsFor: 'transforming' stamp: 'CamilloBruni 10/8/2012 00:10'!
placeholderNode
	| node |
	node := RBParseTreeSearcher treeMatching: self methodDelimiter
				in: modifiedParseTree.
	node isNil ifTrue: [self refactoringFailure: 'Cannot extract code'].
	^node! !

!RBExtractMethodRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBSmalltalk extract: anInterval from: aSelector in: aClass 
	^(self new)
		model: aRBSmalltalk;
		extract: anInterval
			from: aSelector
			in: aClass;
		yourself! !

!RBExtractMethodRefactoring class methodsFor: 'instance creation' stamp: ''!
extract: anInterval from: aSelector in: aClass 
	^self new
		extract: anInterval
		from: aSelector
		in: aClass! !

!RBExtractMethodTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testBadInterval
	self
		shouldFail: (RBExtractMethodRefactoring 
				extract: (self 
						convertInterval: (24 to: 30)
						for: (RBRefactoryTestDataApp sourceCodeAt: #testMethod))
				from: #testMethod
				in: RBRefactoryTestDataApp);
		shouldFail: (RBExtractMethodRefactoring 
				extract: (self 
						convertInterval: (80 to: 147)
						for: (RBBasicLintRuleTest class sourceCodeAt: #subclassOf:overrides:))
				from: #subclassOf:overrides:
				in: RBBasicLintRuleTest class)! !

!RBExtractMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testExtractMethodThatNeedsArgument
	| refactoring class |
	refactoring := RBExtractMethodRefactoring 
		extract: (self 
				convertInterval: (145 to: 343)
				for: (RBTransformationRuleTest sourceCodeAt: #checkMethod:))
		from: #checkMethod:
		in: RBTransformationRuleTest.
	self 
		setupMethodNameFor: refactoring
		toReturn: #foo:.
	self executeRefactoring: refactoring.
	class := refactoring model classNamed: #RBTransformationRuleTest.
	self assert: (class parseTreeFor: #checkMethod:) = (RBParser parseMethod: 'checkMethod: aSmalllintContext 
	class := aSmalllintContext selectedClass.
	(rewriteRule executeTree: aSmalllintContext parseTree) ifTrue: 
			[self foo: aSmalllintContext]').
	self assert: (class parseTreeFor: #foo:) = (RBParser parseMethod: 'foo: aSmalllintContext (RecursiveSelfRule executeTree: rewriteRule tree initialAnswer: false)
				ifFalse: 
					[builder compile: rewriteRule tree printString
						in: class
						classified: aSmalllintContext protocols]')! !

!RBExtractMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testExtractMethodAtEndOfMethodThatNeedsReturn
	| refactoring class |
	refactoring := RBExtractMethodRefactoring 
		extract: (self 
				convertInterval: (52 to: 133)
				for: (RBLintRuleTest sourceCodeAt: #openEditor))
		from: #openEditor
		in: RBLintRuleTest.
	self 
		setupMethodNameFor: refactoring
		toReturn: #foo:.
	self executeRefactoring: refactoring.
	class := refactoring model classNamed: #RBLintRuleTest.
	self assert: (class parseTreeFor: #openEditor) = (RBParser parseMethod: 'openEditor
	| rules |
	rules := self failedRules.
	^self foo: rules').
	self assert: (class parseTreeFor: #foo:) = (RBParser parseMethod: 'foo: rules
	rules isEmpty ifTrue: [^self].
	rules size == 1 ifTrue: [^rules first viewResults]')! !

!RBExtractMethodTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testNonExistantSelector
	self shouldFail: (RBExtractMethodRefactoring 
			extract: (10 to: 20)
			from: #checkClass1:
			in: RBBasicLintRuleTest)! !

!RBExtractMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testModelExtractMethodWithTemporaryAssigned
	| class refactoring |
	model := RBNamespace new.
	class := model classNamed: self class name.
	class 
		compile: 'foo 				| temp bar | 				bar := 5. 				temp := bar * bar. 				Transcript show: temp printString; cr. 				^temp * temp'
		classified: #(#accessing).
	refactoring := RBExtractMethodRefactoring 
				model: model
				extract: (26 to: 102)
				from: #foo
				in: class.
	self setupMethodNameFor: refactoring toReturn: #foobar.
	self executeRefactoring: refactoring.
	self assert: (class parseTreeFor: #foo) 
				= (RBParser parseMethod: 'foo | temp | temp := self foobar. ^temp * temp').
	self 
		assert: ((class parseTreeFor: #foobar) = (RBParser 
						parseMethod: 'foobar | bar temp | bar := 5. temp := bar * bar. Transcript show: temp printString; cr. ^temp.')) |
				((class parseTreeFor: #foobar) = (RBParser 
						parseMethod: 'foobar | temp bar | bar := 5. temp := bar * bar. Transcript show: temp printString; cr. ^temp.'))! !

!RBExtractMethodTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testExtractFailure
	self
		shouldFail: (RBExtractMethodRefactoring 
				extract: (self 
						convertInterval: (80 to: 269)
						for: (RBBasicLintRuleTest class sourceCodeAt: #subclassOf:overrides:))
				from: #subclassOf:overrides:
				in: RBBasicLintRuleTest class);
		shouldFail: (RBExtractMethodRefactoring 
				extract: (self 
						convertInterval: (53 to: 56)
						for: (RBBasicLintRuleTest class sourceCodeAt: #subclassOf:overrides:))
				from: #subclassOf:overrides:
				in: RBBasicLintRuleTest class);
		shouldFail: (RBExtractMethodRefactoring 
				extract: (self 
						convertInterval: (77 to: 222)
						for: (RBBasicLintRuleTest class sourceCodeAt: #subclassResponsibilityNotDefined))
				from: #subclassResponsibilityNotDefined
				in: RBBasicLintRuleTest class)! !

!RBExtractMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testModelExtractMethodWithTemporariesSelected
	| class refactoring |
	model := RBNamespace new.
	class := model classNamed: self class name.
	class compile: 'foo [| temp | temp := 5. temp * temp] value'
		classified: #(#accessing).
	refactoring := RBExtractMethodRefactoring 
				model: model
				extract: (6 to: 36)
				from: #foo
				in: class.
	self setupMethodNameFor: refactoring toReturn: #foobar.
	self executeRefactoring: refactoring.
	self assert: (class parseTreeFor: #foo) 
				= (RBParser parseMethod: 'foo [self foobar] value').
	self assert: (class parseTreeFor: #foobar) 
				= (RBParser parseMethod: 'foobar |temp | temp := 5. ^temp * temp')! !

!RBExtractMethodTest methodsFor: 'tests' stamp: 'MarkRizun 10/2/2014 13:57'!
testExtractMethodThatMovesTemporaryVariable
	| refactoring class |
	refactoring := RBExtractMethodRefactoring 
		extract: (self 
				convertInterval: (22 to: 280)
				for: (RBTransformationRuleTest sourceCodeAt: #superSends))
		from: #superSends
		in: RBTransformationRuleTest.
	self 
		setupMethodNameFor: refactoring
		toReturn: #foo1.
	self executeRefactoring: refactoring.
	class := refactoring model classNamed: #RBTransformationRuleTest.
	self assert: (class parseTreeFor: #superSends) = (RBParser parseMethod: 'superSends
	| rule |
	rule := self foo1.
	self rewriteUsing: rule').
	self assert: (class parseTreeFor: #foo1) = (RBParser parseMethod: 'foo1 | rule | 	rule := RBParseTreeRewriter new.
	rule addSearch: ''super `@message: ``@args''
				-> (
					[:aNode | 
					(class withAllSubclasses
						detect: [:each | each includesSelector: aNode selector]
						ifNone: [nil]) isNil]
							-> ''self `@message: ``@args'').
		^rule')! !

!RBExtractMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testExtractMethodThatNeedsTemporaryVariable
	| refactoring class |
	refactoring := RBExtractMethodRefactoring 
		extract: (self 
				convertInterval: (78 to: 197)
				for: (RBLintRuleTest sourceCodeAt: #displayName))
		from: #displayName
		in: RBLintRuleTest.
	self 
		setupMethodNameFor: refactoring
		toReturn: #foo:.
	self executeRefactoring: refactoring.
	class := refactoring model classNamed: #RBLintRuleTest.
	self assert: (class parseTreeFor: #displayName) = (RBParser parseMethod: 'displayName
	| nameStream |
	nameStream := WriteStream on: (String new: 64).
	self foo: nameStream.
	^nameStream contents').
	self assert: (class parseTreeFor: #foo:) = (RBParser parseMethod: 'foo: nameStream 	nameStream nextPutAll: self name;
		nextPutAll: '' (''.
	self problemCount printOn: nameStream.
	nameStream nextPut: $).')! !

!RBExtractMethodToComponentRefactoring methodsFor: 'transforming' stamp: 'lr 9/8/2011 20:11'!
inlineForwarder
	| refactoring |
	refactoring := RBInlineAllSendersRefactoring 
				model: self model
				sendersOf: extractedMethodSelector
				in: class.
	refactoring setOption: #inlineExpression toUse: [:ref :string | true].
	self performComponentRefactoring: refactoring! !

!RBExtractMethodToComponentRefactoring methodsFor: 'transforming' stamp: 'lr 9/8/2011 20:11'!
extractMethod
	| refactoring |
	refactoring := RBExtractMethodRefactoring 
				model: self model
				extract: extractionInterval
				from: selector
				in: class.
	refactoring setOption: #methodName
		toUse: 
			[:ref :methodName | 
			extractedMethodSelector := ref 
						uniqueMethodNameFor: methodName arguments size.
			methodName
				selector: extractedMethodSelector;
				yourself].
	self performComponentRefactoring: refactoring! !

!RBExtractMethodToComponentRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^RBCondition empty! !

!RBExtractMethodToComponentRefactoring methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream nextPutAll: ' extract: '.
	extractionInterval storeOn: aStream.
	aStream
		nextPutAll: ' from: #';
		nextPutAll: selector;
		nextPutAll: ' in: '.
	class storeOn: aStream.
	aStream nextPut: $)! !

!RBExtractMethodToComponentRefactoring methodsFor: 'transforming' stamp: ''!
transform
	self
		extractMethod;
		moveMethod;
		inlineForwarder! !

!RBExtractMethodToComponentRefactoring methodsFor: 'transforming' stamp: 'CamilloBruni 10/8/2012 00:10'!
moveMethod
	| variable refactoring |
	variable := self selectVariableToMoveMethodTo: extractedMethodSelector
				class: class.
	variable isNil ifTrue: [self refactoringFailure: 'Did not extract method'].
	refactoring := RBMoveMethodRefactoring 
				model: self model
				selector: extractedMethodSelector
				class: class
				variable: variable.
	self performComponentRefactoring: refactoring! !

!RBExtractMethodToComponentRefactoring methodsFor: 'initialize-release' stamp: ''!
extract: anInterval from: aSelector in: aClass 
	class := self classObjectFor: aClass.
	selector := aSelector.
	extractionInterval := anInterval! !

!RBExtractMethodToComponentRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBSmalltalk extract: anInterval from: aSelector in: aClass 
	^(self new)
		model: aRBSmalltalk;
		extract: anInterval
			from: aSelector
			in: aClass;
		yourself! !

!RBExtractMethodToComponentRefactoring class methodsFor: 'instance creation' stamp: ''!
extract: anInterval from: aSelector in: aClass 
	^self new
		extract: anInterval
		from: aSelector
		in: aClass! !

!RBExtractMethodToComponentTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testExtractFailure
	self
		shouldFail: (RBExtractMethodToComponentRefactoring 
				extract: (self 
						convertInterval: (80 to: 269)
						for: (RBBasicLintRuleTest class sourceCodeAt: #subclassOf:overrides:))
				from: #subclassOf:overrides:
				in: RBBasicLintRuleTest class);
		shouldFail: (RBExtractMethodToComponentRefactoring 
				extract: (self 
						convertInterval: (53 to: 56)
						for: (RBBasicLintRuleTest class sourceCodeAt: #subclassOf:overrides:))
				from: #subclassOf:overrides:
				in: RBBasicLintRuleTest class);
		shouldFail: (RBExtractMethodToComponentRefactoring 
				extract: (self 
						convertInterval: (77 to: 222)
						for: (RBBasicLintRuleTest class sourceCodeAt: #subclassResponsibilityNotDefined))
				from: #subclassResponsibilityNotDefined
				in: RBBasicLintRuleTest class)! !

!RBExtractMethodToComponentTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testBadInterval
	self
		shouldFail: (RBExtractMethodToComponentRefactoring 
				extract: (self 
						convertInterval: (24 to: 30)
						for: (RBRefactoryTestDataApp sourceCodeAt: #testMethod))
				from: #testMethod
				in: RBRefactoryTestDataApp);
		shouldFail: (RBExtractMethodToComponentRefactoring 
				extract: (self 
						convertInterval: (80 to: 147)
						for: (RBBasicLintRuleTest class sourceCodeAt: #subclassOf:overrides:))
				from: #subclassOf:overrides:
				in: RBBasicLintRuleTest class)! !

!RBExtractMethodToComponentTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testExtractMethodAtEndOfMethodThatNeedsReturn
	| refactoring class selectorsSize |
	refactoring := RBExtractMethodToComponentRefactoring 
		extract: (self 
				convertInterval: (52 to: 133)
				for: (RBLintRuleTest sourceCodeAt: #openEditor))
		from: #openEditor
		in: RBLintRuleTest.
	self 
		setupMethodNameFor: refactoring
		toReturn: #foo:.
	self 
		setupSelfArgumentNameFor: refactoring
		toReturn: 'asdf'.
	self 
		setupVariableToMoveToFor: refactoring
		toReturn: 'rules'.
	self 
		setupVariableTypesFor: refactoring
		toReturn: (Array with: (refactoring model classNamed: #Collection)).
	class := refactoring model classNamed: #RBLintRuleTest.
	selectorsSize := class selectors size.
	self proceedThroughWarning: [ self executeRefactoring: refactoring ].
	self assert: (class parseTreeFor: #openEditor) = (RBParser parseMethod: 'openEditor
								| rules |
								rules := self failedRules.
								^rules foo: self').
	self assert: ((refactoring model classNamed: #Collection) parseTreeFor: #foo:) = (RBParser parseMethod: 'foo: asdf
								self isEmpty ifTrue: [^asdf].
								self size == 1 ifTrue: [^self first viewResults].
								^asdf').
	self assert: class selectors size = selectorsSize! !

!RBExtractMethodToComponentTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testMoveWithoutSelfReference
	| refactoring class selectorsSize |
	refactoring := RBExtractMethodToComponentRefactoring 
				extract: (self convertInterval: (118 to: 286)
						for: (RBReadBeforeWrittenTester sourceCodeAt: #copyDictionary:))
				from: #copyDictionary:
				in: RBReadBeforeWrittenTester.
	self setupMethodNameFor: refactoring toReturn: #copyWithAssociations.
	self setupVariableToMoveToFor: refactoring toReturn: 'aDictionary'.
	self setupVariableTypesFor: refactoring
		toReturn: (Array with: (refactoring model classNamed: #Dictionary)).
	class := refactoring model classNamed: #RBReadBeforeWrittenTester.
	selectorsSize := class selectors size.
	self executeRefactoring: refactoring.
	self 
		assert: (class parseTreeFor: #copyDictionary:) = (RBParser 
						parseMethod: 'copyDictionary: aDictionary ^aDictionary copyWithAssociations').
	self 
		assert: ((refactoring model classNamed: #Dictionary) 
				parseTreeFor: #copyWithAssociations) = (RBParser 
							parseMethod: 'copyWithAssociations 
							| newDictionary |
							newDictionary := Dictionary new: self size.
							self
								keysAndValuesDo: [:key :value | newDictionary at: key put: value].
							^newDictionary').
	self assert: class selectors size = selectorsSize! !

!RBExtractMethodToComponentTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testNonExistantSelector
	self shouldFail: (RBExtractMethodToComponentRefactoring 
			extract: (10 to: 20)
			from: #checkClass1:
			in: RBBasicLintRuleTest)! !

!RBExtractToTemporaryRefactoring methodsFor: 'preconditions' stamp: 'CamilloBruni 10/8/2012 00:10'!
verifySelectedInterval
	| selectedParseTree selectedSources |
	selectedSources := self selectedSource.
	selectedParseTree := RBParser parseExpression: selectedSources
				onError: [:message :position | self refactoringFailure: 'Invalid selection'].
	selectedParseTree isSequence 
		ifTrue: [self refactoringFailure: 'Cannot assign temp to multiple statements']! !

!RBExtractToTemporaryRefactoring methodsFor: 'initialize-release' stamp: ''!
extract: anInterval to: aString from: aSelector in: aClass 
	class := self classObjectFor: aClass.
	selector := aSelector.
	sourceInterval := anInterval.
	newVariableName := aString! !

!RBExtractToTemporaryRefactoring methodsFor: 'private-accessing' stamp: 'CamilloBruni 10/7/2012 23:59'!
parseTree
	parseTree isNil 
		ifTrue: 
			[parseTree := class parseTreeFor: selector.
			parseTree isNil ifTrue: [self refactoringFailure: 'Could not parse method']].
	^parseTree! !

!RBExtractToTemporaryRefactoring methodsFor: 'transforming' stamp: ''!
compileNewMethod
	class compileTree: self parseTree! !

!RBExtractToTemporaryRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^(RBCondition definesSelector: selector in: class) 
		& (RBCondition isValidInstanceVariableName: newVariableName for: class) 
			& (RBCondition withBlock: 
						[self verifySelectedInterval.
						self checkVariableName.
						true])! !

!RBExtractToTemporaryRefactoring methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream nextPutAll: ' extract: '.
	sourceInterval storeOn: aStream.
	aStream
		nextPutAll: ' to: ''';
		nextPutAll: newVariableName;
		nextPutAll: ''' from: #';
		nextPutAll: selector;
		nextPutAll: ' in: '.
	class storeOn: aStream.
	aStream nextPut: $)! !

!RBExtractToTemporaryRefactoring methodsFor: 'transforming' stamp: ''!
transform
	self
		insertTemporary;
		compileNewMethod! !

!RBExtractToTemporaryRefactoring methodsFor: 'private-accessing' stamp: 'CamilloBruni 10/8/2012 00:10'!
selectedSource
	| source |
	source := class sourceCodeFor: selector.
	source isNil ifTrue: [self refactoringFailure: 'Couldn''t find sources'].
	((sourceInterval first between: 1 and: source size) 
		and: [sourceInterval last between: 1 and: source size]) 
			ifFalse: [self refactoringFailure: 'Invalid interval'].
	^source copyFrom: sourceInterval first to: sourceInterval last! !

!RBExtractToTemporaryRefactoring methodsFor: 'transforming' stamp: 'MarkRizun 7/16/2014 11:16'!
insertTemporary
	| node statementNode nodeReferences children |
	node := self parseTree whichNodeIsContainedBy: sourceInterval.
	(node notNil and: [ node isValue ])
		ifFalse: [ self refactoringFailure: 'Cannot assign to non-value nodes' ].
	children := self parseTree body allChildren.
	nodeReferences := children select: [ :each | each = node ] thenCollect: [ :each | each ].
	statementNode := node statementNode.
	nodeReferences do: [ :each | each replaceWith: (RBVariableNode named: newVariableName) ].
	statementNode parent
		addNode: (self constructAssignmentFrom: node)
			before:
				(node == statementNode
						ifTrue: [ RBVariableNode named: newVariableName ]
						ifFalse: [ statementNode ]);
		addTemporaryNamed: newVariableName! !

!RBExtractToTemporaryRefactoring methodsFor: 'transforming' stamp: ''!
constructAssignmentFrom: aNode 
	| valueNode |
	valueNode := RBVariableNode named: newVariableName.
	^RBAssignmentNode variable: valueNode value: aNode! !

!RBExtractToTemporaryRefactoring methodsFor: 'preconditions' stamp: ''!
checkVariableName
	(class whoDefinesInstanceVariable: newVariableName) notNil 
		ifTrue: 
			[self refactoringError: ('<1p> defines an instance variable named <2s>' 
						expandMacrosWith: class
						with: newVariableName)].
	(class whoDefinesClassVariable: newVariableName) notNil 
		ifTrue: 
			[self refactoringError: ('<1p> defines a class variabled named <2s>' 
						expandMacrosWith: class
						with: newVariableName)].
	(self parseTree allDefinedVariables includes: newVariableName) 
		ifTrue: 
			[self refactoringError: ('<1s> is already a temporary variable name' 
						expandMacrosWith: newVariableName)]! !

!RBExtractToTemporaryRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBSmalltalk extract: anInterval to: aString from: aSelector in: aClass 
	^(self new)
		model: aRBSmalltalk;
		extract: anInterval
			to: aString
			from: aSelector
			in: aClass;
		yourself! !

!RBExtractToTemporaryRefactoring class methodsFor: 'instance creation' stamp: ''!
extract: anInterval to: aString from: aSelector in: aClass 
	^self new 
		extract: anInterval
		to: aString
		from: aSelector
		in: aClass! !

!RBExtractToTemporaryTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testBadName
	self shouldFail: (RBExtractToTemporaryRefactoring 
			extract: (self 
					convertInterval: (14 to: 23)
					for: (RBRefactoryTestDataApp sourceCodeAt: #testMethod))
			to: 'a sdf'
			from: #testMethod
			in: RBRefactoryTestDataApp)! !

!RBExtractToTemporaryTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testExtractToTemporaryInsideBlock
	| refactoring |
	refactoring := RBExtractToTemporaryRefactoring 
		extract: (self 
				convertInterval: (133 to: 141)
				for: (RBRefactoryTestDataApp sourceCodeAt: #noMoveDefinition))
		to: 'asdf'
		from: #noMoveDefinition
		in: RBRefactoryTestDataApp.
	self executeRefactoring: refactoring.
	self assert: ((refactoring model classNamed: #RBRefactoryTestDataApp) parseTreeFor: #noMoveDefinition) = (RBParser parseMethod: 'noMoveDefinition
	| temp |
	^(self collect: 
			[:each | 
			temp := each printString.
			temp , temp]) 
		select: [:each | | asdf | asdf := each size. temp := asdf + temp]')! !

!RBExtractToTemporaryTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testBadInterval
	self
		shouldFail: (RBExtractToTemporaryRefactoring 
				extract: (self 
						convertInterval: (24 to: 30)
						for: (RBRefactoryTestDataApp sourceCodeAt: #testMethod))
				to: 'asdf'
				from: #testMethod
				in: RBRefactoryTestDataApp);
		shouldFail: (RBExtractToTemporaryRefactoring 
				extract: (self 
						convertInterval: (14 to: 105)
						for: (RBRefactoryTestDataApp sourceCodeAt: #testMethod1))
				to: 'asdf'
				from: #testMethod1
				in: RBRefactoryTestDataApp);
		shouldFail: (RBExtractToTemporaryRefactoring 
				extract: (self 
						convertInterval: (61 to: 101)
						for: (RBRefactoryTestDataApp sourceCodeAt: #noMoveDefinition))
				to: 'asdf'
				from: #noMoveDefinition
				in: RBRefactoryTestDataApp)! !

!RBExtractToTemporaryTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testExtractToTemporaryForLastStatementInBlock
	| refactoring |
	refactoring := RBExtractToTemporaryRefactoring 
		extract: (self 
				convertInterval: (52 to: 73)
				for: (RBRefactoryTestDataApp sourceCodeAt: #caller2))
		to: 'temp'
		from: #caller2
		in: RBRefactoryTestDataApp.
	self executeRefactoring: refactoring.
	self assert: ((refactoring model classNamed: #RBRefactoryTestDataApp) parseTreeFor: #caller2) = (RBParser parseMethod: 'caller2
	^(1 to: 10) inject: 1 into: [:sum :each | | temp | temp := sum * (self foo: each). temp]')! !

!RBExtractToTemporaryTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testNonExistantSelector
	self shouldFail: (RBExtractToTemporaryRefactoring 
			extract: (14 to: 23)
			to: 'asdf'
			from: #checkClass1:
			in: RBRefactoryTestDataApp)! !

!RBExtractToTemporaryTest methodsFor: 'tests' stamp: 'MarkRizun 7/16/2014 11:32'!
testExtractToTemporaryWithDuplicates
	| refactoring |
	refactoring := RBExtractToTemporaryRefactoring 
		extract: (self 
				convertInterval: (73 to: 77)
				for: (RBRefactoryTestDataApp sourceCodeAt: #demoMethodWithDuplicates))
		to: 'temp'
		from: #demoMethodWithDuplicates
		in: RBRefactoryTestDataApp.
	self executeRefactoring: refactoring.
	self assert: ((refactoring model classNamed: #RBRefactoryTestDataApp) parseTreeFor: #demoMethodWithDuplicates) = (RBParser parseMethod: 'demoMethodWithDuplicates
	| a b result1 result2 answer temp |
	a := 3.
	temp := a + 5.
	b := temp.
	result1 := a + b.
	result2 := temp.
	answer := result1 + result2 + temp.
	^ answer')! !

!RBFileBlocksRule commentStamp: 'StephaneDucasse 11/29/2014 21:36'!
Checks assignment to a variable that is the first statement inside the value block that is also used in the unwind block.!
!RBFileBlocksRule methodsFor: 'initialization' stamp: 'lr 11/19/2009 14:46'!
initialize
	super initialize.
	self matcher 
		matchesAnyOf: #(
			'[| `@temps | 
				`var := `@object.  
				`@.statements] 
						ensure: 
							[`var `@messages: `@args]'
			'[| `@temps | 
				`var := `@object.  
				`@.statements] 
						ifCurtailed: 
							[`var `@messages: `@args]' )
		do: [ :node :answer | node ]! !

!RBFileBlocksRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
rationale
	^ 'Checks assignment to a variable that is the first statement inside the value block that is also used in the unwind block.'! !

!RBFileBlocksRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Possible bugs'! !

!RBFileBlocksRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Assignment inside unwind blocks should be outside.'! !

!RBFileBlocksRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 16:29'!
category
	^'Potential Bugs'! !

!RBFileBlocksRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'FileBlocksRule'! !

!RBFindBlockArgumentAssignment commentStamp: 'NicolaiHess 8/23/2014 21:19'!
Find assignment nodes with block arguments on its left side.!
!RBFindBlockArgumentAssignment methodsFor: 'initialization' stamp: 'NicolaiHess 8/23/2014 21:20'!
initialize
	super initialize.
	arguments := Set new.
	argumentAssignments := Set new.
! !

!RBFindBlockArgumentAssignment methodsFor: 'visiting' stamp: 'NicolaiHess 10/10/2014 00:31'!
visitAssignmentNode: anAssignmentNode
	"search registered argument variable with the same name and scope"

	| varName |
	super visitAssignmentNode: anAssignmentNode.
	varName := anAssignmentNode variable name.
	arguments
		detect: [ :elem | elem name = varName and: [ self is: anAssignmentNode variable inScopeOf: elem ] ]
		ifFound: [ argumentAssignments add: varName ]! !

!RBFindBlockArgumentAssignment methodsFor: 'visiting' stamp: 'NicolaiHess 8/23/2014 21:20'!
visitTemporaryNodes: aNodeCollection
	"here our trait calls visitArgumentNodes: but we are not interested on temporary nodes -> ignore this."
	! !

!RBFindBlockArgumentAssignment methodsFor: 'visiting' stamp: 'NicolaiHess 8/23/2014 21:20'!
executeTree: aParseTree
	^ self visitNode: aParseTree! !

!RBFindBlockArgumentAssignment methodsFor: 'accessing' stamp: 'NicolaiHess 8/23/2014 21:20'!
assignments
	^  argumentAssignments! !

!RBFindBlockArgumentAssignment methodsFor: 'private' stamp: 'NicolaiHess 10/10/2014 00:30'!
is: aVar inScopeOf: anArgumentNode
	"if this Var is a child of if anArgumentNode parent, then the
assignment on aVar happens in scope of the BlockNode of this ArgumentNode "

	| parent |
	parent := aVar parent.
	[ parent notNil ]
		whileTrue: [ 
			parent = anArgumentNode parent
				ifTrue: [ ^ true ].
			parent := parent parent ].
	^ false! !

!RBFindBlockArgumentAssignment methodsFor: 'visiting' stamp: 'NicolaiHess 10/8/2014 23:44'!
visitArgumentNode: anArgumentNode
	"register argument node if it is an block argument"

	anArgumentNode parent isBlock
		ifTrue: [ arguments add: anArgumentNode ]! !

!RBFindBlockArgumentAssignment class methodsFor: 'accessing' stamp: 'NicolaiHess 8/23/2014 21:21'!
collectAssignments: aParseTree
	^ (self new executeTree: aParseTree) assignments! !

!RBFloatEqualityComparisonRule commentStamp: 'StephaneDucasse 11/29/2014 21:42'!
Floating point types are imprecise. Using the operators = or ~= might not yield the expected result due to internal rounding differences.!
!RBFloatEqualityComparisonRule methodsFor: 'initialization' stamp: 'MarcusDenker 9/20/2013 15:38'!
initialize
	super initialize.
	self matcher 
		matchesAnyOf: #(
			'`{ :node | node isLiteralNode and: [ node value isFloat ] } = `@expr'
			'`{ :node | node isLiteralNode and: [ node value isFloat ] } ~= `@expr'
			'`@expr = `{ :node | node isLiteralNode and: [ node value isFloat ] }'
			'`@expr ~= `{ :node | node isLiteralNode and: [ node value isFloat ] }' )
		do: [ :node :answer | node ]! !

!RBFloatEqualityComparisonRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 13:57'!
group
	^ 'Possible bugs'! !

!RBFloatEqualityComparisonRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 13:58'!
name
	^ 'Float equality comparison'! !

!RBFloatEqualityComparisonRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 13:58'!
category 
	^ 'Potential Bugs'! !

!RBFloatEqualityComparisonRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'FloatEqualityComparisonRule'! !

!RBFooLintRuleTest methodsFor: 'as yet unclassified' stamp: 'MarkRizun 7/24/2014 13:12'!
foo
	^ 6! !

!RBFooLintRuleTest1 methodsFor: 'as yet unclassified' stamp: 'MarkRizun 10/2/2014 14:17'!
foo
	^ 6! !

!RBFormatterTests commentStamp: 'TorstenBergmann 2/4/2014 21:53'!
SUnit tests for RBFormatter!
!RBFormatterTests methodsFor: 'private' stamp: 'lr 9/4/2010 16:56'!
formatClass: aClass
	aClass selectors
		do: [ :each | self formatClass: aClass selector: each ]! !

!RBFormatterTests methodsFor: 'private' stamp: 'MarcusDenker 4/20/2013 03:19'!
formatClass: aClass selector: aSymbol
	| source tree1 tree2 | 
	source := aClass sourceCodeAt: aSymbol.
	tree1 := RBParser parseMethod: source.
	tree2 := RBParser 
		parseMethod: (RBConfigurableFormatter new format: tree1)
		onError: [ :err :pos | self assert: false ].
	self assert: tree1 = tree2! !

!RBFormatterTests methodsFor: 'testing' stamp: 'lr 9/4/2010 16:55'!
testCoreSystem
	#(Object Behavior Boolean True False Integer SmallInteger Collection String) do: [ :each |
		| class |
		class := Smalltalk globals classNamed: each.
		self formatClass: class; formatClass: class class ]! !

!RBFutureDeprecationWarningRule commentStamp: 'StephaneDucasse 11/29/2014 21:01'!
Deprecated methods can be noisy, maybe encouraging people to turn such warnings off, and not address them.  A lint rule allows a gentler staged approach to address deprecations outside of running an application, with a refactoring rule handy.!
!RBFutureDeprecationWarningRule methodsFor: 'private' stamp: 'BenComan 9/21/2014 10:14'!
oldSelectors
	^ self plannedSelectorRenames keys! !

!RBFutureDeprecationWarningRule methodsFor: 'accessing' stamp: 'BenComan 9/21/2014 10:08'!
group
	^ 'Future Deprecation'! !

!RBFutureDeprecationWarningRule methodsFor: 'private' stamp: 'BenComan 9/21/2014 10:05'!
plannedSelectorRenames
	^ { #subStrings: -> #substrings: }! !

!RBFutureDeprecationWarningRule methodsFor: 'accessing' stamp: 'BenComan 9/21/2014 10:16'!
category 	
	^ 'Design Flaws'! !

!RBFutureDeprecationWarningRule methodsFor: 'accessing' stamp: 'BenComan 9/21/2014 10:10'!
name
	^ 'Future deprecation warning'! !

!RBFutureDeprecationWarningRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 16:50'!
checkMethod: aMethod 

	self plannedSelectorRenames do: [ :mapping | 
		| oldSelector newSelector |
		oldSelector := mapping key.
		newSelector := mapping value.
		(aMethod sendsSelector: oldSelector)
			 ifTrue: [ result addMethod: aMethod ] ]
	! !

!RBFutureDeprecationWarningRule class methodsFor: 'accessing' stamp: 'MarcusDenker 9/23/2014 18:12'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'FutureDeprecationWarningRule'! !

!RBGenerateEqualHashRefactoring methodsFor: 'accessing' stamp: ''!
variables: anArray
	variables := anArray! !

!RBGenerateEqualHashRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^ variables
		inject: RBCondition empty
		into: [ :condition :variable | condition & (RBCondition definesInstanceVariable: variable in: self theClass) ]! !

!RBGenerateEqualHashRefactoring methodsFor: 'transforming' stamp: ''!
compileHash
	| method statement hash |
	method := RBParser parseMethod: 'hash
		"Answer an integer value that is related to the identity of the receiver."'.
	statement := nil.
	variables reversed do: [ :each |
		hash := RBMessageNode 
			receiver: (RBVariableNode named: each)
			selector: #hash.
		statement := statement isNil
			ifTrue: [ hash ]
			ifFalse: [
				RBMessageNode
					receiver: hash
					selector: #bitXor:
					arguments: (Array with: statement) ] ].
	method addNode: statement; addReturn.
	self theClass
		compile: method formattedCode
		classified: #(comparing)! !

!RBGenerateEqualHashRefactoring methodsFor: 'transforming' stamp: 'BenjaminVanRyseghem 4/25/2012 18:02'!
accessorForVariable: aString
	| refactoring |
	refactoring := RBCreateAccessorsForVariableRefactoring
		model: self model
		variable: aString
		class: self theClass
		classVariable: false.
	refactoring createGetterAccessor.
	^ refactoring getterMethod! !

!RBGenerateEqualHashRefactoring methodsFor: 'transforming' stamp: ''!
transform
	self compileHash.
	self compileEqual! !

!RBGenerateEqualHashRefactoring methodsFor: 'transforming' stamp: ''!
compileEqual
	| method statement comparison |
	method := RBParser parseMethod: '= anObject
		"Answer whether the receiver and anObject represent the same object."

		self == anObject ifTrue: [ ^ true ].
		self class = anObject class ifFalse: [ ^ false ]'.
	statement := nil.	
	variables reversed do: [ :each |
		| accessor |
		accessor := self accessorForVariable: each.
		comparison := RBMessageNode 
			receiver: (RBVariableNode named: each) 
			selector: #=
			arguments: (Array with: (RBMessageNode 
				receiver: (RBVariableNode named: 'anObject')
				selector: accessor)).
		statement := statement isNil
			ifTrue: [ comparison ]
			ifFalse: [
				RBMessageNode
					receiver: comparison
					selector: #and:
					arguments: (Array with: (RBBlockNode 
						body: (RBSequenceNode 
							statements: (Array with: statement)))) ] ].
	method addNode: statement; addReturn.
	self theClass 
		compile: method formattedCode
		classified: #(comparing)! !

!RBGenerateEqualHashRefactoring methodsFor: 'accessing' stamp: ''!
theClass
	^ (self classObjectFor: className) theNonMetaClass! !

!RBGenerateEqualHashRefactoring class methodsFor: 'instance-creation' stamp: ''!
model: aNamespace className: aClass variables: anArray
	^ (self model: aNamespace className: aClass) variables: anArray! !

!RBGenerateEqualHashRefactoring class methodsFor: 'instance-creation' stamp: ''!
className: aClass variables: anArray
	^ (self className: aClass) variables: anArray! !

!RBGeneratePrintStringRefactoring methodsFor: 'accessing' stamp: ''!
theClass
	^ (self classObjectFor: className) theNonMetaClass! !

!RBGeneratePrintStringRefactoring methodsFor: 'accessing' stamp: ''!
variables: anArray
	variables := anArray! !

!RBGeneratePrintStringRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^ variables
		inject: RBCondition empty
		into: [ :condition :variable | condition & (RBCondition definesInstanceVariable: variable in: self theClass) ]! !

!RBGeneratePrintStringRefactoring methodsFor: 'transforming' stamp: ''!
transform
	| method |
	method := RBParser parseMethod: 'printOn: aStream
		"Append a sequence of characters to aStream that identify the receiver."
		
		super printOn: aStream'.
	variables do: [ :each |
		method body addNode: (RBParser 
			parseExpression: ('aStream nextPutAll: '' <1s>: ''; print: <1s>'
				expandMacrosWith: each)) ].
	self theClass
		compile: method formattedCode
		classified: #(printing)! !

!RBGeneratePrintStringRefactoring class methodsFor: 'instance-creation' stamp: ''!
model: aNamespace className: aClass variables: anArray
	^ (self model: aNamespace className: aClass) variables: anArray! !

!RBGeneratePrintStringRefactoring class methodsFor: 'instance-creation' stamp: ''!
className: aClass variables: anArray
	^ (self className: aClass) variables: anArray! !

!RBGuardClauseRule commentStamp: 'StephaneDucasse 11/29/2014 18:21'!
Transform conditional with a single clause into a form that is more readable.
For example

[[[ 
foo 
	statements. 
	condition ifTrue: [ statement1. statement2 ]
]]]

is transformed into 

[[[  
foo
	statements.
	condition ifFalse: [^self].
	statement1.
	statement2.
]]]!
!RBGuardClauseRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:33'!
initialize
	super initialize.
	self rewriteRule
		replaceMethod: '`@methodName: `@args 
					| `@temps | 
					`@.Statements. 
					`@condition ifTrue: [| `@trueTemps | `.Statement1. `.Statement2. `@.Statements1]'
		with: '`@methodName: `@args
					| `@temps `@trueTemps |
					`@.Statements.
					`@condition ifFalse: [^self].
					`.Statement1.
					`.Statement2.
					`@.Statements1';
		replaceMethod: '`@methodName: `@args 
					| `@temps | 
					`@.Statements. 
					`@condition ifFalse: [| `@falseTemps | `.Statement1. `.Statement2. `@.Statements1]'
		with: '`@methodName: `@args
					| `@temps `@falseTemps |
					`@.Statements.
					`@condition ifTrue: [^self].
					`.Statement1.
					`.Statement2.
					`@.Statements1'! !

!RBGuardClauseRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 18:17'!
rationale
	^ 'Transform conditional with a single clause into a form that is more readable.'! !

!RBGuardClauseRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Transformations'! !

!RBGuardClauseRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Eliminate guarding clauses'! !

!RBGuardClauseRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:50'!
category 
	^ 'Coding Idiom Violation'! !

!RBGuardClauseRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'GuardClauseRule'! !

!RBGuardingClauseRule commentStamp: 'StephaneDucasse 11/29/2014 21:44'!
Checks for ifTrue: or ifFalse: conditions at end of methods that have two or more statements inside their blocks. Such code might better represent the true meaning of the code if they returned self instead.!
!RBGuardingClauseRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:28'!
initialize
	super initialize.
	self matcher 
		matchesAnyMethodOf: #(
			'`@MethodName: `@args 
				| `@temps | 
				`@.Statements. 
				`@condition ifTrue: [| `@BlockTemps | `.Statement1. `.Statement2. `@.BStatements]' 
			'`@MethodName: `@args 
				| `@temps | 
				`@.Statements. 
				`@condition ifFalse: [| `@BlockTemps | `.Statement1. `.Statement2. `@.BStatements]' )
		do: [ :node :answer | 
			answer isNil 
				ifTrue: [ node body statements last ]
				ifFalse: [ answer ] ]! !

!RBGuardingClauseRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
rationale
	^ 'Checks for ifTrue: or ifFalse: conditions at end of methods that have two or more statements inside their blocks. Such code might better represent the true meaning of the code if they returned self instead.'! !

!RBGuardingClauseRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Intention revealing'! !

!RBGuardingClauseRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Guarding clauses'! !

!RBGuardingClauseRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 16:31'!
category 
	^ 'Coding Idiom Violation'! !

!RBGuardingClauseRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'GuardingClauseRule'! !

!RBIdentifierToken commentStamp: 'md 8/9/2005 14:51'!
RBIdentifierToken is the first class representation of an identifier token (e.g. Class)
!
!RBIdentifierToken methodsFor: 'testing' stamp: ''!
isIdentifier
	^true! !

!RBIdentifierToken methodsFor: 'testing' stamp: 'lr 11/7/2009 15:30'!
isPatternVariable
	^value first = RBScanner patternVariableCharacter! !

!RBIfTrueBlocksRule commentStamp: 'StephaneDucasse 11/29/2014 22:10'!
Checks for methods that don''t use blocks in the special messages. People new to Smalltalk might write code such as: "aBoolean ifTrue: (self doSomething)" instead of the correct version: "aBoolean ifTrue: [self doSomething]". Even if these pieces of code could be correct, they cannot be optimized by the compiler.!
!RBIfTrueBlocksRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:28'!
initialize
	super initialize.
	self matcher 
		matchesAnyOf: #(
			'`@condition ifTrue: `{:node | node isBlock not} ifFalse: `@block'
			'`@condition ifTrue: `@block ifFalse: `{:node | node isBlock not}'
			'`@condition ifFalse: `{:node | node isBlock not} ifTrue: `@block'
			'`@condition ifFalse: `@block ifTrue: `{:node | node isBlock not}'
			'`@condition ifTrue: `{:node | node isBlock not}'
			'`@condition ifFalse: `{:node | node isBlock not}'
			'`@condition and: `{:node | node isBlock not}'
			'`@condition or: `{:node | node isBlock not}'
			'`{:node | node isBlock not} whileTrue'
			'`{:node | node isBlock not} whileFalse'
			'`{:node | node isBlock not} whileTrue: `@block'
			'`@block whileTrue: `{:node | node isBlock not}'
			'`{:node | node isBlock not} whileFalse: `@block'
			'`@block whileFalse: `{:node | node isBlock not}'
			'`@from to: `@to do: `{:node | node isBlock not}'
			'`@from to: `@to by: `@by do: `{:node | node isBlock not}'
			'`@condition ifNil: `{:node | node isBlock not}'
			'`@condition ifNotNil: `{:node | node isBlock not}'
			'`@condition ifNil: `{:node | node isBlock not} ifNotNil: `@block'
			'`@condition ifNil: `@block ifNotNil: `{:node | node isBlock not}'
			'`@condition ifNotNil: `{:node | node isBlock not} ifNil: `@block'
			'`@condition ifNotNil: `@block ifNil: `{:node | node isBlock not}' )
		do: [ :node :answer | node ]! !

!RBIfTrueBlocksRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 22:10'!
rationale
	^ 'Checks for methods that don''t use blocks in the special messages such as ifTrue: (...) .'! !

!RBIfTrueBlocksRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Miscellaneous'! !

!RBIfTrueBlocksRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Non-blocks in special messages'! !

!RBIfTrueBlocksRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 16:34'!
category
	^ 'Optimization'! !

!RBIfTrueBlocksRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'IfTrueBlocksRule'! !

!RBIfTrueReturnsRule commentStamp: 'StephaneDucasse 11/29/2014 22:11'!
Checks for common ifTrue: returns that could be simplified using a boolean expression.!
!RBIfTrueReturnsRule methodsFor: 'initialization' stamp: 'MarcusDenker 9/20/2013 15:08'!
initialize
	super initialize.
	self matcher 
		matchesAnyOf: #(
			'| `@temps | ``@.Statements. ``@object ifTrue: [^``@value1]. ^``@value2' 
			'| `@temps | ``@.Statements. ``@object ifFalse: [^``@value1]. ^``@value2' )
		do: [ :node :answer | 
			answer isNil 
				ifTrue: [
					| condition |
					condition := (node statements at: node statements size - 1) arguments first 
						body statements 
						last value.	"``@value1"
					((condition isLiteralNode
						and: [ #(true false) includes: condition value ]) 
						or: [ 
							condition := 	node statements last value.
							condition isLiteralNode and: [ #(true false) includes: condition value ] ]) 
								ifTrue: [ node ]
								ifFalse: [ nil ] ]
				ifFalse: [ answer ] ]! !

!RBIfTrueReturnsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Intention revealing'! !

!RBIfTrueReturnsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'ifTrue:/ifFalse: returns instead of and:/or:''s'! !

!RBIfTrueReturnsRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:21'!
category 
	^ 'Optimization'! !

!RBIfTrueReturnsRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'IfTrueReturnsRule'! !

!RBImplementedNotSentRule commentStamp: 'StephaneDucasse 11/29/2014 21:01'!
This smell arises when a method is implemented but never sent. If a method is not sent, it can be removed. This rule pays attention not to identify as unsent methods, methods with pragmas and test methods since they are likely to be sent through reflection.
	Now if your code is used and extended by others better use a deprecation mechanism. To define a deprecate method follow the pattern: 
	
	foo
		self deprecated: ''Use bar instead ''. 
		^ self bar
		 !
!RBImplementedNotSentRule methodsFor: 'private' stamp: 'YuriyTymchuk 9/11/2014 11:28'!
addLiteral: aLiteral

	aLiteral isSymbol
		ifTrue: [ literals add: aLiteral ]
		ifFalse: [
			aLiteral class == Array ifTrue: [
				aLiteral do: [ :each |
					self addLiteral: each ] ] ]! !

!RBImplementedNotSentRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 10:13'!
category
	^ 'Design Flaws'! !

!RBImplementedNotSentRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/11/2014 11:26'!
resetResult
	super resetResult.
	literals := nil! !

!RBImplementedNotSentRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
rationale
	^ 'Check for methods that are never sent. If a method is not sent, it can be removed.'! !

!RBImplementedNotSentRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Unnecessary code'! !

!RBImplementedNotSentRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:02'!
severity
	^ #information! !

!RBImplementedNotSentRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Methods implemented but not sent'! !

!RBImplementedNotSentRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 16:55'!
checkMethod: aMethod
	"Check if there are any senders. Furthermore methods with pragmas are likely to be sent through reflection, thus do not report those. Also test methods are sent through reflection, so ignore those as well."

	(self literals includes: aMethod selector)
		ifTrue: [ ^ self ].
	aMethod pragmas isEmpty
		ifFalse: [ ^ self ].
	(aMethod methodClass isMeta not
		and: [ aMethod methodClass includesBehavior: TestCase ])
			ifTrue: [ ^ self ].
	result addMethod: aMethod! !

!RBImplementedNotSentRule methodsFor: 'cache' stamp: 'YuriyTymchuk 9/11/2014 11:31'!
literals
	"return all 'message sends' in the systed and cache them"

	literals ifNil: [
		literals := IdentitySet new.

		Smalltalk specialSelectors do: [:sel |
			sel isSymbol ifTrue: [ literals add: sel ] ].
		SystemNavigation default allMethods do: [ :meth |
			meth literals do: [ :lit | self addLiteral: lit ] ] ].
	
	^ literals ! !

!RBImplementedNotSentRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'ImplementedNotSentRule'! !

!RBInconsistentMethodClassificationRule commentStamp: 'StephaneDucasse 11/29/2014 21:00'!
This smell arises when a method protocol is not equivalent to the one defined in the superclass of such method class. All methods should be put into a protocol (method category) that is equivalent to the one of the superclass, which is a standard style in Pharo. Furthermore, methods which are extended in the superclass are ignored, since they may have different protocol name. Pay attention when you apply automatic recategorisation because it may move method in antoher package if the method is defined in the superclass as an extension.

!
!RBInconsistentMethodClassificationRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:15'!
resultClass
	^ RBMultiEnvironment! !

!RBInconsistentMethodClassificationRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 10:14'!
category
	^ 'Design Flaws'! !

!RBInconsistentMethodClassificationRule methodsFor: 'accessing' stamp: 'SeanDeNigris 1/31/2013 08:57'!
rationale
	^ 'All methods should be put into a protocol (method category) that is equivalent to the one of the superclass, which is a Smalltalk style convention.'! !

!RBInconsistentMethodClassificationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Miscellaneous'! !

!RBInconsistentMethodClassificationRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:02'!
severity
	^ #information! !

!RBInconsistentMethodClassificationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Inconsistent method classification'! !

!RBInconsistentMethodClassificationRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 16:57'!
checkMethod: aMethod 
	| superClass superProtocol ownerProtocol |
	aMethod methodClass superclass isNil ifFalse: [
		superClass := aMethod methodClass superclass whichClassIncludesSelector: aMethod selector.
		superClass isNil ifFalse: [
			superProtocol := superClass whichCategoryIncludesSelector: aMethod selector.
			ownerProtocol := aMethod methodClass whichCategoryIncludesSelector: aMethod selector.
			(superProtocol isNil or: [ superProtocol isEmpty or: [ superProtocol first = $* or: [ ownerProtocol isNil or: [ ownerProtocol isEmpty or: [ ownerProtocol first = $* ] ] ] ] ]) ifFalse: [ 
				superProtocol = ownerProtocol ifFalse: [
					result
						addClass: superClass
							selector: aMethod selector
							into: superProtocol;
						addClass: aMethod methodClass
							selector: aMethod selector
							into: superProtocol ] ] ] ]! !

!RBInconsistentMethodClassificationRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'InconsistentMethodClassificationRule'! !

!RBInlineAllMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testInlineMethodWithMultipleSendersInMethod
	| refactoring |
	refactoring := RBInlineAllSendersRefactoring 
		sendersOf: #caller2
		in: RBRefactoryTestDataApp.
	self executeRefactoring: refactoring.
	self assert: ((refactoring model classNamed: #RBRefactoryTestDataApp) parseTreeFor: #inlineLast) = (RBParser parseMethod: 'inlineLast
	5 = 3 ifTrue: [^self caller] ifFalse: [^(1 to: 10) inject: 1 into: [:sum :each | sum * (self foo: each)]] ').
	self assert: ((refactoring model classNamed: #RBRefactoryTestDataApp) parseTreeFor: #multipleCalls) = (RBParser parseMethod: 'multipleCalls
	(1 to: 10) inject: 1 into: [:sum :each | sum * (self foo: each)].
	(1 to: 10) inject: 1 into: [:sum1 :each1 | sum1 * (self foo: each1)]')! !

!RBInlineAllMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testRecursiveMethod
	| class |
	model := RBNamespace new.
	class := model classNamed: self class name.
	class
		compile: 'foo ^self foo' classified: #(#accessing);
		compile: 'bar ^self foo' classified: #(#accessing).
	self executeRefactoring: (RBInlineAllSendersRefactoring 
				model: model
				sendersOf: #foo
				in: class).
	self assert: (class parseTreeFor: #foo) 
				= (RBParser parseMethod: 'foo ^self foo').
	self assert: (class parseTreeFor: #bar) 
				= (RBParser parseMethod: 'bar ^self foo')! !

!RBInlineAllSendersRefactoring methodsFor: 'transforming' stamp: ''!
inlineSelfSends
	class withAllSubclasses do: 
			[:each | 
			| selectors |
			selectors := each selectors.
			selectors remove: selector ifAbsent: [].
			selectors do: [:sel | self inlineMessagesInClass: each andSelector: sel]]! !

!RBInlineAllSendersRefactoring methodsFor: 'transforming' stamp: 'lr 9/8/2011 20:11'!
removeMethod
	self onError: 
			[self performComponentRefactoring: (RBRemoveMethodRefactoring 
						model: self model
						removeMethods: (Array with: selector)
						from: class)]
		do: []! !

!RBInlineAllSendersRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'!
selfSendIn: aTree 
	| searcher |
	searcher := RBParseTreeSearcher new.
	searcher matches: self messagePattern do: [:aNode :answer | ^aNode].
	^searcher executeTree: aTree initialAnswer: nil! !

!RBInlineAllSendersRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^RBCondition canUnderstand: selector in: class! !

!RBInlineAllSendersRefactoring methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream
		nextPutAll: ' sendersOf: #';
		nextPutAll: selector;
		nextPutAll: ' in: '.
	class storeOn: aStream.
	aStream nextPut: $)! !

!RBInlineAllSendersRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'!
numberOfSelfSendsIn: aParseTree 
	| search |
	search := RBParseTreeSearcher new.
	search matches: self messagePattern do: [:aNode :answer | answer + 1].
	^search executeTree: aParseTree initialAnswer: 0! !

!RBInlineAllSendersRefactoring methodsFor: 'transforming' stamp: ''!
transform
	self
		inlineSelfSends;
		removeMethod;
		checkInlinedMethods! !

!RBInlineAllSendersRefactoring methodsFor: 'transforming' stamp: 'CamilloBruni 10/8/2012 00:10'!
checkInlinedMethods
	numberReplaced = 0 
		ifTrue: [self refactoringFailure: 'Could not inline any senders']! !

!RBInlineAllSendersRefactoring methodsFor: 'initialize-release' stamp: ''!
sendersOf: aSelector in: aClass 
	class := self classObjectFor: aClass.
	selector := aSelector.
	numberReplaced := numberNotReplaced := 0! !

!RBInlineAllSendersRefactoring methodsFor: 'accessing' stamp: ''!
messagesNotReplaced
	^numberNotReplaced! !

!RBInlineAllSendersRefactoring methodsFor: 'transforming' stamp: 'lr 9/8/2011 20:11'!
inlineMessagesInClass: aClass andSelector: aSelector 
	| messagesToInline previousCountOfMessages |
	previousCountOfMessages := 4294967295.	"Some really large number > # of initial self sends."
	
	[messagesToInline := self 
				numberOfSelfSendsIn: (aClass parseTreeFor: aSelector).
	messagesToInline > 0 and: [previousCountOfMessages > messagesToInline]] 
			whileTrue: 
				[| node |
				previousCountOfMessages := messagesToInline.
				node := self selfSendIn: (aClass parseTreeFor: aSelector).
				self onError: 
						[self performComponentRefactoring: (RBInlineMethodRefactoring 
									model: self model
									inline: node sourceInterval
									inMethod: aSelector
									forClass: aClass).
						numberReplaced := numberReplaced + 1]
					do: []].
	numberNotReplaced := numberNotReplaced + messagesToInline! !

!RBInlineAllSendersRefactoring methodsFor: 'transforming' stamp: ''!
messagePattern
	^'self ' , (self buildSelectorString: selector)! !

!RBInlineAllSendersRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBSmalltalk sendersOf: aSelector in: aClass 
	^(self new)
		model: aRBSmalltalk;
		sendersOf: aSelector in: aClass;
		yourself! !

!RBInlineAllSendersRefactoring class methodsFor: 'instance creation' stamp: ''!
sendersOf: aSelector in: aClass 
	^self new sendersOf: aSelector in: aClass! !

!RBInlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: ''!
addArgumentToSelector: aSymbol 
	^aSymbol isInfix 
		ifTrue: [#value:value:]
		ifFalse: [(aSymbol , 'value:') asSymbol]! !

!RBInlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: 'lr 11/23/2009 11:02'!
addSelfReferenceToSourceMessage
	| newArguments |
	newArguments := sourceMessage arguments asOrderedCollection.
	newArguments addFirst: sourceMessage receiver copy.
	sourceMessage renameSelector: (self addArgumentToSelector: sourceMessage selector) andArguments: newArguments! !

!RBInlineMethodFromComponentRefactoring methodsFor: 'testing' stamp: 'CamilloBruni 9/13/2012 14:21'!
isOverridden
	| selector| 
	selector := self inlineSelector.
	self inlineClass allSubclassesDo: [:each | 
		(each directlyDefinesMethod: selector)
			ifTrue: [ ^ true ]].
	^ false! !

!RBInlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: 'CamilloBruni 10/8/2012 00:08'!
findSelectedMessage
	sourceParseTree := class parseTreeFor: sourceSelector.
	sourceParseTree isNil 
		ifTrue: [self refactoringFailure: 'Could not parse sources'].
	sourceMessage := sourceParseTree whichNodeIsContainedBy: sourceInterval.
	sourceMessage isNil 
		ifTrue: 
			[self 
				refactoringFailure: 'The selection doesn''t appear to be a message send'].
	sourceMessage isCascade 
		ifTrue: [sourceMessage := sourceMessage messages last].
	sourceMessage isMessage 
		ifFalse: 
			[self 
				refactoringFailure: 'The selection doesn''t appear to be a message send']! !

!RBInlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: 'CamilloBruni 10/8/2012 00:08'!
inlineClass
	| imps |
	inlineClass notNil ifTrue: [^inlineClass].
	imps := (self model allImplementorsOf: self inlineSelector) 
				asOrderedCollection.
	imps size = 1 ifTrue: [^inlineClass := imps first].
	imps isEmpty 
		ifTrue: 
			[self 
				refactoringFailure: 'Nobody defines a method named ' , self inlineSelector].
	inlineClass := self requestImplementorToInline: imps.
	inlineClass isNil 
		ifTrue: [self refactoringFailure: 'No implementor selected'].
	^inlineClass! !

!RBInlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: 'lr 10/26/2009 22:08'!
newNameForSelf
	| variableName index originalName nonMetaClass |
	nonMetaClass := inlineClass theNonMetaClass.
	variableName := originalName := (nonMetaClass name first isVowel 
		ifTrue: [ 'an' ]
		ifFalse: [ 'a' ]) , nonMetaClass name.
	index := 1.
	
	[ variableName := self safeVariableNameBasedOn: variableName.
	inlineParseTree allDefinedVariables includes: variableName ] whileTrue: 
		[ variableName := originalName , index printString.
		index := index + 1 ].
	^ variableName! !

!RBInlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: ''!
safeVariableNameBasedOn: aString 
	"Creates an unused variable name containing aString"

	| baseString newString i allTempVars |
	allTempVars := inlineParseTree allTemporaryVariables.
	baseString := aString copy.
	baseString at: 1 put: baseString first asLowercase.
	newString := baseString.
	i := 0.
	
	[(allTempVars includes: newString) 
		or: [class definesInstanceVariable: newString]] 
			whileTrue: 
				[i := i + 1.
				newString := baseString , i printString].
	^newString! !

!RBInlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: ''!
transform
	self abstractVariableReferences.
	self renameSelfReferences.
	super transform! !

!RBInlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: ''!
checkSuperMessages
	inlineParseTree superMessages isEmpty 
		ifFalse: 
			[self 
				refactoringError: 'Cannot inline method since it sends a super message']! !

!RBInlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: 'lr 11/23/2009 11:03'!
addSelfReferenceToInlineParseTree
	| variableName rewriter newArguments |
	variableName := self newNameForSelf.
	rewriter := RBParseTreeRewriter rename: 'self' to: variableName.
	(rewriter executeTree: inlineParseTree) 
		ifTrue: [inlineParseTree := rewriter tree].
	newArguments := inlineParseTree arguments asOrderedCollection.
	newArguments addFirst: (RBVariableNode named: variableName).
	inlineParseTree
		renameSelector: (self addArgumentToSelector: inlineParseTree selector)
		andArguments: newArguments.
	sourceMessage receiver replaceWith: (RBVariableNode named: variableName)! !

!RBInlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: 'lr 9/8/2011 20:11'!
abstractVariableReferences
	| refactoring |
	refactoring := RBAbstractVariablesRefactoring 
				model: self model
				abstractVariablesIn: inlineParseTree
				from: inlineClass
				toAll: (Array with: class).
	self performComponentRefactoring: refactoring.
	inlineParseTree := refactoring parseTree! !

!RBInlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: ''!
renameSelfReferences
	self addSelfReferenceToSourceMessage.
	self addSelfReferenceToInlineParseTree.! !

!RBInlineMethodFromComponentTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testModelInlineMethodWithSameVariableNames
	| class refactoring |
	model := RBNamespace new.
	class := model classNamed: self class name.
	class compile: 'a9: a b9: b ^self + a + b' classified: #(#accessing).
	(model classNamed: #Object) 
		compile: 'foo | a b c | a := InlineMethodFromComponentTest new. b := 1. c := 2. ^a a9: b b9: c'
		classified: #(#accessing).
	self proceedThroughWarning: 
			[refactoring := RBInlineMethodFromComponentRefactoring 
						model: model
						inline: (72 to: 84)
						inMethod: #foo
						forClass: (model classNamed: #Object).
			self setupInlineExpressionFor: refactoring toReturn: false.
			self executeRefactoring: refactoring].
	self assert: ((refactoring model classNamed: #Object) parseTreeFor: #foo) 
				= (RBParser 
						parseMethod: 'foo | a b c | a := InlineMethodFromComponentTest new. b := 1. c := 2. ^a + b + c')! !

!RBInlineMethodFromComponentTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testInlineEmptyComponentMethod
	| refactoring |
	self proceedThroughWarning: 
		[ refactoring := RBInlineMethodFromComponentRefactoring 
			inline: (self 
					convertInterval: (35 to: 91)
					for: (RBRefactoryTestDataApp sourceCodeAt: #inlineComponent))
			inMethod: #inlineComponent
			forClass: RBRefactoryTestDataApp.
		self 
			setupInlineExpressionFor: refactoring
			toReturn: false.
		"The following line is needed because some people implement #yourself themselves."
		self 
			setupImplementorToInlineFor: refactoring
			toReturn: (refactoring model classNamed: #Object).
		self executeRefactoring: refactoring ].
	self assert: ((refactoring model classNamed: #RBRefactoryTestDataApp) parseTreeFor: #inlineComponent) = (RBParser parseMethod: 'inlineComponent
	| a anObject |
	a := 5.
	anObject := a class.
	anObject superclass.
	anObject hasImmediateInstances.
	^anObject')! !

!RBInlineMethodFromComponentTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testInlineComponentMethodMax
	| refactoring |
	self proceedThroughWarning: 
		[ | class |
		refactoring := RBInlineMethodFromComponentRefactoring 
			inline: (self 
					convertInterval: (47 to: 58)
					for: (RBRefactoryTestDataApp sourceCodeAt: #inlineMax))
			inMethod: #inlineMax
			forClass: RBRefactoryTestDataApp.
		self 
			setupInlineExpressionFor: refactoring
			toReturn: true.
		class := refactoring model classNamed: #Magnitude.
		class 
			compile: 'max: aMagnitude 
					"Answer the receiver or the argument, whichever has the greater magnitude."

					self > aMagnitude
						ifTrue: [^self]
						ifFalse: [^aMagnitude]'
			classified: #(#accessing ).
		self 
			setupImplementorToInlineFor: refactoring
			toReturn: class.
		self executeRefactoring: refactoring ].
	self assert: ((refactoring model classNamed: #RBRefactoryTestDataApp) parseTreeFor: #inlineMax) = (RBParser parseMethod: 'inlineMax
								| x y q |
								x := 5.
								y := 10.
								q := x + 1 > y
									ifTrue: [x + 1]
									ifFalse: [y].
								^q')! !

!RBInlineMethodFromComponentTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testModelInlineMethodWithSameVariableNames2
	| class refactoring |
	model := RBNamespace new.
	class := model classNamed: self class name.
	class compile: 'a9: a b9: b ^self + a + b' classified: #(#accessing).
	(model classNamed: #Object) 
		compile: 'foo | a b c | a := InlineMethodFromComponentTest new. b := 1. c := 2. ^c a9: b b9: a'
		classified: #(#accessing).
	self proceedThroughWarning: 
			[refactoring := RBInlineMethodFromComponentRefactoring 
						model: model
						inline: (72 to: 84)
						inMethod: #foo
						forClass: (model classNamed: #Object).
			self setupInlineExpressionFor: refactoring toReturn: false.
			self executeRefactoring: refactoring].
	self assert: ((refactoring model classNamed: #Object) parseTreeFor: #foo) 
				= (RBParser 
						parseMethod: 'foo | a b c | a := InlineMethodFromComponentTest new. b := 1. c := 2. ^c + b + a')! !

!RBInlineMethodFromComponentTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testInlineMethodFromComponentFailure
	self shouldFail: (RBInlineMethodFromComponentRefactoring 
			inline: (self 
					convertInterval: (50 to: 64)
					for: (RBRefactoryTestDataApp sourceCodeAt: #inlineFailed))
			inMethod: #inlineFailed
			forClass: RBRefactoryTestDataApp)! !

!RBInlineMethodFromComponentTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testModelInlineMethodWithSameVariableNames1
	| class refactoring |
	model := RBNamespace new.
	class := model classNamed: #Rectangle.
	class 
		compile: 'rectangleRelativeTo: aRectangle ^self origin extent: aRectangle extent'
		classified: #(#accessing).
	(model classNamed: #Object) 
		compile: 'foo | aRectangle temp | aRectangle := 0@0 corner: 1@1. temp := aRectangle. ^aRectangle rectangleRelativeTo: temp'
		classified: #(#accessing).
	self proceedThroughWarning: 
			[refactoring := RBInlineMethodFromComponentRefactoring 
						model: model
						inline: (77 to: 112)
						inMethod: #foo
						forClass: (model classNamed: #Object).
			self setupInlineExpressionFor: refactoring toReturn: false.
			self setupImplementorToInlineFor: refactoring toReturn: class.
			self executeRefactoring: refactoring].
	self assert: ((refactoring model classNamed: #Object) parseTreeFor: #foo) 
				= (RBParser 
						parseMethod: 'foo | aRectangle temp | aRectangle := 0@0 corner: 1@1. temp := aRectangle. ^aRectangle origin extent: temp extent')! !

!RBInlineMethodFromComponentTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testInlineComponentIntoCascadedMessage
	| refactoring |
	self proceedThroughWarning: 
		[ refactoring := RBInlineMethodFromComponentRefactoring 
			inline: (self 
					convertInterval: (35 to: 79)
					for: (RBRefactoryTestDataApp sourceCodeAt: #inlineComponent))
			inMethod: #inlineComponent
			forClass: RBRefactoryTestDataApp.
		(refactoring model classNamed: #Behavior) 
			compile: 'hasImmediateInstances ^self format = 0'
			classified: #(#accessing ).
		self 
			setupInlineExpressionFor: refactoring
			toReturn: false.
		self executeRefactoring: refactoring ].
	self assert: ((refactoring model classNamed: #RBRefactoryTestDataApp) parseTreeFor: #inlineComponent) = (RBParser parseMethod: 'inlineComponent
	| a aBehavior |
	a := 5.
	aBehavior := a class.
	aBehavior superclass.
	aBehavior format = 0.
	^aBehavior yourself')! !

!RBInlineMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'!
normalizeReturns
	| rewriter |
	rewriter := RBParseTreeRewriter new.
	rewriter
		replace: '^``@boolean ifTrue: [| `@t1 | `@.Stmts1. ^``@r1] ifFalse: [| `@t2 | `@.Stmts2. ^``@r2]'
			with: '^``@boolean ifTrue: [| `@t1 | `@.Stmts1. ``@r1] ifFalse: [| `@t2 | `@.Stmts2. ``@r2]';
		replace: '^``@boolean ifFalse: [| `@t1 | `@.Stmts1. ^``@r1] ifTrue: [| `@t2 | `@.Stmts2. ^``@r2]'
			with: '^``@boolean ifFalse: [| `@t1 | `@.Stmts1. ``@r1] ifTrue: [| `@t2 | `@.Stmts2. ``@r2]';
		replace: '^``@boolean ifTrue: [| `@t1 | `@.Stmts1. ``@r1] ifFalse: [| `@t2 | `@.Stmts2. ^``@r2]'
			with: '^``@boolean ifTrue: [| `@t1 | `@.Stmts1. ``@r1] ifFalse: [| `@t2 | `@.Stmts2. ``@r2]';
		replace: '^``@boolean ifFalse: [| `@t1 | `@.Stmts1. ``@r1] ifTrue: [| `@t2 | `@.Stmts2. ^``@r2]'
			with: '^``@boolean ifFalse: [| `@t1 | `@.Stmts1. ``@r1] ifTrue: [| `@t2 | `@.Stmts2. ``@r2]';
		replace: '^``@boolean ifTrue: [| `@t1 | `@.Stmts1. ^``@r1] ifFalse: [| `@t2 | `@.Stmts2. ``@r2]'
			with: '^``@boolean ifTrue: [| `@t1 | `@.Stmts1. ``@r1] ifFalse: [| `@t2 | `@.Stmts2. ``@r2]';
		replace: '^``@boolean ifFalse: [| `@t1 | `@.Stmts1. ^``@r1] ifTrue: [| `@t2 | `@.Stmts2. ``@r2]'
			with: '^``@boolean ifFalse: [| `@t1 | `@.Stmts1. ``@r1] ifTrue: [| `@t2 | `@.Stmts2. ``@r2]';
		replace: '``@boolean ifTrue: [| `@t1 | `@.Stmts1. ^``@r1] ifFalse: [| `@t2 | `@.Stmts2. ^``@r2]'
			with: '^``@boolean ifTrue: [| `@t1 | `@.Stmts1. ``@r1] ifFalse: [| `@t2 | `@.Stmts2. ``@r2]';
		replace: '``@boolean ifFalse: [| `@t1 | `@.Stmts1. ^``@r1] ifTrue: [| `@t2 | `@.Stmts2. ^``@r2]'
			with: '^``@boolean ifFalse: [| `@t1 | `@.Stmts1. ``@r1] ifTrue: [| `@t2 | `@.Stmts2. ``@r2]'.
	[rewriter executeTree: inlineParseTree] 
		whileTrue: [inlineParseTree := rewriter tree]! !

!RBInlineMethodRefactoring methodsFor: 'transforming' stamp: 'CamilloBruni 10/8/2012 00:09'!
parseInlineMethod
	self inlineClass isNil 
		ifTrue: 
			[self 
				refactoringFailure: ('<1p> or its superclasses don''t contain method <2s>' 
						expandMacrosWith: class
						with: self inlineSelector)].
	inlineParseTree := self inlineClass parseTreeFor: self inlineSelector.
	inlineParseTree isNil 
		ifTrue: [self refactoringFailure: 'Could not parse sources'].
	inlineParseTree lastIsReturn ifFalse: [inlineParseTree addSelfReturn]! !

!RBInlineMethodRefactoring methodsFor: 'testing' stamp: 'CamilloBruni 9/13/2012 14:20'!
isOverridden
	| selector| 
	selector := self inlineSelector.
	class allSubclassesDo: [:each | 
		(each directlyDefinesMethod: selector)
			ifTrue: [ ^ true ]].
	^ false
	
		! !

!RBInlineMethodRefactoring methodsFor: 'transforming' stamp: ''!
insertInlinedMethod
	| node |
	node := sourceMessage.
	self moveComments.
	node parent isCascade 
		ifTrue: 
			[self rewriteCascadedMessage.
			node := node parent].
	node parent isReturn 
		ifTrue: [node := node parent]
		ifFalse: [self removeReturns].
	self replaceArguments.
	self inlineSourceReplacing: node.
	sourceParseTree removeDeadCode.
	self removeEmptyIfTrues.
	self removeImmediateBlocks! !

!RBInlineMethodRefactoring methodsFor: 'transforming' stamp: ''!
inlineClass
	^inlineClass isNil 
		ifTrue: 
			[inlineClass := (sourceMessage receiver name = 'super' 
						ifTrue: [class superclass]
						ifFalse: [class]) whoDefinesMethod: self inlineSelector]
		ifFalse: [inlineClass]! !

!RBInlineMethodRefactoring methodsFor: 'testing' stamp: 'lr 11/2/2009 00:14'!
hasMultipleReturns
	"Do we have multiple returns? If the last statement isn't a return, then we have an implicit return of self."

	| searcher |
	searcher := RBParseTreeSearcher new.
	searcher matches: '^``@object'
		do: 
			[:aNode :hasAReturn | 
			hasAReturn ifTrue: [^true].
			true].
	searcher executeTree: inlineParseTree
		initialAnswer: inlineParseTree lastIsReturn not.
	^false! !

!RBInlineMethodRefactoring methodsFor: 'transforming' stamp: ''!
inlineSourceReplacing: aParseTree 
	| statements nodeUnderSequence |
	statements := inlineParseTree body statements.
	(statements size > 1 and: [aParseTree isEvaluatedFirst not]) 
		ifTrue: 
			[self 
				refactoringWarning: 'To inline this method, we need to move some of its statements before the original message send.<n>This could change the order of execution, which can change the behavior.<n>Do you want to proceed?' 
						expandMacros].
	nodeUnderSequence := aParseTree.
	[nodeUnderSequence parent isSequence] 
		whileFalse: [nodeUnderSequence := nodeUnderSequence parent].
	(nodeUnderSequence parent)
		addNodes: (statements copyFrom: 1 to: (statements size - 1 max: 0))
			before: nodeUnderSequence;
		addTemporariesNamed: inlineParseTree body temporaryNames.
	aParseTree parent replaceNode: aParseTree
		withNode: (statements isEmpty 
				ifTrue: [RBVariableNode named: 'self']
				ifFalse: [statements last])! !

!RBInlineMethodRefactoring methodsFor: 'transforming' stamp: 'MarcusDenker 9/20/2013 13:29'!
replaceArguments
	sourceMessage arguments reversed
		with: inlineParseTree arguments reversed
		do: [ :replacement :source | 
			(replacement isImmediateNode or: [ self shouldInlineExpression: replacement newSource ]) 
				ifTrue: [ self replaceArgument: source with: replacement ]
				ifFalse: [ self addTemporary: source assignedTo: replacement ] ]! !

!RBInlineMethodRefactoring methodsFor: 'transforming' stamp: ''!
addSelfReturn
	inlineParseTree addSelfReturn! !

!RBInlineMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'!
renameTemporary: oldName to: newName 
	| rewriter |
	rewriter := RBParseTreeRewriter new.
	rewriter
		replace: oldName with: newName;
		replaceArgument: oldName with: newName.
	(rewriter executeTree: inlineParseTree) 
		ifTrue: [inlineParseTree := rewriter tree]! !

!RBInlineMethodRefactoring methodsFor: 'transforming' stamp: ''!
transform
	self
		renameConflictingTemporaries;
		insertInlinedMethod;
		compileMethod! !

!RBInlineMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'!
removeImmediateBlocks
	| rewriter |
	rewriter := RBParseTreeRewriter new.
	rewriter 
		replace: '[``.object] value'
		with: '``.object'
		when: [:aNode | aNode parent isCascade not].
	rewriter 
		replace: '| `@temps | ``@.Stmts1. [| `@bTemps | ``@.bStmts] value. ``@.Stmts2'
		with: '| `@temps `@bTemps | ``@.Stmts1. ``@.bStmts. ``@.Stmts2'.
	(rewriter executeTree: sourceParseTree) 
		ifTrue: [sourceParseTree := rewriter tree]! !

!RBInlineMethodRefactoring methodsFor: 'transforming' stamp: ''!
inlineSelector
	sourceMessage isNil ifTrue: [self findSelectedMessage].
	^sourceMessage selector! !

!RBInlineMethodRefactoring methodsFor: 'initialize-release' stamp: ''!
inline: anInterval inMethod: aSelector forClass: aClass 
	sourceSelector := aSelector.
	class := self classObjectFor: aClass.
	sourceInterval := anInterval! !

!RBInlineMethodRefactoring methodsFor: 'transforming' stamp: ''!
rewriteCascadedMessage
	| index messages |
	messages := sourceMessage parent messages.
	index := (1 to: messages size) 
				detect: [:i | sourceMessage == (messages at: i)]
				ifNone: [0].
	inlineParseTree body addNodesFirst: (messages copyFrom: 1 to: index - 1).
	self removeReturns.
	inlineParseTree body 
		addNodes: (messages copyFrom: index + 1 to: messages size).
	inlineParseTree addReturn! !

!RBInlineMethodRefactoring methodsFor: 'transforming' stamp: ''!
renameConflictingTemporary: aName 
	| allNames newName index seqNode |
	allNames := (Set new)
				addAll: inlineParseTree allDefinedVariables;
				yourself.
	allNames remove: aName ifAbsent: [].
	seqNode := sourceMessage.
	[seqNode isSequence] whileFalse: [seqNode := seqNode parent].
	allNames addAll: seqNode allDefinedVariables.	"Add those variables defined in blocks. This might cause a few 
													variables to be renamed that don't need to be, but this should be safe."
	newName := aName.
	index := 0.
	
	[(sourceMessage whoDefines: newName) notNil or: 
			[(class hierarchyDefinesVariable: newName) or: [allNames includes: newName]]] 
			whileTrue: 
				[index := index + 1.
				newName := aName , index printString].
	newName = aName ifFalse: [self renameTemporary: aName to: newName].
	^newName! !

!RBInlineMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'!
removeReturns
	| rewriter |
	rewriter := RBParseTreeRewriter new.
	rewriter replace: '^``@object' with: '``@object'.
	(rewriter executeTree: inlineParseTree) 
		ifTrue: [inlineParseTree := rewriter tree]! !

!RBInlineMethodRefactoring methodsFor: 'transforming' stamp: ''!
addTemporary: sourceNode assignedTo: replacementNode 
	| newName |
	newName := self renameConflictingTemporary: sourceNode name.
	(inlineParseTree body)
		addTemporaryNamed: newName;
		addNodeFirst: (RBAssignmentNode variable: (RBVariableNode named: newName)
					value: replacementNode)! !

!RBInlineMethodRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^(RBCondition definesSelector: sourceSelector in: class) 
		& (RBCondition withBlock: 
					[self findSelectedMessage.
					self isOverridden 
						ifTrue: 
							[self 
								refactoringWarning: ('<1p>>><2s> is overriden. Do you want to inline it anyway?' 
										expandMacrosWith: self inlineClass
										with: self inlineSelector)].
					self parseInlineMethod.
					self isPrimitive 
						ifTrue: [self refactoringError: 'Cannot inline primitives'].
					self checkSuperMessages.
					self rewriteInlinedTree.
					(sourceMessage parent isReturn or: [self hasMultipleReturns not]) 
						ifFalse: 
							[self 
								refactoringError: 'Cannot inline method since it contains multiple returns that cannot be rewritten'].
					true])! !

!RBInlineMethodRefactoring methodsFor: 'transforming' stamp: ''!
renameConflictingTemporaries
	inlineParseTree allDefinedVariables 
		do: [:each | self renameConflictingTemporary: each]! !

!RBInlineMethodRefactoring methodsFor: 'transforming' stamp: 'CamilloBruni 10/8/2012 00:09'!
findSelectedMessage
	sourceParseTree := class parseTreeFor: sourceSelector.
	sourceParseTree isNil 
		ifTrue: [self refactoringFailure: 'Could not parse sources'].
	sourceMessage := sourceParseTree whichNodeIsContainedBy: sourceInterval.
	sourceMessage isNil 
		ifTrue: 
			[self 
				refactoringFailure: 'The selection doesn''t appear to be a message send'].
	sourceMessage isCascade 
		ifTrue: [sourceMessage := sourceMessage messages last].
	sourceMessage isMessage 
		ifFalse: 
			[self 
				refactoringFailure: 'The selection doesn''t appear to be a message send'].
	(sourceMessage receiver isVariable 
		and: [#('self' 'super') includes: sourceMessage receiver name]) 
			ifFalse: [self refactoringError: 'Cannot inline non-self messages']! !

!RBInlineMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'!
replaceArgument: sourceNode with: replacementNode 
	| rewriter |
	rewriter := RBParseTreeRewriter new.
	rewriter replaceTree: sourceNode withTree: replacementNode.
	(rewriter executeTree: inlineParseTree body) 
		ifTrue: [inlineParseTree body: rewriter tree]! !

!RBInlineMethodRefactoring methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream nextPutAll: ' inline: '.
	sourceInterval storeOn: aStream.
	aStream
		nextPutAll: ' inMethod: #';
		nextPutAll: sourceSelector;
		nextPutAll: ' forClass: '.
	class storeOn: aStream.
	aStream nextPut: $)! !

!RBInlineMethodRefactoring methodsFor: 'transforming' stamp: ''!
compileMethod
	class compileTree: sourceParseTree! !

!RBInlineMethodRefactoring methodsFor: 'transforming' stamp: ''!
checkSuperMessages
	self inlineClass = class ifTrue: [^self].
	self inlineClass superclass isNil ifTrue: [^self].
	inlineParseTree superMessages do: 
			[:each | 
			(self inlineClass superclass whoDefinesMethod: each) 
				= (class superclass whoDefinesMethod: each) 
					ifFalse: 
						[self 
							refactoringError: ('Cannot inline method since it sends a super message <1s> that is overriden' 
									expandMacrosWith: each)]]! !

!RBInlineMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'!
removeEmptyIfTrues
	| rewriter |
	rewriter := RBParseTreeRewriter new.
	rewriter
		replace: '``@boolean ifTrue: [] ifFalse: [| `@temps | ``@.Stmts]'
			with: '``@boolean ifFalse: [|`@temps | ``@.Stmts]';
		replace: '``@boolean ifFalse: [] ifTrue: [| `@temps | ``@.Stmts]'
			with: '``@boolean ifTrue: [|`@temps | ``@.Stmts]';
		replace: '``@boolean ifTrue: [| `@temps | ``@.Stmts] ifFalse: []'
			with: '``@boolean ifTrue: [|`@temps | ``@.Stmts]';
		replace: '``@boolean ifFalse: [| `@temps | ``@.Stmts] ifTrue: []'
			with: '``@boolean ifFalse: [|`@temps | ``@.Stmts]'.
	(rewriter executeTree: sourceParseTree) 
		ifTrue: [sourceParseTree := rewriter tree]! !

!RBInlineMethodRefactoring methodsFor: 'testing' stamp: ''!
isPrimitive
	^inlineParseTree isPrimitive! !

!RBInlineMethodRefactoring methodsFor: 'transforming' stamp: ''!
rewriteInlinedTree
	sourceMessage parent isReturn 
		ifTrue: 
			[(sourceParseTree isLast: sourceMessage parent) 
				ifFalse: [self addSelfReturn]]
		ifFalse: 
			[self
				writeGuardClauses;
				normalizeIfTrues;
				normalizeReturns;
				addSelfReturn]! !

!RBInlineMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'!
normalizeIfTrues
	| rewriter |
	rewriter := RBParseTreeRewriter new.
	rewriter
		replace: '| `@temps | ``@.s1. ``@boolean ifTrue: [| `@t1 | ``@.Stmts1. ^`@r1]. ``@.s2. ^``@r2'
			with: '| `@temps | ``@.s1. ``@boolean ifTrue: [| `@t1 | ``@.Stmts1. ^`@r1] ifFalse: [``@.s2. ^``@r2]';
		replace: '| `@temps | ``@.s1. ``@boolean ifFalse: [| `@t1 | ``@.Stmts1. ^`@r1]. ``@.s2. ^``@r2'
			with: '| `@temps | ``@.s1. ``@boolean ifTrue: [``@.s2. ^``@r2] ifFalse: [| `@t1 | ``@.Stmts1. ^`@r1]'.
	[rewriter executeTree: inlineParseTree] 
		whileTrue: [inlineParseTree := rewriter tree]! !

!RBInlineMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'!
writeGuardClauses
	| rewriter |
	rewriter := RBParseTreeRewriter new.
	rewriter
		replaceMethod: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifTrue: [| `@t1 | `@.Stmts1. ^`@r1]. `@.s2. ^`@r2'
			with: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifTrue: [| `@t1 | `@.Stmts1. ^`@r1] ifFalse: [`@.s2. ^`@r2]';
		replaceMethod: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifFalse: [| `@t1 | `@.Stmts1. ^`@r1]. `@.s2. ^`@r2'
			with: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifTrue: [`@.s2. ^`@r2] ifFalse: [| `@t1 | `@.Stmts1. ^`@r1]';
		replaceMethod: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifTrue: [| `@t1 | `@.Stmts1. ^`@r1]. `@.s2'
			with: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifTrue: [| `@t1 | `@.Stmts1. ^`@r1] ifFalse: [`@.s2. ^self]';
		replaceMethod: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifFalse: [| `@t1 | `@.Stmts1. ^`@r1]. `@.s2'
			with: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifTrue: [`@.s2. ^self] ifFalse: [| `@t1 | `@.Stmts1. ^`@r1]'.
	[rewriter executeTree: inlineParseTree] 
		whileTrue: [inlineParseTree := rewriter tree]! !

!RBInlineMethodRefactoring methodsFor: 'transforming' stamp: 'PabloHerrero 11/7/2013 17:35'!
moveComments
	inlineParseTree nodesDo: 
			[:each | 
			each 
				comments: (each comments collect:
							[:aComment | 
							| start source |
							source := sourceParseTree source.
							start := source size + 1.
							source := source 
										, (inlineParseTree source copyFrom: aComment start to: aComment stop).
							sourceParseTree source: source.
							RBComment with: aComment contents at: start])]! !

!RBInlineMethodRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBSmalltalk inline: anInterval inMethod: aSelector forClass: aClass 
	^(self new)
		model: aRBSmalltalk;
		inline: anInterval
			inMethod: aSelector
			forClass: aClass;
		yourself! !

!RBInlineMethodRefactoring class methodsFor: 'instance creation' stamp: ''!
inline: anInterval inMethod: aSelector forClass: aClass 
	^self new 
		inline: anInterval
		inMethod: aSelector
		forClass: aClass! !

!RBInlineMethodTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testBadInterval
	self
		shouldFail: (RBInlineMethodRefactoring 
				inline: (self 
						convertInterval: (13 to: 23)
						for: (RBRefactoryTestDataApp sourceCodeAt: #testMethod))
				inMethod: #testMethod
				forClass: RBRefactoryTestDataApp);
		shouldFail: (RBInlineMethodRefactoring 
				inline: (self 
						convertInterval: (14 to: 17)
						for: (RBRefactoryTestDataApp sourceCodeAt: #testMethod))
				inMethod: #testMethod
				forClass: RBRefactoryTestDataApp);
		shouldFail: (RBInlineMethodRefactoring 
				inline: (self 
						convertInterval: (24 to: 30)
						for: (RBRefactoryTestDataApp sourceCodeAt: #testMethod))
				inMethod: #testMethod
				forClass: RBRefactoryTestDataApp);
		shouldFail: (RBInlineMethodRefactoring 
				inline: (self 
						convertInterval: (1 to: 30)
						for: (RBRefactoryTestDataApp sourceCodeAt: #testMethod))
				inMethod: #testMethod
				forClass: RBRefactoryTestDataApp)! !

!RBInlineMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testInlineMethod1
	| refactoring |
	refactoring := RBInlineMethodRefactoring 
		inline: (self 
				convertInterval: (39 to: 84)
				for: (RBRefactoryTestDataApp sourceCodeAt: #caller))
		inMethod: #caller
		forClass: RBRefactoryTestDataApp.
	self 
		setupInlineExpressionFor: refactoring
		toReturn: false.
	self executeRefactoring: refactoring.
	self assert: ((refactoring model classNamed: #RBRefactoryTestDataApp) parseTreeFor: #caller) = (RBParser parseMethod: 'caller 
									| anObject anObject1 | 
									anObject := 5.
									anObject1 := anObject + 1.
									Transcript
										show: anObject1 printString;
										cr.
									^anObject')! !

!RBInlineMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testInlineRecursiveCascadedMethod
	| refactoring |
	refactoring := RBInlineMethodRefactoring 
		inline: (self 
				convertInterval: (33 to: 62)
				for: (RBRefactoryTestDataApp sourceCodeAt: #inlineMethod))
		inMethod: #inlineMethod
		forClass: RBRefactoryTestDataApp.
	self executeRefactoring: refactoring.
	self assert: ((refactoring model classNamed: #RBRefactoryTestDataApp) parseTreeFor: #inlineMethod) = (RBParser parseMethod: 'inlineMethod
									| temp temp1 |
									self foo.
									temp1 := self foo; inlineMethod; bar.
									temp := self bar.
									^temp')! !

!RBInlineMethodTest methodsFor: 'failure tests' stamp: 'MarcusDenker 4/25/2013 15:10'!
testInlineMethodForSuperSendThatAlsoSendsSuper
	| refactoring |
	model := Smalltalk evaluate: self inlineMethodTestData.
	refactoring := RBInlineMethodRefactoring 
				inline: (102 to: 131)
				inMethod: #executeNotifying:
				forClass: (model classNamed: #RBRenameInstanceVariableChange).
	self shouldFail: refactoring! !

!RBInlineMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testInlineMethod4
	| refactoring |
	refactoring := RBInlineMethodRefactoring 
		inline: (self 
				convertInterval: (31 to: 112)
				for: (RBRefactoryTestDataApp sourceCodeAt: #inlineJunk))
		inMethod: #inlineJunk
		forClass: RBRefactoryTestDataApp.
	self 
		setupInlineExpressionFor: refactoring
		toReturn: false.
	self executeRefactoring: refactoring.
	self assert: ((refactoring model classNamed: #RBRefactoryTestDataApp) parseTreeFor: #inlineJunk) = (RBParser parseMethod: 'inlineJunk
										| asdf bar1 baz1 asdf1 |
										bar1 := 
												[:each | 
												| temp |
												temp := each.
												temp , temp] value: self.
										baz1 := bar1 + bar1.
										asdf1 := baz1 + bar1.
										asdf := asdf1.
										^asdf foo: 
												[:bar | 
												| baz |
												baz := bar.
												baz * baz]')! !

!RBInlineMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testModelInlineRecursiveMethod
	| refactoring class |
	class := model classNamed: #Object.
	class compile: 'foo self bar. self foo. self bar' classified: #(#accessing).
	refactoring := RBInlineMethodRefactoring 
				model: model
				inline: (15 to: 23)
				inMethod: #foo
				forClass: class.
	self executeRefactoring: refactoring.
	self 
		assert: (class parseTreeFor: #foo) = (RBParser 
						parseMethod: 'foo self bar. self bar. self foo. self bar. self bar')! !

!RBInlineMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testInlineMethod3
	| refactoring |
	refactoring := RBInlineMethodRefactoring 
		inline: (self 
				convertInterval: (58 to: 73)
				for: (RBRefactoryTestDataApp sourceCodeAt: #caller2))
		inMethod: #caller2
		forClass: RBRefactoryTestDataApp.
	self 
		setupInlineExpressionFor: refactoring
		toReturn: false.
	self executeRefactoring: refactoring.
	self assert: ((refactoring model classNamed: #RBRefactoryTestDataApp) parseTreeFor: #caller2) = (RBParser parseMethod: 'caller2
								^(1 to: 10) inject: 1 into: [:sum :each | sum * ((1 to: 10) inject: each into: [:sum1 :each1 | sum1 + each1])]	')! !

!RBInlineMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testInlineMethod2
	| refactoring |
	refactoring := RBInlineMethodRefactoring 
		inline: (self 
				convertInterval: (40 to: 120)
				for: (RBRefactoryTestDataApp sourceCodeAt: #caller1))
		inMethod: #caller1
		forClass: RBRefactoryTestDataApp.
	self 
		setupInlineExpressionFor: refactoring
		toReturn: false.
	self executeRefactoring: refactoring.
	self assert: ((refactoring model classNamed: #RBRefactoryTestDataApp) parseTreeFor: #caller1) = (RBParser parseMethod: 'caller1 
								| anObject each1 anObject1 | 
								anObject := 5.
								anObject1 := anObject + 1.
								each1 := anObject1 printString.
								Transcript
									show: each1;
									cr.
								[:each | each printString. ^anObject] value: each1')! !

!RBInlineMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testInlineMethod
	| refactoring |
	refactoring := RBInlineMethodRefactoring 
		inline: (self 
				convertInterval: (455 to: 504)
				for: (RBBasicLintRuleTest class sourceCodeAt: #sentNotImplementedInApplication))
		inMethod: #sentNotImplementedInApplication
		forClass: RBBasicLintRuleTest class.
	self executeRefactoring: refactoring.
	self assert: ((refactoring model metaclassNamed: #RBBasicLintRuleTest) parseTreeFor: #sentNotImplementedInApplication) = (RBParser parseMethod: 'sentNotImplementedInApplication
									| detector |
									detector := self new.
									detector name: ''Messages sent but not implemented in application''.
									detector methodBlock: 
											[:context :result | 
											| message class block |
											message := context messages 
														detect: [:each | (context isItem: each in: context application) not]
														ifNone: [nil].
											class := context selectedClass.
											block := 
													[:each | 
													| app methodApp root |
													app := context application.
													((class canUnderstand: each) 
														ifTrue: 
															[root := app rootApplication.
															methodApp := ((class whichClassIncludesSelector: each) 
																		compiledMethodAt: each) application 
																		rootApplication.
															methodApp == root or: [root isBasedOn: methodApp]]
														ifFalse: [false]) not].
											message isNil 
												ifTrue: [message := context selfMessages detect: block ifNone: [nil]].
											message isNil 
												ifTrue: 
													[class := class superclass.
													class isNil 
														ifTrue: 
															[context superMessages isEmpty 
																ifFalse: [message := context superMessages asArray first]]
														ifFalse: [message := context superMessages detect: block ifNone: [nil]]].
											message notNil 
												ifTrue: 
													[result addSearchString: message.
													result addClass: context selectedClass selector: context selector]].
									^detector')! !

!RBInlineMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testInlineMethod5
	| refactoring |
	refactoring := RBInlineMethodRefactoring 
		inline: (self 
				convertInterval: (53 to: 64)
				for: (RBRefactoryTestDataApp sourceCodeAt: #inlineLast))
		inMethod: #inlineLast
		forClass: RBRefactoryTestDataApp.
	self executeRefactoring: refactoring.
	self assert: ((refactoring model classNamed: #RBRefactoryTestDataApp) parseTreeFor: #inlineLast) = (RBParser parseMethod: 'inlineLast
									5 = 3 ifTrue: [^self caller] ifFalse: [^	(1 to: 10) inject: 1 into: [:sum :each | sum * (self foo: each)]]')! !

!RBInlineMethodTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testNonExistantSelector
	self shouldFail: (RBInlineMethodRefactoring 
			inline: (14 to: 17)
			inMethod: #checkClass1:
			forClass: RBRefactoryTestDataApp)! !

!RBInlineMethodTest methodsFor: 'tests' stamp: 'MarcusDenker 4/25/2013 15:10'!
testInlineMethodForSuperSend
	| refactoring |
	model := Smalltalk evaluate: self inlineMethodTestData.
	(model classNamed: #RBRenameVariableChange) removeMethod: #executeNotifying:.
	refactoring := RBInlineMethodRefactoring 
				model: model
				inline: (self convertInterval: (102 to: 131)
						for: ((model classNamed: #RBRenameInstanceVariableChange) 
								sourceCodeFor: #executeNotifying:))
				inMethod: #executeNotifying:
				forClass: (model classNamed: #RBRenameInstanceVariableChange).
	self executeRefactoring: refactoring.
	self 
		assert: ((model classNamed: #RBRenameInstanceVariableChange) 
				parseTreeFor: #executeNotifying:) = (RBParser 
							parseMethod: 'executeNotifying: aBlock 
									| undo undos undo1 |
									self addNewVariable.
									self copyOldValuesToNewVariable.
									undos := changes collect: [:each | each executeNotifying: aBlock].
									undo1 := self copy.
									undo1 changes: undos reverse.
									undo := undo1.
									self removeOldVariable.
									^undo')! !

!RBInlineMethodTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testPrimitive
	self shouldFail: (RBInlineMethodRefactoring 
			inline: (self 
					convertInterval: (14 to: 23)
					for: (RBRefactoryTestDataApp sourceCodeAt: #testMethod))
			inMethod: #testMethod
			forClass: RBRefactoryTestDataApp)! !

!RBInlineMethodTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testOverriden
	self shouldWarn: (RBInlineMethodRefactoring 
			inline: (self 
					convertInterval: (15 to: 26)
					for: (RBLintRuleTest sourceCodeAt: #failedRules))
			inMethod: #failedRules
			forClass: RBLintRuleTest)! !

!RBInlineMethodTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testReturn
	self shouldFail: (RBInlineMethodRefactoring 
			inline: (self 
					convertInterval: (418 to: 485)
					for: (RBBasicLintRuleTest class sourceCodeAt: #utilityMethods))
			inMethod: #utilityMethods
			forClass: RBBasicLintRuleTest class)! !

!RBInlineParameterRefactoring methodsFor: 'initialize-release' stamp: ''!
inlineParameter: aString in: aClass selector: aSelector
	oldSelector := aSelector.
	class := self classObjectFor: aClass.
	argument := aString! !

!RBInlineParameterRefactoring methodsFor: 'private' stamp: ''!
allExpressionsToInline
	| coll |
	coll := Set new.
	self model allReferencesTo: oldSelector
		do: 
			[:each | 
			| tree |
			tree := each parseTree.
			tree notNil ifTrue: [coll addAll: (self expressionsToInlineFrom: tree)]].
	^coll asOrderedCollection! !

!RBInlineParameterRefactoring methodsFor: 'transforming' stamp: ''!
modifyImplementorParseTree: parseTree in: aClass 
	| node assignment |
	node := (parseTree arguments at: parameterIndex) copy.
	parseTree body addTemporaryNamed: node name.
	assignment := RBAssignmentNode variable: node copy value: expressions first.
	parseTree body addNodeFirst: assignment.
	super modifyImplementorParseTree: parseTree in: aClass! !

!RBInlineParameterRefactoring methodsFor: 'preconditions' stamp: 'MarcusDenker 9/20/2013 15:06'!
myConditions
	self getNewSelector.
	expressions := self allExpressionsToInline.
	^(RBCondition definesSelector: oldSelector in: class) 
		& ((RBCondition withBlock: [expressions isEmpty not]) 
				errorMacro: 'No callers. Use Remove Method instead.') 
			& ((RBCondition withBlock: [expressions size = 1]) 
					errorMacro: 'All values passed as this argument must be identical.') 
			& ((RBCondition withBlock: [expressions first isLiteralNode]) 
					errorMacro: 'All values passed must be literal.')! !

!RBInlineParameterRefactoring methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream
		nextPutAll: ' inlineParameter: ''';
		nextPutAll: argument;
		nextPutAll: ''' in: '.
	class storeOn: aStream.
	aStream
		nextPutAll: ' selector: #';
		nextPutAll: oldSelector;
		nextPut: $)! !

!RBInlineParameterRefactoring methodsFor: 'private' stamp: 'lr 11/2/2009 00:14'!
expressionsToInlineFrom: aTree 
	| searcher |
	searcher := RBParseTreeSearcher new.
	searcher matches: '``@obj ' , (self buildSelectorString: oldSelector)
		do: 
			[:aNode :answer | 
			answer
				add: (aNode arguments at: parameterIndex);
				yourself].
	^searcher executeTree: aTree initialAnswer: OrderedCollection new! !

!RBInlineParameterRefactoring class methodsFor: 'instance creation' stamp: ''!
inlineParameter: aString in: aClass selector: aSelector 
	^self new 
		inlineParameter: aString
		in: aClass
		selector: aSelector! !

!RBInlineParameterRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBSmalltalk inlineParameter: aString in: aClass selector: aSelector 
	^(self new)
		model: aRBSmalltalk;
		inlineParameter: aString
			in: aClass
			selector: aSelector;
		yourself! !

!RBInlineParameterTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testInlineLiteralArray
	| refactoring class |
	refactoring := RBInlineParameterRefactoring 
		inlineParameter: 'aSymbol'
		in: RBRefactoryTestDataApp
		selector: ('inline' , 'ParameterMethod:') asSymbol.
	self executeRefactoring: refactoring.
	class := refactoring model classNamed: #RBRefactoryTestDataApp.
	self assert: (class parseTreeFor: #inlineParameterMethod) = (RBParser parseMethod: 'inlineParameterMethod | aSymbol | aSymbol := #(asdf). ^aSymbol isSymbol').
	self assert: (class parseTreeFor: #sendInlineParameterMethod) = (RBParser parseMethod: 'sendInlineParameterMethod ^self inlineParameterMethod').
	self deny: (class directlyDefinesMethod: ('inline' , 'ParameterMethod:') asSymbol)! !

!RBInlineParameterTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testInlineBlockFailure
	self shouldFail: (RBInlineParameterRefactoring 
			inlineParameter: 'aBlock'
			in: RBRefactoryTestDataApp
			selector: ('inline' , 'Foo:') asSymbol)! !

!RBInlineTemporaryRefactoring methodsFor: 'preconditions' stamp: 'CamilloBruni 10/8/2012 00:08'!
verifySelectedInterval
	sourceTree := class parseTreeFor: selector.
	sourceTree isNil ifTrue: [self refactoringFailure: 'Could not parse source'].
	assignmentNode := sourceTree whichNodeIsContainedBy: sourceInterval.
	assignmentNode isAssignment 
		ifFalse: 
			[self refactoringFailure: 'The selected node is not an assignment statement'].
	definingNode := assignmentNode whoDefines: assignmentNode variable name.
	self hasOnlyOneAssignment 
		ifFalse: 
			[self refactoringError: 'There are multiple assignments to the variable'].
	(RBReadBeforeWrittenTester isVariable: assignmentNode variable name
		writtenBeforeReadIn: definingNode) 
			ifFalse: 
				[self 
					refactoringError: 'The variable is possible read before it is assigned']! !

!RBInlineTemporaryRefactoring methodsFor: 'initialize-release' stamp: ''!
inline: anInterval from: aSelector in: aClass 
	class := self classObjectFor: aClass.
	selector := aSelector.
	sourceInterval := anInterval! !

!RBInlineTemporaryRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^(RBCondition definesSelector: selector in: class) 
		& (RBCondition withBlock: 
					[self verifySelectedInterval.
					true])! !

!RBInlineTemporaryRefactoring methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream nextPutAll: ' inline: '.
	sourceInterval storeOn: aStream.
	aStream
		nextPutAll: ' from: #';
		nextPutAll: selector;
		nextPutAll: ' in: '.
	class storeOn: aStream.
	aStream nextPut: $)! !

!RBInlineTemporaryRefactoring methodsFor: 'transforming' stamp: ''!
transform
	self
		replaceAssignment;
		replaceReferences;
		compileMethod! !

!RBInlineTemporaryRefactoring methodsFor: 'testing' stamp: 'lr 11/2/2009 00:14'!
hasOnlyOneAssignment
	| searcher |
	searcher := RBParseTreeSearcher new.
	searcher matches: assignmentNode variable name , ' := ``@object'
		do: [:aNode :answer | answer + 1].
	^(searcher executeTree: definingNode initialAnswer: 0) == 1! !

!RBInlineTemporaryRefactoring methodsFor: 'transforming' stamp: ''!
compileMethod
	class compileTree: sourceTree! !

!RBInlineTemporaryRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'!
replaceReferences
	| rewriter |
	rewriter := RBParseTreeRewriter new.
	rewriter replaceTree: assignmentNode variable
		withTree: assignmentNode value.
	definingNode removeTemporaryNamed: assignmentNode variable name.
	rewriter executeTree: definingNode! !

!RBInlineTemporaryRefactoring methodsFor: 'transforming' stamp: ''!
replaceAssignment
	assignmentNode parent isSequence 
		ifTrue: [assignmentNode parent removeNode: assignmentNode]
		ifFalse: [assignmentNode replaceWith: assignmentNode value]! !

!RBInlineTemporaryRefactoring class methodsFor: 'instance creation' stamp: ''!
inline: anInterval from: aSelector in: aClass 
	^self new 
		inline: anInterval
		from: aSelector
		in: aClass! !

!RBInlineTemporaryRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBSmalltalk inline: anInterval from: aSelector in: aClass 
	^(self new)
		model: aRBSmalltalk;
		inline: anInterval
			from: aSelector
			in: aClass;
		yourself! !

!RBInlineTemporaryTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testInlineTemporaryBadInterval
	self shouldFail: (RBInlineTemporaryRefactoring 
			inline: (self 
					convertInterval: (29 to: 100)
					for: (RBRefactoryTestDataApp sourceCodeAt: #moveDefinition))
			from: #moveDefinition
			in: RBRefactoryTestDataApp)! !

!RBInlineTemporaryTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testInlineTemporary
	| refactoring |
	refactoring := RBInlineTemporaryRefactoring 
		inline: (self 
				convertInterval: (24 to: 72)
				for: (RBRefactoryTestDataApp sourceCodeAt: #inlineMethod))
		from: #inlineMethod
		in: RBRefactoryTestDataApp.
	self executeRefactoring: refactoring.
	self assert: ((refactoring model classNamed: #RBRefactoryTestDataApp) parseTreeFor: #inlineMethod) = (RBParser parseMethod: 'inlineMethod
										^self
													foo;
													inlineMethod;
													bar')! !

!RBInlineTemporaryTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testInlineTemporaryReadBeforeWritten
	self shouldFail: (RBInlineTemporaryRefactoring 
			inline: (self 
					convertInterval: (48 to: 56)
					for: (RBRefactoryTestDataApp sourceCodeAt: #inlineTemporary))
			from: #inlineTemporary
			in: RBRefactoryTestDataApp)! !

!RBInlineTemporaryTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testInlineTemporaryMutlipleAssignment
	self shouldFail: (RBInlineTemporaryRefactoring 
			inline: (self 
					convertInterval: (60 to: 83)
					for: (RBRefactoryTestDataApp sourceCodeAt: #moveDefinition))
			from: #moveDefinition
			in: RBRefactoryTestDataApp)! !

!RBInstVarInSubclassesRule commentStamp: 'StephaneDucasse 11/29/2014 20:59'!
This smell arises when instance variables are defined in all subclasses. Many times you might want to pull the instance variable up into the class so that all the subclasses do not have to define it. In addition have a look at the initialize method in each of the subclasses because if the instance variable is really the same, it will be initialized similarly in different places.

!
!RBInstVarInSubclassesRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'!
resultClass
	^ RBVariableEnvironment! !

!RBInstVarInSubclassesRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 10:21'!
category
	^ 'Design Flaws'! !

!RBInstVarInSubclassesRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 21:00'!
rationale
	^ 'Checks classes for instance variables that are defined in all subclasses. '! !

!RBInstVarInSubclassesRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Miscellaneous'! !

!RBInstVarInSubclassesRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:03'!
severity
	^ #information! !

!RBInstVarInSubclassesRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Instance variables defined in all subclasses'! !

!RBInstVarInSubclassesRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:49'!
checkClass: aClass 
	| subs |
	subs := aClass subclasses.
	subs size > 1 ifTrue: 
		[ | sels |
		sels := Bag new.
		subs do: [ :each | sels addAll: each instVarNames ].
		sels asSet do: 
			[ :val | 
			| count |
			count := sels occurrencesOf: val.
			count == subs size ifTrue: 
				[ result 
					addClass: aClass
					instanceVariable: val ] ] ]! !

!RBInstVarInSubclassesRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'InstVarInSubclassesRule'! !

!RBInstanceVariableCapitalizationRule commentStamp: 'StephaneDucasse 11/29/2014 20:58'!
This smell arises when instance variable names (in instance and class side) do not start with an lowercase letter, which is a standard style in Smalltalk.

Instance variable names on the instance- and class-side should start with a lowercase letter. A lowercase letter is used to represent variables with a local scope such as instance variables, temporary variables, method and block arguments. Uppercase is used to represent the case where the scope of a variable is either global (class name and global variables such Transcript) or shared mong different classes (class variables or pool variables).!
!RBInstanceVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'!
resultClass
	^ RBVariableEnvironment! !

!RBInstanceVariableCapitalizationRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 20:58'!
rationale
	^ 'Instance variable names on the instance- and class-side should start with a lowercase letter.'! !

!RBInstanceVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Intention revealing'! !

!RBInstanceVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Instance variable capitalization'! !

!RBInstanceVariableCapitalizationRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 10:14'!
category
	^ 'Style'! !

!RBInstanceVariableCapitalizationRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:49'!
checkClass: aClass 
	aClass instVarNames do: [ :each | 
		each first isLowercase ifFalse: [
			result 
				addClass: aClass
				instanceVariable: each ] ]! !

!RBInstanceVariableCapitalizationRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'InstanceVariableCapitalizationRule'! !

!RBJustSendsSuperRule commentStamp: 'StephaneDucasse 11/29/2014 20:57'!
This smell arises when a method just forwards the message to its superclass. This often happens due to code changes or when you simply forget that you wanted to extend the behavior of a superclass method. These methods can be removed.!
!RBJustSendsSuperRule methodsFor: 'initialization' stamp: 'lr 11/2/2009 00:14'!
initialize
	super initialize.
	matcher := RBParseTreeSearcher justSendsSuper! !

!RBJustSendsSuperRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 10:21'!
category
	^ 'Optimization'! !

!RBJustSendsSuperRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 20:58'!
rationale
	^ 'Check for methods that just forward the message to its superclass.'! !

!RBJustSendsSuperRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Unnecessary code'! !

!RBJustSendsSuperRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:10'!
severity
	^ #information! !

!RBJustSendsSuperRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Method just sends super message'! !

!RBJustSendsSuperRule methodsFor: 'running' stamp: 'MarcusDenker 10/27/2014 17:58'!
checkMethod: aMethod 
	(aMethod ast isPrimitive not and: 
		[ matcher 
			executeMethod: aMethod ast
			initialAnswer: false ]) ifTrue: 
		[ result addMethod: aMethod ]! !

!RBJustSendsSuperRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'JustSendsSuperRule'! !

!RBKeywordToken commentStamp: 'md 8/9/2005 14:52'!
RBKeywordToken is the first-class representation of a keyword token (e.g. add:)!
!RBKeywordToken methodsFor: 'testing' stamp: ''!
isKeyword
	^true! !

!RBKeywordToken methodsFor: 'testing' stamp: 'lr 11/7/2009 15:30'!
isPatternVariable
	^value first = RBScanner patternVariableCharacter! !

!RBLintRule commentStamp: '<historical>'!
I represent an executable check applied on an environment (groups of classes, methods... )!
!RBLintRule methodsFor: 'accessing' stamp: 'lr 2/24/2009 08:29'!
changes
	^ #()! !

!RBLintRule methodsFor: 'accessing' stamp: 'SimonAllier 5/21/2012 14:38'!
leaves 
	^ {self}! !

!RBLintRule methodsFor: 'testing' stamp: 'lr 2/23/2009 21:51'!
isEmpty
	self subclassResponsibility! !

!RBLintRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 11:05'!
category
	"Bugs, Potential Bugs, Design Flaws, Coding Idiom Violation, Optinization, Style "
	^ 'Unclassified rules'! !

!RBLintRule methodsFor: 'testing' stamp: 'lr 2/23/2009 21:52'!
isComposite
	^ false! !

!RBLintRule methodsFor: 'testing' stamp: 'lr 2/23/2009 21:52'!
hasConflicts
	^ false! !

!RBLintRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 18:50'!
rationale
	"Answer an explanation of the rule, usually in one line. Long description can be obtained using longDescription."

	^ self class comment! !

!RBLintRule methodsFor: 'running' stamp: 'lr 9/8/2011 20:15'!
run
	^ RBSmalllintChecker runRule: self! !

!RBLintRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:01'!
severity
	"Answer the severity of issues reported by this rule. This method should return one of #error, #warning, or #information."

	^ #warning! !

!RBLintRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 16:43'!
checkMethod: aMethod
	"Is a hook to specify a check that is performed at the method level"! !

!RBLintRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 16:43'!
checkClass: aClass
	"Is a hook to specify a check that is performed at the class level"
	
! !

!RBLintRule methodsFor: 'accessing' stamp: ''!
result
	^ self subclassResponsibility! !

!RBLintRule methodsFor: 'private' stamp: 'lr 2/24/2009 15:46'!
genericPatternForSelector: aSymbol
	^ String streamContents: [ :stream |
		aSymbol keywords keysAndValuesDo: [ :index :value |
			stream space; nextPutAll: value.
			aSymbol last = $:
				ifTrue: [ stream space; nextPutAll: '`@object'; print: index ] ] ]! !

!RBLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:41'!
problemCount
	self subclassResponsibility! !

!RBLintRule methodsFor: 'printing' stamp: 'lr 2/26/2009 16:06'!
printOn: aStream 
	super printOn: aStream.
	self name isNil 
		ifFalse: [ aStream nextPutAll: ' name: '; print: self name ]! !

!RBLintRule methodsFor: 'running' stamp: 'lr 2/23/2009 21:35'!
resetResult! !

!RBLintRule methodsFor: 'running' stamp: 'lr 9/8/2011 20:15'!
runOnEnvironment: anEnvironment 
	^ RBSmalllintChecker runRule: self onEnvironment: anEnvironment! !

!RBLintRule methodsFor: '*Manifest-Core' stamp: 'SimonAllier 3/27/2013 10:15'!
critics
	^ self result smallLintCritics ! !

!RBLintRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 17:26'!
longDescription
	"A long version of the rationale, just delegate to the class comment. Therefore just enhance class comments!!"
	^ self class comment ! !

!RBLintRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 14:59'!
group
	"Answer a human readable group name of this rule."

	^ String new! !

!RBLintRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 14:58'!
name
	"Answer a human readable name of the rule."

	self subclassResponsibility! !

!RBLintRule methodsFor: 'testing' stamp: ''!
isTransformationRule

	^ false ! !

!RBLintRule class methodsFor: 'accessing' stamp: ''!
identifierMinorVersionNumber
	"This number identifies the version of the rule definition. Each time the rule is updated and its changes invalidates previous false positives identification (and as such should be reassessed by developers) the number should be increased."
	^ 1! !

!RBLintRule class methodsFor: 'testing' stamp: 'lr 2/24/2009 17:08'!
isVisible
	"Answer true if the class should be visible in the GUI."

	^ false! !

!RBLintRule class methodsFor: 'accessing' stamp: ''!
uniqueIdentifierNumber
	"This number should be unique and should change only when the rule completely change semantics"
	^ 0! !

!RBLintRuleTest methodsFor: 'accessing' stamp: ''!
displayName
	| nameStream |
	nameStream := WriteStream on: (String new: 64).
	nameStream nextPutAll: self name;
		nextPutAll: ' ('.
	self problemCount printOn: nameStream.
	nameStream nextPut: $).
	^nameStream contents! !

!RBLintRuleTest methodsFor: 'testing' stamp: ''!
isEmpty
	self subclassResponsibility! !

!RBLintRuleTest methodsFor: 'testing' stamp: ''!
isComposite
	^false! !

!RBLintRuleTest methodsFor: 'testing' stamp: ''!
hasConflicts
	^false! !

!RBLintRuleTest methodsFor: 'accessing' stamp: ''!
run
	^Object printOn: self! !

!RBLintRuleTest methodsFor: 'private' stamp: ''!
viewResults
	self subclassResponsibility! !

!RBLintRuleTest methodsFor: 'accessing' stamp: ''!
checkMethod: aSmalllintContext! !

!RBLintRuleTest methodsFor: 'accessing' stamp: ''!
checkClass: aSmalllintContext! !

!RBLintRuleTest methodsFor: 'initialization' stamp: ''!
initialize
	name := ''! !

!RBLintRuleTest methodsFor: 'accessing' stamp: 'MarkRizun 7/22/2014 14:28'!
someOtherDemoMethod
	| temp |
	temp := self new.
	^ temp junk! !

!RBLintRuleTest methodsFor: 'accessing' stamp: ''!
name: aString 
	name := aString! !

!RBLintRuleTest methodsFor: 'accessing' stamp: 'lr 8/7/2009 17:38'!
openEditor
	| rules |
	rules := self failedRules.
	rules isEmpty ifTrue: [^self].
	rules size == 1 ifTrue: [^rules first viewResults]! !

!RBLintRuleTest methodsFor: 'printing' stamp: ''!
printOn: aStream 
	name isNil
		ifTrue: [super printOn: aStream]
		ifFalse: [aStream nextPutAll: name]! !

!RBLintRuleTest methodsFor: 'accessing' stamp: ''!
problemCount
	^self subclassResponsibility! !

!RBLintRuleTest methodsFor: 'initialize-release' stamp: ''!
resetResult! !

!RBLintRuleTest methodsFor: 'accessing' stamp: ''!
runOnEnvironment: anEnvironment 
	^Object printOn: self onEnvironment: anEnvironment! !

!RBLintRuleTest methodsFor: 'private' stamp: ''!
failedRules
	^self isEmpty
		ifTrue: [#()]
		ifFalse: [Array with: self]! !

!RBLintRuleTest methodsFor: 'accessing' stamp: ''!
name
	^name! !

!RBLintRuleTest methodsFor: 'testing' stamp: 'lr 2/26/2009 15:07'!
junk
	^ RBRefactoryTestDataApp printString 
		copyFrom: 1
		to: CR! !

!RBLintRuleTest class methodsFor: 'foo' stamp: 'MarkRizun 7/25/2014 10:15'!
someFooMethod
	^ 'does nothing here:)'! !

!RBLintRuleTest class methodsFor: 'foo' stamp: 'MarkRizun 7/25/2014 10:16'!
someOtherFooMethod
	^ 'does nothing here even better:)'! !

!RBLiteralArrayCharactersRule commentStamp: 'StephaneDucasse 11/29/2014 22:12'!
Literal arrays containing only characters can more efficiently represented as strings.!
!RBLiteralArrayCharactersRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:32'!
initialize
	super initialize.
	self matcher 
		matches: '`#literal'
		do: [ :node :answer | 
			answer isNil 
				ifTrue: [
					(node value class == Array and: [ self isArrayOfCharacters: node value ]) 
						ifTrue: [ node ]
						ifFalse: [ nil ] ]
				ifFalse: [ answer ] ]! !

!RBLiteralArrayCharactersRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Intention revealing'! !

!RBLiteralArrayCharactersRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Literal array contains only characters'! !

!RBLiteralArrayCharactersRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:22'!
category 
	^ 'Optimization'! !

!RBLiteralArrayCharactersRule methodsFor: 'private' stamp: 'lr 2/24/2009 00:25'!
isArrayOfCharacters: anArray 
	anArray isEmpty ifTrue: [^false].
	1 to: anArray size
		do: [:each | (anArray at: each) class == Character ifFalse: [^false]].
	^true! !

!RBLiteralArrayCharactersRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'LiteralArrayCharactersRule'! !

!RBLiteralArrayContainsCommaRule commentStamp: 'StephaneDucasse 11/29/2014 20:57'!
Checks for literal arrays that contain the #, symbol. The user may have thought that it was a separator.!
!RBLiteralArrayContainsCommaRule methodsFor: 'private' stamp: 'lr 2/6/2010 13:32'!
doesLiteralArrayContainComma: aLiteral 
	aLiteral class = Array 
		ifFalse: [ ^ false ].
	(aLiteral includes: #,)
		ifTrue: [ ^ true ].
	^ aLiteral 
		anySatisfy: [ :each | self doesLiteralArrayContainComma: each ]! !

!RBLiteralArrayContainsCommaRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Possible bugs'! !

!RBLiteralArrayContainsCommaRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Literal array contains a #,'! !

!RBLiteralArrayContainsCommaRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 14:13'!
category 
	^ 'Coding Idiom Violation'! !

!RBLiteralArrayContainsCommaRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 16:58'!
checkMethod: aMethod 
	(aMethod allLiterals anySatisfy: [ :each | self doesLiteralArrayContainComma: each ]) 
		ifTrue: [ result addMethod: aMethod ]! !

!RBLiteralArrayContainsCommaRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'LiteralArrayContainsCommaRule'! !

!RBLiteralArrayContainsSuspiciousTrueFalseOrNilRule commentStamp: 'StephaneDucasse 11/29/2014 20:56'!
Some times ago, arrays were not allowed to contain true false and nil objects. They only contain their symbol representation: evaluating #(true false nil) returns #(#true #false #nil). 

Nowadays, #(true false nil) is equivalent to {true . false . nil }, i.e., it returns an array with the objects true, false, and nil. 

This smells checks methods having #(#true #false #nil) in their literal frame since it can be the source of potential bugs. 
	 !
!RBLiteralArrayContainsSuspiciousTrueFalseOrNilRule methodsFor: 'initialization' stamp: 'lr 2/6/2010 13:50'!
initialize
	super initialize.
	matcher := RBParseTreeSearcher new.
	matcher 
		matches: '`#array `{ :node | node isLiteralArray and: [ node isForByteArray not ] }'
		do: [ :node :answer | 
			answer 
				addAll: (self literalTrueFalseOrNilSymbolsIn: node value);
				yourself ]! !

!RBLiteralArrayContainsSuspiciousTrueFalseOrNilRule methodsFor: 'private' stamp: 'lr 2/6/2010 13:21'!
literalTrueFalseOrNilSymbolsIn: aLiteral 
	| retval |
	aLiteral class == Array ifFalse: [ ^ #() ].
	retval := OrderedCollection withAll: (aLiteral 
		select: [ :each | each isSymbol and: [ #(#true #false #nil ) includes: each ] ]).
	aLiteral do: [ :each | retval addAll: (self literalTrueFalseOrNilSymbolsIn: each) ].
	^ retval! !

!RBLiteralArrayContainsSuspiciousTrueFalseOrNilRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 14:12'!
category
	^ 'Potential Bugs'! !

!RBLiteralArrayContainsSuspiciousTrueFalseOrNilRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 20:56'!
rationale
	^ '#(true false nil) now is equal to {true. false. nil} not {#true. #false. #nil} as it used to be.'! !

!RBLiteralArrayContainsSuspiciousTrueFalseOrNilRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Possible bugs'! !

!RBLiteralArrayContainsSuspiciousTrueFalseOrNilRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Literal array contains a #true, #false, or #nil but the source doesn''t.'! !

!RBLiteralArrayContainsSuspiciousTrueFalseOrNilRule methodsFor: 'running' stamp: 'MarcusDenker 10/27/2014 17:58'!
checkMethod: aMethod 
	| compiledLits parsedLits |
	compiledLits := aMethod allLiterals
		inject: OrderedCollection new
		into: [ :collection :literal |
			collection
				addAll: (self literalTrueFalseOrNilSymbolsIn: literal);
				yourself ].
	compiledLits size > 0 ifTrue: [ 
		parsedLits := OrderedCollection new.
		matcher 
			executeTree: aMethod ast
			initialAnswer: parsedLits.
		compiledLits size ~= parsedLits size ifTrue: [
			result addMethod: aMethod ] ]! !

!RBLiteralArrayContainsSuspiciousTrueFalseOrNilRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'LiteralArrayContainsSuspiciousTrueFalseOrNilRule'! !

!RBLiteralArrayNode commentStamp: '<historical>'!
A RBLiteralArrayNode is an AST node that represents literal arrays and literal byte arrays.

Instance Variables
	contents: <Array of: RBLiteralNode> literal nodes of the array
	isByteArray: <Boolean> if the receiver is a literal byte array
!
!RBLiteralArrayNode methodsFor: 'testing' stamp: ''!
isLiteralArray
	^true! !

!RBLiteralArrayNode methodsFor: 'matching' stamp: 'lr 11/24/2009 23:36'!
copyInContext: aDictionary 
	^ self class 
		startPosition: nil
		contents: (self copyList: self contents inContext: aDictionary)
		stopPosition: nil
		isByteArray: isByteArray! !

!RBLiteralArrayNode methodsFor: 'accessing' stamp: ''!
children
	^contents! !

!RBLiteralArrayNode methodsFor: 'testing' stamp: 'GiselaDecuzzi 6/5/2013 10:29'!
isFaulty
	^self contents anySatisfy: #isFaulty! !

!RBLiteralArrayNode methodsFor: 'private-replacing' stamp: 'BernardoContreras 8/25/2014 19:27'!
replaceSourceWith: aNode 
	(self class = aNode class and: 
			[self isForByteArray = aNode isForByteArray 
				and: [self contents size = aNode contents size]]) 
		ifFalse: [^super replaceSourceWith: aNode].
	self contents
		with: aNode contents 
		do: [:first :second | first = second ifFalse: [ first replaceSourceWith: second]]! !

!RBLiteralArrayNode methodsFor: 'comparing' stamp: 'BernardoContreras 8/25/2014 19:24'!
equalTo: anObject withMapping: aDictionary 
	self class = anObject class ifFalse: [^false].
	self isForByteArray = anObject isForByteArray ifFalse: [^false].
	self contents size = anObject contents size ifFalse: [^false].
	self contents
		with: anObject contents
		do: [:first :second | (first equalTo: second withMapping: aDictionary) ifFalse: [^false]].
	^true! !

!RBLiteralArrayNode methodsFor: 'replacing' stamp: ''!
replaceNode: aNode withNode: anotherNode 
	self contents: (contents 
				collect: [:each | each == aNode ifTrue: [anotherNode] ifFalse: [each]])! !

!RBLiteralArrayNode methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:36'!
acceptVisitor: aProgramNodeVisitor 
	^aProgramNodeVisitor visitLiteralArrayNode: self! !

!RBLiteralArrayNode methodsFor: 'testing' stamp: ''!
isForByteArray
	^isByteArray! !

!RBLiteralArrayNode methodsFor: 'accessing' stamp: ''!
value
	| array |
	array := (isByteArray ifTrue: [ByteArray] ifFalse: [Array]) 
				new: contents size.
	1 to: contents size
		do: [:each | array at: each put: (contents at: each) value].
	^array! !

!RBLiteralArrayNode methodsFor: 'comparing' stamp: 'BernardoContreras 8/25/2014 19:22'!
= anObject 
	super = anObject ifFalse: [^false].
	self isForByteArray = anObject isForByteArray ifFalse: [^false].
	self contents size = anObject contents size ifFalse: [^false].
	self contents
		with: anObject contents
		do: [:first :second | first = second ifFalse: [^false]].
	^true! !

!RBLiteralArrayNode methodsFor: 'copying' stamp: 'lr 11/1/2009 22:35'!
postCopy
	super postCopy.
	self contents: (self contents collect: [ :each | each copy ])! !

!RBLiteralArrayNode methodsFor: 'matching' stamp: 'lr 5/30/2010 11:34'!
match: aNode inContext: aDictionary 
	aNode class = self class ifFalse: [^false].
	self isForByteArray = aNode isForByteArray ifFalse: [^false].
	^self 
		matchList: contents
		against: aNode contents
		inContext: aDictionary! !

!RBLiteralArrayNode methodsFor: 'initialize-release' stamp: ''!
startPosition: startInteger contents: anArray stopPosition: stopInteger isByteArray: aBoolean 
	start := startInteger.
	self contents: anArray.
	stop := stopInteger.
	isByteArray := aBoolean! !

!RBLiteralArrayNode methodsFor: 'initialize-release' stamp: ''!
contents: aRBLiteralNodeCollection 
	contents := aRBLiteralNodeCollection.
	contents do: [:each | each parent: self]! !

!RBLiteralArrayNode methodsFor: 'accessing' stamp: ''!
contents
	^contents! !

!RBLiteralArrayNode class methodsFor: 'instance creation' stamp: ''!
value: aValue 
	^(self new)
		startPosition: nil
			contents: (aValue asArray collect: [:each | RBLiteralNode value: each])
			stopPosition: nil
			isByteArray: aValue class ~~ Array;
		yourself! !

!RBLiteralArrayNode class methodsFor: 'instance creation' stamp: ''!
startPosition: startInteger contents: anArray stopPosition: stopInteger isByteArray: aBoolean 
	^(self new)
		startPosition: startInteger
			contents: anArray
			stopPosition: stopInteger
			isByteArray: aBoolean;
		yourself! !

!RBLiteralArrayToken methodsFor: 'testing' stamp: ''!
isLiteralArrayToken
	^true! !

!RBLiteralArrayToken methodsFor: 'testing' stamp: ''!
isForByteArray
	^value last = $[! !

!RBLiteralNode commentStamp: '<historical>'!
RBLiteralNode is an AST node that represents literals.

Instance Variables
	start: <Integer | nil> source position for the literal's beginning
	stop: <Integer | nil> source position for the literal's end!
!RBLiteralNode methodsFor: 'comparing' stamp: ''!
hash
	^self value hash! !

!RBLiteralNode methodsFor: 'accessing' stamp: 'PabloHerrero 10/24/2013 15:47'!
stopWithoutParentheses
	^stop! !

!RBLiteralNode methodsFor: 'accessing' stamp: ''!
precedence
	^0! !

!RBLiteralNode methodsFor: 'private-replacing' stamp: ''!
replaceSourceWith: aNode 
	self addReplacement: (RBStringReplacement 
				replaceFrom: self start
				to: self stop
				with: aNode formattedCode)! !

!RBLiteralNode methodsFor: 'accessing' stamp: 'PabloHerrero 10/24/2013 15:47'!
startWithoutParentheses
	^start! !

!RBLiteralNode methodsFor: 'testing' stamp: ''!
isLiteralNode
	^true! !

!RBLiteralNode methodsFor: 'testing' stamp: ''!
isImmediateNode
	^true! !

!RBLiteralNode methodsFor: 'accessing' stamp: 'PabloHerrero 1/5/2015 10:37'!
stop: anInteger
	stop := anInteger! !

!RBLiteralNode methodsFor: 'accessing' stamp: ''!
value
	^self subclassResponsibility! !

!RBLiteralNode methodsFor: 'comparing' stamp: 'lr 5/30/2010 11:34'!
= anObject 
	self == anObject ifTrue: [^true].
	^self class = anObject class! !

!RBLiteralNode methodsFor: 'testing' stamp: ''!
needsParenthesis
	^false! !

!RBLiteralNode methodsFor: 'accessing' stamp: 'PabloHerrero 1/5/2015 10:37'!
start: anInteger
	start := anInteger! !

!RBLiteralNode methodsFor: 'private-replacing' stamp: ''!
replaceSourceFrom: aNode 
	self addReplacement: (RBStringReplacement 
				replaceFrom: aNode start
				to: aNode stop
				with: self formattedCode)! !

!RBLiteralNode class methodsFor: 'instance creation' stamp: ''!
value: aValue 
	^((aValue class == Array or: [aValue class == ByteArray]) 
		ifTrue: [RBLiteralArrayNode]
		ifFalse: [RBLiteralValueNode]) value: aValue! !

!RBLiteralToken commentStamp: 'md 8/9/2005 14:52'!
RBLiteralToken is the first-class representation of a literal token (entire literals, even literal arrays, are a single token in the ST80 grammar.).

Instance Variables:
	stopPosition	<Integer>	The position within the source code where the token terminates.

!
!RBLiteralToken methodsFor: 'testing' stamp: ''!
isMultiKeyword
	^false! !

!RBLiteralToken methodsFor: 'testing' stamp: ''!
isLiteralToken
	^true! !

!RBLiteralToken methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	value isSymbol 
		ifTrue: 
			[aStream nextPut: $#.
			((RBScanner isSelector: value) and: [value ~~ #'||']) 
				ifTrue: [aStream nextPutAll: value]
				ifFalse: [value asString printOn: aStream].
			^self].
	value class == Character 
		ifTrue: 
			[aStream
				nextPut: $$;
				nextPut: value.
			^self].
	value storeOn: aStream! !

!RBLiteralToken methodsFor: 'private' stamp: ''!
length
	^stopPosition - self start + 1! !

!RBLiteralToken methodsFor: 'testing' stamp: 'PabloHerrero 10/25/2013 16:52'!
isNumberLiteralToken
	^false! !

!RBLiteralToken methodsFor: 'accessing' stamp: ''!
stop: anObject 
	stopPosition := anObject! !

!RBLiteralToken methodsFor: 'initialize-release' stamp: ''!
value: aString start: anInteger stop: stopInteger 
	value := aString.
	sourcePointer := anInteger.
	stopPosition := stopInteger! !

!RBLiteralToken methodsFor: 'accessing' stamp: ''!
realValue
	^value! !

!RBLiteralToken class methodsFor: 'instance creation' stamp: ''!
value: anObject 
	| literal |
	literal := anObject class == Array 
				ifTrue: [anObject collect: [:each | self value: each]]
				ifFalse: [anObject].
	^self 
		value: literal
		start: nil
		stop: nil! !

!RBLiteralToken class methodsFor: 'instance creation' stamp: ''!
value: aString start: anInteger stop: stopInteger 
	^(self new)
		value: aString
			start: anInteger
			stop: stopInteger;
		yourself! !

!RBLiteralValueNode commentStamp: '<historical>'!
RBLiteralNode is an AST node that represents literal values (e.g., #foo, true, 1, etc.), but not literal arrays.

Instance Variables
	value	<Numeric | Symbol | String  | Character>	the literal value I represent!
!RBLiteralValueNode methodsFor: 'accessing' stamp: 'PabloHerrero 2/16/2015 01:19'!
value
	^ value! !

!RBLiteralValueNode methodsFor: 'comparing' stamp: 'lr 5/30/2010 11:36'!
= anObject 
	^ super = anObject 
		and: [ self value = anObject value 
		and: [ self value species = anObject value species ] ]! !

!RBLiteralValueNode methodsFor: 'matching' stamp: 'PabloHerrero 10/24/2013 13:30'!
copyInContext: aDictionary
	^ self class value: self value! !

!RBLiteralValueNode methodsFor: '*SmartSuggestions' stamp: 'GiselaDecuzzi 5/15/2013 14:57'!
specialCommands 
	^ SugsSuggestionFactory commandsFoLiteralNode.! !

!RBLiteralValueNode methodsFor: 'initialize-release' stamp: 'PabloHerrero 2/16/2015 01:19'!
value: aValue start: aPosition stop: anotherPosition source: aString 

	self value: aValue start: aPosition stop: anotherPosition.
	sourceText := aString.! !

!RBLiteralValueNode methodsFor: 'accessing' stamp: 'PabloHerrero 2/16/2015 01:12'!
sourceText
	^ sourceText ifNil: [
		String streamContents: [:aStream|			
			value isSymbol
				ifTrue: [
					aStream nextPut: $#.
					((RBScanner isSelector: value) and: [value ~~ #'||']) 
						ifTrue: [aStream nextPutAll: value]
						ifFalse: [value asString printOn: aStream]]
				ifFalse: [ 
					value class == Character 
						ifTrue: 
							[aStream nextPut: $$;	nextPut: value]
						ifFalse: [ value storeOn: aStream ]]] ]! !

!RBLiteralValueNode methodsFor: 'testing' stamp: 'GiselaDecuzzi 6/5/2013 10:30'!
isFaulty
	^false.! !

!RBLiteralValueNode methodsFor: 'initialize-release' stamp: 'PabloHerrero 10/24/2013 14:09'!
value: aValue start: aPosition stop: anotherPosition

	value := aValue.
	start := aPosition. 
	stop := anotherPosition.! !

!RBLiteralValueNode methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:37'!
acceptVisitor: aProgramNodeVisitor 
	^aProgramNodeVisitor visitLiteralNode: self! !

!RBLiteralValueNode class methodsFor: 'instance creation' stamp: 'PabloHerrero 2/16/2015 01:20'!
value: aValue start: aPosition stop: anotherPosition 
 	^ self new
		value: aValue start: aPosition stop: anotherPosition;
		yourself.! !

!RBLiteralValueNode class methodsFor: 'instance creation' stamp: 'PabloHerrero 2/16/2015 01:23'!
value: aValue
	^ self value: aValue start: 0 stop: -1! !

!RBLiteralValueNode class methodsFor: 'instance creation' stamp: 'PabloHerrero 2/16/2015 01:20'!
value: aValue start: aPosition stop: anotherPosition  source: aString 
 	^ self new
		value: aValue start: aPosition stop: anotherPosition source: aString;
		yourself.! !

!RBLocalMethodsOfAClassNotInItsTraitComposition commentStamp: 'StephaneDucasse 11/29/2014 20:54'!
If a class has a method in its trait composition, the method should not be implemented in the class.!
!RBLocalMethodsOfAClassNotInItsTraitComposition methodsFor: 'accessing' stamp: 'SebastianTleye 7/19/2013 13:40'!
name
	^ 'Repeated methods in the trait composition'! !

!RBLocalMethodsOfAClassNotInItsTraitComposition methodsFor: 'accessing' stamp: 'MarcusDenker 11/11/2014 16:01'!
category 
    ^ 'Optimization'! !

!RBLocalMethodsOfAClassNotInItsTraitComposition methodsFor: 'running' stamp: 'NicolaiHess 2/9/2015 18:39'!
checkClass: aClass 
	
	"The comparison between methods is made using the ast, this is better than comparing source code only since it does not take into account identations, extra parenthesis, etc"
	
	| selectedClass |
	selectedClass := aClass.
	(selectedClass isTrait not and: [ selectedClass hasTraitComposition ]) ifTrue: [  
		selectedClass localMethods do: [ :method | |traitCompositionMethod |
			traitCompositionMethod := (selectedClass traitComposition methodDescriptionForSelector: method selector) effectiveMethod.
			traitCompositionMethod ifNotNil: [
				
				(traitCompositionMethod ast = method ast) 
					ifTrue: [ result addClass: selectedClass selector: method selector ]]]].! !

!RBLocalMethodsOfAClassNotInItsTraitComposition class methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 20:55'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'MethodInClassVsTrait'! !

!RBLongMethodsRule commentStamp: 'StephaneDucasse 11/29/2014 20:54'!
This smell arises when a long method is found (with 10 or more statements). Note that, it counts statements, not lines. Long methods should often be split into several smaller ones. 

Long methods should often be split into several smaller ones. When you start to need an empty line to separate groups of statements, this is an indication that you should probably define a new method. 
	
Do not forget that methods are points of extension in an object-oriented language. It means that each time you define a method, a subclass may override and extend it while taking advantage and reusing the calling context of your method. This is the basis for the Hook and Template Design Pattern and central to good object-oriented design. So keep your methods short. 

Use the extract method refactoring, which even checks whether the method you are extracting already exists in the class. 
	
The defined number of statements can be edited in #longMethodSize. In the future such rule should hold state and not be based on method redefinition for its customization. !
!RBLongMethodsRule methodsFor: 'initialization' stamp: 'lr 11/2/2009 00:14'!
initialize
	super initialize.
	matcher := RBParseTreeSearcher new.
	matcher matches: '`.Stmt'
		do: 
			[:aNode :answer | 
			(aNode children inject: answer
				into: [:sum :each | matcher executeTree: each initialAnswer: sum]) + 1].! !

!RBLongMethodsRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 10:23'!
category
	^ 'Design Flaws'! !

!RBLongMethodsRule methodsFor: 'accessing' stamp: 'SeanDeNigris 1/31/2013 09:17'!
rationale
	^ 'Returns all methods that have #longMethodSize number of statements. This check counts statements, not lines.'! !

!RBLongMethodsRule methodsFor: 'private' stamp: 'CamilleTeruel 3/29/2013 17:44'!
longMethodSize
	^ 20! !

!RBLongMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Miscellaneous'! !

!RBLongMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Long methods'! !

!RBLongMethodsRule methodsFor: 'running' stamp: 'MarcusDenker 10/27/2014 17:58'!
checkMethod: aMethod 
	(matcher executeTree: aMethod ast initialAnswer: 0) >= self longMethodSize 
		ifTrue: [ result addMethod: aMethod ]! !

!RBLongMethodsRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'LongMethodsRule'! !

!RBMessageNode commentStamp: '<historical>'!
RBMessageNode is an AST node that represents a message send.

Instance Variables:
	arguments	<SequenceableCollection of: RBValueNode>	our argument nodes
	receiver	<RBValueNode>	the receiver's node
	selector	<Symbol>	the selector we're sending
	keywordsPositions	<IntegerArray | nil>	the positions of the selector keywords

!
!RBMessageNode methodsFor: '*opalcompiler-core' stamp: 'MarcusDenker 1/12/2015 12:16'!
isInlineWhile
	
	self methodNode compilationContext optionInlineWhile ifFalse: [ ^false ]. 
	self isCascaded ifTrue: [^ false].
	(#(whileFalse: whileTrue: whileFalse whileTrue) includes: self selector) ifFalse: [^ false].
	self receiver isBlock ifFalse: [^ false].
	self receiver arguments isEmpty ifFalse: [self notify: 'while receiver block must have no arguments'. ^ false].
	self arguments isEmpty ifFalse: [
		self arguments first isBlock ifFalse: [^ false].
		self arguments first arguments isEmpty ifFalse: [^ false].
	].
	^ true! !

!RBMessageNode methodsFor: 'testing' stamp: ''!
isMessage
	^true! !

!RBMessageNode methodsFor: '*opalcompiler-core' stamp: 'MarcusDenker 1/9/2015 15:36'!
isInlineAndOr
	self methodNode compilationContext optionInlineAndOr ifFalse: [ ^false ]. 
	self receiver isBlock ifTrue: [^ false].
	self isCascaded ifTrue: [^ false].
	(#(and: or:) includes: self selector) ifFalse: [^ false].
	(self arguments allSatisfy: [ :each | each isBlock ])  ifFalse: [^ false].
	(self arguments allSatisfy: [ :each | each arguments isEmpty ]) ifFalse: [^ false ].
	^ true! !

!RBMessageNode methodsFor: '*SmartSuggestions' stamp: 'GiselaDecuzzi 4/19/2013 10:08'!
specialCommands
	^ SugsSuggestionFactory commandsForMessage! !

!RBMessageNode methodsFor: 'testing' stamp: 'PabloHerrero 10/14/2013 23:24'!
isKeyword
	^(selector indexOf: $:) ~= 0.! !

!RBMessageNode methodsFor: 'testing' stamp: ''!
isBinary
	^(self isUnary or: [self isKeyword]) not! !

!RBMessageNode methodsFor: 'accessing' stamp: ''!
children
	^(OrderedCollection with: self receiver)
		addAll: self arguments;
		yourself! !

!RBMessageNode methodsFor: 'private-replacing' stamp: ''!
replaceSourceWith: aNode 
	(self isContainmentReplacement: aNode) 
		ifTrue: [^self replaceContainmentSourceWith: aNode].
	aNode isMessage ifFalse: [^super replaceSourceWith: aNode].
	^self replaceSourceWithMessageNode: aNode! !

!RBMessageNode methodsFor: 'querying' stamp: 'PabloHerrero 10/21/2013 17:45'!
bestNodeFor: anInterval 
	(self intersectsInterval: anInterval) ifFalse: [^nil].
	(self containedBy: anInterval) ifTrue: [^self].
	self keywordsIntervals do:
			[:each | 
			((each rangeIncludes: anInterval first) 
				or: [anInterval rangeIncludes:  each first]) 
					ifTrue: [^self]].
	self children do: 
			[:each | 
			| node |
			node := each bestNodeFor: anInterval.
			node notNil ifTrue: [^node]]! !

!RBMessageNode methodsFor: 'accessing' stamp: 'PabloHerrero 10/16/2013 22:53'!
keywordsPositions: aPositionsList
	keywordsPositions := aPositionsList ifNotNil: [:list| list asIntegerArray ].! !

!RBMessageNode methodsFor: 'accessing' stamp: 'PabloHerrero 10/28/2013 17:02'!
keywordsPositions
	^keywordsPositions ifNil: [ (selector keywords collect: [:char| 0 ]) asIntegerArray ]! !

!RBMessageNode methodsFor: '*opalcompiler-core' stamp: 'MarcusDenker 1/12/2015 12:16'!
isInlineToDo

	| block step |
	self methodNode compilationContext optionInlineToDo ifFalse: [ ^false ]. 

	self receiver isBlock ifTrue: [^ false].
	self isCascaded ifTrue: [^ false].
	(#(to:do: to:by:do:) includes: self selector) ifFalse: [^ false].
	block := self arguments last.
	block isBlock ifFalse: [^ false].
	block arguments size = 1 ifFalse: [^ false].
	self arguments first isVariable ifTrue: [ 
		(RBParseTreeSearcher new
			matches: self arguments first name , ' := `@object' do: [:n :a | true];
			executeTree: block initialAnswer: false) ifTrue: [^ false].
	].
	self arguments size = 3 "to:by:do:" ifTrue: [
		step := self arguments second.
		step isLiteralNode ifFalse: [^ false].
		step value = 0 ifTrue: [^ false].
	].
	^ true! !

!RBMessageNode methodsFor: '*opalcompiler-core' stamp: 'MarcusDenker 1/12/2015 12:16'!
isInlineTimesRepeat

	| block |
	self methodNode compilationContext optionInlineTimesRepeat ifFalse: [ ^false ]. 

	self receiver isBlock ifTrue: [^ false].
	self isCascaded ifTrue: [^ false].
	#timesRepeat: = self selector ifFalse: [^ false].
	block := self arguments last.
	block isBlock ifFalse: [^ false].
	block arguments size isZero ifFalse: [^ false].
	^ true! !

!RBMessageNode methodsFor: 'accessing' stamp: ''!
renameSelector: newSelector andArguments: varNodeCollection 
	self
		arguments: varNodeCollection;
		selector: newSelector! !

!RBMessageNode methodsFor: 'accessing' stamp: 'lr 5/30/2010 14:21'!
sentMessages
	^ super sentMessages
		add: self selector;
		yourself! !

!RBMessageNode methodsFor: 'accessing' stamp: 'PabloHerrero 10/22/2013 14:56'!
debugHighlightStart

	^ self  keywordsPositions first! !

!RBMessageNode methodsFor: 'accessing' stamp: ''!
precedence
	^self isUnary 
		ifTrue: [1]
		ifFalse: [self isKeyword ifTrue: [3] ifFalse: [2]]! !

!RBMessageNode methodsFor: 'accessing' stamp: ''!
receiver: aValueNode 
	receiver := aValueNode.
	receiver parent: self! !

!RBMessageNode methodsFor: 'replacing' stamp: ''!
replaceNode: aNode withNode: anotherNode 
	"If we're inside a cascade node and are changing the receiver, change all the receivers"

	receiver == aNode 
		ifTrue: 
			[self receiver: anotherNode.
			(parent notNil and: [parent isCascade]) 
				ifTrue: [parent messages do: [:each | each receiver: anotherNode]]].
	self arguments: (arguments 
				collect: [:each | each == aNode ifTrue: [anotherNode] ifFalse: [each]])! !

!RBMessageNode methodsFor: '*opalcompiler-core' stamp: 'MarcusDenker 7/22/2013 16:03'!
isInlineIf
	self methodNode compilationContext optionInlineIf ifFalse: [ ^false ]. 
	self receiver isBlock ifTrue: [^ false].
	self isCascaded ifTrue: [^ false].
	(#(ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue:) includes: self selector) ifFalse: [^ false].
	self arguments do: [:node | node isBlock ifFalse: [^ false]].
	self arguments do: [:block |
		block arguments isEmpty ifFalse: [
			OCSemanticError new
				node: self;
				compilationContext: self methodNode compilationContext;
				messageText: 'ifTrue:ifFalse: takes zero-arg blocks';
				signal.
			^ false
		]
	].
	^ true! !

!RBMessageNode methodsFor: 'accessing' stamp: 'PabloHerrero 3/7/2015 21:02'!
selector: aSelector
	keywordsPositions := nil.
	selector := aSelector asSymbol.! !

!RBMessageNode methodsFor: 'private-replacing' stamp: ''!
replaceContainmentSourceWith: aNode 
	| originalNode needsParenthesis |
	needsParenthesis := aNode hasParentheses not and: [aNode needsParenthesis].
	originalNode := (self mappingFor: self receiver) = aNode 
				ifTrue: [self receiver]
				ifFalse: [self arguments detect: [:each | (self mappingFor: each) = aNode]].
	self
		addReplacement: (RBStringReplacement 
					replaceFrom: self start
					to: originalNode start - 1
					with: (needsParenthesis ifTrue: ['('] ifFalse: ['']));
		addReplacement: (RBStringReplacement 
					replaceFrom: originalNode stop + 1
					to: self stop
					with: (needsParenthesis ifTrue: [')'] ifFalse: ['']))! !

!RBMessageNode methodsFor: 'initialize-release' stamp: 'PabloHerrero 2/16/2015 00:44'!
receiver: aValueNode selector: aSelector keywordsPositions: positionList arguments: valueNodes
	aSelector numArgs == valueNodes size
		ifFalse: 
			[self error: 'Attempting to assign selector with wrong number of arguments.'].

	self 
		receiver: aValueNode;
		arguments: valueNodes;
		selector: aSelector;
		keywordsPositions: positionList.! !

!RBMessageNode methodsFor: '*opalcompiler-core' stamp: 'MarcusDenker 1/12/2015 12:17'!
isInlineCase
	self methodNode compilationContext optionInlineCase ifFalse: [ ^false ]. 
	self isCascaded ifTrue: [^ false].
	(#(caseOf: caseOf:otherwise:) includes: self selector) ifFalse: [^ false].
	self arguments size = 2 ifTrue: [  "otherwise block"
		self arguments last isBlock ifFalse: [^ false]].
	self arguments first isArray ifFalse: [^ false].
	self arguments first statements do: [:assoc |
		(assoc isMessage and: [assoc selector == #->]) ifFalse: [^ false].
		assoc receiver isBlock ifFalse: [^ false].
		assoc receiver arguments isEmpty ifFalse: [^ false].
		assoc arguments first isBlock ifFalse: [^ false].
	].
	^ true! !

!RBMessageNode methodsFor: 'copying' stamp: 'lr 11/1/2009 22:36'!
postCopy
	super postCopy.
	self receiver: self receiver copy.
	self arguments: (self arguments collect: [ :each | each copy ])! !

!RBMessageNode methodsFor: 'testing' stamp: 'lr 10/20/2009 11:43'!
isSelfSend
	^ self receiver isVariable and: [ self receiver name = 'self' ]! !

!RBMessageNode methodsFor: 'matching' stamp: 'BernardoContreras 8/25/2014 20:29'!
match: aNode inContext: aDictionary 
	aNode class = self class ifFalse: [^false].
	self selector = aNode selector ifFalse: [^false].
	(receiver match: aNode receiver inContext: aDictionary) ifFalse: [^false].
	self arguments
		with: aNode arguments
		do: [:first :second | (first match: second inContext: aDictionary) ifFalse: [^false]].
	^true! !

!RBMessageNode methodsFor: '*OpalDecompiler' stamp: 'ClementBera 7/10/2014 13:30'!
ifNilReceiver
	^ receiver! !

!RBMessageNode methodsFor: 'testing' stamp: 'ClementBera 7/26/2013 17:16'!
needsParenthesis
	^parent 
		ifNil: [false]
		ifNotNil: 
			[self precedence > parent precedence 
				or: [self precedence = parent precedence and: [self isUnary not]]]! !

!RBMessageNode methodsFor: 'testing' stamp: ''!
isUnary
	^arguments isEmpty! !

!RBMessageNode methodsFor: '*OpalDecompiler' stamp: 'ClementBera 8/1/2014 09:40'!
toDoFromWhileWithInit: initStmt
	"Return nil, or a to:do: expression equivalent to this whileTrue:"
	| variable increment limit toDoBlock body test  |
	(selector == #whileTrue:
	 and: [initStmt isAssignment
	 and: [initStmt variable isMemberOf: RBTemporaryNode]]) ifFalse:
		[^nil].
	body := arguments last statements.
	variable := initStmt variable.
	increment := body last toDoIncrement: variable.
	(increment == nil
	 or: [receiver statements size ~= 1]) ifTrue:
		[^nil].
	test := receiver statements first.
	"Note: test chould really be checked that <= or >= comparison
	jibes with the sign of the (constant) increment"
	(test isMessage
	 and: [(limit := test toDoLimit: variable) notNil]) ifFalse:
		[^nil].
	"The block must not overwrite the limit"
	(limit isVariable and: [body anySatisfy: [:e | e isAssignment and: [e variable = limit]]])
		ifTrue: [^nil]. 
	toDoBlock := RBBlockNode body: (RBSequenceNode statements: body allButLast).
	toDoBlock arguments: (Array with: variable).
	variable propertyAt: #hidden put: true.
	increment value = 1 ifTrue: [
		^ RBMessageNode 
			receiver: initStmt value
			selector: #to:do:
			arguments: (Array with: limit with: toDoBlock)].
	^ RBMessageNode 
		receiver: initStmt value
		selector: #to:by:do:
		arguments: (Array with: limit with: increment with: toDoBlock)! !

!RBMessageNode methodsFor: 'accessing' stamp: 'PabloHerrero 10/17/2013 15:40'!
selector
	^ selector.! !

!RBMessageNode methodsFor: 'accessing' stamp: 'PabloHerrero 10/21/2013 17:51'!
stopWithoutParentheses
	^arguments isEmpty 
		ifTrue: [self keywordsIntervals first last]
		ifFalse: [arguments last stop]! !

!RBMessageNode methodsFor: '*OpalDecompiler' stamp: 'cb 7/29/2014 18:24'!
toDoIncrement: variable
	(receiver = variable and: [selector = #+]) 
		ifFalse: [^ nil].
	(arguments first isLiteralNode and: [ arguments first value isInteger ])
		ifTrue: [^ arguments first]
		ifFalse: [^ nil]! !

!RBMessageNode methodsFor: '*OpalDecompiler' stamp: 'ClementBera 8/1/2014 09:40'!
toDoLimit: variable
	(receiver = variable and: [selector == #<= or: [selector == #>= ]]) 
		ifTrue: [ ^ arguments first ]
		ifFalse: [ ^ nil ]! !

!RBMessageNode methodsFor: 'testing' stamp: 'GiselaDecuzzi 6/5/2013 10:30'!
isFaulty
	^self receiver isFaulty or: [self arguments anySatisfy: #isFaulty]! !

!RBMessageNode methodsFor: 'private-replacing' stamp: ''!
isContainmentReplacement: aNode 
	^(self mappingFor: self receiver) = aNode 
		or: [self arguments anySatisfy: [:each | (self mappingFor: each) = aNode]]! !

!RBMessageNode methodsFor: 'testing' stamp: ''!
isCascaded
	^parent notNil and: [parent isCascade]! !

!RBMessageNode methodsFor: 'testing' stamp: 'lr 10/20/2009 11:43'!
isSuperSend
	^ self receiver isVariable and: [ self receiver name = 'super' ]! !

!RBMessageNode methodsFor: 'accessing' stamp: 'jorgeRessia 11/20/2009 16:40'!
debugHighlightStop

	^ self stopWithoutParentheses! !

!RBMessageNode methodsFor: '*opalcompiler-core' stamp: 'MarcusDenker 1/12/2015 12:17'!
isInlineIfNil

	| assertNone assertOneOrNone |
	
	self methodNode compilationContext optionInlineIfNil ifFalse: [ ^false ]. 
	self receiver isBlock ifTrue: [^ false].
	self isCascaded ifTrue: [^ false].
	(#(ifNil: ifNotNil: ifNil:ifNotNil: ifNotNil:ifNil:) includes: self selector) ifFalse: [^ false].
	self arguments do: [:node | node isBlock ifFalse: [^ false]].
	assertNone := [:block | 
		block arguments isEmpty ifFalse: [^ false]
	].
	assertOneOrNone := [:block | 
		block arguments size > 1 ifTrue: [^ false]
	].
	self selector == #ifNil: 	
		ifTrue: [assertNone value: self arguments first].
	self selector == #ifNil:ifNotNil: 
		ifTrue: [assertNone value: self arguments first.  assertOneOrNone value: self arguments last].
	self selector == #ifNotNil: 
		ifTrue: [assertOneOrNone value: self arguments first].
	self selector == #ifNotNil:ifNil: 
		ifTrue: [assertOneOrNone value: self arguments first. assertNone value: self arguments last].
	^ true! !

!RBMessageNode methodsFor: 'testing' stamp: 'lr 12/4/2011 16:30'!
lastIsReturn
	^ (#(#ifTrue:ifFalse: #ifFalse:ifTrue: #ifNil:ifNotNil: #ifNotNil:ifNil:) includes: self selector)
		and: [ arguments first isBlock and: [ arguments first body lastIsReturn 
		and: [ arguments last isBlock and: [ arguments last body lastIsReturn ] ] ] ]! !

!RBMessageNode methodsFor: 'comparing' stamp: 'lr 3/7/2010 13:50'!
hash
	^ (self receiver hash bitXor: self selector hash) bitXor: (self hashForCollection: self arguments)! !

!RBMessageNode methodsFor: 'matching' stamp: 'PabloHerrero 10/15/2013 00:08'!
copyInContext: aDictionary 
	^self class
		receiver: (self receiver copyInContext: aDictionary)
		selector: self selector
		arguments: (self arguments collect: [ :each | each copyInContext: aDictionary ]).! !

!RBMessageNode methodsFor: 'accessing' stamp: ''!
startWithoutParentheses
	^receiver start! !

!RBMessageNode methodsFor: 'accessing' stamp: ''!
receiver
	^receiver! !

!RBMessageNode methodsFor: 'comparing' stamp: 'BernardoContreras 8/25/2014 20:23'!
equalTo: anObject withMapping: aDictionary 
	self class = anObject class ifFalse: [^false].
	((self receiver equalTo: anObject receiver withMapping: aDictionary)
		and: [self selector = anObject selector]) ifFalse: [^false].
	self arguments
		with: anObject arguments
		do: [:first :second | (first equalTo: second withMapping: aDictionary) ifFalse: [^false]].
	^true! !

!RBMessageNode methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:37'!
acceptVisitor: aProgramNodeVisitor 
	^aProgramNodeVisitor visitMessageNode: self! !

!RBMessageNode methodsFor: 'accessing' stamp: ''!
arguments: argCollection 
	arguments := argCollection.
	arguments do: [:each | each parent: self]! !

!RBMessageNode methodsFor: 'accessing' stamp: 'PabloHerrero 1/5/2015 12:42'!
keywords
	^ selector keywords.! !

!RBMessageNode methodsFor: 'comparing' stamp: 'BernardoContreras 8/25/2014 20:22'!
= anObject 
	self == anObject ifTrue: [^true].
	self class = anObject class ifFalse: [^false].
	(self receiver = anObject receiver 
		and: [self selector = anObject selector]) ifFalse: [^false].
	self arguments
		with: anObject arguments
		do: [:first :second | first = second ifFalse: [^false]].
	^true! !

!RBMessageNode methodsFor: 'private-replacing' stamp: 'PabloHerrero 10/22/2013 14:02'!
replaceSourceWithMessageNode: aNode 
	| isBinaryToKeyword newSelectorParts  oldkeywordsIntervals|
	self numArgs = aNode numArgs ifFalse: [^super replaceSourceWith: aNode].
	self arguments with: aNode arguments
		do: [:old :new | (self mappingFor: old) = new ifFalse: [^super replaceSourceWith: aNode]].
	(self mappingFor: self receiver) = aNode receiver 
		ifFalse:
			[(self receiver isVariable and: [aNode receiver isVariable])
				ifFalse:
					[^super replaceSourceWith: aNode].
			self addReplacement:
				(RBStringReplacement
					replaceFrom: self receiver start
					to: self receiver stop
					with: aNode receiver name)].
	(isBinaryToKeyword := self isBinary and: [aNode isKeyword]) 
		ifTrue: 
			[(self hasParentheses not and: [self parent precedence <= aNode precedence]) 
				ifTrue: 
					[self
						addReplacement: (RBStringReplacement 
									replaceFrom: self start
									to: self start - 1
									with: '(');
						addReplacement: (RBStringReplacement 
									replaceFrom: self stop + 1
									to: self stop
									with: ')')]].
							
	newSelectorParts := aNode selectorParts.
	oldkeywordsIntervals := self keywordsIntervals.
	
	self selectorParts keysAndValuesDo: [:index :oldPart| 
			(newSelectorParts at: index) ~= oldPart
				ifTrue: 
					[self addReplacement: (RBStringReplacement 
								replaceFrom: (oldkeywordsIntervals at: index) first
								to: (oldkeywordsIntervals at: index) last
								with: ((isBinaryToKeyword 
										and: [(self source at: (oldkeywordsIntervals at: index) first - 1) isSeparator not]) 
											ifTrue: [' ' , newSelectorParts at: index]
											ifFalse: [newSelectorParts at: index]))]].! !

!RBMessageNode methodsFor: 'accessing' stamp: ''!
numArgs
	^self selector numArgs! !

!RBMessageNode methodsFor: 'accessing' stamp: 'PabloHerrero 1/5/2015 11:36'!
keywordsIntervals
	^ selector keywords
		with: self keywordsPositions 
		collect: [ :keyword :start | start to: (start == 0 ifTrue: [ -1 ] ifFalse: [ start + keyword size - 1]) ].! !

!RBMessageNode methodsFor: '*opalcompiler-core' stamp: 'ClementBera 1/6/2015 11:08'!
isInlined 
	self methodNode compilationContext optionInlineNone ifTrue: [ ^false ]. 
	self isInlineIf ifTrue: [^true].
	self isInlineIfNil  ifTrue: [^true]. 
	self isInlineAndOr  ifTrue: [^true].
	self isInlineWhile ifTrue: [^true].
	self isInlineToDo  ifTrue: [^true].
	self isInlineCase  ifTrue: [^true].
	self isInlineTimesRepeat ifTrue: [ ^true].
	^false.! !

!RBMessageNode methodsFor: 'accessing' stamp: 'PabloHerrero 1/5/2015 12:42'!
selectorParts
	^ self keywords collect: #asSymbol.! !

!RBMessageNode methodsFor: 'accessing' stamp: 'ClementBera 7/26/2013 17:15'!
arguments
	^arguments ifNil: [#()] ifNotNil: [arguments]! !

!RBMessageNode methodsFor: 'testing' stamp: ''!
isFirstCascaded
	^self isCascaded and: [parent messages first == self]! !

!RBMessageNode class methodsFor: 'instance creation' stamp: 'PabloHerrero 2/16/2015 00:44'!
receiver: aValueNode selector: aSelector 
	^self 
		receiver: aValueNode
		selector: aSelector
		arguments: #()! !

!RBMessageNode class methodsFor: 'instance creation' stamp: 'PabloHerrero 2/16/2015 00:44'!
receiver: aValueNode selector: aSelector arguments: valueNodes 
	^self
		receiver: aValueNode
		selector: aSelector
		keywordsPositions: nil
		arguments: valueNodes.! !

!RBMessageNode class methodsFor: 'instance creation' stamp: 'PabloHerrero 2/16/2015 00:44'!
receiver: aValueNode selector: aSelector keywordsPositions: positionList arguments: valueNodes
	^(self new)
		receiver: aValueNode
			selector: aSelector
			keywordsPositions: positionList 
			arguments: valueNodes;
		yourself.! !

!RBMessageNode class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:00'!
gtExampleAddition
	<gtExample>
	^ RBMessageNode 
				receiver: (RBVariableNode named: 'self')
				selector: #+
				arguments: (Array with: (RBLiteralNode value: 0))! !

!RBMetaclass methodsFor: 'accessing' stamp: 'lr 10/26/2009 22:08'!
allClassVariableNames
	^ self theNonMetaClass allClassVariableNames! !

!RBMetaclass methodsFor: 'accessing' stamp: 'lr 10/26/2009 22:08'!
allPoolDictionaryNames
	^ self theNonMetaClass allPoolDictionaryNames! !

!RBMetaclass methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	super storeOn: aStream.
	aStream nextPutAll: ' class'! !

!RBMetaclass methodsFor: 'testing' stamp: ''!
isMeta
	^true! !

!RBMetaclass methodsFor: 'initialize-release' stamp: 'lr 7/23/2010 08:03'!
realName: aSymbol 
	self realClass: (Smalltalk globals at: aSymbol) classSide! !

!RBMetaclass methodsFor: 'printing' stamp: ''!
printOn: aStream
	super printOn: aStream.
	aStream nextPutAll: ' class'! !

!RBMetaclass methodsFor: 'accessing' stamp: 'lr 10/26/2009 22:09'!
theMetaClass
	^ self! !

!RBMetaclass methodsFor: 'testing' stamp: 'lr 10/26/2009 22:08'!
directlyDefinesClassVariable: aString 
	^ self theNonMetaClass directlyDefinesClassVariable: aString! !

!RBMetaclass methodsFor: 'testing' stamp: 'lr 10/26/2009 22:08'!
directlyDefinesPoolDictionary: aString 
	^ self theNonMetaClass directlyDefinesPoolDictionary: aString! !

!RBMetaclass class methodsFor: 'instance creation' stamp: ''!
existingNamed: aSymbol 
	^(self named: aSymbol)
		realName: aSymbol;
		yourself! !

!RBMetaclass class methodsFor: 'instance creation' stamp: ''!
named: aSymbol 
	^(self new)
		name: aSymbol;
		yourself! !

!RBMethod methodsFor: 'accessing' stamp: ''!
method: aCompiledMethod 
	compiledMethod := aCompiledMethod! !

!RBMethod methodsFor: 'accessing' stamp: ''!
selector
	^selector! !

!RBMethod methodsFor: 'accessing' stamp: ''!
parseTree
	^RBParser parseMethod: self source onError: [:str :pos | ^nil]! !

!RBMethod methodsFor: 'private' stamp: 'lr 1/3/2010 11:47'!
literal: anObject containsReferenceTo: aSymbol
	anObject = aSymbol
		ifTrue: [ ^ true ].
	anObject class = Array
		ifFalse: [ ^ false ].
	^ anObject anySatisfy: [ :each | self literal: each containsReferenceTo: aSymbol ]! !

!RBMethod methodsFor: 'accessing' stamp: 'MarkRizun 7/25/2014 09:50'!
ast
	^ self parseTree! !

!RBMethod methodsFor: 'accessing' stamp: ''!
method
	^compiledMethod! !

!RBMethod methodsFor: 'compiling' stamp: 'lr 11/1/2009 23:53'!
compileTree: aBRMethodNode
	| method sourceCode change |
	sourceCode := aBRMethodNode newSource.
	change := self modelClass model
		compile: sourceCode
		in: self modelClass
		classified: self protocols.
	method := self class
		for: self modelClass
		source: sourceCode
		selector: aBRMethodNode selector.
	self modelClass addMethod: method.
	^ change! !

!RBMethod methodsFor: 'accessing' stamp: ''!
selector: aSymbol 
	selector := aSymbol! !

!RBMethod methodsFor: 'testing' stamp: 'lr 11/2/2009 00:14'!
refersToClassNamed: aSymbol 
	| searcher |
	searcher := RBParseTreeSearcher new.
	searcher matches: aSymbol asString do: [:node :answer | true].
	^(searcher executeTree: self parseTree initialAnswer: false) 
		or: [self refersToSymbol: aSymbol]! !

!RBMethod methodsFor: 'accessing' stamp: 'lr 11/1/2009 23:15'!
protocols
	^ self modelClass protocolsFor: self selector! !

!RBMethod methodsFor: 'accessing' stamp: 'lr 11/1/2009 23:15'!
source
	^ source ifNil: [ source := (class realClass sourceCodeAt: selector) asString ]! !

!RBMethod methodsFor: 'printing' stamp: ''!
printOn: aStream 
	class printOn: aStream.
	aStream
		nextPutAll: '>>';
		nextPutAll: self selector! !

!RBMethod methodsFor: 'testing' stamp: 'lr 11/2/2009 00:14'!
refersToVariable: aString 
	| searcher tree |
	tree := self parseTree.
	((tree defines: aString) or: [tree body defines: aString]) 
		ifTrue: [^false].
	searcher := RBParseTreeSearcher new.
	searcher
		matches: aString do: [:node :answer | true];
		matches: '[:`@vars | | `@temps | `@.Stmts]'
			do: 
				[:node :answer | 
				answer or: 
						[((node defines: aString) or: [node body defines: aString]) not 
							and: [searcher executeTree: node body initialAnswer: false]]].
	^searcher executeTree: self parseTree initialAnswer: false! !

!RBMethod methodsFor: 'accessing' stamp: ''!
modelClass
	^class! !

!RBMethod methodsFor: 'accessing' stamp: ''!
source: aString 
	source := aString! !

!RBMethod methodsFor: 'testing' stamp: 'lr 11/2/2009 00:14'!
refersToSymbol: aSymbol 
	| searcher |
	searcher := RBParseTreeSearcher new.
	searcher
		matches: aSymbol printString do: [:node :answer | true];
		matches: '`#literal'
			do: [:node :answer | answer or: [self literal: node value containsReferenceTo: aSymbol]].
	(RBScanner isSelector: aSymbol) 
		ifTrue: 
			[searcher 
				matches: '`@object ' , (RBParseTreeSearcher buildSelectorString: aSymbol)
				do: [:node :answer | true]].
	^searcher executeTree: self parseTree initialAnswer: false! !

!RBMethod methodsFor: 'accessing' stamp: ''!
modelClass: aRBClass
	class := aRBClass! !

!RBMethod class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:09'!
gtExampleThisMethod
	<gtExample: 'This method'>
	^ RBMethod class>>#gtExampleThisMethod! !

!RBMethod class methodsFor: 'instance creation' stamp: ''!
for: aRBClass source: aString selector: aSelector 
	^(self new)
		modelClass: aRBClass;
		selector: aSelector;
		source: aString;
		yourself! !

!RBMethod class methodsFor: 'instance creation' stamp: ''!
for: aRBClass fromMethod: aCompiledMethod andSelector: aSymbol 
	^(self new)
		modelClass: aRBClass;
		method: aCompiledMethod;
		selector: aSymbol;
		yourself! !

!RBMethodHasNoTimeStampRule commentStamp: 'StephaneDucasse 11/29/2014 20:53'!
For proper versioning, every method should have a timestamp.!
!RBMethodHasNoTimeStampRule methodsFor: 'accessing' stamp: 'lr 3/17/2010 17:54'!
group
	^ 'Pharo bugs'! !

!RBMethodHasNoTimeStampRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:11'!
severity
	^ #error! !

!RBMethodHasNoTimeStampRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Method has no timeStamp'! !

!RBMethodHasNoTimeStampRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 16:59'!
checkMethod: aMethod 
	aMethod timeStamp isEmpty ifTrue: 
		[ result addMethod: aMethod ]! !

!RBMethodHasNoTimeStampRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 10:24'!
category
	^ 'Bugs' ! !

!RBMethodHasNoTimeStampRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'MethodHasNoTimeStampRule'! !

!RBMethodName methodsFor: 'accessing' stamp: ''!
selector
	^selector! !

!RBMethodName methodsFor: 'accessing' stamp: ''!
arguments
	^arguments! !

!RBMethodName methodsFor: 'testing' stamp: 'lr 6/15/2010 10:26'!
isValid
	^ (RBCondition checkMethodName: self selector in: self class) 
		and: [ self selector numArgs = self arguments size ]! !

!RBMethodName methodsFor: 'accessing' stamp: ''!
arguments: nameCollection 
	arguments := nameCollection.
	self changed: #arguments! !

!RBMethodName methodsFor: 'accessing' stamp: 'lr 6/15/2010 10:25'!
selector: aSymbol 
	selector := aSymbol asSymbol.
	self changed: #selector! !

!RBMethodName methodsFor: 'printing' stamp: 'lr 6/15/2010 10:25'!
printOn: aStream
	| argumentStream |
	self isValid
		ifFalse: [ ^ aStream nextPutAll: '(invalid)' ].
	argumentStream := self arguments readStream.
	self selector keywords keysAndValuesDo: [ :key :part |
		key = 1 ifFalse: [ aStream space ].
		aStream nextPutAll: part.
		(self selector isUnary or: [ argumentStream atEnd ]) 
			ifTrue: [ ^ self ].
		aStream space; nextPutAll: argumentStream next ]! !

!RBMethodName class methodsFor: 'instance creation' stamp: ''!
selector: aSymbol arguments: stringCollection 
	^(self new)
		selector: aSymbol;
		arguments: stringCollection;
		yourself! !

!RBMethodNode commentStamp: '<historical>'!
RBMethodNode is the AST that represents a Smalltalk method.

Instance Variables:
	arguments	<SequenceableCollection of: RBVariableNode>	the arguments to the method
	body	<BRSequenceNode>	the body/statements of the method
	nodeReplacements	<Dictionary>	a dictionary of oldNode -> newNode replacements
	replacements	<Collection of: RBStringReplacement>	the collection of string replacements for each node replacement in the parse tree
	selector	<Symbol>	the method name
	keywordsPositions	<IntegerArray | nil>	the positions of the selector keywords
	source	<String>	the source we compiled
	tags	<Collection of: Interval>	the source location of any resource/primitive tags

!
!RBMethodNode methodsFor: 'testing' stamp: 'CamilloBruni 12/15/2011 16:32'!
hasTemporaryNamed: aString	
	^ self temporaries anySatisfy: [ :temp| temp name = aString ]! !

!RBMethodNode methodsFor: 'accessing' stamp: 'lr 11/1/2009 19:57'!
children
	^ OrderedCollection new
		addAll: self arguments;
		addAll: self pragmas;
		add: self body;
		yourself! !

!RBMethodNode methodsFor: 'testing' stamp: 'BenComan 1/28/2015 00:06'!
pragmaNamed: aSymbol ifPresent: foundBlock
	^ self pragmas 
		detect: [ :pragma| pragma selector = aSymbol ]
		ifFound: foundBlock! !

!RBMethodNode methodsFor: 'replacing' stamp: ''!
clearReplacements
	replacements := nil! !

!RBMethodNode methodsFor: 'initialization' stamp: ''!
initialize
	replacements := SortedCollection sortBlock: 
					[:a :b | 
					a startPosition < b startPosition 
						or: [a startPosition = b startPosition and: [a stopPosition < b stopPosition]]].
	nodeReplacements := IdentityDictionary new! !

!RBMethodNode methodsFor: '*OpalCompiler-Core' stamp: 'JorgeRessia 11/24/2009 18:56'!
properties: aMethodeProperties 
	^self propertyAt: #methodProperties put: aMethodeProperties! !

!RBMethodNode methodsFor: 'private' stamp: 'TestRunner 12/23/2009 21:13'!
reformatSource
	| stream newSource newTree |
	stream := WriteStream on: (String new: source size + 100).
	stream
		nextPutAll: (source
			copyFrom: (replacements
				inject: 1
				into: [ :sum :each | 
					stream
						nextPutAll: (source copyFrom: sum to: each startPosition - 1);
						nextPutAll: (each string).
					each stopPosition + 1 ])
			to: source size).
	newSource := stream contents.
	newTree := RBParser 
		parseMethod: newSource 
		onError: [ :msg :pos | ^ self formattedCode ].
	self = newTree
		ifFalse: [ ^ self formattedCode ].
	^ newSource! !

!RBMethodNode methodsFor: '*OpalCompiler-Core' stamp: 'JorgeRessia 11/24/2009 19:05'!
ir: aIRMethodNode

	^ self propertyAt: #ir put: aIRMethodNode.! !

!RBMethodNode methodsFor: 'accessing' stamp: 'PabloHerrero 10/22/2013 09:48'!
renameSelector: newSelector andArguments: varNodeCollection 
	| oldIntervals oldArguments oldSelector |
	oldSelector := selector.
	oldIntervals := self keywordsIntervals.
	oldArguments := arguments.
	self
		arguments: varNodeCollection;
		selector: newSelector.
	self changeSourceSelector: oldSelector keywordsIntervals: oldIntervals arguments: oldArguments! !

!RBMethodNode methodsFor: '*OpalCompiler-Core' stamp: 'ClementBera 7/26/2013 15:25'!
decompileString 

	^ self formattedCode 
! !

!RBMethodNode methodsFor: 'initialize-release' stamp: 'PabloHerrero 10/19/2013 07:09'!
selector: aSymbol keywordsPositions: positionList arguments: valueNodes
	self 
		arguments: valueNodes;
		selector: aSymbol;
		keywordsPositions: positionList.! !

!RBMethodNode methodsFor: '*OpalCompiler-Core' stamp: 'MarcusDenker 7/5/2013 17:03'!
properties
	^self propertyAt: #methodProperties ifAbsent: nil! !

!RBMethodNode methodsFor: '*OpalCompiler-Core' stamp: 'MarcusDenker 4/29/2013 15:06'!
sourceText: aString
	self source: aString! !

!RBMethodNode methodsFor: 'accessing' stamp: 'TestRunner 11/5/2009 11:48'!
primitiveSources
	^ self pragmas collect: [ :each | self source copyFrom: each first to: each last ]! !

!RBMethodNode methodsFor: 'accessing' stamp: 'PabloHerrero 10/17/2013 18:39'!
selector: aSelector
	keywordsPositions := nil.
	selector := aSelector asSymbol.! !

!RBMethodNode methodsFor: '*OpalCompiler-Core' stamp: 'MarcusDenker 3/8/2015 09:20'!
compiledMethod
	^ self ir compiledMethod! !

!RBMethodNode methodsFor: 'testing' stamp: 'lr 11/1/2009 19:37'!
isPrimitive
	^ self pragmas anySatisfy: [ :each | each isPrimitive ]! !

!RBMethodNode methodsFor: 'private-replacing' stamp: 'PabloHerrero 10/22/2013 14:02'!
changeSourceSelector: oldSelector keywordsIntervals: oldIntervals arguments: oldArguments
	"If this is the same number of arguments, we try a one to one replacement of selector parts and arguments. If this is not the c
ase try to rewrite the signature as a whole, what unfortunately drops the comments within the signature."

	[ (oldIntervals size = self keywordsPositions size and: [ oldArguments size = arguments size ])
		ifTrue: [
			self selectorParts keysAndValuesDo: [ :index :part |
				self addReplacement: (RBStringReplacement 
					replaceFrom: (oldIntervals at: index) first
					to: (oldIntervals at: index) last
					with: part) ].
			oldArguments with: arguments do: [ :old :new | 
				self addReplacement: (RBStringReplacement 
					replaceFrom: old start
					to: old stop
					with: new name) ] ]
		ifFalse: [
			self addReplacement: (RBStringReplacement
				replaceFrom: oldIntervals first first
				to: (oldArguments notEmpty
					ifTrue: [ oldArguments last stop ]
					ifFalse: [ oldIntervals last last ])
				with: (String streamContents: [ :stream |
					self selectorParts keysAndValuesDo: [ :index :part |
						index = 1 ifFalse: [ stream space ].
						stream nextPutAll: part.
						index <= arguments size
							ifTrue: [ stream space; nextPutAll: (arguments at: index) name ] ] ])) ] ]
		on: Error
		do: [ :ex | ex return ]! !

!RBMethodNode methodsFor: '*OpalCompiler-Core' stamp: 'ClementBera 7/26/2013 15:26'!
generateIR
	| ir |
	scope ifNil: [self doSemanticAnalysisInContext: self compilationContext ].
 	ir := (self compilationContext astTranslatorClass new
			visitNode: self)
			ir.
	^ self ir: ir! !

!RBMethodNode methodsFor: 'accessing' stamp: 'CamilloBruni 12/15/2011 16:28'!
scope: aScopedNode
	scope := aScopedNode! !

!RBMethodNode methodsFor: 'matching' stamp: 'lr 5/30/2010 12:22'!
match: aNode inContext: aDictionary 
	self class = aNode class ifFalse: [ ^ false ].
	aDictionary at: '-source-' put: aNode source.
	self selector = aNode selector ifFalse: [ ^ false ].
	^ (self matchList: arguments against: aNode arguments inContext: aDictionary)
		and: [ (self matchPragmas: self pragmas against: aNode pragmas inContext: aDictionary)
		and: [ body match: aNode body inContext: aDictionary ] ]! !

!RBMethodNode methodsFor: '*OpalCompiler-Core' stamp: 'ClementBera 7/26/2013 15:27'!
methodOrBlockNode
	"^ self"! !

!RBMethodNode methodsFor: 'accessing' stamp: 'MarcusDenker 5/13/2013 11:44'!
compilationContext: aCompilationContext
	compilationContext := aCompilationContext.! !

!RBMethodNode methodsFor: 'accessing' stamp: 'ClementBera 7/26/2013 17:13'!
newSource
	replacements ifNil: [^self formattedCode].
	^[self reformatSource] on: Error do: [:ex | ex return: self formattedCode]! !

!RBMethodNode methodsFor: '*OpalCompiler-Core' stamp: 'jorgeRessia 11/22/2009 10:30'!
ir

	^ self propertyAt: #ir ifAbsent: [self generateIR].! !

!RBMethodNode methodsFor: 'accessing' stamp: 'lr 1/4/2012 21:38'!
addReturn
	^ body addReturn! !

!RBMethodNode methodsFor: '*OpalCompiler-Core' stamp: 'MarcusDenker 1/30/2013 13:13'!
generateWithSource
	"Answer a CompiledMethod with source encoded in trailer."

	
	"for doits, we need to store the source pretty printed from the 
	AST to get the return and methodName correct"
	self selector isDoIt ifTrue: [source := self formattedCode].
	
	^self generate: (CompiledMethodTrailer new sourceCode: source).! !

!RBMethodNode methodsFor: 'accessing' stamp: 'MarcusDenker 5/17/2013 15:41'!
methodClass
	^self compilationContext getClass ! !

!RBMethodNode methodsFor: 'accessing' stamp: 'lr 1/4/2012 21:38'!
addSelfReturn
	^ body addSelfReturn! !

!RBMethodNode methodsFor: '*OpalDecompiler' stamp: 'ClementBera 8/1/2014 10:25'!
removeAndRenameLastTempIfErrorCode
	self primitiveErrorVariableName ifNotNil: [ :primitiveErrorVariableName |
		 body temporaries removeLast ].! !

!RBMethodNode methodsFor: 'accessing' stamp: ''!
allArgumentVariables
	^(self argumentNames asOrderedCollection)
		addAll: super allArgumentVariables;
		yourself! !

!RBMethodNode methodsFor: 'accessing' stamp: ''!
source
	^source! !

!RBMethodNode methodsFor: 'printing' stamp: ''!
printOn: aStream 
	aStream nextPutAll: self formattedCode! !

!RBMethodNode methodsFor: 'testing' stamp: 'CamilloBruni 3/6/2013 15:15'!
pragmaNamed: aSymbol ifAbsent: absentBlock
	^ self pragmas 
		detect: [ :pragma| pragma selector = aSymbol ]
		ifNone: absentBlock! !

!RBMethodNode methodsFor: 'accessing' stamp: 'CamilloBruni 2/3/2012 16:42'!
statements
	^ self body statements! !

!RBMethodNode methodsFor: 'accessing' stamp: 'MarcusDenker 4/12/2013 10:27'!
sourceCode
	"compatibility to MethodNode"
	^source! !

!RBMethodNode methodsFor: '*OpalCompiler-Core' stamp: 'MarcusDenker 7/10/2013 15:55'!
doSemanticAnalysis

	self compilationContext ifNil: [ self methodClass: nil class ].

	self
		compilationContext semanticAnalyzerClass new
		compilationContext: self compilationContext;
		analyze: self! !

!RBMethodNode methodsFor: '*OpalCompiler-Core' stamp: 'ClementBera 5/21/2013 14:30'!
doSemanticAnalysisIn: behavior
	self methodClass: behavior.
	self doSemanticAnalysis! !

!RBMethodNode methodsFor: 'replacing' stamp: 'ClementBera 7/26/2013 17:13'!
addReplacement: aStringReplacement 
	replacements ifNil: [^self].
	replacements add: aStringReplacement! !

!RBMethodNode methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:37'!
acceptVisitor: aProgramNodeVisitor 
	^aProgramNodeVisitor visitMethodNode: self! !

!RBMethodNode methodsFor: 'accessing' stamp: 'lr 1/4/2012 21:40'!
addNode: aNode
	^ body addNode: aNode! !

!RBMethodNode methodsFor: 'accessing' stamp: 'PabloHerrero 11/7/2013 11:14'!
methodComments
	| methodComments |
	methodComments := OrderedCollection withAll: self comments.
	arguments do: [:each | methodComments addAll: each comments].
	^methodComments asSortedCollection: [:a :b | a start < b start]! !

!RBMethodNode methodsFor: '*OpalCompiler-Core' stamp: 'MarcusDenker 6/29/2012 16:04'!
owningScope
	^ self scope! !

!RBMethodNode methodsFor: 'comparing' stamp: 'lr 10/18/2009 16:03'!
= anObject 
	self == anObject ifTrue: [ ^ true ].
	self class = anObject class ifFalse: [ ^ false ].
	(self selector = anObject selector
		and: [ self pragmas size = anObject pragmas size
		and: [ self body = anObject body ] ])
			ifFalse: [ ^ false ].
	self arguments with: anObject arguments do: [ :first :second |
		first = second 
			ifFalse: [ ^ false ] ].
	self pragmas with: anObject pragmas do: [ :first :second |
		first = second 
			ifFalse: [ ^ false ] ].
	^ true! !

!RBMethodNode methodsFor: '*OpalCompiler-Core' stamp: 'MarcusDenker 4/19/2013 08:32'!
sourceNodeForPC: anInteger
	^(self ir instructionForPC: anInteger) sourceNode! !

!RBMethodNode methodsFor: 'accessing' stamp: ''!
arguments
	^arguments! !

!RBMethodNode methodsFor: 'accessing' stamp: ''!
source: anObject
	source := anObject! !

!RBMethodNode methodsFor: '*OpalCompiler-Core' stamp: 'MarcusDenker 4/29/2013 15:25'!
tempNames
	"compatibility method to old MethodNode"
	self flag: #Clean.
	^ self argumentNames, self temporaryNames! !

!RBMethodNode methodsFor: 'testing' stamp: ''!
isMethod
	^true! !

!RBMethodNode methodsFor: '*SmartSuggestions' stamp: 'GiselaDecuzzi 4/19/2013 10:08'!
specialCommands
	 ^SugsSuggestionFactory commandsForMethod.! !

!RBMethodNode methodsFor: 'replacing' stamp: ''!
map: oldNode to: newNode 
	nodeReplacements at: oldNode put: newNode! !

!RBMethodNode methodsFor: '*OpalCompiler-Core' stamp: 'CamilleTeruel 7/29/2014 17:57'!
rewriteTempsForContext: aContext
	
	| rewriter  |
	rewriter := RBParseTreeRewriter new.
	aContext tempNames withIndexDo: [ :tempName :index | 
		rewriter 
			replace: tempName, ' := ``@object'
			with: 'ThisContext namedTempAt:', index asString,  'put: ``@object';
			replace: tempName
			with: 'ThisContext namedTempAt:', index asString ].
	^ rewriter
		executeTree: self;
		tree! !

!RBMethodNode methodsFor: 'accessing' stamp: 'PabloHerrero 10/28/2013 17:01'!
keywordsPositions: aPositionsList
	keywordsPositions := aPositionsList ifNotNil: [:list| list asIntegerArray ]! !

!RBMethodNode methodsFor: '*OpalCompiler-Core' stamp: 'GabrielOmarCotelli 12/4/2013 09:27'!
primitiveFromPragma
	pragmas ifNil: [ ^ IRPrimitive null ].
	^ pragmas
		detect: [ :each | each isPrimitive ]
		ifFound: [ :aPragmaPrimitive | aPragmaPrimitive asPrimitive ]
		ifNone: [ IRPrimitive null ]! !

!RBMethodNode methodsFor: 'accessing' stamp: 'PabloHerrero 10/28/2013 17:01'!
keywordsPositions
	^keywordsPositions ifNil: [ (selector keywords collect: [:char| 0 ]) asIntegerArray ]! !

!RBMethodNode methodsFor: 'accessing' stamp: ''!
methodNode
	^self! !

!RBMethodNode methodsFor: 'accessing' stamp: 'GiselaDecuzzi 5/27/2013 18:59'!
statements: aCollection
	self body statements: aCollection ! !

!RBMethodNode methodsFor: 'accessing' stamp: 'lr 11/1/2009 19:34'!
pragmas: aCollection
	pragmas := aCollection.
	pragmas do: [ :each | each parent: self ]! !

!RBMethodNode methodsFor: 'testing' stamp: ''!
references: aVariableName 
	^body references: aVariableName! !

!RBMethodNode methodsFor: 'accessing' stamp: 'CamilloBruni 12/15/2011 16:28'!
scope
	^ scope! !

!RBMethodNode methodsFor: 'testing' stamp: ''!
isLast: aNode 
	^body isLast: aNode! !

!RBMethodNode methodsFor: 'testing' stamp: ''!
uses: aNode 
	^body == aNode and: [aNode lastIsReturn]! !

!RBMethodNode methodsFor: 'replacing' stamp: ''!
replaceNode: aNode withNode: anotherNode 
	aNode == body ifTrue: [self body: anotherNode].
	self arguments: (arguments 
				collect: [:each | each == aNode ifTrue: [anotherNode] ifFalse: [each]])! !

!RBMethodNode methodsFor: '*OpalCompiler-Core' stamp: 'MarcusDenker 11/20/2012 16:30'!
generate: trailer
	^ self generateIR compiledMethodWith: trailer.! !

!RBMethodNode methodsFor: 'testing' stamp: ''!
defines: aName 
	^arguments anySatisfy: [:each | each name = aName]! !

!RBMethodNode methodsFor: 'copying' stamp: 'lr 11/24/2009 23:22'!
postCopy
	super postCopy.
	self arguments: (self arguments collect: [ :each | each copy ]).
	self pragmas: (self pragmas collect: [ :each | each copy ]).
	self body: self body copy! !

!RBMethodNode methodsFor: 'testing' stamp: 'CamilloBruni 12/15/2011 16:32'!
hasArgumentNamed: aString	
	^ self arguments anySatisfy: [ :argument| argument name = aString ]! !

!RBMethodNode methodsFor: 'accessing' stamp: 'CamilloBruni 2/3/2012 16:41'!
temporaries
	^ self body temporaries! !

!RBMethodNode methodsFor: 'accessing' stamp: ''!
allDefinedVariables
	^(self argumentNames asOrderedCollection)
		addAll: super allDefinedVariables;
		yourself! !

!RBMethodNode methodsFor: 'accessing' stamp: ''!
body: stmtsNode 
	body := stmtsNode.
	body parent: self! !

!RBMethodNode methodsFor: 'accessing' stamp: 'PabloHerrero 10/19/2013 06:41'!
selector
	^ selector! !

!RBMethodNode methodsFor: 'accessing' stamp: 'lr 11/1/2009 19:34'!
pragmas
	^ pragmas ifNil: [ #() ]! !

!RBMethodNode methodsFor: 'testing' stamp: 'GiselaDecuzzi 6/5/2013 10:30'!
isFaulty
	(self arguments anySatisfy: #isFaulty) ifTrue:[ ^true].
	(self pragmas anySatisfy: #isFaulty) ifTrue:[ ^true].
	^self body isFaulty! !

!RBMethodNode methodsFor: 'accessing' stamp: 'CamilloBruni 12/8/2011 16:19'!
temporaryNames
	^ self body temporaryNames! !

!RBMethodNode methodsFor: 'accessing' stamp: 'MarkRizun 10/19/2014 11:32'!
start
	^ 1! !

!RBMethodNode methodsFor: 'accessing' stamp: 'PabloHerrero 11/7/2013 11:14'!
firstPrecodeComment
	| comment  | 
	self comments ifEmpty: [ ^nil ].
	comment :=  self comments first.
	^self source copyFrom: comment start to: comment stop.! !

!RBMethodNode methodsFor: 'testing' stamp: 'CamilloBruni 3/6/2013 15:15'!
hasPragmaNamed: aSymbol	
	self pragmaNamed: aSymbol ifAbsent: [ ^ false ].
	^ true! !

!RBMethodNode methodsFor: 'replacing' stamp: ''!
mappingFor: oldNode 
	^nodeReplacements at: oldNode ifAbsent: [oldNode]! !

!RBMethodNode methodsFor: 'testing' stamp: 'CamilloBruni 3/6/2013 15:14'!
pragmaNamed: aSymbol	
	^ self pragmaNamed: aSymbol ifAbsent: [ KeyNotFound signalFor: aSymbol  ]! !

!RBMethodNode methodsFor: '*OpalCompiler-Core' stamp: 'ClementBera 7/26/2013 15:25'!
doSemanticAnalysisInContext: aCompilationContext
	self compilationContext: aCompilationContext.
	self doSemanticAnalysis.! !

!RBMethodNode methodsFor: 'accessing' stamp: 'MarcusDenker 5/17/2013 15:49'!
methodClass: aClass	
	compilationContext ifNil: [compilationContext := aClass compiler compilationContext].
	self compilationContext class: aClass! !

!RBMethodNode methodsFor: '*OpalDecompiler' stamp: 'ClementBera 8/1/2014 10:24'!
primitiveErrorVariableName
	"Answer the primitive error code temp name, or nil if none."
	self isPrimitive ifTrue: [ 
		self pragmas do: [ :pragma | 
			pragma selectorParts first = 'primitive:' ifTrue: [ 
				^ pragma argumentAt: 'error:' ifAbsent: nil ] ] ].
	^ nil! !

!RBMethodNode methodsFor: 'testing' stamp: ''!
lastIsReturn
	^body lastIsReturn! !

!RBMethodNode methodsFor: 'comparing' stamp: 'lr 3/7/2010 13:55'!
hash
	^ ((self selector hash bitXor: (self hashForCollection: self arguments)) bitXor: (self hashForCollection: self pragmas)) bitXor: self body hash! !

!RBMethodNode methodsFor: '*OpalCompiler-Core' stamp: 'ClementBera 7/26/2013 15:25'!
generate
	"The receiver is the root of a parse tree. Answer a CompiledMethod. The
	argument, trailer, is the references to the source code that is stored with 
	every CompiledMethod."

	^ self generate: CompiledMethodTrailer empty! !

!RBMethodNode methodsFor: 'matching' stamp: 'PabloHerrero 10/20/2013 07:20'!
copyInContext: aDictionary
	^ self class new
		selector: self selector;
		arguments: (self arguments collect: [ :each | each copyInContext: aDictionary ]);
		pragmas: (self pragmas isEmpty
			ifTrue: [ aDictionary at: '-pragmas-' ifAbsent: [ #() ] ]
			ifFalse: [ self copyList: self pragmas inContext: aDictionary ]);
		body: (self body copyInContext: aDictionary);
		source: (aDictionary at: '-source-' ifAbsentPut: [ self source ]);
		yourself! !

!RBMethodNode methodsFor: '*reflectivity' stamp: 'MarcusDenker 3/8/2015 09:26'!
method
	"return the method that I have been compiled for"
	self compilationContext ifNil: [ ^nil ].
	^self compilationContext getClass >> self selector! !

!RBMethodNode methodsFor: 'accessing' stamp: 'MarkRizun 10/19/2014 11:32'!
stop
	^ self newSource size! !

!RBMethodNode methodsFor: '*OpalCompiler-Core' stamp: 'cb 6/27/2013 16:55'!
startWithoutParentheses
	^ 1! !

!RBMethodNode methodsFor: 'accessing' stamp: 'MarcusDenker 5/17/2013 15:49'!
compilationContext
	^ compilationContext! !

!RBMethodNode methodsFor: 'accessing' stamp: ''!
arguments: variableNodes 
	arguments := variableNodes.
	arguments do: [:each | each parent: self]! !

!RBMethodNode methodsFor: 'comparing' stamp: 'lr 10/18/2009 15:44'!
equalTo: anObject withMapping: aDictionary 
	self class = anObject class ifFalse: [ ^ false ].
	(self selector = anObject selector
		and: [ self pragmas size = anObject pragmas size
		and: [ self body equalTo: anObject body withMapping: aDictionary ] ]) 
			ifFalse: [ ^ false ].
	self arguments with: anObject arguments do: [ :first :second |
		(first equalTo: second	withMapping: aDictionary)
			ifFalse: [ ^ false ].
		aDictionary removeKey: first name ].
	self pragmas with: anObject pragmas do: [ :first :second |
		(first equalTo: second	withMapping: aDictionary) 
			ifFalse: [ ^ false ] ].
	^ true! !

!RBMethodNode methodsFor: 'accessing' stamp: 'PabloHerrero 1/5/2015 12:47'!
keywords
	^ selector keywords.! !

!RBMethodNode methodsFor: 'matching' stamp: 'lr 5/30/2010 12:23'!
matchPragmas: matchNodes against: pragmaNodes inContext: aDictionary
	matchNodes isEmpty ifTrue: [ 
		aDictionary at: '-pragmas-' put: pragmaNodes.
		^ true ].
	^ matchNodes allSatisfy: [ :matchNode |
		pragmaNodes anySatisfy: [ :pragmaNode |
			matchNode match: pragmaNode inContext: aDictionary ] ]! !

!RBMethodNode methodsFor: 'accessing' stamp: ''!
body
	^body! !

!RBMethodNode methodsFor: 'accessing' stamp: ''!
numArgs
	^self selector numArgs! !

!RBMethodNode methodsFor: 'accessing' stamp: 'PabloHerrero 10/28/2013 17:01'!
keywordsIntervals
	^selector keywords
		with: self keywordsPositions 
		collect: [:keyword :start| start to: (start = 0 ifTrue: [ -1 ] ifFalse: [ start + keyword size - 1]) ]! !

!RBMethodNode methodsFor: 'accessing' stamp: 'PabloHerrero 1/5/2015 12:47'!
selectorParts
	^ self keywords collect: #asSymbol.! !

!RBMethodNode methodsFor: 'accessing' stamp: ''!
argumentNames
	^self arguments collect: [:each | each name]! !

!RBMethodNode class methodsFor: 'instance creation' stamp: 'PabloHerrero 3/7/2015 21:04'!
selector: aSymbol arguments: valueNodes
	^(self new)
		selector: aSymbol;
		arguments: valueNodes;
		yourself! !

!RBMethodNode class methodsFor: 'instance creation' stamp: ''!
selector: aSymbol body: aSequenceNode 
	^self 
		selector: aSymbol
		arguments: #()
		body: aSequenceNode! !

!RBMethodNode class methodsFor: '*OpalCompiler-Core' stamp: 'ClementBera 11/18/2014 11:42'!
errorMethodNode: selector errorMessage: messageText	
	| message |
	message := RBMessageNode 
		receiver: (RBSelfNode named: 'self')
		selector: #error: 
		arguments: {RBLiteralNode value: messageText}.
	^ self 
		selector: selector 
		arguments: ((1 to: selector numArgs) collect: [ :i | RBArgumentNode named: 't' , i asString ]) 
		body: (RBSequenceNode statements: {message}) ! !

!RBMethodNode class methodsFor: 'instance creation' stamp: ''!
selector: aSymbol arguments: variableNodes body: aSequenceNode 
	^(self new)
		arguments: variableNodes;
		selector: aSymbol;
		body: aSequenceNode;
		yourself! !

!RBMethodNode class methodsFor: 'instance creation' stamp: 'PabloHerrero 10/17/2013 05:04'!
selector: aSymbol keywordsPositions: positionList arguments: valueNodes
	^(self new)
		selector: aSymbol
			keywordsPositions: positionList 
			arguments: valueNodes;
		yourself.! !

!RBMethodNode class methodsFor: '*Spec-Inspector' stamp: 'MarcusDenker 8/4/2014 16:23'!
additionalInspectorClasses
	^ super additionalInspectorClasses, { EyeSyntaxTreeInspector } ! !

!RBMethodRefactoring methodsFor: 'private' stamp: ''!
buildSelectorString: aSelector withPermuteMap: anIntegerCollection 
	| stream keywords |
	aSelector numArgs == 0 ifTrue: [^aSelector asString].
	stream := WriteStream on: String new.
	keywords := aSelector keywords.
	keywords with: anIntegerCollection
		do: 
			[:each :i | 
			stream
				nextPutAll: each;
				nextPutAll: ' ``@arg';
				nextPutAll: i printString;
				nextPut: $ ].
	^stream contents! !

!RBMethodRefactoring methodsFor: 'private' stamp: ''!
buildSelectorString: aSelector 
	aSelector numArgs = 0 ifTrue: [^aSelector].
	^self buildSelectorString: aSelector
		withPermuteMap: (1 to: aSelector numArgs)! !

!RBMethodSourceContainsLinefeedsRule commentStamp: 'StephaneDucasse 11/29/2014 20:52'!
Pharo code should not contain linefeed characters.!
!RBMethodSourceContainsLinefeedsRule methodsFor: 'accessing' stamp: 'lr 3/17/2010 17:54'!
group
	^ 'Pharo bugs'! !

!RBMethodSourceContainsLinefeedsRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:11'!
severity
	^ #error! !

!RBMethodSourceContainsLinefeedsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Method source contains linefeeds'! !

!RBMethodSourceContainsLinefeedsRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 16:59'!
checkMethod: aMethod 
	(aMethod sourceCode includes: Character lf) ifTrue: 
		[ result addMethod: aMethod ]! !

!RBMethodSourceContainsLinefeedsRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 14:11'!
category
	^ 'Bugs'! !

!RBMethodSourceContainsLinefeedsRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'MethodSourceContainsLinefeedsRule'! !

!RBMinMaxRule commentStamp: 'StephaneDucasse 11/29/2014 18:22'!
The use of the messages #min: and #max: improves code readability and avoids heavily nested conditionals.

For example 

[[[ 
	a < b ifTrue: [a] ifFalse: [b]
]]]			

is transformed into 

[[[  
a min: b
]]]
			
		!
!RBMinMaxRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:35'!
initialize
	super initialize.
	self rewriteRule
		replace: '``@a < ``@b ifTrue: [``@a] ifFalse: [``@b]' with: '``@a min: ``@b';
		replace: '``@a <= ``@b ifTrue: [``@a] ifFalse: [``@b]' with: '``@a min: ``@b';
		replace: '``@a > ``@b ifTrue: [``@a] ifFalse: [``@b]' with: '``@a max: ``@b';
		replace: '``@a >= ``@b ifTrue: [``@a] ifFalse: [``@b]' with: '``@a max: ``@b';
		replace: '``@a < ``@b ifTrue: [``@b] ifFalse: [``@a]' with: '``@a max: ``@b';
		replace: '``@a <= ``@b ifTrue: [``@b] ifFalse: [``@a]' with: '``@a max: ``@b';
		replace: '``@a > ``@b ifTrue: [``@b] ifFalse: [``@a]' with: '``@a min: ``@b';
		replace:  '``@a >= ``@b ifTrue: [``@b] ifFalse: [``@a]' with: '``@a min: ``@b';
		replace: '`a < ``@b ifTrue: [`a := ``@b]' with: '`a := `a max: ``@b';
		replace: '`a <= ``@b ifTrue: [`a := ``@b]' with: '`a := `a max: ``@b';
		replace: '`a < ``@b ifFalse: [`a := ``@b]' with: '`a := `a min: ``@b';
		replace: '`a <= ``@b ifFalse: [`a := ``@b]' with: '`a := `a min: ``@b';
		replace: '`a > ``@b ifTrue: [`a := ``@b]' with: '`a := `a min: ``@b';
		replace: '`a >= ``@b ifTrue: [`a := ``@b]' with: '`a := `a min: ``@b';
		replace: '`a > ``@b ifFalse: [`a := ``@b]' with: '`a := `a max: ``@b';
		replace: '`a >= ``@b ifFalse: [`a := ``@b]' with: '`a := `a max: ``@b';
		replace: '``@b < `a ifTrue: [`a := ``@b]' with: '`a := `a min: ``@b';
		replace: '``@b <= `a ifTrue: [`a := ``@b]' with: '`a := `a min: ``@b';
		replace: '``@b < `a ifFalse: [`a := ``@b]' with: '`a := `a max: ``@b';
		replace: '``@b <= `a ifFalse: [`a := ``@b]' with: '`a := `a max: ``@b';
		replace: '``@b > `a ifTrue: [`a := ``@b]' with: '`a := `a max: ``@b';
		replace: '``@b >= `a ifTrue: [`a := ``@b]' with: '`a := `a max: ``@b';
		replace: '``@b > `a ifFalse: [`a := ``@b]' with: '`a := `a min: ``@b';
		replace: '``@b >= `a ifFalse: [`a := ``@b]' with: '`a := `a min: ``@b'! !

!RBMinMaxRule methodsFor: 'accessing' stamp: 'lr 9/7/2010 20:27'!
rationale
	^ 'The use of the messages #min: and #max: improves code readability and avoids heavily nested conditionals.'! !

!RBMinMaxRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Transformations'! !

!RBMinMaxRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Rewrite ifTrue:ifFalse: using min:/max:'! !

!RBMinMaxRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:51'!
category 
	^ 'Coding Idiom Violation'! !

!RBMinMaxRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'MinMaxRule'! !

!RBMissingSubclassResponsibilityRule commentStamp: 'StephaneDucasse 11/29/2014 20:51'!
This smell arises when a class defines a method in all subclasses, but not in itself as an abstract method. Such methods should most likely be defined as subclassResponsibility methods. Furthermore, this check helps to find similar code that might be occurring in all the subclasses that should be pulled up into the superclass.!
!RBMissingSubclassResponsibilityRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:15'!
resultClass
	^ RBMultiEnvironment! !

!RBMissingSubclassResponsibilityRule methodsFor: 'accessing' stamp: 'SeanDeNigris 1/31/2013 09:21'!
group

	^ 'Intention revealing'! !

!RBMissingSubclassResponsibilityRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Method defined in all subclasses, but not in superclass'! !

!RBMissingSubclassResponsibilityRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 10:28'!
category 
	^ 'Design Flaws'! !

!RBMissingSubclassResponsibilityRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:50'!
checkClass: aClass 
	| subs |
	subs := aClass subclasses.
	(subs size > 1 and: [ aClass isMeta not ]) ifTrue: 
		[ | sels |
		sels := Bag new.
		subs do: [ :each | sels addAll: each selectors ].
		sels asSet do: 
			[ :each | 
			((sels occurrencesOf: each) == subs size and: [ (aClass canUnderstand: each) not ]) ifTrue: 
				[ | envName |
				envName := aClass name , '>>' , each.
				subs do: 
					[ :subClass | 
					result 
						addClass: subClass
						selector: each
						into: envName ] ] ] ]! !

!RBMissingSubclassResponsibilityRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'MissingSubclassResponsibilityRule'! !

!RBMissingSuperSendsRule commentStamp: 'StephaneDucasse 11/29/2014 20:51'!
Checks that methods that should always contain a super message send, actually contain a super message send. For example, the postCopy method should always contain a "super postCopy". The list of methods that should contain super message sends is in #superMessages.!
!RBMissingSuperSendsRule methodsFor: 'private' stamp: 'lr 2/24/2009 00:17'!
superMessages
	^#(#release #postCopy #postBuildWith: #preBuildWith: #postOpenWith: #noticeOfWindowClose: #initialize)! !

!RBMissingSuperSendsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:53'!
group
	^ 'Possible bugs'! !

!RBMissingSuperSendsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:53'!
name
	^ 'Missing super sends in selected methods.'! !

!RBMissingSuperSendsRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 10:29'!
category 
	^ 'Potential Bugs'! !

!RBMissingSuperSendsRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:00'!
checkMethod: aMethod 
	| definer superMethod |
	(aMethod methodClass isMeta not and: [ self superMessages includes: aMethod selector ]) ifTrue: 
		[ definer := aMethod methodClass superclass ifNotNil: [ :sc | sc whichClassIncludesSelector: aMethod selector ].
		definer ifNotNil: 
			[ "super defines same method"
			(aMethod superMessages includes: aMethod selector) ifFalse: 
				[ "but I don't call it"
				superMethod := definer 
					compiledMethodAt: aMethod selector
					ifAbsent: [  ].
				(superMethod isReturnSelf or: [ superMethod sendsSelector: #subclassResponsibility ]) ifFalse: 
					[ result addMethod: aMethod ] ] ] ]! !

!RBMissingSuperSendsRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'MissingSuperSendsRule'! !

!RBMissingTranslationsInMenusRule commentStamp: 'StephaneDucasse 11/29/2014 23:10'!
This rule should be updated to verify the inverse no translated messsages should be sent to menu element.!
!RBMissingTranslationsInMenusRule methodsFor: 'initialization' stamp: 'lr 11/2/2009 22:15'!
initialize
	super initialize.
	self matcher
		matchesAnyOf: #(
			'`@menu add: `#label action: `#sym'
			'`@menu add: `#label selector: `#sym arguments: `@stuff'
			'`@menu add: `#label subMenu: `@stuff target: `@targ selector: `#sel argumentList: `@args'
			'`@menu add: `#label subMenu: `@stuff'
			'`@menu add: `#label target: `@targ action: `#sel'
			'`@menu add: `#label target: `@targ selector `#sel argument: `@arg'
			'`@menu add: `#label target: `@targ selector `#sel arguments: `@arg'
			'`@menu add: `#label target: `@targ selector `#sel'
			'`@menu addList: `{ :n | n isLiteral and: [ n value isArray and: [ n value anySatisfy: [ :row | (row isKindOf: Array) and: [ row first isLiteral ] ] ] ] }'
			'`@menu addTitle: `#label updatingSelector: `#sel updateTarget: `@targ'
			'`@menu addTitle: `#label'
			'`@menu addWithLabel: `#label enablement: `#esel action: `#sel'
			'`@menu addWithLabel: `#label enablementSelector: `#esel target: `@targ selector: `#sel argumentList: `@args'
			'`@menu balloonTextForLastItem: `#label'
			'`@menu labels: `#lit lines: `@lines selections: `@sels'
			'`@menu title: `#title' )
		do: [ :node :answer | node ]! !

!RBMissingTranslationsInMenusRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
rationale
	^ 'Literal strings shown to users in menus should be translated.'! !

!RBMissingTranslationsInMenusRule methodsFor: 'accessing' stamp: 'lr 3/17/2010 17:54'!
group
	^ 'Pharo bugs'! !

!RBMissingTranslationsInMenusRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Menus missing translations'! !

!RBMissingTranslationsInMenusRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'MissingTranslationsInMenusRule'! !

!RBMissingYourselfRule commentStamp: '<historical>'!
When using cascaded messages, it is often important to finish the cascade with a yourself message. Why? for several reasons. 
	
	First the messages in the cascade may not return the last receiver but the argument as in the well known case of adding elements in a collection.
	
	| col  | 
	col := (OrderedCollection new: 2) add: 1; add: 2.
	
	In this example, col will be assigned to 2 instead of an orderedCollection because add: returns its argument and not the receiver. 
	
	The correct way to do it is using yourself (since yourself returns the receiver).
	| col  | 
	col := (OrderedCollection new: 2) add: 1; add: 2 ; yourself.
	
	
	Second case. Using yourself you can block the influence of redefined method. 
	Imagine the following example: a method creating an instance, initializing it and returning it.
	
	Box class >> new
		| inst | 
		inst := self new.
		inst initialize. 
		^ inst
		
	What this code ensures is that the instance is returned. Using ^ inst initialize would have 
	return the same (but with the risk that if initialize did not return the receiver the new method would not return the right instance)
	
	The previous code can be expressed as follow:
	
	Box class >> new
		^ self new initialize ; yourself 
		
	Here yourself play the same role as the ^ inst above. !
!RBMissingYourselfRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:32'!
initialize
	super initialize.
	self matcher 
		matches: '`{:node | node isMessage and: [node parent isCascade and: [node isDirectlyUsed and: [node selector ~~ #yourself]]]}'
		do: [ :node :answer | node ]! !

!RBMissingYourselfRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 22:27'!
rationale
	^ 'Checks for missing "; yourself" cascaded message send for cascaded messages that are used.'! !

!RBMissingYourselfRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Possible bugs'! !

!RBMissingYourselfRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Possible missing "; yourself"'! !

!RBMissingYourselfRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:24'!
category 
	^ 'Potential Bugs'! !

!RBMissingYourselfRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'MissingYourselfRule'! !

!RBModifiesCollectionRule commentStamp: 'StephaneDucasse 11/29/2014 23:09'!
Checks for remove:''s of elements inside of collection iteration methods such as do:. These can cause the do: method to break since it will walk of the end of the collection. The common fix for this problem is to copy the collection before iterating over it.

For example turning

aCol do: [ :each |  ... aCol remove:... ]

into 

aCol copy do: [ :each |  ... aCol remove:... ]!
!RBModifiesCollectionRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:33'!
initialize
	super initialize.
	self matcher 
		matchesAnyOf: #(
			'`@object do: [:`each | | `@temps | ``@.Statements]' 
			'`@object collect: [:`each | | `@temps | ``@.Statements]' 
			'`@object select: [:`each | | `@temps | ``@.Statements]' 
			'`@object reject: [:`each | | `@temps | ``@.Statements]' 
			'`@object inject: `@value into: [:`sum :`each | | `@temps | ``@.Statements]')
		do: [ :node :answer | 
			answer isNil 
				ifTrue: [
					(self modifiesTree: node receiver in: node arguments last) 
						ifTrue: [ node ]
						ifFalse: [ nil ] ]
				ifFalse: [ answer ] ]! !

!RBModifiesCollectionRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 23:09'!
rationale
	^ 'Checks for remove:''s of elements inside of collection iteration methods such as do:. '! !

!RBModifiesCollectionRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Possible bugs'! !

!RBModifiesCollectionRule methodsFor: 'private' stamp: 'TestRunner 11/3/2009 16:33'!
modifiesTree: aCollectionTree in: aParseTree 
	| notifier args |
	notifier := RBParseTreeSearcher new.
	args := Array with: (RBPatternVariableNode named: '`@object').
	notifier 
		matchesAnyTreeOf: (#(add: addAll: remove: removeAll:) collect: 
					[:each | 
					RBMessageNode 
						receiver: aCollectionTree
						selector: each
						arguments: args])
		do: [:aNode :answer | true].
	^notifier executeTree: aParseTree initialAnswer: false! !

!RBModifiesCollectionRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Modifies collection while iterating over it'! !

!RBModifiesCollectionRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:25'!
category
	^ 'Potential Bugs'! !

!RBModifiesCollectionRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'ModifiesCollectionRule'! !

!RBMoveInstVarToClassRefactoring commentStamp: 'MarkRizun 7/24/2014 14:19'!
RBMoveInstVarToClassRefactoring knows how to move instance variable from one class to another.

Instance Variables
	newClass:		<RBClass>

newClass
	- class, in which user moves an instance variable!
!RBMoveInstVarToClassRefactoring methodsFor: 'transforming' stamp: 'MarkRizun 7/24/2014 16:12'!
collectSendersOfInstVar
	| brokenSenders subclasses hasInstVar |
	hasInstVar := false.
	brokenSenders := OrderedCollection new.
	oldClass superclass instVarNames
		do: [ :each | 
			each = variableName
				ifTrue: [ hasInstVar := true ] ].
	hasInstVar
		ifTrue: [ ^ brokenSenders ]
		ifFalse: [ 
			brokenSenders := (oldClass selectors
				select: [ :each | (oldClass methodNamed: each) sourceCode includesSubstring: variableName asString ]
				thenCollect: [ :each | oldClass methodNamed: each ]) asOrderedCollection.
			subclasses := oldClass subclasses.
			subclasses
				do: [ :subclass | 
					subclass selectors
						do: [ :each | 
							((subclass methodNamed: each) sourceCode includesSubstring: ' ' , variableName asString , ' ')
								ifTrue: [ brokenSenders add: (subclass methodNamed: each) ] ] ].
			^ brokenSenders ]! !

!RBMoveInstVarToClassRefactoring methodsFor: 'accessing' stamp: 'MarkRizun 7/24/2014 14:45'!
oldClass: aClass
	oldClass := aClass! !

!RBMoveInstVarToClassRefactoring methodsFor: 'preconditions' stamp: 'MarkRizun 7/24/2014 14:41'!
preconditions
	^ RBCondition
		withBlock: [ 
			(class hierarchyDefinesInstanceVariable: variableName)
				ifTrue: [ self refactoringError: 'Already defined in hierarchy' ].true ]! !

!RBMoveInstVarToClassRefactoring methodsFor: 'transforming' stamp: 'MarcusDenker 7/28/2014 21:28'!
transform
	| brokenSenders |
	class addInstanceVariable: variableName asString.
	oldClass removeInstVarNamed: variableName asString.
	brokenSenders := self collectSendersOfInstVar.
	brokenSenders ifNotEmpty: [ 
		Smalltalk tools messageList
			browse: brokenSenders 
			title: 'Broken methods' 
			autoSelect: brokenSenders first selector] ! !

!RBMoveInstVarToClassRefactoring class methodsFor: 'as yet unclassified' stamp: 'MarkRizun 7/24/2014 14:45'!
model: aRBSmalltalk variable: aVarName class: aClass oldClass: anOldClass
	^(self new)
		model: aRBSmalltalk;
		variable: aVarName class: aClass;
		oldClass: anOldClass;
		yourself.! !

!RBMoveInstVarToClassTest methodsFor: 'failure tests' stamp: 'MarkRizun 7/24/2014 16:28'!
testMoveInstVarToClassAlreadyDefined
	self
		shouldFail:
			(RBMoveInstVarToClassRefactoring
				model: model
				variable: 'result'
				class: RBBasicLintRuleTest
				oldClass: RBFooLintRuleTest)! !

!RBMoveMethodRefactoring methodsFor: 'preconditions' stamp: 'lr 11/2/2009 00:14'!
checkForSuperReferences
	| searcher |
	searcher := RBParseTreeSearcher new.
	searcher matches: 'super `@message: `@args' do: [:aNode :answer | true].
	(searcher executeTree: parseTree initialAnswer: false) 
		ifTrue: 
			[self refactoringError: 'Cannot move the method since it has a super message send.']! !

!RBMoveMethodRefactoring methodsFor: 'private-accessing' stamp: 'CamilloBruni 10/8/2012 00:07'!
getClassForGlobalOrClassVariable
	| definingClass type |
	definingClass := class whoDefinesClassVariable: variable.
	definingClass isNil 
		ifTrue: 
			[type := self model classNamed: variable.
			type isNil ifTrue: [type := self model classNamed: #Object]]
		ifFalse: [type := definingClass typeOfClassVariable: variable].
	moveToClasses := self selectVariableTypesFrom: (Array with: type)
				selected: (Array with: type).
	moveToClasses isNil ifTrue: [self refactoringFailure: 'Method not moved']! !

!RBMoveMethodRefactoring methodsFor: 'transforming' stamp: 'PabloHerrero 10/22/2013 14:55'!
compileDelegatorMethod
	| statementNode delegatorNode tree |
	delegatorNode := RBMessageNode 
				receiver: (RBVariableNode named: variable)
				selector: parseTree selector
				keywordsPositions: parseTree keywordsPositions
				arguments: (parseTree argumentNames collect: 
							[:each | 
							RBVariableNode 
								named: (each = selfVariableName ifTrue: ['self'] ifFalse: [each])]).
	self hasOnlySelfReturns 
		ifFalse: [delegatorNode := RBReturnNode value: delegatorNode].
	statementNode := RBSequenceNode temporaries: #()
				statements: (Array with: delegatorNode).
	(tree := class parseTreeFor: selector) body: statementNode.
	class compileTree: tree! !

!RBMoveMethodRefactoring methodsFor: 'transforming' stamp: 'PabloHerrero 10/15/2013 16:30'!
transform
	self
		abstractVariables;
		addSelfReturn;
		replaceSelfReferences;
		replaceVariableReferences;
		compileNewMethods;
		compileDelegatorMethod! !

!RBMoveMethodRefactoring methodsFor: 'transforming' stamp: ''!
abstractVariables
	self performComponentRefactoring: self abstractVariablesRefactoring.
	parseTree := self abstractVariablesRefactoring parseTree! !

!RBMoveMethodRefactoring methodsFor: 'transforming' stamp: ''!
addSelfReturn
	self hasOnlySelfReturns ifTrue: [^self].
	parseTree addSelfReturn! !

!RBMoveMethodRefactoring methodsFor: 'private-accessing' stamp: 'CamilloBruni 10/8/2012 00:07'!
getClassesForInstanceVariable
	| definingClass typer types |
	definingClass := class whoDefinesInstanceVariable: variable.
	typer := RBRefactoryTyper newFor: self model.
	typer runOn: definingClass.
	types := typer typesFor: variable.
	types isEmpty 
		ifTrue: [types := OrderedCollection with: (self model classNamed: #Object)].
	moveToClasses := self selectVariableTypesFrom: types
				selected: (typer guessTypesFor: variable).
	moveToClasses isNil ifTrue: [self refactoringFailure: 'Method not moved']! !

!RBMoveMethodRefactoring methodsFor: 'initialize-release' stamp: ''!
selector: aSymbol class: aClass variable: aVariableName 
	selector := aSymbol.
	class := self classObjectFor: aClass.
	variable := aVariableName! !

!RBMoveMethodRefactoring methodsFor: 'preconditions' stamp: 'lr 11/2/2009 00:14'!
checkAssignmentsToVariable
	| searcher |
	searcher := RBParseTreeSearcher new.
	searcher matches: variable , ' := `@object' do: [:aNode :answer | true].
	(searcher executeTree: parseTree initialAnswer: false) 
		ifTrue: 
			[self refactoringError: ('Cannot move the method into <1s> since it is assigned' 
						expandMacrosWith: variable)]! !

!RBMoveMethodRefactoring methodsFor: 'testing' stamp: 'lr 11/2/2009 00:14'!
hasSelfReferences
	| searcher |
	searcher := RBParseTreeSearcher new.
	searcher matches: 'self' do: [:aNode :answer | true].
	self hasOnlySelfReturns 
		ifTrue: [searcher matches: '^self' do: [:aNode :answer | answer]].
	^searcher executeTree: parseTree initialAnswer: false! !

!RBMoveMethodRefactoring methodsFor: 'testing' stamp: ''!
isMovingToInstVar
	^self isMovingToArgument not 
		and: [(class whoDefinesInstanceVariable: variable) notNil]! !

!RBMoveMethodRefactoring methodsFor: 'transforming' stamp: 'lr 9/8/2011 20:11'!
abstractVariablesRefactoring
	^RBAbstractVariablesRefactoring 
		model: self model
		abstractVariablesIn: parseTree
		from: class
		toAll: moveToClasses
		ignoring: variable! !

!RBMoveMethodRefactoring methodsFor: 'preconditions' stamp: 'CamilloBruni 10/8/2012 00:07'!
getNewMethodName
	| newSelector parameters alreadyDefined methodName newMethodName |
	self removeArgument.
	parameters := parseTree argumentNames asOrderedCollection.
	"parameters remove: variable ifAbsent: []."
	self needsToReplaceSelfReferences 
		ifTrue: [parameters add: selfVariableName].
	methodName := RBMethodName selector: (self uniqueMethodNameFor: parameters size) arguments: parameters.
	
	[newMethodName := self requestMethodNameFor: methodName.
	newMethodName isNil ifTrue: [self refactoringFailure: 'Did not move method'].
	newMethodName isValid 
		ifTrue: [newSelector := newMethodName selector]
		ifFalse: [self refactoringWarning: 'Invalid method name'].
	parameters := newMethodName arguments.
	(self checkMethodName: newSelector in: class) 
		ifFalse: 
			[self refactoringWarning: newSelector , ' is not a valid selector name.'.
			newSelector := nil].
	alreadyDefined := moveToClasses 
				detect: [:each | each hierarchyDefinesMethod: newSelector]
				ifNone: [nil].
	alreadyDefined notNil 
		ifTrue: 
			[self 
				refactoringWarning: ('<1s> is already defined by <2p> or a super/subclass<n>Try another?' 
						expandMacrosWith: newSelector
						with: alreadyDefined).
			newSelector := nil].
	newSelector isNil] 
			whileTrue: [].
	parseTree
		renameSelector: newSelector
		andArguments: (parameters collect: [:each | RBVariableNode named: each]) 
			asArray! !

!RBMoveMethodRefactoring methodsFor: 'private' stamp: 'CamilloBruni 10/7/2012 23:59'!
buildParseTree
	parseTree := (class parseTreeFor: selector) copy.
	parseTree isNil ifTrue: [self refactoringFailure: 'Could not parse method']! !

!RBMoveMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'!
replaceSelfReferences
	| replacer |
	self needsToReplaceSelfReferences ifTrue: [
		replacer := RBParseTreeRewriter new.
		replacer replace: 'self' with: selfVariableName.
		self hasOnlySelfReturns ifTrue: 
			[replacer replace: '^self' with: '^self'].
		replacer executeTree: parseTree.
		parseTree := replacer tree].! !

!RBMoveMethodRefactoring methodsFor: 'preconditions' stamp: ''!
checkTemporaryVariableNames
	| varNames |
	varNames := parseTree allDefinedVariables.
	selfVariableName notNil ifTrue: [varNames add: selfVariableName].
	varNames do: 
			[:name | 
			moveToClasses do: 
					[:each | 
					(self canReferenceVariable: name in: each) 
						ifTrue: 
							[self refactoringError: ('<1p> already defines a variable called <2s>' 
										expandMacrosWith: each
										with: name)]]]! !

!RBMoveMethodRefactoring methodsFor: 'testing' stamp: ''!
isMovingToArgument
	^(parseTree arguments collect: [:each | each name]) includes: variable! !

!RBMoveMethodRefactoring methodsFor: 'private-accessing' stamp: 'CamilloBruni 10/8/2012 00:07'!
getClassesForTemporaryVariable
	| types |
	types := RBRefactoryTyper 
				typesFor: variable
				in: parseTree
				model: self model.
	types isEmpty 
		ifTrue: [types := OrderedCollection with: (self model classNamed: #Object)].
	moveToClasses := self selectVariableTypesFrom: types selected: types.
	moveToClasses isNil ifTrue: [self refactoringFailure: 'Method not moved']! !

!RBMoveMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'!
hasOnlySelfReturns
	^hasOnlySelfReturns isNil 
		ifTrue: 
			[| searcher |
			searcher := RBParseTreeSearcher new.
			searcher
				matches: '^self' do: [:aNode :answer | answer];
				matches: '^`@object' do: [:aNode :answer | false].
			hasOnlySelfReturns := searcher executeTree: parseTree initialAnswer: true]
		ifFalse: [hasOnlySelfReturns]! !

!RBMoveMethodRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^(RBCondition definesSelector: selector in: class) 
		& (RBCondition withBlock: 
					[self buildParseTree.
					self checkForPrimitiveMethod.
					self checkForSuperReferences.
					self checkAssignmentsToVariable.
					self getClassesToMoveTo.
					self getArgumentNameForSelf.
					self checkTemporaryVariableNames.
					self getNewMethodName.
					true])! !

!RBMoveMethodRefactoring methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream
		nextPutAll: ' selector: #';
		nextPutAll: selector;
		nextPutAll: ' class: '.
	class storeOn: aStream.
	aStream
		nextPutAll: ' variable: ''';
		nextPutAll: variable;
		nextPutAll: ''')'! !

!RBMoveMethodRefactoring methodsFor: 'transforming' stamp: 'PabloHerrero 10/21/2013 15:33'!
removeArgument
	"Removes the excess argument if any.
	This argument is the variable which is
	referenced by self in the classes the
	method is moved to. "
	| removeIndex |
	removeIndex := parseTree argumentNames indexOf: variable.
	removeIndex = 0 ifFalse: 
		[parseTree 
			selector: ('' join: ((parseTree selector keywords asOrderedCollection) 
									removeAt: removeIndex; yourself)) asSymbol
			keywordsPositions: ((parseTree keywordsPositions asOrderedCollection) 
									removeAt: removeIndex; yourself) asIntegerArray
			arguments: ((parseTree arguments asOrderedCollection)  
									removeAt: removeIndex; yourself) asArray].! !

!RBMoveMethodRefactoring methodsFor: 'transforming' stamp: 'lr 1/3/2010 11:48'!
verifyTemporaryVariableDoesNotOverride
	(parseTree allDefinedVariables includes: selfVariableName)
		ifTrue: [ ^ false ].
	^ moveToClasses 
		noneSatisfy: [ :each | each definesVariable: selfVariableName ]! !

!RBMoveMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/1/2009 23:05'!
compileNewMethods
	moveToClasses 
		do: [:each | each compile: parseTree newSource withAttributesFrom: (class methodFor: selector)]! !

!RBMoveMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'!
replaceVariableReferences
	| replacer |
	replacer := RBParseTreeRewriter new.
	replacer replace: variable with: 'self'.
	replacer executeTree: parseTree.
	parseTree := replacer tree! !

!RBMoveMethodRefactoring methodsFor: 'private-accessing' stamp: 'CamilloBruni 10/8/2012 00:07'!
getClassesToMoveTo
	self isMovingToArgument 
		ifTrue: [self getClassesForTemporaryVariable]
		ifFalse: 
			[self isMovingToInstVar 
				ifTrue: [self getClassesForInstanceVariable]
				ifFalse: [self getClassForGlobalOrClassVariable]].
	moveToClasses isEmpty 
		ifTrue: [self refactoringFailure: 'No classes selected, method not moved.']! !

!RBMoveMethodRefactoring methodsFor: 'preconditions' stamp: ''!
checkForPrimitiveMethod
	parseTree isPrimitive 
		ifTrue: [self refactoringError: 'Cannot move primitive methods']! !

!RBMoveMethodRefactoring methodsFor: 'transforming' stamp: ''!
getArgumentNameForSelf
	self needsToReplaceSelfReferences ifFalse: [^self].
	
	[selfVariableName := self requestSelfArgumentName.
	(self checkInstanceVariableName: selfVariableName in: class) 
		ifTrue: 
			[self verifyTemporaryVariableDoesNotOverride 
				ifFalse: 
					[self 
						refactoringWarning: 'The variable is already defined in one of the classes you''re moving the method to.<n>Try another?' 
								expandMacros.
					selfVariableName := nil]]
		ifFalse: 
			[self 
				refactoringWarning: 'The variable name is not a valid Smalltalk temporary variable name<n>Try again?' 
						expandMacros.
			selfVariableName := nil].
	selfVariableName isNil] 
			whileTrue: []! !

!RBMoveMethodRefactoring methodsFor: 'testing' stamp: ''!
needsToReplaceSelfReferences
	^self hasSelfReferences 
		or: [self abstractVariablesRefactoring hasVariablesToAbstract]! !

!RBMoveMethodRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBSmalltalk selector: aSymbol class: aClass variable: aVariableName 
	^(self new)
		model: aRBSmalltalk;
		selector: aSymbol
			class: aClass
			variable: aVariableName;
		yourself! !

!RBMoveMethodRefactoring class methodsFor: 'instance creation' stamp: ''!
selector: aSymbol class: aClass variable: aVariableName 
	^(self new)
		selector: aSymbol
			class: aClass
			variable: aVariableName;
		yourself! !

!RBMoveMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testMoveMethodIntoClassVariable
	| refactoring class |
	self proceedThroughWarning: 
		[ refactoring := RBMoveMethodRefactoring 
			selector: #checkMethod:
			class: RBTransformationRuleTest
			variable: 'RecursiveSelfRule'.
		self 
			setupSelfArgumentNameFor: refactoring
			toReturn: 'transformationRule'.
		self 
			setupVariableTypesFor: refactoring
			toReturn: (Array with: (refactoring model classNamed: #RBParseTreeSearcher)).
		self 
			setupMethodNameFor: refactoring
			toReturn: #foo:foo:
			withArguments: #('transformationRule' 'aSmalllintContext' ).
		self executeRefactoring: refactoring ].
	class := refactoring model classNamed: #RBTransformationRuleTest.
	self assert: (class parseTreeFor: #checkMethod:) = (RBParser parseMethod: 'checkMethod: aSmalllintContext RecursiveSelfRule foo: self foo: aSmalllintContext').
	self assert: ((refactoring model classNamed: #RBParseTreeSearcher) parseTreeFor: #foo:foo:) = (RBParser parseMethod: 'foo: transformationRule foo: aSmalllintContext
	transformationRule class: aSmalllintContext selectedClass.
	(transformationRule rewriteRule executeTree: aSmalllintContext parseTree) ifTrue: 
			[(self executeTree: transformationRule rewriteRule tree initialAnswer: false)
				ifFalse: 
					[transformationRule builder compile: transformationRule rewriteRule tree printString
						in: transformationRule class1
						classified: aSmalllintContext protocols]]').
	self assert: (class parseTreeFor: #class1) = (RBParser parseMethod: 'class1 ^class').
	self assert: (class parseTreeFor: #class:) = (RBParser parseMethod: 'class: anObject class := anObject').
	self assert: (class parseTreeFor: #builder) = (RBParser parseMethod: 'builder ^builder').
	self assert: (class parseTreeFor: #builder:) = (RBParser parseMethod: 'builder: anObject builder := anObject').
	self assert: (class parseTreeFor: #rewriteRule) = (RBParser parseMethod: 'rewriteRule ^rewriteRule').
	self assert: (class parseTreeFor: #rewriteRule:) = (RBParser parseMethod: 'rewriteRule: anObject rewriteRule := anObject')! !

!RBMoveMethodTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testMovePrimitiveMethod
	| refactoring |
	(model classNamed: #Object) 
		compile: 'foo <primitive: 100> ^#() primitiveFailed'
		classified: #(#accessing).
	refactoring := RBMoveMethodRefactoring 
				model: model
				selector: #foo
				class: Object
				variable: 'OrderedCollection'.
	self shouldFail: refactoring! !

!RBMoveMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testMoveMethodThatReferencesPoolDictionary
	| refactoring class |
	self proceedThroughWarning: 
		[ refactoring := RBMoveMethodRefactoring 
			selector: #junk
			class: RBLintRuleTest
			variable: 'RefactoryTestDataApp'.
		self 
			setupSelfArgumentNameFor: refactoring
			toReturn: 'transformationRule'.
		self 
			setupVariableTypesFor: refactoring
			toReturn: (Array with: (refactoring model classNamed: 'RBRefactoryTestDataApp class' asSymbol)).
		self 
			setupMethodNameFor: refactoring
			toReturn: #junk1.
		self executeRefactoring: refactoring ].
	class := refactoring model classNamed: #RBLintRuleTest.
	self assert: (class parseTreeFor: #junk) = (RBParser parseMethod: 'junk ^RefactoryTestDataApp junk1').
	self assert: ((refactoring model metaclassNamed: #RBRefactoryTestDataApp) parseTreeFor: #junk1) = (RBParser parseMethod: 'junk1
	^RBRefactoryTestDataApp printString copyFrom: 1 to: CR').
	self assert: (class directlyDefinesPoolDictionary: 'TextConstants' asSymbol)! !

!RBMoveMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:15'!
testMoveMethodIntoArgument
	| refactoring class |
	self proceedThroughWarning: 
		[ refactoring := RBMoveMethodRefactoring 
			selector: #checkMethod:
			class: RBTransformationRuleTest
			variable: 'aSmalllintContext'.
		self 
			setupSelfArgumentNameFor: refactoring
			toReturn: 'transformationRule'.
		self 
			setupVariableTypesFor: refactoring
			toReturn: (Array with: (refactoring model classNamed: #RBSmalllintContext)).
		self 
			setupMethodNameFor: refactoring
			toReturn: #foo:.
		self executeRefactoring: refactoring ].
	class := refactoring model classNamed: #RBTransformationRuleTest.
	self assert: (class parseTreeFor: #checkMethod:) = (RBParser parseMethod: 'checkMethod: aSmalllintContext aSmalllintContext foo: self').
	self assert: ((refactoring model classNamed: #RBSmalllintContext) parseTreeFor: #foo:) = (RBParser parseMethod: 'foo: transformationRule
	transformationRule class: self selectedClass.
	(transformationRule rewriteRule executeTree: self parseTree) ifTrue: 
			[(transformationRule class recursiveSelfRule executeTree: transformationRule rewriteRule tree initialAnswer: false)
				ifFalse: 
					[transformationRule builder compile: transformationRule rewriteRule tree printString
						in: transformationRule class1
						classified: self protocols]]').
	self assert: (class parseTreeFor: #class1) = (RBParser parseMethod: 'class1 ^class').
	self assert: (class parseTreeFor: #class:) = (RBParser parseMethod: 'class: anObject class := anObject').
	self assert: (class theMetaClass parseTreeFor: #recursiveSelfRule:) = (RBParser parseMethod: 'recursiveSelfRule: anObject RecursiveSelfRule := anObject').
	self assert: (class theMetaClass parseTreeFor: #recursiveSelfRule) = (RBParser parseMethod: 'recursiveSelfRule ^RecursiveSelfRule').
	self assert: (class parseTreeFor: #builder) = (RBParser parseMethod: 'builder ^builder').
	self assert: (class parseTreeFor: #builder:) = (RBParser parseMethod: 'builder: anObject builder := anObject').
	self assert: (class parseTreeFor: #rewriteRule) = (RBParser parseMethod: 'rewriteRule ^rewriteRule').
	self assert: (class parseTreeFor: #rewriteRule:) = (RBParser parseMethod: 'rewriteRule: anObject rewriteRule := anObject')! !

!RBMoveMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testMoveMethodIntoInstanceVariable
	| refactoring class |
	self proceedThroughWarning: 
		[ refactoring := RBMoveMethodRefactoring 
			selector: #checkMethod:
			class: RBTransformationRuleTest
			variable: 'rewriteRule'.
		self 
			setupSelfArgumentNameFor: refactoring
			toReturn: 'transformationRule'.
		self 
			setupVariableTypesFor: refactoring
			toReturn: (Array with: (refactoring model classNamed: #RBParseTreeRewriter)).
		self 
			setupMethodNameFor: refactoring
			toReturn: #foo:foo:
			withArguments: #('transformationRule' 'aSmalllintContext' ).
		self executeRefactoring: refactoring ].
	class := refactoring model classNamed: #RBTransformationRuleTest.
	self assert: (class parseTreeFor: #checkMethod:) = (RBParser parseMethod: 'checkMethod: aSmalllintContext rewriteRule foo: self foo: aSmalllintContext').
	self assert: ((refactoring model classNamed: #RBParseTreeRewriter) parseTreeFor: #foo:foo:) = (RBParser parseMethod: 'foo: transformationRule foo: aSmalllintContext
	transformationRule class: aSmalllintContext selectedClass.
	(self executeTree: aSmalllintContext parseTree) ifTrue: 
			[(transformationRule class recursiveSelfRule executeTree: self tree initialAnswer: false)
				ifFalse: 
					[transformationRule builder compile: self tree printString
						in: transformationRule class1
						classified: aSmalllintContext protocols]]').
	self assert: (class parseTreeFor: #class1) = (RBParser parseMethod: 'class1 ^class').
	self assert: (class parseTreeFor: #class:) = (RBParser parseMethod: 'class: anObject class := anObject').
	self assert: (class theMetaClass parseTreeFor: #recursiveSelfRule:) = (RBParser parseMethod: 'recursiveSelfRule: anObject RecursiveSelfRule := anObject').
	self assert: (class theMetaClass parseTreeFor: #recursiveSelfRule) = (RBParser parseMethod: 'recursiveSelfRule ^RecursiveSelfRule').
	self assert: (class parseTreeFor: #builder) = (RBParser parseMethod: 'builder ^builder').
	self assert: (class parseTreeFor: #builder:) = (RBParser parseMethod: 'builder: anObject builder := anObject')! !

!RBMoveMethodToClassRefactoring commentStamp: 'MarkRizun 7/24/2014 14:17'!
A RBMoveMethodToClassRefactoring is a class that represents functionality of "Move method to class" refactoring.
User chooses method, and than any of existiong classes.
Refactoring moves chosen method to class.

Instance Variables
	method:		<RBMethod>

method
	- chosen method
!
!RBMoveMethodToClassRefactoring methodsFor: 'initialize-release' stamp: 'MarkRizun 7/24/2014 11:04'!
method: aMethod class: aClass
	method := aMethod.
	class := self classObjectFor: aClass.! !

!RBMoveMethodToClassRefactoring methodsFor: 'preconditions' stamp: 'MarkRizun 7/24/2014 11:43'!
preconditions
	^(RBCondition definesSelector: method selector in: class) not! !

!RBMoveMethodToClassRefactoring methodsFor: 'printing' stamp: 'MarcusDenker 7/28/2014 19:18'!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream
		nextPutAll: ' selector: #';
		nextPutAll:  method selector;
		nextPutAll: ' class: '.
	class storeOn: aStream.
	aStream
		nextPutAll: ''')'! !

!RBMoveMethodToClassRefactoring methodsFor: 'transforming' stamp: 'MarkRizun 7/24/2014 11:22'!
transform
	| oldClass newClass rbMethod |
	oldClass := RBClass named: method methodClass name.
	oldClass model: self model.
	newClass := RBClass named: class name.
	newClass model: self model.
	rbMethod := RBMethod for: newClass source: method sourceCode selector: method selector.
	oldClass removeMethod: method selector.
	newClass addMethod: rbMethod.
	newClass compile: rbMethod source! !

!RBMoveMethodToClassRefactoring class methodsFor: 'instance creation' stamp: 'MarkRizun 7/24/2014 11:05'!
model: aRBSmalltalk method: aMethod class: aClass
	^ self new
		model: aRBSmalltalk;
		method: aMethod class: aClass;
		yourself! !

!RBMoveMethodToClassRefactoring class methodsFor: 'instance creation' stamp: 'MarkRizun 7/24/2014 11:05'!
method: aMethod class: aClass
	^ self new
		method: aMethod class: aClass;
		yourself! !

!RBMoveMethodToClassTest methodsFor: 'failure tests' stamp: 'MarkRizun 7/24/2014 13:16'!
testMethodAlreadyDefined
	| method someClass |
	someClass := model classNamed: #RBFooLintRuleTest.
	method := RBMethod for: someClass source: 'foo' , String cr , String tab , '^ 6' selector: #foo.
	self shouldFail: (RBMoveMethodToClassRefactoring method: method class: someClass)! !

!RBMoveVariableDefinitionRefactoring methodsFor: 'transforming' stamp: 'CamilloBruni 10/8/2012 00:06'!
checkParseTree
	| node |
	blockNodes := OrderedCollection new.
	node := self whichVariableNode: parseTree
				inInterval: interval
				name: name.
	node isNil
		ifTrue: [self refactoringFailure: 'Unable to locate node in parse tree'].
	definingNode := node whoDefines: name.
	definingNode isNil
		ifTrue: [self refactoringFailure: 'Cannot locate variable definition'].
	definingNode isSequence
		ifFalse: [self refactoringError: 'Variable is an argument'].
	(self usesDirectly: definingNode)
		ifTrue: [self refactoringError: 'Variable already bound tightly as possible'].
	(self checkNodes: (self subblocksIn: definingNode))
		ifFalse: [self refactoringError: 'Variable is possibly read before written']! !

!RBMoveVariableDefinitionRefactoring methodsFor: 'preconditions' stamp: 'CamilloBruni 10/8/2012 00:06'!
preconditions
	^(RBCondition definesSelector: selector in: class) 
		& (RBCondition withBlock: 
					[| methodSource |
					interval first <= interval last 
						ifFalse: [self refactoringFailure: 'Invalid variable name'].
					methodSource := class sourceCodeFor: selector.
					methodSource size >= interval last 
						ifFalse: [self refactoringFailure: 'Invalid range for variable'].
					name := methodSource copyFrom: interval first to: interval last.
					(self checkInstanceVariableName: name in: class) 
						ifFalse: 
							[self 
								refactoringFailure: name , ' does not seem to be a valid variable name.'].
					parseTree := class parseTreeFor: selector.
					self checkParseTree.
					true])! !

!RBMoveVariableDefinitionRefactoring methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream nextPutAll: ' bindTight: '.
	interval storeOn: aStream.
	aStream nextPutAll: ' in: '.
	class storeOn: aStream.
	aStream
		nextPutAll: ' selector: #';
		nextPutAll: selector.
	aStream nextPut: $)! !

!RBMoveVariableDefinitionRefactoring methodsFor: 'transforming' stamp: ''!
transform
	definingNode removeTemporaryNamed: name.
	blockNodes do: [:each | each body addTemporaryNamed: name].
	class compileTree: parseTree! !

!RBMoveVariableDefinitionRefactoring methodsFor: 'transforming' stamp: ''!
checkNodes: sequenceNodes 
	(sequenceNodes 
		detect: [:each | RBReadBeforeWrittenTester isVariable: name readBeforeWrittenIn: each]
		ifNone: [nil]) notNil 
		ifTrue: [^false].
	sequenceNodes do: 
			[:each | 
			(self usesDirectly: each body) 
				ifTrue: [blockNodes add: each]
				ifFalse: 
					[(self checkNodes: (self subblocksIn: each body)) 
						ifFalse: [blockNodes add: each]]].
	^true! !

!RBMoveVariableDefinitionRefactoring methodsFor: 'initialize-release' stamp: ''!
class: aClass selector: aSelector interval: anInterval 
	interval := anInterval.
	class := self classObjectFor: aClass.
	selector := aSelector! !

!RBMoveVariableDefinitionRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'!
usesDirectly: aParseTree 
	| searcher |
	searcher := RBParseTreeSearcher new.
	searcher
		matches: '[:`@args | | `@temps | `@.Statements]'
			do: [:aNode :answer | answer];
		matches: name do: [:aNode :answer | true].
	^searcher executeTree: aParseTree initialAnswer: false! !

!RBMoveVariableDefinitionRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'!
subblocksIn: aParseTree 
	| searcher |
	searcher := RBParseTreeSearcher new.
	searcher matches: '[:`@blockTemps | | `@temps | `@.Statements]'
		do: 
			[:aNode :answer | 
			(aNode references: name)
				ifTrue: [answer add: aNode].
			answer].
	^searcher executeTree: aParseTree initialAnswer: OrderedCollection new! !

!RBMoveVariableDefinitionRefactoring class methodsFor: 'instance creation' stamp: ''!
bindTight: anInterval in: aClass selector: aSelector 
	^self new
		class: aClass
		selector: aSelector
		interval: anInterval! !

!RBMoveVariableDefinitionRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBSmalltalk bindTight: anInterval in: aClass selector: aSelector 
	^(self new)
		model: aRBSmalltalk;
		class: aClass
			selector: aSelector
			interval: anInterval;
		yourself! !

!RBMoveVariableDefinitionTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testMoveDefinition
	| refactoring |
	refactoring := RBMoveVariableDefinitionRefactoring 
		bindTight: (self 
				convertInterval: (19 to: 22)
				for: (RBRefactoryTestDataApp sourceCodeAt: #moveDefinition))
		in: RBRefactoryTestDataApp
		selector: #moveDefinition.
	self executeRefactoring: refactoring.
	self assert: ((refactoring model classNamed: #RBRefactoryTestDataApp) parseTreeFor: #moveDefinition) = (RBParser parseMethod: 'moveDefinition
								^(self collect: 
										[:each | 
										| temp |
										temp := each printString.
										temp , temp]) 
									select: 
										[:each | 
										| temp |
										temp := each size.
										temp odd]')! !

!RBMoveVariableDefinitionTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testNonExistantName
	self
		shouldFail: (RBMoveVariableDefinitionRefactoring 
				bindTight: (1 to: 10)
				in: RBLintRuleTest
				selector: #name1);
		shouldFail: (RBMoveVariableDefinitionRefactoring 
				bindTight: (self 
						convertInterval: (44 to: 54)
						for: (RBLintRuleTest sourceCodeAt: #displayName))
				in: RBLintRuleTest
				selector: #displayName);
		shouldFail: (RBMoveVariableDefinitionRefactoring 
				bindTight: (self 
						convertInterval: (16 to: 25)
						for: (RBLintRuleTest sourceCodeAt: #displayName))
				in: RBLintRuleTest
				selector: #displayName)! !

!RBMoveVariableDefinitionTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testNoMoveDefinition
	self shouldFail: (RBMoveVariableDefinitionRefactoring 
			bindTight: (self 
					convertInterval: (21 to: 24)
					for: (RBRefactoryTestDataApp sourceCodeAt: #moveDefinition))
			in: RBRefactoryTestDataApp
			selector: #noMoveDefinition)! !

!RBMoveVariableDefinitionTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testMoveDefinitionIntoBlockThatIsAReceiverOfACascadedMessage
	| refactoring |
	refactoring := RBMoveVariableDefinitionRefactoring 
		bindTight: (self 
				convertInterval: (48 to: 58)
				for: (RBRefactoryTestDataApp sourceCodeAt: #referencesConditionFor:))
		in: RBRefactoryTestDataApp
		selector: #referencesConditionFor:.
	self executeRefactoring: refactoring.
	self assert: ((refactoring model classNamed: #RBRefactoryTestDataApp) parseTreeFor: #referencesConditionFor:) = (RBParser parseMethod: 'referencesConditionFor: aClass 
								| environment  |
								^(RBCondition withBlock: 
										[| association |association := Smalltalk associationAt: aClass name
													ifAbsent: [self refactoringError: ''Could not find class''].
										environment := (self environment referencesTo: association) 
													| (self environment referencesTo: aClass name).
										environment isEmpty])
									errorMacro: aClass , '' is referenced.<n>Browse references?'';
									errorBlock: [environment openEditor];
									yourself')! !

!RBMultiEnvironment methodsFor: 'testing' stamp: 'lr 3/13/2009 11:52'!
includesClass: aClass
	^ (super includesClass: aClass) and: [ environmentDictionaries anySatisfy: [ :env | env includesClass: aClass ] ]! !

!RBMultiEnvironment methodsFor: '*Manifest-CriticBrowser' stamp: 'SimonAllier 3/30/2012 11:43'!
isMultiEnvironment
	^ true! !

!RBMultiEnvironment methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'!
asSelectorEnvironment
	| s |
	s := RBSelectorEnvironment new.
	s label: self label.
	environmentDictionaries do: [:each | | env |
			env := each asSelectorEnvironment. 
			env classesDo: [:cls | env selectorsForClass: cls do:  [:sel | s addClass: cls selector: sel]]].
	^ s
	  ! !

!RBMultiEnvironment methodsFor: 'testing' stamp: ''!
isEmpty
	^environmentDictionaries isEmpty! !

!RBMultiEnvironment methodsFor: 'removing' stamp: 'lr 9/8/2011 20:32'!
removeClass: aClass selector: aSelector into: aValue 
	(environmentDictionaries at: aValue ifAbsentPut: [RBSelectorEnvironment new]) 
		removeClass: aClass
		selector: aSelector! !

!RBMultiEnvironment methodsFor: 'testing' stamp: 'lr 3/13/2009 11:53'!
includesCategory: aCategory
	^ (super includesCategory: aCategory) and: [ environmentDictionaries anySatisfy: [ :env | env includesCategory: aCategory ] ]! !

!RBMultiEnvironment methodsFor: 'testing' stamp: 'lr 3/13/2009 11:53'!
includesSelector: aSelector in: aClass
	^ (super includesSelector: aSelector in: aClass) and: [ environmentDictionaries anySatisfy: [ :env | env includesSelector: aSelector in: aClass ] ]! !

!RBMultiEnvironment methodsFor: 'adding' stamp: 'lr 9/8/2011 20:32'!
addClass: aClass into: aValue 
	(environmentDictionaries at: aValue ifAbsentPut: [RBSelectorEnvironment new]) 
		addClass: aClass! !

!RBMultiEnvironment methodsFor: 'initialization' stamp: 'lr 9/8/2011 20:32'!
initialize
	super initialize.
	environmentDictionaries := Dictionary new.
	environment := RBSelectorEnvironment new! !

!RBMultiEnvironment methodsFor: 'testing' stamp: 'lr 3/13/2009 11:54'!
includesProtocol: aProtocol in: aClass
	^ (super includesProtocol: aProtocol in: aClass) and: [ environmentDictionaries anySatisfy: [ :env | env includesProtocol: aProtocol in: aClass ] ]! !

!RBMultiEnvironment methodsFor: 'adding' stamp: 'lr 9/8/2011 20:32'!
addClass: aClass selector: aSymbol into: aValue 
	(environmentDictionaries at: aValue ifAbsentPut: [RBSelectorEnvironment new]) 
		addClass: aClass
		selector: aSymbol! !

!RBMultiEnvironment methodsFor: 'accessing' stamp: ''!
problemCount
	^environmentDictionaries size! !

!RBMultiEnvironment methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'!
selectEnvironment: aValue 
	environment := environmentDictionaries at: aValue
				ifAbsent: [RBSelectorEnvironment new]! !

!RBMultiEnvironment methodsFor: 'removing' stamp: 'lr 9/8/2011 20:32'!
removeClass: aClass into: aValue 
	(environmentDictionaries at: aValue ifAbsent: [RBSelectorEnvironment new]) 
		removeClass: aClass! !

!RBMultiEnvironment methodsFor: '*Manifest-CriticBrowser' stamp: 'SimonAllier 3/27/2013 10:14'!
smallLintCritics
	^ self asSelectorEnvironment smallLintCritics! !

!RBMultiEnvironment methodsFor: 'accessing' stamp: ''!
environments
	^environmentDictionaries keys! !

!RBMultiEnvironment methodsFor: '*Manifest-CriticBrowser' stamp: 'MarcusDenker 10/2/2013 20:17'!
removeClass: aClass
	environmentDictionaries keysDo: [ :key |
		(environmentDictionaries at: key) removeClass: aClass ]! !

!RBMultiKeywordLiteralToken methodsFor: 'testing' stamp: ''!
isMultiKeyword
	^true! !

!RBNamespace methodsFor: 'testing' stamp: ''!
includesClassNamed: aSymbol 
	^(self classNamed: aSymbol) notNil! !

!RBNamespace methodsFor: 'accessing' stamp: 'lr 1/20/2010 18:08'!
description
	^ self changes name! !

!RBNamespace methodsFor: 'accessing' stamp: ''!
allReferencesToClass: aRBClass do: aBlock 
	self allClassesDo: 
			[:each | 
			(each whichSelectorsReferToClass: aRBClass) 
				do: [:sel | aBlock value: (each methodFor: sel)]]! !

!RBNamespace methodsFor: 'private' stamp: 'lr 4/7/2010 13:45'!
privateRootClasses
	| classes |
	classes := OrderedCollection new.
	Class rootsOfTheWorld do: [ :each | 
		| class |
		class := self classFor: each.
		(class notNil and: [ class superclass isNil ]) 
			ifTrue: [ classes add: class ] ].
	^ classes! !

!RBNamespace methodsFor: 'accessing' stamp: 'lr 4/7/2010 13:44'!
allReferencesTo: aSymbol do: aBlock
	(self allReferencesTo: aSymbol) do: aBlock! !

!RBNamespace methodsFor: 'private-changes' stamp: 'lr 10/26/2009 22:09'!
addChangeToClass: aRBClass 
	^ changedClasses 
		at: aRBClass name
		put: (Array 
				with: aRBClass theNonMetaClass
				with: aRBClass theMetaClass)! !

!RBNamespace methodsFor: 'private-changes' stamp: ''!
addClassVariable: aString to: aRBClass 
	^changes addClassVariable: aString to: aRBClass! !

!RBNamespace methodsFor: 'private' stamp: 'lr 10/31/2009 17:37'!
classNameFor: aBehavior 
	^ aBehavior theNonMetaClass name! !

!RBNamespace methodsFor: 'initialization' stamp: 'lr 9/8/2011 20:25'!
initialize
	changes := RBCompositeRefactoryChange new.
	environment := RBBrowserEnvironment new.
	newClasses := IdentityDictionary new.
	changedClasses := IdentityDictionary new.
	removedClasses := Set new.
	implementorsCache := IdentityDictionary new.
	sendersCache := IdentityDictionary new! !

!RBNamespace methodsFor: 'accessing' stamp: 'lr 4/7/2010 18:53'!
allImplementorsOf: aSelector do: aBlock
	(self allImplementorsOf: aSelector) do: aBlock! !

!RBNamespace methodsFor: 'accessing' stamp: 'lr 4/7/2010 13:44'!
allReferencesTo: aSymbol
	^ sendersCache at: aSymbol ifAbsentPut: [ self privateReferencesTo: aSymbol ]! !

!RBNamespace methodsFor: 'accessing' stamp: 'lr 1/20/2010 18:08'!
description: aString
	self changes name: aString! !

!RBNamespace methodsFor: 'accessing' stamp: ''!
environment: aBrowserEnvironment 
	environment := aBrowserEnvironment! !

!RBNamespace methodsFor: 'changes' stamp: ''!
removeClass: aRBClass 
	self removeClassNamed: aRBClass name! !

!RBNamespace methodsFor: 'changes' stamp: 'lr 9/8/2011 20:10'!
renameClass: aRBClass to: aSymbol around: aBlock 
	| change value dict |
	change := RBRenameClassChange rename: aRBClass name to: aSymbol.
	self performChange: change around: aBlock.
	self flushCaches.
	dict := (newClasses includesKey: aRBClass name) 
				ifTrue: [newClasses]
				ifFalse: [changedClasses].
	removedClasses
		add: aRBClass name;
		add: aRBClass name , ' class'.
	value := dict at: aRBClass name.
	dict removeKey: aRBClass name.
	dict at: aSymbol put: value.
	value first name: aSymbol.
	value last name: aSymbol.
	value first subclasses do: [:each | each superclass: value first].
	value last subclasses do: [:each | each superclass: value last].
	^change! !

!RBNamespace methodsFor: 'changes' stamp: 'lr 7/1/2008 11:06'!
comment: aString in: aClass
	^ changes comment: aString in: aClass! !

!RBNamespace methodsFor: 'private-changes' stamp: 'lr 10/26/2009 22:09'!
changeClass: aRBClass 
	changedClasses 
		at: aRBClass name
		put: (Array 
				with: aRBClass theNonMetaClass
				with: aRBClass theMetaClass).
	self flushCaches! !

!RBNamespace methodsFor: 'accessing' stamp: ''!
name: aString
	^changes name: aString! !

!RBNamespace methodsFor: 'private-changes' stamp: 'lr 9/8/2011 20:10'!
renameInstanceVariable: oldName to: newName in: aRBClass around: aBlock 
	^self performChange: (RBRenameInstanceVariableChange 
				rename: oldName
				to: newName
				in: aRBClass)
		around: aBlock! !

!RBNamespace methodsFor: 'private-changes' stamp: 'lr 9/8/2011 20:10'!
renameClassVariable: oldName to: newName in: aRBClass around: aBlock 
	^self performChange: (RBRenameClassVariableChange 
				rename: oldName
				to: newName
				in: aRBClass)
		around: aBlock! !

!RBNamespace methodsFor: 'private-changes' stamp: ''!
compile: aString in: aRBClass classified: aSymbol 
	| change |
	change := changes 
				compile: aString
				in: aRBClass
				classified: aSymbol.
	self flushCaches.
	^change! !

!RBNamespace methodsFor: 'private-changes' stamp: ''!
removeClassVariable: aString from: aRBClass 
	^changes removeClassVariable: aString from: aRBClass! !

!RBNamespace methodsFor: 'accessing' stamp: ''!
name
	^changes name! !

!RBNamespace methodsFor: 'testing' stamp: ''!
hasRemoved: aSymbol 
	^removedClasses includes: aSymbol! !

!RBNamespace methodsFor: 'accessing' stamp: 'lr 4/7/2010 13:40'!
allImplementorsOf: aSelector 
	^ implementorsCache at: aSelector ifAbsentPut: [ self privateImplementorsOf: aSelector ]! !

!RBNamespace methodsFor: 'accessing' stamp: ''!
changes
	^changes! !

!RBNamespace methodsFor: 'testing' stamp: ''!
includesGlobal: aSymbol 
	(self hasRemoved: aSymbol) ifTrue: [^false].
	(self includesClassNamed: aSymbol) ifTrue: [^true].
	environment at: aSymbol ifAbsent: [^false].
	^true! !

!RBNamespace methodsFor: 'accessing-classes' stamp: 'lr 10/31/2009 17:35'!
classFor: aBehavior 
	aBehavior isNil 
		ifTrue: [ ^ nil ].
	^ aBehavior isMeta 
		ifTrue: [ self metaclassNamed: aBehavior theNonMetaClass name ]
		ifFalse: [ self classNamed: aBehavior theNonMetaClass name ]! !

!RBNamespace methodsFor: 'private-changes' stamp: ''!
addInstanceVariable: aString to: aRBClass 
	^changes addInstanceVariable: aString to: aRBClass! !

!RBNamespace methodsFor: 'changes' stamp: ''!
reparentClasses: aRBClassCollection to: newClass 
	aRBClassCollection do: 
			[:aClass | 
			self defineClass: (self replaceClassNameIn: aClass definitionString
						to: newClass name)]! !

!RBNamespace methodsFor: 'private-changes' stamp: ''!
removeInstanceVariable: aString from: aRBClass 
	^changes removeInstanceVariable: aString from: aRBClass! !

!RBNamespace methodsFor: 'accessing-classes' stamp: ''!
whichCategoryIncludes: aSymbol
	^self environment whichCategoryIncludes: aSymbol! !

!RBNamespace methodsFor: 'accessing-classes' stamp: 'lr 10/26/2009 22:09'!
classNamed: aSymbol 
	| class classes index |
	aSymbol isNil ifTrue: [ ^ nil ].
	(self hasRemoved: aSymbol) ifTrue: [ ^ nil ].
	(newClasses includesKey: aSymbol) ifTrue: [ ^ (newClasses at: aSymbol) first ].
	(changedClasses includesKey: aSymbol) ifTrue: [ ^ (changedClasses at: aSymbol) first ].
	class := environment 
		at: aSymbol
		ifAbsent: [ nil ].
	(class isBehavior or: [ class isTrait ]) ifTrue: 
		[ classes := self createNewClassFor: class.
		^ class isMeta 
			ifTrue: [ classes last ]
			ifFalse: [ classes first ] ].
	index := aSymbol 
		indexOfSubCollection: ' class'
		startingAt: 1
		ifAbsent: [ ^ nil ].
	class := self classNamed: (aSymbol 
			copyFrom: 1
			to: index - 1) asSymbol.
	^ class isNil 
		ifTrue: [ nil ]
		ifFalse: [ class theMetaClass ]! !

!RBNamespace methodsFor: 'accessing' stamp: ''!
environment
	^environment! !

!RBNamespace methodsFor: 'private-changes' stamp: ''!
replaceClassNameIn: definitionString to: aSymbol 
	| parseTree |
	parseTree := RBParser parseExpression: definitionString.
	parseTree receiver: (RBVariableNode named: aSymbol).
	^parseTree formattedCode! !

!RBNamespace methodsFor: 'private' stamp: ''!
hasCreatedClassFor: aBehavior 
	| className |
	className := self classNameFor: aBehavior.
	^(newClasses includesKey: className) 
		or: [changedClasses includesKey: className]! !

!RBNamespace methodsFor: 'accessing' stamp: 'YuriyTymchuk 10/9/2014 10:42'!
allClassesDo: aBlock
	| seen evalBlock |
	seen := Set new.
	evalBlock := [ :each | 
		seen add: each first name.
		aBlock
			value: each first;
			value: each last ].
	newClasses do: evalBlock.
	changedClasses do: evalBlock.
	environment classesDo: [ :each | 
		each isObsolete ifFalse: [
			| class |
			class := each theNonMetaClass.
			((seen includes: class name) or: [ self hasRemoved: (self classNameFor: class) ]) ifFalse: [
				(class := self classFor: each) isNil ifFalse: [
					seen add: class name.
					aBlock value: class ] ] ] ]! !

!RBNamespace methodsFor: 'changes' stamp: 'MartinDias 11/7/2013 18:11'!
defineClass: aString 
	| change newClass newClassName |
	change := changes defineClass: aString.
	newClassName := change changeClassName.
	newClass := self classNamed: newClassName.
	newClass isNil ifTrue: 
		[ | newMetaclass |
		removedClasses
			remove: newClassName
				ifAbsent: [  ];
			remove: newClassName , ' class'
				ifAbsent: [  ].
		newClass := RBClass named: newClassName.
		newMetaclass := RBMetaclass named: newClassName.
		newClass model: self.
		newMetaclass model: self.
		newClasses 
			at: newClassName
			put: (Array 
					with: newClass
					with: newMetaclass) ].
	newClass superclass: (self classNamed: change superclassName).
	newClass superclass isNil 
		ifTrue: 
			[ self rootClasses add: newClass.
			newClass theMetaClass superclass: (self classFor: Object class superclass) ]
		ifFalse: [ newClass theMetaClass superclass: newClass superclass theMetaClass ].
	newClass instanceVariableNames: change instanceVariableNames.
	newClass classVariableNames: change classVariableNames.
	newClass poolDictionaryNames: change sharedPoolNames.
	newClass category: change category.
	^ change! !

!RBNamespace methodsFor: 'accessing' stamp: 'lr 4/7/2010 13:38'!
rootClasses
	^ rootClasses ifNil: [ rootClasses := self privateRootClasses]! !

!RBNamespace methodsFor: 'private-changes' stamp: ''!
removeMethod: aSelector from: aRBClass 
	self flushCaches.
	^changes removeMethod: aSelector from: aRBClass! !

!RBNamespace methodsFor: 'changes' stamp: ''!
removeClassNamed: aSymbol 
	(self classNamed: aSymbol) subclasses 
		do: [:each | self removeClassNamed: each name].
	removedClasses
		add: aSymbol;
		add: aSymbol , ' class'.
	newClasses removeKey: aSymbol ifAbsent: [].
	changedClasses removeKey: aSymbol ifAbsent: [].
	self flushCaches.
	^changes removeClassNamed: aSymbol! !

!RBNamespace methodsFor: 'private-changes' stamp: ''!
addPool: aString to: aRBClass 
	^changes addPool: aString to: aRBClass! !

!RBNamespace methodsFor: 'private-changes' stamp: ''!
flushCaches
	implementorsCache := IdentityDictionary new.
	sendersCache := IdentityDictionary new! !

!RBNamespace methodsFor: 'private-changes' stamp: ''!
performChange: aCompositeRefactoryChange around: aBlock 
	| oldChanges |
	changes addChange: aCompositeRefactoryChange.
	oldChanges := changes.
	changes := aCompositeRefactoryChange.
	aBlock ensure: [changes := oldChanges].
	^aCompositeRefactoryChange! !

!RBNamespace methodsFor: 'private' stamp: 'YuriyTymchuk 10/9/2014 10:30'!
privateReferencesTo: aSelector 
	| methods |
	methods := OrderedCollection new.
	self allBehaviorsDo: [ :class |
		(class whichSelectorsReferToSymbol: aSelector)
			do: [ :selector |
				methods add: (class methodFor: selector) ] ].
	^ methods! !

!RBNamespace methodsFor: 'accessing' stamp: 'YuriyTymchuk 10/9/2014 10:49'!
allBehaviorsDo: aBlock
	| seen evalBlock |
	seen := Set new.
	evalBlock := [ :each | 
		seen add: each first name.
		aBlock
			value: each first;
			value: each last ].
	newClasses do: evalBlock.
	changedClasses do: evalBlock.
	environment classesDo: [ :each | 
		each isObsolete ifFalse: [
			| class |
			class := each theNonMetaClass.
			((seen includes: class name) or: [ self hasRemoved: (self classNameFor: class) ]) ifFalse: [
				(class := self classFor: each) isNil ifFalse: [
					seen add: class name.
					aBlock
						value: class;
						value: class theMetaClass ] ] ] ]! !

!RBNamespace methodsFor: 'accessing-classes' stamp: 'lr 10/31/2009 17:36'!
createNewClassFor: aBehavior 
	| nonMeta meta className |
	className := aBehavior theNonMetaClass name.
	nonMeta := (RBClass existingNamed: className)
				model: self;
				yourself.
	meta := (RBMetaclass existingNamed: className)
				model: self;
				yourself.
	^changedClasses at: className put: (Array with: nonMeta with: meta)! !

!RBNamespace methodsFor: 'accessing-classes' stamp: 'dc 5/8/2007 13:44'!
metaclassNamed: aSymbol 
	| class |
	aSymbol isNil ifTrue: [^nil].
	(self hasRemoved: aSymbol) ifTrue: [^nil].
	(newClasses includesKey: aSymbol) 
		ifTrue: [^(newClasses at: aSymbol) last].
	(changedClasses includesKey: aSymbol) 
		ifTrue: [^(changedClasses at: aSymbol) last].

	class := environment at: aSymbol ifAbsent: [nil].
	(class isBehavior or: [class isTrait])
		ifTrue: [^ (self createNewClassFor: class) last].
	^ nil! !

!RBNamespace methodsFor: 'private' stamp: 'SebastianTleye 8/1/2013 16:11'!
privateImplementorsOf: aSelector 
	| classes |
	classes := Set new.
	self allClassesDo: [ :class |
		(class directlyDefinesLocalMethod: aSelector)
			ifTrue: [ classes add: class ] ].
	^ classes! !

!RBNamespace class methodsFor: 'instance creation' stamp: ''!
onEnvironment: aBrowserEnvironment 
	^(self new)
		environment: aBrowserEnvironment;
		yourself! !

!RBNamespaceTest methodsFor: 'class tests' stamp: 'lr 3/17/2010 18:51'!
testReferencesPrintOnAfterRemove
	| hasFoundObject hasFoundSelf smalltalk |
	hasFoundObject := false.
	hasFoundSelf := false.
	smalltalk := RBNamespace new.
	(smalltalk classNamed: #Object) 
		removeMethod: #printString.
	(smalltalk classNamed: self class name) 
		removeMethod: #testReferencesPrintOnAfterRemove.
	smalltalk allReferencesTo: #printOn: do: [ :each | 
		hasFoundObject := hasFoundObject
			or: [ each selector = #printString 
			and: [ each modelClass = (smalltalk classNamed: #Object) ] ].
		hasFoundSelf := hasFoundSelf
			or: [ each selector = #testReferencesPrintOnAfterRemove 
			and: [ each modelClass = (smalltalk classNamed: self class name) ] ] ].
	self deny: hasFoundObject.
	self deny: hasFoundSelf! !

!RBNamespaceTest methodsFor: 'class tests' stamp: 'NicolaiHess 4/4/2015 23:11'!
testModelImplementorsSenders
	| model class modelImps refs found |
	model := RBNamespace new.
	model 
		defineClass: 'Object subclass: #Asdf
			instanceVariableNames: ''''
			classVariableNames: ''''
			poolDictionaries: ''''
			category: #''Refactory-Testing'''.
	class := model classNamed: #Asdf.
	class compile: 'storeOn: aStream ^super storeOn: aStream'
		classified: #(#printing).
	modelImps := model allImplementorsOf: #storeOn:.
	self assert: (modelImps includes: class).
	self assert: modelImps size - 1 
				= (RBBrowserEnvironment new implementorsOf: #storeOn:) numberSelectors.
	refs := RBBrowserEnvironment new referencesTo: #storeOn:.
	found := false.
	model allReferencesTo: #storeOn:
		do: 
			[:each | 
			each modelClass = class 
				ifTrue: [found := true]
				ifFalse: 
					[	self flag:#todo. "temporary fix until RBEnvironments are fixed see issue 15287"
						each modelClass isMeta ifFalse:[self 
						assert: (refs includesSelector: each selector in: each modelClass realClass)]]].
	self assert: found
! !

!RBNamespaceTest methodsFor: 'class tests' stamp: 'bh 11/8/2000 14:13'!
testDefineClassChange
	| st |
	st := RBNamespace new.
	st 
		defineClass: 'RefactoringBrowserTest subclass: #SmalltalkTestXXX
				instanceVariableNames: ''''
				classVariableNames: ''''
				poolDictionaries: ''''
				category: #''Refactory-Testing'''.
	self assert: (st includesClassNamed: #SmalltalkTestXXX).
	self assert: (st classNamed: #SmalltalkTestXXX) notNil! !

!RBNamespaceTest methodsFor: 'class tests' stamp: 'bh 11/8/2000 14:13'!
testRedefineClassChange
	| st |
	st := RBNamespace new.
	st defineClass: 'nil subclass: #Object
				instanceVariableNames: ''a''
				classVariableNames: ''A''
				poolDictionaries: ''TextConstants''
				category: #''Refactory-Testing'''.
	self assert: (st includesClassNamed: #Object).
	self assert: (st classNamed: #Object) notNil! !

!RBNamespaceTest methodsFor: 'class tests' stamp: ''!
testReparentSuperclassChange
	| st superclass subclasses |
	st := RBNamespace new.
	superclass := st classFor: TestCase superclass.
	subclasses := TestCase subclasses collect: [:each | st classFor: each].
	st reparentClasses: subclasses to: superclass.
	subclasses do: [:each | self assert: each superclass = superclass]! !

!RBNamespaceTest methodsFor: 'class tests' stamp: 'lr 3/17/2010 18:50'!
testReferencesPrintOnAfterAddition
	| hasFoundObject hasFoundSelf smalltalk |
	hasFoundObject := false.
	hasFoundSelf := false.
	smalltalk := RBNamespace new.
	(smalltalk classNamed: #Object) 
		compile: 'someTestReference self printOn: nil'
		classified: #(testing).
	(smalltalk classNamed: self class name)
		compile: 'someTestReference ^ #printOn:'
		classified: #(testing).
	smalltalk allReferencesTo: #printOn: do: [ :each | 
		hasFoundObject := hasFoundObject 
			or: [ each selector = #someTestReference 
			and: [ each modelClass = (smalltalk classNamed: #Object) ] ].
		hasFoundSelf := hasFoundSelf
			or: [ each selector = #someTestReference 
			and: [ each modelClass = (smalltalk classNamed: self class name) ] ] ].
	self assert: hasFoundObject.
	self assert: hasFoundSelf! !

!RBNamespaceTest methodsFor: 'class tests' stamp: 'lr 9/8/2011 20:25'!
testAllClassesDo
	| model classes |
	classes := 0.
	model := RBNamespace new.
	model allClassesDo: 
			[:each | 
			each name = #Object ifTrue: [each allSubclasses].
			classes := classes + 1].
	RBBrowserEnvironment new classesDo: [:each | classes := classes - 1].
	self assert: classes = 0! !

!RBNamespaceTest methodsFor: 'class tests' stamp: 'lr 3/17/2010 18:52'!
testReferencesPrintOn
	| hasFoundObject hasFoundSelf smalltalk |
	hasFoundObject := false.
	hasFoundSelf := false.
	smalltalk := RBNamespace new.
	smalltalk allReferencesTo: #printOn: do: [ :each | 
		hasFoundObject := hasFoundObject
			or: [ each selector = #fullPrintString 
			and: [each modelClass = (smalltalk classNamed: #Object) ] ].
		hasFoundSelf := hasFoundSelf
			or: [ each selector = #testReferencesPrintOn 
			and: [ each modelClass = (smalltalk classNamed: self class name) ] ] ].
	self assert: hasFoundObject.
	self assert: hasFoundSelf! !

!RBNamespaceTest methodsFor: 'class tests' stamp: 'bh 4/3/2000 15:47'!
testRoots
	| model |
	model := RBNamespace new.
	self 
		assert: (model rootClasses asSortedCollection: [:a :b | a name < b name]) 
				asArray 
					= ((Class rootsOfTheWorld collect: [:each | model classFor: each]) 
							asSortedCollection: [:a :b | a name < b name]) asArray! !

!RBNamespaceTest methodsFor: 'class tests' stamp: ''!
testDefineClassAfterDeletedChange
	| st |
	st := RBNamespace new.
	st removeClassNamed: self class name.
	self deny: (st includesClassNamed: self class name).
	st defineClass: self class definition.
	self assert: (st includesClassNamed: self class name).
	self assert: (st classNamed: self class name) notNil! !

!RBNamespaceTest methodsFor: 'class tests' stamp: 'lr 9/8/2011 20:32'!
testIncludesClass
	self assert: (RBNamespace new includesClassNamed: #Object).
	self deny: (RBNamespace new includesClassNamed: #Object1).
	self 
		deny: ((RBNamespace 
				onEnvironment: (RBClassEnvironment onEnvironment: RBBrowserEnvironment new
						classes: (Array with: Object))) 
					includesClassNamed: #OrderedCollection)! !

!RBNamespaceTest methodsFor: 'class tests' stamp: ''!
testRemoveClassChange
	| st |
	st := RBNamespace new.
	st removeClassNamed: self class name.
	self deny: (st includesClassNamed: self class name).
	self assert: (st classNamed: self class name) isNil! !

!RBNamespaceTest methodsFor: 'class tests' stamp: 'lr 7/1/2008 11:11'!
testCommentChange
	| st cl |
	st := RBNamespace new.
	cl := st classNamed: self class name.
	self assert: cl comment isString.
	cl comment: 'a comment'.
	self assert: cl comment = 'a comment'.
	self assert: st changes changes size = 1.
	self assert: st changes changes first comment = 'a comment'.
	cl comment: nil.
	self assert: cl comment isNil.
	self assert: st changes changes size = 2.
	self assert: st changes changes last comment isNil! !

!RBNamespaceTest methodsFor: 'class tests' stamp: ''!
testImplementors
	| st |
	st := RBNamespace new.
	self assert: ((st allImplementorsOf: #printString) 
				includes: (st classNamed: #Object)).
	(st classNamed: #Object) removeMethod: #printString.
	self deny: ((st allImplementorsOf: #printString) 
				includes: (st classNamed: #Object))! !

!RBNegationCondition methodsFor: 'printing' stamp: ''!
printOn: aStream 
	aStream nextPutAll: 'NOT ';
		print: condition! !

!RBNegationCondition methodsFor: 'initialize-release' stamp: ''!
condition: aCondition 
	condition := aCondition.
	self errorMacro: condition errorMacro! !

!RBNegationCondition methodsFor: 'private' stamp: ''!
errorBlockFor: aBoolean 
	^condition errorBlockFor: aBoolean not! !

!RBNegationCondition methodsFor: 'checking' stamp: ''!
check
	^condition check not! !

!RBNegationCondition methodsFor: 'private' stamp: ''!
errorStringFor: aBoolean 
	^condition errorStringFor: aBoolean not! !

!RBNegationCondition class methodsFor: 'instance creation' stamp: ''!
on: aCondition
	^self new condition: aCondition! !

!RBNoClassCommentRule commentStamp: 'StephaneDucasse 11/29/2014 20:50'!
This smell arises when a class has no comment. Classes should have comments to explain their purpose, collaborations with other classes, and optionally provide examples of use.!
!RBNoClassCommentRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'!
resultClass
	^ RBClassEnvironment! !

!RBNoClassCommentRule methodsFor: 'accessing' stamp: 'SeanDeNigris 1/31/2013 09:23'!
rationale
	^ 'Classes should have comments to explain their purpose, collaborations with other classes, and optionally provide examples of use.'! !

!RBNoClassCommentRule methodsFor: 'accessing' stamp: 'cyrille.delaunay 8/11/2010 16:50'!
group
	^ 'Miscellaneous'! !

!RBNoClassCommentRule methodsFor: 'accessing' stamp: 'cyrille.delaunay 8/11/2010 16:51'!
name
	^ 'No class comment'! !

!RBNoClassCommentRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 10:32'!
category 
	^ 'Coding Idiom Violation'! !

!RBNoClassCommentRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:50'!
checkClass: aClass
	(aClass isMeta or: [ aClass inheritsFrom: TestCase ])
		ifTrue: [ ^ self ].
	aClass organization classComment isEmpty ifTrue: [ 
		result 
			addClass: aClass; 
			addClass: aClass class ]! !

!RBNoClassCommentRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'NoClassCommentRule'! !

!RBNotEliminationRule commentStamp: 'StephaneDucasse 11/29/2014 18:38'!
Eliminate unnecessary not''s in relation of conditionals.
For example test not ifTrue:[] is equivalent to test ifFalse:[]' 

[[[
anObject not ifFalse: block'
]]]

is transformed into

[[[  
anObject ifTrue: block'
]]]

[[[
aCollection select: [ :each | ... anObject not ] 
]]]
	
is transformed into 	

[[[
aCollection reject: [ :each | ... anObject ] 
]]]!
!RBNotEliminationRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:38'!
initialize
	super initialize.
	self rewriteRule
		replace: '``@object not not' with: '``@object';
		replace: '``@object not ifTrue: ``@block' with: '``@object ifFalse: ``@block';
		replace: '``@object not ifFalse: ``@block' with: '``@object ifTrue: ``@block';
		replace: '``@collection select: [:`each | | `@temps | ``@.Statements. ``@object not]'
			with: '``@collection reject: [:`each | | `@temps | ``@.Statements. ``@object]';
		replace: '``@collection reject: [:`each | | `@temps | ``@.Statements. ``@object not]'
			with: '``@collection select: [:`each | | `@temps | ``@.Statements. ``@object]';
		replace: '[| `@temps | ``@.Statements. ``@object not] whileTrue: ``@block'
			with: '[| `@temps | ``@.Statements. ``@object] whileFalse: ``@block';
		replace: '[| `@temps | ``@.Statements. ``@object not] whileFalse: ``@block'
			with: '[| `@temps | ``@.Statements. ``@object] whileTrue: ``@block';
		replace: '[| `@temps | ``@.Statements. ``@object not] whileTrue'
			with: '[| `@temps | ``@.Statements. ``@object] whileFalse';
		replace: '[| `@temps | ``@.Statements. ``@object not] whileFalse'
			with: '[| `@temps | ``@.Statements. ``@object] whileTrue';
		replace: '(``@a <= ``@b) not' with: '``@a > ``@b';
		replace: '(``@a < ``@b) not' with: '``@a >= ``@b';
		replace: '(``@a = ``@b) not' with: '``@a ~= ``@b';
		replace: '(``@a == ``@b) not' with: '``@a ~~ ``@b';
		replace: '(``@a ~= ``@b) not' with: '``@a = ``@b';
		replace: '(``@a ~~ ``@b) not' with: '``@a == ``@b';
		replace: '(``@a >= ``@b) not' with: '``@a < ``@b';
		replace: '(``@a > ``@b) not' with: '``@a <= ``@b'! !

!RBNotEliminationRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 18:23'!
rationale  
	^ 'Eliminate unnecessary not''s in relation of conditionals'! !

!RBNotEliminationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Transformations'! !

!RBNotEliminationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Eliminate unnecessary not''s'! !

!RBNotEliminationRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:51'!
category 
	^ 'Optimization'! !

!RBNotEliminationRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'NotEliminationRule'! !

!RBNotEnvironment methodsFor: 'testing' stamp: ''!
includesClass: aClass 
	(environment includesClass: aClass) ifFalse: [^true].
	aClass selectorsAndMethodsDo: 
			[:each :meth | 
			(environment includesSelector: each in: aClass) ifFalse: [^true]].
	^false! !

!RBNotEnvironment methodsFor: 'testing' stamp: 'CamilloBruni 8/27/2013 02:19'!
includesProtocol: aProtocol in: aClass 
	^(aClass organization protocolOrganizer getProtocolNamed: aProtocol ifNone: [ ^ false ])
		methods anySatisfy: [ :selector | 
			self includesSelector: selector in: aClass ]! !

!RBNotEnvironment methodsFor: 'printing' stamp: ''!
storeOn: aStream
	environment storeOn: aStream.
	aStream nextPutAll: ' not'! !

!RBNotEnvironment methodsFor: 'testing' stamp: ''!
includesCategory: aCategory 
	^(self classNamesFor: aCategory) isEmpty not! !

!RBNotEnvironment methodsFor: 'environments' stamp: ''!
not
	^environment! !

!RBNotEnvironment methodsFor: 'testing' stamp: ''!
includesSelector: aSelector in: aClass
	^(environment includesSelector: aSelector in: aClass) not! !

!RBNotEnvironment methodsFor: 'testing' stamp: 'YuriyTymchuk 7/3/2014 11:19'!
definesClass: aClass 
	^ (environment definesClass: aClass) not! !

!RBNumberLiteralToken methodsFor: 'testing' stamp: 'PabloHerrero 10/25/2013 16:52'!
isNumberLiteralToken
	^true.! !

!RBNumberLiteralToken methodsFor: 'initialize-release' stamp: ''!
source: aString 
	source := aString! !

!RBNumberLiteralToken methodsFor: 'accessing' stamp: ''!
source
	^source! !

!RBNumberLiteralToken methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPutAll: source! !

!RBNumberLiteralToken class methodsFor: 'instance creation' stamp: ''!
value: aNumber start: anInteger stop: stopInteger source: sourceString 
	^(self 
		value: aNumber
		start: anInteger
		stop: stopInteger)
		source: sourceString;
		yourself! !

!RBOnlyReadOrWrittenTemporaryRule commentStamp: 'StephaneDucasse 11/29/2014 23:08'!
Checks that all temporary variables are both read and written. If an temporary variable is only read, you can replace all of the reads with nil, since it couldn''t have been assigned a value. If the variable is only written, then we don''t need to store the result since we never use it.!
!RBOnlyReadOrWrittenTemporaryRule methodsFor: 'initialization' stamp: 'lr 6/4/2010 14:31'!
initialize
	super initialize.
	self matcher
		matches: '| `@temps | ``@.stmts'
		do: [ :sequence :answer |
			answer isNil
				ifFalse: [ answer ]
				ifTrue: [
					sequence temporaries
						detect: [ :temp |
							| isRead isWritten |
							isRead := false.
							isWritten := false.
							sequence statements do: [ :statement | 
								statement nodesDo: [ :node |
									(node isVariable and: [ node name = temp name ]) ifTrue: [
										isRead := isRead or: [ node isUsed ].
										isWritten := isWritten or: [ node isWrite ] ] ] ].
							(isRead and: [ isWritten ]) not ]
						ifNone: [ nil ] ] ]! !

!RBOnlyReadOrWrittenTemporaryRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 23:08'!
rationale
	^ 'Checks that all temporary variables are both read and written.'! !

!RBOnlyReadOrWrittenTemporaryRule methodsFor: 'accessing' stamp: 'lr 6/4/2010 12:10'!
group
	^ 'Unnecessary code'! !

!RBOnlyReadOrWrittenTemporaryRule methodsFor: 'accessing' stamp: 'lr 6/4/2010 12:10'!
severity
	^ #information! !

!RBOnlyReadOrWrittenTemporaryRule methodsFor: 'accessing' stamp: 'lr 6/4/2010 12:10'!
name
	^ 'Temporary variables not read AND written'! !

!RBOnlyReadOrWrittenTemporaryRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:26'!
category 
	^ 'Optimization'! !

!RBOnlyReadOrWrittenTemporaryRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'OnlyReadOrWrittenTemporaryRule'! !

!RBOnlyReadOrWrittenVariableRule commentStamp: 'StephaneDucasse 11/29/2014 20:49'!
This smell arises when an instance variable is not both read and written. If an instance variable is only read, the reads can be replaced by nil, since it could not have been assigned a value. If the variable is only written, then it does not need to store the result since it is never used. This check does not work for the data model classes since they use the #instVarAt:put: messages to set instance variables.!
!RBOnlyReadOrWrittenVariableRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'!
resultClass
	^ RBVariableEnvironment! !

!RBOnlyReadOrWrittenVariableRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Unnecessary code'! !

!RBOnlyReadOrWrittenVariableRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:10'!
severity
	^ #information! !

!RBOnlyReadOrWrittenVariableRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 10:33'!
category 	
	^ 'Optimization'! !

!RBOnlyReadOrWrittenVariableRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Instance variables not read AND written'! !

!RBOnlyReadOrWrittenVariableRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:50'!
checkClass: aClass 
	| allSubclasses |
	allSubclasses := aClass withAllSubclasses.
	aClass instVarNames do: [ :each | 
		| isRead isWritten |
		isRead := false.
		isWritten := false.
		allSubclasses 
			detect: [ :class | 
				isRead ifFalse: [ isRead := (class whichSelectorsRead: each) isEmpty not ].
				isWritten ifFalse: [ isWritten := (class whichSelectorsAssign: each) isEmpty not ].
				isRead and: [ isWritten ] ]
			ifNone: [
				result 
					addClass: aClass
					instanceVariable: each ] ]! !

!RBOnlyReadOrWrittenVariableRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'OnlyReadOrWrittenVariableRule'! !

!RBOrEnvironment methodsFor: 'testing' stamp: 'lr 11/25/2009 00:53'!
includesClass: aClass
	(environment includesClass: aClass) ifTrue: [ ^ true ].
	(orEnvironment includesClass: aClass) ifTrue: [ ^ true ].
	(environment selectorsForClass: aClass) isEmpty ifFalse: [ ^ true ].
	(orEnvironment selectorsForClass: aClass) isEmpty ifFalse: [ ^ true ].
	^ false! !

!RBOrEnvironment methodsFor: 'accessing' stamp: 'lr 11/25/2009 08:25'!
classesDo: aBlock
	| enumerated |
	enumerated := IdentitySet new.
	environment classesDo: [ :each | 
		aBlock value: each.
		enumerated add: each].
	orEnvironment classesDo: [ :each | 
		(enumerated includes: each) 
			ifFalse: [ aBlock value: each ] ]! !

!RBOrEnvironment methodsFor: 'testing' stamp: 'lr 11/25/2009 00:53'!
includesProtocol: aProtocol in: aClass
	^ (environment includesProtocol: aProtocol in: aClass)
		or: [ orEnvironment includesProtocol: aProtocol in: aClass ]! !

!RBOrEnvironment methodsFor: 'printing' stamp: 'lr 11/25/2009 00:51'!
storeOn: aStream 
	aStream nextPut: $(.
	environment storeOn: aStream.
	aStream nextPutAll: ' | '.
	orEnvironment storeOn: aStream.
	aStream nextPut: $)! !

!RBOrEnvironment methodsFor: 'accessing' stamp: 'lr 11/25/2009 00:54'!
selectionIntervalFor: aString
	^ (environment selectionIntervalFor: aString)
		ifNil: [ orEnvironment selectionIntervalFor: aString ]! !

!RBOrEnvironment methodsFor: 'testing' stamp: 'lr 11/25/2009 08:26'!
includesCategory: aCategory 
	^ (environment includesCategory: aCategory)
		or: [ orEnvironment includesCategory: aCategory ]! !

!RBOrEnvironment methodsFor: 'initialization' stamp: 'lr 11/25/2009 00:49'!
orEnvironment: aBrowserEnvironment 
	orEnvironment := aBrowserEnvironment! !

!RBOrEnvironment methodsFor: 'accessing' stamp: 'lr 11/25/2009 08:26'!
selectorsForClass: aClass do: aBlock
	| enumerated |
	enumerated := IdentitySet new.
	environment
		selectorsForClass: aClass
		do: [ :each | 
			enumerated add: each.
			aBlock value: each ].
	orEnvironment
		selectorsForClass: aClass
		do: [:each | 
			(enumerated includes: each) 
				ifFalse: [ aBlock value: each ] ]! !

!RBOrEnvironment methodsFor: 'testing' stamp: 'lr 11/25/2009 00:53'!
includesSelector: aSelector in: aClass
	^ (environment includesSelector: aSelector in: aClass)
		or: [ orEnvironment includesSelector: aSelector in: aClass ]! !

!RBOrEnvironment methodsFor: 'testing' stamp: 'YuriyTymchuk 7/3/2014 11:20'!
definesClass: aClass
	^ (environment definesClass: aClass) or: [ 
		orEnvironment definesClass: aClass ]! !

!RBOrEnvironment class methodsFor: 'instance creation' stamp: 'lr 11/25/2009 00:51'!
onEnvironment: anEnvironment or: anotherEnvironment
	^ (self onEnvironment: anEnvironment)
		orEnvironment: anotherEnvironment;
		yourself! !

!RBOverridesSpecialMessageRule commentStamp: 'StephaneDucasse 11/29/2014 20:30'!
Checks that a class does not override a message that is essential to the base system. For example, if you override the #class method from object, you are likely to crash your image. #classShouldNotOverride returns the list of messages which should not be overriden.!
!RBOverridesSpecialMessageRule methodsFor: 'private' stamp: 'lr 2/24/2009 20:12'!
classShouldNotOverride
	^ #( #== #~~ #class #basicAt: #basicAt:put: #basicSize #identityHash )! !

!RBOverridesSpecialMessageRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 10:34'!
category
	^ 'Bugs'! !

!RBOverridesSpecialMessageRule methodsFor: 'accessing' stamp: 'SimonAllier 9/12/2012 11:28'!
longDescription 

	^ 'Checks that a class does not override a message that is essential to the base system. For example, if you override the #class method from object, you are likely to crash your image.
In the class the messages we should not override are: ',  (', ' join: (self classShouldNotOverride) ),'.
In the class side the messages we should not override are: ',  (', ' join: (self metaclassShouldNotOverride) ),'.' ! !

!RBOverridesSpecialMessageRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Bugs'! !

!RBOverridesSpecialMessageRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:04'!
severity
	^ #error! !

!RBOverridesSpecialMessageRule methodsFor: 'private' stamp: 'lr 2/24/2009 20:13'!
metaclassShouldNotOverride
	^ #( #basicNew #basicNew #class #comment #name )! !

!RBOverridesSpecialMessageRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Overrides a "special" message'! !

!RBOverridesSpecialMessageRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:50'!
checkClass: aClass 
	| selectors |
	selectors := aClass isMeta 
		ifTrue: [ self metaclassShouldNotOverride ]
		ifFalse: [ self classShouldNotOverride ].
	selectors do: [ :each |
		(aClass superclass notNil
			and: [ (aClass superclass canUnderstand: each)
			and: [ (aClass includesSelector: each) ] ])
				ifTrue: [ result addClass: aClass selector: each ] ]! !

!RBOverridesSpecialMessageRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'OverridesSpecialMessageRule'! !

!RBPackageEnvironment methodsFor: 'testing' stamp: 'CamilloBruni 7/7/2013 18:33'!
includesClass: aClass
	^ (super includesClass: aClass) and: [ 
		self packages anySatisfy: [ :package | 
			(package includesClass: aClass) or: [ 
			(package extensionCategoriesForClass: aClass) notEmpty ]]]! !

!RBPackageEnvironment methodsFor: 'accessing' stamp: 'YuriyTymchuk 9/30/2014 10:52'!
classesDo: aBlock
	| enumerated enumerator |
	enumerated := IdentitySet new.
	enumerator := [ :each |
		(enumerated includes: each) ifFalse: [
			(environment includesClass: each)
				ifTrue: [ aBlock value: each ].
			enumerated add: each ] ].
	packages do: [ :package |
		package classes do: enumerator.
		package extensionClasses do: enumerator ]! !

!RBPackageEnvironment methodsFor: 'accessing' stamp: 'lr 11/25/2009 08:49'!
packageNames
	^ packages collect: [ :each | each packageName ]! !

!RBPackageEnvironment methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'!
asSelectorEnvironment
	| result |
	result := RBSelectorEnvironment onEnvironment: environment.
	self classesAndSelectorsDo: [ :class :selector | result addClass: class selector: selector ].
	^ result! !

!RBPackageEnvironment methodsFor: 'printing' stamp: 'TestRunner 12/23/2009 21:22'!
storeOn: aStream 
	aStream nextPut: $(; nextPutAll: self class name; nextPutAll: ' onEnvironment: '.
	environment storeOn: aStream.
	aStream nextPutAll: ' packageNames: '.
	self packageNames asArray storeOn: aStream.
	aStream nextPut: $)! !

!RBPackageEnvironment methodsFor: 'testing' stamp: 'CamilloBruni 7/7/2013 18:34'!
includesCategory: aCategory
	^ (super includesCategory: aCategory) and: [ 
		self packages anySatisfy: [ :package | 
			package includesSystemCategory: aCategory ] ]! !

!RBPackageEnvironment methodsFor: 'testing' stamp: 'CamilloBruni 8/27/2013 01:49'!
includesSelector: aSelector in: aClass
	^ (environment includesSelector: aSelector in: aClass) 
		and: [ self packages anySatisfy: [ :package | 
				package includesSelector: aSelector ofClass: aClass ] ]! !

!RBPackageEnvironment methodsFor: 'accessing' stamp: 'lr 11/25/2009 08:46'!
packages
	^ packages! !

!RBPackageEnvironment methodsFor: 'testing' stamp: 'lr 5/15/2010 09:39'!
definesClass: aClass
	^ (super definesClass: aClass) and: [ self packages anySatisfy: [ :package | package includesClass: aClass ] ]! !

!RBPackageEnvironment methodsFor: 'initialize-release' stamp: 'lr 12/20/2009 09:29'!
packages: aCollection
	packages addAll: aCollection! !

!RBPackageEnvironment methodsFor: 'accessing' stamp: 'CamilloBruni 8/27/2013 01:42'!
classesAndSelectorsDo: aBlock
	packages do: [ :package |
		package methods do: [ :method |
			(environment includesSelector: method selector in: method methodClass)
				ifTrue: [ aBlock value: method methodClass value: method selector ] ] ]! !

!RBPackageEnvironment methodsFor: 'initialization' stamp: 'lr 4/12/2010 15:25'!
initialize
	super initialize.
	packages := Set new! !

!RBPackageEnvironment methodsFor: 'testing' stamp: 'lr 12/3/2009 10:13'!
includesProtocol: aProtocol in: aClass
	^ (environment includesProtocol: aProtocol in: aClass) and: [ self packages anySatisfy: [ :package | package includesMethodCategory: aProtocol ofClass: aClass ] ]! !

!RBPackageEnvironment methodsFor: 'copying' stamp: 'lr 4/12/2010 15:26'!
postCopy
	super postCopy.
	packages := packages copy! !

!RBPackageEnvironment methodsFor: 'printing' stamp: 'CamilloBruni 8/27/2013 01:36'!
printOn: aStream 
	self storeOn: aStream! !

!RBPackageEnvironment class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/2/2013 23:24'!
packageName: aName
	^ self packageNames: { aName }! !

!RBPackageEnvironment class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/2/2013 23:22'!
packageNames: aCollection
	^ self 
		onEnvironment: self default
		packageNames: aCollection! !

!RBPackageEnvironment class methodsFor: 'instance creation' stamp: 'lr 11/25/2009 08:54'!
onEnvironment: anEnvironment packages: aCollection
	^ (self onEnvironment: anEnvironment)
		packages: aCollection;
		yourself! !

!RBPackageEnvironment class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/2/2013 23:24'!
package: aPackage
	^ self packages: { aPackage }! !

!RBPackageEnvironment class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/2/2013 23:22'!
packages: aCollection
	^ self 
		onEnvironment: self default
		packages: aCollection! !

!RBPackageEnvironment class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/27/2013 01:39'!
onEnvironment: anEnvironment packageNames: aCollection
	^ self 
		onEnvironment: anEnvironment
		packages: (aCollection collect: [ :each | 
			RPackageOrganizer default packageNamed: each ])! !

!RBParseErrorNode commentStamp: '<historical>'!
I am a node representing a source code segement that could not be parsed. I am manly used for source-code coloring where we should parse as far as possible and mark the rest as a failure.!
!RBParseErrorNode methodsFor: 'accessing' stamp: 'PabloHerrero 10/23/2013 17:29'!
value
	^value.! !

!RBParseErrorNode methodsFor: 'accessing' stamp: 'PabloHerrero 10/23/2013 17:30'!
value: aString
	value := aString.! !

!RBParseErrorNode methodsFor: 'accessing' stamp: 'CamilloBruni 10/31/2012 18:52'!
errorMessage
	^ errorMessage! !

!RBParseErrorNode methodsFor: 'accessing' stamp: 'PabloHerrero 10/23/2013 18:37'!
start
	^ start! !

!RBParseErrorNode methodsFor: 'accessing' stamp: 'PabloHerrero 2/10/2015 19:04'!
start: aPosition
	start := aPosition! !

!RBParseErrorNode methodsFor: 'accessing' stamp: 'PabloHerrero 11/8/2013 13:57'!
stop
	^ start + value size - 1.! !

!RBParseErrorNode methodsFor: 'accessing' stamp: 'GiselaDecuzzi 6/5/2013 10:30'!
isFaulty
	^true.! !

!RBParseErrorNode methodsFor: 'accessing' stamp: 'CamilloBruni 10/31/2012 18:52'!
errorMessage: anObject
	errorMessage := anObject! !

!RBParseErrorNode methodsFor: 'accessing' stamp: 'g 6/24/2013 18:03'!
binding: anOCTempVariable 
	"only for compatibility"
	! !

!RBParseErrorNode methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:37'!
acceptVisitor: aProgramNodeVisitor
	^ aProgramNodeVisitor visitParseErrorNode: self.! !

!RBParseErrorNode class methodsFor: 'instance creation' stamp: 'PabloHerrero 10/23/2013 17:31'!
errorMessage: aString value: aValue at: aPosition

	^ self new
		errorMessage: aString;
		value: aValue;
		start: aPosition;
		yourself! !

!RBParseTreeEnvironment methodsFor: 'initialize-release' stamp: ''!
matcher: aParseTreeSearcher
	matcher := aParseTreeSearcher! !

!RBParseTreeEnvironment methodsFor: 'accessing' stamp: 'lr 5/14/2010 13:42'!
selectionIntervalFor: aString 
	| parseTree node |
	matcher isNil 
		ifTrue: [ ^ super selectionIntervalFor: aString ].
	parseTree := RBParser
		parseMethod: aString
		onError: [ :error :position | ^ super selectionIntervalFor: aString ].
	node := matcher executeTree: parseTree initialAnswer: nil.
	^ (node isKindOf: RBProgramNode)
		ifTrue: [ node sourceInterval ]
		ifFalse: [ super selectionIntervalFor: aString ]! !

!RBParseTreeLintRule commentStamp: '<historical>'!
A RBParseTreeLintRule is a rule that is expressed using a parse tree matcher on a method AST.!
!RBParseTreeLintRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:15'!
resultClass
	^ RBParseTreeEnvironment! !

!RBParseTreeLintRule methodsFor: 'initialization' stamp: 'lr 11/2/2009 00:14'!
initialize
	super initialize.
	matcher := RBParseTreeSearcher new! !

!RBParseTreeLintRule methodsFor: 'accessing' stamp: 'lr 2/24/2009 00:01'!
matcher
	^ matcher! !

!RBParseTreeLintRule methodsFor: 'running' stamp: 'lr 2/24/2009 08:21'!
resetResult
	super resetResult.
	self result matcher: self matcher! !

!RBParseTreeLintRule methodsFor: 'running' stamp: 'MarcusDenker 10/27/2014 17:56'!
checkMethod: aMethod 
	(self matcher canMatchMethod: aMethod) 
		ifFalse: [ ^ self ].
	(self matcher executeTree: aMethod ast initialAnswer: nil) isNil 
		ifFalse: [ result addMethod: aMethod ]! !

!RBParseTreeLintRule class methodsFor: 'testing' stamp: 'lr 2/24/2009 17:09'!
isVisible
	^ self name ~= #RBParseTreeLintRule! !

!RBParseTreeLintRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'ParseTreeLintRule'! !

!RBParseTreeRewriter commentStamp: '<historical>'!
ParseTreeRewriter walks over and transforms its RBProgramNode (tree). If the tree is modified, then answer is set to true, and the modified tree can be retrieved by the #tree method.

Instance Variables:
	tree	<RBProgramNode>	the parse tree we're transforming!
!RBParseTreeRewriter methodsFor: 'replacing' stamp: ''!
replaceArgument: searchString withValueFrom: replaceBlock 
	self addArgumentRule: (RBBlockReplaceRule searchFor: searchString
				replaceWith: replaceBlock)! !

!RBParseTreeRewriter methodsFor: 'replacing' stamp: ''!
replaceTree: searchTree withTree: replaceTree when: aBlock 
	self addRule: (RBStringReplaceRule 
				searchForTree: searchTree
				replaceWith: replaceTree
				when: aBlock)! !

!RBParseTreeRewriter methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 16:29'!
visitArgumentNodes: aNodeCollection 
	^aNodeCollection collect: [:each | self visitArgumentNode: each]! !

!RBParseTreeRewriter methodsFor: 'private' stamp: ''!
foundMatch
	answer := true! !

!RBParseTreeRewriter methodsFor: 'visitor-double dispatching' stamp: 'StephaneDucasse 3/29/2013 16:28'!
visitCascadeNode: aCascadeNode 
	| newMessages notFound |
	newMessages := OrderedCollection new: aCascadeNode messages size.
	notFound := OrderedCollection new: aCascadeNode messages size.
	aCascadeNode messages do: 
			[:each | 
			| newNode |
			newNode := self performSearches: searches on: each.
			newNode isNil 
				ifTrue: 
					[newNode := each.
					notFound add: newNode].
			newNode isMessage 
				ifTrue: [newMessages add: newNode]
				ifFalse: 
					[newNode isCascade 
						ifTrue: [newMessages addAll: newNode messages]
						ifFalse: 
							[Transcript
								show: 'Cannot replace message node inside of cascaded node with non-message node.';
								cr.
							newMessages add: each]]].
	notFound size = aCascadeNode messages size 
		ifTrue: 
			[| receiver |
			receiver := self visitNode: aCascadeNode messages first receiver.
			newMessages do: [:each | each receiver: receiver]].
	notFound 
		do: [:each | each arguments: (each arguments collect: [:arg | self visitNode: arg])].
	aCascadeNode messages: newMessages! !

!RBParseTreeRewriter methodsFor: 'visitor-double dispatching' stamp: 'StephaneDucasse 3/29/2013 16:32'!
visitMessageNode: aMessageNode
	aMessageNode receiver: (self visitNode: aMessageNode receiver).
	aMessageNode arguments: (aMessageNode arguments collect: [ :each | self visitNode: each ])! !

!RBParseTreeRewriter methodsFor: 'replacing' stamp: ''!
replace: searchString with: replaceString when: aBlock 
	self addRule: (RBStringReplaceRule 
				searchFor: searchString
				replaceWith: replaceString
				when: aBlock)! !

!RBParseTreeRewriter methodsFor: 'replacing' stamp: ''!
replaceMethod: searchString withValueFrom: replaceBlock when: conditionBlock 
	self addRule: (RBBlockReplaceRule 
				searchForMethod: searchString
				replaceWith: replaceBlock
				when: conditionBlock)! !

!RBParseTreeRewriter methodsFor: 'replacing' stamp: ''!
replaceTree: searchTree withTree: replaceTree 
	self addRule: (RBStringReplaceRule searchForTree: searchTree
				replaceWith: replaceTree)! !

!RBParseTreeRewriter methodsFor: 'replacing' stamp: ''!
replace: searchString withValueFrom: replaceBlock 
	self addRule: (RBBlockReplaceRule searchFor: searchString
				replaceWith: replaceBlock)! !

!RBParseTreeRewriter methodsFor: 'visitor-double dispatching' stamp: 'StephaneDucasse 3/29/2013 16:30'!
visitArrayNode: anArrayNode
	anArrayNode statements: (anArrayNode statements collect: [:each | self visitNode: each])! !

!RBParseTreeRewriter methodsFor: 'visitor-double dispatching' stamp: 'StephaneDucasse 3/29/2013 16:28'!
visitBlockNode: aBlockNode 
	aBlockNode arguments: (self visitArgumentNodes: aBlockNode arguments).
	aBlockNode body: (self visitNode: aBlockNode body)! !

!RBParseTreeRewriter methodsFor: 'visitor-double dispatching' stamp: 'StephaneDucasse 3/29/2013 16:32'!
visitMethodNode: aMethodNode
	aMethodNode arguments: (self visitArgumentNodes: aMethodNode arguments).
	aMethodNode pragmas: (aMethodNode pragmas collect: [ :each | self visitNode: each ]).
	aMethodNode body: (self visitNode: aMethodNode body)! !

!RBParseTreeRewriter methodsFor: 'visitor-double dispatching' stamp: 'StephaneDucasse 3/29/2013 16:32'!
visitLiteralArrayNode: aRBArrayLiteralNode
	aRBArrayLiteralNode contents: (aRBArrayLiteralNode contents collect: [ :each | self visitNode: each ])! !

!RBParseTreeRewriter methodsFor: 'replacing' stamp: ''!
replaceArgument: searchString withValueFrom: replaceBlock when: conditionBlock 
	self addArgumentRule: (RBBlockReplaceRule 
				searchFor: searchString
				replaceWith: replaceBlock
				when: conditionBlock)! !

!RBParseTreeRewriter methodsFor: 'visitor-double dispatching' stamp: 'StephaneDucasse 3/29/2013 16:32'!
visitPragmaNode: aPragmaNode
	aPragmaNode arguments: (aPragmaNode arguments collect: [ :each | self visitNode: each ])! !

!RBParseTreeRewriter methodsFor: 'replacing' stamp: ''!
replaceMethod: searchString with: replaceString 
	self addRule: (RBStringReplaceRule searchForMethod: searchString
				replaceWith: replaceString)! !

!RBParseTreeRewriter methodsFor: 'replacing' stamp: ''!
replaceArgument: searchString with: replaceString when: aBlock 
	self addArgumentRule: (RBStringReplaceRule 
				searchFor: searchString
				replaceWith: replaceString
				when: aBlock)! !

!RBParseTreeRewriter methodsFor: 'replacing' stamp: ''!
replaceArgument: searchString with: replaceString 
	self addArgumentRule: (RBStringReplaceRule searchFor: searchString
				replaceWith: replaceString)! !

!RBParseTreeRewriter methodsFor: 'visitor-double dispatching' stamp: 'StephaneDucasse 3/29/2013 16:31'!
visitSequenceNode: aSequenceNode
	aSequenceNode temporaries: (self visitTemporaryNodes: aSequenceNode temporaries).
	aSequenceNode statements: (aSequenceNode statements collect: [ :each | self visitNode: each ])! !

!RBParseTreeRewriter methodsFor: 'replacing' stamp: ''!
replace: searchString withValueFrom: replaceBlock when: conditionBlock 
	self addRule: (RBBlockReplaceRule 
				searchFor: searchString
				replaceWith: replaceBlock
				when: conditionBlock)! !

!RBParseTreeRewriter methodsFor: 'accessing' stamp: ''!
tree
	^tree! !

!RBParseTreeRewriter methodsFor: 'replacing' stamp: ''!
replace: searchString with: replaceString 
	self addRule: (RBStringReplaceRule searchFor: searchString
				replaceWith: replaceString)! !

!RBParseTreeRewriter methodsFor: 'visitor-double dispatching' stamp: 'StephaneDucasse 3/29/2013 16:28'!
visitAssignmentNode: anAssignmentNode 
	anAssignmentNode variable: (self visitNode: anAssignmentNode variable).
	anAssignmentNode value: (self visitNode: anAssignmentNode value)! !

!RBParseTreeRewriter methodsFor: 'replacing' stamp: ''!
replaceMethod: searchString with: replaceString when: aBlock 
	self addRule: (RBStringReplaceRule 
				searchForMethod: searchString
				replaceWith: replaceString
				when: aBlock)! !

!RBParseTreeRewriter methodsFor: 'accessing' stamp: 'MarcusDenker 3/25/2013 21:02'!
executeTree: aParseTree 
	| oldContext |
	oldContext := context.
	context := SmallDictionary new.
	answer := false.
	tree := self visitNode: aParseTree.
	context := oldContext.
	^answer! !

!RBParseTreeRewriter methodsFor: 'replacing' stamp: ''!
replaceMethod: searchString withValueFrom: replaceBlock 
	self addRule: (RBBlockReplaceRule searchForMethod: searchString
				replaceWith: replaceBlock)! !

!RBParseTreeRewriter methodsFor: 'visitor-double dispatching' stamp: 'StephaneDucasse 3/29/2013 16:29'!
visitReturnNode: aReturnNode 
	aReturnNode value: (self visitNode: aReturnNode value)! !

!RBParseTreeRewriter methodsFor: 'private' stamp: 'CamilloBruni 8/31/2013 20:51'!
lookForMoreMatchesInContext: oldContext 
	oldContext keysAndValuesDo: [:key :value | 
		(key isString not and: [key recurseInto]) 
			ifTrue: 
				[oldContext at: key put: (value collect: [:each | self visitNode: each])]]! !

!RBParseTreeRewriter class methodsFor: 'instance creation' stamp: ''!
rename: varName to: newVarName handler: aBlock 
	"Rename varName to newVarName, evaluating aBlock if there is a 
	temporary variable with the same name as newVarName. This 
	does not change temporary variables with varName."

	| rewriteRule |
	rewriteRule := self new.
	rewriteRule
		replace: varName with: newVarName;
		replaceArgument: newVarName
			withValueFrom: 
				[:aNode | 
				aBlock value.
				aNode].
	^rewriteRule! !

!RBParseTreeRewriter class methodsFor: 'accessing' stamp: ''!
replace: code with: newCode in: aParseTree onInterval: anInterval 
	| rewriteRule |
	rewriteRule := self new.
	^rewriteRule
		replace: code
			with: newCode
			when: [:aNode | aNode intersectsInterval: anInterval];
		executeTree: aParseTree;
		tree! !

!RBParseTreeRewriter class methodsFor: 'instance creation' stamp: ''!
replace: code with: newCode method: aBoolean 
	| rewriteRule |
	rewriteRule := self new.
	aBoolean 
		ifTrue: [rewriteRule replaceMethod: code with: newCode]
		ifFalse: [rewriteRule replace: code with: newCode].
	^rewriteRule! !

!RBParseTreeRewriter class methodsFor: 'instance creation' stamp: 'lr 11/23/2009 14:27'!
variable: aVarName getter: getMethod setter: setMethod 
	^self 
		variable: aVarName
		getter: getMethod
		setter: setMethod
		receiver: 'self'! !

!RBParseTreeRewriter class methodsFor: 'instance creation' stamp: 'lr 11/23/2009 14:27'!
variable: aVarName getter: getMethod setter: setMethod receiver: aString 
	| rewriteRule |
	rewriteRule := self new.
	rewriteRule
		replace: aVarName , ' := ``@object'
			with: aString , ' ' , setMethod , ' ``@object';
		replace: aVarName with: aString , ' ' , getMethod.
	^rewriteRule! !

!RBParseTreeRewriter class methodsFor: 'instance creation' stamp: ''!
removeTemporaryNamed: aName 
	| rewriteRule |
	rewriteRule := self new.
	rewriteRule replace: '| `@temps1 ' , aName , ' `@temps2 | ``@.Statements'
		with: '| `@temps1  `@temps2 | ``@.Statements'.
	^rewriteRule! !

!RBParseTreeRewriter class methodsFor: 'accessing' stamp: ''!
replaceStatements: code with: newCode in: aParseTree onInterval: anInterval 
	| tree replaceStmt |
	tree := self buildTree: code method: false.
	tree isSequence 
		ifFalse: [tree := RBSequenceNode statements: (Array with: tree)].
	tree temporaries: (Array with: (RBPatternVariableNode named: '`@temps')).
	tree addNodeFirst: (RBPatternVariableNode named: '`@.S1').
	tree lastIsReturn 
		ifTrue: [replaceStmt := '| `@temps | `@.S1. ^' , newCode]
		ifFalse: 
			[tree addNode: (RBPatternVariableNode named: '`@.S2').
			replaceStmt := '| `@temps | `@.S1. ' , newCode , '. `@.S2'].
	^self 
		replace: tree formattedCode
		with: replaceStmt
		in: aParseTree
		onInterval: anInterval! !

!RBParseTreeRewriter class methodsFor: 'accessing' stamp: ''!
replace: code with: newCode in: aParseTree 
	^(self 
		replace: code
		with: newCode
		method: false)
		executeTree: aParseTree;
		tree! !

!RBParseTreeRewriter class methodsFor: 'instance creation' stamp: ''!
replaceLiteral: literal with: newLiteral 
	| rewriteRule |
	rewriteRule := self new.
	rewriteRule replaceTree: (RBLiteralNode value: literal)
		withTree: (RBLiteralNode value: newLiteral).
	^rewriteRule! !

!RBParseTreeRewriter class methodsFor: 'instance creation' stamp: ''!
rename: varName to: newVarName 
	| rewriteRule |
	rewriteRule := self new.
	rewriteRule
		replace: varName with: newVarName;
		replaceArgument: varName with: newVarName.
	^rewriteRule! !

!RBParseTreeRule commentStamp: 'md 8/9/2005 14:55'!
RBParseTreeRule is the abstract superclass of all of the parse tree searching rules. A parse tree rule is the first class representation of a particular rule to search for. The owner of a rule is the algorithm that actually executes the search. This arrangement allows multiple searches to be conducted by a single Searcher.

Instance Variables:
	owner	<ParseTreeSearcher>	The searcher that is actually performing the search.
	searchTree	<RBProgramNode>	The parse tree to be searched.

!
!RBParseTreeRule methodsFor: 'accessing' stamp: ''!
sentMessages
	^searchTree sentMessages! !

!RBParseTreeRule methodsFor: 'initialize-release' stamp: ''!
methodSearchString: aString 
	searchTree := RBParser parseRewriteMethod: aString! !

!RBParseTreeRule methodsFor: 'matching' stamp: ''!
canMatch: aProgramNode 
	^true! !

!RBParseTreeRule methodsFor: 'initialize-release' stamp: ''!
owner: aParseTreeSearcher
	owner := aParseTreeSearcher! !

!RBParseTreeRule methodsFor: 'matching' stamp: 'PabloHerrero 11/6/2013 11:17'!
performOn: aProgramNode 
	self context empty.
	^((searchTree match: aProgramNode inContext: self context) 
		and: [self canMatch: aProgramNode]) 
			ifTrue:
				[owner recusivelySearchInContext.
				self foundMatchFor: aProgramNode]
			ifFalse: [nil]
			
		! !

!RBParseTreeRule methodsFor: 'matching' stamp: ''!
foundMatchFor: aProgramNode
	^aProgramNode! !

!RBParseTreeRule methodsFor: 'private' stamp: ''!
context
	^owner context! !

!RBParseTreeRule methodsFor: 'initialize-release' stamp: ''!
searchString: aString 
	searchTree := RBParser parseRewriteExpression: aString! !

!RBParseTreeRule class methodsFor: 'instance creation' stamp: ''!
search: aString 
	^(self new)
		searchString: aString;
		yourself! !

!RBParseTreeRule class methodsFor: 'instance creation' stamp: ''!
methodSearch: aString 
	^(self new)
		methodSearchString: aString;
		yourself! !

!RBParseTreeSearcher commentStamp: '<historical>'!
ParseTreeSearcher walks over a normal source code parse tree using the visitor pattern, and then matches these nodes against the meta-nodes using the match:inContext: methods defined for the meta-nodes.

Instance Variables:
	answer	<Object>	the "answer" that is propagated between matches
	argumentSearches	<Collection of: (Association key: RBProgramNode value: BlockClosure)>	argument searches (search for the BRProgramNode and perform the BlockClosure when its found)
	context	<RBSmallDictionary>	a dictionary that contains what each meta-node matches against. This could be a normal Dictionary that is created for each search, but is created once and reused (efficiency).
	messages	<Collection>	the sent messages in our searches
	searches	<Collection of: (Association key: RBProgramNode value: BlockClosure)>	non-argument searches (search for the BRProgramNode and perform the BlockClosure when its found)!
!RBParseTreeSearcher methodsFor: 'private' stamp: 'CamilloBruni 12/15/2011 15:28'!
performSearches: aSearchCollection on: aNode 
	| value |
	aSearchCollection do: [ :aSearchRule|
		value := aSearchRule performOn: aNode.
		value notNil 
			ifTrue: 
				[self foundMatch.
				^value]].
	^nil! !

!RBParseTreeSearcher methodsFor: 'accessing' stamp: ''!
answer
	^answer! !

!RBParseTreeSearcher methodsFor: 'private' stamp: ''!
foundMatch! !

!RBParseTreeSearcher methodsFor: 'initialization' stamp: 'MarcusDenker 3/25/2013 21:02'!
initialize
	super initialize.
	context := SmallDictionary new.
	searches := OrderedCollection new.
	argumentSearches := OrderedCollection new: 0.
	answer := nil! !

!RBParseTreeSearcher methodsFor: 'searching' stamp: ''!
matchesAnyOf: aStringCollection do: aBlock 
	aStringCollection do: [:each | self matches: each do: aBlock]! !

!RBParseTreeSearcher methodsFor: 'accessing' stamp: ''!
addArgumentRules: ruleCollection 
	ruleCollection do: [:each | self addArgumentRule: each]! !

!RBParseTreeSearcher methodsFor: 'searching' stamp: ''!
matchesAnyTreeOf: treeCollection do: aBlock 
	treeCollection do: [:each | self matchesTree: each do: aBlock]! !

!RBParseTreeSearcher methodsFor: 'accessing' stamp: ''!
addRules: ruleCollection 
	ruleCollection do: [:each | self addRule: each]! !

!RBParseTreeSearcher methodsFor: 'accessing' stamp: ''!
messages
	messages notNil ifTrue: [^messages].
	argumentSearches notEmpty ifTrue: [^messages := #()].
	messages := Set new.
	searches do: 
			[:each | 
			| searchMessages |
			searchMessages := each sentMessages.
			RBProgramNode optimizedSelectors 
				do: [:sel | searchMessages remove: sel ifAbsent: []].
			searchMessages isEmpty ifTrue: [^messages := #()].
			messages addAll: searchMessages].
	^messages := messages asArray! !

!RBParseTreeSearcher methodsFor: 'searching' stamp: ''!
matchesTree: aBRProgramNode do: aBlock 
	self addRule: (RBSearchRule searchForTree: aBRProgramNode thenDo: aBlock)! !

!RBParseTreeSearcher methodsFor: 'searching' stamp: ''!
matchesAnyMethodOf: aStringCollection do: aBlock 
	aStringCollection do: [:each | self matchesMethod: each do: aBlock]! !

!RBParseTreeSearcher methodsFor: 'initialize-release' stamp: ''!
answer: anObject
	answer := anObject! !

!RBParseTreeSearcher methodsFor: 'accessing' stamp: ''!
addRule: aParseTreeRule 
	searches add: aParseTreeRule.
	aParseTreeRule owner: self! !

!RBParseTreeSearcher methodsFor: 'testing' stamp: 'lr 1/3/2010 11:48'!
canMatchMethod: aCompiledMethod
	| actualMessages |
	self messages isEmpty
		ifTrue: [ ^ true ].
	actualMessages := aCompiledMethod messages.
	^ self messages 
		anySatisfy: [ :each | actualMessages includes: each ]! !

!RBParseTreeSearcher methodsFor: 'searching' stamp: ''!
matchesArgumentTree: aBRProgramNode do: aBlock 
	self 
		addArgumentRule: (RBSearchRule searchForTree: aBRProgramNode thenDo: aBlock)! !

!RBParseTreeSearcher methodsFor: 'searching' stamp: ''!
matches: aString do: aBlock 
	self addRule: (RBSearchRule searchFor: aString thenDo: aBlock)! !

!RBParseTreeSearcher methodsFor: 'searching' stamp: ''!
matchesMethod: aString do: aBlock 
	self addRule: (RBSearchRule searchForMethod: aString thenDo: aBlock)! !

!RBParseTreeSearcher methodsFor: 'private' stamp: 'MarcusDenker 3/25/2013 21:02'!
recusivelySearchInContext
	"We need to save the matched context since the other searches might overwrite it."

	| oldContext |
	oldContext := context.
	context := SmallDictionary new.
	self lookForMoreMatchesInContext: oldContext.
	context := oldContext! !

!RBParseTreeSearcher methodsFor: 'visiting' stamp: 'CamilleTeruel 4/3/2013 16:23'!
visitNode: aNode 
	| value |
	value := self performSearches: searches on: aNode.
	^ value
		ifNil: [ 
			super visitNode: aNode.
			aNode ]
		ifNotNil: [ value ]! !

!RBParseTreeSearcher methodsFor: 'visiting' stamp: 'CamilleTeruel 4/3/2013 16:22'!
visitArgumentNode: aNode
	| value |
	value := self performSearches: argumentSearches on: aNode.
	^ value
		ifNil: [ 
			super visitArgumentNode: aNode.
			aNode ]
		ifNotNil: [ value ]! !

!RBParseTreeSearcher methodsFor: 'searching' stamp: ''!
matchesAnyArgumentOf: stringCollection do: aBlock 
	stringCollection do: [:each | self matchesArgument: each do: aBlock]! !

!RBParseTreeSearcher methodsFor: 'accessing' stamp: ''!
addArgumentRule: aParseTreeRule 
	argumentSearches add: aParseTreeRule.
	aParseTreeRule owner: self! !

!RBParseTreeSearcher methodsFor: 'accessing' stamp: ''!
executeMethod: aParseTree initialAnswer: anObject 
	answer := anObject.
	searches detect: [:each | (each performOn: aParseTree) notNil] ifNone: [].
	^answer! !

!RBParseTreeSearcher methodsFor: 'accessing' stamp: 'MarcusDenker 3/25/2013 21:02'!
executeTree: aParseTree 
	"Save our current context, in case someone is performing another search inside a match."

	| oldContext |
	oldContext := context.
	context := SmallDictionary new.
	self visitNode: aParseTree.
	context := oldContext.
	^answer! !

!RBParseTreeSearcher methodsFor: 'accessing' stamp: ''!
executeTree: aParseTree initialAnswer: aValue 
	answer := aValue.
	^self executeTree: aParseTree! !

!RBParseTreeSearcher methodsFor: 'searching' stamp: ''!
matchesArgument: aString do: aBlock 
	self addArgumentRule: (RBSearchRule searchFor: aString thenDo: aBlock)! !

!RBParseTreeSearcher methodsFor: 'testing' stamp: ''!
hasRules
	^searches notEmpty! !

!RBParseTreeSearcher methodsFor: 'private' stamp: ''!
lookForMoreMatchesInContext: oldContext 
	oldContext keysAndValuesDo: 
			[:key :value | 
			(key isString not and: [key recurseInto]) 
				ifTrue: [value do: [:each | self visitNode: each]]]! !

!RBParseTreeSearcher methodsFor: 'accessing' stamp: ''!
context
	^context! !

!RBParseTreeSearcher class methodsFor: 'private' stamp: ''!
buildTree: aString method: aBoolean 
	^aBoolean 
		ifTrue: [RBParser parseRewriteMethod: aString]
		ifFalse: [RBParser parseRewriteExpression: aString]! !

!RBParseTreeSearcher class methodsFor: 'private' stamp: ''!
buildSelectorString: aSelector 
	| stream keywords |
	aSelector numArgs = 0 ifTrue: [^aSelector].
	stream := WriteStream on: String new.
	keywords := aSelector keywords.
	1 to: keywords size
		do: 
			[:i | 
			stream
				nextPutAll: (keywords at: i);
				nextPutAll: ' ``@arg';
				nextPutAll: i printString;
				nextPut: $ ].
	^stream contents! !

!RBParseTreeSearcher class methodsFor: 'private' stamp: ''!
buildSelectorTree: aSelector 
	aSelector isEmpty ifTrue: [^nil].
	^RBParser parseRewriteExpression: '``@receiver ' 
				, (self buildSelectorString: aSelector)
		onError: [:err :pos | ^nil]! !

!RBParseTreeSearcher class methodsFor: 'instance creation' stamp: ''!
returnSetterMethod: aVarName 
	^(self new)
		matchesMethod: '`method: `Arg ^' , aVarName , ' := `Arg'
			do: [:aNode :ans | aNode selector];
		yourself! !

!RBParseTreeSearcher class methodsFor: 'instance creation' stamp: ''!
getterMethod: aVarName 
	^(self new)
		matchesMethod: '`method ^' , aVarName do: [:aNode :ans | aNode selector];
		yourself! !

!RBParseTreeSearcher class methodsFor: 'instance creation' stamp: ''!
setterMethod: aVarName 
	^(self new)
		matchesAnyMethodOf: (Array with: '`method: `Arg ' , aVarName , ' := `Arg'
					with: '`method: `Arg ^' , aVarName , ' := `Arg')
			do: [:aNode :ans | aNode selector];
		yourself! !

!RBParseTreeSearcher class methodsFor: 'accessing' stamp: ''!
treeMatching: aString in: aParseTree 
	(self new)
		matches: aString do: [:aNode :answer | ^aNode];
		executeTree: aParseTree.
	^nil! !

!RBParseTreeSearcher class methodsFor: 'accessing' stamp: ''!
treeMatchingStatements: aString in: aParseTree 
	| notifier tree |
	notifier := self new.
	tree := RBParser parseExpression: aString.
	tree isSequence 
		ifFalse: [tree := RBSequenceNode statements: (Array with: tree)].
	tree temporaries: (Array with: (RBPatternVariableNode named: '`@temps')).
	tree addNodeFirst: (RBPatternVariableNode named: '`@.S1').
	tree lastIsReturn 
		ifFalse: [tree addNode: (RBPatternVariableNode named: '`@.S2')].
	notifier matchesTree: tree
		do: [:aNode :answer | ^RBParser parseExpression: aString].
	notifier executeTree: aParseTree.
	^nil! !

!RBParseTreeSearcher class methodsFor: 'instance creation' stamp: 'lr 11/4/2009 11:44'!
justSendsSuper
	^ self new
		matchesAnyMethodOf: #(
			'`@method: `@args ^ super `@method: `@args' 
			'`@method: `@args super `@method: `@args')
		do: [ :node :answer | true ];
		yourself! !

!RBParser commentStamp: '<historical>'!
RBParser takes a source code string and generates an AST for it. This is a hand-written, recursive descent parser and has been optimized for speed. The simplest way to call this is either 'RBParser parseExpression: aString' if you want the AST for an expression, or 'RBParser parseMethod: aString' if you want to parse an entire method.

Instance Variables:
	currentToken	<RBToken>	The current token being processed.
	emptyStatements	<Boolean>	True if empty statements are allowed. In IBM, they are, in VW they aren't.
	errorBlock	<BlockClosure>	The block to evaluate on a syntax error.
	nextToken	<RBToken>	The next token that will be processed. This allows one-token lookahead.
	scanner	<RBScanner>	The scanner that generates a stream of tokens to parse.
	source	<String>	The source code to parse
	tags	<Collection of: Interval>	The source intervals of the tags appearing at the top of a method (e.g. Primitive calls)

Shared Variables:
	ParserType	<Symbol>	the type code we are parsing!
!RBParser methodsFor: 'private-classes' stamp: 'CamilloBruni 12/15/2011 16:15'!
variableNodeClass
	^ RBVariableNode! !

!RBParser methodsFor: 'private-parsing' stamp: 'PabloHerrero 10/21/2013 15:52'!
parseUnaryPragma
	| selector |
	selector := currentToken.
	self step.
	^ self pragmaNodeClass selector: selector value asSymbol keywordsPositions: (Array with: selector start) arguments: #()! !

!RBParser methodsFor: 'private-classes' stamp: 'CamilloBruni 8/30/2011 17:03'!
thisContextNodeClass
	^ RBThisContextNode! !

!RBParser methodsFor: 'accessing' stamp: 'GiselaDecuzzi 5/27/2013 18:55'!
parseMethod: aString
	| node errorNode |
	node := self parseMethod.
	self atEnd
		ifFalse: [ 
			errorNode := self parserError: 'Unknown input at end'.
			errorNode ifNotNil: [ node statements: node statements, {errorNode }] ].
	node source: aString.
	^ node! !

!RBParser methodsFor: 'private-parsing' stamp: ''!
parseKeywordMessage
	^self parseKeywordMessageWith: self parseBinaryMessage! !

!RBParser methodsFor: 'private-parsing' stamp: 'CamilloBruni 10/31/2012 18:37'!
parseLiteralArray
	| stream start stop |
	start := currentToken start.
	stream := WriteStream on: (Array new: 5).
	self step.
	[self atEnd or: [currentToken isSpecial and: [currentToken value = $)]]] 
		whileFalse: [stream nextPut: self parseLiteralArrayObject].
	(currentToken isSpecial and: [currentToken value = $)]) 
		ifFalse: [ ^ self parserError: ''')'' expected'].
	stop := currentToken stop.
	self step.
	^self literalArrayNodeClass 
		startPosition: start
		contents: stream contents
		stopPosition: stop
		isByteArray: false! !

!RBParser methodsFor: 'private-parsing' stamp: 'MarcusDenker 3/27/2014 11:08'!
parseStatementList: pragmaBoolean into: sequenceNode 
	| statements return periods returnPosition node |
	return := false.
	statements := OrderedCollection new.
	periods := OrderedCollection new.
	self addCommentsTo: sequenceNode.
	pragmaBoolean ifTrue: [self parsePragmas].
	[currentToken isSpecial and: [currentToken value = $.]] whileTrue: 
		[periods add: currentToken start.
		self step].
	[self atEnd 
		or: [currentToken isSpecial and: ['])}' includes: currentToken value]]] 
			whileFalse: [
				return ifTrue: [ 
					(self parserError: 'End of statement list encountered') 
						ifNotNil: [ :errorNode | 
								statements add: errorNode. 
								sequenceNode statements: statements.
								sequenceNode periods: periods.
								self step.
								^sequenceNode]
					].
				(currentToken isSpecial and: [currentToken value = $^]) 
					ifTrue: 
						[returnPosition := currentToken start.
						self step.
						node := self returnNodeClass return: returnPosition
									value: self parseAssignment.
						statements add: node.
						return := true]
					ifFalse: [
						"check for pragmas"
						(currentToken isBinary and: [ currentToken value == #<])
							ifTrue: [ self parsePragma ]
							ifFalse: [
								node := self parseAssignment.
								statements add: node ]].
				(currentToken isSpecial and: [currentToken value = $.]) 
					ifTrue: 
						[periods add: currentToken start.
						self step.
						self addCommentsTo: node]
					ifFalse: [
						"check for closing pragmas"
						(currentToken isBinary and: [ currentToken value == #>])
							ifFalse: [ return := true ]
							ifTrue: [ self step ]].
				[currentToken isSpecial and: [currentToken value = $.]] whileTrue: 
					[periods add: currentToken start.
					self step]
				].
	statements notEmpty ifTrue: [self addCommentsTo: statements last].
	sequenceNode
		statements: statements;
		periods: periods.
	^sequenceNode! !

!RBParser methodsFor: 'private-classes' stamp: 'lr 11/1/2009 19:50'!
returnNodeClass
	^ RBReturnNode! !

!RBParser methodsFor: 'initialization' stamp: 'lr 11/1/2009 19:17'!
initialize
	comments := OrderedCollection new! !

!RBParser methodsFor: 'accessing' stamp: ''!
scannerClass
	^RBScanner! !

!RBParser methodsFor: 'private-parsing' stamp: 'PabloHerrero 10/21/2013 15:52'!
parseBinaryPragma
	| binaryToken |
	currentToken isBinary 
		ifFalse: [ ^ self parserError: 'Message pattern expected' ].
	binaryToken := currentToken.
	self step.
	^ self pragmaNodeClass
		selector: binaryToken value asSymbol
		keywordsPositions: (Array with: binaryToken start)
		arguments: (Array with: self parsePragmaLiteral)! !

!RBParser methodsFor: 'private-parsing' stamp: ''!
parseBinaryMessage
	| node |
	node := self parseUnaryMessage.
	
	[currentToken isLiteralToken ifTrue: [self patchNegativeLiteral].
	currentToken isBinary] 
			whileTrue: [node := self parseBinaryMessageWith: node].
	^node! !

!RBParser methodsFor: 'private-parsing' stamp: 'CamilloBruni 11/13/2012 10:22'!
parsePragmas
	[ currentToken isBinary and: [ currentToken value = #< ] ] whileTrue: [
		self parsePragma.
		self step ]! !

!RBParser methodsFor: 'private' stamp: 'PabloHerrero 11/7/2013 17:03'!
extractCommentsFrom: aToken
 
	aToken comments 
		collect: [:interval |
			"RBComment from: interval first to: interval last"
 			RBComment with: (source copyFrom: (interval first + 1) to: (interval last - 1)) at: interval first]
		into: comments! !

!RBParser methodsFor: 'private-parsing' stamp: ''!
parseAssignment
	"Need one token lookahead to see if we have a ':='. This method could 
	make it possible to assign the literals true, false and nil."

	| node position |
	(currentToken isIdentifier and: [self nextToken isAssignment]) 
		ifFalse: [^self parseCascadeMessage].
	node := self parseVariableNode.
	position := currentToken start.
	self step.
	^self assignmentNodeClass 
		variable: node
		value: self parseAssignment
		position: position! !

!RBParser methodsFor: 'private-parsing' stamp: 'CamilloBruni 10/31/2012 18:37'!
parseParenthesizedExpression
	| leftParen node |
	leftParen := currentToken start.
	self step.
	node := self parseAssignment.
	^(currentToken isSpecial and: [currentToken value = $)])
		ifTrue: 
			[node addParenthesis: (leftParen to: currentToken start).
			self step.
			node]
		ifFalse: [ self parserError: ''')'' expected']! !

!RBParser methodsFor: 'private-parsing' stamp: 'PabloHerrero 10/28/2013 14:12'!
parsePrimitiveObject
	currentToken isIdentifier ifTrue: [^self parsePrimitiveIdentifier].
	(currentToken isLiteralToken and: [currentToken isMultiKeyword not]) 
		ifTrue: [^self parsePrimitiveLiteral].
	currentToken isLiteralArrayToken
		ifTrue: 
			[^currentToken isForByteArray 
				ifTrue: [self parseLiteralByteArray]
				ifFalse: [self parseLiteralArray]].
	currentToken isSpecial
		ifTrue: 
			[currentToken value = $[ ifTrue: [^self parseBlock].
			currentToken value = $( ifTrue: [^self parseParenthesizedExpression].
			currentToken value = ${ ifTrue: [^self parseArray]].
	(currentToken isBinary and: [ currentToken value = #- ]) 
		ifTrue: [ ^self parseNegatedNumber ].
	^ self parserError: 'Variable or expression expected'! !

!RBParser methodsFor: 'private-parsing' stamp: 'CamilloBruni 10/31/2012 18:37'!
parseLiteralByteArrayObject
	(currentToken isLiteralToken and: 
			[currentToken value isInteger and: [currentToken value between: 0 and: 255]]) 
		ifFalse: [ ^ self parserError: 'Expecting 8-bit integer'].
	^self parsePrimitiveLiteral! !

!RBParser methodsFor: 'private-parsing' stamp: 'lr 11/2/2009 23:37'!
parseLiteralArrayObject
	currentToken isSpecial 
		ifTrue: 
			[currentToken value = $( ifTrue: [^self parseLiteralArray].
			"currentToken value == $[ ifTrue: [^self parseLiteralByteArray]"].
	currentToken isLiteralArrayToken 
		ifTrue: 
			[^currentToken isForByteArray 
				ifTrue: [self parseLiteralByteArray]
				ifFalse: [self parseLiteralArray]].
	currentToken isLiteralToken ifFalse: [self patchLiteralArrayToken].
	^self parsePrimitiveLiteral! !

!RBParser methodsFor: 'private-parsing' stamp: 'GiselaDecuzzi 6/3/2013 16:09'!
parseBlock
	| position node |
	position := currentToken start.
	self step.
	node := self blockNodeClass new. 
	self parseBlockArgsInto: node.
	node left: position.
	node body: self sequenceNodeClass new.
	(self parseStatements: false into: node body).
	
	(currentToken isSpecial and: [currentToken value = $]])
		ifFalse: [^ self parserError: ''']'' expected' translated].
	node right: currentToken start.
	self step.
	^node! !

!RBParser methodsFor: 'private' stamp: 'ClementBera 7/26/2013 17:09'!
nextToken
	^nextToken ifNil: [nextToken := scanner next] ifNotNil: [nextToken]! !

!RBParser methodsFor: 'private-classes' stamp: 'lr 11/1/2009 19:49'!
cascadeNodeClass
	^ RBCascadeNode! !

!RBParser methodsFor: 'private-parsing' stamp: ''!
parseUnaryMessage
	| node |
	node := self parsePrimitiveObject.
	self addCommentsTo: node.
	[currentToken isLiteralToken ifTrue: [self patchLiteralMessage].
	currentToken isIdentifier] 
			whileTrue: [node := self parseUnaryMessageWith: node].
	self addCommentsTo: node.
	^node! !

!RBParser methodsFor: 'private-parsing' stamp: ''!
parseMessagePattern
	currentToken isLiteralToken ifTrue: [self patchLiteralMessage].
	^currentToken isIdentifier 
		ifTrue: [self parseUnaryPattern]
		ifFalse: 
			[currentToken isKeyword 
				ifTrue: [self parseKeywordPattern]
				ifFalse: [self parseBinaryPattern]]! !

!RBParser methodsFor: 'private-parsing' stamp: 'GiselaDecuzzi 6/3/2013 16:08'!
parseVariableNode
	currentToken isIdentifier 
		ifFalse: [ ^ self parserError: 'Variable name expected' translated].
	^self parsePrimitiveIdentifier! !

!RBParser methodsFor: 'private' stamp: 'lr 11/2/2009 23:37'!
patchNegativeLiteral
	"Handle the special negative number case for binary message sends."

	currentToken value isNumber 
		ifFalse: [^self].
	currentToken value <= 0 ifFalse: [^self].
	currentToken value = 0 
		ifTrue: 
			[(source notNil and: 
					[source notEmpty 
						and: [(source at: (currentToken start min: source size)) = $-]]) 
				ifFalse: [^self]].
	nextToken := currentToken.
	currentToken := RBBinarySelectorToken value: #- start: nextToken start.
	nextToken value: nextToken value negated.
	(nextToken isKindOf: RBNumberLiteralToken) 
		ifTrue: 
			[nextToken source: (nextToken source copyFrom: 2 to: nextToken source size)].
	nextToken start: nextToken start + 1! !

!RBParser methodsFor: 'private' stamp: 'PabloHerrero 11/7/2013 10:36'!
step
	(currentToken notNil and: [currentToken comments notNil]) 
		ifTrue: [self extractCommentsFrom: currentToken].
	nextToken notNil 
		ifTrue: 
			[currentToken := nextToken.
			nextToken := nil]
		ifFalse: [currentToken := scanner next].! !

!RBParser methodsFor: 'private-parsing' stamp: 'PabloHerrero 11/18/2013 19:13'!
parseKeywordPattern
	| selector positions args node |
	selector := ''.
	positions := OrderedCollection new: 2.
	args := OrderedCollection new: 2.
	[currentToken isKeyword]
		whileTrue:
			[selector := selector, currentToken value.
			 positions add: currentToken start.
			self step.
			args add: self parseVariableNode].
	node := self methodNodeClass
		selector: selector asSymbol
		keywordsPositions: positions asIntegerArray
		arguments: args.
	node comments: (node comments, args last comments).
	args last comments ifNotEmpty: [ args last comments: #() ].
	^node! !

!RBParser methodsFor: 'private-parsing' stamp: 'PabloHerrero 10/23/2013 16:16'!
parsePrimitiveIdentifier
	| token node |
	token := currentToken.
	self step.
	node := self variableNodeClass identifierNamed: token value at: token start.
	self addCommentsTo: node.
	^node! !

!RBParser methodsFor: 'private-parsing' stamp: ''!
parseArgs
	| args |
	args := OrderedCollection new.
	[currentToken isIdentifier] whileTrue: [args add: self parseVariableNode].
	^args! !

!RBParser methodsFor: 'private-parsing' stamp: 'CamilloBruni 12/15/2011 16:41'!
parseStatements: pragmaBoolean
	^ self parseStatements: pragmaBoolean into: self sequenceNodeClass new! !

!RBParser methodsFor: 'private-parsing' stamp: 'PabloHerrero 10/21/2013 15:59'!
parseKeywordPragma
	| selector positions arguments |
	selector := ''.
	positions := OrderedCollection new: 2.
	arguments := OrderedCollection new: 2.
	[ currentToken isKeyword ] whileTrue: [
		selector := selector, currentToken value.
		positions add: currentToken start.
		self step.
		arguments addLast: self parsePragmaLiteral ].
	^ self pragmaNodeClass
		selector: selector asSymbol
		keywordsPositions: positions asIntegerArray
		arguments: arguments.! !

!RBParser methodsFor: 'private-classes' stamp: 'CamilloBruni 8/23/2011 16:12'!
selfNodeClass
	^ RBSelfNode! !

!RBParser methodsFor: 'private-parsing' stamp: 'PabloHerrero 11/18/2013 19:13'!
parseBinaryPattern
	| binaryToken node args |
	currentToken isBinary
		ifFalse: [ ^ self parserError: 'Message pattern expected'].
	binaryToken := currentToken.
	self step.
	args := Array with: self parseVariableNode.
	node := self methodNodeClass
		selector: binaryToken value asSymbol
		keywordsPositions: (Array with: binaryToken start)
		arguments: args.
	node comments: node comments , args last comments.
	args last comments ifNotEmpty: [ args last comments: #() ].
	^node! !

!RBParser methodsFor: 'private-classes' stamp: 'lr 11/1/2009 19:50'!
messageNodeClass
	^ RBMessageNode! !

!RBParser methodsFor: 'private-parsing' stamp: 'CamilloBruni 10/31/2012 18:37'!
parseCascadeMessage
	| node receiver messages semicolons |
	node := self parseKeywordMessage.
	(currentToken isSpecial 
		and: [currentToken value = $; and: [node isMessage]]) ifFalse: [^node].
	receiver := node receiver.
	messages := OrderedCollection new: 3.
	semicolons := OrderedCollection new: 3.
	messages add: node.
	[currentToken isSpecial and: [currentToken value = $;]] whileTrue: 
			[semicolons add: currentToken start.
			self step.
			messages add: (currentToken isIdentifier 
						ifTrue: [self parseUnaryMessageWith: receiver]
						ifFalse: 
							[currentToken isKeyword 
								ifTrue: [self parseKeywordMessageWith: receiver]
								ifFalse: 
									[| temp |
									currentToken isLiteralToken ifTrue: [self patchNegativeLiteral].
									currentToken isBinary ifFalse: [ ^ self parserError: 'Message expected'].
									temp := self parseBinaryMessageWith: receiver.
									temp == receiver ifTrue: [ ^ self parserError: 'Message expected'].
									temp]])].
	^self cascadeNodeClass messages: messages semicolons: semicolons! !

!RBParser methodsFor: 'private-classes' stamp: 'CamilloBruni 8/23/2011 16:12'!
superNodeClass
	^ RBSuperNode! !

!RBParser methodsFor: 'error handling' stamp: 'PabloHerrero 10/24/2013 11:21'!
parseErrorNode: aMessageString
	| token sourceString |
	currentToken isError 
		ifTrue: [ ^ RBParseErrorNode errorMessage: currentToken cause value: currentToken value at: currentToken start ].
	sourceString := source copyFrom: self errorPosition to: source size.
	token := RBValueToken value: sourceString start: self errorPosition.
	^ RBParseErrorNode
		errorMessage: aMessageString value: token value at: token start! !

!RBParser methodsFor: 'private-parsing' stamp: 'CamilloBruni 12/15/2011 16:18'!
parseTemps
	| temps |
	temps := OrderedCollection new.
	[currentToken isIdentifier] whileTrue: [temps add: self parsePrimitiveIdentifier].
	^temps! !

!RBParser methodsFor: 'private-parsing' stamp: 'PabloHerrero 2/16/2015 01:25'!
parseNumberLiteral
	| token |
	token := currentToken.
	self step.
	
	^self literalValueNodeClass 
		value: token value 
		start: token start
		stop: token stop
		source: token source
	! !

!RBParser methodsFor: 'private-classes' stamp: 'lr 11/1/2009 19:49'!
arrayNodeClass
	^ RBArrayNode! !

!RBParser methodsFor: 'private-classes' stamp: 'lr 11/1/2009 19:50'!
sequenceNodeClass
	^ RBSequenceNode! !

!RBParser methodsFor: 'private' stamp: ''!
addCommentsTo: aNode
	aNode comments: aNode comments , comments.
	comments := OrderedCollection new! !

!RBParser methodsFor: 'private-classes' stamp: 'lr 11/1/2009 19:49'!
assignmentNodeClass
	^ RBAssignmentNode! !

!RBParser methodsFor: 'accessing' stamp: ''!
errorBlock: aBlock 
	errorBlock := aBlock.
	scanner notNil ifTrue: [scanner errorBlock: aBlock]! !

!RBParser methodsFor: 'private-classes' stamp: 'lr 11/1/2009 19:50'!
literalArrayNodeClass
	^ RBLiteralArrayNode! !

!RBParser methodsFor: 'private-parsing' stamp: 'CamilloBruni 10/31/2012 18:37'!
parseLiteralByteArray
	| stream start stop |
	start := currentToken start.
	stream := WriteStream on: (Array new: 5).
	self step.
	[self atEnd or: [currentToken isSpecial and: [currentToken value = $]]]] 
		whileFalse: [stream nextPut: self parseLiteralByteArrayObject].
	(currentToken isSpecial and: [currentToken value = $]]) 
		ifFalse: [^ self parserError: ''']'' expected'].
	stop := currentToken stop.
	self step.
	^self literalArrayNodeClass 
		startPosition: start
		contents: stream contents
		stopPosition: stop
		isByteArray: true! !

!RBParser methodsFor: 'private-classes' stamp: 'lr 11/1/2009 19:50'!
literalNodeClass
	^ RBLiteralNode! !

!RBParser methodsFor: 'private-parsing' stamp: 'CamilloBruni 11/13/2012 10:12'!
basicParsePragma
	^ currentToken isIdentifier
		ifTrue: [ self parseUnaryPragma ]
		ifFalse: [
			currentToken isKeyword
				ifTrue: [ self parseKeywordPragma ]
				ifFalse: [ self parseBinaryPragma ] ]! !

!RBParser methodsFor: 'private' stamp: 'lr 11/1/2009 20:03'!
patchLiteralArrayToken
	(currentToken isIdentifier and: 
			[self nextToken isAssignment 
				and: [currentToken stop + 1 = self nextToken start]]) 
		ifTrue: 
			[currentToken := RBLiteralToken 
						value: (currentToken value , ':') asSymbol
						start: currentToken start
						stop: self nextToken start.
			nextToken := RBLiteralToken 
						value: #=
						start: nextToken stop
						stop: nextToken stop.
			^self].
	currentToken isAssignment 
		ifTrue: 
			[currentToken := RBLiteralToken 
						value: #':'
						start: currentToken start
						stop: currentToken start.
			nextToken := RBLiteralToken 
						value: #=
						start: currentToken stop
						stop: currentToken stop.
			^self].
	currentToken isSpecial 
		ifTrue: 
			[currentToken := RBLiteralToken 
						value: (String with: currentToken value) asSymbol
						start: currentToken start
						stop: currentToken stop.
			^self].
	(currentToken isIdentifier and: [currentToken value includes: $.]) 
		ifTrue: 
			[currentToken := RBLiteralToken 
						value: currentToken value
						start: currentToken start
						stop: currentToken stop.
			^self].
	(currentToken isIdentifier 
		or: [currentToken isBinary or: [currentToken isKeyword]]) 
			ifFalse: [^self parserError: 'Invalid token'].
	currentToken := RBLiteralToken 
				value: currentToken value asSymbol
				start: currentToken start
				stop: currentToken stop! !

!RBParser methodsFor: 'private-classes' stamp: 'lr 11/1/2009 19:49'!
blockNodeClass
	^ RBBlockNode! !

!RBParser methodsFor: 'private-parsing' stamp: 'ClementBEra 1/30/2013 15:06'!
parsePragma
	| start pragma |
	start := currentToken start.
	self step.
	pragma := self basicParsePragma.
	(currentToken isBinary and: [ currentToken value == #> ]) 
		ifFalse: [ ^ self parserError: '''>'' expected' ].
	pragma left: start; right: currentToken start.
	self addPragma: pragma.! !

!RBParser methodsFor: 'private-parsing' stamp: 'lr 5/30/2010 14:40'!
parsePragmaLiteral
	^ self parseLiteralArrayObject! !

!RBParser methodsFor: 'private-parsing' stamp: 'PabloHerrero 10/21/2013 15:52'!
parseUnaryPattern
	| selector |
	selector := currentToken.
	self step.
	^self methodNodeClass selector: selector value asSymbol keywordsPositions: (Array with: selector start) arguments: #()! !

!RBParser methodsFor: 'error handling' stamp: 'ClementBera 7/26/2013 17:09'!
errorBlock
	^errorBlock ifNil: [[:message :position | ]] ifNotNil: [errorBlock]! !

!RBParser methodsFor: 'accessing' stamp: 'GiselaDecuzzi 6/10/2013 11:42'!
initializeParserWith: aString 
	source := aString.
	self scanner: (self scannerClass on: (ReadStream on: aString))		! !

!RBParser methodsFor: 'error handling' stamp: 'GiselaDecuzzi 6/5/2013 09:31'!
errorPosition
	^currentToken ifNotNil: [ :token | token start] ifNil:[1]! !

!RBParser methodsFor: 'private-classes' stamp: 'lr 11/9/2009 21:08'!
pragmaNodeClass
	^ RBPragmaNode! !

!RBParser methodsFor: 'private' stamp: ''!
patchLiteralMessage
	currentToken value == true 
		ifTrue: 
			[^currentToken := RBIdentifierToken value: 'true' start: currentToken start].
	currentToken value == false 
		ifTrue: 
			[^currentToken := RBIdentifierToken value: 'false' start: currentToken start].
	currentToken value == nil 
		ifTrue: 
			[^currentToken := RBIdentifierToken value: 'nil' start: currentToken start]! !

!RBParser methodsFor: 'initialize-release' stamp: 'GiselaDecuzzi 6/5/2013 09:43'!
scanner: aScanner 
	scanner := aScanner.
	pragmas := nil.
	self initialize.
	self step.! !

!RBParser methodsFor: 'private-parsing' stamp: 'CamilloBruni 11/8/2012 16:01'!
parseStatements: pragmaBoolean into: aSequenceNode
	| temps leftBar rightBar |
	temps := #().
	leftBar := rightBar := nil.
	currentToken isBinary 
		ifTrue: 
			[currentToken value = #| 
				ifTrue: 
					[leftBar := currentToken start.
					self step.
					temps := self parseTemps.
					(currentToken isBinary and: [currentToken value = #|]) 
						ifFalse: [ ^ self parserError: '''|'' expected'].
					rightBar := currentToken start.
					self step]
				ifFalse: 
					[currentToken value = #'||' 
						ifTrue: 
							[rightBar := (leftBar := currentToken start) + 1.
							self step]]].
	^self parseStatementList: pragmaBoolean
		into: (aSequenceNode 
				leftBar: leftBar
				temporaries: temps
				rightBar: rightBar)! !

!RBParser methodsFor: 'testing' stamp: ''!
atEnd
	^currentToken class == RBToken! !

!RBParser methodsFor: 'private-parsing' stamp: 'PabloHerrero 2/16/2015 00:45'!
parseKeywordMessageWith: node 
	| args isKeyword keywordsStartPositions selector|
	args := OrderedCollection new: 3.
	keywordsStartPositions := OrderedCollection new: 3.
	selector := String new.
	
	isKeyword := false.
	[currentToken isKeyword] whileTrue: 
			[keywordsStartPositions add: currentToken start.
			selector := selector, currentToken value.
			self step.
			args add: self parseBinaryMessage.
			isKeyword := true].
	^isKeyword
		ifTrue: 
			[self messageNodeClass 
				receiver: node
				selector: selector
				keywordsPositions: keywordsStartPositions
				arguments: args]
		ifFalse: [node]! !

!RBParser methodsFor: 'private-parsing' stamp: 'PabloHerrero 2/16/2015 01:25'!
parseNegatedNumber
	(self nextToken isLiteralToken not or: [ self nextToken realValue isNumber not ])
		ifTrue: [ ^ self parserError: 'The ''-'' prefix works only for literal numbers (use #negated instead)' ].

	self step; step.
	^ self literalValueNodeClass 
			 	value: self nextToken realValue negated 
				start: currentToken start 
				stop: nextToken stop 
				source: currentToken value, nextToken source.! !

!RBParser methodsFor: 'error handling' stamp: 'GiselaDecuzzi 6/10/2013 15:53'!
parserError: aString 
	"Let the errorBlock try to recover from the error."
	| errorNode errorMessage errorPosition |
	errorNode := self errorBlock cull: aString cull: self errorPosition cull: self.
	errorNode ifNotNil: [ ^ errorNode ].
	currentToken isError 
		ifTrue: [ errorMessage := currentToken cause. errorPosition := currentToken location ] 
		ifFalse: [errorMessage := aString. errorPosition := currentToken start].
	SyntaxErrorNotification
					inClass: Object
					category: nil
					withCode: source
					doitFlag: false
					errorMessage: errorMessage
					location: errorPosition! !

!RBParser methodsFor: 'accessing' stamp: 'MarcusDenker 5/17/2013 14:15'!
parseLiterals: aString 
	| stream |
	stream := WriteStream on: (Array new: 5).
	[self atEnd or: [currentToken isSpecial and: [currentToken value = $)]]] 
		whileFalse: [stream nextPut: self parseLiteralArrayObject].
	
	self atEnd ifFalse: [ ^ self parserError: 'Unknown input at end'].
	
	^stream contents collect: [ :each | each value ]! !

!RBParser methodsFor: 'private-parsing' stamp: 'ClementBera 7/26/2013 17:10'!
parseMethod
	| methodNode | 
	methodNode := self parseMessagePattern.
	self parsePragmas.
	self addCommentsTo: methodNode.
	
	methodNode body: self sequenceNodeClass new.
	(self parseStatements: false into: methodNode body).
	
	pragmas ifNotNil: [ methodNode pragmas: pragmas ].
	^methodNode! !

!RBParser methodsFor: 'private-classes' stamp: 'PabloHerrero 10/25/2013 17:21'!
literalValueNodeClass
	^ RBLiteralValueNode! !

!RBParser methodsFor: 'private-parsing' stamp: 'PabloHerrero 10/28/2013 14:29'!
parsePrimitiveValueLiteral
	| token |
	token := currentToken.
	self step.

	^self literalValueNodeClass 
		value: token value 
		start: token start
		stop: token stop
	! !

!RBParser methodsFor: 'private-parsing' stamp: 'PabloHerrero 10/28/2013 18:17'!
parsePrimitiveLiteral

	currentToken isNumberLiteralToken
		ifTrue: [ ^ self parseNumberLiteral ]
		ifFalse: [ ^ self parsePrimitiveValueLiteral ]! !

!RBParser methodsFor: 'accessing' stamp: 'CamilloBruni 10/31/2012 18:37'!
parseExpression: aString 
	| node |
	node := self parseStatements: false.
	(RBMethodNode selector: #noMethod body: node) source: aString.	"Make the sequence node have a method node as its parent"
	self atEnd ifFalse: [ ^ self parserError: 'Unknown input at end'].
	^node! !

!RBParser methodsFor: 'private-parsing' stamp: 'PabloHerrero 10/20/2013 05:12'!
parseUnaryMessageWith: aNode 
	| selector |
	selector := currentToken.
	self step.
	^self messageNodeClass
		receiver: aNode
		selector:  selector value
		keywordsPositions: (Array with: selector start)
		arguments: #()! !

!RBParser methodsFor: 'private-parsing' stamp: 'CamilloBruni 10/31/2012 18:37'!
parseBlockArgsInto: node 
	| verticalBar args colons |
	args := OrderedCollection new: 2.
	colons := OrderedCollection new: 2.
	verticalBar := false.
	[currentToken isSpecial and: [currentToken value = $:]] whileTrue: 
			[colons add: currentToken start.
			self step.	":"
			verticalBar := true.
			args add: self parseVariableNode].
	verticalBar 
		ifTrue: 
			[currentToken isBinary 
				ifTrue: 
					[node bar: currentToken start.
					currentToken value = #| 
						ifTrue: [self step]
						ifFalse: 
							[currentToken value = #'||' 
								ifTrue: 
									["Hack the current token to be the start 
									of temps bar"

									currentToken
										value: #|;
										start: currentToken start + 1]
								ifFalse: [ ^ self parserError: '''|'' expected']]]
				ifFalse: 
					[(currentToken isSpecial and: [currentToken value = $]]) 
						ifFalse: [ ^ self parserError: '''|'' expected']]].
	node
		arguments: args;
		colons: colons.
	^node! !

!RBParser methodsFor: 'private-parsing' stamp: 'CamilloBruni 10/31/2012 18:36'!
parseArray
	| position node |
	position := currentToken start.
	self step.
	node := self arrayNodeClass new.
	node left: position.
	self parseStatementList: false  into: node.
	(currentToken isSpecial and: [currentToken value = $}]) 
		ifFalse: [ ^ self parserError: 'expected }'].
	node right: currentToken start.
	self step.
	^ node! !

!RBParser methodsFor: 'private-classes' stamp: 'lr 11/1/2009 19:50'!
methodNodeClass
	^ RBMethodNode! !

!RBParser methodsFor: 'private' stamp: 'ClementBera 7/26/2013 17:09'!
addPragma: aPragma
	pragmas ifNil: [ pragmas := OrderedCollection new ].
	pragmas addLast: aPragma! !

!RBParser methodsFor: 'private-parsing' stamp: 'PabloHerrero 10/20/2013 05:14'!
parseBinaryMessageWith: aNode 
	| binaryToken |
	binaryToken := currentToken.
	self step.
	^self messageNodeClass 
		receiver: aNode
		selector:  binaryToken value
		keywordsPositions: (Array with: binaryToken start)
		arguments: (Array with: self parseUnaryMessage)! !

!RBParser class methodsFor: 'accessing' stamp: 'GiselaDecuzzi 5/28/2013 13:22'!
errorNodeBlock
	^ [ :aString :position :parser| parser parseErrorNode: aString ]! !

!RBParser class methodsFor: 'parsing' stamp: ''!
parseRewriteExpression: aString onError: aBlock 
	^RBPatternParser parseExpression: aString onError: aBlock! !

!RBParser class methodsFor: 'parsing' stamp: 'MarcusDenker 5/17/2013 14:08'!
parseLiterals: aString 
	| parser |
	parser := self new.
	parser initializeParserWith: aString.
	^parser parseLiterals: aString! !

!RBParser class methodsFor: 'parsing' stamp: ''!
parseMethodPattern: aString 
	| parser |
	parser := self new.
	parser errorBlock: [:error :position | ^nil].
	parser initializeParserWith: aString.
	^parser parseMessagePattern selector! !

!RBParser class methodsFor: 'parsing' stamp: ''!
parseMethod: aString 
	^self parseMethod: aString onError: nil! !

!RBParser class methodsFor: 'parsing' stamp: ''!
parseRewriteExpression: aString 
	^self parseRewriteExpression: aString onError: nil! !

!RBParser class methodsFor: 'parsing' stamp: ''!
parseRewriteMethod: aString onError: aBlock 
	^RBPatternParser parseMethod: aString onError: aBlock! !

!RBParser class methodsFor: 'parsing' stamp: 'GiselaDecuzzi 5/28/2013 15:09'!
parseExpression: aString onError: aBlock 
	| node parser |
	parser := self new.
	parser errorBlock: aBlock.
	parser initializeParserWith: aString.
	node := parser parseExpression: aString.
	^(node statements size == 1 and: [node temporaries isEmpty]) 
		ifTrue: [node statements first]
		ifFalse: [node]! !

!RBParser class methodsFor: 'parsing' stamp: 'GiselaDecuzzi 6/5/2013 09:53'!
parseFaultyMethod: aString 
	^self parseMethod: aString onError: self errorNodeBlock! !

!RBParser class methodsFor: 'parsing' stamp: ''!
parseExpression: aString 
	^self parseExpression: aString onError: nil! !

!RBParser class methodsFor: 'accessing' stamp: 'MarcusDenker 12/21/2012 12:13'!
parseCompiledMethod: aCompiledMethod
	^ self parseMethod: aCompiledMethod sourceCode! !

!RBParser class methodsFor: 'parsing' stamp: 'GiselaDecuzzi 5/28/2013 15:09'!
parseMethod: aString onError: aBlock 
	| parser |
	parser := self new.
	parser errorBlock: aBlock.
	parser initializeParserWith: aString.
	^parser parseMethod: aString! !

!RBParser class methodsFor: 'parsing' stamp: ''!
parseRewriteMethod: aString 
	^self parseRewriteMethod: aString onError: nil! !

!RBParser class methodsFor: 'parsing' stamp: 'CamilloBruni 10/31/2012 19:08'!
parseFaultyExpression: aString 
	^self parseExpression: aString onError: self errorNodeBlock! !

!RBParserTest commentStamp: 'TorstenBergmann 2/4/2014 21:53'!
SUnit tests for RBParser!
!RBParserTest methodsFor: 'tests' stamp: 'lr 11/2/2009 00:14'!
testBlockRewrites
	| rewriter tree |
	tree := RBParser 
				parseMethod: 'method: asdf
	<primitive: 1>
	<primitive: 2>
	^asdf + self foo + asdf'.
	rewriter := RBParseTreeRewriter new.
	rewriter 
		replace: 'asdf'
		with: 'fdsa'
		when: [:aNode | aNode parent parent isReturn].
	rewriter replace: 'self foo'
		withValueFrom: [:aNode | RBVariableNode named: aNode selector asString].
	rewriter 
		replaceArgument: 'asdf'
		withValueFrom: [:aNode | RBVariableNode named: 'xxx']
		when: [:aNode | false].
	rewriter executeTree: tree.
	self compare: tree
		to: (RBParser 
				parseMethod: 'method: asdf
	<primitive: 1>
	<primitive: 2>
	^asdf +  foo + fdsa')! !

!RBParserTest methodsFor: 'tests' stamp: ''!
testReadBeforeWritten1
	self 
		assert: (RBReadBeforeWrittenTester variablesReadBeforeWrittenIn: (RBParser 
						parseMethod: 'addAll: aCollection 
	"Answer aCollection, having added all elements
	 of aCollection to the receiver.

	 Fail if aCollection is not a kind of
	 Collection."

	| newSize elementsSize growSize |
	(newSize := aCollection size * 2) > elements size ifTrue: [self rehash: newSize].
	elementsSize := elements size.
	growSize := elementsSize // 2.
	aCollection do: 
			[:newObject | 
			| hashIndex element |
			newObject == nil ifFalse: 
					[hashIndex := self hashIndexFor: newObject.
					
					[(element := elements at: hashIndex) == nil
						ifTrue: 
							[elements at: hashIndex put: newObject.
							(elementCount := elementCount + 1) > growSize ifTrue: 
									[self expand.
									elementsSize := elements size.
									growSize := elementsSize // 2].
							true]
						ifFalse: [element == newObject]]
							whileFalse: 
								[(hashIndex := hashIndex + 1) > elementsSize ifTrue: [hashIndex := 1]]]].
	^aCollection')) 
				isEmpty! !

!RBParserTest methodsFor: 'tests' stamp: ''!
testQuerying
	| tree aNode arg1Node bNode |
	tree := RBParser 
				parseMethod: ('test: a`	| b |`	b := (self foo: a; bar) baz.`	b := super test: b.`	^[:arg1 | self foa1 + (super foo: arg1 foo: a foo: b)]' 
						copyReplaceAll: '`'
						with: (String with: (Character value: 13))).
	self 
		assert: tree selfMessages asSortedCollection asArray = #(#bar #foa1 #foo:).
	self assert: tree superMessages asSortedCollection asArray 
				= #(#foo:foo:foo: #test:).
	aNode := tree whichNodeIsContainedBy: (112 to: 112).
	self assert: aNode name = 'a'.
	bNode := tree whichNodeIsContainedBy: (119 to: 119).
	self assert: bNode name = 'b'.
	arg1Node := tree whichNodeIsContainedBy: (102 to: 105).
	self assert: arg1Node name = 'arg1'.
	self assert: (arg1Node statementNode isMessage 
				and: [arg1Node statementNode selector = #+]).
	self assert: (arg1Node whoDefines: 'arg1') isBlock.
	self assert: (aNode whoDefines: 'a') isMethod.
	self assert: (aNode whoDefines: 'b') isSequence.
	self assert: (tree whichNodeIsContainedBy: (91 to: 119)) selector 
				= #foo:foo:foo:.
	self assert: (tree whichNodeIsContainedBy: (69 to: 121)) isBlock.
	self assert: (tree whichNodeIsContainedBy: (69 to: 118)) isNil.
	self assert: aNode blockVariables asSortedCollection asArray = #('arg1').
	self assert: aNode temporaryVariables asSortedCollection asArray = #('b').
	self assert: tree allDefinedVariables asSortedCollection asArray 
				= #('a' 'arg1' 'b').
	self assert: tree allArgumentVariables asSortedCollection asArray 
				= #('a' 'arg1').
	self 
		assert: tree allTemporaryVariables asSortedCollection asArray = #('b')! !

!RBParserTest methodsFor: 'accessing' stamp: 'lr 9/18/2011 15:58'!
exampleClasses
	^ Array with: RBParser with: RBScanner with: RBProgramNode with: RBConfigurableFormatter! !

!RBParserTest methodsFor: 'tests' stamp: 'nk 2/23/2005 15:58'!
testReadBeforeWritten
	#(('a ifTrue: [^self]' true ) ('self foo. a := b' false ) ('condition ifTrue: [a := b] ifFalse: [self foo: a]' true ) ('condition ifTrue: [a := b] ifFalse: [self foo]. a isNil' true ) ('condition ifTrue: [a := b]. a := c' false ) ('[a := b] whileFalse: [a isNil]' false ) ('self foo: b' false ) ) do: 
		[:each | 
		self assert: ((RBReadBeforeWrittenTester readBeforeWritten: #('a' ) in: (RBParser parseExpression: each first))
				includes: 'a')
				== each last.
		self assert: (RBReadBeforeWrittenTester isVariable: 'a' readBeforeWrittenIn: (RBParser parseExpression: each first))
				= each last].
	#('| temp read written written1 |
			read ifTrue: [^self].
			written1 := self foo ifFalse: [written := true] ifTrue: [written := false].
			[temp := true] whileTrue: [temp notNil & written].
			^temp' '| read written |
			self foo ifTrue: [written := true] ifFalse: [written := false].
			self foo ifTrue: [read := true].
			^read' '| read written |
			self foo do: [:i | i].
			[| i | i := 1. i == 1] whileFalse: [read notNil]' '| written |
			[written := 2] whileFalse.
			self do: [:each | | read | each & read]' '| read |
			self do: [:each | read := each].
			self do: [:each | each & read]' ) do: 
		[:each | 
		| read | 
		read := RBReadBeforeWrittenTester variablesReadBeforeWrittenIn: (RBParser parseExpression: each).
		self assert: (read size = 1 and: [read includes: 'read'])]! !

!RBParserTest methodsFor: 'tests' stamp: 'GiselaDecuzzi 5/27/2013 19:31'!
testParseFaultyMethodExpresionHasErrorNodeAsFinal
	| node strangeExpression |
	
	strangeExpression := 'method: asd  ^ asd. n'.
	node := self parseFaultyMethod: strangeExpression.

	self assert: node isMethod.
	self assert: node isFaulty.
	self assert: node statements size equals: 2.
	self assert: node statements last  isFaulty
	! !

!RBParserTest methodsFor: 'private' stamp: 'GiselaDecuzzi 5/27/2013 18:31'!
parseFaultyMethod: text
	^RBParser parseFaultyMethod: text.! !

!RBParserTest methodsFor: 'tests' stamp: 'ms 4/1/2007 13:49'!
testPrimitives
	self assert: (Object parseTreeFor: #basicAt:) isPrimitive.
	#(('foo ^true' false ) ('foo <some: tag> ^true' false ) (' foo <some: tag> <primitive: 123> ^true' true ) ) do: [:each | self assert: (RBParser parseMethod: each first) isPrimitive = each last]! !

!RBParserTest methodsFor: 'tests' stamp: 'GiselaDecuzzi 6/10/2013 11:38'!
testParseFaultyMethod
	| node strangeExpressions |
	
	strangeExpressions := OrderedCollection new .
	strangeExpressions 
		add: 'method: asd   self ,';
		add: 'method: asd   self a:'; "message without needed argument"
		add: 'method: asd   []]'; 
		add: 'method: asd  [  ] ,';"binary message without second argument"
		add: 'method:  ^^'; "returning twice"
		add: 'method: asd  ['; "opening a block"
		add: 'method: asd  ^ asd. n'; "invalid expresion after return"
		add: 'method: asd  ^ {'; "Only Open a literal array"
		add: 'selector '''; 
		add: 'selector #^';
		add: 'selector ¿'.


	strangeExpressions do: [ :exp | 
			node := self parseFaultyMethod: exp.
			self assert: node isMethod.
			self assert: node isFaulty.
	].

	! !

!RBParserTest methodsFor: 'tests' stamp: 'ms 4/1/2007 12:32'!
testPositions
	| blockNode |
	blockNode := RBParser parseExpression: '[:a :b | ]'.
	self assert: blockNode left = 1.
	self assert: blockNode right = 10.
	self assert: blockNode bar = 8.
	self assert: blockNode sourceInterval = (1 to: 10).
	self assert: blockNode size = 1.	"test dummy collection protocol"
	blockNode printString.	"coverage"
	self deny: (blockNode isLast: (RBVariableNode named: 'b')).
	self compare: blockNode
		to: (RBBlockNode 
				arguments: (OrderedCollection with: (RBVariableNode named: 'a')
						with: (RBVariableNode named: 'b'))
				body: (RBSequenceNode statements: OrderedCollection new)).
				! !

!RBParserTest methodsFor: 'tests' stamp: 'PabloHerrero 10/24/2013 11:30'!
testParseMethodWithErrorTokenIsWellFormed
	| node strangeMethod body statement message errorNode |
	
	strangeMethod := '
	selector  
		|temp| 
		temp := ''this is right'', ''wrong because no end.
		^temp'.
	node := self parseFaultyMethod: strangeMethod.

	self assert: node isMethod.
	self assert: node isFaulty.
	self assert: node arguments isEmpty.

	body := node body.
	self assert: body isSequence.
	self assert: body isFaulty.
	self assert: (body temporaries includes: (RBVariableNode named: 'temp')).

	statement := body statements first.
	self assert: statement isFaulty.
	self assert: statement isAssignment .
	
	message := statement value.
	self assert: message isFaulty.
	self assert: message arguments size equals: 1.

	errorNode := message arguments at: 1.
	self assert: errorNode isFaulty.
	self assert: errorNode value equals: 'wrong because no end.
		^temp'.
	self assert: errorNode errorMessage equals: 'Unmatched '' in string literal.' translated.
	
	
	! !

!RBParserTest methodsFor: 'tests' stamp: 'CamilloBruni 3/6/2013 15:03'!
testPragmaPrimitiveError
	| tree  pragma |
	tree := RBParser 
				parseMethod: 'veryBasicAt: index 
	<primitive: #dooo module: #bar error: code>
	^ code'.
	
	self assert: tree pragmas size equals: 1.
	
	pragma := tree pragmas first.
	self assert: pragma selector equals: #primitive:module:error:.! !

!RBParserTest methodsFor: 'private' stamp: 'lr 9/18/2011 15:09'!
treeWithEverything
	^ RBParser parseMethod: 'method: arg1 | temps | temps := #(10). temps foo; foo. ^(temps collect: [:e | ])'! !

!RBParserTest methodsFor: 'private' stamp: 'lr 9/18/2011 15:09'!
treeWithReallyEverything
	^ RBParser parseMethod: 'method: arg1 <foo> <foo: 1.2> | temps | temps := #[ 1 2 3 ]. temps := #(true false nil 1 1.2 $a foo #foo ''foo'' #() #(1 2) #[] #[1 2]). { 1 negated. 1 + 2. 1 raisedTo: 2 }. temps foo; foo: self. ^ (temps collect: [:e | | btemps | ((e isNil)) ])'! !

!RBParserTest methodsFor: 'accessing' stamp: ''!
compare: anObject to: anotherObject 
	self assert: anObject hash = anotherObject hash.
	self assert: anObject = anotherObject! !

!RBParserTest methodsFor: 'tests' stamp: 'PabloHerrero 5/29/2014 06:27'!
testNumberParsing
	| numbers node |
	numbers := #(('1' 1) ('-1' -1) ('123' 123) ('123' 123) ('-123' -123) ('1.1' 1.1) ('-1.1' -1.1) ('1.23' 1.23) ('-1.23' -1.23) ('1e3' 1e3) ('1d3' 1d3) ('1q3' 1q3) ('-1e3' -1e3) ('1e-3' 1e-3) ('-1e-3' -1e-3) ('2r1e8'  2r1e8) ('-2r1e8' -2r1e8) ('2r1e-8' 2r1e-8) ('-2r1e-8' -2r1e-8) ('0.50s2' 0.50s2) ('0.500s3' 0.500s3) ('0.050s3' 0.050s3)).
	numbers do: [ :spec |
		node := RBParser parseExpression: spec first.
		self assert: node source = spec first.
		self assert: node value = spec second ]! !

!RBParserTest methodsFor: 'tests' stamp: 'lr 9/18/2011 15:19'!
testEqualToWithMapping
	| tree |
	tree := self treeWithEverything.
	self assert: (tree equalTo: tree withMapping: Dictionary new).
	tree := self treeWithReallyEverything.
	self assert: (tree equalTo: tree withMapping: Dictionary new).
	
	self exampleClasses do: [ :class |
		class selectors do: [ :each |
			tree := class parseTreeFor: each.
			self assert: (tree equalTo: tree withMapping: Dictionary new) ] ]! !

!RBParserTest methodsFor: 'tests' stamp: 'lr 11/2/2009 00:14'!
testPatternCascade
	| rewriter |
	rewriter := RBParseTreeRewriter new.
	rewriter replace: 'self `;messages; foo: 4; `;messages1'
		with: 'self `;messages1; bar: 4; `;messages'.
	self compare: (rewriter
				executeTree: (RBParser 
							parseExpression: 'self foo; printString; foo: 4; bar. self foo: 4');
				tree)
		to: (RBParser 
				parseExpression: 'self bar; bar: 4; foo; printString. self foo:4')! !

!RBParserTest methodsFor: 'tests' stamp: 'ClementBEra 1/30/2013 15:05'!
testSymbolLiteral
	| tree |
	#(
	'#<' #<
	'#>' #>
	'#<>' #<>
	'# foo' #foo
	'#"bar"foo' #foo 
	'##foo' #foo 
	'###foo' #foo 
	'#foo:' #foo:
	'#foo::' #'foo::'
	'#foo::bar' #'foo::bar'
	'#foo::bar:' #'foo::bar:'
	'#foo::bar::' #'foo::bar::') pairsDo: [ :parseString :expectedResult |
		tree := RBParser parseExpression: parseString.
		self assert: tree value equals: expectedResult.		
		self assert: tree start equals: 1.
		self assert: tree stop equals: parseString size ].
	
	#(('#1' 1) ('#12' 12) ('#12.3' 12.3) ('# 1' 1) ('##1' 1) ('#"bar"1' 1)) do: [ :pair | 
		tree := RBParser parseExpression: pair first.
		self assert: tree value = pair second.		
		self assert: tree start > 1.
		self assert: tree stop = pair first size ]! !

!RBParserTest methodsFor: 'tests' stamp: 'lr 5/30/2010 12:15'!
testRewriteMethods
	"#('source' 'target' 'source pattern' 'target pattern')"
	#(#('arg1: a arg2: b | temp1 temp2 | self stmt1 ifTrue: [^a]. self arg1: a arg2: b' 'arg2: a arg1: b | temp1 temp2 | self stmt1 ifTrue: [^a]. self arg2: b arg2: a' '`arg1: `var1 `arg2: `var2 | `@temps | ``@.stmts. self `arg1: `var1 `arg2: `var2. `@.stmts1' '`arg2: `var1 `arg1: `var2 | `@temps | ``@.stmts. self `arg2: `var2 `arg2: `var1. `@.stmts1') #('arg1: a arg2: b | temp1 temp2 | self stmt1. self arg1: a arg2: b' 'arg1: a arg2: b | temp1 temp2 | [self stmt1] repeat' '`@args: `@vars | `@temps | `@.stmts. self `@args: `@vars' '`@args: `@vars | `@temps | [`@.stmts] repeat') #('+ a | temps | ^self primitiveValue' '- a | temps | ^self primitiveValue' '+ `temp | `@tmps | `@.stmts' '- `temp | `@tmps | `@.stmts') #('a self stmt1. self stmt2' 'a self stmt1. self stmt2' 'b | `@temps | `@.stmts' 'c | `@temps | `@.stmts') #('a <foo: 1 bar: 2>' 'a <bar: 2 foo: 1>' 'a <`sel1: `#arg1 `sel2: `#arg2>' 'a <`sel2: `#arg2 `sel1: `#arg1>') #('a <foo> self foo' 'b <foo> self foo' 'a `@.stmts' 'b `@.stmts'))
		do: 
			[:each | 
			| rewrite |
			rewrite := RBParseTreeRewriter new.
			rewrite replaceMethod: (each at: 3) with: each last.
			self compare: (RBParser 
						parseMethod: (rewrite
								executeTree: (RBParser parseMethod: each first);
								tree) formattedCode)
				to: (RBParser parseMethod: (each at: 2)).
			rewrite := RBParseTreeRewriter new.
			rewrite replaceTree: (RBParser parseRewriteMethod: (each at: 3))
				withTree: (RBParser parseRewriteMethod: each last).
			self compare: (RBParser 
						parseMethod: (rewrite
								executeTree: (RBParser parseMethod: each first);
								tree) formattedCode)
				to: (RBParser parseMethod: (each at: 2))]! !

!RBParserTest methodsFor: 'tests' stamp: 'nk 2/23/2005 15:58'!
testEquivalentExceptRenaming
	#(('a 3-4' 'a 4-3' false ) ('a #[3 4]' 'a #(3 4)' false ) ('a variable1 ~~ "comment" variable2' 'a variable1 ~~ variable2' true ) ('a variable1' 'a variable2' false ) ('a [:a :b | a + b]' 'a [:b :a | a + b]' false ) ('a | a b | a + b' 'a | b a | a + b' true ) ('a | a | a msg1; msg2' 'a | b | b msg2; msg2' false ) ('a c' 'a d' true ) ('a | a b | a := b. ^b msg1' 'a | a b | b := a. ^a msg1' true ) ('a | a b | a := b. ^b msg1: a' 'a | a b | b := a. ^b msg1: a' false ) ('a: b b + 4' 'a: e e + 4' true ) ('a: b b + 4' 'b: b b + 4' false ) ('a: b b: c b + c' 'a: c b: b c + b' true ) ('a: a b: b a + b' 'a: b b: a a + b' false ) ) do: [:each | self assert: ((RBParser parseMethod: each first)
				equalTo: (RBParser parseMethod: (each at: 2))
				exceptForVariables: #('c' ))
				== each last ]! !

!RBParserTest methodsFor: 'tests' stamp: 'ClementBEra 1/30/2013 15:29'!
testPragmas
	| tree node |
	#(('foo <foo>' 				#foo ()) 
	('foo <foo: 1>' 				#foo: (1)) 
	('foo <foo: 1.2>' 			#foo: (1.2)) 
	('foo <foo: -3>' 			#foo: (-3)) 
	('foo <foo: a>' 				#foo: (a)) 
	('foo <foo: #a>' 			#foo: (a)) 
	('foo <foo: #< >' 			#foo: (<)) 
	('foo <foo: #> >' 			#foo: (>)) 
	('foo <foo: $a>' 			#foo: ($a)) 
	('foo <foo: ''bar''>' 		#foo: ('bar')) 
	('foo <foo: true>' 			#foo: (true)) 
	('foo <foo: false>' 			#foo: (false)) 
	('foo <foo: nil>' 			#foo: (nil)) 
	('foo <foo: #(1 2)>' 		#foo: ((1 2)))
	('foo <foo: 1 bar: 2>' 		#foo:bar: (1 2))
	('foo |t| <foo: 1.2>' 		#foo: (1.2))
	('foo self. <foo: $a>' 		#foo: ($a)) 
	('foo |t| <foo: 1 bar: 2>' #foo:bar: (1 2))
	) do: [ :each |
		tree := RBParser parseMethod: each first.
		self assert: (tree pragmas size = 1).
		node := tree pragmas first.
		self assert: node selector = each second.
		1 to: node arguments size do: [ :i |
			self assert: (node arguments at: i) value = (each last at: i) ].
		self assert: (each first at: node start) equals: $<.
		self assert: (each first at: node stop) equals: $> ].
	
	self assert: (RBParser parseMethod: 'selector <a>') isMethod.
	self assert: (RBParser parseMethod: '
	selector 
		"comment1" 
		|temp| 
		"comment2" 
		<a> 
		#<.
		^1') isMethod.
	self should: [RBParser parseMethod: '
	selector 
		"comment1" 
		|temp| 
		"comment2" 
		<a> 
		<.
		^1'] raise: SyntaxErrorNotification.! !

!RBParserTest methodsFor: 'tests' stamp: 'lr 11/2/2009 00:14'!
testSearching
	| searcher |
	searcher := RBParseTreeSearcher new.
	searcher matches: '``@rcv at: ``@arg `sel: ``@arg1'
		do: [:aNode :answer | answer + 1].
	self 
		assert: (searcher executeTree: (RBParser 
						parseExpression: 'self at: 1 put: 2; at: 2 ifAbsent: []; ifAbsent: 2 at: 1; at: 4; foo')
				initialAnswer: 0) = 2.
	searcher := RBParseTreeSearcher new.
	searcher matches: '``@rcv `at: ``@arg1 `at: ``@arg2'
		do: [:aNode :answer | answer + 1].
	self 
		assert: (searcher executeTree: (RBParser 
						parseExpression: 'self at: 1 at: 3; at: 1 put: 32; at: 2; foo; at: 1 at: 1 at: 2')
				initialAnswer: 0) = 1.
	searcher := RBParseTreeSearcher new.
	searcher matchesMethod: 'at: `object `put: `o1 ``@rcv `put: 1'
		do: [:aNode :answer | true].
	self assert: (searcher 
				executeTree: (RBParser parseMethod: 'at: a put: b self foo put: 1')
				initialAnswer: false)! !

!RBParserTest methodsFor: 'tests' stamp: 'MarcusDenker 9/20/2013 15:07'!
testIntervals
	| tree |
	tree := self treeWithReallyEverything.
	tree nodesDo: 
			[:each | 
			(each parent isNil or: [each parent isCascade not and: [ each parent isLiteralNode not]]) 
				ifTrue: 
					[| newNode source |
					source := tree source copyFrom: each start to: each stop.
					each isPragma ifFalse: [
						newNode := each isMethod 
								ifTrue: [RBParser parseMethod: source]
								ifFalse: [RBParser parseExpression: source].
						self compare: each to: newNode]]]! !

!RBParserTest methodsFor: 'tests' stamp: 'lr 9/18/2011 15:18'!
testCopy
	| tree |
	tree := self treeWithEverything.
	self compare: tree to: tree copy.
	tree := self treeWithReallyEverything.
	self compare: tree to: tree copy.
	
	self exampleClasses do: [ :class |
		class selectors do: [ :each |
			tree := class parseTreeFor: each.
			self compare: tree to: tree copy ] ]! !

!RBParserTest methodsFor: 'tests' stamp: 'ms 4/1/2007 12:11'!
testCreationProtocol
	| messageNode |
	self compare: (RBMessageNode 
				receiver: (RBVariableNode named: 'self')
				selector: #+
				arguments: (Array with: (RBLiteralNode value: 0)))
		to: (RBParser parseExpression: 'self + 0').
	messageNode := RBMessageNode receiver: (RBVariableNode named: 'self')
				selector: #foo.
	self compare: (RBMethodNode selector: #bar
				body: (RBSequenceNode statements: (OrderedCollection 
								with: (RBCascadeNode messages: (OrderedCollection with: messageNode with: messageNode)))))
		to: (RBParser parseMethod: 'bar self foo; foo')! !

!RBParserTest methodsFor: 'tests' stamp: 'lr 11/2/2009 00:14'!
testMultimatch
	| rewriter count |
	count := 0.
	rewriter := RBParseTreeRewriter new.
	rewriter 
		replace: '``@object at: ``@foo'
		with: '``@object foo: ``@foo'
		when: [:aNode | (count := count + 1) == 2].
	self compare: (rewriter
				executeTree: (RBParser parseExpression: 'self at: (bar at: 3)');
				tree)
		to: (RBParser parseExpression: 'self at: (bar foo: 3)')! !

!RBParserTest methodsFor: 'tests' stamp: 'StephaneDucasse 5/30/2014 08:50'!
testArray
	| tree |
	#(('{}' 0 0) ('{.}' 0 1) ('{..}' 0 2) ('{foo. bar}' 2 1) ('{foo. bar.}' 2 2) ('{foo. bar. .}' 2 3) ('{. foo. bar}' 2 2) ('{foo.. bar}' 2 2))
	 do: [ :each |
		tree := RBParser parseExpression: each first.
		self assert: tree statements size = each second.
		self assert: tree periods size = each last.
		self assert: tree left = 1.
		self assert: tree right = each first size ]! !

!RBParserTest methodsFor: 'tests' stamp: ''!
testCascadeReplacement
	| cascade |
	cascade := RBParser parseExpression: 'self foo; bar; baz'.
	(cascade messages at: 2) 
		replaceWith: (RBParser parseExpression: 'self bar: 2').
	self compare: cascade
		to: (RBParser parseExpression: 'self foo; bar: 2; baz')! !

!RBParserTest methodsFor: 'tests' stamp: 'lr 11/1/2009 20:50'!
testNodesDo
	| size |
	size := 0.
	self treeWithEverything nodesDo: [:e | size := size + 1].
	self assert: size = 19! !

!RBParserTest methodsFor: 'tests' stamp: 'lr 4/29/2010 21:22'!
testSymbolNumber
	| tree |
	#(('#1' 1) ('#12' 12) ('#12.3' 12.3) ('# 1' 1) ('##1' 1) ('#"bar"1' 1)) do: [ :pair | 
		tree := RBParser parseExpression: pair first.
		self assert: tree value = pair second.		
		self assert: tree start > 1.
		self assert: tree stop = pair first size ]! !

!RBParserTest methodsFor: 'tests' stamp: 'lr 11/1/2009 20:40'!
testLiteralIntevals
	| tree |
	tree := RBParser parseExpression: '#(#a b #( c ))'.
	self assert: tree contents first start = 3.
	self assert: tree contents first stop = 4.
	self assert: tree contents last contents first start = 11! !

!RBParserTest methodsFor: 'tests' stamp: 'lr 9/18/2011 15:19'!
testComparingTrees
	self compare: self treeWithEverything to: self treeWithEverything.
	self compare: self treeWithReallyEverything to: self treeWithReallyEverything.
	
	self exampleClasses do: [ :class |
		class selectors do: [ :selector | 
			self
				compare: (class parseTreeFor: selector) 
				to: (class parseTreeFor: selector) ] ]! !

!RBParserTest methodsFor: 'tests' stamp: 'lr 11/1/2009 20:38'!
testParserErrors
	#(#('self foo. + 3' 11) #('#(' 3) #('self 0' 6) #('self asdf;;asfd' 11)) 
		do: [:each | self parseError: each]! !

!RBParserTest methodsFor: 'tests' stamp: 'lr 9/18/2011 15:20'!
testFormatter
	self exampleClasses do: [ :class |
		class selectors do: [ :selector | 
		self 
			compare: (class parseTreeFor: selector)
			to: (RBParser parseMethod: (class parseTreeFor: selector) printString) ] ]! !

!RBParserTest methodsFor: 'tests' stamp: 'lr 11/1/2009 20:36'!
testLiteralArray
	| tree collection |
	tree := RBParser parseExpression: '#( a #b #''c'' . + - 1 -2 3.4 #true true #false false #nil nil "comment" ''string'' #[ 1 2 3 ] #(1 2 3))'.
	collection := OrderedCollection new.
	collection add: #a; add: #b; add: #c; add: #'.'; add: #+; add: #-; add: 1; add: -2; add: 3.4; add: #true; add: true; add: #false; add: false; add: #nil; add: nil; add: 'string'; add: #[1 2 3]; add: #(1 2 3).	
	tree value with: collection do: [ :token :value | 
		self assert: token value = value ]! !

!RBParserTest methodsFor: 'tests' stamp: 'SeanDeNigris 2/9/2013 15:02'!
testRewrites
	"#('source' 'target' 'source pattern' 'target pattern')"
	#(
		(	'[:c | |a| a foo1; foo2]'	
			'[:c | |a| b foo1; foo2]'
			'a'
			'b' )
		(	'self foo: 1. bar foo1 foo: 2. (self foo: a) foo: (b foo: c)'
			'self bar: 1. bar foo1 bar: 2. (self bar: a) bar: (b bar: c)'
			'``@rcvr foo: ``@arg1'
			'``@rcvr bar: ``@arg1' )
		('3 + 4'	'4 + 4'		'3'		'4' )
		('a := self a'		'b := self a'		'a'		'b' )
		(	'^self at: 1 put: 2'
			'^self put: 1 put: 2'	
			'^`@rcvr `at: `@arg1 put: `@arg2'
			'^`@rcvr put: `@arg1 put: `@arg2' )
		('1 + 2 + 3'		'0 + 0 + 0'		'`#literal'		'0' )
		(
			'1 + 2 + 3. 3 foo: 4'
			'3 + (2 + 1). 4 foo: 3'
			'``@rcvr `msg: ``@arg'
			'``@arg `msg: ``@rcvr' )
		(	'self foo: a bar: b. 1 foo: a bar: b'
			'2 foo: a bar: b. 1 foo: a bar: b'
			'self `@msg: `@args'
			'2 `@msg: `@args' ) 
		(	'a := b. a := c + d'
			'b := a. a := c + d'
			'`var1 := `var2'
			'`var2 := `var1' )
		(	'^self foo value: 1'
			'self return: (self foo value: 1)'
			'^`@anything'
			'self return: `@anything' )
		(	'self first; second. self first; second. self a. self b'
			'2 timesRepeat: [self first; second]. self a. self b'
			'`.Stmt1. `.Stmt1. `@.stmts'
			'2 timesRepeat: [`.Stmt1]. `@.stmts' )
		(	'[:a | self a: 1 c: 2; b]'
			'[:a | self d: 2 e: 1; f. self halt]'
			'`@rcvr `msg1: `@arg1 `msg2: `@arg2; `msg'
			'`@rcvr d: `@arg2 e: `@arg1; f. self halt' )  ) do: 
		[:each | 
		| rewrite | 
		rewrite := RBParseTreeRewriter new.
		rewrite replace: (each at: 3)
			with: each last.
		self compare: (RBParser parseExpression: (rewrite executeTree: (RBParser parseExpression: each first);
				 tree) formattedCode)
			to: (RBParser parseExpression: (each at: 2))]! !

!RBParserTest methodsFor: 'tests' stamp: ''!
testMethodPatterns
	#(#('+ a ^self + a' #+) #('foo ^self foo' #foo) #('foo: a bar: b ^a + b' #foo:bar:)) 
		do: [:each | self assert: (RBParser parseMethodPattern: each first) == each last]! !

!RBParserTest methodsFor: 'tests' stamp: 'lr 11/1/2009 20:32'!
testStatements
	| tree |
	#(('' 0 0) ('.' 0 1) ('| bar |' 0 0) ('| bar | .' 0 1) ('| bar | ..' 0 2) ('foo. bar' 2 1) ('foo. bar.' 2 2) ('foo. bar. .' 2 3) ('. foo. bar' 2 2)) do: [ :each |
		tree := RBParser parseExpression: each first.
		self assert: tree statements size = each second.
		self assert: tree periods size = each last ]! !

!RBParserTest methodsFor: 'tests' stamp: 'ClementBEra 1/30/2013 15:09'!
testString
	self assert: (RBParser parseMethod: 'selector ^ ''<''') isMethod.
	self assert: (RBParser parseMethod: 'selector ^ ''<'', self') isMethod.
	self assert: (RBParser parseMethod: 'selector ''=''') isMethod.
	self assert: (RBParser parseMethod: 'selector '':=''') isMethod.
	self assert: (RBParser parseMethod: 'selector ''<''') isMethod.
	self assert: (RBParser parseMethod: 'selector ''>''') isMethod.
	self assert: (RBParser parseMethod: 'selector ^ ''<>''') isMethod.! !

!RBParserTest methodsFor: 'tests' stamp: 'lr 12/16/2009 09:22'!
testNumberRadixParsing
	2 to: 32 do: [ :radix | 
		| radixString |
		radixString := radix printString, 'r'.
		0 to: 72 do: [ :i | 
			self  assert: (RBParser parseExpression: (radixString, (i radix: radix)))
				value = i ] ]! !

!RBParserTest methodsFor: 'tests' stamp: 'lr 10/27/2009 14:31'!
testBestNodeFor
	| tree |
	tree := self treeWithReallyEverything.
	tree nodesDo: 
			[:each | 
			each sourceInterval isEmpty 
				ifFalse: 
					[self assert: ((tree bestNodeFor: each sourceInterval) = each 
								or: [each parent isCascade and: [each parent messages last = each]])]]! !

!RBParserTest methodsFor: 'tests' stamp: 'lr 9/18/2011 15:18'!
testCopyInContext
	| tree |
	tree := self treeWithEverything.
	self compare: tree to: (tree copyInContext: Dictionary new).
	tree := self treeWithReallyEverything.
	self compare: tree to: (tree copyInContext: Dictionary new).
	
	self exampleClasses do: [ :class |
		class selectors do: [ :each |
			tree := class parseTreeFor: each.
			self compare: tree to: (tree copyInContext: Dictionary new) ] ]! !

!RBParserTest methodsFor: 'tests' stamp: 'lr 11/2/2009 00:14'!
testReplacingNodes
	| tree search block |
	tree := RBParser 
				parseMethod: '+ a | a b | self ifTrue: [a] ifFalse: [b := c]. a := b. [:b :c :a | a foo: a; foo1: a; foo2: a foo: b]. {a. b}. ^a'.
	search := RBParseTreeSearcher new.
	block := [:aNode :answer | aNode replaceWith: (RBVariableNode named: 'q')].
	search
		matches: 'a' do: block;
		matchesArgument: 'a' do: block.
	search executeTree: tree.
	self 
		assert: tree = (RBParser 
						parseMethod: '+ q | q b | self ifTrue: [q] ifFalse: [b := c]. q := b. [:b :c :q | q foo: q; foo1: q; foo2: q foo: b]. {q. b}. ^q').
	self 
		assert: tree removeDeadCode = (RBParser 
						parseMethod: '+ q | q b | self ifTrue: [] ifFalse: [b := c]. q := b. {q. b}. ^q')! !

!RBParserTest methodsFor: 'tests' stamp: 'PabloHerrero 10/19/2013 07:17'!
testModifying
	| tree |
	tree := RBParser 
				parseMethod: 'foo: a bar: b | c | self first. self second. a + b + c'.
	self deny: tree lastIsReturn.
	self deny: (tree body statements at: 2) isUsed.
	self assert: tree body statements last arguments first isUsed.
	self assert: (tree isLast: tree body statements last).
	self deny: (tree isLast: tree body statements first).
	self assert: (tree defines: 'a').
	self deny: (tree defines: 'c').
	self assert: (tree body defines: 'c').
	self deny: (tree body defines: 'a').
	tree
		addReturn;
		selector: #bar:foo:.
	(tree body)
		addTemporaryNamed: 'd';
		removeTemporaryNamed: 'c'.
	self compare: tree
		to: (RBParser 
				parseMethod: 'bar: a foo: b | d | self first. self second. ^a + b + c').
	self 
		assert: ((tree argumentNames asSet)
				removeAll: #('a' 'b');
				yourself) isEmpty.
	self 
		assert: ((tree allDefinedVariables asSet)
				removeAll: #('a' 'b' 'd');
				yourself) isEmpty.
	tree := RBParser parseExpression: 'self foo: 0'.
	tree selector: #+.
	self compare: tree to: (RBParser parseExpression: 'self + 0').! !

!RBParserTest methodsFor: 'tests' stamp: 'MarcusDenker 9/20/2013 15:07'!
testIsA
	| nodes types |
	nodes := Bag new.
	types := Set new.
	#(#(#isAssignment 1) #(#isBlock 1) #(#isCascade 1) #(#isLiteralNode 2) #(#isMessage 3) #(#isMethod 1) #(#isReturn 1) #(#isSequence 2) #(#isValue 15) #(#isVariable 7) #(#isUsed 10) #(#isDirectlyUsed 9) #(#hasParentheses 1) #(#isBinary 0) #(#isPrimitive 0) #(#isImmediateNode 10) #(#isWrite 1) #(#isRead 3)) 
		do: 
			[:each | 
			each last timesRepeat: [nodes add: each first].
			types add: each first].
	self treeWithEverything nodesDo: 
			[:each | 
			types do: 
					[:sel | 
					((each respondsTo: sel) and: [each perform: sel]) 
						ifTrue: [nodes remove: sel]]].
	self assert: nodes isEmpty! !

!RBParserTest methodsFor: 'tests' stamp: 'lr 5/26/2010 19:03'!
testParents
	(Array with: self treeWithEverything with: self treeWithReallyEverything) do: [ :tree |
		(Array with: tree with: tree copy) do: [ :root |
			root nodesDo: [ :node |
				node children do: [ :each |
					(each parent isMessage and: [ each parent isCascaded ]) ifFalse: [ 
						self assert: each parent == node.
						self assert: each methodNode == root ] ] ] ] ]! !

!RBParserTest methodsFor: 'private' stamp: 'lr 9/18/2011 15:10'!
parseError: each
	RBParser 
		parseExpression: each first 
		onError: [ :string :pos | ^ self assert: pos = each last ].
	self assert: false description: 'Parser didn''t fail'! !

!RBParserTest methodsFor: 'tests' stamp: 'lr 9/18/2011 15:21'!
testMatchInContext
	| tree |
	tree := self treeWithEverything.
	self assert: (tree match: tree inContext: Dictionary new).
	tree := self treeWithReallyEverything.
	self assert: (tree match: tree inContext: Dictionary new).
	
	self exampleClasses do: [ :class |
		class selectors do: [ :each |
			tree := class parseTreeFor: each.
			self assert: (tree match: tree inContext: Dictionary new) ] ]! !

!RBParserTest methodsFor: 'tests' stamp: 'lr 10/27/2009 15:53'!
testParsingLiteralMessages
	self assert: (RBParser parseExpression: 'nil self nil') isMessage.
	self assert: (RBParser parseExpression: 'self true') isMessage.
	self assert: (RBParser parseExpression: 'self false') isMessage.
	self assert: (RBParser parseExpression: 'self -1') isMessage.
	
	self assert: (RBParser parseMethod: 'nil') isMethod.
	self assert: (RBParser parseMethod: 'true') isMethod.
	self assert: (RBParser parseMethod: 'false') isMethod! !

!RBPatternBlockNode commentStamp: 'md 8/9/2005 14:56'!
RBPatternBlockNode is the node in matching parse trees (it never occurs in normal Smalltalk code) that executes a block to determine if a match occurs. valueBlock takes two arguments, the first is the actual node that we are trying to match against, and second node is the dictionary that contains all the metavariable bindings that the matcher has made thus far.

Instance Variables:
	valueBlock	<BlockClosure>	The block to execute when attempting to match this to a node.

!
!RBPatternBlockNode methodsFor: 'accessing' stamp: 'lr 5/30/2010 14:27'!
sentMessages
	^ OrderedCollection new! !

!RBPatternBlockNode methodsFor: 'matching' stamp: ''!
createReplacingBlock
	| newBlock |
	self arguments size > 1 
		ifTrue: 
			[self 
				error: 'Replace blocks can only contain an argument for the matching dictionary'].
	newBlock := RBBlockNode arguments: arguments body: body.
	self arguments isEmpty 
		ifTrue: [self addArgumentWithNameBasedOn: 'aDictionary' to: newBlock].
	^self createBlockFor: newBlock! !

!RBPatternBlockNode methodsFor: 'matching' stamp: 'ClementBera 7/26/2013 17:16'!
replacingBlock
	^ valueBlock ifNil: [valueBlock := self createReplacingBlock]! !

!RBPatternBlockNode methodsFor: 'matching' stamp: ''!
replacePatternNodesIn: aRBBlockNode 
	aRBBlockNode body nodesDo: 
			[:each | 
			(each isVariable and: [each isPatternNode]) 
				ifTrue: 
					[each 
						replaceWith: (self constructLookupNodeFor: each name in: aRBBlockNode)]]! !

!RBPatternBlockNode methodsFor: 'matching' stamp: 'lr 11/24/2009 23:30'!
copyInContext: aDictionary 
	^ self replacingBlock value: aDictionary! !

!RBPatternBlockNode methodsFor: 'matching' stamp: ''!
lookupMatchFor: aString in: aDictionary 
	^aDictionary at: aString
		ifAbsent: 
			[| variableNode |
			variableNode := RBPatternVariableNode named: aString.
			aDictionary at: variableNode ifAbsent: [nil]]! !

!RBPatternBlockNode methodsFor: 'matching' stamp: 'MarcusDenker 8/28/2013 10:20'!
createBlockFor: aRBBlockNode 

	self replacePatternNodesIn: aRBBlockNode.
	^Smalltalk compiler 
		source: aRBBlockNode formattedCode;
		receiver: self;
		evaluate! !

!RBPatternBlockNode methodsFor: 'matching' stamp: ''!
addArgumentWithNameBasedOn: aString to: aRBBlockNode 
	| name index vars |
	name := aString.
	vars := aRBBlockNode allDefinedVariables.
	index := 0.
	[vars includes: name] whileTrue: 
			[index := index + 1.
			name := name , index printString].
	aRBBlockNode 
		arguments: (aRBBlockNode arguments copyWith: (RBVariableNode named: name))! !

!RBPatternBlockNode methodsFor: 'matching' stamp: ''!
createMatchingBlock
	| newBlock |
	self arguments size > 2 
		ifTrue: 
			[self 
				error: 'Search blocks can only contain arguments for the node and matching dictionary'].
	newBlock := RBBlockNode arguments: arguments body: body.
	newBlock arguments isEmpty 
		ifTrue: [self addArgumentWithNameBasedOn: 'aNode' to: newBlock].
	newBlock arguments size = 1 
		ifTrue: [self addArgumentWithNameBasedOn: 'aDictionary' to: newBlock].
	^self createBlockFor: newBlock! !

!RBPatternBlockNode methodsFor: 'visitor' stamp: 'StephaneDucasse 3/29/2013 15:37'!
acceptVisitor: aProgramNodeVisitor 
	^aProgramNodeVisitor visitPatternBlockNode: self! !

!RBPatternBlockNode methodsFor: 'matching' stamp: 'PabloHerrero 10/24/2013 14:56'!
constructLookupNodeFor: aString in: aRBBlockNode 
	| argumentNode |
	argumentNode := RBLiteralNode value: aString.
	
	^RBMessageNode 
		receiver: (RBVariableNode named: 'self')
		selector: #lookupMatchFor:in:
		arguments: (Array with: argumentNode with: aRBBlockNode arguments last)! !

!RBPatternBlockNode methodsFor: 'matching' stamp: ''!
match: aNode inContext: aDictionary 
	^self matchingBlock value: aNode value: aDictionary! !

!RBPatternBlockNode methodsFor: 'matching' stamp: 'ClementBera 7/26/2013 17:16'!
matchingBlock
	^ valueBlock ifNil: [valueBlock := self createMatchingBlock]! !

!RBPatternBlockToken commentStamp: 'md 8/9/2005 14:52'!
RBPatternBlockToken is the first-class representation of the pattern block token.

!
!RBPatternBlockToken methodsFor: 'testing' stamp: ''!
isPatternBlock
	^true! !

!RBPatternMessageNode commentStamp: 'md 8/9/2005 14:58'!
RBPatternMessageNode is a RBMessageNode that will match other message nodes without their selectors being equal. 

Instance Variables:
	isCascadeList	<Boolean>	are we matching a list of message nodes in a cascaded message
	isList	<Boolean>	are we matching each keyword or matching all keywords together (e.g., `keyword1: would match a one argument method whereas `@keywords: would match 0 or more arguments)!
!RBPatternMessageNode methodsFor: 'accessing' stamp: 'lr 5/30/2010 14:22'!
sentMessages
	^ super sentMessages
		remove: self selector ifAbsent: [ ];
		yourself! !

!RBPatternMessageNode methodsFor: 'testing-matching' stamp: ''!
isList
	^isCascadeList and: [parent notNil and: [parent isCascade]]! !

!RBPatternMessageNode methodsFor: 'matching' stamp: 'lr 5/30/2010 10:35'!
matchArgumentsAgainst: aNode inContext: aDictionary 
	self arguments size = aNode arguments size
		ifFalse: [ ^ false ].
	(self matchSelectorAgainst: aNode inContext: aDictionary) 
		ifFalse: [ ^ false ].
	self arguments with: aNode arguments do: [ :first :second |
		(first match: second inContext: aDictionary) 
			ifFalse: [ ^ false ] ].
	^ true! !

!RBPatternMessageNode methodsFor: 'matching' stamp: 'PabloHerrero 2/16/2015 00:51'!
copyInContext: aDictionary
	| keywordSelector |
	self isList 
		ifTrue: [ ^ aDictionary at: self ].
	keywordSelector := self isSelectorList 
		ifTrue: [ aDictionary at: self selectorParts first ]
		ifFalse: [ '' join: (self selectorParts collect: [ :each | aDictionary at: each ])].
	^ RBMessageNode
		receiver: (self receiver copyInContext: aDictionary)
		selector: keywordSelector
		arguments: (self copyList: self arguments inContext: aDictionary)! !

!RBPatternMessageNode methodsFor: 'matching' stamp: 'PabloHerrero 10/22/2013 14:02'!
matchSelectorAgainst: aNode inContext: aDictionary 
	self selectorParts with: aNode selectorParts do: [ :first :second |
		| keyword |
		keyword := aDictionary
			at: first
			ifAbsentPut: [ 
				first isPatternVariable 
					ifTrue: [ second ]
					ifFalse: [ first ] ].
		keyword = second 
			ifFalse: [ ^ false ] ].
	^ true! !

!RBPatternMessageNode methodsFor: 'testing-matching' stamp: ''!
isPatternNode
	^true! !

!RBPatternMessageNode methodsFor: 'matching' stamp: 'PabloHerrero 10/22/2013 14:02'!
match: aNode inContext: aDictionary 
	aNode class == self matchingClass ifFalse: [^false].
	(receiver match: aNode receiver inContext: aDictionary) ifFalse: [^false].
	self isSelectorList 
		ifTrue: 
			[^(aDictionary at: self selectorParts first ifAbsentPut: [aNode selector]) 
				== aNode selector and: 
						[(aDictionary at: arguments first ifAbsentPut: [aNode arguments]) 
							= aNode arguments]].
	^self matchArgumentsAgainst: aNode inContext: aDictionary! !

!RBPatternMessageNode methodsFor: 'testing-matching' stamp: ''!
isSelectorList
	^isList! !

!RBPatternMessageNode methodsFor: 'private' stamp: ''!
matchingClass
	^RBMessageNode! !

!RBPatternMessageNode methodsFor: 'initialize-release' stamp: 'PabloHerrero 10/22/2013 14:02'!
receiver: aValueNode selector: aSymbol keywordsPositions: positionList arguments: valueNodes
	| message |
	self
		receiver: aValueNode;
		selector: aSymbol;
		keywordsPositions: positionList;
		arguments: valueNodes.
		
	isCascadeList := isList := false.
	message := self selectorParts first.
	
	2 to: message size
		do: 
			[:i | 
			| character |
			character := message at: i.
			character == self listCharacter 
				ifTrue: [isList := true]
				ifFalse: 
					[character == self cascadeListCharacter 
						ifTrue: [isCascadeList := true]
						ifFalse: [^self]]]! !

!RBPatternMessageNode class methodsFor: 'instance creation' stamp: 'PabloHerrero 2/16/2015 17:15'!
receiver: aValueNode selector: aSelector keywordsPositions: positionList arguments: valueNodes

	^aSelector isPatternVariable
		ifTrue: 
			[super
				receiver: aValueNode
				selector: aSelector 
				keywordsPositions: positionList asIntegerArray
				arguments: valueNodes]
		ifFalse: 
			[RBMessageNode 
				receiver: aValueNode
				selector: aSelector 
				keywordsPositions: positionList asIntegerArray
				arguments: valueNodes]! !

!RBPatternMethodNode commentStamp: 'md 8/9/2005 14:59'!
RBPatternMethodNode is a RBMethodNode that will match other method nodes without their selectors being equal. 

Instance Variables:
	isList	<Boolean>	are we matching each keyword or matching all keywords together (e.g., `keyword1: would match a one argument method whereas `@keywords: would match 0 or more arguments)

!
!RBPatternMethodNode methodsFor: 'matching' stamp: 'lr 5/30/2010 10:35'!
matchArgumentsAgainst: aNode inContext: aDictionary 
	self arguments size = aNode arguments size
		ifFalse: [ ^ false ].
	(self matchSelectorAgainst: aNode inContext: aDictionary) 
		ifFalse: [ ^ false ].
	self arguments with: aNode arguments do: [ :first :second |
		(first match: second inContext: aDictionary) 
			ifFalse: [ ^ false ] ].
	^ true! !

!RBPatternMethodNode methodsFor: 'matching' stamp: 'PabloHerrero 10/22/2013 14:02'!
copyInContext: aDictionary 
	| keywordSelector |
	keywordSelector := self isSelectorList 
		ifTrue: [ aDictionary at: self selectorParts first ]
		ifFalse: [ ('' join:(self selectorParts collect: [ :each | aDictionary at: each ])) asSymbol  ].
	^ RBMethodNode new
		selector: keywordSelector;
		arguments: (self copyList: self arguments inContext: aDictionary);
		pragmas: (self pragmas isEmpty
			ifTrue: [ aDictionary at: '-pragmas-' ifAbsent: [ #() ] ]
			ifFalse: [ self copyList: self pragmas inContext: aDictionary ]);
		body: (self body copyInContext: aDictionary);
		source: (aDictionary at: '-source-');
		yourself! !

!RBPatternMethodNode methodsFor: 'initialize-release' stamp: 'PabloHerrero 10/20/2013 03:26'!
selector: aSymbol keywordsPositions: positionList arguments: valueNodes 
	super selector: aSymbol keywordsPositions: positionList arguments: valueNodes.
	isList := (aSymbol keywords first value at: 2) == self listCharacter! !

!RBPatternMethodNode methodsFor: 'testing-matching' stamp: ''!
isPatternNode
	^true! !

!RBPatternMethodNode methodsFor: 'matching' stamp: 'PabloHerrero 10/22/2013 14:02'!
matchSelectorAgainst: aNode inContext: aDictionary 
	self selectorParts with: aNode selectorParts do: [ :first :second |
		| keyword |
		keyword := aDictionary
			at: first
			ifAbsentPut: [ 
				first isPatternVariable 
					ifTrue: [ second ]
					ifFalse: [ first ] ].
		keyword = second 
			ifFalse: [ ^ false ] ].
	^ true! !

!RBPatternMethodNode methodsFor: 'matching' stamp: 'PabloHerrero 10/22/2013 14:02'!
match: aNode inContext: aDictionary 
	aNode class = self matchingClass 
		ifFalse: [ ^ false ].
	aDictionary at: '-source-' put: aNode source.
	self isSelectorList ifTrue: [
		^ (aDictionary at:  self selectorParts first ifAbsentPut: [ aNode selector ]) = aNode selector
			and: [ (aDictionary at: arguments first ifAbsentPut: [ aNode arguments ]) = aNode arguments
			and: [ (self matchPragmas: self pragmas against: aNode pragmas inContext: aDictionary)
			and: [ body match: aNode body inContext: aDictionary ] ] ] ].
	^(self matchArgumentsAgainst: aNode inContext: aDictionary) 
		and: [ (self matchPragmas: self pragmas against: aNode pragmas inContext: aDictionary)
		and: [ body match: aNode body inContext: aDictionary ] ]! !

!RBPatternMethodNode methodsFor: 'testing' stamp: ''!
isSelectorList
	^isList! !

!RBPatternMethodNode methodsFor: 'private' stamp: ''!
matchingClass
	^RBMethodNode! !

!RBPatternMethodNode class methodsFor: 'instance creation' stamp: 'PabloHerrero 2/16/2015 17:15'!
selector: aSelector keywordsPositions: positionList arguments: valueNodes
	^(aSelector isPatternVariable) 
		ifTrue: [super selector: aSelector keywordsPositions: positionList arguments: valueNodes]
		ifFalse: 
			[RBMethodNode selector: aSelector keywordsPositions: positionList arguments: valueNodes]! !

!RBPatternParser commentStamp: '<historical>'!
RBPatternParser is a subclass of RBParser that allows the extended syntax that creates matching trees. These trees can be used by the ParseTreeMatcher to search and transform source code.
!
!RBPatternParser methodsFor: 'private-classes' stamp: ''!
variableNodeClass
	^RBPatternVariableNode! !

!RBPatternParser methodsFor: 'private-parsing' stamp: 'CamilloBruni 11/8/2012 16:00'!
parsePatternBlock: aClass 
	| position node |
	position := currentToken start.
	self step.
	node := self parseBlockArgsInto: aClass new.
	node left: position.
	
	node body: self sequenceNodeClass new.
	(self parseStatements: false into: node body).
	
	(currentToken isSpecial and: [currentToken value = $}]) 
		ifFalse: [ ^ self parserError: '''}'' expected'].
	node right: currentToken start.
	self step.
	^node! !

!RBPatternParser methodsFor: 'private-parsing' stamp: 'PabloHerrero 10/23/2013 16:15'!
parseLiteralByteArrayObject
	| node |
	(currentToken isIdentifier and: [currentToken isPatternVariable]) 
		ifTrue: 
			[node := self variableNodeClass identifierNamed: currentToken value at: currentToken start.
			node isLiteralNode 
				ifTrue: 
					[self step.
					^node]].
	^super parseLiteralByteArrayObject! !

!RBPatternParser methodsFor: 'private-parsing' stamp: ''!
parsePrimitiveObject
	currentToken isPatternBlock 
		ifTrue: [^self parsePatternBlock: RBPatternBlockNode].
	^super parsePrimitiveObject! !

!RBPatternParser methodsFor: 'private-parsing' stamp: ''!
parseUnaryMessage
	| node |
	node := self parsePrimitiveObject.
	self addCommentsTo: node.
	
	[currentToken isLiteralToken ifTrue: [self patchLiteralMessage].
	currentToken isPatternBlock 
		ifTrue: 
			[node := (self parsePatternBlock: RBPatternWrapperBlockNode)
						wrappedNode: node;
						yourself].
	currentToken isIdentifier] 
			whileTrue: [node := self parseUnaryMessageWith: node].
	self addCommentsTo: node.
	^node! !

!RBPatternParser methodsFor: 'private' stamp: ''!
patchLiteralArrayToken
	(currentToken isIdentifier and: [currentToken isPatternVariable]) 
		ifTrue: [^self].
	super patchLiteralArrayToken! !

!RBPatternParser methodsFor: 'private-parsing' stamp: 'PabloHerrero 10/23/2013 16:15'!
parsePragmaLiteral
	| node |
	currentToken isPatternBlock 
		ifTrue: [ ^ self parsePatternBlock: RBPatternBlockNode ].
	(currentToken isIdentifier and: [ currentToken isPatternVariable ]) ifTrue: [
		node := self variableNodeClass identifierNamed: currentToken value at: currentToken start.
		node isLiteralNode 
			ifFalse: [ self parseError: 'Literal pattern expected' ].
		self step.
		currentToken isPatternBlock ifTrue: [
			node := (self parsePatternBlock: RBPatternWrapperBlockNode)
				wrappedNode: node;
				yourself ].
		^ node ].
	^ super parsePragmaLiteral! !

!RBPatternParser methodsFor: 'private-parsing' stamp: 'PabloHerrero 10/25/2013 15:58'!
parsePrimitiveLiteral
	| node |
	(currentToken isIdentifier and: [currentToken isPatternVariable]) 
		ifTrue: 
			[node := self variableNodeClass identifierNamed: currentToken value at: currentToken start.
			node isLiteralNode 
				ifTrue: 
					[self step.
					^node].
			currentToken := RBLiteralToken 
						value: currentToken value asSymbol
						start: currentToken start
						stop: currentToken stop].
	^super parsePrimitiveLiteral! !

!RBPatternParser methodsFor: 'accessing' stamp: ''!
scannerClass
	^RBPatternScanner! !

!RBPatternParser methodsFor: 'private-classes' stamp: ''!
methodNodeClass
	^RBPatternMethodNode! !

!RBPatternParser methodsFor: 'private-classes' stamp: ''!
messageNodeClass
	^RBPatternMessageNode! !

!RBPatternParser methodsFor: 'private-parsing' stamp: 'StephaneDucasse 3/29/2013 17:16'!
parseError: aString

	self error: aString! !

!RBPatternParser methodsFor: 'private-classes' stamp: 'lr 5/30/2010 09:44'!
pragmaNodeClass
	^RBPatternPragmaNode! !

!RBPatternPragmaNode methodsFor: 'accessing' stamp: 'lr 5/30/2010 14:22'!
sentMessages
	^ super sentMessages
		remove: self selector ifAbsent: [ ];
		yourself! !

!RBPatternPragmaNode methodsFor: 'matching' stamp: 'lr 5/30/2010 10:07'!
matchArgumentsAgainst: aNode inContext: aDictionary 
	self arguments size = aNode arguments size
		ifFalse: [ ^ false ].
	(self matchSelectorAgainst: aNode inContext: aDictionary) 
		ifFalse: [ ^ false ].
	self arguments with: aNode arguments do: [ :first :second |
		(first match: second inContext: aDictionary) 
			ifFalse: [ ^ false ] ].
	^ true! !

!RBPatternPragmaNode methodsFor: 'matching' stamp: 'PabloHerrero 10/22/2013 14:02'!
copyInContext: aDictionary 
	| keywordSelector |
	keywordSelector := self isSelectorList 
		ifTrue: [ aDictionary at: self selectorParts first ]
		ifFalse: [ ('' join: (self selectorParts collect: [ :each | aDictionary at: each ])) asSymbol ].
	^ RBPragmaNode
		selector: keywordSelector
		arguments: (self copyList: self arguments inContext: aDictionary)! !

!RBPatternPragmaNode methodsFor: 'initialization' stamp: 'PabloHerrero 10/20/2013 03:25'!
selector: aSymbol keywordsPositions: positionList arguments: valueNodes
	self 
		arguments: valueNodes;
		selector: aSymbol;
		keywordsPositions: positionList.
	isList := (aSymbol keywords first value at: 2) == self listCharacter! !

!RBPatternPragmaNode methodsFor: 'testing-matching' stamp: 'lr 5/30/2010 09:40'!
isPatternNode
	^ true! !

!RBPatternPragmaNode methodsFor: 'matching' stamp: 'PabloHerrero 10/22/2013 14:02'!
matchSelectorAgainst: aNode inContext: aDictionary 
	self selectorParts with: aNode selectorParts do: [ :first :second |
		| keyword |
		keyword := aDictionary
			at: first
			ifAbsentPut: [ 
				first isPatternVariable 
					ifTrue: [ second ]
					ifFalse: [ first ] ].
		keyword = second 
			ifFalse: [ ^ false ] ].
	^ true! !

!RBPatternPragmaNode methodsFor: 'matching' stamp: 'PabloHerrero 10/22/2013 14:02'!
match: aNode inContext: aDictionary
	aNode class = self matchingClass
		ifFalse: [ ^ false ].
	self isSelectorList ifTrue: [
		^ (aDictionary at: self selectorParts first ifAbsentPut: [ aNode selector ]) = aNode selector
			and: [ (aDictionary at: arguments first ifAbsentPut: [ aNode arguments ]) = aNode arguments ] ].
	^ self matchArgumentsAgainst: aNode inContext: aDictionary! !

!RBPatternPragmaNode methodsFor: 'testing-matching' stamp: 'lr 5/30/2010 09:40'!
isSelectorList
	^ isList! !

!RBPatternPragmaNode methodsFor: 'private' stamp: 'lr 5/30/2010 09:40'!
matchingClass
	^ RBPragmaNode! !

!RBPatternPragmaNode class methodsFor: 'instance creation' stamp: 'PabloHerrero 2/16/2015 17:16'!
selector: aSelector keywordsPositions: positionList arguments: valueNodes
	^(aSelector isPatternVariable)
		ifTrue: [ super selector: aSelector keywordsPositions: positionList arguments: valueNodes ]
		ifFalse: [ RBPragmaNode selector: aSelector keywordsPositions: positionList arguments: valueNodes ]! !

!RBPatternScanner commentStamp: '<historical>'!
RBPatternScanner is a subclass of RBScanner that allows the extended syntax of pattern matching trees.
!
!RBPatternScanner methodsFor: 'accessing' stamp: 'lr 11/7/2009 15:31'!
scanToken
	currentCharacter = PatternVariableCharacter 
		ifTrue: [^self scanPatternVariable].
	currentCharacter = $} ifTrue: [^self scanSpecialCharacter].
	^super scanToken! !

!RBPatternVariableNode commentStamp: 'md 8/9/2005 14:59'!
RBPatternVariableNode is an AST node that is used to match several other types of nodes (literals, variables, value nodes, statement nodes, and sequences of statement nodes).

The different types of matches are determined by the name of the node. If the name contains a # character, then it will match a literal. If it contains, a . then it matches statements. If it contains no extra characters, then it matches only variables. These options are mutually exclusive.

The @ character can be combined with the name to match lists of items. If combined with the . character, then it will match a list of statement nodes (0 or more). If used without the . or # character, then it matches anything except for list of statements. Combining the @ with the # is not supported.

Adding another ` in the name will cause the search/replace to look for more matches inside the node that this node matched. This option should not be used for top level expressions since that would cause infinite recursion (e.g., searching only for "``@anything").

Instance Variables:
	isAnything	<Boolean>	can we match any type of node
	isList	<Boolean>	can we match a list of items (@)
	isLiteral	<Boolean>	only match a literal node (#)
	isStatement	<Boolean>	only match statements (.)
	recurseInto	<Boolean>	search for more matches in the node we match (`)

!
!RBPatternVariableNode methodsFor: 'testing-matching' stamp: ''!
isList
	^isList! !

!RBPatternVariableNode methodsFor: 'testing-matching' stamp: ''!
isAnything
	^isAnything! !

!RBPatternVariableNode methodsFor: 'accessing' stamp: ''!
parent: aBRProgramNode 
	"Fix the case where '``@node' should match a single node, not a sequence node."

	super parent: aBRProgramNode.
	parent isSequence 
		ifTrue: 
			[(self isStatement or: [parent temporaries includes: self]) 
				ifFalse: [isList := false]]! !

!RBPatternVariableNode methodsFor: 'matching' stamp: 'lr 11/24/2009 23:37'!
copyInContext: aDictionary 
	^ (aDictionary at: self) copy! !

!RBPatternVariableNode methodsFor: 'testing-matching' stamp: ''!
isPatternNode
	^true! !

!RBPatternVariableNode methodsFor: 'matching' stamp: ''!
matchStatement: aNode inContext: aDictionary 
	(aNode parent notNil and: [aNode parent isSequence]) ifFalse: [^false].
	^(aDictionary at: self ifAbsentPut: [aNode]) = aNode! !

!RBPatternVariableNode methodsFor: 'matching' stamp: ''!
matchLiteral: aNode inContext: aDictionary 
	^aNode isLiteralNode
		and: [(aDictionary at: self ifAbsentPut: [aNode]) = aNode]! !

!RBPatternVariableNode methodsFor: 'private' stamp: ''!
matchingClass
	^RBVariableNode! !

!RBPatternVariableNode methodsFor: 'initialize-release' stamp: 'MarcusDenker 2/27/2015 11:01'!
initializePatternVariables
	| myname |
	myname := self name.
	isAnything := isList := isLiteral := isStatement := recurseInto := false.
	2 to: myname size
		do: 
			[:i | 
			| character |
			character := myname at: i.
			character == self listCharacter 
				ifTrue: [isAnything := isList := true]
				ifFalse: 
					[character == self literalCharacter 
						ifTrue: [isLiteral := true]
						ifFalse: 
							[character == self statementCharacter 
								ifTrue: [isStatement := true]
								ifFalse: 
									[character == self recurseIntoCharacter 
										ifTrue: [recurseInto := true]
										ifFalse: [^self]]]]]! !

!RBPatternVariableNode methodsFor: 'testing-matching' stamp: ''!
isLiteralNode
	^isLiteral! !

!RBPatternVariableNode methodsFor: 'matching' stamp: 'CamilloBruni 12/15/2011 15:32'!
match: aNode inContext: aDictionary 
	self isAnything 
		ifTrue: [^(aDictionary at: self ifAbsentPut: [aNode]) = aNode].
	self isLiteralNode ifTrue: [^self matchLiteral: aNode inContext: aDictionary].
	self isStatement 
		ifTrue: [^self matchStatement: aNode inContext: aDictionary].
	(aNode isKindOf: self matchingClass) ifFalse: [^false].
	^(aDictionary at: self ifAbsentPut: [aNode]) = aNode! !

!RBPatternVariableNode methodsFor: 'initialize-release' stamp: 'PabloHerrero 10/23/2013 15:58'!
named: aName start: aPosition

	super named: aName start: aPosition.
	self initializePatternVariables! !

!RBPatternVariableNode methodsFor: 'testing-matching' stamp: ''!
recurseInto
	^recurseInto! !

!RBPatternVariableNode methodsFor: 'testing-matching' stamp: ''!
isStatement
	^isStatement! !

!RBPatternVariableNode class methodsFor: 'instance creation' stamp: 'PabloHerrero 2/16/2015 17:16'!
identifierNamed: anIdentifierName at: aPosition
	^anIdentifierName isPatternVariable 
		ifTrue: [super identifierNamed: anIdentifierName at: aPosition]
		ifFalse: [RBVariableNode identifierNamed: anIdentifierName at: aPosition]! !

!RBPatternWrapperBlockNode commentStamp: '<historical>'!
RBPatternWrapperBlockNode allows further matching using a block after a node has been matched by a pattern node.

Instance Variables:
	wrappedNode	<RBProgramNode>	The original pattern node to match!
!RBPatternWrapperBlockNode methodsFor: 'accessing' stamp: ''!
wrappedNode: aRBProgramNode 
	wrappedNode := aRBProgramNode.
	aRBProgramNode parent: self! !

!RBPatternWrapperBlockNode methodsFor: 'accessing' stamp: ''!
precedence
	^1! !

!RBPatternWrapperBlockNode methodsFor: 'matching' stamp: 'lr 11/24/2009 23:30'!
copyInContext: aDictionary 
	"I don't know what this would mean, so ignore it."

	^ wrappedNode copyInContext: aDictionary! !

!RBPatternWrapperBlockNode methodsFor: 'accessing' stamp: ''!
wrappedNode
	^wrappedNode! !

!RBPatternWrapperBlockNode methodsFor: 'visitor' stamp: 'StephaneDucasse 3/29/2013 15:38'!
acceptVisitor: aProgramNodeVisitor 
	^aProgramNodeVisitor visitPatternWrapperBlockNode: self! !

!RBPatternWrapperBlockNode methodsFor: 'matching' stamp: ''!
match: aNode inContext: aDictionary 
	(wrappedNode match: aNode inContext: aDictionary) ifFalse: [^false].
	^super match: aNode inContext: aDictionary! !

!RBPlatformDependentUserInteractionRule commentStamp: 'StephaneDucasse 11/29/2014 23:08'!
Check the methods that  use platform dependent user interactions.

This rule should be updated.!
!RBPlatformDependentUserInteractionRule methodsFor: 'initialization' stamp: 'StephaneDucasse 11/29/2014 23:07'!
initialize
	super initialize.
	self matcher 
		matchesAnyOf: #(
			'PopUpMenu confirm: `@object1 orCancel: `@object2'
			'PopUpMenu confirm: `@object1 trueChoice: `@object2 falseChoice: `@object3'
			'PopUpMenu confirm: `@object1'
			'PopUpMenu inform: `@object1'
			'PopUpMenu initialize'
			'PopUpMenu labelArray: `@object1 lines: `@object2'
			'PopUpMenu labelArray: `@object1'
			'PopUpMenu labels: `@object1 lines: `@object2'
			'PopUpMenu labels: `@object1'
			'PopUpMenu withCaption: `@object1 chooseFrom: `@object2'
			 )
		do: [ :node :answer | node ]! !

!RBPlatformDependentUserInteractionRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 23:08'!
rationale
	^ 'Check the methods that  use platform dependent user interactions.'! !

!RBPlatformDependentUserInteractionRule methodsFor: 'accessing' stamp: 'lr 3/17/2010 17:54'!
group
	^ 'Pharo bugs'! !

!RBPlatformDependentUserInteractionRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:12'!
severity
	^ #error! !

!RBPlatformDependentUserInteractionRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Platform dependent user interaction'! !

!RBPlatformDependentUserInteractionRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:26'!
category 
	^ 'Potential Bugs'! !

!RBPlatformDependentUserInteractionRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'PlatformDependentUserInteractionRule'! !

!RBPragmaEnvironment methodsFor: 'testing' stamp: 'lr 8/7/2009 10:43'!
includesClass: aClass
	^ (environment includesClass: aClass) and: [ aClass selectors anySatisfy: [ :each | self includesSelector: each in: aClass ] ]! !

!RBPragmaEnvironment methodsFor: 'initialize-release' stamp: 'lr 2/24/2009 19:38'!
keywords: aCollection
	keywords addAll: aCollection! !

!RBPragmaEnvironment methodsFor: 'initialize-release' stamp: 'lr 7/21/2008 10:34'!
condition: aBlock
	condition := aBlock! !

!RBPragmaEnvironment methodsFor: 'printing' stamp: 'lr 7/21/2008 10:37'!
storeOn: aStream
	aStream nextPut: $(.
	super storeOn: aStream.
	aStream nextPutAll: ' keywords: '.
	keywords asArray storeOn: aStream.
	aStream nextPut: $)! !

!RBPragmaEnvironment methodsFor: 'testing' stamp: 'lr 8/7/2009 12:42'!
includesCategory: aCategory
	^ (environment includesCategory: aCategory) and: [ (self classNamesFor: aCategory) notEmpty ]! !

!RBPragmaEnvironment methodsFor: 'testing' stamp: 'lr 1/3/2010 11:48'!
includesSelector: aSelector in: aClass
	(environment includesSelector: aSelector in: aClass)
		ifFalse: [ ^ false ].
	^ (aClass compiledMethodAt: aSelector) pragmas
		anySatisfy: [ :each | self includesPragma: each ]! !

!RBPragmaEnvironment methodsFor: 'testing' stamp: 'YuriyTymchuk 7/3/2014 11:21'!
definesClass: aClass
	^ environment definesClass: aClass! !

!RBPragmaEnvironment methodsFor: 'initialization' stamp: 'lr 2/26/2009 13:35'!
initialize
	super initialize.
	keywords := IdentitySet new.
	condition := [ :pragma | true ]! !

!RBPragmaEnvironment methodsFor: 'testing' stamp: 'lr 8/7/2009 12:42'!
includesProtocol: aProtocol in: aClass
	^ (environment includesProtocol: aProtocol in: aClass) and: [ (self selectorsFor: aProtocol in: aClass) notEmpty ]! !

!RBPragmaEnvironment methodsFor: 'copying' stamp: 'lr 7/21/2008 10:37'!
postCopy
	super postCopy.
	keywords := keywords copy! !

!RBPragmaEnvironment methodsFor: 'adding' stamp: 'lr 7/21/2008 10:20'!
addKeyword: aSymbol
	keywords add: aSymbol! !

!RBPragmaEnvironment methodsFor: 'private' stamp: 'lr 7/21/2008 10:40'!
defaultLabel
	| stream |
	stream := String new writeStream.
	keywords do: [ :each | stream nextPut: $<; nextPutAll: each; nextPut: $>; nextPut: $ ].
	^ stream contents! !

!RBPragmaEnvironment methodsFor: 'testing' stamp: 'lr 7/21/2008 10:34'!
includesPragma: aPragma
	^ (keywords includes: aPragma keyword) and: [ condition value: aPragma ]! !

!RBPragmaEnvironment class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/2/2013 23:26'!
keywords: aKeywordCollection
	^ self
		onEnvironment: self default
		keywords: aKeywordCollection! !

!RBPragmaEnvironment class methodsFor: 'instance creation' stamp: 'lr 7/21/2008 10:38'!
onEnvironment: anEnvironment keywords: aKeywordCollection
	^ (self onEnvironment: anEnvironment)
		keywords: aKeywordCollection;
		yourself! !

!RBPragmaNode commentStamp: '<historical>'!
RBPragmaNode is an AST node that represents a method pragma.

Instance Variables:
	arguments <SequenceableCollection of: RBLiteralNode> our argument nodes
	left <Integer | nil> position of <
	right <Integer | nil> position of >
	selector	<Symbol>	the selector we're sending
	keywordsPositions	<IntegerArray | nil>	the positions of the selector keywords!
!RBPragmaNode methodsFor: 'accessing' stamp: 'CamilloBruni 2/26/2014 18:28'!
argumentAt: keywordSelector ifAbsent: absentBlock
	self selectorParts with: self arguments do: [ :selectorPart :argument |
		selectorPart value = keywordSelector
			ifTrue: [ ^ argument ]].
	^ absentBlock value! !

!RBPragmaNode methodsFor: 'accessing' stamp: 'PabloHerrero 10/20/2013 04:21'!
selector
	^ selector! !

!RBPragmaNode methodsFor: 'testing' stamp: 'PabloHerrero 10/20/2013 04:12'!
isKeyword
	^(selector indexOf: $:) ~= 0.! !

!RBPragmaNode methodsFor: 'accessing-token' stamp: 'lr 11/5/2009 10:40'!
right: anInteger
	right := anInteger! !

!RBPragmaNode methodsFor: 'accessing-token' stamp: 'lr 11/5/2009 10:40'!
left
	^ left! !

!RBPragmaNode methodsFor: '*opalcompiler-core' stamp: 'CamilloBruni 2/26/2014 16:50'!
asPrimitive
	| args module name spec  |
	args := (self arguments collect: [ :each | each value ]) asArray.
	self isPrimitive
		ifFalse: [ IRPrimitive null ].
	args first isString
		ifTrue: [ 
			name := args first.
			module := self argumentAt: #module: ifAbsent: [ nil ].
			spec := {(module ifNotNil: [ module value asSymbol ]). (name asSymbol). 0. 0}.
			^ IRPrimitive new
				num: 117;
				spec: spec;
				yourself ]
		ifFalse: [ 
			^ IRPrimitive new
				num: args first;
				spec: nil;
				yourself ]! !

!RBPragmaNode methodsFor: 'accessing' stamp: 'lr 10/27/2009 11:57'!
children
	^ self arguments! !

!RBPragmaNode methodsFor: 'testing' stamp: 'GiselaDecuzzi 6/5/2013 10:30'!
isFaulty
	^self arguments anySatisfy: #isFaulty.! !

!RBPragmaNode methodsFor: 'testing' stamp: 'lr 10/13/2009 14:00'!
isBinary
	^ (self isUnary or: [self isKeyword]) not! !

!RBPragmaNode methodsFor: 'accessing' stamp: 'CamilloBruni 2/26/2014 18:28'!
argumentAt: keywordSelector
	^ self 
		argumentAt: keywordSelector
		ifAbsent: [ KeyNotFound signalFor: keywordSelector ]! !

!RBPragmaNode methodsFor: 'accessing' stamp: 'PabloHerrero 10/20/2013 03:53'!
keywordsPositions: aPositionsList
	keywordsPositions := aPositionsList ifNotNil: [:list| list asIntegerArray ].! !

!RBPragmaNode methodsFor: 'accessing-token' stamp: 'lr 11/5/2009 10:40'!
right
	^ right! !

!RBPragmaNode methodsFor: 'testing' stamp: 'lr 10/13/2009 14:00'!
isPragma
	^ true! !

!RBPragmaNode methodsFor: '*opalcompiler-core' stamp: 'MarcusDenker 5/14/2013 16:32'!
asPragma
	^ Pragma keyword: selector arguments: (arguments collect: [ :each | each value ]) asArray! !

!RBPragmaNode methodsFor: 'accessing' stamp: 'PabloHerrero 10/28/2013 17:01'!
keywordsPositions
	^keywordsPositions ifNil: [ (selector keywords collect: [:char| 0 ]) asIntegerArray ]! !

!RBPragmaNode methodsFor: 'accessing' stamp: 'lr 11/5/2009 10:41'!
start
	^ left! !

!RBPragmaNode methodsFor: '*opalcompiler-core' stamp: 'MarcusDenker 5/14/2013 13:48'!
isCompilerOption
	^ self selector = #compilerOptions:! !

!RBPragmaNode methodsFor: 'accessing' stamp: 'lr 5/30/2010 14:22'!
sentMessages
	^ super sentMessages
		add: self selector;
		yourself! !

!RBPragmaNode methodsFor: 'comparing' stamp: 'lr 3/7/2010 13:47'!
hash
	^ self selector hash bitXor: (self hashForCollection: self arguments)! !

!RBPragmaNode methodsFor: 'matching' stamp: 'PabloHerrero 10/20/2013 07:02'!
copyInContext: aDictionary 
	^ self class
		selector: self selector
		arguments: (self arguments collect: [ :each | each copyInContext: aDictionary ])! !

!RBPragmaNode methodsFor: 'initialization' stamp: 'PabloHerrero 10/19/2013 07:25'!
selector: aSymbol keywordsPositions: positionList arguments: valueNodes
	aSymbol numArgs == valueNodes size
		ifFalse: 
			[self error: 'Attempting to assign selector with wrong number of arguments.'].

	self 
		arguments: valueNodes;
		selector: aSymbol;
		keywordsPositions: positionList.! !

!RBPragmaNode methodsFor: '*opalcompiler-core' stamp: 'CamilloBruni 2/26/2014 16:20'!
isPrimitiveError
	^ #( primitive:error: primitive:module:error: primitive:error:module:) includes: self selector! !

!RBPragmaNode methodsFor: 'accessing' stamp: 'lr 11/5/2009 10:41'!
stop
	^ right! !

!RBPragmaNode methodsFor: 'replacing' stamp: 'lr 10/13/2009 14:00'!
replaceNode: aNode withNode: anotherNode 
	self arguments: (arguments collect: [ :each | 
		each == aNode 
			ifTrue: [ anotherNode ]
			ifFalse: [ each ] ])! !

!RBPragmaNode methodsFor: 'accessing' stamp: 'lr 10/13/2009 14:01'!
arguments: aLiteralCollection 
	arguments := aLiteralCollection.
	arguments do: [ :each | each parent: self ]! !

!RBPragmaNode methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:38'!
acceptVisitor: aProgramNodeVisitor 
	^ aProgramNodeVisitor visitPragmaNode: self! !

!RBPragmaNode methodsFor: 'comparing' stamp: 'BernardoContreras 8/24/2014 23:22'!
equalTo: anObject withMapping: aDictionary 
	self class = anObject class ifFalse: [ ^ false ].
	self selector = anObject selector ifFalse: [ ^ false ].
	self arguments size = anObject arguments size ifFalse: [ ^ false ].
	self arguments with: anObject arguments do: [ :first :second |
		(first equalTo: second withMapping: aDictionary) 
			ifFalse: [ ^ false ] ].
	^ true! !

!RBPragmaNode methodsFor: 'accessing' stamp: 'PabloHerrero 10/20/2013 04:13'!
selector: aSelector 
	keywordsPositions := nil.
	selector := aSelector asSymbol.! !

!RBPragmaNode methodsFor: 'testing' stamp: 'lr 11/9/2009 20:06'!
isPrimitive
	^ #(primitive: primitive:error: primitive:error:module: primitive:module: primitive:module:error:) includes: self selector! !

!RBPragmaNode methodsFor: 'comparing' stamp: 'BernardoContreras 8/24/2014 23:17'!
= anObject 
	self == anObject ifTrue: [^true].
	self class = anObject class ifFalse: [^false].
	self selector = anObject selector ifFalse: [^false].
	self arguments size = anObject arguments size ifFalse: [^false].
	self arguments
		with: anObject arguments
		do: [:first :second | first = second ifFalse: [^false]].
	^true! !

!RBPragmaNode methodsFor: 'copying' stamp: 'lr 11/1/2009 22:37'!
postCopy
	super postCopy.
	self arguments: (self arguments collect: [ :each | each copy ])! !

!RBPragmaNode methodsFor: 'accessing' stamp: 'lr 5/30/2010 09:30'!
numArgs
	^ self selector numArgs! !

!RBPragmaNode methodsFor: 'matching' stamp: 'lr 5/30/2010 10:06'!
match: aNode inContext: aDictionary 
	aNode class = self class
		ifFalse: [ ^ false ].
	self selector = aNode selector
		ifFalse: [ ^ false ].
	self arguments with: aNode arguments do: [ :first :second |
		(first match: second inContext: aDictionary)
			ifFalse: [ ^ false ] ].
	^ true! !

!RBPragmaNode methodsFor: 'accessing-token' stamp: 'lr 11/5/2009 10:40'!
left: anInteger
	left := anInteger! !

!RBPragmaNode methodsFor: 'accessing' stamp: 'PabloHerrero 10/22/2013 11:09'!
keywordsIntervals
	^selector keywords
		with: self keywordsPositions 
		collect: [:keyword :start| start to: (start = 0 ifTrue: [ -1 ] ifFalse: [ start + keyword size - 1]) ].! !

!RBPragmaNode methodsFor: 'accessing' stamp: 'PabloHerrero 10/22/2013 14:02'!
selectorParts
	^ selector keywords collect: [:keyword| keyword asSymbol ].! !

!RBPragmaNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 12:14'!
arguments
	^ arguments ifNil: [ #() ]! !

!RBPragmaNode methodsFor: 'testing' stamp: 'lr 10/13/2009 14:01'!
isUnary
	^ arguments isEmpty! !

!RBPragmaNode class methodsFor: 'instance creation' stamp: 'PabloHerrero 10/20/2013 07:04'!
selector: aSymbol arguments: valueNodes
	^ self selector: aSymbol keywordsPositions: nil arguments: valueNodes ! !

!RBPragmaNode class methodsFor: 'instance creation' stamp: 'PabloHerrero 10/20/2013 07:03'!
selector: aSymbol keywordsPositions: positionList arguments: valueNodes
	^ self new selector: aSymbol keywordsPositions: positionList arguments: valueNodes ! !

!RBPrecedenceRule commentStamp: 'StephaneDucasse 11/29/2014 23:06'!
Checks for mathematical expressions that might be evaluated different (from left-to-right) than the developer thinks.!
!RBPrecedenceRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:33'!
initialize
	super initialize.
	self matcher 
		matches: '`{:node | node isMessage and: [node hasParentheses not and: [#(#+ #-) includes: node selector]]} * `@C'
		do: [ :node :answer | node ]! !

!RBPrecedenceRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 17:45'!
rationale
	^ 'Checks for mathematical expressions that might be evaluated different (from left-to-right) than the developer thinks.'! !

!RBPrecedenceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Miscellaneous'! !

!RBPrecedenceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Inspect instances of "A + B * C" might be "A + (B * C)"'! !

!RBPrecedenceRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:27'!
category 
	^ 'Potential Bugs'! !

!RBPrecedenceRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'PrecedenceRule'! !

!RBPrettyPrintCodeRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^ RBCondition empty! !

!RBPrettyPrintCodeRefactoring methodsFor: 'transforming' stamp: ''!
transform
	| source tree formatted |
	self model allClassesDo: [ :class |
		class selectors do: [ :selector |
			(self model environment includesSelector: selector in: class realClass) ifTrue: [
				source := class sourceCodeFor: selector.
				source isNil ifFalse: [ 
					tree := class parseTreeFor: selector.
					tree isNil ifFalse: [
						formatted := tree formattedCode.
						(source ~= formatted and: [ (RBParser parseMethod: formatted) = tree ]) 
							ifTrue: [ class compile: formatted classified: (class protocolsFor: selector) ] ] ] ] ] ] ! !

!RBProgramNode commentStamp: '<historical>'!
RBProgramNode is an abstract class that represents an abstract syntax tree node in a Smalltalk program.

Subclasses must implement the following messages:
	accessing
		start
		stop
	visitor
		acceptVisitor:

The #start and #stop methods are used to find the source that corresponds to this node. "source copyFrom: self start to: self stop" should return the source for this node.

The #acceptVisitor: method is used by RBProgramNodeVisitors (the visitor pattern). This will also require updating all the RBProgramNodeVisitors so that they know of the new node.

Subclasses might also want to redefine match:inContext: and copyInContext: to do parse tree searching and replacing.

Subclasses that contain other nodes should override equalTo:withMapping: to compare nodes while ignoring renaming temporary variables, and children that returns a collection of our children nodes.

Instance Variables:
	comments	<Collection of: Interval>	the intervals in the source that have comments for this node
	parent	<RBProgramNode>	the node we're contained in

Shared Variables:
	FormatterClass	<Behavior>	the formatter class that is used when we are formatted!
!RBProgramNode methodsFor: 'replacing' stamp: ''!
replaceMethodSource: aNode 
	"We are being replaced with aNode -- if possible try to perform an in place edit of the source."

	| method |
	method := self methodNode.
	method notNil ifTrue: [method map: self to: aNode].
	aNode parent: self parent.
	[self replaceSourceWith: aNode] on: Error
		do: 
			[:ex | 
			self clearReplacements.
			ex return]! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
children
	^#()! !

!RBProgramNode methodsFor: 'accessing' stamp: 'PabloHerrero 3/7/2015 21:00'!
comments: aCollection

	(aCollection ifNil: #())
		ifEmpty: [ self removeProperty: #comments ifAbsent: [] ] 
		ifNotEmpty: [ self propertyAt: #comments put: aCollection ].! !

!RBProgramNode methodsFor: 'meta variable-accessing' stamp: ''!
literalCharacter
	^$#! !

!RBProgramNode methodsFor: 'properties' stamp: 'md 3/29/2007 14:51'!
removeProperty: aKey
	"Remove the property with aKey. Answer the property or raise an error if aKey isn't found."
	
	^ self removeProperty: aKey ifAbsent: [ self error: 'Property not found' ].! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
isImmediateNode
	^false! !

!RBProgramNode methodsFor: 'replacing' stamp: 'ClementBera 7/26/2013 17:10'!
clearReplacements
	parent ifNil: [^self].
	parent clearReplacements! !

!RBProgramNode methodsFor: '*reflectivity' stamp: 'MarcusDenker 3/8/2015 09:14'!
link: aMetaLink
	(self propertyAt: #links ifAbsentPut: [ IdentitySet new ]) add: aMetaLink.
	aMetaLink installOn: self.
	self methodNode method installLink. ! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
parent
	^parent! !

!RBProgramNode methodsFor: 'private-replacing' stamp: 'lr 10/29/2010 11:37'!
replaceSourceFrom: aNode
	self == aNode
		ifFalse: [ self clearReplacements ]! !

!RBProgramNode methodsFor: 'testing-matching' stamp: ''!
isList
	^false! !

!RBProgramNode methodsFor: '*OpalDecompiler' stamp: 'ClementBera 7/10/2014 11:25'!
asReturnNode
	^ RBReturnNode value: self! !

!RBProgramNode methodsFor: 'testing-matching' stamp: ''!
canMatchMethod: aCompiledMethod 
	^self sentMessages allSatisfy: 
			[:each | 
			(self class optimizedSelectors includes: each) 
				or: [aCompiledMethod refersToLiteral: each]]! !

!RBProgramNode methodsFor: 'accessing' stamp: 'lr 5/30/2010 14:22'!
sentMessages
	^ self children
		inject: Set new
		into: [ :messages :each | 
			messages
				addAll: each sentMessages;
				yourself ]! !

!RBProgramNode methodsFor: '*OpalTools' stamp: 'MarcusDenker 10/16/2014 11:00'!
gtInspectorSymbolicBytecodeIn: composite
	<gtInspectorPresentationOrder: 30> 
	^ (GTOpalScopeBrowser new treeIn: composite)
		title: 'Scopes'! !

!RBProgramNode methodsFor: 'testing-matching' stamp: ''!
isPatternNode
	^false! !

!RBProgramNode methodsFor: 'querying' stamp: 'lr 11/2/2009 00:14'!
superMessages
	| searcher |
	searcher := RBParseTreeSearcher new.
	searcher matches: 'super `@msg: ``@args'
		do: 
			[:aNode :answer | 
			answer
				add: aNode selector;
				yourself].
	^searcher executeTree: self initialAnswer: Set new! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
precedence
	^6! !

!RBProgramNode methodsFor: 'iterating' stamp: 'lr 11/1/2009 20:49'!
allChildren
	| children |
	children := OrderedCollection new.
	self nodesDo: [ :each | children addLast: each ].
	^ children! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
isAssignment
	^false! !

!RBProgramNode methodsFor: 'matching' stamp: 'lr 11/24/2009 23:40'!
match: aNode inContext: aDictionary 
	^ self = aNode! !

!RBProgramNode methodsFor: '*opalcompiler-core' stamp: 'ClementBera 7/26/2013 15:24'!
methodOrBlockNode
	^ parent ifNotNil: [ parent methodOrBlockNode ]! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
newSource
	^self formattedCode! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
directlyUses: aNode
	^true! !

!RBProgramNode methodsFor: '*OpalDecompiler' stamp: 'cb 7/29/2014 18:21'!
toDoIncrement: variable
	"Only meant for Messages or Assignments - else return nil"
	^ nil! !

!RBProgramNode methodsFor: 'iterating' stamp: 'lr 11/1/2009 20:49'!
nodesDo: aBlock 
	aBlock value: self.
	self children do: [ :each | each nodesDo: aBlock ]! !

!RBProgramNode methodsFor: 'replacing' stamp: 'ClementBera 7/26/2013 17:13'!
replaceWith: aNode 
	parent ifNil: [self error: 'This node doesn''t have a parent'].
	self replaceMethodSource: aNode.
	parent replaceNode: self withNode: aNode! !

!RBProgramNode methodsFor: 'testing' stamp: 'ClementBera 7/26/2013 17:11'!
isUsed
	"Answer true if this node could be used as part of another expression. For example, you could use the 
	result of this node as a receiver of a message, an argument, the right part of an assignment, or the 
	return value of a block. This differs from isDirectlyUsed in that it is conservative since it also includes 
	return values of blocks."

	^parent ifNil: [false] ifNotNil: [parent uses: self]! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
isLiteralNode
	^false! !

!RBProgramNode methodsFor: 'querying' stamp: 'lr 11/2/2009 00:14'!
selfMessages
	| searcher |
	searcher := RBParseTreeSearcher new.
	searcher matches: 'self `@msg: ``@args'
		do: 
			[:aNode :answer | 
			answer
				add: aNode selector;
				yourself].
	^searcher executeTree: self initialAnswer: Set new! !

!RBProgramNode methodsFor: 'properties' stamp: 'MarcusDenker 3/25/2013 21:02'!
propertyAt: aKey put: anObject
	"Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject."

	^ (properties ifNil: [ properties := SmallDictionary new: 1 ])
		at: aKey put: anObject! !

!RBProgramNode methodsFor: 'matching' stamp: ''!
copyList: matchNodes inContext: aDictionary 
	| newNodes |
	newNodes := OrderedCollection new.
	matchNodes do: 
			[:each | 
			| object |
			object := each copyInContext: aDictionary.
			newNodes addAll: object].
	^newNodes! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
allArgumentVariables
	| children |
	children := self children.
	children isEmpty ifTrue: [^#()].
	^children inject: OrderedCollection new
		into: 
			[:vars :each | 
			vars
				addAll: each allArgumentVariables;
				yourself]! !

!RBProgramNode methodsFor: '*NodeNavigation' stamp: 'GiselaDecuzzi 5/13/2013 11:12'!
statements
	^ #().! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
source
	^parent notNil ifTrue: [parent source] ifFalse: [nil]! !

!RBProgramNode methodsFor: 'printing' stamp: 'lr 11/1/2009 19:28'!
printOn: aStream 
	aStream
		nextPutAll: self class name;
		nextPut: $(;
		nextPutAll: self formattedCode;
		nextPut: $)! !

!RBProgramNode methodsFor: '*reflectivity' stamp: 'MarcusDenker 3/21/2015 16:35'!
afterLinks
	^ self links select: [ :each | each control == #after ]! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
evaluatedFirst: aNode 
	self children do: 
			[:each | 
			each == aNode ifTrue: [^true].
			each isImmediateNode ifFalse: [^false]].
	^false! !

!RBProgramNode methodsFor: 'copying' stamp: 'PabloHerrero 11/18/2013 19:14'!
copyCommentsFrom: aNode 
	"Add all comments from aNode to us. If we already have the comment, then don't add it."

	| newComments |
	newComments := OrderedCollection new.
	aNode nodesDo: [:each | newComments addAll: each comments].
	self nodesDo: 
			[:each | 
			each comments do: [:comment | newComments remove: comment ifAbsent: []]].
	newComments isEmpty ifTrue: [^self].
	newComments := newComments asSortedCollection: [:a :b | a start < b start].
	self comments: newComments! !

!RBProgramNode methodsFor: 'accessing' stamp: 'MarkRizun 10/20/2014 18:39'!
sourceInterval
	^ self start to: self stop! !

!RBProgramNode methodsFor: '*OpalDecompiler' stamp: 'ClementBera 7/16/2014 13:25'!
isIndirectTempVector
	^ false! !

!RBProgramNode methodsFor: '*opalcompiler-core' stamp: 'MarcusDenker 3/8/2015 09:24'!
doSemanticAnalysis
	^ self methodNode doSemanticAnalysis.
	! !

!RBProgramNode methodsFor: 'testing' stamp: 'ClementBera 7/26/2013 17:11'!
isDirectlyUsed
	"This node is directly used as an argument, receiver, or part of an assignment."

	^parent ifNil: [false] ifNotNil: [parent directlyUses: self]! !

!RBProgramNode methodsFor: 'enumeration' stamp: ''!
size
	"Hacked to fit collection protocols"

	^1! !

!RBProgramNode methodsFor: 'replacing' stamp: 'ClementBera 7/26/2013 17:10'!
addReplacement: aStringReplacement
	parent ifNil: [^self].
	parent addReplacement: aStringReplacement! !

!RBProgramNode methodsFor: 'querying' stamp: ''!
whichNodeIsContainedBy: anInterval 
	| selectedChildren |
	(self intersectsInterval: anInterval) ifFalse: [^nil].
	(self containedBy: anInterval) ifTrue: [^self].
	selectedChildren := self children 
				select: [:each | each intersectsInterval: anInterval].
	^selectedChildren size == 1 
		ifTrue: [selectedChildren first whichNodeIsContainedBy: anInterval]
		ifFalse: [nil]! !

!RBProgramNode methodsFor: 'deprecated' stamp: ''!
isImmediate
	^self isImmediateNode! !

!RBProgramNode methodsFor: 'replacing' stamp: ''!
removeDeadCode
	self children do: [:each | each removeDeadCode]! !

!RBProgramNode methodsFor: 'visiting' stamp: ''!
acceptVisitor: aProgramNodeVisitor 
	self subclassResponsibility! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
intersectsInterval: anInterval 
	^(anInterval first between: self start and: self stop) 
		or: [self start between: anInterval first and: anInterval last]! !

!RBProgramNode methodsFor: 'properties' stamp: 'lr 10/18/2009 17:19'!
hasProperty: aKey
	"Test if the property aKey is present."
	
	^ properties notNil and: [ properties includesKey: aKey ]! !

!RBProgramNode methodsFor: '*opalcompiler-core' stamp: ''!
owningScope

	^ parent owningScope ! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
methodComments
	^self comments! !

!RBProgramNode methodsFor: 'accessing' stamp: 'lr 3/26/2010 17:29'!
formattedCode
	^ self formatterClass new format: self! !

!RBProgramNode methodsFor: 'accessing' stamp: 'PabloHerrero 11/7/2013 11:13'!
statementComments
	| statementComments |
	statementComments := OrderedCollection withAll: self comments.
	self children do: [:each | statementComments addAll: each statementComments].
	^statementComments asSortedCollection: [:a :b | a start < b start]! !

!RBProgramNode methodsFor: 'matching' stamp: ''!
matchList: matchNodes against: programNodes inContext: aDictionary 
	^self
		matchList: matchNodes
		index: 1
		against: programNodes
		index: 1
		inContext: aDictionary! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
isMethod
	^false! !

!RBProgramNode methodsFor: 'matching' stamp: ''!
matchList: matchNodes index: matchIndex against: programNodes index: programIndex inContext: aDictionary 
	| node currentIndex currentDictionary nodes |
	matchNodes size < matchIndex ifTrue: [^programNodes size < programIndex].
	node := matchNodes at: matchIndex.
	node isList 
		ifTrue: 
			[currentIndex := programIndex - 1.
			
			[currentDictionary := aDictionary copy.
			programNodes size < currentIndex or: 
					[nodes := programNodes copyFrom: programIndex to: currentIndex.
					(currentDictionary at: node ifAbsentPut: [nodes]) = nodes and: 
							[(self 
								matchList: matchNodes
								index: matchIndex + 1
								against: programNodes
								index: currentIndex + 1
								inContext: currentDictionary) 
									ifTrue: 
										[currentDictionary 
											keysAndValuesDo: [:key :value | aDictionary at: key put: value].
										^true].
							false]]] 
					whileFalse: [currentIndex := currentIndex + 1].
			^false].
	programNodes size < programIndex ifTrue: [^false].
	(node match: (programNodes at: programIndex) inContext: aDictionary) 
		ifFalse: [^false].
	^self 
		matchList: matchNodes
		index: matchIndex + 1
		against: programNodes
		index: programIndex + 1
		inContext: aDictionary! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
parent: aRBProgramNode 
	parent := aRBProgramNode! !

!RBProgramNode methodsFor: '*SmartSuggestions' stamp: 'GiselaDecuzzi 4/5/2013 17:12'!
specialCommands
	^#().! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
isMessage
	^false! !

!RBProgramNode methodsFor: 'accessing' stamp: 'lr 3/26/2010 17:29'!
formatterClass
	^ self class formatterClass! !

!RBProgramNode methodsFor: 'testing' stamp: 'CamilloBruni 12/15/2011 14:32'!
isSelf
	^ false! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
hasMultipleReturns
	| count |
	count := 0.
	self nodesDo: [:each | each isReturn ifTrue: [count := count + 1]].
	^count > 1! !

!RBProgramNode methodsFor: 'querying' stamp: ''!
bestNodeFor: anInterval 
	| selectedChildren |
	(self intersectsInterval: anInterval) ifFalse: [^nil].
	(self containedBy: anInterval) ifTrue: [^self].
	selectedChildren := self children 
				select: [:each | each intersectsInterval: anInterval].
	^selectedChildren size == 1 
		ifTrue: [selectedChildren first bestNodeFor: anInterval]
		ifFalse: [self]! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
isReturn
	^false! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
isSequence
	^false! !

!RBProgramNode methodsFor: 'comparing' stamp: ''!
equalTo: aNode exceptForVariables: variableNameCollection 
	| dictionary |
	dictionary := Dictionary new.
	(self equalTo: aNode withMapping: dictionary) ifFalse: [^false].
	dictionary keysAndValuesDo: 
			[:key :value | 
			(key = value or: [variableNameCollection includes: key]) ifFalse: [^false]].
	^true! !

!RBProgramNode methodsFor: 'querying' stamp: ''!
whoDefines: aName 
	^(self defines: aName) 
		ifTrue: [self]
		ifFalse: [parent notNil ifTrue: [parent whoDefines: aName] ifFalse: [nil]]! !

!RBProgramNode methodsFor: 'private-replacing' stamp: ''!
replaceSourceWith: aNode 
	aNode replaceSourceFrom: self! !

!RBProgramNode methodsFor: 'properties' stamp: 'lr 12/29/2009 12:45'!
propertyAt: aKey
	"Answer the property value associated with aKey."
	
	^ self propertyAt: aKey ifAbsent: [ self error: 'Property not found' ]! !

!RBProgramNode methodsFor: 'accessing' stamp: 'ClementBera 7/26/2013 17:13'!
temporaryVariables
	^parent ifNil: [#()] ifNotNil: [parent temporaryVariables]! !

!RBProgramNode methodsFor: 'testing' stamp: 'lr 10/27/2009 14:33'!
isPragma
	^false! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
containsReturn
	^self children anySatisfy: [:each | each containsReturn]! !

!RBProgramNode methodsFor: '*reflectivity' stamp: 'MarcusDenker 3/6/2015 15:35'!
hasMetalink
	^self hasProperty: #links! !

!RBProgramNode methodsFor: 'accessing' stamp: 'ClementBera 7/26/2013 17:12'!
methodNode
	^parent ifNotNil: [parent methodNode]! !

!RBProgramNode methodsFor: 'accessing' stamp: 'ClementBera 7/26/2013 17:12'!
parents
	^ parent 
		ifNil: [ OrderedCollection with: self ]
		ifNotNil: [ 
			parent parents
				addLast: self;
				yourself ]! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
references: aVariableName 
	^self children anySatisfy: [:each | each references: aVariableName]! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
assigns: aVariableName 
	^self children anySatisfy: [:each | each assigns: aVariableName]! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
isVariable
	^false! !

!RBProgramNode methodsFor: '*opalcompiler-core' stamp: 'ClementBera 7/26/2013 15:24'!
scope
	^ self methodOrBlockNode scope! !

!RBProgramNode methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 7/14/2014 10:29'!
gtInspectorTreeIn: composite
	<gtInspectorPresentationOrder: 30> 
	^ (GTSimpleRBTreeBrowser new treeIn: composite)
		title: 'Tree'! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
debugHighlightStart

	^ self start ! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
isLast: aNode 
	| children |
	children := self children.
	^children notEmpty and: [children last == aNode]! !

!RBProgramNode methodsFor: 'querying' stamp: ''!
statementNode
	"Return your topmost node that is contained by a sequence node."

	(parent isNil or: [parent isSequence]) ifTrue: [^self].
	^parent statementNode! !

!RBProgramNode methodsFor: 'comparing' stamp: 'lr 3/7/2010 13:47'!
hashForCollection: aCollection
	^ aCollection isEmpty ifTrue: [ 0 ] ifFalse: [ aCollection first hash ]! !

!RBProgramNode methodsFor: 'properties' stamp: 'ClementBera 7/26/2013 17:12'!
propertyAt: aKey ifAbsent: aBlock
	"Answer the property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock."
	
	^ properties 
		ifNil: [ aBlock value ]
		ifNotNil: [ properties at: aKey ifAbsent: aBlock ]! !

!RBProgramNode methodsFor: 'replacing' stamp: ''!
replaceNode: aNode withNode: anotherNode 
	self error: 'I don''t store other nodes'! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
uses: aNode
	^true! !

!RBProgramNode methodsFor: 'meta variable-accessing' stamp: ''!
cascadeListCharacter
	^$;! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
defines: aName
	^false! !

!RBProgramNode methodsFor: 'enumeration' stamp: ''!
collect: aBlock 
	"Hacked to fit collection protocols"

	^aBlock value: self! !

!RBProgramNode methodsFor: 'accessing' stamp: 'MarcusDenker 12/17/2012 15:53'!
debugHighlightRange

	^ self debugHighlightStart to: self debugHighlightStop .! !

!RBProgramNode methodsFor: '*opalcompiler-core' stamp: 'ClementBera 7/26/2013 15:24'!
printAsIfCompiledOn: aStream 
	aStream nextPutAll: self formattedCode! !

!RBProgramNode methodsFor: 'copying' stamp: 'lr 12/29/2009 12:44'!
postCopy
	super postCopy.
	properties := properties copy! !

!RBProgramNode methodsFor: 'testing-matching' stamp: ''!
recurseInto
	^false! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
allDefinedVariables
	| children |
	children := self children.
	children isEmpty ifTrue: [^#()].
	^children inject: OrderedCollection new
		into: 
			[:vars :each | 
			vars
				addAll: each allDefinedVariables;
				yourself]! !

!RBProgramNode methodsFor: 'accessing' stamp: 'PabloHerrero 11/19/2013 01:55'!
comments
	"Answer the comments of the receiving parse tree node"
	
	^ (self propertyAt: #comments ifAbsent: [ #() ]) ifNil:[ #() ]! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
isLiteralArray
	^false! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
isEvaluatedFirst
	"Return true if we are the first thing evaluated in this statement."

	^parent isNil or: [parent isSequence or: [parent evaluatedFirst: self]]! !

!RBProgramNode methodsFor: '*SmartSuggestions' stamp: 'GiselaDecuzzi 6/12/2013 11:35'!
suggestions
	^SugsSuggestionFactory globalCommands addAll: self specialCommands; yourself ! !

!RBProgramNode methodsFor: '*reflectivity' stamp: 'MarcusDenker 3/1/2015 10:10'!
links
	^self propertyAt: #links ifAbsent: nil! !

!RBProgramNode methodsFor: '*reflectivity' stamp: 'MarcusDenker 3/8/2015 09:14'!
removeLink: aMetaLink
	self links remove: aMetaLink.
	self links ifEmpty: [ self removeProperty: #links ].
	self methodNode method removeLink. ! !

!RBProgramNode methodsFor: 'testing' stamp: 'GiselaDecuzzi 6/5/2013 10:27'!
isFaulty
	self subclassResponsibility! !

!RBProgramNode methodsFor: '*opalcompiler-core' stamp: 'ClementBera 8/5/2013 11:03'!
isClean
	^ self children allSatisfy: [ :child | child isClean ]! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
debugHighlightStop

	^ self stop ! !

!RBProgramNode methodsFor: 'accessing' stamp: 'ClementBera 7/26/2013 17:11'!
mappingFor: aNode
	| method |
	method := self methodNode.
	method ifNil: [^aNode].
	^method mappingFor: aNode! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
start
	self subclassResponsibility! !

!RBProgramNode methodsFor: 'testing' stamp: 'CamilloBruni 12/15/2011 14:32'!
isTemp
	^ false! !

!RBProgramNode methodsFor: 'accessing' stamp: 'ClementBera 7/26/2013 17:10'!
blockVariables
	^parent ifNil: [#()] ifNotNil: [parent blockVariables]! !

!RBProgramNode methodsFor: 'testing' stamp: 'CamilloBruni 12/15/2011 14:31'!
isArgument
	^false! !

!RBProgramNode methodsFor: 'properties' stamp: 'ClementBera 7/26/2013 17:12'!
removeProperty: aKey ifAbsent: aBlock
	"Remove the property with aKey. Answer the value or, if aKey isn't found, answer the result of evaluating aBlock."
	
	| answer |
	properties ifNil: [ ^ aBlock value ].
	answer := properties removeKey: aKey ifAbsent: aBlock.
	properties isEmpty ifTrue: [ properties := nil ].
	^ answer! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
lastIsReturn
	^self isReturn! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
isValue
	^false! !

!RBProgramNode methodsFor: '*reflectivity' stamp: 'MarcusDenker 3/21/2015 16:35'!
beforeLinks
	^ self links select: [ :each | each control == #before ]! !

!RBProgramNode methodsFor: 'matching' stamp: 'lr 11/24/2009 23:30'!
copyInContext: aDictionary
	^ self copy! !

!RBProgramNode methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 3/21/2015 21:36'!
gtInspectorSourceCodeIn: composite
	<gtInspectorPresentationOrder: 30> 

	^ composite smalltalkCode 
		title: 'Source code';
		display: [ self source ];
		smalltalkClass: [ 
			self parents first compilationContext ifNotNil: [ :ctx | ctx getClass ] ]; 
		initialize: [ :presentation | 
			presentation selectionInterval: self sourceInterval ];
		act: [ self methodNode method compiledMethod browse ] icon: GLMUIThemeExtraIcons glamorousBrowse entitled: 'Browse'! !

!RBProgramNode methodsFor: 'accessing' stamp: 'ClementBera 7/26/2013 17:10'!
asReturn
	"Change the current node to a return node."

	parent ifNil: [self error: 'Cannot change to a return without a parent node.'].
	parent isSequence 
		ifFalse: [self error: 'Parent node must be a sequence node.'].
	(parent isLast: self) ifFalse: [self error: 'Return node must be last.'].
	^parent addReturn! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
stop
	self subclassResponsibility! !

!RBProgramNode methodsFor: 'meta variable-accessing' stamp: ''!
listCharacter
	^$@! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
allTemporaryVariables
	| children |
	children := self children.
	children isEmpty ifTrue: [^#()].
	^children inject: OrderedCollection new
		into: 
			[:vars :each | 
			vars
				addAll: each allTemporaryVariables;
				yourself]! !

!RBProgramNode methodsFor: 'comparing' stamp: ''!
equalTo: aNode withMapping: aDictionary 
	^self = aNode! !

!RBProgramNode methodsFor: '*OpalDecompiler' stamp: 'ClementBera 7/16/2014 13:30'!
isJust: node
	^ false! !

!RBProgramNode methodsFor: 'meta variable-accessing' stamp: ''!
statementCharacter
	^$.! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
containedBy: anInterval 
	^anInterval first <= self start and: [anInterval last >= self stop]! !

!RBProgramNode methodsFor: 'testing' stamp: 'MarcusDenker 6/27/2013 16:59'!
isSuper
	^false! !

!RBProgramNode methodsFor: '*opalcompiler-core' stamp: 'MarcusDenker 12/18/2012 14:08'!
irInstruction
	"search for the first ir instruction that I generate"
	self methodNode ir sourceNode == self  ifTrue: [^self methodNode ir].
	^self methodNode ir firstInstructionMatching: [:instr | instr sourceNode == self ]
	
! !

!RBProgramNode methodsFor: 'properties' stamp: 'lr 12/29/2009 12:45'!
propertyAt: aKey ifAbsentPut: aBlock
	"Answer the property associated with aKey or, if aKey isn't found store the result of evaluating aBlock as new value."
	
	^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ]! !

!RBProgramNode methodsFor: 'enumeration' stamp: ''!
do: aBlock 
	"Hacked to fit collection protocols"

	aBlock value: self! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
isCascade
	^false! !

!RBProgramNode methodsFor: 'meta variable-accessing' stamp: ''!
recurseIntoCharacter
	^$`! !

!RBProgramNode methodsFor: '*opalcompiler-core' stamp: 'CamilleTeruel 2/14/2014 14:33'!
enclosingMethodOrBlockNode
	^ self methodOrBlockNode ! !

!RBProgramNode class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/26/2015 17:52'!
gtExampleRBProgramNode
	<gtExample: 'RBProgramNode'>
	^ (GTInspector class >> #gtInspectorExtensionsIn:) parseTree! !

!RBProgramNode class methodsFor: 'accessing' stamp: 'MarcusDenker 12/16/2013 20:16'!
formatterClass: aClass
	FormatterClass := aClass
		! !

!RBProgramNode class methodsFor: 'accessing' stamp: 'lr 11/7/2009 15:37'!
optimizedSelectors
	^ #( and: caseOf: caseOf:otherwise: ifFalse: ifFalse:ifTrue: ifNil: ifNil:ifNotNil: ifNotNil: ifNotNil:ifNil: ifTrue: ifTrue:ifFalse: or: to:by:do: to:do: whileFalse whileFalse: whileTrue whileTrue: )! !

!RBProgramNode class methodsFor: 'accessing' stamp: 'ClementBera 7/26/2013 16:30'!
formatterClass
	^ FormatterClass 
		ifNil: [ RBConfigurableFormatter ] 
		ifNotNil: [ FormatterClass ]! !

!RBProgramNodeTest commentStamp: 'TorstenBergmann 2/4/2014 21:53'!
SUnit tests for RBProgramNode!
!RBProgramNodeTest methodsFor: 'testing-adding' stamp: 'lr 1/4/2012 22:12'!
testAddNode
	| tree treeNode |
	tree := self parseExpression: '1. 2'.
	treeNode := tree addNode: (self parseExpression: '3').
	self assert: (self parseExpression: '1. 2. 3') = tree.
	self assert: tree statements last = treeNode.
	
	tree := self parseExpression: '{ 1. 2 }'.
	treeNode := tree addNode: (self parseExpression: '3').
	self assert: (self parseExpression: '{ 1. 2. 3 }') = tree.
	self assert: tree statements last = treeNode! !

!RBProgramNodeTest methodsFor: 'testing-replacing' stamp: 'lr 5/26/2010 08:39'!
testReplaceMethodBinary
	| tree |
	tree := self parseMethod: '= "1" anObject "2" ^ "3" 4 "5"'.
	tree renameSelector: #runCase andArguments: #().
	self assert: tree newSource = 'runCase "2" ^ "3" 4 "5"'.
	
	tree := self parseMethod: '= "1" anObject "2" ^ "3" 4 "5"'.
	tree renameSelector: #~~ andArguments: (Array with: (self parseExpression: 'first')).
	self assert: tree newSource = '~~ "1" first "2" ^ "3" 4 "5"'.

	tree := self parseMethod: '= "1" anObject "2" ^ "3" 4 "5"'.
	tree renameSelector: #assert: andArguments: (Array with: (RBVariableNode named: 'first')).
	self assert: tree newSource = 'assert: "1" first "2" ^ "3" 4 "5"'.

	tree := self parseMethod: '= "1" anObject "2" ^ "3" 4 "5"'.
	tree renameSelector: #assert:description: andArguments: (Array with: (RBVariableNode named: 'first') with: (RBVariableNode named: 'second')).
	self assert: tree newSource = 'assert: first description: second "2" ^ "3" 4 "5"'! !

!RBProgramNodeTest methodsFor: 'accessing' stamp: 'lr 2/21/2010 12:17'!
parseMethod: aString
	^ RBParser parseMethod: aString! !

!RBProgramNodeTest methodsFor: 'testing-replacing' stamp: 'lr 5/26/2010 08:39'!
testReplaceMethodKeywordLong
	| tree |
	tree := self parseMethod: 'deny: "1" anObject "2" description: "3" anotherObject "4" ^ "5" 6 "7"'.
	tree renameSelector: #runCase andArguments: #().
	self assert: tree newSource = 'runCase "4" ^ "5" 6 "7"'.
	
	tree := self parseMethod: 'deny: "1" anObject "2" description: "3" anotherObject "4" ^ "5" 6 "7"'.
	tree renameSelector: #~~ andArguments: (Array with: (self parseExpression: 'first')).
	self assert: tree newSource = '~~ first "4" ^ "5" 6 "7"'.

	tree := self parseMethod: 'deny: "1" anObject "2" description: "3" anotherObject "4" ^ "5" 6 "7"'.
	tree renameSelector: #assert: andArguments: (Array with: (self parseExpression: 'first')).
	self assert: tree newSource = 'assert: first "4" ^ "5" 6 "7"'.

	tree := self parseMethod: 'deny: "1" anObject "2" description: "3" anotherObject "4" ^ "5" 6 "7"'.
	tree renameSelector: #assert:description: andArguments: (Array with: (self parseExpression: 'first') with: (self parseExpression: 'second')).
	self assert: tree newSource = 'assert: "1" first "2" description: "3" second "4" ^ "5" 6 "7"'! !

!RBProgramNodeTest methodsFor: 'testing-adding' stamp: 'lr 1/4/2012 22:11'!
testAddNodesFirst
	| tree treeNodes |
	tree := self parseExpression: '3. 4'.
	treeNodes := tree addNodesFirst: (self parseExpression: '1. 2') statements.
	self assert: (self parseExpression: '1. 2. 3. 4') = tree.
	self assert: (tree statements at: 1) = treeNodes first.
	self assert: (tree statements at: 2) = treeNodes last.
	
	tree := self parseExpression: '{ 3. 4 }'.
	treeNodes := tree addNodesFirst: (self parseExpression: '1. 2') statements.
	self assert: (self parseExpression: '{ 1. 2. 3. 4 }') = tree.
	self assert: (tree statements at: 1) = treeNodes first.
	self assert: (tree statements at: 2) = treeNodes last! !

!RBProgramNodeTest methodsFor: 'testing-adding' stamp: 'lr 1/4/2012 21:55'!
testAddTemporaryNamed
	| tree variable |
	tree := self parseExpression: '| a | a'.
	variable := tree addTemporaryNamed: 'b'.
	self assert: variable isVariable.
	self assert: variable name = 'b'.
	self assert: tree temporaries last = variable! !

!RBProgramNodeTest methodsFor: 'testing-adding' stamp: 'lr 1/4/2012 22:09'!
testAddNodes
	| tree treeNodes |
	tree := self parseExpression: '1. 2'.
	treeNodes := tree addNodes: (self parseExpression: '3. 4') statements.
	self assert: (self parseExpression: '1. 2. 3. 4') = tree.
	self assert: (tree statements at: 3) = treeNodes first.
	self assert: (tree statements at: 4) = treeNodes last.
	
	tree := self parseExpression: '{ 1. 2 }'.
	treeNodes := tree addNodes: (self parseExpression: '3. 4') statements.
	self assert: (self parseExpression: '{ 1. 2. 3. 4 }') = tree.
	self assert: (tree statements at: 3) = treeNodes first.
	self assert: (tree statements at: 4) = treeNodes last! !

!RBProgramNodeTest methodsFor: 'testing-adding' stamp: 'lr 1/4/2012 22:11'!
testAddNodeBefore
	| tree treeNode |
	tree := self parseExpression: '1. 3'.
	treeNode := tree
		addNode: (self parseExpression: '2')
		before: tree statements last.
	self assert: (self parseExpression: '1. 2. 3') = tree.
	self assert: (tree statements at: 2) = treeNode.
	
	tree := self parseExpression: '{ 1. 3 }'.
	treeNode := tree
		addNode: (self parseExpression: '2')
		before: tree statements last.
	self assert: (self parseExpression: '{ 1. 2. 3 }') = tree.
	self assert: (tree statements at: 2) = treeNode! !

!RBProgramNodeTest methodsFor: 'testing-replacing' stamp: 'MarkRizun 1/14/2015 11:38'!
testReplaceMessage
	| tree |
	tree := self parseMethod: 'run "1" self "2" run "3"'.
	tree body statements first replaceWith: (self parseExpression: 'self runCase').
	self assert: tree newSource = 'run "1" self "2" runCase "3"'! !

!RBProgramNodeTest methodsFor: 'testing-replacing' stamp: 'MarkRizun 1/14/2015 11:37'!
testReplaceLiteral
	| tree |
	tree := self parseMethod: 'run "1" 123 "2"'.
	tree body statements first replaceWith: (self parseExpression: '$a').
	self assert: tree newSource = 'run "1" $a "2"'.
	tree := self parseMethod: 'run "1" 123 "2"'.
	tree body statements first replaceWith: (self parseExpression: 'zork').
	self assert: tree newSource = 'run "1" zork "2"'! !

!RBProgramNodeTest methodsFor: 'testing-replacing' stamp: 'MarkRizun 1/14/2015 11:37'!
testReplaceAssignment
	| tree |
	tree := self parseMethod: 'run sum := 2 + 2'.
	tree body statements first replaceWith: (self parseExpression: 'multpppp := 2 * 2').
	self
		assert:
			tree newSource
				=
					'run
	multpppp := 2 * 2'! !

!RBProgramNodeTest methodsFor: 'testing-replacing' stamp: 'lr 5/26/2010 08:39'!
testReplaceMethodKeyword
	| tree |
	tree := self parseMethod: 'deny: "1" anObject "2" ^ "3" 4 "5"'.
	tree renameSelector: #runCase andArguments: #().
	self assert: tree newSource = 'runCase "2" ^ "3" 4 "5"'.
	
	tree := self parseMethod: 'deny: "1" anObject "2" ^ "3" 4 "5"'.
	tree renameSelector: #~~ andArguments: (Array with: (self parseExpression: 'first')).
	self assert: tree newSource = '~~ "1" first "2" ^ "3" 4 "5"'.

	tree := self parseMethod: 'deny: "1" anObject "2" ^ "3" 4 "5"'.
	tree renameSelector: #assert: andArguments: (Array with: (RBVariableNode named: 'first')).
	self assert: tree newSource = 'assert: "1" first "2" ^ "3" 4 "5"'.

	tree := self parseMethod: 'deny: "1" anObject "2" ^ "3" 4 "5"'.
	tree renameSelector: #assert:description: andArguments: (Array with: (RBVariableNode named: 'first') with: (RBVariableNode named: 'second')).
	self assert: tree newSource = 'assert: first description: second "2" ^ "3" 4 "5"'! !

!RBProgramNodeTest methodsFor: 'testing-replacing' stamp: 'MarkRizun 1/14/2015 11:37'!
testReplaceLiteralArray1
	| tree |
	tree := self parseMethod: 'run "1" #(1 2 3) "2"'.
	tree body statements first replaceWith: (self parseExpression: '#[1 2 3]').
	self assert: tree newSource = 'run "1" #[1 2 3] "2"'.
	tree := self parseMethod: 'run "1" #(1 2 3) "2"'.
	tree body statements first replaceWith: (self parseExpression: '123').
	self assert: tree newSource = 'run "1" 123 "2"'! !

!RBProgramNodeTest methodsFor: 'testing-comments' stamp: 'PabloHerrero 3/7/2015 21:00'!
testSetCommentsToNil

	self node comments: nil.
	self assert: self node comments equals: #()! !

!RBProgramNodeTest methodsFor: 'testing-adding' stamp: 'lr 1/4/2012 22:10'!
testAddNodesBefore
	| tree treeNodes |
	tree := self parseExpression: '1. 4'.
	treeNodes := tree 
		addNodes: (self parseExpression: '2. 3') statements
		before: tree statements last.
	self assert: (self parseExpression: '1. 2. 3. 4') = tree.
	self assert: (tree statements at: 2) = treeNodes first.
	self assert: (tree statements at: 3) = treeNodes last.
	
	tree := self parseExpression: '{ 1. 4 }'.
	treeNodes := tree 
		addNodes: (self parseExpression: '2. 3') statements
		before: tree statements last.
	self assert: (self parseExpression: '{ 1. 2. 3. 4 }') = tree.
	self assert: (tree statements at: 2) = treeNodes first.
	self assert: (tree statements at: 3) = treeNodes last! !

!RBProgramNodeTest methodsFor: 'testing-replacing' stamp: 'MarkRizun 1/14/2015 11:39'!
testReplaceMessageArgument
	| tree |
	tree := self parseMethod: 'foo "1" self "2" foo: "3" foo "4"'.
	tree body statements first arguments first replaceWith: (self parseExpression: 'bar').
	self assert: tree newSource = 'foo "1" self "2" foo: "3" bar "4"'.
	tree := self parseMethod: 'foo "1" self "2" foo: "3" foo "4"'.
	tree body statements first arguments first replaceWith: (self parseExpression: 'bar msg1 msg2').
	self assert: tree newSource = 'foo "1" self "2" foo: "3" bar msg1 msg2 "4"'.
	tree := self parseMethod: 'foo "1" self "2" foo: "3" foo bar "4"'.
	tree body statements first arguments first replaceWith: (self parseExpression: 'bar').
	self assert: tree newSource = 'foo "1" self "2" foo: "3" bar "4"'! !

!RBProgramNodeTest methodsFor: 'testing-properties' stamp: 'lr 12/29/2009 12:49'!
testPropertyAtIfAbsent
	self assert: (self node propertyAt: #foo ifAbsent: [ true ]).
	self node propertyAt: #foo put: true.
	self assert: (self node propertyAt: #foo ifAbsent: [ false ])! !

!RBProgramNodeTest methodsFor: 'testing-replacing' stamp: 'MarkRizun 1/14/2015 11:39'!
testReplaceMessageReceiver
	| tree |
	tree := self parseMethod: 'foo "1" self "2" foo: "3" 123 "4"'.
	tree body statements first receiver replaceWith: (self parseExpression: 'bar').
	self assert: tree newSource = 'foo "1" bar "2" foo: "3" 123 "4"'.
	tree := self parseMethod: 'foo "1" self "2" foo: "3" 123 "4"'.
	tree body statements first receiver replaceWith: (self parseExpression: 'bar msg1 msg2').
	self assert: tree newSource = 'foo "1" bar msg1 msg2 "2" foo: "3" 123 "4"'.
	tree := self parseMethod: 'foo "1" self foo "2" foo: "3" 123 "4"'.
	tree body statements first receiver replaceWith: (self parseExpression: 'bar').
	self assert: tree newSource = 'foo "1" bar "2" foo: "3" 123 "4"'! !

!RBProgramNodeTest methodsFor: 'testing-replacing' stamp: 'MarkRizun 1/14/2015 11:37'!
testReplaceLiteralArray2
	| tree |
	tree := self parseMethod: 'run "1" #[1 2 3] "2"'.
	tree body statements first replaceWith: (self parseExpression: '#(1 2 3)').
	self assert: tree newSource = 'run "1" #(1 2 3) "2"'.
	tree := self parseMethod: 'run "1" #[1 2 3] "2"'.
	tree body statements first replaceWith: (self parseExpression: '123').
	self assert: tree newSource = 'run "1" 123 "2"'! !

!RBProgramNodeTest methodsFor: 'testing-properties' stamp: 'lr 12/29/2009 12:47'!
testRemovePropertyIfAbsent
	self assert: (self node removeProperty: #foo ifAbsent: [ true ]).
	self node propertyAt: #foo put: true.
	self assert: (self node removeProperty: #foo ifAbsent: [ false ])! !

!RBProgramNodeTest methodsFor: 'accessing' stamp: 'lr 12/29/2009 12:48'!
node
	^ node ifNil: [ node := RBProgramNode new ]! !

!RBProgramNodeTest methodsFor: 'testing-adding' stamp: 'lr 1/4/2012 22:01'!
testAddSelfReturn
	| tree return |
	tree := self parseExpression: '1. 2'.
	return := tree addSelfReturn.
	self assert: tree statements last = return.
	self assert: (self parseExpression: '1. 2. ^ self') = tree.
	
	tree := self parseExpression: '3. ^ 4'.
	return := tree addSelfReturn.
	self assert: tree statements last = return.
	self assert: (self parseExpression: '3. ^ 4') = tree! !

!RBProgramNodeTest methodsFor: 'testing-replacing' stamp: 'MarkRizun 1/14/2015 11:37'!
testReplaceBlock
	| tree |
	tree := self parseMethod: 'run self foo ifNil: [ ^ true ]'.
	tree body statements first arguments first replaceWith: (self parseExpression: '[ ^ false ]').
	self
		assert:
			tree newSource
				=
					'run
	self foo ifNil: [ ^ false ]'! !

!RBProgramNodeTest methodsFor: 'testing-adding' stamp: 'lr 1/4/2012 21:57'!
testAddTemporariesNamed
	| tree variables |
	tree := self parseExpression: '| a | a'.
	variables := tree addTemporariesNamed: #('b' 'c').
	self assert: variables first isVariable.
	self assert: variables first name = 'b'.
	self assert: variables second isVariable.
	self assert: variables second name = 'c'.
	self assert: tree temporaries second = variables first.
	self assert: tree temporaries last = variables second
	! !

!RBProgramNodeTest methodsFor: 'testing-properties' stamp: 'lr 12/29/2009 12:47'!
testRemoveProperty
	self should: [ self node removeProperty: #foo ] raise: Error.
	self node propertyAt: #foo put: true.
	self assert: (self node removeProperty: #foo)! !

!RBProgramNodeTest methodsFor: 'testing-replacing' stamp: 'lr 5/26/2010 08:39'!
testReplaceMethodUnary
	| tree |
	tree := self parseMethod: 'run "1" ^ "2" 3 "4"'.
	tree renameSelector: #runCase andArguments: #().
	self assert: tree newSource = 'runCase "1" ^ "2" 3 "4"'.
	
	tree := self parseMethod: 'run "1" ^ "2" 3 "4"'.
	tree renameSelector: #~~ andArguments: (Array with: (self parseExpression: 'first')).
	self assert: tree newSource = '~~ first "1" ^ "2" 3 "4"'.

	tree := self parseMethod: 'run "1" ^ "2" 3 "4"'.
	tree renameSelector: #assert: andArguments: (Array with: (self parseExpression: 'first')).
	self assert: tree newSource = 'assert: first "1" ^ "2" 3 "4"'.

	tree := self parseMethod: 'run "1" ^ "2" 3 "4"'.
	tree renameSelector: #assert:description: andArguments: (Array with: (self parseExpression: 'first') with: (self parseExpression: 'second')).
	self assert: tree newSource = 'assert: first description: second "1" ^ "2" 3 "4"'! !

!RBProgramNodeTest methodsFor: 'testing-properties' stamp: 'lr 12/29/2009 12:46'!
testPropertyAtIfAbsentPut
	self assert: (self node propertyAt: #foo ifAbsentPut: [ true ]).
	self assert: (self node propertyAt: #foo ifAbsentPut: [ false ])! !

!RBProgramNodeTest methodsFor: 'testing-properties' stamp: 'lr 12/29/2009 12:49'!
testHasProperty
	self deny: (self node hasProperty: #foo).
	self node propertyAt: #foo put: 123.
	self assert: (self node hasProperty: #foo)! !

!RBProgramNodeTest methodsFor: 'accessing' stamp: 'lr 2/21/2010 12:17'!
parseExpression: aString
	^ RBParser parseExpression: aString! !

!RBProgramNodeTest methodsFor: 'testing-adding' stamp: 'lr 1/4/2012 22:01'!
testAddReturn
	| tree return |
	tree := self parseExpression: '1. 2'.
	return := tree addReturn.
	self assert: tree statements last = return.
	self assert: (self parseExpression: '1. ^ 2') = tree.
	
	tree := self parseExpression: '3. ^ 4'.
	return := tree addReturn.
	self assert: tree statements last = return.
	self assert: (self parseExpression: '3. ^ 4') = tree! !

!RBProgramNodeTest methodsFor: 'testing-adding' stamp: 'lr 1/4/2012 22:12'!
testAddNodeFirst
	| tree treeNode |
	tree := self parseExpression: '2. 3'.
	treeNode := tree addNodeFirst: (self parseExpression: '1').
	self assert: (self parseExpression: '1. 2. 3') = tree.
	self assert: tree statements first = treeNode.
	
	tree := self parseExpression: '{ 2. 3 }'.
	treeNode := tree addNodeFirst: (self parseExpression: '1').
	self assert: (self parseExpression: '{ 1. 2. 3 }') = tree.
	self assert: tree statements first = treeNode! !

!RBProgramNodeTest methodsFor: 'testing-properties' stamp: 'lr 12/29/2009 12:49'!
testPropertyAt
	self should: [ self node propertyAt: #foo ] raise: Error.
	self node propertyAt: #foo put: true.
	self assert: (self node propertyAt: #foo)! !

!RBProgramNodeTest methodsFor: 'testing-replacing' stamp: 'MarkRizun 1/14/2015 11:39'!
testReplaceVariable
	| tree |
	tree := self parseMethod: 'run "1" foo "2"'.
	tree body statements first replaceWith: (self parseExpression: 'zork').
	self assert: tree newSource = 'run "1" zork "2"'.
	tree := self parseMethod: 'run "1" foo "2"'.
	tree body statements first replaceWith: (self parseExpression: '123').
	self assert: tree newSource = 'run "1" 123 "2"'! !

!RBProgramNodeTest class methodsFor: 'accessing' stamp: 'lr 9/18/2011 15:06'!
packageNamesUnderTest
	^ #('AST-Core')! !

!RBProgramNodeVisitor commentStamp: '<historical>'!
RBProgramNodeVisitor is an abstract visitor for the RBProgramNodes.

!
!RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''!
visitSuperNode: aSuperNode
	^ self visitVariableNode: aSuperNode! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''!
visitThisContextNode: aThisContextNode
	^ self visitVariableNode: aThisContextNode! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''!
visitArgumentNodes: aNodeCollection 
	"Sent *once* when visiting method and block nodes"
	^aNodeCollection do: [ :each | self visitArgumentNode: each ]! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''!
visitCascadeNode: aCascadeNode 
	aCascadeNode messages do: [:each | self visitNode: each]! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''!
visitMessageNode: aMessageNode 
	(aMessageNode isCascaded not or: [aMessageNode isFirstCascaded]) 
		ifTrue: [self visitNode: aMessageNode receiver].
	aMessageNode arguments do: [:each | self visitNode: each]! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''!
visitMethodNode: aMethodNode 
	self visitArgumentNodes: aMethodNode arguments.
	aMethodNode pragmas
		do: [ :each | self visitNode: each ].
	self visitNode: aMethodNode body! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''!
visitArrayNode: anArrayNode 

	anArrayNode children do: [:each | self visitNode: each]! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''!
visitPatternBlockNode: aRBPatternBlockNode 
	self visitArgumentNodes: aRBPatternBlockNode arguments.
	self visitNode: aRBPatternBlockNode body! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''!
visitBlockNode: aBlockNode 
	self visitArgumentNodes: aBlockNode arguments.
	self visitNode: aBlockNode body! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''!
visitSelfNode: aSelfNode
	^ self visitVariableNode: aSelfNode! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''!
visitTemporaryNode: aNode 
	"Sent *each time* a temporary node is found"
	^ self visitVariableNode: aNode! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''!
visitVariableNode: aVariableNode
	^ aVariableNode! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''!
visitTemporaryNodes: aNodeCollection 
	"This is triggered when defining the temporaries between the pipes"
	^self visitArgumentNodes: aNodeCollection! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''!
visitParseErrorNode: anErrorNode! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''!
visitSequenceNode: aSequenceNode 
	self visitTemporaryNodes: aSequenceNode temporaries.
	aSequenceNode statements do: [:each | self visitNode: each]! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''!
visitLiteralArrayNode: aRBLiteralArrayNode 
	aRBLiteralArrayNode contents do: [:each | self visitNode: each]! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''!
visitNode: aNode 
	^aNode acceptVisitor: self! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''!
visitArgumentNode: anArgumentNode
	"Sent *each time* an argument node is found"
	^ self visitVariableNode: anArgumentNode! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''!
visitAssignmentNode: anAssignmentNode

	self visitNode: anAssignmentNode variable.
	self visitNode: anAssignmentNode value! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''!
visitPatternWrapperBlockNode: aRBPatternWrapperBlockNode 
	self visitNode: aRBPatternWrapperBlockNode wrappedNode.
	self visitArgumentNodes: aRBPatternWrapperBlockNode arguments.
	self visitNode: aRBPatternWrapperBlockNode body! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''!
visitLiteralNode: aLiteralNode! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''!
visitReturnNode: aReturnNode 
	^ self visitNode: aReturnNode value! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''!
visitPragmaNode: aPragmaNode
	aPragmaNode arguments do: [ :each | self visitNode: each ]! !

!RBProtectInstanceVariableRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^RBCondition definesInstanceVariable: variableName in: class! !

!RBProtectInstanceVariableRefactoring methodsFor: 'private-accessing' stamp: 'lr 11/2/2009 00:14'!
getterSetterMethods
	| matcher |
	matcher := RBParseTreeSearcher new.
	matcher
		answer: Set new;
		matchesAnyMethodOf: (Array 
					with: '`method ^' , variableName
					with: ('`method: `arg <1s> := `arg' expandMacrosWith: variableName)
					with: ('`method: `arg ^<1s> := `arg' expandMacrosWith: variableName))
			do: 
				[:aNode :answer | 
				(class subclassRedefines: aNode selector) 
					ifFalse: [answer add: aNode selector].
				answer].
	(class whichSelectorsReferToInstanceVariable: variableName) do: 
			[:each | 
			self 
				checkClass: class
				selector: each
				using: matcher].
	^matcher answer! !

!RBProtectInstanceVariableRefactoring methodsFor: 'transforming' stamp: 'lr 9/8/2011 20:11'!
inline: aSelector 
	self onError: 
			[self performComponentRefactoring: (RBInlineAllSendersRefactoring 
						model: self model
						sendersOf: aSelector
						in: class)]
		do: []! !

!RBProtectInstanceVariableRefactoring methodsFor: 'transforming' stamp: ''!
transform
	self setOption: #inlineExpression toUse: [:ref :string | true].
	self getterSetterMethods do: [:each | self inline: each]! !

!RBProtectInstanceVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testVariableNotDefined
	| refactoring |
	refactoring := RBProtectInstanceVariableRefactoring 
		variable: 'rewrite'
		class: RBSubclassOfClassToRename.
	self shouldFail: refactoring! !

!RBProtectInstanceVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testProtectInstanceVariable
	| refactoring class |
	refactoring := RBProtectInstanceVariableRefactoring 
		variable: 'rewrite' , 'Rule1'
		class: RBSubclassOfClassToRename.
	self executeRefactoring: refactoring.
	class := refactoring model classNamed: #RBSubclassOfClassToRename.
	self assert: (class parseTreeFor: #calls1) = (RBParser parseMethod: 'calls1
								^rewriteRule1 := (rewriteRule1 := self calls)').
	self assert: (class parseTreeFor: #calls) = (RBParser parseMethod: 'calls
								^rewriteRule1 := rewriteRule1 , rewriteRule1').
	self deny: (class directlyDefinesMethod: ('rewrite' , 'Rule1') asSymbol).
	self deny: (class directlyDefinesMethod: ('rewrite' , 'Rule1:') asSymbol)! !

!RBProtocolEnvironment methodsFor: 'testing' stamp: 'YuriyTymchuk 7/3/2014 11:21'!
includesClass: aClass
	^ aClass == class and: [super includesClass: aClass]! !

!RBProtocolEnvironment methodsFor: 'testing' stamp: ''!
includesProtocol: aProtocol in: aClass
	^aClass == class and: [(super includesProtocol: aProtocol in: aClass)
			and: [protocols includes: aProtocol]]! !

!RBProtocolEnvironment methodsFor: 'copying' stamp: 'lr 2/26/2009 14:29'!
postCopy
	super postCopy.
	protocols := protocols copy! !

!RBProtocolEnvironment methodsFor: 'testing' stamp: ''!
isEmpty
	^protocols isEmpty! !

!RBProtocolEnvironment methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPut: $(.
	super storeOn: aStream.
	aStream
		nextPutAll: ' class: ';
		nextPutAll: class name;
		nextPutAll: ' protocols: '.
	protocols asArray storeOn: aStream.
	aStream nextPut: $)! !

!RBProtocolEnvironment methodsFor: 'testing' stamp: 'lr 3/20/2011 11:18'!
includesCategory: aCategory
	^ (super includesCategory: aCategory) and: [
		(environment classNamesFor: aCategory)
			inject: false into: [ :bool :each |
				bool or: [
					| aClass |
					aClass := self systemDictionary at: each ifAbsent: [ nil ].
					aClass == class or: [ aClass class == class ] ] ] ]! !

!RBProtocolEnvironment methodsFor: 'private' stamp: ''!
defaultLabel
	| stream |
	stream := String new writeStream.
	stream nextPutAll: class name;
		nextPut: $>.
	protocols do: 
			[:each | 
			stream nextPutAll: each;
				nextPut: $ ].
	^stream contents! !

!RBProtocolEnvironment methodsFor: 'initialize-release' stamp: ''!
class: aClass protocols: aCollection
	class := aClass.
	protocols := aCollection! !

!RBProtocolEnvironment methodsFor: 'testing' stamp: ''!
includesSelector: aSelector in: aClass 
	^(super includesSelector: aSelector in: aClass) and: 
			[protocols 
				includes: (environment whichProtocolIncludes: aSelector in: aClass)]! !

!RBProtocolEnvironment methodsFor: 'testing' stamp: 'YuriyTymchuk 7/3/2014 11:22'!
definesClass: aClass
	^ aClass == class and: [super definesClass: aClass]! !

!RBProtocolEnvironment class methodsFor: 'instance creation' stamp: ''!
onEnvironment: anEnvironment class: aClass protocols: aCollection
	^(self onEnvironment: anEnvironment)
		class: aClass protocols: aCollection; yourself! !

!RBProtocolEnvironment class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/2/2013 23:25'!
class: aClass protocols: aCollection
	^ self 
		onEnvironment: self default
		class: aClass
		protocols: aCollection! !

!RBProtocolRegexRefactoring methodsFor: 'transforming' stamp: ''!
transform
	| original replacement |
	self model allClassesDo: [ :class |
		class selectors do: [ :selector |
			original := (class realClass whichCategoryIncludesSelector: selector)
				asString.
			original isNil ifFalse: [
				replacement := self execute: original.
				replacement = original ifFalse: [
					class
						compile: (class sourceCodeFor: selector)
						classified: replacement ] ] ] ]! !

!RBPullUpClassVariableRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^(RBCondition isMetaclass: class) not! !

!RBPullUpClassVariableRefactoring methodsFor: 'private-accessing' stamp: 'CamilloBruni 10/8/2012 00:06'!
subclassDefiningVariable
	| subclasses |
	subclasses := class allSubclasses 
		select: [ :each | each isMeta not and: [ each directlyDefinesClassVariable: variableName ] ].
	subclasses isEmpty 
		ifTrue: [ self refactoringFailure: 'Could not find a class defining ' , variableName ].
	subclasses size > 1 
		ifTrue: [ self refactoringError: 'Multiple subclasses define ' , variableName ].
	^ subclasses asArray first! !

!RBPullUpClassVariableRefactoring methodsFor: 'transforming' stamp: ''!
transform
	| subclass |
	subclass := self subclassDefiningVariable.
	subclass removeClassVariable: variableName.
	class addClassVariable: variableName! !

!RBPullUpClassVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testMetaClassFailure
	self shouldFail: (RBPullUpClassVariableRefactoring 
			variable: #RecursiveSelfRule
			class: RBLintRuleTest class)! !

!RBPullUpClassVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testPullUpClassVariable
	| refactoring |
	refactoring := RBPullUpClassVariableRefactoring 
		variable: #RecursiveSelfRule
		class: RBLintRuleTest.
	self executeRefactoring: refactoring.
	self assert: ((refactoring model classNamed: #RBLintRuleTest) directlyDefinesClassVariable: #RecursiveSelfRule).
	self deny: ((refactoring model classNamed: #RBTransformationRuleTest) directlyDefinesClassVariable: #RecursiveSelfRule)! !

!RBPullUpClassVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testNonExistantName
	self shouldFail: (RBPullUpClassVariableRefactoring 
			variable: #Foo
			class: RBLintRuleTest)! !

!RBPullUpInstanceVariableRefactoring methodsFor: 'preconditions' stamp: 'CamilloBruni 10/8/2012 00:06'!
preconditions
	^RBCondition withBlock: 
			[(class hierarchyDefinesInstanceVariable: variableName) 
				ifFalse: [self refactoringFailure: 'No subclass defines ' , variableName].
			(class subclasses 
				detect: [:each | (each directlyDefinesInstanceVariable: variableName) not]
				ifNone: [nil]) notNil 
				ifTrue: 
					[self 
						refactoringWarning: 'Not all subclasses have an instance variable named ' 
								, variableName , '.'].
			true]! !

!RBPullUpInstanceVariableRefactoring methodsFor: 'transforming' stamp: ''!
transform
	class allSubclasses do: 
			[:each | 
			(each directlyDefinesInstanceVariable: variableName) 
				ifTrue: [each removeInstanceVariable: variableName]].
	class addInstanceVariable: variableName! !

!RBPullUpInstanceVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testPullUpInstVar
	| refactoring |
	self proceedThroughWarning: 
		[ refactoring := RBPullUpInstanceVariableRefactoring 
			variable: 'result'
			class: RBLintRuleTest.
		self executeRefactoring: refactoring ].
	self assert: ((refactoring model classNamed: #RBLintRuleTest) directlyDefinesInstanceVariable: 'result').
	self deny: ((refactoring model classNamed: #RBBasicLintRuleTest) directlyDefinesInstanceVariable: 'result')! !

!RBPullUpInstanceVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testPullUpVariableNotDefined
	self shouldFail: (RBPullUpInstanceVariableRefactoring 
			variable: 'notDefinedVariable'
			class: RBLintRuleTest)! !

!RBPullUpMethodRefactoring methodsFor: 'preconditions' stamp: 'lr 7/17/2010 22:44'!
checkBackReferencesTo: aSelector 
	| definingClass pushUpParseTree |
	definingClass := class superclass whoDefinesMethod: aSelector.
	definingClass isNil ifTrue: [^self].
	pushUpParseTree := class parseTreeFor: aSelector.
	class superclass allSubclasses do: 
			[:each | 
			each selectors do: 
					[:sel | 
					| parseTree |
					parseTree := each parseTreeFor: sel.
					(parseTree notNil and: 
							[(parseTree superMessages includes: aSelector) 
								and: [definingClass == (each whoDefinesMethod: aSelector)]]) 
						ifTrue: 
							[removeDuplicates := true.
							(aSelector == sel 
								and: [parseTree equalTo: pushUpParseTree exceptForVariables: #()]) 
									ifFalse: 
										[self 
											refactoringError: ('Cannot pull up <1s> since it would override the method defined in <2p>' 
													expandMacrosWith: aSelector
													with: definingClass)]]]]! !

!RBPullUpMethodRefactoring methodsFor: 'preconditions' stamp: ''!
checkClassVars
	selectors do: [:each | self checkClassVarsFor: each]! !

!RBPullUpMethodRefactoring methodsFor: 'preconditions' stamp: ''!
checkSuperSendsFromSiblings
	| siblings |
	siblings := class superclass subclasses reject: [:each | each = class].
	siblings do: [:aRBClass | self checkSiblingSuperSendsFrom: aRBClass]! !

!RBPullUpMethodRefactoring methodsFor: 'transforming' stamp: ''!
copyDownMethods
	selectors do: [:each | self copyDownMethod: each]! !

!RBPullUpMethodRefactoring methodsFor: 'preconditions' stamp: ''!
checkSuperclass
	| overrideSelectors |
	overrideSelectors := selectors 
				select: [:each | class superclass definesMethod: each].
	overrideSelectors := overrideSelectors reject: 
					[:each | 
					| myTree superTree |
					myTree := class parseTreeFor: each.
					superTree := class superclass parseTreeFor: each.
					superTree equalTo: myTree exceptForVariables: #()].
	overrideSelectors isEmpty ifTrue: [^self].
	class superclass isAbstract 
		ifFalse: 
			[self refactoringError: ('Non-abstract class <2p> already defines <1p>' 
						expandMacrosWith: overrideSelectors asArray first
						with: class superclass)].
	overrideSelectors do: [:each | self checkBackReferencesTo: each]! !

!RBPullUpMethodRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^(selectors inject: (RBCondition hasSuperclass: class)
		into: [:cond :each | cond & (RBCondition definesSelector: each in: class)]) 
			& (RBCondition withBlock: 
						[self checkInstVars.
						self checkClassVars.
						self checkSuperclass.
						self checkSuperMessages.
						true])! !

!RBPullUpMethodRefactoring methodsFor: 'printing' stamp: 'lr 7/17/2010 23:23'!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream nextPutAll: ' pullUp: '.
	selectors asArray storeOn: aStream.
	aStream nextPutAll: ' from: '.
	class storeOn: aStream.
	aStream nextPut: $)! !

!RBPullUpMethodRefactoring methodsFor: 'transforming' stamp: 'lr 7/17/2010 23:24'!
transform
	self
		copyDownMethods;
		pullUpMethods;
		removePulledUpMethods;
		removeDuplicateMethods! !

!RBPullUpMethodRefactoring methodsFor: 'preconditions' stamp: ''!
checkSuperMessages
	self checkSuperSendsFromPushedUpMethods.
	self checkSuperSendsFromSiblings! !

!RBPullUpMethodRefactoring methodsFor: 'transforming' stamp: 'lr 7/17/2010 23:24'!
pullUpMethods
	selectors do: [:each | self pullUp: each]! !

!RBPullUpMethodRefactoring methodsFor: 'transforming' stamp: ''!
removeDuplicatesOf: aSelector 
	| tree |
	tree := class superclass parseTreeFor: aSelector.
	class superclass allSubclasses do: 
			[:each | 
			((each directlyDefinesMethod: aSelector) and: 
					[(tree equalTo: (each parseTreeFor: aSelector) exceptForVariables: #()) 
						and: [(each superclass whoDefinesMethod: aSelector) == class superclass]]) 
				ifTrue: 
					[removeDuplicates 
						ifFalse: 
							[removeDuplicates := true.
							self 
								refactoringWarning: 'Do you want to remove duplicate subclass methods?'].
					each removeMethod: aSelector]]! !

!RBPullUpMethodRefactoring methodsFor: 'preconditions' stamp: 'lr 10/26/2009 22:08'!
checkClassVarsFor: aSelector 
	class theNonMetaClass classVariableNames do: 
		[ :each | 
		((class whichSelectorsReferToClassVariable: each) includes: aSelector) ifTrue: 
			[ self refactoringError: ('<1p> refers to <2s> which is defined in <3p>' 
					expandMacrosWith: aSelector
					with: each
					with: class) ] ]! !

!RBPullUpMethodRefactoring methodsFor: 'preconditions' stamp: 'lr 7/17/2010 22:44'!
checkSuperSendsFromPushedUpMethods
	selectors do: 
			[:each | 
			| parseTree |
			parseTree := class parseTreeFor: each.
			(parseTree superMessages 
				detect: [:sup | class superclass directlyDefinesMethod: sup]
				ifNone: [nil]) notNil 
				ifTrue: 
					[self 
						refactoringError: ('Cannot pull up <1s> since it sends a super message that is defined in the superclass.' 
								expandMacrosWith: each)]]! !

!RBPullUpMethodRefactoring methodsFor: 'transforming' stamp: 'CamilloBruni 10/8/2012 00:04'!
pullUp: aSelector 
	| source refactoring |
	source := class sourceCodeFor: aSelector.
	source isNil 
		ifTrue: [self refactoringFailure: 'Source for method not available'].
	refactoring := RBExpandReferencedPoolsRefactoring 
				model: self model
				forMethod: (class parseTreeFor: aSelector)
				fromClass: class
				toClasses: (Array with: class superclass).
	self performComponentRefactoring: refactoring.
	class superclass compile: source
		classified: (class protocolsFor: aSelector)! !

!RBPullUpMethodRefactoring methodsFor: 'transforming' stamp: 'lr 7/17/2010 23:24'!
removePulledUpMethods
	selectors do: [:each | class removeMethod: each]! !

!RBPullUpMethodRefactoring methodsFor: 'preconditions' stamp: 'lr 7/17/2010 22:44'!
checkSiblingSuperSendsFrom: aRBClass 
	aRBClass selectors do: 
			[:each | 
			| tree |
			tree := aRBClass parseTreeFor: each.
			tree notNil 
				ifTrue: 
					[tree superMessages do: 
							[:aSelector | 
							(selectors includes: aSelector) 
								ifTrue: 
									[| definer |
									definer := aRBClass superclass whoDefinesMethod: aSelector.
									(definer notNil and: [class includesClass: definer]) 
										ifTrue: 
											[self 
												refactoringError: ('Cannot pull up <1s> since <2p>>><3s> sends a super message to it.' 
														expandMacrosWith: aSelector
														with: aRBClass
														with: each)]]]]].
	aRBClass allSubclasses do: [:each | self checkSiblingSuperSendsFrom: each]! !

!RBPullUpMethodRefactoring methodsFor: 'private' stamp: 'CamilloBruni 10/8/2012 00:05'!
copyDownMethod: aSelector 
	| oldProtocol oldSource superclassDefiner subclasses refactoring |
	superclassDefiner := class superclass whoDefinesMethod: aSelector.
	superclassDefiner isNil ifTrue: [^self].
	oldSource := superclassDefiner sourceCodeFor: aSelector.
	oldSource isNil 
		ifTrue: 
			[self 
				refactoringFailure: ('Source code for <1s> superclass method not available' 
						expandMacrosWith: aSelector)].
	oldProtocol := superclassDefiner protocolsFor: aSelector.
	subclasses := class superclass subclasses 
				reject: [:each | each directlyDefinesMethod: aSelector].
	subclasses isEmpty ifTrue: [^self].
	((superclassDefiner parseTreeFor: aSelector) superMessages 
		detect: [:each | superclassDefiner directlyDefinesMethod: each]
		ifNone: [nil]) notNil 
		ifTrue: 
			[self 
				refactoringError: ('Cannot pull up <1s> since we must copy down the superclass method in <2p><n>to the other subclasses, and the superclass method sends a super message which is overriden.' 
						expandMacrosWith: aSelector
						with: superclassDefiner)].
	self 
		refactoringWarning: 'Do you want to copy down the superclass method to the classes that don''t define ' 
				, aSelector.
	refactoring := RBExpandReferencedPoolsRefactoring 
				model: self model
				forMethod: (superclassDefiner parseTreeFor: aSelector)
				fromClass: superclassDefiner
				toClasses: subclasses.
	self performComponentRefactoring: refactoring.
	subclasses do: [:each | each compile: oldSource classified: oldProtocol]! !

!RBPullUpMethodRefactoring methodsFor: 'preconditions' stamp: ''!
checkInstVarsFor: aSelector 
	class instanceVariableNames do: 
			[:each | 
			((class whichSelectorsReferToInstanceVariable: each) includes: aSelector) ifTrue: 
					[self
						refactoringError: ('<1p> refers to <2s> which is defined in <3p>' expandMacrosWith: aSelector
								with: each
								with: class)]]! !

!RBPullUpMethodRefactoring methodsFor: 'preconditions' stamp: ''!
checkInstVars
	selectors do: [:each | self checkInstVarsFor: each]! !

!RBPullUpMethodRefactoring methodsFor: 'initialize-release' stamp: 'lr 7/17/2010 23:23'!
pullUp: selectorCollection from: aClass 
	class := self classObjectFor: aClass.
	selectors := selectorCollection.
	removeDuplicates := false! !

!RBPullUpMethodRefactoring methodsFor: 'transforming' stamp: ''!
removeDuplicateMethods
	selectors do: [:each | self removeDuplicatesOf: each]! !

!RBPullUpMethodRefactoring class methodsFor: 'instance creation' stamp: 'lr 7/17/2010 23:23'!
model: aRBSmalltalk pullUp: selectorCollection from: aClass 
	^(self new)
		model: aRBSmalltalk;
		pullUp: selectorCollection from: aClass;
		yourself! !

!RBPullUpMethodRefactoring class methodsFor: 'instance creation' stamp: 'lr 7/17/2010 23:23'!
pullUp: selectorCollection from: aClass 
	^self new pullUp: selectorCollection from: aClass! !

!RBPullUpMethodTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testPullUpWithSuperSendThatCannotBeCopiedDown
	| class |
	model 
		defineClass: 'Object subclass: #SomeClass instanceVariableNames: '''' classVariableNames: ''Foo'' poolDictionaries: '''' category: #''Refactory-Test data'''.
	(model classNamed: #Object) compile: 'foo ^3' classified: #(#accessing).
	model 
		defineClass: 'SomeClass subclass: #Subclass instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: #''Refactory-Test data'''.
	(model classNamed: #Subclass) compile: 'foo ^super foo'
		classified: #(#accessing).
	model 
		defineClass: 'Subclass subclass: #Foo1 instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: #''Refactory-Test data'''.
	model 
		defineClass: 'Subclass subclass: #Foo2 instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: #''Refactory-Test data'''.
	(class := model classNamed: #Foo2) compile: 'foo ^1'
		classified: #(#accessing).
	self shouldFail: (RBPullUpMethodRefactoring 
				model: model
				pullUp: #(#foo)
				from: class)! !

!RBPullUpMethodTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testPullUpClassMethod
	| class |
	class := model classNamed: #Object.
	class addClassVariable: #Foo.
	class theMetaClass 
		compile: 'foo ^Foo'
		classified: #(#accessing ).
	self shouldFail: (RBPullUpMethodRefactoring 
			model: model
			pullUp: #(#foo )
			from: class theMetaClass)! !

!RBPullUpMethodTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testPullUpWithInvalidSuperSend
	| class |
	model 
		defineClass: 'Object subclass: #SomeClass instanceVariableNames: '''' classVariableNames: ''Foo'' poolDictionaries: '''' category: #''Refactory-Test data'''.
	model 
		defineClass: 'SomeClass subclass: #Subclass instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: #''Refactory-Test data'''.
	model 
		defineClass: 'Subclass subclass: #Foo1 instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: #''Refactory-Test data'''.
	model 
		defineClass: 'Subclass subclass: #Foo2 instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: #''Refactory-Test data'''.
	(model classNamed: #Foo2) compile: 'yourself ^super yourself + 1'
		classified: #(#accessing).
	class := model classNamed: #Foo1.
	class compile: 'yourself ^1' classified: #(#accessing).
	self shouldFail: (RBPullUpMethodRefactoring 
				model: model
				pullUp: #(#yourself)
				from: class)! !

!RBPullUpMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testPullUpMethodWithCopyOverriddenMethodsDown
	| refactoring |
	self proceedThroughWarning: 
		[ refactoring := RBPullUpMethodRefactoring 
			pullUp: #(#isComposite )
			from: RBCompositeLintRuleTest.
		self executeRefactoring: refactoring ].
	self assert: ((refactoring model classNamed: #RBBasicLintRuleTest) parseTreeFor: #isComposite) = (RBParser parseMethod: 'isComposite ^false').
	self assert: ((refactoring model classNamed: ('RBFoo' , 'LintRuleTest') asSymbol) parseTreeFor: #isComposite) = (RBParser parseMethod: 'isComposite ^false').
	self assert: ((refactoring model classNamed: #RBLintRuleTest) parseTreeFor: #isComposite) = (RBParser parseMethod: 'isComposite ^true').
	self deny: ((refactoring model classNamed: #RBCompositeLintRuleTest) directlyDefinesMethod: #isComposite)! !

!RBPullUpMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testPullUpAndCopyDown
	| class |
	model 
		defineClass: 'Object subclass: #SomeClass instanceVariableNames: '''' classVariableNames: ''Foo'' poolDictionaries: '''' category: #''Refactory-Test data'''.
	model 
		defineClass: 'SomeClass subclass: #Subclass instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: #''Refactory-Test data'''.
	model 
		defineClass: 'Subclass subclass: #Foo1 instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: #''Refactory-Test data'''.
	model 
		defineClass: 'Subclass subclass: #Foo2 instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: #''Refactory-Test data'''.
	class := model classNamed: #Foo1.
	class compile: 'yourself ^1' classified: #(#accessing).
	self executeRefactoring: (RBPullUpMethodRefactoring 
				model: model
				pullUp: #(#yourself)
				from: class).
	self assert: (class superclass parseTreeFor: #yourself) 
				= (RBParser parseMethod: 'yourself ^1').
	self deny: (class directlyDefinesMethod: #yourself).
	class := model classNamed: #Foo2.
	self assert: (class directlyDefinesMethod: #yourself).
	self assert: (class parseTreeFor: #yourself) 
				= ((model classNamed: #Object) parseTreeFor: #yourself)! !

!RBPullUpMethodTest methodsFor: 'failure tests' stamp: 'CamilloBruni 1/13/2013 18:21'!
testPullUpWithMethodThatCannotBePushedDown
	model 
		defineClass: 'Object subclass: #SomeClass instanceVariableNames: '''' classVariableNames: ''Foo'' poolDictionaries: '''' category: #''Refactory-Test data'''.
	(model classNamed: #SomeClass) compile: 'yourself ^54'
		classified: #(#accessing).
	self shouldFail: (RBPullUpMethodRefactoring 
				model: model
				pullUp: #(#yourself)
				from: (model classNamed: #SomeClass))! !

!RBPullUpMethodTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testPullUpReferencesInstVar
	self shouldFail: (RBPullUpMethodRefactoring 
			pullUp: #(#checkClass: )
			from: RBBasicLintRuleTest)! !

!RBPushDownClassVariableRefactoring methodsFor: 'preconditions' stamp: 'CamilloBruni 10/7/2012 23:56'!
signalReferenceError: errorString 
	class realClass isNil 
		ifTrue: [ self refactoringError: errorString ]
		ifFalse: [| classVarName error |
			error := '<1s><n>Browse references?' expandMacrosWith: errorString.
			classVarName := variableName asSymbol.
			self 
				refactoringError: error
				with: [ self openBrowserOn: (RBVariableEnvironment 
						referencesToClassVariable: classVarName
						in: class realClass)]]! !

!RBPushDownClassVariableRefactoring methodsFor: 'preconditions' stamp: ''!
signalMultipleReferenceError
	self signalReferenceError: ('Multiple subclasses reference <1s>' 
				expandMacrosWith: variableName)! !

!RBPushDownClassVariableRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	"Preconditions are that only one subclass refers to the class variable."

	^(RBCondition definesClassVariable: variableName in: class) 
		& (RBCondition withBlock: 
					[self findDestinationClass.
					true])! !

!RBPushDownClassVariableRefactoring methodsFor: 'preconditions' stamp: 'TestRunner 11/3/2009 09:28'!
findDestinationClass
	| classes |
	classes := class withAllSubclasses reject: [ :each |
		(each whichSelectorsReferToClassVariable: variableName) isEmpty
			and: [ (each theMetaClass whichSelectorsReferToClassVariable: variableName) isEmpty ] ].
	destinationClass := classes isEmpty 
		ifTrue: [ nil ]
		ifFalse: [ classes asOrderedCollection first ].
	classes do: [ :each | 
		(destinationClass includesClass: each) 
			ifTrue: [ destinationClass := each ]
				ifFalse: [
					(each includesClass: destinationClass) 
						ifFalse: [ self signalMultipleReferenceError ] ] ].
	destinationClass = class 
		ifTrue: [ self signalStillReferencedError ].
	^ destinationClass! !

!RBPushDownClassVariableRefactoring methodsFor: 'preconditions' stamp: ''!
signalStillReferencedError
	self signalReferenceError: ('<1p> has references to <2s>' 
				expandMacrosWith: class
				with: variableName)! !

!RBPushDownClassVariableRefactoring methodsFor: 'transforming' stamp: ''!
transform
	class removeClassVariable: variableName.
	destinationClass isNil ifTrue: [^self].
	destinationClass addClassVariable: variableName! !

!RBPushDownClassVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testModelPushDownVariable
	| class |
	model 
		defineClass: 'Object subclass: #SomeClass instanceVariableNames: '''' classVariableNames: ''Foo'' poolDictionaries: '''' category: #''Refactory-Test data'''.
	model 
		defineClass: 'SomeClass subclass: #Subclass instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: #''Refactory-Test data'''.
	class := model classNamed: #Subclass.
	class compile: 'foo ^Foo' classified: #(#accessing).
	self executeRefactoring: (RBPushDownClassVariableRefactoring 
				model: model
				variable: #Foo
				class: class superclass).
	self deny: (class superclass directlyDefinesClassVariable: #Foo).
	self assert: (class directlyDefinesClassVariable: #Foo)! !

!RBPushDownClassVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testModelNonExistantName
	model 
		defineClass: 'Object subclass: #SomeClass instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: #''Refactory-Test data'''.
	self shouldFail: (RBPushDownClassVariableRefactoring 
				model: model
				variable: #Foo
				class: (model classNamed: #SomeClass))! !

!RBPushDownClassVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testModelPushDownVariableToMultipleClassesInSameHierarchy
	| class |
	model 
		defineClass: 'Object subclass: #SomeClass instanceVariableNames: '''' classVariableNames: ''Foo'' poolDictionaries: '''' category: #''Refactory-Test data'''.
	model 
		defineClass: 'SomeClass subclass: #Subclass instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: #''Refactory-Test data'''.
	class := model classNamed: #Subclass.
	class compile: 'foo ^Foo' classified: #(#accessing).
	model 
		defineClass: 'Subclass subclass: #AnotherSubclass instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: #''Refactory-Test data'''.
	(model metaclassNamed: #AnotherSubclass) compile: 'bar ^Foo'
		classified: #(#accessing).
	self executeRefactoring: (RBPushDownClassVariableRefactoring 
				model: model
				variable: #Foo
				class: class superclass).
	self deny: (class superclass directlyDefinesClassVariable: #Foo).
	self assert: (class directlyDefinesClassVariable: #Foo)! !

!RBPushDownClassVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testModelPushDownToMultipleSubclassesFailure
	model 
		defineClass: 'Object subclass: #SomeClass instanceVariableNames: '''' classVariableNames: ''Foo'' poolDictionaries: '''' category: #''Refactory-Test data'''.
	model 
		defineClass: 'SomeClass subclass: #Subclass instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: #''Refactory-Test data'''.
	(model classNamed: #Subclass) compile: 'foo ^Foo' classified: #(#accessing).
	model 
		defineClass: 'SomeClass subclass: #AnotherSubclass instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: #''Refactory-Test data'''.
	(model metaclassNamed: #AnotherSubclass) compile: 'bar ^Foo'
		classified: #(#accessing).
	self shouldFail: (RBPushDownClassVariableRefactoring 
				model: model
				variable: #Foo
				class: (model classNamed: #SomeClass))! !

!RBPushDownClassVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testModelRemoveUnusedVariable
	model 
		defineClass: 'Object subclass: #SomeClass instanceVariableNames: '''' classVariableNames: ''Foo'' poolDictionaries: '''' category: #''Refactory-Test data'''.
	self 
		assert: ((model classNamed: #SomeClass) directlyDefinesVariable: #Foo).
	model 
		defineClass: 'SomeClass subclass: #Subclass instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: #''Refactory-Test data'''.
	self executeRefactoring: (RBPushDownClassVariableRefactoring 
				model: model
				variable: #Foo
				class: (model classNamed: #SomeClass)).
	self deny: ((model classNamed: #SomeClass) directlyDefinesVariable: #Foo).
	self deny: ((model classNamed: #Subclass) directlyDefinesVariable: #Foo)! !

!RBPushDownClassVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testPushDownClassVariable
	| refactoring |
	refactoring := RBPushDownClassVariableRefactoring 
		variable: #Foo1
		class: RBLintRuleTest.
	self assert: ((refactoring model classNamed: #RBLintRuleTest) directlyDefinesClassVariable: #Foo1).
	self executeRefactoring: refactoring.
	(refactoring model classNamed: #RBLintRuleTest) withAllSubclasses do: [ :each | self deny: (each directlyDefinesClassVariable: #Foo1) ]! !

!RBPushDownClassVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testNonExistantName
	self shouldFail: (RBPushDownClassVariableRefactoring 
			variable: #Foo
			class: RBBasicLintRuleTest)! !

!RBPushDownClassVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testModelPushDownVariableToClassDownTwoLevels
	| class |
	model defineClass: 'Object subclass: #SomeClass instanceVariableNames: '''' classVariableNames: ''Foo'' poolDictionaries: '''' category: #''Refactory-Test data'''.
	model defineClass: 'SomeClass subclass: #Subclass instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: #''Refactory-Test data'''.
	model defineClass: 'Subclass subclass: #AnotherSubclass instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: #''Refactory-Test data'''.
	class := model metaclassNamed: #AnotherSubclass.
	class 
		compile: 'bar ^Foo'
		classified: #(#accessing ).
	class := class theNonMetaClass.
	self executeRefactoring: (RBPushDownClassVariableRefactoring 
			model: model
			variable: #Foo
			class: class superclass superclass).
	self deny: (class superclass superclass directlyDefinesClassVariable: #Foo).
	self deny: (class superclass directlyDefinesClassVariable: #Foo).
	self assert: (class directlyDefinesClassVariable: #Foo)! !

!RBPushDownInstanceVariableRefactoring methodsFor: 'preconditions' stamp: 'lr 9/8/2011 20:25'!
preconditions
	| references |
	references := RBCondition referencesInstanceVariable: variableName
				in: class.
	class realClass isNil 
		ifTrue: 
			[references 
				errorMacro: ('<1s> is referenced.' expandMacrosWith: variableName)]
		ifFalse: 
			[references
				errorMacro: ('<1s> is referenced.<n>Browse references?' 
							expandMacrosWith: variableName);
				errorBlock: 
						[self openBrowserOn: (RBBrowserEnvironment new instVarRefsTo: variableName
									in: class realClass)]].
	^(RBCondition definesInstanceVariable: variableName in: class) 
		& references not! !

!RBPushDownInstanceVariableRefactoring methodsFor: 'transforming' stamp: 'SebastianTleye 8/28/2013 13:47'!
transform
	class removeInstanceVariable: variableName.
	class subclasses do: [:each | each addInstanceVariable: variableName]! !

!RBPushDownInstanceVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testModelPushDownToMetaclass
	model 
		defineClass: 'Object subclass: #SomeClass instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: #''Refactory-Test data'''.
	(model metaclassNamed: #SomeClass) addInstanceVariable: 'foo'.
	model 
		defineClass: 'SomeClass subclass: #Subclass instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: #''Refactory-Test data'''.
	(model metaclassNamed: #Subclass) compile: 'foo ^foo'
		classified: #(#accessing).
	self executeRefactoring: (RBPushDownInstanceVariableRefactoring 
				model: model
				variable: 'foo'
				class: (model metaclassNamed: #SomeClass)).
	self 
		deny: ((model metaclassNamed: #SomeClass) directlyDefinesVariable: 'foo').
	self 
		assert: ((model metaclassNamed: #Subclass) directlyDefinesVariable: 'foo')! !

!RBPushDownInstanceVariableTest methodsFor: 'tests' stamp: 'SebastianTleye 8/28/2013 16:12'!
testPushDownInstanceVariable
	| refactoring |
	refactoring := RBPushDownInstanceVariableRefactoring 
		variable: 'foo1'
		class: RBLintRuleTest.
	self executeRefactoring: refactoring.
	(refactoring model classNamed: #RBLintRuleTest) subclasses do: [ :each | self assert: (each directlyDefinesInstanceVariable: 'foo1') ]! !

!RBPushDownInstanceVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testModelPushDownToMultipleSubclasses
	model 
		defineClass: 'Object subclass: #SomeClass instanceVariableNames: ''foo'' classVariableNames: '''' poolDictionaries: '''' category: #''Refactory-Test data'''.
	model 
		defineClass: 'SomeClass subclass: #Subclass instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: #''Refactory-Test data'''.
	(model classNamed: #Subclass) compile: 'foo ^foo' classified: #(#accessing).
	model 
		defineClass: 'SomeClass subclass: #AnotherSubclass instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: #''Refactory-Test data'''.
	(model classNamed: #AnotherSubclass) compile: 'bar ^foo'
		classified: #(#accessing).
	self executeRefactoring: (RBPushDownInstanceVariableRefactoring 
				model: model
				variable: 'foo'
				class: (model classNamed: #SomeClass)).
	self deny: ((model classNamed: #SomeClass) directlyDefinesVariable: 'foo').
	self 
		assert: ((model classNamed: #Subclass) directlyDefinesVariable: 'foo').
	self assert: ((model classNamed: #AnotherSubclass) 
				directlyDefinesVariable: 'foo')! !

!RBPushDownInstanceVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testNonExistantName
	self shouldFail: (RBPushDownInstanceVariableRefactoring 
			variable: 'foo'
			class: RBBasicLintRuleTest)! !

!RBPushDownInstanceVariableTest methodsFor: 'tests' stamp: 'SebastianTleye 8/28/2013 16:10'!
testModelRemoveUnusedVariable
	model 
		defineClass: 'Object subclass: #SomeClass instanceVariableNames: ''foo'' classVariableNames: '''' poolDictionaries: '''' category: #''Refactory-Test data'''.
	model 
		defineClass: 'SomeClass subclass: #Subclass instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: #''Refactory-Test data'''.
	self executeRefactoring: (RBPushDownInstanceVariableRefactoring 
				model: model
				variable: 'foo'
				class: (model classNamed: #SomeClass)).
	self deny: ((model classNamed: #SomeClass) directlyDefinesVariable: 'foo').
	self assert: ((model classNamed: #Subclass) directlyDefinesVariable: 'foo')! !

!RBPushDownMethodRefactoring methodsFor: 'transforming' stamp: 'lr 9/8/2011 20:11'!
pushDown: aSelector 
	| code protocols refactoring |
	code := class sourceCodeFor: aSelector.
	protocols := class protocolsFor: aSelector.
	refactoring := RBExpandReferencedPoolsRefactoring 
				model: self model
				forMethod: (class parseTreeFor: aSelector)
				fromClass: class
				toClasses: class subclasses.
	self performComponentRefactoring: refactoring.
	class subclasses do: 
			[:each | 
			(each directlyDefinesMethod: aSelector) 
				ifFalse: [each compile: code classified: protocols]]! !

!RBPushDownMethodRefactoring methodsFor: 'preconditions' stamp: 'CamilloBruni 1/12/2013 12:50'!
preconditions
	| condition |
	condition := selectors 
		inject: RBCondition empty
		into: [ :cond :each | 
			cond & (RBCondition definesSelector: each in: class) 
				& (RBCondition subclassesOf: class referToSelector: each) not].
	^condition & (RBCondition isAbstractClass: class)! !

!RBPushDownMethodRefactoring methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream nextPutAll: ' pushDown: '.
	selectors asArray storeOn: aStream.
	aStream nextPutAll: ' from: '.
	class storeOn: aStream.
	aStream nextPut: $)! !

!RBPushDownMethodRefactoring methodsFor: 'initialize-release' stamp: ''!
pushDown: selectorCollection from: aClass 
	class := self classObjectFor: aClass.
	selectors := selectorCollection! !

!RBPushDownMethodRefactoring methodsFor: 'transforming' stamp: ''!
transform
	selectors do: [:each | self pushDown: each].
	selectors do: [:each | class removeMethod: each]! !

!RBPushDownMethodRefactoring class methodsFor: 'instance creation' stamp: ''!
pushDown: selectorCollection from: aClass 
	^self new pushDown: selectorCollection from: aClass! !

!RBPushDownMethodRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBSmalltalk pushDown: selectorCollection from: aClass 
	^(self new)
		model: aRBSmalltalk;
		pushDown: selectorCollection from: aClass;
		yourself! !

!RBPushDownMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testPushDownMethod
	| refactoring class |
	refactoring := RBPushDownMethodRefactoring 
		pushDown: #(#name: )
		from: RBLintRuleTest.
	self executeRefactoring: refactoring.
	class := refactoring model classNamed: #RBLintRuleTest.
	self deny: (class directlyDefinesMethod: #name:).
	class subclasses do: 
		[ :each | 
		self assert: (each parseTreeFor: #name:) = (RBParser parseMethod: 'name: aString name := aString') ]! !

!RBPushDownMethodTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testPushDownNonExistantMenu
	| refactoring |
	refactoring := RBPushDownMethodRefactoring 
		pushDown: #(#someMethodThatDoesNotExist )
		from: RBLintRuleTest.
	self shouldFail: refactoring! !

!RBPushDownMethodTest methodsFor: 'failure tests' stamp: 'CamilloBruni 8/27/2013 15:18'!
testPushDownMethodOnNonAbstractClass
	| refactoring |
	refactoring := RBPushDownMethodRefactoring pushDown: #(#isArray) from: Array.
	self shouldFail: refactoring! !

!RBPushDownMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testPushDownMethodThatReferencesPoolDictionary
	| refactoring class parseTree |
	parseTree := RBLintRuleTest parseTreeFor: #junk.
	self proceedThroughWarning: 
		[ refactoring := RBPushDownMethodRefactoring 
			pushDown: #(#junk )
			from: RBLintRuleTest.
		self executeRefactoring: refactoring ].
	class := refactoring model classNamed: #RBLintRuleTest.
	self deny: (class directlyDefinesMethod: #junk).
	class subclasses do: 
		[ :each | 
		self assert: (each parseTreeFor: #junk) = parseTree.
		self assert: (each directlyDefinesPoolDictionary: 'TextConstants' asSymbol) ]! !

!RBReadBeforeWrittenTester commentStamp: '<historical>'!
RBReadBeforeWrittenTester is a visitor that identifies variables that may have been read before they are initialized.

Instance Variables:
	checkNewTemps	<Boolean>	description of checkNewTemps
	read	<Collection>	description of read
	scopeStack	<OrderedCollection>	description of scopeStack

!
!RBReadBeforeWrittenTester methodsFor: 'initialize-release' stamp: ''!
checkNewTemps: aBoolean 
	checkNewTemps := aBoolean! !

!RBReadBeforeWrittenTester methodsFor: 'initialize-release' stamp: ''!
initializeVars: varNames 
	varNames do: [:each | self currentScope at: each put: nil]! !

!RBReadBeforeWrittenTester methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 16:04'!
visitMessageNode: aMessageNode 
	((#(#whileTrue: #whileFalse: #whileTrue #whileFalse) 
		includes: aMessageNode selector) and: [aMessageNode receiver isBlock]) 
		ifTrue: [self executeTree: aMessageNode receiver body]
		ifFalse: 
			[(aMessageNode isCascaded not or: [aMessageNode isFirstCascaded]) 
				ifTrue: [self visitNode: aMessageNode receiver]].
	((#(#ifTrue:ifFalse: #ifFalse:ifTrue:) includes: aMessageNode selector) 
		and: [aMessageNode arguments allSatisfy: [:each | each isBlock]]) 
			ifTrue: [^self processIfTrueIfFalse: aMessageNode].
	aMessageNode arguments do: [:each | self visitNode: each]! !

!RBReadBeforeWrittenTester methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 16:04'!
visitSequenceNode: aSequenceNode 
	self processStatementNode: aSequenceNode! !

!RBReadBeforeWrittenTester methodsFor: 'private' stamp: ''!
createScope
	scopeStack add: (self copyDictionary: scopeStack last)! !

!RBReadBeforeWrittenTester methodsFor: 'private' stamp: ''!
currentScope
	^scopeStack last! !

!RBReadBeforeWrittenTester methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 16:04'!
visitBlockNode: aBlockNode 
	self processBlock: aBlockNode! !

!RBReadBeforeWrittenTester methodsFor: 'private' stamp: ''!
processBlock: aNode 
	| newScope |
	self createScope.
	self executeTree: aNode body.
	newScope := self removeScope.
	newScope keysAndValuesDo: 
			[:key :value | 
			(value == true and: [(self currentScope at: key) isNil]) 
				ifTrue: [self currentScope at: key put: value]]! !

!RBReadBeforeWrittenTester methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 16:05'!
visitVariableNode: aVariableNode 
	self variableRead: aVariableNode! !

!RBReadBeforeWrittenTester methodsFor: 'initialization' stamp: ''!
initialize
	super initialize.
	scopeStack := OrderedCollection with: Dictionary new.
	read := Set new.
	checkNewTemps := true! !

!RBReadBeforeWrittenTester methodsFor: 'private' stamp: ''!
removeScope
	^scopeStack removeLast! !

!RBReadBeforeWrittenTester methodsFor: 'accessing' stamp: ''!
read
	self currentScope
		keysAndValuesDo: [:key :value | value == true ifTrue: [read add: key]].
	^read! !

!RBReadBeforeWrittenTester methodsFor: 'private' stamp: ''!
variableRead: aNode 
	(self currentScope includesKey: aNode name) 
		ifTrue: 
			[(self currentScope at: aNode name) isNil 
				ifTrue: [self currentScope at: aNode name put: true]]! !

!RBReadBeforeWrittenTester methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 16:04'!
visitAssignmentNode: anAssignmentNode 
	self visitNode: anAssignmentNode value.
	self variableWritten: anAssignmentNode! !

!RBReadBeforeWrittenTester methodsFor: 'private' stamp: ''!
variableWritten: aNode 
	(self currentScope includesKey: aNode variable name) 
		ifTrue: 
			[(self currentScope at: aNode variable name) isNil 
				ifTrue: [self currentScope at: aNode variable name put: false]]! !

!RBReadBeforeWrittenTester methodsFor: 'accessing' stamp: ''!
executeTree: aParseTree 
	^self visitNode: aParseTree! !

!RBReadBeforeWrittenTester methodsFor: 'private' stamp: ''!
processStatementNode: aNode 
	| temps |
	(checkNewTemps not or: [aNode temporaries isEmpty]) 
		ifTrue: 
			[aNode statements do: [:each | self executeTree: each].
			^self].
	self createScope.
	temps := aNode temporaries collect: [:each | each name].
	self initializeVars: temps.
	aNode statements do: [:each | self executeTree: each].
	self removeScope keysAndValuesDo: 
			[:key :value | 
			(temps includes: key) 
				ifTrue: [value == true ifTrue: [read add: key]]
				ifFalse: 
					[(self currentScope at: key) isNil 
						ifTrue: [self currentScope at: key put: value]]]! !

!RBReadBeforeWrittenTester methodsFor: 'private' stamp: 'TestRunner 11/3/2009 09:10'!
copyDictionary: aDictionary 
	"We could send aDictionary the copy message, but that doesn't copy the associations."

	| newDictionary |
	newDictionary := Dictionary new: aDictionary size.
	aDictionary keysAndValuesDo: [ :key :value | newDictionary at: key put: value ].
	^ newDictionary! !

!RBReadBeforeWrittenTester methodsFor: 'private' stamp: ''!
processIfTrueIfFalse: aNode 
	| trueScope falseScope |
	self createScope.
	self executeTree: aNode arguments first body.
	trueScope := self removeScope.
	self createScope.
	self executeTree: aNode arguments last body.
	falseScope := self removeScope.
	self currentScope keysAndValuesDo: 
			[:key :value | 
			value isNil 
				ifTrue: 
					[(trueScope at: key) == (falseScope at: key) 
						ifTrue: [self currentScope at: key put: (trueScope at: key)]
						ifFalse: 
							[((trueScope at: key) == true or: [(falseScope at: key) == true]) 
								ifTrue: [self currentScope at: key put: true]]]]! !

!RBReadBeforeWrittenTester class methodsFor: 'accessing' stamp: ''!
variablesReadBeforeWrittenIn: aParseTree 
	^(self new)
		executeTree: aParseTree;
		read! !

!RBReadBeforeWrittenTester class methodsFor: 'accessing' stamp: ''!
isVariable: aString writtenBeforeReadIn: aBRProgramNode 
	^(self readBeforeWritten: (Array with: aString) in: aBRProgramNode) 
		isEmpty! !

!RBReadBeforeWrittenTester class methodsFor: 'accessing' stamp: ''!
readBeforeWritten: varNames in: aParseTree 
	^(self new)
		checkNewTemps: false;
		initializeVars: varNames;
		executeTree: aParseTree;
		read! !

!RBReadBeforeWrittenTester class methodsFor: 'accessing' stamp: ''!
isVariable: aString readBeforeWrittenIn: aBRProgramNode 
	^(self isVariable: aString writtenBeforeReadIn: aBRProgramNode) not! !

!RBRealizeClassRefactoring commentStamp: 'lr 10/19/2007 09:16'!
Make a given class concrete, by providing empty templates for all the abstract methods.!
!RBRealizeClassRefactoring methodsFor: 'transforming' stamp: ''!
transform: aClass
	| class method parseTree |
	aClass allSelectors do: [ :selector |
		class := aClass whoDefinesMethod: selector.
		(class notNil and: [ class ~= aClass ]) ifTrue: [
			method := class methodFor: selector.
			(method notNil and: [ method refersToSymbol: #subclassResponsibility ]) ifTrue: [
				parseTree := method parseTree.
				parseTree body 
					temporaries: OrderedCollection new; 
					statements: OrderedCollection new;
					addNode: (RBMessageNode 
						receiver: (RBVariableNode named: 'self')
						selector: #shouldBeImplemented).
				aClass compile: parseTree newSource withAttributesFrom: method ] ] ]! !

!RBRealizeClassRefactoring methodsFor: 'accessing' stamp: ''!
theClass
	^ (self classObjectFor: className) theNonMetaClass! !

!RBRealizeClassRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^ RBCondition
		withBlock: [
			(self theClass withAllSubclasses
				detect: [ :each | 
					(each whichSelectorsReferToSymbol: #subclassResponsibility) notEmpty 
						or: [ (each theMetaClass whichSelectorsReferToSymbol: #subclassResponsibility) notEmpty ] ]
				ifNone: [ nil ]) isNil ]
		errorString: self theClass printString , ' is abstract or has abstract subclasses.'! !

!RBRealizeClassRefactoring methodsFor: 'transforming' stamp: ''!
transform
	self transform: self theClass.
	self transform: self theClass theMetaClass! !

!RBRefactoring methodsFor: 'utilities' stamp: ''!
checkInstanceVariableName: aName in: aClass 
	^RBCondition checkInstanceVariableName: aName in: aClass! !

!RBRefactoring methodsFor: 'accessing' stamp: ''!
changes
	^self model changes! !

!RBRefactoring methodsFor: 'support' stamp: ''!
checkClass: aRBClass selector: aSelector using: aMatcher 
	| parseTree |
	parseTree := aRBClass parseTreeFor: aSelector.
	parseTree notNil ifTrue: [aMatcher executeTree: parseTree].
	^aMatcher answer! !

!RBRefactoring methodsFor: 'support' stamp: ''!
convertAllReferencesToClass: aRBClass using: searchReplacer 
	self model allReferencesToClass: aRBClass
		do: 
			[:method | 
			self 
				convertMethod: method selector
				for: method modelClass
				using: searchReplacer]! !

!RBRefactoring methodsFor: 'private' stamp: 'lr 10/5/2010 16:13'!
refactoringError: aString 
	^ RBRefactoringError signal: aString! !

!RBRefactoring methodsFor: 'preconditions' stamp: ''!
checkPreconditions
	| conditions block |
	conditions := self preconditions.
	conditions check 
		ifFalse: 
			[block := conditions errorBlock.
			block notNil 
				ifTrue: [self refactoringError: conditions errorString with: block]
				ifFalse: [self refactoringError: conditions errorString]]! !

!RBRefactoring methodsFor: 'accessing' stamp: ''!
copyOptionsFrom: aDictionary 
	| dict |
	dict := self options.
	dict == self class refactoringOptions 
		ifTrue: [^self options: aDictionary copy].
	dict keysAndValuesDo: 
			[:key :value | 
			value == (self class refactoringOptions at: key) 
				ifTrue: [dict at: key put: (aDictionary at: key)]].
	self options: dict! !

!RBRefactoring methodsFor: 'support' stamp: ''!
convertAllReferencesTo: aSymbol using: searchReplacer 
	self model allReferencesTo: aSymbol
		do: 
			[:method | 
			self 
				convertMethod: method selector
				for: method modelClass
				using: searchReplacer]! !

!RBRefactoring methodsFor: 'transforming' stamp: ''!
transform
	self subclassResponsibility! !

!RBRefactoring methodsFor: 'requests' stamp: ''!
shouldOverride: aSelector in: aClass 
	^(self options at: #alreadyDefined) 
		value: self
		value: aClass
		value: aSelector! !

!RBRefactoring methodsFor: 'support' stamp: ''!
convertMethod: selector for: aClass using: searchReplacer 
	"Convert the parse tree for selector using the searchReplacer. If a
	change is made then compile it into the changeBuilder."

	| parseTree |
	parseTree := aClass parseTreeFor: selector.
	parseTree isNil ifTrue: [^self].
	(searchReplacer executeTree: parseTree) 
		ifTrue: [aClass compileTree: searchReplacer tree]! !

!RBRefactoring methodsFor: 'transforming' stamp: ''!
performComponentRefactoring: aRefactoring 
	aRefactoring copyOptionsFrom: self options.
	aRefactoring primitiveExecute! !

!RBRefactoring methodsFor: 'private' stamp: 'lr 1/4/2010 20:10'!
safeVariableNameFor: aClass temporaries: allTempVars basedOn: aString
	| baseString i newString |
	newString := baseString := aString.
	i := 0.
	[ (allTempVars includes: newString) or: [ aClass definesInstanceVariable: newString ] ] 
		whileTrue: [ 
			i := i + 1.
			newString := baseString , i printString ].
	^ newString! !

!RBRefactoring methodsFor: 'accessing' stamp: ''!
options
	^options isNil ifTrue: [self class refactoringOptions] ifFalse: [options]! !

!RBRefactoring methodsFor: 'private' stamp: 'CamilloBruni 10/7/2012 23:54'!
refactoringFailure: aString 
	^ RBRefactoringFailure signal: aString! !

!RBRefactoring methodsFor: 'accessing' stamp: ''!
options: aDictionary 
	options := aDictionary! !

!RBRefactoring methodsFor: 'support' stamp: ''!
convertClasses: classSet select: aBlock using: searchReplacer 
	classSet do: 
			[:aClass | 
			(aBlock value: aClass) do: 
					[:selector | 
					self 
						convertMethod: selector
						for: aClass
						using: searchReplacer]]! !

!RBRefactoring methodsFor: 'requests' stamp: ''!
shouldUseExistingMethod: aSelector 
	^(self options at: #useExistingMethod) value: self value: aSelector! !

!RBRefactoring methodsFor: 'utilities' stamp: ''!
checkMethodName: aName in: aClass 
	^RBCondition checkMethodName: aName in: aClass! !

!RBRefactoring methodsFor: 'private' stamp: 'lr 10/5/2010 16:13'!
refactoringError: aString with: aBlock 
	^ RBRefactoringError signal: aString with: aBlock! !

!RBRefactoring methodsFor: 'private' stamp: ''!
primitiveExecute
	self checkPreconditions.
	self transform! !

!RBRefactoring methodsFor: 'requests' stamp: ''!
requestSelfArgumentName
	^(self options at: #selfArgumentName) value: self! !

!RBRefactoring methodsFor: 'private' stamp: ''!
uniqueMethodNameFor: anInteger 
	| before after index name |
	before := 'a'.
	after := ''.
	anInteger timesRepeat: [after := after , 'z:'].
	index := 0.
	
	[name := before , index printString , after.
	(Symbol findInterned: name) notNil] 
			whileTrue: [index := index + 1].
	^name asSymbol! !

!RBRefactoring methodsFor: 'testing' stamp: ''!
canReferenceVariable: aString in: aClass 
	(aClass definesVariable: aString) ifTrue: [^true].
	(self model includesGlobal: aString asSymbol) ifTrue: [^true].
	^(self poolVariableNamesFor: aClass) includes: aString! !

!RBRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	self subclassResponsibility! !

!RBRefactoring methodsFor: 'utilities' stamp: 'lr 7/23/2010 08:04'!
poolVariableNamesFor: aClass 
	| pools |
	pools := Set new.
	aClass withAllSuperclasses do: 
			[:each | 
			each allPoolDictionaryNames do: 
					[:pool | 
					pools addAll: ((Smalltalk globals at: pool asSymbol) keys 
								collect: [:name | name asString])]].
	^pools! !

!RBRefactoring methodsFor: 'private' stamp: ''!
onError: aBlock do: errorBlock 
	^aBlock on: self class preconditionSignal
		do: 
			[:ex | 
			errorBlock value.
			ex return: nil]! !

!RBRefactoring methodsFor: 'requests' stamp: 'dvf 9/8/2001 19:32'!
requestMethodNameFor: aMethodName 
	^(self options at: #methodName) value: self value: aMethodName! !

!RBRefactoring methodsFor: 'requests' stamp: ''!
shouldExtractAssignmentTo: aString 
	^(self options at: #extractAssignment) value: self value: aString! !

!RBRefactoring methodsFor: 'utilities' stamp: 'lr 11/2/2009 00:14'!
whichVariableNode: aParseTree inInterval: anInterval name: aName 
	| matcher block |
	matcher := RBParseTreeSearcher new.
	block := 
			[:aNode :answer | 
			(aNode intersectsInterval: anInterval) ifTrue: [aNode] ifFalse: [answer]].
	matcher
		matches: aName do: block;
		matchesArgument: aName do: block.
	^matcher executeTree: aParseTree initialAnswer: nil! !

!RBRefactoring methodsFor: 'requests' stamp: ''!
openBrowserOn: anEnvironment 
	^(self options at: #openBrowser) value: self value: anEnvironment! !

!RBRefactoring methodsFor: 'transforming' stamp: 'lr 9/8/2011 20:25'!
defaultEnvironment
	^RBBrowserEnvironment new! !

!RBRefactoring methodsFor: 'transforming' stamp: ''!
model
	^model isNil 
		ifTrue: 
			[model := (RBNamespace onEnvironment: self defaultEnvironment)
						name: self printString;
						yourself]
		ifFalse: [model]! !

!RBRefactoring methodsFor: 'private' stamp: 'CamilloBruni 10/7/2012 23:55'!
refactoringFailure: aString with: aBlock
	^ RBRefactoringFailure signal: aString with: aBlock! !

!RBRefactoring methodsFor: 'utilities' stamp: ''!
associationForClassVariable: aName in: aClass ifAbsent: aBlock 
	^aClass realClass classPool associationAt: aName asSymbol
		ifAbsent: [aClass realClass classPool associationAt: aName asString ifAbsent: aBlock]! !

!RBRefactoring methodsFor: 'utilities' stamp: ''!
safeMethodNameFor: aClass basedOn: aString 
	"Creates an unused method name containing aString"

	| baseString newString hasParam i |
	baseString := aString copy.
	baseString at: 1 put: baseString first asLowercase.
	newString := baseString.
	hasParam := newString last = $:.
	hasParam 
		ifTrue: [baseString := newString copyFrom: 1 to: newString size - 1].
	i := 0.
	[aClass hierarchyDefinesMethod: newString asSymbol] whileTrue: 
			[i := i + 1.
			newString := baseString , i printString 
						, (hasParam ifTrue: [':'] ifFalse: [''])].
	^newString asSymbol! !

!RBRefactoring methodsFor: 'requests' stamp: 'lr 2/14/2009 11:23'!
selectVariableTypesFrom: initialTypeCollection selected: selectedTypeCollection 
	^ (self options at: #variableTypes) 
		value: self
		value: initialTypeCollection
		value: selectedTypeCollection
! !

!RBRefactoring methodsFor: 'transforming' stamp: 'lr 9/8/2011 20:14'!
execute
	self primitiveExecute.
	RBRefactoringManager instance addRefactoring: self! !

!RBRefactoring methodsFor: 'requests' stamp: ''!
selectVariableToMoveMethodTo: aSelector class: aClass 
	^(self options at: #selectVariableToMoveTo) 
		value: self
		value: aClass
		value: aSelector! !

!RBRefactoring methodsFor: 'requests' stamp: ''!
requestImplementorToInline: implementorsCollection 
	^(self options at: #implementorToInline) value: self
		value: implementorsCollection! !

!RBRefactoring methodsFor: 'private' stamp: 'lr 10/5/2010 16:13'!
refactoringWarning: aString 
	^ RBRefactoringWarning signal: aString! !

!RBRefactoring methodsFor: 'accessing' stamp: ''!
setOption: aSymbol toUse: aBlock 
	| dict |
	dict := self options.
	dict == self class refactoringOptions ifTrue: [dict := dict copy].
	dict at: aSymbol put: aBlock.
	self options: dict! !

!RBRefactoring methodsFor: 'private' stamp: 'dc 5/8/2007 12:05'!
classObjectFor: anObject 
	(anObject isBehavior or: [anObject isTrait]) ifTrue: [^self model classFor: anObject].
	anObject isSymbol ifTrue: [^self model classNamed: anObject].
	^anObject! !

!RBRefactoring methodsFor: 'initialize-release' stamp: ''!
model: aRBNamespace 
	model := aRBNamespace! !

!RBRefactoring methodsFor: 'requests' stamp: ''!
shouldInlineExpression: aString 
	^(self options at: #inlineExpression) value: self value: aString! !

!RBRefactoring methodsFor: '*NautilusRefactoring' stamp: ''!
whatToDisplayIn: aBrowser 
	
	^ self changes changes gather: [:e | e whatToDisplayIn: aBrowser ]! !

!RBRefactoring class methodsFor: 'initialization' stamp: 'lr 2/14/2009 11:20'!
initializeRefactoringOptions
	RefactoringOptions := IdentityDictionary new.
	RefactoringOptions
		at: #implementorToInline
		put: [ :ref :imps | self error: #implementorToInline ];
		
		at: #methodName
		put: [ :ref :methodName | self error: #methodName ];
		
		at: #selfArgumentName
		put: [ :ref | self error: #selfArgumentName ];
		
		at: #selectVariableToMoveTo
		put: [ :ref :class :selector | self error: #selectVariableToMoveTo ];	
			
		at: #variableTypes
		put: [ :ref :types :selected | self error: #variableTypes ];
		
		at: #extractAssignment
		put: [ :ref :varName | self error: #extractAssignment ];
		
		at: #inlineExpression
		put: [ :ref :string | self error: #inlineExpression ];
		
		at: #alreadyDefined
		put: [ :ref :cls :selector |  self error: #alreadyDefined ];
		
		at: #useExistingMethod
		put: [ :ref :selector |  self error: #useExistingMethod ];
		
		at: #openBrowser
		put: [ :ref :env |  self error: #openBrowser ]! !

!RBRefactoring class methodsFor: 'initialization' stamp: 'lr 1/18/2010 21:02'!
initialize
	self initializeRefactoringOptions! !

!RBRefactoring class methodsFor: 'accessing' stamp: 'lr 1/18/2010 21:03'!
refactoringOptions
	^ RefactoringOptions! !

!RBRefactoring class methodsFor: 'accessing signal' stamp: 'lr 10/5/2010 16:13'!
preconditionSignal
	^ RBRefactoringError , RBRefactoringWarning! !

!RBRefactoring class methodsFor: 'accessing' stamp: ''!
setDefaultOption: aSymbol to: aBlock 
	self refactoringOptions at: aSymbol put: aBlock! !

!RBRefactoring class methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 10/11/2013 11:05'!
cleanUp
	"RefactoringOptions holds on to blocks, we should make sure to recreate them so the block references the current method"
	self initializeRefactoringOptions.! !

!RBRefactoringBrowserTest methodsFor: 'private' stamp: 'CamilloBruni 1/12/2013 12:49'!
proceedThroughWarning: aBlock 
	aBlock on: RBRefactoringWarning do: [ :ex | ex resume ]! !

!RBRefactoringBrowserTest methodsFor: 'private' stamp: ''!
convertInterval: anInterval for: aString 
	"Convert the interval to ignore differences in end of line conventions."

	^anInterval! !

!RBRefactoringBrowserTest methodsFor: 'private' stamp: ''!
objectClassVariable
	^Object classPool keys detect: [:each | true]! !

!RBRefactoringBrowserTest methodsFor: 'private' stamp: ''!
executeRefactoring: aRefactoring 
	aRefactoring primitiveExecute.
	RBParser parseExpression: aRefactoring storeString! !

!RBRefactoringBrowserTest class methodsFor: 'testing' stamp: 'lr 10/27/2009 14:01'!
isAbstract
	^ self name = #RBRefactoringBrowserTest! !

!RBRefactoringChangeTests methodsFor: 'tests-perform' stamp: 'lr 10/15/2010 09:32'!
testPerformChangeComment
	| change comment |
	change := changes comment: 'Some Comment' in: self changeMock.
	comment := change changeClass organization classComment.
	self perform: change do: [ self assert: (change changeClass comment = 'Some Comment') ].
	self assert: change changeClass organization classComment = comment! !

!RBRefactoringChangeTests methodsFor: 'tests' stamp: 'lr 10/15/2010 09:12'!
testRenameClass
	| change |
	change := changes renameClass: self class to: self class name , 'Plus'.
	self assert: change oldName = self class name.
	self assert: change newName = (self class name , 'Plus').
	self assert: change changeClass = self class.
	self universalTestFor: change! !

!RBRefactoringChangeTests methodsFor: 'tests' stamp: 'lr 10/15/2010 09:10'!
testRemoveInstanceVariable
	| change |
	change := changes removeInstanceVariable: 'instVar' from: self class.
	self assert: change changeClassName = self class name.
	self assert: change changeClass = self class.
	self assert: change isMeta not.
	self assert: change variable = 'instVar'.
	self universalTestFor: change! !

!RBRefactoringChangeTests methodsFor: 'mocking' stamp: 'MarcusDenker 6/17/2013 15:05'!
createMockClass
	self class compiler evaluate: 'Object subclass: #RBRefactoringChangeMock
	instanceVariableNames: ''instVar''
	classVariableNames: ''ClassVar''
	poolDictionaries: ''''
	category: ''Refactoring-Tests-Changes'''.
	
	self class compiler evaluate:  'RBRefactoringChangeMock class
	instanceVariableNames: ''classInstVar'''.
	
	self changeMock compile: 'one ^ 1' classified: 'accessing'.! !

!RBRefactoringChangeTests methodsFor: 'tests-perform' stamp: 'lr 10/15/2010 09:20'!
testPerformAddRemoveClassVariable
	| change |
	change := changes addClassVariable: 'Foo' to: self changeMock.
	self perform: change do: [ self assert: (change changeClass classVarNames includes: 'Foo') ].
	self deny: (change changeClass classVarNames includes: 'Foo')! !

!RBRefactoringChangeTests methodsFor: 'tests-perform' stamp: 'lr 10/15/2010 09:24'!
testPerformAddRemoveClass
	| change |
	change := changes defineClass: 'Object subclass: #' , self changeMock name , 'Temporary
	instanceVariableNames: ''''
	classVariableNames: ''''
	poolDictionaries: ''''
	category: ''' , self class category , ''''.
	self perform: change do: [
		self assert: (Smalltalk hasClassNamed: change changeClassName).
		self assert: change definedClass name =  change changeClassName.
		self assert: change definedClass isBehavior ].
	self deny: (Smalltalk hasClassNamed: change changeClassName).
	self assert: change definedClass isObsolete! !

!RBRefactoringChangeTests methodsFor: 'accessing' stamp: 'CamilloBruni 8/27/2013 02:41'!
exampleClasses
	^ { "Standard Classes" 
		ProtoObject. Object. Class. Metaclass. Behavior. ClassDescription. Dictionary. Trait.
		"Lots of class vars"
		SmalltalkImage
		""
	}! !

!RBRefactoringChangeTests methodsFor: 'tests' stamp: 'lr 10/15/2010 08:29'!
testAddClassVariable
	| change |
	change := changes addClassVariable: 'ClassVar' to: self class.
	self assert: change changeClassName = self class name.
	self assert: change changeClass = self class.
	self assert: change isMeta not.
	self assert: change variable = 'ClassVar'.
	self universalTestFor: change! !

!RBRefactoringChangeTests methodsFor: 'tests-perform' stamp: 'lr 10/15/2010 09:34'!
testPerformCompositeChange
	changes 
		compile: 'method1 ^ 1' in: self changeMock;
		compile: 'method2 ^ 2' in: self changeMock.
	self perform: changes do: [ 
		self assert: (self changeMock canUnderstand: #method1).
		self assert: (self changeMock canUnderstand: #method2) ].
	self deny: (self changeMock canUnderstand: #method1).
	self deny: (self changeMock canUnderstand: #method2) ! !

!RBRefactoringChangeTests methodsFor: 'tests' stamp: 'lr 10/15/2010 09:09'!
testRemoveClass
	| change |
	change := changes removeClass: self class.
	self assert: change changeClassName = self class name.
	self assert: change changeClass = self class.
	self assert: change isMeta not.
	self universalTestFor: change! !

!RBRefactoringChangeTests methodsFor: 'utilities' stamp: 'lr 9/8/2011 20:10'!
universalTestFor: aChange
	self equalityTestFor: aChange.
	self stringTestFor: aChange.
	(aChange isKindOf: RBRefactoryClassChange)
		ifTrue: [ self undoTestFor: aChange ]! !

!RBRefactoringChangeTests methodsFor: 'tests' stamp: 'lr 10/15/2010 09:11'!
testRemoveMethod
	| change |
	change := changes removeMethod: #setUp from: self class.
	self assert: change changeClassName = self class name.
	self assert: change changeClass = self class.
	self assert: change isMeta not.
	self assert: change selector = #setUp.
	self universalTestFor: change! !

!RBRefactoringChangeTests methodsFor: 'tests' stamp: 'lr 9/5/2010 20:02'!
testRenameInstanceVariable
	| change |
	change := changes renameInstanceVariable: 'instVar1' to: 'instVar2' in: self class.
	self assert: change changeClassName = self class name.
	self assert: change oldName = 'instVar1'.
	self assert: change newName = 'instVar2'.
	self universalTestFor: change! !

!RBRefactoringChangeTests methodsFor: 'tests' stamp: 'lr 10/15/2010 08:33'!
testCompileInMetaclass
	| change |
	change := changes compile: 'new' in: self class class.
	self assert: change controller isNil.
	self assert: change changeClassName = self class name.
	self assert: change changeClass = self class class.
	self assert: change isMeta.
	self assert: change selector = #new.
	self assert: change source = 'new'.
	self assert: change protocol = #accessing.
	self universalTestFor: change! !

!RBRefactoringChangeTests methodsFor: 'tests' stamp: 'lr 10/15/2010 08:30'!
testAddPool
	| change |
	change := changes addPool: 'PoolDict' to: self class.
	self assert: change changeClassName = self class name.
	self assert: change changeClass = self class.
	self assert: change isMeta not.
	self assert: change variable = 'PoolDict'.
	self universalTestFor: change! !

!RBRefactoringChangeTests methodsFor: 'tests-perform' stamp: 'lr 10/15/2010 09:28'!
testPerformAddRemoveClassMethod
	| change source |
	change := changes compile: 'method ^ 1' in: self changeMock class classified: #utilities.
	self perform: change do: [ self assert: (self changeMock respondsTo: #method) ].
	self deny: (self changeMock respondsTo: #method).
	self assert: change definedSelector = #method! !

!RBRefactoringChangeTests methodsFor: 'tests' stamp: 'lr 10/15/2010 08:28'!
testAddInstanceVariable
	| change |
	change := changes addInstanceVariable: 'instVar' to: self class.
	self assert: change changeClassName = self class name.
	self assert: change changeClass = self class.
	self assert: change isMeta not.
	self assert: change variable = 'instVar'.
	self universalTestFor: change! !

!RBRefactoringChangeTests methodsFor: 'utilities' stamp: 'lr 10/15/2010 09:13'!
equalityTestFor: aChange
	self assert: aChange = aChange.
	self assert: aChange hash = aChange hash.

	self assert: aChange copy = aChange.
	self assert: aChange copy hash = aChange hash! !

!RBRefactoringChangeTests methodsFor: 'tests-pattern' stamp: 'CamilloBruni 8/27/2013 02:42'!
testAddTraitPattern
	"Make sure that all trait definitions can be parsed."
	
	self exampleTraits do: [ :trait |
		| change |
		change := changes defineClass: trait definition.
		self assert: (change isKindOf: RBAddTraitChange).
		self assert: (change changeClassName = trait name).
		self assert: (change category = trait category).
		self universalTestFor: change ]! !

!RBRefactoringChangeTests methodsFor: 'tests-perform' stamp: 'lr 9/8/2011 20:10'!
testPerformAddRemoveClassInteractively
	| change |
	change := RBAddClassChange definition: 'Object subclass: #' , self changeMock name , 'Temporary
	instanceVariableNames: ''''
	classVariableNames: ''''
	poolDictionaries: ''''
	category: ''' , self class category , '''' for: self.
	self perform: change do: [ 
		self assert: (Smalltalk hasClassNamed: change changeClassName).
		self assert: change definedClass name =  change changeClassName.
		self assert: change definedClass isBehavior ].
	self deny: (Smalltalk hasClassNamed: change changeClassName).
	self assert: change definedClass isObsolete
	! !

!RBRefactoringChangeTests methodsFor: 'tests-perform' stamp: 'lr 10/15/2010 09:31'!
testPerformChangeMetaclass
	| change |
	change := changes defineClass: self changeMock name , ' class 
	instanceVariableNames: '''''.
	self perform: change do: [ self assert: change changeClass class instVarNames isEmpty ].
	self assert: change changeClass class instVarNames notEmpty.
	self assert: change definedClass = self changeMock class! !

!RBRefactoringChangeTests methodsFor: 'tests-pattern' stamp: 'CamilloBruni 8/27/2013 02:41'!
testAddClassTraitPattern
	"Make sure that all class trait definitions can be parsed."
	
	self exampleTraits do: [ :trait |
		| change |
		change := changes defineClass: trait classTrait definition.
		self assert: (change isKindOf: RBAddClassTraitChange).
		self assert: (change changeClassName = trait name).
		self universalTestFor: change ]! !

!RBRefactoringChangeTests methodsFor: 'mocking' stamp: 'MarcusDenker 6/17/2013 14:53'!
changeMock
	^ Smalltalk at: #RBRefactoringChangeMock! !

!RBRefactoringChangeTests methodsFor: 'tests' stamp: 'lr 9/5/2010 20:02'!
testRenameClassVariable
	| change |
	change := changes renameClassVariable: 'ClassVar1' to: 'ClassVar2' in: self class.
	self assert: change changeClassName = self class name.
	self assert: change oldName = 'ClassVar1'.
	self assert: change newName = 'ClassVar2'.
	self universalTestFor: change! !

!RBRefactoringChangeTests methodsFor: 'utilities' stamp: 'CamilloBruni 9/11/2012 16:40'!
perform: aChange do: aBlock
	"Perform a change in the system silently, evaluate aBlock and then undo the change again."

	| undo |
	^ SystemAnnouncer uniqueInstance suspendAllWhile: [
		undo := aChange execute.
		aBlock ensure: [ undo execute ] ]! !

!RBRefactoringChangeTests methodsFor: 'tests-pattern' stamp: 'CamilloBruni 8/27/2013 02:41'!
testAddMetaclassPattern
	"Make sure that metaclass definitions can be parsed."
	
	self exampleClasses do: [ :class |
		(class isObsolete or: [ class superclass notNil and: [ class superclass isObsolete ] ]) ifFalse: [  
 		| change |
		change := changes defineClass: class class definition.
		self assert: (change isKindOf: RBAddMetaclassChange).
		self assert: change changeClassName equals: class name.
		self assert: change classInstanceVariableNames equals: class class instVarNames.
		self universalTestFor: change ]]! !

!RBRefactoringChangeTests methodsFor: 'tests-perform' stamp: 'lr 10/15/2010 09:36'!
testPerformRenameClassInstanceVariable
	| change |
	change := changes renameInstanceVariable: 'classInstVar' to: 'classInstVarPlus' in: self changeMock class.
	self perform: change do: [ 
		self deny: (change changeClass instVarNames includes: change oldName).
		self assert: (change changeClass instVarNames includes: change newName) ].
	self assert: (change changeClass instVarNames includes: change oldName).
	self deny: (change changeClass instVarNames includes: change newName)! !

!RBRefactoringChangeTests methodsFor: 'tests' stamp: 'lr 9/6/2010 11:31'!
testComposite
	changes 
		compile: 'method ^ 1' in: self class classified: #utilities;
		compile: 'method ^ 2' in: self class class classified: #utilities.
	self assert: (changes changesSize = 2).
	self assert: (changes problemCount = 2).
	self assert: (changes changeForClass: self class name selector: #method) notNil.
	self assert: (changes changeForMetaclass: self class name selector: #method) notNil.
	self universalTestFor: changes! !

!RBRefactoringChangeTests methodsFor: 'tests' stamp: 'lr 10/15/2010 09:10'!
testRemoveClassVariable
	| change |
	change := changes removeClassVariable: 'ClassVar' from: self class.
	self assert: change changeClassName = self class name.
	self assert: change changeClass = self class.
	self assert: change isMeta not.
	self assert: change variable = 'ClassVar'.
	self universalTestFor: change! !

!RBRefactoringChangeTests methodsFor: 'tests-perform' stamp: 'lr 10/15/2010 09:30'!
testPerformChangeClass
	| change |
	change := changes defineClass: self class name , ' subclass: #' , self changeMock name , '
	instanceVariableNames: ''''
	classVariableNames: ''''
	poolDictionaries: ''''
	category: ''' , self class category , ''''.
	self perform: change do: [ 
		self assert: change changeClass superclass = self class.
		self assert: change changeClass instVarNames isEmpty ].
	self assert: change changeClass superclass = Object.
	self assert: change changeClass instVarNames notEmpty.
	self assert: change definedClass = self changeMock! !

!RBRefactoringChangeTests methodsFor: 'tests' stamp: 'lr 10/15/2010 09:11'!
testRemoveClassInstanceVariable
	| change |
	change := changes removeInstanceVariable: 'instVar' from: self class class.
	self assert: change changeClassName = self class name.
	self assert: change changeClass = self class class.
	self assert: change isMeta.
	self assert: change variable = 'instVar'.
	self universalTestFor: change! !

!RBRefactoringChangeTests methodsFor: 'tests' stamp: 'lr 9/8/2011 20:10'!
testCompileInInteractively
	| change |
	change := RBAddMethodChange compile: 'setUp' in: self class classified: #running for: self.
	self assert: change controller = self.
	self assert: change changeClassName = self class name.
	self assert: change changeClass = self class.
	self assert: change isMeta not.
	self assert: change selector = #setUp.
	self assert: change source = 'setUp'.
	self assert: change protocol = #running.
	self universalTestFor: change! !

!RBRefactoringChangeTests methodsFor: 'mocking' stamp: 'MarcusDenker 6/17/2013 15:24'!
text
	"for #testPerformAddRemoveMethodInteractively"
	^'method ^1'! !

!RBRefactoringChangeTests methodsFor: 'tests-perform' stamp: 'lr 10/15/2010 09:34'!
testPerformRenameClass
	| change |
	change := changes renameClass: self changeMock to: self changeMock name , 'Plus'.
	self perform: change do: [ 
		self deny: (Smalltalk hasClassNamed: change oldName).
		self assert: (Smalltalk hasClassNamed: change newName) ].
	self assert: (Smalltalk hasClassNamed: change oldName).
	self deny: (Smalltalk hasClassNamed: change newName)! !

!RBRefactoringChangeTests methodsFor: 'tests' stamp: 'lr 10/15/2010 08:28'!
testAddClassInstanceVariable
	| change |
	change := changes addInstanceVariable: 'instVar' to: self class class.
	self assert: change changeClassName = self class name.
	self assert: change changeClass = self class class.
	self assert: change isMeta.
	self assert: change variable = 'instVar'.
	self universalTestFor: change! !

!RBRefactoringChangeTests methodsFor: 'tests' stamp: 'lr 10/15/2010 09:11'!
testRemovePool
	| change |
	change := changes removePool: 'PoolDict' from: self class.
	self assert: change changeClassName = self class name.
	self assert: change changeClass = self class.
	self assert: change isMeta not.
	self assert: change variable = 'PoolDict'.
	self universalTestFor: change! !

!RBRefactoringChangeTests methodsFor: 'tests-perform' stamp: 'lr 10/15/2010 09:28'!
testPerformAddRemoveInstanceVariable
	| change |
	change := changes addInstanceVariable: 'foo' to: self changeMock.
	self perform: change do: [ self assert: (change changeClass instVarNames includes: 'foo') ].
	self deny: (change changeClass instVarNames includes: 'foo')! !

!RBRefactoringChangeTests methodsFor: 'tests' stamp: 'MartinDias 11/7/2013 18:11'!
testAddClassInteractively
	| change |
	change := RBAddClassChange definition: 'TestCase subclass: #' , self class name , '
	instanceVariableNames: ''instVar''
	classVariableNames: ''ClassVar''
	poolDictionaries: ''PoolDict''
	category: ''' , self class category , '''' for: self.
	self assert: change controller = self.
	self assert: change superclassName = self class superclass name.
	self assert: change changeClassName = self class name.
	self assert: change changeClass = self class.
	self assert: change isMeta not.
	self assert: change instanceVariableNames size = 1.
	self assert: change instanceVariableNames first = 'instVar'.
	self assert: change classVariableNames size = 1.
	self assert: change classVariableNames first = 'ClassVar'.
	self assert: change sharedPoolNames size = 1.
	self assert: change sharedPoolNames first = 'PoolDict'.
	self assert: change category = self class category.
	self universalTestFor: change! !

!RBRefactoringChangeTests methodsFor: 'tests-pattern' stamp: 'MartinDias 11/7/2013 18:11'!
testAddClassPattern
	"Make sure that all class definitions can be parsed."

	self exampleClasses do: [ :class |
		(class isObsolete or: [ class superclass notNil and: [ class superclass isObsolete ] ]) ifFalse: [
			| change |
			change := changes defineClass: class definition.
			self assert: (change isKindOf: RBAddClassChange).
			self assert: (change changeClassName = class name).
			self assert: (class superclass isNil
				ifTrue: [ change definitionClass = ProtoObject ]
				ifFalse: [ change definitionClass = class superclass ]).
			self assert: (change instanceVariableNames = class instVarNames asArray).
			self assert: (change classVariableNames = class classVarNames asArray).
			self assert: (change sharedPoolNames = class sharedPoolNames asArray).
			self assert: (change category = class category).
			self universalTestFor: change ] ]! !

!RBRefactoringChangeTests methodsFor: 'tests-perform' stamp: 'lr 10/15/2010 09:18'!
testPerformAddRemoveClassInstanceVariable
	| change |
	change := changes addInstanceVariable: 'foo' to: self changeMock class.
	self perform: change do: [ self assert: (change changeClass instVarNames includes: 'foo') ].
	self deny: (change changeClass instVarNames includes: 'foo')! !

!RBRefactoringChangeTests methodsFor: 'utilities' stamp: 'lr 9/8/2011 20:10'!
undoTestFor: aChange
	| undo |
	undo := aChange asUndoOperation.
	self assert: (undo isKindOf: RBRefactoryChange)! !

!RBRefactoringChangeTests methodsFor: 'tests-perform' stamp: 'lr 10/15/2010 09:28'!
testPerformAddRemoveMethod
	| change source |
	change := changes compile: 'method ^ 1' in: self changeMock classified: #utilities.
	self perform: change do: [ self assert: (self changeMock canUnderstand: #method) ].
	self deny: (self changeMock canUnderstand: #method).
	self assert: change definedSelector = #method! !

!RBRefactoringChangeTests methodsFor: 'tests' stamp: 'lr 10/15/2010 08:33'!
testCompileInClass
	| change |
	change := changes compile: 'setUp' in: self class.
	self assert: change controller isNil.
	self assert: change changeClassName = self class name.
	self assert: change changeClass = self class.
	self assert: change isMeta not.
	self assert: change selector = #setUp.
	self assert: change source = 'setUp'.
	self assert: change protocol = #running.
	self universalTestFor: change! !

!RBRefactoringChangeTests methodsFor: 'tests' stamp: 'lr 10/15/2010 09:10'!
testRemoveClassNamed
	| change |
	change := changes removeClassNamed: self class name.
	self assert: change changeClassName = self class name.
	self assert: change changeClass = self class.
	self assert: change isMeta not.
	self universalTestFor: change! !

!RBRefactoringChangeTests methodsFor: 'running' stamp: 'MarcusDenker 6/17/2013 15:02'!
tearDown
	super tearDown.
	self removeMockClass.
	! !

!RBRefactoringChangeTests methodsFor: 'mocking' stamp: 'lr 9/6/2010 13:38'!
selectionInterval
	^ 1 to: 0! !

!RBRefactoringChangeTests methodsFor: 'running' stamp: 'MarcusDenker 6/17/2013 14:53'!
setUp
	super setUp.
	self createMockClass.
	changes := RBCompositeRefactoryChange named: 'testing'! !

!RBRefactoringChangeTests methodsFor: 'tests-perform' stamp: 'lr 10/15/2010 09:35'!
testPerformRenameInstanceVariable
	| change |
	change := changes renameInstanceVariable: 'instVar' to: 'instVarPlus' in: self changeMock.
	self perform: change do: [ 
		self deny: (change changeClass instVarNames includes: change oldName).
		self assert: (change changeClass instVarNames includes: change newName) ].
	self assert: (change changeClass instVarNames includes: change oldName).
	self deny: (change changeClass instVarNames includes: change newName)! !

!RBRefactoringChangeTests methodsFor: 'tests-perform' stamp: 'lr 9/8/2011 20:10'!
testPerformAddRemoveMethodInteractively
	| change source |
	change := RBAddMethodChange compile: 'method ^ 1' in: self changeMock classified: #utilities for: self. 
	self perform: change do: [ self assert: (self changeMock canUnderstand: #method) ].
	self deny: (self changeMock canUnderstand: #method).
	self assert: change definedSelector = #method! !

!RBRefactoringChangeTests methodsFor: 'tests' stamp: 'lr 10/15/2010 08:32'!
testComment
	| change |
	change := changes comment: 'Some Comment' in: self class.
	self assert: change changeClassName = self class name.
	self assert: change changeClass = self class.
	self assert: change isMeta not.
	self assert: change comment = 'Some Comment'.
	self universalTestFor: change! !

!RBRefactoringChangeTests methodsFor: 'tests' stamp: 'lr 10/15/2010 09:12'!
testRenameClassInstanceVariable
	| change |
	change := changes renameInstanceVariable: 'instVar1' to: 'instVar2' in: self class class.
	self assert: change changeClassName = self class name.
	self assert: change oldName = 'instVar1'.
	self assert: change newName = 'instVar2'.
	self universalTestFor: change! !

!RBRefactoringChangeTests methodsFor: 'tests-perform' stamp: 'lr 10/15/2010 09:33'!
testPerformChangeMethod
	| change source |
	change := changes compile: 'one ^ 2' in: self changeMock.
	source := change changeClass sourceCodeAt: #one.
	self perform: change do: [ self assert: (change changeClass sourceCodeAt: #one) = 'one ^ 2' ].
	self assert: (change changeClass sourceCodeAt: #one) = source! !

!RBRefactoringChangeTests methodsFor: 'utilities' stamp: 'lr 9/5/2010 20:07'!
stringTestFor: aChange
	self assert: (aChange name isString and: [ aChange name notEmpty ]).
	self assert: (aChange printString isString and: [ aChange printString notEmpty ]).
	self assert: (aChange changeString isString and: [ aChange changeString notEmpty ]).
	self assert: (aChange displayString isString and: [ aChange displayString notEmpty ])! !

!RBRefactoringChangeTests methodsFor: 'accessing' stamp: 'CamilloBruni 8/27/2013 02:43'!
exampleTraits
	^ { TBehavior. TClass. TAssertable }! !

!RBRefactoringChangeTests methodsFor: 'mocking' stamp: 'MarcusDenker 6/17/2013 14:56'!
removeMockClass
	Smalltalk removeClassNamed: #RBRefactoringChangeMock.! !

!RBRefactoringChangeTests methodsFor: 'tests-perform' stamp: 'lr 10/15/2010 09:35'!
testPerformRenameClassVariable
	| change |
	change := changes renameClassVariable: 'ClassVar' to: 'ClassVarPlus' in: self changeMock.
	self perform: change do: [ 
		self deny: (change changeClass classVarNames includes: change oldName).
		self assert: (change changeClass classVarNames includes: change newName) ].
	self assert: (change changeClass classVarNames includes: change oldName).
	self deny: (change changeClass classVarNames includes: change newName)! !

!RBRefactoringChangeTests methodsFor: 'tests' stamp: 'lr 10/15/2010 08:33'!
testCompileInClassified
	| change |
	change := changes compile: 'setUp' in: self class classified: #accessing.
	self assert: change controller isNil.
	self assert: change changeClassName = self class name.
	self assert: change changeClass = self class.
	self assert: change isMeta not.
	self assert: change selector = #setUp.
	self assert: change source = 'setUp'.
	self assert: change protocol = #accessing.
	self universalTestFor: change! !

!RBRefactoringChangeTests class methodsFor: 'accessing' stamp: 'lr 9/5/2010 19:39'!
packageNamesUnderTest
	^ #('Refactoring-Changes')! !

!RBRefactoringError commentStamp: 'lr 10/5/2010 16:17'!
The receiver is signaled whenever a precondition of a refactoring is violated. The action block, if defined, might help the user to resolve the issue.!
!RBRefactoringError methodsFor: 'accessing' stamp: 'lr 10/5/2010 16:07'!
actionBlock
	^ actionBlock
	! !

!RBRefactoringError methodsFor: 'accessing' stamp: 'lr 10/5/2010 16:07'!
actionBlock: aBlock 
	actionBlock := aBlock! !

!RBRefactoringError methodsFor: 'testing' stamp: 'CamilloBruni 10/7/2012 23:11'!
isResumable
	^ true! !

!RBRefactoringError class methodsFor: 'signalling' stamp: 'lr 10/5/2010 16:07'!
signal: aString with: aBlock 
	^ self new
		actionBlock: aBlock;
		signal: aString! !

!RBRefactoringFailure commentStamp: '<historical>'!
This error is signalled whenever there is a non recoverable error during refactorings.!
!RBRefactoringFailure methodsFor: 'testing' stamp: 'CamilloBruni 10/7/2012 23:53'!
isResumable
	^ false! !

!RBRefactoringManager methodsFor: 'public access' stamp: 'lr 9/8/2011 20:10'!
addRefactoring: aRefactoring 
	RBRefactoryChangeManager instance performChange: aRefactoring changes.
	refactorings add: aRefactoring class name! !

!RBRefactoringManager methodsFor: 'initialization' stamp: ''!
initialize
	refactorings := Bag new! !

!RBRefactoringManager methodsFor: 'printing' stamp: ''!
printOn: aStream 
	aStream nextPutAll: '#		Refactoring';
		cr;
		nextPutAll: '---		-----------------------------------------------';
		cr.
	refactorings asSet asSortedCollection do: 
			[:name | 
			aStream nextPutAll: (refactorings occurrencesOf: name) printString;
				nextPutAll: '		';
				nextPutAll: name;
				cr]! !

!RBRefactoringManager class methodsFor: 'public' stamp: 'lr 4/4/2010 08:32'!
unload
	self nuke! !

!RBRefactoringManager class methodsFor: 'instance creation' stamp: 'lr 4/4/2010 08:31'!
instance
	^ Instance ifNil: [ Instance := self basicNew initialize ]! !

!RBRefactoringManager class methodsFor: 'instance creation' stamp: 'lr 4/4/2010 08:31'!
new
	^ self shouldNotImplement! !

!RBRefactoringManager class methodsFor: 'public' stamp: 'lr 4/4/2010 08:32'!
nuke
	Instance notNil ifTrue: [ Instance release ].
	Instance := nil! !

!RBRefactoringTest methodsFor: 'set up' stamp: ''!
setupMethodNameFor: aRefactoring toReturn: aSelector withArguments: stringCollection 
	| options |
	options := aRefactoring options copy.
	options at: #methodName
		put: 
			[:ref :aMethodName | 
			aMethodName
				selector: aSelector;
				arguments: stringCollection;
				yourself].
	aRefactoring options: options! !

!RBRefactoringTest methodsFor: 'set up' stamp: 'lr 9/8/2011 20:14'!
tearDown
	super tearDown.
	RBRefactoringManager instance release.
	(RBRefactoringManager classPool associationAt: #Instance
		ifAbsent: [RBRefactoringManager classPool associationAt: 'Instance']) 
			value: manager! !

!RBRefactoringTest methodsFor: 'set up' stamp: ''!
setupVariableToMoveToFor: aRefactoring toReturn: aString 
	| options |
	options := aRefactoring options copy.
	options at: #selectVariableToMoveTo put: [:ref :class :selector | aString].
	aRefactoring options: options! !

!RBRefactoringTest methodsFor: 'set up' stamp: ''!
setupImplementorToInlineFor: aRefactoring toReturn: anObject 
	| options |
	options := aRefactoring options copy.
	options at: #implementorToInline put: [:ref :imps | anObject].
	aRefactoring options: options! !

!RBRefactoringTest methodsFor: 'set up' stamp: ''!
setupVariableTypesFor: aRefactoring toReturn: anObject 
	| options |
	options := aRefactoring options copy.
	options at: #variableTypes put: [:ref :ignore1 :ignore2 | anObject].
	aRefactoring options: options! !

!RBRefactoringTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:14'!
testPrintRefactoringManager
	self assert: RBRefactoringManager instance printString isString! !

!RBRefactoringTest methodsFor: 'private' stamp: 'StephaneDucasse 8/27/2013 21:56'!
abstractVariableTestData
	| newModel classEnvironment classes |
	classes := #(#Bar #Foo) 
		inject: OrderedCollection new 
		into: [ :sum :each | 
			Smalltalk globals at: each ifPresent: [ :class | 
				sum add: class; add: class class ].
			sum ].
	classEnvironment := RBClassEnvironment classes: classes.
	newModel := RBNamespace onEnvironment: classEnvironment not.
	newModel name: 'Test'.
	
	#('Object subclass: #Foo
		instanceVariableNames: ''instVarName1 instVarName2''
		classVariableNames: ''ClassVarName1 ClassVarName2 ''
		poolDictionaries: ''''
		category: ''Testing'' '
	'Foo subclass: #Bar
		instanceVariableNames: ''''
		classVariableNames: ''''
		poolDictionaries: ''''
		category: ''Testing'' '
	) do: [ :each | 
		newModel defineClass: each ].
	
	#(#(#Bar #(
		#('instVarName1
			^1242321' #tests) 
		#('foo
			instVarName1 := instVarName1 + instVarName2 + ClassVarName1' #tests))) 
	#(#Foo #(
		#('foo
			^instVarName2 := 3' #tests)
		#('bar
			"Add one to instVarName1"
			instVarName1 := instVarName1 + 1' #tests) 
		#('classVarName1
			^ClassVarName1' #tests)
		#('instVarName1: anObject
			^anObject' #tests)
		#('asdf
			^self classVarName1: (ClassVarName1 := ClassVarName1 + 1)' #tests) 
		#('instVarName2
			^instVarName2' #tests)
		#('instVarName2: anObject
			instVarName2 := anObject' #tests)
		#('classVarName1: anObject
			^ClassVarName1 := anObject' #tests)))
	
	#('Bar class' #(
		#('classVarName2: anObject
			ClassVarName2 := anObject' #tests) 
		#('classVarName2
			^ClassVarName2' #tests))) 
	#('Foo class' #(
		#('foo
			^ClassVarName1 := ClassVarName1 * ClassVarName1 * ClassVarName1' #tests)))) 
		do: [:each | 
			| class |
			class := newModel classNamed: each first.
			each last do: [ :methodPair | 
				class 
					compile: methodPair first
					classified: methodPair last]].
	^ newModel! !

!RBRefactoringTest methodsFor: 'private' stamp: 'lr 9/8/2011 20:58'!
childrenToSiblingTestData
^'
| m |
(m:= RBNamespace 
			onEnvironment: ((RBClassEnvironment onEnvironment: RBBrowserEnvironment new) 
					classes: (#(#ConcreteSubclass #ConcreteSuperclass #NoMoveSubclass) 
							inject: OrderedCollection new
							into: 
								[:sum :each | 
								| class |
								class := Smalltalk at: each ifAbsent: [nil].
								class notNil ifTrue: [sum add: class].
								sum]) 
								, (#(#ConcreteSubclass #ConcreteSuperclass #NoMoveSubclass) 
										inject: OrderedCollection new
										into: 
											[:sum :each | 
											| class |
											class := Smalltalk at: each ifAbsent: [nil].
											class notNil ifTrue: [sum add: class class].
											sum])) 
						not) 
		name: ''Test''.
#(''ConcreteSuperclass subclass: #NoMoveSubclass
	instanceVariableNames: ''''''''
	classVariableNames: ''''''''
	poolDictionaries: ''''''''
	category: ''''Testing'''''' ''Object subclass: #ConcreteSuperclass
	instanceVariableNames: ''''instVarName1 instVarName2 ''''
	classVariableNames: ''''ClassVarName1 ClassVarName2 ''''
	poolDictionaries: ''''''''
	category: ''''Testing'''''' ''ConcreteSuperclass subclass: #ConcreteSubclass
	instanceVariableNames: ''''''''
	classVariableNames: ''''''''
	poolDictionaries: ''''''''
	category: ''''Testing'''''') 
	do: [:each | m defineClass: each].
(m metaclassNamed: #ConcreteSuperclass) 
	addInstanceVariable: ''classInstVarName1''.
#(#(#ConcreteSubclass #(#(''initialize
	super initialize.
	instVarName1 := nil'' #everyone) #(''different
	^0'' #everyone))) #(#ConcreteSuperclass #(#(''same
	^self initialize isKindOf: ConcreteSuperclass'' #''one def'') #(''different
	^instVarName1 + instVarName2'' #everyone) #(''initialize
	instVarName1 := instVarName2 := ClassVarName1 := ClassVarName2 := 0'' #everyone))) #(#NoMoveSubclass #(#(''same
	^123'' #''one def''))) #(''ConcreteSubclass class'' #(#(''bar
	^self storeString'' #testing))) #(''ConcreteSuperclass class'' #(#(''foo
	^classInstVarName1 + ClassVarName1 + ClassVarName2'' #testing) #(''new
	^super new initialize'' #testing) #(''bar
	^self printString'' #testing))) #(''NoMoveSubclass class'' #())) 
	do: 
		[:each | 
		| class |
		class := m classNamed: each first.
		each last do: [:meth | class compile: meth first classified: meth last]].
m
'! !

!RBRefactoringTest methodsFor: 'private' stamp: 'lr 9/8/2011 21:02'!
inlineMethodTestData
^ '
| m |
(m := RBNamespace 
			onEnvironment: ((RBClassEnvironment onEnvironment: RBBrowserEnvironment new) 
					classes: (#(#RBRenameClassVariableChange #RBVariableCompositeRefactoryChange #RBRenameInstanceVariableChange #RBCompositeRefactoryChange #RBRenameVariableChange #RBRefactoryChange) 
							inject: OrderedCollection new
							into: 
								[:sum :each | 
								| class |
								class := Smalltalk at: each ifAbsent: [nil].
								class notNil ifTrue: [sum add: class].
								sum]) 
								, (#() inject: OrderedCollection new
										into: 
											[:sum :each | 
											| class |
											class := Smalltalk at: each ifAbsent: [nil].
											class notNil ifTrue: [sum add: class class].
											sum])) 
						not) 
		name: ''Test''.
#(''Object subclass: #RBRefactoryChange
	instanceVariableNames: ''''name ''''
	classVariableNames: ''''''''
	poolDictionaries: ''''''''
	category: ''''Refactory-Support'''''' ''RBRefactoryChange subclass: #RBCompositeRefactoryChange
	instanceVariableNames: ''''changes ''''
	classVariableNames: ''''''''
	poolDictionaries: ''''''''
	category: ''''Refactory-Support'''''' ''RBCompositeRefactoryChange subclass: #RBVariableCompositeRefactoryChange
	instanceVariableNames: ''''className isMeta ''''
	classVariableNames: ''''''''
	poolDictionaries: ''''''''
	category: ''''Refactory-Support'''''' ''RBVariableCompositeRefactoryChange subclass: #RBRenameVariableChange
	instanceVariableNames: ''''oldName newName ''''
	classVariableNames: ''''''''
	poolDictionaries: ''''''''
	category: ''''Refactory-Support'''''' ''RBRenameVariableChange subclass: #RBRenameClassVariableChange
	instanceVariableNames: ''''''''
	classVariableNames: ''''''''
	poolDictionaries: ''''''''
	category: ''''Refactory-Support'''''' ''RBRenameVariableChange subclass: #RBRenameInstanceVariableChange
	instanceVariableNames: ''''''''
	classVariableNames: ''''''''
	poolDictionaries: ''''''''
	category: ''''Refactory-Support'''''') 
	do: [:each | m defineClass: each].
#(#(#RBRenameClassVariableChange #(#(''removeOldVariable
	(RBRemoveClassVariableChange remove: oldName from: self changeClass) execute'' #private) #(''addNewVariable
	(RBAddClassVariableChange add: newName to: self changeClass) execute'' #private) #(''executeNotifying: aBlock 
	| undo |
	self addNewVariable.
	self copyOldValuesToNewVariable.
	undo := super executeNotifying: aBlock.
	self removeOldVariable.
	^undo'' #private) #(''copyOldValuesToNewVariable
	| oldValue |
	oldValue := self changeClass classPool at: oldName ifAbsent: [].
	self changeClass at: newName asSymbol put: oldValue'' #private))) #(#RBVariableCompositeRefactoryChange #(#(''displayClassName
	^isMeta 
		ifTrue: [self changeClassName , '''' class'''']
		ifFalse: [self changeClassName asString]'' #printing) #(''isMeta
	^isMeta'' #private) #(''changeClass: aBehavior 
	isMeta := aBehavior isMeta.
	className := isMeta 
				ifTrue: [aBehavior soleInstance name]
				ifFalse: [aBehavior name]'' #accessing) #(''hash
	^self changeClassName hash'' #comparing) #(''changeClassName: aSymbol 
	className := aSymbol.
	isMeta isNil ifTrue: [isMeta := false]'' #accessing) #(''changeClass
	| class |
	class := Smalltalk at: self changeClassName ifAbsent: [^nil].
	^isMeta ifTrue: [class class] ifFalse: [class]'' #accessing) #(''printOn: aStream
	aStream nextPutAll: self displayString'' #printing) #(''changeClassName
	^className'' #accessing) #(''= aRefactoryClassChange 
	self class = aRefactoryClassChange class ifFalse: [^false].
	^className = aRefactoryClassChange changeClassName 
		and: [isMeta = aRefactoryClassChange isMeta]'' #comparing))) #(#RBRenameInstanceVariableChange #(#(''removeOldVariable
	(RBRemoveInstanceVariableChange remove: oldName from: self changeClass) 
		execute'' #private) #(''addNewVariable
	(RBAddInstanceVariableChange add: newName to: self changeClass) execute'' #private) #(''executeNotifying: aBlock 
	| undo |
	self addNewVariable.
	self copyOldValuesToNewVariable.
	undo := super executeNotifying: aBlock.
	self removeOldVariable.
	^undo'' #private) #(''copyOldValuesToNewVariable
	| newIndex oldIndex |
	oldIndex := self changeClass allInstVarNames indexOf: oldName asString.
	newIndex := self changeClass allInstVarNames indexOf: newName asString.
	self changeClass withAllSubclasses do: 
			[:each | 
			each allInstances 
				do: [:inst | each instVarAt: newIndex put: (each instVarAt: oldIndex)]]'' #private))) #(#RBCompositeRefactoryChange #(#(''compile: source in: class 
	^self addChange: (RBAddMethodChange compile: source in: class)'' #''refactory-changes'') #(''addClassVariable: variableName to: aClass 
	^self addChange: (RBAddClassVariableChange add: variableName to: aClass)'' #''refactory-changes'') #(''addChangeFirst: aRefactoryChange 
	changes addFirst: aRefactoryChange.
	^aRefactoryChange'' #accessing) #(''removeChange: aChange 
	changes remove: aChange ifAbsent: []'' #''private-inspector accessing'') #(''addPool: aPoolVariable to: aClass 
	^self addChange: (RBAddPoolVariableChange add: aPoolVariable to: aClass)'' #''refactory-changes'') #(''initialize
	super initialize.
	changes := OrderedCollection new'' #''initialize-release'') #(''defineClass: aString 
	^self addChange: (RBAddClassChange definition: aString)'' #''refactory-changes'') #(''changeForClass: aRBClass selector: aSelector 
	changes reverseDo: 
			[:each | 
			| change |
			change := each changeForClass: aRBClass selector: aSelector.
			change notNil ifTrue: [^change]].
	^nil'' #accessing) #(''removeInstanceVariable: variableName from: aClass 
	^self 
		addChange: (RBRemoveInstanceVariableChange remove: variableName from: aClass)'' #''refactory-changes'') #(''printOn: aStream 
	aStream nextPutAll: name'' #printing) #(''inspect
	RefactoryBuilderInspector openOn: self'' #''user interface'') #(''flattenOnto: aCollection 
	changes do: [:each | each flattenOnto: aCollection]'' #private) #(''hash
	^changes size'' #comparing) #(''= aRefactoryBuilder 
	self class = aRefactoryBuilder class ifFalse: [^false].
	changes size = aRefactoryBuilder changes size ifFalse: [^false].
	changes with: aRefactoryBuilder changes
		do: [:each :change | each = change ifFalse: [^false]].
	^true'' #comparing) #(''renameClass: class to: newName 
	^self addChange: (RenameClassChange rename: class name to: newName)'' #''refactory-changes'') #(''renameChangesForClass: aClassName to: newClassName 
	^(self copy)
		changes: (self changes 
					collect: [:each | each renameChangesForClass: aClassName to: newClassName]);
		yourself'' #accessing) #(''postCopy
	super postCopy.
	changes := changes collect: [:each | each copy]'' #copying) #(''changes: aCollection 
	changes := aCollection'' #''private-inspector accessing'') #(''addInstanceVariable: variableName to: aClass 
	^self addChange: (RBAddInstanceVariableChange add: variableName to: aClass)'' #''refactory-changes'') #(''compile: source in: class classified: aProtocol 
	^self addChange: (RBAddMethodChange 
				compile: source
				in: class
				classified: aProtocol)'' #''refactory-changes'') #(''changeForMetaclass: aSymbol selector: aSelector 
	changes reverseDo: 
			[:each | 
			| change |
			change := each changeForMetaclass: aSymbol selector: aSelector.
			change notNil ifTrue: [^change]].
	^nil'' #accessing) #(''removeClassVariable: variableName from: aClass 
	^self 
		addChange: (RBRemoveClassVariableChange remove: variableName from: aClass)'' #''refactory-changes'') #(''executeNotifying: aBlock 
	| undos undo |
	undos := changes collect: [:each | each executeNotifying: aBlock].
	undo := self copy.
	undo changes: undos reverse.
	^undo'' #private) #(''changes
	^changes'' #''private-inspector accessing'') #(''removeMethod: aSelector from: aClass 
	^self addChange: (RBRemoveMethodChange remove: aSelector from: aClass)'' #''refactory-changes'') #(''removeClass: aClass 
	^self addChange: (RBRemoveClassChange removeClassName: aClass)'' #''refactory-changes'') #(''addChange: aRefactoryChange 
	changes add: aRefactoryChange.
	^aRefactoryChange'' #accessing) #(''changesSize
	^changes inject: 0 into: [:sum :each | sum + each changesSize]'' #accessing) #(''displayString
	^super displayString asText allBold'' #printing) #(''problemCount
	^self changesSize'' #accessing))) #(#RBRenameVariableChange #(#(''oldName: aString
	oldName := aString'' #private) #(''executeNotifying: aBlock 
	| undo |
	undo := super executeNotifying: aBlock.
	undo
		oldName: newName;
		newName: oldName.
	^undo'' #private) #(''newName: aString 
	newName := aString'' #private) #(''changeString
	^''''Rename '''' , oldName , '''' to '''' , newName'' #printing))) #(#RBRefactoryChange #(#(''flattenedChanges
	| changes |
	changes := OrderedCollection new.
	self flattenOnto: changes.
	^changes'' #private) #(''name: aString
	name := aString'' #''initialize-release'') #(''initialize'' #''initialize-release'') #(''changeForMetaclass: aSymbol selector: aSelector 
	^nil'' #accessing) #(''changeString
	^self class name'' #printing) #(''changeForClass: aRBClass selector: aSelector 
	^nil'' #accessing) #(''executeWithMessage: aString 
	| tally controller m done |
	m := 0 asValue.
	done := 0.
	tally := self changesSize.
	controller := aString isNil 
				ifTrue: [nil]
				ifFalse: [ProgressWidgetView progressOpenOn: m label: aString].
	m value: 0.
	^
	[self executeNotifying: 
			[done := done + 1.
			m value: done asFloat / tally]] 
			ensure: [controller notNil ifTrue: [controller closeAndUnschedule]]'' #''performing-changes'') #(''executeNotifying: aBlock 
	self subclassResponsibility'' #private) #(''changes
	^Array with: self'' #accessing) #(''execute
	^self executeNotifying: []'' #''performing-changes'') #(''inspect
	^((RBCompositeRefactoryChange new)
		changes: (Array with: self);
		yourself) inspect'' #''user interface'') #(''flattenOnto: aCollection 
	aCollection add: self'' #private) #(''name
	^name isNil ifTrue: [self changeString] ifFalse: [name]'' #accessing) #(''changesSize
	^1'' #accessing) #(''displayString
	^name isNil ifTrue: [self changeString] ifFalse: [name]'' #printing) #(''renameChangesForClass: aClassName to: newClassName 
	"We are in the middle of performing a rename operation. If we stored 
	the class name, we need to change the class name to the new 
	name to perform the compiles."

	self subclassResponsibility'' #accessing)))) 
	do: 
		[:each | 
		| class |
		class := m classNamed: each first.
		each last do: [:meth | class compile: meth first classified: meth last]].
m
'! !

!RBRefactoringTest methodsFor: 'set up' stamp: 'lr 9/8/2011 20:14'!
setUp
	| assoc |
	super setUp.
	assoc := RBRefactoringManager classPool associationAt: #Instance
				ifAbsent: [RBRefactoringManager classPool associationAt: 'Instance'].
	manager := assoc value.
	assoc value: nil.
	model := RBNamespace new! !

!RBRefactoringTest methodsFor: 'private' stamp: 'lr 10/5/2010 16:13'!
shouldWarn: aRefactoring 
	self 
		should: [ self executeRefactoring: aRefactoring ]
		raise: RBRefactoringWarning! !

!RBRefactoringTest methodsFor: 'set up' stamp: ''!
setupInlineExpressionFor: aRefactoring toReturn: aBoolean 
	| options |
	options := aRefactoring options copy.
	options at: #inlineExpression put: [:ref :string | aBoolean].
	aRefactoring options: options! !

!RBRefactoringTest methodsFor: 'set up' stamp: ''!
setupSelfArgumentNameFor: aRefactoring toReturn: aString 
	| options |
	options := aRefactoring options copy.
	options at: #selfArgumentName put: [:ref | aString].
	aRefactoring options: options! !

!RBRefactoringTest methodsFor: 'set up' stamp: ''!
setupMethodNameFor: aRefactoring toReturn: aSelector 
	| options |
	options := aRefactoring options copy.
	options at: #methodName
		put: 
			[:ref :aMethodName | 
			aMethodName
				selector: aSelector;
				yourself].
	aRefactoring options: options! !

!RBRefactoringTest methodsFor: 'tests' stamp: 'bh 4/2/2000 22:28'!
testConditions
	| condition newCondition |
	condition := RBCondition new 
				type: #false
				block: [false]
				errorString: 'false'.
	condition errorMacro: '<1?true:false>'.
	self deny: condition check.
	self assert: condition errorString = 'false'.
	self assert: condition not check.
	self assert: condition printString = 'false'.
	self assert: condition not printString = 'NOT false'.
	self deny: (condition not & condition) check.
	self 
		assert: (condition not & condition) printString = 'NOT false & false'.
	self assert: (condition & condition) not check.
	self assert: (condition | condition not) check.
	self deny: (newCondition := condition | condition) check.
	self assert: newCondition errorString = 'false AND false'.
	self assert: (condition not | condition not) check.
	self deny: (newCondition := condition & condition) check.
	self assert: newCondition errorString = 'false'.
	self assert: (condition not & condition not) check.
	self assert: (condition & condition) errorString = 'false OR false'! !

!RBRefactoringTest methodsFor: 'private' stamp: 'lr 10/5/2010 16:13'!
shouldFail: aRefactoring 
	self proceedThroughWarning: [
		self 
			should: [ self executeRefactoring: aRefactoring ]
			raise: RBRefactoringError ]! !

!RBRefactoringWarning commentStamp: 'lr 10/5/2010 16:17'!
The receiver is a warning that usually requires the user to validate. This is used in situations where either the behavior of the program will not be strictly preserved or the change may have a wider impact than the user may think.
!
!RBRefactoryChange commentStamp: '<historical>'!
I am the superclass of all refactoring change objects. 
All I have is a name for the refactoring, but I can perform one or more refactoring operations with the message #execute. 
I am a composite object. To know about my components, ask me with #changes and #changesSize. !
!RBRefactoryChange methodsFor: 'accessing' stamp: ''!
changes
	^Array with: self! !

!RBRefactoryChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 11:29'!
changeForMetaclass: aClassName selector: aSelector 
	^ nil! !

!RBRefactoryChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 11:29'!
changeForClass: aClassName selector: aSelector 
	^ nil! !

!RBRefactoryChange methodsFor: 'private' stamp: ''!
executeNotifying: aBlock 
	self subclassResponsibility! !

!RBRefactoryChange methodsFor: 'printing' stamp: ''!
displayString
	^name isNil ifTrue: [self changeString] ifFalse: [name]! !

!RBRefactoryChange methodsFor: 'accessing' stamp: ''!
changesSize
	^1! !

!RBRefactoryChange methodsFor: 'printing' stamp: ''!
changeString
	^self class name! !

!RBRefactoryChange methodsFor: '*NautilusRefactoring' stamp: ''!
accept: aText notifying: aController
	^ false! !

!RBRefactoryChange methodsFor: '*NautilusRefactoring' stamp: ''!
nameToDisplay

	^ self name! !

!RBRefactoryChange methodsFor: 'initialize-release' stamp: ''!
name: aString
	name := aString! !

!RBRefactoryChange methodsFor: 'accessing' stamp: 'StephaneDucasse 9/13/2013 21:43'!
changeStamp
	^ Author changeStamp! !

!RBRefactoryChange methodsFor: '*NautilusRefactoring' stamp: ''!
oldVersionTextToDisplay

	^ ''! !

!RBRefactoryChange methodsFor: 'performing-changes' stamp: ''!
execute
	^self executeNotifying: []! !

!RBRefactoryChange methodsFor: '*NautilusRefactoring' stamp: ''!
whatToDisplayIn: aChangeBrowser

	^ { self }! !

!RBRefactoryChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 13:56'!
renameChangesForClass: oldClassName to: newClassName
	"We're in the middle of performing a rename operation. If we stored the class name, we need to change the class name to the new name to perform the compiles."

	self subclassResponsibility! !

!RBRefactoryChange methodsFor: 'accessing' stamp: ''!
name
	^name isNil ifTrue: [self changeString] ifFalse: [name]! !

!RBRefactoryChange methodsFor: '*NautilusRefactoring' stamp: ''!
textToDisplay

	^ self name! !

!RBRefactoryChangeManager methodsFor: 'private' stamp: ''!
clearUndoRedoList
	undo := OrderedCollection new.
	redo := OrderedCollection new! !

!RBRefactoryChangeManager methodsFor: 'initialize-release' stamp: 'BernardoContreras 10/28/2014 16:26'!
connectToChanges
	SystemAnnouncer uniqueInstance weak
		when: CategoryAdded,
			CategoryRemoved,
			CategoryRenamed,
			ClassAdded,
			ClassModifiedClassDefinition,
			ClassRemoved,
			ClassRenamed,
			ClassReorganized,
			MethodAdded,
			MethodModified,
			MethodRemoved,
			ProtocolAdded,
			ProtocolRemoved
		send: #update:
		to: self.! !

!RBRefactoryChangeManager methodsFor: 'public access' stamp: 'lr 9/7/2010 19:11'!
performChange: aRefactoringChange
	self ignoreChangesWhile: [ self addUndo: aRefactoringChange execute ]! !

!RBRefactoryChangeManager methodsFor: 'updating' stamp: 'GuillermoPolito 7/2/2012 11:54'!
update: anEvent
	isPerformingRefactoring
		ifFalse: [ self clearUndoRedoList ]! !

!RBRefactoryChangeManager methodsFor: 'public access' stamp: 'lr 9/7/2010 19:12'!
redoOperation
	redo isEmpty
		ifTrue: [ ^ self ].
	self ignoreChangesWhile: [ 
		| change |
		change := redo removeLast.
		undo add: change execute ]! !

!RBRefactoryChangeManager methodsFor: 'public access' stamp: 'lr 9/7/2010 19:12'!
undoOperation
	undo isEmpty
		ifTrue: [ ^ self ].
	self ignoreChangesWhile: [ 
		| change |
		change := undo removeLast.
		redo add: change execute ]! !

!RBRefactoryChangeManager methodsFor: 'public access' stamp: 'lr 9/7/2010 19:11'!
redoChange
	^ redo last! !

!RBRefactoryChangeManager methodsFor: 'public access' stamp: 'lr 9/7/2010 19:11'!
ignoreChangesWhile: aBlock
	isPerformingRefactoring
		ifTrue: [ ^ aBlock value ].
	isPerformingRefactoring := true.
	aBlock ensure: [ isPerformingRefactoring := false ]! !

!RBRefactoryChangeManager methodsFor: 'public access' stamp: 'lr 9/7/2010 19:11'!
addUndo: aRefactoringChange
	undo addLast: aRefactoringChange.
	undo size > UndoSize
		ifTrue: [ undo removeFirst ].
	redo := OrderedCollection new! !

!RBRefactoryChangeManager methodsFor: 'initialization' stamp: ''!
initialize
	undo := OrderedCollection new.
	redo := OrderedCollection new.
	isPerformingRefactoring := false.
	self connectToChanges! !

!RBRefactoryChangeManager methodsFor: 'initialize-release' stamp: 'CamilleTeruel 7/29/2012 18:46'!
disconnectFromChanges
	SystemAnnouncer uniqueInstance unsubscribe: self! !

!RBRefactoryChangeManager methodsFor: 'public access' stamp: 'lr 9/7/2010 19:12'!
undoChange
	^ undo last! !

!RBRefactoryChangeManager methodsFor: 'testing' stamp: 'lr 9/7/2010 19:11'!
hasUndoableOperations
	^ undo isEmpty not! !

!RBRefactoryChangeManager methodsFor: 'testing' stamp: 'lr 9/7/2010 19:11'!
hasRedoableOperations
	^ redo isEmpty not! !

!RBRefactoryChangeManager methodsFor: 'initialize-release' stamp: 'TorstenBergmann 1/22/2015 09:09'!
release
	self disconnectFromChanges.
	super release.	! !

!RBRefactoryChangeManager class methodsFor: 'class initialization' stamp: 'lr 4/4/2010 08:32'!
initialize
	self nuke.
	UndoSize := 20! !

!RBRefactoryChangeManager class methodsFor: 'instance creation' stamp: 'lr 4/4/2010 08:35'!
instance
	^ Instance ifNil: [ Instance := self basicNew initialize ]! !

!RBRefactoryChangeManager class methodsFor: 'instance creation' stamp: 'lr 4/4/2010 08:33'!
new
	^ self shouldNotImplement! !

!RBRefactoryChangeManager class methodsFor: 'class initialization' stamp: 'lr 4/4/2010 08:33'!
undoSize
	^ UndoSize! !

!RBRefactoryChangeManager class methodsFor: 'class initialization' stamp: ''!
undoSize: anInteger 
	UndoSize := anInteger max: 0! !

!RBRefactoryChangeManager class methodsFor: 'public' stamp: 'lr 4/4/2010 08:34'!
nuke
	Instance notNil ifTrue: [ Instance release ].
	Instance := nil! !

!RBRefactoryChangeManager class methodsFor: 'settings' stamp: 'MarcusDenker 8/17/2014 15:34'!
settingsOn: aBuilder
	<systemsettings>
	(aBuilder group: #refactoring)
		label: 'Refactoring Engine';
		parent: #codeBrowsing;
		description: 'Settings related to the refactoring tools';
		with: [ 
					(aBuilder setting: #undoSize)
						target: self;
						label: 'Undo size';
						parentName: #refactoring ]! !

!RBRefactoryChangeManager class methodsFor: 'public' stamp: 'lr 4/4/2010 08:34'!
unload
	self nuke! !

!RBRefactoryClassChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 21:19'!
changeClassName: aSymbol 
	className := aSymbol.
	isMeta isNil ifTrue: [ isMeta := false ]! !

!RBRefactoryClassChange methodsFor: 'printing' stamp: 'lr 9/6/2010 21:19'!
displayClassName
	^ isMeta
		ifTrue: [ self changeClassName , ' class' ]
		ifFalse: [ self changeClassName asString ]! !

!RBRefactoryClassChange methodsFor: 'comparing' stamp: 'lr 9/6/2010 21:19'!
hash
	^ self changeClassName hash! !

!RBRefactoryClassChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 21:19'!
changeClassName
	^ className! !

!RBRefactoryClassChange methodsFor: 'private' stamp: 'lr 9/6/2010 21:19'!
isMeta
	^ isMeta! !

!RBRefactoryClassChange methodsFor: 'private' stamp: 'lr 9/6/2010 21:19'!
executeNotifying: aBlock
	| undo |
	undo := self asUndoOperation.
	undo name: self name.
	self primitiveExecute.
	aBlock value.
	^ undo! !

!RBRefactoryClassChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 21:18'!
changeClass
	| class |
	class := Smalltalk globals at: self changeClassName ifAbsent: [ ^ nil ].
	^ isMeta ifTrue: [ class classSide ] ifFalse: [ class ]! !

!RBRefactoryClassChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 21:19'!
methodSourceFor: aSymbol
	^ (self changeClass includesSelector: aSymbol)
		ifTrue: [ self changeClass sourceCodeAt: aSymbol ]! !

!RBRefactoryClassChange methodsFor: 'accessing' stamp: 'lr 10/31/2009 17:37'!
changeClass: aBehavior 
	isMeta := aBehavior isMeta.
	className := aBehavior theNonMetaClass name! !

!RBRefactoryClassChange methodsFor: 'printing' stamp: 'lr 9/6/2010 21:19'!
changeString
	^ self displayClassName! !

!RBRefactoryClassChange methodsFor: 'comparing' stamp: 'lr 9/6/2010 21:18'!
= aRefactoryClassChange 
	self class = aRefactoryClassChange class
		ifFalse: [ ^ false ].
	^ className = aRefactoryClassChange changeClassName 
		and: [ isMeta = aRefactoryClassChange isMeta ]! !

!RBRefactoryClassChange methodsFor: 'printing' stamp: ''!
printOn: aStream
	aStream nextPutAll: self displayString! !

!RBRefactoryClassChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 13:57'!
renameChangesForClass: oldClassName to: newClassName
	^ self changeClassName = oldClassName
		ifFalse: [ self ]
		ifTrue: [
			self copy
				changeClassName: newClassName;
				yourself ]! !

!RBRefactoryClassChange methodsFor: 'private' stamp: 'lr 9/6/2010 13:29'!
primitiveExecute
	^ self subclassResponsibility! !

!RBRefactoryClassChange methodsFor: 'converting' stamp: ''!
asUndoOperation
	^self subclassResponsibility! !

!RBRefactoryDefinitionChange methodsFor: 'accessing' stamp: 'lr 9/30/2010 14:08'!
definition
	^ definition! !

!RBRefactoryDefinitionChange methodsFor: 'initialization' stamp: 'lr 10/1/2010 14:37'!
definition: aString controller: aController
	isMeta := false.
	definition := aString.
	controller := aController! !

!RBRefactoryDefinitionChange methodsFor: 'private' stamp: 'lr 9/30/2010 14:20'!
definitionClass
	self subclassResponsibility! !

!RBRefactoryDefinitionChange methodsFor: 'comparing' stamp: 'lr 9/30/2010 14:07'!
hash
	^ definition hash! !

!RBRefactoryDefinitionChange methodsFor: 'comparing' stamp: 'lr 9/30/2010 14:07'!
= aDefinitionChange
	^ self class = aDefinitionChange class
		and: [ self definition = aDefinitionChange definition ]! !

!RBRefactoryDefinitionChange methodsFor: 'printing' stamp: 'lr 9/30/2010 14:12'!
printOn: aStream 
	aStream
		nextPutAll: definition;
		nextPut: $!!! !

!RBRefactoryDefinitionChange methodsFor: 'accessing' stamp: 'lr 9/30/2010 14:09'!
definedClass
	^ definedClass! !

!RBRefactoryDefinitionChange methodsFor: 'accessing' stamp: 'lr 9/30/2010 14:13'!
controller
	^ controller! !

!RBRefactoryDefinitionChange methodsFor: 'initialization' stamp: 'lr 10/1/2010 14:32'!
fillOutDefinition: aDictionary
	self subclassResponsibility! !

!RBRefactoryDefinitionChange methodsFor: 'private' stamp: 'MarcusDenker 8/28/2013 10:52'!
primitiveExecute
	definedClass := self definitionClass compiler
		source: self definition;
		requestor: self controller;
		logged: true;
		evaluate! !

!RBRefactoryDefinitionChange methodsFor: 'printing' stamp: 'lr 9/30/2010 14:12'!
changeString
	^ 'Define ' , self displayClassName! !

!RBRefactoryDefinitionChange methodsFor: 'private' stamp: 'lr 9/30/2010 19:21'!
namesIn: aString
	| names scanner token |
	names := OrderedCollection new.
	scanner := RBScanner
		on: (ReadStream on: aString)
		errorBlock: [ :msg :pos | ^ names ].
	[ scanner atEnd ] whileFalse: [
		token := scanner next.
		token isIdentifier
			ifTrue: [ names add: token value ] ].
	^ names asArray! !

!RBRefactoryDefinitionChange class methodsFor: 'private' stamp: 'lr 10/1/2010 14:32'!
definitionPatterns
	self subclassResponsibility! !

!RBRefactoryDefinitionChange class methodsFor: 'instance creation' stamp: 'lr 9/30/2010 14:01'!
definition: aString
	^ self definition: aString for: nil! !

!RBRefactoryDefinitionChange class methodsFor: 'instance creation' stamp: 'MarcusDenker 3/25/2013 21:02'!
definition: aString for: aController
	| parseTree context |
	parseTree := RBParser
		parseExpression: aString
		onError: [ :err :pos | ^ self error: 'Invalid definition string' ].
	context := SmallDictionary new.
	RBRefactoryDefinitionChange allSubclassesDo: [ :class |
		class definitionPatterns do: [ :pattern |
			((RBParser parseRewriteExpression: pattern) match: parseTree inContext: context empty)
			 	ifTrue: [ ^ class definition: aString for: aController context: context ] ] ].
	^ self error: 'Invalid definition string'! !

!RBRefactoryDefinitionChange class methodsFor: 'private' stamp: 'MarcusDenker 9/20/2013 15:07'!
definition: aString for: aController context: aDictionary
	| dictionary |
	dictionary := SmallDictionary new.
	aDictionary keysAndValuesDo: [ :key :node |
		dictionary at: key formattedCode put: (node isVariable
			ifTrue: [ node name ]
			ifFalse: [ 
				node isLiteralNode
					ifTrue: [ node value ]
					ifFalse: [ node ] ]) ].
	^ self new
		definition: aString controller: aController;
		fillOutDefinition: dictionary;
		yourself! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
collectionMessagesToExternalObject
	self someObject collection remove: 10! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
literalArrayCharacters
	^#($a $b $c) includes: $a! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: 'md 3/14/2006 16:47'!
atIfAbsent
	^ Smalltalk at: #MyTest
		ifAbsent: 
			[| collection |
			collection := #().
			Smalltalk at: #MyTest put: collection]! !

!RBRefactoryTestDataApp methodsFor: 'inline' stamp: ''!
inlineComponent
	| a |
	a := 5.
	^a class
		superclass;
		hasImmediateInstances;
		yourself! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
usesAdd
	^(1 to: 10) asOrderedCollection addAll: (11 to: 20)! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
collectionProtocol
	| newCollection |
	newCollection := OrderedCollection new.
	(1 to: 10) asOrderedCollection do: 
			[:each | 
			| new |
			new := each * 2.
			newCollection add: new].
	^newCollection! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: 'lr 2/26/2009 15:07'!
refersToClass
	^ RBRefactoryTestDataApp! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
returnInEnsure
	[self error: 'asdf'] ensure: [^4]! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
guardingClause
	self isSymbol 
		ifFalse: 
			[self printString.
			self isSymbol printString]! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
assignmentInBlock
	[^self printString] ensure: [self close]! !

!RBRefactoryTestDataApp methodsFor: 'test' stamp: ''!
moveDefinition
	| temp |
	^(self collect: 
			[:each | 
			temp := each printString.
			temp , temp]) 
		select: 
			[:each | 
			temp := each size.
			temp odd]! !

!RBRefactoryTestDataApp methodsFor: 'test' stamp: ''!
sendInlineParameterMethod
	^self inlineParameterMethod: #(#asdf)! !

!RBRefactoryTestDataApp methodsFor: 'test' stamp: ''!
symbolReference
	^#(#renameThisMethod: #(4 #renameThisMethod:))! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
returnsIfTrue
	^self isNil ifTrue: [4]! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: 'bh 4/2/2000 22:25'!
searchingLiteral
	^self printString = #a or: [#() = self printString | ( #() == self printString)]! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
release
	self printString! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
tempVarOverridesInstVar
	| temporaryVariable |
	temporaryVariable := 4.
	^temporaryVariable! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: 'nk 2/25/2005 16:50'!
variableAssignedLiteral
	temporaryVariable := #() ! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
detectContains
	^(1 to: 10) do: [:each | each > 2 ifTrue: [^each]]! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: 'nk 3/5/2005 14:51'!
noIsNil: arg
	^arg = nil or: [ arg ~= nil ]! !

!RBRefactoryTestDataApp methodsFor: 'test' stamp: ''!
noMoveDefinition
	| temp |
	^(self collect: 
			[:each | 
			temp := each printString.
			temp , temp]) 
		select: [:each | temp := each size + temp]! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
returnsBooleanAndOther
	self isVariable ifTrue: [^false].
	self printString! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
precedence
	^self isArray ifFalse: [self block + 5 * 34] ifTrue: [self printString = 10]! !

!RBRefactoryTestDataApp methodsFor: 'test' stamp: ''!
inlineParameterMethod: aSymbol
	^aSymbol isSymbol! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
missingYourself
	^(OrderedCollection new)
		add: 1;
		add: 2;
		removeFirst! !

!RBRefactoryTestDataApp methodsFor: 'accessing' stamp: ''!
referencesConditionFor: aClass 
	| environment association |
	^(RBCondition withBlock: 
			[association := Smalltalk associationAt: aClass name
						ifAbsent: [self refactoringError: 'Could not find class'].
			environment := (self environment referencesTo: association) 
						| (self environment referencesTo: aClass name).
			environment isEmpty])
		errorMacro: aClass , ' is referenced.<n>Browse references?';
		errorBlock: [environment openEditor];
		yourself! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
modifiesCollection
	| collection |
	collection := (1 to: 10) asOrderedCollection.
	collection do: [:each | each > 5 ifTrue: [collection remove: each]].
	^collection! !

!RBRefactoryTestDataApp methodsFor: 'test' stamp: 'MarkRizun 7/16/2014 14:33'!
demoExampleCall
	^ self demoRenameMethod: 1 PermuteArgs: 2! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
fileBlocks
	| file |
	^
	[file := 'asdf' asFilename readStream.
	file contents] ensure: [file close]! !

!RBRefactoryTestDataApp methodsFor: 'inline' stamp: ''!
called: anObject on: aBlock 
	Transcript
		show: anObject printString;
		cr.
	aBlock value! !

!RBRefactoryTestDataApp methodsFor: 'inline' stamp: ''!
inlineTemporary
	| temp |
	self isNil ifTrue: [temp := 4].
	^temp! !

!RBRefactoryTestDataApp methodsFor: 'test' stamp: ''!
testFoo: anObject
	^self class + anObject! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
toDo
	1 to: self size do: [:i | (self at: i) printString]! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
yourselfNotUsed
	self
		printString;
		printString;
		yourself! !

!RBRefactoryTestDataApp methodsFor: 'inline' stamp: ''!
multipleCalls
	self caller2.
	self caller2! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
toDoCollect
	| array |
	array := Array new: 10.
	1 to: 10 do: [:i | array at: i put: i * i].
	^array! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
equalsTrue
	^true == self! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
tempsReadBeforeWritten
	| temp |
	self isVariable ifTrue: [temp := 4].
	^temp! !

!RBRefactoryTestDataApp methodsFor: 'test' stamp: ''!
renameThisMethod: anArg
	^self! !

!RBRefactoryTestDataApp methodsFor: 'test' stamp: ''!
callFoo
	^self testFoo: 5! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: 'nk 3/4/2005 16:40'!
literalArrayWithTrueFalseOrNil2
	| b c |
	b := #(#true #false #nil).
	c := #(#true (#true #false #nil) #false #nil).
^b! !

!RBRefactoryTestDataApp methodsFor: 'test' stamp: ''!
inlineJunk
	| asdf |
	asdf := self inlineFoo: 
					[:each | 
					| temp |
					temp := each.
					temp , temp].
	^asdf foo: 
			[:bar | 
			| baz |
			baz := bar.
			baz * baz]! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
whileTrue
	| i |
	i := 1.
	[i < self size] whileTrue: 
			[(self at: i) printString.
			i := i + 1]! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
threeElementPoint
	^5 @ 5 + 6 @ 6! !

!RBRefactoryTestDataApp methodsFor: 'test' stamp: ''!
exampleCall
	^self rename: 1 two: 2! !

!RBRefactoryTestDataApp methodsFor: 'inline' stamp: ''!
inlineFailed
	| x y q |
	x := 5.
	y := 10.
	q := x + 1 fooMax: y.
	^q! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
asOrderedCollectionNotNeeded
	self foo addAll: (1 to: 10) asOrderedCollection! !

!RBRefactoryTestDataApp methodsFor: 'inline' stamp: ''!
inlineMax
	| x y q |
	x := 5.
	y := 10.
	q := x + 1 max: y.
	^q! !

!RBRefactoryTestDataApp methodsFor: 'test' stamp: ''!
selectorNotReferenced
	^self selectorNotReferenced + 4! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
stringConcatenation
	| string |
	string := '' yourself.
	(1 to: 10) do: [:i | string := string , i printString].
	^string! !

!RBRefactoryTestDataApp methodsFor: 'inline' stamp: ''!
caller2
	^(1 to: 10) inject: 1 into: [:sum :each | sum * (self foo: each)]! !

!RBRefactoryTestDataApp methodsFor: 'test' stamp: ''!
rename: this two: argumentMethod
	^self printString , this , argumentMethod! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: 'MarcusDenker 7/28/2014 18:48'!
consistencyCheck
	^(1 to: 10) size > 0! !

!RBRefactoryTestDataApp methodsFor: 'test' stamp: ''!
testMethod1
	^self testMethod1 
		, ([:each | each testMethod1] value: #(#(#testMethod1) 2 #testMethod1))! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
sizeCheck
	self isEmpty
		ifFalse: [self do: 
					[:each | 
					Transcript
						show: each;
						cr]]! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: 'lr 7/1/2008 10:14'!
cruft
	self halt! !

!RBRefactoryTestDataApp methodsFor: 'inline' stamp: ''!
inlineLast
	5 = 3 ifTrue: [^self caller] ifFalse: [^self caller2]! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: 'nk 3/5/2005 15:28'!
assignmentInIfTrue
	| variable |
	self isVariable 
		ifTrue: [variable := self]
		ifFalse: [variable := self printString].
	^variable! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
collectSelectNotUsed
	(1 to: 10) select: [:each | each = 4]! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
extraBlock
	^[:arg | arg + 43] value: 45! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: 'nk 3/4/2005 14:52'!
literalArrayWithTrueFalseOrNil
	| a b c |
	a := #(true false nil).
	b := #(#true #false #nil).
	c := {true. false. nil}.
	^{a. b. c}! !

!RBRefactoryTestDataApp methodsFor: 'inline' stamp: ''!
caller1
	| anObject |
	anObject := 5.
	self called: anObject + 1
		on1: 
			[:each | 
			each printString.
			^anObject]! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: 'nk 3/5/2005 15:28'!
sendsDifferentSuper
	super printString! !

!RBRefactoryTestDataApp methodsFor: 'inline' stamp: ''!
called: anObject on1: aBlock 
	| each |
	each := anObject printString.
	Transcript
		show: each;
		cr.
	aBlock value: each! !

!RBRefactoryTestDataApp methodsFor: 'test' stamp: ''!
inlineMethod
	| temp |
	temp := self
				foo;
				inlineMethod;
				bar.
	^temp! !

!RBRefactoryTestDataApp methodsFor: 'inline' stamp: ''!
foo: aValue
	^(1 to: 10) inject: aValue into: [:sum :each | sum + each]! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
toDoWithIncrement
	| counter |
	counter := 0.
	1 to: 10
		by: 2
		do: [:i | counter := counter + 2].
	^counter! !

!RBRefactoryTestDataApp methodsFor: 'inline' stamp: ''!
caller
	| anObject |
	anObject := 5.
	self 
		called: anObject + 1
		on: [^anObject]! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
booleanPrecedence
	^true & 4 = 45! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: 'nk 3/5/2005 15:28'!
contains
	^((1 to: 10) detect: [:each | each > 2] ifNone: [nil]) isNil! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
fullBlocks
	^[thisContext]! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
badMessage
	self become: String new! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
ifTrueReturns
	self isSymbol ifFalse: [^true].
	^false! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
longMethods
	self printString.
	self printString.
	self isVariable ifTrue: [self printString].
	self isVariable ifTrue: [self printString].
	self isVariable ifTrue: [self printString].
	self isVariable ifTrue: [self printString]! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: 'nk 3/5/2005 15:28'!
minMax
	"Bug in 3<5 ifTrue: [3]  ifFalse: [5]"

^3<5 ifTrue: [3]  ifFalse: [5]
"	| var |
	var := 4.
	var < 5 ifTrue: [var := 5].
	^var"! !

!RBRefactoryTestDataApp methodsFor: 'test' stamp: ''!
testMethod
	^self class! !

!RBRefactoryTestDataApp methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 8/28/2014 10:12'!
demoRenameMethod: arg1 PermuteArgs: arg2
	self do: arg1. 
	self do: arg2.
	^ arg1 > arg2! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
equalNotUsed
	| string |
	string = '' yourself.
	(1 to: 10) do: [:i | string := i printString].
	^string! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
endTrueFalse
	self isVariable 
		ifTrue: 
			[self printString.
			self isVariable printString]
		ifFalse: 
			[self printString.
			^4]! !

!RBRefactoryTestDataApp methodsFor: 'test' stamp: ''!
inlineFoo: aBlock 
	| bar baz asdf |
	bar := aBlock value: self.
	baz := bar + bar.
	asdf := baz + bar.
	^asdf! !

!RBRefactoryTestDataApp methodsFor: 'lint' stamp: ''!
justSendsSuper
	super justSendsSuper! !

!RBRefactoryTestDataApp methodsFor: 'test' stamp: ''!
callMethod
	^self renameThisMethod: 5! !

!RBRefactoryTestDataApp methodsFor: 'test' stamp: 'MarkRizun 7/16/2014 11:25'!
demoMethodWithDuplicates
	| a b result1 result2 answer |
	a := 3.
	b := a + 5.
	result1 := a + b.
	result2 := a + 5.
	answer := result1 + result2 + (a + 5).
	^ answer! !

!RBRefactoryTyper methodsFor: 'private' stamp: ''!
executeSearch: searcher 
	class withAllSubclasses do: 
			[:each | 
			each selectors do: 
					[:sel | 
					| parseTree |
					methodName := sel.
					parseTree := each parseTreeFor: sel.
					parseTree notNil ifTrue: [searcher executeTree: parseTree]]]! !

!RBRefactoryTyper methodsFor: 'private' stamp: 'lr 8/10/2009 16:36'!
backpointersDictionary
	"Create a special dictionary, because the host systems wrongly treats #abc and 'abc' as equal."

	^ PluggableDictionary new
		equalBlock: [ :a :b | a class == b class and: [ a = b ] ];
		hashBlock: [ :a | a class identityHash bitXor: a hash ];
		yourself! !

!RBRefactoryTyper methodsFor: 'accessing' stamp: ''!
guessTypesFor: anInstVarName 
	^bestGuesses at: anInstVarName ifAbsent: [self typesFor: anInstVarName]! !

!RBRefactoryTyper methodsFor: 'initialization' stamp: ''!
initialize
	model := RBNamespace new.
	class := model classFor: Object.
	variableTypes := Dictionary new.
	variableMessages := Dictionary new.
	selectorLookup := IdentityDictionary new.
	bestGuesses := Dictionary new! !

!RBRefactoryTyper methodsFor: 'computing types' stamp: 'lr 5/29/2010 09:45'!
findTypeFor: selectorCollection 
	^selectorCollection inject: self rootClasses
		into: 
			[:classes :each | 
			self refineTypes: classes
				with: (selectorLookup at: each ifAbsentPut: [self implementorsOf: each])]! !

!RBRefactoryTyper methodsFor: 'computing types' stamp: ''!
computeTypes
	variableMessages
		keysAndValuesDo: [:key :value | variableTypes at: key put: (self findTypeFor: value)]! !

!RBRefactoryTyper methodsFor: 'printing' stamp: ''!
printOn: aStream 
	aStream
		nextPutAll: class name;
		cr.
	class instanceVariableNames do: 
			[:each | 
			aStream
				tab;
				nextPutAll: each;
				tab;
				nextPut: $<.
			self printTypeFor: each on: aStream.
			aStream
				nextPut: $>;
				cr]! !

!RBRefactoryTyper methodsFor: 'private' stamp: 'lr 5/29/2010 10:01'!
rootClasses
	^ model rootClasses! !

!RBRefactoryTyper methodsFor: 'accessing' stamp: ''!
selectedClass: aClass 
	class := model classFor: aClass! !

!RBRefactoryTyper methodsFor: 'printing' stamp: ''!
printTypeFor: aString on: aStream 
	| types |
	types := (self guessTypesFor: aString) 
				asSortedCollection: [:a :b | a name < b name].
	1 to: types size
		do: 
			[:i | 
			i == 1 ifFalse: [aStream nextPutAll: ' | '].
			self 
				printType: (types at: i)
				for: aString
				on: aStream]! !

!RBRefactoryTyper methodsFor: 'computing types' stamp: ''!
refineTypes: aClassCollection with: anotherClassCollection 
	| classSet |
	classSet := Set new.
	aClassCollection do: 
			[:each | 
			anotherClassCollection do: 
					[:cls | 
					(cls includesClass: each) 
						ifTrue: [classSet add: cls]
						ifFalse: [(each includesClass: cls) ifTrue: [classSet add: each]]]].
	^classSet! !

!RBRefactoryTyper methodsFor: 'equivalence classes' stamp: 'lr 11/2/2009 00:14'!
computeEquivalenceClassesForMethodsAndVars
	| searcher |
	backpointers := self backpointersDictionary.
	class instanceVariableNames 
		do: [:each | backpointers at: each put: (self backpointersSetWith: each)].
	class withAllSubclasses do: 
		[:sub | sub selectors do: [:each | backpointers at: each put: (self backpointersSetWith: each)]].
	searcher := RBParseTreeSearcher new.
	searcher matches: '^``@object'
		do: [:aNode :answer | self processNode: aNode value].
	self executeSearch: searcher! !

!RBRefactoryTyper methodsFor: 'assignments' stamp: 'lr 11/2/2009 23:38'!
refineTypesByLookingAtAssignments
	| searcher needsSearch |
	needsSearch := false.
	searcher := RBParseTreeSearcher new.
	variableTypes keysAndValuesDo: 
			[:key :value | 
			(key first = $-) 
				ifFalse: 
					[needsSearch := true.
					searcher matches: key , ' := ``@object'
						do: [:aNode :answer | self guessTypeFromAssignment: aNode]]].
	needsSearch ifTrue: [self executeSearch: searcher]! !

!RBRefactoryTyper methodsFor: 'accessing' stamp: ''!
guessTypesFor: anInstVarName in: aClass 
	class = aClass ifFalse: [self runOn: aClass].
	^bestGuesses at: anInstVarName
		ifAbsent: [self typesFor: anInstVarName in: aClass]! !

!RBRefactoryTyper methodsFor: 'private' stamp: 'lr 8/10/2009 16:37'!
backpointersSetWith: anObject
	"Create a special set, because the host systems wrongly treats #abc and 'abc' as equal."
	
	^ PluggableSet new
		equalBlock: [ :a :b | a class == b class and: [ a = b ] ];
		hashBlock: [ :a | a class identityHash bitXor: a hash ];
		add: anObject;
		yourself! !

!RBRefactoryTyper methodsFor: 'selectors-collections' stamp: 'lr 5/29/2010 09:40'!
processCollectionMessagesFor: variableName in: aParseTree 
	| parent block |
	aParseTree isMessage
		ifFalse: [ ^ self ].
	(#(anyOne at: at:ifAbsent: at:ifAbsentPut: atPin: atRandom atRandom: atWrap: eight fifth first fourth last middle ninth second seventh sixth third) includes: aParseTree selector) ifTrue: [
		parent := aParseTree parent.
		(parent notNil and: [ parent isMessage ])
			ifFalse: [ ^ self ].
		aParseTree == parent receiver
			ifFalse: [ ^ self ].
		(variableMessages 
			at: (self collectionNameFor: variableName)
			ifAbsentPut: [Set new])
				add: parent selector.
		self processCollectionMessagesFor: (self collectionNameFor: variableName) in: parent ].
	(#(allSatisfy: anySatisfy: collect: collect:as: detect: detect:ifNone: detectMax: detectMin: detectSum: do: do:displayingProgress: do:separatedBy: gather: noneSatisfy: reject: select:) includes: aParseTree selector) ifTrue: [
		block := aParseTree arguments first.
		block isBlock ifFalse: [ ^ self ].
		self 
			processCollectionFor: variableName
			messagesTo: block arguments first name
			in: block ].
	(#(reduce: reduceLeft: reduceRight:) includes: aParseTree selector) ifTrue: [ 
		block := aParseTree arguments last.
		block isBlock ifFalse: [ ^ self ].
		block arguments do: [ :node |
			self
				processCollectionFor: variableName
				messagesTo: node name
				in: block ] ].
	#inject:into: = aParseTree selector ifTrue: [
		block := aParseTree arguments last.
		block isBlock ifFalse: [ ^ self ].
		self 
			processCollectionFor: variableName
			messagesTo: block arguments last name
			in: block ]! !

!RBRefactoryTyper methodsFor: 'computing types' stamp: 'lr 5/29/2010 09:46'!
implementorsOf: aSelector 
	| classes |
	classes := OrderedCollection new.
	self rootClasses do: 
			[:each | 
			self 
				implementorsOf: aSelector
				in: each
				storeIn: classes].
	^classes! !

!RBRefactoryTyper methodsFor: 'assignments' stamp: 'MarcusDenker 9/20/2013 15:07'!
guessTypeFromAssignment: aNode 
	| type set newType |
	type := nil.
	aNode value isAssignment 
		ifTrue: 
			[^self guessTypeFromAssignment: (RBAssignmentNode variable: aNode variable
						value: aNode value value)].
	aNode value isBlock ifTrue: [type := model classFor: [] class].
	aNode value isLiteralNode 
		ifTrue: 
			[aNode value value isNil ifTrue: [^self].
			type := model classFor: (self typeFor: aNode value value)].
	aNode value isMessage 
		ifTrue: 
			[aNode value receiver isVariable 
				ifTrue: [type := model classNamed: aNode value receiver name asSymbol].
			aNode value selector = #asValue 
				ifTrue: [type := model classNamed: #ValueHolder].
			(#(#and: #or: #= #== #~= #~~ #<= #< #~~ #> #>=) 
				includes: aNode value selector) ifTrue: [type := model classFor: Boolean]].
	type isNil ifTrue: [^self].
	set := variableTypes at: aNode variable name.
	newType := set detect: [:each | type includesClass: each] ifNone: [nil].
	newType isNil ifTrue: [^self].
	((self rootClasses includes: newType) or: [ newType = (model classFor: Object) ])
		ifTrue: [newType := type].
	(bestGuesses at: aNode variable name ifAbsentPut: [Set new]) add: newType! !

!RBRefactoryTyper methodsFor: 'printing' stamp: ''!
collectionNameFor: aString 
	^'-<1s>-' expandMacrosWith: aString! !

!RBRefactoryTyper methodsFor: 'selectors' stamp: 'lr 11/19/2009 11:45'!
computeMessagesSentToVariables
	| searcher |
	variableMessages := Dictionary new.
	class instanceVariableNames 
		do: [:each | variableMessages at: each put: Set new].
	searcher := RBParseTreeSearcher new.
	class instanceVariableNames do: 
			[:each | 
			| block |
			block := [:aNode :answer | 
				(variableMessages at: each ifAbsentPut: [Set new]) add: aNode selector.
				self processCollectionMessagesFor: each in: aNode].
			searcher matches: each , ' `@messageName: ``@args' do: block.
			(backpointers at: each) do: 
					[:sel | 
					sel isSymbol 
						ifTrue: 
							[searcher 
								matches: ('(self <1s>) `@messageName: ``@args' 
										expandMacrosWith: (RBParseTreeSearcher buildSelectorString: sel)) asString
								do: block]]].
	searcher answer: variableMessages.
	self executeSearch: searcher! !

!RBRefactoryTyper methodsFor: 'computing types' stamp: ''!
implementorsOf: aSelector in: aClass storeIn: classes 
	(aClass directlyDefinesMethod: aSelector) 
		ifTrue: 
			[classes add: aClass.
			^self].
	aClass subclasses do: 
			[:each | 
			self 
				implementorsOf: aSelector
				in: each
				storeIn: classes]! !

!RBRefactoryTyper methodsFor: 'private' stamp: ''!
model
	^model! !

!RBRefactoryTyper methodsFor: 'printing' stamp: ''!
printType: aClass for: aString on: aStream 
	| name colTypes |
	colTypes := #().
	name := self collectionNameFor: aString.
	(aClass includesClass: (model classFor: Collection))
		ifTrue: [colTypes := self guessTypesFor: name].
	colTypes isEmpty ifFalse: [aStream nextPut: $(].
	aClass printOn: aStream.
	colTypes isEmpty
		ifFalse: 
			[aStream nextPutAll: ' of: '.
			colTypes size > 1 ifTrue: [aStream nextPut: $(].
			self printTypeFor: name on: aStream.
			colTypes size > 1 ifTrue: [aStream nextPut: $)]].
	colTypes isEmpty ifFalse: [aStream nextPut: $)]! !

!RBRefactoryTyper methodsFor: 'accessing' stamp: ''!
runOn: aClass 
	variableTypes := Dictionary new.
	variableMessages := Dictionary new.
	bestGuesses := Dictionary new.
	class := model classFor: aClass.
	class instanceVariableNames isEmpty ifTrue: [^self].
	self
		selectedClass: aClass;
		computeEquivalenceClassesForMethodsAndVars;
		computeMessagesSentToVariables;
		computeTypes;
		refineTypesByLookingAtAssignments! !

!RBRefactoryTyper methodsFor: 'assignments' stamp: 'lr 7/1/2008 10:25'!
typeFor: anObject 
	anObject isString
		ifTrue: [ ^ String ].
	anObject isInteger
		ifTrue: [ ^ Integer ].
	^ (anObject == true or: [ anObject == false ])
		ifTrue: [ Boolean ]
		ifFalse: [ anObject class ]! !

!RBRefactoryTyper methodsFor: 'equivalence classes' stamp: 'CamilloBruni 8/1/2012 16:11'!
merge: aName 
	| set1 set2 |
	set1 := backpointers at: methodName ifAbsent: [nil].
	set2 := backpointers at: aName ifAbsent: [nil].
	(set1 isNil or: [set2 isNil or: [set1 == set2]]) ifTrue: [^self].
	set1 addAll: set2.
	set2 do: [:each | backpointers at: each put: set1]! !

!RBRefactoryTyper methodsFor: 'equivalence classes' stamp: ''!
processNode: aNode 
	(aNode isVariable and: [class instanceVariableNames includes: aNode name]) 
		ifTrue: [^self merge: aNode name].
	(aNode isMessage 
		and: [aNode receiver isVariable and: [aNode receiver name = 'self']]) 
			ifTrue: [^self merge: aNode selector].
	aNode isAssignment 
		ifTrue: 
			[self
				processNode: aNode value;
				processNode: aNode variable].
	(aNode isMessage and: 
			[#(#ifTrue: #ifFalse: #ifTrue:ifFalse: #ifFalse:ifTrue:) 
				includes: aNode selector]) 
		ifTrue: 
			[aNode arguments do: 
					[:each | 
					each isBlock 
						ifTrue: 
							[each body statements isEmpty 
								ifFalse: [self processNode: each body statements last]]]]! !

!RBRefactoryTyper methodsFor: 'accessing' stamp: ''!
typesFor: anInstVarName in: aClass 
	class = aClass ifFalse: [self runOn: aClass].
	^variableTypes at: anInstVarName ifAbsent: [Set new]! !

!RBRefactoryTyper methodsFor: 'private' stamp: ''!
model: aRBSmalltalk
	model := aRBSmalltalk! !

!RBRefactoryTyper methodsFor: 'selectors-collections' stamp: 'lr 5/29/2010 09:40'!
processCollectionFor: key messagesTo: aName in: aBlock 
	| searcher |
	searcher := RBParseTreeSearcher new.
	searcher 
		matches: aName , ' `@message: ``@args'
		do: [ :aNode :answer | 
			self processCollectionMessagesFor: key in: aNode.
			answer add: aNode selector; yourself ].
	searcher 
		executeTree: aBlock
		initialAnswer: (variableMessages at: (self collectionNameFor: key) ifAbsentPut: [ Set new ])! !

!RBRefactoryTyper methodsFor: 'accessing' stamp: ''!
typesFor: anInstVarName 
	^variableTypes at: anInstVarName ifAbsent: [Set new]! !

!RBRefactoryTyper class methodsFor: 'instance creation' stamp: ''!
newFor: aRBNamespace 
	^(self new)
		model: aRBNamespace;
		yourself! !

!RBRefactoryTyper class methodsFor: 'accessing' stamp: 'lr 11/2/2009 00:14'!
typesFor: variableName in: aParseTree model: aRBSmalltalk 
	| searcher messages |
	searcher := RBParseTreeSearcher new.
	searcher matches: variableName , ' `@message: ``@args'
		do: 
			[:aNode :answer | 
			answer
				add: aNode selector;
				yourself].
	messages := searcher executeTree: aParseTree initialAnswer: Set new.
	^(self new)
		model: aRBSmalltalk;
		findTypeFor: messages! !

!RBRefactoryVariableChange methodsFor: 'comparing' stamp: 'lr 10/15/2010 09:37'!
hash
	^ self changeClassName hash bitXor: self variable hash! !

!RBRefactoryVariableChange methodsFor: 'comparing' stamp: 'lr 10/15/2010 09:37'!
= aRefactoryVariableChange
	^ super = aRefactoryVariableChange and: [ self variable = aRefactoryVariableChange variable ]! !

!RBRefactoryVariableChange methodsFor: 'private' stamp: 'lr 9/6/2010 21:29'!
variable
	^ variable! !

!RBRefactoryVariableChange methodsFor: 'printing' stamp: 'lr 5/18/2010 20:48'!
printOn: aStream 
	aStream
		nextPutAll: self displayClassName; nextPut: $ ;
		nextPutAll: self changeSymbol; nextPut: $ ;
		print: self variable;
		nextPut: $!!! !

!RBRefactoryVariableChange methodsFor: 'private' stamp: 'lr 9/6/2010 21:27'!
changeObject
	^ self variable! !

!RBRefactoryVariableChange methodsFor: 'private' stamp: ''!
changeSymbol
	self subclassResponsibility! !

!RBRefactoryVariableChange methodsFor: 'private' stamp: 'lr 10/15/2010 09:43'!
primitiveExecute
	self changeClass perform: self changeSymbol with: self changeObject! !

!RBRefactoryVariableChange methodsFor: 'initialize-release' stamp: ''!
class: aBehavior variable: aString 
	self changeClass: aBehavior.
	variable := aString! !

!RBRefactoryVariableChange class methodsFor: 'instance creation' stamp: 'lr 9/7/2010 19:44'!
remove: aVariable from: aBehavior
	"This should only be called on the Remove*Change subclasses, but is here so we don't need to copy it to all subclasses"

	^ self new class: aBehavior variable: aVariable! !

!RBRefactoryVariableChange class methodsFor: 'instance creation' stamp: 'lr 9/7/2010 19:44'!
add: aVariable to: aBehavior
	"This should only be called on the Add*Change subclasses, but is here so we don't need to copy it to all subclasses"

	^ self new class: aBehavior variable: aVariable! !

!RBRefersToClassRule commentStamp: 'StephaneDucasse 11/29/2014 20:28'!
This smell arises when a class has its class name directly in the source instead of "self class". The self class variant allows you to create subclasses without needing to redefine that method.
However we cannot systematically replace Class reference by self class or self because a Class reference is static and a self expression is dynamic. So the programmer may want to send messages to root of an hierarchy and not to the leaf classes. !
!RBRefersToClassRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 20:29'!
rationale
	^ 'Checks for direct reference to classes themselves.'! !

!RBRefersToClassRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Miscellaneous'! !

!RBRefersToClassRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Refers to class name instead of "self class"'! !

!RBRefersToClassRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 10:35'!
category 
	^ 'Design Flaws'! !

!RBRefersToClassRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:50'!
checkClass: aClass 
	| sels className |
	className := aClass theNonMetaClass name.
	sels := aClass whichSelectorsReferTo: (Smalltalk globals associationAt: className).
	sels do: 
		[ :each | 
		result 
			addClass: aClass
			selector: each ].
	sels isEmpty ifFalse: [ result addSearchString: className ]! !

!RBRefersToClassRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'RefersToClassRule'! !

!RBRegexRefactoring methodsFor: 'private' stamp: ''!
execute: aString replace: aRegex with: aReadStream
	| stream |
	^ aRegex copy: aString translatingMatchesUsing: [ :match |
		stream := WriteStream on: (String new: 2 * aString size).
		[ aReadStream atEnd ] whileFalse: [
			stream nextPutAll: (aReadStream upTo: $$).
			aReadStream atEnd ifFalse: [
				aReadStream peek isDigit
					ifFalse: [ stream nextPut: aReadStream next ]
					ifTrue: [ stream nextPutAll: (aRegex subexpression: aReadStream next asInteger - $0 asInteger + 1) ] ] ].
		aReadStream reset.
		stream contents ]! !

!RBRegexRefactoring methodsFor: 'initialization' stamp: ''!
initialize
	super initialize.
	matchers := OrderedCollection new! !

!RBRegexRefactoring methodsFor: 'private' stamp: ''!
execute: aString
	"Perform all searches on aString and return the transformation."
	
	^ matchers 
		inject: aString asString
		into: [ :string :assoc | self execute: string replace: assoc key with: assoc value ]! !

!RBRegexRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^ RBCondition empty! !

!RBRegexRefactoring methodsFor: 'searching' stamp: ''!
replace: aFindString with: aReplaceString
	self replace: aFindString with: aReplaceString ignoreCase: false! !

!RBRegexRefactoring methodsFor: 'searching' stamp: ''!
replace: aFindString with: aReplaceString ignoreCase: aBoolean
	"Replace all matches of aFindString (regular expression) with aReplaceString, where $0 references the whole match, and $1..$9 the matched groups."
	
	| regex stream |
	regex := RxParser preferredMatcherClass
		for: (RxParser new parse: aFindString)
		ignoreCase: aBoolean.
	stream := aReplaceString readStream.
	matchers add: regex -> stream! !

!RBRemoveAssignmentWithoutEffectRule commentStamp: '<historical>'!
See my #longDescription .!
!RBRemoveAssignmentWithoutEffectRule methodsFor: 'initialization' stamp: 'SimonAllier 2/8/2013 16:43'!
initialize
	super initialize.
 
	self rewriteRule
		replace: 	'`var := `var' with: ''! !

!RBRemoveAssignmentWithoutEffectRule methodsFor: 'accessing' stamp: 'SimonAllier 9/5/2012 14:24'!
group
	^ 'Transformations'! !

!RBRemoveAssignmentWithoutEffectRule methodsFor: 'accessing' stamp: 'SimonAllier 9/5/2012 14:21'!
name
	^ 'Remove assignment has no effect'! !

!RBRemoveAssignmentWithoutEffectRule methodsFor: 'as yet unclassified' stamp: 'SimonAllier 9/7/2012 14:05'!
category 
	^ 'Optimization'! !

!RBRemoveAssignmentWithoutEffectRule methodsFor: 'as yet unclassified' stamp: 'SimonAllier 9/12/2012 14:02'!
longDescription 
	^ 'Remove assignment has no effect. For example, var := var is unless'! !

!RBRemoveClassChange methodsFor: 'accessing' stamp: 'lr 10/15/2010 09:10'!
changeClass: aBehavior
	super changeClass: aBehavior.
	isMeta := false! !

!RBRemoveClassChange methodsFor: 'private' stamp: ''!
primitiveExecute
	self changeClass removeFromSystem! !

!RBRemoveClassChange methodsFor: 'printing' stamp: 'lr 4/7/2010 08:20'!
changeString
	^ 'Remove ' , self displayClassName! !

!RBRemoveClassChange methodsFor: 'printing' stamp: ''!
printOn: aStream 
	aStream
		nextPutAll: self displayClassName;
		nextPutAll: ' removeFromSystem';
		nextPut: $!!! !

!RBRemoveClassChange methodsFor: 'converting' stamp: 'lr 9/8/2011 20:10'!
asUndoOperation
	| classChanges |
	classChanges := RBCompositeRefactoryChange new.
	self changeClass withAllSubclasses do: [ :each | 
		classChanges defineClass: each definition.
		each class instVarNames 
			do: [ :varName | classChanges addInstanceVariable: varName to: each class ].
		each selectors 
			do: [ :selector | classChanges compile: (each sourceCodeAt: selector) in: each ].
		each class selectors 
			do: [ :selector | classChanges compile: (each class sourceCodeAt: selector) in: each class ] ].
	^ classChanges! !

!RBRemoveClassChange class methodsFor: 'instance creation' stamp: 'lr 9/7/2010 19:45'!
removeClassName: aSymbol
	^ self new changeClassName: aSymbol! !

!RBRemoveClassChange class methodsFor: 'instance creation' stamp: 'lr 9/7/2010 19:44'!
remove: aClass
	^ self new changeClass: aClass! !

!RBRemoveClassRefactoring methodsFor: 'preconditions' stamp: 'MarkRizun 10/2/2014 14:18'!
preconditions
	^classNames inject: RBCondition empty
		into: 
			[:sum :each | 
			| aClass |
			aClass := self model classNamed: each asSymbol.
			aClass isNil ifTrue: [self refactoringFailure: 'No such class'].
			sum 
				& (((RBCondition isMetaclass: aClass) 
						errorMacro: 'Cannot remove just the metaclass') not 
						& ((RBCondition withBlock: [(self hasReferencesTo: each asSymbol) not])
								errorMacro: each , ' is referenced.<n>Browse references?';
								errorBlock: 
										[self openBrowserOn: (RBBrowserEnvironment new 
													referencesTo: (Smalltalk globals associationAt: each ifAbsent: [each]))];
								yourself)
										& ((RBCondition withBlock: [aClass superclass notNil])
													errorMacro: 'Cannot remove top level class<n>when it has subclasses';
													yourself))]! !

!RBRemoveClassRefactoring methodsFor: 'transforming' stamp: ''!
removeClasses
	classNames do: [:each | self model removeClassNamed: each]! !

!RBRemoveClassRefactoring methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream nextPutAll: ' classNames: '.
	classNames asArray storeOn: aStream.
	aStream nextPut: $)! !

!RBRemoveClassRefactoring methodsFor: 'transforming' stamp: ''!
transform
	self
		reparentSubclasses;
		removeClasses! !

!RBRemoveClassRefactoring methodsFor: 'preconditions' stamp: 'lr 9/8/2011 20:25'!
hasReferencesTo: aSymbol 
	| literal |
	literal := Smalltalk globals associationAt: aSymbol.
	RBBrowserEnvironment new classesDo: 
			[:each | 
			(classNames 
				includes: (each isMeta ifTrue: [each soleInstance] ifFalse: [each]) name) 
					ifFalse: 
						[(each whichSelectorsReferTo: literal) isEmpty ifFalse: [^true].
						(each whichSelectorsReferTo: aSymbol) isEmpty ifFalse: [^true]]].
	^false! !

!RBRemoveClassRefactoring methodsFor: 'initialize-release' stamp: ''!
classNames: aClassNameCollection 
	classNames := aClassNameCollection! !

!RBRemoveClassRefactoring methodsFor: 'transforming' stamp: ''!
reparentSubclasses
	classNames do: 
			[:each | 
			| class |
			class := self model classNamed: each.
			self model reparentClasses: class subclasses copy to: class superclass]! !

!RBRemoveClassRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBSmalltalk classNames: aClassNameCollection 
	^(self new)
		model: aRBSmalltalk;
		classNames: aClassNameCollection;
		yourself! !

!RBRemoveClassRefactoring class methodsFor: 'instance creation' stamp: ''!
classNames: aClassNameCollection 
	^self new classNames: aClassNameCollection! !

!RBRemoveClassTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testBadName
	self 
		shouldFail: (RBRemoveClassRefactoring classNames: #(#RecursiveSelfRule))! !

!RBRemoveClassTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testRemoveReferenced
	self shouldFail: (RBRemoveClassRefactoring classNames: #(#RBBasicLintRuleTest ))! !

!RBRemoveClassTest methodsFor: 'tests' stamp: 'MarkRizun 10/2/2014 14:10'!
testRemoveClass
	| refactoring |
	refactoring := RBRemoveClassRefactoring classNames: (Array with: ('RBFoo' , 'LintRuleTest1') asSymbol).
	self executeRefactoring: refactoring.
	self assert: (refactoring model classNamed: ('RBFoo' , 'LintRuleTest1') asSymbol) isNil.
	self assert: (refactoring model classNamed: #RBTransformationRuleTest1) superclass = (refactoring model classNamed: #RBLintRuleTest)! !

!RBRemoveClassVariableChange methodsFor: 'private' stamp: 'lr 3/20/2011 11:28'!
changeSymbol
	^ #removeClassVarNamed:! !

!RBRemoveClassVariableChange methodsFor: 'accessing' stamp: 'lr 10/15/2010 08:31'!
changeClass: aBehavior
	super changeClass: aBehavior.
	isMeta := false! !

!RBRemoveClassVariableChange methodsFor: 'printing' stamp: 'lr 10/15/2010 09:37'!
changeString
	^ 'Remove class variable <1s> from <2s>' 
		expandMacrosWith: self variable
		with: self displayClassName! !

!RBRemoveClassVariableChange methodsFor: 'converting' stamp: 'lr 9/8/2011 20:10'!
asUndoOperation
	^ RBAddClassVariableChange add: self variable to: self changeClass! !

!RBRemoveClassVariableRefactoring methodsFor: 'preconditions' stamp: 'lr 9/8/2011 20:32'!
preconditions
	^ (RBCondition isMetaclass: class) not & (RBCondition 
			definesClassVariable: variableName
			in: class) & (RBCondition withBlock: 
			[ | block |
			block := 
			[ :each | 
			(each whichSelectorsReferToClassVariable: variableName) isEmpty ifFalse: 
				[ class realClass isNil 
					ifTrue: 
						[ self refactoringError: ('<1s> is referenced.' expandMacrosWith: variableName) ]
					ifFalse: 
						[ self 
							refactoringError: ('<1s> is referenced.<n>Browse references?' expandMacrosWith: variableName)
							with: 
								[ self openBrowserOn: (RBVariableEnvironment 
										referencesToClassVariable: variableName
										in: class realClass) ] ] ] ].
			class withAllSubclasses do: block.
			class theMetaClass withAllSubclasses do: block.
			true ])! !

!RBRemoveClassVariableRefactoring methodsFor: 'transforming' stamp: ''!
transform
	class removeClassVariable: variableName! !

!RBRemoveClassVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testNonExistantName
	self shouldFail: (RBRemoveClassVariableRefactoring 
			variable: #RecursiveSelfRule1
			class: RBTransformationRuleTest)! !

!RBRemoveClassVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testRemoveClassVar
	| refactoring class |
	refactoring := RBRemoveClassVariableRefactoring 
		variable: 'Foo1'
		class: RBLintRuleTest.
	class := refactoring model classNamed: #RBLintRuleTest.
	self assert: (class definesClassVariable: 'Foo1').
	self executeRefactoring: refactoring.
	self deny: (class definesClassVariable: 'Foo1')! !

!RBRemoveClassVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testReferencedVariable
	self shouldFail: (RBRemoveClassVariableRefactoring 
			variable: #RecursiveSelfRule
			class: RBTransformationRuleTest)! !

!RBRemoveInstanceVariableChange methodsFor: 'printing' stamp: 'lr 10/14/2010 20:53'!
changeString
	^ 'Remove instance variable <1s> from <2s>' 
		expandMacrosWith: self variable
		with: self displayClassName! !

!RBRemoveInstanceVariableChange methodsFor: 'private' stamp: 'lr 3/20/2011 11:27'!
changeSymbol
	^ #removeInstVarNamed:! !

!RBRemoveInstanceVariableChange methodsFor: 'converting' stamp: 'lr 9/8/2011 20:10'!
asUndoOperation
	^ RBAddInstanceVariableChange add: self variable to: self changeClass! !

!RBRemoveInstanceVariableRefactoring methodsFor: 'preconditions' stamp: 'lr 9/8/2011 20:25'!
preconditions
	| references |
	references := RBCondition hierarchyOf: class
				referencesInstanceVariable: variableName.
	class realClass isNil 
		ifTrue: 
			[references 
				errorMacro: ('<1s> is referenced.' expandMacrosWith: variableName)]
		ifFalse: 
			[references
				errorMacro: ('<1s> is referenced.<n>Browse references?' 
							expandMacrosWith: variableName);
				errorBlock: 
						[self openBrowserOn: (RBBrowserEnvironment new instVarRefsTo: variableName
									in: class realClass)]].
	^(RBCondition definesInstanceVariable: variableName asString in: class) 
		& references not! !

!RBRemoveInstanceVariableRefactoring methodsFor: 'transforming' stamp: ''!
transform
	class removeInstanceVariable: variableName! !

!RBRemoveInstanceVariableRefactoring class methodsFor: 'as yet unclassified' stamp: 'lr 1/20/2010 08:43'!
remove: variable from: class
	^ self variable: variable class: class! !

!RBRemoveInstanceVariableRefactoring class methodsFor: 'as yet unclassified' stamp: 'lr 1/20/2010 08:43'!
model: aNamespace remove: variable from: class
	^ self model: aNamespace variable: variable class: class! !

!RBRemoveInstanceVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testRemoveInstVar
	| refactoring class |
	refactoring := RBRemoveInstanceVariableRefactoring 
		variable: 'foo1'
		class: RBLintRuleTest.
	class := refactoring model classNamed: #RBLintRuleTest.
	self assert: (class definesInstanceVariable: 'foo1').
	self executeRefactoring: refactoring.
	self deny: (class definesInstanceVariable: 'foo1')! !

!RBRemoveInstanceVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testModelRemoveInstanceVariable
	| class |
	model 
		defineClass: 'nil subclass: #Object instanceVariableNames: ''foo1'' classVariableNames: '''' poolDictionaries: '''' category: #''Refactory-Test data'''.
	class := model classNamed: #Object.
	self assert: (class definesInstanceVariable: 'foo1').
	self executeRefactoring: (RBRemoveInstanceVariableRefactoring 
				model: model
				variable: 'foo1'
				class: class).
	self deny: (class definesInstanceVariable: 'foo1')! !

!RBRemoveInstanceVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testNonExistantName
	self shouldFail: (RBRemoveInstanceVariableRefactoring 
			variable: 'name1'
			class: RBLintRuleTest)! !

!RBRemoveInstanceVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testReferencedVariable
	self shouldFail: (RBRemoveInstanceVariableRefactoring 
			variable: 'name'
			class: RBLintRuleTest)! !

!RBRemoveMethodChange methodsFor: 'private' stamp: 'lr 9/7/2010 19:11'!
selector
	^ selector! !

!RBRemoveMethodChange methodsFor: 'comparing' stamp: 'lr 9/7/2010 19:11'!
hash
	^ selector hash! !

!RBRemoveMethodChange methodsFor: 'comparing' stamp: 'lr 9/7/2010 19:10'!
= aRemoveMethodChange
	super = aRemoveMethodChange
		ifFalse: [ ^ false ].
	^ selector = aRemoveMethodChange selector! !

!RBRemoveMethodChange methodsFor: 'printing' stamp: 'lr 2/8/2008 09:29'!
printOn: aStream 
	aStream
		nextPutAll: self displayClassName;
		nextPutAll: ' removeSelector: ';
		print: self selector;
		nextPut: $!!! !

!RBRemoveMethodChange methodsFor: 'private' stamp: 'lr 9/7/2010 19:11'!
primitiveExecute
	^ self changeClass removeSelector: selector! !

!RBRemoveMethodChange methodsFor: 'printing' stamp: 'lr 4/7/2010 08:21'!
changeString
	^ 'Remove <1s>>>#<2s>'
		expandMacrosWith: self displayClassName
		with: selector! !

!RBRemoveMethodChange methodsFor: 'initialize-release' stamp: 'lr 9/7/2010 19:11'!
selector: aSymbol
	selector := aSymbol! !

!RBRemoveMethodChange methodsFor: 'converting' stamp: 'lr 9/8/2011 20:10'!
asUndoOperation
	^ RBAddMethodChange compile: (self methodSourceFor: selector) in: self changeClass! !

!RBRemoveMethodChange class methodsFor: 'instance creation' stamp: 'lr 9/7/2010 19:45'!
remove: aSymbol from: aClass
	^ self new
		changeClass: aClass;
		selector: aSymbol;
		yourself! !

!RBRemoveMethodRefactoring methodsFor: 'preconditions' stamp: 'NicolaiHess 11/28/2014 13:32'!
checkBrowseOccurrences: anCollectionOfOccurrences
	anCollectionOfOccurrences size = 1
		ifTrue: [ ^ self checkBrowseOccurrenceOf: anCollectionOfOccurrences first key in: anCollectionOfOccurrences first value ]
		ifFalse: [ ^ self checkBrowseAllOccurences: anCollectionOfOccurrences ]! !

!RBRemoveMethodRefactoring methodsFor: 'preconditions' stamp: 'NicolaiHess 11/28/2014 13:32'!
checkBrowseOccurrenceOf: selector in: aRBMethod
	self
		refactoringError:
			('Possible call to <2s> in <1p><n>Browse references?' expandMacrosWith: aRBMethod modelClass with: selector)
		with: [ self openBrowserOn: (RBBrowserEnvironment new referencesTo: selector) ]! !

!RBRemoveMethodRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^(selectors inject: RBCondition empty
		into: [:cond :each | cond & (RBCondition definesSelector: each in: class)]) 
			& (RBCondition withBlock: 
						[self checkSuperMethods.
						true])! !

!RBRemoveMethodRefactoring methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream nextPutAll: ' removeMethods: '.
	selectors asArray storeOn: aStream.
	aStream nextPutAll: ' from: '.
	class storeOn: aStream.
	aStream nextPut: $)! !

!RBRemoveMethodRefactoring methodsFor: 'preconditions' stamp: ''!
checkReferencesToSuperSendsToAnyOf: superMessages 
	[superMessages isEmpty] whileFalse: 
			[self 
				refactoringWarning: ('Although <1s> is equivalent to a superclass method,<n>it contains a super send so it might modify behavior.' 
						expandMacrosWith: superMessages first).
			superMessages remove: superMessages first]! !

!RBRemoveMethodRefactoring methodsFor: 'preconditions' stamp: 'lr 11/2/2009 00:14'!
justSendsSuper: aSelector 
	| matcher parseTree superclass |
	matcher := RBParseTreeSearcher justSendsSuper.
	parseTree := class parseTreeFor: aSelector.
	(matcher executeTree: parseTree initialAnswer: false) ifFalse: [^false].
	parseTree lastIsReturn ifTrue: [^true].
	superclass := class superclass whichClassIncludesSelector: aSelector.
	superclass isNil ifTrue: [^true].	"Since there isn't a superclass that implements the message, we can 
								 delete it since it would be an error anyway."
	parseTree := superclass parseTreeFor: aSelector.
	matcher := RBParseTreeSearcher new.
	matcher matches: '^``@object'
		do: 
			[:aNode :answer | 
			answer
				add: aNode value;
				yourself].
	matcher executeTree: parseTree initialAnswer: Set new.
	^(matcher answer 
		detect: [:each | (each isVariable and: [each name = 'self']) not]
		ifNone: [nil]) isNil! !

!RBRemoveMethodRefactoring methodsFor: 'preconditions' stamp: ''!
superclassEquivalentlyDefines: aSelector 
	| superTree myTree |
	class superclass isNil ifTrue: [^false].
	superTree := class superclass parseTreeFor: aSelector.
	myTree := class parseTreeFor: aSelector.
	(superTree isNil or: [myTree isNil]) ifTrue: [^false].
	^superTree equalTo: myTree exceptForVariables: #()! !

!RBRemoveMethodRefactoring methodsFor: 'transforming' stamp: ''!
transform
	selectors do: [:each | class removeMethod: each]! !

!RBRemoveMethodRefactoring methodsFor: 'preconditions' stamp: ''!
checkSuperMethods
	| superMessages nonSupers |
	nonSupers := OrderedCollection new.
	superMessages := OrderedCollection new.
	(selectors reject: [:each | self justSendsSuper: each]) do: 
			[:each | 
			(self superclassEquivalentlyDefines: each) 
				ifTrue: 
					[(class parseTreeFor: each) superMessages isEmpty 
						ifFalse: [superMessages add: each]]
				ifFalse: [nonSupers add: each]].
	nonSupers isEmpty & superMessages isEmpty ifTrue: [^self].
	self checkReferencesToAnyOf: nonSupers.
	self checkReferencesToSuperSendsToAnyOf: superMessages! !

!RBRemoveMethodRefactoring methodsFor: 'preconditions' stamp: 'NicolaiHess 11/28/2014 13:31'!
checkReferencesToAnyOf: aSelectorCollection
	| occurrences |
	occurrences := OrderedCollection new.
	aSelectorCollection
		do: [ :each | 
			self model
				allReferencesTo: each
				do: [ :aRBMethod | 
					(aSelectorCollection includes: aRBMethod selector)
						ifFalse: [ occurrences add: each -> aRBMethod ] ] ].
	occurrences ifEmpty: [ ^ self ].
	^ self checkBrowseOccurrences: occurrences! !

!RBRemoveMethodRefactoring methodsFor: 'initialize-release' stamp: ''!
removeMethods: selectorCollection from: aClass 
	class := self classObjectFor: aClass.
	selectors := selectorCollection! !

!RBRemoveMethodRefactoring methodsFor: 'preconditions' stamp: 'NicolaiHess 11/28/2014 16:38'!
checkBrowseAllOccurences: anCollectionOfOccurrences
	| methods callers |
	methods := anCollectionOfOccurrences collect: [ :c | c key ] as: Set.
	callers := anCollectionOfOccurrences collect: [ :v | v value ].
	methods size = 1
		ifTrue: [ 
			self
				refactoringError:
					('Possible call to <2s> in <1p> methods.<n>Browse references?'
						expandMacrosWith: anCollectionOfOccurrences size
						with: methods anyOne)
				with: [ self openBrowserOn: (RBBrowserEnvironment new referencesTo: methods anyOne) ] ]
		ifFalse: [ 
			self
				refactoringError:
					('Possible call to the <2p> selectors in <1p> methods.<n>Browse references?'
						expandMacrosWith: callers size
						with: methods size)
				with: [ 
					| env |
					env := RBSelectorEnvironment new.
					callers do: [ :d | env addMethod: d method ].
					self openBrowserOn: env ] ]! !

!RBRemoveMethodRefactoring class methodsFor: 'instance creation' stamp: ''!
removeMethods: selectorCollection from: aClass
	^self new removeMethods: selectorCollection from: aClass! !

!RBRemoveMethodRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBSmalltalk removeMethods: selectorCollection from: aClass 
	^(self new)
		model: aRBSmalltalk;
		removeMethods: selectorCollection from: aClass;
		yourself! !

!RBRemoveMethodTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testRemoveReferenced
	self shouldFail: (RBRemoveMethodRefactoring 
			removeMethods: #(#checkClass: )
			from: RBBasicLintRuleTest)! !

!RBRemoveMethodTest methodsFor: 'accessing' stamp: 'TestRunner 1/3/2010 12:35'!
expectedFailures
	^ #(testRemoveSameMethodButSendsSuper)! !

!RBRemoveMethodTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testRemoveSameMethodButSendsSuper
	self shouldWarn: (RBRemoveMethodRefactoring 
			removeMethods: #(#new )
			from: RBBasicLintRuleTest class)! !

!RBRemoveMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testRemoveMethod
	| refactoring selectors |
	selectors := Array with: ('selectorNot' , 'Referenced') asSymbol.
	refactoring := RBRemoveMethodRefactoring 
		removeMethods: selectors
		from: RBRefactoryTestDataApp.
	self assert: ((refactoring model classNamed: #RBRefactoryTestDataApp) directlyDefinesMethod: selectors first).
	self executeRefactoring: refactoring.
	self deny: ((refactoring model classNamed: #RBRefactoryTestDataApp) directlyDefinesMethod: selectors first)! !

!RBRemoveMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testModelRecursiveMethodThatIsNotReferencedFromOtherMethods
	| class otherClass |
	class := model classNamed: #Object.
	class compile: 'someMethodThatIsNotReferenced ^2' classified: #(#accessing).
	self assert: (class definesMethod: #someMethodThatIsNotReferenced).
	otherClass := model metaclassNamed: self class superclass name.
	otherClass 
		compile: 'someMethodThatIsNotReferenced ^3 someMethodThatIsNotReferenced'
		classified: #(#accessing).
	model removeClassNamed: self class name.
	self executeRefactoring: (RBRemoveMethodRefactoring 
				model: model
				removeMethods: #(#someMethodThatIsNotReferenced)
				from: class).
	self deny: (class definesMethod: #someMethodThatIsNotReferenced)! !

!RBRemoveParameterRefactoring methodsFor: 'transforming' stamp: 'CamilloBruni 10/8/2012 00:02'!
hasReferencesToTemporaryIn: each 
	| tree |
	tree := each parseTreeFor: oldSelector.
	tree isNil ifTrue: [self refactoringFailure: 'Cannot parse sources.'].
	^tree references: (tree argumentNames at: parameterIndex)! !

!RBRemoveParameterRefactoring methodsFor: 'private' stamp: 'CamilloBruni 10/8/2012 00:03'!
computeNewSelector
	| keywords stream |
	oldSelector numArgs == 0 
		ifTrue: [self refactoringFailure: 'This method contains no arguments'].
	oldSelector isInfix 
		ifTrue: [self refactoringFailure: 'Cannot remove parameters of infix selectors'].
	keywords := oldSelector keywords asOrderedCollection.
	keywords size = 1 ifTrue: [^(keywords first copyWithout: $:) asSymbol].
	keywords removeAt: parameterIndex.
	stream := WriteStream on: ''.
	keywords do: [:each | stream nextPutAll: each].
	^stream contents asSymbol! !

!RBRemoveParameterRefactoring methodsFor: 'transforming' stamp: 'CamilloBruni 10/8/2012 00:03'!
getNewSelector
	| tree |
	(class directlyDefinesMethod: oldSelector)
		ifFalse: [self refactoringFailure: 'Method doesn''t exist'].
	tree := class parseTreeFor: oldSelector.
	tree isNil ifTrue: [self refactoringFailure: 'Cannot parse sources'].
	parameterIndex := tree argumentNames indexOf: argument ifAbsent: [self refactoringFailure: 'Select a parameter!!!!'].
	permutation := (1 to: oldSelector numArgs)
				copyWithout: parameterIndex.
	newSelector := self computeNewSelector! !

!RBRemoveParameterRefactoring methodsFor: 'preconditions' stamp: 'lr 3/9/2010 16:08'!
myConditions
	| imps |
	imps := self model allImplementorsOf: oldSelector.
	self getNewSelector.
	^imps inject: (RBCondition definesSelector: oldSelector in: class)
		into: 
			[:cond :each | 
			cond 
				& (RBCondition withBlock: [(self hasReferencesToTemporaryIn: each) not]
						errorString: 'This argument is still referenced in at least one implementor!!!!')]! !

!RBRemoveParameterRefactoring methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream
		nextPutAll: ' removeParameter: ''';
		nextPutAll: argument;
		nextPutAll: ''' in: '.
	class storeOn: aStream.
	aStream
		nextPutAll: ' selector: #';
		nextPutAll: oldSelector.
	aStream nextPut: $)! !

!RBRemoveParameterRefactoring methodsFor: 'initialize-release' stamp: ''!
removeParameter: aString in: aClass selector: aSelector 
	oldSelector := aSelector.
	class := self classObjectFor: aClass.
	argument := aString! !

!RBRemoveParameterRefactoring class methodsFor: 'instance creation' stamp: ''!
removeParameter: aString in: aClass selector: aSelector
	^self new removeParameter: aString in: aClass selector: aSelector! !

!RBRemoveParameterRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBSmalltalk removeParameter: aString in: aClass selector: aSelector 
	^(self new)
		model: aRBSmalltalk;
		removeParameter: aString
			in: aClass
			selector: aSelector;
		yourself! !

!RBRemoveParameterTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testPrimitiveMethods
	| refactoring |
	(model classNamed: #Object) 
		compile: 'foo123: a <primitive: 100> ^#() primitiveFailed'
		classified: #(#accessing).
	refactoring := RBRemoveParameterRefactoring 
				model: model
				removeParameter: 'a'
				in: Object
				selector: #foo123:.
	self shouldFail: refactoring! !

!RBRemoveParameterTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testRemoveParameter
	| refactoring class |
	refactoring := RBRemoveParameterRefactoring 
		removeParameter: 'anArg'
		in: RBRefactoryTestDataApp
		selector: ('rename' , 'ThisMethod:') asSymbol.
	self executeRefactoring: refactoring.
	class := refactoring model classNamed: #RBRefactoryTestDataApp.
	self assert: (class parseTreeFor: #renameThisMethod) = (RBParser parseMethod: 'renameThisMethod
								^self').
	self assert: (class parseTreeFor: #callMethod) = (RBParser parseMethod: 'callMethod
								^(self renameThisMethod)').
	self deny: (class directlyDefinesMethod: ('rename' , 'ThisMethod:') asSymbol)! !

!RBRemoveParameterTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testNonExistantName
	self
		shouldFail: (RBRemoveParameterRefactoring 
				removeParameter: 'asdf'
				in: RBBasicLintRuleTest
				selector: #checkClass:);
		shouldFail: (RBRemoveParameterRefactoring 
				removeParameter: 'aSmalllintContext'
				in: RBBasicLintRuleTest
				selector: #checkClass1:)! !

!RBRemovePoolVariableChange methodsFor: 'private' stamp: 'lr 9/6/2010 21:31'!
changeSymbol
	^ #removeSharedPool:! !

!RBRemovePoolVariableChange methodsFor: 'accessing' stamp: 'lr 10/15/2010 08:31'!
changeClass: aBehavior
	super changeClass: aBehavior.
	isMeta := false! !

!RBRemovePoolVariableChange methodsFor: 'printing' stamp: 'lr 4/7/2010 08:20'!
changeString
	^ 'Remove pool variable <1s> from <2s>' 
		expandMacrosWith: self variable
		with: self displayClassName! !

!RBRemovePoolVariableChange methodsFor: 'converting' stamp: 'lr 9/8/2011 20:10'!
asUndoOperation
	^ RBAddPoolVariableChange add: self variable to: self changeClass! !

!RBRenameClassChange methodsFor: 'comparing' stamp: 'lr 5/18/2010 20:56'!
hash
	^ (self class hash bitXor: self oldName hash) bitXor: self newName hash! !

!RBRenameClassChange methodsFor: '*NautilusRefactoring' stamp: ''!
nameToDisplay

	^ self printString! !

!RBRenameClassChange methodsFor: 'comparing' stamp: 'lr 9/6/2010 17:33'!
= aRenameClassChange 
	super class = aRenameClassChange class
		ifFalse: [ ^ false ].
	^oldName = aRenameClassChange oldName 
		and: [ newName = aRenameClassChange newName ]! !

!RBRenameClassChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 17:31'!
oldName
	^ oldName! !

!RBRenameClassChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 17:31'!
newName
	^ newName! !

!RBRenameClassChange methodsFor: 'printing' stamp: 'lr 2/7/2008 22:18'!
printOn: aStream 
	aStream
		nextPutAll: self oldName;
		nextPutAll: ' rename: ';
		print: self newName;
		nextPut: $!!! !

!RBRenameClassChange methodsFor: 'private' stamp: 'lr 9/6/2010 17:31'!
executeNotifying: aBlock 
	| undos |
	self changeClass rename: newName.
	undos := changes collect: [ :each | 
		(each renameChangesForClass: oldName asSymbol to: newName asSymbol) 
			executeNotifying: aBlock ].
	^ self copy
		changes: undos reverse;
		rename: newName to: oldName;
		yourself! !

!RBRenameClassChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 17:30'!
changeClass
	^ Smalltalk globals at: oldName asSymbol ifAbsent: [ Smalltalk globals at: newName asSymbol ]! !

!RBRenameClassChange methodsFor: '*NautilusRefactoring' stamp: 'NicolaiHess 12/8/2014 15:43'!
whatToDisplayIn: aChangeBrowser
"Although I am a composition, my subchanges can not be done without me - just show me"
	^ { self }! !

!RBRenameClassChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 13:57'!
renameChangesForClass: oldClassName to: newClassName
	| change |
	change := super renameChangesForClass: oldClassName to: newClassName.
	oldName asSymbol = oldClassName
		ifTrue: [ change rename: newClassName to: newName ].
	^ change! !

!RBRenameClassChange methodsFor: '*NautilusRefactoring' stamp: ''!
textToDisplay

	^ self printString! !

!RBRenameClassChange methodsFor: 'initialize-release' stamp: ''!
rename: oldString to: newString 
	oldName := oldString.
	newName := newString! !

!RBRenameClassChange class methodsFor: 'instance creation' stamp: 'lr 9/7/2010 19:43'!
rename: oldString to: newString 
	^ self new
		rename: oldString to: newString;
		yourself! !

!RBRenameClassRefactoring methodsFor: 'transforming' stamp: 'CamilloBruni 10/8/2012 00:02'!
renameReferences
	| replacer |
	replacer := (RBParseTreeRewriter replaceLiteral: className with: newName)
				replace: className with: newName;
				replaceArgument: newName
					withValueFrom: 
						[:aNode | 
						self 
							refactoringFailure: newName , ' already exists within the reference scope'];
				yourself.
	self model allReferencesToClass: class
		do: 
			[:method | 
			(method modelClass hierarchyDefinesVariable: newName) 
				ifTrue: 
					[self refactoringFailure: newName , ' is already defined in hierarchy of ' 
								, method modelClass printString].
			self 
				convertMethod: method selector
				for: method modelClass
				using: replacer]! !

!RBRenameClassRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^(RBCondition withBlock: [class notNil and: [class isMeta not]]
		errorString: className , ' is not a valid class name') 
			& (RBCondition isValidClassName: newName) 
			& (RBCondition isGlobal: newName in: self model) not! !

!RBRenameClassRefactoring methodsFor: 'initialize-release' stamp: ''!
className: aName newName: aNewName 
	className := aName asSymbol.
	class := self model classNamed: className.
	newName := aNewName asSymbol! !

!RBRenameClassRefactoring methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream nextPutAll: ' rename: '.
	class storeOn: aStream.
	aStream
		nextPutAll: ' to: #';
		nextPutAll: newName;
		nextPut: $)! !

!RBRenameClassRefactoring methodsFor: 'transforming' stamp: ''!
transform
	self model 
		renameClass: class
		to: newName
		around: [self renameReferences]! !

!RBRenameClassRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBSmalltalk rename: aClass to: aNewName 
	^(self new)
		model: aRBSmalltalk;
		className: aClass name newName: aNewName;
		yourself! !

!RBRenameClassRefactoring class methodsFor: 'instance creation' stamp: ''!
rename: aClass to: aNewName
	^self new className: aClass name newName: aNewName! !

!RBRenameClassTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testBadName
	self
		shouldFail: (RBRenameClassRefactoring 
				rename: RBLintRuleTest
				to: self objectClassVariable);
		shouldFail: (RBRenameClassRefactoring 
				rename: RBLintRuleTest
				to: #'Ob ject')! !

!RBRenameClassTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testRenameClass
	| refactoring class |
	refactoring := RBRenameClassRefactoring 
				rename: (Smalltalk at: ('RBClass' , 'ToRename') asSymbol)
				to: 'RBNew' , 'ClassName' asSymbol.
	self executeRefactoring: refactoring.
	self 
		assert: ((refactoring model classNamed: ('RBNew' , 'ClassName') asSymbol) 
				parseTreeFor: #method1) = (RBParser parseMethod: 'method1
	^self method2').
	self deny: (refactoring model 
				includesClassNamed: ('RBClass' , 'ToRename') asSymbol).
	class := refactoring model 
				classNamed: ('RBSubclass' , 'OfClassToRename') asSymbol.
	self assert: class superclass 
				= (refactoring model classNamed: ('RBNew' , 'ClassName') asSymbol).
	self assert: (class parseTreeFor: #symbolReference) 
				= (RBParser parseMethod: 'symbolReference
								^#RBNewClassName').
	self assert: (class parseTreeFor: #reference) 
				= (RBParser parseMethod: 'reference
								^RBNewClassName new')! !

!RBRenameClassTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testMetaClassFailure
	self 
		shouldFail: (RBRenameClassRefactoring rename: self class class to: #Foo)! !

!RBRenameClassTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testModelRenameSequenceClass
	model 
		defineClass: 'Object subclass: #Foo1 
			instanceVariableNames: '''' 
			classVariableNames: '''' poolDictionaries: ''''
			category: #''Refactory-Test data'''.
	(model classNamed: #Foo1)
		compile: 'foo	 ^ Foo1' classified: #(accessing);
		compile: 'objectName ^ #(Foo1)' classified: #(accessing).
	self executeRefactoring: (RBRenameClassRefactoring 
		model: model
		rename: (model classNamed: #Foo1)
		to: #Foo2).
	self executeRefactoring: (RBRenameClassRefactoring 
		model: model
		rename: (model classNamed: #Foo2)
		to: #Foo3).
	self deny: (model includesClassNamed: #Foo1).
	self deny: (model includesClassNamed: #Foo2).
	self assert: (model includesClassNamed: #Foo3).
	self assert: ((model classNamed: #Foo3) parseTreeFor: #foo) 
		= (RBParser parseMethod: 'foo ^ Foo3').
	self assert: ((model classNamed: #Foo3) parseTreeFor: #objectName) 
		= (RBParser parseMethod: 'objectName ^ #(Foo3)')! !

!RBRenameClassTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testExistingName
	self shouldFail: (RBRenameClassRefactoring rename: self class to: #Object)! !

!RBRenameClassTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testModelRenameClass
	| refactoring class |
	model 
		defineClass: 'Object subclass: #Foo instanceVariableNames: ''a'' classVariableNames: '''' poolDictionaries: '''' category: #''Refactory-Test data'''.
	class := model classNamed: #Foo.
	class
		compile: 'foo	^Object' classified: #(#accessing);
		compile: 'objectName ^#(Object)' classified: #(#accessing).
	refactoring := RBRenameClassRefactoring 
				model: model
				rename: Object
				to: #Thing.
	self executeRefactoring: refactoring.
	self assert: (model includesClassNamed: #Thing).
	self deny: (model includesClassNamed: #Object).
	self 
		assert: (class parseTreeFor: #foo) = (RBParser parseMethod: 'foo ^Thing').
	self assert: (class parseTreeFor: #objectName) 
				= (RBParser parseMethod: 'objectName ^#(Thing)').
	self assert: class superclass name = #Thing! !

!RBRenameClassVariableChange methodsFor: 'private' stamp: 'lr 9/8/2011 20:10'!
addNewVariable
	(RBAddClassVariableChange add: newName to: self changeClass)
		execute! !

!RBRenameClassVariableChange methodsFor: 'private' stamp: 'lr 9/6/2010 13:48'!
copyOldValuesToNewVariable
	| oldValue |
	oldValue := self changeClass classPool at: oldName ifAbsent: [ nil ].
	self changeClass classPool at: newName asSymbol put: oldValue! !

!RBRenameClassVariableChange methodsFor: 'printing' stamp: 'lr 5/18/2010 20:37'!
printOn: aStream 
	aStream
		nextPutAll: self displayClassName;
		nextPutAll: ' removeClassVarName: ';
		print: self oldName;
		nextPut: $!!; cr.
	aStream
		nextPutAll: self displayClassName; 
		nextPutAll: ' addClassVarName: '; 
		print: self newName;
		nextPut: $!!! !

!RBRenameClassVariableChange methodsFor: 'private' stamp: 'lr 9/8/2011 20:10'!
removeOldVariable
	(RBRemoveClassVariableChange remove: oldName from: self changeClass)
		execute! !

!RBRenameClassVariableRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'!
renameReferences
	| replacer subclasses |
	replacer := RBParseTreeRewriter 
		rename: variableName
		to: newName
		handler: 
			[ self refactoringError: ('<1s> is already defined as a method or block temporary <n> variable in this class or one of its subclasses' expandMacrosWith: newName) ].
	subclasses := class withAllSubclasses asSet.
	subclasses addAll: class theMetaClass withAllSubclasses.
	self 
		convertClasses: subclasses
		select: [ :aClass | aClass whichSelectorsReferToClassVariable: variableName ]
		using: replacer! !

!RBRenameClassVariableRefactoring methodsFor: 'initialize-release' stamp: ''!
rename: aVarName to: aName in: aClass
	self variable: aVarName class: aClass.
	newName := aName! !

!RBRenameClassVariableRefactoring methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream
		nextPutAll: ' rename: ''';
		nextPutAll: variableName;
		nextPutAll: ''' to: ''';
		nextPutAll: newName;
		nextPutAll: ''' in: '.
	class storeOn: aStream.
	aStream nextPut: $)! !

!RBRenameClassVariableRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^(RBCondition isMetaclass: class) not 
		& (RBCondition isValidClassVarName: newName asString for: class) 
			& (RBCondition definesClassVariable: variableName asString in: class) 
			& (RBCondition hierarchyOf: class definesVariable: newName asString) not 
			& (RBCondition isGlobal: newName asString in: self model) not! !

!RBRenameClassVariableRefactoring methodsFor: 'transforming' stamp: ''!
transform
	class 
		renameClassVariable: variableName
		to: newName
		around: [self renameReferences]! !

!RBRenameClassVariableRefactoring class methodsFor: 'instance creation' stamp: ''!
rename: aVarName to: aName in: aClass
	^self new
		rename: aVarName
		to: aName
		in: aClass! !

!RBRenameClassVariableRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBSmalltalk rename: aVarName to: aName in: aClass 
	^(self new)
		model: aRBSmalltalk;
		rename: aVarName
			to: aName
			in: aClass;
		yourself! !

!RBRenameClassVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testMetaClassFailure
	self shouldFail: (RBRenameClassVariableRefactoring 
			rename: #RecursiveSelfRule
			to: #Foo
			in: RBTransformationRuleTest class)! !

!RBRenameClassVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testNonExistantName
	self shouldFail: (RBRenameClassVariableRefactoring 
			rename: #foo
			to: #newFoo
			in: RBBasicLintRuleTest)! !

!RBRenameClassVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testRenameClassVar
	| refactoring class |
	refactoring := RBRenameClassVariableRefactoring 
		rename: #RecursiveSelfRule
		to: #RSR
		in: RBTransformationRuleTest.
	self executeRefactoring: refactoring.
	class := refactoring model classNamed: #RBTransformationRuleTest.
	self assert: (class directlyDefinesClassVariable: #RSR).
	self deny: (class directlyDefinesClassVariable: #RecursiveSelfRule).
	self assert: (class theMetaClass parseTreeFor: #initializeAfterLoad1) = (RBParser parseMethod: 'initializeAfterLoad1
								RSR := RBParseTreeSearcher new.
								RSR
									addMethodSearches: #(''`@methodName: `@args | `@temps | self `@methodName: `@args'' ''`@methodName: `@args | `@temps | ^self `@methodName: `@args'')
											-> [:aNode :answer | true]').
	self assert: (class theMetaClass parseTreeFor: #nuke) = (RBParser parseMethod: 'nuke
								RSR := nil').
	self assert: (class parseTreeFor: #checkMethod:) = (RBParser parseMethod: 'checkMethod: aSmalllintContext 
								class := aSmalllintContext selectedClass.
								(rewriteRule executeTree: aSmalllintContext parseTree) ifTrue: 
										[(RSR executeTree: rewriteRule tree initialAnswer: false)
											ifFalse: 
												[builder compile: rewriteRule tree printString
													in: class
													classified: aSmalllintContext protocols]]')! !

!RBRenameClassVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testAlreadyExistingName
	self shouldFail: (RBRenameClassVariableRefactoring 
			rename: #RecursiveSelfRule
			to: self objectClassVariable
			in: RBTransformationRuleTest)! !

!RBRenameInstanceVariableChange methodsFor: 'private' stamp: 'lr 9/8/2011 20:10'!
addNewVariable
	(RBAddInstanceVariableChange add: newName to: self changeClass)
		execute! !

!RBRenameInstanceVariableChange methodsFor: 'private' stamp: 'lr 9/6/2010 13:48'!
copyOldValuesToNewVariable
	| newIndex oldIndex |
	oldIndex := self changeClass allInstVarNames indexOf: oldName asString.
	newIndex := self changeClass allInstVarNames indexOf: newName asString.
	self changeClass withAllSubclasses do: [ :class |
		class allInstances 
			do: [ :each | each instVarAt: newIndex put: (each instVarAt: oldIndex) ] ]! !

!RBRenameInstanceVariableChange methodsFor: 'printing' stamp: 'lr 5/18/2010 20:39'!
printOn: aStream
	aStream
		nextPutAll: self displayClassName;
		nextPutAll: ' removeInstVarName: ';
		print: self oldName;
		nextPut: $!!; cr.
	aStream
		nextPutAll: self displayClassName;
		nextPutAll: ' addInstVarName: ';
		print: self newName;
		nextPut: $!!! !

!RBRenameInstanceVariableChange methodsFor: 'private' stamp: 'lr 9/8/2011 20:10'!
removeOldVariable
	(RBRemoveInstanceVariableChange remove: oldName from: self changeClass) 
		execute! !

!RBRenameInstanceVariableRefactoring methodsFor: 'refactoring' stamp: 'MarkRizun 7/17/2014 16:37'!
executeRefactoring: aRefactoring 
	aRefactoring primitiveExecute.
	RBParser parseExpression: aRefactoring storeString! !

!RBRenameInstanceVariableRefactoring methodsFor: 'refactoring' stamp: 'MarkRizun 7/17/2014 16:37'!
browsedEnvironment
	^ browsedEnvironment ifNil: [ browsedEnvironment := RBBrowserEnvironment new ]! !

!RBRenameInstanceVariableRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^(RBCondition isValidInstanceVariableName: newName for: class) 
		& (RBCondition definesInstanceVariable: variableName in: class) 
			& (RBCondition hierarchyOf: class definesVariable: newName) not 
			& (RBCondition isGlobal: newName in: self model) not! !

!RBRenameInstanceVariableRefactoring methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream
		nextPutAll: ' rename: ''';
		nextPutAll: variableName;
		nextPutAll: ''' to: ''';
		nextPutAll: newName;
		nextPutAll: ''' in: '.
	class storeOn: aStream.
	aStream nextPut: $)! !

!RBRenameInstanceVariableRefactoring methodsFor: 'transforming' stamp: 'JanKurs 1/29/2015 16:30'!
transform
	renameAccessors ifTrue: [ 
		self removeOldAccessors 
	].
	
	class renameInstanceVariable: variableName to: newName around: [ self renameReferences ].
	
	renameAccessors ifTrue: [ 
		self addNewAccessors.
		self renameAccessorsReferences
	]! !

!RBRenameInstanceVariableRefactoring methodsFor: 'transforming' stamp: 'MarkRizun 7/21/2014 17:00'!
renameAccessorsReferences
	| methods senders |
	methods := (class allSelectors select: [ :each | ((class methodFor: each) = nil) not ] thenCollect: [ :each | each ])
		asOrderedCollection.
	senders := (methods
		select: [ :each | (class methodFor: each) source includesSubstring: variableName asString ]
		thenCollect: [ :each | class methodFor: each ]) asOrderedCollection.
	senders
		do: [ :each | each source: (each source copyReplaceAll: variableName asString with: newName asString asTokens: false) ].
	senders
		do: [ :each | 
			(each selector = newName or: [ each selector asString = (newName asString , ':') ])
				ifFalse: [ (model classNamed: class name) compile: each source classified: each protocols ] ]! !

!RBRenameInstanceVariableRefactoring methodsFor: 'transforming' stamp: 'MarkRizun 7/18/2014 12:58'!
removeOldAccessors
	| oldAccessors |
	oldAccessors := (class allSelectors
		select: [ :each | each = variableName asSymbol or: [ each = (variableName , ':') asSymbol ] ]
		thenCollect: [ :each | class methodFor: each ]) asOrderedCollection.
	oldAccessors do: [ :each | class removeMethod: each selector ]! !

!RBRenameInstanceVariableRefactoring methodsFor: 'initialize-release' stamp: 'MarcusDenker 2/27/2015 10:57'!
rename: aVarName to: aName in: aClass
	self rename: aVarName to: aName in: aClass renameAccessors: false
! !

!RBRenameInstanceVariableRefactoring methodsFor: 'transforming' stamp: 'MarkRizun 7/18/2014 13:00'!
addNewAccessors
	| refactoring |
	refactoring := RBCreateAccessorsForVariableRefactoring
		model: self
		variable: newName asString
		class: class
		classVariable: false.
	refactoring
		createGetterAccessor;
		createSetterAccessor! !

!RBRenameInstanceVariableRefactoring methodsFor: 'initialize-release' stamp: 'JanKurs 1/29/2015 16:29'!
rename: aVarName to: aName in: aClass renameAccessors: aBoolean
	self variable: aVarName class: aClass.
	newName := aName.
	renameAccessors := aBoolean! !

!RBRenameInstanceVariableRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'!
renameReferences
	| replacer |
	replacer := RBParseTreeRewriter 
				rename: variableName
				to: newName
				handler: 
					[self 
						refactoringError: ('<1s> is already defined as a method or block temporary <n> variable in this class or one of its subclasses' 
								expandMacrosWith: newName)].
	self 
		convertClasses: class withAllSubclasses
		select: [:aClass | aClass whichSelectorsReferToInstanceVariable: variableName]
		using: replacer! !

!RBRenameInstanceVariableRefactoring class methodsFor: 'instance creation' stamp: 'JanKurs 1/29/2015 16:29'!
model: aRBSmalltalk rename: aVarName to: aName in: aClass renameAccessors: aBoolean
	^(self new)
		model: aRBSmalltalk;
		rename: aVarName
			to: aName
			in: aClass
			renameAccessors: aBoolean;
		yourself! !

!RBRenameInstanceVariableRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBSmalltalk rename: aVarName to: aName in: aClass 
	^(self new)
		model: aRBSmalltalk;
		rename: aVarName
			to: aName
			in: aClass;
		yourself! !

!RBRenameInstanceVariableRefactoring class methodsFor: 'instance creation' stamp: ''!
rename: aVarName to: aName in: aClass
	^self new
		rename: aVarName
		to: aName
		in: aClass! !

!RBRenameInstanceVariableRefactoring class methodsFor: 'instance creation' stamp: 'JanKurs 1/29/2015 16:29'!
rename: aVarName to: aName in: aClass renameAccessors: aBoolean
	^self new
		rename: aVarName
		to: aName
		in: aClass
		renameAccessors: aBoolean! !

!RBRenameInstanceVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testNonExistantName
	self shouldFail: (RBRenameInstanceVariableRefactoring 
			rename: 'foo'
			to: 'newFoo'
			in: RBBasicLintRuleTest)! !

!RBRenameInstanceVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testAlreadyExistingName
	self shouldFail: (RBRenameInstanceVariableRefactoring 
			rename: 'classBlock'
			to: 'name'
			in: RBBasicLintRuleTest)! !

!RBRenameInstanceVariableTest methodsFor: 'tests' stamp: 'JanKurs 1/29/2015 16:28'!
testRenameInstVarNotAccessors
	| refactoring class |
	refactoring := RBRenameInstanceVariableRefactoring rename: 'result' to: 'whatever' in: RBBasicLintRuleTest renameAccessors: false.
	self executeRefactoring: refactoring.
	class := refactoring model classNamed: #RBBasicLintRuleTest.
	self assert: (class directlyDefinesInstanceVariable: 'whatever').
	self deny: (class directlyDefinesInstanceVariable: 'result').
	
	self deny: (class definesMethod: #whatever).
	self deny: (class definesMethod: #whatever:).
	self assert: (class definesMethod: #result).
! !

!RBRenameInstanceVariableTest methodsFor: 'tests' stamp: 'MarkRizun 7/18/2014 10:50'!
testRenameInstVar
	| refactoring class |
	refactoring := RBRenameInstanceVariableRefactoring rename: 'classBlock' to: 'asdf' in: RBBasicLintRuleTest.
	self executeRefactoring: refactoring.
	class := refactoring model classNamed: #RBBasicLintRuleTest.
	self assert: (class directlyDefinesInstanceVariable: 'asdf').
	self deny: (class directlyDefinesInstanceVariable: 'classBlock').
	self
		assert:
			(class parseTreeFor: #checkClass:)
				=
					(RBParser
						parseMethod:
							'checkClass: aSmalllintContext 
								^asdf value: aSmalllintContext value: result').
	self
		assert:
			(class parseTreeFor: #initialize)
				=
					(RBParser
						parseMethod:
							'initialize
	super initialize.
	self anInstVar: 1.
	asdf := [:context :aResult | ].
	methodBlock := [:context :aResult | ].
	self resultClass: RBSelectorEnvironment')! !

!RBRenameMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'!
parseTreeRewriter
	| rewriteRule oldString newString |
	oldString := self buildSelectorString: oldSelector.
	newString := self buildSelectorString: newSelector
				withPermuteMap: permutation.
	rewriteRule := self hasPermutedArguments 
				ifTrue: [RBParseTreeRewriter new]
				ifFalse: [RBParseTreeRewriter replaceLiteral: oldSelector with: newSelector].
	rewriteRule replace: '``@object ' , oldString
		with: '``@object ' , newString.
	^rewriteRule! !

!RBRenameMethodRefactoring methodsFor: 'testing' stamp: ''!
hasPermutedArguments
	^hasPermutedArguments isNil 
		ifTrue: [hasPermutedArguments := super hasPermutedArguments]
		ifFalse: [hasPermutedArguments]! !

!RBRenameMethodRefactoring methodsFor: 'preconditions' stamp: 'CamilloBruni 10/7/2012 23:32'!
preconditions
	| newCondition |
	newCondition := (RBCondition 
							withBlock: [newSelector = oldSelector]
							errorString: 'The selectors are <1?:not >equivalent') 
						& (RBCondition 
							withBlock: [permutation asArray ~= (1 to: oldSelector numArgs) asArray]
							errorString: 'The arguments are <1?:not >permuted').
	^newCondition | super preconditions! !

!RBRenameMethodRefactoring methodsFor: 'preconditions' stamp: ''!
myConditions
	^RBCondition withBlock: [oldSelector numArgs = newSelector numArgs]
		errorString: newSelector printString 
				, ' doesn''t have the correct number of arguments.'! !

!RBRenameMethodRefactoring methodsFor: 'printing' stamp: 'lr 3/9/2010 16:09'!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream
		nextPutAll: ' renameMethod: #';
		nextPutAll: oldSelector;
		nextPutAll: ' in: '.
	class storeOn: aStream.
	aStream
		nextPutAll: ' to: #';
		nextPutAll: newSelector;
		nextPutAll: ' permutation: '.
	permutation storeOn: aStream.
	aStream nextPut: $)! !

!RBRenameMethodRefactoring methodsFor: 'testing' stamp: ''!
implementorsCanBePrimitives
	^self hasPermutedArguments not! !

!RBRenameMethodRefactoring class methodsFor: 'instance creation' stamp: 'md 3/15/2006 17:26'!
renameMethod: aSelector in: aClass to: newSelector permutation: aMap 
	^self new renameMethod: aSelector
		in: aClass
		to: newSelector
		permutation: aMap! !

!RBRenameMethodRefactoring class methodsFor: 'instance creation' stamp: 'md 3/15/2006 17:29'!
model: aRBSmalltalk renameMethod: aSelector in: aClass to: newSelector permutation: aMap 
	^(self new)
		model: aRBSmalltalk;
		renameMethod: aSelector
			in: aClass
			to: newSelector
			permutation: aMap;
		yourself! !

!RBRenameMethodTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testExistingSelector
	self shouldFail: (RBRenameMethodRefactoring 
			renameMethod: #checkClass:
			in: RBBasicLintRuleTest
			to: #runOnEnvironment:
			permutation: (1 to: 1))! !

!RBRenameMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testRenamePrimitive
	| refactoring count |
	count := 0.
	model allReferencesTo: #basicAt:put: do: [:method | count := count + 1].
	refactoring := RBRenameMethodRefactoring 
				model: model
				renameMethod: #basicAt:put:
				in: Object
				to: ('at:' , 'bar:') asSymbol
				permutation: (1 to: 2).
	self proceedThroughWarning: [self executeRefactoring: refactoring].
	model allReferencesTo: #basicAt:put:
		do: 
			[:method | 
			count := count - 1.
			self assert: method source isNil].
	model allReferencesTo: ('at:' , 'bar:') asSymbol
		do: [:method | count := count - 1].
	self assert: count = 0! !

!RBRenameMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testRenameTestMethod
	| refactoring class |
	refactoring := RBRenameMethodRefactoring 
		renameMethod: ('rename' , 'ThisMethod:') asSymbol
		in: RBRefactoryTestDataApp
		to: #renameThisMethod2:
		permutation: (1 to: 1).
	self executeRefactoring: refactoring.
	class := refactoring model classNamed: #RBRefactoryTestDataApp.
	self assert: (class parseTreeFor: #renameThisMethod2:) = (RBParser parseMethod: 'renameThisMethod2: anArg
	^self').
	self assert: (class parseTreeFor: #callMethod) = (RBParser parseMethod: 'callMethod
	^(self renameThisMethod2: 5)').
	self assert: (class parseTreeFor: #symbolReference) = (RBParser parseMethod: 'symbolReference
		^ #(#renameThisMethod2: #(4 #renameThisMethod2:))').
	self deny: (class directlyDefinesMethod: ('rename' , 'ThisMethod:') asSymbol)! !

!RBRenameMethodTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testRenamePermuteArgs
	| refactoring class |
	refactoring := RBRenameMethodRefactoring 
		renameMethod: ('rename:' , 'two:') asSymbol
		in: RBRefactoryTestDataApp
		to: ('rename:' , 'two:') asSymbol
		permutation: #(2 1 ).
	self executeRefactoring: refactoring.
	class := refactoring model classNamed: #RBRefactoryTestDataApp.
	self assert: (class parseTreeFor: ('rename:' , 'two:') asSymbol) = (RBParser parseMethod: 'rename: argumentMethod two: this ^self printString, this, argumentMethod').
	self assert: (class parseTreeFor: #exampleCall) = (RBParser parseMethod: 'exampleCall ^self rename: 2 two: 1')! !

!RBRenameMethodTest methodsFor: 'tests' stamp: 'MarkRizun 8/26/2014 13:16'!
testRenameTestMethod1
	| refactoring class |
	refactoring := RBRenameMethodRefactoring 
		renameMethod: ('testMethod1') asSymbol
		in: RBRefactoryTestDataApp
		to: #testMethod2
		permutation: (1 to: 0).
	self executeRefactoring: refactoring.
	class := refactoring model classNamed: #RBRefactoryTestDataApp.
	self assert: (class parseTreeFor: #testMethod2) = (RBParser parseMethod: 'testMethod2
	^self testMethod2 , ([:each | each testMethod2] value: #(#(#testMethod2) 2 #testMethod2))').
	self assert: ((refactoring model classNamed: #RBBasicLintRuleTest) parseTreeFor: #classBlock:) = (RBParser parseMethod: 'classBlock: aBlock
	classBlock := aBlock testMethod2').
	self deny: (class directlyDefinesMethod: ('test' , 'Method1') asSymbol)! !

!RBRenameMethodTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testMultipleSelectors
	self shouldWarn: (RBRenameMethodRefactoring 
			renameMethod: #checkClass:
			in: RBBasicLintRuleTest
			to: #foo:
			permutation: (1 to: 1))! !

!RBRenameMethodTest methodsFor: 'tests' stamp: 'MarcusDenker 8/28/2014 10:12'!
testRenameMethodPermuteArgs
	| refactoring class |
	refactoring := RBRenameMethodRefactoring
		renameMethod: ('demoRenameMethod:' , 'PermuteArgs:') asSymbol
		in: RBRefactoryTestDataApp
		to: ('demoRenameMethod:' , 'PermuteArgs:') asSymbol
		permutation: #(2 1).
	self executeRefactoring: refactoring.
	class := refactoring model classNamed: #RBRefactoryTestDataApp.
	self
		assert:
			(class parseTreeFor: ('demoRenameMethod:' , 'PermuteArgs:') asSymbol)
				=
					(RBParser
						parseMethod:
							'demoRenameMethod: arg2 PermuteArgs: arg1 self do: arg1.
	self do: arg2.
	^ arg1 > arg2').
	self
		assert:
			(class parseTreeFor: #demoExampleCall)
				= (RBParser parseMethod: 'demoExampleCall ^self demoRenameMethod: 2 PermuteArgs: 1')! !

!RBRenameTemporaryRefactoring methodsFor: 'initialize-release' stamp: ''!
class: aClass selector: aSelector interval: anInterval newName: aString 
	class := self classObjectFor: aClass.
	selector := aSelector.
	interval := anInterval.
	newName := aString! !

!RBRenameTemporaryRefactoring methodsFor: 'preconditions' stamp: 'CamilloBruni 10/8/2012 00:02'!
preconditions
	^(RBCondition definesSelector: selector in: class) 
		& (RBCondition isValidInstanceVariableName: newName for: class) 
			& (RBCondition definesInstanceVariable: newName in: class) not 
			& (RBCondition definesClassVariable: newName in: class) not 
			& (RBCondition withBlock: 
						[| methodSource |
						interval first > interval last 
							ifTrue: [self refactoringFailure: 'Invalid variable name'].
						methodSource := class sourceCodeFor: selector.
						methodSource size >= interval last 
							ifFalse: [self refactoringFailure: 'Invalid range for variable'].
						oldName := methodSource copyFrom: interval first to: interval last.
						true])! !

!RBRenameTemporaryRefactoring methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream nextPutAll: ' renameTemporaryFrom: '.
	interval storeOn: aStream.
	aStream
		nextPutAll: ' to: ''';
		nextPutAll: newName;
		nextPutAll: ''' in: '.
	class storeOn: aStream.
	aStream
		nextPutAll: ' selector: #';
		nextPutAll: selector.
	aStream nextPut: $)! !

!RBRenameTemporaryRefactoring methodsFor: 'tranforming' stamp: 'CamilloBruni 10/8/2012 00:01'!
renameNode: aParseTree 
	(aParseTree whoDefines: newName) notNil 
		ifTrue: [self refactoringError: newName , ' is already defined'].
	(aParseTree allDefinedVariables includes: newName) 
		ifTrue: [self refactoringError: newName , ' is already defined'].
	(RBParseTreeRewriter rename: oldName to: newName) executeTree: aParseTree! !

!RBRenameTemporaryRefactoring methodsFor: 'tranforming' stamp: 'CamilloBruni 10/8/2012 00:01'!
transform
	| definingNode variableNode |
	parseTree := class parseTreeFor: selector.
	variableNode := self 
				whichVariableNode: parseTree
				inInterval: interval
				name: oldName.
	(variableNode isNil or: [variableNode isVariable not]) 
		ifTrue: [self refactoringFailure: oldName , ' isn''t a valid variable'].
	variableNode name = oldName 
		ifFalse: [self refactoringFailure: 'Invalid selection'].
	definingNode := variableNode whoDefines: oldName.
	definingNode isNil 
		ifTrue: [self refactoringFailure: oldName , ' isn''t defined by the method'].
	self renameNode: definingNode.
	class compileTree: parseTree! !

!RBRenameTemporaryRefactoring class methodsFor: 'instance creation' stamp: ''!
renameTemporaryFrom: anInterval to: newName in: aClass selector: aSelector 
	^self new
		class: aClass
		selector: aSelector
		interval: anInterval
		newName: newName! !

!RBRenameTemporaryRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBSmalltalk renameTemporaryFrom: anInterval to: newName in: aClass selector: aSelector 
	^(self new)
		model: aRBSmalltalk;
		class: aClass
			selector: aSelector
			interval: anInterval
			newName: newName;
		yourself! !

!RBRenameTemporaryTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testBadName
	self
		shouldFail: (RBRenameTemporaryRefactoring 
				renameTemporaryFrom: (self 
						convertInterval: (15 to: 19)
						for: (RBLintRuleTest sourceCodeAt: #openEditor))
				to: 'name'
				in: RBLintRuleTest
				selector: #openEditor);
		shouldFail: (RBRenameTemporaryRefactoring 
				renameTemporaryFrom: (self 
						convertInterval: (15 to: 19)
						for: (RBLintRuleTest sourceCodeAt: #openEditor))
				to: 'rules'
				in: RBLintRuleTest
				selector: #openEditor);
		shouldFail: (RBRenameTemporaryRefactoring 
				renameTemporaryFrom: (self 
						convertInterval: (15 to: 19)
						for: (RBLintRuleTest sourceCodeAt: #openEditor))
				to: 'DependentFields'
				in: RBLintRuleTest
				selector: #openEditor);
		shouldFail: (RBRenameTemporaryRefactoring 
				renameTemporaryFrom: (self 
						convertInterval: (15 to: 19)
						for: (RBLintRuleTest sourceCodeAt: #openEditor))
				to: 'a b'
				in: RBLintRuleTest
				selector: #openEditor)! !

!RBRenameTemporaryTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testRenameTemporary
	| refactoring |
	refactoring := RBRenameTemporaryRefactoring 
		renameTemporaryFrom: (self 
				convertInterval: (15 to: 19)
				for: (RBLintRuleTest sourceCodeAt: #openEditor))
		to: 'asdf'
		in: RBLintRuleTest
		selector: #openEditor.
	self executeRefactoring: refactoring.
	self assert: ((refactoring model classNamed: #RBLintRuleTest) parseTreeFor: #openEditor) = (RBParser parseMethod: 'openEditor
								| asdf |
								asdf := self failedRules.
								asdf isEmpty ifTrue: [^self].
								asdf size == 1 ifTrue: [^asdf first viewResults]')! !

!RBRenameTemporaryTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testBadInterval
	self shouldFail: (RBRenameTemporaryRefactoring 
			renameTemporaryFrom: (self 
					convertInterval: (14 to: 17)
					for: (RBRefactoryTestDataApp sourceCodeAt: #testMethod))
			to: 'asdf'
			in: RBRefactoryTestDataApp
			selector: #testMethod)! !

!RBRenameTemporaryTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testModelBadName
	| class |
	model := RBNamespace new.
	class := model classNamed: #Object.
	class 
		compile: 'aMethod: temp1 ^[| temp2 | temp2 := [:temp3 | temp3 = 5] value: 5. temp2] value'
		classified: #(#accessing).
	self
		shouldFail: (RBRenameTemporaryRefactoring 
					renameTemporaryFrom: (20 to: 24)
					to: 'temp3'
					in: class
					selector: #aMethod:);
		shouldFail: (RBRenameTemporaryRefactoring 
					renameTemporaryFrom: (20 to: 24)
					to: 'temp1'
					in: class
					selector: #aMethod:)! !

!RBRenameVariableChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 17:32'!
changeClassName: aSymbol
	className := aSymbol.
	isMeta isNil
		ifTrue: [ isMeta := false ]! !

!RBRenameVariableChange methodsFor: 'printing' stamp: 'lr 9/6/2010 21:17'!
displayClassName
	^ isMeta
		ifTrue: [ self changeClassName , ' class' ]
		ifFalse: [ self changeClassName asString ]! !

!RBRenameVariableChange methodsFor: 'comparing' stamp: 'lr 9/6/2010 17:33'!
hash
	^ (self class hash bitXor: self oldName hash) bitXor: self newName hash! !

!RBRenameVariableChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 17:32'!
changeClassName
	^ className! !

!RBRenameVariableChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 17:32'!
oldName
	^ oldName! !

!RBRenameVariableChange methodsFor: 'private' stamp: 'lr 9/6/2010 13:46'!
isMeta
	^ isMeta! !

!RBRenameVariableChange methodsFor: 'private' stamp: 'lr 9/6/2010 13:46'!
executeNotifying: aBlock 
	| undo |
	self addNewVariable.
	self copyOldValuesToNewVariable.
	undo := super executeNotifying: aBlock.
	undo
		oldName: newName;
		newName: oldName.
	self removeOldVariable.
	^ undo! !

!RBRenameVariableChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 17:32'!
changeClass
	| class |
	class := Smalltalk globals at: self changeClassName ifAbsent: [ ^ nil ].
	^ isMeta ifTrue: [ class class ] ifFalse: [ class ]! !

!RBRenameVariableChange methodsFor: 'private' stamp: ''!
addNewVariable
	self subclassResponsibility! !

!RBRenameVariableChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 17:32'!
changeClass: aBehavior
	isMeta := aBehavior isMeta.
	className := isMeta
		ifTrue: [ aBehavior soleInstance name ]
		ifFalse: [ aBehavior name ]! !

!RBRenameVariableChange methodsFor: 'printing' stamp: 'lr 9/6/2010 17:34'!
changeString
	^ 'Rename ' , oldName , ' to ' , newName! !

!RBRenameVariableChange methodsFor: 'private' stamp: ''!
copyOldValuesToNewVariable
	self subclassResponsibility! !

!RBRenameVariableChange methodsFor: 'private' stamp: ''!
oldName: aString
	oldName := aString! !

!RBRenameVariableChange methodsFor: '*NautilusRefactoring' stamp: ''!
nameToDisplay

	^ 'Rename ', self oldName, ' into ', self newName! !

!RBRenameVariableChange methodsFor: 'comparing' stamp: 'lr 9/6/2010 17:34'!
= aRenameVariableChange 
	self class = aRenameVariableChange class 
		ifFalse: [ ^ false ].
	^ className = aRenameVariableChange changeClassName 
		and: [ isMeta = aRenameVariableChange isMeta 
		and: [ oldName = aRenameVariableChange oldName 
		and: [ newName = aRenameVariableChange newName ] ] ]! !

!RBRenameVariableChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 17:32'!
newName
	^ newName! !

!RBRenameVariableChange methodsFor: 'printing' stamp: 'lr 9/6/2010 13:55'!
printOn: aStream
	aStream nextPutAll: self displayString! !

!RBRenameVariableChange methodsFor: 'private' stamp: ''!
newName: aString 
	newName := aString! !

!RBRenameVariableChange methodsFor: 'private' stamp: ''!
removeOldVariable
	self subclassResponsibility! !

!RBRenameVariableChange methodsFor: '*NautilusRefactoring' stamp: ''!
whatToDisplayIn: aChangeBrowser

	| result |
	result := OrderedCollection with: self.
	^ result, (self changes gather: [:e | e changes ])! !

!RBRenameVariableChange methodsFor: '*NautilusRefactoring' stamp: ''!
textToDisplay

	self printString! !

!RBRenameVariableChange class methodsFor: 'instance creation' stamp: 'lr 9/7/2010 19:43'!
rename: oldName to: newName in: aClass 
	^ self new
		oldName: oldName;
		newName: newName;
		changeClass: aClass;
		yourself! !

!RBRepeteadMethodsInTheSuperclassRule commentStamp: 'StephaneDucasse 11/29/2014 20:26'!
If a class is overriding a method, it should use a different code. Is meaningless to have a method in a class and in its superclass!
!RBRepeteadMethodsInTheSuperclassRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:50'!
checkClass: aClass
	"The comparison between methods is made using the ast, this is better than comparing source code only since it does not take into account identations, extra parenthesis, etc"

	| selectedClass |
	selectedClass := aClass.
	selectedClass
		methodsDo: [ :method | 
			| selector |
			selector := method selector.
			self 
				find: selector
				inSuperclassesOf: selectedClass
				do: [ :overriddenSuperclass |
					method ast = (overriddenSuperclass >> selector) ast
						ifTrue: [ result addClass: selectedClass selector: selector ] ] ]! !

!RBRepeteadMethodsInTheSuperclassRule methodsFor: 'accessing' stamp: 'SebastianTleye 7/19/2013 13:40'!
name
	^ 'Repeated method in the superclasses'! !

!RBRepeteadMethodsInTheSuperclassRule methodsFor: 'accessing' stamp: 'MarcusDenker 11/11/2014 16:03'!
category 
    ^ 'Optimization'! !

!RBRepeteadMethodsInTheSuperclassRule methodsFor: 'running' stamp: 'CamilloBruni 8/28/2013 03:12'!
find: selector inSuperclassesOf: selectedClass do: aBlock
	selectedClass allSuperclassesDo: [ :superclass | 
		(superclass includesSelector: selector)
			ifTrue: [ ^ aBlock value: superclass ]]! !

!RBRepeteadMethodsInTheSuperclassRule class methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 20:31'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'RepeatedMethodInTheSuperclass'! !

!RBReplaceRule commentStamp: 'md 8/9/2005 14:56'!
RBReplaceRule is the abstract superclass of all of the transforming rules. The rules change the source code by replacing the node that matches the rule. Subclasses implement different strategies for this replacement.

Subclasses must implement the following messages:
	matching
		foundMatchFor:

Instance Variables:
	verificationBlock	<BlockClosure>	Is evaluated with the matching node. This allows for further verification of a match beyond simple tree matching.

!
!RBReplaceRule methodsFor: 'initialization' stamp: ''!
initialize
	super initialize.
	verificationBlock := [:aNode | true]! !

!RBReplaceRule methodsFor: 'matching' stamp: ''!
replace: aProgramNode with: newNode 
	aProgramNode replaceMethodSource: newNode! !

!RBReplaceRule methodsFor: 'matching' stamp: 'StephaneDucasse 3/29/2013 18:00'!
searchFor: searchString replaceWith: replaceString 

	self subclassResponsibility! !

!RBReplaceRule methodsFor: 'matching' stamp: ''!
canMatch: aProgramNode 
	^verificationBlock value: aProgramNode! !

!RBReplaceRule methodsFor: 'matching' stamp: 'StephaneDucasse 3/29/2013 18:01'!
searchForMethod: searchString replaceWith: replaceString 

	self subclassResponsibility! !

!RBReplaceRule methodsFor: 'matching' stamp: 'StephaneDucasse 3/29/2013 18:01'!
searchForTree: aBRProgramNode replaceWith: replaceNode 

	self subclassResponsibility! !

!RBReplaceRule methodsFor: 'matching' stamp: 'StephaneDucasse 3/29/2013 18:01'!
searchForTree: aBRProgramNode replaceWith: replaceString when: aBlock 

	self subclassResponsibility! !

!RBReplaceRule methodsFor: 'matching' stamp: ''!
foundMatchFor: aProgramNode 
	self subclassResponsibility! !

!RBReplaceRule methodsFor: 'matching' stamp: 'StephaneDucasse 3/29/2013 18:01'!
searchForMethod: searchString replaceWith: replaceString when: aBlock 

	self subclassResponsibility! !

!RBReplaceRule methodsFor: 'matching' stamp: 'StephaneDucasse 3/29/2013 18:01'!
searchFor: searchString replaceWith: replaceString when: aBlock 

	self subclassResponsibility! !

!RBReturnInEnsureRule commentStamp: 'StephaneDucasse 11/29/2014 23:06'!
Checks for return statements within ensure: blocks that can have unintended side-effects.!
!RBReturnInEnsureRule methodsFor: 'initialization' stamp: 'lr 11/19/2009 14:48'!
initialize
	| returnMatcher |
	super initialize.
	returnMatcher := RBParseTreeSearcher new.
	returnMatcher 
		matches: '^ `@object'
		do: [ :node :answer | true ].
	self matcher 
		matchesAnyOf: #(
			'``@rcv ensure: [| `@temps | ``@.Stmts]'
			'``@rcv ifCurtailed: [| `@temps | ``@.Stmts]')
		do: [ :node :answer | 
			answer isNil 
				ifTrue: [
					(returnMatcher executeTree: node arguments first initialAnswer: false) 
						ifTrue: [ node ]
						ifFalse: [ nil ] ]
				ifFalse: [ answer ] ]! !

!RBReturnInEnsureRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Possible bugs'! !

!RBReturnInEnsureRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Contains a return in an ensure: block'! !

!RBReturnInEnsureRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:27'!
category 
	^ 'Potential Bugs'! !

!RBReturnInEnsureRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'ReturnInEnsureRule'! !

!RBReturnNode commentStamp: '<historical>'!
RBReturnNode is an AST node that represents a return expression.

Instance Variables:
	return	<Integer>	the position of the ^ character
	value	<RBValueNode>	the value that is being returned

!
!RBReturnNode methodsFor: '*OpalDecompiler' stamp: 'ClementBera 7/10/2014 11:25'!
asReturnNode
! !

!RBReturnNode methodsFor: 'comparing' stamp: ''!
hash
	^self value hash! !

!RBReturnNode methodsFor: 'matching' stamp: 'lr 11/24/2009 23:35'!
copyInContext: aDictionary 
	^ self class new
		value: (self value copyInContext: aDictionary);
		yourself! !

!RBReturnNode methodsFor: 'testing' stamp: ''!
containsReturn
	^true! !

!RBReturnNode methodsFor: 'converting' stamp: 'MarcusDenker 1/29/2013 14:22'!
asSequenceNode
	^RBSequenceNode statements: {self} ! !

!RBReturnNode methodsFor: 'accessing' stamp: ''!
children
	^Array with: value! !

!RBReturnNode methodsFor: 'testing' stamp: 'GiselaDecuzzi 6/5/2013 10:30'!
isFaulty
	^self value isFaulty.! !

!RBReturnNode methodsFor: 'testing' stamp: ''!
isReturn
	^true! !

!RBReturnNode methodsFor: 'comparing' stamp: ''!
equalTo: anObject withMapping: aDictionary 
	^self class = anObject class 
		and: [self value equalTo: anObject value withMapping: aDictionary]! !

!RBReturnNode methodsFor: 'replacing' stamp: ''!
replaceNode: aNode withNode: anotherNode 
	value == aNode ifTrue: [self value: anotherNode]! !

!RBReturnNode methodsFor: 'accessing' stamp: 'PabloHerrero 1/6/2015 22:51'!
stop
	^ value stop! !

!RBReturnNode methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:38'!
acceptVisitor: aProgramNodeVisitor 
	^aProgramNodeVisitor visitReturnNode: self! !

!RBReturnNode methodsFor: 'accessing' stamp: 'PabloHerrero 1/6/2015 22:50'!
stop: anInteger
	self value stop: anInteger! !

!RBReturnNode methodsFor: 'accessing' stamp: ''!
value
	^value! !

!RBReturnNode methodsFor: 'comparing' stamp: ''!
= anObject 
	self == anObject ifTrue: [^true].
	self class = anObject class ifFalse: [^false].
	^self value = anObject value! !

!RBReturnNode methodsFor: 'copying' stamp: 'lr 11/1/2009 22:34'!
postCopy
	super postCopy.
	self value: self value copy! !

!RBReturnNode methodsFor: 'accessing' stamp: ''!
start
	^return! !

!RBReturnNode methodsFor: 'matching' stamp: 'lr 5/30/2010 11:35'!
match: aNode inContext: aDictionary 
	aNode class = self class ifFalse: [^false].
	^value match: aNode value inContext: aDictionary! !

!RBReturnNode methodsFor: 'accessing' stamp: ''!
value: valueNode 
	value := valueNode.
	value parent: self! !

!RBReturnNode methodsFor: 'accessing-token' stamp: 'lr 2/12/2010 19:21'!
return: anInteger
	return := anInteger! !

!RBReturnNode methodsFor: 'accessing-token' stamp: 'lr 2/12/2010 19:21'!
return
	^ return! !

!RBReturnNode methodsFor: 'initialize-release' stamp: ''!
return: returnInteger value: aValueNode 
	return := returnInteger.
	self value: aValueNode! !

!RBReturnNode class methodsFor: 'instance creation' stamp: ''!
return: returnInteger value: aValueNode 
	^self new return: returnInteger value: aValueNode! !

!RBReturnNode class methodsFor: 'instance creation' stamp: ''!
value: aNode
	^self return: nil value: aNode! !

!RBReturnsBooleanAndOtherRule commentStamp: 'StephaneDucasse 11/29/2014 20:26'!
This smell arises when a method return a boolean value (true or false) and return some other value such as (nil or self). If the method is suppose to return a boolean, then this signifies that there is one path through the method that might return a non-boolean. If the method doesn''t need to return a boolean, it should be probably rewriten to return some non-boolean value since other programmers reading the method might assume that it returns a boolean.!
!RBReturnsBooleanAndOtherRule methodsFor: 'initialization' stamp: 'lr 11/2/2009 00:14'!
initialize
	super initialize.
	matcher := RBParseTreeSearcher new.
	matcher 
		matches: '^ ``@object'
		do: [ :node :answer | answer add: node value; yourself ]! !

!RBReturnsBooleanAndOtherRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Possible bugs'! !

!RBReturnsBooleanAndOtherRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Returns a boolean and non boolean'! !

!RBReturnsBooleanAndOtherRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 11:22'!
category
	^ 'Potential Bugs'! !

!RBReturnsBooleanAndOtherRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:02'!
checkMethod: aMethod 
	| hasBool hasSelf |
	hasBool := false.
	hasSelf := aMethod parseTree lastIsReturn not.
	(matcher executeTree: aMethod parseTree initialAnswer: Set new) do: [ :each | 
		hasBool := hasBool 
			or: [ (each isLiteralNode and: [ #(true false) includes: each value ]) 
			or: [ (each isMessage and: [ #(and: or:) includes: each selector ]) ] ].
		hasSelf := hasSelf
			or: [ (each isVariable and: [ each name = 'self' ]) 
			or: [ (each isLiteralNode and: [ (#(true false) includes: each value) not ]) ] ] ].
	(hasSelf and: [ hasBool ]) 
		ifTrue: [ result addMethod: aMethod ]! !

!RBReturnsBooleanAndOtherRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'ReturnsBooleanAndOtherRule'! !

!RBReturnsIfTrueRule commentStamp: 'StephaneDucasse 11/29/2014 23:05'!
Check for methods that return the value of an ifTrue: or ifFalse: message. These statements return nil when the block is not executed.!
!RBReturnsIfTrueRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:34'!
initialize
	super initialize.
	self matcher 
		matchesAnyOf: #(
			'^`@condition ifTrue: [| `@temps | `@.statements]'
			'^`@condition ifFalse: [| `@temps | `@.statements]' )
		do: [ :node :answer | node ]! !

!RBReturnsIfTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Possible bugs'! !

!RBReturnsIfTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Returns value of ifTrue:/ifFalse: without ifFalse:/ifTrue: block'! !

!RBReturnsIfTrueRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:27'!
category 
	^ 'Potential Bugs'! !

!RBReturnsIfTrueRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'ReturnsIfTrueRule'! !

!RBScanner commentStamp: '<historical>'!
RBScanner is a stream that returns a sequence of token from the string that it is created on. The tokens know where they came from in the source code and which comments were attached to them.

Instance Variables:
	buffer	<PositionableStream>	Accumulates the text for the current token.
	characterType	<ByteSymbol>	The type of the next character. (e.g. #alphabetic, etc.)
	classificationTable	<Array of: Symbol>	Mapping from Character values to their characterType.
	comments	<Collection of: Interval>	Source intervals of scanned comments that must be attached to the next token.
	currentCharacter	<Character>	The character currently being processed.
	errorBlock	<BlockClosure>	The block to execute on lexical errors.
	extendedLiterals	<Boolean>	True if IBM-type literals are allowed. In VW, this is false.
	nameSpaceCharacter	<Character>	The character used to separate namespaces.
	numberType	<ByteSymbol>	The method to perform: to scan a number. 
	separatorsInLiterals	<Boolean>	True if separators are allowed within literals.
	stream	<PositionableStream>	Contains the text to be scanned.
	tokenStart	<Integer>	The source position of the beginning of the current token

Class Instance Variables:
	classificationTable	<Array>		the default classification table for all characters

Shared Variables:
	PatternVariableCharacter	<Character>	the character that starts a pattern node!
!RBScanner methodsFor: 'accessing' stamp: 'GiselaDecuzzi 5/28/2013 13:28'!
errorBlock: aBlock 
	errorBlock := aBlock! !

!RBScanner methodsFor: 'testing' stamp: ''!
isReadable
	^true! !

!RBScanner methodsFor: 'private-scanning' stamp: ''!
scanLiteralArrayToken
	| token |
	token := RBLiteralArrayToken 
				value: (String with: $# with: currentCharacter)
				start: tokenStart.
	self step.
	^token! !

!RBScanner methodsFor: 'testing' stamp: ''!
isWritable
	^false! !

!RBScanner methodsFor: 'accessing' stamp: 'GiselaDecuzzi 6/10/2013 14:53'!
next
	| token |
	buffer reset.
	tokenStart := stream position.
	token := characterType = #eof 
				ifTrue: 
					[RBToken start: tokenStart + 1	"The EOF token should occur after the end of input"]
				ifFalse: [self scanToken].
	self stripSeparators.
	token comments: self getComments.
	^token! !

!RBScanner methodsFor: 'error handling' stamp: 'GiselaDecuzzi 6/10/2013 13:08'!
scannerError: aString
	(self errorBlock cull: aString cull: self errorPosition cull: self) ifNil: [ 
		^ SyntaxErrorNotification
					inClass: Object
					category: nil
					withCode: stream contents
					doitFlag: false
					errorMessage: aString
					location: stream position + 1
	]! !

!RBScanner methodsFor: 'private-scanning' stamp: 'lr 11/2/2009 23:37'!
stripSeparators
	
	[[characterType = #separator] whileTrue: [self step].
	currentCharacter = $"] 
			whileTrue: [self stripComment]! !

!RBScanner methodsFor: 'accessing' stamp: 'GiselaDecuzzi 6/10/2013 10:22'!
scanToken
	"fast-n-ugly. Don't write stuff like this. Has been found to cause cancer in laboratory rats. Basically a 
	case statement. Didn't use Dictionary because lookup is pretty slow."

	characterType = #alphabetic ifTrue: [^self scanIdentifierOrKeyword].
	(characterType = #digit 
		or: [currentCharacter = $- and: [(self classify: stream peek) = #digit]]) 
			ifTrue: [^self scanNumber].
	characterType = #binary ifTrue: [^self scanBinary: RBBinarySelectorToken].
	characterType = #special ifTrue: [^self scanSpecialCharacter].
	currentCharacter = $' ifTrue: [^self scanLiteralString].
	currentCharacter = $# ifTrue: [^self scanLiteral].
	currentCharacter = $$ ifTrue: [^self scanLiteralCharacter].
	^self scanError: 'Unknown character' translated! !

!RBScanner methodsFor: 'private' stamp: 'lr 11/2/2009 23:37'!
previousStepPosition
	^characterType = #eof 
		ifTrue: [stream position]
		ifFalse: [stream position - 1]! !

!RBScanner methodsFor: 'private-scanning' stamp: 'GiselaDecuzzi 6/10/2013 10:47'!
scanLiteral
	self step.
	self stripSeparators.
	characterType = #alphabetic 
		ifTrue: [ ^ self scanSymbol ].
	characterType = #binary 
		ifTrue: [ ^ (self scanBinary: RBLiteralToken) stop: self previousStepPosition ].
	currentCharacter = $' 
		ifTrue: [ ^ self scanStringSymbol ].
	(currentCharacter = $( or: [ currentCharacter = $[ ]) 
		ifTrue: [ ^ self scanLiteralArrayToken].
	"Accept some strange literals like '#1', '# species' and '##species:'"
	characterType = #digit
		ifTrue: [ ^ self scanNumber ].
	currentCharacter = $#
		ifTrue: [ ^ self scanLiteral ].
	^self scanError: 'Expecting a literal type' translated.! !

!RBScanner methodsFor: 'private-scanning' stamp: ''!
scanLiteralCharacter
	| token |
	self step.	"$"
	token := RBLiteralToken 
				value: currentCharacter
				start: tokenStart
				stop: stream position.
	self step.	"char"
	^token! !

!RBScanner methodsFor: 'private-scanning' stamp: 'CamilloBruni 11/13/2012 10:03'!
scanSpecialCharacter
	| character |
	currentCharacter = $: 
		ifTrue: [
			self step.
			^ currentCharacter = $= 
				ifTrue: [
					self step.
					RBAssignmentToken start: tokenStart]
				ifFalse: [ RBSpecialCharacterToken value: $: start: tokenStart ]].
			
	currentCharacter = $_ ifTrue: [ 
		self step.  
		^ RBShortAssignmentToken start: tokenStart ].
	
	character := currentCharacter.
	self step.
	^ RBSpecialCharacterToken value: character start: tokenStart! !

!RBScanner methodsFor: 'private-scanning' stamp: 'lr 11/2/2009 23:37'!
scanAnySymbol
	characterType = #alphabetic ifTrue: [^self scanSymbol].
	characterType = #binary ifTrue: [^self scanBinary: RBLiteralToken].
	^RBToken new! !

!RBScanner methodsFor: 'error handling' stamp: 'GiselaDecuzzi 6/10/2013 13:11'!
errorBlock
	^errorBlock ifNil: [[:message :position | ]] ifNotNil: [errorBlock]! !

!RBScanner methodsFor: 'initialize-release' stamp: 'lr 11/1/2009 18:31'!
on: aStream 
	buffer := WriteStream on: (String new: 60).
	stream := aStream.
	classificationTable := self class classificationTable.
	comments := OrderedCollection new! !

!RBScanner methodsFor: 'private-scanning' stamp: 'GiselaDecuzzi 6/10/2013 13:07'!
stripComment
	| start stop |
	start := stream position.
	[self step = $"] whileFalse: 
			[characterType = #eof
				ifTrue: [^self scannerError: 'Unmatched " in comment.' translated]].
	stop := stream position.
	self step.
	comments add: (start to: stop)! !

!RBScanner methodsFor: 'private' stamp: ''!
classify: aCharacter 
	| index |
	aCharacter isNil ifTrue: [^nil].
	index := aCharacter asInteger.
	index == 0 ifTrue: [^#separator].
	index > 255 
		ifTrue: 
			[^aCharacter isLetter 
				ifTrue: [#alphabetic]
				ifFalse: [aCharacter isSeparator ifTrue: [#separator] ifFalse: [nil]]].
	^classificationTable at: index! !

!RBScanner methodsFor: 'error handling' stamp: 'GiselaDecuzzi 6/10/2013 13:12'!
errorPosition
	^stream position! !

!RBScanner methodsFor: 'private-scanning' stamp: 'lr 11/2/2009 23:37'!
scanName
	[characterType = #alphabetic or: [characterType = #digit]] whileTrue: 
			[buffer nextPut: currentCharacter.
			self step]! !

!RBScanner methodsFor: 'private-scanning' stamp: 'lr 11/2/2009 23:37'!
scanKeyword
	| outputPosition inputPosition name |
	[currentCharacter = $:] whileTrue: 
			[buffer nextPut: currentCharacter.
			outputPosition := buffer position.
			inputPosition := stream position.
			self step.	":"
			[characterType = #alphabetic] whileTrue: [self scanName]].
	buffer position: outputPosition.
	stream position: inputPosition.
	self step.
	name := buffer contents.
	^(name occurrencesOf: $:) == 1 
		ifTrue: [RBKeywordToken value: name start: tokenStart]
		ifFalse: 
			[RBMultiKeywordLiteralToken 
				value: name asSymbol
				start: tokenStart
				stop: tokenStart + name size - 1]! !

!RBScanner methodsFor: 'private-scanning' stamp: 'lr 3/7/2010 11:41'!
scanBinary: aClass 
	| val |
	buffer nextPut: currentCharacter.
	self step.
	[ characterType = #binary ] whileTrue: 
		[ buffer nextPut: currentCharacter.
		self step ].
	val := buffer contents.
	val := val asSymbol.
	^aClass value: val start: tokenStart! !

!RBScanner methodsFor: 'private-scanning' stamp: 'GiselaDecuzzi 6/10/2013 10:47'!
scanPatternVariable
	buffer nextPut: currentCharacter.
	self step.
	currentCharacter = ${ 
		ifTrue: 
			[self step.
			^RBPatternBlockToken value: '`{' start: tokenStart].
	[characterType = #alphabetic] whileFalse: 
			[characterType = #eof 
				ifTrue: [self scanError: 'Meta variable expected'].
			buffer nextPut: currentCharacter.
			self step].
	^self scanIdentifierOrKeyword! !

!RBScanner methodsFor: 'testing' stamp: 'lr 11/2/2009 23:37'!
atEnd
	^characterType = #eof! !

!RBScanner methodsFor: 'accessing' stamp: ''!
nextPut: anObject 
	"Provide an error notification that the receiver does not
	implement this message."

	self shouldNotImplement! !

!RBScanner methodsFor: 'accessing' stamp: ''!
getComments
	| oldComments |
	comments isEmpty ifTrue: [^nil].
	oldComments := comments.
	comments := OrderedCollection new: 1.
	^oldComments! !

!RBScanner methodsFor: 'private-scanning' stamp: 'lr 11/16/2009 15:48'!
scanSymbol
	[ characterType = #alphabetic or: [ currentCharacter = $: ] ] whileTrue: [
		self scanName.
		currentCharacter = $: ifTrue: [
			buffer nextPut: $:.
			self step ] ].
	^ RBLiteralToken 
		value: buffer contents asSymbol
		start: tokenStart
		stop: self previousStepPosition! !

!RBScanner methodsFor: 'private-scanning' stamp: 'GiselaDecuzzi 6/10/2013 15:53'!
scanError: theCause
	currentCharacter ifNotNil: [ :char | buffer nextPut: char ].
	^ RBErrorToken
		value: buffer contents asString
		start: tokenStart
		cause: theCause
		location: stream position + 1! !

!RBScanner methodsFor: 'private-scanning' stamp: 'YuriyTymchuk 10/29/2013 11:10'!
scanNumber
	| start number stop string |
	start := stream position.
	stream position: start - 1.
	number := [NumberParser parse: stream] on: Error do: [:err | self scannerError: err messageText].
	stop := stream position.
	stream position: start - 1.
	string := stream next: stop - start + 1.
	stream position: stop.
	self step.
	^RBNumberLiteralToken 
		value: number
		start: start
		stop: stop
		source: string! !

!RBScanner methodsFor: 'private-scanning' stamp: 'GiselaDecuzzi 6/10/2013 11:05'!
scanLiteralString
	self step.
	
	[currentCharacter isNil 
		ifTrue: [^self scanError: 'Unmatched '' in string literal.' translated].
	currentCharacter = $' and: [self step ~= $']] 
			whileFalse: 
				[buffer nextPut: currentCharacter.
				self step].
	^RBLiteralToken 
		value: buffer contents
		start: tokenStart
		stop: self previousStepPosition! !

!RBScanner methodsFor: 'private-scanning' stamp: ''!
scanStringSymbol
	| literalToken |
	literalToken := self scanLiteralString.
	literalToken value: literalToken value asSymbol.
	^literalToken! !

!RBScanner methodsFor: 'private' stamp: ''!
step
	stream atEnd 
		ifTrue: 
			[characterType := #eof.
			^currentCharacter := nil].
	currentCharacter := stream next.
	characterType := self classify: currentCharacter.
	^currentCharacter! !

!RBScanner methodsFor: 'accessing' stamp: ''!
flush! !

!RBScanner methodsFor: 'private-scanning' stamp: 'lr 3/7/2010 11:47'!
scanIdentifierOrKeyword
	| name |
	self scanName.
	(currentCharacter = $: and: [stream peek ~= $=]) 
		ifTrue: [^self scanKeyword].
	name := buffer contents.
	name = 'true' 
		ifTrue: 
			[^RBLiteralToken 
				value: true
				start: tokenStart
				stop: self previousStepPosition].
	name = 'false' 
		ifTrue: 
			[^RBLiteralToken 
				value: false
				start: tokenStart
				stop: self previousStepPosition].
	name = 'nil' 
		ifTrue: 
			[^RBLiteralToken 
				value: nil
				start: tokenStart
				stop: self previousStepPosition].
	^RBIdentifierToken value: name start: tokenStart! !

!RBScanner methodsFor: 'accessing' stamp: 'lr 11/23/2009 14:18'!
contents
	| contentsStream |
	contentsStream := WriteStream on: (Array new: 50).
	[ self atEnd ]
		whileFalse: [ contentsStream nextPut: self next ].
	^ contentsStream contents! !

!RBScanner class methodsFor: 'testing' stamp: 'GiselaDecuzzi 6/10/2013 11:42'!
isVariable: aString 
	| scanner token |
	scanner := self on: (ReadStream on: aString).
	token := scanner next.
	token isIdentifier ifFalse: [^false].
	(token start = 1 and: [token stop = aString size]) ifFalse: [^false].
	^(aString includes: $.) not! !

!RBScanner class methodsFor: 'class initialization' stamp: 'lr 12/23/2009 16:40'!
initialize
	self initializeClassificationTable! !

!RBScanner class methodsFor: 'testing' stamp: ''!
isSelector: aSymbol 
	| scanner token |
	scanner := self basicNew.
	scanner on: (ReadStream on: aSymbol asString).
	scanner step.
	token := scanner scanAnySymbol.
	token isLiteralToken ifFalse: [^false].
	token value isEmpty ifTrue: [^false].
	^scanner atEnd! !

!RBScanner class methodsFor: 'class initialization' stamp: 'lr 8/30/2010 11:54'!
initializeClassificationTable
	PatternVariableCharacter := $`.
	classificationTable := Array new: 255.
	self 
		initializeChars: (Character allCharacters
			select: [ :each | each isLetter ])
		to: #alphabetic.
	self initializeUnderscore.
	self initializeChars: '01234567890' to: #digit.
	self initializeChars: '!!%&*+,-/<=>?@\~|' to: #binary.
	classificationTable at: 177 put: #binary.	"plus-or-minus"
	classificationTable at: 183 put: #binary.	"centered dot"
	classificationTable at: 215 put: #binary.	"times"
	classificationTable at: 247 put: #binary.	"divide"
	self initializeChars: '().:;[]{}^' to: #special.
	self
		initializeChars: (Character allCharacters
			select: [ :each | each isSeparator ])
		to: #separator! !

!RBScanner class methodsFor: 'instance creation' stamp: 'lr 8/30/2010 11:56'!
new
	self initializeUnderscore.
	^ super new! !

!RBScanner class methodsFor: 'accessing' stamp: 'ClementBera 7/26/2013 16:31'!
classificationTable
	classificationTable 
		ifNil: [ self initializeClassificationTable ].
	^ classificationTable! !

!RBScanner class methodsFor: 'class initialization' stamp: 'MarcusDenker 4/24/2013 15:51'!
initializeUnderscore
	self classificationTable
		at: $_ asInteger
		put: #alphabetic! !

!RBScanner class methodsFor: 'instance creation' stamp: 'GiselaDecuzzi 6/10/2013 13:00'!
on: aStream errorBlock: aBlock 
	| str |
	str := self new on: aStream.
	str
		errorBlock: aBlock;
		step;
		stripSeparators.
	^str! !

!RBScanner class methodsFor: 'class initialization' stamp: 'lr 11/23/2009 14:46'!
initializeChars: characters to: aSymbol 
	characters do: [:c | classificationTable at: c asInteger put: aSymbol]! !

!RBScanner class methodsFor: 'instance creation' stamp: 'lr 11/23/2009 14:50'!
on: aStream 
	| str |
	str := self new on: aStream.
	str
		step;
		stripSeparators.
	^str! !

!RBScanner class methodsFor: 'accessing' stamp: 'lr 11/7/2009 15:31'!
patternVariableCharacter
	^ PatternVariableCharacter! !

!RBScannerTest commentStamp: 'TorstenBergmann 2/4/2014 21:53'!
SUnit tests for RBScanner!
!RBScannerTest methodsFor: 'testing' stamp: 'GiselaDecuzzi 6/10/2013 11:10'!
verifyErrorToken: scannedToken message: message valueExpected: valueExpected
	self assert: scannedToken isError.
	self assert: scannedToken cause equals: message.
	self assert: scannedToken value equals: valueExpected.
	self assert: scannedToken start equals: 1.! !

!RBScannerTest methodsFor: 'next' stamp: 'GiselaDecuzzi 6/10/2013 11:10'!
testNextWithAnOpeningStringsGetError
	| source scannedToken |
	source := '''only the opening'.
	scannedToken := (self buildScannerForText: source) next.
	self verifyErrorToken: scannedToken message: 'Unmatched '' in string literal.' translated valueExpected: 'only the opening'! !

!RBScannerTest methodsFor: 'next' stamp: 'GiselaDecuzzi 5/30/2013 15:28'!
testNextWithAnOpeningCommentGetError
	| source |
	
	source := '"only the opening'.
	self should: [(self buildScannerForText: source) next] raise: SyntaxErrorNotification! !

!RBScannerTest methodsFor: 'next' stamp: 'GiselaDecuzzi 6/10/2013 11:03'!
testNextWithAnIdentifierTokenGetTheIdentifierToken
	| source scanner token |
	
	source := 'identifierToken'.
	scanner := self buildScannerForText: source.
	token := scanner next.
	self assert: token isIdentifier.
	self deny: token isError.
	self assert: token value equals: source.! !

!RBScannerTest methodsFor: 'next' stamp: 'GiselaDecuzzi 6/10/2013 11:09'!
testNextWithAWrongSymbolGetError
	| source scanner scannedToken |
	source := '#^'.
	scanner := self buildScannerForText: source.
	scannedToken := scanner next.
	self verifyErrorToken: scannedToken message: 'Expecting a literal type' translated valueExpected: '^'! !

!RBScannerTest methodsFor: 'next' stamp: 'GiselaDecuzzi 6/10/2013 11:13'!
testNextWithAnUnknownCharacterGetError
	| source scanner scannedToken |
	
	source := '¿'.
	scanner := self buildScannerForText: source.
	scannedToken := scanner next.
	self verifyErrorToken: scannedToken message: 'Unknown character' translated valueExpected: source! !

!RBScannerTest methodsFor: 'initialize' stamp: 'GiselaDecuzzi 5/30/2013 14:38'!
buildScannerForText: source
	^RBScanner on: (ReadStream on: source)! !

!RBSearchRule commentStamp: 'md 8/9/2005 14:56'!
RBSearchRule is a parse tree rule that simply searches for matches to the rule. Every time a match is found, answerBlock is evaluated with the node that matches and the cureent answer. This two-argument approach allows a collection to be formed from all of the matches (Think inject:into:).

Instance Variables:
	answerBlock	<BlockClosure>	Block to evaluate with the matching node and the current answer.

!
!RBSearchRule methodsFor: 'initialize-release' stamp: ''!
searchForMethod: aString thenDo: aBlock 
	self methodSearchString: aString.
	answerBlock := aBlock! !

!RBSearchRule methodsFor: 'testing' stamp: ''!
canMatch: aProgramNode 
	owner answer: (answerBlock value: aProgramNode value: owner answer).
	^true! !

!RBSearchRule methodsFor: 'initialize-release' stamp: ''!
searchForTree: aBRProgramNode thenDo: aBlock 
	searchTree := aBRProgramNode.
	answerBlock := aBlock! !

!RBSearchRule methodsFor: 'initialize-release' stamp: ''!
searchFor: aString thenDo: aBlock 
	self searchString: aString.
	answerBlock := aBlock! !

!RBSearchRule class methodsFor: 'instance creation' stamp: ''!
searchForMethod: aString thenDo: aBlock 
	^self new searchForMethod: aString thenDo: aBlock! !

!RBSearchRule class methodsFor: 'instance creation' stamp: ''!
searchForTree: aBRProgramNode thenDo: aBlock 
	^self new searchForTree: aBRProgramNode thenDo: aBlock! !

!RBSearchRule class methodsFor: 'instance creation' stamp: ''!
searchFor: aString thenDo: aBlock 
	^self new searchFor: aString thenDo: aBlock! !

!RBSearchTest methodsFor: 'accessing' stamp: 'lr 9/18/2011 15:56'!
buildMethodSearch
	"Simple forwarders"
	self 
		createMethodSearchWith: '`@methodName: `@args ^`@object `@methodName: `@args'
		selectors: #(#problemCount #isEmpty )
		inClass: RBTransformationRuleTest! !

!RBSearchTest methodsFor: 'accessing' stamp: 'NicolaiHess 9/8/2014 15:53'!
buildSimpleVariableSearch
	self 
		createSearchWith: 'result'
		selectors: #(
				#checkClass:
				#checkMethod:
				#isEmpty
				#problemCount
				#resetResult
				#resetResult
				#resetResult
				#result
				#result:
				#resultClass:
				#newResultClass:
				#viewResults
			)
		inClass: RBBasicLintRuleTest! !

!RBSearchTest methodsFor: 'accessing' stamp: 'lr 9/18/2011 15:56'!
buildStatementSearch
	"Two or more statements"
	self 
		createSearchWith: '| `@temps | ``@.Stmts1. ``.Stmt1. ``@.Stmts2. ``.Stmt2. ``@.Stmts3'
		selectors: #(
				#checkMethod:
				#rewriteUsing:
				#viewResults
				#superSends
			)
		inClass: RBTransformationRuleTest! !

!RBSearchTest methodsFor: 'tests' stamp: 'lr 9/18/2011 15:57'!
testAllSearches
	classSearches keysAndValuesDo: 
			[:class :searches | 
			class selectors do: 
					[:sel | 
					currentSelector := sel.
					searches 
						do: [:each | each executeTree: (class parseTreeFor: sel) initialAnswer: each answer]]].
	classSearches 
		do: [:searches | searches do: [:each | self assert: each answer isEmpty]]! !

!RBSearchTest methodsFor: 'accessing' stamp: 'NicolaiHess 9/8/2014 15:57'!
buildSimpleLiteralSearch
	| search |
	search := RBParseTreeSearcher new.
	search 
		matchesAnyTreeOf: (Array with: (RBParser parseExpression: '#(''bugs'' ''possible bugs'' ''unnecessary code'' ''intention revealing'' ''miscellaneous'')'))
		do: 
			[ :aNode :answer | 
			answer
				remove: self currentSelector
					ifAbsent: [ self error: 'failed' ];
				yourself ].
	search answer: #(#protocolsToCheck ) asBag.
	(classSearches 
		at: RBBasicLintRuleTest class
		ifAbsentPut: [ Set new ]) add: search! !

!RBSearchTest methodsFor: 'accessing' stamp: 'lr 9/18/2011 15:57'!
createMethodSearchWith: aCodeString selectors: selectorCollection inClass: aClass 
	| search |
	search := RBParseTreeSearcher new.
	search matchesAnyMethodOf: (Array with: aCodeString)
		do: 
			[:aNode :answer | 
			answer
				remove: self currentSelector ifAbsent: [self error: 'failed'];
				yourself].
	search answer: selectorCollection asBag.
	(classSearches at: aClass ifAbsentPut: [Set new]) add: search! !

!RBSearchTest methodsFor: 'accessing' stamp: 'lr 9/18/2011 15:56'!
buildMethodArgumentSearch
	"Two argument methods"
	self 
		createMethodSearchWith: '`arg1: `arg1 `arg2: `arg2 | `@temps | `@.Stmts'
		selectors: #(
				#subclassOf:overrides:
				#createMatcherFor:method:
				#createParseTreeRule:name:
			)
		inClass: RBBasicLintRuleTest class! !

!RBSearchTest methodsFor: 'accessing' stamp: 'lr 9/18/2011 15:57'!
createSearchWith: aCodeString selectors: selectorCollection inClass: aClass 
	| search |
	search := RBParseTreeSearcher new.
	search matches: aCodeString
		do: 
			[:aNode :answer | 
			answer
				remove: self currentSelector ifAbsent: [self error: 'failed'];
				yourself].
	search answer: selectorCollection asBag.
	(classSearches at: aClass ifAbsentPut: [Set new]) add: search! !

!RBSearchTest methodsFor: 'accessing' stamp: 'lr 9/18/2011 15:57'!
setUp
	super setUp.
	classSearches := Dictionary new.
	self
		buildMethodSearch;
		buildSimpleVariableSearch;
		buildSimpleLiteralSearch;
		buildMessageSearch;
		buildStatementSearch;
		buildArgumentSearch;
		buildMethodTitleSearch;
		buildMethodArgumentSearch! !

!RBSearchTest methodsFor: 'accessing' stamp: 'lr 9/18/2011 15:56'!
buildMethodTitleSearch
	self 
		createMethodSearchWith: 'initialize | `@temps | `@.Stmts'
		selectors: #(#initialize )
		inClass: RBBasicLintRuleTest! !

!RBSearchTest methodsFor: 'accessing' stamp: 'lr 9/18/2011 15:56'!
buildArgumentSearch
	self 
		createArgumentSearchWith: 'aSmalllintContext'
		selectors: #(#checkMethod: #checkClass: )
		inClass: RBBasicLintRuleTest! !

!RBSearchTest methodsFor: 'accessing' stamp: 'lr 9/18/2011 15:57'!
createArgumentSearchWith: aCodeString selectors: selectorCollection inClass: aClass 
	| search |
	search := RBParseTreeSearcher new.
	search matchesAnyArgumentOf: (Array with: aCodeString)
		do: 
			[:aNode :answer | 
			answer
				remove: self currentSelector ifAbsent: [self error: 'failed'];
				yourself].
	search answer: selectorCollection asBag.
	(classSearches at: aClass ifAbsentPut: [Set new]) add: search! !

!RBSearchTest methodsFor: 'accessing' stamp: 'lr 9/18/2011 15:56'!
buildMessageSearch
	self 
		createSearchWith: '``@receiver -> ``@arg'
		selectors: #(#superSends #superSends )
		inClass: RBTransformationRuleTest! !

!RBSearchTest methodsFor: 'accessing' stamp: 'lr 10/19/2011 20:10'!
currentSelector
	^ currentSelector! !

!RBSearchingLiteralRule commentStamp: 'StephaneDucasse 11/29/2014 23:05'!
Checks for repeated literal equalitity tests that should rather be implemented as a search in a literal collection.!
!RBSearchingLiteralRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:35'!
initialize
	super initialize.
	self matcher
		matchesAnyOf: #(
			'``@object = `#literal or: [``@expression]' 
			'``@object == `#literal or: [``@expression]' 
			'`#literal = ``@object or: [``@expression]' 
			'`#literal == ``@object or: [``@expression]' 
			'``@expression | (``@object = `#literal)' 
			'``@expression | (``@object == `#literal)' 
			'``@expression | (`#literal = ``@object)' 
			'``@expression | (`#literal == ``@object)')
		do: [ :node :answer | 
			answer isNil 
				ifTrue: [
					(self isSearchingLiteralExpression: node)
						ifTrue: [ node ]
						ifFalse: [ nil ] ]
				ifFalse: [ answer ] ]! !

!RBSearchingLiteralRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Intention revealing'! !

!RBSearchingLiteralRule methodsFor: 'private' stamp: 'MarcusDenker 9/20/2013 15:03'!
isSearchingLiteralExpression: aSearchingNode for: anObjectNode 
	| argument arguments |
	aSearchingNode isMessage ifFalse: [^false].
	arguments := aSearchingNode arguments.
	arguments size = 1 ifFalse: [^false].
	argument := arguments first.
	(#(#= #==) includes: aSearchingNode selector) 
		ifTrue: 
			[^(aSearchingNode receiver = anObjectNode 
				and: [aSearchingNode arguments first isLiteralNode]) or: 
						[aSearchingNode arguments first = anObjectNode 
							and: [aSearchingNode receiver isLiteralNode]]].
	aSearchingNode selector = #| 
		ifTrue: 
			[^(self isSearchingLiteralExpression: aSearchingNode receiver
				for: anObjectNode) 
					and: [self isSearchingLiteralExpression: argument for: anObjectNode]].
	aSearchingNode selector = #or: ifFalse: [^false].
	argument isBlock ifFalse: [^false].
	argument body statements size = 1 ifFalse: [^false].
	^(self isSearchingLiteralExpression: aSearchingNode receiver
		for: anObjectNode) and: 
				[self isSearchingLiteralExpression: argument body statements first
					for: anObjectNode]! !

!RBSearchingLiteralRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:28'!
category 
	^ 'Optimization'! !

!RBSearchingLiteralRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Uses or''s instead of a searching literal'! !

!RBSearchingLiteralRule methodsFor: 'private' stamp: 'MarcusDenker 9/20/2013 15:07'!
isSearchingLiteralExpression: aMessageNode 
	| equalNode expressionNode |
	equalNode := aMessageNode selector = #| 
				ifTrue: [aMessageNode arguments first]
				ifFalse: [aMessageNode receiver].
	expressionNode := equalNode receiver isLiteralNode
				ifTrue: [equalNode arguments first]
				ifFalse: [equalNode receiver].
	^self isSearchingLiteralExpression: aMessageNode for: expressionNode! !

!RBSearchingLiteralRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'SearchingLiteralRule'! !

!RBSelectorEnvironment methodsFor: 'accessing-classes' stamp: 'lr 3/20/2011 11:18'!
classesDo: aBlock 
	classSelectors keysDo: [ :each | 
		| class |
		class := self systemDictionary at: each ifAbsent: [ nil ].
		(class notNil and: [ environment includesClass: class ])
			ifTrue: [ aBlock value: class ] ].
	metaClassSelectors keysDo: [ :each | 
		| class |
		class := self systemDictionary at: each ifAbsent: [ nil ].
		(class notNil and: [ environment includesClass: class class ])
			ifTrue: [ aBlock value: class class ] ]! !

!RBSelectorEnvironment methodsFor: 'testing' stamp: 'TestRunner 1/3/2010 12:36'!
includesCategory: aCategory 
	^(super includesCategory: aCategory) and: 
			[(self classNamesFor: aCategory) anySatisfy: 
					[:className | 
					(classSelectors includesKey: className) 
						or: [metaClassSelectors includesKey: className]]]! !

!RBSelectorEnvironment methodsFor: 'adding' stamp: 'YuriyTymchuk 9/26/2014 16:47'!
addMethod: aMethod
	"this is a method to improve addition of methods, as class and selector data can be retrieved from a single compiled method"
	
	self addClass: aMethod methodClass selector: aMethod selector! !

!RBSelectorEnvironment methodsFor: 'accessing' stamp: 'ThierryGoubier 9/6/2013 17:26'!
packages
	"Check that packages have really class and selector included."

	| pSet |
	pSet := Set new.
	self classes
		do: [ :each | 
			each packages
				do: [ :p | 
					self
						selectorsForClass: each
						do: [ :s | 
							(p includesSelector: s ofClass: each)
								ifTrue: [ pSet add: p ] ] ] ].
	^ pSet! !

!RBSelectorEnvironment methodsFor: '*GT-SpotterExtensions-Core-private' stamp: 'StefanReichhart 3/23/2015 13:12'!
withClassesFixedForNautilus
	classSelectors ifEmpty: [ 
		metaClassSelectors keysAndValuesDo: [ :class :selectors | 
			classSelectors at: class ifAbsentPut: [ IdentitySet new ] ] ]! !

!RBSelectorEnvironment methodsFor: 'initialization' stamp: ''!
initialize
	super initialize.
	classSelectors := IdentityDictionary new.
	metaClassSelectors := IdentityDictionary new! !

!RBSelectorEnvironment methodsFor: 'adding' stamp: 'lr 2/26/2009 13:36'!
addClass: aClass selector: aSymbol 
	(aClass isMeta 
		ifTrue: [ metaClassSelectors at: aClass soleInstance name ifAbsentPut: [ IdentitySet new ] ]
		ifFalse: [ classSelectors at: aClass name ifAbsentPut: [ IdentitySet new ] ])
			add: aSymbol! !

!RBSelectorEnvironment methodsFor: 'adding' stamp: 'lr 9/14/2010 11:40'!
addClass: aClass 
	aClass isMeta 
		ifTrue: [ metaClassSelectors at: aClass soleInstance name put: aClass selectors asIdentitySet ]
		ifFalse: [ classSelectors at: aClass name put: aClass selectors asIdentitySet ]! !

!RBSelectorEnvironment methodsFor: 'accessing-classes' stamp: 'lr 2/26/2009 13:35'!
classNames
	^ IdentitySet new
		addAll: classSelectors keys;
		addAll: metaClassSelectors keys;
		yourself! !

!RBSelectorEnvironment methodsFor: 'initialize-release' stamp: 'lr 9/14/2010 11:40'!
on: aDictionary 
	aDictionary keysAndValuesDo: [ :class :selectors | 
		class isMeta 
			ifTrue: [ metaClassSelectors at: class soleInstance name put: selectors asIdentitySet ]
			ifFalse: [ classSelectors at: class name put: selectors asIdentitySet ] ]! !

!RBSelectorEnvironment methodsFor: 'removing' stamp: ''!
removeClass: aClass 
	aClass isMeta 
		ifTrue: [metaClassSelectors removeKey: aClass soleInstance name ifAbsent: []]
		ifFalse: [classSelectors removeKey: aClass name ifAbsent: []]! !

!RBSelectorEnvironment methodsFor: 'testing' stamp: ''!
includesClass: aClass 
	^(self privateSelectorsForClass: aClass) isEmpty not 
		and: [super includesClass: aClass]! !

!RBSelectorEnvironment methodsFor: 'private' stamp: ''!
privateIncludesSelector: aSelector inClass: aClass 
	^(self privateSelectorsForClass: aClass) includes: aSelector! !

!RBSelectorEnvironment methodsFor: 'accessing' stamp: 'rr 4/19/2004 16:06'!
asSelectorEnvironment
	^ self! !

!RBSelectorEnvironment methodsFor: 'testing' stamp: ''!
isEmpty
	^classSelectors isEmpty and: [metaClassSelectors isEmpty]! !

!RBSelectorEnvironment methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	| classBlock |
	aStream
		nextPutAll: '((';
		nextPutAll: self class name;
		nextPutAll: ' onEnvironment: '.
	environment storeOn: aStream.
	aStream
		nextPut: $);
		nextPutAll: ' classes: #('.
	classBlock := 
			[:key :value | 
			aStream
				nextPutAll: '#(';
				nextPutAll: key;
				nextPutAll: ' #('.
			value do: 
					[:each | 
					aStream
						nextPutAll: each;
						nextPut: $ ].
			aStream
				nextPutAll: '))';
				cr].
	classSelectors keysAndValuesDo: classBlock.
	aStream nextPutAll: ') metaClasses: #('.
	metaClassSelectors keysAndValuesDo: classBlock.
	aStream nextPutAll: '))'! !

!RBSelectorEnvironment methodsFor: 'testing' stamp: ''!
includesSelector: aSelector in: aClass 
	^(environment includesSelector: aSelector in: aClass)
		and: [self privateIncludesSelector: aSelector inClass: aClass]! !

!RBSelectorEnvironment methodsFor: 'removing' stamp: ''!
removeClass: aClass selector: aSelector 
	(aClass isMeta 
		ifTrue: [metaClassSelectors at: aClass soleInstance name ifAbsent: [^self]]
		ifFalse: [classSelectors at: aClass name ifAbsent: [^self]]) 
			remove: aSelector
			ifAbsent: []! !

!RBSelectorEnvironment methodsFor: 'initialize-release' stamp: 'lr 2/26/2009 13:36'!
classes: classArray metaClasses: metaArray 
	"Used to recreate an environment from its storeString"

	classSelectors := IdentityDictionary new.
	metaClassSelectors := IdentityDictionary new.
	classArray 
		do: [ :each | classSelectors at: each first put: each last asIdentitySet ].
	metaArray 
		do: [ :each | metaClassSelectors at: each first put: each last asIdentitySet ]! !

!RBSelectorEnvironment methodsFor: 'private' stamp: ''!
privateSelectorsForClass: aClass 
	^aClass isMeta 
		ifTrue: [metaClassSelectors at: aClass soleInstance name ifAbsent: [#()]]
		ifFalse: [classSelectors at: aClass name ifAbsent: [#()]]! !

!RBSelectorEnvironment methodsFor: 'testing' stamp: 'TestRunner 1/3/2010 12:36'!
includesProtocol: aProtocol in: aClass 
	^(super includesProtocol: aProtocol in: aClass)
		and: [(environment selectorsFor: aProtocol in: aClass)
				anySatisfy: [:aSelector | self privateIncludesSelector: aSelector inClass: aClass]]! !

!RBSelectorEnvironment methodsFor: 'initialize-release' stamp: ''!
classSelectors: classSelectorDictionary metaClassSelectors: metaClassSelectorDictionary 
	classSelectors := classSelectorDictionary.
	metaClassSelectors := metaClassSelectorDictionary! !

!RBSelectorEnvironment methodsFor: 'testing' stamp: 'lr 8/7/2009 13:00'!
isSelectorEnvironment
	^ true! !

!RBSelectorEnvironment methodsFor: 'private' stamp: ''!
defaultLabel
	^'some methods'! !

!RBSelectorEnvironment methodsFor: 'copying' stamp: 'lr 2/26/2009 14:29'!
postCopy
	| newDict |
	super postCopy.
	newDict := classSelectors copy.
	newDict keysAndValuesDo: [:key :value | newDict at: key put: value copy].
	classSelectors := newDict.
	newDict := metaClassSelectors copy.
	newDict keysAndValuesDo: [:key :value | newDict at: key put: value copy].
	metaClassSelectors := newDict! !

!RBSelectorEnvironment methodsFor: '*manifest-core' stamp: 'YuriyTymchuk 10/13/2014 13:46'!
smallLintCritics
	
	| array |
			
	array := OrderedCollection new.
	self classes do: [:cl | 
		self selectorsForClass: cl do: [:sel | array add:  (cl>>sel)]]. 
			
	^ array! !

!RBSelectorEnvironment methodsFor: 'accessing' stamp: ''!
selectorsForClass: aClass do: aBlock 
	^(self privateSelectorsForClass: aClass) 
		do: [:each | (aClass includesSelector: each) ifTrue: [aBlock value: each]]! !

!RBSelectorEnvironment class methodsFor: 'instance creation' stamp: 'lr 9/14/2010 12:07'!
referencesTo: aLiteral in: anEnvironment 
	| classDict literalPrintString specialFlag specialByte |
	literalPrintString := aLiteral isVariableBinding
		ifTrue: [ aLiteral key asString ]
		ifFalse: [
			aLiteral isString
				ifTrue: [ aLiteral ]
				ifFalse: [ aLiteral printString ] ].
	classDict := IdentityDictionary new.
	specialFlag := Smalltalk
		hasSpecialSelector: aLiteral
		ifTrueSetByte: [ :byte | specialByte := byte ].
	anEnvironment classesDo: [ :class | 
		| selectors |
		selectors := (class thoroughWhichSelectorsReferTo: aLiteral special: specialFlag byte: specialByte)
			select: [ :selector | anEnvironment includesSelector: selector in: class ].
		selectors isEmpty 
			ifFalse: [ classDict at: class put: selectors asIdentitySet ] ].
	^ (self onEnvironment: anEnvironment)
		on: classDict;
		label: 'References to: ' , literalPrintString;
		searchStrings: (Array with: literalPrintString);
		yourself! !

!RBSelectorEnvironment class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/2/2013 23:28'!
implementorsMatching: aString
	^ self 
		implementorsMatching: aString 
		in: self default! !

!RBSelectorEnvironment class methodsFor: 'instance creation' stamp: 'lr 9/14/2010 12:01'!
matches: aString in: anEnvironment 
	| newEnvironment |
	newEnvironment := (self onEnvironment: anEnvironment)
		label: 'Matching: ' , aString;
		searchStrings: (Array with: aString);
		yourself.
	anEnvironment classesAndSelectorsDo: [ :class :selector | 
		| method |
		method := class compiledMethodAt: selector.
		method allLiterals do: [ :literal | 
			literal isString ifTrue: [
				(aString match: literal)
					ifTrue: [ newEnvironment addClass: class selector: selector ] ] ] ].
	^ newEnvironment! !

!RBSelectorEnvironment class methodsFor: 'instance creation' stamp: 'lr 9/14/2010 12:06'!
onMethods: selectorCollection forClass: aClass in: anEnvironment 
	| environemnt |
	environemnt := self onEnvironment: anEnvironment.
	selectorCollection do: [ :each | environemnt addClass: aClass selector: each ].
	^ environemnt! !

!RBSelectorEnvironment class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/2/2013 23:30'!
referencesTo: aLiteral
	^ self
		referencesTo: aLiteral
		in: self default ! !

!RBSelectorEnvironment class methodsFor: 'instance creation' stamp: 'lr 9/14/2010 11:59'!
implementorsMatching: aString in: anEnvironment 
	| classDict metaDict |
	classDict := IdentityDictionary new.
	metaDict := IdentityDictionary new.
	anEnvironment classesDo: [ :class | 
		| selectors |
		selectors := IdentitySet new.
		anEnvironment selectorsForClass: class
			do: [ :each | (aString match: each) ifTrue: [ selectors add: each ] ].
		selectors isEmpty ifFalse: [
			class isMeta 
				ifTrue: [ metaDict at: class soleInstance name put: selectors ]
				ifFalse: [ classDict at: class name put: selectors ] ] ].
	^ (self onEnvironment: anEnvironment)
		classSelectors: classDict metaClassSelectors: metaDict;
		label: 'Implementors of ' , aString;
		yourself! !

!RBSelectorEnvironment class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/2/2013 23:29'!
implementorsOf: aSelector
	^ self
		implementorsOf: aSelector
		in: self default ! !

!RBSelectorEnvironment class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/2/2013 23:29'!
matches: aString
	^ self
		matches: aString
		in: self default! !

!RBSelectorEnvironment class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/2/2013 23:29'!
onMethods: selectorCollection forClass: aClass
	^ self
		onMethods: selectorCollection
		forClass: aClass
		in: self default ! !

!RBSelectorEnvironment class methodsFor: 'instance creation' stamp: 'SebastianTleye 8/2/2013 09:52'!
implementorsOf: aSelector in: anEnvironment 
	| classDict metaDict selectors |
	classDict := IdentityDictionary new.
	metaDict := IdentityDictionary new.
	selectors := IdentitySet with: aSelector.
	anEnvironment classesDo: [ :class | 
		((class includesLocalSelector: aSelector) and: [ anEnvironment includesSelector: aSelector in: class ]) 
			ifTrue: [
				class isMeta 
					ifTrue: [ metaDict at: class soleInstance name put: selectors copy ]
					ifFalse: [ classDict at: class name put: selectors copy ] ] ].
	^ (self onEnvironment: anEnvironment)
		classSelectors: classDict metaClassSelectors: metaDict;
		label: 'Implementors of ' , aSelector;
		yourself! !

!RBSelfNode commentStamp: '<historical>'!
I am a specialized version for the 'self'!
!RBSelfNode methodsFor: '*SmartSuggestions' stamp: 'GiselaDecuzzi 4/16/2013 17:14'!
specialCommands 
	^#().! !

!RBSelfNode methodsFor: 'testing' stamp: 'CamilloBruni 12/15/2011 14:33'!
isSelf
	^ true! !

!RBSelfNode methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:38'!
acceptVisitor: aProgramNodeVisitor 
	^ aProgramNodeVisitor visitSelfNode: self! !

!RBSendsDeprecatedMethodToGlobalRule commentStamp: 'StephaneDucasse 11/29/2014 23:03'!
Checks for sends of deprecated messages that might be removed in upcoming releases of Pharo.!
!RBSendsDeprecatedMethodToGlobalRule methodsFor: 'initialization' stamp: 'CamilleTeruel 3/22/2013 11:30'!
initialize
	| patterns pattern wellKnownGlobals |
	super initialize.
	patterns := OrderedCollection new.
	wellKnownGlobals := IdentityDictionary new.
	Smalltalk globals keysAndValuesDo: [ :name :object |
		object isBehavior ifFalse: [
			(wellKnownGlobals
				at: object class
				ifAbsentPut: [ IdentitySet new ])
					add: name ] ].
	self selectors do: [ :symbol |
		(RBBrowserEnvironment new referencesTo: symbol) classesAndSelectorsDo: [ :class :selector |
			class isMeta
				ifTrue: [
					class withAllSubclassesDo: [ :subclass |
						patterns add: (String
							streamContents: [ :stream | 
								stream
									nextPutAll: subclass theNonMetaClass name;
									nextPutAll: (self genericPatternForSelector: selector) ]) ] ]
				ifFalse: [
					wellKnownGlobals keysAndValuesDo: [ :global :names |
						(global includesBehavior: class) ifTrue: [
							names do: [ :each | 
								patterns add: (String streamContents: [ :stream | 
									stream 
										nextPutAll: each;
										nextPutAll: (self genericPatternForSelector: selector) ]) ] ] ] ] ] ].
	self matcher
		matchesAnyOf: patterns
		do: [ :node :answer | node ]! !

!RBSendsDeprecatedMethodToGlobalRule methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:04'!
selectors
	^ #(deprecated: deprecated:on:in: deprecated:explanation: deprecated:block: greaseDeprecatedApi:details:)! !

!RBSendsDeprecatedMethodToGlobalRule methodsFor: 'accessing' stamp: 'lr 3/17/2010 17:54'!
group
	^ 'Pharo bugs'! !

!RBSendsDeprecatedMethodToGlobalRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:12'!
severity
	^ #error! !

!RBSendsDeprecatedMethodToGlobalRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:28'!
category 
	^ 'Design Flaws'! !

!RBSendsDeprecatedMethodToGlobalRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Sends a deprecated message to a known global'! !

!RBSendsDeprecatedMethodToGlobalRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'SendsDeprecatedMethodToGlobalRule'! !

!RBSendsDifferentSuperRule commentStamp: 'StephaneDucasse 11/29/2014 20:25'!
Checks for methods whose source sends a different super message.

A common example of this is in creation methods. You might define a method such as:

	createInstance
		^super new initialize

If the new method is not defined in the class, you should probably rewrite this to use self instead. Also, if the new method is defined, you might question why you need to send new to the superclass instead of to the class.!
!RBSendsDifferentSuperRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
rationale
	^ 'Checks for methods whose source sends a different super message.'! !

!RBSendsDifferentSuperRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Possible bugs'! !

!RBSendsDifferentSuperRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Sends different super message'! !

!RBSendsDifferentSuperRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 14:08'!
category
	^ 'Design Flaws'! !

!RBSendsDifferentSuperRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:02'!
checkMethod: aMethod 
	| message |
	(message := (aMethod superMessages)
		detect: [ :each | each ~= aMethod selector ]
		ifNone: [ nil ]) notNil ifTrue: 
		[ result
			addSearchString: message;
			addMethod: aMethod ] ! !

!RBSendsDifferentSuperRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'SendsDifferentSuperRule'! !

!RBSendsMethodDictRule commentStamp: 'StephaneDucasse 11/29/2014 20:24'!
Nobody should directly access the method dictionary. It is purely an implementation artefact that we use one dictionary and it might change in the future.!
!RBSendsMethodDictRule methodsFor: 'accessing' stamp: 'MarcusDenker 10/6/2013 08:47'!
rationale
	^ 'nobody should directly access the method dictionary. It is purely an implementation artefact that we use one dictionary and it might change in the future'! !

!RBSendsMethodDictRule methodsFor: 'accessing' stamp: 'MarcusDenker 10/6/2013 08:44'!
group
	^ 'Bugs'! !

!RBSendsMethodDictRule methodsFor: 'accessing' stamp: 'MarcusDenker 10/6/2013 08:44'!
severity
	^ #error! !

!RBSendsMethodDictRule methodsFor: 'accessing' stamp: 'MarcusDenker 10/6/2013 08:44'!
category 
	^ 'Bugs'! !

!RBSendsMethodDictRule methodsFor: 'accessing' stamp: 'MarcusDenker 10/6/2013 08:47'!
name
	^ 'No direct access of methodDict'! !

!RBSendsMethodDictRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:03'!
checkMethod: aMethod
	({Behavior. ClassDescription. Class.TBehavior . TClassDescription . TApplyingOnClassSide } includes: aMethod methodClass)
		ifTrue: [ ^ self ].
	(aMethod messages includes: #methodDict)
		ifTrue: [ 
			result
				addMethod: aMethod;
				addSearchString: 'methodDict' ]! !

!RBSendsMethodDictRule class methodsFor: 'accessing' stamp: 'MarcusDenker 10/6/2013 08:57'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'NobodyShouldSendMethodDict'! !

!RBSendsUnknownMessageToGlobalRule commentStamp: 'StephaneDucasse 11/29/2014 23:01'!
Checks for messages that are sent but not implemented by a global. Reported methods will certainly cause a doesNotUnderstand: message when they are executed.!
!RBSendsUnknownMessageToGlobalRule methodsFor: 'initialization' stamp: 'lr 8/15/2010 17:17'!
initialize
	super initialize.
	self matcher 
		matches: '`{:node :context | node isVariable and: [ Smalltalk includesKey: node name asSymbol ] } `@message: `@args'
		do: [ :node :answer | 
			answer isNil 
				ifTrue: [
					| what |
					what := Smalltalk globals at: node receiver name asSymbol.
					(what notNil and: [ (what respondsTo: node selector) not ]) 
						ifTrue: [ node ]
						ifFalse: [ nil ] ]
				ifFalse: [ answer ] ]! !

!RBSendsUnknownMessageToGlobalRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Bugs'! !

!RBSendsUnknownMessageToGlobalRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:04'!
severity
	^ #error! !

!RBSendsUnknownMessageToGlobalRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Sends unknown message to global'! !

!RBSendsUnknownMessageToGlobalRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:29'!
category 
	^ 'Bugs'! !

!RBSendsUnknownMessageToGlobalRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'SendsUnknownMessageToGlobalRule'! !

!RBSentNotImplementedRule commentStamp: 'StephaneDucasse 11/29/2014 20:24'!
This smell arises when a message is sent by a method,  but no class in the system implements such a message. This method sent will certainly cause a doesNotUnderstand: message when they are executed.  Further this rule checks if messages sent to self or super exist in the hierarchy, since these can be statically typed.!
!RBSentNotImplementedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
rationale
	^ 'Checks for messages that are sent by a method, but no class in the system implements such a message. Further checks if messages sent to self or super exist in the hierarchy, since these can be statically typed. Reported methods will certainly cause a doesNotUnderstand: message when they are executed.'! !

!RBSentNotImplementedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Bugs'! !

!RBSentNotImplementedRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:04'!
severity
	^ #error! !

!RBSentNotImplementedRule methodsFor: 'accessing' stamp: 'Simon 8/30/2012 13:51'!
category 
	^ 'Bugs'! !

!RBSentNotImplementedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Messages sent but not implemented'! !

!RBSentNotImplementedRule methodsFor: 'running' stamp: 'MarcusDenker 10/19/2014 11:06'!
checkMethod: aMethod 
	| message |
	message := aMethod messages 
		"here we need to take the environemnt into account that the code critique is run on. Maybe environemnts need to cache implemnted symbols"
		detect: [ :each | ("SystemNavigation default implementorsExistOf: each"true ) not ]
		ifNone: 
			[ aMethod superMessages 
				detect: 
					[ :each | 
					aMethod methodClass superclass isNil or: [ (aMethod methodClass superclass canUnderstand: each) not ] ]
				ifNone: 
					[ aMethod selfMessages 
						detect: [ :each | (aMethod methodClass allSelectors includes: each) not ]
						ifNone: [ nil ] ] ].
	message notNil ifTrue: [
		result
			addSearchString: message;
			addMethod: aMethod ]! !

!RBSentNotImplementedRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'SentNotImplementedRule'! !

!RBSequenceNode commentStamp: '<historical>'!
RBSequenceNode is an AST node that represents a sequence of statements. Both RBBlockNodes and RBMethodNodes contain these.

Instance Variables:
	leftBar	<Integer | nil>	the position of the left | in the temporaries definition
	periods	<SequenceableCollection of: Integer>	the positions of all the periods that separate the statements
	rightBar	<Integer | nil>	the position of the right | in the temporaries definition
	statements	<SequenceableCollection of: RBStatementNode>	the statement nodes
	temporaries	<SequenceableCollection of: RBVariableNode>	the temporaries defined

!
!RBSequenceNode methodsFor: 'accessing-token' stamp: 'lr 2/12/2010 19:21'!
periods: anArray
	periods := anArray! !

!RBSequenceNode methodsFor: '*SmartSuggestions' stamp: 'GiselaDecuzzi 4/19/2013 10:08'!
specialCommands 
	^ SugsSuggestionFactory commandsForSource.! !

!RBSequenceNode methodsFor: 'adding nodes' stamp: 'lr 1/4/2012 21:44'!
addNodesFirst: aCollection
	aCollection do: [ :each | each parent: self ].
	statements := statements asOrderedCollection
		addAllFirst: aCollection;
		yourself.
	^ aCollection! !

!RBSequenceNode methodsFor: 'accessing' stamp: ''!
children
	^(OrderedCollection new)
		addAll: self temporaries;
		addAll: self statements;
		yourself! !

!RBSequenceNode methodsFor: 'querying' stamp: ''!
bestNodeFor: anInterval 
	| node |
	node := super bestNodeFor: anInterval.
	node == self 
		ifTrue: 
			[(temporaries isEmpty and: [statements size == 1]) 
				ifTrue: [^statements first]].
	^node! !

!RBSequenceNode methodsFor: 'testing' stamp: ''!
isSequence
	^true! !

!RBSequenceNode methodsFor: 'adding nodes' stamp: 'lr 1/4/2012 21:45'!
addTemporaryNamed: aString 
	| variableNode |
	variableNode := RBVariableNode named: aString.
	variableNode parent: self.
	temporaries := temporaries copyWith: variableNode.
	^ variableNode! !

!RBSequenceNode methodsFor: 'accessing' stamp: ''!
temporaryVariables
	^(super temporaryVariables asOrderedCollection)
		addAll: self temporaryNames;
		yourself! !

!RBSequenceNode methodsFor: 'initialization' stamp: 'lr 2/19/2010 14:44'!
initialize
	super initialize.
	periods := statements := temporaries := #()! !

!RBSequenceNode methodsFor: 'adding nodes' stamp: 'lr 1/4/2012 21:42'!
addNodeFirst: aNode
	aNode parent: self.
	statements := statements asOrderedCollection
		addFirst: aNode;
		yourself.
	^ aNode! !

!RBSequenceNode methodsFor: 'accessing' stamp: ''!
statements: stmtCollection 
	statements := stmtCollection.
	statements do: [:each | each parent: self]! !

!RBSequenceNode methodsFor: 'testing' stamp: ''!
references: aVariableName 
	^statements anySatisfy: [:each | each references: aVariableName]! !

!RBSequenceNode methodsFor: 'accessing' stamp: ''!
temporaries: tempCollection 
	temporaries := tempCollection.
	temporaries do: [:each | each parent: self]! !

!RBSequenceNode methodsFor: 'accessing-token' stamp: 'lr 11/1/2009 20:30'!
periods
	^ periods! !

!RBSequenceNode methodsFor: 'testing' stamp: ''!
isLast: aNode 
	| last |
	statements isEmpty ifTrue: [^false].
	last := statements last.
	^last == aNode or: 
			[last isMessage and: 
					[(#(#ifTrue:ifFalse: #ifFalse:ifTrue:) includes: last selector) 
						and: [last arguments anySatisfy: [:each | each isLast: aNode]]]]! !

!RBSequenceNode methodsFor: 'accessing' stamp: ''!
removeTemporaryNamed: aName 
	temporaries := temporaries reject: [:each | each name = aName]! !

!RBSequenceNode methodsFor: 'converting' stamp: 'MarcusDenker 1/29/2013 14:19'!
asSequenceNode
	^self! !

!RBSequenceNode methodsFor: 'testing' stamp: ''!
uses: aNode 
	statements isEmpty ifTrue: [^false].
	aNode == statements last ifFalse: [^false].
	^self isUsed! !

!RBSequenceNode methodsFor: 'replacing' stamp: ''!
replaceNode: aNode withNode: anotherNode 
	self statements: (statements 
				collect: [:each | each == aNode ifTrue: [anotherNode] ifFalse: [each]]).
	self temporaries: (temporaries 
				collect: [:each | each == aNode ifTrue: [anotherNode] ifFalse: [each]])! !

!RBSequenceNode methodsFor: 'replacing' stamp: ''!
replaceNode: aNode withNodes: aCollection 
	| index newStatements |
	self clearReplacements.
	index := self indexOfNode: aNode.
	newStatements := OrderedCollection new: statements size + aCollection size.
	1 to: index - 1 do: [:i | newStatements add: (statements at: i)].
	newStatements addAll: aCollection.
	index + 1 to: statements size
		do: [:i | newStatements add: (statements at: i)].
	aCollection do: [:each | each parent: self].
	statements := newStatements! !

!RBSequenceNode methodsFor: 'testing' stamp: ''!
defines: aName 
	^temporaries anySatisfy: [:each | each name = aName]! !

!RBSequenceNode methodsFor: 'copying' stamp: 'lr 11/1/2009 22:37'!
postCopy
	super postCopy.
	self temporaries: (self temporaries collect: [ :each | each copy ]).
	self statements: (self statements collect: [ :each | each copy ])! !

!RBSequenceNode methodsFor: 'matching' stamp: 'lr 5/30/2010 11:35'!
match: aNode inContext: aDictionary 
	self class = aNode class ifFalse: [^false].
	^(self 
		matchList: temporaries
		against: aNode temporaries
		inContext: aDictionary) and: 
				[self 
					matchList: statements
					against: aNode statements
					inContext: aDictionary]! !

!RBSequenceNode methodsFor: 'accessing' stamp: ''!
temporaries
	^temporaries! !

!RBSequenceNode methodsFor: 'accessing' stamp: ''!
allDefinedVariables
	^(self temporaryNames asOrderedCollection)
		addAll: super allDefinedVariables;
		yourself! !

!RBSequenceNode methodsFor: '*opalcompiler-core' stamp: 'MarcusDenker 5/19/2013 16:00'!
transformLastToReturn
	| last |
	statements ifEmpty: [ ^self].
	last := statements last.
	last isReturn ifFalse: [self replaceNode: last withNode: (RBReturnNode value: last )]! !

!RBSequenceNode methodsFor: 'accessing' stamp: 'lr 1/4/2012 21:38'!
addReturn
	| node |
	statements isEmpty
		ifTrue: [ ^ nil ].
	statements last isReturn
		ifTrue: [ ^ statements last ].
	node := RBReturnNode value: statements last.
	statements at: statements size put: node.
	node parent: self.
	^ node! !

!RBSequenceNode methodsFor: 'testing' stamp: ''!
directlyUses: aNode 
	^false! !

!RBSequenceNode methodsFor: 'adding nodes' stamp: 'lr 1/4/2012 21:44'!
addNodes: aCollection before: anotherNode
	aCollection do: [ :each | self addNode: each before: anotherNode ].
	^ aCollection! !

!RBSequenceNode methodsFor: 'initialize-release' stamp: ''!
leftBar: leftInteger temporaries: variableNodes rightBar: rightInteger 
	leftBar := leftInteger.
	self temporaries: variableNodes.
	rightBar := rightInteger! !

!RBSequenceNode methodsFor: 'accessing-token' stamp: 'lr 2/12/2010 19:22'!
leftBar: anInteger
	leftBar := anInteger! !

!RBSequenceNode methodsFor: 'testing' stamp: 'GiselaDecuzzi 6/5/2013 10:30'!
isFaulty
	^self statements anySatisfy: #isFaulty.! !

!RBSequenceNode methodsFor: 'adding nodes' stamp: 'lr 1/4/2012 21:39'!
addSelfReturn
	| node |
	self lastIsReturn
		ifTrue: [ ^ self statements last ].
	node := RBReturnNode value: (RBVariableNode named: 'self').
	^ self addNode: node! !

!RBSequenceNode methodsFor: 'accessing' stamp: ''!
temporaryNames
	^temporaries collect: [:each | each name]! !

!RBSequenceNode methodsFor: 'accessing' stamp: ''!
statements
	^statements! !

!RBSequenceNode methodsFor: 'accessing' stamp: 'ClementBera 7/26/2013 17:14'!
start
	^ leftBar 
		ifNil: [statements isEmpty ifTrue: [1] ifFalse: [statements first start]]! !

!RBSequenceNode methodsFor: 'private' stamp: ''!
indexOfNode: aNode 
	"Try to find the node by first looking for ==, and then for ="

	^(1 to: statements size) detect: [:each | (statements at: each) == aNode]
		ifNone: [statements indexOf: aNode]! !

!RBSequenceNode methodsFor: 'accessing-token' stamp: 'lr 1/11/2010 15:42'!
leftBar
	^ leftBar! !

!RBSequenceNode methodsFor: 'testing' stamp: ''!
lastIsReturn
	^statements notEmpty and: [statements last lastIsReturn]! !

!RBSequenceNode methodsFor: 'comparing' stamp: 'lr 3/7/2010 13:48'!
hash
	^ (self hashForCollection: self temporaries) bitXor: (self hashForCollection: self statements)! !

!RBSequenceNode methodsFor: 'matching' stamp: 'lr 11/24/2009 23:35'!
copyInContext: aDictionary 
	^ self class new
		temporaries: (self copyList: self temporaries inContext: aDictionary);
		statements: (self copyList: self statements inContext: aDictionary);
		yourself! !

!RBSequenceNode methodsFor: 'querying' stamp: ''!
whichNodeIsContainedBy: anInterval 
	| node |
	node := super whichNodeIsContainedBy: anInterval.
	node == self 
		ifTrue: 
			[(temporaries isEmpty and: [statements size == 1]) 
				ifTrue: [^statements first]].
	^node! !

!RBSequenceNode methodsFor: 'accessing' stamp: ''!
stop
	^(periods isEmpty ifTrue: [0] ifFalse: [periods last]) 
		max: (statements isEmpty ifTrue: [0] ifFalse: [statements last stop])! !

!RBSequenceNode methodsFor: 'accessing' stamp: ''!
allTemporaryVariables
	^(self temporaryNames asOrderedCollection)
		addAll: super allTemporaryVariables;
		yourself! !

!RBSequenceNode methodsFor: 'adding nodes' stamp: 'lr 1/4/2012 21:43'!
addNodes: aCollection
	aCollection do: [ :each | each parent: self ].
	(statements notEmpty and: [ statements last isReturn ])
		ifTrue: [ self error: 'Cannot add statement after return node' ].
	statements := statements asOrderedCollection
		addAll: aCollection;
		yourself.
	^ aCollection! !

!RBSequenceNode methodsFor: 'comparing' stamp: 'BernardoContreras 8/24/2014 20:23'!
equalTo: anObject withMapping: aDictionary 
	self class = anObject class ifFalse: [^false].
	self statements size = anObject statements size ifFalse: [^false].
	self statements
		with: anObject statements
		do: [:first :second | (first equalTo: second withMapping: aDictionary) ifFalse: [^false]].
	aDictionary values asSet size = aDictionary size ifFalse: [^false].	"Not a one-to-one mapping"
	self temporaries
		do: [:each | aDictionary removeKey: each name ifAbsent: []].
	^true! !

!RBSequenceNode methodsFor: 'accessing-token' stamp: 'lr 2/12/2010 19:22'!
rightBar: anInteger
	rightBar := anInteger! !

!RBSequenceNode methodsFor: 'adding nodes' stamp: 'lr 1/4/2012 21:40'!
addNode: aNode
	aNode parent: self.
	(statements notEmpty and: [ statements last isReturn ])
		ifTrue: [ self error: 'Cannot add statement after return node' ].
	statements := statements asOrderedCollection
		add: aNode;
		yourself.
	^ aNode! !

!RBSequenceNode methodsFor: 'adding nodes' stamp: 'lr 1/4/2012 21:41'!
addNode: aNode before: anotherNode
	| index |
	index := self indexOfNode: anotherNode.
	index = 0
		ifTrue: [ ^ self addNode: aNode ].
	statements := statements asOrderedCollection
		add: aNode beforeIndex: index;
		yourself.
	aNode parent: self.
	^ aNode! !

!RBSequenceNode methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:38'!
acceptVisitor: aProgramNodeVisitor 
	^aProgramNodeVisitor visitSequenceNode: self! !

!RBSequenceNode methodsFor: 'comparing' stamp: 'BernardoContreras 8/24/2014 20:20'!
= anObject 
	"Can't send = to the temporaries and statements collection since they might change from arrays to OCs"

	self == anObject ifTrue: [^true].
	self class = anObject class ifFalse: [^false].
	self temporaries size = anObject temporaries size ifFalse: [^false].
	self temporaries
		with: anObject temporaries
		do: [:first :second | first = second ifFalse: [^false]].
	self statements size = anObject statements size ifFalse: [^false].
	self statements
		with: anObject statements
		do: [:first :second | first = second ifFalse: [^false]].
	^true! !

!RBSequenceNode methodsFor: 'replacing' stamp: ''!
removeNode: aNode
	self replaceNode: aNode withNodes: #()! !

!RBSequenceNode methodsFor: 'accessing-token' stamp: 'lr 1/11/2010 15:42'!
rightBar
	^ rightBar! !

!RBSequenceNode methodsFor: 'accessing' stamp: 'PabloHerrero 11/7/2013 11:27'!
methodComments
	| methodComments |
	methodComments := OrderedCollection withAll: self comments.
	temporaries do: [:each | methodComments addAll: each comments].
	(parent notNil and: [parent isBlock]) 
		ifTrue: [parent arguments do: [:each | methodComments addAll: each comments]].
	^methodComments asSortedCollection: [:a :b | a start < b start]! !

!RBSequenceNode methodsFor: 'replacing' stamp: 'lr 11/1/2009 20:34'!
removeDeadCode
	(self isUsed ifTrue: [statements size - 1] ifFalse: [statements size]) 
		to: 1
		by: -1
		do: 
			[:i | 
			(statements at: i) isImmediateNode 
				ifTrue: 
					[self clearReplacements.
					statements removeAt: i]].
	super removeDeadCode! !

!RBSequenceNode methodsFor: 'adding nodes' stamp: 'lr 1/4/2012 21:45'!
addTemporariesNamed: aCollection
	^ aCollection collect: [ :each | self addTemporaryNamed: each ]! !

!RBSequenceNode class methodsFor: 'instance creation' stamp: ''!
leftBar: leftInteger temporaries: variableNodes rightBar: rightInteger 
	^(self new)
		leftBar: leftInteger
			temporaries: variableNodes
			rightBar: rightInteger;
		yourself! !

!RBSequenceNode class methodsFor: 'instance creation' stamp: ''!
temporaries: variableNodes statements: statementNodes 
	^(self new)
		temporaries: variableNodes;
		statements: statementNodes;
		yourself! !

!RBSequenceNode class methodsFor: 'instance creation' stamp: ''!
statements: statementNodes 
	^self temporaries: #() statements: statementNodes! !

!RBShortAssignmentToken methodsFor: 'private' stamp: 'lr 11/1/2009 20:45'!
length
	^ 1! !

!RBShouldntRaiseErrorRule commentStamp: 'StephaneDucasse 11/29/2014 18:39'!
#shouldnt:raise: is a rather tricky method, it is mostly used to make a
test "read" nicer, however it some severe drawbacks. Hence, it should only
be used in certain cases. Consider the following examples.

Example 1:
----------
	self
		shouldnt: [ 1 somethingNotUnderstood ]
		raise: MessageNotUnderstood.

In this particular case the expectations meet the result, the test fails with
an assertion failure since a MNU is raised.

Example 2:
----------
	self shouldnt: [ 1/0 ] raise: MessageNotUnderstood.

In this case the test will fail with a ZeroDivide. So in the negative case
#shouldnt:raise: is not very helpful. 

As a result, #shouldnt:raise: does not change much on the test outcome, the
statement itself produces the same failures. However there is the third and
most common use case.

Example 3:
----------
	self shouldnt: [ 1/0 ] raise: Error.

In this case the test fails, as expected, however not on a ZeroDivide but an
internal error message that shadows the real error. Using Error as argument for
#shouldnt:raise: shadows any possible error that might happen and thus should
be avoided.!
!RBShouldntRaiseErrorRule methodsFor: 'initialization' stamp: 'CamilloBruni 11/4/2013 19:43'!
initialize
	super initialize.
	self rewriteRule
		replace: 'self shouldnt: [ `@statements ] raise: Error' with: '`@statements';
		replace: 'self shouldnt: [ `@statements ] raise: Exception' with: '`@statements'! !

!RBShouldntRaiseErrorRule methodsFor: 'accessing' stamp: 'CamilloBruni 11/4/2013 19:30'!
rationale 
	^ 'Replaces `shouldnt: [ ... ] raise: Error` with  `[ ... ]`'! !

!RBShouldntRaiseErrorRule methodsFor: 'accessing' stamp: 'CamilloBruni 11/4/2013 19:29'!
group
	^ 'Transformations'! !

!RBShouldntRaiseErrorRule methodsFor: 'accessing' stamp: 'MarcusDenker 7/24/2014 13:27'!
name
	^ 'Do not use  `shouldnt: [ ... ] raise: Error` '! !

!RBShouldntRaiseErrorRule methodsFor: 'accessing' stamp: 'CamilloBruni 11/4/2013 19:29'!
category 
	^ 'Coding Idiom Violation'! !

!RBShouldntRaiseErrorRule class methodsFor: 'accessing' stamp: 'CamilloBruni 11/4/2013 23:38'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'ShouldntRaiseErrorRule'! !

!RBSizeCheckRule commentStamp: 'StephaneDucasse 11/29/2014 23:00'!
Check for code that checks that a collection is non-empty before sending it an iteration message (e.g., do:, collect:, etc.). Since the collection iteration messages work for empty collections, we do not need to clutter up our method with the extra size check.!
!RBSizeCheckRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:46'!
initialize
	| patterns |
	super initialize.
	patterns := OrderedCollection new.
	patterns addAll: (self selectors
		collect: [ :each | '`@object size > 0 ifTrue: [`@object' , (self genericPatternForSelector: each) , '. `@.Statements2]' ]).
	patterns addAll: (self selectors
		collect: [ :each | '`@object isEmpty ifFalse: [`@object' , (self genericPatternForSelector: each) , '. `@.Statements2]' ]).
	patterns addAll: (self selectors
		collect: [ :each | '`@object notEmpty ifTrue: [`@object' , (self genericPatternForSelector: each) , '. `@.Statements2]' ]).
	patterns addAll: (self selectors
		collect: [ :each | '`@object size = 0 ifFalse: [`@object' , (self genericPatternForSelector: each) , '. `@.Statements2]' ]).
	self matcher
		matchesAnyOf: patterns
		do: [ :node :answer | node ]! !

!RBSizeCheckRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 23:00'!
rationale
	^ 'Check for code that checks that a collection is non-empty before sending it an iteration message (e.g., do:, collect:, etc.).'! !

!RBSizeCheckRule methodsFor: 'private' stamp: 'lr 2/24/2009 20:47'!
selectors
	^ #( collect: do: reject: select: )! !

!RBSizeCheckRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Intention revealing'! !

!RBSizeCheckRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Unnecessary size check'! !

!RBSizeCheckRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:30'!
category 
	^ 'Optimization'! !

!RBSizeCheckRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'SizeCheckRule'! !

!RBSmalllintChecker commentStamp: '<historical>'!
I apply a lint rule to all classes and methods in a given environment.

My main API is 

- ==run== which resets and runs the rules.!
!RBSmalllintChecker methodsFor: 'accessing' stamp: ''!
methodBlock: aBlock 
	methodBlock := aBlock! !

!RBSmalllintChecker methodsFor: 'initialization' stamp: 'CamilloBruni 5/7/2013 17:38'!
initialize
	methodBlock := [].
	environment := RBBrowserEnvironment new.
	context := RBSmalllintContext newNoCache! !

!RBSmalllintChecker methodsFor: 'initialize-release' stamp: ''!
release
	context release.
	super release! !

!RBSmalllintChecker methodsFor: 'accessing' stamp: ''!
rule: aLintRule 
	rule := aLintRule! !

!RBSmalllintChecker methodsFor: 'accessing' stamp: ''!
context: aSmalllintContext 
	context := aSmalllintContext! !

!RBSmalllintChecker methodsFor: 'private' stamp: 'NicolaiHess 10/18/2014 15:30'!
checkMethodsForClass: aClass
	^ environment
		selectorsForClass: aClass
		do: [ :each | 
			rule checkMethod: aClass>>each.
			methodBlock value ]! !

!RBSmalllintChecker methodsFor: 'accessing' stamp: ''!
environment: aBrowserEnvironment 
	environment := aBrowserEnvironment! !

!RBSmalllintChecker methodsFor: 'actions' stamp: 'YuriyTymchuk 9/29/2014 20:21'!
run
	rule resetResult.
	environment classesAndTraits
		do: [ :class |
			self checkClass: class.
			self checkMethodsForClass: class.
			
			self checkClass: class classSide.
			self checkMethodsForClass: class classSide ]
		displayingProgress: [ :class | 'Running critics on: ', class name ]! !

!RBSmalllintChecker methodsFor: 'private' stamp: 'YuriyTymchuk 9/26/2014 17:51'!
checkClass: aClass 
	(environment includesClass: aClass) ifTrue: [rule checkClass: aClass]! !

!RBSmalllintChecker class methodsFor: 'instance creation' stamp: 'nk 11/12/2002 13:12'!
runRule: aLintRule
	(self new)
		rule: aLintRule;
		run.
	^aLintRule! !

!RBSmalllintChecker class methodsFor: 'instance creation' stamp: ''!
runRule: aLintRule onEnvironment: aBrowserEnvironment 
	(self new)
		rule: aLintRule;
		environment: aBrowserEnvironment;
		run.
	^aLintRule! !

!RBSmalllintChecker class methodsFor: 'instance creation' stamp: 'lr 9/8/2011 20:15'!
newWithContext
	^(self new)
		context: RBSmalllintContext new;
		yourself! !

!RBSmalllintContext methodsFor: 'accessing' stamp: ''!
selector
	^selector! !

!RBSmalllintContext methodsFor: 'accessing' stamp: ''!
parseTree
	^parseTree isNil
		ifTrue: [parseTree := self buildParseTree]
		ifFalse: [parseTree]! !

!RBSmalllintContext methodsFor: 'testing' stamp: 'lr 3/7/2011 21:40'!
includesBehaviorNamed: aClassName
	| current |
	current := self selectedClass.
	[ current isNil ] whileFalse: [
		current name = aClassName
			ifTrue: [ ^ true ].
		current := current superclass ].
	^ false! !

!RBSmalllintContext methodsFor: 'accessing' stamp: ''!
instVarNames
	^self selectedClass allInstVarNames! !

!RBSmalllintContext methodsFor: 'accessing' stamp: ''!
selfMessages
	selfMessages isNil ifTrue: [self computeMessages].
	^selfMessages! !

!RBSmalllintContext methodsFor: 'initialization' stamp: ''!
initialize
	self computeLiterals! !

!RBSmalllintContext methodsFor: 'printing' stamp: 'lr 3/28/2009 14:39'!
printOn: aStream
	super printOn: aStream.
	self selectedClass isNil ifFalse: [ 
		aStream nextPut: $ ; nextPutAll: self selectedClass name.
		self selector isNil ifFalse: [ 
			aStream nextPutAll: '>>'; print: self selector ] ]! !

!RBSmalllintContext methodsFor: 'accessing' stamp: ''!
messages
	messages isNil ifTrue: [self computeMessages].
	^messages! !

!RBSmalllintContext methodsFor: 'accessing' stamp: ''!
selectedClass: anObject 
	class := anObject.
	self selector: nil! !

!RBSmalllintContext methodsFor: 'accessing' stamp: 'nk 2/26/2005 10:19'!
sourceCode
	^self selectedClass sourceCodeAt: self selector ifAbsent: [ '' ].! !

!RBSmalllintContext methodsFor: 'private' stamp: ''!
buildParseTree
	| tree |
	tree := self selectedClass parseTreeFor: self selector.
	tree isNil ifTrue: [^RBParser parseMethod: 'method'].
	^tree! !

!RBSmalllintContext methodsFor: 'private' stamp: 'lr 11/2/2009 00:14'!
computeMessages
	| searcher |
	selfMessages := Set new.
	superMessages := Set new.
	messages := Set new.
	searcher := RBParseTreeSearcher new.
	searcher
		matches: 'self `@message: ``@args'
			do: [:aNode :answer | selfMessages add: aNode selector];
		matches: 'super `@message: ``@args'
			do: [:aNode :answer | superMessages add: aNode selector];
		matches: '``@receiver `@message: ``@args'
			do: [:aNode :answer | messages add: aNode selector].
	searcher executeTree: self parseTree initialAnswer: nil! !

!RBSmalllintContext methodsFor: 'initialize-release' stamp: ''!
release
	literalProcess notNil ifTrue: [literalProcess terminate].
	super release! !

!RBSmalllintContext methodsFor: 'testing' stamp: 'lr 7/23/2010 08:05'!
isAbstract: aClass 
	^(aClass isMeta or: 
			[(self literals includes: aClass name)
				or: [self literals includes: (Smalltalk globals associationAt: aClass name)]])
		not! !

!RBSmalllintContext methodsFor: 'accessing' stamp: ''!
protocol
	^self selectedClass whichCategoryIncludesSelector: self selector! !

!RBSmalllintContext methodsFor: 'private' stamp: ''!
computeLiteralsForClass: aClass 
	(selectors addAll: aClass selectors) do: 
			[:sel | 
			self computeLiteralsForSelector: sel in: aClass.
			Processor yield]! !

!RBSmalllintContext methodsFor: 'accessing' stamp: ''!
selectedClass
	^class! !

!RBSmalllintContext methodsFor: 'accessing' stamp: ''!
superMessages
	superMessages isNil ifTrue: [self computeMessages].
	^superMessages! !

!RBSmalllintContext methodsFor: 'testing' stamp: ''!
uses: anObject 
	^self literals includes: anObject! !

!RBSmalllintContext methodsFor: 'accessing' stamp: ''!
selector: anObject 
	selector := anObject.
	parseTree := compiledMethod := selfMessages := superMessages := messages := nil! !

!RBSmalllintContext methodsFor: 'accessing' stamp: ''!
compiledMethod
	^compiledMethod notNil
		ifTrue: [compiledMethod]
		ifFalse: [compiledMethod := class compiledMethodAt: selector]! !

!RBSmalllintContext methodsFor: 'testing' stamp: ''!
implements: aSelector 
	^self selectors includes: aSelector! !

!RBSmalllintContext methodsFor: 'private' stamp: ''!
checkLiteral: aLiteral 
	(aLiteral isSymbol or: [aLiteral isVariableBinding])
		ifTrue: [literals add: aLiteral]
		ifFalse: 
			[aLiteral class == Array
				ifTrue: [aLiteral do: [:each | self checkLiteral: each]]]! !

!RBSmalllintContext methodsFor: 'private' stamp: ''!
computeLiterals
	literalSemaphore := Semaphore new.
	literalProcess := [self primitiveComputeLiterals] fork! !

!RBSmalllintContext methodsFor: 'private' stamp: ''!
computeLiteralsForSelector: aSelector in: aClass 
	| method |
	method := aClass compiledMethodAt: aSelector ifAbsent: [nil].
	method isNil ifTrue: [^self].
	self addLiteralsFor: method! !

!RBSmalllintContext methodsFor: 'private' stamp: 'lr 9/8/2011 20:25'!
primitiveComputeLiterals
	| semaphore |
	literals := IdentitySet new: 25000.
	literals addAll: self specialSelectors keys.
	selectors := IdentitySet new.
	RBBrowserEnvironment new
		classesDo: [ :each | self computeLiteralsForClass: each ].
	semaphore := literalSemaphore.
	literalSemaphore := nil.
	self signalProcesses: semaphore.
	^literalProcess := nil! !

!RBSmalllintContext methodsFor: 'accessing' stamp: ''!
protocols
	^Array with: self protocol! !

!RBSmalllintContext methodsFor: 'private' stamp: ''!
signalProcesses: aSemaphore 
	aSemaphore isNil ifTrue: [^self].
	[aSemaphore isEmpty] whileFalse: [aSemaphore signal]! !

!RBSmalllintContext methodsFor: 'private' stamp: 'lr 2/5/2010 15:50'!
addLiteralsFor: aCompiledMethod
	2 to: aCompiledMethod numLiterals - 1
		do: [ :index | self checkLiteral: (aCompiledMethod objectAt: index) ]! !

!RBSmalllintContext methodsFor: 'accessing' stamp: ''!
selectors
	literalSemaphore isNil
		ifTrue: 
			[selectors isNil ifTrue: 
					[self computeLiterals.
					literalSemaphore wait]]
		ifFalse: [literalSemaphore wait].
	^selectors! !

!RBSmalllintContext methodsFor: 'private' stamp: 'dvf 9/15/2001 17:39'!
specialSelectors
	| answer |
	answer := IdentityDictionary new.
	(Smalltalk specialSelectors select: [:sel | sel isSymbol]) do:
		[:sel | answer at: sel put: nil.].
	^answer.! !

!RBSmalllintContext methodsFor: 'accessing' stamp: ''!
literals
	literalSemaphore isNil
		ifTrue: 
			[literals isNil ifTrue: 
					[self computeLiterals.
					literalSemaphore wait]]
		ifFalse: [literalSemaphore wait].
	^literals! !

!RBSmalllintContext class methodsFor: 'instance creation' stamp: ''!
newNoCache
	^self basicNew! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testDetectContains
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:12'!
testRefersToClass
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'MarcusDenker 9/20/2013 15:35'!
testEquivalentSuperclassMethods
	| returnedEnvironment rule |
	RBSmalllintChecker 
		runRule: (rule := RBEquivalentSuperclassMethodsRule new)
		onEnvironment: self smalllintTestEnvironment.
	returnedEnvironment := RBSelectorEnvironment new.
	returnedEnvironment 
		addClass: RBSmalllintTestObject
		selector: #isLiteral.
	self 
		checkRule: rule
		isEqualTo: returnedEnvironment! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testStringConcatenation
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'as yet unclassified' stamp: 'YuriyTymchuk 7/10/2014 10:40'!
testRBMissingSubclassResponsibilityRule
	| sup sub1 sub2 |
	sup := Object subclass: 'MySuperclass' instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self class category.
	sub1 := sup subclass: 'MySubclass1' instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self class category.
	sub2 := sup subclass: 'MySubclass2' instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self class category.
	
	sub1 compile: 'method ^ 3'.
	sub2 compile: 'method ^ 5'.
	
	self deny: (RBMissingSubclassResponsibilityRule new
		runOnEnvironment: (RBClassEnvironment class: sup);
		result) isEmpty.
	
	sup  compile: 'method ^ 2'.
		
	self assert: (RBMissingSubclassResponsibilityRule new
		runOnEnvironment: (RBClassEnvironment class: sup);
		result) isEmpty.
		
	sup  compile: 'method ^self subclassResponsibility'.
		
	self assert: (RBMissingSubclassResponsibilityRule new
		runOnEnvironment: (RBClassEnvironment class: sup);
		result) isEmpty.
		
	sub1 removeFromSystem.
	sub2 removeFromSystem.
	sup  removeFromSystem! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testToDoWithIncrement
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'CamilloBruni 11/4/2013 23:36'!
testShouldntRaiseError
	self
		ruleFor: self currentSelector
		plusSelectors: #(shouldntRaiseException)! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testCollectionMessagesToExternalObject
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:15'!
testConsistencyCheck
	self 
		ruleFor: self currentSelector
		plusSelectors: #(#noIsNil: )! !

!RBSmalllintTest methodsFor: 'private' stamp: 'lr 12/24/2008 16:50'!
currentSelector
	^ testSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:12'!
testTempVarOverridesInstVar
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:12'!
testTempsReadBeforeWritten
	self ruleFor: self currentSelector
		plusSelectors: #(#inlineTemporary #noMoveDefinition #tempsReadBeforeWritten #equalNotUsed #fileBlocks #referencesConditionFor:)! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testToDoCollect
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testUsesAdd
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testGuardingClause
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testBooleanPrecedence
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testToDo
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testIfTrueReturns
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'private' stamp: 'lr 9/7/2010 20:19'!
compare: subEnvironment to: superEnvironment 
	subEnvironment classesDo: [ :class | 
		(subEnvironment selectorsForClass: class) 
			do: [ :selector | self assert: (superEnvironment includesSelector: selector in: class) ] ]! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 9/7/2010 20:41'!
testUnclassifiedMethods
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:12'!
testReturnsBooleanAndOther
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 9/7/2010 20:50'!
testUncommonMessageSend
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'private' stamp: 'lr 2/26/2009 16:10'!
ruleFor: aSelector 
	self ruleFor: aSelector plusSelectors: #()! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:13'!
testAtIfAbsent
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:15'!
testExtraBlock
	self 
		ruleFor: self currentSelector
		plusSelectors: #(#testMethod1 )! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testReturnInEnsure
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 9/7/2010 20:47'!
testCodeCruftLeftInMethods
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testEqualsTrue
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testCollectionProtocol
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testAssignmentInIfTrue
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testIfTrueBlocks
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:12'!
testLongMethods
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'bh 4/8/2000 19:06'!
testFullBlocks
	"skip this test in squeak"

"	self blockRuleFor: self currentSelector
		plusSelectors: #(#caller1 #fullBlocks #detectContains #fileBlocks #moveDefinition #caller #assignmentInBlock #equalNotUsed #stringConcatenation #noMoveDefinition #referencesConditionFor: #returnInEnsure)"! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testLiteralArrayCharacters
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testFileBlocks
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testCollectSelectNotUsed
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 9/7/2010 21:03'!
testTemporaryVariableCapitalization
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:12'!
testJustSendsSuper
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:13'!
testAssignmentInBlock
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testPrecedence
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'private' stamp: ''!
checkRule: aLintRule isEqualTo: anEnvironment 
	| returnedEnvironment |
	returnedEnvironment := aLintRule result.
	self compare: returnedEnvironment to: anEnvironment.
	self compare: anEnvironment to: returnedEnvironment! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testMinMax
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 9/7/2010 20:58'!
testFloatEqualityComparison
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testSearchingLiteral
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testEqualNotUsed
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 9/7/2010 21:04'!
testAssignmentWithoutEffect
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testEndTrueFalse
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'CamilloBruni 1/15/2013 23:56'!
testBadMessage
	self ruleFor: self currentSelector plusSelectors: #(codeCruftLeftInMethods collectionMessagesToExternalObject)! !

!RBSmalllintTest methodsFor: 'private' stamp: 'lr 9/8/2011 20:32'!
smalllintTestEnvironment
	| classEnvironment |
	classEnvironment := RBClassEnvironment new.
	classEnvironment addClass: RBSmalllintTestObject.
	^ classEnvironment! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:15'!
testMissingYourself
	self 
		ruleFor: self currentSelector
		plusSelectors: #(#inlineMethod )! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testSizeCheck
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testModifiesCollection
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 9/7/2010 21:05'!
testEmptyExceptionHandler
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testReturnsIfTrue
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testContains
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 9/7/2010 20:58'!
testLiteralArrayContainsComma
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 9/7/2010 20:42'!
testUsesTrue
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testThreeElementPoint
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:12'!
testSendsDifferentSuper
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testWhileTrue
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'!
testYourselfNotUsed
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 9/7/2010 20:46'!
testUnoptimizedAndOr
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:13'!
testAsOrderedCollectionNotNeeded
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'tests' stamp: 'lr 9/7/2010 20:56'!
testOnlyReadOrWrittenTemporary
	self ruleFor: self currentSelector! !

!RBSmalllintTest methodsFor: 'private' stamp: 'CamilloBruni 11/4/2013 19:56'!
ruleFor: aSelector plusSelectors: symbolCollection 
	| returnedEnvironment rule class selector className |
	selector := aSelector asString 
		copyFrom: 5
		to: aSelector size.
	className := 'RB' , selector , 'Rule'.
	class := Smalltalk classNamed: className.
	class isNil ifTrue: [ self error: className , ' class not found' ].
	selector 
		at: 1
		put: selector first asLowercase.
	selector := selector asSymbol.
	RBSmalllintChecker 
		runRule: (rule := class new)
		onEnvironment: self smalllintTestEnvironment.
	returnedEnvironment := RBSelectorEnvironment new.
	returnedEnvironment 
		addClass: RBSmalllintTestObject
		selector: selector.
	symbolCollection do: [ :each | 
		returnedEnvironment 
			addClass: RBSmalllintTestObject
			selector: each ].
	self
		assert: (RBSmalllintTestObject includesSelector: selector)
		description: 'Missing test method RBSmalllintTestObject>>', selector printString.
		
	self 
		assert: (rule name isString and: [ rule name notEmpty ])
		description: 'Missing rule name'.
	self 
		assert: (rule group isString and: [ rule group notEmpty ])
		description: 'Missing group name'.
	self 
		assert: (rule rationale isString and: [ rule rationale notEmpty ])
		description: 'Missing rationale'.
	self
		assert: (#(error warning information) includes: rule severity)
		description: 'Invalid severity'.
	self
		checkRule: rule
		isEqualTo: returnedEnvironment! !

!RBSmalllintTest class methodsFor: 'accessing' stamp: 'lr 9/5/2010 10:48'!
packageNamesUnderTest
	^ #('Refactoring-Critics')! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
collectionMessagesToExternalObject
	self someObject collection remove: 10! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
literalArrayCharacters
	^#($a $b $c) includes: $a! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
atIfAbsent
	^ Smalltalk at: #MyTest
		ifAbsent: 
			[| collection |
			collection := #().
			Smalltalk at: #MyTest put: collection]! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
usesAdd
	^(1 to: 10) asOrderedCollection addAll: (11 to: 20)! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
collectionProtocol
	| newCollection |
	newCollection := OrderedCollection new.
	(1 to: 10) asOrderedCollection do: 
			[:each | 
			| new |
			new := each * 2.
			newCollection add: new].
	^newCollection! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:17'!
refersToClass
	^ RBSmalllintTestObject! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
returnInEnsure
	[self error: 'asdf'] ensure: [^4]! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
guardingClause
	self isSymbol 
		ifFalse: 
			[self printString.
			self isSymbol printString]! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
assignmentInBlock
	[^self printString] ensure: [self close]! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 21:05'!
emptyExceptionHandler
	[ ] on: Error do: [ :err | ]! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
returnsIfTrue
	^self isNil ifTrue: [4]! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
searchingLiteral
	^self printString = #a or: [#() = self printString | ( #() == self printString)]! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:56'!
onlyReadOrWrittenTemporary
	| a |
	a := 1! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
release
	self printString! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
tempVarOverridesInstVar
	| temporaryVariable |
	temporaryVariable := 4.
	^temporaryVariable! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
variableAssignedLiteral
	temporaryVariable := #() ! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
detectContains
	^(1 to: 10) do: [:each | each > 2 ifTrue: [^each]]! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
noIsNil: arg
	^arg = nil or: [ arg ~= nil ]! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
returnsBooleanAndOther
	self isVariable ifTrue: [^false].
	self printString! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
precedence
	^self isArray ifFalse: [self block + 5 * 34] ifTrue: [self printString = 10]! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
missingYourself
	^(OrderedCollection new)
		add: 1;
		add: 2;
		removeFirst! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
modifiesCollection
	| collection |
	collection := (1 to: 10) asOrderedCollection.
	collection do: [:each | each > 5 ifTrue: [collection remove: each]].
	^collection! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:55'!
uncommonMessageSend
	true false! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 21:06'!
assignmentWithoutEffect
	| a |
	a := 1.
	a := a! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
fileBlocks
	| file |
	^
	[file := 'asdf' asFilename readStream.
	file contents] ensure: [file close]! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:58'!
literalArrayContainsComma
	^ #(#,)! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:46'!
unoptimizedAndOr
	^ (true and: [ false ]) and: [ true ]! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
toDo
	1 to: self size do: [:i | (self at: i) printString]! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'CamilloBruni 11/4/2013 23:35'!
shouldntRaiseError
	self shouldnt: [ 0/1 ] raise: Error! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
yourselfNotUsed
	self
		printString;
		printString;
		yourself! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
toDoCollect
	| array |
	array := Array new: 10.
	1 to: 10 do: [:i | array at: i put: i * i].
	^array! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
equalsTrue
	^true == self! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
tempsReadBeforeWritten
	| temp |
	self isVariable ifTrue: [temp := 4].
	^temp! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
whileTrue
	| i |
	i := 1.
	[i < self size] whileTrue: 
			[(self at: i) printString.
			i := i + 1]! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 21:03'!
temporaryVariableCapitalization
	| Capital |
	Capital := 'Bern'.
	^ Capital! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'CamilloBruni 11/4/2013 23:34'!
ifTrueBlocks
	^ true ifFalse: self foo! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
threeElementPoint
	^5 @ 5 + 6 @ 6! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:43'!
usesTrue
	^ True! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
asOrderedCollectionNotNeeded
	self foo addAll: (1 to: 10) asOrderedCollection! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:47'!
codeCruftLeftInMethods
	self halt! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
stringConcatenation
	| string |
	string := '' yourself.
	(1 to: 10) do: [:i | string := string , i printString].
	^string! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'MarcusDenker 7/28/2014 18:48'!
consistencyCheck
	^(1 to: 10) size > 0! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:48'!
sizeCheck
	self isEmpty
		ifFalse: [self do: 
					[:each | 
					]]! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
assignmentInIfTrue
	| variable |
	self isVariable 
		ifTrue: [variable := self]
		ifFalse: [variable := self printString].
	^variable! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
collectSelectNotUsed
	(1 to: 10) select: [:each | each = 4]! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
extraBlock
	^[:arg | arg + 43] value: 45! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
sendsDifferentSuper
	super printString! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'CamilloBruni 11/4/2013 23:35'!
shouldntRaiseException
	self shouldnt: [ 0/1 ] raise: Exception! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
toDoWithIncrement
	| counter |
	counter := 0.
	1 to: 10
		by: 2
		do: [:i | counter := counter + 2].
	^counter! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
booleanPrecedence
	^true & 4 = 45! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
contains
	^((1 to: 10) detect: [:each | each > 2] ifNone: [nil]) isNil! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
fullBlocks
	^[thisContext]! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
badMessage
	self become: String new! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
ifTrueReturns
	self isSymbol ifFalse: [^true].
	^false! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'CamilleTeruel 4/3/2013 18:12'!
longMethods
	self printString.
	self printString.
	self printString.
	self printString.
	self printString.
	self printString.
	self printString.
	self isVariable ifTrue: [self printString].
	self isVariable ifTrue: [self printString].
	self isVariable ifTrue: [self printString].
	self isVariable ifTrue: [self printString].
	self isVariable ifTrue: [self printString].
	self isVariable ifTrue: [self printString].
	self isVariable ifTrue: [self printString].
	self isVariable ifTrue: [self printString].
	self isVariable ifTrue: [self printString].
	self isVariable ifTrue: [self printString].
	self isVariable ifTrue: [self printString]! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
minMax
	"Bug in 3<5 ifTrue: [3]  ifFalse: [5]"

^3<5 ifTrue: [3]  ifFalse: [5]
"	| var |
	var := 4.
	var < 5 ifTrue: [var := 5].
	^var"! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
equalNotUsed
	| string |
	string = '' yourself.
	(1 to: 10) do: [:i | string := i printString].
	^string! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
endTrueFalse
	self isVariable 
		ifTrue: 
			[self printString.
			self isVariable printString]
		ifFalse: 
			[self printString.
			^4]! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:59'!
floatEqualityComparison
	^ 1.0 = 1! !

!RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'!
justSendsSuper
	super justSendsSuper! !

!RBSmalllintTestObject methodsFor: 'as yet unclassified' stamp: 'lr 9/7/2010 20:41'!
unclassifiedMethods
	"intentionally unclassified method"! !

!RBSourceRegexRefactoring methodsFor: 'private' stamp: ''!
parseMethod: aString
	^ [ RBParser parseMethod: aString ]
		on: Error do: [ :err | nil ]! !

!RBSourceRegexRefactoring methodsFor: 'transforming' stamp: 'MarcusDenker 4/28/2013 11:17'!
transform
	| original replacement protocols |
	self model allClassesDo: [ :class |
		class selectors do: [ :selector |
			original := class sourceCodeFor: selector.
			replacement := self execute: original.
			replacement = original ifFalse: [
				(self parseMethod: replacement) isNil ifFalse: [
					protocols := class protocolsFor: selector.
					(class compiler parseSelector: replacement) = selector
						ifFalse: [ class removeMethod: selector ].
					class compile: replacement classified: protocols ] ] ] ]! !

!RBSpecialCharacterToken commentStamp: 'md 8/9/2005 14:53'!
RBSpecialCharacterToken is the first class representation of special characters.

!
!RBSpecialCharacterToken methodsFor: 'private' stamp: ''!
length
	^1! !

!RBSpecialCharacterToken methodsFor: 'testing' stamp: ''!
isSpecial
	^true! !

!RBSplitCascadeRefactoring methodsFor: 'transforming' stamp: ''!
splitCascade
	ancestorNode parent
		addNode: (beforeNodes size > 1
			ifTrue: [ RBCascadeNode messages: beforeNodes ]
			ifFalse: [ beforeNodes first ])
		before: ancestorNode.
	afterNodes size > 1
		ifTrue: [ cascadeNode messages: afterNodes ]
		ifFalse: [ cascadeNode replaceWith: afterNodes first ].
	class compileTree: ancestorNode methodNode! !

!RBSplitCascadeRefactoring methodsFor: 'accessing' stamp: 'CamilloBruni 10/7/2012 23:58'!
parseTree
	parseTree isNil ifTrue: [
		parseTree := class parseTreeFor: selector.
		parseTree isNil
			ifTrue: [ self refactoringFailure: 'Could not parse sources' ] ].
	^ parseTree! !

!RBSplitCascadeRefactoring methodsFor: 'transforming' stamp: ''!
extractReceiver
	| name |
	(cascadeNode receiver isLiteralNode or: [ cascadeNode receiver isVariable ])
		ifTrue: [ ^ self ].
	name := self 
		safeVariableNameFor: class 
		temporaries: self parseTree allDefinedVariables 
		basedOn: 'receiver'.
	ancestorNode parent
		addTemporaryNamed: name;
		addNode: (RBAssignmentNode 
			variable: (RBVariableNode named: name)
			value: cascadeNode receiver)
		before: ancestorNode.
	cascadeNode messages
		do: [ :each | each receiver: (RBVariableNode named: name) ]
		! !

!RBSplitCascadeRefactoring methodsFor: 'preconditions' stamp: 'CamilloBruni 10/8/2012 00:00'!
findAncestorNode
	"The ancestor node is the node that is contained within the sequence. In most cases this is the cascade itself, but it also can be an assignment or a return node."

	ancestorNode := cascadeNode.
	[ ancestorNode parent isSequence not and: [ ancestorNode parent isAssignment ] ]
		whileTrue: [ ancestorNode := ancestorNode parent ].
	[ ancestorNode parent isSequence not and: [ ancestorNode parent isReturn ] ]
		whileTrue: [ ancestorNode := ancestorNode parent ].
	ancestorNode parent isSequence
		ifFalse: [ self refactoringFailure: 'To split this cascade, you must extract it to a temporary first' ]! !

!RBSplitCascadeRefactoring methodsFor: 'preconditions' stamp: 'CamilloBruni 10/8/2012 00:00'!
findCascadeNode
	"Find the cascade to be split."

	cascadeNode := self parseTree bestNodeFor: selectedInterval.
	[ cascadeNode isNil or: [ cascadeNode isCascade ] ]
		whileFalse: [ cascadeNode := cascadeNode parent ].
	cascadeNode isNil
		ifTrue: [ self refactoringFailure: 'The selection doesn''t appear to be within a cascade' ]! !

!RBSplitCascadeRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^ (RBCondition definesSelector: selector in: class) & (RBCondition withBlock: [ 
		self findCascadeNode; findAncestorNode; findMessageNodes. 
		true ])! !

!RBSplitCascadeRefactoring methodsFor: 'initialization' stamp: ''!
split: anInterval from: aSelector in: aClass
	class := self classObjectFor: aClass.
	selector := aSelector.
	selectedInterval := anInterval! !

!RBSplitCascadeRefactoring methodsFor: 'transforming' stamp: ''!
transform
	self extractReceiver.
	self splitCascade! !

!RBSplitCascadeRefactoring methodsFor: 'preconditions' stamp: 'CamilloBruni 10/8/2012 00:00'!
findMessageNodes
	"Find the nodes that form the first part of the cascade and the second part of the cascade."

	beforeNodes := cascadeNode messages
		select: [ :each | each stop <= selectedInterval first ].
	afterNodes := cascadeNode messages
		select: [ :each | selectedInterval last <= each selectorParts first start ].
	(beforeNodes isEmpty or: [ afterNodes isEmpty ])
		ifTrue: [ self refactoringFailure: 'Splitting a cascade into the whole cascade and an empty one is pointless' ].
	(beforeNodes size + afterNodes size = cascadeNode messages size)
		ifFalse: [ self refactoringFailure: 'To set the split boundary place the cursor inbetween two cascaded messages' ]! !

!RBSplitCascadeRefactoring class methodsFor: 'instance-creation' stamp: ''!
split: anInterval from: aSelector in: aClass
	^ self new 
		split: anInterval from: aSelector in: aClass;
		yourself! !

!RBSplitCascadeRefactoring class methodsFor: 'instance-creation' stamp: ''!
model: aNamespace split: anInterval from: aSelector in: aClass
	^ self new
		model: aNamespace;
		split: anInterval from: aSelector in: aClass;
		yourself! !

!RBSplitClassRefactoring methodsFor: 'private-transforming' stamp: 'lr 9/8/2011 20:11'!
abstractReferenceTo: each 
	| setterMethod replacer accessorRef getterMethod |
	accessorRef := RBCreateAccessorsForVariableRefactoring 
				variable: each
				class: newClass
				classVariable: false.
	self performComponentRefactoring: accessorRef.
	getterMethod := accessorRef getterMethod.
	setterMethod := accessorRef setterMethod.
	replacer := RBParseTreeRewriter 
				variable: each
				getter: getterMethod
				setter: setterMethod
				receiver: referenceVariableName.
	self 
		convertClasses: class withAllSubclasses
		select: [:aClass | aClass whichSelectorsReferToInstanceVariable: each]
		using: replacer.
	self performComponentRefactoring: (RBRemoveInstanceVariableRefactoring 
				remove: each
				from: class)! !

!RBSplitClassRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^(RBCondition isValidClassName: newClassName) 
		& (RBCondition isGlobal: newClassName in: self model) not 
			& (RBCondition isValidInstanceVariableName: referenceVariableName for: class) 
			& (RBCondition hierarchyOf: class definesVariable: referenceVariableName) 
					not 
			& (RBCondition isGlobal: referenceVariableName in: self model) not 
			& (RBCondition definesTemporaryVariable: referenceVariableName in: class) 
					not! !

!RBSplitClassRefactoring methodsFor: 'private-transforming' stamp: 'TorstenBergmann 2/26/2014 09:08'!
addClass
	self performComponentRefactoring: (RBAddClassRefactoring 
				model: self model
				addClass: newClassName
				superclass: Object
				subclasses: #()
				category: class category).
	newClass := self model classNamed: newClassName asSymbol! !

!RBSplitClassRefactoring methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream nextPutAll: ' class: '.
	class storeOn: aStream.
	aStream nextPutAll: ' instanceVariables: '.
	instanceVariables asArray storeOn: aStream.
	aStream
		nextPutAll: ' newClassName: #';
		nextPutAll: newClassName;
		nextPutAll: ' referenceVariableName: ''';
		nextPutAll: referenceVariableName;
		nextPutAll: ''')'! !

!RBSplitClassRefactoring methodsFor: 'private-transforming' stamp: 'lr 9/8/2011 20:11'!
addInstanceVariables
	instanceVariables do: 
			[:each | 
			self performComponentRefactoring: (RBAddInstanceVariableRefactoring 
						model: self model
						variable: each
						class: newClass)]! !

!RBSplitClassRefactoring methodsFor: 'transforming' stamp: ''!
transform
	self
		createNewClass;
		createReference;
		abstractVariableReferences! !

!RBSplitClassRefactoring methodsFor: 'transforming' stamp: 'lr 9/8/2011 20:11'!
createReference
	self performComponentRefactoring: (RBAddInstanceVariableRefactoring 
				variable: referenceVariableName
				class: class)! !

!RBSplitClassRefactoring methodsFor: 'transforming' stamp: ''!
createNewClass
	self
		addClass;
		addInstanceVariables! !

!RBSplitClassRefactoring methodsFor: 'transforming' stamp: ''!
abstractVariableReferences
	instanceVariables do: [:each | self abstractReferenceTo: each]! !

!RBSplitClassRefactoring methodsFor: 'initialize-release' stamp: ''!
class: aClass instanceVariables: instVars newClassName: className referenceVariableName: newVariable 
	class := self model classFor: aClass.
	instanceVariables := instVars.
	newClassName := className.
	referenceVariableName := newVariable! !

!RBSplitClassRefactoring class methodsFor: 'instance creation' stamp: ''!
class: class instanceVariables: instVars newClassName: className referenceVariableName: newVariable 
	^(self new)
		class: class
			instanceVariables: instVars
			newClassName: className
			referenceVariableName: newVariable;
		yourself! !

!RBSplitClassRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBSmalltalk class: class instanceVariables: instVars newClassName: className referenceVariableName: newVariable 
	^(self new)
		model: aRBSmalltalk;
		class: class
			instanceVariables: instVars
			newClassName: className
			referenceVariableName: newVariable;
		yourself! !

!RBStringConcatenationRule commentStamp: 'StephaneDucasse 11/29/2014 22:59'!
Check for string concatenation inside some iteration message. Since string concatenation is O(n^2), it is better to use streaming since it is O(n) - assuming that n is large enough. As a general principal avoid , since the receiver is copied. Therefore chaining , messages will lead to multiple useless copies of the receiver. 

Instead of writing
	| string | 
	string := String new.
	#(1 2 3) do: [ :each |
		string := string, each asString].
	^ string

Write, it is much more efficient.

	String streamContents: [:s | 
		#(1 2 3)  do: [:each | s nextPutAll: each asString]]
	
or more concisely...
	'''' join: {1. 1+1. 3}	
!
!RBStringConcatenationRule methodsFor: 'initialization' stamp: 'lr 6/4/2010 12:03'!
initialize
	| concatenationMatcher |
	super initialize.
	concatenationMatcher := RBParseTreeSearcher new.
	concatenationMatcher 
		matches: '`@receiver , `@argument'
		do: [ :node :answer | true ].
	self matcher 
		matchesAnyOf: #(
			'``@collection do: ``@argument' 
			'``@collection do: ``@argument1 separatedBy: ``@argument2' 
			'``@start to: ``@stop do: ``@argument' 
			'``@collection detect: ``@argument' 
			'``@collection detect: ``@argument1 ifNone: ``@argument2' 
			'``@collection select: ``@argument'
			'``@collection reject: ``@argument' 
			'``@collection inject: ``@value into: ``@argument'
			'``@collection anySatisfy: ``@argument'
			'``@collection allSatisfy: ``@argument'
			'``@collection noneSatisfy: ``@argument' )
		do: [ :node :answer | 
			answer isNil 
				ifTrue: [
					(node arguments 
						detect: [ :each | each isBlock and: [ concatenationMatcher executeTree: each initialAnswer: false ] ]
						ifNone: [ nil ]) notNil 
							ifTrue: [ node ]
							ifFalse: [ nil ] ]
				ifFalse: [ answer ] ]! !

!RBStringConcatenationRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 23:00'!
rationale
	^ 'Check for code using string concatenation inside some iteration message.'! !

!RBStringConcatenationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Miscellaneous'! !

!RBStringConcatenationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'String concatenation instead of streams'! !

!RBStringConcatenationRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:31'!
category 
	^ 'Optimization'! !

!RBStringConcatenationRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'StringConcatenationRule'! !

!RBStringReplaceRule commentStamp: 'md 8/9/2005 14:56'!
RBStringReplaceRule replaces a matched tree with another tree (which may include metavariable from the matching tree). This is a very succint syntax for specifying most rewrites.

Instance Variables:
	replaceTree	<RBProgramNode>	The tree to replace the matched tree with.

!
!RBStringReplaceRule methodsFor: 'initialize-release' stamp: ''!
searchFor: searchString replaceWith: replaceString 
	self searchString: searchString.
	self replaceString: replaceString! !

!RBStringReplaceRule methodsFor: 'initialize-release' stamp: ''!
searchForMethod: searchString replaceWith: replaceString 
	self methodSearchString: searchString.
	self methodReplaceString: replaceString! !

!RBStringReplaceRule methodsFor: 'initialize-release' stamp: ''!
searchForTree: aBRProgramNode replaceWith: replaceNode 
	searchTree := aBRProgramNode.
	replaceTree := replaceNode! !

!RBStringReplaceRule methodsFor: 'initialize-release' stamp: ''!
searchForTree: aBRProgramNode replaceWith: replaceString when: aBlock 
	self searchForTree: aBRProgramNode replaceWith: replaceString.
	verificationBlock := aBlock! !

!RBStringReplaceRule methodsFor: 'matching' stamp: ''!
foundMatchFor: aProgramNode 
	| newNode |
	newNode := replaceTree copyInContext: self context.
	aProgramNode replaceMethodSource: newNode.
	newNode copyCommentsFrom: aProgramNode.
	^newNode! !

!RBStringReplaceRule methodsFor: 'initialize-release' stamp: ''!
methodReplaceString: replaceString 
	replaceTree := RBParser parseRewriteMethod: replaceString! !

!RBStringReplaceRule methodsFor: 'initialize-release' stamp: ''!
replaceString: replaceString 
	replaceTree := RBParser parseRewriteExpression: replaceString.
	searchTree isSequence = replaceTree isSequence 
		ifFalse: 
			[searchTree isSequence 
				ifTrue: [replaceTree := RBSequenceNode statements: (Array with: replaceTree)]
				ifFalse: [searchTree := RBSequenceNode statements: (Array with: searchTree)]]! !

!RBStringReplaceRule methodsFor: 'initialize-release' stamp: ''!
searchForMethod: searchString replaceWith: replaceString when: aBlock 
	self searchForMethod: searchString replaceWith: replaceString.
	verificationBlock := aBlock! !

!RBStringReplaceRule methodsFor: 'initialize-release' stamp: ''!
searchFor: searchString replaceWith: replaceString when: aBlock 
	self searchFor: searchString replaceWith: replaceString.
	verificationBlock := aBlock! !

!RBStringReplaceRule class methodsFor: 'instance creation' stamp: ''!
searchFor: searchString replaceWith: replaceString when: aBlock 
	^self new 
		searchFor: searchString
		replaceWith: replaceString
		when: aBlock! !

!RBStringReplaceRule class methodsFor: 'instance creation' stamp: ''!
searchForMethod: searchString replaceWith: replaceString when: aBlock 
	^self new 
		searchForMethod: searchString
		replaceWith: replaceString
		when: aBlock! !

!RBStringReplaceRule class methodsFor: 'instance creation' stamp: ''!
searchFor: searchString replaceWith: replaceString 
	^self new searchFor: searchString replaceWith: replaceString! !

!RBStringReplaceRule class methodsFor: 'instance creation' stamp: ''!
searchForMethod: searchString replaceWith: replaceString 
	^(self new)
		searchForMethod: searchString replaceWith: replaceString;
		yourself! !

!RBStringReplaceRule class methodsFor: 'instance creation' stamp: ''!
searchForTree: aRBProgramNode replaceWith: replaceString 
	^self new searchForTree: aRBProgramNode replaceWith: replaceString! !

!RBStringReplaceRule class methodsFor: 'instance creation' stamp: ''!
searchForTree: aRBProgramNode replaceWith: replaceString when: aBlock 
	^self new 
		searchForTree: aRBProgramNode
		replaceWith: replaceString
		when: aBlock! !

!RBStringReplacement commentStamp: '<historical>'!
RBStringReplacement represents replacing source in the original method with a different string. These are used when reformatting code after a parse tree change has been made. Depending on the change, it may be possible to minimally change the parse tree without needing to format it.

Instance Variables:
	startPosition	<Integer>	the start position in the original source
	stopPosition	<Integer>	the end position in the original source
	string	<String>	replaces everything from the startPosition to the endPosition with this string

!
!RBStringReplacement methodsFor: 'accessing' stamp: ''!
string
	^string! !

!RBStringReplacement methodsFor: 'accessing' stamp: ''!
startPosition
	^startPosition! !

!RBStringReplacement methodsFor: 'initialize-release' stamp: ''!
stopPosition: anInteger 
	stopPosition := anInteger! !

!RBStringReplacement methodsFor: 'accessing' stamp: ''!
stopPosition
	^stopPosition! !

!RBStringReplacement methodsFor: 'initialize-release' stamp: ''!
string: aString 
	string := aString! !

!RBStringReplacement methodsFor: 'initialize-release' stamp: ''!
startPosition: anInteger 
	startPosition := anInteger! !

!RBStringReplacement class methodsFor: 'instance creation' stamp: ''!
replaceFrom: startInteger to: stopInteger with: aString 
	^(self new)
		startPosition: startInteger;
		stopPosition: stopInteger;
		string: aString;
		yourself! !

!RBSubclassOfClassToRename methodsFor: 'accessing' stamp: ''!
calls1
	^self rewriteRule1: (self rewriteRule1: self calls)! !

!RBSubclassOfClassToRename methodsFor: 'accessing' stamp: ''!
calls
	^self rewriteRule1: self name , self rewriteRule1! !

!RBSubclassOfClassToRename methodsFor: 'accessing' stamp: ''!
rewriteRule1: anObject
	^rewriteRule1 := anObject! !

!RBSubclassOfClassToRename methodsFor: 'performing' stamp: 'lr 2/26/2009 14:51'!
symbolReference
	^ #RBClassToRename! !

!RBSubclassOfClassToRename methodsFor: 'performing' stamp: 'lr 2/26/2009 14:51'!
reference
	^ RBClassToRename new! !

!RBSubclassOfClassToRename methodsFor: 'accessing' stamp: ''!
rewriteRule1
	^rewriteRule1! !

!RBSubclassOfClassToRename methodsFor: 'accessing' stamp: ''!
name
	^rewriteRule1! !

!RBSubclassResponsibilityNotDefinedRule commentStamp: 'StephaneDucasse 11/29/2014 20:24'!
This rule checks if all subclassResponsibility methods are defined in all leaf classes. if such a method is not overridden, a subclassResponsibility message can be occur when this method is called.!
!RBSubclassResponsibilityNotDefinedRule methodsFor: 'accessing' stamp: 'SeanDeNigris 1/31/2013 09:39'!
rationale
	^ 'Checks that all methods which send #subclassResponsibility, which indicates that they are abstract, are defined in all leaf classes.'! !

!RBSubclassResponsibilityNotDefinedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Bugs'! !

!RBSubclassResponsibilityNotDefinedRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:04'!
severity
	^ #error! !

!RBSubclassResponsibilityNotDefinedRule methodsFor: 'accessing' stamp: 'Simon 8/30/2012 14:12'!
category 	
	
	^ 'Bugs'! !

!RBSubclassResponsibilityNotDefinedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Subclass responsibility not defined'! !

!RBSubclassResponsibilityNotDefinedRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:50'!
checkClass: aClass 
	(aClass whichSelectorsReferTo: #subclassResponsibility) do: 
		[ :each | 
		(aClass withAllSubclasses 
			detect: 
				[ :class | 
				class subclasses isEmpty and: [ (class whichClassIncludesSelector: each) == aClass ] ]
			ifNone: [ nil ]) notNil ifTrue: 
			[ result 
				addClass: aClass
				selector: each ] ]! !

!RBSubclassResponsibilityNotDefinedRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'SubclassResponsibilityNotDefinedRule'! !

!RBSuperNode commentStamp: '<historical>'!
I am a specialized variable node for 'super'!
!RBSuperNode methodsFor: 'testing' stamp: 'CamilloBruni 12/15/2011 14:33'!
isSuper
	^ true! !

!RBSuperNode methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:39'!
acceptVisitor: aProgramNodeVisitor 
	^aProgramNodeVisitor visitSuperNode: self! !

!RBSuperSendsNewRule commentStamp: 'StephaneDucasse 11/29/2014 20:22'!
This rule checks for method that wrongly initialize an object twice. Contrary to other Smalltalk implementations Pharo automatically calls #initiailize on object creation.
A warning is raised when the statement self new initialize is found in a method.!
!RBSuperSendsNewRule methodsFor: 'initialization' stamp: 'lr 11/2/2009 00:14'!
initialize
	super initialize.
	matcher := RBParseTreeSearcher new.
	matcher 
		matchesAnyOf: #(
			'super new initialize'
			'(super new: `@expr) initialize'
			'self new initialize'
			'(self new: `@expr) initialize' )
		do: [ :answer :node | true ].! !

!RBSuperSendsNewRule methodsFor: 'accessing' stamp: 'Simon 8/30/2012 14:19'!
category 
	^ 'Bugs'! !

!RBSuperSendsNewRule methodsFor: 'accessing' stamp: 'Simon 8/30/2012 14:19'!
longDescription 
	^' This rule checks for method that wrongly initialize an object twice. Contrary to other Smalltalk implementations Pharo automatically calls #initiailize on object creation.
For example, a warning is raised when the statment self new initialize is found in a method.'! !

!RBSuperSendsNewRule methodsFor: 'accessing' stamp: 'SeanDeNigris 1/31/2013 09:39'!
rationale
	^ 'Checks for methods that wrongly initialize an object twice. Contrary to other Smalltalk implementations Pharo automatically calls #initiailize on object creation.'! !

!RBSuperSendsNewRule methodsFor: 'accessing' stamp: 'lr 3/17/2010 17:54'!
group
	^ 'Pharo bugs'! !

!RBSuperSendsNewRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Sends super new initialize'! !

!RBSuperSendsNewRule methodsFor: 'running' stamp: 'MarcusDenker 10/27/2014 17:58'!
checkMethod: aMethod 
	aMethod methodClass isMeta 
		ifTrue: [ ^ self ].
	(matcher executeTree: aMethod ast initialAnswer: false) 
		ifTrue: [ result addMethod: aMethod ]! !

!RBSuperSendsNewRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'SuperSendsNewRule'! !

!RBSuperSendsRule commentStamp: 'StephaneDucasse 11/29/2014 18:53'!
Rewrite super messages to self messages when both refer to same method!
!RBSuperSendsRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:44'!
initialize
	super initialize.
	self rewriteRule 
		replace: 'super `@message: ``@args' 
		with: 'self `@message: ``@args'
		when: [ :node | 
			(class withAllSubclasses 
				detect: [:each | each includesSelector: node selector]
				ifNone: [ nil ]) isNil ]! !

!RBSuperSendsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Transformations'! !

!RBSuperSendsRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 18:53'!
name
	^ 'Rewrite super messages to self messages'! !

!RBSuperSendsRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:52'!
category 
	^ 'Design Flaws'! !

!RBSuperSendsRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'SuperSendsRule'! !

!RBSwapMethodRefactoring commentStamp: 'lr 10/19/2007 09:16'!
Move a method from the class to the instance side, or vice versa. Normally this is not considered to be a refactoring.!
!RBSwapMethodRefactoring methodsFor: 'preconditions' stamp: ''!
checkInstVars
	class instanceVariableNames do: [ :each |
		(target instanceVariableNames includes: each) ifFalse: [
			((class whichSelectorsReferToInstanceVariable: each) includes: selector) ifTrue: [
				self
					refactoringError: ('<1p> refers to <2s>, which is not defined in <3p>' expandMacrosWith: selector with: each with: target) ] ] ]! !

!RBSwapMethodRefactoring methodsFor: '*NautilusRefactoring' stamp: 'NicolaiHess 9/27/2014 00:57'!
whatToDisplayIn: aBrowser 

	^ (self changes changes 
		select: [:change | selector = change selector ]) 
		gather: [:change | change whatToDisplayIn: aBrowser ]! !

!RBSwapMethodRefactoring methodsFor: 'initialization' stamp: ''!
swapMethod: aSelector in: aClass 
	class := self classObjectFor: aClass.
	target := self classObjectFor: (class isMeta 
			ifTrue: [ class theNonMetaClass ]
			ifFalse: [ class theMetaClass ]).
	selector := aSelector! !

!RBSwapMethodRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^ (RBCondition definesSelector: selector in: class)
		& (RBCondition definesSelector: selector in: target) not
		& (RBCondition withBlock: [ self checkInstVars. true ])! !

!RBSwapMethodRefactoring methodsFor: 'transforming' stamp: ''!
transform
	target compile: (class sourceCodeFor: selector) classified: (class protocolsFor: selector).
	class removeMethod: selector! !

!RBSwapMethodRefactoring class methodsFor: 'instance-creation' stamp: ''!
model: aRBSmalltalk swapMethod: aSelector in: aClass
	^ self new 
		model: aRBSmalltalk;
		swapMethod: aSelector in: aClass;
		yourself! !

!RBSwapMethodRefactoring class methodsFor: 'instance-creation' stamp: ''!
swapMethod: aSelector in: aClass
	^ self new swapMethod: aSelector in: aClass! !

!RBTempVarOverridesInstVarRule commentStamp: 'StephaneDucasse 11/29/2014 20:21'!
Finds methods whose temporary variables override an instance variable. This causes problems if you want to use the instance variable inside the method.!
!RBTempVarOverridesInstVarRule methodsFor: 'initialization' stamp: 'CamilloBruni 11/18/2013 17:31'!
initialize
	super initialize.
	matcher := RBParseTreeSearcher new.
	matcher
		matchesArgument: '`var'
		do: [ :aNode :answer | 
			answer or: [
				varName := aNode name.
				vars includes: varName ]]! !

!RBTempVarOverridesInstVarRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Possible bugs'! !

!RBTempVarOverridesInstVarRule methodsFor: 'copying' stamp: 'CamilloBruni 11/18/2013 17:33'!
postCopy
	super postCopy.
	self initialize.! !

!RBTempVarOverridesInstVarRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 13:59'!
category
	^ 'Potential Bugs'! !

!RBTempVarOverridesInstVarRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Instance variable overridden by temporary variable'! !

!RBTempVarOverridesInstVarRule methodsFor: 'running' stamp: 'MarcusDenker 10/27/2014 17:57'!
checkMethod: aMethod 
	vars := aMethod methodClass instVarNames.
	(matcher 
		executeTree: aMethod ast
		initialAnswer: false) ifTrue: 
		[ result 
			addMethod: aMethod;
		 	addSearchString: varName ]! !

!RBTempVarOverridesInstVarRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'TempVarOverridesInstVarRule'! !

!RBTempVectorNode commentStamp: 'ClementBera 7/16/2014 13:22'!
Represents a temp vector.!
!RBTempVectorNode methodsFor: 'accessing' stamp: 'ClementBera 7/16/2014 13:23'!
remoteTemps
	^ temps! !

!RBTempVectorNode methodsFor: 'accessing' stamp: 'ClementBera 7/16/2014 13:23'!
temps
	^ temps! !

!RBTempVectorNode methodsFor: 'printing' stamp: 'ClementBera 7/16/2014 17:13'!
printOn: s
	s << 'tempVectNode'! !

!RBTempVectorNode methodsFor: 'accessing' stamp: 'ClementBera 7/16/2014 17:19'!
start
	^ 1! !

!RBTempVectorNode methodsFor: 'testing' stamp: 'ClementBera 7/16/2014 13:24'!
isIndirectTempVector
	^ true! !

!RBTempVectorNode methodsFor: 'visiting' stamp: 'ClementBera 7/16/2014 17:18'!
acceptVisitor: aRBConfigurableFormatter 
	^ aRBConfigurableFormatter visitVariableNode: self! !

!RBTempVectorNode methodsFor: 'accessing' stamp: 'ClementBera 7/16/2014 13:23'!
temps: anObject
	temps := anObject! !

!RBTemporaryNode commentStamp: '<historical>'!
I am a specialized variable node for temporary variables!
!RBTemporaryNode methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:39'!
acceptVisitor: aProgramNodeVisitor 
	^aProgramNodeVisitor visitTemporaryNode: self! !

!RBTemporaryNode methodsFor: 'testing' stamp: 'CamilloBruni 12/15/2011 14:32'!
isTemp
	^ true! !

!RBTemporaryToInstanceVariableRefactoring methodsFor: 'transforming' stamp: 'CamilloBruni 10/7/2012 23:58'!
transform
	| parseTree matcher method |
	method := class methodFor: selector.
	parseTree := method parseTree.
	parseTree isNil ifTrue: [self refactoringFailure: 'Could not parse method'].
	class removeMethod: selector.
	class addInstanceVariable: temporaryVariableName.
	(matcher := RBParseTreeRewriter removeTemporaryNamed: temporaryVariableName) 
		executeTree: parseTree.
	method compileTree: matcher tree! !

!RBTemporaryToInstanceVariableRefactoring methodsFor: 'initialize-release' stamp: ''!
class: aClass selector: aSelector variable: aVariableName 
	class := self classObjectFor: aClass.
	selector := aSelector.
	temporaryVariableName := aVariableName! !

!RBTemporaryToInstanceVariableRefactoring methodsFor: 'preconditions' stamp: 'CamilloBruni 10/7/2012 23:58'!
checkForValidTemporaryVariable
	| parseTree |
	parseTree := class parseTreeFor: selector.
	(parseTree allTemporaryVariables includes: temporaryVariableName) 
		ifFalse: 
			[self refactoringFailure: temporaryVariableName 
						, ' isn''t a valid temporary variable name'].
	(parseTree allArgumentVariables includes: temporaryVariableName) 
		ifTrue: 
			[self refactoringFailure: temporaryVariableName , ' is a block parameter'].
	(RBReadBeforeWrittenTester isVariable: temporaryVariableName
		readBeforeWrittenIn: parseTree) 
			ifTrue: 
				[self 
					refactoringWarning: ('<1s> is read before it is written.<n>Proceed anyway?' 
							expandMacrosWith: temporaryVariableName)]! !

!RBTemporaryToInstanceVariableRefactoring methodsFor: 'preconditions' stamp: ''!
preconditions
	^(RBCondition definesSelector: selector in: class) 
		& (RBCondition hierarchyOf: class
				definesVariable: temporaryVariableName asString) not 
			& (RBCondition withBlock: 
						[self checkForValidTemporaryVariable.
						true])! !

!RBTemporaryToInstanceVariableRefactoring methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream nextPutAll: ' class: '.
	class storeOn: aStream.
	aStream
		nextPutAll: ' selector: #';
		nextPutAll: selector;
		nextPutAll: ' variable: ''';
		nextPutAll: temporaryVariableName;
		nextPut: $'.
	aStream nextPut: $)! !

!RBTemporaryToInstanceVariableRefactoring class methodsFor: 'instance creation' stamp: ''!
class: aClass selector: aSelector variable: aVariableName 
	^self new 
		class: aClass
		selector: aSelector
		variable: aVariableName! !

!RBTemporaryToInstanceVariableRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBSmalltalk class: aClass selector: aSelector variable: aVariableName 
	^(self new)
		model: aRBSmalltalk;
		class: aClass
			selector: aSelector
			variable: aVariableName;
		yourself! !

!RBTemporaryToInstanceVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testNonExistantName
	self
		shouldFail: (RBTemporaryToInstanceVariableRefactoring 
				class: RBBasicLintRuleTest
				selector: #checkClass:
				variable: 'asdf');
		shouldFail: (RBTemporaryToInstanceVariableRefactoring 
				class: RBBasicLintRuleTest
				selector: #checkClass1:
				variable: 'aSmalllintContext')! !

!RBTemporaryToInstanceVariableTest methodsFor: 'failure tests' stamp: 'lr 9/8/2011 20:11'!
testRedefinedTemporary
	| class |
	class := model classNamed: #Foo.
	class 
		compile: 'someMethod | instVarName1 | instVarName1 := 4. ^instVarName1'
		classified: #(#accessing).
	self shouldFail: (RBTemporaryToInstanceVariableRefactoring 
				class: class
				selector: #someMethod
				variable: 'instVarName1')! !

!RBTemporaryToInstanceVariableTest methodsFor: 'tests' stamp: 'lr 9/8/2011 20:11'!
testTemporaryToInstanceVariable
	| refactoring class |
	refactoring := RBTemporaryToInstanceVariableRefactoring 
		class: RBLintRuleTest
		selector: #displayName
		variable: 'nameStream'.
	self executeRefactoring: refactoring.
	class := refactoring model classNamed: #RBLintRuleTest.
	self assert: (class parseTreeFor: #displayName) = (RBParser parseMethod: 'displayName
								nameStream := WriteStream on: (String new: 64).
								nameStream
									nextPutAll: self name;
									nextPutAll: '' (''.
								self problemCount printOn: nameStream.
								nameStream nextPut: $).
								^nameStream contents').
	self assert: (class directlyDefinesInstanceVariable: 'nameStream')! !

!RBTemporaryToInstanceVariableTest methodsFor: 'set up' stamp: 'CamilloBruni 8/27/2013 15:06'!
setUp
	super setUp.
	model := self abstractVariableTestData.! !

!RBTemporaryVariableCapitalizationRule commentStamp: 'StephaneDucasse 11/29/2014 20:21'!
This smell arises when a temporary or argument variable do not start with a lowercase letter, which is a standart style in Smalltalk.!
!RBTemporaryVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
rationale
	^ 'Temporary and argument variable names should start with a lowercase letter.'! !

!RBTemporaryVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Intention revealing'! !

!RBTemporaryVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Temporary variable capitalization'! !

!RBTemporaryVariableCapitalizationRule methodsFor: 'accessing' stamp: 'Simon 8/30/2012 14:20'!
category
	^ 'Style'! !

!RBTemporaryVariableCapitalizationRule methodsFor: 'running' stamp: 'MarcusDenker 10/27/2014 17:57'!
checkMethod: aMethod 
	aMethod ast allDefinedVariables do: 
		[ :each | 
		each first isLowercase ifFalse: 
			[ result
				addMethod: aMethod;
				addSearchString: each ] ]! !

!RBTemporaryVariableCapitalizationRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'TemporaryVariableCapitalizationRule'! !

!RBTempsReadBeforeWrittenRule commentStamp: 'StephaneDucasse 11/29/2014 20:20'!
Checks that all temporaries are assigned before they are used. This can help find possible paths through the code where a variable might be unassigned when it is used.!
!RBTempsReadBeforeWrittenRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Possible bugs'! !

!RBTempsReadBeforeWrittenRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Temporaries read before written'! !

!RBTempsReadBeforeWrittenRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 13:40'!
category
	^ 'Potential Bugs'! !

!RBTempsReadBeforeWrittenRule methodsFor: 'running' stamp: 'MarcusDenker 10/27/2014 17:57'!
checkMethod: aMethod 
	(RBReadBeforeWrittenTester variablesReadBeforeWrittenIn: aMethod ast) do: 
		[ :each | 
		result 
			addMethod: aMethod;
			addSearchString: each ]! !

!RBTempsReadBeforeWrittenRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'TempsReadBeforeWrittenRule'! !

!RBThemeAPIUpdateRule commentStamp: 'StephaneDucasse 11/29/2014 18:46'!
Do not explicitly refer to UITheme current but use Smalltalk ui theme. Similarly do not directly refer to ThemeIcons current but use Smalltalk ui icons.
!
!RBThemeAPIUpdateRule methodsFor: 'initialization' stamp: 'DamienCassou 5/14/2013 16:23'!
initialize
	super initialize.
	self rewriteRule
		replace: 'UITheme current'
			with: 'Smalltalk ui theme';
		replace: 'ThemeIcons current'
			with: 'Smalltalk ui icons'! !

!RBThemeAPIUpdateRule methodsFor: 'accessing' stamp: 'DamienCassou 5/14/2013 16:22'!
group
	^ 'Transformations'! !

!RBThemeAPIUpdateRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 18:53'!
name
	^ 'Use "Smalltalk ui theme" and "Smalltalk ui icons"'! !

!RBThemeAPIUpdateRule methodsFor: 'accessing' stamp: 'DamienCassou 5/14/2013 16:11'!
category
	^'Coding Idiom Violation'! !

!RBThemeAPIUpdateRule class methodsFor: 'accessing' stamp: 'DamienCassou 5/14/2013 16:29'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'ThemeAPIUpdateRule'! !

!RBThisContextNode commentStamp: '<historical>'!
I represent the specialized variable named 'thisContext'!
!RBThisContextNode methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:39'!
acceptVisitor: aProgramNodeVisitor 
	^aProgramNodeVisitor visitThisContextNode: self! !

!RBThreeElementPointRule commentStamp: 'StephaneDucasse 11/29/2014 22:58'!
Checks arithmetic statements for possible three element points (i.e., a point that has another point in its x or y part).!
!RBThreeElementPointRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:50'!
initialize
	super initialize.
	self matcher
		matches: '``@x @ ``@y'
		do: [ :node :answer | 
			answer isNil 
				ifTrue: [
					| current |
					current := node parent.
					[ current isNil or: [ current isMessage and: [ current selector = #@ or: [ current selector isInfix not ] ] ] ] 
						whileFalse: [ current := current parent ].
					(current isNil or: [ current isMessage and: [ current selector isInfix not ] ]) 
						ifTrue: [ nil ]
						ifFalse: [ node ] ]
				ifFalse: [ answer ] ]! !

!RBThreeElementPointRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
rationale
	^ 'Checks arithmetic statements for possible three element points (i.e., a point that has another point in its x or y part).'! !

!RBThreeElementPointRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Possible bugs'! !

!RBThreeElementPointRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Possible three element point (e.g., x @ y + q @ r)'! !

!RBThreeElementPointRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:32'!
category 
	^ 'Potential Bugs'! !

!RBThreeElementPointRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'ThreeElementPointRule'! !

!RBToDoCollectRule commentStamp: 'StephaneDucasse 11/29/2014 22:58'!
Checks for users of to:do: when the shorter collect: would work.!
!RBToDoCollectRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:50'!
initialize
	super initialize.
	self matcher 
		matchesAnyOf: #(
			'| `@temps1 |
			`@.Stmts1.
			`collection := Array new: `@size.
			`@.Stmts2.
			1 to: `@size do: 
					[:`i | 
					| `@Btemps2 | 
					`@.BStmts1. 
					`collection at: `i put: `@obj.
					`@.BStmt2].
			`@.Stmts3'
				'| `@temps1 |
			`@.Stmts1.
			`collection := Array new: `@size.
			`@.Stmts2.
			1 to: `collection size do: 
					[:`i | 
					| `@Btemps2 | 
					`@.BStmts1. 
					`collection at: `i put: `@obj.
					`@.BStmt2].
			`@.Stmts3' )
		do: [ :node :answer | node ]! !

!RBToDoCollectRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Intention revealing'! !

!RBToDoCollectRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'to:do: doesn''t use collect:'! !

!RBToDoCollectRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:33'!
category 
	^ 'Coding Idiom Violation'! !

!RBToDoCollectRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'ToDoCollectRule'! !

!RBToDoRule commentStamp: 'StephaneDucasse 11/29/2014 22:58'!
Checks for use of to:do: when a do:, with:do: or timesRepeat: when should be used.!
!RBToDoRule methodsFor: 'initialization' stamp: 'lr 11/2/2009 23:38'!
initialize
	super initialize.
	self matcher 
		matches: '1 to: ``@object size do: [:`each | | `@temps | `@.Statements]'
		do: [ :node :answer | 
			answer isNil 
				ifTrue: [
					| varName variableMatcher |
					varName := node arguments last arguments first.	"`each"
					variableMatcher := RBParseTreeSearcher new.
					variableMatcher 
						matchesTree: varName
						do: [ :nod :ans | ans and: [ nod parent isMessage and: [ nod parent selector = #at: ] ] ].
					(variableMatcher executeTree: node arguments last body initialAnswer: true) 
						ifTrue: [ node ]
						ifFalse: [ nil ] ]
				ifFalse: [ answer ] ]! !

!RBToDoRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Intention revealing'! !

!RBToDoRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Uses to:do: instead of do:, with:do: or timesRepeat:'! !

!RBToDoRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:33'!
category 
	^ 'Coding Idiom Violation'! !

!RBToDoRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'ToDoRule'! !

!RBToDoWithIncrementRule commentStamp: 'StephaneDucasse 11/29/2014 22:57'!
Checks for users of to:do: that also increment or decrement a counter.
In Pharo you do not increment or decrement counter but should use the message to:do:by:.

1 to: 100 by: 3 do: [ :each | ... ]!
!RBToDoWithIncrementRule methodsFor: 'initialization' stamp: 'lr 5/15/2010 17:41'!
initialize
	super initialize.
	self matcher 
		matchesAnyOf: #(
			'`@i to: `@j do: [:`e | | `@temps | `@.Stmts. `x := `x + 1. `@.Stmts2]'
			'`@i to: `@j by: `@k do: [:`e | | `@temps | `@.Stmts. `x := `x + `@k. `@.Stmts2]' 
			'`@i to: `@j do: [:`e | | `@temps | `@.Stmts. `x := `x - 1. `@.Stmts2]'
			'`@i to: `@j by: `@k do: [:`e | | `@temps | `@.Stmts. `x := `x - `@k. `@.Stmts2]')
		do: [ :node :answer | node ]! !

!RBToDoWithIncrementRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 17:42'!
rationale
	^ 'Checks for users of to:do: that also increment or decrement a counter.'! !

!RBToDoWithIncrementRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Intention revealing'! !

!RBToDoWithIncrementRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'to:do: loop also increments a counter'! !

!RBToDoWithIncrementRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:33'!
category 
	^ 'Coding Idiom Violation'! !

!RBToDoWithIncrementRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'ToDoWithIncrementRule'! !

!RBToken commentStamp: '<historical>'!
RBToken is the abstract superclass of all of the RB tokens. These tokens (unlike the standard parser's) remember where they came from in the original source code.

Subclasses must implement the following messages:
	accessing
		length

Instance Variables:
	sourcePointer	<Integer>	The position in the original source code where this token began.
!
!RBToken methodsFor: 'accessing' stamp: ''!
comments
	^comments! !

!RBToken methodsFor: 'testing' stamp: ''!
isIdentifier
	^false! !

!RBToken methodsFor: 'accessing' stamp: ''!
removePositions
	sourcePointer := nil! !

!RBToken methodsFor: 'testing' stamp: ''!
isKeyword
	^false! !

!RBToken methodsFor: 'testing' stamp: ''!
isPatternVariable
	^false! !

!RBToken methodsFor: 'testing' stamp: ''!
isLiteralArrayToken
	^false! !

!RBToken methodsFor: 'testing' stamp: ''!
isBinary
	^false! !

!RBToken methodsFor: 'testing' stamp: ''!
isSpecial
	^false! !

!RBToken methodsFor: 'accessing' stamp: ''!
comments: anObject
	comments := anObject! !

!RBToken methodsFor: 'accessing' stamp: 'ClementBera 7/26/2013 17:17'!
stop
	^ sourcePointer 
		ifNil: [ -1 ]
		ifNotNil: [ self start + self length - 1 ]! !

!RBToken methodsFor: 'testing' stamp: ''!
isAssignment
	^false! !

!RBToken methodsFor: 'testing' stamp: ''!
isLiteralToken
	^false! !

!RBToken methodsFor: 'printing' stamp: ''!
printOn: aStream 
	aStream
		nextPut: $ ;
		nextPutAll: self class name! !

!RBToken methodsFor: 'testing' stamp: ''!
isPatternBlock
	^false! !

!RBToken methodsFor: 'accessing' stamp: 'lr 2/18/2010 17:25'!
start
	^ sourcePointer ifNil: [ 0 ]! !

!RBToken methodsFor: 'accessing' stamp: ''!
length
	^self subclassResponsibility! !

!RBToken methodsFor: 'initialize-release' stamp: ''!
start: anInteger 
	sourcePointer := anInteger! !

!RBToken methodsFor: 'testing' stamp: 'GiselaDecuzzi 6/10/2013 10:40'!
isError
	^false! !

!RBToken class methodsFor: 'instance creation' stamp: ''!
start: anInterval 
	^self new start: anInterval! !

!RBTransformationRule commentStamp: '<historical>'!
A RBTransformationRule is a special rule that not only detects problems but also can automatically transform the good.!
!RBTransformationRule methodsFor: 'accessing' stamp: 'CamilleTeruel 4/3/2013 17:24'!
changes
	^ self builder changes! !

!RBTransformationRule methodsFor: 'accessing' stamp: 'CamilleTeruel 4/3/2013 17:24'!
builder
	^ builder
		ifNil: [ 
			self resetResult.
			builder ]! !

!RBTransformationRule methodsFor: 'testing' stamp: 'lr 2/23/2009 23:47'!
isEmpty
	^ builder changes isEmpty! !

!RBTransformationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:23'!
rewriteRule
	^ rewriteRule! !

!RBTransformationRule methodsFor: 'testing' stamp: 'lr 2/23/2009 23:47'!
hasConflicts
	^ true! !

!RBTransformationRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:15'!
result
	| environment |
	environment := RBParseTreeEnvironment new.
	environment matcher: self rewriteRule.
	environment label: self name.
	self changes do: [ :change |
		(change isKindOf: RBAddMethodChange)
			ifTrue: [ environment addClass: change changeClass selector: change selector ] ].
	^ environment! !

!RBTransformationRule methodsFor: 'running' stamp: 'MarcusDenker 10/31/2014 16:24'!
checkMethod: aMethod 
	aMethod isFromTrait
		ifTrue: [ ^ self ].
	(self rewriteRule canMatchMethod: aMethod) 
		ifFalse: [ ^ self ].
	class := aMethod methodClass.
	(self rewriteRule executeTree: aMethod ast copy) ifTrue: [
		(self class recursiveSelfRule executeTree: rewriteRule tree initialAnswer: false) 
			ifFalse: [ builder compile: rewriteRule tree newSource in: class classified: aMethod protocol ] ]! !

!RBTransformationRule methodsFor: 'initialization' stamp: 'lr 11/2/2009 00:14'!
initialize
	super initialize.
	rewriteRule := RBParseTreeRewriter new! !

!RBTransformationRule methodsFor: 'accessing' stamp: 'StephaneDucasse 6/28/2014 18:47'!
rewriteRule: aRule

	rewriteRule := aRule! !

!RBTransformationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:46'!
problemCount
	^ builder problemCount! !

!RBTransformationRule methodsFor: 'running' stamp: 'lr 9/8/2011 20:10'!
resetResult
	builder := RBCompositeRefactoryChange named: self name! !

!RBTransformationRule methodsFor: '*Manifest-Core' stamp: 'SimonAllier 3/29/2013 10:59'!
transform: aCritic
	| changeCode |

	changeCode := (self changes detect: [ :ch | 
			(ch  isMeta = aCritic  methodClass isMeta) &
			(ch changeClassName = aCritic criticTheNonMetaclassClass name) & 
			(ch selector = aCritic selector)]) source.
		
	aCritic methodClass compile: changeCode! !

!RBTransformationRule methodsFor: 'accessing' stamp: 'StephaneDucasse 6/28/2014 18:47'!
name

	^ 'Code Rewriting'! !

!RBTransformationRule methodsFor: 'testing' stamp: ''!
isTransformationRule

	^ true ! !

!RBTransformationRule class methodsFor: 'initialization' stamp: 'lr 11/2/2009 00:14'!
initializeRecursiveSelfRule
	RecursiveSelfRule := RBParseTreeSearcher new.
	RecursiveSelfRule 
		matchesAnyMethodOf: #(
			'`@methodName: `@args | `@temps | self `@methodName: `@args1' 
			'`@methodName: `@args | `@temps | ^ self `@methodName: `@args1')
		do: [ :node :answer | true ].
	^ RecursiveSelfRule! !

!RBTransformationRule class methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:48'!
initialize
	self initializeRecursiveSelfRule! !

!RBTransformationRule class methodsFor: 'testing' stamp: 'lr 2/24/2009 17:09'!
isVisible
	^ self name ~= #RBTransformationRule! !

!RBTransformationRule class methodsFor: 'accessing' stamp: 'MarcusDenker 10/12/2013 00:09'!
recursiveSelfRule
	^ RecursiveSelfRule ifNil: [ self initializeRecursiveSelfRule ]! !

!RBTransformationRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'TransformationRule'! !

!RBTransformationRule class methodsFor: 'cleanup' stamp: 'MarcusDenker 10/11/2013 11:21'!
cleanUp
	RecursiveSelfRule := nil.! !

!RBTransformationRuleTest methodsFor: 'rules' stamp: 'lr 11/2/2009 00:14'!
superSends
	| rule |
	rule := RBParseTreeRewriter new.
	rule addSearch: 'super `@message: ``@args'
				-> (
					[:aNode | 
					(class withAllSubclasses
						detect: [:each | each includesSelector: aNode selector]
						ifNone: [nil]) isNil]
							-> 'self `@message: ``@args').
	self rewriteUsing: rule! !

!RBTransformationRuleTest methodsFor: 'testing' stamp: ''!
isEmpty
	^builder changes isEmpty! !

!RBTransformationRuleTest methodsFor: 'accessing' stamp: ''!
problemCount
	^builder problemCount! !

!RBTransformationRuleTest methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:10'!
resetResult
	builder := RBCompositeRefactoryChange new! !

!RBTransformationRuleTest methodsFor: 'testing' stamp: ''!
hasConflicts
	^true! !

!RBTransformationRuleTest methodsFor: 'private' stamp: ''!
viewResults
	"I reset the result so that we don't fill up memory with methods to compile in the builder."

	builder inspect.
	self resetResult! !

!RBTransformationRuleTest methodsFor: 'accessing' stamp: ''!
checkMethod: aSmalllintContext 
	class := aSmalllintContext selectedClass.
	(rewriteRule executeTree: aSmalllintContext parseTree) ifTrue: 
			[(RecursiveSelfRule executeTree: rewriteRule tree initialAnswer: false)
				ifFalse: 
					[builder compile: rewriteRule tree printString
						in: class
						classified: aSmalllintContext protocols]]! !

!RBTransformationRuleTest methodsFor: 'initialize-release' stamp: ''!
rewriteUsing: searchReplacer 
	rewriteRule := searchReplacer.
	self resetResult! !

!RBTransformationRuleTest class methodsFor: 'transformations' stamp: ''!
assignmentInIfTrue
	^self rewrite: #(
			#('``@Boolean ifTrue: [`variable := ``@true] ifFalse: [`variable := ``@false]'
			"->"
			'`variable := ``@Boolean ifTrue: [``@true] ifFalse: [``@false]')
			#('``@Boolean ifFalse: [`variable := ``@true] ifTrue: [`variable := ``@false]'
			"->"
			'`variable := ``@Boolean ifFalse: [``@true] ifTrue: [``@false]'))
		methods: false
		name: 'Move variable assignment outside of single statement ifTrue:ifFalse: blocks'! !

!RBTransformationRuleTest class methodsFor: 'transformations' stamp: ''!
betweenAnd
	^self rewrite: #(
			#('``@a >= ``@b and: [``@a <= ``@c]' "->" '``@a between: ``@b and: ``@c')
			#('``@a >= ``@b & (``@a <= ``@c)' "->" '``@a between: ``@b and: ``@c')
			#('``@b <= ``@a and: [``@a <= ``@c]' "->" '``@a between: ``@b and: ``@c')
			#('``@b <= ``@a & (``@a <= ``@c)' "->" '``@a between: ``@b and: ``@c')
			#('``@a <= ``@c and: [``@a >= ``@b]' "->" '``@a between: ``@b and: ``@c')
			#('``@a <= ``@c & (``@a >= ``@b)' "->" '``@a between: ``@b and: ``@c')
			#('``@c >= ``@a and: [``@a >= ``@b]' "->" '``@a between: ``@b and: ``@c')
			#('``@c >= ``@a & (``@a >= ``@b)' "->" '``@a between: ``@b and: ``@c')
			#('``@a >= ``@b and: [``@c >= ``@a]' "->" '``@a between: ``@b and: ``@c')
			#('``@a >= ``@b & (``@c >= ``@a)' "->" '``@a between: ``@b and: ``@c')
			#('``@b <= ``@a and: [``@c >= ``@a]' "->" '``@a between: ``@b and: ``@c')
			#('``@b <= ``@a & (``@c >= ``@a)' "->" '``@a between: ``@b and: ``@c')
			#('``@a <= ``@c and: [``@b <= ``@a]' "->" '``@a between: ``@b and: ``@c')
			#('``@a <= ``@c & (``@b <= ``@a)' "->" '``@a between: ``@b and: ``@c')
			#('``@c >= ``@a and: [``@b <= ``@a]' "->" '``@a between: ``@b and: ``@c')
			#('``@c >= ``@a & (``@b <= ``@a)' "->" '``@a between: ``@b and: ``@c'))
		methods: false
		name: '"a >= b and: [a <= c]" -> "a between: b and: c"'! !

!RBTransformationRuleTest class methodsFor: 'transformations' stamp: ''!
superSends
	^(self new)
		name: 'Rewrite super messages to self messages when both refer to same method';
		superSends;
		yourself! !

!RBTransformationRuleTest class methodsFor: 'transformations' stamp: ''!
atIfAbsent
	^self rewrite: #(
			#('``@dictionary at: ``@key 
					ifAbsent: [| `@temps | 
							``@.Statements1.
							``@dictionary at: ``@key put: ``@object.
							``@.Statements2.
							``@object]'
			"->"
			'``@dictionary at: ``@key
					ifAbsentPut: [| `@temps |
							``@.Statements1.
							``@.Statements2.
							``@object]')
			#('``@dictionary at: ``@key
					ifAbsent: [| `@temps |
							``@.Statements.
							``@dictionary at: ``@key put: ``@object]'
			"->"
			'``@dictionary at: ``@key
					ifAbsentPut: [| `@temps |
							``@.Statements.
							``@object]'))
		methods: false
		name: 'at:ifAbsent: -> at:ifAbsentPut:'! !

!RBTransformationRuleTest class methodsFor: 'transformations' stamp: ''!
guardClause
	^self
		rewrite: #(
			#('`@methodName: `@args 
					| `@temps | 
					`@.Statements. 
					`@condition ifTrue: [| `@trueTemps | `.Statement1. `.Statement2. `@.Statements1]'
			"->"
			'`@methodName: `@args
					| `@temps `@trueTemps |
					`@.Statements.
					`@condition ifFalse: [^self].
					`.Statement1.
					`.Statement2.
					`@.Statements1') 
			#('`@methodName: `@args 
					| `@temps | 
					`@.Statements. 
					`@condition ifFalse: [| `@falseTemps | `.Statement1. `.Statement2. `@.Statements1]'
			"->"
			'`@methodName: `@args
					| `@temps `@falseTemps |
					`@.Statements.
					`@condition ifTrue: [^self].
					`.Statement1.
					`.Statement2.
					`@.Statements1'))
		methods: true
		name: 'Eliminate guarding clauses'! !

!RBTransformationRuleTest class methodsFor: 'transformations' stamp: ''!
showWhileBlocks
	^self
		rewrite: #(
			#('``@cursor showWhile: [| `@temps | ``@.Statements. `var := ``@object]'
				"->"	'`var := ``@cursor showWhile: [| `@temps | ``@.Statements. ``@object]') 
			#('``@cursor showWhile: [| `@temps | ``@.Statements. ^``@object]'
				"->"	'^``@cursor showWhile: [| `@temps | ``@.Statements. ``@object]'))
		methods: false
		name: 'Move assignment out of showWhile: blocks'! !

!RBTransformationRuleTest class methodsFor: 'transformations' stamp: ''!
minMax
	^self rewrite: #(
			#('``@a < ``@b ifTrue: [``@a] ifFalse: [``@b]'	"->"	'``@a min: ``@b')
			#('``@a <= ``@b ifTrue: [``@a] ifFalse: [``@b]'	"->"	'``@a min: ``@b')
			#('``@a > ``@b ifTrue: [``@a] ifFalse: [``@b]'	"->"	'``@a max: ``@b')
			#('``@a >= ``@b ifTrue: [``@a] ifFalse: [``@b]'	"->"	'``@a max: ``@b')
			#('``@a < ``@b ifTrue: [``@b] ifFalse: [``@a]'	"->"	'``@a max: ``@b')
			#('``@a <= ``@b ifTrue: [``@b] ifFalse: [``@a]'	"->"	'``@a max: ``@b')
			#('``@a > ``@b ifTrue: [``@b] ifFalse: [``@a]'	"->"	'``@a min: ``@b')
			#('``@a >= ``@b ifTrue: [``@b] ifFalse: [``@a]'	"->"	'``@a min: ``@b')
			#('`a < ``@b ifTrue: [`a := ``@b]'				"->"	'`a := `a max: ``@b')
			#('`a <= ``@b ifTrue: [`a := ``@b]'				"->"	'`a := `a max: ``@b')
			#('`a < ``@b ifFalse: [`a := ``@b]'				"->"	'`a := `a min: ``@b')
			#('`a <= ``@b ifFalse: [`a := ``@b]'			"->"	'`a := `a min: ``@b')
			#('`a > ``@b ifTrue: [`a := ``@b]'				"->"	'`a := `a min: ``@b')
			#('`a >= ``@b ifTrue: [`a := ``@b]'				"->"	'`a := `a min: ``@b')
			#('`a > ``@b ifFalse: [`a := ``@b]'				"->"	'`a := `a max: ``@b')
			#('`a >= ``@b ifFalse: [`a := ``@b]'			"->"	'`a := `a max: ``@b')
			#('``@b < `a ifTrue: [`a := ``@b]'				"->"	'`a := `a min: ``@b')
			#('``@b <= `a ifTrue: [`a := ``@b]'				"->"	'`a := `a min: ``@b')
			#('``@b < `a ifFalse: [`a := ``@b]'				"->"	'`a := `a max: ``@b')
			#('``@b <= `a ifFalse: [`a := ``@b]'			"->"	'`a := `a max: ``@b')
			#('``@b > `a ifTrue: [`a := ``@b]'				"->"	'`a := `a max: ``@b')
			#('``@b >= `a ifTrue: [`a := ``@b]'				"->"	'`a := `a max: ``@b')
			#('``@b > `a ifFalse: [`a := ``@b]'				"->"	'`a := `a min: ``@b')
			#('``@b >= `a ifFalse: [`a := ``@b]'			"->"	'`a := `a min: ``@b'))
		methods: false
		name: 'Rewrite ifTrue:ifFalse: using min:/max:'! !

!RBTransformationRuleTest class methodsFor: 'transformations' stamp: ''!
detectIfNone
	^self rewrite: #(
			#('(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) isNil'
				"->"	'(``@collection contains: [:`each | | `@temps | ``@.Statements]) not')
			#('(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) = nil'
				"->"	'(``@collection contains: [:`each | | `@temps | ``@.Statements]) not')
			#('(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) == nil'
				"->"	'(``@collection contains: [:`each | | `@temps | ``@.Statements]) not')
			#('(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) notNil'
				"->"	'``@collection contains: [:`each | | `@temps | ``@.Statements]')
			#('(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) ~= nil'
				"->"	'``@collection contains: [:`each | | `@temps | ``@.Statements]')
			#('(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) ~~ nil'
				"->"	'``@collection contains: [:`each | | `@temps | ``@.Statements]'))
		methods: false
		name: 'detect:ifNone: -> contains:'! !

!RBTransformationRuleTest class methodsFor: 'class initialization' stamp: 'lr 11/2/2009 00:14'!
initializeAfterLoad1
	RecursiveSelfRule := RBParseTreeSearcher new.
	RecursiveSelfRule
		addMethodSearches: #('`@methodName: `@args | `@temps | self `@methodName: `@args' '`@methodName: `@args | `@temps | ^self `@methodName: `@args')
				-> [:aNode :answer | true]! !

!RBTransformationRuleTest class methodsFor: 'instance creation' stamp: 'lr 11/2/2009 00:14'!
rewrite: stringArrays methods: aBoolean name: aName 
	| rewriteRule |
	rewriteRule := RBParseTreeRewriter new.
	stringArrays do: 
			[:each | 
			aBoolean
				ifTrue: [rewriteRule addMethodSearch: each first -> each last]
				ifFalse: [rewriteRule addSearch: each first -> each last]].
	^(self new) name: aName;
		rewriteUsing: rewriteRule;
		yourself! !

!RBTransformationRuleTest class methodsFor: 'cleanup' stamp: 'MarcusDenker 10/11/2013 11:19'!
cleanUp
	self nuke! !

!RBTransformationRuleTest class methodsFor: 'class initialization' stamp: ''!
nuke
	RecursiveSelfRule := nil! !

!RBTransformationRuleTest class methodsFor: 'transformations' stamp: ''!
equalNil
	^self
		rewrite: #(
			#('``@object = nil'	"->"	'``@object isNil') 
			#('``@object == nil'	"->"	'``@object isNil') 
			#('``@object ~= nil'	"->"	'``@object notNil') 
			#('``@object ~~ nil'	"->"	'``@object notNil'))
		methods: false
		name: '= nil -> isNil AND ~= nil -> notNil'! !

!RBTransformationRuleTest class methodsFor: 'transformations' stamp: ''!
notElimination
	^self
		rewrite: #(
			#('``@object not not'	"->"	'``@object') 
			#('``@object not ifTrue: ``@block' 	"->"	'``@object ifFalse: ``@block') 
			#('``@object not ifFalse: ``@block'	"->"	'``@object ifTrue: ``@block') 
			#('``@collection select: [:`each | | `@temps | ``@.Statements. ``@object not]'
				"->"	'``@collection reject: [:`each | | `@temps | ``@.Statements. ``@object]')
			#('``@collection reject: [:`each | | `@temps | ``@.Statements. ``@object not]'
				"->"	'``@collection select: [:`each | | `@temps | ``@.Statements. ``@object]')
			#('[| `@temps | ``@.Statements. ``@object not] whileTrue: ``@block'
				"->"	'[| `@temps | ``@.Statements. ``@object] whileFalse: ``@block')
			#('[| `@temps | ``@.Statements. ``@object not] whileFalse: ``@block'
				"->"	'[| `@temps | ``@.Statements. ``@object] whileTrue: ``@block')
			#('[| `@temps | ``@.Statements. ``@object not] whileTrue'
				"->"	'[| `@temps | ``@.Statements. ``@object] whileFalse')
			#('[| `@temps | ``@.Statements. ``@object not] whileFalse'
				"->"	'[| `@temps | ``@.Statements. ``@object] whileTrue')
			#('(``@a <= ``@b) not' "->" '``@a > ``@b')
			#('(``@a < ``@b) not' "->" '``@a >= ``@b')
			#('(``@a = ``@b) not' "->" '``@a ~= ``@b')
			#('(``@a == ``@b) not' "->" '``@a ~~ ``@b')
			#('(``@a ~= ``@b) not' "->" '``@a = ``@b')
			#('(``@a ~~ ``@b) not' "->" '``@a == ``@b')
			#('(``@a >= ``@b) not' "->" '``@a < ``@b')
			#('(``@a > ``@b) not' "->" '``@a <= ``@b'))			
		methods: false
		name: 'Eliminate unnecessary not''s'! !

!RBTransformationRuleTest class methodsFor: 'transformations' stamp: 'lr 11/19/2009 14:49'!
unwindBlocks
	^self
		rewrite: #(
			#('[| `@temps | ``@.Statements. `var := ``@object] ensure: ``@block'
				"->"	'`var := [| `@temps | ``@.Statements. ``@object] ensure: ``@block') 
			#('[| `@temps | ``@.Statements. ^``@object] ensure: ``@block'
				"->"	'^[| `@temps | ``@.Statements. ``@object] ensure: ``@block') 
			#('[| `@temps | ``@.Statements. `var := ``@object] ifCurtailed: ``@block'
				"->"	'`var := [| `@temps | ``@.Statements. ``@object] ifCurtailed: ``@block') 
			#('[| `@temps | ``@.Statements. ^``@object] ifCurtailed: ``@block'
				"->"	'^[| `@temps | ``@.Statements. ``@object] ifCurtailed: ``@block'))
		methods: false
		name: 'Move assignment out of unwind blocks'! !

!RBTrueFalseDuplicationRule commentStamp: 'StephaneDucasse 11/29/2014 22:56'!
Checks for ifTrue:ifFalse: blocks that have the same code at the beginning or end. Instead of having the same code in two places, you should move it outside the blocks.!
!RBTrueFalseDuplicationRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:27'!
initialize
	super initialize.
	self matcher
		matchesAnyOf: #(
			'`@object 
				ifTrue: [| `@temps1 | `@.Statements1. `.Statement] 
				ifFalse: [| `@temps2 | `@.Statements2. `.Statement]' 
			'`@object 
				ifTrue: [| `@temps1 | `.Statement. `@.Statements1] 
				ifFalse: [| `@temps2 | `.Statement. `@.Statements2]' 
			'`@object 
				ifFalse: [| `@temps1 | `@.Statements1. `.Statement] 
				ifTrue: [| `@temps2 | `@.Statements2. `.Statement]' 
			'`@object 
				ifFalse: [| `@temps1 | `.Statement. `@.Statements1] 
				ifTrue: [| `@temps2 | `.Statement. `@.Statement2]') 
			do: [ :node :answer | 
				answer isNil 
					ifTrue: [
						| statement |
						statement := node arguments first body statements last.
						(statement isVariable and: [ statement = node arguments last body statements last ]) 
							ifFalse: [ node ]
							ifTrue: [ nil ] ]
					ifFalse: [ answer ] ]! !

!RBTrueFalseDuplicationRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 22:56'!
rationale
	^ 'Checks for ifTrue:ifFalse: blocks that have the same code at the beginning or end.'! !

!RBTrueFalseDuplicationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Unnecessary code'! !

!RBTrueFalseDuplicationRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:09'!
severity
	^ #information! !

!RBTrueFalseDuplicationRule methodsFor: 'accessing' stamp: 'CAMILLETERUEL 3/29/2013 13:09'!
name
	^ 'Check for same statements in ifTrue:ifFalse: blocks'! !

!RBTrueFalseDuplicationRule methodsFor: 'accessing' stamp: 'MarcusDenker 11/11/2014 16:02'!
category 
    ^ 'Optimization'! !

!RBTrueFalseDuplicationRule class methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 23:02'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'TrueFalseDuplication'! !

!RBUnclassifiedMethodsRule commentStamp: 'StephaneDucasse 11/29/2014 20:20'!
All methods should be put into a protocol (method category) for better readability.!
!RBUnclassifiedMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Miscellaneous'! !

!RBUnclassifiedMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Unclassified methods'! !

!RBUnclassifiedMethodsRule methodsFor: 'accessing' stamp: 'Simon 8/30/2012 14:57'!
category
	^ 'Style'! !

!RBUnclassifiedMethodsRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:08'!
checkMethod: aMethod 
	(aMethod methodClass organization categoryOfElement: aMethod selector) = Protocol unclassified ifTrue: 
		[ result addMethod: aMethod ]! !

!RBUnclassifiedMethodsRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'UnclassifiedMethodsRule'! !

!RBUncommonMessageSendRule commentStamp: 'StephaneDucasse 11/29/2014 20:19'!
Sending messages with a common literal (e.g. "Object self") or an uppercase selector name are usually bugs, introduced through missing statement separators.!
!RBUncommonMessageSendRule methodsFor: 'accessing' stamp: 'SeanDeNigris 1/31/2013 09:45'!
commonLiterals

	^ #(#self #super #thisContext #true #false #nil) asIdentitySet! !

!RBUncommonMessageSendRule methodsFor: 'initialization' stamp: 'SeanDeNigris 1/31/2013 09:45'!
initialize
	super initialize.
	literalNames := self commonLiterals.! !

!RBUncommonMessageSendRule methodsFor: 'accessing' stamp: 'lr 3/28/2009 14:21'!
group
	^ 'Possible bugs'! !

!RBUncommonMessageSendRule methodsFor: 'accessing' stamp: 'lr 3/28/2009 14:22'!
name
	^ 'Uncommon message send'! !

!RBUncommonMessageSendRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 13:41'!
category
	^ 'Potential Bugs'! !

!RBUncommonMessageSendRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:08'!
checkMethod: aMethod 
	aMethod messages do: [ :each |
		(each isEmpty or: [ each first isUppercase or: [ literalNames includes: each ] ]) ifTrue: [
			result 
				addMethod: aMethod;
				addSearchString: each ] ]! !

!RBUncommonMessageSendRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'UncommonMessageSendRule'! !

!RBUnconditionalRecursionRule commentStamp: 'StephaneDucasse 11/29/2014 22:55'!
Checks for unconditional recursion that might cause the image to hang when executed.!
!RBUnconditionalRecursionRule methodsFor: 'initialization' stamp: 'lr 5/15/2010 18:09'!
initialize
	super initialize.
	self matcher
		matchesMethod: '`@message: `@args
			| `@temps |
			`@.before.
			self `@message: `@args.
			`@.after'
		do: [ :node :answer | 
			| index |
			index := node body statements
				findFirst: [ :each | each isMessage and: [ each selector = node selector ] ].
			((node body statements copyFrom: 1 to: index)
				anySatisfy: [ :each | each containsReturn ])
					ifTrue: [ answer ]
					ifFalse: [ node ] ]! !

!RBUnconditionalRecursionRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Possible bugs'! !

!RBUnconditionalRecursionRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 17:55'!
severity
	^ #error! !

!RBUnconditionalRecursionRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Unconditional recursion'! !

!RBUnconditionalRecursionRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:34'!
category 
	^ 'Potential Bugs'! !

!RBUnconditionalRecursionRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'UnconditionalRecursionRule'! !

!RBUndeclaredReferenceRule commentStamp: 'StephaneDucasse 11/29/2014 20:17'!
Checks for references to variables in the Undeclared dictionary. If you remove a referenced variable from a class, you will create an undeclared variable reference for those methods that accessed the variable.!
!RBUndeclaredReferenceRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 20:17'!
rationale
	^ 'Checks for references to a undeclared variables'! !

!RBUndeclaredReferenceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Bugs'! !

!RBUndeclaredReferenceRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:04'!
severity
	^ #error! !

!RBUndeclaredReferenceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'References an undeclared variable'! !

!RBUndeclaredReferenceRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:08'!
checkMethod: aMethod 
	
	Undeclared associations
		detect: [ :each |
			aMethod refersToLiteral: each ]
		ifFound: [ :each | 
			result
				addSearchString: each key;
				addMethod: aMethod ]! !

!RBUndeclaredReferenceRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 13:42'!
category 
	^ 'Bugs'! !

!RBUndeclaredReferenceRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'UndeclaredReferenceRule'! !

!RBUnderscoreAssignmentRule commentStamp: 'StephaneDucasse 11/29/2014 18:49'!
Replace _ by :=!
!RBUnderscoreAssignmentRule methodsFor: 'initialization' stamp: 'lr 11/7/2009 18:31'!
initialize
	super initialize.
	self rewriteRule 
		replace: '`var := ``@object' with: '`var := ``@object'
		when: [ :node | node assignmentOperator = '_' ]! !

!RBUnderscoreAssignmentRule methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:02'!
group
	^ 'Transformations'! !

!RBUnderscoreAssignmentRule methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:05'!
name
	^ 'Underscore assignements should be avoided'! !

!RBUnderscoreAssignmentRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:52'!
category
	^ 'Style'! !

!RBUnderscoreAssignmentRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'UnderscoreAssignmentRule'! !

!RBUnnecessaryAssignmentRule commentStamp: 'StephaneDucasse 11/29/2014 22:55'!
Checks for assignements to temporaries that are not used afterwards.!
!RBUnnecessaryAssignmentRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:53'!
initialize
	super initialize.
	self matcher 
		matches: '^`{:aNode | aNode isAssignment and: [(aNode whoDefines: aNode variable name) notNil]}'
		do: [ :node :answer | node ]! !

!RBUnnecessaryAssignmentRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 13:55'!
group
	^ 'Unnecessary code'! !

!RBUnnecessaryAssignmentRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:10'!
severity
	^ #information! !

!RBUnnecessaryAssignmentRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 13:55'!
name
	^ 'Unnecessary assignment to a temporary variable'! !

!RBUnnecessaryAssignmentRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:34'!
category 
	^ 'Optimization'! !

!RBUnnecessaryAssignmentRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'UnnecessaryAssignmentRule'! !

!RBUnoptimizedAndOrRule commentStamp: 'StephaneDucasse 11/29/2014 22:54'!
Checks for inefficient nesting of logical conditions.!
!RBUnoptimizedAndOrRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:53'!
initialize
	super initialize.
	self matcher 
		matchesAnyOf: #(
			'(`@a and: `@b) and: `@c'
			'(`@a or: `@b) or: `@c' )
		do: [ :node :answer | node ]! !

!RBUnoptimizedAndOrRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Miscellaneous'! !

!RBUnoptimizedAndOrRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Uses "(a and: [b]) and: [c]" instead of "a and: [b and: [c]]"'! !

!RBUnoptimizedAndOrRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:34'!
category 
	^ 'Optimization'! !

!RBUnoptimizedAndOrRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'UnoptimizedAndOrRule'! !

!RBUnoptimizedToDoRule commentStamp: 'StephaneDucasse 11/29/2014 22:54'!
Checks for inefficient uses of to:do: that create an unnecessary Interval instance.

( 1 to: 10 ) do: aBlock

can be more efficiently expressed as 

1 to: 10 do: aBlock!
!RBUnoptimizedToDoRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:53'!
initialize
	super initialize.
	self matcher 
		matches: '(`@a to: `@b) do: `@c'
		do: [ :node :answer | node ]! !

!RBUnoptimizedToDoRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 17:48'!
rationale
	^ 'Checks for inefficient uses of to:do: that create an unnecessary Interval instance.'! !

!RBUnoptimizedToDoRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Miscellaneous'! !

!RBUnoptimizedToDoRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Uses (to:)do: instead of to:do:'! !

!RBUnoptimizedToDoRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:35'!
category 
	^ 'Optimization'! !

!RBUnoptimizedToDoRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'UnoptimizedToDoRule'! !

!RBUnpackagedCodeRule commentStamp: 'StephaneDucasse 11/29/2014 20:16'!
Code that is not contained in a Monticello package is not versioned and cannot be brought into a different image.!
!RBUnpackagedCodeRule methodsFor: 'initialization' stamp: 'EstebanLorenzano 9/12/2012 13:37'!
initialize
	super initialize.
	packages := MCWorkingCopy allManagers
		inject: #()
		into: [ :all :each | all, (each packageSet packages) ]! !

!RBUnpackagedCodeRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 13:43'!
category 
	^'Potential Bugs'! !

!RBUnpackagedCodeRule methodsFor: 'accessing' stamp: 'lr 3/20/2009 17:21'!
group
	^ 'Possible bugs'! !

!RBUnpackagedCodeRule methodsFor: 'accessing' stamp: 'lr 3/20/2009 08:20'!
name
	^ 'Unpackaged code'! !

!RBUnpackagedCodeRule methodsFor: 'private' stamp: 'lr 3/20/2009 09:17'!
packageSatisfying: aBlock
	"Answer the first package satisfying aBlock or nil. This method assumes that it is likely that the last matching package matches the given condition again and thus it tries that one first."

	(package notNil and: [ aBlock value: package ])
		ifTrue: [ ^ package ].
	packages do: [ :info |
		(aBlock value: info)
			ifTrue: [ ^ package := info ] ].
	^ nil! !

!RBUnpackagedCodeRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:09'!
checkMethod: aMethod
	(self packageSatisfying: [ :info | info includesMethod: aMethod selector ofClass: aMethod methodClass ]) isNil
		ifTrue: [ self result addMethod: aMethod ]! !

!RBUnpackagedCodeRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:50'!
checkClass: aClass 
	(aClass isMeta not and: [ (self packageSatisfying: [ :info | info includesSystemCategory: aClass category ]) isNil ])
		ifTrue: [ self result addClass: aClass ]! !

!RBUnpackagedCodeRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'UnpackagedCodeRule'! !

!RBUnreferencedVariablesRule commentStamp: 'StephaneDucasse 11/29/2014 20:15'!
Check for variables not referenced. If a variable is not used in a class, it should be deleted.!
!RBUnreferencedVariablesRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'!
resultClass
	^ RBVariableEnvironment! !

!RBUnreferencedVariablesRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Unnecessary code'! !

!RBUnreferencedVariablesRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:10'!
severity
	^ #information! !

!RBUnreferencedVariablesRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 13:44'!
category
	^ 'Design Flaws'! !

!RBUnreferencedVariablesRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Variables not referenced'! !

!RBUnreferencedVariablesRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:50'!
checkClass: aClass 
	| allSubclasses |
	allSubclasses := aClass withAllSubclasses.
	aClass instVarNames do: 
		[ :each | 
		allSubclasses 
			detect: [ :class | (class whichSelectorsAccess: each) isEmpty not ]
			ifNone: 
				[ result 
					addClass: aClass
					instanceVariable: each ] ].
	aClass isMeta ifFalse: 
		[ aClass classPool associationsDo: 
			[ :each | 
			(SystemNavigation default allCallsOn: each) ifEmpty: 
				[ result 
					addClass: aClass
					classVariable: each key ] ] ]! !

!RBUnreferencedVariablesRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'UnreferencedVariablesRule'! !

!RBUnwindBlocksRule commentStamp: 'StephaneDucasse 11/29/2014 18:59'!
Move assignment out of unwind blocks.

For example

[[[
[ statements. 
var := object ] ifCurtailed: block
]]]


[[[ 
var := [ statements. 
	    object] ifCurtailed: block
]]]!
!RBUnwindBlocksRule methodsFor: 'initialization' stamp: 'lr 11/4/2009 09:26'!
initialize
	super initialize.
	self rewriteRule
		replace: '[| `@temps | ``@.Statements. `var := ``@object] ensure: ``@block'
			with: '`var := [| `@temps | ``@.Statements. ``@object] ensure: ``@block';
		replace: '[| `@temps | ``@.Statements. ^``@object] ensure: ``@block'
			with: '^[| `@temps | ``@.Statements. ``@object] ensure: ``@block';
		replace:'[| `@temps | ``@.Statements. `var := ``@object] ifCurtailed: ``@block'
			with: '`var := [| `@temps | ``@.Statements. ``@object] ifCurtailed: ``@block';
		replace:'[| `@temps | ``@.Statements. ^``@object] ifCurtailed: ``@block'
			with: '^[| `@temps | ``@.Statements. ``@object] ifCurtailed: ``@block'! !

!RBUnwindBlocksRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Transformations'! !

!RBUnwindBlocksRule methodsFor: 'accessing' stamp: 'lr 11/19/2009 14:41'!
name
	^ 'Move assignment out of unwind blocks'! !

!RBUnwindBlocksRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:54'!
category
	^ 'Optimization'! !

!RBUnwindBlocksRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'UnwindBlocksRule'! !

!RBUsesAddRule commentStamp: 'StephaneDucasse 11/29/2014 22:52'!
Check for possible uses of the result returned by an add: or addAll: messages. These messages return their arguments not the receiver. As a result, may uses of the results are wrong.!
!RBUsesAddRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:53'!
initialize
	super initialize.
	self matcher 
		matches: '`{:node | node isMessage and: [(node selector == #add: or: [node selector == #addAll:]) and: [node isDirectlyUsed]]}'
		do: [ :node :answer | node ]! !

!RBUsesAddRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Possible bugs'! !

!RBUsesAddRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Uses the result of an add: message'! !

!RBUsesAddRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:35'!
category 
	^ 'Potential Bugs'! !

!RBUsesAddRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'UsesAddRule'! !

!RBUsesTrueRule commentStamp: 'StephaneDucasse 11/29/2014 20:14'!
Checks for uses of the classes True and False instead of the objects true and false.

true is the object true, while True is the class whose true is the sole instance.!
!RBUsesTrueRule methodsFor: 'initialization' stamp: 'lr 7/23/2010 08:04'!
initialize
	super initialize.
	trueBinding := Smalltalk globals associationAt: #True.
	falseBinding := Smalltalk globals associationAt: #False! !

!RBUsesTrueRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 13:46'!
category 	
	^ 'Bugs'! !

!RBUsesTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
rationale
	^ 'Checks for uses of the classes True and False instead of the objects true and false.'! !

!RBUsesTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Bugs'! !

!RBUsesTrueRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:04'!
severity
	^ #error! !

!RBUsesTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Uses True/False instead of true/false'! !

!RBUsesTrueRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:09'!
checkMethod: aMethod 
	((aMethod refersToLiteral: trueBinding) or: [ aMethod refersToLiteral: falseBinding ]) ifTrue: 
		[ result
			addMethod: aMethod;
			searchStrings: #('True' 'False' ) ]! !

!RBUsesTrueRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'UsesTrueRule'! !

!RBUtilityMethodsRule commentStamp: 'StephaneDucasse 11/29/2014 20:13'!
List methods that have one or more arguments and do no refer to self or an instance variable. These methods might be better defined in some other class or as class methods.!
!RBUtilityMethodsRule methodsFor: 'private' stamp: 'lr 2/24/2009 00:18'!
utilityProtocols
	^ #('*utilit*')! !

!RBUtilityMethodsRule methodsFor: 'private' stamp: 'lr 2/24/2009 00:18'!
subclassOf: aClass overrides: aSelector 
	^(aClass subclasses detect: 
			[:each | 
			(each includesSelector: aSelector)
				or: [self subclassOf: each overrides: aSelector]]
		ifNone: [nil]) notNil! !

!RBUtilityMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Miscellaneous'! !

!RBUtilityMethodsRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 13:46'!
category 		
	^ 'Design Flaws'! !

!RBUtilityMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Utility methods'! !

!RBUtilityMethodsRule methodsFor: 'running' stamp: 'MarcusDenker 10/27/2014 17:57'!
checkMethod: aMethod 
	(aMethod methodClass isMeta or: 
		[ aMethod selector numArgs == 0 or: 
			[ self utilityProtocols includes: aMethod protocol ] ]) ifFalse: 
		[ (self 
			subclassOf: aMethod methodClass
			overrides: aMethod selector) ifFalse: 
			[ (aMethod superMessages isEmpty and: [ aMethod selfMessages isEmpty ]) ifTrue: 
				[ (aMethod methodClass allInstVarNames , aMethod methodClass allClassVarNames asArray , #('self' ) 
					detect: [ :each | aMethod ast references: each ]
					ifNone: [  ]) isNil ifTrue: 
					[ result addMethod: aMethod ] ] ] ]! !

!RBUtilityMethodsRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'UtilityMethodsRule'! !

!RBValueNode commentStamp: '<historical>'!
RBValueNode is an abstract class that represents a node that returns some value.

Subclasses must implement the following messages:
	accessing
		startWithoutParentheses
		stopWithoutParentheses
	testing
		needsParenthesis

Instance Variables:
	parentheses	<SequenceableCollection of: Inteval>	the positions of the parethesis around this node. We need a collection of intervals for stupid code such as "((3 + 4))" that has multiple parethesis around the same expression.

!
!RBValueNode methodsFor: 'testing' stamp: ''!
hasParentheses
	^self parentheses notEmpty! !

!RBValueNode methodsFor: 'testing' stamp: ''!
isValue
	^true! !

!RBValueNode methodsFor: 'accessing' stamp: ''!
stopWithoutParentheses
	^self subclassResponsibility! !

!RBValueNode methodsFor: 'testing' stamp: ''!
containedBy: anInterval 
	^anInterval first <= self startWithoutParentheses 
		and: [anInterval last >= self stopWithoutParentheses]! !

!RBValueNode methodsFor: 'accessing' stamp: 'MarkRizun 10/31/2014 15:24'!
start
	^ parentheses ifNil: [ self startWithoutParentheses ] ifNotNil: [ parentheses last first ]! !

!RBValueNode methodsFor: 'accessing' stamp: 'ClementBera 7/26/2013 17:14'!
parentheses
	^parentheses ifNil: [#()] ifNotNil: [parentheses]! !

!RBValueNode methodsFor: 'accessing' stamp: 'ClementBera 7/26/2013 17:14'!
addParenthesis: anInterval 
	parentheses ifNil: [parentheses := OrderedCollection new: 1].
	parentheses add: anInterval! !

!RBValueNode methodsFor: 'testing' stamp: ''!
needsParenthesis
	^self subclassResponsibility! !

!RBValueNode methodsFor: 'converting' stamp: 'MarcusDenker 1/29/2013 14:25'!
asSequenceNode
	^RBSequenceNode statements: {self} ! !

!RBValueNode methodsFor: 'accessing' stamp: 'MarkRizun 10/31/2014 15:24'!
stop
	^ parentheses ifNil: [ self stopWithoutParentheses ] ifNotNil: [ parentheses last last ]! !

!RBValueNode methodsFor: 'accessing' stamp: ''!
startWithoutParentheses
	^self subclassResponsibility! !

!RBValueToken commentStamp: '<historical>'!
RBValueToken is the abstract superclass of all tokens that have additional information attached. For example, the BinarySelector token holds onto the actual character (e.g. $+).

Instance Variables:
	value	<String>	The value of this token

!
!RBValueToken methodsFor: 'private' stamp: ''!
length
	^value size! !

!RBValueToken methodsFor: 'accessing' stamp: ''!
value
	^value! !

!RBValueToken methodsFor: 'accessing' stamp: ''!
value: anObject
	value := anObject! !

!RBValueToken methodsFor: 'printing' stamp: 'CamilloBruni 2/20/2012 23:11'!
printOn: aStream
	super printOn: aStream.
	aStream nextPut: $(.
	value printOn: aStream.
	aStream nextPutAll: ')'! !

!RBValueToken methodsFor: 'initialize-release' stamp: ''!
value: aString start: anInteger 
	value := aString.
	sourcePointer := anInteger! !

!RBValueToken class methodsFor: 'instance creation' stamp: ''!
value: aString start: anInteger 
	^self new value: aString start: anInteger! !

!RBVariableAssignedLiteralRule commentStamp: 'StephaneDucasse 11/29/2014 20:12'!
If a variable is only assigned a single literal value then that variable is either nil or that literal value. If the variable is always initialized with that literal value, then you could replace each variable reference with a message send to get the value. If the variable can also be nil, then you might want to replace that variable with another that stores true or false depending on whether the old variable had been assigned.!
!RBVariableAssignedLiteralRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'!
resultClass
	^ RBVariableEnvironment! !

!RBVariableAssignedLiteralRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Miscellaneous'! !

!RBVariableAssignedLiteralRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Variable is only assigned a single literal value'! !

!RBVariableAssignedLiteralRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 13:48'!
category
	^ 'Design Flaws'! !

!RBVariableAssignedLiteralRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:50'!
checkClass: aClass 
	| allSubclasses |
	allSubclasses := aClass withAllSubclasses.
	aClass instVarNames do: 
		[ :each | 
		| defClass selector |
		(allSubclasses 
			inject: 0
			into: 
				[ :sum :class | 
				| sels |
				sels := class whichSelectorsAssign: each.
				sels size == 1 ifTrue: 
					[ selector := sels asArray first.
					defClass := class ].
				sum + sels size ]) == 1 ifTrue: 
			[ | tree searcher |
			searcher := RBParseTreeSearcher new.
			searcher 
				matches: each , ' := ``@object'
				do: [ :aNode :answer | answer isNil and: [ aNode value isLiteralNode ] ].
			tree := defClass parseTreeFor: selector.
			tree notNil ifTrue: 
				[ (searcher 
					executeTree: tree
					initialAnswer: nil) == true ifTrue: 
					[ result 
						addClass: aClass
						instanceVariable: each ] ] ] ]! !

!RBVariableAssignedLiteralRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'VariableAssignedLiteralRule'! !

!RBVariableEnvironment methodsFor: 'private' stamp: ''!
classVariables
	^classVariables! !

!RBVariableEnvironment methodsFor: 'accessing' stamp: ''!
instanceVariablesFor: aClass 
	| vars name |
	vars := Set new.
	name := aClass name.
	vars
		addAll: (instanceVariables at: name ifAbsent: [#()]);
		addAll: (instanceVariableReaders at: name ifAbsent: [#()]);
		addAll: (instanceVariableWriters at: name ifAbsent: [#()]).
	^vars! !

!RBVariableEnvironment methodsFor: 'private' stamp: 'lr 3/20/2011 11:18'!
classForName: aString 
	| name isMeta class |
	isMeta := aString includes: $ .
	name := (isMeta 
		ifTrue: [ aString copyFrom: 1 to: (aString size - 6 max: 1) ]
		ifFalse: [ aString ]) asSymbol.
	class := self systemDictionary at: name ifAbsent: [ nil ].
	^ (class notNil and: [ isMeta ])
		ifTrue: [ class class ]
		ifFalse: [ class ]! !

!RBVariableEnvironment methodsFor: 'testing' stamp: ''!
includesCategory: aCategory 
	^(self classNamesFor: aCategory) isEmpty not! !

!RBVariableEnvironment methodsFor: 'private' stamp: ''!
instanceVariableWriters
	^instanceVariableWriters! !

!RBVariableEnvironment methodsFor: 'private' stamp: ''!
instanceVariables
	^instanceVariables! !

!RBVariableEnvironment methodsFor: 'private' stamp: 'lr 11/25/2009 00:42'!
selectorCacheFor: aClass 
	^self selectorCache at: aClass name ifAbsentPut: [ self computeSelectorCacheFor: aClass ]! !

!RBVariableEnvironment methodsFor: 'private' stamp: 'lr 11/25/2009 08:32'!
classVariableSelectorsFor: aClass 
	| selectors classVars |
	selectors := Set new.
	classVars := Set new.
	classVariables keysDo: 
			[:each | 
			| cls |
			cls := self classForName: each.
			(cls notNil and: [aClass theNonMetaClass includesBehavior: cls]) 
				ifTrue: [classVars addAll: (classVariables at: each)]].
	classVars do: 
			[:each | 
			| binding |
			binding := aClass bindingOf: each.
			binding notNil 
				ifTrue: [selectors addAll: (aClass whichSelectorsReferTo: binding)]].
	^selectors! !

!RBVariableEnvironment methodsFor: 'accessing' stamp: ''!
addClass: aClass instanceVariableWriter: aString 
	(instanceVariableWriters at: aClass name ifAbsentPut: [Set new]) 
		add: aString.
	self flushCachesFor: aClass.
	self addSearchString: aString! !

!RBVariableEnvironment methodsFor: 'private' stamp: ''!
instanceVariableReaders: anObject
	instanceVariableReaders := anObject! !

!RBVariableEnvironment methodsFor: 'private' stamp: ''!
instanceVariableWriters: anObject
	instanceVariableWriters := anObject! !

!RBVariableEnvironment methodsFor: 'accessing' stamp: ''!
removeClass: aClass instanceVariableReader: aString 
	| vars |
	vars := instanceVariableReaders at: aClass name ifAbsent: [Set new].
	vars remove: aString ifAbsent: [].
	vars isEmpty 
		ifTrue: [instanceVariableReaders removeKey: aClass name ifAbsent: []].
	self flushCachesFor: aClass! !

!RBVariableEnvironment methodsFor: 'accessing' stamp: ''!
addClass: aClass instanceVariable: aString 
	(instanceVariables at: aClass name ifAbsentPut: [Set new]) add: aString.
	self flushCachesFor: aClass.
	self addSearchString: aString! !

!RBVariableEnvironment methodsFor: 'initialization' stamp: ''!
initialize
	super initialize.
	instanceVariables := Dictionary new.
	classVariables := Dictionary new.
	instanceVariableReaders := Dictionary new.
	instanceVariableWriters := Dictionary new! !

!RBVariableEnvironment methodsFor: '*GT-SpotterExtensions-Core-private' stamp: 'StefanReichhart 3/23/2015 13:11'!
withClassesFixedForNautilus
	instanceVariables ifEmpty: [ 
		classVariables keysAndValuesDo: [ :class :variables | 
			instanceVariables at: class ifAbsentPut: [ Set new ] ] ].
! !

!RBVariableEnvironment methodsFor: 'private' stamp: ''!
allClassesDo: aBlock 
	| classes instVarBlock |
	classes := Set new.
	instVarBlock := 
			[:each | 
			| class |
			class := self classForName: each.
			classes addAll: class withAllSubclasses].
	instanceVariables keysDo: instVarBlock.
	instanceVariableReaders keysDo: instVarBlock.
	instanceVariableWriters keysDo: instVarBlock.
	classVariables keysDo: 
			[:each | 
			| class |
			class := self classForName: each.
			class notNil 
				ifTrue: 
					[classes
						addAll: class withAllSubclasses;
						addAll: class class withAllSubclasses]].
	classes do: aBlock! !

!RBVariableEnvironment methodsFor: 'accessing' stamp: 'TommasoDalSasso 10/6/2013 01:37'!
environmentForInstanceVariable: aString in: aClass 
	| selectorEnvironment isReader isWriter |
	selectorEnvironment := RBSelectorEnvironment onEnvironment: self.
	selectorEnvironment addSearchString: aString.
	isReader := isWriter := false.
	((instanceVariables at: aClass name ifAbsent: [#()]) includes: aString) 
		ifTrue: 
			[isReader := true.
			isWriter := true].
	((instanceVariableWriters at: aClass name ifAbsent: [#()]) 
		includes: aString) ifTrue: [isWriter := true].
	((instanceVariableReaders at: aClass name ifAbsent: [#()]) 
		includes: aString) ifTrue: [isReader := true].
	aClass withAllSubAndSuperclassesDo:
			[:each | 
			isWriter 
				ifTrue: 
					[(each whichSelectorsAssign: aString) 
						do: [:sel | selectorEnvironment addClass: each selector: sel]].
			isReader 
				ifTrue: 
					[(each whichSelectorsRead: aString) 
						do: [:sel | selectorEnvironment addClass: each selector: sel]]].
	^selectorEnvironment! !

!RBVariableEnvironment methodsFor: 'private' stamp: 'lr 11/25/2009 00:40'!
flushCachesFor: aClass 
	selectorCache isNil ifTrue: [ ^ self] .
	aClass theNonMetaClass withAllSubclasses do: [ :each | 
		selectorCache
			removeKey: each ifAbsent: [];
			removeKey: each class ifAbsent: [] ]! !

!RBVariableEnvironment methodsFor: 'accessing' stamp: ''!
numberVariables
	^self accessorMethods inject: 0
		into: [:sum :each | sum + ((self perform: each) inject: 0 into: [:s :e | s + e size])]! !

!RBVariableEnvironment methodsFor: 'accessing' stamp: ''!
addClass: aClass classVariable: aSymbol 
	(classVariables at: aClass name ifAbsentPut: [Set new]) add: aSymbol.
	self flushCachesFor: aClass.
	self addSearchString: aSymbol! !

!RBVariableEnvironment methodsFor: 'accessing' stamp: ''!
removeClass: aClass instanceVariable: aString 
	| vars |
	vars := instanceVariables at: aClass name ifAbsent: [Set new].
	vars remove: aString ifAbsent: [].
	vars isEmpty 
		ifTrue: [instanceVariables removeKey: aClass name ifAbsent: []].
	self flushCachesFor: aClass! !

!RBVariableEnvironment methodsFor: 'testing' stamp: 'lr 2/9/2008 10:51'!
includesClass: aClass 
	(super includesClass: aClass) ifFalse: [^false].
	(instanceVariables includesKey: aClass name) ifTrue: [^true].
	(classVariables includesKey: aClass name) ifTrue: [^true].
	^((self selectorCacheFor: aClass) 
		detect: [:each | self includesSelector: each in: aClass]
		ifNone: [nil]) notNil! !

!RBVariableEnvironment methodsFor: 'private' stamp: ''!
instanceVariables: anObject
	instanceVariables := anObject! !

!RBVariableEnvironment methodsFor: 'accessing' stamp: ''!
removeClass: aClass classVariable: aSymbol 
	| vars |
	vars := classVariables at: aClass name ifAbsent: [Set new].
	vars remove: aSymbol ifAbsent: [].
	vars isEmpty ifTrue: [classVariables removeKey: aClass name ifAbsent: []].
	self flushCachesFor: aClass! !

!RBVariableEnvironment methodsFor: 'testing' stamp: 'TestRunner 1/3/2010 11:29'!
isEmpty
	^ self accessorMethods allSatisfy: [ :each | (self perform: each) isEmpty ]! !

!RBVariableEnvironment methodsFor: 'printing' stamp: 'lr 4/29/2010 19:06'!
storeOn: aStream 
	aStream
		nextPut: $(;
		nextPutAll: self class name;
		nextPutAll: ' new '.
	self accessorMethods do: [ :each | 
		aStream
			nextPutAll: each;
			nextPutAll: ': '.
		(self perform: each) storeOn: aStream.
		aStream nextPutAll: '; '].
	aStream nextPutAll: 'yourself)'! !

!RBVariableEnvironment methodsFor: 'accessing' stamp: ''!
addClass: aClass instanceVariableReader: aString 
	(instanceVariableReaders at: aClass name ifAbsentPut: [Set new]) 
		add: aString.
	self flushCachesFor: aClass.
	self addSearchString: aString! !

!RBVariableEnvironment methodsFor: 'testing' stamp: ''!
includesSelector: aSymbol in: aClass 
	^(environment includesSelector: aSymbol in: aClass) 
		and: [(self selectorCacheFor: aClass) includes: aSymbol]! !

!RBVariableEnvironment methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'!
environmentForClassVariable: aSymbol in: aClass 
	| selectorEnvironment assoc block |
	selectorEnvironment := RBSelectorEnvironment onEnvironment: self.
	selectorEnvironment addSearchString: aSymbol.
	((classVariables at: aClass name ifAbsent: [#()]) includes: aSymbol) 
		ifFalse: [^selectorEnvironment].
	assoc := aClass bindingOf: aSymbol.
	block := 
			[:each | 
			(each whichSelectorsReferTo: assoc) 
				do: [:sel | selectorEnvironment addClass: each selector: sel]].
	aClass withAllSubAndSuperclassesDo: 
			[:each | 
			block
				value: each;
				value: each class].
	^selectorEnvironment! !

!RBVariableEnvironment methodsFor: 'accessing' stamp: ''!
classNamesWithVariables
	| classNames |
	classNames := Set new.
	classNames
		addAll: instanceVariables keys;
		addAll: instanceVariableReaders keys;
		addAll: instanceVariableWriters keys;
		addAll: classVariables keys.
	^classNames! !

!RBVariableEnvironment methodsFor: 'private' stamp: ''!
selectorCache
	^selectorCache isNil 
		ifTrue: [selectorCache := Dictionary new]
		ifFalse: [selectorCache]! !

!RBVariableEnvironment methodsFor: 'private' stamp: ''!
accessorMethods
	^#(#instanceVariables #instanceVariableReaders #instanceVariableWriters #classVariables)! !

!RBVariableEnvironment methodsFor: 'testing' stamp: ''!
includesProtocol: aProtocol in: aClass 
	^(self selectorsFor: aProtocol in: aClass) isEmpty not! !

!RBVariableEnvironment methodsFor: 'private' stamp: ''!
instanceVariableReaders
	^instanceVariableReaders! !

!RBVariableEnvironment methodsFor: 'private' stamp: ''!
computeSelectorCacheFor: aClass 
	^(self instanceVariableSelectorsFor: aClass)
		addAll: (self classVariableSelectorsFor: aClass);
		yourself! !

!RBVariableEnvironment methodsFor: 'copying' stamp: ''!
postCopy
	super postCopy.
	instanceVariables := self copyDictionary: instanceVariables.
	instanceVariableReaders := self copyDictionary: instanceVariableReaders.
	instanceVariableWriters := self copyDictionary: instanceVariableWriters.
	classVariables := self copyDictionary: classVariables.
	selectorCache := nil! !

!RBVariableEnvironment methodsFor: 'accessing' stamp: ''!
problemCount
	^self numberVariables! !

!RBVariableEnvironment methodsFor: 'accessing' stamp: ''!
removeClass: aClass instanceVariableWriter: aString 
	| vars |
	vars := instanceVariableWriters at: aClass name ifAbsent: [Set new].
	vars remove: aString ifAbsent: [].
	vars isEmpty 
		ifTrue: [instanceVariableWriters removeKey: aClass name ifAbsent: []].
	self flushCachesFor: aClass! !

!RBVariableEnvironment methodsFor: 'private' stamp: 'TommasoDalSasso 10/6/2013 01:37'!
instanceVariableSelectorsFor: aClass 
	| selectors |
	selectors := Set new.
	#(#instanceVariables #instanceVariableReaders #instanceVariableWriters) 
		with: #(#whichSelectorsAccess: #whichSelectorsRead: #whichSelectorsAssign:)
		do: [:var :sel | 
			| instVars |
			instVars := Set new.
			(self perform: var) keysDo: 
					[:each | 
					| cls |
					cls := self classForName: each.
					(cls notNil and: [aClass includesBehavior: cls]) 
						ifTrue: [instVars addAll: ((self perform: var) at: each)]].
			instVars do: [:each | selectors addAll: (aClass perform: sel with: each)]].
	^selectors! !

!RBVariableEnvironment methodsFor: 'private' stamp: ''!
classVariables: anObject
	classVariables := anObject! !

!RBVariableEnvironment methodsFor: '*manifest-core' stamp: 'YuriyTymchuk 10/10/2014 19:31'!
smallLintCritics
	^ self classes! !

!RBVariableEnvironment methodsFor: 'accessing' stamp: ''!
classVariablesFor: aClass 
	^classVariables at: aClass name ifAbsent: [#()]! !

!RBVariableEnvironment methodsFor: 'copying' stamp: ''!
copyDictionary: aDictionary 
	| copy |
	copy := Dictionary new: aDictionary size.
	aDictionary keysAndValuesDo: [:key :value | copy at: key put: value].
	^copy! !

!RBVariableEnvironment methodsFor: 'testing' stamp: 'lr 1/3/2010 11:11'!
isVariableEnvironment
	^ true! !

!RBVariableEnvironment class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/2/2013 23:31'!
referencesToClassVariable: aSymbol in: aClass 
	^ self 
		on: self default
		referencesToClassVariable: aSymbol 
		in: aClass ! !

!RBVariableEnvironment class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/2/2013 23:32'!
referencesToInstanceVariable: aString in: aClass 
	^ self
		on: self default 
		referencesToInstanceVariable: aString 
		in: aClass ! !

!RBVariableEnvironment class methodsFor: 'instance creation' stamp: 'md 1/17/2006 14:17'!
on: anEnvironment referencesToClassVariable: aSymbol in: aClass 
	| newEnv definingClass assoc |
	newEnv := (self onEnvironment: anEnvironment)
				label: 'References to ''' , aSymbol , ''' in ' , aClass name;
				yourself.
	definingClass := aClass whichClassDefinesClassVar: aSymbol.
	assoc := definingClass bindingOf: aSymbol.
	definingClass withAllSubclassesDo: 
			[:cls | 
			(cls whichSelectorsReferTo: assoc) isEmpty 
				ifFalse: [newEnv addClass: cls classVariable: aSymbol]].
	^newEnv! !

!RBVariableEnvironment class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/2/2013 23:33'!
readersOfInstanceVariable: aString in: aClass 
	^ self
		on: self default
		readersOfInstanceVariable: aString
		in: aClass! !

!RBVariableEnvironment class methodsFor: 'instance creation' stamp: 'nk 3/4/2005 13:17'!
on: anEnvironment writersOfInstanceVariable: aString in: aClass 
	| newEnv |
	newEnv := (self onEnvironment: anEnvironment)
				label: 'Writers of ''' , aString , ''' in ' , aClass name;
				yourself.
	(aClass whichClassDefinesInstVar: aString) withAllSubclassesDo: 
			[:cls | 
			(cls whichSelectorsAssign: aString) isEmpty
				ifFalse: [newEnv addClass: cls instanceVariableWriter: aString]].
	^newEnv! !

!RBVariableEnvironment class methodsFor: 'instance creation' stamp: 'TommasoDalSasso 10/6/2013 01:38'!
on: anEnvironment referencesToInstanceVariable: aString in: aClass 
	| newEnv |
	newEnv := (self onEnvironment: anEnvironment)
				label: 'References to ''' , aString , ''' in ' , aClass name;
				yourself.
	(aClass whichClassDefinesInstVar: aString) withAllSubclassesDo: 
			[:cls | 
			((cls whichSelectorsRead: aString) isEmpty not 
				or: [(cls whichSelectorsAssign: aString) isEmpty not]) 
					ifTrue: [newEnv addClass: cls instanceVariable: aString]].
	^newEnv! !

!RBVariableEnvironment class methodsFor: 'instance creation' stamp: 'CamilloBruni 7/2/2013 23:32'!
writersOfInstanceVariable: aString in: aClass 
	^ self
		on: self default
		writersOfInstanceVariable: aString 
		in: aClass ! !

!RBVariableEnvironment class methodsFor: 'instance creation' stamp: 'TommasoDalSasso 10/6/2013 01:37'!
on: anEnvironment readersOfInstanceVariable: aString in: aClass 
	| newEnv |
	newEnv := (self onEnvironment: anEnvironment)
				label: 'Readers of ''' , aString , ''' in ' , aClass name;
				yourself.
	(aClass whichClassDefinesInstVar: aString) withAllSubclassesDo: 
			[:cls | 
			(cls whichSelectorsRead: aString) isEmpty
				ifFalse: [newEnv addClass: cls instanceVariableReader: aString]].
	^newEnv! !

!RBVariableNode commentStamp: '<historical>'!
RBVariableNode is an AST node that represent a variable (global, inst var, temp, etc.).

Instance Variables:
	name	<RBValueToken>	the variable's name I represent
	nameStart <Integer>	the position where I was found at the source code
!
!RBVariableNode methodsFor: 'accessing' stamp: 'PabloHerrero 1/5/2015 10:38'!
stopWithoutParentheses
	^ start + name size - 1.! !

!RBVariableNode methodsFor: '*SmartSuggestions' stamp: 'GiselaDecuzzi 5/22/2013 15:38'!
specialCommands
	^self binding specialCommands! !

!RBVariableNode methodsFor: '*opalcompiler-core' stamp: 'ClementBera 8/5/2013 11:07'!
isSpecialVariable
	^ self binding isSpecialVariable! !

!RBVariableNode methodsFor: '*opalcompiler-core' stamp: 'MarcusDenker 5/22/2013 16:50'!
isInstance
	^self binding isInstance! !

!RBVariableNode methodsFor: 'testing' stamp: 'GiselaDecuzzi 6/5/2013 10:30'!
isFaulty
	^false! !

!RBVariableNode methodsFor: '*opalcompiler-core' stamp: 'jorgeRessia 11/20/2009 16:40'!
isGlobal
	^self binding isGlobal! !

!RBVariableNode methodsFor: '*opalcompiler-core' stamp: 'MarcusDenker 5/22/2013 16:51'!
binding: aSemVar
	aSemVar ifNil: [^self removeProperty: #binding ifAbsent: []].
	self propertyAt: #binding put: aSemVar.! !

!RBVariableNode methodsFor: 'testing' stamp: ''!
isImmediateNode
	^true! !

!RBVariableNode methodsFor: 'replacing' stamp: ''!
replaceSourceWith: aNode
	self addReplacement: (RBStringReplacement 
				replaceFrom: self start
				to: self stop
				with: aNode formattedCode)! !

!RBVariableNode methodsFor: 'testing' stamp: 'TestRunner 11/2/2009 21:18'!
isRead
	^ self isWrite not and: [ self isUsed ]! !

!RBVariableNode methodsFor: '*opalcompiler-core' stamp: 'ClementBera 8/5/2013 11:03'!
isClean
	^ (self isInstance | self isSpecialVariable) not! !

!RBVariableNode methodsFor: '*opalcompiler-core' stamp: 'MarcusDenker 6/14/2013 15:44'!
isUndeclared

	^self binding isUndeclared! !

!RBVariableNode methodsFor: 'accessing' stamp: 'PabloHerrero 2/10/2015 19:03'!
start
	^ start! !

!RBVariableNode methodsFor: '*opalcompiler-core' stamp: 'MarcusDenker 5/22/2013 16:50'!
isTemp
	^self binding isTemp! !

!RBVariableNode methodsFor: 'accessing' stamp: 'PabloHerrero 2/10/2015 19:03'!
start: aPosition
	start := aPosition! !

!RBVariableNode methodsFor: 'testing' stamp: ''!
references: aVariableName 
	^self name = aVariableName! !

!RBVariableNode methodsFor: 'replacing' stamp: ''!
replaceSourceFrom: aNode 
	self addReplacement: (RBStringReplacement 
				replaceFrom: aNode start
				to: aNode stop
				with: self name)! !

!RBVariableNode methodsFor: 'testing' stamp: ''!
isVariable
	^true! !

!RBVariableNode methodsFor: 'testing' stamp: 'TestRunner 11/2/2009 21:21'!
isWrite
	^ self parent notNil and: [ self parent isAssignment and: [ self parent variable == self ] ]! !

!RBVariableNode methodsFor: 'comparing' stamp: ''!
hash
	^self name hash! !

!RBVariableNode methodsFor: 'matching' stamp: 'PabloHerrero 10/23/2013 14:41'!
copyInContext: aDictionary 
	^ self class named: name.! !

!RBVariableNode methodsFor: '*opalcompiler-core' stamp: 'MarcusDenker 5/22/2013 16:50'!
isArg

	^self binding isArg! !

!RBVariableNode methodsFor: 'accessing' stamp: ''!
precedence
	^0! !

!RBVariableNode methodsFor: 'accessing' stamp: 'PabloHerrero 1/5/2015 10:38'!
startWithoutParentheses
	^ start! !

!RBVariableNode methodsFor: 'comparing' stamp: ''!
equalTo: anObject withMapping: aDictionary 
	^self class = anObject class and: 
			[(aDictionary at: self name ifAbsentPut: [anObject name]) = anObject name]! !

!RBVariableNode methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:39'!
acceptVisitor: aProgramNodeVisitor 
	^aProgramNodeVisitor visitVariableNode: self! !

!RBVariableNode methodsFor: '*opalcompiler-core' stamp: 'MarcusDenker 5/22/2013 16:50'!
binding
	^self propertyAt: #binding ifAbsent: [nil].! !

!RBVariableNode methodsFor: 'comparing' stamp: 'CamilloBruni 12/15/2011 15:17'!
= anObject 
	self == anObject ifTrue: [^true].
	((anObject isKindOf: self class) or: [self isKindOf: anObject class]) 
		ifFalse: [^false].
	^self name = anObject name! !

!RBVariableNode methodsFor: 'accessing' stamp: 'PabloHerrero 10/23/2013 14:12'!
name: aName
	name := aName asSymbol.! !

!RBVariableNode methodsFor: 'initialize-release' stamp: 'PabloHerrero 1/5/2015 10:38'!
named: aName start: aPosition

	self name: aName.
	self start: aPosition.! !

!RBVariableNode methodsFor: 'testing' stamp: ''!
needsParenthesis
	^false! !

!RBVariableNode methodsFor: 'accessing' stamp: 'PabloHerrero 10/23/2013 14:12'!
name
	^ name! !

!RBVariableNode class methodsFor: 'instance creation' stamp: 'PabloHerrero 10/23/2013 14:28'!
named: aName
	^self named: aName start: 0.! !

!RBVariableNode class methodsFor: 'instance creation' stamp: 'PabloHerrero 10/23/2013 15:52'!
identifierNamed: anIdentifierName at: aPosition
	
	anIdentifierName = 'self'
		ifTrue: [ ^ RBSelfNode named: anIdentifierName start: aPosition ].
	anIdentifierName = 'thisContext'
		ifTrue: [ ^ RBThisContextNode named: anIdentifierName start: aPosition ].
	anIdentifierName = 'super'
		ifTrue: [ ^ RBSuperNode named: anIdentifierName start: aPosition ].
	^ self named: anIdentifierName start: aPosition.! !

!RBVariableNode class methodsFor: 'instance creation' stamp: 'PabloHerrero 10/23/2013 14:11'!
named: aName start: aPosition
	^self new 
		named: aName start: aPosition; 
		yourself.! !

!RBVariableNotDefinedRule commentStamp: 'StephaneDucasse 11/29/2014 20:12'!
This check is similar to the "References an undeclared variable" check, but it looks for variables that are not defined in the class or in the undeclared dictionary. You probably had to work hard to get your code in this state.!
!RBVariableNotDefinedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Bugs'! !

!RBVariableNotDefinedRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:04'!
severity
	^ #error! !

!RBVariableNotDefinedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Variable used, but not defined anywhere'! !

!RBVariableNotDefinedRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:11'!
checkMethod: aMethod
	aMethod literals allButLastDo: [ :literal | 
			(literal isVariableBinding and: [ literal key notNil ])
				ifTrue: [ 
					((Smalltalk globals associationAt: literal key ifAbsent: [  ]) == literal
						or: [ (Undeclared associationAt: literal key ifAbsent: [  ]) == literal ])
						ifFalse: [ 
							(aMethod methodClass bindingOf: literal key) == literal
								ifFalse: [ 
									result
										addMethod: aMethod;
										addSearchString: literal key ] ] ] ]! !

!RBVariableNotDefinedRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 13:49'!
category
	^ 'Bugs'! !

!RBVariableNotDefinedRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'VariableNotDefinedRule'! !

!RBVariableRefactoring methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	aStream nextPut: $(.
	self class storeOn: aStream.
	aStream nextPutAll: ' variable: '.
	variableName storeOn: aStream.
	aStream nextPutAll: ' class: '.
	class storeOn: aStream.
	aStream nextPut: $)! !

!RBVariableRefactoring methodsFor: 'initialize-release' stamp: ''!
variable: aVarName class: aClass 
	class := self classObjectFor: aClass.
	variableName := aVarName! !

!RBVariableRefactoring class methodsFor: 'instance creation' stamp: ''!
model: aRBSmalltalk variable: aVarName class: aClass 
	^(self new)
		model: aRBSmalltalk;
		variable: aVarName class: aClass;
		yourself! !

!RBVariableRefactoring class methodsFor: 'instance creation' stamp: ''!
variable: aVarName class: aClass
	^self new variable: aVarName class: aClass! !

!RBVariableReferencedOnceRule commentStamp: 'StephaneDucasse 11/29/2014 19:33'!
Checks for instance variables that might better be defined as temporary variables. If an instance variable is only used in one method and it is always assigned before it is used, then that method could define that variable as a temporary variable of the method instead (assuming that the method is not recursive).!
!RBVariableReferencedOnceRule methodsFor: 'accessing' stamp: 'StephaneDucasse 11/29/2014 19:33'!
rationale
	^ 'Checks for instance variables that might better be defined as temporary variables.'! !

!RBVariableReferencedOnceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Unnecessary code'! !

!RBVariableReferencedOnceRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:10'!
severity
	^ #information! !

!RBVariableReferencedOnceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Variable referenced in only one method and always assigned first'! !

!RBVariableReferencedOnceRule methodsFor: 'accessing' stamp: 'SimonAllier 9/6/2012 13:49'!
category 
	^ 'Design Flaws'! !

!RBVariableReferencedOnceRule methodsFor: 'running' stamp: 'YuriyTymchuk 9/26/2014 17:50'!
checkClass: aClass 
	| allSubclasses |
	allSubclasses := aClass withAllSubclasses.
	aClass instVarNames do: 
		[ :each | 
		| defClass selector |
		(allSubclasses 
			inject: 0
			into: 
				[ :sum :class | 
				| sels |
				sels := class whichSelectorsAccess: each.
				sels size == 1 ifTrue: 
					[ selector := sels asArray first.
					defClass := class ].
				sum + sels size ]) == 1 ifTrue: 
			[ | tree |
			tree := defClass parseTreeFor: selector.
			tree notNil ifTrue: 
				[ (RBReadBeforeWrittenTester 
					isVariable: each
					writtenBeforeReadIn: tree) ifTrue: 
					[ result 
						addClass: defClass
						selector: selector.
					result addSearchString: each ] ] ] ]! !

!RBVariableReferencedOnceRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'VariableReferencedOnceRule'! !

!RBVariableTypeTest methodsFor: 'tests' stamp: 'lr 10/5/2010 16:14'!
testCompositeLintRuleTypes
	| typer types |
	typer := RBRefactoryTyper new runOn: RBCompositeLintRuleTest.
	types := typer guessTypesFor: 'rules'.
	self assert: (types includes: (typer model classFor: Collection)).
	types := typer typesFor: '-rules-'.
	self assert: (types includes: (typer model classFor: RBLintRuleTest)).
	self assert: (typer guessTypesFor: 'asdf') isEmpty.
	typer printString! !

!RBVariableTypeTest methodsFor: 'tests' stamp: 'lr 10/5/2010 16:14'!
testParseTreeTypes
	| types model |
	model := RBNamespace new.
	types := RBRefactoryTyper 
				typesFor: 'foo'
				in: (RBParser 
						parseExpression: 'foo printString; testBasicLintRuleTypes; testParseTreeTypes')
				model: model.
	self assert: types size = 1.
	self assert: (types includes: (model classFor: self class))! !

!RBVariableTypeTest methodsFor: 'tests' stamp: 'lr 10/5/2010 16:14'!
testBasicLintRuleTypes
	| typer types |
	typer := RBRefactoryTyper new.
	types := typer 
		guessTypesFor: 'classBlock'
		in: RBBasicLintRuleTest.
	"self assert: types size = 1."
	self assert: ([  ] class withAllSuperclasses 
			detect: [ :each | types includes: (typer model classFor: each) ]
			ifNone: [ nil ]) notNil.
	types := typer 
		typesFor: 'methodBlock'
		in: (typer model classFor: RBBasicLintRuleTest).
	"self should: [types size = 2]."
	self assert: ([  ] class withAllSuperclasses 
			detect: [ :each | types includes: (typer model classFor: each) ]
			ifNone: [ nil ]) notNil.
	"self should: [types includes: MessageChannel]."
	typer printString! !

!RBVariableTypeTest methodsFor: 'tests' stamp: 'lr 10/5/2010 16:14'!
testLintRuleTypes
	| typer types |
	typer := RBRefactoryTyper new.
	types := typer 
		guessTypesFor: 'name'
		in: RBLintRuleTest.
	self assert: types size = 1.
	self assert: (types includes: (typer model classFor: String))! !

!RBWhileTrueRule commentStamp: 'StephaneDucasse 11/29/2014 22:29'!
Checks for users of whileTrue: when the shorter to:do: would work.

For example
 
statements1. 
[index <= stop] 
	whileTrue: 
	[ 
	blockStmts1. 
	index := index + 1].
statements2!
!RBWhileTrueRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:53'!
initialize
	super initialize.
	self matcher 
		matchesAnyOf: #(
			'| `@temps | 
			`@.Statements1. 
			[`index <= `@stop] 
				whileTrue: 
					[| `@blockTemps | 
					`@.BlockStmts1. 
					`index := `index + 1].
			`@.Statements2'
			'| `@temps | 
			`@.Statements1. 
			[`index < `@stop] 
				whileTrue: 
					[| `@blockTemps | 
					`@.BlockStmts1. 
					`index := `index + 1].
			`@.Statements2'
			'| `@temps | 
			`@.Statements1. 
			[`index >= `@stop] 
				whileTrue: 
					[| `@blockTemps | 
					`@.BlockStmts1. 
					`index := `index - 1].
			`@.Statements2'
			'| `@temps | 
			`@.Statements1. 
			[`index > `@stop] 
				whileTrue: 
					[| `@blockTemps | 
					`@.BlockStmts1. 
					`index := `index - 1].
			`@.Statements2' )
		do: [ :node :answer | node ]! !

!RBWhileTrueRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 17:39'!
rationale
	^ 'Checks for users of whileTrue: when the shorter to:do: would work.'! !

!RBWhileTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Intention revealing'! !

!RBWhileTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Uses whileTrue: instead of to:do:'! !

!RBWhileTrueRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:36'!
category 
	^ 'Coding Idiom Violation'! !

!RBWhileTrueRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'WhileTrueRule'! !

!RBYourselfNotUsedRule commentStamp: 'StephaneDucasse 11/29/2014 21:21'!
Check for methods sending the yourself message when it is not necessary.!
!RBYourselfNotUsedRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:54'!
initialize
	super initialize.
	self matcher 
		matches: '`{:node | node parent isUsed not} yourself'
		do: [ :node :answer | node ]! !

!RBYourselfNotUsedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
rationale
	^ 'Check for methods sending the yourself message when it is not necessary.'! !

!RBYourselfNotUsedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
group
	^ 'Miscellaneous'! !

!RBYourselfNotUsedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'!
name
	^ 'Doesn''t use the result of a yourself message'! !

!RBYourselfNotUsedRule methodsFor: 'accessing' stamp: 'SimonAllier 9/7/2012 10:36'!
category 
	^ 'Optimization'! !

!RBYourselfNotUsedRule class methodsFor: 'accessing' stamp: 'SimonAllier 4/13/2012 16:58'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'YourselfNotUsedRule'! !

!RBkeysDoRule commentStamp: 'StephaneDucasse 11/29/2014 19:32'!
Replaces keys/values do: by keysDo: and valuesDo:.  This rule is based on the observation that using aDict keys do: or aDict values do: create an intermediary collection. 

Dictionary>>keys
	"Answer an Array containing the receiver's keys."
	
	^Array new: self size streamContents: [:s| self keysDo: [:key| s nextPut: key]]
	
This array can be quite large and using the keysDo: does not create such intermediate collection.!
!RBkeysDoRule methodsFor: 'initialization' stamp: 'MarcusDenker 10/5/2013 20:02'!
initialize
	super initialize.
	self rewriteRule
		replace: '``@object keys do: ``@block' with: '``@object keysDo: ``@block';
		replace: '``@object values do: ``@block' with: '``@object valuesDo: ``@block'
! !

!RBkeysDoRule methodsFor: 'accessing' stamp: 'MarcusDenker 10/5/2013 20:02'!
rationale
	^ 'The use of keysDo:/valuesDo: means one intermediate collection created less'! !

!RBkeysDoRule methodsFor: 'accessing' stamp: 'MarcusDenker 10/5/2013 19:44'!
group
	^ 'Transformations'! !

!RBkeysDoRule methodsFor: 'accessing' stamp: 'MarcusDenker 10/5/2013 20:02'!
name
	^ 'keys do: -> keysDo: and valuesDo:'! !

!RBkeysDoRule methodsFor: 'accessing' stamp: 'MarcusDenker 10/5/2013 19:55'!
category 
	^'Optimization'! !

!RBkeysDoRule class methodsFor: 'accessing' stamp: 'MarcusDenker 10/5/2013 19:44'!
uniqueIdentifierName
	"This number should be unique and should change only when the rule completely change semantics"
	
	^'EqualNilRule'! !

!RFC2047MimeConverter commentStamp: '<historical>'!
I do quoted printable MIME decoding as specified in RFC 2047 ""MIME Part Three: Message Header Extensions for Non-ASCII Text". See String>>decodeMimeHeader!
!RFC2047MimeConverter methodsFor: 'private-encoding' stamp: 'bf 3/11/2000 23:16'!
encodeChar: aChar to: aStream

	aChar = Character space
		ifTrue: [^ aStream nextPut: $_].
	((aChar asciiValue between: 32 and: 127) and: [('?=_' includes: aChar) not])
		ifTrue: [^ aStream nextPut: aChar].
	aStream nextPut: $=;
		nextPut: (Character digitValue: aChar asciiValue // 16);
		nextPut: (Character digitValue: aChar asciiValue \\ 16)
! !

!RFC2047MimeConverter methodsFor: 'private-encoding' stamp: 'PeterHugossonMiller 9/3/2009 11:08'!
readWord

	| strm |
	strm := (String new: 20) writeStream.
	dataStream skipSeparators.
	[dataStream atEnd] whileFalse: 
		[ | c |
		c := dataStream next.
		strm nextPut: c.
		c isSeparator ifTrue: [^ strm contents]].
	^ strm contents! !

!RFC2047MimeConverter methodsFor: 'private-encoding' stamp: 'bf 3/12/2000 14:36'!
isStructuredField: aString

	| fName |
	fName := aString copyUpTo: $:.
	('Resent' sameAs: (fName copyUpTo: $-))
		ifTrue: [fName := fName copyFrom: 8 to: fName size].
	^#('Sender' 'From' 'Reply-To' 'To' 'cc' 'bcc') anySatisfy: [:each | fName sameAs: each]! !

!RFC2047MimeConverter methodsFor: 'conversion' stamp: 'bf 3/10/2000 16:06'!
mimeEncode
	"Do conversion reading from dataStream writing to mimeStream. Break long lines and escape non-7bit chars."

	| word pos wasGood isGood max |
	true ifTrue: [mimeStream nextPutAll: dataStream upToEnd].
	pos := 0.
	max := 72.
	wasGood := true.
	[dataStream atEnd] whileFalse: [
		word := self readWord.
		isGood := word allSatisfy: [:c | c asciiValue < 128].
		wasGood & isGood ifTrue: [
			pos + word size < max
				ifTrue: [dataStream nextPutAll: word.
					pos := pos + word size]
				ifFalse: []
		]
	].
	^ mimeStream! !

!RFC2047MimeConverter methodsFor: 'conversion' stamp: 'sd 3/20/2008 22:23'!
mimeDecode
	"Do conversion reading from mimeStream writing to dataStream. See String>>decodeMimeHeader"

	| c |
	[mimeStream atEnd] whileFalse: [
		c := mimeStream next.
		c = $=
			ifTrue: [c := Character value: mimeStream next digitValue * 16
				+ mimeStream next digitValue]
			ifFalse: [c = $_ ifTrue: [c := $ ]].
		dataStream nextPut: c].
	^ dataStream! !

!RFC2047MimeConverter methodsFor: 'private-encoding' stamp: 'bf 3/11/2000 23:13'!
encodeWord: aString

	(aString allSatisfy: [:c | c asciiValue < 128])
		ifTrue: [^ aString].
	^ String streamContents: [:stream |
		stream nextPutAll: '=?iso-8859-1?Q?'.
		aString do: [:c | self encodeChar: c to: stream].
		stream nextPutAll: '?=']! !

!RFMetaContext commentStamp: 'MarcusDenker 3/11/2015 08:44'!
I model the meta level when activating a MetaLink.!
!RFMetaContext methodsFor: 'testing' stamp: 'ClaraAllende 6/26/2014 16:54'!
isMeta
	^level > 0! !

!RFMetaContext methodsFor: 'initialization' stamp: 'ClaraAllende 6/27/2014 17:21'!
initialize
 level := 0! !

!RFMetaContext methodsFor: 'level' stamp: 'ClaraAllende 7/21/2014 13:50'!
shiftLevelUp
	level := level +1.! !

!RFMetaContext methodsFor: 'level' stamp: 'ClaraAllende 7/21/2014 13:50'!
shiftLevelDown
	level := (level - 1) max: 0.
	self assert: level >=0! !

!RFMetaContext methodsFor: 'testing' stamp: 'ClaraAllende 7/7/2014 15:52'!
isActive: n
	^level = n! !

!RFMetaContext class methodsFor: 'reset' stamp: 'ClaraAllende 6/27/2014 16:42'!
reset
	ActiveMetaContext value: self new.! !

!RFMetaContext class methodsFor: 'accessing' stamp: 'ClaraAllende 6/30/2014 11:35'!
current 
	ActiveMetaContext value ifNil:[ActiveMetaContext value: self new].
	^ActiveMetaContext value
! !

!RGAbstractContainer commentStamp: 'VeronicaUquillas 5/12/2011 10:59'!
This is the abstract class for container-based elements.
Elements are separated in groups by kind (e.g classes, methods, pools, etc.)
Subclasses have to define the kind of collection for a particular group of entities.
For a container the use of a dictionary or another collection (e.g. SortedCollection) to store group of elements is independent.

!
!RGAbstractContainer methodsFor: 'lookup elements' stamp: 'VeronicaUquillas 4/14/2011 14:41'!
elementNamed: elementName in: aCollection
	| aSymbol |
	
	aSymbol:= elementName asSymbol.
	^aCollection isDictionary
		ifTrue: [ aCollection at: aSymbol ifAbsent: [ nil ] ]
		ifFalse:[ aCollection detect:[ :each| each fullName = aSymbol ] ifNone:[ nil ] ]! !

!RGAbstractContainer methodsFor: 'managing elements groups' stamp: 'VeronicaUquillas 4/15/2011 09:47'!
elementsCategorized: aSymbol with: aCollection
	"Allows to define other groups of elements with a particular kind of collection"
	
	elements at: aSymbol put: aCollection! !

!RGAbstractContainer methodsFor: 'adding/removing' stamp: 'VeronicaUquillas 4/14/2011 12:17'!
addElement: anObject

	anObject addInContainer: self! !

!RGAbstractContainer methodsFor: 'managing elements groups' stamp: 'VeronicaUquillas 4/15/2011 14:34'!
elementsCategorized: aSymbol
	"Retrieves a group of elements.
	If does not exist set an Set"
	
	^elements at: aSymbol ifAbsentPut:[ Set ]! !

!RGAbstractContainer methodsFor: 'managing elements groups' stamp: 'VeronicaUquillas 4/15/2011 09:48'!
removeElementsCategorized: aSymbol
	"Deletes a group of elements"
	
	elements removeKey: aSymbol ifAbsent:[ ]! !

!RGAbstractContainer methodsFor: 'initialization' stamp: 'VeronicaUquillas 4/14/2011 10:20'!
initialize

	super initialize.
	elements:= IdentityDictionary new.! !

!RGAbstractContainer methodsFor: 'lookup elements' stamp: 'VeronicaUquillas 4/13/2011 16:07'!
elementNamed: elementName
	| aSymbol found |
	
	aSymbol:= elementName asSymbol.
	elements do:[ :collection| 		
		(found:= self elementNamed: aSymbol in: collection) notNil ifTrue:[ ^found ] ].
	^nil! !

!RGAbstractContainer methodsFor: 'adding/removing' stamp: 'VeronicaUquillas 4/14/2011 20:08'!
addElement: anObject in: aCollection

	aCollection isDictionary
		ifTrue: [ aCollection at: anObject fullName put: anObject ]
		ifFalse:[ aCollection add: anObject ]! !

!RGAbstractContainer methodsFor: 'accessing' stamp: 'VeronicaUquillas 4/14/2011 10:21'!
elements
	"Retrieves the elements"
	
	^elements! !

!RGAbstractContainer methodsFor: 'iterating elements' stamp: 'MarcusDenker 10/7/2013 13:01'!
elementsDo: aBlock
	elements valuesDo: [ :collection | collection do: [ :each | aBlock value: each ] ]! !

!RGAbstractContainer methodsFor: 'testing' stamp: 'MarcusDenker 10/31/2014 14:41'!
includesElementNamed: elementName

	^ elements anySatisfy: [ :collection | self includesElementNamed: elementName asSymbol in: collection ]! !

!RGAbstractContainer methodsFor: 'testing' stamp: 'VeronicaUquillas 7/29/2011 10:51'!
includesElement: anRGDefinition

	^anRGDefinition isIncludedInContainer: self! !

!RGAbstractContainer methodsFor: 'testing' stamp: 'MarcusDenker 10/31/2014 14:42'!
includesElementNamed: elementName in: aCollection

	^aCollection isDictionary
		ifTrue: [ aCollection includesKey:  elementName asSymbol ]
		ifFalse:[ aCollection anySatisfy: [ :each| each name = elementName asSymbol ] ]! !

!RGAbstractContainer methodsFor: 'adding/removing' stamp: 'VeronicaUquillas 4/14/2011 12:25'!
removeElement: anObject from: aCollection

	aCollection isDictionary
		ifTrue: [ aCollection removeKey: anObject fullName ifAbsent:[ ] ]
		ifFalse:[ aCollection remove: anObject ifAbsent:[ ] ]! !

!RGAbstractContainer methodsFor: 'initialize-release' stamp: 'VeronicaUquillas 4/15/2011 09:43'!
flushElements

	elements:= IdentityDictionary new! !

!RGAbstractContainer methodsFor: 'adding/removing' stamp: 'VeronicaUquillas 4/14/2011 12:17'!
removeElement: anObject

	anObject removeFromContainer: self! !

!RGBehaviorDefinition commentStamp: 'VeronicaUquillas 5/9/2011 14:30'!
An RGBehaviorDefinition is an abstract definition for class-alike entities (e.g. classes, traits)

Instance Variables
	methods:		<Collection>
	protocols:		<Collection>
	superclass:		<Object>!
!RGBehaviorDefinition methodsFor: 'annotations' stamp: 'VeronicaUquillas 6/28/2011 15:22'!
superclassName
	"Retrieves the name of the superclass if exists"

	^self annotationNamed: self class superclassNameKey! !

!RGBehaviorDefinition methodsFor: 'adding/removing protocols' stamp: 'VeronicaUquillas 5/13/2011 23:42'!
addProtocol: anObject
	"Adds a protocol named anObject.
	Protocols are not repeated"
	
	anObject ifNil:[ ^self ].
	protocols add: anObject! !

!RGBehaviorDefinition methodsFor: 'accessing methods' stamp: 'VeronicaUquillas 3/21/2011 17:14'!
allSelectors
	"Retrieves all the selectos of the receiver in the chain hierarchy"
	| class selectors |
	
	class:= self.
	selectors := Set new.
	[class notNil] whileTrue: 
			[selectors addAll: class selectors.
			class := class superclass ].
	^selectors! !

!RGBehaviorDefinition methodsFor: 'testing class hierarchy' stamp: 'DamienCassou 4/29/2013 15:25'!
includesBehavior: aClass
	^self == aClass or: [self inheritsFrom: aClass]! !

!RGBehaviorDefinition methodsFor: 'compatibility' stamp: 'VeronicaUquillas 4/14/2011 11:13'!
soleInstance
	"to be depracated in the future"
	
	^self theNonMetaClass! !

!RGBehaviorDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 9/19/2011 14:01'!
traits
	"Retrieves ring traits based on the names in the traitComposition and from the environment if it is a ring object"
	
	^ self environment isRingObject 	
		ifTrue: [ self traitNames collect:[ :each| self environment traitNamed: each ] ]
		ifFalse:[ #() ]! !

!RGBehaviorDefinition methodsFor: 'tools' stamp: 'BenjaminVanRyseghem 2/8/2012 17:10'!
browse

	^ Smalltalk tools browser
		fullOnClass: self realClass selector: nil! !

!RGBehaviorDefinition methodsFor: 'managing container' stamp: 'VeronicaUquillas 5/9/2011 14:34'!
removeFromContainer: aRGContainer

	aRGContainer removeClass: self! !

!RGBehaviorDefinition methodsFor: 'initialization' stamp: 'VeronicaUquillas 5/12/2011 10:33'!
initialize

	super initialize.
	methods:= IdentityDictionary new.
	protocols:= Set new.! !

!RGBehaviorDefinition methodsFor: 'accessing' stamp: ''!
theNonMetaClass

	self subclassResponsibility! !

!RGBehaviorDefinition methodsFor: 'accessing' stamp: ''!
package
	
	self subclassResponsibility! !

!RGBehaviorDefinition methodsFor: 'accessing class hierarchy' stamp: 'VeronicaUquillas 3/19/2011 16:22'!
withAllSubclasses
	"if allSubclasses is stored should not affect the collection"

	^self allSubclasses, {self}! !

!RGBehaviorDefinition methodsFor: 'annotations' stamp: 'VeronicaUquillas 6/28/2011 15:23'!
traitCompositionSource: anString
	"Stores aString representing the traits used by the receiver "

	self annotationNamed: self class traitCompositionSourceKey
		put: anString ! !

!RGBehaviorDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 3/21/2011 17:03'!
hasProtocols
	"Validates the existance of protocols"

	^protocols notEmpty! !

!RGBehaviorDefinition methodsFor: 'adding/removing methods' stamp: 'VeronicaUquillas 4/29/2011 13:58'!
removeMethod: aRGMethodDefinition
	"Removes aRGMethodDefinition from the methods dictionary"

	self removeMethod: aRGMethodDefinition from: methods! !

!RGBehaviorDefinition methodsFor: 'managing container' stamp: 'VeronicaUquillas 5/9/2011 14:34'!
addInContainer: aRGContainer

	aRGContainer addClass: self! !

!RGBehaviorDefinition methodsFor: 'adding/removing methods' stamp: 'VeronicaUquillas 4/29/2011 13:59'!
removeSelector: selector
	"Removes a method named as selector"

	methods removeKey: selector ifAbsent:[]! !

!RGBehaviorDefinition methodsFor: 'subclassing' stamp: 'VeronicaUquillas 9/16/2011 16:49'!
addSubclass: aRGBehaviorDefinition
	"Adds a direct subclass of the receiver"

	(self subclasses includes: aRGBehaviorDefinition)
		ifFalse:[ self subclasses add: aRGBehaviorDefinition ]! !

!RGBehaviorDefinition methodsFor: 'testing' stamp: 'MarcusDenker 10/8/2013 11:16'!
includesProtocol: aString
	    "Looks for a protocols named = aString"
    
	    ^protocols includes: aString! !

!RGBehaviorDefinition methodsFor: 'managing container' stamp: 'VeronicaUquillas 5/9/2011 14:34'!
isIncludedInContainer: aRGContainer

	^aRGContainer includesClass: self! !

!RGBehaviorDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 3/21/2011 16:58'!
protocols: aCollection
	"set the protocols of the class"

	protocols:= aCollection! !

!RGBehaviorDefinition methodsFor: 'accessing class hierarchy' stamp: 'VeronicaUquillas 6/28/2011 15:23'!
allSuperclasses
	"Answer an OrderedCollection of the receiver's and the receiver's  
	ancestor's superclasses"
	"Is implementation of Behavior more efficient?"
	
	^self annotationNamed: self class allSuperclassesKey
		ifAbsentPut:[ | supers sprClass |
			supers := OrderedCollection new.
			sprClass := self superclass.
			[sprClass notNil] whileTrue: 
				[supers add: sprClass.
				sprClass := sprClass superclass].
			supers ]! !

!RGBehaviorDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 4/13/2011 16:41'!
isDefined
	"If the class exists in the environment"
	
	^self realClass notNil
	! !

!RGBehaviorDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 11/17/2010 11:01'!
methods

	^methods! !

!RGBehaviorDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 9/19/2011 16:51'!
hasMetaclass

	^ false! !

!RGBehaviorDefinition methodsFor: 'accessing methods' stamp: 'VeronicaUquillas 4/20/2011 17:31'!
compiledMethodNamed: selector
	"Retrieves the compiled method from aRGMethodDefinition"
	| method |

	^(method:= self methodNamed: selector) notNil
	ifTrue: [ method compiledMethod ]
	ifFalse:[ nil ]! !

!RGBehaviorDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 4/13/2011 16:43'!
protocols
	"retrieves the protocols of the class"

	^protocols! !

!RGBehaviorDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 5/2/2011 16:24'!
methods: aDictionary

	methods:= aDictionary! !

!RGBehaviorDefinition methodsFor: 'accessing' stamp: 'MarcusDenker 9/12/2014 17:16'!
superclass: aRGBehaviorDefinition
	"The superclass is assigned.
	If aRGBehaviorDefinition is not nil the receiver is added as a subclass and the superclass assignment also happens for theMetaClass"

	superclass := aRGBehaviorDefinition.
	superclass notNil
		ifFalse: [ ^ self ].
	self superclassName: aRGBehaviorDefinition name.
	aRGBehaviorDefinition addSubclass: self.
	self hasMetaclass
		ifTrue: [ self theMetaClass superclass: aRGBehaviorDefinition theMetaClass ]! !

!RGBehaviorDefinition methodsFor: 'accessing' stamp: 'ST 6/19/2013 15:53'!
traitNames
	"Assuming that traits in a composition can be identified by
	testing for the first character being an uppercase character
	(and thus not a special character such as {, # etc.)"
	| tokens |
	
	tokens := self traitCompositionSource parseLiterals flattened.
	^tokens select: [:each | each first isUppercase].! !

!RGBehaviorDefinition methodsFor: 'accessing methods' stamp: 'StephaneDucasse 8/29/2013 21:02'!
methodsInProtocol: aString
	"Retrieves the methods classified in protocol named aString"

	^methods select: [ :each | each protocol = aString ]! !

!RGBehaviorDefinition methodsFor: 'accessing methods' stamp: 'VeronicaUquillas 8/8/2011 12:47'!
extensionMethods

	^self methods select:[ :each | each isExtension ]! !

!RGBehaviorDefinition methodsFor: 'annotations' stamp: 'VeronicaUquillas 6/28/2011 15:22'!
traitCompositionSource
	"Retrieves aString representing the used traits"

	^self annotationNamed: self class traitCompositionSourceKey
		ifAbsentPut:[  '{}'  ]! !

!RGBehaviorDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 11/24/2010 16:40'!
hasSuperclass

	^superclass notNil! !

!RGBehaviorDefinition methodsFor: 'subclassing' stamp: 'VeronicaUquillas 4/29/2011 09:12'!
removeSubclass: aRGBehaviorDefinition 
	"Removes aRGAbstractClassDefinition from the direct subclasses - without failing if does not exist"
	
	self subclasses remove: aRGBehaviorDefinition ifAbsent: []! !

!RGBehaviorDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 3/22/2011 16:38'!
hasTraitComposition

	^self traitCompositionSource ~= '{}'! !

!RGBehaviorDefinition methodsFor: 'adding/removing methods' stamp: 'VeronicaUquillas 4/29/2011 09:21'!
addMethod: aRGMethodDefinition
	"Adds aRGMethodDefinition in the methods dictionary.
	 Adds the protocol of such method too"

	self addMethod: aRGMethodDefinition in: methods.
	self addProtocol: aRGMethodDefinition protocol! !

!RGBehaviorDefinition methodsFor: 'annotations' stamp: 'VeronicaUquillas 6/28/2011 15:22'!
subclasses: aCollection
	"Stores direct subclasses of the receiver as an annotation"

	self annotationNamed: self class subclassesKey
		ifAbsentPut:[ aCollection ]! !

!RGBehaviorDefinition methodsFor: 'accessing class hierarchy' stamp: 'VeronicaUquillas 6/28/2011 15:22'!
allSubclasses: aCollection
	"Stores all the subclasses (direct and indirect) as an annotation"
	
	self annotationNamed: self class allSubclassesKey
		ifAbsentPut:[ aCollection ]! !

!RGBehaviorDefinition methodsFor: 'accessing methods' stamp: 'VeronicaUquillas 4/20/2011 17:31'!
methodNamed: selector
	"Retrieves aRGMethodDefinition that matches the selector given as argument"
	"RB defines methodFor:"

	^methods at: selector asSymbol ifAbsent:[ nil ]! !

!RGBehaviorDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 4/13/2011 16:40'!
hasMethods
	"validates the existance of methods"

	^methods notEmpty! !

!RGBehaviorDefinition methodsFor: 'accessing class hierarchy' stamp: 'MarcusDenker 9/12/2014 17:15'!
allSuperclassesDo: aBlock
	"Evaluate the argument, aBlock, for each of the receiver's superclasses."

	self superclass isNil
		ifTrue: [ ^ self ].
	aBlock value: superclass.
	superclass allSuperclassesDo: aBlock! !

!RGBehaviorDefinition methodsFor: 'printing' stamp: 'VeronicaUquillas 11/17/2010 14:31'!
printOn: aStream 
	aStream nextPutAll: self name! !

!RGBehaviorDefinition methodsFor: 'annotations' stamp: 'VeronicaUquillas 6/28/2011 15:21'!
definitionSource
	"Retrieves the definition template of the receiver -> aString.
	This value is kept as an annotation"
	
	^self annotationNamed: self class definitionSourceKey! !

!RGBehaviorDefinition methodsFor: 'accessing methods' stamp: 'VeronicaUquillas 4/13/2011 23:54'!
includesSelector: selector
	"Looks if selector is a key in the methods dictionary"
	
	^methods includesKey: selector asSymbol! !

!RGBehaviorDefinition methodsFor: 'accessing' stamp: ''!
theMetaClass

	self subclassResponsibility! !

!RGBehaviorDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 7/18/2011 14:30'!
isSameRevisionAs: aRGBehaviorDefinition
	"This method look for equality of the properties of the receiver"

	^self class = aRGBehaviorDefinition class
		and:[ self name == aRGBehaviorDefinition name ]! !

!RGBehaviorDefinition methodsFor: 'accessing class hierarchy' stamp: 'VeronicaUquillas 7/28/2011 15:59'!
allSubclasses
	"Retrieves all the subclasses of the receiver in the chan hiearchy - value is kept as an annotation"
	"is a good idea storing this?"
	
	^self annotationNamed: self class allSubclassesKey
		ifAbsentPut:[ | collection index |
			index := 1.
			collection := OrderedCollection withAll: self subclasses.
			[index <= collection size] whileTrue: 
				[collection addAll: (collection at: index) subclasses.
				index := index + 1].
			collection ]! !

!RGBehaviorDefinition methodsFor: 'accessing class hierarchy' stamp: 'DamienCassou 4/29/2013 15:32'!
methodDict
	^ methods! !

!RGBehaviorDefinition methodsFor: 'accessing class hierarchy' stamp: 'VeronicaUquillas 3/19/2011 16:22'!
withAllSuperclasses
	"if allSuperclasses is stored should not affect the collection"

	^self allSuperclasses, {self}! !

!RGBehaviorDefinition methodsFor: 'adding/removing methods' stamp: 'MarcusDenker 9/24/2014 16:44'!
addSelector: selectorName classified: protocolName sourced: source

	self addMethod: ((RGMethodDefinition named: selectorName) 
							parent: self;
							protocol: protocolName;
							sourceCode: source;
							yourself)! !

!RGBehaviorDefinition methodsFor: 'accessing class hierarchy' stamp: 'VeronicaUquillas 6/28/2011 15:22'!
allSuperclasses: aCollection
	"Stores all the superclasses (direct and indirect) as an annotation"
	
	self annotationNamed: self class allSuperclassesKey
		ifAbsentPut:[ aCollection ]! !

!RGBehaviorDefinition methodsFor: 'private' stamp: 'VeronicaUquillas 4/29/2011 13:58'!
removeMethod: aRGMethodDefinition from: aCollection
	"Removes aRGMethodDefinition from the collection received"

	aCollection removeKey: aRGMethodDefinition selector ifAbsent:[]! !

!RGBehaviorDefinition methodsFor: 'testing' stamp: ''!
isMeta
	"By default is considered a non-meta class"

	^false! !

!RGBehaviorDefinition methodsFor: 'adding/removing protocols' stamp: 'VeronicaUquillas 4/29/2011 09:29'!
removeProtocol: aString
	"Removes a protocol named aString (if exists)"

	protocols remove: aString ifAbsent:[]! !

!RGBehaviorDefinition methodsFor: 'printing' stamp: 'MarcusDenker 7/30/2014 10:37'!
storeOn: aStream 
	self name storeOn: aStream! !

!RGBehaviorDefinition methodsFor: 'annotations' stamp: 'VeronicaUquillas 6/28/2011 15:21'!
superclassName: aSymbol

	self annotationNamed: self class superclassNameKey 
		put: aSymbol! !

!RGBehaviorDefinition methodsFor: 'accessing' stamp: ''!
realClass
	"Retrieves the current class existing in the runtime environment"

	^self rootEnvironment classNamed: self name ! !

!RGBehaviorDefinition methodsFor: 'private' stamp: 'VeronicaUquillas 6/6/2011 10:47'!
addMethod: aRGMethodDefinition in: aCollection
	"Adds aRGMethodDefinition in the collection received"

	aRGMethodDefinition parent ifNil:[ aRGMethodDefinition parent: self ].
	aCollection at: aRGMethodDefinition selector
		put: aRGMethodDefinition! !

!RGBehaviorDefinition methodsFor: 'annotations' stamp: 'VeronicaUquillas 6/28/2011 15:23'!
definitionSource: aString
	"Sets the definition template of the receiver -> aString.
	It's stored as an annotation"
	
	self annotationNamed: self class definitionSourceKey
		put: aString! !

!RGBehaviorDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 11/17/2010 11:01'!
superclass

	^superclass! !

!RGBehaviorDefinition methodsFor: 'accessing methods' stamp: 'VeronicaUquillas 3/21/2011 17:23'!
selectors
	"Retrieves the method selectors"

	^methods keys! !

!RGBehaviorDefinition methodsFor: '*NautilusCommon' stamp: 'BenjaminVanRyseghem 9/1/2011 14:41'!
addCategory: newName before: aCategory

	^ self addProtocol: newName! !

!RGBehaviorDefinition methodsFor: 'annotations' stamp: 'VeronicaUquillas 6/28/2011 15:22'!
subclasses
	"Retrieves the direct subclasses of the receiver.
	This value is kept as an annotation"

	^self annotationNamed: self class subclassesKey
		ifAbsentPut:[ OrderedCollection new ]! !

!RGBehaviorDefinition class methodsFor: 'class-annotations' stamp: 'VeronicaUquillas 6/28/2011 15:17'!
superclassesKey

	^#superclasses! !

!RGBehaviorDefinition class methodsFor: 'class-annotations' stamp: 'VeronicaUquillas 6/28/2011 15:17'!
traitCompositionSourceKey

	^#traitCompositionSource! !

!RGBehaviorDefinition class methodsFor: 'class-annotations' stamp: 'VeronicaUquillas 8/2/2011 13:43'!
usersKey

	^#users! !

!RGBehaviorDefinition class methodsFor: 'class-annotations' stamp: 'VeronicaUquillas 8/2/2011 13:35'!
isPoolKey

	^#isPool! !

!RGBehaviorDefinition class methodsFor: 'class-annotations' stamp: 'VeronicaUquillas 6/28/2011 15:17'!
allSuperclassesKey

	^#allSuperclasses! !

!RGBehaviorDefinition class methodsFor: 'class-annotations' stamp: 'VeronicaUquillas 6/28/2011 15:17'!
superclassNameKey
	
	^#superclassName! !

!RGBehaviorDefinition class methodsFor: 'class-annotations' stamp: 'VeronicaUquillas 6/28/2011 15:17'!
allSubclassesKey

	^#allSubclasses! !

!RGBehaviorDefinition class methodsFor: 'class-annotations' stamp: 'VeronicaUquillas 6/28/2011 15:17'!
subclassesKey

	^#subclasses! !

!RGBehaviorDefinition class methodsFor: 'class-annotations' stamp: 'VeronicaUquillas 6/28/2011 15:17'!
definitionSourceKey

	^#definitionSource! !

!RGClassDefinition commentStamp: 'VeronicaUquillas 4/19/2011 16:01'!
RGClassDefinition is the concrete representation of a class (no trait)!
!RGClassDefinition methodsFor: 'accessing' stamp: 'MarcusDenker 9/24/2014 16:37'!
comment: anObject
	"Sets a RGCommentDefinition object based on the argument"
	
	comment := anObject isRingObject 
		ifFalse: [ 
			RGCommentDefinition new
				parent: self;
				content: anObject; 
				yourself ]
		ifTrue: [anObject ]
	
	 ! !

!RGClassDefinition methodsFor: 'behavior' stamp: 'MarcusDenker 8/1/2014 14:16'!
withMetaclass
	"Registers explicitly the metaclass of a class"

	metaClass:= RGMetaclassDefinition class: self
! !

!RGClassDefinition methodsFor: 'managing pool users' stamp: 'VeronicaUquillas 8/2/2011 13:41'!
isPool: aBoolean
	
	^self annotationNamed: self class isPoolKey put: aBoolean! !

!RGClassDefinition methodsFor: 'accessing' stamp: 'MarcusDenker 8/1/2014 14:11'!
stamp: aString

	self hasComment
	ifTrue: [ self comment stamp: aString ]
	ifFalse:[ RGCommentDefinition new
						 parent: self; 
						 stamp: aString ]! !

!RGClassDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 4/27/2011 10:45'!
comment
	"Retrieves the comment definition object"

	^comment! !

!RGClassDefinition methodsFor: 'managing pool users' stamp: 'MartinDias 10/28/2013 16:20'!
addUser: aRGClassDefinition
	"The receiver registers the aRGClassDefinition as an user.  An reinforces its status as a shared pool."
	
	aRGClassDefinition isClass ifFalse:[ ^self ].
	(aRGClassDefinition theNonMetaClass sharedPoolNamed: self name) isNil
		ifTrue: [ aRGClassDefinition theNonMetaClass addSharedPoolNamed: self name ].
	self isPool: true.
	self users add: aRGClassDefinition theNonMetaClass! !

!RGClassDefinition methodsFor: 'behavior' stamp: 'VeronicaUquillas 5/12/2011 13:20'!
withMetaclass: aRGMetaclassDefinition
	"Registers explicitly the metaclass of a class"

	metaClass:= aRGMetaclassDefinition.
	metaClass baseClass: self.  
! !

!RGClassDefinition methodsFor: 'initialization' stamp: 'MartinDias 10/28/2013 16:20'!
initialize

	super initialize.
	classVariables:= OrderedCollection new.
	sharedPools:= OrderedCollection new.! !

!RGClassDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 5/9/2011 14:28'!
package: aRGPackage
	"Sets the package in which this class is contained"
	
	package:= aRGPackage! !

!RGClassDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 12/2/2010 18:27'!
theNonMetaClass

	^self! !

!RGClassDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 4/14/2011 12:40'!
package
	"Retrieves the package in which this class is contained, if exists"
	
	^package! !

!RGClassDefinition methodsFor: 'class variables' stamp: 'VeronicaUquillas 4/29/2011 09:25'!
allClassVariables
	"Answer a collection of the receiver's classVariables, including those defined its superclasses"

	^self hasSuperclass 
		ifFalse:[ classVariables ]
		ifTrue:[ self superclass allClassVariables, classVariables ]! !

!RGClassDefinition methodsFor: 'class variables' stamp: 'MarcusDenker 8/1/2014 14:30'!
addClassVarNamed: aString
	| var |
	var := (RGClassVariableDefinition named: aString) parent: self.
	self addVariable: var in: classVariables.
	^var! !

!RGClassDefinition methodsFor: 'class variables' stamp: 'VeronicaUquillas 4/29/2011 13:39'!
removeClassVarNamed: aString

	self removeVariable: (self classVarNamed: aString) from: classVariables! !

!RGClassDefinition methodsFor: 'class variables' stamp: 'VeronicaUquillas 4/28/2011 21:27'!
addClassVariable: aRCClassVariable

	self addVariable: (aRCClassVariable parent: self) 
		in: classVariables! !

!RGClassDefinition methodsFor: 'class variables' stamp: 'VeronicaUquillas 2/25/2011 20:38'!
allClassVarNames

	^self allClassVariables collect:[ :cvar| cvar name ]! !

!RGClassDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 5/12/2011 10:09'!
hasStamp

	^self stamp isEmptyOrNil not! !

!RGClassDefinition methodsFor: 'class variables' stamp: 'VeronicaUquillas 4/29/2011 13:39'!
removeClassVariable: aRGClassVariableDefinition

	self removeVariable: aRGClassVariableDefinition from: classVariables! !

!RGClassDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 4/14/2011 11:15'!
category
	"retrieves a tag for its package"
	
	^category! !

!RGClassDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 12/2/2010 18:26'!
hasMetaclass

	^metaClass notNil! !

!RGClassDefinition methodsFor: 'managing pool users' stamp: 'VeronicaUquillas 8/2/2011 13:46'!
includesUser: aRGBehaviorDefinition

	^self users includes: aRGBehaviorDefinition! !

!RGClassDefinition methodsFor: 'shared pools' stamp: 'MartinDias 10/28/2013 16:20'!
sharedPoolNamed: poolName

	^sharedPools detect:[ :v| v name = poolName asSymbol ] ifNone:[ nil ]! !

!RGClassDefinition methodsFor: 'shared pools' stamp: 'MartinDias 10/28/2013 16:20'!
sharedPoolNames
	
	^sharedPools collect:[ :pool| pool name ]! !

!RGClassDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 5/12/2011 10:08'!
stamp

	^self hasComment ifTrue:[ self comment stamp ] ifFalse:[ nil ]! !

!RGClassDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 5/2/2011 16:26'!
classVariables: aCollection

	classVariables:= aCollection! !

!RGClassDefinition methodsFor: 'shared pools' stamp: 'MartinDias 10/28/2013 16:19'!
allSharedPoolNames
	^ self allSharedPools collect: [ :pool | pool name ]! !

!RGClassDefinition methodsFor: 'accessing' stamp: 'MartinDias 10/28/2013 16:42'!
sharedPools
	"Keeps the pool variable relationship of the receiver"

	^ sharedPools! !

!RGClassDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 3/21/2011 16:53'!
category: aSymbol
	"stores a tag for its package"

	category := aSymbol! !

!RGClassDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 5/12/2011 14:41'!
hasComment

	^comment isEmptyOrNil not! !

!RGClassDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 4/28/2011 21:30'!
classVariables

	^classVariables! !

!RGClassDefinition methodsFor: 'shared pools' stamp: 'MartinDias 10/28/2013 16:21'!
removeSharedPool: aRGPoolVariableDefinition

	self removeVariable: aRGPoolVariableDefinition from: sharedPools! !

!RGClassDefinition methodsFor: 'accessing' stamp: 'MartinDias 10/28/2013 16:42'!
sharedPools: aCollection
	sharedPools := aCollection! !

!RGClassDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 12/2/2010 18:27'!
theMetaClass
	
	^metaClass! !

!RGClassDefinition methodsFor: 'class variables' stamp: 'VeronicaUquillas 4/29/2011 09:25'!
classVarNames
	"Answer a collection of the names of the class variables defined in the receiver."
	
	^classVariables collect:[ :cvar| cvar name ]! !

!RGClassDefinition methodsFor: 'managing pool users' stamp: 'MartinDias 10/28/2013 16:21'!
removeUser: aRGClassDefinition
	"Removes this RGClassDefinition from the users of the receiver"
	
	aRGClassDefinition isClass ifFalse:[ ^self ].
	aRGClassDefinition theNonMetaClass removeSharedPoolNamed: self name.
	self users remove: aRGClassDefinition theNonMetaClass ifAbsent:[ ]! !

!RGClassDefinition methodsFor: 'class variables' stamp: 'MarcusDenker 6/24/2013 11:04'!
classVarNamed: aString

	^classVariables detect:[ :v| v name = aString asSymbol ] ifNone:[ nil ]! !

!RGClassDefinition methodsFor: '*Deprecated40' stamp: 'MarcusDenker 7/17/2014 16:52'!
classSymbol
	self deprecated: 'use className' on: '17 July 2014'  in: 'Pharo4'.
	^ self className! !

!RGClassDefinition methodsFor: 'testing' stamp: 'MartinDias 10/28/2013 16:20'!
isSameRevisionAs: aRGClassDefinition
	"This method look for equality of the properties of the receiver"

	^(super isSameRevisionAs: aRGClassDefinition)
		and:[ self superclassName == aRGClassDefinition superclassName
		and:[ self category = aRGClassDefinition category 
		and:[ self classVarNames sorted = aRGClassDefinition classVarNames sorted 
		and:[ self sharedPoolNames sorted = aRGClassDefinition sharedPoolNames sorted  
		and:[ self traitCompositionSource = aRGClassDefinition traitCompositionSource 
		and:[ ((self hasComment and:[ self comment isSameRevisionAs: aRGClassDefinition comment ]) or:[ self hasComment not ])
		and:[ (self theMetaClass isSameRevisionAs: aRGClassDefinition theMetaClass) ] ] ] ] ] ] ]! !

!RGClassDefinition methodsFor: '*NautilusCommon' stamp: 'BenjaminVanRyseghem 9/1/2011 14:18'!
definition

	^ self realClass definition! !

!RGClassDefinition methodsFor: 'shared pools' stamp: 'MartinDias 10/28/2013 16:20'!
addSharedPool: aRGPoolVariableDefinition
	self 
		addVariable: (aRGPoolVariableDefinition parent: self) 
		in: sharedPools! !

!RGClassDefinition methodsFor: 'shared pools' stamp: 'MartinDias 10/28/2013 16:21'!
removeSharedPoolNamed: poolName

	self removeVariable: (self sharedPoolNamed: poolName) from: sharedPools! !

!RGClassDefinition methodsFor: 'shared pools' stamp: 'MartinDias 10/28/2013 16:20'!
allSharedPools
	"Answer a collection of the pools the receiver shares, including those defined  
	in the superclasses of the receiver."

	^ self hasSuperclass
		ifFalse: [ sharedPools ]
		ifTrue: [ self superclass allSharedPools , sharedPools ]! !

!RGClassDefinition methodsFor: '*NautilusCommon' stamp: 'BenjaminVanRyseghem 9/1/2011 14:28'!
compile: aString classified: aCategory notifying: aController

	self realClass compile: aString classified: aCategory notifying: aController! !

!RGClassDefinition methodsFor: 'managing pool users' stamp: 'VeronicaUquillas 8/2/2011 14:07'!
users
	"If the reciever is a SharedPool then retrieves its users"
	
	^self isPool
		ifTrue: [ self annotationNamed: self class usersKey ifAbsentPut: [ OrderedCollection new ] ]
		ifFalse:[ #() ]! !

!RGClassDefinition methodsFor: 'managing pool users' stamp: 'VeronicaUquillas 8/2/2011 14:03'!
isPool
	"The receiver is a shared pool if it inherits from SharedPool"
	
	^self annotationNamed: self class isPoolKey 
		ifAbsent: [ self superclassName == #SharedPool ]! !

!RGClassDefinition methodsFor: 'shared pools' stamp: 'MartinDias 10/28/2013 16:19'!
addSharedPools: aCollection
	aCollection do: [ :pool | self addSharedPoolNamed: pool ]! !

!RGClassDefinition methodsFor: '*NautilusCommon' stamp: 'BenjaminVanRyseghem 8/28/2011 18:33'!
inheritsFrom: aClass

	^ self realClass inheritsFrom: aClass! !

!RGClassDefinition methodsFor: 'class variables' stamp: 'VeronicaUquillas 11/24/2010 17:24'!
addClassVariables: aCollection
	
	aCollection do: [:var | self addClassVarNamed: var ]! !

!RGClassDefinition methodsFor: 'shared pools' stamp: 'MarcusDenker 9/19/2014 12:41'!
addSharedPoolNamed: poolName
	| pool |
	pool:= (RGPoolVariableDefinition named:  poolName) parent: self.
	self addVariable: pool in: sharedPools.
	^pool! !

!RGClassDefinition class methodsFor: 'instance creation' stamp: 'MarcusDenker 9/19/2014 12:39'!
createSharedPoolNamed: aSymbol
	"A shared pool is a class inheriting from #SharedPool"

	^(RGClassDefinition named: aSymbol)
			superclassName: #SharedPool;
			isPool: true;
			yourself! !

!RGClassDefinitionTest commentStamp: 'TorstenBergmann 2/12/2014 23:09'!
SUnit tests for class definitions!
!RGClassDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 7/30/2014 21:36'!
testWithPoolDictionaries
	| newClass poolVar |
	
	newClass:= (RGClassDefinition named:  #Text)
						addSharedPoolNamed: #TextConstants;
						yourself.

	self assert: (newClass sharedPools size = 1).
	self assert: (newClass sharedPoolNames size = 1).
	self assert: (newClass allSharedPools size = 1).  "no hierarchy"
	self assert: (newClass allSharedPoolNames size = 1).
	
	poolVar:= newClass sharedPoolNamed: #TextConstants.
	self assert: (poolVar notNil).
	self assert: (poolVar isPoolVariable).
	self assert: (poolVar isVariable).
	self assert: (poolVar parent = newClass).
	self assert: (poolVar parentName == newClass name).
	self assert: (poolVar realClass = Text).
	
	newClass withMetaclass.
	self assert: (newClass theMetaClass allSharedPoolNames size = 1).
	
	newClass removeSharedPoolNamed: #TextConstants.
	self assert: (newClass sharedPools isEmpty).! !

!RGClassDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 9/25/2014 13:06'!
testAddingMethods
	| newMethod newClass |
	
	newClass:= RGClassDefinition named:  #OrderedCollection.
	newMethod:= (RGMethodDefinition named: #add:)
					 parent: newClass;
					protocol: 'adding';
					sourceCode: 'add: newObject
									^self addLast: newObject'.
	
	self assert: (newMethod isMetaSide not).
	self assert: (newClass hasMethods not).

	newClass addMethod: newMethod.
	newClass addSelector: #size 
			   classified: 'accessing' 
			   sourced: 'fakeMethod
							^lastIndex - firstIndex + 1'.
	
	self assert: (newClass hasMethods).
	self assert: (newClass selectors = #(add: size)).
	self assert: (newClass includesSelector: #add:).
	self assert: ((newClass methodNamed: #add:) = newMethod).
	self assert: (newClass methods size = 2).
	self assert: (newClass selectors size = 2).
	self assert: (newClass allSelectors size = 2).  "no hierarchy"

	newMethod:= newClass methodNamed: #size.
	self assert: (newMethod parent = newClass).
	
	self assert: ((newClass compiledMethodNamed: #size) notNil).
	self assert: ((newClass compiledMethodNamed: #fakeMethod) isNil)! !

!RGClassDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 8/1/2014 14:29'!
testWithSuperclass
	| newClass supClass  |
	
	supClass:= (RGClassDefinition named:  #Object)
						superclassName: #ProtoObject;
						yourself.

	self assert: (supClass hasSuperclass not).
	self assert: (supClass superclassName == #ProtoObject).   "kept as annotation"
	self assert: (supClass annotations size = 1).
	
	newClass := (RGClassDefinition named: #OrderedCollection) superclass: supClass.
	self assert: (newClass superclass = supClass).
	self assert: (newClass superclassName == #Object).
	self assert: (newClass withAllSuperclasses size = 2).
	self assert: (newClass allSuperclasses size = 1).
	
	self assert: (supClass subclasses size = 1).
	self assert: (supClass withAllSubclasses size = 2).
	self assert: (supClass allSubclasses size = 1).! !

!RGClassDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 7/30/2014 21:36'!
testWithCategory
	| newClass |
	
	newClass:= (RGClassDefinition named:  #Object)
						category: 'Kernel-Objects';
						yourself.

	self assert: (newClass package isNil).
	self assert: (newClass category = 'Kernel-Objects').! !

!RGClassDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 7/30/2014 21:35'!
testExistingClass
	| newClass metaClass |
	
	newClass:= RGClassDefinition named:  #OrderedCollection.
	self assert: (newClass isClass).
	self assert: (newClass isDefined).
	self assert: (newClass realClass = OrderedCollection).
	self assert: (newClass isMeta not).
	
	newClass withMetaclass.
	self assert: (newClass hasMetaclass).
	metaClass:= newClass theMetaClass.
	self assert: (metaClass isMeta).
	self assert: (metaClass name = 'OrderedCollection class').
	self assert: (metaClass theNonMetaClass = newClass).
	self assert: (metaClass realClass = OrderedCollection class).! !

!RGClassDefinitionTest methodsFor: '*Ring-Tests-Monticello' stamp: 'VeronicaUquillas 9/19/2011 17:56'!
testAsClassDefinition3

	| newClass newSlice |
	newClass:= OrderedCollection asRingDefinitionWithMethods: true withSuperclasses: false withSubclasses: false withPackages: false.
	newSlice := newClass environment.
	self assert: (newClass methods size = OrderedCollection methods size).
	self assert: newSlice isSlice.
	self assert: newSlice classes size = 1.
	self assert: (newSlice classNamed: #OrderedCollection) = newClass.
	
	newClass:= OrderedCollection asRingDefinitionWithMethods: false withSuperclasses: true withSubclasses: false withPackages: false.
	newSlice := newClass environment.
	self assert: (newClass superclass isRingObject).
	self assert: (newClass superclass name = OrderedCollection superclass name).
	self assert: (newClass allSuperclasses size = OrderedCollection allSuperclasses size).
	self assert: newClass superclass = (newSlice classNamed: newClass superclassName).
	
	newClass:= RGBehaviorDefinition asRingDefinitionWithMethods: false withSuperclasses: false withSubclasses: true withPackages: false.
	newSlice := newClass environment.
	self assert: (newClass subclasses size = RGBehaviorDefinition subclasses size).
	self assert: (newClass allSubclasses size = RGBehaviorDefinition allSubclasses size).
	self assert: (newClass subclasses allSatisfy:[ :each| newSlice classes values includes: each ]).

	newClass:= RGBehaviorDefinition asRingDefinitionWithMethods: false withSuperclasses: false withSubclasses: false withPackages: true.
	newSlice := newClass environment.
	self assert: (newClass package name = #'Ring-Core-Kernel').
	self assert: (newSlice packageNamed: #'Ring-Core-Kernel') = newClass package.
	self assert: (newClass package classes size = 1).
	self assert: (newClass package classes values first = newClass).

	newClass:= Class asRingDefinitionWithMethods: true withSuperclasses: false withSubclasses: false withPackages: true.
	newSlice := newClass environment.
	self assert: (newClass package name = #Kernel).
	self assert: (newClass extensionMethods notEmpty).
	self assert: (newSlice methods size = (newClass methods size + newClass theMetaClass methods size)).
	self assert: (newSlice packageNamed: #'Ring-Core-Kernel') methods size > 1.
! !

!RGClassDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 9/25/2014 13:07'!
testRemovingMethods
	| newMethod newClass |
	
	newClass:= RGClassDefinition named: #OrderedCollection.
	newMethod:= (RGMethodDefinition named: #add:)
					parent: newClass;
					protocol: 'adding';
					sourceCode: 'add: newObject
									^self addLast: newObject'.
	self assert: (newClass hasMethods not).

	newClass addMethod: newMethod.
	newClass addSelector: #size 
			   classified: 'accessing' 
			   sourced: 'size
							^ lastIndex - firstIndex + 1'.
	
	self assert: (newClass selectors = #(add: size)).
	newClass removeSelector: #join:.
	self assert: (newClass selectors = #(add: size)).
	newClass removeMethod: newMethod.
	self assert: ((newClass includesSelector: #add:) not).
	newClass removeSelector: #size.
	self assert: (newClass hasMethods not).! !

!RGClassDefinitionTest methodsFor: 'testing' stamp: 'ST 6/20/2013 16:50'!
testAsClassDefinitionSourceDefinition

	| newClass |
	newClass:= Trait asRingDefinition.
	self assert: (newClass definitionSource =  'TraitDescription subclass: #Trait
	uses: TClass
	instanceVariableNames: ''name environment classTrait category''
	classVariableNames: ''''
	poolDictionaries: ''''
	category: ''Traits-Kernel''').
	
	self assert: (newClass theMetaClass definitionSource =  'Trait class
	uses: TClass classTrait
	instanceVariableNames: ''''').
	! !

!RGClassDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 7/30/2014 21:36'!
testWithDefaultNamespace
	| newClass |
	
	newClass:= RGClassDefinition named:  #Object.

	self assert: (newClass parent = Smalltalk globals).
	self assert: (newClass realClass = Object).! !

!RGClassDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 7/30/2014 21:36'!
testWithInstanceVariables
	| newClass instVar |
	
	newClass:= RGClassDefinition named: #OrderedCollection.
	newClass addInstanceVariables: #(array firstIndex).
	newClass addInstVarNamed: #lastIndex.
	
	self assert: (newClass instanceVariables size = 3).
	self assert: (newClass instVarNames size = 3).
	self assert: (newClass allInstVarNames size = 3).
	
	instVar:= newClass instanceVariableNamed: #firstIndex.
	self assert: (instVar notNil).
	self assert: (instVar parent = newClass).
	self assert: (instVar isInstanceVariable).
	self assert: (instVar isVariable).
	self assert: (instVar parentName == newClass name).
	self assert: (instVar realClass = OrderedCollection).
	
	newClass removeInstVarNamed: #array.
	self assert: (newClass instanceVariables size = 2).
	self assert: ((newClass instanceVariableNamed: #array) isNil).
	! !

!RGClassDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 7/30/2014 21:36'!
testWithClassVariables
	| newClass classVar |
	
	newClass:= (RGClassDefinition named: #Object)
						addClassVariables: #(DependentsFields);
						addClassVarNamed: #FakeVariable;
						yourself.

	self assert: (newClass classVariables size = 2).
	self assert: (newClass classVarNames size = 2).
	self assert: (newClass allClassVarNames size = 2).  "no hierarchy"
	
	classVar:= newClass classVarNamed: #DependentsFields.
	self assert: (classVar notNil).
	self assert: (classVar isClassVariable).
	self assert: (classVar isVariable).
	self assert: (classVar parent = newClass).
	self assert: (classVar parentName == newClass name).
	self assert: (classVar realClass = Object).
	
	newClass withMetaclass.
	self assert: (newClass theMetaClass allClassVarNames size = 2).
	
	newClass removeClassVarNamed: #DependentsFields.
	self assert: (newClass classVariables size = 1).! !

!RGClassDefinitionTest methodsFor: '*Ring-Tests-Monticello' stamp: 'CamilloBruni 11/8/2013 18:27'!
testAsFullClassDefinition
	"self debug: #testAsFullClassDefinition"
	
	| rgClass |
	rgClass := Class asRingDefinition.
	self assert: rgClass methods isEmpty.
	self assert: rgClass superclass isNil.
	self assert: rgClass subclasses isEmpty.
	self assert: rgClass package name equals: #Kernel.

	rgClass := Class asFullRingDefinition.
	self assert: rgClass methods notEmpty.
	self assert: (rgClass methodNamed: #asRingDefinition) package name = #'Ring-Core-Kernel'.
	self assert: rgClass superclass notNil.
	self assert: rgClass superclass name = #ClassDescription.
	self assert: rgClass subclasses notEmpty.
	self assert: rgClass package notNil.
	self assert: rgClass package = rgClass theNonMetaClass package.
	self assert: rgClass package name = #Kernel.
	self assert: rgClass category = #'Kernel-Classes'.
	self assert: rgClass extensionMethods notEmpty.
	
	self assert: rgClass superclass superclass isNil.
	self assert: rgClass superclass package name equals: #Kernel.
	self assert: rgClass subclasses first package name equals: #Kernel.
	
	rgClass := RGClassDefinition theMetaClass asFullRingDefinition.
	self assert: rgClass package = rgClass theNonMetaClass package.! !

!RGClassDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 7/30/2014 21:36'!
testWithClassInstanceVariables
	| newClass metaClass classInstVar |
	
	newClass:= RGClassDefinition named:  #HashTableSizes.
	newClass withMetaclass.
	metaClass:= newClass theMetaClass.
	metaClass addInstanceVariables: #(sizes).
	
	self assert: (metaClass instanceVariables size = 1).
	self assert: (metaClass instVarNames size = 1).
	self assert: (metaClass allInstVarNames size = 1).
	
	classInstVar:= metaClass instanceVariableNamed: #sizes.
	self assert: (classInstVar notNil).
	self assert: (classInstVar parent = metaClass).
	self assert: (classInstVar isClassInstanceVariable).
	self assert: (classInstVar isVariable).
	self assert: (classInstVar parentName = metaClass name).
	self assert: (classInstVar realClass = HashTableSizes class).
	
	metaClass removeInstVarNamed: #sizes.
	self assert: (metaClass instanceVariables isEmpty).
	self assert: ((metaClass instanceVariableNamed: #sizes) isNil).
	! !

!RGClassDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 7/30/2014 10:32'!
testReadFrom
	"self debug: #testReadFrom"
	
	
	| st rg |
	rg := Point asRingDefinition.
	st := String streamContents: [:s |
		rg storeOn: s.
		s contents].
	self assert: (Object readFrom: st) = rg. 
	
	rg := Point class asRingDefinition.
	st := String streamContents: [:s |
		rg storeOn: s.
		s contents].
	self assert: (Object readFrom: st) = rg ! !

!RGClassDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 8/1/2014 14:11'!
testWithComment
	| newClass newComment |
	
	newClass:= RGClassDefinition named: #Object.
	newComment:= RGCommentDefinition new
						parent: newClass;
						content: 'This is a comment for test';
						stamp: 'VeronicaUquillas 3/22/2011 14:51';
						yourself.
	newClass comment: newComment.

	self assert: (newClass hasComment).
	self assert: (newClass hasStamp).
	self assert: (newClass = newComment parent).
	self assert: (newComment content = 'This is a comment for test').
	self assert: (newComment author = 'VeronicaUquillas').
	self assert: (newComment timeStamp = '3/22/2011 14:51' asDateAndTime).
	
	newClass comment: nil.
	self assert: (newClass hasComment not).
	
	newClass comment:  'This is a comment for test';
			  stamp: 'VeronicaUquillas 3/22/2011 14:51'.
	
	self assert: (newClass comment isRingObject).
! !

!RGClassDefinitionTest methodsFor: 'testing' stamp: 'MartinDias 11/12/2013 18:01'!
testAsRingDefinition
	self assert: OrderedCollection asRingDefinition asRingDefinition isRingObject! !

!RGClassDefinitionTest methodsFor: 'testing' stamp: 'VeronicaUquillas 5/12/2011 19:31'!
testAsClassDefinition
	| newClass |

	newClass:= OrderedCollection asRingDefinition.
	
	self assert: (newClass isRingObject).
	self assert: (newClass isClass).  
	self assert: (newClass name == #OrderedCollection).  
	self assert: (newClass category notNil).
	self assert: (newClass superclassName notNil).
	
	self assert: (newClass theMetaClass isRingObject).
	self assert: (newClass theMetaClass isClass).! !

!RGClassDefinitionTest methodsFor: 'testing' stamp: 'ST 6/20/2013 17:06'!
testAsClassDefinition2

	| newClass |
	newClass:= Trait asRingDefinition.
	
	self assert: (newClass isRingObject).
	self assert: (newClass isClass).  
	self assert: (newClass name == #Trait).  
	self assert: (newClass category notNil).
	self assert: (newClass superclassName notNil).
	self assert: (newClass  traitCompositionSource = 'TClass').
	
	self assert: (newClass theMetaClass isRingObject).
	self assert: (newClass theMetaClass isClass).
	self assert: (newClass theMetaClass traitCompositionSource = 'TClass classTrait').
	! !

!RGClassDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 9/25/2014 13:07'!
testWithProtocols
	| newMethod newClass |
	
	newClass:= RGClassDefinition named: #OrderedCollection.
	newMethod:= (RGMethodDefinition named: #add:)
					 parent: newClass;
					protocol: 'adding'; 
					sourceCode: 'add: newObject
									^self addLast: newObject'.
	
	newClass addMethod: newMethod.
	newClass addProtocol: 'accessing'.
	
	self assert: (newClass hasProtocols).
	self assert: (newClass protocols size = 2).
	self assert: (newClass includesProtocol: 'accessing').
	self assert: ((newClass methodsInProtocol: 'adding') size = 1).
	self assert: ((newClass methodsInProtocol: 'accessing') isEmpty)! !

!RGClassDefinitionTest methodsFor: 'testing' stamp: 'VeronicaUquillas 8/10/2011 11:42'!
testClassEquality
	| newClass |
	
	self assert: OrderedCollection asRingDefinition = OrderedCollection asRingDefinition.
	
	newClass := (OrderedCollection asRingDefinition)
		category: #Kernel.
	self assert: (OrderedCollection asRingDefinition = newClass) ! !

!RGClassDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 7/30/2014 10:39'!
testStoreOn
	"self debug: #testStoreOn"
	
	
	| st |
	st := String streamContents: [:s |
		
		(Point) asRingDefinition storeOn: s.
		s contents].
	self assert: st = '(RGClassDefinition named: #Point)'.
	
	st := String streamContents: [:s |
		
		(Point class) asRingDefinition storeOn: s.
		s contents].
	self assert: st = '((RGMetaclassDefinition named: #''Point class'') baseClass:(RGClassDefinition named: #Point))'! !

!RGClassDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 7/30/2014 21:35'!
testNonExistingClass
	| newClass |
	
	newClass:= RGClassDefinition named:  #Connection.
	self assert: (newClass isClass).
	self assert: (newClass instanceVariables isEmpty).
	self assert: (newClass classVariables isEmpty).
	self assert: (newClass sharedPools isEmpty).
	self assert: (newClass hasMetaclass not).
	self assert: (newClass hasComment not).
	self assert: (newClass hasStamp not).
	self assert: (newClass parent = Smalltalk globals).
	self assert: (newClass package isNil).
	self assert: (newClass category isNil).
	self assert: (newClass hasMethods not).
	self assert: (newClass hasSuperclass not).
	self assert: (newClass hasTraitComposition not).
	self assert: (newClass isDefined not).
	self assert: (newClass hasProtocols not).
	
	! !

!RGClassDescriptionDefinition commentStamp: 'VeronicaUquillas 4/19/2011 16:00'!
RGClassDescriptionDefinition is the common parent for classes and metaclasses defining instance variables!
!RGClassDescriptionDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 11/19/2010 11:59'!
isClass

	^true! !

!RGClassDescriptionDefinition methodsFor: 'instance variables' stamp: 'MartinDias 11/12/2013 18:50'!
removeInstVarNamed: aString

	self removeVariable: (self instanceVariableNamed: aString) from: instanceVariables! !

!RGClassDescriptionDefinition methodsFor: '*NautilusCommon' stamp: 'DamienCassou 4/29/2013 15:19'!
packagesWithoutExtensions
	^ Set new
			add: self package;
			yourself.! !

!RGClassDescriptionDefinition methodsFor: 'instance variables' stamp: 'VeronicaUquillas 2/25/2011 20:38'!
allInstVarNames

	^self allInstanceVariables collect:[ :ivar| ivar name ]! !

!RGClassDescriptionDefinition methodsFor: 'comparing' stamp: 'VeronicaUquillas 2/25/2011 20:17'!
hash

	^self name hash bitXor: self class hash! !

!RGClassDescriptionDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 2/26/2011 12:02'!
instanceVariables: aCollection

	instanceVariables:= aCollection! !

!RGClassDescriptionDefinition methodsFor: 'printing' stamp: 'MarcusDenker 7/30/2014 10:39'!
storeOn: aStream
	aStream
		nextPutAll: '(';
		nextPutAll: self class name;
		nextPutAll: ' named: '.
	name storeOn: aStream.
	aStream nextPut: $)! !

!RGClassDescriptionDefinition methodsFor: 'instance variables' stamp: 'VeronicaUquillas 4/29/2011 09:24'!
instVarNames
	"Answer a collection of the names of the instance variables defined in the receiver."
	
	^instanceVariables collect:[ :ivar| ivar name ]! !

!RGClassDescriptionDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 11/16/2010 11:20'!
instanceVariables

	^instanceVariables! !

!RGClassDescriptionDefinition methodsFor: 'accessing' stamp: 'DamienCassou 4/29/2013 15:28'!
organization: aClassOrg
	"Install an instance of ClassOrganizer that represents the organization of the messages of the receiver."

	aClassOrg ifNotNil: [aClassOrg setSubject: self].
	organization := aClassOrg! !

!RGClassDescriptionDefinition methodsFor: 'private' stamp: 'VeronicaUquillas 4/29/2011 09:23'!
addVariable: aRGVariableDefinition in: aCollection
	"Adds a RGVariableDefinition in the collection received" 

	aCollection add: aRGVariableDefinition! !

!RGClassDescriptionDefinition methodsFor: 'instance variables' stamp: 'MartinDias 11/12/2013 18:51'!
instanceVariableNamed: aString
	^ instanceVariables 
		detect: [ :v | v name = aString asSymbol ] 
		ifNone: [ nil ]! !

!RGClassDescriptionDefinition methodsFor: 'instance variables' stamp: 'MarcusDenker 9/24/2014 16:39'!
addInstVarNamed: aString
	| var |
	var := ((self isMeta 
				ifTrue: [ RGClassInstanceVariableDefinition ]
				ifFalse:[  RGInstanceVariableDefinition ])
		named: aString) parent: self.
	self addVariable: var in: instanceVariables.
	^var! !

!RGClassDescriptionDefinition methodsFor: 'instance variables' stamp: 'VeronicaUquillas 2/19/2011 00:42'!
addInstanceVariables: aCollection
	
	aCollection do: [:var | self addInstVarNamed: var ]! !

!RGClassDescriptionDefinition methodsFor: '*NautilusCommon' stamp: 'BenjaminVanRyseghem 9/1/2011 14:39'!
extendingPackages

	^ self realClass extendingPackages! !

!RGClassDescriptionDefinition methodsFor: 'initialization' stamp: 'VeronicaUquillas 11/24/2010 14:00'!
initialize

	super initialize.
	instanceVariables:= OrderedCollection new.! !

!RGClassDescriptionDefinition methodsFor: 'comparing' stamp: 'VeronicaUquillas 5/11/2011 14:03'!
= aRGClassDefinition

	^self class = aRGClassDefinition class 
		and: [ self name = aRGClassDefinition name 
			and: [ self environment = aRGClassDefinition environment ] ]! !

!RGClassDescriptionDefinition methodsFor: 'instance variables' stamp: 'VeronicaUquillas 4/28/2011 21:30'!
addInstanceVariable: aRGVariableDefinition
	"aRGVariableDefinition is a instance variable or class instance variable"

	self addVariable: (aRGVariableDefinition parent: self)
		in: instanceVariables! !

!RGClassDescriptionDefinition methodsFor: 'private' stamp: 'VeronicaUquillas 4/29/2011 13:37'!
removeVariable: aRGVariableDefinition from: aCollection
	"Removes a variable from a particular collection.
	This behavior is the same for any kind of variable"
	aCollection remove: aRGVariableDefinition ifAbsent:[]! !

!RGClassDescriptionDefinition methodsFor: '*Manifest-Core' stamp: 'StephaneDucasse 11/29/2014 21:20'!
arrayStringForManifest
	| array |
	array := Array new: 2.
	array at: 1 put: self class asString asSymbol.
	array at: 2 put: {(name asSymbol)}.
	^ array! !

!RGClassDescriptionDefinition methodsFor: 'instance variables' stamp: 'VeronicaUquillas 4/29/2011 13:38'!
removeInstanceVariable: aRGVariableDefinition
	"aRGVariableDefinition is a instance variable or class instance variable"

	self removeVariable: aRGVariableDefinition from: instanceVariables! !

!RGClassDescriptionDefinition methodsFor: 'testing' stamp: 'MarcusDenker 10/7/2013 21:25'!
isSameRevisionAs: aRGClassDescriptionDefinition
	"This method look for equality of the properties of the receiver"
	"Instances variables are compared at the level of names but without any sorting"

	^(super isSameRevisionAs: aRGClassDescriptionDefinition)
		and:[ self instVarNames sort = aRGClassDescriptionDefinition instVarNames sort ]! !

!RGClassDescriptionDefinition methodsFor: 'organization' stamp: 'EstebanLorenzano 6/26/2013 18:16'!
organization
	"Answer the instance of ClassOrganizer that represents the organization 
	of the messages of the receiver."

	organization ifNil: [
		self organization: (ClassOrganization forClass: self) ].
	"Making sure that subject is set correctly. It should not be necessary."
	organization ifNotNil: [ organization setSubject: self ].
	^ organization! !

!RGClassDescriptionDefinition methodsFor: 'instance variables' stamp: 'VeronicaUquillas 4/29/2011 09:24'!
allInstanceVariables
	"Answer a collection of the receiver's instanceVariables, including those defined in its superclass"

	^self hasSuperclass 
		ifFalse:[ instanceVariables ]
		ifTrue:[ self superclass allInstanceVariables, instanceVariables ]! !

!RGClassDescriptionDefinition class methodsFor: '*manifest-core' stamp: 'SimonAllier 8/22/2012 16:30'!
manifestReadOn: aArray

	^ self named:( aArray first)! !

!RGClassInstanceVariableDefinition commentStamp: 'TorstenBergmann 2/12/2014 23:07'!
A class instance variable definition!
!RGClassInstanceVariableDefinition methodsFor: 'initialization' stamp: 'VeronicaUquillas 2/15/2011 15:47'!
initialize 

	super initialize.
	self isMetaSide: true.! !

!RGClassInstanceVariableDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 11/16/2010 14:46'!
isClassInstanceVariable

	^true! !

!RGClassVariableDefinition commentStamp: 'TorstenBergmann 2/12/2014 23:07'!
A class variable definition!
!RGClassVariableDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 11/16/2010 14:46'!
isClassVariable

	^true! !

!RGCommentDefinition commentStamp: 'VeronicaUquillas 5/6/2011 10:54'!
RGCommentDefinition is a first-class representation of class's comments!
!RGCommentDefinition methodsFor: 'to remove as soon as possible' stamp: 'VeronicaUquillas 9/3/2011 20:53'!
selector
	self flag: 'if comments are mixed with methods use #name instead'.
	^self name! !

!RGCommentDefinition methodsFor: 'type of comments' stamp: 'VeronicaUquillas 9/18/2011 14:44'!
isPassive

	"A ring comment isPassive by default.  In this case it will retrieve the data that was assigned in its creation"
	^(self annotationNamed: self class statusKey) 
		ifNil:[ true ] 
		ifNotNil:[ :status| status == #passive ]! !

!RGCommentDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 4/27/2011 10:42'!
stamp: anObject

	stamp:= anObject! !

!RGCommentDefinition methodsFor: 'type of comments' stamp: 'VeronicaUquillas 9/19/2011 16:53'!
fromActiveToHistorical
	"If the receiver was generated as an active comment, it can be converted to a historical one by reading the data of the real class (if exists)"
	
	self isActive ifTrue: [
		self asHistorical ]! !

!RGCommentDefinition methodsFor: 'source pointers' stamp: 'VeronicaUquillas 8/25/2011 14:33'!
sourcePointer
	"Retrieves the sourcePointer for this definition if exists"
	
	^self annotationNamed:  self class sourcePointerKey   ! !

!RGCommentDefinition methodsFor: 'to remove as soon as possible' stamp: 'VeronicaUquillas 9/3/2011 20:53'!
methodClass
	self flag: 'if comments are mixed with methods use #realClass instead'.
	^self realClass! !

!RGCommentDefinition methodsFor: 'type of comments' stamp: 'VeronicaUquillas 9/18/2011 14:46'!
asPassive

	"Sets the receiver as passive object, which will allow itself to retrieve its data that was assigned in its creation"
	self annotationNamed: self class statusKey put: #passive! !

!RGCommentDefinition methodsFor: 'stamp values' stamp: 'MarcusDenker 10/16/2013 13:44'!
author: aString 

	self annotationNamed: self class authorKey
			put: aString ! !

!RGCommentDefinition methodsFor: 'stamp values' stamp: 'VeronicaUquillas 6/28/2011 15:22'!
timeStamp: aTimestamp 

	self annotationNamed: self class timeStampKey
			put: aTimestamp ! !

!RGCommentDefinition methodsFor: 'converting' stamp: 'VeronicaUquillas 8/26/2011 11:27'!
asStringOrText

	| text |
	self realClass ifNil: [ ^self fullName ].
	text := self fullName asText.
	text addAttribute: TextEmphasis italic.
	^ text! !

!RGCommentDefinition methodsFor: 'type of comments' stamp: 'VeronicaUquillas 9/18/2011 14:44'!
isHistorical

	"A ring comment can be used to point an old version of the receiver, in this case it will use the sourcePointer to retrieve its information"
	^(self annotationNamed: self class statusKey) 
		ifNil:[ false ] 
		ifNotNil:[ :status| status == #historical ]! !

!RGCommentDefinition methodsFor: 'printing' stamp: 'VeronicaUquillas 9/1/2011 10:02'!
printOn: aStream 

	self parentName ifNotNil: [
		aStream nextPutAll: self parentName;
				  nextPutAll: ' ' ].
	aStream nextPutAll: self name! !

!RGCommentDefinition methodsFor: 'source pointers' stamp: 'VeronicaUquillas 9/18/2011 15:44'!
stampAtPointer
	"A RGMethodDefinition may be created to point the sourceFile in which case it retrieves the stamp"

	^ self sourcePointer notNil
		ifTrue: [ SourceFiles timeStampAt: self sourcePointer for: self commentDataPointers ]
		ifFalse:[ nil ]	! !

!RGCommentDefinition methodsFor: 'stamp values' stamp: 'VeronicaUquillas 9/19/2011 11:10'!
timeStamp 

	^ self annotationNamed: self class timeStampKey 
		ifAbsentPut: [ self class 
							parseTimestampFrom: self stamp 
							default: (DateAndTime epoch) ]! !

!RGCommentDefinition methodsFor: 'to remove as soon as possible' stamp: 'StephaneDucasse 8/21/2011 18:01'!
isValid
	"for compatibility with method definition"

	^ true! !

!RGCommentDefinition methodsFor: 'backward compatibility' stamp: 'VeronicaUquillas 8/25/2011 22:37'!
sourceCode

	^ self content   ! !

!RGCommentDefinition methodsFor: 'type of comments' stamp: 'VeronicaUquillas 9/18/2011 15:41'!
isActive

	"A ring comment isActive when it needs to access the class organization for retrieving its data"
	^(self annotationNamed: self class statusKey) 
		ifNil:[ false ] 
		ifNotNil:[ :status| status == #active ]! !

!RGCommentDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 7/18/2011 14:28'!
isSameRevisionAs: aRGCommentDefinition
	"This method look for equality of the properties of the receiver"
	"A comment validates only its contents and not its stamp"
	
	^(super isSameRevisionAs: aRGCommentDefinition)
		and:[ self content = aRGCommentDefinition content ]! !

!RGCommentDefinition methodsFor: 'testing' stamp: 'MarcusDenker 10/6/2012 14:57'!
isFromTrait
	^false! !

!RGCommentDefinition methodsFor: 'type of comments' stamp: 'MarcusDenker 9/12/2014 17:15'!
fromActiveToPassive
	"If the receiver was generated as an active comment, it can be converted to a passive one by reading the data of the real class organization"

	| realClass |
	self isActive
		ifFalse: [ ^ self ].
	realClass := self realClass.
	realClass notNil
		ifTrue: [ 
			self content: realClass organization classComment.
			self stamp: realClass organization commentStamp ].
	self asPassive! !

!RGCommentDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 4/27/2011 10:48'!
hasStamp

	^stamp isEmptyOrNil not

	! !

!RGCommentDefinition methodsFor: 'testing' stamp: 'MarcusDenker 10/16/2013 13:43'!
hasAuthor

	^self hasStamp and:[ self author isEmptyOrNil not ]! !

!RGCommentDefinition methodsFor: 'to remove as soon as possible' stamp: 'MarianoMartinezPeck 5/7/2012 11:31'!
category
	^self realClass category! !

!RGCommentDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 7/28/2011 10:13'!
fullName
	"Keeps a unique description for the receiver. As annotation to avoid converting each time is invoked"
	
	^self annotationNamed: self class fullNameKey
		ifAbsentPut:[ (self parentName, ' ', self name) asSymbol ]! !

!RGCommentDefinition methodsFor: 'type of comments' stamp: 'VeronicaUquillas 9/18/2011 15:40'!
asActive

	"Sets the receiver as active object, which will allow itself to retrieve its data from the class organization"
	self annotationNamed: self class statusKey put: #active.! !

!RGCommentDefinition methodsFor: 'source pointers' stamp: 'VeronicaUquillas 9/18/2011 15:44'!
contentAtPointer
	"A RGCommentDefinition may be created to point the sourceFile in which case it retrieves the class comment"

	^ self sourcePointer notNil
		ifTrue: [ SourceFiles sourceCodeAt: self sourcePointer ]
		ifFalse:[ '' ]! !

!RGCommentDefinition methodsFor: 'source pointers' stamp: 'VeronicaUquillas 8/25/2011 14:32'!
sourcePointer: aNumber

	self annotationNamed:  self class sourcePointerKey put: aNumber ! !

!RGCommentDefinition methodsFor: 'type of comments' stamp: 'MarcusDenker 7/5/2014 18:58'!
asHistorical

	"Sets the receiver as historical object, which will allow itself to retrieve its data using the sourcePointer"
	| realClass |
	self annotationNamed: self class statusKey put: #historical.
	self sourcePointer ifNil:[
		realClass := self realClass.
		realClass notNil ifTrue: [ 
			realClass organization commentRemoteString
				ifNotNil: [:str | self sourcePointer: str sourcePointer ] ] ]! !

!RGCommentDefinition methodsFor: 'stamp values' stamp: 'MarcusDenker 10/16/2013 13:44'!
author 

	^self annotationNamed: self class authorKey
		ifAbsentPut:[ self class parseAuthorAliasFrom: stamp ]! !

!RGCommentDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 9/19/2011 22:04'!
stamp
	"Retrieves the user-alias + timestamp associated to the receiver (if exists)"
	
	self isActive 
		ifTrue: [ ^ self realClass organization commentStamp ].
	self isHistorical
		ifTrue: [ ^ self stampAtPointer ifNil:[ self realClass ifNil:[ stamp ] ifNotNil:[ :rc| rc organization commentStamp ] ] ].	
	^ stamp! !

!RGCommentDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 9/19/2011 22:03'!
content

	self isActive 
		ifTrue: [ ^ self realClass organization classComment ].
	self isHistorical
		ifTrue: [ ^ self contentAtPointer ifNil:[ self realClass ifNil:[ content ] ifNotNil:[ :rc| rc organization classComment ] ] ].	
	^ content! !

!RGCommentDefinition methodsFor: 'source pointers' stamp: 'VeronicaUquillas 8/25/2011 14:41'!
commentDataPointers
	"Retrieves the combination key to look for information of the receiver in the source file"
	^'commentStamp:' -> #commentStamp:! !

!RGCommentDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 4/27/2011 10:41'!
isComment

	^true! !

!RGCommentDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 5/17/2011 09:57'!
isEmptyOrNil

	^content isEmptyOrNil ! !

!RGCommentDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 4/27/2011 16:02'!
content: anObject

	content:= anObject! !

!RGCommentDefinition methodsFor: 'comparing' stamp: 'VeronicaUquillas 8/25/2011 22:22'!
<= aRGCommentDefinition
	"Sort comment definition according to: 1) name of the class"
	
	^(self parentName <= aRGCommentDefinition parentName)! !

!RGCommentDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 8/26/2011 15:25'!
name

	^name ifNil:[ name := #Comment ]! !

!RGCommentDefinition class methodsFor: 'instance creation' stamp: 'VeronicaUquillas 9/18/2011 15:41'!
realClass: aClass
	"Creates a ring comment definition from a Smalltalk class"
	^(super realClass: aClass)
		asActive;
		yourself! !

!RGCommentDefinitionTest commentStamp: 'TorstenBergmann 2/12/2014 23:09'!
SUnit tests for comment definitions!
!RGCommentDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 8/1/2014 14:11'!
testNewComment
	| newComment |
	
	newComment:= RGCommentDefinition new
						content: 'This is a comment for test';
						stamp: 'VeronicaUquillas 3/22/2011 14:51';
						yourself.
	
	self assert: newComment isComment.
	self assert: newComment isPassive.
	self assert: newComment name = #Comment.
	self assert: newComment hasStamp.
	self assert: newComment hasAuthor.
	self assert: newComment timeStamp notNil.
	
	self assert: (newComment author = 'VeronicaUquillas').
	self assert: (newComment timeStamp = '3/22/2011 14:51' asDateAndTime).
	self assert: (newComment parent = nil).
	self assert: (newComment environment = Smalltalk globals).! !

!RGCommentDefinitionTest methodsFor: 'testing' stamp: 'VeronicaUquillas 8/26/2011 15:14'!
testingConversion
	
	| rgComm |
	rgComm := RGCommentDefinition realClass: RGClassDefinition.
	self assert: rgComm asStringOrText = 'RGClassDefinition Comment'.
	
	rgComm := RGCommentDefinition class: (RGClassDefinition named: #Foo).
	self assert: rgComm asStringOrText = 'Foo Comment'! !

!RGCommentDefinitionTest methodsFor: 'testing' stamp: 'VeronicaUquillas 9/19/2011 17:02'!
testActiveComment

	| rgComment |
	rgComment := RGCommentDefinition realClass: RGClassDefinition.
	self assert: rgComment isActive.
	self assert: rgComment sourcePointer isNil.
	self assert: rgComment content notNil.
	self assert: rgComment stamp notNil.
	rgComment content: ''.
	"it always reads from the organization and the previous changes was not commited"
	self assert: rgComment content ~= ''.
	
	rgComment fromActiveToPassive.
	self assert: rgComment isPassive.
	self assert: rgComment sourcePointer isNil.
	self assert: rgComment content notNil.
	self assert: rgComment stamp notNil.
	rgComment content: ''.
	self assert: rgComment content = ''.
	
	rgComment := RGCommentDefinition realClass: RGClassDefinition.
	rgComment fromActiveToHistorical.
	self assert: rgComment isHistorical.
	self assert: rgComment sourcePointer notNil.
	self assert: rgComment content notNil.
	self assert: rgComment stamp notNil.
	rgComment content: ''.
	"it always reads from the source file and the previous changes was not commited"
	self assert: rgComment content ~= ''! !

!RGCommentDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 8/1/2014 14:11'!
testCommentWithoutAuthor
	| newComment |
	
	newComment:= RGCommentDefinition new
						content: 'This is a comment for test';
						stamp: '3/22/2011 14:51';
						yourself.
	
	self assert: (newComment hasAuthor not).! !

!RGCommentDefinitionTest methodsFor: 'testing' stamp: 'VeronicaUquillas 9/18/2011 16:05'!
testCommentFromSourceFile
	| rgComment |
	
	rgComment := (RGCommentDefinition realClass: RGClassDefinition) asHistorical.
	self assert: rgComment isHistorical.
	self assert: rgComment sourcePointer notNil.
	self assert: rgComment content notNil.
	self assert: rgComment stamp notNil! !

!RGCommentDefinitionTest methodsFor: 'testing' stamp: 'VeronicaUquillas 8/25/2011 22:42'!
testSorting

	| rgComm1 rgComm2 |
	rgComm1 := RGCommentDefinition realClass: RGClassDefinition.
	rgComm2 := RGCommentDefinition realClass: RGElementDefinition.
	self assert: rgComm1 <= rgComm2! !

!RGContainer commentStamp: 'VeronicaUquillas 9/6/2011 16:12'!
A concrete container already knows how to treat classes, methods and packages. !
!RGContainer methodsFor: 'testing' stamp: 'VeronicaUquillas 9/6/2011 17:43'!
includesClassNamed: className
	"Returns true if the receiver includes the className in the defined classes"

	self flag: 'can a metaclass be stored without its nonMetaClass? Check this'.
	^self includesElementNamed: (self theNonMetaClassNameOf: className) in: self definedClasses.! !

!RGContainer methodsFor: 'utilities' stamp: 'VeronicaUquillas 9/6/2011 16:39'!
theNonMetaClassNameOf: aSymbol
	"Rejects the prefix ' class' or ' classTrait' of the argument"
	| index |
	
	index := aSymbol
				indexOfSubCollection: ' class'
				startingAt: 1
				ifAbsent: [ ^aSymbol asSymbol ].

	^(aSymbol 
		copyFrom: 1
		to: index - 1) asSymbol! !

!RGContainer methodsFor: 'convenient accesses' stamp: 'VeronicaUquillas 9/6/2011 17:20'!
traits
	"Retrieves a collection (by default a dictionary) containing only defined traits"

	^self definedClasses select:[ :each| each isTrait ]! !

!RGContainer methodsFor: 'lookup by name' stamp: 'VeronicaUquillas 7/27/2011 15:18'!
packageNamed: packageName
	"Look for a child package named packageName"
	
	^self elementNamed: packageName in: self packages! !

!RGContainer methodsFor: 'testing' stamp: 'VeronicaUquillas 7/27/2011 15:18'!
includesPackage: aRGPackage
	"Verifies if a child package == aRGPackage exists"
	
	^self packages includes: aRGPackage! !

!RGContainer methodsFor: 'initialization' stamp: 'VeronicaUquillas 9/7/2011 13:53'!
initialize

	super initialize.
	self definedClasses: IdentityDictionary new.
	self methods: IdentityDictionary new.
	self packages: IdentityDictionary new.! !

!RGContainer methodsFor: 'adding/removing' stamp: 'VeronicaUquillas 9/6/2011 15:08'!
withoutPackages
	
	self removeElementsCategorized: #packages! !

!RGContainer methodsFor: 'utilities' stamp: 'VeronicaUquillas 4/19/2011 14:11'!
isMetaclassName: aSymbol
	"Validates if the arguments corresponds to a nonMetaClass"
	
	^(aSymbol
		indexOfSubCollection: ' class'
		startingAt: 1) > 0! !

!RGContainer methodsFor: 'adding/removing' stamp: 'MarcusDenker 8/1/2014 14:05'!
addPackageNamed: packageName
	"adds a child package with the given name"

	(self includesPackageNamed: packageName) ifTrue: [ ^self ].
	self addPackage: (RGPackage named: packageName)! !

!RGContainer methodsFor: 'adding/removing' stamp: 'MarcusDenker 7/30/2014 21:37'!
addClassNamed: className 
	"Creates a class with the given name"
	self addClass: (RGClassDefinition named: className)! !

!RGContainer methodsFor: 'adding/removing' stamp: 'VeronicaUquillas 9/6/2011 17:23'!
addClass: aRGBehaviorDefinition
	"aRGBehaviorDefinition has to be a class, trait or metaclass"
	self flag: 'when i am adding a metaclass? check this?'.

	(aRGBehaviorDefinition isClass
		or:[ aRGBehaviorDefinition isTrait ]) ifFalse:[ ^self ].
	self addElement: aRGBehaviorDefinition in: self definedClasses! !

!RGContainer methodsFor: 'convenient accesses' stamp: 'VeronicaUquillas 9/6/2011 17:21'!
classNames
	"Retrieves class names (including traits)"
	
	^ self definedClasses isDictionary
		ifTrue: [ self definedClasses keys ]
		ifFalse:[ self definedClasses collect:[ :class|  class name ] ]! !

!RGContainer methodsFor: 'iterating' stamp: 'VeronicaUquillas 4/19/2011 14:13'!
methodsDo: aBlock

	self methods
		do:[ :each| aBlock value: each ]! !

!RGContainer methodsFor: 'adding/removing' stamp: 'VeronicaUquillas 4/28/2011 15:52'!
removeMethod: aRGMethodDefinition

	self removeElement: aRGMethodDefinition from: self methods! !

!RGContainer methodsFor: 'testing' stamp: 'VeronicaUquillas 4/19/2011 14:13'!
includesMethodNamed: fullSelectorName
	
	^self includesElementNamed: fullSelectorName in: self methods! !

!RGContainer methodsFor: 'adding/removing' stamp: 'VeronicaUquillas 9/6/2011 16:49'!
removeClass: aRGAbstractClassDefinition

	self removeElement: aRGAbstractClassDefinition from: self definedClasses! !

!RGContainer methodsFor: 'testing' stamp: 'VeronicaUquillas 9/6/2011 17:41'!
includesClass: aRGBehaviorDefinition
	"Returns true if the receiver includes aRGBehaviorDefinition in the defined classes"

	^self definedClasses includes: aRGBehaviorDefinition! !

!RGContainer methodsFor: 'adding/removing' stamp: 'VeronicaUquillas 9/6/2011 16:49'!
withoutClasses

	self removeElementsCategorized: #definedClasses! !

!RGContainer methodsFor: 'convenient accesses' stamp: 'VeronicaUquillas 9/6/2011 17:29'!
allClasses
	"convenient method"

	^self classes! !

!RGContainer methodsFor: 'image package loading' stamp: 'VeronicaUquillas 9/19/2011 14:22'!
cleanEmptyPackages

	(self packages select:[ :pck| pck classes size isZero and:[ pck methods size isZero ] ])
		do:[ :pck| self removePackage: pck ]! !

!RGContainer methodsFor: 'accessing' stamp: 'VeronicaUquillas 9/7/2011 13:50'!
methods
	"Retrieves methods defined in the container"
	
	^self elements at: #methods ifAbsentPut:[ IdentityDictionary new ]! !

!RGContainer methodsFor: 'accessing' stamp: 'VeronicaUquillas 7/27/2011 15:18'!
packages: aCollection

	self elementsCategorized: #packages with: aCollection! !

!RGContainer methodsFor: 'iterating' stamp: 'VeronicaUquillas 9/6/2011 17:39'!
traitsDo: aBlock

	self traits do: [ :each|
		aBlock value: each.
		each hasMetaclass
			ifTrue:[ aBlock value: each theMetaClass ] ]! !

!RGContainer methodsFor: 'image package loading' stamp: 'VeronicaUquillas 9/19/2011 16:49'!
findPackageOfMethod: aRGMethodDefinition using: packageKeys

	"Look for the package of an extension method. nil otherwise"
	| pair lname |	
	self packages isEmpty ifTrue: [ ^nil ].
	(aRGMethodDefinition protocol beginsWith: '*') ifFalse:[ ^ nil ].
	lname := aRGMethodDefinition protocol asLowercase.
 	pair := packageKeys detect:[ :assoc| self class category: lname matches: assoc value ] ifNone:[ nil ].
	^ pair ifNotNil:[ self packages at: pair key ]! !

!RGContainer methodsFor: 'convenient accesses' stamp: 'VeronicaUquillas 9/6/2011 17:30'!
allTraits
	"convenient method"
	
	^self allClasses select:[ :each | each isTrait ]! !

!RGContainer methodsFor: 'image package loading' stamp: 'StephaneDucasse 6/2/2012 20:42'!
loadPackagesFromImage

	| rgPackage rgPackageKeys |
	rgPackageKeys := OrderedCollection new.
	self class allManagers do: [ :pck | 
		rgPackage := RGPackage named: pck package name asSymbol.
		rgPackageKeys add: (rgPackage name -> ('*', rgPackage name asLowercase)).
		self addPackage: rgPackage ].
	^ rgPackageKeys! !

!RGContainer methodsFor: 'accessing' stamp: 'VeronicaUquillas 7/27/2011 15:20'!
methods: aCollection
	"Set the methods collection"
	
	self elements at: #methods put: aCollection! !

!RGContainer methodsFor: 'image class and method loading' stamp: 'VeronicaUquillas 9/19/2011 13:22'!
loadMethod: aRGMethodDefinition inClass: aRGBehaviorDefinition using: packageKeys

	self addMethod: aRGMethodDefinition.
	aRGBehaviorDefinition addMethod: aRGMethodDefinition.
	self setPackageOfMethod: aRGMethodDefinition ofClass: aRGBehaviorDefinition using: packageKeys! !

!RGContainer methodsFor: 'convenient accesses' stamp: 'VeronicaUquillas 9/6/2011 17:19'!
traitNames
	"Retrieves the names of defined traits"

	^ self traits isDictionary
		ifTrue: [ self traits keys ]
		ifFalse:[ self traits collect:[ :trait| trait name ] ]! !

!RGContainer methodsFor: 'adding/removing' stamp: 'VeronicaUquillas 7/27/2011 15:18'!
removePackage: aRGPackage
	"removes a child aRGPackage"

	aRGPackage isPackage ifFalse:[ ^self ].
	self removeElement: aRGPackage from: self packages! !

!RGContainer methodsFor: 'convenient accesses' stamp: 'VeronicaUquillas 9/6/2011 17:20'!
extensionMethods
	"Retrieves a collection (by default a dictionary) with the extensions methods of the receiver"

	^self methods values select:[ :mth| mth isExtension ]! !

!RGContainer methodsFor: 'testing' stamp: 'VeronicaUquillas 9/6/2011 17:22'!
hasClasses

	^self definedClasses notEmpty! !

!RGContainer methodsFor: 'adding/removing' stamp: 'VeronicaUquillas 4/28/2011 15:52'!
removeTrait: aRGTraitDefinition
	"convenient method"

	self removeClass: aRGTraitDefinition! !

!RGContainer methodsFor: 'adding/removing' stamp: 'MarcusDenker 7/30/2014 21:40'!
addTraitNamed: traitName 
	"Creates a trait with the given name"
	self addClass:  (RGTraitDefinition named: traitName)! !

!RGContainer methodsFor: 'iterating' stamp: 'VeronicaUquillas 9/6/2011 17:38'!
classesDo: aBlock

	self classes do: [ :each|
		aBlock value: each.
		each hasMetaclass
			ifTrue:[ aBlock value: each theMetaClass ] ]! !

!RGContainer methodsFor: 'adding/removing' stamp: 'VeronicaUquillas 4/28/2011 15:50'!
addTrait: aRGTraitDefinition
	"convenient method"

	self addClass: aRGTraitDefinition! !

!RGContainer methodsFor: 'testing' stamp: 'VeronicaUquillas 7/27/2011 15:18'!
includesPackageNamed: packageName
	"Verifies if a child package with name = packageName exists"
	
	^self includesElementNamed: packageName in: self packages! !

!RGContainer methodsFor: 'adding/removing' stamp: 'VeronicaUquillas 4/28/2011 15:50'!
addMethod: aRGMethodDefinition
	"aRGMethodDefinition needs to satisfy the status isMethod"

	aRGMethodDefinition isMethod ifFalse:[ ^self ].
	self addElement: aRGMethodDefinition in: self methods! !

!RGContainer methodsFor: 'accessing' stamp: 'VeronicaUquillas 9/6/2011 16:48'!
definedClasses: aCollection
	"Set the classes collection"

	self elements at: #definedClasses put: aCollection! !

!RGContainer methodsFor: 'image package loading' stamp: 'VeronicaUquillas 9/19/2011 16:49'!
findPackageOfClass: aRGBehaviorDefinition using: packageKeys

	"Look for the package of a class. It is nil when there is not a package created for a category in MC"
	| pair |
	self packages isEmpty ifTrue: [ ^ nil ].
	^ self packages at: aRGBehaviorDefinition category ifAbsent:[
		pair := packageKeys detect:[ :each| self class category: aRGBehaviorDefinition category matches: each key ] ifNone:[ nil ].
		pair ifNotNil:[ self packages at: pair key ] ]! !

!RGContainer methodsFor: 'image class and method loading' stamp: 'VeronicaUquillas 9/19/2011 13:47'!
loadClass: aRGBehaviorDefinition using: packageKeys

	self setPackageOfClass: aRGBehaviorDefinition using: packageKeys.
	self addClass: aRGBehaviorDefinition! !

!RGContainer methodsFor: 'accessing' stamp: 'VeronicaUquillas 9/7/2011 13:50'!
packages
	"Retrieves the children packages defined in the receiver"

	^self elements at: #packages ifAbsentPut:[ IdentityDictionary new ]! !

!RGContainer methodsFor: 'lookup by name' stamp: 'VeronicaUquillas 7/28/2011 16:59'!
classNamed: className
	"Retrieves an RGBehaviorDefinition object.
	className could be theMetaClass name"
	
	^self classOrTraitNamed: className! !

!RGContainer methodsFor: 'image class and method loading' stamp: 'MarcusDenker 10/7/2013 13:02'!
loadTraitUsers
	"Set the users of a trait"
	| users |
	
	users := self classes select: [ :cls | cls hasTraitComposition ].
	users do:[ :each |  | rgTrait |
		each traitNames do:[ :tname|
			rgTrait := self traitNamed: tname.
			rgTrait notNil ifTrue: [
				rgTrait addUser: each.
				rgTrait theMetaClass addUser: each theMetaClass ] ] ]! !

!RGContainer methodsFor: 'lookup by name' stamp: 'VeronicaUquillas 4/19/2011 14:13'!
methodNamed: fullSelectorName

	^self elementNamed: fullSelectorName in: self methods! !

!RGContainer methodsFor: 'testing' stamp: 'VeronicaUquillas 4/19/2011 14:13'!
hasMethods

	^self methods notEmpty! !

!RGContainer methodsFor: 'iterating' stamp: 'VeronicaUquillas 7/29/2011 10:48'!
allClassesDo: aBlock
	"Evaluate the argument, aBlock, for each class and its metaclass"

	self allClasses do: [ :each|
		aBlock value: each.
		each hasMetaclass
			ifTrue:[ aBlock value: each theMetaClass ] ]! !

!RGContainer methodsFor: 'image package loading' stamp: 'VeronicaUquillas 9/19/2011 13:14'!
setPackageOfMethod: rgMethod ofClass: rgClass using: packageKeys
	"Set the package to aRGMethodDefinition and its value isExtension"

	(self findPackageOfMethod: rgMethod using: packageKeys) 
		ifNil:[ rgClass package ifNotNil:[ :pck| 
				pck addMethod: rgMethod.
				rgMethod isExtension: false ] ]
		ifNotNil:[ :pck| 
			pck addMethod: rgMethod.
			rgMethod isExtension: (rgMethod package ~= rgClass package) ]! !

!RGContainer methodsFor: 'adding/removing' stamp: 'VeronicaUquillas 7/27/2011 15:18'!
addPackage: aRGPackage
	"adds a child package"

	aRGPackage isPackage ifFalse:[ ^self ].
	self addElement: aRGPackage in: self packages! !

!RGContainer methodsFor: 'iterating' stamp: 'VeronicaUquillas 7/29/2011 10:48'!
allTraitsDo: aBlock
	"Evaluate the argument, aBlock, for each trait"

	self allTraits do: [ :each|
		aBlock value: each.
		each hasMetaclass
			ifTrue:[ aBlock value: each theMetaClass ] ]! !

!RGContainer methodsFor: 'lookup by name' stamp: 'VeronicaUquillas 7/28/2011 16:30'!
traitNamed: traitName
	"Retrieves an RGTraitDefinition object.
	traitName could be theMetaClass name"
	| trait |
	
	^(trait:= self classOrTraitNamed: traitName) isTrait
	ifTrue:[ trait ]
	ifFalse:[ nil ]! !

!RGContainer methodsFor: 'testing' stamp: 'VeronicaUquillas 4/28/2011 15:49'!
includesMethod: aRGMethodDefinition

	^self methods includes: aRGMethodDefinition! !

!RGContainer methodsFor: 'image package loading' stamp: 'VeronicaUquillas 9/19/2011 13:11'!
setPackageOfClass: rgClass using: packageKeys
	"Set the package to aRGBehaviorDefinition"

	(self findPackageOfClass: rgClass using: packageKeys) 
		ifNotNil:[ :pck| pck addClass: rgClass ]
	! !

!RGContainer methodsFor: 'adding/removing' stamp: 'VeronicaUquillas 4/19/2011 14:23'!
withoutMethods
	
	self removeElementsCategorized: #methods! !

!RGContainer methodsFor: 'accessing' stamp: 'VeronicaUquillas 9/7/2011 13:50'!
definedClasses
	"Retrieves classes (traits are included)"

	^self elements at: #definedClasses ifAbsentPut:[ IdentityDictionary new ]! !

!RGContainer methodsFor: 'convenient accesses' stamp: 'VeronicaUquillas 9/6/2011 16:50'!
classes
	"convenient method"

	^self definedClasses! !

!RGContainer methodsFor: 'convenient accesses' stamp: 'VeronicaUquillas 10/10/2011 21:15'!
classes: aCollection
	"convenient method"

	self definedClasses: aCollection! !

!RGContainer methodsFor: 'iterating' stamp: 'VeronicaUquillas 9/6/2011 17:37'!
definedClassesDo: aBlock

	self definedClasses do: [ :each|
		aBlock value: each.
		each hasMetaclass
			ifTrue:[ aBlock value: each theMetaClass ] ]! !

!RGContainer methodsFor: 'lookup by name' stamp: 'VeronicaUquillas 9/6/2011 17:21'!
classOrTraitNamed: className
	"A class or metaclass can be reached by its name"
	| theClass |

	className ifNil: [^nil ].
	theClass:= self elementNamed: (self theNonMetaClassNameOf: className) in: self definedClasses.
	theClass ifNil:[ ^nil ].
	
	^(self isMetaclassName: className)
		ifTrue: [ theClass theMetaClass ]
		ifFalse:[ theClass ] ! !

!RGContainer methodsFor: 'lookup by name' stamp: 'VeronicaUquillas 4/19/2011 14:11'!
metaclassNamed: metaclassName
	| theClass |
	
	theClass:= (self classOrTraitNamed: metaclassName).
	theClass notNil
	ifTrue:[ ^theClass isMeta 
		      ifTrue: [ theClass ]
		      ifFalse:[ theClass theMetaClass ] ].
	
	^nil! !

!RGContainer methodsFor: 'convenient accesses' stamp: 'VeronicaUquillas 8/8/2011 10:21'!
allMethods
	"convenient method"

	^self methods! !

!RGContainer class methodsFor: 'image package loading' stamp: 'StephaneDucasse 6/2/2012 19:46'!
packageNames

	^ self allManagers collect: [ :pck | pck package name asSymbol ]! !

!RGContainer class methodsFor: 'image package loading' stamp: 'VeronicaUquillas 9/19/2011 16:38'!
packageOfMethod: aRGMethodDefinition

	^ self packageOfMethod: aRGMethodDefinition using: self packageKeys! !

!RGContainer class methodsFor: 'image package loading' stamp: 'PavelKrivanek 11/13/2012 10:47'!
allManagers

	^ Smalltalk globals at: #MCWorkingCopy 
		ifPresent: [:mcwc | mcwc allManagers ] 
		ifAbsent: [OrderedCollection new ]
! !

!RGContainer class methodsFor: 'image package loading' stamp: 'StephaneDucasse 6/2/2012 19:47'!
packageKeys

	^ self allManagers collect: [ :pck | pck package name asSymbol -> ('*', pck package name asLowercase) ]! !

!RGContainer class methodsFor: 'image package loading' stamp: 'VeronicaUquillas 9/19/2011 14:55'!
category: categoryName matches: prefix

	| prefixSize catSize |
	categoryName ifNil: [ ^false ].
	catSize := categoryName size.
	prefixSize := prefix size.
	catSize < prefixSize ifTrue: [ ^false ].
	(categoryName findString: prefix startingAt: 1 caseSensitive: true) = 1
		ifFalse: [ ^false ].
	^(categoryName at: prefix size + 1 ifAbsent: [ ^true ]) = $-! !

!RGContainer class methodsFor: 'image package loading' stamp: 'VeronicaUquillas 9/19/2011 16:50'!
packageOfMethod: aRGMethodDefinition using: packageKeys

	"Looks for the package of aRGMethodDefinition from the image"
	| pName parentPackage |
	(aRGMethodDefinition protocol notNil and:[ aRGMethodDefinition protocol beginsWith: '*' ]) ifFalse:[
		parentPackage := (aRGMethodDefinition parent ifNotNil:[ aRGMethodDefinition parent package ]).	
		^ parentPackage ifNil:[ self packageOfClass: aRGMethodDefinition parent ] ].

	aRGMethodDefinition protocol ifNil: [ ^ nil ].
	pName := (packageKeys 
				detect: [ :each| self category: aRGMethodDefinition protocol asLowercase matches: each value ] ifNone:[ nil ]).
	^ pName ifNotNil:[ RGPackage named: pName key ]! !

!RGContainer class methodsFor: 'image package loading' stamp: 'VeronicaUquillas 9/19/2011 16:50'!
packageOfClass: aRGBehaviorDefinition using: packageNames

	"Looks for the package of aRGBehaviorDefinition from the image"
	| pName |
	aRGBehaviorDefinition ifNil:[ ^nil ].
	pName := (packageNames 
				detect: [ :each| each = aRGBehaviorDefinition category ]
				ifNone: [ packageNames detect:[ :each| self category: aRGBehaviorDefinition category matches: each ] ifNone:[ nil ] ]).
	^ pName ifNotNil:[ RGPackage named: pName ]! !

!RGContainer class methodsFor: 'image package loading' stamp: 'VeronicaUquillas 9/19/2011 16:38'!
packageOfClass: aRGBehaviorDefinition

	^ self packageOfClass: aRGBehaviorDefinition using: self packageNames.! !

!RGContainerTest commentStamp: 'TorstenBergmann 2/12/2014 23:08'!
SUnit tests for container!
!RGContainerTest methodsFor: '*Ring-Tests-Monticello' stamp: 'VeronicaUquillas 9/19/2011 15:57'!
testRetrievingPackages
	| rgClass rgMethod |
	
	rgClass := OrderedCollection asRingDefinition.
	rgClass package: (RGContainer packageOfClass: rgClass).
	self assert: rgClass package name = #'Collections-Sequenceable'.
	
	rgMethod := (RGMethodDefinition realClass: Class selector: #asRingDefinition).
	rgMethod package: (RGContainer packageOfMethod: rgMethod).
	self assert: rgMethod parent isNil.
	self assert: rgMethod package name = #'Ring-Core-Kernel'.

	rgMethod := (RGMethodDefinition realClass: OrderedCollection selector: #size).
	rgMethod package: (RGContainer packageOfMethod: rgMethod).
	self assert: rgMethod package isNil.

	rgMethod := (RGMethodDefinition class: rgClass selector: #size).
	rgMethod package: (RGContainer packageOfMethod: rgMethod).
	self assert: rgMethod parent notNil.
	self assert: rgMethod package notNil.
	self assert: rgMethod package = rgClass package! !

!RGDefinition commentStamp: 'MarcusDenker 9/30/2014 10:03'!
I am the root class of the Ring meta-model.
A Ring definition has a name, can be annotated and knows its environment!
!RGDefinition methodsFor: 'annotations' stamp: 'VeronicaUquillas 7/19/2011 14:21'!
annotationNamed: annotationName put: value 

	self annotations
		at: annotationName
		put: value! !

!RGDefinition methodsFor: 'testing types' stamp: 'VeronicaUquillas 3/20/2011 16:55'!
isMethod

	^false! !

!RGDefinition methodsFor: 'testing types' stamp: 'VeronicaUquillas 5/12/2011 13:42'!
isOrganization 

	^false! !

!RGDefinition methodsFor: 'annotations' stamp: 'VeronicaUquillas 11/25/2010 17:25'!
annotationNamed: annotationName ifAbsent: exceptionBlock 
	"Answer the value of the annotation named <annotationName>. If the 
	annotation is not defined for the receiver, answer the result of 
	evaluating the <exceptionBlock>."

	self hasAnnotations
		ifFalse: [ ^exceptionBlock value ].

	^self annotations
			at: annotationName
			ifAbsent: [ exceptionBlock value ]! !

!RGDefinition methodsFor: 'annotations' stamp: 'VeronicaUquillas 11/25/2010 17:26'!
removeAnnotationNamed: annotationName 
	"Remove the annotation named <annotationName>. Fails quietly if there 
	is no annotation with the given name."
	
	(self hasAnnotationNamed: annotationName)
		ifTrue:[ annotations removeKey: annotationName ]! !

!RGDefinition methodsFor: 'accessing' stamp: 'MarcusDenker 9/25/2014 13:55'!
environment
	"If the receiver has not namespace assigned the default is used"
	"self class environment = Smalltalk globals"

	^ self annotationNamed: #environment ifAbsent: [ self class environment ]! !

!RGDefinition methodsFor: 'testing types' stamp: 'VeronicaUquillas 5/17/2011 12:50'!
isReference 

	^false! !

!RGDefinition methodsFor: 'testing types' stamp: 'VeronicaUquillas 5/17/2011 12:49'!
isInvocation

	^false! !

!RGDefinition methodsFor: 'accessing' stamp: 'MarcusDenker 9/25/2014 13:55'!
environment: namespace

	namespace = self class environment
		ifFalse:[ self annotationNamed: #environment put: namespace ]! !

!RGDefinition methodsFor: 'testing types' stamp: 'VeronicaUquillas 5/17/2011 12:49'!
isInheritance

	^false! !

!RGDefinition methodsFor: 'annotations' stamp: 'VeronicaUquillas 3/22/2011 16:41'!
annotationNamed: annotationName ifAbsentPut: blockValue 

	^self annotations
		at: annotationName
		ifAbsentPut: blockValue! !

!RGDefinition methodsFor: 'testing types' stamp: 'VeronicaUquillas 3/20/2011 16:54'!
isVariable

	^false! !

!RGDefinition methodsFor: 'accessing' stamp: 'MarcusDenker 9/25/2014 13:55'!
rootEnvironment
	"Retrieves the runtime environment of an RGObject"
	"If the receiver is defined in an RGContainer the runtime environment is the one associated to its container"
	| parent |
	
	parent:= self environment.
	[ parent isRingObject ]
		whileTrue:[ parent:= parent environment ].

	^parent! !

!RGDefinition methodsFor: 'testing types' stamp: 'VeronicaUquillas 3/20/2011 17:56'!
isSlice

	^false! !

!RGDefinition methodsFor: 'annotations' stamp: 'VeronicaUquillas 11/25/2010 17:25'!
hasAnnotationNamed: annotationName
	"Answer <true> if the receiver contains the annotation named <annotationName>. "
	
	self hasAnnotations	
		ifFalse:[ ^false ].
	^annotations includesKey: annotationName! !

!RGDefinition methodsFor: 'annotations' stamp: 'VeronicaUquillas 11/25/2010 17:25'!
annotationNamed: annotationName 
	"Answer the value of the annotation named <annotationName>, or 
	nil if the annotation is not defined for the receiver."
	
	^ self
		annotationNamed: annotationName
		ifAbsent: [ nil ]! !

!RGDefinition methodsFor: 'accessing' stamp: 'MarcusDenker 9/29/2014 16:09'!
fullName

	^self name! !

!RGDefinition methodsFor: 'testing types' stamp: 'VeronicaUquillas 4/14/2011 16:32'!
isRingObject

	^true! !

!RGDefinition methodsFor: 'testing types' stamp: 'VeronicaUquillas 3/20/2011 16:54'!
isPackage

	^false! !

!RGDefinition methodsFor: 'annotations' stamp: 'VeronicaUquillas 11/25/2010 17:25'!
annotationNames
	
	self hasAnnotations
		ifFalse:[ ^OrderedCollection new ].
	^annotations keys! !

!RGDefinition methodsFor: 'annotations' stamp: 'VeronicaUquillas 11/25/2010 17:25'!
hasAnnotations

	^annotations notNil! !

!RGDefinition methodsFor: 'testing types' stamp: 'VeronicaUquillas 5/17/2011 12:50'!
isAccess 

	^false! !

!RGDefinition methodsFor: 'testing types' stamp: 'VeronicaUquillas 4/19/2011 15:57'!
isNamespace

	^false! !

!RGDefinition methodsFor: 'accessing' stamp: 'MarcusDenker 9/29/2014 16:09'!
name: anObject
	"a symbol or a string should be expected"
	
	name:= anObject! !

!RGDefinition methodsFor: 'testing types' stamp: 'VeronicaUquillas 4/27/2011 10:40'!
isComment

	^false! !

!RGDefinition methodsFor: 'annotations' stamp: 'VeronicaUquillas 6/28/2011 15:16'!
annotations

	^annotations ifNil:[ annotations:= IdentityDictionary new ]! !

!RGDefinition methodsFor: 'converting' stamp: 'MarcusDenker 9/25/2014 13:55'!
asRingDefinition
	^ self! !

!RGDefinition methodsFor: 'testing types' stamp: 'VeronicaUquillas 5/17/2011 15:07'!
isAssociation

	^false! !

!RGDefinition methodsFor: 'testing types' stamp: 'VeronicaUquillas 4/19/2011 15:57'!
isGlobalVariable

	^false! !

!RGDefinition methodsFor: 'testing types' stamp: 'VeronicaUquillas 4/19/2011 15:57'!
isPool

	^false! !

!RGDefinition methodsFor: 'accessing' stamp: 'MarcusDenker 9/29/2014 16:09'!
name

	^name! !

!RGDefinition class methodsFor: 'annotations' stamp: 'MarcusDenker 9/29/2014 16:09'!
fullNameKey

	^#fullName! !

!RGDefinition class methodsFor: 'annotations' stamp: 'MarcusDenker 9/29/2014 16:09'!
timeStampKey

	^#timestamp! !

!RGDefinition class methodsFor: 'annotations' stamp: 'MarcusDenker 9/29/2014 16:09'!
authorKey

	^#author! !

!RGDefinition class methodsFor: 'class initialization' stamp: 'MarcusDenker 9/29/2014 16:09'!
named: aName

	^self new
		name: aName asSymbol;
		yourself! !

!RGElementDefinition commentStamp: 'StephaneDucasse 7/26/2011 14:02'!
RGElementDefinition is the abstract class for representing elements of a class-alike definition (i.e., methods, variables, comment).

parent holds the RGClassDefinition or RGMetaclassDefinition defining this element.
	
	
Now a RingEntityDefinition offers two APIs: one that is generic and works for all the source code entities and this is the one we just 
presented: parent, parentName and realParent. Having such interface is important to build generic tools that could manipulate 
any entities in a polymorphic way (yes no isKindOf: everywhere).

In addition, a ring method definition offers a specific interface that should only be used when you know that you are solely manipulate
specific entity such as class element: method definition, class comment, and variables. 

Here is the equivalence table

	realParent 				realClass
	parent					ringClass
	parentName			className
	
For example for a methodDefinition we will have the following:

GENERIC API
------------------
* To access the ring class definition name, use parentName
	aRGMethodDefinition parentName
	
Example:
	(Point>>#dist:) asRingDefinition parentName
		->  #Point
		
* If you have a complete model where classes and methods are ring definition, to access the ring class definition , use parent
	aRGMethodDefinition parent
	
Example:
	aRGMethodDefinition(Point>>#dist:) parent
		->  aRGClassDefinition(Point)
		
* If you want to access the smalltalk class that contains the compiledMethod that is represented by a ringMethodDefinition, use realParent
	aRGMethodDefinition realParent
	
Example:
	(Point>>#dist:) asRingDefinition realParent
		->  Point
		


CLASS Element specific API
------------------------------------------
* The message class returns the class of the object :). Yes as you see we could not use class and className because class is already used to refer to the class of the object.

Example:
	(Point>>#dist:) asRingDefinition class
		->  RingMethodDefinition
		
* The message className returns the name of the ring class defining the reingMethodDefinition.

Example:
	(Point>>#dist:) asRingDefinition className
		->  #Point		
		
* If you have a complete model where classes and methods are ring definition, to access the ring class definition , use parent
	aRGMethodDefinition ringClass
	
Example:
	aRGMethodDefinition(Point>>#dist:) ringClass
		->  aRGClassDefinition(Point)
		
		
* If you want to access the smalltalk class that contains the compiledMethod that is represented by a ringMethodDefinition, use realClass
	aRGMethodDefinition realClass
	
Example:
	(Point>>#dist:) asRingDefinition realClass
		->  Point

!
!RGElementDefinition methodsFor: 'generic parent api' stamp: 'StephaneDucasse 7/26/2011 14:00'!
parent: aRGBehaviorDefinition
	"Set the class associated to the receiver"

	parent := aRGBehaviorDefinition.
	self setParentInfo: aRGBehaviorDefinition.! !

!RGElementDefinition methodsFor: 'comparing' stamp: 'VeronicaUquillas 8/31/2011 19:34'!
hash
	"Hash is re-implemented because #= is re-implemented"
	
	^self class hash bitXor: (self parentName hash bitXor: self isMetaSide hash)! !

!RGElementDefinition methodsFor: 'accessing' stamp: 'StephaneDucasse 7/26/2011 14:01'!
isMetaSide: aBoolean

	self annotationNamed: self class isMetaSideKey put: aBoolean! !

!RGElementDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 9/1/2011 15:50'!
fullName: aString

	^ self annotationNamed: self class fullNameKey put: aString asSymbol! !

!RGElementDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 7/19/2011 14:21'!
isDefined
	"isDefined when the receiver has its realClass defined in the system"

	^self realClass notNil! !

!RGElementDefinition methodsFor: 'generic parent api' stamp: 'StephaneDucasse 7/26/2011 14:01'!
parentName
	"Retrieves the name of the class defining the receiver. Its value is kept as an annotation"

	^ self annotationNamed: self class classNameKey! !

!RGElementDefinition methodsFor: 'private' stamp: 'VeronicaUquillas 8/16/2011 14:33'!
setParentInfo: anObject
	"anObject is aRGBehaviorDefinition or aClass/aTrait"

	self parentName: anObject name. 
	self isMetaSide: anObject isMeta! !

!RGElementDefinition methodsFor: 'generic parent api' stamp: 'VeronicaUquillas 5/4/2011 13:19'!
theNonMetaParentName
	"Rejects the prefix ' class' or ' classTrait' of the parentName"
	| index |
	
	index := self parentName
				indexOfSubCollection: ' class'
				startingAt: 1
				ifAbsent: [ ^self parentName ].

	^(self parentName 
		copyFrom: 1
		to: index - 1) asSymbol! !

!RGElementDefinition methodsFor: 'class element specific api' stamp: 'StephaneDucasse 7/26/2011 14:02'!
realClass
	"Retrieves the Class/Trait/.. object in the System corresponding to the class of the this element."
	
	^ self realParent! !

!RGElementDefinition methodsFor: 'generic parent api' stamp: 'VeronicaUquillas 8/31/2011 17:31'!
parentName: aString

	self annotationNamed: self class classNameKey put: aString asSymbol! !

!RGElementDefinition methodsFor: 'tools' stamp: 'MarcusDenker 7/30/2014 17:15'!
browse

	^ Smalltalk tools browser fullOnClass: self realClass! !

!RGElementDefinition methodsFor: 'class element specific api' stamp: 'StephaneDucasse 7/26/2011 14:02'!
className
	
	^ self parentName! !

!RGElementDefinition methodsFor: 'accessing' stamp: 'StephaneDucasse 7/26/2011 14:01'!
isMetaSide
	"Even thought several class elements do not define this property (ie. class variables, pool variables) they understand it"
	"This is a derived property from the class definining the receiver and thus its value is kept as an annotation"
	"Default value is false"

	^self annotationNamed: self class isMetaSideKey ifAbsentPut: [ false ]! !

!RGElementDefinition methodsFor: 'backward compatibility' stamp: 'VeronicaUquillas 9/1/2011 15:07'!
actualClass
	"returns the Smalltalk class of the receiver"
	
	^ self realClass! !

!RGElementDefinition methodsFor: 'comparing' stamp: 'VeronicaUquillas 8/31/2011 19:22'!
= aRGElementDefinition
	"This method look for equality of the properties of the receiver"
	"Verifies the class and the parentName of the receiver"

	^self class = aRGElementDefinition class
		and:[ self parentName == aRGElementDefinition parentName 
			and:[ self isMetaSide = aRGElementDefinition isMetaSide ] ]! !

!RGElementDefinition methodsFor: 'class element specific api' stamp: 'VeronicaUquillas 8/25/2011 22:47'!
theNonMetaClassName

	^self theNonMetaParentName ! !

!RGElementDefinition methodsFor: 'class element specific api' stamp: 'StephaneDucasse 7/26/2011 14:21'!
className: aName
	
	^ self parentName: aName! !

!RGElementDefinition methodsFor: 'generic parent api' stamp: 'StephaneDucasse 7/26/2011 13:58'!
realParent
	"Retrieves the Class/Trait/.. object in the System corresponding to the class of the this element."
	
	^self parent notNil
		ifTrue: [ self parent realClass ]
		ifFalse: [ self rootEnvironment classNamed: self parentName ]! !

!RGElementDefinition methodsFor: 'generic parent api' stamp: 'StephaneDucasse 7/26/2011 14:00'!
parent
	"The parent of a class definition element: method, comment and variable is the class definition. This method retrieves the class that defines such element"
	
	^ parent! !

!RGElementDefinition methodsFor: 'accessing' stamp: 'LeoGassman 11/7/2013 12:25'!
package
	^self parent package ! !

!RGElementDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 7/18/2011 14:28'!
isSameRevisionAs: aRGElementDefinition
	"This method look for equality of the properties of the receiver"
	"Verifies the class and the parentName of the receiver"

	^self class = aRGElementDefinition class
		and:[ self parentName == aRGElementDefinition parentName ]! !

!RGElementDefinition methodsFor: 'class element specific api' stamp: 'StephaneDucasse 7/26/2011 13:59'!
ringClass
	"Return the ring definition of the class containing the receiver."
	
	^ self parent! !

!RGElementDefinition class methodsFor: 'elements-annotations' stamp: 'VeronicaUquillas 6/28/2011 15:17'!
isMetaSideKey

	^#isMetaSide! !

!RGElementDefinition class methodsFor: 'class initialization' stamp: 'VeronicaUquillas 8/16/2011 14:37'!
class: aRGBehaviorDefinition
	"The argument is a ring object and serves as the parent of a method, variable or class comment"

	^self new
		parent: aRGBehaviorDefinition;
		yourself! !

!RGElementDefinition class methodsFor: 'elements-annotations' stamp: 'VeronicaUquillas 9/17/2011 18:04'!
statusKey

	^#statusKey! !

!RGElementDefinition class methodsFor: 'class initialization' stamp: 'LeoGassman 11/7/2013 12:24'!
realClass: aClass
	"The argument is a Smalltalk class and the parent of a method, variable, class comment.
	However it is not set as parent but only its name and scope (instance/class)"

	^self new
		parent: aClass asRingDefinition;
		yourself! !

!RGElementDefinition class methodsFor: 'parsing stamp' stamp: 'VeronicaUquillas 5/9/2011 14:19'!
parseAuthorAliasFrom: aString
	"Allows other applications  to treat a different empty alias by overriding this method"
	
	^self basicParseAuthorAliasFrom: aString! !

!RGElementDefinition class methodsFor: 'parsing stamp' stamp: 'MarcusDenker 9/12/2014 17:14'!
parseTimestampFrom: aString default: anObject
	"Parse a date-time from a timestamp-string that is extracted from a source file. If there is no timestamp, or we cannot make sense of it, we return the default value."

	| tokens dateStartIndex unknown |
	"The following timestamp strings are supported (source: squeak sources archeological survey):
		<authorname><date><time>. 
		<authorname><date>
		<date><time>
		<date><time><authorname>
		<date><authorname>
		<historical>
	All fields can be separated by spaces or line ends but a separator between authorname and date can be missing as well"
	unknown := anObject.
	aString isEmptyOrNil
		ifTrue: [ ^ unknown ].
	dateStartIndex := (aString indexOf: $/) - 1.	"If there is no / character in the timestamp, we cannot parse a date and return the epoch"
	dateStartIndex = -1
		ifTrue: [ ^ unknown ].
	^ [ 
	"Go the start of the date string (there can be 1 or 2 digits and a space separator can be missing at the front!!!!)"
	(dateStartIndex >= 2 and: [ (aString at: dateStartIndex - 1) isDigit ])
		ifTrue: [ dateStartIndex := dateStartIndex - 1 ].	"Extract only those tokens that possibly represent date or time"
	tokens := (aString copyFrom: dateStartIndex to: aString size) substrings
		select: [ :token | (token occurrencesOf: $/) = 2 or: [ (token occurrencesOf: $:) = 1 ] ].	"2 tokens is a datetime"
	tokens size = 2
		ifTrue: [ (tokens joinUsing: Character space) asDateAndTime ]
		ifFalse: [ tokens first asDate asDateAndTime ] ]
		on: Exception
		do: [ :e | unknown ]! !

!RGElementDefinition class methodsFor: 'parsing stamp' stamp: 'VeronicaUquillas 5/12/2011 19:58'!
parseTimestampFrom: aString
	
	^self parseTimestampFrom: aString default: nil! !

!RGElementDefinition class methodsFor: 'elements-annotations' stamp: 'VeronicaUquillas 8/25/2011 22:09'!
sourcePointerKey 

	^#sourcePointer! !

!RGElementDefinition class methodsFor: 'parsing stamp' stamp: 'MarcusDenker 9/12/2014 17:14'!
basicParseAuthorAliasFrom: aString
	"Parse an alias/name of the author from a string that is extracted from a source file. If there is no alias/name we return emtpy string."

	| tokens dateStartIndex unknown |
	"The following timestamp strings are supported (source: squeak sources archeological survey):
		<authorname><date><time>. 
		<authorname><date>
		<date><time>
		<date><time><authorname>
		<date><authorname>
		<historical>
	All fields can be separated by spaces or line ends but a separator between author alias/name and date can be missing as well"
	"unknown:= 'unknown'."
	unknown := nil.
	aString isEmptyOrNil
		ifTrue: [ ^ unknown ].
	dateStartIndex := (aString indexOf: $/) - 1.	"If there is no / character in the timestamp, no author alias/name exists"
	dateStartIndex = -1
		ifTrue: [ ^ unknown ].
	^ [ 
	"Go the start of the date string (there can be 1 or 2 digits and a space separator can be missing at the front!!!!)"
	(dateStartIndex >= 2 and: [ (aString at: dateStartIndex - 1) isDigit ])
		ifTrue: [ dateStartIndex := dateStartIndex - 1 ].	"Extract only those tokens that do not possible represent date or time - meaning that authorname may be at the end"
	tokens := (aString copyFrom: dateStartIndex to: aString size) substrings
		reject: [ :token | (token occurrencesOf: $/) = 2 or: [ (token occurrencesOf: $:) = 1 ] ].	"only one token should be left if author name/alias exists"
	^ tokens isEmpty
		ifTrue: [ 
			"if dateStartIndex is not 1 then the authorname may be at the beginning"
			dateStartIndex > 1
				ifTrue: [ (aString copyFrom: 1 to: dateStartIndex - 1) trimBoth ]
				ifFalse: [ unknown ] ]
		ifFalse: [ tokens first ] ]
		on: Exception
		do: [ :e | unknown ]! !

!RGElementDefinition class methodsFor: 'elements-annotations' stamp: 'VeronicaUquillas 6/28/2011 15:17'!
classNameKey

	^#className! !

!RGGlobalDefinition commentStamp: 'VeronicaUquillas 4/19/2011 15:52'!
An RGGlobalDefinition is an abstract superclass for representing classes, global variables and shared pools
!
!RGGlobalDefinition methodsFor: 'comparing' stamp: 'VeronicaUquillas 8/2/2011 13:32'!
= aRGGlobalDefinition
	"This method look for equality of the properties of the receiver"
	"Verifies the class and the name of the receiver"

	^self class = aRGGlobalDefinition class
		and:[ self name == aRGGlobalDefinition name ]! !

!RGGlobalDefinition methodsFor: 'comparing' stamp: 'VeronicaUquillas 8/2/2011 13:32'!
hash
	"Hash is re-implemented because #= is re-implemented"
	
	^self class hash bitXor: (self name hash)! !

!RGGlobalDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 4/15/2011 14:58'!
parent
	"Retrieves the namespace in which the receiver is known"
	
	^self environment! !

!RGGlobalDefinitionTest commentStamp: 'TorstenBergmann 2/12/2014 23:09'!
SUnit tests for global definitions (pools, global variables)!
!RGGlobalDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 8/1/2014 14:19'!
testGlobalVariableDefinition
	| global  |
	
	global:= RGGlobalVariableDefinition named:  #Transcript.
	self assert: (global isGlobalVariable).
	self assert: (global parent = Smalltalk globals).! !

!RGGlobalDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 8/1/2014 14:19'!
testEquality
	| global1 global2 |
	
	global1 := RGGlobalVariableDefinition named: #Transcript.
	global2 := RGGlobalVariableDefinition named: #Transcript.
	self assert: global1 = global2.
	
	global2 := RGGlobalVariableDefinition named: #Transcript2.
	self deny: global1 = global2.! !

!RGGlobalDefinitionTest methodsFor: 'testing' stamp: 'VincentBlondeau 3/6/2015 16:43'!
testPoolDefinition
	| pool newClass |
	pool := RGClassDefinition createSharedPoolNamed: #TextConstants.
	self assert: pool isPool.
	self assert: pool users isEmpty.
	self assert: pool parent equals: Smalltalk globals.
	newClass := RGClassDefinition named: #OrderedCollection.
	pool addUser: newClass.
	self assert: pool users size equals: 1.
	self assert: (pool includesUser: newClass).
	self assert: (newClass sharedPoolNamed: #TextConstants) isPoolVariable.
	pool := RGClassDefinition named: #TextConstants.
	pool superclassName: #SharedPool.
	self assert: pool isPool.
	self assert: pool users isEmpty! !

!RGGlobalVariableDefinition commentStamp: 'TorstenBergmann 2/12/2014 23:08'!
A global variable definition!
!RGGlobalVariableDefinition methodsFor: 'managing container' stamp: 'VeronicaUquillas 5/9/2011 15:33'!
isIncludedInContainer: aRGContainer

	^aRGContainer includesGlobalVariable: self! !

!RGGlobalVariableDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 8/2/2011 13:32'!
value
	"Retrieves the current value of the global variable"

	^ value! !

!RGGlobalVariableDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 7/29/2011 09:46'!
value: anObject

	value := anObject! !

!RGGlobalVariableDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 4/13/2011 16:31'!
isGlobalVariable

	^true! !

!RGGlobalVariableDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 4/14/2011 10:03'!
isVariable

	^true! !

!RGGlobalVariableDefinition methodsFor: 'managing container' stamp: 'VeronicaUquillas 5/9/2011 15:33'!
addInContainer: aRGContainer

	aRGContainer addGlobalVariable: self! !

!RGGlobalVariableDefinition methodsFor: 'managing container' stamp: 'VeronicaUquillas 5/9/2011 15:33'!
removeFromContainer: aRGContainer

	aRGContainer removeGlobalVariable: self! !

!RGInstanceVariableDefinition commentStamp: 'TorstenBergmann 2/12/2014 23:07'!
An instance variable definition!
!RGInstanceVariableDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 11/16/2010 14:46'!
isInstanceVariable

	^true! !

!RGMetaclassDefinition commentStamp: 'VeronicaUquillas 4/19/2011 16:05'!
RGMetaclassDefinition is a concrete representation of metaclasses of classes (traits are excluded)!
!RGMetaclassDefinition methodsFor: 'printing' stamp: ''!
storeOn: aStream
	
	aStream nextPut: $(. 
	super storeOn: aStream.
	aStream nextPutAll: ' baseClass:'.
	self theNonMetaClass storeOn: aStream.
	aStream nextPut: $).
	
! !

!RGMetaclassDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 4/20/2011 17:34'!
baseClass: aRGClassDefinition

	baseClass:= aRGClassDefinition.
	self name: (baseClass name, ' class') asSymbol! !

!RGMetaclassDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 11/17/2010 15:52'!
isMeta

	^true! !

!RGMetaclassDefinition methodsFor: 'accessing' stamp: 'NicolaiHess 9/17/2014 00:14'!
category
	^ self theNonMetaClass category! !

!RGMetaclassDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 9/16/2011 17:07'!
realClass

	^baseClass realClass theMetaClass! !

!RGMetaclassDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 5/11/2011 11:38'!
environment

	^baseClass environment! !

!RGMetaclassDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 11/17/2010 14:43'!
theMetaClass

	^self! !

!RGMetaclassDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 3/3/2011 10:03'!
package

	^baseClass package! !

!RGMetaclassDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 11/17/2010 14:42'!
theNonMetaClass

	^baseClass! !

!RGMetaclassDefinition methodsFor: '*Manifest-Core' stamp: 'StephaneDucasse 11/29/2014 21:20'!
arrayStringForManifest
	| array |
	array := Array new: 2.
	array at: 1 put: self class asString asSymbol.
	array
		at: 2
		put:
			{(name asSymbol).
			(self theNonMetaClass asSymbol)}.
	^ array! !

!RGMetaclassDefinition methodsFor: 'variables' stamp: 'VeronicaUquillas 2/26/2011 13:51'!
allClassVarNames

	^self theNonMetaClass allClassVarNames! !

!RGMetaclassDefinition methodsFor: 'variables' stamp: 'MartinDias 10/28/2013 16:17'!
allSharedPoolNames

	^self theNonMetaClass allSharedPoolNames! !

!RGMetaclassDefinition methodsFor: '*NautilusCommon' stamp: 'BenjaminVanRyseghem 8/29/2011 21:23'!
inheritsFrom: aClass

	^ self realClass inheritsFrom: aClass! !

!RGMetaclassDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 7/18/2011 14:32'!
isSameRevisionAs: aRGMetaclassDefinition
	"This method look for equality of the properties of the receiver"

	^(super isSameRevisionAs: aRGMetaclassDefinition)
		and:[ self traitCompositionSource = aRGMetaclassDefinition traitCompositionSource ]! !

!RGMetaclassDefinition class methodsFor: 'class initialization' stamp: 'VeronicaUquillas 2/15/2011 22:05'!
class: anORClassDefinition

	^self new
		baseClass: anORClassDefinition;
		yourself! !

!RGMetaclassDefinition class methodsFor: '*Manifest-Core' stamp: 'SimonAllier 7/26/2012 15:57'!
manifestReadOn: aArray

	^ (self named:( aArray at:1))
		baseClass: ( aArray at:2)! !

!RGMetaclassDefinitionTest commentStamp: 'NicolaiHess 9/16/2014 23:54'!
SUnit tests for Ring metaclass definitions!
!RGMetaclassDefinitionTest methodsFor: 'testing' stamp: 'NicolaiHess 9/17/2014 00:10'!
testAsMetaclassDefinition
	| rgClass class |
	class := Class class.
	rgClass:= class asRingDefinition.
	
	self assert: (rgClass isRingObject).
	self assert: (rgClass isClass).  
	self assert: (rgClass name == #'Class class').  
	self assert: (rgClass category == class category).
	self assert: (rgClass theMetaClass == rgClass).
! !

!RGMetatraitDefinition commentStamp: 'VeronicaUquillas 4/19/2011 16:04'!
RGMetatraitDefinition is a concrete representation of metaclasses of traits!
!RGMetatraitDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 11/24/2010 22:32'!
theMetaClass

	^self! !

!RGMetatraitDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 4/20/2011 17:35'!
baseClass: anRGTraitDefinition

	baseClass:= anRGTraitDefinition.
	self name: (baseClass name, ' classTrait') asSymbol! !

!RGMetatraitDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 11/17/2010 15:52'!
isMeta

	^true! !

!RGMetatraitDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 3/3/2011 10:03'!
package

	^baseClass package! !

!RGMetatraitDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 12/2/2010 18:09'!
theNonMetaClass

	^baseClass! !

!RGMetatraitDefinition methodsFor: 'accessing' stamp: 'NicolaiHess 9/16/2014 23:53'!
category
	^ self theNonMetaClass category! !

!RGMetatraitDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 9/16/2011 17:07'!
realClass

	^baseClass realClass theMetaClass! !

!RGMetatraitDefinition methodsFor: 'testing' stamp: 'StephaneDucasse 7/19/2011 10:26'!
isSameRevisionAs: aRGMetatraitDefinition
	"This method look for equality of the properties of the receiver"

	^(super isSameRevisionAs: aRGMetatraitDefinition)
		and: [ self traitCompositionSource = aRGMetatraitDefinition traitCompositionSource ]! !

!RGMetatraitDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 5/11/2011 11:38'!
environment

	^baseClass environment! !

!RGMetatraitDefinition class methodsFor: 'class initialization' stamp: 'VeronicaUquillas 2/15/2011 23:15'!
class: anORTraitDefinition

	^self new
		baseClass: anORTraitDefinition;
		yourself! !

!RGMetatraitDefinitionTest commentStamp: 'NicolaiHess 9/17/2014 00:02'!
SUnit tests for Ring classtrait definitions!
!RGMetatraitDefinitionTest methodsFor: 'testing' stamp: 'NicolaiHess 9/17/2014 00:13'!
testAsClassTraitfinition
	| rgCTrait cTrait |
	cTrait := TClass classTrait.
	rgCTrait := cTrait asRingDefinition.
	self assert: rgCTrait isRingObject.
	self assert: rgCTrait isTrait.
	self assert: rgCTrait name == #'TClass classTrait'.
	self assert: rgCTrait category == cTrait category.
	self assert: rgCTrait theMetaClass == rgCTrait! !

!RGMethodDefinition commentStamp: 'VeronicaUquillas 9/18/2011 16:00'!
RGMethodDefinition is a concrete representation of methods. It can be used to build browser for methods that are not in the image. It is polymorphic with CompiledMethod. 

* We can ask a RGMethodDefinition for its selector using the selector message.
Example:
	(Point>>#dist:) asRingDefinition selector
		-> #dist

We can also ask the ring object representation of its class or the Smalltalk class actually implementing the corresponding compiledMethod. 

* To access the ring class definition name, use parentName
	aRGMethodDefinition parentName
	
Example:
	(Point>>#dist:) asRingDefinition parentName
		->  #Point
		
* If you have a complete model where classes and methods are ring definition, to access the ring class definition , use parent
	aRGMethodDefinition parent
	
Example:
	aRGMethodDefinition(Point>>#dist:) parent
		->  aRGClassDefinition(Point)
		
* If you want to access the smalltalk class that contains the compiledMethod that is represented by a ringMethodDefinition, use realParent
	aRGMethodDefinition realParent
	
Example:
	(Point>>#dist:) asRingDefinition realParent
		->  Point
		

Now a RingEntityDefinition offers two APIs: one that is generic and works for all the source code entities and this is the one we just 
presented: parent, parentName and realParent. Having such interface is important to build generic tools that could manipulate 
any entities in a polymorphic way (yes no isKindOf: everywhere).

In addition, a ring method definition offers a specific interface that should only be used when you know that you are solely manipulate
specific entity such as class element: method definition, class comment, and variables. 

Here is the equivalence table

	realParent 				realClass
	parent					ringClass
	parentName			className


* The message class returns the class of the object :).

Example:
	(Point>>#dist:) asRingDefinition class
		->  RingMethodDefinition
		
* The message className returns the name of the ring class defining the reingMethodDefinition.

Example:
	(Point>>#dist:) asRingDefinition className
		->  #Point		
		
* If you have a complete model where classes and methods are ring definition, to access the ring class definition , use parent
	aRGMethodDefinition ringClass
	
Example:
	aRGMethodDefinition(Point>>#dist:) ringClass
		->  aRGClassDefinition(Point)
		
		
* If you want to access the smalltalk class that contains the compiledMethod that is represented by a ringMethodDefinition, use realClass
	aRGMethodDefinition realClass
	
Example:
	(Point>>#dist:) asRingDefinition realClass
		->  Point

!
!RGMethodDefinition methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 12/1/2014 23:50'!
gtInspectorImplementorsIn: composite
	<gtInspectorPresentationOrder: 4>
	composite list 
		title: 'Implementors';
		display: [ self compiledMethod implementors ]! !

!RGMethodDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 3/21/2011 17:51'!
isMethod

	^true! !

!RGMethodDefinition methodsFor: 'testing' stamp: 'DamienCassou 4/29/2013 15:41'!
isOverridden
	^ self compiledMethod isOverridden! !

!RGMethodDefinition methodsFor: 'type of methods' stamp: 'VeronicaUquillas 9/18/2011 15:38'!
isPassive

	"A ring method isPassive when it retrieves the data that was assigned in its creation.
	By default is passive"
	^(self annotationNamed: self class statusKey) 
		ifNil:[ true ] 
		ifNotNil:[ :status| status == #passive ]! !

!RGMethodDefinition methodsFor: 'accessing' stamp: 'StephaneDucasse 8/12/2011 11:53'!
stamp: anObject
	"stores an author alias and a timestamp"
	
	stamp := anObject! !

!RGMethodDefinition methodsFor: 'type of methods' stamp: 'VeronicaUquillas 9/19/2011 15:43'!
fromActiveToHistorical
	"If the receiver was generated as an active method, it can be converted to a historical one by reading the data of the compiled method (if exists)"
	
	self isActive ifTrue: [
		self asHistorical ]! !

!RGMethodDefinition methodsFor: 'source pointers' stamp: 'VeronicaUquillas 6/28/2011 15:22'!
sourcePointer
	"Retrieves the sourcePointer for this definition if exists"
	
	^self annotationNamed:  self class sourcePointerKey   ! !

!RGMethodDefinition methodsFor: '*NautilusCommon' stamp: 'CamilloBruni 9/14/2012 00:41'!
isOverride
	| selector |
	selector := self selector.
	self methodClass allSuperclassesDo: [:each | 
		(each includesSelector: selector)
			ifTrue: [ ^ true ]].
	^ false! !

!RGMethodDefinition methodsFor: 'tools' stamp: 'BenjaminVanRyseghem 2/8/2012 17:10'!
browse

	^ Smalltalk tools browser
		fullOnClass: self realClass 
		selector: (self isDefined ifTrue: [ self selector ] ifFalse: [ nil ])! !

!RGMethodDefinition methodsFor: 'managing container' stamp: 'VeronicaUquillas 4/20/2011 17:35'!
removeFromContainer: aRGContainer

	aRGContainer removeMethod: self! !

!RGMethodDefinition methodsFor: 'type of methods' stamp: 'abc 9/18/2011 16:24'!
asPassive

	"Sets the receiver as passive object, which will allow itself to retrieve its data that was assigned in its creation"
	self annotationNamed: self class statusKey put: #passive! !

!RGMethodDefinition methodsFor: 'stamp values' stamp: 'StephaneDucasse 8/12/2011 11:57'!
timeStamp: aTimestamp 

	self annotationNamed: self class timeStampKey put: aTimestamp ! !

!RGMethodDefinition methodsFor: 'source pointers' stamp: 'StephaneDucasse 5/13/2012 21:37'!
filePosition
	
	^SourceFiles filePositionFromSourcePointer: self sourcePointer! !

!RGMethodDefinition methodsFor: 'source pointers' stamp: 'StephaneDucasse 5/15/2012 13:12'!
fileIndex
	^SourceFiles fileIndexFromSourcePointer: self sourcePointer! !

!RGMethodDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 4/20/2011 17:35'!
package: aRGPackage

	package:= aRGPackage! !

!RGMethodDefinition methodsFor: 'stamp values' stamp: 'MarcusDenker 10/16/2013 13:44'!
author: aString 

	self annotationNamed: self class authorKey put: aString ! !

!RGMethodDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 4/14/2011 12:40'!
package
	"Retrieves the package in which this class is contained, if exists"
	
	^package! !

!RGMethodDefinition methodsFor: '*Manifest-Core' stamp: 'StephaneDucasse 11/29/2014 21:18'!
arrayStringForManifest
	| array |
	array := Array new:2.
	array at: 1 put:  (self class asString asSymbol).
	array at: 2 put: {self parentName asSymbol.  self selector asSymbol. self isMetaSide asString  asSymbol}.
	^ array 
	 ! !

!RGMethodDefinition methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 12/1/2014 23:49'!
gtInspectorSourceIn: composite
	<gtInspectorPresentationOrder: 00>
	^ composite smalltalkCode 
		title: 'Source';
		smalltalkClass: [ self methodClass ];
		display: [ self sourceCode ];
		act: [ :text | self methodClass compile: text text notifying: nil ]
			icon: GLMUIThemeExtraIcons glamorousAccept
			on: $s
			entitled: 'Accept';
		act: [ self browse ] 
			icon: GLMUIThemeExtraIcons glamorousBrowse 
			entitled: 'Browse'! !

!RGMethodDefinition methodsFor: 'stamp values' stamp: 'VeronicaUquillas 9/19/2011 11:06'!
timeStamp 

	^self annotationNamed: self class timeStampKey 
		ifAbsentPut: [ self class 
							parseTimestampFrom: self stamp 
							default: (DateAndTime epoch) ]! !

!RGMethodDefinition methodsFor: '*Ring-Monticello' stamp: 'StephaneDucasse 12/28/2012 16:56'!
asMCMethodDefinition
   "Creates a MCMethodDefinition from the receiver"
	| cached |
	cached := MCMethodDefinition cachedDefinitions
		at: self compiledMethod
		ifAbsent: [nil ].
	"we compare that the cached version is in sync with the version 
	the receiver represents because it is an identity structure and the container (here the method definition may have changed internally: different packages, protocol.... )"
	(cached notNil and: [ self sameAsMCDefinition: cached  ])
		ifFalse: [  MCMethodDefinition cachedDefinitions 
					at: self put: (cached := self basicAsMCMethodDefinition) ].
	^ cached! !

!RGMethodDefinition methodsFor: 'type of methods' stamp: 'VeronicaUquillas 9/18/2011 15:39'!
isActive

	"A ring method isActive when it needs to access the compiledMethod for retrieving its data"
	^(self annotationNamed: self class statusKey) 
		ifNil:[ false ] 
		ifNotNil:[ :status| status == #active ]! !

!RGMethodDefinition methodsFor: 'managing container' stamp: 'VeronicaUquillas 4/20/2011 17:35'!
addInContainer: aRGContainer

	aRGContainer addMethod: self
	! !

!RGMethodDefinition methodsFor: '*Ring-Monticello' stamp: 'CamilloBruni 2/28/2012 14:28'!
asMCMethodDefinitionFromFile: file
	"Creates a MCMethodDefinition from a source file assuming the current metod isActive.
	This is significantly faster than the asMCMethodDefinition as it does not open the source file pointer twice; for the sourceCode and the timeStamp"
	| compiledMethod methodClass|
	compiledMethod := self compiledMethod.
	methodClass := compiledMethod methodClass.
	
   ^ MCMethodDefinition
		className: methodClass theNonMetaClass name
 	   	classIsMeta: methodClass isMeta
		selector: compiledMethod selector
		category: compiledMethod category
		timeStamp:( compiledMethod timeStampFromFile: file)
		source: (compiledMethod getSourceFromFile: file)! !

!RGMethodDefinition methodsFor: 'type of methods' stamp: 'MarcusDenker 9/12/2014 17:16'!
fromActiveToPassive
	"If the receiver was generated as an active method, it can be converted to a passive one by reading the data of the compiled method (if exists)"

	| compiledMethod |
	self isActive
		ifFalse: [ ^ self ].
	compiledMethod := self compiledMethod.
	compiledMethod notNil
		ifTrue: [ 
			self protocol: compiledMethod category.
			self sourceCode: compiledMethod sourceCode.
			self stamp: compiledMethod timeStamp ].
	self asPassive! !

!RGMethodDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 3/19/2011 17:10'!
hasStamp

	^stamp isEmptyOrNil not! !

!RGMethodDefinition methodsFor: 'managing container' stamp: 'VeronicaUquillas 4/20/2011 17:35'!
isIncludedInContainer: aRGContainer

	^aRGContainer includesMethod: self! !

!RGMethodDefinition methodsFor: 'operations' stamp: 'MarcusDenker 7/21/2014 16:40'!
recompile
	self method recompile! !

!RGMethodDefinition methodsFor: 'backward compatibility' stamp: 'StephaneDucasse 8/21/2011 19:10'!
category

	^ self protocol! !

!RGMethodDefinition methodsFor: 'accessing' stamp: 'StephaneDucasse 8/12/2011 11:52'!
fullName
	"Keeps a unique description for the receiver. As annotation to avoid converting each time is invoked"
	
	^self annotationNamed: self class fullNameKey
		ifAbsentPut: [ (self parentName, '>>', self selector) asSymbol ]! !

!RGMethodDefinition methodsFor: 'testing' stamp: 'StephaneDucasse 8/12/2011 11:57'!
isDefined
	"Answer whether the receiver exists in the environment"
	
	| rClass |
	self selector isDoIt ifTrue:[ ^false ].
	rClass := self realClass.
	^rClass notNil and: [ rClass includesSelector: self selector ]! !

!RGMethodDefinition methodsFor: '*NautilusCommon' stamp: 'CAMILLETERUEL 3/29/2013 11:52'!
containsHalt
	
	^ self literals includesAnyOf: #(halt halt: halt:onCount: haltIf: haltIfNil haltIfShiftPressed haltOnCount: haltOnce)! !

!RGMethodDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 8/21/2011 19:09'!
isLocalSelector
	"Answer whether the receiver exists in the environment as a local implementation"
	
	| rClass |
	rClass:= self realClass.
	^rClass notNil and: [ rClass includesLocalSelector: self selector ]! !

!RGMethodDefinition methodsFor: 'accessing' stamp: 'StephaneDucasse 8/12/2011 11:53'!
selector: aSymbol
	"The name of a method is known as #selector"

	name := aSymbol! !

!RGMethodDefinition methodsFor: 'accessing' stamp: 'StephaneDucasse 8/12/2011 11:52'!
compiledMethod
	"Retrieves the compiled method of this definition if exists"
	
	| rClass |
	(rClass := self realClass) notNil
		ifTrue: [ (rClass includesSelector: self selector)
			ifTrue: [ ^rClass >> self selector ] ].
			
	^nil! !

!RGMethodDefinition methodsFor: '*NautilusCommon' stamp: 'BenjaminVanRyseghem 2/14/2012 20:28'!
containsShouldBeImplemented

	^ self literals includes: #shouldBeImplemented! !

!RGMethodDefinition methodsFor: '*NautilusCommon' stamp: 'vincentBlondeau 12/12/2014 14:21'!
correspondingMethods
	" retrieve methods that could be the corresponding method "

	self isTestMethod
		ifTrue: [ 
			self methodClass isTestCase
				ifTrue: [ 
					| classSymbol correspondingClass correspondingSel className selector |
					selector := self selector.
					className := self methodClass name.
					(selector beginsWith: 'test') ifFalse: [ ^ #() ].
					classSymbol := (className endsWith: 'Test')
						ifTrue: [ className allButLast: 4]
						ifFalse: [ className ]. 
					correspondingClass := self class environment at: classSymbol asSymbol ifAbsent: [ ^ #() ].
					correspondingSel := (selector allButFirst: 4) transformSelectorForComparison.
					^ correspondingClass selectors
						select: [ :each | each asLowercase = correspondingSel asLowercase or: [ each asLowercase = (correspondingSel , ':') asLowercase ] ]
						thenCollect: [ :each | correspondingClass >> each ] ]
				ifFalse: [ ^ #() ] ]
		ifFalse: [ ^ {self} ]! !

!RGMethodDefinition methodsFor: 'type of methods' stamp: 'VeronicaUquillas 9/19/2011 15:42'!
asHistorical

	"Sets the receiver as historical object, which will allow itself to retrieve its data using the sourcePointer"
	self annotationNamed: self class statusKey put: #historical.
	self sourcePointer ifNil:[ | pointer compiledMethod |
		pointer := 0.
		compiledMethod := self compiledMethod.
		compiledMethod notNil ifTrue: [
			pointer := compiledMethod sourcePointer ].
		pointer isZero
			ifFalse:[ self sourcePointer: pointer ] ]! !

!RGMethodDefinition methodsFor: '*NautilusCommon' stamp: 'NicolaiHess 12/29/2013 23:00'!
isTestMethod

    ^ (self methodClass inheritsFrom: TestCase) and: [ 
		((self selector beginsWith: 'test') 
			or: [ (self selector beginsWith: 'should')]) and: [ self numArgs isZero ] ]! !

!RGMethodDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 9/19/2011 22:02'!
stamp

	self isActive 
		ifTrue: [ ^ self compiledMethod timeStamp ].
	self isHistorical
		ifTrue: [ ^ self stampAtPointer ifNil:[ self compiledMethod ifNil:[ stamp ] ifNotNil:[ :cm| cm timeStamp ] ] ].
	^ stamp! !

!RGMethodDefinition methodsFor: '*NautilusCommon' stamp: 'MarcusDenker 11/22/2014 16:02'!
correspondingTestMethod
	self isTestMethod
		ifTrue: [ ^ self ]
		ifFalse: [ 
			| sel testClass |
			sel := (self selector endsWith: ':')
				ifTrue: [ self selector copyReplaceAll: ':' with: '' asLowercase ]
				ifFalse: [ self selector asLowercase ].
			(sel beginsWith: 'test')
				ifFalse: [ sel := 'test' , sel ].
			^ (testClass := self methodClass correspondingForTest) = self methodClass
				ifTrue: [ nil ]
				ifFalse: [ (testClass methods detect: [ :each | each selector asLowercase = sel ] ifNone: [ nil ]) asRingDefinition ] ]! !

!RGMethodDefinition methodsFor: 'backward compatibility' stamp: ''!
symbolic

	^ self method symbolic! !

!RGMethodDefinition methodsFor: '*NautilusCommon' stamp: 'BenjaminVanRyseghem 9/1/2011 09:40'!
literals
	
	"bad code but I do not know how to properly retrieve the good compiled method using a RGMethodDefinition"


	^ self compiledMethod literals.! !

!RGMethodDefinition methodsFor: 'traits' stamp: 'MarcusDenker 3/24/2011 14:51'!
isBinarySelector
	^self selector
		allSatisfy: [:each | each isSpecial]! !

!RGMethodDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 4/28/2011 15:54'!
selector
	"Retrieves the name of the method"

	^name! !

!RGMethodDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 9/22/2011 15:53'!
isExtension
	"The receiver is an extension when is defined in a different package to the one of its parent.
	Ring allows to set this property. If not assigned tries to find its value "
	
	^self 
		annotationNamed: self class isExtensionKey
		ifAbsent: [  
			(self parent notNil and:[ self package notNil ])
				ifTrue: [ | value |
					       value :=  self parent package ~= self package.
						 self annotationNamed: self class isExtensionKey put: value.
						 value ]
				ifFalse: [ self protocol ifNil:[ false ] ifNotNil:[ :prot|  prot beginsWith: '*' ] ] ]! !

!RGMethodDefinition methodsFor: 'accessing' stamp: 'CamilloBruni 9/22/2012 21:19'!
origin
	"Return the real oring of this method."
	^ self compiledMethod 
		ifNil: [ self methodClass ]
		ifNotNil: [ :compileMethod| compileMethod origin ]! !

!RGMethodDefinition methodsFor: '*System-Support' stamp: 'CamilloBruni 1/30/2013 21:34'!
senders
	
	^ SystemNavigation default allSendersOf: self selector! !

!RGMethodDefinition methodsFor: 'accessing' stamp: 'StephaneDucasse 8/12/2011 11:53'!
isExtension: aBoolean
	"Explicitily set that the receiver is an extension"
	
	self annotationNamed: self class isExtensionKey put: aBoolean ! !

!RGMethodDefinition methodsFor: 'backward compatibility' stamp: 'StephaneDucasse 8/9/2011 17:42'!
methodClass
	"Return the class to which the receiver belongs to."
	
	^ self realClass! !

!RGMethodDefinition methodsFor: 'source pointers' stamp: 'VeronicaUquillas 9/18/2011 15:44'!
protocolAtPointer

	"A RGMethodDefinition that was set as historical will retrieve the protocol using the sourcePointer"

	^ self sourcePointer notNil
		ifTrue: [ SourceFiles protocolAt: self sourcePointer ]
		ifFalse:[ nil ]! !

!RGMethodDefinition methodsFor: 'conversion' stamp: 'MarcusDenker 9/12/2014 17:14'!
asStringOrText

	| text |
	self realClass ifNil: [ ^self fullName ].
	text := (self fullName,' {', (self protocol ifNil: ['']), '} ') asText.
	self isLocalSelector
		ifFalse: [ text addAttribute: TextEmphasis italic ].
	^ text! !

!RGMethodDefinition methodsFor: 'type of methods' stamp: 'VeronicaUquillas 9/18/2011 14:44'!
isHistorical

	"A ring method can be used to point an old version of the receiver, in this case it will use the sourcePointer to retrieve its information"
	^(self annotationNamed: self class statusKey) 
		ifNil:[ false ] 
		ifNotNil:[ :status| status == #historical ]! !

!RGMethodDefinition methodsFor: 'printing' stamp: 'CamilloBruni 1/23/2013 12:20'!
printOn: aStream 

	self parentName ifNotNil: [
		aStream nextPutAll: self parentName;
				  nextPutAll: '>>' ].
	aStream print: self selector! !

!RGMethodDefinition methodsFor: 'source pointers' stamp: 'VeronicaUquillas 9/18/2011 15:45'!
stampAtPointer	

	"A RGMethodDefinition that was set as historical will retrieve the stamp using the sourcePointer"

	^ self sourcePointer notNil
		ifTrue: [ SourceFiles timeStampAt: self sourcePointer ]
		ifFalse:[ nil ]! !

!RGMethodDefinition methodsFor: 'backward compatibility' stamp: 'BenjaminVanRyseghem 3/26/2012 13:23'!
messages

	^ self method messages! !

!RGMethodDefinition methodsFor: 'source pointers' stamp: 'MartinDias 10/28/2013 15:12'!
getPreambleFrom: aFileStream at: position
	^ SourceFiles getPreambleFrom: aFileStream at: position! !

!RGMethodDefinition methodsFor: '*Ring-Monticello' stamp: 'MarcusDenker 7/17/2014 16:51'!
sameAsMCDefinition: anMCMethodDefinition

	^ anMCMethodDefinition selector = self selector 
			and: [ anMCMethodDefinition className = self className
			and: [ anMCMethodDefinition classIsMeta = self isMetaSide 
			and: [ anMCMethodDefinition category = self protocol ]]]

				! !

!RGMethodDefinition methodsFor: 'to remove as soon as possible' stamp: 'StephaneDucasse 8/21/2011 18:00'!
isValid
	"verifies that the receiver is locally defined in the class and that is not a DoIt"

	^self isDefined! !

!RGMethodDefinition methodsFor: 'accessing' stamp: 'MarcusDenker 5/6/2013 11:00'!
sourceCode

	self isActive 
		ifTrue: [ ^ self compiledMethod ifNil:[ sourceCode ] ifNotNil: [ self compiledMethod sourceCode ]].
	self isHistorical
		ifTrue: [ ^ self sourceCodeAtPointer ifNil:[ self compiledMethod ifNil:[ sourceCode ] ifNotNil:[ :cm| cm sourceCode ] ] ].	
	^ sourceCode! !

!RGMethodDefinition methodsFor: '*Deprecated40' stamp: 'MarcusDenker 7/17/2014 16:53'!
classSymbol
	self deprecated: 'use className' on: '17 July 2014'  in: 'Pharo4'.
	^ self className! !

!RGMethodDefinition methodsFor: 'accessing' stamp: 'StephaneDucasse 8/12/2011 11:53'!
protocol: anObject

	protocol := anObject! !

!RGMethodDefinition methodsFor: 'source pointers' stamp: 'VeronicaUquillas 9/18/2011 15:45'!
sourceCodeAtPointer

	"A RGMethodDefinition that was set as historical will retrieve the sourceCode using the sourcePointer"

	^ self sourcePointer notNil
		ifTrue: [ SourceFiles sourceCodeAt: self sourcePointer ]
		ifFalse:[ nil ]! !

!RGMethodDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 8/25/2011 22:30'!
isSameRevisionAs: aRGMethodDefinition
	"This method look for equality of the properties of the receiver"
	"Stamp is ignored as in many cases a method is saved without containing any change. However it appears as changed due to a different stamp"
	self flag: 'needs to be evaluated'.

	^(super isSameRevisionAs: aRGMethodDefinition)
		and: [ self selector = aRGMethodDefinition selector 
			and: [ self protocol = aRGMethodDefinition protocol
				and: [ self sourceCode = aRGMethodDefinition sourceCode ] ] ]! !

!RGMethodDefinition methodsFor: '*NautilusCommon' stamp: 'BenjaminVanRyseghem 8/27/2011 23:11'!
hasErrorTest

	^ self methodClass methodRaisedError: (self selector)! !

!RGMethodDefinition methodsFor: 'testing' stamp: 'CamilloBruni 9/22/2012 21:16'!
isFromTrait

	"Return true for methods that have been included from Traits"
	^ self origin isTrait and: [ self origin ~= self methodClass ]! !

!RGMethodDefinition methodsFor: 'accessing' stamp: 'GiselaDecuzzi 5/3/2013 11:22'!
protocol

	self isActive 
		ifTrue: [ ^ self compiledMethod ifNil:[ protocol ] ifNotNil: [ self compiledMethod category ]].
	self isHistorical
		ifTrue: [ ^ self protocolAtPointer ifNil:[ self compiledMethod ifNil:[ protocol ] ifNotNil:[ :cm| cm category ] ] ].
	^ protocol			! !

!RGMethodDefinition methodsFor: 'comparing' stamp: 'VeronicaUquillas 8/2/2011 11:28'!
hash

	^super hash bitXor: self selector hash! !

!RGMethodDefinition methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 12/1/2014 23:50'!
gtInspectorSendersIn: composite
	<gtInspectorPresentationOrder: 2>
	composite list 
		title: 'Senders';
		display: [ self compiledMethod senders ]! !

!RGMethodDefinition methodsFor: '*Manifest-Core' stamp: 'StephaneDucasse 11/29/2014 21:19'!
storeOn: aStream
	aStream nextPut: $(.
	aStream nextPutAll: self class asString.
	aStream nextPutAll: ' className: '''.
	aStream nextPutAll: self parentName.
	aStream nextPutAll: ''' selector: '.
	aStream nextPutAll: self selector printString.
	aStream nextPutAll: ' isMetaSide: '.
	aStream nextPutAll: self isMetaSide printString.
	aStream nextPut: $)! !

!RGMethodDefinition methodsFor: 'testing' stamp: 'DamienCassou 4/29/2013 15:41'!
isAbstract
	^ self compiledMethod isAbstract! !

!RGMethodDefinition methodsFor: 'backward compatibility' stamp: 'VeronicaUquillas 8/31/2011 15:32'!
method

	^self compiledMethod! !

!RGMethodDefinition methodsFor: '*Ring-Monticello' stamp: 'MarcusDenker 12/2/2013 14:08'!
basicAsMCMethodDefinition
   "Creates a MCMethodDefinition from the receiver"
   self isActive ifTrue: [ 
		self compiledMethod sourceFileStream ifNotNil: [ :file|
			^ self asMCMethodDefinitionFromFile: file]].
	
   ^ MCMethodDefinition
		className: self theNonMetaParentName
 	   	classIsMeta: self isMetaSide
		selector: self selector
		category: self protocol
		timeStamp: self stamp
		source: self sourceCode! !

!RGMethodDefinition methodsFor: 'type of methods' stamp: 'VeronicaUquillas 9/18/2011 15:30'!
asActive

	"Sets the receiver as active object, which will allow itself to retrieve its data from the compiled method"
	self annotationNamed: self class statusKey put: #active! !

!RGMethodDefinition methodsFor: '*NautilusCommon' stamp: 'BenjaminVanRyseghem 8/27/2011 23:11'!
hasFailedTest

	^ self methodClass methodFailed: (self selector)! !

!RGMethodDefinition methodsFor: 'accessing' stamp: 'StephaneDucasse 8/12/2011 11:53'!
sourceCode: anObject

	sourceCode := anObject! !

!RGMethodDefinition methodsFor: 'source pointers' stamp: 'StephaneDucasse 8/1/2011 19:35'!
sourcePointer: aNumber

	self annotationNamed:  self class sourcePointerKey put: aNumber ! !

!RGMethodDefinition methodsFor: '*NautilusCommon' stamp: 'BenjaminVanRyseghem 8/27/2011 22:46'!
containsFlag

	^ self literals includesAnyOf: #( flag flag: ).! !

!RGMethodDefinition methodsFor: 'comparing' stamp: 'StephaneDucasse 12/28/2012 16:23'!
= aRGMethodDefinition
	"This method look for equality of the key properties of the receiver"


	^(super = aRGMethodDefinition)
		and: [ self selector == aRGMethodDefinition selector]! !

!RGMethodDefinition methodsFor: '*NautilusRefactoring' stamp: ''!
nameToDisplay

	^ self printString! !

!RGMethodDefinition methodsFor: 'stamp values' stamp: 'MarcusDenker 10/16/2013 13:44'!
author 

	^self 
		annotationNamed: self class authorKey
		ifAbsentPut: [ self class parseAuthorAliasFrom: self stamp ]! !

!RGMethodDefinition methodsFor: '*NautilusCommon' stamp: 'EstebanLorenzano 11/29/2013 14:32'!
numArgs
	^ self selector asString numArgs! !

!RGMethodDefinition methodsFor: 'metrics' stamp: 'VeronicaUquillas 12/17/2011 08:55'!
numberOfLinesOfCode

	^ self annotationNamed: #numberOfLinesOfCode ifAbsentPut: [ self sourceCode lineCount ]! !

!RGMethodDefinition methodsFor: '*NautilusCommon' stamp: 'BenjaminVanRyseghem 8/27/2011 22:52'!
hasPassedTest

	^ self methodClass methodPassed: (self selector)! !

!RGMethodDefinition methodsFor: '*System-Support' stamp: 'CamilloBruni 1/30/2013 21:34'!
implementors
	
	^ SystemNavigation default allImplementorsOf: self selector! !

!RGMethodDefinition methodsFor: 'traits' stamp: 'mada 5/5/2012 13:07'!
argumentNames
	"Return an array with the argument names of the method's selector"

	^ self compiledMethod argumentNames! !

!RGMethodDefinition methodsFor: 'comparing' stamp: 'VeronicaUquillas 8/25/2011 22:26'!
<= aRGMethodDefinition
	"Sort method definitions according to: 1. class name - 2. class comment - 3. method selector - 4. timestamp"

	self parentName < aRGMethodDefinition parentName ifTrue: [^true].
	self parentName > aRGMethodDefinition parentName ifTrue: [^false].

	self flag: 'This ugly test is needed right now because the old system is used to represent 
	class comment as method with Comment selector. And to mix comment and methods'.
	aRGMethodDefinition isComment ifTrue: [^false].
	
	^(self selector < aRGMethodDefinition selector) 
 		  or: [ (self selector == aRGMethodDefinition selector) and: [
    			  self timeStamp <= aRGMethodDefinition timeStamp ]]! !

!RGMethodDefinition methodsFor: 'to remove as soon as possible' stamp: 'VeronicaUquillas 8/31/2011 13:57'!
classIsMeta

	^self isMetaSide! !

!RGMethodDefinition class methodsFor: 'elements-annotations' stamp: 'VeronicaUquillas 7/22/2011 11:23'!
isExtensionKey 

	^#isExtension! !

!RGMethodDefinition class methodsFor: '*manifest-core' stamp: 'SimonAllier 7/26/2012 15:32'!
manifestReadOn: aArray

 	^ self className:  (aArray at: 1) 
		selector: (aArray at: 2)
		isMetaSide: ((aArray at: 3) = #true)   
		! !

!RGMethodDefinition class methodsFor: 'instance creation' stamp: 'VeronicaUquillas 8/16/2011 14:18'!
class: aRGBehaviorDefinition selector: aString
	"Create a ring method definition from a ring class and a selector"

	^(self class: aRGBehaviorDefinition)
		selector: aString asSymbol;
		yourself! !

!RGMethodDefinition class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/26/2015 17:51'!
gtExampleMethod
	<gtExample: 'RMethodDefinition'>
	^ (GTInspector class >> #gtInspectorExtensionsIn:) asRingDefinition! !

!RGMethodDefinition class methodsFor: 'instance creation' stamp: 'VeronicaUquillas 9/18/2011 15:08'!
realClass: aClass selector: aString
	"Creates a ring method definition from a Smalltalk class and a selector <compiledMethod>"

	^(aClass>>aString asSymbol) asActiveRingDefinition! !

!RGMethodDefinition class methodsFor: 'instance creation' stamp: ''!
className: aString selector: aSelector isMetaSide: aBoolean

	^ (self class: (RGClassDefinition named: aString) selector: aSelector) isMetaSide: aBoolean; yourself! !

!RGMethodDefinition class methodsFor: 'categories' stamp: 'VeronicaUquillas 4/20/2011 17:25'!
unclassifiedProtocolName
	"Return the string labeling the unclassified protocol."

	^ 'as yet unclassified'! !

!RGMethodDefinitionTest commentStamp: 'TorstenBergmann 2/12/2014 23:09'!
SUnit tests for method definitions!
!RGMethodDefinitionTest methodsFor: 'testing' stamp: 'VeronicaUquillas 9/1/2011 10:22'!
testCreatingMethodsWithoutFactory
	| newMethod newClass |

	newMethod := RGMethodDefinition realClass: OrderedCollection selector: 'size'.
	self assert: (newMethod isMethod).  
	self assert: (newMethod selector == #size).  
	self assert: (newMethod protocol notNil).
	self assert: (newMethod sourceCode notEmpty).
	self assert: (newMethod stamp notNil).
	
	newClass := RGClassDefinition named: #OrderedCollection.
	newMethod := RGMethodDefinition class: newClass selector: 'size'.
	self assert: (newMethod isMethod).  
	self assert: (newMethod selector == #size).  
	self assert: (newMethod protocol isNil).
	self assert: (newMethod sourceCode isNil).
	self assert: (newMethod stamp isNil).
	
	newMethod := RGMethodDefinition realClass: OrderedCollection theMetaClass selector: #arrayType.
	self assert: (newMethod isMethod).  
	self assert: (newMethod selector == #arrayType).  
	self assert: (newMethod protocol notNil).
	self assert: (newMethod sourceCode notEmpty).
	self assert: (newMethod stamp notNil).! !

!RGMethodDefinitionTest methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 10/16/2013 13:44'!
foo	^ 'second version'! !

!RGMethodDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 9/25/2014 13:08'!
testExistingMethodWithClass
	| newMethod newClass |
	
	newClass:=RGClassDefinition named: #OrderedCollection.
	newMethod:= (RGMethodDefinition named: #add:)
					 parent: newClass;
					protocol: 'adding';
					sourceCode: 'add: newObject
									^self addLast: newObject'.
									
	self assert: (newMethod isMethod).
	self assert: (newMethod selector == #add:).
	self assert: (newMethod isMetaSide not).
	
	self assert: (newMethod parent = newClass).
	self assert: (newMethod parentName == newClass name).
	
	self assert: (newMethod parent parent == Smalltalk globals).
	self assert: (newMethod realClass = OrderedCollection).
	self assert: (newMethod compiledMethod = (OrderedCollection compiledMethodAt: #add:)).! !

!RGMethodDefinitionTest methodsFor: 'testing' stamp: 'VeronicaUquillas 9/19/2011 16:12'!
testAsMethodDefinition
	| newMethod |

	newMethod:= (OrderedCollection >> #size) asRingDefinition.
	
	self assert: (newMethod isRingObject).
	self assert: newMethod parent isNil.
	self assert: (newMethod isMethod).  
	self assert: (newMethod selector == #size).  
	self assert: (newMethod protocol notNil).
	self assert: (newMethod stamp notNil).! !

!RGMethodDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 9/24/2014 16:32'!
testExistingMethodWithPointer
	| newMethod |
	
	newMethod:= (OrderedCollection>>#size) asActiveRingDefinition.
									
	self assert: (newMethod parent isNil).
	self assert: (newMethod parentName == #OrderedCollection).
	self assert: (newMethod sourceCode notNil).
	self assert: (newMethod protocol notNil).
	self assert: (newMethod stamp notNil).
	self assert: (newMethod isExtension not)! !

!RGMethodDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 9/25/2014 13:09'!
testNonExistingMethodWithClass
	"method does not exist in OrderedCollection"
	| newMethod newClass |
	
	newClass:= RGClassDefinition named: #OrderedCollection.
	newClass withMetaclass.
	
	newMethod:= (RGMethodDefinition named: #foo) parent: newClass theMetaClass.
	newMethod sourceCode: 'foo
									^true'.
									
	self assert: (newMethod isMethod).
	self assert: (newMethod selector == #foo).
	self assert: (newMethod isMetaSide).
	self assert: (newMethod protocol = nil).
	
	self assert: (newMethod parent = newClass theMetaClass).
	self assert: (newMethod parentName = newClass theMetaClass name).
	
	self assert: (newMethod environment == Smalltalk globals).
	self assert: (newMethod realClass = OrderedCollection class).
	self assert: (newMethod compiledMethod isNil).! !

!RGMethodDefinitionTest methodsFor: 'testing' stamp: 'StephaneDucasse 8/12/2011 14:46'!
testSameMethodInSet
	"self debug: #testSameMethodInSet"

	| s rgmethod |
	s := Set new.
	rgmethod := (OrderedCollection>>#size) asRingDefinition.
	s add: rgmethod. 
	self assert: (s includes: rgmethod).
	
	s add: rgmethod. 
	self assert: (s size = 1).
	self assert: (s includes: rgmethod).
	
! !

!RGMethodDefinitionTest methodsFor: 'testing' stamp: 'StephaneDucasse 8/12/2011 14:48'!
testDifferentObjectButSameMethodInSet
	"self debug: #testDifferentObjectButSameMethodInSet"

	| s rgmethod rgmethod2 |
	s := Set new.
	rgmethod := (OrderedCollection>>#size) asRingDefinition.
	s add: rgmethod. 
	rgmethod2 := (OrderedCollection>>#size) asRingDefinition.
	s add: rgmethod2.
	
	self assert: (s size = 1).
	self assert: (s includes: rgmethod).
	self assert: (s includes: rgmethod2).

! !

!RGMethodDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 4/29/2012 10:35'!
testAsHistorical
	| firstVersion secondVersion |

	RGMethodDefinitionTest compile: 'foo	^ ''first version'''.
	firstVersion := (RGMethodDefinitionTest >> #foo) asHistoricalRingDefinition.
	self assert: firstVersion isHistorical.
	self assert: firstVersion sourceCode = firstVersion compiledMethod sourceCode.
	self assert: firstVersion stamp = firstVersion compiledMethod timeStamp.

	RGMethodDefinitionTest compile: 'foo	^ ''second version'''.
	secondVersion := (RGMethodDefinitionTest >> #foo) asHistoricalRingDefinition.
	self assert: secondVersion isHistorical.
	self assert: secondVersion sourceCode = secondVersion compiledMethod sourceCode.
	self assert: secondVersion stamp = secondVersion compiledMethod timeStamp.

	self deny: firstVersion sourcePointer = secondVersion sourcePointer.
	self deny: firstVersion sourceCode = secondVersion sourceCode.! !

!RGMethodDefinitionTest methodsFor: 'testing' stamp: 'VeronicaUquillas 8/25/2011 22:52'!
testSorting

	| rgMethod1 rgMethod2 |
	rgMethod1 := RGMethodDefinition realClass: RGInstanceVariableDefinition selector: #isInstanceVariable.
	rgMethod2 := RGMethodDefinition realClass: RGElementDefinition selector: #isMetaSide.
	self assert: rgMethod2 <= rgMethod1.
	
	rgMethod1 := RGMethodDefinition realClass: RGElementDefinition selector: #parentName.
	self assert: rgMethod2 <= rgMethod1. 
	! !

!RGMethodDefinitionTest methodsFor: 'testing' stamp: ''!
testClassNameSelectorIsMetaSide
	"self debug: #testClassNameSelectorIsMetaSide"
	
	| rg |
	rg := RGMethodDefinition className: 'Point' selector: #x  isMetaSide: false. 	
	self assert: (rg parentName = 'Point').
	self assert: (rg parent isKindOf:RGClassDefinition).
	self assert: (rg selector = #x).
	self assert: (rg isMetaSide not).! !

!RGMethodDefinitionTest methodsFor: '*Manifest-Tests' stamp: ''!
testReadFrom
	"self debug: #testReadFrom"
	
	
	| st rg |
	rg := (Point>>#x) asRingDefinition.
	st := String streamContents: [:s |
		
		rg storeOn: s.
		s contents].
	self assert: (Object readFrom: st) = rg ! !

!RGMethodDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 8/1/2014 14:15'!
testExistingMethodWithoutClass
	"its parent class is not assigned only its name"
	| newMethod |
	
	newMethod:= (RGMethodDefinition named: #add:)
					parentName: #OrderedCollection;
					selector: #add:; 
					isMetaSide: false;
					protocol: 'adding'; 
					sourceCode: 'add: newObject
									^self addLast: newObject'.
	
	self assert: (newMethod isMethod).
	self assert: (newMethod selector == #add:).
	self assert: (newMethod isMetaSide not).
	self assert: (newMethod protocol = #adding).
	self assert: (newMethod fullName = 'OrderedCollection>>add:').
	self assert: (newMethod sourceCode = 'add: newObject
									^self addLast: newObject').
	self assert: (newMethod hasStamp not).
	self assert: (newMethod parent isNil).
	self assert: (newMethod parentName == #OrderedCollection).
	
	self assert: (newMethod environment == Smalltalk globals).
	self assert: (newMethod realClass = OrderedCollection).
	self assert: (newMethod compiledMethod = (OrderedCollection compiledMethodAt: #add:))! !

!RGMethodDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 9/25/2014 13:08'!
testExtensionMethod
	| newMethod newClass newPackage newPackageExt |

	newMethod:= (RGMethodDefinition named: #+)
					isExtension: true.
	self assert: (newMethod protocol isNil).
	self assert: (newMethod isExtension).

	newMethod:= (Collection >> #+) asRingDefinition.	
	self assert: (newMethod isMethod).  
	self assert: (newMethod protocol = '*Collections-arithmetic').
	self assert: (newMethod isExtension).
	
	newPackage := RGPackage named: #Package.
	newPackageExt := RGPackage named:  #PackageExtensions.
	newClass := RGClassDefinition named: #Class.
	newMethod := (RGMethodDefinition named: #foo) parent: newClass.
	newPackage addClass: newClass.
	newMethod package: newPackageExt.
	self assert: (newMethod isExtension).! !

!RGMethodDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 9/25/2014 13:08'!
testMethodEquality

	| newMethod newClass |
	self assert: (OrderedCollection>>#size) asRingDefinition = (OrderedCollection>>#size) asRingDefinition.
	
	newMethod := ((OrderedCollection>>#size) asRingDefinition)
					sourceCode: 'size
						^0'.
	self assert: ((OrderedCollection>>#size) asRingDefinition = newMethod).
	
	newClass:= RGClassDefinition named: #OrderedCollection.
	newMethod:= (RGMethodDefinition named: #size) parent: newClass.
	self assert: ((OrderedCollection>>#size) asRingDefinition = newMethod).
	
	newMethod:= (RGMethodDefinition named: #size) parent: (SortedCollection asRingDefinition).
	self deny: ((OrderedCollection>>#size) asRingDefinition = newMethod).! !

!RGMethodDefinitionTest methodsFor: '*Ring-Tests-Monticello' stamp: 'NicolaiHess 1/17/2014 15:04'!
testAsFullMethodDefinition
	"self debug: #testAsFullMethodDefinition"
	
	| rgMethod |
	rgMethod := (Trait >> #asRingDefinition) asRingDefinition.
	self assert: rgMethod parent isNil.
	self assert: rgMethod package isNil.
	
	"retrieves package information from protocol name (class extension)"
	rgMethod := (Trait >> #asRingDefinition) asFullRingDefinition.
	self assert: rgMethod parent notNil.
	self assert: rgMethod parentName = #Trait.
	self assert: rgMethod parent methods size = 1.
	self assert: rgMethod parent package name equals: #Traits.	
	self assert: rgMethod package notNil.
	self assert: rgMethod package name = #'Ring-Core-Kernel'.

	"retrieves package information from class package name "
	rgMethod := (Trait >> #name) asFullRingDefinition.
	self assert: rgMethod parent notNil.
	self assert: rgMethod parentName = #Trait.
	self assert: rgMethod parent methods size = 1.
	self assert: rgMethod parent package name equals: #Traits.	
	self assert: rgMethod package notNil.
	self assert: rgMethod package name = #Traits.
	! !

!RGMethodDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 4/29/2012 10:35'!
testAsPassive
	| newMethod |

	RGMethodDefinitionTest compile: 'foo	^ ''first version'''.
	newMethod := (RGMethodDefinitionTest >> #foo) asPassiveRingDefinition.
	self assert: newMethod isPassive.
	self assert: newMethod sourceCode = newMethod compiledMethod sourceCode.

	RGMethodDefinitionTest compile: 'foo	^ ''second version'''.
	self assert: newMethod sourceCode = 'foo	^ ''first version'''.		
	self assert: newMethod compiledMethod sourceCode = 'foo	^ ''second version'''.! !

!RGMethodDefinitionTest methodsFor: 'testing' stamp: 'VeronicaUquillas 9/1/2011 00:27'!
testAsMethodDefinition2
	"self debug: #testAsMethodDefinition2"
	
	| newMethod |
	newMethod := (Object >> #printOn:) asRingDefinition.
	self assert: newMethod asStringOrText asString = 'Object>>printOn: {printing} '.
	self assert:  newMethod protocol = 'printing'.
	
	newMethod := (TCloneTest>>#testCopyEmpty) asRingDefinition.
	self assert:  newMethod protocol = 'tests - copy - clone'.

	newMethod := (ArrayTest>>#testCopyEmpty) asRingDefinition.
	self assert:  newMethod protocol = 'tests - copy - clone'.
	
	! !

!RGMethodDefinitionTest methodsFor: '*Manifest-Tests' stamp: ''!
testStoreOn
	"self debug: #testStoreOn"
	
	
	| st |
	st := String streamContents: [:s |
		
		(Point>>#x) asRingDefinition storeOn: s.
		s contents].
	self assert: st = '(RGMethodDefinition className: ''Point'' selector: #x isMetaSide: false)'! !

!RGMethodDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 4/29/2012 10:35'!
testAsActive
	| newMethod |

	RGMethodDefinitionTest compile: 'foo	^ ''first version'''.
	newMethod := (RGMethodDefinitionTest >> #foo) asActiveRingDefinition.
	self assert: newMethod isActive.	
	self assert: newMethod sourcePointer isNil.
	self assert: newMethod sourceCode = newMethod compiledMethod sourceCode.

	RGMethodDefinitionTest compile: 'foo	^ ''second version'''.
	self assert: newMethod sourceCode = newMethod compiledMethod sourceCode.
	
	newMethod := (Trait >> #asRingDefinition) asActiveRingDefinition.
	newMethod fromActiveToPassive.
	self assert: newMethod isPassive.
	self assert: newMethod sourceCode = (Trait >> #asRingDefinition) sourceCode.
	newMethod sourceCode: 'asRingDefinition   ^true'.
	self assert: newMethod sourceCode ~= (Trait >> #asRingDefinition) sourceCode.
	
	newMethod := (Trait >> #asRingDefinition) asActiveRingDefinition.
	newMethod fromActiveToHistorical.
	self assert: newMethod isHistorical.
	self assert: newMethod sourcePointer notNil.! !

!RGMonticelloTest commentStamp: 'TorstenBergmann 2/12/2014 23:10'!
SUnit tests for monticello!
!RGMonticelloTest methodsFor: 'testing' stamp: 'VeronicaUquillas 8/31/2011 19:29'!
testConvertingMCMethodDefinition
	| mcMethod ringMethod |
	
	ringMethod := (OrderedCollection >> #add: ) asRingDefinition.
	mcMethod := ringMethod asMCMethodDefinition.
	
	self assert: (ringMethod isMethod).
	self assert: (ringMethod isSameRevisionAs: ((OrderedCollection >> #add: ) asRingDefinition)).
	self deny: (ringMethod isSameRevisionAs: ((OrderedCollection >> #addAll: ) asRingDefinition))! !

!RGMonticelloTest methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 18:43'!
testConvertingMCTraitDefinition
	| mcClass ringClass |
	
	mcClass := TSortable asClassDefinition.
	ringClass := mcClass asRingDefinition.
	
	self assert: (ringClass isTrait).
	self assert: (ringClass theMetaClass realClass = TSortable theMetaClass).
	self assert: (ringClass isSameRevisionAs: TSortable asRingDefinition).
	self deny: (ringClass isSameRevisionAs: TBehavior asRingDefinition)! !

!RGMonticelloTest methodsFor: 'testing' stamp: 'VeronicaUquillas 7/18/2011 14:56'!
testConvertingMCClassDefinition
	| mcClass ringClass |
	
	mcClass := OrderedCollection asClassDefinition.
	ringClass := mcClass asRingDefinition.
	
	self assert: (ringClass isClass).
	self assert: (ringClass theMetaClass realClass = OrderedCollection class).
	self assert: (ringClass isSameRevisionAs: OrderedCollection asRingDefinition).
	self deny: (ringClass isSameRevisionAs: SortedCollection asRingDefinition)! !

!RGMonticelloTest methodsFor: 'testing' stamp: 'VeronicaUquillas 7/18/2011 14:45'!
testConvertingMCOrganizationDefinition
	| mcOrganization ringOrganization mcOrganization2 |
	
	mcOrganization := MCOrganizationDefinition categories: {#'Ring-Core-Kernel' . #'Ring-Core-Definitions'}.
	mcOrganization2 := MCOrganizationDefinition categories: {#'Ring-Core-Kernel' . #'Ring-Core-Definitions' . #'Ring-Core-Variables'}.
	ringOrganization := mcOrganization asRingDefinition.
	
	self assert: (ringOrganization isOrganization).
	self deny: (ringOrganization isSameRevisionAs: mcOrganization2 asRingDefinition)! !

!RGMonticelloTest methodsFor: 'testing' stamp: 'MarcusDenker 11/10/2012 12:08'!
testAsMCMethodDefinition
	
	| ringMethod mcMethod |
	
	ringMethod := (OrderedCollection>>#size) asActiveRingDefinition.
	mcMethod := ringMethod asMCMethodDefinition.
	
	self assert: ringMethod = mcMethod asRingDefinition.
	self assert: mcMethod className = #OrderedCollection.
	self deny: mcMethod classIsMeta.
	self assert: mcMethod selector = #size.
	self assert: mcMethod category = #accessing.
	self assert: mcMethod source = (OrderedCollection>>#size) sourceCode! !

!RGNamespace commentStamp: 'VeronicaUquillas 4/20/2011 16:34'!
A namespace is a container that in addition to managing classes and methods, it also knows how to treat pools and global variables!
!RGNamespace methodsFor: 'adding elements' stamp: 'MarcusDenker 8/1/2014 14:27'!
addPoolNamed: poolName
	"creates a RGPoolDefinition with the given name.
	It's verified that a pool with that name does not exist"
	| pool |

	(self includesPoolNamed: poolName) ifTrue: [ ^self ].
	"A shared pool is a class inheriting from #SharedPool"
	pool := (RGClassDefinition named: poolName)
			superclassName: #SharedPool;
			isPool: true;
			yourself.
	self addPool: pool.! !

!RGNamespace methodsFor: 'accessing global variables' stamp: 'VeronicaUquillas 4/15/2011 09:47'!
globalVariables: aCollection

	self elementsCategorized: #globalVariables with: aCollection! !

!RGNamespace methodsFor: 'accessing pools' stamp: 'VeronicaUquillas 4/15/2011 09:49'!
pools
	"retrieves the shares pools"

	^self elementsCategorized: #pools! !

!RGNamespace methodsFor: 'accessing global variables' stamp: 'VeronicaUquillas 4/14/2011 15:39'!
globalVariableNamed: globalVariableName

	^self elementNamed: globalVariableName in: self globalVariables! !

!RGNamespace methodsFor: 'accessing pools' stamp: 'VeronicaUquillas 4/14/2011 14:40'!
poolNamed: poolName

	^self elementNamed: poolName in: self pools! !

!RGNamespace methodsFor: 'removing elements' stamp: 'VeronicaUquillas 4/14/2011 15:13'!
removeGlobalVariable: anORGlobalVariableDefinition
	"removes anORGlobalVariableDefinition from the globals dictionary if satisfies it #isGlobalVariable"

	anORGlobalVariableDefinition isGlobalVariable ifFalse:[ ^self ].
	self removeElement: anORGlobalVariableDefinition from: self globalVariables! !

!RGNamespace methodsFor: 'adding elements' stamp: 'VeronicaUquillas 4/14/2011 14:29'!
addPool: anORPoolDefinition
	"adds anORPoolDefinition to the pools dictionary if satisfies it #isPool"

	anORPoolDefinition isPool ifFalse:[ ^self ].
	self addElement: anORPoolDefinition in: self pools! !

!RGNamespace methodsFor: 'testing' stamp: 'VeronicaUquillas 4/19/2011 15:31'!
isNamespace

	^true! !

!RGNamespace methodsFor: 'initialization' stamp: 'VeronicaUquillas 4/20/2011 16:40'!
initialize

	super initialize.
	self globalVariables: IdentityDictionary new.
	self pools: IdentityDictionary new.! !

!RGNamespace methodsFor: 'removing elements' stamp: 'VeronicaUquillas 4/20/2011 16:35'!
withoutGlobalVariables

	self removeElementsCategorized: #globalVariables! !

!RGNamespace methodsFor: 'adding elements' stamp: 'VeronicaUquillas 9/7/2011 10:47'!
addElement: anObject in: aCollection

	anObject environment: self.
	super addElement: anObject in: aCollection! !

!RGNamespace methodsFor: 'testing' stamp: 'VeronicaUquillas 4/14/2011 15:01'!
includesGlobalVariableNamed: globalVariableName
	
	^self includesElementNamed: globalVariableName in: self globalVariables! !

!RGNamespace methodsFor: 'removing elements' stamp: 'VeronicaUquillas 4/20/2011 16:35'!
withoutPools

	self removeElementsCategorized: #pools! !

!RGNamespace methodsFor: 'adding elements' stamp: 'VeronicaUquillas 4/14/2011 14:30'!
addGlobalVariable: anORGlobalVariableDefinition
	"adds anORGlobalVariableDefinition to the globals dictionary if satisfies it #isGlobalVariable"

	anORGlobalVariableDefinition isGlobalVariable ifFalse:[ ^self ].
	self addElement: anORGlobalVariableDefinition in: self globalVariables! !

!RGNamespace methodsFor: 'testing' stamp: 'VeronicaUquillas 4/14/2011 15:36'!
includesGlobalVariable: anORGlobalVariableDefinition

	^self globalVariables includes: anORGlobalVariableDefinition! !

!RGNamespace methodsFor: 'removing elements' stamp: 'VeronicaUquillas 4/14/2011 15:13'!
removePool: anORPoolDefinition
	"removes anORPoolDefinition from the pools dictionary if satisfies it #isPool"

	anORPoolDefinition isPool ifFalse:[ ^self ].
	self removeElement: anORPoolDefinition from: self pools! !

!RGNamespace methodsFor: 'accessing global variables' stamp: 'VeronicaUquillas 4/15/2011 09:49'!
globalVariables
	"retrieves global variables"

	^self elementsCategorized: #globalVariables! !

!RGNamespace methodsFor: 'testing' stamp: 'VeronicaUquillas 4/14/2011 15:35'!
includesPool: anORPoolDefinition

	^self pools includes: anORPoolDefinition! !

!RGNamespace methodsFor: 'adding elements' stamp: 'MarcusDenker 8/1/2014 14:19'!
addGlobalVariableNamed: globalVariableName
	"creates a RGGlobalVariableDefinition with the given name.
	It's verified that a pool with that name does not exist"

	(self includesGlobalVariableNamed: globalVariableName) ifTrue: [ ^self ].
	self addGlobalVariable: (RGGlobalVariableDefinition named: globalVariableName).! !

!RGNamespace methodsFor: 'testing' stamp: 'VeronicaUquillas 4/14/2011 15:01'!
includesPoolNamed: poolName
	
	^self includesElementNamed: poolName in: self pools! !

!RGNamespace methodsFor: 'accessing pools' stamp: 'VeronicaUquillas 4/15/2011 09:47'!
pools: aCollection

	self elementsCategorized: #pools with: aCollection! !

!RGNamespaceTest commentStamp: 'TorstenBergmann 2/12/2014 23:08'!
SUnit tests for namespaces!
!RGNamespaceTest methodsFor: 'testing' stamp: 'MarcusDenker 8/1/2014 14:09'!
testCreatingNamespace
	| newNamespace newPackage newClass |
	
	newNamespace := RGNamespace named: #'RingNamespace'.
	newPackage := RGPackage named:  #'Collections-Sequenceable'.
	newClass:= RGClassDefinition named: #OrderedCollection.
	newPackage addClass: newClass.
	newNamespace addPackage: newPackage;
		addClass: newClass.
	
	self assert: (newNamespace isNamespace).
	self assert: ((newNamespace packageNamed: #'Collections-Sequenceable') == newPackage).
	self assert: ((newNamespace classNamed: #OrderedCollection) == newClass).
	self assert: (newNamespace methods isEmpty).
	self assert: (newNamespace pools isEmpty).
	self assert: (newNamespace globalVariables isEmpty).
	
	newNamespace removeClass: newClass.
	self assert: ((newNamespace classNamed: #OrderedCollection) isNil).
	self assert: ((newPackage classNamed: #OrderedCollection) notNil).! !

!RGOrganization commentStamp: 'TorstenBergmann 2/12/2014 23:06'!
An organization with categories!
!RGOrganization methodsFor: 'accessing' stamp: 'VeronicaUquillas 5/12/2011 11:01'!
categories
	"Retrieves categories in the system (tag-packages)"

	^self elements at: #categories ifAbsent:[ #() ]! !

!RGOrganization methodsFor: 'initialization' stamp: 'VeronicaUquillas 5/12/2011 11:01'!
initialize

	super initialize.
	self categories: OrderedCollection new.! !

!RGOrganization methodsFor: 'testing' stamp: 'VeronicaUquillas 5/12/2011 13:41'!
isOrganization

	^true! !

!RGOrganization methodsFor: 'testing' stamp: 'VeronicaUquillas 7/18/2011 14:32'!
isSameRevisionAs: aRGOrganization
	"This method look for equality of the properties of the receiver"

	^(self class = aRGOrganization class)
		and:[ self categories = aRGOrganization categories ]! !

!RGOrganization methodsFor: 'accessing' stamp: 'VeronicaUquillas 5/12/2011 13:45'!
categories: aCollection
	"Set the categories collection"

	self elements at: #categories put: aCollection! !

!RGOrganization methodsFor: 'accessing' stamp: 'VeronicaUquillas 5/13/2011 00:21'!
fullName

	^#organization! !

!RGPackage commentStamp: 'VeronicaUquillas 4/20/2011 17:18'!
RGPackage is the representation for packages.
A package manages classes, methods and children packages as elements.
A package can also know in which package is defined
!
!RGPackage methodsFor: 'accessing' stamp: 'VeronicaUquillas 9/6/2011 15:14'!
categories
	"Retrieves class categories of the receiver"
	
	^self elements at: #categories! !

!RGPackage methodsFor: 'accessing' stamp: 'VeronicaUquillas 9/6/2011 17:27'!
definedClassNames

	^ super classNames! !

!RGPackage methodsFor: 'adding/removing' stamp: 'VeronicaUquillas 9/19/2011 12:58'!
addMethod: aRGMethodDefinition
	"aRGMethodDefinition needs to satisfy the status isMethod"

	aRGMethodDefinition isMethod ifFalse:[ ^self ].
	aRGMethodDefinition package: self.	"Needed to evaluate #isExtension if it was not set in advance"
	self 
		addElement: aRGMethodDefinition 
		in: (aRGMethodDefinition isExtension 
			ifTrue: [ self extensionMethods ]
			ifFalse:[ super methods ])! !

!RGPackage methodsFor: 'accessing' stamp: 'MarcusDenker 10/31/2014 14:40'!
definedTraits
	"Retrieves the traits defined in the receiver"

	^self traits! !

!RGPackage methodsFor: 'accessing' stamp: 'VeronicaUquillas 9/6/2011 14:48'!
extendedClasses
	"Retrieves the classes holding the extension methods and returns a dictionary as well"
	|  classesOfExt |
	classesOfExt := Dictionary new.
	
	self extensionMethods
		do:[ :mth| (classesOfExt includesKey: mth parentName)
					ifFalse:[ classesOfExt at: mth parentName put: mth parent ] ].
	
	^classesOfExt! !

!RGPackage methodsFor: 'accessing' stamp: 'AndyKellens 1/13/2012 14:51'!
categories: aCollection
	"Set the class categories collection"
	
	self elements at: #categories put: (aCollection asOrderedCollection)! !

!RGPackage methodsFor: 'initialization' stamp: 'VeronicaUquillas 9/6/2011 15:14'!
initialize

	super initialize.
	self withoutPackages.	"By default the receiver has no child packages"
	self extensionMethods: IdentityDictionary new.		
	self categories: OrderedCollection new.! !

!RGPackage methodsFor: 'accessing' stamp: 'VeronicaUquillas 4/20/2011 17:15'!
package: aRGPackage
	"Sets the outer package of the receiver if exists"

	package:= aRGPackage! !

!RGPackage methodsFor: 'printing' stamp: 'LeoGassman 11/7/2013 11:37'!
printOn: aStream
	aStream
		nextPutAll: self class name;
		nextPutAll: '(';
		nextPutAll: self name;
		nextPutAll: ')'! !

!RGPackage methodsFor: 'accessing' stamp: 'VeronicaUquillas 4/11/2011 12:08'!
package
	"Retrieves the  package in which self is contained"

	^package! !

!RGPackage methodsFor: 'accessing' stamp: 'VeronicaUquillas 4/15/2011 14:41'!
parent
	"Retrieves the environment linked to this package"
	
	^self environment! !

!RGPackage methodsFor: 'accessing' stamp: 'VeronicaUquillas 9/6/2011 17:26'!
classNames

	^ self classes isDictionary
		ifTrue: [ self classes keys ]
		ifFalse:[ self classes collect:[ :class|  class name ] ]	! !

!RGPackage methodsFor: 'accessing' stamp: 'VeronicaUquillas 8/8/2011 10:19'!
extensionMethods: aCollection
	"Set the extension methods collection"
	
	self elements at: #extensionMethods put: aCollection! !

!RGPackage methodsFor: 'adding/removing' stamp: 'VeronicaUquillas 9/19/2011 12:58'!
removeMethod: aRGMethodDefinition

	self 
		removeElement: aRGMethodDefinition 
		from: (aRGMethodDefinition isExtension 
				ifTrue: [ self extensionMethods ]
				ifFalse:[ super methods ])! !

!RGPackage methodsFor: 'managing container' stamp: 'VeronicaUquillas 7/29/2011 10:52'!
addInContainer: anRGContainer

	anRGContainer addPackage: self! !

!RGPackage methodsFor: 'testing' stamp: 'VeronicaUquillas 9/6/2011 16:32'!
extendsClass: aRGBehaviorDefinition
	"Returns true if the receiver extends aRGBehaviorDefinition (that is defined in another package)"
	
	^ self extendedClasses includes: aRGBehaviorDefinition! !

!RGPackage methodsFor: 'lookup' stamp: 'VeronicaUquillas 9/6/2011 17:40'!
lookupClassNamed: className
	"Look for the class named className in the receiver's defined classes or in any of its package children"
	| class |
	
	class:= self classNamed: className.
	class ifNotNil:[ ^class ].
	
	self packages
		do:[ :each| class:= each lookupClassNamed: className.
				    class ifNotNil:[ ^class ] ].
	^nil! !

!RGPackage methodsFor: 'accessing' stamp: 'VeronicaUquillas 9/6/2011 14:50'!
extendedSelectors
	"Retrieves the names of the methods"
	
	^ self extensionMethods keys! !

!RGPackage methodsFor: 'testing' stamp: 'VeronicaUquillas 9/6/2011 16:31'!
definesOrExtendsClass: aRGBehaviorDefinition
	"Returns true whether the class, aRGBehaviorDefinition, is one locally defined classes of the receiver or 
	if the receiver extends such class (that is defined in another package)"
	
	^ (self definesClass: aRGBehaviorDefinition) or:[ self extendsClass: aRGBehaviorDefinition ]! !

!RGPackage methodsFor: 'accessing' stamp: 'VeronicaUquillas 9/7/2011 11:31'!
methods
	"Retrieves all the methods defined in the receiver. 
	#methods holds the methods of defined classes"
	
	^super methods, self extensionMethods ! !

!RGPackage methodsFor: 'testing' stamp: 'VeronicaUquillas 3/20/2011 16:52'!
isPackage

	^true! !

!RGPackage methodsFor: 'accessing' stamp: 'VeronicaUquillas 9/6/2011 17:29'!
classes
	"Retrieves a collection (by default a dictionary) of classes defined in the receiver and classes holding extension methods"
	
	^self definedClasses, self extendedClasses ! !

!RGPackage methodsFor: 'testing' stamp: 'VeronicaUquillas 9/6/2011 16:29'!
definesClass: aRGBehaviorDefinition
	"Returns true if the receiver includes aRGBehaviorDefinition in the defined classes"

	^ self includesClass: aRGBehaviorDefinition! !

!RGPackage methodsFor: 'adding/removing' stamp: 'VeronicaUquillas 9/6/2011 17:54'!
addElement: aRGDefinition in: aCollection

	aRGDefinition package: self.
	super addElement: aRGDefinition in: aCollection.! !

!RGPackage methodsFor: 'adding/removing' stamp: 'VeronicaUquillas 9/6/2011 17:36'!
withoutCategories

	self removeElementsCategorized: #categories! !

!RGPackage methodsFor: 'metrics' stamp: 'VeronicaUquillas 7/2/2012 16:29'!
numberOfLinesOfCode
	
	^ self 
		annotationNamed: #numberOfLinesOfCode
		ifAbsentPut: [
			| number |
			number := self classes inject: 0 into: [ :sum :each | sum + each numberOfLinesOfCode + each theMetaClass numberOfLinesOfCode ].
			number := self methods inject: number into: [ :sum :each | sum + each numberOfLinesOfCode ].
			number ]! !

!RGPackage methodsFor: 'accessing' stamp: 'VeronicaUquillas 9/6/2011 15:06'!
extensionMethods
	"Retrieves extension methods"
	
	^self elements at: #extensionMethods! !

!RGPackage methodsFor: 'accessing' stamp: 'VeronicaUquillas 9/6/2011 17:28'!
extendedClassNames

	^ self extendedClasses isDictionary
		ifTrue: [ self extendedClasses keys ]
		ifFalse:[ self extendedClasses collect:[ :each| each name ]]! !

!RGPackageTest commentStamp: 'TorstenBergmann 2/12/2014 23:08'!
SUnit tests for packages!
!RGPackageTest methodsFor: 'testing' stamp: 'MarcusDenker 8/1/2014 14:06'!
testAddingPackage
	| newPackage childPackage |
	
	newPackage:= RGPackage named: #'Collections'.
	newPackage addPackageNamed: #'Collections-Sequenceable'.
		
	self assert: (newPackage includesPackageNamed: #'Collections-Sequenceable').
	self assert: (newPackage packages size = 1).
	
	childPackage:= newPackage packageNamed: #'Collections-Sequenceable'.
	self assert: (childPackage parent = newPackage parent).
	self assert: (childPackage package = newPackage).! !

!RGPackageTest methodsFor: 'testing' stamp: 'MarcusDenker 8/1/2014 14:06'!
testNewPackage
	| newPackage |
	
	newPackage:= RGPackage named: 'Collections-Sequenceable'.
	
	self assert: (newPackage isPackage).
	self assert: (newPackage name = 'Collections-Sequenceable').
	self assert: (newPackage classes isEmpty).
	self assert: (newPackage traits isEmpty).
	self assert: (newPackage packages isEmpty).
	self assert: (newPackage package isNil).
	self assert: (newPackage parent == Smalltalk globals).! !

!RGPackageTest methodsFor: 'testing' stamp: 'MarcusDenker 8/1/2014 14:10'!
testAddingClass
	| newPackage newClass |
	
	newPackage:= RGPackage named: #'Collections-Sequenceable'.
	newClass:= RGClassDefinition named: #OrderedCollection.
	newPackage addClass: newClass.
	
	self assert: (newPackage hasClasses).
	self assert: (newClass package == newPackage).
	self assert: ((newPackage classNamed: #OrderedCollection) == newClass)! !

!RGPoolVariableDefinition commentStamp: 'TorstenBergmann 2/12/2014 23:08'!
A pool variable definition!
!RGPoolVariableDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 2/22/2011 17:49'!
isPoolVariable

	^true! !

!RGSlice commentStamp: 'VeronicaUquillas 4/22/2011 13:36'!
A slice is an arbitrary container of elements (working unit)
By inheritance it knows how to treat classes and methods
!
!RGSlice methodsFor: 'testing' stamp: 'VeronicaUquillas 4/19/2011 15:30'!
isSlice

	^true! !

!RGSlice methodsFor: 'adding/removing' stamp: 'VeronicaUquillas 9/7/2011 10:47'!
addElement: aRGDefinition in: aCollection

	aRGDefinition environment: self.
	super addElement: aRGDefinition in: aCollection! !

!RGSliceTest commentStamp: 'TorstenBergmann 2/12/2014 23:08'!
SUnit tests for slices!
!RGSliceTest methodsFor: 'testing' stamp: 'MarcusDenker 7/30/2014 10:30'!
testNestingContainers
	| newSlice newSlice2 newClass newTrait newClass2 |
	
	newSlice:= RGSlice named: #Root.
	newSlice2:= RGSlice named: #Child.
	newSlice2 environment: newSlice.
	
	newSlice addClassNamed: #OrderedCollection.
	newClass:= newSlice classNamed: #OrderedCollection.
	newSlice addTraitNamed: #TSortable.
	newTrait:= newSlice traitNamed: #TSortable.
	newSlice2 addClassNamed: #SortedCollection.
	newClass2:= newSlice classNamed: #SortedCollection.
	
	self assert: (newSlice classes size = 2).
	self assert: (newSlice2 classes size = 1).
	self assert: (newSlice2 environment = newSlice).
	self assert: (newSlice2 rootEnvironment = newSlice environment)! !

!RGSliceTest methodsFor: 'testing' stamp: 'MarcusDenker 7/30/2014 10:30'!
testNewSlice
	| newSlice |
	
	newSlice:= RGSlice named: 'Foo'.
	
	self assert: (newSlice isSlice).
	self assert: (newSlice classes isEmpty).
	self assert: (newSlice environment == Smalltalk globals)! !

!RGSliceTest methodsFor: 'testing' stamp: 'MarcusDenker 8/1/2014 14:10'!
testAddingClasses
	| newSlice newClass newTrait  |
	
	newSlice:= RGSlice named: 'Foo'.
	newClass:= RGClassDefinition named: #OrderedCollection.
	newTrait:=  RGTraitDefinition named: #TSortable.
	
	newSlice addClassNamed: #SortedCollection;
			 addClass: newClass;
			 addTrait: newTrait.
	
	self assert: (newSlice classes size = 3).
	self assert: (newSlice traits size = 1).
	self assert: (newSlice includesClassNamed: #OrderedCollection).
	self assert: ((newSlice classNamed: #OrderedCollection) == newClass).
	self assert: ((newSlice traitNamed: #TSortable) == newTrait).
	self assert: (newClass isIncludedInContainer: newSlice).
	self assert: (newTrait isIncludedInContainer: newSlice).
	self assert: (newSlice allClasses size = 3).
	self assert: (newSlice allTraits size = 1).
	self assert: (newClass parent = newSlice).
	self assert: (newClass rootEnvironment = newSlice environment)! !

!RGTraitDefinition commentStamp: 'VeronicaUquillas 4/19/2011 16:03'!
RGTraitDefinition is the concrete representation of a trait (no class)!
!RGTraitDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 5/12/2011 14:45'!
hasComment

	^comment isEmptyOrNil not! !

!RGTraitDefinition methodsFor: 'accessing' stamp: 'MarcusDenker 9/24/2014 16:37'!
comment: anObject
	"Sets a RGCommentDefinition object based on the argument"
	
	comment := anObject isRingObject 
		ifFalse: [ 
			RGCommentDefinition new
				parent: self;
				content: anObject; 
				yourself ]
		ifTrue: [anObject ]
	! !

!RGTraitDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 5/12/2011 10:11'!
hasStamp

	^self stamp isEmptyOrNil not! !

!RGTraitDefinition methodsFor: 'behavior' stamp: 'MarcusDenker 8/1/2014 14:16'!
withMetaclass
	"Registers explicitly the metaclass of a trait"

	metaClass:= RGMetatraitDefinition class: self.
! !

!RGTraitDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 7/27/2011 17:32'!
classVariables

	^#()! !

!RGTraitDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 4/13/2011 21:15'!
category
	"Retrieves the tag-package associated to the receiver"

	^category! !

!RGTraitDefinition methodsFor: 'accessing' stamp: 'MarcusDenker 8/1/2014 14:11'!
stamp: aString

	self hasComment
	ifTrue: [ self comment stamp: aString ]
	ifFalse:[ RGCommentDefinition new
						 parent: self; 
						 stamp: aString ]! !

!RGTraitDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 12/2/2010 18:08'!
hasMetaclass

	^metaClass notNil! !

!RGTraitDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 7/27/2011 17:33'!
instanceVariables

	^#()! !

!RGTraitDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 5/9/2011 14:27'!
comment
	"Retrieves the comment definition object associated to the receiver"
	
	^comment! !

!RGTraitDefinition methodsFor: 'behavior' stamp: 'VeronicaUquillas 5/12/2011 13:20'!
withMetaclass: aRGMetatraitDefinition
	"Registers explicitly the metaclass of a class"

	metaClass:= aRGMetatraitDefinition.
	metaClass baseClass: self.  
! !

!RGTraitDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 4/20/2011 17:36'!
package: aRGPackage
	"Sets the package in which this trait is contained"
	
	package:= aRGPackage! !

!RGTraitDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 5/12/2011 10:09'!
stamp

	^self hasComment ifTrue:[ self comment stamp ] ifFalse:[ nil ]! !

!RGTraitDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 4/13/2011 21:16'!
package
	"Retrieves the package in which this trait is contained"
	
	^package! !

!RGTraitDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 12/2/2010 18:08'!
theMetaClass

	^metaClass! !

!RGTraitDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 11/24/2010 22:32'!
theNonMetaClass

	^self! !

!RGTraitDefinition methodsFor: '*NautilusCommon' stamp: 'BenjaminVanRyseghem 9/1/2011 09:38'!
inheritsFrom: aClass

	^ self realClass inheritsFrom: aClass! !

!RGTraitDefinition methodsFor: 'testing' stamp: 'StephaneDucasse 7/19/2011 10:25'!
isSameRevisionAs: aRGTraitDefinition
	"This method look for equality of the properties of the receiver"

	^(super isSameRevisionAs: aRGTraitDefinition)
		and: [ self category = aRGTraitDefinition category 
		and: [ self traitCompositionSource = aRGTraitDefinition traitCompositionSource 
		and: [ ((self hasComment and: [ self comment isSameRevisionAs: aRGTraitDefinition comment ]) or:[ self hasComment not ])
		and: [ (self theMetaClass isSameRevisionAs: aRGTraitDefinition theMetaClass) ] ] ] ]! !

!RGTraitDefinition methodsFor: 'accessing' stamp: 'MartinDias 10/28/2013 16:42'!
sharedPools

	^#()! !

!RGTraitDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 11/24/2010 13:11'!
category: aSymbol

	category:= aSymbol! !

!RGTraitDefinitionTest commentStamp: 'TorstenBergmann 2/12/2014 23:09'!
SUnit tests for trait definitions!
!RGTraitDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 9/25/2014 13:09'!
testAddingMethods
	| newMethod newClass |
	
	newClass:= RGTraitDefinition named:  #TSortable.
	newMethod:= (RGMethodDefinition named: #sort) parent: newClass;
					protocol: 'sorting'; 
					sourceCode: 'sort
									self sort: [:a :b | a <= b]'.
	
	self assert: (newMethod isMetaSide not).
	self assert: (newClass hasMethods not).

	newClass addMethod: newMethod.
	newClass addSelector: #size 
			   classified: 'accessing' 
			   sourced: 'foo
							^lastIndex - firstIndex + 1'.
	
	self assert: (newClass hasMethods).
	self assert: (newClass selectors = #(sort size)).
	self assert: (newClass includesSelector: #sort).
	self assert: ((newClass methodNamed: #sort) = newMethod).
	self assert: (newClass methods size = 2).
	self assert: (newClass selectors size = 2).
	self assert: (newClass allSelectors size = 2).  "no hierarchy"

	newMethod:= newClass methodNamed: #size.
	self assert: (newMethod parent = newClass).
	
	self assert: ((newClass compiledMethodNamed: #sort) notNil).
	self assert: ((newClass compiledMethodNamed: #foo) isNil)! !

!RGTraitDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 7/30/2014 21:40'!
testExistingTrait
	| newClass metaClass |
	
	newClass:= RGTraitDefinition named:  #TSortable.
	self assert: (newClass isTrait).
	self assert: (newClass isDefined).
	self assert: (newClass realClass = TSortable).
	self assert: (newClass isMeta not).
	
	newClass withMetaclass.
	self assert: (newClass hasMetaclass).
	metaClass:= newClass theMetaClass.
	self assert: (metaClass isMeta).
	self assert: (metaClass name = 'TSortable classTrait').
	self assert: (metaClass theNonMetaClass = newClass).
	self assert: (metaClass realClass = TSortable theMetaClass).! !

!RGTraitDefinitionTest methodsFor: 'testing' stamp: 'ST 6/20/2013 16:55'!
testAsTraitDefinition2

	| newTrait newClass newSlice |
	newClass := Trait asRingDefinitionWithMethods: false withSuperclasses: false withSubclasses: true withPackages: false.
	newSlice := newClass environment.
	self assert: (newClass allSubclasses size = Smalltalk globals environment allTraits size).
	self assert: newClass traitNames size = 1.
	self assert: newClass traits first = (newSlice traitNamed: #TClass).
	
	newTrait := TBehaviorCategorization asRingDefinitionWithMethods: true withSuperclasses: true withSubclasses: false withPackages: true.
	newSlice := newTrait environment.
	self assert: newTrait superclass = (newSlice classNamed: #Trait).
	self assert: newTrait methods size < newSlice methods size.
	self assert: newTrait category = #'Traits-Kernel-Traits'.
	self assert: newTrait package = (newSlice packageNamed: #Traits).
	self assert: newTrait subclasses isEmpty.! !

!RGTraitDefinitionTest methodsFor: '*Ring-Tests-Monticello' stamp: 'CamilloBruni 11/8/2013 18:26'!
testAsFullTraitDefinition
	"self debug: #testAsFullTraitDefinition"
	
	| rgClass |
	rgClass := TBehavior asRingDefinition.
	self assert: rgClass methods isEmpty.
	self assert: rgClass superclass isNil.
	self assert: rgClass subclasses isEmpty.
	self assert: rgClass package isNil.

	rgClass := TBehavior asFullRingDefinition.
	self assert: rgClass methods notEmpty.
	self assert: (rgClass methodNamed: #allSelectors) package notNil.
	self assert: rgClass superclass notNil.
	self assert: rgClass superclass name = #Trait.
	self assert: rgClass subclasses isEmpty.
	self assert: rgClass package notNil.
	self assert: rgClass package = rgClass theNonMetaClass package.
	self assert: rgClass package name = #Traits.
	self assert: rgClass category = #'Traits-Kernel-Traits'.
	
	self assert: rgClass superclass superclass isNil.
	self assert: rgClass superclass package name equals: #Traits.
	
	rgClass := TBehavior theMetaClass asFullRingDefinition.
	self assert: rgClass package = rgClass theNonMetaClass package.! !

!RGTraitDefinitionTest methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 18:43'!
testAsTraitDefinition

	| newTrait |
	newTrait:= TBehavior asRingDefinition.
	self assert: (newTrait isRingObject).
	self assert: (newTrait isTrait).  
	self assert: (newTrait name == #TBehavior).  
	self assert: (newTrait category notNil).
	self assert: (newTrait superclassName notNil).
	
	
	self assert: (newTrait theMetaClass isRingObject).
	self assert: (newTrait theMetaClass isTrait).
	self assert: (newTrait theMetaClass traitCompositionSource = '{}').! !

!RGTraitDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 7/30/2014 21:40'!
testNonExistingClass
	| newClass |
	
	newClass:= RGTraitDefinition named:  #TConnection.
	self assert: (newClass isTrait).
	self assert: (newClass hasMetaclass not).
	self assert: (newClass hasComment not).
	self assert: (newClass hasStamp not).
	self assert: (newClass parent = Smalltalk globals).
	self assert: (newClass package isNil).
	self assert: (newClass category isNil).
	self assert: (newClass hasMethods not).
	self assert: (newClass hasSuperclass not).
	self assert: (newClass hasTraitComposition not).
	self assert: (newClass isDefined not).
	self assert: (newClass hasProtocols not).! !

!RGTraitDefinitionTest methodsFor: 'testing' stamp: 'VeronicaUquillas 8/10/2011 11:42'!
testTraitEquality

	| newClass |
	self assert: TSortable asRingDefinition = TSortable asRingDefinition.
	
	newClass := (TSortable asRingDefinition)
		category: #Kernel.
	self assert: (TSortable asRingDefinition = newClass) ! !

!RGTraitDescriptionDefinition commentStamp: 'VeronicaUquillas 4/19/2011 16:02'!
RGTraitDescriptionDefinition is the common parent for traits and metatraits that know their users (ie. classes/metaclasses)!
!RGTraitDescriptionDefinition methodsFor: 'accessing' stamp: 'NicolaiHess 11/27/2014 23:10'!
traitUsers
	"Retrieves the receiver's classes and traits"
	
	^users ifNil:[ users := OrderedCollection new ]! !

!RGTraitDescriptionDefinition methodsFor: 'variables' stamp: 'VeronicaUquillas 4/12/2011 10:04'!
allInstVarNames

	^#()! !

!RGTraitDescriptionDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 7/27/2011 18:10'!
users
	"Retrieves the receiver's classes and traits"
	
	^users ifNil:[ users := OrderedCollection new ]! !

!RGTraitDescriptionDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 2/16/2011 00:03'!
users: aCollection

	users:= aCollection! !

!RGTraitDescriptionDefinition methodsFor: 'variables' stamp: 'VeronicaUquillas 4/14/2011 11:28'!
allClassVarNames

	^#()! !

!RGTraitDescriptionDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 11/19/2010 11:59'!
isTrait

	^true! !

!RGTraitDescriptionDefinition methodsFor: 'adding/removing users' stamp: 'VeronicaUquillas 7/27/2011 18:15'!
removeUser: aRGBehavior

	self users remove: aRGBehavior ifAbsent:[]! !

!RGTraitDescriptionDefinition methodsFor: 'variables' stamp: 'MartinDias 10/28/2013 16:17'!
allSharedPoolNames

	^#()! !

!RGTraitDescriptionDefinition methodsFor: 'accessing' stamp: 'NicolaiHess 11/27/2014 23:10'!
traitUsers: aCollection

	users:= aCollection! !

!RGTraitDescriptionDefinition methodsFor: 'adding/removing users' stamp: 'VeronicaUquillas 7/27/2011 18:15'!
addUser: aRGBehavior

	self users add: aRGBehavior! !

!RGVariableDefinition commentStamp: 'TorstenBergmann 2/12/2014 23:07'!
A variable definition!
!RGVariableDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 2/22/2011 17:52'!
isPoolVariable

	^false! !

!RGVariableDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 9/16/2011 16:26'!
environment

	^ self parent environment ! !

!RGVariableDefinition methodsFor: 'comparing' stamp: 'VeronicaUquillas 8/2/2011 13:03'!
hash

	^super hash bitXor: self name hash! !

!RGVariableDefinition methodsFor: 'comparing' stamp: 'VeronicaUquillas 8/2/2011 13:03'!
= aRGVariableDefinition
	"This variable look for equality of the key properties of the receiver"

	^(super = aRGVariableDefinition)
		and:[ self name == aRGVariableDefinition name ]! !

!RGVariableDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 11/16/2010 14:47'!
isClassInstanceVariable

	^false! !

!RGVariableDefinition methodsFor: 'accessing' stamp: 'VeronicaUquillas 7/28/2011 10:14'!
fullName
	"Keeps a unique description for the receiver. As annotation to avoid converting each time is invoked"
	
	^self annotationNamed: self class fullNameKey
		ifAbsentPut:[ (self parentName, '->', self name) asSymbol ]! !

!RGVariableDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 11/19/2010 12:00'!
isVariable

	^true! !

!RGVariableDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 11/16/2010 14:47'!
isClassVariable

	^false! !

!RGVariableDefinition methodsFor: 'testing' stamp: 'VeronicaUquillas 11/16/2010 14:47'!
isInstanceVariable

	^false! !

!RGVariableDefinitionTest commentStamp: 'TorstenBergmann 2/12/2014 23:10'!
SUnit tests for variable definitions!
!RGVariableDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 9/19/2014 12:42'!
testPoolVariable
	| poolVar newClass |
	
	poolVar:= RGPoolVariableDefinition named: 'TextConstants'.
	
	self assert: (poolVar isPoolVariable).
	self assert: (poolVar isVariable).
	self assert: (poolVar name = 'TextConstants').
	self assert: (poolVar parent isNil).
	self assert: (poolVar isMetaSide not).
	
	newClass:= RGClassDefinition named: #OrderedCollection.
	poolVar:= (RGPoolVariableDefinition named:  'TextConstants' ) parent: newClass.
	self assert: (poolVar parent = newClass).
	self assert: (newClass sharedPools isEmpty).
	
	newClass sharedPools add: poolVar.
	self assert: (newClass sharedPools size = 1).! !

!RGVariableDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 9/24/2014 16:41'!
testClassInstanceVariable
	| instVar newClass metaClass |
	
	instVar:= RGClassInstanceVariableDefinition named: 'sizes'.
	
	self assert: (instVar isClassInstanceVariable).
	self assert: (instVar isVariable).
	self assert: (instVar name = 'sizes').
	self assert: (instVar parent isNil).
	self assert: (instVar isMetaSide).
	
	newClass:= RGClassDefinition named: #OrderedCollection.
	newClass withMetaclass.
	metaClass:= newClass theMetaClass.
	instVar:= metaClass addInstVarNamed: 'sizes'.
	self assert: (instVar parent = metaClass).	
	self assert: (metaClass instanceVariables size = 1).! !

!RGVariableDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 9/24/2014 16:42'!
testInstanceVariable
	| instVar newClass |
	
	instVar:= RGInstanceVariableDefinition named: 'size'.
	
	self assert: (instVar isInstanceVariable).
	self assert: (instVar isVariable).
	self assert: (instVar name = 'size').
	self assert: (instVar parent isNil).
	self assert: (instVar isMetaSide not).
	
	newClass:= RGClassDefinition named: #OrderedCollection.
	instVar:= newClass addInstVarNamed: 'array'.
	self assert: (instVar parent = newClass).
	self assert: (newClass instanceVariables size = 1).! !

!RGVariableDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 9/19/2014 11:51'!
testClassVariable
	| instVar newClass |
	
	instVar:= RGClassVariableDefinition named: 'DependentsFields'.
	
	self assert: (instVar isClassVariable).
	self assert: (instVar isVariable).
	self assert: (instVar name = 'DependentsFields').
	self assert: (instVar parent isNil).
	self assert: (instVar isMetaSide not).   
	
	newClass:= RGClassDefinition named: #Object.
	instVar:= (RGClassVariableDefinition named: 'DependentsFields') parent: newClass.
	
	self assert: (instVar parent = newClass).
	self assert: (newClass classVariables isEmpty).
	
	newClass classVariables add: instVar.
	self assert: (newClass classVariables size = 1).! !

!RGVariableDefinitionTest methodsFor: 'testing' stamp: 'MarcusDenker 8/1/2014 14:18'!
testVariableEquality

	| variable1 variable2|
	
	variable1 := (OrderedCollection asRingDefinition) instanceVariableNamed: #array.
	variable2 := (OrderedCollection asRingDefinition) instanceVariableNamed: #array.
	self assert: variable1 = variable2.

	variable1 := (RGClassVariableDefinition named:  #Foo) parentName: #Test.
	variable2 := (RGClassVariableDefinition named:  #Foo) parentName: #Test.
	self assert: variable1 = variable2.
	
	variable2 := (RGClassVariableDefinition named:  #Foo) parentName: #Test2.
	self deny: variable1 = variable2.
	! !

!RPackage commentStamp: 'StephaneDucasse 7/25/2011 21:55'!
A RPackage is a new implementation of package. Note that it does not touch classes but it is just a layer on top of classes therefore removing a method from a package does not change the underlying class. 


Instance Variables
	classDefinedSelectors:		Dictionary
	classExtensionSelectors:		Dictionary
	metaclassDefinedSelectors:		Dictionary
	metaclassExtensionSelectors:		Dictionary
	packageName:		String
	classes: OrderedCollection of Symbols
	classTags: is a mapping from tags to classNames

The reason we use four dictionaries is that this way we only store #Point in both as the class and the metaclass are involved. We do not have to with Point_class problem when comparing defined and extended classes. The idea is taken from the RBSelectorEnvironment. 					
		
Class Invariant one:
	Classes should not contain metaclass name, but only class names
	
	

Implementation notes 
====================
This class went over 3 internal representations implementation. 
	- first: 	a list of class + two dictionaries: class * methods
	This was not good since we add to go all the time over the list of classes.
	- second: 4 dictionaries class * selectors 
	This was not good since we want to have defined classes without methods. 
	- third: 4 dictionaries + definedClasses

Originally I wanted to avoid to have a defined class list and I wanted to avoid to have to declare the class as defined. But this is not really good since
	- we will want to know if a class definition (without method for example is defined in a given package)
	- second this is easier to hook the packageOf: behavior (we register the package class when the class is 	added to the package).

defined classes information is redundant with the dictionary keys of defined methods but we would have to check and register the class to the packageOrganizer the first time a method is defined then also check on remove to unregister the class from the packageOrganizer.

Adding a method does not define the class as a defined package class. This has to be done explictly. The reason for this choice is that a class should register to the packageOrganizer and that I do not want to do it each time a method is added and I do not want to test it each time a method is added. Now this is done only when the class is declared as defined. 
We could also give the complete freedom to the client to register the class but I thought it was a good compromise. 
	
	
ClassTag are tags that can be associated to classes. They help user organizing their class internal. 
So that we can have a package infrastructure as follows:
	Package1
		ClassA
		ClassB
	in case there is no tags associated to the package
	or
	Package2	
		Tag1
			ClassA
			ClassB
		Tag2
			ClassC
			ClassD
			ClassE
			ClassA		
	
Todo
====
	Next: 
	- finish 
	- build up a synchronizer that import PackageInfo.
	

	

	
!
!RPackage methodsFor: 'testing' stamp: 'MarcusDenker 1/19/2014 23:15'!
includesClassNamed: aSymbol
	"Returns true if the receiver includes class named aSymbol in the classes that are defined within it: only class definition are considered - not class extensions"
	
	^ classes includes: aSymbol asSymbol
	! !

!RPackage methodsFor: 'class tags' stamp: 'EstebanLorenzano 10/10/2013 14:25'!
classTags
	"Returns the tags of the receiver"
	
	^ classTags! !

!RPackage methodsFor: 'class tags' stamp: 'GuillermoPolito 2/14/2014 13:05'!
classTagNamed: aSymbol

	^ classTags detect: [ :each | each name = aSymbol ]! !

!RPackage methodsFor: 'class addition' stamp: 'DamienPollet 10/1/2010 11:37'!
addClassDefinition: aClass
	"Add only the class definition of aClass, as a class defined by the receiver. The term classdefinition denotes the fact that we do not treat its methods. aClass methods are not added to the package. aClass can be either a class or a metaclass"
	
	self addClassDefinitionName: aClass theNonMetaClass name.
	! !

!RPackage methodsFor: 'accessing' stamp: 'ThierryGoubier 2/13/2013 23:10'!
extensionMethodsForClass: aClass
	"Change the set of extensions selectors to an Array to avoid compiled methods collisions in the resulting set."

	^ (self extensionSelectorsForClass: aClass) asArray collect: [ :each | aClass >> each ]! !

!RPackage methodsFor: 'testing' stamp: 'StephaneDucasse 2/21/2010 18:53'!
includesDefinedSelector: aSelector ofClassName: aClassName
	"Return true if the receiver includes the method of selector aSelector. Only checks methods defined (not extended by other packages or package extensions)"
	
	| sels |
	sels := classDefinedSelectors at: aClassName ifAbsent: [^ false].
	^ sels includes: aSelector.! !

!RPackage methodsFor: 'selector handling' stamp: 'StephaneDucasse 4/20/2010 22:56'!
addSelector: aSelector ofClassName: aClassName
	"Add the method to the receiver. If the class is not locally defined in that package then the method is defined as a method extension: ie extending another package. Note that this method does not add the method to the class, it just records in the package that the method is packaged."
	
	( self includesClassNamed: aClassName)
		ifFalse: [(classExtensionSelectors at: aClassName asSymbol ifAbsentPut: [Set new]) add: aSelector]
		ifTrue: [(classDefinedSelectors at: aClassName asSymbol ifAbsentPut: [Set new]) add: aSelector].
	^ aSelector.! !

!RPackage methodsFor: 'updating' stamp: 'cyrille.delaunay 11/16/2010 15:08'!
updateSelector: oldSelector inClass: aClass withNewSelector: newSelector

	"here we check if the old seletor is defined in the package or if it is an extension. Then we dispatch the work to the corresponding method.
	For one specific class, a selector is either a defined selector or an extension selector, there is no way to have a couple of class->selector present in both dictionary"
	
	(self includesDefinedSelector: oldSelector ofClass: aClass) 
		ifTrue: [^ self updateDefinedSelector: oldSelector inClass: aClass  withNewSelector: newSelector].
	(self includesExtensionSelector: oldSelector ofClass: aClass)
		ifTrue: [^ self updateExtensionSelector: oldSelector inClass: aClass  withNewSelector: newSelector].
		
		! !

!RPackage methodsFor: 'private' stamp: 'EstebanLorenzano 1/3/2014 11:07'!
renameExtensionsPrefixedWith: oldName to: newName
	| protocols |
	
	protocols := self extensionMethods 
		collect: [ :each | each origin organization protocolNamed:  each protocol ]
		as: Set.
		
	protocols do: [ :each | each rename: '*', newName, (each name allButFirst: oldName size + 1) ]		
	! !

!RPackage methodsFor: 'private-register' stamp: 'GuillermoPolito 8/5/2012 13:22'!
removeAllMethodsFromClassNamed: aClassNameSymbol
	"Remove all the methods (defined and extensions) that are related to class aClassNameSymbol. aClassNameSymbol is the name of a class and not a metaclass - see class comment."

	classDefinedSelectors removeKey: aClassNameSymbol ifAbsent: [nil].
	classExtensionSelectors removeKey: aClassNameSymbol ifAbsent: [nil].
	metaclassDefinedSelectors removeKey: aClassNameSymbol ifAbsent: [nil].
	metaclassExtensionSelectors removeKey: aClassNameSymbol ifAbsent: [nil].! !

!RPackage methodsFor: 'accessing' stamp: 'YuriyTymchuk 12/20/2013 15:30'!
extendedClasses 
	"Return classes and metaclasses that are extended in the receiver. They represent the classes of method extensions"
	^ (metaclassExtensionSelectors keys 
		select: [ :each| Smalltalk globals includesKey: each ]
		thenCollect: [:each | (Smalltalk globals at: each) theMetaClass])
			union:  (classExtensionSelectors keys 
						select: [ :each| Smalltalk globals includesKey: each ]
						thenCollect: [:each | Smalltalk globals at: each])! !

!RPackage methodsFor: 'private' stamp: 'ThierryGoubier 2/5/2014 07:14'!
moveClass: aClass fromPackage: oldPackage toTag: aTag 

	oldPackage removeClass: aClass.
	self importClass: aClass inTag: aTag.
	
	SystemAnnouncer uniqueInstance 
		classRepackaged: aClass 
		from: oldPackage 
		to: self.! !

!RPackage methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/24/2015 14:46'!
spotterClassesFor: aStep
	<spotterOrder: 20>
	aStep listProcessor
			allCandidates: [ self definedClasses sorted: [ :a :b | a name < b name ] ];
			title: 'Classes';
			filter: GTFilterSubstring! !

!RPackage methodsFor: 'private' stamp: 'StephaneDucasse 4/25/2011 12:26'!
definedMethodsBecomeExtendedForClass: aClassName
	"the package may contain defined methods and their class is removed to the receiver. The status of such methods should now be extended"
	"Precondition: aClassName is in the defined list"
	
	| ext |
	(classDefinedSelectors keys includes: aClassName) ifFalse: [^ self].
	ext := classDefinedSelectors at: aClassName.
	classDefinedSelectors removeKey: aClassName ifAbsent: [self reportBogusBehaviorOf:   #definedMethodsBecomeExtendedForClass: ].
	(classExtensionSelectors keys includes: aClassName) ifTrue: [self error: aClassName , ' should not be defined in extension'.]. "we should remove this check later"
	classExtensionSelectors at: aClassName put: ext.! !

!RPackage methodsFor: 'private' stamp: 'EstebanLorenzano 12/13/2013 15:32'!
renameTagsPrefixedWith: oldName to: newName
	| oldPrefix newPrefix |
	
	oldName ifNil: [ ^ self ].
	
	self 
		classTagNamed: oldName 
		ifPresent: [ :tag | tag renameTo: newName category: newName ].	
	
	oldPrefix := oldName, '-'.
	newPrefix := newName, '-'.
	(self classTags 
		select: [ :each | each categoryName beginsWith: oldPrefix ])
		do: [ :each | 
			each 
				renameTo: each name 
				category: newPrefix, (each name) ]! !

!RPackage methodsFor: 'initialization' stamp: 'EstebanLorenzano 10/10/2013 14:33'!
initialize
	super initialize.	
	classes := Set new.
	metaclassExtensionSelectors := Dictionary new.
	classExtensionSelectors := Dictionary new.
	classDefinedSelectors := Dictionary new.
	metaclassDefinedSelectors := Dictionary new.
	classTags := Set new.! !

!RPackage methodsFor: 'testing' stamp: 'tg 3/13/2010 16:42'!
includesSelector: aSelector ofClass: aClass
	"Return true if the receiver includes the method of selector aSelector. Checks methods defined locally as well as extending other packages"
	
	^ aClass isMeta
		ifTrue: [ self includesSelector: aSelector ofMetaclassName: aClass theNonMetaClass name  ]
		ifFalse: [ self includesSelector: aSelector ofClassName: aClass name  ]
	
! !

!RPackage methodsFor: 'system compatibility' stamp: 'StephaneDucasse 4/27/2011 11:37'!
extensionClasses
	self flag: #stef. "only used by RB and Gofer"
	^ self extendedClasses! !

!RPackage methodsFor: 'accessing' stamp: 'cyrilledelaunay 5/13/2011 13:23'!
packageName

	^ name! !

!RPackage methodsFor: 'accessing' stamp: 'ThierryGoubier 1/26/2014 19:27'!
addClass: aClass
	"TODO: deprecate system category / replace this with a direct call to moveClass:fromPackage:toTag:"
	
	"This does two things:
		- make sure the class tag for ourselves exists
		- change the class category as appropriate.
			(and by cascade, ensure systemClassRecategorizedAction: is called)."
	
	aClass category: (self addClassTag: self categoryName) categoryName! !

!RPackage methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 1/28/2015 21:01'!
spotterPreviewCodeIn: aComposite
	<spotterPreview: 10>
	aComposite list
		title: 'Preview';
		display: [ :x | x ];
		format: [ :class | GTSpotterItemBrick new text: class gtDisplayString; icon: class systemIcon; disable; yourself ];
		entity: self classes asArray.
		
	self flag: 'move "entity: self" somewhere else, maybe'! !

!RPackage methodsFor: 'updating' stamp: 'StephaneDucasse 4/25/2011 12:29'!
updateExtensionForClassNamed: oldString withNewName: newString

	"=> update the 'classExtensionsSelectors' dictionary (replace the old key by the new one)
        => update the 'metaclassclassExtensionsSelectors' dictionary (replace the old key by the new one)"
	"classes remove: oldString.
	classes add: newString."
	
	(metaclassExtensionSelectors at: oldString ifAbsent: [nil]) ifNotNil: [
		metaclassExtensionSelectors at: newString put: (metaclassExtensionSelectors at: oldString).
		metaclassExtensionSelectors removeKey: oldString  ifAbsent: [self reportBogusBehaviorOf: #updateExtensionForClassNamed:withNewName:   ]
		].
	
	(classExtensionSelectors at: oldString ifAbsent: [nil]) ifNotNil: [
		classExtensionSelectors at: newString put: (classExtensionSelectors at: oldString).
		classExtensionSelectors removeKey: oldString ifAbsent: [self reportBogusBehaviorOf: #updateExtensionForClassNamed:withNewName:   ]
		].! !

!RPackage methodsFor: 'system compatibility' stamp: 'RPackage 1/20/2011 13:35'!
systemOrganization 

	^ Smalltalk globals organization! !

!RPackage methodsFor: 'private' stamp: 'ThierryGoubier 1/26/2014 19:28'!
moveClass: aClass toTag: aTag
	"TODO: deprecate system categories / replace this with a direct call to moveClass:fromPackage:toTag:"
	
	"This change the class category as appropriate.
		(and by cascade, ensure systemClassRecategorizedAction: is called)."

	aClass category: aTag categoryName! !

!RPackage methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/24/2015 14:46'!
spotterExtensionMethodsFor: aStep
	<spotterOrder: 30>
	aStep listProcessor
			allCandidates: [ self extensionMethods ];
			title: 'Extension Methods';
			filter: GTFilterSubstring! !

!RPackage methodsFor: 'testing' stamp: 'StephaneDucasse 2/21/2010 17:56'!
includesClass: aClass	
	"Returns true if the receiver includes aClass in the classes that are defined within it: only class definition are considered - not class extensions"
	
	^ self includesClassNamed: aClass theNonMetaClass name! !

!RPackage methodsFor: 'testing' stamp: 'StephaneDucasse 3/11/2010 17:38'!
includesSelector: aSelector ofMetaclassName: aClassName
	"Return true if the receiver includes the method of selector aSelector. Checks methods defined locally as well as extending other packages"
	
	^ (self includesDefinedSelector: aSelector ofMetaclassName: aClassName)
		or: [(self includesExtensionSelector: aSelector ofMetaclassName: aClassName)]! !

!RPackage methodsFor: '*Nautilus' stamp: 'EstebanLorenzano 11/27/2013 13:18'!
asNautilusNodeWithModel: anObject
	^ PackageTreePackageNodeModel with: self model: anObject.! !

!RPackage methodsFor: 'system compatibility' stamp: 'RPackage 1/20/2011 13:33'!
includesSystemCategory: categoryName
	^ self category: categoryName matches: self systemCategoryPrefix! !

!RPackage methodsFor: 'system compatibility' stamp: 'RPackage 1/20/2011 13:34'!
methodsInCategory: aString ofClass: aClass do: aBlock
	((aClass organization listAtCategoryNamed: aString) ifNil: [^self])
		do: [:sel | aBlock value: (self referenceForMethod: sel ofClass: aClass)]! !

!RPackage methodsFor: 'all accessing' stamp: 'EstebanLorenzano 10/8/2013 16:36'!
methods
	| methods |
	
	methods := OrderedCollection new.
	
	metaclassExtensionSelectors keysAndValuesDo: [:key :val | 
		val do: [:sel | 	methods add: ((Smalltalk at: key) theMetaClass >> sel)]].
	classExtensionSelectors keysAndValuesDo: [:key :val |
		val do: [:sel | methods add: ((Smalltalk at: key) >> sel)]].
	
	metaclassDefinedSelectors keysAndValuesDo: [:key :val | 
		val do: [:sel | methods add: ((Smalltalk at: key) theMetaClass >> sel)]].
	classDefinedSelectors keysAndValuesDo: [:key :val | 
		val do: [:sel | methods add: ((Smalltalk at: key) >> sel)]].
	
	^ methods! !

!RPackage methodsFor: 'class tags' stamp: 'EstebanLorenzano 12/12/2013 18:03'!
classTagForClass: aClass 
	^ self 
		classTagNamed: (self toTagName: aClass category) 
		ifAbsent: [ nil ]! !

!RPackage methodsFor: 'system compatibility' stamp: 'RPackage 1/20/2011 13:35'!
overriddenMethodsInClass: aClass do: aBlock
	"Evaluates aBlock with the overridden methods in aClass"
	^ self overrideCategoriesForClass: aClass do: [:cat |
		self methodsInCategory: cat ofClass: aClass do: aBlock]! !

!RPackage methodsFor: 'system compatibility' stamp: 'CamilloBruni 8/27/2013 01:40'!
includesMethodReference: aMethodRef

	self flag: 'includesMethod:ofClass: is not implemented for RPackage. Should fine fine a corresponding one '.
	self flag: #stef. "We can inline this one and replace it by selector and others."
	^ self includesMethod: aMethodRef selector ofClass: aMethodRef actualClass
	"^ self includesDefinedSelector: aMethodRef selector ofClass: aMethodRef actualClass"! !

!RPackage methodsFor: 'system compatibility' stamp: 'RPackage 1/20/2011 13:35'!
systemCategoryPrefix
	^ self name! !

!RPackage methodsFor: 'accessing' stamp: 'GuillermoPolito 8/5/2012 13:33'!
extensionSelectorsForClass: aClass

	^ aClass isMeta
		ifTrue: [ metaclassExtensionSelectors at: aClass theNonMetaClass originalName ifAbsent: [ #() ] ]
		ifFalse: [ classExtensionSelectors at: aClass originalName ifAbsent: [ #() ] ]! !

!RPackage methodsFor: 'accessing' stamp: 'EstebanLorenzano 1/3/2014 09:57'!
name: aSymbol
	name := aSymbol asSymbol.! !

!RPackage methodsFor: 'updating' stamp: 'cyrille.delaunay 11/16/2010 14:41'!
updateExtensionSelector: oldSelector inClass: aClass withNewSelector: newSelector

	aClass isMeta
		ifTrue: [
			(metaclassExtensionSelectors at: aClass instanceSide name asSymbol) remove: oldSelector. 
			(metaclassExtensionSelectors at: aClass instanceSide name asSymbol) add: newSelector. 
			]
		ifFalse: [
			(classExtensionSelectors  at: aClass name asSymbol) remove: oldSelector. 
			(classExtensionSelectors  at: aClass name asSymbol) add: newSelector. 
			]! !

!RPackage methodsFor: 'selector handling' stamp: 'GuillermoPolito 5/29/2012 14:12'!
removeSelector: aSelector ofMetaclassName: aClassName
	"Remove the method in the package. Note that this method does not remove the method from the class, it just records in the package that the method is not in the package anymore. aClassName is the sole instance class name and not its metaclass one: i.e. adding Point class>>new is done as removeSelector: #new ofMetaclassName: #Point"
	
	self basicRemoveSelector: aSelector ofMetaclassName: aClassName.
	(metaclassExtensionSelectors at: aClassName ifAbsent: [ #() ]) ifEmpty: [
		metaclassExtensionSelectors removeKey: aClassName ifAbsent: [].
	].
	(metaclassDefinedSelectors at: aClassName ifAbsent: [ #() ]) ifEmpty: [
		metaclassDefinedSelectors removeKey: aClassName ifAbsent: [].
	].

	((metaclassExtensionSelectors at: aClassName ifAbsent: [#()]) isEmpty and: [(classExtensionSelectors at: aClassName ifAbsent: [#()]) isEmpty])
		ifTrue: [
				self organizer unregisterExtendingPackage: self forClassName: aClassName
	]! !

!RPackage methodsFor: 'selector handling' stamp: 'GuillermoPolito 5/29/2012 14:04'!
basicRemoveSelector: aSelector ofClassName: aClassName
	"Remove the method in the package but does not propagate to the class itself.  Note that this method does not remove the method from the class, it just records in the package that the method is not in the package anymore."
	
	( self includesClassNamed: aClassName)
		ifFalse: [(classExtensionSelectors  at: aClassName ifAbsent: [ ^ Set new]) remove: aSelector.]
		ifTrue: [(classDefinedSelectors  at: aClassName ifAbsent: [ ^ Set new]) remove: aSelector.].
	
	! !

!RPackage methodsFor: 'slices' stamp: 'DamienPollet 10/1/2010 11:48'!
classExtensionSlicesDo: aBlock
	"This method iterates over the class extensions and their associated selectors. A slice is a class * list of selectors. aBlock will be applied to all the extensions slices of the receiver. aBlock first argument is the class and the second argument a list of method selectors"
	
	classExtensionSelectors keysAndValuesDo: aBlock! !

!RPackage methodsFor: 'system compatibility' stamp: 'RPackage 1/20/2011 13:34'!
overriddenMethodsDo: aBlock
	"Enumerates the methods the receiver contains which have been overridden by other packages"
	^ self allOverriddenMethodsDo: [:ea |
		(self isOverrideOfYourMethod: ea)
			ifTrue: [aBlock value: ea]]! !

!RPackage methodsFor: 'system compatibility' stamp: 'EstebanLorenzano 6/27/2013 18:05'!
extensionCategoriesForClass: aClass
	self flag: #stef. "only used by goferCleanUp and PackageEnvironment of RB"
	^ aClass organization realCategories select: [:cat | self isYourClassExtension: cat]! !

!RPackage methodsFor: 'private-register' stamp: 'StephaneDucasse 5/26/2012 16:53'!
removeClassDefinitionNamed: aClassNameSymbol
	"aClassNameSymbol should be the name of a class and not a metaclass to be coherent with the class invariant that classes are only class names and not metaclass ones. 
	
	This method removes the class definition from the receiver and its organizer"

	| removed |
	removed := classes remove: aClassNameSymbol ifAbsent: [nil].
	removed ifNotNil: [ self unregisterClassName: aClassNameSymbol.] 
	! !

!RPackage methodsFor: 'system compatibility' stamp: 'cyrilledelaunay 2/9/2011 13:46'!
methodReferences
	
	^ self methods collect: [:each | each methodReference] thenSelect: [:each| each isValid and: [each isLocalSelector]].! !

!RPackage methodsFor: 'converting' stamp: 'EstebanLorenzano 2/22/2014 11:36'!
demoteToRPackageNamed: aString 
	| newRPackage |

	self unregister.
	newRPackage := self class organizer 
		packageNamed: aString 
		ifAbsent:  [ (self class named: aString) register ].
	newRPackage importPackage: self.
		
	newRPackage classes do: [ :each | 
		SystemAnnouncer uniqueInstance 
			classRepackaged: each 
			from: self  
			to: newRPackage ].! !

!RPackage methodsFor: '*Monticello-RPackage' stamp: 'MarcusDenker 7/16/2014 17:23'!
mcPackage
	"Answers the corresponding MCPackage. 
	 Normally it should exist, but in certain patterns could happen that the monticello package is not there. "
	
	^ MCWorkingCopy allManagers 
		detect: [  :each | each package name = name ]
		ifFound: [ :workingCopy | workingCopy package  ]
		ifNone: [ nil ].
	! !

!RPackage methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/26/2015 21:01'!
spotterTagsFor: aStep
	<spotterOrder: 20>
	self classTags size <= 1 ifTrue: [ ^ self ].
	aStep listProcessor
			allCandidates: [ self classTags sorted: [ :a :b | a name < b name ] ];
			title: 'Tags';
			itemName: [ :item | item name ];
			filter: GTFilterSubstring! !

!RPackage methodsFor: 'accessing' stamp: 'EstebanLorenzano 9/24/2012 16:44'!
register
	self organizer registerPackage: self! !

!RPackage methodsFor: 'class tags' stamp: 'EstebanLorenzano 10/10/2013 14:34'!
classTagNamed: aSymbol ifAbsent: aBlock 
	^ classTags 
		detect: [ :each | each name = aSymbol ]
		ifNone: aBlock! !

!RPackage methodsFor: 'class tags' stamp: 'EstebanLorenzano 10/10/2013 14:23'!
addClassDefinitionName: aClassName toClassTag: aSymbol
	"Tags the class aClass with the tag aSymbol"
	
	(self addClassTag: aSymbol) addClassNamed: aClassName.! !

!RPackage methodsFor: 'class tags' stamp: 'EstebanLorenzano 2/7/2014 15:06'!
addClassTag: aSymbol
	"Add the class tag from the receiver, if already added do nothing."
	| tagName |

	"strip package name if needed"
	tagName := self toTagName: aSymbol.
	
	^ self 
		classTagNamed: tagName
		ifAbsent: [ 
			self class organizer 
				validateCanBeAddedPackage: self
				tagName: tagName.
			self basicAddClassTag: tagName ]! !

!RPackage methodsFor: 'system compatibility' stamp: 'RPackage 1/20/2011 13:33'!
includesMethodCategory: categoryName ofClass: aClass
	^ (self isYourClassExtension: categoryName)
		or: [(self includesClass: aClass)
				and: [(self isForeignClassExtension: categoryName) not]]! !

!RPackage methodsFor: 'system compatibility' stamp: 'EstebanLorenzano 10/8/2013 17:26'!
packages 
	"Compatibility with monticello and old PackageInfo"
	^ self classTags! !

!RPackage methodsFor: '*Manifest-Core' stamp: 'CamilleTeruel 11/12/2013 19:44'!
manifestBuilderForRuleChecker: aRuleChecker
	"Return the manifestsince the rulechecker is keeping a cache, we ask it back"

	^ aRuleChecker manifestBuilderOfPackage: self! !

!RPackage methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 12/11/2014 21:21'!
spotterActDefault
	^ PackageTreeNautilus openOnPackage: self! !

!RPackage methodsFor: 'printing' stamp: 'StephaneDucasse 5/9/2011 17:03'!
printOn: aStream
	super printOn: aStream.
	aStream nextPut: $(.
	aStream nextPutAll: self name.
	aStream nextPut: $)! !

!RPackage methodsFor: 'class tags' stamp: 'EstebanLorenzano 12/12/2013 18:03'!
classesForClassTag: aSymbol
	"Returns the classes tagged using aSymbol"
	
	^ (self 
		classTagNamed: (self toTagName: aSymbol) 
		ifAbsent: [ ^ #() ])
		classes! !

!RPackage methodsFor: 'class tags' stamp: 'EstebanLorenzano 12/12/2013 18:03'!
classTagNamed: aSymbol ifPresent: aBlock
	^ classTags 
		detect: [ :each | each name = aSymbol ] 
		ifFound: [ :tag | aBlock cull: tag ] 
		ifNone: [ nil ]! !

!RPackage methodsFor: 'testing' stamp: 'StephaneDucasse 2/21/2010 20:50'!
includesSelector: aSelector ofClassName: aClassName
	"Return true if the receiver includes the method of selector aSelector. Checks methods defined locally as well as extending other packages"
	
	^ (self includesDefinedSelector: aSelector ofClassName: aClassName)
		or: [(self includesExtensionSelector: aSelector ofClassName: aClassName)]! !

!RPackage methodsFor: 'system compatibility' stamp: 'RPackage 1/20/2011 13:34'!
overriddenMethods
	^ Array streamContents: [:stream |
		self overriddenMethodsDo: [:each | stream nextPut: each]]
! !

!RPackage methodsFor: 'testing' stamp: 'StephaneDucasse 2/21/2010 18:53'!
includesDefinedSelector: aSelector ofMetaclassName: aClassName
	"Return true if the receiver includes the method of selector aSelector. Only checks methods defined (not extended by other packages or package extensions)"
	
	| sels |
	sels := metaclassDefinedSelectors at: aClassName ifAbsent: [^ false].
	^ sels includes: aSelector.! !

!RPackage methodsFor: 'slices' stamp: 'StephaneDucasse 3/11/2010 18:40'!
classNamesAndExtensionSelectorsDo: aBlock
	"Iterate over the extended methods grouped by classes and apply the argument.
	The block will be passed a class name and each individual selectors.
	Only classes with methods are paired with their methods"
	
	classExtensionSelectors keysAndValuesDo: [ :classSymbol :methods |
			methods do: [ :sel |  aBlock value: classSymbol	value: sel]].
	
	metaclassExtensionSelectors keysAndValuesDo: [ :classSymbol :methods |
			methods do: [ :sel |  aBlock 
									value: (classSymbol, '_class') asSymbol
									value: sel]].	! !

!RPackage methodsFor: 'system compatibility' stamp: 'RPackage 1/20/2011 13:35'!
overrideCategoriesForClass: aClass do: aBlock
	"Evaluates aBlock with all the *foo-override categories in aClass"
	^ aClass organization categories do: [:cat |
		(self isOverrideCategory: cat) ifTrue: [aBlock value: cat]]! !

!RPackage methodsFor: 'private' stamp: 'ThierryGoubier 1/27/2014 13:44'!
basicImportClass: aClass
	"Add the class definition and all the selectors which are not extensions of other packages. If the class had an extension to us, then all methods in that extension are moved to 'as yet unclassified' and the extension protocol is deleted (should I use silently or not?)."
	
	"Note: Protocol defaultName is #'as yet unclassified'"

	"Question: should we check that for each extension, there is a real package behind or not?"

	| protocols |
	self addClassDefinition: aClass.
	aClass organization realCategories
		do: [ :each | 
			(self isYourClassExtension: each)
				ifTrue: [ aClass organization renameCategory: each toBe: Protocol defaultName ] ].
	protocols := aClass organization realCategories reject: [ :each | each first = $* ].
	protocols do: [ :each | self importProtocol: each forClass: aClass ]! !

!RPackage methodsFor: '*Nautilus' stamp: 'JurajKubelka 2/3/2015 23:24'!
asNautilusItemPath
	^ Array with: self! !

!RPackage methodsFor: 'system compatibility' stamp: 'cyrilledelaunay 5/4/2011 15:38'!
includesMethod: aSymbol ofClass: aClass

	self flag: #stef. "only used by RB"
	self flag: #cyrille. "looks like a bogus implementation because category have nothing to do with the fact that a method is in package or not."
	"CD: Indeed, it looks strange. 
	With RPackage we have 'includesSelector:ofClass:. I guess it should return the same result (?)'
	"
	aClass ifNil: [^ false].
	^ self
		includesMethodCategory: ((aClass organization categoryOfElement: aSymbol)
										ifNil: [' '])
		ofClass: aClass! !

!RPackage methodsFor: 'system compatibility' stamp: 'RPackage 1/20/2011 13:33'!
isForeignClassExtension: categoryName
	^ categoryName first = $* and: [(self isYourClassExtension: categoryName) not]! !

!RPackage methodsFor: 'system compatibility' stamp: 'RPackage 1/20/2011 13:34'!
isYourClassExtension: categoryName
	^ categoryName notNil and: [self category: categoryName asLowercase matches: self methodCategoryPrefix]! !

!RPackage methodsFor: 'class tags' stamp: 'EstebanLorenzano 12/12/2013 18:03'!
removeClassDefinition: aClass fromClassTag: aSymbol
	"Detags the class aClass with the tag aSymbol"
	
	self 
		removeClassDefinitionName: aClass name 
		fromClassTag: aSymbol! !

!RPackage methodsFor: 'class tags' stamp: 'CamilleTeruel 7/16/2012 16:46'!
addClassDefinition: aClass toClassTag: aSymbol
	"Tags the class aClass with the tag aSymbol"
	
	self addClassDefinitionName: aClass name toClassTag: aSymbol! !

!RPackage methodsFor: 'all accessing' stamp: 'CamilloBruni 4/27/2012 13:26'!
definedClasses 
	| definedClasses |
	definedClasses := Set new.
	classes do: [:each | 
		Smalltalk globals 
			at: each 
			ifPresent: [:aClass| definedClasses add: aClass ]].
	^ definedClasses
	! !

!RPackage methodsFor: 'testing' stamp: 'tg 3/13/2010 13:47'!
includesExtensionSelector: aSelector ofClass: aClass
	"Return true if the receiver includes the method of selector aSelector. Only checks methods extending other packages"
	
	| sels |
	sels := self extensionSelectorsForClass: aClass.
	^ sels includes: aSelector.! !

!RPackage methodsFor: 'slices' stamp: 'StephaneDucasse 3/11/2010 18:46'!
classDefinedSlicesDo: aBlock
	"This method iterates over the defined class and their associated selectors. a slice is a class * list of selectors. aBlock will be applied to all the extensions slices of the receiver. aBlok first argument is the class and the second argument a list of method selectors"
	
	classDefinedSelectors keysAndValuesDo: aBlock! !

!RPackage methodsFor: 'testing' stamp: 'StephaneDucasse 4/20/2010 22:22'!
definesClass: aClass
	"Returns true if the class, aClass, is one of the locally defined classes"
	"should be probably removed since this is the same as includesClass: or the inverse"
	^ self includesClass: aClass! !

!RPackage methodsFor: 'class tags' stamp: 'EstebanLorenzano 12/12/2013 18:04'!
removeClassTag: aSymbol
	"Remove the class tag from the receiver."
	
	self basicRemoveTag: (self 
		classTagNamed:  (self toTagName: aSymbol) 
		ifAbsent: [ ^ self ])! !

!RPackage methodsFor: 'updating' stamp: 'ThierryGoubier 10/25/2013 14:02'!
updateDefinedClassNamed: oldString withNewName: newString
	"this method should only be used with class names , and not metaclass names"

	(oldString substrings size > 1 or: [ newString substrings size > 1 ])
		ifTrue: [ Error signal: 'You should not use metaclass names' ].	"=> update the 'classDefinedSelectors' dictionary (replace the old key by the new one)
       => update the 'metaclassDefinedSelectors' dictionary (replace the old key by the new one)"
	classes remove: oldString.
	classes add: newString.	"Don't forget that class tags also register the classes names."
	self classTags do: [ :aTag | aTag updateDefinedClassNamed: oldString withNewName: newString ].
	self flag: #cyrille.	"what happens if this is a metaclass: it breaks the invariant of the package"	"worse so far the second block below breaks"	"the name of the method should be updateDefinedClassNamed: withNewName:"	"CD: i only use this method when a class is renamed in the system (systemClassRenamedActionFrom:). Normally we are not able to rename a metaclass in the system (?) so we should never end up in a case with metaclass names ?  "
	(classDefinedSelectors at: oldString ifAbsent: [ nil ])
		ifNotNil: [ 
			classDefinedSelectors at: newString put: (classDefinedSelectors at: oldString).
			classDefinedSelectors
				removeKey: oldString
				ifAbsent: [ self reportBogusBehaviorOf: #updateDefinedClassNamed:withNewName: ] ].
	(metaclassDefinedSelectors at: oldString ifAbsent: [ nil ])
		ifNotNil: [ 
			metaclassDefinedSelectors at: newString put: (metaclassDefinedSelectors at: oldString).
			metaclassDefinedSelectors
				removeKey: oldString
				ifAbsent: [ self reportBogusBehaviorOf: #updateDefinedClassNamed:withNewName: ] ]! !

!RPackage methodsFor: 'system compatibility' stamp: 'RPackage 1/20/2011 13:34'!
isOverrideCategory: aString
	^ aString endsWith: '-override'! !

!RPackage methodsFor: 'class tags' stamp: 'YuriyTymchuk 10/25/2013 17:15'!
classNamesForClassTag: aSymbol
	"Returns the classes tagged using aSymbol"
	
	^ (self 
		classTagNamed: aSymbol 
		ifAbsent: [ ^ #() ]) classNames.
! !

!RPackage methodsFor: 'accessing' stamp: 'EstebanLorenzano 12/12/2013 18:11'!
categoryName
	^ self name! !

!RPackage methodsFor: 'class tags' stamp: 'EstebanLorenzano 10/16/2013 17:08'!
removeClassTagsForClassNamed: aString 
	(self classTags 
		select: [ :eachTag | eachTag hasClassNamed: aString ])
		do: [ :eachTag |	
			self 
				removeClassDefinitionName: aString 
				fromClassTag: eachTag name ]! !

!RPackage methodsFor: 'class tags' stamp: 'EstebanLorenzano 12/20/2013 12:03'!
classTagCategoryNames
	^ (Set with: self packageName), (self classTags collect: #categoryName).! !

!RPackage methodsFor: 'private-register' stamp: 'StephaneDucasse 4/22/2011 23:25'!
registerClass: aClass
	"Private method that declares the mapping between a class and its package."
	self organizer
		registerPackage: self forClass: aClass
	! !

!RPackage methodsFor: 'statistics' stamp: 'MarcusDenker 1/11/2014 16:36'!
linesOfCode
	"An approximate measure of lines of code.
	Includes comments, but excludes blank lines."
	^self methods inject: 0 into: [:sum :each | sum + each linesOfCode]! !

!RPackage methodsFor: 'system compatibility' stamp: 'RPackage 1/20/2011 13:33'!
category: categoryName matches: prefix
	"self default category: 'Compression-Archives' matches: 'Compression'"
	"self default category: 'Compression' matches: 'Compression-Archives'"
	"self default category: 'Compression' matches: 'Compression'"
	"self default category: 'Compression-Arh' matches: 'Compression'"
	| prefixSize catSize |
	categoryName ifNil: [ ^false ].
	catSize := categoryName size.
	prefixSize := prefix size.
	catSize < prefixSize ifTrue: [ ^false ].
	(categoryName findString: prefix startingAt: 1 caseSensitive: false) = 1
		ifFalse: [ ^false ].
	^(categoryName at: prefix size + 1 ifAbsent: [ ^true ]) = $-! !

!RPackage methodsFor: 'class tags' stamp: 'EstebanLorenzano 7/21/2014 13:30'!
basicRemoveTag: tag
	classTags remove: tag ifAbsent: [].! !

!RPackage methodsFor: 'private' stamp: 'ThierryGoubier 2/5/2014 07:19'!
importClass: aClass inTag: aTag
	"import a class already created but not attached to a package to the receiver. 
	Handle also *- convention. Methods defined in *category are not added to the package.
	Pay attention that it will not import anything from the metaClass side"

	self basicImportClass: aClass.
	self basicImportClass: aClass theMetaClass.	
	self 
		addClassDefinition:  aClass
		toClassTag: aTag name! !

!RPackage methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/12/2015 14:19'!
spotterMonticelloWorkingCopyFor: aStep
	<spotterOrder: 42>
	aStep listProcessor
		title: 'Monticello Working Copy';
		allCandidates: [ self mcPackage 
			ifNotNilDo: [ :mcPackage | Array with: mcPackage workingCopy ] 
			ifNil: [ #() ] ];
		itemIcon: [ Smalltalk ui icons iconNamed: #versionControlIcon ];
		filter: GTFilterSubstring! !

!RPackage methodsFor: 'comparing' stamp: ''!
<= aRPackage 

	^ self name <= aRPackage name! !

!RPackage methodsFor: 'private' stamp: 'EstebanLorenzano 12/12/2013 18:01'!
toTagName: aSymbol
	^ (aSymbol beginsWith: self name, '-')
		ifTrue: [ (aSymbol allButFirst: self name size + 1) asSymbol ]
		ifFalse: [ aSymbol ]! !

!RPackage methodsFor: 'testing' stamp: 'tg 3/13/2010 15:13'!
includesDefinedSelector: aSelector ofClass: aClass
	"Return true if the receiver includes the method of selector aSelector. Only checks methods defined in this package"
	
	| sels |
	sels := self definedSelectorsForClass: aClass.
	^ sels includes: aSelector.! !

!RPackage methodsFor: 'accessing' stamp: 'DamienPollet 9/28/2010 17:10'!
methodsForClass: aClass
	"Returns all compiled methods for a class in the receiver without distinction of extensions or not"
	
	^ (self includesClass: aClass)
		ifFalse: [self extensionMethodsForClass: aClass]
		ifTrue: [self definedMethodsForClass: aClass]
	! !

!RPackage methodsFor: 'selector handling' stamp: 'StephaneDucasse 4/20/2010 22:56'!
addSelector: aSelector ofMetaclassName: aClassName
	"Add the method to the receiver. If the class is not locally defined in that package then the method is defined as a method extension: ie extending another package. Note that this method does not add the method to the class, it just records in the package that the method is packaged. aClassName is the sole instance class name and not its metaclass one: i.e. adding Point class>>new is done as addSelector: #new ofMetaclassName: #Point"
	
	( self includesClassNamed: aClassName) 
		ifFalse: [(metaclassExtensionSelectors at: aClassName asSymbol ifAbsentPut: [Set new]) add: aSelector]
		ifTrue: [(metaclassDefinedSelectors at: aClassName asSymbol ifAbsentPut: [Set new]) add: aSelector].
	^ aSelector.! !

!RPackage methodsFor: 'system compatibility' stamp: 'GuillermoPolito 5/1/2012 12:25'!
referenceForMethod: aSymbol ofClass: aClass
	^ (aClass >> aSymbol) asRingDefinition! !

!RPackage methodsFor: 'class addition' stamp: 'CamilloBruni 9/5/2012 14:39'!
removeClassDefinition: aClass
	"Remove the class definition from the package but not its methods."
	^ self removeClassDefinitionName: aClass theNonMetaClass originalName.! !

!RPackage methodsFor: 'private-register' stamp: 'StephaneDucasse 4/22/2011 23:25'!
unregisterClass: aClass
	"Private method that declares the mapping between a class and its package."
	self organizer
		unregisterPackage: self forClass: aClass.! !

!RPackage methodsFor: 'compiled method handling' stamp: 'EstebanLorenzano 2/22/2014 11:09'!
removeMethods: aCollection 
	aCollection do: [ :each | self removeMethod: each ]
	! !

!RPackage methodsFor: 'system compatibility' stamp: 'RPackage 1/20/2011 13:34'!
methodCategoryPrefix
	^ '*', self name asLowercase! !

!RPackage methodsFor: 'class addition' stamp: 'cyrilledelaunay 2/22/2011 13:32'!
addClassDefinitionName: aClassName
	"aClassName should only be a class (and not a metaclass name)"

	| aClassNameSymbol |
	('* class' match: aClassName)
		ifTrue: [ ^ self error: 'no metaclass name' ].
	aClassNameSymbol := aClassName asSymbol.
	(classes includes: aClassNameSymbol)
		ifTrue: [ ^ self ].
	classes add: aClassNameSymbol.
	self extendedMethodsShouldBecomeDefinedWhenAddingClassName: aClassNameSymbol.
	self registerClassName: aClassNameSymbol! !

!RPackage methodsFor: 'private' stamp: 'StephaneDucasse 4/25/2011 12:27'!
definedMethodsBecomeExtendedForMetaclass: aClassName
	"the package may contain defined methods and their class is removed to the receiver. The status of such methods should now be extended"
	"Precondition: aClassName is in the defined list"
	
	| ext |
	(metaclassDefinedSelectors keys includes: aClassName) ifFalse: [^ self].
	ext := metaclassDefinedSelectors at: aClassName.
	metaclassDefinedSelectors removeKey: aClassName ifAbsent: [self reportBogusBehaviorOf: #definedMethodsBecomeExtendedForMetaclass:].
	(metaclassExtensionSelectors keys includes: aClassName) ifTrue: [self error: aClassName , ' should not be defined in extension'.]. "we should remove this check later"
	metaclassDefinedSelectors at: aClassName put: ext.! !

!RPackage methodsFor: 'updating' stamp: 'StephaneDucasse 4/13/2011 22:02'!
updateDefinedSelector: oldSelector inClass: aClass withNewSelector: newSelector

	aClass isMeta
		ifTrue: [
			(metaclassDefinedSelectors at: aClass instanceSide name asSymbol) remove: oldSelector. 
			(metaclassDefinedSelectors at: aClass instanceSide name asSymbol) add: newSelector. ]
		ifFalse: [
			(classDefinedSelectors  at: aClass name asSymbol) remove: oldSelector. 
			(classDefinedSelectors  at: aClass name asSymbol) add: newSelector. ]! !

!RPackage methodsFor: 'slices' stamp: 'StephaneDucasse 4/20/2010 21:42'!
metaclassExtensionSlicesDo: aBlock
	"This method iterates over the metaclass extensions and their associated selectors. A slice is a class * list of selectors. aBlock will be applied to all the extensions slices of the receiver. aBlok first argument is the class and second argument a list of selectors"
	
	metaclassExtensionSelectors keysAndValuesDo: aBlock
	
! !

!RPackage methodsFor: 'system compatibility' stamp: 'RPackage 1/20/2011 13:33'!
allOverriddenMethodsDo: aBlock
	"Evaluates aBlock with all the overridden methods in the system"
	^ ProtoObject withAllSubclassesDo: [:class | 
		self overriddenMethodsInClass: class do: aBlock]
! !

!RPackage methodsFor: 'compiled method handling' stamp: 'EstebanLorenzano 2/22/2014 11:10'!
removeMethod: aCompiledMethod 
	"Remove the method to the receiver as a defined method."
	|  methodClass |
	
	methodClass := aCompiledMethod methodClass. 
	methodClass isMeta
		ifTrue: [
			self 
				removeSelector: aCompiledMethod selector 
				ofMetaclassName: methodClass theNonMetaClass originalName ]
		ifFalse: [
			self 
				removeSelector: aCompiledMethod selector 
				ofClassName: methodClass originalName ].

	^ aCompiledMethod.! !

!RPackage methodsFor: '*Deprecated40' stamp: 'MarcusDenker 7/16/2014 17:30'!
correspondingMcPackage
	"Answers the corresponding MCPackage. 
	 Normally it should exist, but in certain patterns could happen that the monticello package is not there. "
	self deprecated: 'use #mcPackage' on: '16 July 2014'  in: 'Pharo4'.
	
	^ MCWorkingCopy allManagers 
		detect: [  :each | each package name = name ]
		ifFound: [ :workingCopy | workingCopy package  ]
		ifNone: [ nil ].
	! !

!RPackage methodsFor: 'accessing' stamp: 'ThierryGoubier 2/2/2014 16:36'!
removeClass: aClass
	"Remove the class and all its methods from the receiver. If we have a protocol which looks like an extension of us, rename it to 'as yet unclassified' to avoid breaking things afterwards."

	aClass organization realCategories
		do: [ :each | 
			(self isYourClassExtension: each)
				ifTrue: [ aClass organization renameCategory: each toBe: Protocol defaultName ] ].
	(self definedMethodsForClass: aClass instanceSide) do: [ :aCompiledMethod | self removeMethod: aCompiledMethod ].
		"we also have also have to remove methods from class side"
	(self definedMethodsForClass: aClass classSide) do: [ :aCompiledMethod | self removeMethod: aCompiledMethod ].
	self removeClassDefinitionWithoutCheckingMethods: aClass.
	self removeClassTagsForClassNamed: aClass name! !

!RPackage methodsFor: 'testing' stamp: 'StephaneDucasse 2/21/2010 18:54'!
includesExtensionSelector: aSelector ofMetaclassName: aClassName
	"Return true if the receiver includes the method of selector aSelector. Only checks methods extending other packages"
	
	| sels |
	sels := metaclassExtensionSelectors at: aClassName ifAbsent: [^ false].
	^ sels includes: aSelector.! !

!RPackage methodsFor: 'private' stamp: 'EstebanLorenzano 2/22/2014 11:56'!
importPackage: anRPackage 
	anRPackage definedClasses  
		do: [ :className | self importClass: className ].
	"new rpackage inherits the extentions"
	classExtensionSelectors :=  classExtensionSelectors, (anRPackage classExtensionSelectors).
	metaclassExtensionSelectors := metaclassExtensionSelectors, (anRPackage metaclassExtensionSelectors).
! !

!RPackage methodsFor: 'testing' stamp: 'StephaneDucasse 2/21/2010 18:54'!
includesExtensionSelector: aSelector ofClassName: aClassName
	"Return true if the receiver includes the method of selector aSelector. Only checks methods extending other packages"
	
	| sels |
	sels := classExtensionSelectors at: aClassName ifAbsent: [^ false].
	^ sels includes: aSelector.! !

!RPackage methodsFor: 'system compatibility' stamp: 'cyrilledelaunay 2/4/2011 14:12'!
systemCategories

	"(RPackageOrganizer default packageNamed: 'HelpSystem-Core' asSymbol) systemCategories"
	"(PackageInfo named: 'HelpSystem-Core' asSymbol) systemCategories"
	^ self systemOrganization categories select: [:cat | self includesSystemCategory: cat]! !

!RPackage methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 11/6/2014 14:21'!
gtInspectorTagsIn: composite
	<gtInspectorPresentationOrder: 40>
	composite list
		title: 'Tags';
		display: #classTags;
		format: #gtDisplayString;
		when: [ self classTags notEmpty ]! !

!RPackage methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/12/2015 14:19'!
spotterMonticelloPackageFor: aStep
	<spotterOrder: 41>
	aStep listProcessor
		title: 'Monticello Package';
		allCandidates: [ self mcPackage 
			ifNotNilDo: [ :mcPackage | Array with: mcPackage ] 
			ifNil: [ #() ] ];
		itemIcon: [ Smalltalk ui icons iconNamed: #monticelloPackageIcon ];
		filter: GTFilterSubstring! !

!RPackage methodsFor: 'private' stamp: 'sd 4/25/2010 15:29'!
extendedMethodsShouldBecomeDefinedWhenAddingClassName: aClassName
	"the package may contain extension methods and their class is added to the receiver. The status of such methods should now be defined"
	"Precondition: aClassName is in the defined list"
	
	self extendedMethodsBecomeDefinedForClass: aClassName.
	self extendedMethodsBecomeDefinedForMetaclass: aClassName.
	! !

!RPackage methodsFor: 'private' stamp: 'StephaneDucasse 7/29/2010 21:16'!
importProtocol: aProtocol forClass: aClass 
	"import all the methods of a protocol as defined in the receiver." 
	
		(aClass organization listAtCategoryNamed: aProtocol)
			do: [:each | self addMethod: (aClass >> each)]
	
	! !

!RPackage methodsFor: 'accessing' stamp: 'MarcusDenker 7/6/2014 10:19'!
extensionSelectors
	"Extension methods are methods defined on classes that are not defined in the receiver"

	| classSels |
	classSels := Set new.
	classExtensionSelectors valuesDo: [ :each | classSels addAll: each ].
	metaclassExtensionSelectors valuesDo: [ :each | classSels addAll: each ].
	^ classSels! !

!RPackage methodsFor: 'class tags' stamp: 'GuillermoPolito 2/14/2014 12:00'!
removeClassesMatchingTag: aTag
	
	aTag classes do: [ :class | self removeClassDefinition: class ]! !

!RPackage methodsFor: 'system compatibility' stamp: 'RPackage 1/20/2011 13:34'!
isOverrideOfYourMethod: aMethodReference
	"Answers true if the argument overrides a method in this package"
	^ (self isYourClassExtension: aMethodReference category) not and:
		[(self changeRecordForOverriddenMethod: aMethodReference) notNil]! !

!RPackage methodsFor: 'private' stamp: 'EstebanLorenzano 1/16/2014 10:40'!
basicAddClassTag: tagName
	| packageTag |
			
	packageTag := RPackageTag package: self name: tagName.
	classTags add: packageTag.
	packageTag ensureSystemCategory.
	
	^ packageTag ! !

!RPackage methodsFor: '*Ring-Core-Kernel' stamp: 'LeoGassman 11/7/2013 12:36'!
asRingDefinition
	^RGPackage named: self name asSymbol! !

!RPackage methodsFor: 'accessing' stamp: 'EstebanLorenzano 1/3/2014 11:02'!
extensionMethods
	"Extension methods are methods defined on classes that are not defined in the receiver"
	| allExtensionMethods |
	
	allExtensionMethods := OrderedCollection new.
	classExtensionSelectors keysAndValuesDo: [ :classSymbol :methods |
		methods do: [ :selector | allExtensionMethods add: ((Smalltalk at: classSymbol) >> selector) ] ].
	metaclassExtensionSelectors keysAndValuesDo: [ :classSymbol :methods |
		methods do: [ :selector | allExtensionMethods add: ((Smalltalk at: classSymbol) theMetaClass >> selector) ] ].	
	
	^ allExtensionMethods				! !

!RPackage methodsFor: 'accessing' stamp: 'sd 4/25/2010 15:52'!
name

	^ name! !

!RPackage methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 11/6/2014 14:21'!
gtInspectorDefinedClassesIn: composite
	<gtInspectorPresentationOrder: 30>
	composite list
		title: 'Classes';
		display: #classes;
		format: #gtDisplayString;
		tags: [ :each | each category ]! !

!RPackage methodsFor: 'all accessing' stamp: 'StephaneDucasse 3/11/2010 15:17'!
definedClassNames 
	"Return the class names having methods defined in the receiver."
	
	^ classes! !

!RPackage methodsFor: 'accessing' stamp: 'GuillermoPolito 8/5/2012 13:33'!
definedSelectorsForClass: aClass

	^ aClass isMeta
		ifTrue: [ metaclassDefinedSelectors at: aClass theNonMetaClass originalName ifAbsent: [ #() ] ]
		ifFalse: [ classDefinedSelectors at: aClass originalName ifAbsent: [ #() ] ]! !

!RPackage methodsFor: 'accessing' stamp: 'EstebanLorenzano 9/11/2012 15:33'!
unregister
	self organizer unregisterPackage: self! !

!RPackage methodsFor: '*Nautilus' stamp: 'EstebanLorenzano 10/14/2013 13:20'!
asNautilusSelection 
	^ PackageTreePackageSelection package: self.! !

!RPackage methodsFor: 'private' stamp: 'StephaneDucasse 4/25/2011 12:26'!
extendedMethodsBecomeDefinedForClass: aClassName
	"the package may contain extension methods and their class is added to the receiver. The status of such methods should now be defined"
	"Precondition: aClassName is in the defined list"
	
	| ext |
	(classExtensionSelectors keys includes: aClassName) ifFalse: [^ self].
	ext := classExtensionSelectors at: aClassName.
	classExtensionSelectors removeKey: aClassName ifAbsent: [self reportBogusBehaviorOf:   #extendedMethodsBecomeDefinedForClass: ].
	(classDefinedSelectors keys includes: aClassName) ifTrue: [self error: aClassName , ' should not be defined in extension'.]. "we should remove this check later"
	classDefinedSelectors at: aClassName put: ext.! !

!RPackage methodsFor: 'testing' stamp: 'StephaneDucasse 4/18/2011 12:14'!
isDefault
	"Return whether the receiver is the default package, i.e. the one used when nothing else is specified."
	^ self name = self class defaultPackageName! !

!RPackage methodsFor: 'private' stamp: 'EstebanLorenzano 2/19/2014 16:12'!
classExtensionSelectors
	^ classExtensionSelectors! !

!RPackage methodsFor: 'compiled method handling' stamp: 'EstebanLorenzano 2/22/2014 11:13'!
addMethod: aCompiledMethod 
	"Add the method to the receiver as a defined method if the class is  defined in it, else as an extension."
	| methodClass |
	
	methodClass := aCompiledMethod methodClass. 
	(self includesClass: methodClass )
		ifTrue: [
			methodClass isMeta
				ifTrue: [
					(metaclassDefinedSelectors 
						at: methodClass theNonMetaClass name  
						ifAbsentPut: [ Set new ]) 
						add: aCompiledMethod selector]
				ifFalse: [
					(classDefinedSelectors 
						at: methodClass name 
						ifAbsentPut: [ Set new ]) 
						add: aCompiledMethod selector ] ]
		ifFalse:  [
			methodClass isMeta
				ifTrue: [
					(metaclassExtensionSelectors 
						at: methodClass theNonMetaClass name  
						ifAbsentPut: [ Set new ]) 
						add: aCompiledMethod selector.]
				ifFalse: [
					(classExtensionSelectors 
						at: methodClass name 
						ifAbsentPut: [ Set new ]) 
						add: aCompiledMethod selector].
				"we added a method extension so the receiver is an extending package of the class"
				self organizer registerExtendingPackage: self forClass: methodClass ].
					
	^ aCompiledMethod.! !

!RPackage methodsFor: 'class tags' stamp: 'EstebanLorenzano 2/14/2014 15:28'!
extensionsForTag: aRPackageTag

	^ self extensionMethods select: [ :extensionMethod | | category |
		category := extensionMethod protocol allButFirst.
		self category:  category matches: aRPackageTag categoryName ]! !

!RPackage methodsFor: 'system compatibility' stamp: 'MartinDias 11/6/2013 16:04'!
changeRecordForOverriddenMethod: aMethodDefinition
	^ SourceFiles
		changeRecordsFor: aMethodDefinition 
		detect: [ :protocol | 
			self 
				includesMethodCategory: protocol 
				ofClass: aMethodDefinition actualClass ]! !

!RPackage methodsFor: 'accessing' stamp: 'DamienPollet 10/1/2010 11:52'!
organizer
	^ self class organizer! !

!RPackage methodsFor: 'accessing' stamp: 'StephaneDucasse 4/13/2011 22:17'!
definedMethodsForClass: aClass

	^ (self definedSelectorsForClass: aClass) asOrderedCollection collect: [ :each | aClass >> each ]! !

!RPackage methodsFor: 'testing' stamp: 'EstebanLorenzano 2/7/2014 14:27'!
includesClassTagNamed: aString
	^ self classTags anySatisfy: [ :each | each name = aString ]! !

!RPackage methodsFor: 'accessing' stamp: 'DamienPollet 9/28/2010 17:11'!
selectorsForClass: aClass
	"Returns all selectors for a class in the receiver without distinction of extensions or not"
	
	^ (self includesClass: aClass)
		ifFalse: [self extensionSelectorsForClass: aClass]
		ifTrue: [self definedSelectorsForClass: aClass]
	! !

!RPackage methodsFor: 'system compatibility' stamp: 'StephaneDucasse 4/27/2011 11:35'!
classesAndMetaClasses
	"Return a Set with all classes and metaclasses belonging to this package"
	self flag: #stef. "only used by goferCleanUp"
	^ OrderedCollection new
		addAll: self definedClasses;
		addAll: (self definedClasses collect: [:each | each classSide]);
		yourself.! !

!RPackage methodsFor: 'private' stamp: 'sd 4/25/2010 15:41'!
definedMethodsShouldBecomeExtensionWhenRemovingClass: aClassName
	"the package may contain defined methods and their class is removed from the receiver. The status of such methods should now be extensions"
	
	self definedMethodsBecomeExtendedForClass: aClassName.
	self definedMethodsBecomeExtendedForMetaclass: aClassName.! !

!RPackage methodsFor: '*Monticello-RPackage' stamp: 'BenjaminVanRyseghem 3/30/2011 12:41'!
isDirty

	| modifiedPackages packages |
	modifiedPackages := MCWorkingCopy allManagers select: [ :each | each modified ].
	packages := modifiedPackages collect: [:each | each package name].
	^ packages includes: self name.! !

!RPackage methodsFor: 'private-register' stamp: 'StephaneDucasse 4/22/2011 23:25'!
registerClassName: aClassNameSymbol
	"Private method that declares the mapping between a class and its package."
	self organizer
		registerPackage: self forClassName: aClassNameSymbol
	! !

!RPackage methodsFor: 'system compatibility' stamp: 'EstebanLorenzano 6/27/2013 18:04'!
coreCategoriesForClass: aClass

	self flag: #stef. "only used by goferCleanUp"
	^ aClass organization realCategories reject: [ :cat | self isForeignClassExtension: cat ]! !

!RPackage methodsFor: 'selector handling' stamp: 'GuillermoPolito 5/29/2012 14:04'!
basicRemoveSelector: aSelector ofMetaclassName: aClassName
	"Remove the method in the package. Note that this method does not remove the method from the class, it just records in the package that the method is not in the package anymore. aClassName is the sole instance class name and not its metaclass one: i.e. adding Point class>>new is done as removeSelector: #new ofMetaclassName: #Point"
	
	( self includesClassNamed: aClassName)
		ifFalse: [(metaclassExtensionSelectors  at: aClassName ifAbsent: [ ^ Set new]) remove: aSelector.]
		ifTrue: [(metaclassDefinedSelectors  at: aClassName ifAbsent: [ ^ Set new]) remove: aSelector.].
	
	! !

!RPackage methodsFor: 'testing' stamp: 'sd 4/25/2010 16:05'!
extendsClass: aClass
	"Returns true if the receiver extends aClass (that is defined in another package)"
	
	| canonizedName |
	canonizedName := aClass theNonMetaClass name.
	^ self extendedClassNames includes:  canonizedName! !

!RPackage methodsFor: 'accessing' stamp: 'cyrilledelaunay 5/4/2011 16:02'!
removeDefinedMethod: aCompiledMethod forClass: aClass 
	"Remove the method to the receiver as a defined method."
	
	self flag: #cyrille. "no need for this method since we have removeMethod and normally 
	given a compiledMethod and a package we know if it is extending or not the package."
	"CD: Indeed, I changed the code where this method was called (removeClass:) , and it does not raise more errors when running the tests.There is no longer senders of this method"
	aClass isMeta
		ifTrue: [(metaclassDefinedSelectors 
			at: aClass theNonMetaClass name  
			ifAbsent: [^nil]) remove: aCompiledMethod selector]
		ifFalse: [(classDefinedSelectors 
			at: aClass name 
			ifAbsent: [^nil]) remove: aCompiledMethod selector].	
	^ aCompiledMethod.! !

!RPackage methodsFor: 'selector handling' stamp: 'GuillermoPolito 5/29/2012 14:12'!
removeSelector: aSelector ofClassName: aClassName
	"Remove the method in the package but does not propagate to the class itself.  Note that this method does not remove the method from the class, it just records in the package that the method is not in the package anymore."
	
	self basicRemoveSelector: aSelector ofClassName: aClassName.
	(classExtensionSelectors at: aClassName ifAbsent: [ #() ]) ifEmpty: [
		classExtensionSelectors removeKey: aClassName ifAbsent: [].
	].
	(classDefinedSelectors at: aClassName ifAbsent: [ #() ]) ifEmpty: [
		classDefinedSelectors removeKey: aClassName ifAbsent: [].
	].

	((metaclassExtensionSelectors at: aClassName ifAbsent: [#()]) isEmpty and: [(classExtensionSelectors at: aClassName ifAbsent: [#()]) isEmpty])
		ifTrue: [
				self organizer unregisterExtendingPackage: self forClassName: aClassName
	]! !

!RPackage methodsFor: 'testing' stamp: 'sd 4/25/2010 16:06'!
definesOrExtendsClass: aClass
	"Returns true whether the class, aClass, is one of the locally defined classes of the receiver or 
	if the receiver extends such class (that is defined in another package)"
	
	| canonizedName |
	canonizedName := aClass theNonMetaClass name.
	^ (classes includes: canonizedName) 
		or: [self extendedClassNames includes:  canonizedName]
! !

!RPackage methodsFor: 'class addition' stamp: 'EstebanLorenzano 10/10/2013 14:46'!
removeClassDefinitionName: aClassName
	"remove the class definition from the package but not its method"
	
	| removed aClassNameSymbol |
	('* class' match: aClassName) ifTrue: [^ self error: 'no metaclass name'].
	aClassNameSymbol := aClassName asSymbol.
	"clean up class tags"
	classTags do: [ :tag| tag removeClassNamed: aClassName ].
	(classTags select: #isEmpty)
		do: [ :eachTag | self basicRemoveTag: eachTag ].
	"remove the class definition"
	removed := classes remove: aClassNameSymbol ifAbsent: [nil].
	removed ifNotNil: [
		self definedMethodsShouldBecomeExtensionWhenRemovingClass: aClassName.
		self unregisterClassName: aClassNameSymbol ] ! !

!RPackage methodsFor: 'private-register' stamp: 'StephaneDucasse 4/22/2011 23:26'!
unregisterClassName: aClassNameSymbol
	"Private method that declares the mapping between a class and its package."
	self organizer unregisterPackage: self forClassName: aClassNameSymbol! !

!RPackage methodsFor: 'private' stamp: 'EstebanLorenzano 10/16/2013 16:11'!
removeClassDefinitionWithoutCheckingMethods: aClass
	"Same than 'removeClassDefinition', excepts that it does not make any check to set defined methods as extensions"
	
	| removed aClassName|
	aClassName := aClass theNonMetaClass name.
	removed := classes remove: aClassName ifAbsent: [nil].
	removed ifNotNil: [
		self unregisterClass: aClass.] 
	! !

!RPackage methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/16/2013 17:10'!
removeClassNamed: className
	self removeClassDefinitionName: className.
	self removeAllMethodsFromClassNamed: className. 
	self removeClassTagsForClassNamed: className.! !

!RPackage methodsFor: 'all accessing' stamp: 'EstebanLorenzano 10/8/2013 12:56'!
classes
	"Return all the classes"
	^ self definedClasses, self extendedClasses 
	
	! !

!RPackage methodsFor: '*Refactoring-Environment' stamp: 'CamilloBruni 8/22/2013 11:48'!
asEnvironment
	^ RBPackageEnvironment package: self! !

!RPackage methodsFor: 'private' stamp: 'EstebanLorenzano 2/19/2014 16:13'!
metaclassExtensionSelectors
	^ metaclassExtensionSelectors! !

!RPackage methodsFor: 'all accessing' stamp: ''!
orderedClasses

	| tmp |
	tmp := self definedClasses asArray sort: [:a :b | a name <= b name].
	tmp := tmp, (self extendedClasses asArray sort: [:a :b | a name <= b name]).
	^tmp collect: [:e | e theNonMetaClass ]
! !

!RPackage methodsFor: 'class tags' stamp: 'EstebanLorenzano 12/12/2013 18:04'!
removeClassDefinitionName: aClassName fromClassTag: aSymbol
	"Detags the class aClass with the tag aSymbol"
	| tag |
	
	tag := self classTagNamed: (self toTagName: aSymbol) ifAbsent: [ ^ self ].
	tag removeClassNamed: aClassName.
	tag isEmpty 
		ifTrue: [ self basicRemoveTag: tag ].
! !

!RPackage methodsFor: '*Nautilus' stamp: 'NicolaiHess 7/30/2014 13:40'!
withClassesIn: anEnvironment createHierarchySorter: aHierarchClass
	^ self asNautilusSelection withClassesIn: anEnvironment createHierarchySorter: aHierarchClass! !

!RPackage methodsFor: 'slices' stamp: 'StephaneDucasse 3/11/2010 18:47'!
metaclassDefinedSlicesDo: aBlock
	"This method iterates over the defined class and their associated selectors. a slice is a class * list of selectors. aBlock will be applied to all the extensions slices of the receiver. aBlok first argument is the class and the second argument a list of method selectors"
	
	metaclassDefinedSelectors keysAndValuesDo: aBlock! !

!RPackage methodsFor: 'private' stamp: 'StephaneDucasse 4/25/2011 12:25'!
extendedMethodsBecomeDefinedForMetaclass: aClassName
	"the package may contain extension methods and their class is added to the receiver. The status of such methods should now be defined"
	"Precondition: aClassName is in the defined list"
	
	| ext |
	(metaclassExtensionSelectors keys includes: aClassName) ifFalse: [^ self].
	ext := metaclassExtensionSelectors at: aClassName.
	metaclassExtensionSelectors removeKey: aClassName  ifAbsent: [self reportBogusBehaviorOf:  #extendedMethodsBecomeDefinedForMetaclass: ].
	(metaclassDefinedSelectors keys includes: aClassName) 
			ifTrue: [self error: aClassName , ' should not be defined in extension'.]. "we should remove this check later"
	metaclassDefinedSelectors at: aClassName put: ext.! !

!RPackage methodsFor: 'private' stamp: 'cyrilledelaunay 5/30/2011 16:22'!
reportBogusBehaviorOf: aSelector

	self logCr: 'RPackage log: Something wrong around ', aSelector asString , 'since the removeKey: is called on not present information.'.! !

!RPackage methodsFor: 'all accessing' stamp: 'sd 4/21/2010 16:12'!
selectors

	| sel |
	sel := Set new.
	metaclassExtensionSelectors valuesDo: [:each | sel addAll: each].
	classExtensionSelectors valuesDo: [:each | sel addAll: each].
	metaclassDefinedSelectors valuesDo: [:each | sel addAll: each].
	classDefinedSelectors valuesDo: [:each | sel addAll: each].
	^ sel
	! !

!RPackage methodsFor: 'iteration' stamp: 'StephaneDucasse 2/21/2010 17:25'!
definedClassesDo: aBlock

	classDefinedSelectors keysDo: aBlock.
	metaclassDefinedSelectors keysDo: aBlock.! !

!RPackage methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/13/2014 20:15'!
renameTo: aSymbol
	| oldName newName oldCategoryNames |

	oldName := self name.
	newName := aSymbol asSymbol.
	
	(self organizer includesPackageNamed: aSymbol)
		ifTrue: [ RPackageConflictError  signal: ('A package named {1} already exists' format: { aSymbol }) ].

	oldCategoryNames  := (self classTags collect: #categoryName as: Set) 
		add: self categoryName;
		yourself.
	self name: aSymbol.
	SystemAnnouncer uniqueInstance suspendAllWhile: [
		self definedClasses do: [ :each | each category: newName, (each category allButFirst: oldName size) ].
		oldCategoryNames do: [ :each | SystemOrganizer default removeCategory: each ] ].
	self renameTagsPrefixedWith: oldName to: newName. 
	self renameExtensionsPrefixedWith: oldName to: newName.
			
	self organizer 
		basicUnregisterPackageNamed: oldName;
		basicRegisterPackage: self.
	
	SystemAnnouncer uniqueInstance 
		announce: (RPackageRenamed 
			to: self 
			oldName: oldName 
			newName: newName).! !

!RPackage methodsFor: '*Manifest-Core' stamp: 'ChristopheDemarey 11/24/2014 15:56'!
packageManifest
	^ (self classes
		detect: [ :each | each isManifest ]
		ifNone: [ TheManifestBuilder new createManifestNamed: name]) new! !

!RPackage methodsFor: 'private' stamp: 'EstebanLorenzano 3/14/2014 17:22'!
importClass: aClass
	"import a class already created but not attached to a package to the receiver. 
	Handle also *- convention. Methods defined in *category are not added to the package.
	Pay attention that it will not import anything from the metaClass side"

	self basicImportClass: aClass.
	self basicImportClass: aClass theMetaClass.	
	self 
		addClassDefinition:  aClass
		toClassTag: (self toTagName: aClass category)! !

!RPackage methodsFor: 'file in/out' stamp: 'EstebanLorenzano 1/15/2014 15:05'!
fileOut
	| internalStream |
	
	internalStream := (String new: 1000) writeStream.

	self classTags do: [ :each | 
		SystemOrganization 
			fileOutCategory: each categoryName 
			on: internalStream ].	
	
	classExtensionSelectors keysAndValuesDo: [ :className :selectors | 
		selectors do: [ :selector | | extendedClass |
			extendedClass := Smalltalk globals classNamed: className.
			extendedClass fileOutMethod: selector on: internalStream ] ].
	
	^ FileStream writeSourceCodeFrom: internalStream baseName: self name isSt: true.! !

!RPackage methodsFor: 'accessing' stamp: 'sd 4/25/2010 16:06'!
extendedClassNames 
	"Return the name of the classes which are extended by the receiver package. if a metaclass is extended, just get its sole instance class name."
	
	^ classExtensionSelectors keys union: metaclassExtensionSelectors keys! !

!RPackage class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:08'!
gtExampleEmpty
	<gtExample: 'Empty package'>
	^ self named: 'Empty'! !

!RPackage class methodsFor: 'class initialization' stamp: 'EstebanLorenzano 9/11/2012 15:33'!
initialize
	"self initialize"
	
	super initialize.
	"Ensure the organizer will be the RPackageOrganizer default"
	self organizer: nil.
! !

!RPackage class methodsFor: 'instance creation' stamp: 'StephaneDucasse 4/13/2011 22:43'!
named: aString

	| newPackage |
	newPackage := self new name: aString ;yourself.
	^ newPackage! !

!RPackage class methodsFor: 'protected only for tests' stamp: 'cyrille.delaunay 10/29/2010 14:31'!
organizer: aPackageOrganizer

	PackageGlobalOrganizer := aPackageOrganizer! !

!RPackage class methodsFor: 'help' stamp: 'StephaneDucasse 6/3/2012 23:28'!
help
	<wikiStyleHelp: 'RPackage'>	
	|stream|
	stream := String new writeStream.
	stream 
		nextPut: $!!;
		nextPutAll: self name asString;
		cr;
		nextPutAll: self comment;
		cr;
		nextPut: $!!;
		nextPutAll: self packageOrganizerClass name asString;
		cr;
		nextPutAll: self packageOrganizerClass comment.		
	^stream contents
	
	! !

!RPackage class methodsFor: 'class initialization' stamp: 'StephaneDucasse 6/3/2012 23:27'!
packageOrganizerClass
	^ RPackageOrganizer
! !

!RPackage class methodsFor: 'protected only for tests' stamp: 'EstebanLorenzano 7/27/2012 20:30'!
organizer
	^ PackageGlobalOrganizer ifNil: [ RPackageOrganizer default ].! !

!RPackage class methodsFor: 'constants' stamp: 'StephaneDucasse 4/29/2011 21:04'!
defaultPackageName
	^ #'_UnpackagedPackage'! !

!RPackage class methodsFor: 'protected only for tests' stamp: 'StephaneDucasse 4/24/2011 16:45'!
withOrganizer: aNewOrganizer do: aBlock
	"Perform an action locally to aNewOrganizer. Does not impact any other organizers."
	
	| old |
	[ old := self organizer.
	old unregister.
	self organizer: aNewOrganizer.
	aNewOrganizer register.
	aBlock cull: aNewOrganizer] ensure: [ 
		self organizer: old. 
		old register.
		aNewOrganizer unregister] ! !

!RPackageAnnouncement commentStamp: 'TorstenBergmann 2/12/2014 22:55'!
Common superclass for package related announcements!
!RPackageAnnouncement methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/1/2011 16:14'!
package: anObject

	package := anObject! !

!RPackageAnnouncement methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/1/2011 16:14'!
package

	^ package! !

!RPackageAnnouncement class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 4/1/2011 16:14'!
to: aPackage

	^ self new package: aPackage! !

!RPackageCategorySynchronisationTest commentStamp: 'TorstenBergmann 2/12/2014 22:59'!
SUnit tests for RPackage category synchronization!
!RPackageCategorySynchronisationTest methodsFor: 'tests - operations on categories' stamp: 'GuillermoPolito 9/5/2012 13:16'!
testAddCategoryCreatesPackage
	"test that when we add a category that does not yet correspond to an existing package, a new package is created"
	"self debug: #testAddCategoryCreatesPackage"
	
	self flag: #todo. "To be removed when Categories are kicked out"
	
	self addXCategory.
	self assert: (self organizer includesPackageNamed: #XXXXX)! !

!RPackageCategorySynchronisationTest methodsFor: 'tests - operations on categories' stamp: 'GuillermoPolito 9/5/2012 13:16'!
testRenameCategoryAlsoRenameAllExtensionProtocols
	"test that when we rename a category, all corresponding extension protocols in the system are renamed"
	"self debug: #testRenameCategoryAlsoRenameAllExtensionProtocols"
	
	|XPackage YPackage ZPackage classInY classInZ| 
	self addXCategory.
	self addYCategory.
	self addZCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage := self organizer packageNamed: #YYYYY.
	ZPackage := self organizer packageNamed: #ZZZZZ.
	
	classInY := self createNewClassNamed: 'ClassInYPackage' inCategory: 'YYYYY'.
	classInZ := self createNewClassNamed: 'ClassInZPackage' inCategory: 'ZZZZZ'. 
	
	self createMethodNamed:  'extensionFromXInClassInY'  inClass: classInY   inCategory: '*XXXXX'. 
	self createMethodNamed:  'longNameExtensionFromXInClassInY'  inClass: classInY   inCategory: '*XXXXX-subcategory'.     
	self createMethodNamed:  'extensionFromXInClassInZ'  inClass: classInZ   inCategory: '*XXXXX'.     
	    
	Smalltalk organization renameCategory: 'XXXXX' toBe: 'NewCategoryName'.
	
	self assert: (XPackage name = 'NewCategoryName').
	self assert: (classInY >> #extensionFromXInClassInY) category = '*NewCategoryName'.
	self assert: (classInY >> #longNameExtensionFromXInClassInY) category = '*NewCategoryName'.
	self assert: (classInZ >> #extensionFromXInClassInZ) category = '*NewCategoryName'.! !

!RPackageCategorySynchronisationTest methodsFor: 'tests - operations on categories' stamp: 'GuillermoPolito 9/5/2012 13:16'!
testAddCategoryIsAlreadyAPackageDoesNotCreatePackage
	"test that when we add a category corresponding to an existing package, we do not create a second package"
	"self debug: #testAddCategoryIsAlreadyAPackageDoesNotCreatePackage"
	
	|tmpPackage|
	
	self flag: #todo. "To be removed when Categories are kicked out"
	
	self addXCategory.
	tmpPackage := self organizer packageNamed: #XXXXX.
	self addXCategory.
	self assert: tmpPackage =  (self organizer packageNamed: #XXXXX)
		! !

!RPackageCategorySynchronisationTest methodsFor: 'tests - operations on categories' stamp: 'GuillermoPolito 9/5/2012 13:16'!
testRenameCategoryChangeTheNameOfThePackage
	"test that when we rename a category, the RPackage corresponding is updated with this new name"
	
	|XPackage| 
	self addXCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	
	Smalltalk organization renameCategory: 'XXXXX' toBe: 'YYYYY'.
	self assert: (XPackage name = 'YYYYY').! !

!RPackageCategorySynchronisationTest methodsFor: 'tests - operations on categories' stamp: 'GuillermoPolito 9/5/2012 13:16'!
testRenameUnknownCategoryCreatesNewRPackage
	"test that when we rename a category that is not registered in RPackage , it does not raise errors and simply create a new package. We need this behaviour as for now, create a new category with the class browser does not emit the corrects events, and therefore RPackage can not be directly updated"
	
	SystemAnnouncer uniqueInstance suspendAllWhile: [
		self addXCategory.
		].
	self deny: (self organizer includesPackageNamed: #XXXXX).
	Smalltalk organization renameCategory: 'XXXXX' toBe: 'YYYYY'.
	self assert: (self organizer includesPackageNamed: #YYYYY).! !

!RPackageCategorySynchronisationTest methodsFor: 'tests - operations on categories' stamp: 'EstebanLorenzano 10/16/2013 17:41'!
testRenameCategoryUpdateTheOrganizer
	"test that when we rename a category, the organizer dictionary is update with this new name, so that we can access the package with this new name as key"

	|XPackage| 
	
	
	self addXCategory.
	
	XPackage := self organizer packageNamed: #XXXXX.
	Smalltalk organization renameCategory: 'XXXXX' toBe: 'YYYYY'.
	self assert: (self organizer packageNamed: 'YYYYY' asSymbol) = XPackage.
	self deny: (self organizer includesPackageNamed: #XXXXX).! !

!RPackageClassesSynchronisationTest commentStamp: 'TorstenBergmann 2/12/2014 22:59'!
SUnit tests for RPackage classes synchronisation!
!RPackageClassesSynchronisationTest methodsFor: 'tests - recategorizing class' stamp: 'GuillermoPolito 9/5/2012 13:59'!
testRecategorizeClassWithMetaClassMethodsRegisterAllClassMethodsInTheNewPackage

	"test that when we recategorize a class (having methods defined in both instance and class side), the new package in which it is defined include all the methods (from instance and class side) defined in this class (not extensions)"
	
	| addedCount addedCat XPackage YPackage ZPackage class|
	self addXCategory.
	self addYCategory.
	self addZCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage := self organizer packageNamed: #YYYYY.
	ZPackage := self organizer packageNamed: #ZZZZZ.
	
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	
	self createMethodNamed: 'method1' inClass: class theMetaClass inCategory: 'category'.
	self createMethodNamed: 'method2' inClass: class theMetaClass inCategory: '*yyyyy'.
	self createMethodNamed: 'method3' inClass: class theMetaClass inCategory: '*zzzzz'.
	
	class category: 'YYYYY'.
	
	"lets check metaclass methods"
	self assert: (YPackage includesDefinedSelector: #method1 ofMetaclassName: class name).
	
	self assert: (YPackage includesDefinedSelector: #method2 ofMetaclassName: class name). 
	
	self assert: (ZPackage includesExtensionSelector: #method3 ofMetaclassName: class name ).! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - operations on protocols' stamp: 'GuillermoPolito 9/5/2012 14:56'!
testReorganizeClassByRenamingExtensionCategoryToClassicCategoryMoveMethodsFromExtendingPackageToParentPackage
	"test that when we reoganized a class by renaming an extension category (a category beginning with '*') to a classic category, all the methods are moved from the  extendingPackage to the parent package of the class"
	
	|XPackage YPackage class| 
	self addXYCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage  := self organizer packageNamed: #YYYYY.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	self createMethodNamed: 'stubMethod' inClass: class  inCategory: '*yyyyy'.
	class organization renameCategory: '*yyyyy' toBe: 'classic category'.
	self deny: (YPackage includesExtensionSelector: #stubMethod ofClass: class).
	self assert: (XPackage includesDefinedSelector: #stubMethod ofClass: class)! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - recategorizing class' stamp: 'BernardoContreras 10/26/2014 22:36'!
testRecategorizeClassRaisesClassRepackagedEvent
	"test that when we recategorize a class, the organizer is updated so that the class name point the the new RPackage"
	
	| XPackage YPackage class ann |
	
	ann := nil.
	SystemAnnouncer uniqueInstance
		when: ClassRepackaged do: [ :a |
			ann := a.
		].
	
	self addXCategory.
	self addYCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage := self organizer packageNamed: #YYYYY.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	class category: 'YYYYY'.	
	
	self assert: ann notNil.
	self assert: ann classRepackaged equals: class.
	self assert: ann oldPackage equals: XPackage.
	self assert: ann newPackage equals: YPackage.! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - recategorizing class' stamp: 'GuillermoPolito 9/5/2012 13:37'!
testRecategorizeClassWithUnexistingPackageNameRegisterTheClassInANewPackage
	"test that when we recategorize a class in category not yet registered in RPackage, a new rPackage is created with the class inside"
	
	|XPackage YPackage class|
	self addXCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	self assert: (self organizer packageOf: class) = XPackage. 
	
	class category: 'YYYYY'.
	YPackage := self organizer packageNamed: #YYYYY.
	
	self assert: (self organizer packageOf: class) equals: YPackage. 
	self deny: (self organizer packageOf: class) = XPackage.! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - operations on classes' stamp: 'GuillermoPolito 9/5/2012 13:28'!
testRenameClassUpdateClassDefinedSelectorsInTheParentPackage
	"test that when we rename a class, the  'classDefinedSelectors' dictionary of the parent package is updated with the new name. There fore we test that we can correctly access the selector from the package by specifying the right name (the new name)"
	
	|XPackage  class refactoring|
	self addXCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	class := self createNewClassNamed: 'RPackageOldStubClass' asSymbol inCategory: 'XXXXX'.
	self createMethodNamed: 'stubMethod' inClass: class  inCategory: 'classic category'.
	
	class rename: 'RPackageNewStubClass'.
	
	self assert: (XPackage includesDefinedSelector: #stubMethod ofClassName: 'RPackageNewStubClass' asSymbol ). 
	self deny: (XPackage includesDefinedSelector: #stubMethod ofClassName: 'RPackageOldStubClass' asSymbol ).! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - operations on classes' stamp: 'GuillermoPolito 9/5/2012 13:28'!
testRenameClassUpdateOrganizerClassExtendingPackagesMapping
	"test that when we rename a class, the classExtendingPackages dictionary of the organizer is updated with the new name, so that we can access the packages when specifying the new name"
	
	|XPackage YPackage class refactoring|
	self addXYCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage := self organizer packageNamed: #YYYYY.
	class := self createNewClassNamed: 'RPackageOldStubClass' inCategory: 'XXXXX'.
	self createMethodNamed: #stubMethod inClass: class inCategory: '*yyyyy'. 
	
	class rename: 'RPackageNewStubClass'.
	
	self assert: ((self organizer extendingPackagesOfClassNamed: 'RPackageNewStubClass' asSymbol) includes: YPackage). 
	self deny: ((self organizer extendingPackagesOfClassNamed: 'RPackageOldStubClass' asSymbol) includes: YPackage).! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - operations on protocols' stamp: 'GuillermoPolito 9/5/2012 14:58'!
testReorganizeClassByAddingNewProtocolDoesNothing
	"test that when we reoganized a class by adding a category, nothing change from  RPackage point of vue."
	
	|XPackage YPackage class| 
	self addXCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	self createMethodNamed: 'newMethod' inClass: class inCategory: 'xxxxx'.  
	class organization addCategory: 'accessing' before: nil.
	
	self assert: (XPackage includesClass: class).
	self assert: (XPackage includesDefinedSelector: #newMethod ofClass: class).
	self assert: (XPackage extensionMethods size = 0).! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - removing classes' stamp: 'GuillermoPolito 9/5/2012 13:31'!
testRemoveClassUpdateTheOrganizerMappings
	"test that when we remove a class, the organizer is updated so that the class is no longer present in the  'classPackageDictionary' dictionary"
	
	|XPackage  class|
	self addXCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.

	Smalltalk removeClassNamed: 'NewClass'. 
	self deny: (self organizer includesPackageBackPointerForClass: class)! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - operations on classes' stamp: 'GuillermoPolito 9/5/2012 13:28'!
testRenameClassUpdateOrganizerClassPackageMapping
	"test that when we rename a class, the classPackage dictionary of the organizer is updated with the new name, so that we can access the package when specifying the new name"
	
	|XPackage class refactoring|
	self addXYCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	class := self createNewClassNamed: 'RPackageOldStubClass' inCategory: 'XXXXX'.
	
	class rename: 'RPackageNewStubClass'.
	
	self assert: ((self organizer packageOfClassNamed: 'RPackageNewStubClass' asSymbol) = XPackage). 
	self assert: ((self organizer packageOfClassNamed: 'RPackageOldStubClass' asSymbol) = nil).! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - recategorizing class' stamp: 'GuillermoPolito 9/5/2012 13:40'!
testRecategorizeClassRegisterTheClassInTheExactMatchPackage
	"test that when we recategorize a class, the new package in which it is defined include it"
	
	|XPackage YPackage class|
	self addXCategory.
	self addXMatchCategory.
	self addYCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage := self organizer packageNamed: #YYYYY.
	class := self createNewClassNamed: 'NewClass' inCategory: 'YYYYY'.
	
	class category: 'XXXXX'.
	
	self assert: (self organizer packageOf: class) = XPackage. 
	self deny: (self organizer packageOf: class) = YPackage.		! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - removing classes' stamp: 'GuillermoPolito 9/5/2012 13:30'!
testRemoveClassUnregisterTheClassExtensionMethodsFromTheCorrespondingPackage
	"test that when we remove a class, the class extension methods are all removed  from theire corresponding parent Package"
	
	|XPackage YPackage class|
	self addXYCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage := self organizer packageNamed: #YYYYY.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	self createMethodNamed: 'stubMethod' inClass: class  inCategory: '*yyyyy'. 
	
	Smalltalk removeClassNamed: 'NewClass'. 
	self deny: (YPackage includesSelector: #stubMethod ofClass: class). ! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - operations on protocols' stamp: 'StephaneDucasse 8/29/2013 21:07'!
testReorganizeClassByRemovingClassicCategoryRemoveMethodsFromTheParentPackage
	"test that when we reoganized a class by removing a classic category (a category not beginning with '*'), the methods from this category are removed from the parent RPackage of the class"
	
	|XPackage  class| 
		
	self addXCategory.
	XPackage := self organizer packageNamed: 'XXXXX'.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	self createMethodNamed: 'stubMethod' inClass: class  inCategory: 'classic category'.
	class removeProtocol: 'classic category'.
	self deny: (XPackage includesDefinedSelector: #stubMethod ofClass: class).! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - removing classes' stamp: 'GuillermoPolito 9/5/2012 13:31'!
testRemoveClassUnregisterTheClassFromItsPackage
	"test that when we remove a class, the class is removed from its parent Package"	

	|XPackage  class|
	self addXCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	
	Smalltalk removeClassNamed: 'NewClass'. 
	self deny: (XPackage includesClass: class)! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - operations on protocols' stamp: 'StephaneDucasse 8/29/2013 21:07'!
testReorganizeClassByRemovingExtensionCategoryRemoveMethodsFromTheExtendingPackage
	"test that when we reoganized a class by removing an extension category (a category beginning with '*'), all the methods that were inside are removed from the extending package"
	 
	|XPackage YPackage class| 
	self addXYCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage  := self organizer packageNamed: #YYYYY.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	
	self createMethodNamed: 'stubMethod' inClass: class  inCategory: '*yyyyy'.
	
	class removeProtocol: '*yyyyy'.
	
	self deny: (YPackage includesExtensionSelector: #stubMethod ofClass: class).
	self deny: (XPackage includesDefinedSelector: #stubMethod ofClass: class).! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - operations on classes' stamp: 'GuillermoPolito 9/5/2012 13:28'!
testRenameClassUpdateClassDefinedInTheParentPackage
	"test that when we rename a class, the classes Defined in the parent package includes the new name"
	"self debug: #testRenameClassUpdateClassDefinedInTheParentPackage"
	
	|XPackage  class refactoring|
	self addXCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	
	class := self createNewClassNamed: 'RPackageOldStubClass' inCategory: 'XXXXX'.	
	class rename: 'RPackageNewStubClass'.
	
	self assert: (XPackage includesClassNamed: 'RPackageNewStubClass'). 
	self deny: (XPackage includesClassNamed: 'RPackageOldStubClass').! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - operations on protocols' stamp: 'GuillermoPolito 9/5/2012 14:56'!
testReorganizeClassByRenamingClassicCategoryToExtensionCategoryMoveAllMethodsFromParentPackageToExtendingPackage
	"self debug:#testReoganizeClassByRenamingClassicCategoryToExtensionCategoryMoveAllMethodsFromParentPackageToExtendingPackage"
	"test that when we reoganized a class by renaming a  classic category (a category not beginning with '*') to an extension category, all the methods are moved from the  parent package of the class to the extending package"
	|XPackage YPackage class| 
	self addXYCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage  := self organizer packageNamed: #YYYYY.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	
	self createMethodNamed: 'stubMethod' inClass: class  inCategory: 'classic category'.
	self createMethodNamed: 'stubMethod2' inClass: class  inCategory: 'classic category'.
	
	class organization renameCategory: 'classic category' toBe: '*yyyyy'.
	
	self assert: (YPackage includesExtensionSelector: #stubMethod ofClass: class).
	self assert: (YPackage includesExtensionSelector: #stubMethod2 ofClass: class).
	self deny: (XPackage includesDefinedSelector: #stubMethod ofClass: class).
	self deny: (XPackage includesDefinedSelector: #stubMethod2 ofClass: class).! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - operations on protocols' stamp: 'GuillermoPolito 9/5/2012 14:56'!
testReorganizeClassByRenamingClassicCategoryToExtensionCategoryMoveMethodsFromParentPackageToExtendingPackage
	"test that when we reoganized a class by renaming a  classic category (a category not beginning with '*') to an extension category, all the methods are moved from the  parent package of the class to the extending package"

	|XPackage YPackage class| 
	self addXYCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage  := self organizer packageNamed: #YYYYY.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	self createMethodNamed: 'stubMethod' inClass: class  inCategory: 'classic category'.
	class organization renameCategory: 'classic category' toBe: '*yyyyy'.
	self assert: (YPackage includesExtensionSelector: #stubMethod ofClass: class).
	self deny: (XPackage includesDefinedSelector: #stubMethod ofClass: class)! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - operations on classes' stamp: 'GuillermoPolito 9/5/2012 13:28'!
testRenameClassUpdateMetaclassExtensionSelectorsInTheExtendingPackages
	"test that when we rename a class, the  'metaclassExtensionSelectors' dictionaries of the extending packages  are updated with the new name. Ther fore we test that we can correctly access the selectors from the package by specifying the right name (the new name)"
	
	|XPackage YPackage class refactoring|
	self addXYCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage := self organizer packageNamed: #YYYYY.
	class := self createNewClassNamed: 'RPackageOldStubClass' asSymbol inCategory: 'XXXXX'.
	self createMethodNamed: 'stubMethod' inClassSideOfClass: class  inCategory: '*yyyyy'.
	
	class rename: 'RPackageNewStubClass'.
	
	self assert: (YPackage includesExtensionSelector: #stubMethod ofMetaclassName: 'RPackageNewStubClass' asSymbol ). 
	self deny: (YPackage includesExtensionSelector: #stubMethod ofMetaclassName: 'RPackageOldStubClass' asSymbol ).! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - operations on protocols' stamp: 'EstebanLorenzano 9/24/2012 16:09'!
testReorganizeClassByAddingExtensionProtocol
	"test that when we reoganized a class by adding a category, nothing change from  RPackage point of vue."
	
	|XPackage YPackage class| 

	self addXCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	self createMethodNamed: 'newMethod' inClass: class inCategory: 'xxxxx'.  
	class organization addCategory: '*yyyyy' before: nil.
	
	self assert: (self organizer includesPackageNamed: #Yyyyy).! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - recategorizing class' stamp: 'EstebanLorenzano 10/8/2013 13:08'!
testRecategorizeClassRegisterTheClassInTheBestMatchPackage
	"test that when we recategorize a class, the new package in which it is defined include it"
	
	|XPackage  YPackage class|
	self addXCategory.
	self addXMatchCategory.
	self addYCategory.
	
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage := self organizer packageNamed: #YYYYY.
	
	class := self createNewClassNamed: 'NewClass' inCategory: 'YYYYY'.
	
	class category: 'XXXXX-YYYY'.
	self assert: (self organizer packageOf: class) = XPackage. 
	self deny: (self organizer packageOf: class) = YPackage.
! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - adding classes' stamp: 'EstebanLorenzano 10/8/2013 13:08'!
testAddClassAddItIntoPackageBestMatchName
	"self debug: #testAddCategoryCreatesPackage"

	|tmpPackage class|
	self addXCategory.
	self addXMatchCategory.
	
	tmpPackage := self organizer packageNamed: #'XXXXX'.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX-YYYY'.

	self assert: (tmpPackage definesClass: class).
	self assert: class package equals: tmpPackage! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - recategorizing class' stamp: 'GuillermoPolito 9/5/2012 13:48'!
testRecategorizeClassUnregisterTheClassFromTheOldPackage
	"test that when we recategorize a class, the old package in which it was defined don't include it anymore"
	

	|XPackage YPackage class|
	self addXCategory.
	self addYCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage := self organizer packageNamed: #YYYYY.
	
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.

	class category: 'YYYYY'.
	self deny: (XPackage includesClass: class).! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - recategorizing class' stamp: 'GuillermoPolito 9/5/2012 13:54'!
testRecategorizeClassUpdateTheOrganizerMappings
	"test that when we recategorize a class, the organizer is updated so that the class name point the the new RPackage"
	
	|XPackage YPackage class|
	self addXCategory.
	self addYCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage := self organizer packageNamed: #YYYYY.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	class category: 'YYYYY'.	
	self assert: (self organizer packageOf: class) equals: YPackage		! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - operations on protocols' stamp: 'GuillermoPolito 9/5/2012 14:56'!
testReorganizeClassByRenamingExtensionCategoryToAnotherExtensionCategoryAddMethodsToTheNewPackage
	"test that when we reoganized a class by renaming an extension category (a category beginning with '*') to another extension category, all the methods are moved to the new extendingPackage"
	
	|XPackage YPackage ZPackage class| 
	self addXYZCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage  := self organizer packageNamed: #YYYYY.
	ZPackage  := self organizer packageNamed: #ZZZZZ.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	self createMethodNamed: 'stubMethod' inClass: class  inCategory: '*yyyyy'.
	class organization renameCategory: '*yyyyy' toBe: '*zzzzz'.
	self assert: (ZPackage includesExtensionSelector: #stubMethod ofClass: class).
	self deny: (YPackage includesExtensionSelector: #stubMethod ofClass: class).
	self deny: (XPackage includesDefinedSelector: #stubMethod ofClass: class)! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - adding classes' stamp: 'GuillermoPolito 9/5/2012 13:28'!
testAddClassUpdateTheOrganizerMappings
	"test that when we add a class, the organizer 'classPackageMapping' dictionary is updated, so that the class is linked to its package and so that we can access its owning package"
	"self debug: #testAddClassUpdateTheOrganizer"
	|tmpPackage class|
	self addXCategory.
	
	tmpPackage := self organizer packageNamed: #XXXXX.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	 
	self assert: class package equals: tmpPackage! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - recategorizing class' stamp: 'EstebanLorenzano 9/24/2012 15:20'!
testRecategorizeClassRegisterTheClassInTheMatchingPackage
	"test that when we recategorize a class, the new package in which it is defined include it"
	
	|XPackage YPackage class|
	self addXCategory.
	self addYCategory.
	
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage := self organizer packageNamed: #YYYYY.
	
	class := self createNewClassNamed: 'NewClass' inCategory: 'YYYYY'.
	
	class category: 'XXXXX'.
	self deny: (self organizer packageOf: class) = YPackage. 
	self assert: (self organizer packageOf: class) = XPackage.! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - recategorizing class' stamp: 'GuillermoPolito 9/5/2012 13:48'!
testRecategorizeClassRegisterTheClassMethodsInTheNewPackage

	"test that when we recategorize a class, the new package in which it is defined include all the methods defined in this class (not extensions)"
	
	| addedCount addedCat XPackage YPackage ZPackage class|
	self addXCategory.
	self addYCategory.
	self addZCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage := self organizer packageNamed: #YYYYY.
	ZPackage := self organizer packageNamed: #ZZZZZ.
	
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	self createMethodNamed: 'method1' inClass: class inCategory: 'category'.
	self createMethodNamed: 'method2' inClass: class inCategory: '*zzzzz'.
	self createMethodNamed: 'method3' inClass: class inCategory: '*yyyyy'.
		
	class category: 'YYYYY'.
	
	self assert: (YPackage includesDefinedSelector: #method1 ofClass: class ). 
	self deny: (XPackage includesSelector: #method1 ofClass: class ). 
	self deny: (ZPackage includesSelector: #method1 ofClass: class ). 
	
	self deny: (XPackage includesSelector: #method2 ofClass: class ). 
	self deny: (YPackage includesSelector: #method2 ofClass: class ). 
	self assert: (ZPackage includesExtensionSelector: #method2 ofClass: class ). 

	self deny: (XPackage includesSelector: #method3 ofClass: class ). 
	self assert: (YPackage includesDefinedSelector: #method3 ofClass: class ). 
	self deny: (ZPackage includesSelector: #method3 ofClass: class ). 
! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - recategorizing class' stamp: 'GuillermoPolito 9/5/2012 13:50'!
testRecategorizeClassUnregisterTheClassMethodsFromTheOldPackage
	"test that when we recategorize a class, the old package in which it was defined don't include its defined methods (not extensions) anymore"
	"self debug: #testRecategorizeClassUnregisterTheClassMethodsFromTheOldPackage"
		
	|XPackage YPackage ZPackage class|
	self addXCategory.
	self addYCategory.
	self addZCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage := self organizer packageNamed: #YYYYY.
	ZPackage := self organizer packageNamed: #ZZZZZ.
	
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	self createMethodNamed: 'method1' inClass: class inCategory: 'category'.
	self createMethodNamed: 'method2' inClass: class inCategory: '*zzzzz'.
	self createMethodNamed: 'method3' inClass: class inCategory: '*yyyyy'.
	
	class category: 'YYYYY'.
	self deny: (XPackage includesSelector: #method1 ofClass: class ). 
	self deny: (XPackage includesSelector: #method2 ofClass: class ). 
	self deny: (XPackage includesSelector: #method3 ofClass: class ).! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - removing classes' stamp: 'GuillermoPolito 9/5/2012 13:30'!
testRemoveClassUnregisterTheClassDefinedMethodsFromItsPackage
	"test that when we remove a class, the class methods defined in the parent package (not extensions) are all removed  from its parent Package"
	
	|XPackage  class|
	self addXCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	self createMethodNamed: 'stubMethod' inClass: class  inCategory: 'classic category'. 
	
	Smalltalk removeClassNamed: 'NewClass'. 
	self deny: (XPackage includesSelector: #stubMethod ofClass: class). ! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - operations on classes' stamp: 'GuillermoPolito 9/5/2012 13:28'!
testRenameClassUpdateClassExtensionSelectorsInTheExtendingPackages
	"test that when we rename a class, the  'classExtensionSelectors' dictionaries of the extending packages  are updated with the new name. Therfore we test that we can correctly access the selectors from the package by specifying the right name (the new name)"

	|XPackage YPackage class refactoring|
	self addXYCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage := self organizer packageNamed: #YYYYY.
	class := self createNewClassNamed: 'RPackageOldStubClass' asSymbol inCategory: 'XXXXX'.
	self createMethodNamed: 'stubMethod' inClass: class  inCategory: '*yyyyy'.
	
	class rename: 'RPackageNewStubClass'.
	
	self assert: (YPackage includesExtensionSelector: #stubMethod ofClassName: 'RPackageNewStubClass' asSymbol ). 
	self deny: (YPackage includesExtensionSelector: #stubMethod ofClassName: 'RPackageOldStubClass' asSymbol ).! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - adding classes' stamp: 'GuillermoPolito 9/5/2012 13:28'!
testAddClassAddItIntoPackageExactName
	"self debug: #testAddCategoryCreatesPackage"

	|tmpPackage class|
	self addXCategory.
	self addXMatchCategory.

	tmpPackage := self organizer packageNamed: #XXXXX.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.

	self assert: (tmpPackage definesClass: class).
	self assert: class package equals: tmpPackage! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - operations on classes' stamp: 'GuillermoPolito 9/5/2012 13:28'!
testRenameClassUpdateMetaclassDefinedSelectorsInTheParentPackage
	"test that when we rename a class, the  'metaclassDefinedSelectors' dictionary of the parent package is updated with the new name. Ther fore we test that we can correctly access the selector from the package by specifying the right name (the new name)"
	
	|XPackage  class refactoring|
	self addXYCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	class := self createNewClassNamed: 'RPackageOldStubClass' asSymbol inCategory: 'XXXXX'.
	self createMethodNamed: 'stubMethod' inClassSideOfClass: class  inCategory: 'classic category'.
	
	class rename: 'RPackageNewStubClass'.
	
	self assert: (XPackage  includesDefinedSelector: #stubMethod ofMetaclassName: 'RPackageNewStubClass' asSymbol ). 
	self deny: (XPackage  includesDefinedSelector: #stubMethod ofMetaclassName: 'RPackageOldStubClass' asSymbol ).! !

!RPackageClassesSynchronisationTest methodsFor: 'tests - operations on protocols' stamp: 'GuillermoPolito 9/5/2012 14:56'!
testReorganizeClassByRenamingExtensionCategoryToClassicCategoryMoveAllMethodsFromExtendingPackageToParentPackage
	"test that when we reoganized a class by renaming an extension category (a category beginning with '*') to a classic category, all the methods are moved from the  extendingPackage to the parent package of the class"
	"self debug: #testReoganizeClassByRenamingExtensionCategoryToClassicCategoryMoveAllMethodsFromExtendingPackageToParentPackage"
	
	|XPackage YPackage class| 
	self addXYCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage  := self organizer packageNamed: #YYYYY.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	
	self createMethodNamed: 'stubMethod' inClass: class  inCategory: '*yyyyy'.
	self createMethodNamed: 'stubMethod2' inClass: class  inCategory: '*yyyyy'.
	
	class organization renameCategory: '*yyyyy' toBe: 'classic category'.
	
	self deny: (YPackage includesExtensionSelector: #stubMethod ofClass: class).
	self deny: (YPackage includesExtensionSelector: #stubMethod2 ofClass: class).
	self assert: (XPackage includesDefinedSelector: #stubMethod ofClass: class).
	self assert: (XPackage includesDefinedSelector: #stubMethod2 ofClass: class).! !

!RPackageCompleteSetupButForModificationTest commentStamp: 'TorstenBergmann 2/12/2014 22:59'!
SUnit tests for RPackage!
!RPackageCompleteSetupButForModificationTest methodsFor: 'test starting situation' stamp: '2010-04-22T07:52:00+01:00'!
testStartingSituation
	"self debug: #testStartingSituation"
	
	self deny: (p2 includesClass: b1).
	self assert: (p2 includesClass: b2).
	"a locally defined class not extended by other packages"
	
	self assert: (p2 includesClass: a2).  
	"a locally defined class extended by other packages"
	
	self assert: (p1 definesOrExtendsClass: a2).
	self deny: (p1 includesClass: a2).! !

!RPackageCompleteSetupButForModificationTest methodsFor: 'test addition' stamp: '2010-04-22T07:59:00+01:00'!
testBasicRemoveClass
	"we remove a class we check that it is not in the package anymore"
	"self debug: #testBasicRemoveClass"	

	|  size |
	size := p1 definedClasses size. 
	self assert: size = 2.
	self assert: (p1 includesClass: a1).
	self assert: (p1 includesClass: a1 class).
	p1 removeClassDefinition: a1.
	self assert: p1 definedClasses size = (size - 1).
	self assert: (p1 includesClass: b1).
	self assert: (p1 includesClass: b1 class).
	self deny: (p1 includesClass: a1).
	self deny: (p1 includesClass: a1 class).
	p1 removeClassDefinition: b1.
	self assert: p1 definedClasses size = (size - 2).
	self deny: (p1 includesClass: b1).
	self deny: (p1 includesClass: b1 class).

! !

!RPackageCompleteSetupButForModificationTest methodsFor: 'test addition' stamp: '2010-04-24T22:27:00+01:00'!
testRemoveMethodDoesNotRemoveFromClass
	"we remove a method so it is not in the package but also not from the class anymore"
	"self debug: #testRemoveMethodDoesNotRemoveFromClass"
	
	p1 removeMethod:  a1 >> #methodDefinedInP1.
	self deny: (p1 includesSelector: #methodDefinedInP1 ofClass: a1).
	self assert: (a1 selectors includes: #methodDefinedInP1)! !

!RPackageCompleteSetupButForModificationTest methodsFor: 'test addition' stamp: '2010-04-24T22:28:00+01:00'!
testRemoveMethod
	"self debug: #testRemoveMethod"
	
	p1 removeMethod: a1 >> #methodDefinedInP1.
	self deny: (p1 includesSelector: #methodDefinedInP1 ofClass: a1).
	! !

!RPackageCompleteSetupButForModificationTest methodsFor: 'test addition' stamp: '2010-04-22T07:53:00+01:00'!
testAddMethod
	"self debug: #testAddMethod"
	
	self assert: (p1 includesSelector: #methodDefinedInP1 ofClass: a1).
	
	a1 compileSilently: 'zork ^ #methodDefinedInP1'.
	p1 addMethod: (a1>>#zork).
	self assert: (p1 includesSelector: #zork ofClass: a1).
	
	self assert: (p3 includesSelector: #classSideMethodDefinedInP3 ofClass: a2 class)
	! !

!RPackageCompleteSetupButForModificationTest methodsFor: 'test addition' stamp: '2010-04-24T22:28:00+01:00'!
testRemoveShouldRaiseErrorWhenMethodIsNotInPackage
	"self debug: #testRemoveShouldRaiseErrorWhenMethodIsNotInPackage"
	
	self should: [p2 removeMethod: a2>>#methodDefinedZork] raise: Error! !

!RPackageCompleteSetupButForModificationTest methodsFor: 'setup' stamp: '2010-11-26T09:22:00+01:00'!
setUp
	super setUp.
	p1 := self createNewPackageNamed: self p1Name.
	p2 := self createNewPackageNamed: self p2Name.
	p3 := self createNewPackageNamed: self p3Name.
	
	a1 :=  self createNewClassNamed: #A1DefinedInP1 inPackage: p1.
	b1 := self createNewClassNamed: #B1DefinedInP1 inPackage: p1.
	a2 := self createNewClassNamed: #A2DefinedInP2 inPackage: p2.
	b2 := self createNewClassNamed: #B2DefinedInP2 inPackage: p2.
	a3 := self createNewClassNamed: #A3DefinedInP3 inPackage: p3.
	
	a1 compileSilently: 'methodDefinedInP1 ^ #methodDefinedInP1'.
	p1 addMethod: (a1>>#methodDefinedInP1).
	a1 compileSilently: 'anotherMethodDefinedInP1 ^ #anotherMethodDefinedInP1'.
	p1 addMethod: (a1>>#anotherMethodDefinedInP1).
	
	a2 compileSilently: 'methodDefinedInP1 ^ #methodDefinedInP1'.
	p1 addMethod: (a2>>#methodDefinedInP1).
	
	a2 compileSilently: 'methodDefinedInP2 ^ #methodDefinedInP2'.
	p2 addMethod: (a2>>#methodDefinedInP2).
	
	a2 compileSilently: 'methodDefinedInP3 ^ #methodDefinedInP3'.
	p3 addMethod: (a2>>#methodDefinedInP3).

	a2 class compileSilently: 'classSideMethodDefinedInP3 ^ #classSideMethodDefinedInP3'.
	p3 addMethod: (a2 class>>#classSideMethodDefinedInP3)

! !

!RPackageCompleteSetupButForModificationTest methodsFor: 'test starting situation' stamp: 'CamilloBruni 6/15/2013 10:17'!
testExtensionMethodOfClass
	"self debug: #testExtensionMethodOfClass"
	
	"P1 
		A1DefinedInP1>>methodDefinedInP1
		B1DefinedInP1	
		A2DefinedInP2>>methodDefinedInP1  (was *P2)
	
	P2
		A2DefinedInP2>>methodDefinedInP2
		B2DefinedInB2	

	P3
		A3DefinedInP3	
		A2DefinedInP2>>methodDefinedInP3  (was *P2*)"
		
	self assert: a2 selectors size = 3.
	"the class contains methods defined by several packages 
	however when looking with a package view we only see the package 
	extension."
		
	self assert: (p2 extensionMethodsForClass: a2) size = 0.
	self assert: (p1 extensionMethodsForClass: a1) size = 0.
	"show that extensionMethodsForClass: does works for methods of class
	defined in the package"
	
	self assert: (p1 extensionMethodsForClass: a2) size = 1.
	self assert: (p3 extensionMethodsForClass: a2) size = 1.! !

!RPackageConflictError commentStamp: '<historical>'!
I'm an error that happens when someone attempts to register a package with a conflicting name. 
Conflicting names can be of two ways: 

PackageA(tagB) conflicts with PackageA-B
PackageA-B conflicts with PackageA(tagB)!
!RPackageCreated commentStamp: '<historical>'!
I am a public announcement sent when a new RPackage is created!
!RPackageExtensionMethodsSynchronisationTest commentStamp: 'TorstenBergmann 2/12/2014 23:00'!
SUnit tests for RPackage extension methods!
!RPackageExtensionMethodsSynchronisationTest methodsFor: 'tests - operations on methods' stamp: 'GuillermoPolito 9/5/2012 14:09'!
testRemoveAllExtensionMethodsFromMetaAndInstanceSideUpdateOrganizerExtensionsMapping
	"test that In a class (from the meta  and the instance side ), when we remove all the method extended by the same external package, the class get unregistered from the classExtendingPackagesMapping of the organizer "

	|XPackage  class YPackage|
	self addXYCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage  := self organizer packageNamed: #YYYYY.

	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	self createMethodNamed: 'stubMethod' inClass: class  inCategory: '*yyyyy'. 
	self createMethodNamed: 'stubMethod2' inClass: class theMetaClass  inCategory: '*yyyyy'. 

	class removeSelector: #stubMethod.
	class theMetaClass removeSelector: #stubMethod2.
	"there should be no differences made between class and metaClass:"
	self deny: ((self organizer extendingPackagesOf: class) includes: YPackage). 
	self deny: ((self organizer extendingPackagesOf: class theMetaClass) includes: YPackage). ! !

!RPackageExtensionMethodsSynchronisationTest methodsFor: 'tests - operations on methods' stamp: 'GuillermoPolito 9/5/2012 14:26'!
testModifyMethodByChangingCode
	"test that when we modify the code of a method, everything work well: NOTHING SHOULD HAPPEN REGARDING THE PACKAGING"
	
	| class firstPackage secondPackage|
	self addXCategory.
	firstPackage := self organizer  packageNamed: #XXXXX.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	self createMethodNamed: 'stubMethod' inClass:  class inCategory: 'classic category'.

	class compile: 'stubMethod ^22222222222'.
	
	"nothing should change"
	self assert: (class >> #stubMethod) category = 'classic category'. 
	self assert: (firstPackage includesDefinedSelector: #stubMethod ofClass: class).
	self deny: (firstPackage includesExtensionSelector: #stubMethod ofClass: class).
	self assert: ((class >> #stubMethod) packageFromOrganizer: self organizer ) = firstPackage.! !

!RPackageExtensionMethodsSynchronisationTest methodsFor: 'we are not sure' stamp: 'GuillermoPolito 9/5/2012 12:51'!
testAddMethodInExtensionCategoryMatchingNameAddMethodToTheExtendingPackage
	"test that when we add a method  in an extension category ( beginning with*) that enlarge a package name (for example *mondrian-accessing for Mondrian), this method is added to the corresponding extending package"
	
	| class XPackage YPackage|
	self addXYCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage := self organizer packageNamed: #YYYYY.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.

	self createMethodNamed: #newMethod inClass:  class inCategory: '*YYYYY-subcategory'.

	self assert: (YPackage includesExtensionSelector: #newMethod ofClass: class).
	self deny: (XPackage includesDefinedSelector: #newMethod ofClass: class).

	self assert: ((class >> #newMethod) packageFromOrganizer: self organizer ) = YPackage! !

!RPackageExtensionMethodsSynchronisationTest methodsFor: 'we are not sure' stamp: 'GuillermoPolito 9/5/2012 13:04'!
testAddMethodInExtensionCategoryNotRespectingCaseAddMethodToTheExtendingPackage
	"test that when we add a method  in an extension category ( beginning with *)thae does not match the case of the corresponding package (for example *packagea for PackageA), this method is added to the corresponding extending package"
	
	| class firstPackage secondPackage|
	self addXYCategory.
	firstPackage := self organizer packageNamed: #XXXXX.
	secondPackage := self organizer packageNamed: #YYYYY.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	
	self createMethodNamed: 'stubMethod' inClass:  class inCategory: '*yyYyY'.
	
	self assert: (secondPackage includesExtensionSelector: #stubMethod ofClass: class).
	self deny: (firstPackage includesDefinedSelector: #stubMethod ofClass: class).
	
	self assert: ((class >> #stubMethod) packageFromOrganizer: self organizer ) equals: secondPackage.! !

!RPackageExtensionMethodsSynchronisationTest methodsFor: 'tests - operations on methods' stamp: 'GuillermoPolito 9/5/2012 14:10'!
testRemoveExtensionMethodDoesNotRemoveExtendingPackage
	"test that when we remove a method that is an extension from an external package, the package is not removed from the the class extending packages if another extension still exist"

	|XPackage  class YPackage|
	self addXYCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage  := self organizer packageNamed: #YYYYY.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	self createMethodNamed: 'stubMethod' inClass: class  inCategory: '*yyyyy'. 
	self createMethodNamed: 'stubMethod2' inClass: class  inCategory: '*yyyyy'. 
	
	self assert: (YPackage includesExtensionSelector: #stubMethod ofClass: class). 
	self assert: (YPackage includesExtensionSelector: #stubMethod2 ofClass: class). 

	"If we only remove one of the extension methods, the package should still be extending the class."
	class removeSelector: #stubMethod.
	self assert: (YPackage extendsClass: class).
	self assert: (YPackage extendsClass: class classSide).! !

!RPackageExtensionMethodsSynchronisationTest methodsFor: 'we are not sure' stamp: 'GuillermoPolito 9/5/2012 12:51'!
testAddMethodInExtensionCategoryWithExactMatchAddMethodToTheExtendingPackage
	"test that when we add a method to a  class in an extension category ( beginning with *), this method is added to the corresponding extending package"
	
	| class firstPackage secondPackage|
	self addXYCategory.		
	self addXMatchCategory.
	
	firstPackage := self organizer packageNamed: #XXXXX.
	secondPackage := self organizer packageNamed: #YYYYY.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	
	
	self createMethodNamed: 'stubMethod' inClass: class inCategory: '*YYYYY'.
	
	self assert: (secondPackage includesExtensionSelector: #stubMethod ofClass: class).
	self deny: (firstPackage includesDefinedSelector: #stubMethod ofClass: class).
	
	self assert: ((class >> #stubMethod) packageFromOrganizer: self organizer) = secondPackage! !

!RPackageExtensionMethodsSynchronisationTest methodsFor: 'tests - operations on methods' stamp: 'GuillermoPolito 9/5/2012 14:09'!
testRemoveAllExtensionMethodsRemoveTheClassFromExtendedClasses
	"test that In a class, when we remove all the method extended by the same external package, the class get unregistered from the extended classes of the external package "

	|XPackage  class YPackage|
	self addXYCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage  := self organizer packageNamed: #YYYYY.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	self createMethodNamed: 'stubMethod' inClass: class  inCategory: '*yyyyy'. 
	self createMethodNamed: 'stubMethod2' inClass: class  inCategory: '*yyyyy'. 
	
	self assert: (YPackage includesExtensionSelector: #stubMethod ofClass: class). 
	self assert: (YPackage includesExtensionSelector: #stubMethod2 ofClass: class). 

	class removeSelector: #stubMethod.
	class removeSelector: #stubMethod2.
	self deny: (YPackage extendsClass: class).
	self deny: (YPackage extendsClass: class classSide).! !

!RPackageExtensionMethodsSynchronisationTest methodsFor: 'testing' stamp: 'GuillermoPolito 9/5/2012 13:03'!
testAddMethodInExtensionCategoryNotExistingCreateANewPackageAndInstallsMethodInIt
	"test that when we add a method  in an extension category ( beginning with *)that does not refer to an existing categorya new package with the name of this category is added, and that the method is added to this new package"
	| class firstPackage t|
	
	self addXCategory.
	
	firstPackage := self organizer packageNamed: #XXXXX.
	
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	
	self createMethodNamed: #newMethod inClass:  class inCategory: '*SomethingDifferentNothingToDoWithWhatWeHave'.
	
	self deny: (class package includesDefinedSelector: #newMethod ofClass: class).
	
	self assert: (self organizer includesPackageNamed: #SomethingDifferentNothingToDoWithWhatWeHave).
	self assert: ((class >> #newMethod) packageFromOrganizer: self organizer ) equals: (self organizer packageNamed: #SomethingDifferentNothingToDoWithWhatWeHave).! !

!RPackageExtensionMethodsSynchronisationTest methodsFor: 'tests - operations on methods' stamp: 'GuillermoPolito 9/5/2012 14:11'!
testRemoveExtensionMethodRemoveMethodFromItsPackage
	"test that when we remove a method that is an extension from an external package, the method is removed from this package"

	|XPackage  class YPackage|
	self addXYCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage  := self organizer packageNamed: #YYYYY.
	
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	self createMethodNamed: 'stubMethod' inClass: class  inCategory: '*yyyyy'.
	
	class removeSelector: #stubMethod.
	self deny: (YPackage includesExtensionSelector: #stubMethod ofClass: class). ! !

!RPackageExtensionMethodsSynchronisationTest methodsFor: 'tests - operations on methods' stamp: 'ThierryGoubier 1/27/2014 13:45'!
testMoveClassInPackageWithExtensionsOnClass
	"Move a class in package XXXXX (with extensions from YYYY) to package YYYYY."
	
	| class secondPackage|
	self addXYCategory.
	secondPackage := self organizer packageNamed: #YYYYY.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	self createMethodNamed: 'stubMethod' inClass:  class inCategory: secondPackage methodCategoryPrefix.

	secondPackage addClass: class.
	
	"Everything should now be in second package (and not listed as an extension)."
	self assert: (class >> #stubMethod) category = Protocol defaultName. 
	self assert: (secondPackage includesDefinedSelector: #stubMethod ofClass: class).
	self deny: (secondPackage includesExtensionSelector: #stubMethod ofClass: class).
	self assert: ((class >> #stubMethod) packageFromOrganizer: self organizer ) = secondPackage.! !

!RPackageExtensionMethodsSynchronisationTest methodsFor: 'tests - operations on methods' stamp: 'ThierryGoubier 1/27/2014 13:45'!
testMoveClassInPackageWithExtensionsOnClassAndBack
	"Move a class in package XXXXX (with extensions from YYYY) to package YYYYY."
	
	| class firstPackage secondPackage|
	self addXYCategory.
	firstPackage := self organizer  packageNamed: #XXXXX.
	secondPackage := self organizer packageNamed: #YYYYY.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	self createMethodNamed: 'stubMethod' inClass:  class inCategory: secondPackage methodCategoryPrefix.

	secondPackage addClass: class.
	
	"Everything should now be in second package (and not listed as an extension, but instead as 'as yet unclassified')."

	self assert: (class >> #stubMethod) category = Protocol defaultName. 
	self assert: (secondPackage includesDefinedSelector: #stubMethod ofClass: class).
	self deny: (secondPackage includesExtensionSelector: #stubMethod ofClass: class).
	self assert: ((class >> #stubMethod) packageFromOrganizer: self organizer ) = secondPackage.
	
	"Moving back, we should not see the extension reappear."

	firstPackage addClass: class.
	
	self assert: (class >> #stubMethod) category = Protocol defaultName. 
	self assert: (firstPackage includesDefinedSelector: #stubMethod ofClass: class).
	self deny: (secondPackage includesExtensionSelector: #stubMethod ofClass: class)
! !

!RPackageExtensionMethodsSynchronisationTest methodsFor: 'tests - operations on methods' stamp: 'ThierryGoubier 2/2/2014 16:39'!
testMoveClassInPackageWithExtensionsOnClass2
	"Move a class in package XXXXX (with extensions from XXXX) to package YYYYY."
	
	| class secondPackage|
	self addXYCategory.
	secondPackage := self organizer packageNamed: #YYYYY.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	self createMethodNamed: 'stubMethod' inClass:  class inCategory: '*XXXXX'.

	secondPackage addClass: class.
	
	"Everything should now be in second package (and not listed as an extension)."
	self assert: (class >> #stubMethod) category = Protocol defaultName. 
	self assert: (secondPackage includesDefinedSelector: #stubMethod ofClass: class).
	self deny: (secondPackage includesExtensionSelector: #stubMethod ofClass: class).
	self assert: ((class >> #stubMethod) packageFromOrganizer: self organizer ) = secondPackage.! !

!RPackageExtensionMethodsSynchronisationTest methodsFor: 'we are not sure' stamp: 'EstebanLorenzano 10/8/2013 13:09'!
testAddMethodInExtensionCategoryBestMatchingNameAddMethodToTheExtendingPackage
	"test that when we add a method  in an extension category ( beginning with*) that enlarge a package name (for example *mondrian-accessing for Mondrian), this method is added to the corresponding extending package"
	
	| class XPackage YPackage |

	self addXYCategory.
	self addXMatchCategory.
	
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX-YYYY'.
	
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage := self organizer packageNamed: #YYYYY.
	
	class := self createNewClassNamed: 'NewClass' inCategory: 'YYYYY'.

	self createMethodNamed: #newMethod inClass:  class inCategory: '*XXXXX-YYYY'.

	self deny: (YPackage includesDefinedSelector: #newMethod ofClass: class).
	self assert: (XPackage includesExtensionSelector: #newMethod ofClass: class).

	self assert: ((class >> #newMethod) packageFromOrganizer: self organizer ) = XPackage! !

!RPackageExtensionMethodsSynchronisationTest methodsFor: 'testing' stamp: 'GuillermoPolito 9/5/2012 13:03'!
testAddMethodInExtensionCategoryNotExistingCreateANewPackage
	"test that when we add a method  in an extension category ( beginning with *)that does not refer to an existing categorya new package with the name of this category is added, and that the method is added to this new package"
	| class firstPackage t|
	
	self addXCategory.
	
	firstPackage := self organizer packageNamed: #XXXXX.
	
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	
	self createMethodNamed: #newMethod inClass:  class inCategory: '*SomethingDifferentNothingToDoWithWhatWeHave'.
	
	self deny: (class package includesDefinedSelector: #newMethod ofClass: class).
	
	self assert: (self organizer includesPackageNamed: #SomethingDifferentNothingToDoWithWhatWeHave).! !

!RPackageIncrementalTest commentStamp: 'StephaneDucasse 5/15/2010 20:21'!
The tests takes as fixture the following situation (which is constructed partially)
For tests that do not need to check the incremental construction.


P1 
	A1DefinedInP1>>methodDefinedInP1
	B1DefinedInP1	
	A2DefinedInP2>>methodDefinedInP1  (was *P2)
	
P2
	A2DefinedInP2>>methodDefinedInP2
	B2DefinedInB2	

P3
	A3DefinedInP3	
	A2DefinedInP2>>methodDefinedInP3  (was *P2*)!
!RPackageIncrementalTest methodsFor: 'test extension' stamp: 'CamilloBruni 9/5/2012 14:25'!
testIncludeSelectorOfClass
	| p1 p2 p3 a2  |
	p1 := self createNewPackageNamed: 'P1'.
	p2 := self createNewPackageNamed: 'P2'.
	p3 := self createNewPackageNamed: 'P3'.
	a2 := self createNewClassNamed: #A2InPackageP2 inPackage: p2.
	a2 compileSilently: 'methodDefinedInP2 ^ #methodDefinedInP2'.
	p2 addMethod: (a2>>#methodDefinedInP2).
	a2 compileSilently: 'methodDefinedInP1 ^ #methodDefinedInP1'.
	p1 addMethod: (a2>>#methodDefinedInP1).
	a2 compileSilently: 'methodDefinedInP3 ^ #methodDefinedInP3'.
	p3 addMethod: (a2>>#methodDefinedInP3).
	
	"includesSelector checks both in defined and extension so we test both"
	self assert: (p2 includesSelector: #methodDefinedInP2 ofClass: a2).
	self assert: (p2 includesDefinedSelector: #methodDefinedInP2 ofClassName: a2 name).
	self deny: (p2 includesExtensionSelector: #methodDefinedInP2 ofClassName: a2 name).
	
	self deny: (p2 includesSelector: #methodDefinedInP3 ofClass: a2).
	self assert: (p3 includesExtensionSelector: #methodDefinedInP3 ofClassName: a2 name).
	self deny: (p3 includesDefinedSelector: #methodDefinedInP3 ofClassName: a2 name).
	
	self deny: (p2 includesSelector: #methodDefinedInP1 ofClass: a2).
	self assert: (p1 includesExtensionSelector: #methodDefinedInP1 ofClassName: a2 name).
	self deny: (p3 includesDefinedSelector: #methodDefinedInP1 ofClassName: a2 name).! !

!RPackageIncrementalTest methodsFor: 'test package belonging' stamp: 'CamilloBruni 9/5/2012 14:26'!
testPackageOfClassForDefinedClasses
	| p a1 b1 |
	p := self createNewPackageNamed: 'P1'.
	a1 := self createNewClassNamed: #A1InPAckageP1 inPackage: p.
	b1 := self createNewClassNamed: #B1InPAckageP1 inPackage: p.

	self assert: a1 package = p.
	self assert: b1 package = p.
! !

!RPackageIncrementalTest methodsFor: 'test class addition removal' stamp: 'CamilloBruni 9/5/2012 14:24'!
testAddClassDefinitionNoDuplicate
	| p a1 b1 |
	p := self createNewPackageNamed: self p1Name.
	a1 := self createNewClassNamed: #A1InPackageP1 inCategory: self p1Name.
	self assert: p definedClasses size = 0.
	p addClassDefinition: a1.
	self assert: p definedClasses size = 1.
	b1 := self createNewClassNamed: #B1InPackageP1 inCategory: self p1Name.
	p addClassDefinition: a1.
	"adding the same class does not do anything - luckily"
	self assert: p definedClasses size = 1.
	p addClassDefinition: b1.
	self assert: p definedClasses size = 2.
! !

!RPackageIncrementalTest methodsFor: 'test extension' stamp: 'CamilloBruni 9/5/2012 14:25'!
testIncludesMethodOfClassInPresenceOfOtherPackageExtensions
	| p1 p2 p3 a2  a2name |
	p1 := self createNewPackageNamed: 'P1'.
	p2 := self createNewPackageNamed: 'P2'.
	p3 := self createNewPackageNamed: 'P3'.
	a2name := #A2InPackageP2.
	a2 := self createNewClassNamed: a2name inPackage: p2.
	
	a2 compileSilently: 'methodDefinedInP2 ^ #methodDefinedInP2'.
	p2 addMethod: (a2>>#methodDefinedInP2).
	self assert: (p2 includesDefinedSelector: #methodDefinedInP2 ofClassName: a2name).
	
	a2 compileSilently: 'methodDefinedInP1 ^ #methodDefinedInP1'.
	p1 addMethod: (a2>>#methodDefinedInP1).
	self assert: (p1 includesExtensionSelector: #methodDefinedInP1 ofClassName: a2name).
	
	a2 compileSilently: 'methodDefinedInP3 ^ #methodDefinedInP3'.
	p3 addMethod: (a2>>#methodDefinedInP3).
	self assert: (p3 includesExtensionSelector: #methodDefinedInP3 ofClassName: a2name).
		
	self assert: (p2 includesDefinedSelector: #methodDefinedInP2 ofClassName: a2name).
	self deny: (p2 includesDefinedSelector: #methodDefinedInP3 ofClassName: a2name).
	self deny: (p2 includesExtensionSelector: #methodDefinedInP3 ofClassName: a2name).
	self deny: (p2 includesDefinedSelector: #methodDefinedInP1 ofClassName: a2name).
	self deny: (p2 includesExtensionSelector: #methodDefinedInP1 ofClassName: a2name).
	
	
	! !

!RPackageIncrementalTest methodsFor: 'test method addition removal' stamp: 'CamilloBruni 9/5/2012 14:26'!
testMethodPackageResolution
	| a1Name p1 a1 |
	a1Name := #A2InPackageP2.
	p1 := self createNewPackageNamed: 'P1'.
	a1 := self createNewClassNamed: a1Name inPackage: p1.
	a1 compileSilently: 'method ^ #methodDefinedInP2'.
	a1 class compileSilently: 'method ^ #methodDefinedInP2'.
	
	p1 addMethod:  (a1>>#method).
	p1 addMethod:  (a1 class>>#method).
	
	self assert: (a1 >> #method) package == p1.
	self assert: (a1 class >> #method) package == p1.! !

!RPackageIncrementalTest methodsFor: 'utility' stamp: '2010-11-26T09:18:00+01:00'!
p1Name
	^ 'RPackageTestP1'! !

!RPackageIncrementalTest methodsFor: 'utility' stamp: '2010-06-13T17:18:00+01:00'!
removeClassNamedIfExists: aClassNameSymbol
	Smalltalk at: aClassNameSymbol asSymbol ifPresent: [:c| c removeFromSystem]! !

!RPackageIncrementalTest methodsFor: 'utility' stamp: '2010-11-26T09:23:00+01:00'!
p3Name
	^ 'RPackageTestP3'

! !

!RPackageIncrementalTest methodsFor: 'test extension' stamp: 'CamilloBruni 9/5/2012 14:25'!
testExtensionClassesWithCompiledMethod
	| p1 p2  a2 b2 |
	p1 := self createNewPackageNamed: 'P1'.
	p2 := self createNewPackageNamed: 'P2'.
	a2 := self createNewClassNamed: #A2InPackageP2 inPackage: p2.
	b2 := self createNewClassNamed: #B2InPackageP2 inPackage: p2.
	self deny: (p1 includesClass: a2).
	self assert: (p2 includesClass: b2).
	self assert: (p2 includesClass: b2).
	
	a2 compileSilently: 'methodDefinedInP1 ^ #methodDefinedInP1'.
	p1 addMethod: (a2>>#methodDefinedInP1).
	
	self assert: p1 extensionMethods size = 1.
	self assert: p1 extensionSelectors size = 1.
	self assert: p1 extendedClasses size = 1.
	self deny: (p1 includesClass: a2).
	"method extension class are not included in packages"
	
	b2 compile: 'firstMethodInB2PackagedInP1 ^ 1'.
	p1 addMethod: (b2>>#firstMethodInB2PackagedInP1).
	
	self assert: p1 extensionSelectors  size = 2.
	self assert: p1 extensionMethods  size = 2.
	self assert: p1 extendedClasses size = 2.
	self deny: (p1 includesClass: b2).
	
	b2 compileSilently: 'secondMethodInB2PackagedInP1 ^ 2'.
	p1 addMethod: (b2>>#secondMethodInB2PackagedInP1).
	
	self assert: p1 extensionSelectors  size = 3.
	self assert: p1 extensionMethods  size = 3.
	self assert: p1 extendedClasses size = 2.
	self deny: (p1 includesClass: b2).! !

!RPackageIncrementalTest methodsFor: 'test package belonging' stamp: 'CamilloBruni 9/5/2012 14:26'!
testPackageOfClassForClassesNotDefinedInPackageButJustExtendingIt
	| p1 p2 a2  |
	p1 := self createNewPackageNamed: 'P1'.
	p2 := self createNewPackageNamed: 'P2'.

	a2 := self createNewClassNamed: #A2InPackageP2 inPackage: p2.
	a2 compileSilently: 'methodDefinedInP1 ^ #methodDefinedInP1'.
	p1 addMethod: (a2>>#methodDefinedInP1).
	
	self assert: a2 package = p2.
	p1 extensionMethods do: 
		[:each | self deny: each methodClass package = p1 ].
	"the package of a class which is extended inside a package p, is not p
	but the package where the class was defined"! !

!RPackageIncrementalTest methodsFor: 'test extension' stamp: 'CamilloBruni 9/5/2012 14:25'!
testIncludeClassMore
	| p1 p2 p3 a2  |
	p1 := self createNewPackageNamed: 'P1'.
	p2 := self createNewPackageNamed: 'P2'.
	p3 := self createNewPackageNamed: 'P3'.
	a2 := self createNewClassNamed: #A2InPackageP2 inPackage: p2.
	a2 compileSilently: 'methodDefinedInP2 ^ #methodDefinedInP2'.
	p2 addMethod: (a2>>#methodDefinedInP2).
	a2 compileSilently: 'methodDefinedInP1 ^ #methodDefinedInP1'.
	p1 addMethod: (a2>>#methodDefinedInP1).
	a2 compileSilently: 'methodDefinedInP3 ^ #methodDefinedInP3'.
	p3 addMethod: (a2>>#methodDefinedInP3).
	
	self assert: (p2 includesClass: a2).
	self deny: (p1 includesClass: a2).
	self deny: (p3 includesClass: a2).! !

!RPackageIncrementalTest methodsFor: 'test method addition removal' stamp: 'CamilloBruni 9/5/2012 14:24'!
testAddRemoveMethod
	| p1 p2 p3 a2   a2Name |
	a2Name := #A2InPackageP2.
	p1 := self createNewPackageNamed: 'P1'.
	p2 := self createNewPackageNamed: 'P2'.
	p3 := self createNewPackageNamed: 'P3'.
	a2 := self createNewClassNamed: a2Name inPackage: p2.
	a2 compileSilently: 'methodDefinedInP2 ^ #methodDefinedInP2'.
	
	p2 addMethod: (a2>>#methodDefinedInP2).
	a2 compileSilently: 'methodDefinedInP1 ^ #methodDefinedInP1'.
	p1 addMethod: (a2>>#methodDefinedInP1).
	a2 compileSilently: 'methodDefinedInP3 ^ #methodDefinedInP3'.
	p3 addMethod: (a2>>#methodDefinedInP3).
	
	self assert: (p2 includesDefinedSelector: #methodDefinedInP2 ofClassName: a2Name).
	self deny: (p2 includesExtensionSelector: #methodDefinedInP2 ofClassName: a2Name).
	self deny: (p3 includesDefinedSelector: #methodDefinedInP3 ofClassName: a2Name).
	self assert: (p3 includesExtensionSelector: #methodDefinedInP3 ofClassName: a2Name).
	self assert: (p1 includesExtensionSelector: #methodDefinedInP1 ofClassName: a2Name).
	self deny: (p3 includesDefinedSelector: #methodDefinedInP1 ofClassName: a2Name).
	
	"removeMethod by default removes from defined methods and not extension"
	p2 removeMethod: (a2>>#methodDefinedInP2).
	self deny: (p2 includesDefinedSelector: #methodDefinedInP2 ofClassName: a2Name).
	self deny: (p2 includesExtensionSelector: #methodDefinedInP2 ofClassName: a2Name).
	
	p1 removeMethod: (a2>>#methodDefinedInP1).
	self deny: (p1 includesDefinedSelector: #methodDefinedInP3 ofClassName: a2Name).
	self deny: (p1 includesExtensionSelector: #methodDefinedInP3 ofClassName: a2Name).! !

!RPackageIncrementalTest methodsFor: 'test extension' stamp: 'CamilloBruni 9/5/2012 14:25'!
testIncludeClass
	| p1 p2 a2  |
	p1 := self createNewPackageNamed: 'P1'.
	p2 := self createNewPackageNamed: 'P2'.
	a2 := self createNewClassNamed: #A2InPackageP2 inPackage: p2.
	a2 compileSilently: 'methodPackagedInP1 ^ #methodPackagedInP1'.
	
	self deny: (p1 includesClass: a2).
	p1 addMethod: (a2>>#methodPackagedInP1).
	self deny: (p1 includesClass: a2).
	"We should declare the class explictly. Adding a method does not declare
	the class as defined. The reason is that like that the client controls the granularity 
	and moment of class registration."
	
	p1 addClassDefinition: a2.
	self assert: (p1 includesClass: a2).
	self assert: (p1 includesClassNamed: a2 name).
	
	! !

!RPackageIncrementalTest methodsFor: 'test class addition removal' stamp: 'CamilloBruni 9/5/2012 14:26'!
testRemoveExtensionMethodRemovesExtensionsFromRPackage
	| p1 p2 a1 b1 |
	p1 := self createNewPackageNamed: self p1Name.
	p2 := self createNewPackageNamed: self p2Name.
	"the class is created but not added to the package for now"
	a1 := self createNewClassNamed: #A1InPackageP1 inCategory: self p1Name.
	p1 addClassDefinition: a1.
	self assert: p1 definedClasses size = 1.
	a1 compileSilently: 'newlyAddedToA1 ^ #methodDefinedInP1'.
	p2 addMethod: (a1>>#newlyAddedToA1).
	
	self assert: (p2 includesSelector: #newlyAddedToA1 ofClass: a1).
	self assert: (p2 includesExtensionSelector: #newlyAddedToA1 ofClass: a1).
	
	a1 removeSelector: #newlyAddedToA1.
	
	self deny: (p2 includesSelector: #newlyAddedToA1 ofClass: a1).
	self deny: (p2 includesExtensionSelector: #newlyAddedToA1 ofClass: a1).
	self deny: (p2 includesDefinedSelector: #newlyAddedToA1 ofClass: a1).! !

!RPackageIncrementalTest methodsFor: 'test class addition removal' stamp: 'CamilloBruni 9/5/2012 14:26'!
testRemoveClassRemovesExtensions
	| p1 p2 a1 b1 |
	p1 := self createNewPackageNamed: self p1Name.
	p2 := self createNewPackageNamed: self p2Name.
	"the class is created but not added to the package for now"
	a1 := self createNewClassNamed: #A1InPackageP1 inCategory: self p1Name.
	p1 addClassDefinition: a1.
	self assert: p1 definedClasses size = 1.
	a1 compileSilently: 'newlyAddedToA1 ^ #methodDefinedInP1'.
	p2 addMethod: (a1>>#newlyAddedToA1).
	
	self assert: (p2 includesSelector: #newlyAddedToA1 ofClass: a1).
	self assert: (p2 includesExtensionSelector: #newlyAddedToA1 ofClass: a1).
	
	a1 removeFromSystem.
	
	self deny: (p2 includesSelector: #newlyAddedToA1 ofClass: a1).
	self deny: (p2 includesExtensionSelector: #newlyAddedToA1 ofClass: a1).
	self deny: (p2 includesDefinedSelector: #newlyAddedToA1 ofClass: a1).! !

!RPackageIncrementalTest methodsFor: 'test class addition removal' stamp: 'CamilloBruni 9/5/2012 14:25'!
testBogusClassAddition
	| p a1 |
	p := self createNewPackageNamed: self p1Name.
	a1 := self createNewClassNamed: #A1InPAckageP1 inCategory: self p1Name.
	self assert: p definedClasses size = 0.
	p addClassDefinitionName: a1 name.
	self assert: p definedClasses size = 1.
	self assert: (p includesClass: a1).
	self should: [p addClassDefinitionName: a1 class name] raise: Error.
! !

!RPackageIncrementalTest methodsFor: 'test class addition removal' stamp: 'CamilloBruni 9/5/2012 14:25'!
testDefinedClassesAndDefinedClassNames
	| p a1 b1 |
	p := self createNewPackageNamed: self p1Name.
	a1 := self createNewClassNamed: #A1InPackageP1 inCategory: self p1Name.
	self assert: p definedClasses size = 0.
	p addClassDefinition: a1.
	self assert: p definedClasses size = 1.
	self assert: (p definedClasses  includes: a1).
	self assert: (p definedClassNames includes: a1 name).
	
	b1 := self createNewClassNamed: #B1InPackageP1 inCategory: self p1Name.
	p addClassDefinition: b1.
	self assert: p definedClasses size = 2.
	self assert: (p definedClasses includes: b1).
	self assert: (p definedClassNames includes: b1 name).
	! !

!RPackageIncrementalTest methodsFor: 'test method addition removal' stamp: 'CamilloBruni 9/5/2012 14:24'!
testAddRemoveSelector
	| p1 p2 p3 a2   a2Name |
	a2Name := #A2InPackageP2.
	p1 := self createNewPackageNamed: 'P1'.
	p2 := self createNewPackageNamed: 'P2'.
	p3 := self createNewPackageNamed: 'P3'.
	a2 := self createNewClassNamed: a2Name inPackage: p2.
	a2 compileSilently: 'methodDefinedInP2 ^ #methodDefinedInP2'.
	p2 addSelector: #methodDefinedInP2 ofClassName: a2Name.
	a2 compileSilently: 'methodDefinedInP1 ^ #methodDefinedInP1'.
	p1 addSelector: #methodDefinedInP1 ofClassName: a2Name.
	a2 compileSilently: 'methodDefinedInP3 ^ #methodDefinedInP3'.
	p3 addSelector: #methodDefinedInP3 ofClassName: a2Name.
	
	self assert: (p2 includesDefinedSelector: #methodDefinedInP2 ofClassName: a2Name).
	self deny: (p2 includesExtensionSelector: #methodDefinedInP2 ofClassName: a2Name).
	self deny: (p3 includesDefinedSelector: #methodDefinedInP3 ofClassName: a2Name).
	self assert: (p3 includesExtensionSelector: #methodDefinedInP3 ofClassName: a2Name).
	self assert: (p1 includesExtensionSelector: #methodDefinedInP1 ofClassName: a2Name).
	self deny: (p3 includesDefinedSelector: #methodDefinedInP1 ofClassName: a2Name).
	
	p2 removeSelector: #methodDefinedInP2 ofClassName:  a2Name.
	self deny: (p2 includesDefinedSelector: #methodDefinedInP2 ofClassName: a2Name).
	self deny: (p2 includesExtensionSelector: #methodDefinedInP2 ofClassName: a2Name).
	
	p1 removeSelector: #methodDefinedInP1 ofClassName:  a2Name.
	self deny: (p1 includesDefinedSelector: #methodDefinedInP3 ofClassName: a2Name).
	self deny: (p1 includesExtensionSelector: #methodDefinedInP3 ofClassName: a2Name).! !

!RPackageIncrementalTest methodsFor: 'utility' stamp: '2010-11-26T09:23:00+01:00'!
p2Name
	^ 'RPackageTestP2'

! !

!RPackageIncrementalTest methodsFor: 'test extension' stamp: 'CamilloBruni 9/5/2012 14:25'!
testClasses	
	| p1 p2 a2  b2 |
	p1 := self createNewPackageNamed: 'P1'.
	p2 := self createNewPackageNamed: 'P2'.

	a2 := self createNewClassNamed: #A2InPackageP2 inPackage: p2.
	b2 := self createNewClassNamed: #B2InPackageP2 inPackage: p2.
	a2 compileSilently: 'methodPackagedInP1 ^ #methodPackagedInP1'.
	p1 addMethod: (a2>>#methodPackagedInP1).
	b2 class compileSilently: 'methodPackagedInP1 ^ #methodPackagedInP1'.
	p1 addMethod: (b2 class>>#methodPackagedInP1).
	
	self assert: p1 classes size = 2.
	self assert: p2 classes size = 2.! !

!RPackageIncrementalTest methodsFor: 'test class addition removal' stamp: 'CamilloBruni 9/5/2012 14:24'!
testAddClassAfterMethodsAtMetaclassToo
	| p1 a1 b1 |
	p1 := self createNewPackageNamed: self p1Name.
	"the class is created but not added to the package for now"
	a1 := self createNewClassNamed: #A1InPackageP1 inCategory: self p1Name.
	self assert: p1 definedClasses size = 0.
	
	"now we add a new method to the class and the to the package: it is considered
	as class extension"
	
	a1 class compileSilently: 'newlyAddedToA1Class ^ #methodDefinedInP1'.
	p1 addMethod: (a1 class>>#newlyAddedToA1Class).
	self assert: (p1 includesSelector: #newlyAddedToA1Class ofClass: a1 class).
	self assert: (p1 includesExtensionSelector: #newlyAddedToA1Class ofClass: a1 class).
	self deny: (p1 includesDefinedSelector: #newlyAddedToA1Class ofClass: a1 class).
	
	"Now we add the class and this means that the method is not an extension anymore but 
	a defined method"
	
	p1 addClassDefinition: a1.
	self assert: p1 definedClasses size = 1.
	
	self deny: (p1 includesExtensionSelector: #newlyAddedToA1Class ofClass: a1 class).
	self assert: (p1 includesDefinedSelector: #newlyAddedToA1Class ofClass: a1 class).
	
	
"
	self assert: (p1 includesSelector: #methodDefinedInP1 ofClass: a1).
	self assert: (p3 includesSelector: #classSideMethodDefinedInP3 ofClass: a2 class)
	"! !

!RPackageIncrementalTest methodsFor: 'test extension' stamp: 'CamilloBruni 9/5/2012 14:25'!
testIncludesOrTouches
	| p1 p2 a2  |
	p1 := self createNewPackageNamed: 'P1'.
	p2 := self createNewPackageNamed: 'P2'.

	a2 := self createNewClassNamed: #A2InPackageP2 inPackage: p2.
	self deny: (p1 includesClass: a2).
	self assert: (p2 includesClass: a2).
	
	a2 compileSilently: 'methodPackagedInP1 ^ #methodPackagedInP1'.
	p1 addMethod: (a2>>#methodPackagedInP1).
	
	self assert: p1 extensionMethods size = 1.
	self assert: p1 extensionSelectors size = 1.
	self deny: (p1 includesClass: a2).
	self assert: (p1 definesOrExtendsClass: a2).
	self assert: (p2 includesClass: a2).! !

!RPackageIncrementalTest methodsFor: 'setup' stamp: 'StephaneDucasse 6/3/2012 22:46'!
tearDown
	
	| logging |
	createdPackages  do: [:each | self removePackage: each name].
	"just remove package from package organizer dictionary"
	
	createdPackages  do: [:each |
		|mCPackage|
		mCPackage := self allManagers 
							detect: [:mcPackage | mcPackage packageName = each packageName asString] 
							ifNone: [nil].
		mCPackage ifNotNil: [mCPackage unregister].
		each extendedClasses do: [ :extendedClass|
			self packageClass organizer
		 		unregisterExtendingPackage: each forClass: extendedClass.]].
	"all ***extending*** classes the packages are also unregistered from PackageOrganizer"									
	(createdClasses reject: [:c| c isObsolete]) do: [:cls| 
		"(RPackage organizer includesPackageBackPointerForClass: cls) 
			ifTrue: [cls package unregisterClass: cls.]. 
		when RPackageOrganizer was not looking at system event we had to do the commented actions"
		logging := false.
		cls removeFromSystem: logging.  
		"not logging so no event are raised"
		"but this also means that the consistency cannot be ensured by internal system announcer too."
		].					
	createdCategories do: [:each | 
		|mCPackage|
		SystemOrganization removeCategory: each.
		 ].
	super tearDown.! !

!RPackageIncrementalTest methodsFor: 'test extension' stamp: 'CamilloBruni 9/5/2012 14:25'!
testExtensionClassNames
	| p1 p2  a2 b2 |
	p1 := self createNewPackageNamed: 'P1'.
	p2 := self createNewPackageNamed: 'P2'.
	a2 := self createNewClassNamed: #A2InPackageP2 inPackage: p2.
	b2 := self createNewClassNamed: #B2InPackageP2 inPackage: p2.
	self deny: (p1 includesClass: a2).
	self assert: (p2 includesClass: b2).
	self assert: (p2 includesClass: a2).
	
	a2 compileSilently: 'methodDefinedInP1 ^ #methodDefinedInP1'.
	p1 addSelector: #methodDefinedInP1 ofClassName: a2 name.
	
	self assert: p1 extensionSelectors size = 1.
	self assert: p1 extensionMethods size = 1.
	self assert: (p1 extendedClassNames includes: #A2InPackageP2).
	self deny: (p1 includesClass: a2).
	"method extension class are not included in packages"
	
	b2 compile: 'firstMethodInB2PackagedInP1 ^ 1'.
	p1 addSelector: #firstMethodInB2PackagedInP1 ofClassName: b2 name.
	
	self assert: p1 extensionSelectors  size = 2.
	self assert: p1 extensionMethods  size = 2.
	self assert: (p1 extendedClassNames includes: #B2InPackageP2).
	self deny: (p1 includesClass: b2).
	
	b2 compileSilently: 'secondMethodInB2PackagedInP1 ^ 2'.
	p1 addSelector: #secondMethodInB2PackagedInP1 ofClassName: b2 name.
	
	self assert: p1 extensionSelectors  size = 3.
	self assert: p1 extensionMethods  size = 3.
	self assert: p1 extendedClasses size = 2.
	self assert: (p1 extendedClassNames includes: #B2InPackageP2).
	self deny: (p1 includesClass: b2).! !

!RPackageIncrementalTest methodsFor: 'test class addition removal' stamp: 'CamilloBruni 9/5/2012 14:24'!
testAddClassAfterMethods
	| p1 a1 b1 |
	p1 := self createNewPackageNamed: self p1Name.
	"the class is created but not added to the package for now"
	a1 := self createNewClassNamed: #A1InPackageP1 inCategory: self p1Name.
	self assert: p1 definedClasses size = 0.
	
	"now we add a new method to the class and the to the package: it is considered
	as class extension"
	
	a1 compileSilently: 'newlyAddedToA1 ^ #methodDefinedInP1'.
	p1 addMethod: (a1>>#newlyAddedToA1).
	self assert: (p1 includesSelector: #newlyAddedToA1 ofClass: a1).
	self assert: (p1 includesExtensionSelector: #newlyAddedToA1 ofClass: a1).
	self deny: (p1 includesDefinedSelector: #newlyAddedToA1 ofClass: a1).
	
	"Now we add the class and this means that the method is not an extension anymore but 
	a defined method"
	
	p1 addClassDefinition: a1.
	self assert: p1 definedClasses size = 1.
	
	self deny: (p1 includesExtensionSelector: #newlyAddedToA1 ofClass: a1).
	self assert: (p1 includesDefinedSelector: #newlyAddedToA1 ofClass: a1).
	
	
"
	self assert: (p1 includesSelector: #methodDefinedInP1 ofClass: a1).
	self assert: (p3 includesSelector: #classSideMethodDefinedInP3 ofClass: a2 class)
	"! !

!RPackageIncrementalTest methodsFor: 'test class addition removal' stamp: 'CamilloBruni 9/5/2012 14:31'!
testClassDefinitionWithTagsRemoval
	| p a1 b1|
	
	p := self createNewPackageNamed: self p1Name.
	a1 := self createNewClassNamed: #A1InPAckageP1 inCategory: self p1Name.
	b1 := self createNewClassNamed: #B1InPAckageP1 inCategory: self p1Name.
	self assert: p definedClasses size equals: 0.
	
	p addClassDefinition: a1.
	p addClassDefinition: b1.
	self assert: p definedClasses size equals: 2.
	
	p addClassDefinition: a1 toClassTag: 'a1-tag'. 
	p addClassDefinition: b1 toClassTag: 'b1-tag'.
	self assert: p classTags size equals: 2.
	
	self assert: (p includesClass: a1).
	self assert: (p includesClass: b1).
	
	p removeClassDefinition: a1.
	self assert: p definedClasses size = 1.
	self deny: (p includesClass: a1).
	self assert: (p includesClass: b1).
	
	p removeClassDefinition: b1 class.
	self deny: (p includesClass: b1).
	self assert: p classTags size equals: 0.
! !

!RPackageIncrementalTest methodsFor: 'test class addition removal' stamp: 'CamilloBruni 9/5/2012 14:26'!
testUniqueClassInDefinedClassesUsingAddClassDefinition
	| p a1 |
	p := self createNewPackageNamed: self p1Name.
	a1 := self createNewClassNamed: #A1InPAckageP1 inCategory: self p1Name.
	self assert: p definedClasses size = 0.
	p addClassDefinition: a1.
	self assert: p definedClasses size = 1.
	p addClassDefinition: a1.
	self assert: p definedClasses size = 1.
	p addClassDefinition: a1 class.
	self assert: p definedClasses size = 1.

! !

!RPackageIncrementalTest methodsFor: 'setup' stamp: 'CamilloBruni 9/5/2012 14:28'!
setUp
	super setUp.
	Author fullName ifNil: [Author fullName: 'RPackage'].! !

!RPackageIncrementalTest methodsFor: 'test extension' stamp: 'CamilloBruni 9/5/2012 14:25'!
testIncludeSelectorOfMetaClass
	| p1 p2 p3 a2  a2class |
	p1 := self createNewPackageNamed: 'P1'.
	p2 := self createNewPackageNamed: 'P2'.
	p3 := self createNewPackageNamed: 'P3'.
	a2 := self createNewClassNamed: #A2InPackageP2 inPackage: p2.
	a2class := a2 class.
	a2class compileSilently: 'methodDefinedInP2 ^ #methodDefinedInP2'.
	p2 addMethod: (a2class>>#methodDefinedInP2).
	a2class compileSilently: 'methodDefinedInP1 ^ #methodDefinedInP1'.
	p1 addMethod: (a2class>>#methodDefinedInP1).
	a2class compileSilently: 'methodDefinedInP3 ^ #methodDefinedInP3'.
	p3 addMethod: (a2class>>#methodDefinedInP3).
	
	"includesSelector checks both in defined and extension so we test both"
	self assert: (p2 includesSelector: #methodDefinedInP2 ofClass: a2class).
	self assert: (p2 includesDefinedSelector: #methodDefinedInP2 ofMetaclassName: a2 name).
	self assert: (p2 includesDefinedSelector: #methodDefinedInP2 ofClass: a2class).
	self deny: (p2 includesExtensionSelector: #methodDefinedInP2 ofMetaclassName: a2 name).
	
	self deny: (p2 includesSelector: #methodDefinedInP3 ofClass: a2).
	self assert: (p3 includesExtensionSelector: #methodDefinedInP3 ofMetaclassName: a2 name).
	self deny: (p3 includesDefinedSelector: #methodDefinedInP3 ofMetaclassName: a2 name).
	
	self deny: (p2 includesSelector: #methodDefinedInP1 ofMetaclassName: a2).
	self assert: (p1 includesExtensionSelector: #methodDefinedInP1 ofMetaclassName: a2 name).
	self assert: (p1 includesExtensionSelector: #methodDefinedInP1 ofClass: a2 class).
	self deny: (p3 includesDefinedSelector: #methodDefinedInP1 ofClassName: a2 name).
	self deny: (p3 includesDefinedSelector: #methodDefinedInP1 ofClass: a2).
! !

!RPackageIncrementalTest methodsFor: 'test extension' stamp: 'CamilloBruni 9/5/2012 14:25'!
testExtensionMethods	
	| p1 p2 a2  b2 |
	p1 := self createNewPackageNamed: 'P1'.
	p2 := self createNewPackageNamed: 'P2'.

	a2 := self createNewClassNamed: #A2InPackageP2 inPackage: p2.
	b2 := self createNewClassNamed: #B2InPackageP2 inPackage: p2.
	a2 compileSilently: 'methodDefinedInP1 ^ #methodDefinedInP1'.
	p1 addMethod: (a2>>#methodDefinedInP1).
	
	self assert: p1 extensionSelectors  size = 1.
	self deny: (p1 includesClass: a2).
	"method extension class are not included in packages"
	
	b2 compileSilently: 'firstMethodInB2PackagedInP1 ^ 1'.
	p1 addMethod: (b2>>#firstMethodInB2PackagedInP1).
	self assert: p1 extensionSelectors  size = 2.
	! !

!RPackageIncrementalTest methodsFor: 'test method addition removal' stamp: 'CamilloBruni 9/5/2012 14:24'!
testAddRemoveSelectorOfMetaclass
	| p1 p2 p3 a2   a2Name a2class |
	a2Name := #A2InPackageP2.
	p1 := self createNewPackageNamed: 'P1'.
	p2 := self createNewPackageNamed: 'P2'.
	p3 := self createNewPackageNamed: 'P3'.
	a2 := self createNewClassNamed: a2Name inPackage: p2.
	a2class := a2 class.
	a2class compileSilently: 'methodDefinedInP2 ^ #methodDefinedInP2'.
	p2 addSelector: #methodDefinedInP2 ofMetaclassName: a2Name.
	a2class compileSilently: 'methodDefinedInP1 ^ #methodDefinedInP1'.
	p1 addSelector: #methodDefinedInP1 ofMetaclassName: a2Name.
	a2class compileSilently: 'methodDefinedInP3 ^ #methodDefinedInP3'.
	p3 addSelector: #methodDefinedInP3 ofMetaclassName: a2Name.
	
	self assert: (p2 includesDefinedSelector: #methodDefinedInP2 ofMetaclassName: a2Name).
	self deny: (p2 includesExtensionSelector: #methodDefinedInP2 ofMetaclassName: a2Name).
	self deny: (p3 includesDefinedSelector: #methodDefinedInP3 ofMetaclassName: a2Name).
	self assert: (p3 includesExtensionSelector: #methodDefinedInP3 ofMetaclassName: a2Name).
	self assert: (p1 includesExtensionSelector: #methodDefinedInP1 ofMetaclassName: a2Name).
	self deny: (p3 includesDefinedSelector: #methodDefinedInP1 ofMetaclassName: a2Name).
	
	p2 removeSelector: #methodDefinedInP2 ofMetaclassName:  a2Name.
	self deny: (p2 includesDefinedSelector: #methodDefinedInP2 ofMetaclassName: a2Name).
	self deny: (p2 includesExtensionSelector: #methodDefinedInP2 ofMetaclassName: a2Name).
	
	p1 removeSelector: #methodDefinedInP1 ofMetaclassName:  a2Name.
	self deny: (p1 includesDefinedSelector: #methodDefinedInP3 ofMetaclassName: a2Name).
	self deny: (p1 includesExtensionSelector: #methodDefinedInP3 ofMetaclassName: a2Name).! !

!RPackageIncrementalTest methodsFor: 'test class addition removal' stamp: 'CamilloBruni 9/5/2012 14:25'!
testClassAddition
	| p a1 |
	p := self createNewPackageNamed: self p1Name.
	a1 := self createNewClassNamed: #A1InPAckageP1 inCategory: self p1Name.
	self assert: p definedClasses size = 0.
	p addClassDefinition: a1.
	self assert: p definedClasses size = 1.
	self assert: (p includesClass: a1).
	self assert: (p includesClass: a1 class)
! !

!RPackageIncrementalTest methodsFor: 'test method addition removal' stamp: 'CamilloBruni 9/5/2012 14:25'!
testMethodAddition
	| p1 a1 methodRef |
	p1 := self createNewPackageNamed: 'P1'.
	a1 := self createNewClassNamed: #A1DefinedInP1 inPackage: p1.
	a1 compileSilently: 'foo ^ 10'.
	p1 addMethod:  (a1>>#foo).
	self assert: (p1 includesSelector: #foo ofClass: a1).
	! !

!RPackageIncrementalTest methodsFor: 'test extension' stamp: 'CamilloBruni 9/5/2012 14:25'!
testExtensionClasses
	| p1 p2 a2  b2 |
	p1 := self createNewPackageNamed: 'P1'.
	p2 := self createNewPackageNamed: 'P2'.

	a2 := self createNewClassNamed: #A2InPackageP2 inPackage: p2.
	b2 := self createNewClassNamed: #B2InPackageP2 inPackage: p2.
	self deny: (p1 includesClass: a2).
	self assert: (p2 includesClass: a2).
	
	a2 compileSilently: 'methodPackagedInP1 ^ #methodPackagedInP1'.
	p1 addMethod: (a2>>#methodPackagedInP1).
	
	self assert: p1 extendedClasses size = 1.
	self assert: (p1 extendedClasses  includes: a2).
	self assert: p1 extendedClassNames size = 1.
	self assert: (p1 extendedClassNames  includes: a2 name).
	
	b2 class compileSilently: 'methodPackagedInP1 ^ #methodPackagedInP1'.
	p1 addMethod: (b2 class>>#methodPackagedInP1).
	
	self assert: p1 extendedClasses size = 2.
	self assert: (p1 extendedClasses  includes: b2 class).
	"extensionClasses returns or metaclasses while extensionClassNames returns class names (but not metaclass names)"

	self assert: p1 extendedClassNames size = 2.
	self assert: (p1 extendedClassNames  includes: b2 name).! !

!RPackageIncrementalTest methodsFor: 'test class addition removal' stamp: 'CamilloBruni 9/5/2012 14:26'!
testRemoveClassAfterMethods
	| p1 a1 b1 |
	p1 := self createNewPackageNamed: self p1Name.
	"the class is created but not added to the package for now"
	a1 := self createNewClassNamed: #A1InPackageP1 inCategory: self p1Name.
	p1 addClassDefinition: a1.
	self assert: p1 definedClasses size = 1.
	a1 compileSilently: 'newlyAddedToA1 ^ #methodDefinedInP1'.
	p1 addMethod: (a1>>#newlyAddedToA1).
	
	"now we add a new method to the class and the to the package: it is considered
	as defined"
	self deny: (p1 includesExtensionSelector: #newlyAddedToA1 ofClass: a1).
	self assert: (p1 includesDefinedSelector: #newlyAddedToA1 ofClass: a1).
	
	p1 removeClassDefinition: a1.
	self assert: p1 definedClasses size = 0.
	
	self assert: (p1 includesSelector: #newlyAddedToA1 ofClass: a1).
	self assert: (p1 includesExtensionSelector: #newlyAddedToA1 ofClass: a1).
	self deny: (p1 includesDefinedSelector: #newlyAddedToA1 ofClass: a1).
	
	"Now we add the class and this means that the method is not defined anymore but an extension "
	! !

!RPackageIncrementalTest methodsFor: 'test registration' stamp: 'CamilloBruni 9/5/2012 14:26'!
testPrivateClassRegisterUnregister
	"Verify that when we register a class, the package organizer register it."
	| p a1 b1 |
	p := self createNewPackageNamed: 'P1'.
	a1 := self createNewClassNamed: #A1InPackageP1.
	p definedClassNames add: #A1InPackageP1.
		"ugly but necessary to test registerClass: independantly from addClassDefinition:"
		"No event should be raised."
	p registerClass: a1.
	self assert: (self packageClass organizer packageOf: a1) = p.
	p definedClassNames remove: #A1InPackageP1.
	p unregisterClass: a1.
	self assert: (self packageClass organizer packageOf: a1) isDefault.
	
	p definedClassNames add: #A1InPackageP1.
		"ugly but necessary to test registerClass: independant from addClassDefinition:"
	p registerClassName: a1 name.
	self assert: (self packageClass organizer packageOf: a1) = p.
	p definedClassNames remove: #A1InPackageP1.
	p unregisterClassName: a1 name.
	self assert: (self packageClass organizer packageOf: a1) isDefault
	! !

!RPackageIncrementalTest methodsFor: 'test class addition removal' stamp: 'CamilloBruni 9/5/2012 14:30'!
testClassDefinitionRemoval
	| p a1 b1|
	
	p := self createNewPackageNamed: self p1Name.
	a1 := self createNewClassNamed: #A1InPAckageP1 inCategory: self p1Name.
	b1 := self createNewClassNamed: #B1InPAckageP1 inCategory: self p1Name.
	self assert: p definedClasses size = 0.
	
	p addClassDefinition: a1.
	p addClassDefinition: b1.
	self assert: p definedClasses size = 2.
	
	self assert: (p includesClass: a1).
	self assert: (p includesClass: b1).
	
	p removeClassDefinition: a1.
	self assert: p definedClasses size = 1.
	self deny: (p includesClass: a1).
	self assert: (p includesClass: b1).
	
	p removeClassDefinition: b1 class.
	self deny: (p includesClass: b1).
! !

!RPackageIncrementalTest methodsFor: 'test class addition removal' stamp: 'CamilloBruni 9/5/2012 14:25'!
testClassDefinitionRemovalName
	| p a1 b1|
	p := self createNewPackageNamed: self p1Name.
	a1 := self createNewClassNamed: #A1InPAckageP1 inCategory: self p1Name.
	b1 := self createNewClassNamed: #B1InPAckageP1 inCategory: self p1Name.
	self assert: p definedClasses size = 0.
	p addClassDefinitionName: a1 name.
	p addClassDefinitionName: b1 name.
	self assert: p definedClasses size = 2.
	self assert: (p includesClass: a1).
	self assert: (p includesClass: b1).
	p removeClassDefinitionName: a1 name.
	self assert: p definedClasses size = 1.
	self deny: (p includesClass: a1).
	self assert: (p includesClass: b1).
	self should: [p removeClassDefinitionName: b1 class name] raise: Error.
	p removeClassDefinitionName: b1  name.
	self deny: (p includesClass: b1).
! !

!RPackageMCSynchronisationTest commentStamp: '<historical>'!
I had some problems using the 'ensure:' method. There was some conflicts with the organizer used for the test when trying to clean the classes, categories and packages generated for the test. 
There is something I don't get with this method. Therefore I choosed to clean by default all possible generated classes, categories and packages after each test using the tearDown method.

For now, all that was in the 'ensure:' methods has been commented.
Look for example at:
    testAddMethodInClassicCategoryAddMethodToTheParentPackageOfItsClass
and try to uncomment it!
!RPackageMCSynchronisationTest methodsFor: 'announcer handling' stamp: 'EstebanLorenzano 7/27/2012 17:57'!
initializeAnnouncers
	super initializeAnnouncers.
	
	oldAnnouncer := MCWorkingCopy announcer.
	MCWorkingCopy announcer: announcerForTest.! !

!RPackageMCSynchronisationTest methodsFor: 'tests' stamp: 'GuillermoPolito 5/26/2012 23:09'!
testCategoryMatching
	
	self assert: (self organizer category: 'Compression-Archives' matches: 'Compression').
	self deny: (self organizer category: 'Compression' matches: 'Compression-Archives').
	self assert: (self organizer category: 'Compression' matches: 'Compression').
	self assert: (self organizer category: 'Compression-Arh' matches: 'Compression').
	self deny: (self organizer category: 'XXXX' matches: 'Compression-Archives').! !

!RPackageMCSynchronisationTest methodsFor: 'utilities' stamp: 'GuillermoPolito 9/5/2012 11:18'!
addXMatchCategory
	Smalltalk globals organization addCategory: 'XXXXX-YYYY'.! !

!RPackageMCSynchronisationTest methodsFor: 'utilities' stamp: 'StephaneDucasse 4/29/2011 21:50'!
addXYZCategory

	self addXCategory.
	self addYCategory.
	self addZCategory.
			! !

!RPackageMCSynchronisationTest methodsFor: 'announcer handling' stamp: 'EstebanLorenzano 7/27/2012 17:50'!
restoreAnnouncers
	super restoreAnnouncers.
	MCWorkingCopy announcer: oldAnnouncer.! !

!RPackageMCSynchronisationTest methodsFor: 'setup' stamp: 'EstebanLorenzano 7/27/2012 18:01'!
tearDown
	MCWorkingCopy removeDependent: self emptyOrganizer.
	self cleanClassesPackagesAndCategories.
	super tearDown.! !

!RPackageMCSynchronisationTest methodsFor: 'private' stamp: 'cyrille.delaunay 11/25/2010 13:17'!
createMethodNamed: methodName inClass: aClass inCategory: aCategoryName 

	^ aClass compile: (methodName, ' ^nil') classified: aCategoryName.! !

!RPackageMCSynchronisationTest methodsFor: 'private' stamp: 'StephaneDucasse 7/29/2010 23:46'!
createNewClassNamed: aName
	
	| cls |
	cls := Object subclass: aName
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: 'RPackageTest'.
	^ cls! !

!RPackageMCSynchronisationTest methodsFor: 'utilities' stamp: 'StephaneDucasse 4/29/2011 21:44'!
addZCategory

	Smalltalk globals organization addCategory: 'ZZZZZ'.
			! !

!RPackageMCSynchronisationTest methodsFor: 'to move to a simple RPackage test case' stamp: 'BernardoContreras 10/26/2014 22:35'!
testRepackagedAnnouncementWhenModifyMethodByMovingFromExtensionCategoryToClassicCategory

	| ann class firstPackage secondPackage|
	
	ann := nil.
	SystemAnnouncer uniqueInstance
		when: MethodRepackaged do: [ :a | ann := a ].
	
	self addXYCategory. 
	firstPackage := self organizer  packageNamed: #XXXXX.
	secondPackage := self organizer  packageNamed: #YYYYY.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	self createMethodNamed: 'stubMethod' inClass:  class inCategory: '*yyyyy'.
	
	class organization classify: #stubMethod under: 'classic one'.		

	self assert: ann notNil.
	self assert: ann methodRepackaged selector equals: #stubMethod.
	self assert: ann oldPackage equals: secondPackage.
	self assert: ann newPackage equals: firstPackage.! !

!RPackageMCSynchronisationTest methodsFor: 'utilities' stamp: 'StephaneDucasse 4/29/2011 21:44'!
addXYCategory

	self addXCategory.
	self addYCategory.
			! !

!RPackageMCSynchronisationTest methodsFor: 'private' stamp: 'cyrille.delaunay 11/22/2010 10:56'!
createNewClassNamed: aName inCategory: aCategoryName
	
	| cls |
	cls := Object subclass: aName asSymbol
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: aCategoryName.
	^ cls! !

!RPackageMCSynchronisationTest methodsFor: 'setup' stamp: 'EstebanLorenzano 7/27/2012 20:24'!
setUp 
	super setUp.
	
	emptyOrganizer := self organizer debuggingName: 'MCSynchronisation Package Organizer'; yourself.
	emptyOrganizer registerPackage: (self packageClass named: 'as yet unclassified').

	Author fullName 
		ifNil: [ Author fullName: 'Tester' ].! !

!RPackageMCSynchronisationTest methodsFor: 'to move to a simple RPackage test case' stamp: 'BernardoContreras 10/26/2014 22:33'!
testRepackagedAnnouncementWhenModifyMethodByMovingFromClassicCategoryToExtensionCategory
	
	| ann class firstPackage secondPackage|
	
	ann := nil.
	SystemAnnouncer uniqueInstance
		when: MethodRepackaged do: [ :a | ann := a ].
	
	self addXYCategory. 
	firstPackage := self organizer  packageNamed: #XXXXX.
	secondPackage := self organizer  packageNamed: #YYYYY.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	self createMethodNamed: 'stubMethod' inClass:  class inCategory: 'classic category'.
	
	class organization classify: #stubMethod under: '*yyyyy'.		

	self assert: ann notNil.
	self assert: ann methodRepackaged selector equals: #stubMethod.
	self assert: ann oldPackage equals: firstPackage.
	self assert: ann newPackage equals: secondPackage.
	ann := nil.

	class organization classify: #stubMethod under: '*yyyyy-suncategory'.

	self assert: ann isNil.! !

!RPackageMCSynchronisationTest methodsFor: 'utilities' stamp: 'GuillermoPolito 5/29/2012 12:31'!
addXCategory
	Smalltalk globals organization addCategory: 'XXXXX'.! !

!RPackageMCSynchronisationTest methodsFor: 'utilities' stamp: 'StephaneDucasse 4/24/2011 23:26'!
addYCategory

	Smalltalk globals organization addCategory: 'YYYYY'.
			! !

!RPackageMCSynchronisationTest methodsFor: 'private' stamp: 'cyrille.delaunay 11/26/2010 15:31'!
createNewTraitNamed: aName inCategory: aCategoryName
	
	| trait |
	trait := Trait named: aName asSymbol
			uses: {}
			category: aCategoryName.
	^ trait! !

!RPackageMCSynchronisationTest methodsFor: 'tests' stamp: 'GuillermoPolito 5/26/2012 23:50'!
testisDefinedAsPackageOrSubPackageInMC
	"test whether a given category is defined as a MC package or whether it is defined as top part of package"
	
	"self debug: #testisDefinedAsSubPackageInMC"
	"self debug: #testisDefinedAsPackageOrSubPackageInMC"
	
	self assert: (self organizer isDefinedAsPackageOrSubPackageInMC: #'Compression').
	self deny: (self organizer isDefinedAsPackageOrSubPackageInMC: #'Compression-Archives').
	"Indeed compression-archives is a category but not a MC package"
	
	self assert: (self organizer isDefinedAsPackageOrSubPackageInMC: #'Collections').
	"#Collection is not defined as a package but as a package #'Collections-Unordered'"
	self assert: (self organizer isDefinedAsPackageOrSubPackageInMC: #'Collections-Unordered').
	self deny: (self organizer isDefinedAsPackageOrSubPackageInMC: #'Collections-Unordered-Test').! !

!RPackageMCSynchronisationTest methodsFor: 'setup' stamp: 'GuillermoPolito 9/5/2012 11:20'!
cleanClassesPackagesAndCategories

		|mCPackage|
		Smalltalk removeClassNamed: 'NewClass'.
		Smalltalk removeClassNamed: 'RPackageNewStubClass'.
		Smalltalk removeClassNamed: 'RPackageOldStubClass'.
		Smalltalk removeClassNamed: 'Foo'.
		Smalltalk removeClassNamed: 'FooOther'.
		Smalltalk removeClassNamed: 'NewTrait'.
		Smalltalk removeClassNamed: 'ClassInYPackage'.
		Smalltalk removeClassNamed: 'ClassInZPackage'.
		Smalltalk organization removeCategory: 'Zork'.
		Smalltalk organization removeCategory: 'XXXXX'.
		Smalltalk organization removeCategory: 'XXXXX-YYYY'.
		Smalltalk organization removeCategory: 'XXXX'.
		Smalltalk organization removeCategory: 'YYYYY'.
		Smalltalk organization removeCategory: 'ZZZZZ'.
		Smalltalk organization removeCategory: 'FooPackage-Core'.
		Smalltalk organization removeCategory: 'FooPackage-Other'.
		Smalltalk organization removeCategory: 'FooPackage'.
		Smalltalk organization removeCategory: 'OriginalCategory'.
		Smalltalk organization removeCategory: 'NewCategoryName'.
		Smalltalk organization removeCategory: 'Y'.
		mCPackage := (self allManagers detect: [:each | each packageName = 'OriginalCategory'] ifNone: [nil]) .
		mCPackage ifNotNil: [mCPackage unregister].
		mCPackage := (self allManagers detect: [:each | each packageName = 'XXXXX'] ifNone: [nil]) .
		mCPackage ifNotNil: [mCPackage unregister].
		mCPackage := (self allManagers detect: [:each | each packageName = 'XXXX'] ifNone: [nil]) .
		mCPackage ifNotNil: [mCPackage unregister].
		mCPackage := (self allManagers detect: [:each | each packageName = 'YYYYY'] ifNone: [nil]) .
		mCPackage ifNotNil: [mCPackage unregister].
		mCPackage := (self allManagers detect: [:each | each packageName = 'YYYY'] ifNone: [nil]) .
		mCPackage ifNotNil: [mCPackage unregister].
		mCPackage := (self allManagers detect: [:each | each packageName = 'Yyyyy'] ifNone: [nil]) .
		mCPackage ifNotNil: [mCPackage unregister].	
		mCPackage := (self allManagers detect: [:each | each packageName = 'YyYyY'] ifNone: [nil]) .
		mCPackage ifNotNil: [mCPackage unregister].
		mCPackage := (self allManagers detect: [:each | each packageName = 'Y'] ifNone: [nil]) .
		mCPackage ifNotNil: [mCPackage unregister].
		mCPackage := (self allManagers detect: [:each | each packageName = 'ZZZZZ'] ifNone: [nil]) .
		mCPackage ifNotNil: [mCPackage unregister].	
		mCPackage := (self allManagers detect: [:each | each packageName = 'Zzzzz'] ifNone: [nil]) .
		mCPackage ifNotNil: [mCPackage unregister].
		mCPackage := (self allManagers detect: [:each | each packageName = 'FooPackage-Core'] ifNone: [nil]) .
		mCPackage ifNotNil: [mCPackage unregister].
		mCPackage := (self allManagers detect: [:each | each packageName = 'FooPackage-Other'] ifNone: [nil]) .
		mCPackage ifNotNil: [mCPackage unregister].
		mCPackage := (self allManagers detect: [:each | each packageName = 'FooPackage'] ifNone: [nil]) .
		mCPackage ifNotNil: [mCPackage unregister].
		mCPackage := (self allManagers detect: [:each | each packageName = 'Zork'] ifNone: [nil]) .
		mCPackage ifNotNil: [mCPackage unregister].
			! !

!RPackageMCSynchronisationTest methodsFor: 'private' stamp: 'cyrille.delaunay 11/25/2010 13:17'!
createMethodNamed: methodName inClassSideOfClass: aClass inCategory: aCategoryName 

	^ aClass classSide compile: (methodName, ' ^nil') classified: aCategoryName.! !

!RPackageMCSynchronisationTest methodsFor: 'to move to a simple RPackage test case' stamp: 'BernardoContreras 10/26/2014 22:33'!
testNotRepackagedAnnouncementWhenMovingClassicCategories

	| ann class firstPackage secondPackage|
	
	ann := nil.
	SystemAnnouncer uniqueInstance
		when: MethodRepackaged do: [ :a | ann := a ].
	
	self addXYCategory. 
	firstPackage := self organizer  packageNamed: #XXXXX.
	secondPackage := self organizer  packageNamed: #YYYYY.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.

	self createMethodNamed: 'stubMethod' inClass:  class inCategory: 'classic'.
	
	self assert: ann isNil.

	class organization classify: #stubMethod under: 'another classic one'.

	self assert: ann isNil.! !

!RPackageMCSynchronisationTest methodsFor: 'to move to a simple RPackage test case' stamp: 'BernardoContreras 10/26/2014 22:35'!
testRepackagedAnnouncementWhenModifyMethodByMovingFromDifferentExtensionCategories

	| ann class firstPackage secondPackage thirdPackage |
	
	ann := nil.
	SystemAnnouncer uniqueInstance
		when: MethodRepackaged do: [ :a | ann := a ].
	
	self addXYZCategory. 
	firstPackage := self organizer  packageNamed: #XXXXX.
	secondPackage := self organizer packageNamed: #YYYYY.
	thirdPackage := self organizer packageNamed: #ZZZZZ.
	
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	self createMethodNamed: 'stubMethod' inClass:  class inCategory: '*yyyyy'.
	
	class organization classify: #stubMethod under: '*zzzzz'.

	self assert: ann notNil.
	self assert: ann methodRepackaged selector equals: #stubMethod.
	self assert: ann oldPackage equals: secondPackage.
	self assert: ann newPackage equals: thirdPackage.! !

!RPackageMCSynchronisationTest methodsFor: 'accessing' stamp: 'RPackage 1/20/2011 13:17'!
emptyOrganizer 

	^ emptyOrganizer! !

!RPackageMCSynchronisationTest methodsFor: 'to move to a simple RPackage test case' stamp: 'BernardoContreras 10/26/2014 22:34'!
testNotRepackagedAnnouncementWhenModifyMethodByMovingInSameExtensionCategory
	
	| ann class firstPackage secondPackage|
	
	ann := nil.
	SystemAnnouncer uniqueInstance
		when: MethodRepackaged do: [ :a | ann := a ].
	
	self addXYCategory. 
	firstPackage := self organizer  packageNamed: #XXXXX.
	secondPackage := self organizer  packageNamed: #YYYYY.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.

	self createMethodNamed: 'stubMethod' inClass:  class inCategory: '*yyyyy'.
	
	self assert: ann isNil.

	class organization classify: #stubMethod under: '*yyyyy-suncategory'.

	self assert: ann isNil.! !

!RPackageMethodsSynchronisationTest commentStamp: 'TorstenBergmann 2/12/2014 23:00'!
SUnit tests for RPackage method synchronization!
!RPackageMethodsSynchronisationTest methodsFor: 'tests - operations on methods' stamp: 'GuillermoPolito 9/5/2012 15:00'!
testModifyMethodByMovingFromClassicCategoryToExtensionCategoryMoveItFromClassPackageToExtendingPackage
	"test that when we move a method from a classic category (not begining with *) to an extension category , the method is moved from the parent package of the class to the extending package"
	
	| class firstPackage secondPackage|
	self addXYCategory. 
	firstPackage := self organizer  packageNamed: #XXXXX.
	secondPackage := self organizer  packageNamed: #YYYYY.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	self createMethodNamed: 'stubMethod' inClass:  class inCategory: 'classic category'.

	class organization classify: #stubMethod under: '*yyyyy'.	
	self deny: (firstPackage includesDefinedSelector: #stubMethod ofClass: class).
	self assert: (secondPackage includesExtensionSelector: #stubMethod ofClass: class).
	self assert: ((class >> #stubMethod) packageFromOrganizer: self organizer ) = secondPackage.
	
	class organization classify: #stubMethod under: '*yyyyy-subcategory'.
	self deny: (firstPackage includesDefinedSelector: #stubMethod ofClass: class).
	self assert: (secondPackage includesExtensionSelector: #stubMethod ofClass: class).
	self assert: ((class >> #stubMethod) packageFromOrganizer: self organizer ) = secondPackage.! !

!RPackageMethodsSynchronisationTest methodsFor: 'tests - operations on methods' stamp: 'GuillermoPolito 9/5/2012 15:00'!
testModifyMethodByMovingFromExtensionCategoryToExtensionCategoryMoveItFromExtendingPackageToSecondExtendingPackage
	"test that when we move a method from an extension category ( begining with *) to another extending package , the method is moved from the extending package to the other extending package"
	
	| class XPackage YPackage ZPackage|
	self addXYZCategory.
	XPackage := self organizer  packageNamed: #XXXXX.
	YPackage := self organizer  packageNamed: #YYYYY.
	ZPackage := self organizer  packageNamed: #ZZZZZ.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	self createMethodNamed: #newMethod inClass:  class inCategory: '*yyyyy'.

	class organization classify: #newMethod under: '*zzzzz'.
	self deny: (XPackage includesDefinedSelector: #newMethod ofClass: class).
	self deny: (YPackage includesExtensionSelector: #newMethod ofClass: class).
	self assert: (ZPackage includesExtensionSelector: #newMethod ofClass: class).
	self assert: ((class >> #newMethod) packageFromOrganizer: self organizer ) = ZPackage.! !

!RPackageMethodsSynchronisationTest methodsFor: 'tests - operations on methods' stamp: 'GuillermoPolito 9/5/2012 15:00'!
testModifyMethodByMovingFromClassicCategoryToClassicCategoryDoesNothing
	"test that when we move a method from a classic category (not begining with *) to another classic category , the packaging keeps the same"
	
	| class firstPackage secondPackage|
	self addXCategory.
	firstPackage := self organizer packageNamed: #XXXXX.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	self createMethodNamed: 'stubMethod' inClass:  class inCategory: 'classic category'.

	"this we do"
	class organization classify: #stubMethod under: 'new category'.

	"this we check"
	self assert: (class >> #stubMethod) category = 'new category'. 
	self assert: (firstPackage includesDefinedSelector: #stubMethod ofClass: class).
	self deny: (firstPackage includesExtensionSelector: #stubMethod ofClass: class).
	self assert: ((class >> #stubMethod) packageFromOrganizer: self organizer ) = firstPackage! !

!RPackageMethodsSynchronisationTest methodsFor: 'tests - operations on methods' stamp: 'GuillermoPolito 9/5/2012 14:27'!
testRemoveMethodRemoveMethodFromItsPackage
	"test that when we remove a method, the method is remod from the package in which the method is defined"
	
	|XPackage  class|
	self addXCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	self createMethodNamed: 'stubMethod' inClass: class  inCategory: 'classic category'. 
	
	class removeSelector: #stubMethod.
	
	self deny: (XPackage includesDefinedSelector: #stubMethod ofClass: class). 
	self deny: (XPackage includesExtensionSelector: #stubMethod ofClass: class). 
	self deny: (XPackage includesSelector: #stubMethod ofClass: class).! !

!RPackageMethodsSynchronisationTest methodsFor: 'tests - operations on methods' stamp: 'GuillermoPolito 9/5/2012 15:04'!
testAddMethodInClassicCategoryAddMethodToTheParentPackageOfItsClass
	"test that when we add a method to a  class in a classic category (not beginning with *), this method is added to the parent package of the class"
	
	|tmpPackage class|
	self addXCategory.
	
	tmpPackage := self organizer packageNamed: #XXXXX.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.

	self createMethodNamed: 'stubMethod' inClass:  class inCategory: 'classic category'.

	self assert: (class package includesDefinedSelector: #stubMethod ofClass: class).
	self assert: ((class >> #stubMethod) packageFromOrganizer: self organizer ) equals: class package.! !

!RPackageMethodsSynchronisationTest methodsFor: 'tests - operations on methods' stamp: 'GuillermoPolito 9/5/2012 12:47'!
testAddMethodInClassicCategoryAddMethodToTheParentPackageOfItsTrait
	"test that when we add a method to a  trait in a classic category (*not beginning with *), this method is added to the parent package of the class"
	
	|tmpPackage trait|
	self addXCategory.

	tmpPackage := self organizer packageNamed: #XXXXX.
	trait := self createNewTraitNamed: 'NewClass' inCategory: 'XXXXX'.

	self createMethodNamed: 'stubMethod' inClass:  trait inCategory: 'classic category'.

	self assert: (trait package includesDefinedSelector: #stubMethod ofClass: trait).
	self assert: ((trait >> #stubMethod) packageFromOrganizer: self organizer ) = trait package! !

!RPackageMethodsSynchronisationTest methodsFor: 'tests - operations on methods' stamp: 'GuillermoPolito 9/5/2012 15:00'!
testModifyMethodByMovingFromExtensionCategoryToClassicCategoryMoveItFromExtendingPackageToClassPackage

	"test that when we move a method from an extension category ( begining with *) to a classic category , the method is moved from the extending package to the parent package of the class"
	
	| class firstPackage secondPackage|
	self addXYCategory.
	
	firstPackage := self organizer  packageNamed: #XXXXX.
	secondPackage := self organizer  packageNamed: #YYYYY.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	self createMethodNamed: 'stubMethod' inClass:  class inCategory: '*yyyyy'.

	class organization classify: #stubMethod under: 'classic category'.
	self assert: (firstPackage includesDefinedSelector: #stubMethod ofClass: class).
	self deny: (secondPackage includesExtensionSelector: #stubMethod ofClass: class).
	self assert: ((class >> #stubMethod) packageFromOrganizer: self organizer ) = firstPackage.! !

!RPackageMonticelloSynchronisationTest commentStamp: 'TorstenBergmann 2/12/2014 23:00'!
SUnit tests for RPackage Monticello synchronization!
!RPackageMonticelloSynchronisationTest methodsFor: 'tests - operations on MCPackages' stamp: 'EstebanLorenzano 9/24/2012 16:02'!
testUnloadMCPackageRemovesRPackage
	"test that when we remove a MC Package, the corresponding RPackage is removed from the organizer"
	|XPackage class|

	MCWorkingCopy forPackage: (MCPackage new name: 'XXXXX').
	(self allManagers detect: [:each | each packageName = 'XXXXX']) unload.

	self flag: #fixme."See comment in RPackageOrganizer>>update:"
	self deny: (self organizer includesPackageNamed: #XXXXX).! !

!RPackageMonticelloSynchronisationTest methodsFor: 'tests - operations on MCPackages' stamp: 'GuillermoPolito 9/5/2012 11:34'!
testAddMCPackageCreatesAPackage
	"test that when we create a MCPackage, a corresponding package is created"
	
	MCWorkingCopy forPackage: (MCPackage new name: #Zork).
	self assert: (self organizer includesPackageNamed: #Zork).
		
					  ! !

!RPackageMonticelloSynchronisationTest methodsFor: 'tests - operations on MCPackages' stamp: 'GuillermoPolito 9/5/2012 13:12'!
testUnregisterMCPackageKeepsRPackage
	"test that when we remove a MC Package, the corresponding RPackage is removed from the organizer"
	
	|XPackage class|
	MCWorkingCopy forPackage: (MCPackage new name: 'XXXXX').
	(self allManagers detect: [:each | each packageName = 'XXXXX']) unregister.
	
	self assert: (self organizer includesPackageNamed: #XXXXX).! !

!RPackageMonticelloSynchronisationTest methodsFor: 'tests - operations on MCPackages' stamp: 'GuillermoPolito 9/5/2012 11:34'!
testAddMCPackageForCategoryAlreadyExistingDoesNotCreateAPackage
	"test that when we create a MCPackage and that a category of this name already exists, no package is created"
	"self debug: #testAddMCPackageForCategoryAlreadyExistingDoesNotCreateAPackage"
	"self run: #testAddMCPackageForCategoryAlreadyExistingDoesNotCreateAPackage"	
	
	|tmpPackage|
	Smalltalk globals organization addCategory: 'Zork'.
	tmpPackage := self organizer packageNamed: #Zork.
	MCWorkingCopy forPackage: (MCPackage new name: #Zork).
	self assert: tmpPackage = (self organizer packageNamed: #Zork).
		
		
					  ! !

!RPackageObsoleteTest commentStamp: 'TorstenBergmann 2/12/2014 22:59'!
SUnit tests for RPackage!
!RPackageObsoleteTest methodsFor: 'tests' stamp: 'GuillermoPolito 5/29/2012 13:25'!
testMethodPackageOfRemovedClass
	"self debug: #testMethodPackageOfRemovedClass"
	
	| pack method foo | 
	pack := self createNewPackageNamed: 'P1'.
	foo := self createNewClassNamed: #FooForTest2 inPackage: pack.
	foo compileSilently: 'bar ^42'.
	method := foo>>#bar.
	foo removeFromSystem.
	self deny: (pack includesClassNamed: #FooForTest2 )
	
	! !

!RPackageObsoleteTest methodsFor: 'tests' stamp: 'EstebanLorenzano 7/27/2012 19:40'!
testMethodPackageFromObsoleteClass
	"self debug: #testMethodPackageFromObsoleteClass"
	
	| pack method foo | 
	[
	pack := self createNewPackageNamed: 'P1'.
	foo := self createNewClassNamed: #FooForTest inPackage: pack.
	foo compile: 'bar ^42'.
	method := foo>>#bar.

	foo obsolete.
	self assert: (method packageFromOrganizer: pack organizer) equals: foo package.
	] ensure: [ 
		foo ifNotNil: [ 
			foo setName: foo originalName.
			foo removeFromSystem.
			].
		Smalltalk globals removeKey: #FooForTest  ifAbsent:  [].
	]! !

!RPackageObsoleteTest methodsFor: 'tests' stamp: 'BernardoContreras 10/26/2014 22:32'!
testAnnouncementClassRemovedIsRaisedOnRemoveFromSystem
	"self debug: #testAnnouncementClassRemovedIsRaisedOnRemoveFromSystem"
	| foo | 
	
	[ notRun := false.
	  SystemAnnouncer uniqueInstance 
		when: ClassRemoved send: #setNotRun to: self.
	foo := self createNewClassNamed: #FooForTest2.
	self deny: notRun.
	foo removeFromSystem.
	self assert: notRun ]
ensure: [ SystemAnnouncer uniqueInstance unsubscribe: self ]. ! !

!RPackageObsoleteTest methodsFor: 'accessing' stamp: 'EstebanLorenzano 9/19/2013 16:59'!
setNotRun 
	notRun := true! !

!RPackageOrganizer commentStamp: '<historical>'!
A RPackageOrganizer is responsible for providing all the package currently defined in the system.
In addition it provides a back pointer from the class to its package.

The classPackageMapping and the classExtendingPackageMapping should be moved in the future to the classes themselves. 


For tests or actions that could destroy the package organizer,  do not access directly the singleton of RPackageOrganizer.
Use instead 
		RPackage withOrganizer: aNewOrganizer do: ablock
			or via RPackage organizer
		
	
RPackageOrganizer fillUp will fill up the system from the current PackageOrganizer
	"self fillUp"
	
-----------------------------------------------------------------------------------------------------------------------------------------------	
	
	
A rpackageOrganizer update itself when some changes are made in the system. It does that by registering to a systemAnnoucer, specifying an action when an annoucement is triggered.
Here is what I (Cyrille Delaunay) propose to do for each annocuement triggered:

SystemCategoryAddedAnnouncement 	
	=> I would just register a new RPackage (if it does not already exist) in the RPackageOrganizer
	
SystemCategoryRemovedAnnouncement 
     => I would just unregister the RPackage concerned from the organizer

SystemCategoryRenamedAnnouncement
     => I would update the RPackage concerned, by changing its name
     => I would update the 'packages' dictionary of the organizer, putting the new name as key

SystemClassAddedAnnouncement 
    => Import the class in the RPackage concerned (RPackage >> importClass:)
    => Register the class in the 'classPackageMapping' dictionary of the organizer (RPackageOrganizer >> registerPackage:forClass)
    (=> maybe we should pay attention if both the class and the metaclass launch this kind of event ?)

SystemClassRecategorizedAnnouncement
    => I would update the old RPackage concerned:
            => unregister the class
            => unregister all defined methods of the class
    => I would update the new RPackage:
            => Import the class in the RPackage (importClass:)
    => I would update the organizer:
            => update the 'classPackageDictionary' to point on the new RPackage

 
SystemClassRemovedAnnouncement
    => I would update the RPackake concerned
             => unregister the class
             => unregister all defined methods of the class
    => I would update the organizer:
             => update the 'classPackageDictionary' to remove the class

SystemClassRenamedAnnouncement
    => I would update the RPackage in which the class is defined:
             => update the 'classDefinedSelectors' dictionary (replace the old key by the new one)
             => update the 'metaclassDefinedSelectors' dictionary (replace the old key by the new one)
    => I would update all RPackages extending this class
             => update the 'classExtensionsSelectors' dictionary (replace the old key by the new one)
             => update the 'metaclassclassExtensionsSelectors' dictionary (replace the old key by the new one)
    => I would update the organizer
             => update the 'classPackageDictionary' to replace the key with the new class name
             => update the 'classExtendingPackagesMapping' to replace the key with the new class name
                          
SystemClassReorganizedAnnouncement 
    (=> I guess we should check if extensions have not been added or removed ? 
      (to retrieve this information, the only thing I found is ClassDescription >> organization, and then check each category begining with '*' and compare with the organizer. seems to be painful, no?))
	=> when an extension is removed, all methods inside are removed. Therefore, the MethodRemovedAnnounecement will do the job. Not sur this one still usefull

SystemProtocolAddedAnnouncement
    => I don't see anything to do for this annoucement

SystemProtocolRemovedAnnoucement
    => If the category is an extension from a package, I would move all the methods concerned, from the extending RPackage to the class RPackage

SystemMethodAddedAnnouncement
       => I would check the category in which the method has been defined
               => if it correspond to an extending package -> add the method to the extending RPackage
               => if not, add the method to the class parentPackage

SystemMethodModifiedAnnouncement
       this annoucement can correspond to several kind of modifications:
	       *  a method has been renamed
                       => I would update the rPackage in which the method is defined to replace the old selector by the new one
		* a method has been move to another category 
			-maybe from a classic category to an extending package
                             => we should move the method from the  method class parentPackage to extendingPackage package
			-maybe from an extending package to another extending package
                             => we should move the method from the  extendingPackage package to the other extendingPackage package
			-maybe from an extending package to a classic category
                             =>  we should move the method from the  extendingPackage to the method class parentPackage
		        -maybe from a classic category to another classic category
                             => we have nothing to do
			

SystemMethodRecategorizedAnnouncement
          same thing than above

SystemMethodRemovedAnnouncement
       => I would simply remove the method from the RPackage in which it is register!
!RPackageOrganizer methodsFor: '*Monticello-RPackage' stamp: 'EstebanLorenzano 2/18/2014 15:06'!
initializeFromMC
 	RPackage 
		withOrganizer: self  
		do:  [  self basicInitializeFromMC ].
! !

!RPackageOrganizer methodsFor: '*RPackage-SystemIntegration' stamp: 'ThierryGoubier 10/25/2013 13:45'!
systemClassRenamedActionFrom: ann
	"When a class is renamed, we update its package as well as the organizer"
	
	| newName oldName class rPackage extendingRPackages packageName |
	class := ann classAffected.
	packageName := ann category.
	oldName := ann oldName.
	newName := ann newName.
	rPackage := self packageOfClassNamed: oldName.
	extendingRPackages := self extendingPackagesOfClassNamed: oldName.
	
	rPackage updateDefinedClassNamed: oldName withNewName: newName.
	"we have to update all RPackages extending this class"
	extendingRPackages do: [:aRPackage | 
		aRPackage updateExtensionForClassNamed: oldName withNewName: newName].
		
	"we have to update the RPackageOrganizer.
	update the 'classPackageDictionary' to replace the key with the new class name"
	self unregisterPackage: rPackage forClassName: oldName.
	self registerPackage: rPackage forClassName: newName.	
		
	"update the 'classExtendingPackagesMapping' to replace the key with the new class name"
	extendingRPackages do: [:aRPackage |
		self unregisterExtendingPackage: aRPackage forClassName: oldName.
		self registerExtendingPackage:  aRPackage forClassName: newName   
		].
	self flag: #cyrille. "we will see that."
	"maybe we should remove also the key from the extendedPackages dictionary"
	"CD: This is what are doing the lines above I think"

	! !

!RPackageOrganizer methodsFor: 'private registration' stamp: 'EstebanLorenzano 2/22/2014 11:28'!
unregisterExtendingPackage: aPackage forClass: aClass
	| extendingPackageForClass |
	
	extendingPackageForClass := classExtendingPackagesMapping 
		at: aClass theNonMetaClass name 
		ifAbsent: [ nil ].
	extendingPackageForClass ifNotNil: [ 
		extendingPackageForClass 
			remove: aPackage 
			ifAbsent: [] "not happy with this one" ]! !

!RPackageOrganizer methodsFor: 'private registration' stamp: 'SeanDeNigris 6/11/2013 15:02'!
checkPackageExistsOrRegister: packageName
	(self packages 
		anySatisfy: [ :each | self category: packageName matches: each packageName ])
		ifFalse: [ (RPackage named: packageName capitalized) register ] ! !

!RPackageOrganizer methodsFor: 'accessing' stamp: 'stephane.ducasse 7/16/2009 23:17'!
packageNames
	^ packages keys! !

!RPackageOrganizer methodsFor: '*Monticello-RPackage' stamp: 'StephaneDucasse 6/2/2012 19:39'!
allManagers

	^ self class allManagers ! !

!RPackageOrganizer methodsFor: 'accessing' stamp: 'SebastianTleye 4/24/2013 10:05'!
packagesWithoutExtensions
	
	^self packages.! !

!RPackageOrganizer methodsFor: 'private testing' stamp: 'StephaneDucasse 4/24/2011 17:32'!
debuggingName: aString

	debuggingName := aString! !

!RPackageOrganizer methodsFor: '*RPackage-SystemIntegration' stamp: 'EstebanLorenzano 10/16/2013 17:11'!
fullyRemoveClassNamed: className
	"Remove the class, the class backpointer, the extensions and the extension backPointer from the receiver and the class involved with the class named: className. className is a class name and should not be a metaclass one. "	
	| rPackage |	
		
	rPackage := self packageOfClassNamed: className.
	rPackage ifNil: [ ^ self ].
	rPackage removeClassNamed: className.
	(self extendingPackagesOfClassNamed: className)
		do: [:each | each removeAllMethodsFromClassNamed: className. ].

	
	! !

!RPackageOrganizer methodsFor: '*Monticello-RPackage' stamp: 'EstebanLorenzano 10/16/2013 12:48'!
initializeFromMCMethodsFor: aBehavior
	| package |
	
	package := aBehavior package.  
	(aBehavior organization protocols
		select: [ :each | each isExtensionProtocol not ])
		do: [ :eachProtocol | 
			 (eachProtocol methods 
				select: [ :eachSelector | (aBehavior >> eachSelector) origin = aBehavior ])
				do: [ :eachSelector | package addMethod: (aBehavior >> eachSelector) ] ]! !

!RPackageOrganizer methodsFor: 'private registration' stamp: 'EstebanLorenzano 10/30/2012 14:36'!
ensureExistAndRegisterPackageNamed: aSymbol
	"A new package is now available and declared in the receiver."
	
	| package |
	
	package := packages 
		at: aSymbol asSymbol 
		ifAbsentPut: [ self packageClass named: aSymbol ].
		
	package extendedClasses do: [ :extendedClass|
			self registerExtendingPackage: package forClass: extendedClass].
	package definedClasses do: [ :definedClass|
			self registerPackage: package forClass: definedClass].
	
	self announcer announce: (RPackageCreated to: package).
	
	^ package! !

!RPackageOrganizer methodsFor: '*RPackage-SystemIntegration' stamp: 'StephaneDucasse 4/13/2011 21:16'!
systemTraitDefinitionModifiedActionFrom: ann
	"this kind of anounecement will be used when:
		=> we create a new trait.
		=> we declare new traits to use in a trait"
	|trait|
	trait := ann itemTrait.
	! !

!RPackageOrganizer methodsFor: '*RPackage-SystemIntegration' stamp: 'GuillermoPolito 7/31/2012 11:59'!
registerInterestToSystemAnnouncement
	"self registerInterestToSystemAnnouncement"
	<systemEventRegistration>
	
	self registerInterestToAnnouncer: self announcer! !

!RPackageOrganizer methodsFor: '*RPackage-SystemIntegration' stamp: 'EstebanLorenzano 10/15/2013 18:23'!
systemCategoryAddedActionFrom: ann
	| package |
	
	package := self packageMatchingExtensionName: ann categoryName asString.
	package ifNil: [ 
		package := self registerPackage: (self packageClass named: ann categoryName asSymbol) ].
	package addClassTag: ann categoryName asSymbol.! !

!RPackageOrganizer methodsFor: 'initialization' stamp: 'CamilloBruni 8/29/2012 23:08'!
initialize
	super initialize.
	
	packages := IdentityDictionary new.
	classPackageMapping := IdentityDictionary new.
	classExtendingPackagesMapping := IdentityDictionary new.
	debuggingName := ''.
	
	self defineUnpackagedClassesPackage! !

!RPackageOrganizer methodsFor: 'private' stamp: 'EstebanLorenzano 2/7/2014 14:37'!
validateCanBeAddedPackage: aPackage 	
	self 
		validateCanBeAddedPackageName: aPackage categoryName 
		tagName: nil! !

!RPackageOrganizer methodsFor: 'package access from class' stamp: 'sd 5/21/2010 14:56'!
extendingPackagesOf: aClass
	"Returns the packages extending the class aClass"
	^ classExtendingPackagesMapping at: aClass theNonMetaClass name ifAbsent: [#()]! !

!RPackageOrganizer methodsFor: 'accessing' stamp: 'EstebanLorenzano 1/8/2014 14:32'!
packageNamed: aSymbol
	^ self 
		packageNamed: aSymbol 
		ifAbsent: [ KeyNotFound signalFor: aSymbol ]! !

!RPackageOrganizer methodsFor: 'testing' stamp: 'StephaneDucasse 4/13/2011 20:14'!
includesPackage: aPackage
	"Answer whether the receiver get a package as registered."
	^ self includesPackageNamed: aPackage name! !

!RPackageOrganizer methodsFor: 'private' stamp: 'CamilloBruni 8/29/2012 23:17'!
reportExtraRemovalOf: aClass

	self logCr:  'The class ',  aClass name printString, 'is removed twice'.! !

!RPackageOrganizer methodsFor: 'public registration' stamp: 'EstebanLorenzano 2/21/2014 10:44'!
registerPackage: aPackage
	"A new package is now available and declared in the receiver. "
	
	self validateCanBeAddedPackage: aPackage.
	
	self basicRegisterPackage: aPackage.
	aPackage extendedClasses 
		do: [ :extendedClass | self registerExtendingPackage: aPackage forClass: extendedClass].
	aPackage definedClasses 
		do: [ :definedClass | self registerPackage: aPackage forClass: definedClass].
		
	self announcer announce: (RPackageCreated to: aPackage).
	
	^ aPackage! !

!RPackageOrganizer methodsFor: 'private registration' stamp: 'CamilloBruni 9/23/2013 20:24'!
basicUnregisterPackageNamed: aSymbolName
	"Unregister the specified package from the list of registered packages. Raise the RPackageUnregistered announcement. This is a low level action. It does not unregister the back pointer from classes to packages or any other information managed by the organizer"
	
	packages
		removeKey: aSymbolName asSymbol
		ifAbsent: [ ]
	! !

!RPackageOrganizer methodsFor: '*RPackage-SystemIntegration' stamp: 'EstebanLorenzano 10/16/2013 15:33'!
renamePackage: rPackage from: oldName to: newName 
	| classesAndProtocolsToRename |
	
	rPackage name: newName. 
	
	"we update the organizer"
	packages 
		at: newName 
		put: rPackage.
	packages 
		removeKey: oldName 
		ifAbsent: [ self reportBogusBehaviorOf:   #systemCategoryRenamedActionFrom: ]. 
	
	"we also rename all the extension protocols in the system with the new name"
	classesAndProtocolsToRename := rPackage extensionMethods asIdentitySet.
	classesAndProtocolsToRename 
		do: [:method | 
			method methodClass organization 
				silentlyRenameCategory: method category 
				toBe: '*', newName ]! !

!RPackageOrganizer methodsFor: 'private testing' stamp: 'BenjaminVanRyseghem 4/17/2011 16:50'!
includesPackageBackPointerForClass: aClass

	^ classPackageMapping includesKey: aClass instanceSide name asSymbol! !

!RPackageOrganizer methodsFor: 'private registration' stamp: 'sd 5/21/2010 14:44'!
registerExtendingPackage: aPackage forClass: aClass 

	| cur |
	cur := classExtendingPackagesMapping at: aClass theNonMetaClass name ifAbsent: [nil].
	cur isNil
		ifTrue: [classExtendingPackagesMapping at: aClass theNonMetaClass name put: (Set with: aPackage)]
		ifFalse: [cur add: aPackage]! !

!RPackageOrganizer methodsFor: '*RPackage-SystemIntegration' stamp: 'ThierryGoubier 1/25/2014 22:08'!
systemClassRecategorizedActionFrom: ann
	| class newRPackage newRPackageTag oldRPackage newCategoryName oldCategoryName|
	
	class := ann classAffected.	

	newCategoryName := ann newCategory asSymbol.
	oldCategoryName := ann oldCategory asSymbol.
	oldRPackage := self packageMatchingExtensionName: oldCategoryName includingClass: class.
	newRPackage := (self packageMatchingExtensionName: newCategoryName) 
		ifNil: [ self registerPackage: (self packageClass named: newCategoryName) ].

	newRPackageTag := newRPackage addClassTag: newCategoryName.

	newRPackage 
		moveClass: class 
		fromPackage: oldRPackage 
		toTag: newRPackageTag! !

!RPackageOrganizer methodsFor: 'testing' stamp: 'IgorStasenko 8/12/2011 16:35'!
hasRegistered
	"return true if this package organizer has already registered interest to system events and Monticello changes "
	
	^ self announcer hasSubscriber: self
	
	"|actionSequence|
	self announcer subscriptions ifNil: [^ true].
	actionSequence := self announcer subscriptions values 
								detect: [:each | each anySatisfy: [:anAction | anAction receiver = RPackage organizer]] ifNone: [nil].
	self flag: #cyril.
	^ (actionSequence isNil not) and: [(MCWorkingCopy myDependents includes: self)]"! !

!RPackageOrganizer methodsFor: '*RPackage-SystemIntegration' stamp: 'cyrilledelaunay 5/13/2011 13:53'!
systemProtocolRemovedActionFrom: ann
	"to be unregistered"
	
	! !

!RPackageOrganizer methodsFor: 'private' stamp: 'EstebanLorenzano 2/7/2014 16:19'!
validateCanBeAddedPackageName: packageName tagName: tagName 
	| package |
	
	package := self 
		packageNamed: packageName
		ifAbsent: [ 
			(packageName includes: $-) ifFalse: [ ^ self ].
			 
			^ self 
				validateCanBeAddedPackageName: (packageName copyUpToLast: $-)
				tagName: ((packageName copyAfterLast: $-), (tagName 
					ifNotNil: [ '-', tagName ]
					ifNil: [ '' ] )) ].
		
	(tagName isEmptyOrNil or: [ package includesClassTagNamed: tagName ])
		ifTrue: [ 
			RPackageConflictError signal: ('Package/Tag can not be added because it conflicts with package {1} tag {2}' format: { packageName. tagName })  ]
! !

!RPackageOrganizer methodsFor: '*RPackage-SystemIntegration' stamp: 'ThierryGoubier 3/2/2014 11:00'!
systemCategoryRemovedActionFrom: ann
	"When a system category is removed, we may: remove a tag, or remove a rpackage. If we remove a RPackage, unregister the linked MCWorkingCopy. If it is a tag, do nothing? (from what I know of RPackage, the tag should already have disappeared because it would have been empty)."

	| rPackage categoryName categoryNameSymbol managers |
	categoryName := ann categoryName.
	categoryNameSymbol := categoryName asSymbol.
	self flag: #hack.	"for decoupling MC"
	managers := (self respondsTo: #allManagers)
		ifTrue: [ self perform: #allManagers ]
		ifFalse: [ #() ].	
	"Reverse the test. First check that this is the root category of a RPackage. If yes, unregister the RPackage and the corresponding MCWorkingCopy."
	rPackage := packages at: categoryNameSymbol ifAbsent: [ ^ self ].
	"Consider that a rPackage with extension selectors or tags is not empty and shouldn't be removed."
	(rPackage extensionSelectors notEmpty
		or: [ (rPackage classTags reject: [ :tag | tag name = categoryName ]) notEmpty ])
		ifTrue: [ ^ self ].
	self basicUnregisterPackageNamed: categoryNameSymbol.
	(managers detect: [ :each | each packageName = categoryName ] ifNone: [  ])
		ifNotNil: [ :mcWorkingCopy | mcWorkingCopy unregister ]! !

!RPackageOrganizer methodsFor: 'package access from class' stamp: 'cyrille.delaunay 11/24/2010 14:24'!
extendingPackagesOfClassNamed: aName
	"Returns the packages extending the class named a Symbol"
	^ classExtendingPackagesMapping at: aName asSymbol ifAbsent: [#()]! !

!RPackageOrganizer methodsFor: '*RPackage-SystemIntegration' stamp: 'EstebanLorenzano 1/9/2014 15:21'!
packageMatchingExtensionName: aString includingClass: aClass
	| package categoryName |
	
	categoryName := aString.
	package := self packageMatchingExtensionName: categoryName.
	[ package includesClass: aClass ] 
		whileFalse: [ 
			(categoryName includes: $-)
				ifFalse: [ self error: 'Class not categorized!!' ].
				
			categoryName := categoryName copyUpToLast: $-.
			package := self packageMatchingExtensionName: categoryName ].
		
	^ package! !

!RPackageOrganizer methodsFor: 'private registration' stamp: 'MarcusDenker 7/16/2014 17:25'!
basicUnregisterPackage: aPackage
	"Unregister the specified package from the list of registered packages. Raise the announcement RPackageUnregistered. This is a low level action. It does not unregister the back pointer from classes to packages or any other information managed by the organizer"
	
	packages
		removeKey: aPackage name asSymbol
		ifAbsent: [ self reportExtraRemovalOf: aPackage ].
	"unregister also mc package"
	aPackage mcPackage 
		ifNotNil: [ :mcPackage | mcPackage workingCopy unregister ].! !

!RPackageOrganizer methodsFor: '*Monticello-RPackage' stamp: 'EstebanLorenzano 2/18/2014 15:06'!
basicInitializeFromMC
	self allManagers
		do: [ :workingCopy | self basicRegisterPackage: (RPackage named: workingCopy packageName) ]
		displayingProgress: 'Importing monticello packages'.
		
	Smalltalk allClassesAndTraits 
		do: [ :eachBehavior | self initializeFromMCFor: eachBehavior ]
		displayingProgress: 'Importing behaviors'.

	Smalltalk allClassesAndTraits 
		do: [ :eachBehavior | 
			self initializeFromMCMethodsFor: eachBehavior.
			self initializeFromMCMethodsFor: eachBehavior class ]
		displayingProgress: 'Importing methods'.

	Smalltalk allClassesAndTraits 
		do: [ :eachBehavior |
			eachBehavior organization extensionProtocols do: [ :eachProtocol | 
				self 
					initializeFromMCExtensionsFor: eachBehavior 
					protocol: eachProtocol ].
			eachBehavior class organization extensionProtocols do: [ :eachProtocol | 
				self 
					initializeFromMCExtensionsFor: eachBehavior class 
					protocol: eachProtocol ] ]
		displayingProgress: 'Importing extensions'.
! !

!RPackageOrganizer methodsFor: 'accessing' stamp: 'CamilloBruni 10/2/2013 17:15'!
packageNamesDo: aBlock
	^ packages keysDo: aBlock! !

!RPackageOrganizer methodsFor: '*RPackage-SystemIntegration' stamp: 'CamilleTeruel 9/4/2014 16:37'!
systemMethodRecategorizedActionFrom: ann
	"a protocol has been renamed
	a method has been removed. // WILL BE TREATED WITH SystemMethodRemovedAnnouncement
	a method has been moved to another category 
		-maybe from the classic category to an extending package
		-maybe from an extending package to another extending package
		-maybe from an extending package to a classic category
		- maybe from a classic category to another classic category.
	Get out of here if my organizer has no package for the class!! (Anonymous classes)"
		
	| oldProtocol newProtocol method methodPackage destinationPackage |

	method := ann method.
	method ifNil: [ ^ self ].
	method origin = ann methodClass ifFalse: [ ^ self].
	(self packageOfClassNamed: ann methodClass theNonMetaClass name) ifNil: [ ^ self ].

	newProtocol := ann  newProtocol.
	newProtocol ifNil: [ ^ self ].

	oldProtocol := ann oldProtocol ifNil: [ '' ].
	
	methodPackage := method packageFromOrganizer: self.
	newProtocol asLowercase = oldProtocol asLowercase ifTrue: [ ^ self ].
		
	destinationPackage := (self hasPackageForProtocol: newProtocol inClass: method methodClass)
		ifTrue: [ 
			self packageForProtocol: newProtocol inClass: method methodClass ]
		ifFalse: [ 
			(newProtocol beginsWith: '*')
				ifTrue: [ self ensureExistAndRegisterPackageNamed: newProtocol allButFirst capitalized ]
				ifFalse: [ method methodClass package ] ].
			
	methodPackage := (self hasPackageForProtocol: oldProtocol inClass: method methodClass)
		ifTrue: [ self packageForProtocol: oldProtocol inClass: method methodClass ]
		ifFalse: [ method methodClass package ].

	methodPackage = destinationPackage
		ifFalse: [
			(methodPackage methods includes: method) 
				ifTrue: [ methodPackage removeMethod: method ].
			
			destinationPackage addMethod: method.
			
			SystemAnnouncer uniqueInstance
				methodRepackaged: method
				from: methodPackage
				to: destinationPackage ]! !

!RPackageOrganizer methodsFor: '*Monticello-RPackage' stamp: 'EstebanLorenzano 11/27/2013 15:17'!
updateAfterNewMCPackageRegistred: anAnnouncement
	"User create a new package, MCWorkingCopy propagates changes. We react accordingly."
	|  name |
	
	name := anAnnouncement package name.
	(self packageExactlyMatchingExtensionName: name) 
		ifNil: [ self ensureExistAndRegisterPackageNamed: name ]! !

!RPackageOrganizer methodsFor: 'accessing' stamp: 'PavelKrivanek 7/17/2014 11:02'!
packageDefiningOrExtendingSelector: aSelector inClassNamed: aClassNameSymbol
	"this implementation is slower
		aClass packages detect: [:each | each includesSelector: aSelector ofClass: aClass ]"
	| classPackage |
	
	classPackage := self packageOfClassNamed: aClassNameSymbol.
	classPackage ifNil: [ ^ nil ].
	(classPackage includesSelector: aSelector ofClassName: aClassNameSymbol)
		ifTrue: [ ^classPackage ].
		
	^(self extendingPackagesOfClassNamed: aClassNameSymbol)
		detect: [ :p | p includesSelector: aSelector ofClassName: aClassNameSymbol ]
		ifNone: [ nil ]! !

!RPackageOrganizer methodsFor: '*RPackage-SystemIntegration' stamp: 'EstebanLorenzano 8/3/2012 14:09'!
unregisterInterestToSystemAnnouncement
	"self unregisterInterestToSystemAnnouncement"

	SystemAnnouncer uniqueInstance unsubscribe: self! !

!RPackageOrganizer methodsFor: 'initialization' stamp: 'EstebanLorenzano 8/3/2012 14:09'!
unregister
	SystemAnnouncer uniqueInstance unsubscribe: self.! !

!RPackageOrganizer methodsFor: 'accessing' stamp: 'StephaneDucasse 6/3/2012 22:42'!
packageClass
	"Return the system class that represent packages."
	
	^ RPackage
	! !

!RPackageOrganizer methodsFor: '*Monticello-RPackage' stamp: 'EstebanLorenzano 10/16/2013 12:49'!
initializeFromMCExtensionsFor: aBehavior protocol: aProtocol
	| package protocolName |
	
	protocolName := (aProtocol name allButFirst) trimBoth.
	package := self packageMatchingExtensionName: protocolName.
	package ifNil: [
		package := self basicRegisterPackage: (RPackage named: protocolName) ].
	self registerExtendingPackage: package forClass: aBehavior.
	(aProtocol methods 
		select: [ :eachSelector | (aBehavior >> eachSelector) origin = aBehavior ])
		do: [ :eachSelector | package addMethod: aBehavior >> eachSelector ]! !

!RPackageOrganizer methodsFor: 'public registration' stamp: 'cyrilledelaunay 5/30/2011 17:38'!
unregisterPackageNamed: symbol
	"Unregister the specified package from the list of registered packages. Raise the announcement RPackageUnregistered."
	
	| aPackage |
	aPackage := packages at: symbol asSymbol ifAbsent: [ nil].
	aPackage 
		ifNotNil: [self unregisterPackage: aPackage].
	^ aPackage! !

!RPackageOrganizer methodsFor: 'testing' stamp: 'StephaneDucasse 4/13/2011 22:57'!
includesPackageNamed: aSymbol
	"Answer whether the receiver get a package named aSymbol as registered."
	^ packages includesKey:  aSymbol asSymbol! !

!RPackageOrganizer methodsFor: 'accessing' stamp: 'tg 3/13/2010 16:39'!
packageDefiningOrExtendingMethod: aCompiledMethod
	^ self packageDefiningOrExtendingSelector: aCompiledMethod selector inClass: aCompiledMethod methodClass
! !

!RPackageOrganizer methodsFor: 'initialization' stamp: 'EstebanLorenzano 5/21/2012 17:50'!
register

	"self registerInterestToMC."
	self registerInterestToSystemAnnouncement.! !

!RPackageOrganizer methodsFor: 'package access from class' stamp: 'StephaneDucasse 4/29/2011 21:04'!
packageOfClassNamed: aName

	self flag: self. "shouldProbablyReturnUnunpackagedPackage instead of nil"
	^ classPackageMapping at: aName asSymbol ifAbsent: [nil]! !

!RPackageOrganizer methodsFor: 'private' stamp: 'CamilloBruni 10/17/2012 11:31'!
addMethod: method
	"we have to register the method in the parent RPackage of the class. 
	to do that, we first have to look if the method is an extension from an external package:"

	| rPackage protocol |
	
	protocol := method protocol ifNil: [ Error signal: 'Should not happen' ].
	
	rPackage := (self hasPackageForProtocol: protocol inClass: method methodClass)
		ifTrue: [ self packageForProtocol: protocol inClass: method methodClass ]
		ifFalse: [ self registerPackage: (self packageClass named: (protocol copyWithout: $*)) ].
		
	rPackage addMethod: method! !

!RPackageOrganizer methodsFor: 'accessing' stamp: 'stephane.ducasse 7/10/2009 11:27'!
packages
	
	^ packages values! !

!RPackageOrganizer methodsFor: 'private registration' stamp: 'EstebanLorenzano 2/22/2014 11:29'!
unregisterPackage: aPackage forClass: aClass 
	"unregister the back pointer mapping from classes to packages."
		
	^classPackageMapping 
		removeKey: aClass theNonMetaClass name 
		ifAbsent: [ self reportExtraRemovalOf: aClass ]! !

!RPackageOrganizer methodsFor: '*Nautilus' stamp: 'BenjaminVanRyseghem 12/20/2012 15:06'!
createPackageNamed: aString

	| instance |
	(packages includesKey: aString asSymbol) ifTrue: [ 
			self openAlreadyExistingError.
			^ nil ].
	
	instance := self packageClass named: aString.
	self registerPackage: instance.
	^ instance! !

!RPackageOrganizer methodsFor: 'initialization' stamp: 'StephaneDucasse 6/3/2012 22:42'!
defineUnpackagedClassesPackage
	^ self ensureExistAndRegisterPackageNamed: self packageClass defaultPackageName! !

!RPackageOrganizer methodsFor: '*Monticello-RPackage' stamp: 'EstebanLorenzano 10/16/2013 15:58'!
initializeFromMCFor: aBehavior
	| package |
		
	package := self packageMatchingExtensionName: aBehavior category.
	package ifNil: [ 
		"It should not happen. 
		 But actually could happen that one class is in a SystemCategory and not in a MC"
		package := self basicRegisterPackage: (RPackage named: aBehavior category) ]. 
	package addClassDefinition: aBehavior.
	package 
		addClassDefinition: aBehavior 
		toClassTag: aBehavior category asSymbol.
	self registerPackage: package forClass: aBehavior.! !

!RPackageOrganizer methodsFor: 'private' stamp: 'EstebanLorenzano 1/9/2014 12:17'!
packageNamedIgnoreCase: aSymbol ifAbsent: aBlock
	"In case of extensions, I can need to take a package ignoring name"
	self packagesDo: [  :each | 
		(each name sameAs: aSymbol) 
			ifTrue: [  ^ each  ]  ].
		
	^ aBlock value.! !

!RPackageOrganizer methodsFor: '*RPackage-SystemIntegration' stamp: 'EstebanLorenzano 10/9/2013 14:54'!
packageMatchingExtensionName: anExtensionName

	"return nil if no package is not found"
	| tmpPackageName |
	
	"we first look if their is a package matching exactly the name specified"
	(self packageExactlyMatchingExtensionName: anExtensionName)
		ifNotNil: [ :package | ^ package ].
	
	"if no package was found, we try to find one matching the begining of the name specified"
	tmpPackageName := ''.
	packages keysDo: [:aSymbol |
		(anExtensionName beginsWithEmpty: (aSymbol, '-') caseSensitive: false)
			ifTrue: [
				"we keep the longest package name found"
				(aSymbol size > tmpPackageName size) 
					ifTrue: [ tmpPackageName := aSymbol ]]].
	
	^ tmpPackageName = ''
		ifTrue: [ nil ] 
		ifFalse: [ self packageNamed: tmpPackageName ]! !

!RPackageOrganizer methodsFor: 'public registration' stamp: 'EstebanLorenzano 2/22/2014 11:29'!
unregisterPackage: aPackage
	"Unregister the specified package from the list of registered packages. Raise the announcement RPackageUnregistered."

	self basicUnregisterPackage: aPackage.
	aPackage extendedClasses 
		do: [ :extendedClass | self unregisterExtendingPackage: aPackage forClass: extendedClass].
	aPackage definedClasses 
		do: [ :definedClass | self unregisterPackage: aPackage forClass: definedClass].
	self announcer announce: (RPackageUnregistered to: aPackage).
	
	^ aPackage! !

!RPackageOrganizer methodsFor: 'printing' stamp: 'StephaneDucasse 4/24/2011 17:33'!
printOn: aStream

	super printOn: aStream.
	debuggingName ifNotNil: [aStream nextPutAll: debuggingName ].  ! !

!RPackageOrganizer methodsFor: '*Deprecated40' stamp: 'EstebanLorenzano 4/14/2014 13:57'!
renamePackage: aPackage in: aString
	self deprecated: 'use RPackage>>renameTo:' on: '18 Mar 2014' in: #Pharo30.
	^ aPackage renameTo: aString! !

!RPackageOrganizer methodsFor: '*RPackage-SystemIntegration' stamp: 'EstebanLorenzano 1/24/2014 18:30'!
systemClassAddedActionFrom: ann
	| class rPackage categoryNameSymbol |
	
	class := ann classAffected.

	categoryNameSymbol := class category.
	rPackage := (self packageMatchingExtensionName: categoryNameSymbol) 
		ifNil: [ self registerPackage: (self packageClass named: categoryNameSymbol) ].		
	
	rPackage importClass: class.
! !

!RPackageOrganizer methodsFor: 'accessing' stamp: 'CamilloBruni 10/2/2013 17:14'!
packagesDo: aBlock
	
	packages valuesDo: aBlock! !

!RPackageOrganizer methodsFor: '*RPackage-SystemIntegration' stamp: 'CamilloBruni 10/17/2012 11:31'!
systemMethodModifiedActionFrom: ann

	"this annoucement can correspond to several kind of modifications:
		=> a method has been renamed
		=> a method has been move to another category // SHOULD BE TREATED WITH SystemMethodRecategorizedEvent
		(
			-maybe from the classic category to an extending package
			-maybe from an extending package to another extending package
			-maybe from an extending package to a classic category
			- maybe from a classic category to another classic category
			)
	"
	| oldMethod newMethod methodPackage |
	newMethod := ann newMethod.
	oldMethod := ann oldMethod.
	self flag: #cyrille. 
	"This is not clear that we need to do soemthing here since the method is removed and added so the other events should be handled correctly
	We should remove this method to see if this is working."
	
	"If the method origin is not the one of the event, we do not care about that method"
	newMethod origin = ann methodClass ifFalse: [^ self].
	
	
	"Special case for trait methods added an override"
	newMethod origin = oldMethod origin
		ifFalse: [ ^ self addMethod: newMethod ].
	
	methodPackage := newMethod packageFromOrganizer: self.
	"maybe the name of the method has changed"
	oldMethod selector = newMethod selector
		ifFalse: [ methodPackage updateSelector: oldMethod selector inClass: oldMethod methodClass withNewSelector: newMethod selector].
		

	! !

!RPackageOrganizer methodsFor: '*Nautilus' stamp: ''!
openAlreadyExistingError

	StandardWindow new alert: 'A package with this name already exists' title: 'Already exists'! !

!RPackageOrganizer methodsFor: 'package access from class' stamp: 'GabrielOmarCotelli 12/4/2013 09:40'!
globalPackageOf: aClass
	"this method should return the 'global' parent package of aClass, that means the package holding the (possible) subcategory in which aClass is concretely defined. For example, 'Object package' returns Kernel-Object, whereas 'PackageOrganizer packageOf: Object' returns Kernel. So I guess that all use of 'packageOf' should be replaced by this method  "

	"RPackageOrganizer default globalPackageOf: Object"

	| classPackage |
	classPackage := self packageOf: aClass.
	^ self packages
		detect: [ :aRPackage | aRPackage ~= classPackage and: [ aRPackage systemCategories includes: classPackage name ] ]
		ifNone: [ classPackage ]! !

!RPackageOrganizer methodsFor: '*RPackage-SystemIntegration' stamp: 'BernardoContreras 10/24/2014 17:36'!
registerInterestToAnnouncer: anAnnouncer	
	"There should be only one"
	anAnnouncer unsubscribe: self.
	
	anAnnouncer weak
		when: CategoryAdded send: #systemCategoryAddedActionFrom: to: self;
		when: CategoryRemoved send: #systemCategoryRemovedActionFrom: to: self;
		when: CategoryRenamed send: #systemCategoryRenamedActionFrom: to: self;
		when:  ClassAdded send: #systemClassAddedActionFrom: to: self;
		when:  ClassRecategorized send: #systemClassRecategorizedActionFrom: to: self;
		when:  ClassRemoved send: #systemClassRemovedActionFrom: to: self;
		when:  ClassRenamed send: #systemClassRenamedActionFrom: to: self;
		when:  ClassReorganized send: #systemClassReorganizedActionFrom: to: self;
		when:  MethodAdded send: #systemMethodAddedActionFrom: to: self;
		when:  MethodModified send: #systemMethodModifiedActionFrom: to: self;
		when:  MethodRecategorized send: #systemMethodRecategorizedActionFrom: to: self;
		when:  MethodRemoved send: #systemMethodRemovedActionFrom: to: self;
		when:  ProtocolAdded send: #systemProtocolAddedActionFrom: to: self;
		when:  ProtocolRemoved send: #systemProtocolRemovedActionFrom: to: self.
		
	self flag: #hack. "for decoupling MC"
	#MCWorkingCopy asClassIfPresent: [ 
		anAnnouncer weak
			when: (Smalltalk globals at: #MCWorkingCopyCreated) 
				send: #updateAfterNewMCPackageRegistred: 
				to: self;
			when: (Smalltalk globals at: #MCWorkingCopyDeleted) 
				send: #updateAfterNewMCPackageUnregistred: 
				to: self	].! !

!RPackageOrganizer methodsFor: '*RPackage-SystemIntegration' stamp: 'CamilleTeruel 9/4/2014 16:30'!
systemMethodRemovedActionFrom: ann

	| method methodPackage |
	method := ann method.
	"If the method is provided by a trait, we do not care about it"
	ann isProvidedByATrait ifTrue: [^ self].

	ann methodClass isMeta
		ifFalse: [ 
			methodPackage := self packageDefiningOrExtendingSelector: ann selector inClassNamed: ann methodClass theNonMetaClass originalName.
			methodPackage ifNotNil: [ 
				methodPackage removeSelector: ann selector ofClassName: ann methodClass theNonMetaClass originalName].
		]
		ifTrue: [ 
			methodPackage := self packageDefiningOrExtendingSelector: ann selector inMetaclassNamed: ann methodClass theNonMetaClass originalName.
			methodPackage ifNotNil: [ 
				methodPackage removeSelector: ann selector ofMetaclassName: ann methodClass theNonMetaClass originalName].
		]! !

!RPackageOrganizer methodsFor: '*RPackage-SystemIntegration' stamp: 'GuillermoPolito 6/3/2012 02:24'!
hasPackageForProtocol: aProtocolName inClass: aClass
	"According aProtocolName is an extension protocol, will look for a matching package. If no matching package is found ,  return nil. If aProtocolName is not an extension protocol, return the parent package of aClass"
	
	|tmpProtocol|
	tmpProtocol := aProtocolName ifNil: [''].
	^ (tmpProtocol beginsWith: '*') not or: [ self hasPackageMatchingExtensionName:  (tmpProtocol copyWithout: $*) ]! !

!RPackageOrganizer methodsFor: '*Monticello-RPackage' stamp: 'EstebanLorenzano 11/27/2013 15:17'!
updateAfterNewMCPackageUnregistred: anAnnouncement
! !

!RPackageOrganizer methodsFor: 'private registration' stamp: 'EstebanLorenzano 2/21/2014 12:56'!
basicRegisterPackage: aPackage
	"A new package is now available and declared in the receiver. Note that it is a low level implementation method since it does not deal with package contained information and does not update the related mapping tables."
	
	packages 
		at: aPackage name asSymbol 
		put: aPackage.
	"register mc package"
	MCWorkingCopy forPackage: (MCPackage named: aPackage name).
	
	^ aPackage! !

!RPackageOrganizer methodsFor: '*RPackage-SystemIntegration' stamp: 'EstebanLorenzano 10/30/2012 15:16'!
packageForProtocol: aProtocolName inClass: aClass
	"According aProtocolName is an extension protocol, will look for a matching package. If no matching package is found ,  return nil. If aProtocolName is not an extension protocol, return the parent package of aClass"
	
	|tmpProtocol|
	tmpProtocol := aProtocolName ifNil: [''].
	^ (tmpProtocol beginsWith: '*')
		ifTrue: [  (self packageMatchingExtensionName: (tmpProtocol copyWithout: $*)) ]
		ifFalse: [ aClass package ]! !

!RPackageOrganizer methodsFor: '*RPackage-SystemIntegration' stamp: 'EstebanLorenzano 8/3/2012 14:22'!
announcer 
	^SystemAnnouncer uniqueInstance private! !

!RPackageOrganizer methodsFor: 'accessing' stamp: 'cyrilledelaunay 5/10/2011 12:26'!
packageDefiningOrExtendingSelector: aSelector inClass: aClass
	"this implementation is slower
		aClass packages detect: [:each | each includesSelector: aSelector ofClass: aClass ]"

	
	^ (aClass packages) detect: [:each | each includesSelector: aSelector ofClass: aClass ] ifNone: [
		"if we do not find in the packages of the class, it means that the method is coming from a trait: "
		|tmpTrait|
		tmpTrait := (aClass traitComposition traitProvidingSelector: aSelector).
		(aClass traitComposition traitProvidingSelector: aSelector) packages detect: [:each |
			each includesSelector: aSelector ofClass: tmpTrait.   
			].
		]
	
"	self packages detect: [:each | 
		each includesSelector: aSelector ofClass: aClass ].
"	
	! !

!RPackageOrganizer methodsFor: '*RPackage-SystemIntegration' stamp: 'GuillermoPolito 8/5/2012 13:27'!
systemClassRemovedActionFrom: ann
	"A class has been removed, we should update the package adequately."
	
	| class className rPackage categoryName |	
	class := ann classRemoved.
	className  := class originalName.
		
	self fullyRemoveClassNamed: className.
	! !

!RPackageOrganizer methodsFor: '*RPackage-SystemIntegration' stamp: 'CamilloBruni 9/23/2013 20:45'!
hasPackageMatchingExtensionName: anExtensionName

	(self hasPackageExactlyMatchingExtensionName: anExtensionName)
		ifTrue: [ ^true ].
		
	packages keysDo: [ :aSymbol | 
		(anExtensionName beginsWithEmpty: aSymbol caseSensitive: false)
			ifTrue: [ ^ true]].
	^ false
	! !

!RPackageOrganizer methodsFor: '*Monticello-RPackage' stamp: 'EstebanLorenzano 11/27/2013 15:14'!
isDefinedAsPackageOrSubPackageInMC: aSymbol
	"a category has been added. "
	
	^ self allManagers anySatisfy: [ :each | 
		self 
			category: each packageName asSymbol 
			matches: aSymbol ]! !

!RPackageOrganizer methodsFor: 'accessing' stamp: 'EstebanLorenzano 1/8/2014 14:35'!
packageNamed: aSymbol  ifAbsent: errorBlock
	"Answer a package with exact name but ignoring case. 
	 It first looks for exact key for performance"
	^ packages 
		at: aSymbol asSymbol 
		ifAbsent: [ 
			self  
				packageNamedIgnoreCase: aSymbol 
			 	ifAbsent: errorBlock ]
	! !

!RPackageOrganizer methodsFor: '*RPackage-SystemIntegration' stamp: 'EstebanLorenzano 10/16/2013 17:47'!
systemCategoryRenamedActionFrom: ann
	| rPackage oldName newName |

	oldName := ann oldCategoryName asSymbol.
	newName := ann newCategoryName asSymbol.
	rPackage := self packageMatchingExtensionName: ann oldCategoryName.
	rPackage ifNil: [  rPackage := (RPackage named: newName) register ].
	rPackage name = ann oldCategoryName ifTrue: [ 
		self 
			renamePackage: rPackage 
			from: oldName 
			to: newName ].
		
	rPackage 
		classTagNamed: oldName
		ifPresent: [ :tag | tag basicRenameTo: newName ]
! !

!RPackageOrganizer methodsFor: 'private registration' stamp: 'StephaneDucasse 4/13/2011 18:50'!
registerPackage: aPackage forClassName: aClassNameSymbol
	"Register aPackage as the package of the class aClassNameSymbol. The package should contain the class in its class definitions."
	
	(aPackage includesClassNamed: aClassNameSymbol asSymbol) 
		ifFalse: 
			[self error: aPackage name , ' does not include the class ' , aClassNameSymbol].
	^classPackageMapping at: aClassNameSymbol put: aPackage! !

!RPackageOrganizer methodsFor: 'public registration' stamp: 'EstebanLorenzano 1/3/2014 09:46'!
registerPackageNamed: aString 
	^ self 
		packageNamed: aString asSymbol
		ifAbsent: [ (RPackage named: aString asSymbol) register ]! !

!RPackageOrganizer methodsFor: '*RPackage-SystemIntegration' stamp: 'CamilloBruni 9/23/2013 20:30'!
packageExactlyMatchingExtensionName: anExtensionName
	"only look for a package for which the name match 'anExtensionName', making no difference about case. Return nil if no package is found"
	
	| extension |
	extension := anExtensionName asSymbol.
	
	packages keysDo: [:aSymbol |
		(aSymbol sameAs: extension)
			ifTrue: [ ^ self packageNamed: aSymbol ]].

	^ nil! !

!RPackageOrganizer methodsFor: 'private registration' stamp: 'cyrille.delaunay 11/24/2010 14:06'!
unregisterExtendingPackage: aPackage forClassName: aClassName
	
	| cur |
	cur := classExtendingPackagesMapping at: aClassName asSymbol ifAbsent: [nil].
	cur isNil
		ifFalse: [cur remove: aPackage ifAbsent: [] "not happy with this one"]! !

!RPackageOrganizer methodsFor: 'private' stamp: 'CamilleTeruel 7/29/2012 18:47'!
stopNotification
	"(self instVarNamed: #default) stopNotification"
	
	"pay attention that we can break the system using this method"
	
	SystemAnnouncer uniqueInstance unsubscribe: self.
	MCWorkingCopy removeDependent: self.! !

!RPackageOrganizer methodsFor: '*RPackage-SystemIntegration' stamp: 'EstebanLorenzano 9/24/2012 16:46'!
systemClassReorganizedActionFrom: ann
	"when a class is reorganized, we have to check if an extension has not been added"
	| clazz classOrganization |

	clazz := ann classReorganized.
	classOrganization := clazz organization.
	classOrganization categories do: [ :each | 
		(each beginsWith: '*')
			ifTrue:  [ self checkPackageExistsOrRegister: each allButFirst ] ]
! !

!RPackageOrganizer methodsFor: 'private registration' stamp: 'StephaneDucasse 4/25/2011 12:30'!
unregisterPackage: aPackage forClassName: aClassName
	"Unregister the package back pointer for a given class. The class should not belong to the package anymore before removing the back pointer."

	(aPackage includesClassNamed: aClassName asSymbol) 
		ifTrue: 
			[self error: aPackage name , ' still includes the class ' , aClassName asSymbol].
	^classPackageMapping removeKey: aClassName asSymbol ifAbsent: [self reportBogusBehaviorOf: #unregisterPackage:forClassName:  ]! !

!RPackageOrganizer methodsFor: 'accessing' stamp: 'PavelKrivanek 7/17/2014 11:02'!
packageDefiningOrExtendingSelector: aSelector inMetaclassNamed: aClassNameSymbol
	"this implementation is slower
		aClass packages detect: [:each | each includesSelector: aSelector ofClass: aClass ]"
	| classPackage |
	
	classPackage := self packageOfClassNamed: aClassNameSymbol.
	classPackage ifNil: [ ^ nil ].
	(classPackage includesSelector: aSelector ofMetaclassName: aClassNameSymbol)
		ifTrue: [ ^classPackage ].
		
	^(self extendingPackagesOfClassNamed: aClassNameSymbol)
		detect: [ :p | p includesSelector: aSelector ofMetaclassName: aClassNameSymbol ]
		ifNone: [ nil ]! !

!RPackageOrganizer methodsFor: 'private testing' stamp: 'StephaneDucasse 4/24/2011 17:32'!
debuggingName

	^ debuggingName ! !

!RPackageOrganizer methodsFor: 'private' stamp: 'cyrilledelaunay 5/30/2011 16:22'!
reportBogusBehaviorOf: aSelector

	self logCr: 'RPackage log: Something wrong around ', aSelector asString , 'since the removeKey: is called on not present information.'.! !

!RPackageOrganizer methodsFor: 'system compatibility' stamp: 'EstebanLorenzano 11/27/2013 12:33'!
category: categoryName matches: prefix
	| prefixSize catSize |
	
	categoryName ifNil: [ ^false ].
	catSize := categoryName size.
	prefixSize := prefix size.
	catSize < prefixSize ifTrue: [ ^false ].
	(categoryName findString: prefix startingAt: 1 caseSensitive: false) = 1
		ifFalse: [ ^false ].
	^(categoryName at: prefix size + 1 ifAbsent: [ ^true ]) = $-! !

!RPackageOrganizer methodsFor: 'private registration' stamp: 'cyrille.delaunay 11/25/2010 15:08'!
registerPackage: aPackage forClass: aClass 
	(aPackage includesClass: aClass) 
		ifFalse: 
			[self error: aPackage name , ' does not includes the class ' , aClass name].
	^classPackageMapping at: aClass theNonMetaClass name put: aPackage! !

!RPackageOrganizer methodsFor: 'private' stamp: 'EstebanLorenzano 2/7/2014 15:52'!
validateCanBeAddedPackage: aPackage tagName: aSymbol
	aPackage name = aSymbol ifTrue: [ ^ self ].
	self 
		validateCanBeAddedPackageName: aPackage categoryName, '-', aSymbol
		tagName: nil! !

!RPackageOrganizer methodsFor: 'private registration' stamp: 'cyrille.delaunay 11/24/2010 14:06'!
registerExtendingPackage: aPackage forClassName: aClassName 

	| cur |
	cur := classExtendingPackagesMapping at: aClassName asSymbol ifAbsent: [nil].
	cur isNil
		ifTrue: [classExtendingPackagesMapping at: aClassName asSymbol put: (Set with: aPackage)]
		ifFalse: [cur add: aPackage]! !

!RPackageOrganizer methodsFor: '*RPackage-SystemIntegration' stamp: 'CamilloBruni 9/23/2013 20:28'!
hasPackageExactlyMatchingExtensionName: anExtensionName
	| extension |
	extension := anExtensionName asSymbol.
	"fast version"
	(self includesPackageNamed: extension)
		ifTrue: [  ^ true ].
		
	"slow version ignoring case"
	packages keysDo: [ :aSymbol | 
		(aSymbol sameAs: extension)
			ifTrue: [ ^ true]].
	^ false! !

!RPackageOrganizer methodsFor: 'package access from class' stamp: 'StephaneDucasse 6/3/2012 22:42'!
packageOf: aClass

	^ classPackageMapping 
		at: aClass theNonMetaClass originalName
		ifAbsent: [self packageNamed: self packageClass defaultPackageName]! !

!RPackageOrganizer methodsFor: '*RPackage-SystemIntegration' stamp: 'cyrille.delaunay 11/18/2010 11:42'!
systemProtocolAddedActionFrom: ann

	"for now I don't see anything to do'"! !

!RPackageOrganizer methodsFor: '*RPackage-SystemIntegration' stamp: 'CamilloBruni 10/17/2012 11:27'!
systemMethodAddedActionFrom: ann
	| method |
	
	"If the method origin is not the one of the event, we do not care about that method"
	
	method := ann method.
	method origin = ann methodClass
		ifFalse: [ ^ self ].
		
	self addMethod: method! !

!RPackageOrganizer class methodsFor: 'private' stamp: 'EstebanLorenzano 10/16/2013 17:37'!
setDefault: anOrganizer 
	default ifNotNil: [ default unregister ].
	default := anOrganizer.
	default register.
	RPackage organizer: nil.! !

!RPackageOrganizer class methodsFor: 'private' stamp: 'StephaneDucasse 6/3/2012 22:39'!
packageClass

	^ RPackage! !

!RPackageOrganizer class methodsFor: 'class initialization' stamp: 'EstebanLorenzano 11/27/2013 11:02'!
initialize
	"You need manually filll the data: 
	
	self initializeDefaultFromMC.
	
	is the usual way (but is not in this package by default, it depends on MC)"! !

!RPackageOrganizer class methodsFor: '*Monticello-RPackage' stamp: 'EstebanLorenzano 11/27/2013 11:02'!
initializeDefaultFromMC

	"self initializeDefaultFromMC"
	self setDefault:  self new initializeFromMC.! !

!RPackageOrganizer class methodsFor: '*Monticello-RPackage' stamp: 'StephaneDucasse 6/2/2012 19:39'!
allManagers

	^ MCWorkingCopy allManagers! !

!RPackageOrganizer class methodsFor: 'singleton' stamp: 'ClementBera 7/26/2013 16:31'!
default
	"WARNING: Since this component can be changed (i.e. for testing) you should NOT use it directly. 
	  Use RPackage class>>#organizer instead"
	
	^ default ifNil: [  default := self new ]! !

!RPackageOrganizer class methodsFor: '*RPackage-SystemIntegration' stamp: 'StephaneDucasse 6/3/2012 22:36'!
isPackageDefinedForClass: aClass

	^ (self default packageOf: aClass) notNil! !

!RPackageOrganizer class methodsFor: 'class initialization' stamp: 'EstebanLorenzano 7/21/2014 15:09'!
removeMockPackagesFromOldOrganizer

	"the next line is a bit 'hacky'. It will remove the mock packages used by monticello test in packageInfo-Organizer. Those packages will now be subclasses of RPackage and should no longer be present in the packageInfo-organizer"
	|mockPackages|

	mockPackages := self default packages 
		select: [:info | (({'MCEmptyPackage'. 'MonticelloMocks'} includes: info packageName)) ].
	mockPackages 
		do: [:each | self default unregisterPackage: each ].
	self default packagesDictionary removeKey: #'Monticello-Mocks' ifAbsent: []! !

!RPackageOrganizer class methodsFor: 'singleton' stamp: 'StephaneDucasse 6/3/2012 22:39'!
resetDefault

	"self resetDefault"
	default  ifNotNil: [
		"When an Organizer is not used anymore, we should always pay attention that these two actions are corretly done."
		default unregisterInterestToSystemAnnouncement.
		MCWorkingCopy removeDependent: default].
	default := self new.
	self packageClass initialize! !

!RPackageOrganizer class methodsFor: '*RPackage-SystemIntegration' stamp: 'GuillermoPolito 8/3/2012 14:20'!
methodAdded: anEvent
	"precondition: package exist, class exist"
	
	| methodCategory |
	methodCategory := anEvent protocol.
	(methodCategory isEmptyOrNil or:[ methodCategory first ~= $* ]) 
		ifFalse: [
			(self isPackageDefinedForClass: anEvent methodClass)
					ifFalse: [self packageClass new named: (Smalltalk organization categoryOfElement: anEvent methodClass theNonMetaClass asSymbol) ].
		].! !

!RPackageOrganizer class methodsFor: '*RPackage-SystemIntegration' stamp: 'cyrille.delaunay 11/26/2010 10:23'!
unregisterInterestToSystemAnnouncement

	self default unregisterInterestToSystemAnnouncement! !

!RPackageOrganizer class methodsFor: '*RPackage-SystemIntegration' stamp: 'sd 4/23/2011 23:31'!
registerInterestToSystemAnnouncement

	self default unregisterInterestToSystemAnnouncement.
	"To make sure that we do not have it twice registered"
	self default registerInterestToSystemAnnouncement! !

!RPackageOrganizerTest commentStamp: 'StephaneDucasse 4/24/2011 17:10'!
RPackageOrganizerTest tests the behavior of PackageOrganizer. 
Note that it does not rely on announcement to be emitted to maintain invariants.
Therefore the new created PackageOrganizer is not registered to listen to event.

!
!RPackageOrganizerTest methodsFor: 'tests extending' stamp: 'FernandoOlivero 9/4/2013 16:17'!
pointRectangleInGraphElement 
	| p |
	p := self packageClass named: #GraphElement.
	p addClassDefinition: Point.
	p addMethod: Point>>#x.
	p addMethod: Point>>#rotateBy:about:. 
	p addClassDefinition: Rectangle.
	p addMethod: self quadrangleClass >>#intersect:.
	^ p! !

!RPackageOrganizerTest methodsFor: 'tests' stamp: 'cyrilledelaunay 5/30/2011 17:10'!
testRegisteredNumberOfPackageIsOk
	"self debug: #testRegisteredNumberOfPackageIsOk"

	| p1 p2 p3 |
	p1 := self createNewPackageNamed: 'P1'.
	p2 := self createNewPackageNamed: 'P2'.
	p3 := self createNewPackageNamed: 'P3'.

	self packageOrganizer basicRegisterPackage: p1.
	self packageOrganizer basicRegisterPackage: p2.
	self packageOrganizer basicRegisterPackage: p3.
	self assert: self packageOrganizer packageNames size = 4.
	self packageOrganizer basicUnregisterPackage: p3.
	self assert: self packageOrganizer packageNames size = 3.! !

!RPackageOrganizerTest methodsFor: 'utility' stamp: 'StephaneDucasse 4/24/2011 17:13'!
packageOrganizer

	^ packageOrganizer ! !

!RPackageOrganizerTest methodsFor: 'tests extensions' stamp: 'EstebanLorenzano 1/15/2013 16:52'!
testSilentlyRenameCategoryToBe

	| class |
	
	class := self createNewClassNamed: #ClassForTestAboutSilentRecategorization inCategory: 'RPackage-Tests'.
	class organization addCategory:#foo.
	self assert: (class organization categories includes: #foo).
	self deny: (class organization categories includes: #bar).
	class organization silentlyRenameCategory: #foo toBe: #bar.
	
	self assert: (class organization categories includes: #bar).
	self deny: (class organization categories includes: #foo).	! !

!RPackageOrganizerTest methodsFor: 'tests' stamp: 'EstebanLorenzano 2/7/2014 13:19'!
testRegisterPackageTagConflictWithPackage
	| package1 package2 |

	package1 := self createNewPackageNamed: 'P1-T1'.
	package1 register.	
	
	package2 := self createNewPackageNamed: 'P1'.
	self 
		should: [ package2 addClassTag: #T1 ]
		raise: Error! !

!RPackageOrganizerTest methodsFor: 'tests' stamp: 'cyrilledelaunay 5/30/2011 16:25'!
testRegisteredIsThere
	"self debug: #testRegisteredIsThere"

	| p1 p2 p3 |
	p1 := self createNewPackageNamed: 'P1'.
	p2 := self createNewPackageNamed: 'P2'.
	p3 := self createNewPackageNamed: 'P3'.

	self packageOrganizer basicRegisterPackage: p1.
	self packageOrganizer basicRegisterPackage: p2.
	self packageOrganizer basicRegisterPackage: p3.
	self assert: self packageOrganizer packageNames size = 4.
	
	{p1 . p2 . p3} do: [:each | 
		self assert:  (self packageOrganizer packageNames includes: each name)]! !

!RPackageOrganizerTest methodsFor: 'tests' stamp: 'cyrilledelaunay 5/30/2011 16:46'!
p1Name
	^ 'RPackageTestP1'! !

!RPackageOrganizerTest methodsFor: 'utility' stamp: '2010-07-29T21:54:00+01:00'!
removeClassNamedIfExists: aClassNameSymbol

	Smalltalk globals at: aClassNameSymbol asSymbol ifPresent: [ :c | c removeFromSystem ]! !

!RPackageOrganizerTest methodsFor: 'tests' stamp: 'cyrilledelaunay 5/30/2011 16:46'!
p3Name
	^ 'RPackageTestP3'! !

!RPackageOrganizerTest methodsFor: 'tests' stamp: 'EstebanLorenzano 2/7/2014 14:52'!
testFullRegistration
	"self debug: #testFullRegistration"

	| p1 p2 p3 a1 a2 b1 b2 a3 |
	"taken from setup of RPackageReadOnlyCompleteSetup"
	
	p1 := self createNewPackageNamed: self p1Name.
	p2 := self createNewPackageNamed: self p2Name.
	p3 := self createNewPackageNamed: self p3Name.
	
	a1 :=  self createNewClassNamed: #A1DefinedInP1 inPackage: p1.
	b1 := self createNewClassNamed: #B1DefinedInP1 inPackage: p1.
	a2 := self createNewClassNamed: #A2DefinedInP2 inPackage: p2.
	b2 := self createNewClassNamed: #B2DefinedInP2 inPackage: p2.
	a3 := self createNewClassNamed: #A3DefinedInP3 inPackage: p3.
	
	a1 compileSilently: 'methodDefinedInP1 ^ #methodDefinedInP1'.
	p1 addMethod: (a1>>#methodDefinedInP1).
	a1 compileSilently: 'anotherMethodDefinedInP1 ^ #anotherMethodDefinedInP1'.
	p1 addMethod: (a1>>#anotherMethodDefinedInP1).
	
	a2 compileSilently: 'methodDefinedInP1 ^ #methodDefinedInP1'.
	p1 addMethod: (a2>>#methodDefinedInP1).
	
	a2 compileSilently: 'methodDefinedInP2 ^ #methodDefinedInP2'.
	p2 addMethod: (a2>>#methodDefinedInP2).
	
	a2 compileSilently: 'methodDefinedInP3 ^ #methodDefinedInP3'.
	p3 addMethod: (a2>>#methodDefinedInP3).

	a2 class compileSilently: 'classSideMethodDefinedInP3 ^ #classSideMethodDefinedInP3'.
	p3 addMethod: (a2 class>>#classSideMethodDefinedInP3).
	

	self packageOrganizer registerPackage: p1.
	self packageOrganizer registerPackage: p2.
	self packageOrganizer registerPackage: p3.
	
	self deny: (p2 includesClass: b1).
	self assert: (p2 includesClass: b2).
	"a locally defined class not extended by other packages"
	
	self assert: (p2 includesClass: a2).  
	"a locally defined class extended by other packages"
	
	self assert: (p1 definesOrExtendsClass: a2).
	self deny: (p1 includesClass: a2).
! !

!RPackageOrganizerTest methodsFor: 'tests extending' stamp: 'FernandoOlivero 9/4/2013 16:16'!
testRegistrationExtendingPackages
	"self debug: #testRegistrationExtendingPackages"

	| p |
	self assert: (self packageOrganizer extendingPackagesOf: self quadrangleClass) isEmpty.
	p := self pointRectangleInGraphElement.
	(self packageOrganizer
					registerExtendingPackage:  p
					forClass: self quadrangleClass).
	self deny: (self packageOrganizer extendingPackagesOf: self quadrangleClass) isEmpty.
	self assert: (self packageOrganizer extendingPackagesOf: self quadrangleClass) anyOne name = #GraphElement.
	! !

!RPackageOrganizerTest methodsFor: 'tests' stamp: 'EstebanLorenzano 2/7/2014 13:17'!
testRegisterPackageConflictWithPackageTag
	"self debug: #testRegisteredIsThere"

	| package1 package2 |

	package1 := self createNewPackageNamed: 'P1'.
	package1 register.
	package1 addClassTag: #T1.
	
	package2 := self createNewPackageNamed: 'P1-T1'.
	self 
		should: [ package2 register ]
		raise: Error! !

!RPackageOrganizerTest methodsFor: 'tests' stamp: 'cyrilledelaunay 5/30/2011 17:19'!
testUnregisterBasedOnNames
	"self debug: #testUnregisterBasedOnNames"

	| p1 p2 p3 |
	p1 := self createNewPackageNamed: 'P1'.
	p2 := self createNewPackageNamed: 'P2'.
	p3 := self createNewPackageNamed: 'P3'.

	self packageOrganizer basicRegisterPackage: p1.
	self packageOrganizer basicRegisterPackage: p2.
	self packageOrganizer basicRegisterPackage: p3.
	self assert: self packageOrganizer packageNames size = 4.

	{p1 . p2 . p3} do: [:each | 
		(self packageOrganizer basicUnregisterPackageNamed: each name).
		self deny:  (self packageOrganizer packageNames includes: each name)]! !

!RPackageOrganizerTest methodsFor: 'tests' stamp: 'cyrilledelaunay 5/30/2011 16:46'!
p2Name
	^ 'RPackageTestP2'! !

!RPackageOrganizerTest methodsFor: 'utility' stamp: 'cyrilledelaunay 5/30/2011 17:19'!
removePackageIfExist: aName

	self packageOrganizer basicUnregisterPackageNamed: aName asSymbol.
		
	! !

!RPackageOrganizerTest methodsFor: 'tests' stamp: 'cyrilledelaunay 5/30/2011 16:53'!
testRegisteredIsIncludedInPackageNames
	"self debug: #testRegisteredIsIncludedInPackageNames"
	| p1 p2 p3 |
	p1 := self createNewPackageNamed: 'P1'.
	p2 := self createNewPackageNamed: 'P2'.
	p3 := self createNewPackageNamed: 'P3'.

	self packageOrganizer registerPackage: p1.
	self packageOrganizer registerPackage: p2.
	self packageOrganizer registerPackage: p3.
	self assert: self packageOrganizer packageNames size = 4.
	self assert: (self packageOrganizer includesPackage: p1). 
	self assert: (self packageOrganizer includesPackageNamed: p1 name). 
	{p1 . p2 . p3} do: [:each | self assert:  (self packageOrganizer packageNames includes: each name)]

! !

!RPackageOrganizerTest methodsFor: 'setup' stamp: 'FernandoOlivero 9/4/2013 16:21'!
tearDown 
	
	Author fullName: previousAuthor.
	
	(createdClasses reject: [:c| c isObsolete])
		do: [:cls| 
				"(self packageClass organizer includesClass: cls)
					ifTrue: [self packageOrganizer unregisterClass: cls.]."
				cls removeFromSystem ].
	"createdPackages do:
		[:each | self packageOrganizer unregisterPackage: each]"
	
! !

!RPackageOrganizerTest methodsFor: 'tests' stamp: 'EstebanLorenzano 2/7/2014 15:51'!
testRegisterPackageConflictWithPackage
	"self debug: #testRegisteredIsThere"

	| package1 package2 |

	package1 := self createNewPackageNamed: 'P1'.
	package1 register.
	
	package2 := self packageClass named: 'P1'.
	self 
		should: [ package2 register ]
		raise: Error! !

!RPackageOrganizerTest methodsFor: 'setup' stamp: 'FernandoOlivero 9/4/2013 16:25'!
setUp
	super setUp.
	createdClasses := OrderedCollection new.
	createdPackages := OrderedCollection new.
	packageOrganizer := self packageOrganizerClass basicNew initialize.
	packageOrganizer debuggingName: 'For PackageOrganizerTest'.
	previousAuthor := Author fullName ifNil: [Author fullName: 'RPackage'].
	
	self createNewClassNamed: 'QuadrangleForTesting' inCategory: self class category.
	self quadrangleClass compileSilently: 'intersect:aPoint ^ false'.! !

!RPackageOrganizerTest methodsFor: 'tests' stamp: 'StephaneDucasse 6/3/2012 22:51'!
testEmpty
	"self debug: #testEmpty"
	self assert: self packageOrganizer packageNames size = 1.
	self assert: (self packageOrganizer packageNames includes: self packageClass defaultPackageName)
! !

!RPackageOrganizerTest methodsFor: 'tests extending' stamp: 'EstebanLorenzano 2/7/2014 15:48'!
testTestingPackageExistence

	| extensionCategory package existingPackage |
	
	self skip. "This tests seems to not have sense anymore (because creating of duplicated packages is forbidden). 
 	Loot at RPackageOrganizerTest>>#testRegisterPackageConflictWithPackageTag"
	
	existingPackage := (RPackage named: 'RPackage-Tests') register; yourself.
	extensionCategory := existingPackage name, '-subcategory'.
	package := RPackage named: extensionCategory.
	packageOrganizer := package organizer.
	self deny: (packageOrganizer includesPackageNamed: extensionCategory).

	packageOrganizer checkPackageExistsOrRegister: extensionCategory.

	self deny: (packageOrganizer includesPackageNamed: extensionCategory).! !

!RPackageOrganizerTest methodsFor: 'tests extending' stamp: 'StephaneDucasse 6/3/2012 22:51'!
stringCharacterInCollPackage
	| p |
	p := self packageClass named: #CollPackage.
	p addClassDefinition: String.
	p addClassDefinition: Character.
	p addMethod: String>>#indexOf:.
	p addMethod: String>>#isAllDigits.
	p addMethod: String class>>#cr.
	p addMethod: Character>>#asInteger.
	p addMethod: Text>>#allBold.
	^ p! !

!RPackageOrganizerTest methodsFor: 'utility' stamp: 'FernandoOlivero 9/4/2013 16:18'!
quadrangleClass
	^ 'QuadrangleForTesting' asClass ! !

!RPackageOrganizerTest methodsFor: 'tests' stamp: 'cyrilledelaunay 5/30/2011 16:52'!
testAccessingPackage
	"self debug: #testAccessingPackage"

	| p1 |
	p1 := self createNewPackageNamed: 'P1'.
	self packageOrganizer registerPackage: p1.
	p1 addClassDefinition: Point.
	p1 addMethod: Point>>#x.
	p1 addMethod: Point class>>#x:y:. 
	self assert: (self packageOrganizer packageNamed: #P1) = p1.
	self should: [(self packageOrganizer packageNamed: #P22)] raise: Error! !

!RPackageOrganizerTest methodsFor: 'tests extending' stamp: 'FernandoOlivero 9/4/2013 16:25'!
testUnregistrationExtendingPackages
	"self debug: #testUnregistrationExtendingPackages"

	| p |
	
	
	p := self pointRectangleInGraphElement.
	self packageOrganizer
		registerExtendingPackage: p
		forClass: self quadrangleClass.
	self deny: (self packageOrganizer extendingPackagesOf: self quadrangleClass) isEmpty.
	self assert: (self packageOrganizer extendingPackagesOf: self quadrangleClass) anyOne name = #GraphElement.
	self packageOrganizer
					unregisterExtendingPackage:  p
					forClass: self quadrangleClass.
	self assert: (self packageOrganizer extendingPackagesOf: self quadrangleClass) isEmpty.
	! !

!RPackageOrganizerTest methodsFor: 'tests' stamp: 'cyrilledelaunay 5/30/2011 17:18'!
testFullUnregistration
	"self debug: #testFullRegistration"

	| p1 p2 p3 a1 a2 b1 b2 a3 |
	"taken from setup of RPackageReadOnlyCompleteSetup"
	
	p1 := self createNewPackageNamed: self p1Name.
	p2 := self createNewPackageNamed: self p2Name.
	p3 := self createNewPackageNamed: self p3Name.
	
	a1 :=  self createNewClassNamed: #A1DefinedInP1 inPackage: p1.
	b1 := self createNewClassNamed: #B1DefinedInP1 inPackage: p1.
	a2 := self createNewClassNamed: #A2DefinedInP2 inPackage: p2.
	b2 := self createNewClassNamed: #B2DefinedInP2 inPackage: p2.
	a3 := self createNewClassNamed: #A3DefinedInP3 inPackage: p3.
	
	a1 compileSilently: 'methodDefinedInP1 ^ #methodDefinedInP1'.
	p1 addMethod: (a1>>#methodDefinedInP1).
	a1 compileSilently: 'anotherMethodDefinedInP1 ^ #anotherMethodDefinedInP1'.
	p1 addMethod: (a1>>#anotherMethodDefinedInP1).
	
	a2 compileSilently: 'methodDefinedInP1 ^ #methodDefinedInP1'.
	p1 addMethod: (a2>>#methodDefinedInP1).
	
	a2 compileSilently: 'methodDefinedInP2 ^ #methodDefinedInP2'.
	p2 addMethod: (a2>>#methodDefinedInP2).
	
	a2 compileSilently: 'methodDefinedInP3 ^ #methodDefinedInP3'.
	p3 addMethod: (a2>>#methodDefinedInP3).

	a2 class compileSilently: 'classSideMethodDefinedInP3 ^ #classSideMethodDefinedInP3'.
	p3 addMethod: (a2 class>>#classSideMethodDefinedInP3).
	

	self packageOrganizer registerPackage: p1.
	self packageOrganizer registerPackage: p2.
	self packageOrganizer registerPackage: p3.
	
	self packageOrganizer unregisterPackage: p1.
	self packageOrganizer unregisterPackage: p2.
	self packageOrganizer unregisterPackage: p3.
	

	self deny: (self packageOrganizer includesPackageBackPointerForClass: a1).
	self deny: (self packageOrganizer includesPackageBackPointerForClass: a2).
	self deny: (self packageOrganizer includesPackageBackPointerForClass: b1).
	self deny: (self packageOrganizer includesPackageBackPointerForClass: b2).
	self deny: (self packageOrganizer includesPackageBackPointerForClass: a3).
! !

!RPackageOrganizerTest methodsFor: 'tests' stamp: 'cyrilledelaunay 5/30/2011 16:52'!
testDefinedClassesInstanceAndMetaSideAPI
	"self debug: #testDefinedClassesInstanceAndMetaSideAPI"
	| p1 |
	p1 := self createNewPackageNamed: 'P1'.
	self packageOrganizer registerPackage: p1.
	p1 addClassDefinition: Point.
	p1 addMethod: Point>>#x.
	p1 addMethod: Point class>>#x:y:. 
	self assert: self packageOrganizer packageNames size = 2.
	self assert: self packageOrganizer packages size = 2.
	self assert: (self packageOrganizer packageNamed: #P1) definedClasses size = 1! !

!RPackageReadOnlyCompleteSetupTest commentStamp: 'StephaneDucasse 4/13/2011 17:10'!
The tests takes as fixture the following situation and exercises the readonly queries.
We should be able to use a test resources to speed it up.

P1 
	A1DefinedInP1
	A1DefinedInP1>>methodDefinedInP1
	B1DefinedInP1	
	A2DefinedInP2>>methodDefinedInP1
	
P2
	A2DefinedInP2
	A2DefinedInP2>>methodDefinedInP2
	B2DefinedInB2	

P3
	A3DefinedInP3	
	A2DefinedInP2>>methodDefinedInP3 !
!RPackageReadOnlyCompleteSetupTest methodsFor: 'test situation' stamp: 'StephaneDucasse 4/13/2011 20:52'!
testStartingSituation
	"self debug: #testStartingSituation"

.	self deny: (p2 includesClass: b1).
	self assert: (p2 includesClass: b2).
	"a locally defined class not extended by other packages"
	
	self assert: (p2 includesClass: a2).  
	"a locally defined class extended by other packages"
	
	self assert: (p1 definesOrExtendsClass: a2).
	self deny: (p1 includesClass: a2).
! !

!RPackageReadOnlyCompleteSetupTest methodsFor: 'test situation' stamp: '2010-04-21T16:13:00+01:00'!
testSelectors
	"self debug: #testSelectors"
	
	self assert: (p1 selectors) size = 2. 
	self assert: ((p1 selectors) includes: #methodDefinedInP1).
	self assert: ((p1 selectors) includes: #anotherMethodDefinedInP1). 

	self assert: p3 selectors size = 2.
	self assert: (p3 selectors includes: #methodDefinedInP3).
	self assert:  (p3 selectors includes: #classSideMethodDefinedInP3)	! !

!RPackageReadOnlyCompleteSetupTest methodsFor: 'test tag class' stamp: 'BenjaminVanRyseghem 8/29/2012 11:56'!
testAddTagsToAClass
	"self debug: #testAddTagsToAClass"
	
	self assert: p1 classTags isEmpty.
	p1 addClassDefinitionName: #A1DefinedInP1 toClassTag: #foo.
	self assert: (((p1 classesForClassTag: #foo) collect: #name) includes: #A1DefinedInP1).
	self assert: ((p1 classesForClassTag: #foo) size = 1).
	p1 addClassDefinitionName: #B1DefinedInP1 toClassTag: #foo.
	self assert: (((p1 classesForClassTag: #foo) collect: #name) includes: #B1DefinedInP1).
	self assert: ((p1 classesForClassTag: #foo) size = 2).

	p1 addClassDefinitionName: #B1DefinedInP1 toClassTag: #zork.
	self assert: (((p1 classesForClassTag: #zork) collect: #name) includes: #B1DefinedInP1).
	self assert: ((p1 classesForClassTag: #foo) size = 2).
	self assert: ((p1 classesForClassTag: #zork) size = 1).! !

!RPackageReadOnlyCompleteSetupTest methodsFor: 'test compiled method' stamp: 'StephaneDucasse 4/13/2011 17:09'!
testClassIsExtendedInPackage
	"self debug: #testClassIsExtendedInPackage"
	
	self deny: ((Smalltalk globals at: #A1DefinedInP1) isExtendedInPackage: p1).
	self assert: (p1 includesClass: (Smalltalk globals at: #A1DefinedInP1)).
	self deny: (p1 extendsClass: (Smalltalk globals at: #A1DefinedInP1)).
	self assert: ((Smalltalk globals at: #A2DefinedInP2) isExtendedInPackage: p1).
	self deny: (p1 includesClass: (Smalltalk globals at: #A2DefinedInP2)).
	self assert: (p1 extendsClass: (Smalltalk globals at: #A2DefinedInP2)).
	! !

!RPackageReadOnlyCompleteSetupTest methodsFor: 'test tag class' stamp: 'YuriyTymchuk 10/25/2013 17:19'!
testAddTag
	"self debug: #testAddTag"
	
	self assert: p1 classTags isEmpty.
	p1 addClassTag: #baz. 
	self assert: (p1 classTags anySatisfy: [ :tag | tag name = #baz ]).
	self assert: (p1 classTags size = 1).
	
	p1 addClassDefinitionName: #A1DefinedInP1 toClassTag: #foo.
	p1 addClassDefinitionName: #B1DefinedInP1 toClassTag: #foo.
	self assert: (p1 classTags anySatisfy: [ :tag | tag name = #foo ]).
	self assert: (p1 classTags size = 2).
	self assert: (((p1 classesForClassTag: #foo) collect: #name) includes: #A1DefinedInP1).
	self assert: (((p1 classesForClassTag: #foo) collect: #name) includes: #B1DefinedInP1).
	self assert: ((p1 classesForClassTag: #foo) size = 2).
	
	p1 addClassTag: #foo. 
	self assert: (p1 classTags anySatisfy: [ :tag | tag name = #baz ]).
	self assert: (p1 classTags anySatisfy: [ :tag | tag name = #foo ]).
	self assert: (((p1 classesForClassTag: #foo) collect: #name) includes: #A1DefinedInP1).
	self assert: (((p1 classesForClassTag: #foo) collect: #name) includes: #B1DefinedInP1).
	self assert: ((p1 classesForClassTag: #foo) size = 2).! !

!RPackageReadOnlyCompleteSetupTest methodsFor: 'test situation' stamp: '2010-03-13T13:48:00+01:00'!
testMetaclassHasExtensions
	"self debug: #testMetaclassHasExtensions"

	self assert: (p3 includesExtensionSelector: #methodDefinedInP3 ofClassName: a2  name).
	self assert: (p3 includesExtensionSelector: #methodDefinedInP3 ofClass: a2).
	self assert: (p3 includesExtensionSelector: #classSideMethodDefinedInP3 ofMetaclassName: a2 name).
	self assert: (p3 includesExtensionSelector: #classSideMethodDefinedInP3 ofClass: a2 class)

	! !

!RPackageReadOnlyCompleteSetupTest methodsFor: 'expectedfailures' stamp: '2010-04-20T21:50:00+01:00'!
expectedFailures

	^ #(testClassNamesAndExtensionSelectorsDo testClassNamesAndExtensionSelectorsDo testClassesAndExtensionMethodsDo testClassesAndExtensionMethodsDo)! !

!RPackageReadOnlyCompleteSetupTest methodsFor: 'test accessing' stamp: '2010-04-21T17:08:00+01:00'!
testPackagesOfClass
	"since a class can be extended by several packages, we want the complete list of packages that define or extend
	the class"
	"self debug: #testPackagesOfClass"
		
	| packages extending |
	packages := a2 packages.
	"a2 is extended by p1 and p3"
	extending := a2 extendingPackages.
	self assert: extending size = 2. 
	self assert: (extending includes: p1).
	self assert: (extending includes: p3).
	
	self assert: packages size = 3. 
	self assert: (packages includes: p1).
	self assert: (packages includes: p2).
	self assert: (packages includes: p3).
	
	
	
	
	
	
	! !

!RPackageReadOnlyCompleteSetupTest methodsFor: 'test slice' stamp: '2010-04-20T21:42:00+01:00'!
testClassesAndExtensionMethodsDo
	"self debug: #testClassesAndExtensionMethodsDo"
	
	| block |

	self assert: (String streamContents: [:stream |
		block := [ :aClass :selectors |
				stream nextPutAll: aClass name ; nextPutAll: ' '.
				selectors do: [ :selector | stream nextPutAll: selector asString].
				stream cr.].
		{p1 . p2 . p3} do: [ :p |
			p classExtensionSlicesDo: block.
			p metaclassExtensionSlicesDo: block.]]) 
		= 'A2DefinedInP2 methodDefinedInP1
A2DefinedInP2 methodDefinedInP3
A2DefinedInP2 classSideMethodDefinedInP3
'! !

!RPackageReadOnlyCompleteSetupTest methodsFor: 'test situation' stamp: '2010-04-21T15:57:00+01:00'!
testMethodsForClass
	"self debug: #testMethodsForClass"
	
	self assert: (p1 methodsForClass: a1) size = 2. 
	self assert: ((p1 methodsForClass: a1) includes: ((Smalltalk at: #A1DefinedInP1)>>#methodDefinedInP1)).
	self assert: ((p1 methodsForClass: a1) includes: ((Smalltalk at: #A1DefinedInP1)>>#anotherMethodDefinedInP1)).
	self assert: (p1 methodsForClass: b1) isEmpty. 
	self assert: (p1 methodsForClass: Object) isEmpty. 
	self assert: (p1 methodsForClass: Object class) isEmpty. 

	self assert: (p3 methodsForClass: a2) size = 1.
	self assert: ((p3 methodsForClass: a2) includes: ((Smalltalk at: #A2DefinedInP2)>>#methodDefinedInP3)).
	self assert: (p3 methodsForClass: a2 class) size = 1.
	self assert:  ((p3 methodsForClass: a2 class) includes: ((Smalltalk at: #A2DefinedInP2) class>>#classSideMethodDefinedInP3))	! !

!RPackageReadOnlyCompleteSetupTest methodsFor: 'test slice' stamp: '2010-04-20T21:53:00+01:00'!
testClassNamesAndExtensionSelectorsDo2
	"self debug: #testClassNamesAndExtensionSelectorsDo2"
	

	self assert: (String streamContents: [:stream |
		{p1 . p2 .p3} do: [:p |
			p classNamesAndExtensionSelectorsDo: [:aClassName :selector |
				stream nextPutAll: aClassName  ; nextPutAll: ' ' ; nextPutAll:  selector asString; cr ]]])
		= 'A2DefinedInP2 methodDefinedInP1
A2DefinedInP2 methodDefinedInP3
A2DefinedInP2_class classSideMethodDefinedInP3
'.
! !

!RPackageReadOnlyCompleteSetupTest methodsFor: 'test situation' stamp: '2010-04-20T22:05:00+01:00'!
testExtensionSelectorsForClass
	"self debug: #testExtensionSelectorsForClass"
	
	self assert: (p1 extensionSelectorsForClass: a2) size = 1. 
	self assert: ((p1 extensionSelectorsForClass: a2) includes: #methodDefinedInP1).
	self assert: ((p1 extensionMethodsForClass: a2) includes: (Smalltalk at: #A2DefinedInP2) >> #methodDefinedInP1).
	self assert: (p1 extensionSelectorsForClass: Object) isEmpty.
	self assert: (p1 extensionSelectorsForClass: Object class) isEmpty! !

!RPackageReadOnlyCompleteSetupTest methodsFor: 'test tag class' stamp: 'YuriyTymchuk 10/25/2013 17:20'!
testAddTagNames
	"self debug: #testAddTag"
	
	self assert: p1 classTags isEmpty.
	p1 addClassTag: #baz. 
	self assert: (p1 classTags anySatisfy: [ :tag | tag name = #baz ]).
	self assert: (p1 classTags size = 1).
	
	p1 addClassDefinitionName: #A1DefinedInP1 toClassTag: #foo.
	p1 addClassDefinitionName: #B1DefinedInP1 toClassTag: #foo.
	self assert: (p1 classTags anySatisfy: [ :tag | tag name = #foo ]).
	self assert: (p1 classTags size = 2).
	self assert: ((p1 classNamesForClassTag: #foo) includes: #A1DefinedInP1).
	self assert: ((p1 classNamesForClassTag: #foo) includes: #B1DefinedInP1).
	self assert: ((p1 classNamesForClassTag: #foo) size = 2).
	
	p1 addClassTag: #foo. 
	self assert: (p1 classTags anySatisfy: [ :tag | tag name = #baz ]).
	self assert: (p1 classTags anySatisfy: [ :tag | tag name = #foo ]).
	self assert: ((p1 classNamesForClassTag: #foo) includes: #A1DefinedInP1).
	self assert: ((p1 classNamesForClassTag: #foo) includes: #B1DefinedInP1).
	self assert: ((p1 classNamesForClassTag: #foo) size = 2).! !

!RPackageReadOnlyCompleteSetupTest methodsFor: 'test compiled method' stamp: 'StephaneDucasse 6/3/2012 22:47'!
testCompiledMethodPackageFromOrganizer
	"self debug: #testCompiledMethodPackageFromOrganizer"
	| method |
	method := (Smalltalk at: #A1DefinedInP1) >> #methodDefinedInP1.
	self assert: (method packageFromOrganizer: self packageClass organizer) = p1.
	method := (Smalltalk at: #A2DefinedInP2) >> #methodDefinedInP1.
	self assert: (method packageFromOrganizer: self packageClass organizer) = p1! !

!RPackageReadOnlyCompleteSetupTest methodsFor: 'test situation' stamp: 'DamienPollet 9/26/2014 16:00'!
testExtensionSelectors
	"self debug: #testDefinedSelectors"
	
	self assert: a1 extensionSelectors isEmpty.

	self assert: a2 extensionSelectors size = 2.
	self assert: (a2 extensionSelectors includes: #methodDefinedInP1).
	self assert: (a2 extensionSelectors includes: #methodDefinedInP3).! !

!RPackageReadOnlyCompleteSetupTest methodsFor: 'test compiled method' stamp: '2010-04-20T21:49:00+01:00'!
testCompiledMethodIsDefinedInPackage
	"self debug: #testCompiledMethodIsDefinedInPackage"
	
	self assert: (((Smalltalk at: #A1DefinedInP1) >> #methodDefinedInP1) isDefinedInPackage: p1).
	self deny: (((Smalltalk at: #A2DefinedInP2) >> #methodDefinedInP1) isDefinedInPackage: p1).
	! !

!RPackageReadOnlyCompleteSetupTest methodsFor: 'test accessing' stamp: '2010-04-21T17:07:00+01:00'!
testExtendingPackagesOfClass
	"since a class can be extended by several packages, we want the list of packages that extend
	the class"
	
	"self debug: #testExtendingPackagesOfClass"
		
	| packages |
	packages := a2 extendingPackages.
	"a2 is extended by p1 and p3"
	self assert: packages size = 2. 
	self assert: (packages includes: p1).
	self deny: (packages includes: p2).
	self assert: (packages includes: p3).
	
	packages := a1 extendingPackages.
	self assert: packages isEmpty. ! !

!RPackageReadOnlyCompleteSetupTest methodsFor: 'test tag class' stamp: 'CamilloBruni 8/31/2013 20:23'!
testRemoveTaggedClasses
	"self debug: #testRemoveTaggedClasses"

	p1 addClassDefinitionName: #A1DefinedInP1 toClassTag: #foo.
	p1 addClassDefinitionName: #B1DefinedInP1 toClassTag: #foo.
	p1 addClassDefinitionName: #B1DefinedInP1 toClassTag: #zork.
	self assert: (((p1 classesForClassTag: #foo) collect: #name) includes: #A1DefinedInP1).
	self assert: (((p1 classesForClassTag: #foo) collect: #name) includes: #B1DefinedInP1).
	self assert: (p1 classesForClassTag: #foo) size = 2.
	self deny: (((p1 classesForClassTag: #zork) collect: #name) includes: #A1DefinedInP1).
	self assert: (((p1 classesForClassTag: #zork) collect: #name) includes: #B1DefinedInP1).	"now when we remove a class"	"from an existing tags list"
	p1 removeClassDefinitionName: #A1DefinedInP1 fromClassTag: #foo.
	self deny: (((p1 classesForClassTag: #foo) collect: #name) includes: #A1DefinedInP1).
	self assert: (((p1 classesForClassTag: #foo) collect: #name) includes: #B1DefinedInP1).
	self assert: (p1 classesForClassTag: #foo) size = 1.	"from a nonexisting tag list"
	p1 removeClassDefinitionName: #B1DefinedInP1 fromClassTag: #taz.
	self assert: (((p1 classesForClassTag: #foo) collect: #name) includes: #B1DefinedInP1).
	self assert: (((p1 classesForClassTag: #zork) collect: #name) includes: #B1DefinedInP1).	"with a class not registered to a tag list"
	p1 removeClassDefinitionName: #Tagada fromClassTag: #foo.
	self deny: (((p1 classesForClassTag: #foo) collect: #name) includes: #A1DefinedInP1).
	self assert: (((p1 classesForClassTag: #foo) collect: #name) includes: #B1DefinedInP1).
	self assert: (p1 classesForClassTag: #foo) size = 1! !

!RPackageReadOnlyCompleteSetupTest methodsFor: 'test compiled method' stamp: '2010-03-16T17:44:00+01:00'!
testCompiledMethodIsExtensionInPackage
	"self debug: #testCompiledMethodIsExtensionInPackage"
	
	self deny: (((Smalltalk at: #A1DefinedInP1) >> #methodDefinedInP1) isExtensionInPackage: p1).
	self assert: (((Smalltalk at: #A2DefinedInP2) >> #methodDefinedInP1) isExtensionInPackage: p1).
	! !

!RPackageReadOnlyCompleteSetupTest methodsFor: 'test tag class' stamp: 'CamilloBruni 8/31/2013 20:23'!
testRemoveTag
	"self debug: #testRemoveTag"

	self assert: p1 classTags isEmpty.
	p1 addClassDefinitionName: #A1DefinedInP1 toClassTag: #foo.
	self assert: (((p1 classesForClassTag: #foo) collect: #name) includes: #A1DefinedInP1).
	self assert: (p1 classesForClassTag: #foo) size = 1.
	p1 addClassDefinitionName: #B1DefinedInP1 toClassTag: #foo.
	self assert: (((p1 classesForClassTag: #foo) collect: #name) includes: #B1DefinedInP1).
	self assert: (p1 classesForClassTag: #foo) size = 2.
	p1 removeClassTag: #bar.
	self assert: (((p1 classesForClassTag: #foo) collect: #name) includes: #B1DefinedInP1).
	self assert: (p1 classesForClassTag: #foo) size = 2.
	p1 removeClassTag: #foo.
	self deny: (((p1 classesForClassTag: #foo) collect: #name) includes: #B1DefinedInP1).
	self assert: (p1 classesForClassTag: #foo) size = 0! !

!RPackageReadOnlyCompleteSetupTest methodsFor: 'setup' stamp: 'DamienPollet 9/26/2014 15:24'!
setUp

	super setUp.
	p1 := self createNewPackageNamed: self p1Name.
	p2 := self createNewPackageNamed: self p2Name.
	p3 := self createNewPackageNamed: self p3Name.
	
	a1 := self createNewClassNamed: #A1DefinedInP1 inPackage: p1.
	b1 := self createNewClassNamed: #B1DefinedInP1 inPackage: p1.
	a2 := self createNewClassNamed: #A2DefinedInP2 inPackage: p2.
	b2 := self createNewClassNamed: #B2DefinedInP2 inPackage: p2.
	a3 := self createNewClassNamed: #A3DefinedInP3 inPackage: p3.
	
	a1 compileSilently: 'methodDefinedInP1 ^ #methodDefinedInP1'.
	p1 addMethod: (a1>>#methodDefinedInP1).
	a1 compileSilently: 'anotherMethodDefinedInP1 ^ #anotherMethodDefinedInP1'.
	p1 addMethod: (a1>>#anotherMethodDefinedInP1).
	
	a2 compileSilently: 'methodDefinedInP1 ^ #methodDefinedInP1'.
	p1 addMethod: (a2>>#methodDefinedInP1).
	
	a2 compileSilently: 'methodDefinedInP2 ^ #methodDefinedInP2'.
	p2 addMethod: (a2>>#methodDefinedInP2).
	
	a2 compileSilently: 'methodDefinedInP3 ^ #methodDefinedInP3'.
	p3 addMethod: (a2>>#methodDefinedInP3).

	a2 class compileSilently: 'classSideMethodDefinedInP3 ^ #classSideMethodDefinedInP3'.
	p3 addMethod: (a2 class>>#classSideMethodDefinedInP3).
	
! !

!RPackageReadOnlyCompleteSetupTest methodsFor: 'test tag class' stamp: 'BenjaminVanRyseghem 8/29/2012 11:48'!
testEmpty
	"self debug: #testEmpty"
	
	self assert: p1 classTags isEmpty.
	! !

!RPackageReadOnlyCompleteSetupTest methodsFor: 'test situation' stamp: '2010-04-21T15:58:00+01:00'!
testSelectorsForClass
	"self debug: #testSelectorsForClass"
	
	self assert: (p1 selectorsForClass: a1) size = 2. 
	self assert: ((p1 selectorsForClass: a1) includes: #methodDefinedInP1).
	self assert: ((p1 selectorsForClass: a1) includes: #anotherMethodDefinedInP1).
	self assert: (p1 selectorsForClass: b1) isEmpty. 
	self assert: (p1 selectorsForClass: Object) isEmpty. 
	self assert: (p1 selectorsForClass: Object class) isEmpty. 

	self assert: (p3 selectorsForClass: a2) size = 1.
	self assert: ((p3 selectorsForClass: a2) includes: #methodDefinedInP3).
	self assert: (p3 selectorsForClass: a2 class) size = 1.
	self assert:  ((p3 selectorsForClass: a2 class) includes: #classSideMethodDefinedInP3)	! !

!RPackageReadOnlyCompleteSetupTest methodsFor: 'test accessing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testExtensionMethods
	"a package can extend several classes, either the class or  the meta-class side. 'extensionMethods' should list all the methods involved in shuch extensions. P3 extend a2 and a2 class"

	"self debug: #testExtendingPackagesOfClass"

	| package extensionMethods cpt |
	package := p3.
	extensionMethods := package extensionMethods.	"self assert: (extensionMethods size = 2)."
	self assert: (extensionMethods includes: a2 >> #methodDefinedInP3).
	self assert: (extensionMethods includes: a2 class >> #classSideMethodDefinedInP3).
	cpt := 0.
	package
		metaclassExtensionSlicesDo: [ :className :listOfSelectors | 
			(className = a2 name and: [ listOfSelectors includes: #classSideMethodDefinedInP3 ])
				ifTrue: [ cpt := cpt + 1 ] ].
	self assert: cpt = 1.
	cpt := 0.
	package
		classExtensionSlicesDo: [ :className :listOfSelectors | 
			(className = a2 name and: [ listOfSelectors includes: #methodDefinedInP3 ])
				ifTrue: [ cpt := cpt + 1 ] ].
	self assert: cpt = 1! !

!RPackageReadOnlyCompleteSetupTest methodsFor: 'test situation' stamp: 'DamienPollet 9/26/2014 15:38'!
testDefinedSelectors
	"self debug: #testDefinedSelectors"
	
	self assert: a1 definedSelectors size = 2. 
	self assert: ((a1 definedSelectors) includes: #methodDefinedInP1).
	self assert: ((a1 definedSelectors) includes: #anotherMethodDefinedInP1). 

	self assert: a2 definedSelectors size = 1.
	self assert: (a2 definedSelectors includes: #methodDefinedInP2).! !

!RPackageReadOnlyCompleteSetupTest methodsFor: 'test situation' stamp: '2010-04-21T16:38:00+01:00'!
testMethods
	"self debug: #testMethods"
	
	| m1 m3 |
	m1 := p1 methods.
	self assert: m1 size = 3. 
	self assert: (m1 includes: a1>>#methodDefinedInP1).
	self assert: (m1 includes: a1>>#anotherMethodDefinedInP1). 
	self assert: (m1 includes: a2>>#methodDefinedInP1).
	m3 := p3 methods.
	self assert: m3 size = 2.
	self assert: (m3 includes: a2>>#methodDefinedInP3).
	self assert: (m3 includes: a2 class>>#classSideMethodDefinedInP3)! !

!RPackageReadOnlyCompleteSetupTest methodsFor: 'test situation' stamp: '2010-04-21T15:57:00+01:00'!
testDefinedSelectorsForClass
	"self debug: #testDefinedSelectorsForClass"
	
	self assert: (p1 definedSelectorsForClass: a1) size = 2. 
	self assert: (p1 definedMethodsForClass: a1) size = 2. 
	self assert: ((p1 definedSelectorsForClass: a1) includes: #methodDefinedInP1).
	self assert: ((p1 definedSelectorsForClass: a1) includes: #anotherMethodDefinedInP1).
	self assert: ((p1 definedMethodsForClass: a1) includes: ((Smalltalk at: #A1DefinedInP1)>>#methodDefinedInP1)).
	self assert: (p1 definedSelectorsForClass: Object) isEmpty. 
	self assert: (p1 definedSelectorsForClass: Object class) isEmpty. 
! !

!RPackageReleaseTest methodsFor: '*RPackage-Tests' stamp: 'EstebanLorenzano 2/6/2013 13:16'!
testRPackageOrganizer
	"Ensure other tests temporary created organizers are collected"
	3 timesRepeat: [ Smalltalk garbageCollect ].

	"Now check :)"
	self 
		assert: RPackageOrganizer allInstances size = 1
		description: 'There are multiple (', RPackageOrganizer allInstances size asString, ') instances of RPackageOrganizer'.
		  
	self 
		assert: RPackageOrganizer allInstances first == RPackageOrganizer default 
		description: 'The default package organizer is the not the only instance of RPackageOrganizer'.! !

!RPackageReleaseTest methodsFor: '*RPackage-Tests' stamp: 'MarcusDenker 1/28/2013 11:03'!
testUnpackagedClasses
	| unpackagedClasses |
	unpackagedClasses := Smalltalk allClassesAndTraits select: [:each | 
		(RPackageOrganizer default packageOf: each) packageName = RPackage defaultPackageName ].
	self 
		assert: unpackagedClasses isEmpty 
		description: (String streamContents: [ :s|
			s nextPutAll: 'Found the following unpackaged classes: '.
			unpackagedClasses
				do: [ :cls| s tab print: cls ]
				separatedBy: [ s cr ]])
! !

!RPackageRenameTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/14/2014 16:02'!
testUnregisterPackage
	"Test that we do rename the package as expected."
	| package workingCopy class |

	package := RPackageOrganizer default registerPackageNamed: 'Test1'.
	workingCopy := MCWorkingCopy forPackage: (MCPackage new name: 'Test1').
	class := Object
		subclass: #TestClass
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: 'Test1-TAG'.
	self assert: (package includesClass: class).
	self assert: (package classTagNamed: #TAG ifAbsent: [ nil ]) notNil.
	self assert: ((package classTagNamed: #TAG ifAbsent: [ nil ]) includesClass: class).
	self assert: workingCopy modified.
	
	package unregister.
	
	self deny: (RPackageOrganizer default includesPackageNamed: #Test1).
	self deny: (MCWorkingCopy hasPackageNamed: #Test1).
	! !

!RPackageRenameTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/15/2014 14:13'!
testRenamePackage
	"Test that we do rename the package as expected."
	| package workingCopy class |

	package := RPackageOrganizer default registerPackageNamed: 'Test1'.
	workingCopy := MCWorkingCopy forPackage: (MCPackage new name: 'Test1').
	class := Object
		subclass: #TestClass
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: 'Test1-TAG'.
	self assert: (package includesClass: class).
	self assert: (package classTagNamed: #TAG ifAbsent: [ nil ]) notNil.
	self assert: ((package classTagNamed: #TAG ifAbsent: [ nil ]) includesClass: class).
	self assert: workingCopy modified.
	package renameTo: 'TestRename'.
	self assert: (package includesClass: class).
	self assert: (package classTagNamed: #TAG ifAbsent: [ nil ]) notNil.
	self assert: ((package classTagNamed: #TAG ifAbsent: [ nil ]) includesClass: class).
	self assert: class category = #'TestRename-TAG'.	
	self deny: (Smalltalk organization includesCategory: #Test1).
	self deny: (MCWorkingCopy hasPackageNamed: #Test1).
	
	"cleaning"
	workingCopy := MCWorkingCopy forPackage: (MCPackage new name: 'TestRename').
	self assert: workingCopy modified.
	workingCopy unload.	
	self deny: (RPackageOrganizer default includesPackageNamed: #TestRename).
	self deny: (MCWorkingCopy hasPackageNamed: #TestRename).
! !

!RPackageRenameTest methodsFor: 'running' stamp: 'EstebanLorenzano 4/14/2014 16:03'!
tearDown 
	super tearDown.
	#TestClass asClassIfPresent: [ :class | class removeFromSystem ].! !

!RPackageRenameTest methodsFor: 'running' stamp: 'EstebanLorenzano 4/15/2014 15:07'!
setUp 
	super setUp.
	SystemAnnouncer restoreAllNotifications.! !

!RPackageRenamed commentStamp: '<historical>'!
I am a public announcement sent when a new RPackage is renamed!
!RPackageRenamed methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/1/2011 16:22'!
newName

	^ newName! !

!RPackageRenamed methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/1/2011 16:22'!
oldName: anObject

	oldName := anObject! !

!RPackageRenamed methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/1/2011 16:22'!
oldName

	^ oldName! !

!RPackageRenamed methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/1/2011 16:22'!
newName: anObject

	newName := anObject! !

!RPackageRenamed class methodsFor: 'instance creation' stamp: 'MarcusDenker 7/6/2014 10:24'!
to: aPackage oldName: aSymbol newName: anotherSymbol

	^ (self to: aPackage) 
		oldName: aSymbol;
		newName: anotherSymbol;
		yourself! !

!RPackageSet commentStamp: '<historical>'!
I'm a set who can be instantiated by pattern matching RPackages ("name" and "name-*").
My purpose is to provide a bridge between monticello and system packages, to allow backward compatibility with old packaging. 
!
!RPackageSet methodsFor: 'accessing' stamp: 'EstebanLorenzano 9/11/2012 15:45'!
unregister
	self packages do: #unregister! !

!RPackageSet methodsFor: 'system compatibility' stamp: 'MarcusDenker 2/7/2013 08:35'!
asRPackageSet
	^self! !

!RPackageSet methodsFor: 'private' stamp: 'EstebanLorenzano 9/12/2012 11:04'!
collectFromAllPackages: selector
	^self packages
		inject: #()
		into: [ :all :each | all, (each perform: selector) asArray ]! !

!RPackageSet methodsFor: 'initialization' stamp: 'EstebanLorenzano 1/15/2014 18:59'!
initialize: aString
	self initialize.
	packageName := aString asSymbol.
	packages := (RPackage organizer packageNamed: aString ifAbsent: [  nil ])
		ifNotNil: [ :package | { package }  ]
		ifNil: [ {} ]
! !

!RPackageSet methodsFor: 'accessing' stamp: 'EstebanLorenzano 9/11/2012 15:45'!
packages
	^packages! !

!RPackageSet methodsFor: 'private' stamp: 'EstebanLorenzano 9/12/2012 11:04'!
collectFromAllPackages: selector with: anObject
	^self packages
		inject: #()
		into: [ :all :each | all, (each perform: selector with: anObject) asArray ]! !

!RPackageSet methodsFor: 'system compatibility' stamp: 'MartinDias 11/6/2013 16:04'!
changeRecordForOverriddenMethod: aMethodDefinition
	^ SourceFiles
		changeRecordsFor: aMethodDefinition 
		detect: [ :protocol | 
			self 
				includesMethodCategory: protocol 
				ofClass: aMethodDefinition actualClass ]! !

!RPackageSet methodsFor: 'system compatibility' stamp: 'CamilloBruni 9/14/2012 00:33'!
includesMethodCategory: categoryName ofClass: aClass
	^ (self isYourClassExtension: categoryName)
		or: [(self includesClass: aClass)
				and: [(self isForeignClassExtension: categoryName) not ]]! !

!RPackageSet methodsFor: 'system compatibility' stamp: 'LucFabresse 11/29/2013 13:42'!
methodCategoryPrefix
	^ '*', self packageName asLowercase! !

!RPackageSet methodsFor: 'system compatibility' stamp: 'EstebanLorenzano 9/18/2012 12:45'!
extensionClasses
	^extensionClasses ifNil: [ extensionClasses := self collectFromAllPackages: #extensionClasses ]! !

!RPackageSet methodsFor: 'accessing' stamp: 'EstebanLorenzano 9/11/2012 15:45'!
packageName
	^packageName! !

!RPackageSet methodsFor: 'system compatibility' stamp: 'EstebanLorenzano 9/18/2012 12:44'!
classesAndMetaClasses
	^classesAndMetaClasses ifNil: [ 
		classesAndMetaClasses := self collectFromAllPackages: #classesAndMetaClasses ]! !

!RPackageSet methodsFor: 'system compatibility' stamp: 'EstebanLorenzano 9/18/2012 12:46'!
overriddenMethods
	^overriddenMethods ifNil: [ overriddenMethods := self collectFromAllPackages: #overriddenMethods ]! !

!RPackageSet methodsFor: 'system compatibility' stamp: 'EstebanLorenzano 9/11/2012 15:43'!
coreCategoriesForClass: aClass
	^self collectFromAllPackages: #coreCategoriesForClass: with: aClass! !

!RPackageSet methodsFor: 'testing' stamp: 'EstebanLorenzano 9/11/2012 15:44'!
includesClass: aClass
	^self packages anySatisfy: [ :each | each includesClass: aClass ]! !

!RPackageSet methodsFor: 'system compatibility' stamp: 'EstebanLorenzano 9/11/2012 15:44'!
includesSystemCategory: categoryName
	^self packages anySatisfy: [ :each | 
		each includesSystemCategory: categoryName ]! !

!RPackageSet methodsFor: 'accessing' stamp: 'EstebanLorenzano 12/20/2013 12:03'!
categoryNames
	^  self packages 	
		inject:  #()
		into: [ :all :each | all, (each classTagCategoryNames asArray) ]! !

!RPackageSet methodsFor: 'accessing' stamp: 'EstebanLorenzano 9/18/2012 12:44'!
methods
	^methods ifNil: [ methods := (self collectFromAllPackages: #methods) collect: #asRingDefinition ]! !

!RPackageSet methodsFor: 'system compatibility' stamp: 'EstebanLorenzano 9/18/2012 12:45'!
systemCategories
	^systemCategories ifNil: [ systemCategories := (self collectFromAllPackages: #systemCategories) asSet asArray].
	! !

!RPackageSet methodsFor: 'system compatibility' stamp: 'CamilloBruni 9/14/2012 00:29'!
isForeignClassExtension: categoryName
	^ categoryName first = $* and: [(self isYourClassExtension: categoryName) not]! !

!RPackageSet methodsFor: 'accessing' stamp: 'EstebanLorenzano 9/18/2012 12:43'!
definedClasses
	^definedClasses ifNil: [ definedClasses := self collectFromAllPackages: #definedClasses ]! !

!RPackageSet methodsFor: 'system compatibility' stamp: 'CamilloBruni 9/14/2012 00:28'!
isYourClassExtension: categoryName
	^ categoryName notNil and: [self category: categoryName asLowercase matches: self methodCategoryPrefix]! !

!RPackageSet methodsFor: 'accessing' stamp: 'EstebanLorenzano 9/18/2012 12:43'!
classes
	^classes ifNil: [ classes := self collectFromAllPackages: #definedClasses ]! !

!RPackageSet methodsFor: 'system compatibility' stamp: 'EstebanLorenzano 9/11/2012 15:44'!
includesMethodReference: aMethodReference
	^self packages anySatisfy: [ :each | 
		each includesMethodReference: aMethodReference ]! !

!RPackageSet methodsFor: 'system compatibility' stamp: 'CamilloBruni 9/14/2012 00:29'!
category: categoryName matches: prefix
	^ RPackageOrganizer default category: categoryName matches: prefix! !

!RPackageSet methodsFor: 'accessing' stamp: 'EstebanLorenzano 9/18/2012 12:43'!
extensionMethods
	^extensionMethods ifNil: [
		extensionMethods := ((self collectFromAllPackages: #extensionMethods) collect: #asRingDefinition) asSet asArray ]! !

!RPackageSet methodsFor: 'system compatibility' stamp: 'EstebanLorenzano 9/19/2012 15:31'!
extensionCategoriesForClass: aClass
	^ aClass organization categories select: [:cat | self isYourClassExtension: cat]! !

!RPackageSet class methodsFor: 'accessing' stamp: 'EstebanLorenzano 7/19/2013 16:12'!
withCacheDo: aBlock 
	| oldActive |
	
	oldActive := self isCacheActive.
	self cacheActive: true.
	aBlock ensure: [ 
		self cacheActive: oldActive.
		self isCacheActive ifFalse: [ self resetCache ] ].! !

!RPackageSet class methodsFor: 'private' stamp: 'EstebanLorenzano 7/19/2013 16:01'!
cachePackageAt: aString ifAbsentPut: aBlock
	"self addCount: aString."
	^ self cachePackages 
		at: aString asSymbol
		ifAbsentPut: aBlock! !

!RPackageSet class methodsFor: 'instance creation' stamp: 'EstebanLorenzano 7/19/2013 16:09'!
named: aString

	^ self isCacheActive 
		ifTrue: [ 
			self 
				cachePackageAt: aString 
				ifAbsentPut: [ self basicNamed: aString ] ]
		ifFalse: [ self basicNamed: aString ].
! !

!RPackageSet class methodsFor: 'private' stamp: 'EstebanLorenzano 7/19/2013 16:02'!
resetCache 
	cachePackages := nil.! !

!RPackageSet class methodsFor: 'testing' stamp: 'EstebanLorenzano 7/19/2013 16:00'!
isCacheActive 
	^ cacheActive ifNil: [ cacheActive := false ].! !

!RPackageSet class methodsFor: 'private' stamp: 'EstebanLorenzano 7/21/2014 13:28'!
basicNamed: aString
	^ self basicNew 
		initialize: aString;
		yourself! !

!RPackageSet class methodsFor: 'private' stamp: 'EstebanLorenzano 7/19/2013 16:01'!
cachePackages 
	^ cachePackages ifNil: [ cachePackages := IdentityDictionary new ]! !

!RPackageSet class methodsFor: 'private' stamp: 'EstebanLorenzano 7/19/2013 16:01'!
cacheActive: aBoolean 
	cacheActive := aBoolean! !

!RPackageStringExtensionTest methodsFor: 'tests' stamp: 'TudorGirba 2/17/2015 09:07'!
testAsPackageIfAbsent
	self assert: ('___inexistent___package___' asPackageIfAbsent: [ true ])! !

!RPackageStringExtensionTest methodsFor: 'tests' stamp: 'TudorGirba 2/17/2015 09:05'!
testAsPackage
	self assert: self class package name asPackage notNil! !

!RPackageStringExtensionTest methodsFor: 'tests' stamp: 'TudorGirba 2/17/2015 09:05'!
testAsPackageWithError
	self 
		should: ['___inexistent___package___' asPackage]
		raise: NotFound
	! !

!RPackageTag commentStamp: 'MartinWalk 7/12/2014 17:09'!
I'm a class tag for an RPackage. 
Class tags can be any kind of metadata the user needs, but they are for now equivalent to class categories. !
!RPackageTag methodsFor: 'testing' stamp: 'EstebanLorenzano 12/12/2013 17:36'!
isRoot
	^ self name = self packageName! !

!RPackageTag methodsFor: '*Nautilus' stamp: 'EstebanLorenzano 10/14/2013 13:23'!
asNautilusSelection 
	^ PackageTreeTagSelection tag: self! !

!RPackageTag methodsFor: 'accessing' stamp: 'EstebanLorenzano 1/16/2014 10:38'!
ensureSystemCategory 
	SystemOrganization addCategory: self categoryName! !

!RPackageTag methodsFor: 'testing' stamp: 'EstebanLorenzano 11/29/2013 12:58'!
includesMethodCategory: aProtocol ofClass: aClass 
	^ self package 
		includesMethodCategory: aProtocol 
		ofClass: aClass ! !

!RPackageTag methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/24/2015 14:46'!
spotterClassesFor: aStep
	<spotterOrder: 20>
	aStep listProcessor
			allCandidates: [ self classes sorted: [ :a :b | a name < b name ] ];
			title: 'Classes';
			filter: GTFilterSubstring! !

!RPackageTag methodsFor: '*Manifest-Core' stamp: 'GuillermoPolito 4/9/2015 20:56'!
manifestBuilderForRuleChecker: aRuleChecker
	"Return the manifestsince the rulechecker is keeping a cache, we ask it back"

	^ aRuleChecker manifestBuilderOfPackage: self package! !

!RPackageTag methodsFor: 'testing' stamp: 'EstebanLorenzano 10/16/2013 16:18'!
hasClassNamed: aSymbol 
	^ self classNames includes: aSymbol! !

!RPackageTag methodsFor: 'initialization' stamp: 'EstebanLorenzano 10/10/2013 14:10'!
initialize 
	super initialize.
	classNames := Set new.! !

!RPackageTag methodsFor: 'testing' stamp: 'EstebanLorenzano 11/29/2013 12:57'!
includesSelector: aSelector ofClass: aClass
	^ self package 
		includesSelector: aSelector 
		ofClass: aClass! !

!RPackageTag methodsFor: 'printing' stamp: 'MartinWalk 7/12/2014 16:58'!
printOn: aStream 
	super printOn: aStream.
	aStream nextPut: $(.
	aStream nextPutAll: self name.
	aStream nextPut: $)! !

!RPackageTag methodsFor: 'accessing' stamp: 'EstebanLorenzano 1/16/2014 11:08'!
addClassNamed: aSymbol 
	(classNames includes: aSymbol) ifTrue: [ ^ self ].
	^ classNames add: aSymbol.! !

!RPackageTag methodsFor: 'accessing' stamp: 'ThierryGoubier 1/25/2014 21:22'!
addClass: aClass
	aClass category: self categoryName! !

!RPackageTag methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/10/2013 14:11'!
classNames 
	^ classNames! !

!RPackageTag methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/10/2013 16:06'!
package 
	^ package! !

!RPackageTag methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/16/2013 15:08'!
packageName 
	^ self package name! !

!RPackageTag methodsFor: 'accessing' stamp: 'EstebanLorenzano 11/27/2013 14:29'!
extensionClasses 
	^ #()! !

!RPackageTag methodsFor: 'testing' stamp: 'EstebanLorenzano 10/16/2013 16:17'!
hasClass: aClass 
	^  self hasClassNamed: aClass name! !

!RPackageTag methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/10/2013 14:11'!
removeClass: aClass
	^ self removeClassNamed: aClass name.! !

!RPackageTag methodsFor: 'testing' stamp: 'EstebanLorenzano 1/12/2014 23:06'!
includesClass: aClass 
	^ self hasClassNamed: aClass name! !

!RPackageTag methodsFor: '*Nautilus' stamp: 'EstebanLorenzano 11/27/2013 13:19'!
asNautilusNodeWithModel: anObject
	^ PackageTreeTagNodeModel with: self model: anObject.! !

!RPackageTag methodsFor: 'accessing' stamp: 'EstebanLorenzano 12/13/2013 15:30'!
renameTo: aString category: categoryName
	| oldName |
	
	oldName := self toCategoryName: self name.
	oldName = categoryName ifTrue: [ ^ self ].
	
	self basicRenameTo: aString.
	SystemAnnouncer uniqueInstance suspendAllWhile: [
		self classes do: [ :each | each category: categoryName ].
		self class environment organization 
			renameCategory: oldName 
			toBe: categoryName. ].! !

!RPackageTag methodsFor: '*Nautilus' stamp: 'JurajKubelka 2/3/2015 23:26'!
asNautilusItemPath
	^ 	Array 
			with: self package
			with: self.
! !

!RPackageTag methodsFor: 'testing' stamp: 'EstebanLorenzano 10/16/2013 16:34'!
isEmpty
	^ self classNames isEmpty! !

!RPackageTag methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/10/2013 14:11'!
removeClassNamed: aSymbol 
	^ classNames remove: aSymbol ifAbsent: [].! !

!RPackageTag methodsFor: 'updating' stamp: 'MarcusDenker 7/6/2014 10:21'!
updateDefinedClassNamed: oldString withNewName: newString
	(self hasClassNamed: oldString)
		ifFalse: [ ^ self ].
	self removeClassNamed: oldString.
	self addClassNamed: newString! !

!RPackageTag methodsFor: 'private ' stamp: 'EstebanLorenzano 10/16/2013 15:36'!
basicRenameTo: aString
	name := aString.! !

!RPackageTag methodsFor: 'accessing' stamp: 'EstebanLorenzano 12/12/2013 17:34'!
categoryName 
	"Answer this tag as a SystemCategory. 
    That would be RPackage, '-', RPackageTag, unless tag is root (same name as RPackage)"
	^ self toCategoryName: self name
! !

!RPackageTag methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/10/2013 14:12'!
classes
	^ self classNames collect: [ :each | self class environment at: each ]! !

!RPackageTag methodsFor: 'accessing' stamp: 'EstebanLorenzano 12/18/2013 17:06'!
removeFromPackage
	self 
		assert: self isEmpty 
		description: 'Package tag is not empty'.
		
	self package basicRemoveTag: self.! !

!RPackageTag methodsFor: 'converting' stamp: 'EstebanLorenzano 2/22/2014 12:13'!
promoteAsRPackage
	"This method converts this rpackage tag into an rpackage, removes the tag from the parent package with all classes included and registers the new package in the system.
	The tag has to be removed before registering to avoid conflicts.
	Smells like we could have an error and lose package tags!! registerPackage should not fail because names Package-Tag are unique in the system."
	| newRPackage |
	
	newRPackage := self asRPackage.
	self classes do: [ :each | self package removeClass: each  ].
	self package removeClassTag: self name.
	self package removeMethods: newRPackage extensionMethods.
	RPackage organizer registerPackage: newRPackage.
	
	newRPackage classes do: [ :each | 
		SystemAnnouncer uniqueInstance 
			classRepackaged: each 
			from: self package
			to:  newRPackage ].! !

!RPackageTag methodsFor: 'initialization' stamp: 'EstebanLorenzano 10/10/2013 15:54'!
initializePackage: aPackage name: aString 
	package := aPackage.
	name := aString.
	self initialize.! !

!RPackageTag methodsFor: 'accessing' stamp: 'NicolaiHess 1/1/2014 23:42'!
orderedClasses
^ self package orderedClasses select:[:c | c category = self categoryName]! !

!RPackageTag methodsFor: '*Nautilus' stamp: 'NicolaiHess 7/30/2014 13:40'!
withClassesIn: aRBBrowserEnvironment createHierarchySorter: aClass 
	self shouldBeImplemented.! !

!RPackageTag methodsFor: 'private ' stamp: 'EstebanLorenzano 2/14/2014 15:29'!
asRPackage
	"Create a new RPackage with the same contents as this rpackage tag"
	| newRPackage |
	
	newRPackage := RPackage named: self categoryName.
	self classes 
		do: [ :className | newRPackage importClass: className ].
	(self package extensionsForTag: self) 
		do: [ :extensionMethod | newRPackage addMethod: extensionMethod ].
	
	^ newRPackage! !

!RPackageTag methodsFor: 'accessing' stamp: 'EstebanLorenzano 12/13/2013 15:21'!
renameTo: aString 
	| oldName categoryName |
	
	oldName := self toCategoryName: self name.
	categoryName := self toCategoryName: aString. 
	
	oldName = categoryName ifTrue: [ ^ self ].
	
	self basicRenameTo: aString.
	SystemAnnouncer uniqueInstance suspendAllWhile: [
		self classes do: [ :each | each category: categoryName ].
		self class environment organization 
			renameCategory: oldName 
			toBe: categoryName. ].! !

!RPackageTag methodsFor: 'private ' stamp: 'EstebanLorenzano 12/12/2013 17:36'!
toCategoryName: aString 
	^ aString = self packageName
		ifTrue: [ aString ]
		ifFalse: [ self packageName, '-', aString ]! !

!RPackageTag methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/10/2013 13:51'!
name 
	^ name! !

!RPackageTag methodsFor: 'file in/out' stamp: 'EstebanLorenzano 1/15/2014 11:36'!
fileOut
	| internalStream |
	
	internalStream := (String new: 1000) writeStream.
	
	SystemOrganization 
		fileOutCategory: self categoryName 
		on: internalStream.
		
	^ FileStream writeSourceCodeFrom: internalStream baseName: self name isSt: true.! !

!RPackageTag methodsFor: 'accessing' stamp: 'EstebanLorenzano 1/12/2014 23:05'!
extensionCategoriesForClass: aClass 
	^ self package extensionCategoriesForClass: aClass! !

!RPackageTag methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 11/6/2014 14:16'!
gtInspectorDefinedClassesIn: composite
	<gtInspectorPresentationOrder: 30>
	composite list
		title: 'Classes';
		display: #classes;
		format: #gtDisplayString! !

!RPackageTag class methodsFor: 'instance creation' stamp: 'EstebanLorenzano 10/10/2013 15:55'!
package: aPackage name: aString 
	^ self basicNew 
		initializePackage: aPackage name: aString;
		yourself! !

!RPackageTag class methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/26/2015 17:51'!
gtExamplePackageTag
	<gtExample: 'Tag'>
	^ (RPackageOrganizer default packageOf: GTSpotter) classTags anyOne! !

!RPackageTag class methodsFor: 'instance creation' stamp: 'EstebanLorenzano 10/10/2013 15:55'!
new 
	self error: 'Use #package:name:'! !

!RPackageTagTest commentStamp: 'TorstenBergmann 2/12/2014 23:00'!
SUnit tests for RPackage tags!
!RPackageTagTest methodsFor: 'tests' stamp: 'GuillermoPolito 2/14/2014 13:09'!
testAsRPackage
	| package1 tag convertedTag class |

	package1 := (RPackage named: #Test1) register.
	class := self createNewClassNamed: 'TestClass' inCategory: 'Test1-TAG1'.
	class compile: 'foo ^42' classified: 'accessing'.
	
	tag := (package1 classTagNamed: #TAG1).
	
	convertedTag := tag asRPackage.
	
	self assert: (convertedTag includesClass: class).
	self assert: (convertedTag includesSelector: 'foo' ofClass:  class).! !

!RPackageTagTest methodsFor: 'tests' stamp: 'GuillermoPolito 2/14/2014 14:17'!
testAsRPackageWithExtensionMethods
	| package1 convertedTag class  |

	package1 := (RPackage named: #Test1) register.
	package1 addClassTag: #TAG1.
	
	(RPackage named: #Test2) register.
	class := self createNewClassNamed: 'TestClass' inCategory: 'Test2'.
	
	class compile: 'foo ^42' classified: '*Test1-TAG1'.
	
	convertedTag := (package1 classTagNamed: #TAG1) asRPackage.
	
	self assert: (convertedTag definedClasses isEmpty).
	self assert: (convertedTag includesExtensionSelector: 'foo' ofClass:  class).! !

!RPackageTagTest methodsFor: 'tests' stamp: 'EstebanLorenzano 2/25/2014 13:49'!
testPromoteAsRPackageWithExtension
	| packageOriginal packagePromoted class classOther tag |

	packageOriginal := (RPackage named: #Test1) register.
	class := self createNewClassNamed: 'TestClass' inCategory: 'Test1-TAG1'.
	class compile: 'foo ^42' classified: #'accessing'.

	classOther := self createNewClassNamed: 'TestClassOther' inCategory: 'XXXX'.
	classOther compile: 'bar ^42' classified: #'*Test1-TAG1'.

	tag := packageOriginal classTagNamed: 'TAG1'.
	tag promoteAsRPackage.

	packagePromoted:= RPackage organizer packageNamed: 'Test1-TAG1'.	
	self assert: packagePromoted notNil. 
	self assert: (packagePromoted classes includes: class).
	self assert: (packagePromoted extensionMethods includes: classOther>>#bar).	
	self assert: (classOther>>#bar) protocol equals: '*Test1-TAG1'. 
	self deny: (packageOriginal classes includes: class).
	self deny: (packageOriginal extensionMethods includes: classOther>>#bar)
	! !

!RPackageTagTest methodsFor: 'tests' stamp: 'EstebanLorenzano 1/24/2014 18:14'!
testAddClassFromTag
	| package1 package2 class |

	package1 := (RPackage named: #Test1) register.
	class := self createNewClassNamed: 'TestClass' inCategory: 'Test1-TAG1'.
	
	self assert: (package1 includesClass: class).
	self assert: (package1 classTagNamed: #TAG1 ifAbsent: [ nil ]) notNil.
	self assert: ((package1 classTagNamed: #TAG1 ifAbsent: [ nil ]) includesClass: class).
	
	package2 := (RPackage named: #Test2) register.
	
	(package2 addClassTag: #TAG2) addClass: class.
	
	self deny: (package1 includesClass: class).
	self assert: (package2 includesClass: class).	
	self assert: (package2 classTagNamed: #TAG2 ifAbsent: [ nil ]) notNil.
	self assert: ((package2 classTagNamed: #TAG2 ifAbsent: [ nil ]) includesClass: class).

	
! !

!RPackageTagTest methodsFor: 'running' stamp: 'EstebanLorenzano 2/22/2014 11:05'!
tearDown 
	super tearDown.
	#(TestClass TestClassOther) 
		do: [ :each | each asClassIfPresent: #removeFromSystem ]! !

!RPackageTagTest methodsFor: 'tests' stamp: 'EstebanLorenzano 2/22/2014 12:04'!
testPromoteAsRPackage
	| package1 package2 class tag1 |

	package1 := (RPackage named: #Test1) register.
	class := self createNewClassNamed: 'TestClass' inCategory: 'Test1-TAG1'.
	class compile: 'foo ^42' classified: 'accessing'.

	tag1 := package1 classTagNamed: 'TAG1'.
	
	tag1 promoteAsRPackage.

	package2:= RPackage organizer packageNamed: 'Test1-TAG1'.	
	self assert: package2 notNil. 
	self assert: (package2 classes includes: class).
	self deny: (package1 classes includes: class).! !

!RPackageTagTest methodsFor: 'tests' stamp: 'EstebanLorenzano 1/24/2014 18:12'!
testAddClass
	| package1 package2 class |

	package1 := (RPackage named: #Test1) register.
	class := self createNewClassNamed: 'TestClass' inCategory: 'Test1'.
	
	self assert: (package1 includesClass: class).
	
	package2 := (RPackage named: #Test2) register.
	
	(package2 addClassTag: #TAG) addClass: class.
	
	self deny: (package1 includesClass: class).
	self assert: (package2 includesClass: class).	
	self assert: (package2 classTagNamed: #TAG ifAbsent: [ nil ]) notNil.
	self assert: ((package2 classTagNamed: #TAG ifAbsent: [ nil ]) includesClass: class).

	
! !

!RPackageTest commentStamp: 'TorstenBergmann 2/12/2014 23:01'!
SUnit tests for RPackage !
!RPackageTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/15/2014 15:05'!
testRenameToMakesMCDirty
	| package |
	
	package := (RPackage named: #'Test1') register.
	self createNewClassNamed: 'TestClass' inCategory: 'Test1'.
	
	package renameTo: 'Test2'.
	
	! !

!RPackageTest methodsFor: 'tests' stamp: 'EstebanLorenzano 2/21/2014 11:36'!
testDemoteToRPackageNamedMultilevelPackage1
	| package1 package2  class  |

	package1 := (RPackage named: #'Test1-TAG1-X1') register.
	class := self createNewClassNamed: 'TestClass' inCategory: 'Test1-TAG1-X1'.
	class compile: 'foo ^42' classified: 'accessing'.

	package1 demoteToRPackageNamed: 'Test1'.

	self deny: (RPackage organizer includesPackage: package1).
	package2 := RPackage organizer packageNamed: 'Test1'.
	self assert: package2 notNil. 
	self assert: (package2 classes includes: class).
	self assert: ((package2 classTagNamed: 'TAG1-X1') classes includes: class).! !

!RPackageTest methodsFor: 'tests' stamp: 'EstebanLorenzano 2/25/2014 13:49'!
testDemoteToRPackageNamedWithExtension
	| packageOriginal packageDemoted class classOther |

	packageOriginal := (RPackage named: #'Test1-TAG1') register.
	class := self createNewClassNamed: 'TestClass' inCategory: 'Test1-TAG1'.
	class compile: 'foo ^42' classified: 'accessing'.

	classOther := self createNewClassNamed: 'TestClassOther' inCategory: 'XXXX'.
	classOther compile: 'bar ^42' classified: #'*Test1-TAG1'.

	packageOriginal demoteToRPackageNamed: 'Test1'.

	self deny: (RPackage organizer includesPackage: packageOriginal).
	packageDemoted := RPackage organizer packageNamed: 'Test1'.
	self assert: packageDemoted notNil. 
	self assert: (packageDemoted classes includes: class).
	self assert: ((packageDemoted classTagNamed: 'TAG1') classes includes: class).
	self assert: (packageDemoted extensionMethods includes: classOther>>#bar).	
	self assert: ((classOther>>#bar) protocol) equals: '*Test1-TAG1'.
	self assert: (packageDemoted classes	includesAll: {class. classOther}).
! !

!RPackageTest methodsFor: 'tests' stamp: 'EstebanLorenzano 1/24/2014 18:15'!
testAddClassFromTag
	| package1 package2 class |

	package1 := (RPackage named: #Test1) register.
	class := self createNewClassNamed: 'TestClass' inCategory: 'Test1-TAG'.
	
	self assert: (package1 includesClass: class).
	
	package2 := (RPackage named: #Test2) register.
	
	package2 addClass: class.
	
	self deny: (package1 includesClass: class).
	self assert: (package2 includesClass: class).	
	self assert: (package2 classTagNamed: #Test2 ifAbsent: [ nil ]) notNil.
	self assert: ((package2 classTagNamed: #Test2 ifAbsent: [ nil ]) includesClass: class).

	
! !

!RPackageTest methodsFor: 'running' stamp: 'EstebanLorenzano 2/22/2014 11:22'!
tearDown 
	super tearDown.
	#(TestClass TestClassOther) 
		do: [ :each | each asClassIfPresent: #removeFromSystem ]! !

!RPackageTest methodsFor: 'tests' stamp: 'EstebanLorenzano 2/21/2014 11:36'!
testDemoteToRPackageNamedExistingPackage
	| package1 package2 packageExisting class  |

	package1 := (RPackage named: #'Test1-TAG1') register.
	packageExisting := (RPackage named: #'Test1') register.
	class := self createNewClassNamed: 'TestClass' inCategory: 'Test1-TAG1'.
	class compile: 'foo ^42' classified: 'accessing'.

	package1 demoteToRPackageNamed: 'Test1'.

	self deny: (RPackage organizer includesPackage: package1).
	package2 := RPackage organizer packageNamed: 'Test1'.
	self assert: package2 notNil. 
	self assert: package2 equals: packageExisting. 
	self assert: (package2 classes includes: class).
	self assert: ((package2 classTagNamed: 'TAG1') classes includes: class).! !

!RPackageTest methodsFor: 'tests' stamp: 'EstebanLorenzano 3/19/2014 17:07'!
testAnonymousClassAndSelector
	"jgeidel test case from issue 12628."

	"Make sure we don't have a registration or a package for the method."

	| ghost method uPackage |
	ghost := Object newAnonymousSubclass.
	uPackage := self organizer packageNamed: #'_UnpackagedPackage'.
	method := ghost compiler compile: 'rpackagetest'.
	ghost addSelector: #rpackagetest withMethod: method.
	self deny: (uPackage includesDefinedSelector: #rpackagetest ofClass: ghost).
	self deny: (self organizer packageOfClassNamed: ghost name) notNil.
	ghost organization classify: #rpackagetest under: '*rpackagetest'! !

!RPackageTest methodsFor: 'tests' stamp: 'BernardoContreras 10/26/2014 22:32'!
testAddClass
	| package1 package2 class done |

	package1 := (RPackage named: #Test1) register.
	done := 0.
	class := self createNewClassNamed: 'TestClass' inCategory: 'Test1-TAG'.
	SystemAnnouncer uniqueInstance when: ClassRecategorized do: [ done := done + 1].
	
	self assert: (package1 includesClass: class).
	self assert: (package1 classTagNamed: #TAG ifAbsent: [ nil ]) notNil.
	self assert: ((package1 classTagNamed: #TAG ifAbsent: [ nil ]) includesClass: class).
	
	package2 := (RPackage named: #Test2) register.
	
	package2 addClass: class.
	
	self assert: done = 1.
	self deny: (package1 includesClass: class).
	self assert: (package2 includesClass: class).	
	self assert: (package2 classTagNamed: #Test2 ifAbsent: [ nil ]) notNil.
	self assert: ((package2 classTagNamed: #Test2 ifAbsent: [ nil ]) includesClass: class).! !

!RPackageTest methodsFor: 'tests' stamp: 'EstebanLorenzano 2/21/2014 11:35'!
testDemoteToRPackageNamedMultilevelPackage2
	| package1 package2  class  |

	package1 := (RPackage named: #'Test1-TAG1-X1') register.
	class := self createNewClassNamed: 'TestClass' inCategory: 'Test1-TAG1-X1'.
	class compile: 'foo ^42' classified: 'accessing'.

	package1 demoteToRPackageNamed: 'Test1-TAG1'.

	self deny: (RPackage organizer includesPackage: package1).
	package2 := RPackage organizer packageNamed: 'Test1-TAG1'.
	self assert: package2 notNil. 
	self assert: (package2 classes includes: class).
	self assert: ((package2 classTagNamed: 'X1') classes includes: class).! !

!RPackageTest methodsFor: 'tests' stamp: 'EstebanLorenzano 2/21/2014 11:35'!
testDemoteToRPackageNamed
	| package1 package2 class  |

	package1 := (RPackage named: #'Test1-TAG1') register.
	class := self createNewClassNamed: 'TestClass' inCategory: 'Test1-TAG1'.
	class compile: 'foo ^42' classified: 'accessing'.

	package1 demoteToRPackageNamed: 'Test1'.

	self deny: (RPackage organizer includesPackage: package1).
	package2 := RPackage organizer packageNamed: 'Test1'.
	self assert: package2 notNil. 
	self assert: (package2 classes includes: class).
	self assert: ((package2 classTagNamed: 'TAG1') classes includes: class).! !

!RPackageTestCase commentStamp: 'TorstenBergmann 2/12/2014 22:58'!
Common superclass for RPackage related tests!
!RPackageTestCase methodsFor: 'accessing' stamp: 'StephaneDucasse 6/3/2012 22:44'!
packageClass 
	"returns the system class that represents Packages"
	^ RPackage ! !

!RPackageTestCase methodsFor: 'announcer handling' stamp: 'EstebanLorenzano 8/3/2012 14:24'!
initializeAnnouncers
	oldSystemAnnouncer := SystemAnnouncer uniqueInstance.

	SystemAnnouncer announcer: (announcerForTest := SystemAnnouncer new).! !

!RPackageTestCase methodsFor: 'utils' stamp: 'StephaneDucasse 6/2/2012 19:43'!
allManagers

	^ MCWorkingCopy allManagers! !

!RPackageTestCase methodsFor: 'running' stamp: 'GuillermoPolito 7/23/2012 13:45'!
runCase
	[
	self initializeAnnouncers.
	
	^ self packageClass 
		withOrganizer: self setupOrganizer
		do: [ 
			self resources do: [:each | each availableFor: self].
			self setUp.
			self performTest
			]
	] ensure: [ 
		self tearDown.
		self restoreAnnouncers.
		self cleanUpInstanceVariables
	]! !

!RPackageTestCase methodsFor: 'announcer handling' stamp: 'EstebanLorenzano 8/3/2012 14:23'!
restoreAnnouncers
	SystemAnnouncer announcer: oldSystemAnnouncer.
! !

!RPackageTestCase methodsFor: 'utility' stamp: 'CamilloBruni 9/5/2012 14:27'!
createNewClassNamed: aName
	^ self createNewClassNamed: aName inCategory: 'RPackageTest'! !

!RPackageTestCase methodsFor: 'accessing' stamp: 'StephaneDucasse 6/3/2012 22:44'!
organizer
	"This method will access the organizer that will temporarily swapped using the withOrganizer:do: method"
	^ self packageClass organizer! !

!RPackageTestCase methodsFor: 'utility' stamp: 'CamilloBruni 9/5/2012 14:27'!
createNewClassNamed: aName inCategory: cat
	
	| cls |
	cls := Object subclass: aName
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: cat.
	createdClasses add: cls.
	createdCategories add: cat.
	^ cls! !

!RPackageTestCase methodsFor: 'running' stamp: 'CamilloBruni 9/5/2012 14:28'!
setUp
	
	createdClasses := OrderedCollection new.
	createdPackages := OrderedCollection new.
	createdCategories := Set new.! !

!RPackageTestCase methodsFor: 'accessing' stamp: 'StephaneDucasse 6/3/2012 23:25'!
setupOrganizer
	^ self packageOrganizerClass basicNew initialize; debuggingName: 'Organizer for RPackageTest'; yourself! !

!RPackageTestCase methodsFor: 'utility' stamp: 'CamilloBruni 9/5/2012 14:27'!
createNewPackageNamed: aName

	| pack |
	self removePackage: aName.
	pack := self packageClass named: aName.
	createdPackages add: pack.
	^ pack! !

!RPackageTestCase methodsFor: 'utility' stamp: 'CamilloBruni 9/5/2012 14:27'!
createNewTraitNamed: aName inCategory: cat
	
	| cls |
	cls := Trait named: aName
			uses: {}
			category: cat.
	createdClasses add: cls.
	createdCategories add: cat.
	^ cls! !

!RPackageTestCase methodsFor: 'utility' stamp: 'CamilloBruni 9/5/2012 14:27'!
createNewTraitNamed: aName
	^ self createNewTraitNamed: aName inCategory: 'RPackageTest'! !

!RPackageTestCase methodsFor: 'utility' stamp: 'CamilloBruni 9/5/2012 14:27'!
createNewTraitNamed: aName inPackage: p
	
	| cls |
	cls := self createNewTraitNamed: aName.
	p addClassDefinition: cls.
	^ cls! !

!RPackageTestCase methodsFor: 'accessing' stamp: 'StephaneDucasse 6/3/2012 23:25'!
packageOrganizerClass 
	"returns the package organizer class"
	^ RPackageOrganizer! !

!RPackageTestCase methodsFor: 'utility' stamp: 'CamilloBruni 9/5/2012 14:27'!
createNewClassNamed: aName inPackage: p
	
	| cls |
	cls := self createNewClassNamed: aName.
	p addClassDefinition: cls.
	^ cls! !

!RPackageTestCase methodsFor: 'utility' stamp: 'CamilloBruni 9/5/2012 14:41'!
removePackage: aName
	self packageClass organizer basicUnregisterPackageNamed: aName.
	! !

!RPackageTraitSynchronisationTest commentStamp: 'TorstenBergmann 2/12/2014 23:00'!
SUnit tests for RPackage trait synchronization
!
!RPackageTraitSynchronisationTest methodsFor: 'tests - operations on methods' stamp: 'GuillermoPolito 9/5/2012 14:25'!
testTraitCompositionMethodsArePackagedWithTheirTraits
	"test that when we remove a class method coming from a trait, the method is not removed from the parent package of the trait"
	
	|XPackage YPackage class trait|
	self addXCategory.
	self addYCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage := self organizer packageNamed: #YYYYY.
	
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	trait := self createNewTraitNamed: 'NewTrait' inCategory: 'YYYYY'.
	
	self createMethodNamed: 'stubMethod' inClass: trait  inCategory: 'classic protocol'. 
	class setTraitComposition: trait asTraitComposition.
	
	self assert: (YPackage includesDefinedSelector: #stubMethod ofClass: trait). 
	self deny: (XPackage includesDefinedSelector: #stubMethod ofClass: class).! !

!RPackageTraitSynchronisationTest methodsFor: 'tests - operations on methods' stamp: 'MartinDias 2/11/2013 14:21'!
testRemoveTraitMethodOverridenByClassDoesRemoveMethodFromClassPackage
	"test that when we remove a class method overriding the one from a trait, the method is removed from the class package"
	
	|XPackage YPackage class trait|
	self addXCategory.
	self addYCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage := self organizer packageNamed: #YYYYY.
	
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	trait := self createNewTraitNamed: 'NewTrait' inCategory: 'YYYYY'.
	
	self createMethodNamed: 'stubMethod' inClass: trait  inCategory: 'classic protocol'. 
	class setTraitComposition: trait asTraitComposition.
	self createMethodNamed: 'stubMethod' inClass: class  inCategory: 'classic protocol'. 
	
	class removeSelector: #stubMethod.
	self deny: (XPackage includesDefinedSelector: #stubMethod ofClass: class). ! !

!RPackageTraitSynchronisationTest methodsFor: 'tests - operations on methods' stamp: 'GuillermoPolito 9/5/2012 14:26'!
testRemoveTraitMethod
	"test that when we remove a method from a trait used by a class, the method is removed from the trait package normally"
	
	|XPackage YPackage class trait|
	self addXCategory.
	self addYCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage := self organizer packageNamed: #YYYYY.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	trait := self createNewTraitNamed: 'NewTrait' inCategory: 'YYYYY'.
	self createMethodNamed: 'stubMethod' inClass: trait  inCategory: 'classic protocol'. 
	class setTraitComposition: trait asTraitComposition.
	
	trait removeSelector: #stubMethod.
	self deny: (YPackage includesSelector: #stubMethod ofClass: trait). 
	self deny: (XPackage includesSelector: #stubMethod ofClass: class).! !

!RPackageTraitSynchronisationTest methodsFor: 'tests - operations on traits' stamp: 'GuillermoPolito 9/5/2012 12:44'!
testAddTraitUpdateTheOrganizerMappings
	"test that when we add a Trait, the organizer 'classPackageMapping' dictionary is updated, so that the trait is linked to its package and so that we can access its owning package"
	"self debug: #testAddClassUpdateTheOrganizer"
	|tmpPackage class|
	self addXCategory.
	
	tmpPackage := self organizer packageNamed: #XXXXX.
	class := self createNewTraitNamed: 'NewClass' inCategory: 'XXXXX'.
	 
	self assert: class package equals: tmpPackage! !

!RPackageTraitSynchronisationTest methodsFor: 'tests - operations on traits' stamp: 'EstebanLorenzano 10/8/2013 13:10'!
testAddTraitAddItIntoPackageBestMatchName
	"self debug: #testAddTraitAddItIntoPackageBestMatchName"

	|tmpPackage class|
	self addXCategory.
	self addXMatchCategory.
	
	tmpPackage := self organizer packageNamed: #'XXXXX'.
	class := self createNewTraitNamed: 'NewClass' inCategory: 'XXXXX-YYYY'.

	self assert: (tmpPackage definesClass: class).
	self assert: tmpPackage equals: class package.! !

!RPackageTraitSynchronisationTest methodsFor: 'tests - operations on methods' stamp: 'GuillermoPolito 9/5/2012 14:24'!
testRemoveMethodComingFromTraitDoesNotRemoveMethodFromTraitPackage
	"test that when we remove a class method coming from a trait, the method is not removed from the parent package of the trait"
	
	|XPackage YPackage class trait|
	self addXCategory.
	self addYCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage := self organizer packageNamed: #YYYYY.
	
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	trait := self createNewTraitNamed: 'NewTrait' inCategory: 'YYYYY'.
	
	self createMethodNamed: 'stubMethod' inClass: trait  inCategory: 'classic protocol'. 
	class setTraitComposition: trait asTraitComposition.
	
	class removeSelector: #stubMethod.
	self assert: (YPackage includesDefinedSelector: #stubMethod ofClass: trait). 
	self deny: (XPackage includesDefinedSelector: #stubMethod ofClass: class). ! !

!RPackageTraitSynchronisationTest methodsFor: 'tests - operations on methods' stamp: 'GuillermoPolito 9/5/2012 12:38'!
testAddMethodByUsingATraitDoesNotAddTheMethodToThePackage
	"test that when a method is added to a class bu using a trait, this method is not imported in the parent package of the class"
	"self debug: #testAddMethodByUsingATraitDoesNotAddTheMethodToThePackage"
	
	|XPackage YPackage class trait|
	self addXCategory.
	self addYCategory.
	XPackage := self organizer packageNamed: #XXXXX.
	YPackage := self organizer packageNamed: #YYYYY.
	trait := self createNewTraitNamed: 'NewTrait' inCategory: 'YYYYY'.
	class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'.
	self createMethodNamed: 'stubMethod' inClass:  trait inCategory: 'trait category'.
	
	self assert: (XPackage methods isEmpty ).
	self deny: (YPackage methods isEmpty ).
	class addToComposition: trait.
	self assert: (YPackage includesDefinedSelector: #stubMethod ofClass: trait).
	self assert: (XPackage methods isEmpty).
		! !

!RPackageTraitSynchronisationTest methodsFor: 'tests - operations on traits' stamp: 'GuillermoPolito 9/5/2012 12:42'!
testAddTraitAddItIntoPackageExactName
	"self debug: #testAddTraitAddItIntoPackageExactName"

	|tmpPackage class|
	self addXCategory.
	self addXMatchCategory.

	tmpPackage := self organizer packageNamed: #XXXXX.
	class := self createNewTraitNamed: 'NewClass' inCategory: 'XXXXX'.

	self assert: (tmpPackage definesClass: class).
	self assert: tmpPackage equals: class package.! !

!RPackageTraitTest commentStamp: 'TorstenBergmann 2/12/2014 22:59'!
SUnit tests for RPackage!
!RPackageTraitTest methodsFor: 'tests' stamp: 'StephaneDucasse 5/10/2011 10:24'!
testStartingSituation
	"self debug: #testStartingSituation"


.	self deny: (p5 includesClass: a1).
	self assert: (p4 includesClass: a1).
	self assert: (p4 includesClass: t1).
	self assert: (p4 definesOrExtendsClass: a1).
	self assert: (p5 includesClass: t2).! !

!RPackageTraitTest methodsFor: 'tests' stamp: 'StephaneDucasse 6/3/2012 23:26'!
testPackageOfTraitMethodIsTraitPackage
	"The package of a trait method is the package of its trait."

	self assert: ((a1 >> #traitMethodDefinedInP5) packageFromOrganizer: self packageClass organizer) = p5.
	self assert: ((a1 >> #traitMethodDefinedInP5)packageFromOrganizer: self packageOrganizerClass default) = p5.
	self assert: ((a1>>#traitMethodDefinedInP4) packageFromOrganizer: self packageClass organizer) = p4.! !

!RPackageTraitTest methodsFor: 'setup' stamp: 'StephaneDucasse 5/9/2011 16:42'!
p4Name

	^ 'RPackageTestP4'! !

!RPackageTraitTest methodsFor: 'setup' stamp: 'cyrilledelaunay 5/10/2011 12:50'!
p6Name

	^ 'RPackageTestP6'! !

!RPackageTraitTest methodsFor: 'tests' stamp: 'StephaneDucasse 6/3/2012 23:26'!
testPackageOfClassMethodFromTraitIsTraitPackage

	"test that a class method coming from a trait is packaged in the trait package"
	self assert: ((a1>>#traitMethodDefinedInP4) packageFromOrganizer: self packageClass organizer) = p4.
	self assert: ((a1>>#traitMethodDefinedInP5) packageFromOrganizer: self packageOrganizerClass default) = p5.! !

!RPackageTraitTest methodsFor: 'setup' stamp: 'StephaneDucasse 5/9/2011 16:43'!
p5Name

	^ 'RPackageTestP5'! !

!RPackageTraitTest methodsFor: 'tests' stamp: 'StephaneDucasse 6/3/2012 23:26'!
testPackageOfClassMethodIsClassPackage
	"The package of a local method (not defined in a trait) is the package of its class"
	
	self assert: ((a1>>#localMethodDefinedInP1) packageFromOrganizer: self packageClass organizer) = p4.
	self assert: ((a1>>#anotherLocalMethodDefinedInP1) packageFromOrganizer: self packageOrganizerClass default) = p4.
	self assert: ((a1>>#anotherLocalMethodDefinedInP1) packageFromOrganizer: self packageClass organizer) = p4.! !

!RPackageTraitTest methodsFor: 'tests' stamp: 'StephaneDucasse 6/3/2012 22:47'!
testPackageOfClassMethodFromTraitExtensionIsExtendingPackage
	"The package of a method defined in atrait but package in another package than the extended trait is the 
	package containing the extension."
	
	"The package of a method in A1 (which is coming from the trait T1 used by A1) is the package of T1"
	self assert: ((a1>>#traitMethodExtendedFromP4) packageFromOrganizer: self packageClass organizer) = p4.
	"The package of a method in A1 (which is coming from the trait T1 used by A1 but extended in package T2) is the package of T2"
	self assert: ((a1>>#traitMethodExtendedFromP6) packageFromOrganizer: self packageClass organizer) = p6.! !

!RPackageTraitTest methodsFor: 'setup' stamp: 'cyrilledelaunay 5/13/2011 12:55'!
setUp

	super setUp.
	
	p4 := self createNewPackageNamed: self p4Name.  
	p5 := self createNewPackageNamed: self p5Name. 
	p6 := self createNewPackageNamed: self p6Name.  
	
	a1 :=  self createNewClassNamed: #A1DefinedInP1 inPackage: p4.
	
	"a1 defines two normal = local methods"
	a1 compileSilently: 'localMethodDefinedInP1 ^ #methodDefinedInP1'.
	p4 addMethod: (a1>>#localMethodDefinedInP1).
	a1 compileSilently: 'anotherLocalMethodDefinedInP1 ^ #anotherMethodDefinedInP1'.
	p4 addMethod: (a1>>#anotherLocalMethodDefinedInP1).
	
	t1 := self createNewTraitNamed: #TraitInPackageP4 inPackage: p4.
	t1 compileSilently: 'traitMethodDefinedInP4 ^ #traitMethodDefinedInP4'.
	p4 addMethod: (t1>>#traitMethodDefinedInP4).
	
	"P6 defines a new method extension on T1 (packaged in p4)"
	t1 compileSilently: 'traitMethodExtendedFromP6 ^ #traitMethodExtendedFromP6' classified: ('*',self p6Name). 
	p6 addMethod: (t1>>#traitMethodExtendedFromP6).
	
	t2 := self createNewTraitNamed: #TraitInPackageP5 inPackage: p5.
	t2 compileSilently: 'traitMethodDefinedInP5 ^ #traitMethodDefinedInP5'.
	
	p5 addMethod: (t2 >> #traitMethodDefinedInP5).  
	
	"Here P4 extends T2 from P5 with a new method"
	t2 compileSilently: 'traitMethodExtendedFromP4 ^ #traitMethodExtendedFromP4' classified: ('*',self p4Name). 
	p4 addMethod: (t2 >> #traitMethodExtendedFromP4).
	
	a1 setTraitComposition: (t1 + t2) asTraitComposition.
	
	"a2 compileSilently: 'methodDefinedInP1 ^ #methodDefinedInP1'.
	p1 addMethod: (a2>>#methodDefinedInP1).
	
	a2 compileSilently: 'methodDefinedInP2 ^ #methodDefinedInP2'.
	p2 addMethod: (a2>>#methodDefinedInP2).
	
	a2 compileSilently: 'methodDefinedInP3 ^ #methodDefinedInP3'.
	p3 addMethod: (a2>>#methodDefinedInP3).

	a2 class compileSilently: 'classSideMethodDefinedInP3 ^ #classSideMethodDefinedInP3'.
	p3 addMethod: (a2 class>>#classSideMethodDefinedInP3)."
	! !

!RPackageUnregistered commentStamp: '<historical>'!
I am a public announcement sent when a new RPackage is unregistred ( kind  of removed from the system )!
!RPackageWithDoTest commentStamp: 'TorstenBergmann 2/12/2014 23:01'!
SUnit tests for RPackage!
!RPackageWithDoTest methodsFor: 'tests' stamp: 'StephaneDucasse 6/3/2012 22:49'!
packageClass
	^ RPackage! !

!RPackageWithDoTest methodsFor: 'accessing' stamp: 'EstebanLorenzano 8/3/2012 14:24'!
announcer
	^ SystemAnnouncer uniqueInstance private! !

!RPackageWithDoTest methodsFor: 'simple ensure tests' stamp: 'sd 4/24/2011 12:26'!
doC: aBlock 
	
	x := 5.
	[aBlock value] ifCurtailed: [x :=3]! !

!RPackageWithDoTest methodsFor: 'simple ensure tests' stamp: 'sd 4/24/2011 14:20'!
testDoC
	"self run: #testDoC"
	
	[self doC: [ self error]] on: Error do: [:e|].
	"necessary for SUnit"
	self assert: x = 3
! !

!RPackageWithDoTest methodsFor: 'simple ensure tests' stamp: 'sd 4/24/2011 13:14'!
testDo2
	"self run: #testDo2"
	
	[self do: [ self error]
		] on: Error do: [:ex | ].
	self assert: x = 3
! !

!RPackageWithDoTest methodsFor: 'tests' stamp: 'EstebanLorenzano 8/3/2012 14:51'!
testWithDoIsCorrectlyReinstallingDefaultEvenIfHalt
	"self debug: #testWithDoIsCorrectlyReinstallingDefaultEvenIfHalt"
	
	| current empty |
	current := self packageOrganizerClass default.  
	empty := self packageOrganizerClass basicNew initialize.
	[ self packageClass 
		withOrganizer: empty
		do: [ 		
			self assert: (self announcer hasSubscriber: empty).
			self deny: (self announcer hasSubscriber: current).
			self error ] ]
		on: Error do: [:ex|].
	
	self assert: (self announcer hasSubscriber: current).
	self deny: (self announcer hasSubscriber: empty)
		
		


! !

!RPackageWithDoTest methodsFor: 'simple ensure tests' stamp: 'sd 4/24/2011 14:17'!
do: aBlock 

	x := 5.
	[aBlock value] ensure: [x :=3.]! !

!RPackageWithDoTest methodsFor: 'simple ensure tests' stamp: 'sd 4/24/2011 13:24'!
doOnDo: aBlock 
	
	x := 5.
	[aBlock value.
	self ensure] on: Error do:  [:ex | self ensure].! !

!RPackageWithDoTest methodsFor: 'simple ensure tests' stamp: 'sd 4/24/2011 14:20'!
testOnDo
	"self run: #testOnDo"
	
	self doOnDo: [ self error].
	self assert: x = 3.
	x := 77.
	self doOnDo: [x = 21].
	self assert: x = 3
! !

!RPackageWithDoTest methodsFor: 'tests' stamp: 'IgorStasenko 8/12/2011 16:37'!
info
	
	
	self announcer hasSubscriber: RPackageOrganizer default.
	Smalltalk garbageCollect.
	RPackageOrganizer allInstances collect: [:each | self announcer hasSubscriber: each ] ! !

!RPackageWithDoTest methodsFor: 'simple ensure tests' stamp: 'sd 4/24/2011 14:19'!
testDo
	"self run: #testDo"
	
	[self do: [ Error signal]] on:Error do: [:ex|].
	"necessary else SUnit believe that the error is not handle"
	self assert: x = 3
! !

!RPackageWithDoTest methodsFor: 'tests' stamp: 'EstebanLorenzano 8/3/2012 15:05'!
testWithDoIsCorrectlyReinstallingDefault
	"self debug: #testWithDoIsCorrectlyReinstallingDefault"
	
	| current empty |

	current := self packageOrganizerClass default.  
	empty := self packageOrganizerClass basicNew initialize.
	empty debuggingName: 'empty from PackageWithDoTest'.
	self packageClass 
		withOrganizer: empty
		do: [ 
			self assert: (self announcer hasSubscriber: empty).
			self deny: (self announcer hasSubscriber: current)].
	self assert: (self announcer hasSubscriber: current).
	self deny: (self announcer hasSubscriber: empty)! !

!RPackageWithDoTest methodsFor: 'tests' stamp: 'StephaneDucasse 6/3/2012 23:24'!
packageOrganizerClass
	^ RPackageOrganizer! !

!RPackageWithDoTest methodsFor: 'tests' stamp: 'BenjaminVanRyseghem 8/29/2012 11:49'!
testInvariant
	"The default invariant"
	"self run: #testInvariant"
	
	self assert: (self packageOrganizerClass default packageNames size > 50).
	"to be sure that this is real default one"
	self assert: (self announcer hasSubscriber: self packageOrganizerClass default).
	"note that this test is not precise enough because I could get the wrong one."
	Smalltalk garbageCollect.
	Smalltalk garbageCollect.
	self assert: self packageOrganizerClass allInstances size equals: 1.
	
	self packageOrganizerClass allInstances collect: [:each | self announcer hasSubscriber: each ] 
	"To debug..."! !

!RPackageWithDoTest methodsFor: 'simple ensure tests' stamp: 'sd 4/24/2011 13:24'!
ensure

	x := 3! !

!RWBinaryOrTextStream commentStamp: '<historical>'!
A simulation of a FileStream, but living totally in memory.  Hold the contents of a file or web page from the network.  Can then fileIn like a normal FileStream.

Need to be able to switch between binary and text, as a FileStream does, without recopying the whole collection.  Convert to binary upon input and output.  Always keep as text internally.!
!RWBinaryOrTextStream methodsFor: 'accessing' stamp: 'tk 6/20/97 19:46'!
binary
	isBinary := true! !

!RWBinaryOrTextStream methodsFor: 'accessing' stamp: 'LukasRenggli 5/8/2010 18:43'!
nextPut: charOrByte
	^ super nextPut: charOrByte asCharacter! !

!RWBinaryOrTextStream methodsFor: 'accessing' stamp: 'tk 12/13/97 13:07'!
next

	| byte |
	^ isBinary 
			ifTrue: [byte := super next.
				 byte ifNil: [nil] ifNotNil: [byte asciiValue]]
			ifFalse: [super next].
! !

!RWBinaryOrTextStream methodsFor: 'properties-setting' stamp: 'tk 10/1/1998 11:54'!
setFileTypeToObject
	"do nothing.  We don't have a file type"! !

!RWBinaryOrTextStream methodsFor: 'accessing' stamp: 'tk 6/20/97 19:47'!
isBinary
	^ isBinary! !

!RWBinaryOrTextStream methodsFor: 'accessing' stamp: 'ar 4/10/2005 19:26'!
next: anInteger 
	"Answer the next anInteger elements of my collection. Must override to get class right."

	| newArray |
	newArray := (isBinary ifTrue: [ByteArray] ifFalse: [ByteString]) new: anInteger.
	^ self nextInto: newArray! !

!RWBinaryOrTextStream methodsFor: 'positioning' stamp: 'tk 6/21/97 13:04'!
reset
	"Set the receiver's position to the beginning of the sequence of objects."

	super reset.
	isBinary ifNil: [isBinary := false].
	collection class == ByteArray ifTrue: ["Store as String and convert as needed."
		collection := collection asString.
		isBinary := true].
! !

!RWBinaryOrTextStream methodsFor: 'public' stamp: 'tk 1/14/1999 20:16'!
padToEndWith: aChar
	"We don't have pages, so we are at the end, and don't need to pad."! !

!RWBinaryOrTextStream methodsFor: 'accessing' stamp: 'tk 6/20/97 19:47'!
text
	isBinary := false! !

!RWBinaryOrTextStream methodsFor: 'writing' stamp: 'LukasRenggli 5/8/2010 18:44'!
nextPutAll: aCollection
	"Optimized for ByteArrays"
	^ aCollection class == ByteArray 
		ifTrue: [ super nextPutAll: aCollection asString ]
		ifFalse: [ super nextPutAll: aCollection ]! !

!RWBinaryOrTextStream methodsFor: 'writing' stamp: 'DamienCassou 9/7/2009 19:26'!
upTo: anObject 
	"Answer a subcollection from the current access position to the 
	occurrence (if any, but not inclusive) of anObject in the receiver. If 
	anObject is not in the collection, answer the entire rest of the receiver."
	| newStream element species |
	species := isBinary ifTrue:[ByteArray] ifFalse:[String].
	newStream := WriteStream on: (species new: 100).
	[self atEnd or: [(element := self next) = anObject]]
		whileFalse: [newStream nextPut: element].
	^newStream contents! !

!RWBinaryOrTextStream methodsFor: 'converting' stamp: 'tk 6/25/97 13:22'!
ascii
	isBinary := false! !

!RWBinaryOrTextStream methodsFor: 'converting' stamp: 'tk 2/4/2000 09:15'!
asBinaryOrTextStream

	^ self! !

!RWBinaryOrTextStream methodsFor: 'accessing' stamp: 'ar 4/10/2005 19:27'!
upToEnd
	"Must override to get class right."
	| newArray |
	newArray := (isBinary ifTrue: [ByteArray] ifFalse: [ByteString]) new: self size - self position.
	^ self nextInto: newArray! !

!RWBinaryOrTextStream methodsFor: 'accessing' stamp: 'ls 3/27/2000 22:24'!
next: n into: aCollection startingAt: startIndex
	"Read n objects into the given collection. 
	Return aCollection or a partial copy if less than n elements have been read."
	"Overriden for efficiency"
	| max |
	max := (readLimit - position) min: n.
	aCollection 
		replaceFrom: startIndex 
		to: startIndex+max-1
		with: collection
		startingAt: position+1.
	position := position + max.
	max = n
		ifTrue:[^aCollection]
		ifFalse:[^aCollection copyFrom: 1 to: startIndex+max-1]! !

!RWBinaryOrTextStream methodsFor: 'accessing' stamp: 'tk 6/21/97 12:49'!
contents
	"Answer with a copy of my collection from 1 to readLimit."

	| newArray |
	isBinary ifFalse: [^ super contents].	"String"
	readLimit := readLimit max: position.
	newArray := ByteArray new: readLimit.
	^ newArray replaceFrom: 1
		to: readLimit
		with: collection
		startingAt: 1.! !

!RWBinaryOrTextStream methodsFor: 'writing' stamp: 'DamienCassou 9/7/2009 19:25'!
next: anInteger putAll: aCollection startingAt: startIndex
	"Optimized for ByteArrays"
	aCollection class == ByteArray 
		ifTrue:[^super next: anInteger putAll: aCollection asString startingAt: startIndex].
	^super next: anInteger putAll: aCollection startingAt: startIndex! !

!RWBinaryOrTextStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/26/2011 09:30'!
readInto: aCollection startingAt: startIndex count: n
	"Read n objects into the given collection. 
	Return number of elements that have been read."
	"Overriden for efficiency"
	| max |
	max := (readLimit - position) min: n.
	aCollection 
		replaceFrom: startIndex 
		to: startIndex + max - 1
		with: collection
		startingAt: position + 1.
	position := position + max.
	^ max! !

!RadialGradientPaint commentStamp: '<historical>'!
I represent a radial gradient paint.

The center point and radius defining a circle where gradient will be drawn in user space coordinates.

The gradient's ramp color at 0 maps to the focal point and ramp color at 1 maps to the edge of the circle,
interpolating colors in between.

Also check the comment of my superclass to know better how and when you can use me.
!
!RadialGradientPaint methodsFor: 'accessing' stamp: 'IgorStasenko 4/12/2013 09:23'!
radius: aNumber

	radius := aNumber! !

!RadialGradientPaint methodsFor: 'accessing' stamp: 'IgorStasenko 4/12/2013 09:26'!
focalPoint
	
	^ focalPoint! !

!RadialGradientPaint methodsFor: 'accessing' stamp: 'IgorStasenko 4/12/2013 09:22'!
center: aPoint

	center := aPoint! !

!RadialGradientPaint methodsFor: 'accessing' stamp: 'IgorStasenko 4/12/2013 09:26'!
radius
	
	^ radius! !

!RadialGradientPaint methodsFor: 'accessing' stamp: 'IgorStasenko 4/12/2013 09:26'!
center
	
	^ center! !

!RadialGradientPaint methodsFor: 'accessing' stamp: 'IgorStasenko 4/12/2013 09:24'!
focalPoint: aPoint

	focalPoint := aPoint! !

!RadialGradientPaint methodsFor: 'converting' stamp: 'IgorStasenko 4/12/2013 09:33'!
asAthensPaintOn: aCanvas
	^ aCanvas surface
		createRadialGradient:  colorRamp
		center: center
		radius: radius
		focalPoint: focalPoint ! !

!RadioButtonGroup commentStamp: '<historical>'!
A RadioButtonGroup is a group for radio buttons which ensure that only radio button of this group is activated at the same time.!
!RadioButtonGroup methodsFor: 'protocol' stamp: ''!
default: aButton

	aButton privateSetState: true.
	aButton takeKeyboardFocus.! !

!RadioButtonGroup methodsFor: 'protocol' stamp: ''!
addRadioButton: aButton

	buttons do: [:b | 
		aButton whenActivatedDo: [ b privateSetState: false ].
		b whenActivatedDo: [ aButton privateSetState: false ]].
		
	buttons add: aButton.
	aButton privateSetState: false! !

!RadioButtonGroup methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 23:07'!
initialize

	super initialize.

	buttons := OrderedCollection new.! !

!RadioButtonGroupExample commentStamp: '<historical>'!
A RadioButtonGroupExample is an simple example about how to use RadioButtons and RadioGroup!
!RadioButtonGroupExample methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/1/2013 15:11'!
container

	^ container asSpecAdapter! !

!RadioButtonGroupExample methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/1/2012 17:52'!
button1

	^ button1! !

!RadioButtonGroupExample methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 6/12/2012 19:29'!
instantiateButtons

	! !

!RadioButtonGroupExample methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 2/2/2012 00:56'!
setActionsForButton3

	button3 whenActivatedDo: [ container addMorph: morph3 ].
	button3 whenDesactivatedDo: [ container removeMorph: morph3 ]! !

!RadioButtonGroupExample methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 2/2/2012 00:56'!
setActionsForButton2

	button2 whenActivatedDo: [ container addMorph: morph2 ].
	button2 whenDesactivatedDo: [ container removeMorph: morph2 ]! !

!RadioButtonGroupExample methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 2/2/2012 01:00'!
instantiateMorphs

	morph1 := Morph new
					color: Color red;
					width: 60;
					height: 20.
	morph2 := Morph new
					color: Color blue;
					width: 20;
					height: 60.
	morph3 := Morph new
					color: Color green;
					width: 50;
					height: 50.! !

!RadioButtonGroupExample methodsFor: 'initialization' stamp: 'CamilloBruni 9/22/2013 21:36'!
initializeWidgets

	button1 := self newRadioButton.
	button2 := self newRadioButton.
	button3 := self newRadioButton.
	
	button1 label: 'Button 1'.
	button2 label: 'Button 2'.
	button3 label: 'Button 3'.
	
	self setFocus.
	self setGroup.
	! !

!RadioButtonGroupExample methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 2/2/2012 00:49'!
setGroup

	RadioButtonGroup new 
		addRadioButton: button1;
		addRadioButton: button2;
		addRadioButton: button3;
		default: button1.
	! !

!RadioButtonGroupExample methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 2/2/2012 00:50'!
setActions

	self setActionsForButton1.
	self setActionsForButton2.
	self setActionsForButton3.	! !

!RadioButtonGroupExample methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/1/2012 17:52'!
button2

	^ button2! !

!RadioButtonGroupExample methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 22:57'!
initialize

	super initialize.

	container := PanelMorph new.
	container
		changeTableLayout;
		listDirection: #bottomToLeft.
	
	self instantiateMorphs.! !

!RadioButtonGroupExample methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/1/2012 17:52'!
button3

	^ button3! !

!RadioButtonGroupExample methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 6/12/2012 19:29'!
initializePresenter

	self setActions.
	! !

!RadioButtonGroupExample methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 2/2/2012 00:47'!
setFocus
	
	self focusOrder
		add: button1;
		add: button2;
		add: button3.
	! !

!RadioButtonGroupExample methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 2/2/2012 00:56'!
setActionsForButton1

	button1 whenActivatedDo: [ container addMorph: morph1 ].
	button1 whenDesactivatedDo: [ container removeMorph: morph1 ]! !

!RadioButtonGroupExample class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/1/2013 15:11'!
defaultSpec
	<spec: #default>
	
	^ SpecLayout composed
		newRow: [ :row |
			row 
				add: #button1;
				add: #button2;
				add: #button3 ] height: self toolbarHeight;
		add: #container;
		yourself! !

!RadioButtonGroupExample class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 2/1/2012 17:51'!
title

	^ 'Radio Button Group Example'! !

!RadioButtonGroupExample class methodsFor: 'example' stamp: 'HernanMoralesDurand 2/3/2014 00:09'!
example
	"self example"

	RadioButtonGroupExample new openWithSpec.
! !

!RadioButtonModel commentStamp: '<historical>'!
A RadioButtonModel is a spec model for RadioButton

!! The method privateSetState: is really private and should only be used by RadioButtonGroup !!

You can also have a look at RadioButtonGroupExample for a full example of how to use them with a group.!
!RadioButtonModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 6/12/2012 13:40'!
toggleState
	"Toogle the current state of the radioButton"

	self state: self state not! !

!RadioButtonModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:43'!
state: aBoolean
	"Set if the checkbox is activated or not"
	"<api: #boolean getter: #state>"
	stateHolder value: aBoolean! !

!RadioButtonModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:36'!
whenLabelClickableChanged: aBlock
	"A block performed when the label click is activated or descativated"
	
	labelClickableHolder whenChangedDo:  aBlock ! !

!RadioButtonModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:20'!
labelClickable: aBoolean
	"<api: #boolean getter: #labelClickable registration: #whenLabelClickableChanged:>"
	"Set if the label can be clicked to select the radioButton"
	
	labelClickableHolder value: aBoolean! !

!RadioButtonModel methodsFor: 'api-valueHolder' stamp: 'StephaneDucasse 2/27/2015 21:51'!
labelHolder

	^ labelHolder	! !

!RadioButtonModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
privateSetState: aBoolean
	"Should only be used by RadioButtonGroup"
	
	stateHolder value: aBoolean.
	self changed: #state! !

!RadioButtonModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:26'!
whenChangedDo: aBlock
	"This method is used to propagate the event that I have changed"
	stateHolder whenChangedDo: aBlock! !

!RadioButtonModel methodsFor: 'api-events' stamp: 'BenjaminVanRyseghem 7/11/2012 17:13'!
whenDesactivatedDo: aBlock
	"This method is used to propagate the event that I have been desactivated"
	
	stateHolder whenChangedDo: [:bool | bool ifFalse: aBlock ]! !

!RadioButtonModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:00'!
labelClickable
	"<api: #inspect>"
	"Return true if the label can be clicked to select the radioButton"

	^ labelClickableHolder value! !

!RadioButtonModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:36'!
whenDesactivationActionChanged: aBlock
	"A block performed when the desactivation action changed"
	actionWhenDesactivatedHolder whenChangedDo:  aBlock ! !

!RadioButtonModel methodsFor: 'initialization' stamp: 'StephaneDucasse 2/27/2015 21:51'!
initialize

	super initialize.
	actionWhenActivatedHolder := [] asValueHolder.
	actionWhenDesactivatedHolder := [] asValueHolder.
	enabledHolder := true asValueHolder.
	stateHolder := false asValueHolder.
	labelClickableHolder := true asValueHolder. 
	labelHolder := '' asValueHolder.
	stateHolder whenChangedDo: [:bool |
		bool
			ifTrue: actionWhenActivatedHolder value
			ifFalse: actionWhenDesactivatedHolder value.
		self changed: #state ].
	labelClickableHolder whenChangedDo: [:aBoolean | self changed: { #labelClickable: . aBoolean } ].
	labelHolder whenChangedDo: [:label | self changed: { #label: . label } ].
	! !

!RadioButtonModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:50'!
desactivationAction: aBlock
	"<api: #block getter: #desactivationAction registration: #whenDesactivationActionChanged:>"
	"This method is used to set the action to perform when I am desactivated"
	
	actionWhenDesactivatedHolder value: aBlock! !

!RadioButtonModel methodsFor: '*Deprecated40' stamp: 'StephaneDucasse 2/27/2015 21:50'!
whenLabelChanged: aBlock
	"Set a block to performed when the text is changed"
	self deprecated: 'Instead of using aModel whenLabelChanged: aBlock, use aModel labelHolder whenChangedDo: aBlock.'.
	
	labelHolder whenChangedDo: aBlock ! !

!RadioButtonModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:17'!
label
	"<api: #inspect>"
	^ labelHolder value! !

!RadioButtonModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:06'!
state
	"<api: #inspect>"
	"Return the current state of the radio button"

	^ stateHolder value! !

!RadioButtonModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:36'!
whenActivationActionChanged: aBlock
	"A block performed when the activation action changed"
	actionWhenActivatedHolder whenChangedDo:  aBlock ! !

!RadioButtonModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:23'!
activationAction: aBlock
	"<api: #block getter: #activationAction registration: #whenActivationActionChanged:>"
	"This method is used to set the action to perform when I am activated"
	
	actionWhenActivatedHolder value: aBlock! !

!RadioButtonModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:11'!
click
	"<api: #do>"
	"Simulate a click on the radioButton.
	Used when the checkboc is a list item"

	self toggleState! !

!RadioButtonModel methodsFor: 'api-events' stamp: 'BenjaminVanRyseghem 7/11/2012 17:13'!
whenActivatedDo: aBlock
	"This method is used to propagate the event that I have been activated" 
	
	stateHolder whenChangedDo: [:bool | bool ifTrue: aBlock ]! !

!RadioButtonModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/12/2012 12:36'!
actionWhenDesactivatedHolder
	
	^ actionWhenDesactivatedHolder! !

!RadioButtonModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/12/2012 12:36'!
enabledHolder
	
	^ enabledHolder! !

!RadioButtonModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/12/2012 12:36'!
stateHolder
	
	^ stateHolder! !

!RadioButtonModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:22'!
label: aString
	"<api: #string getter: #label registration: #whenLabelChanged:>"
	"Set the label of the radioButton"

	labelHolder value: aString.! !

!RadioButtonModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/12/2012 12:36'!
actionWhenActivatedHolder
	
	^ actionWhenActivatedHolder! !

!RadioButtonModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/1/2013 13:39'!
defaultSpec
	<spec: #default>
	
	^ #(RadioButtonAdapter
		adapt: #(model))! !

!RadioButtonModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 6/12/2012 12:36'!
title

	^ 'Radio Button'! !

!RadioButtonModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/13/2014 15:24'!
adapterName

	^ #RadioButtonAdapter! !

!RaisedBorder commentStamp: 'kfr 10/27/2003 09:32'!
see BorderedMorph!
!RaisedBorder methodsFor: 'accessing' stamp: 'ar 8/25/2001 17:51'!
style
	^#raised! !

!RaisedBorder methodsFor: 'color tracking' stamp: 'ar 8/25/2001 18:17'!
trackColorFrom: aMorph
	baseColor ifNil:[self color: aMorph raisedColor].! !

!RaisedBorder methodsFor: 'accessing' stamp: 'ar 11/26/2001 15:23'!
colorsAtCorners
	| c c14 c23 |
	c := self color.
	c14 := c lighter. c23 := c darker.
	^Array with: c14 with: c23 with: c23 with: c14! !

!RaisedBorder methodsFor: 'accessing' stamp: 'gvc 1/31/2007 13:49'!
bottomRightColor
	"Changed from direct access to color since, if nil,
	self color is transparent."
	
	^width = 1 
		ifTrue: [self color twiceDarker]
		ifFalse: [self color darker]! !

!RaisedBorder methodsFor: 'accessing' stamp: 'gvc 1/31/2007 13:49'!
topLeftColor
	"Changed from direct access to color since, if nil,
	self color is transparent."

	^width = 1 
		ifTrue: [self color twiceLighter]
		ifFalse: [self color lighter]! !

!Random commentStamp: 'MarcusDenker 2/14/2010 22:27'!
This Random Number Generator graciously contributed by David N. Smith.  It is an adaptation of the Park-Miller RNG which uses Floats to avoid the need for LargeInteger arithmetic.

If you just want a quick random integer, use:
		10 atRandom
Every integer interval can give a random number:
		(6 to: 12) atRandom
SequenceableCollections can give randomly selected elements:
		'pick one of these letters randomly' atRandom
SequenceableCollections also respond to shuffled, as in:
		($A to: $Z) shuffled

The correct way to use class Random is to store one in an instance or class variable:
		myGenerator := Random new.
Then use it every time you need another number between 0.0 and 1.0 (excluding)
		myGenerator next
You can also generate a positive integer
		myGenerator nextInt: 10!
!Random methodsFor: 'initialization' stamp: 'sma 5/12/2000 12:29'!
seed: anInteger 
	seed := anInteger! !

!Random methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 10:17'!
initialize
	" Set a reasonable Park-Miller starting seed "
	super initialize.
	[seed := (Time millisecondClockValue bitAnd: 16r3FFFFFFF) bitXor: self hash.
	seed = 0] whileTrue: ["Try again if ever get a seed = 0"].

	a := 16r000041A7 asFloat.    " magic constant =      16807 "
	m := 16r7FFFFFFF asFloat.    " magic constant = 2147483647 "
	q := (m quo: a) asFloat.
	r  := (m \\ a) asFloat.
! !

!Random methodsFor: 'accessing' stamp: 'sma 5/12/2000 12:25'!
next
	"Answer a random Float in the interval [0 to 1)."

	^ (seed := self nextValue) / m! !

!Random methodsFor: 'accessing' stamp: 'sma 5/12/2000 12:46'!
next: anInteger into: anArray
	1 to: anInteger do: [:index | anArray at: index put: self next].
	^ anArray! !

!Random methodsFor: 'accessing' stamp: 'sma 5/12/2000 12:45'!
next: anInteger
	^ self next: anInteger into: (Array new: anInteger)! !

!Random methodsFor: 'private' stamp: 'sma 5/12/2000 12:43'!
seed
	^ seed! !

!Random methodsFor: 'private' stamp: 'sma 5/12/2000 12:28'!
nextValue
	"This method generates random instances of Integer 	in the interval
	0 to 16r7FFFFFFF. This method does NOT update the seed; repeated sends
	answer the same value.
	The algorithm is described in detail in 'Random Number Generators: 
	Good Ones Are Hard to Find' by Stephen K. Park and Keith W. Miller 
	(Comm. Asso. Comp. Mach., 31(10):1192--1201, 1988)."

	| lo hi aLoRHi answer |
	hi := (seed quo: q) asFloat.
	lo := seed - (hi * q).  " = seed rem: q"  
	aLoRHi := (a * lo) - (r * hi).
	answer := (aLoRHi > 0.0)
		ifTrue:  [aLoRHi]
		ifFalse: [aLoRHi + m].
	^ answer! !

!Random methodsFor: 'accessing' stamp: 'gvc 1/31/2007 13:52'!
nextInt: anInteger
	"Answer a random integer in the interval [1, anInteger].
	Handle large numbers too (for cryptography)."

	anInteger strictlyPositive ifFalse: [ self error: 'Range must be positive' ].
	anInteger asFloat isInfinite
		ifTrue: [^(self next asFraction * anInteger) truncated + 1].
	^ (self next * anInteger) truncated + 1! !

!Random class methodsFor: 'instance creation' stamp: 'nk 7/30/2004 21:51'!
seed: anInteger 
	^self new seed: anInteger! !

!Random class methodsFor: 'testing' stamp: 'nice 1/5/2010 15:59'!
bucketTest: randy
	"Execute this:   Random bucketTest: Random new"
	" A quick-and-dirty bucket test. Prints nbuckets values on the
Transcript.
	  Each should be 'near' the value of ntries. Any run with any value
'far' from ntries
	  indicates something is very wrong. Each run generates different
values.
	  For a slightly better test, try values of nbuckets of 200-1000 or
more; go get coffee.
	  This is a poor test; see Knuth.   Some 'OK' runs:
		1000 1023 998 969 997 1018 1030 1019 1054 985 1003
		1011 987 982 980 982 974 968 1044 976
		1029 1011 1025 1016 997 1019 991 954 968 999 991
		978 1035 995 988 1038 1009 988 993 976
"
	| nbuckets buckets ntrys |
	nbuckets := 20.
	buckets := Array new: nbuckets.
	buckets atAllPut: 0.
	ntrys :=  100.
	ntrys*nbuckets timesRepeat: [ | slot |
		slot := (randy next * nbuckets) floor + 1.
		buckets at: slot put: (buckets at: slot) + 1 ].
	Transcript cr.
	1 to: nbuckets do: [ :nb |
		Transcript show: (buckets at: nb) printString, ' ' ]! !

!Random class methodsFor: 'testing' stamp: ''!
theItsCompletelyBrokenTest
	"Random theItsCompletelyBrokenTest"
	"The above should print as...
	(0.149243269650845 0.331633021743797 0.75619644800024 0.393701540023881 0.941783181364547 0.549929193942775 0.659962596213428 0.991354559078512 0.696074432551896 0.922987899707159 )
	If they are not these values (accounting for precision of printing) then something is horribly wrong: DO NOT USE THIS CODE FOR ANYTHING. "
	| rng |
	rng := Random new.
	rng seed: 2345678901.
	^ (1 to: 10) collect: [:i | rng next]! !

!RandomTest commentStamp: 'TorstenBergmann 2/5/2014 08:43'!
SUnit tests for random generator!
!RandomTest methodsFor: 'running' stamp: 'md 4/2/2003 12:32'!
setUp
	gen := Random seed: 112629.! !

!RandomTest methodsFor: 'tests' stamp: 'md 4/2/2003 12:50'!
testNext

	10000 timesRepeat: [
			| next | 
			next := gen next.
			self assert: (next >= 0).
			self assert: (next < 1).
	].! !

!RangeSettingDeclaration commentStamp: 'alain.plantec 4/7/2009 23:03'!
A RangeSettingValue is a setting for which the value domain is an interval.  See SettingManager comment for more explanations.

Instance Variables
	range:		<Interval>

range
	- The interval which define the value domain
!
!RangeSettingDeclaration methodsFor: 'user interface' stamp: 'FernandoOlivero 4/12/2011 10:14'!
inputWidget
	^ (self theme newRowIn: World for: {(self theme 
							newTextEntryIn: World 
							for: self
							get: #realValue
							set: #realValue:
							class: (Smalltalk globals at: self type)
							getEnabled: #enabled
							help: nil) hResizing: #rigid;
							width: 80;
							wantsFrameAdornments: true;
							yourself. 
						(PluggableSliderMorph new max: self range last;
							 min: self range first;
							 quantum: self range increment;
							on: self
							getValue: #realValue
							setValue: #realValue:) hResizing: #spaceFill;
							 vResizing: #spaceFIll;
							 setBalloonText: self description;
							 minWidth: 300; height: 20;
							 yourself}) 
				cellInset: 10;
				yourself! !

!RangeSettingDeclaration methodsFor: 'user interface' stamp: 'alain.plantec 4/8/2009 16:57'!
hasEditableList
	^ false! !

!RangeSettingDeclaration methodsFor: 'accessing' stamp: 'AlainPlantec 1/29/2010 10:48'!
realValue: aValue
	aValue
		ifNil: [self settingReceiver perform: self setSelector with: nil]
		ifNotNil: [self settingReceiver perform: self setSelector with: ((aValue max: self range first) min: self range last)].
	self triggerEvent: self privateChangeEvent with: self
	! !

!RangeSettingDeclaration methodsFor: 'accessing' stamp: 'alain.plantec 3/3/2009 09:38'!
range: anInterval
	range := anInterval! !

!RangeSettingDeclaration methodsFor: 'accessing' stamp: 'alain.plantec 3/12/2009 16:19'!
range
	^ range ! !

!ReadStream commentStamp: '<historical>'!
I represent an accessor for a sequence of objects that can only read objects from the sequence.!
!ReadStream methodsFor: 'accessing' stamp: 'ar 11/2/1998 12:20'!
size
	"Compatibility with other streams (e.g., FileStream)"
	^readLimit! !

!ReadStream methodsFor: 'file stream compatibility' stamp: 'nk 12/13/2002 12:00'!
localName
	^'ReadStream'! !

!ReadStream methodsFor: 'accessing' stamp: 'LukasRenggli 5/8/2010 18:39'!
nextPut: anObject
	self shouldNotImplement! !

!ReadStream methodsFor: 'accessing' stamp: ''!
next
	"Primitive. Answer the next object in the Stream represented by the
	receiver. Fail if the collection of this stream is not an Array or a String.
	Fail if the stream is positioned at its end, or if the position is out of
	bounds in the collection. Optional. See Object documentation
	whatIsAPrimitive."

	<primitive: 65>
	position >= readLimit
		ifTrue: [^nil]
		ifFalse: [^collection at: (position := position + 1)]! !

!ReadStream methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 12/18/2013 13:00'!
gtInspectorStreamStateIn: composite
	<gtInspectorPresentationOrder: 50>
	(composite wrapper with: [ :w | 
		w title: 'Contents'.
		w show: [ :a | 
			a text
				display: [ self contents ];
				initialize: [ :aPresentation | 
					aPresentation selectionInterval: (1 to: self position) ] ] ])
		startOn: self! !

!ReadStream methodsFor: 'accessing' stamp: 'ls 8/16/1998 00:46'!
next: anInteger 
	"Answer the next anInteger elements of my collection.  overriden for efficiency"

	| ans endPosition |

	endPosition := position + anInteger  min:  readLimit.
	ans := collection copyFrom: position+1 to: endPosition.
	position := endPosition.
	^ans
! !

!ReadStream methodsFor: 'accessing' stamp: 'ajh 9/5/2002 22:11'!
readStream
	"polymorphic with SequenceableCollection.  Return self"

	^ self! !

!ReadStream methodsFor: 'accessing' stamp: 'nice 12/8/2009 14:22'!
upToAnyOf: aCollection do: aBlock
	"Overriden for speed"
	| end result |
	end := collection indexOfAnyOf: aCollection startingAt: 1 + position ifAbsent: [0].
	(end = 0 or: [end > readLimit]) ifTrue: [^self upToEnd].
	result := collection copyFrom: 1 + position to: -1 + end.
	position := end.
	aBlock value: (collection at: end).
	^result! !

!ReadStream methodsFor: 'private' stamp: ''!
on: aCollection from: firstIndex to: lastIndex

	| len |
	collection := aCollection.
	readLimit :=  lastIndex > (len := collection size)
						ifTrue: [len]
						ifFalse: [lastIndex].
	position := firstIndex <= 1
				ifTrue: [0]
				ifFalse: [firstIndex - 1]! !

!ReadStream methodsFor: 'accessing' stamp: 'nice 12/8/2009 15:05'!
upTo: anObject
	"fast version using indexOf:"
	| start end |

	start := position+1.
	end := collection indexOf: anObject startingAt: start ifAbsent: [ 0 ].

	"not present--return rest of the collection"	
	(end = 0 or: [end > readLimit]) ifTrue: [ ^self upToEnd ].

	"skip to the end and return the data passed over"
	position := end.
	^collection copyFrom: start to: (end-1)! !

!ReadStream methodsFor: 'accessing' stamp: ''!
ascii! !

!ReadStream methodsFor: 'accessing' stamp: 'nice 12/8/2009 15:24'!
upToEnd
	| start |
	start := 1 + position.
	position := readLimit.
	^collection copyFrom: start to: position! !

!ReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/26/2011 09:21'!
readInto: aCollection startingAt: startIndex count: n
	"Read n objects into the given collection. 
	Return number of elements that have been read."
	
	| max |
	max := (readLimit - position) min: n.
	aCollection 
		replaceFrom: startIndex 
		to: startIndex + max - 1
		with: collection
		startingAt: position + 1.
	position := position + max.
	^ max! !

!ReadStream class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/26/2015 18:14'!
gtExampleReadStreamEmpty
	<gtExample: 'Empty stream'>
	^ '' readStream! !

!ReadStream class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/26/2015 18:14'!
gtExampleReadStream
	<gtExample: 'Stream'>
	^ 'GTInspector' readStream! !

!ReadStream class methodsFor: 'instance creation' stamp: ''!
on: aCollection from: firstIndex to: lastIndex 
	"Answer with a new instance streaming over a copy of aCollection from
	firstIndex to lastIndex."

	^self basicNew
		on: aCollection
		from: firstIndex
		to: lastIndex! !

!ReadStream class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/26/2015 18:15'!
gtExampleReadStreamAtEnd
	<gtExample: 'Stream at end'>
	^ 'GTInspector' readStream 
		upToEnd;
		yourself! !

!ReadStream class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/26/2015 18:14'!
gtExampleReadStreamWithPosition
	<gtExample: 'Stream with position'>
	^ 'GTInspector' readStream 
		next; 
		next; 
		yourself! !

!ReadStreamTest commentStamp: 'tlk 12/5/2004 14:36'!
I am an SUnit test for ReadStream.
I have no test fixtures.!
!ReadStreamTest methodsFor: 'tests' stamp: 'damiencassou 11/23/2008 16:53'!
testBack
	|stream|
	stream := 'abc' readStream.
	stream setToEnd.
	self assert: stream back = $c.
! !

!ReadStreamTest methodsFor: 'tests' stamp: 'bp 10/29/2004 06:16'!
testUpToAll

	self assert: (self streamOn: 'abcdefgh' upToAll: 'cd') = 'ab'.
	self assert: (self streamOn: 'abcdefgh' upToAll: 'cd' upToAll: 'gh') = 'ef'.

	self assert: (self streamOn: '' upToAll: '') = ''.

	self assert: (self streamOn: 'a' upToAll: '') = ''.
	self assert: (self streamOn: 'a' upToAll: 'a') = ''.
	self assert: (self streamOn: 'a' upToAll: 'b') = 'a'.

	self assert: (self streamOn: 'ab' upToAll: '') = ''.
	self assert: (self streamOn: 'ab' upToAll: 'a') = ''.
	self assert: (self streamOn: 'ab' upToAll: 'b') = 'a'.
	self assert: (self streamOn: 'ab' upToAll: 'c') = 'ab'.
	self assert: (self streamOn: 'ab' upToAll: 'ab') = ''.

	self assert: (self streamOn: 'abc' upToAll: '') = ''.
	self assert: (self streamOn: 'abc' upToAll: 'a') = ''.
	self assert: (self streamOn: 'abc' upToAll: 'b') = 'a'.
	self assert: (self streamOn: 'abc' upToAll: 'c') = 'ab'.
	self assert: (self streamOn: 'abc' upToAll: 'd') = 'abc'.
	self assert: (self streamOn: 'abc' upToAll: 'ab') = ''.
	self assert: (self streamOn: 'abc' upToAll: 'bc') = 'a'.
	self assert: (self streamOn: 'abc' upToAll: 'cd') = 'abc'.
! !

!ReadStreamTest methodsFor: 'accessing - defaults' stamp: 'dc 2/27/2007 16:58'!
streamOnArray
	^ ReadStream on: (Array with: 1 with: #(a b c) with: false).! !

!ReadStreamTest methodsFor: 'tests' stamp: 'tlk 12/5/2004 14:34'!
testPositionOfSubCollection
	
	self assert: ('xyz' readStream positionOfSubCollection: 'q' ) = 0.
	self assert: ('xyz' readStream positionOfSubCollection: 'x' ) = 1.

	self assert: ('xyz' readStream positionOfSubCollection: 'y' ) = 2.
	self assert: ('xyz' readStream positionOfSubCollection: 'z' ) = 3.! !

!ReadStreamTest methodsFor: 'tests - testing' stamp: 'dc 2/27/2007 16:58'!
testIsEmpty
	| stream |
	self assert: self emptyStream isEmpty.
	
	stream := self streamOnArray.
	self deny: stream isEmpty.
	stream skip: 3.
	self deny: stream isEmpty.
	
	stream := self streamOnString.
	self deny: stream isEmpty.
	stream next;next;next.
	self deny: stream isEmpty.
	stream setToEnd.
	self deny: stream isEmpty.! !

!ReadStreamTest methodsFor: 'tests' stamp: 'damiencassou 11/23/2008 16:57'!
testPeekBack
	"Test the new implementation of the method peekBack due to changing #back."
	|stream|
	stream := 'abc' readStream.
	stream setToEnd.
	self assert: stream peekBack = $c.
! !

!ReadStreamTest methodsFor: 'accessing - defaults' stamp: 'dc 2/27/2007 16:58'!
emptyStream
	^ ReadStream on: String new.! !

!ReadStreamTest methodsFor: 'tests - accessing' stamp: 'nice 12/9/2009 13:05'!
testUpTo3
	| stream string |
	string := 'XYZabcdUVW'.
	stream := ReadStream on: string from: (string indexOf: $a) to: (string indexOf: $d).
	self assert: stream upToEnd = 'abcd'.
	self assert: stream atEnd.
	stream := ReadStream on: string from: (string indexOf: $a) to: (string indexOf: $d).
	self assert: (stream upTo: $c) = 'ab'.
	self assert: stream next = $d.
	stream := ReadStream on: string from: (string indexOf: $a) to: (string indexOf: $d).
	self assert: (stream upTo: $e) = 'abcd'.
	self assert: stream atEnd.! !

!ReadStreamTest methodsFor: 'tests' stamp: 'damiencassou 11/23/2008 16:55'!
testOldBack
	"Test the old behavior of the method back. The method #oldBack is a misconception about what a stream is. A stream contains a pointer *between* elements with past and future elements. The method #oldBack considers that the pointer is *on* an element. (Damien Cassou - 1 August 2007)"
	|stream|
	stream := 'abc' readStream.
	stream setToEnd.
	self assert: stream oldBack = $b.
! !

!ReadStreamTest methodsFor: 'accessing - defaults' stamp: 'dc 2/27/2007 16:58'!
streamOnString
	^ ReadStream on: 'abcde'.! !

!ReadStreamTest methodsFor: 'tests' stamp: 'damiencassou 5/30/2008 14:26'!
streamOn: collection upToAll: subcollection1 upToAll: subcollection2 
	^ collection readStream
		upToAll: subcollection1;
		upToAll: subcollection2! !

!ReadStreamTest methodsFor: 'tests' stamp: 'damiencassou 11/23/2008 16:54'!
testBackOnPosition1
	"Test the new implementation of the method back."
	|stream|
	stream := 'abc' readStream.
	stream next.
	self assert: stream back = $a.
! !

!ReadStreamTest methodsFor: 'tests' stamp: 'damiencassou 11/23/2008 16:56'!
testOldPeekBack
	"Test the old behavior of the method peekBack. The method #oldBack is a misconception about what a stream is. A stream contains a pointer *between* elements with past and future elements. The method #oldBack considers that the pointer is *on* an element. (Damien Cassou - 1 August 2007)"
	|stream|
	stream := 'abc' readStream.
	stream setToEnd.
	self assert: stream oldPeekBack = $b.
! !

!ReadStreamTest methodsFor: 'tests' stamp: 'damiencassou 5/30/2008 14:26'!
streamOn: collection upToAll: subcollection 
	^ collection readStream upToAll: subcollection! !

!ReadStreamTest methodsFor: 'tests' stamp: 'GabrielOmarCotelli 5/25/2010 21:22'!
testOldBackOnPosition1
	"Test the old behavior of the method back. The method #oldBack is a misconception about what a stream is. A stream contains a pointer *between* elements with past and future elements. The method #oldBack considers that the pointer is *on* an element. (Damien Cassou - 1 August 2007)"

	| stream |
	stream := 'abc' readStream.
	stream next.
	self assert: stream oldBack isNil! !

!ReadWriteStream commentStamp: '<historical>'!
I represent an accessor for a sequence of objects. My instances can both read and store objects.!
!ReadWriteStream methodsFor: 'testing' stamp: 'tk 12/2/2001 17:13'!
hash

	self class == ReadWriteStream ifFalse: [^ super hash].
	^ (self position + readLimit + 53) hash! !

!ReadWriteStream methodsFor: '*Compression' stamp: 'GabrielOmarCotelli 12/10/2013 08:39'!
asUnZippedStream
	| isGZip outputStream first strm archive |
	"Decompress this file if needed, and return a stream.  No file is written.  File extension may be .gz or anything else.  Also works on archives (.zip, .gZip)."
	strm := self binary.
	strm isZipArchive
		ifTrue: [ 
			archive := ZipArchive new readFrom: strm.
			archive members
				detect: [ :any | any fileName asLowercase endsWith: '.ttf' ]
				ifFound: [ :which | 
					strm := which contentStream.
					archive close ]
				ifNone: [ 
					archive close.
					^ self error: 'Can''t find .ttf file in archive' ] ].
	first := strm next.
	isGZip := strm next * 256 + first = GZipConstants gzipMagic.
	strm skip: -2.
	isGZip
		ifTrue: [ 
			outputStream := (MultiByteBinaryOrTextStream with: (GZipReadStream on: strm) upToEnd) reset.
			strm close ]
		ifFalse: [ outputStream := strm ].
	^ outputStream! !

!ReadWriteStream methodsFor: 'testing' stamp: 'tk 11/29/2001 12:47'!
= other

	(self class == ReadWriteStream and: [other class == ReadWriteStream]) ifFalse: [
		^ super = other].	"does an identity test.  Don't read contents of FileStream"
	^ self position = other position and: [self contents = other contents]! !

!ReadWriteStream methodsFor: 'accessing' stamp: ''!
next
	"Primitive. Return the next object in the Stream represented by the
	receiver. Fail if the collection of this stream is not an Array or a String.
	Fail if the stream is positioned at its end, or if the position is out of
	bounds in the collection. Optional. See Object documentation
	whatIsAPrimitive."

	<primitive: 65>
	"treat me as a FIFO"
	position >= readLimit
		ifTrue: [^nil]
		ifFalse: [^collection at: (position := position + 1)]! !

!ReadWriteStream methodsFor: 'accessing' stamp: 'ar 8/5/2003 02:23'!
next: anInteger 
	"Answer the next anInteger elements of my collection.  overriden for efficiency"

	| ans endPosition |
	readLimit := readLimit max: position.

	endPosition := position + anInteger  min:  readLimit.
	ans := collection copyFrom: position+1 to: endPosition.
	position := endPosition.
	^ans
! !

!ReadWriteStream methodsFor: 'converting' stamp: 'ajh 9/14/2002 20:37'!
readStream
	"polymorphic with SequenceableCollection.  Return self"

	^ self! !

!ReadWriteStream methodsFor: '*Compression' stamp: 'nk 8/21/2004 15:47'!
isZipArchive
	"Determine if this appears to be a valid Zip archive"
	| sig |
	self binary.
	sig := self next: 4.
	self position: self position - 4. "rewind"
	^ZipArchive validSignatures includes: sig! !

!ReadWriteStream methodsFor: 'accessing' stamp: ''!
name
	^ 'a stream'   "for fileIn compatibility"! !

!ReadWriteStream methodsFor: 'accessing' stamp: ''!
contents
	"Answer with a copy of my collection from 1 to readLimit."

	readLimit := readLimit max: position.
	^collection copyFrom: 1 to: readLimit! !

!ReadWriteStreamTest commentStamp: '<historical>'!
This is the unit test for the class ReadWriteStream.
Unit tests are a good way to exercise the
functionality of your system in a repeatable and
automatic manner. They are therefore recommended if
you plan to release anything. For more information,
see: 
	- http://www.c2.com/cgi/wiki?UnitTest
	- there is a chapter in the PharoByExample book (http://pharobyexample.org/)
	- the sunit class category!
!ReadWriteStreamTest methodsFor: 'tests' stamp: 'sd 6/5/2005 09:24'!
testConstructionUsingWith
	"Use the with: constructor."

	| aStream |
	aStream := ReadWriteStream with: #(1 2).
	self assert: (aStream contents = #(1 2)) description: 'Ensure correct initialization.'! !

!ReadWriteStreamTest methodsFor: 'tests' stamp: 'sd 6/5/2005 09:24'!
testNew

	self should: [ReadWriteStream new] raise: Error.! !

!ReadWriteStreamTest methodsFor: 'tests - testing' stamp: 'dc 2/27/2007 16:06'!
testIsEmpty
	| stream |
	stream := ReadWriteStream on: String new.
	self assert: stream isEmpty.
	stream nextPut: $a.
	self deny: stream isEmpty.
	stream reset.
	self deny: stream isEmpty.
	stream next.
	self deny: stream isEmpty.! !

!RealEstateAgent commentStamp: '<historical>'!
Responsible for real-estate management on the screen, which is to say, controlling where new windows appear, with what sizes, etc.  5/20/96 sw!
!RealEstateAgent class methodsFor: 'settings' stamp: 'AlainPlantec 2/25/2011 15:58'!
windowColumnsDesired
	"Answer how many separate vertical columns of windows are
	wanted."
	^ (self usedStrategy = #staggerFor:initialExtent:world:)
		ifTrue: [1]
		ifFalse: [self maximumUsableArea width > 640
				ifTrue: [2]
				ifFalse: [1]]! !

!RealEstateAgent class methodsFor: 'settings' stamp: 'alain.plantec 6/1/2008 20:02'!
screenTopSetback
	^ 0! !

!RealEstateAgent class methodsFor: 'utilities' stamp: 'AlainPlantec 10/17/2009 17:40'!
assignCollapsePointFor: aSSView 
	"Offer up a location along the left edge of the screen for a collapsed
	SSView. Make sure it doesn't overlap any other collapsed frames."
	| grid otherFrames y free topLeft viewBox |
	grid := 24.
	"should be mult of 8, since manual move is gridded by 8"
	otherFrames := ( aSSView world   windowsSatisfying: [:w | true])
				collect: [:w | w collapsedFrame]
				thenSelect: [:rect | rect notNil].
	viewBox := aSSView world viewBox.
	y := viewBox top.
	[(y := y + grid) <= (viewBox height - grid)]
		whileTrue: [topLeft := viewBox left @ y.
			free := true.
			otherFrames
				do: [:w | free := free & (topLeft ~= w topLeft)].
			free
				ifTrue: [^ topLeft]].
	"If all else fails..."
	^ 0 @ 0! !

!RealEstateAgent class methodsFor: 'utilities' stamp: 'AlainPlantec 10/17/2009 17:40'!
assignCollapseFrameFor: aSSView 
	"Offer up a location along the left edge of the screen for a collapsed
	SSView. Make sure it doesn't overlap any other collapsed frames."
	| grid otherFrames topLeft viewBox collapsedFrame extent newFrame verticalBorderDistance top |
	grid := 8.
	verticalBorderDistance := 8.
	otherFrames := ( aSSView world windowsSatisfying: [:w | w ~= aSSView])
				collect: [:w | w collapsedFrame]
				thenSelect: [:rect | rect notNil].
	viewBox := aSSView world viewBox.
	collapsedFrame := aSSView collapsedFrame.
	extent := collapsedFrame notNil
				ifTrue: [collapsedFrame extent]
				ifFalse: [aSSView getRawLabel width + aSSView labelWidgetAllowance @ (aSSView labelHeight + 2)].
	collapsedFrame notNil
		ifTrue: [(otherFrames
					anySatisfy: [:f | collapsedFrame intersects: f])
				ifFalse: ["non overlapping"
					^ collapsedFrame]].
	top := viewBox top + verticalBorderDistance.
	[topLeft := viewBox left @ top.
	newFrame := topLeft extent: extent.
	newFrame bottom <= (viewBox height - verticalBorderDistance)]
		whileTrue: [(otherFrames
					anySatisfy: [:w | newFrame intersects: w])
				ifFalse: ["no overlap"
					^ newFrame].
			top := top + grid].
	"If all else fails... (really to many wins here)"
	^ 0 @ 0 extent: extent! !

!RealEstateAgent class methodsFor: 'strategy' stamp: 'janniklaval 6/12/2010 17:19'!
standardFor: aView initialExtent: initialExtent world: aWorld

	| allOrigins screenRight screenBottom putativeOrigin putativeFrame allowedArea staggerOrigin otherFrames |
	allowedArea := self maximumUsableAreaInWorld: aWorld.
	screenRight := allowedArea right.
	screenBottom := allowedArea bottom.
	otherFrames := (aWorld
				windowsSatisfying: [:w | w isCollapsed not])
				collect: [:w | w bounds].
	allOrigins := otherFrames
				collect: [:f | f origin].
	(self standardPositionsInWorld: aWorld)
		do: [:aPosition | "First see if one of the standard positions is free"
			(allOrigins includes: aPosition)
				ifFalse: ["First see if one of the standard positions is free"
					^ (aPosition extent: initialExtent)
						translatedAndSquishedToBeWithin: allowedArea"First see if one of the standard positions is free"]].
	staggerOrigin := (self standardPositionsInWorld: aWorld) first.
	"Fallback: try offsetting from top left"
	putativeOrigin := staggerOrigin.
	[putativeOrigin := putativeOrigin + StaggerOffset.
	putativeFrame := putativeOrigin extent: initialExtent.
	putativeFrame bottom < screenBottom
		and: [putativeFrame right < screenRight]]
		whileTrue: [(allOrigins includes: putativeOrigin)
				ifFalse: [^ (putativeOrigin extent: initialExtent)
						translatedAndSquishedToBeWithin: allowedArea]].
	^ (self scrollBarSetback @ self screenTopSetback extent: initialExtent)
		translatedAndSquishedToBeWithin: allowedArea! !

!RealEstateAgent class methodsFor: 'settings' stamp: 'AlainPlantec 2/25/2011 15:58'!
usedStrategy
	^ UsedStrategy ifNil: [UsedStrategy := #staggerFor:initialExtent:world:]! !

!RealEstateAgent class methodsFor: 'framing' stamp: 'janniklaval 6/12/2010 19:03'!
initialFrameFor: aView initialExtent: initialExtent world: aWorld 
	"Find a plausible initial screen area for the supplied view, which
	should be a StandardSystemView, taking into account the
	'reverseWindowStagger' Preference, the size needed, and other
	windows currently on the screen."
	
	^self perform: self usedStrategy with: aView with: initialExtent with: aWorld
	! !

!RealEstateAgent class methodsFor: 'strategy' stamp: 'MarcusDenker 7/26/2014 12:38'!
cascadeFor: aView initialExtent: initialExtent world: aWorld

	| position allowedArea |
	allowedArea := self maximumUsableAreaInWorld: aWorld.
	position := aWorld currentWindow isMorph 
		ifFalse: [ aWorld currentHand position - 5]
		ifTrue: [ aWorld currentWindow position + 20].
	^ (position extent: initialExtent)
		translatedAndSquishedToBeWithin: allowedArea! !

!RealEstateAgent class methodsFor: 'framing' stamp: 'AlainPlantec 10/17/2009 17:41'!
strictlyStaggeredInitialFrameFor: aStandardSystemView initialExtent: initialExtent world: aWorld
	"This method implements a staggered window placement policy that I (di) like.
	Basically it provides for up to 4 windows, staggered from each of the 4 corners.
	The windows are staggered so that there will always be a corner visible."

	| allowedArea grid initialFrame otherFrames cornerSel corner delta putativeCorner free maxLevel |

	allowedArea :=(self maximumUsableAreaInWorld: aWorld)
		insetBy: (self scrollBarSetback @ self screenTopSetback extent: 0@0).
	"Number to be staggered at each corner (less on small screens)"
	maxLevel := allowedArea area > 300000 ifTrue: [3] ifFalse: [2].
	"Amount by which to stagger (less on small screens)"
	grid := allowedArea area > 500000 ifTrue: [40] ifFalse: [20].
	initialFrame := 0@0 extent: ((initialExtent
							"min: (allowedArea extent - (grid*(maxLevel+1*2) + (grid//2))))
							min: 600@400")).
	otherFrames := (aWorld windowsSatisfying: [:w | w isCollapsed not])
					collect: [:w | w bounds].
	0 to: maxLevel do:
		[:level | 
		1 to: 4 do:
			[:ci | cornerSel := #(topLeft topRight bottomRight bottomLeft) at: ci.
			corner := allowedArea perform: cornerSel.
			"The extra grid//2 in delta helps to keep title tabs distinct"
			delta := (maxLevel-level*grid+(grid//2)) @ (level*grid).
			1 to: ci-1 do: [:i | delta := delta rotateBy: #right centerAt: 0@0]. "slow way"
			putativeCorner := corner + delta.
			free := true.
			otherFrames do:
				[:w |
				free := free & ((w perform: cornerSel) ~= putativeCorner)].
			free ifTrue:
				[^ (initialFrame align: (initialFrame perform: cornerSel)
								with: putativeCorner)
						 translatedAndSquishedToBeWithin: allowedArea]]].
	"If all else fails..."
	^ (self scrollBarSetback @ self screenTopSetback extent: initialFrame extent)
		translatedAndSquishedToBeWithin: allowedArea! !

!RealEstateAgent class methodsFor: 'settings' stamp: 'MarcusDenker 5/15/2011 10:08'!
standardWindowExtent
	"Answer the standard default extent for new windows. "
	| effectiveExtent width strips height grid allowedArea maxLevel |
	effectiveExtent := self maximumUsableArea extent - (self scrollBarSetback @ self screenTopSetback).
	(self usedStrategy = #staggerFor:initialExtent:world:)
		ifTrue: ["NOTE: following copied from
			strictlyStaggeredInitialFrameFor: "
			"Number to be staggered at each corner (less on small
			screens) "
			allowedArea := self maximumUsableArea
						insetBy: (self scrollBarSetback @ self screenTopSetback extent: 0 @ 0).
			"NOTE: following copied from
			strictlyStaggeredInitialFrameFor: "
			"Number to be staggered at each corner (less on small
			screens) "
			maxLevel := allowedArea area > 300000
						ifTrue: [3]
						ifFalse: [2].
			"Amount by which to stagger (less on small screens)"
			grid := allowedArea area > 500000
						ifTrue: [40]
						ifFalse: [20].
			^ allowedArea extent - (grid * (maxLevel + 1 * 2) + (grid // 2)) max: StandardSize].
	width := (strips := self windowColumnsDesired) > 1
				ifTrue: [effectiveExtent x // strips]
				ifFalse: [3 * effectiveExtent x // 4].
	height := (strips := self windowRowsDesired) > 1
				ifTrue: [effectiveExtent y // strips]
				ifFalse: [3 * effectiveExtent y // 4].
	^ width @ height max: StandardSize "RealEstateAgent standardWindowExtent"! !

!RealEstateAgent class methodsFor: 'accessing' stamp: 'StephaneDucasse 6/12/2010 22:34'!
standardPositionsInWorld: aWorldOrNil
	"Return a list of standard window positions -- this may have one, two, or four of them, depending on the size and shape of the display screen.  "

	| anArea aList  midX midY |
	anArea := self maximumUsableAreaInWorld: aWorldOrNil.
	midX := self scrollBarSetback +   ((anArea width - self scrollBarSetback)  // 2).
	midY := self screenTopSetback + ((anArea height - self screenTopSetback) // 2).
	aList := OrderedCollection with: (self scrollBarSetback @ self screenTopSetback).
	self windowColumnsDesired > 1
		ifTrue: 	[ aList add: (midX @ self screenTopSetback)].
	self windowRowsDesired > 1
		ifTrue: 
			[ aList add: (self scrollBarSetback @ (midY+self screenTopSetback)).
			self windowColumnsDesired > 1 ifTrue:
				[ aList add: (midX @ (midY+self screenTopSetback))]].
	^ aList! !

!RealEstateAgent class methodsFor: 'accessing' stamp: 'StephaneDucasse 6/12/2010 22:35'!
standardSize: extent

	StandardSize := extent! !

!RealEstateAgent class methodsFor: 'accessing' stamp: 'IgorStasenko 12/22/2012 02:32'!
maximumUsableArea

	| allowedArea |
	allowedArea := Display usableArea.
	allowedArea := allowedArea intersect: ActiveWorld visibleClearArea ifNone: [ allowedArea ].
	^allowedArea! !

!RealEstateAgent class methodsFor: 'class initialization' stamp: 'AlainPlantec 12/14/2009 19:34'!
initialize
	"RealEstateAgent initialize"

	StaggerOffset := 20 @ 40.
	StandardSize := 700@500.! !

!RealEstateAgent class methodsFor: 'framing' stamp: 'RAA 5/25/2000 08:13'!
initialFrameFor: aView world: aWorld
	"Find a plausible initial screen area for the supplied view.  See called method."

	^ self initialFrameFor: aView initialExtent: aView initialExtent world: aWorld! !

!RealEstateAgent class methodsFor: 'strategy' stamp: 'AlainPlantec 2/25/2011 15:58'!
staggerFor: aView initialExtent: initialExtent world: aWorld

	^ self strictlyStaggeredInitialFrameFor: aView
				initialExtent: initialExtent
				world: aWorld! !

!RealEstateAgent class methodsFor: 'settings' stamp: 'AlainPlantec 9/3/2010 16:48'!
usedStrategy: aSelector
	UsedStrategy := aSelector! !

!RealEstateAgent class methodsFor: 'settings' stamp: 'AlainPlantec 2/25/2011 15:58'!
windowRowsDesired
	"Answer how many separate horizontal rows of windows are wanted."
	^ (self usedStrategy = #staggerFor:initialExtent:world:)
		ifTrue: [1]
		ifFalse: [self maximumUsableArea height > 480
				ifTrue: [2]
				ifFalse: [1]] ! !

!RealEstateAgent class methodsFor: 'settings' stamp: 'alain.plantec 6/1/2008 20:06'!
scrollBarSetback
	^ 16-3 "width = 16; inset from border by 3"
! !

!RealEstateAgent class methodsFor: 'accessing' stamp: 'IgorStasenko 12/22/2012 02:32'!
maximumUsableAreaInWorld: aWorldOrNil

	| allowedArea |
	allowedArea := Display usableArea.
	aWorldOrNil ifNotNil: [
		allowedArea := allowedArea intersect: aWorldOrNil visibleClearArea ifNone: [ allowedArea ]].
	^allowedArea! !

!RealEstateAgent class methodsFor: 'accessing' stamp: 'StephaneDucasse 6/12/2010 22:35'!
standardSize

	^ StandardSize ! !

!RecentMessageList commentStamp: 'BenjaminVanRyseghem 11/29/2010 11:31'!
MessageList is a simple object that holds a set of ordered method definitions.
See MessageList example for an example.

MessageList example

Instance Variables:
	methodReferenceList	<Collection>!
!RecentMessageList methodsFor: 'private' stamp: 'GuillermoPolito 8/3/2012 13:37'!
removeAClass: anEvent
	
	| tempList |
	tempList := self methodReferenceList select:[:each | each className = anEvent classRemoved name asSymbol].
	tempList do: [:each | self removeMethodReference: each]! !

!RecentMessageList methodsFor: 'event handler' stamp: 'BenjaminVanRyseghem 3/16/2012 04:34'!
aMethodHasBeenModified: aMethodEvent

	self addMethodReference: (self createTheMethodReference: aMethodEvent)
! !

!RecentMessageList methodsFor: 'accessing' stamp: ''!
lastEntry 

	^lastEntry! !

!RecentMessageList methodsFor: 'accessing' stamp: 'MarcusDenker 8/8/2014 14:56'!
maxListSize: aNumber

	maxListSize := aNumber negative ifTrue: [0] ifFalse:[aNumber].
	self checkSize
		ifTrue: [self updateView]! !

!RecentMessageList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/29/2010 11:25'!
methodReferenceList

	^ methodReferenceList! !

!RecentMessageList methodsFor: 'initialization' stamp: 'MarcusDenker 8/8/2014 14:58'!
initialize 
	"Initialization"
	
	super initialize.
	self clearAll.	
	self registerToAnnouncements.
	! !

!RecentMessageList methodsFor: 'accessing' stamp: 'MarcusDenker 8/8/2014 14:56'!
maxListSize

	^maxListSize ifNil: [maxListSize := self defaultMaxListSize]! !

!RecentMessageList methodsFor: 'event handler' stamp: 'BenjaminVanRyseghem 11/29/2010 11:25'!
aClassHasBeenRemoved: anEvent

	self removeAClass: anEvent! !

!RecentMessageList methodsFor: '*NautilusCommon' stamp: 'MarcusDenker 10/10/2014 08:20'!
lastClasses: anInteger

	"I return the last anInteger classes modified"
	| result tempList |
	result := WeakOrderedCollection new.
	tempList := self methodReferenceList sorted: [:a :b | a timeStamp >= b timeStamp].
	
	tempList do: [:method |
		result size = anInteger ifTrue: [ ^ result ].
		method methodClass ifNotNil:[:class | |nonMetaClass|
		nonMetaClass := method methodClass theNonMetaClass.
		(result includes: nonMetaClass) ifFalse: [ result add: nonMetaClass ]]].
	^ result! !

!RecentMessageList methodsFor: 'event handler' stamp: 'StephaneDucasse 7/26/2011 14:22'!
aClassHasBeenRenamed: anEvent

	| toChangeList |
	toChangeList := self methodReferenceList select: [:each | each className = anEvent oldName asSymbol].
	toChangeList do: [:each | each parentName: anEvent newName asSymbol].
	self updateView.! !

!RecentMessageList methodsFor: 'private' stamp: 'CamilleTeruel 9/4/2014 16:37'!
removeAMethod: aRemovedEvent
	
	| method list |
	method := aRemovedEvent method.
	list := (self methodReferenceList select: [:each |  
						each className = method methodClass name
							and:[ each name = method selector ]]).
	list do: [:each | each fullName: (each className, '>>', each selector, ' (removed)') ].
	self updateView.! !

!RecentMessageList methodsFor: 'event handler' stamp: 'MarcusDenker 8/8/2014 14:57'!
aClassHasBeenCommented: anEvent

	anEvent newStamp ifNil: [ ^self ].
	self addMethodReference: (self createAClassReference: anEvent)! !

!RecentMessageList methodsFor: 'actions' stamp: ''!
removeMethodReference: aMethodReference

	self methodReferenceList remove: aMethodReference.
	self updateView.! !

!RecentMessageList methodsFor: 'private' stamp: 'MarcusDenker 8/8/2014 14:50'!
createAClassReference: aCommentedEvent

	^RGCommentDefinition realClass: aCommentedEvent classCommented! !

!RecentMessageList methodsFor: 'event handler' stamp: 'BenjaminVanRyseghem 11/29/2010 11:25'!
aMethodHasBeenAdded: aMethodEvent

	self addMethodReference: (self createTheMethodReference: aMethodEvent)
! !

!RecentMessageList methodsFor: 'userinterface' stamp: 'MarcusDenker 8/1/2014 11:29'!
updateView
	
	self triggerEvent: #changed.! !

!RecentMessageList methodsFor: 'actions' stamp: 'BenjaminVanRyseghem 12/16/2010 15:53'!
addMethodReference: aMethodReference.

	self addMethodReferenceSilently: aMethodReference.
	self checkSize.
	self updateView! !

!RecentMessageList methodsFor: 'event handler' stamp: 'BenjaminVanRyseghem 11/29/2010 11:25'!
aMethodHasBeenRemoved: aMethodEvent

	self removeAMethod: aMethodEvent
! !

!RecentMessageList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/16/2010 15:52'!
defaultMaxListSize

	^100! !

!RecentMessageList methodsFor: 'actions' stamp: 'MarcusDenker 8/7/2014 14:56'!
addMethodReferenceSilently: aMethodReference

	self methodReferenceList add: aMethodReference.
	lastEntry := aMethodReference.! !

!RecentMessageList methodsFor: 'actions' stamp: 'GuillermoPolito 3/4/2015 16:28'!
revertLastMethodSubmission
	"If the most recent method submission was a method change, revert
	that change, and if it was a submission of a brand-new method, 
	remove that method."
	
	"self new revertLastMethodSubmission"
	| changeRecords lastSubmission theClass theSelector |
	self  methodReferenceList isEmpty ifTrue: [^ self ].
	lastSubmission := self  lastEntry.
	theClass := lastSubmission actualClass ifNil: [^ self ].
	theSelector := lastSubmission selector.
	changeRecords := theClass changeRecordsAt: theSelector.
	changeRecords isEmptyOrNil ifTrue: [^ self ].
	changeRecords size = 1
		ifTrue:
			["method has no prior version, so reverting in this case means removing"
			theClass removeSelector: theSelector]
		ifFalse:
			[changeRecords second fileIn].! !

!RecentMessageList methodsFor: 'private' stamp: 'CamilleTeruel 9/4/2014 16:30'!
createTheMethodReference: aModifiedMethodEvent
	
	| method |
	method := aModifiedMethodEvent method.

	^ (RGMethodDefinition
		realClass: method methodClass
		selector: method selector) asHistorical! !

!RecentMessageList methodsFor: 'actions' stamp: ''!
clearAll

	self methodReferenceList: OrderedCollection new.
	self updateView.! !

!RecentMessageList methodsFor: 'userinterface' stamp: 'MarcusDenker 8/7/2014 14:58'!
open
	"opens the system window for recent messages"

	^ MessageBrowser new
		topologicSort: false;
		sortingBlock: [ :a :b | a timeStamp > b timeStamp ];
		messages: methodReferenceList;
		title: 'Recenty accepted Methods' translated;
		open! !

!RecentMessageList methodsFor: 'initialization' stamp: 'BernardoContreras 10/27/2014 21:55'!
registerToAnnouncements

	SystemAnnouncer uniqueInstance unsubscribe: self.
	SystemAnnouncer uniqueInstance weak
		"Class"
		when: ClassCommented send: #aClassHasBeenCommented: to: self;
		when: ClassRemoved send: #aClassHasBeenRemoved: to: self;
		when: ClassRenamed send: #aClassHasBeenRenamed: to: self;
		"Method"
		when: MethodAdded send: #aMethodHasBeenAdded: to: self;
		when: MethodModified send: #aMethodHasBeenModified: to: self;
		when: MethodRemoved send: #aMethodHasBeenRemoved: to: self! !

!RecentMessageList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/29/2010 11:25'!
methodReferenceList: anObject

	methodReferenceList := anObject! !

!RecentMessageList methodsFor: 'actions' stamp: 'BenjaminVanRyseghem 12/16/2010 15:57'!
checkSize

	| result |
	result := false.
	self maxListSize > 0 "0 means infinite"
		ifTrue: [
			result := (self methodReferenceList size > self maxListSize).
			[self methodReferenceList size > self maxListSize]
				whileTrue: [self methodReferenceList removeFirst]].
	^result! !

!RecentMessageList class methodsFor: 'events' stamp: 'GuillermoPolito 8/21/2012 19:12'!
stopNotifications
	SystemAnnouncer uniqueInstance unsubscribe: self uniqueInstance! !

!RecentMessageList class methodsFor: 'cleanup' stamp: 'MarcusDenker 7/27/2014 08:13'!
cleanUp

	self resetUniqueInstance.! !

!RecentMessageList class methodsFor: 'instance creation' stamp: ''!
new
	^ self uniqueInstance! !

!RecentMessageList class methodsFor: 'tool registration' stamp: 'MarcusDenker 8/8/2014 14:48'!
recentMessageListMenuOn: aBuilder 
	<worldMenu> 
	
	(aBuilder item: #'Recent Messages')
		action: [self open];
		parent: #Tools;
		order: 0.50;
		help: 'Browse the last messages you''ve submitted';
		icon: self icon! !

!RecentMessageList class methodsFor: 'tool registration' stamp: 'MarcusDenker 7/27/2014 08:12'!
registerToolsOn: registry
	registry register: self as: #recentMessageList! !

!RecentMessageList class methodsFor: 'setting' stamp: 'StephaneDucasse 11/11/2014 18:48'!
recentMessageListSettingOn: aBuilder 
	<systemsettings>

	(aBuilder group: #recentMessageList)
		target: self;
		parent: #codeBrowsing;
		label: 'Recent Messages';
		description: 'Settings related to the recent messages browser';
		with: [
			(aBuilder setting: #maxListSize)
				target: self;
				targetSelector: #uniqueInstance;
				label: 'Maximum size of the methods list';
				description: 'If negative or zero, the size will be infinite. Caution : It may slow down your system' translated.
		]! !

!RecentMessageList class methodsFor: 'instance creation' stamp: 'MarcusDenker 6/11/2013 16:17'!
open
	
	self new open.! !

!RecentMessageList class methodsFor: 'instance creation' stamp: 'MarcusDenker 6/11/2013 16:17'!
uniqueInstance

	^UniqueInstance ifNil: [UniqueInstance := self basicNew initialize]! !

!RecentMessageList class methodsFor: 'instance creation' stamp: 'MarcusDenker 8/8/2014 14:53'!
resetUniqueInstance
	"Reset the singleton of the recentMessageBrowser model, so if you execute it you will lose all the history of the recent messages."
	"self resetUniqueInstance"
	
	self stopNotifications.
	self uniqueInstance triggerEvent: #reset.
	UniqueInstance := nil
	! !

!RecentMessageList class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/15/2013 13:50'!
icon 
	^ Smalltalk ui icons iconNamed: #recentMessagesIcon! !

!Rectangle commentStamp: 'StephaneDucasse 8/8/2010 18:13'!
I represent a rectangular area of the screen. Arithmetic functions take points as arguments and carry out scaling and translating operations to create new instances of me. Rectangle functions create new instances by determining intersections of rectangles with rectangles.

Note 1: only rectangles parallel to reference frame (Screen) can be represented by this class.

Note 2: the Rectangle is represented by two extremities of one diagonal. By convention, it must be the diagonal:
	from rectangle origin (the point having smallest coordinates in reference frame),
	to rectangle corner (the point having largest coordinates in reference frame).

Note 3: Screen coordinates conventions are:
	x is horizontal axis, zero at left border, oriented toward right;
	y is vertical axis, zero at top border, oriented toward bottom.
This corresponds to the latin convention for writing text from left to right and top to bottom.

Note 4: the Rectangle extent is obtained by subtracting rectangle origin to rectangle corner coordinates.
If this leads to a negative width (extent x coordinate) and/or a negative height (extent y coordinate), then the Rectangle is degenerated and considered empty.

Instance variables:
	origin	<Point> the coordinates of corner having smallest coordinates (top left in Screen coordinates)
	corner	<Point> the coordinates of corner having largest coordinates (bottom right in Screen coordinates)
!
!Rectangle methodsFor: 'rectangle functions' stamp: 'lr 7/4/2009 10:42'!
intersect: aRectangle 
	"Answer a Rectangle that is the area in which the receiver overlaps with 
	aRectangle. Optimized for speed; old code read:
		^Rectangle 
			origin: (origin max: aRectangle origin)
			corner: (corner min: aRectangle corner)
	"
	| aPoint left right top bottom |
	aPoint := aRectangle origin.
	aPoint x > origin x 
		ifTrue: [ left := aPoint x ]
		ifFalse: [ left := origin x ].
	aPoint y > origin y 
		ifTrue: [ top := aPoint y ]
		ifFalse: [ top := origin y ].
	aPoint := aRectangle corner.
	aPoint x < corner x 
		ifTrue: [ right := aPoint x ]
		ifFalse: [ right := corner x ].
	aPoint y < corner y 
		ifTrue: [ bottom := aPoint y ]
		ifFalse: [ bottom := corner y ].
	^ Rectangle 
		origin: left @ top
		corner: right @ bottom! !

!Rectangle methodsFor: '*Fuel' stamp: 'MaxLeske 10/3/2014 19:53'!
fuelSetOrigin: originPoint corner: cornerPoint
	origin := originPoint.
	corner := cornerPoint! !

!Rectangle methodsFor: 'rectangle functions' stamp: ''!
insetOriginBy: originDeltaPoint cornerBy: cornerDeltaPoint 
	"Answer a Rectangle that is inset from the receiver by a given amount in 
	the origin and corner."

	^Rectangle
		origin: origin + originDeltaPoint
		corner: corner - cornerDeltaPoint! !

!Rectangle methodsFor: 'transforming' stamp: 'CamilloBruni 8/1/2012 16:02'!
centeredBeneath: aRectangle
	 "Move the reciever so that its top center point coincides with the bottom center point of aRectangle."

	^ self align: self topCenter with: aRectangle bottomCenter! !

!Rectangle methodsFor: 'fmp' stamp: 'lr 7/4/2009 10:42'!
deltaToEnsureInOrCentered: r extra: aNumber 
	| dX dY halfXDiff halfYDiff |
	dX := dY := 0.
	halfXDiff := ((r width - self width) * aNumber) truncated.
	halfYDiff := ((r height - self height) * aNumber) truncated.
	self left < r left 
		ifTrue: [ dX := self left - r left - halfXDiff ]
		ifFalse: 
			[ self right > r right ifTrue: [ dX := self right - r right + halfXDiff ] ].
	self top < r top 
		ifTrue: [ dY := self top - r top - halfYDiff ]
		ifFalse: 
			[ self bottom > r bottom ifTrue: [ dY := self bottom - r bottom + halfYDiff ] ].
	^ dX @ dY! !

!Rectangle methodsFor: 'transforming' stamp: ''!
scaleFrom: rect1 to: rect2
	"Produce a rectangle stretched according to the stretch from rect1 to rect2"
	^ (origin scaleFrom: rect1 to: rect2)
		corner: (corner scaleFrom: rect1 to: rect2)! !

!Rectangle methodsFor: 'testing' stamp: 'md 10/2/2005 21:51'!
isRectangle
	^true! !

!Rectangle methodsFor: 'accessing' stamp: ''!
corners
	"Return an array of corner points in the order of a quadrilateral spec for WarpBlt."

	^ Array
		with: self topLeft
		with: self bottomLeft
		with: self bottomRight
		with: self topRight
! !

!Rectangle methodsFor: 'private' stamp: 'Sd 8/2/2014 16:21'!
setPoint: pt1 point: pt2

	origin := (pt1 x min: pt2 x)@(pt1 y min: pt2 y).
	corner := (pt1 x max: pt2 x)@(pt1 y max: pt2 y).
	
! !

!Rectangle methodsFor: 'rectangle functions' stamp: 'IgorStasenko 10/13/2013 16:10'!
withTop: y 
	"Return a copy of me with a different top y"
	^ origin x @ (y min: corner y) corner: corner x @ corner y! !

!Rectangle methodsFor: 'transforming' stamp: ''!
align: aPoint1 with: aPoint2 
	"Answer a Rectangle that is a translated by aPoint2 - aPoint1."

	^self translateBy: aPoint2 - aPoint1! !

!Rectangle methodsFor: '*Morphic-Base' stamp: 'MarcusDenker 9/13/2013 16:23'!
newRectButtonPressedDo: newRectBlock 
	"Track the outline of a new rectangle until mouse button changes. newFrameBlock produces each new rectangle from the previous. Only tracks while mouse is down."
	| rect newRect buttonNow hand |
	
	hand := World activeHand.
	
	buttonNow := hand anyButtonPressed.
	rect := self.
	self drawReverseFrame: rect.
		
	hand captureEventsWhile: [:evt |
		evt isMouse ifTrue: [
			buttonNow := evt anyButtonPressed.
			newRect := newRectBlock value: rect value: evt cursorPoint.
			newRect = rect ifFalse: 
				[self drawReverseFrame: rect.
				self drawReverseFrame: newRect.	
				rect := newRect ]. 

			 buttonNow 
			] ifFalse: [ true ]
		].
	
	self drawReverseFrame: rect.
	World activeHand
		newMouseFocus: nil;
		showTemporaryCursor: nil.
	^ rect! !

!Rectangle methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
innerCorners
	"Return an array of inner corner points,
	ie, the most extreme pixels included,
	in the order of a quadrilateral spec for WarpBlt"
	| r1 |
	r1 := self topLeft corner: self bottomRight - (1 @ 1).
	^ Array 
		with: r1 topLeft
		with: r1 bottomLeft
		with: r1 bottomRight
		with: r1 topRight! !

!Rectangle methodsFor: 'truncation and roundoff' stamp: 'wiz 2/12/2006 01:37'!
compressTo: grid
	"Answer a Rectangle whose origin and corner are rounded to grid x and grid y.
	Rounding is done by upper value on origin and lower value on corner so that
	rounded rectangle is inside self."

	^Rectangle origin: (origin roundUpTo: grid)
				corner: (corner roundDownTo: grid)! !

!Rectangle methodsFor: 'rectangle functions' stamp: 'lr 7/4/2009 10:42'!
pointNearestTo: aPoint 
	"Return the point on my border closest to aPoint"
	| side |
	(self containsPoint: aPoint) 
		ifTrue: 
			[ side := self sideNearestTo: aPoint.
			side == #right ifTrue: [ ^ self right @ aPoint y ].
			side == #left ifTrue: [ ^ self left @ aPoint y ].
			side == #bottom ifTrue: [ ^ aPoint x @ self bottom ].
			side == #top ifTrue: [ ^ aPoint x @ self top ] ]
		ifFalse: [ ^ aPoint adhereTo: self ]! !

!Rectangle methodsFor: 'accessing' stamp: ''!
top
	"Answer the position of the receiver's top horizontal line."

	^origin y! !

!Rectangle methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
area
	"Answer the receiver's area, the product of width and height."
	| w |
	(w := self width) <= 0 ifTrue: [ ^ 0 ].
	^ w * self height max: 0! !

!Rectangle methodsFor: 'transforming' stamp: ''!
translateBy: factor 
	"Answer a Rectangle translated by factor, a Point or a scalar."

	^Rectangle origin: origin + factor corner: corner + factor! !

!Rectangle methodsFor: 'private' stamp: 'Sd 8/2/2014 16:24'!
setLeft: left right: right top: top bottom: bottom 

	origin := (left min: right) @ (top min: bottom).
	corner := (left max: right) @ (top max: bottom).
! !

!Rectangle methodsFor: 'rectangle functions' stamp: 'bf 9/10/1999 16:16'!
withSideOrCorner: side setToPoint: newPoint minExtent: minExtent
	"Return a copy with side set to newPoint"
	^self withSideOrCorner: side setToPoint: newPoint minExtent: minExtent
		limit: ((#(left top) includes: side) ifTrue: [SmallInteger minVal] ifFalse: [SmallInteger maxVal])! !

!Rectangle methodsFor: 'truncation and roundoff' stamp: 'wiz 2/12/2006 01:37'!
compressed
	"Answer a Rectangle whose origin and corner are rounded to integers.
	Rounding is done by upper value on origin and lower value on corner so that
	rounded rectangle is inside self."

	^Rectangle origin: origin ceiling corner: corner floor! !

!Rectangle methodsFor: 'transforming' stamp: 'StephaneDucasse 8/15/2013 18:28'!
flipBy: direction centerAt: aPoint 
	"Return a copy flipped #vertical or #horizontal, about aPoint."
	^ (origin flipBy: direction centerAt: aPoint)
		rectangle: (corner flipBy: direction centerAt: aPoint)! !

!Rectangle methodsFor: 'accessing' stamp: 'StephaneDucasse 4/4/2010 15:00'!
extent
	"Answer a point with the receiver's width @ the receiver's height."

	^corner - origin! !

!Rectangle methodsFor: 'transforming' stamp: ''!
scaleBy: scale 
	"Answer a Rectangle scaled by scale, a Point or a scalar."

	^Rectangle origin: origin * scale corner: corner * scale! !

!Rectangle methodsFor: 'rectangle functions' stamp: 'ClementBera 9/30/2013 10:53'!
bordersOn: her along: herSide 
	((herSide = #right and: [self left = her right])
	or: [herSide = #left and: [self right = her left]])
		ifTrue:
		[^ (self top max: her top) < (self bottom min: her bottom)].
	((herSide = #bottom and: [self top = her bottom])
	or: [herSide = #top and: [self bottom = her top]])
		ifTrue:
		[^ (self left max: her left) < (self right min: her right)].
	^ false! !

!Rectangle methodsFor: 'rectangle functions' stamp: 'lr 7/4/2009 10:42'!
allAreasOutsideList: aCollection startingAt: startIndex do: aBlock 
	"Enumerate aBlock with all areas of the receiver not overlapping 
	any rectangle in the given collection"
	| yOrigin yCorner aRectangle index rr |
	index := startIndex.

	"Find the next intersecting rectangle from aCollection"
	
	[ index <= aCollection size ifFalse: [ ^ aBlock value: self ].
	aRectangle := aCollection at: index.
	origin <= aRectangle corner and: [ aRectangle origin <= corner ] ] whileFalse: [ index := index + 1 ].

	"aRectangle is intersecting; process it"
	aRectangle origin y > origin y 
		ifTrue: 
			[ rr := origin corner: corner x @ (yOrigin := aRectangle origin y).
			rr 
				allAreasOutsideList: aCollection
				startingAt: index + 1
				do: aBlock ]
		ifFalse: [ yOrigin := origin y ].
	aRectangle corner y < corner y 
		ifTrue: 
			[ rr := origin x @ (yCorner := aRectangle corner y) corner: corner.
			rr 
				allAreasOutsideList: aCollection
				startingAt: index + 1
				do: aBlock ]
		ifFalse: [ yCorner := corner y ].
	aRectangle origin x > origin x ifTrue: 
		[ rr := origin x @ yOrigin corner: aRectangle origin x @ yCorner.
		rr 
			allAreasOutsideList: aCollection
			startingAt: index + 1
			do: aBlock ].
	aRectangle corner x < corner x ifTrue: 
		[ rr := aRectangle corner x @ yOrigin corner: corner x @ yCorner.
		rr 
			allAreasOutsideList: aCollection
			startingAt: index + 1
			do: aBlock ]! !

!Rectangle methodsFor: 'rectangle functions' stamp: 'JuanVuletich 10/11/2010 19:51'!
quickMerge: aRectangle 
	"Answer the receiver if it encloses the given rectangle or the merge of the two rectangles if it doesn't. THis method is an optimization to reduce extra rectangle creations."
	| useRcvr rOrigin rCorner minX maxX minY maxY |
	
	aRectangle ifNil: [ ^self ].
	
	useRcvr := true.
	rOrigin := aRectangle topLeft.
	rCorner := aRectangle bottomRight.
	minX := rOrigin x < origin x 
		ifTrue: 
			[ useRcvr := false.
			rOrigin x ]
		ifFalse: [ origin x ].
	maxX := rCorner x > corner x 
		ifTrue: 
			[ useRcvr := false.
			rCorner x ]
		ifFalse: [ corner x ].
	minY := rOrigin y < origin y 
		ifTrue: 
			[ useRcvr := false.
			rOrigin y ]
		ifFalse: [ origin y ].
	maxY := rCorner y > corner y 
		ifTrue: 
			[ useRcvr := false.
			rCorner y ]
		ifFalse: [ corner y ].
	useRcvr 
		ifTrue: [ ^ self ]
		ifFalse: 
			[ ^ Rectangle 
				origin: minX @ minY
				corner: maxX @ maxY ]! !

!Rectangle methodsFor: 'testing' stamp: ''!
isWide
	^ self width > self height! !

!Rectangle methodsFor: '*Athens-Core' stamp: 'IgorStasenko 5/6/2013 05:43'!
asAthensShapeOn: anAthensCanvas 
	"Just answer self. Receiver don't needs any conversion to be used with Athens"
	
	^ self! !

!Rectangle methodsFor: 'rectangle functions' stamp: 'lr 7/4/2009 10:42'!
sideNearestTo: aPoint 
	| distToLeft distToRight distToTop distToBottom closest side |
	distToLeft := aPoint x - self left.
	distToRight := self right - aPoint x.
	distToTop := aPoint y - self top.
	distToBottom := self bottom - aPoint y.
	closest := distToLeft.
	side := #left.
	distToRight < closest ifTrue: 
		[ closest := distToRight.
		side := #right ].
	distToTop < closest ifTrue: 
		[ closest := distToTop.
		side := #top ].
	distToBottom < closest ifTrue: 
		[ closest := distToBottom.
		side := #bottom ].
	^ side
	"
 | r | r := Rectangle fromUser.
Display border: r width: 1.
[Sensor anyButtonPressed] whileFalse:
	[(r sideNearestTo: Sensor cursorPoint) , '      ' displayAt: 0@0]
"! !

!Rectangle methodsFor: 'printing' stamp: ''!
printOn: aStream 
	"Refer to the comment in Object|printOn:."

	origin printOn: aStream.
	aStream nextPutAll: ' corner: '.
	corner printOn: aStream! !

!Rectangle methodsFor: 'testing' stamp: ''!
containsRect: aRect
	"Answer whether aRect is within the receiver (OK to coincide)."

	^ aRect origin >= origin and: [aRect corner <= corner]
! !

!Rectangle methodsFor: 'rectangle functions' stamp: 'StephaneDucasse 9/7/2013 13:04'!
extendBy: deltaMargin 
	"Answer a Rectangle with the same origin as the receiver, but whose corner is offset by deltaMargin."

	^ deltaMargin asMargin extendRectangle: self! !

!Rectangle methodsFor: 'rectangle functions' stamp: ''!
withHeight: height 
	"Return a copy of me with a different height"
	^ origin corner: corner x @ (origin y + height)! !

!Rectangle methodsFor: 'rectangle functions' stamp: 'lr 7/4/2009 10:42'!
areasOutside: aRectangle 
	"Answer an Array of Rectangles comprising the parts of the receiver not 
	intersecting aRectangle."
	"Make sure the intersection is non-empty"
	| areas yOrigin yCorner |
	(self intersects: aRectangle) ifFalse: [ ^ Array with: self ].
	areas := OrderedCollection new.
	aRectangle origin y > origin y 
		ifTrue: 
			[ areas addLast: (origin corner: corner x @ (yOrigin := aRectangle origin y)) ]
		ifFalse: [ yOrigin := origin y ].
	aRectangle corner y < corner y 
		ifTrue: 
			[ areas addLast: (origin x @ (yCorner := aRectangle corner y) corner: corner) ]
		ifFalse: [ yCorner := corner y ].
	aRectangle origin x > origin x ifTrue: 
		[ areas addLast: (origin x @ yOrigin corner: aRectangle origin x @ yCorner) ].
	aRectangle corner x < corner x ifTrue: 
		[ areas addLast: (aRectangle corner x @ yOrigin corner: corner x @ yCorner) ].
	^ areas! !

!Rectangle methodsFor: 'truncation and roundoff' stamp: 'nice 2/5/2006 16:53'!
roundTo: grid
	"Answer a Rectangle whose origin and corner are rounded to grid x and grid y."

	^Rectangle origin: (origin roundTo: grid)
				corner: (corner roundTo: grid)! !

!Rectangle methodsFor: 'accessing' stamp: ''!
bottomRight
	"Answer the point at the right edge of the bottom horizontal line of the 
	receiver."

	^corner! !

!Rectangle methodsFor: 'accessing' stamp: ''!
corner
	"Answer the point at the bottom right corner of the receiver."

	^corner! !

!Rectangle methodsFor: 'printing' stamp: 'nice 11/1/2009 20:27'!
storeOn: aStream 
	"printed form is good for storing too"
	
	aStream nextPut: $(.
	self printOn: aStream.
	aStream nextPut: $).! !

!Rectangle methodsFor: 'accessing' stamp: ''!
center
	"Answer the point at the center of the receiver."

	^self topLeft + self bottomRight // 2! !

!Rectangle methodsFor: 'accessing' stamp: ''!
width
	"Answer the width of the receiver."

	^corner x - origin x! !

!Rectangle methodsFor: 'accessing' stamp: ''!
topCenter
	"Answer the point at the center of the receiver's top horizontal line."

	^self center x @ self top! !

!Rectangle methodsFor: 'rectangle functions' stamp: 'CamilloBruni 8/1/2012 16:00'!
amountToTranslateWithin: aRectangle 
	"Answer a Point, delta, such that self + delta is forced within aRectangle.
	Keep self topLeft inside when all of self cannot be made to fit"
	| dx dy |
	dx := 0.
	dy := 0.
	self right > aRectangle right ifTrue: [ dx := aRectangle right - self right ].
	self bottom > aRectangle bottom ifTrue: [ dy := aRectangle bottom - self bottom ].
	self left + dx < aRectangle left ifTrue: [ dx := aRectangle left - self left ].
	self top + dy < aRectangle top ifTrue: [ dy := aRectangle top - self top ].
	^ dx @ dy! !

!Rectangle methodsFor: 'accessing' stamp: ''!
bottomLeft
	"Answer the point at the left edge of the bottom horizontal line of the 
	receiver."

	^origin x @ corner y! !

!Rectangle methodsFor: 'transforming' stamp: 'gvc 4/24/2007 12:51'!
interpolateTo: end at: amountDone
	"Interpolate between the instance and end after the specified amount has been done (0 - 1)."

	^(self origin interpolateTo: end origin at: amountDone)
		corner: (self corner interpolateTo: end corner at: amountDone)! !

!Rectangle methodsFor: 'rectangle functions' stamp: ''!
withSide: side setTo: value  "return a copy with side set to value"
	^ self perform: (#(withLeft: withRight: withTop: withBottom: )
							at: (#(left right top bottom) indexOf: side))
		with: value! !

!Rectangle methodsFor: 'comparing' stamp: ''!
= aRectangle 
	"Answer true if the receiver's species, origin and corner match aRectangle's."

	self species = aRectangle species
		ifTrue: [^origin = aRectangle origin and: [corner = aRectangle corner]]
		ifFalse: [^false]! !

!Rectangle methodsFor: 'accessing' stamp: 'ar 10/26/2000 22:16'!
left: aNumber
	^aNumber @ origin y corner: corner! !

!Rectangle methodsFor: 'accessing' stamp: ''!
rightCenter
	"Answer the point at the center of the receiver's right vertical line."

	^self right @ self center y! !

!Rectangle methodsFor: '*Athens-Core' stamp: 'IgorStasenko 3/27/2011 18:43'!
asPolygonTransformedBy: aTransform
	"answer a clock-wise oriented polygon, representing receiver,
	transformed by transform"
	
	^ {
		aTransform transform: origin.
		aTransform transformX: corner x Y: origin y.
		aTransform transform: corner.
		aTransform transformX: origin x Y: corner y.
	}! !

!Rectangle methodsFor: 'rectangle functions' stamp: 'lr 7/4/2009 10:42'!
forPoint: aPoint closestSideDistLen: sideDistLenBlock 
	"Evaluate the block with my side (symbol) closest to aPoint,
		the approx distance of aPoint from that side, and
		the length of the side (or 0 if aPoint is beyond the side)"
	| side |
	side := self sideNearestTo: aPoint.
	side == #right ifTrue: 
		[ ^ sideDistLenBlock 
			value: side
			value: (self right - aPoint x) abs
			value: ((aPoint y 
					between: self top
					and: self bottom) 
					ifTrue: [ self height ]
					ifFalse: [ 0 ]) ].
	side == #left ifTrue: 
		[ ^ sideDistLenBlock 
			value: side
			value: (self left - aPoint x) abs
			value: ((aPoint y 
					between: self top
					and: self bottom) 
					ifTrue: [ self height ]
					ifFalse: [ 0 ]) ].
	side == #bottom ifTrue: 
		[ ^ sideDistLenBlock 
			value: side
			value: (self bottom - aPoint y) abs
			value: ((aPoint x 
					between: self left
					and: self right) 
					ifTrue: [ self width ]
					ifFalse: [ 0 ]) ].
	side == #top ifTrue: 
		[ ^ sideDistLenBlock 
			value: side
			value: (self top - aPoint y) abs
			value: ((aPoint x 
					between: self left
					and: self right) 
					ifTrue: [ self width ]
					ifFalse: [ 0 ]) ]! !

!Rectangle methodsFor: '*rubric' stamp: 'AlainPlantec 4/22/2013 11:36'!
privateSetCorner: bottomRight 
	corner := bottomRight! !

!Rectangle methodsFor: 'truncation and roundoff' stamp: 'wiz 1/11/2006 18:39'!
isIntegerRectangle
"Answer true if all component of receiver are integral."

^origin isIntegerPoint and: [ corner isIntegerPoint ]! !

!Rectangle methodsFor: 'accessing' stamp: 'ar 10/26/2000 22:17'!
right: aNumber
	^origin corner: aNumber @ corner y! !

!Rectangle methodsFor: 'transforming' stamp: 'nk 7/5/2003 08:31'!
translatedAndSquishedToBeWithin: aRectangle
	"Return an adjustment of the receiver that fits within aRectangle by
		- translating it to be within aRectangle if necessary, then
		- reducing its size, if necessary"

	^ (self translatedToBeWithin: aRectangle) squishedWithin: aRectangle! !

!Rectangle methodsFor: 'truncation and roundoff' stamp: 'StephaneDucasse 5/27/2010 22:10'!
ceiling
	"Answer the integer rectange to the bottom right of receiver.
	Return reciever if it already and integerRectange."

	self isIntegerRectangle ifTrue: [ ^ self ].
	^origin ceiling corner: corner ceiling! !

!Rectangle methodsFor: 'transforming' stamp: 'gvc 6/25/2007 14:00'!
quickMergePoint: aPoint
	"Answer the receiver if it encloses the given point or the expansion of the
	receiver to do so if it doesn't. "

	| useRcvr minX maxX minY maxY |
	useRcvr := true.
	minX := aPoint x < origin x ifTrue: [useRcvr := false. aPoint x] ifFalse: [origin x].
	maxX := aPoint x >= corner x ifTrue: [useRcvr := false. aPoint x + 1] ifFalse: [corner x].
	minY := aPoint y < origin y ifTrue: [useRcvr := false. aPoint y] ifFalse: [origin y].
	maxY := aPoint y >= corner y ifTrue: [useRcvr := false. aPoint y + 1] ifFalse: [corner y].
	^useRcvr
		ifTrue: [self]
		ifFalse: [minX@minY corner: maxX@maxY]
! !

!Rectangle methodsFor: 'rectangle functions' stamp: 'CamilloBruni 8/1/2012 16:04'!
encompass: aPoint 
	"Answer a Rectangle that contains both the receiver and aPoint."

	^ Rectangle 
		origin: (origin min: aPoint)
		corner: (corner max:  aPoint)! !

!Rectangle methodsFor: 'accessing' stamp: ''!
height
	"Answer the height of the receiver."

	^corner y - origin y! !

!Rectangle methodsFor: 'accessing' stamp: ''!
leftCenter
	"Answer the point at the center of the receiver's left vertical line."

	^self left @ self center y! !

!Rectangle methodsFor: '*rubric' stamp: 'AlainPlantec 4/22/2013 16:25'!
privateSetOrigin: topLeft 
	origin := topLeft! !

!Rectangle methodsFor: '*Morphic-Base' stamp: 'IgorStasenko 12/18/2012 16:49'!
asLayoutFrame
	"Answer an instance of LayoutFrame which uses fractions from receiver "
	
	^ LayoutFrame new
		leftFraction: self left;
		rightFraction: self right;
		topFraction: self top;
		bottomFraction: self bottom;
		yourself
		! !

!Rectangle methodsFor: 'rectangle functions' stamp: 'di 9/8/1999 21:25'!
withSideOrCorner: side setToPoint: newPoint
	"Return a copy with side set to newPoint"

	^ self withSideOrCorner: side setToPoint: newPoint minExtent: 0@0! !

!Rectangle methodsFor: 'rectangle functions' stamp: 'CamilloBruni 8/1/2012 16:18'!
translatedToBeWithin: aRectangle
	"Answer a copy of the receiver that does not extend beyond aRectangle."

	^ self translateBy: (self amountToTranslateWithin: aRectangle)! !

!Rectangle methodsFor: 'rectangle functions' stamp: 'di 10/20/97 23:01'!
rectanglesAt: y height: ht
	(y+ht) > self bottom ifTrue: [^ Array new].
	^ Array with: (origin x @ y corner: corner x @ (y+ht))! !

!Rectangle methodsFor: 'transforming' stamp: 'StephaneDucasse 8/15/2013 18:28'!
rotateBy: direction centerAt: aPoint
	"Return a copy rotated #right, #left, or #pi about aPoint"
	^ (origin rotateBy: direction centerAt: aPoint)
		rectangle: (corner rotateBy: direction centerAt: aPoint)! !

!Rectangle methodsFor: 'accessing' stamp: 'gvc 6/7/2006 10:44'!
pointAtSideOrCorner: loc
	"Answer the point represented by the given location."
	
	^ self
		perform: (#(topLeft topCenter topRight rightCenter
					bottomRight bottomCenter bottomLeft leftCenter)
						at: (#(topLeft top topRight right
					bottomRight bottom bottomLeft left) indexOf: loc))

	! !

!Rectangle methodsFor: '*Morphic-Base' stamp: 'StephaneDucasse 5/13/2012 19:01'!
drawReverseFrame: rect

	Display 
		border: rect
		width: 2
		rule: Form reverse
		fillColor: Color gray! !

!Rectangle methodsFor: 'rectangle functions' stamp: 'IgorStasenko 10/13/2013 16:11'!
withBottom: y 
	"Return a copy of me with a different bottom y"
	^ origin x @ origin y corner: corner x @ (y max: origin y)! !

!Rectangle methodsFor: 'rectangle functions' stamp: 'StephaneDucasse 9/7/2013 11:51'!
insetBy: delta 
	"Answer a Rectangle that is inset from the receiver by delta. delta is a 
	Rectangle, Point, or scalar."
	
	^ delta asMargin insetRectangle: self! !

!Rectangle methodsFor: 'transforming' stamp: 'gvc 6/13/2006 14:08'!
scaledAndCenteredIn: aRect
	"Answer a new rectangle that fits into aRectangle and is centered
	but with the same aspect ratio as the receiver."
	
	^self width / aRect width > (self height / aRect height)
		ifTrue: [aRect left @ (aRect leftCenter y - (self height * (aRect width / self width) / 2))
					corner: aRect right @ (aRect rightCenter y + (self height * (aRect width / self width) / 2))]
		ifFalse: [aRect topCenter x - (self width * (aRect height / self height) / 2) @ aRect top
					corner: (aRect topCenter x + (self width * (aRect height / self height) / 2)) @ aRect bottom]! !

!Rectangle methodsFor: 'rectangle functions' stamp: 'IgorStasenko 10/13/2013 16:10'!
withRight: x 
	"Return a copy of me with a different right x"
	^ origin x @ origin y corner: (x max: origin x) @ corner y! !

!Rectangle methodsFor: '*Athens-Core' stamp: 'IgorStasenko 8/30/2013 16:49'!
paintFillsUsing: aPaint on: anAthensCanvas 
	"This method is a part of rendering dispatch  Canvas->receiver->paint"
	
	^ aPaint athensFillRectangle: self on: anAthensCanvas! !

!Rectangle methodsFor: 'truncation and round off' stamp: ''!
rounded
	"Answer a Rectangle whose origin and corner are rounded."

	^Rectangle origin: origin rounded corner: corner rounded! !

!Rectangle methodsFor: 'truncation and roundoff' stamp: 'nice 2/5/2006 16:51'!
expandTo: grid
	"Answer a Rectangle whose origin and corner are rounded to grid x and grid y.
	Rounding is done by upper value on origin and lower value on corner so that
	self is inside rounded rectangle."

	^Rectangle origin: (origin roundDownTo: grid)
				corner: (corner roundUpTo: grid)! !

!Rectangle methodsFor: 'accessing' stamp: ''!
origin
	"Answer the point at the top left corner of the receiver."

	^origin! !

!Rectangle methodsFor: 'accessing' stamp: ''!
left
	"Answer the position of the receiver's left vertical line."

	^origin x! !

!Rectangle methodsFor: '*Fuel' stamp: 'MarianoMartinezPeck 5/18/2012 22:24'!
fuelAccept: aGeneralMapper
	"Since we can have subclasses of Rectangle, like CharacterBlock that adds new instVars, we cannot use the visitRectangle: for it."
	^ (self class == Rectangle) 
		ifTrue: [ aGeneralMapper visitRectangle: self ]
		ifFalse: [ super fuelAccept: aGeneralMapper   ] 
	
! !

!Rectangle methodsFor: '*Morphic-Base' stamp: 'StephaneDucasse 5/13/2012 20:47'!
newRectFrom: newRectBlock 
	"Track the outline of a new rectangle until mouse button changes. newFrameBlock produces each new rectangle from the previous"
	| rect newRect buttonStart buttonNow  hand |

	hand := World activeHand.
	
	buttonStart := buttonNow := hand anyButtonPressed.
	rect := self.

	self drawReverseFrame: rect.

	hand captureEventsWhile: [:evt |
		evt isMouse ifTrue: [
			buttonNow := evt anyButtonPressed.
			newRect := newRectBlock value: rect value: evt cursorPoint.
			newRect = rect ifFalse: 
				[self drawReverseFrame: rect.
				self drawReverseFrame: newRect.	
				rect := newRect ]. 

			 buttonNow = buttonStart
			] ifFalse: [ true ]
		].
	
	self drawReverseFrame:  rect.
	
	hand
		newMouseFocus: nil;
		showTemporaryCursor: nil.
	^ rect
	
! !

!Rectangle methodsFor: 'truncation and roundoff' stamp: 'wiz 2/12/2006 15:56'!
floor
"Answer the integer rectange to the topleft of receiver.
Return reciever if it already and integerRectange."

self isIntegerRectangle ifTrue: [ ^ self ] .

^origin floor corner: corner floor! !

!Rectangle methodsFor: 'accessing' stamp: ''!
right
	"Answer the position of the receiver's right vertical line."

	^corner x! !

!Rectangle methodsFor: 'rectangle functions' stamp: 'StephaneDucasse 8/15/2013 18:29'!
withSideOrCorner: side setToPoint: newPoint minExtent: minExtent limit: limit
	"Return a copy with side set to newPoint"
	side = #top ifTrue: [^ self withTop: (newPoint y min: corner y - minExtent y max: limit + minExtent y)].
	side = #bottom ifTrue: [^ self withBottom: (newPoint y min: limit - minExtent y max: origin y + minExtent y)].
	side = #left ifTrue: [^ self withLeft: (newPoint x min: corner x - minExtent x max: limit + minExtent x)].
	side = #right ifTrue: [^ self withRight: (newPoint x min: limit - minExtent x max: origin x + minExtent x)].
	side = #topLeft ifTrue: [^ (newPoint min: corner - minExtent) corner: self bottomRight].
	side = #bottomRight ifTrue: [^ self topLeft corner: (newPoint max: origin + minExtent)].
	side = #bottomLeft ifTrue: [^ self topRight rectangle: ((newPoint x min: corner x - minExtent x) @ (newPoint y max: origin y + minExtent y))].
	side = #topRight ifTrue: [^ self bottomLeft rectangle: ((newPoint x max: origin x + minExtent x) @ (newPoint y min: corner y - minExtent y))].! !

!Rectangle methodsFor: 'testing' stamp: 'lr 7/4/2009 10:42'!
intersects: aRectangle 
	"Answer whether aRectangle intersects the receiver anywhere."
	"Optimized; old code answered:
		(origin max: aRectangle origin) < (corner min: aRectangle corner)"
	| rOrigin rCorner |
	rOrigin := aRectangle origin.
	rCorner := aRectangle corner.
	rCorner x <= origin x ifTrue: [ ^ false ].
	rCorner y <= origin y ifTrue: [ ^ false ].
	rOrigin x >= corner x ifTrue: [ ^ false ].
	rOrigin y >= corner y ifTrue: [ ^ false ].
	^ true! !

!Rectangle methodsFor: 'accessing' stamp: 'ar 10/26/2000 22:17'!
top: aNumber
	^origin x @ aNumber corner: corner! !

!Rectangle methodsFor: 'accessing' stamp: 'acg 2/23/2000 00:52'!
aboveCenter
	"Answer the point slightly above the center of the receiver."

	^self topLeft + self bottomRight // (2@3)! !

!Rectangle methodsFor: 'accessing' stamp: ''!
bottomCenter
	"Answer the point at the center of the bottom horizontal line of the 
	receiver."

	^self center x @ self bottom! !

!Rectangle methodsFor: 'truncation and round off' stamp: 'jm 5/29/1998 15:53'!
truncated
	"Answer a Rectangle whose origin and corner have any fractional parts removed. Answer the receiver if its coordinates are already integral."

	(origin x isInteger and:
	[origin y isInteger and:
	[corner x isInteger and:
	[corner y isInteger]]])
		ifTrue: [^ self].

	^ Rectangle origin: origin truncated corner: corner truncated
! !

!Rectangle methodsFor: 'rectangle functions' stamp: 'IgorStasenko 12/22/2012 02:30'!
intersect: aRectangle ifNone: aBlock
	"Answer a Rectangle that is the area in which the receiver overlaps with 
	aRectangle. 
	If there's no overlap, evaluate the block instead 
	"
	| aPoint left right top bottom |
	(self intersects: aRectangle) ifFalse: [ ^ aBlock value ].
	 
	aPoint := aRectangle origin.
	aPoint x > origin x 
		ifTrue: [ left := aPoint x ]
		ifFalse: [ left := origin x ].
	aPoint y > origin y 
		ifTrue: [ top := aPoint y ]
		ifFalse: [ top := origin y ].
	aPoint := aRectangle corner.
	aPoint x < corner x 
		ifTrue: [ right := aPoint x ]
		ifFalse: [ right := corner x ].
	aPoint y < corner y 
		ifTrue: [ bottom := aPoint y ]
		ifFalse: [ bottom := corner y ].
	^ Rectangle 
		origin: left @ top
		corner: right @ bottom! !

!Rectangle methodsFor: 'testing' stamp: ''!
containsPoint: aPoint 
	"Answer whether aPoint is within the receiver."

	^origin <= aPoint and: [aPoint < corner]! !

!Rectangle methodsFor: 'testing' stamp: ''!
hasPositiveExtent
	^ (corner x > origin x) and: [corner y > origin y]! !

!Rectangle methodsFor: 'truncation and round off' stamp: ''!
truncateTo: grid
	"Answer a Rectangle whose origin and corner are truncated to grid x and grid y."

	^Rectangle origin: (origin truncateTo: grid)
				corner: (corner truncateTo: grid)! !

!Rectangle methodsFor: 'comparing' stamp: ''!
hash
	"Hash is reimplemented because = is implemented."

	^origin hash bitXor: corner hash! !

!Rectangle methodsFor: 'rectangle functions' stamp: 'di 10/22/1998 16:11'!
adjustTo: newRect along: side 
	"Return a copy adjusted to fit a neighbor that has changed size."
	side = #left ifTrue: [^ self withRight: newRect left].
	side = #right ifTrue: [^ self withLeft: newRect right].
	side = #top ifTrue: [^ self withBottom: newRect top].
	side = #bottom ifTrue: [^ self withTop: newRect bottom].! !

!Rectangle methodsFor: 'accessing' stamp: 'ar 10/26/2000 22:17'!
bottom: aNumber
	^origin corner: corner x @ aNumber! !

!Rectangle methodsFor: 'rectangle functions' stamp: 'ar 1/5/2002 18:04'!
allAreasOutsideList: aCollection do: aBlock
	"Enumerate aBlock with all areas of the receiver not overlapping 
	any rectangle in the given collection"
	^self allAreasOutsideList: aCollection startingAt: 1 do: aBlock! !

!Rectangle methodsFor: 'accessing' stamp: ''!
topLeft
	"Answer the point at the top left corner of the receiver's top horizontal line."

	^origin
! !

!Rectangle methodsFor: 'rectangle functions' stamp: ''!
withWidth: width 
	"Return a copy of me with a different width"
	^ origin corner: (origin x + width) @ corner y! !

!Rectangle methodsFor: 'accessing' stamp: ''!
bottom
	"Answer the position of the receiver's bottom horizontal line."

	^corner y! !

!Rectangle methodsFor: 'transforming' stamp: 'sw 5/21/96'!
squishedWithin: aRectangle
	"Return an adjustment of the receiver that fits within aRectangle by reducing its size, not by changing its origin.  "

	^ origin corner: (corner min: aRectangle bottomRight)

"(50 @ 50 corner: 160 @ 100) squishedWithin:  (20 @ 10 corner: 90 @ 85)"
! !

!Rectangle methodsFor: 'testing' stamp: ''!
isTall
	^ self height > self width! !

!Rectangle methodsFor: 'accessing' stamp: ''!
topRight
	"Answer the point at the top right corner of the receiver's top horizontal 
	line."

	^corner x @ origin y! !

!Rectangle methodsFor: 'truncation and roundoff' stamp: 'nice 2/5/2006 16:52'!
expanded
	"Answer a Rectangle whose origin and corner are rounded to integers.
	Rounding is done by upper value on origin and lower value on corner so that
	self is inside rounded rectangle."

	^Rectangle origin: origin floor corner: corner ceiling! !

!Rectangle methodsFor: 'rectangle functions' stamp: 'StephaneDucasse 9/7/2013 12:28'!
expandBy: delta 
	"Answer a Rectangle that is outset from the receiver by delta. delta is a 
	Rectangle, Point, or scalar."
	
	^ delta asMargin expandRectangle: self! !

!Rectangle methodsFor: 'rectangle functions' stamp: ''!
merge: aRectangle 
	"Answer a Rectangle that contains both the receiver and aRectangle."

	^Rectangle 
		origin: (origin min: aRectangle origin)
		corner: (corner max: aRectangle corner)! !

!Rectangle methodsFor: 'self evaluating' stamp: 'sd 7/31/2005 21:49'!
isSelfEvaluating
	^ self class == Rectangle! !

!Rectangle methodsFor: 'accessing' stamp: ''!
boundingBox
	^ self! !

!Rectangle methodsFor: 'rectangle functions' stamp: 'IgorStasenko 10/13/2013 16:09'!
withLeft: x 
	"Return a copy of me with a different left x (but not going over right side)"
	^ (x min: corner x) @ origin y corner: corner x @ corner y! !

!Rectangle methodsFor: 'testing' stamp: 'ar 10/29/2000 19:03'!
isZero
	^origin isZero and:[corner isZero]! !

!Rectangle methodsFor: 'converting' stamp: 'StephaneDucasse 9/7/2013 13:10'!
asMargin

	^ Margin fromRectangle: self! !

!Rectangle class methodsFor: 'instance creation' stamp: 'Sd 8/2/2014 16:27'!
origin: originPoint corner: cornerPoint 
	"Answer an instance of me whose corners (top left and bottom right) are 
	determined by the arguments."

	^self basicNew setPoint: originPoint point: cornerPoint! !

!Rectangle class methodsFor: 'instance creation' stamp: 'Sd 8/2/2014 16:24'!
left: left right: right top: top bottom: bottom 
	"Answer an instance of me whose left, right, top, and bottom coordinates 
	are determined by the arguments."

	^ self basicNew setLeft: left right: right top: top bottom: bottom ! !

!Rectangle class methodsFor: '*Morphic-Base' stamp: ''!
fromUser
	"Answer an instance of me that is determined by having the user 
	designate the top left and bottom right corners. The gridding for user 
	selection is 1@1."

	^self fromUser: 1 @ 1! !

!Rectangle class methodsFor: 'instance creation' stamp: 'tk 3/9/97'!
center: centerPoint extent: extentPoint 
	"Answer an instance of me whose center is centerPoint and width 
	by height is extentPoint.  "

	^self origin: centerPoint - (extentPoint//2) extent: extentPoint! !

!Rectangle class methodsFor: 'instance creation' stamp: 'Sd 8/2/2014 16:26'!
origin: originPoint extent: extentPoint 
	"Answer an instance of me whose top left corner is originPoint and width by height is extentPoint. Note that extentPoint should be non negative since it represents the size of the rectangle"

	
	^self basicNew 
		setPoint: originPoint 
		point: (originPoint x+ (extentPoint x max: 0)) @ (originPoint y + (extentPoint y max: 0)).! !

!Rectangle class methodsFor: '*Morphic-Base' stamp: 'StephaneDucasse 5/13/2012 18:47'!
activeHand

	^ ActiveHand! !

!Rectangle class methodsFor: 'instance creation' stamp: 'ClementBera 9/27/2013 17:50'!
encompassing: listOfPoints 
	"A number of callers of encompass: should use this method."
	| topLeft bottomRight |
	topLeft := bottomRight := listOfPoints first.
	listOfPoints allButFirstDo: [ :p | 
		topLeft := topLeft min: p.
		bottomRight := bottomRight max: p ].
	^ topLeft corner: bottomRight! !

!Rectangle class methodsFor: 'instance creation' stamp: 'Sd 8/2/2014 16:27'!
point: pt1 point: pt2 
	"Answer an instance of me constructed from two points."

	^self basicNew setPoint: pt1 point: pt2! !

!Rectangle class methodsFor: '*Morphic-Base' stamp: 'StephaneDucasse 5/13/2012 20:02'!
fromUser: gridPoint 
	"Answer a Rectangle that is determined by having the user 
	designate the top left and bottom right corners. 
	The cursor reamins linked with the sensor, but
	the outline is kept gridded."
	| originRect |
	self activeHand showTemporaryCursor: Cursor origin.

	originRect :=  ((self activeHand cursorPoint grid: gridPoint) extent: 0 @ 0) 
					newRectFrom: [ :f :pt | (pt grid: gridPoint) extent: 0 @ 0 ].
					
	self activeHand showTemporaryCursor: Cursor bottomRight.

	^  originRect newRectFrom: [ :f :pt | f origin corner: (pt grid: gridPoint) ]! !

!Rectangle class methodsFor: 'instance creation' stamp: 'lr 7/4/2009 10:42'!
merging: listOfRects 
	"A number of callers of merge: should use this method."
	| minX minY maxX maxY |
	listOfRects do: 
		[ :r | 
		minX 
			ifNil: 
				[ minX := r topLeft x.
				minY := r topLeft y.
				maxX := r bottomRight x.
				maxY := r bottomRight y ]
			ifNotNil: 
				[ minX := minX min: r topLeft x.
				minY := minY min: r topLeft y.
				maxX := maxX max: r bottomRight x.
				maxY := maxY max: r bottomRight y ] ].
	^ minX @ minY corner: maxX @ maxY! !

!RectangleTest methodsFor: 'tests' stamp: 'zz 10/23/2007 20:15'!
testTwoRectanglesWithAnAdjascentCornerDoNotIntersect
  
   | rect1 rect2 |
   rect1 := 0@0 corner: 40@40.
   rect2 := 40@40 corner: 50@50.
   self deny: (rect1 intersects: rect2);
        deny: (rect2 intersects: rect1).! !

!RectangleTest methodsFor: 'tests' stamp: 'StephaneDucasse 8/15/2013 19:03'!
testInsettingByNumberShouldWork

	| rec1 rec2 |
	rec1 := 0@0 extent: 100@200.
	rec2 := rec1 insetBy: 30.
	
	self assert: rec2 height = 140. 
	self assert: rec2 width = 40. 
	
	rec1 := 0@0 extent: 100@200.
	rec2 := rec1 insetBy: 50.
	
	self assert: rec2 height = 100. 
	self assert: rec2 width = 0. 
	! !

!RectangleTest methodsFor: 'tests' stamp: 'zz 10/23/2007 20:10'!
testARectangleContainsItsOrigin
	self
		assert: (rectangle1 containsPoint: rectangle1 origin)! !

!RectangleTest methodsFor: 'tests' stamp: 'StephaneDucasse 8/15/2013 19:09'!
testInsettingByRectangleShouldNotProduceNegativeRectangle

	| rec1 rec2 |
	rec1 := 0@0 extent: 100@200.
	rec2 := rec1 insetBy: (1@2 rectangle: 5@10).
	
	self assert: rec2 left = 1. 
	self assert: rec2 right = 95. 
	self assert: rec2 top = 2. 
	self assert: rec2 bottom = 190. 
	
	
	rec1 := 0@0 extent: 100@200.
	rec2 := rec1 insetBy: (46@2 rectangle: 55@10).
	
	self assert: rec2 left = 46. 
	self assert: rec2 right = 46. 
	self assert: rec2 top = 2. 
	self assert: rec2 bottom = 190. 
	
	rec1 := 0@0 extent: 100@200.
	rec2 := rec1 insetBy: (46@2 rectangle: 55@10).
	
	self assert: rec2 left = 46. 
	self assert: rec2 right = 46. 
	self assert: rec2 top = 2. 
	self assert: rec2 bottom = 190. 
	
	rec1 := 0@0 extent: 100@200.
	rec2 := rec1 insetBy: (1@102 rectangle: 5@105).
	
	self assert: rec2 left = 1. 
	self assert: rec2 right = 95. 
	self assert: rec2 top = 102. 
	self assert: rec2 bottom = 102. 
! !

!RectangleTest methodsFor: 'tests' stamp: 'thomasvincent 10/18/2014 13:39'!
testTranslateBy
	| rect |
	rect:= (2@2 corner: 6@4).
	
	self assert: (rect translateBy:2) left = 4.
	self assert: (rect translateBy:2) right = 8.
	self assert: (rect translateBy:2) top = 4.
	self assert: (rect translateBy:2) bottom = 6.
	
	self assert: (rect translateBy:(2 negated)) left = 0.
	self assert: (rect translateBy:(2 negated)) right = 4.
	self assert: (rect translateBy:(2 negated)) top = 0.
	self assert: (rect translateBy:(2 negated)) bottom = 2.! !

!RectangleTest methodsFor: 'tests-accessing' stamp: 'JulesIVANIC 10/28/2013 20:21'!
testArea

	self assert: (0 @ 0 corner: 5 @ 5) area = 25.
	self assert: (2 @ 3 corner: 10 @ 8) area = 40.
	self assert: (5 @ 5 corner: 6 @ 6) area = 1.
	self assert: (-1 @ -2 corner: 2 @ 1) area = 9.! !

!RectangleTest methodsFor: 'tests-rectangle functions' stamp: 'JulesIVANIC 10/28/2013 20:19'!
testWithWidth

	| r |
	r := Rectangle new.
	r := 1 @ 2 corner: 5 @ 5.
	self assert: (r withWidth: 7) = (1 @ 2 corner: 8 @ 5).
	self assert: (r withWidth: 3) = (1 @ 2 corner: 4 @ 5).! !

!RectangleTest methodsFor: 'tests-transforming' stamp: 'JulesIVANIC 10/28/2013 20:21'!
testFlipByCenterAt

	| rectangle |
	
	rectangle := 10 @ 10 corner: 20 @ 20.
	self assert: (10 @ 0 corner: 20 @ 10) equals: (rectangle flipBy: #vertical centerAt: 10 @ 10).
	self assert: (0 @ 10 corner: 10 @ 20) equals: (rectangle flipBy: #horizontal centerAt: 10 @ 10)! !

!RectangleTest methodsFor: 'tests' stamp: 'StephaneDucasse 10/13/2013 16:39'!
testWithLeftDoesNotProduceInvalidRectangle
	"self debug: #testWithLeftDoesNotProduceInvalidRectangle"

	| rect1 rect2 |
	rect1 := 0@10 corner: 50@60.
	
	"it is possible to adjust the left to the left of the current left side"
	rect2 := rect1 withLeft: -10.
	self assert: rect2 left equals: -10.

	"it is possible to adjust the left to the right of the current left side but not over the righ side!!!!!!!!"
	rect2 := rect1 withLeft: 40.
	self assert: rect2 left equals: 40.
	
	"it is possible to adjust the left to be to the right of the current left side but not over the righ side, at the maximum 
	you will a zero width rectangle!!!!!!!!"
	rect2 := rect1 withLeft: 80.
	self assert: rect2 left equals: 50.
	self assert: rect2 width isZero
	! !

!RectangleTest methodsFor: 'tests-accessing' stamp: 'thomasvincent 10/18/2014 13:01'!
testLeft
|rect|
rect:=(0 @ 0 corner: 20 @ 20) left:10.
self assert: rect left = 10.! !

!RectangleTest methodsFor: 'tests' stamp: 'zz 10/23/2007 20:12'!
testARectangleIntersectsWithItself
	self
		assert: (rectangle1 intersects: rectangle1)! !

!RectangleTest methodsFor: 'tests' stamp: 'zz 10/23/2007 20:13'!
testRectanglesWithSameOriginIntersect

    | rect1 rect2 |
   rect1 := 10@10 corner: 20@30.
   rect2 := rect1 corner extent: 20@40.
   self deny: (rect1 intersects: rect2).! !

!RectangleTest methodsFor: 'tests' stamp: 'Sd 8/2/2014 16:33'!
testPointPointConstructorIsSymmetrical
	| pt1 pt2 rect1 rect2 |

	pt1:= 0@0.
	pt2 := 10@10.
    
	rect1 := Rectangle point: pt1 point: pt2.
	rect2 := Rectangle point: pt2 point: pt1.
	
	self assert: rect1 equals: rect2! !

!RectangleTest methodsFor: 'tests-rectangle functions' stamp: 'AugustinPetre 10/31/2013 01:50'!
testWithBottom

	| r |
	r := Rectangle new.
	r := (0 @ 0) corner: (5 @ 5).
	self assert: (r withBottom: 7) = ((0 @ 0) corner: (5 @ 7)).
	self assert: (r withBottom: 3) = ((0 @ 0) corner: (5 @ 3)).

	r := Rectangle new.
	r := (-5 @ -10) corner: (-2 @ -3).
	self assert: (r withBottom: -2) = ((-5 @ -10) corner: (-2 @ -2)).
	self assert: (r withBottom: 5) = ((-5 @ -10) corner: (-2 @ 5)).! !

!RectangleTest methodsFor: 'tests-accessing' stamp: 'thomasvincent 10/18/2014 12:58'!
testBottom
|rect|
rect:=(0 @ 0 corner: 20 @ 20) bottom:10.
self assert: rect bottom = 10.! !

!RectangleTest methodsFor: 'tests-rectangle functions' stamp: 'JulesIVANIC 10/28/2013 20:18'!
testWithTop

	| r |
	r := Rectangle new.
	r := 0 @ 0 corner: 5 @ 5.
	self assert: (r withTop: -2) = (0 @ -2 corner: 5 @ 5).
	self assert: (r withTop: 3) = (0 @ 3 corner: 5 @ 5).! !

!RectangleTest methodsFor: 'tests' stamp: 'zz 10/23/2007 20:11'!
testARectangleDoesNotContainItsCorner
	self
		deny: (rectangle1 containsPoint: rectangle1 corner)! !

!RectangleTest methodsFor: 'tests' stamp: 'zz 10/22/2007 09:07'!
testAreasOutside2
    | frame rects visibleArea  |
    frame := 0@0 extent: 300@300.
    rects := OrderedCollection new: 80.
    rects add: (50@50 corner: 200 @ 200);
          add: (100@100 corner: 250@250).
  
   visibleArea := Array with: frame.
   rects do: [:rect |  | remnants |
      remnants := OrderedCollection new.
      visibleArea do: [:a | remnants addAll: (a areasOutside: rect)].
      visibleArea := remnants.
  ].
  visibleArea := visibleArea asArray.
  self assert: (visibleArea allSatisfy: [:r | r area ~= 0]).

   1 to: visibleArea size do: [:idx |
     idx + 1 to: visibleArea size do: [:idx2 |
        self deny: ((visibleArea at: idx) intersects: (visibleArea at: idx2)).
  ]  ].

  1 to: rects size do: [:idx |
     1 to: visibleArea size do: [:idx2 |
        self deny: ((rects at: idx) intersects: (visibleArea at: idx2)).
  ]  ].

! !

!RectangleTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/31/2015 22:24'!
testCenter 
	| r1 c |
	r1 := 0@0 extent: 10@20.
	c := r1 center.
	self assert: (r1 containsPoint: c) description: 'the center is inside the rectangle'.
	self assert: (r1 topLeft dist: c) = (r1 bottomRight dist: c).
	self assert: (r1 bottomLeft dist: c) = (r1 topRight dist: c).
	self assert: (r1 topLeft dist: c) = (r1 bottomLeft dist: c).
	self assert: (r1 translateBy: -20@10) center = (c translateBy: -20@10) description: 'the center is translated with the rectangle'! !

!RectangleTest methodsFor: 'tests' stamp: 'StephaneDucasse 8/15/2013 17:33'!
testInsettingSmallerThanRectangleExtentShouldProduceCorrectExtent

	| rec1 rec2 |
	rec1 := 0@0 extent: 100@100.
	rec2 := rec1 insetBy: 40@40.
	
	self assert: rec2 height = 20. 
	self assert: rec2 width = 20. ! !

!RectangleTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/31/2015 22:20'!
testCenterEmpty

      | r1 c |
      r1 := 30@10 corner: 10@20.
		"does not create an empty rectangle"
      c := r1 center.
      self assert: (r1 containsPoint: c) description: 'A rectangle contain its center.'.
      self assert: (r1 topLeft dist: c) = (r1 bottomRight dist: c).
      self assert: (r1 bottomLeft dist: c) = (r1 topRight dist: c).
      self assert: (r1 topLeft dist: c) = (r1 bottomLeft dist: c).
      self assert: (r1 translateBy: -20@10) center = (c translateBy: -20@10) description: 'the center is translated with the rectangle'.! !

!RectangleTest methodsFor: 'tests' stamp: 'zz 10/22/2007 09:15'!
testMergingDisjointRectangles

	| aCollection merge |
	aCollection := OrderedCollection new.
	aCollection add: (Rectangle left: -10 right: 0 top: -10 bottom: 0).
	aCollection add: (Rectangle left: 0 right: 10 top: 0 bottom: 10).
	merge := Rectangle merging: aCollection.
	self assert: merge = (Rectangle left: -10 right: 10 top: -10 bottom: 10).! !

!RectangleTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/31/2015 22:22'!
testFlip

	| r1 c r1Horiz r1Vert |
   r1 := 30@10 corner: 10@20.
   c := 5@5.
   r1Horiz := r1 flipBy: #horizontal centerAt: c.
   r1Vert := r1 flipBy: #vertical centerAt: c.

   self assert: r1 area = r1Horiz area description: 'flip preserves area'.
   self assert: r1 area = r1Vert area description: 'flip preserves area'.

 	self assert: r1 extent = r1Horiz extent description: 'flip preserves extent'.
	self assert: r1 extent = r1Vert extent description: 'flip preserves extent'.
	self assert:  (r1 flipBy: #horizontal centerAt: r1 center) = r1.
	self assert:  (r1 flipBy: #vertical centerAt: r1 center) = r1! !

!RectangleTest methodsFor: 'tests' stamp: 'zz 10/16/2007 20:00'!
testMergingOneRectangleReturnsThisRectangle
	| aCollection mergingRectangle |
	aCollection := OrderedCollection new.
	aCollection add: rectangle1.
	mergingRectangle := Rectangle merging: aCollection.
	self assert: mergingRectangle = aCollection first! !

!RectangleTest methodsFor: 'tests' stamp: 'StephaneDucasse 8/15/2013 17:34'!
testInsettingLargerThanRectangleExtentShouldNotProduceNegativeExtent

	| rec1 rec2 |
	rec1 := 0@0 extent: 100@100.
	rec2 := rec1 insetBy: 200@200.
	
	self assert: rec2 height >= 0. 
	self assert: rec2 width >= 0. 
	
	rec1 := 0@0 extent: 100@100.
	rec2 := rec1 insetBy: 50@50.
	"because insetBy: reduces from both sides"
	self assert: rec2 height = 0. 
	self assert: rec2 width = 0. ! !

!RectangleTest methodsFor: 'tests' stamp: 'StephaneDucasse 10/13/2013 16:47'!
testWithTopDoesNotProduceInvalidRectangle
	"self debug: #testWithTopDoesNotProduceInvalidRectangle"

	| rect1 rect2 |
	rect1 := 0@10 corner: 50@60.
	
	"it is possible to adjust the top above of the current top side"
	rect2 := rect1 withTop: -10.
	self assert: rect2 top equals: -10.

	"it is possible to adjust the top below of the current top side"
	rect2 := rect1 withTop: 40.
	self assert: rect2 top equals: 40.
	
	"it is possible to adjust the top below of the current top side but not below the bottom"
	rect2 := rect1 withTop: 70.
	self assert: rect2 top equals: 60.
	self assert: rect2 height isZero
	! !

!RectangleTest methodsFor: 'tests' stamp: 'zz 10/22/2007 09:09'!
testMergingTwoRectangles

	| coll merge |
	coll := OrderedCollection new.
	coll add: (Rectangle left: 1 right: 1 top: 1 bottom: 1).
	coll add: (Rectangle left: 10 right: 10 top: 10 bottom: 10).

	merge := Rectangle merging: coll.
	self assert: merge = (Rectangle left: 1 right: 10 top: 1 bottom: 10).! !

!RectangleTest methodsFor: 'tests' stamp: 'jeromegarcia 10/1/2014 15:53'!
testRotateBy
	| rect |
	
	rect := Rectangle left:0  right:6  top:4  bottom:2. 

	self assert: (rect rotateBy:#left centerAt:0@0) left = 2.
	self assert: (rect rotateBy:#left centerAt:0@0) right = 4.
	self assert: (rect rotateBy:#left centerAt:0@0) top = -6.
	self assert: (rect rotateBy:#left centerAt:0@0) bottom = 0.
	
	self assert: (rect rotateBy:#right centerAt:0@0) left = -4.
	self assert: (rect rotateBy:#right centerAt:0@0) right = -2.
	self assert: (rect rotateBy:#right centerAt:0@0) top = 0.
	self assert: (rect rotateBy:#right centerAt:0@0) bottom = 6.
	
	self assert: (rect rotateBy:#pi centerAt:0@0) left = -6.
	self assert: (rect rotateBy:#pi centerAt:0@0) right = 0.
	self assert: (rect rotateBy:#pi centerAt:0@0) top = -4.
	self assert: (rect rotateBy:#pi centerAt:0@0) bottom = -2.! !

!RectangleTest methodsFor: 'tests' stamp: 'StephaneDucasse 10/13/2013 16:52'!
testWithBottomDoesNotProduceInvalidRectangle
	"self debug: #testWithBottomDoesNotProduceInvalidRectangle"

	| rect1 rect2 |
	rect1 := 0@10 corner: 50@60.
	
	"it is possible to adjust the bottom below the current bottom side"
	rect2 := rect1 withBottom: 100.
	self assert: rect2 bottom equals: 100.

	"it is possible to adjust the bottom above the current bottom side"
	rect2 := rect1 withBottom: 40.
	self assert: rect2 bottom equals: 40.
	
	"it is possible to adjust the bottom above the current bottom side but not above the top"
	rect2 := rect1 withBottom: -10.
	self assert: rect2 bottom equals: 10.
	self assert: rect2 height isZero
	! !

!RectangleTest methodsFor: 'tests' stamp: 'sd 6/5/2005 10:17'!
testMergingOverlappingRects

	| coll merge |
	coll := OrderedCollection new.
	coll add: (Rectangle left: 5 right: 10 top: 0 bottom: 15).
	coll add: (Rectangle left: 0 right: 15 top: 5 bottom: 10).
	merge := Rectangle merging: coll.
	self assert: merge = (Rectangle left: 0 right: 15 top: 0 bottom: 15).! !

!RectangleTest methodsFor: 'tests' stamp: 'thomasvincent 10/18/2014 13:44'!
testScaleBy
	| rect |
	rect:= (2@2 corner: 6@4). 
	
	self assert: (rect scaleBy: 2) left = 4.
	self assert: (rect scaleBy: 2) right = 12.
	self assert: (rect scaleBy: 2) top = 4.
	self assert: (rect scaleBy: 2) bottom = 8.
	
	self assert: (rect scaleBy: (1/2)) left = 1.
	self assert: (rect scaleBy: (1/2)) right = 3.
	self assert: (rect scaleBy: (1/2)) top = 1.
	self assert: (rect scaleBy: (1/2)) bottom = 2.
	
	self assert: (rect scaleBy: 0) left = 0.
	self assert: (rect scaleBy: 0) right = 0.
	self assert: (rect scaleBy: 0) top = 0.
	self assert: (rect scaleBy: 0) bottom = 0.! !

!RectangleTest methodsFor: 'tests-rectangle functions' stamp: 'JulesIVANIC 10/28/2013 20:18'!
testWithHeight

	| r |
	r := Rectangle new.
	r := 1 @ 2 corner: 5 @ 5.
	self assert: (r withHeight: 7) = (1 @ 2 corner: 5 @ 9).
	self assert: (r withHeight: 3) = (1 @ 2 corner: 5 @ 5).! !

!RectangleTest methodsFor: 'tests' stamp: 'zz 10/23/2007 20:14'!
testTwoRectanglesWithAnAdjascentBorderDoNotIntersect
  
   | rect1 rect2 |
   rect1 := 0@0 corner: 40@40.
   rect2 := 40@0 extent:40@40.
   self deny: (rect1 intersects: rect2);
        deny: (rect2 intersects: rect1).! !

!RectangleTest methodsFor: 'tests' stamp: 'StephaneDucasse 8/15/2013 17:24'!
testRectangleWithNegativeExtentShouldHaveZeroExtent
	
	self assert: (Rectangle origin: 10@10 extent: -5@ -5) extent = (0@0).
	self assert: (Rectangle origin: 10@10 extent: -5@ -5) origin = (10@10).
		self assert: (Rectangle origin: 10@10 extent: 50@ 60) extent = (50@60).! !

!RectangleTest methodsFor: 'setup-teardown' stamp: 'zz 10/16/2007 20:39'!
setUp
	emptyRectangle := 0 @ 0 corner: 0 @ 0.
	rectangle1 := 10@10 corner:20@20! !

!RectangleTest methodsFor: 'tests' stamp: 'StephaneDucasse 5/28/2011 13:35'!
testAnEmptyRectangleHasNoArea
	self assert: emptyRectangle area = 0! !

!RectangleTest methodsFor: 'tests-rectangle functions' stamp: 'MarcusDenker 10/8/2014 12:27'!
testPointNearestTo

	| rectangle negativeRectangle |
	rectangle := 10 @ 10 corner: 20 @ 20.
	self assert: 10 @ 10 equals: (rectangle pointNearestTo: 9 @ 9).
	self assert: 20 @ 20 equals: (rectangle pointNearestTo: 21 @ 21).
	self assert: 10 @ 20 equals: (rectangle pointNearestTo: 9 @ 21).
	self assert: 20 @ 10 equals: (rectangle pointNearestTo: 21 @ 10).
	self assert: 10 @ 15 equals: (rectangle pointNearestTo: 11 @ 15).
	self assert: 15 @ 10 equals: (rectangle pointNearestTo: 15 @ 13).
	self assert: 20 @ 15 equals: (rectangle pointNearestTo: 17 @ 15).
	self assert: 15 @ 20 equals: (rectangle pointNearestTo: 15 @ 18).
	negativeRectangle := -10 @ -10 corner: -20 @ -20.
	self assert: -10 @ -10 equals: (negativeRectangle pointNearestTo: 0@0).! !

!RectangleTest methodsFor: 'tests-accessing' stamp: 'thomasvincent 10/18/2014 13:10'!
testTop
|rect|
rect:=(0 @ 0 corner: 20 @ 20) top:10.
self assert: rect top = 10.! !

!RectangleTest methodsFor: 'tests-accessing' stamp: 'thomasvincent 10/18/2014 12:57'!
testRight
|rect|
rect:=(0 @ 0 corner: 20 @ 20) right:10.
self assert: rect right = 10.! !

!RectangleTest methodsFor: 'tests' stamp: 'test 10/22/2007 21:37'!
testAreasOutside1

    | frame rects visibleArea  |
    frame := 0@0 extent: 300@300.
    rects := OrderedCollection new: 80.
    0 to: 3 do: [:i |
      0 to: 2 do: [:j |
            rects add: (i@j * 20 extent: 10@10)
    ]  ].
  
   visibleArea := Array with: frame.
   rects do: [:aRectangle |  | remnants |
      remnants := OrderedCollection new.
      visibleArea do: [:a | remnants addAll: (a areasOutside: aRectangle)].
      visibleArea := remnants.
  ].
  visibleArea := visibleArea asArray.
  self assert: (visibleArea allSatisfy: [:r | r area ~= 0]).
   1 to: visibleArea size do: [:index |
     index + 1 to: visibleArea size do: [:index2 |
        self deny: ((visibleArea at: index) intersects: (visibleArea at: index2)).
  ]  ].

  1 to: rects size do: [:index |
     1 to: visibleArea size do: [:index2 |
        self deny: ((rects at: index) intersects: (visibleArea at: index2)).
  ]  ]! !

!RectangleTest methodsFor: 'tests' stamp: 'zz 10/16/2007 20:14'!
testMergingNestedRectanglesReturnTheContainer

	| aCollection merge |
	aCollection := OrderedCollection new.
	aCollection add: (Rectangle left: 1 right: 10 top: 1 bottom: 10).
	aCollection add: (Rectangle left: 4 right: 5 top: 4 bottom: 5).
	merge := Rectangle merging: aCollection.
	self assert: merge = aCollection first.! !

!RectangleTest methodsFor: 'tests' stamp: 'StephaneDucasse 10/13/2013 16:44'!
testWithRightDoesNotProduceInvalidRectangle
	"self debug: #testWithRightDoesNotProduceInvalidRectangle"

	| rect1 rect2 |
	rect1 := 0@10 corner: 50@60.
	
	"it is possible to adjust the right to the right of the current right side"
	rect2 := rect1 withRight: 100.
	self assert: rect2 right equals: 100.

	"it is possible to adjust the right to the left of the current right side but not over the left side!!!!!!!!"
	rect2 := rect1 withRight: 40.
	self assert: rect2 right equals: 40.
	
	"it is possible to adjust the right to be to the left of the current right side but not over the left side itself, at the maximum 
	you will a zero width rectangle!!!!!!!!"
	rect2 := rect1 withRight: -10.
	self assert: rect2 right equals: 0.
	self assert: rect2 width isZero
	! !

!RectangleTest methodsFor: 'tests-rectangle functions' stamp: 'AugustinPetre 10/31/2013 00:29'!
testSideNearestTo
	"rectangular area of screen implies that negalive coordinates not allowed"
	| rectangle |
	rectangle := 5 @ 5 corner: 45 @ 45.
	self assert: #left equals: (rectangle sideNearestTo: 4 @ 34).
	self assert: #right equals: (rectangle sideNearestTo: 60 @ 21).
	self assert: #top equals: (rectangle sideNearestTo: 25 @ 1).
	self assert: #bottom equals: (rectangle sideNearestTo: 23 @ 65)! !

!RectangleTest methodsFor: 'tests' stamp: 'zz 10/22/2007 09:12'!
testMergingOverlappingRectangles
	| aCollection merge |
	aCollection := OrderedCollection new.
	aCollection
		add: (Rectangle
				left: 5
				right: 10
				top: 0
				bottom: 15);
		
		add: (Rectangle
				left: 0
				right: 15
				top: 5
				bottom: 10).
	merge := Rectangle merging: aCollection.
	self assert: merge
			= (Rectangle
					left: 0
					right: 15
					top: 0
					bottom: 15)! !

!RectangleTest methodsFor: 'tests' stamp: 'Sd 8/2/2014 16:37'!
testSettingLeftDoesNotProduceInvalidRectangle
  
	| rect1 rect2 |
	
	rect1 := 0@0 corner: 40@40.

	"the left side of new rectangle wants to be beyond the right side of it"
	rect2 := rect1 left: 50.
	
	self assert: rect2 left equals: 40.
	self assert: rect2 right equals: 50.! !

!RectangleTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/31/2015 22:26'!
testCenterEmpty2

      | r1 c |
      r1 := 0@0 corner: 0@0.
		"does not create an empty rectangle"
      c := r1 center.
      self deny: (r1 containsPoint: c) description: 'An empty rectangle does not contain its center.'.
      self assert: (r1 topLeft dist: c) = (r1 bottomRight dist: c).
      self assert: (r1 bottomLeft dist: c) = (r1 topRight dist: c).
      self assert: (r1 topLeft dist: c) = (r1 bottomLeft dist: c).
      self assert: (r1 translateBy: -20@10) center = (c translateBy: -20@10) description: 'the center is translated with the rectangle'.! !

!RectangleTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:23'!
testStoreOn
	| assoc assoc2 |
	assoc := (0 @ 0 extent: 1 @ 1) -> 0.
	assoc2 := self class compiler evaluate: assoc storeString.
	self assert: assoc key = assoc2 key.
	self assert: assoc value = assoc2 value! !

!RectangleTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/31/2015 22:20'!
testCenterEmptyBasedOnPointPoint

      | r1 c |
		r1 := Rectangle point: 30@10 point: 10@20.
		"does not create an empty rectangle"
      c := r1 center.
      self assert: (r1 containsPoint: c) description: 'A rectangle contain its center.'.
      self assert: (r1 topLeft dist: c) = (r1 bottomRight dist: c).
      self assert: (r1 bottomLeft dist: c) = (r1 topRight dist: c).
      self assert: (r1 topLeft dist: c) = (r1 bottomLeft dist: c).
      self assert: (r1 translateBy: -20@10) center = (c translateBy: -20@10) description: 'the center is translated with the rectangle'.! !

!ReduceTest commentStamp: 'TorstenBergmann 2/20/2014 15:30'!
SUnit tests for reducing collections!
!ReduceTest methodsFor: 'testing' stamp: 'LukasRenggli 5/10/2010 12:58'!
testReduceCollection2Arguments
	| block |
	block := [ :a :b | a + b ].
	self collectionClasses do: [ :class |
		self should: [ class new reduce: block ] raise: Error.
		self assert: ((class with: 1) reduce: block) = 1.
		self assert: ((class with: 1 with: 2) reduce: block) = 3.
		self assert: ((class with: 1 with: 2 with: 3) reduce: block) = 6.
		self assert: ((class with: 1 with: 2 with: 3 with: 4) reduce: block) = 10 ]! !

!ReduceTest methodsFor: 'testing' stamp: 'LukasRenggli 5/10/2010 12:58'!
testReduceLeftSpecial
	self assert: ((1 to: 100) reduceLeft: [ :a :b | a - b ]) = -5048.
	self assert: ('abc' reduceLeft: [ :a :b | Array with: a with: b ]) = #(($a $b) $c)! !

!ReduceTest methodsFor: 'accessing' stamp: 'LukasRenggli 5/10/2010 12:58'!
collectionClasses
	^ (Array with: Set with: Bag) , (self sequenceableClasses)! !

!ReduceTest methodsFor: 'testing' stamp: 'LukasRenggli 5/10/2010 12:58'!
testReduceRightSpecial
	self assert: ((1 to: 100) reduceRight: [ :a :b | a - b ]) = -50.
	self assert: ('abc' reduceRight: [ :a :b | Array with: a with: b ]) = #($a ($b $c))! !

!ReduceTest methodsFor: 'testing' stamp: 'LukasRenggli 5/10/2010 12:58'!
testReduceLeft2Arguments
	| block |
	block := [ :a :b | Array with: a with: b ].
	self sequenceableClasses do: [ :class |
		self should: [ class new reduceLeft: block ] raise: Error.
		self assert: ((class with: #a) reduceLeft: block) = #a.
		self assert: ((class with: #a with: #b) reduceLeft: block) = #(a b).
		self assert: ((class with: #a with: #b with: #c) reduceLeft: block) = #((a b) c).
		self assert: ((class with: #a with: #b with: #c with: #d) reduceLeft: block) = #(((a b) c) d).
		self assert: ((class with: #a with: #b with: #c with: #d with: #e) reduceLeft: block) = #((((a b) c) d) e) ]! !

!ReduceTest methodsFor: 'testing' stamp: 'LukasRenggli 5/10/2010 12:58'!
testReduceLeft3Arguments
	| block |
	block := [ :a :b :c | Array with: a with: b with: c ].
	self sequenceableClasses do: [ :class |
		self should: [ class new reduceLeft: block ] raise: Error.
		self assert: ((class with: #a) reduceLeft: block) = #a.
		self should: [ (class with: #a with: #b) reduceLeft: block ] raise: Error.
		self assert: ((class with: #a with: #b with: #c) reduceLeft: block) = #(a b c).
		self should: [ (class with: #a with: #b with: #c with: #d) reduceLeft: block ] raise: Error.
		self assert: ((class with: #a with: #b with: #c with: #d with: #e) reduceLeft: block) = #((a b c) d e) ]! !

!ReduceTest methodsFor: 'accessing' stamp: 'LukasRenggli 5/10/2010 12:58'!
sequenceableClasses
	^ Array with: Array with: OrderedCollection with: SortedCollection! !

!ReduceTest methodsFor: 'testing' stamp: 'LukasRenggli 5/10/2010 12:58'!
testReduceRight3Arguments
	| block |
	block := [ :a :b :c | Array with: a with: b with: c ].
	self sequenceableClasses do: [ :class |
		self should: [ class new reduceRight: block ] raise: Error.
		self assert: ((class with: #a) reduceRight: block) = #a.
		self should: [ (class with: #a with: #b) reduceRight: block ] raise: Error.
		self assert: ((class with: #a with: #b with: #c) reduceRight: block) = #(a b c).
		self should: [ (class with: #a with: #b with: #c with: #d) reduceRight: block ] raise: Error.
		self assert: ((class with: #a with: #b with: #c with: #d with: #e) reduceRight: block) = #(a b (c d e)) ]! !

!ReduceTest methodsFor: 'testing' stamp: 'LukasRenggli 5/10/2010 12:58'!
testReduceCollection3Arguments
	| block |
	block := [ :a :b :c | a + b + c ].
	self collectionClasses do: [ :class |
		self should: [ class new reduce: block ] raise: Error.
		self assert: ((class with: 1) reduce: block) = 1.
		self should: [ (class with: 1 with: 2) reduce: block ] raise: Error.
		self assert: ((class with: 1 with: 2 with: 3) reduce: block) = 6.
		self should: [ (class with: 1 with: 2 with: 3 with: 4) reduce: block ] raise: Error ]! !

!ReduceTest methodsFor: 'testing' stamp: 'LukasRenggli 5/10/2010 12:58'!
testReduceRight2Arguments
	| block |
	block := [ :a :b | Array with: a with: b ].
	self sequenceableClasses do: [ :class |
		self should: [ class new reduceRight: block ] raise: Error.
		self assert: ((class with: #a) reduceRight: block) = #a.
		self assert: ((class with: #a with: #b) reduceRight: block) = #(a b).
		self assert: ((class with: #a with: #b with: #c) reduceRight: block) = #(a (b c)).
		self assert: ((class with: #a with: #b with: #c with: #d) reduceRight: block) = #(a (b (c d))).
		self assert: ((class with: #a with: #b with: #c with: #d with: #e) reduceRight: block) = #(a (b (c (d e)))) ]! !

!ReflectiveMethod commentStamp: 'MarcusDenker 2/25/2015 18:00'!
I am a method, but not a compiled method storing bytecode, but a high-level model of a method referencing the AST.

to be compatible to CompiledMethod, I forward sends to a compiled method of myself.

When I am installed in a class, #run:with:in: will compile a new compiledMethod and install it. This compiledMethod has a reference to me. We form a "twin" were we reference each other and either can be installed.

call #invalidate to force the installation of the ReflectiveMethod, and therefore code generation on the next execution.!
!ReflectiveMethod methodsFor: 'accessing' stamp: 'MarcusDenker 3/6/2015 15:41'!
compiledMethod: aCompiledMethod
	compiledMethod := aCompiledMethod.
	ast := compiledMethod ast.! !

!ReflectiveMethod methodsFor: 'accessing' stamp: 'MarcusDenker 3/6/2015 15:41'!
ast
	^ast! !

!ReflectiveMethod methodsFor: 'invalidate' stamp: 'MarcusDenker 2/26/2015 12:47'!
invalidate
	"nop: I am already installed"! !

!ReflectiveMethod methodsFor: 'evaluation' stamp: 'MarcusDenker 3/7/2015 08:24'!
recompileAST
	compiledMethod := ast generate: compiledMethod trailer.
	compiledMethod reflectiveMethod: self.! !

!ReflectiveMethod methodsFor: 'inspector extensions' stamp: 'MarcusDenker 3/19/2015 17:12'!
gtInspectorASTIn: composite
	<gtInspectorPresentationOrder: 35> 
	self compiledMethod gtInspectorASTIn: composite! !

!ReflectiveMethod methodsFor: 'accessing' stamp: 'MarcusDenker 2/26/2015 12:55'!
linkCount
	^linkCount ifNil: [ linkCount := 0 ]! !

!ReflectiveMethod methodsFor: 'invalidate' stamp: 'MarcusDenker 3/6/2015 16:14'!
installCompiledMethod
	| class |
	class := ast compilationContext getClass.
	class basicAddSelector: self selector withMethod: compiledMethod.! !

!ReflectiveMethod methodsFor: 'accessing' stamp: 'MarcusDenker 3/6/2015 16:46'!
compiledMethod
	^compiledMethod! !

!ReflectiveMethod methodsFor: 'testing' stamp: 'MarcusDenker 2/26/2015 12:55'!
hasLinks
	^self linkCount > 0.! !

!ReflectiveMethod methodsFor: 'testing' stamp: 'MarcusDenker 3/1/2015 09:33'!
decreaseLinkCount
	linkCount := linkCount - 1.! !

!ReflectiveMethod methodsFor: 'reflective operations' stamp: 'MarcusDenker 2/25/2015 18:05'!
doesNotUnderstand: aMessage
	^aMessage sendTo: compiledMethod
! !

!ReflectiveMethod methodsFor: 'accessing' stamp: 'MarcusDenker 3/6/2015 16:46'!
reflectiveMethod
	^self! !

!ReflectiveMethod methodsFor: 'inspector extensions' stamp: 'MarcusDenker 3/19/2015 17:14'!
gtInspectorSourceIn: composite
	<gtInspectorPresentationOrder: 30> 
	self compiledMethod gtInspectorSourceIn: composite! !

!ReflectiveMethod methodsFor: 'invalidate' stamp: 'MarcusDenker 2/27/2015 16:54'!
destroyTwin
	self installCompiledMethod.
	compiledMethod reflectiveMethod: nil.! !

!ReflectiveMethod methodsFor: 'evaluation' stamp: 'MarcusDenker 3/6/2015 16:09'!
run: aSelector with: anArray in: aReceiver	
	"we install the old one as the compiler might need it"
	self installCompiledMethod.
	self recompileAST.
	self installCompiledMethod.
	^compiledMethod valueWithReceiver: aReceiver arguments: anArray! !

!ReflectiveMethod methodsFor: 'testing' stamp: 'MarcusDenker 3/1/2015 09:35'!
increaseLinkCount
	linkCount := self linkCount + 1.! !

!ReflectiveMethod methodsFor: 'testing' stamp: 'MarcusDenker 3/1/2015 09:33'!
installLink
	self increaseLinkCount.
	self invalidate.! !

!ReflectiveMethod methodsFor: 'invalidate' stamp: 'MarcusDenker 3/1/2015 18:20'!
removeLink
	self decreaseLinkCount.
	self linkCount = 0 ifTrue: [ self destroyTwin ]
		! !

!ReflectiveMethod methodsFor: 'inspector extensions' stamp: 'MarcusDenker 3/19/2015 17:13'!
gtInspectorIrIn: composite
	<gtInspectorPresentationOrder: 35> 
	self compiledMethod gtInspectorIrIn: composite! !

!ReflectiveMethod methodsFor: 'inspector extensions' stamp: 'MarcusDenker 3/19/2015 17:14'!
gtInspectorPragmasIn: composite
	<gtInspectorPresentationOrder: 30> 
	self compiledMethod gtInspectorPragmasIn: composite! !

!ReflectiveMethod methodsFor: 'accessing' stamp: 'MarcusDenker 2/26/2015 13:22'!
linkCount: aNumber
	linkCount := aNumber! !

!ReflectiveMethod methodsFor: 'invalidate' stamp: 'MarcusDenker 2/26/2015 13:14'!
createTwin
	"do nothing"! !

!ReflectiveMethod class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 17:16'!
gtExampleMethod
	<gtExample>
	^ self on: (self class >> #gtExampleMethod)! !

!ReflectiveMethod class methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 2/26/2015 11:06'!
on: aCompiledMethod 
	^self new
		compiledMethod: aCompiledMethod
! !

!ReflectiveMethodTest commentStamp: 'MarcusDenker 3/1/2015 18:23'!
Tests for Reflective method!
!ReflectiveMethodTest methodsFor: 'tests - creation' stamp: 'MarcusDenker 2/27/2015 16:56'!
testInvalidateWithLinkCount
	(ReflectivityExamples>>#exampleMethod) createTwin. 
	(ReflectivityExamples>>#exampleMethod) invalidate. 
	(ReflectivityExamples>>#exampleMethod) linkCount: 1.
	self assert: (ReflectivityExamples>>#exampleMethod) class = ReflectiveMethod.
	self assert: ReflectivityExamples new exampleMethod = 5.
	self assert: (ReflectivityExamples>>#exampleMethod) class = CompiledMethod. 
	self deny: (ReflectivityExamples>>#exampleMethod) reflectiveMethod isNil.
	
	(ReflectivityExamples>>#exampleMethod) reflectiveMethod: nil.! !

!ReflectiveMethodTest methodsFor: 'tests - links' stamp: 'MarcusDenker 3/1/2015 11:57'!
testUninstallLink
	| sendNode link |
	sendNode := (ReflectivityExamples>>#exampleMethod) ast body statements first value.
	link := MetaLink new.
	sendNode link: link.
	self assert:  (ReflectivityExamples>>#exampleMethod) class = ReflectiveMethod.
	link uninstall.	
	self assert: (ReflectivityExamples>>#exampleMethod) class = CompiledMethod.
	self assert: (ReflectivityExamples>>#exampleMethod) reflectiveMethod = nil.
	! !

!ReflectiveMethodTest methodsFor: 'tests - creation' stamp: 'MarcusDenker 2/26/2015 13:19'!
testCreateReflectiveMethod
	| compiledMethod reflectiveMethod |
	compiledMethod := ReflectivityExamples>>#exampleMethod.
	reflectiveMethod := ReflectiveMethod on: compiledMethod.
	self assert: reflectiveMethod class = ReflectiveMethod.! !

!ReflectiveMethodTest methodsFor: 'tests - creation' stamp: 'MarcusDenker 2/27/2015 17:04'!
testInvalidate
	(ReflectivityExamples>>#exampleMethod) createTwin. 
	(ReflectivityExamples>>#exampleMethod) invalidate. 
	self assert: (ReflectivityExamples>>#exampleMethod) class = ReflectiveMethod.
	self assert: ReflectivityExamples new exampleMethod = 5.
	self assert: (ReflectivityExamples>>#exampleMethod) class = CompiledMethod. 
	(ReflectivityExamples>>#exampleMethod) reflectiveMethod: nil.
	
	! !

!ReflectiveMethodTest methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 3/21/2015 16:40'!
tagExec
	tag := #yes.! !

!ReflectiveMethodTest methodsFor: 'tests - creation' stamp: 'MarcusDenker 2/27/2015 17:04'!
testCreateReflectiveMethodAndInvalidate
	| compiledMethod reflectiveMethod |
	compiledMethod := ReflectivityExamples>>#exampleMethod.
	reflectiveMethod := ReflectiveMethod on: compiledMethod.
	self assert: reflectiveMethod class = ReflectiveMethod.
	compiledMethod reflectiveMethod: reflectiveMethod. 
	self assert: (compiledMethod reflectiveMethod = reflectiveMethod).
	
	compiledMethod invalidate.
	self assert: (ReflectivityExamples>>#exampleMethod) class = ReflectiveMethod.
	self assert: ReflectivityExamples new exampleMethod = 5.
	self assert: (ReflectivityExamples>>#exampleMethod) class = CompiledMethod. 
	(ReflectivityExamples>>#exampleMethod) reflectiveMethod: nil.
	
	! !

!ReflectiveMethodTest methodsFor: 'tests - links' stamp: 'MarcusDenker 3/22/2015 14:47'!
testUninstallLinkAndRun
	| sendNode link |
	self skip.
	sendNode := (ReflectivityExamples>>#exampleMethod) ast body statements first value.
	link := MetaLink new metaObject: self; selector: #tagExec.
	sendNode link: link.
	self assert: sendNode hasMetalink.
	self assert: (ReflectivityExamples>>#exampleMethod) class = ReflectiveMethod.
	self assert: (tag isNil).
	self assert: (ReflectivityExamples new exampleMethod = 5).
	self assert: (tag = #yes).
	self assert: (ReflectivityExamples>>#exampleMethod) class = CompiledMethod.
	link uninstall. 
! !

!ReflectiveMethodTest methodsFor: 'tests - links' stamp: 'MarcusDenker 3/1/2015 10:24'!
testLinkCountTwoLinks
	| sendNode link1 link2 |
	link1 := MetaLink new. 
	link2 := MetaLink new. 
	
	sendNode := (ReflectivityExamples>>#exampleMethod) ast body statements first value.
	sendNode link: link1.
	self assert:  (ReflectivityExamples>>#exampleMethod) linkCount = 1.
	sendNode link: link2.
	self assert: (ReflectivityExamples>>#exampleMethod) linkCount = 2.
	sendNode removeLink: link1.
	self assert: (ReflectivityExamples>>#exampleMethod) linkCount = 1.
	sendNode removeLink: link2.	
	self assert: (ReflectivityExamples>>#exampleMethod) class = CompiledMethod.
	self assert: (ReflectivityExamples>>#exampleMethod) reflectiveMethod = nil.
	! !

!ReflectiveMethodTest methodsFor: 'tests - links' stamp: 'MarcusDenker 3/6/2015 16:14'!
testTwoLinks
	| sendNode link1 link2 |
	link1 := MetaLink new. 
	link2 := MetaLink new. 
	
	sendNode := (ReflectivityExamples>>#exampleMethod) ast body statements first value.
	sendNode link: link1.
	sendNode link: link2. 
	self assert: sendNode links size = 2.
	sendNode removeLink: link1.
	self assert: sendNode links size  = 1.
	sendNode removeLink: link2.	
	self assert: sendNode links isNil.
	self assert: (ReflectivityExamples>>#exampleMethod) class = CompiledMethod.
	self assert: (ReflectivityExamples>>#exampleMethod) reflectiveMethod = nil.
	! !

!ReflectiveMethodTest methodsFor: 'tests - links' stamp: 'MarcusDenker 3/1/2015 11:58'!
testSetLink
	| sendNode link |
	link := MetaLink new.
	sendNode := (ReflectivityExamples>>#exampleMethod) ast body statements first value.
	sendNode link: link.
	self assert: (sendNode links includes: link).
	self assert: (ReflectivityExamples>>#exampleMethod) class = ReflectiveMethod.
	sendNode removeLink: link.
	(ReflectivityExamples>>#exampleMethod) destroyTwin.
	self assert: (ReflectivityExamples>>#exampleMethod) class = CompiledMethod.
	self assert: (ReflectivityExamples>>#exampleMethod) reflectiveMethod = nil.
	! !

!ReflectivityExamples commentStamp: 'MarcusDenker 3/8/2015 09:28'!
Examples for RF!
!ReflectivityExamples methodsFor: 'examples' stamp: 'MarcusDenker 3/8/2015 09:10'!
exampleMethod
	^ 2 + 3! !

!RegexAPIDocumentation commentStamp: 'Tbn 11/12/2010 22:56'!
This is a custom help book providing the API documentation for the regular expression framework.
!
!RegexAPIDocumentation class methodsFor: 'accessing' stamp: 'Tbn 11/12/2010 22:56'!
bookName
	^'API Documentation'! !

!RegexAPIDocumentation class methodsFor: 'defaults' stamp: 'Tbn 11/12/2010 22:59'!
builder
	^PackageAPIHelpBuilder! !

!RegexAPIDocumentation class methodsFor: 'accessing' stamp: 'StephanEggermont 12/9/2013 19:54'!
helpPackages
	^#('Regex-Core' 'Regex-Core-Exceptions' 'Regex-Tests-Core')! !

!RegexCompilationError commentStamp: 'Tbn 11/12/2010 22:38'!
This class represents compilation errors in regular expressions.!
!RegexError commentStamp: 'Tbn 11/12/2010 22:37'!
This is a common superclass for errors in regular expressions.!
!RegexHelp commentStamp: 'Tbn 11/12/2010 22:15'!
This is a custom help book for the regular expression framework.
!
!RegexHelp class methodsFor: 'accessing' stamp: 'Tbn 11/12/2010 22:16'!
bookName
	^'Regular expressions framework'! !

!RegexHelp class methodsFor: 'pages' stamp: 'Tbn 11/12/2010 23:11'!
implementationNotes
	"This method was automatically generated. Edit it using:"
	"RegexHelp edit: #implementationNotes"
	^HelpTopic
		title: 'Implementation notes'
		contents: 
'Version:		1.1
	Released:		October 1999
	Mail to:		Vassili Bykov <vassili@parcplace.com>, <v_bykov@yahoo.com>
	Flames to:		/dev/null

	WHAT IS ADDED

The matcher includes classes in two categories:
	VB-Regex-Syntax
	VB-Regex-Matcher
and a few CharacterArray methods in `VB-regex'' protocol.  No system
classes or methods are modified.

	WHAT TO LOOK AT FIRST

String>>matchesRegex: -- in 90% cases this method is all you need to
access the package.

RxParser -- accepts a string or a stream of characters with a regular
expression, and produces a syntax tree corresponding to the
expression. The tree is made of instances of Rxs<whatever> classes.

RxMatcher -- accepts a syntax tree of a regular expression built by
the parser and compiles it into a matcher: a structure made of
instances of Rxm<whatever> classes. The RxMatcher instance can test
whether a string or a positionable stream of characters matches the
original regular expression, or search a string or a stream for
substrings matching the expression. After a match is found, the
matcher can report a specific string that matched the whole
expression, or any parenthesized subexpression of it.

All other classes support the above functionality and are used by
RxParser, RxMatcher, or both.

	CAVEATS

The matcher is similar in spirit, but NOT in the design--let alone the
code--to the original Henry Spencer''s regular expression
implementation in C.  The focus is on simplicity, not on efficiency.
I didn''t optimize or profile anything.  I may in future--or I may not:
I do this in my spare time and I don''t promise anything.

The matcher passes H. Spencer''s test suite (see ''test suite''
protocol), with quite a few extra tests added, so chances are good
there are not too many bugs.  But watch out anyway.

	EXTENSIONS, FUTURE, ETC.

With the existing separation between the parser, the syntax tree, and
the matcher, it is easy to extend the system with other matchers based
on other algorithms. In fact, I have a DFA-based matcher right now,
but I don''t feel it is good enough to include it here.  I might add
automata-based matchers later, but again I don''t promise anything.

	HOW TO REACH ME

As of today (December 20, 2000), you can contact me at
<vassili@parcplace.com>. If this doesn''t work, look around
comp.lang.smalltalk or comp.lang.lisp.  !!' readStream nextChunkText! !

!RegexHelp class methodsFor: 'pages' stamp: 'Tbn 11/12/2010 23:05'!
introduction
	"This method was automatically generated. Edit it using:"
	"RegexHelp edit: #introduction"
	^HelpTopic
		title: 'Introduction'
		contents: 
'A regular expression is a template specifying a class of strings. A
regular expression matcher is an tool that determines whether a string
belongs to a class specified by a regular expression.  This is a
common task of a user input validation code, and the use of regular
expressions can GREATLY simplify and speed up development of such
code.  As an example, here is how to verify that a string is a valid
hexadecimal number in Smalltalk notation, using this matcher package:

	aString matchesRegex: ''16r[[:xdigit:]]+''

(Coding the same ``the hard way'''' is an exercise to a curious reader).

This matcher is offered to the Smalltalk community in hope it will be
useful. It is free in terms of money, and to a large extent--in terms
of rights of use. Refer to `Boring Stuff'' section for legalese.

The ''What''s new in this release'' section describes the functionality
introduced in 1.1 release.

The `Syntax'' section explains the recognized syntax of regular
expressions.

The `Usage'' section explains matcher capabilities that go beyond what
String>>matchesRegex: method offers.

The `Implementation notes'' sections says a few words about what is
under the hood.

Happy hacking,

--Vassili Bykov 
<vassili@objectpeople.com> <vassili@magma.ca>

August 6, 1996
April 4, 1999!!' readStream nextChunkText! !

!RegexHelp class methodsFor: 'accessing' stamp: 'Tbn 11/12/2010 23:13'!
pages
	^#(introduction whatsNew syntax usage implementationNotes license)! !

!RegexHelp class methodsFor: 'pages' stamp: 'Tbn 11/12/2010 23:13'!
license
	"This method was automatically generated. Edit it using:"
	"RegexHelp edit: #license"
	^HelpTopic
		title: 'License'
		contents: 
'The Regular Expression Matcher (``The Software'''') 
is Copyright (C) 1996, 1999 Vassili Bykov.  
It is provided to the Smalltalk community in hope it will be useful.

1. This license applies to the package as a whole, as well as to any
   component of it. By performing any of the activities described
   below, you accept the terms of this agreement.

2. The software is provided free of charge, and ``as is'''', in hope
   that it will be useful, with ABSOLUTELY NO WARRANTY. The entire
   risk and all responsibility for the use of the software is with
   you.  Under no circumstances the author may be held responsible for
   loss of data, loss of profit, or any other damage resulting
   directly or indirectly from the use of the software, even if the
   damage is caused by defects in the software.

3. You may use this software in any applications you build.

4. You may distribute this software provided that the software
   documentation and copyright notices are included and intact.

5. You may create and distribute modified versions of the software,
   such as ports to other Smalltalk dialects or derived work, provided
   that: 

   a. any modified version is expressly marked as such and is not
   misrepresented as the original software; 

   b. credit is given to the original software in the source code and
   documentation of the derived work; 

   c. the copyright notice at the top of this document accompanies
   copyright notices of any modified version.  !!' readStream nextChunkText! !

!RegexHelp class methodsFor: 'pages' stamp: 'Tbn 11/12/2010 23:10'!
usage
	"This method was automatically generated. Edit it using:"
	"RegexHelp edit: #usage"
	^HelpTopic
		title: 'Usage'
		contents: 
'The preceding section covered the syntax of regular expressions. It
used the simplest possible interface to the matcher: sending
#matchesRegex: message to the sample string, with regular expression
string as the argument.  This section explains hairier ways of using
the matcher.

	PREFIX MATCHING AND CASE-INSENSITIVE MATCHING

A CharacterArray (an EsString in VA) also understands these messages:

	#prefixMatchesRegex: regexString
	#matchesRegexIgnoringCase: regexString
	#prefixMatchesRegexIgnoringCase: regexString

#prefixMatchesRegex: is just like #matchesRegex, except that the whole
receiver is not expected to match the regular expression passed as the
argument; matching just a prefix of it is enough.  For example:

	''abcde'' matchesRegex: ''(a|b)+''		-- false
	''abcde'' prefixMatchesRegex: ''(a|b)+''	-- true

The last two messages are case-insensitive versions of matching.

	ENUMERATION INTERFACE

An application can be interested in all matches of a certain regular
expression within a String.  The matches are accessible using a
protocol modelled after the familiar Collection-like enumeration
protocol:

	#regex: regexString matchesDo: aBlock

Evaluates a one-argument <aBlock> for every match of the regular
expression within the receiver string.

	#regex: regexString matchesCollect: aBlock

Evaluates a one-argument <aBlock> for every match of the regular
expression within the receiver string. Collects results of evaluations
and anwers them as a SequenceableCollection.

	#allRegexMatches: regexString

Returns a collection of all matches (substrings of the receiver
string) of the regular expression.  It is an equivalent of <aString
regex: regexString matchesCollect: [:each | each]>.

	#allRangesOfRegexMatches: regexString

Returns a collection of all character ranges (startIndex to: stopIndex)
that match the regular expression.

	REPLACEMENT AND TRANSLATION

It is possible to replace all matches of a regular expression with a
certain string using the message:

	#copyWithRegex: regexString matchesReplacedWith: aString

For example:

	''ab cd ab'' copyWithRegex: ''(a|b)+'' matchesReplacedWith: ''foo''

A more general substitution is match translation:

	#copyWithRegex: regexString matchesTranslatedUsing: aBlock

This message evaluates a block passing it each match of the regular
expression in the receiver string and answers a copy of the receiver
with the block results spliced into it in place of the respective
matches.  For example:

	''ab cd ab'' copyWithRegex: ''(a|b)+'' matchesTranslatedUsing: [:each | each asUppercase]

All messages of enumeration and replacement protocols perform a
case-sensitive match.  Case-insensitive versions are not provided as
part of a CharacterArray protocol.  Instead, they are accessible using
the lower-level matching interface.

	LOWER-LEVEL INTERFACE

Internally, #matchesRegex: works as follows:

1. A fresh instance of RxParser is created, and the regular expression
string is passed to it, yielding the expression''s syntax tree.

2. The syntax tree is passed as an initialization parameter to an
instance of RxMatcher. The instance sets up some data structure that
will work as a recognizer for the regular expression described by the
tree.

3. The original string is passed to the matcher, and the matcher
checks for a match.

	THE MATCHER

If you repeatedly match a number of strings against the same regular
expression using one of the messages defined in CharacterArray, the
regular expression string is parsed and a matcher is created anew for
every match.  You can avoid this overhead by building a matcher for
the regular expression, and then reusing the matcher over and over
again. You can, for example, create a matcher at a class or instance
initialization stage, and store it in a variable for future use.

You can create a matcher using one of the following methods:

	- Sending #forString:ignoreCase: message to RxMatcher class, with
the regular expression string and a Boolean indicating whether case is
ignored as arguments.

	- Sending #forString: message.  It is equivalent to <... forString:
regexString ignoreCase: false>.

A more convenient way is using one of the two matcher-created messages
understood by CharacterArray.

	- <regexString asRegex> is equivalent to <RxMatcher forString:
regexString>.

	- <regexString asRegexIgnoringCase> is equivalent to <RxMatcher
forString: regexString ignoreCase: true>.

Here are four examples of creating a matcher:

	hexRecognizer := RxMatcher forString: ''16r[0-9A-Fa-f]+''
	hexRecognizer := RxMatcher forString: ''16r[0-9A-Fa-f]+'' ignoreCase: false
	hexRecognizer := ''16r[0-9A-Fa-f]+'' asRegex
	hexRecognizer := ''16r[0-9A-F]+'' asRegexIgnoringCase

	MATCHING

The matcher understands these messages (all of them return true to
indicate successful match or search, and false otherwise):

matches: aString

	True if the whole target string (aString) matches.

matchesPrefix: aString

	True if some prefix of the string (not necessarily the whole
	string) matches.

search: aString

	Search the string for the first occurrence of a matching
	substring. (Note that the first two methods only try matching from
	the very beginning of the string). Using the above example with a
	matcher for `a+'', this method would answer success given a string
	`baaa'', while the previous two would fail.

matchesStream: aStream
matchesStreamPrefix: aStream
searchStream: aStream

	Respective analogs of the first three methods, taking input from a
	stream instead of a string. The stream must be positionable and
	peekable.

All these methods answer a boolean indicating success. The matcher
also stores the outcome of the last match attempt and can report it:

lastResult

	Answers a Boolean -- the outcome of the most recent match
	attempt. If no matches were attempted, the answer is unspecified.

	SUBEXPRESSION MATCHES

After a successful match attempt, you can query the specifics of which
part of the original string has matched which part of the whole
expression.

A subexpression is a parenthesized part of a regular expression, or
the whole expression. When a regular expression is compiled, its
subexpressions are assigned indices starting from 1, depth-first,
left-to-right. For example, `((ab)+(c|d))?ef'' includes the following
subexpressions with these indices:

	1:	((ab)+(c|d))?ef
	2:	(ab)+(c|d)
	3:	ab
	4:	c|d

After a successful match, the matcher can report what part of the
original string matched what subexpression. It understandards these
messages:

subexpressionCount

	Answers the total number of subexpressions: the highest value that
	can be used as a subexpression index with this matcher. This value
	is available immediately after initialization and never changes.

subexpression: anIndex

	An index must be a valid subexpression index, and this message
	must be sent only after a successful match attempt. The method
	answers a substring of the original string the corresponding
	subexpression has matched to.

subBeginning: anIndex
subEnd: anIndex

	Answer positions within the original string or stream where the
	match of a subexpression with the given index has started and
	ended, respectively.

This facility provides a convenient way of extracting parts of input
strings of complex format. For example, the following piece of code
uses the ''MMM DD, YYYY'' date format recognizer example from the
`Syntax'' section to convert a date to a three-element array with year,
month, and day strings (you can select and evaluate it right here):

	| matcher |
	matcher := RxMatcher forString: ''(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)[ ]+(:isDigit::isDigit:?)[ ]*,[ ]*(19|20)(:isDigit::isDigit:)''.
	(matcher matches: ''Aug 6, 1996'')
		ifTrue: 
			[Array 
				with: (matcher subexpression: 5)
				with: (matcher subexpression: 2)
				with: (matcher subexpression: 3)]
		ifFalse: [''no match'']

(should answer ` #(''96'' ''Aug'' ''6'')'').

	ENUMERATION AND REPLACEMENT

The enumeration and replacement protocols exposed in CharacterArray
are actually implemented by the matcher.  The following messages are
understood:

	#matchesIn: aString
	#matchesIn: aString do: aBlock
	#matchesIn: aString collect: aBlock
	#copy: aString replacingMatchesWith: replacementString
	#copy: aString translatingMatchesUsing: aBlock
	#matchingRangesIn: aString

	#matchesOnStream: aStream
	#matchesOnStream: aStream do: aBlock
	#matchesOnStream: aStream collect: aBlock
	#copy: sourceStream to: targetStream replacingMatchesWith: replacementString
	#copy: sourceStream to: targetStream translatingMatchesWith: aBlock

Note that in those methods that take a block, the block may refer to the rxMatcher itself, 
e.g. to collect information about the position the match occurred at, or the
subexpressions of the match. An example can be seen in #matchingRangesIn:

	ERROR HANDLING

Exception signaling objects (Signals in VisualWorks, Exceptions in VisualAge) are
accessible through RxParser class protocol. To handle possible errors, use
the protocol described below to obtain the exception objects and use the
protocol of the native Smalltalk implementation to handle them.

If a syntax error is detected while parsing expression,
RxParser>>syntaxErrorSignal is raised/signaled.

If an error is detected while building a matcher,
RxParser>>compilationErrorSignal is raised/signaled.

If an error is detected while matching (for example, if a bad selector
was specified using `:<selector>:'' syntax, or because of the matcher''s
internal error), RxParser>>matchErrorSignal is raised

RxParser>>regexErrorSignal is the parent of all three.  Since any of
the three signals can be raised within a call to #matchesRegex:, it is
handy if you want to catch them all.  For example:

VisualWorks:

	RxParser regexErrorSignal
		handle: [:ex | ex returnWith: nil]
		do: [''abc'' matchesRegex: ''))garbage['']

VisualAge:

	[''abc'' matchesRegex: ''))garbage['']
		when: RxParser regexErrorSignal
		do: [:signal | signal exitWith: nil]
!!' readStream nextChunkText! !

!RegexHelp class methodsFor: 'pages' stamp: 'Tbn 11/12/2010 23:08'!
syntax
	"This method was automatically generated. Edit it using:"
	"RegexHelp edit: #syntax"
	^HelpTopic
		title: 'Syntax'
		contents: 
'[You can select and "print it'' examples in this method. Just don''t
forget to cancel the changes.]

The simplest regular expression is a single character.  It matches
exactly that character. A sequence of characters matches a string with
exactly the same sequence of characters:

	''a'' matchesRegex: ''a''				-- true
	''foobar'' matchesRegex: ''foobar''		-- true
	''blorple'' matchesRegex: ''foobar''		-- false

The above paragraph introduced a primitive regular expression (a
character), and an operator (sequencing). Operators are applied to
regular expressions to produce more complex regular expressions.
Sequencing (placing expressions one after another) as an operator is,
in a certain sense, `invisible''--yet it is arguably the most common.

A more `visible'' operator is Kleene closure, more often simply
referred to as `a star''.  A regular expression followed by an asterisk
matches any number (including 0) of matches of the original
expression. For example:

	''ab'' matchesRegex: ''a*b''		 		-- true
	''aaaaab'' matchesRegex: ''a*b''	 	-- true
	''b'' matchesRegex: ''a*b''		 		-- true
	''aac'' matchesRegex: ''a*b''	 		-- false: b does not match

A star''s precedence is higher than that of sequencing. A star applies
to the shortest possible subexpression that precedes it. For example,
''ab*'' means `a followed by zero or more occurrences of b'', not `zero
or more occurrences of ab'':

	''abbb'' matchesRegex: ''ab*''	 		-- true
	''abab'' matchesRegex: ''ab*''		 	-- false

To actually make a regex matching `zero or more occurrences of ab'',
`ab'' is enclosed in parentheses:

	''abab'' matchesRegex: ''(ab)*''		 	-- true
	''abcab'' matchesRegex: ''(ab)*''	 	-- false: c spoils the fun

Two other operators similar to `*'' are `+'' and `?''. `+'' (positive
closure, or simply `plus'') matches one or more occurrences of the
original expression. `?'' (`optional'') matches zero or one, but never
more, occurrences.

	''ac'' matchesRegex: ''ab*c''	 		-- true
	''ac'' matchesRegex: ''ab+c''	 		-- false: need at least one b
	''abbc'' matchesRegex: ''ab+c''		 	-- true
	''abbc'' matchesRegex: ''ab?c''		 	-- false: too many b''s

As we have seen, characters `*'', `+'', `?'', `('', and `)'' have special
meaning in regular expressions. If one of them is to be used
literally, it should be quoted: preceded with a backslash. (Thus,
backslash is also special character, and needs to be quoted for a
literal match--as well as any other special character described
further).

	''ab*'' matchesRegex: ''ab*''		 	-- false: star in the right string is special
	''ab*'' matchesRegex: ''ab\*''	 		-- true
	''a\c'' matchesRegex: ''a\\c''		 	-- true

The last operator is `|'' meaning `or''. It is placed between two
regular expressions, and the resulting expression matches if one of
the expressions matches. It has the lowest possible precedence (lower
than sequencing). For example, `ab*|ba*'' means `a followed by any
number of b''s, or b followed by any number of a''s'':

	''abb'' matchesRegex: ''ab*|ba*''	 	-- true
	''baa'' matchesRegex: ''ab*|ba*''	 	-- true
	''baab'' matchesRegex: ''ab*|ba*''	 	-- false

A bit more complex example is the following expression, matching the
name of any of the Lisp-style `car'', `cdr'', `caar'', `cadr'',
... functions:

	c(a|d)+r

It is possible to write an expression matching an empty string, for
example: `a|''.  However, it is an error to apply `*'', `+'', or `?'' to
such expression: `(a|)*'' is an invalid expression.

So far, we have used only characters as the ''smallest'' components of
regular expressions. There are other, more `interesting'', components.

A character set is a string of characters enclosed in square
brackets. It matches any single character if it appears between the
brackets. For example, `[01]'' matches either `0'' or `1'':

	''0'' matchesRegex: ''[01]''		 		-- true
	''3'' matchesRegex: ''[01]''		 		-- false
	''11'' matchesRegex: ''[01]''		 		-- false: a set matches only one character

Using plus operator, we can build the following binary number
recognizer:

	''10010100'' matchesRegex: ''[01]+''	 	-- true
	''10001210'' matchesRegex: ''[01]+''	 	-- false

If the first character after the opening bracket is `^'', the set is
inverted: it matches any single character *not* appearing between the
brackets:

	''0'' matchesRegex: ''[^01]''		  		-- false
	''3'' matchesRegex: ''[^01]''		 		-- true

For convenience, a set may include ranges: pairs of characters
separated with `-''. This is equivalent to listing all characters
between them: `[0-9]'' is the same as `[0123456789]''.

Special characters within a set are `^'', `-'', and `]'' that closes the
set. Below are the examples of how to literally use them in a set:

	[01^]		-- put the caret anywhere except the beginning
	[01-]		-- put the dash as the last character
	[]01]		-- put the closing bracket as the first character 
	[^]01]			(thus, empty and universal sets cannot be specified)

Regular expressions can also include the following backquote escapes
to refer to popular classes of characters:

	\w	any word constituent character (same as [a-zA-Z0-9_])
	\W	any character but a word constituent
	\d	a digit (same as [0-9])
	\D	anything but a digit
	\s 	a whitespace character (same as [:space:] below)
	\S	anything but a whitespace character

These escapes are also allowed in character classes: ''[\w+-]'' means
''any character that is either a word constituent, or a plus, or a
minus''.

Character classes can also include the following grep(1)-compatible
elements to refer to:

	[:alnum:]		any alphanumeric character (same as [a-zA-Z0-9])
	[:alpha:]		any alphabetic character (same as [a-zA-Z])
	[:cntrl:]		any control character. (any character with code < 32)
	[:digit:]		any decimal digit (same as [0-9])
	[:graph:]		any graphical character. (any character with code >= 32).
	[:lower:]		any lowercase character (including non-ASCII lowercase characters)
	[:print:]		any printable character. In this version, this is the same as [:graph:]
	[:punct:]		any punctuation character:  . , !!!! ? ; : '' - ( ) ` and double quotes
	[:space:]		any whitespace character (space, tab, CR, LF, null, form feed, Ctrl-Z, 16r2000-16r200B, 16r3000)
	[:upper:]		any uppercase character (including non-ASCII uppercase characters)
	[:xdigit:]		any hexadecimal character (same as [a-fA-F0-9]).

Note that many of these are only as consistent or inconsistent on issues
of locale as the underlying Smalltalk implementation. Values shown here
are for VisualWorks 7.6.

Note that these elements are components of the character classes,
i.e. they have to be enclosed in an extra set of square brackets to
form a valid regular expression.  For example, a non-empty string of
digits would be represented as ''[[:digit:]]+''.

The above primitive expressions and operators are common to many
implementations of regular expressions. The next primitive expression
is unique to this Smalltalk implementation.

A sequence of characters between colons is treated as a unary selector
which is supposed to be understood by Characters. A character matches
such an expression if it answers true to a message with that
selector. This allows a more readable and efficient way of specifying
character classes. For example, `[0-9]'' is equivalent to `:isDigit:'',
but the latter is more efficient. Analogously to character sets,
character classes can be negated: `:^isDigit:'' matches a Character
that answers false to #isDigit, and is therefore equivalent to
`[^0-9]''.

As an example, so far we have seen the following equivalent ways to
write a regular expression that matches a non-empty string of digits:

	''[0-9]+''
	''\d+''
	''[\d]+''
	''[[:digit:]]+''
	:isDigit:+''

The last group of special primitive expressions includes: 

	.	matching any character except a NULL; 
	^	matching an empty string at the beginning of a line; 
	$	matching an empty string at the end of a line.
	\b	an empty string at a word boundary
	\B	an empty string not at a word boundary
	\<	an empty string at the beginning of a word
	\>	an empty string at the end of a word

	''axyzb'' matchesRegex: ''a.+b''		-- true
	''ax zb'' matchesRegex: ''a.+b''			-- true (space is matched by `.'')
	''ax
zb'' matchesRegex: ''a.+b''				-- true (carriage return is matched by `.'')

Again, the dot ., caret ^ and dollar $ characters are special and should be quoted
to be matched literally.

	EXAMPLES

As the introductions said, a great use for regular expressions is user
input validation. Following are a few examples of regular expressions
that might be handy in checking input entered by the user in an input
field. Try them out by entering something between the quotes and
print-iting. (Also, try to imagine Smalltalk code that each validation
would require if coded by hand).  Most example expressions could have
been written in alternative ways.

Checking if aString may represent a nonnegative integer number:

	'''' matchesRegex: '':isDigit:+''
or
	'''' matchesRegex: ''[0-9]+''
or
	'''' matchesRegex: ''\d+''

Checking if aString may represent an integer number with an optional
sign in front:

	'''' matchesRegex: ''(\+|-)?\d+''

Checking if aString is a fixed-point number, with at least one digit
is required after a dot:

	'''' matchesRegex: ''(\+|-)?\d+(\.\d+)?''

The same, but allow notation like `123.'':

	'''' matchesRegex: ''(\+|-)?\d+(\.\d*)?''

Recognizer for a string that might be a name: one word with first
capital letter, no blanks, no digits.  More traditional:

	'''' matchesRegex: ''[A-Z][A-Za-z]*''

more Smalltalkish:

	'''' matchesRegex: '':isUppercase::isAlphabetic:*''

A date in format MMM DD, YYYY with any number of spaces in between, in
XX century:

	'''' matchesRegex: ''(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)[ ]+(\d\d?)[ ]*,[ ]*19(\d\d)''

Note parentheses around some components of the expression above. As
`Usage'' section shows, they will allow us to obtain the actual strings
that have matched them (i.e. month name, day number, and year number).

For dessert, coming back to numbers: here is a recognizer for a
general number format: anything like 999, or 999.999, or -999.999e+21.

	'''' matchesRegex: ''(\+|-)?\d+(\.\d*)?((e|E)(\+|-)?\d+)?''
!!' readStream nextChunkText! !

!RegexHelp class methodsFor: 'pages' stamp: 'Tbn 11/12/2010 23:06'!
whatsNew
	"This method was automatically generated. Edit it using:"
	"RegexHelp edit: #whatsNew"
	^HelpTopic
		title: 'What''s new'
		contents: 
'VERSION 1.3.1 (September 2008)
1. Updated documentation of character classes, making clear the problems of locale - an area for future improvement

VERSION 1.3 (September 2008)
1. \w now matches underscore as well as alphanumerics, in line with most other regex libraries (and our documentation!!!!).  
2. \W rejects underscore as well as alphanumerics
3. added tests for this at end of testSuite
4. updated documentation and added note to old incorrect comments in version 1.1 below

VERSION 1.2.3 (November 2007)

1. Regexs with ^ or $ applied to copy empty strings caused infinite loops, e.g. ('''' copyWithRegex: ''^.*$'' matchesReplacedWith: ''foo''). Applied a similar correction to that from version 1.1c, to #copyStream:to:(replacingMatchesWith:|translatingMatchesUsing:).
2. Extended RxParser testing to run each test for #copy:translatingMatchesUsing: as well as #search:.
3. Corrected #testSuite test that a dot does not match a null, which was passing by luck with Smalltalk code in a literal array.
4. Added test to end of test suite for fix 1 above.

VERSION 1.2.2 (November 2006)

There was no way to specify a backslash in a character set. Now [\\] is accepted.

VERSION 1.2.1	(August 2006)

1. Support for returning all ranges (startIndex to: stopIndex) matching a regex - #allRangesOfRegexMatches:, #matchingRangesIn:
2. Added hint to usage documentation on how to get more information about matches when enumerating
3. Syntax description of dot corrected: matches anything but NUL since 1.1a

VERSION 1.2	(May 2006)

Fixed case-insensitive search for character sets.

VERSION 1.1c	(December 2004)

Fixed the issue with #matchesOnStream:do: which caused infinite loops for matches 
that matched empty strings.

VERSION 1.1b	(November 2001)

Changes valueNowOrOnUnwindDo: to ensure:, plus incorporates some earlier fixes.

VERSION 1.1a	(May 2001)

1. Support for keeping track of multiple subexpressions.
2. Dot (.) matches anything but NUL character, as it should per POSIX spec.
3. Some bug fixes.

VERSION 1.1	(October 1999)

Regular expression syntax corrections and enhancements:

1. Backslash escapes similar to those in Perl are allowed in patterns:

	\w	any word constituent character (equivalent to [a-zA-Z0-9_]) *** underscore only since 1.3 ***
	\W	any character but a word constituent (equivalent to [^a-xA-Z0-9_] *** underscore only since 1.3 ***
	\d	a digit (same as [0-9])
	\D	anything but a digit
	\s 	a whitespace character
	\S	anything but a whitespace character
	\b	an empty string at a word boundary
	\B	an empty string not at a word boundary
	\<	an empty string at the beginning of a word
	\>	an empty string at the end of a word

For example, ''\w+'' is now a valid expression matching any word.

2. The following backslash escapes are also allowed in character sets
(between square brackets):

	\w, \W, \d, \D, \s, and \S.

3. The following grep(1)-compatible named character classes are
recognized in character sets as well:

	[:alnum:]
	[:alpha:]
	[:cntrl:]
	[:digit:]
	[:graph:]
	[:lower:]
	[:print:]
	[:punct:]
	[:space:]
	[:upper:]
	[:xdigit:]

For example, the following patterns are equivalent:

	''[[:alnum:]_]+'' ''\w+''  ''[\w]+'' ''[a-zA-Z0-9_]+'' *** underscore only since 1.3 ***

4. Some non-printable characters can be represented in regular
expressions using a common backslash notation:

	\t	tab (Character tab)
	\n	newline (Character lf)
	\r	carriage return (Character cr)
	\f	form feed (Character newPage)
	\e	escape (Character esc)

5. A dot is corectly interpreted as ''any character but a newline''
instead of ''anything but whitespace''.

6. Case-insensitive matching.  The easiest access to it are new
messages CharacterArray understands: #asRegexIgnoringCase,
#matchesRegexIgnoringCase:, #prefixMatchesRegexIgnoringCase:.

7. The matcher (an instance of RxMatcher, the result of
String>>asRegex) now provides a collection-like interface to matches
in a particular string or on a particular stream, as well as
substitution protocol. The interface includes the following messages:

	matchesIn: aString
	matchesIn: aString collect: aBlock
	matchesIn: aString do: aBlock

	matchesOnStream: aStream
	matchesOnStream: aStream collect: aBlock
	matchesOnStream: aStream do: aBlock

	copy: aString translatingMatchesUsing: aBlock
	copy: aString replacingMatchesWith: replacementString

	copyStream: aStream to: writeStream translatingMatchesUsing: aBlock
	copyStream: aStream to: writeStream replacingMatchesWith: aString

Examples:

	''\w+'' asRegex matchesIn: ''now is the time''

returns an OrderedCollection containing four strings: ''now'', ''is'',
''the'', and ''time''.

	''\<t\w+'' asRegexIgnoringCase
		copy: ''now is the Time''
		translatingMatchesUsing: [:match | match asUppercase]

returns ''now is THE TIME'' (the regular expression matches words
beginning with either an uppercase or a lowercase T).

ACKNOWLEDGEMENTS

Since the first release of the matcher, thanks to the input from
several fellow Smalltalkers, I became convinced a native Smalltalk
regular expression matcher was worth the effort to keep it alive. For
the contributions, suggestions, and bug reports that made this release 
possible, I want to thank:

	Felix Hack
	Peter Hatch
	Alan Knight
	Eliot Miranda
	Thomas Muhr
	Robb Shecter
	David N. Smith
	Francis Wolinski

and anyone whom I haven''t yet met or heard from, but who agrees this
has not been a complete waste of time.

--Vassili Bykov
October 3, 1999!!' readStream nextChunkText! !

!RegexMatchingError commentStamp: 'Tbn 11/12/2010 22:38'!
This class represents matching errors in regular expressions.!
!RegexSyntaxError commentStamp: 'Tbn 11/12/2010 22:38'!
This class represents syntax errors in regular expressions.!
!RegexSyntaxError methodsFor: 'accessing' stamp: 'CamilloBruni 10/7/2012 22:51'!
position: anInteger
	position := anInteger.! !

!RegexSyntaxError methodsFor: 'accessing' stamp: 'CamilloBruni 10/7/2012 22:47'!
position
	"return the parsing error location"
	^ position! !

!RegexSyntaxError class methodsFor: 'signaling' stamp: 'CamilloBruni 10/7/2012 22:51'!
signal: anErrorMessage at: errorPosition
	^ (self new)
		position: errorPosition;
		signal: anErrorMessage! !

!RegisterableTranslatorMock commentStamp: 'TorstenBergmann 9/16/2014 15:16'!
I'm a mock object to mock a translator!
!RegisterableTranslatorMock methodsFor: 'initialization' stamp: 'TorstenBergmann 9/16/2014 15:19'!
initialize
	"Initializes the receiver"
	
	super initialize.
	translations := Dictionary new.
	translations at: #'TestCase' put: 'Testfall'! !

!RegisterableTranslatorMock methodsFor: 'translate' stamp: 'TorstenBergmann 9/16/2014 15:21'!
translate: aString
	"Dispatch to a registered translator to translate the given string or (if there is no translator) return the untranslated string."
	^translations at: aString asSymbol ifAbsent: [ aString ] 
! !

!RegisterableTranslatorMock methodsFor: 'translate' stamp: 'TorstenBergmann 9/16/2014 15:20'!
translate: aString toLocale: localeID
 
	^self translate: aString! !

!RelationSet commentStamp: 'JanVanDeSandt 2/27/2015 11:25'!
I'm a Set like collection that is used to hold collections of associated objects. When an object is added to or removed from this collection the inverse side is also updated.!
!RelationSet methodsFor: 'private' stamp: 'JanVanDeSandt 2/21/2015 14:58'!
species

	^Set! !

!RelationSet methodsFor: 'accessing' stamp: 'JanVanDeSandt 2/21/2015 16:51'!
size
	^set ifNil: [0] ifNotNil: [ set size ]! !

!RelationSet methodsFor: 'enumerating' stamp: 'JanVanDeSandt 2/21/2015 16:46'!
do: aBlock 
	"Evaluate aBlock with each of the receiver's elements as the argument."

	set do: aBlock! !

!RelationSet methodsFor: 'adding' stamp: 'JanVanDeSandt 2/21/2015 17:06'!
add: anObject

	(self includes: anObject)
		ifTrue: [ ^anObject ].
		
	slot add: anObject to: owner.
	^set add: anObject! !

!RelationSet methodsFor: 'initailize-release' stamp: 'JanVanDeSandt 2/21/2015 16:44'!
initializeOwner: anObject slot: aToManyAssociation

	owner := anObject.
	slot := aToManyAssociation.
	set := Set new! !

!RelationSet methodsFor: 'removing' stamp: 'JanVanDeSandt 2/21/2015 17:07'!
remove: oldObject ifAbsent: aBlock

	(set includes: oldObject)
		ifFalse: [ ^aBlock value ].
		
	slot remove: oldObject from: owner.
	^set remove: oldObject ifAbsent: aBlock! !

!RelationSet methodsFor: 'internal' stamp: 'JanVanDeSandt 2/21/2015 16:45'!
inverseAdd: anObject

	^set add: anObject! !

!RelationSet methodsFor: 'copying' stamp: 'JanVanDeSandt 2/27/2015 11:09'!
copy

	^Set new 
		addAll: self;
		yourself! !

!RelationSet methodsFor: 'internal' stamp: 'JanVanDeSandt 2/21/2015 16:45'!
inverseRemove: anObject

	^set remove: anObject! !

!RelationSet class methodsFor: 'instance creation' stamp: 'JanVanDeSandt 2/21/2015 09:54'!
owner: anObject slot: aToManyAssociation

	^self new initializeOwner: anObject slot: aToManyAssociation ! !

!RelationSetTest methodsFor: 'tests' stamp: 'JanVanDeSandt 2/27/2015 11:27'!
testCopy
	"A copy of an RelationSet should give us a regular Set."

	| movie |
	
	movie := SlotExampleMovie new.
	self assert: movie actors isCollection.
	self assert: movie actors copy isCollection.
	self deny: movie actors copy class = RelationSet! !

!RelationSetTest methodsFor: 'tests' stamp: 'JanVanDeSandt 2/21/2015 20:06'!
testSelect

	| movie result |
	
	movie := SlotExampleMovie named: 'Thelma and Louise'.
	movie
		addActor: (SlotExamplePerson named: 'P1') ;
		addActor: (SlotExamplePerson named: 'P2').

	result := movie actors select: [ :e | e name = 'P1' ].
	self assert: result class equals: Set.
	self assert: result size equals: 1.
	self assert: result anyOne name equals: 'P1'.! !

!RelationSlot commentStamp: 'JanVanDeSandt 2/27/2015 11:26'!
I'm a Slot that represents one side of a relationship. If this side of the relationship is updated I take care of keeping the other side up to date.

I'm abstract, use  the ToOne or ToMany  subclass depending on the cardinality.

Instance Variables
	inverseName:		<String>
	inverseSlot:		<RelationSlot>
	targetClass:		<Class> or <Symbol>

inverseName
	- the name  of the slot of the other side of the relationship

inverseSlot
	- the slot of the other side of the relationship

targetClass
	- the class or the name of the class this slot refers to
!
!RelationSlot methodsFor: 'comparing' stamp: 'JanVanDeSandt 2/22/2015 14:12'!
hash
	^ ((self species hash bitXor: self name hash) 
			bitXor: (self index ifNil: [ 0 ])) 
				bitXor: self targetClassName hash! !

!RelationSlot methodsFor: 'code generation' stamp: 'JanVanDeSandt 2/21/2015 16:25'!
emitStore: aMethodBuilder
	aMethodBuilder
		pushLiteral: self;
		pushReceiver;
		send: #writeToSlot:of:  
		! !

!RelationSlot methodsFor: 'accessing' stamp: 'JanVanDeSandt 2/21/2015 15:32'!
targetClassName

	^targetClass isSymbol
		ifTrue: [ targetClass ]
		ifFalse: [ targetClass name ]! !

!RelationSlot methodsFor: 'accessing' stamp: 'JanVanDeSandt 2/20/2015 16:51'!
inverseSlot

	^inverseSlot ifNil: [ self linkUp. inverseSlot ]! !

!RelationSlot methodsFor: 'accessing' stamp: 'JanVanDeSandt 2/21/2015 15:33'!
targetClass

	targetClass isSymbol
		ifTrue: [ 
			targetClass := Smalltalk globals at: targetClass 
				ifAbsent: [ self error: 'Cannot find class ', targetClass printString ] ].
	
	^targetClass! !

!RelationSlot methodsFor: 'internal' stamp: 'JanVanDeSandt 2/22/2015 14:05'!
addAssociationFrom: ownerObject to: otherObject
	"A new reference from <ownerObject> to <otherObject> is created. Here we update the other 
	side of the association. If the other side is a ToOne association this means that an other
	association may have to be removed first."

	self inverseSlot isToOneSlot
		ifTrue: [ 
			| oldObject |
			oldObject := inverseSlot read: otherObject.
			oldObject notNil
				ifTrue: [ inverseSlot removeAssociationFrom: otherObject to: oldObject ].
			inverseSlot writeInverse: ownerObject to: otherObject ]
		ifFalse: [ 
			(inverseSlot read: otherObject) inverseAdd: ownerObject ]! !

!RelationSlot methodsFor: 'initialization' stamp: 'JanVanDeSandt 2/27/2015 11:37'!
inClass: aTargetClassOrSymbol

	targetClass := aTargetClassOrSymbol! !

!RelationSlot methodsFor: 'testing' stamp: 'JanVanDeSandt 2/21/2015 16:37'!
isToOneSlot

	^false! !

!RelationSlot methodsFor: 'accessing' stamp: 'JanVanDeSandt 2/20/2015 16:54'!
inverseName

	^inverseName! !

!RelationSlot methodsFor: 'comparing' stamp: 'JanVanDeSandt 2/22/2015 14:09'!
= anObject 

	^super = anObject and: [ 
		self targetClassName = anObject targetClassName and: [ 
			inverseName = anObject inverseName ] ]

	! !

!RelationSlot methodsFor: 'initialization' stamp: 'JanVanDeSandt 2/27/2015 11:22'!
linkUp

	inverseSlot := self targetClass slotNamed: inverseName.
	(inverseSlot isKindOf: RelationSlot)
		ifFalse: [ self error: 'Invalid association: ... ' ].
		
	inverseSlot inverseName = self name
		ifFalse: [ self error: 'Invalid association: inverse names do not match' ].! !

!RelationSlot methodsFor: 'printing' stamp: 'JanVanDeSandt 2/27/2015 11:38'!
printOn: aStream
	aStream 
		store: self name;
		nextPutAll: ' => ';
		nextPutAll: self class name.
	self hasInverse 
		ifTrue: [ 
			aStream
				nextPutAll: ' inverse: ';
				store: inverseName ].
	aStream
		nextPutAll: ' inClass: ';
		store: self targetClassName.
! !

!RelationSlot methodsFor: 'internal' stamp: 'JanVanDeSandt 2/22/2015 14:06'!
removeAssociationFrom: ownerObject to: otherObject
	"A reference from <ownerObject> to <otherObject> is removed. Here we update the other 
	side of the association. If the other side is a ToOne association set the value to nil,
	for ToMany associations remove <ownerObject> from the collection." 

	self inverseSlot isToOneSlot
		ifTrue: [ inverseSlot writeInverse: nil to: otherObject ]
		ifFalse: [ (inverseSlot read: otherObject) inverseRemove: ownerObject ]! !

!RelationSlot methodsFor: 'testing' stamp: 'JanVanDeSandt 2/21/2015 09:51'!
hasInverse

	^inverseName notNil! !

!RelationSlot methodsFor: 'internal' stamp: 'JanVanDeSandt 2/21/2015 16:26'!
checkValue: aValue

	(aValue isKindOf: self targetClass)
		ifFalse: [ self error: 'Invalid value' ].! !

!RelationSlot methodsFor: 'initialization' stamp: 'JanVanDeSandt 2/27/2015 11:37'!
inverse: anInverseSymbol inClass: aTargetClassOrSymbol

	self inClass: aTargetClassOrSymbol.
	inverseName := anInverseSymbol.! !

!RelationSlot class methodsFor: 'instance creation' stamp: 'JanVanDeSandt 2/27/2015 11:39'!
named: aSymbol inverse: anInverseSymbol inClass: aTargetClassOrSymbol 

	^(super named: aSymbol) inverse: anInverseSymbol inClass: aTargetClassOrSymbol ! !

!RelationSlotTest methodsFor: 'tests' stamp: 'JanVanDeSandt 2/27/2015 11:41'!
testDefinitionWithoutInverse

	| slot |
	
	slot := #people => ToManyRelationSlot inClass: #SlotExamplePerson.
	self deny: slot hasInverse! !

!RelationSlotTest methodsFor: 'tests' stamp: 'JanVanDeSandt 2/27/2015 11:41'!
testDefinition

	| s1 s2 |
	
	s1 := ToManyRelationSlot named: #people inverse: #x inClass: #SlotExamplePerson.
	s2 := #people => ToManyRelationSlot inverse: #x inClass: #SlotExamplePerson.
	
	self assert: s1 = s2.
	self assert: s1 hasInverse 
! !

!RelationSlotTest methodsFor: 'tests' stamp: 'JanVanDeSandt 2/27/2015 11:42'!
testEquals

	| s1 s2 |
	
	s1 := ToManyRelationSlot named: #slot inverse: #x inClass: #SlotExamplePerson.
	s2 := ToManyRelationSlot named: #slot inverse: #x inClass: #SlotExamplePerson.
	
	self assert: s1 = s2.
	self assert: s1 hash = s2 hash.! !

!RelationSlotTest methodsFor: 'tests' stamp: 'JanVanDeSandt 2/27/2015 11:41'!
testDefinitionWithClass

	| s1 s2 |
	
	s1 := #people => ToManyRelationSlot inverse: #x inClass: #SlotExamplePerson.
	s2 := #people => ToManyRelationSlot inverse: #x inClass: SlotExamplePerson.
	
	self assert: s1 = s2.
	self assert: s1 hasInverse 
! !

!RelationSlotTest methodsFor: 'tests' stamp: 'JanVanDeSandt 2/27/2015 11:42'!
testNotEquals

	| s1 s2 |
	
	s1 := ToManyRelationSlot named: #slot inverse: #x inClass: #SlotExamplePerson.
	s2 := ToManyRelationSlot named: #slot inverse: #y inClass: #SlotExamplePerson.
	
	self deny: s1 = s2.
! !

!RelativePath commentStamp: '<historical>'!
I represent a relative path (a position starting from Path workingDirectory)!
!RelativePath methodsFor: 'testing' stamp: 'cwp 2/26/2011 11:03'!
isRoot
	^ false! !

!RelativePath methodsFor: 'printing' stamp: 'cwp 2/26/2011 18:00'!
printOn: aStream delimiter: aCharacter
	self isWorkingDirectory ifTrue: [aStream nextPut: $.. ^ self].
	super printOn: aStream delimiter: aCharacter! !

!RelativePath methodsFor: 'printing' stamp: 'EstebanLorenzano 4/3/2012 11:15'!
printOn: aStream
	aStream nextPutAll: 'Path '.
	self isWorkingDirectory
		ifTrue: [aStream nextPutAll: 'workingDirectory']
		ifFalse: 
			[aStream 
				nextPutAll: '* ''';
				nextPutAll: (self at: 1) asString;
				nextPut: $'.
			2 to: self size do:
				[:i |
				aStream
					nextPutAll: ' / ''';
					nextPutAll: (self at: i);
					nextPut: $']]
					
			! !

!RelativePath methodsFor: 'testing' stamp: 'cwp 2/26/2011 10:58'!
isAbsolute
	^ false! !

!ReleaseTest commentStamp: '<historical>'!
I contain tests that validate the integrity of the system.!
!ReleaseTest methodsFor: '*Refactoring-Critics' stamp: 'SebastianTleye 7/19/2013 16:29'!
testExplicitRequirementMethodsShouldBeImplementedInTheirUsers
	"If a class is using a trait with an explicit requirement method, this class should implement the method"
	| result |
	result := RBExplicitRequirementMethodsRule new run.
	self assert: result isEmpty.! !

!ReleaseTest methodsFor: '*Refactoring-Critics' stamp: 'CamilloBruni 8/22/2013 11:55'!
testLocalMethodsOfTheClassShouldNotBeRepeatedInItsTraits
	"If a class is using a trait with an explicit requirement method, this class should implement the method"
	
	self assertValidLintRule: RBLocalMethodsOfAClassNotInItsTraitComposition new! !

!ReleaseTest methodsFor: '*Manifest-Core' stamp: 'CamilloBruni 8/22/2013 11:58'!
assertValidLintRule: aLintRule
	| checker |
	checker := SmalllintManifestChecker new 
		rule: aLintRule;
		run.
	self 
		assert: aLintRule result isEmpty
		description: [ aLintRule rationale ]! !

!ReleaseTest methodsFor: 'testing' stamp: 'CamilloBruni 2/10/2013 17:36'!
testInstalledMethodsWithIncorrectTrailerKind
	| incorrectMethods |
	
	incorrectMethods := SystemNavigation new installedMethodsWithIncorrectTrailerKind.
	
	self 
		assert: incorrectMethods isEmpty
		description: [ String streamContents: [ :s|
			s 
				nextPutAll: 'Found methods with incorrect trailer kind: ';
				print: incorrectMethods ]].
	! !

!ReleaseTest methodsFor: 'testing' stamp: 'EstebanLorenzano 9/3/2014 15:18'!
testObsoleteClasses
	| obsoleteClasses |
	
	Smalltalk fixObsoleteReferences.
	Smalltalk garbageCollect.
	obsoleteClasses := SystemNavigation new obsoleteClasses
		select: [ :each | each isAnonymous not ].
	
	self 
		assert: obsoleteClasses isEmpty
		description: [
			String streamContents: [ :s|
				s 
					nextPutAll: 'Obsolete classes remaining: ';
					print: obsoleteClasses ]]! !

!ReleaseTest methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/23/2013 20:48'!
actualProcesses
	^ self class actualProcesses! !

!ReleaseTest methodsFor: 'testing' stamp: 'MarcusDenker 11/15/2013 11:25'!
testUnknownProcesses
	"Make sure that there are no other processes running except the known processes"
	
	| unknownProcesses |
	unknownProcesses := self actualProcesses difference: self knownProcesses.
	self 
		assert: unknownProcesses size <=2
		description: (String streamContents: [ :out |
			out << 'Found unknown processes: '.
			unknownProcesses 
				do: [ :each | out print: each ] 
				separatedBy: [ out << ', ' ] ])! !

!ReleaseTest methodsFor: 'testing' stamp: 'CamilloBruni 7/17/2013 14:32'!
testLayoutIntegrity
	SystemNavigation default allClassesDo: [ :class |
		class theNonMetaClass layout checkIntegrity.
		class theMetaClass layout checkIntegrity ]! !

!ReleaseTest methodsFor: 'testing' stamp: 'CamilloBruni 2/10/2013 17:35'!
testInstanceSideMethodsWithNilKeyInLastLiteral
	| instanceSideMethodsWithNilKeyInLastLiteral |
	
	instanceSideMethodsWithNilKeyInLastLiteral := SystemNavigation new instanceSideMethodsWithNilKeyInLastLiteral.
	
	self 
		assert: instanceSideMethodsWithNilKeyInLastLiteral isEmpty
		description: [ String streamContents: [ :s|
			s 
				nextPutAll: 'Found methods with nil as last literal: ';
				print: instanceSideMethodsWithNilKeyInLastLiteral ]].
	! !

!ReleaseTest methodsFor: 'testing' stamp: 'MarcusDenker 7/18/2014 10:07'!
testAllGlobalBindingAreGlobalVariables
	| wrong |
	wrong := Smalltalk globals associations reject: [ :each | each isKindOf:  GlobalVariable].
	self assert: wrong isEmpty.! !

!ReleaseTest methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/23/2013 20:38'!
knownProcesses
	^ self class knownProcesses! !

!ReleaseTest methodsFor: 'testing' stamp: 'MarcusDenker 7/18/2014 10:09'!
testAllClassPoolBindingAreClassVariables
	| wrong |
	wrong := OrderedCollection new.
	Smalltalk globals allClasses do: [:class | 
		 wrong addAll: (class classVariables reject: [ :each | each isKindOf:  ClassVariable]).
		].
	self assert: wrong isEmpty.! !

!ReleaseTest methodsFor: 'testing' stamp: 'CamilloBruni 2/10/2013 17:34'!
testUndeclared
	| undeclaredReferences |
	
	Smalltalk cleanOutUndeclared. 
	undeclaredReferences := Undeclared.
	
	self 
		assert: undeclaredReferences isEmpty 
		description: (String streamContents: [ :s|
			s 
				nextPutAll: 'Found undeclared references: ';
				print: undeclaredReferences ])
	! !

!ReleaseTest methodsFor: 'testing' stamp: 'MarcusDenker 9/5/2014 10:17'!
testMethodsWithUnboundGlobals
	| methodsWithUnboundGlobals |
	"Ensure the environment is clean"
	3 timesRepeat: [ Smalltalk garbageCollect ].
	
	Smalltalk cleanOutUndeclared. 
	methodsWithUnboundGlobals := SystemNavigation new methodsWithUnboundGlobals.
	
	self 
		assert:methodsWithUnboundGlobals isEmpty
		description: [ String streamContents: [ :s |
			s 
				nextPutAll: 'Found methods with unbound globals: '; 
				print: methodsWithUnboundGlobals ]]! !

!ReleaseTest class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/23/2013 20:47'!
actualProcesses
	^ Process allSubInstances reject: [ :each | each isTerminated ]! !

!ReleaseTest class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/23/2013 20:47'!
knownProcesses
	"Return a dynamic list of know processes"
	
	"(self actualProcesses difference: self knownProcesses) do: [ :each | each suspend; terminate ]."
	
	^ {
		Processor activeProcess.	
		InputEventFetcher default fetcherProcess.
		WeakArray runningFinalizationProcess.
		Processor backgroundProcess.
		SmalltalkImage current lowSpaceWatcherProcess.
		UIManager default uiProcess.
		Delay schedulingProcess } asSet! !

!RemoteString commentStamp: '<historical>'!
My instances provide an external file reference to a piece of text.  It may be the sourceCode of a method, or the class comments of a class.

The changes file or file-in file usually has a chunk that is just the source string of a method:

max: aNumber
	^ self > aNumber ifTrue: [self] ifFalse: [aNumber]!!

I can return either a String or a Text.  Some a chunk is followed by a second chunk (beginning with ]style[) containing style information.  The encoding is like this:

max: aNumber
	^ self > aNumber ifTrue: [self] ifFalse: [aNumber]!!
]style[(14 50 312)f1,f1b,f1LInteger +;i!!

Allowed TextAttributes are TextFontChange, TextEmphasis, TextColor, TextDoIt, TextKern, TextLink, TextURL.  TextFontReference and TextAnchor are not supported.

See PositionableStream nextChunkText and RunArray class scanFrom:.!
!RemoteString methodsFor: 'accessing' stamp: 'Sd 1/28/2011 14:36'!
last
	^self string ifNotNil: [ :s | s last ] ! !

!RemoteString methodsFor: 'accessing' stamp: 'stephaneducasse 2/4/2006 20:31'!
setSourcePointer: aSourcePointer
	sourceFileNumber := SourceFiles fileIndexFromSourcePointer: aSourcePointer.
	filePositionHi := SourceFiles filePositionFromSourcePointer: aSourcePointer! !

!RemoteString methodsFor: 'accessing' stamp: 'Sd 1/28/2011 14:36'!
position 
	"Answer the location of the string on a file."

	^ filePositionHi ! !

!RemoteString methodsFor: 'private' stamp: 'MartinDias 11/5/2013 15:04'!
string: aString onFileNumber: fileNumber
	"Store this as my string if source files exist."
	| theFile |
	(SourceFiles at: fileNumber) ifNotNil: [
		theFile := SourceFiles at: fileNumber.
		theFile setToEnd; cr.
		self 
			string: aString 
			onFileNumber: fileNumber 
			toFile: theFile ]! !

!RemoteString methodsFor: 'accessing' stamp: ''!
sourceFileNumber
	"Answer the index of the file on which the string is stored."

	^sourceFileNumber! !

!RemoteString methodsFor: 'accessing' stamp: 'MartinDias 11/5/2013 15:04'!
string 
	"Answer the receiver's string if remote files are enabled.
	Use a read only copy to avoid syntax errors when accessed via
	multiple processes."
	
	| theFile |
	(sourceFileNumber isNil or: [ (SourceFiles at: sourceFileNumber) isNil ]) ifTrue: [ ^ '' ].
	theFile := (SourceFiles at: sourceFileNumber) readOnlyCopy.
	^ [ filePositionHi > theFile size ifTrue: [
		self error: 'RemoteString past end of file' ].
		theFile position: filePositionHi.
		theFile nextChunk] ensure: [ theFile close ]! !

!RemoteString methodsFor: 'private' stamp: 'stephaneducasse 2/4/2006 20:32'!
fileNumber: fileNumber position: position 

	sourceFileNumber := fileNumber.
	filePositionHi := position! !

!RemoteString methodsFor: 'accessing' stamp: 'MartinDias 11/5/2013 15:02'!
fileStream 
	"Answer the file stream with position set at the beginning of my string.
	Answer a read only copy to avoid syntax errors when accessed via
	multiple processes."

	| theFile |
	(sourceFileNumber isNil or: [ (SourceFiles at: sourceFileNumber) isNil ]) ifTrue: [ ^ nil ].
	theFile := (SourceFiles at: sourceFileNumber) readOnlyCopy.
	filePositionHi > theFile size ifTrue: [
		self error: 'RemoteString past end of file' ].
	theFile position: filePositionHi.
	^ theFile! !

!RemoteString methodsFor: 'accessing' stamp: 'hmm 4/26/2000 20:47'!
sourcePointer
	sourceFileNumber ifNil: [^ 0].
	^SourceFiles sourcePointerFromFileIndex: sourceFileNumber andPosition: filePositionHi! !

!RemoteString methodsFor: 'accessing' stamp: 'MarcusDenker 5/4/2013 22:51'!
text
	^ self string asText! !

!RemoteString methodsFor: 'chunk' stamp: 'StephaneDucasse 9/12/2010 09:53'!
string: aString onFileNumber: fileNumber toFile: aFileStream 
	"Store this as the receiver's string if source files exist."

	| position |
	position := aFileStream position.
	self fileNumber: fileNumber position: position.
	aFileStream nextChunkPut: aString.
	^ self ! !

!RemoteString class methodsFor: 'instance creation' stamp: ''!
newString: aString onFileNumber: sourceIndex 
	"Answer an instance of me for string, aString, on file indexed by 
	sourceIndex. Put the string on the file and create the remote reference."

	^self new string: aString onFileNumber: sourceIndex! !

!RemoteString class methodsFor: 'instance creation' stamp: ''!
newFileNumber: sourceIndex position: anInteger 
	"Answer an instance of me fora file indexed by sourceIndex, at the 
	position anInteger. Assume that the string is already stored on the file 
	and the instance will be used to access it."

	^self new fileNumber: sourceIndex position: anInteger! !

!RemoteString class methodsFor: 'instance creation' stamp: ''!
newString: aString onFileNumber: sourceIndex toFile: aFileStream
	"Answer an instance of me for string, aString, on file indexed by 
	sourceIndex. Put the string on the file, aFileStream, and create the 
	remote reference. Assume that the index corresponds properly to 
	aFileStream."

	^self new string: aString onFileNumber: sourceIndex toFile: aFileStream! !

!RemoteTempVectorNode commentStamp: '<historical>'!
I am a node for a vector of remote temps, created to share temps between closures when those temps are written to in closures other than their defining ones.!
!RemoteTempVectorNode methodsFor: 'code generation (closures)' stamp: 'eem 5/24/2008 23:20'!
emitCodeForValueOf: aTempVariableNode stack: stack encoder: encoder
	encoder supportsClosureOpcodes
		ifTrue:
			[encoder
				genPushRemoteTemp: (remoteTemps indexOf: aTempVariableNode) - 1
				inVectorAt: index.
			 stack push: 1]
		ifFalse:
			[self emitCodeForLoadFor: aTempVariableNode stack: stack encoder: encoder.
			 readNode
				emitCode: stack
				args: 1
				encoder: encoder
				super: false]! !

!RemoteTempVectorNode methodsFor: 'code generation (closures)' stamp: 'eem 5/24/2008 18:24'!
sizeCodeForStoreInto: aTempVariableNode encoder: encoder
	encoder supportsClosureOpcodes ifTrue:
		[^encoder sizeStoreRemoteTemp: (remoteTemps indexOf: aTempVariableNode) - 1 inVectorAt: index].
	^writeNode sizeCode: encoder args: 2 super: false! !

!RemoteTempVectorNode methodsFor: 'code generation (closures)' stamp: 'eem 5/24/2008 18:19'!
emitCodeForLoadFor: aTempVariableNode stack: stack encoder: encoder
	encoder supportsClosureOpcodes ifTrue:
		[^self].
	"Need to generate the first half of
		tempVector at: index put: expr
	 i.e. the push of tempVector and index."
	super emitCodeForValue: stack encoder: encoder.
	self emitCodeForIndexOf: aTempVariableNode stack: stack encoder: encoder! !

!RemoteTempVectorNode methodsFor: 'code generation (closures)' stamp: 'jannik.laval 5/1/2010 16:23'!
sizeCodeForIndexOf: aTempVariableNode encoder: encoder
	[encoder supportsClosureOpcodes not] assert.
	^(encoder encodeLiteral: (remoteTemps indexOf: aTempVariableNode)) sizeCodeForValue: encoder! !

!RemoteTempVectorNode methodsFor: 'accessing' stamp: 'eem 6/2/2008 16:47'!
remoteTemps
	^remoteTemps! !

!RemoteTempVectorNode methodsFor: 'code generation (closures)' stamp: 'eem 5/24/2008 18:23'!
sizeCodeForValueOf: aTempVariableNode encoder: encoder
	encoder supportsClosureOpcodes ifTrue:
		[^encoder sizePushRemoteTemp: (remoteTemps indexOf: aTempVariableNode) - 1 inVectorAt: index].
	^(self sizeCodeForValue: encoder)
	+ (self sizeCodeForIndexOf: aTempVariableNode encoder: encoder)
	+ (readNode sizeCode: encoder args: 1 super: false)! !

!RemoteTempVectorNode methodsFor: 'code generation (closures)' stamp: 'eem 5/24/2008 18:23'!
sizeCodeForStorePopInto: aTempVariableNode encoder: encoder
	encoder supportsClosureOpcodes ifTrue:
		[^encoder sizeStorePopRemoteTemp: (remoteTemps indexOf: aTempVariableNode) - 1 inVectorAt: index].
	^(self sizeCodeForStoreInto: aTempVariableNode encoder: encoder)
	+ encoder sizePop! !

!RemoteTempVectorNode methodsFor: 'decompiler' stamp: 'eem 9/25/2008 09:46'!
remoteTemps: anArray
	remoteTemps := anArray.
	anArray do: [:tempNode| tempNode remoteNode: self]! !

!RemoteTempVectorNode methodsFor: 'code generation (closures)' stamp: 'eem 5/24/2008 23:02'!
emitCodeForStorePopInto: aTempVariableNode stack: stack encoder: encoder
	encoder supportsClosureOpcodes
		ifTrue:
			[encoder
				genStorePopRemoteTemp: (remoteTemps indexOf: aTempVariableNode) - 1
				inVectorAt: index]
		ifFalse:
			[self emitCodeForStoreInto: aTempVariableNode stack: stack encoder: encoder.
			 encoder genPop].
	stack pop: 1! !

!RemoteTempVectorNode methodsFor: 'code generation (closures)' stamp: 'eem 9/25/2008 17:16'!
nodeToInitialize: encoder
	^AssignmentNode new
		variable: self
		value: (encoder supportsClosureOpcodes
					ifTrue: [NewArrayNode new numElements: remoteTemps size]
					ifFalse:
						[MessageNode new
							receiver: (encoder encodeVariable: 'Array')
							selector: #new:
							arguments: (Array with: (encoder encodeLiteral: remoteTemps size))
							precedence: 3
							from: encoder])! !

!RemoteTempVectorNode methodsFor: 'code generation (closures)' stamp: 'eem 5/24/2008 23:02'!
emitCodeForStoreInto: aTempVariableNode stack: stack encoder: encoder
	encoder supportsClosureOpcodes
		ifTrue:
			[encoder
				genStoreRemoteTemp: (remoteTemps indexOf: aTempVariableNode) - 1
				inVectorAt: index]
		ifFalse:
			[writeNode
				emitCode: stack
				args: 2
				encoder: encoder
				super: false]! !

!RemoteTempVectorNode methodsFor: 'code generation (closures)' stamp: 'eem 5/24/2008 18:19'!
sizeCodeForLoadFor: aTempVariableNode encoder: encoder
	encoder supportsClosureOpcodes ifTrue:
		[^0].
	"Need to size the first half of
		tempVector at: index put: expr
	 i.e. the push of tempVector and index."
	^(super sizeCodeForValue: encoder)
	+ (self sizeCodeForIndexOf: aTempVariableNode encoder: encoder)! !

!RemoteTempVectorNode methodsFor: 'visiting' stamp: 'eem 9/6/2009 12:34'!
accept: aVisitor
	^aVisitor visitRemoteTempVectorNode: self! !

!RemoteTempVectorNode methodsFor: 'code generation (closures)' stamp: 'jannik.laval 5/1/2010 16:23'!
emitCodeForIndexOf: aTempVariableNode stack: stack encoder: encoder
	[encoder supportsClosureOpcodes not] assert.
	(encoder encodeLiteral: (remoteTemps indexOf: aTempVariableNode))
		emitCodeForValue: stack encoder: encoder! !

!RemoteTempVectorNode methodsFor: 'code generation (closures)' stamp: 'eem 5/20/2008 17:57'!
referenceScopesAndIndicesDo: aBinaryBlock
	self shouldNotImplement! !

!RemoteTempVectorNode methodsFor: 'code generation (closures)' stamp: 'ClementBera 7/26/2013 16:48'!
addRemoteTemp: aTempVariableNode encoder: encoder
	remoteTemps ifNil:
		[remoteTemps := OrderedCollection new].
	remoteTemps addLast: aTempVariableNode.
	aTempVariableNode referenceScopesAndIndicesDo:
		[:scopeBlock "<BlockNode>" :location "<Integer>"|
		 self addReadWithin: scopeBlock at: location].
	encoder supportsClosureOpcodes ifFalse:
		[encoder encodeLiteral: remoteTemps size.
		 readNode := encoder encodeSelector: #at:.
		 writeNode := encoder encodeSelector: #at:put:]! !

!RemoteTempVectorNode methodsFor: 'code generation (closures)' stamp: 'eem 6/2/2008 16:50'!
isIndirectTempVector
	^true! !

!RemoteTempVectorNode methodsFor: 'code generation (closures)' stamp: 'eem 9/8/2008 10:47'!
scope
	"Answer scope of temporary variables.
	 Currently only the following distinctions are made:
		 0	outer level: args and user-declared temps
		 1	block args and doLimiT temps
		-1	a block temp that is no longer active
		-2	a block temp that held limit of to:do:
		-3	an indirect temp vector"
	^-3! !

!RemotesManager commentStamp: 'ChristopheDemarey 1/8/2014 17:00'!
I am an user interface used to link mcpackages and remotes.

RemotesManager new openWithSpec!
!RemotesManager methodsFor: 'api' stamp: 'ChristopheDemarey 12/17/2013 14:54'!
initialExtent

	^  400@260! !

!RemotesManager methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/4/2013 12:52'!
addRemote
	
	self newRemote ifNotNil: [ :repo | 
		MCRepositoryGroup default addRepository: repo.
		remotes roots: self buildRoots ]! !

!RemotesManager methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/30/2013 19:53'!
remotes
	^ remotes! !

!RemotesManager methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/4/2013 14:28'!
editRemote
	| item view |
	
	item := remotes highlightedItem content.
	view := CredentialEditor new.
	view 
		setPassword: item password;
		setUsername: item username.
	
	view openDialogWithSpec
		centered;
		modalRelativeTo: self window.
	
	view cancelled ifTrue: [ ^ self ].
	
	item 
		username: view getUsername;
		password: view getPassword! !

!RemotesManager methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/4/2013 12:52'!
newRemote
	| types index |
	
	types := MCRepository allConcreteSubclasses asArray.
	index := UIManager default chooseFrom: (types collect: [:ea | ea description])
				title: 'Repository type:'.
	^ index = 0 ifFalse: [(types at: index) morphicConfigure]! !

!RemotesManager methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 12/4/2013 13:12'!
initializeDialogWindow: aWindow

	aWindow
		toolbar: OkToolbar new! !

!RemotesManager methodsFor: 'private-icons' stamp: 'BenjaminVanRyseghem 11/30/2013 22:44'!
addRemoteIcon

	^ self class addRemoteIcon! !

!RemotesManager methodsFor: 'initialization' stamp: 'ChristopheDemarey 12/17/2013 14:52'!
initializeWidgets

	remotes := self newTree.
	addRemote := self newButton.
	removeRemote := self newButton.
	editRemote := self newButton.

	remotes
		beCheckList;
		removeOnlyLastSelected: true; 
		autoMultiSelection: true;
		displayBlock: [ :item | item label ];
		iconBlock: [ :item | item icon ];
		roots: self buildRoots.
		
	addRemote 
		icon: self addRemoteIcon;
		action: [ self addRemote ];
		help: 'Add a new remote'.
		
	removeRemote
		icon: self removeRemoteIcon;
		action: [ self removeRemote ];
		enabled: false;
		help: 'Remote the selected remote'.
		
	editRemote
		icon: self editRemoteIcon;
		action: [ self editRemote ];
		enabled: false;
		help: 'Edit the selected remote'.
		
	self focusOrder
		add: remotes;
		add: removeRemote;
		add: addRemote! !

!RemotesManager methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/4/2013 12:57'!
removeRemoteWidget
	^ removeRemote! !

!RemotesManager methodsFor: 'accessing' stamp: 'SeanDeNigris 10/23/2014 17:00'!
selectedRemotes
	^ selectedRemotes! !

!RemotesManager methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/4/2013 14:27'!
removeRemote
	| item |
	
	item := remotes highlightedItem content.
	MCRepositoryGroup default
		removeRepository: item remote.
		
	remotes 
		roots: self buildRoots;
		highlightedItem: nil! !

!RemotesManager methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/4/2013 12:57'!
addRemoteWidget
	^ addRemote! !

!RemotesManager methodsFor: 'private-icons' stamp: 'BenjaminVanRyseghem 12/4/2013 10:54'!
editRemoteIcon

	^ self class editRemoteIcon! !

!RemotesManager methodsFor: 'initialization' stamp: 'SeanDeNigris 10/21/2014 14:20'!
initialize
	selectedRemotes := Set new.
	super initialize
! !

!RemotesManager methodsFor: 'api' stamp: 'ChristopheDemarey 3/9/2015 15:16'!
title
	^ super title 
		ifNil: ['Remotes manager']! !

!RemotesManager methodsFor: 'initialization' stamp: 'ChristopheDemarey 12/17/2013 15:16'!
initializePresenter

	remotes whenHighlightedItemChanged: [ :item | 
		editRemote enabled: item notNil.
		removeRemote enabled: item notNil ].
! !

!RemotesManager methodsFor: 'private-icons' stamp: 'BenjaminVanRyseghem 11/30/2013 23:10'!
removeRemoteIcon

	^ self class removeRemoteIcon! !

!RemotesManager methodsFor: 'private' stamp: 'SeanDeNigris 10/21/2014 14:34'!
selected: aRepository changed: selected
	selected
		ifTrue: [ selectedRemotes add: aRepository ]
		ifFalse: [ selectedRemotes remove: aRepository ].
	selectedChangedBlock ifNotNil: 
		[ selectedChangedBlock cull: aRepository cull: selected ] ! !

!RemotesManager methodsFor: 'private' stamp: 'ChristopheDemarey 1/8/2014 17:03'!
buildRoots
	^ MCRepositoryGroup default repositories
		select: [ :each | each isCache not ]
		thenCollect: [ :each || remote  |			
			remote := each koRemote.
			TreeNodeModel new
				content: remote;
				hasContentToShow: true;
				selected: ( selectedRemotes includes: each );
				whenSelectedChanged: [ :bool | self selected: each changed: bool ] ;
				yourself ]! !

!RemotesManager methodsFor: 'api' stamp: 'ChristopheDemarey 12/19/2013 13:11'!
selectedChangedBlock: aBlock
	selectedChangedBlock := aBlock! !

!RemotesManager methodsFor: 'api' stamp: 'ChristopheDemarey 1/8/2014 17:03'!
selectedRemotes: aRemoteList
	selectedRemotes := aRemoteList! !

!RemotesManager methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/4/2013 12:55'!
editRemoteWidget
	^ editRemote! !

!RemotesManager class methodsFor: 'specs' stamp: 'ChristopheDemarey 12/17/2013 14:50'!
defaultSpec
	<spec: #default>
	^ SpecLayout composed
		newColumn: [ :col | 
			col
				newRow: [ :r | 
					r
						newColumn: [ :c |  ];
						add: #editRemoteWidget width: self buttonHeight + 4;
						add: #removeRemoteWidget width: self buttonHeight + 4;
						add: #addRemoteWidget width: self buttonHeight ]
					height: self buttonHeight;
					add: #remotes ];
		yourself! !

!RemotesManager class methodsFor: 'private-icons' stamp: 'BenjaminVanRyseghem 11/30/2013 23:10'!
removeRemoteIconData

	^ #(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4291210037 4290808596 4290810135 4290677781 4290147595 4291210037 0 0 0 0 0 0 0 0 0 4290683681 4294624811 4294631521 4294768803 4294568569 4294105160 4294031910 4290683681 0 0 0 0 0 0 0 0 4291073566 4294625582 4294630746 4294768804 4294568569 4294105160 4294031910 4289552134 0 0 0 0 0 0 0 0 4289952033 4293174041 4294303042 4294569571 4294170172 4293309977 4293101065 4290539540 0 0 0 0 0 0 0 0 4290280479 4294036034 4294634621 4294768801 4294568564 4294105159 4294031911 4290802196 0 0 0 0 0 0 0 0 4290280223 4294036035 4294634621 4294768801 4294568567 4294105160 4294031910 4290868243 0 0 0 0 0 0 0 0 4290280224 4294036037 4294634620 4294768799 4294568571 4294105162 4294031910 4290868498 0 0 0 0 0 0 0 0 4290280225 4293969990 4294634874 4294768798 4294568575 4284440415 4282335071 4282335071 4282335071 4282335071 4282335071 4282335071 0 0 0 0 4290280225 4292976410 4294302527 4294569825 4294170431 4282335071 4284440415 4284440415 4284440415 4284440415 4284440415 4278190080 0 0 0 0 4291537467 4293042201 4294302271 4294569825 4294170431 4282335071 4284440415 4284440415 4284440415 4284440415 4284440415 4278190080 0 0 0 0 0 4291209522 4291140130 4291205922 4291073824 4282335071 4294967295 4294967295 4294967295 4294967295 4294967295 4278190080 0 0 0 0 0 0 0 0 0 4282335071 4284440415 4284440415 4284440415 4284440415 4284440415 4278190080 0 0 0 0 0 0 0 0 0 4282335071 4284440415 4284440415 4284440415 4284440415 4284440415 4278190080 0 0 0 0 0 0 0 0 0 4282335071 4278190080 4278190080 4278190080 4278190080 4278190080 4282335071)! !

!RemotesManager class methodsFor: 'icons' stamp: 'BenjaminVanRyseghem 12/4/2013 10:55'!
editRemoteIcon

	^ editRemoteIcon ifNil: [ editRemoteIcon := Pharo3UIThemeIcons form16x16FromContents: self editRemoteIconData ]! !

!RemotesManager class methodsFor: 'icons' stamp: 'BenjaminVanRyseghem 11/30/2013 23:10'!
removeRemoteIcon

	^ removeRemoteIcon ifNil: [ removeRemoteIcon := Pharo3UIThemeIcons form16x16FromContents: self removeRemoteIconData ]! !

!RemotesManager class methodsFor: 'icons' stamp: 'BenjaminVanRyseghem 11/30/2013 22:45'!
addRemoteIcon

	^ addRemoteIcon ifNil: [ addRemoteIcon := Pharo3UIThemeIcons form16x16FromContents: self addRemoteIconData ]! !

!RemotesManager class methodsFor: 'private-icons' stamp: 'BenjaminVanRyseghem 12/4/2013 10:55'!
editRemoteIconData

	^ #(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4291210037 4290808596 4290810135 4290677781 4290147595 4291210037 0 0 0 0 0 0 0 0 0 4290683681 4294624811 4294631521 4294768803 4294568569 4294105160 4294031910 4290683681 0 0 0 0 0 0 0 0 4291073566 4294625582 4294630746 4294768804 4294568569 4294105160 4294031910 4289552134 0 0 0 0 0 0 0 0 4289952033 4293174041 4294303042 4294569571 4294170172 4293309977 4293101065 4290539540 0 0 0 0 0 0 0 0 4290280479 4294036034 4294634621 4294768801 4294568564 4294105159 4294031911 4290802196 0 0 0 0 0 0 0 0 4290280223 4294036035 4294634621 4294768801 4294568567 4294105160 4294031910 4290868243 0 0 0 0 0 0 0 0 4290280224 4294036037 4294634620 4294768799 4294568571 4294105162 4294031910 4290868498 0 0 0 0 0 0 0 0 4290280225 4293969990 4294634874 4294768798 4294568575 4284440415 4282335071 4282335071 4282335071 4282335071 4282335071 4282335071 0 0 0 0 4290280225 4292976410 4294302527 4294569825 4294170431 4282335071 4284440415 4282335071 4294967295 4282335071 4284440415 4278190080 0 0 0 0 4291537467 4293042201 4294302271 4294569825 4294170431 4282335071 4284440415 4288651167 4294967295 4288651167 4284440415 4278190080 0 0 0 0 0 4291209522 4291140130 4291205922 4291073824 4282335071 4286611584 4294967295 4278190080 4294967295 4286611584 4278190080 0 0 0 0 0 0 0 0 0 4282335071 4290756543 4288651167 4278190080 4288651167 4290756543 4278190080 0 0 0 0 0 0 0 0 0 4282335071 4294967295 4294967295 4294967295 4294967295 4294967295 4278190080 0 0 0 0 0 0 0 0 0 4282335071 4278190080 4278190080 4278190080 4278190080 4278190080 4282335071)! !

!RemotesManager class methodsFor: 'private-icons' stamp: 'BenjaminVanRyseghem 11/30/2013 22:45'!
addRemoteIconData

	^ #(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4291210037 4290808596 4290810135 4290677781 4290147595 4291210037 0 0 0 0 0 0 0 0 0 4290683681 4294624811 4294631521 4294768803 4294568569 4294105160 4294031910 4290683681 0 0 0 0 0 0 0 0 4291073566 4294625582 4294630746 4294768804 4294568569 4294105160 4294031910 4289552134 0 0 0 0 0 0 0 0 4289952033 4293174041 4294303042 4294569571 4294170172 4293309977 4293101065 4290539540 0 0 0 0 0 0 0 0 4290280479 4294036034 4294634621 4294768801 4294568564 4294105159 4294031911 4290802196 0 0 0 0 0 0 0 0 4290280223 4294036035 4294634621 4294768801 4294568567 4294105160 4294031910 4290868243 0 0 0 0 0 0 0 0 4290280224 4294036037 4294634620 4294768799 4294568571 4294105162 4294031910 4290868498 0 0 0 0 0 0 0 0 4290280225 4293969990 4294634874 4294768798 4294568575 4284440415 4282335071 4282335071 4282335071 4282335071 4282335071 4282335071 0 0 0 0 4290280225 4292976410 4294302527 4294569825 4294170431 4282335071 4284440415 4284440415 4294967295 4284440415 4284440415 4278190080 0 0 0 0 4291537467 4293042201 4294302271 4294569825 4294170431 4282335071 4284440415 4284440415 4294967295 4284440415 4284440415 4278190080 0 0 0 0 0 4291209522 4291140130 4291205922 4291073824 4282335071 4294967295 4294967295 4294967295 4294967295 4294967295 4278190080 0 0 0 0 0 0 0 0 0 4282335071 4284440415 4284440415 4294967295 4284440415 4284440415 4278190080 0 0 0 0 0 0 0 0 0 4282335071 4284440415 4284440415 4294967295 4284440415 4284440415 4278190080 0 0 0 0 0 0 0 0 0 4282335071 4278190080 4278190080 4278190080 4278190080 4278190080 4282335071)! !

!RemovedField commentStamp: '<historical>'!
I represent the change of a removed field on an instance.!
!RemovedField methodsFor: 'installing' stamp: 'ToonVerwaest 3/28/2011 17:08'!
installOn: aModification
	aModification installRemovedSlot: self! !

!RemovedField methodsFor: 'accessing' stamp: 'ToonVerwaest 3/28/2011 16:34'!
originalSlot
	^ originalSlot! !

!RemovedField methodsFor: 'accessing' stamp: 'ToonVerwaest 3/28/2011 16:34'!
originalSlot: anObject
	originalSlot := anObject! !

!RemovedField methodsFor: 'accessing' stamp: 'ToonVerwaest 3/28/2011 17:19'!
oldFieldIndex
	^ originalSlot index + fieldIndex! !

!RenderBugsTest commentStamp: 'wiz 5/15/2008 22:58'!
A RenderBugz is an infinite recursion bug test for TransformationMorphs.

In 3.9 (7067) and before, when TransformationMorph has no rendee there are several methods that will infinitely recurse until manually stopped or the image runs out of memory.

So far the ones I've caught are the getters and setters for heading and forwardDirection.

So there  are tests for them here.

Ideally there would be a way to run a test against a stopwatch to catch endless recursion.
Found it. Now incorperated. And the tests should be both save to run and cleanup after themselves even when they fail. 

So far we have not tested the normal cases of rendering working. 
I will leave that as a separate task for another time. 

So this is an automatic test when the bugs are fixed and interactive (crash) tests when the bugs are present.

Instance Variables


Revision notes. wiz 5/15/2008 22:58

When running tests from the TestRunner browser the test would sporadically fail.
When they failed a transfomation morph would be left on the screen and not removed by the 
ensureBlock. 

So I changed things to fall under MorphicUIBugTests because that had a cleanup mechansizm for left over morphs.

I also added one routine to test for time and one parameter to determine the time limit.
To my surprise doubling or tripling the time limit still produced sporadic errors when the test is run repeatedly enough ( I am using a 400mz iMac. )  So now the parameter is set to 4. Things will probably fail there if tried long enough. At that point try 5 etc. 

I am reluctant to make the number larger than necessary. The tighter the test the more you know what is working.

I also added a dummy test to check specifically for the timing bug. It fails on the same sporadic basis as the other test went the time parameter is short enough. This lends confidence to the theory that the timing difficulty is coming from outside the test. The sunit runner puts up a progress morph for each test. So the morphic display stuff is busy and probably also the GC.
!
!RenderBugsTest methodsFor: 'tests' stamp: 'MarcusDenker 10/28/2014 17:19'!
testTestTime
	"This is a control case. Should always pass. 
If it does not something external to the tests are slowing things down 
past the 1 millisecond mark."

	"self new testTestTime"

	"self run: #testTestTime"

	| t |
	cases := {(t := TransformationMorph new openCenteredInWorld)}.
	self shouldntTakeLong: [ self assert: true ].
	^ true! !

!RenderBugsTest methodsFor: 'tests' stamp: 'MarcusDenker 10/28/2014 17:19'!
testSetForward
	"If the bug exist there will be an infinte reccursion."

	"self new testSetForward"

	"self run: #testSetForward"

	| t |
	cases := {(t := TransformationMorph new openCenteredInWorld)}.
	self
		shouldntTakeLong: [ 
			t forwardDirection: 180.0.
			self assert: t forwardDirection = 0.0 ].	"and without a rendee it should not change things."
	^ true! !

!RenderBugsTest methodsFor: 'tests' stamp: 'MarcusDenker 10/28/2014 17:19'!
testHeading
	"If the bug exist there will be an infinte recursion."

	"self new testHeading"

	"self run: #testHeading"

	| t |
	cases := {(t := TransformationMorph new openCenteredInWorld)}.
	self
		shouldntTakeLong: [ 
			[ self assert: t heading = 0.0 ]
				ensure: [ t delete ] ].
	^ true! !

!RenderBugsTest methodsFor: 'private' stamp: 'MarcusDenker 10/28/2014 17:20'!
shouldntTakeLong: aBlock
	"Check for infinite recursion. Test should finish in a reasonable time."

	^ self should: aBlock notTakeMoreThanMilliseconds: self long! !

!RenderBugsTest methodsFor: 'tests' stamp: 'MarcusDenker 10/28/2014 17:20'!
testForward
	"If the bug exist there will be an infinte recursion."

	"self new testForward"

	"self run: #testForward"

	| t |
	cases := {(t := TransformationMorph new openCenteredInWorld)}.
	self shouldntTakeLong: [ self assert: t forwardDirection = 0.0 ].
	^ true! !

!RenderBugsTest methodsFor: 'private' stamp: 'MarcusDenker 10/28/2014 17:20'!
long
	"return time limit in milliseconds for tests"

	^ 50! !

!ReparseAfterSourceEditing commentStamp: 'TorstenBergmann 1/31/2014 11:19'!
Notify about the need to reparse after source code was edited!
!ReparseAfterSourceEditing methodsFor: 'accessing' stamp: 'IgorStasenko 8/28/2013 10:31'!
newSource
	
	^ newSource! !

!ReparseAfterSourceEditing methodsFor: 'accessing' stamp: 'IgorStasenko 8/28/2013 10:31'!
newSource: anObject
	
	newSource := anObject! !

!ReparseAfterSourceEditing class methodsFor: 'signaling' stamp: 'IgorStasenko 8/28/2013 10:32'!
signalWithNewSource: aSourceCode

	^ self new
		newSource: aSourceCode;
		signal! !

!ResetWindow commentStamp: '<historical>'!
A ResetWindow is simple UI to reset the currently analysed model.!
!ResetWindow methodsFor: 'initialization' stamp: 'CamilleTeruel 11/12/2013 19:35'!
setCurrentConfigurationModel
	currentConfigurationModel  
		state: false;
		label: 'Uses Current Configuration';
		action: [ CriticBrowser openOnWorkingConfiguration: CriticWorkingConfiguration current. 
				self delete ]! !

!ResetWindow methodsFor: 'accessing' stamp: 'SimonAllier 1/28/2013 10:24'!
currentConfigurationModel
	^ currentConfigurationModel! !

!ResetWindow methodsFor: 'accessing' stamp: 'SimonAllier 1/28/2013 10:24'!
resetModel
	^ resetModel! !

!ResetWindow methodsFor: 'initialization' stamp: 'SimonAllier 1/28/2013 10:23'!
setFocusOrder

	self focusOrder
		add: resetModel;
		add: currentConfigurationModel! !

!ResetWindow methodsFor: 'initialization' stamp: 'StephaneDucasse 3/21/2013 09:25'!
initializeWidgets

	self instantiateModels: #(
		resetModel ButtonModel
		currentConfigurationModel ButtonModel 
		 ).
	self setFocusOrder.
	self setResetModel. 
	self setCurrentConfigurationModel. 
	! !

!ResetWindow methodsFor: 'initialization' stamp: 'StephaneDucasse 3/21/2013 09:26'!
setResetModel
	resetModel 
		state: false;
		label: 'Reset Current Configurartion';
		action: [ SelectPackageBrowser open. 
				self delete ]! !

!ResetWindow methodsFor: 'api' stamp: 'SimonAllier 1/28/2013 11:35'!
initialExtent

	^   450@30! !

!ResetWindow class methodsFor: 'specs' stamp: 'SimonAllier 1/28/2013 10:23'!
defaultSpec
<spec>

	^SpecLayout composed
		newRow: [:r |
			r 
				add: #resetModel;
				add: #currentConfigurationModel
			]  height: 25! !

!ResetWindow class methodsFor: 'specs' stamp: 'SimonAllier 1/28/2013 10:31'!
title
	^ 'Critic Browser' ! !

!ResolutionRequest commentStamp: 'cwp 11/18/2009 11:38'!
I represent a request for user assistance in resolving an origin. I am a resumable exception that gets raised when there is no way of automatically resolving a particular origin. !
!ResolutionRequest methodsFor: 'accessing' stamp: 'cwp 10/27/2009 10:22'!
origin: aSymbol
	origin := aSymbol! !

!ResolutionRequest methodsFor: 'exceptionDescription' stamp: 'CamilloBruni 7/10/2012 15:09'!
defaultAction
	| filedir ref |
	filedir := UIManager default chooseDirectory: 'Where is ', origin asString, '?'.
	ref := filedir ifNotNil: [FileSystem disk referenceTo: filedir fullName].
	self resume: ref! !

!ResolutionRequest class methodsFor: 'instance creation' stamp: 'cwp 10/27/2009 10:13'!
for: origin
	^ self new
		origin: origin;
		signal! !

!RestartDebugAction commentStamp: '<historical>'!
A RestartDebugAction restarts the execution of the current context.
!
!RestartDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/20/2013 15:21'!
id

	^ #restart! !

!RestartDebugAction methodsFor: 'actions' stamp: 'AndreiChis 9/20/2013 15:22'!
executeAction

	self session restart: self currentContext! !

!RestartDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/21/2013 21:33'!
defaultKeyText

	^ 'r'! !

!RestartDebugAction methodsFor: 'testing' stamp: 'AndreiChis 9/20/2013 17:16'!
appliesToDebugger: aDebugger

	^ aDebugger session isInterruptedContextPostMortem not! !

!RestartDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/17/2013 19:25'!
defaultLabel

	^ 'Restart'! !

!RestartDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/18/2013 11:08'!
defaultOrder

	^ 10! !

!RestartDebugAction class methodsFor: 'registration' stamp: 'AndreiChis 9/21/2013 22:15'!
actionType
	<debuggingAction>
	<contextMenuDebuggingAction>! !

!ResumableTestFailure commentStamp: '<historical>'!
A ResumableTestFailure triggers a TestFailure, but lets execution of the TestCase continue. this is useful when iterating through collections, and #assert: ing on each element. in combination with methods like testcase>>#assert:description:, this lets you run through a whole collection and note which tests pass.

here''s an example:

	

	(1 to: 30) do: [ :each |
		self assert: each odd description: each printString, ' is even' resumable: true]

for each element where #odd returns <false>, the element will be printed to the Transcript. !
!ResumableTestFailure methodsFor: 'camp smalltalk' stamp: ''!
sunitExitWith: aValue
	self resume: aValue! !

!ResumableTestFailure methodsFor: 'camp smalltalk' stamp: ''!
isResumable
	"Of course a ResumableTestFailure is resumable ;-)"

	^true! !

!ResumableTestFailureTestCase commentStamp: 'TorstenBergmann 2/12/2014 23:15'!
SUnit tests for ResumableTestFailure!
!ResumableTestFailureTestCase methodsFor: 'test data' stamp: 'BaseSystem 8/30/2009 09:40'!
errorTest
	1 zork! !

!ResumableTestFailureTestCase methodsFor: 'running' stamp: 'StephaneDucasse 6/9/2012 23:08'!
testResumable
	| result suite |
	suite := self classForTestSuite new.
	suite addTest: (self class selector: #errorTest).
	suite addTest: (self class selector: #regularTestFailureTest).
	suite addTest: (self class selector: #resumableTestFailureTest).
	suite addTest: (self class selector: #okTest).
	result := suite run.
	self
		assert: result failures size = 2;
		assert: result errors size = 1! !

!ResumableTestFailureTestCase methodsFor: 'running' stamp: 'BaseSystem 8/30/2009 09:40'!
tearDown
	self deny: 'You should not see me' = duplicateFailureLog last
			description: 'We saw the ''You should not see me'' failure'.
	self deny: 'You should see more than me' = duplicateFailureLog last
			description: 'We did not see more than a ''You should see more than me'' failure'.! !

!ResumableTestFailureTestCase methodsFor: 'test data' stamp: 'BaseSystem 8/30/2009 09:40'!
okTest
	self assert: true! !

!ResumableTestFailureTestCase methodsFor: 'logging' stamp: 'BaseSystem 8/30/2009 09:40'!
logFailure: aString
	duplicateFailureLog add: aString.
	super logFailure: aString.! !

!ResumableTestFailureTestCase methodsFor: 'test data' stamp: 'BaseSystem 8/30/2009 09:40'!
failureTest
	self
		assert: false description: 'You should see me' resumable: true; 
		assert: false description: 'You should see me too' resumable: true; 
		assert: false description: 'You should see me last' resumable: false; 
		assert: false description: 'You should not see me' resumable: true! !

!ResumableTestFailureTestCase methodsFor: 'test data' stamp: 'BaseSystem 8/30/2009 09:40'!
regularTestFailureTest
	self assert: false description: 'You should see me'! !

!ResumableTestFailureTestCase methodsFor: 'Not categorized' stamp: 'BaseSystem 8/30/2009 09:40'!
resumableTestFailureTest
	self
		assert: false description: 'You should see more than me' resumable: true; 
		assert: false description: 'You should see more than me' resumable: true; 
		assert: false description: 'You should see me last' resumable: false; 
		assert: false description: 'You should not see me' resumable: true! !

!ResumableTestFailureTestCase methodsFor: 'running' stamp: 'BaseSystem 8/30/2009 09:40'!
setUp
	duplicateFailureLog := OrderedCollection with: 'In set up'.! !

!ResumableTestFailureTestCase class methodsFor: 'history' stamp: 'simon.denier 11/22/2008 22:13'!
lastStoredRun
	^ ((Dictionary new) add: (#passed->((Set new) add: #testResumable; yourself)); add: (#timeStamp->'22 November 2008 10:11:35 pm'); add: (#failures->((Set new))); add: (#errors->((Set new))); yourself)! !

!ResumeDebugAction commentStamp: '<historical>'!
A ResumeDebugAction resumes the execution of the interrupted process and closes the debugger.
!
!ResumeDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/18/2013 18:55'!
id

	^ #resume! !

!ResumeDebugAction methodsFor: 'actions' stamp: 'AndreiChis 9/19/2013 17:13'!
executeAction

	self session 
		resume;
		clear.
	self debugger close. ! !

!ResumeDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/21/2013 21:33'!
defaultKeyText

	^ 'p'! !

!ResumeDebugAction methodsFor: 'testing' stamp: 'AndreiChis 9/20/2013 17:16'!
appliesToDebugger: aDebugger

	^ aDebugger session isInterruptedContextPostMortem not! !

!ResumeDebugAction methodsFor: 'initialization' stamp: 'AndreiChis 9/25/2013 17:33'!
initialize

	super initialize.
	"No need to update the debgger as it will anyway be closed."
	self needsUpdate: false ! !

!ResumeDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/24/2013 17:42'!
defaultLabel

	^ 'Proceed'! !

!ResumeDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/18/2013 18:57'!
defaultOrder

	^ 5! !

!ResumeDebugAction class methodsFor: 'registration' stamp: 'AndreiChis 9/21/2013 22:15'!
actionType
	<debuggingAction>
	<contextMenuDebuggingAction>! !

!ReturnNode commentStamp: '<historical>'!
I represent an expression of the form ^expr.!
!ReturnNode methodsFor: 'code generation' stamp: ''!
code

	^expr code! !

!ReturnNode methodsFor: 'testing' stamp: ''!
isVariableReference

	^expr isVariableReference! !

!ReturnNode methodsFor: 'testing' stamp: ''!
isReturnSelf

	^expr == NodeSelf! !

!ReturnNode methodsFor: 'converting' stamp: ''!
asReturnNode! !

!ReturnNode methodsFor: 'testing' stamp: ''!
isSpecialConstant

	^expr isSpecialConstant! !

!ReturnNode methodsFor: 'initialize-release' stamp: ''!
expr: e encoder: encoder sourceRange: range

	expr := e.
	encoder noteSourceRange: range forNode: self! !

!ReturnNode methodsFor: 'code generation (closures)' stamp: 'eem 7/24/2009 09:44'!
analyseTempsWithin: scopeBlock "<BlockNode>" rootNode: rootNode "<MethodNode>" assignmentPools: assignmentPools "<Dictionary>"
	"Note we could do this:
		scopeBlock ~~ rootNode block ifTrue:
			[scopeBlock noteNonLocalReturn].
	 and pass up the flag in <BlockNode>>>analyseTempsWithin:rootNode:
	 which may be fast but will also give less information the debugger.
	 For now we consider clean blocks a premature optimization."
	self flag: 'consider clean blocks'.
	expr analyseTempsWithin: scopeBlock rootNode: rootNode assignmentPools: assignmentPools! !

!ReturnNode methodsFor: 'testing' stamp: 'MarcusDenker 5/20/2013 15:21'!
isReturn
	^true! !

!ReturnNode methodsFor: 'printing' stamp: 'yo 8/2/2004 17:21'!
expr

	^ expr.
! !

!ReturnNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 14:52'!
sizeCodeForValue: encoder

	^expr sizeCodeForReturn: encoder! !

!ReturnNode methodsFor: 'initialize-release' stamp: ''!
expr: e

	expr := e! !

!ReturnNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 16:40'!
emitCodeForValue: stack encoder: encoder

	expr emitCodeForReturn: stack encoder: encoder.
	pc := encoder methodStreamPosition! !

!ReturnNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 16:40'!
emitCodeForReturn: stack encoder: encoder

	expr emitCodeForReturn: stack encoder: encoder.
	pc := encoder methodStreamPosition! !

!ReturnNode methodsFor: 'visiting' stamp: 'eem 9/6/2009 12:35'!
accept: aVisitor
	^aVisitor visitReturnNode: self! !

!ReturnNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 14:52'!
sizeCodeForReturn: encoder

	^expr sizeCodeForReturn: encoder! !

!ReturnNode methodsFor: 'printing' stamp: 'AlainPlantec 1/7/2010 22:35'!
printOn: aStream indent: level

	aStream nextPutAll: '^ '. 
	expr printOn: aStream indent: level.
	expr printCommentOn: aStream indent: level! !

!ReturnValueDebugAction commentStamp: '<historical>'!
A ReturnValueDebugAction forces a return of a given value to the previous context
!
!ReturnValueDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/21/2013 22:19'!
id

	^ #returnValue! !

!ReturnValueDebugAction methodsFor: 'actions' stamp: 'AndreiChis 9/21/2013 22:24'!
executeAction
	|expression value|
	
	expression := UIManager default request: 'Enter expression for return value:'.
	value := self class compiler
			source: expression;
			context: self currentContext;
			receiver: self currentContext receiver;
			evaluate.

	self session returnValue: value from: self currentContext! !

!ReturnValueDebugAction methodsFor: 'testing' stamp: 'AndreiChis 9/21/2013 22:19'!
appliesToDebugger: aDebugger

	^ aDebugger session isInterruptedContextPostMortem not! !

!ReturnValueDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/21/2013 22:19'!
defaultLabel

	^ 'Return entered value'! !

!ReturnValueDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/21/2013 22:19'!
defaultOrder

	^ 50! !

!ReturnValueDebugAction class methodsFor: 'registration' stamp: 'AndreiChis 9/21/2013 22:19'!
actionType
	<contextMenuDebuggingAction>! !

!RootClassPoolUser commentStamp: 'StephaneDucasse 12/13/2011 15:57'!
I'm a class using a single shared pool (which hides a system class). My subclasses should be able to 
access the class variable defined in the pool I use. !
!RootClassPoolUser class methodsFor: 'accessing' stamp: 'StephaneDucasse 10/7/2011 21:16'!
author

	^  Author! !

!RootClassPoolUser class methodsFor: 'accessing' stamp: 'StephaneDucasse 10/7/2011 21:16'!
gloups

	^  Gloups! !

!RootEyeElement commentStamp: 'SvenVanCaekenberghe 3/15/2014 23:38'!
RootEyeElement is used in the tree/explorer view for the initial, top root element. It shows a different label.
!
!RootEyeElement methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 3/15/2014 23:38'!
label
	^ 'root'! !

!RotatingStringMorph commentStamp: '<historical>'!
A RotatingStringMorph is a StringMorph which rotate to show everything if the width is too small to display the whole contents!
!RotatingStringMorph methodsFor: 'stepping and presenter' stamp: 'CT 1/8/2013 18:47'!
step
	(rotating and: [ self largeEnough not ]) ifTrue: [ self stepAction ]! !

!RotatingStringMorph methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 23:07'!
initialize

	super initialize.
	initialContents := self contents.
	rotating := false.
	self on: #mouseEnter send: #mouseEnter: to: self.
	self on: #mouseLeave send: #mouseLeave: to: self.! !

!RotatingStringMorph methodsFor: 'event handling' stamp: 'CT 1/8/2013 18:23'!
mouseEnter: evt

	rotating := true! !

!RotatingStringMorph methodsFor: 'accessing' stamp: 'CT 1/8/2013 18:38'!
contents: aString

	initialContents := aString.
	self privateSetContents: aString, ' '! !

!RotatingStringMorph methodsFor: 'testing' stamp: 'CT 1/8/2013 18:21'!
stepTime

	^ 150! !

!RotatingStringMorph methodsFor: 'event handling' stamp: 'CT 1/8/2013 18:48'!
mouseLeave: evt

	rotating := false.
	self resetDisplay! !

!RotatingStringMorph methodsFor: 'stepping and presenter' stamp: 'CT 1/8/2013 18:21'!
stepAction
	self privateSetContents: self contents allButFirst , self contents first asString! !

!RotatingStringMorph methodsFor: 'private' stamp: 'CT 1/8/2013 18:46'!
largeEnough
	^ (self font widthOfString: initialContents) <= (self ownerChain collect: [ :morph | morph extent x ]) min! !

!RotatingStringMorph methodsFor: 'protocol' stamp: ''!
asText

	^ initialContents asText! !

!RotatingStringMorph methodsFor: 'private' stamp: 'CT 1/8/2013 18:23'!
resetDisplay
	
	self privateSetContents: initialContents.
	! !

!RoundedBorder commentStamp: 'gvc 9/23/2008 11:52'!
Rounded corner border supporting radii of 1-4 pixels. Slower but more flexible than CornerRounder.!
!RoundedBorder methodsFor: 'drawing' stamp: 'gvc 2/9/2009 13:58'!
frameRectangle0: aRectangle on: aCanvas
	"Draw the border for a corner radius of 0."

	aCanvas
		frameAndFillRectangle: aRectangle
		fillColor: Color transparent
		borderWidth: self width
		borderColor: self color! !

!RoundedBorder methodsFor: 'drawing' stamp: 'gvc 2/21/2008 14:37'!
frameRectangle3: aRectangle on: aCanvas
	"Draw the border for a corner radius of 3."

	|r|
	r := aRectangle insetBy: self width // 2.	
	self width odd ifTrue: [r := r insetBy: (0@0 corner: 1@1)].
	aCanvas
		line: r topLeft + (3@0) to: r topRight - (3@0) width: self width color: self color;
		line: r topRight + (-2@1) to: r topRight + (-1@1) width: self width color: self color;
		line: r topRight + (-1@1) to: r topRight + (-1@2) width: self width color: self color;
		line: r topRight + (0@3) to: r bottomRight - (0@3) width: self width color: self color;
		line: r bottomRight - (1@2) to: r bottomRight - (1@1) width: self width color: self color;
		line: r bottomRight - (1@1) to: r bottomRight - (2@1) width: self width color: self color;
		line: r bottomRight - (3@0) to: r bottomLeft + (3@0) width: self width color: self color;
		line: r bottomLeft - (-2@1) to: r bottomLeft - (-1@1) width: self width color: self color;
		line: r bottomLeft - (-1@1) to: r bottomLeft - (-1@2) width: self width color: self color;
		line: r bottomLeft - (0@3) to: r topLeft + (0@3) width: self width color: self color;
		line: r topLeft + (1@2) to: r topLeft + (1@1) width: self width color: self color;
		line: r topLeft + (1@1) to: r topLeft + (2@1) width: self width color: self color! !

!RoundedBorder methodsFor: 'drawing' stamp: 'gvc 1/9/2009 17:06'!
frameRectangle7: aRectangle on: aCanvas
	"Draw the border for a corner radius of 7."

	|r|
	r := aRectangle insetBy: self width // 2.	
	self width odd ifTrue: [r := r insetBy: (0@0 corner: 1@1)].
	aCanvas
		line: r topLeft + (7@0) to: r topRight - (7@0) width: self width color: self color;
		line: r topRight + (-6@1) to: r topRight + (-5@1) width: self width color: self color;
		line: r topRight + (-4@2) to: r topRight + (-2@4) width: self width color: self color;
		line: r topRight + (-1@5) to: r topRight + (-1@6) width: self width color: self color;
		line: r topRight + (0@7) to: r bottomRight - (0@7) width: self width color: self color;
		line: r bottomRight - (1@6) to: r bottomRight - (1@5) width: self width color: self color;
		line: r bottomRight - (2@4) to: r bottomRight - (4@2) width: self width color: self color;
		line: r bottomRight - (5@1) to: r bottomRight - (6@1) width: self width color: self color;
		line: r bottomRight - (7@0) to: r bottomLeft + (7@0) width: self width color: self color;
		line: r bottomLeft - (-6@1) to: r bottomLeft - (-5@1) width: self width color: self color;
		line: r bottomLeft - (-4@2) to: r bottomLeft - (-2@4) width: self width color: self color;
		line: r bottomLeft - (-1@5) to: r bottomLeft - (-1@6) width: self width color: self color;
		line: r bottomLeft - (0@7) to: r topLeft + (0@7) width: self width color: self color;
		line: r topLeft + (1@6) to: r topLeft + (1@5) width: self width color: self color;
		line: r topLeft + (2@4) to: r topLeft + (4@2) width: self width color: self color;
		line: r topLeft + (5@1) to: r topLeft + (6@1) width: self width color: self color! !

!RoundedBorder methodsFor: 'accessing' stamp: 'gvc 3/14/2007 10:47'!
cornerRadius: anObject
	"Set the value of cornerRadius"

	cornerRadius := anObject! !

!RoundedBorder methodsFor: 'drawing' stamp: 'gvc 2/21/2008 14:26'!
frameRectangle2: aRectangle on: aCanvas
	"Draw the border for a corner radius of 2."

	|r|
	r := aRectangle insetBy: self width // 2.	
	self width odd ifTrue: [r := r insetBy: (0@0 corner: 1@1)].
	aCanvas
		line: r topLeft + (2@0) to: r topRight - (2@0) width: self width color: self color;
		line: r topRight + (-1@1) to: r topRight + (-1@1) width: self width color: self color;
		line: r topRight + (0@2) to: r bottomRight - (0@2) width: self width color: self color;
		line: r bottomRight - (1@1) to: r bottomRight - (1@1) width: self width color: self color;
		line: r bottomRight - (2@0) to: r bottomLeft + (2@0) width: self width color: self color;
		line: r bottomLeft - (-1@1) to: r bottomLeft - (-1@1) width: self width color: self color;
		line: r bottomLeft - (0@2) to: r topLeft + (0@2) width: self width color: self color;
		line: r topLeft + (1@1) to: r topLeft + (1@1) width: self width color: self color! !

!RoundedBorder methodsFor: 'drawing' stamp: 'gvc 2/9/2009 13:58'!
frameRectangle: aRectangle on: aCanvas
	"Draw the border. Radius is the x/y offset not width 'around the corner'."
	
	self cornerRadius = 0 ifTrue: [^self frameRectangle0: aRectangle on: aCanvas].
	self cornerRadius = 1 ifTrue: [^self frameRectangle1: aRectangle on: aCanvas].
	self cornerRadius = 2 ifTrue: [^self frameRectangle2: aRectangle on: aCanvas].
	self cornerRadius = 3 ifTrue: [^self frameRectangle3: aRectangle on: aCanvas].
	self cornerRadius = 4 ifTrue: [^self frameRectangle4: aRectangle on: aCanvas].
	self cornerRadius = 5 ifTrue: [^self frameRectangle5: aRectangle on: aCanvas].
	self cornerRadius = 6 ifTrue: [^self frameRectangle6: aRectangle on: aCanvas].
	self cornerRadius = 7 ifTrue: [^self frameRectangle7: aRectangle on: aCanvas].
	self cornerRadius = 8 ifTrue: [^self frameRectangle8: aRectangle on: aCanvas].
	^super frameRectangle: aRectangle on: aCanvas.! !

!RoundedBorder methodsFor: 'drawing' stamp: 'gvc 2/21/2008 14:20'!
frameRectangle1: aRectangle on: aCanvas
	"Draw the border for a corner radius of 1."

	|r|
	r := aRectangle insetBy: self width // 2.	
	self width odd ifTrue: [r := r insetBy: (0@0 corner: 1@1)].
	aCanvas
		line: r topLeft + (1@0) to: r topRight - (1@0) width: self width color: self color;
		line: r topRight + (0@1) to: r bottomRight - (0@1) width: self width color: self color;
		line: r bottomRight - (1@0) to: r bottomLeft + (1@0) width: self width color: self color;
		line: r bottomLeft - (0@1) to: r topLeft + (0@1) width: self width color: self color! !

!RoundedBorder methodsFor: 'drawing' stamp: 'gvc 1/9/2009 17:10'!
frameRectangle8: aRectangle on: aCanvas
	"Draw the border for a corner radius of 8."

	|r|
	r := aRectangle insetBy: self width // 2.	
	self width odd ifTrue: [r := r insetBy: (0@0 corner: 1@1)].
	aCanvas
		line: r topLeft + (8@0) to: r topRight - (8@0) width: self width color: self color;
		line: r topRight + (-7@1) to: r topRight + (-6@1) width: self width color: self color;
		line: r topRight + (-5@2) to: r topRight + (-2@5) width: self width color: self color;
		line: r topRight + (-1@6) to: r topRight + (-1@7) width: self width color: self color;
		line: r topRight + (0@8) to: r bottomRight - (0@8) width: self width color: self color;
		line: r bottomRight - (1@7) to: r bottomRight - (1@6) width: self width color: self color;
		line: r bottomRight - (2@5) to: r bottomRight - (5@2) width: self width color: self color;
		line: r bottomRight - (6@1) to: r bottomRight - (7@1) width: self width color: self color;
		line: r bottomRight - (8@0) to: r bottomLeft + (8@0) width: self width color: self color;
		line: r bottomLeft - (-7@1) to: r bottomLeft - (-6@1) width: self width color: self color;
		line: r bottomLeft - (-5@2) to: r bottomLeft - (-2@5) width: self width color: self color;
		line: r bottomLeft - (-1@6) to: r bottomLeft - (-1@7) width: self width color: self color;
		line: r bottomLeft - (0@8) to: r topLeft + (0@8) width: self width color: self color;
		line: r topLeft + (1@7) to: r topLeft + (1@6) width: self width color: self color;
		line: r topLeft + (2@5) to: r topLeft + (5@2) width: self width color: self color;
		line: r topLeft + (6@1) to: r topLeft + (7@1) width: self width color: self color! !

!RoundedBorder methodsFor: 'initialization' stamp: 'gvc 3/14/2007 12:16'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		cornerRadius: 0! !

!RoundedBorder methodsFor: 'drawing' stamp: 'gvc 1/9/2009 16:50'!
frameRectangle5: aRectangle on: aCanvas
	"Draw the border for a corner radius of 5."

	|r|
	r := aRectangle insetBy: self width // 2.	
	self width odd ifTrue: [r := r insetBy: (0@0 corner: 1@1)].
	aCanvas
		line: r topLeft + (5@0) to: r topRight - (5@0) width: self width color: self color;
		line: r topRight + (-4@1) to: r topRight + (-2@2) width: self width color: self color;
		line: r topRight + (-1@3) to: r topRight + (-1@4) width: self width color: self color;
		line: r topRight + (0@5) to: r bottomRight - (0@5) width: self width color: self color;
		line: r bottomRight - (1@4) to: r bottomRight - (2@2) width: self width color: self color;
		line: r bottomRight - (3@1) to: r bottomRight - (4@1) width: self width color: self color;
		line: r bottomRight - (5@0) to: r bottomLeft + (5@0) width: self width color: self color;
		line: r bottomLeft - (-4@1) to: r bottomLeft - (-3@1) width: self width color: self color;
		line: r bottomLeft - (-2@2) to: r bottomLeft - (-1@4) width: self width color: self color;
		line: r bottomLeft - (0@5) to: r topLeft + (0@5) width: self width color: self color;
		line: r topLeft + (1@4) to: r topLeft + (1@3) width: self width color: self color;
		line: r topLeft + (2@2) to: r topLeft + (4@1) width: self width color: self color! !

!RoundedBorder methodsFor: 'accessing' stamp: 'gvc 3/14/2007 10:47'!
cornerRadius
	"Answer the value of cornerRadius"

	^ cornerRadius! !

!RoundedBorder methodsFor: 'drawing' stamp: 'gvc 2/9/2009 13:48'!
frameRectangle6: aRectangle on: aCanvas
	"Draw the border for a corner radius of 6."

	|r|
	r := aRectangle insetBy: self width // 2.	
	self width odd ifTrue: [r := r insetBy: (0@0 corner: 1@1)].
	aCanvas
		line: r topLeft + (6@0) to: r topRight - (6@0) width: self width color: self color;
		line: r topRight + (-5@1) to: r topRight + (-3@2) width: self width color: self color;
		line: r topRight + (-2@3) to: r topRight + (-2@3) width: self width color: self color;
		line: r topRight + (-1@4) to: r topRight + (-1@5) width: self width color: self color;
		line: r topRight + (0@6) to: r bottomRight - (0@6) width: self width color: self color;
		line: r bottomRight - (1@5) to: r bottomRight - (2@3) width: self width color: self color;
		line: r bottomRight - (3@2) to: r bottomRight - (4@1) width: self width color: self color;
		line: r bottomRight - (5@1) to: r bottomRight - (6@0) width: self width color: self color;
		line: r bottomRight - (7@0) to: r bottomLeft + (6@0) width: self width color: self color;
		line: r bottomLeft - (-5@1) to: r bottomLeft - (-4@1) width: self width color: self color;
		line: r bottomLeft - (-3@2) to: r bottomLeft - (-3@2) width: self width color: self color;
		line: r bottomLeft - (-2@3) to: r bottomLeft - (-1@5) width: self width color: self color;
		line: r bottomLeft - (0@6) to: r topLeft + (0@6) width: self width color: self color;
		line: r topLeft + (1@5) to: r topLeft + (1@4) width: self width color: self color;
		line: r topLeft + (2@3) to: r topLeft + (2@3) width: self width color: self color;
		line: r topLeft + (3@2) to: r topLeft + (5@1) width: self width color: self color! !

!RoundedBorder methodsFor: 'drawing' stamp: 'gvc 2/21/2008 14:41'!
frameRectangle4: aRectangle on: aCanvas
	"Draw the border for a corner radius of 4."

	|r|
	r := aRectangle insetBy: self width // 2.	
	self width odd ifTrue: [r := r insetBy: (0@0 corner: 1@1)].
	aCanvas
		line: r topLeft + (4@0) to: r topRight - (4@0) width: self width color: self color;
		line: r topRight + (-3@1) to: r topRight + (-1@2) width: self width color: self color;
		line: r topRight + (-1@2) to: r topRight + (-1@3) width: self width color: self color;
		line: r topRight + (0@4) to: r bottomRight - (0@4) width: self width color: self color;
		line: r bottomRight - (1@3) to: r bottomRight - (1@2) width: self width color: self color;
		line: r bottomRight - (2@1) to: r bottomRight - (3@1) width: self width color: self color;
		line: r bottomRight - (4@0) to: r bottomLeft + (4@0) width: self width color: self color;
		line: r bottomLeft - (-3@1) to: r bottomLeft - (-2@1) width: self width color: self color;
		line: r bottomLeft - (-1@2) to: r bottomLeft - (-1@3) width: self width color: self color;
		line: r bottomLeft - (0@4) to: r topLeft + (0@4) width: self width color: self color;
		line: r topLeft + (1@3) to: r topLeft + (1@2) width: self width color: self color;
		line: r topLeft + (2@1) to: r topLeft + (3@1) width: self width color: self color! !

!RowLayout commentStamp: 'gvc 5/31/2007 16:12'!
A simple row layout.!
!RowLayout methodsFor: 'as yet unclassified' stamp: 'gvc 7/1/2010 12:15'!
minExtentOf: aMorph in: newBounds
	"Return the minimal size aMorph's children would require given the new bounds"
	
	| props extent|
	cachedMinExtent ifNotNil: [^cachedMinExtent].
	aMorph submorphs ifEmpty: [^aMorph minWidth @ aMorph minHeight].
	extent := 0@0.
	cachedMinExtents := aMorph submorphs collect: [:m | | min |
		min := m minExtent.
		extent := extent x + min x @ (extent y max: min y).
		min].
	props := aMorph assureTableProperties.
	^cachedMinExtent := extent + (aMorph submorphs size - 1 * 
		(props cellInset isPoint ifTrue: [props cellInset x] ifFalse: [props cellInset]) @ 0)! !

!RowLayout methodsFor: 'as yet unclassified' stamp: 'gvc 5/31/2007 17:20'!
flushLayoutCache
	"Flush any cached information associated with the receiver."
	
	cachedMinExtent := nil! !

!RowLayout methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 8/15/2013 16:47'!
layout: aMorph in: layoutBounds
	"Compute the layout for the given morph based on the new bounds.
	Supports submorph hResizing, vResizing, cellInset, cellPositioning
	(top, *center, bottom*) and listCentering."

	| props spare extra height inset newBounds minExt fillCount x width|
	aMorph submorphs ifEmpty: [^self].
	props := aMorph assureTableProperties.
	minExt := (aMorph minWidth@aMorph minHeight - aMorph extent + aMorph layoutBounds extent) max: 0@0.
	newBounds := layoutBounds origin extent: (layoutBounds extent max: minExt).
	width := 0.
	width := (self minExtentOf: aMorph in: newBounds) x.
	spare := newBounds width - width max: 0.
	fillCount := 0.
	spare > 0
		ifTrue: [fillCount := aMorph submorphs inject: 0 into: [:tot :m |
					tot + (m hResizing == #spaceFill ifTrue: [1] ifFalse: [0])].
				extra := fillCount = 0
					ifTrue: [0]
					ifFalse: [spare // fillCount].
				spare := spare - (fillCount - 1 * extra)]
		ifFalse: [extra := 0].
	x := fillCount > 0
		ifTrue: [newBounds left]
		ifFalse: [props listCentering == #center
					ifTrue: [newBounds center x - (width // 2)]
					ifFalse: [props listCentering == #bottomRight
								ifTrue: [newBounds right - width]
								ifFalse: [newBounds left]]].
	height := newBounds height.
	inset := props cellInset isPoint ifTrue: [props cellInset x] ifFalse: [props cellInset]. 
	aMorph submorphs with: cachedMinExtents do: [:m :ext | | pos vr box cell |
		width := m hResizing == #spaceFill
			ifTrue: [fillCount := fillCount - 1.
					ext x + (fillCount > 0
						ifTrue: [spare]
						ifFalse: [extra])]
			ifFalse: [ext x].
		cell := x@newBounds top extent: width@height.
		((vr := m vResizing) == #shrinkWrap or: [m bounds ~= cell])
			ifTrue: [((vr == #shrinkWrap) not and: [m extent = cell extent])
						ifTrue: [m position: cell origin]
						ifFalse: [box := m bounds.
								m hResizing == #spaceFill 
									ifTrue: [box := cell origin extent: cell width @ box height].
								vr  == #spaceFill
									ifTrue: [box := box origin extent: box width @ cell height].
								vr  == #shrinkWrap
									ifTrue:[box := box origin extent: box width @ ext y].
								pos := props cellPositioning.
								box := box align: (box perform: pos) with: (cell perform: pos).
								m bounds: box]].
		x := x + width + inset]! !

!RubAbstractTextArea commentStamp: 'AlainPlantec 5/21/2014 00:39'!
RubTextSurface is a kind of TextMorph.

About the contextual menu
By default, the menu is given by the editingMode.
The model can implement a #menu method to impose a specific menu.

This menu retrieving algorithm is implemented by a dedicated objet, hold by the RubAbstractTextArea>>#getMenuPolicy instance variable. This dedicated object implements a #lookupMenu method for this.
By default, it is the textArea itself (see RubAbstractTextArea>>defaultGetMenuPolicy). 
The policy can be changed with RubAbstractTextArea>>#getMenuPolicy:, by passing whatever object that answer to #lookupMenu.

Instance Variables
	editingMode:		<Object>
	editingState:		<Object>
	editor:		<Object>
	hasFocus:		<Object>
	holder:		<Object>
	margins:		<Object>
	menuAllowed:		<Object>
	model:		<Object>
	paragraph:		<Object>
	readOnly:		<Object>
	scrollPivot:		<Object>
	text:		<Object>
	textColor:		<Object>
	textStyle:		<Object>
	wrapped:		<Object>

editingMode
	- xxxxx

editingState
	- xxxxx

editor
	- xxxxx

hasFocus
	- xxxxx

holder
	- xxxxx

margins
	- xxxxx

menuAllowed
	- xxxxx

model
	- xxxxx

paragraph
	- xxxxx

readOnly
	- xxxxx

scrollPivot
	- xxxxx

text
	- xxxxx

textColor
	- xxxxx

textStyle
	- xxxxx

wrapped
	- xxxxx


!
!RubAbstractTextArea methodsFor: 'accessing cursor' stamp: 'AlainPlantec 2/6/2014 14:22'!
removeCursor
	self cursor ifNotNil: [ :c | 
		self cursor aboutToBeRemoved.
		self removeMorph: c ].
	cursor := nil! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 4/22/2013 10:44'!
markBlock: aCharacterBlock
	self handleSelectionChange: [ self editingState markBlock:  aCharacterBlock]! !

!RubAbstractTextArea methodsFor: 'geometry' stamp: 'AlainPlantec 5/7/2013 16:41'!
minExtent
	| minH |
	minH := scrollPane ifNil: [ 0 ] ifNotNil: [ 60 ].
	^ ((self textStyle defaultFont widthOfString: 'XXX') + self margins left + self margins right)
		@ (self textStyle lineGrid + self margins top + self margins bottom)! !

!RubAbstractTextArea methodsFor: 'find-replace' stamp: 'AlainPlantec 3/26/2013 13:35'!
replaceSelectionWith: aText
	self
		handleEdit: [self editor replaceSelectionWith: aText]! !

!RubAbstractTextArea methodsFor: 'event handling' stamp: 'TudorGirba 7/22/2014 22:37'!
escapePressed
	"do nothing. do not simulate a right click
	because Esc is too useful as a shortcut for other purposes
	to be used for popping a menu"
	"^ self yellowButtonActivity: false"
! !

!RubAbstractTextArea methodsFor: 'private' stamp: 'AlainPlantec 4/11/2013 23:42'!
announce: anAnnouncement 
	self announcer announce: anAnnouncement ! !

!RubAbstractTextArea methodsFor: 'accessing cursor' stamp: 'AlainPlantec 4/25/2013 20:36'!
forceCursorVisibleWhile: aBlock
	self cursor
		ifNotNil: [ :cur | 
			| prev |
			prev := cur stayVisible.
			cur stayVisible: true.
			aBlock
				ensure: [ cur stayVisible: prev ] ]! !

!RubAbstractTextArea methodsFor: 'initialize' stamp: 'TudorGirba 6/2/2014 08:23'!
initialize
	super initialize.
	self compose.
	self addCursor.
	self plugFindReplace.! !

!RubAbstractTextArea methodsFor: 'composing' stamp: 'AlainPlantec 4/5/2013 20:40'!
handleParagraphChange: aBlock
	aBlock value.
	self compose.
	self changed! !

!RubAbstractTextArea methodsFor: 'public accessing' stamp: 'AlainPlantec 5/14/2013 12:45'!
beEditable
	self readOnly
		ifTrue: [ self readOnly: false ]! !

!RubAbstractTextArea methodsFor: 'accessing decorators' stamp: 'AlainPlantec 4/16/2013 15:49'!
hasDecorator: aDecorator
	^ self paragraph hasDecorator: aDecorator
	! !

!RubAbstractTextArea methodsFor: 'menu' stamp: 'AlainPlantec 5/20/2014 22:27'!
getMenuPolicy
	^ getMenuPolicy ifNil: [ getMenuPolicy := self defaultGetMenuPolicy ]! !

!RubAbstractTextArea methodsFor: 'paragraph feedbacks' stamp: 'AlainPlantec 2/6/2014 14:44'!
updateExtentFromParagraph
	(paragraph notNil and: [ bounds notNil ])
		ifTrue: [ 
			| newExtent |
			newExtent := self paragraph extent max: self minimumExtent.
			self forceExtentTo: (newExtent x + self margins right) @ newExtent y]! !

!RubAbstractTextArea methodsFor: 'accessing text' stamp: 'AlainPlantec 5/8/2013 09:27'!
addAttribute: anAttribute
	self text addAttribute: anAttribute ! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 4/19/2013 11:40'!
markBlock
	^ self editingState markBlock! !

!RubAbstractTextArea methodsFor: 'testing' stamp: 'TudorGirba 5/30/2014 13:29'!
takesKeyboardFocus
	"Answer whether the receiver can normally take keyboard focus."

	^true! !

!RubAbstractTextArea methodsFor: 'geometry' stamp: 'AlainPlantec 5/30/2013 00:07'!
privateMoveBy: delta
	self
		handleBoundsChange: [ 
			self paragraph moveBy: delta truncated.
			super privateMoveBy: delta truncated ]! !

!RubAbstractTextArea methodsFor: 'initialize' stamp: 'AlainPlantec 5/7/2013 11:57'!
plugFindReplace
	self announcer subscribe:  MorphGotFocus send: #whenTextAreaGotFocus: to: RubFindReplaceService default.	
	self announcer subscribe:  MorphLostFocus send: #whenTextAreaLostFocus: to: RubFindReplaceService default.	
	self announcer subscribe:  RubSelectionChanged send: #whenTextAreaSelectionChanged: to: RubFindReplaceService default.	
	RubFindReplaceService default announcer weak subscribe:  RubFindTextChanged  send: #whenFindTextChanged: to: self

! !

!RubAbstractTextArea methodsFor: 'event handling' stamp: 'AlainPlantec 3/26/2013 13:35'!
mouseEnter: evt
	"Handle a mouseEnter event, meaning the mouse just entered my bounds with no button pressed."
	super mouseEnter: evt.
	self showOverEditableTextCursor
	! !

!RubAbstractTextArea methodsFor: 'submorphs-add/remove' stamp: 'AlainPlantec 4/25/2013 17:32'!
delete
	self hasFocus
		ifTrue: [ self currentHand newKeyboardFocus: nil ].
	super delete! !

!RubAbstractTextArea methodsFor: 'accessing editing state' stamp: 'AlainPlantec 4/25/2013 18:58'!
hasFocus
	^ ( editingState ifNil: [^ false ] ) hasFocus! !

!RubAbstractTextArea methodsFor: 'accessing segments' stamp: 'AlainPlantec 2/6/2014 23:13'!
segments
	^ segments ifNil: [ segments := OrderedCollection new ]
! !

!RubAbstractTextArea methodsFor: 'initialize' stamp: 'AlainPlantec 4/19/2013 13:21'!
unplugFindReplace
	self announcer unsubscribe: RubFindReplaceService default.	
	RubFindReplaceService default announcer unsubscribe: self
! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 4/22/2013 10:46'!
markIndex: markIndex pointIndex: pointIndex
	self handleSelectionChange: [ self editingState markIndex: markIndex pointIndex: pointIndex ]! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 4/11/2013 21:38'!
markIndex
	^ self editingState markIndex
! !

!RubAbstractTextArea methodsFor: 'menu' stamp: 'AlainPlantec 5/20/2014 23:48'!
getMenuPolicy: aGetMenuPolicy
	getMenuPolicy := aGetMenuPolicy! !

!RubAbstractTextArea methodsFor: 'event handling' stamp: 'AlainPlantec 4/25/2013 18:54'!
mouseUp: evt
	self scrollPivot: nil.
	(self boundsInWorld containsPoint: self currentHand position)
		ifFalse: [self hideOverEditableTextCursor].
! !

!RubAbstractTextArea methodsFor: 'accessing' stamp: 'AlainPlantec 2/6/2014 14:43'!
cursorWidth
	^ self cursorClass defaultWidth ! !

!RubAbstractTextArea methodsFor: 'accessing paragraph' stamp: 'AlainPlantec 4/11/2013 09:34'!
lines
	^ self paragraph lines! !

!RubAbstractTextArea methodsFor: 'private' stamp: 'AlainPlantec 4/24/2013 12:54'!
setEmphasisHere
	self editor setEmphasisHere! !

!RubAbstractTextArea methodsFor: 'paragraph feedbacks' stamp: 'AlainPlantec 2/6/2014 15:19'!
paragraphWasComposedFrom: startIndex to: stopIndex
	self
		handleBoundsChange: [ 
			self wrapped
				ifTrue: [ self updateBottomFromParagraph ]
				ifFalse: [ self updateExtentFromParagraph ] ]! !

!RubAbstractTextArea methodsFor: 'geometry' stamp: 'AlainPlantec 2/6/2014 11:06'!
handleBoundsChange: aBlock
	| oldBounds |
	oldBounds := self bounds copy.
	aBlock value.
	oldBounds topLeft ~= self bounds topLeft
		ifTrue: [ self announce: ((RubPositionChanged morph: self) previousBounds: oldBounds)].
	oldBounds extent ~= self bounds extent
		ifTrue: [ 
			self scrollPane ifNotNil: [ :sp | sp textAreaExtentChanged ].
			self announce: ((RubExtentChanged morph: self) previousBounds: oldBounds) ].
! !

!RubAbstractTextArea methodsFor: 'composing' stamp: 'AlainPlantec 5/7/2013 23:09'!
compose

	self prepareParagraphToCompose.
	self paragraph compose ! !

!RubAbstractTextArea methodsFor: 'accessing cursor' stamp: 'AlainPlantec 2/6/2014 14:37'!
cursorClass
	^ RubCursor! !

!RubAbstractTextArea methodsFor: 'private' stamp: 'AlainPlantec 5/18/2013 22:37'!
privateSetTextStyle: aTextStyle
	textStyle := aTextStyle! !

!RubAbstractTextArea methodsFor: 'layout' stamp: 'AlainPlantec 3/21/2013 18:39'!
acceptDroppingMorph: aMorph event: evt
	"This message is sent when a morph is dropped onto me."
	self addMorphFront: aMorph fromWorldPosition: aMorph position.
		"Make a TextAnchor and install it in a run."! !

!RubAbstractTextArea methodsFor: 'accessing' stamp: 'AlainPlantec 3/23/2013 13:30'!
backgroundColor: newColor
	self color: newColor! !

!RubAbstractTextArea methodsFor: 'accessing text' stamp: 'AlainPlantec 11/24/2013 21:07'!
privateText: stringOrText
	"Accept new text contents."

	| fontNumber |
	stringOrText isText
		ifTrue: [ self paragraph text: stringOrText ]
		ifFalse: [ 
			fontNumber := self textStyle defaultFontIndex.
			self paragraph text: (Text string: stringOrText asString attributes: {(TextFontChange fontNumber: fontNumber)}) ]! !

!RubAbstractTextArea methodsFor: 'event handling' stamp: 'AlainPlantec 5/7/2013 12:58'!
whenFindTextChanged: anAnnouncement 
	self changed! !

!RubAbstractTextArea methodsFor: 'editing' stamp: 'AlainPlantec 6/1/2013 10:13'!
replaceFrom: start to: stop with: aText
	self
		handleEdit: [ self editor replaceTextFrom: start to: stop with: aText ]
! !

!RubAbstractTextArea methodsFor: 'defaults' stamp: 'AlainPlantec 3/26/2013 15:10'!
defaultMenuAllowed
	^ true! !

!RubAbstractTextArea methodsFor: 'accessing decorators' stamp: 'AlainPlantec 4/18/2013 10:48'!
withDecorator: aDecorator
	(self hasDecoratorNamed: aDecorator key)
		ifTrue: [ ^ self ].
	paragraph := aDecorator next: paragraph.
	self compose! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 6/3/2013 23:25'!
primarySelection
	^ self submorphThat: [ :sm | sm isKindOf: RubPrimarySelectionMorph ] ifNone:  [ ]
! !

!RubAbstractTextArea methodsFor: 'accessing decorators' stamp: 'AlainPlantec 4/18/2013 10:48'!
withDecoratorsNamed: aCollection
	aCollection do: [ :m | self withDecoratorNamed: m ]! !

!RubAbstractTextArea methodsFor: 'accessing text' stamp: 'AlainPlantec 2/5/2014 14:44'!
textStyle: aTextStyle
	self privateTextStyle: aTextStyle.
	self addAttribute: (TextFontChange fontNumber: (textStyle defaultFontIndex)).
	self paragraph compose.
	self recomputeSelection.
	self  announce: (RubTextStyleChanged morph: self).
! !

!RubAbstractTextArea methodsFor: 'accessing cursor' stamp: 'AlainPlantec 2/6/2014 14:17'!
addCursor
	self cursor ifNil: [ self addMorph: (cursor := self newCursor) ]! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 4/2/2013 23:52'!
select
	self editor select! !

!RubAbstractTextArea methodsFor: 'find-replace' stamp: 'AlainPlantec 5/7/2013 11:29'!
findAndSelect: aRegex startingAt: anIndex searchBackwards: searchBackwards
	| where |
	self
		handleEdit: [
			where := self editor
				findAndSelect: aRegex
				startingAt: anIndex
				searchBackwards: searchBackwards.
			self scrollSelectionIntoView: nil].
	^ where! !

!RubAbstractTextArea methodsFor: 'accessing editing state' stamp: 'AlainPlantec 4/25/2013 21:35'!
emphasisHere: aListOfAttributes
	self editingState emphasisHere: aListOfAttributes
! !

!RubAbstractTextArea methodsFor: 'defaults' stamp: 'AlainPlantec 4/15/2013 07:45'!
defaultColor
	"answer the default color/fill style for the receiver"
	^ self class backgroundColor! !

!RubAbstractTextArea methodsFor: 'defaults' stamp: 'AlainPlantec 3/23/2013 11:52'!
defaultTextStyle
	| ts f |
	f := self class editorFont.
	ts := f textStyle copy ifNil: [ TextStyle fontArray: { f } ].
	ts defaultFontIndex: (ts fontIndexOf: f).
	^ ts! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 4/22/2013 17:10'!
recomputeSelection
	"The same characters are selected but their coordinates may have changed.
	Redetermine the selection according to the start and stop block indices; 
	do not highlight."

	self markIndex: self markIndex pointIndex: self pointIndex! !

!RubAbstractTextArea methodsFor: 'event handling' stamp: 'AndreiChis 11/14/2014 14:21'!
keyStroke: evt
	"Handle a keystroke event."
	self scrollPane ifNotNil: [ :sp | (sp scrollByKeyboard: evt) ifTrue: [^self] ].
	evt isUserInterrupt ifTrue: [^self].
	self handleEdit: [ self editor keystroke: evt ].
	self scrollSelectionIntoView: nil! !

!RubAbstractTextArea methodsFor: 'accessing editing state' stamp: 'AlainPlantec 4/25/2013 18:53'!
scrollPivot: aPoint
	^self editingState scrollPivot: aPoint! !

!RubAbstractTextArea methodsFor: 'structure' stamp: 'AlainPlantec 5/7/2013 16:41'!
topRendererOrSelf

	^ scrollPane 
		ifNil: [ super topRendererOrSelf ]
		ifNotNil: [ scrollPane topRendererOrSelf ]! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 4/3/2013 11:03'!
selection
	^ self editor selection! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 6/4/2013 09:19'!
primarySelectionColor
	^ self primarySelection ifNil: [ Color transparent] ifNotNil: [:ps | ps color ]! !

!RubAbstractTextArea methodsFor: 'accessing text' stamp: 'AlainPlantec 3/16/2013 10:56'!
userString
	"Do I have a text string to be searched on?"

	^ self text string! !

!RubAbstractTextArea methodsFor: 'accessing editing state' stamp: 'AlainPlantec 3/26/2013 13:33'!
editingStateClass
	^ RubEditingState! !

!RubAbstractTextArea methodsFor: 'accessing decorators' stamp: 'AlainPlantec 4/23/2013 19:42'!
withoutAnyDecorator
	[ self paragraph key notNil ] whileTrue: [ self withoutDecorator: paragraph ]! !

!RubAbstractTextArea methodsFor: 'accessing' stamp: 'AlainPlantec 3/26/2013 12:03'!
menuAllowed: aBoolean
	menuAllowed := aBoolean! !

!RubAbstractTextArea methodsFor: 'event handling' stamp: 'AlainPlantec 3/26/2013 13:35'!
hideOverEditableTextCursor  
	self currentHand showTemporaryCursor: nil
	! !

!RubAbstractTextArea methodsFor: 'private' stamp: 'AlainPlantec 4/23/2013 21:34'!
text: t textStyle: s color: c textColor: tc
	"Private -- for use only in morphic duplication"	
	self releaseParagraph.
	super text: t textStyle: s color: c textColor: tc.
! !

!RubAbstractTextArea methodsFor: 'accessing segments' stamp: 'AndreiChis 1/12/2015 22:51'!
addSegment: aRubTextSegmentMorph
	| seg |
	seg := aRubTextSegmentMorph inTextArea: self.
	self segments add: seg.
	self addMorphBack: seg.
	^ seg
! !

!RubAbstractTextArea methodsFor: 'interactive error protocol' stamp: 'AlainPlantec 4/2/2013 23:50'!
correctFrom: start to: stop with: aString
	self editor correctFrom: start to: stop with: aString! !

!RubAbstractTextArea methodsFor: 'event handling' stamp: 'AlainPlantec 3/26/2013 13:35'!
handlesKeyboard: evt
	^true! !

!RubAbstractTextArea methodsFor: 'keymapping' stamp: 'TudorGirba 6/22/2014 22:47'!
initializeShortcuts: aKMDispatcher
	"we delegate the creation of default shortcuts to the editor
	because it is the one that knows more details about the goal of editing"
	super initializeShortcuts: aKMDispatcher.
	self editor initializeShortcuts: aKMDispatcher! !

!RubAbstractTextArea methodsFor: 'accessing' stamp: 'AlainPlantec 3/26/2013 14:08'!
readOnly: aBoolean
	 readOnly := aBoolean! !

!RubAbstractTextArea methodsFor: 'accessing editing state' stamp: 'AlainPlantec 4/25/2013 18:59'!
hasFocus: aBoolean
	^ self editingState hasFocus: aBoolean ! !

!RubAbstractTextArea methodsFor: 'event handling' stamp: 'AlainPlantec 4/30/2013 13:41'!
handleMouseMove: anEvent
	"Re-implemented to allow for mouse-up move events"

	anEvent wasHandled
		ifTrue: [ ^ self ].	"not interested"
	anEvent hand hasSubmorphs
		ifTrue: [ ^ self ].
	anEvent wasHandled: true.
	self mouseMove: anEvent.
	(anEvent anyButtonPressed and: [ anEvent hand mouseFocus == self ])
		ifFalse: [ ^ self ].
	super handleMouseMove: anEvent
	! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 4/22/2013 10:43'!
unselect
	self handleSelectionChange: [ self editingState unselect ]! !

!RubAbstractTextArea methodsFor: 'menu' stamp: 'AlainPlantec 5/21/2014 00:24'!
defaultGetMenuPolicy
	^ self! !

!RubAbstractTextArea methodsFor: 'accessing text' stamp: 'AlainPlantec 3/23/2013 11:50'!
font
	"Answer the probable font"
	^ self textStyle fonts at: self textStyle defaultFontIndex
! !

!RubAbstractTextArea methodsFor: 'public accessing' stamp: 'AlainPlantec 3/26/2013 12:03'!
allowMenu
	self menuAllowed: true! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 4/3/2013 10:48'!
selectAll
	self editor selectAll! !

!RubAbstractTextArea methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 00:51'!
model: aModel
	model := aModel! !

!RubAbstractTextArea methodsFor: 'accessing' stamp: 'AlainPlantec 3/25/2013 11:00'!
margins
	^  margins ifNil: [margins := self defaultMargins ]! !

!RubAbstractTextArea methodsFor: 'accessing cursor' stamp: 'AlainPlantec 2/6/2014 14:17'!
cursor
	^ cursor
! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 6/3/2013 23:24'!
addPrimarySelection
	self addMorph: self newPrimarySelection.
! !

!RubAbstractTextArea methodsFor: 'event handling' stamp: 'AlainPlantec 4/23/2013 13:17'!
click: anEvent
	self
		handleEdit: [ 
			self editor click: anEvent.
			self scrollSelectionIntoView: nil ]! !

!RubAbstractTextArea methodsFor: 'find-replace' stamp: 'AlainPlantec 3/26/2013 08:01'!
sharesFindReplace
	^ true! !

!RubAbstractTextArea methodsFor: 'composing' stamp: 'AlainPlantec 5/7/2013 16:41'!
offset
	^ scrollPane
		ifNil: [ 0@0 ]
		ifNotNil: [ :h | scrollPane offset ]! !

!RubAbstractTextArea methodsFor: 'accessing editor' stamp: 'AlainPlantec 5/17/2013 22:59'!
editorClass
	"Answer the class used to create the receiver's editor"

	^ RubTextEditor! !

!RubAbstractTextArea methodsFor: 'private' stamp: 'AlainPlantec 2/5/2014 10:13'!
privateTextStyle: aTextStyle
	textStyle := aTextStyle! !

!RubAbstractTextArea methodsFor: 'find-replace' stamp: 'AlainPlantec 5/7/2013 10:51'!
findRegex
	^ self editor findRegex! !

!RubAbstractTextArea methodsFor: 'caching' stamp: 'AlainPlantec 3/22/2013 14:04'!
releaseCachedState
	super releaseCachedState.
	self releaseParagraph! !

!RubAbstractTextArea methodsFor: 'find-replace' stamp: 'AlainPlantec 5/7/2013 13:37'!
hasFindReplaceFocus
	^ RubFindReplaceService default dialogIsActiveFor: self! !

!RubAbstractTextArea methodsFor: 'accessing text' stamp: 'AlainPlantec 4/23/2013 21:19'!
text
	^ self paragraph text! !

!RubAbstractTextArea methodsFor: 'accessing' stamp: 'AlainPlantec 4/15/2013 07:45'!
backgroundColor
	^ self color! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 3/12/2013 17:44'!
selectFrom: a to: b
	self editor selectFrom: a to: b! !

!RubAbstractTextArea methodsFor: 'accessing decorators' stamp: 'AlainPlantec 4/18/2013 10:50'!
withoutDecoratorsNamed: aCollection
	aCollection do: [ :m | self withoutDecoratorNamed: m ]! !

!RubAbstractTextArea methodsFor: 'accessing' stamp: 'AlainPlantec 4/15/2013 17:36'!
lineNumbersTextColor
	^ self class lineNumbersTextColor 
! !

!RubAbstractTextArea methodsFor: 'composing' stamp: 'AlainPlantec 5/7/2013 23:09'!
prepareParagraphToCompose
	self paragraph container: self compositionRectangle.
! !

!RubAbstractTextArea methodsFor: 'composing' stamp: 'AlainPlantec 5/7/2013 16:41'!
scrollBounds
	^ scrollPane
		ifNil: [ self innerBounds  ]
		ifNotNil: [ :h | scrollPane scrollBounds ]! !

!RubAbstractTextArea methodsFor: 'accessing text' stamp: 'AlainPlantec 11/25/2013 10:19'!
textStyle
	^textStyle ifNil: [ textStyle := self defaultTextStyle  ]! !

!RubAbstractTextArea methodsFor: 'event handling' stamp: 'AlainPlantec 4/2/2013 23:59'!
showOverEditableTextCursor
	| o |
	owner isNil
		ifTrue: [^ self].
	o := owner isWorldMorph 
		ifTrue: [self] 
		ifFalse: [owner].
	(o boundsInWorld containsPoint: self currentHand position)
		ifTrue: [self currentHand showTemporaryCursor: (self theme overTextCursorFor: self)]
! !

!RubAbstractTextArea methodsFor: 'accessing editing state' stamp: 'AlainPlantec 4/19/2013 12:15'!
editingState
	^ editingState ifNil: [editingState := self newEditingState]! !

!RubAbstractTextArea methodsFor: 'geometry' stamp: 'AlainPlantec 5/7/2013 23:00'!
extent: aPoint
	self
		handleBoundsChange: [ 
			self wrapped
				ifTrue: [ 
					(bounds notNil and: [ bounds width = aPoint x ])
						ifTrue: [ ^ self ].
					super extent: ((self paragraph extentFromClientBottomRight: aPoint) max: self minimumExtent).
					self recomputeSelection ] ]! !

!RubAbstractTextArea methodsFor: 'accessing editing state' stamp: 'AlainPlantec 5/7/2013 09:54'!
newEditingState
	^ self editingStateClass new textArea: self! !

!RubAbstractTextArea methodsFor: 'accessing decorators' stamp: 'AlainPlantec 4/23/2013 19:49'!
withFindReplaceSelection
	self withDecoratorNamed: #findReplaceSelection! !

!RubAbstractTextArea methodsFor: 'accessing' stamp: 'AlainPlantec 5/17/2013 22:59'!
newEditor
	"Return my current editor, or install a new one."
	^ self editorClass forTextArea: self! !

!RubAbstractTextArea methodsFor: 'accessing editor' stamp: 'AlainPlantec 5/8/2013 09:47'!
openingDelimiters
	^ self editor openingDelimiters
! !

!RubAbstractTextArea methodsFor: 'interactive error protocol' stamp: 'AlainPlantec 4/16/2013 12:41'!
deselect
	self selectFrom: 1 to: 0! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 5/6/2013 22:26'!
selectionRects
	^ Array
		streamContents: [ :strm | 
			strm nextPutAll: self paragraph selectionRects.
			self cursor ifNotNil: [ strm nextPut: self cursor bounds ] ]! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 4/23/2013 13:24'!
selectionChanged
	"Invalidate all the selection rectangles. 
	Make sure that any drop shadow is accounted for too."

	paragraph ifNil: [ ^ self ].
	self recomputeSelection.
! !

!RubAbstractTextArea methodsFor: 'accessing' stamp: 'AlainPlantec 3/26/2013 15:10'!
readOnly
	^readOnly ifNil: [ readOnly := self defaultReadOnly ]! !

!RubAbstractTextArea methodsFor: 'public accessing' stamp: 'AlainPlantec 4/17/2013 17:21'!
updateMarginsWith: aRectangle
	self handleParagraphChange: [self margins: aRectangle ]! !

!RubAbstractTextArea methodsFor: 'event handling' stamp: 'AlainPlantec 4/22/2013 11:49'!
doubleClick: anEvent
	^ self handleEdit: [ self editor doubleClick: anEvent ]! !

!RubAbstractTextArea methodsFor: 'find-replace' stamp: 'AlainPlantec 5/7/2013 10:54'!
openFindDialog
	self sharesFindReplace 
		ifTrue: [ self announce: RubFindReplaceWindowRequired ]
		ifFalse: [self flash]! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 6/2/2013 14:46'!
primarySelectionBounds
	^ self primarySelection bounds! !

!RubAbstractTextArea methodsFor: 'accessing editor' stamp: 'AlainPlantec 4/2/2013 23:51'!
editor
	"Return my current editor, or install a new one."
	^ editor ifNil: [ editor := self newEditor ]! !

!RubAbstractTextArea methodsFor: 'accessing text' stamp: 'AlainPlantec 5/17/2013 11:04'!
font: aFont
	| newTextStyle |
	newTextStyle := aFont textStyle copy ifNil: [ TextStyle fontArray: { aFont } ].
	newTextStyle defaultFontIndex: (newTextStyle fontIndexOf: aFont).
	self textStyle: newTextStyle
! !

!RubAbstractTextArea methodsFor: 'event handling' stamp: 'AlainPlantec 3/26/2013 13:35'!
handlesMouseOver: evt 
	"Do I want to receive mouseEnter: and mouseLeave: when the button is up and the hand is empty?"
	^ self enabled! !

!RubAbstractTextArea methodsFor: 'multi level undo' stamp: 'AlainPlantec 4/3/2013 10:49'!
redoTypeIn: aText interval: anInterval 
	self handleEdit: [self editor redoTypeIn: aText interval: anInterval]! !

!RubAbstractTextArea methodsFor: 'accessing' stamp: 'AlainPlantec 5/14/2013 11:22'!
wrapped
	^ false! !

!RubAbstractTextArea methodsFor: 'public accessing' stamp: 'AlainPlantec 4/16/2013 17:38'!
beEditableWhile: aBlock
	| wasEditable |
	wasEditable := self readOnly.
	self readOnly: false.
	aBlock ensure: [ self readOnly:  wasEditable]
! !

!RubAbstractTextArea methodsFor: 'interactive error protocol' stamp: 'AlainPlantec 3/26/2013 13:35'!
nextTokenFrom: start direction: dir
	^ self editor nextTokenFrom: start direction: dir! !

!RubAbstractTextArea methodsFor: 'accessing segments' stamp: 'AlainPlantec 5/29/2013 22:36'!
segmentsAtLine: aLineNumber
	^ self segments select: [ :s | s firstLineIndex = aLineNumber ]! !

!RubAbstractTextArea methodsFor: 'settings' stamp: 'AlainPlantec 4/3/2013 10:27'!
caseSensitiveFinds
	^ self class caseSensitiveFinds! !

!RubAbstractTextArea methodsFor: 'interactive error protocol' stamp: 'AlainPlantec 5/17/2013 21:23'!
notify: aString at: anInteger in: aStream
	^ self editor notify: aString at: anInteger in: aStream! !

!RubAbstractTextArea methodsFor: 'composing' stamp: 'AlainPlantec 5/7/2013 23:09'!
forceCompose

	self prepareParagraphToCompose.
	self paragraph forceCompose ! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 2/6/2014 11:53'!
handleSelectionChange: aBlock
	| prevMarkBlock prevPointBlock |
	self flag: 'hack here because text segments are not well designed regarding text editing'.
	self primarySelection ifNil: [ self addPrimarySelection  ].
	prevMarkBlock := self markBlock.
	prevPointBlock := self pointBlock.
	aBlock value.
	(prevMarkBlock ~= self markBlock or: [ prevPointBlock ~= self pointBlock ])
		ifTrue: [ 
			"have to invalidate the full surface because of the selection"
			self invalidRect: (self expandFullBoundsForDropShadow: self drawingBounds).
			self scrollPane ifNotNil: [ :sp | sp selectionChanged ].
			self announce: (RubSelectionChanged from: self previousMarkBlock: prevMarkBlock previousPointBlock: prevPointBlock) ] ! !

!RubAbstractTextArea methodsFor: 'accessing editor' stamp: 'AlainPlantec 5/7/2013 16:22'!
releaseEditor
	"Release the editor for my paragraph."

	editor
		ifNotNil: [ 
			editor unplug.
			editor := nil ]! !

!RubAbstractTextArea methodsFor: 'event handling' stamp: 'AlainPlantec 5/21/2014 00:27'!
getMenu: shiftKeyState 
	"Ask the getMenuPolicy to lookup the menu to popup if any"
	^ self getMenuPolicy lookupMenu! !

!RubAbstractTextArea methodsFor: 'find-replace' stamp: 'AlainPlantec 4/3/2013 10:47'!
replaceAll: aRegex with: aText
	self
		handleEdit: [self editor replaceAll: aRegex with: aText].
! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 6/2/2013 15:15'!
editPrimarySelectionSeparately
	| view |
	view := self primarySelection readWriteView.
	(view embeddedInMorphicWindowLabeled: 'Selection editing') openInHand.! !

!RubAbstractTextArea methodsFor: 'drawing' stamp: 'AlainPlantec 5/7/2013 16:40'!
drawingBounds
	^ (self scrollPane isNil or: [ self wrapped ])
		ifTrue: [self innerBounds]
		ifFalse: [ self innerBounds topLeft extent: SmallInteger maxVal @ SmallInteger maxVal ]! !

!RubAbstractTextArea methodsFor: 'menu' stamp: 'AlainPlantec 5/21/2014 00:29'!
lookupMenu
	"default implementation of the algorithm that lookup the menu"

	| default |
	default := [ self editingMode menu ].
	^ self model 
		ifNil: [ default value ] 
		ifNotNil: [ :m | m menu ifNil: [ default value ] ]! !

!RubAbstractTextArea methodsFor: 'accessing' stamp: 'TudorGirba 8/1/2014 21:08'!
notificationStrategy: aStrategy
	self editor notificationStrategy: aStrategy! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 4/22/2013 17:48'!
markBlock: markCharacterBlock pointBlock: pointCharacterBlock
	self handleSelectionChange: [ self editingState markBlock: markCharacterBlock pointBlock: pointCharacterBlock ]! !

!RubAbstractTextArea methodsFor: 'dropping/grabbing' stamp: 'AlainPlantec 4/13/2013 00:09'!
resistsRemoval
	^ self grabbedAllowed not! !

!RubAbstractTextArea methodsFor: 'accessing editing state' stamp: 'AlainPlantec 4/25/2013 18:53'!
scrollPivot
	^self editingState scrollPivot! !

!RubAbstractTextArea methodsFor: 'accessing decorators' stamp: 'AlainPlantec 5/8/2013 09:47'!
withOpeningClosingDelimitersHighlight
	self withDecoratorNamed: #openingClosingDelimitersHighlight! !

!RubAbstractTextArea methodsFor: 'event handling' stamp: 'AlainPlantec 5/17/2013 10:01'!
keyboardFocusChange: aBoolean
	aBoolean
		ifTrue: [
			self hasFocus: true.
			self showOverEditableTextCursor ]
		ifFalse: [ 
			self hasFocus: false.
			self hideOverEditableTextCursor ].
	super keyboardFocusChange: aBoolean.
	self focusChanged.
! !

!RubAbstractTextArea methodsFor: 'dropping/grabbing' stamp: 'AlainPlantec 4/13/2013 00:09'!
aboutToBeGrabbedBy: aHand
	self grabbedAllowed
		ifTrue: [ ^ super aboutToBeGrabbedBy: aHand ].
	^ nil! !

!RubAbstractTextArea methodsFor: 'find-replace' stamp: 'AlainPlantec 3/26/2013 13:35'!
findNextString: aSubString startingAt: searchIdx
	| where |
	self
		handleEdit: [where := self editor findNextString: aSubString startingAt: searchIdx].
	^ where
! !

!RubAbstractTextArea methodsFor: 'accessing decorators' stamp: 'AlainPlantec 4/18/2013 10:45'!
classOfDecoratorNamed: aKey
	^ RubParagraphDecorator classOfDecoratorNamed: aKey! !

!RubAbstractTextArea methodsFor: 'accessing decorators' stamp: 'AlainPlantec 4/24/2013 11:27'!
withoutDecorator: aDecorator
	| n p |
	(self hasDecorator: aDecorator)
		ifFalse: [ ^ self ].
	n := paragraph.
	[ n notNil and: [ n ~= aDecorator ] ]
		whileTrue: [ 
			p := n.
			n := p next ].
	n ifNil: [ ^ self ].
	p ifNil: [ paragraph := aDecorator next ] ifNotNil: [ p next: aDecorator next ].
	aDecorator aboutToBeUnplugged.
	aDecorator next: nil.
	aDecorator unplug.
	self changed! !

!RubAbstractTextArea methodsFor: 'drawing' stamp: 'AlainPlantec 5/31/2013 11:33'!
drawSubmorphsOn: aCanvas
	"Draw the focus here since we are using inset bounds
	for the focus rectangle."

	super drawSubmorphsOn: aCanvas.
	aCanvas rubParagraph: self paragraph bounds: self drawingBounds color: self textColor.
	(scrollPane isNil and: [ self readOnly not and: [ self hasKeyboardFocus or: [ self hasFindReplaceFocus ] ] ])
		ifTrue: [ self drawKeyboardFocusOn: aCanvas ]! !

!RubAbstractTextArea methodsFor: 'editing' stamp: 'AlainPlantec 4/23/2013 12:04'!
handleEdit: editBlock
	"Ensure that changed areas get suitably redrawn"
	editBlock value.
	self selectionChanged.  "Note new selection"
! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 4/22/2013 10:47'!
pointBlock: aCharacterBlock
	self handleSelectionChange: [ self editingState pointBlock: aCharacterBlock ]! !

!RubAbstractTextArea methodsFor: 'drawing' stamp: 'AlainPlantec 2/26/2015 17:01'!
drawSubmorphsOnAthensCanvas: aCanvas
	"Draw the focus here since we are using inset bounds
	for the focus rectangle."

	super drawSubmorphsOn: aCanvas.
	self paragraph drawOnAthensCanvas: aCanvas bounds: self drawingBounds color: self textColor.
	(scrollPane isNil and: [ self readOnly not and: [ self hasKeyboardFocus or: [ self hasFindReplaceFocus ] ] ])
		ifTrue: [ self drawKeyboardFocusOn: aCanvas ]! !

!RubAbstractTextArea methodsFor: 'accessing editing mode' stamp: 'AlainPlantec 5/17/2013 23:40'!
editingMode: anEditingMode
	editingMode unplug.
	editingMode := anEditingMode.
	editingMode plugin: self.
 ! !

!RubAbstractTextArea methodsFor: 'public accessing' stamp: 'AlainPlantec 11/22/2013 09:13'!
setTextWith: stringOrText
	"Accept new text contents."

	self handleParagraphChange: [self privateText: stringOrText]! !

!RubAbstractTextArea methodsFor: 'accessing text' stamp: 'AlainPlantec 3/25/2013 18:23'!
string
	"obtain a string value from the receiver"

	^ self text string! !

!RubAbstractTextArea methodsFor: 'accessing' stamp: 'TudorGirba 5/30/2014 13:29'!
borderWidth: newWidth
	"No border allowed"
	super borderWidth: 0! !

!RubAbstractTextArea methodsFor: 'accessing text' stamp: 'AlainPlantec 8/2/2013 16:54'!
tabWidth
	^ self paragraph tabWidth! !

!RubAbstractTextArea methodsFor: 'accessing decorators' stamp: 'AlainPlantec 4/18/2013 10:49'!
withoutDecoratorNamed: aKey
	(self decoratorNamed: aKey)
		ifNotNil: [ :m | self withoutDecorator: m ].
	self changed! !

!RubAbstractTextArea methodsFor: 'editing' stamp: 'AlainPlantec 2/7/2014 00:23'!
acceptContents
	"The message is sent when the user hits enter or Cmd-S.
	Accept the current contents and endediting"

	self announce: (RubTextAcceptRequest morph: self).
	self changed! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 6/2/2013 13:38'!
newPrimarySelection
	^ RubPrimarySelectionMorph inTextArea: self from: self markIndex to: self pointIndex.
! !

!RubAbstractTextArea methodsFor: 'accessing decorators' stamp: 'AlainPlantec 4/23/2013 19:51'!
withoutSecondarySelection
	self withoutDecoratorNamed: #secondarySelection! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 4/11/2013 10:00'!
pointIndex
	^ self editingState pointIndex! !

!RubAbstractTextArea methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 00:51'!
model 
	^model! !

!RubAbstractTextArea methodsFor: 'private' stamp: 'AlainPlantec 5/17/2013 21:11'!
privateSetParagraph: aParagraph
	paragraph := aParagraph! !

!RubAbstractTextArea methodsFor: 'accessing cursor' stamp: 'AlainPlantec 2/6/2014 14:37'!
newCursor
	^ self cursorClass new! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 4/19/2013 11:40'!
pointBlock
	^ self editingState pointBlock! !

!RubAbstractTextArea methodsFor: 'paragraph feedbacks' stamp: 'AlainPlantec 4/26/2013 15:19'!
updateBottomFromParagraph
	paragraph
		ifNotNil: [ 
			| newExtent |
			newExtent := self paragraph extent max: self paragraph minimumExtent.
			self forceExtentTo: self extent x @ newExtent y]! !

!RubAbstractTextArea methodsFor: 'dropping/grabbing' stamp: 'AlainPlantec 5/7/2013 16:41'!
grabbedAllowed
	^ scrollPane isNil! !

!RubAbstractTextArea methodsFor: 'event handling' stamp: 'AlainPlantec 6/2/2013 23:18'!
mouseDown: evt
	"Make this TextMorph be the keyboard input focus, if it isn't  
	already, and repond to the text selection gesture.
	Changed to not take keyboard focus if an owner is a
	PluggableTextMorph that doesn't want focus."

	(evt yellowButtonPressed and: [ evt commandKeyPressed not ]) "First check for option (menu) click"
		ifTrue: [ ^ (self yellowButtonActivity: evt shiftPressed) ].

	(self paragraph click: evt for: self model controller: self)
		ifTrue: [ 
			self click: evt.
			evt hand releaseKeyboardFocus: self.
			^ self ].
	(evt yellowButtonChanged or: [ evt commandKeyPressed ])
		ifTrue: [ 
			(self yellowButtonActivity: evt shiftPressed)
				ifTrue: [ ^ self ] ].
	"no matter what, if shift is pressed extend the selection"
	evt shiftPressed
		ifTrue: [ ^ self mouseMove: evt ].

	(self hasFocus or: [ self editor hasSelection not ])
		ifTrue: [ 
			| selectors |
			self scrollPivot: evt hand position.
			selectors := Array
				with: #click:
				with: #doubleClick:
				with: nil
				with: nil.
			evt hand
				waitForClicksOrDrag: self
				event: evt
				selectors: selectors
				threshold: 5 ].
	self hasKeyboardFocus
		ifFalse: [ self takeKeyboardFocus ]! !

!RubAbstractTextArea methodsFor: 'private' stamp: 'AlainPlantec 4/24/2013 11:30'!
releaseParagraph
	paragraph
		ifNotNil: [ 
			self withoutAnyDecorator.
			paragraph unplug.
			paragraph := nil ].
! !

!RubAbstractTextArea methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 16:42'!
scrollPane: aScrollPane
	scrollPane := aScrollPane.
	self color: Color transparent! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 4/4/2013 10:29'!
selectionStart
	^ self editingState selectionStart! !

!RubAbstractTextArea methodsFor: 'geometry' stamp: 'AlainPlantec 4/26/2013 16:15'!
bounds
	^ super bounds ifNil: [ self defaultBounds ]! !

!RubAbstractTextArea methodsFor: 'testing' stamp: 'AlainPlantec 3/26/2013 13:43'!
canChangeText
	^ self enabled and: [ self readOnly not ]! !

!RubAbstractTextArea methodsFor: 'accessing decorators' stamp: 'AlainPlantec 4/18/2013 10:46'!
hasDecoratorNamed: aKey
	^ self paragraph hasDecoratorNamed: aKey
	! !

!RubAbstractTextArea methodsFor: 'multi level undo' stamp: 'AlainPlantec 4/3/2013 10:49'!
undoRedoExchange: aninterval with: anotherInterval
	self handleEdit: [self editor undoRedoExchange: aninterval with: anotherInterval]! !

!RubAbstractTextArea methodsFor: 'multi level undo' stamp: 'AlainPlantec 4/3/2013 10:49'!
undoTypeIn: aText interval: anInterval 
	self handleEdit: [self editor undoTypeIn: aText interval: anInterval]! !

!RubAbstractTextArea methodsFor: 'accessing decorators' stamp: 'AlainPlantec 4/18/2013 10:45'!
decoratorNamed: aKey
	^self paragraph decoratorNamed: aKey! !

!RubAbstractTextArea methodsFor: 'event handling' stamp: 'AlainPlantec 3/26/2013 12:06'!
handlesMouseDown: evt
	^ self innerBounds containsPoint: evt cursorPoint! !

!RubAbstractTextArea methodsFor: 'defaults' stamp: 'AlainPlantec 4/24/2013 13:56'!
defaultMargins
	^ 6 @ 6 corner: 6 @ 6! !

!RubAbstractTextArea methodsFor: 'accessing' stamp: 'AlainPlantec 4/15/2013 17:29'!
lineNumbersBackgroundColor
	^ self class lineNumbersBackgroundColor! !

!RubAbstractTextArea methodsFor: 'defaults' stamp: 'AlainPlantec 3/25/2013 23:19'!
defaultBounds 
	^ super defaultBounds topLeft corner: self minimumExtent! !

!RubAbstractTextArea methodsFor: 'accessing' stamp: 'AlainPlantec 2/6/2014 14:42'!
margins: aRectangle
	margins := aRectangle withRight: (aRectangle right max: self cursorWidth ).
! !

!RubAbstractTextArea methodsFor: 'accessing editor' stamp: 'AlainPlantec 5/8/2013 09:46'!
closingDelimiters
	^ self editor closingDelimiters
! !

!RubAbstractTextArea methodsFor: 'event handling' stamp: 'AlainPlantec 5/7/2013 16:41'!
scrollSelectionIntoView: evt 
	scrollPane ifNotNil: [ scrollPane scrollSelectionIntoView: evt ]	
! !

!RubAbstractTextArea methodsFor: 'find-replace' stamp: 'AlainPlantec 5/7/2013 10:51'!
findText
	^ self editor findText! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 4/2/2013 23:52'!
selectInvisiblyFrom: start to: stop
	self editor selectInvisiblyFrom: start to: stop! !

!RubAbstractTextArea methodsFor: 'copying' stamp: 'AlainPlantec 4/23/2013 21:21'!
veryDeepInner: deepCopier 
	"Copy all of my instance variables. Some need to be not copied at all, but shared.
	Warning!!!! Every instance variable defined in this class must be handled.
	We must also implement veryDeepFixupWith:.  See DeepCopier class comment."

	super veryDeepInner: deepCopier.
	textStyle := textStyle veryDeepCopyWith: deepCopier.
	paragraph := paragraph veryDeepCopyWith: deepCopier.
	textColor := textColor veryDeepCopyWith: deepCopier.
	editor := editor veryDeepCopyWith: deepCopier.
! !

!RubAbstractTextArea methodsFor: 'event handling' stamp: 'AlainPlantec 3/26/2013 13:35'!
wouldAcceptKeyboardFocusUponTab
	"Answer whether the receiver might accept keyboard focus if 
	tab were hit in some container playfield"
	^ true! !

!RubAbstractTextArea methodsFor: 'composing' stamp: 'AlainPlantec 5/7/2013 16:41'!
compositionRectangle
	^ scrollPane ifNil: [ self innerBounds ] ifNotNil: [ self innerBounds topLeft extent: scrollPane scrollBounds extent ]! !

!RubAbstractTextArea methodsFor: 'accessing editing mode' stamp: 'AlainPlantec 5/17/2013 22:29'!
editingMode
	^ editingMode
		ifNil: [ 
			self editingMode: RubPlainTextMode new.
			editingMode ]! !

!RubAbstractTextArea methodsFor: 'paragraph feedbacks' stamp: 'AlainPlantec 4/26/2013 16:13'!
forceExtentTo: aPoint
	super extent: aPoint! !

!RubAbstractTextArea methodsFor: 'private' stamp: 'AlainPlantec 5/17/2013 23:09'!
paragraph
	"Paragraph instantiation is lazy -- create it only when needed"

	paragraph
		ifNil: [
			paragraph := self newParagraph.
			self compose.
			self selectAll].
	^ paragraph ! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 4/4/2013 10:30'!
selectionStop
	^ self editingState selectionStop! !

!RubAbstractTextArea methodsFor: 'event handling' stamp: 'AlainPlantec 4/24/2013 13:54'!
yellowButtonActivity: shiftKeyState 
	"Invoke the text-editing menu.
	Check if required first!!"
	self wantsYellowButtonMenu
		ifFalse: [ ^ false ].	
	(self getMenu: shiftKeyState)
		ifNotNilDo: [ :menu|
			menu setInvokingView: self editor.
			menu invokeModal. 
			self changed.
			^ true].
		
	^ true! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 4/3/2013 10:53'!
useFindReplaceSelection
	^ self class  useFindReplaceSelection! !

!RubAbstractTextArea methodsFor: 'geometry' stamp: 'AlainPlantec 4/26/2013 15:26'!
minimumExtent
	^ self minExtent! !

!RubAbstractTextArea methodsFor: 'editing' stamp: 'AlainPlantec 11/25/2013 08:15'!
privateReplaceFrom: start to: stop with: aText
	self paragraph replaceFrom: start to: stop with: aText.
! !

!RubAbstractTextArea methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 16:41'!
scrollPane
	^ scrollPane! !

!RubAbstractTextArea methodsFor: 'private' stamp: 'AlainPlantec 4/25/2013 17:29'!
unplug
	self unplugFindReplace.
	self releaseEditingState.
	self releaseParagraph.
	self releaseEditor.
	super unplug
	! !

!RubAbstractTextArea methodsFor: 'public accessing' stamp: 'AlainPlantec 3/26/2013 12:03'!
forbidMenu
	self menuAllowed: false! !

!RubAbstractTextArea methodsFor: 'accessing text' stamp: 'AlainPlantec 11/25/2013 10:18'!
textColor
	^ textColor ifNil: [ textColor := self defaultTextColor ]! !

!RubAbstractTextArea methodsFor: 'menu' stamp: 'AlainPlantec 4/24/2013 13:48'!
wantsYellowButtonMenu
	^ self menuAllowed ! !

!RubAbstractTextArea methodsFor: 'public accessing' stamp: 'AlainPlantec 5/14/2013 12:43'!
beReadOnly
	self readOnly
		ifFalse: [ self readOnly: true ]! !

!RubAbstractTextArea methodsFor: 'editing' stamp: 'AlainPlantec 8/2/2013 14:59'!
cancelEdits
	"The message is sent when the user hits enter or Cmd-L.
	Cancel the current contents and end editing.
	This default implementation does nothing."
	self announce: (RubCanceEditRequested morph: self)! !

!RubAbstractTextArea methodsFor: 'accessing editing state' stamp: 'AlainPlantec 4/25/2013 21:35'!
emphasisHere
	^ self editingState emphasisHere
! !

!RubAbstractTextArea methodsFor: 'accessing text' stamp: 'AlainPlantec 11/22/2013 09:29'!
updateTextWith: aStringOrText
	self
		handleEdit: [ 
			self
				beEditableWhile: [ 
					aStringOrText = self text
						ifFalse: [ 
							self selectAll.							
							self editor replaceSelectionWith: aStringOrText.
							self deselect ] ] ]! !

!RubAbstractTextArea methodsFor: 'accessing text' stamp: 'AlainPlantec 2/5/2014 10:11'!
textColor: newColor
	textColor = newColor ifTrue: [^ self].
	textColor := newColor.
	self addAttribute: (TextColor color: newColor).
	self changed.! !

!RubAbstractTextArea methodsFor: 'accessing segments' stamp: 'AlainPlantec 3/16/2014 22:52'!
removeSegment: aRubTextSegmentMorph
	self announcer unsubscribe: aRubTextSegmentMorph.
	self segments remove: aRubTextSegmentMorph ifAbsent: [].
! !

!RubAbstractTextArea methodsFor: 'accessing decorators' stamp: 'AlainPlantec 4/18/2013 10:48'!
withDecoratorNamed: aKey
	(self hasDecoratorNamed: aKey)
		ifTrue: [ ^ self ].
	(self classOfDecoratorNamed: aKey)
		ifNotNil: [ :cls | self withDecorator: cls new ]! !

!RubAbstractTextArea methodsFor: 'defaults' stamp: 'AlainPlantec 3/26/2013 15:10'!
defaultReadOnly

	^ false! !

!RubAbstractTextArea methodsFor: 'accessing' stamp: 'AlainPlantec 3/26/2013 12:02'!
menuAllowed
	^ menuAllowed ifNil: [ menuAllowed := self defaultMenuAllowed  ]! !

!RubAbstractTextArea methodsFor: 'accessing text' stamp: 'AlainPlantec 8/2/2013 16:54'!
tabWidth: anInteger
	self paragraph tabWidth: anInteger! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 4/4/2013 10:31'!
stopIndex
	^ self selectionStop stringIndex! !

!RubAbstractTextArea methodsFor: 'mock for spec' stamp: 'AlainPlantec 5/16/2013 12:18'!
enabled: aBoolean! !

!RubAbstractTextArea methodsFor: 'event handling' stamp: 'AlainPlantec 5/7/2013 23:06'!
mouseMove: evt
	evt redButtonPressed
		ifTrue: [ 
			self pointBlock: (self paragraph characterBlockAtPoint: evt cursorPoint).
			self editor storeSelectionInText ].
! !

!RubAbstractTextArea methodsFor: 'accessing decorators' stamp: 'AlainPlantec 4/23/2013 19:50'!
withoutFindReplaceSelection
	self withoutDecoratorNamed: #findReplaceSelection! !

!RubAbstractTextArea methodsFor: 'defaults' stamp: 'AlainPlantec 4/2/2013 09:31'!
defaultTextColor
	"answer the default color/fill style for the receiver"
	^ self class textColor! !

!RubAbstractTextArea methodsFor: 'copying' stamp: 'AlainPlantec 4/23/2013 21:21'!
copy
	^ super copy
		text: self text copy
		textStyle: textStyle copy
		color: color
		textColor: textColor ! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 4/2/2013 23:53'!
selectionInterval
	^self editor selectionInterval ! !

!RubAbstractTextArea methodsFor: 'defaults' stamp: 'AlainPlantec 3/26/2013 12:13'!
defaultYellowButtonMenuEnabled
	^ self defaultMenuAllowed ! !

!RubAbstractTextArea methodsFor: 'accessing editing state' stamp: 'AlainPlantec 4/19/2013 12:40'!
releaseEditingState
	editingState ifNotNil: [ 
		editingState unplug.
		editingState := nil]! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 3/26/2013 15:30'!
hasSelection
	^ self editor hasSelection ! !

!RubAbstractTextArea methodsFor: 'event handling' stamp: 'AlainPlantec 5/14/2013 11:33'!
focusChanged 
	super focusChanged.
	self editor focusChanged.
	self changed.

	
! !

!RubAbstractTextArea methodsFor: 'paragraph feedbacks' stamp: 'AlainPlantec 2/6/2014 13:17'!
paragraphReplacedTextFrom: start to: stop with: aText
	"A text change has taken place in my paragraph, as a result of editing and I must be updated"
	self
		handleBoundsChange: [ 
			self wrapped
				ifTrue: [ self updateBottomFromParagraph ]
				ifFalse: [ self updateExtentFromParagraph ] ].
	self scrollPane ifNotNil: [ :sp | sp textChanged ].
	self announce: (RubTextChanged from: start to: stop with: aText).
! !

!RubAbstractTextArea methodsFor: 'event handling' stamp: 'AlainPlantec 3/27/2013 21:26'!
handleKeystroke: anEvent 
	"System level event handling."

	anEvent wasHandled
		ifTrue: [^ self].
	self allowsKeymapping
		ifTrue: [ self dispatchKeystrokeForEvent: anEvent ] .
	anEvent wasHandled
		ifTrue: [
			"We need to check for completion here because otherwise it will try to handle the keystroke, 
			even if it was already processed."
			(Smalltalk tools hasToolNamed: #codeCompletion) 
				ifTrue: [ Smalltalk tools codeCompletion uniqueInstance closeMenu ].
			^ self].
	(self handlesKeyStroke: anEvent)
		ifFalse: [^ self].
	self keyStroke: anEvent.
	anEvent wasHandled: true.! !

!RubAbstractTextArea methodsFor: 'private' stamp: 'AlainPlantec 6/2/2013 14:42'!
newParagraph
	| newParagraph |
	newParagraph := RubOpeningClosingDelimiterDecorator next: RubParagraph new.
	newParagraph textArea: self.
	newParagraph container: self compositionRectangle.
	^ newParagraph! !

!RubAbstractTextArea methodsFor: 'find-replace' stamp: 'AlainPlantec 3/26/2013 13:35'!
replaceAll: aRegex with: aText startingAt: startIdx
	self
		handleEdit: [self editor replaceAll: aRegex with: aText startingAt: startIdx].
! !

!RubAbstractTextArea methodsFor: 'event handling' stamp: 'AlainPlantec 3/26/2013 13:35'!
mouseLeave: evt
	"Handle a mouseLeave event, meaning the mouse just left my bounds with no button pressed."
	super mouseLeave: evt.
	self hideOverEditableTextCursor
	! !

!RubAbstractTextArea methodsFor: 'accessing selection' stamp: 'AlainPlantec 4/4/2013 10:29'!
startIndex
	^ self selectionStart stringIndex! !

!RubAbstractTextArea class methodsFor: 'settings' stamp: 'AlainPlantec 4/2/2013 08:46'!
lineNumbersFont
	^ LineNumbersFont ifNil: [ LineNumbersFont := TextStyle default fontOfPointSize: 7] ! !

!RubAbstractTextArea class methodsFor: 'settings' stamp: 'AlainPlantec 4/3/2013 10:21'!
textColor
	^ DefaultTextColor ifNil: [ DefaultTextColor := Color black]  ! !

!RubAbstractTextArea class methodsFor: 'settings' stamp: 'AlainPlantec 4/2/2013 09:18'!
lineNumbersBackgroundColor: aColor
	 LineNumbersBackgroundColor := aColor! !

!RubAbstractTextArea class methodsFor: 'settings' stamp: 'AlainPlantec 4/15/2013 17:37'!
lineNumbersTextColor: aColor
	LineNumbersTextColor := aColor! !

!RubAbstractTextArea class methodsFor: 'settings' stamp: 'AlainPlantec 4/2/2013 09:17'!
lineNumbersBackgroundColor
	^ LineNumbersBackgroundColor ifNil: [ LineNumbersBackgroundColor := Color lightGray veryMuchLighter] ! !

!RubAbstractTextArea class methodsFor: 'settings' stamp: 'AlainPlantec 4/2/2013 09:21'!
backgroundColor
	^ BackgroundColor ifNil: [ BackgroundColor := Color white] ! !

!RubAbstractTextArea class methodsFor: 'settings' stamp: 'AlainPlantec 4/2/2013 10:09'!
textColor: aColor
	DefaultTextColor := aColor! !

!RubAbstractTextArea class methodsFor: 'settings' stamp: 'AlainPlantec 4/15/2013 17:37'!
lineNumbersTextColor
	^ LineNumbersTextColor ifNil: [ LineNumbersTextColor := Color gray muchDarker] ! !

!RubAbstractTextArea class methodsFor: 'settings' stamp: 'AlainPlantec 4/3/2013 10:21'!
useSelectionBar: aBoolean
	UseSelectionBar := aBoolean! !

!RubAbstractTextArea class methodsFor: 'settings' stamp: 'AlainPlantec 4/3/2013 10:22'!
useSecondarySelection
	^ UseSecondarySelection ifNil: [UseSecondarySelection := true] ! !

!RubAbstractTextArea class methodsFor: 'settings' stamp: 'AlainPlantec 4/2/2013 09:21'!
backgroundColor: aColor
	BackgroundColor := aColor! !

!RubAbstractTextArea class methodsFor: 'settings' stamp: 'AlainPlantec 4/3/2013 10:21'!
caseSensitiveFinds
	^ CaseSensitiveFinds ifNil: [CaseSensitiveFinds := false] ! !

!RubAbstractTextArea class methodsFor: 'settings' stamp: 'AlainPlantec 4/2/2013 09:28'!
backgroundUpdatingForBigText
	^ BackgroundUpdating ifNil: [BackgroundUpdating := false] ! !

!RubAbstractTextArea class methodsFor: 'settings' stamp: 'AlainPlantec 3/31/2013 23:39'!
lineNumbersFont: aFont
	LineNumbersFont := aFont! !

!RubAbstractTextArea class methodsFor: 'settings' stamp: 'StephaneDucasse 11/11/2014 18:48'!
rubricSettingsOn: aBuilder
	<systemsettings>
	(aBuilder group: #Rubric)
		label: 'Rubric editor';
		with: [ 
					(aBuilder setting: #editorFont)
						target: self;
						description: 'The default editor font';
						label: 'Font'.
					(aBuilder setting: #backgroundColor)
						target: self;
						description: 'The default editor background color';
						label: 'Background'.
					(aBuilder setting: #textColor)
						target: self;
						description: 'The default editor text color';
						label: 'Text color'.
					(aBuilder group: #LineNumbers)
						target: self;
						label: 'Line numbers';
						description: 'line numbers settings';
						with: [ 
									(aBuilder setting: #lineNumbersFont)
										target: self;
										description: 'Font used for line numbers' ;
										label: 'Line numbers font'.
									(aBuilder setting: #lineNumbersTextColor)
										target: self;
										description: 'Color used for line numbers';
										label: 'Line numbers color'.
									(aBuilder setting: #lineNumbersBackgroundColor)
										target: self;
										description: 'Color used for line numbers background';
										label: 'Line numbers background color' ] ]! !

!RubAbstractTextArea class methodsFor: 'settings' stamp: 'AlainPlantec 4/3/2013 10:22'!
walkAlongDisplayedLine
	^ WalkAlongDisplayedLine ifNil: [WalkAlongDisplayedLine := true] ! !

!RubAbstractTextArea class methodsFor: 'settings' stamp: 'AlainPlantec 4/3/2013 10:20'!
useFindReplaceSelection: aBoolean
	UseFindReplaceSelection := aBoolean! !

!RubAbstractTextArea class methodsFor: 'settings' stamp: 'AlainPlantec 4/3/2013 10:21'!
walkAlongDisplayedLine: aBoolean
	WalkAlongDisplayedLine := aBoolean! !

!RubAbstractTextArea class methodsFor: 'settings' stamp: 'AlainPlantec 3/22/2013 21:06'!
editorFont
	^ EditorFont ifNil: [ EditorFont := StandardFonts codeFont]! !

!RubAbstractTextArea class methodsFor: 'settings' stamp: 'AlainPlantec 4/3/2013 10:21'!
useFindReplaceSelection
	^ UseFindReplaceSelection ifNil: [UseFindReplaceSelection := true] ! !

!RubAbstractTextArea class methodsFor: 'settings' stamp: 'AlainPlantec 4/3/2013 10:20'!
caseSensitiveFinds: aBoolean
	CaseSensitiveFinds := aBoolean! !

!RubAbstractTextArea class methodsFor: 'settings' stamp: 'AlainPlantec 4/3/2013 10:20'!
useSecondarySelection: aBoolean
	UseSecondarySelection := aBoolean! !

!RubAbstractTextArea class methodsFor: 'settings' stamp: 'AlainPlantec 4/2/2013 09:23'!
backgroundUpdatingForBigText: aBoolean
	BackgroundUpdating := aBoolean! !

!RubAbstractTextArea class methodsFor: 'shortcut examples' stamp: 'AlainPlantec 3/28/2013 21:36'!
examplesOfSmalltalkEditorShortcutsOn: aBuilder
	"No Keymap here, by default, the editor rely on a builtin keymapping engine (see TextEditor and SmallEditor)
	Here are some example on how to declare them if you want to setup different shortcuts

	<keymap>
	(aBuilder shortcut: #browseIt)
		category: #RubSmalltalkEditor
		default: $b command mac | $b ctrl win | $b ctrl unix
		do: [ :morph | morph editor browseIt ].
					
	(aBuilder shortcut: #doIt) 
		category: #RubSmalltalkEditor
		default: $d command mac | $d ctrl win | $d ctrl unix
		do: [ :morph | morph doIt ].
			
	(aBuilder shortcut: #inspectIt) 
		category: #RubSmalltalkEditor
		default: $i command mac | $i ctrl win | $i ctrl unix
		do: [ :morph | morph inspectIt ].
		
	(aBuilder shortcut: #implementorsOfIt) 
		category: #RubSmalltalkEditor
		default: $m command mac | $m ctrl win | $m ctrl unix
		do: [ :morph | morph implementorsOfIt ].
		
	(aBuilder shortcut: #sendersOfIt)
		category: #RubSmalltalkEditor
		default: $n command mac | $n ctrl win | $n ctrl unix
		do: [ :morph | morph sendersOfIt ].
		
	(aBuilder shortcut: #printIt) 
		category: #RubSmalltalkEditor
		default: $p command mac | $p ctrl win | $p ctrl unix
		do: [ :morph | morph printIt ].
		"! !

!RubAbstractTextArea class methodsFor: 'settings' stamp: 'AlainPlantec 4/3/2013 10:22'!
useSelectionBar
	^ UseSelectionBar ifNil: [UseSelectionBar := true] ! !

!RubAbstractTextArea class methodsFor: 'shortcut examples' stamp: 'AlainPlantec 3/28/2013 21:36'!
examplesOfEditorShortcutsOn: aBuilder
	"No Keymap here, by default, the editor rely on a builtin keymapping engine (see TextEditor and SmallEditor)
	Here are some example on how to declare them if you want to setup different shortcuts
	
	<keymap>

	(aBuilder shortcut: #accept)
		category: #RubTextEditor
		default: $s ctrl win | $s ctrl unix | $s command mac
		do: [ :morph | morph acceptContents ]. 
		
	(aBuilder shortcut: #selectAll) 
		category: #RubTextEditor
		shortcut: $a ctrl win | $a ctrl unix | $a command mac
		do: [ :target | target handleKeymapEdition: [:editor | editor selectAll ] ].

	(aBuilder shortcut: #copySelection) 
		category: #RubTextEditor
		default: $c ctrl win | $c ctrl unix | $c command mac
		do: [ :target | target editor copySelection ].
		
	(aBuilder shortcut: #paste) 
		category: #RubTextEditor
		default: $v ctrl win | $v ctrl unix | $v command mac
		do: [ :target | target handleKeymapEdition: [:editor | editor paste]].
		
	(aBuilder shortcut: #cut) 
		category: #RubTextEditor
		default: $x ctrl win | $x ctrl unix | $x command mac
		do: [ :target :event | target handleKeymapEdition: [:editor | editor cut]  ].
				
	(aBuilder shortcut: #find) 
		category: #RubTextEditor
		default: $f ctrl win | $f ctrl unix | $f command mac
		do: [ :target | target find ].
		
	(aBuilder shortcut: #findAgain) 
		category: #RubTextEditor
		default: $g ctrl win | $g ctrl unix | $g command mac
		do: [ :target | target handleKeymapEdition: [:editor | editor findAgain ] ].
		
	(aBuilder shortcut: #exchange) 
		category: #RubTextEditor
		default: $e ctrl win | $e ctrl unix | $e command mac
		do: [ :target | target handleKeymapEdition: [:editor | editor exchange ] ].
		
	(aBuilder shortcut: #backWord)  
		category: #RubTextEditor
		default: $w ctrl win | $w ctrl unix | $w command mac
		do: [ :target |  target handleKeymapEdition: [:editor | editor backWord ] ].
		
	(aBuilder shortcut: #backWord) 
		category: #RubTextEditor
		default: Character backspace  asShortcut win | Character backspace asShortcut unix | Character backspace asShortcut mac
		do: [ :target :morph :event |  target handleKeymapEdition: [:editor | editor backspace: event ] ].
		
	(aBuilder shortcut: #(swapChars)) 
		category: #RubTextEditor
		default: $y ctrl win | $y ctrl unix | $y command mac
		do: [ :target |  target handleKeymapEdition: [:editor | editor swapChars ] ].

	(aBuilder shortcut: #setSearchString)
		category: #RubTextEditor
		default: $h ctrl win | $h ctrl unix | $h command mac
		do: [ :target | target editor setSearchString ].
		
	(aBuilder shortcut: #cancel) 
		category: #RubTextEditor
		default: $l ctrl win | $l ctrl unix | $l command mac
		do: [ :target | target editor cancel ].
		
	(aBuilder shortcut: #undo) 
		category: #RubTextEditor
		default: $z ctrl win | $z ctrl unix | $z command mac
		do: [ :target | target editor undo ].
		
	(aBuilder shortcut: #redo) 
		category: #RubTextEditor
		default: $j ctrl shift win | $j ctrl shift unix | $j command shift mac
		do: [ :target | target editor redo ].
	
	(aBuilder shortcut: #cursorHome)
		category: #RubTextEditor
		default: Character home ctrl win | Character home ctrl unix | Character home command mac
		do: [ :target :morph :event | target editor cursorHome: event ].
	
	(aBuilder shortcut: #cursorEnd)
		category: #RubTextEditor
		default: Character end ctrl win | Character end ctrl unix | Character end command mac
		do: [ :target :morph :event | target editor cursorEnd: event ].

	(aBuilder shortcut: #cursorHome)
		category: #RubTextEditor
		default: Character home asShortcut win | Character home asShortcut unix | Character home asShortcut mac
		do: [ :target :morph :event | target editor cursorHome: event ].
	
	(aBuilder shortcut: #cursorEnd)
		category: #RubTextEditor
		default: Character end asShortcut win | Character end asShortcut unix | Character end asShortcut mac
		do: [ :target :morph :event | target editor cursorEnd: event ].
	"! !

!RubAbstractTextArea class methodsFor: 'settings' stamp: 'AlainPlantec 3/22/2013 21:06'!
editorFont: aFont
	EditorFont := aFont! !

!RubAdornmentDisplayer commentStamp: '<historical>'!
RubAdornmentDisplayer adds a simple !
!RubAdornmentDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 5/15/2013 01:47'!
computedSize
	^  25! !

!RubAdornmentDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 5/15/2013 01:46'!
computedWidthFrom: aRectangle
	^  (super computedWidthFrom: aRectangle) min: self computedSize
! !

!RubAdornmentDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 4/22/2013 22:48'!
level
	^ SmallInteger maxVal ! !

!RubAdornmentDisplayer methodsFor: 'drawing' stamp: 'AlainPlantec 2/6/2014 13:52'!
drawOn: aCanvas
	| bnds adorncolor size fillStyle |
	super drawOn: aCanvas.
	self paragraphProvider hasUnacceptedEdits ifFalse: [ ^self ].
	bnds := self bounds.
	adorncolor := self paragraphProvider adornmentColor.
	size := self width.
	fillStyle := (GradientFillStyle ramp: {
			0.0->(Color white alpha: 0.3).
			0.8->adorncolor.
			1.0->adorncolor})
		origin: bnds topRight - (size@0);
		direction: (size @ size negated) // 4;
		radial: false.
	aCanvas
		drawPolygon:  {bnds topRight. bnds topRight + (0@size). bnds topRight - (size@0)}
		fillStyle: fillStyle! !

!RubAdornmentDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 4/23/2013 00:42'!
computedPositionFrom: aRectangle
	^  ((aRectangle right min: self scrollBounds right) - (self computedWidthFrom: aRectangle)) @ aRectangle top
! !

!RubAdornmentDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 5/15/2013 01:45'!
computedHeightFrom: aRectangle

	^ aRectangle height min: self computedSize! !

!RubAdornmentDisplayer class methodsFor: 'querying' stamp: 'AlainPlantec 4/22/2013 22:24'!
key
	^ #adornment! !

!RubAnnotationDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 5/17/2013 12:02'!
textColor
	^ self textArea lineNumbersTextColor muchDarker
! !

!RubAnnotationDisplayer methodsFor: 'submorphs-accessing' stamp: 'AlainPlantec 5/19/2013 00:13'!
changeColumnDisplay
	self paragraphProvider columnRuler
		ifNil: [ self paragraphProvider withColumns ]
		ifNotNil: [ self paragraphProvider withoutColumns ].
	self textArea changed.
	self updateContents! !

!RubAnnotationDisplayer methodsFor: 'event handling' stamp: 'AlainPlantec 5/18/2013 16:51'!
textOfCharBlock: aCharacterBlock
	| t l c |
	l := aCharacterBlock textLine.
	c := aCharacterBlock stringIndex - l first + 1.
	t := l lineNumber printString , '/' , self lines size printString
		, ' [', c printString.
	self paragraphProvider annotationRuler
		ifNotNil: [ :r | 
			| tabIdx |
			tabIdx := ((aCharacterBlock left + 1) // self paragraph tabWidth) + 1.
			t := t , ':' , tabIdx printString ].
	t := t, ']'.
	^ t! !

!RubAnnotationDisplayer methodsFor: 'submorphs-accessing' stamp: 'AlainPlantec 5/20/2013 00:11'!
lineNumbersDisplayLabel
	^ self paragraphProvider lineNumbersRuler  
		ifNil: [ '+L' ]
		ifNotNil: [ 'L' ]! !

!RubAnnotationDisplayer methodsFor: 'submorphs-accessing' stamp: 'AlainPlantec 5/18/2013 23:49'!
chosenTabWidth: anInteger
	self paragraph tabWidth: anInteger.
	self updateContents! !

!RubAnnotationDisplayer methodsFor: 'geometry' stamp: 'AlainPlantec 3/17/2014 13:30'!
computedHeightFrom: aRectangle
	^ row ifNil: [0] ifNotNil: [row height]! !

!RubAnnotationDisplayer methodsFor: 'submorphs-accessing' stamp: 'AlainPlantec 5/19/2013 00:26'!
changeLineNumbersDisplay
	self paragraphProvider lineNumbersRuler 
		ifNil: [ self paragraphProvider withLineNumbers ]
		ifNotNil: [ self paragraphProvider withoutLineNumbers ].
	self paragraphProvider manageLayout.
	self updateContents! !

!RubAnnotationDisplayer methodsFor: 'submorphs-accessing' stamp: 'AlainPlantec 5/18/2013 23:55'!
tabWidthLabelMorph
	^ StringMorph
		contents: self tabWidthLabel
		font: self fontToUse! !

!RubAnnotationDisplayer methodsFor: 'submorphs-accessing' stamp: 'AlainPlantec 3/17/2014 12:10'!
chooseEditingMode: anEvent
	self modeListMenu invokeAt: anEvent position in: self world.
	self updateContents! !

!RubAnnotationDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 5/19/2013 23:05'!
level
	^ 1! !

!RubAnnotationDisplayer methodsFor: 'submorphs-accessing' stamp: 'AlainPlantec 5/17/2013 12:24'!
wrappingPolicyLabel
	^ self paragraphProvider wrapped
				ifTrue: [ 'W' ]
				ifFalse: [ 'NW' ]! !

!RubAnnotationDisplayer methodsFor: 'geometry' stamp: 'AlainPlantec 5/17/2013 11:36'!
manageLayoutInBounds: aRectangle
	| ret |
	ret := super manageLayoutInBounds: aRectangle.
	self updateContents.
	^ ret! !

!RubAnnotationDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 5/17/2013 11:00'!
backgroundColor
	^ self paragraphProvider backgroundColor darker! !

!RubAnnotationDisplayer methodsFor: 'initialize-release' stamp: 'AlainPlantec 5/17/2013 11:22'!
initialize
	super initialize.
	self side: #bottom.
! !

!RubAnnotationDisplayer methodsFor: 'submorphs-accessing' stamp: 'AlainPlantec 5/18/2013 23:47'!
chooseTabWidth: anEvent
	self tabWidthMenu invokeAt: anEvent position in: self world! !

!RubAnnotationDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 5/18/2013 23:53'!
tabWidth
	^ self paragraph tabWidth! !

!RubAnnotationDisplayer methodsFor: 'submorphs-accessing' stamp: 'AlainPlantec 5/18/2013 23:34'!
editingModeLabelMorph
	^ StringMorph
		contents: self editingModeLabel
		font: self fontToUse! !

!RubAnnotationDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 5/18/2013 23:34'!
editingModeLabel
	^ self paragraphProvider editingMode label! !

!RubAnnotationDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 5/18/2013 23:46'!
tabWidthMenu
	"Answer the menu to be presented to select a tab width"

	^ (PragmaMenuBuilder pragmaKeyword: #RubTabWidthMenu model: self) menu! !

!RubAnnotationDisplayer methodsFor: 'submorphs-accessing' stamp: 'AlainPlantec 5/17/2013 12:23'!
wrappingPolicyLabelMorph
	^ StringMorph
		contents: self wrappingPolicyLabel
		font: self fontToUse! !

!RubAnnotationDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 5/17/2013 19:03'!
modeListMenu
	"Answer the menu to be presented to select an editing mode"

	^ (PragmaMenuBuilder pragmaKeyword: #RubEditingModeMenu model: self) menu! !

!RubAnnotationDisplayer methodsFor: 'submorphs-accessing' stamp: 'AlainPlantec 5/19/2013 00:23'!
noteNewOwner: aMorph
	super noteNewOwner: aMorph.
	self color: self backgroundColor.
	lineAnnotation := RubTextFieldArea new.
	lineAnnotation withoutAnyDecorator.
	lineAnnotation backgroundColor: Color transparent.
	lineAnnotation font: self fontToUse.
	lineAnnotation beReadOnly.
	lineAnnotation textColor: self textColor.
	wrappingPolicyMorph := self wrappingPolicyLabelMorph.
	editingModeMorph := self editingModeLabelMorph.
	tabWidthMorph := self tabWidthLabelMorph.
	columnDisplayMorph := self columnDisplayLabelMorph.
	lineNumbersDisplayMorph := self lineNumbersDisplayLabelMorph.
	row := self theme
		newRowIn: self
		for:
			{(self spacer: 2).
			lineAnnotation.
			(self spacer: 2).
			tabWidthMorph.
			(self spacer: 2).
			editingModeMorph.
			(self spacer: 2).
			wrappingPolicyMorph.
			(self spacer: 2).
			lineNumbersDisplayMorph.
			(self spacer: 2).
			columnDisplayMorph.
			(self spacer: 2)}.
	wrappingPolicyMorph on: #mouseDown send: #changeWrappingPolicy to: self.
	tabWidthMorph on: #mouseDown send: #chooseTabWidth: to: self.
	editingModeMorph on: #mouseDown send: #chooseEditingMode: to: self.
	columnDisplayMorph on: #mouseDown send: #changeColumnDisplay to: self.
	lineNumbersDisplayMorph on: #mouseDown send: #changeLineNumbersDisplay to: self.
	row color: Color transparent.
	row hResizing: #spaceFill.
	lineAnnotation hResizing: #spaceFill.
	self addMorph: row! !

!RubAnnotationDisplayer methodsFor: 'event handling' stamp: 'AlainPlantec 5/19/2013 00:25'!
updateContents
	| t |
	row ifNil: [ ^self ].
	self textArea selectionStart ifNil: [ ^self ].
	self lines ifNil: [ ^self ].
	t := self textOfCharBlock: self textArea selectionStart.
	self textArea selectionStop ~= self textArea selectionStart
		ifTrue: [ t := t , ' -- ' , (self textOfCharBlock: self textArea selectionStop) ].
	lineAnnotation
		beEditableWhile: [ 
			lineAnnotation setTextWith: t.
			self layoutChanged ].
	wrappingPolicyMorph contents: self wrappingPolicyLabel.
	editingModeMorph contents: self editingModeLabel.
	tabWidthMorph contents: self tabWidthLabel.
	columnDisplayMorph contents: self columnDisplayLabel.
	lineNumbersDisplayMorph contents: self lineNumbersDisplayLabel.
	row position: self innerBounds topLeft.
	row width: self innerBounds width! !

!RubAnnotationDisplayer methodsFor: 'submorphs-accessing' stamp: 'AlainPlantec 5/19/2013 00:21'!
lineNumbersDisplayLabelMorph
	^ StringMorph
		contents: self lineNumbersDisplayLabel
		font: self fontToUse! !

!RubAnnotationDisplayer methodsFor: 'submorphs-accessing' stamp: 'AlainPlantec 5/20/2013 00:11'!
columnDisplayLabel
	^ self paragraphProvider columnRuler 
		ifNil: [ '+C' ]
		ifNotNil: [ 'C' ]! !

!RubAnnotationDisplayer methodsFor: 'submorphs-accessing' stamp: 'AlainPlantec 5/19/2013 00:09'!
columnDisplayLabelMorph
	^ StringMorph
		contents: self columnDisplayLabel
		font: self fontToUse! !

!RubAnnotationDisplayer methodsFor: 'event handling' stamp: 'AlainPlantec 2/6/2014 12:05'!
selectionChanged
	self updateContents.
	super selectionChanged! !

!RubAnnotationDisplayer methodsFor: 'geometry' stamp: 'AlainPlantec 5/17/2013 10:27'!
computedWidthFrom: aRectangle
	^ aRectangle width! !

!RubAnnotationDisplayer methodsFor: 'submorphs-accessing' stamp: 'AlainPlantec 5/18/2013 23:55'!
tabWidthLabel
	^ 'Tab width: ', self tabWidth printString! !

!RubAnnotationDisplayer methodsFor: 'submorphs-accessing' stamp: 'AlainPlantec 5/17/2013 12:59'!
spacer: anInteger
	^ Morph new
		borderWidth: 0;
		color: Color transparent;
		extent: anInteger@3! !

!RubAnnotationDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 5/17/2013 08:41'!
fontToUse
	^ RubAbstractTextArea lineNumbersFont ! !

!RubAnnotationDisplayer methodsFor: 'submorphs-accessing' stamp: 'AlainPlantec 5/17/2013 11:44'!
changeWrappingPolicy
	self paragraphProvider wrapped 
		ifTrue: [ self paragraphProvider beNotWrapped  ]
		ifFalse: [ self paragraphProvider beWrapped ].
	self updateContents.
	self paragraphProvider changed! !

!RubAnnotationDisplayer class methodsFor: 'querying' stamp: 'AlainPlantec 5/17/2013 08:51'!
key
	^ #annotation! !

!RubAnnotationDisplayer class methodsFor: 'menus' stamp: 'AlainPlantec 5/19/2013 12:27'!
tabWidthMenuOn: aBuilder
	"Specify the menu used to select the tab width"

	<contextMenu>
	<RubTabWidthMenu>
	(6 to: 200 by: 6) do: [ :t | (aBuilder item: t asString asSymbol) action: [ :model | model chosenTabWidth: t ] ] ! !

!RubBasicSelectionDecorator methodsFor: 'drawing' stamp: 'AlainPlantec 2/26/2015 19:52'!
handleDrawingOnAthensCanvas: aCanvas bounds: aRectangle
	self selectionStart ifNil: [ ^ self ].
	self selectionStop ifNil: [ ^self ].
	super handleDrawingOnAthensCanvas: aCanvas bounds: aRectangle! !

!RubBasicSelectionDecorator methodsFor: 'drawing' stamp: 'AlainPlantec 2/26/2015 19:32'!
drawOnAthensCanvas! !

!RubBasicSelectionDecorator methodsFor: 'drawing' stamp: 'AlainPlantec 4/11/2013 13:54'!
draw! !

!RubBasicSelectionDecorator methodsFor: 'drawing' stamp: 'AlainPlantec 4/11/2013 14:07'!
handleDrawingOn: aCanvas using: aDisplayScanner at: aPosition 
	self selectionStart ifNil: [ ^ self ].
	self selectionStop ifNil: [ ^self ].
	aCanvas isShadowDrawing
		ifTrue: [ ^ self ].	"don't draw selection with shadow"
	super handleDrawingOn: aCanvas using: aDisplayScanner at: aPosition 
! !

!RubBasicSelectionDecorator class methodsFor: 'querying' stamp: 'AlainPlantec 4/17/2013 23:30'!
key
	^ nil! !

!RubBoundsChanged methodsFor: 'accessing' stamp: 'AlainPlantec 4/23/2013 11:10'!
previousBounds
	^ previousBounds! !

!RubBoundsChanged methodsFor: 'accessing' stamp: 'AlainPlantec 4/23/2013 11:10'!
previousBounds: anObject
	previousBounds := anObject! !

!RubCharacterBlock methodsFor: 'accessing' stamp: 'AlainPlantec 4/21/2013 14:59'!
surface: aRectangle
	surface := aRectangle! !

!RubCharacterBlock methodsFor: 'accessing' stamp: 'AlainPlantec 4/21/2013 15:05'!
origin
	^ surface origin! !

!RubCharacterBlock methodsFor: 'accessing' stamp: 'AlainPlantec 4/21/2013 14:49'!
left
	^ surface left! !

!RubCharacterBlock methodsFor: 'private' stamp: 'AlainPlantec 4/21/2013 14:47'!
stringIndex: anInteger topLeft: topLeft extent: extent 
	stringIndex := anInteger.
	surface := topLeft extent: extent
! !

!RubCharacterBlock methodsFor: 'comparing' stamp: 'AlainPlantec 3/17/2013 15:13'!
< aCharacterBlock 
	"Answer whether the string index of the receiver precedes that of 
	aCharacterBlock."

	^stringIndex < aCharacterBlock stringIndex! !

!RubCharacterBlock methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:13'!
textLine: aLine 
	textLine := aLine! !

!RubCharacterBlock methodsFor: 'accessing' stamp: 'AlainPlantec 4/21/2013 15:02'!
height
	^ surface height! !

!RubCharacterBlock methodsFor: 'accessing' stamp: 'AlainPlantec 4/21/2013 14:50'!
right
	^ surface right! !

!RubCharacterBlock methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:13'!
textLine
	^ textLine! !

!RubCharacterBlock methodsFor: 'printing' stamp: 'AlainPlantec 4/21/2013 14:46'!
printOn: aStream
	aStream nextPutAll: 'a CharacterBlock with index '.
	stringIndex printOn: aStream.
	aStream nextPutAll: ' and surface '.
	self surface printOn: aStream.
	textLine
		ifNotNil: [ 
			aStream
				cr;
				nextPutAll: ' in '.
			textLine printOn: aStream ]! !

!RubCharacterBlock methodsFor: 'private' stamp: 'AlainPlantec 4/22/2013 16:25'!
privateSetOrigin: aPoint
	self surface privateSetOrigin: aPoint! !

!RubCharacterBlock methodsFor: 'accessing' stamp: 'AlainPlantec 4/21/2013 15:04'!
areasOutside: aRectangle
	^ surface areasOutside: aRectangle! !

!RubCharacterBlock methodsFor: 'comparing' stamp: 'AlainPlantec 3/17/2013 15:13'!
> aCharacterBlock 
	"Answer whether the string index of the receiver comes after that of 
	aCharacterBlock."

	^aCharacterBlock < self! !

!RubCharacterBlock methodsFor: 'accessing' stamp: 'AlainPlantec 4/21/2013 14:52'!
bottomRight
	^ surface bottomRight ! !

!RubCharacterBlock methodsFor: 'accessing' stamp: 'AlainPlantec 4/21/2013 15:05'!
corner
	^ surface corner! !

!RubCharacterBlock methodsFor: 'accessing' stamp: 'AlainPlantec 4/21/2013 15:02'!
width
	^ surface width! !

!RubCharacterBlock methodsFor: 'private' stamp: 'AlainPlantec 4/21/2013 14:46'!
moveBy: aPoint 
	"Change the corner positions of the receiver so that its area translates by 
	the amount defined by the argument, aPoint."
	surface := surface translateBy: aPoint! !

!RubCharacterBlock methodsFor: 'accessing' stamp: 'AlainPlantec 4/21/2013 14:47'!
surface
	^ surface! !

!RubCharacterBlock methodsFor: 'comparing' stamp: 'AlainPlantec 3/17/2013 15:13'!
>= aCharacterBlock 
	"Answer whether the string index of the receiver does not precede that of 
	aCharacterBlock."

	^(self < aCharacterBlock) not! !

!RubCharacterBlock methodsFor: 'comparing' stamp: 'AlainPlantec 4/21/2013 14:44'!
min: aCharacterBlock
	aCharacterBlock ifNil: [ ^ self ].
	^ aCharacterBlock < self
		ifTrue: [ aCharacterBlock ]
		ifFalse: [ self ]! !

!RubCharacterBlock methodsFor: 'accessing' stamp: 'AlainPlantec 4/21/2013 15:03'!
area
	^ surface area! !

!RubCharacterBlock methodsFor: 'comparing' stamp: 'AlainPlantec 4/21/2013 14:44'!
max: aCharacterBlock
	aCharacterBlock ifNil: [ ^ self ].
	^ aCharacterBlock > self
		ifTrue: [ aCharacterBlock ]
		ifFalse: [ self ]! !

!RubCharacterBlock methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:13'!
stringIndex
	"Answer the position of the receiver in the string it indexes."

	^stringIndex! !

!RubCharacterBlock methodsFor: 'accessing' stamp: 'AlainPlantec 4/21/2013 14:49'!
bottom
	^ surface bottom! !

!RubCharacterBlock methodsFor: 'accessing' stamp: 'AlainPlantec 4/21/2013 14:55'!
bottomLeft
	^ surface bottomLeft! !

!RubCharacterBlock methodsFor: 'accessing' stamp: 'AlainPlantec 4/21/2013 14:49'!
top
	^ surface top! !

!RubCharacterBlock methodsFor: 'accessing' stamp: 'AlainPlantec 4/21/2013 14:51'!
topLeft
	^ surface topLeft! !

!RubCharacterBlock methodsFor: 'accessing' stamp: 'AlainPlantec 4/21/2013 21:15'!
extent
	^ surface extent! !

!RubCharacterBlock methodsFor: 'accessing' stamp: 'AlainPlantec 5/14/2013 22:07'!
topRight
	^ surface topRight! !

!RubCharacterBlock methodsFor: 'comparing' stamp: 'AlainPlantec 3/17/2013 15:13'!
= aCharacterBlock

	self species = aCharacterBlock species
		ifTrue: [^stringIndex = aCharacterBlock stringIndex]
		ifFalse: [^false]! !

!RubCharacterBlock methodsFor: 'private' stamp: 'AlainPlantec 4/21/2013 14:58'!
translateBy: aPoint 
	"Change the corner positions of the receiver so that its area translates by 
	the amount defined by the argument, aPoint."
	^ self copy moveBy: aPoint! !

!RubCharacterBlock methodsFor: 'private' stamp: 'AlainPlantec 4/21/2013 15:01'!
insetBy: aPoint 
	"Change the corner positions of the receiver so that its area translates by 
	the amount defined by the argument, aPoint."
	^ self copy surface: (surface insetBy: aPoint)! !

!RubCharacterBlock methodsFor: 'private' stamp: 'AlainPlantec 4/22/2013 16:22'!
privateSetCorner: aPoint
	self surface privateSetCorner: aPoint! !

!RubCharacterBlock methodsFor: 'accessing' stamp: 'AlainPlantec 4/21/2013 15:00'!
withLeft: anInteger
	^ self copy surface: (surface withLeft: anInteger)
! !

!RubCharacterBlock methodsFor: 'accessing' stamp: 'AlainPlantec 4/21/2013 15:00'!
withRight: anInteger
	^ self copy surface: (surface withRight: anInteger)! !

!RubCharacterBlock methodsFor: 'comparing' stamp: 'AlainPlantec 3/17/2013 15:13'!
<= aCharacterBlock 
	"Answer whether the string index of the receiver does not come after that 
	of aCharacterBlock."

	^(self > aCharacterBlock) not! !

!RubCharacterBlockScanner methodsFor: 'private' stamp: 'AlainPlantec 3/17/2013 15:18'!
lastSpaceOrTabExtentSetX: xVal
	lastSpaceOrTabExtent := xVal @ lastSpaceOrTabExtent y! !

!RubCharacterBlockScanner methodsFor: 'stop conditions' stamp: 'AlainPlantec 5/18/2013 18:28'!
tab
	| currentX |
	currentX := (alignment = Justified and: [self leadingTab not])
		ifTrue:		"imbedded tabs in justified text are weird"
			[destX + (self tabWidth - (line justifiedTabDeltaFor: spaceCount)) max: destX]
		ifFalse:
			[self nextTabXFrom: destX].
	lastSpaceOrTabExtent := lastCharacterExtent copy.
	self lastSpaceOrTabExtentSetX: (currentX - destX max: 0).
	currentX >= characterPoint x
		ifTrue: 
			[lastCharacterExtent := lastSpaceOrTabExtent copy.
			^ self crossedX].
	destX := currentX.
	lastIndex := lastIndex + 1.
	^false! !

!RubCharacterBlockScanner methodsFor: 'scanning' stamp: 'AlainPlantec 4/13/2013 00:23'!
characterBlockAtPoint: aPoint index: index in: textLine
	"This method is the Morphic characterBlock finder.  It combines
	MVC's characterBlockAtPoint:, -ForIndex:, and buildCharcterBlock:in:"

	| runLength lineStop stopCondition |
	line := textLine.
	rightMargin := line rightMargin.
	lastIndex := line first.
	self setStopConditions.	"also sets font"
	characterIndex := index.	" == nil means scanning for point"
	characterPoint := aPoint.
	(characterPoint isNil or: [ characterPoint y > line bottom ])
		ifTrue: [ characterPoint := line bottomRight ].
	(text isEmpty
		or: [ 
			(characterPoint y < line top or: [ characterPoint x < line left ])
				or: [ characterIndex notNil and: [ characterIndex < line first ] ] ])
		ifTrue: [ 
			^ (RubCharacterBlock new stringIndex: line first topLeft: line leftMargin @ line top extent: 0 @ textStyle lineGrid)
				textLine: line ].
	destX := leftMargin := line leftMarginForAlignment: alignment.
	destY := line top.
	runLength := text runLengthFor: line first.
	characterIndex
		ifNotNil: [ lineStop := characterIndex	"scanning for index" ]
		ifNil: [ lineStop := line last	"scanning for point" ].
	runStopIndex := lastIndex + (runLength - 1) min: lineStop.
	lastCharacterExtent := 0 @ line lineHeight.
	spaceCount := 0.
	[ false ]
		whileFalse: [ 
			stopCondition := self
				scanCharactersFrom: lastIndex
				to: runStopIndex
				in: text string
				rightX: characterPoint x
				stopConditions: stopConditions
				kern: kern.	"see setStopConditions for stopping conditions for character block 	operations."
			self lastCharacterExtentSetX: (specialWidth ifNil: [ font widthOf: (text at: lastIndex) ] ifNotNil: [ specialWidth ]).
			(self perform: stopCondition)
				ifTrue: [ 
					characterIndex
						ifNil: [ 
							"Result for characterBlockAtPoint: "
							(stopCondition ~~ #cr
								and: [ lastIndex == line last and: [ aPoint x > (characterPoint x + (lastCharacterExtent x / 2)) ] ])
								ifTrue: [ 
									"Correct for right half of last character in line"
									^ (RubCharacterBlock new
										stringIndex: lastIndex + 1
										topLeft: characterPoint + (lastCharacterExtent x @ 0) + (font descentKern @ 0)
										extent: 0 @ lastCharacterExtent y) textLine: line ].
							^ (RubCharacterBlock new
								stringIndex: lastIndex
								topLeft: characterPoint + (font descentKern @ 0)
								extent: lastCharacterExtent - (font baseKern @ 0)) textLine: line ]
						ifNotNil: [ 
							"Result for characterBlockForIndex: "
							^ (RubCharacterBlock new
								stringIndex: characterIndex
								topLeft: characterPoint + ((font descentKern - kern) @ 0)
								extent: lastCharacterExtent) textLine: line ] ] ]! !

!RubCharacterBlockScanner methodsFor: 'private' stamp: 'AlainPlantec 3/17/2013 15:18'!
lastCharacterExtentSetX: xVal
	lastCharacterExtent := xVal @ lastCharacterExtent y! !

!RubCharacterBlockScanner methodsFor: 'stop conditions' stamp: 'AlainPlantec 3/17/2013 15:18'!
endOfRun
	"Before arriving at the cursor location, the selection has encountered an 
	end of run. Answer false if the selection continues, true otherwise. Set 
	up indexes for building the appropriate CharacterBlock."

	| runLength lineStop |
	(((characterIndex ~~ nil and:
		[runStopIndex < characterIndex and: [runStopIndex < text size]])
			or:	[characterIndex == nil and: [lastIndex < line last]]) or: [
				((lastIndex < line last)
				and: [((text at: lastIndex) leadingChar ~= (text at: lastIndex+1) leadingChar)
					and: [lastIndex ~= characterIndex]])])
		ifTrue:	["We're really at the end of a real run."
				runLength := (text runLengthFor: (lastIndex := lastIndex + 1)).
				characterIndex ~~ nil
					ifTrue:	[lineStop := characterIndex	"scanning for index"]
					ifFalse:	[lineStop := line last			"scanning for point"].
				(runStopIndex := lastIndex + (runLength - 1)) > lineStop
					ifTrue: 	[runStopIndex := lineStop].
				self setStopConditions.
				^false].

	lastCharacter := text at: lastIndex.
	characterPoint := destX @ destY.
	((lastCharacter = Space and: [alignment = Justified])
		or: [lastCharacter = Tab and: [lastSpaceOrTabExtent notNil]])
		ifTrue: [lastCharacterExtent := lastSpaceOrTabExtent].
	characterIndex ~~ nil
		ifTrue:	["If scanning for an index and we've stopped on that index,
				then we back destX off by the width of the character stopped on
				(it will be pointing at the right side of the character) and return"
				runStopIndex = characterIndex
					ifTrue:	[self characterPointSetX: destX - lastCharacterExtent x.
							^true].
				"Otherwise the requested index was greater than the length of the
				string.  Return string size + 1 as index, indicate further that off the
				string by setting character to nil and the extent to 0."
				lastIndex :=  lastIndex + 1.
				lastCharacter := nil.
				self lastCharacterExtentSetX: 0.
				^true].

	"Scanning for a point and either off the end of the line or off the end of the string."
	runStopIndex = text size
		ifTrue:	["off end of string"
				lastIndex :=  lastIndex + 1.
				lastCharacter := nil.
				self lastCharacterExtentSetX: 0.
				^true].
	"just off end of line without crossing x"
	lastIndex := lastIndex + 1.
	^true! !

!RubCharacterBlockScanner methodsFor: 'stop conditions' stamp: 'AlainPlantec 3/17/2013 15:18'!
setStopConditions
	"Set the font and the stop conditions for the current run."
	
	self setFont.
	self setConditionArray: (alignment = Justified ifTrue: [#paddedSpace]).
! !

!RubCharacterBlockScanner methodsFor: 'stop conditions' stamp: 'AlainPlantec 3/17/2013 15:18'!
paddedSpace
	"When the line is justified, the spaces will not be the same as the font's 
	space character. A padding of extra space must be considered in trying 
	to find which character the cursor is pointing at. Answer whether the 
	scanning has crossed the cursor."

	| pad |
	pad := 0.
	spaceCount := spaceCount + 1.
	pad := line justifiedPadFor: spaceCount font: font.
	lastSpaceOrTabExtent := lastCharacterExtent copy.
	self lastSpaceOrTabExtentSetX:  spaceWidth + pad.
	(destX + lastSpaceOrTabExtent x)  >= characterPoint x
		ifTrue: [lastCharacterExtent := lastSpaceOrTabExtent copy.
				^self crossedX].
	lastIndex := lastIndex + 1.
	destX := destX + lastSpaceOrTabExtent x.
	^ false
! !

!RubCharacterBlockScanner methodsFor: 'private' stamp: 'AlainPlantec 3/17/2013 15:18'!
characterPointSetX: xVal
	characterPoint := xVal @ characterPoint y! !

!RubCharacterBlockScanner methodsFor: 'scanning' stamp: 'AlainPlantec 3/17/2013 15:18'!
placeEmbeddedObject: anchoredMorph
	"Workaround: The following should really use #textAnchorType"
	anchoredMorph relativeTextAnchorPosition ifNotNil:[^true].
	(super placeEmbeddedObject: anchoredMorph) ifFalse: [^ false].
	specialWidth := anchoredMorph width.
	^ true! !

!RubCharacterBlockScanner methodsFor: 'stop conditions' stamp: 'AlainPlantec 5/18/2013 18:27'!
crossedX
	"Text display has wrapping. The scanner just found a character past the x 
	location of the cursor. We know that the cursor is pointing at a character 
	or before one."

	| leadingTab currentX |
	characterIndex == nil ifFalse: [
		"If the last character of the last line is a space,
		and it crosses the right margin, then locating
		the character block after it is impossible without this hack."
		characterIndex > text size ifTrue: [
			lastIndex := characterIndex.
			characterPoint := (nextLeftMargin ifNil: [leftMargin]) @ (destY + line lineHeight).
			^true]].
	characterPoint x <= (destX + (lastCharacterExtent x // 2))
		ifTrue:	[lastCharacter := (text at: lastIndex).
				characterPoint := destX @ destY.
				^true].
	lastIndex >= line last 
		ifTrue:	[lastCharacter := (text at: line last).
				characterPoint := destX @ destY.
				^true].

	"Pointing past middle of a character, return the next character."
	lastIndex := lastIndex + 1.
	lastCharacter := text at: lastIndex.
	currentX := destX + lastCharacterExtent x + kern.
	self lastCharacterExtentSetX: (font widthOf: lastCharacter).
	characterPoint := currentX @ destY.
	lastCharacter = Space ifFalse: [^ true].

	"Yukky if next character is space or tab."
	alignment = Justified ifTrue:
		[self lastCharacterExtentSetX:
			(lastCharacterExtent x + 	(line justifiedPadFor: (spaceCount + 1) font: font)).
		^ true].

	true ifTrue: [^ true].
	"NOTE:  I find no value to the following code, and so have defeated it - DI"

	"See tabForDisplay for illumination on the following awfulness."
	leadingTab := true.
	line first to: lastIndex - 1 do:
		[:index | (text at: index) ~= Tab ifTrue: [leadingTab := false]].
	(alignment ~= Justified or: [leadingTab])
		ifTrue:	[self lastCharacterExtentSetX: (self nextTabXFrom: currentX) -
						currentX]
		ifFalse:	[self lastCharacterExtentSetX:  (((currentX + (self tabWidth -
						(line justifiedTabDeltaFor: spaceCount))) -
							currentX) max: 0)].
	^ true! !

!RubCharacterBlockScanner methodsFor: 'stop conditions' stamp: 'AlainPlantec 3/17/2013 15:18'!
setFont
	specialWidth := nil.
	super setFont! !

!RubCharacterBlockScanner methodsFor: 'stop conditions' stamp: 'AlainPlantec 3/28/2013 21:43'!
cr 
	"Answer a CharacterBlock that specifies the current location of the mouse 
	relative to a carriage return stop condition that has just been 
	encountered. The ParagraphEditor convention is to denote selections by 
	CharacterBlocks, sometimes including the carriage return (cursor is at 
	the end) and sometimes not (cursor is in the middle of the text)."

	((characterIndex ~= nil
		and: [characterIndex > text size])
			or: [(line last = text size)
				and: [(destY + line lineHeight) < characterPoint y]])
		ifTrue:	["When off end of string, give data for next character"
				destY := destY +  line lineHeight.
				baselineY := line lineHeight.
				lastCharacter := nil.
				characterPoint := (nextLeftMargin ifNil: [leftMargin]) @ destY.
				(lastIndex < text size and: [(text at: lastIndex) = Character cr and: [(text at: lastIndex+1) = Character lf]])
					ifTrue: [lastIndex := lastIndex + 2]
					ifFalse: [lastIndex := lastIndex + 1].
				self lastCharacterExtentSetX: 0.
				^ true].
		lastCharacter := Character cr.
		characterPoint := destX @ destY.
		self lastCharacterExtentSetX: rightMargin - destX.
		^true! !

!RubCharacterBlockScanner methodsFor: 'scanning' stamp: 'AlainPlantec 5/18/2013 18:27'!
indentationLevel: anInteger
	super indentationLevel: anInteger.
	nextLeftMargin := leftMargin.
	indentationLevel timesRepeat: [
		nextLeftMargin := self nextTabXFrom: nextLeftMargin]! !

!RubCharacterScanner methodsFor: 'scanning' stamp: 'AlainPlantec 3/17/2013 23:22'!
embeddedObject
	| savedIndex |
	savedIndex := lastIndex.
	text
		attributesAt: lastIndex
		do: [ :attr | 
			attr anchoredMorph
				ifNotNil: [ 
					"Following may look strange but logic gets reversed.
			If the morph fits on this line we're not done (return false for true) 
			and if the morph won't fit we're done (return true for false)"
					(self placeEmbeddedObject: attr anchoredMorph)
						ifFalse: [ ^ true ] ] ].
	lastIndex := savedIndex + 1.	"for multiple(!!) embedded morphs"
	^ false! !

!RubCharacterScanner methodsFor: 'scanning' stamp: 'AlainPlantec 3/17/2013 15:17'!
indentationLevel
	"return the number of tabs that are currently being placed at the beginning of each line"
	^indentationLevel ifNil:[0]! !

!RubCharacterScanner methodsFor: 'scanning' stamp: 'AlainPlantec 5/18/2013 18:26'!
nextTabXFrom: anX
	"Tab stops are distances from the left margin. Set the distance into the 
	argument, anX, normalized for the paragraph's left margin."

	| normalizedX tabX mx |
	mx := 9999.
	normalizedX := anX - leftMargin.
	tabX := self tabWidth.
	[ tabX <= normalizedX and: [ tabX < mx ] ] whileTrue: [ tabX := tabX + self tabWidth ].
	^ tabX < mx
		ifTrue: [ leftMargin + tabX min: rightMargin ]
		ifFalse: [ rightMargin ] ! !

!RubCharacterScanner methodsFor: 'scanner methods' stamp: 'AlainPlantec 3/26/2013 15:02'!
scanJapaneseCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta

	| ascii encoding f nextDestX maxAscii startEncoding |
	lastIndex := startIndex.
	lastIndex > stopIndex ifTrue: [lastIndex := stopIndex. ^ stops endOfRun].
	startEncoding := (sourceString at: startIndex) leadingChar.
	font ifNil: [font := TextStyle defaultFont fontArray at: 1].
	font isFontSet ifTrue: [
		f := [font fontArray at: startEncoding + 1]
			on: Exception do: [:ex | nil].
		f ifNil: [ f := font fontArray at: 1].
		maxAscii := f maxAscii.
		"xTable := f xTable.
		maxAscii := xTable size - 2."
		spaceWidth := f widthOf: Character space.
	] ifFalse: [
		maxAscii := font maxAscii.
	].
	[lastIndex <= stopIndex] whileTrue: [
		"self halt."
		encoding := (sourceString at: lastIndex) leadingChar.
		encoding ~= startEncoding ifTrue: [lastIndex := lastIndex - 1. ^ stops endOfRun].
		ascii := (sourceString at: lastIndex) charCode.
		ascii > maxAscii ifTrue: [ascii := maxAscii].
		(encoding = 0 and: [ascii < stops size and: [(stops at: ascii + 1) ~~ nil]]) ifTrue: [^ stops at: ascii + 1].
		(self isBreakableAt: lastIndex in: sourceString in: (EncodedCharSet charsetAt: encoding)) ifTrue: [
			self registerBreakableIndex.
		].
		nextDestX := destX + (font widthOf: (sourceString at: lastIndex)).
		nextDestX > rightX ifTrue: [firstDestX ~= destX ifTrue: [^ stops crossedX]].
		destX := nextDestX + kernDelta.
		lastIndex := lastIndex + 1.
	].
	lastIndex := stopIndex.
	^ stops endOfRun! !

!RubCharacterScanner methodsFor: 'private' stamp: 'AlainPlantec 3/17/2013 15:17'!
setActualFont: aFont
	"Set the basal font to an isolated font reference."

	font := aFont! !

!RubCharacterScanner methodsFor: 'private' stamp: 'AlainPlantec 3/17/2013 15:17'!
textColor: ignored
	"Overridden in DisplayScanner"! !

!RubCharacterScanner methodsFor: 'initialize' stamp: 'AlainPlantec 3/17/2013 15:17'!
initialize
	super initialize.
	destX := destY := leftMargin := 0.! !

!RubCharacterScanner methodsFor: 'private' stamp: 'AlainPlantec 3/17/2013 15:17'!
setAlignment: style
	alignment := style.
	! !

!RubCharacterScanner methodsFor: 'scanning' stamp: 'AlainPlantec 3/26/2013 15:03'!
scanMultiCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta

	| ascii encoding f nextDestX maxAscii startEncoding floatDestX widthAndKernedWidth nextChar atEndOfRun |
	lastIndex := startIndex.
	lastIndex > stopIndex ifTrue: [lastIndex := stopIndex. ^ stops endOfRun].
	startEncoding := (sourceString at: startIndex) leadingChar.
	font ifNil: [font := TextStyle defaultFont fontArray at: 1].
	font isFontSet ifTrue: [
		f := [font fontArray at: startEncoding + 1]
			on: Exception do: [:ex | nil].
		f ifNil: [ f := font fontArray at: 1].
		maxAscii := f maxAscii.
		spaceWidth := f widthOf: Character space.
	] ifFalse: [
		maxAscii := font maxAscii.
	].
	floatDestX := destX.
	widthAndKernedWidth := Array new: 2.
	atEndOfRun := false.
	[lastIndex <= stopIndex] whileTrue: [
		encoding := (sourceString at: lastIndex) leadingChar.
		encoding ~= startEncoding ifTrue: [lastIndex := lastIndex - 1. ^ stops endOfRun].
		ascii := (sourceString at: lastIndex) charCode.
		ascii > maxAscii ifTrue: [ascii := maxAscii].
		(encoding = 0 and: [ascii < stops size and: [(stops at: ascii + 1) ~~ nil]]) ifTrue: [^ stops at: ascii + 1].
		(self isBreakableAt: lastIndex in: sourceString in: Latin1Environment) ifTrue: [
			self registerBreakableIndex.
		].
		nextChar := (lastIndex + 1 <= stopIndex) 
			ifTrue:[sourceString at: lastIndex + 1]
			ifFalse:[
				atEndOfRun := true.
				"if there is a next char in sourceString, then get the kern 
				and store it in pendingKernX"
				lastIndex + 1 <= sourceString size
					ifTrue:[sourceString at: lastIndex + 1]
					ifFalse:[	nil]].
		font 
			widthAndKernedWidthOfLeft: (sourceString at: lastIndex) 
			right: nextChar
			into: widthAndKernedWidth.
		nextDestX := floatDestX + (widthAndKernedWidth at: 1).
		nextDestX > rightX ifTrue: [destX ~= firstDestX ifTrue: [^stops crossedX]].
		floatDestX := floatDestX + kernDelta + (widthAndKernedWidth at: 2).
		atEndOfRun 
			ifTrue:[
				pendingKernX := (widthAndKernedWidth at: 2) - (widthAndKernedWidth at: 1).
				floatDestX := floatDestX - pendingKernX].
		destX := floatDestX .
		lastIndex := lastIndex + 1.
	].
	lastIndex := stopIndex.
	^ stops endOfRun! !

!RubCharacterScanner methodsFor: 'scanner methods' stamp: 'AlainPlantec 3/17/2013 15:17'!
combinableChar: char for: prevEntity

! !

!RubCharacterScanner methodsFor: 'scanning' stamp: 'AlainPlantec 3/26/2013 15:04'!
leadingTab
	"return true if only tabs lie to the left"
	line first to: lastIndex do:
		[:i | (text at: i) == Character tab ifFalse: [^ false]].
	^ true! !

!RubCharacterScanner methodsFor: 'scanning' stamp: 'AlainPlantec 3/17/2013 15:17'!
measureString: aString inFont: aFont from: startIndex to: stopIndex
	"WARNING: In order to use this method the receiver has to be set up using #initializeStringMeasurer"
	destX := destY := lastIndex := 0.
	baselineY := aFont ascent.
	font := aFont.  " added Dec 03, 2004 "
"	map := aFont characterToGlyphMap."
	self scanCharactersFrom: startIndex to: stopIndex in: aString rightX: 999999 stopConditions: stopConditions kern: 0.
	^destX! !

!RubCharacterScanner methodsFor: 'accessing' stamp: 'AlainPlantec 5/18/2013 23:14'!
tabWidth
	^ textStyle rubTabWidth! !

!RubCharacterScanner methodsFor: 'private' stamp: 'AlainPlantec 4/5/2013 13:56'!
backgroundColor: ignored
	"Overridden in DisplayScanner"! !

!RubCharacterScanner methodsFor: 'scanner methods' stamp: 'AlainPlantec 3/17/2013 15:17'!
isBreakableAt: index in: sourceString in: encodingClass

	^ encodingClass isBreakableAt: index in: sourceString.
! !

!RubCharacterScanner methodsFor: 'scanning' stamp: 'AlainPlantec 3/17/2013 15:17'!
indentationLevel: anInteger
	"set the number of tabs to put at the beginning of each line"
	indentationLevel := anInteger! !

!RubCharacterScanner methodsFor: 'private' stamp: 'AlainPlantec 3/17/2013 15:17'!
addKern: kernDelta
	"Set the current kern amount."
	kern := kern + kernDelta! !

!RubCharacterScanner methodsFor: 'multilingual scanning' stamp: 'AlainPlantec 3/17/2013 15:17'!
widthOf: char inFont: aFont

	(char isMemberOf: CombinedChar) ifTrue: [
		^ aFont widthOf: char base.
	] ifFalse: [
		^ aFont widthOf: char.
	].


! !

!RubCharacterScanner methodsFor: 'private' stamp: 'AlainPlantec 3/17/2013 15:17'!
setFont: fontNumber
	"Set the font by number from the textStyle."

	self setActualFont: (textStyle fontAt: fontNumber)! !

!RubCharacterScanner methodsFor: 'scanning' stamp: 'AlainPlantec 3/17/2013 15:17'!
basicScanCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta
	"Primitive. This is the inner loop of text display--but see 
	scanCharactersFrom: to:rightX: which would get the string, 
	stopConditions and displaying from the instance. March through source 
	String from startIndex to stopIndex. If any character is flagged with a 
	non-nil entry in stops, then return the corresponding value. Determine 
	width of each character from xTable, indexed by map. 
	If dextX would exceed rightX, then return stops at: 258. 
	Advance destX by the width of the character. If stopIndex has been
	reached, then return stops at: 257. Optional. 
	See Object documentation whatIsAPrimitive."
	| ascii nextDestX char floatDestX widthAndKernedWidth nextChar atEndOfRun |
	<primitive: 103>
	lastIndex := startIndex.
	floatDestX := destX.
	widthAndKernedWidth := Array new: 2.
	atEndOfRun := false.
	[lastIndex <= stopIndex]
		whileTrue: [
			char := (sourceString at: lastIndex).
			ascii := char asciiValue.
			
			(ascii < stops size and: [(stops at: ascii + 1) notNil]) ifTrue: [^ stops at: ascii + 1].
			(self isBreakableAt: lastIndex in: sourceString in: Latin1Environment) 
				ifTrue: [ self registerBreakableIndex ].
			"Note: The following is querying the font about the width
			since the primitive may have failed due to a non-trivial
			mapping of characters to glyphs or a non-existing xTable."
			nextChar := (lastIndex + 1 <= stopIndex) 
				ifTrue:[sourceString at: lastIndex + 1]
				ifFalse:[
					atEndOfRun := true.
					"if there is a next char in sourceString, then get the kern 
					and store it in pendingKernX"
					lastIndex + 1 <= sourceString size
						ifTrue:[sourceString at: lastIndex + 1]
						ifFalse:[	nil]].
			font 
				widthAndKernedWidthOfLeft: char 
				right: nextChar
				into: widthAndKernedWidth.
			nextDestX := floatDestX + (widthAndKernedWidth at: 1).
			nextDestX > rightX ifTrue: [^stops crossedX].
			floatDestX := floatDestX + kernDelta + (widthAndKernedWidth at: 2).
			atEndOfRun 
				ifTrue:[
					pendingKernX := (widthAndKernedWidth at: 2) - (widthAndKernedWidth at: 1).
					floatDestX := floatDestX - pendingKernX].
			destX := floatDestX.
			lastIndex := lastIndex + 1].
	lastIndex := stopIndex.
	^ stops endOfRun! !

!RubCharacterScanner methodsFor: 'private' stamp: 'AlainPlantec 3/17/2013 15:17'!
addEmphasis: code
	"Set the bold-ital-under-strike emphasis."
	emphasisCode := emphasisCode bitOr: code! !

!RubCharacterScanner methodsFor: 'scanning' stamp: 'AlainPlantec 3/17/2013 15:17'!
scanCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta
	| startEncoding selector |
	
	sourceString isByteString
		ifTrue: [ ^ self 
					basicScanCharactersFrom: startIndex 
					to: stopIndex 
					in: sourceString 
					rightX: rightX 
					stopConditions: stops 
					kern: kernDelta ].

	sourceString isWideString ifFalse: [ ^ stops endOfRun ].
		
	startIndex > stopIndex 
		ifTrue: [ 
			lastIndex := stopIndex.
			^ stops endOfRun ].
	
	startEncoding := (sourceString at: startIndex) leadingChar.
	selector := (EncodedCharSet charsetAt: startEncoding) scanSelector.

	^ self 
		perform: selector 
		withArguments: (Array 
							with: startIndex 
							with: stopIndex 
							with: sourceString 
							with: rightX 
							with: stops 
							with: kernDelta).

	
! !

!RubCharacterScanner methodsFor: 'scanning' stamp: 'AlainPlantec 3/17/2013 15:17'!
handleIndentation
	self indentationLevel timesRepeat: [
		self plainTab]! !

!RubCharacterScanner methodsFor: 'text constants' stamp: 'AlainPlantec 3/26/2013 14:56'!
justified
	^ 3! !

!RubCharacterScanner methodsFor: 'private' stamp: 'AlainPlantec 3/17/2013 15:17'!
setConditionArray: aSymbol

	aSymbol == #paddedSpace ifTrue: [^stopConditions := PaddedSpaceCondition "copy"].
	"aSymbol == #space ifTrue: [^stopConditions := SpaceCondition copy]."
	aSymbol == nil ifTrue: [^stopConditions := NilCondition "copy"].
	self error: 'undefined stopcondition for space character'.
! !

!RubCharacterScanner methodsFor: 'scanning' stamp: 'AlainPlantec 3/17/2013 15:17'!
placeEmbeddedObject: anchoredMorph
	"Place the anchoredMorph or return false if it cannot be placed.
	In any event, advance destX by its width."
	| w |
	"Workaround: The following should really use #textAnchorType"
	anchoredMorph relativeTextAnchorPosition ifNotNil:[^true].
	destX := destX + (w := anchoredMorph width).
	(destX > rightMargin and: [(leftMargin + w) <= rightMargin])
		ifTrue: ["Won't fit, but would on next line"
				^ false].
	lastIndex := lastIndex + 1.
	
	^ true! !

!RubCharacterScanner methodsFor: 'multilingual scanning' stamp: 'AlainPlantec 3/17/2013 15:17'!
registerBreakableIndex

	"Record left x and character index of the line-wrappable point. 
	The default implementation here does nothing."

	^ false.
! !

!RubCharacterScanner methodsFor: 'scanning' stamp: 'AlainPlantec 5/18/2013 18:27'!
plainTab
	"This is the basic method of adjusting destX for a tab."
	destX := (alignment = self justified and: [self leadingTab not])
		ifTrue:		"embedded tabs in justified text are weird"
			[destX + (self tabWidth - (line justifiedTabDeltaFor: spaceCount)) max: destX]
		ifFalse: 
			[self nextTabXFrom: destX].
	pendingKernX := 0.! !

!RubCharacterScanner methodsFor: 'private' stamp: 'AlainPlantec 3/20/2013 06:10'!
setFont
	| priorFont |
	"Set the font and other emphasis."
	priorFont := font.
	text == nil
		ifFalse: [ 
			emphasisCode := 0.
			kern := 0.
			indentationLevel := 0.
			alignment := textStyle alignment.
			font := nil.
			(text attributesAt: lastIndex forStyle: textStyle) do: [ :att | att emphasizeScanner: self ] ].
	font == nil
		ifTrue: [ self setFont: textStyle defaultFontIndex ].
	font := font emphasized: emphasisCode.
	priorFont
		ifNotNil: [ 
			font = priorFont
				ifTrue: [ 
					"font is the same, perhaps the color has changed?
					We still want kerning between chars of the same
					font, but of different color. So add any pending kern to destX"
					destX := destX + (pendingKernX ifNil: [ 0 ]) ].
			destX := destX + priorFont descentKern ].
	pendingKernX := 0.	"clear any pending kern so there is no danger of it being added twice"
	destX := destX - font descentKern.	"NOTE: next statement should be removed when clipping works"
	leftMargin ifNotNil: [ destX := destX max: leftMargin ].
	kern := kern - font baseKern.	"Install various parameters from the font."
	spaceWidth := font widthOf: Character space.	"	map := font characterToGlyphMap."
	stopConditions := DefaultStopConditions! !

!RubCharacterScanner methodsFor: 'private' stamp: 'AlainPlantec 5/18/2013 23:15'!
text: t textStyle: ts 
	text := t.
	textStyle := ts! !

!RubCharacterScanner class methodsFor: 'class initialization' stamp: 'AlainPlantec 3/26/2013 14:47'!
initialize
"
	RubCharacterScanner initialize
"
	| a |
	a := RubTextStopConditions new.
	a at: 1 + 1 put: #embeddedObject.
	a at: Character tab asciiValue + 1 put: #tab.
	a at: Character cr asciiValue + 1 put: #cr.
	a at: Character lf asciiValue + 1 put: #cr.
	
	NilCondition := a copy.
	DefaultStopConditions := a copy.

	PaddedSpaceCondition := a copy.
	PaddedSpaceCondition at: Character space asciiValue + 1 put: #paddedSpace.
	
	SpaceCondition := a copy.
	SpaceCondition at: Character space asciiValue + 1 put: #space.
! !

!RubCodeSizeFeedback methodsFor: 'accessing' stamp: 'AlainPlantec 4/20/2013 22:09'!
normalColor
	^ Color transparent! !

!RubCodeSizeFeedback methodsFor: 'geometry' stamp: 'AlainPlantec 4/20/2013 22:02'!
extent: aPoint 
	self updateColor.
	super extent: aPoint! !

!RubCodeSizeFeedback methodsFor: 'drawing' stamp: 'AlainPlantec 4/22/2013 16:13'!
drawOn: aCanvas
	| font s |
	super drawOn: aCanvas.
	color = self normalColor
		ifTrue: [ ^ self ].
	font := self paragraph textStyle defaultFont.
	s := self textSize asString.
	aCanvas
		drawString: s
		in: (self bounds withTop: self bounds bottom - font height)
		font: font
		color: self stringColor! !

!RubCodeSizeFeedback methodsFor: 'private' stamp: 'AlainPlantec 4/18/2013 16:44'!
ignoredCharacters

	^ { Character space. Character tab. Character cr. $.. $;. $:. $'. $(. $) }! !

!RubCodeSizeFeedback methodsFor: 'event handling' stamp: 'AlainPlantec 2/6/2014 09:14'!
scrollerOffsetChanged
	self updateColor.
	super scrollerOffsetChanged! !

!RubCodeSizeFeedback methodsFor: 'private' stamp: 'AlainPlantec 4/19/2013 17:47'!
textSize
	| result count ignoredCharacters |
	result := 0.
	count := true.
	ignoredCharacters := self ignoredCharacters.
	self text string
		do: [ :char | 
			result > (self alertLimit * 3) 
				ifTrue: [ ^result ].
			(#($' $") includes: char)
				ifTrue: [ count := count not ]
				ifFalse: [ 
					((ignoredCharacters includes: char) not and: [ count ])
						ifTrue: [ result := result + 1 ] ] ].
	^ result! !

!RubCodeSizeFeedback methodsFor: 'private' stamp: 'AlainPlantec 4/20/2013 21:56'!
updateColor
	self color: self backgroundColor! !

!RubCodeSizeFeedback methodsFor: 'accessing' stamp: 'AlainPlantec 4/20/2013 12:26'!
stringColor
	| size |
	size := self textSize.
	self warningLimit negative ifTrue: [ ^ Color black ].
	^ size >= self warningLimit
			ifTrue: [
				size >= self alertLimit
					ifTrue: [ Color red ]
					ifFalse: [ Color orange ]]
			ifFalse: [ Color black ].! !

!RubCodeSizeFeedback methodsFor: 'accessing' stamp: 'AlainPlantec 4/20/2013 22:12'!
alertLimit

	^ 2 * self warningLimit! !

!RubCodeSizeFeedback methodsFor: 'accessing' stamp: 'AlainPlantec 4/20/2013 22:10'!
backgroundColor
	"Return the current fillStyle of the receiver."

	| basicColor size |
	basicColor := Color white.
	self paragraph ifNil: [ ^Color transparent ].
	size := self textSize.
	size >= self warningLimit
		ifTrue: [ 
			| returnedColor overshoot transitionSpan transitionColor |
			transitionSpan := self warningLimit.
			transitionColor := Color yellow mixed: 0.6 with: basicColor.
			size >= self alertLimit
				ifFalse: [ overshoot := size - self warningLimit ]
				ifTrue: [ 
					transitionSpan := self alertLimit - self warningLimit.
					basicColor := transitionColor mixed: 0.5 with: basicColor.
					transitionColor := (Color orange mixed: 0.5 with: Color red) mixed: 0.5 with: basicColor.
					overshoot := size - self alertLimit ].
			^ CompositeFillStyle
				fillStyles:
					{((GradientFillStyle
						ramp:
							{(0 -> transitionColor).
							(1 -> basicColor)})
						origin: (self bounds width / 2) asFloat @ self bounds bottom;
						direction: 0 @ (12 + (2 * self bounds height * overshoot / transitionSpan)) negated asFloat;
						normal: 0 @ 1;
						radial: false;
						yourself).
					((GradientFillStyle
						ramp:
							{(0 -> Color white).
							(0.3 -> (Color white alpha: 0.01))})
						origin: self bounds left @ (self bounds height / 2) asFloat;
						direction: self bounds width @ 0;
						normal: 1 @ 0;
						radial: false;
						yourself)} ].
	^ self normalColor! !

!RubCodeSizeFeedback methodsFor: 'accessing' stamp: 'AlainPlantec 4/20/2013 22:06'!
warningLimit

	^ 350! !

!RubCodeSizeFeedback methodsFor: 'event handling' stamp: 'AlainPlantec 2/6/2014 09:54'!
textChanged
	self updateColor.
	super textChanged! !

!RubCodeSizeFeedback methodsFor: 'accessing' stamp: 'AlainPlantec 4/22/2013 15:49'!
computedPositionFrom: aRectangle
	^  ((aRectangle right min: self scrollBounds right) - (self computedWidthFrom: aRectangle)) @ aRectangle top
! !

!RubCodeSizeFeedback methodsFor: 'accessing' stamp: 'AlainPlantec 4/22/2013 14:58'!
computedWidthFrom: aRectangle
	^  (super computedWidthFrom: aRectangle) min: 50.
! !

!RubCodeSizeFeedback methodsFor: 'defaults' stamp: 'AlainPlantec 4/20/2013 21:57'!
defaultBackgroundColor
	^ self backgroundColor ! !

!RubCodeSizeFeedback class methodsFor: 'querying' stamp: 'AlainPlantec 4/18/2013 13:45'!
key
	^ #codeSizeFeedback! !

!RubColumnDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 17:06'!
tabLineDashesColors 
	^ tabLineDashesColors ifNil: [tabLineDashesColors := {(self tabLineColor). (Color transparent)}].
! !

!RubColumnDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 17:06'!
tabLineDashes
	^ tabLineDashes ifNil: [tabLineDashes := {self tabLineWidth. self tabLineWidth}].
! !

!RubColumnDisplayer methodsFor: 'drawing' stamp: 'AlainPlantec 8/2/2013 17:04'!
drawOn: aCanvas
	| cwidth col dsh lw cw dc nb bnds gap |
	super drawOn: aCanvas.
	bnds := self bounds.
	cwidth := self width.
	cw := self tabWidth.
	gap := self offset x \\ cw .
	col := cw + self margins left.
	dsh := self tabLineDashes.
	dc := {(self tabLineColor). (Color transparent)}.
	lw := self tabLineWidth.
	nb := cwidth // cw.
	nb timesRepeat: [ 
			| b |
			b :=  (bnds topLeft + (col @ 0) ) corner: (bnds bottomLeft + ((col + lw) @ 0) ).
			b := b translateBy: (((cw - gap) - cw)@ 0).
			aCanvas
				frameRectangle: b
				width: 1
				colors: dc
				dashes: dsh.
			col := col + cw ]! !

!RubColumnDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 17:01'!
tabWidth
	^ self paragraph tabWidth! !

!RubColumnDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 17:00'!
tabWidth: anInteger
	self paragraph tabWidth: anInteger! !

!RubColumnDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 17:06'!
tabLineColor: aColor
	tabLineColor := aColor! !

!RubColumnDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 4/16/2013 23:41'!
font
	| textStyle |
	textStyle := self textStyle.
	^ textStyle fontAt: textStyle defaultFontIndex! !

!RubColumnDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 17:07'!
tabLineWidth
	^ tabLineWidth ifNil: [ tabLineWidth := 1 ]! !

!RubColumnDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 17:07'!
tabLineWidth: anInteger
	tabLineWidth := anInteger! !

!RubColumnDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 17:06'!
tabLineColor
	^ tabLineColor ifNil: [ tabLineColor := Color lightGray twiceLighter] ! !

!RubColumnDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 17:06'!
tabLineDashes: anArray
	 tabLineDashes := anArray
! !

!RubColumnDisplayer class methodsFor: 'querying' stamp: 'AlainPlantec 4/16/2013 23:16'!
key
	^ #column! !

!RubCompositionScanner methodsFor: 'scanning' stamp: 'AlainPlantec 3/17/2013 15:19'!
setActualFont: aFont
	"Keep track of max height and ascent for auto lineheight"
	| descent |
	super setActualFont: aFont.
	"'   ', lastIndex printString, '   ' displayAt: (lastIndex * 15)@0."
	lineHeight == nil
		ifTrue: [descent := font descent.
				baseline := font ascent.
				lineHeight := baseline + descent]
		ifFalse: [descent := lineHeight - baseline max: font descent.
				baseline := baseline max: font ascent.
				lineHeight := lineHeight max: baseline + descent]! !

!RubCompositionScanner methodsFor: 'stop conditions' stamp: 'AlainPlantec 3/26/2013 14:47'!
cr
	"Answer true. Set up values for the text line interval currently being 
	composed."

	pendingKernX := 0.
	(lastIndex < text size and: [(text at: lastIndex) = Character cr  and: [(text at: lastIndex+1) = Character lf]]) ifTrue: [lastIndex := lastIndex + 1].
	line stop: lastIndex.
	spaceX := destX.
	line paddingWidth: rightMargin - spaceX.
	^true! !

!RubCompositionScanner methodsFor: 'stop conditions' stamp: 'AlainPlantec 5/18/2013 18:28'!
tab
	"Advance destination x according to tab settings in the paragraph's 
	textStyle. Answer whether the character has crossed the right edge of 
	the composition rectangle of the paragraph."

	pendingKernX := 0.
	destX := self nextTabXFrom: destX.
	destX > rightMargin ifTrue:	[^self crossedX].
	lastIndex := lastIndex + 1.
	^false
! !

!RubCompositionScanner methodsFor: 'stop conditions' stamp: 'AlainPlantec 3/19/2013 18:04'!
endOfRun
	"Answer true if scanning has reached the end of the paragraph. 
	Otherwise step conditions (mostly install potential new font) and answer 
	false."

	| runLength |
	lastIndex = text size
	ifTrue:	[line stop: lastIndex.
			spaceX := destX.
			line paddingWidth: rightMargin - destX.
			^true]
	ifFalse:	[
			"(text at: lastIndex) charCode = 32 ifTrue: [destX := destX + spaceWidth]."
			runLength := (text runLengthFor: (lastIndex := lastIndex + 1)).
			runStopIndex := lastIndex + (runLength - 1).
			self setStopConditions.
			^false]
! !

!RubCompositionScanner methodsFor: 'stop conditions' stamp: 'AlainPlantec 3/17/2013 15:19'!
setStopConditions
	"Set the font and the stop conditions for the current run."
	
	self setFont! !

!RubCompositionScanner methodsFor: 'stop conditions' stamp: 'AlainPlantec 3/19/2013 18:05'!
placeEmbeddedObject: anchoredMorph
	| descent |
	"Workaround: The following should really use #textAnchorType"
	anchoredMorph relativeTextAnchorPosition ifNotNil:[^true].
	(super placeEmbeddedObject: anchoredMorph) ifFalse: ["It doesn't fit"
		"But if it's the first character then leave it here"
		lastIndex < line first ifFalse:[
			line stop: lastIndex-1.
			^ false]].
	descent := lineHeight - baseline.
	lineHeight := lineHeight max: anchoredMorph height.
	baseline := lineHeight - descent.
	line stop: lastIndex.
	^ true! !

!RubCompositionScanner methodsFor: 'multilingual scanning' stamp: 'AlainPlantec 3/17/2013 15:19'!
registerBreakableIndex

	"Record left x and character index of the line-wrappable point. 
	Used for wrap-around. Answer whether the character has crossed the 
	right edge of the composition rectangle of the paragraph."

	(text at: lastIndex) = Character space ifTrue: [
		breakAtSpace := true.
		spaceX := destX.
		spaceCount := spaceCount + 1.
		lineHeightAtBreak := lineHeight.
		baselineAtBreak := baseline.
		breakableIndex := lastIndex.
		destX > rightMargin ifTrue: 	[^self crossedX].
	] ifFalse: [
		breakAtSpace := false.
		lineHeightAtBreak := lineHeight.
		baselineAtBreak := baseline.
		breakableIndex := lastIndex - 1.
	].
	^ false.
! !

!RubCompositionScanner methodsFor: 'stop conditions' stamp: 'AlainPlantec 3/26/2013 15:03'!
crossedX
	"There is a word that has fallen across the right edge of the composition 
	rectangle. This signals the need for wrapping which is done to the last 
	space that was encountered, as recorded by the space stop condition."

	pendingKernX := 0.
	breakAtSpace ifTrue: [
		spaceCount >= 1 ifTrue:
			["The common case. First back off to the space at which we wrap."
			line stop: breakableIndex.
			lineHeight := lineHeightAtBreak.
			baseline := baselineAtBreak.
			spaceCount := spaceCount - 1.
			breakableIndex := breakableIndex - 1.

			"Check to see if any spaces preceding the one at which we wrap.
				Double space after punctuation, most likely."
			[(spaceCount > 1 and: [(text at: breakableIndex) = Character space])]
				whileTrue:
					[spaceCount := spaceCount - 1.
					"Account for backing over a run which might
						change width of space."
					font := text fontAt: breakableIndex withStyle: textStyle.
					breakableIndex := breakableIndex - 1.
					spaceX := spaceX - (font widthOf: Character space)].
			line paddingWidth: rightMargin - spaceX.
			line internalSpaces: spaceCount]
		ifFalse:
			["Neither internal nor trailing spaces -- almost never happens."
			lastIndex := lastIndex - 1.
			[destX <= rightMargin]
				whileFalse:
					[destX := destX - (font widthOf: (text at: lastIndex)).
					lastIndex := lastIndex - 1].
			spaceX := destX.
			line paddingWidth: rightMargin - destX.
			line stop: (lastIndex max: line first)].
		^true
	].

	(breakableIndex isNil or: [breakableIndex < line first]) ifTrue: [
		"Any breakable point in this line.  Just wrap last character."
		breakableIndex := lastIndex - 1.
		lineHeightAtBreak := lineHeight.
		baselineAtBreak := baseline.
	].

	"It wasn't a space, but anyway this is where we break the line."
	line stop: breakableIndex.
	lineHeight := lineHeightAtBreak.
	baseline := baselineAtBreak.
	^ true.
! !

!RubCompositionScanner methodsFor: 'stop conditions' stamp: 'AlainPlantec 3/21/2013 09:25'!
setFont
	super setFont.
	breakAtSpace := false! !

!RubCompositionScanner methodsFor: 'scanning' stamp: 'AlainPlantec 4/2/2013 13:38'!
composeFrom: startIndex inRectangle: lineRectangle firstLine: firstLine leftSide: leftSide rightSide: rightSide
	"Answer an instance of TextLineInterval that represents the next line in the paragraph."
	| runLength stopCondition |
	"Set up margins"
	leftMargin := lineRectangle left.
	leftSide ifTrue: [leftMargin := leftMargin +
						(firstLine ifTrue: [textStyle firstIndent]
								ifFalse: [textStyle restIndent])].
	destX := spaceX := leftMargin.
	firstDestX := destX.
	rightMargin := lineRectangle right.
	rightSide ifTrue: [rightMargin := rightMargin - textStyle rightIndent].
	lastIndex := startIndex.	"scanning sets last index"
	destY := lineRectangle top.
	lineHeight := baseline := 0.  "Will be increased by setFont"
	self setStopConditions.	"also sets font"
	runLength := text runLengthFor: startIndex.
	runStopIndex := (lastIndex := startIndex) + (runLength - 1).
	line := (RubTextLine start: lastIndex stop: 0 internalSpaces: 0 paddingWidth: 0)
				rectangle: lineRectangle.
	spaceCount := 0.
	self handleIndentation.
	leftMargin := destX.
	line leftMargin: leftMargin.

	[false]
		whileFalse: 
			[stopCondition := self scanCharactersFrom: lastIndex to: runStopIndex
				in: text string rightX: rightMargin stopConditions: stopConditions
				kern: kern.
			"See setStopConditions for stopping conditions for composing."
			line stopCondition: stopCondition.
			(self perform: stopCondition)
				ifTrue: [^ line lineHeight: lineHeight + textStyle leading baseline: baseline + textStyle leading]]! !

!RubCompositionScanner methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:19'!
rightX
	"Meaningful only when a line has just been composed -- refers to the 
	line most recently composed. This is a subtrefuge to allow for easy 
	resizing of a composition rectangle to the width of the maximum line. 
	Useful only when there is only one line in the form or when each line 
	is terminated by a carriage return. Handy for sizing menus and lists."

	breakAtSpace ifTrue: [^ spaceX].

	^ destX.
! !

!RubConfigurationChange methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 10:46'!
configurationBlock: aBlockWithAScrolledTextMorphAsArgument
	configurationBlock := aBlockWithAScrolledTextMorphAsArgument! !

!RubConfigurationChange methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 10:46'!
configurationBlock
	^ configurationBlock ifNil: [ configurationBlock := [ :scrolledTextMorph | ] ]! !

!RubCurrentLineBarDecorator methodsFor: 'drawing' stamp: 'AlainPlantec 2/26/2015 20:41'!
drawOnAthensCanvas
	| line bnd |
	super drawOnAthensCanvas.
	self selectionStart = self selectionStop ifFalse: [^self].
	line := self selectionStart textLine.
	bnd := (line topLeft - (self margins left @ 0)) corner: ((line bottomRight + (self margins right @ 0)) min: self clippedRectangle bottomRight).
	canvas setPaint: self selectionBarColor.
	canvas setShape: bnd.
	canvas draw 
! !

!RubCurrentLineBarDecorator methodsFor: 'drawing' stamp: 'AlainPlantec 5/14/2013 16:10'!
draw
	| line bnd |
	super draw.
	self selectionStart = self selectionStop ifFalse: [^self].
	line := self selectionStart textLine.
	bnd := (line topLeft - (self margins left @ 0)) corner: (line bottomRight + (self margins right @ 0)).
	canvas fillRectangle: bnd color: self selectionBarColor! !

!RubCurrentLineBarDecorator methodsFor: 'accessing' stamp: 'AlainPlantec 4/11/2013 14:11'!
selectionBarColor
	^ self theme selectionBarColor! !

!RubCurrentLineBarDecorator class methodsFor: 'querying' stamp: 'AlainPlantec 4/16/2013 14:49'!
key
	^ #selectionBar! !

!RubCursor methodsFor: 'initialize' stamp: 'AlainPlantec 4/22/2013 10:01'!
defaultColor 
	^ Color transparent! !

!RubCursor methodsFor: 'structure' stamp: 'AlainPlantec 4/22/2013 20:17'!
topRendererOrSelf
	^owner topRendererOrSelf! !

!RubCursor methodsFor: 'accessing' stamp: 'AlainPlantec 2/6/2014 14:29'!
period
	^ period ifNil: [ period := self class period ]! !

!RubCursor methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:34'!
textArea
	^ owner! !

!RubCursor methodsFor: 'blinking' stamp: 'AlainPlantec 4/25/2013 20:41'!
removeAlarm
	self world
		ifNotNil: [ :wld | 
			wld removeAlarm: #hideShow for: self ] ! !

!RubCursor methodsFor: 'accessing' stamp: 'AndreiChis 3/24/2015 19:09'!
visibleCursorColor
	self class cursorWithFixedColor 
		ifTrue: [ ^ self class defaultColor ].
	^ visibleCursorColor ifNil: [ self defaultVisibleCursorColor ] ! !

!RubCursor methodsFor: 'blinking' stamp: 'AlainPlantec 6/2/2013 15:53'!
beVisible
	self color = self invisibleCursorColor
		ifTrue: [ self color: self actualCursorColor ]! !

!RubCursor methodsFor: 'private - layout' stamp: 'AlainPlantec 2/6/2014 14:45'!
updateBounds
	| x line |
	self textArea ifNil: [ ^self ].
	line := self textArea selectionStop textLine.
	x := self textArea selectionStop left.
	self position: x @ line top.
	self extent: self class defaultWidth @ (line height + 1)! !

!RubCursor methodsFor: 'initialize' stamp: 'AlainPlantec 4/22/2013 10:27'!
defaultBounds
	^ 0 @ 0 corner: 0 @ 0! !

!RubCursor methodsFor: 'blinking' stamp: 'AlainPlantec 2/6/2014 14:30'!
hideShow
	self textArea canChangeText 
		ifFalse: [ ^ self beNotVisible ].
	self stayVisible 
		ifTrue: [ ^ self beVisible ].
	self isBlinkingCursor
		ifTrue: [ 
			self switchColor.
			self addAlarm ]
		ifFalse: [ self beVisible ]! !

!RubCursor methodsFor: 'blinking' stamp: 'AlainPlantec 6/2/2013 15:55'!
switchColor
	self color = self invisibleCursorColor
		ifTrue: [ self color: self actualCursorColor ]
		ifFalse: [ self beNotVisible ].
! !

!RubCursor methodsFor: 'accessing' stamp: 'AlainPlantec 6/2/2013 23:01'!
actualCursorColor
	self textArea readOnly ifTrue: [ ^Color transparent ].
	^ (self textArea hasFocus and: [ self stayVisible not ])
		ifFalse: [ self invisibleCursorColor ]
		ifTrue: [ self visibleCursorColor ]! !

!RubCursor methodsFor: 'event handling' stamp: 'AlainPlantec 2/5/2014 14:25'!
whenTextAreaSelectionChanged: anAnnouncement
	self updateBounds.
	self updateVisibility ! !

!RubCursor methodsFor: 'submorphs-accessing' stamp: 'AlainPlantec 2/6/2014 14:32'!
noteNewOwner: aMorph 
	super noteNewOwner: aMorph.
	self textArea announcer subscribe: MorphGotFocus send: #whenGotFocus: to: self.
	self textArea announcer subscribe: MorphLostFocus send: #whenLostFocus: to: self.
	self textArea announcer subscribe: RubSelectionChanged send: #whenTextAreaSelectionChanged: to: self.
	self textArea announcer subscribe: RubTextStyleChanged send: #whenTextAreaTextStyleChanged: to: self.
! !

!RubCursor methodsFor: 'initialize' stamp: 'AndreiChis 3/26/2015 17:23'!
defaultVisibleCursorColor
	^ self theme textColor! !

!RubCursor methodsFor: 'blinking' stamp: 'AlainPlantec 5/7/2013 13:49'!
startBlinking
	self beVisible.
	self ensureFor: 1000! !

!RubCursor methodsFor: 'initialize' stamp: 'AlainPlantec 2/6/2014 14:22'!
aboutToBeRemoved
	self beNotVisible.
	self removeAlarm.
	self textArea announcer unsubscribe: self! !

!RubCursor methodsFor: 'blinking' stamp: 'AlainPlantec 5/7/2013 09:34'!
ensureFor: millisecs
	self removeAlarm.
	self beVisible.
	self textArea canChangeText
		ifTrue: [ self addAlarmAt: millisecs ]! !

!RubCursor methodsFor: 'blinking' stamp: 'AlainPlantec 2/6/2014 14:30'!
isBlinkingCursor
	^ self period > 0! !

!RubCursor methodsFor: 'accessing' stamp: 'AlainPlantec 6/2/2013 23:02'!
invisibleCursorColor
	^ invisibleCursorColor ifNil: [ invisibleCursorColor := Color transparent ]! !

!RubCursor methodsFor: 'event handling' stamp: 'AlainPlantec 4/25/2013 20:41'!
whenLostFocus: anAnnouncement
	self stayVisible
		ifFalse: [ 
			self removeAlarm.
			self beNotVisible ]! !

!RubCursor methodsFor: 'event handling' stamp: 'AlainPlantec 5/21/2013 18:03'!
whenGotFocus: anAnnouncement
	self updateBounds.
	self updateVisibility ! !

!RubCursor methodsFor: 'adding' stamp: 'AlainPlantec 2/6/2014 14:26'!
addAlarm

	self addAlarmAt: self period! !

!RubCursor methodsFor: 'accessing' stamp: 'AndreiChis 3/24/2015 19:10'!
visibleCursorColor: aColor
	visibleCursorColor := aColor! !

!RubCursor methodsFor: 'event handling' stamp: 'AlainPlantec 2/6/2014 14:30'!
updateVisibility
	(self textArea isNil or: [ self textArea canChangeText not ])
		ifTrue: [ ^ self beNotVisible ].
	self beVisible.
	self isBlinkingCursor
		ifTrue: [ self startBlinking ]
		ifFalse: [ self beVisible ].
	self changed! !

!RubCursor methodsFor: 'accessing' stamp: 'AlainPlantec 4/25/2013 20:49'!
stayVisible: aBoolean
	stayVisible := aBoolean.
	self color: self visibleCursorColor ! !

!RubCursor methodsFor: 'event handling' stamp: 'AlainPlantec 2/5/2014 14:27'!
whenTextAreaTextStyleChanged: anAnnouncement
	self updateBounds.
! !

!RubCursor methodsFor: 'private' stamp: 'AlainPlantec 5/7/2013 09:34'!
unplug
	self removeAlarm.
	self textArea announcer unsubscribe: self.
	super unplug! !

!RubCursor methodsFor: 'accessing' stamp: 'AlainPlantec 4/25/2013 20:29'!
stayVisible
	^ stayVisible ifNil: [ stayVisible := false ]! !

!RubCursor methodsFor: 'blinking' stamp: 'AlainPlantec 6/2/2013 15:53'!
beNotVisible
	self color = self invisibleCursorColor
		ifFalse: [ self color: self invisibleCursorColor ]! !

!RubCursor methodsFor: 'adding' stamp: 'AlainPlantec 5/7/2013 10:48'!
addAlarmAt: millisecs
	self removeAlarm.
	(self stayVisible not and: [ self textArea hasFocus ])
		ifFalse: [ ^ self ].
	self world
		ifNotNil: [ :wld | 
			wld
				addAlarm: #hideShow
				withArguments: #()
				for: self
				at: Time millisecondClockValue + millisecs ]! !

!RubCursor class methodsFor: 'accessing' stamp: 'AlainPlantec 2/6/2014 14:57'!
defaultColor: aColor
	DefaultColor := aColor! !

!RubCursor class methodsFor: 'accessing' stamp: 'AlainPlantec 2/6/2014 15:01'!
defaultColor
	^ DefaultColor ifNil: [ DefaultColor := Color lightGray ]! !

!RubCursor class methodsFor: 'accessing' stamp: 'AlainPlantec 2/6/2014 15:02'!
cursorWithFixedColor
	^ FixedColor ifNil: [ FixedColor := false ]! !

!RubCursor class methodsFor: 'accessing' stamp: 'AlainPlantec 2/6/2014 14:28'!
period
	^ Period ifNil: [ Period :=  700 ] ! !

!RubCursor class methodsFor: 'accessing' stamp: 'AlainPlantec 2/6/2014 14:46'!
defaultWidth
	^ DefaultWidth ifNil: [ DefaultWidth := 2 ]! !

!RubCursor class methodsFor: 'settings' stamp: 'StephaneDucasse 11/11/2014 18:48'!
rubricSettingsOn: aBuilder
	<systemsettings>
	(aBuilder group: #'Rubric cursor')
		parent: #Rubric;
		label: 'Cursor';
		with: [ 
					(aBuilder setting: #cursorWithFixedColor)
						target: self;
						label: 'Fixed color';
						with: [ 
									(aBuilder setting: #defaultColor)
										target: self;
										description: 'The cursolr color color';
										label: 'Color'  ].
					(aBuilder range: #defaultWidth)
						target: self;
						label: 'Width';
						description: 'Specify the cursor width';
						range: (1 to: 4).
					(aBuilder range: #period)
						target: self;
						label: 'Blinking period';
						description:
								'Specify the cursor blinking period in milliseconds. If it is set to zero then the cursor will not blink' translated;
						range: (0 to: 1000) ]! !

!RubCursor class methodsFor: 'accessing' stamp: 'AlainPlantec 2/6/2014 14:33'!
period: anInteger
	Period :=  anInteger! !

!RubCursor class methodsFor: 'accessing' stamp: 'AlainPlantec 2/6/2014 15:08'!
cursorWithFixedColor: aBoolean
	FixedColor := aBoolean! !

!RubCursor class methodsFor: 'accessing' stamp: 'AlainPlantec 2/6/2014 14:46'!
defaultWidth: anInteger
	DefaultWidth := anInteger! !

!RubDisplayScanner methodsFor: 'scanning' stamp: 'AlainPlantec 4/5/2013 14:07'!
displayLine: textLine offset: offset leftInRun: leftInRun
	"The call on the primitive (scanCharactersFrom:to:in:rightX:) will be interrupted according to an array of stop conditions passed to the scanner at which time the code to handle the stop condition is run and the call on the primitive continued until a stop condition returns true (which means the line has terminated).  leftInRun is the # of characters left to scan in the current run; when 0, it is time to call setStopConditions."
	| stopCondition nowLeftInRun startIndex string lastPos |
	line := textLine.
	morphicOffset := offset.
	lineY := line top + offset y.
	lineHeight := line lineHeight.
	rightMargin := line rightMargin + offset x.
	lastIndex := line first.
	leftInRun <= 0 ifTrue: [self setStopConditions].
	leftMargin := (line leftMarginForAlignment: alignment) + offset x.
	destX := runX := leftMargin.
	fillBlt == nil ifFalse:
		["Not right"
		fillBlt destX: line left destY: lineY
			width: line width height: lineHeight; copyBits].
	lastIndex := line first.
	leftInRun <= 0
		ifTrue: [nowLeftInRun := text runLengthFor: lastIndex]
		ifFalse: [nowLeftInRun := leftInRun].
	baselineY := lineY + line baseline.
	destY := baselineY - font ascent.
	runStopIndex := lastIndex + (nowLeftInRun - 1) min: line last.
	spaceCount := 0.
	string := text string.
	[
		startIndex := lastIndex.
		lastPos := destX@destY.
		stopCondition := self scanCharactersFrom: lastIndex to: runStopIndex
						in: string rightX: rightMargin stopConditions: stopConditions
						kern: kern.
		lastIndex >= startIndex ifTrue:[
			bitBlt displayString: string 
				from: startIndex 
	"XXXX: The following is an interesting bug. All stopConditions exept #endOfRun
		have lastIndex past the last character displayed. #endOfRun sets it *on* the character.
		If we display up until lastIndex then we will also display invisible characters like
		CR and tab. This problem should be fixed in the scanner (i.e., position lastIndex
		consistently) but I don't want to deal with the fallout right now so we keep the
		fix minimally invasive."
				to: (stopCondition == #endOfRun ifTrue:[lastIndex] ifFalse:[lastIndex-1])
				at: lastPos kern: kern baselineY: baselineY font: font].
		(emphasisCode allMask: 4) ifTrue:[
			font displayUnderlineOn: bitBlt from: lastPos x@baselineY to: destX@baselineY.
		].
		(emphasisCode allMask: 16) ifTrue:[
			font displayStrikeoutOn: bitBlt from: lastPos x@baselineY to: destX@baselineY.
		].
		"see setStopConditions for stopping conditions for displaying."
		self perform: stopCondition.
		"or: [lastIndex > runStopIndex]."
	] whileFalse.
	^ runStopIndex - lastIndex   "Number of characters remaining in the current run"! !

!RubDisplayScanner methodsFor: 'stop conditions' stamp: 'AlainPlantec 12/8/2014 17:35'!
setPort: aBitBlt
	"Install the BitBlt to use"
	bitBlt := aBitBlt.
	bitBlt sourceX: 0; width: 0.	"Init BitBlt so that the first call to a primitive will not fail"
	bitBlt sourceForm: nil. "Make sure font installation won't be confused"
! !

!RubDisplayScanner methodsFor: 'stop conditions' stamp: 'AlainPlantec 12/8/2014 17:40'!
setFont 
	super setFont.  "Sets font and emphasis bits, and maybe foregroundColor"
	font installOn: bitBlt foregroundColor: foregroundColor backgroundColor: Color transparent.
	text ifNotNil:[
		baselineY := lineY + line baseline.
		destY := baselineY - font ascent].
! !

!RubDisplayScanner methodsFor: 'stop conditions' stamp: 'AlainPlantec 3/17/2013 15:20'!
crossedX
	"This condition will sometimes be reached 'legally' during display, when, 
	for instance the space that caused the line to wrap actually extends over 
	the right boundary. This character is allowed to display, even though it 
	is technically outside or straddling the clipping ectangle since it is in 
	the normal case not visible and is in any case appropriately clipped by 
	the scanner."

	^ true ! !

!RubDisplayScanner methodsFor: 'stop conditions' stamp: 'AlainPlantec 3/17/2013 15:20'!
tab
	self plainTab.
	lastIndex := lastIndex + 1.
	^ false! !

!RubDisplayScanner methodsFor: 'displaying' stamp: 'AlainPlantec 12/8/2014 17:33'!
displayEmbeddedForm: aForm

	aForm 
		displayOn: bitBlt destForm 
		at: destX @ (lineY + line baseline - aForm height)
		clippingBox: bitBlt clipRect
		rule: Form blend
		fillColor: Color white! !

!RubDisplayScanner methodsFor: 'private' stamp: 'AlainPlantec 3/17/2013 15:20'!
presentationText: t

	text := t.
! !

!RubDisplayScanner methodsFor: 'private' stamp: 'AlainPlantec 3/17/2013 15:20'!
textColor: textColor
	ignoreColorChanges ifTrue: [^ self].
	foregroundColor := textColor! !

!RubDisplayScanner methodsFor: 'stop conditions' stamp: 'AlainPlantec 3/17/2013 15:20'!
endOfRun
	"The end of a run in the display case either means that there is actually 
	a change in the style (run code) to be associated with the string or the 
	end of this line has been reached."
	| runLength |
	lastIndex = line last ifTrue: [^true].
	runX := destX.
	runLength := text runLengthFor: (lastIndex := lastIndex + 1).
	runStopIndex := lastIndex + (runLength - 1) min: line last.
	self setStopConditions.
	^ false! !

!RubDisplayScanner methodsFor: 'stop conditions' stamp: 'AlainPlantec 12/8/2014 17:34'!
setDestForm: df
	bitBlt setDestForm: df.! !

!RubDisplayScanner methodsFor: 'stop conditions' stamp: 'AlainPlantec 3/26/2013 14:58'!
setStopConditions
	"Set the font and the stop conditions for the current run."
	
	self setFont.
	self setConditionArray: (alignment = self justified ifTrue: [#paddedSpace]).

"
	alignment = self justified ifTrue: [
		stopConditions == DefaultStopConditions 
			ifTrue:[stopConditions := stopConditions copy].
		stopConditions at: Character space asciiValue + 1 put: #paddedSpace]
"! !

!RubDisplayScanner methodsFor: 'displaying' stamp: 'AlainPlantec 12/8/2014 17:34'!
displayString: string from: startIndex to: stopIndex at: aPoint
	font displayString: string on: bitBlt 
		from: startIndex 
		to: stopIndex 
		at: aPoint kern: kern! !

!RubDisplayScanner methodsFor: 'stop conditions' stamp: 'AlainPlantec 3/17/2013 15:20'!
paddedSpace
	"Each space is a stop condition when the alignment is right justified. 
	Padding must be added to the base width of the space according to 
	which space in the line this space is and according to the amount of 
	space that remained at the end of the line when it was composed."

	spaceCount := spaceCount + 1.
	destX := destX + spaceWidth + (line justifiedPadFor: spaceCount  font: font).
	lastIndex := lastIndex + 1.
	pendingKernX := 0.
	^ false! !

!RubDisplayScanner methodsFor: 'private' stamp: 'AlainPlantec 3/20/2013 05:27'!
text: t textStyle: ts foreground: foreColor background: backColor fillBlt: blt ignoreColorChanges: shadowMode
	text := t.
	textStyle := ts. 
	foregroundColor := foreColor.
	(backgroundColor := backColor) isTransparent ifFalse:
		[fillBlt := blt.
		fillBlt fillColor: backgroundColor].
	ignoreColorChanges := shadowMode! !

!RubDisplayScanner methodsFor: 'scanning' stamp: 'AlainPlantec 3/25/2013 21:33'!
placeEmbeddedObject: anchoredMorph
	anchoredMorph relativeTextAnchorPosition ifNotNil:[
		anchoredMorph position: 
			anchoredMorph relativeTextAnchorPosition +
			(anchoredMorph owner bounds origin x @ 0)
			- (0@morphicOffset y) + (0@lineY).
		^true
	].
	(super placeEmbeddedObject: anchoredMorph) ifFalse: [^ false].
	anchoredMorph isMorph ifTrue: [
		anchoredMorph position: ((destX - anchoredMorph width)@lineY) - morphicOffset
	] ifFalse: [
		destY := lineY.
		baselineY := lineY + anchoredMorph height..
		runX := destX.
		anchoredMorph 
			displayOn: bitBlt destForm 
			at: destX - anchoredMorph width @ destY
			clippingBox: bitBlt clipRect
			rule: Form blend
			fillColor: Color white 
	].
	^ true! !

!RubDisplayScanner methodsFor: 'private' stamp: 'AlainPlantec 4/5/2013 14:01'!
backgroundColor: aColor
	ignoreColorChanges ifTrue: [^ self].
	backgroundColor := aColor! !

!RubDisplayScanner methodsFor: 'multilingual scanning' stamp: 'AlainPlantec 3/17/2013 15:20'!
isBreakableAt: index in: sourceString in: encodingClass

	^ false.
! !

!RubDisplayScanner methodsFor: 'displaying' stamp: 'AlainPlantec 12/8/2014 17:34'!
fillTextBackground
	fillBlt == nil ifFalse:
		["Not right"
		fillBlt destX: line left destY: lineY
			width: line width left height: line lineHeight; copyBits].! !

!RubDisplayScanner methodsFor: 'stop conditions' stamp: 'AlainPlantec 3/26/2013 14:47'!
cr
	"When a carriage return is encountered, simply increment the pointer 
	into the paragraph."

	pendingKernX := 0.
	(lastIndex < text size and: [(text at: lastIndex) = Character cr  and: [(text at: lastIndex+1) = Character lf]])
		ifTrue: [lastIndex := lastIndex + 2]
		ifFalse: [lastIndex := lastIndex + 1].
	^false! !

!RubDisplayScanner methodsFor: 'stop conditions' stamp: 'AlainPlantec 12/8/2014 17:34'!
plainTab
	| nextDestX |
 	nextDestX := super plainTab.
	fillBlt == nil ifFalse:
		[fillBlt destX: destX destY: destY width: nextDestX - destX height: font height; copyBits].
	^nextDestX! !

!RubDisplayScanner class methodsFor: 'queries' stamp: 'AlainPlantec 3/17/2013 15:20'!
defaultFont
	^ TextStyle defaultFont! !

!RubEditingArea methodsFor: 'accessing' stamp: 'AlainPlantec 5/17/2013 22:58'!
editorClass: aClass
	editorClass := aClass! !

!RubEditingArea methodsFor: 'accessing decorators' stamp: 'AlainPlantec 5/7/2013 23:15'!
withSecondarySelection
	self withDecoratorNamed: #secondarySelection! !

!RubEditingArea methodsFor: 'public accessing' stamp: 'AlainPlantec 5/7/2013 22:54'!
beNotWrapped
	self wrapped
		ifTrue: [ self handleParagraphChange: [ self wrapped: false ] ]! !

!RubEditingArea methodsFor: 'accessing decorators' stamp: 'AlainPlantec 5/7/2013 23:16'!
withoutSelectionBar
	self withoutDecoratorNamed: #selectionBar! !

!RubEditingArea methodsFor: 'event handling' stamp: 'AlainPlantec 5/14/2013 11:27'!
autoScroll: anEvent
	scrollPane ifNil: [ ^self ].
	self scrollPivot  ifNil: [ ^self ].
	scrollPane scrollWhenMouseMove: anEvent pivotPoint: self scrollPivot! !

!RubEditingArea methodsFor: 'settings' stamp: 'AlainPlantec 5/7/2013 23:14'!
walkAlongDisplayedLine
	^ self class walkAlongDisplayedLine! !

!RubEditingArea methodsFor: 'accessing' stamp: 'AlainPlantec 5/17/2013 22:57'!
editorClass
	^ editorClass ifNil: [ editorClass := RubTextEditor ]! !

!RubEditingArea methodsFor: 'accessing decorators' stamp: 'AlainPlantec 5/7/2013 23:15'!
withSelectionBar
	self withDecoratorNamed: #selectionBar! !

!RubEditingArea methodsFor: 'highlighting' stamp: 'AndreiChis 1/13/2015 12:16'!
removeHighlightSegment

	(self getHighlightSegment)
		ifNotNil: [ :aSegment | aSegment delete ].! !

!RubEditingArea methodsFor: 'public accessing' stamp: 'AlainPlantec 3/17/2014 13:13'!
beForSmalltalkScripting
	self editingMode: RubSmalltalkScriptingMode new! !

!RubEditingArea methodsFor: 'highlighting' stamp: 'AndreiChis 1/12/2015 22:38'!
getHighlightSegment

	^ self segments detect: [ :each | each class = RubHighlightSegmentMorph ] ifNone: [ nil ]! !

!RubEditingArea methodsFor: 'error handling' stamp: 'AlainPlantec 5/17/2013 23:05'!
doesNotUnderstand: aMessage
	^ aMessage sendTo: self editingMode! !

!RubEditingArea methodsFor: 'accessing decorators' stamp: 'AlainPlantec 5/7/2013 23:16'!
withoutOpeningClosingDelimitersHighlight
	self withoutDecoratorNamed: #openingClosingDelimitersHighlight! !

!RubEditingArea methodsFor: 'initialize-release' stamp: 'AlainPlantec 3/17/2014 10:41'!
beForPlainText
	self editingMode: RubPlainTextMode new! !

!RubEditingArea methodsFor: 'highlighting' stamp: 'AndreiChis 1/12/2015 22:41'!
hasHighlightSegment

	^ self getHighlightSegment notNil! !

!RubEditingArea methodsFor: 'private' stamp: 'AlainPlantec 5/21/2013 09:35'!
newParagraph
	^ RubCurrentLineBarDecorator	next: (RubExtraSelectionDecorator next: super newParagraph)! !

!RubEditingArea methodsFor: 'accessing' stamp: 'AlainPlantec 5/14/2013 11:23'!
wrapped
	^ wrapped ifNil: [ wrapped := false ] ! !

!RubEditingArea methodsFor: 'highlighting' stamp: 'AndreiChis 1/13/2015 12:16'!
ensureAndGetNewHighlightSegmentFrom: startIndex to: stopIndex
	
	^ self 
		removeHighlightSegment;
		addSegment: (RubHighlightSegmentMorph from: startIndex to: stopIndex)! !

!RubEditingArea methodsFor: 'as yet unclassified' stamp: 'AndreiChis 5/7/2014 17:39'!
bindingOf: aString
	^ self editingMode bindingOf: aString! !

!RubEditingArea methodsFor: 'event handling' stamp: 'AlainPlantec 5/7/2013 23:06'!
mouseMove: evt
	| editEvt |
	super mouseMove: evt.
	scrollPane ifNil: [ ^ self ].
	self scrollPivot: evt cursorPoint.
	editEvt := evt transformedBy: (self transformedFrom: scrollPane ) inverseTransformation.
	(editEvt position y between: scrollPane top and: scrollPane bottom)
		ifFalse: [
			self
				startStepping: #autoScroll:
				at: Time millisecondClockValue
				arguments: (Array with: evt)
				stepTime: 100	"fast enough" ]
		ifTrue: [ self stopSteppingSelector: #autoScroll: ]! !

!RubEditingArea methodsFor: 'initialize-release' stamp: 'AlainPlantec 3/17/2014 10:41'!
beForSmalltalkCode
	self editingMode: RubSmalltalkCodeMode new
! !

!RubEditingArea methodsFor: 'public accessing' stamp: 'AlainPlantec 5/7/2013 22:54'!
beWrapped
	self wrapped
		ifFalse: [ self handleParagraphChange: [ self wrapped: true ] ]! !

!RubEditingArea methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 23:17'!
wrapped: aBoolean
	wrapped := aBoolean! !

!RubEditingMode methodsFor: 'initialize-release' stamp: 'AlainPlantec 3/17/2014 13:01'!
updateTextAreaWhenUnplugged
! !

!RubEditingMode methodsFor: 'menu' stamp: 'AlainPlantec 5/21/2014 00:04'!
menu 
		"Answer the menu to be presented "

	^ (PragmaMenuBuilder pragmaKeyword: self menuKeyword  model: self textArea ) menu! !

!RubEditingMode methodsFor: 'menu' stamp: 'AlainPlantec 5/20/2014 23:28'!
menuKeyword
	^ self class menuKeyword! !

!RubEditingMode methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2014 12:15'!
editorClass
	^ RubTextEditor! !

!RubEditingMode methodsFor: 'accessing' stamp: 'AlainPlantec 5/17/2013 22:14'!
textArea
	^ textArea! !

!RubEditingMode methodsFor: 'accessing' stamp: 'AlainPlantec 5/17/2013 21:24'!
editor
	^self textArea editor! !

!RubEditingMode methodsFor: 'initialize-release' stamp: 'AlainPlantec 3/17/2014 12:29'!
updateTextAreaWhenPlugged
	| t |
	t := self textArea text copy.
	self textArea updateTextWith: ''.
	self textArea updateTextWith: t.
! !

!RubEditingMode methodsFor: 'accessing' stamp: 'AlainPlantec 5/17/2013 22:14'!
model
	^ self textArea model! !

!RubEditingMode methodsFor: 'accessing' stamp: 'AlainPlantec 5/18/2013 01:32'!
label
	^ self class label! !

!RubEditingMode methodsFor: 'accessing' stamp: 'AlainPlantec 5/17/2013 22:42'!
textArea: aTextArea
	textArea := aTextArea! !

!RubEditingMode methodsFor: 'initialize-release' stamp: 'AlainPlantec 3/17/2014 12:29'!
plugin: aTextArea 
	textArea := aTextArea.
	previousEditorClass := self textArea editorClass.
	previousEditorClass = self editorClass
		ifFalse: [ 
			self textArea editorClass: self editorClass.
			self textArea releaseEditor].
	self updateTextAreaWhenPlugged! !

!RubEditingMode methodsFor: 'initialize-release' stamp: 'AlainPlantec 3/17/2014 13:02'!
unplug
	previousEditorClass = self textArea editor class
		ifFalse: [ 
			self textArea editorClass: previousEditorClass.
			self textArea releaseEditor ].
	self updateTextAreaWhenUnplugged.
	textArea := nil.
! !

!RubEditingMode methodsFor: 'accessing' stamp: 'AlainPlantec 5/17/2013 22:16'!
textStyle
	^ self textArea textStyle! !

!RubEditingMode class methodsFor: 'accessing' stamp: 'AlainPlantec 5/20/2014 22:41'!
userManager
	^ (Smalltalk at: #UserManager ifAbsent: [ Smalltalk at: #UsersManager ]) default
! !

!RubEditingMode class methodsFor: 'menu' stamp: 'MarcusDenker 3/21/2015 09:24'!
extendedSearchMenuOn: aBuilder
	(aBuilder item: #'extendedSearch' translated)
		label: 'Code search...' translated;
		withSeparatorAfter;
		with: [ 
					(aBuilder item: #'browse it' translated)
						keyText: 'b';
						selector: #browseIt.
					(aBuilder item: #'senders of it' translated)
						keyText: 'n';
						selector: #sendersOfIt.
					(aBuilder item: #'implementors of it' translated)
						keyText: 'm';
						selector: #implementorsOfIt.
					(aBuilder item: #'references to it' translated)
						keyText: 'N';
						selector: #referencesToIt;
						withSeparatorAfter.
					(aBuilder item: #'selectors containing it' translated)
						keyText: 'W';
						selector: #methodNamesContainingIt.
					(aBuilder item: #'case insensitive method literal strings with it' translated)
						keyText: 'E';
						selector: #methodStringsContainingit.
					(aBuilder item: #'case sensitive method literal strings with it' translated)
						keyText: 'E';
						selector: #methodCaseSensitiveStringsContainingit.
					(aBuilder item: #'method source with it' translated)
						selector: #methodSourceContainingIt;
						withSeparatorAfter.
					(aBuilder item: #'class names containing it' translated) selector: #classNamesContainingIt.
					(aBuilder item: #'class comments with it' translated) selector: #classCommentsContainingIt ]! !

!RubEditingMode class methodsFor: 'menu' stamp: 'AlainPlantec 5/20/2014 22:44'!
menuKeyword
	^ self subclassResponsibility ! !

!RubEditingMode class methodsFor: 'accessing' stamp: 'AlainPlantec 5/20/2014 22:41'!
currentUser
	^ self userManager currentUser
! !

!RubEditingMode class methodsFor: 'keymap' stamp: 'AlainPlantec 5/20/2014 22:48'!
buildTabKeymapOn: aBuilder
	<keymap>
	! !

!RubEditingState methodsFor: 'accessing' stamp: 'AlainPlantec 4/25/2013 19:38'!
emphasisHere: aListOfTextAttribute
	emphasisHere := aListOfTextAttribute ifNotNil: [ :l | l reject: [ :a | RubTextSelectionColor = a class ] ]! !

!RubEditingState methodsFor: 'accessing' stamp: 'AlainPlantec 4/22/2013 10:48'!
markBlock: aCharacterBlock
	markBlock := aCharacterBlock! !

!RubEditingState methodsFor: 'accessing' stamp: 'AlainPlantec 4/22/2013 10:49'!
pointBlock: aCharacterBlock
	pointBlock := aCharacterBlock! !

!RubEditingState methodsFor: 'accessing' stamp: 'AlainPlantec 4/25/2013 18:52'!
scrollPivot: aPoint
	scrollPivot := aPoint! !

!RubEditingState methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 02:03'!
selectionStart
	^ self pointBlock ifNotNil: [:pb | pb min: self markBlock]! !

!RubEditingState methodsFor: 'undo-redo' stamp: 'AlainPlantec 3/22/2013 11:13'!
addUndoRecord: anUndoRecord
	self undoManager isPlugged 
		ifTrue: [self undoManager clearRedoHistory.
			self undoManager addRecord: anUndoRecord]

! !

!RubEditingState methodsFor: 'accessing' stamp: 'AlainPlantec 3/22/2013 11:13'!
startOfTyping
	^ startOfTyping! !

!RubEditingState methodsFor: 'accessing' stamp: 'AlainPlantec 3/22/2013 11:13'!
emphasisHere
	^ emphasisHere! !

!RubEditingState methodsFor: 'undo-redo' stamp: 'AlainPlantec 3/22/2013 11:13'!
redo
	^ self undoManager redo ! !

!RubEditingState methodsFor: 'undo-redo' stamp: 'AlainPlantec 3/22/2013 11:13'!
clearUndoManager: aKeyboardEvent
	self undoManager reset.
	^ true! !

!RubEditingState methodsFor: 'accessing' stamp: 'AlainPlantec 3/22/2013 11:13'!
startOfTyping: anIntegerIndex
	startOfTyping := anIntegerIndex! !

!RubEditingState methodsFor: 'accessing' stamp: 'AlainPlantec 3/22/2013 11:13'!
markBlock
	^ markBlock! !

!RubEditingState methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:44'!
paragraph
	^ textArea paragraph! !

!RubEditingState methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 02:04'!
selectionStop
	^ self pointBlock ifNotNil: [:pb | pb max: self markBlock]! !

!RubEditingState methodsFor: 'accessing' stamp: 'AlainPlantec 4/19/2013 14:33'!
previousInterval: anInterval

	previousInterval := anInterval.
! !

!RubEditingState methodsFor: 'accessing' stamp: 'AlainPlantec 3/22/2013 11:13'!
undoManager

	^ undoManager ifNil: [ undoManager := HistoryIterator new].
! !

!RubEditingState methodsFor: 'undo-redo' stamp: 'AlainPlantec 3/22/2013 11:13'!
undo
	^ self undoManager undo ! !

!RubEditingState methodsFor: 'accessing' stamp: 'AlainPlantec 5/17/2013 21:51'!
pointIndex
	^ self pointBlock ifNotNil: [:p | p stringIndex ] ifNil: [ 0 ]! !

!RubEditingState methodsFor: 'accessing' stamp: 'AlainPlantec 4/22/2013 10:48'!
markBlock: markCharacterBlock pointBlock: pointCharacterBlock
	markBlock := markCharacterBlock.
	pointBlock := pointCharacterBlock! !

!RubEditingState methodsFor: 'accessing' stamp: 'AlainPlantec 3/22/2013 11:13'!
previousInterval

	^ previousInterval ifNil: [previousInterval := 1 to: 0]! !

!RubEditingState methodsFor: 'undo-redo' stamp: 'AlainPlantec 3/22/2013 11:13'!
redoArray: doArray undoArray: undoArray
	self undoManager isPlugged 
		ifTrue: [self undoManager redoArray: doArray undoArray: undoArray]! !

!RubEditingState methodsFor: 'private-debugging' stamp: 'AlainPlantec 3/22/2013 11:13'!
exploreUndoManager: aKeyboardEvent
	self undoManager explore.
	^ true! !

!RubEditingState methodsFor: 'accessing' stamp: 'AlainPlantec 4/25/2013 18:55'!
hasFocus
	^ hasFocus ifNil: [ hasFocus := false ]! !

!RubEditingState methodsFor: 'accessing' stamp: 'AlainPlantec 4/25/2013 18:55'!
hasFocus: aBoolean
	hasFocus := aBoolean! !

!RubEditingState methodsFor: 'accessing' stamp: 'AlainPlantec 3/22/2013 11:13'!
pointBlock
	^ pointBlock! !

!RubEditingState methodsFor: 'accessing' stamp: 'AlainPlantec 4/25/2013 18:52'!
scrollPivot
	^ scrollPivot! !

!RubEditingState methodsFor: 'accessing' stamp: 'AlainPlantec 4/22/2013 10:49'!
markIndex: markIndex pointIndex: pointIndex
	markBlock := self paragraph characterBlockForIndex: markIndex.
	pointBlock := self paragraph characterBlockForIndex: pointIndex! !

!RubEditingState methodsFor: 'accessing' stamp: 'AlainPlantec 5/21/2013 09:51'!
textArea: aTextArea
	textArea := aTextArea.
! !

!RubEditingState methodsFor: 'accessing' stamp: 'AlainPlantec 3/22/2013 11:13'!
unselect
	self markBlock: self pointBlock copy! !

!RubEditingState methodsFor: 'undo-redo' stamp: 'AlainPlantec 4/19/2013 19:20'!
undoRedoTransaction: aBlock
	self undoManager openRecordGroup.
	aBlock ensure: [  self undoManager closeRecordGroup ].
! !

!RubEditingState methodsFor: 'accessing' stamp: 'AlainPlantec 5/17/2013 21:50'!
markIndex
	^ self markBlock ifNotNil: [:m | m stringIndex] ifNil: [ 1 ]
! !

!RubEditingState methodsFor: 'private' stamp: 'AlainPlantec 4/22/2013 10:50'!
unplug
	super unplug.
	undoManager
		ifNotNil: [ 
			undoManager reset.
			undoManager := nil ].
	 pointBlock := markBlock := startOfTyping := previousInterval := nil.! !

!RubEncryptedDisplayScanner methodsFor: 'scanning' stamp: 'AlainPlantec 3/17/2013 15:22'!
displayLine: textLine offset: offset leftInRun: leftInRun
	"The call on the primitive (scanCharactersFrom:to:in:rightX:) will be interrupted according to an array of stop conditions passed to the scanner at which time the code to handle the stop condition is run and the call on the primitive continued until a stop condition returns true (which means the line has terminated).  leftInRun is the # of characters left to scan in the current run; when 0, it is time to call setStopConditions."
	| stopCondition nowLeftInRun startIndex string lastPos |
	line := textLine.
	morphicOffset := offset.
	lineY := line top + offset y.
	lineHeight := line lineHeight.
	rightMargin := line rightMargin + offset x.
	lastIndex := line first.
	leftInRun <= 0 ifTrue: [self setStopConditions].
	leftMargin := (line leftMarginForAlignment: alignment) + offset x.
	destX := runX := leftMargin.
	fillBlt == nil ifFalse:
		["Not right"
		fillBlt destX: line left destY: lineY
			width: line width left height: lineHeight; copyBits].
	lastIndex := line first.
	leftInRun <= 0
		ifTrue: [nowLeftInRun := text runLengthFor: lastIndex]
		ifFalse: [nowLeftInRun := leftInRun].
	baselineY := lineY + line baseline.
	destY := baselineY - font ascent.
	runStopIndex := lastIndex + (nowLeftInRun - 1) min: line last.
	spaceCount := 0.
	string := String streamContents: [:s | 
		1 to: text string size do: [:i | s << '*']].
	[
		startIndex := lastIndex.
		lastPos := destX@destY.
		stopCondition := self scanCharactersFrom: lastIndex to: runStopIndex
						in: string rightX: rightMargin stopConditions: stopConditions
						kern: kern.
		lastIndex >= startIndex ifTrue:[
			bitBlt displayString: string 
				from: startIndex 
	"XXXX: The following is an interesting bug. All stopConditions exept #endOfRun
		have lastIndex past the last character displayed. #endOfRun sets it *on* the character.
		If we display up until lastIndex then we will also display invisible characters like
		CR and tab. This problem should be fixed in the scanner (i.e., position lastIndex
		consistently) but I don't want to deal with the fallout right now so we keep the
		fix minimally invasive."
				to: (stopCondition == #endOfRun ifTrue:[lastIndex] ifFalse:[lastIndex-1])
				at: lastPos kern: kern baselineY: baselineY font: font].
		"see setStopConditions for stopping conditions for displaying."
		self perform: stopCondition.
		"or: [lastIndex > runStopIndex]."
	] whileFalse.
	^ runStopIndex - lastIndex   "Number of characters remaining in the current run"! !

!RubExtraSelectionDecorator methodsFor: 'drawing' stamp: 'AlainPlantec 5/21/2013 16:01'!
computeFindReplaceShapesFrom: topLeft to: bottomRight
	| topLeftBlk |
	findReplaceShapes := nil.
	self findRegex ifNil: [ ^self ].
	topLeftBlk := self characterBlockAtPoint: topLeft.
	findReplaceRanges := ((self findRegex matchingRangesIn: (self visibleStringFrom: topLeft to: bottomRight))
		collect: [ :r | r + topLeftBlk stringIndex - 1 ]).
	findReplaceRanges do: [ :r | self text addAttribute: RubTextSelectionColor findReplaceSelection from: r first to: r last ].
	findReplaceShapes := findReplaceRanges
		collect: [ :r | 
			RubSurfaceSelectionShape
				vertices: (self verticesFrom: r first to: r last + 1)
				firstIndex: r first
				lastIndex: r last + 1
				color: (RubTextSelectionColor findReplaceSelection backgroundColor alpha: 0.05)
				borderWidth: 2
				borderColor: RubTextSelectionColor findReplaceSelection backgroundColor].
	^ findReplaceShapes! !

!RubExtraSelectionDecorator methodsFor: 'drawing' stamp: 'AlainPlantec 5/21/2013 15:43'!
drawSelectionShape: aSelBlock
	"Display a SelectionShape if it does not overlap vith the regular selection"
	| startIdx stopIdx  |
	startIdx := aSelBlock firstIndex.
	stopIdx := aSelBlock lastIndex.
	(self selectionStart notNil and: [ self selectionStop notNil and: [ self selectionStart ~= self selectionStop ] ])
		ifTrue: [ 
			| selSartIdx selStopIdx selBlockRange selRange |
			selSartIdx := self selectionStart stringIndex.
			selStopIdx := self selectionStop stringIndex.
			selBlockRange := startIdx to: stopIdx.
			selRange := selSartIdx to: selStopIdx.
			((selBlockRange rangeIncludes: selSartIdx + 1)
				or: [ 
					(selBlockRange rangeIncludes: selStopIdx - 1)
						or: [ (selRange rangeIncludes: startIdx + 1) or: [ selRange rangeIncludes: stopIdx - 1 ] ] ])
				ifTrue: [ ^ self ] ].	"regular selection and this selection block overlap"
	aSelBlock drawOn: canvas! !

!RubExtraSelectionDecorator methodsFor: 'drawing' stamp: 'AlainPlantec 2/26/2015 19:37'!
drawSelectionShapeOnAthensCanvas: aSelBlock
	"Display a SelectionShape if it does not overlap vith the regular selection"
	| startIdx stopIdx  |
	startIdx := aSelBlock firstIndex.
	stopIdx := aSelBlock lastIndex.
	(self selectionStart notNil and: [ self selectionStop notNil and: [ self selectionStart ~= self selectionStop ] ])
		ifTrue: [ 
			| selSartIdx selStopIdx selBlockRange selRange |
			selSartIdx := self selectionStart stringIndex.
			selStopIdx := self selectionStop stringIndex.
			selBlockRange := startIdx to: stopIdx.
			selRange := selSartIdx to: selStopIdx.
			((selBlockRange rangeIncludes: selSartIdx + 1)
				or: [ 
					(selBlockRange rangeIncludes: selStopIdx - 1)
						or: [ (selRange rangeIncludes: startIdx + 1) or: [ selRange rangeIncludes: stopIdx - 1 ] ] ])
				ifTrue: [ ^ self ] ].	"regular selection and this selection block overlap"
	aSelBlock drawOnAthensCanvas: canvas! !

!RubExtraSelectionDecorator methodsFor: 'drawing' stamp: 'AlainPlantec 5/15/2013 09:47'!
draw
	super draw.
	Display depth < 3
		ifTrue: [ ^ self ].
	self computeSelectionShapes.
	self cleanUpText.
	self drawAllSelectionShapes! !

!RubExtraSelectionDecorator methodsFor: 'drawing' stamp: 'AlainPlantec 5/21/2013 16:01'!
computeSecondarySelectionShapesFrom: topLeft to: bottomRight
	| primary secondarySelRanges otherRanges topLeftBlk |
	primary := self primarySelectionInterval.
	topLeftBlk := self characterBlockAtPoint: topLeft.
	otherRanges := findReplaceRanges ifNil: [ #() ].
	(secondarySelRanges := (((self visibleStringFrom: topLeft to: bottomRight) allRangesOfSubString: self selection asString)
		collect: [ :r | r + topLeftBlk stringIndex - 1 ])
		reject: [ :i | 
			(otherRanges anySatisfy: [ :r | (r rangeIncludes: i first) or: [ r rangeIncludes: i last ] ])
				or: [ i = primary or: [ i first > self text size ] ] ]) collect: [ :i | i first to: (i last min: self text size) ].
	secondarySelRanges
		do: [ :r | self text addAttribute: RubTextSelectionColor secondarySelection from: r first to: r last ].
	^ secondarySelectionShapes := secondarySelRanges
		collect: [ :r | 
			RubSurfaceSelectionShape
				vertices: (self verticesFrom: r first to: r last + 1)
				firstIndex: r first
				lastIndex: r last + 1
				color: (RubTextSelectionColor secondarySelection backgroundColor alpha: 0.05)
				borderWidth: 3
				borderColor: RubTextSelectionColor secondarySelection backgroundColor ]! !

!RubExtraSelectionDecorator methodsFor: 'drawing' stamp: 'AlainPlantec 5/15/2013 09:46'!
computeSelectionShapes
	self findRegex ~= previousFindRegex
		ifTrue: [ self computeFindReplaceShapesFrom: self clippedRectangle topLeft to: self clippedRectangle bottomRight ].
	(self selection ~= previousSelection or: [ self findRegex ~= previousFindRegex ])
		ifTrue: [ self computeSecondarySelectionShapesFrom: self clippedRectangle topLeft to: self clippedRectangle bottomRight ].
	previousFindRegex := self findRegex.
	previousSelection := self selection! !

!RubExtraSelectionDecorator methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:48'!
findRegex
	^ self textArea ifNotNil: [ self textArea findRegex ]! !

!RubExtraSelectionDecorator methodsFor: 'drawing' stamp: 'AlainPlantec 5/14/2013 17:29'!
cleanUpText
	self text removeAttribute: RubTextSelectionColor findReplaceSelection.
	self text removeAttribute: RubTextSelectionColor secondarySelection.
! !

!RubExtraSelectionDecorator methodsFor: 'accessing' stamp: 'AlainPlantec 5/14/2013 16:37'!
primarySelectionInterval
	^ self selectionStart notNil
		ifTrue: [ self selectionStart stringIndex to: self selectionStop stringIndex - 1 ]
		ifFalse: [ 0 to: -1 ].
! !

!RubExtraSelectionDecorator methodsFor: 'drawing' stamp: 'AlainPlantec 2/26/2015 19:36'!
drawAllSelectionShapesOnAthensCanvas
	findReplaceShapes ifNotNil: [ findReplaceShapes do: [ :selblock | self drawSelectionShapeOnAthensCanvas: selblock ] ].
	secondarySelectionShapes ifNotNil: [ secondarySelectionShapes do: [ :selblock | self drawSelectionShapeOnAthensCanvas: selblock ] ]! !

!RubExtraSelectionDecorator methodsFor: 'drawing' stamp: 'AlainPlantec 5/15/2013 09:49'!
drawAllSelectionShapes
	findReplaceShapes ifNotNil: [ findReplaceShapes do: [ :selblock | self drawSelectionShape: selblock ] ].
	secondarySelectionShapes ifNotNil: [ secondarySelectionShapes do: [ :selblock | self drawSelectionShape: selblock ] ]! !

!RubExtraSelectionDecorator methodsFor: 'drawing' stamp: 'AlainPlantec 2/26/2015 19:36'!
drawOnAthensCanvas
	super drawOnAthensCanvas.
	self computeSelectionShapes.
	self cleanUpText.
	self drawAllSelectionShapesOnAthensCanvas! !

!RubExtraSelectionDecorator class methodsFor: 'querying' stamp: 'AlainPlantec 4/16/2013 14:48'!
key
	^ #findReplaceSelection! !

!RubFindReplaceDialogWindow methodsFor: 'updating' stamp: 'AlainPlantec 4/3/2013 14:29'!
newFinding
	| t |
	(t := self findText asString) ifEmpty: [^ self ].
	(self prevFinds includes: t)
		ifFalse: [self prevFinds addFirst: t].
	self prevFinds size > self maxPreviousListSize
		ifTrue: [self prevFinds removeLast]! !

!RubFindReplaceDialogWindow methodsFor: 'action' stamp: 'AlainPlantec 4/3/2013 23:22'!
cancel
	self model findText: ''.
	super cancel ! !

!RubFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 14:29'!
maxPreviousListSize
	^ self class maxPreviousListSize! !

!RubFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 4/3/2013 22:39'!
replaceAllEnabled
	^ self textView notNil
		and: [self findText notEmpty]! !

!RubFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 23:02'!
replaceText
	^ self model ifNil: [ '' asText] ifNotNil: [:m | m replaceText]! !

!RubFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 14:29'!
prevReplacements
	^ self class replacements! !

!RubFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 22:57'!
findText
	^ self model ifNil: ['' asText] ifNotNil: [:m | m findText]! !

!RubFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 4/3/2013 14:29'!
newButtons
	"Answer new buttons as appropriate."

	^{self newFindButton isDefault: true. self newReplaceButton. self newReplaceAllButton. self newCancelButton}! !

!RubFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 22:34'!
caseSensitive: aBoolean
	self model caseSensitive: aBoolean.
! !

!RubFindReplaceDialogWindow methodsFor: 'updating' stamp: 'AlainPlantec 4/4/2013 09:46'!
regexError
	self findTextFieldMorph textColor: Color  red! !

!RubFindReplaceDialogWindow methodsFor: 'action' stamp: 'AlainPlantec 5/7/2013 13:32'!
delete
	| m |
	m := model.
	[ super delete ]
		ensure: [ 
			model := m.
			model textArea ifNotNil: [ :ta | ta takeKeyboardFocus ] ]! !

!RubFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 4/3/2013 14:29'!
taskbarButtonFor: aTaskBar
	"No taskbar button because always on top"
	^nil! !

!RubFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 23:00'!
caseSensitive
	^ self model ifNil: [false] ifNotNil: [:m | m caseSensitive] ! !

!RubFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 4/4/2013 09:57'!
findText: aStringOrText
	^ self model findText: aStringOrText.
! !

!RubFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 4/3/2013 14:29'!
findTextFieldMorph
	^self
		findDeepSubmorphThat: [:m |
			(m isKindOf: PluggableTextFieldMorph) and: [m getTextSelector = #findText]]
		ifAbsent: [] ! !

!RubFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 4/3/2013 14:29'!
newReplaceAllButton
	^ (self theme
		newButtonIn: self
		for: self
		getState: nil
		action: #replaceAll
		arguments: nil
		getEnabled: #replaceAllEnabled
		label: 'Replace all' translated
		help: 'Replace all occurences' translated) hResizing: #rigid;
		 vResizing: #rigid! !

!RubFindReplaceDialogWindow methodsFor: 'action' stamp: 'AlainPlantec 4/3/2013 14:29'!
open
	self openAsIsIn: World.
	self extent: self extent.
	self activate
! !

!RubFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 23:01'!
entireWordsOnly
	^ self model ifNil: [false] ifNotNil: [:m | m entireWordsOnly] ! !

!RubFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 4/3/2013 14:29'!
newReplaceButton
	^ (self theme
		newButtonIn: self
		for: self
		getState: nil
		action: #replace 
		arguments: nil
		getEnabled: #replaceEnabled
		label: 'Replace' translated
		help: 'Replace the next occurence' translated) hResizing: #rigid;
		 vResizing: #rigid! !

!RubFindReplaceDialogWindow methodsFor: 'updating' stamp: 'AlainPlantec 4/4/2013 09:47'!
findPolicyChanged
	self changed: #findText.
	self changed: #caseSensitive.
	self changed: #isRegex.
	self changed: #entireWordsOnly.
	self changed: #findEnabled.
	self changed: #replaceText.
	self changed: #replaceEnabled.
	self changed: #replaceAllEnabled.
	self findTextFieldMorph textColor: Color  black.

! !

!RubFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 22:59'!
isRegex
	^ self model ifNil: [false] ifNotNil: [:m | m isRegex] ! !

!RubFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 4/3/2013 14:29'!
newContentMorph
	^(self newColumn: {	
			(self newGroupbox: nil for: 
				(self newColumn: {
					self newFindTextEntryMorph.
					(self newRow: {
						(self newColumn: {
							(self newCheckboxFor: self getSelected: #isRegex setSelected: #isRegex: getEnabled: nil label: 'Regular expression' translated help: nil).
							(self newCheckboxFor: self getSelected: #caseSensitive setSelected: #caseSensitive: getEnabled: nil label: 'Case sensitive' translated help: nil).
							(self newCheckboxFor: self getSelected: #entireWordsOnly setSelected: #entireWordsOnly: getEnabled: nil label: 'Entire words only'  translated help: nil) }
						).
						(self newColumn: {
							(self newCheckboxFor: self getSelected: #searchBackwards setSelected: #searchBackwards: getEnabled: nil label: 'Search backwards'  translated help: nil).
							(self newCheckboxFor: self getSelected: #wrapAround setSelected: #wrapAround: getEnabled: nil label: 'Wrap around'  translated help: nil) }
						) }	
					) }
				)
			).
			(self newLabelGroup: {'Replace with: ' translated -> self newReplaceTextEntryMorph}) vResizing: #shrinkWrap}
		) 

! !

!RubFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 4/3/2013 22:39'!
replaceEnabled
	^ self textView notNil
		and: [self findText notEmpty]! !

!RubFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 22:35'!
replaceText: aStringOrText
	self model replaceText: aStringOrText asString.
	^ true

! !

!RubFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 22:34'!
isRegex: aBoolean
	self model isRegex: aBoolean.
! !

!RubFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 22:36'!
wrapAround: aBoolean
	self model wrapAround: aBoolean.
! !

!RubFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 14:29'!
prevFinds
	^ self class finds! !

!RubFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 4/3/2013 14:29'!
newFindButton
	^(self theme
			newButtonIn: self
			for: self
			getState: nil
			action: #find
			arguments: nil
			getEnabled: #findEnabled
			label: 'Find' translated
			help: 'Find the next occurence' translated)
		hResizing: #rigid;
		vResizing: #rigid! !

!RubFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 4/3/2013 14:29'!
title
	^ 'Find & Replace' translated.
! !

!RubFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 4/3/2013 14:29'!
defaultButton
	"Answer the default button."
	^self
		findDeepSubmorphThat: [:m |
			(m isKindOf: PluggableButtonMorph) and: [m actionSelector = #find]]
		ifAbsent: [] ! !

!RubFindReplaceDialogWindow methodsFor: 'action' stamp: 'AlainPlantec 4/4/2013 10:11'!
replace
	self newReplacement.
	self model replace.
	self find! !

!RubFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'StephaneDucasse 10/27/2014 09:34'!
buildWindowMenu
	"Build and answer the window menu."

	| aMenu |
	aMenu := self theme newMenuIn: self for: self.
	aMenu
		addToggle: 'Close' translated
		target: self
		selector: #closeBoxHit
		getStateSelector: nil
		enablementSelector: #allowedToClose.
	aMenu lastItem icon: self theme windowCloseForm.
	aMenu addLine.
	aMenu add: 'About' selector: #showAbout.
	aMenu lastItem icon: self theme smallHelpIcon.
	^ aMenu! !

!RubFindReplaceDialogWindow methodsFor: 'action' stamp: 'AlainPlantec 4/4/2013 10:11'!
replaceAll
	self model replaceAll! !

!RubFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 4/4/2013 09:33'!
searchBackwards: aBoolean
	self searchBackwards = aBoolean
		ifFalse: [ 
			self model searchBackwards: aBoolean.
			self findPolicyChanged ]! !

!RubFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 4/3/2013 14:29'!
initialExtent 
	^ 400 @ super initialExtent y! !

!RubFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 4/3/2013 14:29'!
extent: anExtent
	^ super extent: anExtent x @ self initialExtent y! !

!RubFindReplaceDialogWindow methodsFor: 'updating' stamp: 'AlainPlantec 4/4/2013 09:47'!
update: aSymbol
	self textView ifNotNil: [
		aSymbol = #regexError
				ifTrue: [self regexError].
		aSymbol = #newFinding
				ifTrue: [^ self newFinding].
		aSymbol = #findPolicy
			ifTrue: [self findPolicyChanged]].
	super update: aSymbol! !

!RubFindReplaceDialogWindow methodsFor: 'updating' stamp: 'AlainPlantec 4/3/2013 14:29'!
newReplacement
	| t |
	(t := self replaceText asString) ifEmpty: [^ self ].
	(self prevReplacements includes: t)
		ifFalse: [self prevReplacements addFirst: t].
	self prevReplacements size > self maxPreviousListSize
		ifTrue: [self prevReplacements removeLast]! !

!RubFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 23:01'!
wrapAround
	^ self model ifNil: [true] ifNotNil: [:m | m wrapAround] ! !

!RubFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 4/3/2013 14:29'!
isResizeable
	"Answer whether we are not we can be resized."

	^true! !

!RubFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 4/3/2013 14:29'!
newFindTextEntryMorph
	| entryCompletion pt |
	entryCompletion := EntryCompletion new
				dataSourceBlock: [:currText | self prevFinds ];
				filterBlock: [:currApplicant :currText | currText size = 0
						or: [currApplicant asUppercase includesSubstring: currText asString asUppercase]].
	pt := (self newAutoAcceptTextEntryFor: self
			get: #findText
			set: #findText:
			class: String 
			getEnabled: nil
			help: 'Enter the text to find' translated
			entryCompletion: entryCompletion) 
		acceptOnCR: false;
		ghostText: 'Text to find';
		withDropListButton;
		crAction: [:t | self find];
		yourself.
	pt textMorph
		autoFit: true;
		wrapFlag: false;
		margins: (2@1 corner: 2@1).
	^ pt
! !

!RubFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 22:34'!
entireWordsOnly: aBoolean
	self model entireWordsOnly: aBoolean.
! !

!RubFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 4/3/2013 14:29'!
findEnabled
	^ self findString isEmptyOrNil not ! !

!RubFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 4/3/2013 14:29'!
defaultFocusMorph
	^ self findTextFieldMorph textMorph! !

!RubFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:59'!
textView
	^ self model ifNotNil: [ :m | m textArea ]! !

!RubFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 23:01'!
searchBackwards
	^ self model ifNil: [false] ifNotNil: [:m | m searchBackwards]! !

!RubFindReplaceDialogWindow methodsFor: 'action' stamp: 'AlainPlantec 4/4/2013 10:13'!
find
	self newFinding.
	^ self model find! !

!RubFindReplaceDialogWindow methodsFor: 'user-interface' stamp: 'AlainPlantec 4/3/2013 14:29'!
newReplaceTextEntryMorph
	| entryCompletion pt |
	entryCompletion := EntryCompletion new
				dataSourceBlock: [:currText | self prevReplacements ];
				filterBlock: [:currApplicant :currText | currText size = 0
						or: [currApplicant asUppercase includesSubstring: currText asString asUppercase]].

	pt := (self
		newAutoAcceptTextEntryFor: self
		get: #replaceText
		set: #replaceText:
		class: String
		getEnabled: nil
		help: 'Enter the replacement text' translated
		entryCompletion: entryCompletion)
			acceptOnCR: true;
			crAction: [:t | self replace];
			withDropListButton;
			yourself.
	pt textMorph
		autoFit: true;
		wrapFlag: false;
		margins: (2@1 corner: 2@1).
	^ pt
! !

!RubFindReplaceDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 23:02'!
findString
	^ self model ifNil: ['' asText] ifNotNil: [:m | m findString]! !

!RubFindReplaceDialogWindow class methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 14:29'!
finds
	^ Finds ifNil: [Finds := OrderedCollection new]! !

!RubFindReplaceDialogWindow class methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 14:29'!
replacements
	^ Replacements ifNil: [Replacements := OrderedCollection new]! !

!RubFindReplaceDialogWindow class methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 14:29'!
maxPreviousListSize
	^ 15! !

!RubFindReplaceService methodsFor: 'updating' stamp: 'AlainPlantec 5/7/2013 12:02'!
findPolicyChanged
	self changed: #findPolicy.
	self announcer announce: RubFindTextChanged new! !

!RubFindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 14:28'!
entireWordsOnly
	^ entireWordsOnly ifNil: [entireWordsOnly := false]! !

!RubFindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 14:28'!
findStartIndex
	^ findStartIndex! !

!RubFindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 14:28'!
isRegex
	^ isRegex ifNil: [isRegex := false]! !

!RubFindReplaceService methodsFor: 'updating' stamp: 'AndreiChis 3/25/2015 17:10'!
updateFindStartIndex
	| si |
	self textArea 
		ifNil: [ ^self ]
		ifNotNil: [ :aTextArea |
			aTextArea changed.
			self changed: #replaceEnabled.
			si := aTextArea selectionInterval.
			self findStartIndex: (self searchBackwards ifTrue: [si first - 1] ifFalse: [si last + 1]) ]! !

!RubFindReplaceService methodsFor: 'accessing' stamp: 'AndreiChis 3/25/2015 17:13'!
textArea
	^ textAreaHolder at: 1 ! !

!RubFindReplaceService methodsFor: 'user-interface' stamp: 'AlainPlantec 5/7/2013 13:13'!
newDialog
	| d |
	d := RubFindReplaceDialogWindow new model: self.
	d findPolicyChanged.
	d announcer subscribe: MorphDeleted send: #whenDialogDeleted to: self.
	^ d
	! !

!RubFindReplaceService methodsFor: 'services' stamp: 'AlainPlantec 5/15/2013 00:50'!
findRegex
	| s |
	self regexString ifEmpty: [ ^nil ].
	s := self entireWordsOnly
		ifTrue: ['\<', self regexString, '\>']
		ifFalse: [ self regexString].
	[^ self caseSensitive
			ifTrue: [s asRegex]
			ifFalse: [s asRegexIgnoringCase]]
		on: Error 
		do: [self changed: #regexError. 
			^ '' asRegex]
! !

!RubFindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 12:01'!
findTextSilently: aStringOrText
	findText := aStringOrText asText.
	self findPolicyChanged! !

!RubFindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 12:01'!
replaceText: aStringOrText
	replaceText := aStringOrText asString.
	self findPolicyChanged
! !

!RubFindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 14:28'!
replaceText
	^ replaceText ifNil: [replaceText := '']! !

!RubFindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 12:01'!
isRegex: aBoolean
	isRegex := aBoolean.
	self findPolicyChanged
! !

!RubFindReplaceService methodsFor: 'user-interface' stamp: 'AlainPlantec 5/7/2013 13:35'!
whenDialogDeleted
	dialog := nil.
! !

!RubFindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 12:01'!
wrapAround: aBoolean
	wrapAround := aBoolean.
	self findPolicyChanged

! !

!RubFindReplaceService methodsFor: 'as yet unclassified' stamp: 'AndreiChis 3/25/2015 17:12'!
initialize
	super initialize.
	
	textAreaHolder := WeakArray new: 1 ! !

!RubFindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 14:28'!
findText
	^ (findText ifNil: [findText := '' asText. findText]) asString! !

!RubFindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 14:28'!
convertedFindString
	| specials |
	specials := '^$:\+*[]()'.
	^String 
		streamContents: [:s | self findString 
			do: [:c | (specials includes: c) ifTrue: [s nextPut:$\].
				s nextPut: c]]! !

!RubFindReplaceService methodsFor: 'services' stamp: 'AlainPlantec 5/7/2013 09:59'!
findNext
	| where  |
	findStartIndex 
		ifNil: [findStartIndex := self textArea editor startIndex].
	findStartIndex > 0 
		ifTrue: [where := self textArea findNextString: self findString startingAt: findStartIndex].
	(where isNil and: [self wrapAround])
		ifTrue: [where := self textArea findNextString: self findString asString startingAt: 1].
	^ where
! !

!RubFindReplaceService methodsFor: 'services' stamp: 'AlainPlantec 5/7/2013 09:59'!
replace
	findStartIndex := self searchBackwards 
		ifTrue: [self textArea editor stopIndex] 
		ifFalse: [self textArea editor startIndex].
	(self find)
		ifNotNil: [self textArea replaceSelectionWith: self replaceText]! !

!RubFindReplaceService methodsFor: 'services' stamp: 'AlainPlantec 5/7/2013 09:59'!
replaceAll
	| startIdx |
	startIdx := self wrapAround ifTrue: [1] ifFalse: [self textArea editor selectionInterval first].
	self textArea replaceAll: self findRegex with: self replaceText startingAt: startIdx
! !

!RubFindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 12:01'!
searchBackwards: aBoolean
	searchBackwards := aBoolean.
	self updateFindStartIndex.
	self findPolicyChanged
! !

!RubFindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 12:00'!
caseSensitive: aBoolean
	caseSensitive := aBoolean.
	self findPolicyChanged! !

!RubFindReplaceService methodsFor: 'events handling' stamp: 'AlainPlantec 5/7/2013 11:35'!
whenTextAreaSelectionChanged: anAnnouncement 
	self updateFindStartIndex! !

!RubFindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 14:28'!
findText: aStringOrText isRegex: aBoolean entireWordsOnly: forEntireWordsOnly
		self isRegex: aBoolean.
		self findText: aStringOrText.
		self entireWordsOnly: forEntireWordsOnly! !

!RubFindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 11:09'!
announcer
	^ announcer ifNil: [ announcer := Announcer new ]! !

!RubFindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 14:28'!
regexString
	^ self isRegex 
		ifTrue: [self findString]
		ifFalse: [self convertedFindString]
! !

!RubFindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 14:28'!
findText: aStringOrText isRegex: isReg caseSensitive: isCaseSensitive entireWordsOnly: forEntireWordsOnly
		self isRegex: isReg.
		self findText: aStringOrText.
		self entireWordsOnly: forEntireWordsOnly.
		self caseSensitive: isCaseSensitive! !

!RubFindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 14:28'!
wrapAround
	^ wrapAround ifNil: [wrapAround := true]! !

!RubFindReplaceService methodsFor: 'events handling' stamp: 'AlainPlantec 5/7/2013 12:56'!
whenTextAreaLostFocus: anAnnounce
	self announcer announce: RubFindTextChanged new
! !

!RubFindReplaceService methodsFor: 'user-interface' stamp: 'AndreiChis 3/25/2015 17:10'!
dialogIsActiveFor: aTextArea
	^ self dialog world notNil and: [ self textArea = aTextArea  ]! !

!RubFindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 12:00'!
entireWordsOnly: aBoolean
	entireWordsOnly := aBoolean.
	self findPolicyChanged! !

!RubFindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 14:28'!
selectionRegexString
	^ self convertedFindString
! !

!RubFindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 14:28'!
findText: aStringOrText isRegex: aBoolean
		self isRegex: aBoolean.
		self findText: aStringOrText.
		self replaceText: ''.
! !

!RubFindReplaceService methodsFor: 'accessing' stamp: 'AndreiChis 3/25/2015 17:13'!
textArea: aTextArea
	textAreaHolder at: 1 put: aTextArea.
	aTextArea announcer subscribe: RubFindReplaceWindowRequired send: #whenFindReplaceWindowRequired: to: self. 
! !

!RubFindReplaceService methodsFor: 'events handling' stamp: 'AlainPlantec 5/7/2013 11:04'!
whenTextAreaGotFocus: anAnnounce
	self textArea: anAnnounce morph.
	self findText: self findText.
	self changed: #findText.
	self changed: #caseSensitive.
	self changed: #replaceEnabled.
! !

!RubFindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 14:28'!
caseSensitive
	^ caseSensitive ifNil: [caseSensitive := TextEditor caseSensitiveFinds]! !

!RubFindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 12:02'!
findText: aStringOrText
	findText := aStringOrText asText.
	self findPolicyChanged.
	self announcer announce: RubFindTextChanged new.
	^ true! !

!RubFindReplaceService methodsFor: 'user-interface' stamp: 'AlainPlantec 4/4/2013 10:23'!
dialog
	^ dialog ifNil: [ dialog := self newDialog ]
	! !

!RubFindReplaceService methodsFor: 'events handling' stamp: 'AlainPlantec 5/7/2013 15:44'!
whenFindReplaceWindowRequired: anAnnouncement
	self findText
		ifEmpty: [ 
			self textArea hasSelection
				ifTrue: [ self findText: self textArea selection ] ].
	self dialog open! !

!RubFindReplaceService methodsFor: 'services' stamp: 'AlainPlantec 5/7/2013 09:59'!
find
	| where  |
	findStartIndex 
		ifNil: [findStartIndex := self searchBackwards 
			ifTrue: [self textArea editor stopIndex]
			ifFalse: [self textArea  editor startIndex]].
	findStartIndex > 0 
		ifTrue: [where := self textArea 
			findAndSelect: self findRegex
			startingAt: findStartIndex
			searchBackwards: self searchBackwards].
	(where isNil and: [self wrapAround])
		ifTrue: [ | idx |
			idx := self searchBackwards ifTrue: [self textArea  editor string size] ifFalse: [1].
			where := self textArea 
				findAndSelect: self findRegex
				startingAt: idx
				searchBackwards: self searchBackwards].
	where ifNil: [self textArea  flash].
	^ where
! !

!RubFindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 14:28'!
findString
	^ self findText asString! !

!RubFindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 14:28'!
findStartIndex: anInteger
	findStartIndex := anInteger! !

!RubFindReplaceService methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 14:28'!
searchBackwards
	^ searchBackwards ifNil: [searchBackwards := false]! !

!RubFindReplaceService class methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 14:46'!
default
	^ Singleton ifNil: [ Singleton := self new ]
! !

!RubFindReplaceService class methodsFor: 'accessing' stamp: 'AlainPlantec 4/4/2013 09:24'!
dialog
	^ self default dialog! !

!RubFindReplaceService class methodsFor: 'cleanup' stamp: 'AndreiChis 3/4/2015 10:45'!
cleanUp

	Singleton := nil! !

!RubGhostTextDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 2/5/2014 10:39'!
textColor
	^ textColor! !

!RubGhostTextDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 4/18/2013 11:12'!
centered
	self handleTextChangeWhile: [ghostText selectAll; centered; deselect]
! !

!RubGhostTextDisplayer methodsFor: 'geometry' stamp: 'AlainPlantec 4/19/2013 10:32'!
extent: aPoint
	super extent: aPoint.
	self showHideGhostText! !

!RubGhostTextDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 4/18/2013 11:12'!
fontName: aFontName pointSize: anInteger
	self
		handleTextChangeWhile: [ 
			ghostText
				beEditableWhile: [ 
					ghostText fontName: aFontName pointSize: anInteger.
					ghostText compose.
					self changed ] ]! !

!RubGhostTextDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 4/18/2013 11:13'!
rightFlush
	self
		handleTextChangeWhile: [ ghostText selectAll; rightFlush; deselect ]
! !

!RubGhostTextDisplayer methodsFor: 'initialize-release' stamp: 'AlainPlantec 2/5/2014 10:41'!
defaultTextColor.
	^ Color lightGray! !

!RubGhostTextDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 2/5/2014 10:38'!
setTextWith: aText
	ghostText setTextWith: aText asText.
	ghostText  textColor: self textColor
! !

!RubGhostTextDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 4/22/2013 18:34'!
level
	^ SmallInteger maxVal  - 1! !

!RubGhostTextDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 2/5/2014 10:40'!
updateTextWith: aText
	self
		handleTextChangeWhile: [ 
			ghostText updateTextWith: aText.
			ghostText textColor: self textColor ]! !

!RubGhostTextDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 4/22/2013 14:36'!
manageLayoutInBounds: aRectangle
	| ret |
	self handleTextChangeWhile: [ ret := super manageLayoutInBounds: aRectangle ].
	^ ret! !

!RubGhostTextDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 4/18/2013 11:11'!
bold
	self handleTextChangeWhile: [ghostText selectAll; bold; deselect]
! !

!RubGhostTextDisplayer methodsFor: 'private' stamp: 'AlainPlantec 5/17/2013 21:49'!
showHideGhostText
	self textArea text
		ifNotEmpty: [ self removeAllMorphs ]
		ifEmpty: [ 
			ghostText unlock.
			ghostText centered.
			ghostText extent: self extent.
			self addMorphCentered: ghostText.
			ghostText lock]! !

!RubGhostTextDisplayer methodsFor: 'initialize-release' stamp: 'AlainPlantec 2/5/2014 10:41'!
initialize
	super initialize.
	ghostText := RubEditingArea new.
	ghostText withoutAnyDecorator.
	ghostText backgroundColor: Color transparent.
	textColor := self defaultTextColor.
	ghostText beReadOnly.
	ghostText beWrapped.
! !

!RubGhostTextDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 2/5/2014 10:39'!
textColor: aColor
	textColor := aColor.
	self
		handleTextChangeWhile: [ ghostText textColor: aColor ]! !

!RubGhostTextDisplayer methodsFor: 'event handling' stamp: 'AlainPlantec 2/6/2014 09:54'!
textChanged 
	self showHideGhostText.
	super textChanged
! !

!RubGhostTextDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 5/20/2013 19:46'!
computedPositionFrom: aRectangle
	^ self scrollBounds topLeft
! !

!RubGhostTextDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 5/20/2013 19:46'!
computedWidthFrom: aRectangle
	^  self scrollBounds width
! !

!RubGhostTextDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 4/19/2013 10:31'!
handleTextChangeWhile: aBlock 
	aBlock value.
	self showHideGhostText! !

!RubGhostTextDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 4/18/2013 11:14'!
updateMarginsWith: aRectangle
	self
		handleTextChangeWhile: [ ghostText updateMarginsWith: aRectangle]
! !

!RubGhostTextDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 4/23/2013 20:33'!
fontPointSize: anInteger
	self handleTextChangeWhile: [ghostText fontPointSize: anInteger]! !

!RubGhostTextDisplayer class methodsFor: 'querying' stamp: 'AlainPlantec 4/16/2013 19:11'!
key
	^ #ghostText! !

!RubHighlightSegmentMorph commentStamp: 'AndreiChis 1/12/2015 17:14'!
A RubHighlightSegmentMorph is a volatile segment that deletes itself whenever the user interacts with the editor. It can be used to add selection-like segments.
!
!RubHighlightSegmentMorph methodsFor: 'event handling' stamp: 'AndreiChis 1/14/2015 11:00'!
registerTextArea
	super registerTextArea.
	textArea announcer subscribe: RubKeystroke send: #whenKeyPressed: to: self.
	textArea announcer subscribe: RubMouseClick send: #whenMouseClicked: to: self.
	textArea announcer subscribe: RubSelectionChanged send: #whenSelectionChanged: to: self.
	
	self color: (self theme rubScrolledTextMorphThemer highlightBackgroundColorFor: textArea).
	self borderStyle: (self theme rubScrolledTextMorphThemer highlightBorderStyleFor: textArea).
	self borderWidth: (self textArea hasSelection
		ifTrue: [ 2 * super borderWidth] 
		ifFalse: [ super borderWidth ])! !

!RubHighlightSegmentMorph methodsFor: 'event handling' stamp: 'AndreiChis 1/12/2015 17:00'!
whenMouseClicked: event

	self delete! !

!RubHighlightSegmentMorph methodsFor: 'event handling' stamp: 'AndreiChis 1/12/2015 15:57'!
mouseDown: anEvent
	super mouseDown: anEvent.
	self delete! !

!RubHighlightSegmentMorph methodsFor: 'event handling' stamp: 'AndreiChis 1/14/2015 10:39'!
whenSelectionChanged: anAnnouncement 

	self delete
	! !

!RubHighlightSegmentMorph methodsFor: 'event handling' stamp: 'AndreiChis 1/12/2015 17:12'!
whenKeyPressed: anEvent

	self delete! !

!RubHighlightSegmentMorph methodsFor: 'event handling' stamp: 'AndreiChis 1/14/2015 10:54'!
showMouseHasLeaved

! !

!RubHighlightSegmentMorph methodsFor: 'event handling' stamp: 'AndreiChis 1/12/2015 15:33'!
handlesMouseDown: evt

	^ true! !

!RubHighlightSegmentMorph methodsFor: 'event handling' stamp: 'AndreiChis 1/14/2015 10:54'!
showMouseHasEntered
! !

!RubHighlightSegmentMorph methodsFor: 'event handling' stamp: 'AndreiChis 1/13/2015 15:37'!
whenTextChanged: anAnnouncement 

	self delete! !

!RubKeystroke methodsFor: 'accessing' stamp: 'TudorGirba 7/21/2014 13:31'!
event
	^ event! !

!RubKeystroke methodsFor: 'accessing' stamp: 'TudorGirba 7/21/2014 13:31'!
event: anObject
	event := anObject! !

!RubKeystroke class methodsFor: 'instance creation' stamp: 'TudorGirba 7/21/2014 13:31'!
with: anEvent
	^ self new event: anEvent! !

!RubLineNumberDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:34'!
textColor
	^ self textArea lineNumbersTextColor 
! !

!RubLineNumberDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:48'!
verticalSeparatorColor
	^ (self textArea backgroundColor contrastingColor ) alpha: 0.3! !

!RubLineNumberDisplayer methodsFor: 'drawing' stamp: 'AlainPlantec 6/4/2013 09:23'!
drawOn: aCanvas
	| prev right font lines visibleRectangle tcolor left |
	super drawOn: aCanvas.
	self paragraph selectionStart ifNil: [ ^ self ].
	self paragraph selectionStop ifNil: [ ^ self ].
	self paragraph lines ifNil: [ ^ self ].
	right := self bounds right.
	left := self bounds left.
	font := self fontToUse.
	prev := nil.
	lines := self lines.
	tcolor := self textColor.
	aCanvas
		clipBy: self bounds
		during: [ :clippedCanvas | 
			| backBnd |
			clippedCanvas fillRectangle: self verticalSeparatorBounds color: self verticalSeparatorColor.
			visibleRectangle := clippedCanvas clipRect.
			(self lineIndexForPoint: visibleRectangle topLeft) to: (self lineIndexForPoint: visibleRectangle bottomRight) do: [ :i | 
				| line |
				line := lines at: i.
				(self selectionStart == self selectionStop and: [self selectionStop textLine lineNumber = line lineNumber])
					ifTrue: [ 
						backBnd := self bounds.
						backBnd := (backBnd left) @ line top corner: self verticalSeparatorBounds left @ line bottom.
						backBnd := backBnd translateBy: 0 @ (self offset y negated + self bounds top).
						clippedCanvas fillRectangle: backBnd color: self selectionColorToUse ].
				prev = line lineNumber
					ifFalse: [ 
						| lineMark lineBnd ygap |
						ygap := ((line lineHeight - font height) // 2 - 1) rounded.
						lineMark := line lineNumber asString.
						self side = #left
							ifTrue: [ 
								| width |
								width := (self fontToUse widthOfString: lineMark) + self horizontalGapAfter.
								lineBnd := (right - width) @ (line bottom - font height - ygap) corner: (right + width) @ line bottom ]
							ifFalse: [ lineBnd := (left + self horizontalGapBefore) @ (line bottom - font height - ygap) corner: right @ line bottom ].
						lineBnd := lineBnd translateBy: 0 @ (self offset y negated + self bounds top).
						clippedCanvas
							drawString: lineMark
							in: lineBnd
							font: font
							color: tcolor.
						prev := line lineNumber ] ] ]! !

!RubLineNumberDisplayer methodsFor: 'menus' stamp: 'AlainPlantec 5/30/2013 14:10'!
getMenu: shiftState
	"Answer the menu to be presented when the yellow button is pressed while the shift key is down"

	^ nil "self menu"! !

!RubLineNumberDisplayer methodsFor: 'menus' stamp: 'AlainPlantec 5/30/2013 14:05'!
menu
	"Answer the menu to be presented when the yellow button is pressed while the shift key is down"

	^ (PragmaMenuBuilder pragmaKeyword: self menuKeyword  model: self) menu! !

!RubLineNumberDisplayer methodsFor: 'menus' stamp: 'AlainPlantec 5/30/2013 14:05'!
menuKeyword 
	^ #RubLineNumberMenu
	! !

!RubLineNumberDisplayer methodsFor: 'event handling' stamp: 'AlainPlantec 5/30/2013 11:51'!
mouseUp: anEvent
	| lineIndex line |
	lineIndex := self lineIndexForPoint: anEvent position.
	line := self lines at: lineIndex.
	anEvent setPosition: line topLeft.
	self textArea mouseUp: anEvent.
! !

!RubLineNumberDisplayer methodsFor: 'event handling' stamp: 'AlainPlantec 5/30/2013 14:02'!
yellowButtonActivity: shiftKeyState 
	"Invoke the text-editing menu.
	Check if required first!!"
	(self getMenu: shiftKeyState)
		ifNotNilDo: [ :menu|
			menu invokeModal. 
			self changed.
			^ true].
	^ true! !

!RubLineNumberDisplayer methodsFor: 'event handling' stamp: 'AlainPlantec 5/30/2013 10:52'!
handlesMouseDown: evt
	^ true! !

!RubLineNumberDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 5/22/2013 11:42'!
level
	^ 2! !

!RubLineNumberDisplayer methodsFor: 'geometry' stamp: 'AlainPlantec 6/3/2013 23:45'!
horizontalGapBefore
	^ 3! !

!RubLineNumberDisplayer methodsFor: 'geometry' stamp: 'AlainPlantec 4/17/2013 11:50'!
minimumWidth
	^ (self fontToUse widthOfString: 'MM') + self horizontalGapAfter + self horizontalGapBefore + self  verticalSeparatorWidth 
! !

!RubLineNumberDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 4/15/2013 17:28'!
backgroundColor
	^ self paragraphProvider lineNumbersBackgroundColor ! !

!RubLineNumberDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 6/4/2013 09:21'!
selectionColorToUse
	^ self primarySelectionColor! !

!RubLineNumberDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 4/16/2013 09:41'!
verticalSeparatorBounds
	| bnds  |
	bnds := self bounds.
	^ self side = #left
		ifTrue: [ (bnds topRight -  (self verticalSeparatorWidth @ 0)) corner: bnds bottomRight ]
		ifFalse: [ (bnds topLeft corner: bnds bottomLeft + (self verticalSeparatorWidth @ 0)) ]! !

!RubLineNumberDisplayer methodsFor: 'geometry' stamp: 'AlainPlantec 6/3/2013 23:45'!
horizontalGapAfter
	^ 3! !

!RubLineNumberDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 4/14/2013 01:14'!
verticalSeparatorWidth
	^ 1! !

!RubLineNumberDisplayer methodsFor: 'event handling' stamp: 'AlainPlantec 5/30/2013 14:00'!
mouseDown: anEvent
	| lineIndex line |
	(anEvent yellowButtonPressed and: [ anEvent commandKeyPressed not ]) "First check for option (menu) click"
		ifTrue: [ ^ (self yellowButtonActivity: anEvent shiftPressed) ].

	lineIndex := self lineIndexForPoint: anEvent position.
	line := self lines at: lineIndex.
	anEvent setPosition: line topLeft.
	self textArea mouseDown: anEvent! !

!RubLineNumberDisplayer methodsFor: 'geometry' stamp: 'AlainPlantec 4/22/2013 14:50'!
computedWidthFrom: aRectangle
	^ (((self fontToUse widthOfString: self paragraph numberOfPhysicalLines asString) + self horizontalGapBefore
		+ self horizontalGapAfter + self verticalSeparatorWidth) max: self minimumWidth) truncated! !

!RubLineNumberDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 5/9/2013 08:12'!
fontToUse
	^ RubAbstractTextArea lineNumbersFont ! !

!RubLineNumberDisplayer methodsFor: 'event handling' stamp: 'AlainPlantec 5/30/2013 11:49'!
mouseMove: anEvent
	| lineIndex line |
	lineIndex := self lineIndexForPoint: anEvent position.
	line := self lines at: lineIndex.
	anEvent setPosition: line topLeft.
	self textArea mouseMove: anEvent
! !

!RubLineNumberDisplayer class methodsFor: 'menu declaration' stamp: 'AlainPlantec 5/30/2013 14:08'!
menuOn: aBuilder
	"Specify the menu used when writing text. Try it with:
	(PragmaMenuBuilder 
		pragmaKeyword: 'textEditorMenu'
		model: nil) menu popUpInWorld"

	<contextMenu>
	<RubLineNumberMenu>
	(aBuilder item: #'Find...' translated)
		keyText: 'f';
		selector: #find;
		icon: Smalltalk ui icons smallFindIcon.
! !

!RubLineNumberDisplayer class methodsFor: 'querying' stamp: 'AlainPlantec 4/16/2013 19:11'!
key
	^ #lineNumbers! !

!RubLipsumBasicExample commentStamp: 'AlainPlantec 3/17/2014 13:38'!
"When the text is wrapped, it is slower but the text has 1798 lines"
[self openWrapped] timeToRun  
     
"Enjoy the speed when not wrapped!! "
[self openNotWrapped] timeToRun 
 !
!RubLipsumBasicExample methodsFor: 'user interface' stamp: 'AlainPlantec 4/23/2013 10:26'!
newScrolledTextNotWrapped
	^ self newScrolledText ! !

!RubLipsumBasicExample methodsFor: 'user interface' stamp: 'AlainPlantec 7/31/2013 10:09'!
newScrolledText
	| st |
	st := self textModel newScrolledText
		withAdornment;
		withLineNumbers;
		withColumns;
		withGhostText: 'Hello, the text is now empty. Don''t worry, I will disappear if you enter some text.';
		withAnnotation;
		yourself.
	st ghostTextRuler fontName: 'Bitmap DejaVu Sans' pointSize: 18; centered.
	^ st! !

!RubLipsumBasicExample methodsFor: 'user interface' stamp: 'AlainPlantec 4/23/2013 10:27'!
newScrolledTextWrapped
	^ self newScrolledText beWrapped! !

!RubLipsumBasicExample methodsFor: 'accessing' stamp: 'AndreiChis 1/7/2015 16:42'!
loremIpsum
	^ String loremIpsum: 81233! !

!RubLipsumBasicExample methodsFor: 'accessing' stamp: 'AlainPlantec 7/31/2013 09:55'!
textModel
	^ textModel ifNil: [textModel := RubScrolledTextModel new text: self loremIpsum ]! !

!RubLipsumBasicExample class methodsFor: 'examples' stamp: 'AlainPlantec 7/31/2013 10:12'!
openNotWrapped
	"self openNotWrapped"

	self openScrolledText: self new newScrolledTextNotWrapped.
! !

!RubLipsumBasicExample class methodsFor: 'examples' stamp: 'AlainPlantec 7/31/2013 10:11'!
openScrolledText: aScrolledText

	|  window |
	window := StandardWindow new.
	window addMorph: aScrolledText fullFrame: (0@0 corner: 1@1) asLayoutFrame.
	window title: self title.
	self spyAnnouncer ifTrue: [ aScrolledText textArea announcer open ].
	window openInWorld! !

!RubLipsumBasicExample class methodsFor: 'examples' stamp: 'AlainPlantec 4/23/2013 10:32'!
title
	^ 'Lorem Ipsum example'! !

!RubLipsumBasicExample class methodsFor: 'examples' stamp: 'AlainPlantec 5/7/2013 10:01'!
spyAnnouncer
	"Set it to true if you want to observe textArea announcements"
	^ false! !

!RubLipsumBasicExample class methodsFor: 'examples' stamp: 'AlainPlantec 8/27/2013 10:38'!
openWrapped
	"self openWrapped"
	self openScrolledText: self new newScrolledTextWrapped.
! !

!RubLipsumWithSegmentsExample commentStamp: '<historical>'!
[self openWrapped] timeToRun
     
[self openNotWrapped] timeToRun
 !
!RubLipsumWithSegmentsExample methodsFor: 'user interface' stamp: 'AlainPlantec 2/7/2014 11:58'!
newScrolledText
	| st r conf |
	st := super newScrolledText.
	conf := RubConfigurationChange new.
	conf
		configurationBlock: [ :scrolledText | 
			scrolledText withTextSegmentIcons.
			scrolledText addSegment: (r := RubUnderlinedSegmentMorph from: 1 to: 29).
			r icon: self iconProvider smallErrorIcon.
			r label: 'Please review'.
			r iconBlock: [ :seg :event | seg delete ].
			scrolledText addSegment: (r := RubUnderlinedSegmentMorph from: 35 to: 59).
			r icon: self iconProvider smallErrorIcon.
			r label: 'Remove'.
			r
				iconBlock: [ :seg :event | 
					seg textArea selectFrom: seg firstIndex to: seg lastIndex.
					seg textArea replaceSelectionWith: ''.
					seg delete ].
			scrolledText addSegment: (r := RubUnderlinedSegmentMorph from: 430 to: 740).
			r borderColor: Color lightGray.
			r changeable: false.
			r label: 'Edit separately'.
			r iconBlock: [ :seg :event | (seg readWriteView embeddedInMorphicWindowLabeled: 'Lipsum part view') openInHand ].
			r straight: false.
			r icon: self iconProvider smallWarningIcon.
			scrolledText addSegment: (r := RubUnderlinedSegmentMorph from: 810 to: 1000).
			r color: (Color blue alpha: 0.1).
			r borderColor: Color black.
			r label: 'Explore'.
			r changeable: false.
			r icon: self iconProvider smallHelpIcon.
			r iconBlock: [ :seg :event | seg explore ].
			scrolledText addSegment: (r := RubPlainSegmentMorph from: 1300 to: 1610).
			r label: 'Remove'.
			r
				iconBlock: [ :seg :event | 
					seg textArea selectFrom: seg firstIndex to: seg lastIndex.
					seg textArea replaceSelectionWith: ''.
					seg delete ].
			r color: (Color green alpha: 0.1).
			r borderColor: Color gray.
			r icon: self iconProvider smallWarningIcon ].
	self textModel announce: conf.
	^ st! !

!RubLipsumWithSegmentsExample methodsFor: 'accessing' stamp: 'AlainPlantec 6/20/2013 09:26'!
iconProvider
	" For 2.0/3.0 compatibility "
	^ (Smalltalk respondsTo: #ui)
		ifTrue: [ (Smalltalk perform: #ui) icons]
		ifFalse: [ UITheme current ]! !

!RubLipsumWithSegmentsExample methodsFor: 'accessing' stamp: 'AlainPlantec 2/6/2014 16:04'!
loremIpsum
	^ super loremIpsum copyFrom: 1 to: 2000! !

!RubMethodEditingExample commentStamp: '<historical>'!
self open!
!RubMethodEditingExample methodsFor: 'accessing' stamp: 'AlainPlantec 4/23/2013 20:15'!
selector
	^ selector! !

!RubMethodEditingExample methodsFor: 'view' stamp: 'AlainPlantec 4/23/2013 20:15'!
classSelector
	| applicantsBlock entryCompletion |
	applicantsBlock := [(Array
				streamContents: [:strm | Symbol
						allSymbolTablesDo: [:each | (each notEmpty
									and: [each first canBeGlobalVarInitial
											and: [Smalltalk globals includesKey: each]])
								ifTrue: [strm nextPut: each]]]) sort].
	entryCompletion := EntryCompletion new
				dataSourceBlock: [:currText | applicantsBlock value ];
				filterBlock: [:currApplicant :currText | currText size > 0
						and: [currApplicant asUppercase includesSubstring: currText asString asUppercase]].
	^ (UIManager default newAutoAcceptTextEntryFor: self
			get: #className
			set: #className:
			class: String 
			getEnabled: nil
			help: 'Enter a class name' translated
			entryCompletion: entryCompletion)
				acceptOnCR: false;
				ghostText: 'Class name';
				withDropListButton;
				yourself.
! !

!RubMethodEditingExample methodsFor: 'accessing' stamp: 'AlainPlantec 4/23/2013 20:15'!
selectedClass
	self className ifNil: [ ^ nil ]. 
	^ Smalltalk globals at: self className ifAbsent: []! !

!RubMethodEditingExample methodsFor: 'view' stamp: 'AlainPlantec 4/23/2013 20:15'!
methodSelector
	| entryCompletion applicantsBlock |
	applicantsBlock := [self selectedClass 
						ifNil: [#()] 
						ifNotNil: [:clsn | self classToUse selectors asArray sort ]].
	entryCompletion := EntryCompletion new
				dataSourceBlock: [:currText | applicantsBlock value];
				filterBlock: [:currApplicant :currText | currText size > 0
						and: [currApplicant asUppercase includesSubstring: currText asString asUppercase]].
	^ (UIManager default newAutoAcceptTextEntryFor: self
			get: #selector
			set: #selector:
			class: String 
			getEnabled: #haveClassName
			help: 'Enter a selector' translated
			entryCompletion: entryCompletion) 
				acceptOnCR: false;
				ghostText: 'Selector';
				withDropListButton;
				yourself.
! !

!RubMethodEditingExample methodsFor: 'view' stamp: 'AlainPlantec 8/2/2013 09:40'!
newScrolledText
	| scrolledText |
	scrolledText := self textModel
		newScrolledText
		beForSmalltalkCode;
		withCodeSizeFeedback;
		withGhostText: 'Choose a class and then a method to edit its code';
		yourself.
	scrolledText ghostTextRuler
		centered;
		fontPointSize: 18.
	^ scrolledText! !

!RubMethodEditingExample methodsFor: 'accessing' stamp: 'AlainPlantec 7/31/2013 12:57'!
updateCodeWith: someText.
	self textModel setText: someText.
! !

!RubMethodEditingExample methodsFor: 'accessing' stamp: 'AlainPlantec 7/31/2013 12:57'!
classIsMeta: aBoolean
	classIsMeta := aBoolean.
	self selector: nil.
	self changed: #selector.
	self changed: #classIsMeta.
	self updateCodeWith: ''
! !

!RubMethodEditingExample methodsFor: 'accessing' stamp: 'AlainPlantec 4/23/2013 20:15'!
className
	^ className ifNotNil: [className asSymbol]! !

!RubMethodEditingExample methodsFor: 'accessing' stamp: 'AlainPlantec 4/23/2013 20:15'!
haveClassName
	^ self selectedClass notNil! !

!RubMethodEditingExample methodsFor: 'accessing' stamp: 'AlainPlantec 7/31/2013 13:00'!
selector: aSymbol
	selector := aSymbol ifNotNil: [:sel |( sel copyWithout: Character cr) asSymbol].
	self updateCodeWith: ''.
	self changed: #selector.
	self classToUse 
		ifNotNil: [:cls | (cls selectors includes: selector)
			ifTrue: [self updateCodeWith:  (cls sourceCodeAt: selector)]]! !

!RubMethodEditingExample methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 09:50'!
selectedClassOrMetaClass
	^ self classToUse ! !

!RubMethodEditingExample methodsFor: 'accessing' stamp: 'AlainPlantec 7/31/2013 12:57'!
className: aClassName
	className := aClassName copyWithout: Character cr.
	self selector: nil.
	self updateCodeWith: ''.
	self changed: #selector.
	self changed: #className.
	self selectedClass
		ifNotNil: [ self changed: #haveClassName]! !

!RubMethodEditingExample methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 09:40'!
textModel
	^ textModel ifNil: [ textModel := RubSmalltalkMethodEditorModel new client: self]! !

!RubMethodEditingExample methodsFor: 'view' stamp: 'AlainPlantec 4/23/2013 20:31'!
open
	| window bar editor |
	window := (StandardWindow labelled: 'Method editor with shout') model: self.
	editor := self newScrolledText.
	editor hResizing: #spaceFill; vResizing: #spaceFill.
	window addMorph: (window newColumn: { window newRow: { self classSelector. self metaSwitch. self methodSelector}. editor} )
		fullFrame: LayoutFrame identity.
	^ window openInWorld! !

!RubMethodEditingExample methodsFor: 'view' stamp: 'AlainPlantec 4/23/2013 20:15'!
metaSwitch
	^ UIManager default
		newCheckboxFor: self
		getSelected: #classIsMeta
		setSelected: #classIsMeta:
		label: 'Class'
		help: 'Class side is used if checked' ! !

!RubMethodEditingExample methodsFor: 'accessing' stamp: 'AlainPlantec 4/23/2013 20:15'!
classIsMeta
	^ classIsMeta ifNil: [classIsMeta := false]! !

!RubMethodEditingExample methodsFor: 'accessing' stamp: 'AlainPlantec 4/23/2013 20:15'!
classToUse
	^ self selectedClass
		ifNotNil: [self classIsMeta 
				ifTrue: [self selectedClass class]
				ifFalse: [self selectedClass]]! !

!RubMethodEditingExample methodsFor: 'shout' stamp: 'AlainPlantec 8/2/2013 09:48'!
shoutAboutToStyle: ATextView

	ATextView classOrMetaClass: self classToUse.
	^ true! !

!RubMethodEditingExample class methodsFor: 'instance creation' stamp: 'AlainPlantec 4/23/2013 20:19'!
open
	self new open! !

!RubMouseClick methodsFor: 'accessing' stamp: 'AndreiChis 1/12/2015 16:59'!
event
	^ event! !

!RubMouseClick methodsFor: 'accessing' stamp: 'AndreiChis 1/12/2015 16:59'!
event: anObject
	event := anObject! !

!RubMouseClick class methodsFor: 'instance creation' stamp: 'AndreiChis 1/12/2015 17:01'!
with: anEvent
	^ self new event: anEvent! !

!RubNotificationStrategy commentStamp: 'AndreiChis 10/1/2014 13:34'!
I encapsulate the logic that gets executed when, during compilation, a RubSmalltalkEditor receives a notification from the compiler. 

I am an abstract class. My subclasses define the actual behaviour.!
!RubNotificationStrategy methodsFor: 'as yet unclassified' stamp: 'TudorGirba 8/1/2014 18:58'!
editor: aSmalltalkEditor
	editor := aSmalltalkEditor ! !

!RubNotificationStrategy methodsFor: 'as yet unclassified' stamp: 'TudorGirba 8/1/2014 18:58'!
editor
	^ editor! !

!RubNotificationStrategy methodsFor: 'as yet unclassified' stamp: 'TudorGirba 8/1/2014 18:56'!
notify: aString at: anInteger in: aStream 
	self subclassResponsibility ! !

!RubOpeningClosingDelimiterDecorator methodsFor: 'drawing' stamp: 'AlainPlantec 4/11/2013 15:29'!
positionOfOppositeDelimiter: aDelimiter startingAt: aPosition
	| string topLineIndex bottomLineIndex topLineFirst bottomLinelast oppositeDelimiter level here hereChar incr |
	string := self string.
	topLineIndex := self lineIndexForPoint: self clippedRectangle topLeft.
	bottomLineIndex := self lineIndexForPoint: self clippedRectangle bottomRight.
	topLineFirst := (self lines at: topLineIndex) first.
	bottomLinelast := (self lines at: bottomLineIndex) last.
	oppositeDelimiter := self openingDelimiters , self closingDelimiters
		at: (self closingDelimiters , self openingDelimiters indexOf: aDelimiter).
	(self openingDelimiters includes: aDelimiter)
		ifTrue: [ incr := [ :v | v + 1 ] ]
		ifFalse: [ incr := [ :v | v - 1 ] ].
	level := 1.
	here := aPosition - 1.
	[ level > 0 and: [ here > (topLineFirst max: 1) and: [ here <= bottomLinelast ] ] ]
		whileTrue: [ 
			here := incr value: here.
			here > string size
				ifTrue: [ ^ 0 ].
			hereChar := string at: here.
			hereChar = oppositeDelimiter
				ifTrue: [ 
					level := level - 1.
					level = 0
						ifTrue: [ ^ here ] ]
				ifFalse: [ 
					hereChar = aDelimiter
						ifTrue: [ level := level + 1 ] ] ].
	^ 0! !

!RubOpeningClosingDelimiterDecorator methodsFor: 'drawing' stamp: 'AlainPlantec 2/26/2015 20:53'!
drawOnAthensCanvas
	"Send all visible lines to the displayScanner for display"

	| cursorPosition delimiter oppositePos rect previousOppositeBlock |
	cursorPosition := self paragraph pointIndex.
	cursorPosition ifNil: [ ^ self ].
	cursorPosition < 2
		ifTrue: [ ^ self ].
	(self closingDelimiters includes: (delimiter := self paragraph string at: cursorPosition - 1))
		ifFalse: [ 
			(self openingDelimiters includes: (delimiter := self paragraph string at: cursorPosition - 1))
				ifFalse: [ ^ self ] ].
	oppositePos := self positionOfOppositeDelimiter: delimiter startingAt: cursorPosition.
	oppositePos = 0
		ifTrue: [ ^ self ].
	previousOppositeBlock := self characterBlockForIndex: oppositePos.
	rect := previousOppositeBlock.
	rect privateSetCorner: (rect corner min: self clippedRectangle bottomRight) + (0 @ 1).
	rect privateSetOrigin: rect origin.
	canvas setPaint: RubTextSelectionColor oppositeDelimiterSelection backgroundColor.
	canvas setShape: rect surface expanded.
	canvas draw.
	canvas setShape: (rect surface insetBy: 0.5).
	(canvas setStrokePaint: Color black)
		width: 1.
	canvas draw.
! !

!RubOpeningClosingDelimiterDecorator methodsFor: 'drawing' stamp: 'AlainPlantec 4/24/2013 01:22'!
draw
	"Send all visible lines to the displayScanner for display"

	| cursorPosition delimiter oppositePos rect previousOppositeBlock |
	cursorPosition := self paragraph pointIndex.
	cursorPosition ifNil: [ ^ self ].
	cursorPosition < 2
		ifTrue: [ ^ self ].
	(self closingDelimiters includes: (delimiter := self paragraph string at: cursorPosition - 1))
		ifFalse: [ 
			(self openingDelimiters includes: (delimiter := self paragraph string at: cursorPosition - 1))
				ifFalse: [ ^ self ] ].
	oppositePos := self positionOfOppositeDelimiter: delimiter startingAt: cursorPosition.
	oppositePos = 0
		ifTrue: [ ^ self ].
	previousOppositeBlock := self characterBlockForIndex: oppositePos.
	rect := previousOppositeBlock.
	rect privateSetCorner: rect corner + (1 @ 1).
	rect privateSetOrigin: rect origin + (-1 @ 0).
	canvas fillRectangle: rect color: RubTextSelectionColor oppositeDelimiterSelection backgroundColor.
	canvas frameRectangle: rect color: Color black! !

!RubOpeningClosingDelimiterDecorator class methodsFor: 'querying' stamp: 'AlainPlantec 4/23/2013 19:47'!
key
	^ #openingClosingDelimitersHighlight! !

!RubParagraph methodsFor: 'accessing composer' stamp: 'AlainPlantec 4/25/2013 10:30'!
newComposer
	^ RubTextComposer new ! !

!RubParagraph methodsFor: 'accessing text area' stamp: 'AlainPlantec 5/7/2013 09:44'!
selectionStart
	^ textArea selectionStart! !

!RubParagraph methodsFor: 'querying' stamp: 'AlainPlantec 4/18/2013 10:46'!
hasDecoratorNamed: aKey
	^ false! !

!RubParagraph methodsFor: 'editing' stamp: 'AlainPlantec 3/20/2013 11:06'!
actionAttributesUnder: aClickPoint event: anEvent do: aBlock
	|startBlock|
	
	startBlock := self characterBlockAtPoint: aClickPoint.
	(self text attributesAt: startBlock stringIndex forStyle: self textStyle) 
		select: [ :attribute| attribute mayActOnEvent: anEvent ]
		thenDo: [:attribute | | range boxes| 
			"find the boxes for the current attribute range"
			range := self text rangeOf: attribute startingAt: startBlock stringIndex.
			boxes := self selectionRectsFrom: (self characterBlockForIndex: range first) 
						to: (self characterBlockForIndex: range last+1).
			(boxes detect: [:each | each containsPoint: aClickPoint] ifNone: [nil])
				ifNotNil: [ aBlock cull: attribute cull: boxes ]]! !

!RubParagraph methodsFor: 'querying' stamp: 'AlainPlantec 4/18/2013 10:45'!
decoratorNamed: aKey
	^ nil! !

!RubParagraph methodsFor: 'editing' stamp: 'AlainPlantec 5/7/2013 09:44'!
move: anEvent for: model controller: editor
	"Give sensitive text a chance to fire.  Display flash: (100@100 extent: 100@100)."
	
	| action clickPoint |
	
	clickPoint := anEvent cursorPoint.
	action := false.
	
	self actionAttributesUnder: clickPoint event: anEvent do: [ :attribute| |target|
		"evaluate the attribute action"
		target := (model ifNil: [textArea]).
		(attribute actOnMove: anEvent for: target in: self editor: editor) == true 	
			ifTrue: [ ^ true ]].
	
	(action and: [ Cursor currentCursor == Cursor webLink]) 
		ifTrue:[ Cursor normal show ].
	
	^ action! !

!RubParagraph methodsFor: 'composition' stamp: 'AlainPlantec 4/25/2013 10:37'!
recomposeFrom: start to: stop delta: delta
	self
		disableDrawingWhile: [ 	self composer recomposeFrom: start to: stop delta: delta ]! !

!RubParagraph methodsFor: 'accessing' stamp: 'AlainPlantec 3/12/2013 17:44'!
theme
	^ UITheme current! !

!RubParagraph methodsFor: 'private' stamp: 'AlainPlantec 5/16/2013 22:34'!
defaultEmptyText
	^ Text string: '' attributes: (Array with: self defaultFontChange)! !

!RubParagraph methodsFor: 'drawing' stamp: 'AlainPlantec 4/2/2013 17:59'!
disableDrawingWhile: aBlock
	self disableDrawing.
	aBlock ensure: [ self enableDrawing ]! !

!RubParagraph methodsFor: 'accessing text area' stamp: 'AlainPlantec 5/7/2013 09:44'!
closingDelimiters
	^ textArea closingDelimiters
! !

!RubParagraph methodsFor: 'geometry updating' stamp: 'AlainPlantec 3/25/2013 18:03'!
extentFromClientWidth: anInteger
	^ self extentFromClientBottomRight: (anInteger @ self extent y)! !

!RubParagraph methodsFor: 'initialize-release' stamp: 'AlainPlantec 4/8/2013 11:32'!
initialize 
	super initialize.
	drawingEnabled := true.
! !

!RubParagraph methodsFor: 'mock selection' stamp: 'AlainPlantec 6/4/2013 09:29'!
selection
	^ self textArea selection! !

!RubParagraph methodsFor: 'private' stamp: 'AlainPlantec 5/16/2013 22:25'!
defaultFontChange
	^ (TextFontChange fontNumber: self textStyle defaultFontIndex)! !

!RubParagraph methodsFor: 'accessing' stamp: 'AlainPlantec 4/25/2013 19:13'!
withoutDecorator
	^ self
! !

!RubParagraph methodsFor: 'accessing text area' stamp: 'AlainPlantec 5/7/2013 09:44'!
wrapped
	^ textArea wrapped! !

!RubParagraph methodsFor: 'drawing' stamp: 'AlainPlantec 3/10/2015 20:56'!
drawOnAthensCanvas: aCanvas bounds: aRectangle color: aColor
	self displayTextOnAthensCanvas: aCanvas in: aRectangle! !

!RubParagraph methodsFor: 'querying' stamp: 'AlainPlantec 6/6/2013 16:27'!
firstNonBlankCharacterBlockInLine: aLine
	| idx str blanks |
	idx := aLine first.
	str := self text string.
	blanks := { Character space. Character tab }.
	[ idx <= aLine last ]
		whileTrue: [ | c |
			c := str at: idx.
			(blanks includes: c)
				ifFalse: [ ^ self characterBlockForIndex: idx ].
			idx := idx + 1 ].
	^ self characterBlockForIndex: aLine last ! !

!RubParagraph methodsFor: 'drawing' stamp: 'AlainPlantec 4/1/2013 11:14'!
enableDrawing
	drawingEnabled := true! !

!RubParagraph methodsFor: 'querying' stamp: 'AlainPlantec 4/16/2013 15:39'!
hasDecorator: aDecorator
	^ false! !

!RubParagraph methodsFor: 'querying' stamp: 'AlainPlantec 6/13/2013 01:16'!
lastNonBlankCharacterBlockInLine: aLine
	| idx str blanks |
	idx := aLine last.
	str := self text string.
	blanks := { Character space. Character tab. Character cr. Character lf }.
	[ idx >= aLine first ]
		whileTrue: [ 
			(blanks includes: (str at: idx))
				ifFalse: [ ^ self characterBlockForIndex: idx ].
			idx := idx - 1 ].
	^ self characterBlockForIndex: aLine first ! !

!RubParagraph methodsFor: 'querying' stamp: 'AlainPlantec 4/11/2013 20:54'!
firstLineCharacterIndexFromCharacterIndex: anIndex
	^ (self lines at: (self lineIndexOfCharacterIndex: anIndex)) first! !

!RubParagraph methodsFor: 'composition' stamp: 'AlainPlantec 4/11/2013 17:59'!
compositionRectangle
	| e tl |
	e := self compositionExtent.
	tl := (self container insetBy: self margins) topLeft.
	^ tl corner: (tl x + e x - self margins right - (self margins left max: self cursorWidth)) @ e y! !

!RubParagraph methodsFor: 'composition' stamp: 'AlainPlantec 4/25/2013 20:08'!
forceCompose
	self uptodateComposer prepareToForceComposition.
	self compose! !

!RubParagraph methodsFor: 'accessing composer' stamp: 'AlainPlantec 5/18/2013 23:14'!
uptodateComposer
	^ self composer
		text: self text;
		textStyle: self textStyle;
		container: self compositionRectangle;
		emphasisHere: textArea emphasisHere;
		cursorWidth: textArea cursorWidth;
		yourself! !

!RubParagraph methodsFor: 'geometry updating' stamp: 'AlainPlantec 5/7/2013 09:44'!
moveBy: aPoint
	container := container translateBy: aPoint.
	self composer moveBy: aPoint.
	textArea recomputeSelection.
	textArea invalidRect: (self position extent: self extent)
! !

!RubParagraph methodsFor: 'geometry updating' stamp: 'AlainPlantec 3/21/2013 17:55'!
adjustBottomY
	| heights  bottomY verticalSize |
	heights := self lines collect: [ :each | each lineHeight ].
	verticalSize := heights sum.
	bottomY := self container top + verticalSize.
	self container: (self container withBottom: bottomY truncated).! !

!RubParagraph methodsFor: 'querying' stamp: 'AlainPlantec 5/18/2013 23:15'!
characterBlockAtPoint: aPoint 
	"Answer a CharacterBlock for the character in the text at aPoint."
	| line |
	line := self lines at: (self lineIndexForPoint: aPoint).
	^ (RubCharacterBlockScanner new text: self text textStyle: self textStyle)
		characterBlockAtPoint: aPoint index: nil
		in: line! !

!RubParagraph methodsFor: 'accessing' stamp: 'AlainPlantec 4/8/2013 11:30'!
paragraph
	^ self! !

!RubParagraph methodsFor: 'accessing text area' stamp: 'AlainPlantec 5/7/2013 09:44'!
selectionStop
	^ textArea selectionStop! !

!RubParagraph methodsFor: 'accessing composer' stamp: 'AlainPlantec 3/20/2013 08:36'!
numberOfLines

	^ self lines size! !

!RubParagraph methodsFor: 'accessing' stamp: 'AlainPlantec 5/16/2013 22:30'!
text: aText
	(aText string notEmpty and: [aText runs isEmpty]) 
		ifTrue: [ aText runs: (Array with: self defaultFontChange) ].
	text := aText! !

!RubParagraph methodsFor: 'geometry' stamp: 'AlainPlantec 4/8/2013 11:54'!
extent
	^ self actualWidth
		ifNil: [ self minimumExtent ]
		ifNotNil: [ 
			(self actualWidth + self margins left + self margins right)
				@ (self lines last bottom - self lines first top + self margins top + self margins bottom) ]! !

!RubParagraph methodsFor: 'editing' stamp: 'AlainPlantec 5/7/2013 09:44'!
click: anEvent for: model controller: editor
	"Give sensitive text a chance to fire.  Display flash: (100@100 extent: 100@100)."
	
	| action clickPoint |
	
	clickPoint := anEvent cursorPoint.
	action := false.
	self actionAttributesUnder: clickPoint event: anEvent do: [ :attribute| |target|
		"evaluate the attribute action"
		target := (model ifNil: [textArea]).
		(attribute actOnClick: anEvent for: target in: self editor: editor) == true 	
			ifTrue: [ ^ true ]].
	
	(action and: [ Cursor currentCursor == Cursor webLink]) 
		ifTrue:[ Cursor normal show ].
	
	^ action! !

!RubParagraph methodsFor: 'geometry' stamp: 'AlainPlantec 5/7/2013 09:44'!
minimumExtent
	^ textArea minimumExtent! !

!RubParagraph methodsFor: 'private' stamp: 'AlainPlantec 5/7/2013 08:55'!
aboutToBeUnplugged! !

!RubParagraph methodsFor: 'geometry updating' stamp: 'AlainPlantec 4/11/2013 17:26'!
extentFromClientBottomRight: aPoint
	| w newExtent |
	self wrapped
		ifFalse: [ ^ self extent ].
	newExtent := aPoint.
	w := newExtent x max: self minimumExtent x.
	self container: (self container topLeft extent: (w @ newExtent y) truncated).
	self compose.
	^ newExtent x @ self extent y! !

!RubParagraph methodsFor: 'accessing' stamp: 'AlainPlantec 4/11/2013 16:29'!
position
	^ container topLeft! !

!RubParagraph methodsFor: 'querying' stamp: 'AlainPlantec 4/5/2013 21:23'!
lineIndexOfCharacterIndex: characterIndex 
	"Answer the line index for a given characterIndex."
	"apparently the selector changed with NewParagraph"
	^ self composer lineIndexOfCharacterIndex: characterIndex
! !

!RubParagraph methodsFor: 'accessing text area' stamp: 'AlainPlantec 5/7/2013 16:40'!
scrollPane
	^ textArea scrollPane! !

!RubParagraph methodsFor: 'geometry updating' stamp: 'AlainPlantec 3/21/2013 17:54'!
adjustRightX
	| shrink |
	shrink := self container right - self maxRightX.
	self lines do: [ :line | line paddingWidth: (line paddingWidth - shrink)].
	self container: (self container withRight: self maxRightX)! !

!RubParagraph methodsFor: 'querying' stamp: 'AlainPlantec 5/18/2013 00:09'!
defaultCharacterBlock
	^ (RubCharacterBlock new
		stringIndex: 1
		topLeft: self lines first topLeft
		extent: 0 @ 0) textLine: self lines first! !

!RubParagraph methodsFor: 'drawing' stamp: 'AlainPlantec 4/11/2013 18:49'!
drawOn: aCanvas using: aDisplayScanner at: aPosition
	"Send all visible lines to the displayScanner for display"

	| offset leftInRun line visibleRectangle |
	self drawingEnabled ifFalse: [ ^self ].
	visibleRectangle := aCanvas clipRect.
	offset := (aPosition - self position) truncated.
	leftInRun := 0.
	(self lineIndexForPoint: visibleRectangle topLeft) to: (self lineIndexForPoint: visibleRectangle  bottomRight)
	do: [ :i | 
		line := self lines at: i.
		line first <= line last
			ifTrue: [ leftInRun := aDisplayScanner displayLine: line offset: offset leftInRun: leftInRun ] ].! !

!RubParagraph methodsFor: 'accessing text area' stamp: 'AlainPlantec 5/7/2013 09:44'!
margins
	^textArea margins.
! !

!RubParagraph methodsFor: 'accessing' stamp: 'AlainPlantec 3/20/2013 13:34'!
container
	^ container! !

!RubParagraph methodsFor: 'querying' stamp: 'AlainPlantec 4/11/2013 09:56'!
lineIndexForPoint: aPoint
	"Answer the index of the line in which to select the character nearest to aPoint."
	^ self composer lineIndexForPoint: aPoint! !

!RubParagraph methodsFor: 'initialize-release' stamp: 'AlainPlantec 5/7/2013 09:44'!
unplug
	self releaseComposer.
	textArea := nil.
	text := nil.
	super unplug! !

!RubParagraph methodsFor: 'drawing' stamp: 'AlainPlantec 4/1/2013 11:14'!
disableDrawing
	drawingEnabled := false! !

!RubParagraph methodsFor: 'querying' stamp: 'AlainPlantec 3/20/2013 12:08'!
indentationOfLineIndex: lineIndex ifBlank: aBlock
	"Answer the number of leading tabs in the line at lineIndex.  If there are
	 no visible characters, pass the number of tabs to aBlock and return its value.
	 If the line is word-wrap overflow, back up a line and recur."

	^ self composer indentationOfLineIndex: lineIndex ifBlank: aBlock! !

!RubParagraph methodsFor: 'accessing' stamp: 'AlainPlantec 4/25/2013 10:36'!
composer
	^ composer ifNil: [ composer := self newComposer ]! !

!RubParagraph methodsFor: 'accessing text area' stamp: 'AlainPlantec 5/7/2013 09:44'!
cursorWidth
	^ textArea cursorWidth
! !

!RubParagraph methodsFor: 'accessing' stamp: 'AlainPlantec 4/16/2013 15:14'!
next 
	^nil! !

!RubParagraph methodsFor: 'accessing composer' stamp: 'AlainPlantec 4/11/2013 09:56'!
lines
	^ self composer lines! !

!RubParagraph methodsFor: 'editing' stamp: 'AlainPlantec 3/20/2013 13:22'!
replaceFrom: start to: stop with: aText displaying: displayBoolean 
	"Edit the text, and then recompose the lines." 
	self composer replaceFrom: start to: stop with: aText.
! !

!RubParagraph methodsFor: 'mock selection' stamp: 'AlainPlantec 4/11/2013 12:18'!
findRegex
	^ nil! !

!RubParagraph methodsFor: 'accessing' stamp: 'AlainPlantec 3/19/2013 13:32'!
string
	^ self text string! !

!RubParagraph methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:48'!
textArea
	^ textArea! !

!RubParagraph methodsFor: 'accessing composer' stamp: 'AlainPlantec 4/11/2013 09:56'!
numberOfPhysicalLines

	^ self composer numberOfPhysicalLines! !

!RubParagraph methodsFor: 'accessing' stamp: 'AlainPlantec 5/17/2013 23:17'!
text
	^ text ifNil: [ text := self defaultEmptyText ]! !

!RubParagraph methodsFor: 'composition' stamp: 'AlainPlantec 5/22/2013 17:56'!
compose
	self
		disableDrawingWhile: [ 
			self uptodateComposer 
				composeLinesFrom: 1
				to: self text size
				delta: 0
				into: OrderedCollection new
				priorLines: Array new
				atY: self compositionRectangle top.
			textArea ifNotNil: [ textArea paragraphWasComposedFrom: 1 to: self text size ] ]! !

!RubParagraph methodsFor: 'accessing' stamp: 'AlainPlantec 6/2/2013 14:47'!
selectionRectsFrom: characterBlock1 to: characterBlock2
	"Return an array of rectangles representing the area between the two character blocks given as arguments."

	| line1 line2 rects cb1 cb2 w |
	characterBlock1 = characterBlock2
		ifTrue: [ ^ #() ].
	characterBlock1 <= characterBlock2
		ifTrue: [ 
			cb1 := characterBlock1.
			cb2 := characterBlock2 ]
		ifFalse: [ 
			cb2 := characterBlock1.
			cb1 := characterBlock2 ].
	line1 := self lineIndexOfCharacterIndex: cb1 stringIndex.
	line2 := self lineIndexOfCharacterIndex: cb2 stringIndex.
	line1 = line2
		ifTrue: [ ^ Array with: (cb1 topLeft corner: cb2 bottomRight) ].
	^ Array
		streamContents: [ :strm | 
			| last |
			strm nextPut: (last := cb1 topLeft corner: (self lines at: line1) bottomRight).
			line1 + 1 to: line2 - 1 do: [ :i | 
				| line |
				line := self lines at: i.
				(line left = last left and: [ line right = last right ])
					ifTrue: [ 
						"new line has same margins as old one -- "
						"merge them, so that the caller gets as few rectangles as possible"
						last privateSetCorner: last right @ line bottom ]
					ifFalse: [ 
						"differing margins; cannot merge"
						strm nextPut: (last := line rectangle) ] ].
			strm nextPut: ((self lines at: line2) topLeft corner: cb2 bottomLeft) ]! !

!RubParagraph methodsFor: 'querying' stamp: 'AlainPlantec 4/11/2013 21:21'!
totalTextHeight

	^self lines last bottom! !

!RubParagraph methodsFor: 'accessing' stamp: 'AlainPlantec 5/18/2013 23:13'!
tabWidth
	^ self textStyle rubTabWidth! !

!RubParagraph methodsFor: 'accessing' stamp: 'AlainPlantec 5/19/2013 00:03'!
tabWidth: anInteger
	| newTextStyle tabsArray |
	newTextStyle := self textStyle copy.
	tabsArray := (anInteger to: 99999 by: anInteger) asArray.
	newTextStyle privateTabsArray: tabsArray.
	self textArea privateSetTextStyle: newTextStyle.
	self releaseComposer.
	self compose.
	self textArea recomputeSelection; changed! !

!RubParagraph methodsFor: 'querying' stamp: 'AlainPlantec 5/18/2013 23:15'!
characterBlockForIndex: index 
	"Answer a CharacterBlock for the character in text at index."
	| line |
	line := self lines at: (self lineIndexOfCharacterIndex: index).
	^ (RubCharacterBlockScanner new text: self text textStyle: self textStyle)
		characterBlockAtPoint: nil index: ((index max: line first) min: self text size+1)
		in: line! !

!RubParagraph methodsFor: 'accessing composer' stamp: 'AlainPlantec 4/11/2013 09:56'!
actualWidth
	^ self composer actualWidth! !

!RubParagraph methodsFor: 'geometry updating' stamp: 'AlainPlantec 5/7/2013 09:44'!
updateClientExtent
	textArea updateExtentFromParagraph.
! !

!RubParagraph methodsFor: 'querying' stamp: 'AlainPlantec 4/16/2013 15:46'!
key
	^self class key! !

!RubParagraph methodsFor: 'private' stamp: 'AlainPlantec 4/11/2013 16:08'!
releaseComposer
	composer
		ifNotNil: [ :c | 
			c unplug.
			composer := nil ]! !

!RubParagraph methodsFor: 'accessing text area' stamp: 'AlainPlantec 5/7/2013 09:44'!
textStyle
	^ textArea textStyle! !

!RubParagraph methodsFor: 'querying' stamp: 'AlainPlantec 3/20/2013 08:34'!
containsPoint: aPoint
	^ (self lines at: (self lineIndexForPoint: aPoint)) rectangle
		containsPoint: aPoint! !

!RubParagraph methodsFor: 'querying' stamp: 'AlainPlantec 4/11/2013 20:42'!
lastLineCharacterIndexFromCharacterIndex: anIndex
	| targetLine |
	targetLine := self lines at: (self lineIndexOfCharacterIndex: anIndex).
	^ targetLine = self lines last
		ifTrue: [ targetLine last + 1 ]
		ifFalse: [ targetLine last ]! !

!RubParagraph methodsFor: 'editing' stamp: 'AlainPlantec 11/24/2013 23:19'!
replaceFrom: start to: stop with: aText
	"Edit the text, and then recompose the lines."

	self
		disableDrawingWhile: [ 
			self composer emphasisHere: textArea emphasisHere.
			self composer replaceFrom: start to: stop with: aText.
			self text: self composer text.
			textArea paragraphWasComposedFrom: start to: stop.
			textArea paragraphReplacedTextFrom: start to: stop with: aText ]! !

!RubParagraph methodsFor: 'geometry' stamp: 'AlainPlantec 4/8/2013 11:52'!
width
	^  self wrapped
		ifTrue: [ self container right  -  (self container insetBy: self margins) topLeft x]
		ifFalse: [ SmallInteger maxVal ]! !

!RubParagraph methodsFor: 'copying' stamp: 'AlainPlantec 3/25/2013 10:47'!
deepCopy
	"Don't want to copy the container (etc) or fonts in the TextStyle."

	^ self error: 'A ParagraphHandler should never be deep copied'.! !

!RubParagraph methodsFor: 'composition' stamp: 'AlainPlantec 4/9/2013 19:00'!
compositionExtent
	"Return the bounds for composing this text.  There are two cases:
	1.  wrapped is true -- grow downward as necessary,
	2.  wrapped is false -- grow in 2D as nexessary."

	^ (self wrapped
		ifTrue: [ self container width @ SmallInteger maxVal ]
		ifFalse: [ SmallInteger maxVal @ SmallInteger maxVal ]) max: self minimumCompositionExtent! !

!RubParagraph methodsFor: 'accessing' stamp: 'AlainPlantec 4/25/2013 10:31'!
container: atextContainerOrRectangle
	container := atextContainerOrRectangle.
! !

!RubParagraph methodsFor: 'copying' stamp: 'AlainPlantec 3/25/2013 11:06'!
copy

	^ self error: 'A ParagraphHandler should never be copied'.! !

!RubParagraph methodsFor: 'composition' stamp: 'AlainPlantec 3/25/2013 22:54'!
minimumCompositionExtent

	^ self minimumExtent x - self margins left @ self minimumExtent y! !

!RubParagraph methodsFor: 'accessing text area' stamp: 'AlainPlantec 5/7/2013 09:45'!
openingDelimiters
	^ textArea openingDelimiters
! !

!RubParagraph methodsFor: 'drawing' stamp: 'AlainPlantec 2/26/2015 16:55'!
displayTextOnAthensCanvas: anAthensCanvas in: aRectangle
	| athensDisplayScanner offset leftInRun |
	anAthensCanvas clipBy: aRectangle during:[
	anAthensCanvas pathTransform
		restoreAfter: [ 
			offset := aRectangle topLeft - self position.
			athensDisplayScanner := AthensDisplayScanner for: self on: anAthensCanvas.
			leftInRun := 0.
			self
				forLinesIn: anAthensCanvas clipRect
				do: [ :line | 
					line first <= line last
						ifTrue: [ leftInRun := athensDisplayScanner displayLine: line offset: offset leftInRun: leftInRun ] ] ] ]! !

!RubParagraph methodsFor: 'accessing text area' stamp: 'AlainPlantec 5/7/2013 09:44'!
pointIndex
	^ textArea pointIndex! !

!RubParagraph methodsFor: 'accessing' stamp: 'AlainPlantec 6/2/2013 14:47'!
selectionRects
	"Return an array of rectangles representing the selection region."

	^ self selectionStart
		ifNil: [ Array new ]
		ifNotNil: [ self selectionRectsFrom: self selectionStart to: self selectionStop ]! !

!RubParagraph methodsFor: 'accessing text area' stamp: 'AlainPlantec 5/7/2013 09:44'!
model
	^ textArea model! !

!RubParagraph methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:48'!
textArea: aClient
	"Classically, the client is a Morph which holds the text, the textstyle, the textColor.
	client must never be nil except when I'm released"
	textArea := aClient ! !

!RubParagraph methodsFor: 'drawing' stamp: 'AlainPlantec 2/26/2015 16:38'!
forLinesIn: aVisibleRect do: aBlock
	(self lineIndexForPoint: aVisibleRect topLeft) to: 
	(self lineIndexForPoint: aVisibleRect bottomRight) do: 
		[:i | aBlock value: (self lines at: i) ]! !

!RubParagraph methodsFor: 'accessing composer' stamp: 'AlainPlantec 3/20/2013 11:16'!
maxRightX
	^ self composer maxRightX! !

!RubParagraph methodsFor: 'querying' stamp: 'AlainPlantec 5/21/2013 14:57'!
verticesFrom: firstIndex to: lastIndex
	| firstCB lastCB firstLineIndex lastLineIndex firstLine lastLine vertices secondLine thirdLine |
	firstCB := self characterBlockForIndex: firstIndex.
	lastCB := self characterBlockForIndex: lastIndex.
	firstLineIndex := self lineIndexOfCharacterIndex: firstIndex.
	lastLineIndex := self lineIndexOfCharacterIndex: lastIndex.
	firstLine := self lines at: firstLineIndex.
	lastLine := self lines at: lastLineIndex.
	vertices := OrderedCollection new.
	firstLine = lastLine
		ifTrue: [ 
			vertices add: firstCB bottomLeft.
			vertices add: firstCB topLeft.
			firstIndex ~= lastIndex
				ifTrue: [ 
					vertices add: lastCB topLeft.
					vertices add: lastCB bottomLeft.
					vertices add: firstCB bottomLeft ] ]
		ifFalse: [ 
			secondLine := self lines at: firstLineIndex + 1.
			thirdLine := self lines at: lastLineIndex - 1.
			vertices add: firstCB bottomLeft - (1@0).
			vertices add: firstCB topLeft - (1@0).
			vertices add: (self textArea right - self margins right) @ firstLine top.
			vertices add: (self textArea right - self margins right) @ thirdLine bottom.
			vertices add: lastCB topLeft.
			vertices add: lastCB bottomLeft.
			vertices add: lastLine bottomLeft - (1@0).
			vertices add: secondLine topLeft - (1@0).
			vertices add: firstCB bottomLeft - (1@0)].
	^ vertices! !

!RubParagraph methodsFor: 'drawing' stamp: 'AlainPlantec 4/1/2013 11:13'!
drawingEnabled
	^ drawingEnabled ifNil: [ drawingEnabled := true ]! !

!RubParagraph class methodsFor: 'querying' stamp: 'AlainPlantec 4/16/2013 15:01'!
key
	^ nil! !

!RubParagraphDecorator methodsFor: 'drawing' stamp: 'AlainPlantec 5/10/2013 07:56'!
drawOn: aCanvas using: aDisplayScanner at: aPosition
	self drawingEnabled ifFalse: [ ^self ].
	self selectionStart ifNil: [ ^self ].
	self selectionStop ifNil: [ ^self ].
	self handleDrawingOn: aCanvas using: aDisplayScanner at: aPosition.
	next drawOn: aCanvas using: aDisplayScanner at: aPosition! !

!RubParagraphDecorator methodsFor: 'accessing' stamp: 'AlainPlantec 4/8/2013 14:20'!
next
	^ next! !

!RubParagraphDecorator methodsFor: 'querying' stamp: 'AlainPlantec 4/18/2013 10:46'!
hasDecoratorNamed: aKey
	^ self key = aKey or: [ next hasDecoratorNamed: aKey ]! !

!RubParagraphDecorator methodsFor: 'accessing' stamp: 'AlainPlantec 4/8/2013 14:20'!
next: anObject
	next := anObject! !

!RubParagraphDecorator methodsFor: 'querying' stamp: 'AlainPlantec 4/18/2013 10:45'!
decoratorNamed: aKey
	^ self key = aKey
		ifTrue: [ self ]
		ifFalse: [ next decoratorNamed: aKey ]! !

!RubParagraphDecorator methodsFor: 'drawing' stamp: 'AlainPlantec 4/11/2013 15:29'!
clippedRectangle
	^ canvas clipRect.
! !

!RubParagraphDecorator methodsFor: 'error handling' stamp: 'AlainPlantec 5/7/2013 09:18'!
doesNotUnderstand: aMessage
	^ [ aMessage sendTo: next ]
		on: MessageNotUnderstood
		do: [ super doesNotUnderstand: aMessage ]! !

!RubParagraphDecorator methodsFor: 'drawing' stamp: 'AlainPlantec 2/26/2015 19:07'!
drawOnAthensCanvas: aCanvas bounds: aRectangle color: aColor
	self drawingEnabled ifFalse: [ ^self ].
	self selectionStart ifNil: [ ^self ].
	self selectionStop ifNil: [ ^self ].
	self handleDrawingOnAthensCanvas: aCanvas bounds: aRectangle.
	next drawOnAthensCanvas: aCanvas bounds: aRectangle color: aColor! !

!RubParagraphDecorator methodsFor: 'accessing' stamp: 'AlainPlantec 11/13/2014 18:22'!
visibleStringFrom: topLeft to: bottomRight
	| topLeftBlk bottomRightBlk startIdx stopIdx string  |
	topLeftBlk := self characterBlockAtPoint: topLeft.
	bottomRightBlk := self characterBlockAtPoint: bottomRight.
	startIdx := topLeftBlk stringIndex.
	stopIdx := bottomRightBlk stringIndex.
	string := self text string.
	^ self text string copyFrom: startIdx to: (stopIdx min: string size)
! !

!RubParagraphDecorator methodsFor: 'drawing' stamp: 'AlainPlantec 4/23/2013 21:36'!
draw
	"do nothing by default"! !

!RubParagraphDecorator methodsFor: 'drawing' stamp: 'AlainPlantec 2/26/2015 19:10'!
handleDrawingOn: aCanvas using: aDisplayScanner at: aPosition
	canvas := aCanvas.
	position := aPosition.
	self draw! !

!RubParagraphDecorator methodsFor: 'drawing' stamp: 'AlainPlantec 2/26/2015 19:32'!
handleDrawingOnAthensCanvas: aCanvas bounds: aRectangle
	canvas := aCanvas.
	displayScanner := nil.
	position := aRectangle topLeft.
	self drawOnAthensCanvas! !

!RubParagraphDecorator methodsFor: 'querying' stamp: 'AlainPlantec 4/16/2013 15:04'!
key
	^self class key! !

!RubParagraphDecorator methodsFor: 'drawing' stamp: 'AlainPlantec 2/26/2015 19:32'!
drawOnAthensCanvas
	"do nothing by default"! !

!RubParagraphDecorator methodsFor: 'initialize-release' stamp: 'AlainPlantec 4/16/2013 15:31'!
unplug
	next
		ifNotNil: [ 
			next unplug.
			next := nil ].
	super unplug! !

!RubParagraphDecorator methodsFor: 'querying' stamp: 'AlainPlantec 4/16/2013 15:38'!
hasDecorator: aDecorator
	^ self = aDecorator or: [ next hasDecorator: aDecorator ]! !

!RubParagraphDecorator class methodsFor: 'querying' stamp: 'AlainPlantec 4/16/2013 14:47'!
key
	^ self subclassResponsibility ! !

!RubParagraphDecorator class methodsFor: 'instance creation' stamp: 'AlainPlantec 4/8/2013 10:45'!
next: aDecoratorOrAParagraph
	^ self new next: aDecoratorOrAParagraph ! !

!RubParagraphDecorator class methodsFor: 'querying' stamp: 'AlainPlantec 4/18/2013 10:45'!
classOfDecoratorNamed: aKey 
	^ self allSubclasses detect: [ :cls | cls key = aKey ] ifNone: [  ]! !

!RubPlainSegmentMorph methodsFor: 'initialization' stamp: 'AlainPlantec 5/29/2013 23:10'!
defaultColor
	^ Color yellow alpha: 0.5.
! !

!RubPlainSegmentMorph methodsFor: 'initialization' stamp: 'AlainPlantec 5/29/2013 23:10'!
defaultBorderColor
	^ Color yellow
! !

!RubPlainTextMode methodsFor: 'text area alignment' stamp: 'AlainPlantec 5/17/2013 20:50'!
centered 
	self changeAlignment: #centered! !

!RubPlainTextMode methodsFor: 'text area font' stamp: 'AlainPlantec 5/17/2013 23:20'!
fontName: fontName pointSize: pointSize
	| newTextStyle |
	(LogicalFontManager current allFamilies detect: [ :f | f familyName = fontName ] ifNone: [  ])
		ifNotNil: [ :fam | 
			| style font |
			style := fam members detect: [ :m | m styleName = 'Regular' ].
			font := style asLogicalFontOfPointSize: pointSize.
			newTextStyle := font textStyle ]
		ifNil: [ newTextStyle := ((TextStyle named: fontName asSymbol) ifNil: [ TextStyle default ]) copy ].
	self textArea privateTextStyle: newTextStyle.
	self textArea addAttribute: (TextFontChange fontNumber: (newTextStyle fontIndexOfPointSize: pointSize))! !

!RubPlainTextMode methodsFor: 'text area emphasis' stamp: 'AlainPlantec 5/17/2013 20:51'!
italic
	
	self changeEmphasis: #italic! !

!RubPlainTextMode methodsFor: 'text area emphasis' stamp: 'AlainPlantec 5/17/2013 20:51'!
narrow
	
	self changeEmphasis: #narrow! !

!RubPlainTextMode methodsFor: 'text area alignment' stamp: 'AlainPlantec 5/17/2013 20:50'!
rightFlush 
	
	self changeAlignment: #rightFlush
! !

!RubPlainTextMode methodsFor: 'text area alignment' stamp: 'AlainPlantec 5/17/2013 22:14'!
changeAlignment: aSymbol
	"Change the alignment of the receiver. Alignment can be #leftFlush #centered #rightFlush #justified "
	
	"| t |
t := 'khkjhjkhjkhjkh
kjhj
kjhkjhkjh
kjh
kjhkjh kjh jh jh jh jh kjh kjh ' asTextMorph.
t openInWorld.
t selectAll; changeFormatting: #rightFlush.
t inspect"
	self textArea beEditableWhile: [ self editor applyAttribute: (TextAlignment perform: aSymbol)].
	self textArea changed! !

!RubPlainTextMode methodsFor: 'text area emphasis' stamp: 'AlainPlantec 5/17/2013 20:52'!
normal
	
	self changeEmphasis: #normal! !

!RubPlainTextMode methodsFor: 'text area font' stamp: 'AlainPlantec 5/18/2013 00:15'!
beAllFont: aFont
	self textArea font: aFont! !

!RubPlainTextMode methodsFor: 'text area emphasis' stamp: 'AlainPlantec 5/17/2013 20:51'!
bold
	
	self changeEmphasis: #bold! !

!RubPlainTextMode methodsFor: 'text area alignment' stamp: 'AlainPlantec 5/17/2013 20:50'!
leftFlush 

	self changeAlignment: #leftFlush
! !

!RubPlainTextMode methodsFor: 'text area alignment' stamp: 'AlainPlantec 5/17/2013 20:50'!
justified 
	self changeAlignment: #justified! !

!RubPlainTextMode methodsFor: 'text area emphasis' stamp: 'AlainPlantec 5/17/2013 20:52'!
struckOut
	
	self changeEmphasis: #struckOut! !

!RubPlainTextMode methodsFor: 'text area font' stamp: 'AlainPlantec 5/17/2013 20:55'!
fontName: fontName size: pointSize
	| newTextStyle |
	(LogicalFontManager current allFamilies detect: [ :f | f familyName = fontName ] ifNone: [  ])
		ifNotNil: [ :fam | 
			| style font |
			style := fam members detect: [ :m | m styleName = 'Regular' ].
			font := style asLogicalFontOfPointSize: pointSize.
			newTextStyle := font textStyle ]
		ifNil: [ newTextStyle := ((TextStyle named: fontName asSymbol) ifNil: [ TextStyle default ]) copy ].
	self textArea privateTextStyle: newTextStyle.
	self addAttribute: (TextFontChange fontNumber: (newTextStyle fontIndexOfSize: pointSize))! !

!RubPlainTextMode methodsFor: 'text area emphasis' stamp: 'AlainPlantec 5/17/2013 22:15'!
changeEmphasis: aSymbol
	"Change the alignment of the receiver. Alignment can be #normal, #bold,  #italic, #narrow, #underlined, or #struckOut"

	"| t |
t := 'khkjhjkhjkhjkh
kjhj
kjhkjhkjh
kjh
kjhkjh kjh jh jh jh jh kjh kjh ' asTextMorph.
t openInWorld.
t selectAll; changeEmphasis: #bold.
t inspect"

	self textArea beEditableWhile: [ self editor applyAttribute: (TextEmphasis perform: aSymbol) ].	
	"this code should be moved to TextEditor but changeEmphasis: is defined there for something else
	so it should be renamed first there."
	self textArea changed! !

!RubPlainTextMode methodsFor: 'text area font' stamp: 'AlainPlantec 5/18/2013 00:11'!
fontPointSize: pointSize
	self textArea addAttribute: (TextFontChange fontNumber: (self textStyle fontIndexOfPointSize: pointSize))! !

!RubPlainTextMode methodsFor: 'text area emphasis' stamp: 'AlainPlantec 5/17/2013 20:52'!
underlined
	
	self changeEmphasis: #underlined! !

!RubPlainTextMode class methodsFor: 'menu' stamp: 'StephaneDucasse 11/11/2014 18:30'!
fontMenuOn: aBuilder
	"Specify the menu used when writing text. Try it with:
	(PragmaMenuBuilder 
		pragmaKeyword: 'RubTextEditorShiftedMenu'
		model: nil) menu popUpInWorld"

	(aBuilder item: #'fontItems')
		label: 'Font...';
		withSeparatorAfter;
		with: [ 
					(aBuilder item: #'Set font...' translated)
						keyText: 'k';
						selector: #offerFontMenu.
					(aBuilder item: #'Set alignment...' translated)
						selector: #chooseAlignment;
						withSeparatorAfter ]! !

!RubPlainTextMode class methodsFor: 'menu' stamp: 'AlainPlantec 5/20/2014 23:15'!
menuOn: aBuilder
	"Specify the menu used when writing text. Try it with:
	(PragmaMenuBuilder 
		pragmaKeyword: 'RubTextEditorMenu'
		model: nil) menu popUpInWorld"

	<contextMenu>
	<RubPlainTextMenu>
	| uitheme |
	uitheme := Smalltalk ui icons.
	(aBuilder item: #'Find...' translated)
		keyText: 'f';
		selector: #find;
		icon: uitheme smallFindIcon.
	(aBuilder item: #'Find again' translated)
		keyText: 'g';
		selector: #findAgain;
		icon: uitheme smallFindIcon.
	(aBuilder item: #'Set search string' translated)
		keyText: 'h';
		selector: #setSearchString.
	self currentUser canBrowse
		ifTrue: [ self extendedSearchMenuOn: aBuilder ].
	aBuilder model canChangeText
		ifTrue: [ 
			(aBuilder item: #'Do again' translated)
				keyText: 'j';
				selector: #again;
				icon: uitheme smallRedoIcon.
			(aBuilder item: #Undo translated)
				keyText: 'z';
				selector: #undo;
				icon: uitheme smallUndoIcon;
				withSeparatorAfter.
			self fontMenuOn: aBuilder ].
	(aBuilder item: #Copy translated)
		keyText: 'c';
		selector: #copySelection;
		icon: uitheme smallCopyIcon.
	aBuilder model canChangeText
		ifTrue: [ 
			(aBuilder item: #Cut translated)
				keyText: 'x';
				selector: #cut;
				icon: uitheme smallCutIcon.
			(aBuilder item: #Paste translated)
				keyText: 'v';
				selector: #paste;
				icon: uitheme smallPasteIcon.
			(aBuilder item: #'Paste...' translated)
				selector: #pasteRecent;
				icon: uitheme smallCopyIcon;
				withSeparatorAfter.
			aBuilder model model
				ifNotNil: [ 
					(aBuilder item: #Accept translated)
						keyText: 's';
						selector: #accept;
						icon: uitheme smallOkIcon.
					(aBuilder item: #Cancel translated)
						keyText: 'l';
						selector: #cancel;
						icon: uitheme smallCancelIcon ] ]! !

!RubPlainTextMode class methodsFor: 'accessing' stamp: 'AlainPlantec 5/17/2013 14:07'!
label
	^ 'Plain text'! !

!RubPlainTextMode class methodsFor: 'menu' stamp: 'AlainPlantec 5/20/2014 22:45'!
menuKeyword
	^ 'RubPlainTextMenu'! !

!RubPlainTextMode class methodsFor: 'menu' stamp: 'AlainPlantec 3/17/2014 12:08'!
editingModeMenuOn: aBuilder
	"Specify the menu used to select an editing mode"

	<contextMenu>
	<RubEditingModeMenu>
	(aBuilder item: self label translated)
		action: [:model | model textArea editingMode: self new ]! !

!RubPrimarySelectionMorph methodsFor: 'initialization' stamp: 'AlainPlantec 6/2/2013 14:55'!
initialize
	super initialize.
	self beExtendable! !

!RubPrimarySelectionMorph methodsFor: 'initialization' stamp: 'AlainPlantec 6/4/2013 00:33'!
defaultColor
	^ self theme selectionColor
! !

!RubPrimarySelectionMorph methodsFor: 'accessing' stamp: 'AlainPlantec 6/4/2013 00:34'!
selectionColor
	^ self textArea hasFocus
		ifTrue: [ self theme selectionColor ]
		ifFalse: [ self theme unfocusedSelectionColor alphaMixed: 0.3 with: Color veryLightGray lighter ]! !

!RubPrimarySelectionMorph methodsFor: 'ui' stamp: 'AlainPlantec 6/2/2013 15:31'!
readWriteView
	| view |
	view  := super readWriteView.
	^ view! !

!RubPrimarySelectionMorph methodsFor: 'initialization' stamp: 'AlainPlantec 6/2/2013 14:56'!
defaultBorderColor
	^ Color orange
! !

!RubPrimarySelectionMorph methodsFor: 'protocol-events' stamp: 'AlainPlantec 6/2/2013 14:52'!
whenTextAreaGotFocus: anAnnouncement 
	self color: self selectionColor ! !

!RubPrimarySelectionMorph methodsFor: 'protocol-events' stamp: 'AlainPlantec 6/2/2013 14:52'!
whenTextAreaLostFocus: anAnnouncement 
	self color: self selectionColor ! !

!RubPrimarySelectionMorph methodsFor: 'event handling' stamp: 'AlainPlantec 6/3/2013 23:27'!
registerTextArea 
	super registerTextArea.
	textArea announcer subscribe:  RubSelectionChanged send: #whenTextAreaSelectionChanged: to: self.
	textArea announcer subscribe:  MorphGotFocus send: #whenTextAreaGotFocus: to: self.	
	textArea announcer subscribe:  MorphLostFocus send: #whenTextAreaLostFocus: to: self.	
! !

!RubPrimarySelectionMorph methodsFor: 'protocol-events' stamp: 'AlainPlantec 6/3/2013 23:26'!
whenTextAreaSelectionChanged: anAnnouncement 
	firstIndex := self textArea markIndex min: self textArea pointIndex.
	lastIndex := self textArea pointIndex max: self textArea markIndex.
	self computeVertices.
	self announcer announce: RubTextSetInModel.
! !

!RubReturnEntered methodsFor: 'accessing' stamp: 'AlainPlantec 5/9/2013 08:38'!
accepted
	^ accepted ifNil: [ accepted := false ]! !

!RubReturnEntered methodsFor: 'accessing' stamp: 'AlainPlantec 4/26/2013 12:00'!
accepted: aBoolean
	accepted := aBoolean! !

!RubSHTextStylerST80 commentStamp: 'AndreiChis 11/12/2014 12:03'!
I extend SHTextStylerST80 and replace the links  for methdos , classes and variables with the Rubric specific links.!
!RubSHTextStylerST80 methodsFor: 'private' stamp: 'AlainPlantec 11/25/2014 14:30'!
addLinkAttributesFor: ranges in: aText to: charAttributes
	| links |
	"TODO: put this on class side"
	links := Dictionary new.
 
	"see SHTextStylerST80 class >> #defaultStyleTable for more types"
	links at: #instVar put: [ :aString| RubTextVariableLink variableName: aString ].
	links at: #globalVar put: [ :aString| RubTextClassLink className: aString ].
	#(binary unary  keyword) do: [ :type|
		links at: type put: [ :aString| RubTextMethodLink selector: aString ]].
	#(pragmaUnary pragmaBinary patternBinary patternUnary patternKeyword) do: [ :type|
		links at: type put: [ :aString| RubTextMethodLink selector: aString senders: true]].
	links at: #true put: [ :aString| RubTextClassLink class: True ].
	links at: #false put: [ :aString| RubTextClassLink class: False ].
	links at: #nil put: [ :aString| RubTextClassLink class: UndefinedObject ].
	links at: #character put: [ :aString| RubTextClassLink class: Character ].
	
	"set the attrinbutes on the text"
	ranges do: [ :range|
		links at: range type ifPresent: [ :action| |attributes|
			attributes := charAttributes at: range start.
			attributes := attributes, { action cull: (range stringIn: aText) }.
			charAttributes 
				from: range start
				to: range end
				put: attributes ]]! !

!RubSHTextStylerST80 class methodsFor: 'initialization' stamp: 'AndreiChis 11/14/2014 11:29'!
initialize
	"self initialize"
	styleTable := nil.
	textAttributesByPixelHeight := nil.! !

!RubSHTextStylerST80 class methodsFor: 'accessing' stamp: 'AndreiChis 11/14/2014 11:29'!
styleTable
	^ SHTextStylerST80 styleTable! !

!RubSHTextStylerST80 class methodsFor: 'accessing' stamp: 'AndreiChis 11/14/2014 11:30'!
styleTable: anArray 
	SHTextStylerST80 styleTable: anArray ! !

!RubSHTextStylerST80 class methodsFor: 'style table' stamp: 'AndreiChis 11/14/2014 15:08'!
initialTextAttributesForPixelHeight: aNumber 
	^ SHTextStylerST80 initialTextAttributesForPixelHeight: aNumber ! !

!RubSHTextStylerST80 class methodsFor: 'accessing' stamp: 'AndreiChis 11/14/2014 15:08'!
textAttributesByPixelHeight  
	^ SHTextStylerST80 textAttributesByPixelHeight ! !

!RubScrollBar methodsFor: 'style' stamp: 'AlainPlantec 4/12/2013 21:41'!
normalThumbFillStyle
	"Return the normal thumb fillStyle for the receiver."
	
	^(self theme scrollbarNormalThumbFillStyleFor: self) asColor darker! !

!RubScrollBar methodsFor: 'style' stamp: 'AlainPlantec 4/12/2013 21:44'!
mouseOverThumbButtonFillStyle
	"Return the mouse over thumb fillStyle for the receiver."
	
	^(self theme scrollbarMouseOverThumbButtonFillStyleFor: self) asColor darker! !

!RubScrollBar methodsFor: 'style' stamp: 'AlainPlantec 4/12/2013 21:41'!
pressedThumbFillStyle
	"Return the pressed thumb fillStyle for the receiver."
	
	^(self theme scrollbarPressedThumbFillStyleFor: self) asColor darker! !

!RubScrolledTextExtra commentStamp: '<historical>'!
RubScrolledTextExtra represents the root of rulers graphical representations (which add specific behavior to the scrolledText on which they are attached).

Subinstances are the graphical representation of the associated decorators defined in the .

 the main methods are 
	- computedExtentFrom:
	- computedHeightFrom: 
	- computedPositionFrom:
	- computedWidthFrom:
	
!
!RubScrolledTextExtra methodsFor: 'accessing' stamp: 'AlainPlantec 4/17/2013 12:05'!
lineIndexForPoint: aPoint
	^ self paragraph lineIndexForPoint: aPoint  + (0 @ (self offset y - self bounds top))! !

!RubScrolledTextExtra methodsFor: 'defaults' stamp: 'AlainPlantec 4/15/2013 16:15'!
defaultColor
	^ self defaultBackgroundColor ! !

!RubScrolledTextExtra methodsFor: 'accessing' stamp: 'AlainPlantec 4/27/2013 01:31'!
selectionStart
	^ self paragraph selectionStart! !

!RubScrolledTextExtra methodsFor: 'event handling' stamp: 'AlainPlantec 2/6/2014 09:13'!
scrollerOffsetChanged
	self changed! !

!RubScrolledTextExtra methodsFor: 'structure' stamp: 'AlainPlantec 5/7/2013 08:28'!
topRendererOrSelf
	^self paragraphProvider! !

!RubScrolledTextExtra methodsFor: 'accessing' stamp: 'AlainPlantec 4/17/2013 11:17'!
offset
	^ self paragraphProvider scrollPane offset! !

!RubScrolledTextExtra methodsFor: 'accessing' stamp: 'AlainPlantec 4/22/2013 14:42'!
computedHeightFrom: aRectangle
	^ aRectangle height! !

!RubScrolledTextExtra methodsFor: 'accessing' stamp: 'AlainPlantec 4/17/2013 11:23'!
lines
	^ self paragraph lines! !

!RubScrolledTextExtra methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:48'!
textArea
	^ self paragraph textArea! !

!RubScrolledTextExtra methodsFor: 'accessing' stamp: 'AlainPlantec 4/22/2013 13:25'!
level
	^ 0! !

!RubScrolledTextExtra methodsFor: 'accessing' stamp: 'AlainPlantec 4/22/2013 14:43'!
computedExtentFrom: aRectangle
	^ (self computedWidthFrom: aRectangle) @ (self computedHeightFrom: aRectangle)! !

!RubScrolledTextExtra methodsFor: 'geometry' stamp: 'AlainPlantec 4/19/2013 09:42'!
manageLayoutInBounds: aRectangle
! !

!RubScrolledTextExtra methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:48'!
text 
	^ self textArea text! !

!RubScrolledTextExtra methodsFor: 'initialize-release' stamp: 'AlainPlantec 4/22/2013 18:47'!
initialize
	super initialize.
	self clipSubmorphs: true! !

!RubScrolledTextExtra methodsFor: 'testing' stamp: 'AlainPlantec 4/19/2013 09:27'!
isVertical
	^ false! !

!RubScrolledTextExtra methodsFor: 'accessing' stamp: 'AlainPlantec 6/4/2013 09:18'!
primarySelectionColor
	^ self textArea primarySelectionColor! !

!RubScrolledTextExtra methodsFor: 'defaults' stamp: 'AlainPlantec 4/15/2013 16:15'!
defaultBackgroundColor 
	^ Color transparent! !

!RubScrolledTextExtra methodsFor: 'testing' stamp: 'AlainPlantec 4/19/2013 09:24'!
isHorizontal
	^ false! !

!RubScrolledTextExtra methodsFor: 'accessing' stamp: 'AlainPlantec 4/17/2013 16:43'!
scrollBounds
	^ self paragraphProvider scrollBounds! !

!RubScrolledTextExtra methodsFor: 'accessing' stamp: 'AlainPlantec 4/16/2013 16:39'!
key
	^self class key! !

!RubScrolledTextExtra methodsFor: 'submorphs-accessing' stamp: 'AlainPlantec 2/6/2014 12:05'!
noteNewOwner: aMorph 
	super noteNewOwner: aMorph! !

!RubScrolledTextExtra methodsFor: 'accessing' stamp: 'AlainPlantec 5/17/2013 10:39'!
textStyle

	^ self textArea textStyle.
! !

!RubScrolledTextExtra methodsFor: 'testing' stamp: 'AlainPlantec 4/19/2013 09:24'!
isOver
	^ false! !

!RubScrolledTextExtra methodsFor: 'accessing' stamp: 'AlainPlantec 4/17/2013 11:29'!
paragraph
	^ self paragraphProvider ifNotNil: [:p | p paragraph]! !

!RubScrolledTextExtra methodsFor: 'accessing' stamp: 'AlainPlantec 4/27/2013 01:31'!
selectionStop
	^ self paragraph selectionStop! !

!RubScrolledTextExtra methodsFor: 'accessing' stamp: 'AlainPlantec 4/16/2013 17:47'!
paragraphProvider
	| o |
	o := owner.
	[ o notNil ]
		whileTrue: [ 
			o isParagraphProvider
				ifTrue: [ ^ o ].
			o := o owner ].
	^ nil! !

!RubScrolledTextExtra methodsFor: 'event handling' stamp: 'AlainPlantec 2/6/2014 13:32'!
textAccepted
	self changed! !

!RubScrolledTextExtra methodsFor: 'event handling' stamp: 'AlainPlantec 2/6/2014 09:54'!
textChanged
	self changed! !

!RubScrolledTextExtra methodsFor: 'accessing' stamp: 'AlainPlantec 4/22/2013 14:41'!
computedPositionFrom: aRectangle
	^ aRectangle topLeft! !

!RubScrolledTextExtra methodsFor: 'event handling' stamp: 'AlainPlantec 2/6/2014 12:04'!
selectionChanged
	self changed! !

!RubScrolledTextExtra methodsFor: 'accessing' stamp: 'AlainPlantec 4/22/2013 15:00'!
computedWidthFrom: aRectangle
	^ aRectangle width ! !

!RubScrolledTextExtra methodsFor: 'accessing' stamp: 'AlainPlantec 4/17/2013 15:46'!
scrollPane
	^ self paragraphProvider scrollPane! !

!RubScrolledTextExtra methodsFor: 'testing' stamp: 'AlainPlantec 4/19/2013 09:24'!
isSideRuler
	^ false! !

!RubScrolledTextExtra methodsFor: 'initialize-release' stamp: 'AlainPlantec 5/7/2013 09:34'!
unplug
	self paragraphProvider
		ifNotNil: [ 
			self scrollPane ifNotNil: [:sp | sp announcer unsubscribe: self].
			self textArea ifNotNil: [:ts | ts announcer unsubscribe: self ] ].
	super unplug ! !

!RubScrolledTextExtra methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:48'!
margins
	^ self textArea margins! !

!RubScrolledTextExtra class methodsFor: 'querying' stamp: 'AlainPlantec 4/19/2013 08:45'!
key
	^ nil! !

!RubScrolledTextExtra class methodsFor: 'querying' stamp: 'AlainPlantec 4/18/2013 10:43'!
classOfRulerNamed: aKey 
	^ self allSubclasses detect: [ :cls | cls key = aKey ] ifNone: [  ]! !

!RubScrolledTextExtraSurface methodsFor: 'accessing' stamp: 'AlainPlantec 4/22/2013 15:00'!
computedWidthFrom: aRectangle
	^  aRectangle width min: self scrollBounds width
! !

!RubScrolledTextExtraSurface methodsFor: 'testing' stamp: 'AlainPlantec 4/19/2013 09:09'!
isOver
	^ true! !

!RubScrolledTextExtraSurface methodsFor: 'accessing' stamp: 'AlainPlantec 5/19/2013 23:37'!
level
	^ 0! !

!RubScrolledTextExtraSurface methodsFor: 'accessing' stamp: 'AlainPlantec 4/22/2013 15:49'!
computedPositionFrom: aRectangle
	^  aRectangle topLeft
! !

!RubScrolledTextExtraSurface methodsFor: 'geometry' stamp: 'AlainPlantec 4/23/2013 01:09'!
manageLayoutInBounds: aRectangle
	self position: (self computedPositionFrom: aRectangle).
	self extent: (self computedExtentFrom: aRectangle).
	self changed.
	^ aRectangle ! !

!RubScrolledTextExtraSurface methodsFor: 'accessing' stamp: 'AlainPlantec 4/22/2013 14:59'!
computedHeightFrom: aRectangle
	^ aRectangle height min: self scrollBounds height! !

!RubScrolledTextModel methodsFor: 'accessing' stamp: 'AlainPlantec 7/31/2013 09:49'!
announcer
	^ announcer ifNil: [ announcer := self defaultAnnouncer ]! !

!RubScrolledTextModel methodsFor: 'view updating' stamp: 'AlainPlantec 2/7/2014 11:58'!
reconfigureViewWith: aBlockWithAScrolledTextMorphAsArgument
	self announce: (RubConfigurationChange new configurationBlock: aBlockWithAScrolledTextMorphAsArgument)
! !

!RubScrolledTextModel methodsFor: 'menu' stamp: 'AlainPlantec 5/21/2014 00:04'!
menu
	^ nil! !

!RubScrolledTextModel methodsFor: 'text managing' stamp: 'AlainPlantec 8/1/2013 19:50'!
getText
	^ self text! !

!RubScrolledTextModel methodsFor: 'view creating' stamp: 'AlainPlantec 8/1/2013 19:42'!
newScrolledText
	^ (RubScrolledTextMorph on: self) getSelectionSelector: #primarySelectionInterval; yourself! !

!RubScrolledTextModel methodsFor: 'text managing' stamp: 'AlainPlantec 8/1/2013 19:32'!
primarySelectionInterval
	^ primarySelectionInterval ! !

!RubScrolledTextModel methodsFor: 'text managing' stamp: 'AlainPlantec 7/31/2013 09:47'!
text:  atextOrString
	text := atextOrString asText! !

!RubScrolledTextModel methodsFor: 'accessing' stamp: 'AlainPlantec 8/1/2013 19:36'!
announce: anAnnouncement 
	self announcer announce: anAnnouncement! !

!RubScrolledTextModel methodsFor: 'text managing' stamp: 'AlainPlantec 8/2/2013 10:06'!
setPrimarySelectionInterval: anInterval

	primarySelectionInterval := anInterval.
	self announce: RubPrimarySelectionUpdatedInModel! !

!RubScrolledTextModel methodsFor: 'accessing' stamp: 'AlainPlantec 7/31/2013 09:50'!
defaultAnnouncerClass 
	^Announcer! !

!RubScrolledTextModel methodsFor: 'text managing' stamp: 'AlainPlantec 7/31/2013 12:55'!
setText: aText 
	self text:  aText.
	self announcer announce: RubTextUpdatedInModel.
	^ true! !

!RubScrolledTextModel methodsFor: 'text managing' stamp: 'AlainPlantec 7/31/2013 09:48'!
text

	^ text ifNil: [ text := '' asText ]! !

!RubScrolledTextModel methodsFor: 'text managing' stamp: 'AlainPlantec 7/31/2013 12:55'!
setText: aText from: aView
	^ self setText: aText! !

!RubScrolledTextModel methodsFor: 'accessing' stamp: 'AlainPlantec 7/31/2013 09:50'!
defaultAnnouncer
	^ self defaultAnnouncerClass new! !

!RubScrolledTextMorph commentStamp: '<historical>'!
A RubScrolledText is a replacement for PluggableTextMorph

Instance Variables
	alwaysAccept:		<Object>
	getTextSelector:		<Object>
	hasEditingConflicts:		<Object>
	hasUnacceptedEdits:		<Object>
	hasValidText:		<Object>
	setTextSelector:		<Object>

alwaysAccept
	- xxxxx

getTextSelector
	- xxxxx

hasEditingConflicts
	- xxxxx

hasUnacceptedEdits
	- xxxxx

hasValidText
	- xxxxx

setTextSelector
	- xxxxx
!
!RubScrolledTextMorph methodsFor: 'model protocol' stamp: 'AlainPlantec 5/16/2013 21:55'!
getSelectionSelector: aSelector
	getSelectionSelector := aSelector.
! !

!RubScrolledTextMorph methodsFor: 'classification' stamp: 'AlainPlantec 4/12/2013 23:57'!
isRenderer
	^ true! !

!RubScrolledTextMorph methodsFor: 'model protocol' stamp: 'AlainPlantec 8/27/2013 15:33'!
scrollToBeginningOfLine
	self scrollPane scrollToBeginningOfLine! !

!RubScrolledTextMorph methodsFor: 'accessing rulers' stamp: 'AlainPlantec 4/18/2013 10:51'!
withoutLineNumbers
	self withoutRulerNamed: #lineNumbers! !

!RubScrolledTextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 4/16/2013 13:44'!
handleMouseDown: event
	^ super handleMouseDown: event! !

!RubScrolledTextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 5/30/2013 14:37'!
mouseWheel: event 
	"Handle a mouseWheel event."
	
	(self scrollTarget handlesMouseWheel: event)
		ifTrue: [^self scrollTarget mouseWheel: event]. "pass on"! !

!RubScrolledTextMorph methodsFor: 'rulers handling' stamp: 'AlainPlantec 2/6/2014 14:02'!
withoutRuler: aRuler
	(self hasRuler: aRuler)
		ifFalse: [ ^ self ].
	rulers remove: aRuler.
	self removeMorph: aRuler.
	self manageLayout.
	self changed! !

!RubScrolledTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/17/2013 13:57'!
classOrMetaClass: aBehavior
	self textArea classOrMetaClass: aBehavior! !

!RubScrolledTextMorph methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 3/17/2015 23:13'!
font: aFont
	"polymorphism with text area"
	self textFont: aFont! !

!RubScrolledTextMorph methodsFor: 'initialize-release' stamp: 'TudorGirba 6/2/2014 11:19'!
initialize
	super initialize.
	self clipSubmorphs: true.
	rulers := SortedCollection sortBlock: [ :a :b | b level < a level ].
	self addMorph: (scrollPane := self newScrollPane).
	self announcer subscribe: RubConfigurationChange send: #whenConfigurationChanged: to: self.
	self textArea announcer subscribe: RubCanceEditRequested send: #whenCanceEditRequested: to: self.
	self textArea announcer subscribe: MorphGotFocus send: #whenGotForcus: to: self.
	self textArea announcer subscribe: MorphLostFocus send: #whenLostForcus: to: self.
	self textArea announcer subscribe: RubTextAcceptRequest  send: #whenTextAcceptRequest: to: self.
	self withAdornment.


	self borderStyle: self borderStyleToUse	
! !

!RubScrolledTextMorph methodsFor: 'accessing rulers' stamp: 'AlainPlantec 4/19/2013 08:29'!
withCodeSizeFeedback
	self withRulerNamed: #codeSizeFeedback! !

!RubScrolledTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/17/2013 11:28'!
wrapped
	^ self scrollPane wrapped! !

!RubScrolledTextMorph methodsFor: 'accessing rulers' stamp: 'AlainPlantec 5/17/2013 08:51'!
withAnnotation
	self withRulerNamed: #annotation! !

!RubScrolledTextMorph methodsFor: 'defaults' stamp: 'AlainPlantec 4/11/2013 22:39'!
defaultBackgroundColor 
	^ Color white! !

!RubScrolledTextMorph methodsFor: 'model protocol' stamp: 'AlainPlantec 6/2/2013 12:43'!
setTextSelector
	^ setTextSelector ifNil: [  setTextSelector := #setText:from:]! !

!RubScrolledTextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 2/6/2014 09:37'!
scrollerExtentChanged
	self manageLayout
! !

!RubScrolledTextMorph methodsFor: 'accessing segments' stamp: 'AlainPlantec 5/22/2013 11:11'!
segmentsAtLine: aLineNumber
	^ self textArea  segmentsAtLine: aLineNumber
! !

!RubScrolledTextMorph methodsFor: 'model protocol' stamp: 'AlainPlantec 8/27/2013 15:37'!
takeKeyboardFocus
	self textArea takeKeyboardFocus! !

!RubScrolledTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 6/2/2013 12:36'!
wrapped: aBoolean
	self scrollPane wrapped: aBoolean! !

!RubScrolledTextMorph methodsFor: 'defaults' stamp: 'AlainPlantec 4/16/2013 12:20'!
defaultBorderWidth
	^ 0! !

!RubScrolledTextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 4/26/2013 19:49'!
whenLostForcus: anAnnouncement
	self announcer announce: anAnnouncement.
	self changed! !

!RubScrolledTextMorph methodsFor: 'accessing scrollbars' stamp: 'AlainPlantec 4/26/2013 12:27'!
vScrollbarShowNever
	self scrollPane vScrollbarShowNever! !

!RubScrolledTextMorph methodsFor: 'accessing decorators' stamp: 'AlainPlantec 5/7/2013 09:34'!
withoutSelectionBar
	self textArea withoutSelectionBar! !

!RubScrolledTextMorph methodsFor: 'accessing rulers' stamp: 'AlainPlantec 4/22/2013 22:39'!
withoutAdornment
	self withoutRulerNamed: #adornment! !

!RubScrolledTextMorph methodsFor: 'accessing-selection' stamp: 'AlainPlantec 6/2/2013 15:03'!
editPrimarySelectionSeparately
	self textArea editPrimarySelectionSeparately! !

!RubScrolledTextMorph methodsFor: 'accessing rulers' stamp: 'AlainPlantec 5/22/2013 11:47'!
verticalRulers
	^self rulers select: [ :r | r isVertical ]! !

!RubScrolledTextMorph methodsFor: 'accessing rulers' stamp: 'AlainPlantec 4/18/2013 10:42'!
lineNumbersRuler
	^ self rulerNamed: #lineNumbers! !

!RubScrolledTextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 5/18/2013 16:40'!
whenTextUpdatedInModel: anAnnouncement
	self announcer announce: anAnnouncement.
	self updateTextWith: self getTextFromModel.
	"self setSelection: self getSelection."

! !

!RubScrolledTextMorph methodsFor: 'accessing' stamp: 'TudorGirba 8/1/2014 21:06'!
notificationStrategy: aStrategy
	self textArea notificationStrategy: aStrategy! !

!RubScrolledTextMorph methodsFor: 'accessing rulers' stamp: 'AlainPlantec 5/17/2013 08:52'!
withoutAnnotation
	self withoutRulerNamed: #annotation! !

!RubScrolledTextMorph methodsFor: 'initialize-release' stamp: 'AlainPlantec 5/17/2013 20:39'!
defaultScrollTarget
	| textArea |
	textArea := self textAreaClass new.
	textArea backgroundColor: Color lightGray veryMuchLighter.
	^ textArea! !

!RubScrolledTextMorph methodsFor: 'accessing segments' stamp: 'AlainPlantec 2/6/2014 16:06'!
segments
	^ self textArea segments
! !

!RubScrolledTextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 5/30/2013 14:39'!
handlesMouseWheel: evt
	"Do I want to receive mouseWheel events?" 

	^ true! !

!RubScrolledTextMorph methodsFor: 'rulers handling' stamp: 'StephaneDucasse 4/23/2013 16:43'!
withRulersNamed: aCollection
	"returns a collection of rulers as described by aCollection of keys. It can be in the receiver or in the extra hierarchy"
	aCollection do: [ :m | self withRulerNamed: m ]! !

!RubScrolledTextMorph methodsFor: 'accessing rulers' stamp: 'AlainPlantec 5/19/2013 00:15'!
withoutColumns
	self withoutRulerNamed: #column! !

!RubScrolledTextMorph methodsFor: 'model protocol' stamp: 'AlainPlantec 4/22/2013 23:18'!
canDiscardEdits
	^self hasUnacceptedEdits not! !

!RubScrolledTextMorph methodsFor: 'accessing scrollbars' stamp: 'AlainPlantec 4/26/2013 16:41'!
hScrollbarShowAlways
	self scrollPane hScrollbarShowAlways.
	self extent: self extent.
	self manageLayout ! !

!RubScrolledTextMorph methodsFor: 'initialize-release' stamp: 'AlainPlantec 5/18/2013 10:36'!
beForSmalltalkCode
	self textArea beForSmalltalkCode.! !

!RubScrolledTextMorph methodsFor: 'model protocol' stamp: 'AlainPlantec 4/26/2013 18:21'!
hasUnacceptedEdits: aBoolean
	self autoAccept
		ifFalse: [ hasUnacceptedEdits := aBoolean ]! !

!RubScrolledTextMorph methodsFor: 'accessing menu' stamp: 'AlainPlantec 5/20/2014 23:55'!
getMenuPolicy: aGetMenuPolicy
	self textArea getMenuPolicy: aGetMenuPolicy! !

!RubScrolledTextMorph methodsFor: 'model protocol' stamp: 'AlainPlantec 8/27/2013 15:31'!
scrollToBeginningOfText
	self scrollPane scrollToBeginningOfText! !

!RubScrolledTextMorph methodsFor: 'initialize-release' stamp: 'AlainPlantec 5/8/2013 09:34'!
newScrollPane
	| sp |
	sp := RubTextScrollPane new.
	sp scrollTarget: self defaultScrollTarget.
	^ sp! !

!RubScrolledTextMorph methodsFor: 'accessing rulers' stamp: 'AlainPlantec 5/22/2013 11:48'!
overRulers
	^self rulers select: [ :r | r isOver ]! !

!RubScrolledTextMorph methodsFor: 'drawing' stamp: 'AlainPlantec 5/31/2013 11:51'!
drawSubmorphsOn: aCanvas
	"Display submorphs back to front"

	| drawBlock subs |
	submorphs isEmpty
		ifTrue: [ ^ self ].
	subs := submorphs copyWithoutAll: self sideRulers.
	drawBlock := [ :canvas | subs reverseDo: [ :m | canvas fullDrawMorph: m ] ].
	self clipSubmorphs
		ifTrue: [ aCanvas clipBy: (aCanvas clipRect intersect: self clippingBounds ifNone: [ ^ self ]) during: drawBlock ]
		ifFalse: [ drawBlock value: aCanvas ].
	subs := self sideRulers.
	drawBlock := [ :canvas | subs reverseDo: [ :m | canvas fullDrawMorph: m ] ].
	self clipSubmorphs
		ifTrue: [ aCanvas clipBy: (aCanvas clipRect intersect: self clippingBounds ifNone: [ ^ self ]) during: drawBlock ]
		ifFalse: [ drawBlock value: aCanvas ].
! !

!RubScrolledTextMorph methodsFor: 'accessing scrollbars' stamp: 'AlainPlantec 4/26/2013 13:18'!
hScrollbarShowWhenNeeded
	self scrollPane hScrollbarShowWhenNeeded! !

!RubScrolledTextMorph methodsFor: 'rulers handling' stamp: 'AlainPlantec 4/18/2013 10:41'!
hasRulerNamed: aKey
	^ self rulers anySatisfy: [ :r | r key = aKey ]
	! !

!RubScrolledTextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 2/6/2014 11:07'!
textAreaExtentChanged
	self manageLayout
! !

!RubScrolledTextMorph methodsFor: 'accessing rulers' stamp: 'AlainPlantec 4/26/2013 12:39'!
withoutTextField
	self withoutRulerNamed: #textField.
! !

!RubScrolledTextMorph methodsFor: 'acessing text' stamp: 'AlainPlantec 8/2/2013 15:14'!
getTextFromModel
	"Retrieve the current model text"

	| newText |
	self getTextSelector ifNil: [^Text new].
	newText := (self model perform: self getTextSelector withEnoughArguments: {self}) asText.
	newText ifNil: [^Text new].
	^newText copy! !

!RubScrolledTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/18/2013 01:20'!
editingMode: anEditingMode
	self textArea editingMode: anEditingMode.
! !

!RubScrolledTextMorph methodsFor: 'acessing text' stamp: 'AlainPlantec 8/27/2013 15:53'!
setTextWith: stringOrText
	"Accept new text contents with line breaks only as in the text.
	Fit my width and height to the result."
	self scrollPane setTextWith: stringOrText.
	self setSelection: self getSelectionFromModel.
	self resetState! !

!RubScrolledTextMorph methodsFor: 'accessing rulers' stamp: 'AlainPlantec 5/22/2013 11:07'!
withoutTextSegmentIcons
	self withoutRulerNamed: #textSegmentIcons
! !

!RubScrolledTextMorph methodsFor: 'model protocol' stamp: 'AlainPlantec 4/22/2013 23:33'!
getTextSelector: aSymbol 
	getTextSelector  := aSymbol! !

!RubScrolledTextMorph methodsFor: 'drawing' stamp: 'AlainPlantec 2/26/2015 18:54'!
drawSubmorphsOnAthensCanvas: anAthensCanvas
	"Display submorphs back to front"

	| drawBlock subs |
	submorphs isEmpty
		ifTrue: [ ^ self ].
	subs := submorphs copyWithoutAll: self sideRulers.
	drawBlock := [ subs reverseDo: [ :m | anAthensCanvas fullDrawMorph: m ] ].
	self clipSubmorphs
		ifTrue: [ anAthensCanvas clipBy: (anAthensCanvas clipRect intersect: self clippingBounds ifNone: [ ^ self ]) during: drawBlock ]
		ifFalse: [ drawBlock value ].
	subs := self sideRulers.
	drawBlock := [ subs reverseDo: [ :m | anAthensCanvas fullDrawMorph: m ] ].
	self clipSubmorphs
		ifTrue: [ anAthensCanvas clipBy: (anAthensCanvas clipRect intersect: self clippingBounds ifNone: [ ^ self ]) during: drawBlock ]
		ifFalse: [ drawBlock value ]! !

!RubScrolledTextMorph methodsFor: 'accessing scrollbars' stamp: 'AlainPlantec 4/26/2013 13:26'!
currentHScrollBarThickness
	^self scrollPane currentHScrollBarThickness! !

!RubScrolledTextMorph methodsFor: 'model protocol' stamp: 'AlainPlantec 8/27/2013 15:33'!
scrollToEndOfLine
	self scrollPane scrollToEndOfLine! !

!RubScrolledTextMorph methodsFor: 'accessing scrollbars' stamp: 'AlainPlantec 4/26/2013 16:43'!
borderWidth: anInteger
	super borderWidth: anInteger.
	self extent: self extent.
	self manageLayout ! !

!RubScrolledTextMorph methodsFor: 'acessing text' stamp: 'AlainPlantec 8/2/2013 16:55'!
tabWidth
	^ self textArea tabWidth! !

!RubScrolledTextMorph methodsFor: 'accessing rulers' stamp: 'AlainPlantec 5/17/2013 10:46'!
annotationRuler
	^ self rulerNamed: #annotation! !

!RubScrolledTextMorph methodsFor: 'accessing rulers' stamp: 'AlainPlantec 2/6/2014 14:03'!
rulers
	^ rulers ! !

!RubScrolledTextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 4/26/2013 19:49'!
whenGotForcus: anAnnouncement
	self announcer announce: anAnnouncement.
	self changed! !

!RubScrolledTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 4/17/2013 16:44'!
backgroundColor: aColor
	self color: aColor! !

!RubScrolledTextMorph methodsFor: 'accessing rulers' stamp: 'AlainPlantec 4/22/2013 22:39'!
withAdornment
	self withRulerNamed: #adornment! !

!RubScrolledTextMorph methodsFor: 'model protocol' stamp: 'AlainPlantec 4/24/2013 10:23'!
getTextSelector
	^ getTextSelector ifNil: [  getTextSelector := #getText ]! !

!RubScrolledTextMorph methodsFor: 'accessing decorators' stamp: 'AlainPlantec 5/7/2013 09:34'!
withoutDecoratorNamed: aSymbol
	self textArea withoutDecoratorNamed: aSymbol! !

!RubScrolledTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 4/26/2013 19:40'!
autoAccept: aBoolean
	"Whether I should accept my contents on each change."
	autoAccept := aBoolean.
	aBoolean
		ifTrue: [ self withoutAdornment; acceptContents]
		ifFalse: [ self withAdornment ]! !

!RubScrolledTextMorph methodsFor: 'accessing rulers' stamp: 'AlainPlantec 2/6/2014 14:05'!
extraAreas
	^ self rulers select: [ :r | r isOver ]
! !

!RubScrolledTextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 8/27/2013 15:53'!
whenPrimarySelectionUpdatedInModel: anAnnouncement
	self announcer announce: anAnnouncement.
	self setSelection: self getSelectionFromModel.

! !

!RubScrolledTextMorph methodsFor: 'model protocol' stamp: 'AlainPlantec 2/6/2014 13:31'!
acceptContents
	(self autoAccept not and: [ self canDiscardEdits and: [ self alwaysAccept not ] ])
		ifTrue: [ ^ self flash ].
	self hasEditingConflicts
		ifTrue: [  
			(self
				confirm:
					'Caution!! This method may have been
changed elsewhere since you started
editing it here.  Accept anyway?' translated)
				ifFalse: [ ^ self flash ] ].
	self acceptTextInModel == true
		ifTrue: [
			self hasUnacceptedEdits: false.
			self rulers do: [ :r | r textAccepted ].
			self announcer announce: (RubTextAccepted morph: self) ]! !

!RubScrolledTextMorph methodsFor: 'rulers handling' stamp: 'AlainPlantec 4/18/2013 10:51'!
withoutRulersNamed: aCollection
	aCollection do: [ :m | self withoutRulerNamed: m ]! !

!RubScrolledTextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 6/2/2013 15:43'!
whenTextSetInModel: anAnnouncement
	self announcer announce: anAnnouncement.
	self scrollPane setTextWith: self getTextFromModel! !

!RubScrolledTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:34'!
model 
	^self textArea model! !

!RubScrolledTextMorph methodsFor: 'accessing rulers' stamp: 'AlainPlantec 4/19/2013 08:29'!
withoutCodeSizeFeedback
	self withoutRulerNamed: #codeSizeFeedback! !

!RubScrolledTextMorph methodsFor: 'initialize-release' stamp: 'AlainPlantec 5/18/2013 10:36'!
beForPlainText
	self textArea beForPlainText! !

!RubScrolledTextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 4/16/2013 13:46'!
mouseDown: event
	"If pane is not empty, pass the event to the last submorph,
	assuming it is the most appropriate recipient (!!)"

	(self innerBounds containsPoint: event cursorPoint)
		ifTrue: [ 
			self scrollPane mouseDown: event.
			self eventHandler ifNotNil: [ self eventHandler mouseDown: event fromMorph: self ] ]! !

!RubScrolledTextMorph methodsFor: 'model protocol' stamp: 'AlainPlantec 4/22/2013 22:30'!
hasEditingConflicts
	^ hasEditingConflicts ifNil: [ hasEditingConflicts := false ] ! !

!RubScrolledTextMorph methodsFor: 'accessing-selection' stamp: 'AlainPlantec 9/18/2013 20:12'!
moveCursorToIndex: anIndex 
	self selectFrom: anIndex to: anIndex - 1! !

!RubScrolledTextMorph methodsFor: 'acessing text' stamp: 'AlainPlantec 4/18/2013 12:16'!
beNotWrapped
	self scrollPane beNotWrapped ! !

!RubScrolledTextMorph methodsFor: 'defaults' stamp: 'AlainPlantec 4/14/2013 19:29'!
defaultColor
	^ self defaultBackgroundColor ! !

!RubScrolledTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 4/22/2013 17:06'!
hasKeyboardFocus
	^ (self scrollPane ifNil: [ ^false ]) hasKeyboardFocus! !

!RubScrolledTextMorph methodsFor: 'model protocol' stamp: 'AlainPlantec 8/27/2013 15:53'!
cancel

	self updateTextWith: self getTextFromModel.
	self setSelection: self getSelectionFromModel! !

!RubScrolledTextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 4/22/2013 13:18'!
keyStroke: event
	self scrollPane
		ifNotNil: [ :scrollpane | scrollpane keyStroke: (event transformedBy: (scrollpane transformFrom: self)) ]! !

!RubScrolledTextMorph methodsFor: 'rulers handling' stamp: 'AlainPlantec 4/18/2013 10:51'!
removeAllRulers
	[ self rulers notEmpty ] whileTrue: [ self withoutRuler: self rulers first ]! !

!RubScrolledTextMorph methodsFor: 'accessing rulers' stamp: 'AlainPlantec 5/31/2013 11:49'!
sideRulers
	^self rulers select: [ :r | r isSideRuler ]! !

!RubScrolledTextMorph methodsFor: 'drawing' stamp: 'AlainPlantec 5/7/2013 18:07'!
adornmentColor
	"color to Indicate edit status for the given morph."

	self hasEditingConflicts
		ifTrue: [ ^ Color red ].
	self hasUnacceptedEdits
		ifTrue: [ 
			self model wantsDiffFeedback
				ifTrue: [ ^ Color yellow darker ]
				ifFalse: [ ^ Color orange ] ].
	self model wantsDiffFeedback
		ifTrue: [ ^ Color green ].
	^ Color transparent! !

!RubScrolledTextMorph methodsFor: 'testing' stamp: 'AlainPlantec 4/16/2013 17:44'!
isParagraphProvider
	^ true! !

!RubScrolledTextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 5/17/2013 09:05'!
handlesMouseDown: event
	^ self scrollBounds containsPoint: event cursorPoint! !

!RubScrolledTextMorph methodsFor: 'geometry' stamp: 'AlainPlantec 4/18/2013 10:32'!
position: aPoint
	super position: aPoint.
	self manageLayout

	! !

!RubScrolledTextMorph methodsFor: 'accessing-selection' stamp: 'AlainPlantec 5/16/2013 09:07'!
setSelection: aSelectionInterval
	aSelectionInterval ifNil: [ ^ self ].
	self textArea selectFrom: aSelectionInterval first to: aSelectionInterval last.
	self scrollPane scrollSelectionIntoView! !

!RubScrolledTextMorph methodsFor: 'layout' stamp: 'AlainPlantec 2/6/2014 09:38'!
manageLayout
	| ret |
	self textArea ifNil: [ ^self ].
	ret := self manageLayoutInBounds: self innerBounds.
	self layoutChanged.
	^ret! !

!RubScrolledTextMorph methodsFor: 'private' stamp: 'AlainPlantec 5/7/2013 09:34'!
shoutStyler
	^ self textArea shoutStyler! !

!RubScrolledTextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 8/2/2013 14:58'!
whenCanceEditRequested: anAnnoucement
	self announcer announce: anAnnoucement.
	self cancel
! !

!RubScrolledTextMorph methodsFor: 'initialize-release' stamp: 'AlainPlantec 5/17/2013 20:39'!
textAreaClass
	^ RubEditingArea! !

!RubScrolledTextMorph methodsFor: 'accessing rulers' stamp: 'AlainPlantec 4/18/2013 10:51'!
withoutGhostText
	self withoutRulerNamed: #ghostText.
! !

!RubScrolledTextMorph methodsFor: 'accessing rulers' stamp: 'AlainPlantec 5/22/2013 11:07'!
withTextSegmentIcons
	self withRulerNamed: #textSegmentIcons
! !

!RubScrolledTextMorph methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 3/20/2015 12:33'!
margins: aRectangle
	"polymorphism with text area"
	self textArea margins: aRectangle! !

!RubScrolledTextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 5/18/2013 16:37'!
whenTextAcceptedInModel: anAnnouncement
	self announcer announce: anAnnouncement.
	self acceptContents
! !

!RubScrolledTextMorph methodsFor: 'accessing decorators' stamp: 'AlainPlantec 5/7/2013 09:34'!
withoutAnyDecorator
	self textArea withoutAnyDecorator! !

!RubScrolledTextMorph methodsFor: 'model protocol' stamp: 'AlainPlantec 5/17/2013 01:10'!
on: aModel 
	self model: aModel.
! !

!RubScrolledTextMorph methodsFor: 'model protocol' stamp: 'AlainPlantec 5/16/2013 21:54'!
on: aModel text: aGetTextSelector accept: aSetTextSelector readSelection: aReadSelectionSelector menu: aGetMenuSelector
	self getTextSelector: aGetTextSelector.
	self setTextSelector: aSetTextSelector.
	self getSelectionSelector: aReadSelectionSelector.
	self getMenuSelector: aGetMenuSelector.
	self on: aModel! !

!RubScrolledTextMorph methodsFor: 'accessing segments' stamp: 'AndreiChis 1/12/2015 22:49'!
addSegment: aRubTextSegmentMorph
	^ self textArea addSegment: aRubTextSegmentMorph
! !

!RubScrolledTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 4/26/2013 18:02'!
autoAccept
	"Answer whether the editor accepts its contents on each change."

	^autoAccept ifNil: [autoAccept := false]! !

!RubScrolledTextMorph methodsFor: 'submorphs-accessing' stamp: 'AlainPlantec 4/23/2013 01:14'!
noteNewOwner: aMorph 
	super noteNewOwner: aMorph.
	self manageLayout ! !

!RubScrolledTextMorph methodsFor: 'private' stamp: 'AlainPlantec 5/16/2013 08:59'!
resetState
	hasEditingConflicts := nil.
	hasUnacceptedEdits := nil.
	self changed! !

!RubScrolledTextMorph methodsFor: 'rulers handling' stamp: 'StephaneDucasse 4/23/2013 16:45'!
withRulerNamed: aKey
	"returns the ruler associated with the aKey. It can be in the receiver or in the extra hierarchy.
	aKey is a symbol i.e., #lineNumbers"
	(self hasRulerNamed: aKey)
		ifTrue: [ ^ self ].
	(self classOfRulerNamed: aKey)
		ifNotNil: [ :cls | self withRuler: cls new ]! !

!RubScrolledTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/17/2013 22:30'!
editingMode
	^  self textArea editingMode! !

!RubScrolledTextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 4/11/2013 22:51'!
handlesKeyboard: evt
	"Yes for page up/down."
	
	^true! !

!RubScrolledTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 4/13/2013 14:06'!
paragraph
	^ self scrollPane paragraph ! !

!RubScrolledTextMorph methodsFor: 'rulers handling' stamp: 'AlainPlantec 4/18/2013 10:42'!
rulerNamed: aKey
	^self rulers detect: [ :r | r key = aKey ] ifNone: [  ]! !

!RubScrolledTextMorph methodsFor: 'accessing rulers' stamp: 'AlainPlantec 5/22/2013 11:48'!
horizontalRulers
	^self rulers select: [ :r | r isHorizontal ]! !

!RubScrolledTextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 5/18/2013 16:37'!
whenTextAcceptRequest: anAnnouncement
	self announcer announce: anAnnouncement.
	self acceptContents! !

!RubScrolledTextMorph methodsFor: 'model protocol' stamp: 'AlainPlantec 8/27/2013 15:30'!
scrollToEndOfText
	self scrollPane scrollToEndOfText! !

!RubScrolledTextMorph methodsFor: 'accessing rulers' stamp: 'AlainPlantec 4/18/2013 10:42'!
ghostTextRuler
	^ self rulerNamed: #ghostText! !

!RubScrolledTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/6/2014 08:56'!
scrollPane
	^ scrollPane! !

!RubScrolledTextMorph methodsFor: 'model protocol' stamp: 'AlainPlantec 4/23/2013 00:33'!
hasUnacceptedEdits
	^ hasUnacceptedEdits ifNil: [ hasUnacceptedEdits := false ] ! !

!RubScrolledTextMorph methodsFor: 'private' stamp: 'AlainPlantec 5/7/2013 09:34'!
unplug
	self textArea ifNotNil: [ self textArea announcer unsubscribe: self ].
	self scrollPane
		ifNotNil: [ :scrollpane | 
			scrollpane announcer unsubscribe: self.
			scrollpane unplug ].
	super unplug! !

!RubScrolledTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/7/2014 11:58'!
model: aModel
	self textArea model: aModel.
	self setTextWith: self getTextFromModel.
	self setSelection: self getSelectionFromModel.
	aModel announcer subscribe: RubTextAcceptedInModel send: #whenTextAcceptedInModel: to: self.	
	aModel announcer subscribe: RubTextSetInModel send: #whenTextSetInModel: to: self.	
	aModel announcer subscribe: RubTextUpdatedInModel send: #whenTextUpdatedInModel: to: self.	
	aModel announcer subscribe: RubPrimarySelectionUpdatedInModel send: #whenPrimarySelectionUpdatedInModel: to: self.
	aModel announcer subscribe: RubConfigurationChange send: #whenConfigurationChangedFromModel: to: self.
! !

!RubScrolledTextMorph methodsFor: 'accessing rulers' stamp: 'AlainPlantec 4/18/2013 10:40'!
withColumns
	self withRulerNamed: #column! !

!RubScrolledTextMorph methodsFor: 'accessing rulers' stamp: 'AlainPlantec 2/5/2014 10:34'!
withGhostText: aText
	self withRulerNamed: #ghostText.
	self ghostTextRuler updateTextWith: aText asText.
	self ghostTextRuler comeToFront! !

!RubScrolledTextMorph methodsFor: 'accessing rulers' stamp: 'AlainPlantec 4/22/2013 22:39'!
adornmentRuler
	^ self rulerNamed: #adornment! !

!RubScrolledTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:34'!
textColor
	^ self textArea textColor! !

!RubScrolledTextMorph methodsFor: 'accessing' stamp: 'TudorGirba 7/22/2014 22:34'!
beReadOnly
	self textArea beReadOnly ! !

!RubScrolledTextMorph methodsFor: 'model protocol' stamp: 'AlainPlantec 4/22/2013 23:33'!
setTextSelector: aSymbol 
	setTextSelector  := aSymbol! !

!RubScrolledTextMorph methodsFor: 'accessing scrollbars' stamp: 'AlainPlantec 2/6/2014 09:24'!
scrollerOffsetChanged
	self rulers do: [:r | r scrollerOffsetChanged]! !

!RubScrolledTextMorph methodsFor: 'model protocol' stamp: 'AlainPlantec 5/16/2013 09:11'!
getSelectionSelector
	^ getSelectionSelector! !

!RubScrolledTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 4/15/2013 10:07'!
offset
	^ self scrollPane offset! !

!RubScrolledTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:34'!
textArea
	^ self scrollPane ifNotNil: [:sp | sp textArea]! !

!RubScrolledTextMorph methodsFor: 'model protocol' stamp: 'AlainPlantec 4/22/2013 23:16'!
alwaysAccept
	^ alwaysAccept ifNil: [ alwaysAccept := false]! !

!RubScrolledTextMorph methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 3/26/2015 16:40'!
cursor
	"polymorphism with text area"
	^ self textArea cursor! !

!RubScrolledTextMorph methodsFor: 'accessing scrollbars' stamp: 'AlainPlantec 4/26/2013 12:27'!
hScrollbarShowNever
	self scrollPane hScrollbarShowNever! !

!RubScrolledTextMorph methodsFor: 'model protocol' stamp: 'AlainPlantec 6/2/2013 12:38'!
acceptTextInModel
	self model ifNil: [ ^ true ].
	 ^ self setTextSelector numArgs = 2
		ifTrue: [ self model perform: self setTextSelector with: self text with: self ]
		ifFalse: [ self model perform: self setTextSelector with: self text ]! !

!RubScrolledTextMorph methodsFor: 'acessing text' stamp: 'AlainPlantec 5/18/2013 16:34'!
updateTextWith: stringOrText
	"Accept new text contents with line breaks only as in the text.
	Fit my width and height to the result."
	self scrollPane updateTextWith: stringOrText.
	"self setSelection: self getSelection."
	self resetState! !

!RubScrolledTextMorph methodsFor: 'layout' stamp: 'Alainplantec 10/1/2013 11:11'!
manageLayoutInBounds: aRectangle
	| myBounds |
	myBounds := aRectangle.
	self horizontalRulers do: [ :r | myBounds := r manageLayoutInBounds: myBounds ].
	self verticalRulers do: [ :r | myBounds := r manageLayoutInBounds: myBounds ].
	self overRulers do: [ :r | myBounds := r manageLayoutInBounds: myBounds ].
	self scrollPane
		ifNotNil: [ :scrollpane |
			scrollpane position: myBounds topLeft.
			scrollpane extent: (myBounds extent max: 0@0)].
	^ myBounds! !

!RubScrolledTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 4/17/2013 16:45'!
backgroundColor
	^self color! !

!RubScrolledTextMorph methodsFor: 'model protocol' stamp: 'AlainPlantec 4/22/2013 23:16'!
alwaysAccept: aBoolean
	"Set the always accept flag."
	"This flag is used when there are unsaved changes in my text field and an exterior actor tries to modify me"
	"If the flag is true, I will accept to change even if I have pending modification instead of poping up the Accept/Discard/Cancel window"


	alwaysAccept := aBoolean
! !

!RubScrolledTextMorph methodsFor: 'accessing-selection' stamp: 'AlainPlantec 5/16/2013 14:05'!
selectFrom: firstIndex to: lastIndex
	^ self setSelection: (firstIndex to: lastIndex)! !

!RubScrolledTextMorph methodsFor: 'acessing text' stamp: 'AlainPlantec 5/7/2013 09:34'!
text
	^ self textArea text! !

!RubScrolledTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:34'!
textColor: aColor 
	self textArea textColor: aColor! !

!RubScrolledTextMorph methodsFor: 'model protocol' stamp: 'AlainPlantec 4/22/2013 22:04'!
hasEditingConflicts: aBoolean
	hasEditingConflicts := aBoolean! !

!RubScrolledTextMorph methodsFor: 'acessing text' stamp: 'AlainPlantec 8/2/2013 17:23'!
tabWidth: anInteger
	self textArea tabWidth: anInteger ! !

!RubScrolledTextMorph methodsFor: 'accessing decorators' stamp: 'AlainPlantec 5/7/2013 09:34'!
withDecoratorNamed: aSymbol
	self textArea withDecoratorNamed: aSymbol! !

!RubScrolledTextMorph methodsFor: 'rulers handling' stamp: 'AlainPlantec 2/6/2014 14:02'!
withRuler: aRuler
	(self hasRulerNamed: aRuler key)
		ifTrue: [ ^ self ].
	rulers add: aRuler.
	self addMorphBack: aRuler.
	"Extra areas must be in the front "
	self extraAreas do: [ :r | self addMorphFront: r ].
	self manageLayout.
	" Finnally, the scrollPane must be in the front of all because text must be drawn last "
	self addMorphFront: self scrollPane.
! !

!RubScrolledTextMorph methodsFor: 'accessing rulers' stamp: 'AlainPlantec 5/22/2013 11:07'!
textSegmentIconsRuler
	^ self rulerNamed: #textSegmentIcons! !

!RubScrolledTextMorph methodsFor: 'rulers handling' stamp: 'AlainPlantec 4/19/2013 08:32'!
classOfRulerNamed: aKey
	^ RubScrolledTextExtra classOfRulerNamed: aKey! !

!RubScrolledTextMorph methodsFor: 'mock for spec' stamp: 'AlainPlantec 5/16/2013 12:20'!
enabled: aBoolean! !

!RubScrolledTextMorph methodsFor: 'accessing-selection' stamp: 'AlainPlantec 8/27/2013 15:53'!
getSelectionFromModel
	"Answer the model's selection interval."

	^ self getSelectionSelector ifNotNil: [ :s | self model perform: s withEnoughArguments: {self} ]! !

!RubScrolledTextMorph methodsFor: 'acessing text' stamp: 'AlainPlantec 4/18/2013 12:16'!
beWrapped
	self scrollPane beWrapped! !

!RubScrolledTextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 4/15/2013 11:34'!
mouseMove: event
	"If pane is not empty, pass the event to the last submorph,
	assuming it is the most appropriate recipient (!!)"
	
	self scrollPane mouseMove: event.
	self eventHandler
		ifNotNil: [ self eventHandler mouseMove: event fromMorph: self ]! !

!RubScrolledTextMorph methodsFor: 'acessing text' stamp: 'AlainPlantec 5/16/2013 11:48'!
getTextFromView
	"Retrieve the current view text, possibly not accepted"

	^ self textArea text! !

!RubScrolledTextMorph methodsFor: 'geometry' stamp: 'AlainPlantec 4/17/2013 16:42'!
scrollBounds
	^ self scrollPane scrollBounds! !

!RubScrolledTextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 8/2/2013 10:45'!
whenConfigurationChanged: anAnnouncement
	anAnnouncement configurationBlock value: self
! !

!RubScrolledTextMorph methodsFor: 'geometry' stamp: 'AlainPlantec 5/7/2013 17:28'!
extent: aPoint
	super extent: aPoint.
	self manageLayout! !

!RubScrolledTextMorph methodsFor: 'accessing rulers' stamp: 'AlainPlantec 4/18/2013 10:40'!
withLineNumbers
	self withRulerNamed: #lineNumbers! !

!RubScrolledTextMorph methodsFor: 'accessing scrollbars' stamp: 'AlainPlantec 4/26/2013 12:29'!
scrollbarsShowNever
	self hScrollbarShowNever.
	self vScrollbarShowNever! !

!RubScrolledTextMorph methodsFor: 'rulers handling' stamp: 'AlainPlantec 4/16/2013 19:12'!
hasRuler: aRuler
	^ self rulers includes: aRuler
	! !

!RubScrolledTextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 8/2/2013 10:48'!
whenConfigurationChangedFromModel: anAnnouncement
	self announcer announce: anAnnouncement
! !

!RubScrolledTextMorph methodsFor: 'rulers handling' stamp: 'AlainPlantec 4/18/2013 10:51'!
withoutRulerNamed: aKey
	(self rulerNamed: aKey)
		ifNotNil: [ :m | self withoutRuler: m ].
	self changed! !

!RubScrolledTextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2014 13:13'!
beForSmalltalkScripting
	self textArea beForSmalltalkScripting! !

!RubScrolledTextMorph methodsFor: 'accessing-selection' stamp: 'AlainPlantec 5/15/2013 10:19'!
selectionInterval
	^ self textArea selectionInterval! !

!RubScrolledTextMorph methodsFor: 'mock for spec' stamp: 'AlainPlantec 5/16/2013 14:03'!
setText: aText
	self updateTextWith: aText! !

!RubScrolledTextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 2/6/2014 13:56'!
textChanged
	self manageLayout.
	self autoAccept
		ifTrue: [ self acceptContents ]
		ifFalse: [ self hasUnacceptedEdits: true ].
	self rulers do: [ :r | r textChanged ]! !

!RubScrolledTextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 2/6/2014 12:04'!
selectionChanged
	self rulers do: [ :r | r selectionChanged ]
! !

!RubScrolledTextMorph methodsFor: 'accessing rulers' stamp: 'AlainPlantec 4/18/2013 10:42'!
columnRuler
	^ self rulerNamed: #column! !

!RubScrolledTextMorph methodsFor: 'accessing' stamp: 'TudorGirba 7/11/2014 22:14'!
textFont: aFont
	self textArea font: aFont! !

!RubScrolledTextMorph methodsFor: 'accessing' stamp: 'TudorGirba 6/2/2014 11:31'!
borderStyleToUse
	"Answer the borderStyle that should be used for the receiver."
	
	^self enabled
		ifTrue: [self theme rubScrolledTextMorphThemer normalBorderStyleFor: self]
		ifFalse: [self theme rubScrolledTextMorphThemer disabledBorderStyleFor: self]! !

!RubScrolledTextMorph class methodsFor: 'instance creation' stamp: 'AlainPlantec 4/22/2013 23:44'!
on: aModel 
	^ self new on: aModel! !

!RubScrolledTextMorphThemer methodsFor: 'border-styles' stamp: 'AndreiChis 1/14/2015 10:59'!
highlightBorderStyleFor: aTextArea
	^ BorderStyle inset 
		baseColor: Smalltalk ui theme selectionColor;
		width: 2! !

!RubScrolledTextMorphThemer methodsFor: 'colors' stamp: 'AndreiChis 1/14/2015 12:12'!
highlightBackgroundColorFor: aTextArea

	^ Color veryLightGray alpha:0.01! !

!RubScrolledTextMorphThemer methodsFor: 'border-styles' stamp: 'TudorGirba 5/30/2014 14:24'!
disabledBorderStyleFor: aTextArea
	^ self normalBorderStyleFor: aTextArea ! !

!RubScrolledTextMorphThemer methodsFor: 'border-styles' stamp: 'TudorGirba 6/3/2014 08:18'!
normalBorderStyleFor: aTextArea
	^ BorderStyle 
		width: 0
		color: Color transparent! !

!RubScrolledTextMorphThemerForGLMWhitespaceTheme methodsFor: 'border-styles' stamp: 'TudorGirba 6/3/2014 08:21'!
normalBorderStyleFor: aTextArea
	^ BorderStyle 
		width: 1
		color: (GLMWhitespaceTheme lightBaseColor)! !

!RubScrolledTextSideRuler methodsFor: 'geometry' stamp: 'AlainPlantec 5/17/2013 08:59'!
manageLayoutInBounds: aRectangle
	super manageLayoutInBounds: aRectangle.
	self extent: (self computedExtentFrom: aRectangle).
	self side = #left
		ifTrue: [ 
			self position: aRectangle topLeft.
			^ aRectangle topLeft + ((self computedWidthFrom: aRectangle) @ 0) corner: aRectangle corner ].
	self side = #right
		ifTrue: [ 
			self position: aRectangle topRight - ((self computedWidthFrom: aRectangle) @ 0).
			^ aRectangle topLeft corner: aRectangle corner - ((self computedWidthFrom: aRectangle) @ 0) ].
	self side = #bottom
		ifTrue: [ 
			self position: aRectangle bottomLeft - (0 @ (self computedHeightFrom: aRectangle)).
			^ aRectangle topLeft corner: aRectangle corner - (0 @ (self computedHeightFrom: aRectangle)) ].
	^ self error: 'side must be in #( #left #right #bottom #top #over )'! !

!RubScrolledTextSideRuler methodsFor: 'testing' stamp: 'AlainPlantec 4/19/2013 09:23'!
isVertical
	^ #(#left #right) includes: self side! !

!RubScrolledTextSideRuler methodsFor: 'testing' stamp: 'AlainPlantec 4/19/2013 09:26'!
isSideRuler
	^ true! !

!RubScrolledTextSideRuler methodsFor: 'testing' stamp: 'AlainPlantec 4/19/2013 09:23'!
isHorizontal
	^ #(#top #bottom) includes: self side! !

!RubScrolledTextSideRuler methodsFor: 'accessing' stamp: 'AlainPlantec 4/19/2013 09:10'!
side
	^side ifNil: [ side := #left ]! !

!RubScrolledTextSideRuler methodsFor: 'accessing' stamp: 'AlainPlantec 4/19/2013 09:11'!
side: aSide
	side := aSide! !

!RubSegmentIconMenuItemMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/31/2013 12:44'!
segment
	
	^ segment! !

!RubSegmentIconMenuItemMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/31/2013 12:44'!
segment: aSegment
	
	segment := aSegment! !

!RubSegmentIconMenuItemMorph methodsFor: 'selecting' stamp: 'AlainPlantec 5/31/2013 12:48'!
deselect: anEvent
	self segment showMouseHasLeaved.
	super deselect: anEvent.
! !

!RubSegmentIconMenuItemMorph methodsFor: 'selecting' stamp: 'AlainPlantec 5/31/2013 12:47'!
select: anEvent
	self segment showMouseHasEntered.
	super select: anEvent.
! !

!RubSegmentIconMenuItemMorph methodsFor: 'events' stamp: 'AlainPlantec 5/31/2013 13:24'!
invokeWithEvent: evt
	super invokeWithEvent: evt.
	self owner defaultTarget changed! !

!RubSegmentIconMenuMorph methodsFor: 'adding item' stamp: 'StephaneDucasse 10/27/2014 17:53'!
addToggle: aString target: anObject selector: aSymbol getStateSelector: stateSymbol enablementSelector: enableSymbol argumentList: argList
	"Append a menu item with the given label. If the item is selected, it will send the given selector to the target object."

	|item|
	item := RubSegmentIconMenuItemMorph new
		contents: aString translated;
		target: anObject;
		selector: aSymbol;
		arguments: argList;
		getStateSelector: stateSymbol;
		enablementSelector: enableSymbol.
	^ self addMenuItem: item.
! !

!RubSegmentMorph commentStamp: 'AlainPlantec 2/7/2014 11:53'!
3. The CLOSED and SEGMENTED variant looks like polygon. This is actually what you get when you do
	PolygonMorph new openInWorld
You get a triangle. See below how to manipulate these objects...

4. The CLOSED and SMOOTHED variant looks like blob (???)

!
!RubSegmentMorph methodsFor: 'smoothing' stamp: 'AlainPlantec 2/7/2014 11:46'!
slopes: knots 
	"Choose slopes according to state of polygon"
	self isCurvy ifFalse: [^ self segmentedSlopesOf: knots ].
	^ self closedCubicSlopesOf: knots! !

!RubSegmentMorph methodsFor: 'initialization' stamp: 'AlainPlantec 2/7/2014 09:24'!
beStraightSegments

	smoothCurve == false ifFalse:
		[smoothCurve := false.
		self computeBounds]! !

!RubSegmentMorph methodsFor: 'initialization' stamp: 'AlainPlantec 2/7/2014 09:24'!
defaultColor
	"answer the default color/fill style for the receiver"
	^ Color orange! !

!RubSegmentMorph methodsFor: 'cubic support' stamp: 'AlainPlantec 2/7/2014 09:24'!
changeOfChangesInSlopes: slopes of: verts
	"A message to knots of a spline. Returns an array with the 4rd 
	cubic coeff."
	"The last nth item is correct iff this is a closed cubic. 
	Presumably that is the only time we care. 
	We always return the same sized array as self."
	| n changes |
	n := verts size.
	n = slopes size ifFalse: [^ self error: 'vertices and slopes differ in number'].
	changes := Array new: n.
	1 to: n do: [:i | changes at: i put: (verts at: i)
					- (verts atWrap: i + 1) * 2
					+ (slopes at: i)
					+ (slopes atWrap: i + 1)].
	^ changes! !

!RubSegmentMorph methodsFor: 'geometry' stamp: 'AlainPlantec 2/7/2014 09:24'!
transformedBy: aTransform
	self setVertices: (self vertices collect:[:v| aTransform localPointToGlobal: v])! !

!RubSegmentMorph methodsFor: 'cubic support' stamp: 'AlainPlantec 2/7/2014 09:24'!
changeInSlopes: slopes of: verts 
	"A message to knots of a spline. Returns an array with the 3rd cubic coeff."
	"The last nth item is correct iff this is a closed cubic.
	Presumably that is the only time we care.
	We always return the same sized array as self."
	| n slopeChanges |
	n := verts size.
	n = slopes size ifFalse: [^ self error: 'vertices and slopes differ in number'].
	slopeChanges := Array new: n.
	1 to: n do: [:i | slopeChanges at: i put: (verts atWrap: i + 1)
					- (verts at: i) * 3 - ((slopes at: i) * 2)
					- (slopes atWrap: i + 1)].
	^ slopeChanges! !

!RubSegmentMorph methodsFor: 'testing' stamp: 'AlainPlantec 2/7/2014 11:45'!
isCurvy
	"Test for significant curves.  
	Small smoothcurves in practice are straight."
	^ smoothCurve and: [vertices size > 2]! !

!RubSegmentMorph methodsFor: 'geometry' stamp: 'AlainPlantec 2/7/2014 09:24'!
bounds: newBounds
	"This method has to be reimplemented since self extent: will also change self bounds origin,
	super bounds would leave me in wrong position when container is growing.
	Always change extent first then position"
	
	self extent: newBounds extent; position: newBounds topLeft
! !

!RubSegmentMorph methodsFor: 'drawing' stamp: 'AlainPlantec 2/7/2014 09:24'!
drawBorderOn: aCanvas 
	self
		drawClippedBorderOn: aCanvas
		usingEnds: (Array with: vertices first with: vertices last)! !

!RubSegmentMorph methodsFor: 'caching' stamp: 'AlainPlantec 2/7/2014 11:36'!
releaseCachedState

	super releaseCachedState.
	filledForm := nil.
	borderForm := nil.
	curveState := nil.
	(self hasProperty: #flex) ifTrue:
		[self removeProperty: #flex].
! !

!RubSegmentMorph methodsFor: 'private' stamp: 'AlainPlantec 2/7/2014 09:24'!
getVertices

	smoothCurve ifFalse: [^ vertices].

	"For curves, enumerate the full set of interpolated points"
	^ Array streamContents:
		[:s | self lineSegmentsDo: [:pt1 :pt2 | s nextPut: pt1]]! !

!RubSegmentMorph methodsFor: 'drawing' stamp: 'AlainPlantec 2/7/2014 09:24'!
drawClippedBorderOn: aCanvas usingEnds: anArray 
	aCanvas clipBy: self bounds during:[:cc| self drawBorderOn: cc usingEnds: anArray].! !

!RubSegmentMorph methodsFor: 'drawing' stamp: 'AlainPlantec 2/7/2014 09:39'!
drawBorderOn: aCanvas usingEnds: anArray
	"Display my border on the canvas."

	| bigClipRect style |
	style := self borderStyle.
	bigClipRect := aCanvas clipRect expandBy: (self borderWidth + 1) // 2.
	self
		lineSegmentsDo: [ :p1 :p2 | 
			| p1i p2i |
			p1i := p1 asIntegerPoint.
			p2i := p2 asIntegerPoint.
			style drawLineFrom: p1i to: p2i on: aCanvas ]! !

!RubSegmentMorph methodsFor: 'initialization' stamp: 'AlainPlantec 2/7/2014 11:43'!
initialize
	super initialize.
	vertices := Array with: 5 @ 0 with: 20 @ 10 with: 0 @ 20.
	smoothCurve := false.
	self computeBounds.
! !

!RubSegmentMorph methodsFor: 'private' stamp: 'AlainPlantec 2/7/2014 09:28'!
setVertices: newVertices
	vertices := newVertices.
	self computeBounds! !

!RubSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/7/2014 11:56'!
borderWidth: anInteger

	super borderWidth: anInteger.
	self computeBounds! !

!RubSegmentMorph methodsFor: 'geometry' stamp: 'AlainPlantec 2/7/2014 09:24'!
intersects: aRectangle 
	"Answer whether any of my segments intersects aRectangle, which is in World coordinates."
	| rect |
	(super intersects: aRectangle) ifFalse: [ ^false ].
	rect := self bounds: aRectangle in: self world.
	self
		lineSegmentsDo: [:p1 :p2 | (rect intersectsLineFrom: p1 to: p2)
				ifTrue: [^ true]].
	^ false! !

!RubSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/7/2014 09:24'!
vertices
	^ vertices! !

!RubSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/7/2014 09:24'!
midVertices
	"Return and array of midpoints for this line or closed curve"
	| midPts nextVertIx tweens |
	vertices size < 2
		ifTrue: [^ vertices].
	midPts := OrderedCollection new.
	nextVertIx := 2.
	tweens := OrderedCollection new.
	tweens add: vertices first asIntegerPoint.
	"guarantee at least two points."
	self
		lineSegmentsDo: [:p1 :p2 | 
			tweens addLast: p2 asIntegerPoint.
			p2 = (vertices atWrap: nextVertIx)
				ifTrue: ["Found endPoint."
					midPts addLast: (tweens atWrap: tweens size + 1 // 2)
							+ (tweens at: tweens size // 2 + 1) // 2.
					tweens := OrderedCollection new.
					tweens add: p2 asIntegerPoint.
					"guarantee at least two points."
					nextVertIx := nextVertIx + 1]].
	^ midPts asArray! !

!RubSegmentMorph methodsFor: 'shaping' stamp: 'AlainPlantec 2/7/2014 09:24'!
diamondOval
	"Set my vertices to an array of edge midpoint vertices. Order of vertices is in the tradion of warpblt quads."
	
	| b |
	b := self bounds.
	self setVertices: { b leftCenter. b bottomCenter. b rightCenter. b topCenter }! !

!RubSegmentMorph methodsFor: 'cubic support' stamp: 'AlainPlantec 2/7/2014 09:24'!
naturalCubicSlopesOf: knots 
	"Sent to knots returns the slopes of a natural cubic curve fit."
	"We solve the equation for knots with end conditions:  
	2*b1+b2 = 3(a1 - a0) 
	bN1+2*bN = 3*(aN-aN1)
	and inbetween:
	b2+4*b3+b4=3*(a4-a2)
	where a2 is (knots atWrap: index + 1) etc.
	and the b's are the slopes .
	N is the last index (knots size)
	N1 is N-1.
	 
	by using row operations to convert the matrix to upper  
	triangular and then back sustitution. The D[i] are the derivatives at the  
	knots."
	
	| x gamma delta D n1 |
	n1 := knots size.
	n1 < 3
		ifTrue: [self error: 'Less than 3 points makes a poor curve'].
	x := knots.
	gamma := Array new: n1.
	delta := Array new: n1.
	
	D := Array new: n1.
	gamma at: 1 put: 1.0 / 2.0.
	2 to: n1 - 1 do: [:i | gamma at: i put: 1.0 / (4.0
						- (gamma at: i - 1))].
	gamma at: n1 put: 1.0 / (2.0
				- (gamma at: n1 - 1)).
	delta at: 1 put: 3.0 * ((x at: 2)
				- (x at: 1))
			* (gamma at: 1).
	2 to: n1 - 1 do: [:i | delta at: i put: 3.0 * ((x at: i + 1)
						- (x at: i - 1))
					- (delta at: i - 1)
					* (gamma at: i)].
	delta at: n1 put: 3.0 * ((x at: n1)
				- (x at: n1 - 1))
			- (delta at: n1 - 1)
			* (gamma at: n1).
	D
		at: n1
		put: (delta at: n1).
	(1 to: n1 - 1)
		reverseDo: [:i | D at: i put: (delta at: i)
					- ((gamma at: i)
							* (D at: i + 1))].
	^ D! !

!RubSegmentMorph methodsFor: 'smoothing' stamp: 'AlainPlantec 2/7/2014 11:31'!
lineSegmentsDo: endPointsBlock 
	"Emit a sequence of segment endpoints into endPointsBlock."
	"Unlike the method this one replaces we expect the curve 
	coefficents not the dirivatives"
	"Also unlike the replaced method the smooth closed curve
	does 
	not need an extra vertex. 
	We take care of the extra endpoint here. Just like for 
	segmented curves."
	| cs x y beginPoint |
	vertices size < 1
		ifTrue: [^ self].
	"test too few vertices first"
	self isCurvy
		ifFalse: [beginPoint := nil.
			"smoothCurve 
			ifTrue: [cs := self coefficients]."
			"some things still depend on smoothCurves having 
			curveState"
			vertices
				do: [:vert | 
					beginPoint
						ifNotNil: [endPointsBlock value: beginPoint value: vert].
					beginPoint := vert].
			endPointsBlock value: beginPoint value: vertices first.
			^ self].
	"For curves we include all the interpolated sub segments."
	"self assert: [(vertices size > 2 )].	"
	cs := self coefficients.
	beginPoint := (x := cs first first) @ (y := cs fifth first).
	1 to: cs first size
		do: [:i | | t n x3 y3 x1 endPoint x2 y1 y2 | 
			"taylor series coefficients"
			x1 := cs second at: i.
			y1 := cs sixth at: i.
			x2 := cs third at: i.
			y2 := cs seventh at: i.
			x3 := cs fourth at: i.
			y3 := cs eighth at: i.
			n := cs ninth at: i.
			"guess n 
			n := 5 max: (x2 abs + y2 abs * 2.0 + (cs third atWrap:
			i 
			+ 1) abs + (cs seventh atWrap: i + 1) abs / 100.0) 
			rounded."
			1
				to: n - 1
				do: [:j | 
					t := j asFloat / n asFloat.
					endPoint := x3 * t + x2 * t + x1 * t + x @ (y3 * t + y2 * t + y1 * t + y).
					endPointsBlock value: beginPoint value: endPoint.
					beginPoint := endPoint].
			endPoint := (x := cs first atWrap: i + 1) @ (y := cs fifth atWrap: i + 1).
			endPointsBlock value: beginPoint value: endPoint.
			beginPoint := endPoint]! !

!RubSegmentMorph methodsFor: 'geometry' stamp: 'AlainPlantec 2/7/2014 09:24'!
mergeDropThird: mv in: hv from: shared 
	"We are merging two polygons.  In this case, they have at least three identical shared vertices.  Make sure they are sequential in each, and drop the middle one from vertex lists mv, hv, and shared.  First vertices on lists are identical already."

	"know (mv first = hv first)"

	| mdrop vv |
	(shared includes: (mv at: mv size - 2)) 
		ifTrue: [(shared includes: mv last) ifTrue: [mdrop := mv last]]
		ifFalse: 
			[(shared includes: mv last) 
				ifTrue: [(shared includes: mv second) ifTrue: [mdrop := mv first]]].
	(shared includes: (mv third)) 
		ifTrue: [(shared includes: mv second) ifTrue: [mdrop := mv second]].
	mdrop ifNil: [^nil].
	mv remove: mdrop.
	hv remove: mdrop.
	shared remove: mdrop.
	[shared includes: mv first] whileFalse: 
			["rotate them"

			vv := mv removeFirst.
			mv addLast: vv].
	[mv first = hv first] whileFalse: 
			["rotate him until same shared vertex is first"

			vv := hv removeFirst.
			hv addLast: vv]! !

!RubSegmentMorph methodsFor: 'cubic support' stamp: 'AlainPlantec 2/7/2014 09:24'!
closedCubicSlopesOf: knots 
	"Sent to knots returns the slopes of a closed cubic spline.
	From the same set of java sources as naturalCubic. This is a smalltalk  
	transliteration of the java code."
	"from java code NatCubicClosed extends NatCubic  
	solves for the set of equations for all knots: 
	b1+4*b2+b3=3*(a3-a1)
	where a1 is (knots atWrap: index + 1) etc.
	and the b's are the slopes .
	by decomposing the matrix into upper triangular and lower matrices  
	and then back sustitution. See Spath 'Spline Algorithms for Curves  
	and Surfaces' pp 19--21. The D[i] are the derivatives at the knots.  
	"
	
	| v w x y z n1  D F G H |
	n1 := knots size.
	n1 < 3
		ifTrue: [self error: 'Less than 3 points makes a poor curve'].
	v := Array new: n1.
	w := Array new: n1.
	y := Array new: n1.
	
	D := Array new: n1.
	x := knots.
	z := 1.0 / 4.0.
	v at: 2 put: z.
	w at: 2 put: z.
	y at: 1 put: z * 3.0 * ((x at: 2) - (x at: n1)).
	H := 4.0.
	F := 3 * ((x at: 1) - (x at: n1 - 1)).
	G := 1.
	2 to: n1 - 1 do: [:k | 
			z := 1.0 / (4.0 - (v at: k)).
			v at: k + 1 put: z.
			w at: k + 1 put: z negated
					* (w at: k).
			y at: k put: z * (3.0 * ((x at: k + 1) - (x at: k - 1)) - (y at: k - 1)).
			H := H - (G * (w at: k)).
			F := F - (G * (y at: k - 1)).
			G := (v at: k) negated * G].
	H := H - (G + 1 * ((v at: n1) + (w at: n1))).
	y at: n1 put: F - (G + 1 * (y at: n1 - 1)).
	D at: n1 put: (y at: n1) / H.
	D at: n1 - 1 put: (y at: n1 - 1) - ((v at: n1) + (w at: n1) * (D at: n1)).
	(1 to: n1 - 2)
		reverseDo: [:k | D at: k put: (y at: k)
					- ((v at: k + 1) * (D at: k + 1)) - ((w at: k + 1) * (D at: n1))].
	^ D 

! !

!RubSegmentMorph methodsFor: 'smoothing' stamp: 'AlainPlantec 2/7/2014 09:24'!
coefficients
	curveState ifNotNil: [^ curveState at: 1].
	^ self vertices size < 1 
		ifTrue: [ self  ]
		ifFalse: [ self coefficientsForMoreThanThreePoints ].  ! !

!RubSegmentMorph methodsFor: 'private' stamp: 'MarcusDenker 11/11/2014 10:03'!
filledForm
	"Note: The filled form is actually 2 pixels bigger than bounds, and the point corresponding to this morphs' position is at 1@1 in the form.  This is due to the details of the fillig routines, at least one of which requires an extra 1-pixel margin around the outside.  Computation of the filled form is done only on demand."
	| bb origin |
	filledForm ifNotNil: [^ filledForm].
	filledForm := Form extent: bounds extent+2.

	"Draw the border..."
	bb := (BitBlt toForm: filledForm) sourceForm: nil; fillColor: Color black;
			combinationRule: Form over; width: 1; height: 1.
	origin := bounds topLeft asIntegerPoint-1.
	self lineSegmentsDo: [:p1 :p2 | bb drawFrom: p1 asIntegerPoint-origin
										to: p2 asIntegerPoint-origin].

	"Fill it in..."
	filledForm convexShapeFill: Color black.

	(borderColor isColor and: [borderColor isTranslucentButNotTransparent]) ifTrue: 
		["If border is stored as a form, then erase any overlap now."
		filledForm copy: self borderForm boundingBox from: self borderForm
			to: 1@1 rule: Form erase].

	^ filledForm! !

!RubSegmentMorph methodsFor: 'testing' stamp: 'AlainPlantec 2/7/2014 10:58'!
containsPoint: aPoint
	(super containsPoint: aPoint)
		ifFalse: [ ^ false ].
	color isTransparent
		ifFalse: [ ^ (self filledForm pixelValueAt: aPoint - bounds topLeft + 1) > 0 ].
	self
		lineSegmentsDo: [ :p1 :p2 | 
			(aPoint onLineFrom: p1 to: p2 within: (3 max: (borderWidth + 1) // 2) asFloat)
				ifTrue: [ ^ true ] ].
	^ false ! !

!RubSegmentMorph methodsFor: 'initialization' stamp: 'MarcusDenker 11/11/2014 10:04'!
vertices: verts color: aColor borderWidth: borderWidthInteger borderColor: anotherColor 
	super initialize.
	vertices := verts.
	color := aColor.
	borderWidth := borderWidthInteger. 
	borderColor := anotherColor.
	self computeBounds! !

!RubSegmentMorph methodsFor: 'smoothing' stamp: 'AlainPlantec 2/7/2014 11:28'!
coefficientsForMoreThanThreePoints 
	"Less than three points handled as segments by our lineSegmentsDo:"
	| verts coefficients vertXs slopeXs vertYs slopeYs bestSegments |
	verts := self vertices. 
	coefficients := {
		vertXs := verts collect: [:p | p x asFloat].
		slopeXs := self slopes: vertXs. 
		self changeInSlopes: slopeXs of: vertXs .
		self changeOfChangesInSlopes: slopeXs of: vertXs. 
		vertYs := verts collect: [:p | p y asFloat].
		slopeYs := self slopes: vertYs.
		self changeInSlopes: slopeYs of: vertYs.
		self changeOfChangesInSlopes: slopeYs of: vertYs. 
		Array new: verts size withAll: 12}.
		
		
	bestSegments := (1 to: verts size) collect: [:i | (self transform: coefficients toCubicPointPolynomialAt: i) bestSegments].
	coefficients at: 9 put:bestSegments.

	curveState := {coefficients. nil. nil}.
	self computeNextToEndPoints.
	^ coefficients! !

!RubSegmentMorph methodsFor: 'testing' stamp: 'AlainPlantec 2/7/2014 09:24'!
isCurve
	^ smoothCurve! !

!RubSegmentMorph methodsFor: 'geometry' stamp: 'AlainPlantec 2/7/2014 11:01'!
extent: newExtent
	"Not really advisable, but we can preserve most of the geometry if we don't
	shrink things too small."

	| safeExtent center |
	center := self referencePosition.
	safeExtent := newExtent max: 20 @ 20.
	self
		setVertices:
			(vertices collect: [ :p | (p - center) * (safeExtent asFloatPoint / (bounds extent max: 1 @ 1)) + center ])! !

!RubSegmentMorph methodsFor: 'drawing' stamp: 'AlainPlantec 2/7/2014 09:35'!
drawOn: aCanvas 
	"Display the receiver, a spline curve, approximated by straight 
	line segments."
	|  |
	aCanvas drawPolygon: self getVertices fillStyle: self fillStyle.
	self drawBorderOn: aCanvas
! !

!RubSegmentMorph methodsFor: 'cubic support' stamp: 'AlainPlantec 2/7/2014 09:24'!
transform: coefficients toCubicPointPolynomialAt: vIndex 
	"From curve information assemble a 4-array of points representing the coefficents for curve segment between to points. Beginning point is first point in array endpoint is the pointSum of the array. Meant to be sent to newcurves idea of curve coefficents." 
	| transformed |
	transformed := (1 to: 4) collect: [:i | 
			((coefficients at: i) at: vIndex) @ ((coefficients at: 4 + i) at: vIndex)].
	^ Cubic withAll: transformed! !

!RubSegmentMorph methodsFor: 'initialization' stamp: 'AlainPlantec 2/7/2014 11:26'!
beSmoothCurve
	smoothCurve == true
		ifFalse: [ 
			smoothCurve := true.
			self computeBounds ]! !

!RubSegmentMorph methodsFor: 'private' stamp: 'AlainPlantec 2/7/2014 09:44'!
privateMoveBy: delta
	super privateMoveBy: delta.
	vertices := vertices collect: [:p | p + delta].
	curveState := nil.  "Force recomputation"
	(self valueOfProperty: #referencePosition) ifNotNil:
		[:oldPos | self setProperty: #referencePosition toValue: oldPos + delta]! !

!RubSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/7/2014 09:24'!
cornerStyle: aSymbol
	"Set the receiver's corner style.  But, in this case, do *not*"

	(extension isNil or: [self cornerStyle == aSymbol]) ifTrue: [^self].
	extension cornerStyle: nil.
	self changed! !

!RubSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/7/2014 09:24'!
couldHaveRoundedCorners
	^ false! !

!RubSegmentMorph methodsFor: 'drawing' stamp: 'AlainPlantec 2/7/2014 09:24'!
areasRemainingToFill: aRectangle
	"Could be improved by quick check of inner rectangle"

	^ Array with: aRectangle! !

!RubSegmentMorph methodsFor: 'private' stamp: 'AlainPlantec 2/7/2014 11:54'!
curveBounds
	"Compute the bounds from actual curve traversal, with 
	leeway for borderWidth. 
	Also note the next-to-first and next-to-last points for arrow 
	directions."
	"wiz - to avoid roundoff errors we return unrounded curvebounds."
	"we expect our receiver to take responsibility for approriate rounding adjustment."
	"hint: this is most likely 'self curveBounds expanded' "
	| pointAfterFirst pointBeforeLast  oX oY cX cY |
	self isCurvy
		ifFalse: [^ (Rectangle encompassing: vertices)
				expandBy: self borderWidth * 0.5 ].
	curveState := nil.
	"Force recomputation"
	"curveBounds := vertices first corner: vertices last."
	pointAfterFirst := nil.
	self
		lineSegmentsDo: [:p1 :p2 | 
			pointAfterFirst isNil
				ifTrue: [pointAfterFirst := p2 floor .
					oX := cX := p1 x.
					oY := cY := p1 y. ].
			"curveBounds := curveBounds encompass: p2 ."
			oX:= oX min: p2 x.
			cX := cX max: p2 x.
			oY := oY min: p2 y.
			cY := cY max: p2 y.
			pointBeforeLast := p1 floor ].
	curveState at: 2 put: pointAfterFirst.
	curveState at: 3 put: pointBeforeLast.
	^ ( oX @ oY corner: cX @ cY )  expandBy: self borderWidth * 0.5 ! !

!RubSegmentMorph methodsFor: 'smoothing' stamp: 'AlainPlantec 2/7/2014 09:24'!
computeNextToEndPoints
	| pointAfterFirst pointBeforeLast |
	pointAfterFirst := nil.
	self lineSegmentsDo: 
			[:p1 :p2 | 
			pointAfterFirst ifNil: [pointAfterFirst := p2 asIntegerPoint].
			pointBeforeLast := p1 asIntegerPoint].
	curveState at: 2 put: pointAfterFirst.
	curveState at: 3 put: pointBeforeLast! !

!RubSegmentMorph methodsFor: 'initialization' stamp: 'AlainPlantec 2/7/2014 09:24'!
defaultBorderColor
	"answer the default border color/fill style for the receiver"
	^ Color
		r: 0.0
		g: 0.419
		b: 0.935! !

!RubSegmentMorph methodsFor: 'private' stamp: 'AlainPlantec 2/7/2014 09:41'!
borderForm
	"A form must be created for drawing the border whenever the borderColor is translucent."

	| borderCanvas |
	borderForm ifNotNil: [^ borderForm].
	borderCanvas := (Display defaultCanvasClass extent: bounds extent depth: 1)
		asShadowDrawingCanvas: Color black.
	borderCanvas translateBy: bounds topLeft negated
		during:[:tempCanvas| self drawBorderOn: tempCanvas].
	borderForm := borderCanvas form.
	^ borderForm! !

!RubSegmentMorph methodsFor: 'geometry' stamp: 'AlainPlantec 2/7/2014 09:24'!
merge: aPolygon 
	"Expand myself to enclose the other polygon.  (Later merge overlapping or disjoint in a smart way.)  For now, the two polygons must share at least two vertices.  Shared vertices must come one after the other in each polygon.  Polygons must not overlap."

	| shared mv vv hv xx |
	shared := vertices select: [:mine | aPolygon vertices includes: mine].
	shared size < 2 ifTrue: [^nil].	"not sharing a segment"
	mv := vertices asOrderedCollection.
	[shared includes: mv first] whileFalse: 
			["rotate them"

			vv := mv removeFirst.
			mv addLast: vv].
	hv := aPolygon vertices asOrderedCollection.
	[mv first = hv first] whileFalse: 
			["rotate him until same shared vertex is first"

			vv := hv removeFirst.
			hv addLast: vv].
	[shared size > 2] whileTrue: 
			[shared := shared asOrderedCollection.
			(self 
				mergeDropThird: mv
				in: hv
				from: shared) ifNil: [^nil]].
	"works by side effect on the lists"
	(mv second) = hv last 
		ifTrue: 
			[mv
				removeFirst;
				removeFirst.
			^self setVertices: (hv , mv) asArray].
	(hv second) = mv last 
		ifTrue: 
			[hv
				removeFirst;
				removeFirst.
			^self setVertices: (mv , hv) asArray].
	(mv second) = (hv second) 
		ifTrue: 
			[hv removeFirst.
			mv remove: (mv second).
			xx := mv removeFirst.
			^self setVertices: (hv , (Array with: xx) , mv reversed) asArray].
	mv last = hv last 
		ifTrue: 
			[mv removeLast.
			hv removeFirst.
			^self setVertices: (mv , hv reversed) asArray].
	^nil! !

!RubSegmentMorph methodsFor: 'geometry' stamp: 'AlainPlantec 2/7/2014 09:24'!
referencePosition 
	"Return the current reference position of the receiver"
	^ self valueOfProperty: #referencePosition ifAbsent: [super referencePosition]
! !

!RubSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/7/2014 09:51'!
borderColor: aColor 

	super borderColor: aColor.
	self releaseCachedState! !

!RubSegmentMorph methodsFor: 'cubic support' stamp: 'AlainPlantec 2/7/2014 09:24'!
segmentedSlopesOf: knots 
	"For a collection of floats. Returns the slopes for straight 
	segments between vertices."
	"last slope closes the polygon. Always return same size as 
	self. "
	^ knots collectWithIndex: [:x :i | (knots atWrap: i + 1) - x]! !

!RubSegmentMorph methodsFor: 'private' stamp: 'AlainPlantec 2/7/2014 09:43'!
computeBounds
	vertices ifNil: [^ self].
	self changed.
	self releaseCachedState.
	bounds := self curveBounds expanded.
	self layoutChanged.
	self changed.
! !

!RubSegmentMorph class methodsFor: 'instance creation' stamp: 'AlainPlantec 2/7/2014 11:48'!
vertices: verts color: c borderWidth: bw borderColor: bc
	^ self basicNew beStraightSegments vertices: verts color: c borderWidth: bw borderColor: bc! !

!RubSelectionChanged methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:34'!
textArea
	^ morph! !

!RubSelectionChanged methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 10:03'!
from: aTextArea previousMarkBlock: prevMarkBlock previousPointBlock: prevPointBlock 
	self morph: aTextArea.
	previousMarkBlock := prevMarkBlock.
	previousPointBlock := prevPointBlock! !

!RubSelectionChanged methodsFor: 'accessing' stamp: 'AlainPlantec 4/19/2013 12:07'!
previousPointBlock
	^ previousPointBlock! !

!RubSelectionChanged methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:34'!
markBlock
	^ self textArea markBlock! !

!RubSelectionChanged methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:34'!
pointBlock
	^ self textArea pointBlock! !

!RubSelectionChanged methodsFor: 'accessing' stamp: 'AlainPlantec 4/19/2013 12:07'!
previousMarkBlock
	^ previousMarkBlock! !

!RubSelectionChanged class methodsFor: 'instance creation' stamp: 'AlainPlantec 5/7/2013 10:03'!
from: aTextArea previousMarkBlock: prevMarkBlock previousPointBlock: prevPointBlock 
	^ self new from: aTextArea previousMarkBlock: prevMarkBlock previousPointBlock: prevPointBlock 
! !

!RubSelectorChooserMorph methodsFor: 'action' stamp: 'AlainPlantec 4/5/2013 10:06'!
choose: index
	"Set the given choice and ok."
	requestor ifNil: [^ self delete].
	requestor editor selectorChooser ~= self 
		ifTrue: [^ self delete].
	requestor takeKeyboardFocus.
	super choose: index
	! !

!RubSelectorChooserMorph methodsFor: 'action' stamp: 'AlainPlantec 4/5/2013 08:40'!
close
	requestor 
		ifNotNil: [requestor takeKeyboardFocus.
			self choose: 0]! !

!RubSelectorChooserMorph methodsFor: 'ui-building' stamp: 'AlainPlantec 4/5/2013 08:40'!
newContentMorph 
	| sp |
	sp := super newContentMorph.
	sp
		updateScrollbars.
	^ sp
! !

!RubSelectorChooserMorph methodsFor: 'ui-building' stamp: 'AlainPlantec 4/5/2013 08:40'!
nextPrefixWith: aPrefix
	| curr pref found lab |
	curr := aPrefix size.
	lab := self labels first.
	found := false.
	[lab size <= curr 
		ifTrue: [found := true]
		ifFalse: [pref := lab copyFrom: 1 to: curr.
			self labels 
				do: [:l | found 
					ifFalse: [(l asString beginsWith: pref)
						ifFalse: [pref := pref allButLast.
							found := true]]]].
	found] whileFalse: [curr := curr + 1].
	^ (pref notNil and: [pref size > aPrefix size])
		ifTrue: [pref]
! !

!RubSelectorChooserMorph methodsFor: 'stepping and presenter' stamp: 'AlainPlantec 4/5/2013 09:49'!
step
	[requestorPos 
		ifNil: [requestorPos := requestor owner position]
		ifNotNil: [requestorPos ~= requestor owner position
			ifTrue: [^ self close]].
	(requestor isNil or: [requestor isInWorld not])
		ifTrue: [^ self close].
	requestor editor selectorChooser ~= self 
		ifTrue: [self close]
	] on: Error do: [self delete]
! !

!RubSelectorChooserMorph methodsFor: 'accessing' stamp: 'AlainPlantec 4/5/2013 08:40'!
defaultBaseColor
	^  (self theme menuColorFor: self) muchLighter! !

!RubSelectorChooserMorph methodsFor: 'ui-building' stamp: 'AlainPlantec 5/15/2013 09:40'!
positionInRequestor
	|  caret  editor pos allowedArea |
	requestor ifNil: [^self].
	editor := requestor editor.
	caret := editor stopIndex.
	editor selectAt: caret.
	pos := editor selectionPosition: prefix.
	allowedArea := self allowedArea.
	(pos x + self width) > allowedArea width
		ifTrue: [pos := pos - (self width @ 0) - ((50 + 40)@ 0)].
	(pos y + self height) > allowedArea height
		ifTrue: [pos := (pos x @ (allowedArea height - self height - 5))].
	^ pos 
 ! !

!RubSelectorChooserMorph methodsFor: 'accessing' stamp: 'AlainPlantec 4/5/2013 08:40'!
prefix: aPrefix
	"Set the value of labels"
	prefix := aPrefix.
! !

!RubSelectorChooserMorph methodsFor: 'testing' stamp: 'AlainPlantec 4/5/2013 08:40'!
wantsSteps 
	^ requestor notNil! !

!RubSelectorChooserMorph methodsFor: 'submorphs-add/remove' stamp: 'AlainPlantec 4/5/2013 08:40'!
comeToFront
	super comeToFront.
	self setPosition ! !

!RubSelectorChooserMorph methodsFor: 'drawing' stamp: 'AlainPlantec 4/16/2013 01:26'!
drawCommonPrefixAreasOn: aCanvas
	| firstMenu firstMenuItem topLeft bottomLeft lastMenuItem |
	requestor ifNil: [^ self ].
	prefix  
		ifNotNil: [ self choiceMenus 
			do: [:cm | self drawCommonPrefixAreasOn: aCanvas menu: cm]]
! !

!RubSelectorChooserMorph methodsFor: 'ui-building' stamp: 'AlainPlantec 4/5/2013 08:40'!
setPosition
	self position: self positionInRequestor.
! !

!RubSelectorChooserMorph methodsFor: 'ui-building' stamp: 'AlainPlantec 4/5/2013 09:40'!
open
	super open. 
	self comeToFront.
	self borderStyle: ( self theme progressBarBorderStyleFor: self).
	self setPosition! !

!RubSelectorChooserMorph methodsFor: 'drawing' stamp: 'AlainPlantec 4/5/2013 08:40'!
fullDrawOn: aCanvas
	super fullDrawOn: aCanvas.
	self drawCommonPrefixAreasOn: aCanvas
	! !

!RubSelectorChooserMorph methodsFor: 'stepping and presenter' stamp: 'AlainPlantec 4/5/2013 08:40'!
stepTime
	^ 500! !

!RubSelectorChooserMorph methodsFor: 'drawing' stamp: 'AlainPlantec 4/5/2013 08:40'!
drawCommonPrefixAreasOn: aCanvas menu: aMenu
	| firstMenuItem topLeft bottomLeft lastMenuItem w c |
	firstMenuItem := aMenu menuItems first.
	lastMenuItem := aMenu menuItems last.
	w := (firstMenuItem fontToUse widthOfString: prefix).
	topLeft := firstMenuItem boundsInWorld topLeft.
	bottomLeft := lastMenuItem boundsInWorld bottomLeft + ( w @ 0 ).
	c := aMenu color muchDarker.
	aCanvas fillRectangle: (topLeft  corner: bottomLeft) color: (c alpha: 0.3)! !

!RubSelectorChooserMorph class methodsFor: 'opening' stamp: 'AlainPlantec 4/5/2013 10:00'!
popUpPrefix: aPrefix from: aTextMorph 
	Cursor wait
		showWhile: [| selectors chooser |
			selectors := self selectorsFromPrefix: aPrefix.
			selectors size = 1
				ifTrue: [aTextMorph editor selectorChooserChosenSelector: selectors first.
					^ nil].
			selectors isEmpty
				ifFalse: [chooser := self new
								chooseBlock: [:chosen | aTextMorph editor selectorChooserChosenSelector: chosen];
								 requestor: aTextMorph;
								 prefix: aPrefix; 
								 labels: selectors;
								 yourself.
					chooser open].
			^ chooser]! !

!RubSelectorChooserMorph class methodsFor: 'accessing' stamp: 'StephaneDucasse 4/23/2013 14:55'!
selectorsFromPrefix: aPrefix
	"returns the value of labels from a selector prefix"
	"self selectorsFromPrefix: 'prin' "
	| key applicants |
	aPrefix isEmptyOrNil  ifTrue: [^ #()].
	applicants := aPrefix first canBeGlobalVarInitial
		ifTrue: [Array streamContents: [:strm |
			Symbol allSymbolTablesDo: [:each |
				(each notEmpty and: [each first canBeGlobalVarInitial])
					ifTrue: [strm nextPut: each]]]]
		ifFalse: [Array streamContents: [:strm |
			Symbol allSymbolTablesDo: [:each |
				(each notEmpty and: [each first canBeGlobalVarInitial not])
					ifTrue: [strm nextPut: each]]]].
	key := aPrefix asLowercase.
	^ (applicants select: [:each | (each asLowercase beginsWith: key) and: [each noneSatisfy: [:c | c tokenish not]]]) sort
! !

!RubShoutStylerDecorator methodsFor: 'editing' stamp: 'AlainPlantec 5/17/2013 00:02'!
stylerStyledInBackground: styledCopyOfText
	next ifNil: [ ^self ].
	text string = styledCopyOfText string
		ifTrue: [ self stylerStyled: styledCopyOfText ].
! !

!RubShoutStylerDecorator methodsFor: 'editing' stamp: 'AlainPlantec 5/22/2013 18:08'!
replaceFrom: start to: stop with: aText
	self okToStyle
		ifFalse: [ ^ next replaceFrom: start to: stop with: aText ].
	self
		disableDrawingWhile: [
			aText addAttribute: self defaultFontChange.
			text ifNil: [ text := self text ].
			text replaceFrom: start to: stop with: (self styler format: aText).
			self style: text.
			next text: text.
			self recomposeFrom: start to: start + aText size - 1 delta: aText size - (stop - start + 1).
			self textArea paragraphWasComposedFrom: start to: start + aText size - 1.
			self textArea paragraphReplacedTextFrom: start to: stop with: aText ]! !

!RubShoutStylerDecorator methodsFor: 'accessing' stamp: 'AlainPlantec 4/23/2013 21:38'!
styler
	"The styler responsible for highlighting text in the receiver"
	^ styler ifNil: [styler := self defaultStyler]! !

!RubShoutStylerDecorator methodsFor: 'editing' stamp: 'AlainPlantec 10/3/2014 16:32'!
stylerStyled: styledCopyOfText
	next ifNil: [ ^self ].
	text runs: styledCopyOfText runs.
	"The selection and then the cursor bounds has to be updated 
	to take possible text attribute changes into account"
	self textArea recomputeSelection.
	self textArea cursor updateBounds.
	""
	(self textArea scrollPane ifNil: [ self textArea ]) changed.! !

!RubShoutStylerDecorator methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:48'!
next: aDecorator
	super next: aDecorator.
	aDecorator ifNotNil: [ 
		self textArea announcer subscribe: RubTextAcceptRequest send: #whenTextAcceptRequest: to: self.
		savedTextColor := self textArea textColor.
		self textArea textColor: Color transparent]! !

!RubShoutStylerDecorator methodsFor: 'accessing' stamp: 'AndreiChis 5/3/2014 19:13'!
beForSmalltalkScripting
	self styler workspace: self model! !

!RubShoutStylerDecorator methodsFor: 'accessing' stamp: 'AlainPlantec 4/24/2013 03:09'!
classOrMetaClass: aBehavior
	"set the classOrMetaClass in the receiver's styler to aBehavior"
		
	self styler classOrMetaClass: aBehavior! !

!RubShoutStylerDecorator methodsFor: 'accessing' stamp: 'AlainPlantec 5/17/2013 00:43'!
text: aText
	self okToStyle
		ifFalse: [ ^ next text: aText ].
	self
		disableDrawingWhile: [
			aText addAttribute: self defaultFontChange.
			next text: (text := (self styler format: aText)).
			self style: text]! !

!RubShoutStylerDecorator methodsFor: 'accessing' stamp: 'AlainPlantec 2/6/2014 13:24'!
text
	^ next text! !

!RubShoutStylerDecorator methodsFor: 'accessing' stamp: 'AlainPlantec 4/24/2013 00:01'!
shoutIsAvailable
	^ shoutIsAvailable ifNil: [ shoutIsAvailable := (Smalltalk at: #SHTextStylerST80 ifAbsent: []) notNil] ! !

!RubShoutStylerDecorator methodsFor: 'accessing' stamp: 'AndreiChis 11/12/2014 11:46'!
defaultStyler
	^ ((Smalltalk at: #RubSHTextStylerST80) ifNil: [ ^nil ]) new view: self; yourself! !

!RubShoutStylerDecorator methodsFor: 'event handling' stamp: 'AlainPlantec 4/24/2013 08:57'!
whenTextAcceptRequest: anAnnouncement

	" shout for the whole text "
	(next notNil and: [self okToStyle])
		ifTrue: [ self text: self text ]! !

!RubShoutStylerDecorator methodsFor: 'private' stamp: 'AlainPlantec 5/7/2013 09:48'!
aboutToBeUnplugged
	next
		ifNotNil: [ 
			self textArea announcer unsubscribe: self.
			self textArea textColor: savedTextColor ]! !

!RubShoutStylerDecorator methodsFor: 'editing' stamp: 'TudorGirba 6/14/2014 21:02'!
style: aText
	self styler styleInBackgroundProcess: aText! !

!RubShoutStylerDecorator methodsFor: 'initialize-release' stamp: 'AlainPlantec 4/24/2013 11:25'!
unplug 
	super unplug! !

!RubShoutStylerDecorator methodsFor: 'shout' stamp: 'AlainPlantec 5/7/2013 09:48'!
shoutAboutToStyle: myself 
	^ self textArea shoutAboutToStyle: myself! !

!RubShoutStylerDecorator methodsFor: 'accessing' stamp: 'AlainPlantec 4/24/2013 02:50'!
okToStyle
	^ self shoutIsAvailable and: [ self shoutAboutToStyle: self ]! !

!RubShoutStylerDecorator class methodsFor: 'querying' stamp: 'AlainPlantec 4/23/2013 23:50'!
key
	^ #shoutStyler! !

!RubSmalltalkCodeMode methodsFor: 'shout' stamp: 'AlainPlantec 5/17/2013 20:49'!
hasBindingThatBeginsWith: aString 
	" For the shout styler "
	^ self model notNil and: [ self model hasBindingThatBeginsWith: aString ]! !

!RubSmalltalkCodeMode methodsFor: 'initialize-release' stamp: 'AlainPlantec 3/17/2014 12:30'!
updateTextAreaWhenUnplugged
	self textArea withoutShoutStyler.
	super updateTextAreaWhenUnplugged

! !

!RubSmalltalkCodeMode methodsFor: 'shout' stamp: 'AlainPlantec 5/17/2013 20:46'!
withShoutStyler
	self textArea withDecoratorNamed: #shoutStyler! !

!RubSmalltalkCodeMode methodsFor: 'shout' stamp: 'AlainPlantec 5/17/2013 20:48'!
hasBindingOf: aString
	" For the shout styler "
	^ self model notNil and: [ self model hasBindingOf: aString ]! !

!RubSmalltalkCodeMode methodsFor: 'initialize-release' stamp: 'AlainPlantec 3/17/2014 12:16'!
editorClass
	^ RubSmalltalkEditor.
! !

!RubSmalltalkCodeMode methodsFor: 'shout' stamp: 'AlainPlantec 5/17/2013 21:10'!
shoutStyler
	^ self textArea decoratorNamed: #shoutStyler! !

!RubSmalltalkCodeMode methodsFor: 'shout' stamp: 'AlainPlantec 5/17/2013 20:46'!
withoutShoutStyler
	self textArea withoutDecoratorNamed: #shoutStyler! !

!RubSmalltalkCodeMode methodsFor: 'shout' stamp: 'AlainPlantec 5/17/2013 21:08'!
classOrMetaClass: aBehavior
	"set the classOrMetaClass in the receiver's styler to aBehavior"
	self textArea shoutStyler ifNotNil: [ :s | s classOrMetaClass: aBehavior]! !

!RubSmalltalkCodeMode methodsFor: 'shout' stamp: 'AlainPlantec 5/17/2013 20:47'!
bindingOf: varName
	^ self model bindingOf: varName! !

!RubSmalltalkCodeMode methodsFor: 'shout' stamp: 'AlainPlantec 5/18/2013 01:26'!
shoutAboutToStyle: myShoutStyler
	^ self model isNil or: [ (self model respondsTo: #shoutAboutToStyle:) not or: [ self model shoutAboutToStyle: self] ]! !

!RubSmalltalkCodeMode methodsFor: 'initialize-release' stamp: 'AlainPlantec 3/17/2014 12:30'!
updateTextAreaWhenPlugged
	self textArea withShoutStyler.
	super updateTextAreaWhenPlugged

! !

!RubSmalltalkCodeMode class methodsFor: 'accessing' stamp: 'AlainPlantec 5/17/2013 14:07'!
label
	^ 'Smalltalk code'! !

!RubSmalltalkCodeMode class methodsFor: 'menu' stamp: 'AlainPlantec 5/20/2014 22:47'!
menuKeyword
	^ 'RubSmalltalkCodeMenu'! !

!RubSmalltalkCodeMode class methodsFor: 'menu' stamp: 'EstebanLorenzano 3/20/2015 16:40'!
menuOn: aBuilder
	"Specify the menu used when writing code. Try it with:
	(PragmaMenuBuilder 
		pragmaKeyword: 'smalltalkEditorMenu'
		model: nil) menu popUpInWorld
	"

	<contextMenu>
	<RubSmalltalkCodeMenu>
	| uitheme |
	uitheme := Smalltalk ui icons.
	self currentUser canEvaluateCode
		ifTrue: [ 
			(aBuilder item: #'Do it' translated)
				keyText: 'd';
				selector: #doIt;
				help: nil;
				icon: uitheme smallDoItIcon.
			(aBuilder item: #'Print it' translated)
				keyText: 'p';
				selector: #printIt;
				help: nil;
				icon: uitheme smallPrintItIcon ].
	self currentUser canInspect
		ifTrue: [ 
			(aBuilder item: #'Inspect it' translated)
				keyText: 'i';
				selector: #inspectIt;
				help: nil;
				icon: uitheme smallInspectItIcon.
			(aBuilder item: #'Basic Inspect it' translated)
				keyText: 'I';
				selector: #basicInspectIt;
				help: nil;
				icon: uitheme smallInspectItIcon ].
	self currentUser canDebug
		ifTrue: [ 
			(aBuilder item: #'Debug it' translated)
				keyText: 'D';
				selector: #debugIt;
				help: nil;
				icon: uitheme smallDebugIcon.
			(aBuilder item: #'Profile it' translated)
				selector: #tallyIt;
				icon: uitheme smallDebugIcon;
				withSeparatorAfter ].
	(aBuilder item: #'Find...' translated)
		keyText: 'f';
		selector: #find;
		help: nil;
		icon: uitheme smallFindIcon.
	(aBuilder item: #'Find again' translated)
		keyText: 'g';
		selector: #findAgain;
		help: nil;
		icon: uitheme smallFindIcon.
	self currentUser canBrowse
		ifTrue: [ self extendedSearchMenuOn: aBuilder ].
	(aBuilder item: #'Do again' translated)
		keyText: 'j';
		selector: #again;
		help: nil;
		icon: uitheme smallRedoIcon.
	(aBuilder item: #Undo translated)
		keyText: 'z';
		selector: #undo;
		help: nil;
		icon: uitheme smallUndoIcon;
		withSeparatorAfter.
	(aBuilder item: #Copy translated)
		keyText: 'c';
		selector: #copySelection;
		help: nil;
		icon: uitheme smallCopyIcon.
	(aBuilder item: #Cut translated)
		keyText: 'x';
		selector: #cut;
		help: nil;
		icon: uitheme smallCutIcon.
	(aBuilder item: #Paste translated)
		keyText: 'v';
		selector: #paste;
		help: nil;
		icon: uitheme smallPasteIcon.
	(aBuilder item: #'Paste...' translated)
		selector: #pasteRecent;
		help: nil;
		icon: uitheme smallCopyIcon;
		withSeparatorAfter.
	aBuilder model model
		ifNotNil: [ 
			self currentUser canEditCode
				ifTrue: [ 
					(aBuilder item: #Accept translated)
						keyText: 's';
						selector: #accept;
						icon: uitheme smallOkIcon.
					(aBuilder item: #Cancel translated)
						keyText: 'l';
						selector: #cancel;
						icon: uitheme smallCancelIcon ] ]! !

!RubSmalltalkCodeMode class methodsFor: 'menu' stamp: 'AlainPlantec 3/17/2014 12:08'!
editingModeMenuOn: aBuilder
	"Specify the menu used to select an editing mode"

	<contextMenu>
	<RubEditingModeMenu>
	(aBuilder item: self label translated)
		action: [:model | model textArea editingMode: self new]! !

!RubSmalltalkEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 5/6/2013 23:44'!
referencesToIt: aKeyboardEvent
	"Triggered by Cmd-N; browse references to the current selection"

	self currentUser canBrowse ifFalse: [ ^ false ].
	self referencesToIt.
	^ true! !

!RubSmalltalkEditor methodsFor: 'basic-completion' stamp: 'AlainPlantec 4/5/2013 10:15'!
selectorChooserKeystroke: aKeyboardEvent
	| asciiValue |
	selectorChooser 
		ifNotNil: [(selectorChooser handlesKeyStroke: aKeyboardEvent) 
			ifTrue: [selectorChooser keyStroke: aKeyboardEvent.
				^ true]].
	asciiValue := aKeyboardEvent keyValue.
	asciiValue = Character cr asciiValue
		ifTrue: [self selectorChooserClose.
			^ true].
	aKeyboardEvent controlKeyPressed
		ifTrue: [self selectorChooserClose.
			^ true].
	"aKeyboardEvent commandKeyPressed
		ifTrue: [self closeSelectorChooser.
			^ true]."
	self selectorChooserUpdate.
	^ false! !

!RubSmalltalkEditor methodsFor: 'new selection' stamp: 'AndreiChis 1/12/2015 10:55'!
computeSelectionIntervalForCurrentLine
	| i left right s |
	s := self string.
	i := s encompassParagraph: self selectionInterval.
	left := i first.
	right := i last.
	[ left <= right and: [ (s at: left) = $" or: [(s at: left) isSeparator] ] ]
		whileTrue: [ left := left + 1 ].
	[ left <= right and: [ (s at: right) = $"  or: [(s at: right) isSeparator] ] ]
		whileTrue: [ right := right - 1 ].
	^ left to: right! !

!RubSmalltalkEditor methodsFor: 'do-its' stamp: 'AndreiChis 1/14/2015 12:20'!
highlightEvaluateAndDo: aBlock
	"Treat the current selection as an expression; evaluate it and invoke aBlock with the result."
	
	self highlightAndEmptyCheck: [ ^ '' ].
	^ self 
		evaluate: self highlightedTextAsStream
		andDo: [:result | aBlock value: result]! !

!RubSmalltalkEditor methodsFor: 'do-its' stamp: 'AndreiChis 1/14/2015 11:29'!
compile: aStream for: anObject in: evalContext
	| methodNode  |

	methodNode :=  self class compiler
		source: aStream;
		class: anObject class;
		context: evalContext;
		requestor: self morph;
		noPattern: true;
		failBlock:  [ ^nil ];
		translate.
			
	^methodNode generateWithSource! !

!RubSmalltalkEditor methodsFor: 'do-its' stamp: 'AndreiChis 1/14/2015 13:12'!
tally: aStream
	"Treat the current selection as an expression; evaluate and tally it."
	| receiver context v compiledMethod profiler |
	(self model respondsTo: #doItReceiver) 
		ifTrue: 
			[receiver := self model doItReceiver.
			context := self model doItContext]
		ifFalse:
			[receiver := context := nil].
	compiledMethod := self compile: aStream for: receiver in: context.
	compiledMethod ifNil: [^ self].
	profiler := TimeProfiler spyOn: [ v:= compiledMethod valueWithReceiver: receiver arguments: #()].
	profiler showResult: v.
	
! !

!RubSmalltalkEditor methodsFor: 'do-its' stamp: 'AlainPlantec 3/22/2013 11:08'!
evaluateSelection
	"Treat the current selection as an expression; evaluate it and return the result"
	
	^self evaluateSelectionAndDo: [:result | result]! !

!RubSmalltalkEditor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 4/5/2013 10:15'!
querySymbol: aKeyboardEvent
	"Invoked by Ctrl-q to query the Symbol table and display alternate symbols.
	 See comment in completeSymbol:lastOffering: for details."

	self closeTypeIn.
	self selectorChooserClose.
	self querySymbol.
	^true! !

!RubSmalltalkEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 4/3/2013 01:54'!
selectedSymbol
	"Return the currently selected symbol, or nil if none.  Spaces, tabs and returns are ignored"

	| aString |
	self hasCursor ifTrue: [^ nil].
	aString := self selection string copyWithoutAll:
		{Character space.  Character cr.  Character tab}.
	aString size = 0 ifTrue: [^ nil].
	Symbol hasInterned: aString  ifTrue: [:sym | ^ sym].

	^ nil! !

!RubSmalltalkEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 4/18/2013 11:49'!
spawn
	"Create and schedule a message browser for the code of the model's 
	selected message. Retain any edits that have not yet been accepted."
	| code |
	code := self string.
	self cancel.
	self model spawn: code.! !

!RubSmalltalkEditor methodsFor: 'do-its' stamp: 'AlainPlantec 3/22/2013 11:08'!
tallyIt

	^ self tallySelection! !

!RubSmalltalkEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 5/6/2013 23:43'!
debugIt: aKeyboardEvent
	"Evaluate the current selection in the Debugger."

	self currentUser canDebug ifFalse: [ ^ false ].
	self debugIt.
	^ true! !

!RubSmalltalkEditor methodsFor: 'initialization' stamp: 'TudorGirba 8/1/2014 19:05'!
initialize
	super initialize.
	notificationStrategy := RubTextInsertionStrategy new editor: self! !

!RubSmalltalkEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 3/22/2013 11:08'!
browseIt
	"Launch a browser for the current selection, if appropriate"
	^ self browseClassFromIt
! !

!RubSmalltalkEditor methodsFor: 'do-its' stamp: 'AndreiChis 1/13/2015 14:38'!
evaluateSelectionAndDo: aBlock
	"Treat the current selection as an expression; evaluate it and invoke aBlock with the result.
	If no selection is present select the current line."

	self lineSelectAndEmptyCheck: [^ ''].
	^ self 
		evaluate: self selectionForDoitAsStream 
		andDo: aBlock! !

!RubSmalltalkEditor methodsFor: 'binding' stamp: 'AlainPlantec 5/12/2013 08:17'!
bindingOf: aString
	^ self textArea bindingOf: aString! !

!RubSmalltalkEditor methodsFor: 'do-its' stamp: 'AlainPlantec 3/22/2013 11:08'!
debug: aCompiledMethod receiver: anObject in: evalContext

 	 | guineaPig debugger context |

       guineaPig := [
              aCompiledMethod
                       valueWithReceiver: anObject
                       arguments: (evalContext ifNil: [ #() ] ifNotNil: [ { evalContext } ]) ] newProcess.
       context := guineaPig suspendedContext.
       debugger :=  Smalltalk tools debugger new
               process: guineaPig
               controller: nil
               context: context.
       debugger openFullNoSuspendLabel: 'Debug it'.
       [ debugger interruptedContext method == aCompiledMethod ]
               whileFalse: [ debugger send ]! !

!RubSmalltalkEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 4/18/2013 11:48'!
methodSourceContainingIt
	"Open a browser on methods which contain the current selection in their source (case-sensitive full-text search of source).   EXTREMELY slow!!"
	self lineSelectAndEmptyCheck: [^ self].
	self model systemNavigation  browseMethodsWithSourceString: self selection string matchCase: false.! !

!RubSmalltalkEditor methodsFor: 'new selection' stamp: 'AlainPlantec 3/22/2013 11:08'!
nextTokenFrom: start direction: dir
	"simple token-finder for compiler automated corrections"
	| loc str |
	loc := start + dir.
	str := self string.
	[(loc between: 1 and: str size) and: [(str at: loc) isSeparator]]
		whileTrue: [loc := loc + dir].
	^ loc! !

!RubSmalltalkEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 5/6/2013 23:44'!
inspectIt: aKeyboardEvent
	"Inspect the selection -- invoked via cmd-i.  If there is no current selection, use the current line.  1/17/96 sw
	 2/29/96 sw: don't call selectLine; it's done by inspectIt now"

	self currentUser canInspect ifFalse: [ ^ false ].
	self inspectIt.
	^ true! !

!RubSmalltalkEditor methodsFor: 'menu messages' stamp: 'AndreiChis 9/24/2014 10:31'!
browseClassFrom: aClassString
	"Launch a hierarchy browser for the class indicated by the current selection.  If multiple classes matching the selection exist, let the user choose among them."

	| selectedClass |
	self lineSelectAndEmptyCheck: [ ^ self ].
	selectedClass := self model systemNavigation 
		classFromPattern: aClassString 
		withCaption: 'choose a class to browse...'.
	selectedClass isNil
		ifTrue: [ ^ self internalCallToImplementorsOf: aClassString ].
	Smalltalk tools browser fullOnClass: selectedClass! !

!RubSmalltalkEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 5/6/2013 23:43'!
doIt: aKeyboardEvent
	"Called when user hits cmd-d.  Select the current line, if relevant, then evaluate and execute.  2/1/96 sw.
	2/29/96 sw: don't call selectLine; it's done by doIt now"
	
	self currentUser canEvaluateCode ifFalse: [ ^ false ].
	self doIt.
	^ true! !

!RubSmalltalkEditor methodsFor: 'menu messages' stamp: 'AndreiChis 9/24/2014 10:33'!
internalCallToBrowse: aSelector
	"Launch a browser for the class indicated by the given selector. 
	If multiple classes matching the selection exist, let the user choose among them."
	| aClass |
	aClass := self model systemNavigation 
				classFromPattern: aSelector
				withCaption: 'choose a class to browse...'.
	aClass ifNil: [^ self].
	Smalltalk tools browser fullOnClass: aClass! !

!RubSmalltalkEditor methodsFor: 'new selection' stamp: 'TudorGirba 8/1/2014 18:57'!
notify: aString at: anInteger in: aStream 
	^ self notificationStrategy 
		notify: aString 
		at: anInteger 
		in: aStream 
! !

!RubSmalltalkEditor methodsFor: 'basic-completion' stamp: 'AlainPlantec 4/5/2013 10:01'!
querySymbol
	self selectorChooseQuerySymbol ! !

!RubSmalltalkEditor methodsFor: 'keymapping' stamp: 'TudorGirba 6/23/2014 00:20'!
initializeShortcuts: aKMDispatcher
	super initializeShortcuts: aKMDispatcher.
	aKMDispatcher attachCategory: RubSmalltalkEditor name! !

!RubSmalltalkEditor methodsFor: 'basic-completion' stamp: 'AlainPlantec 4/5/2013 10:15'!
selectorChooserClose
	selectorChooser 
		ifNotNil: [ [selectorChooser delete] ensure: [selectorChooser := nil] ]! !

!RubSmalltalkEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 4/18/2013 11:47'!
implementorsOf: aSelector
	"Open an implementors browser on the given selector"

	(self model systemNavigation allImplementorsOf: aSelector) isEmpty
			ifTrue: [self internalCallToBrowse: aSelector ]
			ifFalse: [ self model systemNavigation browseAllImplementorsOf: aSelector]! !

!RubSmalltalkEditor methodsFor: 'testing' stamp: 'AlainPlantec 3/22/2013 11:08'!
isSmalltalkEditor
	^ true ! !

!RubSmalltalkEditor methodsFor: 'basic-completion' stamp: 'AlainPlantec 4/5/2013 10:17'!
selectorChooserUpdate
	selectorChooser ifNil: [^ self].
	self selectorChooserClose.
	self selectorChooseQuerySymbol ! !

!RubSmalltalkEditor methodsFor: 'do-its' stamp: 'AlainPlantec 3/22/2013 11:08'!
exploreIt
	self evaluateSelectionAndDo: [:result | result explore]! !

!RubSmalltalkEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 4/18/2013 11:48'!
methodStringsContainingit
	"Open a browser on methods which contain the current selection as part of a string constant."

	self lineSelectAndEmptyCheck: [^ self].
	self model systemNavigation  browseMethodsWithString: self selection string matchCase: false.
! !

!RubSmalltalkEditor methodsFor: 'do-its' stamp: 'AlainPlantec 3/22/2013 11:08'!
inspectIt
	self evaluateSelectionAndDo: [:result | result inspect]! !

!RubSmalltalkEditor methodsFor: 'accessing' stamp: 'TudorGirba 8/1/2014 21:05'!
notificationStrategy: aStrategy
	notificationStrategy := aStrategy.
	aStrategy editor: self! !

!RubSmalltalkEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 5/7/2013 09:50'!
sendersOfIt
	"Open a senders browser on the selected selector"

	| selectedSelector mthds aClass syst |
	self lineSelectAndEmptyCheck: [^ self].
	selectedSelector  := self selectedSelector.
	selectedSelector isNil ifTrue: [^ textArea flash].
	syst := self model systemNavigation.
	mthds := (syst allCallsOn: selectedSelector).
	aClass := syst environment at: selectedSelector ifAbsent: [nil].   
	aClass isNil 
		ifFalse: [ mthds := mthds , (syst allReferencesTo: aClass binding) ].
	syst browseMessageList: mthds name: 'Senders or Users of ', selectedSelector autoSelect: selectedSelector ! !

!RubSmalltalkEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 5/6/2013 23:45'!
sendersOfIt: aKeyboardEvent
	"Triggered by Cmd-n; browse implementors of the selector represented by the current selection, if plausible. 2/1/96 sw"

	self currentUser canBrowse ifFalse: [ ^ false ].
	self sendersOfIt.
	^ true! !

!RubSmalltalkEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 5/6/2013 23:45'!
spawnIt: aKeyboardEvent
	"Triggered by Cmd-o; spawn a new code window, if it makes sense."

	self currentUser canBrowse ifFalse: [ ^ false ].
	self spawn.
	^ true! !

!RubSmalltalkEditor methodsFor: 'do-its' stamp: 'AndreiChis 1/14/2015 13:13'!
debug: aStream

	| method receiver context |
	(self model respondsTo: #doItReceiver) 
		ifTrue: 
			[receiver := self model doItReceiver.
			context := self model doItContext]
		ifFalse:
			[receiver := context := nil].
	method := self compile: aStream for: receiver in: context.
	method notNil ifTrue: [
		self debug: method receiver: receiver in: context ].
	! !

!RubSmalltalkEditor methodsFor: 'do-its' stamp: 'AndreiChis 1/14/2015 13:12'!
debugHighlight
	"Treat the current highlight as an expression; evaluate and debugg it in a new debugger."

	self highlightAndEmptyCheck: [ ^ self ].
	self debug: self highlightedTextAsStream! !

!RubSmalltalkEditor methodsFor: 'do-its' stamp: 'AndreiChis 1/14/2015 12:13'!
debugIt

	^ self debugSelection! !

!RubSmalltalkEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 4/18/2013 11:48'!
methodCaseSensitiveStringsContainingit
	"Open a browser on methods which contain the current selection as part of a string constant."

	self lineSelectAndEmptyCheck: [^ self].
	
	self model systemNavigation  browseMethodsWithString: self selection string matchCase: true! !

!RubSmalltalkEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 5/6/2013 23:44'!
pasteInitials: aKeyboardEvent 
	"Replace the current text selection by an authorship name/date stamp; invoked by cmd-shift-v, easy way to put an authorship stamp in the comments of an editor."

	self currentUser canEditCode ifFalse: [ ^ false ].
	self closeTypeIn.
	self replace: self selectionInterval with: (Text fromString: Author changeStamp) and: [self selectAt: self stopIndex].
	^ true! !

!RubSmalltalkEditor methodsFor: 'do-its' stamp: 'AndreiChis 1/14/2015 13:12'!
debugSelection
	"Treat the current selection as an expression; evaluate and debugg it in a new debugger."
	
	self lineSelectAndEmptyCheck: [^self].
	self debug: self selectionAsStream! !

!RubSmalltalkEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 3/22/2013 11:08'!
selectedSelector
	"Try to make a selector out of the current text selection"
	^self selection string findSelector! !

!RubSmalltalkEditor methodsFor: 'basic-completion' stamp: 'AlainPlantec 5/7/2013 09:50'!
selectorChooserFocusChange
	textArea hasFocus
		ifTrue: [ selectorChooser ifNotNil: [ selectorChooser comeToFront ] ]! !

!RubSmalltalkEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 5/7/2013 09:50'!
referencesToIt
	"Open a references browser on the selected symbol"

	| aSymbol env ref |
	self selectLine.
	((aSymbol := self selectedSymbol) == nil)
			ifTrue: [^ textArea flash].

	self referencesTo: aSymbol! !

!RubSmalltalkEditor methodsFor: 'typing support' stamp: 'TudorGirba 7/21/2014 13:34'!
keystroke: aKeyboardEvent
	self
		completionAround: [ 
			(self selectorChooserHandlesKeyboard: aKeyboardEvent)
				ifFalse: [ super keystroke: aKeyboardEvent ].
			self selectorChooserKeystroke: aKeyboardEvent ]
		keyStroke: aKeyboardEvent.
	textArea announce: (RubKeystroke with: aKeyboardEvent)! !

!RubSmalltalkEditor methodsFor: 'basic-completion' stamp: 'AlainPlantec 4/5/2013 09:49'!
selectorChooser
	^ selectorChooser
! !

!RubSmalltalkEditor methodsFor: 'do-its' stamp: 'AndreiChis 1/13/2015 14:47'!
evaluate: aStream andDo: aBlock
	"Treat the current selection as an expression; evaluate it and invoke aBlock with the result."
	| result rcvr ctxt |

	(self model respondsTo: #doItReceiver) 
		ifTrue: [ rcvr := self model doItReceiver.
				ctxt := self model doItContext]
		ifFalse: [ rcvr := ctxt := nil].
	result := rcvr class compiler
			source: aStream;
			context: ctxt;
			receiver: rcvr;
			requestor: self morph  "don't set it to self.. The receiver can be destroyed as a result of evaluateSelection";
			failBlock:  [self morph flash. ^ nil];
			evaluate.		
			
	^ aBlock value: result! !

!RubSmalltalkEditor methodsFor: 'do-its' stamp: 'AndreiChis 1/14/2015 13:12'!
tallyHighlight
	"Treat the current highlight as an expression; evaluate and tally it."
	
	self highlightAndEmptyCheck: [ ^ self ].
	self tally: self highlightedTextAsStream
	
! !

!RubSmalltalkEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 5/7/2013 09:50'!
implementorsOfIt
	"Open an implementors browser on the selected selector"

	| aSelector |
	self lineSelectAndEmptyCheck: [^ self].
	(aSelector := self selectedSelector) == nil ifTrue: [^ textArea flash].
	self implementorsOf: aSelector! !

!RubSmalltalkEditor methodsFor: 'do-its' stamp: 'AlainPlantec 3/22/2013 11:08'!
printIt
	"Treat the current text selection as an expression; evaluate it. Insert the 
	description of the result of evaluation after the selection and then make 
	this description the new text selection."

	| printString |
	self
		evaluateSelectionAndDo: [ :result | 
			printString := [ result printString ]
				on: Error
				do: [ '<error in printString: try ''Inspect it'' to debug>' ].
			self afterSelectionInsertAndSelect: printString ]! !

!RubSmalltalkEditor methodsFor: 'NOcompletion' stamp: 'AlainPlantec 4/26/2013 01:06'!
atCompletionPosition
	"Return true if the cursor is at a possible completion position"
	| cursorPosition |
	cursorPosition := self startIndex.
	cursorPosition < 2 ifTrue: [ ^ false ].
	^ (self text at: cursorPosition - 1) isCompletionCharacter! !

!RubSmalltalkEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 5/6/2013 23:43'!
exploreIt: aKeyboardEvent
	"Explore the selection -- invoked via cmd-shift-I.  If there is no current selection, use the current line."
	
	self currentUser canInspect ifFalse: [ ^ false ].
	self exploreIt.
	^ true! !

!RubSmalltalkEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 3/22/2013 11:08'!
browseClassFromIt
	"Launch a hierarchy browser for the class indicated by the current selection.  If multiple classes matching the selection exist, let the user choose among them."
	
	self lineSelectAndEmptyCheck: [^ self].
	self browseClassFrom: (self selection string copyWithoutAll: CharacterSet crlf)! !

!RubSmalltalkEditor methodsFor: 'events' stamp: 'AlainPlantec 4/26/2013 00:37'!
click: anEvent 	
	self selectorChooserClose.
	^ super click: anEvent 
! !

!RubSmalltalkEditor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 3/22/2013 11:08'!
displayIfFalse: aKeyboardEvent
	"Replace the current text selection with the text 'ifFalse:'--initiated by 
	ctrl-f."

	self addString: 'ifFalse:'.
	^false! !

!RubSmalltalkEditor methodsFor: 'do-its' stamp: 'AndreiChis 1/21/2015 20:25'!
compileSelectionFor: anObject in: evalContext
	
	^ self compile: self selectionAsStream for: anObject in: evalContext! !

!RubSmalltalkEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 4/18/2013 11:47'!
classNamesContainingIt
	"Open a browser on classes whose names contain the selected string"

	self lineSelectAndEmptyCheck: [^self].
	self model systemNavigation 
		browseClassesWithNamesContaining: self selection string
		caseSensitive: Sensor shiftPressed! !

!RubSmalltalkEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 3/22/2013 11:08'!
internalCallToBrowseIt
	"Launch a browser for the class indicated by the current selection. 
	If multiple classes matching the selection exist, let the user choose among them."
	| aClass |
	self lineSelectAndEmptyCheck: [^ self].
	self internalCallToBrowse: (self selection string copyWithoutAll: CharacterSet crlf)! !

!RubSmalltalkEditor methodsFor: 'accessing' stamp: 'TudorGirba 8/1/2014 19:04'!
notificationStrategy
	^ notificationStrategy! !

!RubSmalltalkEditor methodsFor: 'private' stamp: 'AlainPlantec 4/18/2013 11:48'!
modelCurrentSelectedClass
	" ugly dispatch, but current Browser protocol names aren't really cool "
	" for Nautilus ( and other tools), selectedClass sounds better, but I think it shouldn't be hardcoded "
	" IT'S A TEMP SOLUTION -- BenjaminVanRyseghem 14/04/11"

	" From now, all tools should use #selectedBehavior, waiting for a better solution - Thx Nice "
	(self model respondsTo: #selectedBehavior)
		ifTrue: [^ self model selectedBehavior ].
	
	" old selectors in order of uses "
	(self model respondsTo: #selectedClass)
		ifTrue: [^ self model selectedClass ].
	(self model respondsTo: #selectedClassOrMetaClass)
		ifTrue: [ ^ self model selectedClassOrMetaClass ].
	
		
	^ nil! !

!RubSmalltalkEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 5/6/2013 23:44'!
methodStringsContainingIt: aKeyboardEvent
	"Invoked from cmd-E -- open a browser on all methods holding string constants containing it."

	self currentUser canBrowse ifFalse: [ ^ false ].
	self methodStringsContainingit.
	^ true! !

!RubSmalltalkEditor methodsFor: 'basic-completion' stamp: 'AlainPlantec 4/5/2013 10:14'!
selectorChooserHandlesKeyboard: aKeyboardEvent
	^ (selectorChooser notNil and: [ selectorChooser handlesKeyboard: aKeyboardEvent ])
! !

!RubSmalltalkEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 3/22/2013 11:08'!
printIt: aKeyboardEvent
	"Print the results of evaluting the selection -- invoked via cmd-p.  If there is no current selection, use the current line.  1/17/96 sw
	 2/29/96 sw: don't call selectLine now, since it's called by doIt"
	self printIt.
	^ true! !

!RubSmalltalkEditor methodsFor: 'basic-completion' stamp: 'AlainPlantec 5/7/2013 09:50'!
selectorChooseQuerySymbol
	| pref |
	self hasSelection
		ifFalse: [ self selectPrecedingIdentifier ].
	pref := String
		streamContents: [ :strm | 
			self selection asString trimBoth
				do: [ :c | 
					c isSeparator
						ifFalse: [ strm nextPut: c ] ] ].
	selectorChooser := RubSelectorChooserMorph popUpPrefix: pref from: textArea! !

!RubSmalltalkEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 5/6/2013 23:44'!
methodNamesContainingIt: aKeyboardEvent
	"Browse methods whose selectors containing the selection in their names"

	self currentUser canBrowse ifFalse: [ ^ false ].
	self methodNamesContainingIt.
	^ true! !

!RubSmalltalkEditor methodsFor: 'menu messages' stamp: 'TudorGirba 6/3/2014 08:43'!
referencesTo: aVariableOrClassName
	"Open a references browser on the given symbol"
	| env ref |

	" ugly dispatch, but current Browser protocol names aren't really cool "
	env := self modelCurrentSelectedClass ifNil: [ Smalltalk globals ].

	env isBehavior ifTrue: [
		(env instVarIndexFor: aVariableOrClassName) > 0 ifTrue: [
		 ^ self systemNavigation browseAllAccessesTo: aVariableOrClassName from: env]].

	ref:= (env bindingOf: aVariableOrClassName) ifNil: [ ^ self ].
	
	self systemNavigation browseAllSendersOf: ref! !

!RubSmalltalkEditor methodsFor: 'new selection' stamp: 'AlainPlantec 3/22/2013 11:08'!
selectPrecedingIdentifier
	"Invisibly select the identifier that ends at the end of the selection, if any."

	| string sep stop tok |
	tok := false.
	string := self string.
	stop := self stopIndex - 1.
	[stop > 0 and: [(string at: stop) isSeparator]] whileTrue: [stop := stop - 1].
	sep := stop.
	[sep > 0 and: [(string at: sep) tokenish]] whileTrue: [tok := true. sep := sep - 1].
	tok ifTrue: [self selectInvisiblyFrom: sep + 1 to: stop]! !

!RubSmalltalkEditor methodsFor: 'basic-completion' stamp: 'AlainPlantec 5/7/2013 09:50'!
selectorChooserChosenSelector: aSelector
	| newStart replacement caret prevSelection |
	self selectorChooserClose.
	aSelector ifNil: [ ^ self ].
	self selectPrecedingIdentifier.
	prevSelection := textArea selection.
	newStart := self startIndex.
	caret := self stopIndex.
	replacement := String
		streamContents: [ :strm | 
			| kwds |
			1 to: (kwds := aSelector keywords) size do: [ :i | 
				strm nextPutAll: (kwds at: i).
				i = 1
					ifTrue: [ caret := newStart + strm contents size + 1 ].
				strm
					nextPutAll:
						(i < kwds size
							ifTrue: [ '  ' ]
							ifFalse: [ ' ' ]) ] ].
	prevSelection asString = replacement trimBoth
		ifTrue: [ textArea flash ]
		ifFalse: [ 
			self replaceSelectionWith: replacement.
			self selectFrom: caret to: caret - 1 ]! !

!RubSmalltalkEditor methodsFor: 'private' stamp: 'AlainPlantec 5/7/2013 09:50'!
completionAround:  aBlock  keyStroke: anEvent
	"I'm a editor for Smalltalk, so, ok do completion around"
	Smalltalk tools codeCompletionAround: aBlock textMorph: textArea keyStroke: anEvent! !

!RubSmalltalkEditor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 3/22/2013 11:08'!
displayIfTrue: aKeyboardEvent
	"Replace the current text selection with the text 'ifTrue:'--initiated by 
	ctrl-t."

	self addString: 'ifTrue:'.
	^false! !

!RubSmalltalkEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 5/7/2013 09:50'!
prettyPrint
	"Reformat the contents of the receiver's view (a Browser)."

	| selectedClass newText |
	self model selectedMessageName ifNil: [^ textArea flash].
	selectedClass := self modelCurrentSelectedClass.
	newText := selectedClass compilerClass new
		format: self text
		in: selectedClass
		notifying: self.
	newText ifNotNil:
		[ self selectInvisiblyFrom: 1 to: self paragraph text size.
		self replaceSelectionWith: (newText asText makeSelectorBoldIn: selectedClass).
		self selectAt: 1]! !

!RubSmalltalkEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 4/18/2013 11:48'!
internalCallToImplementorsOf: aSelector
	"Open an implementors browser on the given selector"
	
	 (self model systemNavigation allImplementorsOf: aSelector) isEmpty
				ifFalse: [ self model systemNavigation browseAllImplementorsOf: aSelector]
			
	! !

!RubSmalltalkEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 5/6/2013 23:44'!
implementorsOfIt: aKeyboardEvent
	"Triggered by Cmd-m; browse implementors of the selector represented by the current selection, if plausible. 2/1/96 sw"

	self currentUser canBrowse ifFalse: [ ^ false ].
	self implementorsOfIt.
	^ true! !

!RubSmalltalkEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 5/6/2013 23:44'!
save: aKeyboardEvent
	"Submit the current text.  Equivalent to 'accept' 1/18/96 sw"

	self currentUser canEvaluateCode ifFalse: [ ^ false ].
	self closeTypeIn.
	self accept.
	^ true! !

!RubSmalltalkEditor methodsFor: 'do-its' stamp: 'AlainPlantec 3/22/2013 11:08'!
selectionForDoitAsStream
	"Answer a ReadStream on the text in the paragraph that is currently
	selected. "
	^ ReadWriteStream
		on: self string
		from: self startIndex 
		to: self stopIndex - 1! !

!RubSmalltalkEditor methodsFor: 'menu messages' stamp: 'AndreiChis 11/12/2014 11:56'!
sendersOf: selectedSelector
	" opens a Browser on the given selector"
	self model systemNavigation browseAllSendersOf: selectedSelector! !

!RubSmalltalkEditor methodsFor: 'do-its' stamp: 'AndreiChis 1/14/2015 13:12'!
tallySelection
	"Treat the current selection as an expression; evaluate and tally it."

	self lineSelectAndEmptyCheck: [ ^ self ].
	self lineSelectAndEmptyCheck: [ ^ self ].
	self tally: self selectionAsStream
	
! !

!RubSmalltalkEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 5/7/2013 09:50'!
internalCallToImplementorsOfIt
	"Open an implementors browser on the selected selector"

	| aSelector |
	self lineSelectAndEmptyCheck: [^ self].
	(aSelector := self selectedSelector) == nil ifTrue: [^ textArea flash].
	self internalCallToImplementorsOf: aSelector.
			
	! !

!RubSmalltalkEditor methodsFor: 'private' stamp: 'AlainPlantec 4/5/2013 10:13'!
focusChanged
	super focusChanged.
	self selectorChooserFocusChange ! !

!RubSmalltalkEditor methodsFor: 'accessing' stamp: 'TudorGirba 7/23/2014 11:52'!
selectionPosition: aString

	| startIndex |
	startIndex := self startIndex.
	^[
		| bottomLeft topLeft index |
		index := startIndex - aString size.
		self selectInvisiblyFrom: index to: index - 1.
		bottomLeft := textArea cursor bottomLeft.
		topLeft := textArea owner positionInWorld.
		topLeft + bottomLeft ]
			ensure: [ self selectInvisiblyFrom: startIndex to: startIndex - 1 ]! !

!RubSmalltalkEditor methodsFor: 'do-its' stamp: 'AlainPlantec 5/6/2013 23:43'!
doIt
	"Set the context to include pool vars of the model.  Then evaluate."
	self currentUser canEvaluateCode ifFalse: [ ^ false ].
	^ self evaluateSelection! !

!RubSmalltalkEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 5/6/2013 23:43'!
browseIt: t1 
	self currentUser canBrowse
		ifFalse: [^ false].
	self browseIt.
	^ true! !

!RubSmalltalkEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 4/18/2013 11:46'!
classCommentsContainingIt
	"Open a browser class comments which contain the current selection somewhere in them."

	self lineSelectAndEmptyCheck: [^ self].
	self model systemNavigation  browseClassCommentsWithString: self selection string matchCase: false. ! !

!RubSmalltalkEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 4/18/2013 11:48'!
methodNamesContainingIt
	"Open a browser on methods names containing the selected string"

	self lineSelectAndEmptyCheck: [ ^ self ].
	Cursor wait showWhile: [ 
		self model systemNavigation  browseMethodsWhoseNamesContain: self selection string trimBoth ]
	! !

!RubSmalltalkEditor methodsFor: 'do-its' stamp: 'AlainPlantec 3/22/2013 11:08'!
selectionString
	"remove the initial and final quote marks, if present"
	"'''h''' withoutWrappingDoubleQuotes"
	| quote selection  |
	selection :=  self selection string trimBoth .
	selection size < 2 ifTrue: [ ^ selection ].
	quote := selection first.
	^ quote = $"
		ifTrue: [ selection copyFrom: 2 to: selection size - 1 ]
		ifFalse: [ selection ].! !

!RubSmalltalkEditor methodsFor: 'do-its' stamp: 'EstebanLorenzano 3/20/2015 16:53'!
basicInspectIt
	self evaluateSelectionAndDo: [:result | result basicInspect]! !

!RubSmalltalkEditor class methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:24'!
compilerFor: aClass
	^ (aClass respondsTo: #compiler) 
		ifTrue: [aClass compiler]
		ifFalse: [ aClass class evaluatorClass new ]! !

!RubSmalltalkEditor class methodsFor: 'keymapping' stamp: 'TudorGirba 7/18/2014 16:14'!
buildPatchShortcutsForDoItInWindowsOn: aBuilder
	"this is because for some reason Ctrl+d means Ctrl+end on Windows"
	<keymap>
	(aBuilder shortcut: #doItPatchForWindows) 
		category: RubSmalltalkEditor name
		default: Character end ctrl win
		do: [ :target | target editor doIt: nil ]
		description: 'Do it'.
	
	(aBuilder shortcut: #debugItPatchForWindows) 
		category: RubSmalltalkEditor name
		default: Character end shift ctrl win
		do: [ :target | target editor debugIt: nil ]
		description: 'Debug it'! !

!RubSmalltalkEditor class methodsFor: 'keymapping' stamp: 'TudorGirba 7/2/2014 13:47'!
buildShortcutsOn: aBuilder
	"We are defining the bindings twice because we want to support 
	both Cmd and Ctrl for Windows and Linux. This should happen at least as long as in the development environment
	both of these are supported.
	
	We list both variations explicitly because we want to be able to see the action code when inspecting the morph.
	"
	<keymap>

	
	(aBuilder shortcut: #browseIt) 
		category: RubSmalltalkEditor name
		default: $b ctrl
		do: [ :target | target editor browseIt: nil ]
		description: 'Browse'.
	(aBuilder shortcut: #browseItCommand) 
		category: RubSmalltalkEditor name
		default: $b command
		do: [ :target | target editor browseIt: nil ]
		description: 'Browse'.

	(aBuilder shortcut: #doIt) 
		category: RubSmalltalkEditor name
		default: $d ctrl
		do: [ :target | target editor doIt: nil ]
		description: 'Do it'.
	(aBuilder shortcut: #doItCommand) 
		category: RubSmalltalkEditor name
		default: $d command
		do: [ :target | target editor doIt: nil ]
		description: 'Do it'.

	(aBuilder shortcut: #inspectIt) 
		category: RubSmalltalkEditor name
		default: $i ctrl
		do: [ :target | target editor inspectIt: nil ]
		description: 'Inspect it'.
	(aBuilder shortcut: #inspectItCommand) 
		category: RubSmalltalkEditor name
		default: $i command 
		do: [ :target | target editor inspectIt: nil ]
		description: 'Inspect it'.

	(aBuilder shortcut: #implementorsOfIt) 
		category: RubSmalltalkEditor name
		default: $m ctrl
		do: [ :target | target editor implementorsOfIt: nil ]
		description: 'Implementors of it'.
	(aBuilder shortcut: #implementorsOfItCommand) 
		category: RubSmalltalkEditor name
		default: $m command
		do: [ :target | target editor implementorsOfIt: nil ]
		description: 'Implementors of it'.

	(aBuilder shortcut: #senderOfIt) 
		category: RubSmalltalkEditor name
		default: $n ctrl
		do: [ :target | target editor sendersOfIt: nil ]
		description: 'Senders of it'.
	(aBuilder shortcut: #senderOfItCommand) 
		category: RubSmalltalkEditor name
		default: $n command
		do: [ :target | target editor sendersOfIt: nil ]
		description: 'Senders of it'.

	(aBuilder shortcut: #printIt) 
		category: RubSmalltalkEditor name
		default: $p ctrl
		do: [ :target | target editor printIt ]
		description: 'Print it'.
	(aBuilder shortcut: #printItCommand) 
		category: RubSmalltalkEditor name
		default: $p command
		do: [ :target | target editor printIt ]
		description: 'Print it'.

	(aBuilder shortcut: #debugIt) 
		category: RubSmalltalkEditor name
		default: $d shift ctrl
		do: [ :target | target editor debugIt: nil ]
		description: 'Debug it'.
	(aBuilder shortcut: #debugItCommand) 
		category: RubSmalltalkEditor name
		default: $d shift command
		do: [ :target | target editor debugIt: nil ]
		description: 'Debug it'.

	(aBuilder shortcut: #referencesToIt) 
		category: RubSmalltalkEditor name
		default: $n shift ctrl
		do: [ :target | target editor referencesToIt: nil ]
		description: 'References to it'.
	(aBuilder shortcut: #referencesToItCommand) 
		category: RubSmalltalkEditor name
		default: $n shift command
		do: [ :target | target editor referencesToIt: nil ]
		description: 'References to it'.

	(aBuilder shortcut: #methodStringsContainingIt) 
		category: RubSmalltalkEditor name
		default: $e shift ctrl | $e shift command mac
		do: [ :target | target editor methodStringsContainingIt: nil ]
		description: 'Method strings containing it'.	
	(aBuilder shortcut: #methodStringsContainingItCommand) 
		category: RubSmalltalkEditor name
		default: $e shift command
		do: [ :target | target editor methodStringsContainingIt: nil ]
		description: 'Method strings containing it'

! !

!RubSmalltalkEditorModel methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 09:37'!
selectedClassOrMetaClass
	^ nil! !

!RubSmalltalkEditorModel methodsFor: 'shout' stamp: 'AlainPlantec 8/1/2013 19:56'!
shoutAboutToStyle: aSmalltalkEditingMode
	^ client ifNil: [ true ] ifNotNil: [ client shoutAboutToStyle: aSmalltalkEditingMode ]! !

!RubSmalltalkEditorModel methodsFor: 'accessing' stamp: 'AlainPlantec 8/1/2013 19:56'!
client: anObject 	
	client := anObject! !

!RubSmalltalkMethodEditorModel methodsFor: 'view creating' stamp: 'AlainPlantec 8/2/2013 09:33'!
newScrolledText
	^ super newScrolledText beForSmalltalkCode! !

!RubSmalltalkScriptEditorModel methodsFor: 'shout' stamp: 'AlainPlantec 8/2/2013 09:32'!
hasBindingThatBeginsWith: aString 
	^ client ifNil: [ false ] ifNotNil:  [ client hasBindingThatBeginsWith: aString  ]! !

!RubSmalltalkScriptEditorModel methodsFor: 'shout' stamp: 'AlainPlantec 8/2/2013 09:32'!
hasBindingOf: aString 
	^ client ifNil: [ false ] ifNotNil:  [ client hasBindingOf: aString  ]! !

!RubSmalltalkScriptEditorModel methodsFor: 'view creating' stamp: 'AlainPlantec 8/2/2013 09:32'!
newScrolledText
	^ super newScrolledText beForSmalltalkScripting! !

!RubSmalltalkScriptingMode methodsFor: 'initialize-release' stamp: 'AlainPlantec 3/17/2014 13:10'!
updateTextAreaWhenPlugged
	super updateTextAreaWhenPlugged.
	self textArea shoutStyler beForSmalltalkScripting! !

!RubSmalltalkScriptingMode class methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2014 13:19'!
label
	^ 'Smalltalk script'! !

!RubSmalltalkScriptingMode class methodsFor: 'menu' stamp: 'AlainPlantec 3/17/2014 13:19'!
editingModeMenuOn: aBuilder
	"Specify the menu used to select an editing mode"

	<contextMenu>
	<RubEditingModeMenu>
	(aBuilder item: self label translated)
		action: [:model | model textArea editingMode: self new]! !

!RubSurfaceSelectionShape methodsFor: 'accessing' stamp: 'AlainPlantec 5/15/2013 00:13'!
backgroundColor
	^ color! !

!RubSurfaceSelectionShape methodsFor: 'drawing' stamp: 'AlainPlantec 5/15/2013 09:04'!
bounds
	^ self polygon bounds! !

!RubSurfaceSelectionShape methodsFor: 'drawing' stamp: 'AlainPlantec 5/21/2013 15:36'!
drawOn: aCanvas 
	aCanvas drawPolygon: self vertices color: self backgroundColor borderWidth: borderWidth borderColor:  borderColor! !

!RubSurfaceSelectionShape methodsFor: 'accessing' stamp: 'AlainPlantec 5/15/2013 09:09'!
lastIndex
	^ lastIndex! !

!RubSurfaceSelectionShape methodsFor: 'drawing' stamp: 'AlainPlantec 5/15/2013 09:04'!
polygon
	^ Polygon vertices: self vertices! !

!RubSurfaceSelectionShape methodsFor: 'accessing' stamp: 'AlainPlantec 5/21/2013 15:57'!
borderColor
	^ borderColor! !

!RubSurfaceSelectionShape methodsFor: 'drawing' stamp: 'AlainPlantec 5/21/2013 15:07'!
vertices
	^ vertices! !

!RubSurfaceSelectionShape methodsFor: 'accessing' stamp: 'AlainPlantec 5/21/2013 15:56'!
borderWidth
	^ borderWidth! !

!RubSurfaceSelectionShape methodsFor: 'initialize-release' stamp: 'AlainPlantec 5/21/2013 15:43'!
vertices: aCollectionOfPoints firstIndex: firstCharIndex lastIndex: lastCharIndex color: aColor borderWidth: aBorderWidth borderColor: aBorderColor
	firstIndex := firstCharIndex.
	lastIndex := lastCharIndex.
	vertices := aCollectionOfPoints.
	color := aColor.
	borderWidth := aBorderWidth.
	borderColor := aBorderColor! !

!RubSurfaceSelectionShape methodsFor: 'drawing' stamp: 'AlainPlantec 2/26/2015 19:45'!
drawOnAthensCanvas: aCanvas
	| path |
	path := aCanvas
		createPath: [ :builder | 
			builder
				absolute;
				moveTo: self vertices first.
			self vertices allButFirstDo: [ :pt | builder lineTo: pt ].
			builder close ].
	aCanvas setShape: path.
	aCanvas setPaint: self backgroundColor.
	aCanvas draw.
	borderWidth > 0
		ifTrue: [ 
			(aCanvas setStrokePaint: borderColor)
				capSquare;
				width: borderWidth.
			aCanvas draw ]! !

!RubSurfaceSelectionShape methodsFor: 'accessing' stamp: 'AlainPlantec 5/21/2013 15:08'!
firstIndex
	^ firstIndex ! !

!RubSurfaceSelectionShape class methodsFor: 'instance creation' stamp: 'AlainPlantec 5/21/2013 15:29'!
vertices: aCollectionOfPoints firstIndex: firstCharBlock lastIndex: lastCharBlock color: aColor borderWidth: aBorderWidth borderColor: aBorderColor
	^ self new
		vertices: aCollectionOfPoints
		firstIndex: firstCharBlock
		lastIndex: lastCharBlock
		color: aColor
		borderWidth: aBorderWidth
		borderColor: aBorderColor
! !

!RubTextAccepted methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:34'!
text 
	^ morph textArea text! !

!RubTextAreaExamples commentStamp: '<historical>'!
RubTextAreaExamples blueTextOnGrayBacgroundNotWrapped.
RubTextAreaExamples blueTextOnGrayBacgroundWrappedTo400.
RubTextAreaExamples blueTextOnGrayBacgroundWrappedTo400Version2.
RubTextAreaExamples profileSourcesFileViewing.
RubTextAreaExamples rightFlushed.
RubTextAreaExamples shoutedScriptingTextArea.
RubTextAreaExamples simplestEmptyNotWrapped.
RubTextAreaExamples simplestEmptyWrappedTo400.
RubTextAreaExamples simplestWrappedTo400.
RubTextAreaExamples smalltalkCodeWrappedTo400.
RubTextAreaExamples sourceCodeTemplateWrappedTo400.
RubTextAreaExamples smalltalkCodeWrappedWithUnderlineSegments.
RubTextAreaExamples textFieldWithCRAction.
RubTextAreaExamples withOnlyThePrimarySelection.
RubTextAreaExamples wrappedTo400WithMarginsOf40.!
!RubTextAreaExamples class methodsFor: 'examples' stamp: 'AlainPlantec 5/17/2013 21:30'!
rightFlushed
	"self rightFlushed"

	RubEditingArea new
		beWrapped;
		width: 300;
		updateTextWith: 'AAAAAA' , Character cr asString , 'BBBB';
		selectAll;
		rightFlush;
		deselect;
		openInWorld! !

!RubTextAreaExamples class methodsFor: 'examples' stamp: 'AlainPlantec 5/17/2013 21:29'!
blueTextOnGrayBacgroundNotWrapped
	"self blueTextOnGrayBacgroundNotWrapped"

	RubEditingArea new
		backgroundColor: Color lightGray;
		updateTextWith: self smallLoremIpsum;
		textColor: Color blue;
		beNotWrapped; 
		width: 400;
		openInWorld! !

!RubTextAreaExamples class methodsFor: 'examples' stamp: 'AlainPlantec 5/17/2013 21:30'!
smallLoremIpsumWrappedTo400
	"self smallLoremIpsumWrappedTo400"

	RubEditingArea new
		beWrapped;
		width: 400;
		updateTextWith: self smallLoremIpsum;
		openInWorld! !

!RubTextAreaExamples class methodsFor: 'examples' stamp: 'AlainPlantec 5/17/2013 22:39'!
sourceCodeTemplateWrappedTo400
	"self sourceCodeTemplateWrappedTo400"
	ModelForShout := self.
	RubEditingArea new
		model: self ;
		beForSmalltalkCode;
		beWrapped;
		width: 400;
		updateTextWith: self sourceCodeTemplate;
		openInWorld! !

!RubTextAreaExamples class methodsFor: 'shout' stamp: 'AlainPlantec 4/24/2013 03:30'!
hasBindingOf: aString
	^ (self bindingOf: aString) notNil
	! !

!RubTextAreaExamples class methodsFor: 'examples' stamp: 'AlainPlantec 2/5/2014 16:23'!
presentationInput
	"
	
	self presentationInput.
	
	Thanks to Tudor Girba aka Doru
	Then Shift+Tab makes the editing area appear at the center of the screen.
	Useful to input explanations during a presentation 
	"

	KMRepository reset.
	KMRepository default
		setAsGlobalCategory:
			((KMCategory named: 'Presentation')
				addKeymapEntry:
					(KMKeymap
						shortcut: Character tab shift
						action: [ 
							RubEditingArea new
								beWrapped;
								width: World width / 3;
								updateTextWith: '';
								takeKeyboardFocus;
								backgroundColor: Color paleYellow;
								cellInset: 50;
								onAnnouncement: MorphLostFocus do: [ :ann | ann morph delete ];
								font: (LogicalFont familyName: 'Source Sans Pro' pointSize: 20);
								openCenteredInWorld ]))! !

!RubTextAreaExamples class methodsFor: 'examples' stamp: 'AlainPlantec 11/24/2013 23:22'!
blueTextOnGrayBacgroundWrappedTo400Version2
	"self blueTextOnGrayBacgroundWrappedTo400Version2"

	RubEditingArea new
		beWrapped;
		width: 400;
		updateTextWith: ((Text fromString: self smallLoremIpsum) addAttribute: (TextColor color: Color blue));
		backgroundColor: Color lightGray;
		openInWorld! !

!RubTextAreaExamples class methodsFor: 'examples' stamp: 'AlainPlantec 5/17/2013 21:30'!
profileSourcesFileViewing
	"The big test to check that a TextArea is able to compose and ''quickly'' show
	 a big file content "

	"self profileSourcesFileViewing"

	self
		show: 'Wait a moment, the sources file is huge' translated
		while: [ 
			TimeProfiler
				spyAllOn: [ 
					(RubEditingArea new
						beWrapped;
						width: 600;
						updateTextWith: (FileStream readOnlyFileNamed: Smalltalk sourcesFile basename) contents) openInWorld ] ]! !

!RubTextAreaExamples class methodsFor: 'NOcompletion' stamp: 'AlainPlantec 4/26/2013 01:11'!
isCodeCompletionAllowed

	^ true.! !

!RubTextAreaExamples class methodsFor: 'NOcompletion' stamp: 'AlainPlantec 4/26/2013 01:16'!
selectedClassOrMetaClass
	^ ModelForShout class! !

!RubTextAreaExamples class methodsFor: 'examples' stamp: 'AlainPlantec 6/6/2013 14:58'!
smalltalkCodeWrappedWithSegments
	"self smalltalkCodeWrappedWithSegments"

	| area s |
	area := self smalltalkCodeWrappedTo400.
	area addSegment: (RubUnderlinedSegmentMorph inTextArea: area from: 1 to: 29).
	s := RubUnderlinedSegmentMorph inTextArea: area from: 43 to: 57.
	s straight: false.
	area addSegment: s.
	area addSegment: (s := RubUnderlinedSegmentMorph inTextArea: area from: 81 to: 185).
	s color: (Color blue alpha: 0.02).
	s borderColor: Color blue.
	s underlineColor: Color blue.
	area addSegment: (s := RubPlainSegmentMorph inTextArea: area from: 300 to: 500).
	s color: (Color yellow).
	s borderColor: (Color orange alpha: 0.5).
	s beSmoothCurve.
	s balloonColor: Color yellow.
	s setCenteredBalloonText: 'Please note this deferred execution'.
	area openInWorld! !

!RubTextAreaExamples class methodsFor: 'examples' stamp: 'AlainPlantec 6/6/2013 15:11'!
smalltalkCodeWithStabilo
	"self smalltalkCodeWithStabilo"
	| area seg code |
	area := RubEditingArea new
		beWrapped;
		width: 400;
		updateTextWith: (code := self someSmallSmalltalkCode).
	area addSegment: (seg := RubPlainSegmentMorph inTextArea: area from: 3 to: code size).
	seg color: (Color yellow).
	seg borderColor: (Color orange alpha: 0.5).
	seg beSmoothCurve.
	area openInWorld! !

!RubTextAreaExamples class methodsFor: 'examples' stamp: 'AlainPlantec 2/5/2014 15:01'!
textAreaWithBiggerFont
	" self textAreaWithBiggerFont "

	RubEditingArea new
		beWrapped;
		width: 400;
		updateTextWith: 'test';
		takeKeyboardFocus;
		onAnnouncement: MorphLostFocus do: [ :ann | ann morph delete ];
		font: (LogicalFont familyName: 'Source Sans Pro' pointSize: 20);
		openCenteredInWorld! !

!RubTextAreaExamples class methodsFor: 'shout' stamp: 'AlainPlantec 4/24/2013 03:34'!
shoutAboutToStyle: aStyler
	aStyler classOrMetaClass: ModelForShout.
	^ true! !

!RubTextAreaExamples class methodsFor: 'accessing' stamp: 'AlainPlantec 4/24/2013 03:13'!
someSmalltalkCode
	^ self class sourceCodeAt: #show:while:! !

!RubTextAreaExamples class methodsFor: 'shout' stamp: 'AlainPlantec 4/24/2013 03:31'!
hasBindingThatBeginsWith: aString
	^false! !

!RubTextAreaExamples class methodsFor: 'examples' stamp: 'AlainPlantec 6/6/2013 15:04'!
someSmallSmalltalkCode.
	^ '
WorldState
	addDeferredUIMessage: [ 
		World displayWorldSafely.
		Cursor wait
			showWhile: [ 
				aBlock
					ensure: [ m delete ] ] ]'! !

!RubTextAreaExamples class methodsFor: 'examples' stamp: 'AlainPlantec 5/22/2013 23:27'!
centered
	"self centered"

	RubEditingArea new
		beWrapped;
		width: 300;
		updateTextWith: 'AAAAAA' , Character cr asString , 'BBBB';
		selectAll;
		centered;
		deselect;
		openInWorld! !

!RubTextAreaExamples class methodsFor: 'accessing' stamp: 'AlainPlantec 5/14/2013 11:37'!
smallLoremIpsum
	^'Lorem ipsum dolor sit amet, consectetur adipiscing elit. Integer nec odio. Praesent libero. Sed cursus ante dapibus diam. Sed nisi. Nulla quis sem at nibh elementum imperdiet. Duis sagittis ipsum. Praesent mauris. Fusce nec tellus sed augue semper porta. Mauris massa. Vestibulum lacinia arcu eget nulla. Class aptent taciti sociosqu ad litora torquent per conubia nostra, per inceptos himenaeos. '! !

!RubTextAreaExamples class methodsFor: 'examples' stamp: 'AlainPlantec 5/22/2013 09:32'!
smalltalkCodeWrappedTo400
	"self smalltalkCodeWrappedTo400"
	| area |
	ModelForShout := self.
	area := RubEditingArea new
		beWrapped;
		model: self;
		width: 400;
		beForSmalltalkCode;
		updateTextWith: self someSmalltalkCode.
	area openInWorld.
	^ area! !

!RubTextAreaExamples class methodsFor: 'examples' stamp: 'AlainPlantec 5/17/2013 21:30'!
simplestEmptyWrappedTo400
	"self simplestEmptyWrappedTo400"

	RubEditingArea new
		beWrapped;
		width: 400;
		openInWorld! !

!RubTextAreaExamples class methodsFor: 'examples' stamp: 'AlainPlantec 5/10/2013 07:35'!
textFieldWithCRAction
	"self textFieldWithCRAction"

	| s |
	s := RubTextFieldArea new
		width: 800;
		setTextWith: 'My contents will be printed in the Transcript when return is entered';
		openInWorld.
	s announcer subscribe: RubReturnEntered send: #value to:  [ Transcript show: s text asString ]! !

!RubTextAreaExamples class methodsFor: 'examples' stamp: 'AlainPlantec 5/17/2013 21:30'!
simplestEmptyNotWrapped
	"self simplestEmptyNotWrapped"

	RubEditingArea new
		beNotWrapped;
		openInWorld! !

!RubTextAreaExamples class methodsFor: 'examples' stamp: 'AlainPlantec 8/2/2013 09:07'!
shoutedScriptingTextArea
	"self shoutedScriptingTextArea" 

	ModelForShout := nil.
	RubEditingArea new
		beWrapped;
		model: self;
		beForSmalltalkScripting;
		width: 500;
		updateTextWith: self someSmalltalkScript;
		openInWorld! !

!RubTextAreaExamples class methodsFor: 'examples' stamp: 'AlainPlantec 5/21/2013 22:01'!
simplestWrappedTo400
	"self simplestWrappedTo400"

	RubEditingArea new
		beWrapped;
		width: 400;
		updateTextWith: self smallLoremIpsum;
		openInWorld! !

!RubTextAreaExamples class methodsFor: 'examples' stamp: 'AlainPlantec 6/20/2013 09:38'!
autoReactingText
	"self autoReactingText"

	| area seg blk |
	area := RubEditingArea new
		beWrapped;
		withoutSelectionBar.
	area setTextWith: 'Click or keep the mouse down on [0]'.
	area width: 400.
	seg := RubPlainSegmentMorph inTextArea: area from: 34 to: 35.
	blk := [ seg replaceTextWith: (seg getText string asNumber + 1) asString ].
	seg on: #mouseDown send: #value to: blk.
	seg on: #mouseStillDown send: #value to: blk.
	seg beExtendable.
	area addSegment: seg.
	area openInWorld! !

!RubTextAreaExamples class methodsFor: 'private' stamp: 'AlainPlantec 5/17/2013 21:30'!
show: aMessage while: aBlock
	| m |
	m := RubEditingArea new
		backgroundColor: Color black;
		textColor: Color white;
		beReadOnly;
		beWrapped;
		width: 300;
		setTextWith: aMessage;
		fontPointSize: 18;
		selectAll;
		centered;
		deselect;
		yourself.
	m
		openInWorld;
		centered.
	WorldState
		addDeferredUIMessage: [ 
			World displayWorldSafely.
			Cursor wait
				showWhile: [ 
					aBlock
						ensure: [ m delete ] ] ]! !

!RubTextAreaExamples class methodsFor: 'examples' stamp: 'AlainPlantec 6/2/2013 23:09'!
withOnlyThePrimarySelection
	"self withOnlyThePrimarySelection"

	ModelForShout := nil.
	RubEditingArea new
		beWrapped;
		width: 400;
		model: self;
		withoutAnyDecorator;
		updateTextWith: self smallLoremIpsum;
		openInWorld.
		
! !

!RubTextAreaExamples class methodsFor: 'examples' stamp: 'AlainPlantec 5/17/2013 21:30'!
wrappedTo400WithMarginsOf40
	"self wrappedTo400WithMarginsOf40"

	RubEditingArea new
		beWrapped;
		width: 400;
		updateMarginsWith: (40@40 corner: 40@40);
		updateTextWith: self smallLoremIpsum;
		openInWorld! !

!RubTextAreaExamples class methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 10:07'!
someSmalltalkScript
	^ '" Enter some code here as in a workspace"' , String cr , 'RubTextArea new
		beWrapped;
		smalltalkScriptingModel: self;
		width: 500;
		setTextWith: ''" Enter some code here as in a workspace"'';
		openInWorld'! !

!RubTextAreaExamples class methodsFor: 'examples' stamp: 'AlainPlantec 5/14/2013 23:20'!
simplestEmptyTextField
	"self simplestEmptyTextField"

	RubTextFieldArea new
		openInWorld! !

!RubTextAreaExamples class methodsFor: 'examples' stamp: 'AlainPlantec 5/18/2013 00:13'!
blueTextOnGrayBacgroundWrappedTo400
	"self blueTextOnGrayBacgroundWrappedTo400"

	RubEditingArea new
		beWrapped;
		width: 400;
		updateTextWith: self smallLoremIpsum;
		backgroundColor: Color lightGray;
		textColor: Color blue;
		openInWorld! !

!RubTextChanged methodsFor: 'accessing' stamp: 'AlainPlantec 4/16/2013 15:58'!
start
	^ start! !

!RubTextChanged methodsFor: 'accessing' stamp: 'Alainplantec 10/1/2013 10:55'!
from: startIndex to: stopIndex with: aText
	self start: startIndex.
	self stop: stopIndex.
	self text: aText! !

!RubTextChanged methodsFor: 'accessing' stamp: 'AlainPlantec 4/16/2013 15:58'!
start: anInteger
	start := anInteger! !

!RubTextChanged methodsFor: 'accessing' stamp: 'AlainPlantec 4/16/2013 15:58'!
stop
	^ stop! !

!RubTextChanged methodsFor: 'accessing' stamp: 'AlainPlantec 4/16/2013 15:58'!
stop: anInteger
	stop := anInteger! !

!RubTextChanged methodsFor: 'accessing' stamp: 'AlainPlantec 4/16/2013 15:58'!
text: aText
	text := aText! !

!RubTextChanged methodsFor: 'accessing' stamp: 'AlainPlantec 4/16/2013 15:58'!
text
	^ text! !

!RubTextChanged class methodsFor: 'instance creation' stamp: 'AlainPlantec 4/16/2013 15:56'!
from: start to: stop with: aText
	^ self new from: start to: stop with: aText! !

!RubTextClassLink commentStamp: 'AndreiChis 11/12/2014 12:02'!
An active link in a text linking to a class!
!RubTextClassLink methodsFor: 'accessing' stamp: 'AndreiChis 11/12/2014 11:37'!
className: aStringOrSymbol
	className := aStringOrSymbol asSymbol! !

!RubTextClassLink methodsFor: 'system primitives' stamp: 'AndreiChis 11/12/2014 11:37'!
className	
	^ className! !

!RubTextClassLink methodsFor: 'evaluating' stamp: 'AndreiChis 11/12/2014 11:39'!
actOnClick: anEvent for: target in: aParagraph editor: anEditor
	anEvent shiftPressed
		ifFalse: [ anEditor editor browseClassFrom: self className ]
		ifTrue: [ anEditor editor referencesTo: self className ].
	^ true! !

!RubTextClassLink class methodsFor: 'instance creation' stamp: 'AndreiChis 11/12/2014 11:37'!
className: aSymbol
	^ self new
		className: aSymbol;
		yourself! !

!RubTextClassLink class methodsFor: 'instance creation' stamp: 'AndreiChis 11/12/2014 11:37'!
class: aClass
	^ self className: aClass name! !

!RubTextComposer methodsFor: 'private composition' stamp: 'AlainPlantec 3/24/2013 08:05'!
composeEachRectangleIn: rectangles

	| myLine lastChar |

	1 to: rectangles size do: [:i | 
		currCharIndex <= theText size ifFalse: [ ^ false ].
		myLine := scanner 
			composeFrom: currCharIndex 
			inRectangle: (rectangles at: i)				
			firstLine: isFirstLine 
			leftSide: i=1 
			rightSide: i=rectangles size.
		myLine actualWidth: scanner rightX - theContainer left.
		
		lines addLast: myLine.
		actualHeight := actualHeight max: myLine lineHeight.  "includes font changes"
		currCharIndex := myLine last + 1.
		
		"This happens if the text is just one line long"
		(myLine last = 0) ifTrue: [ ^ false ].
		
		lastChar := theText at: myLine last.
		(CharacterSet crlf includes: lastChar) ifTrue: [^#cr].
	].
	^false! !

!RubTextComposer methodsFor: 'accessing' stamp: 'AlainPlantec 3/20/2013 11:09'!
container
	^ theContainer! !

!RubTextComposer methodsFor: 'accessing' stamp: 'AlainPlantec 4/25/2013 21:43'!
emphasisHere: aListOfTextAttribute
	emphasisHere := aListOfTextAttribute ! !

!RubTextComposer methodsFor: 'private composition' stamp: 'AlainPlantec 4/2/2013 13:45'!
completeComposition
	numberOfPhysicalLines := 1.
	actualWidth := 1.
	self lines
		do: [ :line | 
			line lineNumber: numberOfPhysicalLines.
			line stopCondition = #cr
				ifTrue: [ numberOfPhysicalLines := numberOfPhysicalLines + 1 ].
			actualWidth := line actualWidth max: actualWidth ]! !

!RubTextComposer methodsFor: 'querying' stamp: 'AlainPlantec 3/20/2013 12:08'!
indentationOfLineIndex: lineIndex ifBlank: aBlock
	"Answer the number of leading tabs in the line at lineIndex.  If there are
	 no visible characters, pass the number of tabs to aBlock and return its value.
	 If the line is word-wrap overflow, back up a line and recur."

	| arrayIndex first last crlf |
	crlf := CharacterSet crlf.
	arrayIndex := lineIndex.
	[first := (self lines at: arrayIndex) first.
	 first > 1 and: [crlf includes: (self text string at: first - 1)]] whileTrue: "word wrap"
		[arrayIndex := arrayIndex - 1].
	last := (self lines at: arrayIndex) last.
	
	^(self text string copyFrom: first to: last) indentationIfBlank: aBlock.
! !

!RubTextComposer methodsFor: 'querying' stamp: 'AlainPlantec 3/20/2013 12:04'!
lineIndexForPoint: aPoint
	"Answer the index of the line in which to select the character nearest to aPoint."
	| i py |
	py := aPoint y truncated.

	"Find the first line at this y-value"
	i := (self fastFindFirstLineSuchThat: [:line | line bottom > py]) min: self lines size.

	"Now find the first line at this x-value"
	[i < self lines size and: [(self lines at: i+1) top = (self lines at: i) top
				and: [aPoint x >= (self lines at: i+1) left]]]
		whileTrue: [i := i + 1].
	^ i! !

!RubTextComposer methodsFor: 'accessing' stamp: 'AlainPlantec 4/25/2013 22:10'!
cursorWidth
	^ cursorWidth! !

!RubTextComposer methodsFor: 'private' stamp: 'AlainPlantec 3/24/2013 07:57'!
slideOneLineDown

	| priorLine |

	"Having detected the end of rippling recoposition, we are only sliding old lines"
	prevIndex < prevLines size ifFalse: [
		"There are no more prevLines to slide."
		^nowSliding := possibleSlide := false
	].

	"Adjust and re-use previously composed line"
	prevIndex := prevIndex + 1.
	priorLine := (prevLines at: prevIndex) slideIndexBy: deltaCharIndex andMoveTopTo: currentY.
	lines addLast: priorLine.
	currentY := priorLine bottom.
	currCharIndex := priorLine last + 1! !

!RubTextComposer methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 08:21'!
lines
	^ lines! !

!RubTextComposer methodsFor: 'private composition' stamp: 'AlainPlantec 5/18/2013 23:17'!
composeLinesFrom: argStart to: argStop delta: argDelta into: argLinesCollection priorLines: argPriorLines atY: argStartY textStyle: argTextStyle text: argText container: argContainer
	theTextStyle := argTextStyle.
	theText := argText.
	theContainer := argContainer.
	self needComposition
		ifFalse: [ ^ self ].
	lines := argLinesCollection.
	deltaCharIndex := argDelta.
	currCharIndex := startCharIndex := argStart.
	stopCharIndex := argStop.
	prevLines := argPriorLines.
	currentY := argStartY.
	defaultLineHeight := 0. "(theTextStyle fontAt: theTextStyle defaultFontIndex) height" "+ theTextStyle leading".
	maxRightX := theContainer left.
	possibleSlide := stopCharIndex < theText size and: [ theContainer isMemberOf: Rectangle ].
	nowSliding := false.
	prevIndex := 1.
	scanner := RubCompositionScanner new text: theText textStyle: theTextStyle.
	isFirstLine := true.
	self composeAllLines.
	isFirstLine
		ifTrue: [ 
			"No space in container or empty text"
			self addNullLineWithIndex: startCharIndex andRectangle: (theContainer topLeft extent: theContainer width @ defaultLineHeight) ]
		ifFalse: [ self fixupLastLineIfCR ].
	prevLines := #()! !

!RubTextComposer methodsFor: 'accessing' stamp: 'AlainPlantec 4/25/2013 22:06'!
cursorWidth: anInteger
	cursorWidth := anInteger! !

!RubTextComposer methodsFor: 'accessing' stamp: 'AlainPlantec 4/25/2013 21:12'!
emphasisHere
	^ emphasisHere ifNil: [ emphasisHere := ' ' asText attributesAt: 1 forStyle: self textStyle ]! !

!RubTextComposer methodsFor: 'accessing' stamp: 'AlainPlantec 3/20/2013 10:57'!
lines: aCollectionOfTextLine
	lines := aCollectionOfTextLine! !

!RubTextComposer methodsFor: 'private composition' stamp: 'AlainPlantec 4/2/2013 17:35'!
composeAllLines
	[ currCharIndex <= theText size and: [ currentY + defaultLineHeight <= theContainer bottom ] ]
		whileTrue: [ 
			(nowSliding
				ifTrue: [ self slideOneLineDown ]
				ifFalse: [ self composeOneLine ]) ifNil: [ ^ nil ] ]! !

!RubTextComposer methodsFor: 'accessing' stamp: 'AlainPlantec 3/30/2013 09:16'!
numberOfPhysicalLines
	^ numberOfPhysicalLines ifNil: [ numberOfPhysicalLines := 0 ]! !

!RubTextComposer methodsFor: 'private composition' stamp: 'AlainPlantec 4/5/2013 21:24'!
recomposeFrom: start to: stop delta: delta
	"Recompose this paragraph. The altered portion is between start and
	stop. Recomposition may continue to the end of the text, due to a
	ripple effect.
	Delta is the amount by which the current text is longer than it was
	when its current lines were composed."

	"Have to recompose line above in case a word-break was affected."

	| startLine newLines |
	self lines ifNil: [ ^self ].
	startLine := (self lineIndexOfCharacterIndex: start) - 1 max: 1.
	[ startLine > 1 and: [ (self lines at: startLine - 1) top = (self lines at: startLine) top ] ]
		whileTrue: [ startLine := startLine - 1 ].	"Find leftmost of line pieces"
	newLines := OrderedCollection new: self lines size + 1.
	1 to: startLine - 1 do: [ :i | newLines addLast: (self lines at: i) ].
	self
		composeLinesFrom: (self lines at: startLine) first
		to: stop
		delta: delta
		into: newLines
		priorLines: self lines
		atY: (self lines at: startLine) top.
! !

!RubTextComposer methodsFor: 'accessing' stamp: 'AlainPlantec 3/20/2013 07:45'!
startCharIndex: anObject
	^ startCharIndex := anObject! !

!RubTextComposer methodsFor: 'testing' stamp: 'AlainPlantec 3/17/2013 15:10'!
checkIfReadyToSlide

	"Check whether we are now in sync with previously composed lines"

	(possibleSlide and: [currCharIndex > stopCharIndex]) ifFalse: [^self].

	[prevIndex < prevLines size
		and: [(prevLines at: prevIndex) first < (currCharIndex - deltaCharIndex)]]
			whileTrue: [prevIndex := prevIndex + 1].

	(prevLines at: prevIndex) first = (currCharIndex - deltaCharIndex) ifTrue: [
		"Yes -- next line will have same start as prior line."
		prevIndex := prevIndex - 1.
		possibleSlide := false.
		nowSliding := true
	] ifFalse: [
		prevIndex = prevLines size ifTrue: [
			"Weve reached the end of prevLines, so no use to keep looking for lines to slide."
			possibleSlide := false
		]
	]! !

!RubTextComposer methodsFor: 'accessing' stamp: 'AlainPlantec 5/18/2013 23:19'!
tabWidth
	^ self textStyle rubTabWidth! !

!RubTextComposer methodsFor: 'public composition' stamp: 'AlainPlantec 5/18/2013 23:17'!
composeLinesFrom: start to: stop delta: delta into: lineColl priorLines: priorLines atY: startingY
	"While the section from start to stop has changed, composition may
	ripple all the way to the end of the text. However in a rectangular
	container, if we ever find a line beginning with the same character as
	before (ie corresponding to delta in the old lines), then we can just
	copy the old lines from there to the end of the container, with
	adjusted indices and y-values"

	self 
		composeLinesFrom: start
		to: stop
		delta: delta
		into: lineColl
		priorLines: priorLines
		atY: startingY
		textStyle: self textStyle
		text: self text
		container: theContainer.
	self completeComposition! !

!RubTextComposer methodsFor: 'accessing' stamp: 'AlainPlantec 3/20/2013 10:58'!
text
	^ theText 
	! !

!RubTextComposer methodsFor: 'accessing' stamp: 'AlainPlantec 3/20/2013 11:33'!
actualWidth
	^ actualWidth! !

!RubTextComposer methodsFor: 'accessing' stamp: 'AlainPlantec 3/20/2013 10:58'!
textStyle
	^ theTextStyle ! !

!RubTextComposer methodsFor: 'querying' stamp: 'AlainPlantec 3/20/2013 12:04'!
fastFindFirstLineSuchThat: lineBlock
	"Perform a binary search of the lines array and return the index
	of the first element for which lineBlock evaluates as true.
	This assumes the condition is one that goes from false to true for
	increasing line numbers (as, eg, yval > somey or start char > somex).
	If lineBlock is not true for any element, return size+1."
	| index low high |
	low := 1.
	high := self lines size.
	[index := high + low // 2.
	low > high]
		whileFalse: 
			[(lineBlock value: (self lines at: index))
				ifTrue: [high := index - 1]
				ifFalse: [low := index + 1]].
	^ low! !

!RubTextComposer methodsFor: 'private composition' stamp: 'AlainPlantec 3/24/2013 08:02'!
composeOneLine
	| rectangles |
	rectangles := theContainer rectanglesAt: currentY height: defaultLineHeight.
	rectangles notEmpty
		ifTrue: [ (self composeAllRectangles: rectangles) ifNil: [ ^ nil ] ]
		ifFalse: [ currentY := currentY + defaultLineHeight ].
	self checkIfReadyToSlide! !

!RubTextComposer methodsFor: 'public composition' stamp: 'AlainPlantec 11/25/2013 09:05'!
replaceFrom: start to: stop with: aText
	"Edit the text, and then recompose the lines."
	self text replaceFrom: start to: stop with: aText.
	self recomposeFrom: start to: start + aText size - 1 delta: aText size - (stop - start + 1).
! !

!RubTextComposer methodsFor: 'private' stamp: 'AlainPlantec 3/20/2013 05:57'!
fixupLastLineIfCR
	"This awful bit is to ensure that if we have scanned all the text and the last character is a CR that there is a null line at the end of lines. Sometimes this was not happening which caused anomalous selections when selecting all the text. This is implemented as a post-composition fixup because I couldn't figure out where to put it in the main logic."

	(theText size > 0 and: [ CharacterSet crlf includes: theText last ])
		ifFalse: [ ^ self ].
	self addNullLineForIndex: theText size + 1! !

!RubTextComposer methodsFor: 'adding' stamp: 'AlainPlantec 5/18/2013 23:16'!
addNullLineWithIndex: index andRectangle: aRectangle
	| nullString nullLine |
	nullString := ' ' asText.
	self emphasisHere do: [ :attr | nullString addAttribute: attr ].
	scanner text: nullString textStyle: theTextStyle.
	nullLine := scanner
		composeFrom: 1
		inRectangle: aRectangle
		firstLine: true
		leftSide: true
		rightSide: false.
	nullLine firstIndex: index lastIndex: index - 1.
	nullLine internalSpaces: 0 paddingWidth: 0.
	nullLine rectangle: ( aRectangle withBottom: nullLine bottom).
	lines addLast: nullLine 
! !

!RubTextComposer methodsFor: 'adding' stamp: 'AlainPlantec 5/7/2013 15:37'!
addNullLineForIndex: index
	"This awful bit is to ensure that if we have scanned all the text and the last character is a CR that there is a null line at the end of lines. Sometimes this was not happening which caused anomalous selections when selecting all the text. This is implemented as a post-composition fixup because I couldn't figure out where to put it in the main logic."

	| oldLastLine r |
	oldLastLine := lines last.
	oldLastLine last - oldLastLine first >= 0
		ifFalse: [ ^ self ].
	oldLastLine last = (index - 1)
		ifFalse: [ ^ self ].
	r := oldLastLine left @ oldLastLine bottom extent: oldLastLine right @ (oldLastLine bottom - oldLastLine top).	
	"Even though we may be below the bottom of the container,
	it is still necessary to compose the last line for consistency..."
	self addNullLineWithIndex: index andRectangle: r! !

!RubTextComposer methodsFor: 'private' stamp: 'AlainPlantec 4/11/2013 16:44'!
moveBy: aPoint
	self lines do: [ :line | line moveBy: aPoint ].
	theContainer := theContainer translateBy: aPoint.
	maxRightX := maxRightX + aPoint x! !

!RubTextComposer methodsFor: 'accessing' stamp: 'AlainPlantec 3/20/2013 11:11'!
container: aRectangle 
	theContainer := aRectangle! !

!RubTextComposer methodsFor: 'accessing' stamp: 'AlainPlantec 3/20/2013 10:57'!
text: aText
	theText := aText
	! !

!RubTextComposer methodsFor: 'accessing' stamp: 'AlainPlantec 3/20/2013 07:45'!
startCharIndex
	^ startCharIndex! !

!RubTextComposer methodsFor: 'accessing' stamp: 'AlainPlantec 3/20/2013 10:58'!
textStyle: aTextStyle 
	theTextStyle := aTextStyle! !

!RubTextComposer methodsFor: 'private composition' stamp: 'AlainPlantec 3/24/2013 08:07'!
composeAllRectangles: rectangles
	| charIndexBeforeLine numberOfLinesBefore |
	actualHeight := defaultLineHeight.
	charIndexBeforeLine := currCharIndex.
	numberOfLinesBefore := lines size.
	self composeEachRectangleIn: rectangles.
	currentY := currentY + actualHeight.
	currentY > theContainer bottom
		ifTrue: [ 
			"Oops -- the line is really too high to fit -- back out"
			currCharIndex := charIndexBeforeLine.
			lines size - numberOfLinesBefore timesRepeat: [ lines removeLast ].
			^ self ].	"It's OK -- the line still fits."
	maxRightX := maxRightX max: scanner rightX.
	1 to: rectangles size - 1 do: [ :i | 
		"Adjust heights across rectangles if necessary"
		(lines at: lines size - rectangles size + i) lineHeight: lines last lineHeight baseline: lines last baseline ].
	isFirstLine := false.
	currCharIndex > theText size
		ifTrue: [ ^ nil	"we are finished composing" ]! !

!RubTextComposer methodsFor: 'accessing' stamp: 'AlainPlantec 3/20/2013 05:35'!
maxRightX
	^ maxRightX! !

!RubTextComposer methodsFor: 'private composition' stamp: 'AlainPlantec 4/25/2013 22:54'!
needComposition
	| ret |
	ret := prevText isNil.
	ret ifFalse: [ret := prevTextStyle ~= theTextStyle].
	ret ifFalse: [ret := prevContainer ~= theContainer].
	ret ifFalse: [ret := prevText string ~= theText string].
	ret ifFalse: [ret := prevText runs ~= theText runs].
	ret ifTrue: [
		prevText := theText copy.
		prevTextStyle := theTextStyle.
		prevContainer := theContainer].
	^ ret! !

!RubTextComposer methodsFor: 'querying' stamp: 'AlainPlantec 4/5/2013 21:24'!
lineIndexOfCharacterIndex: characterIndex 
	"Answer the line index for a given characterIndex."
	^ (self fastFindFirstLineSuchThat: [:line | line first > characterIndex]) - 1 max: 1! !

!RubTextComposer methodsFor: 'public composition' stamp: 'AlainPlantec 4/25/2013 20:07'!
prepareToForceComposition
	prevText := nil! !

!RubTextComposer methodsFor: 'private' stamp: 'AlainPlantec 4/25/2013 10:50'!
unplug
	theText := '' asText.
	lines := #().
	prevText := prevTextStyle := prevContainer := nil.
	super unplug! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 5/7/2013 09:50'!
find
	"Prompt the user for a string to search for, and search the receiver from the current selection onward for it."
	textArea openFindDialog! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 5/7/2013 09:50'!
changeTextFont
	"Present a menu of available fonts, and if one is chosen, apply it to the current selection."

	textArea
		forceCursorVisibleWhile: [ 
			| hadFocus |
			hadFocus := textArea hasFocus.
			textArea
				openModal:
					(FontChooser
						openWithWindowTitle: 'Choose a Font'
						for: self
						setSelector: #applyTextFont:
						getSelector: self fontToUse).
			hadFocus
				ifTrue: [ textArea takeKeyboardFocus ] ]! !

!RubTextEditor methodsFor: 'new selection' stamp: 'AndreiChis 1/12/2015 10:55'!
computeSelectionIntervalForCurrentLine

	^ self encompassParagraph: self selectionInterval! !

!RubTextEditor methodsFor: 'nonediting/nontyping keys' stamp: 'AlainPlantec 5/17/2013 01:20'!
cursorEnd: aKeyboardEvent
	"Private - Move cursor end of current line."

	| string |
	self closeTypeIn.
	string := self string.
	self
		moveCursor: [ :position | string indexOf: Character cr startingAt: position ifAbsent: [ string size + 1 ] ]
		forward: true
		specialBlock: [ :dummy | string size + 1 ]
		event: aKeyboardEvent.
	^ true! !

!RubTextEditor methodsFor: 'nonediting/nontyping keys' stamp: 'AlainPlantec 5/7/2013 09:50'!
escape 
	textArea escapePressed .
	! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 3/22/2013 11:07'!
replaceSelectionWith: aText
	self replace: self selectionInterval with: aText and: []
! !

!RubTextEditor methodsFor: 'typing support' stamp: 'AlainPlantec 3/22/2013 11:08'!
startOfTyping
	^ self editingState startOfTyping  ! !

!RubTextEditor methodsFor: 'typing support' stamp: 'AlainPlantec 3/28/2013 19:38'!
performCmdActionsWith: aKeyboardEvent shifted: aBoolean return: return
	| asciiValue actions action|
	asciiValue := aKeyboardEvent keyValue + 1.
	actions := aBoolean
				ifTrue: [self  shiftCmdActions]
				ifFalse: [self  cmdActions].
	action := (actions at: asciiValue).
	action == #noop: ifTrue: [ ^ false ].
	return value: ( self perform: action with: aKeyboardEvent).! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AndreiChis 1/14/2015 13:10'!
highlightAndEmptyCheck: returnBlock
	| selectionInterval |

	selectionInterval := self getHighlightInterval.
	selectionInterval ifEmpty: [ textArea flash.  ^ returnBlock value ].
	self highlightInterval: selectionInterval! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 4/3/2013 09:56'!
theme
	^ UITheme current! !

!RubTextEditor methodsFor: 'keymapping' stamp: 'TudorGirba 6/22/2014 23:52'!
defaultShiftCommandKeymapping
	"Initialize the shift-command-key (or control-key) shortcut table."

	| cmdMap |
	cmdMap := Array new: 256 withAll: #noop:.	"use temp in case of a crash"
	{(Character home -> #cursorHome:).
	(Character end -> #cursorEnd:).
	(Character backspace -> #forwardDelete:).
	(Character pageUp -> #cursorPageUp:).
	(Character newPage -> #cursorPageDown:).
	(Character cr -> #crWithIndent:).
	(Character escape -> #offerMenuFromEsc:).
	(Character arrowLeft -> #cursorLeft:).
	(Character arrowRight -> #cursorRight:).
	(Character arrowUp -> #cursorUp:).
	(Character arrowDown -> #cursorDown:).
	(Character space -> #selectWord:).
	(Character delete -> #forwardDelete:)}
		do: [ :assoc | 
			| char symbol |
			char := assoc key.
			symbol := assoc value.
			cmdMap at: char asciiValue + 1 put: symbol	"plain keys" ].
	"Note: Command key overrides shift key, so, for example, cmd-shift-9 produces $9 not $("	"({< and double-quote"	"Note: Must use cmd-9 or ctrl-9 to get '()' since cmd-shift-9 is a Mac FKey command."
	'9[,''' do: [ :char | cmdMap at: char asciiValue + 1 put: #shiftEnclose: ].
	^ cmdMap! !

!RubTextEditor methodsFor: 'new selection' stamp: 'AlainPlantec 3/22/2013 11:07'!
afterSelectionInsertAndSelect: aString

	self insertAndSelect: aString at: self stopIndex ! !

!RubTextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 3/22/2013 11:07'!
compareToClipboard: aKeyboardEvent
	"Compare the receiver to the text on the clipboard."

	self compareToClipboard.
	^ true! !

!RubTextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 8/2/2013 14:53'!
cancel: aKeyboardEvent
	"Cancel unsubmitted changes."
	self cancel.
	^ true! !

!RubTextEditor methodsFor: 'keymapping' stamp: 'AlainPlantec 3/28/2013 19:22'!
shiftCmdActions
	^self defaultKeymappingIndex at: #shiftCommand ! !

!RubTextEditor methodsFor: 'private' stamp: 'AlainPlantec 3/22/2013 11:08'!
nullText

	^Text string: '' attributes: self emphasisHere! !

!RubTextEditor methodsFor: 'private' stamp: 'AlainPlantec 4/22/2013 01:19'!
moveCursor: directionBlock forward: forward specialBlock: specialBlock event: aKeyboardEvent
	"Private - Move cursor.
	directionBlock is a one argument Block that computes the new Position from a given one.
	specialBlock is a one argumentBlock that computes the new position from a given one under the alternate semantics.
	Note that directionBlock always is evaluated first."
	| shift indices newPosition |
	shift := aKeyboardEvent shiftPressed.
	indices := self setIndices: shift forward: forward.
	newPosition := directionBlock value: (indices at: #moving).
	(aKeyboardEvent commandKeyPressed or: [ aKeyboardEvent controlKeyPressed ])
		ifTrue: [newPosition := specialBlock value: newPosition].
	shift
		ifTrue: [self selectMark: (indices at: #fixed) point: newPosition - 1]
		ifFalse: [self selectAt: newPosition].
	self setEmphasisHereFromTextForward: forward! !

!RubTextEditor methodsFor: 'typing support' stamp: 'AlainPlantec 3/22/2013 11:08'!
startOfTyping: anIntegerIndex
	self editingState startOfTyping:  anIntegerIndex! !

!RubTextEditor methodsFor: 'keymapping' stamp: 'AlainPlantec 3/28/2013 19:09'!
defaultKeymappingIndex
	^defaultKeymappingIndex ifNil: [ defaultKeymappingIndex := self newDefaultKeymappingIndex ]! !

!RubTextEditor methodsFor: 'typing support' stamp: 'AlainPlantec 3/22/2013 11:07'!
closeTypeIn
	"See comment in openTypeIn. It is important to call
	closeTypeIn before executing any non-typing key, making a new selection, etc. It is
	called automatically for menu commands."
	self startOfTyping 
		ifNotNil: [self addTypeInUndoRecord.
			self doneTyping]! !

!RubTextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 5/7/2013 09:50'!
markBlock
	^ textArea markBlock! !

!RubTextEditor methodsFor: 'testing' stamp: 'AlainPlantec 4/3/2013 10:01'!
isSmalltalkEditor
	^ false ! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 3/22/2013 11:07'!
setSearch: aString
	"Make the current selection, if any, be the current search string."
	self findText: aString isRegex: false.
	^ true! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 3/22/2013 11:07'!
setSelectorSearch: aStringOrText 
	"Make the current selection as a selector search in current FindReplaceService."
	| regex |
	regex := aStringOrText asString trimBoth.
	regex := regex copyReplaceAll: '#' with: ''.
	regex := regex copyReplaceAll: ' ' with: ''.
	self findText: regex isRegex: false caseSensitive: true entireWordsOnly: false.
	^ true! !

!RubTextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 5/7/2013 09:50'!
markIndex: markIndex pointIndex: pointIndex
	textArea markIndex: markIndex pointIndex: pointIndex
! !

!RubTextEditor methodsFor: 'new selection' stamp: 'AlainPlantec 4/3/2013 10:00'!
selectInterval: anInterval
	"Select the specified characters inclusive.
	 Be sure the selection is in view."

	self selectFrom: anInterval first to: anInterval last! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 3/22/2013 11:07'!
chooseAlignment
	self changeAlignment! !

!RubTextEditor methodsFor: 'find-select' stamp: 'AlainPlantec 3/22/2013 11:07'!
findNext: aRegex startingAt: searchIdx 
	| strm match range |
	strm := (self string copyFrom: searchIdx to: self string size) readStream.
	aRegex searchStream: strm.
	match := aRegex subexpression: 1.
	match ifNotNil: [range := (aRegex position + searchIdx - match size) to: (aRegex position + searchIdx - 1)].
	^ range! !

!RubTextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 5/7/2013 09:50'!
markIndex
	^ textArea markIndex! !

!RubTextEditor methodsFor: 'typing support' stamp: 'TudorGirba 6/22/2014 21:38'!
dispatch: aKeyboardEvent
	"Carry out the action associated with this character, if any.
	Type-ahead is passed so some routines can flush or use it."

	| return |
	return := [ :val | ^ val ].
	self dispatchEnterOn: aKeyboardEvent return: return.
	self dispatchCommandOn: aKeyboardEvent return: return.
	^ self normalCharacter: aKeyboardEvent! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:50'!
replace: xoldInterval with: newText and: selectingBlock 
	"Replace the text in oldInterval with newText and
	execute selectingBlock to establish the new selection.
	Create an UndoRecord to allow perfect undoing."
	| prevSel currInterval |
	self selectInterval: xoldInterval.
	prevSel := self selection.
	currInterval := self selectionInterval.
	self editingState previousInterval: currInterval.
	self zapSelectionWith: newText.
	selectingBlock value.
	((prevSel isEmpty and: [newText isEmpty]) and: [currInterval size < 1]) 
		ifFalse: [self 
			redoArray: {textArea. #redoTypeIn:interval:. {newText. currInterval}} 
			undoArray: {textArea. #undoTypeIn:interval:. {prevSel. currInterval first to: currInterval first + newText size - 1}}]! !

!RubTextEditor methodsFor: 'private' stamp: 'AlainPlantec 4/3/2013 10:01'!
lines
	"Compute lines based on logical line breaks, not optical (which may change due to line wrapping of the editor).
	Subclasses using kinds of Paragraphs can instead use the service provided by it.
	"
	| lines string index lineIndex stringSize |
	string := self string.
	"Empty strings have no lines at all. Think of something."
	string isEmpty ifTrue:[^{#(1 0 0)}].
	stringSize := string size.
	lines := OrderedCollection new: (string size // 15).
	index := 0.
	lineIndex := 0.
	string linesDo:[:line |
		lines addLast: (Array
			with: (index := index + 1)
			with: (lineIndex := lineIndex + 1)
			with: (index := index + line size min: stringSize))].
	"Special workaround for last line empty."
	string last == Character cr
	"lines last last < stringSize" ifTrue:[lines addLast:{stringSize +1. lineIndex+1. stringSize}].
	^lines! !

!RubTextEditor methodsFor: 'private' stamp: 'AlainPlantec 4/24/2013 12:51'!
setEmphasisHere
	self editingState
		emphasisHere:
			((self text attributesAt: (self pointIndex - 1 max: 1) forStyle: self textStyle) select: [ :att | att mayBeExtended ])! !

!RubTextEditor methodsFor: 'private' stamp: 'TudorGirba 6/26/2014 11:10'!
nextWord: position
	| string index  initialIsAlphaNumeric |
	string := self string.
	index := position.
	position >= string size ifTrue: [ ^ position ].
	initialIsAlphaNumeric := (string at: index - 1) isAlphaNumeric.

	[(index <= string size) 
		and: [(string at: index) isAlphaNumeric = initialIsAlphaNumeric]]
			whileTrue: [index := index + 1].
	^ index! !

!RubTextEditor methodsFor: 'nonediting/nontyping keys' stamp: 'AlainPlantec 5/7/2013 09:50'!
raiseContextMenu: aKeyboardEvent

	^ textArea yellowButtonActivity: ActiveEvent shiftPressed! !

!RubTextEditor methodsFor: 'private' stamp: 'AlainPlantec 5/7/2013 09:50'!
compose
	^textArea compose! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 4/11/2013 21:21'!
totalTextHeight

	^self paragraph totalTextHeight! !

!RubTextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 3/22/2013 11:07'!
changeEmphasis: aKeyboardEvent
	"Change the emphasis of the current selection or prepare to accept characters with the change in emphasis. Emphasis change amounts to a font change.  Keeps typeahead."

	"control 0..9 -> 0..9"

	| keyCode attribute oldAttributes index thisSel colors |
	keyCode := ('0123456789-=' indexOf: aKeyboardEvent keyCharacter ifAbsent: [1]) - 1.
	oldAttributes := self text attributesAt: self pointIndex.
	thisSel := self selection.

	"Decipher keyCodes for Command 0-9..."
	"
	(keyCode between: 1 and: 5) 
		ifTrue: [attribute := TextFontChange fontNumber: keyCode].
	"
	keyCode = 6 
		ifTrue: [
			colors := #(#black #magenta #red #yellow #green #blue #cyan #white).
			index := UIManager default chooseFrom:  colors title: 'choose color...'.
			index = 0 ifTrue: [^true].
			index <= colors size 
				ifTrue: [attribute := TextColor color: (Color perform: (colors at: index))]
				ifFalse: [
					index := index - colors size - 1.	"Re-number!!!!!!"
					index = 0 ifTrue: [attribute := self chooseColor].
					thisSel ifNil: [^true]	"Could not figure out what to link to"]].
	(keyCode between: 7 and: 11) 
		ifTrue: [
			aKeyboardEvent shiftPressed 
				ifTrue: [
					keyCode = 10 ifTrue: [attribute := TextKern kern: -1].
					keyCode = 11 ifTrue: [attribute := TextKern kern: 1]]
				ifFalse: [
					attribute := TextEmphasis 
								perform: (#(#bold #italic #narrow #underlined #struckOut) at: keyCode - 6).
					oldAttributes 
						do: [:att | (att dominates: attribute) ifTrue: [attribute turnOff]]]].
	keyCode = 0 ifTrue: [ attribute := TextEmphasis normal ].
	attribute ifNotNil: [
		self applyAttribute: attribute].
	^true! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 3/22/2013 11:07'!
pasteRecent
	"Paste an item chose from RecentClippings."

	| clipping |
	(clipping := Clipboard chooseRecentClipping) ifNil: [^ self].
	Clipboard clipboardText: clipping.
	^ self paste! !

!RubTextEditor methodsFor: 'private' stamp: 'AlainPlantec 5/7/2013 09:50'!
exchangeWith: prior
	"If the prior selection is non-overlapping and legal, exchange the text of
	 it with the current selection and leave the currently selected text selected
	 in the location of the prior selection (or leave a caret after a non-caret if it was
	 exchanged with a caret).  If both selections are carets, flash & do nothing.
	 Don't affect the paste buffer.  Undoer: itself; Redoer: Undoer."

	| start stop before currSelection priorSelection delta redoArgs altInterval undoArgs undoRec |
	start := self startIndex.
	stop := self stopIndex - 1.
	((prior first <= prior last) | (start <= stop) "Something to exchange" and:
			[self isDisjointFrom: prior])
		ifTrue:
			[before := prior last < start.
			currSelection := self selection.
			priorSelection := self text copyFrom: prior first to: prior last.
			delta := before ifTrue: [0] ifFalse: [priorSelection size - currSelection size].
			self zapSelectionWith: priorSelection.
			redoArgs := { prior. start to: stop}.
						
			self selectFrom: prior first + delta to: prior last + delta.
			delta := before ifTrue: [stop - prior last] ifFalse: [start - prior first].
			self zapSelectionWith: currSelection.
			
			altInterval := prior first + delta to: prior last + delta.
			undoArgs := {altInterval. self startIndex to: self stopIndex - 1}.
			"self undoer: #exchangeWith: with: altInterval."
			prior first > prior last ifTrue: [self selectAt: self editingState previousInterval last + 1].
			self 
				redoArray: { textArea. #undoRedoExchange:with:. redoArgs} 
				undoArray: {textArea. #undoRedoExchange:with:. undoArgs}]
		ifFalse:
			[textArea flash]! !

!RubTextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 3/22/2013 11:07'!
offerFontMenu: aKeyboardEvent 
	"The user typed the command key that requests a font change; Offer the font menu."

	self closeTypeIn.
	self offerFontMenu.
	^ true! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 3/22/2013 11:07'!
lastFont	
	"Answer the Font for to be used if positioned at the end of the text"
	| t |	
	t := self text.	
	^ t fontAt: t size + 1! !

!RubTextEditor methodsFor: 'keymapping' stamp: 'TudorGirba 6/22/2014 23:52'!
defaultCommandKeymapping
	| cmdMap |
		
	cmdMap := Array new: 256 withAll: #noop:.	"use temp in case of a crash"
	{(Character home -> #cursorHome:).
	(Character end -> #cursorEnd:).
	(Character backspace -> #backspace:).
	(Character pageUp -> #cursorPageUp:).
	(Character newPage -> #cursorPageDown:).
	(Character cr -> #crWithIndent:).
	(Character escape -> #escape:).
	(Character arrowLeft -> #cursorLeft:).
	(Character arrowRight -> #cursorRight:).
	(Character arrowUp -> #cursorUp:).
	(Character arrowDown -> #cursorDown:).
	(Character space -> #selectWord:).
	(Character delete -> #forwardDelete:) } do: [ :assoc | 
		cmdMap at: assoc key asciiValue + 1 put: assoc value ].
	'([{''"<' do: [ :char | cmdMap at: char asciiValue + 1 put: #enclose: ].
	cmdMap at: $, asciiValue + 1 put: #shiftEnclose:.
	'0123456789-=' do: [ :char | cmdMap at: char asciiValue + 1 put: #changeEmphasis: ].
	^ cmdMap! !

!RubTextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 4/3/2013 09:59'!
paste: aKeyboardEvent 
	"Replace the current text selection by the text in the shared buffer."

	self closeTypeIn.
	self paste.
	^true! !

!RubTextEditor methodsFor: 'scrolling' stamp: 'AlainPlantec 3/22/2013 11:07'!
scrollBy: ignore 
	"Ignore scroll requests."
! !

!RubTextEditor methodsFor: 'find-select' stamp: 'AlainPlantec 3/22/2013 11:07'!
findPrevious: aRegex startingAt: searchIdx 
	| allRanges |
	allRanges := self findAll: aRegex endingAt: searchIdx.
	^ allRanges notEmpty
		ifTrue: [allRanges last].
! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 4/4/2013 09:44'!
findText: aString isRegex: aBoolean
	self findReplaceService findText: aString isRegex: aBoolean! !

!RubTextEditor methodsFor: 'private' stamp: 'AlainPlantec 5/7/2013 09:50'!
textStyle: aTextStyle
	textArea textStyle: aTextStyle! !

!RubTextEditor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 5/7/2013 14:44'!
backspace: aKeyboardEvent
	| result startIndex |
	result := aKeyboardEvent shiftPressed
		ifTrue: [ self backWord: aKeyboardEvent keyCharacter ]
		ifFalse: [ 
			self hasSelection
				ifTrue: [ 
					self replaceSelectionWith: self nullText. 
					textArea changed]
				ifFalse: [ 
					startIndex := self markIndex
						+
							(self hasCursor
								ifTrue: [ 0 ]
								ifFalse: [ 1 ]).
					startIndex := 1 max: startIndex - 1.
					self backTo: startIndex ].
			false ].
	self closeTypeIn.
	^ result! !

!RubTextEditor methodsFor: 'typing support' stamp: 'AlainPlantec 4/26/2013 12:06'!
dispatchEnterOn: aKeyboardEvent return: aBlock
	aKeyboardEvent keyValue = Character cr asciiValue
		ifFalse: [ ^ false ].
	aKeyboardEvent controlKeyPressed
		ifTrue: [ aBlock value: (self normalCharacter: aKeyboardEvent) ].
	aKeyboardEvent shiftPressed
		ifTrue: [ aBlock value: (self lf: aKeyboardEvent) ].
	aKeyboardEvent commandKeyPressed
		ifTrue: [ aBlock value: (self crlf: aKeyboardEvent) ].
	aBlock value: (self crWithIndent: aKeyboardEvent)! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 3/22/2013 11:07'!
offerFontMenu
	"Present a menu of available fonts, and if one is chosen, apply it to the current selection.  
	Use only names of Fonts of this paragraph  "
	
	^self changeTextFont! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 3/22/2013 11:07'!
changeEmphasis

	|  reply code align menuList startIndex attribute choices |
	choices := self emphasisChoices.
	startIndex := self startIndex.
	align := self text alignmentAt: startIndex ifAbsent: [ 0 ].
	code := self text emphasisAt: startIndex.
	menuList := WriteStream on: Array new.
	menuList nextPut: (code isZero ->  'normal' translated).
	menuList nextPutAll: (choices  collect: [:emph|
							(code anyMask: (TextEmphasis perform: emph) emphasisCode)
								-> emph asString translated ]).
						
	menuList nextPut: ((self text attributesAt: startIndex)
							anySatisfy: [ :attr | attr isKern and: [attr kern < 0 ]]) -> 'narrow' translated.
	reply := UIManager default chooseFrom:  choices values: choices.
	reply notNil 
		ifTrue: [ attribute := TextEmphasis perform: reply.
				self applyAttribute:  attribute].
	^ true! !

!RubTextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 4/3/2013 09:58'!
select
	"select what and how ?"! !

!RubTextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 3/22/2013 11:07'!
changeLfToCr: aKeyboardEvent
	"Replace all LFs by CRs.
	Triggered by Cmd-U -- useful when getting code from FTP sites
	jmv- Modified to als change crlf by cr"
	
	| fixed |
	fixed := self selection string.
	fixed := fixed copyReplaceAll: String crlf with: String cr.
	fixed := fixed copyReplaceAll: String lf with: String cr. 
	self replaceSelectionWith: (Text fromString: fixed).
	^ true! !

!RubTextEditor methodsFor: 'typing support' stamp: 'AlainPlantec 4/3/2013 09:51'!
dispatchCommandOn: aKeyboardEvent return: return
	| asciiValue char |
	asciiValue := aKeyboardEvent keyValue.	
	
	"Special keys overwrite crtl+key combinations - at least on Windows. To resolve this
	conflict, assume that keys other than cursor keys aren't used together with Crtl."
	((self specialShiftCmdKeys includes: asciiValue) and: [ asciiValue < 27 ])
		ifTrue: [ ^ self performCmdActionsWith: aKeyboardEvent shifted: aKeyboardEvent controlKeyPressed return: return ].	
	
	"backspace, and escape keys (ascii 8 and 27) are command keys"
	(aKeyboardEvent commandKeyPressed or: [ self specialShiftCmdKeys includes: asciiValue ])
		ifTrue: [ ^ self performCmdActionsWith: aKeyboardEvent shifted: aKeyboardEvent shiftPressed return: return ].	
			
	"the control key can be used to invoke shift-cmd shortcuts"
	aKeyboardEvent controlKeyPressed
		ifTrue: [ ^ self performCmdActionsWith: aKeyboardEvent shifted: true return: return ].
	^ false! !

!RubTextEditor methodsFor: 'find-select' stamp: 'AlainPlantec 4/22/2013 20:57'!
findAndSelect: aRegex startingAt: anIndex searchBackwards: searchBackwards
	| oldSelectionInterval where |
	self closeTypeIn.
	oldSelectionInterval := self selectionInterval.
	self selectInvisiblyFrom: anIndex to: anIndex - 1.
	where :=  searchBackwards
		ifTrue: [self findAndSelectPreviousOccurenceOf: aRegex]
		ifFalse: [self findAndSelectNextOccurenceOf: aRegex].
	where ifNil: [self selectInterval: oldSelectionInterval].
	^ where! !

!RubTextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 5/7/2013 09:50'!
recomputeSelection
	"The same characters are selected but their coordinates may have changed.
	Redetermine the selection according to the start and stop block indices; 
	do not highlight."

	textArea recomputeSelection! !

!RubTextEditor methodsFor: 'new selection' stamp: 'AlainPlantec 4/3/2013 10:00'!
selectMark: mark point: point
	"Select the specified characters inclusive.
	 Be sure the selection is in view."

	(mark =  self markIndex and: [point + 1 = self pointIndex]) ifFalse:
		[self deselect.
		self selectInvisiblyMark: mark point: point]! !

!RubTextEditor methodsFor: 'typing support' stamp: 'AlainPlantec 4/25/2013 19:36'!
setEmphasisHereFromTextForward: lookForward

	| i t forward delta prevIsSeparator nextIsSeparator |
	i := self pointIndex.
	t := self text.
	"Try to set emphasisHere correctly after whitespace.
	Most important after a cr, i.e. at the start of a new line"
	prevIsSeparator :=  i > 1 and: [ (t at: i-1) isSeparator ].
	nextIsSeparator := i <= t size and: [ (t at: i) isSeparator ].
	forward := prevIsSeparator = nextIsSeparator
		ifTrue: [ lookForward ]
		ifFalse: [ nextIsSeparator ].
	delta := forward ifTrue: [ 1 ] ifFalse: [ 0 ].
	self editingState emphasisHere: ((t attributesAt: (i - delta max: 1)) select: [:att | att mayBeExtended]).
	! !

!RubTextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 11/25/2013 10:23'!
selection
	"Answer the text in the paragraph that is currently selected."
	^self text copyFrom: self startIndex to: self stopIndex - 1 ! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 3/22/2013 11:07'!
accept: aKeyboardEvent 
	"Save the current text of the text being edited as the current acceptable version for purposes of canceling.  Allow my morph to take appropriate action"
	self accept.
	^ true! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 4/4/2013 10:25'!
findAgain
	"Find the text-to-find again."
	| where |
	where := self findReplaceService findNext.
	where isNil
		ifTrue: [self flash]
		ifFalse: [ self selectInterval: where].
	^ where
! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 5/7/2013 09:50'!
lineSelectAndEmptyCheck: returnBlock
	"If the current selection is an insertion point, expand it to be the entire current line; if after that's done the selection is still empty, then evaluate the returnBlock, which will typically consist of '[^ self]' in the caller -- check senders of this method to understand this."

	self selectLine.  "if current selection is an insertion point, then first select the entire line in which occurs before proceeding"
	self hasSelection ifFalse: [textArea flash.  ^ returnBlock value]! !

!RubTextEditor methodsFor: 'find-select' stamp: 'AlainPlantec 3/22/2013 11:07'!
findAll: aRegex endingAt: searchIdx 
	| ranges |
	ranges := aRegex matchingRangesIn: (self string copyFrom: 1 to: searchIdx).
	^ ranges 
			! !

!RubTextEditor methodsFor: 'deprecated' stamp: 'AlainPlantec 3/22/2013 11:07'!
offerMenuFromEsc: aKeyboardEvent
	"The escape key was hit while the receiver has the keyboard focus; take action"
 	ActiveEvent shiftPressed 
		ifFalse: [ self raiseContextMenu: aKeyboardEvent].
	^ false 	! !

!RubTextEditor methodsFor: 'private' stamp: 'AlainPlantec 3/27/2013 14:56'!
applyTextFont: aFont
	self applyAttribute: (TextFontReference toFont: aFont).
! !

!RubTextEditor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 4/3/2013 10:06'!
selectAll: aKeyboardEvent 
	"select everything"

	self closeTypeIn.
	self selectFrom: 1 to: self string size.
	^ true! !

!RubTextEditor methodsFor: 'private' stamp: 'AlainPlantec 5/7/2013 09:50'!
resetState
	"Establish the initial conditions for editing the paragraph: place cursor 
	before first character, set the emphasis to that of the first character"

	| b |
	b := self paragraph defaultCharacterBlock.
	textArea markBlock: b pointBlock: b copy.
	self editingState startOfTyping: nil.
	self editingState previousInterval: (1 to: 0).
	self setEmphasisHereFromText! !

!RubTextEditor methodsFor: 'new selection' stamp: 'AndreiChis 1/12/2015 10:55'!
selectLine
	"Make the receiver's selection, if it currently consists of an insertion point only, encompass the current line."
	self hasSelection ifTrue: [^self].
	self selectInterval: self computeSelectionIntervalForCurrentLine! !

!RubTextEditor methodsFor: 'nonediting/nontyping keys' stamp: 'AlainPlantec 4/3/2013 10:00'!
cursorLeft: aKeyboardEvent 
	"Private - Move cursor left one character if nothing selected, otherwise 
	move cursor to beginning of selection. If the shift key is down, start 
	selecting or extending current selection. Don't allow cursor past 
	beginning of text"

	self closeTypeIn.
	self
		moveCursor:[:position | position - 1 max: 1]
		forward: false
		specialBlock:[:position | self previousWord: position]
		event: aKeyboardEvent.
	^ true! !

!RubTextEditor methodsFor: 'new selection' stamp: 'AlainPlantec 3/22/2013 11:07'!
correctFrom: start to: stop with: aString
	"Make a correction in the model that the user has authorised from somewhere else in the system (such as from the compilier).  
	The user's selection is not changed, only corrected."
	| wasShowing userSelection delta loc |
	
	userSelection := self selectionInterval.
	self selectInvisiblyFrom: start to: stop.
	self replaceSelectionWith: aString asText.
	delta := aString size - (stop - start + 1).
	self selectInvisiblyFrom:
		userSelection first + (userSelection first > start ifFalse: [ 0 ] ifTrue: [ delta ])
		to: userSelection last + (userSelection last > start ifFalse: [ 0 ] ifTrue: [ delta ]).
! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 3/22/2013 11:07'!
lastParagraphStyle
	"Answer the TextStyle for to be used if positioned at the end of the text"
	
	| t |
	t := self text.
	^self startIndex > t size
		ifTrue: [ self text styleIfApplying: self emphasisHere ]
		ifFalse: [ self text textStyleAt: t size +1 ]! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 3/22/2013 11:07'!
exchange
	"See comment in exchangeWith:"

	self exchangeWith: self editingState previousInterval! !

!RubTextEditor methodsFor: 'typing support' stamp: 'AlainPlantec 3/22/2013 11:07'!
addString: aString
	"Think of a better name"
	self zapSelectionWith: (Text string: aString attributes: self emphasisHere)! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 3/22/2013 11:07'!
again
	"Text substitution. If the left shift key is down, the substitution is
	made throughout the entire Paragraph. Otherwise, only the next 
	possible substitution is made"
	true.
	! !

!RubTextEditor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 3/22/2013 11:08'!
doAgainMany: aKeyboardEvent 
	"Do the previous thing again repeatedly."

	self closeTypeIn.
	^ true! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 4/22/2013 12:20'!
align
	"Align text according to the next greater alignment value,
	cycling among leftFlush, rightFlush, center, and justified."
	self changeAlignment.
! !

!RubTextEditor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 3/22/2013 11:08'!
findAgain: aKeyboardEvent 
	"Find the desired text again."
	self closeTypeIn.
	self findAgain.
	^ true! !

!RubTextEditor methodsFor: 'keymapping' stamp: 'TudorGirba 6/22/2014 22:51'!
initializeShortcuts: aKMDispatcher
	aKMDispatcher attachCategory: RubTextEditor name! !

!RubTextEditor methodsFor: 'testing' stamp: 'AlainPlantec 3/22/2013 11:07'!
isCaretBehindChar
	"Return true if the cursor position is after an alphanumeric character, otherwise false."

	| cursorPosition |
	^(cursorPosition := self startIndex) >= 2 and: [
		(self text at: cursorPosition - 1) isAlphaNumeric ]! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 3/22/2013 11:07'!
setSearchString
	"Make the current selection, if any, be the current search string."
	self closeTypeIn.
	self setSearch: self selection string.
	^ true! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 5/7/2013 09:50'!
undo
	"Undo  previous edit."
	self closeTypeIn.
	self editingState undo ifFalse: [textArea flash]. 
! !

!RubTextEditor methodsFor: 'undo-redo private' stamp: 'AlainPlantec 5/7/2013 09:50'!
addDeleteSelectionUndoRecord
	| undoText redoText undoRec |
	undoText := self selection.
	redoText := self nullText.
	self
		redoArray:	{textArea. #undoTypeIn:interval:.	{redoText.	(self selectionInterval)}}
		undoArray:	{textArea. #redoTypeIn:interval:.	{undoText.	(self selectionInterval first to: self selectionInterval first - 1)}}! !

!RubTextEditor methodsFor: 'keymapping' stamp: 'AlainPlantec 4/3/2013 09:49'!
specialShiftCmdKeys

"Private - return array of key codes that represent single keys acting
as if shift-command were also being pressed"

^#(
	1	"home"
	3	"enter"
	4	"end"
	8	"backspace"
	11	"page up"
	12	"page down"
	27	"escape"
	28	"left arrow"
	29	"right arrow"
	30	"up arrow"
	31	"down arrow"
	127	"delete"
	)! !

!RubTextEditor methodsFor: 'private' stamp: 'AlainPlantec 3/22/2013 11:08'!
pageHeight
	| howManyLines visibleHeight totalHeight ratio |
	howManyLines := self paragraph numberOfLines.
	visibleHeight := self visibleHeight.
	totalHeight := self totalTextHeight.
	ratio := visibleHeight / totalHeight.
	^(ratio * howManyLines) rounded - 2! !

!RubTextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 5/7/2013 09:50'!
unselect
	textArea unselect! !

!RubTextEditor methodsFor: 'typing support' stamp: 'AlainPlantec 4/23/2013 12:57'!
keystroke: aKeyboardEvent
	(self dispatch: aKeyboardEvent)
		ifTrue: [ "If not a normal character"
			self doneTyping.
			self storeSelectionInText.
			^ self ].
	"normal character"
	self openTypeIn.
	self hasSelection
		ifTrue: [ 
			"save highlighted characters"
			self editingState previousInterval: self selectionInterval].
	"Notice selection changed"
	self unselect.
	self storeSelectionInText! !

!RubTextEditor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 4/3/2013 10:06'!
selectAll

	self selectFrom: 1 to: self string size! !

!RubTextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 3/22/2013 11:07'!
outdent: aKeyboardEvent
	"Remove a tab from the front of every line occupied by the selection."

	^ self inOutdent: aKeyboardEvent delta: -1! !

!RubTextEditor methodsFor: 'events' stamp: 'AndreiChis 1/12/2015 16:58'!
click: event
	| p |
	self closeTypeIn.
	p := self paragraph characterBlockAtPoint: event cursorPoint.
	textArea markBlock: p pointBlock: p.
	self setEmphasisHereFromText.
	self storeSelectionInText.
	textArea announce: (RubMouseClick with: event)! !

!RubTextEditor methodsFor: 'private' stamp: 'AlainPlantec 3/22/2013 11:08'!
sameColumn: start newLine: lineBlock forward: isForward
	"Private - Compute the index in my text
	with the line number derived from lineBlock,"
	" a one argument block accepting the old line number.
	The position inside the line will be preserved as good as possible"
	"The boolean isForward is used in the border case to determine if
	we should move to the beginning or the end of the line."
	| column currentLine offsetAtTargetLine targetEOL lines numberOfLines currentLineNumber targetLineNumber |
	self walkAlongDisplayedLine
		ifTrue: [lines := self paragraph lines.
			numberOfLines := self paragraph numberOfLines.
			currentLineNumber := self paragraph lineIndexOfCharacterIndex: start.
			currentLine := lines at: currentLineNumber]
		ifFalse: [lines := self lines.
			numberOfLines := lines size.
			currentLine := lines
				detect:[:lineInterval | lineInterval last >= start]
				ifNone:[lines last].
			currentLineNumber := currentLine second].
	column := start - currentLine first.
	targetLineNumber := ((lineBlock value: currentLineNumber) max: 1) min: numberOfLines.
	offsetAtTargetLine := (lines at: targetLineNumber) first.
	targetEOL := (lines at: targetLineNumber) last + (targetLineNumber = numberOfLines ifTrue:[1]ifFalse:[0]).
	targetLineNumber = currentLineNumber
	"No movement or movement failed. Move to beginning or end of line."
		ifTrue:[^isForward
			ifTrue:[targetEOL]
			ifFalse:[offsetAtTargetLine]].
	^offsetAtTargetLine + column min: targetEOL.! !

!RubTextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 3/22/2013 11:07'!
exchange: aKeyboardEvent
	"Exchange the current and prior selections."

	self closeTypeIn.
	self exchange.
	^true! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 3/22/2013 11:07'!
findRegex
	^ self findReplaceService findRegex! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:50'!
text
	"Answer the text of the paragraph being edited."

	^ textArea text! !

!RubTextEditor methodsFor: 'new selection' stamp: 'AlainPlantec 4/4/2013 00:17'!
selectFrom: start to: stop
	"Select the specified characters inclusive."
	self selectInvisiblyFrom: start to: stop.
	self closeTypeIn.
	self storeSelectionInText.
	"Preserve current emphasis if selection is empty"
	stop > start 
		ifTrue: [self setEmphasisHereFromTextForward: true ]! !

!RubTextEditor methodsFor: 'displaying' stamp: 'AlainPlantec 5/7/2013 09:50'!
flash
	^ textArea flash! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 4/18/2013 11:46'!
saveContentsInFile
	"Save the receiver's contents string to a file, prompting the user for a file-name.  Suggest a reasonable file-name."

	| fileName stringToSave parentWindow labelToUse suggestedName lastIndex |
	self flag: #beurk.

	stringToSave := self string. 
	stringToSave size = 0 ifTrue: [^self inform: 'nothing to save.'].
	parentWindow := self model dependents 
				detect: [:dep | dep isKindOf: SystemWindow]
				ifNone: [nil].
	labelToUse := parentWindow ifNil: ['Untitled']
				ifNotNil: [parentWindow label].
	suggestedName := nil.
	#(#('Decompressed contents of: ' '.gz')) do: 
			[:leaderTrailer | 
			"can add more here..."

			(labelToUse beginsWith: leaderTrailer first) 
				ifTrue: 
					[suggestedName := labelToUse copyFrom: leaderTrailer first size + 1
								to: labelToUse size.
					(labelToUse endsWith: leaderTrailer last) 
						ifTrue: 
							[suggestedName := suggestedName copyFrom: 1
										to: suggestedName size - leaderTrailer last size]
						ifFalse: 
							[lastIndex := suggestedName lastIndexOf: $. ifAbsent: [0].
							(lastIndex = 0 or: [lastIndex = 1]) 
								ifFalse: [suggestedName := suggestedName copyFrom: 1 to: lastIndex - 1]]]].
	suggestedName ifNil: [suggestedName := labelToUse , '.text'].
	fileName := UIManager default request: 'File name?'
				initialAnswer: suggestedName.
	fileName isEmptyOrNil 
		ifFalse: 
			[(FileStream newFileNamed: fileName)
				nextPutAll: stringToSave;
				close]! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 4/3/2013 09:59'!
clipboardText

	^ Clipboard clipboardText! !

!RubTextEditor methodsFor: 'nonediting/nontyping keys' stamp: 'AlainPlantec 4/3/2013 10:00'!
cursorPageUp: aKeyboardEvent 

	self closeTypeIn.
	self 
		moveCursor: [:position |
			self
				sameColumn: position
				newLine: [:lineNo | lineNo - self pageHeight]
				forward: false]
		forward: false
		specialBlock:[:dummy | dummy]
		event: aKeyboardEvent.
	^true! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:50'!
textStyle
	^ textArea textStyle! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:50'!
editingState
	^ textArea editingState! !

!RubTextEditor methodsFor: 'constants' stamp: 'AlainPlantec 3/22/2013 11:07'!
emphasisChoices
	"Return the list of emphasis that are possible to apply on the currently edited text morph"
	
	^  #(normal bold italic narrow underlined struckOut).	
	! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 4/11/2013 09:48'!
openingDelimiters
	^ '([{'
! !

!RubTextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 5/7/2013 09:50'!
inOutdent: aKeyboardEvent delta: delta
	"Add/remove a tab at the front of every line occupied by the selection. 
	Derived from work by Larry Tesler back in December 1985."

	| cr realStart realStop lines startLine stopLine start stop adjustStart indentation size numLines inStream newString outStream |
	self flag: #toBeReviewed.
	cr := Character cr.

	"Operate on entire lines, but remember the real selection for re-highlighting later"
	realStart := self startIndex.
	realStop := self stopIndex - 1.

	"Special case a caret on a line of its own, including weird case at end of paragraph"
	(realStart > realStop and: [
				realStart < 2 or: [(self string at: realStart - 1) == cr]])
		ifTrue:
			[delta < 0
				ifTrue: [
					textArea flash]
				ifFalse: [
					self replaceSelectionWith: Character tab asSymbol asText.
					self selectAt: realStart + 1].
			^true].

	lines := self paragraph lines.
	startLine := self paragraph lineIndexOfCharacterIndex: realStart.
	stopLine := self paragraph lineIndexOfCharacterIndex: (realStart max: realStop).
	start := (lines at: startLine) first.
	stop := (lines at: stopLine) last.
	
	"Pin the start of highlighting unless the selection starts a line"
	adjustStart := realStart > start.

	"Find the indentation of the least-indented non-blank line; never outdent more"
	indentation := (startLine to: stopLine) inject: 1000 into: [ :previousValue :each |
		previousValue min: (self paragraph indentationOfLineIndex: each ifBlank: [ :tabs | 1000 ])].			

	size :=  stop + 1 - start.
	numLines := stopLine + 1 - startLine.
	inStream := ReadStream on: self string from: start to: stop.

	newString := String new: size + ((numLines * delta) max: 0).
	outStream := ReadWriteStream on: newString.

	"This subroutine does the actual work"
	self indent: delta fromStream: inStream toStream: outStream.

	"Adjust the range that will be highlighted later"
	adjustStart ifTrue: [realStart := (realStart + delta) max: start].
	realStop := realStop + outStream position - size.

	"Prepare for another iteration"
	indentation := indentation + delta.
	size := outStream position.
	inStream := outStream setFrom: 1 to: size.

	outStream == nil
		ifTrue: 	"tried to outdent but some line(s) were already left flush"
			[textArea flash]
		ifFalse:
			[self selectInvisiblyFrom: start to: stop.
			size = newString size ifFalse: [newString := outStream contents].
			self replaceSelectionWith: newString asText].
	self selectFrom: realStart to: realStop. 	"highlight only the original range"
	^ true! !

!RubTextEditor methodsFor: 'nonediting/nontyping keys' stamp: 'AlainPlantec 4/3/2013 10:00'!
selectWord: aKeyboardEvent

	self closeTypeIn.
	self selectWord.
	^ true! !

!RubTextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 4/3/2013 09:58'!
deselect
	"If the text selection is visible on the screen, reverse its highlight."
	" ***** screw this logic ***** selectionShowing ifTrue: [self reverseSelection] "! !

!RubTextEditor methodsFor: 'new selection' stamp: 'AlainPlantec 4/3/2013 10:00'!
selectAt: characterIndex 
	"Place the caret before the character at characterIndex.
	 Be sure it is in view."

	self selectFrom: characterIndex to: characterIndex - 1! !

!RubTextEditor methodsFor: 'undo-redo private' stamp: 'AlainPlantec 4/19/2013 19:14'!
redoArray: doArray undoArray: undoArray
	self editingState redoArray: doArray undoArray: undoArray! !

!RubTextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 3/22/2013 11:07'!
enclose: aKeyboardEvent
	"Insert or remove bracket characters around the current selection."

	| left right startIndex stopIndex oldSelection which text |
	self closeTypeIn.
	startIndex := self startIndex.
	stopIndex := self stopIndex.
	oldSelection := self selection.
	which := '([<{"''' indexOf: aKeyboardEvent keyCharacter ifAbsent: [ ^true ].
	left := '([<{"''' at: which.
	right := ')]>}"''' at: which.
	text := self text.
	((startIndex > 1 and: [stopIndex <= text size])
			and: [ (text at: startIndex-1) = left and: [(text at: stopIndex) = right]])
		ifTrue: [
			"already enclosed; strip off brackets"
			self selectFrom: startIndex-1 to: stopIndex.
			self replaceSelectionWith: oldSelection]
		ifFalse: [
			"not enclosed; enclose by matching brackets"
			self replaceSelectionWith:
				(Text string: (String with: left), oldSelection string, (String with: right) attributes: self emphasisHere).
			self selectFrom: startIndex+1 to: stopIndex].
	^true! !

!RubTextEditor methodsFor: 'events' stamp: 'AlainPlantec 6/4/2013 00:06'!
doubleClick: evt
	| here |
	self closeTypeIn.	"no matter what, if shift is pressed extend the selection"
	here := self pointIndex.
	(here between: 2 and: self string size)
		ifFalse: [ 
			"if at beginning or end, select entire string"
			self selectFrom: 1 to: self string size ]
		ifTrue: [ self selectWord ].
	self setEmphasisHereFromText.
	self storeSelectionInText! !

!RubTextEditor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 4/3/2013 10:06'!
crlf: aKeyboardEvent
	"Append a line feed character to the stream of characters."

	self addString: String crlf.
	^false! !

!RubTextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 3/22/2013 11:07'!
indent: aKeyboardEvent
	"Add a tab at the front of every line occupied by the selection."

	^ self inOutdent: aKeyboardEvent delta: 1! !

!RubTextEditor methodsFor: 'find-select' stamp: 'AlainPlantec 4/19/2013 19:21'!
undoRedoTransaction: aBlock
	self editingState undoRedoTransaction: aBlock! !

!RubTextEditor methodsFor: 'nonediting/nontyping keys' stamp: 'AlainPlantec 5/7/2013 09:50'!
escape: aKeyboardEvent
	textArea escapePressed.
	^ false  ! !

!RubTextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 6/1/2013 10:11'!
zapSelectionWith: aText
	| start stop |
	self canChangeText
		ifFalse: [ ^ self ].
	start := self startIndex.
	stop := self stopIndex.
	(aText isEmpty and: [ stop > start ])
		ifTrue: [ 
			"If deleting, then set emphasisHere from 1st character of the deletion"
			self editingState emphasisHere: ((self text attributesAt: start) select: [ :att | att mayBeExtended ]) ].
	(start = stop and: [ aText size = 0 ])
		ifFalse: [ 
			textArea privateReplaceFrom: start to: stop - 1 with: aText asText.
			"We ask to editingSate directly instead to the morph "	
			"to avoid unwanted SelectionChanged announce."	
			"It will be send later while unselecting (with #unselect send)"
			self markIndex: start pointIndex: start + aText size.
			self editingState previousInterval: self selectionInterval ] ! !

!RubTextEditor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 3/22/2013 11:08'!
find: aKeyboardEvent
	"Prompt the user for what to find, then find it, searching from the current selection onward."

	self closeTypeIn.
	self find.
	^ true! !

!RubTextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 3/22/2013 11:07'!
makeLowercase: aKeyboardEvent
	"Force the current selection to lowercase.  Triggered by Cmd-X."

	self closeTypeIn.
	self replaceSelectionWith: (Text fromString: (self selection string asLowercase)).
	^ true! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 3/22/2013 11:07'!
previousCharacterIfAbsent: aBlock

	^ self text at: self startIndex - 1 ifAbsent: aBlock! !

!RubTextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 3/22/2013 11:07'!
undo: aKeyboardEvent 
	"Undo the last edit."

	self undo.
	^true! !

!RubTextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 4/3/2013 09:59'!
noop: aKeyboardEvent 
	"Unimplemented keyboard command; just ignore it."

	^ true! !

!RubTextEditor methodsFor: 'undoers-redoers' stamp: 'AlainPlantec 3/22/2013 11:08'!
redoTypeIn: aText interval: anInterval
	self selectInterval: anInterval.
	self replace: self selectionInterval with: aText and:
		[self selectInterval: (anInterval first to: anInterval first + aText size - 1)].
! !

!RubTextEditor methodsFor: 'new selection' stamp: 'AlainPlantec 4/19/2013 11:35'!
selectInvisiblyMark: mark point: point
	"Select the designated characters, inclusive.  Make no visual changes."

	self markIndex: mark pointIndex: point + 1! !

!RubTextEditor methodsFor: 'undo-redo private' stamp: 'AlainPlantec 3/22/2013 11:08'!
clearUndoManager: aKeyboardEvent
	^ self editingState clearUndoManager: aKeyboardEvent.
! !

!RubTextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 3/22/2013 11:07'!
makeCapitalized: aKeyboardEvent
	"Force the current selection to uppercase.  Triggered by Cmd-z."

	| prev |
	self closeTypeIn.
	prev := $-.  "not a letter"
	self replaceSelectionWith: (Text fromString:
		(self selection string collect:
			[:c | prev := prev isLetter ifTrue: [c asLowercase] ifFalse: [c asUppercase]])).
	^ true! !

!RubTextEditor methodsFor: 'testing' stamp: 'AlainPlantec 4/3/2013 10:01'!
isSimpleEditor 
	^ false ! !

!RubTextEditor methodsFor: 'settings' stamp: 'AlainPlantec 5/7/2013 09:50'!
caseSensitiveFinds
	^ textArea caseSensitiveFinds! !

!RubTextEditor methodsFor: 'keymapping' stamp: 'AlainPlantec 3/28/2013 19:21'!
newDefaultKeymappingIndex
	defaultKeymappingIndex := IdentityDictionary new.
	defaultKeymappingIndex at: #command put: self defaultCommandKeymapping.
	defaultKeymappingIndex at: #shiftCommand put: self defaultShiftCommandKeymapping.
	^ defaultKeymappingIndex ! !

!RubTextEditor methodsFor: 'private' stamp: 'AlainPlantec 5/7/2013 09:50'!
cut
	"Cut out the current selection and redisplay the paragraph if necessary.  Undoer & Redoer: undoCutCopy:"

	self lineSelectAndEmptyCheck: [^ self].
	self clipboardTextPut: self selection.
	self replaceSelectionWith: self nullText.
	textArea changed
! !

!RubTextEditor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 3/28/2013 22:28'!
forwardDelete: aKeyboardEvent
	"Delete forward over the next character"

	self closeTypeIn.
	self hasSelection
		ifFalse: [ 
			| idx1 idx2 |
			idx1 := self startIndex min: self stopIndex.
			idx2 := self stopIndex max: self startIndex.
			aKeyboardEvent shiftPressed
				ifTrue: [ idx2 := self nextWord: idx1 ]
				ifFalse: [ idx2 := idx2 + 1 ].
			self selectInvisiblyFrom: idx1 to: idx2 - 1 ].
	self addDeleteSelectionUndoRecord.
	self zapSelectionWith: self nullText.
	^ false! !

!RubTextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 4/19/2013 11:39'!
hasCursor
	^self markBlock = self pointBlock! !

!RubTextEditor methodsFor: 'settings' stamp: 'AlainPlantec 5/7/2013 09:50'!
walkAlongDisplayedLine
	^ textArea walkAlongDisplayedLine! !

!RubTextEditor methodsFor: 'private' stamp: 'AlainPlantec 3/22/2013 11:08'!
findText: aString isRegex: isRegex caseSensitive: caseSensitive entireWordsOnly: entireWordsOnly
	self findReplaceService findText: aString isRegex: isRegex caseSensitive: caseSensitive entireWordsOnly: entireWordsOnly
! !

!RubTextEditor methodsFor: 'find-select' stamp: 'AlainPlantec 4/3/2013 00:43'!
findAndSelectPreviousOccurenceOf: aRegex
	| where |
	where := self findPrevious: aRegex startingAt: self startIndex.
	where isNil ifFalse: [self selectInterval: where].
	^ where! !

!RubTextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 6/2/2013 15:04'!
editPrimarySelectionSeparately
	textArea editPrimarySelectionSeparately! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 3/22/2013 11:07'!
currentParagraphStyle
	"Answer the TextStyle for the current selection or cursor location if any"
	
	| i t |
	i := self startIndex.
	t := self text.
	^i > t size
		ifTrue: [ self text styleIfApplying: self emphasisHere ]
		ifFalse: [ self text textStyleAt: i ]! !

!RubTextEditor methodsFor: 'find-select' stamp: 'AlainPlantec 4/19/2013 19:19'!
replaceAll: aRegex with: aText
	self
		undoRedoTransaction: [ 
			| selec ranges |
			selec := self selectionInterval.
			ranges := self findAll: aRegex startingAt: selec first.
			ranges
				reverseDo: [ :r | 
					self selectInvisiblyFrom: r first to: r last.
					self replaceSelectionWith: aText ].
			self selectInterval: selec ]! !

!RubTextEditor methodsFor: 'private' stamp: 'AlainPlantec 4/26/2013 12:07'!
textWasAccepted
	self closeTypeIn.
	^ self accept! !

!RubTextEditor methodsFor: 'nonediting/nontyping keys' stamp: 'AlainPlantec 4/3/2013 10:00'!
cursorDown: aKeyboardEvent 

	"Private - Move cursor from position in current line to same position in
	next line. If next line too short, put at end. If shift key down,
	select."

	self closeTypeIn.
	self 
		moveCursor:[:position | self
				sameColumn: position
				newLine:[:line | line + 1]
				forward: true]
		forward: true
		specialBlock:[:dummy | dummy]
		event: aKeyboardEvent.
	^true! !

!RubTextEditor methodsFor: 'private' stamp: 'AlainPlantec 3/22/2013 11:08'!
encompassParagraph: anInterval
	"Return an interval that includes anInterval, and that comprises one or several whole paragraphs in the receiver.
	Answer starts at the position following a cr (or eventually 1) and ends at a cr (or eventually at self size)"
	^ self string encompassParagraph: anInterval
! !

!RubTextEditor methodsFor: 'typing support' stamp: 'AlainPlantec 4/19/2013 14:35'!
openTypeIn
	"Set up startOfTyping to keep track of the leftmost backspace.
	 You can't undo typing until after closeTypeIn."

	self startOfTyping 
		ifNil: [self editingState previousInterval: (1 to: 0).
			self startOfTyping: self startIndex]! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 3/22/2013 11:07'!
changeAlignment
	"Interactively change the alignment of the text currently being edited."
	| reply  |
	reply := UIManager default 
				chooseFrom:  self alignmentChoices 
				values:  self alignmentChoices.	
	reply ifNil: [^self].
	self applyAttribute: (TextAlignment perform: reply).
	^ true! !

!RubTextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 3/22/2013 11:07'!
selectionAsStream
	"Answer a ReadStream on the text in the paragraph that is currently 
	selected."

	^ReadStream
		on: (self string copyFrom: self startIndex to: self stopIndex - 1)! !

!RubTextEditor methodsFor: 'find-select' stamp: 'AlainPlantec 3/22/2013 11:07'!
findNextString: aSubString startingAt: searchIdx 
	| idx |
	idx := self string findString: aSubString startingAt: searchIdx.
	^ idx isZero ifFalse: [idx to: idx + aSubString size - 1]
			! !

!RubTextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 5/7/2013 09:50'!
duplicate: aKeyboardEvent
	"Paste the current selection over the prior selection, if it is non-overlapping and
	 legal.  Undoer & Redoer: undoAndReselect."

	self closeTypeIn.
	(self hasSelection and: [self isDisjointFrom: self editingState previousInterval])
		ifTrue: "Something to duplicate"
			[self replace: self editingState previousInterval with: self selection and:
				[self selectAt: self pointIndex]]
		ifFalse:
			[textArea flash].
	^true! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 4/4/2013 10:32'!
caret
	"Return the index position of the caret"
	^ self startIndex ! !

!RubTextEditor methodsFor: 'find-select' stamp: 'AlainPlantec 4/3/2013 14:40'!
findReplaceService
	^ RubFindReplaceService default! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 3/22/2013 11:07'!
wordAtCaret

	^self paragraph text asString wordBefore: self startIndex - 1
! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 3/22/2013 11:07'!
compareToClipboard
	"Check to see if whether the receiver's text is the same as the text currently on the clipboard, and inform the user."
	| s1 s2 |
	s1 := self clipboardText string.
	s2 := self string.
	s1 = s2 ifTrue: [^ self inform: 'Exact match'].

	(StringHolder new textContents:
		(TextDiffBuilder buildDisplayPatchFrom: s1 to: s2))
		openLabel: 'Comparison to Clipboard Text'! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 4/19/2013 14:34'!
copySelection
	"Copy the current selection and store it in the paste buffer, unless a caret.  Undoer & Redoer: undoCutCopy"

	self lineSelectAndEmptyCheck: [^ self].
	self clipboardTextPut: self selection.
	self editingState previousInterval: self selectionInterval.
! !

!RubTextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 3/22/2013 11:07'!
copyHiddenInfo
	"In TextLinks, TextDoits, TextColor, and TextURLs, there is hidden
info.  Copy that to the clipboard.  You can paste it and see what it is.
Usually enclosed in <>."

	^ self clipboardTextPut: self hiddenInfo asText! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 3/22/2013 11:07'!
string

	^self text string! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 6/1/2013 10:15'!
replaceTextFrom: start to: stop with: aText
	self replace: (start to: stop - 1) with: aText and: []
! !

!RubTextEditor methodsFor: 'new selection' stamp: 'AlainPlantec 3/22/2013 11:07'!
insertAndSelect: aString at: anInteger

	self replace: (anInteger to: anInteger - 1)
		with: (Text string: (' ' , aString)
					attributes: self emphasisHere)
		and: [self ]! !

!RubTextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 3/22/2013 11:07'!
chooseColor
	"Make a new Text Color Attribute, let the user pick a color, and return the attribute"

	| attribute |	
	attribute := TextColor color: Color black "default".
	UIManager default chooseColor
		ifNotNil: [:nc | attribute color: nc].
	^ attribute
! !

!RubTextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 3/22/2013 11:07'!
redo: aKeyboardEvent 
	"Redo the last edit."

	self redo.
	^true! !

!RubTextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 5/6/2013 09:55'!
storeSelectionInText
	self theme currentSettings haveSelectionTextColor 
		ifTrue: [
			self text removeAttribute: RubTextSelectionColor primarySelection.
			self text addAttribute: RubTextSelectionColor primarySelection from: self startIndex to: self stopIndex - 1]! !

!RubTextEditor methodsFor: 'new selection' stamp: 'AndreiChis 1/14/2015 12:19'!
highlightInterval: anInterval

	self textArea 
		ensureAndGetNewHighlightSegmentFrom: anInterval first 
		to: anInterval last + 1.! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 3/22/2013 11:07'!
nextCharacterIfAbsent: aBlock

	^ self text at: self startIndex ifAbsent: aBlock! !

!RubTextEditor methodsFor: 'private' stamp: 'AlainPlantec 3/22/2013 11:08'!
findText: aString isRegex: isRegex entireWordsOnly: entireWordsOnly
	self findReplaceService findText: aString isRegex: isRegex entireWordsOnly: entireWordsOnly
! !

!RubTextEditor methodsFor: 'private' stamp: 'AlainPlantec 3/22/2013 11:08'!
indent: delta fromStream: inStream toStream: outStream
	"Append the contents of inStream to outStream, adding or deleting delta or -delta
	 tabs at the beginning, and after every CR except a final CR.  Do not add tabs
	 to totally empty lines, and be sure nothing but tabs are removed from lines."

	| ch skip cr tab prev atEnd |
	cr := Character cr.
	tab := Character tab.
	delta > 0
		ifTrue: "shift right"
			[prev := cr.
			 [ch := (atEnd := inStream atEnd) ifTrue: [cr] ifFalse: [inStream next].
			  (prev == cr and: [ch ~~ cr]) ifTrue:
				[delta timesRepeat: [outStream nextPut: tab]].
			  atEnd]
				whileFalse:
					[outStream nextPut: ch.
					prev := ch]]
		ifFalse: "shift left"
			[skip := delta. "a negative number"
			 [inStream atEnd] whileFalse:
				[((ch := inStream next) == tab and: [skip < 0]) ifFalse:
					[outStream nextPut: ch].
				skip := ch == cr ifTrue: [delta] ifFalse: [skip + 1]]]! !

!RubTextEditor methodsFor: 'typing support' stamp: 'AlainPlantec 3/22/2013 11:08'!
setEmphasisHereFromText

	self setEmphasisHereFromTextForward: true! !

!RubTextEditor methodsFor: 'nonediting/nontyping keys' stamp: 'AlainPlantec 5/17/2013 01:19'!
cursorHome: aKeyboardEvent
	"Private - Move cursor from position in current line to beginning of
	current line. If control key is pressed put cursor at beginning of text"

	| string |
	string := self string.
	self
		moveCursor: [ :position | (string lastIndexOf: Character cr startingAt: position - 1 ifAbsent: [ 0 ]) + 1 ]
		forward: false
		specialBlock: [ :dummy | 1 ]
		event: aKeyboardEvent.
	^ true! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 3/22/2013 11:07'!
findAgainAndReplace
	"Find the text-to-find again and eventually replace it with the current replace text."
	| where |
	where := self findAgain.
	where isNil
		ifFalse: [self findReplaceService replaceText 
				ifNotEmpty: [:rt | self replaceSelectionWith: rt]]
! !

!RubTextEditor methodsFor: 'obsolete-parenblinking' stamp: 'AlainPlantec 4/6/2013 00:49'!
blinkPrevParen: aCharacter
	"kept because NECController is sending it to me"! !

!RubTextEditor methodsFor: 'private' stamp: 'TudorGirba 6/27/2014 00:09'!
previousWord: position
	| string index  initialIsAlphaNumeric |
	string := self string.
	index := position.
	position <= 1 ifTrue: [ ^ position ].
	initialIsAlphaNumeric := (string at: index) isAlphaNumeric.
	[index := index - 1] doWhileTrue:
		[(index > 0) and: [(string at: index) isAlphaNumeric = initialIsAlphaNumeric]].
	^ index + 1! !

!RubTextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 5/7/2013 09:50'!
pointIndex
	^ textArea pointIndex! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 4/3/2013 09:59'!
clipboardTextPut: text

	^ Clipboard clipboardText: text! !

!RubTextEditor methodsFor: 'nonediting/nontyping keys' stamp: 'AlainPlantec 4/3/2013 10:00'!
cursorUp: aKeyboardEvent 
"Private - Move cursor from position in current line to same position in
prior line. If prior line too short, put at end"

	self closeTypeIn.
	self
		moveCursor: [:position | self
				sameColumn: position
				newLine:[:line | line - 1]
				forward: false]
		forward: false
		specialBlock:[:dummy | dummy]
		event: aKeyboardEvent.
	^true! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:50'!
model
	^ textArea model! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 4/3/2013 09:59'!
paste
	"Paste the text from the shared buffer over the current selection and 
	redisplay if necessary.  Undoer & Redoer: undoAndReselect."

	self replace: self selectionInterval with: self clipboardText and:
		[self selectAt: self pointIndex]! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 00:55'!
currentUser
	^ self class currentUser
! !

!RubTextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 5/7/2013 09:50'!
pointBlock
	^ textArea pointBlock! !

!RubTextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 3/27/2013 23:15'!
shiftEnclose: aKeyboardEvent
	"Insert or remove bracket characters around the current selection."

	| char left right startIndex stopIndex oldSelection which text |
	char := aKeyboardEvent keyCharacter.
	char = $9 ifTrue: [ char := $( ].
	char = $, ifTrue: [ char := $< ].
	char asciiValue = 27 ifTrue: [ char := ${ ].	"ctrl-["

	self closeTypeIn.
	startIndex := self startIndex.
	stopIndex := self stopIndex.
	oldSelection := self selection.
	which := '([<{"''' indexOf: char ifAbsent: [1].
	left := '([<{"''' at: which.
	right := ')]>}"''' at: which.
	text := self text.
	((startIndex > 1 and: [stopIndex <= text size])
			and: [ (text at: startIndex-1) = left and: [(text at: stopIndex) = right]])
		ifTrue: [
			"already enclosed; strip off brackets"
			self selectFrom: startIndex-1 to: stopIndex.
			self replaceSelectionWith: oldSelection]
		ifFalse: [
			"not enclosed; enclose by matching brackets"
			self replaceSelectionWith:
				(Text string: (String with: left), oldSelection string, (String with: right) attributes: self emphasisHere).
			self selectFrom: startIndex+1 to: stopIndex].
	^true! !

!RubTextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 5/7/2013 09:50'!
swapChars: aKeyboardEvent
	"Triggered byCmd-Y;.  Swap two characters, either those straddling the insertion point, or the two that comprise the selection.  Suggested by Ted Kaehler.  "

	| currentSelection aString chars |
	(chars := self selection) size = 0
		ifTrue:
			[currentSelection := self pointIndex.
			self selectMark: currentSelection - 1 point: currentSelection]
		ifFalse:
			[chars size = 2
				ifFalse:
					[textArea flash. ^ true]
				ifTrue:
					[currentSelection := self pointIndex - 1]].
	aString := self selection string.
	self replaceSelectionWith: (Text string: aString reversed attributes: self emphasisHere).
	self selectAt: currentSelection + 1.
	^ true! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 16:32'!
textArea: atextArea
	textArea := atextArea.
	self resetState.! !

!RubTextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 5/7/2013 09:50'!
selectionStart
	^ textArea selectionStart! !

!RubTextEditor methodsFor: 'testing' stamp: 'AlainPlantec 5/7/2013 09:50'!
canChangeText
	^ textArea canChangeText! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 8/2/2013 15:18'!
cancel
	"Cancel the changes made so far to this text"
	textArea cancelEdits! !

!RubTextEditor methodsFor: 'keymapping' stamp: 'AlainPlantec 3/28/2013 19:21'!
cmdActions
	^ self defaultKeymappingIndex at: #command! !

!RubTextEditor methodsFor: 'new selection' stamp: 'AndreiChis 4/1/2015 12:56'!
atEndOfLineInsertAndSelect: aString

	self insertAndSelect: aString at: (self encompassParagraph: self selectionInterval) last + 1.! !

!RubTextEditor methodsFor: 'undoers-redoers' stamp: 'AlainPlantec 3/22/2013 11:08'!
undoRedoExchange: aninterval with: anotherInterval
	self selectInvisiblyFrom: aninterval first to: aninterval last.
	self exchangeWith: anotherInterval
! !

!RubTextEditor methodsFor: 'undoers-redoers' stamp: 'AlainPlantec 3/22/2013 11:08'!
undoTypeIn: aText interval: anInterval
	self selectInterval: anInterval.
	self replace: anInterval with: aText and:
		[self selectInterval: (anInterval first to: anInterval first - 1)].
! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:50'!
visibleHeight

	^textArea owner bounds height
! !

!RubTextEditor methodsFor: 'new selection' stamp: 'AlainPlantec 4/3/2013 10:00'!
selectInvisiblyAt: characterIndex 
	"Place the caret before the character at characterIndex.
	 Be sure it is in view but vithout any further action."
	
	self selectInvisiblyFrom: characterIndex to:  characterIndex - 1
! !

!RubTextEditor methodsFor: 'obsolete-parenblinking' stamp: 'AlainPlantec 4/6/2013 00:50'!
blinkParenAt: parenLocation 
	"kept because NECController is sending it to me"! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:50'!
morph
	^ textArea! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 4/11/2013 09:48'!
closingDelimiters
	^ ')]}'
! !

!RubTextEditor methodsFor: 'testing' stamp: 'AlainPlantec 3/22/2013 11:07'!
isTextEditor
	^ true ! !

!RubTextEditor methodsFor: 'find-select' stamp: 'AlainPlantec 3/22/2013 11:07'!
findText
	^ self findReplaceService findText! !

!RubTextEditor methodsFor: 'new selection' stamp: 'AlainPlantec 4/19/2013 11:34'!
selectInvisiblyFrom: start to: stop
	"Select the designated characters, inclusive.  Make no visual changes."

	self markIndex: start pointIndex: stop + 1! !

!RubTextEditor methodsFor: 'find-select' stamp: 'AlainPlantec 4/4/2013 00:05'!
findAndSelectNextOccurenceOf: aRegex
	| where |
	where := self findNext: aRegex startingAt: self stopIndex.
	where ifNotNil: [self selectInterval: where].
	^ where! !

!RubTextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 4/3/2013 09:59'!
cut: aKeyboardEvent 
	"Cut out the current text selection."

	self cut.
	^true! !

!RubTextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 4/3/2013 09:59'!
copySelection: aKeyboardEvent
	"Copy the current text selection."

	self copySelection.
	^true! !

!RubTextEditor methodsFor: 'nonediting/nontyping keys' stamp: 'AlainPlantec 3/22/2013 11:07'!
setSearchString: aKeyboardEvent
	"Establish the current selection as the current search string."
	^ self setSearchString! !

!RubTextEditor methodsFor: 'find-select' stamp: 'AlainPlantec 3/22/2013 11:07'!
findAll: aRegex startingAt: searchIdx 
	| ranges |
	ranges := aRegex matchingRangesIn: (self string copyFrom: searchIdx to: self string size).
	^ ranges collect: [:i | i + searchIdx - 1]
			! !

!RubTextEditor methodsFor: 'undo-redo private' stamp: 'AlainPlantec 5/7/2013 09:50'!
addTypeInUndoRecord
	| begin stop undoText redoText |
	begin := self startOfTyping min: self stopIndex. 
	stop := self stopIndex max: self startOfTyping.
	self editingState previousInterval: (begin to: stop - 1). 
	undoText := self nullText.
	redoText := stop > begin
			ifTrue: [self text copyFrom: begin to: stop - 1]
			ifFalse: [self nullText].
	((undoText isEmpty and: [redoText isEmpty]) and: [self editingState previousInterval size < 1])
			ifFalse: [self 
				redoArray: { textArea. #redoTypeIn:interval:.  {redoText. begin to: begin + self selection size - 1} } 
				undoArray: {textArea. #undoTypeIn:interval:.  {undoText. begin to: stop - 1} }].
	
! !

!RubTextEditor methodsFor: 'private' stamp: 'AlainPlantec 5/7/2013 09:50'!
paragraph
	^ textArea paragraph! !

!RubTextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 3/22/2013 11:07'!
hiddenInfo
	"In TextLinks, TextDoits, TextColor, and TextURLs, there is hidden info.  Return the entire string that was used by Cmd-6 to create this text attribute.  Usually enclosed in < >."

	| attrList |
	attrList := self text attributesAt: (self pointIndex + self markIndex)//2.
	attrList do: [:attr |
		attr forTextActionInfoDo: [ :info |
			^ self selection asString, '<', info, '>']].
	"If none of the above"
	attrList do: [:attr |
		attr forTextColorDo: [ :color |
			^ self selection asString, '<', color printString, '>']].
	^ self selection asString, '[No hidden info]'! !

!RubTextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 5/7/2013 09:50'!
selectionStop
	^ textArea selectionStop! !

!RubTextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 4/6/2013 02:35'!
oppositeDelimiterSelection
	^ RubTextSelectionColor oppositeDelimiterSelection! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 3/22/2013 11:07'!
changeEmphasisOrAlignment
	| aList reply  code align menuList startIndex attribute |
	startIndex := self startIndex.
	align := self text alignmentAt: startIndex ifAbsent: [ 0 ].
	code := self text emphasisAt: startIndex.
	menuList := WriteStream on: Array new.
	menuList nextPut: (code isZero -> 'normal' translated).
	menuList nextPutAll: (#(bold italic underlined struckOut) collect: [:emph|
		(code anyMask: (TextEmphasis perform: emph) emphasisCode) -> emph asString translated]).
	
	menuList nextPut: ((self text attributesAt: startIndex)
		anySatisfy: [ :attr | attr isKern and: [attr kern < 0 ]]) -> 'narrow' translated.
		
	self alignmentChoices collectWithIndex: [ :type :i |
		menuList nextPut: (align = (i-1)) -> type asString translated ].
	
	aList := #(normal bold italic underlined struckOut narrow leftFlush centered rightFlush justified).
	reply := UIManager default chooseFrom:  aList values: aList.
	reply notNil ifTrue: [
		(self alignmentChoices includes: reply)
			ifTrue: [ attribute :=TextAlignment perform: reply]
			ifFalse: [ attribute := TextEmphasis perform: reply].
		self applyAttribute:  attribute].
	^ true! !

!RubTextEditor methodsFor: 'nonediting/nontyping keys' stamp: 'AlainPlantec 4/3/2013 10:00'!
cursorRight: aKeyboardEvent 
	"Private - Move cursor right one character if nothing selected, 
	otherwise move cursor to end of selection. If the shift key is down, 
	start selecting characters or extending already selected characters. 
	Don't allow cursor past end of text"

	self closeTypeIn.
	self
		moveCursor: [:position | position + 1]
		forward: true
		specialBlock:[:position | self nextWord: position]
		event: aKeyboardEvent.
	^ true! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 5/7/2013 09:50'!
accept
	"Save the current text of the text being edited as the current acceptable version for purposes of canceling.  Allow my morph to take appropriate action"
	self canChangeText 
		ifTrue: [textArea acceptContents]! !

!RubTextEditor methodsFor: 'undo-redo private' stamp: 'AlainPlantec 3/22/2013 11:08'!
exploreUndoManager: aKeyboardEvent
	^ self editingState exploreUndoManager: aKeyboardEvent! !

!RubTextEditor methodsFor: 'private' stamp: 'AlainPlantec 4/3/2013 10:01'!
setIndices: shiftPressed forward: forward
	"Little helper method that sets the moving and fixed indices according to some flags."
	| indices |
	indices := Dictionary new.
	self flag: 'to be reviewed'.
	(shiftPressed)
		ifTrue: [
			indices at: #moving put: self pointIndex.
			indices at: #fixed put: self markIndex
		] ifFalse: [
			forward
				ifTrue:[
					indices at: #moving put: self stopIndex.
					indices at: #fixed put: self startIndex.
				] ifFalse: [
					indices at: #moving put: self startIndex.
					indices at: #fixed put: self stopIndex.
				]
		].
	^indices! !

!RubTextEditor methodsFor: 'events' stamp: 'AlainPlantec 4/22/2013 01:56'!
tripleClick: evt
	self closeTypeIn.	"no matter what, if shift is pressed extend the selection"
	self selectLine.
	self setEmphasisHereFromText.
	self storeSelectionInText.! !

!RubTextEditor methodsFor: 'accessing-selection' stamp: 'AndreiChis 1/14/2015 11:53'!
getHighlightInterval
	"Answer the interval that is or should be highligted."

	^ self hasSelection 
		ifTrue: [ self selectionInterval ]
		ifFalse: [ self computeSelectionIntervalForCurrentLine ]! !

!RubTextEditor methodsFor: 'find-select' stamp: 'AlainPlantec 3/22/2013 11:07'!
findText: aStringOrText
	self findReplaceService findText: aStringOrText ! !

!RubTextEditor methodsFor: 'typing support' stamp: 'AlainPlantec 3/22/2013 11:08'!
doneTyping
	self startOfTyping: nil! !

!RubTextEditor methodsFor: 'new selection' stamp: 'AlainPlantec 4/19/2013 15:14'!
selectWord
	"Select delimited text or word--the result of double-clicking."

	| openDelimiter closeDelimiter direction match level leftDelimiters rightDelimiters
	string here hereChar start stop |
	string := self string.
	here := self pointIndex.
	(here between: 2 and: string size)
		ifFalse: ["if at beginning or end, select entire string"
			^self selectLine].
	leftDelimiters := '([{<''"
'.
	rightDelimiters := ')]}>''"
'.
	openDelimiter := string at: here - 1.
	match := leftDelimiters indexOf: openDelimiter.
	match > 0
		ifTrue: 
			["delimiter is on left -- match to the right"
			start := here.
			direction := 1.
			here := here - 1.
			closeDelimiter := rightDelimiters at: match]
		ifFalse: 
			[openDelimiter := string at: here.
			match := rightDelimiters indexOf: openDelimiter.
			match > 0
				ifTrue: 
					["delimiter is on right -- match to the left"
					stop := here - 1.
					direction := -1.
					closeDelimiter := leftDelimiters at: match]
				ifFalse: ["no delimiters -- select a token"
					direction := -1]].
	level := 1.
	[level > 0 and: [direction > 0
			ifTrue: [here < string size]
			ifFalse: [here > 1]]]
		whileTrue: 
			[hereChar := string at: (here := here + direction).
			match = 0
				ifTrue: ["token scan goes left, then right"
					hereChar tokenish
						ifTrue: [here = 1
								ifTrue: 
									[start := 1.
									"go right if hit string start"
									direction := 1]]
						ifFalse: [direction < 0
								ifTrue: 
									[start := here + 1.
									"go right if hit non-token"
									direction := 1]
								ifFalse: [level := 0]]]
				ifFalse: ["bracket match just counts nesting level"
					hereChar = closeDelimiter
						ifTrue: [level := level - 1"leaving nest"]
						ifFalse: [hereChar = openDelimiter 
									ifTrue: [level := level + 1"entering deeper nest"]]]].

	level > 0 ifTrue: ["in case ran off string end"	here := here + direction].
	direction > 0
		ifTrue: [self selectFrom: start to: here - 1]
		ifFalse: [self selectFrom: here + 1 to: stop]! !

!RubTextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 3/22/2013 11:07'!
makeUppercase: aKeyboardEvent
	"Force the current selection to uppercase.  Triggered by Cmd-Y."

	self closeTypeIn.
	self replaceSelectionWith: (Text fromString: (self selection string asUppercase)).
	^ true! !

!RubTextEditor methodsFor: 'private' stamp: 'AlainPlantec 5/7/2013 09:50'!
unplug
	textArea := nil.
	super unplug! !

!RubTextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 3/22/2013 11:07'!
align: aKeyboardEvent
	"Triggered by Cmd-u;  cycle through alignment alternatives."

	self align.
	^ true! !

!RubTextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 3/27/2013 22:54'!
swapChars
	"Triggered byCmd-Y;.  Swap two characters, either those straddling the insertion point, or the two that comprise the selection.  Suggested by Ted Kaehler.  "

	^ self swapChars: nil! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:50'!
transformFrom: owner
	^textArea transformFrom: owner! !

!RubTextEditor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 4/3/2013 10:06'!
lf: aKeyboardEvent 
	"Append a line feed character to the stream of characters."

	self addString: Character lf asString.
	^false! !

!RubTextEditor methodsFor: 'constants' stamp: 'AlainPlantec 3/22/2013 11:07'!
alignmentChoices
	"Return the symbols representing the TextAlignment operations to get a text aligned."
	
	^ #(leftFlush centered justified rightFlush)! !

!RubTextEditor methodsFor: 'accessing' stamp: 'TudorGirba 8/1/2014 21:03'!
textArea
	^ textArea! !

!RubTextEditor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 4/3/2013 10:06'!
backWord: aKeyboardEvent
	"If the selection is not a caret, delete it and leave it in the backspace buffer.
	 Else, delete the word before the caret."

	| startIndex |
	self hasCursor ifTrue: [ "a caret, delete at least one character"
		startIndex := 1 max: self markIndex - 1.
		[startIndex > 1 and:
			[(self string at: startIndex - 1) tokenish]]
				whileTrue: [
					startIndex := startIndex - 1]]
	ifFalse: [ "a non-caret, just delete it"
		startIndex := self markIndex].
	self backTo: startIndex.
	^false! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:50'!
emphasisHere
	^ textArea emphasisHere! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 3/22/2013 11:07'!
currentCharacterStyleOrNil
	"Answer the CharacterStyle for the current selection or cursor location if any"

	^self hasSelection
		ifTrue: [ self text characterStyleOrNilAt: self startIndex ]
		ifFalse: [ self text characterStyleOrNilIfApplying: self emphasisHere ]! !

!RubTextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 5/7/2013 09:50'!
redo
	"redo previous edit"

	self editingState redo ifFalse: [textArea flash]. 
! !

!RubTextEditor methodsFor: 'nonediting/nontyping keys' stamp: 'AlainPlantec 3/22/2013 11:07'!
selectCurrentTypeIn: aKeyboardEvent 
	"Select what would be replaced by an undo (e.g., the last typeIn)."

	self closeTypeIn.
	self selectInterval: self editingState previousInterval.
	^ true! !

!RubTextEditor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 4/3/2013 10:05'!
normalCharacter: aKeyboardEvent 
	"A nonspecial character is to be added to the stream of characters."

	self hasSelection 
		ifTrue: [self addDeleteSelectionUndoRecord].
	self addString: aKeyboardEvent keyCharacter asString.
	^false! !

!RubTextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 5/7/2013 09:50'!
stopIndex
	^ textArea stopIndex! !

!RubTextEditor methodsFor: 'private' stamp: 'AlainPlantec 5/18/2013 00:22'!
applyAttribute: aTextAttribute
	"The user selected aTextAttribute via shortcut, menu or other means.
	If there is a selection, apply the attribute to the selection.
	In any case use the attribute for the user input (emphasisHere)"

	self editingState emphasisHere: (Text addAttribute: aTextAttribute toArray: self emphasisHere).
	self selection
		ifNotEmpty: [:s | self replaceSelectionWith: (s addAttribute: aTextAttribute)].
	self compose.
	self recomputeSelection! !

!RubTextEditor methodsFor: 'private' stamp: 'AlainPlantec 4/26/2013 00:49'!
completionAround:  aBlock keyStroke: anEvent
	" No code completion for simple text editor, so nothing special to do here around the block execution"
	aBlock value! !

!RubTextEditor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 3/22/2013 11:53'!
crWithIndent: aKeyboardEvent
	"Replace the current text selection with CR followed by as many tabs
	as on the current line (+/- bracket count) -- initiated by Shift-Return."
	| char s i tabCount crChars|
	self closeTypeIn.
	s := self string.
	i := self stopIndex.
	tabCount := 0.
	crChars := Array with: Character cr with: Character lf.
	[(i := i-1) > 0 and: [(crChars includes: (char := s at: i)) not]]
		whileTrue:  "Count tabs and brackets (but not a leading bracket)"
		[(char = Character tab and: [i < s size and: [(s at: i+1) ~= $[ ]]) ifTrue: [tabCount := tabCount + 1].
		char = $[ ifTrue: [tabCount := tabCount + 1].
		char = $] ifTrue: [tabCount := tabCount - 1]].
	 "Now inject CR with tabCount tabs"
	self addString: (String streamContents: [ :strm | strm crtab: tabCount ]).
	^ false! !

!RubTextEditor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 4/3/2013 10:06'!
cursorTopHome: aKeyboardEvent
	"Put cursor at beginning of text -- invoked from cmd-H shortcut, useful for keyboards that have no home key."

	self selectAt: 1.
	^ true! !

!RubTextEditor methodsFor: 'typing support' stamp: 'AlainPlantec 5/7/2013 15:19'!
backTo: startIndex
	"Backspace typing"
	self stopIndex > startIndex ifTrue: [
		self selectFrom: startIndex to: self stopIndex - 1.
		self addDeleteSelectionUndoRecord.
		self zapSelectionWith: self nullText].
	^ false! !

!RubTextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 4/3/2013 09:57'!
selectionInterval
	"Answer the interval that is currently selected."

	^self startIndex to: self stopIndex - 1 ! !

!RubTextEditor methodsFor: 'nonediting/nontyping keys' stamp: 'AlainPlantec 4/3/2013 10:00'!
cursorPageDown: aKeyboardEvent 

	self closeTypeIn.
	self 
		moveCursor: [:position |
			self
				sameColumn: position
				newLine: [:lineNo | lineNo + self pageHeight]
				forward: true]
		forward: true
		specialBlock:[:dummy | dummy]
		event: aKeyboardEvent.
	^true! !

!RubTextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 3/26/2013 15:24'!
hasSelection
	^ self pointIndex ~= self markIndex! !

!RubTextEditor methodsFor: 'private' stamp: 'AlainPlantec 4/4/2013 13:44'!
focusChanged
	"Nothing to do by default"! !

!RubTextEditor methodsFor: 'find-select' stamp: 'AlainPlantec 4/19/2013 19:19'!
replaceAll: aRegex with: aText startingAt: startIdx
	self
		undoRedoTransaction: [ 
			| selec ranges |
			selec := self selectionInterval.
			ranges := self findAll: aRegex startingAt: startIdx.
			ranges
				reverseDo: [ :r | 
					self selectInvisiblyFrom: r first to: r last.
					self replaceSelectionWith: aText ].
			self selectInterval: selec ]! !

!RubTextEditor methodsFor: 'accessing-selection' stamp: 'AndreiChis 1/14/2015 11:53'!
highlightedTextAsStream
	"Answer a ReadStream on the text in the paragraph that is currently highlighted."

	| highlightedInterval |
	highlightedInterval := self getHighlightInterval.
	^ (self string copyFrom: highlightedInterval first to: highlightedInterval last) readStream! !

!RubTextEditor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 4/3/2013 10:06'!
backWord
	"If the selection is not a caret, delete it and leave it in the backspace buffer.
	 Else, delete the word before the caret."
	^ self backWord: nil
! !

!RubTextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 5/7/2013 09:50'!
startIndex
	^ textArea startIndex! !

!RubTextEditor methodsFor: 'testing' stamp: 'AlainPlantec 4/3/2013 10:01'!
hasError
	^ false ! !

!RubTextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 3/27/2013 14:07'!
fontToUse
	^ self text fontAt: self startIndex! !

!RubTextEditor methodsFor: 'private' stamp: 'AlainPlantec 3/22/2013 11:08'!
isDisjointFrom: anInterval
	"Answer true if anInterval is a caret not touching or within the current
	 interval, or if anInterval is a non-caret that does not overlap the current
	 selection."

	| fudge |
	fudge := anInterval size = 0 ifTrue: [1] ifFalse: [0].
	^(anInterval last + fudge < self startIndex or:
			[anInterval first - fudge >= self stopIndex])
! !

!RubTextEditor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 3/22/2013 11:08'!
search: aKeyboardEvent
	"Invoked by Ctrl-S.  Same as 'again', but always uses the existing findText
	 from current FindReplaceService"

	self closeTypeIn.
	self findAgain.
	^true! !

!RubTextEditor class methodsFor: 'keymapping' stamp: 'TudorGirba 7/2/2014 09:51'!
buildPatchShortcutsForSelectAllInWindowsOn: aBuilder
	<keymap>
	"this is because for some reason Ctrl+a means Ctrl+home on Windows"
	(aBuilder shortcut: #selectAllPatchForWin) 
		category: RubTextEditor name
		default: Character home ctrl win
		do: [ :target | target editor selectAll: nil ]
		description: 'Select all'
! !

!RubTextEditor class methodsFor: 'keymapping' stamp: 'TudorGirba 7/2/2014 15:16'!
buildShortcutsOn: aBuilder
	"We are defining the bindings twice because we want to support 
	both Cmd and Ctrl for Windows and Linux. This should happen at least as long as in the development environment
	both of these are supported.
	
	We list both variations explicitly because we want to be able to see the action code when inspecting the morph.
	"
	<keymap>
	(aBuilder shortcut: #cancel) 
		category: RubTextEditor name
		default: $l ctrl
		do: [ :target | target editor cancel ]
		description: 'Cancel unsaved editings'.
	(aBuilder shortcut: #cancelCommand) 
		category: RubTextEditor name
		default: $l command
		do: [ :target | target editor cancel ]
		description: 'Cancel unsaved editings'.
		
	(aBuilder shortcut: #accept) 
		category: RubTextEditor name
		default: $s ctrl
		do: [ :target | target editor accept ]
		description: 'Accept unsaved editings'.
	(aBuilder shortcut: #acceptCommand) 
		category: RubTextEditor name
		default: $s command
		do: [ :target | target editor accept ]
		description: 'Accept unsaved editings'.

	(aBuilder shortcut: #selectAll) 
		category: RubTextEditor name
		default: $a ctrl
		do: [ :target | target editor selectAll: nil ]
		description: 'Select all'.
	(aBuilder shortcut: #selectAllCommand) 
		category: RubTextEditor name
		default: $a command
		do: [ :target | target editor selectAll: nil ]
		description: 'Select all'.

	(aBuilder shortcut: #copySelection) 
		category: RubTextEditor name
		default: $c ctrl
		do: [ :target | target editor copySelection ]
		description: 'Copy selection'.
	(aBuilder shortcut: #copySelectionCommand) 
		category: RubTextEditor name
		default: $c command
		do: [ :target | target editor copySelection ]
		description: 'Copy selection'.

	(aBuilder shortcut: #paste) 
		category: RubTextEditor name
		default: $v ctrl
		do: [ :target | target editor paste ]
		description: 'Paste'.
	(aBuilder shortcut: #pasteCommand) 
		category: RubTextEditor name
		default: $v command
		do: [ :target | target editor paste ]
		description: 'Paste'.


	(aBuilder shortcut: #cut) 
		category: RubTextEditor name
		default: $x ctrl
		do: [ :target | target editor cut ]
		description: 'Cut selection'.
	(aBuilder shortcut: #cutCommand) 
		category: RubTextEditor name
		default: $x command
		do: [ :target | target editor cut ]
		description: 'Cut selection'.

	(aBuilder shortcut: #undo) 
		category: RubTextEditor name
		default: $z ctrl
		do: [ :target | target editor undo ]
		description: 'Undo'.
	(aBuilder shortcut: #undoCommand) 
		category: RubTextEditor name
		default: $z command
		do: [ :target | target editor undo ]
		description: 'Undo'.

	(aBuilder shortcut: #redo) 
		category: RubTextEditor name
		default: $z shift ctrl
		do: [ :target | target editor redo ]
		description: 'Redo'.
	(aBuilder shortcut: #redoCommand) 
		category: RubTextEditor name
		default: $z shift command
		do: [ :target | target editor redo ]
		description: 'Redo'.

	(aBuilder shortcut: #find) 
		category: RubTextEditor name
		default: $f ctrl
		do: [ :target | target editor find: nil ]
		description: 'Find text'.
	(aBuilder shortcut: #find) 
		category: RubTextEditor name
		default: $f command
		do: [ :target | target editor find: nil ]
		description: 'Find text'.

	(aBuilder shortcut: #findAgain) 
		category: RubTextEditor name
		default: $g ctrl
		do: [ :target | target editor findAgain: nil ]
		description: 'Find text again'.
	(aBuilder shortcut: #findAgainCommand) 
		category: RubTextEditor name
		default: $g command 
		do: [ :target | target editor findAgain: nil ]
		description: 'Find text again'.
		
	(aBuilder shortcut: #indent) 
		category: RubTextEditor name
		default: $r shift ctrl
		do: [ :target | target editor indent: nil ]
		description: 'Indent'.
	(aBuilder shortcut: #indentCommand) 
		category: RubTextEditor name
		default: $r shift command
		do: [ :target | target editor indent: nil ]
		description: 'Indent'.

	(aBuilder shortcut: #outdent) 
		category: RubTextEditor name
		default: $l shift ctrl
		do: [ :target | target editor outdent: nil ]
		description: 'Outdent'.
	(aBuilder shortcut: #outdentCommand) 
		category: RubTextEditor name
		default: $l shift command
		do: [ :target | target editor outdent: nil ]
		description: 'Outdent'.
! !

!RubTextEditor class methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 00:54'!
currentUser
	^ self userManager currentUser
! !

!RubTextEditor class methodsFor: 'accessing' stamp: 'AlainPlantec 5/20/2014 22:41'!
userManager
	^ (Smalltalk at: #UserManager ifAbsent: [ Smalltalk at: #UsersManager ]) default! !

!RubTextEditor class methodsFor: 'instance creation' stamp: 'AlainPlantec 5/20/2014 22:41'!
forTextArea: aMorph
	^ self new textArea: aMorph! !

!RubTextFieldArea methodsFor: 'settings' stamp: 'AlainPlantec 5/8/2013 20:41'!
walkAlongDisplayedLine
	^ false! !

!RubTextFieldArea methodsFor: 'private' stamp: 'AndreiChis 1/16/2015 13:34'!
privateReplaceFrom: start to: stop with: aText
	| newText  |
	newText := aText.
	" it is possible to have cr in case of copy-paste "
	(aText string includesAnyOf: {(Character cr). (Character lf)})
		ifTrue: [ 
			newText := newText asString copyReplaceAll: String cr with: '' asTokens: false.
			newText := (newText asString copyReplaceAll: String lf with: '' asTokens: false) asText ].
	super privateReplaceFrom: start to: stop with: newText! !

!RubTextFieldArea methodsFor: 'event handling' stamp: 'AlainPlantec 5/10/2013 07:37'!
keyStroke: evt
	evt keyValue = Character cr asciiValue
		ifTrue: [ 
			| answer |
			self announce: (answer := RubReturnEntered morph: self).
			answer accepted
				ifTrue: [ self editor textWasAccepted ] ]
		ifFalse: [ super keyStroke: evt ]! !

!RubTextFieldArea methodsFor: 'defaults' stamp: 'AlainPlantec 5/14/2013 23:27'!
defaultMargins
	^ 2 @ 2 corner: 2 @ 4! !

!RubTextFieldArea methodsFor: 'private' stamp: 'AlainPlantec 5/21/2013 09:35'!
newParagraph
	^ RubExtraSelectionDecorator next: super newParagraph
! !

!RubTextFieldExample commentStamp: '<historical>'!
self open.

self openWithScrollbar.

self openWithBorderOfWidth: 1.
self openWithBorderOfWidth: 5.

self openWithScrollbarAndBorderOfWidth: 0.
self openWithScrollbarAndBorderOfWidth: 1.
self openWithScrollbarAndBorderOfWidth: 5.

self openAutoAccept.!
!RubTextFieldExample methodsFor: 'user interface' stamp: 'AlainPlantec 4/26/2013 16:53'!
newScrolledTextWithScrollbarAndBorderOfWidth: anInteger
	^ self newScrolledText hScrollbarShowAlways; borderWidth: anInteger! !

!RubTextFieldExample methodsFor: 'accessing' stamp: 'AlainPlantec 4/26/2013 12:16'!
announcer
	^ announcer ifNil: [ announcer := Announcer new ]! !

!RubTextFieldExample methodsFor: 'user interface' stamp: 'AlainPlantec 4/26/2013 14:00'!
newScrolledTextWithScrollbar
	^ self newScrolledText hScrollbarShowAlways! !

!RubTextFieldExample methodsFor: 'menu' stamp: 'AndreiChis 5/21/2014 17:45'!
menu
	^ nil! !

!RubTextFieldExample methodsFor: 'accessing' stamp: 'AlainPlantec 4/26/2013 12:16'!
string: aString
	string := aString! !

!RubTextFieldExample methodsFor: 'accessing' stamp: 'AlainPlantec 4/26/2013 12:16'!
acceptString: aString
	self string: aString.
	^ true! !

!RubTextFieldExample methodsFor: 'user interface' stamp: 'AlainPlantec 4/26/2013 12:16'!
getText
	^ self string asText! !

!RubTextFieldExample methodsFor: 'user interface' stamp: 'AlainPlantec 2/5/2014 10:33'!
newScrolledText
	| st |
	st := (RubTextFieldMorph
		on: self)
		withAdornment;
		withGhostText: 'Input field bla bla bla bla bla bla';
		yourself.
	st width: 300.
	^st! !

!RubTextFieldExample methodsFor: 'accessing' stamp: 'AlainPlantec 4/26/2013 12:16'!
string
	^ string ifNil: [ string := '' ]! !

!RubTextFieldExample methodsFor: 'user interface' stamp: 'AlainPlantec 6/2/2013 12:44'!
setText: aText from: aView 
	^ self acceptString: aText string! !

!RubTextFieldExample methodsFor: 'user interface' stamp: 'AlainPlantec 5/10/2013 08:05'!
newScrolledTextAutoAccept
	| st |
	st := (RubTextFieldMorph
		on: self)
		withAdornment;
		withGhostText: 'Input field bla bla bla bla bla bla';
		autoAccept: true;
		yourself.
	st width: 300.
	^st! !

!RubTextFieldExample methodsFor: 'user interface' stamp: 'AlainPlantec 4/26/2013 16:53'!
newScrolledTextWithBorderOfWidth: anInteger
	^ self newScrolledText borderWidth: anInteger.! !

!RubTextFieldExample class methodsFor: 'examples' stamp: 'AlainPlantec 5/7/2013 09:34'!
open
	| st |
	st := self new newScrolledText.
	self spyAnnouncer ifTrue: [st textArea announcer open].
 	st openInWorld
! !

!RubTextFieldExample class methodsFor: 'examples' stamp: 'AlainPlantec 5/7/2013 09:34'!
openAutoAccept
	| st model |
	model := self new.
	st := model newScrolledTextAutoAccept.
	model inspect.
	self spyAnnouncer ifTrue: [st textArea announcer open].
 	st openInWorld
! !

!RubTextFieldExample class methodsFor: 'examples' stamp: 'AlainPlantec 5/7/2013 09:34'!
openWithScrollbar
	| st |
	st := self new newScrolledTextWithScrollbar.
	self spyAnnouncer ifTrue: [st textArea announcer open].
 	st openInWorld
! !

!RubTextFieldExample class methodsFor: 'examples' stamp: 'AlainPlantec 5/7/2013 10:08'!
spyAnnouncer
	"Set it to true if you want to observe text area announcements"
	^ false! !

!RubTextFieldExample class methodsFor: 'examples' stamp: 'AlainPlantec 5/7/2013 09:34'!
openWithScrollbarAndBorderOfWidth: anInteger
	| st |
	st := self new newScrolledTextWithScrollbarAndBorderOfWidth: anInteger.
	self spyAnnouncer ifTrue: [st textArea announcer open].
 	st openInWorld
! !

!RubTextFieldExample class methodsFor: 'examples' stamp: 'AlainPlantec 5/7/2013 09:34'!
openWithBorderOfWidth: anInteger
	| st |
	st := self new newScrolledTextWithBorderOfWidth: anInteger.
	self spyAnnouncer ifTrue: [st textArea announcer open].
 	st openInWorld
! !

!RubTextFieldMorph methodsFor: 'initialize-release' stamp: 'AlainPlantec 5/10/2013 07:24'!
initialize
	super initialize.
	self textArea announcer subscribe: RubReturnEntered  send: #whenReturnEntered: to: self.
	self scrollbarsShowNever.
	self extent: self extent! !

!RubTextFieldMorph methodsFor: 'model protocol' stamp: 'AlainPlantec 5/7/2013 18:05'!
hasValidText: aBoolean
	hasValidText := aBoolean! !

!RubTextFieldMorph methodsFor: 'geometry' stamp: 'AlainPlantec 5/7/2013 17:27'!
extent: aPoint
	super extent: aPoint x @ self textFieldHeight! !

!RubTextFieldMorph methodsFor: 'initialize-release' stamp: 'AlainPlantec 5/9/2013 08:13'!
textAreaClass
	^ RubTextFieldArea! !

!RubTextFieldMorph methodsFor: 'event handling' stamp: 'AlainPlantec 5/10/2013 07:25'!
whenReturnEntered: anAnnouncement
	self announcer announce: anAnnouncement.
	self changed
! !

!RubTextFieldMorph methodsFor: 'geometry' stamp: 'AlainPlantec 5/7/2013 17:28'!
textFieldHeight
	| vgap |
	vgap := self currentHScrollBarThickness isZero
		ifTrue: [  0 ]
		ifFalse: [ self currentHScrollBarThickness - 1 ].
	^ self textArea height + (self borderWidth * 2) + vgap! !

!RubTextFieldMorph methodsFor: 'drawing' stamp: 'AlainPlantec 5/7/2013 18:06'!
adornmentColor
	"color to Indicate edit status for the given morph."

	self hasValidText
		ifFalse: [ ^ Color red ].
	^ super adornmentColor! !

!RubTextFieldMorph methodsFor: 'model protocol' stamp: 'AlainPlantec 5/7/2013 18:05'!
hasValidText
	^ hasValidText ifNil: [ hasValidText := true ] ! !

!RubTextFieldMorph methodsFor: 'private' stamp: 'AlainPlantec 5/7/2013 18:08'!
resetState
	hasValidText := nil.
	super resetState! !

!RubTextInsertionStrategy commentStamp: 'AndreiChis 10/1/2014 13:35'!
I insert the notification directly in the text at the given position. (I alter the content of the text editor)!
!RubTextInsertionStrategy methodsFor: 'as yet unclassified' stamp: 'TudorGirba 8/1/2014 18:58'!
notify: aString at: anInteger in: aStream 
	"The compilation of text failed. The syntax error is noted as the argument, 
	aString. Insert it in the text at starting character position anInteger."

	| pos |
	pos := self editor selectionInterval notEmpty
		ifTrue: [self editor startIndex + anInteger - 1 ]
		ifFalse: [anInteger].
	self editor insertAndSelect: aString at: (pos max: 1)! !

!RubTextLine methodsFor: 'scanning' stamp: 'AlainPlantec 3/17/2013 15:14'!
justifiedTabDeltaFor: spaceIndex 
	"Compute the delta for a tab in a line of justified text, so tab falls 
	somewhere plausible when line is justified."

	| pad extraPad |
	internalSpaces = 0 ifTrue: [^0].
	pad := paddingWidth // internalSpaces.
	extraPad := paddingWidth \\ internalSpaces.
	spaceIndex <= extraPad
		ifTrue: [^spaceIndex * (pad + 1)]
		ifFalse: [^extraPad * (pad + 1) + (spaceIndex - extraPad * pad)]! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:14'!
last
	^ lastIndex! !

!RubTextLine methodsFor: 'scanning' stamp: 'AlainPlantec 3/17/2013 15:14'!
justifiedPadFor: spaceIndex 
	"Compute the width of pad for a given space in a line of justified text."

	| pad |
	internalSpaces = 0 ifTrue: [^0].
	pad := paddingWidth // internalSpaces.
	spaceIndex <= (paddingWidth \\ internalSpaces)
		ifTrue: [^pad + 1]
		ifFalse: [^pad]! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:14'!
first
	^ firstIndex! !

!RubTextLine methodsFor: 'private' stamp: 'AlainPlantec 3/22/2013 22:50'!
internalSpaces: spacesInteger paddingWidth: padWidthInteger

	internalSpaces := spacesInteger asInteger.
	paddingWidth := padWidthInteger asInteger! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:14'!
left
	^ left! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:14'!
stop: stopInteger 
	"Set the stopping point in the string of the line to be stopInteger."

	lastIndex := stopInteger! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:14'!
lineHeight
	^ bottom - top! !

!RubTextLine methodsFor: 'scanning' stamp: 'AlainPlantec 3/17/2013 15:14'!
justifiedPadFor: spaceIndex font: aFont
	"Compute the width of pad for a given space in a line of justified text."

	| pad |
	internalSpaces = 0 ifTrue: [^0].
	^(aFont notNil and:[aFont isSubPixelPositioned])
		ifTrue:[paddingWidth * 1.0 / internalSpaces]
		ifFalse:[
			pad := paddingWidth // internalSpaces.
			spaceIndex <= (paddingWidth \\ internalSpaces)
				ifTrue: [pad + 1]
				ifFalse: [pad]]
		! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 4/22/2013 00:19'!
height
	^ self bottom - self top! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 3/29/2013 13:51'!
lineNumber: anInteger
	lineNumber := anInteger! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:14'!
internalSpaces: spacesInteger 
	"Set the number of spaces in the line to be spacesInteger."

	internalSpaces := spacesInteger! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:14'!
right
	^ right! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:14'!
baseline
	^ baseline! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:14'!
setRight: x
	right := x! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 4/2/2013 13:36'!
stopCondition: aSymbol
	stopCondition := aSymbol! !

!RubTextLine methodsFor: 'printing' stamp: 'AlainPlantec 3/17/2013 15:14'!
printOn: aStream
	super printOn: aStream.
	aStream space; print: firstIndex; nextPutAll: ' to: '; print: lastIndex! !

!RubTextLine methodsFor: 'private' stamp: 'AlainPlantec 3/17/2013 15:14'!
firstIndex: firstInteger lastIndex: lastInteger
	firstIndex := firstInteger.
	lastIndex := lastInteger! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 3/20/2013 11:26'!
actualWidth
	^ actualWidth ifNil: [ 0 ] "self right - self paddingWidth"! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 3/29/2013 13:51'!
lineNumber
	^ lineNumber! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:14'!
rectangle: lineRectangle
	left := lineRectangle left.
	right := lineRectangle right.
	top := lineRectangle top.
	bottom := lineRectangle bottom! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 3/22/2013 22:49'!
paddingWidth: padWidthInteger 
	"Set the amount of space to be added to the font to be padWidthInteger."

	paddingWidth := padWidthInteger asInteger! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:14'!
leftMargin
	"This has to get fixed -- store during composition"
	^ self left! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 3/22/2013 23:06'!
leftMarginForAlignment: alignmentCode
	alignmentCode = RightFlush ifTrue: [^ self left + paddingWidth].
	alignmentCode = Centered ifTrue: [^ self left + (paddingWidth//2)].
	^ self left  "leftFlush and justified"! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:14'!
rightMargin
	"This has to get fixed -- store during composition"
	^ self right! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:14'!
bottomRight
	^ right@bottom! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 3/19/2013 16:45'!
actualWidth: anObject
	actualWidth := anObject! !

!RubTextLine methodsFor: 'comparing' stamp: 'AlainPlantec 3/17/2013 15:14'!
hash
	"#hash is re-implemented because #= is re-implemented"
	^firstIndex hash bitXor: lastIndex hash! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:14'!
rectangle
	^ self topLeft corner: self bottomRight! !

!RubTextLine methodsFor: 'updating' stamp: 'AlainPlantec 3/20/2013 06:06'!
moveBy: delta 
	"Move my rectangle by the given delta"
	left := left + delta x.
	right := right + delta x.
	top := top + delta y.
	bottom := bottom + delta y.
! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:14'!
width
	^ right - left! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:14'!
top
	^ top! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 4/2/2013 13:36'!
stopCondition
	^ stopCondition! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:14'!
topLeft
	^ left @ top! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:14'!
bottom
	^ bottom! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 5/14/2013 22:10'!
bottomLeft
	^ left@bottom! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:14'!
paddingWidth
	"Answer the amount of space to be added to the font."

	^paddingWidth! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 5/14/2013 19:55'!
topRight
	^ right @ top! !

!RubTextLine methodsFor: 'comparing' stamp: 'AlainPlantec 3/17/2013 15:14'!
= line

	self species = line species
		ifTrue: [^((firstIndex = line first and: [lastIndex = line last])
				and: [internalSpaces = line internalSpaces])
				and: [paddingWidth = line paddingWidth]]
		ifFalse: [^false]! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:14'!
internalSpaces
	"Answer the number of spaces in the line."

	^internalSpaces! !

!RubTextLine methodsFor: 'updating' stamp: 'AlainPlantec 3/17/2013 15:14'!
slideIndexBy: delta andMoveTopTo: newTop
	"Relocate my character indices and y-values.
	Used to slide constant text up or down in the wake of a text replacement."

	firstIndex := firstIndex + delta.
	lastIndex := lastIndex + delta.
	bottom := bottom + (newTop - top).
	top := newTop.
! !

!RubTextLine methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:14'!
leftMargin: lm
	left := lm! !

!RubTextLine methodsFor: 'private' stamp: 'AlainPlantec 3/17/2013 15:14'!
lineHeight: height baseline: ascent
	bottom := top + height.
	baseline := ascent! !

!RubTextLine methodsFor: 'updating' stamp: 'AlainPlantec 3/17/2013 15:14'!
slide: delta 
	"Change the starting and stopping points of the line by delta."

	firstIndex := firstIndex + delta.
	lastIndex := lastIndex + delta! !

!RubTextLine class methodsFor: 'instance creation' stamp: 'AlainPlantec 3/17/2013 15:14'!
start: startInteger stop: stopInteger internalSpaces: spacesInteger paddingWidth: padWidthInteger
	"Answer an instance of me with the arguments as the start, stop points, 
	number of spaces in the line, and width of the padding."
	| line |
	line := self new firstIndex: startInteger lastIndex: stopInteger.
	^ line internalSpaces: spacesInteger paddingWidth: padWidthInteger! !

!RubTextLink commentStamp: 'AndreiChis 11/12/2014 12:02'!
A  link in text referring to class and methods.  
This link reacts to mouseDown events.
!
!RubTextLink methodsFor: 'testing' stamp: 'AndreiChis 11/12/2014 11:37'!
mayActOnEvent: anEvent
	^ anEvent isMouseDown and: [ anEvent commandKeyPressed ]! !

!RubTextMethodLink commentStamp: 'AndreiChis 11/12/2014 12:02'!
An active link in a text linking to a method!
!RubTextMethodLink methodsFor: 'accessing' stamp: 'AndreiChis 11/12/2014 11:38'!
selector
	^ selector! !

!RubTextMethodLink methodsFor: 'initialization' stamp: 'AndreiChis 11/12/2014 11:38'!
initialize 
	super initialize.
	browseSenders := false.! !

!RubTextMethodLink methodsFor: 'event handling' stamp: 'AndreiChis 11/12/2014 11:39'!
actOnClick: anEvent for: target in: aParagraph editor: anEditor
	self flag: 'TODO: complete implementation with class'.
	
	browseSenders == anEvent shiftPressed
		ifTrue: [ anEditor editor implementorsOf: self selector ]
		ifFalse: [ anEditor editor sendersOf: self selector ].
		
	^ true! !

!RubTextMethodLink methodsFor: 'accessing' stamp: 'AndreiChis 11/12/2014 11:38'!
senders: aBoolean
	browseSenders := aBoolean! !

!RubTextMethodLink methodsFor: 'accessing' stamp: 'AndreiChis 11/12/2014 11:38'!
selector: aStringOrSymbol
	selector := aStringOrSymbol asSymbol.! !

!RubTextMethodLink class methodsFor: 'instance creation' stamp: 'AndreiChis 11/12/2014 11:38'!
selector: aStringOrSymbol
	^ self new
		selector: aStringOrSymbol;
		yourself! !

!RubTextMethodLink class methodsFor: 'instance creation' stamp: 'AndreiChis 11/12/2014 11:38'!
selector: aString senders: browseSenders
	^ (self selector: aString)
		senders: browseSenders;
		yourself! !

!RubTextScrollPane methodsFor: 'classification' stamp: 'AlainPlantec 4/12/2013 23:59'!
isRenderer
	^ false! !

!RubTextScrollPane methodsFor: 'text area protocol' stamp: 'AlainPlantec 5/7/2013 09:34'!
beNotWrapped
	self handleWrappingPolicyChange: [ self textArea beNotWrapped]! !

!RubTextScrollPane methodsFor: 'text area protocol' stamp: 'AlainPlantec 4/18/2013 12:49'!
handleWrappingPolicyChange: aBlock
	aBlock value.
	self wrapped
		ifTrue: [ 
			self fitScrollTargetWidth.
			self updateScrollbars ]! !

!RubTextScrollPane methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:34'!
hasKeyboardFocus
	"Answer whether the receiver has keyboard focus."

	^ super hasKeyboardFocus or: [(self textArea ifNil: [^false]) hasKeyboardFocus]! !

!RubTextScrollPane methodsFor: 'accessing' stamp: 'AndreiChis 8/28/2014 14:00'!
newHScrollbar
	"Answer a new horizontal scrollbar."

	^RubScrollBar new
		model: self;
		setValueSelector: #hScrollbarValue:! !

!RubTextScrollPane methodsFor: 'text area protocol' stamp: 'AlainPlantec 4/15/2013 11:18'!
scrollSelectionIntoView
	"Scroll my text into view if necessary and return true, else return false"
	self scrollSelectionIntoView: nil.
! !

!RubTextScrollPane methodsFor: 'accessing' stamp: 'AndreiChis 8/28/2014 14:00'!
newVScrollbar
	"Answer a new vertical scrollbar."

	^RubScrollBar new
		model: self;
		setValueSelector: #vScrollbarValue:! !

!RubTextScrollPane methodsFor: 'scrollbar managing' stamp: 'AlainPlantec 8/27/2013 15:32'!
scrollToBeginningOfLine
	self hScrollbarValue: 0;
	updateScrollbars! !

!RubTextScrollPane methodsFor: 'structure' stamp: 'AlainPlantec 4/13/2013 12:15'!
topRendererOrSelf
	^ owner ifNil: [ super topRendererOrSelf ]! !

!RubTextScrollPane methodsFor: 'geometry' stamp: 'AlainPlantec 2/6/2014 09:35'!
position: aPoint
	"Update the receiver's extent. Hide/show the scrollbars and resize the scroller
	as neccessary."
	| previousBounds |
	previousBounds := self bounds copy.
	previousBounds topLeft = aPoint
		ifTrue: [ ^ self ].
	super position: aPoint! !

!RubTextScrollPane methodsFor: 'text area protocol' stamp: 'AlainPlantec 5/9/2013 08:47'!
scrollSelectionIntoView: event
	"Scroll my text into view if necessary and return true, else return false"

	| selRects delta selRect rectToTest transform cpHere editor bnds |
	editor := self textArea editor.
	selRects := self textArea selectionRects.
	selRects isEmpty
		ifTrue: [ ^ false ].
	rectToTest := selRects first merge: selRects last.
	transform := scroller transformFrom: self.
	(event notNil and: [ event isMouse and: [ event anyButtonPressed ] ])
		ifTrue: [ 
			"Check for autoscroll"
			cpHere := transform localPointToGlobal: event cursorPoint.
			(cpHere y <= self top or: [ cpHere x <= self left ])
				ifTrue: [ rectToTest := selRects first topLeft extent: 2 @ 2 ]
				ifFalse: [ 
					(cpHere y >= self bottom or: [ cpHere x >= self right  ] )
						ifTrue: [ rectToTest := selRects last bottomRight extent: 2 @ 2 ]
						ifFalse: [ ^ false ] ] ].
	selRect := transform localBoundsToGlobal: rectToTest.
	bnds := self scrollBounds insetBy: self textArea margins.
	selRect height > bounds height
		ifTrue: [ 
			editor pointIndex - editor markIndex < 0
				ifTrue: [ self scrollBy: 0 @ (bnds top - selRect top) ]
				ifFalse: [ self scrollBy: 0 @ (bnds bottom - selRect bottom) ].
			^ true ].
	(delta := selRect amountToTranslateWithin: bnds) ~= (0 @ 0)
		ifTrue: [ 
			delta x > 0
				ifTrue: [ 
					scroller offset x - delta x < self scrollBounds width
						ifTrue: [ delta := scroller offset x @ delta y ] ].
			self scrollBy: delta truncated.
			^ true ].
	^ false! !

!RubTextScrollPane methodsFor: 'initialize' stamp: 'AlainPlantec 5/7/2013 09:34'!
initialize
	super initialize.
	self scroller extent: self textArea extent.
	self wrapped ifTrue: [ self fitScrollTarget  ]! !

!RubTextScrollPane methodsFor: 'text area protocol' stamp: 'AlainPlantec 5/7/2013 09:34'!
wrapped
	^ self textArea wrapped! !

!RubTextScrollPane methodsFor: 'text area protocol' stamp: 'AlainPlantec 5/7/2013 09:34'!
wrapped: aBoolean
	self handleWrappingPolicyChange: [ self textArea wrapped: aBoolean ]! !

!RubTextScrollPane methodsFor: 'geometry' stamp: 'AlainPlantec 5/7/2013 10:05'!
fitScrollTargetWidth
	"if the scroller extent is different that the textArea 
	extent, then, if the textArea is wrapped, then resize 
	the textArea width accordingly
	If the textArea is not wrapped, then do nothing
	"
	self scroller width = self textArea width
		ifFalse: [ self textArea width: self scrollBounds width ]! !

!RubTextScrollPane methodsFor: 'text area protocol' stamp: 'AlainPlantec 5/7/2013 09:34'!
scrollWhenMouseMove: anEvent pivotPoint: aPivot
	| worldTransform viewBounds gap |
	worldTransform := self transformFrom: self world.
	(self scrollSelectionIntoView: anEvent)
		ifTrue: [ ^ self ].
	self textArea selectionRects
		ifNotEmpty: [ :selRects |
			viewBounds := worldTransform localBoundsToGlobal: self bounds.
			(viewBounds containsPoint: anEvent hand position)
				ifFalse: [ 
					gap := selRects last height.
					aPivot y < anEvent hand position y
						ifTrue: [ 
							gap := gap + (anEvent hand position y - viewBounds bottom).
							anEvent setPosition: anEvent position + (0 @ gap) ]
						ifFalse: [ 
							gap := gap + (viewBounds top - anEvent hand position y).
							anEvent setPosition: anEvent position - (0 @ gap) ].
					self textArea mouseMove: anEvent ] ]! !

!RubTextScrollPane methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:34'!
paragraph
	^ self textArea paragraph ! !

!RubTextScrollPane methodsFor: 'initialize' stamp: 'AlainPlantec 5/17/2013 21:30'!
defaultScrollTarget
	^ RubEditingArea new! !

!RubTextScrollPane methodsFor: 'scrollbar managing' stamp: 'AlainPlantec 8/27/2013 15:30'!
scrollToEndOfText
	self vScrollbarValue: 1;
	updateScrollbars! !

!RubTextScrollPane methodsFor: 'dropping/grabbing' stamp: 'AlainPlantec 4/12/2013 23:35'!
aboutToBeGrabbedBy: aHand
	^ nil! !

!RubTextScrollPane methodsFor: 'scrollbar managing' stamp: 'AlainPlantec 5/7/2013 10:06'!
fitScrollTarget
	"if the scroller extent is different that the textArea 
	extent, then, if the textArea is wrapped, then resize 
	the textArea width accordingly
	If the textArea is not wrapped, then do nothing
	"
	
	self wrapped
		ifFalse: [ ^ self ].
	self fitScrollTargetWidth ! !

!RubTextScrollPane methodsFor: 'scrollbar managing' stamp: 'AlainPlantec 4/18/2013 12:39'!
hScrollbarNeeded
	"Return whether the horizontal scrollbar is needed."
	self wrapped ifTrue: [  ^ false ].
	^ super hScrollbarNeeded! !

!RubTextScrollPane methodsFor: 'private' stamp: 'AlainPlantec 5/7/2013 09:41'!
unplug
	self hasTextArea
		ifTrue: [ self textArea unplug ].
	super unplug! !

!RubTextScrollPane methodsFor: 'scrollbar managing' stamp: 'AlainPlantec 8/27/2013 15:31'!
scrollToBeginningOfText
	self vScrollbarValue: 0;
	updateScrollbars! !

!RubTextScrollPane methodsFor: 'event handling' stamp: 'AlainPlantec 2/6/2014 11:08'!
textAreaExtentChanged
	self fitScrollTarget.
	self owner ifNotNil: [ :o | o textAreaExtentChanged ]
! !

!RubTextScrollPane methodsFor: 'scrollbar managing' stamp: 'AlainPlantec 4/19/2013 00:13'!
updateScrollbars
	super updateScrollbars.
	self wrapped
		ifTrue: [ self fitScrollTargetWidth ]! !

!RubTextScrollPane methodsFor: 'drawing' stamp: 'AlainPlantec 5/7/2013 13:38'!
drawSubmorphsOn: aCanvas 
	"Draw the focus here since we are using inset bounds
	for the focus rectangle."

	super drawSubmorphsOn: aCanvas.
	(self hasKeyboardFocus or: [ self textArea hasFindReplaceFocus ]) 
		ifTrue: [self drawKeyboardFocusOn: aCanvas].
! !

!RubTextScrollPane methodsFor: 'text area protocol' stamp: 'AlainPlantec 5/7/2013 09:41'!
hasTextArea
	^ self scroller submorphs notEmpty! !

!RubTextScrollPane methodsFor: 'private' stamp: 'AlainPlantec 4/15/2013 08:27'!
offset
	^ scroller offset! !

!RubTextScrollPane methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 09:34'!
textArea
	^ self scrollTarget! !

!RubTextScrollPane methodsFor: 'drawing' stamp: 'AlainPlantec 2/26/2015 18:55'!
drawSubmorphsOnAthensCanvas: anAthensCanvas
	"Draw the focus here since we are using inset bounds
	for the focus rectangle."

	super drawSubmorphsOnAthensCanvas: anAthensCanvas.
	(self hasKeyboardFocus or: [ self textArea hasFindReplaceFocus ]) 
		ifTrue: [self drawKeyboardFocusOnAthensCanvas: anAthensCanvas].
! !

!RubTextScrollPane methodsFor: 'scrollbar managing' stamp: 'AlainPlantec 4/26/2013 13:34'!
hideOrShowScrollBar 
	self updateScrollbars! !

!RubTextScrollPane methodsFor: 'text area protocol' stamp: 'AlainPlantec 11/22/2013 09:27'!
setTextWith: stringOrText
	"Set the initial text contents with line breaks only as in the text.
	Fit my width and height to the result."
	self textArea width: self scroller width.
	self textArea setTextWith: stringOrText.
	self updateScrollbars 
! !

!RubTextScrollPane methodsFor: 'scrollbar managing' stamp: 'AlainPlantec 4/15/2013 13:57'!
hScrollbarValue: scrollValue
	self handleScrollerOffsetChange: [ 
		super hScrollbarValue: scrollValue]
! !

!RubTextScrollPane methodsFor: 'accessing' stamp: 'AlainPlantec 4/12/2013 08:56'!
adoptPaneColor: paneColor
	"Adopt the given pane color."
	
	super adoptPaneColor: paneColor.
	self hScrollbar adoptPaneColor: paneColor darker.
	self vScrollbar adoptPaneColor: paneColor darker! !

!RubTextScrollPane methodsFor: 'text area protocol' stamp: 'AlainPlantec 5/7/2013 09:34'!
updateTextWith: stringOrText
	"Accept new text contents with line breaks only as in the text.
	Fit my width and height to the result."
	self textArea width: self scroller width.
	self textArea updateTextWith: stringOrText.
	self updateScrollbars 
! !

!RubTextScrollPane methodsFor: 'geometry' stamp: 'AlainPlantec 4/26/2013 13:43'!
currentHScrollBarThickness
	^ self hScrollbarNeeded
		ifTrue: [ self scrollBarThickness ]
		ifFalse: [ 0 ]! !

!RubTextScrollPane methodsFor: 'scrollbar managing' stamp: 'AlainPlantec 8/27/2013 15:32'!
scrollToEndOfLine
	self hScrollbarValue: 1;
	updateScrollbars! !

!RubTextScrollPane methodsFor: 'scrollbar managing' stamp: 'AlainPlantec 4/15/2013 08:44'!
vScrollbarValue: scrollValue
	self handleScrollerOffsetChange: [ super vScrollbarValue: scrollValue]
! !

!RubTextScrollPane methodsFor: 'event handling' stamp: 'AlainPlantec 5/7/2013 09:34'!
mouseMove: anEvent 

	scroller hasSubmorphs 
		ifTrue: [ self textArea mouseMove: (anEvent transformedBy: (scroller transformFrom: self)) ].
	self eventHandler
		ifNotNil: [ self eventHandler mouseMove: anEvent fromMorph: self ]! !

!RubTextScrollPane methodsFor: 'text area protocol' stamp: 'AlainPlantec 5/7/2013 09:34'!
beWrapped
	self handleWrappingPolicyChange: [ self textArea beWrapped ]! !

!RubTextScrollPane methodsFor: 'geometry' stamp: 'AlainPlantec 2/6/2014 09:40'!
extent: newExtent
	"Update the receiver's extent. Hide/show the scrollbars and resize the scroller
	as neccessary."

	| previousBounds |
	previousBounds := self bounds copy.
	previousBounds extent = newExtent
		ifTrue: [ ^ self ].
	super extent: newExtent.
	self owner ifNotNil: [ :o | o scrollerExtentChanged ].
	self wrapped
		ifTrue: [ self updateScrollbars ]! !

!RubTextScrollPane methodsFor: 'scrollbar managing' stamp: 'AlainPlantec 2/6/2014 09:23'!
handleScrollerOffsetChange: aBlock
	| prevOffset ret |
	prevOffset := self offset.
	ret := aBlock value.
	(self offset ~= prevOffset and: [ self owner notNil ])
		ifTrue: [ self owner scrollerOffsetChanged ].
	^ ret! !

!RubTextScrollPane methodsFor: 'geometry' stamp: 'AlainPlantec 4/26/2013 13:25'!
currentVScrollBarThickness
	^ self vScrollbarNeeded
		ifTrue: [ self scrollBarThickness ]
		ifFalse: [ 0 ]! !

!RubTextScrollPane methodsFor: 'scrollbar managing' stamp: 'AlainPlantec 4/18/2013 09:53'!
scrollBy: delta
	self
		handleScrollerOffsetChange: [ 
			| newYoffset newXoffset |
			"Move the contents in the direction delta."
			newYoffset := scroller offset y - delta y max: 0.
			newXoffset := scroller offset x - delta x max: 0.
			"Set the offset on the scroller"
			scroller offset: newXoffset @ newYoffset.
			self updateScrollbars ]! !

!RubTextScrollPane methodsFor: 'event handling' stamp: 'AlainPlantec 2/6/2014 13:54'!
textChanged

	self owner ifNotNil: [ :o | o textChanged ]! !

!RubTextScrollPane methodsFor: 'scrollbar managing' stamp: 'AlainPlantec 5/31/2013 15:47'!
scrollByKeyboard: event
	"If event is ctrl+up/down then scroll and answer true"

	| ret sb |
	(event controlKeyPressed or: [ event commandKeyPressed ])
		ifFalse: [ ^ false ].
	sb := event commandKeyPressed
		ifTrue: [self hScrollbar]
		ifFalse: [self vScrollbar].
	self
		handleScrollerOffsetChange: [ 
			ret := false.
			event keyValue = 30 
				ifTrue: [ 
					sb scrollUp: 3.
					ret := true ].
			event keyValue = 31
				ifTrue: [ 
					sb scrollDown: 3.
					ret := true ] ].
	^ ret! !

!RubTextScrollPane methodsFor: 'event handling' stamp: 'AlainPlantec 2/6/2014 12:02'!
selectionChanged
	self owner ifNotNil: [ :o | o selectionChanged ]! !

!RubTextScrollPane methodsFor: 'scrollbar managing' stamp: 'AlainPlantec 5/7/2013 09:34'!
hLeftoverScrollRange
	"Return the entire scrolling range minus the currently viewed area."
	^self textArea width  - self scrollBounds width max: 0! !

!RubTextScrollPane methodsFor: 'event handling' stamp: 'AlainPlantec 5/7/2013 09:34'!
mouseDown: anEvent 
	scroller hasSubmorphs 
		ifTrue: [ self textArea mouseDown: (anEvent transformedBy: (scroller transformFrom: self)) ].
	self eventHandler
		ifNotNil: [ self eventHandler mouseDown: anEvent fromMorph: self ]! !

!RubTextScrollPane methodsFor: 'initialize' stamp: 'AlainPlantec 5/7/2013 16:40'!
unregisterTextArea
	self hasTextArea
		ifTrue: [ 
			self textArea scrollPane: nil.
			self textArea announcer unsubscribe: self.
			self textArea unplug ]! !

!RubTextScrollPane methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2013 10:06'!
scrollTarget: aTextArea
	self unregisterTextArea.
	super scrollTarget: aTextArea.
	self registerTextArea ! !

!RubTextScrollPane methodsFor: 'initialize' stamp: 'AlainPlantec 2/6/2014 11:18'!
registerTextArea
	self hasTextArea
		ifTrue: [
			self textArea scrollPane: self.
			self updateScrollbars ]! !

!RubTextSegmentIconBox methodsFor: 'accessing' stamp: 'AlainPlantec 5/31/2013 09:05'!
textColor
	^ self textArea lineNumbersTextColor 
! !

!RubTextSegmentIconBox methodsFor: 'event handling' stamp: 'AlainPlantec 5/31/2013 09:05'!
mouseEnter: anEvent
	self color: (Color lightGray alpha: 0.04).
! !

!RubTextSegmentIconBox methodsFor: 'accessing' stamp: 'AlainPlantec 5/31/2013 09:05'!
verticalSeparatorColor
	^ (self textArea backgroundColor contrastingColor ) alpha: 0.3! !

!RubTextSegmentIconBox methodsFor: 'accessing' stamp: 'AlainPlantec 5/31/2013 09:05'!
verticalSeparatorBounds
	| bnds  |
	bnds := self bounds.
	^ self side = #left
		ifTrue: [ (bnds topRight -  (self verticalSeparatorWidth @ 0)) corner: bnds bottomRight ]
		ifFalse: [ (bnds topLeft corner: bnds bottomLeft + (self verticalSeparatorWidth @ 0)) ]! !

!RubTextSegmentIconBox methodsFor: 'event handling' stamp: 'AlainPlantec 5/31/2013 09:05'!
mouseEnter: anEvent in: aSegment
	previouslyIn = aSegment
		ifTrue: [ ^ self ].
	previouslyIn := aSegment.
	aSegment showMouseHasEntered ! !

!RubTextSegmentIconBox methodsFor: 'accessing' stamp: 'AlainPlantec 5/31/2013 09:05'!
verticalSeparatorWidth
	^ 1! !

!RubTextSegmentIconBox methodsFor: 'event handling' stamp: 'AlainPlantec 5/31/2013 09:05'!
mouseDown: anEvent
	| lineIndex |
	lineIndex := self lineIndexForPoint: anEvent position.
	(self paragraphProvider segmentsAtLine: lineIndex) do: [ :s | s icon ifNotNil: [ Transcript show: '[x]' ] ] ! !

!RubTextSegmentIconBox methodsFor: 'event handling' stamp: 'AlainPlantec 5/31/2013 09:05'!
mouseLeave: anEvent
	self color: self defaultBackgroundColor.
	previouslyIn
		ifNotNil: [ 
			previouslyIn showMouseHasLeaved.
			previouslyIn := nil ]! !

!RubTextSegmentIconBox methodsFor: 'event handling' stamp: 'AlainPlantec 5/31/2013 09:05'!
handlesMouseMove: evt
	^ true! !

!RubTextSegmentIconBox methodsFor: 'accessing' stamp: 'AlainPlantec 5/31/2013 09:08'!
backgroundColor
	^ Color orange veryMuchLighter! !

!RubTextSegmentIconBox class methodsFor: 'querying' stamp: 'AlainPlantec 5/31/2013 09:05'!
key
	^ #textSegmentIcons! !

!RubTextSegmentIconDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 5/22/2013 10:50'!
textColor
	^ self textArea lineNumbersTextColor 
! !

!RubTextSegmentIconDisplayer methodsFor: 'structure' stamp: 'AlainPlantec 6/2/2013 16:02'!
topRendererOrSelf
	^self ! !

!RubTextSegmentIconDisplayer methodsFor: 'event handling' stamp: 'AlainPlantec 5/30/2013 10:25'!
handlesMouseDown: evt
	^ true! !

!RubTextSegmentIconDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 5/22/2013 11:42'!
level
	^ 1! !

!RubTextSegmentIconDisplayer methodsFor: 'event handling' stamp: 'AlainPlantec 5/30/2013 15:19'!
handlesMouseOver: evt

	^ true! !

!RubTextSegmentIconDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 5/22/2013 10:50'!
backgroundColor
	^ self paragraphProvider lineNumbersBackgroundColor ! !

!RubTextSegmentIconDisplayer methodsFor: 'initialize-release' stamp: 'AlainPlantec 5/31/2013 10:45'!
initialize
	super initialize.
	self clipSubmorphs: false! !

!RubTextSegmentIconDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 5/22/2013 10:50'!
verticalSeparatorWidth
	^ 1! !

!RubTextSegmentIconDisplayer methodsFor: 'drawing' stamp: 'AlainPlantec 5/31/2013 09:32'!
iconPositionOfSegment: aSegment
	^ (self left + self horizontalGapBefore) @ aSegment position y
		translateBy: 0 negated @ (self offset y negated + self bounds top)! !

!RubTextSegmentIconDisplayer methodsFor: 'drawing' stamp: 'AlainPlantec 5/31/2013 09:02'!
drawSegmentsAtLineIndex: anIndex on: aCanvas
	(self paragraphProvider segmentsAtLine: anIndex)
		do: [ :s | 
			| pos |
			pos := (self left + self horizontalGapBefore) @ s position y
				translateBy: 0 negated @ (self offset y negated + self bounds top).
			s displayIconAt: pos on: aCanvas ]! !

!RubTextSegmentIconDisplayer methodsFor: 'event handling' stamp: 'AlainPlantec 5/31/2013 12:04'!
handleMouseOver: anEvent
	| lineIndex |
	super handleMouseOver: anEvent.
	lineIndex := self lineIndexForPoint: anEvent position.
	self mouseEnter: anEvent in: ( (self paragraphProvider segmentsAtLine: lineIndex) select: [ :s | s icon notNil ] ).
	previouslyIn ifNotNil: [
		previouslyIn showMouseHasLeaved.
		previouslyIn := nil ].

	
! !

!RubTextSegmentIconDisplayer methodsFor: 'event handling' stamp: 'AlainPlantec 5/30/2013 15:13'!
handlesMouseMove: evt
	^ true! !

!RubTextSegmentIconDisplayer methodsFor: 'event handling' stamp: 'AlainPlantec 8/2/2013 19:38'!
invokeIconMenuOfSegments: aSegmentList event: anEvent
	| menu |
	aSegmentList ifEmpty: [ ^ self ].
	menu := RubSegmentIconMenuMorph new
		defaultTarget: self;
		color: Color yellow muchLighter.
	aSegmentList
		do: [ :seg | 
			seg label
				ifNotEmpty: [ 
					(menu
						add: seg label
						target: seg iconBlock
						selector: #value:value:
						argumentList: {seg. anEvent})
						icon: seg icon;
						segment: seg;
						yourself ] ].
	menu hasItems
		ifFalse: [ ^ self ].
	menu borderWidth: 0.
	menu
		on: #mouseLeave
		send: #value
		to: [ 
			menu delete.
			self changed ].
	menu invokeAt: (self iconPositionOfSegment: aSegmentList first) - (1 @ 4 negated) in: self! !

!RubTextSegmentIconDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 5/22/2013 10:50'!
verticalSeparatorColor
	^ (self textArea backgroundColor contrastingColor ) alpha: 0.3! !

!RubTextSegmentIconDisplayer methodsFor: 'drawing' stamp: 'AlainPlantec 2/6/2014 23:52'!
drawOn: aCanvas
	| visibleRectangle |
	super drawOn: aCanvas.
	self paragraph selectionStart ifNil: [ ^ self ].
	self paragraph selectionStop ifNil: [ ^ self ].
	self paragraph lines ifNil: [ ^ self ].
	aCanvas
		clipBy: self bounds
		during: [ :clippedCanvas | 
			| tl br |
			clippedCanvas fillRectangle: self verticalSeparatorBounds color: self verticalSeparatorColor.
			visibleRectangle := clippedCanvas clipRect.
			tl := self lineIndexForPoint: visibleRectangle topLeft.
			br := self lineIndexForPoint: visibleRectangle bottomRight.
			tl to: br do: [ :i | 
				((self paragraphProvider segmentsAtLine: i) select: [ :s | s icon notNil ])
					ifNotEmpty: [ :segments | 
						| s pos |
						s := segments first.
						s displayIconAt: (pos := self iconPositionOfSegment: s) on: aCanvas.
						segments size > 1
							ifTrue: [ 
								| r ygap |
								ygap := s icon height + 1.
								r := pos + (0 @ ygap) corner: (pos x + 12) @ (pos y + ygap + 2).
								aCanvas fillRectangle: (r expandBy: 2) color: (Color white alpha: 0.4).
								aCanvas
									frameRectangle: r
									width: 2
									colors: {(Color white). (Color black)}
									dashes: {1. 1} ] ] ] ]! !

!RubTextSegmentIconDisplayer methodsFor: 'event handling' stamp: 'AlainPlantec 5/31/2013 12:11'!
mouseEnter: anEvent in: aSegmentList
	aSegmentList ifEmpty: [ ^self ].
	previouslyIn = aSegmentList first
		ifTrue: [ ^ self ].
	previouslyIn := aSegmentList first.
	self invokeIconMenuOfSegments: aSegmentList event: anEvent.
! !

!RubTextSegmentIconDisplayer methodsFor: 'geometry' stamp: 'AlainPlantec 5/30/2013 10:51'!
horizontalGapBefore
	^ 1! !

!RubTextSegmentIconDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 5/30/2013 10:51'!
itemWidth 
	^ 16! !

!RubTextSegmentIconDisplayer methodsFor: 'event handling' stamp: 'AlainPlantec 5/31/2013 11:53'!
mouseEnter: anEvent
	super mouseEnter: anEvent! !

!RubTextSegmentIconDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 5/22/2013 10:50'!
verticalSeparatorBounds
	| bnds  |
	bnds := self bounds.
	^ self side = #left
		ifTrue: [ (bnds topRight -  (self verticalSeparatorWidth @ 0)) corner: bnds bottomRight ]
		ifFalse: [ (bnds topLeft corner: bnds bottomLeft + (self verticalSeparatorWidth @ 0)) ]! !

!RubTextSegmentIconDisplayer methodsFor: 'geometry' stamp: 'AlainPlantec 5/30/2013 10:51'!
horizontalGapAfter
	^ 1! !

!RubTextSegmentIconDisplayer methodsFor: 'event handling' stamp: 'AlainPlantec 5/31/2013 12:08'!
mouseDown: anEvent
	super mouseDown: anEvent! !

!RubTextSegmentIconDisplayer methodsFor: 'geometry' stamp: 'AlainPlantec 5/22/2013 10:53'!
computedWidthFrom: aRectangle
	^  (self horizontalGapBefore + self itemWidth + self horizontalGapAfter + self verticalSeparatorWidth) truncated ! !

!RubTextSegmentIconDisplayer methodsFor: 'event handling' stamp: 'AlainPlantec 5/31/2013 11:53'!
mouseLeave: anEvent
	previouslyIn
		ifNotNil: [ 
			previouslyIn showMouseHasLeaved.
			previouslyIn := nil ]! !

!RubTextSegmentIconDisplayer methodsFor: 'accessing' stamp: 'AlainPlantec 5/22/2013 10:50'!
fontToUse
	^ RubAbstractTextArea lineNumbersFont ! !

!RubTextSegmentIconDisplayer class methodsFor: 'querying' stamp: 'AlainPlantec 5/22/2013 10:50'!
key
	^ #textSegmentIcons! !

!RubTextSegmentMorph methodsFor: 'initialization' stamp: 'AlainPlantec 5/29/2013 23:09'!
defaultColor
	^ Color red! !

!RubTextSegmentMorph methodsFor: 'structure' stamp: 'AlainPlantec 6/6/2013 16:20'!
topRendererOrSelf
	^owner
		ifNotNil: [ owner topRendererOrSelf ]! !

!RubTextSegmentMorph methodsFor: 'event handling' stamp: 'AlainPlantec 5/22/2013 12:11'!
handlesMouseOver: evt
	^ true! !

!RubTextSegmentMorph methodsFor: 'initialization' stamp: 'AlainPlantec 5/29/2013 23:09'!
initialize
	super initialize.
	self borderWidth: 0.
	self beStraightSegments.
	self clipSubmorphs: false
! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 6/2/2013 12:45'!
setText: aText from: aView
	self replaceTextWith: aText.
	self announcer announce: RubTextUpdatedInModel.
	^ true! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/31/2013 13:09'!
iconBlock: aBlockWithMyselfAndAnEventAsArgument
	iconBlock := aBlockWithMyselfAndAnEventAsArgument! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/31/2013 13:12'!
iconBlock
	^ iconBlock ifNil: [ iconBlock := [ :seg :evt | ] ]! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/7/2014 09:22'!
beExtendable
	self changeable: false! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/31/2013 10:10'!
label: aString
	label := aString! !

!RubTextSegmentMorph methodsFor: 'submorphs-accessing' stamp: 'AlainPlantec 2/6/2014 23:32'!
noteNewOwner: aMorph
	super noteNewOwner: aMorph.
	self registerTextArea! !

!RubTextSegmentMorph methodsFor: 'ui' stamp: 'AlainPlantec 6/2/2013 12:42'!
readOnlyView
	^ RubScrolledTextMorph new
		setTextWith: self getText;
		wrapped: self textArea wrapped;
		width: 200;
		yourself! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 11:04'!
inTextArea: aTextArea from: aFirstCharIndex to: aLastCharIndex
	self from: aFirstCharIndex to: aLastCharIndex.
	self inTextArea:  aTextArea
! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/22/2013 09:06'!
lastIndex: anInteger
	lastIndex := anInteger.
	self computeVertices ! !

!RubTextSegmentMorph methodsFor: 'drawing' stamp: 'AlainPlantec 6/6/2013 15:36'!
computeVertices
	self isCurve
		ifTrue: [ self computeSmoothVertices ]
		ifFalse: [ self computeStraightVertices ]! !

!RubTextSegmentMorph methodsFor: 'private' stamp: 'AlainPlantec 5/30/2013 00:08'!
privateMoveBy: aPoint
	super privateMoveBy: aPoint.
	self computeVertices! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/31/2013 13:15'!
firstIndex
	^ firstIndex ! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/22/2013 08:34'!
icon: aForm
	icon := aForm! !

!RubTextSegmentMorph methodsFor: 'event handling' stamp: 'AlainPlantec 5/30/2013 16:07'!
mouseEnter: anEvent
	self showMouseHasEntered.
	super mouseEnter: anEvent! !

!RubTextSegmentMorph methodsFor: 'private' stamp: 'AlainPlantec 6/6/2013 15:35'!
computeSmoothVertices
	| firstCB lastCB firstLineIndex lastLineIndex firstLine lastLine verts |
	firstLineIndex := self lineIndexOfCharacterIndex: firstIndex.
	lastLineIndex := self lineIndexOfCharacterIndex: lastIndex.
	firstLine := self lines at: firstLineIndex.
	lastLine := self lines at: lastLineIndex.
	verts := OrderedCollection new.
	firstLine = lastLine
		ifTrue: [ 
			firstCB := self textArea paragraph firstNonBlankCharacterBlockInLine: firstLine.
			verts add: firstCB bottomLeft.
			verts add: firstCB topLeft.
			firstIndex ~= lastIndex
				ifTrue: [ 
					lastCB := self textArea paragraph lastNonBlankCharacterBlockInLine: firstLine.
					verts add: lastCB topLeft.
					verts add: lastCB bottomLeft.
					verts add: firstCB bottomLeft ] ]
		ifFalse: [ 
			| currLine currIdx cb |
			currIdx := firstLineIndex.
			currLine := firstLine.
			[ 
			cb := self textArea paragraph lastNonBlankCharacterBlockInLine: currLine.
			verts add: cb topRight.
			verts add: cb bottomRight.
			currIdx := currIdx + 1.
			currLine := self lines at: currIdx ] doWhileTrue: [ currLine ~~ lastLine ].
			cb := self textArea paragraph lastNonBlankCharacterBlockInLine: currLine.
			verts add: cb topRight.
			verts add: cb bottomRight.
			[ 
			cb := self textArea paragraph firstNonBlankCharacterBlockInLine: currLine.
			verts add: cb bottomLeft - (1 @ 0).
			verts add: cb topLeft - (1 @ 0).
			currIdx := currIdx - 1.
			currLine := self lines at: currIdx ] doWhileTrue: [ currLine ~~ firstLine ].
			cb := self textArea paragraph firstNonBlankCharacterBlockInLine: currLine.
			verts add: cb bottomLeft - (1 @ 0).
			verts add: cb topLeft - (1 @ 0) ].
	self setVertices: verts! !

!RubTextSegmentMorph methodsFor: 'submorphs-add/remove' stamp: 'AlainPlantec 2/6/2014 23:25'!
delete
	textArea ifNotNil: [ :ta | ta removeSegment: self ].
	textArea := nil.
	super delete! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/7/2014 09:22'!
beChangeable
	self changeable: true! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 11:04'!
inTextArea: aTextArea 
	textArea := aTextArea.
	self computeVertices! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/31/2013 13:58'!
interval
	^ self firstIndex to: self lastIndex! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/21/2013 16:35'!
lineIndexOfCharacterIndex: anIndex
	^ self textArea paragraph lineIndexOfCharacterIndex: anIndex! !

!RubTextSegmentMorph methodsFor: 'event handling' stamp: 'AlainPlantec 5/30/2013 16:07'!
showMouseHasEntered
	self borderWidth: 1.
! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 6/6/2013 13:51'!
margins
	^ self textArea margins! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/22/2013 08:34'!
icon
	^ icon ! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 6/3/2013 07:47'!
replaceTextWith: aText
	self textArea replaceFrom: self firstIndex  to: self lastIndex with: aText asText! !

!RubTextSegmentMorph methodsFor: 'drawing' stamp: 'AlainPlantec 5/30/2013 23:26'!
displayIconAt: aPosition on: aCanvas
	self icon ifNil: [ ^self ].
	aCanvas translucentImage: self icon at: aPosition! !

!RubTextSegmentMorph methodsFor: 'event handling' stamp: 'AlainPlantec 5/22/2013 18:28'!
whenExtentChanged: anAnnouncement 
	self computeVertices.
! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/31/2013 13:15'!
lastIndex
	^ lastIndex ! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/21/2013 15:32'!
textArea
	^ textArea! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/21/2013 16:35'!
lines
	^ self textArea paragraph lines! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 8/2/2013 11:03'!
from: aFirstCharIndex to: aLastCharIndex
	lastIndex := aLastCharIndex.
	firstIndex := aFirstCharIndex! !

!RubTextSegmentMorph methodsFor: 'private' stamp: 'AlainPlantec 6/6/2013 15:28'!
computeStraightVertices
	| firstCB lastCB firstLineIndex lastLineIndex firstLine lastLine verts secondLine thirdLine |
	firstCB := self characterBlockForIndex: firstIndex.
	lastCB := self characterBlockForIndex: lastIndex.
	firstLineIndex := self lineIndexOfCharacterIndex: firstIndex.
	lastLineIndex := self lineIndexOfCharacterIndex: lastIndex.
	firstLine := self lines at: firstLineIndex.
	lastLine := self lines at: lastLineIndex.
	verts := OrderedCollection new.
	firstLine = lastLine
		ifTrue: [ 
			verts add: firstCB bottomLeft.
			verts add: firstCB topLeft.
			firstIndex ~= lastIndex
				ifTrue: [ 
					verts add: lastCB topLeft.
					verts add: lastCB bottomLeft.
					verts add: firstCB bottomLeft ] ]
		ifFalse: [ 
			secondLine := self lines at: firstLineIndex + 1.
			thirdLine := self lines at: lastLineIndex - 1.
			verts add: firstCB bottomLeft - (1 @ 0).
			verts add: firstCB topLeft - (1 @ 0).
			verts add: (self textArea right - self margins right) @ firstLine top.
			verts add: (self textArea right - self margins right) @ thirdLine bottom.
			verts add: lastCB topLeft.
			verts add: lastCB bottomLeft.
			verts add: lastLine bottomLeft - (1 @ 0).
			verts add: secondLine topLeft - (1 @ 0).
			verts add: firstCB bottomLeft - (1 @ 0) ].
	self setVertices: verts! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/21/2013 16:35'!
characterBlockForIndex: anIndex
	^ self textArea paragraph characterBlockForIndex: anIndex! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/30/2013 10:36'!
mouseDownOnIcon: anEvent
	^ self iconBlock value: anEvent! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/22/2013 09:06'!
firstIndex: anInteger
	firstIndex := anInteger.
	self computeVertices ! !

!RubTextSegmentMorph methodsFor: 'event handling' stamp: 'AlainPlantec 5/30/2013 16:07'!
showMouseHasLeaved
	self borderWidth: 0.
! !

!RubTextSegmentMorph methodsFor: 'event handling' stamp: 'AlainPlantec 2/6/2014 23:21'!
whenTextChanged: anAnnouncement 
	| beg end delta |
	textArea ifNil: [ ^self ].
	beg := anAnnouncement start.
	end := anAnnouncement stop.
	delta := anAnnouncement text size - (end - beg + 1).
	self textChangedFrom: beg to: end delta: delta.
	textArea ifNil: [ ^self ].
	self computeVertices.
	self changed
! !

!RubTextSegmentMorph methodsFor: 'ui' stamp: 'AlainPlantec 6/2/2013 12:39'!
readWriteView
	^ self readOnlyView on: self! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 6/3/2013 07:44'!
getText 
	^ self textArea text copyFrom: self firstIndex to: self lastIndex - 1! !

!RubTextSegmentMorph methodsFor: 'initialization' stamp: 'AlainPlantec 6/6/2013 14:50'!
beSmoothCurve
	super beSmoothCurve.
	self textArea ifNotNil: [ self computeVertices ].
! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/7/2014 09:21'!
changeable
	^ changeable ifNil: [ changeable := true ]! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/31/2013 10:10'!
label
	^ label ifNil: [ label := '' ]! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/7/2014 09:22'!
changeable: aBoolean
	changeable := aBoolean! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/29/2013 22:37'!
lastLineIndex
	^ self lineIndexOfCharacterIndex: lastIndex! !

!RubTextSegmentMorph methodsFor: 'event handling' stamp: 'AlainPlantec 5/30/2013 16:07'!
mouseLeave: anEvent
	self showMouseHasLeaved.
	super mouseLeave: anEvent! !

!RubTextSegmentMorph methodsFor: 'event handling' stamp: 'AlainPlantec 3/17/2014 09:10'!
textChangedFrom: begin to: end delta: delta
	| changeInterval |
	self flag: 'Dirty code, that does not work well, to be reviewed'.
	((self interval rangeIncludes: begin) or: [ self interval rangeIncludes: end ])
		ifTrue: [ 
			self changeable
				ifTrue: [ ^ self delete ] ].
	changeInterval := begin to: end.
	((self interval rangeIncludes: end) and: [delta > 0])
		ifTrue: [ 
			self lastIndex: (self lastIndex + delta).
			^ self computeVertices ].
	((changeInterval rangeIncludes: begin) and: [ (changeInterval rangeIncludes: end) not ])
		ifTrue: [ 
			self firstIndex: self firstIndex - (self firstIndex - end).
			^ self computeVertices ].
	((changeInterval rangeIncludes: self firstIndex) and: [ changeInterval rangeIncludes: self lastIndex ])
		ifTrue: [ ^ self delete ].
	self textArea text size < self firstIndex
		ifTrue: [ ^ self delete ].
	self textArea text size < self lastIndex
		ifTrue: [ 
			self changeable
				ifTrue: [ ^ self delete ]
				ifFalse: [ 
					self lastIndex: self textArea text size.
					^ self computeVertices ] ].
	end < self firstIndex
		ifTrue: [ 
			firstIndex := self firstIndex + delta.
			lastIndex := self lastIndex + delta.
			^ self computeVertices ]! !

!RubTextSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/29/2013 22:36'!
firstLineIndex
	^  self lineIndexOfCharacterIndex: firstIndex! !

!RubTextSegmentMorph methodsFor: 'event handling' stamp: 'AlainPlantec 2/6/2014 15:18'!
registerTextArea 
	textArea announcer subscribe: RubExtentChanged send: #whenExtentChanged: to: self.
	textArea announcer subscribe: RubTextChanged send: #whenTextChanged: to: self! !

!RubTextSegmentMorph class methodsFor: 'instance creation' stamp: 'AlainPlantec 8/2/2013 11:07'!
from: aFirstCharIndex to: aLastCharIndex
	^ self new from: aFirstCharIndex to: aLastCharIndex! !

!RubTextSegmentMorph class methodsFor: 'instance creation' stamp: 'AlainPlantec 5/30/2013 23:54'!
inTextArea: aTextArea from: aFirstCharIndex to: aLastCharIndex
	^ self new inTextArea: aTextArea from: aFirstCharIndex to: aLastCharIndex! !

!RubTextSelectionColor methodsFor: 'accessing' stamp: 'AlainPlantec 4/5/2013 15:12'!
textColor
	^ self colorBlock value! !

!RubTextSelectionColor methodsFor: 'accessing' stamp: 'AlainPlantec 4/5/2013 15:12'!
backgroundColor
	^ self backgroundColorBlock ifNotNil: [:bcb | bcb value]! !

!RubTextSelectionColor methodsFor: 'accessing' stamp: 'AlainPlantec 4/5/2013 15:12'!
dominates: other
	"There can be only one..."
	^self class == other class! !

!RubTextSelectionColor methodsFor: 'accessing' stamp: 'AlainPlantec 4/5/2013 15:12'!
backgroundColorBlock: aBlock

	 backgroundColorBlock := aBlock ! !

!RubTextSelectionColor methodsFor: 'accessing' stamp: 'AlainPlantec 4/5/2013 15:12'!
colorBlock

	^ colorBlock ifNil: [colorBlock := [self theme currentSettings selectionTextColor]]! !

!RubTextSelectionColor methodsFor: 'accessing' stamp: 'AlainPlantec 4/5/2013 15:12'!
backgroundColorBlock

	^ backgroundColorBlock ! !

!RubTextSelectionColor methodsFor: 'accessing' stamp: 'AlainPlantec 4/6/2013 00:39'!
emphasisCode: anInteger
	emphasisCode := anInteger! !

!RubTextSelectionColor methodsFor: 'accessing' stamp: 'AlainPlantec 4/6/2013 00:40'!
emphasisCode
	^ emphasisCode ifNil: [ 0 ]! !

!RubTextSelectionColor methodsFor: 'styling' stamp: 'AlainPlantec 8/2/2013 22:38'!
emphasizeScanner: scanner
	"Set the emphasis for text display"
	"self backgroundColor ifNotNil: [ :bc | scanner backgroundColor: bc ]."
	self textColor ifNotNil: [:c | scanner textColor: c].
	emphasisCode ifNotNil: [ scanner addEmphasis: emphasisCode ]! !

!RubTextSelectionColor methodsFor: 'accessing' stamp: 'AlainPlantec 4/5/2013 15:12'!
theme
	^ UITheme current ! !

!RubTextSelectionColor methodsFor: 'accessing' stamp: 'AlainPlantec 4/5/2013 15:12'!
colorBlock: aBlock
	"aBlock value gives the text color"
	colorBlock := aBlock! !

!RubTextSelectionColor class methodsFor: 'default accessing' stamp: 'AlainPlantec 4/5/2013 15:12'!
primarySelection
	^ PrimarySelection
		ifNil: [ 
			PrimarySelection := self new
				colorBlock: [ self theme currentSettings selectionTextColor ];
				backgroundColorBlock: [ self theme currentSettings selectionColor ];
				yourself ]! !

!RubTextSelectionColor class methodsFor: 'default accessing' stamp: 'AlainPlantec 4/11/2013 15:02'!
findReplaceSelection
	^ FindReplaceSelection
		ifNil: [ 
			FindReplaceSelection := self new
				colorBlock: [ 
							self theme currentSettings haveFindReplaceSelectionTextColor
								ifTrue: [ self theme currentSettings findReplaceSelectionTextColor ]
								ifFalse: [  ] ];
				backgroundColorBlock: [ self theme currentSettings findReplaceSelectionColor ];
				yourself ]! !

!RubTextSelectionColor class methodsFor: 'default accessing' stamp: 'AlainPlantec 4/6/2013 02:39'!
oppositeDelimiterSelection
	^ OppositeDelimiterSelection
		ifNil: [ 
			OppositeDelimiterSelection := RubTextSelectionColor new
				colorBlock: [ Color black ];
				backgroundColorBlock: [ Color green muchLighter ];
				emphasisCode: 0;
				yourself ]! !

!RubTextSelectionColor class methodsFor: 'default accessing' stamp: 'AlainPlantec 4/5/2013 15:12'!
theme
	^ UITheme current ! !

!RubTextSelectionColor class methodsFor: 'default accessing' stamp: 'AlainPlantec 4/11/2013 15:02'!
secondarySelection
	^ SecondarySelection
		ifNil: [ 
			SecondarySelection := self new
				colorBlock: [ 
							self theme currentSettings haveSecondarySelectionTextColor
								ifTrue: [ self theme currentSettings secondarySelectionTextColor ]
								ifFalse: [  ] ];
				backgroundColorBlock: [ self theme currentSettings secondarySelectionColor ];
				yourself ]! !

!RubTextStopConditions methodsFor: 'initialize-release' stamp: 'AlainPlantec 3/17/2013 15:23'!
initialize
	"Initialize the default stop conditions."
	stops := Array new: 258.
	self endOfRun: #endOfRun.
	self crossedX: #crossedX.! !

!RubTextStopConditions methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:23'!
size
	"Return the highest code to which an action can be mapped.
	Do not take into account the two slots for endOfRun and crossedX, since they don't map any character code.
	Warning: this message is used for compatibility with obsolete code."
	
	^256! !

!RubTextStopConditions methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:23'!
at: anInteger put: aSymbolOrNil
	"Set the special action associated with a character of code anInteger, or nil if none.
	The character code should be betxween 1 and 256 (presumably codePoint + 1).
	It can eventually be 257 for endOfRun action, or 258 for crossedX action for backward compatibility with historical squeak versions."
	
	anInteger = 257
		ifTrue: [
			self endOfRun: aSymbolOrNil..
			^aSymbolOrNil].
	anInteger = 258
		ifTrue: [
			self crossedX: aSymbolOrNil..
			^aSymbolOrNil].
	^stops at: anInteger put: aSymbolOrNil! !

!RubTextStopConditions methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:23'!
at: anInteger
	"Answer the special action associated with a character of code anInteger, or nil if none.
	The character code should be betxween 1 and 256 (presumably codePoint + 1).
	It can eventually be 257 for endOfRun action, or 258 for crossedX action for backward compatibility with historical squeak versions."
	
	^stops at: anInteger! !

!RubTextStopConditions methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:23'!
endOfRun
	"Answer the special action to be performed et end of text."
	
	^endOfRun! !

!RubTextStopConditions methodsFor: 'copying' stamp: 'AlainPlantec 3/17/2013 15:23'!
postCopy
	stops := stops copy! !

!RubTextStopConditions methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:23'!
endOfRun: aSymbolOrNil
	endOfRun := aSymbolOrNil.
	
	"Backward compatibility with historical EndOfRun TextConstant handling"
	stops size >= 257 ifTrue: [stops at: 257 put: endOfRun]! !

!RubTextStopConditions methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:23'!
crossedX: aSymbolOrNil
	crossedX := aSymbolOrNil.
	
	"Backward compatibility with historical EndOfRun TextConstant handling"
	stops size >= 258 ifTrue: [stops at: 258 put: crossedX]! !

!RubTextStopConditions methodsFor: 'accessing' stamp: 'AlainPlantec 3/17/2013 15:23'!
crossedX
	"Answer the special action to be performed when crossing composition bounds."
	
	^crossedX! !

!RubTextStopConditions methodsFor: 'initialize-release' stamp: 'AlainPlantec 3/17/2013 15:23'!
setStops: stopArray
	stops := stopArray! !

!RubTextVariableLink commentStamp: 'AndreiChis 11/12/2014 12:02'!
An active link in a text linking to a variable!
!RubTextVariableLink methodsFor: 'accessing' stamp: 'AndreiChis 11/12/2014 11:38'!
variableName: aString
	variableName := aString! !

!RubTextVariableLink methodsFor: 'evaluating' stamp: 'AndreiChis 11/12/2014 11:39'!
actOnClick: anEvent for: aNautilusUI in: aParagraph editor: anEditor
	anEditor editor referencesTo: self variableName.
	^ true! !

!RubTextVariableLink methodsFor: 'accessing' stamp: 'AndreiChis 11/12/2014 11:38'!
variableName
	^ variableName! !

!RubTextVariableLink class methodsFor: 'instance creation' stamp: 'AndreiChis 11/12/2014 11:38'!
variableName: aSymbol
	^ self new
		variableName: aSymbol;
		yourself! !

!RubUnderlinedSegmentMorph methodsFor: 'drawing' stamp: 'AlainPlantec 5/22/2013 17:44'!
underlineShapeFromPosition: firstPos toPosition: lastPos
	| shape ygap pos |
	shape := OrderedCollection new.
	ygap := self straight
		ifTrue: [ 0 ]
		ifFalse: [ 1 ].
	shape add: (pos := firstPos x @ (firstPos y + (ygap // 2))).
	[ pos x < (lastPos x min: self right) ]
		whileTrue: [ 
			ygap := ygap negated.
			pos := (pos x + 2 min: self right) @ (pos y + ygap).
			shape add: pos.
			pos := pos + (1 @ 0) ].
	^ shape! !

!RubUnderlinedSegmentMorph methodsFor: 'initialization' stamp: 'AlainPlantec 5/29/2013 23:36'!
defaultColor
	^ Color white alpha: 0.05
! !

!RubUnderlinedSegmentMorph methodsFor: 'initialization' stamp: 'AlainPlantec 5/29/2013 23:28'!
defaultUnderlineColor
	^ super defaultColor
! !

!RubUnderlinedSegmentMorph methodsFor: 'drawing' stamp: 'AlainPlantec 5/22/2013 00:30'!
drawOn: aCanvas
	super drawOn: aCanvas.
	self drawUnderlineOn: aCanvas! !

!RubUnderlinedSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/29/2013 23:01'!
underlineColor: aColor
	underlineColor := aColor! !

!RubUnderlinedSegmentMorph methodsFor: 'drawing' stamp: 'AlainPlantec 8/2/2013 17:04'!
tabLineDashes
	^ { 1. 1} ! !

!RubUnderlinedSegmentMorph methodsFor: 'drawing' stamp: 'AlainPlantec 5/29/2013 22:39'!
computeVertices
	| lpos rpos fln lln |
	super computeVertices.
	fln := self firstLineIndex.
	lln := self lastLineIndex.
	underlineShape := OrderedCollection new.
	fln to: lln do: [ :idx | 
		| line cidx |
		line := self lines at: idx.
		cidx := idx = fln
			ifTrue: [ firstIndex ]
			ifFalse: [ line first ].
		lpos := (self characterBlockForIndex: cidx) bottomLeft.
		cidx := idx = lln
			ifTrue: [ lastIndex ]
			ifFalse: [ line last ].
		rpos := (self characterBlockForIndex: cidx) bottomLeft.
		underlineShape add: (self underlineShapeFromPosition: lpos toPosition: rpos) ]! !

!RubUnderlinedSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/30/2013 00:15'!
straight: aBoolean
	straight := aBoolean.
	self computeVertices 
	! !

!RubUnderlinedSegmentMorph methodsFor: 'initialization' stamp: 'AlainPlantec 5/29/2013 23:28'!
defaultBorderColor
	^ super defaultColor alpha: 0.5.
! !

!RubUnderlinedSegmentMorph methodsFor: 'drawing' stamp: 'AlainPlantec 5/29/2013 22:29'!
drawUnderlineOn: aCanvas
	underlineShape
		do: [ :s | 
			(1 to: s size - 1 by:
				(self straight
					ifTrue: [ 2 ]
					ifFalse: [ 1 ]))
				do: [ :p | 
					| s1 s2 |
					s1 := s at: p.
					s2 := s at: p + 1.
					aCanvas
						line: s1
						to: s2
						width: 2
						color: self underlineColor ] ]! !

!RubUnderlinedSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/29/2013 23:15'!
underlineColor
	^ underlineColor ifNil: [ underlineColor := self defaultUnderlineColor ]! !

!RubUnderlinedSegmentMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/22/2013 17:07'!
straight
	^ straight ifNil: [ straight := true ]
	! !

!RubWorkspaceExample commentStamp: '<historical>'!
self open!
!RubWorkspaceExample methodsFor: 'shout' stamp: 'AlainPlantec 4/24/2013 12:18'!
hasBindingThatBeginsWith: aString
	^false! !

!RubWorkspaceExample methodsFor: 'accessing' stamp: 'AlainPlantec 4/24/2013 12:01'!
announcer
	^ announcer ifNil: [ announcer := Announcer new ]! !

!RubWorkspaceExample methodsFor: 'code pane menu' stamp: 'AlainPlantec 8/2/2013 09:09'!
codePaneMenu: aMenu shifted: shifted 
	"Note that unless we override perform:orSendTo:, 
	PluggableTextController will respond to all menu items in a 
	text pane"
	"Not tested"! !

!RubWorkspaceExample methodsFor: 'shout' stamp: 'AlainPlantec 4/24/2013 12:10'!
hasBindingOf: aString
	^(self guessTypeForName: aString) notNil! !

!RubWorkspaceExample methodsFor: 'user interface' stamp: 'AlainPlantec 8/1/2013 19:50'!
getText
	^ textModel getText! !

!RubWorkspaceExample methodsFor: 'user interface' stamp: 'AlainPlantec 2/6/2014 13:55'!
newScrolledText
	| st |
	st := textModel newScrolledText 
		beWrapped;
		autoAccept: true;
		withLineNumbers;
		withGhostText: 'Workspace: a place where you can code and test scripts';
		withAnnotation;
		yourself.
	st ghostTextRuler fontName: 'Bitmap DejaVu Sans' pointSize: 18; textColor: Color gray lighter; centered.
	^st! !

!RubWorkspaceExample methodsFor: 'shout' stamp: 'AlainPlantec 8/2/2013 09:54'!
initialize
	super initialize.
	textModel := RubSmalltalkScriptEditorModel new client: self.
	mustDeclareVariables := false.
! !

!RubWorkspaceExample methodsFor: 'completion' stamp: 'AlainPlantec 4/26/2013 01:02'!
isCodeCompletionAllowed

	^ true.! !

!RubWorkspaceExample methodsFor: 'accessing' stamp: 'AlainPlantec 8/1/2013 19:49'!
acceptString: aString
	textModel setText: aString asText.
	 ^ true! !

!RubWorkspaceExample methodsFor: 'shout' stamp: 'AlainPlantec 4/24/2013 12:10'!
guessTypeForName: aString
	| binding |
	
	bindings isNil ifFalse: [ 
		binding := bindings 
			at: aString
			ifAbsent: [ nil ].
		binding isNil
			ifFalse: [ ^ binding class ] ].

	^ nil! !

!RubWorkspaceExample methodsFor: 'user interface' stamp: 'AlainPlantec 6/2/2013 12:44'!
setText: aText from: aView 
	^ self acceptString: aText string! !

!RubWorkspaceExample methodsFor: 'shout' stamp: 'AlainPlantec 4/24/2013 12:13'!
bindingOf: aString 
	
	mustDeclareVariables ifTrue: [^ nil].
	"I want to have workspace that force the user to declare  
	variables. Still subclasses may want to do something else"
	bindings isNil
		ifTrue: [self initializeBindings].
	(bindings includesKey: aString)
		ifFalse: [bindings at: aString put: nil].
	^ bindings associationAt: aString! !

!RubWorkspaceExample methodsFor: 'shout' stamp: 'AlainPlantec 4/24/2013 12:01'!
shoutAboutToStyle: ATextView
	^ true! !

!RubWorkspaceExample class methodsFor: 'examples' stamp: 'AlainPlantec 4/24/2013 11:58'!
open
	(self windowWithScrolledText: (self new newScrolledText)) openInWorld
! !

!RubWorkspaceExample class methodsFor: 'examples' stamp: 'AlainPlantec 5/7/2013 09:34'!
windowWithScrolledText: aScrolledText 
	| w |
	w := StandardWindow new.
	w title: self title.
	self spyAnnouncer ifTrue: [aScrolledText textArea announcer open].
	w addMorph: aScrolledText fullFrame: (0@0 corner: 1@1) asLayoutFrame.
	^w! !

!RubWorkspaceExample class methodsFor: 'examples' stamp: 'AlainPlantec 4/25/2013 22:47'!
spyAnnouncer
	"Set it to true if you want to observe textsurface announcements"
	^ false! !

!RubWorkspaceExample class methodsFor: 'examples' stamp: 'AlainPlantec 4/24/2013 11:58'!
title
	^ 'Rubric workspace example'! !

!RunArray commentStamp: '<historical>'!
My instances provide space-efficient storage of data which tends to be constant over long runs of the possible indices. Essentially repeated values are stored singly and then associated with a "run" length that denotes the number of consecutive occurrences of the value.

My two important variables are
	runs	An array of how many elements are in each run
	values	An array of what the value is over those elements

The variables lastIndex, lastRun and lastOffset cache the last access
so that streaming through RunArrays is not an N-squared process.

Many complexities of access can be bypassed by using the method
	RunArray withStartStopAndValueDo:!
!RunArray methodsFor: 'copying' stamp: 'ls 10/10/1999 13:15'!
copyFrom: start to: stop
	| newRuns run1 run2 offset1 offset2 | 
	stop < start ifTrue: [^RunArray new].
	self at: start setRunOffsetAndValue: [:r :o :value1 | run1 := r. offset1 := o. value1].
	self at: stop setRunOffsetAndValue: [:r :o :value2 | run2 := r. offset2 := o. value2].
	run1 = run2
		ifTrue: 
			[newRuns := Array with: offset2 - offset1 + 1]
		ifFalse: 
			[newRuns := runs copyFrom: run1 to: run2.
			newRuns at: 1 put: (newRuns at: 1) - offset1.
			newRuns at: newRuns size put: offset2 + 1].
	^RunArray runs: newRuns values: (values copyFrom: run1 to: run2)! !

!RunArray methodsFor: 'enumerating' stamp: 'nice 10/29/2011 20:51'!
detectMin: aBlock
	"Only evaluate once per run"

	^values detectMin: aBlock! !

!RunArray methodsFor: 'enumerating' stamp: 'ar 12/27/1999 13:43'!
runsAndValuesDo: aBlock
	"Evaluate aBlock with run lengths and values from the receiver"
	^runs with: values do: aBlock.! !

!RunArray methodsFor: 'accessing' stamp: 'ar 10/16/2001 18:56'!
last
	^values at: values size! !

!RunArray methodsFor: 'enumerating' stamp: 'nice 12/26/2009 20:55'!
runsFrom: start to: stop do: aBlock
	"Evaluate aBlock with all existing runs in the range from start to stop"
	start > stop ifTrue:[^self].
	self at: start setRunOffsetAndValue:[:firstRun :offset :firstValue|
		| run value index |
		run := firstRun.
		value := firstValue.
		index := start + (runs at: run) - offset.
		[aBlock value: value.
		index <= stop] whileTrue:[
			run := run + 1.
			value := values at: run.
			index := index + (runs at: run)]].
! !

!RunArray methodsFor: 'enumerating' stamp: 'nice 10/29/2011 20:52'!
detect: aBlock ifNone: exceptionBlock 
	"Only evaluate once per run"

	^values detect: aBlock ifNone: exceptionBlock ! !

!RunArray methodsFor: 'adding' stamp: 'nice 7/21/2011 20:21'!
add: newObject withOccurrences: anInteger
	"Add value as the last element of the receiver, the given number of times"
	anInteger <= 0 ifTrue: [ ^self ].
	lastIndex := nil. "flush access cache"
	(runs size=0 or: [values last ~= newObject])
		ifTrue:
			[runs := runs copyWith: anInteger.
			values := values copyWith: newObject]
		ifFalse:
			[runs at: runs size put: runs last + anInteger]! !

!RunArray methodsFor: 'private' stamp: 'ar 10/16/2001 18:47'!
setRuns: newRuns setValues: newValues
	lastIndex := nil. "flush access cache"
	runs := newRuns asArray.
	values := newValues asArray.! !

!RunArray methodsFor: 'testing' stamp: 'nice 10/29/2011 21:50'!
isSortedBy: aBlock
	^values isSortedBy: aBlock! !

!RunArray methodsFor: 'adding' stamp: 'nice 3/20/2010 07:58'!
addLast: value
	"Add value as the last element of the receiver."
	lastIndex := nil. "flush access cache"
	(runs size=0 or: [values last ~= value])
		ifTrue:
			[runs := runs copyWith: 1.
			values := values copyWith: value]
		ifFalse:
			[runs at: runs size put: runs last+1].
	^value! !

!RunArray methodsFor: 'enumerating' stamp: 'nice 10/29/2011 22:35'!
replace: aBlock
	"Beware, the block will be evaluated only once per group of values."
	values := values replace: aBlock.
	self coalesce! !

!RunArray methodsFor: 'adding' stamp: 'BG 6/12/2003 11:07'!
rangeOf: attr startingAt: startPos
	"Answer an interval that gives the range of attr at index position startPos. An empty interval with start value startPos is returned when the attribute attr is not present at position startPos. self size > 0 is assumed, it is the responsibility of the caller to test for emptiness of self.
Note that an attribute may span several adjancent runs. "

	self at: startPos 
		setRunOffsetAndValue: 
			[:run :offset :value | 
			^(value includes: attr)
				ifFalse: [startPos to: startPos - 1]
				ifTrue:
					[ | firstRelevantPosition lastRelevantPosition idxOfCandidateRun |
					lastRelevantPosition := startPos - offset + (runs at: run) - 1.
					firstRelevantPosition := startPos - offset.
					idxOfCandidateRun := run + 1.
					[idxOfCandidateRun <= runs size 
							 and: [(values at: idxOfCandidateRun) includes: attr]]
						whileTrue:
							[lastRelevantPosition := lastRelevantPosition + (runs at: idxOfCandidateRun).
							idxOfCandidateRun := idxOfCandidateRun + 1]. 
					idxOfCandidateRun := run - 1.
					[idxOfCandidateRun >= 1 
							 and: [(values at: idxOfCandidateRun) includes: attr]]
						whileTrue:
							[firstRelevantPosition := firstRelevantPosition - (runs at: idxOfCandidateRun).
							idxOfCandidateRun := idxOfCandidateRun - 1]. 
 
					firstRelevantPosition to: lastRelevantPosition]]! !

!RunArray methodsFor: 'printing' stamp: 'tk 12/16/97 09:18'!
writeScanOn: strm
	"Write out the format used for text runs in source files. (14 50 312)f1,f1b,f1LInteger +;i"

	strm nextPut: $(.
	runs do: [:rr | rr printOn: strm. strm space].
	strm skip: -1; nextPut: $).
	values do: [:vv |
		vv do: [:att | att writeScanOn: strm].
		strm nextPut: $,].
	strm skip: -1. "trailing comma"! !

!RunArray methodsFor: 'private' stamp: ''!
values
	"Answer the values in the receiver."

	^values! !

!RunArray methodsFor: 'copying' stamp: ''!
copyReplaceFrom: start to: stop with: replacement

	^(self copyFrom: 1 to: start - 1)
		, replacement 
		, (self copyFrom: stop + 1 to: self size)! !

!RunArray methodsFor: 'copying' stamp: 'nice 10/29/2011 21:07'!
copyUpTo: anElement 
	"Optimized"

	| newValues |
	newValues := values copyUpTo: anElement.
	^ self class
		runs: (runs copyFrom: 1 to: newValues size)
		values: newValues! !

!RunArray methodsFor: 'adding' stamp: 'ar 10/16/2001 18:47'!
addFirst: value
	"Add value as the first element of the receiver."
	lastIndex := nil. "flush access cache"
	(runs size=0 or: [values first ~= value])
		ifTrue:
			[runs := {1}, runs.
			values := {value}, values]
		ifFalse:
			[runs at: 1 put: runs first+1]! !

!RunArray methodsFor: 'adding' stamp: 'ar 10/16/2001 18:48'!
repeatLastIfEmpty: defaultBlock
	"add the last value back again. If we are empty, add (defaultBlock value)"
	lastIndex := nil. "flush access cache"
	(runs size=0)
		ifTrue:[
			runs := runs copyWith: 1.
			values := values copyWith: defaultBlock value]
		ifFalse:
			[runs at: runs size put: runs last+1]! !

!RunArray methodsFor: 'enumerating' stamp: 'nice 10/29/2011 20:51'!
detectMax: aBlock
	"Only evaluate once per run"

	^values detectMax: aBlock! !

!RunArray methodsFor: 'copying' stamp: 'ar 10/16/2001 18:57'!
, aRunArray 
	"Answer a new RunArray that is a concatenation of the receiver and
	aRunArray."

	| new newRuns |
	(aRunArray isMemberOf: RunArray)
		ifFalse: 
			[new := self copy.
			"attempt to be sociable"
			aRunArray do: [:each | new addLast: each].
			^new].
	runs size = 0 ifTrue: [^aRunArray copy].
	aRunArray runs size = 0 ifTrue: [^self copy].
	(values at: values size) ~= (aRunArray values at: 1)
		ifTrue: [^RunArray
					runs: runs , aRunArray runs
					values: values , aRunArray values].
	newRuns := runs
			copyReplaceFrom: runs size
			to: runs size
			with: aRunArray runs.
	newRuns at: runs size put: (runs at: runs size) + (aRunArray runs at: 1).
	^RunArray
		runs: newRuns
		values: 
			(values
				copyReplaceFrom: values size
				to: values size
				with: aRunArray values)! !

!RunArray methodsFor: 'enumerating' stamp: 'nice 7/21/2011 13:56'!
count: aBlock
	"Beware, the block will be evaluated only once per group of values."
	| count |
	count := 0.
	self runsAndValuesDo: [:run :value |
		(aBlock value: value)
			ifTrue:
				[count := count + run]].
	^count! !

!RunArray methodsFor: 'accessing' stamp: 'StephaneDucasse 5/6/2010 08:48'!
at: index put: aValue 
	"Set an element of the RunArray"
	| runIndex offsetInRun lastValue runLength runReplacement valueReplacement iStart iStop |
	index isInteger
		ifFalse: [self errorNonIntegerIndex].
	(index >= 1 and: [index <= self size])
		ifFalse: [self errorSubscriptBounds: index].
	self
		at: index
		setRunOffsetAndValue: [:run :offset :value | 
			runIndex := run.
			offsetInRun := offset.
			lastValue := value].
	aValue = lastValue
		ifTrue: [^ aValue].
	runLength := runs at: runIndex.
	runReplacement := Array
				with: offsetInRun
				with: 1
				with: runLength - offsetInRun - 1.
	valueReplacement := Array
				with: lastValue
				with: aValue
				with: lastValue.
	iStart := offsetInRun = 0
				ifTrue: [2]
				ifFalse: [1].
	iStop := offsetInRun = (runLength - 1)
				ifTrue: [2]
				ifFalse: [3].
	self
		setRuns: (runs copyReplaceFrom: runIndex to: runIndex with: (runReplacement copyFrom: iStart to: iStop))
		setValues: (values copyReplaceFrom: runIndex to: runIndex with: (valueReplacement copyFrom: iStart to: iStop)).
	self coalesce.
	^ aValue! !

!RunArray methodsFor: 'copying' stamp: 'nice 10/5/2009 08:44'!
postCopy
	super postCopy.
	runs := runs copy.
	values := values copy! !

!RunArray methodsFor: 'private' stamp: ''!
at: index setRunOffsetAndValue: aBlock 
	"Supply all run information to aBlock."
	"Tolerates index=0 and index=size+1 for copyReplace: "
	| run limit offset |
	limit := runs size.
	(lastIndex == nil or: [index < lastIndex])
		ifTrue: "cache not loaded, or beyond index - start over"
			[run := 1.
			offset := index-1]
		ifFalse: "cache loaded and before index - start at cache"
			[run := lastRun.
			offset := lastOffset + (index-lastIndex)].
	[run <= limit and: [offset >= (runs at: run)]]
		whileTrue: 
			[offset := offset - (runs at: run).
			run := run + 1].
	lastIndex := index. "Load cache for next access"
	lastRun := run.
	lastOffset := offset.
	run > limit
		ifTrue: 
			["adjustment for size+1"
			run := run - 1.
			offset := offset + (runs at: run)].
	^aBlock
		value: run "an index into runs and values"
		value: offset "zero-based offset from beginning of this run"
		value: (values at: run) "value for this run"! !

!RunArray methodsFor: 'copying' stamp: 'nice 10/29/2011 21:09'!
copyUpThrough: anElement
	"Optimized"

	| newValues |
	newValues := values copyUpThrough: anElement.
	^ self class
		runs: (runs copyFrom: 1 to: newValues size)
		values: newValues! !

!RunArray methodsFor: 'enumerating' stamp: 'nice 10/29/2011 20:57'!
collect: aBlock
	"Beware, the block will be evaluated only once per group of values."
	^(self class runs: runs copy contents values: (values collect: aBlock)) coalesce! !

!RunArray methodsFor: 'enumerating' stamp: 'nice 8/2/2011 11:20'!
reverseDo: aBlock
	"This is refined for speed"
	
	| i |
	i := runs size.
	[i > 0]
		whileTrue: 
			[ | r v |
			v := values at: i.
			r := runs at: i.
			i := i - 1.
			[( r := r - 1) >= 0]
				whileTrue: [aBlock value: v]].! !

!RunArray methodsFor: 'removing' stamp: 'nice 10/29/2011 22:04'!
removeAll
	runs := Array new.
	values := Array new! !

!RunArray methodsFor: 'accessing' stamp: 'ar 10/16/2001 18:56'!
first
	^values at: 1! !

!RunArray methodsFor: 'enumerating' stamp: 'nice 10/29/2011 20:53'!
detectSum: aBlock
	"Only loop on runs"
	| sum |
	sum := 0.
	self runsAndValuesDo: [:run :value | 
		sum := (aBlock value: value) * run + sum].
	^ sum! !

!RunArray methodsFor: 'converting' stamp: 'BG 6/8/2003 15:17'!
reversed
	^self class runs: runs reversed values: values reversed! !

!RunArray methodsFor: 'enumerating' stamp: 'nice 10/29/2011 21:12'!
findFirst: aBlock
	| index |
	index := 1.
	self runsAndValuesDo: [ :run :value |
		(aBlock value: value) ifTrue: [^index].
		index := index + run].
	^0! !

!RunArray methodsFor: 'accessing' stamp: ''!
at: index

	self at: index setRunOffsetAndValue: [:run :offset :value | ^value]! !

!RunArray methodsFor: 'printing' stamp: 'sma 6/1/2000 09:47'!
printOn: aStream
	self printNameOn: aStream.
	aStream
		nextPutAll: ' runs: ';
		print: runs;
		nextPutAll: ' values: ';
		print: values! !

!RunArray methodsFor: 'adding' stamp: 'ar 10/16/2001 18:48'!
repeatLast: times ifEmpty: defaultBlock
	"add the last value back again, the given number of times. If we are empty, add (defaultBlock value)"
	times = 0 ifTrue: [^self ].
	lastIndex := nil. "flush access cache"
	(runs size=0)
		ifTrue:
			[runs := runs copyWith: times.
			values := values copyWith: defaultBlock value]
		ifFalse:
			[runs at: runs size put: runs last+times] ! !

!RunArray methodsFor: 'accessing' stamp: 'nice 12/27/2009 04:54'!
withStartStopAndValueDo: aBlock
	| start |
	start := 1.
	runs with: values do:
		[:len : val | | stop |
		stop := start + len - 1.
		aBlock value: start value: stop value: val.
		start := stop + 1]
		! !

!RunArray methodsFor: 'enumerating' stamp: 'nice 10/29/2011 21:18'!
findLast: aBlock
	| index |
	index := values size + 1.
	[(index := index - 1) >= 1] whileTrue:
		[(aBlock value: (values at: index)) ifTrue: [^(1 to: index) detectSum: [:i | runs at: i]]].
	^0! !

!RunArray methodsFor: 'enumerating' stamp: 'nice 10/29/2011 20:55'!
anySatisfy: aBlock 
	"Only evaluate once per run"

	^values anySatisfy: aBlock! !

!RunArray methodsFor: 'private' stamp: ''!
runs

	^runs! !

!RunArray methodsFor: 'enumerating' stamp: 'nice 10/29/2011 20:55'!
noneSatisfy: aBlock 
	"Only evaluate once per run"

	^values noneSatisfy: aBlock! !

!RunArray methodsFor: 'accessing' stamp: ''!
size
	| size |
	size := 0.
	1 to: runs size do: [:i | size := size + (runs at: i)].
	^size! !

!RunArray methodsFor: 'printing' stamp: ''!
storeOn: aStream

	aStream nextPut: $(.
	aStream nextPutAll: self class name.
	aStream nextPutAll: ' runs: '.
	runs storeOn: aStream.
	aStream nextPutAll: ' values: '.
	values storeOn: aStream.
	aStream nextPut: $)! !

!RunArray methodsFor: 'printing' stamp: ''!
writeOn: aStream

	aStream nextWordPut: runs size.
	1 to: runs size do:
		[:x |
		aStream nextWordPut: (runs at: x).
		aStream nextWordPut: (values at: x)]! !

!RunArray methodsFor: 'copying' stamp: 'nice 10/29/2011 21:07'!
copyUpToLast: anElement
	"Optimized"

	| newValues |
	newValues := values copyUpToLast: anElement.
	^ self class
		runs: (runs copyFrom: 1 to: newValues size)
		values: newValues! !

!RunArray methodsFor: 'removing' stamp: 'nice 10/29/2011 22:01'!
remove: anObject ifAbsent: exceptionBlock
	| index mustCoalesce run |
	index := values indexOf: anObject ifAbsent: [^exceptionBlock value].
	(run := runs at: index) > 1
		ifTrue: [runs at: index put: run - 1]
		ifFalse:
			[mustCoalesce := index > 1 and: [index < values size and: [(values at: index - 1) = (values at: index + 1)]].
			runs := runs copyWithoutIndex: index.
			values := values copyWithoutIndex: index.
			mustCoalesce
				ifTrue:
					[runs at: index - 1 put: (runs at: index - 1) + (runs at: index).
					runs := runs copyWithoutIndex: index.
					values := values copyWithoutIndex: index]].
	^anObject! !

!RunArray methodsFor: 'testing' stamp: 'nice 10/29/2011 21:23'!
includes: anObject
	"Answer whether anObject is one of the receiver's elements."

	^values includes: anObject! !

!RunArray methodsFor: 'testing' stamp: 'nice 10/29/2011 21:50'!
isSorted
	^values isSorted! !

!RunArray methodsFor: 'private' stamp: 'nice 8/2/2011 12:08'!
fillFrom: aCollection with: aBlock
	"Evaluate aBlock with each of aCollection's elements as the argument.
	Collect the resulting values into self. Answer self."

	| newRuns newValues lastLength lastValue |
	newRuns := (Array new: aCollection size) writeStream.
	newValues := (Array new: aCollection size) writeStream.
	lastLength := 0.
	lastValue := Object new.
	aCollection do: [:each | 
		| value |
		value := aBlock value: each.
		lastValue = value
			ifTrue: [lastLength := lastLength + 1]
			ifFalse:
				[lastLength > 0
					ifTrue:
						[newRuns nextPut: lastLength.
						newValues nextPut: lastValue].
				lastLength := 1.
				lastValue := value]].
	lastLength > 0
		ifTrue:
			[newRuns nextPut: lastLength.
			newValues nextPut: lastValue].
	self setRuns: newRuns contents setValues: newValues contents! !

!RunArray methodsFor: 'enumerating' stamp: 'nice 8/2/2011 10:01'!
select: aBlock
	"Beware, the block will be evaluated only once per group of values."
	| newRuns newValues |
	newRuns := (Array new: runs size) writeStream.
	newValues := (Array new: values size) writeStream.
	self runsAndValuesDo: [:run :value |
		(aBlock value: value)
			ifTrue:
				[newRuns add: run.
				newValues add: value]].
	^(self class runs: newRuns contents values: newValues contents) coalesce! !

!RunArray methodsFor: 'comparing' stamp: 'nice 10/29/2011 22:23'!
= otherArray 
	"Test if all my elements are equal to those of otherArray"

	self == otherArray ifTrue: [^true].
	self species == otherArray species ifFalse: [^ false].
	(otherArray isMemberOf: RunArray) ifFalse: [^ self hasEqualElements: otherArray].

	"Faster test between two RunArrays"
	^ (runs hasEqualElements: otherArray runs)
		and: [values hasEqualElements: otherArray values]! !

!RunArray methodsFor: 'enumerating' stamp: 'nice 8/2/2011 11:20'!
do: aBlock
	"This is refined for speed"
	
	1 to: runs size do: [:i |
		| r v |
		v := values at: i.
		r := runs at: i.
		[( r := r - 1) >= 0]
			whileTrue: [aBlock value: v]].! !

!RunArray methodsFor: 'converting' stamp: 'nice 10/29/2011 20:58'!
asSet
	^values asSet! !

!RunArray methodsFor: 'enumerating' stamp: 'nice 10/29/2011 20:55'!
allSatisfy: aBlock 
	"Only evaluate once per run"

	^values allSatisfy: aBlock! !

!RunArray methodsFor: 'converting' stamp: 'nice 10/29/2011 20:59'!
asBag
	| aBag |
	aBag := Bag new: values size.
	self runsAndValuesDo: [:run :value |
		aBag add: value withOccurrences: run].
	^aBag! !

!RunArray methodsFor: 'self evaluating' stamp: 'nice 10/30/2009 20:29'!
isSelfEvaluating
	^ self class == RunArray and: [values isSelfEvaluating]! !

!RunArray methodsFor: 'accessing' stamp: ''!
runLengthAt: index 
	"Answer the length remaining in run beginning at index."

	self at: index 
		setRunOffsetAndValue: [:run :offset :value | ^(runs at: run) - offset]! !

!RunArray methodsFor: 'adding' stamp: 'tk 1/28/98 09:28'!
coalesce
	"Try to combine adjacent runs"
	| ind |
	ind := 2.
	[ind > values size] whileFalse: [
		(values at: ind-1) = (values at: ind) 
			ifFalse: [ind := ind + 1]
			ifTrue: ["two are the same, combine them"
				values := values copyReplaceFrom: ind to: ind with: #().
				runs at: ind-1 put: (runs at: ind-1) + (runs at: ind).
				runs := runs copyReplaceFrom: ind to: ind with: #().
				"self error: 'needed to combine runs' "]].
			! !

!RunArray methodsFor: 'private' stamp: 'ul 8/2/2011 20:09'!
mapValues: mapBlock
	"NOTE: only meaningful to an entire set of runs"

	values := values collect: mapBlock! !

!RunArray class methodsFor: 'instance creation' stamp: 'dc 5/24/2007 10:53'!
new: aSize
	^ self new: aSize withAll: nil! !

!RunArray class methodsFor: 'instance creation' stamp: 'ar 10/16/2001 19:03'!
new

	^self runs: Array new values: Array new! !

!RunArray class methodsFor: 'instance creation' stamp: ''!
readFrom: aStream
	"Answer an instance of me as described on the stream, aStream."

	| size runs values |
	size := aStream nextWord.
	runs := Array new: size.
	values := Array new: size.
	1 to: size do:
		[:x |
		runs at: x put: aStream nextWord.
		values at: x put: aStream nextWord].
	^ self runs: runs values: values! !

!RunArray class methodsFor: 'instance creation' stamp: 'nice 8/2/2011 11:52'!
newFrom: aCollection 
	"Answer an instance of me containing the same elements as aCollection."

	| runs values lastRun lastValue |
	runs := (Array new: aCollection size // 2) writeStream.
	values := (Array new: aCollection size // 2) writeStream.
	lastRun := 0.
	lastValue := Object new.
	aCollection do: [:x | 
		lastValue = x
			ifTrue: [lastRun := lastRun + 1]
			ifFalse:
				[lastRun > 0
					ifTrue:
						[runs nextPut: lastRun.
						values nextPut: lastValue].
				lastRun := 1.
				lastValue := x]].
	lastRun > 0
		ifTrue:
			[runs nextPut: lastRun.
			values nextPut: lastValue].
	^self basicNew setRuns: runs contents setValues: values contents

"	RunArray newFrom: {1. 2. 2. 3}
	{1. $a. $a. 3} as: RunArray
	({1. $a. $a. 3} as: RunArray) values
"! !

!RunArray class methodsFor: 'instance creation' stamp: ''!
runs: newRuns values: newValues 
	"Answer an instance of me with runs and values specified by the 
	arguments."

	| instance |
	instance := self basicNew.
	instance setRuns: newRuns setValues: newValues.
	^instance! !

!RunArray class methodsFor: 'instance creation' stamp: 'nice 10/31/2011 20:27'!
scanFrom: strm
	"Read the style section of a fileOut or sources file.	nextChunk has already been done. We need to return a RunArray of TextAttributes of various kinds. These are written by the implementors of writeScanOn:"
	| runs values attrList char |
	(strm peekFor: $( ) ifFalse: [^ nil].
	runs := OrderedCollection new.
	[strm skipSeparators.
	 strm peekFor: $)] whileFalse: 
		[runs add: (Number readFrom: strm)].
	values := OrderedCollection new. "Value array"
	attrList := OrderedCollection new. "Attributes list"
	[(char := strm next) == nil] whileFalse: [
		char == $, ifTrue: [values add: attrList asArray. attrList := OrderedCollection new].
		char == $a ifTrue: [attrList add: 
			(TextAlignment new alignment: (Integer readFrom: strm ifFail: [0]))].
		char == $f ifTrue: [attrList add: 
			(TextFontChange new fontNumber: (Integer readFrom: strm ifFail: [0]))].
		char == $F ifTrue: [attrList add: (TextFontReference toFont: 
			(Smalltalk at: #StrikeFont ifPresent: [:sf | sf familyName: (strm upTo: $#) size: (Integer readFrom: strm ifFail: [0])]))].
		char == $b ifTrue: [attrList add: (TextEmphasis bold)].
		char == $i ifTrue: [attrList add: (TextEmphasis italic)].
		char == $u ifTrue: [attrList add: (TextEmphasis underlined)].
		char == $= ifTrue: [attrList add: (TextEmphasis struckOut)].
		char == $n ifTrue: [attrList add: (TextEmphasis normal)].
		char == $- ifTrue: [attrList add: (TextKern kern: -1)].
		char == $+ ifTrue: [attrList add: (TextKern kern: 1)].
		char == $c ifTrue: [attrList add: (TextColor scanFrom: strm)]. "color"
		char == $L ifTrue: [attrList add: (TextLink scanFrom: strm)]. "L not look like 1"
		char == $R ifTrue: [attrList add: (TextURL scanFrom: strm)].
				"R capitalized so it can follow a number"
		char == $P ifTrue: [attrList add: (TextPrintIt scanFrom: strm)].
		char == $d ifTrue: [attrList add: (TextDoIt scanFrom: strm)].
		"space, cr do nothing"
		].
	values add: attrList asArray.
	^ self runs: runs asArray values: (values copyFrom: 1 to: runs size) asArray
"
RunArray scanFrom: (ReadStream on: '(14 50 312)f1,f1b,f1LInteger +;i')
"! !

!RunArray class methodsFor: 'instance creation' stamp: 'ar 10/16/2001 19:04'!
new: size withAll: value 
	"Answer a new instance of me, whose every element is equal to the
	argument, value."

	size = 0 ifTrue: [^self new].
	^self runs: (Array with: size) values: (Array with: value)! !

!RunArrayTest commentStamp: 'TorstenBergmann 1/31/2014 12:22'!
SUnit tests for class RunArray!
!RunArrayTest methodsFor: 'tests - accessing' stamp: 'dc 2/12/2007 10:12'!
testWithStartStopAndValueDo
	"self debug: #testWithStartStopAndValueDo"
	| array elements startStops |
	array := #($a $b $b $c $c $c $d $d) as: RunArray.
	elements := OrderedCollection new.
	startStops := OrderedCollection new.
	array withStartStopAndValueDo: [:start :stop :value | elements add: value. startStops add: start->stop].
	
	self assert: elements asArray = #($a $b  $c  $d).
	self assert: startStops asArray = {1->1 . 2->3 . 4->6 . 7->8}! !

!RunArrayTest methodsFor: 'tests - accessing' stamp: 'nice 10/31/2011 20:31'!
testAtPut
	"self debug: #testAtPut"
	| array |
	array := RunArray new: 5 withAll: 2.
	
	array at: 3 put: 5.
	self assert: array asArray = #(2 2 5 2 2).
	
	array at: 1 put: 1.
	self assert: array asArray = #(1 2 5 2 2).! !

!RunArrayTest methodsFor: 'tests - instance creation' stamp: 'nice 10/31/2011 20:32'!
testNewWithAll
	"self debug: #testNewWithAll"
	| array |
	array := RunArray new: 5 withAll: 2.
	self assert: array size = 5.
	self assert: array asArray = #(2 2 2 2 2)! !

!RunArrayTest methodsFor: 'tests - accessing' stamp: 'dc 2/15/2007 10:29'!
testAtPut2
	"self debug: #testAtPut2"
	| array |
	array := RunArray new: 5 withAll: 2.
	
	self should: [array at: 0 put: 5] raise: Error.
	self should: [array at: 6 put: 5] raise: Error.
	self should: [array at: $b put: 5] raise: Error.! !

!RunArrayTest methodsFor: 'tests - instance creation' stamp: 'nice 10/31/2011 20:32'!
testRunsValues
	"self debug: #testRunsValues"
	| array |
	array := RunArray runs: #(1 4 2 1) values: #($a $b $c $a).
	self assert: array size = 8.
	self assert: array asArray = #($a $b $b $b $b $c $c $a).! !

!RunArrayTest methodsFor: 'tests - instance creation' stamp: 'zz 7/2/2008 16:18'!
testANewRunArrayIsEmpty

	| t |
	t := RunArray new.
	self assert:t isEmpty 
! !

!RunArrayTest methodsFor: 'tests - accessing' stamp: 'dc 2/12/2007 09:49'!
testFirst
	"self debug: #testFirst"
	| array |
	array := RunArray new: 5 withAll: 2.
	self assert: array first = 2.
	
	array := #($a $b $c $d) as: RunArray.
	self assert: array first = $a.! !

!RunArrayTest methodsFor: 'tests - instance creation' stamp: 'dc 5/24/2007 10:56'!
testNewWithSize
	|array|
	array := RunArray new: 5.
	self assert: array size = 5.
	1 to: 5 do: [:index | self assert: (array at: index) isNil]! !

!RunArrayTest methodsFor: 'tests - accessing' stamp: 'dc 2/12/2007 09:58'!
testRunLengthAt
	"self debug: #testRunLengthAt"
	| array |
	array := #($a $b $b $c $c $c $d $d) as: RunArray.
	self assert: (array runLengthAt: 1) = 1.
	self assert: (array runLengthAt: 2) = 2.
	self assert: (array runLengthAt: 3) = 1.
	self assert: (array runLengthAt: 4) = 3.
	self assert: (array runLengthAt: 5) = 2.
	self assert: (array runLengthAt: 6) = 1.
	self assert: (array runLengthAt: 7) = 2.
	self assert: (array runLengthAt: 8) = 1.! !

!RunArrayTest methodsFor: 'tests - accessing' stamp: 'dc 2/15/2007 10:25'!
testAt
	"self debug: #testAt"
	| array |
	array := RunArray new: 5 withAll: 2.
	self assert: (array at: 3) = 2.
	
	array at: 3 put: 5.
	self assert: (array at: 3) = 5
! !

!RunArrayTest methodsFor: 'tests - instance creation' stamp: 'dc 2/12/2007 09:22'!
testNew
	"self debug: #testNew"
	| array |
	array := RunArray new.
	self assert: array size = 0.! !

!RunArrayTest methodsFor: 'tests - instance creation' stamp: 'nice 10/31/2011 20:32'!
testNewFrom
	"self debug: #testNewFrom"
	| array |
	array := RunArray newFrom: #($a $b $b $b $b $c $c $a).
	self assert: array size = 8.
	self assert: array asArray = #($a $b $b $b $b $c $c $a).! !

!RunArrayTest methodsFor: 'tests - instance creation' stamp: 'damiencassou 5/30/2008 14:26'!
testScanFromANSICompatibility
	"self run: #testScanFromANSICompatibility"
	RunArray scanFrom: '()f1dNumber new;;' readStream.
	RunArray scanFrom: '()a1death;;' readStream.
	RunArray scanFrom: '()F1death;;' readStream! !

!RunArrayTest methodsFor: 'tests - accessing' stamp: 'dc 2/12/2007 09:49'!
testLast
	"self debug: #testLast"
	| array |
	array := RunArray new: 5 withAll: 2.
	self assert: array last = 2.
	
	array := #($a $b $c $d) as: RunArray.
	self assert: array last = $d.! !

!RunArrayTest methodsFor: 'tests - instance creation' stamp: 'MarcusDenker 5/2/2013 11:36'!
testIsSelfEvaluating
	| array array2 |
	array := RunArray new: 5 withAll: 2.
	self assert: array isSelfEvaluating.
	array2 := RunArray new: 5 withAll: Object new.
	array2 isSelfEvaluating ifTrue: [self
		assert: (self class compiler evaluate: array2 printString) = array2
		description: 'a self evaluating should evaluate as self'].! !

!RunToSelectionDebugAction commentStamp: '<historical>'!
A RunToSelectionDebugAction resumes the execution until the selected position in the source code is reached.!
!RunToSelectionDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/20/2013 15:26'!
id

	^ #runToHere! !

!RunToSelectionDebugAction methodsFor: 'actions' stamp: 'AndreiChis 9/20/2013 15:27'!
executeAction

	self session 
		runToSelection: self debugger code getSelection 
		inContext: self currentContext! !

!RunToSelectionDebugAction methodsFor: 'testing' stamp: 'AndreiChis 9/20/2013 17:16'!
appliesToDebugger: aDebugger

	^ aDebugger session isInterruptedContextPostMortem not! !

!RunToSelectionDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/17/2013 19:26'!
defaultLabel

	^ 'Run to here'! !

!RunToSelectionDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/20/2013 15:56'!
defaultOrder

	^ 35! !

!RunToSelectionDebugAction class methodsFor: 'registration' stamp: 'AndreiChis 12/17/2013 14:29'!
actionType
	<debuggingAction>
	<contextMenuCodeDebuggingAction>! !

!RussianEnvironment commentStamp: 'StephaneDucasse 11/29/2011 22:25'!
EncodedCharSet initialize.
LanguageEnvironment resetKnownEnvironments.
Locale switchToID: (LocaleID isoLanguage: 'ru').
!
!RussianEnvironment class methodsFor: 'subclass responsibilities' stamp: 'yo 8/29/2008 14:11'!
systemConverterClass

	^ UTF8TextConverter! !

!RussianEnvironment class methodsFor: 'subclass responsibilities' stamp: 'yo 12/11/2007 11:22'!
supportedLanguages
	"Return the languages that this class supports. 
	Any translations for those languages will use this class as their environment."
	
	^#('ru' )! !

!RussianEnvironment class methodsFor: 'class initialization' stamp: 'StephaneDucasse 8/22/2013 14:32'!
initialize

	EncodedCharSet declareEncodedCharSet: self atIndex: 15+1.! !

!RussianEnvironment class methodsFor: 'subclass responsibilities' stamp: 'nice 5/1/2011 19:22'!
leadingChar

	^0! !

!RxCharSetParser commentStamp: 'Tbn 11/12/2010 23:13'!
-- Regular Expression Matcher v 1.1 (C) 1996, 1999 Vassili Bykov
--
I am a parser created to parse the insides of a character set ([...]) construct. I create and answer a collection of "elements", each being an instance of one of: RxsCharacter, RxsRange, or RxsPredicate.

Instance Variables:

	source	<Stream>	open on whatever is inside the square brackets we have to parse.
	lookahead	<Character>	The current lookahead character
	elements	<Collection of: <RxsCharacter|RxsRange|RxsPredicate>> Parsing result!
!RxCharSetParser methodsFor: 'parsing' stamp: 'vb 4/11/09 21:56'!
addChar: aChar

	elements add: (RxsCharacter with: aChar)! !

!RxCharSetParser methodsFor: 'parsing' stamp: 'CamilloBruni 10/7/2012 22:53'!
parseStep

	lookahead = $[ ifTrue:
		[source peek = $:
			ifTrue: [^self parseNamedSet]
			ifFalse: [^self parseCharOrRange]].
	lookahead = $\ ifTrue:
		[^self parseEscapeChar].
	lookahead = $- ifTrue:
		[RxParser signalSyntaxException: 'invalid range' at: source position].
	self parseCharOrRange! !

!RxCharSetParser methodsFor: 'parsing' stamp: 'vb 4/11/09 21:56'!
parseCharOrRange

	| firstChar |
	firstChar := lookahead.
	self match: firstChar.
	lookahead = $- ifTrue:
		[self match: $-.
		lookahead isNil
			ifTrue: [^self addChar: firstChar; addChar: $-]
			ifFalse: 
				[self addRangeFrom: firstChar to: lookahead.
				^self match: lookahead]].
	self addChar: firstChar! !

!RxCharSetParser methodsFor: 'parsing' stamp: 'CamilloBruni 10/7/2012 22:52'!
match: aCharacter

	aCharacter = lookahead
		ifFalse: [
			RxParser 
				signalSyntaxException: 'unexpected character: ', (String with: lookahead)
				at: source position].
	^source atEnd
		ifTrue: [lookahead := nil]
		ifFalse: [lookahead := source next]! !

!RxCharSetParser methodsFor: 'parsing' stamp: 'vb 4/11/09 21:56'!
parseNamedSet

	| name |
	self match: $[; match: $:.
	name := (String with: lookahead), (source upTo: $:).
	lookahead := source next.
	self match: $].
	elements add: (RxsPredicate forNamedClass: name)! !

!RxCharSetParser methodsFor: 'parsing' stamp: 'vb 4/11/09 21:56'!
parseEscapeChar

	self match: $\.
	$- = lookahead
		ifTrue: [elements add: (RxsCharacter with: $-)]
		ifFalse: [elements add: (RxsPredicate forEscapedLetter: lookahead)].
	self match: lookahead! !

!RxCharSetParser methodsFor: 'parsing' stamp: 'CamilloBruni 10/7/2012 22:52'!
addRangeFrom: firstChar to: lastChar

	firstChar asInteger > lastChar asInteger ifTrue:
		[RxParser signalSyntaxException: ' bad character range' at: source position].
	elements add: (RxsRange from: firstChar to: lastChar)! !

!RxCharSetParser methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
initialize: aStream

	source := aStream.
	lookahead := aStream next.
	elements := OrderedCollection new! !

!RxCharSetParser methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
parse

	lookahead = $- ifTrue:
		[self addChar: $-.
		self match: $-].
	[lookahead isNil] whileFalse: [self parseStep].
	^elements! !

!RxCharSetParser class methodsFor: 'instance creation' stamp: 'vb 4/11/09 21:56'!
on: aStream

	^self new initialize: aStream! !

!RxMatchOptimizer commentStamp: 'Tbn 11/12/2010 23:13'!
-- Regular Expression Matcher v 1.1 (C) 1996, 1999 Vassili Bykov
--
A match start optimizer, handy for searching a string. Takes a regex syntax tree and sets itself up so that prefix characters or matcher states that cannot start a match are later recognized with #canStartMatch:in: method.

Used by RxMatcher, but can be used by other matchers (if implemented) as well.!
!RxMatchOptimizer methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
nonMethodPredicateTester
	| p selector |
	nonMethodPredicates isEmpty ifTrue: [^nil].
	p := self optimizeSet: nonMethodPredicates.	"also allows copying closures"
	^p size = 1
		ifTrue: 
			[selector := p first.
			[:char :matcher | 
			RxParser doHandlingMessageNotUnderstood:
				[(char perform: selector) not]]]
		ifFalse: 
			[[:char :m | 
			RxParser doHandlingMessageNotUnderstood:
				[p contains: [:sel | (char perform: sel) not]]]]! !

!RxMatchOptimizer methodsFor: 'private' stamp: 'vb 4/11/09 21:56'!
nonPrefixTester

	| np nonPrefixChar |
	nonPrefixes isEmpty ifTrue: [^nil].
	np := self optimizeSet: nonPrefixes. "also allows copying closures"
	^np size = 1 "might be be pretty common case"
		ifTrue: 
			[nonPrefixChar := np first.
			[:char :matcher | char ~= nonPrefixChar]]
		ifFalse: [[:char : matcher | (np includes: char) not]]! !

!RxMatchOptimizer methodsFor: 'double dispatch' stamp: 'vb 4/11/09 21:56'!
syntaxCharSet: charSetNode 
	"All these (or none of these) characters is the prefix."

	charSetNode isNegated
		ifTrue: [nonPrefixes addAll: (charSetNode enumerableSetIgnoringCase: ignoreCase)]
		ifFalse: [prefixes addAll: (charSetNode enumerableSetIgnoringCase: ignoreCase)].
	charSetNode hasPredicates ifTrue: 
			[charSetNode isNegated
				ifTrue: [nonPredicates addAll: charSetNode predicates]
				ifFalse: [predicates addAll: charSetNode predicates]]! !

!RxMatchOptimizer methodsFor: 'double dispatch' stamp: 'vb 4/11/09 21:56'!
syntaxRegex: regexNode
	"All prefixes of the regex's branches should be combined.
	Therefore, just recurse."

	regexNode branch dispatchTo: self.
	regexNode regex notNil
		ifTrue: [regexNode regex dispatchTo: self]! !

!RxMatchOptimizer methodsFor: 'double dispatch' stamp: 'vb 4/11/09 21:56'!
syntaxCharacter: charNode
	"This character is the prefix, of one of them."

	prefixes add: charNode character! !

!RxMatchOptimizer methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
canStartMatch: aCharacter in: aMatcher 
	"Answer whether a match could commence at the given lookahead
	character, or in the current state of <aMatcher>. True answered
	by this method does not mean a match will definitly occur, while false
	answered by this method *does* guarantee a match will never occur."

	aCharacter isNil ifTrue: [^true].
	^testBlock == nil or: [testBlock value: aCharacter value: aMatcher]! !

!RxMatchOptimizer methodsFor: 'private' stamp: 'vb 4/11/09 21:56'!
determineTestMethod
	"Answer a block closure that will work as a can-match predicate.
	Answer nil if no viable optimization is possible (too many chars would
	be able to start a match)."

	| testers |
	(conditions includes: #any) ifTrue: [^nil].
	testers := OrderedCollection new: 5.
	#(#prefixTester #nonPrefixTester #conditionTester #methodPredicateTester #nonMethodPredicateTester #predicateTester #nonPredicateTester)
		do: 
			[:selector | 
			| tester |
			tester := self perform: selector.
			tester notNil ifTrue: [testers add: tester]].
	testers isEmpty ifTrue: [^nil].
	testers size = 1 ifTrue: [^testers first].
	testers := testers asArray.
	^[:char :matcher | testers contains: [:t | t value: char value: matcher]]! !

!RxMatchOptimizer methodsFor: 'initialize-release' stamp: 'CamilloBruni 8/28/2013 16:49'!
initialize: aRegex ignoreCase: aBoolean 
	"Set `testMethod' variable to a can-match predicate block:
	two-argument block which accepts a lookahead character
	and a matcher (presumably built from aRegex) and answers 
	a boolean indicating whether a match could start at the given
	lookahead. "

	ignoreCase := aBoolean.
	prefixes := Set new: 10.
	nonPrefixes := Set new: 10.
	conditions := Set new: 3.
	methodPredicates := Set new: 3.
	nonMethodPredicates := Set new: 3.
	predicates := Set new: 3.
	nonPredicates := Set new: 3.
	lookarounds := Set new: 3.
	aRegex dispatchTo: self.	"If the whole expression is nullable, 
		end-of-line is an implicit can-match condition!!"
	aRegex isNullable ifTrue: [conditions add: #atEndOfLine].
	testBlock := self determineTestMethod! !

!RxMatchOptimizer methodsFor: 'double dispatch' stamp: 'vb 4/11/09 21:56'!
syntaxEpsilon
	"Empty string, terminate the recursion (do nothing)."! !

!RxMatchOptimizer methodsFor: 'double dispatch' stamp: 'vb 4/11/09 21:56'!
syntaxAny
	"Any special char is among the prefixes."

	conditions add: #any! !

!RxMatchOptimizer methodsFor: 'private' stamp: 'vb 4/11/09 21:56'!
prefixTester

	| p prefixChar |
	prefixes isEmpty ifTrue: [^nil].
	p := self optimizeSet: prefixes. "also allows copying closures"
	ignoreCase ifTrue: [p := p collect: [:each | each asUppercase]].
	^p size = 1 "might be a pretty common case"
		ifTrue: 
			[prefixChar := p first.
			ignoreCase
				ifTrue: [[:char :matcher | char sameAs: prefixChar]]
				ifFalse: [[:char :matcher | char = prefixChar]]]
		ifFalse:
			[ignoreCase
				ifTrue: [[:char :matcher | p includes: char asUppercase]]
				ifFalse: [[:char :matcher | p includes: char]]]! !

!RxMatchOptimizer methodsFor: 'double dispatch' stamp: 'vb 4/11/09 21:56'!
syntaxEndOfLine
	"Beginning of line is among the prefixes."

	conditions add: #atEndOfLine! !

!RxMatchOptimizer methodsFor: 'double dispatch' stamp: 'vb 4/11/09 21:56'!
syntaxMessagePredicate: messagePredicateNode 
	messagePredicateNode negated
		ifTrue: [nonMethodPredicates add: messagePredicateNode selector]
		ifFalse: [methodPredicates add: messagePredicateNode selector]! !

!RxMatchOptimizer methodsFor: 'double dispatch' stamp: 'vb 4/11/09 21:56'!
syntaxBranch: branchNode
	"If the head piece of the branch is transparent (allows 0 matches),
	we must recurse down the branch. Otherwise, just the head atom
	is important."

	(branchNode piece isNullable and: [branchNode branch notNil])
		ifTrue: [branchNode branch dispatchTo: self].
	branchNode piece dispatchTo: self! !

!RxMatchOptimizer methodsFor: 'double dispatch' stamp: 'vb 4/11/09 21:56'!
syntaxEndOfWord

	conditions add: #atEndOfWord! !

!RxMatchOptimizer methodsFor: 'private' stamp: 'vb 4/11/09 21:56'!
nonPredicateTester

	| p pred |
	nonPredicates isEmpty ifTrue: [^nil].
	p := self optimizeSet: nonPredicates.	"also allows copying closures"
	^p size = 1
		ifTrue: 
			[pred := p first.
			[:char :matcher | (pred value: char) not]]
		ifFalse: 
			[[:char :m | p contains: [:some | (some value: char) not]]]! !

!RxMatchOptimizer methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
conditionTester
	"#any condition is filtered at the higher level;
	it cannot appear among the conditions here."

	| matchCondition |
	conditions isEmpty ifTrue: [^nil].
	conditions size = 1 ifTrue:
		[matchCondition := conditions detect: [:ignored | true].
		"Special case all of the possible conditions."
		#atBeginningOfLine = matchCondition ifTrue: [^[:c :matcher | matcher atBeginningOfLine]].
		#atEndOfLine = matchCondition ifTrue: [^[:c :matcher | matcher atEndOfLine]].
		#atBeginningOfWord = matchCondition ifTrue: [^[:c :matcher | matcher atBeginningOfWord]].
		#atEndOfWord = matchCondition ifTrue: [^[:c :matcher | matcher atEndOfWord]].
		#atWordBoundary = matchCondition ifTrue: [^[:c :matcher | matcher atWordBoundary]].
		#notAtWordBoundary = matchCondition ifTrue: [^[:c :matcher | matcher notAtWordBoundary]].
		RxParser signalCompilationException: 'invalid match condition'].
	"More than one condition. Capture them as an array in scope."
	matchCondition := conditions asArray.
	^[:c :matcher |
		matchCondition contains:
			[:conditionSelector |
			matcher perform: conditionSelector]]! !

!RxMatchOptimizer methodsFor: 'double dispatch' stamp: 'vb 4/11/09 21:56'!
syntaxPredicate: predicateNode 

	predicates add: predicateNode predicate! !

!RxMatchOptimizer methodsFor: 'private' stamp: 'CamilloBruni 8/28/2013 16:47'!
predicateTester

	| p pred |
	predicates isEmpty ifTrue: [^nil].
	p := self optimizeSet: predicates.	"also allows copying closures"
	^p size = 1
		ifTrue: [
			pred := p first.
			[:char :matcher | 
				pred value: char ]]
		ifFalse: [
			[:char :matcher | 
				p contains: [:some | some value: char ]]]! !

!RxMatchOptimizer methodsFor: 'double dispatch' stamp: 'vb 4/11/09 21:56'!
syntaxBeginningOfWord
	"Beginning of line is among the prefixes."

	conditions add: #atBeginningOfWord! !

!RxMatchOptimizer methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
methodPredicateTester
	| p selector |
	methodPredicates isEmpty ifTrue: [^nil].
	p := self optimizeSet: methodPredicates.	"also allows copying closures"
	^p size = 1
		ifTrue: 
			["might be a pretty common case"
			selector := p first.
			[:char :matcher | 
			RxParser doHandlingMessageNotUnderstood:
				[char perform: selector]]]
		ifFalse: 
			[[:char :m | 
			RxParser doHandlingMessageNotUnderstood:
				[p contains: [:sel | char perform: sel]]]]! !

!RxMatchOptimizer methodsFor: 'double dispatch' stamp: 'CamilloBruni 8/28/2013 16:48'!
syntaxLookaround: lookaroundNode 

	
	lookarounds add: lookaroundNode! !

!RxMatchOptimizer methodsFor: 'double dispatch' stamp: 'vb 4/11/09 21:56'!
syntaxNonWordBoundary

	conditions add: #notAtWordBoundary! !

!RxMatchOptimizer methodsFor: 'private' stamp: 'vb 4/11/09 21:56'!
optimizeSet: aSet
	"If a set is small, convert it to array to speed up lookup
	(Array has no hashing overhead, beats Set on small number
	of elements)."

	^aSet size < 10 ifTrue: [aSet asArray] ifFalse: [aSet]! !

!RxMatchOptimizer methodsFor: 'double dispatch' stamp: 'vb 4/11/09 21:56'!
syntaxWordBoundary

	conditions add: #atWordBoundary! !

!RxMatchOptimizer methodsFor: 'double dispatch' stamp: 'vb 4/11/09 21:56'!
syntaxPiece: pieceNode
	"Pass on to the atom."

	pieceNode atom dispatchTo: self! !

!RxMatchOptimizer methodsFor: 'double dispatch' stamp: 'vb 4/11/09 21:56'!
syntaxBeginningOfLine
	"Beginning of line is among the prefixes."

	conditions add: #atBeginningOfLine! !

!RxMatcher commentStamp: 'Tbn 11/12/2010 23:13'!
-- Regular Expression Matcher v 1.1 (C) 1996, 1999 Vassili Bykov
--
This is a recursive regex matcher. Not strikingly efficient, but simple. Also, keeps track of matched subexpressions.  The life cycle goes as follows:

1. Initialization. Accepts a syntax tree (presumably produced by RxParser) and compiles it into a matcher built of other classes in this category.

2. Matching. Accepts a stream or a string and returns a boolean indicating whether the whole stream or its prefix -- depending on the message sent -- matches the regex.

3. Subexpression query. After a successful match, and before any other match, the matcher may be queried about the range of specific stream (string) positions that matched to certain parenthesized subexpressions of the original expression.

Any number of queries may follow a successful match, and any number or matches may follow a successful initialization.

Note that `matcher' is actually a sort of a misnomer. The actual matcher is a web of Rxm* instances built by RxMatcher during initialization. RxMatcher is just the interface facade of this network.  It is also a builder of it, and also provides a stream-like protocol to easily access the stream being matched.

Instance variables:
	matcher				<RxmLink> The entry point into the actual matcher.
	stream				<Stream> The stream currently being matched against.
	markerPositions		<Array of: Integer> Positions of markers' matches.
	markerCount		<Integer> Number of markers.
	lastResult 			<Boolean> Whether the latest match attempt succeeded or not.
	lastChar			<Character | nil> character last seen in the matcher stream!
!RxMatcher methodsFor: 'private' stamp: 'lr 1/15/2010 21:17'!
proceedSearchingStream: aStream

	| position |
	position := aStream position.
	[aStream atEnd] whileFalse:
		[self tryMatch ifTrue: [^true].
		aStream position: position; next.
		position := aStream position].
	"Try match at the very stream end too!!"
	self tryMatch ifTrue: [^true]. 
	^false! !

!RxMatcher methodsFor: 'testing' stamp: 'lr 1/15/2010 21:12'!
atWordBoundary

	^(self isWordChar: self lastChar)
		xor: (self isWordChar: stream peek)! !

!RxMatcher methodsFor: 'double dispatch' stamp: 'vb 4/11/09 21:56'!
syntaxRegex: regexNode
	"Double dispatch from the syntax tree. 
	Regex node is a chain of branches to be tried. Should compile this 
	into a bundle of parallel branches, between two marker nodes." 
	
	| startIndex endIndex endNode alternatives |
	startIndex := self allocateMarker.
	endIndex := self allocateMarker.
	endNode := RxmMarker new index: endIndex.
	alternatives := self hookBranchOf: regexNode onto: endNode.
	^(RxmMarker new index: startIndex)
		pointTailTo: alternatives;
		yourself! !

!RxMatcher methodsFor: 'double dispatch' stamp: 'vb 4/11/09 21:56'!
syntaxCharacter: charNode
	"Double dispatch from the syntax tree. 
	We get here when no merging characters into strings was possible."

	| wanted |
	wanted := charNode character.
	^RxmPredicate new predicate: 
		(ignoreCase
			ifTrue: [[:char | char sameAs: wanted]]
			ifFalse: [[:char | char = wanted]])! !

!RxMatcher methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
initialize: syntaxTreeRoot ignoreCase: aBoolean
	"Compile thyself for the regex with the specified syntax tree.
	See comment and `building' protocol in this class and 
	#dispatchTo: methods in syntax tree components for details 
	on double-dispatch building. 
	The argument is supposedly a RxsRegex."

	ignoreCase := aBoolean.
	self buildFrom: syntaxTreeRoot.
	startOptimizer := RxMatchOptimizer new initialize: syntaxTreeRoot ignoreCase: aBoolean! !

!RxMatcher methodsFor: 'privileged' stamp: 'vb 4/11/09 21:56'!
restoreState: aBlock

	aBlock value! !

!RxMatcher methodsFor: 'double dispatch' stamp: 'vb 4/11/09 21:56'!
syntaxEpsilon
	"Double dispatch from the syntax tree. Match empty string. This is unlikely
	to happen in sane expressions, so we'll live without special epsilon-nodes."

	^RxmSubstring new
		substring: String new
		ignoreCase: ignoreCase! !

!RxMatcher methodsFor: 'double dispatch' stamp: 'vb 4/11/09 21:56'!
syntaxAny
	"Double dispatch from the syntax tree. 
	Create a matcher for any non-null character."

	^RxmPredicate new
		predicate: [:char | char asInteger ~= 0]! !

!RxMatcher methodsFor: 'match enumeration' stamp: 'vb 4/11/09 21:56'!
matchesOnStream: aStream collect: aBlock

	| result |
	result := OrderedCollection new.
	self
		matchesOnStream: aStream
		do: [:match | result add: (aBlock value: match)].
	^result! !

!RxMatcher methodsFor: 'double dispatch' stamp: 'vb 4/11/09 21:56'!
syntaxEndOfLine
	"Double dispatch from the syntax tree. 
	Create a matcher for end-of-line condition."

	^RxmSpecial new beEndOfLine! !

!RxMatcher methodsFor: 'accessing' stamp: 'lr 1/15/2010 21:45'!
searchStream: aStream
	"Search the stream for occurrence of something matching myself.
	After the search has occurred, stop positioned after the end of the
	matched substring. Answer a Boolean indicating success."

	| position |
	stream := aStream.
	position := aStream position.
	markerPositions := nil.
	[aStream atEnd] whileFalse:
		[self tryMatch ifTrue: [^true].
		aStream position: position; next.
		position := aStream position].
	"Try match at the very stream end too!!"
	self tryMatch ifTrue: [^true]. 
	^false! !

!RxMatcher methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
subexpressions: subIndex
	"Answer an array of all matches of the subexpression at the given index.
	The answer is always an array; it is empty if there are no matches."

	| originalPosition startPositions stopPositions reply |
	originalPosition := stream position.
	startPositions := self subBeginning: subIndex.
	stopPositions := self subEnd: subIndex.
	(startPositions isEmpty or: [stopPositions isEmpty]) ifTrue: [^Array new].
	reply := OrderedCollection new.
	startPositions with: stopPositions do:
		[:start :stop |
		stream position: start.
		reply add: (stream next: stop - start)].
	stream position: originalPosition.
	^reply asArray! !

!RxMatcher methodsFor: 'private' stamp: 'vb 4/11/09 21:56'!
makePlus: aMatcher
	"Private - Wrap this matcher so that the result would match 1 and more
	occurrences of the matcher."

	| loopback |
	loopback := (RxmBranch new beLoopback)
		next: aMatcher.
	aMatcher pointTailTo: loopback.
	^aMatcher! !

!RxMatcher methodsFor: '*GT-Playground' stamp: 'StefanReichhart 3/21/2015 09:52'!
matchesIn: aString subexpressionsDo: aBlock
	self matchesOnStream: aString readStream subexpressionsDo: aBlock! !

!RxMatcher methodsFor: 'double dispatch' stamp: 'vb 4/11/09 21:56'!
syntaxMessagePredicate: messagePredicateNode
	"Double dispatch from the syntax tree. 
	Special link can handle predicates."

	^messagePredicateNode negated
		ifTrue: [RxmPredicate new bePerformNot: messagePredicateNode selector]
		ifFalse: [RxmPredicate new bePerform: messagePredicateNode selector]! !

!RxMatcher methodsFor: 'match enumeration' stamp: 'vb 4/11/09 21:56'!
matchesOnStream: aStream

	| result |
	result := OrderedCollection new.
	self
		matchesOnStream: aStream
		do: [:match | result add: match].
	^result! !

!RxMatcher methodsFor: 'testing' stamp: 'lr 1/15/2010 21:12'!
atBeginningOfLine

	^self position = 0 or: [self lastChar = Cr]! !

!RxMatcher methodsFor: 'privileged' stamp: 'lr 1/15/2010 21:13'!
currentState
	"Answer an opaque object that can later be used to restore the
	matcher's state (for backtracking)."

	| origPosition origLastChar |
	origPosition := stream position.
	^	[stream position: origPosition]! !

!RxMatcher methodsFor: 'private' stamp: 'vb 4/11/09 21:56'!
makeStar: aMatcher
	"Private - Wrap this matcher so that the result would match 0 and more
	occurrences of the matcher."

	| dummy detour loopback |
	dummy := RxmLink new.
	detour := RxmBranch new
		next: aMatcher;
		alternative: dummy.
	loopback := (RxmBranch new beLoopback)
		next: aMatcher;
		alternative: dummy.
	aMatcher pointTailTo: loopback.
	^detour! !

!RxMatcher methodsFor: 'match enumeration' stamp: 'vb 4/11/09 21:56'!
matchesIn: aString
	"Search aString repeatedly for the matches of the receiver.  Answer an OrderedCollection of all matches (substrings)."

	| result |
	result := OrderedCollection new.
	self
		matchesOnStream: aString readStream
		do: [:match | result add: match].
	^result! !

!RxMatcher methodsFor: 'double dispatch' stamp: 'vb 4/11/09 21:56'!
syntaxPredicate: predicateNode
	"Double dispatch from the syntax tree. 
	A character set is a few characters, and we either match any of them,
	or match any that is not one of them."

	^RxmPredicate with: predicateNode predicate! !

!RxMatcher methodsFor: 'private' stamp: 'vb 4/11/09 21:56'!
makeOptional: aMatcher
	"Private - Wrap this matcher so that the result would match 0 or 1
	occurrences of the matcher."

	| dummy branch |
	dummy := RxmLink new.
	branch := (RxmBranch new beLoopback)
		next: aMatcher;
		alternative: dummy.
	aMatcher pointTailTo: dummy.
	^branch! !

!RxMatcher methodsFor: 'private' stamp: 'vb 4/11/09 21:56'!
hookBranchOf: regexNode onto: endMarker
	"Private - Recurse down the chain of regexes starting at
	regexNode, compiling their branches and hooking their tails 
	to the endMarker node."

	| rest |
	rest := regexNode regex isNil
		ifTrue: [nil]
		ifFalse: [self hookBranchOf: regexNode regex onto: endMarker].
	^RxmBranch new
		next: ((regexNode branch dispatchTo: self)
					pointTailTo: endMarker; 
					yourself);
		alternative: rest;
		yourself! !

!RxMatcher methodsFor: 'private' stamp: 'vb 4/11/09 21:56'!
isWordChar: aCharacterOrNil
	"Answer whether the argument is a word constituent character:
	alphanumeric or _."

	^aCharacterOrNil ~~ nil
		and: [aCharacterOrNil isAlphaNumeric]! !

!RxMatcher methodsFor: 'testing' stamp: 'vb 4/11/09 21:56'!
notAtWordBoundary

	^self atWordBoundary not! !

!RxMatcher methodsFor: 'streaming' stamp: 'vb 4/11/09 21:56'!
position

	^stream position! !

!RxMatcher methodsFor: 'accessing' stamp: 'CamilloBruni 10/10/2012 14:14'!
matches: aString
	"Match against a string. Return true if the complete String matches.
	If you want to search for occurences anywhere in the String see #search:"

	^self matchesStream: aString readStream! !

!RxMatcher methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
subEnd: subIndex

	^markerPositions at: subIndex * 2! !

!RxMatcher methodsFor: 'testing' stamp: 'vb 4/11/09 21:56'!
supportsSubexpressions

	^true! !

!RxMatcher methodsFor: 'double dispatch' stamp: 'CamilloBruni 8/14/2013 13:01'!
syntaxPiece: pieceNode
	"Double dispatch from the syntax tree. 
	Piece is an atom repeated a few times. Take care of a special
	case when the atom is repeated just once."

	| atom |
	atom := pieceNode atom dispatchTo: self.
	^pieceNode isSingular
		ifTrue: [atom]
		ifFalse: [pieceNode isStar
			ifTrue: [self makeStar: atom]
			ifFalse: [pieceNode isPlus
				ifTrue: [self makePlus: atom]
				ifFalse: [pieceNode isOptional
					ifTrue: [self makeOptional: atom]
					ifFalse: [self makeQuantified: atom min: pieceNode min max: pieceNode max]]]]! !

!RxMatcher methodsFor: 'double dispatch' stamp: 'vb 4/11/09 21:56'!
syntaxBeginningOfLine
	"Double dispatch from the syntax tree. 
	Create a matcher for beginning-of-line condition."

	^RxmSpecial new beBeginningOfLine! !

!RxMatcher methodsFor: '*GT-Playground' stamp: 'StefanReichhart 3/21/2015 09:51'!
matchesOnStream: aStream subexpressionsDo: aBlock
	| subexpressions |
	[ self searchStream: aStream ] whileTrue: [ 
		subexpressions := ((1 to: self subexpressionCount) collect: [ :each | (self subexpression: each) ]).
		aBlock value: subexpressions first value: subexpressions allButFirst ]! !

!RxMatcher methodsFor: 'double dispatch' stamp: 'vb 4/11/09 21:56'!
syntaxCharSet: charSetNode
	"Double dispatch from the syntax tree. 
	A character set is a few characters, and we either match any of them,
	or match any that is not one of them."

	^RxmPredicate with: (charSetNode predicateIgnoringCase: ignoreCase)! !

!RxMatcher methodsFor: 'match enumeration' stamp: 'vb 4/11/09 21:56'!
matchesIn: aString collect: aBlock
	"Search aString repeatedly for the matches of the receiver.  Evaluate aBlock for each match passing the matched substring as the argument, collect evaluation results in an OrderedCollection, and return in. The following example shows how to use this message to split a string into words."
	"'\w+' asRegex matchesIn: 'Now is the Time' collect: [:each | each asLowercase]"

	| result |
	result := OrderedCollection new.
	self
		matchesOnStream: aString readStream
		do: [:match | result add: (aBlock value: match)].
	^result! !

!RxMatcher methodsFor: 'streaming' stamp: 'lr 1/15/2010 21:13'!
next
	^ stream next! !

!RxMatcher methodsFor: 'match enumeration' stamp: 'vb 4/11/09 21:56'!
matchingRangesIn: aString
	"Search aString repeatedly for the matches of the receiver.  Answer an OrderedCollection of ranges of each match (index of first character to: index of last character)."

	| result |
	result := OrderedCollection new.
	self
		matchesIn: aString 
		do: [:match | result add: (self position - match size + 1 to: self position)].
	^result! !

!RxMatcher methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
subexpression: subIndex
	"Answer a string that matched the subexpression at the given index.
	If there are multiple matches, answer the last one.
	If there are no matches, answer nil. 
	(NB: it used to answer an empty string but I think nil makes more sense)."

	| matches |
	matches := self subexpressions: subIndex.
	^matches isEmpty ifTrue: [nil] ifFalse: [matches last]! !

!RxMatcher methodsFor: 'match enumeration' stamp: 'lr 1/15/2010 21:45'!
copyStream: aStream to: writeStream translatingMatchesUsing: aBlock
	"Copy the contents of <aStream> on the <writeStream>, except for the matches. For each match, evaluate <aBlock> passing the matched substring as the argument.  Expect the block to answer a String, and write the answer to <writeStream> in place of the match."

	| searchStart matchStart matchEnd match |
	stream := aStream.	
	markerPositions := nil.
	[searchStart := aStream position.
	self proceedSearchingStream: aStream] whileTrue:
		[matchStart := (self subBeginning: 1) first.
		matchEnd := (self subEnd: 1) first.
		aStream position: searchStart.
		searchStart to: matchStart - 1 do:
			[:ignoredPos | writeStream nextPut: aStream next].
		match := (String new: matchEnd - matchStart + 1) writeStream.
		matchStart to: matchEnd - 1 do:
			[:ignoredPos | match nextPut: aStream next].
		writeStream nextPutAll: (aBlock value: match contents).
		"Be extra careful about successful matches which consume no input.
		After those, make sure to advance or finish if already at end."
		matchEnd = searchStart ifTrue: 
			[aStream atEnd
				ifTrue:	[^self "rest after end of whileTrue: block is a no-op if atEnd"]
				ifFalse:	[writeStream nextPut: aStream next]]].
	aStream position: searchStart.
	[aStream atEnd] whileFalse: [writeStream nextPut: aStream next]! !

!RxMatcher methodsFor: 'private' stamp: 'vb 4/11/09 21:56'!
allocateMarker
	"Answer an integer to use as an index of the next marker."

	markerCount := markerCount + 1.
	^markerCount! !

!RxMatcher methodsFor: 'testing' stamp: 'vb 4/11/09 21:56'!
atEndOfLine

	^self atEnd or: [stream peek = Cr]! !

!RxMatcher methodsFor: 'private' stamp: 'CamilloBruni 8/14/2013 16:41'!
makeQuantified: anRxmLink min: min max: max 
	"Perform recursive poor-man's transformation of the {<min>,<max>} quantifiers."
	| aMatcher |
	
	"<atom>{,<max>}       ==>  (<atom>{1,<max>})?"
	min = 0 ifTrue: [ 
		^ self makeOptional: (self makeQuantified: anRxmLink min: 1 max: max) ].
	
	"<atom>{<min>,}       ==>  <atom>{<min>-1, <min>-1}<atom>+"
	max ifNil: [
		^ (self makeQuantified: anRxmLink min: 1 max: min-1) pointTailTo: (self makePlus: anRxmLink copy) ].
	
	"<atom>{<max>,<max>}  ==>  <atom><atom> ... <atom>"
	min = max 
		ifTrue: [ 
			aMatcher := anRxmLink copy.
			(min-1) timesRepeat: [ aMatcher pointTailTo: anRxmLink copy ].
			^ aMatcher ].

	"<atom>{<min>,<max>}  ==>  <atom>{<min>,<min>}(<atom>{1,<max>-1})?"
	aMatcher := self makeOptional: anRxmLink copy.
	(max - min - 1) timesRepeat: [ 
		 aMatcher := self makeOptional: (anRxmLink copy pointTailTo: aMatcher) ].
	^ (self makeQuantified: anRxmLink min: min max: min) pointTailTo: aMatcher! !

!RxMatcher methodsFor: 'match enumeration' stamp: 'vb 4/11/09 21:56'!
copy: aString replacingMatchesWith: replacementString
	"Copy <aString>, except for the matches. Replace each match with <aString>."

	| answer |
	answer := (String new: 40) writeStream.
	self
		copyStream: aString readStream
		to: answer
		replacingMatchesWith: replacementString.
	^answer contents! !

!RxMatcher methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
matchesStream: theStream
	"Match thyself against a positionable stream."

	^(self matchesStreamPrefix: theStream)
		and: [stream atEnd]! !

!RxMatcher methodsFor: 'private' stamp: 'lr 1/15/2010 21:51'!
tryMatch
	"Match thyself against the current stream."

	| oldMarkerPositions |
	oldMarkerPositions := markerPositions.
	markerPositions := Array new: markerCount.
	1 to: markerCount do: [ :i | markerPositions at: i put: OrderedCollection new ].
	lastResult := startOptimizer isNil
		ifTrue: [ matcher matchAgainst: self]
		ifFalse: [ (startOptimizer canStartMatch: stream peek in: self) and: [ matcher matchAgainst: self ] ].
	"check for duplicates"
	(lastResult not or: [ oldMarkerPositions isNil or: [ oldMarkerPositions size ~= markerPositions size ] ])
		ifTrue: [ ^ lastResult ].
	oldMarkerPositions with: markerPositions do: [ :oldPos :newPos |
		oldPos size = newPos size 
			ifFalse: [ ^ lastResult ].
		oldPos with: newPos do: [ :old :new |
			old = new
				ifFalse: [ ^ lastResult ] ] ].
	"this is a duplicate"
	^ lastResult := false! !

!RxMatcher methodsFor: 'match enumeration' stamp: 'vb 4/11/09 21:56'!
copy: aString translatingMatchesUsing: aBlock
	"Copy <aString>, except for the matches. For each match, evaluate <aBlock> passing the matched substring as the argument.  Expect the block to answer a String, and replace the match with the answer."

	| answer |
	answer := (String new: 40) writeStream.
	self copyStream: aString readStream to: answer translatingMatchesUsing: aBlock.
	^answer contents! !

!RxMatcher methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
subBeginning: subIndex

	^markerPositions at: subIndex * 2 - 1! !

!RxMatcher methodsFor: 'double dispatch' stamp: 'PeterHugossonMiller 9/3/2009 11:08'!
syntaxBranch: branchNode
	"Double dispatch from the syntax tree. 
	Branch node is a link in a chain of concatenated pieces.
	First build the matcher for the rest of the chain, then make 
	it for the current piece and hook the rest to it."
	| result next rest |
	branchNode branch isNil
		ifTrue: [^branchNode piece dispatchTo: self].
	"Optimization: glue a sequence of individual characters into a single string to match."
	branchNode piece isAtomic ifTrue:
		[result := (String new: 40) writeStream.
		next := branchNode tryMergingInto: result.
		result := result contents.
		result size > 1 ifTrue: "worth merging"
			[rest := next notNil 
				ifTrue: [next dispatchTo: self]
				ifFalse: [nil].
			^(RxmSubstring new substring: result ignoreCase: ignoreCase)
				pointTailTo: rest;
				yourself]].
	"No optimization possible or worth it, just concatenate all. "
	^(branchNode piece dispatchTo: self)
		pointTailTo: (branchNode branch dispatchTo: self);
		yourself! !

!RxMatcher methodsFor: 'match enumeration' stamp: 'lr 1/15/2010 21:45'!
copyStream: aStream to: writeStream replacingMatchesWith: aString
	"Copy the contents of <aStream> on the <writeStream>, except for the matches. Replace each match with <aString>."

	| searchStart matchStart matchEnd |
	stream := aStream.
	markerPositions := nil.
	[searchStart := aStream position.
	self proceedSearchingStream: aStream] whileTrue:
		[matchStart := (self subBeginning: 1) first.
		matchEnd := (self subEnd: 1) first.
		aStream position: searchStart.
		searchStart to: matchStart - 1 do:
			[:ignoredPos | writeStream nextPut: aStream next].
		writeStream nextPutAll: aString.
		aStream position: matchEnd.
		"Be extra careful about successful matches which consume no input.
		After those, make sure to advance or finish if already at end."
		matchEnd = searchStart ifTrue: 
			[aStream atEnd
				ifTrue:	[^self "rest after end of whileTrue: block is a no-op if atEnd"]
				ifFalse:	[writeStream nextPut: aStream next]]].
	aStream position: searchStart.
	[aStream atEnd] whileFalse: [writeStream nextPut: aStream next]! !

!RxMatcher methodsFor: 'double dispatch' stamp: 'vb 4/11/09 21:56'!
syntaxEndOfWord
	"Double dispatch from the syntax tree. 
	Create a matcher for end-of-word condition."

	^RxmSpecial new beEndOfWord! !

!RxMatcher methodsFor: 'privileged' stamp: 'vb 4/11/09 21:56'!
markerPositionAt: anIndex add: position
	"Remember position of another instance of the given marker."

	(markerPositions at: anIndex) addFirst: position! !

!RxMatcher methodsFor: 'streaming' stamp: 'vb 4/11/09 21:56'!
atEnd

	^stream atEnd! !

!RxMatcher methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
lastResult

	^lastResult! !

!RxMatcher methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
buildFrom: aSyntaxTreeRoot
	"Private - Entry point of matcher build process."

	markerCount := 0.  "must go before #dispatchTo: !!"
	matcher := aSyntaxTreeRoot dispatchTo: self.
	matcher terminateWith: RxmTerminator new! !

!RxMatcher methodsFor: 'testing' stamp: 'lr 1/15/2010 21:12'!
atEndOfWord

	^(self isWordChar: self lastChar)
		and: [(self isWordChar: stream peek) not]! !

!RxMatcher methodsFor: 'testing' stamp: 'lr 1/15/2010 21:12'!
atBeginningOfWord

	^(self isWordChar: self lastChar) not
		and: [self isWordChar: stream peek]! !

!RxMatcher methodsFor: 'match enumeration' stamp: 'cami 9/12/2013 23:48'!
matchesOnStream: aStream do: aBlock
	"Be extra careful about successful matches which consume no input.
	After those, make sure to advance or finish if already at end."

	| position subexpression |
	[
		position := aStream position.
		self searchStream: aStream
	] whileTrue: [
		subexpression := self subexpression: 1.
		aBlock value: subexpression.
		subexpression size = 0 ifTrue: [
			aStream atEnd
				ifTrue: [^self]
				ifFalse: [aStream next]]]! !

!RxMatcher methodsFor: 'accessing' stamp: 'CamilloBruni 10/10/2012 14:15'!
matchesPrefix: aString
	"Match against a string. Return true if a prefix matches.
	If you want to match 
		- the full string use #matches:
		- anywhere in the string use #search:"

	^self matchesStreamPrefix: aString readStream! !

!RxMatcher methodsFor: 'double dispatch' stamp: 'vb 4/11/09 21:56'!
syntaxBeginningOfWord
	"Double dispatch from the syntax tree. 
	Create a matcher for beginning-of-word condition."

	^RxmSpecial new beBeginningOfWord! !

!RxMatcher methodsFor: 'match enumeration' stamp: 'vb 4/11/09 21:56'!
matchesIn: aString do: aBlock
	"Search aString repeatedly for the matches of the receiver.
	Evaluate aBlock for each match passing the matched substring
	as the argument."

	self
		matchesOnStream: aString readStream
		do: aBlock! !

!RxMatcher methodsFor: '*Collections-Abstract-splitjoin' stamp: 'CamilloBruni 1/23/2013 12:00'!
split: aString indicesDo: aBlock
	| lastPosition |

	stream := aString readStream.
	lastPosition := stream position.
	
	[ self searchStream: stream ] whileTrue: [ 
		aBlock value: lastPosition+1 value: (self subBeginning: 1) first.
		[ lastPosition < stream position ] assertWithDescription: 'Regex cannot match null string'.
		lastPosition := stream position ].
	
	aBlock value: lastPosition + 1 value: aString size.! !

!RxMatcher methodsFor: 'double dispatch' stamp: 'CamilloBruni 8/28/2013 17:07'!
syntaxLookaround: lookaroundNode
	"Double dispatch from the syntax tree. 
	Special link can handle lookarounds (look ahead, positive and negative)."
	| piece |
	piece := lookaroundNode piece dispatchTo: self.
	^ RxmLookahaed with: piece! !

!RxMatcher methodsFor: 'accessing' stamp: 'lr 1/15/2010 21:45'!
matchesStreamPrefix: theStream
	"Match thyself against a positionable stream."

	stream := theStream.
	markerPositions := nil.
	^self tryMatch! !

!RxMatcher methodsFor: 'double dispatch' stamp: 'vb 4/11/09 21:56'!
syntaxNonWordBoundary
	"Double dispatch from the syntax tree. 
	Create a matcher for the word boundary condition."

	^RxmSpecial new beNotWordBoundary! !

!RxMatcher methodsFor: 'double dispatch' stamp: 'vb 4/11/09 21:56'!
syntaxWordBoundary
	"Double dispatch from the syntax tree. 
	Create a matcher for the word boundary condition."

	^RxmSpecial new beWordBoundary! !

!RxMatcher methodsFor: 'accessing' stamp: 'CamilloBruni 10/10/2012 14:13'!
search: aString
	"Search anywhere in the String for occurrence of something matching myself.
	If you want to match the full String see #matches:
	Answer a Boolean indicating success."

	^self searchStream: aString readStream! !

!RxMatcher methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
subexpressionCount

	^markerCount // 2! !

!RxMatcher methodsFor: 'accessing' stamp: 'lr 1/15/2010 21:14'!
lastChar
	^ stream position = 0
		ifFalse: [ stream skip: -1; next ]! !

!RxMatcher class methodsFor: 'instance creation' stamp: 'vb 4/11/09 21:56'!
for: aRegex ignoreCase: aBoolean
	"Create and answer a matcher that will match a regular expression
	specified by the syntax tree of which `aRegex' is a root."

	^self new
		initialize: aRegex
		ignoreCase: aBoolean! !

!RxMatcher class methodsFor: 'instance creation' stamp: 'vb 4/11/09 21:56'!
forString: aString ignoreCase: aBoolean
	"Create and answer a matcher that will match the regular expression
	`aString'."

	^self for: (RxParser new parse: aString) ignoreCase: aBoolean! !

!RxMatcher class methodsFor: 'class initialization' stamp: 'avi 11/30/2003 13:30'!
initialize
	"RxMatcher initialize"
	Cr := Character cr.
	Lf := Character lf.! !

!RxMatcher class methodsFor: 'instance creation' stamp: 'vb 4/11/09 21:56'!
for: aRegex
	"Create and answer a matcher that will match a regular expression
	specified by the syntax tree of which `aRegex' is a root."

	^self for: aRegex ignoreCase: false! !

!RxMatcher class methodsFor: 'instance creation' stamp: 'vb 4/11/09 21:56'!
forString: aString
	"Create and answer a matcher that will match the regular expression
	`aString'."

	^self for: (RxParser new parse: aString)! !

!RxMatcherTest commentStamp: 'Tbn 11/12/2010 22:31'!
This class provides tests for the regular expression matcher.!
!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry006
	self runRegex: #('^abc$'
		'abc' true (1 'abc')
		'abcc' false nil
		'aabc' false nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry009
	self runRegex: #('^'
		'abc' true nil)! !

!RxMatcherTest methodsFor: 'testing-protocol' stamp: 'TestRunner 1/15/2010 20:51'!
testMatchingRangesIn
	| matcher expected |
	matcher := self matcherClass forString: '\w+'.
	expected := #(1 3 5 6 8 10 12 15) asOrderedCollection.
	(matcher matchingRangesIn: 'now is the time') do: [ :range |
		self assert: range first = expected removeFirst.
		self assert: range last = expected removeFirst ].
	self assert: expected isEmpty! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry078
	self runRegex: #('a\(b'
		'a(b' true (1 'a(b'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry035
	self runRegex: #('a[b-d]e'
		'abd' false nil
		'ace' true (1 'ace'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry027
	self runRegex: #('\ba\w+' "a word beginning with an A"
		'land ancient' true (1 'ancient')
		'antique vase' true (1 'antique')
		'goofy foobar' false nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry026
	self runRegex: #('(f|o)+\b'
		'foo' true (1 'foo')
		' foo ' true (1 'foo'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry073
	self runRegex: #('^*' nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry042
	self runRegex: #('a[]b' nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry097
	self runRegex: #('(ab|)*' nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry045
	self runRegex: #('a[]]b'
		'a]b' true (1 'a]b'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry013
	self runRegex: #('.a.*'
		'1234abc' true (1 '4abc')
		'abcd' false nil)! !

!RxMatcherTest methodsFor: 'testing-protocol' stamp: 'lr 1/15/2010 20:39'!
testMatchesOnStream
	| matcher |
	matcher := self matcherClass forString: '\w+'.
	self assert: (matcher matchesOnStream: 'now is the time' readStream) asArray 
		= #('now' 'is' 'the' 'time')! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry091
	self runRegex: #('(a*|b)*' nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
henryReadme
	self error: 'The tests in this category are based on the ones in Henry Spencer''s regexp.c package.'! !

!RxMatcherTest methodsFor: 'testing-protocol' stamp: 'lr 1/15/2010 20:45'!
testMatchesStream
	| matcher |
	matcher := self matcherClass forString: '\w+'.
	self assert: (matcher matchesStream: 'now' readStream).
	self deny: (matcher matchesStream: 'now is' readStream)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry064
	self runRegex: #('[^[:space:]]+'
		'  word12!!@#$  ' true (1 'word12!!@#$'))! !

!RxMatcherTest methodsFor: 'testing-extensions' stamp: 'lr 4/23/2010 08:50'!
testStringAllRangesOfRegexMatches
	| result |
	result := 'aabbcc' allRangesOfRegexMatches: 'b+'.
	self assert: result size = 1.
	self assert: result first first = 3.
	self assert: result first last = 4
	! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry051
	self runRegex: #('[\D]+'
		'123abc45def78' true (1 'abc'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry038
	self runRegex: #('a[b-]'
		'a-' true (1 'a-'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry119
	self runRegex: #('a([bc]*)(c+d)' 'abcd' true (1 'abcd' 2 'b' 3 'cd'))
	! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry067
	self runRegex: #('[^[:punct:]]+'
		'!!hello,world!!' true (1 'hello'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry077
	self runRegex: #('a\' nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry107
	self runRegex: #('(a|b|c|d|e)f'
		'ef' true (1 'ef' 2 'e'))
	"	((a*|b))*	-	c	-	-"! !

!RxMatcherTest methodsFor: 'testing-empty' stamp: 'lr 1/15/2010 21:46'!
testEmptyStringAtBeginningOfLine
	| matcher |
	matcher := self matcherClass forString: '^'.
	self
		assert: (matcher copy: 'foo1 bar1' , String cr , 'foo2 bar2' replacingMatchesWith: '*')
			= ('*foo1 bar1' , String cr , '*foo2 bar2')
		description: 'An empty string at the beginning of a line'! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry090
	self runRegex: #('(a|)*' nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry029
	self runRegex: #('\Ba\w+' "a word with an A in the middle, match at A and further"
		'land ancient' true (1 'and')
		'antique vase' true (1 'ase')
		'smalltalk shall overcome' true (1 'alltalk')
		'foonix is better' false nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry116
	self runRegex: #('a([bc]*)c*' 'abc' true (1 'abc' 2 'bc'))
	! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry036
	self runRegex: #('a[b-d]'
		'aac' true (1 'ac'))! !

!RxMatcherTest methodsFor: 'testing-protocol' stamp: 'hfm 4/2/2010 13:52'!
testMatchesInCollect
	| matcher |
	matcher := self matcherClass forString: '\w+'.
	self assert: (matcher
		matchesIn: 'now is the time'
		collect: [ :each | each reversed ]) asArray
			= #('won' 'si' 'eht' 'emit')! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry101
	self runRegex: #('a*'
		'' true '')! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry057
	self runRegex: #('[^[:alnum:]]+'
		'fii234!!@#$34f' true (1 '!!@#$'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry018
	self runRegex: #('a\s*c'
		'a   c' true (1 'a   c')
		'a bc' false nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry033
	self runRegex: #('.+\<foo'
		'foo' false nil
		'ab foo' true (1 'ab foo')
		'abfoo' false nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry063
	self runRegex: #('[[:space:]]+'
		'2  spaces' true (1 '  '))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry088
	self runRegex: #('(a*)*' nil)! !

!RxMatcherTest methodsFor: 'testing-empty' stamp: 'lr 1/15/2010 20:05'!
testEmptyStringAtBeginningOfWord
	| matcher |
	matcher := self matcherClass forString: '\<'.
	self
		assert: (matcher copy: 'foo bar' replacingMatchesWith: '*')
			= '*foo *bar'
		description: 'An empty string at the beginning of a word'! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry092
	self runRegex: #('(a+|b)*'
		'ab' true (1 'ab' 2 'b'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry040
	self runRegex: #('[k]'
		'ab' false nil)! !

!RxMatcherTest methodsFor: 'testing-protocol' stamp: 'hfm 4/2/2010 13:52'!
testMatchesOnStreamCollect
	| matcher |
	matcher := self matcherClass forString: '\w+'.
	self assert: (matcher 
		matchesOnStream: 'now is the time' readStream 
		collect: [ :each | each reversed ]) asArray
			= #('won' 'si' 'eht' 'emit')! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry001
	self runRegex: #('abc'
		'abc' true (1 'abc')
		'xbc' false nil
		'axc' false nil
		'abx' false nil
		'xabcy' true (1 'abc')
		'ababc' true (1 'abc'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry012
	"Need to get creative to include the null character..."
	self runRegex: #('a.*c'	
		'axyzc' true (1 'axyzc')
		'axy zc' true (1 'axy zc') "testing that a dot matches a space"
		), (Array with: 'axy', (String with: 0 asCharacter), 'zc'), #(false nil "testing that a dot does not match a null"
		'axyzd' false nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry025
	self runRegex: #('\D+'
		'1234 abc 456' true (1 ' abc ')
		'1234567890' false nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry053
	self runRegex: #('[\s]+'
		'2  spaces' true (1 '  '))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry020
	self runRegex: #('a\S*c'
		'aqwertyc' true (1 'aqwertyc')
		'ab c' false nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry043
	self runRegex: #('a[' nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry100
	self runRegex: #('abc' '' false nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry048
	self runRegex: #('a[^]b]c'
		'a]c' false nil
		'adc' true (1 'adc'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry080
	self runRegex: #('a\\b'
		'a\b' true (1 'a\b'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry008
	self runRegex: #('abc$'
		'aabc' true (1 'abc'))! !

!RxMatcherTest methodsFor: 'testing-protocol' stamp: 'lr 1/15/2010 20:38'!
testCopyReplacingMatches
	"See that the match context is preserved while copying stuff between matches:"
	
	| matcher |
	matcher := self matcherClass forString: '\<\d\D+'.
	self assert: (matcher copy: '9aaa1bbb 8ccc' replacingMatchesWith: 'foo')
		= 'foo1bbb foo'! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry128
	self runRegex: #('[ -~ -~ -~ -~ -~]*' 'abc' true (1 'abc'))
	! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry023
	self runRegex: #('\d+'
		'foo@#$%123ASD #$$%^&' true (1 '123')
		'foo!!@#$asdfl;' false nil)! !

!RxMatcherTest methodsFor: 'testing-extensions' stamp: 'lr 4/23/2010 08:55'!
testStringMatchesRegex
	self deny: ('aabbcc' matchesRegex: 'a+').
	self deny: ('aabbcc' matchesRegex: 'b+c+').
	self assert: ('aabbcc' matchesRegex: 'a+b+c+')! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry056
	self runRegex: #('[\W]+'
		'fii234!!@#$34f' true (1 '!!@#$'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry072
	self runRegex: #('*a' nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry058
	self runRegex: #('[%&[:alnum:]]+'
		'foo%3' true (1 'foo%3')
		'foo34&rt4$57a' true (1 'foo34&rt4')
		'!!@#$' false nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry062
	self runRegex: #('[[:upper:]]+'
		'UPPERlower1234' true (1 'UPPER')
		'lowerUPPER ' true (1 'UPPER'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry060
	self runRegex: #('[[:cntrl:]]+'
		' a 1234asdf' false nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry094
	self runRegex: #('(a+|b)?'
		'ab' true (1 'a' 2 'a'))! !

!RxMatcherTest methodsFor: 'testing-extensions' stamp: 'lr 4/23/2010 08:56'!
testStringPrefixMatchesRegexIgnoringCase
	self assert: ('AABBCC' prefixMatchesRegexIgnoringCase: 'a+').
	self deny: ('AABBCC' prefixMatchesRegexIgnoringCase: 'b+')! !

!RxMatcherTest methodsFor: 'testing-extensions' stamp: 'lr 4/23/2010 08:57'!
testStringRegexMatchesCollect
	| result |
	result := 'aabbcc' regex: 'b+' matchesCollect: [ :each | each asUppercase ].
	self assert: result size = 1.
	self assert: result first = 'BB'! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry052
	self runRegex: #('[[:digit:]e]+'
		'01234' true (1 '01234')
		'0123e456' true (1 '0123e456')
		'0123e45g78' true (1 '0123e45'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry021
	self runRegex: #('\S+'
		'     	asdf		' true (1 'asdf')
		' 	
			' false nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry083
	self runRegex: #('((a))'
		'abc' true (1 'a' 2 'a' 3 'a'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry099
	self runRegex: #('' 'abc' true (1 ''))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry115
	self runRegex: #('(ab|ab*)bc' 'abc' true (1 'abc' 2 'a'))
	! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry005
	self runRegex: #('ab?bc'
		'abbc' true (1 'abbc')
		'abc' true (1 'abc')
		'abbbbc' false nil
		'abc' true (1 'abc'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry010
	self runRegex: #('$'
		'abc' true nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry076
	self runRegex: #('$b'	'b' false nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry117
	self runRegex: #('a([bc]*)(c*d)' 'abcd' true (1 'abcd' 2 'bc' 3 'd'))
	! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry120
	self runRegex: #('a[bcd]*dcdcde' 'adcdcde' true (1 'adcdcde'))
	! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry129
	self runRegex: #('[ -~ -~ -~ -~ -~ -~]*' 'abc' true (1 'abc'))
	! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry105
	self runRegex: #('([abc])*bcd'
		'abcd' true (1 'abcd' 2 'a'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry031
	self runRegex: #('\>.+abc'
		' abcde fg' false nil
		'foo abcde' true (1 ' abc')
		'abcde' false nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry024
	self runRegex: #('a\D+c'
		'aqwertyc' true (1 'aqwertyc')
		'aqw6ertc' false nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry137
	self runRegex: #('\((.*), (.*)\)' '(a, b)' true (2 'a' 3 'b'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry085
	self runRegex: #('a+b+c'
		'aabbabc' true (1 'abc'))! !

!RxMatcherTest methodsFor: 'testing-extensions' stamp: 'lr 4/23/2010 08:56'!
testStringPrefixMatchesRegex
	self assert: ('aabbcc' prefixMatchesRegex: 'a+').
	self deny: ('aabbcc' prefixMatchesRegex: 'b+')! !

!RxMatcherTest methodsFor: 'testing-extensions' stamp: 'lr 4/23/2010 08:53'!
testStringCopyWithRegexMatchesReplacedWith
	self assert: ('aabbcc' copyWithRegex: 'b+' matchesReplacedWith: 'X') = 'aaXcc'! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry054
	self runRegex: #('[\S]+'
		'  word12!!@#$  ' true (1 'word12!!@#$'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry082
	self runRegex: #('(abc' nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry019
	self runRegex: #('\s+'
		'abc3457 sd' true (1 ' ')
		'1234$^*^&asdfb' false nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry108
	self runRegex: #('abcd*efg' 
		'abcdefg' true (1 'abcdefg'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry084
	self runRegex: #('(a)b(c)'
		'abc' true (1 'abc' 2 'a' 3 'c'))! !

!RxMatcherTest methodsFor: 'testing-empty' stamp: 'TestRunner 1/15/2010 21:19'!
testEmptyStringNotAtWordBoundary
	| matcher |
	matcher := self matcherClass forString: '\B'.
	self
		assert: (matcher copy: 'foo bar' replacingMatchesWith: '*')
			= 'f*o*o b*a*r'
		description: 'An empty string not at a word boundary'! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry004
	self runRegex: #('ab+bc'	
		'abbc' true (1 'abbc')
		'abc' false nil
		'abq' false nil
		'abbbbc' true (1 'abbbbc'))! !

!RxMatcherTest methodsFor: 'testing-protocol' stamp: 'hfm 4/2/2010 13:52'!
testCopyTranslatingMatches
	| matcher |
	matcher := self matcherClass forString: '\w+'.
	self assert: (matcher copy: 'now is  the   time    ' translatingMatchesUsing: [ :each | each reversed ])
		= 'won si  eht   emit    '! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry068
	self runRegex: #('[[:xdigit:]]+'
		'  x10FCD  ' true (1 '10FCD')
		' hgfedcba0123456789ABCDEFGH '
			true (1 'fedcba0123456789ABCDEF'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry014
	self runRegex: #('a\w+c'
		' abbbbc ' true (1 'abbbbc')
		'abb bc' false nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry096
	self runRegex: #('(^)*' nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry133
	self runRegex: #('(bc+d$|ef*g.|h?i(j|k))' 
		'effgz' true (1 'effgz' 2 'effgz' 3 nil)
		'ij' true (1 'ij' 2 'ij' 3 'j')
		'effg' false nil
		'bcdd' false nil
		'reffgz' true (1 'effgz' 2 'effgz' 3 nil))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry034
	self runRegex: #('a[bc]d'
		'abc' false nil
		'abd' true (1 'abd'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry122
	self runRegex: #('(ab|a)b*c' 'abc' true (1 'abc'))
	! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry074
	self runRegex: #('$*' nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry118
	self runRegex: #('a([bc]+)(c*d)' 'abcd' true (1 'abcd' 2 'bc' 3 'd'))
	! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry047
	self runRegex: #('a[^-b]c'
		'adc' true (1 'adc')
		'a-c' false nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry134
	self runRegex: #('(((((((((a)))))))))' 'a' true (1 'a'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry135
	self runRegex: #('multiple words of text' 
		'uh-uh' false nil
		'multiple words of text, yeah' true (1 'multiple words of text'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry125
	self runRegex: #('[ -~ -~]*' 'abc' true (1 'abc'))
	! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry055
	self runRegex: #('[\w]+'
		' 	foo123bar	45' true (1 'foo123bar'))! !

!RxMatcherTest methodsFor: 'testing-protocol' stamp: 'lr 1/15/2010 20:45'!
testMatches
	| matcher |
	matcher := self matcherClass forString: '\w+'.
	self assert: (matcher matches: 'now').
	self deny: (matcher matches: 'now is')! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry030
	self runRegex: #('fooa\>.*'
		'fooa ' true nil
		'fooa123' false nil
		'fooa bar' true nil
		'fooa' true nil
		'fooargh' false nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry127
	self runRegex: #('[ -~ -~ -~ -~]*' 'abc' true (1 'abc'))
	! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry109
	self runRegex: #('ab*' 
		'xabyabbbz' true (1 'ab')
		'xayabbbz' true (1 'a'))! !

!RxMatcherTest methodsFor: 'testing' stamp: 'lr 1/15/2010 19:47'!
testRegex001
	self runRegex: #('^.*$' 
		'' true (1 '')
		'a' true (1 'a')
		'abc' true (1 'abc'))! !

!RxMatcherTest methodsFor: 'testing-empty' stamp: 'TestRunner 1/15/2010 21:18'!
testEmptyStringAtEndOfWord
	| matcher |
	matcher := self matcherClass forString: '\>'.
	self
		assert: (matcher copy: 'foo bar' replacingMatchesWith: '*')
			= 'foo* bar*'
		description: 'An empty string at the end of a word'! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry075
	self runRegex: #('(*)b' nil)! !

!RxMatcherTest methodsFor: 'testing-empty' stamp: 'TestRunner 1/15/2010 21:18'!
testEmptyStringAtWordBoundary
	| matcher |
	matcher := self matcherClass forString: '\b'.
	self
		assert: (matcher copy: 'foo bar' replacingMatchesWith: '*')
			= '*foo* *bar*'
		description: 'An empty string at a word boundary'! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry095
	self runRegex: #('[^ab]*'
		'cde' true (1 'cde'))! !

!RxMatcherTest methodsFor: 'testing-empty' stamp: 'TestRunner 1/15/2010 21:18'!
testEmptyStringAtEndOfLine
	| matcher |
	matcher := self matcherClass forString: '$'.
	self
		assert: (matcher copy: 'foo1 bar1' , String cr , 'foo2 bar2' replacingMatchesWith: '*')
			= ('foo1 bar1*', String cr , 'foo2 bar2*')
		description: 'An empty string at the end of a line'! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry016
	self runRegex: #('a\W+c'
		'a   c' true (1 'a   c')
		'a bc' false nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry106
	self runRegex: #('a|b|c|d|e' 'e' true (1 'e'))! !

!RxMatcherTest methodsFor: 'utilties' stamp: 'lr 1/15/2010 19:31'!
runRegex: anArray
	"Run a clause anArray against a set of tests. Each clause is an array with a regex source string followed by sequence of 3-tuples. Each three-element group is one test to try against the regex, and includes: 1) test string; 2) expected result; 3) expected subexpression as an array of (index, substring), or nil."

	| source matcher |
	source := anArray first.
	matcher := self compileRegex: source.
	matcher isNil
		ifTrue: [
			(anArray at: 2) isNil
				ifFalse: [ self signalFailure: 'Compilation failed, should have succeeded: ' , source printString ] ]
		ifFalse: [
			(anArray at: 2) isNil
				ifTrue: [ self signalFailure: 'Compilation succeeded, should have failed: ' , source printString ]
				ifFalse: [
					2 to: anArray size by: 3 do: [ :index | 
						self 
							runMatcher: matcher
							with: (anArray at: index)
							expect: (anArray at: index + 1)
							withSubexpressions: (anArray at: index + 2) ] ] ]! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry037
	self runRegex: #('a[-b]'
		'a-' true (1 'a-'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry070
	self runRegex: #('()ef'
		'def' true (1 'ef' 2 ''))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry039
	self runRegex: #('a[a-b-c]' nil)! !

!RxMatcherTest methodsFor: 'testing-protocol' stamp: 'lr 1/15/2010 20:28'!
testCaseInsensitive
	| matcher |
	matcher := self matcherClass forString: 'the quick brown fox' ignoreCase: true.
	self assert: (matcher search: 'the quick brown fox').
	self assert: (matcher search: 'The quick brown FOX').
	self assert: (matcher search: 'What do you know about the quick brown fox?').
	self assert: (matcher search: 'What do you know about THE QUICK BROWN FOX?')! !

!RxMatcherTest methodsFor: 'testing-extensions' stamp: 'lr 4/23/2010 08:58'!
testStringRegexMatchesDo
	| result |
	result := OrderedCollection new.
	'aabbcc' regex: 'b+' matchesDo: [ :each | result add: each ].
	self assert: result size = 1.
	self assert: result first = 'bb'! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry111
	self runRegex: #('[abhgefdc]ij' 'hij' true (1 'hij'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry032
	self runRegex: #('\<foo.*'
		'foo' true nil
		'foobar' true nil
		'qfoobarq foonix' true (1 'foonix')
		' foo' true nil
		' 12foo' false nil
		'barfoo' false nil)! !

!RxMatcherTest methodsFor: 'testing-protocol' stamp: 'lr 1/15/2010 20:28'!
testCaseSensitive
	| matcher |
	matcher := self matcherClass forString: 'the quick brown fox' ignoreCase: false.
	self assert: (matcher search: 'the quick brown fox').
	self deny: (matcher search: 'The quick brown FOX').
	self assert: (matcher search: 'What do you know about the quick brown fox?').
	self deny: (matcher search: 'What do you know about THE QUICK BROWN FOX?')! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry069
	self runRegex: #('ab|cd'
		'abc' true (1 'ab')
		'abcd' true (1 'ab'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry098
	self runRegex: #(')(' nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry087
	self runRegex: #('a*?' nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry136
	self runRegex: #('(.*)c(.*)' 'abcde' true (1 'abcde' 2 'ab' 3 'de'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry028
	self runRegex: #('(f|o)+\B'
		'quuxfoobar' true (1 'foo')
		'quuxfoo ' true (1 'fo'))! !

!RxMatcherTest methodsFor: 'accessing' stamp: 'lr 1/15/2010 18:47'!
matcherClass
	^ RxMatcher! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry071
	self runRegex: #('()*' nil)! !

!RxMatcherTest methodsFor: 'testing-protocol' stamp: 'lr 1/15/2010 20:44'!
testMatchesOnStreamDo
	| matcher expected |
	matcher := self matcherClass forString: '\w+'.
	expected := #('now' 'is' 'the' 'time') asOrderedCollection.
	matcher 
		matchesOnStream: 'now is the time' readStream
		do: [ :each | self assert: each = expected removeFirst ].
	self assert: expected isEmpty! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry131
	self runRegex: #('[a-zA-Z_][a-zA-Z0-9_]*' 'alpha' true (1 'alpha'))
	! !

!RxMatcherTest methodsFor: 'testing-extensions' stamp: 'lr 4/23/2010 08:52'!
testStringAsRegexIgnoringCase
	self assert: 'b+' asRegexIgnoringCase class = RxParser preferredMatcherClass! !

!RxMatcherTest methodsFor: 'testing' stamp: 'lr 1/15/2010 19:47'!
testRegex002
	self runRegex: #('a\w+c'
		' abb_bbc ' true (1 'abb_bbc')
		'abb-bc' false nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry114
	self runRegex: #('(a|b)c*d' 'abcd' true (1 'bcd' 2 'b'))
	! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry126
	self runRegex: #('[ -~ -~ -~]*' 'abc' true (1 'abc'))
	! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry007
	self runRegex: #('^abc'
		'abcc' true (1 'abc'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry050
	self runRegex: #('[e\d]+' "reversal of the above, should be the same"
		'01234' true (1 '01234')
		'0123e456' true (1 '0123e456')
		'0123e45g78' true (1 '0123e45'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry081
	self runRegex: #('abc)' nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry112
	self runRegex: #('^(ab|cd)e' 'abcde' false nil)
	! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry132
	self runRegex: #('^a(bc+|b[eh])g|.h$' 'abh' true (1 'bh' 2 nil))
	! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry066
	self runRegex: #('[[:print:]]+'
		'abc' true (1 'abc'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry123
	self runRegex: #('((a)(b)c)(d)' 'abcd' true (1 'abcd' 3 'a' 4 'b' 5 'd'))
	! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry003
	self runRegex: #('ab*bc'
		'abc' true (1 'abc')
		'abbc' true (1 'abbc')
		'abbbbc' true (1 'abbbbc'))! !

!RxMatcherTest methodsFor: 'testing' stamp: 'lr 1/15/2010 19:47'!
testRegex003
	self runRegex: #('a\W+c'
		' abb_bbc ' false nil
		'abb-bc' false nil
		'a.,:;-&!!"#%/()={[]}+?\~*''c' true (1 'a.,:;-&!!"#%/()={[]}+?\~*''c'))! !

!RxMatcherTest methodsFor: 'testing-extensions' stamp: 'lr 4/23/2010 08:51'!
testStringAsRegex
	self assert: 'b+' asRegex class = RxParser preferredMatcherClass! !

!RxMatcherTest methodsFor: 'testing-protocol' stamp: 'lr 1/15/2010 20:55'!
testSubexpressionCount
	| matcher |
	#(('a' 1) ('a(b)' 2) ('a(b(c))' 3) ('(a)(b)' 3) ('(a(b))*' 3)) do: [ :pair |
		matcher := self matcherClass forString: pair first.
		matcher supportsSubexpressions 
			ifTrue: [ self assert: matcher subexpressionCount = pair last ] ]! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry121
	self runRegex: #('a[bcd]+dcdcde' 'adcdcde' false nil)
	! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry011
	self runRegex: #('a.c'
		'abc' true (1 'abc')
		'axc' true (1 'axc'))! !

!RxMatcherTest methodsFor: 'testing' stamp: 'lr 4/23/2010 09:01'!
testRegex004
	self runRegex: #(':isVowel:'
		'aei' true nil
		'xyz' false nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry061
	self runRegex: #('[[:lower:]]+'
		'UPPERlower1234' true (1 'lower')
		'lowerUPPER' true (1 'lower'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry046
	self runRegex: #('a[^bc]d'
		'aed' true (1 'aed')
		'abd' false nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry089
	self runRegex: #('(a*)+' nil)! !

!RxMatcherTest methodsFor: 'testing-protocol' stamp: 'lr 1/15/2010 20:44'!
testMatchesInDo
	| matcher expected |
	matcher := self matcherClass forString: '\w+'.
	expected := #('now' 'is' 'the' 'time') asOrderedCollection.
	matcher 
		matchesIn: 'now is the time'
		do: [ :each | self assert: each = expected removeFirst ].
	self assert: expected isEmpty! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry086
	self runRegex: #('a**' nil)! !

!RxMatcherTest methodsFor: 'testing-protocol' stamp: 'lr 1/15/2010 20:38'!
testMatchesIn
	| matcher |
	matcher := self matcherClass forString: '\w+'.
	self assert: (matcher matchesIn: 'now is the time') asArray 
		= #('now' 'is' 'the' 'time')! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry102
	self runRegex: #('abcd'
		'abcd' true (1 'abcd'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry041
	self runRegex: #('a[b-a]' nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry002
	self runRegex: #('ab*c'
		'abc' true (1 'abc'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry017
	self runRegex: #('\W+'
		'foo!!@#$bar' true (1 '!!@#$')
		'foobar' false nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry103
	self runRegex: #('a(bc)d'
		'abcd' true (1 'abcd' 2 'bc'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry022
	self runRegex: #('a\d+c'
		'a0123456789c' true (1 'a0123456789c')
		'a12b34c' false nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry015
	self runRegex: #('\w+'
		'  	foobar	quux' true (1 'foobar')
		' 	~!!@#$%^&*()-+=\|/?.>,<' false nil)! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry049
	self runRegex: #('[\de]+'
		'01234' true (1 '01234')
		'0123e456' true (1 '0123e456')
		'0123e45g78' true (1 '0123e45'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry124
	self runRegex: #('[ -~]*' 'abc' true (1 'abc'))
	! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry113
	self runRegex: #('(abc|)def' 'abcdef' true nil)
	! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry130
	self runRegex: #('[ -~ -~ -~ -~ -~ -~ -~]*' 'abc' true (1 'abc'))
	! !

!RxMatcherTest methodsFor: 'testing-extensions' stamp: 'lr 4/23/2010 08:50'!
testStringAllRegexMatches
	| result |
	result := 'aabbcc' allRegexMatches: 'b+'.
	self assert: result size = 1.
	self assert: result first = 'bb'! !

!RxMatcherTest methodsFor: 'testing-extensions' stamp: 'lr 4/23/2010 08:53'!
testStringCopyWithRegexMatchesTranslatedUsing
	self assert: ('aabbcc' 
		copyWithRegex: 'b+' 
		matchesTranslatedUsing: [ :each | 
			self assert: each = 'bb'.
			'X' ]) = 'aaXcc'! !

!RxMatcherTest methodsFor: 'testing-extensions' stamp: 'lr 4/23/2010 08:55'!
testStringMatchesRegexIgnoringCase
	self deny: ('AABBCC' matchesRegexIgnoringCase: 'a+').
	self deny: ('AABBCC' matchesRegexIgnoringCase: 'b+c+').
	self assert: ('AABBCC' matchesRegexIgnoringCase: 'a+b+c+')! !

!RxMatcherTest methodsFor: 'utilties' stamp: 'TestRunner 1/15/2010 21:02'!
runMatcher: aMatcher with: aString expect: aBoolean withSubexpressions: anArray
	| copy got |
	copy := aMatcher
		copy: aString
		translatingMatchesUsing: [ :each | each ].
	self 
		assert: copy = aString
		description: 'Copying: expected ' , aString printString , ', but got ' , copy printString.
	got := aMatcher search: aString.
	self
		assert: got = aBoolean 
		description: 'Searching: expected ' , aBoolean printString , ', but got ' , got printString.
	(anArray isNil or: [ aMatcher supportsSubexpressions not ])
		ifTrue: [ ^ self ].
	1 to: anArray size by: 2 do: [ :index |
		| sub subExpect subGot |
		sub := anArray at: index.
		subExpect := anArray at: index + 1.
		subGot := aMatcher subexpression: sub.
		self
			assert: subExpect = subGot
			description: 'Subexpression ' , sub printString , ': expected ' , subExpect printString , ', but got ' , subGot printString ]! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry044
	self runRegex: #('a]' 
		'a]' true (1 'a]'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry079
	self runRegex: #('a\(*b'
		'ab' true (1 'ab')
		'a((b' true (1 'a((b'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry065
	self runRegex: #('[[:graph:]]+'
		'abc' true (1 'abc'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry093
	self runRegex: #('(a+|b)+'
		'ab' true (1 'ab' 2 'b'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry110
	self runRegex: #('(ab|cd)e' 'abcde' true (1 'cde' 2 'cd'))! !

!RxMatcherTest methodsFor: 'utilties' stamp: 'MarcusDenker 4/29/2013 17:13'!
compileRegex: aString
	"Compile the regex and answer the matcher, or answer nil if compilation fails."

	| syntaxTree |
	syntaxTree := RxParser safelyParse: aString.
	^ syntaxTree isNil ifFalse: [ self matcherClass for: syntaxTree ]! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry059
	self runRegex: #('[[:alpha:]]+'
		' 123foo3 ' true (1 'foo')
		'123foo' true (1 'foo')
		'foo1b' true (1 'foo'))! !

!RxMatcherTest methodsFor: 'testing-henry' stamp: 'lr 1/15/2010 19:46'!
testHenry104
	self runRegex: #('([abc])*d'
		'abbbcd' true (1 'abbbcd' 2 'c'))! !

!RxMatcherTest class methodsFor: 'accessing' stamp: 'lr 1/15/2010 19:48'!
packageNamesUnderTest
	^ #('VB-Regex')! !

!RxParser commentStamp: 'Tbn 11/12/2010 23:13'!
-- Regular Expression Matcher v 1.1 (C) 1996, 1999 Vassili Bykov
--
The regular expression parser. Translates a regular expression read from a stream into a parse tree. ('accessing' protocol). The tree can later be passed to a matcher initialization method.  All other classes in this category implement the tree. Refer to their comments for any details.

Instance variables:
	input		<Stream> A stream with the regular expression being parsed.
	lookahead	<Character>!
!RxParser methodsFor: 'recursive descent' stamp: 'CamilloBruni 8/28/2013 15:19'!
piece
	"<piece> ::= <atom> | <atom>* | <atom>+ | <atom>? | <atom>{<number>,<number>}"

	| atom |
	atom := self atom.
	
	lookahead = $*
		ifTrue: [ 
			self next.
			atom isNullable
				ifTrue: [ self signalNullableClosureParserError ].
			^ RxsPiece new initializeStarAtom: atom ].

	lookahead = $+
		ifTrue: [ 
			self next.
			atom isNullable
				ifTrue: [ self signalNullableClosureParserError ].
			^ RxsPiece new initializePlusAtom: atom ].

	lookahead = $?
		ifTrue: [ 
			self next.
			atom isNullable
				ifTrue: [ 
					^ self lookAround ].
			^ RxsPiece new initializeOptionalAtom: atom ].
	
	lookahead = ${
		ifTrue: [
			^ self quantifiedAtom: atom ].
		
	^ RxsPiece new initializeAtom: atom! !

!RxParser methodsFor: 'recursive descent' stamp: 'CamilloBruni 8/14/2013 09:22'!
atom
	"An atom is one of a lot of possibilities, see below."

	| atom |
	(lookahead = #epsilon 
	or: [ lookahead = $| 
	or: [ lookahead = $)
	or: [ lookahead = $*
	or: [ lookahead = $+ 
	or: [ lookahead = $? ]]]]])
		ifTrue: [ ^RxsEpsilon new ].
		
	lookahead = $( 
		ifTrue: [
			"<atom> ::= '(' <regex> ')' "
			self match: $(.
			atom := self regex.
			self match: $).
			^atom ].
	
	lookahead = $[
		ifTrue: [
			"<atom> ::= '[' <characterSet> ']' "
			self match: $[.
			atom := self characterSet.
			self match: $].
			^atom ].
	
	lookahead = $: 
		ifTrue: [
			"<atom> ::= ':' <messagePredicate> ':' "
			self match: $:.
			atom := self messagePredicate.
			self match: $:.
			^atom ].
	
	lookahead = $. 
		ifTrue: [
			"any non-whitespace character"
			self next.
			^RxsContextCondition new beAny].
	
	lookahead = $^ 
		ifTrue: [
			"beginning of line condition"
			self next.
			^RxsContextCondition new beBeginningOfLine].
	
	lookahead = $$ 
		ifTrue: [
			"end of line condition"
			self next.
			^RxsContextCondition new beEndOfLine].
		
	lookahead = $\ 
		ifTrue: [
			"<atom> ::= '\' <character>"
			self next.
			lookahead = #epsilon 
				ifTrue: [ self signalParseError: 'bad quotation' ].
			(BackslashConstants includesKey: lookahead)
				ifTrue: [
					atom := RxsCharacter with: (BackslashConstants at: lookahead).
					self next.
					^atom].
			self ifSpecial: lookahead
				then: [:node | self next. ^node]].
		
	"If passed through the above, the following is a regular character."
	atom := RxsCharacter with: lookahead.
	self next.
	^atom! !

!RxParser methodsFor: 'private' stamp: 'CamilloBruni 8/14/2013 09:46'!
inputUpTo: aCharacter errorMessage: aString
	"Accumulate input stream until <aCharacter> is encountered
	and answer the accumulated chars as String, not including
	<aCharacter>. Signal error if end of stream is encountered,
	passing <aString> as the error description."

	| accumulator |
	accumulator := WriteStream on: (String new: 20).
	[lookahead ~= aCharacter and: [lookahead ~= #epsilon]]
		whileTrue: [
			accumulator nextPut: lookahead.
			self next].
	lookahead = #epsilon
		ifTrue: [ self signalParseError: aString ].
	^accumulator contents! !

!RxParser methodsFor: 'private' stamp: 'vb 4/11/09 21:56'!
ifSpecial: aCharacter then: aBlock
	"If the character is such that it defines a special node when follows a $\,
	then create that node and evaluate aBlock with the node as the parameter.
	Otherwise just return."

	| classAndSelector |
	classAndSelector := BackslashSpecials at: aCharacter ifAbsent: [^self].
	^aBlock value: (classAndSelector key new perform: classAndSelector value)! !

!RxParser methodsFor: 'private' stamp: 'vb 4/11/09 21:56'!
inputUpTo: aCharacter nestedOn: anotherCharacter errorMessage: aString 
	"Accumulate input stream until <aCharacter> is encountered
	and answer the accumulated chars as String, not including
	<aCharacter>. Signal error if end of stream is encountered,
	passing <aString> as the error description."

	| accumulator nestLevel |
	accumulator := WriteStream on: (String new: 20).
	nestLevel := 0.
	[lookahead ~= aCharacter or: [nestLevel > 0]] whileTrue: 
			[#epsilon = lookahead ifTrue: [self signalParseError: aString].
			accumulator nextPut: lookahead.
			lookahead = anotherCharacter ifTrue: [nestLevel := nestLevel + 1].
			lookahead = aCharacter ifTrue: [nestLevel := nestLevel - 1].
			self next].
	^accumulator contents! !

!RxParser methodsFor: 'private' stamp: 'vb 4/11/09 21:56'!
next
	"Advance the input storing the just read character
	as the lookahead."

	input atEnd
		ifTrue: [lookahead := #epsilon]
		ifFalse: [lookahead := input next]! !

!RxParser methodsFor: 'recursive descent' stamp: 'CamilloBruni 8/14/2013 09:18'!
branch
	"<branch> ::= e | <piece> <branch>"

	| piece branch |
	piece := self piece.
	(lookahead = #epsilon 
	or: [ lookahead = $| 
	or: [ lookahead = $) ]])
		ifTrue: [ branch := nil ]
		ifFalse: [ branch := self branch ].
	^RxsBranch new 
		initializePiece: piece 
		branch: branch! !

!RxParser methodsFor: 'recursive descent' stamp: 'CamilloBruni 8/14/2013 09:21'!
regex
	"<regex> ::= e | <branch> `|' <regex>"

	| branch regex |
	branch := self branch.
	
	(lookahead = #epsilon 
	or: [ lookahead = $) ])
		ifTrue: [ regex := nil ]
		ifFalse: [
			self match: $|.
			regex := self regex ].
		
	^RxsRegex new initializeBranch: branch regex: regex! !

!RxParser methodsFor: 'private' stamp: 'CamilloBruni 10/7/2012 22:50'!
signalParseError

	self class 
		signalSyntaxException: 'Regex syntax error' at: input position! !

!RxParser methodsFor: 'private' stamp: 'vb 4/11/09 21:56'!
match: aCharacter
	"<aCharacter> MUST match the current lookeahead.
	If this is the case, advance the input. Otherwise, blow up."

	aCharacter ~= lookahead 
		ifTrue: [^self signalParseError].	"does not return"
	self next! !

!RxParser methodsFor: 'recursive descent' stamp: 'CamilloBruni 8/14/2013 12:13'!
quantifiedAtom: atom
	"Parse a quanitifer expression which can have one of the following forms
		{<min>,<max>}    match <min> to <max> occurences
		{<minmax>}       which is the same as with repeated limits: {<number>,<number>}
		{<min>,}         match at least <min> occurences
		{,<max>}         match maximally <max> occurences, which is the same as {0,<max>}"
	| min max |
	self next.
	lookahead = $,
		ifTrue: [ min := 0 ]
		ifFalse: [
			max := min := (self inputUpToAny: ',}' errorMessage: ' no terminating "}"') asUnsignedInteger ].
	lookahead = $,
		ifTrue: [
			self next.
			max := (self inputUpToAny: ',}' errorMessage: ' no terminating "}"') asUnsignedInteger ].	
	self match: $}.
	atom isNullable
		ifTrue: [ self signalNullableClosureParserError ].
	(max isNotNil and: [ max < min ])
		ifTrue: [ self signalParseError: ('wrong quantifier, expected ', min asString, ' <= ', max asString) ].
	^ RxsPiece new 
		initializeAtom: atom
		min: min
		max: max! !

!RxParser methodsFor: 'recursive descent' stamp: 'CamilloBruni 8/14/2013 09:19'!
characterSet
	"Match a range of characters: something between `[' and `]'.
	Opening bracked has already been seen, and closing should
	not be consumed as well. Set spec is as usual for
	sets in regexes."

	| spec errorMessage |
	errorMessage := ' no terminating "]"'.
	spec := self inputUpTo: $] nestedOn: $[ errorMessage: errorMessage.
	(spec isEmpty 
	or: [spec = '^']) 
		ifTrue: [
			"This ']' was literal." 
			self next.
			spec := spec, ']', (self inputUpTo: $] nestedOn: $[ errorMessage: errorMessage)].
	^self characterSetFrom: spec! !

!RxParser methodsFor: 'recursive descent' stamp: 'CamilloBruni 8/14/2013 09:44'!
messagePredicate
	"Match a message predicate specification: a selector (presumably
	understood by a Character) enclosed in :'s ."

	| spec negated |
	spec := self inputUpTo: $: errorMessage: ' no terminating ":"'.
	negated := false.
	spec first = $^ 
		ifTrue: [
			negated := true.
			spec := spec copyFrom: 2 to: spec size].
	^RxsMessagePredicate new 
		initializeSelector: spec asSymbol
		negated: negated! !

!RxParser methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
parse: aString
	"Parse input from a string <aString>.
	On success, answers an RxsRegex -- parse tree root.
	On error, raises `RxParser syntaxErrorSignal' with the current
	input stream position as the parameter."

	^self parseStream: (ReadStream on: aString)! !

!RxParser methodsFor: 'recursive descent' stamp: 'CamilloBruni 8/28/2013 17:01'!
lookAround
	"Parse a lookaround expression after: (?<lookround>) 
	<lookround> ::= !!<regex> | =<regex>"
	| lookaround |
	(lookahead = $!!
	or: [ lookahead = $=])
		ifFalse: [ ^ self signalParseError: 'Invalid lookaround expression ?', lookahead asString ].
	self next.
	lookaround := RxsLookaround with: self regex.
	lookahead = $!!
		ifTrue: [ lookaround beNegative ].
	^ lookaround
	! !

!RxParser methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
parseStream: aStream
	"Parse an input from a character stream <aStream>.
	On success, answers an RxsRegex -- parse tree root.
	On error, raises `RxParser syntaxErrorSignal' with the current
	input stream position as the parameter."

	| tree |
	input := aStream.
	lookahead := nil.
	self match: nil.
	tree := self regex.
	self match: #epsilon.
	^tree! !

!RxParser methodsFor: 'private' stamp: 'CamilloBruni 8/14/2013 09:46'!
inputUpToAny: aDelimiterString errorMessage: aString
	"Accumulate input stream until any character from <aDelimiterString> is encountered
	and answer the accumulated chars as String, not including the matched characters from the
	<aDelimiterString>. Signal error if end of stream is encountered,
	passing <aString> as the error description."

	| accumulator |
	accumulator := WriteStream on: (String new: 20).
	[(aDelimiterString includes: lookahead) not and: [lookahead ~= #epsilon]]
		whileTrue: [
			accumulator nextPut: lookahead.
			self next ].
	lookahead = #epsilon
		ifTrue: [ self signalParseError: aString ].
	^accumulator contents! !

!RxParser methodsFor: 'private' stamp: 'CamilloBruni 8/14/2013 09:39'!
signalNullableClosureParserError
	self signalParseError: ' nullable closure'.! !

!RxParser methodsFor: 'private' stamp: 'vb 4/11/09 21:56'!
characterSetFrom: setSpec
	"<setSpec> is what goes between the brackets in a charset regex
	(a String). Make a string containing all characters the spec specifies.
	Spec is never empty."

	| negated spec |
	spec := ReadStream on: setSpec.
	spec peek = $^
		ifTrue: 	[negated := true.
				spec next]
		ifFalse:	[negated := false].
	^RxsCharSet new
		initializeElements: (RxCharSetParser on: spec) parse
		negated: negated! !

!RxParser methodsFor: 'private' stamp: 'CamilloBruni 10/7/2012 22:49'!
signalParseError: aString

	self class signalSyntaxException: aString at: input position! !

!RxParser class methodsFor: 'DOCUMENTATION' stamp: 'vb 4/11/09 21:56'!
e: x implementationNotes: xx
"	
	Version:		1.1
	Released:		October 1999
	Mail to:		Vassili Bykov <vassili@parcplace.com>, <v_bykov@yahoo.com>
	Flames to:		/dev/null

	WHAT IS ADDED

The matcher includes classes in two categories:
	VB-Regex-Syntax
	VB-Regex-Matcher
and a few CharacterArray methods in `VB-regex' protocol.  No system
classes or methods are modified.

	WHAT TO LOOK AT FIRST

String>>matchesRegex: -- in 90% cases this method is all you need to
access the package.

RxParser -- accepts a string or a stream of characters with a regular
expression, and produces a syntax tree corresponding to the
expression. The tree is made of instances of Rxs<whatever> classes.

RxMatcher -- accepts a syntax tree of a regular expression built by
the parser and compiles it into a matcher: a structure made of
instances of Rxm<whatever> classes. The RxMatcher instance can test
whether a string or a positionable stream of characters matches the
original regular expression, or search a string or a stream for
substrings matching the expression. After a match is found, the
matcher can report a specific string that matched the whole
expression, or any parenthesized subexpression of it.

All other classes support the above functionality and are used by
RxParser, RxMatcher, or both.

	CAVEATS

The matcher is similar in spirit, but NOT in the design--let alone the
code--to the original Henry Spencer's regular expression
implementation in C.  The focus is on simplicity, not on efficiency.
I didn't optimize or profile anything.  I may in future--or I may not:
I do this in my spare time and I don't promise anything.

The matcher passes H. Spencer's test suite (see 'test suite'
protocol), with quite a few extra tests added, so chances are good
there are not too many bugs.  But watch out anyway.

	EXTENSIONS, FUTURE, ETC.

With the existing separation between the parser, the syntax tree, and
the matcher, it is easy to extend the system with other matchers based
on other algorithms. In fact, I have a DFA-based matcher right now,
but I don't feel it is good enough to include it here.  I might add
automata-based matchers later, but again I don't promise anything.

	HOW TO REACH ME

As of today (December 20, 2000), you can contact me at
<vassili@parcplace.com>. If this doesn't work, look around
comp.lang.smalltalk or comp.lang.lisp.  
"

	self error: 'comment only'! !

!RxParser class methodsFor: 'exception signaling' stamp: 'avi 11/30/2003 13:25'!
signalSyntaxException: errorString
	RegexSyntaxError new signal: errorString! !

!RxParser class methodsFor: 'class initialization' stamp: 'lr 11/4/2009 22:14'!
initializeBackslashConstants
	"self initializeBackslashConstants"

	(BackslashConstants := Dictionary new)
		at: $e put: Character escape;
		at: $n put: Character lf;
		at: $r put: Character cr;
		at: $f put: Character newPage;
		at: $t put: Character tab! !

!RxParser class methodsFor: 'class initialization' stamp: 'vb 4/11/09 21:56'!
initializeBackslashSpecials
	"Keys are characters that normally follow a \, the values are
	associations of classes and initialization selectors on the instance side
	of the classes."
	"self initializeBackslashSpecials"

	(BackslashSpecials := Dictionary new)
		at: $w put: (Association key: RxsPredicate value: #beWordConstituent);
		at: $W put: (Association key: RxsPredicate value: #beNotWordConstituent);
		at: $s put: (Association key: RxsPredicate value: #beSpace);
		at: $S put: (Association key: RxsPredicate value: #beNotSpace);
		at: $d put: (Association key: RxsPredicate value: #beDigit);
		at: $D put: (Association key: RxsPredicate value: #beNotDigit);
		at: $b put: (Association key: RxsContextCondition value: #beWordBoundary);
		at: $B put: (Association key: RxsContextCondition value: #beNonWordBoundary);
		at: $< put: (Association key: RxsContextCondition value: #beBeginningOfWord);
		at: $> put: (Association key: RxsContextCondition value: #beEndOfWord)! !

!RxParser class methodsFor: 'exception signaling' stamp: 'CamilloBruni 10/7/2012 22:50'!
signalSyntaxException: errorString at: errorPosition
	RegexSyntaxError signal: errorString at: errorPosition! !

!RxParser class methodsFor: 'utilities' stamp: 'avi 11/30/2003 13:23'!
safelyParse: aString
	"Parse the argument and return the result (the parse tree).
	In case of a syntax error, return nil.
	Exception handling here is dialect-dependent."
	^ [self new parse: aString] on: RegexSyntaxError do: [:ex | nil]! !

!RxParser class methodsFor: 'exception signaling' stamp: 'avi 11/30/2003 13:25'!
signalMatchException: errorString
	RegexMatchingError new signal: errorString! !

!RxParser class methodsFor: 'DOCUMENTATION' stamp: 'vb 4/11/09 21:56'!
a: x introduction: xx 
" 
A regular expression is a template specifying a class of strings. A
regular expression matcher is an tool that determines whether a string
belongs to a class specified by a regular expression.  This is a
common task of a user input validation code, and the use of regular
expressions can GREATLY simplify and speed up development of such
code.  As an example, here is how to verify that a string is a valid
hexadecimal number in Smalltalk notation, using this matcher package:

	aString matchesRegex: '16r[[:xdigit:]]+'

(Coding the same ``the hard way'' is an exercise to a curious reader).

This matcher is offered to the Smalltalk community in hope it will be
useful. It is free in terms of money, and to a large extent--in terms
of rights of use. Refer to `Boring Stuff' section for legalese.

The 'What's new in this release' section describes the functionality
introduced in 1.1 release.

The `Syntax' section explains the recognized syntax of regular
expressions.

The `Usage' section explains matcher capabilities that go beyond what
String>>matchesRegex: method offers.

The `Implementation notes' sections says a few words about what is
under the hood.

Happy hacking,

--Vassili Bykov 
<vassili@objectpeople.com> <vassili@magma.ca>

August 6, 1996
April 4, 1999
"

	self error: 'comment only'! !

!RxParser class methodsFor: 'DOCUMENTATION' stamp: 'lr 1/7/2010 20:10'!
c: x syntax: xx
" 

[You can select and `print it' examples in this method. Just don't
forget to cancel the changes.]

The simplest regular expression is a single character.  It matches
exactly that character. A sequence of characters matches a string with
exactly the same sequence of characters:

	'a' matchesRegex: 'a'				-- true
	'foobar' matchesRegex: 'foobar'		-- true
	'blorple' matchesRegex: 'foobar'		-- false

The above paragraph introduced a primitive regular expression (a
character), and an operator (sequencing). Operators are applied to
regular expressions to produce more complex regular expressions.
Sequencing (placing expressions one after another) as an operator is,
in a certain sense, `invisible'--yet it is arguably the most common.

A more `visible' operator is Kleene closure, more often simply
referred to as `a star'.  A regular expression followed by an asterisk
matches any number (including 0) of matches of the original
expression. For example:

	'ab' matchesRegex: 'a*b'		 		-- true
	'aaaaab' matchesRegex: 'a*b'	 	-- true
	'b' matchesRegex: 'a*b'		 		-- true
	'aac' matchesRegex: 'a*b'	 		-- false: b does not match

A star's precedence is higher than that of sequencing. A star applies
to the shortest possible subexpression that precedes it. For example,
'ab*' means `a followed by zero or more occurrences of b', not `zero
or more occurrences of ab':

	'abbb' matchesRegex: 'ab*'	 		-- true
	'abab' matchesRegex: 'ab*'		 	-- false

To actually make a regex matching `zero or more occurrences of ab',
`ab' is enclosed in parentheses:

	'abab' matchesRegex: '(ab)*'		 	-- true
	'abcab' matchesRegex: '(ab)*'	 	-- false: c spoils the fun

Two other operators similar to `*' are `+' and `?'. `+' (positive
closure, or simply `plus') matches one or more occurrences of the
original expression. `?' (`optional') matches zero or one, but never
more, occurrences.

	'ac' matchesRegex: 'ab*c'	 		-- true
	'ac' matchesRegex: 'ab+c'	 		-- false: need at least one b
	'abbc' matchesRegex: 'ab+c'		 	-- true
	'abbc' matchesRegex: 'ab?c'		 	-- false: too many b's

As we have seen, characters `*', `+', `?', `(', and `)' have special
meaning in regular expressions. If one of them is to be used
literally, it should be quoted: preceded with a backslash. (Thus,
backslash is also special character, and needs to be quoted for a
literal match--as well as any other special character described
further).

	'ab*' matchesRegex: 'ab*'		 	-- false: star in the right string is special
	'ab*' matchesRegex: 'ab\*'	 		-- true
	'a\c' matchesRegex: 'a\\c'		 	-- true

The last operator is `|' meaning `or'. It is placed between two
regular expressions, and the resulting expression matches if one of
the expressions matches. It has the lowest possible precedence (lower
than sequencing). For example, `ab*|ba*' means `a followed by any
number of b's, or b followed by any number of a's':

	'abb' matchesRegex: 'ab*|ba*'	 	-- true
	'baa' matchesRegex: 'ab*|ba*'	 	-- true
	'baab' matchesRegex: 'ab*|ba*'	 	-- false

A bit more complex example is the following expression, matching the
name of any of the Lisp-style `car', `cdr', `caar', `cadr',
... functions:

	c(a|d)+r

It is possible to write an expression matching an empty string, for
example: `a|'.  However, it is an error to apply `*', `+', or `?' to
such expression: `(a|)*' is an invalid expression.

So far, we have used only characters as the 'smallest' components of
regular expressions. There are other, more `interesting', components.

A character set is a string of characters enclosed in square
brackets. It matches any single character if it appears between the
brackets. For example, `[01]' matches either `0' or `1':

	'0' matchesRegex: '[01]'		 		-- true
	'3' matchesRegex: '[01]'		 		-- false
	'11' matchesRegex: '[01]'		 		-- false: a set matches only one character

Using plus operator, we can build the following binary number
recognizer:

	'10010100' matchesRegex: '[01]+'	 	-- true
	'10001210' matchesRegex: '[01]+'	 	-- false

If the first character after the opening bracket is `^', the set is
inverted: it matches any single character *not* appearing between the
brackets:

	'0' matchesRegex: '[^01]'		  		-- false
	'3' matchesRegex: '[^01]'		 		-- true

For convenience, a set may include ranges: pairs of characters
separated with `-'. This is equivalent to listing all characters
between them: `[0-9]' is the same as `[0123456789]'.

Special characters within a set are `^', `-', and `]' that closes the
set. Below are the examples of how to literally use them in a set:

	[01^]		-- put the caret anywhere except the beginning
	[01-]		-- put the dash as the last character
	[]01]		-- put the closing bracket as the first character 
	[^]01]			(thus, empty and universal sets cannot be specified)

Regular expressions can also include the following backquote escapes
to refer to popular classes of characters:

	\w	any word constituent character (same as [a-zA-Z0-9_])
	\W	any character but a word constituent
	\d	a digit (same as [0-9])
	\D	anything but a digit
	\s 	a whitespace character (same as [:space:] below)
	\S	anything but a whitespace character

These escapes are also allowed in character classes: '[\w+-]' means
'any character that is either a word constituent, or a plus, or a
minus'.

Character classes can also include the following grep(1)-compatible
elements to refer to:

	[:alnum:]		any alphanumeric character (same as [a-zA-Z0-9])
	[:alpha:]		any alphabetic character (same as [a-zA-Z])
	[:cntrl:]		any control character. (any character with code < 32)
	[:digit:]		any decimal digit (same as [0-9])
	[:graph:]		any graphical character. (any character with code >= 32).
	[:lower:]		any lowercase character (including non-ASCII lowercase characters)
	[:print:]		any printable character. In this version, this is the same as [:graph:]
	[:punct:]		any punctuation character:  . , !! ? ; : ' - ( ) ` and double quotes
	[:space:]		any whitespace character (space, tab, CR, LF, null, form feed, Ctrl-Z, 16r2000-16r200B, 16r3000)
	[:upper:]		any uppercase character (including non-ASCII uppercase characters)
	[:xdigit:]		any hexadecimal character (same as [a-fA-F0-9]).

Note that many of these are only as consistent or inconsistent on issues
of locale as the underlying Smalltalk implementation. Values shown here
are for VisualWorks 7.6.

Note that these elements are components of the character classes,
i.e. they have to be enclosed in an extra set of square brackets to
form a valid regular expression.  For example, a non-empty string of
digits would be represented as '[[:digit:]]+'.

The above primitive expressions and operators are common to many
implementations of regular expressions. The next primitive expression
is unique to this Smalltalk implementation.

A sequence of characters between colons is treated as a unary selector
which is supposed to be understood by Characters. A character matches
such an expression if it answers true to a message with that
selector. This allows a more readable and efficient way of specifying
character classes. For example, `[0-9]' is equivalent to `:isDigit:',
but the latter is more efficient. Analogously to character sets,
character classes can be negated: `:^isDigit:' matches a Character
that answers false to #isDigit, and is therefore equivalent to
`[^0-9]'.

As an example, so far we have seen the following equivalent ways to
write a regular expression that matches a non-empty string of digits:

	'[0-9]+'
	'\d+'
	'[\d]+'
	'[[:digit:]]+'
	:isDigit:+'

The last group of special primitive expressions includes: 

	.	matching any character except a NULL; 
	^	matching an empty string at the beginning of a line; 
	$	matching an empty string at the end of a line.
	\b	an empty string at a word boundary
	\B	an empty string not at a word boundary
	\<	an empty string at the beginning of a word
	\>	an empty string at the end of a word

	'axyzb' matchesRegex: 'a.+b'		-- true
	'ax zb' matchesRegex: 'a.+b'			-- true (space is matched by `.')
	'ax
zb' matchesRegex: 'a.+b'				-- true (carriage return is matched by `.')

Again, the dot ., caret ^ and dollar $ characters are special and should be quoted
to be matched literally.

	EXAMPLES

As the introductions said, a great use for regular expressions is user
input validation. Following are a few examples of regular expressions
that might be handy in checking input entered by the user in an input
field. Try them out by entering something between the quotes and
print-iting. (Also, try to imagine Smalltalk code that each validation
would require if coded by hand).  Most example expressions could have
been written in alternative ways.

Checking if aString may represent a nonnegative integer number:

	'' matchesRegex: ':isDigit:+'
or
	'' matchesRegex: '[0-9]+'
or
	'' matchesRegex: '\d+'

Checking if aString may represent an integer number with an optional
sign in front:

	'' matchesRegex: '(\+|-)?\d+'

Checking if aString is a fixed-point number, with at least one digit
is required after a dot:

	'' matchesRegex: '(\+|-)?\d+(\.\d+)?'

The same, but allow notation like `123.':

	'' matchesRegex: '(\+|-)?\d+(\.\d*)?'

Recognizer for a string that might be a name: one word with first
capital letter, no blanks, no digits.  More traditional:

	'' matchesRegex: '[A-Z][A-Za-z]*'

more Smalltalkish:

	'' matchesRegex: ':isUppercase::isAlphabetic:*'

A date in format MMM DD, YYYY with any number of spaces in between, in
XX century:

	'' matchesRegex: '(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)[ ]+(\d\d?)[ ]*,[ ]*19(\d\d)'

Note parentheses around some components of the expression above. As
`Usage' section shows, they will allow us to obtain the actual strings
that have matched them (i.e. month name, day number, and year number).

For dessert, coming back to numbers: here is a recognizer for a
general number format: anything like 999, or 999.999, or -999.999e+21.

	'' matchesRegex: '(\+|-)?\d+(\.\d*)?((e|E)(\+|-)?\d+)?'

"

	self error: 'comment only'! !

!RxParser class methodsFor: 'preferences' stamp: 'vb 4/11/09 21:56'!
preferredMatcherClass
	"The matcher to use. For now just one is available, but in
	principle this determines the matchers built implicitly,
	such as by String>>asRegex, or String>>matchesRegex:.
	This might seem a bit strange place for this preference, but
	Parser is still more or less `central' thing in the whole package."

	^RxMatcher! !

!RxParser class methodsFor: 'class initialization' stamp: 'avi 11/30/2003 13:26'!
initialize
	"self initialize"
	self
		initializeBackslashConstants;
		initializeBackslashSpecials! !

!RxParser class methodsFor: 'DOCUMENTATION' stamp: 'lr 1/7/2010 20:10'!
b: x whatsNewInThisRelease: xx
"
VERSION 1.3.1 (September 2008)
1. Updated documentation of character classes, making clear the problems of locale - an area for future improvement

VERSION 1.3 (September 2008)
1. \w now matches underscore as well as alphanumerics, in line with most other regex libraries (and our documentation!!).  
2. \W rejects underscore as well as alphanumerics
3. added tests for this at end of testSuite
4. updated documentation and added note to old incorrect comments in version 1.1 below

VERSION 1.2.3 (November 2007)

1. Regexs with ^ or $ applied to copy empty strings caused infinite loops, e.g. ('' copyWithRegex: '^.*$' matchesReplacedWith: 'foo'). Applied a similar correction to that from version 1.1c, to #copyStream:to:(replacingMatchesWith:|translatingMatchesUsing:).
2. Extended RxParser testing to run each test for #copy:translatingMatchesUsing: as well as #search:.
3. Corrected #testSuite test that a dot does not match a null, which was passing by luck with Smalltalk code in a literal array.
4. Added test to end of test suite for fix 1 above.

VERSION 1.2.2 (November 2006)

There was no way to specify a backslash in a character set. Now [\\] is accepted.

VERSION 1.2.1	(August 2006)

1. Support for returning all ranges (startIndex to: stopIndex) matching a regex - #allRangesOfRegexMatches:, #matchingRangesIn:
2. Added hint to usage documentation on how to get more information about matches when enumerating
3. Syntax description of dot corrected: matches anything but NUL since 1.1a

VERSION 1.2	(May 2006)

Fixed case-insensitive search for character sets.

VERSION 1.1c	(December 2004)

Fixed the issue with #matchesOnStream:do: which caused infinite loops for matches 
that matched empty strings.

VERSION 1.1b	(November 2001)

Changes valueNowOrOnUnwindDo: to ensure:, plus incorporates some earlier fixes.

VERSION 1.1a	(May 2001)

1. Support for keeping track of multiple subexpressions.
2. Dot (.) matches anything but NUL character, as it should per POSIX spec.
3. Some bug fixes.

VERSION 1.1	(October 1999)

Regular expression syntax corrections and enhancements:

1. Backslash escapes similar to those in Perl are allowed in patterns:

	\w	any word constituent character (equivalent to [a-zA-Z0-9_]) *** underscore only since 1.3 ***
	\W	any character but a word constituent (equivalent to [^a-xA-Z0-9_] *** underscore only since 1.3 ***
	\d	a digit (same as [0-9])
	\D	anything but a digit
	\s 	a whitespace character
	\S	anything but a whitespace character
	\b	an empty string at a word boundary
	\B	an empty string not at a word boundary
	\<	an empty string at the beginning of a word
	\>	an empty string at the end of a word

For example, '\w+' is now a valid expression matching any word.

2. The following backslash escapes are also allowed in character sets
(between square brackets):

	\w, \W, \d, \D, \s, and \S.

3. The following grep(1)-compatible named character classes are
recognized in character sets as well:

	[:alnum:]
	[:alpha:]
	[:cntrl:]
	[:digit:]
	[:graph:]
	[:lower:]
	[:print:]
	[:punct:]
	[:space:]
	[:upper:]
	[:xdigit:]

For example, the following patterns are equivalent:

	'[[:alnum:]_]+' '\w+'  '[\w]+' '[a-zA-Z0-9_]+' *** underscore only since 1.3 ***

4. Some non-printable characters can be represented in regular
expressions using a common backslash notation:

	\t	tab (Character tab)
	\n	newline (Character lf)
	\r	carriage return (Character cr)
	\f	form feed (Character newPage)
	\e	escape (Character esc)

5. A dot is corectly interpreted as 'any character but a newline'
instead of 'anything but whitespace'.

6. Case-insensitive matching.  The easiest access to it are new
messages CharacterArray understands: #asRegexIgnoringCase,
#matchesRegexIgnoringCase:, #prefixMatchesRegexIgnoringCase:.

7. The matcher (an instance of RxMatcher, the result of
String>>asRegex) now provides a collection-like interface to matches
in a particular string or on a particular stream, as well as
substitution protocol. The interface includes the following messages:

	matchesIn: aString
	matchesIn: aString collect: aBlock
	matchesIn: aString do: aBlock

	matchesOnStream: aStream
	matchesOnStream: aStream collect: aBlock
	matchesOnStream: aStream do: aBlock

	copy: aString translatingMatchesUsing: aBlock
	copy: aString replacingMatchesWith: replacementString

	copyStream: aStream to: writeStream translatingMatchesUsing: aBlock
	copyStream: aStream to: writeStream replacingMatchesWith: aString

Examples:

	'\w+' asRegex matchesIn: 'now is the time'

returns an OrderedCollection containing four strings: 'now', 'is',
'the', and 'time'.

	'\<t\w+' asRegexIgnoringCase
		copy: 'now is the Time'
		translatingMatchesUsing: [:match | match asUppercase]

returns 'now is THE TIME' (the regular expression matches words
beginning with either an uppercase or a lowercase T).

ACKNOWLEDGEMENTS

Since the first release of the matcher, thanks to the input from
several fellow Smalltalkers, I became convinced a native Smalltalk
regular expression matcher was worth the effort to keep it alive. For
the contributions, suggestions, and bug reports that made this release 
possible, I want to thank:

	Felix Hack
	Peter Hatch
	Alan Knight
	Eliot Miranda
	Thomas Muhr
	Robb Shecter
	David N. Smith
	Francis Wolinski

and anyone whom I haven't yet met or heard from, but who agrees this
has not been a complete waste of time.

--Vassili Bykov
October 3, 1999
"

	self error: 'comment only'! !

!RxParser class methodsFor: 'utilities' stamp: 'vb 4/11/09 21:56'!
parse: aString
	"Parse the argument and return the result (the parse tree).
	In case of a syntax error, the corresponding exception is signaled."

	^self new parse: aString! !

!RxParser class methodsFor: 'exception signaling' stamp: 'avi 11/30/2003 13:25'!
signalCompilationException: errorString
	RegexCompilationError new signal: errorString! !

!RxParser class methodsFor: 'DOCUMENTATION' stamp: 'vb 4/11/09 21:56'!
d: x usage: xx
" 
The preceding section covered the syntax of regular expressions. It
used the simplest possible interface to the matcher: sending
#matchesRegex: message to the sample string, with regular expression
string as the argument.  This section explains hairier ways of using
the matcher.

	PREFIX MATCHING AND CASE-INSENSITIVE MATCHING

A CharacterArray (an EsString in VA) also understands these messages:

	#prefixMatchesRegex: regexString
	#matchesRegexIgnoringCase: regexString
	#prefixMatchesRegexIgnoringCase: regexString

#prefixMatchesRegex: is just like #matchesRegex, except that the whole
receiver is not expected to match the regular expression passed as the
argument; matching just a prefix of it is enough.  For example:

	'abcde' matchesRegex: '(a|b)+'		-- false
	'abcde' prefixMatchesRegex: '(a|b)+'	-- true

The last two messages are case-insensitive versions of matching.

	ENUMERATION INTERFACE

An application can be interested in all matches of a certain regular
expression within a String.  The matches are accessible using a
protocol modelled after the familiar Collection-like enumeration
protocol:

	#regex: regexString matchesDo: aBlock

Evaluates a one-argument <aBlock> for every match of the regular
expression within the receiver string.

	#regex: regexString matchesCollect: aBlock

Evaluates a one-argument <aBlock> for every match of the regular
expression within the receiver string. Collects results of evaluations
and anwers them as a SequenceableCollection.

	#allRegexMatches: regexString

Returns a collection of all matches (substrings of the receiver
string) of the regular expression.  It is an equivalent of <aString
regex: regexString matchesCollect: [:each | each]>.

	#allRangesOfRegexMatches: regexString

Returns a collection of all character ranges (startIndex to: stopIndex)
that match the regular expression.

	REPLACEMENT AND TRANSLATION

It is possible to replace all matches of a regular expression with a
certain string using the message:

	#copyWithRegex: regexString matchesReplacedWith: aString

For example:

	'ab cd ab' copyWithRegex: '(a|b)+' matchesReplacedWith: 'foo'

A more general substitution is match translation:

	#copyWithRegex: regexString matchesTranslatedUsing: aBlock

This message evaluates a block passing it each match of the regular
expression in the receiver string and answers a copy of the receiver
with the block results spliced into it in place of the respective
matches.  For example:

	'ab cd ab' copyWithRegex: '(a|b)+' matchesTranslatedUsing: [:each | each asUppercase]

All messages of enumeration and replacement protocols perform a
case-sensitive match.  Case-insensitive versions are not provided as
part of a CharacterArray protocol.  Instead, they are accessible using
the lower-level matching interface.

	LOWER-LEVEL INTERFACE

Internally, #matchesRegex: works as follows:

1. A fresh instance of RxParser is created, and the regular expression
string is passed to it, yielding the expression's syntax tree.

2. The syntax tree is passed as an initialization parameter to an
instance of RxMatcher. The instance sets up some data structure that
will work as a recognizer for the regular expression described by the
tree.

3. The original string is passed to the matcher, and the matcher
checks for a match.

	THE MATCHER

If you repeatedly match a number of strings against the same regular
expression using one of the messages defined in CharacterArray, the
regular expression string is parsed and a matcher is created anew for
every match.  You can avoid this overhead by building a matcher for
the regular expression, and then reusing the matcher over and over
again. You can, for example, create a matcher at a class or instance
initialization stage, and store it in a variable for future use.

You can create a matcher using one of the following methods:

	- Sending #forString:ignoreCase: message to RxMatcher class, with
the regular expression string and a Boolean indicating whether case is
ignored as arguments.

	- Sending #forString: message.  It is equivalent to <... forString:
regexString ignoreCase: false>.

A more convenient way is using one of the two matcher-created messages
understood by CharacterArray.

	- <regexString asRegex> is equivalent to <RxMatcher forString:
regexString>.

	- <regexString asRegexIgnoringCase> is equivalent to <RxMatcher
forString: regexString ignoreCase: true>.

Here are four examples of creating a matcher:

	hexRecognizer := RxMatcher forString: '16r[0-9A-Fa-f]+'
	hexRecognizer := RxMatcher forString: '16r[0-9A-Fa-f]+' ignoreCase: false
	hexRecognizer := '16r[0-9A-Fa-f]+' asRegex
	hexRecognizer := '16r[0-9A-F]+' asRegexIgnoringCase

	MATCHING

The matcher understands these messages (all of them return true to
indicate successful match or search, and false otherwise):

matches: aString

	True if the whole target string (aString) matches.

matchesPrefix: aString

	True if some prefix of the string (not necessarily the whole
	string) matches.

search: aString

	Search the string for the first occurrence of a matching
	substring. (Note that the first two methods only try matching from
	the very beginning of the string). Using the above example with a
	matcher for `a+', this method would answer success given a string
	`baaa', while the previous two would fail.

matchesStream: aStream
matchesStreamPrefix: aStream
searchStream: aStream

	Respective analogs of the first three methods, taking input from a
	stream instead of a string. The stream must be positionable and
	peekable.

All these methods answer a boolean indicating success. The matcher
also stores the outcome of the last match attempt and can report it:

lastResult

	Answers a Boolean -- the outcome of the most recent match
	attempt. If no matches were attempted, the answer is unspecified.

	SUBEXPRESSION MATCHES

After a successful match attempt, you can query the specifics of which
part of the original string has matched which part of the whole
expression.

A subexpression is a parenthesized part of a regular expression, or
the whole expression. When a regular expression is compiled, its
subexpressions are assigned indices starting from 1, depth-first,
left-to-right. For example, `((ab)+(c|d))?ef' includes the following
subexpressions with these indices:

	1:	((ab)+(c|d))?ef
	2:	(ab)+(c|d)
	3:	ab
	4:	c|d

After a successful match, the matcher can report what part of the
original string matched what subexpression. It understandards these
messages:

subexpressionCount

	Answers the total number of subexpressions: the highest value that
	can be used as a subexpression index with this matcher. This value
	is available immediately after initialization and never changes.

subexpression: anIndex

	An index must be a valid subexpression index, and this message
	must be sent only after a successful match attempt. The method
	answers a substring of the original string the corresponding
	subexpression has matched to.

subBeginning: anIndex
subEnd: anIndex

	Answer positions within the original string or stream where the
	match of a subexpression with the given index has started and
	ended, respectively.

This facility provides a convenient way of extracting parts of input
strings of complex format. For example, the following piece of code
uses the 'MMM DD, YYYY' date format recognizer example from the
`Syntax' section to convert a date to a three-element array with year,
month, and day strings (you can select and evaluate it right here):

	| matcher |
	matcher := RxMatcher forString: '(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)[ ]+(:isDigit::isDigit:?)[ ]*,[ ]*(19|20)(:isDigit::isDigit:)'.
	(matcher matches: 'Aug 6, 1996')
		ifTrue: 
			[Array 
				with: (matcher subexpression: 5)
				with: (matcher subexpression: 2)
				with: (matcher subexpression: 3)]
		ifFalse: ['no match']

(should answer ` #('96' 'Aug' '6')').

	ENUMERATION AND REPLACEMENT

The enumeration and replacement protocols exposed in CharacterArray
are actually implemented by the matcher.  The following messages are
understood:

	#matchesIn: aString
	#matchesIn: aString do: aBlock
	#matchesIn: aString collect: aBlock
	#copy: aString replacingMatchesWith: replacementString
	#copy: aString translatingMatchesUsing: aBlock
	#matchingRangesIn: aString

	#matchesOnStream: aStream
	#matchesOnStream: aStream do: aBlock
	#matchesOnStream: aStream collect: aBlock
	#copy: sourceStream to: targetStream replacingMatchesWith: replacementString
	#copy: sourceStream to: targetStream translatingMatchesWith: aBlock

Note that in those methods that take a block, the block may refer to the rxMatcher itself, 
e.g. to collect information about the position the match occurred at, or the
subexpressions of the match. An example can be seen in #matchingRangesIn:

	ERROR HANDLING

Exception signaling objects (Signals in VisualWorks, Exceptions in VisualAge) are
accessible through RxParser class protocol. To handle possible errors, use
the protocol described below to obtain the exception objects and use the
protocol of the native Smalltalk implementation to handle them.

If a syntax error is detected while parsing expression,
RxParser>>syntaxErrorSignal is raised/signaled.

If an error is detected while building a matcher,
RxParser>>compilationErrorSignal is raised/signaled.

If an error is detected while matching (for example, if a bad selector
was specified using `:<selector>:' syntax, or because of the matcher's
internal error), RxParser>>matchErrorSignal is raised

RxParser>>regexErrorSignal is the parent of all three.  Since any of
the three signals can be raised within a call to #matchesRegex:, it is
handy if you want to catch them all.  For example:

VisualWorks:

	RxParser regexErrorSignal
		handle: [:ex | ex returnWith: nil]
		do: ['abc' matchesRegex: '))garbage[']

VisualAge:

	['abc' matchesRegex: '))garbage[']
		when: RxParser regexErrorSignal
		do: [:signal | signal exitWith: nil]

"

	self error: 'comment only'! !

!RxParser class methodsFor: 'exception signaling' stamp: 'lr 11/4/2009 22:37'!
doHandlingMessageNotUnderstood: aBlock
	"MNU should be trapped and resignaled as a match error in a few places in the matcher.
	This method factors out this dialect-dependent code to make porting easier."
	^ aBlock
		on: MessageNotUnderstood
		do: [:ex | RxParser signalMatchException: 'invalid predicate selector']! !

!RxParser class methodsFor: 'DOCUMENTATION' stamp: 'vb 4/11/09 21:56'!
f: x boringStuff: xx
"
The Regular Expression Matcher (``The Software'') 
is Copyright (C) 1996, 1999 Vassili Bykov.  
It is provided to the Smalltalk community in hope it will be useful.

1. This license applies to the package as a whole, as well as to any
   component of it. By performing any of the activities described
   below, you accept the terms of this agreement.

2. The software is provided free of charge, and ``as is'', in hope
   that it will be useful, with ABSOLUTELY NO WARRANTY. The entire
   risk and all responsibility for the use of the software is with
   you.  Under no circumstances the author may be held responsible for
   loss of data, loss of profit, or any other damage resulting
   directly or indirectly from the use of the software, even if the
   damage is caused by defects in the software.

3. You may use this software in any applications you build.

4. You may distribute this software provided that the software
   documentation and copyright notices are included and intact.

5. You may create and distribute modified versions of the software,
   such as ports to other Smalltalk dialects or derived work, provided
   that: 

   a. any modified version is expressly marked as such and is not
   misrepresented as the original software; 

   b. credit is given to the original software in the source code and
   documentation of the derived work; 

   c. the copyright notice at the top of this document accompanies
   copyright notices of any modified version.  "

	self error: 'comment only'! !

!RxParserTest commentStamp: 'Tbn 11/12/2010 22:31'!
This class provides tests for the regular expression parser.!
!RxParserTest methodsFor: 'tests' stamp: 'StephaneDucasse 12/11/2010 15:00'!
testTranslatingMatchesUsing
	"self debug: #testTranslatingMatchesUsing"
	

	self assert: ('\<t\w+' asRegexIgnoringCase
		copy: 'now is the Time'
		translatingMatchesUsing: [:match | match asUppercase]) = 'now is THE TIME'.

	"the regular expression matches words beginning with either an uppercase or a lowercase T"! !

!RxParserTest methodsFor: 'tests' stamp: 'sd 9/4/2006 23:29'!
toDotestSpecialCharacterInSetRange
	"self debug: #testSpecialCharacterInSetRange"
	
	"Special characters within a set are `^', `-', and `]' that closes the
set. Below are the examples of how to literally use them in a set:
	[01^]		-- put the caret anywhere except the beginning
	[01-]		-- put the dash as the last character
	[]01]		-- put the closing bracket as the first character 
	[^]01]			(thus, empty and universal sets cannot be specified)"

	self assert: ('0' matchesRegex: '[01^]').
	
	self assert: ('0' matchesRegex: '[0-9]').	
	! !

!RxParserTest methodsFor: 'tests' stamp: 'sd 9/3/2006 21:41'!
testSimpleMatchesRegexWithStar
	"self debug: #testSimpleMatchesRegexWithStar"
	
	"The above paragraph in testSimpleMatchesRegex introduced a primitive regular expression (a
character), and an operator (sequencing). Operators are applied to
regular expressions to produce more complex regular expressions.
Sequencing (placing expressions one after another) as an operator is,
in a certain sense, `invisible'--yet it is arguably the most common.
A more `visible' operator is Kleene closure, more often simply
referred to as `a star'.  A regular expression followed by an asterisk
matches any number (including 0) of matches of the original
expression. For example:"

	self assert: ('ab' matchesRegex: 'a*b').		 		
	self assert: ('aaaaab' matchesRegex: 'a*b').	
	self assert: ('b' matchesRegex: 'a*b').	 	
	self deny: ('aac' matchesRegex: 'a*b').	 		! !

!RxParserTest methodsFor: 'tests' stamp: 'sd 9/4/2006 23:38'!
testSpecialCharacterInSetRange
	"self debug: #testSpecialCharacterInSetRange"
	
	"Special characters within a set are `^', `-', and `]' that closes the
set. Below are the examples of how to literally use them in a set:
	[01^]		-- put the caret anywhere except the beginning
	[01-]		-- put the dash as the last character
	[]01]		-- put the closing bracket as the first character 
	[^]01]			(thus, empty and universal sets cannot be specified)"

	self assert: ('0' matchesRegex: '[01^]').
	self assert: ('1' matchesRegex: '[01^]').
	self assert: ('^' matchesRegex: '[01^]').
	
	self deny: ('0' matchesRegex: '[^01]').
	self deny: ('1' matchesRegex: '[^01]').
	
	"[^abc] means that everything except abc is matche"
	self assert: ('^' matchesRegex: '[^01]').
	! !

!RxParserTest methodsFor: 'tests' stamp: 'sd 9/4/2006 23:20'!
testCharacterSetRange
	"self debug: #testCharacterSetRange"
	
	"For convenience, a set may include ranges: pairs of characters
separated with `-'. This is equivalent to listing all characters
between them: `[0-9]' is the same as `[0123456789]'. "	

	self assert: ('0' matchesRegex: '[0-9]').	
	self assert: ('9' matchesRegex: '[0-9]').	
	self deny: ('a' matchesRegex: '[0-9]').
	self deny: ('01' matchesRegex: '[0-9]').	
	self assert: ('01442128629839374565' matchesRegex: '[0-9]+').	
	! !

!RxParserTest methodsFor: 'tests' stamp: 'marcus.denker 10/22/2008 10:47'!
testMatchesInwW
	"self debug: #testMatchesInwW"
	
	"1. Backslash escapes similar to those in Perl are allowed in patterns:
	\w	any word constituent character (equivalent to [a-zA-Z0-9:=])
	\W	any character but a word constituent (equivalent to [^a-xA-Z0-9:=]"

	self assert: ('\w+' asRegex matchesIn: 'now is the time') asArray = #('now' 'is' 'the' 'time').
	self assert: ('\W+' asRegex matchesIn: 'now is the time') asArray = #(' ' ' ' ' ').
	
	"why do we get that"
	self assert: ('\w' asRegex matchesIn: 'now') asArray = #('n' 'o' 'w').! !

!RxParserTest methodsFor: 'tests' stamp: 'sd 9/4/2006 16:26'!
testStarPlusQuestionMark
	"self debug: #testStarPlusQuestionMark"
	
	"Two other operators similar to `*' are `+' and `?'. `+' (positive
closure, or simply `plus') matches one or more occurrences of the
original expression. `?' (`optional') matches zero or one, but never
more, occurrences."

	self assert: ('ac' matchesRegex: 'ab*c').  		
	self deny: ('ac' matchesRegex: 'ab+c'). 		"-- false: need at least one b"
	self assert: ('abbc' matchesRegex: 'ab+c').	
	self assert: ('abbbbbbc' matchesRegex: 'ab+c').	
	self deny: ('abbc' matchesRegex: 'ab?c')	 	"-- false: too many b's"! !

!RxParserTest methodsFor: 'tests' stamp: 'sd 9/4/2006 16:24'!
testCadrMatching
	"self debug: #testCadrMatching"

	"A bit more complex example is the following expression, matching the
name of any of the Lisp-style `car', `cdr', `caar', `cadr',
... functions:"

	self assert: ( 'car' matchesRegex: 'c(a|d)+r').
	self assert: ( 'cdr' matchesRegex: 'c(a|d)+r').
	self assert: ( 'caar' matchesRegex: 'c(a|d)+r').
	self assert: ( 'cadr' matchesRegex: 'c(a|d)+r').
	self assert: ( 'caddar' matchesRegex: 'c(a|d)+r').! !

!RxParserTest methodsFor: 'tests' stamp: 'sd 9/4/2006 16:49'!
testCharacterSet
	"self debug: #testCharacterSet"
	
	"So far, we have used only characters as the 'smallest' components of
regular expressions. There are other, more `interesting', components.
A character set is a string of characters enclosed in square
brackets. It matches any single character if it appears between the
brackets. For example, `[01]' matches either `0' or `1':"

	self assert: ('0' matchesRegex: '[01]').	 	
	self deny: ('3' matchesRegex: '[01]'). 	 
	self deny: ('11' matchesRegex: '[01]').	"-- false: a set matches only one character"
	self deny: ('01' matchesRegex: '[01]').
! !

!RxParserTest methodsFor: 'tests' stamp: 'sd 9/4/2006 17:39'!
testCharacterSetBinaryNumber
	"self debug: #testCharacterSetBinaryNumber"
	
	"Using plus operator, we can build the following binary number
recognizer:"
	self assert: ('10010100' matchesRegex: '[01]+').	 	
	self deny: ('10001210' matchesRegex: '[01]+')	 ! !

!RxParserTest methodsFor: 'tests' stamp: 'sd 9/3/2006 22:57'!
testStarPrecedence
	"self debug: #testStarPrecedence"
	
	"A star's precedence is higher than that of sequencing. A star applies
to the shortest possible subexpression that precedes it. For example,
'ab*' means `a followed by zero or more occurrences of b', not `zero
or more occurrences of ab':"

	self assert: ('abbb' matchesRegex: 'ab*'). 
	self deny: ('abab' matchesRegex: 'ab*').	 	
		
	"To actually make a regex matching `zero or more occurrences of ab',
`ab' is enclosed in parentheses:"
	self assert: ('abab' matchesRegex: '(ab)*'). 
	self deny: ('abcab' matchesRegex: '(ab)*')! !

!RxParserTest methodsFor: 'tests' stamp: 'sd 9/3/2006 19:50'!
testSimpleMatchesRegex
	"self debug: #testSimpleMatchesRegex"
	
	"The simplest regular expression is a single character.  It matches
exactly that character. A sequence of characters matches a string with
exactly the same sequence of characters:"

	self assert: ('a' matchesRegex: 'a').
	self assert: ('foobar' matchesRegex: 'foobar')	.
	self deny: ('blorple' matchesRegex: 'foobar')! !

!RxParserTest methodsFor: 'tests' stamp: 'sd 9/5/2006 00:11'!
DoesNotWorktestBackQuotesEscape
	"self debug: #testBackQuotesEscape"
	
	"Regular expressions can also include the following backquote escapes
to refer to popular classes of characters:
	\w	any word constituent character (same as [a-zA-Z0-9:=])
	\W	any character but a word constituent
	\d	a digit (same as [0-9])
	\D	anything but a digit
	\s 	a whitespace character
	\S	anything but a whitespace character
These escapes are also allowed in character classes: '[\w+-]' means
'any character that is either a word constituent, or a plus, or a
minus'."
	
	self assert: ('one word' matchesRegex: '\w').	
		
	self assert: ('one' matchesRegex: '\w').		  	
	! !

!RxParserTest methodsFor: 'tests' stamp: 'CamilloBruni 8/14/2013 12:51'!
testQuantifierSimple
	"Test quantifier expressions that can be expressed with + or *"
	self assert: ('a'  matchesRegex: 'a{1}').
	self deny:   ('aa' matchesRegex: 'a{1}').
	
	self assert: ('a'  matchesRegex: 'a{1,1}').
	self deny:   ('aa' matchesRegex: 'a{1,1}').
	
	self assert: ('ab'   matchesRegex: '(ab){1,}').
	self assert: ('abab' matchesRegex: '(ab){1,}').
	self deny:   (''     matchesRegex: '(ab){1,}').
	
	self assert: ('ab'   matchesRegex: '(ab){,1}').
	self assert: (''     matchesRegex: '(ab){,1}').
	self deny:   ('abab' matchesRegex: '(ab){,1}').! !

!RxParserTest methodsFor: 'tests' stamp: 'StephaneDucasse 12/11/2010 15:00'!
test
	"self debug: #test"
	

	self assert: ('\<t\w+' asRegexIgnoringCase
		copy: 'now is the Time'
		translatingMatchesUsing: [:match | match asUppercase]) = 'now is THE TIME'.

	"the regular expression matches words beginning with either an uppercase or a lowercase T"! !

!RxParserTest methodsFor: 'tests' stamp: 'sd 9/4/2006 16:38'!
testOrOperator
	"self debug: #testOrOperator"
	
	"The last operator is `|' meaning `or'. It is placed between two
regular expressions, and the resulting expression matches if one of
the expressions matches. It has the lowest possible precedence (lower
than sequencing). For example, `ab*|ba*' means `a followed by any
number of b's, or b followed by any number of a's':"

	self assert: ('abb' matchesRegex: 'ab*|ba*').  	
	self assert: ('baa' matchesRegex: 'ab*|ba*').	 	
	self deny: ('baab' matchesRegex: 'ab*|ba*').
	

	"It is possible to write an expression matching an empty string, for
example: `a|'.  However, it is an error to apply `*', `+', or `?' to
such expression: `(a|)*' is an invalid expression."

	self should: ['(a|)*' asRegex] raise: Error.
! !

!RxParserTest methodsFor: 'tests' stamp: 'sd 9/4/2006 16:17'!
testQuotingOperators
	"self debug: #testQuotingOperators"
	
	"As we have seen, characters `*', `+', `?', `(', and `)' have special
meaning in regular expressions. If one of them is to be used
literally, it should be quoted: preceded with a backslash. (Thus,
backslash is also special character, and needs to be quoted for a
literal match--as well as any other special character described
further)."

	self deny: ('ab*' matchesRegex: 'ab*'). "	-- false: star in the right string is special"
	self assert: ('ab*' matchesRegex: 'ab\*').	 		
	self assert: ('a\c' matchesRegex: 'a\\c').		 	! !

!RxParserTest methodsFor: 'tests' stamp: 'CamilloBruni 8/28/2013 17:18'!
testLookaround
	self assert: ('A'   matchesRegex: '(?!!ABC).*').
	self assert: ('AB'  matchesRegex: '(?!!ABC).*').
	self deny:   ('ABC' matchesRegex: '(?!!ABC).*').! !

!RxParserTest methodsFor: 'tests' stamp: 'sd 9/5/2006 00:01'!
testCharacterSetInversion
	"self debug: #testCharacterSetInversion"
	
	"If the first character after the opening bracket is `^', the set is
inverted: it matches any single character *not* appearing between the
brackets:"
	
	self deny: ('0' matchesRegex: '[^01]').		  	
	"0 appears in 01 so there is no match"
	
	self assert: ('3' matchesRegex: '[^01]').
	"3 is not in 01 so it matches"
	
	
	self deny: ('30' matchesRegex: '[^01]').		
	self deny: ('33333333333333333333333330' matchesRegex: '[^01]').	
	"there is one zero so it does not match"! !

!RxParserTest methodsFor: 'tests' stamp: 'CamilloBruni 8/14/2013 16:42'!
testQuantifier
	self deny:   (''     matchesRegex: 'a{2}').
	self deny:   ('a'    matchesRegex: 'a{2}').
	self assert: ('aa'   matchesRegex: 'a{2}').
	self deny:   ('aaa'  matchesRegex: 'a{2}').
	
	self deny:   (''     matchesRegex: 'a{2,3}').
	self deny:   ('a'    matchesRegex: 'a{2,3}').
	self assert: ('aa'   matchesRegex: 'a{2,3}').
	self assert: ('aaa'  matchesRegex: 'a{2,3}').
	self deny:   ('aaaa' matchesRegex: 'a{2,3}').
	
	self deny:   (''     matchesRegex: 'a{2,}').
	self deny:   ('a'    matchesRegex: 'a{2,}').
	self assert: ('aa'   matchesRegex: 'a{2,}').
	self assert: ('aaa'  matchesRegex: 'a{2,}').
	self assert: ('aaaa' matchesRegex: 'a{2,}').
	
	self assert: (''     matchesRegex: 'a{,3}').
	self assert: ('a'    matchesRegex: 'a{,3}').
	self assert: ('aa'   matchesRegex: 'a{,3}').
	self assert: ('aaa'  matchesRegex: 'a{,3}').
	self deny:   ('aaaa' matchesRegex: 'a{,3}').! !

!RxmBranch commentStamp: 'Tbn 11/12/2010 23:14'!
-- Regular Expression Matcher v 1.1 (C) 1996, 1999 Vassili Bykov
--
This is a branch of a matching process. Either `next' chain should match, or `alternative', if not nil, should match. Since this is also used to build loopbacks to match repetitions, `loopback' variable indicates whether the instance is a loopback: it affects the matcher-building operations (which of the paths through the branch is to consider as the primary when we have to find the "tail" of a matcher construct).

Instance variables
	alternative		<RxmLink> to match if `next' fails to match.
	loopback		<Boolean>!
!RxmBranch methodsFor: 'matching' stamp: 'vb 4/11/09 21:56'!
matchAgainst: aMatcher
	"Match either `next' or `alternative'. Fail if the alternative is nil."

	^(next matchAgainst: aMatcher)
		or: [alternative notNil
			and: [alternative matchAgainst: aMatcher]]! !

!RxmBranch methodsFor: 'initialization' stamp: 'lr 11/4/2009 22:38'!
initialize
	"See class comment for instance variable description."

	super initialize.
	loopback := false! !

!RxmBranch methodsFor: 'building' stamp: 'vb 4/11/09 21:56'!
terminateWith: aNode
	"See superclass for explanations."

	loopback
		ifTrue: [alternative == nil
			ifTrue: [alternative := aNode]
			ifFalse: [alternative terminateWith: aNode]]
		ifFalse: [super terminateWith: aNode]! !

!RxmBranch methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
beLoopback
	"See class comment for instance variable description."

	loopback := true! !

!RxmBranch methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
alternative: aBranch
	"See class comment for instance variable description."

	alternative := aBranch! !

!RxmBranch methodsFor: 'building' stamp: 'CamilloBruni 8/14/2013 12:53'!
pointTailTo: aNode
	"See superclass for explanations."

	loopback
		ifTrue: [
			alternative == nil
				ifTrue: [alternative := aNode]
				ifFalse: [alternative pointTailTo: aNode]]
		ifFalse: [super pointTailTo: aNode]! !

!RxmLink commentStamp: 'Tbn 11/12/2010 23:14'!
-- Regular Expression Matcher v 1.1 (C) 1996, 1999 Vassili Bykov
--
A matcher is built of a number of links interconnected into some intricate structure. Regardless of fancy stuff, any link (except for the terminator) has the next one. Any link can match against a stream of characters, recursively propagating the match to the next link. Any link supports a number of matcher-building messages. This superclass does all of the above. 

The class is not necessarily abstract. It may double as an empty string matcher: it recursively propagates the match to the next link, thus always matching nothing successfully.

Principal method:
	matchAgainst: aMatcher
		Any subclass will reimplement this to test the state of the matcher, most
		probably reading one or more characters from the matcher's stream, and
		either decide it has matched and answer true, leaving matcher stream
		positioned at the end of match, or answer false and restore the matcher
		stream position to whatever it was before the matching attempt.

Instance variables:
	next		<RxmLink | RxmTerminator> The next link in the structure.!
!RxmLink methodsFor: 'matching' stamp: 'vb 4/11/09 21:56'!
matchAgainst: aMatcher
	"If a link does not match the contents of the matcher's stream,
	answer false. Otherwise, let the next matcher in the chain match."

	^next matchAgainst: aMatcher! !

!RxmLink methodsFor: 'building' stamp: 'vb 4/11/09 21:56'!
terminateWith: aTerminator
	"Propagate this message along the chain of links, and
	make aTerminator the `next' link of the last link in the chain.
	If the chain is already reminated with the same terminator, 
	do not blow up."

	next == nil
		ifTrue: [next := aTerminator]
		ifFalse: [next terminateWith: aTerminator]! !

!RxmLink methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
next: aLink
	"Set the next link, either an RxmLink or an RxmTerminator."

	next := aLink! !

!RxmLink methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
next
	
	^next! !

!RxmLink methodsFor: 'copying' stamp: 'CamilloBruni 8/14/2013 14:33'!
postCopy
	super postCopy.
	next := next copy! !

!RxmLink methodsFor: 'building' stamp: 'vb 4/11/09 21:56'!
pointTailTo: anRxmLink
	"Propagate this message along the chain of links.
	Point `next' reference of the last link to <anRxmLink>.
	If the chain is already terminated, blow up."

	next == nil
		ifTrue: [next := anRxmLink]
		ifFalse: [next pointTailTo: anRxmLink]! !

!RxmLookahaed commentStamp: '<historical>'!
Instance holds onto a lookead which matches but does not consume anything.

Instance variables:
	predicate		<RxmLink>!
!RxmLookahaed methodsFor: 'matching' stamp: 'CamilloBruni 8/28/2013 17:02'!
matchAgainst: aMatcher
	"Match if the predicate block evaluates to true when given the
	current stream character as the argument."

	| original result |
	original := aMatcher currentState.
	result := lookahead matchAgainst: aMatcher.
	aMatcher restoreState: original.
	^ result not 
		and: [ next matchAgainst: aMatcher ]! !

!RxmLookahaed methodsFor: 'initialization' stamp: 'CamilloBruni 8/28/2013 16:52'!
initialize
	super initialize.
	positive := true.! !

!RxmLookahaed methodsFor: 'building' stamp: 'CamilloBruni 8/28/2013 17:09'!
terminateWith: aNode
	lookahead terminateWith: aNode.
	super terminateWith: aNode.! !

!RxmLookahaed methodsFor: 'accessing' stamp: 'CamilloBruni 8/28/2013 16:43'!
lookahead
	^ lookahead! !

!RxmLookahaed methodsFor: 'accessing' stamp: 'CamilloBruni 8/28/2013 16:43'!
lookahead: anRxmLink
	lookahead := anRxmLink! !

!RxmLookahaed class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/28/2013 16:44'!
with: aPiece

	^self new lookahead: aPiece! !

!RxmMarker commentStamp: 'Tbn 11/12/2010 23:14'!
-- Regular Expression Matcher v 1.1 (C) 1996, 1999 Vassili Bykov
--
A marker is used to remember positions of match of certain points of a regular expression. The marker receives an identifying key from the Matcher and uses that key to report positions of successful matches to the Matcher.

Instance variables:
	index	<Object> Something that makes sense for the Matcher. Received from the latter during initalization and later passed to it to identify the receiver.!
!RxmMarker methodsFor: 'matching' stamp: 'vb 4/11/09 21:56'!
matchAgainst: aMatcher
	"If the rest of the link chain matches successfully, report the
	position of the stream *before* the match started to the matcher."

	| startPosition |
	startPosition := aMatcher position.
	(next matchAgainst: aMatcher)
		ifTrue:
			[aMatcher markerPositionAt: index add: startPosition.
			^true].
	^false! !

!RxmMarker methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
index: anIndex
	"An index is a key that makes sense for the matcher.
	This key can be passed to marker position getters and
	setters to access position for this marker in the current
	matching session."

	index := anIndex! !

!RxmPredicate commentStamp: 'Tbn 11/12/2010 23:14'!
-- Regular Expression Matcher v 1.1 (C) 1996, 1999 Vassili Bykov
--
Instance holds onto a one-argument block and matches exactly one character if the block evaluates to true when passed the character as the argument.

Instance variables:
	predicate		<BlockClosure>!
!RxmPredicate methodsFor: 'matching' stamp: 'vb 4/11/09 21:56'!
matchAgainst: aMatcher
	"Match if the predicate block evaluates to true when given the
	current stream character as the argument."

	| original |
	original := aMatcher currentState.
	(aMatcher atEnd not 
		and: [(predicate value: aMatcher next)
			and: [next matchAgainst: aMatcher]])
		ifTrue: [^true]
		ifFalse:
			[aMatcher restoreState: original.
			^false]! !

!RxmPredicate methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
bePerformNot: aSelector
	"Match any single character that answers false to this message."

	self predicate: 
		[:char | 
		RxParser doHandlingMessageNotUnderstood: [(char perform: aSelector) not]]! !

!RxmPredicate methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
predicate: aBlock
	"This link will match any single character for which <aBlock>
	evaluates to true."

	aBlock numArgs ~= 1 ifTrue: [self error: 'bad predicate block'].
	predicate := aBlock.
	^self! !

!RxmPredicate methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
bePerform: aSelector
	"Match any single character that answers true  to this message."

	self predicate: 
		[:char | 
		RxParser doHandlingMessageNotUnderstood: [char perform: aSelector]]! !

!RxmPredicate class methodsFor: 'instance creation' stamp: 'vb 4/11/09 21:56'!
with: unaryBlock

	^self new predicate: unaryBlock! !

!RxmSpecial commentStamp: 'Tbn 11/12/2010 23:14'!
-- Regular Expression Matcher v 1.1 (C) 1996, 1999 Vassili Bykov
--
A special node that matches a specific matcher state rather than any input character.
The state is either at-beginning-of-line or at-end-of-line.!
!RxmSpecial methodsFor: 'matching' stamp: 'vb 4/11/09 21:56'!
matchAgainst: aMatcher
	"Match without consuming any input, if the matcher is
	in appropriate state."

	^(aMatcher perform: matchSelector)
		and: [next matchAgainst: aMatcher]! !

!RxmSpecial methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
beNotWordBoundary

	matchSelector := #notAtWordBoundary! !

!RxmSpecial methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
beEndOfLine

	matchSelector := #atEndOfLine! !

!RxmSpecial methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
beBeginningOfWord

	matchSelector := #atBeginningOfWord! !

!RxmSpecial methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
beWordBoundary

	matchSelector := #atWordBoundary! !

!RxmSpecial methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
beEndOfWord

	matchSelector := #atEndOfWord! !

!RxmSpecial methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
beBeginningOfLine

	matchSelector := #atBeginningOfLine! !

!RxmSubstring commentStamp: 'Tbn 11/12/2010 23:14'!
-- Regular Expression Matcher v 1.1 (C) 1996, 1999 Vassili Bykov
--
Instance holds onto a string and matches exactly this string, and exactly once.

Instance variables:
	string 	<String>!
!RxmSubstring methodsFor: 'matching' stamp: 'vb 4/11/09 21:56'!
matchAgainst: aMatcher
	"Match if my sample stream is exactly the current prefix
	of the matcher stream's contents."

	| originalState sampleStream mismatch |
	originalState := aMatcher currentState.
	sampleStream := self sampleStream.
	mismatch := false.
	[sampleStream atEnd
		or: [aMatcher atEnd
		or: [mismatch := (compare value: sampleStream next value: aMatcher next) not]]] whileFalse.
	(mismatch not and: [sampleStream atEnd and: [next matchAgainst: aMatcher]])
		ifTrue: [^true]
		ifFalse: 
			[aMatcher restoreState: originalState.
			^false]! !

!RxmSubstring methodsFor: 'initialization' stamp: 'lr 11/4/2009 22:38'!
initialize
	super initialize.
	self beCaseSensitive! !

!RxmSubstring methodsFor: 'private' stamp: 'vb 4/11/09 21:56'!
sampleStream

	^sample readStream! !

!RxmSubstring methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
substring: aString ignoreCase: aBoolean
	"Match exactly this string."

	sample := aString.
	aBoolean ifTrue: [self beCaseInsensitive]! !

!RxmSubstring methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
character: aCharacter ignoreCase: aBoolean
	"Match exactly this character."

	sample := String with: aCharacter.
	aBoolean ifTrue: [self beCaseInsensitive]! !

!RxmSubstring methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
beCaseInsensitive

	compare := [:char1 :char2 | char1 sameAs: char2]! !

!RxmSubstring methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
beCaseSensitive

	compare := [:char1 :char2 | char1 = char2]! !

!RxmTerminator commentStamp: 'Tbn 11/12/2010 23:14'!
-- Regular Expression Matcher v 1.1 (C) 1996, 1999 Vassili Bykov
--
Instances of this class are used to terminate matcher's chains. When a match reaches this (an instance receives #matchAgainst: message), the match is considered to succeed. Instances also support building protocol of RxmLinks, with some restrictions.!
!RxmTerminator methodsFor: 'matching' stamp: 'vb 4/11/09 21:56'!
matchAgainst: aStream
	"If got here, the match is successful."

	^true! !

!RxmTerminator methodsFor: 'building' stamp: 'vb 4/11/09 21:56'!
terminateWith: aTerminator
	"Branch terminators are never supposed to change.
	Make sure this is the case."

	aTerminator ~~ self
		ifTrue: [RxParser signalCompilationException:
				'internal matcher build error - wrong terminator']! !

!RxmTerminator methodsFor: 'building' stamp: 'vb 4/11/09 21:56'!
pointTailTo: anRxmLink
	"Branch tails are never redirected by the build algorithm.
	Healthy terminators should never receive this."

	RxParser signalCompilationException:
		'internal matcher build error - redirecting terminator tail'! !

!RxsBranch commentStamp: 'Tbn 11/12/2010 23:14'!
-- Regular Expression Matcher v 1.1 (C) 1996, 1999 Vassili Bykov
--
A Branch is a Piece followed by a Branch or an empty string.

Instance variables:
	piece		<RxsPiece>
	branch		<RxsBranch|RxsEpsilon>!
!RxsBranch methodsFor: 'optimization' stamp: 'vb 4/11/09 21:56'!
tryMergingInto: aStream
	"Concatenation of a few simple characters can be optimized
	to be a plain substring match. Answer the node to resume
	syntax tree traversal at. Epsilon node used to terminate the branch
	will implement this to answer nil, thus indicating that the branch
	has ended."

	piece isAtomic ifFalse: [^self].
	aStream nextPut: piece character.
	^branch isNil
		ifTrue: [branch]
		ifFalse: [branch tryMergingInto: aStream]! !

!RxsBranch methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
piece

	^piece! !

!RxsBranch methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
branch

	^branch! !

!RxsBranch methodsFor: 'testing' stamp: 'vb 4/11/09 21:56'!
isNullable

	^piece isNullable and: [branch isNil or: [branch isNullable]]! !

!RxsBranch methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
initializePiece: aPiece branch: aBranch
	"See class comment for instance variables description."

	piece := aPiece.
	branch := aBranch! !

!RxsBranch methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
dispatchTo: aMatcher
	"Inform the matcher of the kind of the node, and it
	will do whatever it has to."

	^aMatcher syntaxBranch: self! !

!RxsCharSet commentStamp: 'Tbn 11/12/2010 23:14'!
-- Regular Expression Matcher v 1.1 (C) 1996, 1999 Vassili Bykov
--
A character set corresponds to a [...] construct in the regular expression.

Instance variables:
	elements	<OrderedCollection> An element can be one of: RxsCharacter, RxsRange, or RxsPredicate.
	negated		<Boolean>!
!RxsCharSet methodsFor: 'privileged' stamp: 'lr 11/4/2009 22:27'!
optimalSetIgnoringCase: aBoolean
	"Assuming the client with search the `set' using #includes:,
	answer a collection with the contents of `set', of the class
	that will provide the fastest lookup. Strings are faster than
	Sets for short strings."

	| set |
	set := self enumerableSetIgnoringCase: aBoolean.
	^set size < 10
		ifTrue: [set asArray]
		ifFalse: [set]! !

!RxsCharSet methodsFor: 'testing' stamp: 'GabrielOmarCotelli 11/28/2013 19:03'!
isEnumerable

	^elements anySatisfy: [:some | some isEnumerable ]! !

!RxsCharSet methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
initializeElements: aCollection negated: aBoolean
	"See class comment for instance variables description."

	elements := aCollection.
	negated := aBoolean! !

!RxsCharSet methodsFor: 'testing' stamp: 'vb 4/11/09 21:56'!
isNegated

	^negated! !

!RxsCharSet methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
dispatchTo: aMatcher
	"Inform the matcher of the kind of the node, and it
	will do whatever it has to."

	^aMatcher syntaxCharSet: self! !

!RxsCharSet methodsFor: 'privileged' stamp: 'vb 4/11/09 21:56'!
enumerablePartPredicateIgnoringCase: aBoolean

	| enumeration |
	enumeration := self optimalSetIgnoringCase: aBoolean.
	^negated
		ifTrue: [[:char | (enumeration includes: char) not]]
		ifFalse: [[:char | enumeration includes: char]]! !

!RxsCharSet methodsFor: 'privileged' stamp: 'vb 4/11/09 21:56'!
enumerableSetIgnoringCase: aBoolean
	"Answer a collection of characters that make up the portion of me
	that can be enumerated."

	| set |
	set := Set new.
	elements do:
		[:each |
		each isEnumerable ifTrue:
			[each enumerateTo: set ignoringCase: aBoolean]].
	^set! !

!RxsCharSet methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
predicates

	^(elements reject: [:some | some isEnumerable])
		collect: [:each | each predicate]! !

!RxsCharSet methodsFor: 'privileged' stamp: 'vb 4/11/09 21:56'!
predicatePartPredicate
	"Answer a predicate that tests all of my elements that cannot be
	enumerated."

	| predicates |
	predicates := elements reject: [:some | some isEnumerable].
	predicates isEmpty
		ifTrue: [^[:char | negated]].
	predicates size = 1
		ifTrue: [^negated
			ifTrue: [predicates first predicateNegation]
			ifFalse: [predicates first predicate]].
	predicates := predicates collect: [:each | each predicate].
	^negated
		ifFalse:
			[[:char | predicates contains: [:some | some value: char]]]
		ifTrue:
			[[:char | (predicates contains: [:some | some value: char]) not]]! !

!RxsCharSet methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
predicateIgnoringCase: aBoolean

	| predicate enumerable |
	enumerable := self enumerablePartPredicateIgnoringCase: aBoolean.
	^self hasPredicates
		ifFalse: [enumerable]
		ifTrue:
			[predicate := self predicatePartPredicate.
			negated
				ifTrue: [[:char | (enumerable value: char) and: [predicate value: char]]]
				ifFalse: [[:char | (enumerable value: char) or: [predicate value: char]]]]! !

!RxsCharSet methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
hasPredicates

	^elements contains: [:some | some isEnumerable not]! !

!RxsCharacter commentStamp: 'Tbn 11/12/2010 23:14'!
-- Regular Expression Matcher v 1.1 (C) 1996, 1999 Vassili Bykov
--
A character is a literal character that appears either in the expression itself or in a character set within an expression.

Instance variables:
	character		<Character>!
!RxsCharacter methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
enumerateTo: aSet ignoringCase: aBoolean

	aBoolean
		ifTrue: 
			[aSet 
				add: character asUppercase;
				add: character asLowercase]
		ifFalse: [aSet add: character]! !

!RxsCharacter methodsFor: 'testing' stamp: 'vb 4/11/09 21:56'!
isEnumerable

	^true! !

!RxsCharacter methodsFor: 'testing' stamp: 'vb 4/11/09 21:56'!
isAtomic
	"A character is always atomic."

	^true! !

!RxsCharacter methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
initializeCharacter: aCharacter
	"See class comment for instance variable description."

	character := aCharacter! !

!RxsCharacter methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
dispatchTo: aMatcher
	"Inform the matcher of the kind of the node, and it
	will do whatever it has to."

	^aMatcher syntaxCharacter: self! !

!RxsCharacter methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
character

	^character! !

!RxsCharacter class methodsFor: 'instance creation' stamp: 'vb 4/11/09 21:56'!
with: aCharacter

	^self new initializeCharacter: aCharacter! !

!RxsContextCondition commentStamp: 'Tbn 11/12/2010 23:14'!
-- Regular Expression Matcher v 1.1 (C) 1996, 1999 Vassili Bykov
--
One of a few special nodes more often representing special state of the match rather than a predicate on a character.  The ugly exception is the #any condition which *is* a predicate on a character.

Instance variables:
	kind		<Selector>!
!RxsContextCondition methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
beEndOfLine
	"Matches empty string at the end of a line."

	kind := #syntaxEndOfLine! !

!RxsContextCondition methodsFor: 'testing' stamp: 'vb 4/11/09 21:56'!
isNullable

	^#syntaxAny ~~ kind! !

!RxsContextCondition methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
dispatchTo: aBuilder

	^aBuilder perform: kind! !

!RxsContextCondition methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
beBeginningOfWord
	"Matches empty string at the beginning of a word."

	kind := #syntaxBeginningOfWord! !

!RxsContextCondition methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
beWordBoundary
	"Analog of \w (alphanumeric plus _)."

	kind := #syntaxWordBoundary! !

!RxsContextCondition methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
beEndOfWord
	"Matches empty string at the end of a word."

	kind := #syntaxEndOfWord! !

!RxsContextCondition methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
beBeginningOfLine
	"Matches empty string at the beginning of a line."

	kind := #syntaxBeginningOfLine! !

!RxsContextCondition methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
beNonWordBoundary
	"Analog of \B."

	kind := #syntaxNonWordBoundary! !

!RxsContextCondition methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
beAny
	"Matches anything but a newline."

	kind := #syntaxAny! !

!RxsEpsilon commentStamp: 'Tbn 11/12/2010 23:14'!
-- Regular Expression Matcher v 1.1 (C) 1996, 1999 Vassili Bykov
--
This is an empty string.  It terminates some of the recursive constructs.!
!RxsEpsilon methodsFor: 'testing' stamp: 'vb 4/11/09 21:56'!
isNullable
	"See comment in the superclass."

	^true! !

!RxsEpsilon methodsFor: 'building' stamp: 'vb 4/11/09 21:56'!
dispatchTo: aBuilder
	"Inform the matcher of the kind of the node, and it
	will do whatever it has to."

	^aBuilder syntaxEpsilon! !

!RxsLookaround commentStamp: '<historical>'!
I lookaround is used for lookaheads and lookbehinds. They are used to check if the input matches a certain subexpression without consuming any characters (e.g. not advancing the match position).

Lookarounds can be positive or negative. If they are positive the condition fails if the subexpression fails, if they are negative it is inverse.!
!RxsLookaround methodsFor: 'initailize-release' stamp: 'CamilloBruni 8/28/2013 17:01'!
initializePiece: anRsxPiece
	super initialize.
	piece := anRsxPiece.! !

!RxsLookaround methodsFor: 'accessing' stamp: 'CamilloBruni 8/28/2013 16:04'!
piece
	^ piece! !

!RxsLookaround methodsFor: 'initailize-release' stamp: 'CamilloBruni 8/28/2013 16:08'!
bePositive
	positive := true! !

!RxsLookaround methodsFor: 'accessing' stamp: 'CamilloBruni 8/28/2013 17:01'!
dispatchTo: aBuilder
	"Inform the matcher of the kind of the node, and it
	will do whatever it has to."
	^aBuilder syntaxLookaround: self! !

!RxsLookaround methodsFor: 'initailize-release' stamp: 'CamilloBruni 8/28/2013 16:08'!
beNegative
	positive := false! !

!RxsLookaround class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/28/2013 16:05'!
with: anRsxPiece
	^ self new
		initializePiece: anRsxPiece! !

!RxsMessagePredicate commentStamp: 'Tbn 11/12/2010 23:14'!
-- Regular Expression Matcher v 1.1 (C) 1996, 1999 Vassili Bykov
--
A message predicate represents a condition on a character that is tested (at the match time) by sending a unary message to the character expecting a Boolean answer.

Instance variables:
	selector		<Symbol>!
!RxsMessagePredicate methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
negated

	^negated! !

!RxsMessagePredicate methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
selector

	^selector! !

!RxsMessagePredicate methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
initializeSelector: aSelector
	"The selector must be a one-argument message understood by Character."

	selector := aSelector! !

!RxsMessagePredicate methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
dispatchTo: aBuilder
	"Inform the matcher of the kind of the node, and it
	will do whatever it has to."

	^aBuilder syntaxMessagePredicate: self! !

!RxsMessagePredicate methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
initializeSelector: aSelector negated: aBoolean
	"The selector must be a one-argument message understood by Character."

	selector := aSelector.
	negated := aBoolean! !

!RxsNode commentStamp: 'Tbn 11/12/2010 23:14'!
-- Regular Expression Matcher v 1.1 (C) 1996, 1999 Vassili Bykov
--
A generic syntax tree node, provides some common responses to the standard tests, as well as tree structure printing -- handy for debugging.!
!RxsNode methodsFor: 'constants' stamp: 'vb 4/11/09 21:56'!
indentCharacter
	"Normally, #printOn:withIndent: method in subclasses
	print several characters returned by this method to indicate
	the tree structure."

	^$+! !

!RxsNode methodsFor: 'testing' stamp: 'vb 4/11/09 21:56'!
isNullable
	"True if the node can match an empty sequence of characters."

	^false "for most nodes"! !

!RxsNode methodsFor: 'testing' stamp: 'vb 4/11/09 21:56'!
isAtomic
	"Answer whether the node is atomic, i.e. matches exactly one 
	constant predefined normal character.  A matcher may decide to 
	optimize matching of a sequence of atomic nodes by glueing them 
	together in a string."

	^false "tentatively"! !

!RxsPiece commentStamp: '<historical>'!
-- Regular Expression Matcher v 1.1 (C) 1996, 1999 Vassili Bykov
--
A piece is an atom, possibly optional or repeated a number of times.

Instance variables:
	atom	<RxsCharacter|RxsCharSet|RxsPredicate|RxsRegex|RxsSpecial>
	min		<Integer>
	max		<Integer|nil> nil means infinity!
!RxsPiece methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
initializeOptionalAtom: anAtom
	"This piece is 0 or 1 occurrences of the specified RxsAtom."

	self initializeAtom: anAtom min: 0 max: 1! !

!RxsPiece methodsFor: 'testing' stamp: 'vb 4/11/09 21:56'!
isSingular
	"A piece with a range is 1 to 1 needs can be compiled
	as a simple match."

	^min = 1 and: [max = 1]! !

!RxsPiece methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
character
	"If this node is atomic, answer the character it
	represents. It is the caller's responsibility to make sure this
	node is indeed atomic before using this."

	^atom character! !

!RxsPiece methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
atom

	^atom! !

!RxsPiece methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
initializeStarAtom: anAtom
	"This piece is any number of occurrences of the atom."

	self initializeAtom: anAtom min: 0 max: nil! !

!RxsPiece methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
max
	"The value answered may be nil, indicating infinity."

	^max! !

!RxsPiece methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
min

	^min! !

!RxsPiece methodsFor: 'testing' stamp: 'vb 4/11/09 21:56'!
isOptional

	^min = 0 and: [max = 1]! !

!RxsPiece methodsFor: 'testing' stamp: 'vb 4/11/09 21:56'!
isStar

	^min = 0 and: [max == nil]! !

!RxsPiece methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
initializeAtom: anAtom
	"This piece is exactly one occurrence of the specified RxsAtom."

	self initializeAtom: anAtom min: 1 max: 1! !

!RxsPiece methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
initializePlusAtom: anAtom
	"This piece is one or more occurrences of the specified RxsAtom."

	self initializeAtom: anAtom min: 1 max: nil! !

!RxsPiece methodsFor: 'testing' stamp: 'vb 4/11/09 21:56'!
isAtomic
	"A piece is atomic if only it contains exactly one atom
	which is atomic (sic)."

	^self isSingular and: [atom isAtomic]! !

!RxsPiece methodsFor: 'testing' stamp: 'vb 4/11/09 21:56'!
isNullable
	"A piece is nullable if it allows 0 matches. 
	This is often handy to know for optimization."

	^min = 0 or: [atom isNullable]! !

!RxsPiece methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
dispatchTo: aMatcher
	"Inform the matcher of the kind of the node, and it
	will do whatever it has to."

	^aMatcher syntaxPiece: self! !

!RxsPiece methodsFor: 'testing' stamp: 'vb 4/11/09 21:56'!
isPlus

	^min = 1 and: [max == nil]! !

!RxsPiece methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
initializeAtom: anAtom min: minOccurrences max: maxOccurrences
	"This piece is from <minOccurrences> to <maxOccurrences> 
	occurrences of the specified RxsAtom."

	atom := anAtom.
	min := minOccurrences.
	max := maxOccurrences! !

!RxsPredicate commentStamp: 'Tbn 11/12/2010 23:15'!
-- Regular Expression Matcher v 1.1 (C) 1996, 1999 Vassili Bykov
--
This represents a character that satisfies a certain predicate.

Instance Variables:

	predicate	<BlockClosure>	A one-argument block. If it evaluates to the value defined by <negated> when it is passed a character, the predicate is considered to match.
	negation	<BlockClosure>	A one-argument block that is a negation of <predicate>.!
!RxsPredicate methodsFor: 'initialize-release' stamp: 'lr 1/7/2010 20:06'!
beWordConstituent

	predicate := [:char | char isAlphaNumeric or: [char == $_]].
	negation := [:char | char isAlphaNumeric not and: [char ~~ $_]]! !

!RxsPredicate methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
beDigit

	predicate := [:char | char isDigit].
	negation := [:char | char isDigit not]! !

!RxsPredicate methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
predicate

	^predicate! !

!RxsPredicate methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
beNotWordConstituent

	self
		beWordConstituent;
		negate! !

!RxsPredicate methodsFor: 'initialize-release' stamp: 'lr 11/4/2009 22:29'!
beAlphabetic

	predicate := [:char | char isLetter].
	negation := [:char | char isLetter not]! !

!RxsPredicate methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
negated

	^self copy negate! !

!RxsPredicate methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
beAlphaNumeric

	predicate := [:char | char isAlphaNumeric].
	negation := [:char | char isAlphaNumeric not]! !

!RxsPredicate methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
beControl

	predicate := [:char | char asInteger < 32].
	negation := [:char | char asInteger >= 32]! !

!RxsPredicate methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
beSpace

	predicate := [:char | char isSeparator].
	negation := [:char | char isSeparator not]! !

!RxsPredicate methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
beUppercase

	predicate := [:char | char isUppercase].
	negation := [:char | char isUppercase not]! !

!RxsPredicate methodsFor: 'testing' stamp: 'vb 4/11/09 21:56'!
isEnumerable

	^false! !

!RxsPredicate methodsFor: 'private' stamp: 'vb 4/11/09 21:56'!
negate

	| tmp |
	tmp := predicate.
	predicate := negation.
	negation := tmp! !

!RxsPredicate methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
beNotDigit

	self
		beDigit;
		negate! !

!RxsPredicate methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
value: aCharacter

	^predicate value: aCharacter! !

!RxsPredicate methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
beHexDigit

	| hexLetters |
	hexLetters := 'abcdefABCDEF'.
	predicate := [:char | char isDigit or: [hexLetters includes: char]].
	negation := [:char | char isDigit not and: [(hexLetters includes: char) not]]! !

!RxsPredicate methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
beGraphics

	self
		beControl;
		negate! !

!RxsPredicate methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
beLowercase

	predicate := [:char | char isLowercase].
	negation := [:char | char isLowercase not]! !

!RxsPredicate methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
dispatchTo: anObject

	^anObject syntaxPredicate: self! !

!RxsPredicate methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
bePunctuation

	| punctuationChars |
	punctuationChars := #($. $, $!! $? $; $: $" $' $- $( $) $`).
	predicate := [:char | punctuationChars includes: char].
	negation := [:char | (punctuationChars includes: char) not]! !

!RxsPredicate methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
bePrintable

	self
		beControl;
		negate! !

!RxsPredicate methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
predicateNegation

	^negation! !

!RxsPredicate methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
beNotSpace

	self
		beSpace;
		negate! !

!RxsPredicate methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
beBackslash

	predicate := [:char | char == $\].
	negation := [:char | char ~~ $\]! !

!RxsPredicate class methodsFor: 'class initialization' stamp: 'vb 4/11/09 21:56'!
initialize
	"self initialize"

	self
		initializeNamedClassSelectors;
		initializeEscapedLetterSelectors! !

!RxsPredicate class methodsFor: 'instance creation' stamp: 'vb 4/11/09 21:56'!
forNamedClass: aString

	^self new perform:
		(NamedClassSelectors
			at: aString
			ifAbsent: [RxParser signalSyntaxException: 'bad character class name'])! !

!RxsPredicate class methodsFor: 'class initialization' stamp: 'vb 4/11/09 21:56'!
initializeEscapedLetterSelectors
	"self initializeEscapedLetterSelectors"

	(EscapedLetterSelectors := Dictionary new)
		at: $w put: #beWordConstituent;
		at: $W put: #beNotWordConstituent;
		at: $d put: #beDigit;
		at: $D put: #beNotDigit;
		at: $s put: #beSpace;
		at: $S put: #beNotSpace;
		at: $\ put: #beBackslash! !

!RxsPredicate class methodsFor: 'class initialization' stamp: 'vb 4/11/09 21:56'!
initializeNamedClassSelectors
	"self initializeNamedClassSelectors"

	(NamedClassSelectors := Dictionary new)
		at: 'alnum' put: #beAlphaNumeric;
		at: 'alpha' put: #beAlphabetic;
		at: 'cntrl' put: #beControl;
		at: 'digit' put: #beDigit;
		at: 'graph' put: #beGraphics;
		at: 'lower' put: #beLowercase;
		at: 'print' put: #bePrintable;
		at: 'punct' put: #bePunctuation;
		at: 'space' put: #beSpace;
		at: 'upper' put: #beUppercase;
		at: 'xdigit' put: #beHexDigit! !

!RxsPredicate class methodsFor: 'instance creation' stamp: 'vb 4/11/09 21:56'!
forEscapedLetter: aCharacter

	^self new perform:
		(EscapedLetterSelectors
			at: aCharacter
			ifAbsent: [RxParser signalSyntaxException: 'bad backslash escape'])! !

!RxsRange commentStamp: 'Tbn 11/12/2010 23:15'!
-- Regular Expression Matcher v 1.1 (C) 1996, 1999 Vassili Bykov
--
I represent a range of characters as appear in character classes such as

	[a-ZA-Z0-9].

I appear in a syntax tree only as an element of RxsCharSet.

Instance Variables:

	first	<Character>
	last	<Character>!
!RxsRange methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
initializeFirst: aCharacter last: anotherCharacter

	first := aCharacter.
	last := anotherCharacter! !

!RxsRange methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
enumerateTo: aSet ignoringCase: aBoolean
	"Add all of the elements I represent to the collection."

	first asInteger to: last asInteger do:
		[:charCode | | character |
		character := charCode asCharacter.
		aBoolean
		ifTrue: 
			[aSet 
				add: character asUppercase;
				add: character asLowercase]
		ifFalse: [aSet add: character]]! !

!RxsRange methodsFor: 'testing' stamp: 'vb 4/11/09 21:56'!
isEnumerable

	^true! !

!RxsRange class methodsFor: 'instance creation' stamp: 'vb 4/11/09 21:56'!
from: aCharacter to: anotherCharacter

	^self new initializeFirst: aCharacter last: anotherCharacter! !

!RxsRegex commentStamp: 'Tbn 11/12/2010 23:15'!
-- Regular Expression Matcher v 1.1 (C) 1996, 1999 Vassili Bykov
--
The body of a parenthesized thing, or a top-level expression, also an atom.  

Instance variables:
	branch		<RxsBranch>
	regex		<RxsRegex | RxsEpsilon>!
!RxsRegex methodsFor: 'initialize-release' stamp: 'vb 4/11/09 21:56'!
initializeBranch: aBranch regex: aRegex
	"See class comment for instance variable description."

	branch := aBranch.
	regex := aRegex! !

!RxsRegex methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
branch

	^branch! !

!RxsRegex methodsFor: 'testing' stamp: 'vb 4/11/09 21:56'!
isNullable

	^branch isNullable or: [regex notNil and: [regex isNullable]]! !

!RxsRegex methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
dispatchTo: aMatcher
	"Inform the matcher of the kind of the node, and it
	will do whatever it has to."

	^aMatcher syntaxRegex: self! !

!RxsRegex methodsFor: 'accessing' stamp: 'vb 4/11/09 21:56'!
regex
	^regex! !

!SDL2 commentStamp: 'IgorStasenko 7/30/2014 18:24'!
A bunch of functions in a single class for accessing SDL2 interface!
!SDL2 methodsFor: 'nb-library' stamp: 'RonieSalgado 3/23/2014 20:29'!
nbLibraryNameOrHandle
	^self class nbLibraryNameOrHandle! !

!SDL2 class methodsFor: 'opengl' stamp: 'RonieSalgado 5/8/2014 22:59'!
glCreateContext: window
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( SDL_GLContext SDL_GL_CreateContext ( SDL_Window window ) )! !

!SDL2 class methodsFor: 'video' stamp: 'RonieSalgado 3/26/2014 15:12'!
freeSurface: surface
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( void SDL_FreeSurface ( SDL_Surface* surface ) )! !

!SDL2 class methodsFor: 'native' stamp: 'RonieSalgado 4/18/2014 21:34'!
checkLibraryName: aName
	^ (NativeBoost loadSymbol: 'SDL_Init' fromModule: aName) notNil! !

!SDL2 class methodsFor: 'opengl' stamp: 'RonieSalgado 5/8/2014 23:00'!
glMakeCurrent: window context: context
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( int SDL_GL_MakeCurrent ( SDL_Window window , SDL_GLContext context ) )! !

!SDL2 class methodsFor: 'common' stamp: 'RonieSalgado 3/23/2014 22:20'!
init: flags
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( int SDL_Init ( Uint32 flags ) )! !

!SDL2 class methodsFor: 'common' stamp: 'RonieSalgado 3/23/2014 22:06'!
quit
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( void SDL_Quit ( ) )! !

!SDL2 class methodsFor: 'clipboard' stamp: 'RonieSalgado 5/3/2014 20:00'!
strlen: text
	| res |
	res := 0.
	[ (text nbUInt8AtOffset: res) ~= 0 ] whileTrue:
		[ res := res + 1 ].
	^ res! !

!SDL2 class methodsFor: 'video' stamp: 'RonieSalgado 3/26/2014 15:35'!
createRGBSurfaceFromPixels: pixels width: width height: height depth: depth pitch: pitch
	rmask: rmask gmask: gmask bmask: bmask amask: amask
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( SDL_Surface* SDL_CreateRGBSurfaceFrom 
						( void* pixels , int width , int height , int depth , int pitch ,
						  Uint32 rmask , Uint32 gmask , Uint32 bmask , Uint32 amask ) )! !

!SDL2 class methodsFor: 'common' stamp: 'RonieSalgado 4/18/2014 21:44'!
isAvailable
	^ [ (NativeBoost loadSymbol: 'SDL_Init' fromModule: SDL2 moduleName) isNotNil ] ifError: [ false ]! !

!SDL2 class methodsFor: 'native' stamp: 'RonieSalgado 3/23/2014 22:59'!
nbLibraryNameOrHandle
	^ self moduleName! !

!SDL2 class methodsFor: 'clipboard' stamp: 'RonieSalgado 5/3/2014 20:01'!
clipboardText
	| text len data |
	text := self primClipboardText.
	len := self strlen: text.
	data := ByteArray new: len.
	NativeBoost memCopy: text to: data size: len.
	^ ZnUTF8Encoder new decodeBytes: data.! !

!SDL2 class methodsFor: 'timer' stamp: 'RonieSalgado 3/24/2014 01:16'!
delay: milliseconds
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( void SDL_Delay ( Uint32 milliseconds ) )! !

!SDL2 class methodsFor: 'mouse' stamp: 'RonieSalgado 3/25/2014 16:49'!
mouseStateX: x y: y
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( Uint32 SDL_GetMouseState ( int* x , int* y ) )! !

!SDL2 class methodsFor: 'event' stamp: 'RonieSalgado 3/25/2014 03:47'!
pollEvent: event
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( int SDL_PollEvent ( void* event ) )! !

!SDL2 class methodsFor: 'common' stamp: 'RonieSalgado 3/25/2014 02:34'!
initLibrary
	Session == Smalltalk session ifTrue: [ ^ 1 ].
	self init: SDL_INIT_NOPARACHUTE.
	Session := Smalltalk session.! !

!SDL2 class methodsFor: 'clipboard' stamp: 'RonieSalgado 5/3/2014 19:57'!
clipboardText: text
	| encoded encoder |
	encoded := ByteArray streamContents: [ :stream |
		encoder := ZnUTF8Encoder new.
		encoder next: text size putAll: text startingAt: 1 toStream: stream.
		stream nextPut: 0 ].
	self primClipboardText: encoded! !

!SDL2 class methodsFor: 'native' stamp: 'RonieSalgado 4/18/2014 21:48'!
findSDL2
	"In Linux, try to use the linked version."
	OSSDL2Driver hasPlugin.
	
	"Look for SDL2 using different names."
	#( 0
	SDL2
	libSDL2.so
	SDL2.dll
	) do: [ :nm | [(self checkLibraryName: nm) ifTrue: [ ^ nm ] ] ifError: [nil] ].
	self error: 'Failed to find SDL2 library.'! !

!SDL2 class methodsFor: 'mouse' stamp: 'RonieSalgado 3/25/2014 14:47'!
mouseState
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( Uint32 SDL_GetMouseState ( nil , nil ) )! !

!SDL2 class methodsFor: 'common' stamp: 'RonieSalgado 3/25/2014 02:07'!
initVideo
	self initLibrary;
		 initSubSystem: SDL_INIT_VIDEO! !

!SDL2 class methodsFor: 'opengl' stamp: 'RonieSalgado 5/9/2014 02:02'!
glSwapWindow: window
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( void SDL_GL_SwapWindow ( SDL_Window window ) )! !

!SDL2 class methodsFor: 'clipboard' stamp: 'RonieSalgado 5/3/2014 19:43'!
primClipboardText: text
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( int SDL_SetClipboardText ( char* text ) )! !

!SDL2 class methodsFor: 'opengl' stamp: 'RonieSalgado 5/8/2014 22:46'!
glSetAttribute: attr value: value
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( int SDL_GL_SetAttribute(SDL_GLattr attr, int value) )! !

!SDL2 class methodsFor: 'mouse' stamp: 'RonieSalgado 3/25/2014 14:47'!
modState
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( SDL_Keymod SDL_GetModState ( ) )! !

!SDL2 class methodsFor: 'clipboard' stamp: 'RonieSalgado 5/3/2014 19:43'!
primClipboardText
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( char* SDL_GetClipboardText ( ) )! !

!SDL2 class methodsFor: 'common' stamp: 'RonieSalgado 3/23/2014 22:20'!
wasInit: flags
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( int SDL_WasInit ( Uint32 flags ) )! !

!SDL2 class methodsFor: 'opengl' stamp: 'RonieSalgado 5/8/2014 23:02'!
glGetProcAddress: procName
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( void* SDL_GL_GetProcAddress ( String procName ) )! !

!SDL2 class methodsFor: 'common' stamp: 'RonieSalgado 3/23/2014 22:20'!
initSubSystem: flags
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( int SDL_InitSubSystem ( Uint32 flags ) )! !

!SDL2 class methodsFor: 'native' stamp: 'RonieSalgado 4/18/2014 21:42'!
moduleName
	ModuleSession ~~ Smalltalk session ifTrue: [
		ModuleName := self findSDL2.
		ModuleSession := Smalltalk session
	].
	^ ModuleName! !

!SDL2 class methodsFor: 'timer' stamp: 'RonieSalgado 3/24/2014 01:19'!
ticks
	"Gets the number of milliseconds since the SDL library was initialized"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( Uint32 SDL_GetTicks ( ) )! !

!SDL2 class methodsFor: 'video' stamp: 'RonieSalgado 3/24/2014 01:21'!
createWindow: title x: x y: y width: w height: h flags: flags
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( SDL_Window SDL_CreateWindow ( String title, int x, int y, int w, int h, Uint32 flags ) )! !

!SDL2 class methodsFor: 'common' stamp: 'RonieSalgado 3/23/2014 22:20'!
quitSubSystem: flags
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( void SDL_QuitSubSystem ( Uint32 flags ) )! !

!SDL2Constants commentStamp: 'IgorStasenko 7/30/2014 18:24'!
Pool of various SDL2 library constants!
!SDL2Constants class methodsFor: 'class initialization' stamp: 'RonieSalgado 3/25/2014 03:22'!
initializeEvent
    SDL_FIRSTEVENT := 0.
    SDL_QUIT           := 16r100.

    "iOS Events"
    SDL_APP_TERMINATING	:= SDL_QUIT + 1.
    SDL_APP_LOWMEMORY	:= SDL_QUIT + 2.
    SDL_APP_WILLENTERBACKGROUND	:= SDL_QUIT + 3.
    SDL_APP_DIDENTERBACKGROUND	:= SDL_QUIT + 4.
    SDL_APP_WILLENTERFOREGROUND	:= SDL_QUIT + 5.
    SDL_APP_DIDENTERFOREGROUND	:= SDL_QUIT + 6.
						
    "Window events"
    SDL_WINDOWEVENT := 16r200.
    SDL_SYSWMEVENT := SDL_WINDOWEVENT + 1.

    "Keyboard events"
    SDL_KEYDOWN  := 16r300.
    SDL_KEYUP			:= SDL_KEYDOWN + 1.
    SDL_TEXTEDITING	:= SDL_KEYDOWN + 2.
    SDL_TEXTINPUT		:= SDL_KEYDOWN + 3.

    "Mouse events"
    SDL_MOUSEMOTION    := 16r400.
    SDL_MOUSEBUTTONDOWN	:= SDL_MOUSEMOTION + 1.
    SDL_MOUSEBUTTONUP		:= SDL_MOUSEMOTION + 2.
    SDL_MOUSEWHEEL			:= SDL_MOUSEMOTION + 3.

    "Joystick events"
    SDL_JOYAXISMOTION  := 16r600.
    SDL_JOYBALLMOTION	:= SDL_JOYAXISMOTION + 1.
    SDL_JOYHATMOTION	:= SDL_JOYAXISMOTION + 2.
    SDL_JOYBUTTONDOWN	:= SDL_JOYAXISMOTION + 3.
    SDL_JOYBUTTONUP		:= SDL_JOYAXISMOTION + 4.
    SDL_JOYDEVICEADDED	:= SDL_JOYAXISMOTION + 5.
    SDL_JOYDEVICEREMOVED	:= SDL_JOYAXISMOTION + 6.

    "Game controller events"
    SDL_CONTROLLERAXISMOTION  := 16r650.
    SDL_CONTROLLERBUTTONDOWN	:= SDL_CONTROLLERAXISMOTION + 1.
    SDL_CONTROLLERBUTTONUP	 	:= SDL_CONTROLLERAXISMOTION + 2.
    SDL_CONTROLLERDEVICEADDED 	:= SDL_CONTROLLERAXISMOTION + 3.
    SDL_CONTROLLERDEVICEREMOVED	:= SDL_CONTROLLERAXISMOTION + 4.
    SDL_CONTROLLERDEVICEREMAPPED	:= SDL_CONTROLLERAXISMOTION + 5.

    "Touch events"
    SDL_FINGERDOWN	:= 16r700.
    SDL_FINGERUP		:= SDL_FINGERDOWN + 1.
    SDL_FINGERMOTION	:= SDL_FINGERDOWN + 2.

    "Gesture events"
    SDL_DOLLARGESTURE  := 16r800.
    SDL_DOLLARRECORD := SDL_DOLLARGESTURE + 1.
    SDL_MULTIGESTURE := SDL_DOLLARGESTURE + 2.

    "Clipboard events"
    SDL_CLIPBOARDUPDATE := 16r900.

    "Drag and drop events"
    SDL_DROPFILE        := 16r1000.

    "/** Events ::SDL_USEREVENT through ::SDL_LASTEVENT are for your use,
     *  and should be allocated with SDL_RegisterEvents()
     */"
    SDL_USEREVENT    := 16r8000.

    "/**
     *  This last event is only for bounding internal arrays
     */"
    SDL_LASTEVENT    := 16rFFFF
! !

!SDL2Constants class methodsFor: 'class initialization' stamp: 'RonieSalgado 3/25/2014 14:58'!
initializeMouse
	SDL_BUTTON_LEFT 	:= 1.
	SDL_BUTTON_MIDDLE	:=  2.
	SDL_BUTTON_RIGHT	:= 3.
	SDL_BUTTON_X1		:= 4.
	SDL_BUTTON_X2		:= 5.
	SDL_BUTTON_LMASK	:= self SDL_BUTTON: SDL_BUTTON_LEFT.
	SDL_BUTTON_MMASK	:= self SDL_BUTTON: SDL_BUTTON_MIDDLE.
	SDL_BUTTON_RMASK	:= self SDL_BUTTON: SDL_BUTTON_RIGHT.
	SDL_BUTTON_X1MASK	:= self SDL_BUTTON: SDL_BUTTON_X1.
	SDL_BUTTON_X2MASK  := self SDL_BUTTON: SDL_BUTTON_X2.
! !

!SDL2Constants class methodsFor: 'class initialization' stamp: 'RonieSalgado 3/25/2014 17:35'!
initializeKeycodes2
	SDLK_CAPSLOCK	:= 16r40000039.
	SDLK_F1	:= 16r4000003A.
	SDLK_F2	:= 16r4000003B.
	SDLK_F3	:= 16r4000003C.
	SDLK_F4	:= 16r4000003D.
	SDLK_F5	:= 16r4000003E.
	SDLK_F6	:= 16r4000003F.
	SDLK_F7	:= 16r40000040.
	SDLK_F8	:= 16r40000041.
	SDLK_F9	:= 16r40000042.
	SDLK_F10	:= 16r40000043.
	SDLK_F11	:= 16r40000044.
	SDLK_F12	:= 16r40000045.
	SDLK_PRINTSCREEN	:= 16r40000046.
	SDLK_SCROLLLOCK	:= 16r40000047.
	SDLK_PAUSE	:= 16r40000048.
	SDLK_INSERT	:= 16r40000049.
	SDLK_HOME	:= 16r4000004A.
	SDLK_PAGEUP	:= 16r4000004B.
	SDLK_DELETE	:= 16r007F.
	SDLK_END	:= 16r4000004D.
	SDLK_PAGEDOWN	:= 16r4000004E.
	SDLK_RIGHT	:= 16r4000004F.
	SDLK_LEFT	:= 16r40000050.
	SDLK_DOWN	:= 16r40000051.
	SDLK_UP	:= 16r40000052.
	SDLK_NUMLOCKCLEAR	:= 16r40000053.
	SDLK_KP_DIVIDE	:= 16r40000054.
	SDLK_KP_MULTIPLY	:= 16r40000055.
	SDLK_KP_MINUS	:= 16r40000056.
	SDLK_KP_PLUS	:= 16r40000057.
	SDLK_KP_ENTER	:= 16r40000058.
	SDLK_KP_1	:= 16r40000059.
	SDLK_KP_2	:= 16r4000005A.
	SDLK_KP_3	:= 16r4000005B.
	SDLK_KP_4	:= 16r4000005C.
	SDLK_KP_5	:= 16r4000005D.
	SDLK_KP_6	:= 16r4000005E.
	SDLK_KP_7	:= 16r4000005F.
	SDLK_KP_8	:= 16r40000060.
	SDLK_KP_9	:= 16r40000061.
	SDLK_KP_0	:= 16r40000062.
	SDLK_KP_PERIOD	:= 16r40000063.
	SDLK_APPLICATION	:= 16r40000065.
	SDLK_POWER	:= 16r40000066.
	SDLK_KP_EQUALS	:= 16r40000067.
	SDLK_F13	:= 16r40000068.
	SDLK_F14	:= 16r40000069.
	SDLK_F15	:= 16r4000006A.
	SDLK_F16	:= 16r4000006B.
	SDLK_F17	:= 16r4000006C.
	SDLK_F18	:= 16r4000006D.
	SDLK_F19	:= 16r4000006E.
	SDLK_F20	:= 16r4000006F.
	SDLK_F21	:= 16r40000070.
	SDLK_F22	:= 16r40000071.
	SDLK_F23	:= 16r40000072.
	SDLK_F24	:= 16r40000073.
	SDLK_EXECUTE	:= 16r40000074.
	SDLK_HELP	:= 16r40000075.
	SDLK_MENU	:= 16r40000076.
	SDLK_SELECT	:= 16r40000077.
	SDLK_STOP	:= 16r40000078.
	SDLK_AGAIN	:= 16r40000079.
	SDLK_UNDO	:= 16r4000007A.
	SDLK_CUT	:= 16r4000007B.
	SDLK_COPY	:= 16r4000007C.
	SDLK_PASTE	:= 16r4000007D.
	SDLK_FIND	:= 16r4000007E.
	SDLK_MUTE	:= 16r4000007F.
	SDLK_VOLUMEUP	:= 16r40000080.
	SDLK_VOLUMEDOWN	:= 16r40000081.
	SDLK_KP_COMMA	:= 16r40000085.
	SDLK_KP_EQUALSAS400	:= 16r40000086.! !

!SDL2Constants class methodsFor: 'class initialization' stamp: 'RonieSalgado 5/8/2014 22:49'!
initializeOpenGL
    SDL_GL_RED_SIZE	:= 0.
    SDL_GL_GREEN_SIZE	:= 1.
    SDL_GL_BLUE_SIZE	:= 2.
    SDL_GL_ALPHA_SIZE	:= 3.
    SDL_GL_BUFFER_SIZE	:= 4.
    SDL_GL_DOUBLEBUFFER	:= 5.
    SDL_GL_DEPTH_SIZE	:= 6.
    SDL_GL_STENCIL_SIZE	:= 7.
    SDL_GL_ACCUM_RED_SIZE	:= 8.
    SDL_GL_ACCUM_GREEN_SIZE	:= 9.
    SDL_GL_ACCUM_BLUE_SIZE		:= 10.
    SDL_GL_ACCUM_ALPHA_SIZE	:= 11.
    SDL_GL_STEREO		:= 12.
    SDL_GL_MULTISAMPLEBUFFERS	:= 13.
    SDL_GL_MULTISAMPLESAMPLES	:= 14.
    SDL_GL_ACCELERATED_VISUAL	:= 15.
    SDL_GL_SWAP_CONTROL	:= 16
! !

!SDL2Constants class methodsFor: 'class initialization' stamp: 'RonieSalgado 3/23/2014 22:03'!
initializeCommon
	SDL_INIT_TIMER := 16r00000001.
	SDL_INIT_AUDIO := 16r00000010.
	SDL_INIT_VIDEO := 16r00000020.
	SDL_INIT_JOYSTICK := 16r00000200.
	SDL_INIT_HAPTIC := 16r00001000.
	SDL_INIT_GAMECONTROLLER := 16r00002000.
	SDL_INIT_EVENTS := 16r00004000.
	SDL_INIT_NOPARACHUTE := 16r00100000.
	SDL_INIT_EVERYTHING := SDL_INIT_TIMER | SDL_INIT_AUDIO | SDL_INIT_VIDEO | SDL_INIT_EVENTS |
                SDL_INIT_JOYSTICK | SDL_INIT_HAPTIC | SDL_INIT_GAMECONTROLLER.! !

!SDL2Constants class methodsFor: 'class initialization' stamp: 'RonieSalgado 3/25/2014 14:59'!
SDL_BUTTON: button
	^ (1 << ((button)-1))! !

!SDL2Constants class methodsFor: 'class initialization' stamp: 'RonieSalgado 5/15/2014 23:50'!
initialize
	"
	self initialize
	"
	self initializeCommon.
	self initializeEvent.
	self initializeKeyboard.
	self initializeKeycodes.
	self initializeKeycodes2.
	self initializeKeycodes3.
	self initializeMouse.
	self initializeOpenGL.
	self initializePixelFormat.
	self initializeRenderer.
	self initializeTexture.
	self initializeWindow.! !

!SDL2Constants class methodsFor: 'class initialization' stamp: 'RonieSalgado 3/25/2014 17:35'!
initializeKeycodes
	SDLK_UNKNOWN	:= 16r0000.
	SDLK_RETURN	:= 16r000D.
	SDLK_ESCAPE	:= 16r001B.
	SDLK_BACKSPACE	:= 16r0008.
	SDLK_TAB	:= 16r0009.
	SDLK_SPACE	:= 16r0020.
	SDLK_EXCLAIM	:= 16r0021.
	SDLK_QUOTEDBL	:= 16r0022.
	SDLK_HASH	:= 16r0023.
	SDLK_PERCENT	:= 16r0025.
	SDLK_DOLLAR	:= 16r0024.
	SDLK_AMPERSAND	:= 16r0026.
	SDLK_QUOTE	:= 16r0027.
	SDLK_LEFTPAREN	:= 16r0028.
	SDLK_RIGHTPAREN	:= 16r0029.
	SDLK_ASTERISK	:= 16r002A.
	SDLK_PLUS	:= 16r002B.
	SDLK_COMMA	:= 16r002C.
	SDLK_MINUS	:= 16r002D.
	SDLK_PERIOD	:= 16r002E.
	SDLK_SLASH	:= 16r002F.
	SDLK_0	:= 16r0030.
	SDLK_1	:= 16r0031.
	SDLK_2	:= 16r0032.
	SDLK_3	:= 16r0033.
	SDLK_4	:= 16r0034.
	SDLK_5	:= 16r0035.
	SDLK_6	:= 16r0036.
	SDLK_7	:= 16r0037.
	SDLK_8	:= 16r0038.
	SDLK_9	:= 16r0039.
	SDLK_COLON	:= 16r003A.
	SDLK_SEMICOLON	:= 16r003B.
	SDLK_LESS	:= 16r003C.
	SDLK_EQUALS	:= 16r003D.
	SDLK_GREATER	:= 16r003E.
	SDLK_QUESTION	:= 16r003F.
	SDLK_AT	:= 16r0040.
	SDLK_LEFTBRACKET	:= 16r005B.
	SDLK_BACKSLASH	:= 16r005C.
	SDLK_RIGHTBRACKET	:= 16r005D.
	SDLK_CARET	:= 16r005E.
	SDLK_UNDERSCORE	:= 16r005F.
	SDLK_BACKQUOTE	:= 16r0060.
	SDLK_a	:= 16r0061.
	SDLK_b	:= 16r0062.
	SDLK_c	:= 16r0063.
	SDLK_d	:= 16r0064.
	SDLK_e	:= 16r0065.
	SDLK_f	:= 16r0066.
	SDLK_g	:= 16r0067.
	SDLK_h	:= 16r0068.
	SDLK_i	:= 16r0069.
	SDLK_j	:= 16r006A.
	SDLK_k	:= 16r006B.
	SDLK_l	:= 16r006C.
	SDLK_m	:= 16r006D.
	SDLK_n	:= 16r006E.
	SDLK_o	:= 16r006F.
	SDLK_p	:= 16r0070.
	SDLK_q	:= 16r0071.
	SDLK_r	:= 16r0072.
	SDLK_s	:= 16r0073.
	SDLK_t	:= 16r0074.
	SDLK_u	:= 16r0075.
	SDLK_v	:= 16r0076.
	SDLK_w	:= 16r0077.
	SDLK_x	:= 16r0078.
	SDLK_y	:= 16r0079.
	SDLK_z	:= 16r007A.! !

!SDL2Constants class methodsFor: 'class initialization' stamp: 'RonieSalgado 5/15/2014 23:49'!
initializeKeycodes3
	SDLK_ALTERASE	:= 16r40000099.
	SDLK_SYSREQ	:= 16r4000009A.
	SDLK_CANCEL	:= 16r4000009B.
	SDLK_CLEAR	:= 16r4000009C.
	SDLK_PRIOR	:= 16r4000009D.
	SDLK_RETURN2	:= 16r4000009E.
	SDLK_SEPARATOR	:= 16r4000009F.
	SDLK_OUT	:= 16r400000A0.
	SDLK_OPER	:= 16r400000A1.
	SDLK_CLEARAGAIN	:= 16r400000A2.
	SDLK_CRSEL	:= 16r400000A3.
	SDLK_EXSEL	:= 16r400000A4.
	SDLK_KP_00	:= 16r400000B0.
	SDLK_KP_000	:= 16r400000B1.
	SDLK_THOUSANDSSEPARATOR	:= 16r400000B2.
	SDLK_DECIMALSEPARATOR	:= 16r400000B3.
	SDLK_CURRENCYUNIT	:= 16r400000B4.
	SDLK_CURRENCYSUBUNIT	:= 16r400000B5.
	SDLK_KP_LEFTPAREN	:= 16r400000B6.
	SDLK_KP_RIGHTPAREN	:= 16r400000B7.
	SDLK_KP_LEFTBRACE	:= 16r400000B8.
	SDLK_KP_RIGHTBRACE	:= 16r400000B9.
	SDLK_KP_TAB	:= 16r400000BA.
	SDLK_KP_BACKSPACE	:= 16r400000BB.
	SDLK_KP_A	:= 16r400000BC.
	SDLK_KP_B	:= 16r400000BD.
	SDLK_KP_C	:= 16r400000BE.
	SDLK_KP_D	:= 16r400000BF.
	SDLK_KP_E	:= 16r400000C0.
	SDLK_KP_F	:= 16r400000C1.
	SDLK_KP_XOR	:= 16r400000C2.
	SDLK_KP_POWER	:= 16r400000C3.
	SDLK_KP_PERCENT	:= 16r400000C4.
	SDLK_KP_LESS	:= 16r400000C5.
	SDLK_KP_GREATER	:= 16r400000C6.
	SDLK_KP_AMPERSAND	:= 16r400000C7.
	SDLK_KP_DBLAMPERSAND	:= 16r400000C8.
	SDLK_KP_VERTICALBAR	:= 16r400000C9.
	SDLK_KP_DBLVERTICALBAR	:= 16r400000CA.
	SDLK_KP_COLON	:= 16r400000CB.
	SDLK_KP_HASH	:= 16r400000CC.
	SDLK_KP_SPACE	:= 16r400000CD.
	SDLK_KP_AT	:= 16r400000CE.
	SDLK_KP_EXCLAM	:= 16r400000CF.
	SDLK_KP_MEMSTORE	:= 16r400000D0.
	SDLK_KP_MEMRECALL	:= 16r400000D1.
	SDLK_KP_MEMCLEAR	:= 16r400000D2.
	SDLK_KP_MEMADD	:= 16r400000D3.
	SDLK_KP_MEMSUBTRACT	:= 16r400000D4.
	SDLK_KP_MEMMULTIPLY	:= 16r400000D5.
	SDLK_KP_MEMDIVIDE	:= 16r400000D6.
	SDLK_KP_PLUSMINUS	:= 16r400000D7.
	SDLK_KP_CLEAR	:= 16r400000D8.
	SDLK_KP_CLEARENTRY	:= 16r400000D9.
	SDLK_KP_BINARY	:= 16r400000DA.
	SDLK_KP_OCTAL	:= 16r400000DB.
	SDLK_KP_DECIMAL	:= 16r400000DC.
	SDLK_KP_HEXADECIMAL	:= 16r400000DD.
	SDLK_LCTRL	:= 16r400000E0.
	SDLK_LSHIFT	:= 16r400000E1.
	SDLK_LALT	:= 16r400000E2.
	SDLK_LGUI	:= 16r400000E3.
	SDLK_RCTRL	:= 16r400000E4.
	SDLK_RSHIFT	:= 16r400000E5.
	SDLK_RALT	:= 16r400000E6.
	SDLK_RGUI	:= 16r400000E7.
	SDLK_MODE	:= 16r40000101.
	SDLK_AUDIONEXT	:= 16r40000102.
	SDLK_AUDIOPREV	:= 16r40000103.
	SDLK_AUDIOSTOP	:= 16r40000104.
	SDLK_AUDIOPLAY	:= 16r40000105.
	SDLK_AUDIOMUTE	:= 16r40000106.
	SDLK_MEDIASELECT	:= 16r40000107.
	SDLK_WWW	:= 16r40000108.
	SDLK_MAIL	:= 16r40000109.
	SDLK_CALCULATOR	:= 16r4000010A.
	SDLK_COMPUTER	:= 16r4000010B.
	SDLK_AC_SEARCH	:= 16r4000010C.
	SDLK_AC_HOME	:= 16r4000010D.
	SDLK_AC_BACK	:= 16r4000010E.
	SDLK_AC_FORWARD	:= 16r4000010F.
	SDLK_AC_STOP	:= 16r40000110.
	SDLK_AC_REFRESH	:= 16r40000111.
	SDLK_AC_BOOKMARKS	:= 16r40000112.
	SDLK_BRIGHTNESSDOWN	:= 16r40000113.
	SDLK_BRIGHTNESSUP	:= 16r40000114.
	SDLK_DISPLAYSWITCH	:= 16r40000115.
	SDLK_KBDILLUMTOGGLE	:= 16r40000116.
	SDLK_KBDILLUMDOWN	:= 16r40000117.
	SDLK_KBDILLUMUP	:= 16r40000118.
	SDLK_EJECT	:= 16r40000119.
	SDLK_SLEEP	:= 16r4000011A.! !

!SDL2Constants class methodsFor: 'class initialization' stamp: 'RonieSalgado 3/24/2014 02:56'!
initializeRenderer
	"
	Renderer related constants.
	"
      SDL_RENDERER_SOFTWARE := 16r00000001.
    	SDL_RENDERER_ACCELERATED := 16r00000002.
    	SDL_RENDERER_PRESENTVSYNC := 16r00000004.
    	SDL_RENDERER_TARGETTEXTURE := 16r00000008.! !

!SDL2Constants class methodsFor: 'class initialization' stamp: 'RonieSalgado 3/24/2014 03:38'!
initializePixelFormat
	"
	Pixel format related constants
	"
  	SDL_PIXELTYPE_UNKNOWN := 0.
    	SDL_PIXELTYPE_INDEX1 := 1.
    	SDL_PIXELTYPE_INDEX4 := 2.
    	SDL_PIXELTYPE_INDEX8 := 3.
    	SDL_PIXELTYPE_PACKED8 := 4.
    	SDL_PIXELTYPE_PACKED16 := 5.
    	SDL_PIXELTYPE_PACKED32 := 6.
    	SDL_PIXELTYPE_ARRAYU8 := 7.
    	SDL_PIXELTYPE_ARRAYU16 := 8.
    	SDL_PIXELTYPE_ARRAYU32 := 9.
    	SDL_PIXELTYPE_ARRAYF16 := 10.
    	SDL_PIXELTYPE_ARRAYF32 := 11.

    	SDL_BITMAPORDER_NONE := 0.
    	SDL_BITMAPORDER_4321 := 1.
    	SDL_BITMAPORDER_1234 := 2.
			
	SDL_PACKEDORDER_NONE := 0.
    	SDL_PACKEDORDER_XRGB := 1.
    	SDL_PACKEDORDER_RGBX := 2.
    	SDL_PACKEDORDER_ARGB := 3.
    	SDL_PACKEDORDER_RGBA := 4.
    	SDL_PACKEDORDER_XBGR := 5.
    	SDL_PACKEDORDER_BGRX := 6.
    	SDL_PACKEDORDER_ABGR := 7.
    	SDL_PACKEDORDER_BGRA := 8.

    	SDL_ARRAYORDER_NONE := 0.
    	SDL_ARRAYORDER_RGB := 1.
    	SDL_ARRAYORDER_RGBA := 2.
    	SDL_ARRAYORDER_ARGB := 3.
    	SDL_ARRAYORDER_BGR := 4.
    	SDL_ARRAYORDER_BGRA := 5.
    	SDL_ARRAYORDER_ABGR := 6.
		
    	SDL_PACKEDLAYOUT_NONE := 6.
    	SDL_PACKEDLAYOUT_332 := 6.
    	SDL_PACKEDLAYOUT_4444 := 6.
    	SDL_PACKEDLAYOUT_1555 := 6.
    	SDL_PACKEDLAYOUT_5551 := 6.
    	SDL_PACKEDLAYOUT_565 := 6.
    	SDL_PACKEDLAYOUT_8888 := 6.
    	SDL_PACKEDLAYOUT_2101010 := 6.
    	SDL_PACKEDLAYOUT_1010102 := 6.
									
	SDL_PIXELFORMAT_RGBX8888 := self definePixelFormat_type: SDL_PIXELTYPE_PACKED32 order: SDL_PACKEDORDER_RGBX layout: SDL_PACKEDLAYOUT_8888 bits: 24 bytes: 4.
	SDL_PIXELFORMAT_XRGB8888 := self definePixelFormat_type: SDL_PIXELTYPE_PACKED32 order: SDL_PACKEDORDER_XRGB layout: SDL_PACKEDLAYOUT_8888 bits: 24 bytes: 4.! !

!SDL2Constants class methodsFor: 'class initialization' stamp: 'RonieSalgado 3/24/2014 03:18'!
definePixelFormat_type: type order: order layout: playout bits: bits bytes: bytes
	^ ((1 << 28) | ((type) << 24) | ((order) << 20) | ((playout) << 16) |
     	    ((bits) << 8) | ((bytes) << 0))! !

!SDL2Constants class methodsFor: 'class initialization' stamp: 'RonieSalgado 3/24/2014 02:55'!
initializeTexture
	"
	Texture related constants.
	"
      SDL_TEXTUREACCESS_STATIC := 0.
      SDL_TEXTUREACCESS_STREAMING := 1.
      SDL_TEXTUREACCESS_TARGET := 2.
! !

!SDL2Constants class methodsFor: 'class initialization' stamp: 'RonieSalgado 3/25/2014 04:08'!
initializeWindow
	"
	Window related constants.
	"
    SDL_WINDOW_FULLSCREEN := 16r00000001.
    SDL_WINDOW_OPENGL := 16r00000002.
    SDL_WINDOW_SHOWN := 16r00000004.
    SDL_WINDOW_HIDDEN := 16r00000008.
    SDL_WINDOW_BORDERLESS := 16r00000010.
    SDL_WINDOW_RESIZABLE := 16r00000020.
    SDL_WINDOW_MINIMIZED := 16r00000040.
    SDL_WINDOW_MAXIMIZED := 16r00000080.
    SDL_WINDOW_INPUT_GRABBED := 16r00000100.
    SDL_WINDOW_INPUT_FOCUS := 16r00000200.
    SDL_WINDOW_MOUSE_FOCUS := 16r00000400.
    SDL_WINDOW_FULLSCREEN_DESKTOP := ( SDL_WINDOW_FULLSCREEN | 16r00001000 ).
    SDL_WINDOW_FOREIGN := 16r00000800.
    SDL_WINDOW_ALLOW_HIGHDPI := 16r00002000.

    SDL_WINDOWPOS_UNDEFINED_MASK := 16r1FFF0000.
    SDL_WINDOWPOS_UNDEFINED := SDL_WINDOWPOS_UNDEFINED_MASK.
	
    SDL_WINDOWPOS_CENTERED_MASK := 16r2FFF0000.
    SDL_WINDOWPOS_CENTERED := SDL_WINDOWPOS_CENTERED_MASK.

    SDL_WINDOWEVENT_NONE			:= 0.
    SDL_WINDOWEVENT_SHOWN		:= 1.
    SDL_WINDOWEVENT_HIDDEN			:= 2.
    SDL_WINDOWEVENT_EXPOSED		:= 3.
    SDL_WINDOWEVENT_MOVED			:= 4.
    SDL_WINDOWEVENT_RESIZED		:= 5.
    SDL_WINDOWEVENT_SIZE_CHANGED		:= 6.
    SDL_WINDOWEVENT_MINIMIZED		:= 7.
    SDL_WINDOWEVENT_MAXIMIZED		:= 8.
    SDL_WINDOWEVENT_RESTORED		:= 9.
    SDL_WINDOWEVENT_ENTER			:= 10.
    SDL_WINDOWEVENT_LEAVE			:= 11.
    SDL_WINDOWEVENT_FOCUS_GAINED		:= 12.
    SDL_WINDOWEVENT_FOCUS_LOST		:= 13.
    SDL_WINDOWEVENT_CLOSE			:= 14.! !

!SDL2Constants class methodsFor: 'class initialization' stamp: 'RonieSalgado 3/25/2014 14:55'!
initializeKeyboard
    KMOD_NONE := 16r0000.
    KMOD_LSHIFT := 16r0001.
    KMOD_RSHIFT := 16r0002.
    KMOD_LCTRL := 16r0040.
    KMOD_RCTRL := 16r0080.
    KMOD_LALT := 16r0100.
    KMOD_RALT := 16r0200.
    KMOD_LGUI := 16r0400.
    KMOD_RGUI := 16r0800.
    KMOD_NUM := 16r1000.
    KMOD_CAPS := 16r2000.
    KMOD_MODE := 16r4000.
    KMOD_RESERVED := 16r8000.

	KMOD_CTRL  :=  (KMOD_LCTRL | KMOD_RCTRL).
	KMOD_SHIFT :=  (KMOD_LSHIFT | KMOD_RSHIFT).
	KMOD_ALT    := (KMOD_LALT | KMOD_RALT).
	KMOD_GUI    := (KMOD_LGUI | KMOD_RGUI).! !

!SDL2EventHandler commentStamp: '<historical>'!
I am an interface (abstract) used for visiting the raw SDL2 events. 
!
!SDL2EventHandler methodsFor: 'visitor' stamp: 'RonieSalgado 3/25/2014 14:26'!
visitMouseButtonDownEvent: mouseMotionEvent! !

!SDL2EventHandler methodsFor: 'visitor' stamp: 'RonieSalgado 3/25/2014 15:52'!
visitKeyUpEvent: windowEvent! !

!SDL2EventHandler methodsFor: 'visitor' stamp: 'RonieSalgado 3/25/2014 14:26'!
visitMouseWheelEvent: mouseMotionEvent! !

!SDL2EventHandler methodsFor: 'visitor' stamp: 'RonieSalgado 3/25/2014 15:52'!
visitKeyDownEvent: windowEvent! !

!SDL2EventHandler methodsFor: 'visitor' stamp: 'RonieSalgado 3/25/2014 04:32'!
visitMouseMotionEvent: mouseMotionEvent! !

!SDL2EventHandler methodsFor: 'visitor' stamp: 'RonieSalgado 3/25/2014 03:10'!
visitWindowEvent: windowEvent! !

!SDL2EventHandler methodsFor: 'visitor' stamp: 'RonieSalgado 3/25/2014 15:52'!
visitTextInputEvent: windowEvent! !

!SDL2EventHandler methodsFor: 'visitor' stamp: 'RonieSalgado 3/25/2014 14:26'!
visitMouseButtonUpEvent: mouseMotionEvent! !

!SDL2EventHandler methodsFor: 'visitor' stamp: 'RonieSalgado 3/25/2014 03:10'!
visitCommonEvent: commonEvent! !

!SDL2Example commentStamp: 'IgorStasenko 7/30/2014 18:25'!
Couple examples..!
!SDL2Example methodsFor: 'examples' stamp: 'RonieSalgado 3/25/2014 01:40'!
simpleWindow
	"
	self new simpleWindow
	"
	| window |
	SDL2 initVideo.
	window := SDL2 createWindow: 'Test Window'
					x: SDL_WINDOWPOS_UNDEFINED
					y: SDL_WINDOWPOS_UNDEFINED
					width: 640
					height: 480
					flags: SDL_WINDOW_SHOWN.
	SDL2 delay: 3000.
	window destroy.! !

!SDL2Example methodsFor: 'examples' stamp: 'RonieSalgado 3/25/2014 01:39'!
simpleDrawWindow
	"
	self new simpleDrawWindow
	"
	| window renderer |
	SDL2 initVideo.
	window := SDL2 createWindow: 'Test Window'
					x: SDL_WINDOWPOS_UNDEFINED
					y: SDL_WINDOWPOS_UNDEFINED
					width: 640
					height: 480
					flags: SDL_WINDOW_SHOWN.
	renderer := window createDefaultRenderer.
	renderer drawColorR: 0 g: 0 b: 0 a: 0;
			  clear;
			  drawColorR: 0 g: 255 b: 0 a: 255;
			  drawPointX: 50 y: 50;
			  drawColorR: 255 g: 0 b: 0 a: 255;
			  drawLineX1: 30 y1: 30 x2: 500 y2: 30;
			  present.
	SDL2 delay: 3000.
	renderer destroy.
	window destroy.! !

!SDL2Example methodsFor: 'examples' stamp: 'RonieSalgado 3/25/2014 01:39'!
simpleBlackWindow
	"
	self new simpleBlackWindow
	"
	| window renderer |
	SDL2 initVideo.
	window := SDL2 createWindow: 'Test Window'
					x: SDL_WINDOWPOS_UNDEFINED
					y: SDL_WINDOWPOS_UNDEFINED
					width: 640
					height: 480
					flags: SDL_WINDOW_SHOWN.
	renderer := window createDefaultRenderer.
	renderer drawColorR: 0 g: 0 b: 0 a: 0;
			  clear;
			  present.
	SDL2 delay: 3000.
	renderer destroy.
	window destroy.! !

!SDL2Example methodsFor: 'examples' stamp: 'RonieSalgado 3/25/2014 04:43'!
osWindow
	"
	self new osWindow
	"
	| attrs window |
	attrs := OSWindowAttributes new.
	attrs preferableDriver: OSSDL2Driver new;
		extent: Display extent.
	window := OSWindow createWithAttributes: attrs.
	window eventHandler: (OSWindowMorphicEventHandler for: World).
	window newFormRenderer: Display.

! !

!SDL2Example methodsFor: 'examples' stamp: 'RonieSalgado 3/25/2014 01:39'!
simpleDrawDisplay
	"
	self new simpleDrawDisplay
	"
	| window renderer texture   |
	
	"Create the window and the renderer."
	SDL2 initVideo.
	window := SDL2 createWindow: 'Test Window'
					x: SDL_WINDOWPOS_UNDEFINED
					y: SDL_WINDOWPOS_UNDEFINED
					width: 1024
					height: 480
					flags: SDL_WINDOW_SHOWN.
	renderer := window createDefaultRenderer.
	
	"Create the texture"
	texture := renderer createTextureFormat: SDL_PIXELFORMAT_XRGB8888
						access: SDL_TEXTUREACCESS_STREAMING width: Display width height: Display height.
	texture updateTexturePixels: Display bits pitch: Display width*4.
	
	"Render"
	renderer copy: texture;
			  present.
	SDL2 delay: 3000.
	
	"Quit"
	texture destroy.
	renderer destroy.
	window destroy.! !

!SDL2Handle commentStamp: 'IgorStasenko 7/30/2014 18:26'!
My subclasses represent various handles coming from SDL2 library!
!SDL2Handle methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 3/24/2014 01:21'!
nbLibraryNameOrHandle
	^self class nbLibraryNameOrHandle! !

!SDL2Handle class methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 3/24/2014 01:22'!
nbLibraryNameOrHandle
	^ SDL2 nbLibraryNameOrHandle! !

!SDL2MappedEvent commentStamp: 'IgorStasenko 7/30/2014 18:43'!
SDL2 library structure!
!SDL2MappedEvent methodsFor: 'accessing' stamp: 'RonieSalgado 3/25/2014 04:00'!
windowID
	^ nil! !

!SDL2MappedEvent methodsFor: 'event type' stamp: 'RonieSalgado 3/25/2014 04:23'!
eventType
	^ nil! !

!SDL2MappedEvent class methodsFor: 'visitor' stamp: 'RonieSalgado 3/25/2014 03:07'!
accept: aVisitor
	self subclassResponsibility! !

!SDL2MappedEvent class methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 3/25/2014 03:38'!
fromSdlEvent: event
	| convertedEvent |
	convertedEvent := self new.
	NativeBoost memCopy: event to: convertedEvent address size: (self instanceSize).
	^ convertedEvent! !

!SDL2MappedEvent class methodsFor: 'event type' stamp: 'RonieSalgado 3/25/2014 04:35'!
eventType
	^ nil! !

!SDL2SpecialCharacterMapping commentStamp: 'RonieSalgado 3/25/2014 17:19'!
This class keeps a maps for key symbols that are represented by Morphic as special characters.!
!SDL2SpecialCharacterMapping class methodsFor: 'symbol mapping' stamp: 'RonieSalgado 3/25/2014 17:20'!
mapKeySymbol: keySym ifAbsent: aBlock
	^( Mapping at: keySym ifAbsent: [^ aBlock value ]) asCharacter ! !

!SDL2SpecialCharacterMapping class methodsFor: 'class initialization' stamp: 'RonieSalgado 3/25/2014 17:51'!
initialize
	"
	self initialize
	"
	Mapping := Dictionary new.
	{
	 SDLK_RETURN . Character cr.
	 SDLK_BACKSPACE . Character backspace.
	 SDLK_TAB . Character tab.
	 SDLK_HOME . Character home.
	 SDLK_LEFT . Character arrowLeft.
	 SDLK_UP . Character arrowUp.
	 SDLK_RIGHT . Character arrowRight.
	 SDLK_DOWN . Character arrowDown.
	 SDLK_END . Character end.
	 SDLK_INSERT . Character insert.
	 SDLK_PAGEUP . Character pageUp.
	 SDLK_PAGEDOWN . Character pageDown.
	 SDLK_DELETE. Character delete.
	} pairsDo: [ :key :val | Mapping at: key put: val ]! !

!SDL2Structure commentStamp: 'IgorStasenko 7/30/2014 18:30'!
Common things for all SDL2 structs!
!SDL2Structure methodsFor: 'native' stamp: 'RonieSalgado 3/23/2014 20:28'!
nbLibraryNameOrHandle
	^self class nbLibraryNameOrHandle! !

!SDL2Structure class methodsFor: 'native' stamp: 'RonieSalgado 3/23/2014 20:29'!
nbLibraryNameOrHandle
	^ SDL2 nbLibraryNameOrHandle! !

!SDL2Types commentStamp: 'IgorStasenko 7/30/2014 18:45'!
Various types used by SDL2!
!SDL2Types class methodsFor: 'class initialization' stamp: 'RonieSalgado 5/8/2014 22:50'!
initialize
	"
	self initialize
	"
	Uint8 := #uint8.
	Int8 := #int8.
	Sint8 := #int8.
	Uint16 := #uint16.
	Int16 := #int16.
	Sint16 := #int16.
	Uint32 := #uint32.
	Int32 := #int32.
	Sint32 := #int32.
	Uint64 := #uint64.
	Int64 := #int64.
	Sint64 := #int64.
	
	SDL_Keycode := Sint32.
	SDL_Keymod := Uint32.
	SDL_Scancode := Uint32.
	
	SDL_GLattr := #int.! !

!SDL_Color commentStamp: 'IgorStasenko 7/30/2014 18:44'!
SDL2 library structure!
!SDL_Color class methodsFor: 'fields descriptions' stamp: 'RonieSalgado 3/23/2014 20:36'!
fieldsDesc
	"
	self initializeAccessors
	"
	^#(
    Uint8 r;
    Uint8 g;
    Uint8 b;
    Uint8 a;
 	)! !

!SDL_CommonEvent commentStamp: 'IgorStasenko 7/30/2014 18:43'!
SDL2 library structure!
!SDL_CommonEvent methodsFor: 'visitor' stamp: 'RonieSalgado 3/25/2014 03:09'!
accept: aVisitor
	^ aVisitor visitCommonEvent: self! !

!SDL_CommonEvent class methodsFor: 'fields description' stamp: 'RonieSalgado 3/25/2014 03:09'!
fieldsDesc
	"
	self initializeAccessors
	"
	^ #(
    		Uint32 type;
    		Uint32 timestamp;
 	)! !

!SDL_Event commentStamp: 'IgorStasenko 7/30/2014 18:45'!
This is a raw SDL2 event!
!SDL_Event methodsFor: 'accessing' stamp: 'RonieSalgado 3/25/2014 03:36'!
mapped
	^ (EventTypeMap at: self type ifAbsent: [ ^ self unknownEvent ]) fromSdlEvent: self! !

!SDL_Event methodsFor: 'accessing' stamp: 'RonieSalgado 3/25/2014 03:37'!
type
	^self nbUInt32AtOffset: 0! !

!SDL_Event methodsFor: 'accessing' stamp: 'RonieSalgado 3/25/2014 03:37'!
unknownEvent
	^ SDL_CommonEvent fromSdlEvent: self! !

!SDL_Event class methodsFor: 'instance creation' stamp: 'RonieSalgado 3/25/2014 03:34'!
initialize
	"self initialize"

	SDL2Types initialize.  "make sure its initialized|"

	EventTypeMap := Dictionary new.
	SDL2MappedEvent  allSubclassesDo: [ :cls |
		| eventType |
		eventType := cls eventType.
		eventType ifNotNil: [ EventTypeMap at: eventType put: cls ].
	]
! !

!SDL_Event class methodsFor: 'instance creation' stamp: 'RonieSalgado 3/25/2014 03:00'!
new
	"union with 56 bytes"
	^ self basicNew: 56! !

!SDL_GLContext commentStamp: 'IgorStasenko 7/30/2014 18:26'!
I represent a handle of GL rendering context, coming from SDL2 library!
!SDL_GLContext methodsFor: 'deleting' stamp: 'RonieSalgado 5/8/2014 23:01'!
delete
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( void SDL_GL_DeleteContext ( self ) )! !

!SDL_KeyDownEvent commentStamp: 'IgorStasenko 7/30/2014 18:44'!
SDL2 library structure!
!SDL_KeyDownEvent methodsFor: 'visitor' stamp: 'RonieSalgado 3/25/2014 15:51'!
accept: aVisitor
	^ aVisitor visitKeyDownEvent: self! !

!SDL_KeyDownEvent class methodsFor: 'event type' stamp: 'RonieSalgado 3/25/2014 15:31'!
eventType
	^ SDL_KEYDOWN! !

!SDL_KeyUpEvent commentStamp: 'IgorStasenko 7/30/2014 18:44'!
SDL2 library structure!
!SDL_KeyUpEvent methodsFor: 'visitor' stamp: 'RonieSalgado 3/25/2014 15:52'!
accept: aVisitor
	^ aVisitor visitKeyUpEvent: self! !

!SDL_KeyUpEvent class methodsFor: 'event type' stamp: 'RonieSalgado 3/25/2014 15:31'!
eventType
	^ SDL_KEYUP! !

!SDL_KeyboardEvent commentStamp: 'IgorStasenko 7/30/2014 18:43'!
SDL2 library structure!
!SDL_KeyboardEvent class methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 3/25/2014 04:25'!
fieldsDesc
	"
	self initializeAccessors
	"
	^ #(
	Uint32 type;
	Uint32 timestamp;
	Uint32 windowID;
	Uint8 state;
	Uint8 repeat;
    	Uint8 padding2;
    	Uint8 padding3;
    	SDL_Keysym keysym;
 	)! !

!SDL_Keysym commentStamp: 'IgorStasenko 7/30/2014 18:44'!
SDL2 library structure!
!SDL_Keysym class methodsFor: 'fields description' stamp: 'RonieSalgado 3/25/2014 04:29'!
fieldsDesc
	"
	self initializeAccessors
	"
	^#(
    SDL_Scancode scancode;
    SDL_Keycode sym;
    Uint16 mod;
    Uint32 unused;
 	)! !

!SDL_MouseButtonDownEvent commentStamp: 'IgorStasenko 7/30/2014 18:44'!
SDL2 library structure!
!SDL_MouseButtonDownEvent methodsFor: 'visitor' stamp: 'RonieSalgado 3/25/2014 14:14'!
accept: aVisitor
	^ aVisitor visitMouseButtonDownEvent: self! !

!SDL_MouseButtonDownEvent class methodsFor: 'event type' stamp: 'RonieSalgado 3/25/2014 14:14'!
eventType
	^ SDL_MOUSEBUTTONDOWN! !

!SDL_MouseButtonEvent commentStamp: 'IgorStasenko 7/30/2014 18:44'!
SDL2 library structure!
!SDL_MouseButtonEvent class methodsFor: 'fields description' stamp: 'RonieSalgado 3/25/2014 14:13'!
fieldsDesc
	"
	self initializeAccessors
	"
	^ #(
    Uint32 type;
    Uint32 timestamp;
    Uint32 windowID;
    Uint32 which;
    Uint8 button;
    Uint8 state;
    Uint8 padding1;
    Uint8 padding2;
    Sint32 x;
    Sint32 y;
 	)! !

!SDL_MouseButtonUpEvent commentStamp: 'IgorStasenko 7/30/2014 18:44'!
SDL2 library structure!
!SDL_MouseButtonUpEvent methodsFor: 'visitor' stamp: 'RonieSalgado 3/25/2014 14:15'!
accept: aVisitor
	^ aVisitor visitMouseButtonUpEvent: self! !

!SDL_MouseButtonUpEvent class methodsFor: 'event type' stamp: 'RonieSalgado 3/25/2014 14:14'!
eventType
	^ SDL_MOUSEBUTTONUP! !

!SDL_MouseMotionEvent commentStamp: 'IgorStasenko 7/30/2014 18:44'!
SDL2 library structure!
!SDL_MouseMotionEvent methodsFor: 'visitor' stamp: 'RonieSalgado 3/25/2014 04:32'!
accept: aVisitor
	^ aVisitor visitMouseMotionEvent: self! !

!SDL_MouseMotionEvent class methodsFor: 'fields description' stamp: 'RonieSalgado 3/25/2014 04:31'!
fieldsDesc
	"
	self initializeAccessors
	"
	^ #(
    Uint32 type;
    Uint32 timestamp;
    Uint32 windowID; 
    Uint32 which;
    Uint32 state;
    Sint32 x;
    Sint32 y;
    Sint32 xrel;
    Sint32 yrel;
 	)! !

!SDL_MouseMotionEvent class methodsFor: 'event type' stamp: 'RonieSalgado 3/25/2014 04:31'!
eventType
	^ SDL_MOUSEMOTION! !

!SDL_MouseWheelEvent commentStamp: 'IgorStasenko 7/30/2014 18:44'!
SDL2 library structure!
!SDL_MouseWheelEvent methodsFor: 'visitor' stamp: 'RonieSalgado 3/25/2014 14:17'!
accept: aVisitor
	^ aVisitor visitMouseWheelEvent: self! !

!SDL_MouseWheelEvent class methodsFor: 'fields description' stamp: 'RonieSalgado 3/25/2014 14:16'!
fieldsDesc
	"
	self initializeAccessors
	"
	^ #(
    Uint32 type;
    Uint32 timestamp;
    Uint32 windowID;
    Uint32 which;
    Sint32 x;
    Sint32 y;
 	)! !

!SDL_MouseWheelEvent class methodsFor: 'event type' stamp: 'RonieSalgado 3/25/2014 14:17'!
eventType
	^ SDL_MOUSEWHEEL! !

!SDL_Palette commentStamp: 'IgorStasenko 7/30/2014 18:44'!
SDL2 library structure!
!SDL_Palette class methodsFor: 'fields description' stamp: 'RonieSalgado 3/23/2014 20:36'!
fieldsDesc
	"
	self initializeAccessors
	"
	^#(
    int ncolors;
    SDL_Color* colors;
    Uint32 version;
    int refcount;
 	)! !

!SDL_PixelFormat commentStamp: 'IgorStasenko 7/30/2014 18:44'!
SDL2 library structure!
!SDL_PixelFormat class methodsFor: 'fields description' stamp: 'RonieSalgado 3/23/2014 20:35'!
fieldsDesc
	"
	self initializeAccessors
	"
	^#(
    Uint32 format;
    SDL_Palette* palette;
    Uint8 BitsPerPixel;
    Uint8 BytesPerPixel;
    Uint8 pad1;
    Uint32 Rmask;
    Uint32 Gmask;
    Uint32 Bmask;
    Uint32 Amask;
    Uint8 Rloss;
    Uint8 Gloss;
    Uint8 Bloss;
    Uint8 Aloss;
    Uint8 Rshift;
    Uint8 Gshift;
    Uint8 Bshift;
    Uint8 Ashift;
    int refcount;
    SDL_PixelFormat* next;
 	)! !

!SDL_Point commentStamp: 'IgorStasenko 7/30/2014 18:44'!
SDL2 library structure!
!SDL_Point class methodsFor: 'fields description' stamp: 'RonieSalgado 3/23/2014 22:04'!
fieldsDesc
	"
	self initializeAccessors
	"
	^#(
		int x;
		int y;
 	)! !

!SDL_QuitEvent commentStamp: 'IgorStasenko 7/30/2014 18:43'!
SDL2 library structure!
!SDL_QuitEvent methodsFor: 'visitor' stamp: 'RonieSalgado 3/25/2014 03:35'!
accept: aVisitor
	^ aVisitor visitQuitEvent: self! !

!SDL_QuitEvent class methodsFor: 'event type' stamp: 'RonieSalgado 3/25/2014 03:33'!
eventType
	^ SDL_QUIT! !

!SDL_Rect commentStamp: 'IgorStasenko 7/30/2014 18:44'!
SDL2 library structure!
!SDL_Rect class methodsFor: 'fields description' stamp: 'RonieSalgado 3/23/2014 21:51'!
fieldsDesc
	"
	self initializeAccessors
	"
	^#(
		int x;
		int y;
		int w;
		int h;
 	)! !

!SDL_Rect class methodsFor: 'fields description' stamp: 'RonieSalgado 3/24/2014 03:27'!
newX: x y: y w: w h: h
	^ self new x: x; y: y; w: w; h: h; yourself! !

!SDL_Renderer commentStamp: 'IgorStasenko 7/30/2014 18:27'!
I represent a handle of GL rendering context, coming from SDL2 library!
!SDL_Renderer methodsFor: 'rendering' stamp: 'RonieSalgado 3/24/2014 02:45'!
fillRect: rect
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( int SDL_RenderFillRect ( self , SDL_Rect* rect ) )! !

!SDL_Renderer methodsFor: 'rendering' stamp: 'RonieSalgado 3/24/2014 02:34'!
clear
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( int SDL_RenderClear ( self ) )! !

!SDL_Renderer methodsFor: 'rendering' stamp: 'RonieSalgado 3/24/2014 02:43'!
drawPointX: x y: y
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( int SDL_RenderDrawPoint ( self , int x , int y ) )! !

!SDL_Renderer methodsFor: 'rendering' stamp: 'RonieSalgado 5/10/2014 01:02'!
noClipRect
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( int SDL_RenderSetClipRect ( self , nil ) )! !

!SDL_Renderer methodsFor: 'initialize' stamp: 'RonieSalgado 3/24/2014 02:50'!
destroy
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( void SDL_DestroyRenderer ( self ) )! !

!SDL_Renderer methodsFor: 'rendering' stamp: 'RonieSalgado 5/9/2014 00:04'!
noRenderTarget
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( int SDL_SetRenderTarget ( self , nil ) )! !

!SDL_Renderer methodsFor: 'rendering' stamp: 'RonieSalgado 3/24/2014 02:35'!
present
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( void SDL_RenderPresent ( self ) )! !

!SDL_Renderer methodsFor: 'rendering' stamp: 'RonieSalgado 3/24/2014 03:35'!
copy: texture
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( int SDL_RenderCopy ( self , SDL_Texture texture , nil, nil ) )! !

!SDL_Renderer methodsFor: 'rendering' stamp: 'RonieSalgado 3/24/2014 02:45'!
drawRect: rect
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( int SDL_RenderDrawRect ( self , SDL_Rect* rect ) )! !

!SDL_Renderer methodsFor: 'rendering' stamp: 'RonieSalgado 3/24/2014 02:42'!
drawColorR: r g: g b: b a: a
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( int SDL_SetRenderDrawColor ( self , Uint8 r , Uint8 g , Uint8 b , Uint8 a ) )! !

!SDL_Renderer methodsFor: 'rendering' stamp: 'RonieSalgado 3/24/2014 02:44'!
drawLineX1: x1 y1: y1 x2: x2 y2: y2
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( int SDL_RenderDrawLine ( self , int x1 , int y1 , int x2 , int y2 ) )! !

!SDL_Renderer methodsFor: 'rendering' stamp: 'RonieSalgado 3/24/2014 02:53'!
createTextureFormat: format access: access width: width height: height
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( SDL_Texture SDL_CreateTexture ( self , Uint32 format , int access , int width , int height ) )! !

!SDL_Renderer methodsFor: 'rendering' stamp: 'RonieSalgado 3/24/2014 03:35'!
copy: texture srcRect: srcRect dstRect: dstRect
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( int SDL_RenderCopy ( self , SDL_Texture texture , SDL_Rect* srcRect , SDL_Rect* dstRect ) )! !

!SDL_Surface commentStamp: 'IgorStasenko 7/30/2014 18:44'!
SDL2 library structure!
!SDL_Surface class methodsFor: 'fields description' stamp: 'RonieSalgado 3/23/2014 21:54'!
fieldsDesc
	"
	self initializeAccessors
	"
	^#(
		Uint32 flags;
		SDL_PixelFormat* format;
    		int w;
		int h;
    		int pitch;
    		void* pixels;
		void* userdata;
		int locked;
		void* lock_data;
		SDL_Rect clip_rect;
    		void *map;
    		int refcount;
 	)! !

!SDL_TextInputEvent commentStamp: 'IgorStasenko 7/30/2014 18:44'!
SDL2 library structure!
!SDL_TextInputEvent methodsFor: 'visitor' stamp: 'RonieSalgado 3/25/2014 16:00'!
accept: aVisitor
	^ aVisitor visitTextInputEvent: self! !

!SDL_TextInputEvent methodsFor: 'accesing' stamp: 'RonieSalgado 3/25/2014 16:17'!
text
	| len text |
	len := self strlen.
	text := ByteArray new: len.
	(1 to: len) do: [ :i |
		text at: i put: (self address nbUInt8AtOffset: 12 + i - 1)
	].
	^ text! !

!SDL_TextInputEvent methodsFor: 'accesing' stamp: 'RonieSalgado 3/25/2014 16:13'!
strlen
	| len |
	len := 0.
	(12 to: 12 + 32 - 1) do: [ :i |
		(self address nbUInt8AtOffset: i) = 0 ifTrue: [ ^ len ].
		len := len + 1.
	].
	^ len! !

!SDL_TextInputEvent class methodsFor: 'fields description' stamp: 'RonieSalgado 3/25/2014 15:50'!
fieldsDesc
	"
	self initializeAccessors
	"
	^ #(
    Uint32 type;
    Uint32 timestamp;
    Uint32 windowID;

	"HACK: for char text[32];"
      char text0;
	char text1;
	char text2;
	char text3;
	char text4;
	char text5;
	char text6;
	char text7;
	char text8;
	char text9;
	char text10;
	char text11;
	char text12;
	char text13;
	char text14;
	char text15;
	char text16;
	char text17;
	char text18;
	char text19;
	char text20;
	char text21;
	char text22;
	char text23;
	char text24;
	char text25;
	char text26;
	char text27;
	char text28;
	char text29;
	char text30;
	char text31;
 	)! !

!SDL_TextInputEvent class methodsFor: 'event type' stamp: 'RonieSalgado 3/25/2014 15:41'!
eventType
	^ SDL_TEXTINPUT! !

!SDL_Texture commentStamp: 'IgorStasenko 7/30/2014 18:27'!
I represent a handle of GL texture, coming from SDL2 library!
!SDL_Texture methodsFor: 'initialize' stamp: 'RonieSalgado 3/24/2014 02:51'!
destroy
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( void SDL_DestroyTexture ( self ) )! !

!SDL_Texture methodsFor: 'initialize' stamp: 'RonieSalgado 3/24/2014 03:24'!
updateTextureRect: rect pixels: pixels pitch: pitch
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( int SDL_UpdateTexture ( self , SDL_Rect* rect , void* pixels , int pitch ) )! !

!SDL_Texture methodsFor: 'initialize' stamp: 'RonieSalgado 3/24/2014 03:37'!
updateTexturePixels: pixels pitch: pitch
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( int SDL_UpdateTexture ( self , nil , void* pixels , int pitch ) )! !

!SDL_Window commentStamp: 'IgorStasenko 7/30/2014 18:27'!
I represent a handle of SDL2 window, coming from SDL2 library!
!SDL_Window methodsFor: 'accessing' stamp: 'RonieSalgado 3/26/2014 15:36'!
icon: surface
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( void SDL_SetWindowIcon ( self , SDL_Surface* surface ) )! !

!SDL_Window methodsFor: 'accessing' stamp: 'RonieSalgado 3/26/2014 03:33'!
setPositionX: x y: y
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( void SDL_SetWindowPosition ( self , int x , int y ) )! !

!SDL_Window methodsFor: 'accessing' stamp: 'RonieSalgado 3/26/2014 03:33'!
getSizeW: w h: h
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( void SDL_GetWindowSize ( self , int* w , int* h ) )! !

!SDL_Window methodsFor: 'accessing' stamp: 'RonieSalgado 3/26/2014 15:06'!
fullscreen: flags
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( int SDL_SetWindowFullscreen ( self , Uint32 flags ) )! !

!SDL_Window methodsFor: 'initialize' stamp: 'RonieSalgado 3/24/2014 01:15'!
destroy
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( void SDL_DestroyWindow ( self ) )! !

!SDL_Window methodsFor: 'rendering' stamp: 'RonieSalgado 3/24/2014 02:40'!
createRenderer: driverIndex flags: flags
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( SDL_Renderer SDL_CreateRenderer ( self , int driverIndex , Uint32 flags ) )! !

!SDL_Window methodsFor: 'accessing' stamp: 'RonieSalgado 3/26/2014 03:33'!
setSizeW: w h: h
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( void SDL_SetWindowSize ( self , int w , int h ) )! !

!SDL_Window methodsFor: 'accessing' stamp: 'RonieSalgado 3/26/2014 03:32'!
title
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( char* SDL_GetWindowTitle ( self ) )! !

!SDL_Window methodsFor: 'accessing' stamp: 'RonieSalgado 3/26/2014 03:32'!
title: title
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( void SDL_SetWindowTitle ( self , String title ) )! !

!SDL_Window methodsFor: 'accessing' stamp: 'RonieSalgado 3/25/2014 03:53'!
windowID
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( Uint32 SDL_GetWindowID ( self ) )! !

!SDL_Window methodsFor: 'rendering' stamp: 'RonieSalgado 5/8/2014 23:42'!
createDefaultRenderer
	^ self createRenderer: -1 flags: 0! !

!SDL_Window methodsFor: 'accessing' stamp: 'RonieSalgado 3/26/2014 03:30'!
getPositionX: x y: y
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode>
	^ self nbCall: #( void SDL_GetWindowPosition ( self , int* x , int* y ) )! !

!SDL_WindowEvent commentStamp: 'IgorStasenko 7/30/2014 18:44'!
SDL2 library structure!
!SDL_WindowEvent methodsFor: 'visitor' stamp: 'RonieSalgado 3/25/2014 03:07'!
accept: aVisitor
	^ aVisitor visitWindowEvent: self! !

!SDL_WindowEvent class methodsFor: 'fields description' stamp: 'RonieSalgado 3/25/2014 03:02'!
fieldsDesc
	"
	self initializeAccessors
	"
	^ #(
    Uint32 type;
    Uint32 timestamp;
    Uint32 windowID;
    Uint8 event;
    Uint8 padding1;
    Uint8 padding2;
    Uint8 padding3;
    Sint32 data1;
    Sint32 data2;
 	)! !

!SDL_WindowEvent class methodsFor: 'event type' stamp: 'RonieSalgado 3/25/2014 03:26'!
eventType
	^ SDL_WINDOWEVENT! !

!SHA1 commentStamp: '<historical>'!
This class implements the Secure Hash Algorithm (SHA) described in the U.S. government's Secure Hash Standard (SHS). This standard is described in FIPS PUB 180-1, "SECURE HASH STANDARD", April 17, 1995.

The Secure Hash Algorithm is also described on p. 442 of 'Applied Cryptography: Protocols, Algorithms, and Source Code in C' by Bruce Scheier, Wiley, 1996.

See the comment in class DigitalSignatureAlgorithm for details on its use.

Implementation notes:
The secure hash standard was created with 32-bit hardware in mind. All arithmetic in the hash computation must be done modulo 2^32. This implementation uses ThirtyTwoBitRegister objects to simulate hardware registers; this implementation is about six times faster than using LargePositiveIntegers (measured on a Macintosh G3 Powerbook). Implementing a primitive to process each 64-byte buffer would probably speed up the computation by a factor of 20 or more.
!
!SHA1 methodsFor: 'private' stamp: 'StephaneDucasse 10/17/2009 17:15'!
processFinalBuffer: buffer bitLength: bitLength 
	"Process given buffer, whose length may be <= 64 bytes, accumulating the results in totalA through totalE. Also process the final padding bits and length."
	| out |
	out := ByteArray new: 64.
	out 
		replaceFrom: 1
		to: buffer size
		with: buffer
		startingAt: 1.
	buffer size < 56 ifTrue: 
		[ "padding and length fit in last data block"
		out 
			at: buffer size + 1
			put: 128.	"trailing one bit"
		self 
			storeLength: bitLength
			in: out.	"end with length"
		self processBuffer: out.
		^ self ].

	"process the final data block"
	buffer size < 64 ifTrue: 
		[ out 
			at: buffer size + 1
			put: 128 ].	"trailing one bit"
	self processBuffer: out.

	"process one additional block of padding ending with the length"
	out := ByteArray new: 64.	"filled with zeros"
	buffer size = 64 ifTrue: 
		[ "add trailing one bit that didn't fit in final data block"
		out 
			at: 1
			put: 128 ].
	self 
		storeLength: bitLength
		in: out.
	self processBuffer: out! !

!SHA1 methodsFor: 'private' stamp: 'StephaneDucasse 10/17/2009 17:15'!
storeLength: bitLength in: aByteArray 
	"Fill in the final 8 bytes of the given ByteArray with a 64-bit big-endian representation of the original message length in bits."
	| n i |
	n := bitLength.
	i := aByteArray size.
	[ n > 0 ] whileTrue: 
		[ aByteArray 
			at: i
			put: (n bitAnd: 255).
		n := n bitShift: -8.
		i := i - 1 ]! !

!SHA1 methodsFor: 'private' stamp: 'StephaneDucasse 10/17/2009 17:15'!
initializeTotals
	"Initialize totalA through totalE to their seed values."
	"total registers for use when primitives are absent"
	totalA := ThirtyTwoBitRegister new load: 1732584193.
	totalB := ThirtyTwoBitRegister new load: 4023233417.
	totalC := ThirtyTwoBitRegister new load: 2562383102.
	totalD := ThirtyTwoBitRegister new load: 271733878.
	totalE := ThirtyTwoBitRegister new load: 3285377520.
	self initializeTotalsArray! !

!SHA1 methodsFor: 'accessing' stamp: 'StephaneDucasse 10/17/2009 17:15'!
hashInteger: aPositiveInteger seed: seedInteger 
	"Hash the given positive integer. The integer to be hashed should have 512 or fewer bits. This entry point is used in the production of random numbers"
	"Initialize totalA through totalE to their seed values."
	| buffer dstIndex |
	totalA := ThirtyTwoBitRegister new load: ((seedInteger bitShift: -128) bitAnd: 4294967295).
	totalB := ThirtyTwoBitRegister new load: ((seedInteger bitShift: -96) bitAnd: 4294967295).
	totalC := ThirtyTwoBitRegister new load: ((seedInteger bitShift: -64) bitAnd: 4294967295).
	totalD := ThirtyTwoBitRegister new load: ((seedInteger bitShift: -32) bitAnd: 4294967295).
	totalE := ThirtyTwoBitRegister new load: (seedInteger bitAnd: 4294967295).
	self initializeTotalsArray.

	"pad integer with zeros"
	buffer := ByteArray new: 64.
	dstIndex := 0.
	aPositiveInteger digitLength 
		to: 1
		by: -1
		do: 
			[ :i | 
			buffer 
				at: (dstIndex := dstIndex + 1)
				put: (aPositiveInteger digitAt: i) ].

	"process that one block"
	self processBuffer: buffer.
	^ self finalHash! !

!SHA1 methodsFor: 'private' stamp: 'jm 12/7/1999 23:25'!
constantForStep: i
	"Answer the constant for the i-th step of the block hash loop. We number our steps 1-80, versus the 0-79 of the standard."

	i <= 20 ifTrue: [^ K1].
	i <= 40 ifTrue: [^ K2].
	i <= 60 ifTrue: [^ K3].
	^ K4
! !

!SHA1 methodsFor: 'private' stamp: 'StephaneDucasse 10/17/2009 17:15'!
finalHash
	"Concatenate the final totals to build the 160-bit integer result."
	"Details: If the primitives are supported, the results are in the totals array. Otherwise, they are in the instance variables totalA through totalE."
	| r |
	totals ifNil: 
		[ "compute final hash when not using primitives"
		^ (totalA asInteger bitShift: 128) + (totalB asInteger bitShift: 96) + (totalC asInteger bitShift: 64) + (totalD asInteger bitShift: 32) + totalE asInteger ].

	"compute final hash when using primitives"
	r := 0.
	1 
		to: 5
		do: [ :i | r := r bitOr: ((totals at: i) bitShift: 32 * (5 - i)) ].
	^ r! !

!SHA1 methodsFor: 'primitives' stamp: 'jm 12/21/1999 22:58'!
primHasSecureHashPrimitive
	"Answer true if this platform has primitive support for the Secure Hash Algorithm."

	<primitive: 'primitiveHasSecureHashPrimitive' module: 'DSAPrims'>
	^ false
! !

!SHA1 methodsFor: 'primitives' stamp: 'jm 12/21/1999 20:13'!
primHashBlock: blockBitmap using: workingTotalsBitmap
	"Hash the given block (a Bitmap) of 80 32-bit words, using the given workingTotals."

	<primitive: 'primitiveHashBlock' module: 'DSAPrims'>
	^ self primitiveFailed
! !

!SHA1 methodsFor: 'accessing' stamp: 'StephaneDucasse 10/17/2009 17:15'!
hashInteger: aPositiveInteger 
	"Hash the given positive integer. The integer to be hashed should have 512 or fewer bits. This entry point is used in key generation."
	| buffer dstIndex |
	self initializeTotals.

	"pad integer with zeros"
	aPositiveInteger highBit <= 512 ifFalse: [ self error: 'integer cannot exceed 512 bits' ].
	buffer := ByteArray new: 64.
	dstIndex := 0.
	aPositiveInteger digitLength 
		to: 1
		by: -1
		do: 
			[ :i | 
			buffer 
				at: (dstIndex := dstIndex + 1)
				put: (aPositiveInteger digitAt: i) ].

	"process that one block"
	self processBuffer: buffer.
	^ self finalHash! !

!SHA1 methodsFor: 'private' stamp: 'StephaneDucasse 10/17/2009 17:15'!
initializeTotalsArray
	"Initialize the totals array from the registers for use with the primitives."
	totals := Bitmap new: 5.
	totals 
		at: 1
		put: totalA asInteger.
	totals 
		at: 2
		put: totalB asInteger.
	totals 
		at: 3
		put: totalC asInteger.
	totals 
		at: 4
		put: totalD asInteger.
	totals 
		at: 5
		put: totalE asInteger! !

!SHA1 methodsFor: 'private' stamp: 'StephaneDucasse 10/17/2009 17:15'!
expandedBlock: aByteArray 
	"Convert the given 64 byte buffer into 80 32-bit registers and answer the result."
	| out src v |
	out := Array new: 80.
	src := 1.
	1 
		to: 16
		do: 
			[ :i | 
			out 
				at: i
				put: (ThirtyTwoBitRegister new 
						loadFrom: aByteArray
						at: src).
			src := src + 4 ].
	17 
		to: 80
		do: 
			[ :i | 
			v := (out at: i - 3) copy.
			v
				bitXor: (out at: i - 8);
				bitXor: (out at: i - 14);
				bitXor: (out at: i - 16);
				leftRotateBy: 1.
			out 
				at: i
				put: v ].
	^ out! !

!SHA1 methodsFor: 'public' stamp: 'SvenVanCaekenberghe 9/23/2013 17:05'!
hashStream: aPositionableStream
	"Hash the contents of the given stream from the current position to the end using the Secure Hash Algorithm. The SHA algorithm is defined in FIPS PUB 180-1. It is also described on p. 442 of 'Applied Cryptography: Protocols, Algorithms, and Source Code in C' by Bruce Scheier, Wiley, 1996."
	"http://en.wikipedia.org/wiki/Sha1#Example_hashes" 
	"(SHA1 new hashStream: 'The quick brown fox jumps over the lazy dog' readStream) hex."
	
	| startPosition buf bitLength |
	self initializeTotals.
  	
	aPositionableStream atEnd ifTrue: [self processFinalBuffer: #() bitLength: 0].

	startPosition := aPositionableStream position.
	[aPositionableStream atEnd] whileFalse: 
		[ buf := aPositionableStream next: 64.
		(aPositionableStream atEnd not and: [buf size = 64])
			ifTrue: [self processBuffer: buf]
			ifFalse: [ bitLength := (aPositionableStream position - startPosition) * 8.
					self processFinalBuffer: buf bitLength: bitLength]].
	^ self finalHash asByteArrayOfSize: 20! !

!SHA1 methodsFor: 'primitives' stamp: 'jm 12/21/1999 20:11'!
primExpandBlock: aByteArray into: wordBitmap
	"Expand the given 64-byte buffer into the given Bitmap of length 80."

	<primitive: 'primitiveExpandBlock' module: 'DSAPrims'>
	^ self primitiveFailed
! !

!SHA1 methodsFor: 'private' stamp: 'StephaneDucasse 10/17/2009 17:15'!
processBuffer: aByteArray 
	"Process given 64-byte buffer, accumulating the results in totalA through totalE."
	| a b c d e w tmp |
	self primHasSecureHashPrimitive 
		ifTrue: [ ^ self processBufferUsingPrimitives: aByteArray ]
		ifFalse: [ totals := nil ].

	"initialize registers a through e from the current totals"
	a := totalA copy.
	b := totalB copy.
	c := totalC copy.
	d := totalD copy.
	e := totalE copy.

	"expand and process the buffer"
	w := self expandedBlock: aByteArray.
	1 
		to: 80
		do: 
			[ :i | 
			tmp := (a copy leftRotateBy: 5)
				+= (self 
						hashFunction: i
						of: b
						with: c
						with: d);
				+= e;
				+= (w at: i);
				+= (self constantForStep: i).
			e := d.
			d := c.
			c := b copy leftRotateBy: 30.
			b := a.
			a := tmp ].

	"add a through e into total accumulators"
	totalA += a.
	totalB += b.
	totalC += c.
	totalD += d.
	totalE += e! !

!SHA1 methodsFor: 'private' stamp: 'StephaneDucasse 10/17/2009 17:15'!
processBufferUsingPrimitives: aByteArray 
	"Process given 64-byte buffer using the primitives, accumulating the results in totals."
	"expand and process the buffer"
	| w |
	w := Bitmap new: 80.
	self 
		primExpandBlock: aByteArray
		into: w.
	self 
		primHashBlock: w
		using: totals! !

!SHA1 methodsFor: 'private' stamp: 'jm 12/7/1999 22:15'!
hashFunction: i of: x with: y with: z
	"Compute the hash function for the i-th step of the block hash loop. We number our steps 1-80, versus the 0-79 of the standard."
	"Details: There are four functions, one for each 20 iterations. The second and fourth are the same."

	i <= 20 ifTrue: [^ x copy bitAnd: y; bitOr: (x copy bitInvert; bitAnd: z)].
	i <= 40 ifTrue: [^ x copy bitXor: y; bitXor: z].
	i <= 60 ifTrue: [^ x copy bitAnd: y; bitOr: (x copy bitAnd: z); bitOr: (y copy bitAnd: z)].
	^ x copy bitXor: y; bitXor: z
! !

!SHA1 class methodsFor: 'accessing' stamp: 'len 8/15/2002 01:45'!
hashSize
	^ 20! !

!SHA1 class methodsFor: 'class initialization' stamp: 'StephaneDucasse 10/17/2009 17:15'!
initialize
	"SecureHashAlgorithm initialize"
	"For the curious, here's where these constants come from:
	  #(2 3 5 10) collect: [:x | ((x sqrt / 4.0) * (2.0 raisedTo: 32)) truncated hex]"
	K1 := ThirtyTwoBitRegister new load: 1518500249.
	K2 := ThirtyTwoBitRegister new load: 1859775393.
	K3 := ThirtyTwoBitRegister new load: 2400959708.
	K4 := ThirtyTwoBitRegister new load: 3395469782! !

!SHA1 class methodsFor: 'accessing' stamp: 'rww 9/22/2006 19:25'!
blockSize
	^ 64! !

!SHA1Ecryptor commentStamp: '<historical>'!
A SHA1Ecryptor is an encryptor using SHA1 algorithm!
!SHA1Ecryptor methodsFor: 'protocol' stamp: 'MaxLeske 7/28/2013 17:27'!
encrypt: aString

	^ SHA1 new hashMessage: aString! !

!SHA1Test commentStamp: '<historical>'!
This is the unit test for the class SecureHashAlgorithm. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see: 
	- http://www.c2.com/cgi/wiki?UnitTest
	- there is a chapter in the PharoByExample book (http://pharobyexample.org)
	- the sunit class category!
!SHA1Test methodsFor: 'testing - examples' stamp: 'SvenVanCaekenberghe 9/23/2013 17:09'!
testExample3
	"This is the third example from the specification document (FIPS PUB 180-1). 
	This example may take several minutes."

	hash := SHA1 new hashMessage: (String new: 1000000 withAll: $a).
	self assert: hash asInteger equals: 16r34AA973CD4C4DAA4F61EEB2BDBAD27316534016F.! !

!SHA1Test methodsFor: 'testing - examples' stamp: 'SvenVanCaekenberghe 9/23/2013 17:08'!
testExample2
	"This is the second example from the specification document (FIPS PUB 180-1)"

	hash := SHA1 new hashMessage: 'abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq'.
	self assert: hash equals: (ByteArray readHexFrom: '84983E441C3BD26EBAAE4AA1F95129E5E54670F1')! !

!SHA1Test methodsFor: 'testing - examples' stamp: 'SvenVanCaekenberghe 9/23/2013 17:08'!
testExample1
	"This is the first example from the specification document (FIPS PUB 180-1)"

	hash := SHA1 new hashMessage: 'abc'.
	self assert: hash equals: (ByteArray readHexFrom:  'A9993E364706816ABA3E25717850C26C9CD0D89D').
		! !

!SHA1Test methodsFor: 'testing - examples' stamp: 'SvenVanCaekenberghe 9/23/2013 17:07'!
testEmptyInput
	"self run: #testEmptyInput"

	self assert: ((SHA1 new hashMessage: '') asInteger radix: 16) equals: 'DA39A3EE5E6B4B0D3255BFEF95601890AFD80709'! !

!SHA256 commentStamp: 'SvenVanCaekenberghe 6/26/2014 08:58'!
I am SHA256, a HashFunction.

I implement the SHA-2 cryptographic hash function with digest size 256.

See also

http://en.wikipedia.org/wiki/Sha256

http://csrc.nist.gov/publications/fips/fips180-2/fips180-2withchangenotice.pdf

Usage

SHA256 hashMessage: 'foo'.

From the older class comments:

Copied from CFSHA256 (Cloudfront)

Please direct questions or comments about this implementation to Ron Teitelbaum: Ron@USMedRec.com

This code was extensively coppied from SHA1 by Luciano Notarfrancesco lnotarfrancesco@yahoo.com!
!SHA256 methodsFor: 'private' stamp: 'RJT 10/14/2005 19:36'!
storeLength: bitLength in: aByteArray
	"Fill in the final 8 bytes of the given ByteArray with a 64-bit big-endian representation of the original message length in bits."

	| n i |
	n := bitLength.
	i := aByteArray size.
	[n > 0] whileTrue: [
		aByteArray at: i put: (n bitAnd: 16rFF).
		n := n bitShift: -8.
		i := i - 1].
! !

!SHA256 methodsFor: 'private' stamp: 'RJT 10/14/2005 19:33'!
processFinalBuffer: buffer bitLength: bitLength
	"Process given buffer, whose length may be <= 64 bytes, accumulating the results in totalA through totalE. Also process the final padding bits and length."

	| out |
	out := ByteArray new: 64.
	out replaceFrom: 1 to: buffer size with: buffer startingAt: 1.
	buffer size < 56 ifTrue: [  "padding and length fit in last data block"
		out at: buffer size + 1 put: 128.  "trailing one bit"
		self storeLength: bitLength in: out.  "end with length"
		self processBuffer: out.
		^ self].

	"process the final data block"
	buffer size < 64 ifTrue: [
		out at: buffer size + 1 put: 128].  "trailing one bit"
	self processBuffer: out.

	"process one additional block of padding ending with the length"
	out := ByteArray new: 64.  "filled with zeros"
	buffer size = 64 ifTrue: [
		"add trailing one bit that didn't fit in final data block"
		out at: 1 put: 128].
	self storeLength: bitLength in: out.
	self processBuffer: out.
! !

!SHA256 methodsFor: 'private' stamp: 'RJT 10/14/2005 19:48'!
initializeTotalsArray
	"Initialize the totals array from the registers for use with the primitives."

	totals := Bitmap new: 8.
	totals at: 1 put: totalA asInteger.
	totals at: 2 put: totalB asInteger.
	totals at: 3 put: totalC asInteger.
	totals at: 4 put: totalD asInteger.
	totals at: 5 put: totalE asInteger.
	totals at: 6 put: totalF asInteger.
	totals at: 7 put: totalG asInteger.
	totals at: 8 put: totalH asInteger.! !

!SHA256 methodsFor: 'private' stamp: 'RJT 10/14/2005 23:18'!
initializeTotals
	"Initialize totalA through totalE to their seed values."

	"total registers for use when primitives are absent"
	totalA := ThirtyTwoBitRegister new load: self class h0.
	totalB := ThirtyTwoBitRegister new load: self class h1.
	totalC := ThirtyTwoBitRegister new load: self class h2.
	totalD := ThirtyTwoBitRegister new load: self class h3.
	totalE := ThirtyTwoBitRegister new load: self class h4.
	totalF := ThirtyTwoBitRegister new load: self class h5.
	totalG := ThirtyTwoBitRegister new load: self class h6.
	totalH := ThirtyTwoBitRegister new load: self class h7.
	self initializeTotalsArray.
! !

!SHA256 methodsFor: 'private' stamp: 'RJT 10/15/2005 13:56'!
processBuffer: aByteArray
	"Process given 64-byte buffer, accumulating the results in totalA through totalE."

	| a b c d e f g h w |
	totals := nil.

	"initialize registers a through e from the current totals" 
	a := totalA copy.
	b := totalB copy.
	c := totalC copy.
	d := totalD copy.
	e := totalE copy.
	f := totalF copy.
	g := totalG copy.
	h := totalH copy.

	"expand and process the buffer"
	w := self expandedBlock: aByteArray.
	1 to: 64 do: [:i | | s0 maj t0 s1 ch t1 |
		s0 := (a copy leftRotateBy: -2).
		s0 bitXor: (a copy leftRotateBy: -13);
			bitXor: (a copy leftRotateBy: -22).
		maj := (a copy bitAnd: b).
		maj bitOr: (b copy bitAnd: c);
			bitOr: (c copy bitAnd: a).
		t0 := s0 copy += maj.
		s1 := (e copy leftRotateBy: -6).
		s1 bitXor: (e copy leftRotateBy: -11);
			bitXor: (e copy leftRotateBy: -25).
		ch := (e copy bitAnd: f).
		ch bitOr: ((e copy bitInvert) bitAnd: g).
		t1 := h copy += s1 += ch += (ThirtyTwoBitRegister new load: (self class roundConstants at: i)) += (w at: i) copy.
		h := g.
		g := f.
		f := e.
		e := d copy += t1.
		d := c.
		c := b.
		b := a.
		a := t0 += t1.
	"Transcript cr; show: i asString, String tab, a asString, String tab, b asString, String tab, c asString, String tab, d asString, String tab, e asString, String tab, f asString, String tab, g asString, String tab, h asString, String tab."
	].

	"add a through e into total accumulators"
	totalA += a.
	totalB += b.
	totalC += c.
	totalD += d.
	totalE += e.
	totalF += f.
	totalG += g.
	totalH += h.
! !

!SHA256 methodsFor: 'private' stamp: 'jvds 1/8/2011 22:05'!
expandedBlock: aByteArray
	"Convert the given 64 byte buffer into 80 32-bit registers and answer the result." 
	| out src |
	out := Array new: 64.
	src := 1.
	1 to: 16 do: [:i |
		out at: i put: (ThirtyTwoBitRegister new loadFrom: aByteArray at: src).
		src := src + 4].

	17 to: 64 do: [:i | | s0 s1 wi15 wi2 wi |
		wi15 := (out at: i - 15) copy.
		wi2 := (out at: i-2) copy.
		s0 := wi15 copy.
		s0 leftRotateBy: -7;
			bitXor: (wi15 copy leftRotateBy: -18);
			bitXor: (wi15 copy bitShift: -3).
		s1 := wi2 copy.
		s1 leftRotateBy: -17;
			bitXor: (wi2 copy leftRotateBy: -19);
			bitXor: (wi2 copy bitShift: -10).
		wi := (out at: i-16) copy += s0 += (out at: i-7) copy += s1.
		out at: i put: wi].
	^ out
! !

!SHA256 methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/24/2014 23:52'!
hashStream: aPositionableStream
	"Hash the contents of the given stream from the current position to the end using the Secure Hash Algorithm. The SHA algorithm is defined in FIPS PUB 180-1. It is also described on p. 442 of 'Applied Cryptography: Protocols, Algorithms, and Source Code in C' by Bruce Scheier, Wiley, 1996."
	"SHA256 new hashStream: (ReadStream on: 'foo')"

	| startPosition buf bitLength |
	self initializeTotals.

	aPositionableStream atEnd ifTrue: [ self processFinalBuffer: #() bitLength: 0 ].

	startPosition := aPositionableStream position.
	[ aPositionableStream atEnd ] whileFalse: [
		buf := aPositionableStream next: 64.
		(aPositionableStream atEnd not and: [ buf size = 64 ])
			ifTrue: [ self processBuffer: buf ]
			ifFalse: [
				bitLength := (aPositionableStream position - startPosition) * 8.
				self processFinalBuffer: buf bitLength: bitLength ] ].

	^self finalHash asByteArrayOfSize: 32! !

!SHA256 methodsFor: 'accessing' stamp: 'RJT 10/14/2005 23:15'!
finalHash
	"Concatenate the final totals to build the 160-bit integer result."
	"Details: If the primitives are supported, the results are in the totals array. Otherwise, they are in the instance variables totalA through totalE."

		^ (totalA asInteger bitShift: 224) +
		  (totalB asInteger bitShift: 192) +
		  (totalC asInteger bitShift: 160) +	
		  (totalD asInteger bitShift: 128) +
		  (totalE asInteger bitShift:  96) +
		  (totalF asInteger bitShift:  64) +
		  (totalG asInteger bitShift:  32) +
		  (totalH asInteger).! !

!SHA256 class methodsFor: 'constants' stamp: 'RJT 10/14/2005 23:25'!
roundConstants
	"2 raisedTo: 32 times the cube root of the first 64 primes 2..311"
	"(Integer primesUpTo: 311) collect: [:x | ((x raisedTo: 1/3) * (2.0 raisedTo: 32)) truncated hex] \\ 32 bits" 
	^#(16r428A2F98 16r71374491 16rB5C0FBCF 16rE9B5DBA5 16r3956C25B 16r59F111F1 16r923F82A4 16rAB1C5ED5 16rD807AA98 16r12835B01 16r243185BE 16r550C7DC3 16r72BE5D74 16r80DEB1FE 16r9BDC06A7 16rC19BF174 16rE49B69C1 16rEFBE4786 16r0FC19DC6 16r240CA1CC 16r2DE92C6F 16r4A7484AA 16r5CB0A9DC 16r76F988DA 16r983E5152 16rA831C66D 16rB00327C8 16rBF597FC7 16rC6E00BF3 16rD5A79147 16r06CA6351 16r14292967 16r27B70A85 16r2E1B2138 16r4D2C6DFC 16r53380D13 16r650A7354 16r766A0ABB 16r81C2C92E 16r92722C85 16rA2BFE8A1 16rA81A664B 16rC24B8B70 16rC76C51A3 16rD192E819 16rD6990624 16rF40E3585 16r106AA070 16r19A4C116 16r1E376C08 16r2748774C 16r34B0BCB5 16r391C0CB3 16r4ED8AA4A 16r5B9CCA4F 16r682E6FF3 16r748F82EE 16r78A5636F 16r84C87814 16r8CC70208 16r90BEFFFA 16rA4506CEB 16rBEF9A3F7 16rC67178F2)
	! !

!SHA256 class methodsFor: 'constants' stamp: 'RJT 10/14/2005 23:21'!
h2
	"2 raisedTo: 32 times the square root of the first 8 primes 2..19"
	"#(2 3 5 7 11 13 17 19) collect: [:x | ((x sqrt) * (2.0 raisedTo: 32)) truncated hex] // 32 bits"
	^16r3C6EF372! !

!SHA256 class methodsFor: 'constants' stamp: 'RJT 10/14/2005 23:19'!
h0
	"2 raisedTo: 32 times the square root of the first 8 primes 2..19"
	"#(2 3 5 7 11 13 17 19) collect: [:x | ((x sqrt) * (2.0 raisedTo: 32)) truncated hex] // 32 bits"
	^16r6A09E667! !

!SHA256 class methodsFor: 'constants' stamp: 'RJT 10/14/2005 23:21'!
h6
	"2 raisedTo: 32 times the square root of the first 8 primes 2..19"
	"#(2 3 5 7 11 13 17 19) collect: [:x | ((x sqrt) * (2.0 raisedTo: 32)) truncated hex] // 32 bits"
	^16r1F83D9AB! !

!SHA256 class methodsFor: 'constants' stamp: 'RJT 10/14/2005 23:21'!
h7
	"2 raisedTo: 32 times the square root of the first 8 primes 2..19"
	"#(2 3 5 7 11 13 17 19) collect: [:x | ((x sqrt) * (2.0 raisedTo: 32)) truncated hex] // 32 bits"
	^16r5BE0CD19! !

!SHA256 class methodsFor: 'constants' stamp: 'RJT 10/14/2005 23:21'!
h5
	"2 raisedTo: 32 times the square root of the first 8 primes 2..19"
	"#(2 3 5 7 11 13 17 19) collect: [:x | ((x sqrt) * (2.0 raisedTo: 32)) truncated hex] // 32 bits"
	^16r9B05688C! !

!SHA256 class methodsFor: 'constants' stamp: 'RJT 10/14/2005 23:20'!
h1
	"2 raisedTo: 32 times the square root of the first 8 primes 2..19"
	"#(2 3 5 7 11 13 17 19) collect: [:x | ((x sqrt) * (2.0 raisedTo: 32)) truncated hex] // 32 bits"
	^16rBB67AE85! !

!SHA256 class methodsFor: 'constants' stamp: 'RJT 10/14/2005 23:21'!
h4
	"2 raisedTo: 32 times the square root of the first 8 primes 2..19"
	"#(2 3 5 7 11 13 17 19) collect: [:x | ((x sqrt) * (2.0 raisedTo: 32)) truncated hex] // 32 bits"
	^16r510E527F! !

!SHA256 class methodsFor: 'accessing' stamp: 'cmm 2/9/2006 23:49'!
blockSize
	^ 64! !

!SHA256 class methodsFor: 'constants' stamp: 'RJT 10/14/2005 23:21'!
h3
	"2 raisedTo: 32 times the square root of the first 8 primes 2..19"
	"#(2 3 5 7 11 13 17 19) collect: [:x | ((x sqrt) * (2.0 raisedTo: 32)) truncated hex] // 32 bits"
	^16rA54FF53A! !

!SHA256 class methodsFor: 'accessing' stamp: 'cmm 2/20/2006 23:20'!
hashSize
	^ 32! !

!SHA256Test commentStamp: 'SvenVanCaekenberghe 6/24/2014 23:54'!
SHA256Tests contains unit tests for SHA256.

Test vectors taken from

http://en.wikipedia.org/wiki/Sha256

http://csrc.nist.gov/publications/fips/fips180-2/fips180-2withchangenotice.pdf
!
!SHA256Test methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/24/2014 23:53'!
testFips180Example3
	"This test is a bit slow if the implementation is not making use of extra primitives"
	
	hash := SHA256 hashMessage: (String new: 1e6 withAll: $a).
	self assert: hash hex equals: 'cdc76e5c9914fb9281a1c7e284d73e67f1809a48a497200e046d39ccc7112cd0'! !

!SHA256Test methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/24/2014 23:39'!
testWikipediaExampleEmpty
	hash := SHA256 hashMessage: ''.
	self assert: hash hex equals: 'e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855'! !

!SHA256Test methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/24/2014 23:38'!
testWikipediaExample1
	hash := SHA256 hashMessage: 'The quick brown fox jumps over the lazy dog'.
	self assert: hash hex equals: 'd7a8fbb307d7809469ca9abcb0082e4f8d5651e46d3cdb762d02d0bf37c9e592'! !

!SHA256Test methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/24/2014 23:39'!
testWikipediaExample2
	hash := SHA256 hashMessage: 'The quick brown fox jumps over the lazy dog.'.
	self assert: hash hex equals: 'ef537f25c895bfa782526529a9b63d97aa631564d5d789c2b765448c8635fb6c'! !

!SHA256Test methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/24/2014 23:44'!
testFips180Example1
	hash := SHA256 hashMessage: 'abc'.
	self assert: hash hex equals: 'ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad'! !

!SHA256Test methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/24/2014 23:45'!
testFips180Example2
	hash := SHA256 hashMessage: 'abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq'.
	self assert: hash hex equals: '248d6a61d20638b8e5c026930c3e6039a33ce45964ff2167f6ecedd419db06c1'! !

!SHMethodEditingMode commentStamp: 'AlainPlantec 9/20/2011 21:15'!
This example shows how to use shout for method editing. Try it with:

SHMethodEditingMode new open

For method editing, you need to provide a class to the styler. When a class is given, the styler is automatically turned into a method editing mode.
The styler is then able to style the code according to the class bindings (instance variables names, shared pool...)
See #shoutAboutToStyle. 
  - First, the class is given to the styler by sending #classOrMetaClass: to the view with the class as argument.
  - Finally, in this example, #shoutAboutToStyle returns true because the code is always to be styled.

Instance Variables
	className:		<String>
	code:		<String>

className
	- The class name for the styler

code
	- the code which is entered into the editor  
!
!SHMethodEditingMode methodsFor: 'accessing' stamp: 'AlainPlantec 9/19/2011 21:26'!
code
	^ code ifNil: [code := '' asText]! !

!SHMethodEditingMode methodsFor: 'accessing' stamp: 'AlainPlantec 9/20/2011 07:55'!
selector
	^ selector! !

!SHMethodEditingMode methodsFor: 'view' stamp: 'MarcusDenker 8/9/2014 12:56'!
classSelector
	| applicantsBlock entryCompletion |
	applicantsBlock := [(Array
				streamContents: [:strm | Symbol
						allSymbolTablesDo: [:each | (each notEmpty
									and: [each first canBeGlobalVarInitial
											and: [Smalltalk globals includesKey: each]])
								ifTrue: [strm nextPut: each]]]) sort].
	entryCompletion := EntryCompletion new
				dataSourceBlock: [:currText | applicantsBlock value ];
				filterBlock: [:currApplicant :currText | currText notEmpty
						and: [currApplicant asUppercase includesSubstring: currText asString asUppercase]].
	^ (UIManager default newAutoAcceptTextEntryFor: self
			get: #className
			set: #className:
			class: String 
			getEnabled: nil
			help: 'Enter a class name' translated
			entryCompletion: entryCompletion)
				acceptOnCR: false;
				ghostText: 'Class name';
				withDropListButton;
				yourself.
! !

!SHMethodEditingMode methodsFor: 'accessing' stamp: 'AlainPlantec 9/20/2011 09:55'!
code: someText
	code := someText.
	self changed: #code! !

!SHMethodEditingMode methodsFor: 'accessing' stamp: 'AlainPlantec 9/20/2011 09:18'!
selectedClass
	self className ifNil: [ ^ nil ]. 
	^ Smalltalk globals at: self className ifAbsent: []! !

!SHMethodEditingMode methodsFor: 'view' stamp: 'MarcusDenker 8/9/2014 12:56'!
methodSelector
	| entryCompletion applicantsBlock |
	applicantsBlock := [self selectedClass 
						ifNil: [#()] 
						ifNotNil: [:clsn | self classToUse selectors asArray sort ]].
	entryCompletion := EntryCompletion new
				dataSourceBlock: [:currText | applicantsBlock value];
				filterBlock: [:currApplicant :currText | currText notEmpty
						and: [currApplicant asUppercase includesSubstring: currText asString asUppercase]].
	^ (UIManager default newAutoAcceptTextEntryFor: self
			get: #selector
			set: #selector:
			class: String 
			getEnabled: #haveClassName
			help: 'Enter a selector' translated
			entryCompletion: entryCompletion) 
				acceptOnCR: false;
				ghostText: 'Selector';
				withDropListButton;
				yourself.
! !

!SHMethodEditingMode methodsFor: 'accessing' stamp: 'AlainPlantec 9/20/2011 10:00'!
classIsMeta: aBoolean
	classIsMeta := aBoolean.
	self selector: nil.
	self changed: #selector.
	self changed: #classIsMeta.
	self code: ''.
! !

!SHMethodEditingMode methodsFor: 'accessing' stamp: 'AlainPlantec 9/19/2011 22:12'!
className
	^ className ifNotNil: [className asSymbol]! !

!SHMethodEditingMode methodsFor: 'accessing' stamp: 'AlainPlantec 9/20/2011 09:19'!
haveClassName
	^ self selectedClass notNil! !

!SHMethodEditingMode methodsFor: 'accessing' stamp: 'AlainPlantec 9/20/2011 10:00'!
selector: aSymbol
	selector := aSymbol ifNotNil: [:sel |( sel copyWithout: Character cr) asSymbol].
	self changed: #selector.
	self classToUse 
		ifNotNil: [:cls | (cls selectors includes: selector)
			ifTrue: [self code: (cls sourceCodeAt: selector)]]! !

!SHMethodEditingMode methodsFor: 'accessing' stamp: 'AlainPlantec 9/20/2011 10:00'!
className: aClassName
	className := aClassName copyWithout: Character cr.
	self selector: nil.
	self changed: #selector.
	self changed: #className.
	self selectedClass
		ifNotNil: [	self changed: #haveClassName]! !

!SHMethodEditingMode methodsFor: 'view' stamp: 'IgorStasenko 12/20/2012 14:09'!
open
	| window bar editor |
	window := (StandardWindow labelled: 'Method editor with shout') model: self.
	editor := window newTextEditorFor:  self getText:  #code setText: #code: getEnabled: nil. 
	window addMorph: (window newColumn: { window newRow: { self classSelector. self metaSwitch. self methodSelector}. editor} )
		fullFrame: LayoutFrame identity.
	^ window openInWorld! !

!SHMethodEditingMode methodsFor: 'view' stamp: 'AlainPlantec 9/20/2011 09:13'!
metaSwitch
	^ UIManager default
		newCheckboxFor: self
		getSelected: #classIsMeta
		setSelected: #classIsMeta:
		label: 'Class'
		help: 'Class side is used if checked' ! !

!SHMethodEditingMode methodsFor: 'accessing' stamp: 'AlainPlantec 9/20/2011 08:58'!
classIsMeta
	^ classIsMeta ifNil: [classIsMeta := false]! !

!SHMethodEditingMode methodsFor: 'accessing' stamp: 'AlainPlantec 9/20/2011 09:21'!
classToUse
	^ self selectedClass
		ifNotNil: [self classIsMeta 
				ifTrue: [self selectedClass class]
				ifFalse: [self selectedClass]]! !

!SHMethodEditingMode methodsFor: 'shout' stamp: 'MarcusDenker 8/9/2014 12:55'!
shoutAboutToStyle: aTextView
	aTextView classOrMetaClass: self classToUse.
	^ true! !

!SHOneEditorShoutedASecondNotShouted commentStamp: 'AlainPlantec 9/20/2011 17:23'!
In this example, the view has two text editors. 
Try it with:

SHOneEditorShoutedASecondNotShouted  new open.

The top view is supposed to be used for code editing and the other for comment editing.
Only the code editor view has to be highligthed whereas the comment editor is never highligthed. In this case, the model must implement a #shoutAboutToStyle: method which returns true. When the view is built, the comment pane is setup to forbid code styling by sending #styled: to it with false as argument. See the #open method and the #styled: sent.

Instance Variables:
	code	<Text>
	comment	<Text>!
!SHOneEditorShoutedASecondNotShouted methodsFor: 'accessing' stamp: 'AlainPlantec 9/1/2011 18:48'!
code
	^ code ifNil: [code := '' asText]! !

!SHOneEditorShoutedASecondNotShouted methodsFor: 'accessing' stamp: 'AlainPlantec 9/3/2011 18:35'!
comment: someText
	comment := someText.
	self changed: #comment! !

!SHOneEditorShoutedASecondNotShouted methodsFor: 'view' stamp: 'AlainPlantec 9/19/2011 22:40'!
open
	| window codeEditor commentEditor |
	window := (StandardWindow labelled: 'A styled editor and a not styled one for the same model') model: self.
	codeEditor := window newTextEditorFor:  self getText:  #code setText: #code: getEnabled: nil. 
	commentEditor := window newTextEditorFor:  self getText:  #comment setText: #comment: getEnabled: nil. 
	"now, comment must not be highlighted: just send #styled: to the editor with false as argument"
	commentEditor styled: false.
	window addMorph: codeEditor frame: (0@0 extent: 1@0.5).
	window addMorph: commentEditor frame: (0@0.5 extent: 1@1).
	^ window openInWorld! !

!SHOneEditorShoutedASecondNotShouted methodsFor: 'accessing' stamp: 'AlainPlantec 9/3/2011 18:35'!
code: someText
	code := someText.
	self changed: #code! !

!SHOneEditorShoutedASecondNotShouted methodsFor: 'shout' stamp: 'MarcusDenker 8/9/2014 12:55'!
shoutAboutToStyle: aTextView
	^ true! !

!SHOneEditorShoutedASecondNotShouted methodsFor: 'accessing' stamp: 'AlainPlantec 9/1/2011 18:49'!
comment
	^ comment ifNil: [comment := '' asText]! !

!SHParserST80 commentStamp: 'StephaneDucasse 11/29/2011 22:27'!
I am a Smalltalk method / expression parser supporting syntax highligthing. !
!SHParserST80 methodsFor: 'parse' stamp: ''!
parseExpression
	| assignType |
	self isName
		ifTrue: [self
				scanPast: (self resolve: currentToken).
			self isAssignment
				ifTrue: [assignType := self isAnsiAssignment
								ifTrue: [#ansiAssignment]
								ifFalse: [#assignment].
					self scanPast: assignType.
					self parseExpression]
				ifFalse: [self parseCascade]]
		ifFalse: [self parseTerm.
			self parseCascade]! !

!SHParserST80 methodsFor: 'identifier testing' stamp: ''!
resolve: aString 
	(#('self' 'super' 'true' 'false' 'nil' 'thisContext' ) includes: aString)
		ifTrue: [^ aString asSymbol].
	(self isBlockTempName: aString)
		ifTrue: [^ #blockTempVar].
	(self isBlockArgName: aString)
		ifTrue: [^ #blockArg].
	(self isMethodTempName: aString)
		ifTrue: [^ #tempVar].
	(self isMethodArgName: aString)
		ifTrue: [^ #methodArg].
	(instanceVariables includes: aString)
		ifTrue: [^ #instVar].
	workspace
		ifNotNil: [(workspace hasBindingOf: aString)
				ifTrue: [^ #workspaceVar]].
	Symbol
		hasInterned: aString
		ifTrue: [:sym | classOrMetaClass isBehavior
				ifTrue: [classOrMetaClass theNonMetaClass withAllSuperclasses
						do: [:c | 
							(c classPool bindingOf: sym)
								ifNotNil: [^ #classVar].
							c sharedPools
								do: [:p | (p bindingOf: sym)
										ifNotNil: [^ #poolConstant]].
							(c environment bindingOf: sym)
								ifNotNil: [^ #globalVar]]]
				ifFalse: [(environment bindingOf: sym)
						ifNotNil: [^ #globalVar]]].
	^ self resolvePartial: aString! !

!SHParserST80 methodsFor: 'identifier testing' stamp: ''!
isIncompleteMethodArgName: aString 
	^ (arguments
		at: 0
		ifAbsent: [#()])
		anySatisfy: [:each | each beginsWith: aString]! !

!SHParserST80 methodsFor: 'scan' stamp: ''!
skipDigits
	[self nextChar isDigit] whileTrue! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parseSymbolString
	| first c last |
	first := sourcePosition.
	self nextChar.
	[(c := self currentChar) isNil
		ifTrue: [self
				rangeType: #unfinishedString
				start: first
				end: source size.
			self error].
	c ~~ $'
		or: [self peekChar == $'
				and: [sourcePosition := sourcePosition + 1.
					true]]]
		whileTrue: [sourcePosition := sourcePosition + 1].
	last := sourcePosition.
	self nextChar.
	self
		scanPast: #stringSymbol
		start: first - 1
		end: last! !

!SHParserST80 methodsFor: 'token testing' stamp: ''!
isKeyword
	^ (currentTokenFirst isLetter
			or: [currentTokenFirst == $_])
		and: [currentToken last == $:]! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parseBinary
	| binary type |
	self parseUnary.
	[self isBinary]
		whileTrue: [binary := currentToken.
			type := #binary.
			(binary isEmpty
					or: [Symbol
							hasInterned: binary
							ifTrue: [:sym | nil]])
				ifFalse: [type := (Symbol thatStartsCaseSensitive: binary skipping: nil) isNil
								ifTrue: [#undefinedBinary]
								ifFalse: [#incompleteBinary]].
			self scanPast: type.
			self parseTerm.
			self parseUnary]! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parseLiteral: inArray 
	| pos c |
	currentTokenFirst == $$
		ifTrue: [self failWhen: self currentChar isNil.
			self rangeType: #'$'.
			pos := currentTokenSourcePosition + 1.
			self nextChar.
			^ self
				scanPast: #character
				start: pos
				end: pos].
	currentTokenFirst isDigit
		ifTrue: [^ self scanPast: #number].
	currentToken = '-'
		ifTrue: [c := self currentChar.
			(inArray
					and: [c isNil
							or: [c isDigit not]])
				ifTrue: [^ self scanPast: #symbol].
			self scanPast: #-.
			self failWhen: currentToken isNil.
			^ self scanPast: #number].
	currentTokenFirst == $'
		ifTrue: [^ self parseString].
	currentTokenFirst == $#
		ifTrue: [^ self parseSymbol].
	(inArray
			and: [currentToken notNil])
		ifTrue: [^ self scanPast: #symbol].
	self failWhen: currentTokenFirst == $..
	self error! !

!SHParserST80 methodsFor: 'parse support' stamp: ''!
initializeInstanceVariables
	instanceVariables := classOrMetaClass notNil
				ifTrue: [classOrMetaClass allInstVarNames asArray]
				ifFalse: [Set new]! !

!SHParserST80 methodsFor: 'token testing' stamp: ''!
isBinary
	| char |
	(currentToken isNil
			or: [self isName
					or: [self isKeyword]])
		ifTrue: [^ false].
	1
		to: currentToken size
		do: [:i | 
			char := currentToken at: i.
			(self isSelectorCharacter: char)
				ifFalse: [^ false]].
	^ true! !

!SHParserST80 methodsFor: 'identifier testing' stamp: ''!
isMethodTempName: aString 
	((arguments
			at: 0
			ifAbsent: [#()])
			includes: aString)
		ifTrue: [^ false].
	^ (temporaries
		at: 0
		ifAbsent: [#()])
		includes: aString! !

!SHParserST80 methodsFor: 'accessing' stamp: ''!
classOrMetaClass: aClass 
	classOrMetaClass := aClass! !

!SHParserST80 methodsFor: 'identifier testing' stamp: ''!
isIncompleteMethodTempName: aString 
	^ (temporaries
		at: 0
		ifAbsent: [#()])
		anySatisfy: [:each | each beginsWith: aString]! !

!SHParserST80 methodsFor: 'token testing' stamp: ''!
isName
	^ (currentTokenFirst isLetter
			or: [currentTokenFirst == $_])
		and: [currentToken last isAlphaNumeric
				or: [currentToken last == $_]]! !

!SHParserST80 methodsFor: 'identifier testing' stamp: ''!
isBlockTempName: aString 
	| temp arg |
	blockDepth
		to: 1
		by: -1
		do: [:level | 
			arg := (arguments
						at: level
						ifAbsent: [#()])
						includes: aString.
			arg
				ifTrue: [^ false].
			temp := (temporaries
						at: level
						ifAbsent: [#()])
						includes: aString.
			temp
				ifTrue: [^ true]].
	^ false! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parseLiteralArrayElement
	| type |
	(currentTokenFirst isLetter
			or: [currentTokenFirst == $_])
		ifTrue: [type := (#('true' 'false' 'nil' ) includes: currentToken)
						ifTrue: [currentToken asSymbol]
						ifFalse: [#symbol].
			^ self scanPast: type].
	currentTokenFirst == $(
		ifTrue: [self scanPast: #arrayStart.
			^ self parseArray].
	currentTokenFirst == $[
		ifTrue: [self scanPast: #byteArrayStart.
			^ self parseByteArray].
	^ self parseLiteral: true! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parsePragmaBinary
	self scanPast: #pragmaBinary.
	self isName
		ifTrue: [self
				scanPast: (self resolvePragmaArgument: currentToken)]
		ifFalse: [self parseLiteral: false].
	self failUnless: currentToken = '>'.
	self scanPast: #primitiveOrExternalCallEnd! !

!SHParserST80 methodsFor: 'initialization' stamp: ''!
initialize
	environment := Smalltalk! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parseStatementList
	[[currentTokenFirst == $.]
		whileTrue: [self scanPast: #statementSeparator].
	(currentToken notNil
			and: [currentTokenFirst ~~ $]])
		ifTrue: [self parseStatement].
	currentTokenFirst == $.]
		whileTrue: [self scanPast: #statementSeparator]! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parsePragmaSequence
	[currentToken = '<']
		whileTrue: [self scanPast: #primitiveOrExternalCallStart.
			currentToken = 'primitive:'
				ifTrue: [self rangeType: #primitive.
					self parsePrimitive]
				ifFalse: [self isTokenExternalFunctionCallingConvention
						ifTrue: [self rangeType: #externalFunctionCallingConvention.
							self parseExternalCall]
						ifFalse: [self isName
								ifTrue: [self scanPast: #pragmaUnary.
									self failUnless: currentToken = '>'.
									self scanPast: #primitiveOrExternalCallEnd]
								ifFalse: [self isKeyword
										ifTrue: [self parsePragmaKeyword]
										ifFalse: [self isBinary
												ifTrue: [self parsePragmaBinary]
												ifFalse: [self error]]]]]]! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parseStatementListForBraceArray
	[currentTokenFirst ~~ $}
		ifTrue: [self parseStatement].
	currentTokenFirst == $.]
		whileTrue: [self scanPast: #statementSeparator]! !

!SHParserST80 methodsFor: 'accessing' stamp: ''!
environment: anObject 
	environment := anObject! !

!SHParserST80 methodsFor: 'scan' stamp: ''!
scanIdentifier
	| c start |
	start := sourcePosition.
	[(c := self nextChar) isAlphaNumeric
		or: [c == $_]] whileTrue.
	(c == $:
			and: [(self isSelectorCharacter: self peekChar) not])
		ifTrue: [self nextChar].
	currentToken := source copyFrom: start to: sourcePosition - 1.
	currentTokenSourcePosition := start! !

!SHParserST80 methodsFor: 'scan' stamp: ''!
nextChar
	sourcePosition := sourcePosition + 1.
	^ source
		at: sourcePosition
		ifAbsent: [Character space]! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parseUnary
	| unary type |
	[self isName]
		whileTrue: [unary := currentToken.
			type := #unary.
			(unary isEmpty
					or: [Symbol
							hasInterned: unary
							ifTrue: [:sym | nil]])
				ifFalse: [type := (Symbol thatStartsCaseSensitive: unary skipping: nil) isNil
								ifTrue: [#undefinedUnary]
								ifFalse: [#incompleteUnary]].
			self scanPast: type]! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parseStringOrSymbol
	currentTokenFirst == $'
		ifTrue: [^ self parseString].
	currentTokenFirst == $#
		ifTrue: [^ self parseSymbol].
	self error! !

!SHParserST80 methodsFor: 'scan' stamp: ''!
scanPast: rangeType start: startInteger end: endInteger 
	^ self
		rangeType: rangeType
		start: startInteger
		end: endInteger;
		 scanNext! !

!SHParserST80 methodsFor: 'scan' stamp: ''!
scanWhitespace
	| c |
	[c := self currentChar.
	c notNil
		and: [c isSeparator]]
		whileTrue: [sourcePosition := sourcePosition + 1].
	c == $"
		ifTrue: [self scanComment]! !

!SHParserST80 methodsFor: 'accessing' stamp: 'SeanDeNigris 6/22/2012 18:29'!
isMethod

	^ isMethod ifNil: [ classOrMetaClass notNil ].! !

!SHParserST80 methodsFor: 'customizing' stamp: 'SeanDeNigris 6/22/2012 18:24'!
on: anObject

	anObject shoutParser: self.! !

!SHParserST80 methodsFor: 'accessing' stamp: ''!
workspace: aWorkspace 
	workspace := aWorkspace! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parseByteArray
	[currentTokenFirst == $]]
		whileFalse: [self scanPast: #integer].
	self scanPast: #byteArrayEnd! !

!SHParserST80 methodsFor: 'error handling' stamp: ''!
failWhen: aBoolean 
	aBoolean
		ifTrue: [self error]! !

!SHParserST80 methodsFor: 'identifier testing' stamp: ''!
isBlockArgName: aString 
	| temp arg |
	blockDepth
		to: 1
		by: -1
		do: [:level | 
			arg := (arguments
						at: level
						ifAbsent: [#()])
						includes: aString.
			arg
				ifTrue: [^ true].
			temp := (temporaries
						at: level
						ifAbsent: [#()])
						includes: aString.
			temp
				ifTrue: [^ false]].
	^ false! !

!SHParserST80 methodsFor: 'identifier testing' stamp: ''!
isIncompleteBlockArgName: aString 
	| arg |
	blockDepth
		to: 1
		by: -1
		do: [:level | 
			arg := (arguments
						at: level
						ifAbsent: [#()])
						anySatisfy: [:each | each beginsWith: aString].
			arg
				ifTrue: [^ true]].
	^ false! !

!SHParserST80 methodsFor: 'scan' stamp: ''!
skipBigDigits: baseInteger 
	[self isBigDigit: self nextChar base: baseInteger] whileTrue! !

!SHParserST80 methodsFor: 'accessing' stamp: 'SeanDeNigris 6/22/2012 18:29'!
isMethod: aBoolean

	isMethod := aBoolean.! !

!SHParserST80 methodsFor: 'scan' stamp: ''!
scanPast: rangeType level: level 
	| cycle typePlusCycle |
	cycle := level <= 1
				ifTrue: [0]
				ifFalse: [level - 2 \\ 7 + 1].
	typePlusCycle := cycle = 0
				ifTrue: [rangeType]
				ifFalse: [(rangeType , cycle asString) asSymbol].
	^ self scanPast: typePlusCycle! !

!SHParserST80 methodsFor: 'parse support' stamp: ''!
enterBlock
	blockDepth := blockDepth + 1.
	bracketDepth := bracketDepth + 1! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parseBlock
	self enterBlock.
	self scanPast: #blockStart level: bracketDepth.
	currentTokenFirst == $:
		ifTrue: [self parseBlockArguments].
	currentTokenFirst == $|
		ifTrue: [self parseBlockTemporaries].
	self parseStatementList.
	self failUnless: currentTokenFirst == $].
	self scanPast: #blockEnd level: bracketDepth.
	self leaveBlock! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parseKeyword
	| keyword rangeIndices |
	self parseBinary.
	keyword := ''.
	rangeIndices := #().
	[[self isKeyword]
		whileTrue: [keyword := keyword , currentToken.
			self rangeType: #keyword.
			rangeIndices := rangeIndices copyWith: ranges size.
			self scanNext.
			self parseTerm.
			self parseBinary].
	nil]
		ensure: [| type | (keyword isEmpty
					or: [Symbol
							hasInterned: keyword
							ifTrue: [:sym | nil]])
				ifFalse: [type := (Symbol thatStartsCaseSensitive: keyword skipping: nil) isNil
								ifTrue: [#undefinedKeyword]
								ifFalse: [#incompleteKeyword].
					rangeIndices
						do: [:i | (ranges at: i)
								type: type]]]! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parseUnaryMessagePattern
	self scanPast: #patternUnary! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parseMessagePattern
	self isName
		ifTrue: [self parseUnaryMessagePattern]
		ifFalse: [self isBinary
				ifTrue: [self parseBinaryMessagePattern]
				ifFalse: [self failUnless: self isKeyword.
					self parseKeywordMessagePattern]]! !

!SHParserST80 methodsFor: 'parse' stamp: 'MarcusDenker 6/24/2013 11:23'!
parse: aBoolean 
	self initializeInstanceVariables.
	sourcePosition := 1.
	arguments := Dictionary new.
	temporaries := Dictionary new.
	blockDepth := bracketDepth := 0.
	ranges isNil
		ifTrue: [ranges := OrderedCollection new: 100]
		ifFalse: [ranges reset].
	errorBlock := [^ false].
	[self scanNext.
	aBoolean
		ifTrue: [self parseMessagePattern.
			self parsePragmaSequence].
	self parseMethodTemporaries.
	aBoolean
		ifTrue: [self parsePragmaSequence].
	self parseStatementList.
	currentToken
		ifNotNil: [self error]]
		ensure: [errorBlock := nil].
	^ true! !

!SHParserST80 methodsFor: 'token testing' stamp: ''!
isAssignment
	^ currentToken = ':='
		or: [currentToken = '_']! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parseKeywordMessagePattern
	[self isKeyword]
		whileTrue: [self scanPast: #patternKeyword.
			self failUnless: self isName.
			self scanPast: #patternArg]! !

!SHParserST80 methodsFor: 'character testing' stamp: ''!
isBigDigit: aCharacter base: anInteger 
	| digitValue |
	digitValue := aCharacter digitValue.
	^ digitValue >= 0
		and: [digitValue < anInteger]! !

!SHParserST80 methodsFor: 'token testing' stamp: ''!
isTokenExternalFunctionCallingConvention
	| descriptorClass |
	descriptorClass := Smalltalk
				at: #ExternalFunction
				ifAbsent: [].
	descriptorClass
		ifNil: [^ false].
	^ (descriptorClass callingConventionFor: currentToken) notNil! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parseBinaryMessagePattern
	self scanPast: #patternBinary.
	self failUnless: self isName.
	self scanPast: #patternArg! !

!SHParserST80 methodsFor: 'parse' stamp: 'MarcusDenker 8/9/2014 12:55'!
parseBlockTemporaries
	currentTokenFirst == $|
		ifFalse: [ ^ self ].
	self scanPast: #blockTempBar.
	[ self isName ] whileTrue: [ self scanPast: #blockPatternTempVar ].
	self failUnless: currentToken = '|'.
	self scanPast: #blockTempBar! !

!SHParserST80 methodsFor: 'scan' stamp: ''!
currentChar
	^ source
		at: sourcePosition
		ifAbsent: []! !

!SHParserST80 methodsFor: 'token testing' stamp: ''!
isAnsiAssignment
	^ currentToken = ':='! !

!SHParserST80 methodsFor: 'scan' stamp: ''!
scanComment
	| c s e |
	s := sourcePosition.
	[sourcePosition := sourcePosition + 1.
	(c := self currentChar)
		ifNil: [self
				rangeType: #unfinishedComment
				start: s
				end: source size.
			^ self error].
	c == $"] whileFalse.
	e := sourcePosition.
	s < e
		ifTrue: [self
				rangeType: #comment
				start: s
				end: e].
	self nextChar.
	self scanWhitespace! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parsePrimitive
	self scanNext.
	currentTokenFirst isDigit
		ifTrue: [self scanPast: #integer]
		ifFalse: [self parseStringOrSymbol].
	currentToken = 'module:'
		ifTrue: [self scanPast: #module.
			self parseStringOrSymbol.
			currentToken = 'error:'
				ifTrue: [self scanPast: #primitive.
					self isName
						ifTrue: [self scanPast: #patternTempVar]
						ifFalse: [self parseStringOrSymbol]]]
		ifFalse: [currentToken = 'error:'
				ifTrue: [self scanPast: #module.
					self isName
						ifTrue: [self scanPast: #patternTempVar]
						ifFalse: [self parseStringOrSymbol].
					currentToken = 'module:'
						ifTrue: [self scanPast: #primitive.
							self parseStringOrSymbol]]].
	self failUnless: currentToken = '>'.
	self scanPast: #primitiveOrExternalCallEnd! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parsePragmaKeyword
	[self isKeyword]
		whileTrue: [self scanPast: #pragmaKeyword.
			self isName
				ifTrue: [self
						scanPast: (self resolvePragmaArgument: currentToken)]
				ifFalse: [self parseLiteral: false]].
	self failUnless: currentToken = '>'.
	self scanPast: #primitiveOrExternalCallEnd! !

!SHParserST80 methodsFor: 'character testing' stamp: ''!
isSelectorCharacter: aCharacter 
	aCharacter isAlphaNumeric
		ifTrue: [^ false].
	aCharacter isSeparator
		ifTrue: [^ false].
	('"#$'':().;[]{}^_' includes: aCharacter)
		ifTrue: [^ false].
	aCharacter asciiValue = 30
		ifTrue: [^ false].
	aCharacter asciiValue = 0
		ifTrue: [^ false].
	^ true! !

!SHParserST80 methodsFor: 'identifier testing' stamp: ''!
resolvePartial: aString 
	(#('self' 'super' 'true' 'false' 'nil' 'thisContext' )
			anySatisfy: [:each | each beginsWith: aString])
		ifTrue: [^ #incompleteIdentifier].
	(self isIncompleteBlockTempName: aString)
		ifTrue: [^ #incompleteIdentifier].
	(self isIncompleteBlockArgName: aString)
		ifTrue: [^ #incompleteIdentifier].
	(self isIncompleteMethodTempName: aString)
		ifTrue: [^ #incompleteIdentifier].
	(self isIncompleteMethodArgName: aString)
		ifTrue: [^ #incompleteIdentifier].
	(instanceVariables
			anySatisfy: [:each | each beginsWith: aString])
		ifTrue: [^ #incompleteIdentifier].
	workspace
		ifNotNil: [(workspace hasBindingThatBeginsWith: aString)
				ifTrue: [^ #incompleteIdentifier]].
	classOrMetaClass isBehavior
		ifTrue: [classOrMetaClass theNonMetaClass withAllSuperclasses
				do: [:c | 
					(c classPool hasBindingThatBeginsWith: aString)
						ifTrue: [^ #incompleteIdentifier].
					c sharedPools
						do: [:p | 
							(p hasBindingThatBeginsWith: aString)
								ifTrue: [^ #incompleteIdentifier].
							nil].
					(c environment hasBindingThatBeginsWith: aString)
						ifTrue: [^ #incompleteIdentifier].
					nil]]
		ifFalse: [(environment hasBindingThatBeginsWith: aString)
				ifTrue: [^ #incompleteIdentifier]].
	^ #undefinedIdentifier! !

!SHParserST80 methodsFor: 'identifier testing' stamp: ''!
resolvePartialPragmaArgument: aString 
	(#('true' 'false' 'nil' )
			anySatisfy: [:each | each beginsWith: aString])
		ifTrue: [^ #incompleteIdentifier].
	classOrMetaClass isBehavior
		ifTrue: [classOrMetaClass theNonMetaClass withAllSuperclasses
				do: [:c | 
					(c environment hasBindingThatBeginsWith: aString)
						ifTrue: [^ #incompleteIdentifier].
					nil]]
		ifFalse: [(environment hasBindingThatBeginsWith: aString)
				ifTrue: [^ #incompleteIdentifier]].
	^ #undefinedIdentifier! !

!SHParserST80 methodsFor: 'parse support' stamp: ''!
pushTemporary: aString 
	(temporaries
		at: blockDepth
		ifAbsentPut: [OrderedCollection new: 10])
		add: aString! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parseCharSymbol
	| s e |
	s := sourcePosition - 1.
	e := sourcePosition.
	self nextChar.
	self
		scanPast: #symbol
		start: s
		end: e! !

!SHParserST80 methodsFor: 'identifier testing' stamp: ''!
isMethodArgName: aString 
	^ (arguments
		at: 0
		ifAbsent: [#()])
		includes: aString! !

!SHParserST80 methodsFor: 'error handling' stamp: ''!
failUnless: aBoolean 
	aBoolean
		ifFalse: [self error]! !

!SHParserST80 methodsFor: 'scan' stamp: ''!
scanPast: rangeType 
	rangeType = #blockPatternArg
		ifTrue: [self pushArgument: currentToken].
	rangeType = #blockPatternTempVar
		ifTrue: [self pushTemporary: currentToken].
	rangeType = #patternArg
		ifTrue: [self pushArgument: currentToken].
	rangeType = #patternTempVar
		ifTrue: [self pushTemporary: currentToken].
	^ self rangeType: rangeType;
		 scanNext! !

!SHParserST80 methodsFor: 'recording ranges' stamp: ''!
rangeType: aSymbol start: s end: e 
	^ ranges
		add: (SHRange
				start: s
				end: e
				type: aSymbol)! !

!SHParserST80 methodsFor: 'identifier testing' stamp: ''!
resolvePragmaArgument: aString 
	(#('true' 'false' 'nil' ) includes: aString)
		ifTrue: [^ aString asSymbol].
	Symbol
		hasInterned: aString
		ifTrue: [:sym | classOrMetaClass isBehavior
				ifTrue: [classOrMetaClass theNonMetaClass withAllSuperclasses
						do: [:c | (c environment bindingOf: sym)
								ifNotNil: [^ #globalVar]]]
				ifFalse: [(environment bindingOf: sym)
						ifNotNil: [^ #globalVar]]].
	^ self resolvePartialPragmaArgument: aString! !

!SHParserST80 methodsFor: 'accessing' stamp: ''!
source
	^ source! !

!SHParserST80 methodsFor: 'scan' stamp: ''!
-= aSymbol 
	^ 1 -= 2! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parseStatement
	currentTokenFirst == $^
		ifTrue: [self scanPast: #return].
	self parseExpression! !

!SHParserST80 methodsFor: 'identifier testing' stamp: ''!
isIncompleteBlockTempName: aString 
	| temp |
	blockDepth
		to: 1
		by: -1
		do: [:level | 
			temp := (temporaries
						at: level
						ifAbsent: [#()])
						anySatisfy: [:each | each beginsWith: aString].
			temp
				ifTrue: [^ true]].
	^ false! !

!SHParserST80 methodsFor: 'recording ranges' stamp: 'CamilloBruni 1/20/2012 14:31'!
rangeType: aSymbol 

	self failWhen: currentToken isNil.
	^ self
		rangeType: aSymbol
		start: currentTokenSourcePosition
		end: currentTokenSourcePosition + currentToken size - 1! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parseBlockArguments
	[currentTokenFirst == $:]
		whileTrue: [self scanPast: #blockArgColon.
			self failUnless: self isName.
			self scanPast: #blockPatternArg].
	currentTokenFirst == $|
		ifTrue: [^ self scanPast: #blockArgsBar]! !

!SHParserST80 methodsFor: 'parse' stamp: 'SeanDeNigris 6/22/2012 18:30'!
parse
	^ self parse: self isMethod.! !

!SHParserST80 methodsFor: 'scan' stamp: ''!
scanNext
	self scanWhitespace.
	currentTokenFirst := self currentChar.
	currentTokenFirst isNil
		ifTrue: [currentTokenFirst := Character space.
			currentTokenSourcePosition := nil.
			currentToken := nil.
			^ nil].
	currentTokenFirst isDigit
		ifTrue: [^ self scanNumber].
	(currentTokenFirst isLetter
			or: [currentTokenFirst == $_])
		ifTrue: [^ self scanIdentifier].
	^ self scanBinary! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parseSymbolSelector
	| start end |
	start := sourcePosition - 1.
	end := sourcePosition.
	[self isSelectorCharacter: self nextChar]
		whileTrue: [end := sourcePosition].
	self
		scanPast: #symbol
		start: start
		end: end! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parseString
	| first c answer last |
	first := sourcePosition.
	answer := ''.
	[(c := self currentChar) isNil
		ifTrue: [self
				rangeType: #unfinishedString
				start: first - 1
				end: source size.
			self error].
	(c ~~ $'
			and: [answer := answer copyWith: c.
				true])
		or: [self peekChar == $'
				and: [sourcePosition := sourcePosition + 1.
					answer := answer copyWith: $'.
					true]]]
		whileTrue: [sourcePosition := sourcePosition + 1].
	last := sourcePosition.
	self nextChar.
	self
		scanPast: #string
		start: first - 1
		end: last.
	^ answer! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parseExternalCall
	self scanNext.
	self scanPast: #externalCallType.
	currentToken = '*'
		ifTrue: [self scanPast: #externalCallTypePointerIndicator].
	currentTokenFirst isDigit
		ifTrue: [self scanPast: #integer]
		ifFalse: [self failUnless: currentTokenFirst == $'.
			self parseString].
	self failUnless: currentTokenFirst == $(.
	self scanPast: #leftParenthesis.
	[currentTokenFirst ~~ $)]
		whileTrue: [self scanPast: #externalCallType.
			currentToken = '*'
				ifTrue: [self scanPast: #externalCallTypePointerIndicator]].
	self scanPast: #rightParenthesis.
	currentToken = 'module:'
		ifTrue: [self scanPast: #module.
			self failUnless: currentTokenFirst == $'.
			self parseString].
	self failUnless: currentToken = '>'.
	self scanPast: #primitiveOrExternalCallEnd! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parseCascade
	self parseKeyword.
	[currentTokenFirst == $;]
		whileTrue: [self scanPast: #cascadeSeparator.
			self parseKeyword]! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parseTerm
	self failWhen: currentToken isNil.
	currentTokenFirst == $(
		ifTrue: [bracketDepth := bracketDepth + 1.
			self scanPast: #leftParenthesis level: bracketDepth.
			self parseExpression.
			self failUnless: currentTokenFirst == $).
			self scanPast: #rightParenthesis level: bracketDepth.
			^ bracketDepth := bracketDepth - 1].
	currentTokenFirst == $[
		ifTrue: [^ self parseBlock].
	currentTokenFirst == ${
		ifTrue: [self scanPast: #leftBrace.
			^ self parseBraceArray].
	self isName
		ifTrue: [^ self
				scanPast: (self resolve: currentToken)].
	self parseLiteral: false! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parseBraceArray
	self parseStatementListForBraceArray.
	self failUnless: currentTokenFirst == $}.
	self scanPast: #rightBrace! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parseSymbolIdentifier
	| c start end |
	c := self currentChar.
	self
		failUnless: (c isLetter
				or: [c == $:
						or: [c == $_]]).
	start := sourcePosition.
	[c := self nextChar.
	c isAlphaNumeric
		or: [c == $:
				or: [c == $_]]] whileTrue.
	end := sourcePosition - 1.
	c := source copyFrom: start - 1 to: end.
	self
		scanPast: #symbol
		start: start - 1
		end: end.
	^ c! !

!SHParserST80 methodsFor: 'scan' stamp: ''!
peekChar
	^ source
		at: sourcePosition + 1
		ifAbsent: [Character space]! !

!SHParserST80 methodsFor: 'scan' stamp: 'nice 3/15/2014 16:02'!
scanNumber
	| start c nc base |
	start := sourcePosition.
	self skipDigits.
	c := self currentChar.
	c == $r
		ifTrue: [base := Integer
						readFrom: (ReadStream
								on: (source copyFrom: start to: sourcePosition - 1)).
			self peekChar == $-
				ifTrue: [self nextChar].
			self skipBigDigits: base.
			c := self currentChar.
			c == $.
				ifTrue: [(self isBigDigit: self nextChar base: base)
						ifTrue: [self skipBigDigits: base]
						ifFalse: [sourcePosition := sourcePosition - 1]].
			c := self currentChar.
			('deq' includes: c)
				ifTrue: [((nc := self nextChar) isDigit
							or: [nc == $-
									and: [self peekChar isDigit]])
						ifTrue: [self skipDigits]
						ifFalse: [sourcePosition := sourcePosition - 1]].
			c == $s
				ifTrue: [(nc := self nextChar) isDigit
						ifTrue: [self skipDigits]
						ifFalse: [nc isLetter ifTrue: [sourcePosition := sourcePosition - 1]]].
			currentToken := source copyFrom: start to: sourcePosition - 1.
			^ currentTokenSourcePosition := start].
	c == $s
		ifTrue: [(nc := self nextChar) isDigit
					ifTrue: [self skipDigits]
					ifFalse: [nc isLetter ifTrue: [sourcePosition := sourcePosition - 1]].
			currentToken := source copyFrom: start to: sourcePosition - 1.
			^ currentTokenSourcePosition := start].
	c == $.
		ifTrue: [self nextChar isDigit
				ifTrue: [self skipDigits]
				ifFalse: [sourcePosition := sourcePosition - 1.
					currentToken := source copyFrom: start to: sourcePosition - 1.
					^ currentTokenSourcePosition := start]].
	c := self currentChar.
	('deq' includes: c)
		ifTrue: [((nc := self nextChar) isDigit
					or: [nc == $-
							and: [self peekChar isDigit]])
				ifTrue: [self skipDigits]
				ifFalse: [sourcePosition := sourcePosition - 1]].
	c == $s
		ifTrue: [(nc := self nextChar) isDigit
				ifTrue: [self skipDigits]
				ifFalse: [nc isLetter ifTrue: [sourcePosition := sourcePosition - 1]]].
	currentToken := source copyFrom: start to: sourcePosition - 1.
	^ currentTokenSourcePosition := start! !

!SHParserST80 methodsFor: 'parse' stamp: 'MarcusDenker 8/9/2014 12:55'!
parseMethodTemporaries
	currentTokenFirst == $|
		ifFalse: [ ^ self ].
	self scanPast: #methodTempBar.
	[ self isName ] whileTrue: [ self scanPast: #patternTempVar ].
	self failUnless: currentToken = '|'.
	self scanPast: #methodTempBar! !

!SHParserST80 methodsFor: 'parse support' stamp: 'NicolaiHess 12/17/2014 08:27'!
parsingBlockarguments
	^ ranges isEmpty not and:[|last| last:= ranges last.
		last type = #blockPatternArg]! !

!SHParserST80 methodsFor: 'parse support' stamp: ''!
leaveBlock
	arguments
		removeKey: blockDepth
		ifAbsent: [].
	temporaries
		removeKey: blockDepth
		ifAbsent: [].
	blockDepth := blockDepth - 1.
	bracketDepth := bracketDepth - 1! !

!SHParserST80 methodsFor: 'parse support' stamp: ''!
pushArgument: aString 
	(arguments
		at: blockDepth
		ifAbsentPut: [OrderedCollection new: 10])
		add: aString! !

!SHParserST80 methodsFor: 'scan' stamp: 'NicolaiHess 4/6/2014 16:38'!
scanBinary
	| c d |
	c := self currentChar.
	currentTokenSourcePosition := sourcePosition.
	currentToken := c asString.
	d := self nextChar.
	((self isSelectorCharacter: c)
			or: [c == $:])
		ifFalse: [^ currentToken].
	(c == $:
			and: [d == $=])
		ifTrue: [currentToken := currentToken , d asString.
			self nextChar.
			^ currentToken].
	((c == $|) and:[self parsingBlockarguments])
		ifTrue: [^ currentToken].
	[self isSelectorCharacter: d]
		whileTrue: [currentToken := currentToken , d asString.
			d := self nextChar].
	^ currentToken! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parseArray
	[currentTokenFirst == $)]
		whileFalse: [self parseLiteralArrayElement].
	self scanPast: #arrayEnd! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
rangesIn: sourceString classOrMetaClass: aBehaviour workspace: aWorkspace environment: anEnvironmentOrNil 
	anEnvironmentOrNil
		ifNotNil: [environment := anEnvironmentOrNil].
	self workspace: aWorkspace;
		 classOrMetaClass: aBehaviour;
		 source: sourceString.
	self parse.
	^ ranges! !

!SHParserST80 methodsFor: 'accessing' stamp: ''!
source: aString 
	source := aString! !

!SHParserST80 methodsFor: 'error handling' stamp: ''!
error
	self
		rangeType: #excessCode
		start: (ranges isEmpty
				ifTrue: [1]
				ifFalse: [ranges last end + 1])
		end: source size.
	errorBlock value! !

!SHParserST80 methodsFor: 'parse' stamp: ''!
parseSymbol
	| c |
	currentToken = '#'
		ifTrue: [self rangeType: #symbol.
			self scanWhitespace].
	c := self currentChar.
	self
		failWhen: (c isNil
				or: [c isSeparator]).
	c == $(
		ifTrue: [self nextChar.
			self
				scanPast: #arrayStart
				start: currentTokenSourcePosition
				end: currentTokenSourcePosition + 1.
			^ self parseArray].
	c == $[
		ifTrue: [self nextChar.
			self
				scanPast: #byteArrayStart
				start: currentTokenSourcePosition
				end: currentTokenSourcePosition + 1.
			^ self parseByteArray].
	c == $'
		ifTrue: [^ self parseSymbolString].
	((self isSelectorCharacter: c)
			or: [c == $-])
		ifTrue: [^ self parseSymbolSelector].
	(c isLetter
			or: [c == $:])
		ifTrue: [^ self parseSymbolIdentifier].
	^ self parseCharSymbol! !

!SHParserST80 class methodsFor: 'instance creation' stamp: ''!
new
	^ super new initialize; yourself! !

!SHParserST80Test commentStamp: 'TorstenBergmann 2/12/2014 23:22'!
SUnit tests for shouts ST80 parser!
!SHParserST80Test methodsFor: 'tests-manual' stamp: 'tween 7/8/2006 12:02'!
r
	"ensure that r is defined so that we don't get an #undefinedUnary token type "! !

!SHParserST80Test methodsFor: 'utilities' stamp: 'StephaneDucasse 4/14/2012 11:42'!
verifyClass: aBehavior selector: aSymbol
	| ranges position types errors |
	ranges := SHParserST80 new 
		rangesIn: (aBehavior sourceCodeAt: aSymbol) 
		classOrMetaClass: aBehavior 
		workspace: nil environment: nil.
	types := #(#default #invalid #excessCode #comment #unfinishedComment #'$' #character #integer #number #- #symbol #stringSymbol #literalArray #string #unfinishedString #assignment #ansiAssignment #literal #keyword #binary #unary #incompleteKeyword #incompleteBinary #incompleteUnary #undefinedKeyword #undefinedBinary #undefinedUnary #patternKeyword #patternBinary #patternUnary #self #super #true #false #nil #thisContext #return #patternArg #methodArg #blockPatternArg #blockArg #argument #blockArgColon #leftParenthesis #rightParenthesis #leftParenthesis1 #rightParenthesis1 #leftParenthesis2 #rightParenthesis2 #leftParenthesis3 #rightParenthesis3 #leftParenthesis4 #rightParenthesis4 #leftParenthesis5 #rightParenthesis5 #leftParenthesis6 #rightParenthesis6 #leftParenthesis7 #rightParenthesis7 #blockStart #blockEnd #blockStart1 #blockEnd1 #blockStart2 #blockEnd2 #blockStart3 #blockEnd3 #blockStart4 #blockEnd4 #blockStart5 #blockEnd5 #blockStart6 #blockEnd6 #blockStart7 #blockEnd7 #arrayStart #arrayEnd #arrayStart1 #arrayEnd1 #byteArrayStart #byteArrayEnd #byteArrayStart1 #byteArrayEnd1 #leftBrace #rightBrace #cascadeSeparator #statementSeparator #externalCallType #externalCallTypePointerIndicator #primitiveOrExternalCallStart #primitiveOrExternalCallEnd #methodTempBar #blockTempBar #blockArgsBar #primitive #externalFunctionCallingConvention #module #blockTempVar #blockPatternTempVar #instVar #workspaceVar #undefinedIdentifier #incompleteIdentifier #tempVar #patternTempVar #poolConstant #classVar #globalVar #pragmaKeyword #pragmaUnary #pragmaBinary) asIdentitySet.
	errors := #(#excessCode #unfinishedComment #unfinishedString) asIdentitySet.
	position := 0.
	ranges do: [ :each |
		self 
			assert: 1 <= each length 
			description: 'empty range'.
		self 
			assert: position <= each start
			description: 'overlapping range'.
		self 
			assert: each start <= each end 
			description: 'empty range'.
		self 
			assert: (types includes: each type)
			description: 'unknown type ' , each type.
		self
			deny: (errors includes: each type)
			description: 'error type ' , each type.
		position := each end ]! !

!SHParserST80Test methodsFor: 'tests-manual' stamp: 'tween 7/8/2006 12:02'!
q
	"ensure that q is defined so that we don't get an #undefinedUnary token type "! !

!SHParserST80Test methodsFor: 'tests-smoke' stamp: 'lr 10/18/2010 15:33'!
testBooleanHierarchy
	self verifyHierarchy: Boolean! !

!SHParserST80Test methodsFor: 'tests-manual' stamp: 'tween 7/8/2006 12:02'!
s
	"ensure that s is defined so that we don't get an #undefinedUnary token type "! !

!SHParserST80Test methodsFor: 'tests-smoke' stamp: 'CamilloBruni 8/28/2013 02:23'!
testCollectionHierarchy
	self skip: 'Too slow for too little value added'.
	self verifyHierarchy: Collection! !

!SHParserST80Test methodsFor: 'tests-manual' stamp: 'tween 7/8/2006 16:43'!
d
	"ensure that d is defined so that we don't get an #undefinedUnary token type "! !

!SHParserST80Test methodsFor: 'tests-manual' stamp: 'tween 7/8/2006 12:02'!
e
	"ensure that e is defined so that we don't get an #undefinedUnary token type "! !

!SHParserST80Test methodsFor: 'tests-smoke' stamp: 'lr 10/18/2010 15:24'!
testNumberHierarchy
	self verifyHierarchy: Number! !

!SHParserST80Test methodsFor: 'tests-smoke' stamp: 'lr 10/18/2010 15:34'!
testObjectClass
	self verifyClass: Object! !

!SHParserST80Test methodsFor: 'utilities' stamp: 'tween 7/8/2006 11:45'!
tokenTypesIn: aString
	| parser ranges |
	parser := SHParserST80 new.
	ranges := parser rangesIn: aString classOrMetaClass: Object workspace: nil environment: nil.
	^ranges asArray collect: [:each | each type]! !

!SHParserST80Test methodsFor: 'utilities' stamp: 'tween 7/8/2006 11:44'!
tokensIn: aString
	| parser ranges |
	parser := SHParserST80 new.
	ranges := parser rangesIn: aString classOrMetaClass: Object workspace: nil environment: nil.
	^ranges asArray collect: [:each | aString copyFrom: each start to: each end]! !

!SHParserST80Test methodsFor: 'tests' stamp: 'PabloHerrero 1/10/2015 12:56'!
testNumbers
	| types tokens s |
	s := 'x 1'.
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number).
	self assert: tokens = #('x' '1').
	
	s := 'x -1'.
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary #- number).
	self assert: tokens = #('x' '-' '1').

	s := 'x -1.1'.
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary #- number).
	self assert: tokens = #('x' '-' '1.1').

	s := 'x -1.1.'.
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary #- number statementSeparator).
	self assert: tokens = #('x' '-' '1.1' '.').
		
	s := 'x 1.true'.
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number statementSeparator #true).
	self assert: tokens = #('x' '1' '.' 'true').
		
	s := 'x 2r1'.	
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number).
	self assert: tokens = #('x' '2r1').

	s := 'x 2d1'.	
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number).
	self assert: tokens = #('x' '2d1').
	
	s := 'x 2e1'.	
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number).
	self assert: tokens = #('x' '2e1').
	
	s := 'x 2q1'.	
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number).
	self assert: tokens = #('x' '2q1').	
		
	s := 'x 16r-A'.	
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number).
	self assert: tokens = #('x' '16r-A').

	s := 'x -16r-A'.	
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary #- number).
	self assert: tokens = #('x' '-' '16r-A').
	
	s := 'x 16r'.	
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number).
	self assert: tokens = #('x' '16r').
	
	s := 'x 16r-'.	
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number).
	self assert: tokens = #('x' '16r-').

	s := 'x 16r-d'.	
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number).
	self assert: tokens = #('x' '16r-d').
			
	s := 'x 2r2'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number excessCode).
	self assert: tokens = #('x' '2r' '2').

	s := 'x 1.'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number statementSeparator).
	self assert: tokens = #('x' '1' '.').
	
	s := 'x 1yourself'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number unary).
	self assert: tokens = #('x' '1' 'yourself').
	
	s := 'x 1size'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number unary).
	self assert: tokens = #('x' '1' 'size').
	
	s := 'x 1.1size'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number unary).
	self assert: tokens = #('x' '1.1' 'size').	
	
	s := 'x 1s'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number).
	self assert: tokens = #('x' '1s').
	
	s := 'x 1.1s'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number).
	self assert: tokens = #('x' '1.1s').	
	
	s := 'x 2r1e26'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number).
	self assert: tokens = #('x' '2r1e26').
	
	s := 'x 16r1e-26'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number binary number).
	self assert: tokens = #('x' '16r1e' '-' '26').
	
	s := 'x 16r1e'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number).
	self assert: tokens = #('x' '16r1e').
	
	s := 'x 16r1e-1'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number binary number).
	self assert: tokens = #('x' '16r1e' '-' '1').
		
	s := 'x 16r1e-'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number binary excessCode).
	self assert: tokens = #('x' '16r1e' '-' '').
	
	s := 'x 16r1.ABe20'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number).
	self assert: tokens = #('x' '16r1.ABe20').
	
	s := 'x 16r1.ABe-20'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number binary number).
	self assert: tokens = #('x' '16r1.ABe' '-' '20').

	s := 'x 1.0e14'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number).
	self assert: tokens = #('x' '1.0e14').
	
	s := 'x 1.0e-14'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number).
	self assert: tokens = #('x' '1.0e-14').
	
	s := 'x 1.0e14e'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number unary).
	self assert: tokens = #('x' '1.0e14' 'e').
""	
	s := 'x 2r1q26'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number).
	self assert: tokens = #('x' '2r1q26').
	
	s := 'x 16r1q-26'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number).
	self assert: tokens = #('x' '16r1q-26').
	
	s := 'x 16r1q'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number unary).
	self assert: tokens = #('x' '16r1' 'q').
	
	s := 'x 16r1q-1'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number).
	self assert: tokens = #('x' '16r1q-1').
		
	s := 'x 16r1q-'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number unary binary excessCode).
	self assert: tokens = #('x' '16r1' 'q' '-' '').
	
	s := 'x 16r1.ABq20'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number).
	self assert: tokens = #('x' '16r1.ABq20').
	
	s := 'x 16r1.ABq-20'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number).
	self assert: tokens = #('x' '16r1.ABq-20').

	s := 'x 1.0q14'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number).
	self assert: tokens = #('x' '1.0q14').
	
	s := 'x 1.0q-14'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number).
	self assert: tokens = #('x' '1.0q-14').
	
	s := 'x 1.0q14q'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number unary).
	self assert: tokens = #('x' '1.0q14' 'q').
""
	s := 'x 2r1d26'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number).
	self assert: tokens = #('x' '2r1d26').
	
	s := 'x 16r1d-26'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number binary number).
	self assert: tokens = #('x' '16r1d' '-' '26').
	
	s := 'x 16r1d'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number).
	self assert: tokens = #('x' '16r1d').
	
	s := 'x 16r1d-1'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number binary number).
	self assert: tokens = #('x' '16r1d' '-' '1').
		
	s := 'x 16r1d-'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number binary excessCode).
	self assert: tokens = #('x' '16r1d' '-' '').
	
	s := 'x 16r1.ABd20'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number).
	self assert: tokens = #('x' '16r1.ABd20').
	
	s := 'x 16r1.ABd-20'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number binary number).
	self assert: tokens = #('x' '16r1.ABd' '-' '20').

	s := 'x 1.0d14'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number).
	self assert: tokens = #('x' '1.0d14').
	
	s := 'x 1.0d-14'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number).
	self assert: tokens = #('x' '1.0d-14').
	
	s := 'x 1.0d14d'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number unary).
	self assert: tokens = #('x' '1.0d14' 'd').
	
""

	s := 'x -1.1e-2'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary #- number ).
	self assert: tokens = #('x' '-' '1.1e-2'). "only first - is separate token !!"
	
	s := 'x -16r-1.0e-2'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary #- number binary number).
	self assert: tokens = #('x' '-' '16r-1.0e' '-' '2'). "only first - is separate token !!"
	
	s := 'x 1-1'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number binary number ).
	self assert: tokens = #('x' '1' '-' '1'). 

	s := 'x 1>-------1'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types equals: #(patternUnary number incompleteBinary number ).
	self assert: tokens equals: #('x' '1' '>-------' '1'). 

	s := 'x 1>-------"comment"1'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types equals: #(patternUnary number incompleteBinary comment number ).
	self assert: tokens equals: #('x' '1' '>-------' '"comment"' '1'). 	

	s := 'x 1-self'. 
	types := self tokenTypesIn: s.
	tokens := self tokensIn: s. 
	self assert: types = #(patternUnary number binary self ).
	self assert: tokens = #('x' '1' '-' 'self'). ! !

!SHParserST80Test methodsFor: 'utilities' stamp: 'lr 10/18/2010 15:22'!
verifyClass: aBehavior
	aBehavior selectors do: [ :selector | self verifyClass: aBehavior selector: selector ]
	! !

!SHParserST80Test methodsFor: 'utilities' stamp: 'PabloHerrero 1/10/2015 12:55'!
>-------> anObject

"Dummy binary selector method"! !

!SHParserST80Test methodsFor: 'utilities' stamp: 'lr 10/18/2010 15:21'!
verifyHierarchy: aBehavior
	aBehavior withAllSubclassesDo: [ :class | self verifyClass: class; verifyClass: class class ]! !

!SHPreferences commentStamp: 'TorstenBergmann 2/12/2014 23:23'!
Preferences for Shout!
!SHPreferences class methodsFor: 'accessing-styles' stamp: ''!
reservedWordsStyle
	^ Groups at: #reservedWords! !

!SHPreferences class methodsFor: 'accessing' stamp: ''!
enabled
	^ enabled
		ifNil: [enabled := true]! !

!SHPreferences class methodsFor: 'accessing-styles' stamp: ''!
globalVarStyle: aGroupStyle 
	^ Groups at: #globalVar put: aGroupStyle! !

!SHPreferences class methodsFor: 'accessing-styles' stamp: ''!
globalVarStyle
	^ Groups at: #globalVar! !

!SHPreferences class methodsFor: 'accessing-styles' stamp: ''!
syntaxStyle
	^ Groups at: #syntax! !

!SHPreferences class methodsFor: 'accessing-styles' stamp: ''!
errorStyle: aGroupStyle 
	^ Groups at: #error put: aGroupStyle! !

!SHPreferences class methodsFor: 'accessing-styles' stamp: ''!
primitiveTypesStyle
	^ Groups at: #primitiveTypes! !

!SHPreferences class methodsFor: 'accessing-styles' stamp: ''!
commentStyle
	^ Groups at: #comment! !

!SHPreferences class methodsFor: 'private' stamp: ''!
customStyleTable: anArray 
	CustomStyleTable := anArray.
	self initializeGroups! !

!SHPreferences class methodsFor: 'initialization' stamp: ''!
initialize
	self customStyleTable: SHTextStylerST80 defaultStyleTable! !

!SHPreferences class methodsFor: 'accessing-styles' stamp: ''!
commentStyle: aGroupStyle 
	^ Groups at: #comment put: aGroupStyle! !

!SHPreferences class methodsFor: 'accessing-styles' stamp: ''!
defaultStyle: aGroupStyle 
	^ Groups at: #default put: aGroupStyle! !

!SHPreferences class methodsFor: 'accessing-styles' stamp: ''!
selectorPatternsStyle
	^ Groups at: #selectorPatterns! !

!SHPreferences class methodsFor: 'accessing-styles' stamp: ''!
argsStyle: aGroupStyle 
	^ Groups at: #args put: aGroupStyle! !

!SHPreferences class methodsFor: 'settings' stamp: 'StephaneDucasse 11/11/2014 18:49'!
settingsOn: aBuilder 
	<systemsettings>
	(aBuilder setting: #'Syntax Highlighting') 
		target: self;
		dialog: [ self styleTableRow ];
		parentName: #codeBrowsing;
		description: 'Syntax Highlighting As You Type: Enable syntax highlighting in browsers, debuggers and workspaces and set patterns style.';
		selector: #enabled;
		icon: Smalltalk ui icons smallConfigurationIcon;
		with: [
			(aBuilder setting: #selectorPatternsStyle) 
				label: 'Selector Patterns';
				description: 'Selector patterns in method pane'.
			(aBuilder setting: #errorStyle) 
				label: 'Syntactic error';
				description: 'Invalid and undefined code' .
			(aBuilder setting: #argsStyle) 
				label: 'Parameters';
				description: 'Parameters in patterns, message sends, and blocks' .
			(aBuilder setting: #commentStyle) 
				label: 'Comments';
				description: 'Comments in code pane' .
			(aBuilder setting: #defaultStyle) 
				label: 'Default' ;
				description: 'Default style' .
			(aBuilder setting: #globalVarStyle) 
				label: 'Global variables' ;
				description: 'References to global variables, including classes' .
			(aBuilder setting: #instanceVarStyle) 
				label: 'Instance/class variables' ;
				description: 'References to instance and class variables' .
			(aBuilder setting: #messageSendsStyle) 
				label: 'Message sends' ;
				description: 'Message sends' .
			(aBuilder setting: #primitiveOrModuleStyle) 
				label: 'Primitive or module' ;
				description: 'Primitive or module' .
			(aBuilder setting: #primitiveTypesStyle) 
				label: 'Primitive types';
				description: 'Literal data' .
			(aBuilder setting: #reservedWordsStyle) 
				label: 'Reserved words';
				description: 'Reserved words of the Smalltalk language' .
			(aBuilder setting: #syntaxStyle) 
				label: 'Syntax';
				description: 'Any other syntactic element' .
			(aBuilder setting: #variableStyle) 
				label: 'Variable';
				description: 'Temporary variable'  ]! !

!SHPreferences class methodsFor: 'accessing-styles' stamp: ''!
primitiveOrModuleStyle
	^ Groups at: #primitiveOrModule! !

!SHPreferences class methodsFor: 'accessing' stamp: ''!
enabled: aBoolean 
	enabled := aBoolean! !

!SHPreferences class methodsFor: 'settings' stamp: 'EstebanLorenzano 10/16/2012 11:35'!
styleTableRow
	| allStyles |
	
	allStyles := Pragma  allNamed: #styleTable: in: SHTextStylerST80 class.
	^UIManager default theme 
		newRowIn: World 
		for: (
			{ UIManager default theme buttonLabelForText: 'Predefined styles: ' translated }, 
			(allStyles collect: [ :eachPragma | 
				(UIManager default theme 
					newButtonIn: World 
						for:  self
						getState: nil 
						action: #setStyleTableNamed:  
						arguments:  { eachPragma argumentAt: 1 }
						getEnabled: nil 
						getLabel: nil
						help: ('Change style table to ', (eachPragma argumentAt: 1)) translated)
					label: (eachPragma argumentAt: 1);
					yourself ] ))! !

!SHPreferences class methodsFor: 'accessing-styles' stamp: ''!
messageSendsStyle: aGroupStyle 
	^ Groups at: #messageSends put: aGroupStyle! !

!SHPreferences class methodsFor: 'accessing-styles' stamp: ''!
messageSendsStyle
	^ Groups at: #messageSends! !

!SHPreferences class methodsFor: 'accessing-styles' stamp: ''!
primitiveOrModuleStyle: aGroupStyle 
	^ Groups at: #primitiveOrModule put: aGroupStyle! !

!SHPreferences class methodsFor: 'settings' stamp: 'EstebanLorenzano 10/16/2012 11:36'!
setStyleTableNamed: aString
	self setStyleTable: (((Pragma allNamed: #styleTable: in: SHTextStylerST80 class)
		detect: [ :each | (each argumentAt: 1) = aString ])
		method 
			valueWithReceiver: SHTextStylerST80 class 
			arguments: #())! !

!SHPreferences class methodsFor: 'accessing-styles' stamp: ''!
primitiveTypesStyle: aGroupStyle 
	^ Groups at: #primitiveTypes put: aGroupStyle! !

!SHPreferences class methodsFor: 'accessing-styles' stamp: ''!
instanceVarStyle: aGroupStyle 
	^ Groups at: #instanceVar put: aGroupStyle! !

!SHPreferences class methodsFor: 'accessing-styles' stamp: ''!
reservedWordsStyle: aGroupStyle 
	^ Groups at: #reservedWords put: aGroupStyle! !

!SHPreferences class methodsFor: 'accessing-styles' stamp: ''!
syntaxStyle: aGroupStyle 
	^ Groups at: #syntax put: aGroupStyle! !

!SHPreferences class methodsFor: 'accessing-styles' stamp: ''!
selectorPatternsStyle: aGroupStyle 
	^ Groups at: #selectorPatterns put: aGroupStyle! !

!SHPreferences class methodsFor: 'accessing-styles' stamp: ''!
variableStyle: aGroupStyle 
	^ Groups at: #variable put: aGroupStyle! !

!SHPreferences class methodsFor: 'settings' stamp: 'CamilloBruni 10/31/2012 19:41'!
setStyleTable: anArray
	SHTextStylerST80 styleTable: anArray.
	SHRBTextStyler styleTable: anArray.! !

!SHPreferences class methodsFor: 'accessing-styles' stamp: ''!
errorStyle
	^ Groups at: #error! !

!SHPreferences class methodsFor: 'accessing-styles' stamp: ''!
instanceVarStyle
	^ Groups at: #instanceVar! !

!SHPreferences class methodsFor: 'private' stamp: ''!
customStyleTable
	^ CustomStyleTable! !

!SHPreferences class methodsFor: 'private' stamp: 'CamilloBruni 10/31/2012 19:43'!
applyStyle
	| table |
	table := Groups values gather: [:group | group styleForTable].
	SHTextStylerST80 styleTable: table.
	SHRBTextStyler styleTable: table.! !

!SHPreferences class methodsFor: 'accessing-styles' stamp: ''!
defaultStyle
	^ Groups at: #default! !

!SHPreferences class methodsFor: 'accessing-styles' stamp: ''!
variableStyle
	^ Groups at: #variable! !

!SHPreferences class methodsFor: 'initialization' stamp: 'AlainPlantec 9/20/2011 17:20'!
initializeGroups
	Groups := Dictionary new.
	#(#default #(#default ) #reservedWords #(#self #super #true #false #nil #thisContext ) #primitiveTypes #(#'$' #character #integer #number #- #symbol #stringSymbol #literalArray #string #unfinishedString ) #selectorPatterns #(#patternKeyword #patternBinary #patternUnary ) #messageSends #(#keyword #binary #unary #incompleteKeyword #incompleteBinary #incompleteUnary ) #primitiveOrModule #(#primitive #externalFunctionCallingConvention #module #externalCallType #externalCallTypePointerIndicator #primitiveOrExternalCallStart #primitiveOrExternalCallEnd ) #args #(#patternArg #methodArg #blockPatternArg #blockArg #argument ) #variable #(#blockTempVar #blockPatternTempVar #workspaceVar #tempVar #patternTempVar #incompleteIdentifier ) #instanceVar #(#instVar #classVar ) #globalVar #(#globalVar #poolConstant ) #comment #(#comment #unfinishedComment ) #error #(#invalid #excessCode #undefinedKeyword #undefinedBinary #undefinedUnary #undefinedIdentifier ) #syntax #(#assignment #ansiAssignment #literal #return #blockArgColon #leftParenthesis #rightParenthesis #leftParenthesis1 #rightParenthesis1 #leftParenthesis2 #rightParenthesis2 #leftParenthesis3 #rightParenthesis3 #leftParenthesis4 #rightParenthesis4 #leftParenthesis5 #rightParenthesis5 #leftParenthesis6 #rightParenthesis6 #leftParenthesis7 #rightParenthesis7 #blockStart #blockEnd #blockStart1 #blockEnd1 #blockStart2 #blockEnd2 #blockStart3 #blockEnd3 #blockStart4 #blockEnd4 #blockStart5 #blockEnd5 #blockStart6 #blockEnd6 #blockStart7 #blockEnd7 #arrayStart #arrayEnd #arrayStart1 #arrayEnd1 #byteArrayStart #byteArrayEnd #byteArrayStart1 #byteArrayEnd1 #leftBrace #rightBrace #cascadeSeparator #statementSeparator #methodTempBar #blockTempBar #blockArgsBar ) )
		pairsDo: [:gname :tokens | Groups
				at: gname
				put: (SHStyleElement withTokens: tokens)]! !

!SHPreferences class methodsFor: 'accessing-styles' stamp: ''!
argsStyle
	^ Groups at: #args! !

!SHRBTextStyler commentStamp: '<historical>'!
I'm the one who visits node to coloring the code!
!SHRBTextStyler methodsFor: 'formatting' stamp: 'CamilloBruni 10/31/2012 19:33'!
addStyle: styleSymbol forNode: anRBNode
	self addAttributes: (self attributesFor: styleSymbol) forNode: anRBNode.! !

!SHRBTextStyler methodsFor: 'visiting rb nodes' stamp: 'GiselaDecuzzi 5/24/2013 15:23'!
visitSuperNode: aSuperNode
	self 
		addStyle: #super
		forNode: aSuperNode! !

!SHRBTextStyler methodsFor: 'visiting rb nodes' stamp: 'GiselaDecuzzi 5/24/2013 15:24'!
visitThisContextNode: aThisContextNode
	self 
		addStyle: #thisContext
		forNode: aThisContextNode! !

!SHRBTextStyler methodsFor: 'visiting' stamp: ''!
visitArgumentNodes: aNodeCollection 
	"Sent *once* when visiting method and block nodes"
	^aNodeCollection do: [ :each | self visitArgumentNode: each ]! !

!SHRBTextStyler methodsFor: 'visiting' stamp: ''!
visitCascadeNode: aCascadeNode 
	aCascadeNode messages do: [:each | self visitNode: each]! !

!SHRBTextStyler methodsFor: 'formatting' stamp: 'CamilloBruni 10/31/2012 21:40'!
addAttributes: attributes from: start to: stop
	charAttr
		from: start
		to: stop
		put: attributes! !

!SHRBTextStyler methodsFor: 'visiting rb nodes' stamp: 'GiselaDecuzzi 5/24/2013 15:22'!
visitSelfNode: aSelfNode
	self 
		addStyle: #self
		forNode: aSelfNode! !

!SHRBTextStyler methodsFor: 'visiting' stamp: ''!
visitArrayNode: anArrayNode 

	anArrayNode children do: [:each | self visitNode: each]! !

!SHRBTextStyler methodsFor: 'visiting' stamp: ''!
visitPatternBlockNode: aRBPatternBlockNode 
	self visitArgumentNodes: aRBPatternBlockNode arguments.
	self visitNode: aRBPatternBlockNode body! !

!SHRBTextStyler methodsFor: 'visiting rb nodes' stamp: 'PabloHerrero 1/5/2015 10:13'!
visitMessageNode: aMessageNode
	| style link |
	style := #keyword.
	(Symbol findInterned: aMessageNode selector asString)
		ifNil: [ 
			style := (Symbol thatStartsCaseSensitive: aMessageNode selector asString skipping: nil) isNil
				ifTrue: [ #undefinedKeyword ]
				ifFalse: [ #incompleteKeyword ] ].
	link := TextMethodLink selector: aMessageNode selector.
	aMessageNode selectorParts do: [ :keyword | self addStyle: style attribute: link forNode: keyword ].
	(aMessageNode isCascaded not or: [ aMessageNode isFirstCascaded ])
		ifTrue: [ self visitNode: aMessageNode receiver ].
	aMessageNode arguments do: [ :each | self visitNode: each ]	! !

!SHRBTextStyler methodsFor: 'visiting rb nodes' stamp: 'GiselaDecuzzi 6/24/2013 13:01'!
visitClassReferenceNode: aNode


	Smalltalk 
		at: aNode name asSymbol 
		ifAbsent: [ self 
			addStyle: #invalid
			attribute: (TextClassLink className: aNode name asSymbol )
			forNode: aNode.
			^self
		 ]. 
	self 
		addStyle: #globalVar
		attribute: (TextClassLink className: aNode name asSymbol )
		forNode: aNode	 ! !

!SHRBTextStyler methodsFor: 'visiting rb nodes' stamp: 'PabloHerrero 11/7/2013 11:15'!
visitMethodNode: aMethodNode 
aMethodNode comments do: [ :comment|
		self 
			addStyle: #comment
			from: comment start
			to: comment stop ].
	aMethodNode arguments do: [ :argument|
		self 
			addStyle: #patternArg
			forNode: argument ].
		
	aMethodNode selectorParts do: [ :keyword|
		self 
			addStyle: #patternKeyword
			forNode: keyword ].
	
	aMethodNode pragmas
		do: [ :each | self visitNode: each ].
		
	self visitNode: aMethodNode body! !

!SHRBTextStyler methodsFor: 'visiting rb nodes' stamp: 'GiselaDecuzzi 6/11/2013 16:28'!
visitVariableNode: aVariableNode

	aVariableNode name first isUppercase 
		ifTrue: [environment ifNil: [ ^ self visitClassReferenceNode: aVariableNode ]].

	self 
		addStyle: (self resolveStyleFor: aVariableNode) 
		attribute: (TextVariableLink variableName: aVariableNode name)
		forNode: aVariableNode.
	
	! !

!SHRBTextStyler methodsFor: 'visiting rb nodes' stamp: 'PabloHerrero 11/7/2013 11:14'!
visitBlockNode: aBlockNode 
	aBlockNode comments do: [ :comment|
		self 
			addStyle: #comment
			from: comment start
			to: comment stop ].

	aBlockNode arguments do: [ :argument|
		self 
			addStyle: #blockPatternArg
			forNode: argument ].
	
	self visitNode: aBlockNode body! !

!SHRBTextStyler methodsFor: 'visiting rb nodes' stamp: 'GiselaDecuzzi 5/24/2013 15:23'!
visitTemporaryNode: aTemporaryNode 
	self 
		addStyle: #tempVar
		forNode: aTemporaryNode! !

!SHRBTextStyler methodsFor: 'formatting' stamp: 'CamilloBruni 10/31/2012 20:01'!
addStyle: styleSymbol attributes: additionalAttributes forNode: anRBNode
	self 
		addAttributes: (self attributesFor: styleSymbol), additionalAttributes 
		forNode: anRBNode.! !

!SHRBTextStyler methodsFor: 'formatting' stamp: 'CamilloBruni 10/31/2012 21:40'!
addAttributes: attributes forNode: anRBNode
	self 
		addAttributes: attributes
		from: anRBNode start
		to: anRBNode stop! !

!SHRBTextStyler methodsFor: 'formatting' stamp: 'CamilloBruni 10/31/2012 21:40'!
addStyle: styleSymbol from: start to: end
	self addAttributes: (self attributesFor: styleSymbol) from: start to: end.! !

!SHRBTextStyler methodsFor: 'visiting' stamp: ''!
visitLiteralArrayNode: aRBLiteralArrayNode 
	aRBLiteralArrayNode contents do: [:each | self visitNode: each]! !

!SHRBTextStyler methodsFor: 'formatting' stamp: 'MarcusDenker 8/9/2014 12:55'!
literalStyleSymbol: aValue
	aValue isSymbol
		ifTrue: [ ^ #symbol ].
	aValue isString
		ifTrue: [ ^ #string ].
	aValue isNumber
		ifTrue: [ ^ #number ].
	aValue == true
		ifTrue: [ ^ #true ].
	aValue == false
		ifTrue: [ ^ #false ].
	aValue isNil
		ifTrue: [ ^ #nil ].
	^ #default! !

!SHRBTextStyler methodsFor: 'visiting' stamp: ''!
visitPatternWrapperBlockNode: aRBPatternWrapperBlockNode 
	self visitNode: aRBPatternWrapperBlockNode wrappedNode.
	self visitArgumentNodes: aRBPatternWrapperBlockNode arguments.
	self visitNode: aRBPatternWrapperBlockNode body! !

!SHRBTextStyler methodsFor: 'visiting rb nodes' stamp: 'PabloHerrero 10/22/2013 14:02'!
visitPragmaNode: aPragmaNode
	aPragmaNode selectorParts do: [ :keyword|
	self 
		addStyle: #pragmaKeyword
		forNode: keyword ].
	
	aPragmaNode arguments do: [ :each | self visitNode: each ]! !

!SHRBTextStyler methodsFor: 'visiting' stamp: ''!
visitTemporaryNodes: aNodeCollection 
	"This is triggered when defining the temporaries between the pipes"
	^self visitArgumentNodes: aNodeCollection! !

!SHRBTextStyler methodsFor: 'visiting rb nodes' stamp: 'GiselaDecuzzi 5/24/2013 15:21'!
visitParseErrorNode: anErrorNode
	self 
		addStyle: #invalid
		forNode: anErrorNode! !

!SHRBTextStyler methodsFor: 'visiting rb nodes' stamp: 'GiselaDecuzzi 5/27/2013 17:55'!
visitSequenceNode: aSequenceNode 
		
	aSequenceNode temporaries do: [ :temporary|
		self 
			addStyle: #patternTempVar
			forNode: temporary ].
	
	aSequenceNode statements do: [:each | self visitNode: each]! !

!SHRBTextStyler methodsFor: 'private' stamp: 'GiselaDecuzzi 6/24/2013 13:11'!
privateStyle: aText 
	| ast |

	ast := self parse: aText isMethod: classOrMetaClass isNil not .
	ast doSemanticAnalysis.
	self style: aText ast: ast.
	^ aText! !

!SHRBTextStyler methodsFor: 'visiting rb nodes' stamp: 'PabloHerrero 11/7/2013 11:15'!
visitNode: aNode 
	aNode comments do: [ :comment|
		self 
			addStyle: #comment
			from: comment start
			to: comment stop ].

	^aNode acceptVisitor: self! !

!SHRBTextStyler methodsFor: 'private' stamp: 'GiselaDecuzzi 5/30/2013 12:50'!
style: aText ast: ast
	| oldRuns |

	oldRuns := aText runs.
	text := aText.	
	charAttr := Array new: aText size withAll: (self attributesFor: #default).
	ast acceptVisitor: self .
	aText runs: (RunArray newFrom: charAttr).	
	self 
		addAttributesFrom: oldRuns 
		satisfying: [:each | each shoutShouldPreserve] 
		to: aText.
		! !

!SHRBTextStyler methodsFor: 'visiting rb nodes' stamp: 'GiselaDecuzzi 5/24/2013 14:44'!
visitArgumentNode: anArgumentNode
	self 
		addStyle: #argument
		forNode: anArgumentNode.! !

!SHRBTextStyler methodsFor: 'visiting' stamp: ''!
visitAssignmentNode: anAssignmentNode

	self visitNode: anAssignmentNode variable.
	self visitNode: anAssignmentNode value! !

!SHRBTextStyler methodsFor: 'formatting' stamp: 'CamilloBruni 10/31/2012 20:02'!
addStyle: styleSymbol attribute: additionalAttribute forNode: anRBNode
	self 
		addStyle:styleSymbol
		attributes: { additionalAttribute }
		forNode: anRBNode.! !

!SHRBTextStyler methodsFor: 'private' stamp: 'GiselaDecuzzi 6/11/2013 18:23'!
parse: aText isMethod: isMethod
	|root|
	
	isMethod 
		ifTrue: [
			[root := RBParser parseFaultyMethod: aText asString.
			root methodNode methodClass: classOrMetaClass.
			^root] 
				on: Error 
				do: [^RBParser parseFaultyExpression: aText asString]]
		ifFalse:[ ^RBParser parseFaultyExpression: aText asString ].! !

!SHRBTextStyler methodsFor: 'visiting rb nodes' stamp: 'GiselaDecuzzi 6/3/2013 16:53'!
visitReturnNode: aReturnNode 
	self 
		addStyle: #return
		from: aReturnNode start
		to: aReturnNode stop.
		
	self visitNode: aReturnNode value! !

!SHRBTextStyler methodsFor: 'visiting rb nodes' stamp: 'GiselaDecuzzi 5/24/2013 15:20'!
visitLiteralNode: aLiteralNode
	| value |
	value := aLiteralNode value.
	self 
		addStyle: (self literalStyleSymbol: value)
		attribute: (TextClassLink class: value class)
		forNode: aLiteralNode! !

!SHRBTextStyler methodsFor: 'private' stamp: 'GiselaDecuzzi 6/24/2013 13:06'!
resolveStyleFor: aVariableNode

	aVariableNode binding ifNil: [^#default].
	aVariableNode isArg ifTrue: [ ^#methodArg].
	aVariableNode isTemp ifTrue: [ ^#tempVar].
	aVariableNode isInstance ifTrue: [ ^#instVar]. 
	aVariableNode isUndeclared ifTrue: [ ^#invalid]. 
	self flag: 'todo: see if its incompleteIdentifier'.
	^#invalid.! !

!SHRBTextStyler class methodsFor: 'configuration' stamp: 'StephaneDucasse 11/11/2014 18:49'!
enableAstHighlightSetting: aBuilder 
	<systemsettings>
	(aBuilder setting: #useAstColoring) 
		label: 'AST based coloring';
		parent: #'Syntax Highlighting'; 
		target: SHRBTextStyler ;
		description: 'When selected we use AST for coloring text, this needs to be debugged and finished' 
! !

!SHRBTextStyler class methodsFor: 'configuration' stamp: 'GiselaDecuzzi 6/14/2013 16:47'!
useAstColoring
	^ PluggableTextMorph stylingClass = SHRBTextStyler ! !

!SHRBTextStyler class methodsFor: 'configuration' stamp: 'GiselaDecuzzi 6/14/2013 16:48'!
useAstColoring: bool
	^ PluggableTextMorph stylingClass: (bool ifTrue: [SHRBTextStyler] ifFalse:[SHTextStylerST80])! !

!SHRange commentStamp: 'StephaneDucasse 11/29/2011 22:28'!
I associate a type with a range of characters in a String
I have these instance variables...
	start - the one based index of the first character of the range within the String.
	end - the one based index of the last character  of the range within the String.
	type - a Symbol describing the type of the range
	
A sequence of instances of me are created by an instance of SHParserST80 which can then used by an instance of  SHTextStyler to style Text. !
!SHRange methodsFor: 'accessing' stamp: ''!
end: anInteger 
	end := anInteger! !

!SHRange methodsFor: 'tests' stamp: 'ul 1/28/2011 00:48'!
isConstant
	
	^self asType notNil! !

!SHRange methodsFor: 'tests' stamp: 'bar 1/6/2005 22:22'!
isBlockEnd
	^ type beginsWith: 'blockEnd'! !

!SHRange methodsFor: 'tests' stamp: 'bar 3/9/2006 10:10'!
isKeyword
	^ type == #keyword or:[type == #undefinedKeyword]! !

!SHRange methodsFor: 'accessing' stamp: 'CamilloBruni 2/1/2012 19:20'!
stringIn: aText
	^ (self textIn: aText) asString! !

!SHRange methodsFor: 'tests' stamp: 'bar 3/2/2006 21:27'!
isBinary
	^type == #binary! !

!SHRange methodsFor: 'tests' stamp: 'ul 4/21/2011 03:21'!
isSelf
	
	^type == #self! !

!SHRange methodsFor: 'tests' stamp: 'ul 4/21/2011 03:20'!
isGlobal

	^type == #globalVar! !

!SHRange methodsFor: 'tests' stamp: 'bar 1/6/2005 22:21'!
isBlockStart
	^type beginsWith: 'blockStart'! !

!SHRange methodsFor: 'tests' stamp: 'ul 4/21/2011 03:20'!
isBlockTemporary
	
	^type == #blockPatternTempVar or: [ type == #blockPatternArg ]! !

!SHRange methodsFor: 'accessing' stamp: ''!
start
	^ start! !

!SHRange methodsFor: 'tests' stamp: 'ul 1/28/2011 00:49'!
asType

	type == #symbol ifTrue: [ ^Symbol ].
	type == #character ifTrue: [ ^Character ].
	type == #string ifTrue: [ ^String ].
	type == #number ifTrue: [ ^Number ].
	type == #true ifTrue: [ ^True ].
	type == #false ifTrue: [ ^False ].
	type == #arrayEnd ifTrue: [ ^Array ].
	type == #byteArrayEnd ifTrue: [ ^ByteArray ].
	self isBlockEnd ifTrue: [ ^BlockClosure ].
	^nil! !

!SHRange methodsFor: 'accessing' stamp: ''!
length
	^ end - start + 1! !

!SHRange methodsFor: 'accessing' stamp: ''!
start: anInteger 
	start := anInteger! !

!SHRange methodsFor: 'accessing' stamp: ''!
type
	^ type! !

!SHRange methodsFor: 'tests' stamp: 'bar 1/9/2005 13:13'!
isVariable
	^ self isTemporaryVariable
		or: [self isInstanceVariable
				or: [self isSelf or:[self isSuper]]]! !

!SHRange methodsFor: 'accessing' stamp: ''!
type: aSymbol 
	type := aSymbol! !

!SHRange methodsFor: 'tests' stamp: 'ul 4/21/2011 03:19'!
isArgument

	^type == #methodArg! !

!SHRange methodsFor: 'tests' stamp: 'ul 4/21/2011 03:21'!
isTemporaryVariable
	
	^#(#tempVar #blockTempVar workspaceVar ) identityIncludes: type! !

!SHRange methodsFor: 'tests' stamp: 'ul 4/21/2011 03:20'!
isInstanceVariable
	
	^type == #instVar! !

!SHRange methodsFor: 'tests' stamp: 'ul 4/21/2011 03:21'!
isUnfinished
	
	^#(#unfinishedString #unfinishedComment ) identityIncludes: type! !

!SHRange methodsFor: 'accessing' stamp: ''!
start: startInteger end: endInteger type: typeSymbol 
	start := startInteger.
	end := endInteger.
	type := typeSymbol! !

!SHRange methodsFor: 'tests' stamp: 'ul 4/21/2011 03:20'!
isOpening
	
	^(type beginsWith: 'blockStart') or: [
		type beginsWith: 'leftParenthesis' ]
		! !

!SHRange methodsFor: 'accessing' stamp: ''!
end
	^ end! !

!SHRange methodsFor: 'tests' stamp: 'MarcusDenker 8/9/2014 12:55'!
includesPosition: anInteger
	^ anInteger between: start and: end! !

!SHRange methodsFor: 'tests' stamp: 'ul 4/21/2011 03:20'!
isAssignment

	^type == #assignment or: [ type == #ansiAssignment ]! !

!SHRange methodsFor: 'tests' stamp: 'ul 4/21/2011 03:21'!
isSuper
	
	^type == #super! !

!SHRange methodsFor: 'tests' stamp: 'bar 1/6/2005 13:17'!
isComment
	^ type == #comment! !

!SHRange methodsFor: 'tests' stamp: 'ul 4/21/2011 03:21'!
isSeparator
	
	^#(#methodTempBar #statementSeparator #patternUnary #patternArg #blockPatternArg #blockArgsBar #return #primitiveOrExternalCallEnd) identityIncludes: type! !

!SHRange methodsFor: 'tests' stamp: 'ul 4/21/2011 03:20'!
isClassVariable

	^type == #classVar! !

!SHRange methodsFor: 'accessing' stamp: 'CamilloBruni 2/1/2012 19:20'!
textIn: aText
	^ aText copyFrom: self start to: self end! !

!SHRange methodsFor: 'tests' stamp: 'bar 3/2/2006 21:26'!
isVariablesOnly
	^ self isAssignment
		or: [self isVariable
				or: [self isConstant
						or: [self isSeparator or:[self isBinary]]]]! !

!SHRange class methodsFor: 'instance creation' stamp: ''!
start: s end: e type: aSymbol 
	^ self new
		start: s
		end: e
		type: aSymbol;
		 yourself! !

!SHStyleElement commentStamp: 'TorstenBergmann 2/12/2014 23:23'!
A Shout style element!
!SHStyleElement methodsFor: 'accessing' stamp: ''!
emphasis
	| style |
	^ emphasis
		ifNil: [style := SHPreferences customStyleTable
						detect: [:e | self tokens first = e first].
			style size > 2
				ifTrue: [emphasis := style third.
					emphasis isSymbol
						ifFalse: [emphasis := ' ' join: emphasis].
					emphasis]
				ifFalse: [#normal]]! !

!SHStyleElement methodsFor: 'accessing' stamp: ''!
tokens
	^ tokens! !

!SHStyleElement methodsFor: 'printing' stamp: 'MarcusDenker 8/9/2014 12:56'!
printOn: aStream
	super printOn: aStream.
	color isNil
		ifFalse: [ 
			aStream
				nextPutAll: ' color: ';
				nextPutAll: color printString ].
	emphasis isNil
		ifFalse: [ 
			aStream
				nextPutAll: ' emphasis: ';
				nextPutAll: emphasis printString ].
	tokens isNil
		ifFalse: [ 
			aStream
				nextPutAll: ' tokens: ';
				nextPutAll: tokens printString ]! !

!SHStyleElement methodsFor: 'accessing' stamp: ''!
color
	^ color
		ifNil: [color := Color colorFrom: (SHPreferences customStyleTable
							detect: [:e | self tokens first = e first]) second]! !

!SHStyleElement methodsFor: 'accessing' stamp: ''!
emphasis: anObject 
	emphasis := anObject.
	SHPreferences applyStyle! !

!SHStyleElement methodsFor: 'styling' stamp: ''!
emphasisAsArray
	^ self emphasis = 'bold italic'
		ifTrue: [#(#bold #italic )]
		ifFalse: [self emphasis]! !

!SHStyleElement methodsFor: 'accessing' stamp: ''!
color: anObject 
	color := anObject.
	SHPreferences applyStyle! !

!SHStyleElement methodsFor: 'accessing' stamp: ''!
tokens: anObject 
	tokens := anObject! !

!SHStyleElement methodsFor: 'styling' stamp: ''!
styleForTable
	^ self tokens
		collect: [:token | 
			| style |
			style := OrderedCollection with: token.
			style add: self color.
			self emphasis
				ifNotNil: [style add: self emphasisAsArray].
			style asArray]! !

!SHStyleElement class methodsFor: 'settings' stamp: ''!
settingInputWidgetForNode: aSettingNode 
	| theme |
	theme := UITheme builder.
	^ theme newRow: {theme
			newColorChooserFor: aSettingNode realValue
			getColor: #color
			setColor: #color:
			help: 'Choose token color'. (theme
			newDropListFor: aSettingNode realValue
			list: #(#bold #italic #normal 'bold italic' )
			getSelected: #emphasis
			setSelected: #emphasis:
			getEnabled: nil
			useIndex: false
			help: 'Choose token emphasis') hResizing: #rigid;
			 width: 100}! !

!SHStyleElement class methodsFor: 'instance-creation' stamp: ''!
withTokens: aCollection 
	^ self new tokens: aCollection;
		 yourself! !

!SHStyleElementTest commentStamp: 'AlexandreBergel 9/30/2011 15:22'!
I am testing the class SHStyleElement!
!SHStyleElementTest methodsFor: 'tests' stamp: 'AlexandreBergel 9/30/2011 15:19'!
testPrintOn
	"
	self debug: #testPrintOn
	"
	self assert: element printString =  'a SHStyleElement tokens: #(#self #super #true #false)'

	! !

!SHStyleElementTest methodsFor: 'running' stamp: 'AlexandreBergel 9/30/2011 15:18'!
setUp
	element := SHStyleElement withTokens: #(#self #super #true #false).! !

!SHStyleElementTest methodsFor: 'tests' stamp: 'AlexandreBergel 9/30/2011 15:23'!
testStyleForTable
	"
	self debug: #testStyleForTable
	"
	| table |
	table := element styleForTable.
	self assert: table size = 4.
	self assert: (table collect: #first) = element tokens! !

!SHStylingOrNotDependingOnModelState commentStamp: 'AlainPlantec 9/20/2011 17:26'!
I'm a example that shows how to have a simple editor in which text is highlighted or not depending on the editor model state.  Try it with:

SHStylingOrNotDependingOnModelState new open.

Thus, depending on the model state, the view should be styled or not styled. This is achieve by implementing a #shoutAboutToStyle: method in the model (here, an instance of myself). #shoutAboutToStyle: returns true if the view which is passed as argument must be styled. In this excample, if the value of the 'state' instance variable is #code, then the text is hilighted, else it is not.

Instance Variables:
	code	<Text>
	codeEditing    <Boolean>!
!SHStylingOrNotDependingOnModelState methodsFor: 'accessing' stamp: 'AlainPlantec 9/1/2011 18:58'!
code
	^ code ifNil: [code := '' asText]! !

!SHStylingOrNotDependingOnModelState methodsFor: 'view' stamp: 'IgorStasenko 12/20/2012 14:09'!
open
	| window editor bar |
	window := (StandardWindow labelled: 'Code and text editor') model: self.
	bar := window newRow: {
			window 
				newCheckboxFor: self 
				getSelected: #codeEditing 
				setSelected: #codeEditing:
				label: 'Code editing' 
				help: 'Checked for code editing' }.
	editor := window newTextEditorFor:  self getText:  #code setText: #code: getEnabled: nil. 
	window addMorph: (window newColumn: {bar. editor})
		fullFrame: LayoutFrame identity.
	^ window openInWorld! !

!SHStylingOrNotDependingOnModelState methodsFor: 'accessing' stamp: 'AlainPlantec 9/3/2011 16:23'!
codeEditing
	^ codeEditing ifNil: [codeEditing := true]! !

!SHStylingOrNotDependingOnModelState methodsFor: 'accessing' stamp: 'AlainPlantec 9/3/2011 18:30'!
code: someText
	code := someText.
	self changed: #code! !

!SHStylingOrNotDependingOnModelState methodsFor: 'accessing' stamp: 'AlainPlantec 9/19/2011 19:44'!
codeEditing: aBoolean
	codeEditing = aBoolean ifTrue: [^self].
	codeEditing := aBoolean.
	self changed: #code.
! !

!SHStylingOrNotDependingOnModelState methodsFor: 'shout' stamp: 'MarcusDenker 8/9/2014 12:55'!
shoutAboutToStyle: aTextView
	^ self codeEditing! !

!SHTextStyler commentStamp: 'StephaneDucasse 11/29/2011 22:28'!
I am an Abstract class.
Subclasses of me can create formatted, coloured, and styled copies of Text that is given to them.
They may perform their styling asynchronously, in a background process which I create and manage.

My public interface is...

	view: aViewOrMorph - set the view that will receive notifications when styling has completed.
	
	format: aText - modifies aText's string

	style: aText - modifies the TextAttributes of aText, but does not change the string, then sends #stylerStyled: to the view.

	styleInBackgroundProcess: aText - performs style: in a background process, then sends #stylerStylednBackground: to the view.

	styledTextFor: aText - answers a formatted and styled copy of aText

	unstyledTextFrom: aText - answers a copy of aText with all TextAttributes removed

Subclasses of me should re-implement...

	privateFormat: aText - answer a formatted version of aText; the String may be changed
	privateStyle: aText - modify the TextAttributes of aText; but do not change the String
	

	
	
!
!SHTextStyler methodsFor: 'styling' stamp: 'MarcusDenker 8/10/2014 09:48'!
styledTextFor: aText 
	^self privateStyle: aText! !

!SHTextStyler methodsFor: 'formatting' stamp: 'MarcusDenker 8/10/2014 09:46'!
format: aText 
	self terminateBackgroundStylingProcess.
	^ aText! !

!SHTextStyler methodsFor: 'initialization' stamp: ''!
initialize
	stylingEnabled := true! !

!SHTextStyler methodsFor: 'private' stamp: 'AlainPlantec 9/19/2011 19:29'!
stylingEnabled
	^ stylingEnabled! !

!SHTextStyler methodsFor: 'accessing' stamp: ''!
view: aViewOrMorph 
	view := aViewOrMorph! !

!SHTextStyler methodsFor: 'private' stamp: ''!
privateStyle: aText 
	self shouldBeImplemented! !

!SHTextStyler methodsFor: 'private' stamp: ''!
terminateBackgroundStylingProcess
	self monitor
		critical: [backgroundProcess
				ifNotNil: [backgroundProcess terminate.
					backgroundProcess := nil].
			sem
				ifNotNil: [sem terminateProcess.
					sem := nil]]! !

!SHTextStyler methodsFor: 'styling' stamp: 'MarcusDenker 8/9/2014 12:55'!
style: aText
	self terminateBackgroundStylingProcess.
	stylingEnabled
		ifFalse: [ ^ self ].
	text := aText copy.
	self privateStyle: text.
	view ifNotNil: [ :view2 | view2 stylerStyled: text ]! !

!SHTextStyler methodsFor: 'styling' stamp: ''!
unstyledTextFrom: aText 
	^ Text fromString: aText string! !

!SHTextStyler methodsFor: 'styling' stamp: 'BenComan 3/27/2015 23:56'!
styleInBackgroundProcess: aText
	self terminateBackgroundStylingProcess.
	stylingEnabled
		ifFalse: [ ^ self ].
	text := aText copy.
	self monitor
		critical: [ 
			sem := Semaphore new.
			[ 
			sem notNil
				ifTrue: [ 
					sem waitTimeoutSeconds: 5.
					view ifNotNil: [ view stylerStyledInBackground: text ] ] ] forkAt: Processor activePriority.
			backgroundProcess := [ 
			self privateStyle: text.
			sem signal ] forkAt: Processor userBackgroundPriority ]! !

!SHTextStyler methodsFor: 'private' stamp: 'AlainPlantec 9/19/2011 19:29'!
stylingEnabled: aBoolean
	stylingEnabled := aBoolean! !

!SHTextStyler methodsFor: 'private' stamp: ''!
monitor
	monitor isNil
		ifTrue: [monitor := Monitor new].
	^ monitor! !

!SHTextStylerST80 commentStamp: '<historical>'!
I style Smalltalk methods and expressions.

My 'styleTable' class instance var holds an array ofArrays which control how each token is styled/coloured. See my defaultStyleTable class method for its structure.
My styleTable can be changed by either modifying the defaultStyleTable class method and then executing SHTextStylerST80 initialize ; or by giving me a new styleTable through my #styleTable: class method.

My 'textAttributesByPixelSize' class instance var contains a dictionary of dictionaries.
	The key is a pixelSize and the value a Dictionary from token type Symbol to TextAttribute array.
	It is created/maintained automatically.

I reimplement #unstyledTextFrom: so that TextActions are preserved in the unstyled text 
	
	
	
	
	 
	
!
!SHTextStylerST80 methodsFor: 'private' stamp: 'MarcusDenker 12/2/2013 14:10'!
setAttributesIn: aText fromRanges: ranges 
	"use the . to find and assign TextAttributes to aText"
	
	| charAttr oldRuns |
	
	oldRuns := aText runs.
	charAttr := Array new: aText size withAll: (self attributesFor: #default).
	
	ranges do: [:range | 
		(self attributesFor: range type) ifNotNil: [ :attribute|
			charAttr 
				from: range start
				to: range end
				put: attribute]].

	self addLinkAttributesFor: ranges in: aText to: charAttr.
	
	aText runs: (RunArray newFrom: charAttr).
	
	self 
		addAttributesFrom: oldRuns 
		satisfying: [:each | each shoutShouldPreserve] 
		to: aText.! !

!SHTextStylerST80 methodsFor: 'accessing' stamp: ''!
font: aFont 
	font := aFont! !

!SHTextStylerST80 methodsFor: 'private' stamp: ''!
attributesFor: aSymbol 
	^ self class attributesFor: aSymbol pixelHeight: self pixelHeight! !

!SHTextStylerST80 methodsFor: 'private' stamp: ''!
pixelHeight
	^ pixelHeight
		ifNil: [pixelHeight := (font
						ifNil: [TextStyle defaultFont]) pixelSize]! !

!SHTextStylerST80 methodsFor: 'accessing' stamp: ''!
environment: anObject 
	environment := anObject! !

!SHTextStylerST80 methodsFor: 'private' stamp: 'GiselaDecuzzi 5/30/2013 12:50'!
rangesIn: aText setWorkspace: aBoolean 
	parser ifNil: [parser := SHParserST80 new on: (view ifNotNil: [ view model ]) ].
	^ parser
		rangesIn: aText asString
		classOrMetaClass: classOrMetaClass
		workspace: (aBoolean
				ifTrue: [workspace]) 
		environment: environment! !

!SHTextStylerST80 methodsFor: 'private' stamp: 'MarcusDenker 8/10/2014 09:47'!
privateStyle: aText 
	(self rangesIn: aText setWorkspace: true)
		ifNotNil: [ :ranges| self setAttributesIn: aText fromRanges: ranges].
	^aText.! !

!SHTextStylerST80 methodsFor: 'private' stamp: 'CamilloBruni 3/9/2012 16:36'!
addLinkAttributesFor: ranges in: aText to: charAttributes
	| links |
	"TODO: put this on class side"
	links := Dictionary new.
	
	"see SHTextStylerST80 class >> #defaultStyleTable for more types"
	links at: #instVar put: [ :aString| TextVariableLink variableName: aString ].
	links at: #globalVar put: [ :aString| TextClassLink className: aString ].
	#(binary unary  keyword) do: [ :type|
		links at: type put: [ :aString| TextMethodLink selector: aString ]].
	#(pragmaUnary pragmaBinary patternBinary patternUnary patternKeyword) do: [ :type|
		links at: type put: [ :aString| TextMethodLink selector: aString senders: true]].
	links at: #true put: [ :aString| TextClassLink class: True ].
	links at: #false put: [ :aString| TextClassLink class: False ].
	links at: #nil put: [ :aString| TextClassLink class: UndefinedObject ].
	links at: #character put: [ :aString| TextClassLink class: Character ].
	
	"set the attrinbutes on the text"
	ranges do: [ :range|
		links at: range type ifPresent: [ :action| |attributes|
			attributes := charAttributes at: range start.
			attributes := attributes, { action cull: (range stringIn: aText) }.
			charAttributes 
				from: range start
				to: range end
				put: attributes ]]! !

!SHTextStylerST80 methodsFor: 'converting' stamp: 'CamilloBruni 10/31/2012 16:57'!
unstyledTextFrom: aText 
	"return a Text object without all styling attributes"
	| answer |
	answer := super unstyledTextFrom: aText.
	
	self 
		addAttributesFrom: aText runs 
		satisfying: [ :each| each isKindOf: TextAction ]
		to: answer.
	
	^ answer! !

!SHTextStylerST80 methodsFor: 'accessing' stamp: ''!
classOrMetaClass: aBehavior 
	classOrMetaClass := aBehavior! !

!SHTextStylerST80 methodsFor: 'converting' stamp: 'CamilloBruni 10/31/2012 16:57'!
addAttributesFrom: attributeRuns satisfying: aTestBlock to: aText

	attributeRuns withStartStopAndValueDo: [:start :stop :attributes | 
		attributes 
			select: aTestBlock 
			thenDo: [ :selectedAttribute| 
				aText
					addAttribute: selectedAttribute
					from: start
					to: stop ]].
		
	^ aText! !

!SHTextStylerST80 methodsFor: 'accessing' stamp: ''!
workspace: aWorkspace 
	workspace := aWorkspace! !

!SHTextStylerST80 class methodsFor: 'style table' stamp: 'EstebanLorenzano 10/16/2012 14:25'!
defaultStyleTable
	"color can be a valid argument to Color class>>colorFrom: , or nil to
	use the editor text color.
	Multiple emphases can be specified using an array e.g. #(bold italic).
	If emphasis is not specified, #normal will be used.
	if pixel height is not specified , then the editor font size will be used.
	"
								
 	^ self blueStyleTable! !

!SHTextStylerST80 class methodsFor: 'style table' stamp: ''!
styleTable: anArray 
	styleTable := anArray.
	textAttributesByPixelHeight := nil! !

!SHTextStylerST80 class methodsFor: 'style table' stamp: ''!
attributesFor: aSymbol pixelHeight: aNumber 
	^ (self textAttributesByPixelHeight
		at: aNumber
		ifAbsentPut: [self initialTextAttributesForPixelHeight: aNumber])
		at: aSymbol
		ifAbsent: []! !

!SHTextStylerST80 class methodsFor: 'style table' stamp: ''!
initialTextAttributesForPixelHeight: aNumber 
	| d |
	d := IdentityDictionary new.
	self styleTable
		do: [:each | 
			| textStyle element emphasis font pixelHeight attrArray color textStyleName |
			element := each first.
			color := each
						at: 2
						ifAbsent: [].
			color := color
						ifNotNil: [Color colorFrom: color].
			emphasis := each
						at: 3
						ifAbsent: [].
			textStyleName := each
						at: 4
						ifAbsent: [].
			pixelHeight := each
						at: 5
						ifAbsent: [aNumber].
			textStyleName
				ifNil: [pixelHeight := nil].
			textStyle := TextStyle named: textStyleName.
			font := textStyle
						ifNotNil: [pixelHeight
								ifNotNil: [textStyle fontOfSize: pixelHeight]].
			attrArray := self
						attributeArrayForColor: color
						emphasis: emphasis
						font: font.
			attrArray notEmpty
				ifTrue: [d at: element put: attrArray]].
	^ d! !

!SHTextStylerST80 class methodsFor: 'style table' stamp: 'StephaneDucasse 5/1/2013 13:54'!
vintageStyleTable
	"color can be a valid argument to Color class>>colorFrom: , or nil to
	use the editor text color.
	Multiple emphases can be specified using an array e.g. #(bold italic).
	If emphasis is not specified, #normal will be used.
	if pixel height is not specified , then the editor font size will be used.
	
	This style is based on old theme and other old environments.  
	"
	<styleTable: 'Vintage'>
								
 ^ #(
			"(symbol color [emphasisSymbolOrArray [textStyleName [pixelHeight]]])" 
			(default 								black)
			(invalid 									red)
			(excessCode 							red)
			
			(comment 								'006400')
			(unfinishedComment 					(red muchDarker))
			
			(#'$' 									('801f91' lighter))
			(character 								('801f91' lighter))
			(integer 								('801f91'))
			(number 								('801f91'))
			(#- 										('801f91'))
			(symbol 								('801f91')) 
			(stringSymbol 							('801f91')) 
			(literalArray 							black)
			(string 									('801f91'))
												
			(unfinishedString 						red normal)
			(assignment 							nil bold)
			(ansiAssignment 						nil bold)
										
			(literal 									nil italic)
												
			(keyword 								black)
			(binary 									black) 
			(unary 									black)
										
			(#true 									('A31515' darker))
			(#false 									('A31515' darker))
			(#nil 									('A31515' darker))
													
			(#self 									'A31515')
			(#super								'A31515')
			(#thisContext 							'A31515')
			(#return 								'A31515' bold)
												
			(patternArg 							(blue muchDarker)) 
			(methodArg 							(blue muchDarker))
			(blockPatternArg 						(blue muchDarker))
			(blockArg 								(blue muchDarker))
			(argument 								(blue muchDarker))
			(blockTempVar 						(blue muchDarker))
			(blockPatternTempVar 					(blue muchDarker))
								
			(instVar 								(blue muchDarker))
			(workspaceVar 							(blue muchDarker) bold)
										
			(tempVar 								(blue muchDarker))
			(patternTempVar 						(blue muchDarker))
										
			(poolConstant 							(blue muchDarker) bold)
			(classVar 								(blue muchDarker) bold)
			(globalVar 								black bold)
												
		
			(incompleteIdentifier 					blue italic)
			(incompleteKeyword 					blue italic)
			(incompleteBinary 						blue italic) 
			(incompleteUnary 						blue italic)
				
			(undefinedIdentifier 					red)						
			(undefinedKeyword 					red)
			(undefinedBinary 						red) 
			(undefinedUnary 						red) 
			
			(patternKeyword 						nil bold)
			(patternBinary 							nil bold)
			(patternUnary 							nil bold) 
			(blockArgColon 						black)
			(leftParenthesis 						black)
			(rightParenthesis 						black)
			(leftParenthesis1 						(green muchDarker))
			(rightParenthesis1 						(green muchDarker))
			(leftParenthesis2 						(magenta muchDarker))
			(rightParenthesis2 						(magenta muchDarker))
			(leftParenthesis3 						(red muchDarker))
			(rightParenthesis3 						(red muchDarker))
			(leftParenthesis4 						(green darker))
			(rightParenthesis4 						(green darker))
			(leftParenthesis5 						(orange darker))
			(rightParenthesis5 						(orange darker))
			(leftParenthesis6 						(magenta darker))
			(rightParenthesis6 						(magenta darker))
			(leftParenthesis7 						blue)
			(rightParenthesis7 						blue)
			(blockStart 								black)
			(blockEnd 								black)
			(blockStart1 							(green muchDarker))
			(blockEnd1 								(green muchDarker))
			(blockStart2 							(magenta muchDarker))
			(blockEnd2 								(magenta muchDarker))
			(blockStart3 							(red muchDarker))
			(blockEnd3 								(red muchDarker))
			(blockStart4 							(green darker))
			(blockEnd4 								(green darker))
			(blockStart5 							(orange darker))
			(blockEnd5 								(orange darker))
			(blockStart6 							(magenta darker))
			(blockEnd6 								(magenta darker))
			(blockStart7 							blue)
			(blockEnd7 								blue) 
			(arrayStart 								black)
			(arrayEnd 								black)
			(arrayStart1 							black)
			(arrayEnd1 								black)
			(leftBrace 								black)
			(rightBrace 								black)
			(cascadeSeparator 					black bold)
			(statementSeparator 					black bold)
			(methodTempBar 						black)
			(blockTempBar 						black)
			(blockArgsBar 							black)
										
			(externalCallType 						black)
			(externalCallTypePointerIndicator 		black)
			(primitiveOrExternalCallStart 			black bold)
			(primitiveOrExternalCallEnd 			black bold)
			(primitive 								(cyan muchDarker))
			(pragmaKeyword 						(cyan muchDarker))
			(pragmaUnary 							(cyan muchDarker))
			(pragmaBinary 							(cyan muchDarker)) 
			(externalFunctionCallingConvention 	(cyan muchDarker) bold)
			(module 								(cyan muchDarker) bold))! !

!SHTextStylerST80 class methodsFor: 'style table' stamp: 'StephaneDucasse 5/1/2013 13:49'!
solarizedStyleTable
	"color can be a valid argument to Color class>>colorFrom: , or nil to
	use the editor text color.
	Multiple emphases can be specified using an array e.g. #(bold italic).
	If emphasis is not specified, #normal will be used.
	if pixel height is not specified , then the editor font size will be used.
	
	This style is based on old theme and other old environments.  
	"
	<styleTable: 'Solarized'>
								
 ^ #(
			"(symbol color [emphasisSymbolOrArray [textStyleName [pixelHeight]]])" 
			(default 								('657A81' muchDarker))
			(invalid 									red)
			(excessCode 							red)
			
			(comment 								'586E75')
			(unfinishedComment 					(red muchDarker))
			
			(#'$' 									('268BD2' lighter))
			(character 								('268BD2' lighter))
			(integer 								('2AA198'))
			(number 								('2AA198'))
			(#- 										('2AA198'))
			(symbol 								('268BD2')) 
			(stringSymbol 							('268BD2')) 
			(literalArray 							black)
			(string 									('268BD2'))
												
			(unfinishedString 						red normal)
			(assignment 							nil bold)
			(ansiAssignment 						nil bold)
										
			(literal 									nil italic)
												
			(keyword 								nil)
			(binary 									nil) 
			(unary 									nil)
										
			(#true 									('CB4B16' darker))
			(#false 									('CB4B16' darker))
			(#nil 									('CB4B16' darker))
													
			(#self 									'B58900')
			(#super								'B58900')
			(#thisContext 							'B58900')
			(#return 								'B58900' bold)
												
			(patternArg 							('D33682')) 
			(methodArg 							('D33682'))
			(blockPatternArg 						('D33682'))
			(blockArg 								('D33682'))
			(argument 								('D33682'))
			(blockTempVar 						('D33682'))
			(blockPatternTempVar 					('D33682'))
								
			(instVar 								('D33682'))
			(workspaceVar 							('D33682') bold)
										
			(tempVar 								('D33682'))
			(patternTempVar 						('D33682'))
										
			(poolConstant 							('D33682') bold)
			(classVar 								('D33682') bold)
			(globalVar 								('268BD2' muchDarker) bold)
												
			(undefinedIdentifier 					red)
			(incompleteIdentifier 					'D33682' italic)
			(incompleteKeyword 					nil  italic)
			(incompleteBinary 						nil  italic) 
			(incompleteUnary 						nil  italic)
			(undefinedKeyword 					red)
			(undefinedBinary 						red) 
			(undefinedUnary 						red) 
			(patternKeyword 						'657A81' bold)
			(patternBinary 							'657A81' bold)
			(patternUnary 							'657A81' bold) 
			(blockArgColon 						black)
			(leftParenthesis 						black)
			(rightParenthesis 						black)
			(leftParenthesis1 						(green muchDarker))
			(rightParenthesis1 						(green muchDarker))
			(leftParenthesis2 						(magenta muchDarker))
			(rightParenthesis2 						(magenta muchDarker))
			(leftParenthesis3 						(red muchDarker))
			(rightParenthesis3 						(red muchDarker))
			(leftParenthesis4 						(green darker))
			(rightParenthesis4 						(green darker))
			(leftParenthesis5 						(orange darker))
			(rightParenthesis5 						(orange darker))
			(leftParenthesis6 						(magenta darker))
			(rightParenthesis6 						(magenta darker))
			(leftParenthesis7 						blue)
			(rightParenthesis7 						blue)
			(blockStart 								black)
			(blockEnd 								black)
			(blockStart1 							(green muchDarker))
			(blockEnd1 								(green muchDarker))
			(blockStart2 							(magenta muchDarker))
			(blockEnd2 								(magenta muchDarker))
			(blockStart3 							(red muchDarker))
			(blockEnd3 								(red muchDarker))
			(blockStart4 							(green darker))
			(blockEnd4 								(green darker))
			(blockStart5 							(orange darker))
			(blockEnd5 								(orange darker))
			(blockStart6 							(magenta darker))
			(blockEnd6 								(magenta darker))
			(blockStart7 							blue)
			(blockEnd7 								blue) 
			(arrayStart 								black)
			(arrayEnd 								black)
			(arrayStart1 							black)
			(arrayEnd1 								black)
			(leftBrace 								black)
			(rightBrace 								black)
			(cascadeSeparator 					black bold)
			(statementSeparator 					black bold)
			(methodTempBar 						black)
			(blockTempBar 						black)
			(blockArgsBar 							black)
										
			(externalCallType 						black)
			(externalCallTypePointerIndicator 		black)
			(primitiveOrExternalCallStart 			black bold)
			(primitiveOrExternalCallEnd 			black bold)
			(primitive 								(cyan muchDarker))
			(pragmaKeyword 						(cyan muchDarker))
			(pragmaUnary 							(cyan muchDarker))
			(pragmaBinary 							(cyan muchDarker)) 
			(externalFunctionCallingConvention 	(cyan muchDarker) bold)
			(module 								(cyan muchDarker) bold))! !

!SHTextStylerST80 class methodsFor: 'style table' stamp: 'EstebanLorenzano 5/1/2014 09:36'!
darkStyleTable
	"color can be a valid argument to Color class>>colorFrom: , or nil to
	use the editor text color.
	Multiple emphases can be specified using an array e.g. #(bold italic).
	If emphasis is not specified, #normal will be used.
	if pixel height is not specified , then the editor font size will be used.
	
	This style is inspired on darkula theme from eclipse: http://eclipsecolorthemes.org/?view=theme&id=15515.  
	"
	<styleTable: 'Dark'>

 ^ #(
			"(symbol color [emphasisSymbolOrArray [textStyleName [pixelHeight]]])" 
			(default 								white)
			(invalid 								red)
			(excessCode 							red)
			
			(comment 								'7D8C93')
			(unfinishedComment 				red)
			
			(#'$' 									('E38C1E' lighter))
			(character 							('E38C1E' lighter))
			(integer 								('FFE54B'))
			(number 								('FFE54B'))
			(#- 									('FFE54B'))
			(symbol 								('E38C1E')) 
			(stringSymbol 						('E38C1E')) 
			(literalArray 						white)
			(string 								('E38C1E'))
												
			(unfinishedString 					red normal)
			(assignment 							nil bold)
			(ansiAssignment 					nil bold)
										
			(literal 								nil italic)
												
			(keyword 								white)
			(binary 								white) 
			(unary 								white)
										
			(#true 								('00CC6E' darker))
			(#false 								('00CC6E' darker))
			(#nil 									('00CC6E' darker))
													
			(#self 								'00CC6E')
			(#super								'00CC6E')
			(#thisContext 						'00CC6E')
			(#return 								'00CC6E' bold)
												
			(patternArg 							'A7E2ED') 
			(methodArg 							'A7E2ED')
			(blockPatternArg 					'A7E2ED' italic)
			(blockArg 							'A7E2ED' italic)
			(argument 							'A7E2ED')
			(blockTempVar 						'A7E2ED')
			(blockPatternTempVar 				'A7E2ED')
								
			(instVar 								'A7E2ED')
			(workspaceVar 						'A7E2ED' bold)
										
			(tempVar 								'A7E2ED')
			(patternTempVar 					'A7E2ED')
										
			(poolConstant 						'A7E2ED' bold)
			(classVar 							'A7E2ED' bold)
			(globalVar 							white bold)
												
		
			(incompleteIdentifier 			'E8E2B7' italic)
			(incompleteKeyword 				'E8E2B7' italic)
			(incompleteBinary 					'E8E2B7' italic) 
			(incompleteUnary 					'E8E2B7' italic)
				
			(undefinedIdentifier 				red)						
			(undefinedKeyword 					red)
			(undefinedBinary 					red) 
			(undefinedUnary 					red) 
			
			(patternKeyword 					nil bold)
			(patternBinary 						nil bold)
			(patternUnary 						nil bold) 
			(blockArgColon 						white)
			(leftParenthesis 					white)
			(rightParenthesis 					white)
			(leftParenthesis1 					(green muchLighter))
			(rightParenthesis1 				(green muchLighter))
			(leftParenthesis2 					(magenta muchLighter))
			(rightParenthesis2 				(magenta muchLighter))
			(leftParenthesis3 					(red muchLighter))
			(rightParenthesis3 				(red muchLighter))
			(leftParenthesis4 					(green lighter))
			(rightParenthesis4 				(green lighter))
			(leftParenthesis5 					(orange lighter))
			(rightParenthesis5 				(orange lighter))
			(leftParenthesis6 					(magenta lighter))
			(rightParenthesis6 				(magenta lighter))
			(leftParenthesis7 					blue)
			(rightParenthesis7 				blue)
			(blockStart 							white)
			(blockEnd 							white)
			(blockStart1 						(green muchLighter))
			(blockEnd1 							(green muchLighter))
			(blockStart2 						(magenta muchLighter))
			(blockEnd2 							(magenta muchLighter))
			(blockStart3 						(red muchLighter))
			(blockEnd3 							(red muchLighter))
			(blockStart4 						(green lighter))
			(blockEnd4 							(green lighter))
			(blockStart5 						(orange lighter))
			(blockEnd5 							(orange lighter))
			(blockStart6 						(magenta lighter))
			(blockEnd6 							(magenta lighter))
			(blockStart7 						blue)
			(blockEnd7 							blue) 
			(arrayStart 							white)
			(arrayEnd 							white)
			(arrayStart1 						white)
			(arrayEnd1 							white)
			(leftBrace 							white)
			(rightBrace 							white)
			(cascadeSeparator 					white bold)
			(statementSeparator 				white bold)
			(methodTempBar 						white)
			(blockTempBar 						white)
			(blockArgsBar 						white)
										
			(externalCallType 								white)
			(externalCallTypePointerIndicator 		white)
			(primitiveOrExternalCallStart 				white bold)
			(primitiveOrExternalCallEnd 				white bold)
			(primitive 										'B4DD6E')
			(pragmaKeyword 									'B4DD6E')
			(pragmaUnary 									'B4DD6E')
			(pragmaBinary 									'B4DD6E') 
			(externalFunctionCallingConvention 		'B4DD6E' bold)
			(module 											'B4DD6E' bold))! !

!SHTextStylerST80 class methodsFor: 'initialization' stamp: 'AlainPlantec 8/27/2011 15:57'!
initialize
	"self initialize"
	styleTable := nil.
	textAttributesByPixelHeight := nil.
	(PluggableTextMorph respondsTo: #stylingClass:)
		ifTrue: [ PluggableTextMorph stylingClass: self ]! !

!SHTextStylerST80 class methodsFor: 'style table' stamp: 'StephaneDucasse 5/1/2013 13:42'!
attributeArrayForColor: aColorOrNil emphasis: anEmphasisSymbolOrArrayorNil font: aTextStyleOrFontOrNil 

	| emphArray answer |	
	answer := Array new.
	aColorOrNil ifNotNil: [ answer := answer , {TextColor color: aColorOrNil}].
	
	anEmphasisSymbolOrArrayorNil
		ifNotNil: [
			emphArray := anEmphasisSymbolOrArrayorNil isSymbol
						ifTrue: [{anEmphasisSymbolOrArrayorNil}]
						ifFalse: [anEmphasisSymbolOrArrayorNil].
			emphArray do: [:each | 
				each ~= #normal
					ifTrue: [answer := answer , {TextEmphasis perform: each}]]].
	
	aTextStyleOrFontOrNil
		ifNotNil: [ answer := answer , {TextFontReference toFont: aTextStyleOrFontOrNil}].
		
	^ answer! !

!SHTextStylerST80 class methodsFor: 'style table' stamp: ''!
styleTable
	^ styleTable
		ifNil: [styleTable := self defaultStyleTable]! !

!SHTextStylerST80 class methodsFor: 'style table' stamp: ''!
textAttributesByPixelHeight
	^ textAttributesByPixelHeight
		ifNil: [textAttributesByPixelHeight := Dictionary new]! !

!SHTextStylerST80 class methodsFor: 'style table' stamp: 'StephaneDucasse 5/1/2013 13:52'!
blueStyleTable
	"color can be a valid argument to Color class>>colorFrom: , or nil to
	use the editor text color.
	Multiple emphases can be specified using an array e.g. #(bold italic).
	If emphasis is not specified, #normal will be used.
	if pixel height is not specified , then the editor font size will be used.
	"
	<styleTable: 'Blue'>
								
 ^ #(
			"(symbol color [emphasisSymbolOrArray [textStyleName [pixelHeight]]])" 
			(default 								black)
			(invalid 									red)
			(excessCode 							red)
			
			(comment 								(gray darker))
			(unfinishedComment 					(red muchDarker))
			
			(#'$' 									(red muchDarker))
			(character 								(red muchDarker))
			(integer 								(red muchDarker))
			(number 								(red muchDarker)) 
			(#- 										(red muchDarker))
			(symbol 								(magenta muchDarker)) 
			(stringSymbol 							(magenta muchDarker)) 
			(literalArray 							(magenta muchDarker))
			(string 									(magenta muchDarker) normal)										
			(unfinishedString 						red normal)
	
			(assignment 							nil)
			(ansiAssignment 						nil)
	
			(literal 									nil italic)
			(keyword 								(black))
			(binary 									(black)) 
			(unary 									(black))
										
			(#self 									(cyan muchDarker ))
			(#super 								(cyan muchDarker ))
			(#true 									(red muchDarker))
			(#false 									(red muchDarker))
			(#nil 									(red muchDarker))
			(#thisContext 							(cyan muchDarker ))
			(#return 								(cyan muchDarker ) bold)
			(patternArg 							(blue muchDarker)) 
			(methodArg 							(blue muchDarker))
			(blockPatternArg 						(blue muchDarker))
			(blockArg 								(blue muchDarker))
			(argument 								(blue muchDarker))
			(blockTempVar 						(blue muchDarker))
			(blockPatternTempVar 					(blue muchDarker))
			(instVar 								(blue muchDarker))
			(workspaceVar 							(blue muchDarker))
		
			(tempVar 								(blue muchDarker))
			(patternTempVar 						(blue muchDarker))
			(poolConstant 							(blue muchDarker))
			(classVar 								(blue muchDarker))
			(globalVar 								(blue muchDarker))
												
			(incompleteIdentifier 					blue italic)
			(incompleteKeyword 					nil  italic)
			(incompleteBinary 						nil  italic) 
			(incompleteUnary 						nil  italic)					
				
			(undefinedIdentifier 					red)						
			(undefinedKeyword 					red)
			(undefinedBinary 						red) 
			(undefinedUnary 						red) 
	
			(patternKeyword 						nil bold)
			(patternBinary 							nil bold)
			(patternUnary 							nil bold) 
			(blockArgColon 						black)
			(leftParenthesis 						black)
			(rightParenthesis 						black)
			(leftParenthesis1 						(green muchDarker))
			(rightParenthesis1 						(green muchDarker))
			(leftParenthesis2 						(magenta muchDarker))
			(rightParenthesis2 						(magenta muchDarker))
			(leftParenthesis3 						(red muchDarker))
			(rightParenthesis3 						(red muchDarker))
			(leftParenthesis4 						(green darker))
			(rightParenthesis4 						(green darker))
			(leftParenthesis5 						(orange darker))
			(rightParenthesis5 						(orange darker))
			(leftParenthesis6 						(magenta darker))
			(rightParenthesis6 						(magenta darker))
			(leftParenthesis7 						blue)
			(rightParenthesis7 						blue)
			(blockStart 								black)
			(blockEnd 								black)
			(blockStart1 							(green muchDarker))
			(blockEnd1 								(green muchDarker))
			(blockStart2 							(magenta muchDarker))
			(blockEnd2 								(magenta muchDarker))
			(blockStart3 							(red muchDarker))
			(blockEnd3 								(red muchDarker))
			(blockStart4 							(green darker))
			(blockEnd4 								(green darker))
			(blockStart5 							(orange darker))
			(blockEnd5 								(orange darker))
			(blockStart6 							(magenta darker))
			(blockEnd6 								(magenta darker))
			(blockStart7 							blue)
			(blockEnd7 								blue) 
			(arrayStart 								black)
			(arrayEnd 								black)
			(arrayStart1 							black)
			(arrayEnd1 								black)
			(leftBrace 								black)
			(rightBrace 								black)
			(cascadeSeparator 					black)
			(statementSeparator 					black)
			(methodTempBar 						(black))
			(blockTempBar 						(black))
			(blockArgsBar 							(black))
										
			(externalCallType 						black)
			(externalCallTypePointerIndicator 		black)
			(primitiveOrExternalCallStart 			black bold)
			(primitiveOrExternalCallEnd 			black bold)
			(primitive 								(green muchDarker))
			(pragmaKeyword 						(green muchDarker))
			(pragmaUnary 							(green muchDarker))
			(pragmaBinary 							(green muchDarker)) 
			(externalFunctionCallingConvention 	(green muchDarker) bold)
			(module 								(green muchDarker) bold))! !

!SHTextStylerST80 class methodsFor: 'initialization' stamp: 'AlainPlantec 8/27/2011 16:56'!
unload
	(PluggableTextMorph respondsTo: #stylingClass:)
		ifTrue: [ PluggableTextMorph stylingClass: nil ]
	! !

!SHTextStylerST80 class methodsFor: 'style table' stamp: 'Anonymous 8/4/2013 16:46'!
tangoStyleTable
	"color can be a valid argument to Color class>>colorFrom: , or nil to
	use the editor text color.
	Multiple emphases can be specified using an array e.g. #(bold italic).
	If emphasis is not specified, #normal will be used.
	if pixel height is not specified , then the editor font size will be used.
	
	This is a syntax coloring scheme based on the tango desktop icon scheme:
	http://tango.freedesktop.org/Tango_Icon_Theme_Guidelines
	"
	<styleTable: 'Tango'>
								
 ^ #(
			"(symbol color [emphasisSymbolOrArray [textStyleName [pixelHeight]]])" 
			(default 								black)
			(invalid 									red)
			(excessCode 							red)
			
			(comment 								'888a85')
			(unfinishedComment 					(red muchDarker))
			
			(#'$' 									'ce5c00')
			(character 								'ce5c00')
			(integer 								'8f5902')
			(number 								'8f5902')
			(#- 										'8f5902')
			(symbol 								'c4a000') 
			(stringSymbol 							'c4a000') 
			(literalArray 							black)
			(string 									'ce5c00')
												
			(unfinishedString 						red normal)
			(assignment 							nil)
			(ansiAssignment 						nil)
										
			(literal 									'8F5902')
												
			(keyword 								(black))
			(binary 									(black)) 
			(unary 									(black))
										
			(#true 									'8F5902')
			(#false 									'8F5902')
			(#nil 									'8F5902')
													
			(#self 									'4d9a06')
			(#super 								'4d9a06')
			(#thisContext 							'4d9a06')
			(#return 								black bold)
												
			(patternArg 							'2e3426' italic) 
			(methodArg 							'555753' italic)
			(blockPatternArg 						'888a85' bold)
			(blockArg 								'555753' italic)
			(argument 								'555753' italic)
			(blockTempVar 						'555753' italic)
			(blockPatternTempVar 					'888a85' italic)
								
			(instVar 								'204a87')
			(workspaceVar 							'204a87')
										
			(tempVar 								'555753' italic)
			(patternTempVar 						'888a85' italic)
										
			(poolConstant 							'ad7fa8' bold)
			(classVar 								'ad7fa8' bold)
			(globalVar 								'5c3566' bold)
												
			
			(incompleteIdentifier 					blue italic)
			(incompleteKeyword 					blue italic)
			(incompleteBinary 						blue italic) 
			(incompleteUnary 						blue italic)
									
			(undefinedIdentifier 					red)						
			(undefinedKeyword 					red)
			(undefinedBinary 						red) 
			(undefinedUnary 						red) 
			(patternKeyword 						nil bold)
			(patternBinary 							nil bold)
			(patternUnary 							nil bold) 
			(blockArgColon 						black)
			(leftParenthesis 						black)
			(rightParenthesis 						black)
			(leftParenthesis1 						(green muchDarker))
			(rightParenthesis1 						(green muchDarker))
			(leftParenthesis2 						(magenta muchDarker))
			(rightParenthesis2 						(magenta muchDarker))
			(leftParenthesis3 						(red muchDarker))
			(rightParenthesis3 						(red muchDarker))
			(leftParenthesis4 						(green darker))
			(rightParenthesis4 						(green darker))
			(leftParenthesis5 						(orange darker))
			(rightParenthesis5 						(orange darker))
			(leftParenthesis6 						(magenta darker))
			(rightParenthesis6 						(magenta darker))
			(leftParenthesis7 						blue)
			(rightParenthesis7 						blue)
			(blockStart 								black)
			(blockEnd 								black)
			(blockStart1 							(green muchDarker))
			(blockEnd1 								(green muchDarker))
			(blockStart2 							(magenta muchDarker))
			(blockEnd2 								(magenta muchDarker))
			(blockStart3 							(red muchDarker))
			(blockEnd3 								(red muchDarker))
			(blockStart4 							(green darker))
			(blockEnd4 								(green darker))
			(blockStart5 							(orange darker))
			(blockEnd5 								(orange darker))
			(blockStart6 							(magenta darker))
			(blockEnd6 								(magenta darker))
			(blockStart7 							blue)
			(blockEnd7 								blue) 
			(arrayStart 								black)
			(arrayEnd 								black)
			(arrayStart1 							black)
			(arrayEnd1 								black)
			(leftBrace 								black)
			(rightBrace 								black)
			(cascadeSeparator 					black)
			(statementSeparator 					black)
			(methodTempBar 						black)
			(blockTempBar 						black)
			(blockArgsBar 							black)
										
			(externalCallType 						black)
			(externalCallTypePointerIndicator 		black)
			(primitiveOrExternalCallStart 			black bold)
			(primitiveOrExternalCallEnd 			black bold)
			(primitive 								(green muchDarker))
			(pragmaKeyword 						(green muchDarker))
			(pragmaUnary 							(green muchDarker))
			(pragmaBinary 							(green muchDarker)) 
			(externalFunctionCallingConvention 	(green muchDarker) bold)
			(module 								(green muchDarker) bold))! !

!SHWorkspaceEditingMode commentStamp: 'AlainPlantec 9/20/2011 17:13'!
By default, shout styling is into a method editing mode. If you need a script editor for example, then you have to setup shout into a workspace mode. In order to setup a workspace mode, one have to make it available the workspace instance to the view styler. Typically, the workspace inspace is the model instance itself. See the sent of the #workspace: message into the #open method:

open
	...
	editor := window newTextEditorFor:  self getText:  #code setText: #code: getEnabled: nil. 
	editor styler workspace: self. 
	...
	^ window openInWorld

The workspace class has also to implement #hasBindingOf: and #hasBindingThatBeginsWith:. In fact, #hasBindingOf: and #hasBindingThatBeginsWith: are sent to the workspace by shout during styling. As an example, see the #bindings method implemented here:

bindings
	^ #('shout' 'styling')

It returns a list of symbols which is used by #hasBindingOf: and #hasBindingThatBeginsWith:. 
Then open an editor with:

SHWorkspaceEditingMode new open

If you enter the word 'shout' as an example, you will see that the word is recognized as a variable name.
!
!SHWorkspaceEditingMode methodsFor: 'accessing' stamp: 'AlainPlantec 9/4/2011 10:19'!
code
	^ code ifNil: [code := '' asText]! !

!SHWorkspaceEditingMode methodsFor: 'bindings' stamp: 'AlainPlantec 9/4/2011 10:31'!
hasBindingThatBeginsWith: aString
	^ self bindings anySatisfy: [:s | s beginsWith: aString]
! !

!SHWorkspaceEditingMode methodsFor: 'accessing' stamp: 'AlainPlantec 9/4/2011 10:19'!
code: someText
	code := someText.
	self changed: #code! !

!SHWorkspaceEditingMode methodsFor: 'bindings' stamp: 'AlainPlantec 9/4/2011 10:30'!
hasBindingOf: aString
	^ self bindings includes: aString asSymbol.! !

!SHWorkspaceEditingMode methodsFor: 'private bindings' stamp: 'AlainPlantec 9/20/2011 16:54'!
bindings
	^ #('shout' 'example')! !

!SHWorkspaceEditingMode methodsFor: 'view' stamp: 'AlainPlantec 9/20/2011 17:16'!
open
	| window editor |
	window := (StandardWindow labelled: 'Editor with Workspace like  syntax highlighting') model: self.
	editor := window newTextEditorFor:  self getText:  #code setText: #code: getEnabled: nil. 
	"Set-up the styler to be in workspace mode"
	editor styler workspace: self.
	window addMorph: editor frame: (0@0 extent: 1@1).
	^ window openInWorld! !

!SHWorkspaceEditingMode methodsFor: 'shout' stamp: 'MarcusDenker 8/9/2014 12:55'!
shoutAboutToStyle: aTextView
	^ true! !

!SMTPClient commentStamp: 'mir 2/21/2002 16:57'!
This class implements the SMTP (mail sending) protocol specified in RFC 821.

HELO <SP> <domain> <CRLF>

MAIL <SP> FROM:<reverse-path> <CRLF>

RCPT <SP> TO:<forward-path> <CRLF>

DATA <CRLF>

RSET <CRLF>

SEND <SP> FROM:<reverse-path> <CRLF>

SOML <SP> FROM:<reverse-path> <CRLF>

SAML <SP> FROM:<reverse-path> <CRLF>

VRFY <SP> <string> <CRLF>

EXPN <SP> <string> <CRLF>

HELP [<SP> <string>] <CRLF>

NOOP <CRLF>

QUIT <CRLF>

TURN <CRLF>

!
!SMTPClient methodsFor: 'private protocol' stamp: 'nice 1/5/2010 15:59'!
data: messageData
	"send the data of a message"
	"DATA <CRLF>"

	

	"inform the server we are sending the message data"
	self sendCommand: 'DATA'.
	self checkResponse.

	"process the data one line at a time"
	messageData linesDo:  [ :messageLine | | cookedLine |
		cookedLine := messageLine.
		(cookedLine beginsWith: '.') ifTrue: [ 
			"lines beginning with a dot must have the dot doubled"
			cookedLine := '.', cookedLine ].
		self sendCommand: cookedLine ].

	"inform the server the entire message text has arrived"
	self sendCommand: '.'.
	self checkResponse.! !

!SMTPClient methodsFor: 'private protocol' stamp: 'fbs 3/23/2004 17:16'!
mailFrom: fromAddress
	" MAIL <SP> FROM:<reverse-path> <CRLF>"

	| address |
	address := (MailAddressParser addressesIn: fromAddress) first.

	self sendCommand: 'MAIL FROM: <', address, '>'.
	self checkResponse.! !

!SMTPClient methodsFor: 'private protocol' stamp: 'mir 2/21/2002 17:52'!
quit
	"send a QUIT command.  This is polite to do, and indeed some servers might drop messages that don't have an associated QUIT"
	"QUIT <CRLF>"

	self sendCommand: 'QUIT'.
	self checkResponse.! !

!SMTPClient methodsFor: 'private protocol' stamp: 'mir 2/21/2002 17:52'!
recipient: aRecipient
	"specify a recipient for the message.  aRecipient should be a bare email address"
	"RCPT <SP> TO:<forward-path> <CRLF>"

	self sendCommand: 'RCPT TO: <', aRecipient, '>'.
	self checkResponse.! !

!SMTPClient methodsFor: 'public protocol' stamp: 'gk 8/4/2006 15:14'!
useHelo
	"If client use HELO instead of EHLO. HELO is the old protocol and
	an old server may require it instead of EHLO."

	^self connectionInfo at: #useHelo ifAbsent: [false]! !

!SMTPClient methodsFor: 'public protocol' stamp: 'StephaneDucasse 1/3/2010 21:34'!
localHostName
	"The local host name for purposes of identifying the the server.
 	If nil, NetNameResolver localHostName will be used."
 
 	^self connectionInfo at: #localHostName ifAbsent: [NetNameResolver localHostName]! !

!SMTPClient methodsFor: 'public protocol' stamp: 'StephaneDucasse 1/3/2010 21:34'!
localHostName: aString
	"The local host name for purposes of identifying the the server.
 	If nil, NetNameResolver localHostName will be used."
 
 	^self connectionInfo at: #localHostName put: aString! !

!SMTPClient methodsFor: 'public protocol' stamp: 'mir 2/21/2002 15:43'!
mailFrom: sender to: recipientList text: messageText
	"deliver this mail to a list of users.  NOTE: the recipient list should be a collection of simple internet style addresses -- no '<>' or '()' stuff"

	self mailFrom: sender.
	recipientList do: [ :recipient |
		self recipient: recipient ].
	self data: messageText.
! !

!SMTPClient methodsFor: 'utility' stamp: 'StephaneDucasse 1/3/2010 21:31'!
encodeString: aString 
	| str dec out |
	str := String new: (aString size * 4 / 3 + 3) ceiling.
	dec := Base64MimeConverter new.
	dec
		mimeStream: (out := str writeStream) ;
		dataStream: aString readStream;
		mimeEncode.
	^out contents! !

!SMTPClient methodsFor: 'private protocol' stamp: 'gk 8/4/2006 15:15'!
initiateSession
	"EHLO <SP> <domain> <CRLF>"

	self sendCommand: (self useHelo ifTrue:['HELO '] ifFalse: ['EHLO ']) , NetNameResolver localHostName.
	self checkResponse.
! !

!SMTPClient methodsFor: 'private protocol' stamp: 'MarcusDenker 2/14/2010 20:16'!
login
	self initiateSession. "send EHLO first"
	self user ifNil: [^self].
	self sendCommand: 'AUTH LOGIN ' , (self encodeString: self user).
	[self checkResponse]
		on: TelnetProtocolError
		do: [ :ex | ex isCommandUnrecognized ifTrue: [^ self] ifFalse: [ex pass]].
	self sendCommand: (self encodeString: self password).
	self checkResponse! !

!SMTPClient methodsFor: 'public protocol' stamp: 'gk 8/4/2006 15:14'!
useHelo: aBoolean
	"Tell client to use HELO instead of EHLO. HELO is the old protocol and
	an old server may require it instead of EHLO."

	^self connectionInfo at: #useHelo put: aBoolean! !

!SMTPClient class methodsFor: 'accessing' stamp: 'mir 2/21/2002 17:22'!
defaultPortNumber
	^25! !

!SMTPClient class methodsFor: 'sending mail' stamp: 'SeanDeNigris 12/6/2011 14:32'!
deliverMailFrom: fromAddress to: recipientList text: messageText usingServer: aString
	"Deliver a single email to a list of users and then close the connection.  For delivering multiple messages, it is best to create a single connection and send all mail over it
	recipientList - a collection of simple internet style addresses -- no '<>' or '()' stuff
	aString - can be
		- server name and port number e.g. mail.mydomain.com:26
		- server name only e.g. mail.mydomain.com, default port is used"

	| smtpClient |
	smtpClient := self openOnHostNamed: aString.
	[smtpClient initiateSession.
	smtpClient mailFrom: fromAddress to: recipientList text: messageText.
	smtpClient quit]
		ensure: [smtpClient close]
! !

!SMTPClient class methodsFor: 'sending mail' stamp: 'SeanDeNigris 12/6/2011 14:31'!
deliver: aMailMessage usingServer: aString
	"See comment for #deliverMailFrom:to:text:usingServer:"
	
	self deliverMailFrom: aMailMessage from to: aMailMessage recipientList text: aMailMessage text usingServer: aString.! !

!SMTPClient class methodsFor: 'example' stamp: 'adrian_lienhard 7/18/2009 16:00'!
example
	"SMTPClient example"

	self deliverMailFrom: 'm.rueger@acm.org' to: #('m.rueger@acm.org') text:
'From: test
To: "not listed"
Subject: this is a test

Hello from Pharo!!
'	usingServer: 'smtp.concentric.net'! !

!SMTPClient class methodsFor: 'example' stamp: 'adrian_lienhard 7/18/2009 16:00'!
example2
	"SMTPClient example2"

	self deliverMailFrom: 'm.rueger@acm.org' to: #('m.rueger@acm.org') text:
'Subject: this is a test

Hello from Pharo!!
'	usingServer: 'smtp.concentric.net'! !

!SMTPClient class methodsFor: 'accessing' stamp: 'mir 2/25/2002 19:07'!
logFlag
	^#smtp! !

!SMTPClientTest commentStamp: 'TorstenBergmann 2/5/2014 10:11'!
SUnit tests for SMTP client!
!SMTPClientTest methodsFor: 'testing' stamp: 'fbs 3/23/2004 17:15'!
testMailFrom
	smtp mailFrom: 'frank@angband.za.org'.
	self assert: socket outStream contents = ('MAIL FROM: <frank@angband.za.org>', String crlf).
	
	socket resetOutStream.
	smtp mailFrom: '<frank@angband.za.org>'.
	self assert: socket outStream contents = ('MAIL FROM: <frank@angband.za.org>', String crlf).
	
	socket resetOutStream.
	smtp mailFrom: 'Frank <frank@angband.za.org>'.
	self assert: socket outStream contents = ('MAIL FROM: <frank@angband.za.org>', String crlf).! !

!SMTPClientTest methodsFor: 'running' stamp: 'fbs 3/22/2004 13:11'!
setUp
	socket := MockSocketStream on: ''.
	smtp := SMTPClient new.
	smtp stream: socket.! !

!SQSurfaceDispatch commentStamp: 'IgorStasenko 12/30/2011 12:35'!
A structure from SurfacePlugin.h 
 

typedef struct sqSurfaceDispatch {
	/* Version information. Must be provided by the client
	   so the surface manager can check if certain operations
	   are supported. */
	int majorVersion;
	int minorVersion;

	/* Version 1.0 */
	fn_getSurfaceFormat getSurfaceFormat;
	fn_lockSurface lockSurface;
	fn_unlockSurface unlockSurface;
	fn_showSurface showSurface;
} sqSurfaceDispatch; 
!
!SQSurfaceDispatch methodsFor: 'initialize-release' stamp: 'IgorStasenko 12/30/2011 12:35'!
initialize
	self
		majorVersion: 1; 
		minorVersion: 0! !

!SQSurfaceDispatch class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 12/30/2011 12:30'!
fieldsDesc

"
A structure from SurfacePlugin.h 
 

typedef struct sqSurfaceDispatch {
	/* Version information. Must be provided by the client
	   so the surface manager can check if certain operations
	   are supported. */
	int majorVersion;
	int minorVersion;

	/* Version 1.0 */
	fn_getSurfaceFormat getSurfaceFormat;
	fn_lockSurface lockSurface;
	fn_unlockSurface unlockSurface;
	fn_showSurface showSurface;
} sqSurfaceDispatch; 
"
	^ #(
		int majorVersion;
		int minorVersion;
		void* getSurfaceFormatFn;
		void* lockSurfaceFn;
		void* unlockSurfaceFn;
		void* showSurfaceFn
	)! !

!STCommandLineHandler commentStamp: '<historical>'!
Usage: st [--help] [ --quit ] <FILE>
	--help    list this help message
	--quit    if specified, the image exits without saving after evaluating FILE
	--save    if specified, save the image after evaluating FILE
	<FILE>    a file containing valid Pharo expressions

Documentation:
The ST command line handler runs Pharo code stored in a file without quiting.

Example:

	pharo Pharo.image st code.st
	
	# By default files ending in .st are recognized and evaluated
	pharo Pharo.image code.st!
!STCommandLineHandler methodsFor: 'loading' stamp: 'CamilloBruni 5/1/2012 20:51'!
loadSourceFiles: anArray
	"Load all the source files in the given array."

	sourceFiles := anArray collect: [ :each | 
						(FileSystem disk resolve: each) asFileReference ].
! !

!STCommandLineHandler methodsFor: 'private' stamp: 'CamilloBruni 7/17/2013 16:20'!
handleError: error reference: aReference
	"Print a header before failing on an errro / syntax notification from the the script loaded by the given request"
	| fileReference |
	
	"We ignore warnings for now"
	(error isKindOf: OCSemanticWarning)
		ifTrue: [ ^ error pass ].
		
	"try to get the proper file"
	fileReference := aReference.
	((error isKindOf: OCSemanticError) and: [ error requestor isNotNil ])
		ifTrue: [ fileReference := error requestor fileReference ].
	
	"spit out a warning if in headless mode, otherwise a debugger will popup"
	Smalltalk isHeadless 
		ifTrue: [ self inform: 'Errors in script loaded from ', fileReference fullName ].
															
	"for syntax errors we can use the default action"															
	(error isKindOf: SyntaxErrorNotification)
		ifTrue: [ ^ error defaultAction ].
	
	(error isKindOf: OCSemanticError)
		ifTrue: [ 
			self class printCompilerWarning: error.
			^ error resume: error defaultAction ].
	
	"otherwise resignal it"
	error pass.! !

!STCommandLineHandler methodsFor: 'private' stamp: 'CamilloBruni 4/28/2012 21:48'!
handleError: error	
	
	"for syntax errors we can used the default action"	"otherwise resignal it"
	(error isKindOf: SyntaxErrorNotification)
		ifTrue: [ error defaultAction ]
		ifFalse: [ error pass ]! !

!STCommandLineHandler methodsFor: 'installing' stamp: 'CamilloBruni 7/17/2013 16:21'!
handleErrorsDuring: aBlock reference: aReference
	aBlock
		on: Error, OCSemanticWarning, OCSemanticError
		do: [ :e | self handleError: e reference: aReference ]! !

!STCommandLineHandler methodsFor: 'installing' stamp: 'CamilloBruni 7/17/2013 15:08'!
installSourceFile: aReference
	"Install the the source file given by aFileReference"
	| codeImporter |

	" parse the code given in the source file"
	aReference readStreamDo: [ :stream |
		self 
			handleErrorsDuring: [ 
				codeImporter := CodeImporter fileStream: stream.
				codeImporter skipShebang parseDeclarations ]
			reference: aReference ].
	
	"evaluate the declarations in a second step to allow for properly closing the source file stream"
	self 
		handleErrorsDuring: [ codeImporter evaluate ]
		reference: aReference.! !

!STCommandLineHandler methodsFor: 'installing' stamp: 'CamilloBruni 7/10/2013 16:09'!
installSourceFiles
	"Install the previously loaded source files"

	sourceFiles ifNil: [ ^ self ].
	[ sourceFiles do: [ :reference | 
		self installSourceFile: reference ]
	] ensure: [ sourceFiles := nil ].
	! !

!STCommandLineHandler methodsFor: 'private' stamp: 'CamilloBruni 11/6/2013 21:40'!
end
	| quit  |
	
	quit := self commandLine hasOption: 'quit'.
	
	(self commandLine hasOption: 'save') 
		ifTrue: [ Smalltalk snapshot: true andQuit: quit ].
	
	quit
		ifTrue: [ self exitSuccess ].! !

!STCommandLineHandler methodsFor: 'activation' stamp: 'CamilloBruni 11/6/2013 21:40'!
activate
	self activateHelp
		ifTrue: [  ^ self ].
	
	self loadSourceFiles: (self commandLine allFilesWithExtension: 'st').
	self installSourceFiles.
	
	self end! !

!STCommandLineHandler class methodsFor: 'handler selection' stamp: 'CamilloBruni 5/2/2012 11:31'!
isResponsibleFor: aCommandLine
	"This handler is reponsible only for .st files"
	(aCommandLine hasFileWithExtension: '.st')
		ifTrue: [ ^ true ].
	^ super isResponsibleFor: aCommandLine! !

!STCommandLineHandler class methodsFor: 'printing' stamp: 'CamilloBruni 7/10/2013 16:28'!
printCompilerWarning: aSyntaxErrorNotification
	| stderr position contents errorLine errorMessage maxLineNumberSize lineNumber |
	
	"format the error"
	position := aSyntaxErrorNotification location.
	contents := aSyntaxErrorNotification errorCode.
	errorLine := contents lineNumberCorrespondingToIndex: position.
	stderr := VTermOutputDriver stderr.
		
	"first gather the error title to be able to underline it properly"
	errorMessage := String streamContents: [ :s|
		s nextPutAll: 'Syntax Error on line '; 
			print: errorLine; nextPutAll: ': '; 
			print: aSyntaxErrorNotification errorMessage].
	
	 stderr red;
		nextPutAll: errorMessage; lf;
		nextPutAll: ('' padLeftTo: errorMessage size with: $=); lf.
	
	"print each source line and mark the found syntax error"
	maxLineNumberSize := contents lines size asString size.
	lineNumber := 0.
	contents lineIndicesDo: [:start :endWithoutDelimiters :end |
		lineNumber := lineNumber + 1.
		lineNumber == errorLine 
			ifTrue: [ stderr red ]
			ifFalse:[ stderr white ].
		"0 pad the line numbers to the same size"
		stderr 
			nextPutAll: (lineNumber asString padLeftTo: maxLineNumberSize with: $0);
			nextPutAll: ': '.
		
		stderr white; 
			nextPutAll: (contents copyFrom: start to: endWithoutDelimiters);
			lf.
		"print the marker under the error line"
		(lineNumber == errorLine) ifTrue: [
			stderr red
				nextPutAll:( '_^_' padLeftTo: position - start + maxLineNumberSize + 4);
				lf ]]! !

!STCommandLineHandler class methodsFor: 'accessing' stamp: 'CamilloBruni 2/6/2013 18:18'!
description
	^ 'Loads and executes .st source files'! !

!STCommandLineHandler class methodsFor: 'accessing' stamp: 'CamilloBruni 5/2/2012 11:35'!
commandName
	^ 'st'! !

!STCommandLineHandlerTest methodsFor: 'coverage' stamp: 'CamilloBruni 7/3/2013 15:46'!
classToBeTested
	^ STCommandLineHandler! !

!STCommandLineHandlerTest methodsFor: 'tests' stamp: 'CamilloBruni 7/3/2013 15:45'!
testCommandLineHandlerCondition
	| commandLine reference |
	
	commandLine := CommandLineArguments withArguments: {'/non/existing/file.st'}. 
	"the reponsibility is transfered tot the BasicCodeLoader as soon as there is a .st file in the arguments"
	self assert: (STCommandLineHandler isResponsibleFor: commandLine).
		
	[ reference := FileSystem disk workingDirectory / 'codeLoad1.st'.
	  reference writeStreamDo: [ :stream | stream nextPutAll: '42' ].
	  commandLine := CommandLineArguments withArguments: {reference fullName}. 
	  self assert: (STCommandLineHandler isResponsibleFor: commandLine) ]
	ensure: [ reference delete ]
! !

!STCommandLineHandlerTest methodsFor: 'tests' stamp: 'CamilloBruni 7/3/2013 15:45'!
testInstallSourceFilesFail
	| codeLoader |
	
	codeLoader := STCommandLineHandler new.
	codeLoader loadSourceFiles: {'codeLoad1.st'}.
	"Ensure file is not there"
	(FileSystem disk workingDirectory / 'codeLoad1.st') asFileReference ensureDelete. 
	"Trying non existing file"
	self should: [ codeLoader installSourceFiles ] raise: Error.! !

!STCommandLineHandlerTest methodsFor: 'tests' stamp: 'CamilloBruni 7/3/2013 15:45'!
testLoadSourceFiles
	| codeLoader |
	
	codeLoader := STCommandLineHandler new.
	
	codeLoader loadSourceFiles: {
		'/not/existing/codeLoad1.st'. 
		'/not/existing/codeLoad2.st'}.
	
	self assert: (codeLoader instVarNamed: 'sourceFiles') notNil.
	self assert: (codeLoader instVarNamed: 'sourceFiles') size = 2.
	self assert: ((codeLoader instVarNamed: 'sourceFiles') allSatisfy: [ :each | each isKindOf: FileReference ]).! !

!SUnitAPIDocumentation commentStamp: 'TorstenBergmann 2/12/2014 23:13'!
SUnit API documentation for help system!
!SUnitAPIDocumentation class methodsFor: 'accessing' stamp: 'tbn 12/16/2010 22:39'!
bookName
	^'API Documentation'! !

!SUnitAPIDocumentation class methodsFor: 'defaults' stamp: 'tbn 12/16/2010 22:39'!
builder
	^PackageAPIHelpBuilder! !

!SUnitAPIDocumentation class methodsFor: 'accessing' stamp: 'StephanEggermont 12/9/2013 19:54'!
helpPackages
	^#('SUnit-Core-Announcements' 'SUnit-Core-Extensions' 'SUnit-Core-Kernel' 'SUnit-Core-Kernel' 'SUnit-Core-Utilities' 'SUnit-Tests' 'SUnit-UI')! !

!SUnitExtensionsTest commentStamp: 'TorstenBergmann 2/12/2014 23:15'!
SUnit tests for extensions to SUnit!
!SUnitExtensionsTest methodsFor: 'real tests' stamp: 'md 8/2/2006 11:05'!
validShouldNotTakeMoreThan

	self should: [(Delay forMilliseconds: 100) wait] notTakeMoreThan:  200 milliSeconds.! !

!SUnitExtensionsTest methodsFor: 'real tests' stamp: 'mx 3/20/2006 23:47'!
shouldRaiseWithExceptionDoTest

	self 
		should: [ Error signal: '1' ]
		raise: Error
		withExceptionDo: [ :anException | self assert: anException messageText = '1' ]! !

!SUnitExtensionsTest methodsFor: 'real tests' stamp: 'mx 3/20/2006 23:47'!
shouldRaiseWithSignalDoTest

	self 
		should: [ Error signal: '1' ]
		raise: Error
		withExceptionDo: [ :anException | self assert: anException messageText = '1' ]! !

!SUnitExtensionsTest methodsFor: 'test' stamp: ''!
testAutoAssertTrue
	self assert: 1 = 1.
	self assert: true! !

!SUnitExtensionsTest methodsFor: 'tests' stamp: 'CamilloBruni 10/16/2013 18:13'!
testNoExceptionWithNoMatchingString
	self
		shouldnt: [ Object messageNotUnderstoodByObject ]
		raise: MessageNotUnderstood
		whoseDescriptionDoesNotInclude: 'messageNotUnderstoodByObject'
		description: 'tested obsoleting Object'! !

!SUnitExtensionsTest methodsFor: 'real tests' stamp: ''!
validShouldNotTakeMoreThanMilliseconds

	self should: [(Delay forMilliseconds: 100) wait] notTakeMoreThanMilliseconds: 200! !

!SUnitExtensionsTest methodsFor: 'real tests' stamp: 'EstebanLorenzano 11/11/2010 17:13'!
invalidShouldNotTakeMoreThan

	self should: [(Delay forMilliseconds: 100) wait] notTakeMoreThan: 50 milliSeconds.! !

!SUnitExtensionsTest methodsFor: 'testing' stamp: ''!
isLogging
	^true! !

!SUnitExtensionsTest methodsFor: 'real tests' stamp: 'mx 3/20/2006 23:47'!
assertionFailedInRaiseWithExceptionDoTest

	self 
		should: [ Error signal ]
		raise: Error
		withExceptionDo: [ :anException | self assert: false ]! !

!SUnitExtensionsTest methodsFor: 'test' stamp: 'mx 3/20/2006 23:40'!
testErrorInRaiseWithExceptionDo

	| testCase testResult  |
	
	testCase := self class selector: #errorInRaiseWithExceptionDoTest.
	testResult := testCase run.
		
	self assert: (testResult errors includes: testCase).
	self assert: testResult errors size=1.
	self assert: testResult failures isEmpty.
	self assert: testResult passed isEmpty.
	
	! !

!SUnitExtensionsTest methodsFor: 'real tests' stamp: ''!
shouldFixTest

	self shouldFix: [ Error signal: 'any kind of error' ]
! !

!SUnitExtensionsTest methodsFor: 'test' stamp: 'mx 3/20/2006 23:40'!
testShouldRaiseWithExceptionDo

	| testCase testResult  |
	
	testCase := self class selector: #shouldRaiseWithExceptionDoTest.
	testResult := testCase run.
	
	self assert: (testResult passed includes: testCase).
	self assert: testResult passed size=1.
	self assert: testResult failures isEmpty.
	self assert: testResult errors isEmpty.
	
	! !

!SUnitExtensionsTest methodsFor: 'real tests' stamp: 'mx 3/20/2006 23:47'!
noExceptionInShouldRaiseWithExceptionDoTest

	self 
		should: [  ]
		raise: Error
		withExceptionDo: [ :anException | Error signal: 'Should not get here' ]! !

!SUnitExtensionsTest methodsFor: 'test support' stamp: ''!
failureLog
	^self stream! !

!SUnitExtensionsTest methodsFor: 'accessing' stamp: 'GuillermoPolito 9/1/2010 18:24'!
stream
	^stream ifNil: [stream := String new writeStream].! !

!SUnitExtensionsTest methodsFor: 'tests' stamp: 'md 4/2/2006 14:02'!
testExceptionWithMatchingString
	self should: [ Object obsolete ] raise: Error whoseDescriptionIncludes: 'NOT obsolete' description: 'tested obsoleting Object'! !

!SUnitExtensionsTest methodsFor: 'tests' stamp: 'CamilloBruni 10/16/2013 18:12'!
testNoExceptionWithMatchingString
	self 
		shouldnt: [ Object messageNotUnderstoodByObject ]
		raise: MessageNotUnderstood 
		whoseDescriptionIncludes: 'Zero'
		description: 'tested obsoleting Object'! !

!SUnitExtensionsTest methodsFor: 'test' stamp: ''!
testValidShouldNotTakeMoreThanMilliseconds

	| testCase testResult |

	testCase := self class selector: #validShouldNotTakeMoreThanMilliseconds.
	testResult := testCase run.

	self assert: (testResult passed includes: testCase).
	self assert: testResult passed size = 1.
	self assert: testResult failures isEmpty.
	self assert: testResult errors isEmpty

! !

!SUnitExtensionsTest methodsFor: 'real tests' stamp: 'mx 3/20/2006 23:47'!
differentExceptionInShouldRaiseWithExceptionDoTest

	[ self 
		should: [ Error signal ]
		raise: Halt
		withExceptionDo: [ :anException | self assert: false description: 'should:raise:withExceptionDo: handled an exception that should not handle'] ]
	on: Error
	do: [ :anException | anException return: nil ]! !

!SUnitExtensionsTest methodsFor: 'tests' stamp: 'CamilloBruni 10/16/2013 18:13'!
testExceptionWithoutMatchingString
	self 
		should: [ Object obsolete ]
		raise: Error
		whoseDescriptionDoesNotInclude: 'Zero'
		description: 'tested obsoleting Object'! !

!SUnitExtensionsTest methodsFor: 'test' stamp: 'mx 3/20/2006 23:40'!
testDifferentExceptionInShouldRaiseWithExceptionDo

	| testCase testResult  |
	
	testCase := self class selector: #differentExceptionInShouldRaiseWithExceptionDoTest.
	testResult := testCase run.
	
	self assert: (testResult passed includes: testCase).
	self assert: testResult errors isEmpty.
	self assert: testResult failures isEmpty.
	self assert: testResult passed size=1! !

!SUnitExtensionsTest methodsFor: 'test' stamp: 'mx 3/20/2006 23:40'!
testNoExceptionInShouldRaiseWithExceptionDo

	| testCase testResult  |
	
	testCase := self class selector: #noExceptionInShouldRaiseWithExceptionDoTest.
	testResult := testCase run.
	
	self assert: (testResult failures includes: testCase).
	self assert: testResult failures size=1.
	self assert: testResult passed isEmpty.
	self assert: testResult errors isEmpty.
	
	! !

!SUnitExtensionsTest methodsFor: 'test' stamp: ''!
testShouldFix

	| testCase testResult  |
	
	testCase := self class selector: #shouldFixTest.
	testResult := testCase run.
	
	self assert: (testResult passed includes: testCase).
	self assert: testResult passed size=1.
	self assert: testResult failures isEmpty.
	self assert: testResult errors isEmpty.
	
	! !

!SUnitExtensionsTest methodsFor: 'test' stamp: ''!
testInvalidShouldNotTakeMoreThanMilliseconds

	| testCase testResult |

	testCase := self class selector: #invalidShouldNotTakeMoreThanMilliseconds.
	testResult := testCase run.

	self assert: testResult passed isEmpty.
	self assert: testResult failures size = 1.
	self assert: (testResult failures includes: testCase).
	self assert: testResult errors isEmpty

! !

!SUnitExtensionsTest methodsFor: 'test' stamp: 'BernardoContreras 3/4/2015 16:17'!
testAutoAssertFalse
	| booleanCondition |
	self assert: self isLogging.
	self should: [ self assert: 1 = 2 description: 'self assert: 1 = 2' ] raise: self defaultTestFailure.
	booleanCondition := (self stream contents substrings: {Character cr}) last = 'self assert: 1 = 2'.
	self assert: booleanCondition! !

!SUnitExtensionsTest methodsFor: 'test' stamp: 'md 8/2/2006 11:06'!
testValidShouldNotTakeMoreThan
	| testCase testResult |

	testCase := self class selector: #validShouldNotTakeMoreThan.
	testResult := testCase run.

	self assert: (testResult passed includes: testCase).
	self assert: testResult passed size = 1.
	self assert: testResult failures isEmpty.
	self assert: testResult errors isEmpty

! !

!SUnitExtensionsTest methodsFor: 'test' stamp: 'BernardoContreras 3/4/2015 16:16'!
testAutoDenyFalse
	| booleanCondition |
	self assert: self isLogging.
	self should: [ self deny: 1 = 1 description: 'self deny: 1 = 1'.] raise: self defaultTestFailure.
	booleanCondition := (self stream contents substrings:  {Character cr}) last = 'self deny: 1 = 1'.
	self assert: booleanCondition! !

!SUnitExtensionsTest methodsFor: 'test' stamp: 'md 8/2/2006 11:06'!
testInvalidShouldNotTakeMoreThan

	| testCase testResult |

	testCase := self class selector: #invalidShouldNotTakeMoreThan.
	testResult := testCase run.

	self assert: testResult passed isEmpty.
	self assert: testResult failures size = 1.
	self assert: (testResult failures includes: testCase).
	self assert: testResult errors isEmpty

! !

!SUnitExtensionsTest methodsFor: 'real tests' stamp: ''!
invalidShouldNotTakeMoreThanMilliseconds

	self should: [(Delay forMilliseconds: 100) wait] notTakeMoreThanMilliseconds: 50! !

!SUnitExtensionsTest methodsFor: 'test' stamp: 'mx 3/20/2006 23:39'!
testAssertionFailedInRaiseWithExceptionDo

	| testCase testResult  |
	
	testCase := self class selector: #assertionFailedInRaiseWithExceptionDoTest.
	testResult := testCase run.
	
	self assert: (testResult failures includes: testCase).
	self assert: testResult failures size=1.
	self assert: testResult passed isEmpty.
	self assert: testResult errors isEmpty.
	
	! !

!SUnitExtensionsTest methodsFor: 'test' stamp: ''!
testAutoDenyTrue
	self deny: 1 = 2.
	self deny: false! !

!SUnitExtensionsTest methodsFor: 'real tests' stamp: 'mx 3/20/2006 23:47'!
errorInRaiseWithExceptionDoTest

	self 
		should: [ Error  signal ]
		raise: Error
		withExceptionDo: [ :anException | Error signal: 'A forced error' ]! !

!SUnitExtensionsTest class methodsFor: 'history' stamp: 'simon.denier 11/22/2008 22:13'!
lastStoredRun
	^ ((Dictionary new) add: (#passed->((Set new) add: #testNoExceptionWithMatchingString; add: #testNoExceptionWithNoMatchingString; add: #testExceptionWithMatchingString; add: #testExceptionWithoutMatchingString; add: #testValidShouldNotTakeMoreThan; add: #testInvalidShouldNotTakeMoreThanMilliseconds; add: #testDifferentExceptionInShouldRaiseWithExceptionDo; add: #testShouldRaiseWithExceptionDo; add: #testShouldFix; add: #testAssertionFailedInRaiseWithExceptionDo; add: #testAutoDenyFalse; add: #testAutoDenyTrue; add: #testAutoAssertFalse; add: #testAutoAssertTrue; add: #testValidShouldNotTakeMoreThanMilliseconds; add: #testErrorInRaiseWithExceptionDo; add: #testNoExceptionInShouldRaiseWithExceptionDo; add: #testInvalidShouldNotTakeMoreThan; yourself)); add: (#timeStamp->'22 November 2008 10:11:35 pm'); add: (#failures->((Set new))); add: (#errors->((Set new))); yourself)! !

!SUnitHelp commentStamp: 'tbn 12/16/2010 22:26'!
This is a custom help book for the SUnit framework.
!
!SUnitHelp class methodsFor: 'pages' stamp: 'tbn 4/26/2011 15:37'!
links
	"This method was automatically generated. Edit it using:"
	"SUnitHelp edit: #links"
	^HelpTopic
		title: 'Links'
		contents: 
'Visit the following sites to get more informations on SUnit

- http://sunit.sourceforge.net/
- http://www.iam.unibe.ch/~ducasse/Programmez/OnTheWeb/Eng-Art8-SUnit-V1.pdf
- http://en.wikipedia.org/wiki/SUnit!!' readStream nextChunkText! !

!SUnitHelp class methodsFor: 'accessing' stamp: 'tbn 12/16/2010 22:19'!
bookName
	^'SUnit framework'! !

!SUnitHelp class methodsFor: 'accessing' stamp: 'tbn 4/26/2011 15:37'!
pages
	^#(introduction running SUnitTutorial SUnitAPIDocumentation links)! !

!SUnitHelp class methodsFor: 'pages' stamp: 'tbn 12/16/2010 23:31'!
introduction
	"This method was automatically generated. Edit it using:"
	"SUnitHelp edit: #introduction"
	^HelpTopic
		title: 'Introduction'
		contents: 
'SUnit is the mother of all unit testing frameworks, and serves as one of the cornerstones of test-driven development methodologies such as eXtreme Programming. 

The culture of testing has always been part of the philosophy of development in Smalltalk:
You write a method, accept the code and test it by writing a small script in a workspace, in a comment or an example as a class method. But this approach does not allow to automatically repeat the testing or ensure that the code is working. SUnit is a framework you can use to describe and execute unit tests. Unit testing is a method by which individual units of source code are tested to determine if they are fit for use. A unit is the smallest testable part of an application.!!' readStream nextChunkText! !

!SUnitHelp class methodsFor: 'pages' stamp: 'tbn 12/16/2010 23:31'!
running
	"This method was automatically generated. Edit it using:"
	"SUnitHelp edit: #running"
	^HelpTopic
		title: 'Running tests'
		contents: 
'SUnit allows writing tests on Smalltalk source code and checking results. This is usually done in a tool called TestRunner which you can either open from the Pharo world menu or by evaluating:

   TestRunner open

in a Smalltalk workspace.

By writing tests and checking them with the test runner you can ensure the sustainability of your applications.

!!' readStream nextChunkText! !

!SUnitTest commentStamp: '<historical>'!
This is both an example of writing tests and a self test for the SUnit. The tests 
here are pretty strange, since you want to make sure things blow up. You should 
not generally have to write tests this complicated in structure, although they 
will be far more complicated in terms of your own objects- more assertions, more 
complicated setup. Kent says: "Never forget, however, that if the tests are hard 
to write, something is probably wrong with the design".!
!SUnitTest methodsFor: 'testing' stamp: 'BaseSystem 8/30/2009 09:40'!
testShould

	self
		should: [true];
		shouldnt: [false]! !

!SUnitTest methodsFor: 'accessing' stamp: 'BaseSystem 8/30/2009 09:40'!
hasRun
	^hasRun! !

!SUnitTest methodsFor: 'private' stamp: 'BaseSystem 8/30/2009 09:40'!
assertForTestResult: aResult runCount: aRunCount passed: aPassedCount failed: aFailureCount errors: anErrorCount

	self
		assert: aResult runCount = aRunCount;
		assert: aResult passedCount = aPassedCount;
		assert: aResult failureCount = aFailureCount;
		assert: aResult errorCount = anErrorCount! !

!SUnitTest methodsFor: 'private' stamp: 'BaseSystem 8/30/2009 09:40'!
setRun
	hasRun := true! !

!SUnitTest methodsFor: 'testing' stamp: 'EstebanLorenzano 11/11/2010 16:33'!
testExpectedFailureDetection
	self assert: self expectedFailures size = 2.
	self assert: (self expectedFailures includesAllOf: #(expectedFailureFails expectedFailurePasses))! !

!SUnitTest methodsFor: 'testing' stamp: 'jannik.laval 10/1/2010 16:42'!
testRan

	| case |

	case := self class selector: #setRun.
	case resources do: [:each | each availableFor: case].
	[case setUp.
	case performTest] ensure: [
		self assert: case hasSetup.
		self assert: case hasRun.
		case tearDown.
		case cleanUpInstanceVariables].
	self assert: case hasSetup isNil.
	self assert: case hasRun isNil.! !

!SUnitTest methodsFor: 'testing' stamp: 'BaseSystem 8/30/2009 09:40'!
testError

	| case result |

	case := self class selector: #error.
	result := case run.
	self
		assertForTestResult: result
		runCount: 1
		passed: 0
		failed: 0
		errors: 1.

	case := self class selector: #errorShouldntRaise.
	result := case run.
	self 
		assertForTestResult: result
		runCount: 1
		passed: 0
		failed: 0
		errors: 1! !

!SUnitTest methodsFor: 'testing' stamp: 'IgorStasenko 7/28/2011 16:44'!
expectedFailures
	^super expectedFailures "#() "! !

!SUnitTest methodsFor: 'testing' stamp: 'BaseSystem 8/30/2009 09:40'!
testFail

	| case result |

	case := self class selector: #fail.
	result := case run.

	self
		assertForTestResult: result
		runCount: 1
		passed: 0
		failed: 1
		errors: 0! !

!SUnitTest methodsFor: 'testing' stamp: 'NicolaiHess 11/30/2014 20:54'!
testFileOutResult
	| suite result fileout |
	suite := self classForTestSuite new.
	suite
		addTest: (self class selector: #noop);
		addTest: (self class selector: #fail);
		addTest: (self class selector: #error).
	result := suite run.
	fileout := String streamContents: [ :aStream | result fileOutOn: aStream ].
	self
		assert: fileout
		equals:
			'3 run, 1 passes, 0 skipped, 0 expected failures, 1 failures, 1 errors, 0 unexpected passes
Failures:
SUnitTest(TestAsserter)>>#fail

Errors:
SUnitTest>>#error
'! !

!SUnitTest methodsFor: 'testing' stamp: 'MarcusDenker 6/28/2012 18:23'!
testDialectLocalizedException

	self
		should: [self classForTestResult signalFailureWith: 'Foo']
		raise: self defaultTestFailure.
	self
		should: [self classForTestResult signalErrorWith: 'Foo']
		raise: self defaultTestError.! !

!SUnitTest methodsFor: 'private' stamp: 'NikoSchwarz 10/23/2010 15:34'!
expectedFailurePasses
	<expectedFailure>
	self assert: true.! !

!SUnitTest methodsFor: 'testing' stamp: 'md 2/22/2006 14:19'!
testSelectorWithArg: anObject
	"should not result in error"! !

!SUnitTest methodsFor: 'private' stamp: 'NikoSchwarz 10/23/2010 15:33'!
assertForTestResult: aResult runCount: aRunCount passed: aPassedCount failed: aFailureCount errors: anErrorCount expectedFailures: anExpectedFailureCount

	self
		assert: aResult runCount = aRunCount;
		assert: aResult expectedPassCount = aPassedCount;
		assert: aResult failureCount = aFailureCount;
		assert: aResult errorCount = anErrorCount;
		assert: aResult expectedDefectCount = anExpectedFailureCount! !

!SUnitTest methodsFor: 'testing' stamp: 'md 2/22/2006 14:16'!
testRunning

	(Delay forSeconds: 2) wait
			! !

!SUnitTest methodsFor: 'helpers' stamp: 'DamienCassou 12/4/2013 09:46'!
deprecatedMessage
	self deprecated: 'Deprecated method used by #testIgnoreDeprecationWarnings' on: '' in: ''! !

!SUnitTest methodsFor: 'testing' stamp: 'StephaneDucasse 6/9/2012 23:02'!
testSuite
	| suite result |
	suite := self classForTestSuite new.
	suite
		addTest: (self class selector: #noop);
		addTest: (self class selector: #fail);
		addTest: (self class selector: #error).
	result := suite run.
	self
		assertForTestResult: result
		runCount: 3
		passed: 1
		failed: 1
		errors: 1! !

!SUnitTest methodsFor: 'testing' stamp: 'BaseSystem 8/30/2009 09:40'!
testAssert
	self assert: true.
	self deny: false! !

!SUnitTest methodsFor: 'testing' stamp: 'DamienCassou 12/4/2013 09:47'!
raiseDeprecationWarnings
	| oldRaiseWarning |
	oldRaiseWarning := Deprecation raiseWarning.
	[ Deprecation raiseWarning: true.
	self deprecatedMessage.
	self fail ]
		ensure: [ Deprecation raiseWarning: oldRaiseWarning ]! !

!SUnitTest methodsFor: 'testing' stamp: 'EstebanLorenzano 8/17/2012 16:40'!
testWithExceptionDo

	self
		should: [self error: 'foo']
		raise: self defaultTestError
		withExceptionDo: [:exception |
			self assert: (exception description includesSubstring: 'foo')
		]
			! !

!SUnitTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
errorShouldntRaise
	self someMessageThatIsntUnderstood! !

!SUnitTest methodsFor: 'testing' stamp: 'NikoSchwarz 10/23/2010 15:23'!
testExpectedFailure

	| case result |
	case := self class selector: #expectedFailureFails.
	self deny: case shouldPass.
	result := case run.
	self
		assertForTestResult: result
		runCount: 1
		passed: 0
		failed: 0
		errors: 0
		expectedFailures: 1.! !

!SUnitTest methodsFor: 'testing' stamp: 'DamienCassou 12/4/2013 09:46'!
testIgnoreDeprecationWarnings
	| oldRaiseWarning |
	oldRaiseWarning := Deprecation raiseWarning.
	[ Deprecation raiseWarning: false.
	self deprecatedMessage.
	self assert: true ]
		ensure: [ Deprecation raiseWarning: oldRaiseWarning ]! !

!SUnitTest methodsFor: 'testing' stamp: 'BaseSystem 8/30/2009 09:40'!
testRanOnlyOnce

	self assert: hasRanOnce ~= true.
	hasRanOnce := true! !

!SUnitTest methodsFor: 'running' stamp: 'BaseSystem 8/30/2009 09:40'!
setUp
	hasSetup := true! !

!SUnitTest methodsFor: 'accessing' stamp: 'BaseSystem 8/30/2009 09:40'!
hasSetup
	^hasSetup! !

!SUnitTest methodsFor: 'testing' stamp: 'DamienCassou 12/4/2013 09:52'!
testRaiseDeprecationWarnings
	| case result |
	case := self class selector: #raiseDeprecationWarnings.
	result := case run.
	self assert: result defects asArray equals: (Array with: case).
	self
		assertForTestResult: result
		runCount: 1
		passed: 0
		failed: 1
		errors: 0! !

!SUnitTest methodsFor: 'private' stamp: 'BaseSystem 8/30/2009 09:40'!
noop! !

!SUnitTest methodsFor: 'testing' stamp: 'StephaneDucasse 6/9/2012 23:01'!
testDefects
	| result suite error failure |
	suite := self classForTestSuite new.
	suite addTest: (error := self class selector: #error).
	suite addTest: (failure := self class selector: #fail).
	result := suite run.
	self assert: result defects asArray = (Array with: error with: failure).
	self
		assertForTestResult: result
		runCount: 2
		passed: 0
		failed: 1
		errors: 1! !

!SUnitTest methodsFor: 'testing' stamp: 'BaseSystem 8/30/2009 09:40'!
testResult

	| case result |

	case := self class selector: #noop.
	result := case run.

	self
		assertForTestResult: result
		runCount: 1
		passed: 1
		failed: 0
		errors: 0! !

!SUnitTest methodsFor: 'testing' stamp: 'StephaneDucasse 6/9/2012 22:54'!
testException

	self
		should: [self error: 'foo']
		raise: self defaultTestError! !

!SUnitTest methodsFor: 'private' stamp: 'NikoSchwarz 10/23/2010 14:34'!
expectedFailureFails
	<expectedFailure>
	self assert: false.! !

!SUnitTest methodsFor: 'testing' stamp: 'NikoSchwarz 10/23/2010 15:38'!
testExpectedFailurePass

	| case result |
	case := self class selector: #expectedFailurePasses.
	self deny: case shouldPass.
	result := case run.
	self
		assertForTestResult: result
		runCount: 1
		passed: 0
		failed: 1
		errors: 0
		expectedFailures: 0.! !

!SUnitTest methodsFor: 'testing' stamp: 'BaseSystem 8/30/2009 09:40'!
testIsNotRerunOnDebug

	| case |

	case := self class selector: #testRanOnlyOnce.
	case run.
	case debug! !

!SUnitTest methodsFor: 'private' stamp: 'BaseSystem 8/30/2009 09:40'!
error
	3 zork! !

!SUnitTest class methodsFor: 'history' stamp: 'AdrianLienhard 10/19/2009 10:49'!
lastStoredRun
	^ ((Dictionary new) add: (#passed->((Set new) add: #testWithExceptionDo; add: #testAssert; add: #testRanOnlyOnce; add: #testDialectLocalizedException; add: #testFail; add: #testDefects; add: #testIsNotRerunOnDebug; add: #testResult; add: #testRunning; add: #testError; add: #testException; add: #testShould; add: #testSuite; yourself)); add: (#timeStamp->'22 November 2008 10:11:35 pm'); add: (#failures->((Set new))); add: (#errors->((Set new))); yourself)! !

!SUnitTutorial commentStamp: 'tbn 12/16/2010 22:38'!
This is a custom help book providing a tutorial for the SUnit framework.
!
!SUnitTutorial class methodsFor: 'pages' stamp: 'tbn 12/16/2010 23:29'!
step1
	"This method was automatically generated. Edit it using:"
	"SUnitTutorial edit: #step1"
	^HelpTopic
		title: 'Step 1 - Define a test class'
		contents: 
'To define a series of tests in SUnit one typically creates a subclass of class TestCase. The idea is that the methods of this class will implement several tests, the instance variables represent the objects and / or the context in which these tests will be performed. 

In our example we want to write a test on a simple Person class (which is not yet in our image). If the unit under test is a single class one convention is to name the test like the class but followed with the postfix "Test". 

So to create a test for the Person class we subclass TestCase with a custom "PersonTest" class.

	TestCase subclass: #PersonTest
		instanceVariableNames: ''''
		classVariableNames: ''''
		poolDictionaries: ''''
		category: ''MyApp-Tests-Model''

Note that we havent created the class Person yet - so one idea of ExtremeProgramming (XP) is to write the test first as a way to describe a use case that your application has to cover. After that you write the code and the test will show you if the scenario is fullfilled. You dont have to follow this programming style and can also write tests to cover existing code.
	!!' readStream nextChunkText! !

!SUnitTutorial class methodsFor: 'accessing' stamp: 'tbn 12/16/2010 22:37'!
bookName
	^'Tutorial'! !

!SUnitTutorial class methodsFor: 'accessing' stamp: 'tbn 4/26/2011 15:56'!
pages
	^#(step1 step2 step3 step4 step5)! !

!SUnitTutorial class methodsFor: 'pages' stamp: 'tbn 4/26/2011 16:19'!
step5
	"This method was automatically generated. Edit it using:"
	"SUnitTutorial edit: #step5"
	^HelpTopic
		title: 'Step 5 - Getting the test green'
		contents: 
'To get our test green we have to implement the missing methods. First the debugger tells us that the Person class does not understand the message #named: 

We dont have to go back into a standard browser to implement it, we just select ''Create'' in the walkback window. The system now asks us where #named: should be defined in the inheritance hierarchy. We select the Person class and categorize the method in a new method category ''instance creation''.

Finally we have a debugger open where we can implement the code like this:

  named: aString
 	^(self new)
		name: aString;
		yourself
		
Note that after accepting the method in the debugger you can instantly step through it or hit ''Proceed'' to continue execution. The system tell us that there is no setter method #name:, so we implement it too on the instance side:
	
   name: aString
	name := aString

Next the #firstName: message is missing:
	
   firstName: aString
	firstName := aString
	
At any point in time we can control if the test is already green in the TestRunner. Finally when we implement
the missing #fullName method by concatenating first name and surename:

	fullName
		^firstName, '' '', name  
		
Now out test should be green.!!' readStream nextChunkText! !

!SUnitTutorial class methodsFor: 'pages' stamp: 'tbn 4/26/2011 15:42'!
step2
	"This method was automatically generated. Edit it using:"
	"SUnitTutorial edit: #step2"
	^HelpTopic
		title: 'Step 2 - Define a first test method'
		contents: 
'To define a test we create a new instance side method for our first test scenario. By convention any method (in a subclass of TestCase) whose selector starts with ''test'' is supposed to be a test and can be run using the TestRunner tool:

	testInstanceCreation
		|person|
		person := Person named: ''Beck''.
		person firstName: ''Kent''.
		self assert: person fullName = ''Kent Beck''.
		
A good style is to put this method into the method category ''testing''.

When you accept the code the system may ask you about the new class Person. It''s not yet defined - but you can easily create it using the following class definition:

	Object subclass: #Person
		instanceVariableNames: ''name firstName'' 
		classVariableNames: ''''
		poolDictionaries: ''''
		category: ''MyApp-Core-Model''!!' readStream nextChunkText! !

!SUnitTutorial class methodsFor: 'pages' stamp: 'CamilloBruni 8/24/2012 17:48'!
step4
	"This method was automatically generated. Edit it using:"
	"SUnitTutorial edit: #step4"
	^HelpTopic
		title: 'Step 4 - Using the TestRunner'
		contents: 
'Testing by evaluating an expression as we is not very convenient - so it is better to open the TestRunner - a user interface tool displaying all the tests in the system. You can start it either using the world menu or by evaluating 

    TestRunner open

in a workspace.

Scroll down until you find the class category ''MyApp-Tests-Model'' and select the test by clicking on the class PersonTest. It is possible to select more than one test/category. Now click on "Run selected". 

If you run the test in the test runner it will be marked red since it contains errors. The test runner will also show you the result of the test run:

     1 run, 0 passes, 0 skipped, 0 expected failures, 0 failures, 1 errors, 0 unexpected passes

If you click on the failed method in the lower right pane the debugger will open.!!' readStream nextChunkText! !

!SUnitTutorial class methodsFor: 'pages' stamp: 'CamilloBruni 8/24/2012 17:48'!
step3
	"This method was automatically generated. Edit it using:"
	"SUnitTutorial edit: #step3"
	^HelpTopic
		title: 'Step 3 - Running our first test method'
		contents: 
'To run our test case method we can evaluate the following code snippet in a workspace:

	PersonTest run: #testInstanceCreation

If you print the result then the following will appear:

      1 run, 0 passes, 0 skipped, 0 expected failures, 0 failures, 1 errors, 0 unexpected passes

This tells us that one test has been run and one error occured while testing. Currently we dont have all messages implemented - so the test has to fail. 

If you want to debug the test to see whats happened you can evaluate:

     PersonTest debug: #testInstanceCreation



 
	!!' readStream nextChunkText! !

!SVColorSelectorMorph commentStamp: 'gvc 8/8/2007 14:36'!
A colour selector that displays an area with saturation on the x axis and volume on the y axis. Provides interactive selection of colour by mouse. For the moment it is event rather than model based.
Setting the color will specify the hue and setting the selectedColor will specify the saturation and volume (may have a different hue to that displayed if not in sync).!
!SVColorSelectorMorph methodsFor: 'as yet unclassified' stamp: 'gvc 9/21/2006 14:15'!
basicColor: aColor
	"Set the gradient colors."
	
	super color: aColor asNontranslucentColor.
	self
		fillStyle: self gradient! !

!SVColorSelectorMorph methodsFor: 'event handling' stamp: 'gvc 9/21/2006 12:12'!
mouseUp: evt 
	"Handle a up event. Show the location morph again."
	
	evt hand showTemporaryCursor: nil.
	self updateSelectedLocation.
	self locationMorph visible: true! !

!SVColorSelectorMorph methodsFor: 'as yet unclassified' stamp: 'gvc 9/21/2006 12:17'!
updateSelectedLocation
	"Position the location morph to indicate the selected colour."
	
	self locationMorph
		position: (self selectedLocation - (self locationMorph extent // 2 + (self locationMorph extent \\ 2)))! !

!SVColorSelectorMorph methodsFor: 'pixel access' stamp: 'gvc 9/21/2006 10:42'!
colorAt: aPoint
	"Answer the color in the world at the given point."
	
	^self isInWorld
		ifTrue: [(Display colorAt: aPoint) asNontranslucentColor ]
		ifFalse: [Color black]! !

!SVColorSelectorMorph methodsFor: 'accessing' stamp: 'gvc 9/20/2006 13:37'!
locationMorph
	"Answer the value of locationMorph"

	^ locationMorph! !

!SVColorSelectorMorph methodsFor: 'as yet unclassified' stamp: 'gvc 9/21/2006 15:13'!
blackGradient
	"Answer the black gradient. Top to bottom, transparent to black."

	^(InterpolatedGradientFillStyle colors: {Color black alpha: 0. Color black})
		origin: self innerBounds topLeft;
		direction: 0@self innerBounds height! !

!SVColorSelectorMorph methodsFor: 'event handling' stamp: 'gvc 9/20/2006 12:50'!
handlesMouseDown: evt
	"Yes for down and move.." 

	^true! !

!SVColorSelectorMorph methodsFor: 'as yet unclassified' stamp: 'gvc 9/22/2006 11:26'!
showLocation
	"Show the location morph and update the display."
	
	self locationMorph visible: true.
	World displayWorldSafely.! !

!SVColorSelectorMorph methodsFor: 'accessing' stamp: 'gvc 9/21/2006 14:15'!
color: aColor
	"Set the gradient colors."
	
	self
		basicColor: aColor;
		selectedColor: (Color h: aColor hue s: self selectedColor saturation v: self selectedColor brightness)! !

!SVColorSelectorMorph methodsFor: 'accessing' stamp: 'gvc 5/23/2007 11:54'!
adoptPaneColor: paneColor
	"Pass on to the border too."
	
	super adoptPaneColor: paneColor.
	self borderStyle baseColor: paneColor twiceDarker! !

!SVColorSelectorMorph methodsFor: 'initialization' stamp: 'gvc 9/22/2006 10:22'!
initialize
	"Initialize the receiver."

	super initialize.
	self locationMorph: self newLocationMorph.
	self
		clipSubmorphs: true;
		color: Color blue;
		borderStyle: (BorderStyle inset width: 1);
		addMorphBack: self locationMorph;
		addMorphBack: self blackGradientMorph! !

!SVColorSelectorMorph methodsFor: 'as yet unclassified' stamp: 'gvc 9/21/2006 15:25'!
selectedLocation
	"Answer the location within the receiver of the selected colour
	relative to the receiver's top left."

	|b c x y|
	b := self innerBounds.
	c := self selectedColor.
	x := c saturation * (b width - 1).
	y := 1 - c brightness * (b height - 1).
	^(x truncated @ y truncated) + b topLeft! !

!SVColorSelectorMorph methodsFor: 'event handling' stamp: 'gvc 3/19/2010 16:21'!
mouseEnterDragging: evt
	"Make the location morph invisible when entering."
	
	self hideLocation.
	evt hand showTemporaryCursor: (Cursor crossHair copy offset: -9 @ -9).! !

!SVColorSelectorMorph methodsFor: 'layout' stamp: 'gvc 9/26/2006 12:23'!
layoutBounds: aRectangle
	"Set the bounds for laying out children of the receiver.
	Note: written so that #layoutBounds can be changed without touching this method"
	
	super layoutBounds: aRectangle.
	self updateGradients! !

!SVColorSelectorMorph methodsFor: 'accessing' stamp: 'gvc 9/19/2006 15:08'!
selectedColor
	"Answer the value of selectedColor"

	^selectedColor ifNil: [self color]! !

!SVColorSelectorMorph methodsFor: '*Morphic-Base' stamp: 'gvc 9/21/2006 15:19'!
borderWidth: anInteger
	"Update the gradients after setting."
	
	super borderWidth: anInteger.
	self updateGradients! !

!SVColorSelectorMorph methodsFor: 'as yet unclassified' stamp: 'gvc 7/30/2009 13:52'!
updateGradients
	"Update the gradient directions."

	|bgm b|
	b := self innerBounds.
	bgm := self submorphs last.
	bgm bounds: b.
	bgm fillStyle
		origin: b topLeft;
		direction: 0@b height.
	self fillStyle
		origin: b topLeft;
		direction: (b width@0).
	self updateSelectedLocation! !

!SVColorSelectorMorph methodsFor: 'visual properties' stamp: 'gvc 9/21/2006 10:49'!
fillStyle: fillStyle
	"If it is a color then override with gradient."
	
	fillStyle isColor
		ifTrue: [self color: fillStyle]
		ifFalse: [super fillStyle: fillStyle]! !

!SVColorSelectorMorph methodsFor: 'as yet unclassified' stamp: 'gvc 9/22/2006 11:25'!
hideLocation
	"Hide the location morph and update the display."
	
	self locationMorph visible: false.
	World displayWorldSafely.! !

!SVColorSelectorMorph methodsFor: 'event handling' stamp: 'gvc 5/23/2007 11:56'!
mouseLeaveDragging: evt
	"Make the location morph visible when leaving."
	
	evt hand showTemporaryCursor: nil.
	self showLocation! !

!SVColorSelectorMorph methodsFor: 'event handling' stamp: 'gvc 9/21/2006 16:33'!
handlesMouseOverDragging: evt
	"Yes, make the location morph visible when leaving."
	
	^true! !

!SVColorSelectorMorph methodsFor: 'event handling' stamp: 'gvc 9/22/2006 12:11'!
mouseMove: evt 
	"Handle a mouse move event. Select the color at the mouse position."
	
	evt redButtonPressed
		ifFalse: [^super mouseMove: evt].
	self selectColorAt: evt position.
	^super mouseMove: evt! !

!SVColorSelectorMorph methodsFor: 'geometry' stamp: 'gvc 9/22/2006 10:33'!
extent: p
	"Update the gradient directions."

	super extent: p.
	self updateGradients! !

!SVColorSelectorMorph methodsFor: 'accessing' stamp: 'gvc 9/20/2006 13:37'!
locationMorph: anObject
	"Set the value of locationMorph"

	locationMorph := anObject! !

!SVColorSelectorMorph methodsFor: 'accessing' stamp: 'gvc 9/21/2006 14:01'!
selectedColor: aColor
	"Set the value of selectedColor."

	selectedColor := aColor.
	self locationMorph visible ifTrue: [self updateSelectedLocation].
	self triggerEvent: #colorSelected with: aColor! !

!SVColorSelectorMorph methodsFor: 'as yet unclassified' stamp: 'gvc 7/30/2009 13:52'!
gradient
	"Answer the base gradient."

	|b|
	b := self innerBounds.
	^(GradientFillStyle colors: {Color white. self color})
		origin: b topLeft;
		direction: (b width@0)! !

!SVColorSelectorMorph methodsFor: 'as yet unclassified' stamp: 'gvc 9/19/2006 11:36'!
blackGradientMorph
	"Answer the black gradient morph."

	^Morph new
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		fillStyle: self blackGradient! !

!SVColorSelectorMorph methodsFor: 'instance creation' stamp: 'StephaneDucasse 5/23/2013 18:40'!
newLocationMorph
	"Answer a new morph indicating the location of the selected color."

	^ImageMorph new
		form: Cursor crossHair withMask asCursorForm! !

!SVColorSelectorMorph methodsFor: 'as yet unclassified' stamp: 'gvc 9/22/2006 12:12'!
selectColorAt: aPoint
	"Set the color at the given position."
	
	|b p|
	b := self innerBounds.
	p := (b containsPoint: aPoint)
		ifTrue: [aPoint]
		ifFalse: [b pointNearestTo: aPoint].
	p := p - b topLeft / b extent.
	self selectedColor: (Color
		h: self color hue
		s: p x
		v: 1.0 - p y)! !

!SVColorSelectorMorph methodsFor: 'event handling' stamp: 'gvc 3/19/2010 16:21'!
mouseDown: evt 
	"Handle a mouse down event. Select the color at the mouse position."
	
	evt redButtonPressed
		ifFalse: [^super mouseDown: evt].
	evt hand showTemporaryCursor: (Cursor crossHair copy offset: -9 @ -9).
	self hideLocation.
	self selectColorAt: evt position.
	^super mouseDown: evt! !

!SaveCommandLineHandler commentStamp: '<historical>'!
Usage: save <imageBaseName> [--delete-old]
 	<imageName>     a base name for the image
	--delete-old    remove the old image and changes file
	
Documentation:
Saves the image and changes file under a new name.

Examples:
	# create a 'bar.image' and 'foo.changes'
	pharo Pharo.image save bar
	# create the same file as in the previous example but delete Foo.image and Foo.changes
	pharo Pharo.image save bar --delete-old!
!SaveCommandLineHandler methodsFor: 'actions' stamp: 'CamilloBruni 4/10/2013 10:48'!
saveImage
	| imageName oldImageFile oldChangesFile |
	
	imageName := self arguments detect: [ :arg| arg ~= '--delete-old' ].
	oldImageFile := Smalltalk imageFile resolve.
	oldChangesFile := Smalltalk changesFile resolve.
	
	(Smalltalk saveAs: imageName)
		ifTrue: [ 
			"rebooting, when executing this, we are already in the renamed image" 
			^ self ].
	
	"...otherwise continuing"
	(self hasOption: 'delete-old')
		ifFalse: [ ^ self exitSuccess ].
	
	oldImageFile delete.
	oldChangesFile delete.
	
	self exitSuccess.! !

!SaveCommandLineHandler methodsFor: 'activation' stamp: 'CamilloBruni 4/10/2013 10:42'!
activate
	self activateHelp
		ifTrue: [  ^ self ].
	
	((self hasOption: 'delete-old') 
		ifTrue: [ self arguments size = 2 ]
		ifFalse: [ self arguments size = 1])
			ifFalse: [ 
				self printHelp.
				^ self exitFailure: 'Missing Arguments' ].
		
	self saveImage.
		! !

!SaveCommandLineHandler class methodsFor: 'accessing' stamp: 'CamilloBruni 10/18/2012 11:05'!
description
	^ 'Rename the image and changes file'! !

!SaveCommandLineHandler class methodsFor: 'accessing' stamp: 'CamilloBruni 10/18/2012 11:03'!
commandName
	^ 'save'! !

!ScaledDecimal commentStamp: 'nice 5/16/2009 20:45'!
ScaledDecimal implement a special kind of Fraction that prints in decimal notation.
It uses a limited number of digits (scale) after the decimal separation dot and round the result.
Note that a ScaledDecimal does not printOn: exactly, however it will storeOn: exactly because the full precision fraction is kept in memory.

This is mostly usefull with denominators being powers of 10.!
!ScaledDecimal methodsFor: 'mathematical functions' stamp: 'nice 5/16/2009 21:15'!
raisedToInteger: aNumber
	^self class newFromNumber: (super raisedToInteger: aNumber) scale: scale! !

!ScaledDecimal methodsFor: 'mathematical functions' stamp: 'nice 10/14/2011 22:21'!
nthRoot: anInteger
	"Answer the nth root of the receiver.
	Preserve receiver class and scale if answer is exact.
	Otherwise, answer a Float to denote inexactness."
	| nthRoot |
	nthRoot := self asFraction nthRoot: anInteger.
	^nthRoot isFloat
		ifTrue: [nthRoot]
		ifFalse: [nthRoot asScaledDecimal: scale]! !

!ScaledDecimal methodsFor: 'comparing' stamp: 'nice 5/17/2009 00:25'!
< aNumber
	aNumber class = self class ifTrue: [^self asFraction < aNumber asFraction].
	^self asFraction < aNumber! !

!ScaledDecimal methodsFor: 'converting' stamp: 'nice 5/16/2009 23:53'!
adaptToFraction: rcvr andSend: selector
	"If I am involved in arithmetic with a Fraction, convert it to a ScaledDecimal."

	^(rcvr asScaledDecimal: scale) perform: selector with: self! !

!ScaledDecimal methodsFor: 'private' stamp: 'nice 5/16/2009 20:54'!
setNumerator: n denominator: d scale: s

	self setNumerator: n denominator: d.
	scale := s! !

!ScaledDecimal methodsFor: 'arithmetic' stamp: 'nice 5/17/2009 00:21'!
+ aNumber
	aNumber class = self class ifTrue: [^self asFraction + aNumber asFraction asScaledDecimal: (scale max: aNumber scale)].
	^self coerce: self asFraction + aNumber! !

!ScaledDecimal methodsFor: 'arithmetic' stamp: 'nice 5/17/2009 00:21'!
- aNumber
	aNumber class = self class ifTrue: [^self asFraction - aNumber asFraction asScaledDecimal: (scale max: aNumber scale)].
	^self coerce: self asFraction - aNumber! !

!ScaledDecimal methodsFor: 'accessing' stamp: 'nice 5/16/2009 20:56'!
scale
	^scale! !

!ScaledDecimal methodsFor: 'printing' stamp: 'nice 3/29/2011 22:39'!
printOn: aStream
	"Append an approximated representation of the receiver on aStream.
	Use prescribed number of digits after decimal point (the scale) using a rounding operation if not exact"
	
	self printOn: aStream showingDecimalPlaces: scale.

	"Append a scale specification so that the number can be recognized as a ScaledDecimal"
	aStream nextPut: $s; print: scale.! !

!ScaledDecimal methodsFor: 'private' stamp: 'nice 5/17/2009 00:21'!
coerce: aNumber
	"Note: this quick hack could be replaced by double dispatching"
	
	aNumber class = self class ifTrue: [^self class newFromNumber: aNumber scale: (scale max: aNumber scale)].
	(aNumber isFraction or: [aNumber isInteger]) ifTrue: [^self class newFromNumber: aNumber scale: scale].
	^aNumber! !

!ScaledDecimal methodsFor: 'converting' stamp: 'nice 5/17/2009 00:19'!
asFraction	
	"Convert the receiver to a Fraction.
	Avoid using numerator / denominator to save a useless and costly gcd: computation"

	^denominator = 1
		ifTrue: [numerator]
		ifFalse: [Fraction numerator: numerator denominator: denominator]! !

!ScaledDecimal methodsFor: 'arithmetic' stamp: 'nice 5/16/2009 21:01'!
squared
	^self class newFromNumber: super squared scale: scale! !

!ScaledDecimal methodsFor: 'printing' stamp: 'nice 5/16/2009 21:31'!
printOn: aStream base: base
	base = 10 ifFalse: [self error: 'ScaledDecimals should be printed only in base 10'].
	^self printOn: aStream! !

!ScaledDecimal methodsFor: 'comparing' stamp: 'nice 9/25/2009 23:04'!
> aNumber
	aNumber class = self class ifTrue: [^self asFraction > aNumber asFraction].
	^self asFraction > aNumber! !

!ScaledDecimal methodsFor: 'mathematical functions' stamp: 'nice 10/14/2011 22:02'!
sqrt
	"Answer the square root of the receiver.
	Preserve receiver class and scale if answer is exact.
	Otherwise, answer a Float to denote inexactness."
	| squareRoot |
	squareRoot := self asFraction sqrt.
	^squareRoot isFloat
		ifTrue: [squareRoot]
		ifFalse: [squareRoot asScaledDecimal: scale]! !

!ScaledDecimal methodsFor: 'printing' stamp: 'BernardoContreras 11/6/2011 17:02'!
storeOn: aStream 
	"ScaledDecimal sometimes have more digits than they print (potentially an infinity).
	In this case, do not use printOn: because it would loose some extra digits"
	
	self shouldBePrintedAsLiteral
		ifTrue: [self printOn: aStream]
		ifFalse: [aStream
			nextPut: $(;
		 	store: numerator;
			nextPut: $/;
			store: denominator;
			nextPut: $s;
			store: scale;
			nextPut: $)]! !

!ScaledDecimal methodsFor: 'testing' stamp: 'nice 5/16/2009 21:11'!
isLiteral
	"Answer if this number could be a well behaved literal.
	Well, it would only if evaluating back to self.
	This is not the case of all ScaledDecimals.
	Some have an infinite precision and would need an infinite number of digits to print literally.
	Try for example (3.00s2 reciprocal)."
	
	^denominator = 1 "first test trivial case before engaging arithmetic"
		or: ["Exactly we should test:
				(numerator * (10 raisedTo; scale)) \\ denominator = 0.
				But since we can assume fraction is reduced already this will be simply:"
			(10 raisedTo: scale) \\ denominator = 0]! !

!ScaledDecimal methodsFor: 'comparing' stamp: 'nice 8/28/2008 19:18'!
literalEqual: other
	"Testing equality is not enough.
	It is also necessary to test number of decimal places (scale).
	Otherwise we cannot compile both literals 0.5s1 and 0.50s2 in the same method"
	
	^(super literalEqual: other) and: [self scale = other scale]! !

!ScaledDecimal methodsFor: 'arithmetic' stamp: 'nice 5/16/2009 21:01'!
negated
	^self class newFromNumber: super negated scale: scale! !

!ScaledDecimal methodsFor: 'comparing' stamp: 'nice 9/25/2009 23:04'!
>= aNumber
	aNumber class = self class ifTrue: [^self asFraction >= aNumber asFraction].
	^self asFraction >= aNumber! !

!ScaledDecimal methodsFor: 'arithmetic' stamp: 'nice 5/16/2009 21:01'!
reciprocal
	^self class newFromNumber: super reciprocal scale: scale! !

!ScaledDecimal methodsFor: 'mathematical functions' stamp: 'nice 5/16/2009 21:06'!
raisedTo: aNumber
	^self coerce: (super raisedTo: aNumber)! !

!ScaledDecimal methodsFor: 'comparing' stamp: 'nice 5/17/2009 00:25'!
= aNumber
	aNumber class = self class ifTrue: [^self asFraction = aNumber asFraction].
	^self asFraction = aNumber! !

!ScaledDecimal methodsFor: 'testing' stamp: 'nice 5/17/2009 00:01'!
isFraction
	"Though kind of Fraction, pretend we are not a Fraction to let coercion works correctly"
	
	^false! !

!ScaledDecimal methodsFor: 'converting' stamp: 'nice 5/16/2009 23:42'!
adaptToInteger: rcvr andSend: selector
	"If I am involved in arithmetic with an Integer, convert it to a ScaledDecimal."

	^(rcvr asScaledDecimal: scale) perform: selector with: self! !

!ScaledDecimal methodsFor: 'accessing' stamp: 'StephaneDucasse 10/15/2011 20:37'!
isSelfEvaluating
    "Not all scaled decimal are self evaluating, because they print rounded digits."
    ^self isLiteral! !

!ScaledDecimal methodsFor: 'arithmetic' stamp: 'nice 5/17/2009 00:20'!
* aNumber
	aNumber class = self class ifTrue: [^self asFraction * aNumber asFraction asScaledDecimal: (scale max: aNumber scale)].
	^self coerce: self asFraction * aNumber! !

!ScaledDecimal methodsFor: 'comparing' stamp: 'nice 9/25/2009 23:03'!
<= aNumber
	aNumber class = self class ifTrue: [^self asFraction <= aNumber asFraction].
	^self asFraction <= aNumber! !

!ScaledDecimal methodsFor: 'arithmetic' stamp: 'nice 5/17/2009 00:21'!
/ aNumber
	aNumber class = self class ifTrue: [^self asFraction / aNumber asFraction asScaledDecimal: (scale max: aNumber scale)].
	^self coerce: self asFraction / aNumber! !

!ScaledDecimal class methodsFor: '*AST-Core-Parser' stamp: 'YuriyTymchuk 10/29/2013 11:10'!
readFrom: stringOrStream 
	"Answer a decimal number as described on stringOrStream.
	The number may not include a leading radix specification, as in 16rFADE,
	nor an exponent like 1.0e-3
	It might have a scale specification at end or not like 10.3s2
	If not, number of digits after decimal point will be used as scale"
	
	^(NumberParser on: stringOrStream) nextScaledDecimal! !

!ScaledDecimal class methodsFor: 'instance creation' stamp: 'nice 5/16/2009 22:23'!
newFromNumber: aNumber scale: anInteger
	| aFraction |
	aFraction := aNumber asFraction.
	^aFraction isFraction
		ifTrue: [self new setNumerator: aFraction numerator denominator: aFraction denominator scale: anInteger]
		ifFalse: [self new setNumerator: aFraction denominator: 1 scale: anInteger]! !

!ScaledDecimalTest commentStamp: '<historical>'!
I provide a test suite for ScaledDecimal values. Examine my tests to see how SmallIntegers should behave, and see how to use them.!
!ScaledDecimalTest methodsFor: 'tests' stamp: 'nice 5/17/2009 00:38'!
testOneRaisedToInteger
	"One might be handled specially"
	
	self assert: (1.0s1 raisedToInteger: -1) scale = 1.
	self assert: (1.0s1 raisedToInteger: -1) = 1.
	self assert: (1.0s1 raisedToInteger: 0) scale = 1.
	self assert: (1.0s1 raisedToInteger: 0) = 1.
	self assert: (1.0s1 raisedToInteger: 1) scale = 1.
	self assert: (1.0s1 raisedToInteger: 1) = 1.
	self assert: (1.0s1 raisedToInteger: 2) scale = 1.
	self assert: (1.0s1 raisedToInteger: 2) = 1.! !

!ScaledDecimalTest methodsFor: 'tests' stamp: 'nice 2/13/2010 23:12'!
testConvertFromInteger
	"Converting an Integer with asScaledDecimal use strictly necessary number of decimal places: 0."

	| sd |
	sd := 13 asScaledDecimal.
	self assert: 0 = sd scale.
	self assert: ('13s0' = sd printString).
	sd := -13 asScaledDecimal.
	self assert: 0 = sd scale.
	self assert: ('-13s0' = sd printString).
	sd := 130000000013 asScaledDecimal.
	self assert: 0 = sd scale.
	self assert: ('130000000013s0' = sd printString).
	sd := -130000000013 asScaledDecimal.
	self assert: 0 = sd scale.
	self assert: ('-130000000013s0' = sd printString)
! !

!ScaledDecimalTest methodsFor: 'tests' stamp: 'ul 11/15/2010 12:02'!
testAsNumberWithoutDecimalPoint

	| sd |
	sd := '123s0' asNumber.
	self assert: ScaledDecimal == sd class.
	self assert: sd scale = 0.
	self assert: '123s0' = sd printString.
! !

!ScaledDecimalTest methodsFor: 'tests' stamp: 'ul 11/15/2010 12:02'!
testAsNumberWithoutDecimalPoint2

	| sd |
	sd := '123s2' asNumber.
	self assert: ScaledDecimal == sd class.
	self assert: sd scale = 2.
	self assert: '123.00s2' = sd printString.
! !

!ScaledDecimalTest methodsFor: 'tests' stamp: 'nice 5/17/2009 00:31'!
testScaleExtension
	"The scale is extended to the larger one in case of arithmetic operation"
	
	#( #* #+ #- #/) do: [:op |
		self assert: (2.5s1 perform: op with: 1.000s3) scale = 3.
		self assert: (3.5000s4 perform: op with: 1.0s1) scale = 4.]! !

!ScaledDecimalTest methodsFor: 'tests' stamp: 'nice 11/22/2007 22:42'!
testReadFrom
	"This is related to http://bugs.squeak.org/view.php?id=6779"
	
	self should: [(ScaledDecimal readFrom: '5.3') isKindOf: ScaledDecimal]
		description: 'Reading a ScaledDecimal should answer a ScaledDecimal'.
	self should: [((ScaledDecimal readFrom: '5.3') asScaledDecimal: 1) = (53/10 asScaledDecimal: 1)]
		description: 'ScaledDecimal readFrom: should not use Float intermediate because it would introduce round off errors'.! !

!ScaledDecimalTest methodsFor: 'tests' stamp: 'nice 10/14/2011 22:23'!
testExactNthRoot
	| eight thousandth tenth two |
	eight := 8.0s1.
	two := eight raisedTo: 1/3.
	self assert: two = 2.
	self assert: (two class = eight class and: [two scale = eight scale]).
	thousandth := 0.001s3.
	tenth := thousandth raisedTo: 1/3.
	self assert: tenth * 10 = 1.
	self assert: (tenth class = thousandth class and: [tenth scale = thousandth scale]).! !

!ScaledDecimalTest methodsFor: 'tests' stamp: 'nice 10/31/2011 23:15'!
testConvertFromNonDecimalFraction
	"Converting a Fraction with asScaledDecimal use default number of decimals when the serie of decimals is infinite."
	| defaultNumberOfDecimals |
	defaultNumberOfDecimals := (1/3) asScaledDecimal scale.
	#(6 7 9 11 12 13 14 17 18 19 21 22 23 24) do: [:den |
		| sd sd2 |
		sd := (1/den) asScaledDecimal.
		self assert: sd scale = defaultNumberOfDecimals.
		sd2 := ScaledDecimal readFrom: sd printString.
		self deny: sd = sd2
		] ! !

!ScaledDecimalTest methodsFor: 'tests' stamp: 'nice 10/14/2011 22:25'!
testInexactNthRoot
	| tenth cubicRoot3 fifthRootTenth three |
	three := 3.0s1.
	cubicRoot3 := three raisedTo: 1/3.
	self assert: cubicRoot3 class = Float.
	self deny: cubicRoot3 squared = 3.
	tenth := 0.10s2.
	fifthRootTenth := tenth raisedTo: 1/5.
	self assert: fifthRootTenth class = Float.
	self deny: fifthRootTenth squared = tenth.! !

!ScaledDecimalTest methodsFor: 'tests' stamp: 'ul 11/15/2010 12:02'!
testAsNumberWithExtendedScale

	| sd |
	sd := '123s2' asNumber.
	self assert: ScaledDecimal == sd class.
	self assert: sd scale = 2.
	self assert: '123.00s2' = sd printString.
! !

!ScaledDecimalTest methodsFor: 'tests' stamp: 'nice 5/16/2009 23:48'!
testCoercion
	#( #* #+ #- #/) do: [:op |
		self assert: (1.0s1 perform: op with: 2) class = ScaledDecimal.
		self assert: (1.0s1 perform: op with: 1/2) class = ScaledDecimal.
		self deny: (1.0s1 perform: op with: 1.0) class = ScaledDecimal.
		
		self assert: (1 perform: op with: 2.0s1) class = ScaledDecimal.
		self assert: (1/2 perform: op with: 2.0s1) class = ScaledDecimal.
		self deny: (1.0 perform: op with: 1.0s1) class = ScaledDecimal]! !

!ScaledDecimalTest methodsFor: 'tests' stamp: 'nice 2/13/2010 23:13'!
testConvertFromIntegerWithScale
	"Converting an Integer with asScaledDecimal: does now honour the scale passed as message argument."

	| sd |
	sd := 13 asScaledDecimal: 6.
	self assert: 6 = sd scale.
	self assert: ('13.000000s6' = sd printString).
	sd := -13 asScaledDecimal: 4.
	self assert: 4 = sd scale.
	self assert: ('-13.0000s4' = sd printString).
	sd := 130000000013 asScaledDecimal: 3.
	self assert: 3 = sd scale.
	self assert: ('130000000013.000s3' = sd printString).
	sd := -130000000013 asScaledDecimal: 1.
	self assert: 1 = sd scale.
	self assert: ('-130000000013.0s1' = sd printString)
! !

!ScaledDecimalTest methodsFor: 'tests' stamp: 'nice 10/31/2011 23:14'!
testConvertFromDecimalFraction
	"Converting a Fraction with asScaledDecimal use strictly necessary number of decimal places when possible."
	0 to: 11 do: [:pow2 |
		0 to: 11 do: [:pow5 |
			| fraction sd sd2 |
			fraction := 13 / (2 raisedTo: pow2) / (5 raisedTo: pow5).
			sd := fraction asScaledDecimal.
			self assert: sd scale = (pow2 max: pow5).
			sd2 := ScaledDecimal readFrom: sd printString.
			self assert: sd = sd2]].! !

!ScaledDecimalTest methodsFor: 'tests' stamp: 'ul 11/15/2010 12:02'!
testAsNumberNegatedWithoutDecimalPoint2

	| sd |
	sd := '-123s2' asNumber.
	self assert: ScaledDecimal == sd class.
	self assert: sd scale = 2.
	self assert: '-123.00s2' = sd printString.
! !

!ScaledDecimalTest methodsFor: 'tests' stamp: 'nice 3/29/2011 22:20'!
testConvertFromFloat

	| aFloat sd f2 diff |
	aFloat := 11/13 asFloat.
	sd := aFloat asScaledDecimal: 2.
	self assert: 2 = sd scale.
	self assert: '0.85s2' = sd printString.
	self assert: '-0.85s2' = sd negated printString.
	f2 := sd asFloat.
	diff := f2 - aFloat.
	self assert: diff abs < 1.0e-9. "actually, f = f2, but this is not a requirement"
! !

!ScaledDecimalTest methodsFor: 'tests' stamp: 'ul 11/15/2010 12:02'!
testLiteral

	| sd |
	sd := 1.40s2.
	self assert: ScaledDecimal == sd class.
	self assert: sd scale = 2.
	self assert: '1.40s2' = sd printString! !

!ScaledDecimalTest methodsFor: 'tests' stamp: 'nice 5/16/2009 22:28'!
testPrintString
	"The printed representation of a ScaledDecimal is rounded.
	Note that old implementation was truncated."

	| sd |
	sd := (13 / 11) asScaledDecimal: 6.
	self assert: ('1.181818s6' = sd printString).
	sd := (13 / 11) asScaledDecimal: 5.
	self assert: ('1.18182s5' = sd printString).
	sd := (13 / 11) asScaledDecimal: 5.
	self deny: ('1.18181s5' = sd printString)
! !

!ScaledDecimalTest methodsFor: 'tests' stamp: 'ul 11/15/2010 12:02'!
testAsNumber
	"Ensure no loss of precision"

	| sd |
	sd := '1.40s2' asNumber.
	self assert: ScaledDecimal == sd class.
	self assert: sd scale = 2.
	self assert: '1.40s2' = sd printString.
! !

!ScaledDecimalTest methodsFor: 'tests' stamp: 'nice 12/3/2007 20:35'!
testIsLiteral
	"This test is related to http://bugs.squeak.org/view.php?id=6796"
	
	self assert: 1.00s2 isLiteral description: 'every literal obviously isLiteral'.
	
	"Note that (1 / 3.00s2) is not a well behaved literal,
	because it does not re-evaluate to self...
	Every literal should be evaluated as self (see isSelfEvaluating).
	There is currently no way to print it as a literal.
	So i propose it shall not answer true."
	self deny: (1/3.00s2) isLiteral description: 'this number cannot represent itself as a literal'.! !

!ScaledDecimalTest methodsFor: 'tests' stamp: 'nice 5/17/2009 00:35'!
testRaisedToInteger
	"Raising to integer should preserve class and scale"
	
	self assert: (3.0s1 raisedToInteger: -1) scale = 1.
	self assert: (3.0s1 raisedToInteger: -1) = (1/3).
	self assert: (3.0s1 raisedToInteger: 0) scale = 1.
	self assert: (3.0s1 raisedToInteger: 0) = 1.
	self assert: (3.0s1 raisedToInteger: 1) scale = 1.
	self assert: (3.0s1 raisedToInteger: 1) = 3.
	self assert: (3.0s1 raisedToInteger: 2) scale = 1.
	self assert: (3.0s1 raisedToInteger: 2) = 9.! !

!ScaledDecimalTest methodsFor: 'tests' stamp: 'nice 5/17/2009 00:40'!
testZeroRaisedToInteger
	"Zero might be handle specially"
	
	self should: [0.0s1 raisedToInteger: -1] raise: Error.
	self assert: (0.0s1 raisedToInteger: 0) = 1.
	self assert: (0.0s1 raisedToInteger: 0) scale = 1.
	self assert: (0.0s1 raisedToInteger: 1) = 0.
	self assert: (0.0s1 raisedToInteger: 1) scale = 1.
	self assert: (0.0s1 raisedToInteger: 2) = 0.
	self assert: (0.0s1 raisedToInteger: 2) scale = 1.! !

!ScaledDecimalTest methodsFor: 'tests' stamp: 'YuriyTymchuk 10/29/2013 11:20'!
testAsNumberWithSuperfluousDecimalPoint

	| sd |
	sd := '123.s2' asNumber.
	self deny: ScaledDecimal == sd class description: 'It used to, but this syntax is not valid Smalltalk'.

! !

!ScaledDecimalTest methodsFor: 'tests' stamp: 'nice 3/29/2011 22:43'!
testRounded
	self assert: (1999/1000s2) printString = '2.00s2'.
	self assert: (-1999/1000s2) printString = '-2.00s2'! !

!ScaledDecimalTest methodsFor: 'tests' stamp: 'ul 11/15/2010 12:02'!
testAsNumberNegatedWithoutDecimalPoint

	| sd |
	sd := '-123s0' asNumber.
	self assert: ScaledDecimal == sd class.
	self assert: sd scale = 0.
	self assert: '-123s0' = sd printString.
! !

!ScaledDecimalTest methodsFor: 'tests' stamp: 'nice 3/29/2011 22:22'!
testConvertFromFraction

	| sd |
	sd := (13 / 11) asScaledDecimal: 6.
	self assert: ScaledDecimal == sd class.
	self assert: ('1.181818s6' = sd printString).
	self assert: 6 = sd scale.
	sd := (-13 / 11) asScaledDecimal: 6.
	self assert: ScaledDecimal == sd class.
	self assert: ('-1.181818s6' = sd printString).
	self assert: 6 = sd scale
! !

!ScaledDecimalTest methodsFor: 'tests' stamp: 'ul 11/15/2010 12:02'!
testAsNumberWithRadix

	| sd |
	sd := '10r-22.2s5' asNumber.
	self assert: ScaledDecimal == sd class.
	self assert: sd scale = 5.
	self assert: '-22.20000s5' = sd printString.
! !

!ScaledDecimalTest methodsFor: 'tests' stamp: 'nice 10/14/2011 21:59'!
testInexactSqrt
	| tenth sqrt3 sqrtTenth three |
	three := 3.0s1.
	sqrt3 := three sqrt.
	self assert: sqrt3 class = Float.
	self deny: sqrt3 squared = 3.
	tenth := 0.10s2.
	sqrtTenth := tenth sqrt.
	self assert: sqrtTenth class = Float.
	self deny: sqrtTenth squared = tenth.! !

!ScaledDecimalTest methodsFor: 'tests' stamp: 'nice 10/14/2011 21:57'!
testExactSqrt
	| four hundredth tenth two |
	four := 4.0s1.
	two := four sqrt.
	self assert: two = 2.
	self assert: (two class = four class and: [two scale = four scale]).
	hundredth := 0.01s2.
	tenth := hundredth sqrt.
	self assert: tenth * 10 = 1.
	self assert: (tenth class = hundredth class and: [tenth scale = hundredth scale]).! !

!ScaledDecimalTest methodsFor: 'tests' stamp: 'MarcusDenker 5/2/2013 11:36'!
testStoreOn
	"this is http://bugs.squeak.org/view.php?id=4378"
	
	"Both results should be 1.
	ScaledDecimal representations are exact
	(though only scale digits or fractional part are printed)"

	self assert:
    		(self class compiler evaluate: (0.5s1 squared storeString)) * 4
		= (0.5s1 squared * 4).
		
	
	"However, exact literals should store literaly
	If not, they would break Decompiler."
	
	"BUG: i cannot write the test like this:
	self assert:
    		0.5s2 squared storeString = '0.25s2'
	BECAUSE compiler would consider 0.5s2 as = 0.5s1 and would reuse same slot..."
	
	self assert:
    		0.25s2 storeString = '0.25s2'! !

!Scanner commentStamp: '<historical>'!
I scan a string or text, picking out Smalltalk syntactic tokens. I look one character ahead. I put each token found into the instance variable, token, and its type (a Symbol) into the variable, tokenType. At the end of the input stream, I pretend to see an endless sequence of special characters called doits.!
!Scanner methodsFor: 'expression types' stamp: ''!
advance

	| prevToken |
	prevToken := token.
	self scanToken.
	^prevToken! !

!Scanner methodsFor: 'multi-character scans' stamp: 'StephaneDucasse 8/8/2010 18:18'!
xIllegal
	"An illegal character was encountered"
	self notify: 'Illegal character (char code ' , hereChar charCode , ' ' , hereChar charCode storeStringHex , ')' at: mark! !

!Scanner methodsFor: 'expression types' stamp: 'ar 5/10/2005 12:24'!
scanLitWord
	"Accumulate keywords and asSymbol the result."

	| t |
	[(self typeTableAt: hereChar) = #xLetter]
		whileTrue: 
			[t := token.
			self xLetter.
			token := t , token].
	token := token asSymbol! !

!Scanner methodsFor: 'initialize-release' stamp: 'eem 8/20/2008 20:57'!
initScannerForTokenization
	"Use a version of typeTable that doesn't raise xIllegal when enocuntering an :="
	| underscoreIndex |
	underscoreIndex := typeTable indexOf: #xUnderscore ifAbsent: [^self].
	typeTable := typeTable copy.
	typeTable at: underscoreIndex put: #xUnderscoreForTokenization! !

!Scanner methodsFor: 'initialization' stamp: ''!
scan: inputStream 
	"Bind the input stream, fill the character buffers and first token buffer."

	source := inputStream.
	self step.
	self step.
	self scanToken! !

!Scanner methodsFor: 'multi-character scans' stamp: 'ul 3/27/2011 23:32'!
xColon
	"Allow := for assignment"
	
	aheadChar == $= ifTrue:
		[self step.
		tokenType := #leftArrow.
		self step.
		^ token := #':='].
	"Otherwise, just do what normal scan of colon would do"
	tokenType := #colon.
	^ token := self step asSymbol! !

!Scanner methodsFor: 'expression types' stamp: 'nice 2/22/2012 14:48'!
scanToken

	[(tokenType := self typeTableAt: hereChar) == #xDelimiter]
		whileTrue: [self step].  "Skip delimiters fast, there almost always is one."
	mark := aheadChar == DoItCharacter
		ifTrue: [hereChar == DoItCharacter
			ifTrue: [source position + 1]
			ifFalse: [source position]]
		ifFalse: [source position - 1].
	(tokenType at: 1) == $x "x as first letter"
		ifTrue: [self perform: tokenType "means perform to compute token & type"]
		ifFalse: [token := self step asSymbol "else just unique the first char"].
	^token! !

!Scanner methodsFor: 'multi-character scans' stamp: 'nice 2/23/2010 16:39'!
xBinary

	| startOfToken |
	tokenType := #binary.
	startOfToken := mark.
	token := String with: self step.
	[(self typeTableAt: hereChar) == #xBinary] whileTrue:
		[(hereChar == $- and: [(self typeTableAt: aheadChar) == #xDigit])
			ifTrue: [^self ambiguousSelector: (token , '-')
					inRange: (startOfToken to: source position - 1).].
		token := token, (String with: self step)].
	token := token asSymbol! !

!Scanner methodsFor: 'multi-character scans' stamp: 'eem 5/8/2008 17:01'!
xUnderscoreForTokenization
	self step.
	tokenType := #leftArrow.
	^token := #'_'! !

!Scanner methodsFor: 'error handling' stamp: 'nice 2/25/2010 02:56'!
notify: string at: posiiton
	"Parser compatible message"
	 
	^self notify: string ! !

!Scanner methodsFor: 'expression types' stamp: 'ul 3/27/2011 22:21'!
scanAllTokenPositionsInto: aBlock
	"Evaluate aBlock with the start and end positions of all separate non-white-space tokens, including comments."

	| lastMark |
	lastMark := 1.
	[currentComment ifNotNil:
		[currentComment do:
			[:cmnt| | idx |
			 idx := source originalContents indexOfSubCollection: cmnt startingAt: lastMark.
			 (idx > 0 and: [idx < mark]) ifTrue:
				[aBlock value: idx - 1 value: (lastMark := idx + cmnt size)]].
		 currentComment := nil].
	mark ifNotNil:
		[(token == #- 
		  and: [(self typeTableAt: hereChar) == #xDigit]) ifTrue:
			[| savedMark |
			 savedMark := mark.
			 self scanToken.
			 token := token negated.
			 mark := savedMark].
		"Compensate for the fact that the parser uses two character lookahead.  Normally we must
		  remove the extra two characters.  But this mustn't happen for the last token at the end of stream."
		 aBlock
			value: mark
			value: (source atEnd
					ifTrue: [tokenType := #doIt. "to cause an immediate ^self" source position]
					ifFalse: [source position - 2])].
	 (tokenType == #rightParenthesis
	  or: [tokenType == #doIt]) ifTrue:
		[^self].
	tokenType == #leftParenthesis
		ifTrue: 
			[self scanToken; scanAllTokenPositionsInto: aBlock]
		ifFalse: 
			[(tokenType == #word or: [tokenType == #keyword or: [tokenType == #colon]])
				ifTrue: 
					[self scanLitWord.
					 token == #true ifTrue: [token := true].
					 token == #false ifTrue: [token := false].
					 token == #nil ifTrue: [token := nil]]
				ifFalse:
					[(token == #- 
					  and: [(self typeTableAt: hereChar) == #xDigit])
						ifTrue: 
							[self scanToken.
							 token := token negated]]].
		self scanToken ] repeat! !

!Scanner methodsFor: 'multi-character scans' stamp: ''!
xDelimiter
	"Ignore blanks, etc."

	self scanToken! !

!Scanner methodsFor: 'multi-character scans' stamp: 'nice 2/9/2012 22:02'!
xLitQuote
	"Symbols and vectors: #(1 (4 5) 2 3) #ifTrue:ifFalse: #'abc'."
	| start |
	start := mark.
	self step.
	"litQuote"
	self scanToken.
	tokenType == #leftParenthesis
		ifTrue: [self scanToken; scanLitVec.
			mark := start + 1.
			tokenType == #doIt
				ifTrue: [self offEnd: 'Unmatched parenthesis']]
		ifFalse: [tokenType == #leftBracket
				ifTrue: [self scanToken; scanLitByte.
					mark := start + 1.
					tokenType == #doIt
						ifTrue: [self offEnd: 'Unmatched bracket']]
				ifFalse: [(tokenType == #word or: [tokenType == #keyword or: [tokenType == #colon]])
						ifTrue: [self scanLitWord]
						ifFalse: [tokenType == #literal
								ifTrue: [token isSymbol
										ifTrue: ["##word"
											token := token
											"May want to move toward ANSI
											here "]]
								ifFalse: [tokenType == #string
										ifTrue: [token := token asSymbol]]]]].
	mark := start.
	tokenType := #literal
	"#(Pen)
	#Pen
	#'Pen'
	##Pen
	###Pen
	"! !

!Scanner methodsFor: 'multi-character scans' stamp: 'nice 2/23/2012 21:52'!
xDollar
	"Form a Character literal."

	aheadChar == DoItCharacter
		ifTrue:
			[mark := mark + 1. "Let the notification lie behind the dollar"
			^self offEnd: 'A Character was expected'].
	self step. "pass over $"
	token := self step.
	tokenType := #number! !

!Scanner methodsFor: 'multi-character scans' stamp: 'nice 2/9/2012 14:32'!
typeTableAt: aCharacter
	^typeTable
		at: aCharacter charCode
		ifAbsent:
			[aCharacter == DoItCharacter
				ifTrue: [#doIt]
				ifFalse: [#xLetter]]! !

!Scanner methodsFor: 'error handling' stamp: 'nice 4/4/2010 21:45'!
ambiguousSelector: aString inRange: anInterval
	"Warning: this methods breaks backward compatibility: $- is now part of literal argument.."
	
	token := aString asSymbol.
	^self! !

!Scanner methodsFor: 'multi-character scans' stamp: 'nice 2/9/2012 21:19'!
xLetter
	"Form a word or keyword."

	| type |
	buffer reset.
	[(type := self typeTableAt: hereChar) == #xLetter or: [type == #xDigit]]
		whileTrue:
			["open code step for speed"
			buffer nextPut: hereChar.
			hereChar := aheadChar.
			aheadChar := source atEnd
							ifTrue: [DoItCharacter]
							ifFalse: [source next]].
	tokenType := (type == #xColon and: [aheadChar ~~ $=])
					ifTrue: 
						[buffer nextPut: self step.
						"Allow any number of embedded colons in literal symbols"
						[(self typeTableAt: hereChar) == #xColon] whileTrue:
							[buffer nextPut: self step].
						#keyword]
					ifFalse: [#word].
	token := buffer contents! !

!Scanner methodsFor: 'multi-character scans' stamp: 'MarcusDenker 4/24/2013 15:50'!
xUnderscore
	^ self xIllegal! !

!Scanner methodsFor: 'public access' stamp: 'PeterHugossonMiller 9/2/2009 15:56'!
scanTokens: textOrString 
	"Answer an Array that has been tokenized as though the input text, 
	textOrString, had appeared between the array delimitors #( and ) in a 
	Smalltalk literal expression."

	self scan: textOrString asString readStream.
	self scanLitVec.
	^token

	"Scanner new scanTokens: 'identifier keyword: 8r31 ''string'' .'"! !

!Scanner methodsFor: 'expression types' stamp: 'nice 2/9/2012 21:44'!
scanLitVec
	| s |
	s := (Array new: 16) writeStream.
	[tokenType == #rightParenthesis or: [tokenType == #doIt]] whileFalse:
		[tokenType == #leftParenthesis
			ifTrue: 
				[self scanToken; scanLitVec]
			ifFalse: 
				[(tokenType == #word or: [tokenType == #keyword or: [tokenType == #colon]])
					ifTrue: 
						[self scanLitWord.
						token == #true ifTrue: [token := true].
						token == #false ifTrue: [token := false].
						token == #nil ifTrue: [token := nil]]
					ifFalse:
						[(token == #- 
						  and: [(self typeTableAt: hereChar) == #xDigit]) ifTrue: 
							[self scanToken.
							 token := token negated]]].
		s nextPut: token.
		self scanToken].
	token := s contents! !

!Scanner methodsFor: 'error handling' stamp: ''!
notify: string 
	"Refer to the comment in Object|notify:." 
	self error: string! !

!Scanner methodsFor: 'expression types' stamp: 'nice 2/9/2012 21:50'!
scanStringStruct

	| s |
	s := (Array new: 16) writeStream.
	[tokenType == #rightParenthesis or: [tokenType == #doIt]]
		whileFalse: 
			[tokenType == #leftParenthesis
				ifTrue: 
					[self scanToken; scanStringStruct]
				ifFalse: 
					[tokenType == #word ifFalse:
						[^self error: 'only words and parens allowed']].
			s nextPut: token.
			self scanToken].
	token := s contents! !

!Scanner methodsFor: 'multi-character scans' stamp: 'YuriyTymchuk 10/29/2013 11:10'!
xDigit
	"Form a number."

	tokenType := #number.
	aheadChar == DoItCharacter
		ifTrue: [source skip: -1 "Read off the end last time"]
		ifFalse: [source skip: -2].
	token := (NumberParser on: source)
		failBlock: [:errorString :position | self notify: errorString at:position];
		nextNumber.
	self step; step! !

!Scanner methodsFor: 'expression types' stamp: 'PeterHugossonMiller 9/3/2009 11:10'!
scanLitByte
	| stream |
	stream := (ByteArray new: 16) writeStream.
	[ tokenType = #rightBracket or: [ tokenType = #doIt ] ] whileFalse: [
		tokenType = #word
			ifTrue: [ self scanLitWord ].
		(token isInteger and: [ token between: 0 and: 255 ])
			ifFalse: [ ^ self offEnd: '8-bit integer or right bracket expected' ].
		stream nextPut: token.
		self scanToken ].
	token := stream contents! !

!Scanner methodsFor: 'initialization' stamp: 'StephaneDucasse 3/13/2011 11:48'!
initScanner

	buffer := (String new: 40) writeStream.
	typeTable := String typeTable! !

!Scanner methodsFor: 'expression types' stamp: 'ul 3/27/2011 23:31'!
step

	| c |
	c := hereChar.
	hereChar := aheadChar.
	source atEnd
		ifTrue: [aheadChar := DoItCharacter]
		ifFalse: [aheadChar := source next].
	^c! !

!Scanner methodsFor: 'multi-character scans' stamp: 'BenjaminVanRyseghem 6/11/2012 13:46'!
xDoubleQuote
	"Collect a comment."
	| aStream |

	aStream := (String new: 200) writeStream.
	self step.
	[hereChar == $"]
		whileFalse:
			[hereChar == DoItCharacter
				ifTrue: [^self offEnd: 'Unmatched comment quote'].
			aStream nextPut: self step.].
	self step.
	(currentComment ifNil: [ 
		currentComment := OrderedCollection new ])
			add: aStream contents.
	self scanToken! !

!Scanner methodsFor: 'multi-character scans' stamp: 'nice 2/9/2012 09:39'!
xSingleQuote
	"String."

	self step.
	buffer reset.
	[hereChar == $' 
		and: [aheadChar == $' 
				ifTrue: [self step. false]
				ifFalse: [true]]]
		whileFalse: 
			[hereChar == DoItCharacter
				ifTrue: [^self offEnd: 'Unmatched string quote'].
			buffer nextPut: self step].
	self step.
	token := buffer contents.
	tokenType := #string! !

!Scanner methodsFor: 'error handling' stamp: ''!
offEnd: aString 
	"Parser overrides this"

	^self notify: aString! !

!Scanner class methodsFor: 'class initialization' stamp: 'nice 2/9/2012 21:53'!
initialize
	"The unicode ending with FFFE or FFFF are non characters and can be used by applications if they wish.
	We use last legal unicode 16r10FFFF to encode the end of source stream"
	DoItCharacter := Character value: 16r10FFFF! !

!Scanner class methodsFor: 'instance creation' stamp: 'ar 1/30/2005 11:50'!
new

	^self basicNew initScanner! !

!Schedule commentStamp: 'brp 5/13/2003 09:48'!
I represent a powerful class for implementing recurring schedules.!
!Schedule methodsFor: 'enumerating' stamp: 'brp 5/13/2003 09:50'!
schedule: anArrayOfDurations

	schedule := anArrayOfDurations
! !

!Schedule methodsFor: 'enumerating' stamp: 'brp 5/13/2003 09:51'!
scheduleDo: aBlock

	self between: (self start) and: (self end) do: aBlock. ! !

!Schedule methodsFor: 'enumerating' stamp: 'brp 5/13/2003 09:50'!
schedule
	^ schedule ! !

!Schedule methodsFor: 'enumerating' stamp: 'brp 5/13/2003 09:50'!
dateAndTimes

	| dateAndTimes |
	dateAndTimes := OrderedCollection new.
	self scheduleDo: [ :e | dateAndTimes add: e ].
	^ dateAndTimes asArray.! !

!Schedule methodsFor: 'private' stamp: 'stephane.ducasse 8/7/2009 23:27'!
scheduleDuration
	^ schedule sum! !

!Schedule methodsFor: 'private' stamp: 'stephane.ducasse 8/7/2009 23:28'!
everyDayAtSameTimes
	"Answer false if unknown"
	
	| count |
	count := (Duration days: 1) / self scheduleDuration.
	^ count >= 1 and: [ count isInteger ]! !

!Schedule methodsFor: 'enumerating' stamp: 'PaulDeBruicker 10/27/2011 10:17'!
between: aStart and: anEnd do: aBlock
	"from Cuis 99"
	
	| element end i startDate |
	end := self end min: anEnd.

	element := self start.	
	"Performance optimization. Avoid going through unnecesary days if easy."
	startDate := aStart asDate.
	(startDate > element asDate and: [ self everyDayAtSameTimes ]) ifTrue: [
		element := DateAndTime date: startDate time: element asTime ].

	i := 1.
	[ element < aStart ] whileTrue: [
		element := element + (schedule at: i).
		i := i + 1.
		i > schedule size ifTrue: [i := 1]].

	[ element <= end ] whileTrue: [
		aBlock value: element.
		element := element + (schedule at: i).
		i := i + 1.
		i > schedule size ifTrue: [i := 1]]
.
! !

!Schedule methodsFor: 'testing' stamp: 'brp 5/13/2003 09:38'!
includes: aDateAndTime

	| dt |
	dt := aDateAndTime asDateAndTime.
	self scheduleDo: [ :e | e = dt ifTrue: [^true] ].
	^ false.
! !

!ScheduleTest commentStamp: 'TorstenBergmann 2/5/2014 08:43'!
SUnit tests for recurring schedules (class Schedule).!
!ScheduleTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:44'!
testBetweenAndDoIncludedInSchedule
	| count |
	count := 0.
	aSchedule
		between: (DateAndTime
				year: 2003
				month: 4
				day: 1)
		and: (DateAndTime
				year: 2003
				month: 4
				day: 30)
		do: [:each | count := count + 1].
	self assert: count = 8! !

!ScheduleTest methodsFor: 'coverage' stamp: 'brp 9/25/2003 16:03'!
selectorsToBeIgnored

	| private | 
	private := #( #printOn: ).

	^ super selectorsToBeIgnored, private
! !

!ScheduleTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:44'!
testExampleFromSwikiPage
	"It is often neccessary to schedule repeated events, like airline flight schedules, TV programmes, and file backups.
	 Schedule is a Timespan which maintains an array of Durations.
	 The durations specify the offset to the next scheduled DateAndTime. "
	"Consider a TV programme scheduled for 8:30pm every Saturday and Sunday for the current year. "
	"Find the first Saturday and set its time to 20h30"
	| sat shows |
	sat := Year current asMonth dates detect: [ :d | d dayOfWeekName = #Saturday ].
	sat := sat start + (Duration hours: 20.5).
	"Create a schedule" 
	shows := Schedule starting: sat ending: Year current end.
	shows schedule: { Duration days: 1. Duration days: 6 }.
	"To inspect:"
	shows dateAndTimes.
	shows dateAndTimes collect: [ :dt | dt dayOfWeekName ].

! !

!ScheduleTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:44'!
testBetweenAndDoDisjointWithSchedule
	| count |
	count := 0.
	aSchedule
		between: (DateAndTime
				year: 2004
				month: 4
				day: 1)
		and: (DateAndTime
				year: 2004
				month: 4
				day: 30)
		do: [:each | count := count + 1].
	self assert: count = 0! !

!ScheduleTest methodsFor: 'running' stamp: 'brp 9/26/2004 19:30'!
tearDown

	DateAndTime localTimeZone: restoredTimeZone.
! !

!ScheduleTest methodsFor: 'tests' stamp: 'nk 3/30/2004 10:34'!
testMonotonicity

	| t1 t2 t3 t4 |
	t1 := DateAndTime now.
	t2 := DateAndTime now.
	t3 := DateAndTime now.
	t4 := DateAndTime now.

	self 
		assert: (	t1 <= t2);
		assert: (	t2 <= t3);
		assert: (	t3 <= t4).
! !

!ScheduleTest methodsFor: 'coverage' stamp: 'brp 9/25/2003 16:03'!
classToBeTested

	^ Schedule

! !

!ScheduleTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:44'!
testIncludes
	self assert: (aSchedule includes: (DateAndTime year: 2003 month: 6 day: 15 hour: 20 minute: 30 second: 0 offset: 0 hours))
	
! !

!ScheduleTest methodsFor: 'running' stamp: 'brp 9/26/2004 19:30'!
setUp
 	 "Schedule is a type of Timespan representing repeated occurences of the same event. 
	The beginning of the schedule is the first occurrence of the event.
	A schedule maintains an array of Durations. 
	Each durations specify the offset to the next scheduled each. 
	The duration of each occurence of the event is not specified. 
	Nor are any other attributes such as name"

	restoredTimeZone := DateAndTime localTimeZone.
	DateAndTime localTimeZone: (TimeZone timeZones detect: [:tz | tz abbreviation = 'GMT']).

	"Create aSchedule with an event scheduled for 8:30pm every Saturday 
	and Sunday for the year 2003. "
	"Create the first event occurring on the first Saturday at 8:30 pm: 1/4/03"
	firstEvent :=  DateAndTime year: 2003 month: 1 day: 4 hour: 20 minute: 30. 
	
	"Create a schedule for one year starting with the first event" 
	aSchedule := Schedule starting: firstEvent duration: 52 weeks.

	"Schedule the recurring events by scheduling the time in between each one.  
	One day for Sat-Sun. 6 days for Sun-Sat" 
	aSchedule schedule: { Duration days: 1. Duration days: 6 }.
! !

!ScheduleTest methodsFor: 'tests' stamp: 'brp 9/25/2003 16:08'!
testFromDateAndTime

	| oc1 oc2 |
	oc1 := OrderedCollection new.
	DateAndTime today to: DateAndTime tomorrow by: 10 hours do: [ :dt | oc1 add: dt ].

	oc2 := { DateAndTime today. 
			(DateAndTime today + 10 hours). 
				(DateAndTime today + 20 hours) }.

	self assert: (oc1 asArray = oc2)! !

!ScheduleTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:44'!
testBetweenAndDoOverlappingSchedule
	| count |
	count := 0.
	aSchedule
		between: (DateAndTime
				year: 2002
				month: 12
				day: 1)
		and: (DateAndTime
				year: 2003
				month: 1
				day: 31)
		do: [:each | count := count + 1].
	self assert: count = 8! !

!ScheduleTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:44'!
testSchedule
	self assert: aSchedule schedule size = 2.
	self assert: aSchedule schedule first = 1 days.	
	self assert: aSchedule schedule second = 6 days.
! !

!ScheduleTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:44'!
testDateAndTimes
	| answer |
	self assert: aSchedule dateAndTimes size  = 104.
	self assert: aSchedule dateAndTimes first = firstEvent.
	answer := true.
	aSchedule dateAndTimes do: [:each | (each dayOfWeekName = 'Saturday'
		or: [each dayOfWeekName = 'Sunday']) ifFalse: [^false]].
	self assert: answer
! !

!ScheduleTest methodsFor: 'tests' stamp: 'PaulDeBruicker 10/27/2011 10:18'!
testDaysOfWeekAreConsistent
	| originalDayOfWeekSet modifiedDayOfWeekSet start end |
	originalDayOfWeekSet := (aSchedule dateAndTimes collect: [ :each | each dayOfWeek ]) asSet.
	start := DateAndTime
		year: 2003
		month: 1
		day: 5
		hour: 20
		minute: 30.
	end := DateAndTime
		year: 2003
		month: 6
		day: 4
		hour: 20
		minute: 30.
	modifiedDayOfWeekSet := OrderedCollection new.
	aSchedule between: start and: end do: [ :eachStart | modifiedDayOfWeekSet add: eachStart dayOfWeek ].
	self assert: originalDayOfWeekSet equals: modifiedDayOfWeekSet asSet! !

!ScriptLoader commentStamp: 'StephaneDucasse 5/30/2014 09:00'!
Pharo Process Description. This comment contains: 
	- some points on infrastructure
	- some scripts description 	
	- main behavior of the scriptLoader.
	
General points on infrastructure 
---------------------------------------------------------------------------------------------------------------------------------
An enhancement
	- should be added to the bug tracker https://pharo.fogbugz.com
	- announced to the mailing-list
	- asked for feedback 
	- results should be added to the BT entry

FixedToInclude tag means ready for integration.
FixToreview means that people should have a look and give feedback (often just need to FixToInclude)

A bug detected and discussed via the mailing-list should be added to the bug tracker. 
When a fix is provided, it should be either posted on the bug tracker as a slice in the PharoInbox - (a slice is an emtpy package that has as requirement other package composing the fix).

- Repositories
---------------------
For each Pharo version, we have three projects:
	Pharo
	PharoInbox
	(PharoTreatedInbox - was used in Pharo20 and we hope to get it back)
	
A fix goes either from inbox to treatedInbox or to Pharo.
If a fix does not work it is moved to the TreatedInbox.
If a fix works it is integrated as follow - it will be moved from the Inbox to the TreatedInbox
and integrated and published in the Pharo project


It is now a bit old but to help browsing multiple repositories use the following expression: ScriptLoader new addExtraRepositories

	self addRepository39ToAllPackages.
	self addRepository310ToAllPackages.
	self addRepositoryTaskForcesToAllPackages.
	self addRepositorySqueakTrunkToAllPackages.
	self addRepositoryMCToAllPackages.
	self addRepositoryTreatedToAllPackages.

System Scripts
-------------------------

Before starting and you need to download (only once) the pharo-updates folder from git hub:

	git clone https://github.com/pharo-project/pharo-update.git
	cd pharo-update
	git checkout 40

to work on the right branch



Typically before any integration, execute the script prepare.sh 
----------------------------------------------------------------------------
#!! /bin/bash

version=3.0
working_dir=current
previous_dir=previous
zip_name=latest.zip

if [ -e $zip_name ]; then
        rm $zip_name
fi
wget --no-check-certificate http://files.pharo.org/image/30/$zip_name
rm -Rf $previous_dir
mv $working_dir $previous_dir
unzip -d $working_dir $zip_name  
mv $working_dir/Pharo*.image $working_dir/Pharo.image
mv $working_dir/Pharo*.changes $working_dir/Pharo.changes
cp PharoPass.txt $working_dir/PharoPass.txt
./scripts/getupdateslist.sh
pharo $working_dir/Pharo.image

the script getupdateslist.sh is defined as follows: 
----------------------------------------------------------------------------
#!!/bin/bash

flatten_version=30
updates_dir=./pharo-update
working_dir=current
current_dir=`pwd`

cd $updates_dir
git pull
cd $current_dir
cp $updates_dir/updates$flatten_version.staged $working_dir


Later when you will be done and you will kick the integration server you will need the following publish script.

The publish.sh script is defined as follows:

#!! /bin/bash

version=3.0
updates_dir=./pharo-update
current_dir=current
previous_dir=previous

cp $current_dir/*.cs $updates_dir
cp $current_dir/*.staged $updates_dir
./scripts/publish.sh





4 Steps of the integration process
------------------------------------------------------
Precondition: you have run the ./prepare.sh scripts and before that one you should do a git clone of the pharo-update repository.

The integration works in 4 main steps which can be steered by the following expression
ScriptLoader releaseMenu

or via the menu that can be shown/hidden using 
	ScriptLoader showIntegrationMenu
	ScriptLoader hideIntegrationMenu



---------------------------------------------------------------------------------------------------------------------------------
1.) 'Prepare new update' :  Start up a recent and clean image
	ScriptLoader new prepareNewUpdate
	
	This step will 
		- load the latest updates
		
		- load the latest version of the ScriptLoader package from the Pharo repository.
		Indeed when we work on improving the ScriptLoader it may not be published in the update stream. 
		New versions can be available on the server but not part of the latest updates.
		Therefore the process always loads the latest version of scriptloader from the pharo repository.
		This point is important because when an integration failed, you have to check and optionally 
		remove the scriptloader package from the pharo repository or republished a previous version with a more recent 		number to override the last one.
		
		- check that the update.list (which contains the cs to load the packages) is in sync
		with the image current version. The update was done automatically by the prepare bash script (which pulls from git).
		
		- snapshot the package version to detect dirty or changed but non dirty packages.

2.) Apply changes

	Once you are done and select the second menu item or  
	
		ScriptLoader new doneApplyingChanges
	
	This step will 
		- create an update method with can trigger the load of the packages and some pre/post actions
		- create a script method with describes all the package versions and it used by the update methods
		- save all the packages that are different (except some filtered packages)	
		into a local folder named 'package-to-be-tested'.
		ScriptLoader, SLICE*.... and a couple of other packages are not considered to be included in the script method
			(check method packagesNotToSavePatternNames)
		

3.) Verify changes
	==> in a ***new*** image (in the current folder) execute:
	ScriptLoader new verifyNewUpdate

	This step will 
		- load in any order (so may break) the packages previously saved
		in the 'package-to-be-tested' folder.
		- this step is important because you may get simple changes with unexpected side effects and that 
		may break the load.
		

4.) If there are problems go to 2.) to fix them, else you can commit the changes.

	ScriptLoader new publishChanges

	This step will
		- generate a new cs file whose purpose is to load the given version of the scriptloader and trigger the 
		correct update method.
		- add the name of the cs file to the end of the updates.staged file local to the disc
		- copy all the package from the local directory to the Pharo
		
	At the current time (August 2013), you will get the contents of the mail that you can send to the list. 
	Now you will have to wait before sending it because you need to kick in the ci integration process. 
			Execute the publish.sh bash script to publish the cs and the staged file in git.
	
	Then go to the https://ci.inria.fr/pharo/? page.
	You will see that the ci will validate your integration automatically.
		First it will load the code (strangely named: Step-1-Tracker) 
		Second it will validate it: Step-2-Validation 
		Third it will release it: Step-3-Release 
		Fourth it will publish it: Step-4-Publish 
	
	As a result the pharo-update and a new image will be published.
	You can then send the mail of the new update.
		
		


5) in case of problems.
If a problem arrives during the step 4, your update.staged file and your image may not in sync!! 
Do not stress!! Normally it should be easy to fix.
		 
If the ci integration failed previously: 
		- 1. Load the previous version of the Scriptloader, modify it to get the package dirty and republish it. It will get a newer number and the setting up of the integration will load it instead of a version of ScriptLoader containing an integration that did not finish.
		-2 just throw away your current directory. Do not worry about the fact that the changeset has been added to git. When you will integrate, the process will create a file with the same number and erase the committed one. 

Note that if you have to rollback the created image you have to access the file repository to remove the latest image.
		The file server is available at
		 files.pharo.org
			Server:		193.51.235.3
			Address:	193.51.235.3#53
		It may be possible that you do not access and need to get your ssh files there first. 




Other notes.
--------------------

CurrentMajorVersionNumber should contains a string '1.0', '1.1'....
This string will determine on which folder on the server the updates.list should be loaded.
	i.e., updates/pharo1.0, updates/pharo1.1 ....

--- Not to forget ---
To change the release stream
add a new method for each releaseStream
	ScriptLoader toPharoOne
	ScriptLoader toPharoOneDotOne
!
!ScriptLoader methodsFor: 'mc related utils' stamp: 'StephaneDucasse 5/26/2012 22:01'!
allCurrentPackages
	"ScriptLoader new allCurrentPackages" 
	
	| copies |
	copies := self allManagers asSortedCollection:
		[ :a :b | a package name <= b package name ].
	^ copies! !

!ScriptLoader methodsFor: 'private' stamp: 'MarcusDenker 7/10/2012 10:37'!
saveAsImageAsTestImage
	"Now you can run tests and see and go back to the previous image
	and do that go and back.... then after you can decide to freeze"

	| file |
	file := FileSystem workingDirectory  /  (self shortImageName, '-imageForTests') , Smalltalk imageSuffix.
	Smalltalk image saveAs: file nextVersion basename.! !

!ScriptLoader methodsFor: 'menu integration actions' stamp: 'MarcusDenker 5/5/2013 12:51'!
publishChanges
	| username password str strings|
	(FileStream isAFileNamed: 'PharoPass.txt') 
		ifTrue: [ str := FileStream fileNamed:  'PharoPass.txt'. 
				strings := str contents substrings.
				username := strings first.
				password := strings second] 
		ifFalse: [ username := UIManager default request: 'Pharo repository login'.
			     password := UIManager default requestPassword: 'Pharo repository password'.].

	self setToRepositoriesPassword: password to: username.
	
	self csForLastUpdateAndPatchUpdatesList: 'Update'.
	self copyPackagesFromWaitingFolderToHomeRepository.
	self announceOnMailingList.
	self inform: 'All packages have been uploaded to the Pharo repository.
Remaining manual steps:
1) ./pushUpdate 
2) Announce new update on mailing list'! !

!ScriptLoader methodsFor: 'generate scripts/methods' stamp: 'StephaneDucasse 8/21/2011 16:24'!
generateCS: packageInfo fromUpdate: updateNumber on: st
	
	st nextPutAll:
'"Postscript:
Leave the line above, and replace the rest of this comment by a useful one.
Executable statements should follow this comment, and should
be separated by periods, with no exclamation points (!!!!).
Be sure to put any further comments in double-quotes, like this one."

|repository|
repository := MCHttpRepository
                location: ''', self homeRepositoryUrlString,
'''
                user: ''''
                password: ''''.
(repository loadVersionFromFileNamed:' .
	st nextPut: $' ; nextPutAll: packageInfo, '.mcz'') load.'; cr.
	st nextPutAll: 'ScriptLoader new update', (updateNumber) asString; nextPutAll: '.' ; cr.
	st nextPutAll: '!!'.
	^ st contents
! !

!ScriptLoader methodsFor: 'accessing' stamp: 'StephaneDucasse 8/21/2011 15:19'!
repository
	^ repository ifNil: [
		repository := MCHttpRepository new
			location: self homeRepositoryUrlString ;
			user: '';
			password: '']! !

!ScriptLoader methodsFor: 'ci' stamp: 'SeanDeNigris 7/12/2012 08:44'!
loadLatestUpdateListSilently
	"fetch the latest version of the update.list on the server"
	
	| result listToUse lastUpdate |
	(result := ZnEasy get: UpdateStreamer new updateFolderURL, self updatesListFileName) isSuccess
		ifFalse: [ self error: 'Cannot access update server' ].
	listToUse := result contents.			
	listToUse linesDo: [:each | lastUpdate := each].
	(lastUpdate beginsWith: self getLatestUpdateNumber asString)
		 ifTrue: ["Write this file as our current updates.list"
			self updatesListFileName asFileReference delete;
				writeStreamDo:  [:stream | stream nextPutAll: listToUse]]
		ifFalse: [ 
			self inform: 'Image update version did not match automatically fetched  update.list!!  
			Proceed after downloading using the script ./getUpdatesList instead' ].
	! !

!ScriptLoader methodsFor: 'elementary steps' stamp: 'EstebanLorenzano 3/19/2013 11:32'!
csForLastUpdateAndPatchUpdatesList: aString
	"Creates update changeSet and pending list for continuous integration"
	| filename |
	filename := self csForLastUpdate: aString.
	self updateStageList: aString.
	^ filename ! !

!ScriptLoader methodsFor: 'ci' stamp: 'EstebanLorenzano 9/17/2014 12:15'!
publicChangesSilently: changes user: username password: password
	self setToRepositoriesPassword: password to: username.
	self csForLastUpdateAndPatchUpdatesList: 'Update'.
	self copyPackagesFromWaitingFolderToHomeRepository! !

!ScriptLoader methodsFor: 'private' stamp: 'michael.rueger 1/13/2009 15:25'!
loadVersionFromFileNamed: fn
	| version |
	version := self repository loadVersionFromFileNamed: fn.
	^version
		ifNil: [self inboxRepository loadVersionFromFileNamed: fn]! !

!ScriptLoader methodsFor: 'ci' stamp: 'MarcusDenker 2/25/2015 17:29'!
generateScriptAndUpdateMethodForNewVersionSilentlyConfigurations: configurations preLoad: preload postLoad: postLoad
	
	"remove old update and script methods"
	self removeUpdateMethods.
	self removeScriptMethods.
	
	self compileScriptMethodWithCurrentPackages: self currentScriptVersionNumber.
	self 
		compileNewUpdateMethodSilentlyConfigurations: configurations 
		preLoad: preload 
		postLoad: postLoad! !

!ScriptLoader methodsFor: 'mc related utils' stamp: 'sd 3/15/2008 17:40'!
addHomeRepositoryToPackageNamed: aString
	
	|pa|
	pa := MCPackage named: aString.
	pa workingCopy repositoryGroup addRepository: self repository.
	! !

!ScriptLoader methodsFor: 'new script-update format' stamp: 'MarcusDenker 7/5/2014 14:23'!
newGenerateNewUpdateMethod
	"ScriptLoader new newGenerateNewUpdateMethod"
	
	| str mthName preamble postscript |
	str := ReadWriteStream on: (String new: 1000).
	mthName := 'update', self currentUpdateVersionNumber asString.
	str nextPutAll: mthName ; cr  ; tab.
	str nextPutAll: '"self new ', mthName, '"'; crtab. 
	preamble := UIManager default 
		multiLineRequest: 'Preamble expression'
		initialAnswer: ''
		answerHeight: 100.
	preamble isEmptyOrNil ifFalse: [str nextPutAll: preamble; ensureEndsWith: $.; crtab].

	str nextPutAll: 'self withUpdateLog: ' ; nextPut: $'; nextPutAll: self commentForCurrentUpdate ; nextPut: $'; nextPut: $. .
	str crtab.
	str nextPutAll: 'self loadTogether: '.
	str nextPutAll: 'self script' , self currentScriptVersionNumber asString, ' merge: false.'.
	str crtab.
	postscript := UIManager default
					multiLineRequest: 'Postscript expression'
					initialAnswer: ''
					answerHeight: 100. 
	postscript isEmptyOrNil ifFalse: [str nextPutAll: postscript; ensureEndsWith: $.; crtab].
	
	str nextPutAll: 'self flushCaches.'; cr.
	str nextPutAll: 'self cleanRepositories.'; cr.
	
	
	^ str contents! !

!ScriptLoader methodsFor: 'elementary steps' stamp: 'S 6/17/2013 13:16'!
csForLastUpdate: aString
	"Create the changeSet for latest update (preamble, update, postload)"
	
	| updateNumber filename|
	
	updateNumber := self getLatestUpdateNumber.
	filename := updateNumber asString, '-Pha-', aString, '.cs'.
	filename asFileReference 
		ensureDelete;
		writeStreamDo: [ :stream|
			self 
				generateCS: self latestScriptLoaderPackageIdentificationString
				fromUpdate: updateNumber on: stream].
	^ filename! !

!ScriptLoader methodsFor: 'mc related utils' stamp: 'SeanDeNigris 8/26/2012 15:54'!
installRepository: aString for: packageName

	(self allManagers select: [:each | each package name = packageName])
		first repositoryGroup
		addRepository: (MCHttpRepository location: aString)
		! !

!ScriptLoader methodsFor: 'menu integration actions' stamp: 'SvenVanCaekenberghe 1/16/2014 23:07'!
doneApplyingChanges
	| comment commentQuoted st |
	Smalltalk image saveSession.
		"now you can reopen prior to publishing to fix :)"
	self saveAsNewImageWithCurrentReleaseNameToPublish.
	
	comment := UIManager default
		multiLineRequest: 'Comment for this update.'
		initialAnswer: self generateCommentForCurrentUpdate
		answerHeight: 200.
	comment ifNil: [^ self].
	
	commentQuoted := comment copyReplaceAll: (String with: $') with: (String with: $' with: $').
	st := String new writeStream.
	st nextPutAll: 'commentForCurrentUpdate'; cr.
	st nextPutAll: ' ^ '.
	st nextPut: $'.
	st nextPutAll: commentQuoted.
	st nextPut: $'.
	self class
		compile: (st contents)
		classified: 'public'.

	self class waitingCacheFolder deleteAllChildren.
	self saveChangedPackagesIntoWaitingFolder.
	self generateScriptAndUpdateMethodForNewVersion.
	self saveLatestScriptLoaderToWaitingFolder.
	
	self inform: 'Update prepared and ready to be verified.'! !

!ScriptLoader methodsFor: 'ci' stamp: 'EstebanLorenzano 9/23/2014 16:03'!
doneApplyingChangesSilentlyComment: providedComment configurations: configurations preLoad: preload postLoad: postLoad
	| comment commentQuoted st |
	Smalltalk image saveSession.
	self saveAsNewImageWithCurrentReleaseNameToPublish.
	comment := providedComment trimBoth.
	
	commentQuoted := comment copyReplaceAll: (String with: $') with: (String with: $' with: $').
	st := String new writeStream.
	st nextPutAll: 'commentForCurrentUpdate'; cr.
	st nextPutAll: ' ^ '.
	st nextPut: $'.
	st nextPutAll: commentQuoted.
	st nextPut: $'.
	self class
		compile: (st contents)
		classified: 'public'.

	self class waitingCacheFolder deleteAllChildren.
	self saveChangedPackagesIntoWaitingFolder.
	self 
		generateScriptAndUpdateMethodForNewVersionSilentlyConfigurations: configurations 
		preLoad: preload 
		postLoad: postLoad.
	self saveLatestScriptLoaderToWaitingFolder.! !

!ScriptLoader methodsFor: 'accessing' stamp: 'lr 3/14/2010 21:13'!
gofer
	^ Smalltalk globals
		at: #Gofer
		ifAbsent: [ 
			self
				installGofer;
				gofer ]! !

!ScriptLoader methodsFor: 'mc related utils' stamp: 'StephaneDucasse 5/26/2012 22:01'!
currentVersions
	"ScriptLoader new currentVersions"
	
	| copies |
	copies := self allManagers asSortedCollection:
		[ :a :b | a package name <= b package name ].
	^ copies collect:
		[:ea |  ea ancestry ancestorString ]! !

!ScriptLoader methodsFor: 'elementary steps' stamp: 'EstebanLorenzano 8/26/2014 16:57'!
saveLatestScriptLoaderToHome
	"self new saveLatestScriptLoaderToHome"

	| man r |
	man := self allManagers.
	r := man select: [:each | each packageName matchesRegex: self theScriptLoaderPackageName, '.*' ].
	self repository storeVersion: (r first newVersionIn: self repository).! !

!ScriptLoader methodsFor: 'private' stamp: 'MarcusDenker 7/10/2012 10:37'!
saveAsNewImageWithCurrentReleaseNameToPublish
	"If the reload failed and you do not want to lose time reload all the cs and packages... you can now restart from the image saved now"
	
	| file |
	file := FileSystem workingDirectory  / (self shortImageName, '-releasePharoToPublish'), Smalltalk imageSuffix.
	
	Smalltalk image saveAs: file nextVersion basename.! !

!ScriptLoader methodsFor: 'accessing' stamp: 'StephaneDucasse 8/21/2011 15:23'!
inboxRepositoryDefault
	^ MCHttpRepository new 
	 	location: self inboxRepositoryUrlString;
		user: '';
		password: ''! !

!ScriptLoader methodsFor: 'elementary steps' stamp: 'SeanDeNigris 7/12/2012 08:44'!
updateUpdatesList: aString
	"ScriptLoader new updateUpdatesList: 'cleanUpMethods'"
	
	self updatesListFileName asFileReference writeStreamDo: [ :str|
		str
			setToEnd;
			cr;
			nextPutAll: self currentUpdateVersionNumber asString;
			nextPutAll: '-Pha-', aString, '.cs' ]! !

!ScriptLoader methodsFor: 'menu integration actions' stamp: 'StephaneDucasse 8/22/2013 21:55'!
prepareNewUpdate
	self launchUpdate.
	self loadLatestScriptloader.
	self markPackagesBeforeNewCodeIsLoaded.
	self checkImageIsUptodate ifFalse: [self loadLatestUpdateList].
	self checkImageIsUptodate ifFalse: [
		^ self inform: 'Your update.staged file and your image are not in sync!! Do not stress!! Normally it should be easy to fix.
		 
		If the integration failed previously: 
		- 1. Load the previous version of the Scriptloader, modify it to get the package dirty and republish it. It will get a newer number and the setting up of the integration will load it instead of a version of ScriptLoader containing an integration that did not finish.
		-2 just throw away your current directory. Do not worry about the fact that the changeset has been added to git. When you will integrate, the process will create a file with the same number and erase the committed one. 
		
		Note that if you have to rollback the created image you have to access the file repository to remove the latest image.
		The file server is available at
		 files.pharo.org
			Server:		193.51.235.3
			Address:	193.51.235.3#53
		It may be possible that you do not access and need to get your ssh files there first. 
		' ].
	self setUpdateAndScriptVersionNumbers.
	self saveAsNewImageWithCurrentReleaseName.
	self inform: 'The new version number is ' , self currentUpdateVersionNumber asString , '. Ready to apply changes now.', String cr, 'You are now running in image ', (Smalltalk imageFile basename).! !

!ScriptLoader methodsFor: 'mc related utils' stamp: 'StephaneDucasse 5/26/2012 22:01'!
addRepositoryTaskForcesToAllPackages
	"self new addRepositoryTaskForcesToAllPackages"
	
	self allManagers do: [:each | 
		each repositoryGroup
			 addRepository: self repositoryTaskForces
			].
	
	! !

!ScriptLoader methodsFor: 'mc related utils' stamp: 'EstebanLorenzano 8/26/2014 16:57'!
latestScriptLoaderPackageIdentificationString
	"ScriptLoader new latestScriptLoaderPackageIdentificationString"
	
	^  self allCurrentVersions detect: [:each | each matchesRegex: self theScriptLoaderPackageName, '.*' ]! !

!ScriptLoader methodsFor: 'private' stamp: 'Jb 10/23/2010 12:14'!
launchUpdate

	UpdateStreamer new updateFromServer! !

!ScriptLoader methodsFor: 'generate scripts/methods' stamp: 'DamienCassou 9/8/2009 14:41'!
currentUpdateVersionNumber
	^ CurrentUpdateVersionNumber ifNil: [SystemVersion current highestUpdate]! !

!ScriptLoader methodsFor: 'ci' stamp: 'EstebanLorenzano 9/23/2014 16:05'!
compileNewUpdateMethodSilentlyConfigurations: configurations preLoad: preload postLoad: postLoad
	"Use me to create a new update method with the next update number"
	"self new compileNewUpdateMethod"
	

	self class 
		compile: (self 
			newGenerateNewUpdateMethodSilentlyConfigurations: configurations 
			preLoad: preload 
			postLoad: postLoad)
		classified: 'pharo - updates'! !

!ScriptLoader methodsFor: 'accessing' stamp: 'StephaneDucasse 8/21/2011 15:23'!
inboxRepository
	^ inboxRepository ifNil: [inboxRepository :=  self inboxRepositoryDefault]
	! !

!ScriptLoader methodsFor: 'accessing' stamp: 'StephaneDucasse 5/3/2013 11:08'!
diffServerRootString

	^  'http://smalltalkhub.com/mc/Pharo/Pharo30/main/'! !

!ScriptLoader methodsFor: 'private' stamp: 'EstebanLorenzano 8/26/2014 16:57'!
produceDiffLinksForPackages
	"self defaultMCWaitingFolder allFileNames"
	"self new produceDiffLinksForPackages"
	
	| filenames |
	filenames := self waitingFolderMCZFiles.
	filenames := filenames reject: [:each | each matchesRegex: self theScriptLoaderPackageName, '.*' ].
	^ filenames collect: [:name |
			 self diffServerRootString, (name copyUpToLast: $.) , '.diff'  ]
		! !

!ScriptLoader methodsFor: 'private' stamp: 'StephaneDucasse 10/16/2012 12:46'!
announceOnMailingList
	"self new announceOnMailingList"
	
	| title contents |
	title := '[update ', self currentMajorVersionNumber asString , '] #', self currentUpdateVersionNumber asString.
	
	contents := String streamContents: [:str |
			str 
				nextPutAll:  title; cr ; 
				nextPutAll: self currentUpdateVersionNumber asString; 
				nextPutAll: '
-----

';
				nextPutAll: self commentForCurrentUpdate.
			str cr.
			str nextPutAll: 'Diff information:'; cr.
			self produceDiffLinksForPackages do: [:each |
				str nextPutAll: each ; cr].
				 
			str contents
			].	
	
	UIManager default
		edit: contents
		label: title.! !

!ScriptLoader methodsFor: 'load primitives' stamp: 'CamilloBruni 10/26/2013 21:50'!
loadTogether: aCollection merge: aBoolean
	| loader |
	loader := aBoolean
		ifTrue: [ MCVersionMerger new ]
		ifFalse: [ MCVersionLoader new].
	(self newerVersionsIn: aCollection)
		do: [:fn | loader addVersion: (self loadVersionFromFileNamed: fn)]
  	  	displayingProgress: 'Adding versions...'.
	aBoolean
		ifTrue: [
			[loader merge] on: MCMergeResolutionRequest do: [:request | request autoMerge ]]
		ifFalse: [
			loader hasVersions 
				ifTrue: [ [loader load] on: MCMergeOrLoadWarning do: [:ex | ex load ]]]

! !

!ScriptLoader methodsFor: 'private' stamp: 'StephaneDucasse 11/13/2010 22:30'!
setToRepositoriesPassword: aPassword to: aUser
	"self new setToRepositoriesPassword: 'sd' to: 'zork'"
	
	MCRepositoryGroup instVarNamed: 'default' put: nil. 
	self removeAllHTTPRepositories: {self repository locationWithTrailingSlash . self inboxRepository locationWithTrailingSlash}. 
	self repository password: aPassword.
	self repository user: aUser.
	self inboxRepository password: aPassword.
	self inboxRepository user: aUser.
	self addHomeRepositoryToAllPackages! !

!ScriptLoader methodsFor: 'menu integration actions' stamp: 'lr 3/14/2010 21:13'!
verifyNewUpdate
	self repository: self class defaultMCWaitingFolder.
	self class loadLatestPackage: 'ScriptLoader' fromRepository: self repository.
	self perform: ('update' , self getLatestUpdateNumber asString) asSymbol.
	(self confirm: 'Completed loading the new update. Run all test now?')
		ifTrue: [ 
			Author fullName: 'tester'.
			Smalltalk globals at: #TestRunner ifPresent: [ :class | class open model runAll ] ]! !

!ScriptLoader methodsFor: 'generate scripts/methods' stamp: 'stephane.ducasse 3/21/2009 14:41'!
generateScriptTemplateWithAllCurrentPackages
	"ScriptLoader new generateScriptTemplateWithAllCurrentPackages"
	
	| str |
	str := ReadWriteStream on: (String new: 1000).
	str nextPutAll: 'scriptXXX' ; cr ; cr ; tab.
	str nextPutAll: '| names|'; cr.
	str nextPutAll: 'names := '.
	str nextPut: $'.
	self currentVersionsToBeSaved do: 
		[:each |
			str nextPutAll: each ; nextPutAll: '.mcz']
		separatedBy: [str nextPut: Character cr].
	str nextPut: $'; nextPut: Character cr.
	str nextPutAll: 'findTokens: String lf , String cr.

	self loadTogether: names merge: false.'.
	^ str contents! !

!ScriptLoader methodsFor: 'generate scripts/methods' stamp: 'StephaneDucasse 8/21/2011 16:30'!
rootURLString 

	^ self class rootURLString! !

!ScriptLoader methodsFor: 'elementary steps' stamp: 'EstebanLorenzano 8/25/2014 13:41'!
loadLatestScriptloader
	"self new loadLatestScriptloader"
	
	self class 
		loadLatestPackage: self theScriptLoaderPackageName
		fromHub: 'Pharo40' 
	

! !

!ScriptLoader methodsFor: 'pharo - scripts' stamp: 'TheIntegrator 4/14/2015 08:27'!
script607

	^ 'AST-Core-TheIntegrator.283.mcz
AST-Tests-Core-TheIntegrator.65.mcz
Announcements-Core-MarcusDenker.55.mcz
Announcements-Help-TheIntegrator.12.mcz
Announcements-Tests-Core-TheIntegrator.25.mcz
AsmJit-Core-MarcusDenker.8.mcz
AsmJit-Extension-MarcusDenker.8.mcz
AsmJit-Instructions-TheIntegrator.13.mcz
AsmJit-Operands-StephaneDucasse.14.mcz
AsmJit-StackManagement-SvenVanCaekenberghe.11.mcz
AsmJit-Tests-TheIntegrator.21.mcz
AsmJit-x86-TheIntegrator.40.mcz
Athens-Balloon-MarcusDenker.20.mcz
Athens-Cairo-MarcusDenker.85.mcz
Athens-CairoPools-NicolaiHess.14.mcz
Athens-Core-MarcusDenker.50.mcz
Athens-Examples-MarcusDenker.42.mcz
Athens-Morphic-NicolaiHess.44.mcz
Athens-Text-NicolaiHess.16.mcz
Balloon-StephaneDucasse.118.mcz
BalloonTests-MarcusDenker.3.mcz
Chroma-CubeHelix-TheIntegrator.2.mcz
CodeImport-TheIntegrator.48.mcz
Collections-Abstract-StephaneDucasse.276.mcz
Collections-Arithmetic-TheIntegrator.15.mcz
Collections-Atomic-MarcusDenker.10.mcz
Collections-Native-TheIntegrator.9.mcz
Collections-Sequenceable-TheIntegrator.189.mcz
Collections-Stack-MarcusDenker.7.mcz
Collections-Streams-TheIntegrator.168.mcz
Collections-Strings-TheIntegrator.350.mcz
Collections-Support-MarcusDenker.57.mcz
Collections-Unordered-TheIntegrator.207.mcz
Collections-Weak-TheIntegrator.88.mcz
CollectionsTests-TheIntegrator.683.mcz
Compiler-TheIntegrator.582.mcz
Compression-TheIntegrator.149.mcz
CompressionTests-TheIntegrator.29.mcz
ConfigurationCommandLineHandler-Core-TheIntegrator.27.mcz
ConfigurationCommandLineHandler-Tests-MarcusDenker.11.mcz
Debugger-Tests-TheIntegrator.2.mcz
DebuggerActions-MarcusDenker.74.mcz
DebuggerFilters-TheIntegrator.9.mcz
DebuggerModel-TheIntegrator.106.mcz
Deprecated40-TheIntegrator.48.mcz
EmbeddedFreeType-TheIntegrator.15.mcz
EmbeddedFreeType-Tests-TheIntegrator.4.mcz
EmergencyEvaluator-MarcusDenker.32.mcz
FileSystem-Core-TheIntegrator.171.mcz
FileSystem-Disk-TheIntegrator.79.mcz
FileSystem-Memory-TheIntegrator.57.mcz
FileSystem-Tests-Core-TheIntegrator.88.mcz
FileSystem-Tests-Disk-TheIntegrator.22.mcz
FileSystem-Tests-Memory-TheIntegrator.8.mcz
FileSystem-Zip-TheIntegrator.17.mcz
Files-TheIntegrator.373.mcz
FontChooser-TheIntegrator.7.mcz
FontInfrastructure-TheIntegrator.8.mcz
FontInfrastructure-Tests-TheIntegrator.2.mcz
FreeType-TheIntegrator.695.mcz
FreeTypeTests-SvenVanCaekenberghe.5.mcz
Fuel-TheIntegrator.804.mcz
FuelCommandLineHandler-TheIntegrator.27.mcz
FuelSystem-FileRegistry-EstebanLorenzano.3.mcz
FuelTests-TheIntegrator.384.mcz
FuelTools-Debugger-StephaneDucasse.12.mcz
GT-Inspector-TudorGirba.305.mcz
GT-InspectorExtensions-Core-TudorGirba.144.mcz
GT-Playground-TudorGirba.110.mcz
GT-Spotter-StefanReichhart.307.mcz
GT-Spotter-EventRecorder-JurajKubelka.89.mcz
GT-SpotterExtensions-Core-TudorGirba.141.mcz
GT-Tests-Inspector-StefanReichhart.33.mcz
GT-Tests-Playground-StefanReichhart.4.mcz
GT-Tests-Spotter-TudorGirba.8.mcz
Generated-code-non-existing-package-EstebanLorenzano.2.mcz
Glamour-Announcements-AndreiChis.8.mcz
Glamour-Browsers-TorstenBergmann.109.mcz
Glamour-Core-StefanReichhart.299.mcz
Glamour-Examples-TorstenBergmann.291.mcz
Glamour-Helpers-AndreiChis.39.mcz
Glamour-Morphic-Brick-StefanReichhart.398.mcz
Glamour-Morphic-Brick-Tests-AliakseiSyrel.13.mcz
Glamour-Morphic-Pager-AndreiChis.103.mcz
Glamour-Morphic-Renderer-AndreiChis.320.mcz
Glamour-Morphic-Theme-StefanReichhart.212.mcz
Glamour-Morphic-Widgets-AndreiChis.177.mcz
Glamour-Presentations-AndreiChis.176.mcz
Glamour-Rubric-Presentations-AndreiChis.41.mcz
Glamour-Tests-Core-AliakseiSyrel.104.mcz
Glamour-Tests-Morphic-AndreiChis.124.mcz
Glamour-Tests-Resources-AndreiChis.3.mcz
Glamour-Tests-Rubric-AndreiChis.14.mcz
Gofer-Core-TheIntegrator.228.mcz
Gofer-Tests-TheIntegrator.164.mcz
Graphics-Canvas-TheIntegrator.2.mcz
Graphics-Display Objects-TheIntegrator.159.mcz
Graphics-Files-TheIntegrator.58.mcz
Graphics-Fonts-EstebanLorenzano.96.mcz
Graphics-Fonts-Tests-EstebanLorenzano.3.mcz
Graphics-Primitives-StephaneDucasse.157.mcz
Graphics-Resources-EstebanLorenzano.22.mcz
Graphics-Shapes-TheIntegrator.2.mcz
Graphics-Tests-TheIntegrator.72.mcz
Graphics-Transformations-TheIntegrator.12.mcz
GroupManager-TheIntegrator.72.mcz
GroupManagerUI-TheIntegrator.40.mcz
Growl-TheIntegrator.37.mcz
HelpSystem-Core-TheIntegrator.120.mcz
HelpSystem-Tests-TheIntegrator.30.mcz
HudsonBuildTools20-TheIntegrator.65.mcz
Jobs-EstebanLorenzano.4.mcz
Kernel-TheIntegrator.2011.mcz
KernelTests-TheIntegrator.767.mcz
Keymapping-Core-EstebanLorenzano.195.mcz
Keymapping-KeyCombinations-EstebanLorenzano.45.mcz
Keymapping-Pragmas-TheIntegrator.50.mcz
Keymapping-Settings-StephaneDucasse.83.mcz
Keymapping-Tests-TheIntegrator.94.mcz
Keymapping-Tools-Spec-TheIntegrator.30.mcz
Komitter-TheIntegrator.115.mcz
Manifest-Core-TheIntegrator.215.mcz
Manifest-CriticBrowser-TheIntegrator.177.mcz
Manifest-Resources-Tests-MarcusDenker.14.mcz
Manifest-Tests-TheIntegrator.49.mcz
MenuRegistration-TheIntegrator.74.mcz
MessageBrowserRefactoringAddition-StephaneDucasse.2.mcz
Metacello-Base-EstebanLorenzano.114.mcz
Metacello-Core-MarcusDenker.722.mcz
Metacello-FileTree-EstebanLorenzano.30.mcz
Metacello-GitHub-StephaneDucasse.33.mcz
Metacello-MC-TheIntegrator.699.mcz
Metacello-PharoCommonPlatform-StephaneDucasse.12.mcz
Metacello-Platform.pharo20-EstebanLorenzano.36.mcz
Metacello-Platform.pharo30-StephaneDucasse.6.mcz
Metacello-ProfStef-MarcusDenker.16.mcz
Metacello-Reference-EstebanLorenzano.37.mcz
Metacello-TestsCore-EstebanLorenzano.36.mcz
Metacello-TestsMC-EstebanLorenzano.388.mcz
Metacello-TestsMCCore-EstebanLorenzano.6.mcz
Metacello-TestsMCResources-TheIntegrator.15.mcz
Metacello-TestsCommonMC.pharo20-EstebanLorenzano.4.mcz
Metacello-TestsPlatform.squeakCommon-MarcusDenker.19.mcz
Metacello-ToolBox-MarcusDenker.141.mcz
Metacello-Tutorial-EstebanLorenzano.27.mcz
Monticello-TheIntegrator.1009.mcz
Monticello-Tests-TheIntegrator.6.mcz
MonticelloConfigurations-MarcusDenker.70.mcz
MonticelloFileTree-Core-TheIntegrator.182.mcz
MonticelloFileTree-FileSystem-Utilities-MarcusDenker.32.mcz
MonticelloGUI-TheIntegrator.341.mcz
MonticelloMocks-EstebanLorenzano.2.mcz
Morphic-Base-TheIntegrator.441.mcz
Morphic-Core-TheIntegrator.166.mcz
Morphic-Examples-TheIntegrator.40.mcz
Morphic-Widgets-Basic-TheIntegrator.41.mcz
Morphic-Widgets-ColorPicker-StephaneDucasse.17.mcz
Morphic-Widgets-Extra-TheIntegrator.22.mcz
Morphic-Widgets-List-TheIntegrator.15.mcz
Morphic-Widgets-NewList-TheIntegrator.5.mcz
Morphic-Widgets-Pluggable-TheIntegrator.44.mcz
Morphic-Widgets-Scrolling-TheIntegrator.23.mcz
Morphic-Widgets-Tabs-TheIntegrator.12.mcz
Morphic-Widgets-Taskbar-StephaneDucasse.7.mcz
Morphic-Widgets-Tree-TheIntegrator.27.mcz
Morphic-Widgets-Windows-TheIntegrator.47.mcz
MorphicTests-TheIntegrator.99.mcz
Multilingual-Encodings-MarcusDenker.47.mcz
Multilingual-Languages-StephaneDucasse.40.mcz
Multilingual-OtherLanguages-MarcusDenker.12.mcz
Multilingual-Tests-MarcusDenker.35.mcz
Multilingual-TextConversion-TheIntegrator.70.mcz
Multilingual-TextConverterOtherLanguages-MarcusDenker.2.mcz
NECompletion-TheIntegrator.194.mcz
NECompletion-Tests-TheIntegrator.2.mcz
NativeBoost-Core-TheIntegrator.164.mcz
NativeBoost-Examples-CamilloBruni.16.mcz
NativeBoost-Mac-MarcusDenker.12.mcz
NativeBoost-Pools-CamilloBruni.13.mcz
NativeBoost-Tests-TheIntegrator.92.mcz
NativeBoost-Unix-MarcusDenker.17.mcz
NativeBoost-Win32-TheIntegrator.57.mcz
Nautilus-TheIntegrator.909.mcz
Nautilus-Tests-TheIntegrator.12.mcz
NautilusCommon-TheIntegrator.260.mcz
NautilusRefactoring-TheIntegrator.216.mcz
Network-Kernel-StephaneDucasse.112.mcz
Network-MIME-MarcusDenker.69.mcz
Network-Mail-StephaneDucasse.39.mcz
Network-Protocols-MarcusDenker.101.mcz
Network-UUID-MarcusDenker.29.mcz
Network-Url-MarcusDenker.99.mcz
NetworkTests-TheIntegrator.103.mcz
NewValueHolder-TheIntegrator.27.mcz
NodeNavigation-StephaneDucasse.51.mcz
NonInteractiveTranscript-TheIntegrator.15.mcz
OSWindow-Core-TheIntegrator.20.mcz
OSWindow-SDL2-EstebanLorenzano.19.mcz
OSWindow-VM-IgorStasenko.2.mcz
OpalCompiler-Core-TheIntegrator.641.mcz
OpalCompiler-Tests-TheIntegrator.282.mcz
OpalDecompiler-TheIntegrator.31.mcz
OpalTools-TheIntegrator.16.mcz
Pharo-Help-TheIntegrator.15.mcz
Polymorph-TaskbarIcons-MarcusDenker.40.mcz
Polymorph-Widgets-TheIntegrator.1211.mcz
PragmaCollector-TheIntegrator.3.mcz
ProfStef-Core-TheIntegrator.55.mcz
ProfStef-Help-SvenVanCaekenberghe.14.mcz
ProfStef-Tests-TheIntegrator.25.mcz
RPackage-Core-TheIntegrator.383.mcz
RPackage-SystemIntegration-TheIntegrator.232.mcz
RPackage-Tests-TheIntegrator.167.mcz
RecentSubmissions-StephaneDucasse.233.mcz
Refactoring-Changes-TheIntegrator.65.mcz
Refactoring-Core-TheIntegrator.270.mcz
Refactoring-Critics-TheIntegrator.160.mcz
Refactoring-Environment-TheIntegrator.49.mcz
Refactoring-Tests-Changes-MarcusDenker.38.mcz
Refactoring-Tests-Core-TheIntegrator.123.mcz
Refactoring-Tests-Critics-MarcusDenker.25.mcz
Refactoring-Tests-Environment-StephaneDucasse.11.mcz
Reflectivity-StephaneDucasse.25.mcz
Reflectivity-Tests-TheIntegrator.16.mcz
Regex-Core-MarcusDenker.33.mcz
Regex-Help-MarcusDenker.5.mcz
Regex-Tests-Core-MarcusDenker.9.mcz
ReleaseTests-TheIntegrator.15.mcz
Ring-Core-Containers-TheIntegrator.41.mcz
Ring-Core-Kernel-TheIntegrator.207.mcz
Ring-Monticello-MarcusDenker.29.mcz
Ring-Tests-Containers-MarcusDenker.18.mcz
Ring-Tests-Kernel-TheIntegrator.83.mcz
Ring-Tests-Monticello-MarcusDenker.19.mcz
Rubric-AndreiChis.187.mcz
SUnit-Core-TheIntegrator.138.mcz
SUnit-Help-MarcusDenker.9.mcz
SUnit-Tests-TheIntegrator.48.mcz
SUnit-UI-TheIntegrator.110.mcz
SUnit-UITesting-TheIntegrator.21.mcz
ScriptLoader-Tests-TheIntegrator.4.mcz
Settings-Graphics-StephaneDucasse.28.mcz
Settings-Polymorph-TheIntegrator.78.mcz
Settings-System-StephaneDucasse.35.mcz
ShoreLine-Report-Core-TommasoDalSasso.9.mcz
ShoreLine-Report-Settings-TommasoDalSasso.2.mcz
ShoreLine-Report-UI-TommasoDalSasso.12.mcz
Shout-TheIntegrator.236.mcz
ShoutTests-TheIntegrator.27.mcz
Slot-TheIntegrator.604.mcz
Slot-Tests-TheIntegrator.39.mcz
SmartSuggestions-TheIntegrator.147.mcz
SmartSuggestions-Tests-TheIntegrator.2.mcz
Spec-Core-StephaneDucasse.386.mcz
Spec-Debugger-TheIntegrator.236.mcz
Spec-Examples-TheIntegrator.91.mcz
Spec-Help-TheIntegrator.8.mcz
Spec-Inspector-TheIntegrator.238.mcz
Spec-Layout-TheIntegrator.67.mcz
Spec-MorphicAdapters-TheIntegrator.207.mcz
Spec-PolyWidgets-TheIntegrator.57.mcz
Spec-Tests-StephaneDucasse.45.mcz
Spec-Tools-StephaneDucasse.261.mcz
StartupPreferences-TheIntegrator.131.mcz
System-Announcements-TheIntegrator.98.mcz
System-Caching-TheIntegrator.23.mcz
System-CachingTests-TheIntegrator.12.mcz
System-Changes-StephaneDucasse.257.mcz
System-Clipboard-SvenVanCaekenberghe.32.mcz
System-CommandLine-TheIntegrator.167.mcz
System-CommandLineHandler-TheIntegrator.3.mcz
System-FilePackage-TheIntegrator.132.mcz
System-FileRegistry-StephaneDucasse.33.mcz
System-Finalization-TheIntegrator.19.mcz
System-Hashing-StephaneDucasse.45.mcz
System-History-EstebanLorenzano.7.mcz
System-History-Tests-EstebanLorenzano.3.mcz
System-Installers-SvenVanCaekenberghe.42.mcz
System-Localization-TheIntegrator.88.mcz
System-Localization-Tests-TheIntegrator.5.mcz
System-Object Events-MarcusDenker.15.mcz
System-Platforms-StephaneDucasse.61.mcz
System-Serial Port-StephaneDucasse.23.mcz
System-Settings-StephaneDucasse.309.mcz
System-Sound-StephaneDucasse.18.mcz
System-Support-StephaneDucasse.1091.mcz
System-VMEvents-TheIntegrator.2.mcz
Tests-TheIntegrator.724.mcz
Text-Core-StephaneDucasse.31.mcz
Text-Diff-StephaneDucasse.4.mcz
Text-Edition-StephaneDucasse.77.mcz
Text-Edition-Tests-EstebanLorenzano.3.mcz
Text-Scanning-TheIntegrator.24.mcz
Text-Tests-EstebanLorenzano.7.mcz
Tool-Base-TheIntegrator.66.mcz
Tool-Browser-Old-TheIntegrator.37.mcz
Tool-Changes-TheIntegrator.22.mcz
Tool-ConfigurationBrowser-TheIntegrator.15.mcz
Tool-Diff-TheIntegrator.2.mcz
Tool-FileList-TheIntegrator.34.mcz
Tool-FileList-Tests-EstebanLorenzano.3.mcz
Tool-FilePackageBrowser-TheIntegrator.7.mcz
Tool-Finder-TheIntegrator.30.mcz
Tool-ImageCleaner-TheIntegrator.10.mcz
Tool-ProcessBrowser-StephaneDucasse.6.mcz
Tool-Profilers-TheIntegrator.17.mcz
Tool-SystemReporter-StephaneDucasse.10.mcz
Tool-Transcript-TheIntegrator.12.mcz
Tool-TxWorkspace-TheIntegrator.6.mcz
Tool-Workspace-TheIntegrator.24.mcz
Tools-TheIntegrator.1503.mcz
ToolsTest-MarcusDenker.denker.71.mcz
Traits-TheIntegrator.757.mcz
Transcript-StephaneDucasse.32.mcz
TxText-Athens-TheIntegrator.44.mcz
TxText-AthensTests-IgorStasenko.9.mcz
TxText-Model-NicolaiHess.50.mcz
TxText-Styler-IgorStasenko.3.mcz
TxTextTests-Model-IgorStasenko.26.mcz
UIManager-TheIntegrator.141.mcz
Unicode-Initialization-MarcusDenker.10.mcz
UpdateStreamer-Core-TheIntegrator.34.mcz
UpdateStreamer-Tests-TheIntegrator.9.mcz
UserManager-Core-MarcusDenker.13.mcz
UserManager-Tests-TheIntegrator.5.mcz
Versionner-Core-Announcements-MarcusDenker.11.mcz
Versionner-Core-Commands-ChristopheDemarey.53.mcz
Versionner-Core-DependenciesModel-TheIntegrator.95.mcz
Versionner-Core-Model-ChristopheDemarey.49.mcz
Versionner-Spec-Browser-ChristopheDemarey.173.mcz
Versionner-Tests-Core-Commands-TheIntegrator.17.mcz
Versionner-Tests-Core-DependenciesModel-MarcusDenker.40.mcz
Versionner-Tests-Core-Model-ChristopheDemarey.33.mcz
Versionner-Tests-Resources-MarcusDenker.14.mcz
Zinc-Character-Encoding-Core-SvenVanCaekenberghe.37.mcz
Zinc-Character-Encoding-Tests-SvenVanCaekenberghe.22.mcz
Zinc-FileSystem-SvenVanCaekenberghe.10.mcz
Zinc-HTTP-SvenVanCaekenberghe.423.mcz
Zinc-Resource-Meta-Core-SvenVanCaekenberghe.48.mcz
Zinc-Resource-Meta-FileSystem-TheIntegrator.8.mcz
Zinc-Resource-Meta-Tests-SvenVanCaekenberghe.33.mcz
Zinc-Tests-SvenVanCaekenberghe.223.mcz
Zinc-Zodiac-SvenVanCaekenberghe.34.mcz
Zodiac-Core-SvenVanCaekenberghe.38.mcz
Zodiac-Extra-StephaneDucasse.10.mcz
Zodiac-Tests-SvenVanCaekenberghe.12.mcz'
findTokens: String lf , String cr! !

!ScriptLoader methodsFor: 'generate scripts/methods' stamp: 'StephaneDucasse 4/4/2010 13:26'!
compileScriptMethodWithCurrentPackages: aNumber 
	"ScriptLoader new compileScriptMethodWithCurrentPackages: 9999"
	
	self class compile: 
		(self newGenerateScriptTemplateWithCurrentPackages: aNumber)
		classified: 'pharo - scripts'! !

!ScriptLoader methodsFor: 'utils' stamp: 'MarcusDenker 2/25/2015 15:07'!
removeUpdateMethods
	(ScriptLoader organization listAtCategoryNamed: 'pharo - updates') do: [:each | ScriptLoader removeSelector: each].! !

!ScriptLoader methodsFor: 'private' stamp: 'al 11/1/2008 18:19'!
waitingFolderMCZFiles
	^ self class defaultMCWaitingFolder allFileNames
		reject: [:each | each =  '.DS_Store']! !

!ScriptLoader methodsFor: 'mc public utils' stamp: 'StephaneDucasse 5/26/2012 22:02'!
unloadPackage: aString
	"self new unloadPackage: 'Sixx'"
	| toRemove | 
	toRemove := (self allManagers asSortedCollection:
		[ :a :b | a package name <= b package name ]) detect: [:each | each package name = aString].
	toRemove unload.! !

!ScriptLoader methodsFor: 'private' stamp: 'StephaneDucasse 2/10/2011 15:40'!
updatesListFileName

	^ 'updates', (SystemVersion current majorMinor:''), '.list'! !

!ScriptLoader methodsFor: 'mc related utils' stamp: 'EstebanLorenzano 7/21/2014 13:28'!
addPackage: aString
	| workingCopy |
	RPackageOrganizer default registerPackageNamed: aString.
	workingCopy := MCWorkingCopy forPackage: (MCPackage new name: aString)! !

!ScriptLoader methodsFor: 'elementary steps' stamp: 'MarcusDenker 2/25/2015 15:07'!
generateScriptAndUpdateMethodForNewVersion
	"Use me to generate the script and update method"
	"self new generateScriptAndUpdateMethodForNewVersion"
	
	"remove old update and script methods"
	self removeUpdateMethods.
	self removeScriptMethods.
	
	self compileScriptMethodWithCurrentPackages: self currentScriptVersionNumber.
	self compileNewUpdateMethod.
	
! !

!ScriptLoader methodsFor: 'generate scripts/methods' stamp: 'StephaneDucasse 4/4/2010 14:36'!
compileNewUpdateMethod
	"Use me to create a new update method with the next update number"
	"self new compileNewUpdateMethod"
	

	self class compile: 
		(self newGenerateNewUpdateMethod)
		classified: 'pharo - updates'! !

!ScriptLoader methodsFor: 'pharo - updates' stamp: 'TheIntegrator 4/14/2015 08:27'!
update40607
	"self new update40607"
	self withUpdateLog: '15229 Athens uses wrong <example> pragma
	https://pharo.fogbugz.com/f/cases/15229

15336 Writing a new .souces brakes class comments
	https://pharo.fogbugz.com/f/cases/15336'.
	self loadTogether: self script607 merge: false.
	self loadConfiguration: 'Athens' version: '3.2'.self flushCaches.
! !

!ScriptLoader methodsFor: 'generate scripts/methods' stamp: 'StephaneDucasse 8/21/2011 15:57'!
taskForcesRepositoryUrlString
	
	^ self rootURLString , 'PharoTaskForces'! !

!ScriptLoader methodsFor: 'elementary steps' stamp: 'al 11/1/2008 18:33'!
saveChangedPackagesIntoWaitingFolder
	self currentChangedPackages do: [:each |
		self
			saveInToReloadCachePackage: each
			with: self commentForCurrentUpdate]! !

!ScriptLoader methodsFor: 'fixing stream' stamp: 'stephane.ducasse 2/6/2009 17:36'!
unloadPackageNamed: aString
	"self new workingCopyFromPackageName: 'CollectionExtensions' "
	
	^ (self workingCopyFromPackageName: aString) unload
	! !

!ScriptLoader methodsFor: 'cleaning' stamp: 'MarcusDenker 1/17/2014 08:54'!
flushCaches

	Smalltalk cleanUp.
	Smalltalk garbageCollect.! !

!ScriptLoader methodsFor: 'elementary steps' stamp: 'nice 1/5/2010 15:59'!
mergePackageFromWaitingFolder
	"self defaultMCWaitingFolder allFileNames"
	"self new loadPackageFromWaitingFolder"
	
	
	self waitingFolderMCZFiles
		do: [ :name | | version |
			version := self class defaultMCWaitingFolder  versionFromFileNamed: name.
			version merge.
			]! !

!ScriptLoader methodsFor: 'mc related utils' stamp: 'EstebanLorenzano 9/8/2013 11:53'!
savePackage: aWorkingCopy in: aRepository with: aMessageString
	" | sc |
	  sc := self new.
	  sc savePackage: (self new workingCopyFromPackageName: 'ScriptLoader11') 
		in: MCCacheRepository uniqueInstance
		with: 'this is test to automate dirty package saving in cache'"

	aRepository storeVersion: (aWorkingCopy 
		newVersionWithName: aWorkingCopy uniqueVersionName
		message: aMessageString
		in: aRepository)! !

!ScriptLoader methodsFor: 'accessing' stamp: 'adrian_lienhard 3/16/2009 21:42'!
repository: aRepository
	repository := aRepository! !

!ScriptLoader methodsFor: 'ci' stamp: 'StephaneDucasse 11/7/2013 20:21'!
checkImageIsUptodateSilently

	| last number |
	self class checkImageInSyncWithUpdate 
		ifFalse: [^ true].	
	
	self updatesListFile writeStreamDo:  [ :stream |
		stream contents linesDo: [ :each | last := each ]].
	last isNil 
		ifTrue: [^ false]. "in case the file is empty"
	 (last copyUpTo: $-) isAllDigits
		ifFalse: [^ true].  			"for cases where we have #Pharo1.1rc1 starting the line"
	number := (last copyUpTo: $-) asNumber.
	^ number = self getLatestUpdateNumber.
! !

!ScriptLoader methodsFor: 'generate scripts/methods' stamp: 'al 11/1/2008 18:15'!
getLatestScriptNumber
	"self new getLatestScriptNumber"
	
	| upfroms |
	upfroms := self class selectors select: [:each | 'script*' match: each ].
	upfroms := upfroms collect: [:each | (each asString allButFirst: 6)].
	upfroms := upfroms reject: [:each | '*Log*' match: each ].
	upfroms := upfroms reject: [:each | '*XXX*' match: each ].
	upfroms := upfroms collect: [:each | each asNumber].
	^ upfroms asSortedCollection last
	! !

!ScriptLoader methodsFor: 'private' stamp: 'SeanDeNigris 7/12/2012 08:44'!
updatesListFile
	^  self updatesListFileName asFileReference! !

!ScriptLoader methodsFor: 'accessing' stamp: 'StephaneDucasse 5/26/2012 21:57'!
allManagers

	^ MCWorkingCopy allManagers! !

!ScriptLoader methodsFor: 'ci' stamp: 'MarcusDenker 2/28/2012 18:04'!
launchUpdateSilently

	^ UpdateStreamer new updateFromServerSilently
! !

!ScriptLoader methodsFor: 'utils' stamp: 'MarcusDenker 2/25/2015 15:06'!
removeScriptMethods
	(ScriptLoader organization listAtCategoryNamed: 'pharo - scripts') do: [:each | ScriptLoader removeSelector: each].! !

!ScriptLoader methodsFor: 'generate scripts/methods' stamp: 'adrian lienhard 11/7/2008 22:07'!
setUpdateAndScriptVersionNumbers
	CurrentUpdateVersionNumber := self getLatestUpdateNumber + 1.
	CurrentScriptVersionNumber := self getLatestScriptNumber + 1.! !

!ScriptLoader methodsFor: 'log' stamp: 'MarcusDenker 3/2/2015 17:12'!
withUpdateLog: aString
	"ignore, check the issue tracker or ScriptLoader MC History"! !

!ScriptLoader methodsFor: 'ci' stamp: 'EstebanLorenzano 9/26/2014 15:26'!
newGenerateNewUpdateMethodSilentlyConfigurations: configurations preLoad: preload postLoad: postLoad
	"ScriptLoader new newGenerateNewUpdateMethod"
	
	| stream methodName preamble postscript |
	stream := ReadWriteStream on: (String new: 1000).
	methodName := 'update', self currentUpdateVersionNumber asString.

	stream 
		<< methodName << String cr
		<< Character tab << '"self new ' << methodName << '"' << String cr
		<< Character tab .
		
	preamble := self decodeFromPrint: (preload reset contents asString).
	preamble isEmptyOrNil 
		ifFalse: [ stream nextPutAll: preamble; ensureEndsWith: $.; crtab ].

	stream 
		<< 'self withUpdateLog: ''' << self commentForCurrentUpdate << '''.' << String cr
		<< Character tab << 'self loadTogether: self script' << self currentScriptVersionNumber asString << ' merge: false.' << String cr
		<< Character tab.
		
	configurations 
		do: [ :each | stream << 'self loadConfiguration: ''' << each key << ''' version: ' << each value printString << '.' ]
		separatedBy: [ stream cr ].
		
	postscript := self decodeFromPrint: (postLoad reset contents asString). 
	postscript isEmptyOrNil 
		ifFalse: [ stream nextPutAll: postscript; ensureEndsWith: $.; crtab ].
	
	stream << 'self flushCaches.' << String cr.
	
	^ stream contents! !

!ScriptLoader methodsFor: 'load primitives' stamp: 'EstebanLorenzano 9/23/2014 16:58'!
loadConfiguration: configurationName version: version
	Gofer it 
		repository: self inboxRepositoryDefault;
		configurationOf: configurationName;
		loadVersion: version! !

!ScriptLoader methodsFor: 'private' stamp: 'MarcusDenker 7/10/2012 10:37'!
saveAsNewImageWithCurrentReleaseName
	| file |
	file := FileSystem workingDirectory  / (('Pharo-', self currentUpdateVersionNumber asString), '-Release'), Smalltalk imageSuffix.
	Smalltalk image saveAs: (file nextVersion basename copyUpToLast: Path extensionDelimiter). ! !

!ScriptLoader methodsFor: 'elementary steps' stamp: 'EstebanLorenzano 3/19/2013 11:32'!
updateStageList: aString
	| stagedFile fileExists |
	"Writes the pending updates into a 'staging' list, so the continuous integration can 
	 process and move it to updates when validated (and not before)."
	
	stagedFile := self stagedListFile.
	fileExists := stagedFile exists.
	stagedFile writeStreamDo: [ :stream |
		fileExists 
			ifTrue: [ stream setToEnd ]
			ifFalse: [ stream nextPut: $#; nextPutAll: SystemVersion current version asString ].
		stream
			cr;
			nextPutAll: self currentUpdateVersionNumber asString;
			nextPutAll: '-Pha-', aString, '.cs' ]! !

!ScriptLoader methodsFor: 'public' stamp: 'SvenVanCaekenberghe 1/16/2014 23:07'!
generateCommentForCurrentUpdate
 ^ self commentForIssues: self getSliceIssuesNumbers! !

!ScriptLoader methodsFor: 'generate scripts/methods' stamp: 'SeanDeNigris 7/12/2012 08:44'!
writeCS: extensionAndNumber forUpdate: updateNumber withName: aSt
	"ScriptLoader new writeCS: '-md.2929' forUpdate: 7049 withName: 'cleanUpMethods'"
	
	(updateNumber asString, 'update', aSt, '.cs') asFileReference delete
		writeStreamDo: [ :stream |
			self generateCS: extensionAndNumber fromUpdate: updateNumber on: stream].
! !

!ScriptLoader methodsFor: 'elementary steps' stamp: 'EstebanLorenzano 8/25/2014 13:46'!
saveLatestScriptLoaderToWaitingFolder
	"self new saveLatestScriptLoaderToWaitingFolder"

	| man r |
	man := self allManagers.
	r := man select: [ :each | each packageName sameAs: self theScriptLoaderPackageName ].
	self
		saveInToReloadCachePackage: r first
		with: self commentForCurrentUpdate! !

!ScriptLoader methodsFor: 'load primitives' stamp: 'StephaneDucasse 5/26/2012 22:02'!
newerVersionsIn: aCollection
	^aCollection reject: [:each |
		self allManagers anySatisfy: [:workingcopy |
			workingcopy ancestry ancestorString , '.mcz' = each]].! !

!ScriptLoader methodsFor: 'elementary steps' stamp: 'nice 1/5/2010 15:59'!
copyPackagesFromWaitingFolderToHomeRepository
	"self defaultMCWaitingFolder allFileNames"
	"self new copyPackageFromWaitingFolderToHomeRepository"
	
	
	self waitingFolderMCZFiles do: [:name | | version |
		version := self class defaultMCWaitingFolder versionFromFileNamed: name.
		self repository storeVersion: version]! !

!ScriptLoader methodsFor: 'generate scripts/methods' stamp: 'adrian lienhard 11/7/2008 22:08'!
currentScriptVersionNumber
	^ CurrentScriptVersionNumber! !

!ScriptLoader methodsFor: 'new script-update format' stamp: 'StephaneDucasse 4/4/2010 13:25'!
newGenerateScriptTemplateWithCurrentPackages: aNumber
	"ScriptLoader new generateScriptTemplateWithCurrentPackages"
	"this version change the script to only "
	
	| str withoutScriptLoader |
	str := ReadWriteStream on: (String new: 1000).
	str nextPutAll: 'script', aNumber asString ; cr ; cr ; tab.
	str nextPutAll: '^ '.
	str nextPut: $'.
	withoutScriptLoader := self currentVersionsToBeSaved.
	withoutScriptLoader
		do: [ :each | str nextPutAll: each ; nextPutAll: '.mcz']
		separatedBy: [str nextPut: Character cr].
	str nextPut: $'; nextPut: Character cr.
	str nextPutAll: 'findTokens: String lf , String cr'.
	^ str contents! !

!ScriptLoader methodsFor: 'menu integration actions' stamp: 'MarcusDenker 7/10/2012 10:37'!
saveImageForRunningTests

	| comment commentQuoted st resuming |
	resuming := false.
	Smalltalk image saveSession
		ifFalse: [ resuming := true].
	resuming ifTrue: [
		self saveAsImageAsTestImage.
	
		self inform: 'Now you can use this image named ''Test'' to run the tests and come back to fix problems in the \ previous one and eventually freeze it by selecting the next step, in either one.' withCRs]! !

!ScriptLoader methodsFor: 'mc related utils' stamp: 'StephaneDucasse 5/26/2012 22:02'!
removeAllRepositories
	"self new removeAllRepositories"
	
	self allManagers do: [:each |  each  repositoryGroup initialize].
	MCRepositoryGroup default initialize.
	! !

!ScriptLoader methodsFor: 'generate scripts/methods' stamp: 'MarcusDenker 5/26/2014 15:51'!
inboxRepositoryUrlString
	
	^ self rootURLString, 'Pharo40Inbox/main'! !

!ScriptLoader methodsFor: 'ci' stamp: 'sd 4/20/2012 16:06'!
prepareNewUpdateSilently
	"Return nil on error"

	self launchUpdateSilently ifFalse: [ ^ nil ].
	[ self loadLatestScriptloader ]
		on: Warning
		do: [:warning | ^ nil ].
	self markPackagesBeforeNewCodeIsLoaded.
	self checkImageIsUptodateSilently ifFalse: [ self loadLatestUpdateListSilently ].
	self checkImageIsUptodate ifFalse: [ ^ nil ].
	self setUpdateAndScriptVersionNumbers.
	self saveAsNewImageWithCurrentReleaseName.
	^ self currentUpdateVersionNumber! !

!ScriptLoader methodsFor: 'fixing stream' stamp: 'sd 3/24/2008 17:31'!
workingCopyFromPackageName: aString
	"self new workingCopyFromPackageName: '39Deprecated' "
	
	|pa|
	pa := MCPackage named: aString.
	^ pa workingCopy 
	! !

!ScriptLoader methodsFor: 'private' stamp: 'EstebanLorenzano 3/18/2013 17:06'!
stagedListFileName

	^ 'updates', (SystemVersion current majorMinor:''), '.staged'! !

!ScriptLoader methodsFor: 'mc related utils' stamp: 'sd 10/31/2005 18:01'!
addRepositoryToPackageNamed: aString
	
	|pa|
	pa := MCPackage named: aString.
	pa workingCopy repositoryGroup addRepository: self repository.
	! !

!ScriptLoader methodsFor: 'public' stamp: 'TheIntegrator 4/14/2015 08:27'!
commentForCurrentUpdate
 ^ '15229 Athens uses wrong <example> pragma
	https://pharo.fogbugz.com/f/cases/15229

15336 Writing a new .souces brakes class comments
	https://pharo.fogbugz.com/f/cases/15336'! !

!ScriptLoader methodsFor: 'fixing stream' stamp: 'alain.plantec 2/6/2009 15:49'!
installVersionInfo
	"self new installVersionInfo"

	| highestUpdate newVersion |
	highestUpdate := SystemVersion current highestUpdate.
	(self confirm: 'Reset highest update (' , highestUpdate printString , ')?')
		ifTrue: [SystemVersion current highestUpdate: 0].

	newVersion := UIManager default request: 'New version designation:' translated initialAnswer: '3.9' , highestUpdate printString. 
	SystemVersion newVersion: newVersion.
	
! !

!ScriptLoader methodsFor: 'public' stamp: 'EstebanLorenzano 4/2/2015 11:32'!
commentForIssues: issues
	"self new commentForIssues: #(12623 12621 12615)"
	
	^ String streamContents: [ :stream | 
		issues 
			do: [ :each | | description link |
				stream print: each; space.
				description := ZnClient new
					url: 'http://tracker.pharo.org/issues/name/';
					addPath: each asString;
					get.
				stream << (description reject: [ :c | c = $' ]); cr.
				link := 'https://pharo.fogbugz.com/f/cases' asUrl / each asString.
				stream tab; print: link; cr; cr ]
			displayingProgress: 'Fetching Issue Descriptions' ]! !

!ScriptLoader methodsFor: 'load primitives' stamp: 'CamilloBruni 9/15/2013 17:52'!
loadOneAfterTheOther: aCollection merge: aBoolean
	
	(self newerVersionsIn: aCollection)
		do: [:fn | | loader |
			loader := aBoolean
				ifTrue: [ MCVersionMerger new ]
				ifFalse: [ MCVersionLoader new].
			loader addVersion: (self repository loadVersionFromFileNamed: fn).
			aBoolean
				ifTrue: [
					[loader merge] on: MCMergeResolutionRequest do: [:request |
							request autoMerge ]]
				ifFalse: [loader load]].
	

! !

!ScriptLoader methodsFor: 'utils' stamp: 'StephaneDucasse 6/17/2012 22:47'!
shortImageName
	"should be removed when the version  will be integrated in SmalltalkImage"
	
	^ Smalltalk shortImageName copyUpToLast: $. ! !

!ScriptLoader methodsFor: 'mc public utils' stamp: 'MarcusDenker 8/17/2012 15:39'!
unregisterPackage: aString

	| toRemove | 
	toRemove := (MCWorkingCopy allManagers asSortedCollection:
		[ :a :b | a package name <= b package name ]) detect: [:each | each package name = aString].
	MCWorkingCopy registry removeKey: toRemove package.! !

!ScriptLoader methodsFor: 'private' stamp: 'StephaneDucasse 6/7/2013 15:06'!
addRepositoryDefaultToAllPackages
	"self new addRepositoryDefaultToAllPackages"
	
	self allManagers do: [:each | 
		each repositoryGroup
			 addRepository: self repository
			].
	
	! !

!ScriptLoader methodsFor: 'mc related utils' stamp: 'adrianLienhard 11/2/2008 00:31'!
saveInToReloadCachePackage: aWorkingCopy with: aMessageString
	self
		savePackage: aWorkingCopy
		in: self class defaultMCWaitingFolder
		with: aMessageString! !

!ScriptLoader methodsFor: 'cleaning' stamp: 'MarcusDenker 1/5/2015 15:39'!
cleanRepositories
	"self new cleanRepositories"
	
	MCRepositoryGroup instVarNamed: 'default' put: nil. 
	self addHomeRepositoryToAllPackages! !

!ScriptLoader methodsFor: 'generate scripts/methods' stamp: 'sd 4/20/2012 16:16'!
getLatestUpdateNumber
	"self new getLatestUpdateNumber"
	
	| upfroms |
	upfroms := self class selectors select: [:each | 'update*' match: each ].
	upfroms := upfroms collect: [:each | [(each asString last: 5) asNumber] on: Error do: [0]].
	^ upfroms asSortedCollection last! !

!ScriptLoader methodsFor: 'private' stamp: 'EstebanLorenzano 3/18/2013 17:06'!
stagedListFile
	^  self stagedListFileName asFileReference! !

!ScriptLoader methodsFor: 'menu integration actions' stamp: 'CamilloBruni 5/10/2012 15:58'!
checkImageIsUptodate
	^ self checkImageIsUptodateSilently
	! !

!ScriptLoader methodsFor: 'mc related utils' stamp: 'stephane.ducasse 6/30/2008 15:15'!
allCurrentDirtyPackages
	"ScriptLoader new allCurrentDirtyPackages"
	"return all the current dirty packages even the ones that we do not want to save"

	
	^  self allCurrentPackages select: [:each | each needsSaving].

	! !

!ScriptLoader methodsFor: 'private' stamp: 'EstebanLorenzano 8/25/2014 17:42'!
packagesNotToSavePatternNames
	^ super packagesNotToSavePatternNames, #( 'ConfigurationOf.*' )! !

!ScriptLoader methodsFor: 'mc public utils' stamp: 'EstebanLorenzano 8/10/2012 18:35'!
deletePackage: aString
	| toRemove toUnregister | 
	
	toRemove := (MCWorkingCopy allManagers asSortedCollection:
		[ :a :b | a package name <= b package name ]) detect: [:each | each package name = aString].
	toRemove unload. 
	"With RPackage, each 'sub-package' is considered a separate package so we need to also unregister them"
	toUnregister := RPackageOrganizer default packages select: [:each | (each name = aString) or:  [each name beginsWith: aString,'-']].
	RPackageOrganizer default unregisterPackageNamed: aString.
! !

!ScriptLoader methodsFor: 'private' stamp: 'CamilloBruni 10/1/2012 12:52'!
loadLatestUpdateList
	"fetch the latest version of the update.list on the server"
	
	| result listToUse lastUpdate |
	result := ZnClient new
		systemPolicy;
		beOneShot;
		setAcceptEncodingGzip;
		accept: ZnMimeType text;
		url: (UpdateStreamer new updateFolderURL, self updatesListFileName);
		ifFail: [ :exception | self error: 'Cannot access update server: ' , exception printString ];
		get.
	(listToUse := result lines) isEmpty 
		ifTrue: [ self error: 'Update list is empty' ].			
	lastUpdate := listToUse last.
	(lastUpdate beginsWith: self getLatestUpdateNumber asString)
		 ifTrue: ["Write this file as our current updates.list"
			self updatesListFileName asFileReference
				delete;
				writeStreamDo: [:stream | stream nextPutAll: result ] ]
		ifFalse: [ 
			self inform: 'Image update version did not match automatically fetched  update.list!!  
			Proceed after downloading using the script ./getUpdatesList instead' ].
	! !

!ScriptLoader methodsFor: 'mc related utils' stamp: 'SvenVanCaekenberghe 1/16/2014 22:59'!
getSliceIssuesNumbers
	"Figure out which slices were loaded by looking at MC packages"
	
	^ MCWorkingCopy allManagers 
		select: [ :each | each packageName beginsWith: 'SLICE-Issue-' ]
		thenCollect: [ :each | ((each packageName allButFirst: 12) copyUpTo: $-) asNumber ]! !

!ScriptLoader methodsFor: 'mc related utils' stamp: 'MarcusDenker 7/16/2014 12:42'!
addHomeRepositoryToAllPackages
	"self new addHomeRepositoryToAllPackages"
	
	self allManagers do: [:each | 
		each repositoryGroup
			addRepository: self repository;
			addRepository: self inboxRepository].
		
	MCRepositoryGroup default
		addRepository: self repository;
		addRepository: self inboxRepository.! !

!ScriptLoader methodsFor: 'private' stamp: 'nice 1/5/2010 15:59'!
buildConfigurationMapFor: packageNames

	| configurationMap |
	configurationMap := MCConfiguration new.
	configurationMap repositories
		add: self repository;
		add: self inboxRepository.

	packageNames do: [:packageName | | version depArray |
		version := self loadVersionFromFileNamed: packageName.
		depArray := { version package name. version info name. version info id asString. }.
		configurationMap dependencies add: (MCConfiguration dependencyFromArray: depArray)].
	^configurationMap! !

!ScriptLoader methodsFor: 'mc related utils' stamp: 'EstebanLorenzano 8/25/2014 16:36'!
currentPackages
	"self new currentPackages" 
	
	
	| copies |
	copies := self allManagers asSortedCollection:
		[ :a :b | a package name <= b package name ].
	^ copies reject: [:each |
		self packagesNotToSavePatternNames
			anySatisfy: [:p | each packageName matchesRegex: p ] ].
	! !

!ScriptLoader methodsFor: 'mc related utils' stamp: 'StephaneDucasse 5/26/2012 22:02'!
removeAllHTTPRepositories: aColl
	"self new removeAllRepositories: 
			#('http://source.squeakfoundation.org/inbox/'
			 'http://source.squeakfoundation.org/39a/'
			 'http://source.squeakfoundation.org/Balloon/'
			 'http://source.squeakfoundation.org/Compression/'
			 'http://source.squeakfoundation.org/Graphics/'
			  'http://source.wiresong.ca/mc/')"
 
	self allManagers do: [:each | 
		aColl do: [ :location | 
					each  repositoryGroup removeHTTPRepositoryLocationNamed: location]].
	! !

!ScriptLoader methodsFor: 'generate scripts/methods' stamp: 'stephane.ducasse 3/21/2009 18:07'!
generateScriptTemplateWithCurrentPackages: aNumber
	"ScriptLoader new generateScriptTemplateWithCurrentPackages"
	
	| str withoutScriptLoader |
	str := ReadWriteStream on: (String new: 1000).
	str nextPutAll: 'script', aNumber asString ; cr ; cr ; tab.
	str nextPutAll: '| names |'; cr.
	str nextPutAll: 'names := '.
	str nextPut: $'.
	withoutScriptLoader := self currentVersionsToBeSaved.
	withoutScriptLoader
		do: [ :each | str nextPutAll: each ; nextPutAll: '.mcz']
		separatedBy: [str nextPut: Character cr].
	str nextPut: $'; nextPut: Character cr.
	str nextPutAll: 'findTokens: String lf , String cr.

	self loadTogether: names merge: false.'.
	^ str contents! !

!ScriptLoader methodsFor: 'accessing' stamp: 'SeanDeNigris 8/26/2012 15:56'!
repositoryTaskForces
	^ repositoryTaskForces ifNil: [
		repositoryTaskForces := MCHttpRepository location: self taskForcesRepositoryUrlString]! !

!ScriptLoader methodsFor: 'generate scripts/methods' stamp: 'sd 7/8/2006 18:20'!
writeCS: extensionAndNumber forUpdate: updateNumber
	"ScriptLoader new writeCS: '-sd.210' forUpdate: 7037"
	
	self writeCS: extensionAndNumber forUpdate: updateNumber withName: 'changeMe'! !

!ScriptLoader methodsFor: 'elementary steps' stamp: 'nice 1/5/2010 15:59'!
loadPackageFromWaitingFolder
	"self defaultMCWaitingFolder allFileNames"
	"self new loadPackageFromWaitingFolder"
	
	
	self waitingFolderMCZFiles do: [:name | | version |
		version := self class defaultMCWaitingFolder versionFromFileNamed: name.
		version load]! !

!ScriptLoader methodsFor: 'ci' stamp: 'EstebanLorenzano 9/26/2014 15:27'!
decodeFromPrint: aString 
	^ aString 
		copyReplaceAll: $' asString, $' asString
		with: $' asString! !

!ScriptLoader methodsFor: 'generate scripts/methods' stamp: 'MarcusDenker 5/26/2014 15:45'!
homeRepositoryUrlString
	
	^ self rootURLString, 'Pharo40/main'! !

!ScriptLoader methodsFor: 'ci' stamp: 'EstebanLorenzano 9/23/2014 16:42'!
doneApplyingChangesSilentlyIssues: issuesToIntegrate preLoad: preload postLoad: postLoad
	| comment commentQuoted st |
	Smalltalk image saveSession.
		"now you can reopen prior to publishing to fix :)"
	self saveAsNewImageWithCurrentReleaseNameToPublish.
	comment := String streamContents: [:stream |
		issuesToIntegrate do: [:each | 
			stream << each name << 'Thanks to ' << each content author email ; lf;lf.
			stream << each url;lf;lf;lf.]].
	comment := comment trimBoth.
	
	"comment := UIManager default
		multiLineRequest: 'Comment for this update.'
		initialAnswer: self commentForCurrentUpdate
		answerHeight: 200.
	comment ifNil: [^ self]."
	
	commentQuoted := comment copyReplaceAll: (String with: $') with: (String with: $' with: $').
	st := String new writeStream.
	st nextPutAll: 'commentForCurrentUpdate'; cr.
	st nextPutAll: ' ^ '.
	st nextPut: $'.
	st nextPutAll: commentQuoted.
	st nextPut: $'.
	self class
		compile: (st contents)
		classified: 'public'.

	self class waitingCacheFolder deleteAllChildren.
	self saveChangedPackagesIntoWaitingFolder.
	self 
		generateScriptAndUpdateMethodForNewVersionSilentlyConfigurations: #() 
		preLoad: preload 
		postLoad: postLoad.
	self saveLatestScriptLoaderToWaitingFolder.! !

!ScriptLoader class methodsFor: 'menu' stamp: 'ClementBera 7/26/2013 16:31'!
currentlyIntegratingChanges

	CurrentlyIntegratingChanges ifNil: [self hideIntegrationMenu].
	^ CurrentlyIntegratingChanges! !

!ScriptLoader class methodsFor: 'public' stamp: 'StephaneDucasse 11/9/2010 18:39'!
releaseMenu
	"self releaseMenu"
	|symbol|
	symbol := UIManager default
		chooseFrom: #('1- Prepare new update'
		                        '2- Save new image for testing (optional)'
						'3- Freeze changes: packages will be saved (required)'
						'4- Verify new update (open the mother image in the same folder) (optional)'
						'5- Publish changes')
		values: #(prepareNewUpdate saveImageForRunningTests doneApplyingChanges verifyNewUpdate publishChanges).
	symbol ifNotNil: [ScriptLoader new perform: symbol]! !

!ScriptLoader class methodsFor: 'menu' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
menuCommandOn: aBuilder 
	<worldMenu>
	
	(aBuilder item: #'Integrator Menu')
		order: 1.5;
		precondition: [self currentlyIntegratingChanges];
		parent: #System;
		icon: Smalltalk ui icons smallAuthoringToolsIcon;
		action: [ScriptLoader releaseMenu]! !

!ScriptLoader class methodsFor: 'private' stamp: 'EstebanLorenzano 3/19/2013 11:21'!
loadLatestPackage: aString fromHub: aDirectoryName
	"Loads a package from smalltalkhub repository"

	self loadLatestPackage: aString from: self rootURLString, aDirectoryName, '/main'
	! !

!ScriptLoader class methodsFor: 'private' stamp: 'EstebanLorenzano 3/19/2013 11:28'!
rootURLString 

	^ 'http://smalltalkhub.com/mc/Pharo/'! !

!ScriptLoader class methodsFor: 'private' stamp: 'SeanDeNigris 8/26/2012 11:59'!
loadLatestPackage: aString from: aPath
	| repository |
	
	repository := MCHttpRepository location: aPath.
	self loadLatestPackage: aString fromRepository: repository! !

!ScriptLoader class methodsFor: 'public' stamp: 'StephaneDucasse 10/18/2009 17:15'!
currentMajorVersionNumber

	^ CurrentMajorVersionNumber ! !

!ScriptLoader class methodsFor: 'menu' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
theme
	^ Smalltalk ui theme! !

!ScriptLoader class methodsFor: 'public' stamp: 'StephaneDucasse 6/12/2010 08:47'!
checkImageInSyncWithUpdate: aBoolean

	CheckImageInSyncWithUpdate := aBoolean! !

!ScriptLoader class methodsFor: 'loadscripts' stamp: 'lr 3/14/2010 21:13'!
gofer
	^ Smalltalk globals
		at: #Gofer
		ifAbsent: [ 
			(self new)
				installGofer;
				gofer ]! !

!ScriptLoader class methodsFor: 'loadscripts' stamp: 'MarcusDenker 5/26/2014 15:52'!
initialize
	self flag: #shouldRemoveNumber.
	CurrentMajorVersionNumber :=  4.0! !

!ScriptLoader class methodsFor: 'source' stamp: 'SeanDeNigris 8/26/2012 11:59'!
latestVersionOf: packageName location: location

  | repository sortMczs fileToLoad | 
  
  repository := MCHttpRepository location: location.
  sortMczs := [:a :b |
    [(a findBetweenSubStrs: #($.)) allButLast last asInteger > (b  
      findBetweenSubStrs: #($.)) allButLast last asInteger]
    on: Error do: [:ex | false]].
  
  fileToLoad := (repository readableFileNames asSortedCollection: sortMczs) detect: 
    [:file | file beginsWith: (packageName, '-')].
  
  ^ fileToLoad! !

!ScriptLoader class methodsFor: 'private' stamp: 'nice 1/5/2010 15:59'!
loadLatestPackage: aString fromRepository: aRepository
	| versionsBlock versions tries |
	
	versionsBlock := [ (aRepository allVersionNames select: [ :each |
		each beginsWith: aString ])
		asSortedCollection: [ :a :b |
			(a copyAfterLast: $.) asNumber <= (b copyAfterLast: $.) asNumber]].
	versions := versionsBlock value.
	tries := 0.
	[ versions isEmpty and: [ tries < 3 ] ] whileTrue: [
		versions := versionsBlock value.
		tries := tries + 1 ].
	versions isEmpty ifTrue: [ self error: 'problems when accessing squeaksource' ].
	
	aRepository versionReaderForFileNamed: (versions last , '.mcz') do: [:reader | | version |
		version := reader version.
		version load.
		version workingCopy repositoryGroup addRepository: aRepository]! !

!ScriptLoader class methodsFor: 'public' stamp: 'StephaneDucasse 10/18/2009 17:12'!
currentMajorVersionNumber: aNumber

	CurrentMajorVersionNumber := aNumber! !

!ScriptLoader class methodsFor: 'menu' stamp: 'StephaneDucasse 5/14/2010 22:03'!
hideIntegrationMenu

	CurrentlyIntegratingChanges := false.! !

!ScriptLoader class methodsFor: 'menu' stamp: 'StephaneDucasse 5/14/2010 22:03'!
showIntegrationMenu

	CurrentlyIntegratingChanges := true.! !

!ScriptLoader class methodsFor: 'public' stamp: 'StephaneDucasse 9/10/2010 17:28'!
checkImageInSyncWithUpdate
	"most of the time you want to make sure that your image is in sync with the latest item of the update.list
	but in some cases you do not to get forced to have this behavior."
	
	^ CheckImageInSyncWithUpdate ifNil: [CheckImageInSyncWithUpdate := true]! !

!ScriptLoader class methodsFor: 'source' stamp: 'CamilloBruni 10/1/2012 12:52'!
latestSource: packageName location: location

  | contents versionName zip |
  
  versionName := location, '/', (self latestVersionOf: packageName location: location).
  contents := ZnClient new
		systemPolicy;
		setAcceptEncodingGzip;
		beOneShot;
		url: versionName;
		ifFail: [ :exception | self error: 'Cannot access latest source: ' , exception printString ];
		get.
    
  zip := ZipArchive new.
  zip readFrom: contents readStream.
  ^  (zip memberNamed: 'snapshot/source.st') contents.! !

!ScriptLoader class methodsFor: 'private' stamp: 'adrian_lienhard 3/16/2009 21:32'!
defaultMCWaitingFolder
	"self defaultMCWaitingFolder" 
	
	^ MCDirectoryRepository new directory: self waitingCacheFolder! !

!ScriptLoaderTest methodsFor: 'testing' stamp: 'adrian_lienhard 3/16/2009 21:34'!
testMarkPackageBeforeLoad
	"self debug: #testMarkPackageBeforeLoad"
	

	| s |
	s := ScriptLoader new.
	s resetPackagesBeforeLastLoad.
	self assert: s diffPackages size = s currentVersionsToBeSaved size.
	self assert: s  = s.
	
	s markPackagesBeforeNewCodeIsLoaded.
	self assert: s diffPackages isEmpty! !

!ScriptLoaderTest methodsFor: 'testing' stamp: 'StephaneDucasse 6/12/2010 15:09'!
testAllCurrentVersionsContainsScriptLoader
	"self debug: #testAllCurrentVersionsContainsScriptLoader"
	
	| p |
	p := ScriptLoader new allCurrentVersions.
	self assert: (p anySatisfy: [ :pa | 'ScriptLoader*'  match: pa])! !

!ScriptLoaderTest methodsFor: 'testing' stamp: 'StephaneDucasse 6/12/2010 15:09'!
testAllCurrentPackagesContainScriptLoader
	"self debug: #testAllCurrentPackagesContainScriptLoader"

	| p |
	p := ScriptLoader new allCurrentPackages collect: [:each | each package name].
	self assert: (p anySatisfy: [ :pa | 'ScriptLoader*' match: pa])! !

!ScrollBar commentStamp: '<historical>'!
Inspired by an oiginal design of Hans-Martin Mosner, this ScrollBar is intended to exercise the handling of input events in Morphic.  With sufficient flexibility in this area, all particular behavior can be concentrated in this single class with no need to specialize any other morphs to achieve button, slider and menu-button behavior.

Once we have this working, put in logic for horizontal operation as well.

CachedImages was added to reduce the number of forms created and thrown away. This will be helpful for Nebraska and others as well.!
!ScrollBar methodsFor: 'access' stamp: 'AlainPlantec 12/17/2009 14:10'!
sliderColor: aColor 
	"Change the color of the scrollbar to go with aColor."
	| buttonColor |
	super sliderColor: aColor.
	self setProperty: #lastPaneColor toValue: aColor.
	buttonColor := self thumbColor.
	upButton color: buttonColor.
	downButton color: buttonColor.
	slider color: buttonColor slightlyLighter.	
	pagingArea
		fillStyle: self normalFillStyle;
		borderStyle: self normalBorderStyle.
	(self theme scrollbarPagingAreaCornerStyleIn: self window) = #rounded
		ifTrue: [self fillStyle: self normalButtonFillStyle]
		ifFalse: [self fillStyle: self normalFillStyle].
	self borderWidth: 0.
	^self adoptGradientColor: aColor! !

!ScrollBar methodsFor: 'update' stamp: 'GaryChambers 2/9/2012 11:16'!
themeChanged
	"Update the buttons, slider and paging area."

	self
		removeAllMorphs;
		initializeSlider.
	super themeChanged! !

!ScrollBar methodsFor: 'mouse' stamp: 'AlainPlantec 12/12/2009 13:54'!
mouseEnterThumb: event
	"The mouse has entered the thumb."
	
	slider
		fillStyle: self mouseOverThumbFillStyle;
		borderStyle: self mouseOverThumbBorderStyle;
		changed.
	upButton
		fillStyle: self mouseOverThumbButtonFillStyle;
		borderStyle: self mouseOverThumbButtonBorderStyle;
		changed.
	downButton
		fillStyle: self mouseOverThumbButtonFillStyle;
		borderStyle: self mouseOverThumbButtonBorderStyle;
		changed! !

!ScrollBar methodsFor: '*glamour-morphic-widgets' stamp: 'cyrilledelaunay 6/6/2011 15:58'!
setOptimalResizing
	self hResizing: #rigid.
	self vResizing: #rigid! !

!ScrollBar methodsFor: 'update' stamp: 'CamilloBruni 2/19/2014 20:36'!
updatePagingAreaBounds
	"Initialize the receiver's pagingArea."
	
	pagingArea bounds: self totalSliderArea! !

!ScrollBar methodsFor: 'update' stamp: 'CamilloBruni 2/19/2014 20:55'!
updateDownButtonBounds
	"update the receiver's downButton bounds"
	
	downButton bounds: (self theme scrollBarDownButtonBoundsFor: self)! !

!ScrollBar methodsFor: 'style' stamp: 'gvc 7/30/2007 15:56'!
pressedBorderStyle
	"Return the pressed borderStyle for the receiver."
	
	^self theme scrollbarPressedBorderStyleFor: self! !

!ScrollBar methodsFor: 'style' stamp: 'gvc 7/30/2007 15:55'!
mouseOverThumbBorderStyle
	"Return the mouse over thumb borderStyle for the receiver."
	
	^self theme scrollbarMouseOverThumbBorderStyleFor: self! !

!ScrollBar methodsFor: 'style' stamp: 'gvc 7/30/2007 15:56'!
pressedThumbFillStyle
	"Return the pressed thumb fillStyle for the receiver."
	
	^self theme scrollbarPressedThumbFillStyleFor: self! !

!ScrollBar methodsFor: 'geometry' stamp: 'dew 2/21/1999 03:08'!
sliderExtent
	"The sliderExtent is now stored in the slider itself, not hardcoded as it is in the superclass."
	^slider extent! !

!ScrollBar methodsFor: 'style' stamp: 'gvc 7/30/2007 15:55'!
mouseOverPagingAreaThumbFillStyle
	"Return the thumb fillStyle for the receiver when the mouse
	is over the paging area."
	
	^self theme scrollbarMouseOverBarThumbFillStyleFor: self! !

!ScrollBar methodsFor: 'style' stamp: 'gvc 7/30/2007 15:55'!
mouseOverButtonBorderStyle
	"Return the mouse over button borderStyle for the receiver."
	
	^self theme scrollbarMouseOverButtonBorderStyleFor: self! !

!ScrollBar methodsFor: '*glamour-morphic-widgets' stamp: 'TudorGirba 1/16/2011 13:10'!
glmAnimateValue: aNumber duration: anInteger
"	aNumber = value ifTrue: [^ self ]."
	anInteger <= 0 
		ifTrue: [ self setValue: aNumber ]
		ifFalse: [
			| startTime start end |
			startTime := Time millisecondClockValue.
			start := value "roundTo: scrollDelta".
			[ | delta |
			[ (delta := Time millisecondClockValue - startTime) < anInteger ] whileTrue: [
				self setValue: (aNumber - start) * (delta / anInteger) + start.
				Processor yield ].
				self setValue: aNumber ]
					fork ]! !

!ScrollBar methodsFor: 'style' stamp: 'gvc 7/30/2007 15:55'!
mouseOverPagingAreaButtonBorderStyle
	"Return the button borderStyle for the receiver when the mouse
	is over the paging area."
	
	^self theme scrollbarMouseOverBarButtonBorderStyleFor: self! !

!ScrollBar methodsFor: 'mouse' stamp: 'ThierryGoubier 5/29/2012 16:05'!
mouseLeaveUpButton: event
	"The mouse has left the up button."

	event redButtonPressed
		ifFalse: [ 
			upButton
				fillStyle: self normalButtonFillStyle;
				borderStyle: self normalButtonBorderStyle;
				changed ]! !

!ScrollBar methodsFor: 'access' stamp: ''!
scrollDelta: d1 pageDelta: d2
	"Supply optional increments for better scrolling of, eg, text"
	scrollDelta := d1.
	pageDelta := d2.! !

!ScrollBar methodsFor: 'initialization' stamp: 'AlainPlantec 12/17/2009 11:18'!
initialize
	super initialize.
	scrollDelta := 0.02.
	pageDelta := 0.2.
! !

!ScrollBar methodsFor: 'access' stamp: 'AlainPlantec 12/17/2009 14:10'!
scrollDownInit
	"Initialize a scroll down (from button) operation.
	Fixed to perform immediately with deferred 
	stepping for subsequent hold of button."

	|bc|
	bc := downButton borderStyle baseColor.
	downButton borderInset.
	downButton borderStyle baseColor: bc.
	self resetTimer.
	self scrollBarAction: #doScrollDown.
	self doScrollDown.
	self
		startStepping: #stepAt:
		at: Time millisecondClockValue + self stepTime
		arguments: nil stepTime: nil.
	downButton fillStyle: self pressedButtonFillStyle.
	downButton borderStyle: self pressedButtonBorderStyle! !

!ScrollBar methodsFor: 'geometry' stamp: 'dew 2/27/1999 18:22'!
expandSlider
	"Compute the new size of the slider (use the old sliderThickness as a minimum)."
	| r |
	r := self totalSliderArea.
	slider extent: (bounds isWide
		ifTrue: [((r width * interval) asInteger max: self sliderThickness) @ slider height]
		ifFalse: [slider width @ ((r height * interval) asInteger max: self sliderThickness)])! !

!ScrollBar methodsFor: 'access' stamp: 'gvc 4/26/2007 14:06'!
thumbColor
	"Problem: Part of the ScrollBar/Slider code uses 'slider' to mean the entire scrollbar/slider widget, and part of it uses 'slider' to mean only the draggable 'thumb'.  This should be cleaned up so that 'thumb' is used instead of 'slider' where appropriate.  For now, the meaning of thumbColor is clear, at least."

	^self class imageColorFor: self! !

!ScrollBar methodsFor: 'style' stamp: 'gvc 7/30/2007 15:55'!
mouseOverBorderStyle
	"Return the mouse over borderStyle for the receiver."
	
	^self theme scrollbarMouseOverBorderStyleFor: self! !

!ScrollBar methodsFor: 'scrolling' stamp: 'AlainPlantec 12/17/2009 14:09'!
scrollAbsolute: event
	"Just don't if it is not the red button and we are drawing gradients."
	
	event redButtonPressed ifFalse: [^self].
	^super scrollAbsolute: event! !

!ScrollBar methodsFor: 'scrolling' stamp: 'RAA 12/29/2000 11:56'!
setNextDirectionFromEvent: event

	nextPageDirection := bounds isWide ifTrue: [
		event cursorPoint x >= slider center x
	]
	ifFalse: [
		event cursorPoint y >= slider center y
	]

! !

!ScrollBar methodsFor: 'other events' stamp: 'AlainPlantec 12/17/2009 14:09'!
mouseDownInSlider: event
	"The mouse has been pressed in the slider area."
	
	interval = 1.0 ifTrue:
		["make the entire scrollable area visible if a full scrollbar is clicked on"
		self setValue: 0.
		self model hideOrShowScrollBar].
	event redButtonPressed ifFalse: [^self].
	slider fillStyle: self pressedThumbFillStyle.
	slider borderStyle: self pressedThumbBorderStyle.
	self theme useScrollbarThumbShadow ifTrue: [
		sliderShadow
			color: self sliderShadowColor;
			cornerStyle: slider cornerStyle;
			bounds: slider bounds;
			show]! !

!ScrollBar methodsFor: 'scrolling' stamp: 'ar 10/7/2000 14:56'!
scrollBarAction
	^self valueOfProperty: #scrollBarAction! !

!ScrollBar methodsFor: 'testing' stamp: 'di 4/22/2001 18:30'!
stepTime
	^ currentScrollDelay ifNil: [300]! !

!ScrollBar methodsFor: 'mouse' stamp: 'AlainPlantec 12/12/2009 14:03'!
mouseEnterPagingArea: event
	"The mouse has entered the paging area."
	
	pagingArea
		fillStyle: self mouseOverFillStyle;
		borderStyle: self mouseOverBorderStyle;
		changed.
	slider
		fillStyle: self mouseOverPagingAreaThumbFillStyle;
		borderStyle: self mouseOverPagingAreaThumbBorderStyle;
		changed.
	upButton
		fillStyle: self mouseOverPagingAreaButtonFillStyle;
		borderStyle: self mouseOverPagingAreaButtonBorderStyle;
		changed.
	downButton
		fillStyle: self mouseOverPagingAreaButtonFillStyle;
		borderStyle: self mouseOverPagingAreaButtonBorderStyle;
		changed! !

!ScrollBar methodsFor: 'style' stamp: 'gvc 7/30/2007 15:56'!
normalThumbFillStyle
	"Return the normal thumb fillStyle for the receiver."
	
	^self theme scrollbarNormalThumbFillStyleFor: self! !

!ScrollBar methodsFor: 'initialize' stamp: 'GaryChambers 2/9/2012 10:58'!
upImage
	"answer a form to be used in the up button"
	^ self class
		arrowOfDirection: (bounds isWide
				ifTrue: [#left]
				ifFalse: [#top])
		size: (self buttonExtent x min: self buttonExtent y)
		color: self buttonImageColor! !

!ScrollBar methodsFor: 'style' stamp: 'gvc 7/30/2007 15:56'!
pressedThumbBorderStyle
	"Return the pressed thumb borderStyle for the receiver."
	
	^self theme scrollbarPressedThumbBorderStyleFor: self! !

!ScrollBar methodsFor: 'mouse' stamp: 'ThierryGoubier 5/29/2012 16:07'!
mouseLeaveDownButton: event
	"The mouse has left the down button."

	event redButtonPressed
		ifFalse: [ 
			downButton
				fillStyle: self normalButtonFillStyle;
				borderStyle: self normalButtonBorderStyle;
				changed ]! !

!ScrollBar methodsFor: 'access' stamp: ''!
scrollDelta
	^ scrollDelta! !

!ScrollBar methodsFor: 'access' stamp: 'AlainPlantec 12/17/2009 14:08'!
finishedScrolling
	"Scrolling has finished (button or paging area)."
	
	|bcu bcd|
	bcu := upButton borderStyle baseColor.
	bcd := downButton borderStyle baseColor.
	self stopStepping.
	self scrollBarAction: nil.
	upButton borderRaised.
	upButton borderStyle baseColor: bcu.
	downButton borderRaised.
	downButton borderStyle baseColor: bcd.
	pagingArea
		fillStyle: self normalFillStyle;
		borderStyle: self normalBorderStyle! !

!ScrollBar methodsFor: 'update' stamp: 'pmm 3/13/2010 11:33'!
adoptGradientColor: aColor
	"Adopt the given pane color."

	|c fs bfs bs bbs|
	aColor ifNil:[^self].
	c := aColor.
	fs := self normalThumbFillStyle.
	bfs := self normalButtonFillStyle.
	bs := self normalThumbBorderStyle.
	bbs := self normalButtonBorderStyle.
	sliderColor := c.
	downButton
		fillStyle: bfs;
		borderStyle: bbs.
	upButton
		fillStyle: bfs shallowCopy;
		borderStyle: bbs.
	slider
		fillStyle: fs;
		borderStyle: bs.
	self updateUpButtonImage.
	self updateDownButtonImage! !

!ScrollBar methodsFor: 'style' stamp: 'gvc 7/30/2007 15:56'!
pressedButtonBorderStyle
	"Return the pressed button borderStyle for the receiver."
	
	^self theme scrollbarPressedButtonBorderStyleFor: self! !

!ScrollBar methodsFor: 'mouse' stamp: 'gvc 5/23/2007 15:20'!
mouseEnterDownButton: event
	"The mouse has entered the down button."
	
	downButton
		fillStyle: self mouseOverButtonFillStyle;
		borderStyle: self mouseOverButtonBorderStyle;
		changed! !

!ScrollBar methodsFor: 'initialize' stamp: 'dgd 3/28/2003 19:13'!
menuImage
	"answer a form to be used in the menu button"
	^ self class
		boxOfSize: (self buttonExtent x min: self buttonExtent y)
		color: self thumbColor! !

!ScrollBar methodsFor: 'scroll timing' stamp: 'GuillermoPolito 9/1/2010 18:35'!
waitForDelay1: delay1 delay2: delay2 
	"Return true if an appropriate delay has passed since the last scroll operation.
	The delay decreases exponentially from delay1 to delay2."

	| now scrollDelay |
	timeOfLastScroll ifNil: [self resetTimer].	"Only needed for old instances"
	now := Time millisecondClockValue.
	(scrollDelay := currentScrollDelay) ifNil: [scrollDelay := delay1	"initial delay"].
	currentScrollDelay := scrollDelay * 9 // 10 max: delay2.	"decrease the delay"
	timeOfLastScroll := now.
	^true! !

!ScrollBar methodsFor: 'access' stamp: 'AlainPlantec 12/17/2009 14:10'!
scrollUpInit
	"Initialize a scroll up (from button) operation.
	Fixed to perform immediately with deferred 
	stepping for subsequent hold of button."

	|bc|
	bc := upButton borderStyle baseColor.
	upButton borderInset.
	upButton borderStyle baseColor: bc.
	self resetTimer.
	self scrollBarAction: #doScrollUp.
	self doScrollUp.
	self
		startStepping: #stepAt:
		at: Time millisecondClockValue + self stepTime
		arguments: nil stepTime: nil.
	upButton fillStyle: self pressedButtonFillStyle.
	upButton borderStyle: self pressedButtonBorderStyle! !

!ScrollBar methodsFor: 'scrolling' stamp: 'bf 4/14/1999 12:03'!
scrollUp: count
	self setValue: (value - (scrollDelta * count) - 0.000001 max: 0.0)! !

!ScrollBar methodsFor: 'access' stamp: 'GaryChambers 2/9/2012 10:57'!
buttonImageColor
	"Answer the color to use for the arrow image of a button."

	^self theme scrollbarImageColorFor: self! !

!ScrollBar methodsFor: 'stepping and presenter' stamp: 'ar 10/7/2000 15:02'!
step
	| action |
	action := self scrollBarAction.
	action ifNotNil:[self perform: action].! !

!ScrollBar methodsFor: 'initialization' stamp: 'NicolasPetton 3/18/2013 19:14'!
initializeDownButton
	"initialize the receiver's downButton"

	downButton := self theme newScrollBarDownButtonFor: self.
	
	downButton color: self thumbColor.
	downButton 
		on: #mouseDown
		send: #scrollDownInit
		to: self.
	downButton 
		on: #mouseUp
		send: #finishedScrolling
		to: self.
	self updateDownButtonImage.
	downButton 
		borderWidth: 1;
		borderColor: Color lightGray.
		
	downButton cornerStyle: (self theme scrollbarButtonCornerStyleIn: self window).
	downButton on: #mouseUp send: #finishedScrolling: to: self.
	downButton on: #mouseEnter send: #mouseEnterDownButton: to: self.
	downButton on: #mouseLeave send: #mouseLeaveDownButton: to: self.
	self addMorph: downButton! !

!ScrollBar methodsFor: 'access' stamp: 'gvc 3/26/2008 18:15'!
slider
	"Answer the slider."

	^slider! !

!ScrollBar methodsFor: 'style' stamp: 'gvc 7/30/2007 15:55'!
mouseOverThumbFillStyle
	"Return the mouse over thumb fillStyle for the receiver."
	
	^self theme scrollbarMouseOverThumbFillStyleFor: self! !

!ScrollBar methodsFor: 'initialization' stamp: 'MarcusDenker 10/26/2011 15:23'!
initializePagingArea
	"Initialize the receiver's pagingArea."
	
	pagingArea := Morph
				newBounds: self totalSliderArea
				color: (Color
						r: 0.6
						g: 0.6
						b: 0.8).
	pagingArea
		on: #mouseDown
		send: #scrollPageInit:
		to: self.
	pagingArea
		on: #mouseUp
		send: #finishedScrolling
		to: self.
	self addMorph: pagingArea.
	pagingArea cornerStyle: (self theme scrollbarPagingAreaCornerStyleIn: self window).
	pagingArea on: #mouseUp send: #finishedScrolling: to: self.
	self on: #mouseEnter send: #mouseEnterPagingArea: to: self.
	self on: #mouseLeave send: #mouseLeavePagingArea: to: self! !

!ScrollBar methodsFor: 'access' stamp: 'gvc 6/4/2007 16:12'!
finishedScrolling: event
	"Scrolling has finished for a button."
	
	self finishedScrolling.
	(self containsPoint: event position)
		ifTrue: [pagingArea
				fillStyle: self mouseOverFillStyle;
				borderStyle: self mouseOverBorderStyle]
		ifFalse: [pagingArea
				fillStyle: self normalFillStyle;
				borderStyle: self normalBorderStyle].
	(upButton containsPoint: event position)
		ifTrue: [upButton
					fillStyle: self mouseOverButtonFillStyle;
					borderStyle: self mouseOverButtonBorderStyle]
		ifFalse: [(self containsPoint: event position)
					ifTrue: [upButton
							fillStyle: self mouseOverPagingAreaButtonFillStyle;
							borderStyle: self mouseOverPagingAreaButtonBorderStyle]
					ifFalse: [upButton
							fillStyle: self normalButtonFillStyle;
							borderStyle: self normalButtonBorderStyle]].
	(downButton containsPoint: event position)
		ifTrue: [downButton
					fillStyle: self mouseOverButtonFillStyle;
					borderStyle: self mouseOverButtonBorderStyle]
		ifFalse: [(self containsPoint: event position)
					ifTrue: [downButton
							fillStyle: self mouseOverPagingAreaButtonFillStyle;
							borderStyle: self mouseOverPagingAreaButtonBorderStyle]
					ifFalse: [downButton
							fillStyle: self normalButtonFillStyle;
							borderStyle: self normalButtonBorderStyle]]! !

!ScrollBar methodsFor: 'initialize' stamp: 'GaryChambers 2/9/2012 10:57'!
downImage
	"answer a form to be used in the down button"
	^ self class
		arrowOfDirection: (bounds isWide
				ifTrue: [#right]
				ifFalse: [#bottom])
		size: (self buttonExtent x min: self buttonExtent y)
		color: self buttonImageColor! !

!ScrollBar methodsFor: 'style' stamp: 'gvc 7/30/2007 15:56'!
normalButtonBorderStyle
	"Return the normal button borderStyle for the receiver."
	
	^self theme scrollbarNormalButtonBorderStyleFor: self! !

!ScrollBar methodsFor: 'geometry' stamp: 'gvc 10/7/2008 11:46'!
sliderThickness
	"Answer the minimum width/height of the scrollbar thumb. Refer to the theme."
	
	^self theme scrollbarMinimumThumbThickness! !

!ScrollBar methodsFor: 'style' stamp: 'gvc 7/30/2007 15:55'!
mouseOverPagingAreaButtonFillStyle
	"Return the button fillStyle for the receiver when the mouse
	is over the paging area."
	
	^self theme scrollbarMouseOverBarButtonFillStyleFor: self! !

!ScrollBar methodsFor: 'style' stamp: 'gvc 7/30/2007 15:56'!
normalBorderStyle
	"Return the normal borderStyle for the receiver."
	
	^self theme scrollbarNormalBorderStyleFor: self! !

!ScrollBar methodsFor: 'mouse' stamp: 'AlainPlantec 12/17/2009 14:09'!
mouseUpInSlider: event
	"The mouse button has been released."
	
	sliderShadow hide.
	(slider containsPoint: event position)
		ifTrue: [slider
					fillStyle: self mouseOverThumbFillStyle;
					borderStyle: self mouseOverThumbBorderStyle]
		ifFalse: [self mouseLeaveThumb: event].
	slider changed! !

!ScrollBar methodsFor: 'style' stamp: 'gvc 7/30/2007 15:55'!
mouseOverFillStyle
	"Return the mouse over fillStyle for the receiver."
	
	^self theme scrollbarMouseOverFillStyleFor: self! !

!ScrollBar methodsFor: 'initialize' stamp: 'StephaneDucasse 5/23/2013 18:39'!
updateDownButtonImage
	"update the receiver's downButton.  put a new image inside"
	downButton removeAllMorphs.
	downButton
		addMorphCentered: (ImageMorph new form: self downImage)! !

!ScrollBar methodsFor: 'access' stamp: 'md 2/24/2006 16:27'!
adoptPaneColor: aColor
	"Adopt the given pane color"
	aColor ifNil:[^self].
	self sliderColor: aColor.! !

!ScrollBar methodsFor: 'style' stamp: 'gvc 7/30/2007 15:56'!
normalFillStyle
	"Return the normal fillStyle for the receiver."
	
	^self theme scrollbarNormalFillStyleFor: self! !

!ScrollBar methodsFor: 'update' stamp: 'CamilloBruni 2/19/2014 20:55'!
updateSliderBounds
	"Initialize the receiver's slider."
	
	self 
		updateUpButtonBounds;
		updateDownButtonBounds;
		updatePagingAreaBounds.
	super updateSliderBounds.
	! !

!ScrollBar methodsFor: 'initialize' stamp: 'StephaneDucasse 5/23/2013 18:39'!
updateUpButtonImage
"update the receiver's upButton. put a new image inside"
	upButton removeAllMorphs.
	upButton
		addMorphCentered: (ImageMorph new form: self upImage)! !

!ScrollBar methodsFor: 'scrolling' stamp: 'di 4/22/2001 18:28'!
doScrollUp
	"Scroll automatically while mouse is down"
	(self waitForDelay1: 200 delay2: 40) ifFalse: [^ self].
	self setValue: (value - scrollDelta - 0.000001 max: 0.0)! !

!ScrollBar methodsFor: 'scroll timing' stamp: 'di 8/17/1998 09:22'!
resetTimer
	timeOfMouseDown := Time millisecondClockValue.
	timeOfLastScroll := timeOfMouseDown - 1000 max: 0.
	nextPageDirection := nil.
	currentScrollDelay := nil! !

!ScrollBar methodsFor: 'mouse' stamp: 'AlainPlantec 12/12/2009 14:04'!
mouseLeavePagingArea: event
	"The mouse has left the paging area."
	
	pagingArea
		fillStyle: self normalFillStyle;
		borderStyle: self normalBorderStyle;
		changed.
	slider
		fillStyle: self normalThumbFillStyle;
		borderStyle: self normalThumbBorderStyle;
		changed.
	upButton
		fillStyle: self normalButtonFillStyle;
		borderStyle: self normalButtonBorderStyle;
		changed.
	downButton
		fillStyle: self normalButtonFillStyle;
		borderStyle: self normalButtonBorderStyle;
		changed! !

!ScrollBar methodsFor: 'scrolling' stamp: 'SeanDeNigris 2/10/2015 13:48'!
scrollLeft: count
	self scrollUp: count! !

!ScrollBar methodsFor: 'scrolling' stamp: 'SeanDeNigris 2/10/2015 13:48'!
scrollRight: count
	self scrollDown: count! !

!ScrollBar methodsFor: 'mouse' stamp: 'gvc 5/23/2007 15:20'!
mouseEnterUpButton: event
	"The mouse has entered the up button."
	
	upButton
		fillStyle: self mouseOverButtonFillStyle;
		borderStyle: self mouseOverButtonBorderStyle;
		changed! !

!ScrollBar methodsFor: 'access' stamp: 'dew 2/15/1999 18:25'!
pagingArea
	^pagingArea! !

!ScrollBar methodsFor: 'style' stamp: 'gvc 7/30/2007 15:56'!
normalThumbBorderStyle
	"Return the normal thumb borderStyle for the receiver."
	
	^self theme scrollbarNormalThumbBorderStyleFor: self! !

!ScrollBar methodsFor: 'scrolling' stamp: 'di 4/22/2001 18:28'!
doScrollDown
	"Scroll automatically while mouse is down"
	(self waitForDelay1: 200 delay2: 40) ifFalse: [^ self].
	self setValue: (value + scrollDelta + 0.000001 min: 1.0)! !

!ScrollBar methodsFor: 'update' stamp: 'CamilloBruni 2/19/2014 20:40'!
updateUpButtonBounds
	"update the receiver's upButton bounds"

	upButton bounds: (self theme scrollBarUpButtonBoundsFor: self)! !

!ScrollBar methodsFor: 'access' stamp: 'gvc 3/26/2008 19:13'!
interval: d
	"Supply an optional floating fraction so slider can expand to indicate range.
	Update the fill style for the tumb (may have extent-based elements)."
	
	|oldExtent|
	oldExtent := slider extent.
	interval := d min: 1.0.
	self expandSlider.
	self computeSlider.
	slider extent = oldExtent
		ifFalse: [slider fillStyle: self normalThumbFillStyle]! !

!ScrollBar methodsFor: 'geometry' stamp: 'NicolasPetton 3/18/2013 20:06'!
buttonExtent
	| size |
	size := self theme scrollbarThickness.
	
	^ bounds isWide
		ifTrue: [ upButton 
			ifNil: [  size@size ] 
			ifNotNil: [ upButton extent ] ]
		ifFalse: [ downButton 
			ifNil: [ size@size ] 
			ifNotNil: [ downButton extent ] ]! !

!ScrollBar methodsFor: 'scrolling' stamp: 'ar 10/7/2000 15:13'!
doScrollByPage
	"Scroll automatically while mouse is down"
	(self waitForDelay1: 300 delay2: 100) ifFalse: [^ self].
	nextPageDirection
		ifTrue: [self setValue: (value + pageDelta min: 1.0)]
		ifFalse: [self setValue: (value - pageDelta max: 0.0)]
! !

!ScrollBar methodsFor: 'style' stamp: 'gvc 7/30/2007 15:55'!
mouseOverThumbButtonFillStyle
	"Return the mouse over thumb fillStyle for the receiver."
	
	^self theme scrollbarMouseOverThumbButtonFillStyleFor: self! !

!ScrollBar methodsFor: 'geometry' stamp: 'dgd 3/26/2003 09:13'!
extent: p 
	p x > p y
		ifTrue: [super
				extent: (p max: 42 @ 8)]
		ifFalse: [super
				extent: (p max: 8 @ 42)].
	! !

!ScrollBar methodsFor: 'scrolling' stamp: 'ar 10/7/2000 14:56'!
scrollBarAction: aSymbol
	self setProperty: #scrollBarAction toValue: aSymbol! !

!ScrollBar methodsFor: 'style' stamp: 'gvc 7/30/2007 15:55'!
mouseOverPagingAreaThumbBorderStyle
	"Return the thumb borderStyle for the receiver when the mouse
	is over the paging area."
	
	^self theme scrollbarMouseOverBarThumbBorderStyleFor: self! !

!ScrollBar methodsFor: 'style' stamp: 'gvc 7/30/2007 15:56'!
normalButtonFillStyle
	"Return the normal button fillStyle for the receiver."
	
	^self theme scrollbarNormalButtonFillStyleFor: self! !

!ScrollBar methodsFor: 'style' stamp: 'gvc 7/30/2007 15:56'!
pressedFillStyle
	"Return the pressed fillStyle for the receiver."
	
	^self theme scrollbarPressedFillStyleFor: self! !

!ScrollBar methodsFor: 'style' stamp: 'gvc 7/30/2007 15:55'!
mouseOverButtonFillStyle
	"Return the mouse over button fillStyle for the receiver."
	
	^self theme scrollbarMouseOverButtonFillStyleFor: self! !

!ScrollBar methodsFor: 'style' stamp: 'gvc 7/30/2007 15:56'!
pressedButtonFillStyle
	"Return the pressed button fillStyle for the receiver."
	
	^self theme scrollbarPressedButtonFillStyleFor: self! !

!ScrollBar methodsFor: 'access' stamp: 'AlainPlantec 12/17/2009 14:10'!
scrollPageInit: evt
	"Scroll initiated by the paging area."
	
	self resetTimer.
	self setNextDirectionFromEvent: evt.
	self scrollBarAction: #doScrollByPage.
	self doScrollByPage. "do the first one now since morph stepping is rather variable in its timing
		and the user may release before actually actioned...."
	pagingArea
		fillStyle: self pressedFillStyle;
		borderStyle: self pressedBorderStyle.
	self startStepping: #stepAt: at: Time millisecondClockValue + self stepTime arguments: nil stepTime: nil! !

!ScrollBar methodsFor: 'testing' stamp: 'ar 10/7/2000 15:02'!
wantsSteps
	^self scrollBarAction notNil! !

!ScrollBar methodsFor: 'geometry' stamp: 'AlainPlantec 12/12/2009 14:04'!
totalSliderArea
	| upperBoundsButton |
	upperBoundsButton := upButton.
	bounds isWide
		ifTrue: [
			upButton right > upperBoundsButton right
				ifTrue: [upperBoundsButton := upButton].
			^upperBoundsButton bounds topRight corner: downButton bounds bottomLeft]
		ifFalse:[
			upButton bottom > upperBoundsButton bottom
				ifTrue: [upperBoundsButton := upButton].
			^upperBoundsButton bounds bottomLeft corner: downButton bounds topRight].
! !

!ScrollBar methodsFor: 'mouse' stamp: 'ThierryGoubier 7/13/2012 10:30'!
mouseLeaveThumb: event
	"The mouse has left the thumb."

	| buttonFillStyle buttonBorderStyle |
	event redButtonPressed ifFalse: [ 
		slider
			fillStyle: self normalThumbFillStyle;
			borderStyle: self normalThumbBorderStyle;
			changed ].
	
	"Update buttons"
	(self containsPoint: event position)
		ifTrue: [ 
			buttonFillStyle := self mouseOverPagingAreaButtonFillStyle.
			buttonBorderStyle := self mouseOverPagingAreaButtonBorderStyle ]
		ifFalse: [ 
			buttonFillStyle := self normalButtonFillStyle.
			buttonBorderStyle := self normalButtonBorderStyle ].	
	upButton
		fillStyle: buttonFillStyle;
		borderStyle: buttonBorderStyle.
	downButton
		fillStyle: buttonFillStyle;
		borderStyle: buttonBorderStyle.! !

!ScrollBar methodsFor: 'style' stamp: 'gvc 7/30/2007 15:55'!
mouseOverThumbButtonBorderStyle
	"Return the button borderStyle for the receiver when the mouse
	is over the thumb."
	
	^self theme scrollbarMouseOverThumbButtonBorderStyleFor: self! !

!ScrollBar methodsFor: 'model access' stamp: 'gvc 9/7/2006 11:59'!
setValue: newValue
	"Using roundTo: instead of truncateTo: ensures that scrollUp will scroll the same distance as scrollDown.
	Fix for >= 1.0 since, when close the roundTo may round down and not allow the value to reach
	the full range."
	
	newValue >= 1.0
		ifTrue: [^super setValue: 1.0].
	^ super setValue: (newValue roundTo: scrollDelta)! !

!ScrollBar methodsFor: 'scrolling' stamp: 'bf 4/14/1999 12:03'!
scrollDown: count
	self setValue: (value + (scrollDelta * count) + 0.000001 min: 1.0)! !

!ScrollBar methodsFor: 'initialization' stamp: 'NicolasPetton 3/18/2013 19:13'!
initializeUpButton
	"initialize the receiver's upButton"
	upButton := self theme newScrollBarUpButtonFor: self.
	upButton color: self thumbColor.
	upButton
		on: #mouseDown
		send: #scrollUpInit
		to: self.
	upButton
		on: #mouseUp
		send: #finishedScrolling
		to: self.
	self updateUpButtonImage.
	upButton 
		borderWidth: 1;
		borderColor: Color lightGray.
		
	upButton cornerStyle: (self theme scrollbarButtonCornerStyleIn: self window).
	upButton on: #mouseUp send: #finishedScrolling: to: self.
	upButton on: #mouseEnter send: #mouseEnterUpButton: to: self.
	upButton on: #mouseLeave send: #mouseLeaveUpButton: to: self.
	self addMorph: upButton! !

!ScrollBar methodsFor: 'initialization' stamp: 'NicolasPetton 3/18/2013 19:27'!
initializeSlider
	"Initialize the receiver's slider."
	
	self initializeUpButton; initializeDownButton; initializePagingArea.
	super initializeSlider.
	self sliderColor: self sliderColor.
	self slider
		width: self theme scrollbarThickness;
		height: self theme scrollbarThickness.
	slider cornerStyle: (self theme scrollbarThumbCornerStyleIn: self window).
	slider on: #mouseEnter send: #mouseEnterThumb: to: self.
	slider on: #mouseLeave send: #mouseLeaveThumb: to: self! !

!ScrollBar class methodsFor: 'images - samples' stamp: 'dgd 3/28/2003 10:17'!
sampleSizes
	
"private"
	^ #(10 12 14 16 18 32 64 )! !

!ScrollBar class methodsFor: '*Polymorph-Widgets' stamp: 'FernandoOlivero 4/12/2011 10:14'!
imageColorFor: aScrollbar
	"Return the (button) image colour for the given scrollbar."
	
	^self theme scrollbarImageColorFor: aScrollbar! !

!ScrollBar class methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 1/12/2014 15:48'!
initialize
	"ScrollBar initialize"

	self initializeImagesCache! !

!ScrollBar class methodsFor: 'cleanup' stamp: 'StephaneDucasse 3/9/2010 22:12'!
cleanUp
	"Re-initialize the image cache"

	self initializeImagesCache! !

!ScrollBar class methodsFor: 'initialization' stamp: 'FernandoOlivero 4/12/2011 10:15'!
initializeImagesCache
	"initialize the receiver's ImagesCache. 
	 
	normally this method is not evaluated more than in the class 
	initializazion. "

	" 
	ScrollBar initializeImagesCache.
	"

	ArrowImagesCache := self theme createArrowImagesCache.
	BoxesImagesCache := self theme createBoxImagesCache! !

!ScrollBar class methodsFor: 'images' stamp: 'dgd 3/28/2003 10:22'!
arrowOfDirection: aSymbol size: finalSizeInteger color: aColor 
	"answer a form with an arrow based on the parameters"
	^ ArrowImagesCache at: {aSymbol. finalSizeInteger. aColor}! !

!ScrollBar class methodsFor: 'images - samples' stamp: 'dgd 3/28/2003 10:18'!
sampleColors
	"private"
	^ (Color lightCyan wheel: 5)! !

!ScrollBar class methodsFor: 'images - samples' stamp: 'sd 11/8/2003 16:02'!
arrowSamples
	"create a set of arrow with different sizes, colors and directions"
	" 
	ScrollBar arrowSamples.  
	"
	| column |
	column := AlignmentMorph newColumn vResizing: #shrinkWrap;
				 hResizing: #shrinkWrap;
				 layoutInset: 1;
				 borderColor: Color black;
				 borderWidth: 0;
				 wrapCentering: #center;
				 cellPositioning: #center;
				 color: Color white;
				 yourself.
	
	self sampleSizes
		do: [:size | 
			| row | 
			row := AlignmentMorph newRow color: Color transparent;
						 vResizing: #shrinkWrap;
						 cellInset: 2 @ 0 yourself.
			
			self sampleColors
				do: [:color | 
					#(#top #right #bottom #left )
						do: [:direction | 
							row addMorphBack: (ScrollBar
									arrowOfDirection: direction
									size: size
									color: color) asMorph]].
			
			column addMorphBack: row].
	
	column openInHand! !

!ScrollBar class methodsFor: 'images' stamp: 'dgd 3/28/2003 10:22'!
boxOfSize: finalSizeInteger color: aColor 
	"answer a form with an box based on the parameters"
	^ BoxesImagesCache at: {finalSizeInteger. aColor}! !

!ScrollBar class methodsFor: 'images - samples' stamp: 'dgd 3/28/2003 10:18'!
boxSamples
	"create a set of box with different sizes and colors"
	" 
	ScrollBar boxSamples.  
	"
	| column |
	column := AlignmentMorph newColumn vResizing: #shrinkWrap;
				 hResizing: #shrinkWrap;
				 layoutInset: 1;
				 borderColor: Color black;
				 borderWidth: 0;
				 wrapCentering: #center;
				 cellPositioning: #center;
				 color: Color white;
				 yourself.
	""
	self sampleSizes
		do: [:size | 
			| row | 
			row := AlignmentMorph newRow color: Color transparent;
						 vResizing: #shrinkWrap;
						 cellInset: 2 @ 0 yourself.
			""
			self sampleColors
				do: [:color | 
					row addMorphBack: (ScrollBar boxOfSize: size color: color) asMorph].
			""
			column addMorphBack: row].
	""
	""
	column openInHand! !

!ScrollPane commentStamp: 'mk 8/9/2005 10:34'!
The scroller (a transform) of a scrollPane is driven by the scrollBar.  The scroll values vary from 0.0, meaning zero offset to 1.0 meaning sufficient offset such that the bottom of the scrollable material appears 3/4 of the way down the pane.  The total distance to achieve this range is called the totalScrollRange.

Basic clue about utilization of the ScrollPane class is given in:
	ScrollPane example1.
	ScrollPane example2.!
!ScrollPane methodsFor: 'settings' stamp: 'AlainPlantec 12/17/2009 21:38'!
alwaysShowVScrollbar
	^ self class alwaysShowVScrollbar! !

!ScrollPane methodsFor: 'geometry testing' stamp: 'sps 3/10/2004 10:22'!
hIsScrollbarShowing
	"Return true if a horz scroll bar is currently showing"

	^submorphs includes: hScrollBar
! !

!ScrollPane methodsFor: 'access' stamp: 'ar 5/19/1999 18:06'!
scroller: aTransformMorph
	scroller ifNotNil:[scroller delete].
	scroller := aTransformMorph.
	self addMorph: scroller.
	self resizeScroller.! !

!ScrollPane methodsFor: 'access options' stamp: 'sps 4/4/2004 12:23'!
hideVScrollBarIndefinitely: bool
	"Get rid of scroll bar for short panes that don't want it shown."

	self setProperty: #noVScrollBarPlease toValue: bool.
	self vHideOrShowScrollBar.
! !

!ScrollPane methodsFor: '*Polymorph-Widgets' stamp: 'SeanDeNigris 2/10/2015 13:50'!
mouseWheel: event 
	"Handle a mouseWheel event."
	
	event isUp ifTrue: [ ^ scrollBar scrollUp: 3 ].
	event isDown ifTrue: [ ^ scrollBar scrollDown: 3 ].
	event isLeft  ifTrue: [ ^ hScrollBar scrollLeft: 3 ].
	event isRight  ifTrue: [ ^ hScrollBar scrollRight: 3 ].! !

!ScrollPane methodsFor: 'scrolling' stamp: 'MarcusDenker 10/1/2013 21:17'!
hIsScrollbarNeeded
"Return whether the horz scrollbar is needed"

	"Don't show it if we were told not to."
	(self valueOfProperty: #noHScrollBarPlease ifAbsent: [false]) ifTrue: [^false].

	"Always show it if we were told to"
	(self valueOfProperty: #hScrollBarAlways ifAbsent: [false]) ifTrue: [^true].

	^self hIsScrollable
! !

!ScrollPane methodsFor: 'geometry' stamp: 'sps 12/24/2002 16:07'!
hUnadjustedScrollRange
	"Return the width extent of the receiver's submorphs."

	| submorphBounds |
	submorphBounds := scroller localSubmorphBounds ifNil: [^ 0].
	^ submorphBounds right
! !

!ScrollPane methodsFor: 'event handling' stamp: 'marcus.denker 8/24/2008 22:05'!
handlesMouseOver: evt
	"Could just ^ true, but this ensures that scroll bars won't flop out
	if you mouse-over appendages such as connecting pins."
	"self flag: #arNote." "I have no idea how the code below could've ever worked. If the receiver does not handle mouse over events then it should not receive any #mouseLeave if the mouse leaves the receiver for real. This is because 'evt cursorPoint' describes the *end* point of the movement and considering that the code would return false if the move ends outside the receiver the scroll bars should never pop back in again. Which is exactly what happens with the new event logic if you don't just ^true. I'm leaving the code in for reference - perhaps somebody can make sense from it; I sure cannot."
	^true
"
	| cp |
	cp := evt cursorPoint.
	(bounds containsPoint: cp)
		ifTrue: [^ true]			
		ifFalse: [self submorphsDo:
					[:m | (m containsPoint: cp) ifTrue:
							[m == scrollBar
								ifTrue: [^ true]
								ifFalse: [^ false]]].
				^ false]
"! !

!ScrollPane methodsFor: 'initialization' stamp: 'MarcusDenker 10/3/2013 14:25'!
initialize
	
	"initialize the state of the receiver"
	super initialize.
	hasFocus := false.
	self initializeScrollBars.
	self extent: self defaultExtent.
	self hideOrShowScrollBars.


! !

!ScrollPane methodsFor: 'geometry' stamp: 'di 11/11/1998 09:48'!
resizeScroller

	scroller bounds: self innerBounds! !

!ScrollPane methodsFor: 'scrolling' stamp: 'sps 12/25/2002 01:10'!
hHideOrShowScrollBar
	"Hide or show the scrollbar depending on if the pane is scrolled/scrollable."

	self hIsScrollbarNeeded
		ifTrue:[ self hShowScrollBar ]
		ifFalse: [ self hHideScrollBar ].
! !

!ScrollPane methodsFor: 'scroll bar events' stamp: 'sps 12/27/2002 00:13'!
vScrollBarMenuButtonPressed: event
	^ self scrollBarMenuButtonPressed: event
! !

!ScrollPane methodsFor: 'menu' stamp: 'BenjaminVanRyseghem 11/25/2012 03:01'!
getMenu: shiftKeyState
	"Answer the menu for this text view, supplying an empty menu to be filled in. If the menu selector takes an extra argument, pass in the current state of the shift key."
	| menu aMenu aTitle |
	self getMenuSelector == nil ifTrue: [^ nil].
	menu := UIManager default newMenuIn: self for: self model.
	aTitle := getMenuTitleSelector ifNotNil: [self model perform: getMenuTitleSelector].
	self getMenuSelector numArgs = 1 ifTrue:
		[aMenu := self model perform: self getMenuSelector with: menu.
		aTitle ifNotNil:  [aMenu addTitle: aTitle].
		^ aMenu].
	self getMenuSelector numArgs = 2 ifTrue:
		[aMenu := self model perform: self getMenuSelector with: menu with: shiftKeyState.
		aTitle ifNotNil:  [aMenu addTitle: aTitle].
		^ aMenu].
	^ self error: 'The getMenuSelector must be a 1- or 2-keyword symbol'! !

!ScrollPane methodsFor: 'scrolling' stamp: 'MarcusDenker 10/1/2013 21:25'!
hHideScrollBar
	self hIsScrollbarShowing ifFalse: [^scroller offset: (self hMargin negated@scroller offset y)].
	self removeMorph: hScrollBar.
	scroller offset: (self hMargin negated@scroller offset y).
	self resetExtent.

! !

!ScrollPane methodsFor: '*Polymorph-Widgets' stamp: 'gvc 6/6/2006 10:28'!
scrollValue
	"Answer the values of the scrollbars as a point."

	^hScrollBar value @ scrollBar value! !

!ScrollPane methodsFor: 'geometry testing' stamp: 'sps 3/10/2004 13:46'!
hIsScrollable

	"If the contents of the pane are too small to scroll, return false."
	^ self hLeftoverScrollRange > 0
	
! !

!ScrollPane methodsFor: 'geometry' stamp: 'MarcusDenker 10/3/2013 23:33'!
vLeftoverScrollRange
	"Return the entire scrolling range minus the currently viewed area."
	scroller hasSubmorphs ifFalse:[^0].
	^ (self vTotalScrollRange -  self vScrollBarHeight roundTo: self scrollDeltaHeight) max: 0
! !

!ScrollPane methodsFor: 'event handling' stamp: 'MarcusDenker 10/1/2013 21:21'!
mouseEnter: event
	hasFocus := true.
	owner isSystemWindow ifTrue: [owner paneTransition: event].
! !

!ScrollPane methodsFor: 'access' stamp: 'dew 10/17/1999 19:40'!
hasFocus
	"hasFocus is currently set by mouse enter/leave events.
	This inst var should probably be moved up to a higher superclass."

	^ hasFocus ifNil: [false]! !

!ScrollPane methodsFor: '*Polymorph-Widgets' stamp: 'SeanDeNigris 2/10/2015 14:13'!
handlesMouseWheel: evt
	"Do I want to receive mouseWheel events?" 

	^self vIsScrollable or: [ self hIsScrollable ]! !

!ScrollPane methodsFor: 'geometry' stamp: 'sps 12/24/2002 00:13'!
hExtraScrollRange
	"Return the amount of extra blank space to include below the bottom of the scroll content."
	^ self scrollDeltaWidth
! !

!ScrollPane methodsFor: 'geometry' stamp: 'sps 12/25/2002 14:43'!
vUnadjustedScrollRange
	"Return the height extent of the receiver's submorphs."
	| submorphBounds |
	submorphBounds := scroller localSubmorphBounds ifNil: [^ 0].
	^ submorphBounds bottom
! !

!ScrollPane methodsFor: 'geometry' stamp: 'MarcusDenker 10/1/2013 21:24'!
vScrollBarHeight
	| h |

	h := bounds height - (2 * borderWidth).
	self hIsScrollbarNeeded
		ifTrue:[ h := h - self scrollBarThickness. ].
	^h
! !

!ScrollPane methodsFor: 'access options' stamp: 'sps 4/4/2004 12:29'!
showScrollBarsOnlyWhenNeeded: bool

	self showHScrollBarOnlyWhenNeeded: bool.
	self showVScrollBarOnlyWhenNeeded: bool.
! !

!ScrollPane methodsFor: 'access options' stamp: 'sps 4/4/2004 12:23'!
alwaysShowVScrollBar: bool

	self setProperty: #vScrollBarAlways toValue: bool.
	self vHideOrShowScrollBar.
! !

!ScrollPane methodsFor: 'geometry' stamp: 'MarcusDenker 10/1/2013 21:22'!
setScrollDeltas
	"Set the ScrollBar deltas, value and interval, based on the current scroll pane size, offset and range."

	scroller hasSubmorphs ifFalse: 
		[scrollBar interval: 1.0. 
		hScrollBar interval: 1.0. 
		^ self].
	
"NOTE: fullbounds commented out now -- trying to find a case where this expensive step is necessary -- perhaps there is a less expensive way to handle that case."
	"scroller fullBounds." "force recompute so that leftoverScrollRange will be up-to-date"
	self hideOrShowScrollBars.
	
	self vIsScrollbarShowing ifTrue:[ self vSetScrollDelta ].
	self hIsScrollbarShowing ifTrue:[ self hSetScrollDelta ].
! !

!ScrollPane methodsFor: 'drawing' stamp: 'AlainPlantec 10/11/2011 00:31'!
drawSubmorphsOn: aCanvas 
	"Draw the focus here since we are using inset bounds
	for the focus rectangle."

	super drawSubmorphsOn: aCanvas.
	self hasKeyboardFocus ifTrue: [self drawKeyboardFocusOn: aCanvas].
! !

!ScrollPane methodsFor: 'event handling' stamp: 'md 2/13/2006 11:53'!
mouseUp: evt
	"If pane is not empty, pass the event to the last submorph,
	assuming it is the most appropriate recipient (!!)"
	scroller hasSubmorphs ifTrue:
		[scroller submorphs last mouseUp: (evt transformedBy: (scroller transformFrom: self))]! !

!ScrollPane methodsFor: 'geometry' stamp: 'JW 2/21/2001 22:06'!
extraScrollRange
	"Return the amount of extra blank space to include below the bottom of the scroll content."
	"The classic behavior would be ^bounds height - (bounds height * 3 // 4)"
	^ self scrollDeltaHeight! !

!ScrollPane methodsFor: 'scrolling' stamp: 'sps 12/25/2002 16:35'!
showScrollBars
	self  vShowScrollBar; hShowScrollBar
! !

!ScrollPane methodsFor: 'initialization' stamp: 'AlainPlantec 10/10/2011 20:05'!
newTransformMorph
	^TransformMorph new 
! !

!ScrollPane methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/7/2015 21:17'!
drawSubmorphsOnAthensCanvas: anAthensCanvas
	super 	drawSubmorphsOnAthensCanvas: anAthensCanvas.
	self hasKeyboardFocus ifTrue: [self drawKeyboardFocusOnAthensCanvas: anAthensCanvas].! !

!ScrollPane methodsFor: 'scroll bar events' stamp: 'di 6/26/1998 13:31'!
shiftedYellowButtonActivity
	^ self yellowButtonActivity: true! !

!ScrollPane methodsFor: 'access options' stamp: 'sps 4/4/2004 12:21'!
hideScrollBarsIndefinitely: bool
	"Get rid of scroll bar for short panes that don't want it shown."

	self hideVScrollBarIndefinitely: bool.
	self hideHScrollBarIndefinitely: bool.
! !

!ScrollPane methodsFor: 'geometry' stamp: 'sps 3/10/2004 11:06'!
vTotalScrollRange
	"Return the entire scrolling range."
	^ self vUnadjustedScrollRange + self vExtraScrollRange
! !

!ScrollPane methodsFor: 'access' stamp: 'GuillermoPolito 9/24/2012 22:21'!
scrollBar
	^scrollBar! !

!ScrollPane methodsFor: 'accessing' stamp: 'dgd 10/1/2004 12:52'!
borderWidth: aNumber 
	super borderWidth: aNumber.
	self setScrollDeltas! !

!ScrollPane methodsFor: '*Polymorph-Widgets' stamp: 'gvc 6/15/2007 11:14'!
minWidth
	"Answer the minimum width."

	|noVPlease noHPlease minW|
	noVPlease := self valueOfProperty: #noVScrollBarPlease ifAbsent: [false]. 
	noHPlease := self valueOfProperty: #noHScrollBarPlease ifAbsent: [false]. 
	minW := noVPlease
		ifTrue: [noHPlease
					ifTrue: [1]
					ifFalse: [self scrollBarThickness * 3]]
		ifFalse: [noHPlease
					ifTrue: [self scrollBarThickness + 20]
					ifFalse: [self scrollBarThickness * 3 + 2]].
	^minW max: super minWidth! !

!ScrollPane methodsFor: 'scrolling' stamp: 'kfr 11/14/2004 10:29'!
scrollToShow: aRectangle
	"scroll to include as much of aRectangle as possible, where aRectangle is in the scroller's local space"
	| range |
	((aRectangle top - scroller offset y) >= 0 and: [
		(aRectangle bottom - scroller offset y) <= (self innerBounds height) ])
		ifTrue:[ "already visible"^self ].

	range := self vLeftoverScrollRange.
	scrollBar value: (range > 0
		ifTrue: [((aRectangle top) / self vLeftoverScrollRange)
							truncateTo: scrollBar scrollDelta]
		ifFalse: [0]).
	scroller offset: -3 @ (range * scrollBar value).! !

!ScrollPane methodsFor: '*Polymorph-Widgets' stamp: 'gvc 8/27/2009 11:57'!
borderStyle: aBorderStyle
	"Optimised when no change."
	
	self borderStyle = aBorderStyle ifTrue: [^self].
	super borderStyle: aBorderStyle.
	self setScrollDeltas! !

!ScrollPane methodsFor: 'access options' stamp: 'sps 4/4/2004 12:23'!
alwaysShowHScrollBar: bool
	self setProperty: #hScrollBarAlways toValue: bool.
	self hHideOrShowScrollBar.
! !

!ScrollPane methodsFor: 'scroll bar events' stamp: 'sw 3/22/2001 12:03'!
shiftedTextPaneMenuRequest
	"The more... button was hit from the text-pane menu"

	^ self yellowButtonActivity: true! !

!ScrollPane methodsFor: 'scrolling' stamp: 'MartinDias 7/16/2013 17:54'!
vScrollBarValue: scrollValue
	| systemWindow |
	scroller hasSubmorphs ifFalse: [^ self].
	scroller offset: (scroller offset x @ (self vLeftoverScrollRange * scrollValue) rounded).

	owner ifNil: [ ^ self ].
	systemWindow := self window.
		
	systemWindow ifNotNil:
		[ systemWindow 
			announce: (WindowScrolling new step: 0@scrollValue; window: systemWindow) ].
		
	self announcer announce: (PaneScrolling new 
		step: 0@scrollValue;
		scrollPane: self;
		yourself)

! !

!ScrollPane methodsFor: 'scrolling' stamp: 'sps 12/25/2002 16:30'!
hideScrollBars
	self
		vHideScrollBar;
		hHideScrollBar
! !

!ScrollPane methodsFor: 'geometry testing' stamp: 'sps 3/10/2004 10:22'!
vIsScrollbarShowing
	"Return true if a retractable scroll bar is currently showing"

	^submorphs includes: scrollBar
! !

!ScrollPane methodsFor: 'geometry testing' stamp: 'sps 3/10/2004 10:22'!
hIsScrolled
	"If the scroller is not set to x = 0, then the pane has been h-scrolled."
	^scroller offset x > 0
! !

!ScrollPane methodsFor: 'access options' stamp: 'sps 4/4/2004 12:25'!
alwaysShowScrollBars: bool
	"Get rid of scroll bar for short panes that don't want it shown."

	self 
		alwaysShowHScrollBar: bool;
		alwaysShowVScrollBar: bool.
! !

!ScrollPane methodsFor: 'settings' stamp: 'AlainPlantec 12/17/2009 21:38'!
alwaysHideHScrollbar
	^ self class alwaysHideHScrollbar! !

!ScrollPane methodsFor: 'access options' stamp: 'sps 4/4/2004 12:22'!
showHScrollBarOnlyWhenNeeded: bool
	"Get rid of scroll bar for short panes that don't want it shown."

	self setProperty: #noHScrollBarPlease toValue: bool.
	self setProperty: #hScrollBarAlways toValue: bool.
	
	self hHideOrShowScrollBar.
! !

!ScrollPane methodsFor: 'menu' stamp: 'sw 8/18/1998 12:38'!
menuTitleSelector: aSelector
	getMenuTitleSelector := aSelector! !

!ScrollPane methodsFor: 'scrolling' stamp: 'sps 3/10/2004 11:09'!
scrollBy: delta
	"Move the contents in the direction delta."

	| newYoffset r newXoffset |
	
	"Set the offset on the scroller"
	newYoffset := scroller offset y - delta y max: 0.
	newXoffset := scroller offset x - delta x max: -3.
	
	scroller offset: newXoffset@ newYoffset.

	"Update the scrollBars"
	(r := self vLeftoverScrollRange) = 0
		ifTrue: [scrollBar value: 0.0]
		ifFalse: [scrollBar value: newYoffset asFloat / r].
	(r := self hLeftoverScrollRange) = 0
		ifTrue: [hScrollBar value: -3.0]
		ifFalse: [hScrollBar value: newXoffset asFloat / r]
! !

!ScrollPane methodsFor: 'event handling' stamp: 'AlainPlantec 10/7/2011 15:25'!
scrollByKeyboard: event 
	"If event is ctrl+up/down then scroll and answer true"
	(event controlKeyPressed or:[event commandKeyPressed]) ifFalse: [^ false].
	event keyValue = 30
		ifTrue: 
			[scrollBar scrollUp: 3.
			^ true].
	event keyValue = 31
		ifTrue: 
			[scrollBar scrollDown: 3.
			^ true].
	^ false! !

!ScrollPane methodsFor: 'geometry' stamp: 'dew 3/23/2004 23:23'!
hSetScrollDelta
	"Set the ScrollBar deltas, value and interval, based on the current scroll pane size, offset and range."
	| range delta |

	scroller hasSubmorphs ifFalse:[scrollBar interval: 1.0. ^self].
	
	delta := self scrollDeltaWidth.
	range := self hLeftoverScrollRange.
	range = 0 ifTrue: [ hScrollBar scrollDelta: 0.02 pageDelta: 0.2; interval: 1.0; setValue: 0. ^self].

	"Set up for one line (for arrow scrolling), or a full pane less one line (for paging)."

	hScrollBar 
			scrollDelta: (delta / range) asFloat 
			pageDelta: ((self innerBounds width - delta) / range) asFloat.
	hScrollBar interval: ((self innerBounds width) / self hTotalScrollRange) asFloat.
	hScrollBar setValue: ((scroller offset x / range) min: 1.0) asFloat.
! !

!ScrollPane methodsFor: 'event handling' stamp: 'CamilloBruni 3/4/2013 17:39'!
mouseDown: evt
	self flag: #todo. "This is a quick fix for ensure cmd+click works. 
	see: http://code.google.com/p/pharo/issues/detail?id=7403
	probably a better fix is just remove it, but I want to prevent any possible side effects and 
	there is no time for study the issue as it would be required"
	(evt yellowButtonPressed and: [ evt commandKeyPressed not ]) "First check for option (menu) click"
		ifTrue: [ (self yellowButtonActivity: evt shiftPressed) 
			ifTrue: [ ^ super mouseDown: evt. ]].
	
	"If pane is not empty, pass the event to the last submorph,
	assuming it is the most appropriate recipient (!!)"
	scroller hasSubmorphs 
		ifTrue: [ scroller submorphs last mouseDown: (evt transformedBy: (scroller transformFrom: self)) ].
	
	self eventHandler
		ifNotNil: [ self eventHandler mouseDown: evt fromMorph: self ]! !

!ScrollPane methodsFor: '*Polymorph-Widgets' stamp: 'gvc 10/24/2006 12:00'!
hScrollValue: scrollValue
	"Set the horizontal scroll value via the scrollbar itself."

	hScrollBar setValue: scrollValue! !

!ScrollPane methodsFor: 'scrolling' stamp: 'MartinDias 7/16/2013 17:54'!
hScrollBarValue: scrollValue
	| x systemWindow |
	
	self hIsScrollbarShowing ifFalse: 
		[ ^ scroller offset: (0 - self hMargin)@scroller offset y ].
	((x := self hLeftoverScrollRange * scrollValue) <= 0)
		ifTrue:[ x := 0 - self hMargin ].
	scroller offset: (x@scroller offset y).

	owner ifNil: [ ^ self ].
	
	systemWindow := self window.
	systemWindow ifNotNil:
		[ systemWindow 
			announce: (WindowScrolling new step: scrollValue@0; window: systemWindow) ].
		
	self announcer announce: (PaneScrolling new 
		step: scrollValue@0;
		scrollPane: self;
		yourself)! !

!ScrollPane methodsFor: 'scrolling' stamp: 'MarcusDenker 10/1/2013 21:23'!
vHideScrollBar
	self vIsScrollbarShowing ifFalse: [^self].
	self removeMorph: scrollBar.
	self resetExtent
	
! !

!ScrollPane methodsFor: '*Polymorph-Widgets' stamp: 'GaryChambers 2/9/2012 11:31'!
themeChanged
	"The current theme has changed.
	Update any dependent visual aspects."

	scrollBar theme: self theme.
	hScrollBar theme: self theme.
	super themeChanged! !

!ScrollPane methodsFor: 'scrolling' stamp: 'MarcusDenker 10/1/2013 21:18'!
hShowScrollBar

	self hIsScrollbarShowing ifTrue: [^self].
	self hResizeScrollBar.
	self privateAddMorph: hScrollBar atIndex: 1.
	self resetExtent.
! !

!ScrollPane methodsFor: 'accessing' stamp: 'nk 3/8/2004 11:07'!
numSelectionsInView
	"Answer the scroller's height based on the average number of submorphs."
	
	^scroller numberOfItemsPotentiallyInView! !

!ScrollPane methodsFor: 'event handling' stamp: 'md 2/13/2006 11:53'!
keyStroke: evt
	"If pane is not empty, pass the event to the last submorph,
	assuming it is the most appropriate recipient (!!)"

	(self scrollByKeyboard: evt) ifTrue: [^self].
	scroller submorphs last keyStroke: evt! !

!ScrollPane methodsFor: 'geometry' stamp: 'dew 10/17/1999 19:41'!
resetExtent
	"Reset the extent. (may be overridden by subclasses which need to do more than this)"
	self resizeScroller! !

!ScrollPane methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 8/5/2012 22:39'!
initializeScroller
	scroller := self newTransformMorph color: Color transparent.
	scroller offset: -3 @ 0.
	self addMorph: scroller! !

!ScrollPane methodsFor: 'geometry' stamp: 'MarcusDenker 10/1/2013 21:20'!
innerBounds
	| inner |
	inner := super innerBounds.
	(submorphs includes: scrollBar) ifTrue:[
		inner := (inner topLeft corner: (inner right - scrollBar width) @ inner bottom)
	].
	self hIsScrollbarShowing
		ifFalse: [ ^ inner]
		ifTrue: [ ^ inner topLeft extent: (inner extent - (0@self scrollBarThickness))].
! !

!ScrollPane methodsFor: 'event handling' stamp: 'sps 3/10/2004 10:23'!
handlesMouseDown: evt
	^ true
! !

!ScrollPane methodsFor: 'scrolling' stamp: 'sps 12/25/2002 16:31'!
vHideOrShowScrollBar

	self vIsScrollbarNeeded
		ifTrue:[ self vShowScrollBar ]
		ifFalse:[ self vHideScrollBar ].
! !

!ScrollPane methodsFor: 'access options' stamp: 'nk 4/28/2004 10:08'!
hideScrollBarsIndefinitely
	self hideScrollBarsIndefinitely: true
! !

!ScrollPane methodsFor: 'scroll bar events' stamp: 'di 6/26/1998 13:31'!
scrollBarMenuButtonPressed: event
	^ self yellowButtonActivity: event shiftPressed! !

!ScrollPane methodsFor: 'scrolling' stamp: 'StephaneDucasse 5/28/2011 13:35'!
hideOrShowScrollBars

	| wasHShowing wasVShowing |

	wasVShowing := self vIsScrollbarShowing.
	wasHShowing := self hIsScrollbarShowing.

	self 
		vHideOrShowScrollBar; 
		hHideOrShowScrollBar; 
		resizeScrollBars.

	(wasVShowing and: [self vIsScrollbarShowing not]) ifTrue:
		["Make sure the delta is 0"
		(scroller offset y = 0) 
				ifFalse:[ scroller offset: (scroller offset x@0) ]].
			
	(wasHShowing and: [self hIsScrollbarShowing not]) ifTrue:
		[(scroller offset x <= 0)
				ifFalse:[ scroller offset: (self hMargin negated@scroller offset y)]].
! !

!ScrollPane methodsFor: 'geometry' stamp: 'sps 3/10/2004 11:51'!
hTotalScrollRange
	"Return the entire scrolling range."
	^ self hUnadjustedScrollRange + self hExtraScrollRange + self hMargin
! !

!ScrollPane methodsFor: 'initialization' stamp: 'ThierryGoubier 9/14/2012 23:01'!
initializeShortcuts: aKMDispatcher
	super initializeShortcuts: aKMDispatcher.
	aKMDispatcher attachCategory: #ScrollPane! !

!ScrollPane methodsFor: 'scroll bar events' stamp: 'MarcusDenker 12/2/2013 14:08'!
yellowButtonActivity: shiftKeyState
	
	(self getMenu: shiftKeyState) 
		ifNotNil: [ :menu|
			menu setInvokingView: self.
			menu popUpEvent: self activeHand lastEvent in: self world.
			^ true].
	^ false! !

!ScrollPane methodsFor: 'scrolling' stamp: 'MarcusDenker 10/1/2013 21:23'!
vIsScrollbarNeeded
"Return whether the verticle scrollbar is needed"
	
	"Don't show it if we were told not to."
	(self valueOfProperty: #noVScrollBarPlease ifAbsent: [false]) ifTrue: [^false].

	"Always show it if we were told to"
	(self valueOfProperty: #vScrollBarAlways ifAbsent: [false]) ifTrue: [^true].
	
	^self vIsScrollable
! !

!ScrollPane methodsFor: '*Polymorph-Widgets' stamp: 'gvc 10/26/2006 15:30'!
getMenuSelector: aSymbol
	"Set the menu selector."

	getMenuSelector := aSymbol! !

!ScrollPane methodsFor: 'geometry' stamp: 'sps 12/25/2002 14:40'!
vExtraScrollRange
	"Return the amount of extra blank space to include below the bottom of the scroll content."
	"The classic behavior would be ^bounds height - (bounds height * 3 // 4)"
	^ self scrollDeltaHeight
! !

!ScrollPane methodsFor: '*Polymorph-Widgets' stamp: 'MarcusDenker 10/1/2013 21:13'!
scrollBarThickness
	"Includes border"
	^ self theme scrollbarThickness
	! !

!ScrollPane methodsFor: 'geometry testing' stamp: 'sps 3/10/2004 10:22'!
isScrolledFromTop
	"Have the contents of the pane been scrolled, so that the top of the contents are not visible?"
	^scroller offset y > 0
! !

!ScrollPane methodsFor: 'geometry' stamp: 'MarcusDenker 10/1/2013 21:18'!
hScrollBarWidth
"Return the width of the horizontal scrollbar"


	| w |
	
	w := bounds width - (2 * borderWidth).
	
	self vIsScrollbarNeeded
		ifTrue: [w := w - self scrollBarThickness ].
		
	^w 
! !

!ScrollPane methodsFor: 'menu' stamp: 'BenjaminVanRyseghem 11/25/2012 02:41'!
wantsYellowButtonMenu
	"Answer true if the receiver wants a yellow button menu"
	^ self getMenuSelector notNil! !

!ScrollPane methodsFor: 'geometry' stamp: 'sps 3/10/2004 13:26'!
scrollDeltaHeight
	"Return the increment in pixels which this pane should be scrolled (normally a subclass responsibility)."
	^ 10
! !

!ScrollPane methodsFor: 'settings' stamp: 'AlainPlantec 12/17/2009 21:38'!
alwaysShowHScrollbar
	^ self class alwaysShowHScrollbar! !

!ScrollPane methodsFor: 'geometry testing' stamp: 'sps 3/10/2004 10:23'!
vIsScrolled
	"If the scroller is not set to y = 0, then the pane has been scrolled."
	^scroller offset y > 0
! !

!ScrollPane methodsFor: 'initialization' stamp: 'sps 4/3/2005 15:21'!
defaultExtent
	^150@120
! !

!ScrollPane methodsFor: '*Polymorph-Widgets' stamp: 'MarcusDenker 10/1/2013 21:16'!
hideOrShowScrollBar
	"Hide or show the scrollbar depending on if the pane is scrolled/scrollable."

	"Don't show it if we were told not to."
	(self valueOfProperty: #noScrollBarPlease ifAbsent: [false]) ifTrue: [^self].

	(self vIsScrollbarNeeded not and: [ self isScrolledFromTop not ]) ifTrue: [self vHideScrollBar].
	(self vIsScrollbarNeeded or: [ self isScrolledFromTop ]) ifTrue: [self vShowScrollBar].
! !

!ScrollPane methodsFor: '*Polymorph-Widgets' stamp: 'CamilloBruni 9/14/2013 17:20'!
scrollValue: aPoint
	self 
		hScrollValue: aPoint x;
		vScrollValue: aPoint y.! !

!ScrollPane methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/27/2009 16:44'!
adoptPaneColor: paneColor
	"Match the pane colour."
	
	super adoptPaneColor: paneColor.
	scrollBar adoptPaneColor: paneColor.
	hScrollBar adoptPaneColor: paneColor.
	paneColor ifNil: [^self].
	self borderWidth > 0 ifTrue: [
		self borderStyle: self borderStyleToUse]! !

!ScrollPane methodsFor: 'geometry' stamp: 'MarcusDenker 10/1/2013 21:32'!
vResizeScrollBar
	| w topLeft  |
	w := self scrollBarThickness.
	topLeft := bounds topRight - ((w + borderWidth - 0) @ (0 - borderWidth)).
	scrollBar bounds: (topLeft extent: w @ self vScrollBarHeight)! !

!ScrollPane methodsFor: 'scroll bar events' stamp: 'sps 12/27/2002 00:13'!
hScrollBarMenuButtonPressed: event
	^ self scrollBarMenuButtonPressed: event
! !

!ScrollPane methodsFor: 'geometry' stamp: 'dew 3/23/2004 23:25'!
vSetScrollDelta
	"Set the ScrollBar deltas, value and interval, based on the current scroll pane size, offset and range."
	| range delta |

	scroller hasSubmorphs ifFalse:[scrollBar interval: 1.0. ^self].
	
	delta := self scrollDeltaHeight.
	range := self vLeftoverScrollRange.
	range = 0 ifTrue: [^ scrollBar scrollDelta: 0.02 pageDelta: 0.2; interval: 1.0; setValue: 0].

	"Set up for one line (for arrow scrolling), or a full pane less one line (for paging)."
	scrollBar scrollDelta: (delta / range) asFloat 
			pageDelta: ((self innerBounds height - delta) / range) asFloat.
	scrollBar interval: ((self innerBounds height) / self vTotalScrollRange) asFloat.
	scrollBar setValue: (scroller offset y / range min: 1.0) asFloat.
! !

!ScrollPane methodsFor: 'access options' stamp: 'sps 4/4/2004 12:25'!
showVScrollBarOnlyWhenNeeded: bool
	"Get rid of scroll bar for short panes that don't want it shown."

	self setProperty: #noVScrollBarPlease toValue: bool.
	self setProperty: #vScrollBarAlways toValue: bool.
	self vHideOrShowScrollBar.
! !

!ScrollPane methodsFor: 'access' stamp: 'sps 3/10/2004 11:32'!
hMargin
"pixels of whitespace at to the left of the scroller when the hScrollBar offset is 0"
	^3
! !

!ScrollPane methodsFor: 'event handling' stamp: 'md 2/13/2006 11:53'!
mouseMove: evt
	"If pane is not empty, pass the event to the last submorph,
	assuming it is the most appropriate recipient (!!)."
	scroller hasSubmorphs ifTrue:
		[scroller submorphs last mouseMove: (evt transformedBy: (scroller transformFrom: self))]! !

!ScrollPane methodsFor: 'initialization' stamp: 'MarcusDenker 7/20/2014 13:12'!
initializeScrollBars
	"initialize the receiver's scrollBar"

	(scrollBar := ScrollBar new model: self; setValueSelector: #vScrollBarValue:)
		borderWidth: 1;
		borderColor: Color black.
	(hScrollBar := ScrollBar new model: self; setValueSelector: #hScrollBarValue:)
		borderWidth: 1;
		borderColor: Color black.
	self initializeScroller.
	self addMorph: scrollBar.
	self addMorph: hScrollBar.
	self alwaysShowVScrollbar
		ifTrue: [ self alwaysShowVScrollBar: true ].
	self alwaysHideHScrollbar
		ifTrue: [ self hideHScrollBarIndefinitely: true ]
		ifFalse: [ 
			self alwaysShowHScrollbar
				ifTrue: [ self alwaysShowHScrollBar: true ] ]! !

!ScrollPane methodsFor: 'access options' stamp: 'sps 4/4/2004 12:23'!
hideHScrollBarIndefinitely: bool
	"Get rid of scroll bar for short panes that don't want it shown."

	self setProperty: #noHScrollBarPlease toValue: bool.
	self hHideOrShowScrollBar.
! !

!ScrollPane methodsFor: 'scrolling' stamp: 'MarcusDenker 10/1/2013 21:24'!
vShowScrollBar

	self vIsScrollbarShowing ifTrue: [^ self].
	self vResizeScrollBar.
	self privateAddMorph: scrollBar atIndex: 1.
	self resetExtent
! !

!ScrollPane methodsFor: 'geometry' stamp: 'MarcusDenker 10/1/2013 21:12'!
extent: newExtent
	
	| oldW oldH wasHShowing wasVShowing noVPlease noHPlease minH minW |
	
	oldW := self width.
	oldH := self height.
	wasHShowing := self hIsScrollbarShowing.
	wasVShowing := self vIsScrollbarShowing.

	"Figure out the minimum width and height for this pane so that scrollbars will appear"
	noVPlease := self valueOfProperty: #noVScrollBarPlease ifAbsent: [false]. 
	noHPlease := self valueOfProperty: #noHScrollBarPlease ifAbsent: [false]. 
	minH := self scrollBarThickness + 16.
	minW := self scrollBarThickness + 20.
	noVPlease ifTrue:[ 
		noHPlease
			ifTrue:[minH := 1. minW := 1 ]
			ifFalse:[minH := self scrollBarThickness ].
	] ifFalse:[
		noHPlease
			ifTrue:[minH := self scrollBarThickness + 5].
	].
	super extent: (newExtent max: (minW@minH)).

	"Now reset widget sizes"
	self resizeScrollBars; resizeScroller; hideOrShowScrollBars.
	
	"Now resetScrollDeltas where appropriate, first the vScrollBar..."
	((self height ~~ oldH) or: [ wasHShowing ~~ self hIsScrollbarShowing]) ifTrue:
		[self vIsScrollbarShowing ifTrue: [ self vSetScrollDelta ]].
			
	"...then the hScrollBar"
	((self width ~~ oldW) or: [wasVShowing ~~ self vIsScrollbarShowing]) ifTrue:
		[self hIsScrollbarShowing ifTrue: [ self hSetScrollDelta ]].

! !

!ScrollPane methodsFor: '*Polymorph-Widgets' stamp: 'BenjaminVanRyseghem 11/25/2012 02:41'!
getMenuSelector

	^ getMenuSelector! !

!ScrollPane methodsFor: 'geometry testing' stamp: 'sps 3/10/2004 13:23'!
vIsScrollable
"Return whether the verticle scrollbar is scrollable"

	"If the contents of the pane are too small to scroll, return false."
	^ self vLeftoverScrollRange > 0
		"treat a single line as non-scrollable"
		and: [self vTotalScrollRange > (self scrollDeltaHeight * 3/2)]
! !

!ScrollPane methodsFor: 'scroll bar events' stamp: 'di 6/26/1998 13:32'!
unshiftedYellowButtonActivity
	^ self yellowButtonActivity: false! !

!ScrollPane methodsFor: 'geometry' stamp: 'sps 12/25/2002 16:34'!
resizeScrollBars
	self vResizeScrollBar; hResizeScrollBar
! !

!ScrollPane methodsFor: 'access' stamp: ''!
scroller
	^ scroller! !

!ScrollPane methodsFor: '*Polymorph-Widgets' stamp: 'gvc 10/24/2006 12:00'!
vScrollValue: scrollValue
	"Set the vertical scroll value via the scrollbar itself."

	scrollBar setValue: scrollValue! !

!ScrollPane methodsFor: 'initialization' stamp: 'EstebanLorenzano 5/15/2014 13:26'!
defaultBorderColor
	"answer the default border color/fill style for the receiver"
	^ self theme borderColor! !

!ScrollPane methodsFor: '*Polymorph-Widgets' stamp: 'MarcusDenker 7/9/2014 21:36'!
minHeight
	"Answer the minimum height."

	| noVPlease noHPlease minH |
	noVPlease := self valueOfProperty: #noVScrollBarPlease ifAbsent: [ false ].
	noHPlease := self valueOfProperty: #noHScrollBarPlease ifAbsent: [ false ].
	minH := noVPlease
		ifTrue: [ 
			noHPlease
				ifTrue: [ 1 ]
				ifFalse: [ self scrollBarThickness ] ]
		ifFalse: [ 
			noHPlease
				ifTrue: [ self scrollBarThickness * 3 ]
				ifFalse: [ self scrollBarThickness * 4 + 2 ] ].
	^ minH max: super minHeight! !

!ScrollPane methodsFor: 'geometry' stamp: 'AlainPlantec 10/9/2011 02:15'!
hLeftoverScrollRange
	"Return the entire scrolling range minus the currently viewed area."
	| w |
	scroller hasSubmorphs ifFalse: [^0].
	w :=  bounds width.
	self vIsScrollbarShowing ifTrue:[ w := w - self scrollBarThickness ].
	^ (self hTotalScrollRange - w roundTo: self scrollDeltaHeight) max: 0
! !

!ScrollPane methodsFor: 'event handling' stamp: 'MarcusDenker 10/1/2013 21:21'!
mouseLeave: event
	hasFocus := false.
	owner isSystemWindow ifTrue: [owner paneTransition: event]
! !

!ScrollPane methodsFor: 'geometry' stamp: 'sps 3/9/2004 17:29'!
scrollDeltaWidth
	"Return the increment in pixels which this pane should be scrolled (normally a subclass responsibility)."
	
	^10
! !

!ScrollPane methodsFor: 'geometry' stamp: 'MarcusDenker 10/1/2013 21:17'!
hResizeScrollBar

	| topLeft h |

	(self valueOfProperty: #noHScrollBarPlease ifAbsent: [false]) ifTrue: [^self].
	bounds ifNil: [ self fullBounds ].
	
	h := self scrollBarThickness.
	topLeft := bounds bottomLeft + (borderWidth @ (h + borderWidth) negated).
	hScrollBar bounds: (topLeft extent: self hScrollBarWidth@ h)
! !

!ScrollPane methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/27/2009 16:43'!
borderStyleToUse
	"Answer the borderStyle that should be used for the receiver."
	
	^self enabled
		ifTrue: [self theme scrollPaneNormalBorderStyleFor: self]
		ifFalse: [self theme scrollPaneDisabledBorderStyleFor: self]! !

!ScrollPane class methodsFor: 'settings' stamp: 'AlainPlantec 12/17/2009 21:36'!
alwaysShowVScrollbar
	^ false! !

!ScrollPane class methodsFor: 'examples' stamp: 'mk 8/9/2005 10:28'!
example1
	| window scrollPane pasteUpMorph |
	window := SystemWindow new.
	scrollPane := ScrollPane new.
	pasteUpMorph := PasteUpMorph new.
	pasteUpMorph extent: 1000@1000.
	scrollPane scroller addMorph: pasteUpMorph.
	window addMorph: scrollPane frame: (0@0 corner: 1@1).
	window openInWorld.! !

!ScrollPane class methodsFor: 'settings' stamp: 'AlainPlantec 12/17/2009 21:36'!
alwaysHideHScrollbar
	^ false! !

!ScrollPane class methodsFor: 'shortcuts' stamp: 'GuillermoPolito 9/24/2012 21:58'!
buildScrollPaneShortcuts: aBuilder
	"Note: the ctrl up and down don't work because they are transformed at the very beginning as mousewheel ctrl up and ctrl down. But why and how ? TG 15/09/2012."

	<keymap>
	(aBuilder shortcut: #scrollUp)
		category: #ScrollPane
		default: Character arrowUp ctrl | Character arrowUp command mac
		do: [ :target | target scrollBar scrollUp: 3 ].
	(aBuilder shortcut: #scrollDown)
		category: #ScrollPane
		default: Character arrowDown ctrl | Character arrowDown command mac
		do: [ :target | target scrollBar scrollDown: 3 ].! !

!ScrollPane class methodsFor: 'examples' stamp: 'mk 8/9/2005 10:29'!
example2
	| window scrollPane pasteUpMorph point textMorph |
	window := SystemWindow new.
	scrollPane := ScrollPane new.
	pasteUpMorph := PasteUpMorph new.
	pasteUpMorph extent: 1000@1000.
	scrollPane scroller addMorph: pasteUpMorph.
	window addMorph: scrollPane frame: (0@0 corner: 1@1).
	0 to: 1000 by: 100 do: 
		[:x | 0 to: 1000 by: 100 do:
			[:y |
				point :=  x@y.
				textMorph := TextMorph new contents: point asString.
				textMorph position: point.
				pasteUpMorph addMorph: textMorph
			]
		].
	window openInWorld.! !

!ScrollPane class methodsFor: 'settings' stamp: 'AlainPlantec 12/17/2009 21:36'!
alwaysShowHScrollbar
	^ false! !

!ScrollSyncExample commentStamp: '<historical>'!
I am an example that exposes to the world how to use a ScrollPane announcement to have a nice morph being in sync with the current vertical scrollbar position.

Invoke me with:
	ScrollSyncExample new openWithSpec!
!ScrollSyncExample methodsFor: 'layouts' stamp: 'MartinDias 7/16/2013 19:55'!
defaultSpecLayout
	<spec>
	 ^ SpecLayout composed
		add: #sideRuler 
		origin: 0@(1 - self currentVerticalScrollPosition) 
		corner: 0@(1 - self currentVerticalScrollPosition) 
		offsetOrigin: 0@(-250) 
		offsetCorner: 50@250;
		add: #text 
		origin: 0@0 
		corner: 1@1 
		offsetOrigin: 50@0 
		offsetCorner: 0@0;
		yourself! !

!ScrollSyncExample methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 10/1/2013 13:47'!
initialize

	super initialize.

	sideRuler := (Morph new
		color: Color yellow;
		extent: 50@500;
		useGradientFill;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		yourself) asSpecAdapter.
		
	currentVerticalScrollPosition := 0.! !

!ScrollSyncExample methodsFor: 'accessing' stamp: 'MartinDias 7/16/2013 19:55'!
currentVerticalScrollPosition
	^ currentVerticalScrollPosition! !

!ScrollSyncExample methodsFor: 'accessing' stamp: 'MartinDias 7/16/2013 19:48'!
sideRuler
	^ sideRuler! !

!ScrollSyncExample methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 10/1/2013 13:36'!
initializeWidgets

	text := self newText.
		
	text whenBuiltDo: [ :builtAnnouncement | 
		text whenScrollValueChanged: [ :newPosition | self syncMorphPosition ] ].
	
	text text: self loremIpsum.! !

!ScrollSyncExample methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/4/2014 21:28'!
loremIpsum
	^ String loremIpsum: 2854! !

!ScrollSyncExample methodsFor: 'private' stamp: 'BenjaminVanRyseghem 10/1/2013 13:30'!
syncMorphPosition

	currentVerticalScrollPosition = text scrollValue y ifTrue: [ ^ self ].
	currentVerticalScrollPosition := text scrollValue y.
	self needRebuild: false.
	text needRebuild: false.
	self buildWithSpecLayout: self defaultSpecLayout.! !

!ScrollSyncExample methodsFor: 'accessing' stamp: 'MartinDias 7/16/2013 18:01'!
text
	^ text! !

!ScrollSyncExample class methodsFor: 'specs' stamp: 'MartinDias 7/16/2013 19:48'!
defaultSpec
	<spec>
	
	 ^ SpecLayout composed
		newRow: [ :r |
			r 
				add: #sideRuler width: 50;
				add: #text ];
		yourself! !

!ScrollSyncExample class methodsFor: 'specs' stamp: 'MartinDias 7/16/2013 18:35'!
title

	^ self name! !

!ScrollSyncExample class methodsFor: 'example' stamp: 'HernanMoralesDurand 2/3/2014 00:09'!
example
	"self example"

	ScrollSyncExample new openWithSpec.
! !

!SearchFacade commentStamp: '<historical>'!
SearchFacade is a facade for creating searching dialog window!
!SearchFacade class methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 7/24/2013 08:51'!
mcPackageSearch
	^ self mcPackageSearchRejectAll: [ :aPackage | false ] withInitialFilter: nil! !

!SearchFacade class methodsFor: 'protocol search' stamp: 'BenjaminVanRyseghem 6/27/2012 00:00'!
protocolSearchFor: aClass

	^ (self protocolSearchIn: aClass organization categories)
			browseBlock: [:answer | Smalltalk tools browser openOnClass: aClass onProtocol: answer ]; 
			yourself! !

!SearchFacade class methodsFor: 'class search' stamp: 'MarcusDenker 8/13/2014 15:14'!
classSearchIn: classes
	^ ListDialogWindow new
		getList: [ :r | classes select: [ :e | r search: e name ] ];
		displayBlock: [ :e | e name ];
		title: 'Class search' translated;
		yourself! !

!SearchFacade class methodsFor: 'class search' stamp: 'CamilloBruni 9/14/2012 01:41'!
classSearch

	^ self classSearchInEnvironment: self environment! !

!SearchFacade class methodsFor: 'message search' stamp: 'MarcusDenker 8/13/2014 15:14'!
messageSearchIn: aCollection
	| rawList |
	rawList := aCollection sorted: [ :a :b | a selector <= b selector ].
	^ ListDialogWindow new
		getList: [ :r | rawList select: [ :e | r search: e selector ] ];
		displayBlock: [ :e | e selector ];
		title: 'Message search' translated;
		yourself! !

!SearchFacade class methodsFor: 'message search' stamp: 'CamilloBruni 9/14/2012 01:22'!
allMessageSearchFor: aClass

	^ self messageSearchIn: aClass allMethods! !

!SearchFacade class methodsFor: 'rpackage search' stamp: 'BenjaminVanRyseghem 6/26/2012 23:27'!
rPackageSearch
				
	^ self rPackageSearchIn: RPackageOrganizer default! !

!SearchFacade class methodsFor: 'class search' stamp: 'CamilloBruni 9/14/2012 01:41'!
superclassSearchFor: aClass

	^ self classSearchIn: aClass allSuperclasses reverse! !

!SearchFacade class methodsFor: 'class search' stamp: 'CamilloBruni 9/14/2012 01:41'!
classSearchInEnvironment: anEnvironment
	| classes |
	classes :=  anEnvironment allClassesAndTraits sorted: [ :a :b| a name <= b name ].
	^ self classSearchIn: classes.! !

!SearchFacade class methodsFor: 'class search' stamp: 'CamilloBruni 9/14/2012 01:42'!
subclassSearchFor: aClass
	| classes |
	classes := aClass allSubclasses sorted: [ :a :b| a name <= b name ].
	^ self classSearchIn: classes! !

!SearchFacade class methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 7/17/2013 15:07'!
mcPackageSearchRejectAll: aRejectBlock withInitialFilter: filter
	| workingCopies |
	
	workingCopies := MCWorkingCopy allManagers asSortedCollection: [ :a :b | a name <= b name].
	workingCopies := workingCopies reject: aRejectBlock.
	
	^ ListDialogWindow new
				getList: [ :regex | workingCopies select: [ :workingCopy | regex search: workingCopy name] ];
				displayBlock: [ :workingCopy | workingCopy package name ];
				title: 'Monticello packages';
				initialFilter: (filter ifNil: [ '' ] ifNotNil: [ filter]);
				yourself. 
! !

!SearchFacade class methodsFor: 'rpackage search' stamp: 'MarcusDenker 8/13/2014 15:14'!
rPackageSearchIn: anOrganizer
	| rawList |
	rawList := anOrganizer packages sorted: [ :a :b | a name <= b name ].
	^ ListDialogWindow new
		getList: [ :r | rawList select: [ :e | r search: e name ] ];
		displayBlock: [ :e | e name ];
		browseBlock: [ :answer | Smalltalk tools browser openOnPackage: answer ];
		title: 'Package search' translated;
		yourself! !

!SearchFacade class methodsFor: 'message search' stamp: 'BenjaminVanRyseghem 6/26/2012 23:36'!
messageSearchFor: aClass

	^ self messageSearchIn: aClass methods! !

!SearchFacade class methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 7/24/2013 23:23'!
projectWithConfigurationSearchRejectAll: aRejectBlock
	"Get a  search widget with filled with projects having a ConfigurationOf in the image."
	| projects |

	projects := (MBConfigurationRoot current configurations) reject: aRejectBlock.
	
	^ ListDialogWindow new
				getList: [ :regex | projects select: [ :project | regex search: project name configurationBaseName] ];
				displayBlock: [:e | e name configurationBaseName];
				browseBlock: [:answer | Smalltalk tools browser openOnPackage: answer ]; 
				title: 'Projects with a configuration';
				yourself. ! !

!SearchFacade class methodsFor: 'class search' stamp: 'CamilloBruni 9/14/2012 01:45'!
hierarchySearchFor: aClass
	| classes |
	classes := aClass allSuperclasses reverse, (aClass allSubclasses sorted: [ :a :b| a name <= b name ]).
	^ self classSearchIn: classes! !

!SearchFacade class methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 7/17/2013 15:07'!
mcPackageSearchRejectAll: aRejectBlock
	^ self mcPackageSearchRejectAll: aRejectBlock withInitialFilter: nil! !

!SearchFacade class methodsFor: 'package search' stamp: 'MarcusDenker 8/13/2014 15:14'!
packageSearchIn: anEnvironment
	| rawList |
	rawList := anEnvironment organization categories sort.
	^ ListDialogWindow new
		getList: [ :r | rawList select: [ :e | r search: e ] ];
		displayBlock: [ :e | e ];
		title: 'Package search' translated;
		yourself! !

!SearchFacade class methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 7/24/2013 23:24'!
projectWithConfigurationSearch
	"Get a  search widget with filled with projects having a ConfigurationOf in the image."

	^ self projectWithConfigurationSearchRejectAll: [ :item | false ]! !

!SearchFacade class methodsFor: 'protocol search' stamp: 'MarcusDenker 8/13/2014 15:14'!
protocolSearchIn: aCollection
	^ ListDialogWindow new
		getList: [ :r | aCollection sorted select: [ :e | r search: e ] ];
		displayBlock: [ :e | e ];
		title: 'Protocol search' translated;
		yourself! !

!SearchFacade class methodsFor: 'package search' stamp: 'BenjaminVanRyseghem 6/26/2012 23:27'!
packageSearch
				
	^ self packageSearchIn: self environment! !

!SearchMorph commentStamp: 'CamilloBruni 8/4/2011 14:39'!
I am a searchfield with a dropdown for the history. It is a minor extension to the EditableDropListMorph managing the search history directly in the morph. 

Typical use-case:

	^ SearchMorph new
		model: self;
		setIndexSelector: #classSearchAccept:; "sends the search result to the model"
		searchList: self class classSearchList; "sent on creation to get the initial search list"
		yourself
	
	!
!SearchMorph methodsFor: 'drawing' stamp: 'GuillermoPolito 7/24/2012 13:08'!
newContentMorph
	|pluggableTextMorph|
	pluggableTextMorph := super newContentMorph.

	pluggableTextMorph 
		autoAccept: false;
		askBeforeDiscardingEdits: false;
		setProperty: #wantsFrameAdornments toValue: false;
		changedAction: [:aString| self contentChanged: aString asString];
		eventHandler: MorphicEventHandler new.
		
	pluggableTextMorph on: #keyStroke send: #keyStroke:fromMorph: to: self.
	^ pluggableTextMorph! !

!SearchMorph methodsFor: 'event handling' stamp: 'CamilloBruni 8/11/2011 07:57'!
keyStroke: event

	keystrokeSelector ifNotNil: [ 
		(self keystrokeAction: event) ifTrue: [ ^ self ] ].
	
	^ super keyStroke: event! !

!SearchMorph methodsFor: 'accessing' stamp: 'CamilloBruni 8/4/2011 12:27'!
searchList: aCollection
	self list: aCollection! !

!SearchMorph methodsFor: 'accessing' stamp: 'CamilloBruni 9/2/2011 13:05'!
keystrokeSelector
	^ keystrokeSelector! !

!SearchMorph methodsFor: 'accessing' stamp: 'CamilloBruni 8/11/2011 07:07'!
keystrokeSelector: aSymbol
	keystrokeSelector := aSymbol.
! !

!SearchMorph methodsFor: 'accessing' stamp: 'CamilloBruni 8/3/2011 16:44'!
maxSize: aNumber
	maxSize := aNumber! !

!SearchMorph methodsFor: 'initialization' stamp: 'CamilloBruni 8/4/2011 14:22'!
initialize
	super initialize.
	self convertTo: String.
	list := OrderedCollection new.
	self useSelectionIndex: false.
	self ghostText: 'Hit return to accept' translated! !

!SearchMorph methodsFor: 'event handling' stamp: 'CamilloBruni 9/2/2011 13:13'!
keyStroke: event fromMorph: morph

	keystrokeSelector ifNotNil: [ 
		^ self keystrokeAction: event ].
	
	^ false! !

!SearchMorph methodsFor: 'accessing' stamp: 'CamilloBruni 8/3/2011 16:44'!
maxSize
	^ maxSize! !

!SearchMorph methodsFor: 'accessing' stamp: 'CamilloBruni 8/3/2011 19:17'!
listSelectionIndex: anInteger
	"Set the list selection."

	self hideList.
	anInteger = 0 
		ifTrue: [
			self model ifNotNil: [:m | 
				self setIndexSelector ifNotNil: [:s |
					self useSelectionIndex 
						ifFalse: [m perform: s with: nil]]]]
		ifFalse: [ ^ super listSelectionIndex: anInteger ].! !

!SearchMorph methodsFor: 'protocol' stamp: 'CamilloBruni 8/11/2011 06:13'!
takeKeyboardFocus
	contentMorph takeKeyboardFocus.! !

!SearchMorph methodsFor: 'accessing' stamp: 'CamilloBruni 8/11/2011 04:41'!
acceptSelector: aSymbol
	self setIndexSelector: aSymbol! !

!SearchMorph methodsFor: 'accessing' stamp: 'CamilloBruni 8/3/2011 17:24'!
searchList
	^ list ifNil: [ list := OrderedCollection new].! !

!SearchMorph methodsFor: 'protocol' stamp: 'CamilloBruni 8/11/2011 08:01'!
contentChanged: aString
	content := aString.
	self updateSelector ifNotNil: [ :selector|
		self model perform: selector with: aString ]! !

!SearchMorph methodsFor: 'accessing' stamp: 'CamilloBruni 8/3/2011 17:17'!
searchString
	^ content! !

!SearchMorph methodsFor: 'private' stamp: 'CamilloBruni 8/11/2011 04:06'!
nextCompletion
	currentCompletionIndex := (currentCompletionIndex + 1 \\ self searchList size) + 1.
	^ self currentTabCompletion! !

!SearchMorph methodsFor: 'private' stamp: 'CamilloBruni 8/11/2011 04:08'!
currentTabCompletion
	self searchList ifEmpty: [ ^ ''].
	
	currentCompletionIndex > self searchList
		ifTrue: [ currentCompletionIndex := 1].
	
	^ self searchList at: currentCompletionIndex! !

!SearchMorph methodsFor: 'protocol' stamp: 'CamilloBruni 8/4/2011 12:27'!
addToList: aString
	aString isEmpty ifTrue: [ ^ self ].
	list ifNil: [
		list := self searchList].
	list remove: aString ifAbsent: [].
	list size = self maxSize
		ifTrue: [ self searchList removeLast].
	list addFirst: aString.
	self changed: #list.! !

!SearchMorph methodsFor: 'accessing' stamp: 'CamilloBruni 8/11/2011 07:52'!
selectionInterval
	^ contentMorph selectionInterval! !

!SearchMorph methodsFor: 'event handling' stamp: 'CamilloBruni 9/2/2011 13:06'!
keystrokeAction: event 
	| args returnValue |
	keystrokeSelector ifNil: [ ^ nil ].
	args := keystrokeSelector numArgs.
	args = 1 ifTrue: [returnValue := model perform: keystrokeSelector with: event].
	args = 2 
		ifTrue: 
			[returnValue := model 
				perform: keystrokeSelector
				with: event
				with: self].
	returnValue ifNotNil: [
			^ returnValue = true ].
	
	self error: 'keystrokeSelector must be a 1- or 2-keyword symbol'.
	^ false! !

!SearchMorph methodsFor: 'accessing' stamp: 'CamilloBruni 8/11/2011 04:50'!
acceptSelector
	^ self setIndexSelector! !

!SearchMorph methodsFor: 'protocol' stamp: 'CamilloBruni 8/4/2011 12:31'!
showList
	"trigger a list update so that shared search results are updated properly"
	self changed: #list.
	super showList.! !

!SearchMorph methodsFor: 'accessing' stamp: 'CamilloBruni 8/11/2011 04:57'!
updateSelector
	^ updateSelector! !

!SearchMorph methodsFor: 'accessing' stamp: 'CamilloBruni 8/11/2011 04:57'!
updateSelector: aSymbol 
	updateSelector := aSymbol! !

!SearchMorph methodsFor: 'accessing' stamp: 'CamilloBruni 8/11/2011 06:56'!
content: anObject 
	content := anObject trimBoth.
	self addToList: content.
	self listSelectionIndex: (self list indexOf: content).
	self updateList! !

!SearchableList commentStamp: '<historical>'!
SearchableList 
	new items: #( aaa abc axz bbb bfbg bof c);
	openWithSpec
	
should it be a subclass of LIstModel?
Because now I will have to delegate a lot? and I cannot plug a IconList

How do I make textModel react to every keystroke without an accept!
!SearchableList methodsFor: 'accessing' stamp: 'NicolaiHess 2/15/2015 22:29'!
items: aCollection
	listModel items: aCollection! !

!SearchableList methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 9/25/2013 18:24'!
initializeWidgets

	self instantiateModels: #(	
		listModel 		#ListModel
		searchModel 	TextInputFieldModel ).
	searchModel 
		autoAccept: true;
		ghostText: 'filter'.! !

!SearchableList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/12/2012 18:46'!
searchModel
	^ searchModel! !

!SearchableList methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/12/2012 18:46'!
listModel
	^ listModel! !

!SearchableList methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 6/12/2012 18:06'!
initializePresenter

	searchModel whenTextChanged: [:newText || text |
		text :=  searchModel getText asLowercase.
		text isEmpty
			ifTrue: [ listModel resetFilteringBlock ]
			ifFalse: [
				listModel filteringBlock: [:col | col select: [:e | e asLowercase beginsWith: searchModel getText asLowercase ]]]]! !

!SearchableList class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/7/2013 11:48'!
defaultSpec

	^ SpecLayout composed
		newRow: #searchModel height: self toolbarHeight;
		add: #listModel top: self toolbarHeight;
		yourself! !

!SearchableList class methodsFor: 'example' stamp: 'NicolaiHess 2/15/2015 22:30'!
example
	"self example"
	| instance |
	
	instance := self new.
	instance items: #( aaa abc axz bbb bfbg bof c).
	instance openWithSpec.
! !

!SearchableTree commentStamp: '<historical>'!
I am a tree plus an input field to be able to filter the tree elements!
!SearchableTree methodsFor: 'api-compatibility' stamp: 'BenjaminVanRyseghem 4/18/2013 14:40'!
childrenBlock
	
	^ tree childrenBlock! !

!SearchableTree methodsFor: 'api' stamp: 'BenjaminVanRyseghem 5/21/2013 15:34'!
resetSelection

	tree resetSelection! !

!SearchableTree methodsFor: 'api' stamp: 'BenjaminVanRyseghem 12/6/2013 18:42'!
highlightedItem: aTreeNodeModel
	
	tree highlightedItem: aTreeNodeModel! !

!SearchableTree methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/7/2013 14:31'!
button

	^ button! !

!SearchableTree methodsFor: 'api-events' stamp: 'BenjaminVanRyseghem 4/18/2013 14:40'!
whenMenuChanged: aBlock
	
	tree whenMenuChanged: aBlock! !

!SearchableTree methodsFor: 'api' stamp: 'BenjaminVanRyseghem 4/18/2013 14:37'!
columns: aCollection
	
	tree columns: aCollection! !

!SearchableTree methodsFor: 'api-compatibility' stamp: 'BenjaminVanRyseghem 4/18/2013 14:40'!
childrenBlock: aBlock
	
	tree childrenBlock: aBlock! !

!SearchableTree methodsFor: 'api' stamp: 'BenjaminVanRyseghem 4/18/2013 14:38'!
preferedPaneColor: aColor

	tree preferedPaneColor: aColor! !

!SearchableTree methodsFor: 'api' stamp: 'BenjaminVanRyseghem 4/18/2013 14:38'!
rootNodeHolder

	^ tree rootNodeHolder! !

!SearchableTree methodsFor: 'api' stamp: 'BenjaminVanRyseghem 4/18/2013 14:39'!
selectedItem: anItem
	
	tree selectedItem: anItem! !

!SearchableTree methodsFor: 'initialization' stamp: 'DucasseStephane 9/10/2014 09:59'!
initialize

	super initialize.

	roots := OrderedCollection new asValueHolder! !

!SearchableTree methodsFor: 'api' stamp: 'BenjaminVanRyseghem 4/18/2013 14:38'!
keyStrokeAction: aBlock

	tree keyStrokeAction: aBlock! !

!SearchableTree methodsFor: 'api' stamp: 'BenjaminVanRyseghem 4/18/2013 14:39'!
updateTree
	
	tree updateTree! !

!SearchableTree methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 4/20/2013 03:59'!
initializePresenter

	inputField whenTextChanged: [ :text | self updateRootFor: text ].
		
	tree whenTreeUpdated: [ inputField text: '' ].! !

!SearchableTree methodsFor: 'api' stamp: 'BenjaminVanRyseghem 4/18/2013 14:38'!
menu: aBlock
	
	tree menu: aBlock! !

!SearchableTree methodsFor: 'api' stamp: 'BenjaminVanRyseghem 4/18/2013 14:37'!
autoMultiSelection: aBoolean

	tree autoMultiSelection: aBoolean! !

!SearchableTree methodsFor: 'api' stamp: 'BenjaminVanRyseghem 5/21/2013 16:34'!
iconBlock: aBlock
	
	tree iconBlock: aBlock! !

!SearchableTree methodsFor: 'api-events' stamp: 'BenjaminVanRyseghem 4/18/2013 17:41'!
whenRootsChanged: aBlock

	roots whenChangedDo: aBlock! !

!SearchableTree methodsFor: 'api' stamp: 'BenjaminVanRyseghem 4/18/2013 14:39'!
selectedItem
	
	^ tree selectedItem! !

!SearchableTree methodsFor: 'list api-events' stamp: 'BenjaminVanRyseghem 11/30/2013 20:53'!
whenSelectedItemChanged: aBlock

	tree whenSelectedItemChanged: aBlock! !

!SearchableTree methodsFor: 'api' stamp: 'BenjaminVanRyseghem 6/18/2013 16:17'!
secondSelection: anItem
	
	tree secondSelection: anItem! !

!SearchableTree methodsFor: 'api' stamp: 'BenjaminVanRyseghem 4/18/2013 14:39'!
rowInset: anInteger

	tree rowInset: anInteger! !

!SearchableTree methodsFor: 'api' stamp: 'BenjaminVanRyseghem 5/21/2013 14:21'!
autoAccept: aBoolean

	inputField autoAccept: aBoolean! !

!SearchableTree methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 11/21/2013 11:07'!
updateRootFor: aText
	| aFilter |
	
	aFilter := TokenTreeFilter token: aText.
	tree filterWith: aFilter! !

!SearchableTree methodsFor: 'api' stamp: 'BenjaminVanRyseghem 4/18/2013 14:38'!
menu
	
	^ tree menu! !

!SearchableTree methodsFor: 'api-events-compatibility' stamp: 'BenjaminVanRyseghem 4/18/2013 14:40'!
whenChildrenBlockChanged: aBlock
	
	tree whenChildrenBlockChanged: aBlock! !

!SearchableTree methodsFor: 'api' stamp: 'BenjaminVanRyseghem 4/18/2013 14:38'!
isCheckList: aBoolean

	tree isCheckList: aBoolean! !

!SearchableTree methodsFor: 'api' stamp: 'BenjaminVanRyseghem 4/18/2013 14:37'!
evenRowColor: aColor

	tree evenRowColor: aColor! !

!SearchableTree methodsFor: 'api' stamp: 'BenjaminVanRyseghem 4/18/2013 14:37'!
columnInset: anInteger

	tree columnInset: anInteger! !

!SearchableTree methodsFor: 'api-compatibility' stamp: 'BenjaminVanRyseghem 4/18/2013 14:40'!
displayBlock: aBlock
	
	tree displayBlock: aBlock! !

!SearchableTree methodsFor: 'initialization' stamp: 'TorstenBergmann 3/4/2015 21:59'!
initializeWidgets

	self instantiateModels: #(
		tree 		TreeModel
		inputField	TextInputFieldModel
		label 		LabelModel
		button 		ButtonModel).
			
	tree rootNodeHolder: [ :item | 
		(tree defaultNodeFor: item)
			matchTokenFilterBlock: [ :aFilter |
				aFilter token
					ifEmpty: [ true ]
					ifNotEmpty: [ item asString asLowercase includesSubstring: aFilter token asLowercase ] ];
			yourself ].
			
	button 
		label: '';
		icon: (Smalltalk ui icons iconNamed: #smallFindIcon);
		state: false;
		action: [ inputField accept ].
			
	label 
		label: 'Search:';
		color:Color black.
	
	inputField
		ghostText: 'Search';
		entryCompletion: nil;
		acceptOnCR: true.
		
	self focusOrder
		add: tree;
		add: inputField! !

!SearchableTree methodsFor: 'api' stamp: 'BenjaminVanRyseghem 4/18/2013 14:38'!
resizerWidth: anInteger

	tree resizerWidth: anInteger! !

!SearchableTree methodsFor: 'api' stamp: 'BenjaminVanRyseghem 4/18/2013 14:38'!
roots
	
	^ tree roots! !

!SearchableTree methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/11/2013 08:37'!
roots: aCollection

	roots value: aCollection asOrderedCollection.	
	tree roots: aCollection asOrderedCollection! !

!SearchableTree methodsFor: 'api' stamp: 'BenjaminVanRyseghem 4/18/2013 14:39'!
selectedItems
	
	^ tree selectedItems! !

!SearchableTree methodsFor: 'api' stamp: 'BenjaminVanRyseghem 4/22/2013 21:16'!
columns
	
	^ tree columns! !

!SearchableTree methodsFor: 'api' stamp: 'BenjaminVanRyseghem 4/18/2013 14:39'!
selectedItems: aCollection
	
	tree selectedItems: aCollection! !

!SearchableTree methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/18/2013 14:43'!
tree
	^ tree! !

!SearchableTree methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/18/2013 14:43'!
inputField
	^ inputField! !

!SearchableTree methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/20/2013 12:24'!
label
	^ label! !

!SearchableTree methodsFor: 'api-events-compatibility' stamp: 'BenjaminVanRyseghem 4/18/2013 14:40'!
whenDisplayBlockChanged: aBlock
	
	tree whenDisplayBlockChanged: aBlock! !

!SearchableTree methodsFor: 'api-compatibility' stamp: 'BenjaminVanRyseghem 4/18/2013 14:40'!
displayBlock

	^ tree displayBlock! !

!SearchableTree methodsFor: 'api' stamp: 'BenjaminVanRyseghem 4/18/2013 14:37'!
doubleClick: aBlock

	tree doubleClick: aBlock! !

!SearchableTree methodsFor: 'api' stamp: 'BenjaminVanRyseghem 4/18/2013 14:38'!
multiSelection: aBoolean

	tree multiSelection: aBoolean! !

!SearchableTree methodsFor: 'api' stamp: 'BenjaminVanRyseghem 4/18/2013 14:38'!
rootNodeHolder: aBlock

	tree rootNodeHolder: aBlock! !

!SearchableTree methodsFor: 'api-events' stamp: 'BenjaminVanRyseghem 4/18/2013 14:40'!
whenSelectedItemsChanged: aBlock
	
	tree whenSelectedItemsChanged: aBlock! !

!SearchableTree class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 6/19/2013 15:24'!
defaultSpec
	<spec: #default>
	
	^ SpecLayout composed
		newRow: [:r |
			r
			"add: #label width: 50;"
			add: #inputField;
			add: #button width: 25 ] height: 25;
		newRow: #tree top: 25;
		yourself! !

!SearchableTree class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 6/19/2013 15:26'!
searchAtBottom
	<spec: #default>
	
	^ SpecLayout composed
		newColumn: [:c |
			c 
				add: #tree;
				newRow: [:r |
					r
					"add: #label width: 50;"
					add: #inputField;
					add: #button width: 25 ] height: 25 ];
		yourself! !

!SelectBrowser commentStamp: '<historical>'!
A simple selection browser.!
!SelectBrowser methodsFor: 'accessing' stamp: ''!
selectedModel
	^ selectedModel! !

!SelectBrowser methodsFor: 'api' stamp: ''!
nextAction
	self subclassResponsibility
! !

!SelectBrowser methodsFor: 'initialization' stamp: ''!
setFocusOrder

	self focusOrder
		add: addButtonModel;
		add: addAllButtonModel;
		add: removeButtonModel;
		add: removeAllButtonModel.
		! !

!SelectBrowser methodsFor: 'initialization' stamp: 'SimonAllier 1/28/2013 10:36'!
initializeWidgets

	self instantiateModels: #(
		addButtonModel ButtonModel
		addAllButtonModel ButtonModel 
		removeButtonModel ButtonModel
		removeAllButtonModel ButtonModel
		nextButtonModel ButtonModel ).
		
	self setFocusOrder.

	self setAddButtonModel. 
	self setAddAllButtonModel. 
	self setRemoveButtonModel. 
	self setRemoveAllButtonModel. 
	self setNextButtonModel. ! !

!SelectBrowser methodsFor: 'accessing' stamp: 'SimonAllier 3/22/2013 15:16'!
nextButtonModel
	^ nextButtonModel! !

!SelectBrowser methodsFor: 'initialization' stamp: 'Sd 11/30/2012 17:37'!
setRemoveAllButtonModel
	
	removeAllButtonModel
		state: false;
		label: 'Remove All';
		action: [ self  removeAllItems ].
	
! !

!SelectBrowser methodsFor: 'initialization' stamp: ''!
setAddAllButtonModel
	
	addAllButtonModel
		state: false;
		label: 'Add All';
		action: [ self  addAllItems].
	
! !

!SelectBrowser methodsFor: 'initialization' stamp: ''!
setRemoveButtonModel
	
	removeButtonModel
		state: false;
		label: 'Remove';
		action: [ self removeItems ].
	
! !

!SelectBrowser methodsFor: 'accessing' stamp: ''!
toSelectModel
	^ toSelectModel! !

!SelectBrowser methodsFor: 'initialization' stamp: 'Sd 11/30/2012 17:37'!
setNextButtonModel
	
	nextButtonModel
		state: false;
		label: 'Next';
		action: [ self  nextAction ].
	
! !

!SelectBrowser methodsFor: 'accessing' stamp: ''!
addButtonModel
	^ addButtonModel! !

!SelectBrowser methodsFor: 'accessing' stamp: ''!
removeAllButtonModel
	^ removeAllButtonModel! !

!SelectBrowser methodsFor: 'initialization' stamp: 'Sd 11/30/2012 17:37'!
setAddButtonModel
	
	addButtonModel
		state: false;
		label: 'Add';
		action: [ self addItems ].
	
! !

!SelectBrowser methodsFor: 'accessing' stamp: 'StephaneDucasse 3/21/2013 09:27'!
items: aCollection
	"Set the elements to be analysed"
	
	toSelectModel items: (self sort: aCollection)
! !

!SelectBrowser methodsFor: 'accessing' stamp: ''!
removeButtonModel
	^ removeButtonModel! !

!SelectBrowser methodsFor: 'accessing' stamp: ''!
addAllButtonModel
	^ addAllButtonModel! !

!SelectBrowser methodsFor: 'api' stamp: 'StephaneDucasse 3/21/2013 09:26'!
initialExtent
	^   450@360! !

!SelectBrowser class methodsFor: 'specs' stamp: 'SimonAllier 9/28/2012 13:56'!
defaultSpec

		<spec>
	
	^ SpecLayout composed
		newColumn: [:c |
			c
			newRow: [:r |
				r 
					add: #toSelectModel;
					addSplitter;
					add:  #selectedModel];
			newRow: [:r |
				r 
					add:#addButtonModel;
					add:#addAllButtonModel;
					add:#removeButtonModel;
					add:#removeAllButtonModel;
					add: #nextButtonModel ] height: 25]	! !

!SelectPackageBrowser commentStamp: '<historical>'!
To select packages.!
!SelectPackageBrowser methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 9/25/2013 18:24'!
initialize

	| wrappingBlock |
	super initialize.	
	toSelectModel := self instantiate: ListModel.
	selectedModel := self instantiate: ListModel.
	selectedModel beMultipleSelection.
	toSelectModel beMultipleSelection.
	testPackage := OrderedCollection new.
	wrappingBlock := [ :package | package packageName ].
	toSelectModel displayBlock: wrappingBlock.
	selectedModel displayBlock: wrappingBlock.! !

!SelectPackageBrowser methodsFor: 'private' stamp: 'StephaneDucasse 11/21/2012 18:17'!
removeAllItems

	| tmp |
	tmp := self sort: (toSelectModel listItems asOrderedCollection addAll: (selectedModel listItems);yourself ).
	toSelectModel   items: tmp.
	selectedModel items: {}.
	toSelectModel updateList.
	selectedModel updateList.  	  ! !

!SelectPackageBrowser methodsFor: 'accessing' stamp: 'SimonAllier 1/28/2013 10:49'!
addTestCaseClasses
	^ addTestCaseClassesModel
! !

!SelectPackageBrowser methodsFor: 'initialization' stamp: 'SimonAllier 1/28/2013 11:11'!
removeTestPackageModel

	^ removeTestPackageModel
	
	! !

!SelectPackageBrowser methodsFor: 'private' stamp: 'StephaneDucasse 3/21/2013 09:27'!
addAllItems

	| tmp |
	tmp := self sort: (selectedModel listItems asOrderedCollection addAll: (toSelectModel listItems); yourself ).
	selectedModel  items: tmp.
	toSelectModel  items: {}.
	toSelectModel updateList.
	selectedModel updateList.  	  ! !

!SelectPackageBrowser methodsFor: 'api' stamp: 'CamilleTeruel 11/14/2013 14:43'!
nextAction

	| env packages |	
		
	packages := selectedModel listItems.
	env := RBPackageEnvironment new packages: packages.
	SelectRuleBrowser openWithEnvironment: env removeTestCase: self addTestCaseClasses state.
	self delete
	
		
! !

!SelectPackageBrowser methodsFor: 'private' stamp: 'SimonAllier 5/21/2012 16:09'!
sort: aCollection
	
	^ aCollection asOrderedCollection sort: [:e1 :e2 | (e1 asString) < (e2 asString)].! !

!SelectPackageBrowser methodsFor: 'initialization' stamp: 'StephaneDucasse 3/21/2013 09:29'!
initializeWidgets

	super initializeWidgets.	
	self instantiateModels: #(
		addTestCaseClassesModel CheckBoxModel
		removeTestPackageModel ButtonModel).
	self setRemoveTestPackageModel.		
	addTestCaseClassesModel label: 'remove all TestCase Classes'.
	addTestCaseClassesModel state: true.! !

!SelectPackageBrowser methodsFor: 'private' stamp: 'StephaneDucasse 3/21/2013 09:28'!
addItems
	
	toSelectModel selectedItems
		ifNotNil: [ :items |  
			selectedModel items: (self sort: (selectedModel listItems asOrderedCollection addAll: items; yourself) ).
			toSelectModel items: (self sort: (toSelectModel listItems asOrderedCollection removeAll: items; yourself) ) ].
		toSelectModel updateList.
		selectedModel updateList.  	  ! !

!SelectPackageBrowser methodsFor: 'private' stamp: 'StephaneDucasse 11/21/2012 18:18'!
removeItems
	
	selectedModel selectedItems
		ifNotNil: [:items | 
			toSelectModel items: ( self sort: (toSelectModel listItems asOrderedCollection addAll: items; yourself)).
			selectedModel items: (self sort: (selectedModel listItems asOrderedCollection removeAll: items; yourself)).
			].
		toSelectModel updateList.
		selectedModel updateList.  	  ! !

!SelectPackageBrowser methodsFor: 'initialization' stamp: 'SimonAllier 1/28/2013 10:52'!
setRemoveTestPackageModel

	removeTestPackageModel
		state: false;
		label: 'Remove All Packages Tests';
		action: [ self  removeTestPackage ].
	! !

!SelectPackageBrowser methodsFor: 'initialization' stamp: 'SimomAllier 3/25/2013 13:47'!
removeTestPackage

	| matchText  |
	testPackage isEmpty
		ifTrue: [
			removeTestPackageModel label: 'Add All Packages Tests'.
			matchText := '*Test*'.
			testPackage :=MCWorkingCopy allManagers select: [ :package | matchText match:  package packageName ].
			selectedModel items: (self sort:(selectedModel listItems \ testPackage)).
			toSelectModel items: (self sort:(toSelectModel  listItems \ testPackage)) ]
		ifFalse: [
			removeTestPackageModel label: 'Remove All Packages Tests'.		
			toSelectModel items: (self sort: (toSelectModel listItems asOrderedCollection addAll: testPackage; yourself)).
			testPackage := OrderedCollection new ]. 
	toSelectModel updateList.
	selectedModel updateList.  	! !

!SelectPackageBrowser class methodsFor: 'specs' stamp: 'SimonAllier 1/28/2013 11:12'!
defaultSpec

		<spec>
	
	^ SpecLayout composed
		newColumn: [:c |
			c
			newRow: [:r |
				r 
					add: #toSelectModel; 
					addSplitter;
					add:  #selectedModel];
			newRow: [:r |
				r
					add: # removeTestPackageModel; 
					add: #addTestCaseClasses]  height: 25;
			newRow: [:r |
				r 
					add:#addButtonModel;
					add:#addAllButtonModel;
					add:#removeButtonModel;
					add:#removeAllButtonModel;
					add: #nextButtonModel ] height: 25]	! !

!SelectPackageBrowser class methodsFor: 'specs' stamp: ''!
title
	^ 'Select packages'! !

!SelectPackageBrowser class methodsFor: 'instance creation' stamp: 'CamilleTeruel 11/14/2013 14:45'!
open
	
	self new items: RPackageOrganizer default packages;
		openWithSpec ! !

!SelectRuleBrowser commentStamp: '<historical>'!
To select rules.!
!SelectRuleBrowser methodsFor: 'accessing' stamp: 'SimonAllier 1/29/2013 13:41'!
removeTestCase: aBoolean
	removeTestCase := aBoolean! !

!SelectRuleBrowser methodsFor: 'initialization' stamp: 'StephaneDucasse 2/8/2015 21:22'!
initialize

	| wrappingBlock childrenBlockS childrenBlockTS |
	super initialize.
	toSelectModel := self instantiate: TreeModel.
	selectedModel := self instantiate: TreeModel.
	selectRule := Set new.
	childrenBlockS := [:rule | 
		rule isComposite 
			ifTrue: [rule rules select: [ :r |
					(selectRule anySatisfy:  [ :sr | sr = r ]) or: [ r isComposite ] ]]
			 ifFalse: [{}]]. 
	childrenBlockTS := [ :rule | 
		rule isComposite 
			ifTrue: [rule rules select: [ :r |
					(selectRule anySatisfy: [ :sr | sr = r ]) not or: [ r isComposite ]]]
			 ifFalse: [{}] ]. 

	toSelectModel childrenBlock: childrenBlockTS.
	selectedModel childrenBlock: childrenBlockS.
	wrappingBlock := [ :rule | rule name ].	
	toSelectModel displayBlock: wrappingBlock.
	selectedModel displayBlock: wrappingBlock.! !

!SelectRuleBrowser methodsFor: 'api' stamp: 'MarcusDenker 7/24/2013 15:08'!
removeAllItems
	
	selectedModel roots do: [ :item |  
		selectRule removeAllFoundIn: item leaves].
	self updateTree 	  ! !

!SelectRuleBrowser methodsFor: 'api' stamp: 'StephaneDucasse 11/21/2012 18:24'!
updateTree

	toSelectModel updateTree.
	selectedModel updateTree.  	  ! !

!SelectRuleBrowser methodsFor: 'api' stamp: 'MarcusDenker 7/24/2013 15:08'!
addAllItems
	
	toSelectModel roots do: [ :item | selectRule addAll: item leaves].
	self updateTree.  	  ! !

!SelectRuleBrowser methodsFor: 'accessing' stamp: ''!
environment: aEnv
	environment := aEnv! !

!SelectRuleBrowser methodsFor: 'api' stamp: 'CamilleTeruel 11/12/2013 19:35'!
nextAction

	| rules rbRule |
	self delete.
	rules := selectedModel roots.
	rules do: [ :each | 
				each leaves
					do: [ :leave | 
						(selectRule anySatisfy: [ :r | r = leave ])
							ifFalse: [ each removeRule: leave ] ] ].
	rules := rules reject: [ :each | each rules isEmpty ].
	rbRule := RBCompositeLintRule new
				name: self defaultRulesRootName;
				rules: rules;
				yourself.
	
	CriticWorkingConfiguration current
		rule: rbRule;
		environment: environment;
		removeTestCase: removeTestCase.
	CriticBrowser openOnWorkingConfiguration: CriticWorkingConfiguration current! !

!SelectRuleBrowser methodsFor: 'accessing' stamp: 'SimonAllier 5/22/2012 10:45'!
items: aCollection
	
	toSelectModel roots: aCollection.
	selectedModel roots: aCollection
! !

!SelectRuleBrowser methodsFor: 'api' stamp: 'MarcusDenker 12/2/2013 18:26'!
addItems
	
	toSelectModel selectedItem
		ifNotNil: [ :item | selectRule add: item content  ].
	self updateTree   	  ! !

!SelectRuleBrowser methodsFor: 'api' stamp: 'StephaneDucasse 2/8/2015 21:22'!
removeItems
	
	selectedModel selectedItem
		ifNotNil: [ :item |  
			selectRule removeAllFoundIn: item content leaves ].
	self updateTree  	  ! !

!SelectRuleBrowser methodsFor: 'private' stamp: 'StephaneDucasse 3/21/2013 09:31'!
defaultRulesRootName
	^ 'Selected Rules'! !

!SelectRuleBrowser class methodsFor: 'specs' stamp: ''!
title
	^ 'Select rules'! !

!SelectRuleBrowser class methodsFor: 'instance creation' stamp: 'SimonAllier 1/29/2013 13:42'!
openWithEnvironment: aEnv removeTestCase: aBooelan
	
	self new items: (RBCompositeLintRule allGoodRules rules);
		environment: aEnv;
		removeTestCase: aBooelan;
		openWithSpec;
		updateTree . ! !

!SelectVisitor commentStamp: '<historical>'!
I am a visitor that selects objects from the nodes I visit. I take a block similar to those passed to Collection>>select:. I evaluate the block with DirectoryEntries for the nodes I visit.

I can use any guide, and the objects in the array I produce will reflect the order imposed by the guide.!
!SelectVisitor methodsFor: 'visiting' stamp: 'CamilloBruni 8/9/2011 15:48'!
visitReference: anEntry
	(block value: anEntry) 
		ifTrue: [ out nextPut: anEntry ]! !

!SelectVisitor class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/9/2011 15:50'!
postorder: aReference select: aBlock
	^ (self select: aBlock) postorder: aReference! !

!SelectVisitor class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/9/2011 15:50'!
preorder: aReference
	^ self preorder: aReference select: [:entry | true]! !

!SelectVisitor class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/9/2011 15:50'!
select: aBlock
	^ self basicNew initializeWithBlock: aBlock! !

!SelectVisitor class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/9/2011 15:50'!
breadthFirst: aReference select: aBlock
	^ (self select: aBlock) breadthFirst: aReference! !

!SelectVisitor class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/9/2011 15:50'!
postorder: aReference
	^ self postorder: aReference select: [:entry | true]! !

!SelectVisitor class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/9/2011 15:50'!
preorder: aReference select: aBlock
	^ (self select: aBlock) preorder: aReference! !

!SelectVisitor class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/9/2011 15:50'!
breadthFirst: aReference
	^ self breadthFirst: aReference select: [:entry | true]! !

!SelectVisitorTest commentStamp: 'TorstenBergmann 1/31/2014 11:41'!
SUnit tests for class SelectVistor
!
!SelectVisitorTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:40'!
testPostorder
	| entries |
	entries := SelectVisitor postorder: self root.
	self 
		assertEntries: entries
		are: #(
				'/alpha/beta/delta'
				'/alpha/beta/gamma'
				'/alpha/beta'
				'/alpha/epsilon/zeta'
				'/alpha/epsilon'
				'/alpha'
			)! !

!SelectVisitorTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:40'!
testPostorderSelect
	| entries |
	entries := SelectVisitor postorder: self root select: [ :node| node name endsWith: #a].
	self 
		assertEntries: entries
		are: #(
				'/alpha/beta/delta'
				'/alpha/beta/gamma'
				'/alpha/beta'
				'/alpha/epsilon/zeta'
				'/alpha'
			)! !

!SelectVisitorTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:40'!
testPreorderSelect
	| entries |
	entries := SelectVisitor preorder: self root select: [ :node| node name endsWith: #a].
	self 
		assertEntries: entries
		are: #(
				'/alpha'
				'/alpha/beta'
				'/alpha/beta/delta'
				'/alpha/beta/gamma'
				'/alpha/epsilon/zeta'
			)! !

!SelectVisitorTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:40'!
testBreadthFirstSelect
	| entries |
	entries := SelectVisitor breadthFirst: self root select: [ :node| node name endsWith: #a].
	self 
		assertEntries: entries
		are: #(
				'/alpha'
				'/alpha/beta'
				'/alpha/beta/delta'
				'/alpha/beta/gamma'
				'/alpha/epsilon/zeta'
			)! !

!SelectVisitorTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:40'!
testPreorder
	| entries |
	entries := SelectVisitor preorder: self root.
	self 
		assertEntries: entries
		are: #(
				'/alpha'
				'/alpha/beta'
				'/alpha/beta/delta'
				'/alpha/beta/gamma'
				'/alpha/epsilon'
				'/alpha/epsilon/zeta'
			)! !

!SelectVisitorTest methodsFor: 'tests' stamp: 'EstebanLorenzano 4/2/2012 11:40'!
testBreadthFirst
	| entries |
	entries := SelectVisitor breadthFirst: self root.
	self 
		assertEntries: entries
		are: #(
				'/alpha'
				'/alpha/beta'
				'/alpha/epsilon'
				'/alpha/beta/delta'
				'/alpha/beta/gamma'
				'/alpha/epsilon/zeta'
			)! !

!SelectionMorph commentStamp: '<historical>'!
A selectionMorph supports the selection of multiple objects in a morphic world or pasteUp. Using command+shift you get a squared lazzo and you can grab morphs. After you can grab the selection as a morph.

Structure:
	selectedItems	an OrderedCollection of Morphs
					These are the morphs that have been selected
	slippage		a Point
					Keeps track of actual movement between the 
					steps of gridded movement
	dupLoc		a Point
					Notes the position when first duplicate request occurs from halo
	dupDelta	a Point
					Holds the final delta of the first duplicate plus subsequent moves.
!
!SelectionMorph methodsFor: 'private' stamp: 'dgd 2/21/2003 23:18'!
setOtherSelection: otherOrNil 
	otherSelection := otherOrNil.
	otherOrNil isNil 
		ifTrue: [super borderColor: Color blue]
		ifFalse: 
			[itemsAlreadySelected := otherSelection selectedItems.
			super borderColor: Color green]! !

!SelectionMorph methodsFor: 'initialization' stamp: 'AlainPlantec 12/19/2009 14:14'!
defaultColor
	"answer the default color/fill style for the receiver"
	^ (self theme settings menuSelectionColor) alpha: 0.08
! !

!SelectionMorph methodsFor: 'private' stamp: 'di 8/31/2000 21:45'!
setSelectedItems: items

	selectedItems := items.
	self changed! !

!SelectionMorph methodsFor: 'geometry' stamp: 'jcg 2/14/2001 08:58'!
bounds: newBounds
	"Make sure position: gets called before extent:; Andreas' optimization for growing/shrinking in ChangeSet 3119 screwed up selection of morphs from underlying pasteup."

	selectedItems := OrderedCollection new.  "Avoid repostioning items during super position:"
	self position: newBounds topLeft; extent: newBounds extent
! !

!SelectionMorph methodsFor: 'halo commands' stamp: 'tb 8/10/2003 14:47'!
organizeIntoColumn
	"Place my objects in a column-enforcing container"

	((AlignmentMorph inAColumn: (selectedItems asSortedCollection: [:x :y | x top < y top])) setNameTo: 'Column'; color: Color orange muchLighter; enableDragNDrop: true; yourself) openInHand
! !

!SelectionMorph methodsFor: 'undo' stamp: 'di 8/31/2000 00:24'!
borderColorForItems: colorCollection

	(selectedItems select: [:m | m isKindOf: BorderedMorph])
		with: colorCollection
		do: [:m :c | m borderColor: c]! !

!SelectionMorph methodsFor: 'halo commands' stamp: 'tb 8/10/2003 14:48'!
organizeIntoRow
	"Place my objects in a row-enforcing container"

	((AlignmentMorph inARow: (selectedItems asSortedCollection: [:x :y | x left < y left])) setNameTo: 'Row'; color: Color orange muchLighter; enableDragNDrop: true; yourself) openInHand
! !

!SelectionMorph methodsFor: 'accessing' stamp: 'dgd 9/11/2004 21:57'!
wantsToBeTopmost
	"Answer if the receiver want to be one of the topmost objects in 
	its owner"
	^ true! !

!SelectionMorph methodsFor: 'halo commands' stamp: 'dgd 10/26/2004 14:53'!
addOrRemoveItems: handOrEvent 
	"Make a new selection extending the current one."

	| hand |
	hand := (handOrEvent isMorphicEvent) 
				ifFalse: [handOrEvent]
				ifTrue: [handOrEvent hand].
	hand 
		addMorphBack: ((self class 
				newBounds: (hand lastEvent cursorPoint extent: 16 @ 16)) 
					setOtherSelection: self).
! !

!SelectionMorph methodsFor: 'initialization' stamp: 'StephaneDucasse 8/15/2013 18:29'!
extendByHand: aHand
	"Assumes selection has just been created and added to some pasteUp or world"
	| startPoint handle |

	startPoint := self position.

	handle := NewHandleMorph new followHand: aHand
		forEachPointDo: [:newPoint |
					| localPt |
					localPt := (self transformFrom: self world) globalPointToLocal: newPoint.
					self bounds: (startPoint rectangle: localPt)
				]
		lastPointDo: [:newPoint |
					selectedItems isEmpty
						ifTrue: [self delete]
						ifFalse: [
							selectedItems size = 1
								ifTrue:[self delete.  selectedItems anyOne addHalo]
								ifFalse:[self doneExtending]
						]
				].

	aHand attachMorph: handle.
	handle startStepping.! !

!SelectionMorph methodsFor: 'halos and balloon help' stamp: 'AlainPlantec 12/12/2009 09:53'!
addHandlesTo: aHaloMorph box: box
	| onlyThese |
	aHaloMorph haloBox: box.
	onlyThese := #(addDismissHandle: addMenuHandle: addGrabHandle: addDragHandle: addDupHandle: addHelpHandle: addGrowHandle: addFontSizeHandle: addFontStyleHandle: addFontEmphHandle: addRecolorHandle:).
	HaloMorph currentHaloSpecifications do:
		[:aSpec | (onlyThese includes: aSpec addHandleSelector) ifTrue:
				[aHaloMorph perform: aSpec addHandleSelector with: aSpec]].
	aHaloMorph innerTarget addOptionalHandlesTo: aHaloMorph box: box! !

!SelectionMorph methodsFor: 'halo commands' stamp: 'dgd 9/20/2004 13:41'!
alignLeftEdges
	"Make the left coordinate of all my elements be the same"

	| minLeft |
	minLeft := (selectedItems collect: [:itm | itm left]) min.
	selectedItems do:
		[:itm | itm left: minLeft].

	self changed
! !

!SelectionMorph methodsFor: 'viewer' stamp: 'dgd 8/29/2004 12:34'!
externalName
	^ 'Selected {1} objects' translated format:{self selectedItems size}! !

!SelectionMorph methodsFor: 'undo' stamp: 'di 8/31/2000 00:26'!
borderWidthForItems: widthCollection

	(selectedItems select: [:m | m isKindOf: BorderedMorph])
		with: widthCollection
		do: [:m :c | m borderWidth: c]! !

!SelectionMorph methodsFor: 'undo' stamp: 'jm 2/25/2003 16:27'!
undoMove: cmd redo: redo owner: oldOwners bounds: oldBoundses predecessor: oldPredecessors 
	"Handle undo and redo of move commands in morphic"

	| item |
	redo 
		ifFalse: 
			["undo sets up the redo state first"

			cmd 
				redoTarget: self
				selector: #undoMove:redo:owner:bounds:predecessor:
				arguments: { 
						cmd.
						true.
						selectedItems collect: [:m | m owner].
						selectedItems collect: [:m | m bounds].
						selectedItems collect: [:m | m owner morphPreceding: m]}].
	1 to: selectedItems size do: 
				[:i | 
				item := selectedItems at: i.
				(oldOwners at: i) ifNotNil: 
						[(oldPredecessors at: i) ifNil: [(oldOwners at: i) addMorphFront: item]
							ifNotNil: [(oldOwners at: i) addMorph: item after: (oldPredecessors at: i)]].
				item bounds: (oldBoundses at: i).
				item isSystemWindow ifTrue: [item activate]]! !

!SelectionMorph methodsFor: 'accessing' stamp: 'di 9/19/2000 18:25'!
borderWidth: aWidth

	| bordered |
	bordered := selectedItems select: [:m | m isKindOf: BorderedMorph].
	undoProperties ifNil: [undoProperties := bordered collect: [:m | m borderWidth]].
	bordered do: [:m | m borderWidth: aWidth]! !

!SelectionMorph methodsFor: 'halo commands' stamp: 'dgd 9/20/2004 13:41'!
alignRightEdges
	"Make the right coordinate of all my elements be the same"

	| maxRight |
	maxRight := (selectedItems collect: [:itm | itm right]) max.
	selectedItems do:
		[:itm | itm right: maxRight].

	self changed
! !

!SelectionMorph methodsFor: 'initialization' stamp: 'MarcusDenker 12/12/2009 00:02'!
initialize
	"initialize the state of the receiver"
	super initialize.
	
	selectedItems := OrderedCollection new.
	itemsAlreadySelected := OrderedCollection new.
	slippage := 0@0! !

!SelectionMorph methodsFor: 'halos and balloon help' stamp: 'di 8/31/2000 22:59'!
addOptionalHandlesTo: aHalo box: box
	aHalo addHandleAt: box leftCenter color: Color blue icon: nil
		on: #mouseUp send: #addOrRemoveItems: to: self.! !

!SelectionMorph methodsFor: 'halo commands' stamp: 'dgd 9/20/2004 13:41'!
alignCentersVertically
	"Make every morph in the selection have the same horizontal center as the topmost item."

	| minTop topMost |
	selectedItems size > 1 ifFalse: [^ self].
	minTop := (selectedItems collect: [:itm | itm top]) min.
	topMost := selectedItems detect: [:m | m top = minTop].
	selectedItems do:
		[:itm | itm center: (topMost center x @ itm center y)].

	self changed
! !

!SelectionMorph methodsFor: 'visual properties' stamp: 'di 9/19/2000 21:53'!
fillStyle: aColor
	undoProperties ifNil: [undoProperties := selectedItems collect: [:m | m fillStyle]].
	selectedItems do: [:m | m fillStyle: aColor]! !

!SelectionMorph methodsFor: 'halo commands' stamp: 'dgd 9/20/2004 13:50'!
alignTopEdges
	"Make the top coordinate of all my elements be the same"

	| minTop |
	minTop := (selectedItems collect: [:itm | itm top]) min.
	selectedItems do:
		[:itm | itm top: minTop].

	self changed
! !

!SelectionMorph methodsFor: 'halo commands' stamp: 'HenrikSperreJohansen 6/11/2010 00:34'!
doDup: evt fromHalo: halo handle: dupHandle

	selectedItems := selectedItems collect: #duplicate.
	selectedItems do: [:m | self owner addMorph: m].
	dupDelta isNil
		ifTrue: ["First duplicate operation -- note starting location"
				dupLoc := self position.
				evt hand grabMorph: self.
				halo removeAllHandlesBut: dupHandle]
		ifFalse: ["Subsequent duplicate does not grab, but only moves me and my morphs"
				dupLoc := nil.
				self position: self position + dupDelta]
! !

!SelectionMorph methodsFor: 'halo commands' stamp: 'dgd 9/20/2004 13:51'!
distributeVertically
	"Distribute the empty vertical space in a democratic way."
	| minTop maxBottom totalHeight currentTop space |
	self selectedItems size > 2
		ifFalse: [^ self].

	minTop := self selectedItems anyOne top.
	maxBottom := self selectedItems anyOne bottom.
	totalHeight := 0.
	self selectedItems
		do: [:each | 
			minTop := minTop min: each top.
			maxBottom := maxBottom max: each bottom.
			totalHeight := totalHeight + each height].

	currentTop := minTop.
	space := (maxBottom - minTop - totalHeight / (self selectedItems size - 1)) rounded.
	(self selectedItems asSortedCollection:[:x :y | x top <= y top])
		do: [:each | 
			each top: currentTop.
			currentTop := currentTop + each height + space].

	self changed
! !

!SelectionMorph methodsFor: 'menus' stamp: 'di 8/31/2000 20:50'!
maybeAddCollapseItemTo: aMenu
	"... don't "! !

!SelectionMorph methodsFor: 'halo commands' stamp: 'dgd 9/20/2004 13:41'!
alignCentersHorizontally
	"Make every morph in the selection have the same vertical center as the topmost item."

	| minLeft leftMost |
	selectedItems size > 1 ifFalse: [^ self].
	minLeft := (selectedItems collect: [:itm | itm left]) min.
	leftMost := selectedItems detect: [:m | m left = minLeft].
	selectedItems do:
		[:itm | itm center: (itm center x @ leftMost center y)].

	self changed
! !

!SelectionMorph methodsFor: 'geometry' stamp: 'StephaneDucasse 7/2/2013 17:50'!
extent: newExtent

	super extent: newExtent.
	self selectSubmorphsOf: self world! !

!SelectionMorph methodsFor: 'drawing' stamp: 'ar 9/1/2000 14:25'!
drawOn: aCanvas

	| canvas form1 form2 box |
	super drawOn: aCanvas.
	box := self bounds.
	selectedItems do: [:m | box := box merge: m fullBounds].
	box := box expandBy: 1.
	canvas := Display defaultCanvasClass extent: box extent depth: 8.
	canvas translateBy: box topLeft negated
		during: [:tempCanvas | selectedItems do: [:m | tempCanvas fullDrawMorph: m]].
	form1 := (Form extent: box extent) copyBits: (0@0 extent: box extent) from: canvas form at: 0@0 colorMap: (Color maskingMap: 8).
	form2 := Form extent: box extent.
	(0@0) fourNeighbors do: [:d | form1 displayOn: form2 at: d rule: Form under].
	form1 displayOn: form2 at: 0@0 rule: Form erase.
	aCanvas stencil: form2
		at: box topLeft
		sourceRect: form2 boundingBox
		color: self borderColor
! !

!SelectionMorph methodsFor: 'private' stamp: 'di 8/31/2000 22:12'!
selectSubmorphsOf: aMorph

	| newItems removals |
	newItems := aMorph submorphs select:
		[:m | (bounds containsRect: m fullBounds) 
					and: [m~~self
					and: [(m isKindOf: HaloMorph) not]]].
	otherSelection ifNil: [^ selectedItems := newItems].

	removals := newItems intersection: itemsAlreadySelected.
	otherSelection setSelectedItems: (itemsAlreadySelected copyWithoutAll: removals).
	selectedItems := (newItems copyWithoutAll: removals).
! !

!SelectionMorph methodsFor: 'halo commands' stamp: 'StephaneDucasse 10/27/2014 08:40'!
addCustomMenuItems: aMenu hand: aHandMorph
	"Add custom menu items to the menu"

	super addCustomMenuItems: aMenu hand: aHandMorph.
	aMenu addLine.
	aMenu add: 'add or remove items' target: self selector: #addOrRemoveItems: argument: aHandMorph.
	aMenu addList: {
		#-.
		{'Place into a row' . #organizeIntoRow}.
		{'Place into a column' . #organizeIntoColumn}.
		#-.
		{'Align left edges' . #alignLeftEdges}.
		{'Align top edges' . #alignTopEdges}.
		{'Align right edges' . #alignRightEdges}.
		{'Align bottom edges' . #alignBottomEdges}.
		#-.
		{'Align centers vertically' . #alignCentersVertically}.
		{'Align centers horizontally' . #alignCentersHorizontally}.
		}.

	self selectedItems size > 2
		ifTrue: [
			aMenu addList: {
				#-.
				{'Distribute vertically' . #distributeVertically}.
				{'Distribute horizontally' . #distributeHorizontally}.
				}.
		].
! !

!SelectionMorph methodsFor: 'private' stamp: 'dgd 9/20/2004 14:01'!
doneExtending

	otherSelection ifNotNil:
		[selectedItems := otherSelection selectedItems , selectedItems.
		otherSelection delete.
		self setOtherSelection: nil].
	self changed.
	self layoutChanged.
	super privateBounds:
		((Rectangle merging: (selectedItems collect: [:m | m fullBounds]))
			expandBy: 8).
	self changed.
	self addHalo.! !

!SelectionMorph methodsFor: 'private' stamp: 'di 8/31/2000 21:36'!
selectedItems

	^ selectedItems! !

!SelectionMorph methodsFor: 'halos and balloon help' stamp: 'SeanDeNigris 1/29/2013 13:57'!
balloonHelpTextForHandle: aHandle
	(aHandle eventHandler mouseSelectorsInclude: #addOrRemoveItems:)
		ifTrue: [^'Add items to, or remove them from, this selection.'].
	^ super balloonHelpTextForHandle: aHandle! !

!SelectionMorph methodsFor: 'halo commands' stamp: 'HenrikSperreJohansen 6/11/2010 00:34'!
duplicate
	"Make a duplicate of the receiver and havbe the hand grab it"

	selectedItems :=  selectedItems collect: #duplicate.
	selectedItems reverseDo: [:m | (owner ifNil: [ActiveWorld]) addMorph: m].
	dupLoc := self position.
	ActiveHand grabMorph: self.
	! !

!SelectionMorph methodsFor: 'initialization' stamp: 'AlainPlantec 12/19/2009 14:14'!
defaultBorderColor
	"answer the default border color/fill style for the receiver"
	^ (self defaultColor) twiceDarker alpha: 0.75! !

!SelectionMorph methodsFor: 'undo' stamp: 'di 9/19/2000 21:53'!
fillStyleForItems: fillStyleCollection

	selectedItems with: fillStyleCollection do: [:m :c | m fillStyle: c]! !

!SelectionMorph methodsFor: 'halos and balloon help' stamp: 'dgd 9/11/2004 18:29'!
hasHalo: aBool 
	super hasHalo: aBool.
	aBool
		ifFalse: [ (self hasProperty: #deleting) ifFalse: [self delete] ]
! !

!SelectionMorph methodsFor: 'halo commands' stamp: 'dgd 9/20/2004 13:50'!
distributeHorizontally
	"Distribute the empty vertical space in a democratic way."
	| minLeft maxRight totalWidth currentLeft space |

	self selectedItems size > 2
		ifFalse: [^ self].

	minLeft := self selectedItems anyOne left.
	maxRight := self selectedItems anyOne right.
	totalWidth := 0.
	self selectedItems
		do: [:each | 
			minLeft := minLeft min: each left.
			maxRight := maxRight max: each right.
			totalWidth := totalWidth + each width].

	currentLeft := minLeft.
	space := (maxRight - minLeft - totalWidth / (self selectedItems size - 1)) rounded.
	(self selectedItems
		asSortedCollection: [:x :y | x left <= y left])
		do: [:each | 
			each left: currentLeft.
			currentLeft := currentLeft + each width + space].

	self changed
! !

!SelectionMorph methodsFor: 'submorphs-add/remove' stamp: 'dgd 9/11/2004 18:27'!
delete
	self setProperty: #deleting toValue: true.
	super delete.
	! !

!SelectionMorph methodsFor: 'dropping/grabbing' stamp: 'ar 10/10/2000 15:02'!
aboutToBeGrabbedBy: aHand
	slippage := 0@0.
	^ super aboutToBeGrabbedBy: aHand
! !

!SelectionMorph methodsFor: 'accessing' stamp: 'nk 9/4/2004 17:33'!
borderColor: aColor

	| bordered |
	bordered := selectedItems.
	undoProperties ifNil: [undoProperties := bordered collect: [:m | m borderColor]].
	bordered do: [:m | m borderColor: aColor]! !

!SelectionMorph methodsFor: 'dropping/grabbing' stamp: 'AlainPlantec 7/9/2013 12:41'!
justDroppedInto: newOwner event: evt

	selectedItems isEmpty ifTrue:
		["Hand just clicked down to draw out a new selection"
		^ self extendByHand: evt hand].
	dupLoc ifNotNil: [dupDelta := self position - dupLoc].
	selectedItems reverseDo: [:m | 
		self defer:
			[m referencePosition: (newOwner localPointToGlobal: m referencePosition).
			newOwner handleDropMorph:
				(DropEvent new setPosition: evt cursorPoint contents: m hand: evt hand)]].
	evt wasHandled: true! !

!SelectionMorph methodsFor: 'wiw support' stamp: 'dgd 9/11/2004 21:58'!
morphicLayerNumber
	"helpful for insuring some morphs always appear in front of or  
	behind others. smaller numbers are in front"
	^ 8! !

!SelectionMorph methodsFor: 'submorphs-add/remove' stamp: 'di 8/23/2000 17:06'!
dismissViaHalo

	super dismissViaHalo.
	selectedItems do: [:m | m dismissViaHalo]! !

!SelectionMorph methodsFor: 'halo commands' stamp: 'dgd 9/20/2004 13:40'!
alignBottomEdges
	"Make the bottom coordinate of all my elements be the same"

	| maxBottom |
	maxBottom := (selectedItems collect: [:itm | itm bottom]) max.
	selectedItems do:
		[:itm | itm bottom: maxBottom].

	self changed
! !

!SelectionMorph methodsFor: 'private' stamp: 'StephaneDucasse 6/28/2013 11:34'!
privateFullMoveBy: delta
	| deltaSlipped griddingMorph |
	selectedItems isEmpty
		ifTrue: [ ^ super privateFullMoveBy: delta ].
	griddingMorph := self pasteUpMorph.
	griddingMorph ifNil: [ ^ super privateFullMoveBy: delta ].
	deltaSlipped := delta + slippage.
	slippage := 0.
	super privateFullMoveBy: deltaSlipped.
	selectedItems do: [ :m | m position: m position + deltaSlipped ]! !

!SelectionValueHolder commentStamp: 'BenjaminVanRyseghem 1/23/2014 15:18'!
I am especially designed to contain a list selection (an index + an object)!
!SelectionValueHolder methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 1/24/2014 16:07'!
initialize

	super initialize.
	index := 0 asValueHolder.
	selection := nil asValueHolder.
	
	index whenChangedSend: #valueChanged to: self.
	selection whenChangedSend: #valueChanged to: self.! !

!SelectionValueHolder methodsFor: 'accessing' stamp: ''!
selection

	^ selection! !

!SelectionValueHolder methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:21'!
value

	^ {index. selection}! !

!SelectionValueHolder methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:44'!
index: anIndex

	index := anIndex.
	self valueChanged: index! !

!SelectionValueHolder methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 1/24/2014 16:14'!
reset

	self index value: 0.
	self selection value: nil.
	self valueChanged! !

!SelectionValueHolder methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:44'!
selection: aSelection

	selection := aSelection.
	self valueChanged: selection! !

!SelectionValueHolder methodsFor: 'accessing' stamp: ''!
index

	^ index! !

!SelectionValueHolder class methodsFor: 'instance creation' stamp: ''!
index: indexValueHolder selection: selectionValueHolder

	^ self new
		index: indexValueHolder;
		selection: selectionValueHolder;
		yourself! !

!SelectorChooserMorph commentStamp: 'AlainPlantec 11/29/2010 10:47'!
A SelectorChooserMorph is an IdentifierChooserMorph specialized to allow a selector query from a selector prefix and for a TextMorph. 
When the prefix starts with an uppercase, then, only globals names and class names that begins with the prefix are shown.
Otherwise, all systems symbols that begins with the prefix are presented (the string comparison is not case sensitive).
It takes the keyboard focus when a navigation key (up, down, left or right key) is first pressed in the TextMorph from which it has been opened.

Instance Variables
	prefix: <String>
	requestorPos <Point>
	
prefix
	- The prefix which has been used to compute the labels list.

requestorPos
	- private, used to be able to automatically close the menu if the position of the requestor is changing!
!SelectorChooserMorph methodsFor: 'action' stamp: 'AlainPlantec 11/21/2010 15:59'!
choose: index
	"Set the given choice and ok."
	requestor ifNil: [^ self delete].
	requestor editor editingState selectorChooser ~= self 
		ifTrue: [^ self delete].
	requestor takeKeyboardFocus.
	super choose: index
	! !

!SelectorChooserMorph methodsFor: 'action' stamp: 'AlainPlantec 11/21/2010 16:03'!
close
	requestor 
		ifNotNil: [requestor takeKeyboardFocus.
			self choose: 0]! !

!SelectorChooserMorph methodsFor: 'ui-building' stamp: 'AlainPlantec 11/26/2010 10:03'!
newContentMorph 
	| sp |
	sp := super newContentMorph.
	sp
		updateScrollbars.
	^ sp
! !

!SelectorChooserMorph methodsFor: 'ui-building' stamp: 'AlainPlantec 11/18/2010 22:55'!
nextPrefixWith: aPrefix
	| curr pref found lab |
	curr := aPrefix size.
	lab := self labels first.
	found := false.
	[lab size <= curr 
		ifTrue: [found := true]
		ifFalse: [pref := lab copyFrom: 1 to: curr.
			self labels 
				do: [:l | found 
					ifFalse: [(l asString beginsWith: pref)
						ifFalse: [pref := pref allButLast.
							found := true]]]].
	found] whileFalse: [curr := curr + 1].
	^ (pref notNil and: [pref size > aPrefix size])
		ifTrue: [pref]
! !

!SelectorChooserMorph methodsFor: 'stepping and presenter' stamp: 'AlainPlantec 11/24/2010 15:11'!
step
	[requestorPos 
		ifNil: [requestorPos := requestor owner position]
		ifNotNil: [requestorPos ~= requestor owner position
			ifTrue: [^ self close]].
	(requestor isNil or: [requestor isInWorld not])
		ifTrue: [^ self close].
	requestor editor editingState selectorChooser ~= self 
		ifTrue: [self close]
	] on: Error do: [self delete]
! !

!SelectorChooserMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/29/2010 09:13'!
defaultBaseColor
	^  (self theme menuColorFor: self) muchLighter! !

!SelectorChooserMorph methodsFor: 'accessing' stamp: 'AlainPlantec 11/19/2010 09:19'!
prefix: aPrefix
	"Set the value of labels"
	prefix := aPrefix.
! !

!SelectorChooserMorph methodsFor: 'ui-building' stamp: 'AlainPlantec 11/26/2010 10:11'!
positionInRequestor
	| caret bottomLeft topLeft editor pos allowedArea |
	requestor ifNil: [^self].
	editor := requestor editor.
	caret := editor stopIndex.
	[editor selectAt: caret.
	bottomLeft := editor paragraph selectionRects first bottomLeft.
	topLeft := requestor owner submorphBounds topLeft.
	pos := topLeft + bottomLeft]
		ensure: [editor selectAt: caret].
	pos := pos + (40 @ 0).
	allowedArea := self allowedArea.
	(pos x + self width) > allowedArea width
		ifTrue: [pos := pos - (self width @ 0) - ((50 + 40)@ 0)].
	(pos y + self height) > allowedArea height
		ifTrue: [pos := (pos x @ (allowedArea height - self height - 5))].
	^ pos.
! !

!SelectorChooserMorph methodsFor: 'testing' stamp: 'AlainPlantec 11/19/2010 08:32'!
wantsSteps 
	^ requestor notNil! !

!SelectorChooserMorph methodsFor: 'submorphs-add/remove' stamp: 'AlainPlantec 11/19/2010 10:53'!
comeToFront
	super comeToFront.
	self setPosition ! !

!SelectorChooserMorph methodsFor: 'drawing' stamp: 'AlainPlantec 11/19/2010 11:10'!
drawCommonPrefixAreasOn: aCanvas
	| firstMenu firstMenuItem topLeft bottomLeft lastMenuItem |
	requestor ifNil: [^ self].
	prefix 
		ifNotNil: [ self choiceMenus 
			do: [:cm | self drawCommonPrefixAreasOn: aCanvas menu: cm]]
! !

!SelectorChooserMorph methodsFor: 'ui-building' stamp: 'AlainPlantec 11/21/2010 16:10'!
setPosition
	self position: self positionInRequestor.
! !

!SelectorChooserMorph methodsFor: 'ui-building' stamp: 'FernandoOlivero 4/12/2011 10:15'!
open
	super open. 
	self borderStyle: ( self theme progressBarBorderStyleFor: self).
	self setPosition! !

!SelectorChooserMorph methodsFor: 'drawing' stamp: 'AlainPlantec 11/24/2010 13:47'!
fullDrawOn: aCanvas
	super fullDrawOn: aCanvas.
	self drawCommonPrefixAreasOn: aCanvas
	! !

!SelectorChooserMorph methodsFor: 'stepping and presenter' stamp: 'AlainPlantec 11/19/2010 11:27'!
stepTime
	^ 500! !

!SelectorChooserMorph methodsFor: 'drawing' stamp: 'AlainPlantec 11/29/2010 10:59'!
drawCommonPrefixAreasOn: aCanvas menu: aMenu
	| firstMenuItem topLeft bottomLeft lastMenuItem w c |
	firstMenuItem := aMenu menuItems first.
	lastMenuItem := aMenu menuItems last.
	w := (firstMenuItem fontToUse widthOfString: prefix).
	topLeft := firstMenuItem boundsInWorld topLeft.
	bottomLeft := lastMenuItem boundsInWorld bottomLeft + ( w @ 0 ).
	c := aMenu color muchDarker.
	aCanvas fillRectangle: (topLeft  corner: bottomLeft) color: (c alpha: 0.3)! !

!SelectorChooserMorph class methodsFor: 'opening' stamp: 'AlainPlantec 11/25/2010 23:48'!
popUpPrefix: aPrefix from: aTextMorph 
	Cursor wait
		showWhile: [| selectors chooser |
			selectors := self selectorsFromPrefix: aPrefix.
			selectors size = 1
				ifTrue: [aTextMorph editor editingState chosenSelector: selectors first for: aTextMorph.
					^ nil].
			selectors isEmpty
				ifFalse: [chooser := self new
								chooseBlock: [:chosen | aTextMorph editor editingState chosenSelector: chosen for: aTextMorph];
								 requestor: aTextMorph;
								 prefix: aPrefix; 
								 labels: selectors;
								 yourself.
					chooser open].
			^ chooser]! !

!SelectorChooserMorph class methodsFor: 'accessing' stamp: 'AlainPlantec 11/19/2010 09:01'!
selectorsFromPrefix: aPrefix
	"returns the value of labels from a selector prefix"
	| key applicants |
	aPrefix isEmptyOrNil  ifTrue: [^ #()].
	applicants := aPrefix first canBeGlobalVarInitial
		ifTrue: [Array streamContents: [:strm |
			Symbol allSymbolTablesDo: [:each |
				(each notEmpty and: [each first canBeGlobalVarInitial])
					ifTrue: [strm nextPut: each]]]]
		ifFalse: [Array streamContents: [:strm |
			Symbol allSymbolTablesDo: [:each |
				(each notEmpty and: [each first canBeGlobalVarInitial not])
					ifTrue: [strm nextPut: each]]]].
	key := aPrefix asLowercase.
	^ (applicants select: [:each | (each asLowercase beginsWith: key) and: [each noneSatisfy: [:c | c tokenish not]]]) sort
! !

!SelectorException commentStamp: 'SvenVanCaekenberghe 4/20/2011 13:10'!
I am SelectorException, an abstract superclass for exceptions related to a selector.!
!SelectorException methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/20/2011 13:10'!
selector
	^ selector! !

!SelectorException methodsFor: 'printing' stamp: 'nice 12/2/2011 23:35'!
standardMessageText
	"Generate a standard textual description"
	
	^ String streamContents: [ :stream |
		stream << 'for '.
		stream print: self selector.
		stream << ' in '.
		stream print: self signaler class]! !

!SelectorException methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/20/2011 13:11'!
messageText
	"Overwritten to initialiaze the message text to a standard text if it has not yet been set"
	
	^ messageText ifNil: [ messageText := self standardMessageText ]! !

!SelectorException methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/20/2011 13:11'!
selector: aSelector
	selector := aSelector! !

!SelectorException class methodsFor: 'signaling' stamp: 'SvenVanCaekenberghe 4/20/2011 13:13'!
signalFor: aSelector
	"Create and signal an exception for aSelector in the default receiver."
	
	^ self new
		selector: aSelector;
		signal! !

!SelectorException class methodsFor: 'signaling' stamp: 'MarcusDenker 7/28/2014 18:35'!
signalFor: aSelector in: aReceiver
	"Create and signal an exception for aSelector in aReceiver."

	^ self new
		selector: aSelector;
		signaler: aReceiver;
		signal! !

!SelectorFilter commentStamp: 'TorstenBergmann 1/31/2014 11:30'!
A filter for selectors!
!SelectorFilter methodsFor: 'initialization' stamp: 'AndreiChis 9/30/2013 10:54'!
initialize
	super initialize.
	self selectors: OrderedCollection new.! !

!SelectorFilter methodsFor: 'accessing' stamp: 'ClaraAllende 8/14/2013 20:02'!
selectors
 	^selectors! !

!SelectorFilter methodsFor: 'testing' stamp: 'AndreiChis 9/30/2013 11:56'!
shouldDisplay: aContext
	 ^ (self selectors  
		includes: aContext method selector) not.! !

!SelectorFilter methodsFor: 'accessing' stamp: 'AndreiChis 9/30/2013 10:54'!
selectors: someSelectors
	selectors := someSelectors! !

!SelectorFilter class methodsFor: 'instance creation' stamp: 'AndreiChis 9/30/2013 10:55'!
forSelector: aSelector
	|filter|
	
	filter:= self new.
	filter selectors add: aSelector.
	^ filter! !

!SelectorFilter class methodsFor: 'instance creation' stamp: 'AndreiChis 9/30/2013 10:55'!
forSelectors: someSelectors
	 |filter|
	
	 filter:= self new.
	 filter selectors addAll: someSelectors.
	^ filter! !

!SelectorNode commentStamp: '<historical>'!
I am a parse tree leaf representing a selector.!
!SelectorNode methodsFor: 'printing' stamp: 'eem 9/25/2008 14:56'!
key: aSelector
	"This is for printing of FFI selectors."
	key := aSelector! !

!SelectorNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 14:52'!
emitCode: stack args: nArgs encoder: encoder

	self emitCode: stack
		args: nArgs
		encoder: encoder
		super: false! !

!SelectorNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 14:52'!
emitCodeForEffect: stack encoder: encoder

	self shouldNotImplement! !

!SelectorNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 14:52'!
sizeCodeForValue: encoder

	self shouldNotImplement! !

!SelectorNode methodsFor: 'testing' stamp: 'EstebanLorenzano 8/17/2012 16:40'!
isForFFICall
	^key includesSubstring: '()/'! !

!SelectorNode methodsFor: 'initialize-release' stamp: 'eem 5/14/2008 09:30'!
name: literal key: object index: i type: type
	"For compatibility with Encoder>>name:key:class:type:set:"
	^self key: object index: i type: type! !

!SelectorNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 16:15'!
sizeCode: encoder args: nArgs super: supered
	self reserve: encoder.
	^supered
		ifTrue:
			[code < Send "i.e. its a special selector" ifTrue:
				[code := self code: (index := encoder sharableLitIndex: key) type: 5].
			 encoder sizeSendSuper: index numArgs: nArgs]
		ifFalse:
			[self flag: #yuck. "special selector sends cause this problem"
			 encoder
				sizeSend: (code < Send ifTrue: [code negated] ifFalse: [index])
				numArgs: nArgs]! !

!SelectorNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 16:08'!
reserve: encoder 
	"If this is a yet unused literal of type -code, reserve it."

	code < 0 ifTrue: [code := self code: (index := encoder sharableLitIndex: key) type: 0 - code]! !

!SelectorNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 14:52'!
emitCodeForValue: stack encoder: encoder

	self shouldNotImplement! !

!SelectorNode methodsFor: 'visiting' stamp: 'eem 9/6/2009 12:34'!
accept: aVisitor
	^aVisitor visitSelectorNode: self! !

!SelectorNode methodsFor: 'printing' stamp: 'eem 9/25/2008 15:01'!
printAsFFICallWithArguments: aSequence on: aStream indent: level
	aStream nextPutAll: (key copyUpTo: $)).
	aSequence
		do: [:arg| arg printOn: aStream indent: level]
		separatedBy: [aStream nextPutAll: ', '].
	aStream nextPut: $)! !

!SelectorNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 14:52'!
sizeCodeForEffect: encoder

	self shouldNotImplement! !

!SelectorNode methodsFor: 'printing' stamp: 'eem 5/6/2008 14:50'!
printOn: aStream indent: level 
	aStream nextPutAll: (key == nil
							ifTrue: ['<key==nil>']
							ifFalse: [key])! !

!SelectorNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 17:47'!
emitCode: stack args: nArgs encoder: encoder super: supered
	stack pop: nArgs.
	^supered
		ifTrue:
			[encoder genSendSuper: index numArgs: nArgs]
		ifFalse:
			[encoder
				genSend: (code < Send ifTrue: [code negated] ifFalse: [index])
				numArgs: nArgs]! !

!SelfEvaluatingObjectTest commentStamp: 'TorstenBergmann 2/5/2014 08:44'!
SUnit tests for self evaluting objects !
!SelfEvaluatingObjectTest methodsFor: 'utilities' stamp: 'MarcusDenker 5/2/2013 11:37'!
assertCode: code print: aString
	self assert: (self class evaluate: code) printString = aString! !

!SelfEvaluatingObjectTest methodsFor: 'tests' stamp: 'md 12/7/2011 16:05'!
testArray
	"self debug: #testArray"

	self assertCode: '#(1 2 3)' print: '#(1 2 3)'.
	self assertCode: '{1 . 2 . 3}' print: '#(1 2 3)'.
	self assertCode: '{1 + 0 . 2 . 3}' print: '#(1 2 3)'.
	self assertCode: '{1 + 0 . 1 @ 2 . 3}' print: '{1. (1@2). 3}'.
	self assertCode: '{2@3}' print: '{(2@3)}'.
	self assertCode: '{Object new}' print:  'an Array(an Object)'.
	self assertCode: '{Rectangle new . Object new}' print:  'an Array(nil corner: nil an Object)'.
	self assertCode: '{10@10 corner: 20@20 . 100@100 corner: 200@200}' print: '{(10@10) corner: (20@20). (100@100) corner: (200@200)}'! !

!SelfEvaluatingObjectTest methodsFor: 'tests' stamp: 'StephaneDucasse 10/16/2011 18:16'!
testObjects
	"self debug: #testObjects"

	self assert: 10 isSelfEvaluating.
	self assert: $a isSelfEvaluating.
	self assert: 3.14157 isSelfEvaluating.
	self assert: #(1 2 3) isSelfEvaluating.
	self assert: #abc isSelfEvaluating.
	self assert: 'abc' isSelfEvaluating.

	self assert: Object isSelfEvaluating.
	self assert: Object new isSelfEvaluating not.
	
	self assert: {Float infinity . Float nan. Float infinity negated} isSelfEvaluating.

	self assert: (Array with: 10) isSelfEvaluating.
	self assert: (Array with: Object new) isSelfEvaluating not.

	self assert: true isSelfEvaluating.
	self assert: false isSelfEvaluating.

	self assert: nil isSelfEvaluating.

	self assert: (1 to: 10) isSelfEvaluating.
	self assert: (1->2) isSelfEvaluating.
	self assert: Color red isSelfEvaluating.
	self assert: RunArray new isSelfEvaluating.! !

!SelfEyeElement commentStamp: '<historical>'!
I am an eye element for self!
!SelfEyeElement methodsFor: 'action' stamp: 'ClementBera 4/30/2013 11:30'!
browseClassRefs

	self hostClass isTrait 
		ifTrue: [self systemNavigation browseAllUsersOfTrait: self hostClass]
		ifFalse: [self systemNavigation browseAllCallsOnClass: self hostClass]! !

!SelfEyeElement methodsFor: 'action' stamp: 'ClementBera 4/30/2013 11:29'!
browseInstVarDefs

	^ self systemNavigation browseInstVarDefs: self hostClass! !

!SelfEyeElement methodsFor: 'accessing' stamp: 'ClementBera 4/30/2013 11:21'!
value
	^ host! !

!SelfEyeElement methodsFor: 'accessing' stamp: 'CamilloBruni 4/30/2013 10:55'!
accessorCode
	^ self label! !

!SelfEyeElement methodsFor: 'accessing' stamp: 'CamilloBruni 4/30/2013 10:52'!
label
	^ 'self'! !

!SelfEyeElement methodsFor: 'action' stamp: 'ClementBera 4/30/2013 11:28'!
browseInstVarRefs

	^ self systemNavigation browseInstVarRefs: self hostClass! !

!SelfEyeElement methodsFor: 'menu' stamp: 'BenjaminVanRyseghem 11/1/2013 15:31'!
customSubMenu: aMenu
	"Subclasse may add more menu items here"

	aMenu addGroup: [ :aGroup |
		aGroup addItem: [ :anItem |
			anItem name: 'Inst var refs...';
			action: [ self browseInstVarRefs ] ].
		aGroup addItem: [ :anItem |
			anItem name: 'Inst var defs...';
			action: [ self browseInstVarDefs ] ].
		aGroup addItem: [ :anItem |
			anItem name: 'Class var refs...';
			action: [ self classVarRefs ] ].
		aGroup addItem: [ :anItem |
			anItem name: 'Class variables';
			action: [ self browseInstClassVariables ] ].
		aGroup addItem: [ :anItem |
			anItem name: 'Class refs';
			action: [ self browseClassRefs ] ] ]! !

!SelfEyeElement methodsFor: 'action' stamp: 'ClementBera 4/30/2013 11:30'!
browseInstClassVariable

	^ self systemNavigation browseClassVariables: self hostClass! !

!SelfEyeElement methodsFor: 'action' stamp: 'ClementBera 4/30/2013 11:29'!
classVarRefs

	^ self systemNavigation browseClassVarRefs: self hostClass! !

!SelfEyeElement methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/14/2014 10:30'!
shouldShowInTree
	^ false! !

!Semaphore commentStamp: '<historical>'!
I provide synchronized communication of a single bit of information (a "signal") between Processes. A signal is sent by sending the message signal and received by sending the message wait. If no signal has been sent when a wait message is sent, the sending Process will be suspended until a signal is sent.!
!Semaphore methodsFor: 'initialize-release' stamp: ''!
initSignals
	"Consume any excess signals the receiver may have accumulated."

	excessSignals := 0.! !

!Semaphore methodsFor: 'comparing' stamp: 'sma 4/22/2000 18:48'!
hash
	^ self identityHash! !

!Semaphore methodsFor: 'testing' stamp: 'ar 3/2/2001 16:51'!
isSignaled
	"Return true if this semaphore is currently signaled"
	^excessSignals > 0! !

!Semaphore methodsFor: 'mutual exclusion' stamp: 'StephaneDucasse 3/13/2010 13:42'!
critical: mutuallyExcludedBlock			
	"Evaluate mutuallyExcludedBlock only if the receiver is not currently in
	the process of running the critical: message. If the receiver is, evaluate
	mutuallyExcludedBlock after the other critical: message is finished."
	
	"We need to catch eventual interruptions very carefully.
	The naive approach of just doing, e.g.,:
			self wait.
			aBlock ensure: [self signal].
	will fail if the active process gets terminated while in the wait.
	However, the equally naive:
			[self wait.
			aBlock value] ensure: [self signal].
	will fail too, since the active process may get interrupted while
	entering the ensured block and leave the semaphore signaled twice.
	To avoid both problems we make use of the fact that interrupts only
	occur on sends (or backward jumps) and use an assignment (bytecode)
	right before we go into the wait primitive (which is not a real send and
	therefore not interruptable either)."
	
	| blockValue caught |
	caught := false.
	[
		caught := true.
		self wait.
		blockValue := mutuallyExcludedBlock value
	] ensure: [caught ifTrue: [self signal]].
	^blockValue
! !

!Semaphore methodsFor: 'communication' stamp: 'ar 3/27/2009 22:37'!
waitTimeoutSeconds: anInteger
	"Wait on this semaphore for up to the given number of seconds, then timeout.
	Return true if the deadline expired, false otherwise."
	^self waitTimeoutMSecs: anInteger * 1000.
! !

!Semaphore methodsFor: 'mutual exclusion' stamp: 'StephaneDucasse 3/13/2010 13:39'!
critical: mutuallyExcludedBlock ifLocked: alternativeBlock
	"Evaluate mutuallyExcludedBlock only if the receiver is not currently in 
	the process of running the critical: message. If the receiver is, evaluate 
	mutuallyExcludedBlock after the other critical: message is finished."
	
	"Note: The following is tricky and depends on the fact that the VM will not switch between 
processes while executing byte codes (process switches happen only in real sends). The following 
test is written carefully so that it will result in bytecodes only."

	excessSignals == 0 
		ifTrue: 
			[ "If we come here, then the semaphore was locked when the test executed. 
			Evaluate the alternative block and answer its result."
			^alternativeBlock value ].
	^self critical: mutuallyExcludedBlock! !

!Semaphore methodsFor: 'mutual exclusion' stamp: 'ClementBera 10/3/2013 10:27'!
critical: mutuallyExcludedBlock ifError: errorBlock
	"Evaluate mutuallyExcludedBlock only if the receiver is not currently in 
	the process of running the critical: message. If the receiver is, evaluate 
	mutuallyExcludedBlock after the other critical: message is finished."
	| blockValue hasError errMsg errRcvr |
	hasError := false.
	self critical:[
		blockValue := mutuallyExcludedBlock ifError: [ :msg :rcvr|
			hasError := true.
			errMsg := msg.
			errRcvr := rcvr
		].
	].
	hasError ifTrue:[ ^errorBlock cull: errMsg cull: errRcvr].
	^blockValue! !

!Semaphore methodsFor: 'communication' stamp: 'ar 3/27/2009 22:38'!
waitTimeoutMSecs: anInteger
	"Wait on this semaphore for up to the given number of milliseconds, then timeout. 
	Return true if the deadline expired, false otherwise."
	| d |
	d := DelayWaitTimeout new setDelay: (anInteger max: 0) forSemaphore: self.
	^d wait! !

!Semaphore methodsFor: 'communication' stamp: ''!
signal
	"Primitive. Send a signal through the receiver. If one or more processes 
	have been suspended trying to receive a signal, allow the first one to 
	proceed. If no process is waiting, remember the excess signal. Essential. 
	See Object documentation whatIsAPrimitive."

	<primitive: 85>
	self primitiveFailed

	"self isEmpty    
		ifTrue: [excessSignals := excessSignals+1]    
		ifFalse: [Processor resume: self removeFirstLink]"

! !

!Semaphore methodsFor: 'comparing' stamp: 'sma 4/22/2000 18:48'!
= anObject
	^ self == anObject! !

!Semaphore methodsFor: 'mutual exclusion' stamp: 'ClementBera 10/3/2013 10:27'!
critical: mutuallyExcludedBlock ifCurtailed: terminationBlock
	"Evaluate mutuallyExcludedBlock only if the receiver is not currently in 
	the process of running the critical: message. If the receiver is, evaluate 
	mutuallyExcludedBlock after the other critical: message is finished."
	^self critical:[mutuallyExcludedBlock ifCurtailed: terminationBlock]
! !

!Semaphore methodsFor: 'initialize-release' stamp: ''!
terminateProcess
	"Terminate the process waiting on this semaphore, if any."

	self isEmpty ifFalse: [ self removeFirst terminate ].! !

!Semaphore methodsFor: 'initialize-release' stamp: 'jf 12/2/2003 18:53'!
resumeProcess: aProcess
	"Remove the given process from the list of waiting processes (if it's there) and resume it.  This is used when a process asked for its wait to be timed out."

	| process |
	process := self remove: aProcess ifAbsent: [nil].
	process ifNotNil: [process resume].! !

!Semaphore methodsFor: 'communication' stamp: ''!
wait
	"Primitive. The active Process must receive a signal through the receiver 
	before proceeding. If no signal has been sent, the active Process will be 
	suspended until one is sent. Essential. See Object documentation 
	whatIsAPrimitive."

	<primitive: 86>
	self primitiveFailed

	"excessSignals>0  
		ifTrue: [excessSignals := excessSignals-1]  
		ifFalse: [self addLastLink: Processor activeProcess suspend]"
! !

!Semaphore methodsFor: 'initialize-release' stamp: 'CamilloBruni 10/14/2013 22:01'!
consumeAllSignals
	"Consume any excess signals the receiver may have accumulated."

	excessSignals := 0.! !

!Semaphore class methodsFor: 'instance creation' stamp: ''!
new
	"Answer a new instance of Semaphore that contains no signals."

	^self basicNew initSignals! !

!Semaphore class methodsFor: 'instance creation' stamp: ''!
forMutualExclusion
	"Answer an instance of me that contains a single signal. This new 
	instance can now be used for mutual exclusion (see the critical: message 
	to Semaphore)."

	^self new signal! !

!SemaphoreTest commentStamp: 'tlk 5/5/2006 13:32'!
A SemaphoreTest is sunit test for simple and multiEx semaphores

Instance Variables none; does not have common test fixture accross all tests (because its testing differenct sorts of semaphores (could refactor into muliple testcases if there were more test conditions.
!
!SemaphoreTest methodsFor: 'tests' stamp: 'jf 12/2/2003 19:31'!
testWaitAndWaitTimeoutTogether
	| semaphore value waitProcess waitTimeoutProcess |
	semaphore := Semaphore new.
	
	waitProcess := [semaphore wait. value := #wait] fork.

	waitTimeoutProcess := [semaphore waitTimeoutMSecs: 50. value := #waitTimeout] fork.

	"Wait for the timeout to happen"
	(Delay forMilliseconds: 100) wait.

	"The waitTimeoutProcess should already have timed out.  This should release the waitProcess"
	semaphore signal.

	[waitProcess isTerminated and: [waitTimeoutProcess isTerminated]]
		whileFalse: [(Delay forMilliseconds: 100) wait].

	self assert: value = #wait.
	! !

!SemaphoreTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/2/2012 13:34'!
testAfterCriticalWait	"self run: #testSemaAfterCriticalWait"
	"This tests whether a semaphore that has just left the wait in Semaphore>>critical:
	leaves it with signaling the associated semaphore."
	| s p |
	s := Semaphore new.
	p := [s critical:[]] forkAt: Processor activePriority-1.
	"wait until p entered the critical section"
	[p suspendingList == s] whileFalse:[(Delay forMilliseconds: 10) wait].
	"Now that p entered it, signal the semaphore. p now 'owns' the semaphore
	but since we are running at higher priority than p it will not get to do
	anything."
	s signal.
	p terminate.
	self assert:(s instVarNamed: #excessSignals) = 1! !

!SemaphoreTest methodsFor: 'tests' stamp: 'tlk 5/5/2006 13:28'!
testCriticalIfError
	| lock |
	lock := Semaphore forMutualExclusion.
	[lock critical: [self criticalError ifError:[]]] forkAt: Processor userInterruptPriority.
	self assert: lock isSignaled! !

!SemaphoreTest methodsFor: 'tests' stamp: 'tlk 5/5/2006 13:27'!
testCritical
	| lock |
	lock := Semaphore forMutualExclusion.
	[lock critical: [self criticalError]] forkAt: Processor userInterruptPriority.
	self assert: lock isSignaled! !

!SemaphoreTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/2/2012 13:16'!
testSimpleCommunication
	"A process waiting on a signal will not proceed until one is sent"

	| semaphore wasBlockStarted wasBlockFinished |
	wasBlockStarted := wasBlockFinished := false.
	semaphore := Semaphore new.
	
	[
		wasBlockStarted := true.
		semaphore wait.
		wasBlockFinished := true ] fork.

	Processor yield.
	
	self assert: wasBlockStarted.
	self deny: wasBlockFinished.
	
	semaphore signal.
	Processor yield.
	
	self assert: wasBlockFinished.! !

!SemaphoreTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/2/2012 13:34'!
testInCriticalWait	"self run: #testSemaInCriticalWait"
	"This tests whether a semaphore that has entered the wait in Semaphore>>critical:
	leaves it without signaling the associated semaphore."
	| s p |
	s := Semaphore new.
	p := [s critical:[]] fork.
	Processor yield.
	self assert: (p suspendingList == s).
	p terminate.
	self assert:(s instVarNamed: #excessSignals) = 0! !

!SemaphoreTest methodsFor: 'private' stamp: 'tlk 5/5/2006 13:26'!
criticalError
	Processor activeProcess terminate! !

!SemaphoreTest methodsFor: 'tests' stamp: 'ar 3/23/2009 17:01'!
testWaitTimeoutMSecs
	"Ensure that waitTimeoutMSecs behaves properly"

	"Ensure that a timed out waitTimeoutMSecs: returns true from the wait"
	self assert: (Semaphore new waitTimeoutMSecs: 50) == true.

	"Ensure that a signaled waitTimeoutMSecs: returns false from the wait"
	self assert: (Semaphore new signal waitTimeoutMSecs: 50) == false.
! !

!SemaphoreTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/2/2012 14:50'!
testMutualExclusion

	| lock steps |
	steps := OrderedCollection new.
	lock := Semaphore forMutualExclusion.
	
	[
		steps add: #startProcess1.
		lock critical: [
			steps add: #startCritical1.
			Processor yield.
			steps add: #endCritical1 ] ] fork.
	[
		steps add: #startProcess2.
		lock critical: [ 
			steps add: #startCritical2.
			Processor yield.
			steps add: #endCritical2 ] ] fork.
	
	[ steps size = 6 ] whileFalse: [ Processor yield ].

	self assert: (steps hasEqualElements: #(startProcess1 startCritical1 startProcess2 endCritical1 startCritical2 endCritical2)).! !

!SemaphoreTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/2/2012 13:33'!
testSchedulesFIFO
	"Based only on wait time, independent of process priority"

	| semaphore waitingLongestResumed higherPriorityResumed |
	waitingLongestResumed := higherPriorityResumed := false.
	semaphore := Semaphore new.
	
	[
		semaphore wait.
		waitingLongestResumed := true ] forkAt: Processor activeProcess priority + 10.
	[
		semaphore wait.
		higherPriorityResumed := true ] forkAt: Processor activeProcess priority + 20.

	self deny: waitingLongestResumed.
	self deny: higherPriorityResumed.

	semaphore signal.
	self assert: waitingLongestResumed.
	
	semaphore signal.
	self assert: higherPriorityResumed.! !

!SemaphoreTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/2/2012 13:22'!
testReturnsAsManyWaitsAsSignalsReceived

	| semaphore semaphoreReturnedOnce semaphoreReturnedTwice |
	semaphoreReturnedOnce := semaphoreReturnedTwice := false.
	semaphore := Semaphore new.
	
	[
		semaphore wait.
		semaphoreReturnedOnce := true.
		semaphore wait.
		semaphoreReturnedTwice := true ] fork.

	Processor yield.
	self deny: semaphoreReturnedOnce.
	
	semaphore signal.
	Processor yield.
	self assert: semaphoreReturnedOnce.
	self deny: semaphoreReturnedTwice.
	
	semaphore signal.
	Processor yield.
	self assert: semaphoreReturnedTwice.! !

!SeparatorMorph commentStamp: 'gvc 6/4/2007 14:13'!
Simple themed separator morph.!
!SeparatorMorph methodsFor: 'accessing' stamp: 'gvc 6/4/2007 14:21'!
adoptPaneColor: paneColor
	"Change our fill too."
	
	super adoptPaneColor: paneColor.
	paneColor ifNil: [^self].
	self fillStyle: (self theme separatorFillStyleFor: self)! !

!SequenceableCollection commentStamp: '<historical>'!
I am an abstract superclass for collections that have a well-defined order associated with their elements. Thus each element is externally-named by integers referred to as indices.!
!SequenceableCollection methodsFor: 'copying' stamp: ''!
copyFrom: start to: stop 
	"Answer a copy of a subset of the receiver, starting from element at 
	index start until element at index stop."

	| newSize |
	newSize := stop - start + 1.
	^(self species new: newSize)
		replaceFrom: 1
		to: newSize
		with: self
		startingAt: start! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'sma 5/12/2000 11:56'!
do: elementBlock separatedBy: separatorBlock
	"Evaluate the elementBlock for all elements in the receiver,
	and evaluate the separatorBlock between."

	1 to: self size do:
		[:index |
		index = 1 ifFalse: [separatorBlock value].
		elementBlock value: (self at: index)]! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'StephaneDucasse 3/1/2011 14:22'!
overlappingPairsCollect: aBlock 
	"Answer the result of evaluating aBlock with all of the overlapping pairs of my elements."
	| retval |
	retval := self species ofSize: self size - 1.
	1 to: self size - 1
		do: [:i | retval at: i put: (aBlock value: (self at: i) value: (self at: i + 1)) ].
	^retval! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'StephaneDucasse 1/13/2010 22:02'!
allPairsDo: aBinaryBlock
	"
	Iterate over all the pairs of the receiver and apply the binaryBlock
	to each pair. 
	
	| res | 
	res := OrderedCollection new. 
	#(0 1 2 3) allPairsDo: [:first :second | res add: {first . second} ].
	res 
	 an OrderedCollection(#(0 0) #(0 1) #(0 2) #(0 3) #(1 0) #(1 1) #(1 2) #(1 3) #(2 0) #(2 1) #(2 2) #(2 3) #(3 0) #(3 1) #(3 2) #(3 3))
	"
	
	self do: [:first| self do: [:second| aBinaryBlock value: first value: second]]! !

!SequenceableCollection methodsFor: 'copying' stamp: 'rhi 12/6/2001 14:04'!
copyWithoutIndex: index
	"Return a copy containing all elements except the index-th."

	| copy |
	copy := self species ofSize: self size - 1.
	copy replaceFrom: 1 to: index-1 with: self startingAt: 1.
	copy replaceFrom: index to: copy size with: self startingAt: index+1.
	^ copy! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'CamilloBruni 3/22/2013 22:36'!
reject: rejectBlock 
	"Optimized version of Collection>>#reject:"
	
	| each |
	
	^ self class new: self size streamContents: [ :stream|
		1 to: self size do: [ :index |
			(rejectBlock value: (each := self at: index))
				ifFalse: [ stream nextPut: each ]]]! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'SvenVanCaekenberghe 3/8/2012 14:00'!
findBinary: aBlock
	"Search for an element in the receiver using binary search.
	The argument aBlock is a one-element block returning
		0 	- if the element is the one searched for
		<0	- if the search should continue in the first half
		>0	- if the search should continue in the second half
	If no matching element is found, raise an error.
	Examples:
		#(1 3 5 7 11 15 23) findBinary: [ :arg | 11 - arg ]. "
		
	^ self 
		findBinary: aBlock 
		do: [ :found | found ] 
		ifNone: [ self errorNotFound: aBlock ]! !

!SequenceableCollection methodsFor: 'splitjoin' stamp: 'onierstrasz 4/10/2009 22:53'!
joinUsing: joiner
	"joiner - character, string or sequenceable collection
	returns collection of the same collection class as 'joiner', or a String"
	^ joiner join: self! !

!SequenceableCollection methodsFor: 'comparing' stamp: 'tk 12/6/2000 11:39'!
hasEqualElements: otherCollection
	"Answer whether the receiver's size is the same as otherCollection's
	size, and each of the receiver's elements equal the corresponding 
	element of otherCollection.
	This should probably replace the current definition of #= ."

	| size |
	(otherCollection isKindOf: SequenceableCollection) ifFalse: [^ false].
	(size := self size) = otherCollection size ifFalse: [^ false].
	1 to: size do:
		[:index |
		(self at: index) = (otherCollection at: index) ifFalse: [^ false]].
	^ true! !

!SequenceableCollection methodsFor: 'converting' stamp: 'ar 9/14/1998 23:47'!
asFloatArray
	"Answer a FloatArray whose elements are the elements of the receiver, in 
	the same order."

	| floatArray |
	floatArray := FloatArray new: self size.
	1 to: self size do:[:i| floatArray at: i put: (self at: i) asFloat ].
	^floatArray! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'JMM 10/30/2005 09:21'!
second
	"Answer the second element of the receiver.
	Raise an error if there are not enough elements."

	^ self at: 2! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'ar 8/14/1998 21:21'!
identityIndexOf: anElement ifAbsent: exceptionBlock
	"Answer the index of anElement within the receiver. If the receiver does 
	not contain anElement, answer the result of evaluating the argument, 
	exceptionBlock."
	1 to: self size do:
		[:i | (self at: i) == anElement ifTrue: [^ i]].
	^ exceptionBlock value! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'ar 12/16/2001 01:06'!
lastIndexOf: anElement
	"Answer the index of the last occurence of anElement within the 
	receiver. If the receiver does not contain anElement, answer 0."

	^ self lastIndexOf: anElement startingAt: self size ifAbsent: [0]! !

!SequenceableCollection methodsFor: 'sorting' stamp: ''!
mergeFirst: first middle: middle last: last into: dst by: aBlock
	"Private. Merge the sorted ranges [first..middle] and [middle+1..last] 
	of the receiver into the range [first..last] of dst."

	| i1 i2 val1 val2 out |
	i1 := first.
	i2 := middle + 1.
	val1 := self at: i1.
	val2 := self at: i2.
	out := first - 1.  "will be pre-incremented"

	"select 'lower' half of the elements based on comparator"
	[(i1 <= middle) and: [i2 <= last]] whileTrue:
		[(aBlock value: val1 value: val2)
			ifTrue: [dst at: (out := out + 1) put: val1.
					val1 := self at: (i1 := i1 + 1)]
			ifFalse: [dst at: (out := out + 1) put: val2.
					i2 := i2 + 1.
					i2 <= last ifTrue: [val2 := self at: i2]]].

	"copy the remaining elements"
	i1 <= middle
		ifTrue: [dst replaceFrom: out + 1 to: last with: self startingAt: i1]
		ifFalse: [dst replaceFrom: out + 1 to: last with: self startingAt: i2]! !

!SequenceableCollection methodsFor: 'sorting' stamp: ''!
sorted: aSortBlockOrNil
	"Return a new sequenceable collection which contains the same elements as self but its 
elements are sorted by aSortBlockOrNil. The block should take two arguments and return true if 
the first element should preceed the second one. If aSortBlock is nil then <= is used for 
comparison."
	
	^self copy sort: aSortBlockOrNil! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'ar 8/14/1998 21:20'!
identityIndexOf: anElement 
	"Answer the index of anElement within the receiver. If the receiver does 
	not contain anElement, answer 0."

	^self identityIndexOf: anElement ifAbsent: [0]! !

!SequenceableCollection methodsFor: 'converting' stamp: 'sma 5/12/2000 17:32'!
asArray
	"Answer an Array whose elements are the elements of the receiver."

	^ Array withAll: self! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'sma 6/1/2000 15:35'!
allButLast
	"Answer a copy of the receiver containing all but the last
	element. Raise an error if there are not enough elements."

	^ self allButLast: 1! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'sma 5/12/2000 18:04'!
before: target
	"Answer the receiver's element immediately before target. Raise an
	error if target is not an element of the receiver, or if there are no 
	elements before it (i.e. it is the first element)."

	^ self before: target ifAbsent: [self errorNotFound: target]! !

!SequenceableCollection methodsFor: 'testing' stamp: 'StephaneDucasse 3/28/2010 21:06'!
endsWithAnyOf: aCollection
	"Return true if the receiver ends with any of the elements in aCollection."
	^aCollection anySatisfy:[:suffix| self endsWith: suffix]! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'LukasRenggli 5/10/2010 12:58'!
reduceRight: aBlock
	"Fold the result of the receiver from right to left into aBlock. The argument aBlock must take two or more arguments."

	"#(1 2 3) reduceRight: [ :a :b | a - b ].
		--> (1 - (2 - 3)) = 2
	#(1 + 3 - 5) reduceRight: [ :a :op :b | a perform: op with: b ].
		--> (1 + (3 - 5)) = -1"

	| arguments |
	self emptyCheck.
	arguments := Array new: aBlock argumentCount.
	(arguments size = 0 or: [ (self size + 1) \\ (arguments size - 1) > 0 ])
		ifTrue: [ self error: 'Collection size and block argument count do not match.' ].
	arguments at: arguments size put: self last.
	self size - arguments size + 1 to: 1 by: 1 - arguments size do: [ :index |
		arguments
			replaceFrom: 1 to: aBlock argumentCount - 1 with: self startingAt: index;
			at: arguments size put: (aBlock valueWithArguments: arguments) ].
	^ arguments last! !

!SequenceableCollection methodsFor: 'splitjoin' stamp: 'onierstrasz 4/12/2009 20:20'!
splitOn: splitter 
	"splitter - can be a subsequence, a Block or a Regex (String receiver only).
	Any other object used as a splitter is treated as an Array containing that object."
	^ splitter split: self! !

!SequenceableCollection methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 3/25/2015 09:09'!
gtInspectorItemsIn: composite
	^ composite table
		title: 'Items';
		display: [ :aCollection | (1 to: self size) collect: [ :index | index -> (self at: index) ] ];
		beMultiple;
		searchOn: [:text :each | 
			Smalltalk compiler evaluate: ' | entity each | each := self. entity := each.', text for: each value logged: false];
		column: 'Index' evaluated: [ :assoc | assoc key asString ];
		column: 'Item' evaluated: [ :assoc | GTObjectPrinter new asTruncatedTextFrom: assoc value ];
		send: [ :result | 
			result isNil
				ifTrue: [ nil ]
				ifFalse: [ result value size = 1 
					ifTrue: [result anyOne value]  
					ifFalse: [self species withAll: (result collect: [:each | each value])]]];
		showOnly: 50;
		helpMessage: 'Quick selection field. Given your INPUT, it executes: self select: [:each | INPUT ]'.! !

!SequenceableCollection methodsFor: 'splitjoin' stamp: 'onierstrasz 4/12/2009 19:58'!
joinTo: stream
	"double dispatch for join:"
	^ stream nextPutAll: self! !

!SequenceableCollection methodsFor: 'converting' stamp: 'ar 10/10/1998 16:19'!
asIntegerArray
	"Answer an IntegerArray whose elements are the elements of the receiver, in 
	the same order."

	| intArray |
	intArray := IntegerArray new: self size.
	1 to: self size do:[:i| intArray at: i put: (self at: i)].
	^intArray! !

!SequenceableCollection methodsFor: 'splitjoin' stamp: 'BenComan 10/17/2013 15:14'!
joinUsing: joiner last: last 
	"#(1 2 3 4) joinUsing: ', ' last: 'and'. => '1, 2, 3 and 4"
	(self size = 0) ifTrue: [  ^ '' ].
	(self size = 1) ifTrue: [  ^ self first asString ].
	^ last join: (Array
				with: (joiner join: self allButLast)
				with: self last)! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'sma 4/22/2000 17:45'!
atAllPut: anObject 
	"Put anObject at every one of the receiver's indices."

	| size |
	(size := self size) > 26 "first method faster from 27 accesses and on"
		ifTrue: [self from: 1 to: size put: anObject]
		ifFalse: [1 to: size do: [:index | self at: index put: anObject]]! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'md 1/19/2006 09:56'!
middle
	"Answer the middle element of the receiver."
	^ self at: self size // 2 + 1! !

!SequenceableCollection methodsFor: 'testing' stamp: 'StephaneDucasse 3/28/2010 21:01'!
beginsWith: aSequenceableCollection
	"Answer true if the receiver starts with the argument collection"
	(aSequenceableCollection isEmpty or: [self size < aSequenceableCollection size]) ifTrue: [^false].
	aSequenceableCollection withIndexDo: [:each :index | (self at: index) ~= each ifTrue: [^false]].
	^true! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'SvenVanCaekenberghe 3/8/2012 13:58'!
findBinaryIndex: aBlock
	"Search for an element in the receiver using binary search.
	The argument aBlock is a one-element block returning
		0 	- if the element is the one searched for
		<0	- if the search should continue in the first half
		>0	- if the search should continue in the second half
	If no matching element is found, raise an error.
	Examples:
		#(1 3 5 7 11 15 23) findBinaryIndex: [ :arg | 11 - arg ]
	"
	^ self 
		findBinaryIndex: aBlock 
		do: [ :found | found ] 
		ifNone: [ self errorNotFound: aBlock ]! !

!SequenceableCollection methodsFor: 'sorting' stamp: ''!
sort
	"Sort this collection into ascending order using the '<=' operator."

	self sort: [:a :b | a <= b]! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'sma 5/12/2000 18:11'!
from: start to: stop do: aBlock
	"Evaluate aBlock for all elements between start and stop (inclusive)."

	start to: stop do: [:index | aBlock value: (self at: index)]! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'ward 7/28/97 09:41'!
permutationsDo: aBlock
	"Repeatly value aBlock with a single copy of the receiver. Reorder the copy
	so that aBlock is presented all (self size factorial) possible permutations."
	"(1 to: 4) permutationsDo: [:each | Transcript cr; show: each printString]"

	self shallowCopy permutationsStartingAt: 1 do: aBlock! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'di 5/17/1998 13:34'!
withIndexCollect: elementAndIndexBlock 
	"Just like with:collect: except that the iteration index supplies the second argument to the block."
	| result |
	result := self species new: self size.
	1 to: self size do:
		[:index | result at: index put:
		(elementAndIndexBlock
			value: (self at: index)
			value: index)].
	^ result! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'tk 7/30/97 12:41'!
asDigitsToPower: anInteger do: aBlock
	"Repeatedly value aBlock with a single Array.  Adjust the collection
	so that aBlock is presented all (self size raisedTo: anInteger) possible 
	combinations of the receiver's elements taken as digits of an anInteger long number."
	"(0 to: 1) asDigitsToPower: 4 do: [:each | Transcript cr; show: each printString]"

	| aCollection |
	aCollection := Array new: anInteger.
	self asDigitsAt: 1 in: aCollection do: aBlock! !

!SequenceableCollection methodsFor: 'enumerating' stamp: ''!
findLast: aBlock
	"Return the index of my last element for which aBlock evaluates as true."

	| index |
	index := self size + 1.
	[(index := index - 1) >= 1] whileTrue:
		[(aBlock value: (self at: index)) ifTrue: [^index]].
	^ 0! !

!SequenceableCollection methodsFor: 'converting' stamp: 'lr 5/13/2010 16:25'!
reverse
	"Answer a copy of the receiver with element order reversed, as expected by ANSI."

	^ self reversed! !

!SequenceableCollection methodsFor: 'accessing' stamp: ''!
swap: oneIndex with: anotherIndex 
	"Move the element at oneIndex to anotherIndex, and vice-versa."

	| element |
	element := self at: oneIndex.
	self at: oneIndex put: (self at: anotherIndex).
	self at: anotherIndex put: element! !

!SequenceableCollection methodsFor: 'accessing' stamp: ''!
replaceFrom: start to: stop with: replacement 
	"This destructively replaces elements from start to stop in the receiver. 
	Answer the receiver itself. Use copyReplaceFrom:to:with: for 
	insertion/deletion which may alter the size of the result."

	replacement size = (stop - start + 1)
		ifFalse: [self error: 'Size of replacement doesnt match'].
	^self replaceFrom: start to: stop with: replacement startingAt: 1! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'MaxLeske 9/16/2014 10:11'!
size
	^ self subclassResponsibility! !

!SequenceableCollection methodsFor: 'splitjoin' stamp: 'CamilloBruni 1/19/2013 12:41'!
splitOn: splitter indicesDo: aBlock
	"splitter - can be a subsequence, a Block or a Regex (String receiver only).
	Any other object used as a splitter is treated as an Array containing that object."
	^ splitter split: self indicesDo: aBlock! !

!SequenceableCollection methodsFor: '*Morphic-Base-Pluggable Widgets' stamp: 'BenjaminVanRyseghem 2/12/2012 15:14'!
detectIndex: aBlock ifNone: exceptionBlock

	self doWithIndex: [:each :index | (aBlock value: each) ifTrue: [^ index]].
	^ exceptionBlock value! !

!SequenceableCollection methodsFor: 'testing' stamp: 'sma 5/12/2000 14:08'!
includes: anObject
	"Answer whether anObject is one of the receiver's elements."

	^ (self indexOf: anObject) ~= 0! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'JMM 10/30/2005 09:21'!
ninth
	"Answer the ninth element of the receiver.
	Raise an error if there are not enough elements."

	^ self at: 9! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'ar 5/1/1999 05:01'!
do: aBlock without: anItem
	"Enumerate all elements in the receiver.
	Execute aBlock for those elements that are not equal to the given item"
	"Refer to the comment in Collection|do:."
	1 to: self size do:
		[:index | anItem = (self at: index) ifFalse:[aBlock value: (self at: index)]]! !

!SequenceableCollection methodsFor: '*Graphics-Display Objects' stamp: 'ar 3/3/2001 20:06'!
asColorArray
	^ColorArray withAll: self! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'nk 8/23/2003 10:42'!
nextToLast
	^self at: self size - 1! !

!SequenceableCollection methodsFor: '*Spec-Tools' stamp: 'BenjaminVanRyseghem 10/3/2012 14:36'!
subObjectsToInspect
	| element |
	
	element := self collect:[ :e | e ].

	^ super subObjectsToInspect, element! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'di 11/12/1998 15:01'!
pairsCollect: aBlock 
	"Evaluate aBlock with my elements taken two at a time, and return an Array with the results"

	^ (1 to: self size // 2) collect:
		[:index | aBlock value: (self at: 2 * index - 1) value: (self at: 2 * index)]
"
#(1 'fred' 2 'charlie' 3 'elmer') pairsCollect:
	[:a :b | b, ' is number ', a printString]
"! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'sma 5/12/2000 12:50'!
atRandom: aGenerator
	"Answer a random element of the receiver.  Uses aGenerator which
	should be kept by the user in a variable and used every time. Use
	this instead of #atRandom for better uniformity of random numbers 
	because only you use the generator.  Causes an error if self has no 
	elements."

	^ self at: (aGenerator nextInt: self size)! !

!SequenceableCollection methodsFor: '*Kernel-Extensions' stamp: 'kph 9/27/2007 21:18'!
putOn: aStream

	self do: [ :each | each putOn: aStream ]! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'StephaneDucasse 5/28/2011 13:41'!
before: target ifAbsent: exceptionBlock
	"Answer the receiver's element immediately before target. Answer
	the result of evaluating the exceptionBlock if target is not an element
	of the receiver, or if there are no elements before it."

	| index |
	index := self indexOf: target.
	^ (index = 0 or: [index = 1])
		ifTrue: [exceptionBlock value]
		ifFalse: [self at: index - 1]! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'apb 11/4/2000 22:51'!
atAll: indexArray
	"Answer a new collection like the receiver which contains all elements
	of the receiver at the indices of indexArray."
	"#('one' 'two' 'three' 'four') atAll: #(3 2 4)"

	| newCollection |
	newCollection := self species ofSize: indexArray size.
	1 to: indexArray size do:
		[:index |
		newCollection at: index put: (self at: (indexArray at: index))].
	^ newCollection! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'StephaneDucasse 9/18/2010 21:18'!
indexOf: anElement startingAt: start
       "Answer the index of the first occurence of anElement after start within the receiver. If the receiver does not contain anElement, answer 0."

	^self indexOf: anElement startingAt: start ifAbsent: 0! !

!SequenceableCollection methodsFor: 'converting' stamp: 'ar 10/10/1998 16:20'!
asWordArray
	"Answer a WordArray whose elements are the elements of the receiver, in 
	the same order."

	| wordArray |
	wordArray := WordArray new: self size.
	1 to: self size do:[:i| wordArray at: i put: (self at: i)].
	^wordArray! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'sma 6/1/2000 15:47'!
indexOf: anElement startingAt: start ifAbsent: exceptionBlock
	"Answer the index of the first occurence of anElement after start
	within the receiver. If the receiver does not contain anElement, 
	answer the 	result of evaluating the argument, exceptionBlock."

	start to: self size do:
		[:index |
		(self at: index) = anElement ifTrue: [^ index]].
	^ exceptionBlock value! !

!SequenceableCollection methodsFor: 'private' stamp: 'sma 5/12/2000 13:57'!
checkedAt: index
	index > self size ifTrue: [self error: 'not enough elements'].
	^ self at: index! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'di 11/12/1998 15:01'!
pairsDo: aBlock 
	"Evaluate aBlock with my elements taken two at a time.  If there's an odd number of items, ignore the last one.  Allows use of a flattened array for things that naturally group into pairs.  See also pairsCollect:"

	1 to: self size // 2 do:
		[:index | aBlock value: (self at: 2 * index - 1) value: (self at: 2 * index)]
"
#(1 'fred' 2 'charlie' 3 'elmer') pairsDo:
	[:a :b | Transcript cr; show: b, ' is number ', a printString]
"! !

!SequenceableCollection methodsFor: 'copying' stamp: 'md 7/14/2006 12:11'!
, otherCollection 
	"Concatenate two Strings or Collections."
	
	^ self copyReplaceFrom: self size + 1
		  to: self size
		  with: otherCollection
"
#(2 4 6 8) , #(who do we appreciate)
((2989 storeStringBase: 16) copyFrom: 4 to: 6) , ' boy!!'
"! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'ar 12/16/2001 01:05'!
lastIndexOf: anElement startingAt: lastIndex ifAbsent: exceptionBlock
	"Answer the index of the last occurence of anElement within the  
	receiver. If the receiver does not contain anElement, answer the
	result of evaluating the argument, exceptionBlock."

	lastIndex to: 1 by: -1 do:
		[:index |
		(self at: index) = anElement ifTrue: [^ index]].
	^ exceptionBlock value! !

!SequenceableCollection methodsFor: 'private' stamp: 'sma 5/12/2000 18:06'!
errorFirstObject: anObject
	self error: 'specified object is first object'! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'sma 5/12/2000 12:18'!
atAll: indexArray putAll: valueArray
	"Store the elements of valueArray into the slots
	of this collection selected by indexArray."

	indexArray with: valueArray do: [:index :value | self at: index put: value].
	^ valueArray! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'sma 5/12/2000 11:46'!
collect: aBlock 
	"Evaluate aBlock with each of the receiver's elements as the argument.  
	Collect the resulting values into a collection like the receiver. Answer  
	the new collection."

	| newCollection |
	newCollection := self species new: self size.
	1 to: self size do:
		[:index |
		newCollection at: index put: (aBlock value: (self at: index))].
	^ newCollection! !

!SequenceableCollection methodsFor: 'converting' stamp: 'sma 5/12/2000 12:52'!
writeStream
	^ WriteStream on: self! !

!SequenceableCollection methodsFor: 'converting' stamp: 'raok 6/23/2003 12:51'!
concatenation
	|result index|

	result := Array new: (self inject: 0 into: [:sum :each | sum + each size]).
	index := 0.
	self do: [:each | each do: [:item | result at: (index := index+1) put: item]].
	^result! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'sma 6/1/2000 15:35'!
allButLast: n
	"Answer a copy of the receiver containing all but the last n
	elements. Raise an error if there are not enough elements."

	^ self copyFrom: 1 to: self size - n! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'md 1/19/2006 09:57'!
first
	"Answer the first element of the receiver"

	^ self at: 1! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'nice 12/9/2009 14:55'!
indexOfAnyOf: aCollection
	"Answer the index of the first occurence of any element included in aCollection within the receiver.
	If the receiver does not contain anElement, answer zero, which is an invalid index."

	^self indexOfAnyOf: aCollection startingAt: 1 ifAbsent: [0]! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'ar 12/16/2001 01:06'!
lastIndexOf: anElement ifAbsent: exceptionBlock
	"Answer the index of the last occurence of anElement within the  
	receiver. If the receiver does not contain anElement, answer the
	result of evaluating the argument, exceptionBlock."
	^self lastIndexOf: anElement startingAt: self size ifAbsent: exceptionBlock! !

!SequenceableCollection methodsFor: 'testing' stamp: 'StephaneDucasse 3/28/2010 21:07'!
beginsWithAnyOf: aCollection
	"Return true if the receiver starts with any of the elements in aCollection."
	^aCollection anySatisfy:[:prefix| self beginsWith: prefix]! !

!SequenceableCollection methodsFor: '*opalcompiler-core' stamp: 'kwl 6/25/2006 19:07'!
literalIndexOf: anElement ifAbsent: exceptionBlock
	"Answer the index of anElement within the receiver. If the receiver does 
	not contain anElement, answer the result of evaluating the argument, 
	exceptionBlock."
	1 to: self size do:
		[:i | ((self at: i) literalEqual: anElement) ifTrue: [^ i]].
	^ exceptionBlock value! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'sma 6/1/2000 15:31'!
first: n
	"Answer the first n elements of the receiver.
	Raise an error if there are not enough elements."

	^ self copyFrom: 1 to: n! !

!SequenceableCollection methodsFor: 'private' stamp: 'sma 5/12/2000 18:03'!
errorLastObject: anObject
	self error: 'specified object is last object'! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'DamienPollet 8/6/2014 16:49'!
reverseWithIndexDo: elementAndIndexBlock 
	"Just like reverseWith:do: except that the iteration index supplies the second argument to the block."
	self size to: 1 by: -1 do: [:index |
		elementAndIndexBlock
			value: (self at: index)
			value: index]! !

!SequenceableCollection methodsFor: 'copying' stamp: 'sma 6/1/2000 16:05'!
copyAfter: anElement
	"Answer a copy of the receiver from after the first occurence
	of anElement up to the end. If no such element exists, answer 
	an empty copy."

	^ self allButFirst: (self indexOf: anElement ifAbsent: [^ self copyEmpty])! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'sma 5/12/2000 13:52'!
atWrap: index put: value
	"Store value into the index'th element of the receiver.  If index is out
	of bounds, let it wrap around from the end to the beginning until it 
	is in bounds. Answer value."

	^ self at: index  - 1 \\ self size + 1 put: value! !

!SequenceableCollection methodsFor: 'copying' stamp: 'CamilloBruni 6/22/2012 21:16'!
grownBy: length
	"Answer a copy of receiver collection with size grown by length"

	| newCollection size |
	size := self size.
	newCollection := self species ofSize: size + length.
	newCollection replaceFrom: 1 to: size with: self startingAt: 1.
	^ newCollection! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'nice 11/16/2009 10:31'!
lastIndexOfAnyOf: aCollection startingAt: lastIndex ifAbsent: exceptionBlock
	"Answer the index of the last occurence of anElement within the  
	receiver. If the receiver does not contain anElement, answer the
	result of evaluating the argument, exceptionBlock."

	lastIndex to: 1 by: -1 do:
		[:index |
		(aCollection includes: (self at: index)) ifTrue: [^ index]].
	^ exceptionBlock value! !

!SequenceableCollection methodsFor: 'copying' stamp: ''!
copyWith: newElement 
	"Answer a copy of the receiver that is 1 bigger than the receiver and has 
	newElement at the last element."

	| newIC |
	newIC := self species new: self size + 1.
	newIC 
		replaceFrom: 1
		to: self size
		with: self
		startingAt: 1.
	newIC at: newIC size put: newElement.
	^newIC! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'tk 7/30/97 12:52'!
combinations: kk atATimeDo: aBlock
	"Take the items in the receiver, kk at a time, and evaluate the block for each combination.  Hand in an array of elements of self as the block argument.  Each combination only occurs once, and order of the elements does not matter.  There are (self size take: kk) combinations."
	" 'abcde' combinations: 3 atATimeDo: [:each | Transcript cr; show: each printString]"

	| aCollection |
	aCollection := Array new: kk.
	self combinationsAt: 1 in: aCollection after: 0 do: aBlock! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'sma 6/1/2000 11:47'!
collect: aBlock from: firstIndex to: lastIndex
	"Refer to the comment in Collection|collect:."

	| size result j |
	size := lastIndex - firstIndex + 1.
	result := self species new: size.
	j := firstIndex.
	1 to: size do: [:i | result at: i put: (aBlock value: (self at: j)). j := j + 1].
	^ result! !

!SequenceableCollection methodsFor: 'copying' stamp: 'nice 2/24/2009 11:33'!
forceTo: length paddingWith: elem
	"Force the length of the collection to length, padding
	if necessary with elem.  Note that this makes a copy."

	| newCollection |
	newCollection := self species new: length withAll: elem.
	newCollection replaceFrom: 1 to: (self size min: length) with: self startingAt: 1.
	^ newCollection! !

!SequenceableCollection methodsFor: 'splitjoin' stamp: 'CamilloBruni 1/19/2013 12:41'!
split: aSequenceableCollection indicesDo: aBlock
	
	"Split a collection by myself as a delimitier.
	see Object >> split: for optimized version for single delimiters.
	Example:
		'||' split: 'foo||bar||2'"
	
	| position oldPosition |
	
	position := 1.
	oldPosition := position.
	position := aSequenceableCollection indexOfSubCollection: self startingAt: position.
	
	[ position > 0 ] whileTrue: [
		aBlock value: oldPosition value: position - 1.
		position := position + self size.
		oldPosition := position.
		position := aSequenceableCollection indexOfSubCollection: self startingAt: position.
	].

	aBlock value: oldPosition value: aSequenceableCollection size.

! !

!SequenceableCollection methodsFor: 'enumerating' stamp: ''!
do: aBlock 
	"Refer to the comment in Collection|do:."
	1 to: self size do:
		[:index | aBlock value: (self at: index)]! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'nice 12/9/2009 14:57'!
indexOfAnyOf: aCollection startingAt: start ifAbsent: exceptionBlock
	"Answer the index of the first occurence of any element included in aCollection after start within the receiver.
	If the receiver does not contain anElement, answer the result of evaluating the argument, exceptionBlock.
	Note: it is user responsibility to provide aCollection that behaves relatevily fast when asked for includes: (like a Set)"

	start to: self size do:
		[:index |
		(aCollection includes: (self at: index)) ifTrue: [^ index]].
	^ exceptionBlock value! !

!SequenceableCollection methodsFor: 'private' stamp: 'tk 7/30/97 12:42'!
asDigitsAt: anInteger in: aCollection do: aBlock
	"(0 to: 1) asDigitsToPower: 4 do: [:each | Transcript cr; show: each printString]"

	self do: 
		[:each | 
		aCollection at: anInteger put: each.
		anInteger = aCollection size 
			ifTrue: [aBlock value: aCollection]
			ifFalse: [self asDigitsAt: anInteger + 1 in: aCollection do: aBlock]].! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'MarcusDenker 9/29/2014 15:12'!
with: otherCollection collect: twoArgBlock 
	"Collect and return the result of evaluating twoArgBlock with corresponding elements from this collection and otherCollection."
	| result |
	otherCollection size = self size ifFalse: [self errorSizeMismatch].
	result := self species new: self size.
	1 to: self size do:
		[:index | result at: index put:
		(twoArgBlock
			value: (self at: index)
			value: (otherCollection at: index))].
	^ result! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'md 1/19/2006 09:56'!
last
	"Answer the last element of the receiver"

	^ self at: self size! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'nice 12/9/2009 14:55'!
indexOfAnyOf: aCollection ifAbsent: exceptionBlock
	"Answer the index of the first occurence of any element included in aCollection within the receiver.
	If the receiver does not contain anElement, answer the result of evaluating the argument, exceptionBlock."

	^self indexOfAnyOf: aCollection startingAt: 1 ifAbsent: exceptionBlock! !

!SequenceableCollection methodsFor: 'copying' stamp: 'MaxLeske 10/30/2013 13:36'!
shuffled
	^ self copy shuffle! !

!SequenceableCollection methodsFor: 'copying' stamp: 'sma 6/1/2000 16:06'!
copyLast: num
	"Deprecated. Use #last:"

	^ self last: num! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'ajh 8/6/2002 15:03'!
allButFirstDo: block

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

!SequenceableCollection methodsFor: '*Morphic-Base-Pluggable Widgets' stamp: 'BenjaminVanRyseghem 2/12/2012 15:14'!
detectIndex: aBlock

	^ self detectIndex: aBlock ifNone: [ self errorNotFound: aBlock ] ! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'nk 6/12/2004 17:06'!
atLast: indexFromEnd
	"Return element at indexFromEnd from the last position.
	 atLast: 1, returns the last element"

	^ self atLast: indexFromEnd ifAbsent: [self error: 'index out of range']! !

!SequenceableCollection methodsFor: 'copying' stamp: 'ajh 9/27/2002 12:09'!
copyWithFirst: newElement 
	"Answer a copy of the receiver that is 1 bigger than the receiver with newElement as the first element."

	| newIC |
	newIC := self species ofSize: self size + 1.
	newIC 
		replaceFrom: 2
		to: self size + 1
		with: self
		startingAt: 1.
	newIC at: 1 put: newElement.
	^ newIC! !

!SequenceableCollection methodsFor: 'sorting' stamp: ''!
mergeSortFrom: startIndex to: stopIndex by: aBlock
	"Sort the given range of indices using the mergesort algorithm.
	Mergesort is a worst-case O(N log N) sorting algorithm that usually
	does only half as many comparisons as heapsort or quicksort."

	"Details: recursively split the range to be sorted into two halves,
	mergesort each half, then merge the two halves together. An extra 
	copy of the data is used as temporary storage and successive merge 
	phases copy data back and forth between the receiver and this copy.
	The recursion is set up so that the final merge is performed into the
	receiver, resulting in the receiver being completely sorted."

	self size <= 1 ifTrue: [^ self].  "nothing to do"
	startIndex = stopIndex ifTrue: [^ self].
	[startIndex >= 1 and: [startIndex < stopIndex]] assert. "bad start index"
	[stopIndex <= self size] assert. "bad stop index"
	self
		mergeSortFrom: startIndex
		to: stopIndex 
		src: self copy 
		dst: self 
		by: aBlock! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'JMM 10/30/2005 09:22'!
sixth
	"Answer the sixth element of the receiver.
	Raise an error if there are not enough elements."

	^ self at: 6! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'SvenVanCaekenberghe 3/8/2012 13:55'!
findBinary: aBlock ifNone: exceptionBlock
	"Search for an element in the receiver using binary search.
	The argument aBlock is a one-element block returning
		0 	- if the element is the one searched for
		<0	- if the search should continue in the first half
		>0	- if the search should continue in the second half
	If no matching element is found, evaluate exceptionBlock,
	with the 'bounding' elements as optional arguments."
	
	^ self 
		findBinary: aBlock 
		do: [ :found | found ] 
		ifNone: exceptionBlock! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'nice 4/19/2011 00:07'!
after: target ifAbsent: exceptionBlock
	"Answer the element after target.  Answer the result of evaluation
	the exceptionBlock if target is not in the receiver, or if there are 
	no elements after it."

	| index |
	index := self indexOf: target.
	^ (index = 0 or: [index = self size])
		ifTrue: [exceptionBlock value]
		ifFalse: [self at: index + 1]! !

!SequenceableCollection methodsFor: 'testing' stamp: 'StephaneDucasse 3/28/2010 21:01'!
endsWith: aSequenceableCollection
	"Answer true if the receiver ends with the argument collection"
	
	| start |
	(aSequenceableCollection isEmpty or: [self size < aSequenceableCollection size]) ifTrue: [^false].
	start := self size - aSequenceableCollection size.
	aSequenceableCollection withIndexDo: [:each :index | (self at: start + index) ~= each ifTrue: [^false]].
	^true! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'CamilloBruni 3/22/2013 22:36'!
reject: rejectBlock thenDo: aBlock
	"Refer to the comment in Collection>>#reject:thenDo:"
	
	|  each |
	
	1 to: self size do: [ :index |
		(rejectBlock value: (each := self at: index))
			ifFalse: [ aBlock value: each ]].! !

!SequenceableCollection methodsFor: 'private' stamp: 'ward 7/28/97 09:38'!
permutationsStartingAt: anInteger do: aBlock
	"#(1 2 3 4) permutationsDo: [:each | Transcript cr; show: each printString]"

	anInteger > self size ifTrue: [^self].
	anInteger = self size ifTrue: [^aBlock value: self].
	anInteger to: self size do:
		[:i | self swap: anInteger with: i.
		self permutationsStartingAt: anInteger + 1 do: aBlock.
		self swap: anInteger with: i]! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'ar 1/20/98 16:22'!
replaceAll: oldObject with: newObject 
	"Replace all occurences of oldObject with newObject"
	| index |
	index := self
				indexOf: oldObject
				startingAt: 1
				ifAbsent: [0].
	[index = 0]
		whileFalse: 
			[self at: index put: newObject.
			index := self
						indexOf: oldObject
						startingAt: index + 1
						ifAbsent: [0]]! !

!SequenceableCollection methodsFor: 'copying' stamp: 'sma 6/1/2000 16:00'!
copyUpTo: anElement 
	"Answer all elements up to but not including anObject. If there
	is no such object, answer a copy of the receiver."

	^ self first: (self indexOf: anElement ifAbsent: [^ self copy]) - 1! !

!SequenceableCollection methodsFor: 'splitjoin' stamp: 'CamilloBruni 1/19/2013 12:41'!
splitOn: splitter do: aBlock
	"splitter - can be a subsequence, a Block or a Regex (String receiver only).
	Any other object used as a splitter is treated as an Array containing that object."
	^ splitter split: self do: aBlock! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'CamilloBruni 3/22/2013 22:30'!
reject: rejectBlock thenCollect: collectBlock
	"Optimized version of Collection>>#reject:thenCollect:"
	
	| each |

	^ self class new: self size streamContents: [ :stream|
		1 to: self size do: [ :index |
			(rejectBlock value: (each := self at: index))
				ifFalse: [ stream nextPut: (collectBlock value: each) ]]]! !

!SequenceableCollection methodsFor: '*NewValueHolder' stamp: 'BenjaminVanRyseghem 1/24/2014 16:07'!
asValueHolder

	^ CollectionValueHolder value: self! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'CamilloBruni 3/22/2013 22:29'!
collect: collectBlock thenReject: rejectBlock
	"Optimized version of Collection>>#thenReject:"
	
	| each |
	
	^  self class new: self size streamContents: [ :stream |
		1 to: self size do: [:index |
			each := collectBlock value: (self at: index).
			(rejectBlock value: each)
				ifFalse: [ stream nextPut: each ]]]! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'MarcusDenker 9/29/2014 15:12'!
with: otherCollection do: twoArgBlock 
	"Evaluate twoArgBlock with corresponding elements from this collection and otherCollection."
	otherCollection size = self size ifFalse: [self errorSizeMismatch].
	1 to: self size do:
		[:index |
		twoArgBlock value: (self at: index)
				value: (otherCollection at: index)]! !

!SequenceableCollection methodsFor: 'sorting' stamp: ''!
sort: aSortBlock 
	"Sort this array using aSortBlock. The block should take two arguments
	and return true if the first element should preceed the second one."

	self
		mergeSortFrom: 1
		to: self size
		by: aSortBlock! !

!SequenceableCollection methodsFor: 'accessing' stamp: ''!
replaceFrom: start to: stop with: replacement startingAt: repStart 
	"This destructively replaces elements from start to stop in the receiver 
	starting at index, repStart, in the sequenceable collection, 
	replacementCollection. Answer the receiver. No range checks are 
	performed."

	| index repOff |
	repOff := repStart - start.
	index := start - 1.
	[(index := index + 1) <= stop]
		whileTrue: [self at: index put: (replacement at: repOff + index)]! !

!SequenceableCollection methodsFor: 'accessing' stamp: ''!
indexOfSubCollection: aSubCollection startingAt: anIndex 
	"Answer the index of the receiver's first element, such that that element 
	equals the first element of aSubCollection, and the next elements equal 
	the rest of the elements of aSubCollection. Begin the search at element 
	anIndex of the receiver. If no such match is found, answer 0."

	^self
		indexOfSubCollection: aSubCollection
		startingAt: anIndex
		ifAbsent: [0]! !

!SequenceableCollection methodsFor: 'converting' stamp: 'sma 5/12/2000 17:36'!
asByteArray
	"Answer a ByteArray whose elements are the elements of the receiver."

	^ ByteArray withAll: self! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'sma 6/1/2000 15:47'!
indexOf: anElement ifAbsent: exceptionBlock
	"Answer the index of the first occurence of anElement within the  
	receiver. If the receiver does not contain anElement, answer the 
	result of evaluating the argument, exceptionBlock."

	^ self indexOf: anElement startingAt: 1 ifAbsent: exceptionBlock! !

!SequenceableCollection methodsFor: '*GT-Playground' stamp: 'StefanReichhart 3/21/2015 09:52'!
takeFirst: anInteger
	^ self first: (self size min: anInteger)! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'sma 6/1/2000 15:35'!
allButFirst: n
	"Answer a copy of the receiver containing all but the first n
	elements. Raise an error if there are not enough elements."

	^ self copyFrom: n + 1 to: self size! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'di 7/13/97 09:35'!
withIndexDo: elementAndIndexBlock 
	"Just like with:do: except that the iteration index supplies the second argument to the block."
	1 to: self size do:
		[:index |
		elementAndIndexBlock
			value: (self at: index)
			value: index]! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'ar 3/3/2001 22:43'!
integerAt: index put: value
	"Return the integer at the given index"
	^self at: index put: value! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'di 11/6/1998 14:32'!
atPin: index 
	"Return the index'th element of me if possible.
	Return the first or last element if index is out of bounds."

	index < 1 ifTrue: [^ self first].
	index > self size ifTrue: [^ self last].
	^ self at: index! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'ajh 6/27/2002 18:10'!
atLast: indexFromEnd put: obj
	"Set the element at indexFromEnd from the last position.
	 atLast: 1 put: obj, sets the last element"

	^ self at: self size + 1 - indexFromEnd put: obj! !

!SequenceableCollection methodsFor: 'converting' stamp: 'jm 4/27/98 04:09'!
reversed
	"Answer a copy of the receiver with element order reversed."
	"Example: 'frog' reversed"

	| n result src |
	n := self size.
	result := self species new: n.
	src := n + 1.
	1 to: n do: [:i | result at: i put: (self at: (src := src - 1))].
	^ result
! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'sma 5/12/2000 12:11'!
at: index ifAbsent: exceptionBlock 
	"Answer the element at my position index. If I do not contain an element 
	at index, answer the result of evaluating the argument, exceptionBlock."

	(index between: 1 and: self size) ifTrue: [^ self at: index].
	^ exceptionBlock value! !

!SequenceableCollection methodsFor: 'shuffling' stamp: 'MaxLeske 10/30/2013 13:35'!
shuffle
	^ self shuffleBy: Random new! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'nice 12/9/2009 14:54'!
indexOfAnyOf: aCollection startingAt: start
	"Answer the index of the first occurence of any element included in aCollection after start within the receiver.
	If the receiver does not contain anElement, answer zero, which is an invalid index."

	^self indexOfAnyOf: aCollection startingAt: start ifAbsent: [0]! !

!SequenceableCollection methodsFor: 'shuffling' stamp: 'StephaneDucasse 7/10/2010 18:26'!
shuffleBy: aRandom
	"Durstenfeld's version of the Fisher-Yates shuffle"

	self size to: 2 by: -1 do: [ :i | 
		self swap: i with: (aRandom nextInt: i) ]! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'MarcusDenker 9/29/2014 15:13'!
select: selectBock thenDo: aBlock
	"Refer to the comment in Collection>>#select:thenDo:"
	
	| each |
	1 to: self size do: [ :index |
		(selectBock value: (each := self at: index))
			ifTrue: [ aBlock value: each ]].! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'nice 1/5/2010 15:59'!
groupsOf: n atATimeCollect: aBlock 
	"Evaluate aBlock with my elements taken n at a time. Ignore any 
	leftovers at the end. 
	Allows use of a flattened  
	array for things that naturally group into groups of n. 
	If aBlock has a single argument, pass it an array of n items, 
	otherwise, pass the items as separate arguments. 
	See also pairsDo:"
	| passArray |
	passArray := aBlock numArgs = 1.
	^(n
		to: self size
		by: n)
		collect: [:index | | args | 
			args := (self copyFrom: index - n + 1 to: index) asArray.
			passArray
				ifTrue: [aBlock value: args]
				ifFalse: [aBlock valueWithArguments: args]]! !

!SequenceableCollection methodsFor: 'removing' stamp: ''!
remove: oldObject ifAbsent: anExceptionBlock 
	"SequencableCollections cannot implement removing."

	self shouldNotImplement! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'sma 6/1/2000 15:34'!
allButFirst
	"Answer a copy of the receiver containing all but the first
	element. Raise an error if there are not enough elements."

	^ self allButFirst: 1! !

!SequenceableCollection methodsFor: 'copying' stamp: 'sma 6/1/2000 16:02'!
copyUpToLast: anElement
	"Answer a copy of the receiver from index 1 to the last occurrence of 
	anElement, not including anElement."

	^ self first: (self lastIndexOf: anElement ifAbsent: [^ self copy]) - 1! !

!SequenceableCollection methodsFor: 'copying' stamp: 'sma 6/1/2000 16:07'!
copyEmpty
	^ self species new: 0! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'nice 1/5/2010 15:59'!
groupsOf: n atATimeDo: aBlock 
	"Evaluate aBlock with my elements taken n at a time. Ignore any leftovers at the end.
	Allows use of a flattened 
	array for things that naturally group into groups of n.
	If aBlock has a single argument, pass it an array of n items,
	otherwise, pass the items as separate arguments.
	See also pairsDo:"
	| passArray |
	passArray := (aBlock numArgs = 1).
	n
		to: self size
		by: n
		do: [:index | | args | 
			args := (self copyFrom: index - n + 1 to: index) asArray.
			passArray ifTrue: [ aBlock value: args ]
				ifFalse: [ aBlock valueWithArguments: args ]].! !

!SequenceableCollection methodsFor: 'sorting' stamp: ''!
mergeSortFrom: first to: last src: src dst: dst by: aBlock
	"Private. Split the range to be sorted in half, sort each half, and 
	merge the two half-ranges into dst."

	| middle |
	first = last ifTrue: [^ self].
	middle := (first + last) // 2.
	self mergeSortFrom: first to: middle src: dst dst: src by: aBlock.
	self mergeSortFrom: middle + 1 to: last src: dst dst: src by: aBlock.
	src mergeFirst: first middle: middle last: last into: dst by: aBlock! !

!SequenceableCollection methodsFor: 'private' stamp: 'SvenVanCaekenberghe 4/21/2011 13:02'!
errorOutOfBounds

	SubscriptOutOfBounds signal! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'MarcusDenker 9/29/2014 15:14'!
reverseWith: aSequenceableCollection do: aBlock 
	"Evaluate aBlock with each of the receiver's elements, in reverse order, 
	along with the  corresponding element, also in reverse order, from 
	aSequencableCollection. "

	self size ~= aSequenceableCollection size ifTrue: [^ self errorSizeMismatch].
	self size to: 1 by: -1 do: [:index | 
			aBlock 
				value: (self at: index)
				value: (aSequenceableCollection at: index)]! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'JMM 10/30/2005 09:21'!
fifth
	"Answer the fifth element of the receiver.
	Raise an error if there are not enough elements."

	^ self at: 5! !

!SequenceableCollection methodsFor: 'comparing' stamp: 'sma 5/12/2000 14:04'!
= otherCollection 
	"Answer true if the receiver is equivalent to the otherCollection.
	First test for identity, then rule out different species and sizes of
	collections. As a last resort, examine each element of the receiver
	and the otherCollection."

	self == otherCollection ifTrue: [^ true].
	self species == otherCollection species ifFalse: [^ false].
	^ self hasEqualElements: otherCollection! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'sma 5/12/2000 13:51'!
atWrap: index 
	"Answer the index'th element of the receiver.  If index is out of bounds,
	let it wrap around from the end to the beginning until it is in bounds."

	^ self at: index - 1 \\ self size + 1! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'di 7/13/97 09:44'!
collectWithIndex: elementAndIndexBlock
	"Use the new version with consistent naming"
	^ self withIndexCollect: elementAndIndexBlock! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'tk 12/27/2000 09:53'!
polynomialEval: thisX
	| sum valToPower |
	"Treat myself as the coeficients of a polynomial in X.  Evaluate it with thisX.  First element is the constant and last is the coeficient for the highest power."
	"  #(1 2 3) polynomialEval: 2   "   "is 3*X^2 + 2*X + 1 with X = 2"

	sum := self first.
	valToPower := thisX.
	2 to: self size do: [:ind | 
		sum := sum + ((self at: ind) * valToPower).
		valToPower := valToPower * thisX].
	^ sum! !

!SequenceableCollection methodsFor: 'converting' stamp: 'di 11/6/1998 09:35'!
isSequenceable
	^ true! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'LukasRenggli 5/10/2010 12:58'!
reduceLeft: aBlock
	"Fold the result of the receiver from left to right into aBlock. The argument aBlock must take two or more arguments."

	"#(1 2 3) reduceLeft: [ :a :b | a - b ].
		--> ((1 - 2) - 3) = -4
	#(1 + 3 - 5) reduceLeft: [ :a :op :b | a perform: op with: b ].
		--> ((1 + 3) - 5) = -1"

	| arguments |
	self emptyCheck.
	arguments := Array new: aBlock argumentCount.
	(arguments size = 0 or: [ (self size + 1) \\ (arguments size - 1) > 0 ])
		ifTrue: [ self error: 'Collection size and block argument count do not match.' ].
	arguments at: 1 put: self first.
	2 to: self size by: arguments size - 1 do: [ :index |
		arguments
			replaceFrom: 2 to: arguments size with: self startingAt: index;
			at: 1 put: (aBlock valueWithArguments: arguments) ].
	^ arguments first! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'SvenVanCaekenberghe 3/8/2012 14:26'!
findBinaryIndex: aBlock do: actionBlock ifNone: exceptionBlock
	"Search for an element in the receiver using binary search.
	The argument aBlock is a one-element block returning
		0 	- if the element is the one searched for
		<0	- if the search should continue in the first half
		>0	- if the search should continue in the second half
	If found, evaluate actionBlock with the index as argument
	If no matching element is found, evaluate exceptionBlock,
	with the indexes of the 'bounding' elements as arguments.
	Warning: Might give invalid indexes, see examples below
	Examples:
		#(1 3 5 7 11 15 23)
			findBinaryIndex: [ :arg | 11 - arg ]
			do: [ :found | found ]
			ifNone: [ :a :b | 'between: ', {a. b} printString ]
		#(1 3 5 7 11 15 23)
			findBinaryIndex: [ :arg | 12 - arg ]
			do: [ :found | found ]
			ifNone: [ :a :b | 'between: ', {a. b} printString ]
		#(1 3 5 7 11 15 23)
			findBinaryIndex: [ :arg | 0.5 - arg ]
			do: [ :found | found ]
			ifNone: [ :a :b | 'between: ', {a. b} printString ]
		#(1 3 5 7 11 15 23)
			findBinaryIndex: [ :arg | 25 - arg ]
			do: [ :found | found ]
			ifNone: [ :a :b | 'between: ',{a. b} printString ] "
			
	| index low high test |
	low := 1.
	high := self size.
	[ index := high + low // 2.
	  low > high ] whileFalse: [
		test := aBlock value: (self at: index).
		test = 0 
			ifTrue: [ ^ actionBlock value: index ]
			ifFalse: [ test > 0
				ifTrue: [ low := index + 1 ]
				ifFalse: [ high := index - 1 ] ] ].
	^ exceptionBlock cull: high cull: low! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'SvenVanCaekenberghe 3/8/2012 13:57'!
findBinaryIndex: aBlock ifNone: exceptionBlock
	"Search for an element in the receiver using binary search.
	The argument aBlock is a one-element block returning
		0 	- if the element is the one searched for
		<0	- if the search should continue in the first half
		>0	- if the search should continue in the second half
	If no matching element is found, evaluate exceptionBlock,
	with the 'bounding' elements as optional arguments."

	^ self 
		findBinaryIndex: aBlock 
		do: [ :found | found ] 
		ifNone: exceptionBlock! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'nk 3/30/2002 12:45'!
paddedWith: otherCollection do: twoArgBlock 
	"Evaluate twoArgBlock with corresponding elements from this collection and otherCollection.
	Missing elements from either will be passed as nil."
	1 to: (self size max: otherCollection size) do:
		[:index | twoArgBlock value: (self at: index ifAbsent: [])
				value: (otherCollection at: index ifAbsent: [])]! !

!SequenceableCollection methodsFor: 'copying' stamp: 'nice 2/26/2009 11:48'!
forceTo: length paddingStartWith: elem 
	"Force the length of the collection to length, padding  
	the beginning of the result if necessary with elem.  
	Note that this makes a copy."
	| newCollection padLen |
	newCollection := self species ofSize: length.
	padLen := length - self size max: 0.
	newCollection
		from: 1
		to: padLen
		put: elem.
	newCollection
		replaceFrom: padLen + 1
		to: ((padLen + self size) min: length)
		with: self
		startingAt:  1.
	^ newCollection! !

!SequenceableCollection methodsFor: 'sorting' stamp: ''!
isSortedBy: aBlock
	"Return true if the receiver is sorted by the given criterion."

	| lastElm elm |
	self isEmpty ifTrue: [^ true].
	lastElm := self first.
	2 to: self size do: 
		[:index | 
		elm := self at: index.
		(aBlock value: lastElm value: elm) ifFalse: [^ false].
		lastElm := elm].
	^ true! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'sma 5/12/2000 18:00'!
after: target
	"Answer the element after target.  Raise an error if target is not
	in the receiver, or if there are no elements after it."

	^ self after: target ifAbsent: [self errorNotFound: target]! !

!SequenceableCollection methodsFor: 'copying' stamp: 'sma 6/1/2000 16:05'!
copyAfterLast: anElement
	"Answer a copy of the receiver from after the last occurence
	of anElement up to the end. If no such element exists, answer 
	an empty copy."

	^ self allButFirst: (self lastIndexOf: anElement ifAbsent: [^ self copyEmpty])! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'di 7/13/97 09:43'!
doWithIndex: elementAndIndexBlock
	"Use the new version with consistent naming"
	^ self withIndexDo: elementAndIndexBlock! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'ul 11/11/2009 19:38'!
replace: aBlock 
	"Evaluate aBlock with each of the receiver's elements as the argument.  
	Collect the resulting values into self."

	1 to: self size do: [ :index |
		self at: index put: (aBlock value: (self at: index)) ]! !

!SequenceableCollection methodsFor: 'converting' stamp: 'TAG 11/6/1998 15:55'!
@ aCollection 
	^ self with: aCollection collect: [:a :b | a @ b]! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'sma 6/1/2000 15:30'!
last: n
	"Answer the last n elements of the receiver.  
	Raise an error if there are not enough elements."

	| size |
	size := self size.
	^ self copyFrom: size - n + 1 to: size! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'sma 5/12/2000 12:17'!
atAll: aCollection put: anObject 
	"Put anObject at every index specified by the elements of aCollection."

	aCollection do: [:index | self at: index put: anObject].
	^ anObject! !

!SequenceableCollection methodsFor: 'copying' stamp: 'ar 10/16/2001 19:03'!
copyReplaceFrom: start to: stop with: replacementCollection 
	"Answer a copy of the receiver satisfying the following conditions: If 
	stop is less than start, then this is an insertion; stop should be exactly 
	start-1, start = 1 means insert before the first character, start = size+1 
	means append after last character. Otherwise, this is a replacement; start 
	and stop have to be within the receiver's bounds."

	| newSequenceableCollection newSize endReplacement |
	newSize := self size - (stop - start + 1) + replacementCollection size.
	endReplacement := start - 1 + replacementCollection size.
	newSequenceableCollection := self species new: newSize.
	start > 1 ifTrue:[
		newSequenceableCollection
			replaceFrom: 1
			to: start - 1
			with: self
			startingAt: 1].
	start <= endReplacement ifTrue:[
		newSequenceableCollection
			replaceFrom: start
			to: endReplacement
			with: replacementCollection
			startingAt: 1].
	endReplacement < newSize ifTrue:[
		newSequenceableCollection
			replaceFrom: endReplacement + 1
			to: newSize
			with: self
			startingAt: stop + 1].
	^newSequenceableCollection! !

!SequenceableCollection methodsFor: 'copying' stamp: 'sma 6/1/2000 15:38'!
copyWithoutFirst
	"Deprecatd. Return a copy of the receiver which doesn't include
	the first element."

	^ self allButFirst! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'SvenVanCaekenberghe 3/8/2012 14:24'!
findBinary: aBlock do: actionBlock ifNone: exceptionBlock
	"Search for an element in the receiver using binary search.
	The argument aBlock is a one-element block returning
		0 	- if the element is the one searched for
		<0	- if the search should continue in the first half
		>0	- if the search should continue in the second half
	If found, evaluate actionBlock with the found element as argument
	If no matching element is found, evaluate exceptionBlock,
	with the 'bounding' elements or nil as arguments.
	Examples:
		#(1 3 5 7 11 15 23)
			findBinary: [ :arg | 11 - arg ]
			do: [ :found | found ]
			ifNone: [ :a :b | 'between: ', {a. b} printString ]
		#(1 3 5 7 11 15 23)
			findBinary: [ :arg | 12 - arg ]
			do: [ :found | found ]
			ifNone: [ :a :b | 'between: ', {a. b} printString ]
		#(1 3 5 7 11 15 23)
			findBinary: [ :arg | 0.5 - arg ]
			do: [ :found | found ]
			ifNone: [ :a :b | 'between: ', {a. b} printString ]
		#(1 3 5 7 11 15 23)
			findBinary: [ :arg | 25 - arg ]
			do: [ :found | found ]
			ifNone: [ :a :b | 'between: ',{a. b} printString ] "
	
	^ self
		findBinaryIndex: aBlock
		do: [ :foundIndex |
			actionBlock value: (self at: foundIndex) ]
		ifNone: [ :prevIndex :nextIndex |
			exceptionBlock
				cull: (prevIndex > 0 ifTrue: [ self at: prevIndex ])
				cull: (nextIndex <= self size ifTrue: [ self at: nextIndex ]) ]
! !

!SequenceableCollection methodsFor: 'enumerating' stamp: ''!
reverseDo: aBlock
	"Evaluate aBlock with each of the receiver's elements as the argument, 
	starting with the last element and taking each in sequence up to the 
	first. For SequenceableCollections, this is the reverse of the enumeration 
	for do:."

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

!SequenceableCollection methodsFor: 'copying' stamp: 'MarcusDenker 12/20/2010 16:00'!
copyUpThrough: anElement
    "Answer all elements up to and including anObject. If there
     is no such object, answer a copy of the receiver."

	^self first: (self indexOf: anElement ifAbsent: [^ self copy])! !

!SequenceableCollection methodsFor: '*Tool-Diff' stamp: 'MarcusDenker 10/4/2013 10:42'!
aggregateRuns: aBlock
	"Answer a new collection of the same species as the
	receiver with elements being collections (of the receiver
	species) containing those elements of the receiver
	for which the given block consecutively evaluates to
	the same object."

	| str eStr r|
	str := Array new writeStream.
	r := nil.
	eStr := Array new writeStream.
	self do: [:e | | t |
		(t := aBlock value: e) = r
			ifFalse: [r := t.
					eStr isEmpty
						ifFalse: [str nextPut: (eStr contents as: self species).
								eStr reset]].
				eStr nextPut: e].
	eStr isEmpty ifFalse: [str nextPut: (eStr contents as: self species)].
	^str contents as: self species
	! !

!SequenceableCollection methodsFor: '*Balloon' stamp: 'NS 5/30/2001 20:56'!
asPointArray
	"Answer an PointArray whose elements are the elements of the receiver, in 
	the same order."

	| pointArray |
	pointArray := PointArray new: self size.
	1 to: self size do:[:i| pointArray at: i put: (self at: i)].
	^pointArray! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'MarcusDenker 5/27/2014 10:46'!
indexOf: anElement
	"Answer the index of the first occurrence of anElement within the  
	receiver. If the receiver does not contain anElement, answer 0."

	^ self indexOf: anElement ifAbsent: 0! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'nk 7/17/2003 17:55'!
overlappingPairsDo: aBlock 
	"Emit overlapping pairs of my elements into aBlock"

	1 to: self size - 1
		do: [:i | aBlock value: (self at: i) value: (self at: i + 1)]! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'raok 11/22/2002 12:34'!
at: index incrementBy: value
	^self at: index put: (self at: index) + value! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'StephaneDucasse 1/2/2012 21:09'!
reduce: aBlock
	"Fold the result of the receiver into aBlock. The argument aBlock must take two or more arguments. It applies the argument, binaryBlock cumulatively to the elements of the receiver. For sequenceable collections the elements will be used in order, for unordered collections the order is unspecified."
	
	"#(1 2 3) reduce: [ :a :b | a + b ]
		--> 1 + 2 + 3 = 6
	#(1 2 3 4 5) reduce: [ :a :b :c | a + b + c ]
		--> 1 + 2 + 3 + 4 + 5 = 15"
		
	^ self reduceLeft: aBlock! !

!SequenceableCollection methodsFor: '*Traits' stamp: 'apb 8/22/2005 17:07'!
asTraitComposition
	"For convenience the composition {T1. T2 ...} is the same as T1 + T2 + ..."
	^self isEmpty
		ifFalse: [
			self size = 1
				ifTrue: [self first asTraitComposition]
				ifFalse: [
					self copyWithoutFirst 
						inject: self first
						into: [:left :right | left + right]]]
		ifTrue: [
			TraitComposition new]! !

!SequenceableCollection methodsFor: 'private' stamp: 'tk 7/30/97 12:42'!
combinationsAt: jj in: aCollection after: nn do: aBlock
	"Choose k of N items and put in aCollection.  jj-1 already chosen.  Indexes of items are in numerical order, to avoid the same combo being used twice.  In this slot, we are allowed to use items in self indexed by nn+1 to self size.  nn is the index used for position jj-1."
	"(1 to: 6) combinationsSize: 3 do: [:each | Transcript cr; show: each printString]"

nn+1 to: self size do: [:index | 
		aCollection at: jj put: (self at: index).
		jj = aCollection size 
			ifTrue: [aBlock value: aCollection]
			ifFalse: [self combinationsAt: jj + 1 in: aCollection after: index do: aBlock]].! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'ajh 8/6/2002 15:01'!
allButLastDo: block

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

!SequenceableCollection methodsFor: 'accessing' stamp: 'sma 5/12/2000 11:33'!
anyOne
	^ self first! !

!SequenceableCollection methodsFor: 'accessing' stamp: ''!
indexOfSubCollection: sub startingAt: start ifAbsent: exceptionBlock
	"Answer the index of the receiver's first element, such that that element 
	equals the first element of sub, and the next elements equal 
	the rest of the elements of sub. Begin the search at element 
	start of the receiver. If no such match is found, answer the result of 
	evaluating argument, exceptionBlock."
	| first index |
	sub isEmpty ifTrue: [^ exceptionBlock value].
	first := sub first.
	start to: self size - sub size + 1 do:
		[:startIndex |
		(self at: startIndex) = first ifTrue:
			[index := 1.
			[(self at: startIndex+index-1) = (sub at: index)]
				whileTrue:
				[index = sub size ifTrue: [^startIndex].
				index := index+1]]].
	^ exceptionBlock value! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'ar 3/3/2001 22:43'!
integerAt: index
	"Return the integer at the given index"
	^self at: index! !

!SequenceableCollection methodsFor: 'enumerating' stamp: ''!
findFirst: aBlock
	"Return the index of my first element for which aBlock evaluates as true."

	| index |
	index := 0.
	[(index := index + 1) <= self size] whileTrue:
		[(aBlock value: (self at: index)) ifTrue: [^index]].
	^ 0! !

!SequenceableCollection methodsFor: 'sorting' stamp: ''!
sorted
	"Return a new sequenceable collection which contains the same elements as self but its 
elements are sorted in ascending order using the #'<=' operator."
	
	^self sorted: [ :a :b| a <= b ]! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'JMM 10/30/2005 09:21'!
seventh
	"Answer the seventh element of the receiver.
	Raise an error if there are not enough elements."

	^ self at: 7! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'JMM 10/30/2005 09:21'!
fourth
	"Answer the fourth element of the receiver.
	Raise an error if there are not enough elements."

	^ self at: 4! !

!SequenceableCollection methodsFor: 'copying' stamp: 'MarcusDenker 1/18/2014 14:08'!
copyReplaceAll: oldSubCollection with: newCollection
	"Answer a copy of the receiver in which all occurrences of
	oldSubCollection have been replaced by newCollection "

	| aString startSearch currentIndex endIndex |
	
	aString := self.
	startSearch := 1.
	[(currentIndex := aString indexOfSubCollection: oldSubCollection startingAt: startSearch) > 0]
		whileTrue: [
			endIndex := currentIndex + oldSubCollection size - 1.
			aString := aString
					copyReplaceFrom: currentIndex
					to: endIndex
					with: newCollection.
				startSearch := currentIndex + newCollection size].

	^ aString! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'nk 7/17/2003 17:54'!
overlappingPairsWithIndexDo: aBlock 
	"Emit overlapping pairs of my elements into aBlock, along with an index."

	1 to: self size - 1
		do: [:i | aBlock value: (self at: i) value: (self at: i + 1) value: i ]! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'ajh 6/27/2002 17:52'!
atLast: indexFromEnd ifAbsent: block
	"Return element at indexFromEnd from the last position.
	 atLast: 1 ifAbsent: [] returns the last element"

	^ self at: self size + 1 - indexFromEnd ifAbsent: block! !

!SequenceableCollection methodsFor: '*Spec-Tools' stamp: 'BenjaminVanRyseghem 10/3/2012 14:38'!
displaySubObjectAt: index
	| size |
	
	size := self class allInstVarNames size.
	^ index <= size
		ifTrue: [ self class allInstVarNames at: index ]
		ifFalse: [ ( index - size ) asString ]! !

!SequenceableCollection methodsFor: 'comparing' stamp: 'SqR 8/3/2000 13:39'!
hash
	| hash |

	hash := self species hash.
	1 to: self size do: [:i | hash := (hash + (self at: i) hash) hashMultiply].
	^hash! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'CamilloBruni 3/22/2013 22:30'!
collect: collectBlock thenSelect: selectBlock
	"Optimized version of Collection>>#collect:thenSelect:"
	
	| each |
	
	^  self class new: self size streamContents: [ :stream |
		1 to: self size do: [:index |
			each := collectBlock value: (self at: index).
			(selectBlock value: each)
				ifTrue: [ stream nextPut: each ]]]! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'MarcusDenker 9/29/2014 15:13'!
select: selectBlock thenCollect: collectBlock
	"Optimized version of Collection>>#select:thenCollect:"
	
	| each |
	^ self class new: self size streamContents: [ :stream|
		1 to: self size do: [ :index |
			(selectBlock value: (each := self at: index))
				ifTrue: [ stream nextPut: (collectBlock value: each) ]]]! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'JMM 10/30/2005 09:22'!
third
	"Answer the third element of the receiver.
	Raise an error if there are not enough elements."

	^ self at: 3! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'SqR 10/30/2000 22:06'!
from: startIndex to: endIndex put: anObject
	"Put anObject in all indexes between startIndex 
	and endIndex. Very fast. Faster than to:do: for
	more than 26 positions. Answer anObject"

	| written toWrite thisWrite |

	startIndex > endIndex ifTrue: [^self].
	self at: startIndex put: anObject.
	written := 1.
	toWrite := endIndex - startIndex + 1.
	[written < toWrite] whileTrue:
		[
			thisWrite := written min: toWrite - written.
			self 
				replaceFrom: startIndex + written
				to: startIndex + written + thisWrite - 1
				with: self startingAt: startIndex.
			written := written + thisWrite
		].
	^anObject! !

!SequenceableCollection methodsFor: 'converting' stamp: 'sma 5/12/2000 12:51'!
readStream
	^ ReadStream on: self! !

!SequenceableCollection methodsFor: '*Morphic-Widgets-Tabs' stamp: 'BenjaminVanRyseghem 6/18/2013 18:48'!
max: aBlock
	| max |
	
	self ifEmpty: [ ^ nil ].
	
	max := aBlock value: self first.
	
	self allButFirstDo: [ :each || value |
		value := aBlock value: each.
		value > max ifTrue: [ max := value ] ].
	
	^ max! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'JMM 10/30/2005 09:21'!
eighth
	"Answer the eighth element of the receiver.
	Raise an error if there are not enough elements."

	^ self at: 8! !

!SequenceableCollection methodsFor: 'converting' stamp: 'PeterHugossonMiller 9/3/2009 11:11'!
asStringWithCr
	"Convert to a string with returns between items.  Elements are
usually strings.
	 Useful for labels for PopUpMenus."
	| labelStream |
	labelStream := (String new: 200) writeStream.
	self do: [:each |
		each isString
			ifTrue: [labelStream nextPutAll: each; cr]
			ifFalse: [each printOn: labelStream. labelStream cr]].
	self size > 0 ifTrue: [labelStream skip: -1].
	^ labelStream contents! !

!SequenceableCollection methodsFor: 'sorting' stamp: ''!
isSorted
	"Return true if the receiver is sorted by the given criterion.
	Optimization for isSortedBy: [:a :b | a <= b]."

	| lastElm elm |
	self isEmpty ifTrue: [^ true].
	lastElm := self first.
	2 to: self size do: 
		[:index | 
		elm := self at: index.
		lastElm <= elm ifFalse: [^ false].
		lastElm := elm].
	^ true! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'MarcusDenker 9/29/2014 15:13'!
select: aBlock 
	"Optimized version of Collection>>#select:"
	
	| each |
	^ self class new: self size streamContents: [ :stream|
		1 to: self size do: [ :index |
			(aBlock value: (each := self at: index))
				ifTrue: [ stream nextPut: each ]]]! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'sma 5/12/2000 18:13'!
keysAndValuesDo: aBlock 
	"Enumerate the receiver with all the keys (aka indices) and values."

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

!SequenceableCollection methodsFor: 'splitjoin' stamp: 'onierstrasz 4/12/2009 20:19'!
join: aCollection
	"NB: this implementation only works for Array, since WriteStreams only work for Arrays and Strings. (!!)
	Overridden in OrderedCollection and SortedCollection."
	^ self class
		streamContents: [:stream | aCollection
				do: [:each | each joinTo: stream]
				separatedBy: [stream nextPutAll: self]]! !

!SequenceableCollection methodsFor: 'splitjoin' stamp: 'onierstrasz 4/12/2009 19:58'!
appendTo: aCollection
	"double dispatch for join:"
	^ aCollection addAllLast: self! !

!SequenceableCollection class methodsFor: 'stream creation' stamp: 'CamilloBruni 9/7/2011 16:40'!
<< blockWithArg
	^ self streamContents: blockWithArg! !

!SequenceableCollection class methodsFor: 'stream creation' stamp: 'DamienCassou 9/26/2014 14:25'!
new: newSize streamContents: blockWithArg
	| stream |
	stream := WriteStream on: (self streamSpecies new: newSize).
	blockWithArg value: stream.
	^ stream contents! !

!SequenceableCollection class methodsFor: 'accessing' stamp: 'CamilloBruni 9/5/2011 15:33'!
streamSpecies
	"I return the class that is used for streaming. If override consider overriding #new:streamContents:"
	^ self! !

!SequenceableCollection class methodsFor: 'stream creation' stamp: 'CamilloBruni 9/5/2011 15:32'!
streamContents: blockWithArg limitedTo: sizeLimit
	| stream |
	stream := LimitedWriteStream on: (self streamSpecies new: (100 min: sizeLimit)).
	stream setLimit: sizeLimit limitBlock: [^ stream contents].
	blockWithArg value: stream.
	^ stream contents
"
String streamContents: [:s | 1000 timesRepeat: [s nextPutAll: 'Junk']] limitedTo: 25
 'JunkJunkJunkJunkJunkJunkJ'
"! !

!SequenceableCollection class methodsFor: 'instance creation' stamp: 'MarcusDenker 12/7/2009 14:55'!
ofSize: n
	"Create a new collection of size n with nil as its elements.
	This method exists because OrderedCollection new: n creates an
	empty collection,  not one of size n."
	^ self new: n! !

!SequenceableCollection class methodsFor: '*Spec-Inspector' stamp: 'MarcusDenker 7/25/2014 16:47'!
inspectorClass
	^ EyeCollectionInspector! !

!SequenceableCollection class methodsFor: 'stream creation' stamp: 'CamilloBruni 9/7/2011 16:40'!
streamContents: blockWithArg

	^ self new: 100 streamContents: blockWithArg! !

!SerialPort commentStamp: '<historical>'!
This class supports a simple interface to the serial ports of the underlying platform, if it supports serial ports. The mapping of port numbers to hardware ports is platform specific, but typically follows platform ordering conventions. For example, on the Macintosh, port 0 is the modem port and port 1 is the printer port, since in the programmers documentation these ports are referred to as ports A and B.
!
!SerialPort methodsFor: 'accessing' stamp: 'jm 5/1/1998 18:02'!
stopBitsType: anInteger
	"Set the stop bits type for this serial port, where:
		0 - 1.5 stop bits
		1 - one stop bit
		2 - two stop bits"

	stopBitsType := anInteger.
! !

!SerialPort methodsFor: 'accessing' stamp: 'jm 5/1/1998 17:29'!
parityType: anInteger
	"Set the parity type for this serial port, where:
		0 - no parity
		1 - odd parity
		2 - even parity"

	parityType := anInteger.
! !

!SerialPort methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primClosePort: portNumber

	<primitive: 'primitiveSerialPortClose' module: 'SerialPlugin'>
	^ nil  "(DNS)"
	"self primitiveFailed."
! !

!SerialPort methodsFor: 'open/close' stamp: 'StephaneDucasse 2/12/2011 16:45'!
close
	"Close the serial port. Do nothing if the port is not open."
	
	port ifNotNil: [port isString 
					ifTrue: [self primClosePortByName: port]
 					ifFalse: [self primClosePort: port]].
	port := nil! !

!SerialPort methodsFor: 'input/output' stamp: 'StephaneDucasse 2/12/2011 16:44'!
readString
	"Answer a String read from this serial port. Answer the empty
	String if no data is available. The port must be open."
	| buf count |
	buf := String new: 1000.
	count := port isString 
				ifTrue: [ self
							primReadPortByName: port
							into: buf
							startingAt: 1
							count: buf size.]
				ifFalse: [ self
						 	primReadPort: port
							into: buf
							startingAt: 1
							count: buf size.].
	^ buf copyFrom: 1 to: count! !

!SerialPort methodsFor: 'accessing' stamp: 'jm 5/1/1998 17:28'!
xOnByte: anInteger
	"Set the value of the XOn byte to be used if XOn/XOff flow control is enabled."

	xOnByte := anInteger.
! !

!SerialPort methodsFor: 'primitives' stamp: 'Sk 1/4/2009 18:24'!
primReadPortByName: portName into: byteArray startingAt: startIndex count: count 
	<primitive: 'primitiveSerialPortReadByName' module:'SerialPlugin'>
	self primitiveFailed! !

!SerialPort methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primWritePort: portNumber from: byteArray startingAt: startIndex count: count

	<primitive: 'primitiveSerialPortWrite' module: 'SerialPlugin'>
	self primitiveFailed.
! !

!SerialPort methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 10:21'!
initialize
	"Default port settings."

	super initialize.
	port := nil.					"set when opened"
	baudRate := 9600.			"9600 baud"
	stopBitsType := 1.				"one stop bit"
	parityType := 0.				"no parity"
	dataBits := 8.					"8 bits"
	outputFlowControlType := 0.	"none"
	inputFlowControlType := 0.	"none"
	xOnByte := 19.				"ctrl-S"
	xOffByte := 24.				"ctrl-X"
! !

!SerialPort methodsFor: 'accessing' stamp: 'jm 5/1/1998 17:20'!
xOffByte

	^ xOffByte
! !

!SerialPort methodsFor: 'open/close' stamp: 'BillSchwab 7/16/2011 17:42'!
openPort: portId 
	"Open the given serial port, using the settings specified by my
	instance variables."

		| result |	

	self close.
	
	"8-10 - wks - this has to tell us if it fails: step 1, save the primitive result"
	result := portId isString
		ifTrue: [self
				primOpenPortByName: portId
				baudRate: baudRate
				stopBitsType: stopBitsType
				parityType: parityType
				dataBits: dataBits
				inFlowControlType: inputFlowControlType
				outFlowControlType: outputFlowControlType
				xOnByte: xOnByte
				xOffByte: xOffByte]
		ifFalse: [self
				primOpenPort: portId
				baudRate: baudRate
				stopBitsType: stopBitsType
				parityType: parityType
				dataBits: dataBits
				inFlowControlType: inputFlowControlType
				outFlowControlType: outputFlowControlType
				xOnByte: xOnByte
				xOffByte: xOffByte].

	"wks - raise an error if there was a failure."
	result isNil ifTrue:[ self error:'Cannot open ', portId printString. ].

	port := portId
! !

!SerialPort methodsFor: 'printing' stamp: 'jm 5/1/1998 18:02'!
printOn: aStream

	aStream
		nextPutAll: 'SerialPort(';
		nextPutAll:
			(port ifNil: ['closed'] ifNotNil: ['#', port printString]);
		nextPutAll: ', ';
		print: baudRate; nextPutAll: ' baud, ';
		print: dataBits; nextPutAll: ' bits, ';
		nextPutAll: (#('1.5' '1' '2') at: stopBitsType + 1); nextPutAll: ' stopbits, ';
		nextPutAll: (#('no' 'odd' 'even') at: parityType + 1); nextPutAll: ' parity)'.
! !

!SerialPort methodsFor: 'accessing' stamp: 'jm 5/1/1998 17:38'!
inputFlowControlType: anInteger
	"Set the type of input flow control, where:
		0 - none
		1 - XOn/XOff
		2 - hardware handshaking"

	inputFlowControlType := anInteger.
! !

!SerialPort methodsFor: 'input/output' stamp: 'StephaneDucasse 2/12/2011 16:43'!
nextPutAll: aStringOrByteArray 
	"Send the given bytes out this serial port. The port must be
	open. "
	^ port isString
		ifTrue: [self
					primWritePortByName: port
					from: aStringOrByteArray
					startingAt: 1
					count: aStringOrByteArray size]
		ifFalse: [self
					primWritePort: port
					from: aStringOrByteArray
					startingAt: 1
					count: aStringOrByteArray size]
! !

!SerialPort methodsFor: 'accessing' stamp: 'jm 5/1/1998 17:21'!
inputFlowControlType

	^ inputFlowControlType
! !

!SerialPort methodsFor: 'input/output' stamp: 'StephaneDucasse 2/12/2011 16:44'!
readInto: aStringOrByteArray startingAt: index 
	"Read data into the given String or ByteArray object starting at the given index, and answer the number of bytes read. Does not go past the end of the given String or ByteArray."
	
	^ port isString 
		ifTrue: [self primReadPortByName: port
					into: aStringOrByteArray
					startingAt: index
					count: aStringOrByteArray size - index + 1]
		ifFalse: [self primReadPort: port
					into: aStringOrByteArray
					startingAt: index
					count: aStringOrByteArray size - index + 1].
		! !

!SerialPort methodsFor: 'accessing' stamp: 'jm 5/1/1998 17:20'!
xOnByte

	^ xOnByte
! !

!SerialPort methodsFor: 'accessing' stamp: 'jm 5/1/1998 17:29'!
dataBits: anInteger
	"Set the number of data bits for this serial port to 5, 6, 7, or 8."

	dataBits := anInteger.
! !

!SerialPort methodsFor: 'accessing' stamp: 'jm 5/1/1998 17:29'!
baudRate: anInteger
	"Set the baud rate for this serial port."

	baudRate := anInteger.
! !

!SerialPort methodsFor: 'accessing' stamp: 'jm 5/1/1998 17:19'!
stopBitsType

	^ stopBitsType
! !

!SerialPort methodsFor: 'primitives' stamp: 'Sk 1/4/2009 18:24'!
primOpenPortByName: portName baudRate: baud stopBitsType: stop parityType: parity dataBits: numDataBits inFlowControlType: inFlowCtrl outFlowControlType: outFlowCtrl xOnByte: xOn xOffByte: xOff 
	<primitive: 'primitiveSerialPortOpenByName' module:'SerialPlugin'>
	^ nil"(DNS)"! !

!SerialPort methodsFor: 'accessing' stamp: 'jm 5/1/1998 17:28'!
xOffByte: anInteger
	"Set the value of the XOff byte to be used if XOn/XOff flow control is enabled."

	xOffByte := anInteger.
! !

!SerialPort methodsFor: 'accessing' stamp: 'jm 5/1/1998 17:19'!
outputFlowControlType

	^ outputFlowControlType
! !

!SerialPort methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primOpenPort: portNumber baudRate: baud stopBitsType: stop
	parityType: parity dataBits: numDataBits
	inFlowControlType: inFlowCtrl outFlowControlType: outFlowCtrl
	xOnByte: xOn xOffByte: xOff

	<primitive: 'primitiveSerialPortOpen' module: 'SerialPlugin'>
	^ nil  "(DNS)"
! !

!SerialPort methodsFor: 'primitives' stamp: 'Sk 1/4/2009 18:24'!
primClosePortByName: portName
	<primitive: 'primitiveSerialPortCloseByName' module:'SerialPlugin'>
	^ nil"(DNS)"
	"self primitiveFailed."! !

!SerialPort methodsFor: 'accessing' stamp: 'jm 5/1/1998 17:19'!
dataBits

	^ dataBits
! !

!SerialPort methodsFor: 'accessing' stamp: 'jm 5/1/1998 17:38'!
outputFlowControlType: anInteger
	"Set the type of output flow control, where:
		0 - none
		1 - XOn/XOff
		2 - hardware handshaking"

	outputFlowControlType := anInteger.
! !

!SerialPort methodsFor: 'accessing' stamp: 'jm 5/1/1998 17:19'!
parityType

	^ parityType
! !

!SerialPort methodsFor: 'input/output' stamp: 'StephaneDucasse 2/12/2011 16:43'!
readByteArray
	"Answer a ByteArray read from this serial port. Answer an empty ByteArray if no data is available. The port must be open. "
	
	| buf count |
	buf := ByteArray new: 1000.
	count := port isString
				ifTrue: [self
						primReadPortByName: port
						into: buf
						startingAt: 1
						count: buf size]
				ifFalse: [self
						primReadPort: port
						into: buf
						startingAt: 1
						count: buf size].
	^ buf copyFrom: 1 to: count! !

!SerialPort methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primReadPort: portNumber into: byteArray startingAt: startIndex count: count

	<primitive: 'primitiveSerialPortRead' module: 'SerialPlugin'>
	self primitiveFailed.
! !

!SerialPort methodsFor: 'primitives' stamp: 'Sk 1/4/2009 18:25'!
primWritePortByName: portName from: byteArray startingAt: startIndex count: count 
	<primitive: 'primitiveSerialPortWriteByName' module:'SerialPlugin'>
	self primitiveFailed! !

!SerialPort methodsFor: 'accessing' stamp: 'jm 5/1/1998 17:19'!
baudRate

	^ baudRate
! !

!Session commentStamp: '<historical>'!
I am a unique identifier for the current smalltalk session.
On each image startup the current session is invalidated and a new session is created.
!
!Session methodsFor: 'accessing' stamp: 'CamilloBruni 8/21/2013 18:25'!
creationTime
	^ creationTime! !

!Session methodsFor: 'initialize' stamp: 'CamilloBruni 8/21/2013 18:26'!
initialize

	creationTime := DateAndTime now.! !

!Session methodsFor: 'accessing' stamp: 'CamilloBruni 8/21/2013 18:26'!
age
	^ DateAndTime now - self creationTime! !

!Session class methodsFor: 'accessing' stamp: 'CamilloBruni 5/9/2013 19:46'!
current
	^ current ifNil: [ current := self new ]! !

!Session class methodsFor: 'accessing' stamp: 'CamilloBruni 5/9/2013 19:46'!
reset
	current := nil! !

!Set commentStamp: '<historical>'!
I represent a set of objects without duplicates.  I can hold anything that responds to
#hash and #=, except for nil.  My instances will automatically grow, if necessary,
Note that I rely on #=, not #==.  If you want a set using #==, use IdentitySet.

Instance structure:

  array	An array whose non-nil elements are the elements of the set,
		and whose nil elements are empty slots.  There is always at least one nil.
		In fact I try to keep my "load" at 75% or less so that hashing will work well.

  tally	The number of elements in the set.  The array size is always greater than this.

The core operation is #findElementOrNil:, which either finds the position where an
object is stored in array, if it is present, or finds a suitable position holding nil, if
its argument is not present in array,!
!Set methodsFor: '*Fuel' stamp: 'MartinDias 2/25/2013 14:33'!
fuelAfterMaterialization

	"Since for Set and IdentitySet we are recreating the collection with #add: (see FLSimpleCollectionCluster) we do not need to rehash"
	^ ((self class == Set) or: [ self class == IdentitySet ] ) 
		ifFalse: [ self rehash ] 
		ifTrue: [ self ]! !

!Set methodsFor: 'private' stamp: 'StephaneDucasse 2/20/2010 17:49'!
withArray: anArray
	"private -- for use only in copy"
	"I want to get a conflict"
	array := anArray! !

!Set methodsFor: 'accessing' stamp: 'Igor.Stasenko 11/13/2009 07:15'!
like: anObject
	"Answer an object in the receiver that is equal to anObject,
	nil if no such object is found. Relies heavily on hash properties.
	Note, use #like:ifAbsent: if you need to match against nil as element"

	^ self like: anObject ifAbsent: [ nil ]! !

!Set methodsFor: 'testing' stamp: 'CamilloBruni 7/3/2013 13:14'!
isHealthy
	"Test that object hashes match their positions stored in set's array,
	answer true if everything ok, false otherwise
	
	Set allSubInstances select: [:badSet |
		badSet isHealthy not ]
	"
	array withIndexDo: [ :element :index |
		element ifNotNil: [
			(self scanFor: element) == index
				ifFalse: [ ^ false ]]].
	^ true! !

!Set methodsFor: 'private' stamp: 'IgorStasenko 12/29/2011 14:11'!
grow
	"Grow the elements array and reinsert the old elements"

	| oldElements |
	oldElements := array.
	array := Array new: (HashTableSizes atLeast: oldElements size * 2).
	tally := 0.
	oldElements
		do:
			[ :each | 
			each == nil
				ifFalse: [ self noCheckAdd: each enclosedSetElement] ]! !

!Set methodsFor: 'testing' stamp: 'sma 5/12/2000 14:46'!
occurrencesOf: anObject 
	^ (self includes: anObject) ifTrue: [1] ifFalse: [0]! !

!Set methodsFor: 'removing' stamp: 'sma 5/12/2000 14:45'!
copyWithout: oldElement 
	"Answer a copy of the receiver that does not contain any
	elements equal to oldElement."

	^ self copy
		remove: oldElement ifAbsent: [];
		yourself! !

!Set methodsFor: 'adding' stamp: 'sma 5/12/2000 17:29'!
add: newObject withOccurrences: anInteger
	^ self add: newObject! !

!Set methodsFor: '*Fuel' stamp: 'MarianoMartinezPeck 7/26/2012 17:42'!
fuelAccept: aGeneralMapper
	"Since we have subclasses of Set that behave differently, we cannot use the visitSimpleCollection: for all of them."
	^ ((self class == Set) or: [ self class == IdentitySet ] ) 
		ifTrue: [ aGeneralMapper visitSimpleCollection: self ]
		ifFalse: [ super fuelAccept: aGeneralMapper ] 
	! !

!Set methodsFor: 'accessing' stamp: 'md 7/31/2005 08:56'!
atRandom: aGenerator
	"Answer a random element of the receiver. Uses aGenerator which
    should be kept by the user in a variable and used every time. Use
    this instead of #atRandom for better uniformity of random numbers because 
	only you use the generator. Causes an error if self has no elements."
	| rand |

	self emptyCheck.
	rand := aGenerator nextInt: self size.
	self doWithIndex:[:each :ind |
		ind == rand ifTrue:[^each]].
	^ self errorEmptyCollection
! !

!Set methodsFor: 'private' stamp: 'Igor.Stasenko 11/13/2009 06:58'!
scanFor: anObject
	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."

	| index start |
	index := start := anObject hash \\ array size + 1.
	[ 
		| element |
		((element := array at: index) == nil or: [ element enclosedSetElement = anObject ])
			ifTrue: [ ^index ].
		(index := index \\ array size + 1) = start ] whileFalse.
	self errorNoFreeSpace! !

!Set methodsFor: 'adding' stamp: 'Igor.Stasenko 11/13/2009 06:59'!
add: newObject
	"Include newObject as one of the receiver's elements, but only if
	not already present. Answer newObject."

	| index |
	index := self scanFor: newObject.
	(array at: index) ifNil: [self atNewIndex: index put: newObject asSetElement].
	^ newObject! !

!Set methodsFor: '*Fuel' stamp: 'MartinDias 9/9/2011 14:46'!
addIfNotPresent: anObject ifPresentDo: aBlock
	"Include anObject as one of the receiver's elements and then value aBlock, but only if there
	is no such element already. Anwser anObject."

	| index |
	index := self scanFor: anObject.
	(array at: index) 
		ifNil: [self atNewIndex: index put: anObject asSetElement]
		ifNotNil: [ aBlock value ].
	^ anObject

	"Sets in Pharo 1.2 can't' contain nil, so this implementation is wrong in that version. This is the right one (in Pharo 1.2):

	| index |
	anObject ifNil: [self error: 'Sets cannot meaningfully contain nil as an element'].
	index := self findElementOrNil: anObject.
	(array at: index) 
		ifNil: [ self atNewIndex: index put: anObject ]
		ifNotNil: [ aBlock value ].
	^ anObject"! !

!Set methodsFor: 'enumerating' stamp: 'StephaneDucasse 3/14/2014 20:55'!
difference: aCollection
	"Answer the set theoretic difference of two collections. Optimized version for Sets where no intermediate Set is necessary"

	"#(a b c d e f) difference:  #(a b z k)
	=> #(#f #d #e #c)
	
	#(a b z k) difference: #(a b c d e f) 
	=> #(#k #z) 
	"

	| set |
	set := self copy.
	aCollection do: [ :each | set remove: each ifAbsent: [  ] ].
	^ set! !

!Set methodsFor: 'private' stamp: 'Igor.Stasenko 3/19/2010 14:27'!
fixCollisionsFrom: start
	"The element at start has been removed and replaced by nil.
	This method moves forward from there, relocating any entries
	that had been placed below due to collisions with this one"

	| element index |
	index := start.
	[ (element := array at: (index := index \\ array size + 1)) == nil ] whileFalse: [
		| newIndex |
		(newIndex := self scanFor: element enclosedSetElement) = index ifFalse: [
			array swap: index with: newIndex ] ]! !

!Set methodsFor: '*Monticello-Storing' stamp: 'tk 4/8/1999 13:05'!
comeFullyUpOnReload: smartRefStream
	"Symbols have new hashes in this image."

	self rehash.
	"^ self"
! !

!Set methodsFor: 'private' stamp: ''!
rehash
	| newSelf |
	newSelf := self species new: self size.
	self do: [:each | newSelf noCheckAdd: each].
	array := newSelf array! !

!Set methodsFor: 'removing' stamp: ''!
remove: oldObject ifAbsent: aBlock

	| index |
	index := self findElementOrNil: oldObject.
	(array at: index) == nil ifTrue: [ ^ aBlock value ].
	array at: index put: nil.
	tally := tally - 1.
	self fixCollisionsFrom: index.
	^ oldObject! !

!Set methodsFor: 'accessing' stamp: 'Igor.Stasenko 11/13/2009 07:13'!
like: anObject ifAbsent: aBlock
	"Answer an object in the receiver that is equal to anObject,
	or evaluate the block if not found. Relies heavily on hash properties"
	| element |
	element := array at: (self scanFor: anObject).
	^ element ifNil: [ aBlock value ] ifNotNil: [ element enclosedSetElement ]! !

!Set methodsFor: 'testing' stamp: ''!
includes: anObject 
	^ (array at: (self findElementOrNil: anObject)) ~~ nil! !

!Set methodsFor: 'enumerating' stamp: 'CamilloBruni 1/16/2012 18:24'!
intersection: aCollection
	"Answer the set theoretic intersection of two collections.
	Optimized version for Sets where no intermediate Set is necessary"

	| outputSet |
	
	outputSet := self class new.
	
	aCollection do: [ :each|
		((self includes: each) and: [(outputSet includes: each) not])
				ifTrue: [ outputSet add: each]].
		
	^ outputSet! !

!Set methodsFor: 'testing' stamp: 'tk 11/8/2001 15:35'!
= aSet
	self == aSet ifTrue: [^ true].	"stop recursion"
	(aSet isKindOf: Set) ifFalse: [^ false].
	self size = aSet size ifFalse: [^ false].
	self do: [:each | (aSet includes: each) ifFalse: [^ false]].
	^ true! !

!Set methodsFor: 'enumerating' stamp: 'Igor.Stasenko 11/13/2009 06:36'!
collect: aBlock 
	"Evaluate aBlock with each of the receiver's elements as the argument.  
	Collect the resulting values into a collection like the receiver. Answer  
	the new collection."

	| newSet |
	newSet := Set new: self size.
	array do: [:each | each ifNotNil: [newSet add: (aBlock value: each enclosedSetElement)]].
	^ newSet! !

!Set methodsFor: 'enumerating' stamp: 'Igor.Stasenko 11/13/2009 06:37'!
do: aBlock 
	tally = 0 ifTrue: [^ self].
	1 to: array size do:
		[:index |
		| each |
		(each := array at: index) ifNotNil: [aBlock value: each enclosedSetElement]]! !

!Set methodsFor: 'converting' stamp: 'ar 11/20/1998 16:34'!
asSet
	^self! !

!Set methodsFor: 'copy' stamp: 'StephaneDucasse 5/11/2010 17:32'!
postCopy
	super postCopy.
	array := array copy! !

!Set methodsFor: 'enumerating' stamp: 'jannik.laval 2/6/2009 16:44'!
flatCollect: aBlock 
	
	
	^self flatCollectAsSet: aBlock! !

!Set methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 5/30/2012 06:49'!
gtInspectorItemsIn: composite
	"we override this because sets do not work well in morph tree morphs" 
	^ (super gtInspectorItemsIn: composite)
		display: [:set | set asOrderedCollection]! !

!Set methodsFor: 'private' stamp: 'IgorStasenko 12/29/2011 14:14'!
noCheckNoGrowFillFrom: anArray
	"Add the elements of anArray except nils to me assuming that I don't contain any of them, they are unique and I have more free space than they require."

	1 to: anArray size do: [ :index |
		(anArray at: index) ifNotNil: [ :object |
			array
				at: (self scanForEmptySlotFor: object enclosedSetElement)
				put: object ] ]! !

!Set methodsFor: 'private' stamp: 'IgorStasenko 12/29/2011 14:02'!
noCheckAdd: anObject
	"This method should be deprecated"
	array at: (self findElementOrNil: anObject) put: anObject asSetElement.
	tally := tally + 1! !

!Set class methodsFor: '*Spec-Inspector' stamp: 'cb 6/25/2013 13:43'!
inspectorClass
	^ EyeSetInspector! !

!Set class methodsFor: 'instance creation' stamp: 'adrian-lienhard 6/22/2009 00:02'!
new
	^ self basicNew
		initialize: 5;
		yourself! !

!Set class methodsFor: 'instance creation' stamp: ''!
newFrom: aCollection 
	"Answer an instance of me containing the same elements as aCollection."
	| newCollection |
	newCollection := self new: aCollection size.
	newCollection addAll: aCollection.
	^ newCollection
"
	Set newFrom: {1. 2. 3}
	{1. 2. 3} as: Set
"! !

!Set class methodsFor: 'instance creation' stamp: 'MartinMcClure 3/18/2010 22:08'!
sizeFor: nElements
	"Large enough size to hold nElements with some slop (see fullCheck)"

	^ HashTableSizes atLeast: nElements * 4 // 3! !

!Set class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:08'!
gtExampleSimple
	<gtExample: 'Simple'>
	^ #('fourtytwo' 42) asSet! !

!SetElement commentStamp: 'StephaneDucasse 7/14/2011 21:29'!
I am a helper class for handling the contents of Set.
My main purpose is to allow a Set to contain nil.
Since nil represents an empty slot in a Set, it cannot be stored directly in the array of values. Instead, an instance of SetElement is used as a wrapper. See implementors and senders of #asElement for wrapping, and #enclosedSetElement for unwrapping.!
!SetElement methodsFor: 'accessing' stamp: 'Igor.Stasenko 11/13/2009 05:49'!
enclosedSetElement: anObject
	enclosedElement := anObject! !

!SetElement methodsFor: 'comparing' stamp: 'Igor.Stasenko 11/13/2009 05:52'!
hash
	^ enclosedElement hash
! !

!SetElement methodsFor: 'comparing' stamp: 'Igor.Stasenko 11/13/2009 05:51'!
= anObject
	^ anObject class = self class and: [ enclosedElement = anObject enclosedSetElement ]
! !

!SetElement methodsFor: 'accessing' stamp: 'Igor.Stasenko 11/13/2009 05:49'!
enclosedSetElement
	^ enclosedElement! !

!SetElement methodsFor: 'converting' stamp: 'Igor.Stasenko 11/13/2009 06:29'!
asSetElement
	"A receiver has to be included into a set, as a distinct object.
	We need to wrap receiver in own turn, otherwise #enclosedSetElement will return wrong object for that set"
	^ SetElement with: self! !

!SetElement class methodsFor: 'accessing' stamp: 'Igor.Stasenko 11/13/2009 05:56'!
withNil
	^ NilElement
! !

!SetElement class methodsFor: 'class initialization' stamp: 'Igor.Stasenko 11/13/2009 05:55'!
initialize
	NilElement := self with: nil.
! !

!SetElement class methodsFor: 'instance creation' stamp: 'Igor.Stasenko 11/13/2009 05:53'!
with: anObject
	^ self new enclosedSetElement: anObject! !

!SetEyeElement commentStamp: '<historical>'!
I am an eye element for sets, showing appropriate thing with indexes
!
!SetEyeElement methodsFor: 'action' stamp: 'ClementBera 4/30/2013 16:35'!
save: aValue
	| oldElement |
	oldElement := self host array at: self index.
	self host 
		remove: oldElement;
		add: aValue.! !

!SetEyeElement methodsFor: 'accessing' stamp: 'ClementBera 4/30/2013 16:38'!
externalIndex
	^ externalIndex! !

!SetEyeElement methodsFor: 'accessing' stamp: 'ClementBera 4/30/2013 16:20'!
value
	^ self host array at: self index! !

!SetEyeElement methodsFor: 'accessing' stamp: 'ClementBera 4/30/2013 16:21'!
accessorCode
	^ '(self array at: ', self index asString, ')'! !

!SetEyeElement methodsFor: 'accessing' stamp: 'ClementBera 4/30/2013 16:38'!
externalIndex: anObject
	externalIndex := anObject! !

!SetEyeElement methodsFor: 'accessing' stamp: 'ClementBera 4/30/2013 16:38'!
label
	^ self externalIndex printString! !

!SetEyeElement class methodsFor: 'instance creation' stamp: 'ClementBera 4/30/2013 16:37'!
host: anObject index: index externalIndex: externalIndex
	^ (self host: anObject)
		index: index;
		externalIndex: externalIndex;
		yourself! !

!SetTest commentStamp: '<historical>'!
This is the unit test for the class Set. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see: 
	- http://www.c2.com/cgi/wiki?UnitTest
	- there is a chapter in the PharoByExample book (http://pharobyexample.org/)
	- the sunit class category!
!SetTest methodsFor: 'sunit original tests' stamp: 'StephaneDucasse 6/9/2012 22:56'!
testIllegal
	self should: [empty at: 5] raise: self defaultTestError.
	self should: [empty at: 5 put: #abc] raise: self defaultTestError.
			! !

!SetTest methodsFor: 'tests - set arithmetic' stamp: ''!
numberOfSimilarElementsInIntersection
	^ self collection occurrencesOf: self anotherElementOrAssociationIn! !

!SetTest methodsFor: 'test - iterate' stamp: 'damienpollet 1/30/2009 18:04'!
testDoWithoutNoDuplicates
	"self debug: #testDoWithoutNoDuplicates"
	| res |
	res := self speciesClass new.  
	self collection do: [:each | res add: each] without: -2.
	self assert: res size = self doWithoutNumber.! !

!SetTest methodsFor: 'tests - remove' stamp: ''!
testRemoveElementReallyRemovesElement
	"self debug: #testRemoveElementReallyRemovesElement"
	| size |
	size := self nonEmptyWithoutEqualElements size.
	self nonEmptyWithoutEqualElements remove: self nonEmptyWithoutEqualElements anyOne.
	self assert: size - 1 = self nonEmptyWithoutEqualElements size! !

!SetTest methodsFor: 'tests - converting' stamp: ''!
assertNonDuplicatedContents: aCollection whenConvertedTo: aClass 
	| result |
	result := aCollection perform: ('as' , aClass name) asSymbol.
	self assert: (result class includesBehavior: aClass).
	result do: 
		[ :each | 
		self assert: (aCollection occurrencesOf: each) = (result occurrencesOf: each) ].
	^ result! !

!SetTest methodsFor: 'tests - converting' stamp: ''!
testAsIdentitySet
	"test with a collection without equal elements :"
	self 
		assertSameContents: self collectionWithoutEqualElements
		whenConvertedTo: IdentitySet.
! !

!SetTest methodsFor: 'test - creation' stamp: ''!
testWithWithWith
	"self debug: #testWithWithWith"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom:1 to: 3 .
	aCol := self collectionClass with: (collection at:1) with: ( collection at:2 ) with: ( collection at: 3).

	1 to: 3 do: [ :i | self assert: ( aCol occurrencesOf: ( collection at: i ) ) = ( collection occurrencesOf: ( collection at: i ) ) ].! !

!SetTest methodsFor: 'some tests' stamp: 'stephane.ducasse 10/6/2008 19:34'!
testAsSet
	"could be moved in Array or Collection"

	| newFull |
	newFull := #(1 2 3 ) asSet.
	newFull add: 4.
	self assert: (newFull = full).! !

!SetTest methodsFor: 'tests - fixture' stamp: ''!
test0TStructuralEqualityTest
	self empty.
	self nonEmpty.
	self assert: self empty isEmpty.
	self deny: self nonEmpty isEmpty! !

!SetTest methodsFor: 'tests - converting' stamp: ''!
testAsByteArray
	| res |
	self integerCollectionWithoutEqualElements.
	self integerCollectionWithoutEqualElements do: [ :each | self assert: each class = SmallInteger ].
	res := true.
	self integerCollectionWithoutEqualElements
		detect: [ :each | (self integerCollectionWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false.
	self assertSameContents: self integerCollectionWithoutEqualElements whenConvertedTo: ByteArray! !

!SetTest methodsFor: 'tests - with nil' stamp: 'CamilloBruni 8/31/2013 20:23'!
testAllowInclusionOfNils
	| set |
	set := self classToBeTested new.
	set add: nil.
	self assert: (set includes: nil).
	set remove: nil.
	self deny: (set includes: nil)! !

!SetTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionTwoSimilarElementsInIntersection
	"self debug: #testIntersectionBasic"
	| inter |
	inter := self collection intersection: (self collectionClass with: self anotherElementOrAssociationIn).
	self assert: (self collection occurrencesOf: self anotherElementOrAssociationIn) = self numberOfSimilarElementsInIntersection.
	self assert: (inter includes: self anotherElementOrAssociationIn value)! !

!SetTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 11:54'!
firstCollection
" return a collection that will be the first part of the concatenation"
	^ nonEmpty1element ! !

!SetTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 16:54'!
collectionInForIncluding
	^ collectionIncluded ! !

!SetTest methodsFor: 'tests - concatenation' stamp: ''!
testConcatenationWithDuplicate


| collection1 collection2 result |
collection1 := self firstCollection .
collection2 := self firstCollection  .
result := collection1 , collection2.

collection1 do:[ :each | self assert: (result includes: each)].
self assert: result size = collection1 size.! !

!SetTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAnyNoneThere
	"self debug: #testIncludesAnyOfNoneThere'"
	
	self deny: (self nonEmpty includesAny: self empty).
	self deny: (self nonEmpty includesAny: { self elementNotIn. self anotherElementNotIn })! !

!SetTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 16:42'!
collectionOfFloat
	^ collectionOfFloat ! !

!SetTest methodsFor: 'some tests' stamp: 'stephane.ducasse 10/6/2008 19:35'!
testLike
	self assert: ((full like: 3) = 3).
	self assert: ((full like: 8) isNil).! !

!SetTest methodsFor: 'sunit original tests' stamp: 'stephane.ducasse 5/20/2009 18:05'!
testAdd 
	empty add: 5.
	self assert: (empty includes: 5).! !

!SetTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 10:04'!
collectionWithoutEqualElements
" return a collection without equal elements"
	^ withoutEqualElements ! !

!SetTest methodsFor: 'tests - adding uniquely' stamp: ''!
testAddNewElementIncrementsSize
	| added oldSize |
	oldSize := self collectionWithoutElement size.
	self deny: (self collectionWithoutElement includes: self element).
	added := self collectionWithoutElement add: self element.
	self assert: added = self element.
	self assert: (self collectionWithoutElement includes: self element).
	self assert: self collectionWithoutElement size = (oldSize + 1)! !

!SetTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedArray
	| result collection |
	collection := self collectionWithSortableElements .
	result := collection  asArray sort.
	self assert: (result class includesBehavior: Array).
	self assert: result isSorted.
	self assert: result size = collection size! !

!SetTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifferenceWithSeparateCollection
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifferenceWithSeparateCollection"
	| res separateCol |
	
	separateCol := self collectionClass with: self anotherElementOrAssociationNotIn.
	res := self collectionWithoutEqualElements difference: separateCol.
	
	self deny: (res includes: self anotherElementOrAssociationNotIn).
	self assert: res size equals: self collectionWithoutEqualElements size.
	
	self collectionWithoutEqualElements do: [ :each|
		self assert: (res includes: each)].
	
	res := separateCol difference: self collection.
	self deny: (res includes: self collection anyOne).
	self assert: res equals: separateCol! !

!SetTest methodsFor: 'requirements' stamp: 'stephane.ducasse 10/8/2008 15:42'!
collectionWithElement
	^ full! !

!SetTest methodsFor: 'tests - set arithmetic' stamp: ''!
testUnionOfEmpties
	"self debug: #testUnionOfEmpties"
	
	self assert:  (self empty union: self empty) isEmpty.
	
	! !

!SetTest methodsFor: 'some tests' stamp: 'stephane.ducasse 5/20/2009 18:06'!
testAddWithOccurences
 
	empty add: 2 withOccurrences: 3.
	self assert: (empty includes: 2).
	self assert: ((empty occurrencesOf: 2) = 1).! !

!SetTest methodsFor: 'tests - converting' stamp: ''!
testAsArray
	"self debug: #testAsArray3"
	self 
		assertSameContents: self collectionWithoutEqualElements
		whenConvertedTo: Array! !

!SetTest methodsFor: 'tests - includes' stamp: ''!
testIncludesElementIsThere
	"self debug: #testIncludesElementIsThere"
	
	self assert: (self nonEmpty includes: self nonEmpty anyOne).! !

!SetTest methodsFor: 'tests - copy' stamp: ''!
testCopyNotSame
	"self debug: #testCopySameClass"
	"A copy of a collection should always be of the same class as the instance it copies"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: copy  == self nonEmpty.! !

!SetTest methodsFor: 'test - creation' stamp: ''!
testWith
	"self debug: #testWith"
	
	| aCol anElement |
	anElement := self collectionMoreThan5Elements anyOne.
	aCol := self collectionClass with: anElement.
	self assert: (aCol includes: anElement).! !

!SetTest methodsFor: 'tests - printing' stamp: ''!
testPrintOn
	| aStream result allElementsAsString tmp |
	result:=''.
	aStream:= ReadWriteStream on: result.
	tmp:= OrderedCollection new.
	self nonEmpty do: [:each | tmp add: each asString].
	
	self nonEmpty printOn: aStream .
	allElementsAsString:=(result findBetweenSubStrs: ' ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i=1
			ifTrue:[
			self accessCollection class name first isVowel 
				ifTrue:[self assert: (allElementsAsString at:i)='an' ]
				ifFalse:[self assert: (allElementsAsString at:i)='a'].].
		i=2
			ifTrue:[self assert: (allElementsAsString at:i)=self accessCollection class name].
		i>2
			ifTrue:[self assert: (tmp occurrencesOf:(allElementsAsString at:i))=(allElementsAsString  occurrencesOf:(allElementsAsString at:i)).].	
			].! !

!SetTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCloneTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!SetTest methodsFor: 'tests - printing' stamp: ''!
testPrintElementsOn

	| aStream result allElementsAsString tmp |
	result:=''.
	aStream:= ReadWriteStream on: result.
	tmp:= OrderedCollection new.
	self nonEmpty do: [:each | tmp add: each asString].
	
	self nonEmpty printElementsOn: aStream .
	allElementsAsString:=(result findBetweenSubStrs: ' ' ).
	1 to: allElementsAsString size do:
		[:i | 
		self assert: (tmp occurrencesOf:(allElementsAsString at:i))=(allElementsAsString  occurrencesOf:(allElementsAsString at:i)).
			].! !

!SetTest methodsFor: 'tests - adding uniquely' stamp: ''!
testTAddIfNotPresentWithElementAlreadyIn

	| added oldSize |
	oldSize := self collectionWithElement size.
	self assert: (self collectionWithElement includes: self element).

	added := self collectionWithElement addIfNotPresent: self element.
	
	self assert: added = self element.
	self assert: (self collectionWithElement includes: self element).
	self assert: self collectionWithElement size = oldSize.! !

!SetTest methodsFor: 'tests - concatenation' stamp: ''!
testConcatenationWithEmpty
	| result |
	result := self firstCollection , self empty.
	self assert: result = self firstCollection! !

!SetTest methodsFor: 'some tests' stamp: 'stephane.ducasse 5/20/2009 18:05'!
testCopy
	| newFull |
	full add: 3.
	full add: 2.
	newFull := full copy.
	self assert: (full size = newFull size).
	self assert: ((full select: [:each | (newFull includes: each) not]) isEmpty).
	self assert: ((newFull select: [:each | (full includes: each) not]) isEmpty).! !

!SetTest methodsFor: 'tests - includes' stamp: 'stephane.ducasse 11/21/2008 14:58'!
anotherElementNotIn
	^ 42! !

!SetTest methodsFor: 'some tests' stamp: 'StephaneDucasse 3/5/2010 14:33'!
testRemoveIfAbsent
	"self debug: #testRemoveIfAbsent"
	
	self assert: (full remove: 8 ifAbsent: [true]).
	self assert: (full remove: 4 ifAbsent: [false]) isNumber.
	
	
	! !

!SetTest methodsFor: 'tests - remove' stamp: ''!
testRemoveElementFromEmpty
	"self debug: #testRemoveElementFromEmpty"
	self 
		should: [ self empty remove: self nonEmptyWithoutEqualElements anyOne ]
		raise: Error! !

!SetTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 16:54'!
collectionWithElementsToRemove
	^ collectionIncluded ! !

!SetTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsStringOnDelimiterLastMore

	| delim multiItemStream result last allElementsAsString tmp |
	
	delim := ', '.
	last := 'and'.
	result:=''.
	tmp := self nonEmpty collect: [:each | each asString].
	multiItemStream := ReadWriteStream on:result.
	self nonEmpty  asStringOn: multiItemStream delimiter: ', ' last: last.
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 ) | i= allElementsAsString size
			ifTrue: [self assert: (tmp occurrencesOf:(allElementsAsString at:i))=(allElementsAsString 			occurrencesOf:(allElementsAsString at:i))].
		i=(allElementsAsString size-1)
			ifTrue:[ self assert: (allElementsAsString at:i)=('and')].
			].
! !

!SetTest methodsFor: 'test - iterate' stamp: 'luc.fabresse 11/29/2008 23:09'!
expectedSizeAfterReject
	^1! !

!SetTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsStringOnDelimiterLastEmpty

	| delim emptyStream |
	delim := ', '.
	emptyStream := ReadWriteStream on: ''.
	self empty asStringOn: emptyStream delimiter: delim last:'and'.
	self assert: emptyStream contents = ''.
! !

!SetTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIncludeTest
	| anElementIn |
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self elementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self elementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self anotherElementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self anotherElementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self empty.
	self assert: self empty isEmpty! !

!SetTest methodsFor: 'tests - includes' stamp: 'CamilloBruni 8/31/2013 20:23'!
testIdentityIncludes
	" test the comportement in presence of elements 'includes' but not 'identityIncludes' "

	" can not be used by collections that can't include elements for wich copy doesn't return another instance "

	| collection element |
	self collectionWithCopyNonIdentical.
	collection := self collectionWithCopyNonIdentical.
	element := collection anyOne copy.	"self assert: (collection includes: element)."
	self deny: (collection identityIncludes: element)! !

!SetTest methodsFor: 'coverage' stamp: 'CamilloBruni 7/3/2013 13:04'!
classToBeTested
	^ Set.! !

!SetTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOfEmpty
	| result |
	result := self empty occurrencesOf: (self collectionWithoutEqualElements anyOne).
	self assert: result = 0! !

!SetTest methodsFor: 'tests - includes' stamp: 'delaunay 4/2/2009 11:53'!
testIncludesElementIsNotThere
	"self debug: #testIncludesElementIsNotThere"
	self deny: (self nonEmpty includes: self elementNotInForOccurrences).
	self assert: (self nonEmpty includes: self nonEmpty anyOne).
	self deny: (self empty includes: self elementNotInForOccurrences)! !

!SetTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyEmpty
	"self debug: #testCopyEmpty"
	
	| copy | 
	copy := self empty copy.
	self assert: copy isEmpty.! !

!SetTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsStringOnDelimiterLastOne

	| delim oneItemStream result |
	
	delim := ', '.
	result:=''.
	oneItemStream := ReadWriteStream on: result.
	self nonEmpty1Element  asStringOn: oneItemStream delimiter: delim last: 'and'.
	oneItemStream  do:
		[:each1 |
		self nonEmpty1Element do: [:each2 |self assert: each1 = (each2 asString) ]
		 ].
	

! !

!SetTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIncludeWithIdentityTest
	| anElement |
	self collectionWithCopyNonIdentical.
	anElement := self collectionWithCopyNonIdentical anyOne.
	self deny: anElement == anElement copy! !

!SetTest methodsFor: 'tests - printing' stamp: ''!
testPrintOnDelimiter
	| aStream result allElementsAsString tmp |
	result:=''.
	aStream:= ReadWriteStream on: result.
	tmp:= OrderedCollection new.
	self nonEmpty do: [:each | tmp add: each asString].
	
	
	
	self nonEmpty printOn: aStream delimiter: ', ' .
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		self assert: (tmp occurrencesOf:(allElementsAsString at:i))=(allElementsAsString  occurrencesOf:(allElementsAsString at:i))
			].! !

!SetTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSetAritmeticTest
	self collection.
	self deny: self collection isEmpty.
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self anotherElementOrAssociationNotIn.
	self collection isDictionary
		ifTrue: [ self deny: (self collection associations includes: self anotherElementOrAssociationNotIn key) ]
		ifFalse: [ self deny: (self collection includes: self anotherElementOrAssociationNotIn) ].
	self collectionClass! !

!SetTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 12/18/2009 13:17'!
collectionWithoutNilElements
" return a collection that doesn't includes a nil element  and that doesn't includes equal elements'"
	^ collectionWith3Elements  ! !

!SetTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureRequirementsOfTGrowableTest
	self empty.
	self nonEmpty.
	self element.
	self elementNotIn.
	self assert: self empty isEmpty.
	self deny: self nonEmpty isEmpty.
	self assert: (self nonEmpty includes: self element).
	self deny: (self nonEmpty includes: self elementNotIn)! !

!SetTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 10:05'!
integerCollectionWithoutEqualElements
" return a collection of integer without equal elements"
	^ withoutEqualElements ! !

!SetTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureTConvertTest
	"a collection of number without equal elements:"

	| res |
	self collectionWithoutEqualElements.
	res := true.
	self collectionWithoutEqualElements
		detect: [ :each | (self collectionWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false! !

!SetTest methodsFor: 'tests - copy' stamp: ''!
testCopyEquals
	"self debug: #testCopySameClass"
	"A copy should be equivalent to the things it's a copy of"
	
	| copy | 
	copy := self nonEmpty copy.
	self assert: copy  = self nonEmpty.! !

!SetTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsStringOnDelimiterMore

	| delim multiItemStream result allElementsAsString tmp |
	
	
	delim := ', '.
	result:=''.
	tmp:= self nonEmpty collect:[:each | each asString].
	multiItemStream := ReadWriteStream on:result.
	self nonEmpty  asStringOn: multiItemStream delimiter: ', '.
	
	allElementsAsString := (result findBetweenSubStrs: ', ' ).
	allElementsAsString do:
		[:each |
		self assert: (tmp occurrencesOf: each)=(allElementsAsString occurrencesOf: each).
		].! !

!SetTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWithoutAll
	"self debug: #testCopyEmptyWithoutAll"
	| res |
	res := self empty copyWithoutAll: self collectionWithElementsToRemove.
	self assert: res size = self empty size.
	self collectionWithElementsToRemove do: [ :each | self deny: (res includes: each) ]! !

!SetTest methodsFor: 'tests - adding uniquely' stamp: ''!
testTAddIfNotPresentWithNewElement
	| added oldSize |
	oldSize := self collectionWithoutElement size.
	self deny: (self collectionWithoutElement includes: self element).
	added := self collectionWithoutElement addIfNotPresent: self element.
	self assert: added = self element.
	self assert: (self collectionWithoutElement includes: self element).
	self assert: self collectionWithoutElement size = (oldSize + 1)! !

!SetTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 14:16'!
collectionMoreThan5Elements
" return a collection including at least 5 elements"
	
	^ collection5Elements ! !

!SetTest methodsFor: 'tests - remove' stamp: ''!
testRemoveElementThatExists
	"self debug: #testRemoveElementThatExists"

	| el res |
	el := self nonEmptyWithoutEqualElements anyOne.
	res := self nonEmptyWithoutEqualElements remove: el.
	self assert: res == el! !

!SetTest methodsFor: 'tests - includes' stamp: ''!
testIdentityIncludesNonSpecificComportement
	" test the same comportement than 'includes: '  "
	| collection |	
	collection := self nonEmpty  .
	
	self deny: (collection identityIncludes: self elementNotIn ).
	self assert:(collection identityIncludes: collection anyOne)
! !

!SetTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutAll
	"self debug: #testCopyNonEmptyWithoutAll"
	| res |
	res := self nonEmpty copyWithoutAll: self collectionWithElementsToRemove.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self collectionWithElementsToRemove do: [ :each | self deny: (res includes: (each)) ].
	self nonEmpty do: 
		[ :each | 
		(self collectionWithElementsToRemove includes: each) ifFalse: [ self assert: (res includes: each) ] ]! !

!SetTest methodsFor: 'tests - growable' stamp: 'delaunay 4/2/2009 11:53'!
testAddNonEmptyGrowsWhenNewElement
	"self debug: #testAddNonEmptyGrowsWhenNewElement"
	| oldSize |
	oldSize := self nonEmpty size.
	self deny: (self nonEmpty includes: self elementNotInForOccurrences).
	self nonEmpty add: self elementNotInForOccurrences.
	self assert: self nonEmpty size > oldSize! !

!SetTest methodsFor: 'some tests' stamp: 'stephane.ducasse 10/6/2008 16:56'!
testDo2
	| newFull result |
	newFull := Set withAll: (1 to: 5).
	result := 0.
	newFull do: [:each | result := (result + each)].
	self assert: (result = 15).! !

!SetTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureAsStringCommaAndDelimiterTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty.
	self nonEmpty1Element.
	self assert: self nonEmpty1Element size = 1! !

!SetTest methodsFor: 'sunit original tests' stamp: 'stephane.ducasse 10/6/2008 19:34'!
testRemove
	full remove: 4.
	self assert: (full includes: 3).
	self deny: (full includes: 4).! !

!SetTest methodsFor: 'tests - iterating' stamp: 'CamilloBruni 9/7/2011 11:45'!
testCollect

	| res element collection|
	collection := self collectionWithoutNilElements.
	element := self element.
	res := collection collect: [:each | element].
	
	self assert: res size = 1.
	
	res do: [ :each|
		self assert: each = element ]! !

!SetTest methodsFor: 'some tests' stamp: 'stephane.ducasse 5/20/2009 18:05'!
testCopyWithout
	| newFull | 
	full add: 3.
	full add: 2.
	newFull := full copyWithout: 3.
	self assert: (newFull size = (full size - 1)).
	self deny: (newFull includes: 3).
	self assert: ((newFull select: [:each | (full includes: each) not]) isEmpty).
	self assert: ((full select: [:each | (newFull includes: each) not]) = (Set with: 3)).
	! !

!SetTest methodsFor: 'tests - converting' stamp: ''!
assertNoDuplicates: aCollection whenConvertedTo: aClass 
	| result |
	result := self collectionWithEqualElements asIdentitySet.
	self assert: (result class includesBehavior: IdentitySet).
	self collectionWithEqualElements do: [ :initial | self assert: (result occurrencesOf: initial) = 1 ]! !

!SetTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAnyAllThere
	"self debug: #testIncludesAnyOfAllThere'"
	self deny: (self nonEmpty includesAny: self empty).
	self assert: (self nonEmpty includesAny: { self nonEmpty anyOne }).
	self assert: (self nonEmpty includesAny: self nonEmpty).! !

!SetTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsCommaStringEmpty

	self assert: self empty asCommaString = ''.
	self assert: self empty asCommaStringAnd = ''.
	
! !

!SetTest methodsFor: 'tests - empty' stamp: 'stephane.ducasse 10/5/2008 13:11'!
nonEmpty
	
	^ full! !

!SetTest methodsFor: 'test - copy' stamp: 'delaunay 4/17/2009 15:26'!
elementToAdd
	^ 42! !

!SetTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCreationWithTest
	self collectionMoreThan5Elements.
	self assert: self collectionMoreThan5Elements size >= 5! !

!SetTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyNonEmpty
	"self debug: #testCopyNonEmpty"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: copy isEmpty.
	self assert: copy size = self nonEmpty size.
	self nonEmpty do: 
		[:each | copy includes: each]! !

!SetTest methodsFor: 'tests - remove' stamp: ''!
testRemoveAllFoundIn
	"self debug: #testRemoveElementThatExists"
	| el aSubCollection res |
	el := self nonEmptyWithoutEqualElements anyOne.
	aSubCollection := (self nonEmptyWithoutEqualElements copyWithout: el) copyWith: self elementNotIn.
	res := self nonEmptyWithoutEqualElements removeAllFoundIn: aSubCollection.
	self assert: self nonEmptyWithoutEqualElements size = 1.
	self nonEmptyWithoutEqualElements do: [ :each | self assert: each = el ]! !

!SetTest methodsFor: 'test - enumerating' stamp: 'TudorGirba 11/3/2013 11:09'!
testFlatCollect
	self assert: (#(1 2) asSet flatCollect: [ :x | 1 to: (2 * x) ]) = #(1 2 3 4) asSet.
	self assert: (#() asSet flatCollect: [:x | 1 to: 4 ]) isEmpty! !

!SetTest methodsFor: 'tests - printing' stamp: ''!
testPrintNameOn

	| aStream result |
	result:=''.
	aStream:= ReadWriteStream on: result.
	self nonEmpty printNameOn: aStream.
	self nonEmpty class name first isVowel
		ifTrue:[ self assert: aStream contents =('an ',self nonEmpty class name ) ]
		ifFalse:[self assert: aStream contents =('a ',self nonEmpty class name)].! !

!SetTest methodsFor: 'test - equality' stamp: ''!
testEqualSignIsTrueForNonIdenticalButEqualCollections
	"self debug: #testEqualSignIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty = self empty copy). 
	self assert: (self empty copy = self empty).
	self assert: (self empty copy = self empty copy).
		
	self assert: (self nonEmpty = self nonEmpty copy). 
	self assert: (self nonEmpty copy = self nonEmpty).
	self assert: (self nonEmpty copy = self nonEmpty copy).! !

!SetTest methodsFor: 'test - creation' stamp: ''!
testWithWith
	"self debug: #testWithWith"
	
	| aCol collection element1 element2 |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom: 1 to: 2  .
	element1 := collection at: 1.
	element2 := collection at:2.
	
	aCol := self collectionClass with: element1  with: element2 .
	self assert: (aCol occurrencesOf: element1 ) = ( collection occurrencesOf: element1).
	self assert: (aCol occurrencesOf: element2 ) = ( collection occurrencesOf: element2).
	
	! !

!SetTest methodsFor: 'sunit original tests' stamp: 'stephane.ducasse 10/6/2008 19:35'!
testIncludes
	self assert: (full includes: 4).
	self assert: (full includes: 3).
	self deny: (full includes: 6).
			! !

!SetTest methodsFor: 'tests - size capacity' stamp: 'stephane.ducasse 10/6/2008 19:33'!
sizeCollection

	^ full! !

!SetTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsCommaStringMore

	| result resultAnd index allElementsAsString tmp |
	result:= self nonEmpty asCommaString .
	resultAnd:= self nonEmpty asCommaStringAnd .
	tmp :=OrderedCollection new. 
	self nonEmpty do: [ :each | tmp add: each asString].

	"verifying result  :"
	index := 1.
	allElementsAsString := (result findBetweenSubStrs: ', ' ).
	allElementsAsString do:
		[:each |
		self assert: (tmp occurrencesOf: each)=(allElementsAsString occurrencesOf: each).
		].
	
	"verifying esultAnd :"
	allElementsAsString:=(resultAnd findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 ) | i= allElementsAsString size
			ifTrue: [self assert: (tmp occurrencesOf:(allElementsAsString at:i))=(allElementsAsString  occurrencesOf:(allElementsAsString at:i))].
		i=(allElementsAsString size-1)
			ifTrue:[ self assert: (allElementsAsString at:i)=('and')].
			].! !

!SetTest methodsFor: 'some tests' stamp: 'stephane.ducasse 10/6/2008 19:34'!
testSize2
	self assert: (empty size = 0).
	self assert: (full size = 4).
	empty add: 2.
	empty add: 1.
	full add: 2.
	self assert: (empty size = 2).
	self assert: (full size = 4).
	empty remove: 2.
	self assert: (empty size = 1).! !

!SetTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureTRemoveTest
	| duplicate |
	self empty.
	self nonEmptyWithoutEqualElements.
	self deny: self nonEmptyWithoutEqualElements isEmpty.
	duplicate := true.
	self nonEmptyWithoutEqualElements
		detect: [ :each | (self nonEmptyWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ duplicate := false ].
	self assert: duplicate = false.
	self elementNotIn.
	self assert: self empty isEmpty.
	self deny: self nonEmptyWithoutEqualElements isEmpty.
	self deny: (self nonEmptyWithoutEqualElements includes: self elementNotIn)! !

!SetTest methodsFor: 'tests - empty' stamp: 'stephane.ducasse 10/5/2008 13:11'!
empty
	
	^ empty! !

!SetTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWith
	"self debug: #testCopyNonEmptyWith"
	| res anElement |
	anElement := self elementToAdd .
	res := self nonEmpty copyWith: anElement.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self assert: (res includes: (anElement value)).
	self nonEmpty do: [ :each | res includes: each ]! !

!SetTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsStringOnDelimiterEmpty

	| delim emptyStream |
	delim := ', '.
	emptyStream := ReadWriteStream on: ''.
	self empty asStringOn: emptyStream delimiter: delim.
	self assert: emptyStream contents = ''.
! !

!SetTest methodsFor: 'tests - copy' stamp: 'delaunay 3/30/2009 10:33'!
testCopyNonEmptyWithoutAllNotIncluded
	! !

!SetTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 12/18/2009 13:14'!
collection

	^ collectionWith3Elements! !

!SetTest methodsFor: 'tests' stamp: 'nice 9/14/2009 21:08'!
testRemoveAll
	"Allows one to remove all elements of a collection" 
	
	| c1 c2 s2 |
	c1 := full.
	c2 := c1 copy.
	s2 := c2 size.
	
	c1 removeAll.
	
	self assert: c1 size = 0.
	self assert: c2 size = s2 description: 'the copy has not been modified'.! !

!SetTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 12:00'!
anotherElementOrAssociationIn
	" return an element (or an association for Dictionary ) present  in 'collection' "
	^ self collection  anyOne! !

!SetTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionEmpty
	"self debug: #testIntersectionEmpty"
	
	| inter |
	inter := self empty intersection: self empty.
	self assert: inter isEmpty. 
	inter := self empty intersection: self collection .
	self assert: inter =  self empty.
	! !

!SetTest methodsFor: 'some tests' stamp: 'stephane.ducasse 5/20/2009 18:07'!
testIntersection 
	| newFull col |
	full add: 3; add: 2.
	col := full intersection: full.
	self assert: (full = col).

	newFull := Set with: 8 with: 9 with: #z.
	col := newFull intersection: full.
	self assert: (col isEmpty).
	
	newFull add: 5; add: #abc; add: 7.
	col := newFull intersection: full.
	self assert: ((full select: [:each | (newFull includes: each)]) = col).
	
	
	! !

!SetTest methodsFor: 'requirements' stamp: 'delaunay 4/24/2009 10:28'!
collectionWithSortableElements
" return a collection elements that can be sorte ( understanding message ' < '  or ' > ')"
	^collectionOfFloat ! !

!SetTest methodsFor: 'some tests' stamp: 'GL 2/28/2006 09:25'!
testAtRandom
	| rand |
	rand := Random new.
	full add: 3.
	full add: 2.
	full add: 4.
	full add: 1.
	self assert: (full includes: (full atRandom: rand)).
	! !

!SetTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedCollectionWithSortBlock
	| result tmp |
	result := self collectionWithSortableElements  asSortedCollection: [:a :b | a > b].
	self assert: (result class includesBehavior: SortedCollection).
	result do: 
		[ :each | 
		self assert: (self collectionWithSortableElements   occurrencesOf: each) = (result occurrencesOf: each) ].
	self assert: result size = self collectionWithSortableElements  size.
	tmp:=result at: 1.
	result do: [:each| self assert: tmp>=each. tmp:=each].
	! !

!SetTest methodsFor: 'tests - converting' stamp: ''!
assertSameContents: aCollection whenConvertedTo: aClass 
	| result |
	result := self assertNonDuplicatedContents: aCollection whenConvertedTo: aClass.
	self assert: result size = aCollection size! !

!SetTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 12/18/2009 13:18'!
collectionWithoutElement
	" return a collection that does not include 'element' "
	^ collectionWith3Elements  ! !

!SetTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOfNotIn
	| result |
	result := self collectionWithoutEqualElements occurrencesOf: self elementNotInForOccurrences.
	self assert: result = 0! !

!SetTest methodsFor: 'some tests' stamp: 'stephane.ducasse 10/6/2008 16:56'!
testCollect2
	| newFull result |
	newFull := Set withAll: (1 to: 10).
	result := newFull collect: [:each | each >= 1 ifTrue: [each] ifFalse: ['no']].
	self assert: (result = newFull).
	result := newFull collect: [:each | each >= 5 ifTrue: [each] ifFalse: ['no']].
	self assert: (result = ((Set withAll: (5 to: 10)) add: 'no'; yourself)).! !

!SetTest methodsFor: 'test - creation' stamp: ''!
testWithAll
	"self debug: #testWithAll"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection .
	aCol := self collectionClass withAll: collection  .
	
	collection do: [ :each | self assert: (aCol occurrencesOf: each ) = ( collection occurrencesOf: each ) ].
	
	self assert: (aCol size = collection size ).! !

!SetTest methodsFor: 'requirements' stamp: 'delaunay 5/13/2009 11:14'!
collectionNotIncluded
	^ self classToBeTested  with: elementNotIn. ! !

!SetTest methodsFor: 'tests - includes' stamp: 'delaunay 4/2/2009 11:53'!
elementNotInForOccurrences
	^ 666! !

!SetTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureOccurrencesTest
	| tmp |
	self empty.
	self assert: self empty isEmpty.
	self collectionWithoutEqualElements.
	self deny: self collectionWithoutEqualElements isEmpty.
	tmp := OrderedCollection new.
	self collectionWithoutEqualElements
		do: [ :each | 
			self deny: (tmp includes: each).
			tmp add: each ].
	self elementNotInForOccurrences.
	self deny: (self collectionWithoutEqualElements includes: self elementNotInForOccurrences)! !

!SetTest methodsFor: 'test - equality' stamp: ''!
testEqualSignOfIdenticalCollectionObjects
	"self debug: #testEqualSignOfIdenticalCollectionObjects"
	
	self assert: (self empty = self empty). 
	self assert: (self nonEmpty = self nonEmpty). 
	! !

!SetTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyCreatesNewObject
	"self debug: #testCopyCreatesNewObject"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: self nonEmpty == copy.
	! !

!SetTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifferenceWithNonNullIntersection
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifferenceWithNonNullIntersection"
	"	#(1 2 3) difference: #(2 4) 
	->  #(1 3)"
	| res overlapping |
	overlapping := self collectionClass 
		with: self anotherElementOrAssociationNotIn
		with: self anotherElementOrAssociationIn.
	res := self collection difference: overlapping.
	self deny: (res includes: self anotherElementOrAssociationIn).
	overlapping do: [ :each | self deny: (res includes: each) ]! !

!SetTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 12:01'!
anotherElementOrAssociationNotIn
	" return an element (or an association for Dictionary )not present  in 'collection' "
	^ elementNotIn ! !

!SetTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 12/18/2009 13:18'!
secondCollection
" return a collection that will be the second part of the concatenation"
	^ collectionWith3Elements  ! !

!SetTest methodsFor: 'tests - concatenation' stamp: ''!
testConcatenation

| collection1 collection2 result |
collection1 := self firstCollection .
collection2 := self secondCollection .
result := collection1 , collection2.

collection1 do:[ :each | self assert: (result includes: each)].
collection2 do:[ :each | self assert: (result includes: each)].
! !

!SetTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionBasic
	"self debug: #testIntersectionBasic"
	| inter |
	inter := self collection intersection: (self collectionClass with: self anotherElementOrAssociationIn).
	self deny: inter isEmpty.
	self assert: (inter includes: self anotherElementOrAssociationIn value)! !

!SetTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutNotIncluded
	"self debug: #testCopyNonEmptyWithoutNotIncluded"
	| res |
	res := self nonEmpty copyWithout: self elementToAdd.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self nonEmpty do: [ :each | self assert: (res includes: each) ]! !

!SetTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifference
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifference"
	
	| difference |
	self assert: (self collectionWithoutEqualElements difference: self collectionWithoutEqualElements) isEmpty.
	self assert: (self empty difference: self collectionWithoutEqualElements) isEmpty.
	difference := (self collectionWithoutEqualElements difference: self empty).
	self assert: difference size = self collectionWithoutEqualElements	 size.
	self collectionWithoutEqualElements do: [ :each |
		self assert: (difference includes: each)].
! !

!SetTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithout
	"self debug: #testCopyNonEmptyWithout"
	
	| res anElementOfTheCollection |
	anElementOfTheCollection :=  self nonEmpty anyOne.
	res := (self nonEmpty copyWithout: anElementOfTheCollection).
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self deny: (res includes: anElementOfTheCollection).
	self nonEmpty do:
		[:each | (each = anElementOfTheCollection) 
					ifFalse: [self assert: (res includes: each)]].
	
! !

!SetTest methodsFor: 'tests - converting' stamp: ''!
testAsOrderedCollection
	
	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: OrderedCollection! !

!SetTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionItself
	"self debug: #testIntersectionItself"
	
	| result |
	result :=  (self collectionWithoutEqualElements intersection: self collectionWithoutEqualElements).
	self assert: result size  = self collectionWithoutEqualElements size.
	self collectionWithoutEqualElements do: [ :each|
		self assert: (result includes: each) ].
	! !

!SetTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOf
	| collection |
	collection := self collectionWithoutEqualElements .
	
	collection do: [ :each | self assert: (collection occurrencesOf: each) = 1 ].! !

!SetTest methodsFor: 'requirements' stamp: 'stephane.ducasse 10/8/2008 15:42'!
element
	^ 4! !

!SetTest methodsFor: 'tests - size capacity' stamp: 'stephane.ducasse 10/6/2008 17:09'!
emptyButAllocatedWith20

	^ emptyButAllocatedWith20! !

!SetTest methodsFor: 'tests - fixture' stamp: ''!
test0CopyTest
	self empty.
	self assert: self empty size = 0.
	self nonEmpty.
	self assert: (self nonEmpty size = 0) not.
	self collectionWithElementsToRemove.
	self assert: (self collectionWithElementsToRemove size = 0) not.
	self collectionWithElementsToRemove do: [ :each | self assert: (self nonEmpty includes: each) ].
	self elementToAdd.
	self deny: (self nonEmpty includes: self elementToAdd).
	self collectionNotIncluded.
	self collectionNotIncluded do: [ :each | self deny: (self nonEmpty includes: each) ]! !

!SetTest methodsFor: 'tests - remove' stamp: ''!
testRemoveAllSuchThat
	"self debug: #testRemoveElementThatExists"
	| el aSubCollection |
	el := self nonEmptyWithoutEqualElements anyOne.
	aSubCollection := self nonEmptyWithoutEqualElements copyWithout: el.
	self nonEmptyWithoutEqualElements removeAllSuchThat: [ :each | aSubCollection includes: each ].
	self assert: self nonEmptyWithoutEqualElements size = 1.
	self nonEmptyWithoutEqualElements do: [ :each | self assert: each = el ]! !

!SetTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 12/18/2009 12:02'!
result

	 ^ collectResult! !

!SetTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 10:22'!
collectionWithCopyNonIdentical
	" return a collection that include elements for which 'copy' return a different object (this is not the case of SmallInteger)"
	^ collectionOfFloat! !

!SetTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWithout
	"self debug: #testCopyEmptyWithout"
	| res |
	res := self empty copyWithout: self elementToAdd.
	self assert: res size = self empty size.
	self deny: (res includes: self elementToAdd)! !

!SetTest methodsFor: 'test - equality' stamp: ''!
testEqualSign
	"self debug: #testEqualSign"

	self deny: (self empty = self nonEmpty).! !

!SetTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 11:28'!
nonEmptyWithoutEqualElements
" return a collection without equal elements "
	^ withoutEqualElements ! !

!SetTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedCollection

	| aCollection result |
	aCollection := self collectionWithSortableElements .
	result := aCollection asSortedCollection.
	
	self assert: (result class includesBehavior: SortedCollection).
	result do: 
		[ :each | 
		self assert: (aCollection occurrencesOf: each) = (result occurrencesOf: each) ].
	
	self assert: result size = aCollection size.! !

!SetTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 10:01'!
nonEmpty1Element
" return a collection of size 1 including one element"
	^ nonEmpty1element ! !

!SetTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureConcatenationTest
	self firstCollection.
	self deny: self firstCollection isEmpty.
	self firstCollection.
	self deny: self firstCollection isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!SetTest methodsFor: 'some tests' stamp: 'stephane.ducasse 5/20/2009 18:05'!
testUnion
	| newFull col newCol |
	full add: 3.
	full add: 2.
	col := full union: full.
	self assert: (full = col).

	newFull := Set with: 8 with: 9 with: #z.
	col := newFull union: full.
	self assert: (col size = (full size + newFull size)).
	self assert: ((col select: [:each | (full includes: each) not]) = newFull).
	self assert: ((col select: [:each | (newFull includes: each) not]) = full).

	full add: 9.
	col := newFull union: full.
	newCol := newFull copy.
	newCol remove: 9.
	self assert: (col size = (full size + newFull size - 1)).
	self assert: ((col select: [:each | (full includes: each) not]) = newCol).
	newCol := full copy.
	newCol remove: 9.
	self assert: ((col select: [:each | (newFull includes: each) not]) = newCol).
	
	
	! !

!SetTest methodsFor: 'test - enumerating' stamp: 'TudorGirba 11/3/2013 12:08'!
testFlatCollectAsSet
	self assert: (#(1 2) asSet flatCollect: [ :x | 1 to: (2 * x) ]) = #(1 2 3 4) asSet! !

!SetTest methodsFor: 'sunit original tests' stamp: 'stephane.ducasse 10/6/2008 19:39'!
testOccurrences
	self assert: ((empty occurrencesOf: 0) = 0).
	self assert: ((full occurrencesOf: 4) = 1).
	full add: 4.
	self assert: ((full occurrencesOf: 4) = 1).! !

!SetTest methodsFor: 'tests - copy' stamp: ''!
testCopySameClass
	"self debug: #testCopySameClass"
	"A copy of a collection should always be of the same class as the instance it copies"
	
	| copy | 
	copy := self empty copy.
	self assert: copy class == self empty class.! !

!SetTest methodsFor: 'test - creation' stamp: ''!
testWithWithWithWith
	"self debug: #testWithWithWithWith"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom: 1 to: 4.
	aCol := self collectionClass with: (collection at:1) with: ( collection at:2 ) with: ( collection at: 3) with: ( collection at: 4).

	1 to: 3 do: [ :i | self assert: ( aCol occurrencesOf: ( collection at: i ) ) = ( collection occurrencesOf: ( collection at: i ) ) ].! !

!SetTest methodsFor: 'test - iterate' stamp: 'stephane.ducasse 10/6/2008 19:40'!
selectedNumber

	^ 2
	! !

!SetTest methodsFor: 'test - iterate' stamp: 'stephane.ducasse 10/6/2008 17:39'!
speciesClass
	
	^ Set! !

!SetTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsCommaStringOne
	
	self nonEmpty1Element do: 
		[:each | 
		self assert: each asString =self nonEmpty1Element  asCommaString.
		self assert: each asString=self nonEmpty1Element  asCommaStringAnd.].

	! !

!SetTest methodsFor: 'tests - set arithmetic' stamp: ''!
containsAll: union of: one andOf: another
			
	self assert: (one allSatisfy: [:each | union includes: each]).
	self assert: (another allSatisfy: [:each | union includes: each])! !

!SetTest methodsFor: 'sunit original tests' stamp: 'stephane.ducasse 5/20/2009 18:05'!
testGrow 
	empty addAll: (1 to: 100).
	self assert: (empty size = 100).
			! !

!SetTest methodsFor: 'tests - fixture' stamp: ''!
test0FixturePrintTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty! !

!SetTest methodsFor: 'tests - growable' stamp: ''!
testAddEmptyGrows
	"self debug: #testAddEmptyGrows"
	
	| oldSize |
	oldSize := self empty size.
	self empty add: self element.
	self assert: (self empty size) = (oldSize + 1).! !

!SetTest methodsFor: 'ambiguous' stamp: 'delaunay 4/20/2009 16:42'!
elementNotIn
	^elementNotIn ! !

!SetTest methodsFor: 'initialize' stamp: 'cyrille.delaunay 12/18/2009 13:14'!
setUp
	empty := self classToBeTested  new.
	full := self classToBeTested  with: 1 with: 2 with: 3 with: 4.
	collectionIncluded := self classToBeTested  with: 2 with: 3 .
	collectionWith3Elements := self classToBeTested  new.
	collectionWith3Elements add: 1; add: -2; add: 3. 
	collectResult := self classToBeTested  new add: SmallInteger ; yourself.
	emptyButAllocatedWith20 := self classToBeTested  new: 20.
	elementNotIn := 99.
	collectionOfFloat := self classToBeTested  with: 2.5 with: 4.6 with: 4.2.
	nonEmpty1element := self classToBeTested  with: 32.
	withoutEqualElements := self classToBeTested  with: 4 with: 5 with: 2.
	collection5Elements := self classToBeTested with: 1 with: 2 with: 3 with: 4 with: 5.! !

!SetTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAllNoneThere
	"self debug: #testIncludesAllOfNoneThere'"
	self deny: (self empty includesAll: self nonEmpty ).
	self deny: (self nonEmpty includesAll: { self elementNotIn. self anotherElementNotIn })! !

!SetTest methodsFor: 'test - creation' stamp: ''!
testWithWithWithWithWith
	"self debug: #testWithWithWithWithWith"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom: 1 to: 5 .
	aCol := self collectionClass with: (collection at:1) with: ( collection at:2 ) with: ( collection at: 3) with: (collection at: 4 ) with: ( collection at: 5 ).

	1 to: 3 do: [ :i | self assert: ( aCol occurrencesOf: ( collection at: i ) ) = ( collection occurrencesOf: ( collection at: i ) ) ].! !

!SetTest methodsFor: 'tests - printing' stamp: ''!
testPrintOnDelimiterLast

	| aStream result allElementsAsString tmp |
	result:=''.
	aStream:= ReadWriteStream on: result.
	tmp:= OrderedCollection new.
	self nonEmpty do: [:each | tmp add: each asString].
	
	self nonEmpty printOn: aStream delimiter: ', ' last: 'and'.
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 )
			ifTrue: [self assert: (tmp occurrencesOf: (allElementsAsString at:i))=(allElementsAsString  occurrencesOf: (allElementsAsString at:i))].
		i=(allElementsAsString size-1)
			ifTrue:[ self deny: (allElementsAsString at:i)=('and')asString].
		i=(allElementsAsString size)
			ifTrue: [self assert: (tmp occurrencesOf: (allElementsAsString at:i))=(allElementsAsString  occurrencesOf: (allElementsAsString at:i))].
			].! !

!SetTest methodsFor: 'tests - converting' stamp: ''!
testAsBag

	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: Bag! !

!SetTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsStringOnDelimiterOne

	| delim oneItemStream result |

	delim := ', '.
	result:=''.
	oneItemStream := ReadWriteStream on: result.
	self nonEmpty1Element  asStringOn: oneItemStream delimiter: delim.
	oneItemStream  do:
		[:each1 |
		self nonEmpty1Element do: [:each2 |self assert: each1 = (each2 asString) ]
		 ].
	
! !

!SetTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWith
	"self debug: #testCopyWith"
	| res anElement |
	anElement := self elementToAdd.
	res := self empty copyWith: anElement.
	self assert: res size = (self empty size + 1).
	self assert: (res includes: (anElement value))! !

!SetTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureConverAsSortedTest
	self collectionWithSortableElements.
	self deny: self collectionWithSortableElements isEmpty! !

!SetTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 16:40'!
elementInForIncludesTest
" return an element included in nonEmpty "
	^ self nonEmpty anyOne! !

!SetTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:23'!
test0FixtureAddForUniquenessTest
	self element.
	self collectionWithElement.
	self assert: (self collectionWithElement includes: self element).
	self collectionWithoutElement.
	self assert: (self collectionWithElement includes: self element)! !

!SetTest methodsFor: 'some tests' stamp: 'CamilloBruni 7/3/2013 13:12'!
testAllSetsAreHealthy
	| badSets |
	"Only run for Set"
	self collectionClass = Set
		ifFalse: [ ^ self ].
	badSets := Set allSubInstances select: [:badSet | 
		badSet isHealthy not ].
	self assert: badSets isEmpty.! !

!SetTest methodsFor: 'tests - adding uniquely' stamp: ''!
testAddAlreadyThereDoesNotCount

	| added oldSize |
	oldSize := self collectionWithElement size.
	self assert: (self collectionWithElement includes: self element).

	added := self collectionWithElement add: self element.
	
	self assert: added = self element.
	self assert: (self collectionWithElement includes: self element).
	self assert: self collectionWithElement size = oldSize.! !

!SetTest methodsFor: 'tests - printing' stamp: ''!
testStoreOn
" for the moment work only for collection that include simple elements such that Integer"

"| string str result cuttedResult index elementsAsStringExpected elementsAsStringObtained tmp |
string := ''.
str := ReadWriteStream  on: string.
elementsAsStringExpected := OrderedCollection new.
elementsAsStringObtained := OrderedCollection new.
self nonEmpty do: [ :each | elementsAsStringExpected  add: each asString].

self nonEmpty storeOn: str.
result := str contents .
cuttedResult := ( result findBetweenSubStrs: ';' ).

index := 1.

cuttedResult do:
	[ :each |
	index = 1 
		ifTrue: [ self assert: (each beginsWith: ( tmp := '((' , self nonEmpty class asString , ' new) add: '           )).
				tmp := each copyFrom: ( tmp size + 1) to: ( each size ).
				elementsAsStringObtained add: tmp.
				index := index + 1. ]
		ifFalse:  [ 
		 index < cuttedResult size
			ifTrue:[self assert: (each beginsWith: ( tmp:=  ' add: '   )).
				tmp := each copyFrom: ( tmp size + 1) to: ( each size ).
				elementsAsStringObtained add: tmp.
					index := index + 1.]
			ifFalse: [self assert: ( each = ' yourself)' ) ].
			]
	
	].


	elementsAsStringExpected do: [ :each | self assert: (elementsAsStringExpected occurrencesOf: each ) = ( elementsAsStringObtained occurrencesOf: each) ]"

! !

!SetTest methodsFor: 'tests - remove' stamp: ''!
testRemoveAllError
	"self debug: #testRemoveElementThatExists"
	| el aSubCollection |
	el := self elementNotIn.
	aSubCollection := self nonEmptyWithoutEqualElements copyWith: el.
	self 
		should: [ | res | res := self nonEmptyWithoutEqualElements removeAll: aSubCollection ]
		raise: Error! !

!SettingBrowser commentStamp: '<historical>'!
<help>

!! The User interface
A SettingBrowser allows the browsing as well as the editing of setting values.
For each setting, a label and an input widget allowing the change of the setting value are shown.

!!!! Browsing standards settings
In order to open a setting browser one can also use the expression below:
--------------------
SettingBrowser open
--------------------
It opens a SettingBrowser for all settings declared with the standard 'systemsettings' pragma keyword. 
To see how these settings are declared in the image, you can browse all senders of #systemsettings:
--------------
SystemNavigation new  browseAllSendersOf: #systemsettings
--------------

!!!! Browsing application specific settings
For specific applications, other pragma keywords can be used. These keywords can be passed as follow:
--------------------
(SettingBrowser forKeywords: #('blob')) open.
--------------------
Then, only settings which are declared with the keyword 'blob' are viewed. 
Here is an example of such a setting declared in the class side of a class BlobSettings 
--------------------
BlobSettings class>>blobSettingOn: aBuilder
	<blob>
	(aBuilder group: #blobEditing) 
		label: 'Editing' translated;
		parent: #blobBrowsing; 
		description: 'All settings concerned with blob editing' translated;
		with: [	
			(aBuilder setting: #color)	...
--------------------
The expression 'SettingBrowser open' is then equivalent to the '(SettingBrowser forKeywords: #('systemsettings')) open' expression.

!!!! Filtering
The SettingBrowser has a filtering functionality to limitate the number of settings. You can enter a token in the input field of the toolbar in order to show only settings that are matching the token.
Two filtering modes are allowed:  with a substring or with a regular expression.
- with a substring: only settings which name, description, pragma class or method selector includes this substring are viewed; 
- with a regular expression: the same as with a substring except that the input is used as a regular expression. This filtering is applied if the Regexp checkbox is checked.

!! How to declare a setting
A setting is declared with a method class side. This kind of method takes a builder as argument and a standard setting is tagged with the <systemsettings> pragma. The builder argument serves as a facade for the declaration.

!!!!A simple boolean setting example

Let's start with a setting declaration example:
CodeHolderSystemSettings class>>caseSensitiveFindsSettingsOn: aBuilder
	<systemsettings>
	(aBuilder setting: #caseSensitiveFinds) 
		label: 'Case sensitive search' translated;
		description: 'If true, then the "find" command in text will always make its searches in a case-sensitive fashion' translated;
		setSelector: #caseSensitiveFinds:;
		getSelector: #caseSensitiveFinds;
		target: TextEditor;
		parent: #codeEditing.

For this setting to be declared, we make the asumption that we have TextEditor class>>caseSensitiveFinds and TextEditor class>>caseSensitiveFinds: methods in order to change the preference value. 
To declare a setting, just send #setting: to the builder with its identifier, a Symbol passed as argument. It creates a setting node. Then you can set the label, the description with #label: and #description sent to the newly created setting node. You also have to set the selectors for setting and getting the preference value as well as the target to which these accessors are sent  (often a class). This is done by sending respectively, #setSelector:, #getSelector: and #target: to the setting node.
Because all settings are organized in trees we need a way to indicate what is the position of the setting node in the overall setting trees list. In fact it can be done two ways. The first way is to use the #parent: message (A second possibility is to declare a subtree in one method, it is explained later in this documentation).The #parent: message is send for non root settings. #parent takes the identifier of the parent setting as argument.

You may notice that in this example,  if we don't take into account the $: at the end of the setting accessor, the getting and the setting accessors are the same. This is often the case. You can simply set the setter and the getter by sending the #selector: message to the setting node. Thus the declaration is simplified as follow:
CodeHolderSystemSettings class>>caseSensitiveFindsSettingsOn: aBuilder
	<systemsettings>
	(aBuilder setting: #caseSensitiveFinds) 
		label: 'Case sensitive search' translated;
		description: 'If true, then the "find" command in text will always make its searches in a case-sensitive fashion' translated;
		selector: #caseSensitiveFinds;
		target: TextEditor;
		parent: #codeEditing.

You may also notice that the identifier of the setting is then the same as the selector. In this case, you can omit to set the selector because by default, the identifier is used as the selector for getting the preference value and the identifier concatenated with a $: at the end is used as the setting selector. Thus the declaration is simplified again as follow:
CodeHolderSystemSettings class>>caseSensitiveFindsSettingsOn: aBuilder
	<systemsettings>
	(aBuilder setting: #caseSensitiveFinds) 
		label: 'Case sensitive search' translated;
		description: 'If true, then the "find" command in text will always make its searches in a case-sensitive fashion' translated;
		target: TextEditor;
		parent: #codeEditing.

Finally, if you decide to declare a setting directly in the class which implements the selector, the target information can be also omitted because the class in which the setting is declared is used by default. Thus the simplest declaration can be:
TextEditor class>>caseSensitiveFindsSettingsOn: aBuilder
	<systemsettings>
	(aBuilder setting: #caseSensitiveFinds) 
		label: 'Case sensitive search' translated;
		description: 'If true, then the "find" command in text will always make its searches in a case-sensitive fashion' translated;
		parent: #codeEditing.

!!!!Declaring a subtree in one single method
Directly declaring a sub-tree of settings in one method is also possible. Then, typically, a root group is declared for the application settings and the children settings themselves are also declared within the same method as in the example below in which #formatCommentWithStatements and #indentString are directly declared as children of the #configurableFormatter setting:

RBConfigurableFormatter class>>settingsOn: aBuilder
	<systemsettings>	
	(aBuilder group: #configurableFormatter)
		target: self;
		parent: #refactoring;
		label: 'Configurable Formatter' translated;
		description: 'Settings related to the formatter' translated;
		with: [
			(aBuilder setting: #formatCommentWithStatements)
				label: 'Format comment with statements' translated.
			(aBuilder setting: #indentString)
				label: 'Indent string' translated]

!!!!Optional setting
Any setting can have children. In the case where a boolean setting is used as a parent, then, its children are chown only if the parent preference value is true.

!!!!Range setting
You send the #range: message to the builder instead of the #setting: message. In addition, you send the #range: message to the setting with an interval as argument in order to indicate the valid range.
screenMarginSettingOn: aBuilder
	<systemsettings>
	(aBuilder range: #fullscreenMargin)
		target: SystemWindow;
		parent: #windows;
		label: 'Fullscreen margin' translated;
		description: 'Specify the amount of space that is let around a windows when it''s opened fullscreen' translated;
		range: (-5 to: 100).

!!!!List setting
For this kind of setting, the SettingBrowser will show a drop list. Here is an example for the window position strategy. Notice that the setting is declared by sending the #pickOne message to the builder. Notice also that the list of valid values are given by sending the #domainValues: message to the setting. The argument is an array of association. Each association key is the label that is shown and the corresponding association value gives the value that will be assigned to the preference.
windowPositionStrategySettingsOn: aBuilder
	<systemsettings>
	(aBuilder pickOne: #usedStrategy) 
		label: 'Window position strategy' translated;
		target: RealEstateAgent;
		domainValues: {
			'Reverse Stagger' translated -> #staggerFor:initialExtent:world:. 
			'Cascade' translated -> #cascadeFor:initialExtent:world:. 
			'Standard' translated -> #standardFor:initialExtent:world:};

!!!!Launcher
A launcher is a particular setting. It allows to launch a script directly from the setting browser. Imagine that you have changed some settings and that you need to evaluate a script in order to update some other objets. It can be used also to configurate globally a package of the entire image.
As an example, in order to use True Type Fonts, the system must be updated by collecting all the available TT fonts. This can be done by evaluating the following expression:
-------------
FreeTypeFontProvider current updateFromSystem
-------------
In order to be able to launch this script from the setting browser, you have to declare a launcher. For example, look-at how the script for the TT fonts is declared in GraphicFontSettings class >> #standardFontsSettingsOn:.

GraphicFontSettings class >> #standardFontsSettingsOn:
	<systemsettings>
	(aBuilder group: #standardFonts)
		...
		(aBuilder launcher: #updateFromSystem)
				order: 1; 
				target: FreeTypeFontProvider;
				targetSelector: #current;
				description: 'Update available fonts by scanning the current system';
				script: #updateFromSystem;
				label: 'Update fonts from system' translated.

Notice that you send #launcher: to the builder in order to create the setting node, then you send #script: to the created node with the selector of the script passed as argument.
</help>

Implementation details
See also SettingNode, SettingTree, SettingNodeBuilder and SettingTreeBuilder classes.

Instance Variables
	roots:		<Collection of SettingTreeNode>
	searchedText:		<String>
	status:		<WriteStream>
	collector:		<SettingCollector>

roots
	- the roots of the viewed setting trees

searchedText
	- the string used as a filter token or regexp in order to select viewed settings

status
	- a WriteStream used in order to store useful information which are shown when no current item is selected

collector
	- The SettingCollector which has the responsibility to collect settings and to build viewed trees
!
!SettingBrowser methodsFor: 'menu' stamp: 'alain.plantec 10/19/2009 14:17'!
menuSetToDefault: aTreeNode
	| v |
	(v := aTreeNode settingDeclaration) hasDefault
		ifTrue: [(self confirm: 'Set to default value ?' translated)
				ifTrue: [v setToDefault. self updateList]]! !

!SettingBrowser methodsFor: 'user interface' stamp: 'AlainPlantec 10/11/2011 14:59'!
choosePackagesIn: aWindow 
	| result list |
	list := MorphTreeModel new
				beCheckList;
				autoMultiSelection: true;
				rootItems: (self allPackagesWithSettings asArray sort: [:a :b | a packageName < b packageName]);
				 wrapBlockOrSelector: #packageName.
	result := list openDialogWindowIn: aWindow title: 'Choose packages' selectedtems: self viewedPackages.
	result ifNotNil: [self changePackageSet: result]! !

!SettingBrowser methodsFor: 'updating' stamp: 'AlainPlantec 9/17/2011 21:34'!
updateAccordingTo: aFilter
	self selection: nil.
	self setDescription: ''.
	roots := nil.
	self updateList.
	[
	self rootNodes do: [:r | r updateAccordingTo: aFilter].
	self rootNodes removeAllSuchThat: [:n | (aFilter keepSettingTreeNode: n) not and: [n isEmpty]].
	]
		on: RegexSyntaxError
		do: [:ex | 
			self setDescription: 'Regular expression syntax error, see `documentation'' protocol of RxParser class for user''s guide'].
	self expandAll! !

!SettingBrowser methodsFor: 'accessing' stamp: 'AlainPlantec 1/1/2012 22:31'!
regexpSearch: aBoolean
	self class regexpSearch: aBoolean.
! !

!SettingBrowser methodsFor: 'accessing' stamp: 'alain.plantec 4/20/2009 09:19'!
searchedTextList
	^ self class searchedTextList! !

!SettingBrowser methodsFor: 'menu' stamp: 'alain.plantec 10/19/2009 14:49'!
menuEmptyList: aTreeNode
	| v |
	(v := aTreeNode settingDeclaration) hasEditableList 
		ifTrue: [v emptyList. self updateList]! !

!SettingBrowser methodsFor: 'user interface' stamp: 'AlainPlantec 4/29/2010 17:51'!
newTreeHolder
	^ SettingTree new  acceptableKeywords: self settingsKeywords! !

!SettingBrowser methodsFor: 'accessing' stamp: 'AlainPlantec 2/4/2010 17:15'!
rootNodes
	^ roots ifNil: [roots := self treeHolder settingTreeRoots]
! !

!SettingBrowser methodsFor: 'accessing' stamp: 'AlainPlantec 11/24/2009 11:44'!
acceptableKeywords: aCollectionOfRegExps 
	self treeHolder acceptableKeywords: aCollectionOfRegExps ! !

!SettingBrowser methodsFor: 'user interface' stamp: 'AlainPlantec 1/29/2010 21:23'!
helpMenuIn: aWindow
	| helpMenu |
	helpMenu := aWindow newMenu.
	helpMenu
		addToggle: 'About' translated
		target: self
		selector: #about.
	helpMenu lastItem font: aWindow theme menuFont.
	helpMenu
		addToggle: 'Declaring and managing settings' translated
		target: self
		selector: #helpDeclaringAndManagingSettings.
	helpMenu lastItem font: aWindow theme menuFont.
	^ helpMenu
! !

!SettingBrowser methodsFor: 'accessing' stamp: 'AlainPlantec 1/29/2010 21:11'!
viewedPackages
	^ viewedPackages
		ifNil: [viewedPackages := Set new]! !

!SettingBrowser methodsFor: 'updating' stamp: 'AlainPlantec 1/29/2010 21:08'!
changePackageSet: aSet 
	aSet ~= self viewedPackages
		ifTrue: [self viewedPackages: aSet.
			self applyFilters].
	^ true! !

!SettingBrowser methodsFor: 'updating' stamp: 'alain.plantec 4/2/2009 14:12'!
updateStatusWith: aMessage
	self addToStatus: aMessage.
	self addToStatus: Character cr.
! !

!SettingBrowser methodsFor: 'updating' stamp: 'AlainPlantec 10/17/2013 12:18'!
closePathFrom: aSetting
	(self settingNodeOfDeclaration: aSetting)
		ifNotNil: [ :node | self requestView: (MorphTreeChangeRequest collapseNodePath: (node path collect: [ :n | n withoutListWrapper ])) ]! !

!SettingBrowser methodsFor: 'accessing' stamp: 'AlainPlantec 1/29/2010 13:51'!
getDescription
	^ (self selectedNode)
		ifNil: [self status contents ifEmpty: ['Hit return in text fields to accept the input' translated]]
		ifNotNil: [:sel | (Text string: sel item label attribute: TextEmphasis bold), String cr, sel item description]! !

!SettingBrowser methodsFor: 'user interface' stamp: 'alain.plantec 3/23/2009 18:38'!
statusViewIn: aMorph
	| statusView |
	statusView := aMorph
				newTextEditorFor: self
				getText: #getDescription
				setText: #setDescription:.
	^ statusView
 ! !

!SettingBrowser methodsFor: 'menu' stamp: 'AlainPlantec 12/1/2009 15:51'!
doubleClick
	self selectedNode ifNotNil: [:node | node browseDeclaration]! !

!SettingBrowser methodsFor: 'updating' stamp: 'AlainPlantec 1/1/2012 22:43'!
changeSearchedText: aString 
	self searchedText: aString.
	self applyFilters.
	^ true ! !

!SettingBrowser methodsFor: 'initialize-release' stamp: 'AlainPlantec 1/29/2010 21:10'!
release
	treeHolder release.
	treeHolder := nil.
	roots := nil.
	status := nil.
	searchedText := nil.
	viewedPackages := nil.
	super release.! !

!SettingBrowser methodsFor: 'accessing' stamp: 'AlainPlantec 9/17/2011 21:25'!
viewedLabelOfSetting: aSettingDeclaration 
	| node |
	node := self settingNodeOfDeclaration: aSettingDeclaration.
	^ node 
		ifNil: [aSettingDeclaration label]
		ifNotNil: [(node allChildren notEmpty and: [aSettingDeclaration hasValue])
				ifTrue: [aSettingDeclaration label, '...'] 
				ifFalse: [aSettingDeclaration label]]! !

!SettingBrowser methodsFor: 'accessing' stamp: 'AlainPlantec 1/29/2010 11:05'!
allPackagesWithSettings
	^( self treeHolder nodeList collect: [:n | n receiverPackage]) asSet! !

!SettingBrowser methodsFor: '*StartupPreferences' stamp: 'DamienCassou 11/3/2013 17:20'!
exportSettings
	| title nodes actions   |
	
	nodes := self treeHolder nodeList.
	title := 'Exporting settings'.
	title
		displayProgressFrom: 1 
		to: nodes size 
		during: [:bar | actions := nodes collectWithIndex: [:e :i | 
											bar current: i.
											bar label: (String streamContents: [:s | 
															s << title << ' (' << (e item label) << ')']).
											e item exportSettingAction ]].
		
	actions := actions reject: [:e | e isNil ].
	self exportAllSettings: actions by: 50 withBasename: 'exported_settings'.! !

!SettingBrowser methodsFor: 'accessing' stamp: 'AlainPlantec 1/30/2010 10:18'!
viewedPackages: aCollectionOfPackagesOrNil
	viewedPackages := aCollectionOfPackagesOrNil! !

!SettingBrowser methodsFor: 'user interface' stamp: 'BenjaminVanRyseghem 8/1/2012 15:12'!
toolBarIn: aMorph 
	| toolBar |
	toolBar := aMorph newToolbar: {
	aMorph
		newButtonFor: self
		getState: nil
		action: #expandAll
		arguments: nil
		getEnabled: nil
		label: 'Expand all' translated
		help: 'Expand all tree nodes' translated.
	aMorph newToolSpacer.
	aMorph newToolSpacer.
	aMorph newLabel: 'Search for: ' translated.
	(SearchMorph
				on: self
				list: #searchedTextList
				selected: #searchedText
				changeSelected: #changeSearchedText:
				useIndex: false 
				addToList: #addToSearchedTextList:
				class: String
				getEnabled: nil) hResizing: #spaceFill; 
				ghostText: 'Hit return to accept' translated.
	aMorph
			newCheckboxFor: self
			getSelected: #regexpSearch
			setSelected: #regexpSearch:
			getEnabled: nil
			label: 'Regexp' 
			help: 'Filter according to a regular expression' translated.
	aMorph newToolSpacer.	
	aMorph newToolSpacer.
	(aMorph
				newButtonFor: self
				getState: nil
				action: #choosePackagesIn:
				arguments: {aMorph}
				getEnabled: nil
				label: 'Choose packages' translated 
				help: 'Select packages' translated).
	(aMorph
				newButtonFor: self
				getState: nil
				action: #exportSettings
				arguments: nil
				getEnabled: nil
				label: 'Export Settings' translated 
				help: 'Export the current settings using StartupPreferences' translated).
	aMorph newToolSpacer}.
	^ toolBar! !

!SettingBrowser methodsFor: 'updating' stamp: 'alain.plantec 4/23/2009 15:01'!
textFilter
	^ self regexpSearch
		ifFalse: [SettingTokenFilter new token: self searchedText]
		ifTrue: [SettingRegexpFilter new regexp: self searchedText] ! !

!SettingBrowser methodsFor: 'user interface' stamp: 'AlainPlantec 1/30/2010 10:10'!
getViewedPackageNames
	^ Text
		streamContents: [:s | self viewedPackages
				ifEmpty: [s nextPutAll: 'All packages' translated]
				ifNotEmpty: [:selections | 
					(selections asSet = self allPackagesWithSettings asSet)
						ifTrue: [s nextPutAll: 'All packages']
						ifFalse: [selections
								do: [:package | 
									s nextPutAll: package packageName.
									s nextPut: Character space]]]]! !

!SettingBrowser methodsFor: 'user interface' stamp: 'AlainPlantec 9/14/2011 16:06'!
settingsKeywords 
	^ self class settingsKeywords! !

!SettingBrowser methodsFor: 'user interface' stamp: 'MarcusDenker 10/8/2014 15:12'!
helpDeclaringAndManagingSettings
	"Open up a workspace with explanatory info in it about the Setting Browser"
	UIManager default edit: 'To be documented here later' label: 'Declaring and managing settings' translated. 
	! !

!SettingBrowser methodsFor: 'accessing' stamp: 'alain.plantec 4/8/2009 08:58'!
searchedText
	^ searchedText ifNil: [searchedText := '']! !

!SettingBrowser methodsFor: 'user interface' stamp: 'AlainPlantec 1/29/2010 21:10'!
packageListViewIn: aWindow
	^ aWindow
				newTextEditorFor: self
				getText: #getViewedPackageNames
				setText: #setViewedPackageNames:.
! !

!SettingBrowser methodsFor: 'user interface' stamp: 'AlainPlantec 10/10/2011 11:31'!
open
	
	Cursor wait
		showWhile: [ | window |window := StandardWindow new model: self.
			window title: self windowTitle.
			self buildWindowIn: window.
			window themeChanged.
			window openInWorld.
			(window findDeeplyA: self treeMorphClass)  takeKeyboardFocus. 
			^ window]! !

!SettingBrowser methodsFor: 'menu' stamp: 'AlainPlantec 10/30/2011 17:03'!
keyStroke: anEvent from: aTreeMorph
	| c |
	c := anEvent keyCharacter.
	c = $a
		ifTrue: [^ self expandAll].
	c = $A
		ifTrue: [^ self collapseAll]. 
	self selectedNode
		ifNotNil: [:current | current keyStroke: anEvent from: aTreeMorph.
			current settingDeclaration hasDefault
				ifTrue: [c = $d
						ifTrue: [^ self menuSetToDefault: current]].
			current settingDeclaration hasEditableList
				ifTrue: [c = $e
						ifTrue: [^ self menuEmptyList: current]]]! !

!SettingBrowser methodsFor: 'accessing' stamp: 'alain.plantec 4/2/2009 14:12'!
setDescription: aText 
	self status reset.
	self addToStatus: aText.
	self changed: #getDescription! !

!SettingBrowser methodsFor: 'updating' stamp: 'AlainPlantec 11/18/2009 08:31'!
treeChanged: anAnnounce
	roots := nil.
	self selection: nil.
	self updateList! !

!SettingBrowser methodsFor: 'accessing' stamp: 'alain.plantec 4/23/2009 15:01'!
regexpSearch
	^ self class regexpSearch! !

!SettingBrowser methodsFor: 'accessing' stamp: 'alain.plantec 3/23/2009 18:38'!
searchedText: aString
	searchedText := aString.
! !

!SettingBrowser methodsFor: 'updating' stamp: 'AlainPlantec 10/17/2013 09:41'!
updateList
	self isRendered ifTrue: [
		self treeHolder updateList.
		self changed: #getDescription.
		self changed: #getViewedPackageNames.
		super updateList].	
! !

!SettingBrowser methodsFor: 'accessing' stamp: 'AlainPlantec 11/24/2009 11:42'!
treeHolder
	^ treeHolder
		ifNil: [treeHolder := self newTreeHolder whenChangedSend: #treeChanged: to: self; yourself]! !

!SettingBrowser methodsFor: 'accessing' stamp: 'AlainPlantec 11/24/2009 11:44'!
settingNodeOfDeclaration: aSettingDeclaration
	^ self treeHolder deeplyDetect: [:n | n settingDeclaration = aSettingDeclaration]! !

!SettingBrowser methodsFor: 'updating' stamp: 'AlainPlantec 11/27/2009 22:08'!
settingValueChanged: aSetting 
	aSetting realValue = true
		ifTrue: [self openPathFrom: aSetting].
	aSetting realValue = false
		ifTrue: [self closePathFrom: aSetting].
	aSetting changed: #realValue.
	aSetting changed: #fontButtonLabel.
	aSetting changed: #index.
	aSetting changed: #content ! !

!SettingBrowser methodsFor: 'user interface' stamp: 'EstebanLorenzano 5/15/2014 14:06'!
treeMorphIn: aMorph 
	| treeMorph |
	treeMorph := (self treeMorphClass on: self)
		getMenuSelector: #menu:shifted:;
		keystrokeActionSelector: #keyStroke:from:;
		columns: {
			MorphTreeColumn new startWidth: 300; rowMorphGetSelector: #labelMorphFor:; yourself.
			MorphTreeColumn new rowMorphGetSelector: #inputMorphFor:;yourself
		};
		doubleClickSelector: #doubleClick;
		rowInset: 6;
		columnInset: 6;
		rowColorForEven: Smalltalk ui theme lightBackgroundColor;
		yourself.
	^ treeMorph buildContents! !

!SettingBrowser methodsFor: '*StartupPreferences' stamp: 'DamienCassou 11/3/2013 17:33'!
exportSettings: aCollection toFileNamed: filename
	StartupPreferencesLoader default addAtStartupInPreferenceVersionFolder: aCollection named: filename! !

!SettingBrowser methodsFor: 'menu' stamp: 'AlainPlantec 1/29/2010 21:22'!
about
	self inform: 'Here you can browse, query and change all system settings' translated! !

!SettingBrowser methodsFor: 'accessing' stamp: 'alain.plantec 4/2/2009 14:11'!
status
	^ status ifNil: [status := String new writeStream]! !

!SettingBrowser methodsFor: 'updating' stamp: 'AlainPlantec 11/18/2009 08:28'!
selection: aSelectionHolder
	super selection: aSelectionHolder.
	self setDescription: ''.
	self changed: #getDescription
! !

!SettingBrowser methodsFor: 'updating' stamp: 'AlainPlantec 10/17/2013 10:02'!
openPathFrom: aSetting
	(self settingNodeOfDeclaration: aSetting) ifNotNil: [:node |
		self expandNodePath: node path]! !

!SettingBrowser methodsFor: 'accessing' stamp: 'alain.plantec 4/2/2009 14:12'!
addToStatus: aText 
	self status nextPutAll: aText.
! !

!SettingBrowser methodsFor: 'updating' stamp: 'AlainPlantec 1/30/2010 10:18'!
applyFilters
	roots := nil.
	self searchedText
		ifNotEmpty: [self updateAccordingTo: self textFilter].
	self viewedPackages
		ifNotEmpty: [ | filter |
			filter := SettingPackageFilter new
			packages: self viewedPackages.
			self updateAccordingTo: filter].
	self updateList
! !

!SettingBrowser methodsFor: 'user interface' stamp: 'alain.plantec 9/21/2009 09:40'!
initialExtent
	^ self class initialExtent! !

!SettingBrowser methodsFor: 'menu' stamp: 'StephaneDucasse 10/22/2014 22:07'!
menu: menu shifted: b 
	"Set up the menu to apply to the receiver's, 
	honoring the #shifted boolean"
	menu
		add: 'Expand all (a)' 
		target: self
		selector: #expandAll. 
	menu
		add: 'Collapse all (A)' 
		target: self 
		selector: #collapseAll.
	self selectedNode
		ifNotNil: [:current | 
			menu
				add: 'Expand all from here' 
				target: self
				selector: #expandAllFromNode:
				argument: current.
			menu addLine.
			current menu: menu shifted: b].
	self selectedNode
		ifNotNil: [:current |
			current settingDeclaration hasDefault
				ifTrue: [
					menu addLine.
					menu
						add: 'Set to default (d)' 
						target: self
						selector: #menuSetToDefault:
						argument: current].
			current settingDeclaration hasEditableList
				ifTrue: [
					current settingDeclaration hasDefault
						ifFalse: [  menu addLine ].
					menu
						add: 'Empty list (e)' 
						target: self
						selector: #menuEmptyList:
						argument: current]].
	^ menu! !

!SettingBrowser methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
taskbarIcon
	^ Smalltalk ui icons smallConfigurationIcon! !

!SettingBrowser methodsFor: 'user interface' stamp: 'TudorGirba 2/16/2014 21:44'!
setViewedPackageNames: aText 
	| allViewed |
	allViewed := Set new.
	aText asString substrings
		do: [:sub | (RPackageOrganizer default
						packageNamed: sub
						ifAbsent: [])
				ifNotNil: [:pkg | allViewed add: pkg]].
	self changePackageSet: allViewed.
	self changed: #getViewedPackageNames
! !

!SettingBrowser methodsFor: 'user interface' stamp: 'AlainPlantec 12/1/2009 09:10'!
isRendered
	| renderingMorphs |
	renderingMorphs := SystemWindow allSubInstances select: [:sw | sw model = self].
	^ renderingMorphs anySatisfy: [:m | m owner notNil]! !

!SettingBrowser methodsFor: 'user interface' stamp: 'MarcusDenker 9/30/2013 22:49'!
buildWindowIn: aWindow 
	| statusView toolBar treeMorph toolBarY gap packageListView statusViewHeight |
	treeMorph := self treeMorphIn: aWindow.
	statusView := self statusViewIn: aWindow.
	statusViewHeight := 100.
	toolBar := self toolBarIn: aWindow.
	gap := 3.
	packageListView := self packageListViewIn: aWindow.
	toolBarY := toolBar minExtent y + gap.
	aWindow 
		addMorph: toolBar
		fullFrame: ((0 @ 0 corner: 1 @ 0) asLayoutFrame 
						topOffset: gap;
						bottomOffset: toolBarY + gap).
	aWindow 
		addMorph: treeMorph
		fullFrame: ((0 @ 0 corner: 1 @ 0.99) asLayoutFrame 
				topOffset: toolBarY + gap + gap;
				bottomOffset: statusViewHeight negated).
	aWindow 
		addMorph: statusView
		fullFrame: ((0 @ 0.99 corner: 0.75 @ 1) asLayoutFrame 
				topOffset: statusViewHeight negated).
	aWindow 
		addMorph: packageListView
		fullFrame: ((0.75 @ 0.99 corner: 1 @ 1) asLayoutFrame 
				topOffset: statusViewHeight negated).
	^ aWindow! !

!SettingBrowser methodsFor: '*StartupPreferences' stamp: 'MarcusDenker 12/16/2013 20:04'!
exportAllSettings: actions by: groupSize withBasename: aString
	"Export all settings in files. No more than groupSize settings will be exported to the same file. If there are more than groupSize settings, settings will be exported in multiple files (named aString%d.st, with %d a number increasing from 1 to (actions size / groupSize)."
	| index |
	index := 1.
	actions
		groupsOf: groupSize
		atATimeDo: [ :setting | 
			self exportSettings: setting toFileNamed: aString , index printString , '.st'.
			index := index + 1 ].
	self
		exportSettings: (actions last: (actions size rem: groupSize))
		toFileNamed: aString , index printString , '.st'! !

!SettingBrowser methodsFor: 'accessing' stamp: 'alain.plantec 3/27/2009 23:04'!
pragmaErrorOccured: aPragmaError
	self setDescription: aPragmaError message, String cr! !

!SettingBrowser methodsFor: 'user interface' stamp: 'AlainPlantec 1/29/2010 21:29'!
windowTitle
	^ 'Settings browser'! !

!SettingBrowser methodsFor: 'menu' stamp: 'AlainPlantec 11/24/2009 11:44'!
setAllToDefault
	(self confirm: 'Set all to default value ?' translated) ifTrue: [
		self treeHolder nodeList do: [:node | node item hasDefault ifTrue: [node item setToDefault]].
		self updateList]! !

!SettingBrowser methodsFor: 'accessing' stamp: 'alain.plantec 4/23/2009 15:03'!
addToSearchedTextList: aString
	(self searchedTextList includes: aString) 
		ifFalse: [self searchedTextList size > 5 ifTrue: [self searchedTextList removeFirst].
		self searchedTextList add: aString]! !

!SettingBrowser class methodsFor: 'accessing' stamp: 'AlainPantec 1/7/2011 08:15'!
regexpSearch
	"Is the regexp filtering used"
	^ regexpSearch ifNil: [regexpSearch := false]! !

!SettingBrowser class methodsFor: 'accessing' stamp: 'AlainPlantec 9/17/2011 18:32'!
initialExtent
	"Initial extent of the SettingBrowser window"
	^ 900@600
		! !

!SettingBrowser class methodsFor: 'world menu' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
menuCommandOn: aBuilder
	<worldMenu>
	(aBuilder item: #'Settings')
		parent: #System;
		order: 1;
		icon: Smalltalk ui icons smallConfigurationIcon;
		action: [ SettingBrowser open ]; 
		help: 'Opens a SystemSettingBrowser which allows you to alter many system settings'! !

!SettingBrowser class methodsFor: 'help system' stamp: 'AlainPlantec 1/5/2011 13:03'!
wikiStyleHelp
	<wikiStyleHelp: #'The setting browser'>
	^ self comment! !

!SettingBrowser class methodsFor: 'accessing' stamp: 'AlainPantec 1/7/2011 08:16'!
regexpSearch: aBoolean
	"Set to true if the regexp filtering is to be used"

	regexpSearch := aBoolean! !

!SettingBrowser class methodsFor: 'accessing' stamp: 'AlainPantec 1/7/2011 08:16'!
searchedTextList
	"Keep a list of previously entered filtering tokens"
	^ searchedTextList ifNil: [searchedTextList := OrderedCollection new]! !

!SettingBrowser class methodsFor: 'opening' stamp: 'AlainPantec 1/7/2011 08:19'!
browse: aCollectionOfKeywords
	"open a SettingBrowser view which is able to browse all settings 
	that are declared with a pragma keyword which is at least
	one of the string contained in aCollectionOfKeywords
	example:
	(SettingBrowser browse: #('systemsettings'))
	browse all settings which make use of the pragma keyword 'systemsettings'
	
	Note that the default setting pragma keyword is 'systemsettings'
	"
	(self forKeywords: aCollectionOfKeywords) open! !

!SettingBrowser class methodsFor: 'accessing' stamp: 'AlainPlantec 9/14/2011 16:05'!
settingsKeywords 
	^ ((PragmaCollector new filter: [:prg | prg keyword = #settingPragmaProcessor]) reset) collect: [:p | p method selector].
! !

!SettingBrowser class methodsFor: 'opening' stamp: 'AlainPantec 1/7/2011 08:19'!
forKeywords: aCollectionOfKeywords
	"create a new SettingBrowser initialized with a set of pragma keywords"
	^ self new acceptableKeywords: aCollectionOfKeywords! !

!SettingBrowser class methodsFor: 'private helpers' stamp: 'AlainPlantec 9/14/2011 16:10'!
currentNodeList
	^ (SettingTree new  acceptableKeywords: self settingsKeywords) nodeList! !

!SettingBrowser class methodsFor: 'opening' stamp: 'alain.plantec 4/13/2009 14:33'!
open
	"Open a SettingBrowser view"
	^ self new open! !

!SettingBrowser class methodsFor: 'private helpers' stamp: 'AlainPlantec 9/17/2011 21:29'!
viewAllSettings
	"self viewAllSettings"
	Workspace openContents: self allSettingsState label: 'Current Setting assignments' 
! !

!SettingBrowser class methodsFor: 'updating' stamp: 'AlainPlantec 11/30/2009 10:22'!
refreshAllSettingBrowsers
	self allSubInstances do: [:sb | sb updateList]! !

!SettingBrowser class methodsFor: 'private helpers' stamp: 'AlainPlantec 9/17/2011 21:29'!
allSettingsState
	"
	Workspace openContents: self allSettingsState label: 'Current Setting assignments' 
	"
	| declList |
	declList := (self currentNodeList select: [ :node | node item hasValue])
		collect: [ :node | node item ].
	^ String streamContents: [:s | declList do: [:d | d settingStoreOn: s] ]! !

!SettingDeclaration commentStamp: 'AlainPlantec 1/3/2011 10:52'!
A SettingDeclaration is an handler for a writtable setting value. 
Its main responsibility is allow real value changing and to hold descriptive data about the setting. When the real value is changed, all declared listeners are notified. The standard event mechanism is used for that purpose. See #value: method which is call in order to change a setting value. Whatever object can declare its interest in the real value changes by sending #whenChangedSend:to: to a setting. See notification protocol.

For convenience, my olds values are registered in a list. This list is used by the SystemSettingBrowser in order to easily retrieve previous values.

The type instance variable is a Symbol. It is used by the SystemSettingBrowser in order to build the input widget of a setting.
It can be the name of the class or the name of a superclass of the value. In that case, the input widget is built by #settingInputWidgetForNode: implemented by the class which name is the value of the type instance variable. As an example, the input widget for a Boolean is built by Boolean class>>settingInputWidgetForNode:.

Type value is not limited to be a class name. It can also be whatever symbol. In that case, the selector corresponding to the message to send to the setting in order to build the inputWidget is built by SettingDeclaration>>localInputWidgetSelector. If the type instance variable is not set, then it is dynamically set to the class name of the value. 

See SettingManager comment for more explanations.

Instance Variables
	default:		<Object>
	getSelector:		<Object>
	ghostHelp:		<Object>
	setSelector:		<Object>
	type:		<Object>

default
	- xxxxx

getSelector
	- xxxxx

ghostHelp
	- xxxxx

setSelector
	- xxxxx

type
	- xxxxx
!
!SettingDeclaration methodsFor: 'user interface' stamp: 'AlainPlantec 9/14/2011 16:37'!
preferenceValue
	^ self realValue! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'alain.plantec 4/8/2009 16:50'!
hasPrivateListener
	^ self hasActionForEvent: self privateChangeEvent! !

!SettingDeclaration methodsFor: '*StartupPreferences' stamp: 'BenjaminVanRyseghem 2/5/2013 15:59'!
exportSettingAction
	| targetSymbol currentValue |
	
	targetSymbol := self target isSymbol
						ifTrue: [ self target ]
						ifFalse: [ self target name asSymbol ].
						
	currentValue := self targetSelector
						ifNil: [ (Smalltalk at: targetSymbol) perform: self getSelector ]
						ifNotNil: [:s | ((Smalltalk at: targetSymbol) perform: s) perform: self getSelector].
	
	^ (self hasDefault not or: [ (self default = currentValue) not ])
		ifTrue: [ self startupAction ]
		ifFalse: [ "We do nothing" nil ]! !

!SettingDeclaration methodsFor: 'accessing' stamp: 'alain.plantec 9/18/2009 23:07'!
getSelector: aSymbol
	getSelector := aSymbol! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'alain.plantec 9/18/2009 09:23'!
setToDefault
	self realValue: self defaultValue.
! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'FernandoOlivero 4/12/2011 10:17'!
inputWidgetForBoolean
	^  self theme  
			newCheckboxIn: World
			for: self
			getSelected: #realValue
			setSelected: #realValue:
			getEnabled: #enabled
			label: '' 
			help: nil! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'AlainPlantec 4/15/2012 13:24'!
inputWidgetForString
	| widget |
	widget := EditableDropListMorph
		on: self
		list: #list
		selected: #index
		changeSelected: #index:
		useIndex: true
		addToList: #addToList:
		class: (Smalltalk globals at: self type)
		getEnabled: #enabled
		default: self defaultValue.
	widget ghostText: self ghostHelp.
	widget contentMorph wantsFrameAdornments: true.
	widget hResizing: #rigid.
	widget width: 450.
	^ widget! !

!SettingDeclaration methodsFor: '*StartupPreferences' stamp: 'BenjaminVanRyseghem 2/5/2013 16:06'!
displayExportAction

	Workspace
		openContents: self startupAction storeString 
		label: self label! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'AlainPlantec 1/29/2010 14:21'!
inputWidgetSelectorInClass: aClass 
	| selector |
	^ (aClass respondsTo: (selector := #settingInputWidgetForNode:))
		ifTrue: [selector] ! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'alain.plantec 9/18/2009 23:10'!
list
	^ self class valueListFor: self! !

!SettingDeclaration methodsFor: 'accessing' stamp: 'alain.plantec 3/11/2009 18:22'!
type: anObject
	"Set the value of type"

	type := anObject! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'AlainPlantec 1/29/2010 14:20'!
inputWidgetForNumber
	^ self inputWidgetForString width: 200.
! !

!SettingDeclaration methodsFor: 'accessing' stamp: 'alain.plantec 3/4/2009 11:48'!
defaultValue
	^ default value! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'AlainPlantec 9/14/2011 16:47'!
settingStoreOn: aStream
	aStream tab;
		nextPutAll: (self target isSymbol
				ifTrue: [self target]
				ifFalse: [self target name]);
		nextPutAll: (self targetSelector
				ifNil: ['']
				ifNotNil: [' ' , self targetSelector]);
		 nextPutAll: ' ' , self setSelector , ' '.
	self preferenceValue settingStoreOn: aStream.
	aStream nextPut: $.;
		 cr! !

!SettingDeclaration methodsFor: 'testing' stamp: 'alain.plantec 4/8/2009 16:59'!
hasDefault
	^ true! !

!SettingDeclaration methodsFor: 'accessing' stamp: 'AlainPlantec 11/23/2009 22:36'!
setSelector
	^ setSelector ifNil: [self getSelector ifNotNil: [:gs | (gs, ':') asSymbol]]! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'FernandoOlivero 4/12/2011 10:16'!
inputWidgetForColor
	^ (  
	 self theme 
		newColorChooserIn: World
		for: self
		getColor: #realValue
		setColor: #realValue:
		getEnabled: #enabled 
		help: 'Choose a color') minWidth: 150; width: 150; yourself! !

!SettingDeclaration methodsFor: 'accessing' stamp: 'AlainPlantec 11/23/2009 22:35'!
getSelector
	^ getSelector ifNil: [self name]! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
inputWidgetForFileOrDirectoryWithAction: aSymbol

	| list button |
	list := EditableDropListMorph
				on: self
				list: #list
				selected: #index
				changeSelected: #index:
				useIndex: true 
				addToList: #addToList:
				class: String
				getEnabled: #enabled
				default: self defaultValue.
	list
		ghostText: self ghostHelp;
		hResizing: #rigid;
		width: 450;
		wantsFrameAdornments: true.
		
	button :=  self theme  
						newButtonIn: World
						for: self
						getState: nil
						action: aSymbol
						arguments: nil
						getEnabled: nil
						label:  (AlphaImageMorph new image: Smalltalk ui icons smallOpenIcon)
						help: 'Open directory chooser dialog' translated.
		
	^  self theme newRowIn: World for: { list. button }.! !

!SettingDeclaration methodsFor: 'accessing' stamp: 'alain.plantec 9/18/2009 09:13'!
default: anObject 
	"initialize the default value"
	default := anObject.
! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'alain.plantec 4/9/2009 09:41'!
addToList: anItem
	(self list includes: anItem)
		ifFalse: [self list size > self maxKept
				ifTrue: [self list removeFirst].
			self list add: anItem.
			self changed: #list]! !

!SettingDeclaration methodsFor: 'accessing' stamp: 'AlainPlantec 11/23/2009 13:49'!
selector: aSymbol
	self getSelector: aSymbol.
	self setSelector: (aSymbol, ':') asSymbol.! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'FernandoOlivero 4/12/2011 10:16'!
inputWidgetForPassword
	| widget |
	widget :=  self theme  
				newTextEntryIn: World
				for: self
				get: #realValue
				set: #realValue:
				class: String
				getEnabled: #enabled
				help: nil.
	widget
		wantsFrameAdornments: true;
		hResizing: #rigid;
		width: 450; 
		font: (StrikeFont passwordFontSize:  self theme  textFont pointSize).
	^ widget! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'alain.plantec 9/17/2009 21:20'!
listenersForEvent: anEvent
	| listeners actionSequence |	
	listeners := Set new.	
	actionSequence := self actionMap at: anEvent ifAbsent: [].	
	actionSequence ifNotNil: [
		actionSequence isCollection	 
			ifTrue: [actionSequence do: [:oneAction | 
					oneAction receiver ifNotNil: [:r | listeners add: r]]]
			ifFalse: [listeners add: actionSequence receiver]].
	^ listeners! !

!SettingDeclaration methodsFor: '*StartupPreferences' stamp: 'MikeMueller 3/5/2013 12:58'!
startupAction
	"I assume here that the receiver is always a class"

	 | targetSymbol currentValue |
			
	targetSymbol := self target isSymbol
						ifTrue: [ self target ]
						ifFalse: [ self target name asSymbol ].
						
	currentValue := self targetSelector
						ifNil: [ (Smalltalk at: targetSymbol) perform: self getSelector ]
						ifNotNil: [:s | ((Smalltalk at: targetSymbol) perform: s) perform: self getSelector].
	^ StartupAction 
		name: self label 
		code: (String streamContents: [:s |
					self targetSelector ifNotNil: [ s << '(' ].
					s << '(Smalltalk at: '.
					targetSymbol asSymbol printOn: s.
					self targetSelector ifNotNil: [:ts | s << ') perform: '. ts printOn: s ].
					s << ') perform: '.
					self setSelector asSymbol printOn: s.
					s << ' with: ('.
					currentValue settingStoreOn: s.
					s <<')' ])
		runOnce: true! !

!SettingDeclaration methodsFor: 'accessing' stamp: 'alain.plantec 3/11/2009 19:40'!
default
	^ default ! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'alain.plantec 9/18/2009 09:44'!
index: anInteger 
	self realValue: (self list at: anInteger)! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'AlainPlantec 11/25/2009 21:35'!
maxNameWidthForFont: aFont 
	| max |
	max := 0.
	self domainValuesLabels
		do: [:v | max := max max: (aFont widthOfStringOrText: v)].
	^ max ! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'AlainPlantec 1/29/2010 14:18'!
localInputWidgetSelector
	| imSel |
	^ (self respondsTo: (imSel := ('inputWidgetFor' , self type) asSymbol)) ifTrue: [imSel]! !

!SettingDeclaration methodsFor: 'accessing' stamp: 'alain.plantec 9/18/2009 23:07'!
setSelector: aSymbol
	setSelector := aSymbol! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'alain.plantec 4/6/2009 21:54'!
maxKept
	"maximum number of old values which are kept in
	list instance variable"
	^ 5! !

!SettingDeclaration methodsFor: 'accessing' stamp: 'AlainPlantec 1/29/2010 10:49'!
realValue
	"Answer the value of realValue"

	^ (self settingReceiver perform: self getSelector) 
		ifNil: [self setToDefault. 
			self settingReceiver perform: self getSelector]! !

!SettingDeclaration methodsFor: 'accessing' stamp: 'alain.plantec 4/8/2009 15:59'!
privateChangeEvent
	^ #privateSettingValueChanged! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'AlainPlantec 3/7/2010 14:34'!
hasEditableList
	^ (self realValue isKindOf: Boolean) not! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'AlainPlantec 1/29/2010 14:20'!
inputWidgetForPoint
	^ self inputWidgetForString width: 200.
! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'alain.plantec 9/19/2009 09:18'!
emptyList
	self list removeAll.
	self value ifNotNil: [self addToList: self realValue].! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'alain.plantec 4/8/2009 16:50'!
privateForget: aReceiver selector: aSelector 
	"Private"
	self
		removeActionsSatisfying: [:action | action receiver == aReceiver
				and: [action selector = aSelector]]
		forEvent: self privateChangeEvent! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'SeanDeNigris 11/11/2013 18:38'!
inputWidgetForDirectory

	^ self inputWidgetForFileOrDirectoryWithAction: #chooseFileDirectory.! !

!SettingDeclaration methodsFor: 'accessing' stamp: 'alain.plantec 9/18/2009 23:52'!
ghostHelp
	^ ghostHelp ! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
defaultIcon
	^ (self type = #LogicalFont or: [self realValue isKindOf: AbstractFont])
		ifTrue: [ Smalltalk ui icons smallFontsIcon]
		ifFalse: [ Smalltalk ui icons smallPaintIcon]! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'AlainPlantec 9/17/2011 15:39'!
inputWidgetForLabel
	| widget |
	widget := self theme newLabelIn: World for: self label: '' getEnabled: nil.
	widget getTextSelector: #preferenceValue.
	widget width: 450.
	^ widget! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'FernandoOlivero 4/12/2011 10:17'!
inputWidget
	"return the default widget for the input a the setting"
	| inputWidget xtraDialogWidget | 
	xtraDialogWidget := super inputWidget.
	inputWidget :=  self localInputWidgetSelector ifNotNil: [:localSel | self perform: localSel].
	(inputWidget isNil and: [self typeClass notNil])
		ifTrue: [inputWidget := (self inputWidgetSelectorInClass: self typeClass)
			ifNotNil: [:selector | self typeClass perform: selector with: self]].
	inputWidget
		ifNotNil: [(inputWidget respondsTo: #model:) 
			ifTrue: [inputWidget model: self]]. 
	xtraDialogWidget 
		ifNotNil: [inputWidget := inputWidget ifNil: [xtraDialogWidget] 
			ifNotNil: [ self theme  newRowIn: World for: {inputWidget. xtraDialogWidget}]].
	^ inputWidget ! !

!SettingDeclaration methodsFor: '*StartupPreferences' stamp: 'BenjaminVanRyseghem 2/5/2013 15:17'!
isExportable

	^ true! !

!SettingDeclaration methodsFor: 'accessing' stamp: 'alain.plantec 9/18/2009 09:24'!
type
	"Answer the value of type"

	^ type ifNil: [type := self realValue class name]! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'alain.plantec 4/8/2009 16:35'!
privateListeners
	^ self listenersForEvent: self privateChangeEvent! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'alain.plantec 4/8/2009 16:10'!
privateForget: aReceiver 
	"do not notify aReceiver anymore"
	self removeActionsWithReceiver: aReceiver forEvent: self privateChangeEvent! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'alain.plantec 9/18/2009 23:20'!
index
	^ self list
		indexOf: self realValue
		ifAbsent: [self realValue
				ifNil: [0]
				ifNotNil: [self addToList: self realValue.
					self list size]]! !

!SettingDeclaration methodsFor: 'comparing' stamp: 'AlainPlantec 12/13/2009 08:55'!
hash
	"hash is re-implemented because #= is re-implemented"
	^ self target hash
		bitXor: (self targetSelector hash
				bitXor: (self getSelector hash bitXor: self setSelector hash)) ! !

!SettingDeclaration methodsFor: 'accessing' stamp: 'AlainPlantec 1/29/2010 10:49'!
realValue: anObject
	"Set the value of realValue"
	self settingReceiver perform: self setSelector with: anObject.
	self triggerEvent: self privateChangeEvent with: self.! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'FernandoOlivero 4/12/2011 10:17'!
inputWidgetForFont
	^ (  self theme 
		newButtonIn: World
		for: self
		getState: nil 
		action: #getFont
		arguments: {}
		getEnabled: #enabled
		getLabel: #fontButtonLabel
		help: 'Choose a font ...' translated) cornerStyle: #square
! !

!SettingDeclaration methodsFor: 'accessing' stamp: 'lr 3/14/2010 21:13'!
typeClass
	^ Smalltalk globals at: self type ifAbsent: [  ]! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'alain.plantec 4/8/2009 15:59'!
whenPrivateChangedSend: zeroOrOneArgSelector to: aSubscriber 
	"private, use #whenChangedSend:to: instead"
	self
		when: self privateChangeEvent
		send: zeroOrOneArgSelector
		to: aSubscriber! !

!SettingDeclaration methodsFor: 'comparing' stamp: 'AlainPlantec 12/2/2009 16:44'!
= other
	self class = other class
		ifFalse: [^ false].
	self target == other target ifFalse: [^ false].
	self targetSelector = other targetSelector ifFalse: [^ false].
	self getSelector = other getSelector ifFalse: [^ false].
	self setSelector = other setSelector ifFalse: [^ false].
	^ true
	
! !

!SettingDeclaration methodsFor: 'accessing' stamp: 'alain.plantec 9/18/2009 23:52'!
ghostHelp: aString
	ghostHelp := aString! !

!SettingDeclaration methodsFor: 'user interface' stamp: 'alain.plantec 5/20/2009 12:24'!
inputMorphFor: aContainer
	^ (super inputMorphFor: aContainer)
		ifNotNil: [:im |			
				self whenPrivateChangedSend: #settingValueChanged: to: aContainer model.
				self whenPrivateChangedSend: #innerWidgetChanged to: aContainer.
				im]! !

!SettingDeclaration methodsFor: 'accessing' stamp: 'AlainPlantec 11/25/2009 08:22'!
hasValue
	^ true! !

!SettingDeclaration class methodsFor: 'cache accessing' stamp: 'AlainPlantec 1/29/2010 10:50'!
valueListFor: aSettingValue
	| targetEntry |
	targetEntry := self valueListCache at: aSettingValue settingReceiver ifAbsentPut: [IdentityDictionary new].
	^ targetEntry at: aSettingValue getSelector ifAbsentPut: [OrderedCollection new].! !

!SettingDeclaration class methodsFor: 'icon accessing' stamp: 'alain.plantec 4/9/2009 00:15'!
nullifyForm
	^ (Form
	extent: 16@16
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 463732736 4285815129 4285815129 4285815129 4285815129 4285815129 2292449280 463732736 0 0 0 0 0 0 0 1688469504 4285815129 4278190080 4278190080 4278190080 4278190080 4278190080 4280091395 4285815129 1688469504 0 0 0 0 0 1688469504 4285815129 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4285815129 1688469504 0 0 0 463732736 4285815129 4278190080 4294967295 4294967295 4278190080 4278190080 4278190080 4278190080 4294967295 4294967295 4278190080 4285815129 463732736 0 0 4285815129 4278190080 4278190080 4294967295 4294967295 4294967295 4278190080 4278190080 4294967295 4294967295 4294967295 4278190080 4285815129 4285815129 0 0 4285815129 4278190080 4278190080 4278190080 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4278190080 4278190080 4278190080 4285815129 0 0 4285815129 4278190080 4278190080 4278190080 4278190080 4294967295 4294967295 4294967295 4294967295 4278190080 4278190080 4278190080 4278190080 4285815129 0 0 4285815129 4278190080 4278190080 4278190080 4278190080 4294967295 4294967295 4294967295 4294967295 4278190080 4278190080 4278190080 4278190080 4285815129 0 0 4285815129 4278190080 4278190080 4278190080 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4278190080 4278190080 4278190080 4285815129 0 0 2292449280 4281927174 4280025345 4294967295 4294967295 4294967295 4278190080 4278190080 4294967295 4294967295 4294967295 4278190080 4283696903 4285815129 0 0 463732736 4285815129 4278190080 4294967295 4294967295 4278190080 4278190080 4278190080 4278190080 4294967295 4294967295 4278190080 4285815129 463732736 0 0 0 1688469504 4285815129 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4285815129 1688469504 0 0 0 0 0 1688469504 4285815129 4285815129 4278190080 4278190080 4278190080 4278190080 4283696646 4285815129 1688469504 0 0 0 0 0 0 0 463732736 2292449280 4285815129 4285815129 4285815129 4285815129 2292449280 463732736 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: 0@0)! !

!SettingDeclaration class methodsFor: 'icon accessing' stamp: 'alain.plantec 4/8/2009 17:40'!
smallCautionForm
	^ (Form
	extent: 16@16
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 463732736 2292449280 3517186048 4154720256 4154720256 3517186048 2292449280 463732736 0 0 0 0 0 0 0 1688469504 4137943040 4292614939 4293600292 4293534756 4293534499 4293402913 4292483352 4137943040 1688469504 0 0 0 0 0 1688469504 4290185224 4293600292 4292284175 4291428866 4291166208 4291100672 4291297794 4292087053 4293271070 4290184967 1688469504 0 0 0 463732736 4137943040 4293534756 4291823367 4291231744 4291166208 4294967295 4294967295 4290969600 4290969600 4291429637 4293073948 4137943040 463732736 0 0 2292449280 4292614682 4292284175 4291231744 4291035136 4291035136 4294967295 4294967295 4291035136 4291035136 4290838528 4291824395 4292351253 2292449280 0 0 3517186048 4293468963 4291363330 4291166208 4291035136 4291035136 4294967295 4294967295 4291035136 4291035136 4290707456 4290838785 4292942105 3517186048 0 0 4154720256 4293534242 4291166208 4291100672 4291035136 4291035136 4294967295 4294967295 4291035136 4290707456 4290641920 4290641920 4292942104 4154720256 0 0 4154720256 4293468449 4291035136 4291035136 4291035136 4291035136 4291100672 4291100672 4291035136 4290641920 4290576384 4290510848 4292876056 4154720256 0 0 3517186048 4293271328 4291166722 4290969600 4291035136 4291035136 4291035136 4291035136 4291035136 4291035136 4290510848 4290576641 4292744726 3517186048 0 0 2292449280 4292417303 4291955981 4290838528 4291035136 4291035136 4294967295 4294967295 4291035136 4291035136 4290445312 4291430665 4292088338 2292449280 0 0 463732736 4137943040 4293139484 4291298565 4290707456 4290641920 4294967295 4294967295 4290510848 4290379776 4290905092 4292678933 4137943040 463732736 0 0 0 1688469504 4290184967 4293007898 4291693323 4290707713 4290510848 4290445312 4290511105 4291365129 4292678932 4290053638 1688469504 0 0 0 0 0 1688469504 4137943040 4292219924 4292876311 4292876055 4292810518 4292744726 4292088081 4137943040 1688469504 0 0 0 0 0 0 0 463732736 2292449280 3517186048 4154720256 4154720256 3517186048 2292449280 463732736 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: 0@0)! !

!SettingDeclaration class methodsFor: 'cache accessing' stamp: 'alain.plantec 9/18/2009 09:57'!
valueListCache
	^ ValueListCache ifNil: [ValueListCache := WeakKeyDictionary new]! !

!SettingFilter commentStamp: 'alain.plantec 4/8/2009 12:51'!
A SettingFilter is a filter wich is used by a SettingBrowser in order to select which nodes of the setting trees are to be shown. A SettingFilter subclass must redefine the #keepHandler: method which return true if the argument handler is to be kept.

Instance Variables
!
!SettingFilter methodsFor: 'filtering' stamp: 'alain.plantec 9/18/2009 23:46'!
keepSettingTreeNode: aSettingNode 
	^ false! !

!SettingNode commentStamp: 'alain.plantec 4/20/2009 21:42'!
A SettingTreeNode is used by a SettingCollector as a node for setting trees. Built trees can be viewed by a SettingBrowser

Instance Variables
	contents:		<Collection of SettingTreeNode>
	parentNode:		<SettingTreeNode or nil>

contents
	- the children

parentNode
	- the parent or nil if the node is a root
!
!SettingNode methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/16/2011 16:14'!
selector
	^ self pragma 
		ifNil: ['']
		ifNotNil: [:p | p selector]! !

!SettingNode methodsFor: 'accessing' stamp: 'AlainPlantec 11/24/2009 09:26'!
parent: aSymbol
	self parentName: aSymbol! !

!SettingNode methodsFor: 'accessing' stamp: 'alain.plantec 9/18/2009 16:06'!
description
	^ self settingDeclaration description! !

!SettingNode methodsFor: 'updating' stamp: 'AlainPlantec 10/30/2011 17:19'!
updateAccordingTo: aFilter 
	(aFilter keepSettingTreeNode: self) 
		ifFalse: [
			self contents do: [ :n | n updateAccordingTo: aFilter].
			self contents removeAllSuchThat: [ :n | (aFilter keepSettingTreeNode: n) not  and: [n isEmpty]]]
		! !

!SettingNode methodsFor: 'menu' stamp: 'AlainPlantec 11/24/2009 15:24'!
inspectItem
	self settingDeclaration inspect! !

!SettingNode methodsFor: 'menu' stamp: 'alain.plantec 3/23/2009 10:11'!
menuBrowse
	self browseDeclaration! !

!SettingNode methodsFor: 'menu' stamp: 'AlainPlantec 11/24/2009 15:24'!
exploreItem
	self settingDeclaration explore! !

!SettingNode methodsFor: 'accessing' stamp: 'AlainPlantec 12/3/2009 14:44'!
methodClass
	^ self pragma ifNotNil: [self pragma methodClass theNonMetaClass]! !

!SettingNode methodsFor: 'accessing' stamp: 'alain.plantec 9/18/2009 23:40'!
settingValue
	^ self settingDeclaration realValue
! !

!SettingNode methodsFor: 'menu' stamp: 'alain.plantec 4/3/2009 07:57'!
deeplySelect: aBlock in: aCollection
	(aBlock value: self) ifTrue: [aCollection add: self].
	self contents do: [:sub | sub deeplySelect: aBlock in: aCollection].
	^ aCollection! !

!SettingNode methodsFor: 'accessing' stamp: 'AlainPlantec 11/23/2009 14:13'!
labelMorphFor: aContainer
	^ self settingDeclaration 
		ifNotNil: [:v | v labelMorphFor: aContainer]! !

!SettingNode methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 3/12/2015 16:57'!
spotterLabel
	| label |
	label := self settingDeclaration label.
	^ self parentNode isNil
		ifTrue: [ label ]
		ifFalse: [ self parentNode spotterLabel , '/', label ]
		! !

!SettingNode methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 3/20/2015 10:06'!
spotterPreviewIn: composite
	<spotterPreview: 0>
	
	composite custom: (
				(self settingDeclaration inputWidget asBrick)
						hSpaceFill;
						vShrinkWrap;
						vAlign: #center;
						yourself)! !

!SettingNode methodsFor: 'accessing' stamp: 'AlainPlantec 11/24/2009 07:11'!
settingDeclaration
	^ self item! !

!SettingNode methodsFor: 'menu' stamp: 'StephaneDucasse 10/22/2014 22:09'!
menu: menu shifted: b 
	menu
		add: 'Browse (b)'
		target: self
		selector: #browseDeclaration.		
	self item isExportable ifFalse: [ ^self ].
	menu 
		add: 'Display export action string' 
		target: self item
		selector: #displayExportAction! !

!SettingNode methodsFor: 'accessing' stamp: 'AlainPlantec 11/24/2009 07:38'!
pragma: aPragma
	pragma := aPragma! !

!SettingNode methodsFor: 'accessing' stamp: 'AlainPlantec 1/29/2010 10:50'!
settingReceiver
	^ item settingReceiver! !

!SettingNode methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 3/12/2015 09:23'!
gtInspectorLiveIn: composite
	<gtInspectorPresentationOrder: 0>
	composite morph
		title: 'Live';
		display: [ self settingDeclaration inputWidget ];
		when: [ self settingDeclaration notNil ]! !

!SettingNode methodsFor: 'testing' stamp: 'alain.plantec 3/17/2009 09:45'!
isEmpty
	^ self contents isEmpty! !

!SettingNode methodsFor: 'accessing' stamp: 'AlainPlantec 11/24/2009 09:27'!
parentName
	^ parentName
	! !

!SettingNode methodsFor: 'accessing' stamp: 'AlainPlantec 12/9/2009 07:52'!
order
	^ item order! !

!SettingNode methodsFor: 'accessing' stamp: 'AlainPlantec 11/24/2009 09:27'!
parentName: aSymbol
	parentName := aSymbol.
	! !

!SettingNode methodsFor: 'accessing' stamp: 'AlainPlantec 12/5/2009 07:33'!
allChildren
	^ self model childrenOf: self.
! !

!SettingNode methodsFor: 'accessing' stamp: 'AlainPlantec 12/5/2009 07:51'!
parentNode
	^ self model nodeNamed: self parentName! !

!SettingNode methodsFor: 'menu' stamp: 'StephaneDucasse 10/15/2011 20:58'!
browseDeclaration
	"open a browser on the method which defines myself"
	Smalltalk tools browser
		fullOnClass: self methodClass class selector: self selector! !

!SettingNode methodsFor: 'accessing' stamp: 'TudorGirba 2/16/2014 21:45'!
receiverPackage
	^ self settingReceiver
		ifNotNil: [self settingReceiver class package] ! !

!SettingNode methodsFor: 'accessing' stamp: 'AlainPlantec 12/9/2009 07:52'!
order: anInteger
	item order: anInteger! !

!SettingNode methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 3/13/2015 22:02'!
spotterForSettingsFor: aStep
	<spotterOrder: 0>
	self allChildren isEmpty ifTrue: [ ^ self ].
	aStep listProcessor
		title: 'Children';
		allCandidates: [ self allChildren ];
		itemName: [ :each | each spotterLabel ];
		filter: GTFilterSubstring! !

!SettingNode methodsFor: 'accessing' stamp: 'AlainPlantec 11/24/2009 14:51'!
pragma
	^ pragma! !

!SettingNode methodsFor: 'accessing' stamp: 'CamilloBruni 11/9/2013 14:40'!
helpText
	^ self item description ifEmpty: [ nil ]! !

!SettingNode methodsFor: 'menu' stamp: 'alain.plantec 4/3/2009 07:59'!
deeplyDetect: aBlock 
	(aBlock value: self) ifTrue: [^ self].
	self contents do: [:sub | (sub deeplyDetect: aBlock) ifNotNil: [:found | ^ found]].
	^ nil! !

!SettingNode methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/29/2013 13:45'!
inputMorphFor: aContainer
	^ self settingDeclaration
		ifNotNil: [:v | 
			(v inputMorphFor: aContainer) ifNil: [ '' ]]! !

!SettingNode methodsFor: 'menu' stamp: 'AlainPlantec 2/25/2011 17:07'!
keyStroke: anEvent from: aTreeMorph
	| c |
	c := anEvent keyCharacter.
	c = $b
		ifTrue: [self menuBrowse. ^ true].
	c = $i
		ifTrue: [self inspectItem. ^ true].
	c = $I
		ifTrue: [self exploreItem. ^ true].
	^ false
! !

!SettingNode methodsFor: 'checking' stamp: 'AlainPlantec 12/13/2009 21:59'!
checkForUnknownTarget
	self parentNode ifNotNil: [:p | item target ifNil: [item target: p item target].
		item targetSelector ifNil: [item targetSelector: p item targetSelector]].
	self allChildren do: [:c | c checkForUnknownTarget]! !

!SettingNode methodsFor: 'accessing' stamp: 'AlainPlantec 12/5/2009 08:52'!
contents
	(self settingDeclaration hasValue
			and: [self settingValue = false])
		ifTrue: [^ OrderedCollection new]
		ifFalse: [^ contents 
				ifNil: [contents := self allChildren.
					self settingDeclaration ordering
						ifTrue: [contents := contents asArray sort: self model sortBlock].
					contents := self model retainedNodesFromList: contents asOrderedCollection]]! !

!SettingNode methodsFor: 'comparing' stamp: 'alain.plantec 3/3/2009 22:46'!
<= other
	^ self asString <= other asString! !

!SettingNode methodsFor: 'accessing' stamp: 'alain.plantec 9/18/2009 16:38'!
icon
	^ self settingDeclaration ifNotNil: [:d | d icon ] ! !

!SettingNode class methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:07'!
gtExampleSettingNode
	<gtExample: 'Settings node'>
	^ SettingTree gtExampleSettingTree nodeList anyOne! !

!SettingNodeBuilder commentStamp: 'TorstenBergmann 1/31/2014 10:35'!
Used to build nodes from the settings framework!
!SettingNodeBuilder methodsFor: 'public declaration accessing' stamp: 'AlainPlantec 12/3/2009 16:21'!
notInStyle
	node item notInStyle! !

!SettingNodeBuilder methodsFor: 'public declaration accessing' stamp: 'AlainPlantec 11/24/2009 13:51'!
parent: aSymbol
	node parentName: aSymbol! !

!SettingNodeBuilder methodsFor: 'public declaration accessing' stamp: 'AlainPlantec 11/26/2009 21:39'!
targetSelector: aSelector
	node item targetSelector: aSelector
! !

!SettingNodeBuilder methodsFor: 'private tree building' stamp: 'AlainPlantec 11/24/2009 13:34'!
asParentWhile: aBlock
	builder parent: self while: aBlock
! !

!SettingNodeBuilder methodsFor: 'public declaration accessing' stamp: 'AlainPlantec 11/24/2009 13:51'!
domainValues: aCollection 
	node item domainValues: aCollection 
! !

!SettingNodeBuilder methodsFor: 'public declaration accessing' stamp: 'AlainPlantec 11/24/2009 13:51'!
getSelector: aSymbol
	node item getSelector: aSymbol
! !

!SettingNodeBuilder methodsFor: 'public declaration accessing' stamp: 'AlainPlantec 11/24/2009 13:51'!
description: aText
	node item description: aText! !

!SettingNodeBuilder methodsFor: 'accessing' stamp: 'AlainPlantec 11/24/2009 13:33'!
builder: aTreeBuilder
	builder := aTreeBuilder! !

!SettingNodeBuilder methodsFor: 'public declaration accessing' stamp: 'AlainPlantec 11/24/2009 13:51'!
label: aStringOrBlockOrMessageSend
	node item label: aStringOrBlockOrMessageSend.
! !

!SettingNodeBuilder methodsFor: 'public declaration accessing' stamp: 'AlainPlantec 11/24/2009 13:52'!
type: anObject
	node item type: anObject
! !

!SettingNodeBuilder methodsFor: 'public declaration accessing' stamp: 'AlainPlantec 11/24/2009 13:52'!
target: anObject
	node item target: anObject
! !

!SettingNodeBuilder methodsFor: 'public declaration accessing' stamp: 'AlainPlantec 11/24/2009 13:51'!
dialog: aSymbol
	node item dialog: aSymbol
! !

!SettingNodeBuilder methodsFor: 'public tree building' stamp: 'AlainPlantec 11/24/2009 12:40'!
with: aBlock
	self asParentWhile: aBlock! !

!SettingNodeBuilder methodsFor: 'accessing' stamp: 'AlainPlantec 11/24/2009 12:43'!
node
	^ node! !

!SettingNodeBuilder methodsFor: 'public declaration accessing' stamp: 'AlainPlantec 11/24/2009 13:52'!
parentName
	^ node parentName
	! !

!SettingNodeBuilder methodsFor: 'accessing' stamp: 'AlainPlantec 11/24/2009 12:43'!
node: aSettingTreeNode
	node := aSettingTreeNode! !

!SettingNodeBuilder methodsFor: 'public declaration accessing' stamp: 'AlainPlantec 11/24/2009 13:50'!
default: anObject
	node item  default: anObject
! !

!SettingNodeBuilder methodsFor: 'public declaration accessing' stamp: 'AlainPlantec 11/24/2009 13:52'!
parentName: aSymbol
	node parentName: aSymbol.
	! !

!SettingNodeBuilder methodsFor: 'public declaration accessing' stamp: 'AlainPlantec 11/24/2009 13:52'!
selector: aSymbol
	node item selector: aSymbol
! !

!SettingNodeBuilder methodsFor: '*Keymapping-Settings' stamp: 'GuillermoPolito 5/31/2011 13:54'!
shortcutName: aShortcutName
	node item shortcutName: aShortcutName! !

!SettingNodeBuilder methodsFor: 'public declaration accessing' stamp: 'AlainPlantec 11/24/2009 13:51'!
icon: aForm
	node item icon: aForm! !

!SettingNodeBuilder methodsFor: 'public declaration accessing' stamp: 'AlainPlantec 11/24/2009 13:51'!
ghostHelp: aString
	node item ghostHelp: aString
! !

!SettingNodeBuilder methodsFor: 'public declaration accessing' stamp: 'AlainPlantec 11/24/2009 13:51'!
name: aStringOrBlockOrMessageSend
	node item name: aStringOrBlockOrMessageSend.
! !

!SettingNodeBuilder methodsFor: 'public declaration accessing' stamp: 'AlainPlantec 11/27/2009 23:26'!
noOrdering
	node item noOrdering
! !

!SettingNodeBuilder methodsFor: 'public declaration accessing' stamp: 'AlainPlantec 11/24/2009 13:51'!
order: aNumber
	node item order: aNumber
! !

!SettingNodeBuilder methodsFor: 'public declaration accessing' stamp: 'AlainPlantec 11/24/2009 13:52'!
range: anInterval
	node item range: anInterval
! !

!SettingNodeBuilder methodsFor: 'public declaration accessing' stamp: 'AlainPlantec 12/5/2009 13:52'!
script: aSymbol
	node item script: aSymbol
! !

!SettingNodeBuilder methodsFor: 'public declaration accessing' stamp: 'AlainPlantec 11/24/2009 13:52'!
setSelector: aSymbol
	node item setSelector: aSymbol
! !

!SettingNodeBuilder methodsFor: '*Keymapping-Settings' stamp: 'GuillermoPolito 2/15/2011 23:29'!
do: aBlockClosure 
	node item action: aBlockClosure ! !

!SettingNodeBuilder methodsFor: 'public declaration accessing' stamp: 'AlainPlantec 11/24/2009 14:02'!
name
	^ node item name
! !

!SettingNodeBuilder methodsFor: 'public declaration accessing' stamp: 'AlainPlantec 12/5/2009 08:44'!
precondition: aValuable
	node item precondition: aValuable
! !

!SettingNodeBuilder methodsFor: '*Keymapping-Settings' stamp: 'GuillermoPolito 5/31/2011 12:29'!
category: aByteSymbol 
	node item categoryName: aByteSymbol! !

!SettingPackageFilter commentStamp: 'AlainPlantec 12/31/2010 11:38'!
A SettingPackageFilter is a SettingFilter used to select settings from a given list of packages: a setting is kept only if the package in which it is defined is present in the given package list

Instance Variables
	packages:		<Collection>

packages
	- The collection of PackageInfo the filter is currently using!
!SettingPackageFilter methodsFor: 'accessing' stamp: 'alain.plantec 3/16/2009 23:00'!
packages
	"Answer the value of packages"

	^ packages! !

!SettingPackageFilter methodsFor: 'accessing' stamp: 'alain.plantec 4/8/2009 12:55'!
packages: aCollectionOfPackageInfo
	"Set the value of packages"

	packages := aCollectionOfPackageInfo
! !

!SettingPackageFilter methodsFor: 'filtering' stamp: 'AlainPlantec 11/27/2009 10:28'!
keepSettingTreeNode: aSettingNode 
	| rp |
	^ (rp := aSettingNode receiverPackage) notNil and: [self packages includes: rp]! !

!SettingRegexpFilter commentStamp: 'alain.plantec 4/8/2009 13:02'!
A SettingRegexpFilter is SettingFilter which makes use of a regular expression in order to keep or not a SettingHandler.

Instance Variables
	regexp:		<String>

regexp
	- a regular expression string
!
!SettingRegexpFilter methodsFor: 'accessing' stamp: 'alain.plantec 4/7/2009 23:52'!
regexp
	"Answer the value of regexp"

	^ regexp! !

!SettingRegexpFilter methodsFor: 'accessing' stamp: 'alain.plantec 4/7/2009 23:52'!
regexp: anObject
	"Set the value of regexp"

	regexp := anObject! !

!SettingRegexpFilter methodsFor: 'filtering' stamp: 'AlainPlantec 1/1/2012 22:39'!
keepSettingDeclaration: aSettingDeclaration
	^ ({aSettingDeclaration name. aSettingDeclaration label. aSettingDeclaration description}
				collect: [:e | e ifNil: ['']])
				anySatisfy: [:token | token  matchesRegexIgnoringCase: self regexp]
! !

!SettingRegexpFilter methodsFor: 'filtering' stamp: 'alain.plantec 9/18/2009 23:46'!
keepSettingTreeNode: aSettingNode 
	^ (({aSettingNode methodClass name. aSettingNode selector}
			collect: [:e | e ifNil: ['']])
			anySatisfy: [:token | token substrings anySatisfy: [:sub | sub matchesRegexIgnoringCase: self regexp]])
		or: [self keepSettingDeclaration: aSettingNode settingDeclaration] ! !

!SettingTokenFilter commentStamp: 'alain.plantec 4/8/2009 13:03'!
A SettingTokenFilter is SettingFilter which makes use of a token (substring) in order to keep or not a SettingHandler.


Instance Variables
	token:		<String>

!
!SettingTokenFilter methodsFor: 'accessing' stamp: 'alain.plantec 3/16/2009 22:51'!
token: aString
	"Set the value of token"

	token := aString! !

!SettingTokenFilter methodsFor: 'accessing' stamp: 'alain.plantec 3/16/2009 22:51'!
token
	"Answer the value of token"

	^ token! !

!SettingTokenFilter methodsFor: 'filtering' stamp: 'AlainPlantec 10/30/2011 13:03'!
keepSettingDeclaration: aSettingDeclaration
	| selector |
	selector := (aSettingDeclaration respondsTo: #getSelector) 
		ifTrue: [aSettingDeclaration getSelector] ifFalse: [''].
	^ (({aSettingDeclaration name.  
		aSettingDeclaration label. 
		selector asUppercase. 
		aSettingDeclaration description}
				collect: [:e | (e ifNil: ['']) asUppercase])
				includesSubstringAnywhere: self token asUppercase)
! !

!SettingTokenFilter methodsFor: 'filtering' stamp: 'AlainPlantec 9/24/2011 22:18'!
keepSettingTreeNode: aSettingNode 
	^ (({aSettingNode methodClass name asUppercase. aSettingNode selector asUppercase}
			collect: [:e | e ifNil: ['']])
			includesSubstringAnywhere: self token asUppercase)
		or: [self keepSettingDeclaration: aSettingNode settingDeclaration]! !

!SettingTree commentStamp: 'AlainPlantec 1/2/2011 22:56'!
A SettingTree is responsible for the building of system setting trees from a collection of pragma.
Built tree nodes are instances of SettingNode. Built trees are suitable for tree browsing with the help of a MorphTreeMorph (see SettingBrowser>>treeMorphIn: and SettingBrowser>>roots to know how a SettingBrowser is initializing its MorphTreeMorph with the help of a SettingTree). 

Below, two examples of tree building with a SettingCollector are shown.
---------------
(SettingTree acceptableKeywords: #(#'systemsettings')) settingTreeRoots. "get system setting trees"
---------------

Instance Variables
	collector		<PragmaCollector>
	nodeList		<A list of SettingNode>
!
!SettingTree methodsFor: 'accessing' stamp: 'AlainPlantec 11/24/2009 11:51'!
updateList
	nodeList := nil.
! !

!SettingTree methodsFor: 'checking' stamp: 'AlainPlantec 12/7/2009 08:56'!
checkForUnknownTarget
	"check only root because other nodes with unknown target inherits it from its parent"
	self settingTreeRoots do: [:node | node item target ifNil: [node item target: (node pragma ifNotNil: [:prg | prg methodClass theNonMetaClass])]].
	self settingTreeRoots do: [:node | node checkForUnknownTarget].
! !

!SettingTree methodsFor: 'querying' stamp: 'AlainPlantec 12/5/2009 08:51'!
settingTreeRoots
	^ self retainedNodesFromList: ((self nodeList select: [:n | n parentName isNil]) asArray sort: self sortBlock) asOrderedCollection.
! !

!SettingTree methodsFor: 'checking' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
checkForUnknownParent
	self unclassified ifNotEmpty: [:nodesWithUnknownParent | | builder g |
		builder := SettingTreeBuilder new.
		g := (builder group: #nodesWithUnknownParent) node.
		self nodeList addFirst: g.
		g model: self.
		g item label: '*** Unclassified ***'.
		g item icon:  Smalltalk ui icons smallDebugIcon.
		g item order: 0.0.
		nodesWithUnknownParent do: [:node | node parentName: #nodesWithUnknownParent]]! !

!SettingTree methodsFor: 'querying' stamp: 'GabrielOmarCotelli 12/4/2013 09:41'!
childrenOf: aNode
	| children idx order |
	"Get aNode children. Assign children order if one child has an order which is not nil"
	children := self nodeList select: [ :p | p parentName = aNode settingDeclaration name ].
	children
		detect: [ :n | n order notNil ]
		ifFound: [ :firstWithOrder | 
			idx := children indexOf: firstWithOrder.
			order := firstWithOrder order.
			idx > 1
				ifTrue: [ 
					idx - 1 to: 1 do: [ :pos | 
						(children at: pos) order: order - 1.
						order := order - 1 ] ].
			order := firstWithOrder order.
			idx + 1 to: children size do: [ :pos | 
				(children at: pos) order ifNil: [ (children at: pos) order: order + 1 ] ifNotNil: [ order := (children at: pos) order ].
				order := order + 1 ] ].
	^ children! !

!SettingTree methodsFor: 'accessing' stamp: 'AlainPlantec 1/29/2010 13:52'!
itemSortBlock
	^ [:a :b | 
		((a order notNil and: [b order notNil]) and: [a order ~= b order])
			ifTrue: [a order < b order]
			ifFalse: [((a order isNil and: [b order isNil]) or: [a order = b order])
				ifTrue: [a label < b label]
				ifFalse: [a order ifNil: [false] ifNotNil: [true]]]]! !

!SettingTree methodsFor: 'querying' stamp: 'AlainPlantec 11/24/2009 12:01'!
unclassified
	^ self nodeList select: [:node | node parentName notNil and: [node parentNode isNil]].! !

!SettingTree methodsFor: 'theme' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
theme
	^ Smalltalk ui theme! !

!SettingTree methodsFor: 'querying' stamp: 'alain.plantec 4/13/2009 08:04'!
deeplySelect: aBlock in: aCollection 
	self settingTreeRoots
		do: [:aRoot | aRoot deeplySelect: aBlock in: aCollection]. 
	^ aCollection! !

!SettingTree methodsFor: 'accessing' stamp: 'asasa  4/28/2010 18:33'!
acceptableKeywords: keywords
	self collector filter: [:prg | prg methodClass isMeta and: [keywords includes: prg keyword]].
	nodeList := nil.
	self collector reset.
! !

!SettingTree methodsFor: 'querying' stamp: 'alain.plantec 4/3/2009 07:53'!
deeplySelect: aBlock
	^ self deeplySelect: aBlock in: OrderedCollection new
! !

!SettingTree methodsFor: 'private tree building' stamp: 'AlainPlantec 11/24/2009 09:34'!
nodeNamed: aSymbol ifAbsent: aBlock
	^ self nodeList detect: [:d | d settingDeclaration name = aSymbol] ifNone: aBlock! !

!SettingTree methodsFor: 'updating' stamp: 'alain.plantec 10/19/2009 11:37'!
whenChangedSend: aSelector to: aTarget
	self collector whenChangedSend: aSelector to: aTarget.
	self collector whenResetSend: aSelector to: aTarget.! !

!SettingTree methodsFor: 'querying' stamp: 'alain.plantec 10/19/2009 13:56'!
pragmasDo: aBlock
	^  self collector do: aBlock! !

!SettingTree methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 3/12/2015 16:56'!
spotterForSettingsFor: aStep
	<spotterOrder: 0>
	aStep listProcessor
		title: 'Settings';
		allCandidates: [ self nodeList ];
		itemName: [ :each | each spotterLabel ];
		filter: GTFilterSubstring! !

!SettingTree methodsFor: 'querying' stamp: 'alain.plantec 9/19/2009 09:32'!
deeplyDetect: aBlock 
	self settingTreeRoots
		do: [:sub | (sub deeplyDetect: aBlock)
				ifNotNil: [:found | ^ found]].
	^ nil ! !

!SettingTree methodsFor: 'private tree building' stamp: 'AlainPlantec 11/27/2009 22:05'!
emptyNodeNamed: aSymbol
	(self nodeNamed: aSymbol)
! !

!SettingTree methodsFor: 'accessing' stamp: 'AlainPlantec 12/5/2009 08:46'!
nodeList
	| builder |
	^ nodeList 
		ifNil: [
			builder := SettingTreeBuilder new.
			self pragmasDo: [:p | builder buildPragma: p].
			nodeList := builder nodeList.
			nodeList do: [:n | n model: self].
			self checkForUnknownParent.
			self checkForUnknownTarget.
			self nodeList]! !

!SettingTree methodsFor: 'querying' stamp: 'AlainPlantec 12/5/2009 08:51'!
retainedNodesFromList: aListOfNodes
	| retained |
	retained := OrderedCollection new.
	aListOfNodes do: [:n | [n item precondition value ifTrue: [retained add: n]] on: Error do: [retained add: n]].
	^ retained! !

!SettingTree methodsFor: 'private tree building' stamp: 'AlainPlantec 11/24/2009 09:35'!
nodeNamed: aSymbol
	^ self nodeNamed: aSymbol ifAbsent: []
! !

!SettingTree methodsFor: 'accessing' stamp: 'alain.plantec 10/19/2009 11:28'!
collector
	^ collector ifNil: [collector := PragmaCollector new]! !

!SettingTree methodsFor: 'accessing' stamp: 'AlainPlantec 1/29/2010 13:52'!
sortBlock
	^ [:a :b | self itemSortBlock value: a settingDeclaration value: b settingDeclaration]! !

!SettingTree methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 3/12/2015 09:23'!
gtInspectorTreeIn: composite
	<gtInspectorPresentationOrder: 0>
	composite tree 
		title: 'Tree';
		display: [ self settingTreeRoots ];
		children: [ :each | self childrenOf: each ];
		format: [ :each | each settingDeclaration label ] ! !

!SettingTree class methodsFor: 'instance creation' stamp: 'AlainPlantec 1/2/2011 22:55'!
acceptableKeywords: aCollectionOfStrings
	^ self new acceptableKeywords: aCollectionOfStrings 
! !

!SettingTree class methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:07'!
gtExampleSettingTree
	<gtExample: 'Settings tree'>
	^ SettingTree new acceptableKeywords: SettingBrowser settingsKeywords! !

!SettingTreeBuilder commentStamp: 'TorstenBergmann 1/31/2014 10:32'!
A builder for the settings tree!
!SettingTreeBuilder methodsFor: 'private tree building' stamp: 'AlainPlantec 1/30/2010 11:54'!
nodeClass: aClass name: aSymbol
	| node |
	node := self nodeClass with: aClass new.
	node item name: aSymbol.
	node pragma: currentPragma.
	node parentName: (currentParent ifNotNil: [currentParent name]).
	self nodeList add: node.
	^ (SettingNodeBuilder new) node: node; builder: self; yourself! !

!SettingTreeBuilder methodsFor: 'public tree building' stamp: 'AlainPlantec 1/29/2010 14:07'!
group: aSymbol
	^ self nodeClass: PragmaSetting name: aSymbol
! !

!SettingTreeBuilder methodsFor: 'accessing' stamp: 'asasa  4/28/2010 18:21'!
buildPragma: aPragma
	currentPragma := aPragma.
	self perform: aPragma keyword withArguments: aPragma arguments.
	^ nodeList! !

!SettingTreeBuilder methodsFor: 'public tree building' stamp: 'AlainPlantec 12/5/2009 13:50'!
launcher: aSymbol
	^ self nodeClass: SystemSettingLauncher name: aSymbol
! !

!SettingTreeBuilder methodsFor: '*Keymapping-Settings' stamp: 'GuillermoPolito 2/9/2011 23:45'!
shortcut: aShortcutNameSymbol
	^ self nodeClass: KMShortcutDeclaration name: aShortcutNameSymbol! !

!SettingTreeBuilder methodsFor: 'public tree building' stamp: 'AlainPlantec 12/2/2009 11:47'!
pickOne: aSymbol
	^ self nodeClass: PickOneSettingDeclaration name: aSymbol
! !

!SettingTreeBuilder methodsFor: 'private tree building' stamp: 'AlainPlantec 11/24/2009 13:35'!
parent: aNode while: aBlock
	| oldParent |
	oldParent := currentParent.
	currentParent := aNode.
	aBlock value.
	currentParent := oldParent! !

!SettingTreeBuilder methodsFor: 'public tree building' stamp: 'AlainPlantec 11/24/2009 12:15'!
setting: aSymbol
	^ self nodeClass: SettingDeclaration name: aSymbol
! !

!SettingTreeBuilder methodsFor: 'public tree building' stamp: 'AlainPlantec 11/24/2009 12:15'!
range: aSymbol
	^ self nodeClass: RangeSettingDeclaration name: aSymbol
! !

!SettingTreeBuilder methodsFor: 'accessing' stamp: 'AlainPlantec 11/24/2009 12:05'!
nodeList
	^ nodeList ifNil: [nodeList := OrderedCollection new]
! !

!SettingTreeBuilder methodsFor: 'pragmas' stamp: 'AlainPlantec 4/29/2010 17:44'!
systemsettings
	<settingPragmaProcessor>
	"Process a <systemsettings> pragma"
	currentPragma methodClass theNonMetaClass perform: currentPragma selector with: self.! !

!SettingTreeBuilder methodsFor: '*Keymapping-Settings' stamp: 'GuillermoPolito 3/13/2011 17:58'!
attachShortcutCategory: aByteSymbol to: aClass
	KMFactory keymapContainer attachCategoryName: aByteSymbol to: aClass.! !

!SettingTreeBuilder methodsFor: 'accessing' stamp: 'AlainPlantec 1/30/2010 11:53'!
nodeClass
	^ SettingNode! !

!SettingTreeBuilder class methodsFor: 'instance creation' stamp: 'AlainPlantec 11/24/2009 11:53'!
acceptableKeywords: aCollectionOfRegExps 
	^ self new acceptableKeywords: aCollectionOfRegExps 
! !

!ShadowDrawingCanvas commentStamp: 'LaurentLaffont 2/23/2011 20:17'!
see ColorMappingCanvas comment.!
!ShadowDrawingCanvas methodsFor: 'testing' stamp: 'IgorStasenko 7/18/2011 18:53'!
isShadowDrawing
	^true! !

!ShadowDrawingCanvas methodsFor: 'accessing' stamp: 'ar 8/8/2001 14:14'!
shadowColor: aColor
	shadowColor := aColor! !

!ShadowDrawingCanvas methodsFor: 'accessing' stamp: 'ar 8/8/2001 14:14'!
shadowColor
	^shadowColor! !

!ShadowDrawingCanvas methodsFor: 'private' stamp: 'ar 8/8/2001 14:13'!
image: aForm at: aPoint sourceRect: sourceRect rule: rule
	"Draw the given form. For the 'paint' combination rule use stenciling otherwise simply fill the source rectangle."
	rule = Form paint ifTrue:[
		^myCanvas
			stencil: aForm
			at: aPoint
			sourceRect: sourceRect
			color: shadowColor
	] ifFalse:[
		^myCanvas
			fillRectangle: (sourceRect translateBy: aPoint)
			color: shadowColor
	].! !

!ShadowDrawingCanvas methodsFor: 'initialization' stamp: 'ar 8/8/2001 14:14'!
on: aCanvas
	myCanvas := aCanvas.
	shadowColor := Color black.! !

!ShadowDrawingCanvas methodsFor: 'private' stamp: 'ar 8/8/2001 14:14'!
mapColor: aColor
	aColor isColor ifFalse:[^aColor]. "Should not happen but who knows..."
	^aColor isTransparent
		ifTrue:[aColor]
		ifFalse:[shadowColor]! !

!ShadowLabelMorph commentStamp: 'TorstenBergmann 2/5/2014 10:30'!
A label with shadow!
!ShadowLabelMorph methodsFor: 'drawing' stamp: 'StephaneDucasse 10/12/2010 12:58'!
drawOn: aCanvas
	"Draw based on enablement."
	
	|pc|
	pc := self owner
		ifNil: [self paneColor]
		ifNotNil: [self owner color isTransparent
					ifTrue: [self owner paneColor]
					ifFalse: [self owner color]].
	aCanvas
		drawString: self contents
		in: (self bounds translateBy: 1)
		font: self fontToUse
		color: pc lighter;
		drawString: self contents
		in: self bounds
		font: self fontToUse
		color: self color.! !

!Shape commentStamp: '<historical>'!
I am an abstract class that knows my bounds and if a point is contained in me.!
!Shape methodsFor: 'as yet unclassified' stamp: 'gvc 10/31/2006 10:48'!
containsPoint: aPoint
	"Answer whether the receiver contains the given point."

	^self basicContainsPoint: aPoint! !

!Shape methodsFor: 'as yet unclassified' stamp: 'gvc 10/31/2006 10:48'!
basicContainsPoint: aPoint
	"Answer whether the receiver contains the given point."

	^self bounds containsPoint: aPoint! !

!Shape methodsFor: 'as yet unclassified' stamp: 'gvc 10/31/2006 10:25'!
bounds
	"Answer a rectangle that encloses the receiver."

	self subclassResponsibility! !

!SharedPackageFilterPatternsHolder commentStamp: 'JurajKubelka 12/17/2014 20:56'!
A SharedPackageFilterPatternsHolder is used for package filter input. It shares historical values of the input among all the PackageTreeNautilus browsers. Variable lastValue keeps the last used value. It is used when a browser is opened from a system (e.g. World menu, anObject browse).

Instance Variables
	mutex:		Mutex
	value:		OrderedCollection
	lastValue:	String
!
!SharedPackageFilterPatternsHolder methodsFor: 'accessing' stamp: 'JurajKubelka 12/26/2013 17:30'!
indexOf: aString 
	
	^ mutex critical: [ value indexOf: aString ]! !

!SharedPackageFilterPatternsHolder methodsFor: 'initialization' stamp: 'JurajKubelka 12/26/2013 17:18'!
initialize

	super initialize.
	mutex := Mutex new.! !

!SharedPackageFilterPatternsHolder methodsFor: 'accessing' stamp: 'JurajKubelka 12/26/2013 17:19'!
value

	^ mutex critical: [ value ].! !

!SharedPackageFilterPatternsHolder methodsFor: 'accessing' stamp: 'JurajKubelka 12/26/2013 17:29'!
size

	^ mutex critical: [ value size ]! !

!SharedPackageFilterPatternsHolder methodsFor: 'accessing' stamp: 'JurajKubelka 12/17/2014 12:54'!
lastValue: aValue 
	mutex critical: [ lastValue := aValue ]! !

!SharedPackageFilterPatternsHolder methodsFor: 'accessing' stamp: 'JurajKubelka 12/26/2013 17:31'!
at: index

	^ mutex critical: [ value at: index ]! !

!SharedPackageFilterPatternsHolder methodsFor: 'accessing' stamp: 'JurajKubelka 12/26/2013 17:18'!
value: anObject

	mutex critical: [ value := anObject ].! !

!SharedPackageFilterPatternsHolder methodsFor: 'removing' stamp: 'JurajKubelka 12/26/2013 17:28'!
remove: aString ifAbsent: aBlockClosure 
	
	^ mutex critical: [ value remove: aString ifAbsent: aBlockClosure ]! !

!SharedPackageFilterPatternsHolder methodsFor: 'adding' stamp: 'JurajKubelka 12/17/2014 17:11'!
addFirst: aString 
	^ mutex critical: [ 
		value 
			detect: [ :eachPattern | aString beginsWith: eachPattern ]
			ifFound: [ :aPattern | value remove: aPattern ].
		value addFirst: aString.
	 ]! !

!SharedPackageFilterPatternsHolder methodsFor: 'accessing' stamp: 'JurajKubelka 12/17/2014 12:54'!
lastValue
	^ mutex critical: [ lastValue ]! !

!SharedPackageFilterPatternsHolder methodsFor: 'accessing' stamp: 'JurajKubelka 12/17/2014 11:27'!
firstOrNil
	^ mutex critical: [ 
		value 
			ifNotEmpty: [ value first ] 
			ifEmpty: [ nil ] ]! !

!SharedPackageFilterPatternsHolder methodsFor: 'enumerating' stamp: 'JurajKubelka 12/26/2013 17:27'!
collectWithIndex: aBlockClosure 
	
	^ mutex critical: [ value withIndexCollect: aBlockClosure ]! !

!SharedPackageFilterPatternsHolder class methodsFor: 'accessing' stamp: 'JurajKubelka 12/26/2013 17:51'!
instance

	^ instance ifNil: [ instance := self new value: OrderedCollection new; yourself ]! !

!SharedPool commentStamp: '<historical>'!
A shared pool represents a set of bindings which are accessible to all classes which import the pool in its 'pool dictionaries'. SharedPool is NOT a dictionary but rather a name space. Bindings are represented by 'class variables' - as long as we have no better way to represent them at least.!
!SharedPool class methodsFor: 'enumerating' stamp: 'tpr 12/14/2004 12:34'!
keysDo: aBlock
"A hopefully temporary fix for an issue arising from miss-spelled variable names in code being compiled. The correction code (see Class>possibleVariablesFor:continuedFrom: assumes that sharedPools are Dictionaries. The proper fix would involve making sure all pools are actually subclasses of SharedPool, which they are not currently."
	self bindingsDo:[:b|
		aBlock value: b key]! !

!SharedPool class methodsFor: 'name lookup' stamp: 'tween 9/13/2004 10:10'!
hasBindingThatBeginsWith: aString
	"Answer true if the receiver has a binding that begins with aString, false otherwise"

	"First look in classVar dictionary."
	(self classPool hasBindingThatBeginsWith: aString) ifTrue:[^true].
	"Next look in shared pools."
	self sharedPools do:[:pool | 
		(pool hasBindingThatBeginsWith: aString) ifTrue: [^true]].
	^false! !

!SharedPool class methodsFor: 'name lookup' stamp: 'ar 5/18/2003 20:33'!
bindingsDo: aBlock
	^self classPool bindingsDo: aBlock! !

!SharedPool class methodsFor: '*refactoring-core' stamp: 'dvf 9/17/2003 03:10'!
keys
	^self classPool keys! !

!SharedPool class methodsFor: 'name lookup' stamp: 'EstebanLorenzano 3/1/2013 15:57'!
bindingOf: varName
	"Answer the binding of some variable resolved in the scope of the receiver"
	| aSymbol binding |
	aSymbol := varName asSymbol.

	"First look in classVar dictionary."
	binding := self classPool bindingOf: aSymbol.
	binding ifNotNil:[^binding].

	"Next look in shared pools."
	self sharedPools do:[:pool | 
		binding := pool bindingOf: aSymbol.
		binding ifNotNil:[^binding].
	].

	"subclassing and environment are not preserved"
	^nil! !

!SharedPool class methodsFor: 'name lookup' stamp: 'tpr 5/29/2003 18:12'!
includesKey: aName
	"does this pool include aName"
	^(self bindingOf: aName) notNil! !

!SharedPool class methodsFor: 'name lookup' stamp: 'ar 5/18/2003 18:14'!
classBindingOf: varName
	"For initialization messages grant the regular scope"
	^super bindingOf: varName! !

!SharedQueue commentStamp: 'ls 6/25/2005 13:48'!
An implementation of a shared queue based on class Monitor.  Clients may may place items on the queue using nextPut: or remove them using methods like next or nextOrNil.  Items are removed in first-in first-out (FIFO) order.  It is safe for multiple threads to access the same shared queue, which is why this is a "shared" queue.

[monitor] is used to synchronize access from multiple threads.

[items] is an ordered collection holding the items that are in the queue.  New items are added  at the end, and old items are removed from the beginning.

All methods must hold the monitor while they run.
!
!SharedQueue methodsFor: 'accessing' stamp: 'nice 11/4/2009 21:10'!
flushAllSuchThat: aBlock
	"Remove from the queue all objects that satisfy aBlock."
	monitor critical: [
		items := items reject: aBlock].
! !

!SharedQueue methodsFor: 'accessing' stamp: 'ls 6/25/2005 14:00'!
peek
	"Answer the object that was sent through the receiver first and has not 
	yet been received by anyone but do not remove it from the receiver. If 
	no object has been sent, return nil"
	^monitor critical: [
		items isEmpty ifTrue: [ nil ] ifFalse: [ items first ] ]
! !

!SharedQueue methodsFor: 'size' stamp: 'ls 6/25/2005 14:04'!
size
	^monitor critical: [ items size ]! !

!SharedQueue methodsFor: 'size' stamp: 'ls 6/25/2005 14:03'!
isEmpty
	^monitor critical: [ items isEmpty ]! !

!SharedQueue methodsFor: 'accessing' stamp: 'StephaneDucasse 10/19/2010 14:00'!
nextPut: anObject
	monitor critical: [
		items addLast: anObject.
		monitor signal].
	^ anObject
! !

!SharedQueue methodsFor: 'accessing' stamp: 'StephaneDucasse 10/19/2010 13:59'!
next
	^monitor critical: [
		monitor waitWhile: [ items isEmpty ].
		items removeFirst ]
! !

!SharedQueue methodsFor: 'accessing' stamp: 'ls 6/25/2005 14:00'!
nextOrNil
	^monitor critical: [
		items isEmpty ifTrue: [ nil ] ifFalse: [ items removeFirst ] ]! !

!SharedQueue methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 10:22'!
initialize
	super initialize.
	monitor := Monitor new.
	items := OrderedCollection new.
! !

!SharedQueue methodsFor: 'accessing' stamp: 'nice 1/5/2010 15:59'!
findFirst: aBlock
	"Answer the next object that satisfies aBlock, skipping any intermediate objects.
	If no such object has been queued, answer <nil> and leave me intact."

	
	^monitor critical: [ | index |
		index := items findFirst: aBlock.
		index = 0 ifTrue: [
			nil ]
		ifFalse: [
			items removeAt: index ] ].
! !

!SharedQueue methodsFor: 'copying' stamp: 'nice 10/5/2009 19:07'!
postCopy
	super postCopy.
	monitor critical:
		[items := items copy.
		monitor := Monitor new]! !

!SharedQueue methodsFor: 'printing' stamp: 'ls 6/25/2005 13:56'!
printOn: aStream
	monitor critical: [
		aStream 
			nextPutAll: self class name;
			nextPutAll: ' with ';
			print: items size;
		 	nextPutAll: ' items' ].! !

!SharedQueue methodsFor: 'accessing' stamp: 'nice 11/4/2009 21:10'!
flush
	"Remove from the queue all objects"
	monitor critical: [
		items := items removeAll].
! !

!SharedQueue methodsFor: 'accessing' stamp: 'nice 11/4/2009 21:17'!
nextOrNilSuchThat: aBlock
	"Answer the next object that satisfies aBlock, skipping any intermediate objects.
	If no object has been sent, answer <nil> and leave me intact.
	NOTA BENE:  aBlock MUST NOT contain a non-local return (^)."

	^monitor critical: [
		| index |
		index := items findFirst: aBlock.
		index = 0
			ifTrue: [nil]
			ifFalse: [items removeAt: index]
	]! !

!SharedQueue methodsFor: 'accessing' stamp: 'StephaneDucasse 10/19/2010 14:01'!
removeAll
       monitor critical: [
		items removeAll ].! !

!SharedQueue class methodsFor: 'instance creation' stamp: 'ls 6/25/2005 13:53'!
new
	^self basicNew initialize! !

!SharedQueueTest commentStamp: 'TorstenBergmann 2/20/2014 15:30'!
SUnit tests for shared queues!
!SharedQueueTest methodsFor: 'testing' stamp: 'GabrielOmarCotelli 5/25/2010 21:22'!
testNextOrNilSuchThat
	| q item |
	q := SharedQueue new.
	q nextPut: 5.
	q nextPut: 6.
	item := q findFirst: [ :x | x even ].
	self should: [ item = 6 ].
	self should: [ q nextOrNil = 5 ].
	self should: [ q nextOrNil isNil ]! !

!SharedQueueTest methodsFor: 'testing' stamp: 'GabrielOmarCotelli 5/25/2010 21:22'!
testBasics
	| q |
	q := SharedQueue new.
	self should: [ q nextOrNil isNil ].
	q nextPut: 5.
	self should: [ q nextOrNil = 5 ].
	self should: [ q nextOrNil isNil ]! !

!SharedQueueTest methodsFor: 'testing' stamp: 'GabrielOmarCotelli 5/25/2010 21:22'!
testContention1
	"here is a test case that breaks the standard SharedQueue from Squeak 3.8"

	| q r1 r2 |
	q := SharedQueue new.
	q nextPut: 5.
	q nextPut: 10.
	self should: [ q nextOrNil = 5 ].
	[ r1 := q next ] fork.
	[ r2 := q next ] fork.
	Processor yield.	"let the above two threads block"
	q nextPut: 10.
	Processor yield.
	self should: [ r1 = 10 ].
	self should: [ r2 = 10 ].
	self should: [ q nextOrNil isNil ]! !

!ShiftJISTextConverter commentStamp: '<historical>'!
Text converter for Shift-JIS.  Mac and Windows in Japanese mode use this encoding.!
!ShiftJISTextConverter methodsFor: 'private' stamp: 'ar 4/9/2005 22:31'!
katakanaValue: code

	^ Character leadingChar: JapaneseEnvironment leadingChar code: (#(
	16rFFFD 16rFF61 16rFF62 16rFF63 16rFF64 16rFF65 16rFF66 16rFF67
	16rFF68 16rFF69 16rFF6A 16rFF6B 16rFF6C 16rFF6D 16rFF6E 16rFF6F
	16rFF70 16rFF71 16rFF72 16rFF73 16rFF74 16rFF75 16rFF76 16rFF77
	16rFF78 16rFF79 16rFF7A 16rFF7B 16rFF7C 16rFF7D 16rFF7E 16rFF7F
	16rFF80 16rFF81 16rFF82 16rFF83 16rFF84 16rFF85 16rFF86 16rFF87
	16rFF88 16rFF89 16rFF8A 16rFF8B 16rFF8C 16rFF8D 16rFF8E 16rFF8F
	16rFF90 16rFF91 16rFF92 16rFF93 16rFF94 16rFF95 16rFF96 16rFF97
	16rFF98 16rFF99 16rFF9A 16rFF9B 16rFF9C 16rFF9D 16rFF9E 16rFF9F
) at: (code - 16r9F)).
! !

!ShiftJISTextConverter methodsFor: 'conversion' stamp: 'StephaneDucasse 5/28/2011 13:41'!
nextPut: aCharacter toStream: aStream 
	| value leadingChar aChar |
	aStream isBinary ifTrue: [^aCharacter storeBinaryOn: aStream].
	value := aCharacter charCode.
	(16rFF61 <= value and: [value <= 16rFF9F]) ifTrue: [
		aStream basicNextPut: (self sjisKatakanaFor: value).
		^ aStream].
	aChar := JISX0208 charFromUnicode: value.
	aChar ifNil: [^ aStream].
	value := aChar charCode.
	leadingChar := aChar leadingChar.
	leadingChar = 0 ifTrue: [
		aStream basicNextPut: (Character value: value).
		^ aStream.
	].
	leadingChar == self leadingChar ifTrue: [
		| upper lower | 
		upper := value // 94 + 33.
		lower := value \\ 94 + 33.
		upper \\ 2 = 1 ifTrue: [
			upper := upper + 1 / 2 + 112.
			lower := lower + 31
		] ifFalse: [
			upper := upper / 2 + 112.
			lower := lower + 125
		].
		upper >= 160 ifTrue: [upper := upper + 64].
		lower >= 127 ifTrue: [lower := lower + 1].
		aStream basicNextPut: (Character value: upper).
		aStream basicNextPut: (Character value: lower).
		^ aStream
	].
! !

!ShiftJISTextConverter methodsFor: 'friend' stamp: 'yo 10/23/2002 15:28'!
leadingChar

	^ JISX0208 leadingChar
! !

!ShiftJISTextConverter methodsFor: 'private' stamp: 'yo 3/1/2004 22:05'!
sjisKatakanaFor: value

	^ Character value: (#(
		16rA0 16rA1 16rA2 16rA3 16rA4 16rA5 16rA6 16rA7
		16rA8 16rA9 16rAA 16rAB 16rAC 16rAD 16rAE 16rAF
		16rB0 16rB1 16rB2 16rB3 16rB4 16rB5 16rB6 16rB7
		16rB8 16rB9 16rBA 16rBB 16rBC 16rBD 16rBE 16rBF
		16rC0 16rC1 16rC2 16rC3 16rC4 16rC5 16rC6 16rC7
		16rC8 16rC9 16rCA 16rCB 16rCC 16rCD 16rCE 16rCF
		16rD0 16rD1 16rD2 16rD3 16rD4 16rD5 16rD6 16rD7
		16rD8 16rD9 16rDA 16rDB 16rDC 16rDD 16rDE 16rDF
	) at: value - 16rFF5F).

! !

!ShiftJISTextConverter methodsFor: 'private' stamp: 'ar 4/9/2005 22:31'!
toUnicode: aChar

	^ Character leadingChar: JapaneseEnvironment leadingChar code: aChar asUnicode.
! !

!ShiftJISTextConverter methodsFor: 'conversion' stamp: 'GabrielOmarCotelli 5/25/2010 21:22'!
nextFromStream: aStream
	| character1 character2 value1 value2 char1Value result |
	aStream isBinary
		ifTrue: [ ^ aStream basicNext ].
	character1 := aStream basicNext.
	character1 isNil
		ifTrue: [ ^ nil ].
	char1Value := character1 asciiValue.
	char1Value < 16r81
		ifTrue: [ ^ character1 ].
	(char1Value > 16rA0 and: [ char1Value < 16rE0 ])
		ifTrue: [ ^ self katakanaValue: char1Value ].
	character2 := aStream basicNext.
	character2 isNil
		ifTrue: [ ^ nil	"self errorMalformedInput" ].
	value1 := character1 asciiValue.
	character1 asciiValue >= 224
		ifTrue: [ value1 := value1 - 64 ].
	value1 := value1 - 129 bitShift: 1.
	value2 := character2 asciiValue.
	character2 asciiValue >= 128
		ifTrue: [ value2 := value2 - 1 ].
	character2 asciiValue >= 158
		ifTrue: [ 
			value1 := value1 + 1.
			value2 := value2 - 158 ]
		ifFalse: [ value2 := value2 - 64 ].
	result := Character leadingChar: self leadingChar code: value1 * 94 + value2.
	^ self toUnicode: result! !

!ShiftJISTextConverter class methodsFor: 'utilities' stamp: 'yo 12/25/2003 21:33'!
encodingNames 

	^ #('shift-jis' 'shift_jis' 'sjis') copy
! !

!ShiftedField commentStamp: '<historical>'!
I represent the change of a shifted field on an instance.
The old field and the new field correspond to the same Slot.

In terms of method migration, it is only necessary to update the index of direct accessors/bytecodes to instance variable.!
!ShiftedField methodsFor: 'accessing' stamp: 'ToonVerwaest 3/28/2011 20:27'!
shift
	^ shift! !

!ShiftedField methodsFor: 'accessing' stamp: 'ToonVerwaest 3/28/2011 20:27'!
shift: anObject
	shift := anObject! !

!ShiftedField methodsFor: 'migrating' stamp: 'MartinDias 6/24/2013 18:04'!
migrateAt: index to: newInstance from: oldInstance
	newInstance 
		instVarAt: index 
		put: (oldInstance instVarAt: index - shift)! !

!ShoreLineReportSettings commentStamp: 'TommasoDalSasso 6/11/2014 17:29'!
A ShoreLineReportSettings is the setting manager for the ShoreLine Reporter.
!
!ShoreLineReportSettings class methodsFor: 'settings' stamp: 'TommasoDalSasso 12/2/2014 16:54'!
reportServerSettingsOn: aBuilder

	(aBuilder group: #shoreLineServer)
		label: 'Server settings' translated;
		parent: #shoreLine;
		noOrdering.

	(aBuilder setting: #host)
		target: SlReporter;
		label: 'ShoreLine server address' translated;
		description: 'Address of the ShoreLine server' translated;
		parent: #shoreLineServer.

	(aBuilder setting: #port)
		target: SlReporter;
		label: 'ShoreLine server port' translated;
		description: 'Port of the ShoreLine Server' translated;
		parent: #shoreLineServer.! !

!ShoreLineReportSettings class methodsFor: 'settings' stamp: 'TommasoDalSasso 12/2/2014 16:08'!
reportSettingsOn: aBuilder
	<systemsettings>

	(aBuilder group: #shoreLine)
		label: 'ShoreLine Reporter' translated;
		noOrdering.

	self reportFlagSettingsOn: aBuilder.
	self reportServerSettingsOn: aBuilder.! !

!ShoreLineReportSettings class methodsFor: 'settings' stamp: 'TommasoDalSasso 12/2/2014 16:54'!
reportFlagSettingsOn: aBuilder

	(aBuilder setting: #enabled)
		target: SlReporter;
		label: 'Enable ShoreLine Reporter' translated;
		description: 'Enable the submission of automaticalle generated reports' translated;
		parent: #shoreLine.

	(aBuilder setting: #autoSubmit)
		target: SlReporter;
		label: 'Automatic submission' translated;
		description: 'If this is enabled, a report is automatically submitted every time an exception occurs' translated;
		parent: #shoreLine.
		
	(aBuilder setting: #showSummary)
		target: SlReporter;
		label: 'Show report summary' translated;
		description: 'Display a summary of the data before submission' translated;
		parent: #shoreLine.
		
	(aBuilder setting: #showNotification)
		target: SlReporter;
		label: 'Show notifications' translated;
		description: 'Show a notification popup after a report ha been submitted' translated;
		parent: #shoreLine.
! !

!ShortIntegerArray commentStamp: '<historical>'!
ShortIntegerArray is an array for efficiently representing integers in the 16bit range.!
!ShortIntegerArray methodsFor: 'objects from disk' stamp: 'hjo 1/17/2011 01:46'!
write: shortInteger bigEndianOn: aStream
	^ aStream nextNumber: 4 put: shortInteger! !

!ShortIntegerArray methodsFor: 'accessing' stamp: 'ar 11/3/1998 15:41'!
size
	^super size * 2! !

!ShortIntegerArray methodsFor: 'private' stamp: 'ar 1/15/1999 17:37'!
swapShortObjects
	"Private -- swap all the short quantities in the receiver"
	| tmp |
	1 to: self basicSize do:[:i|
		tmp := (self pvtAt: i * 2).
		self pvtAt: i * 2 put: (self pvtAt: i * 2 - 1).
		self pvtAt: i * 2 - 1 put: tmp.
	]! !

!ShortIntegerArray methodsFor: 'objects from disk' stamp: 'hjo 1/17/2011 00:52'!
restoreEndianness
	"This word object was just read in from a stream.  It was stored in Big Endian (Mac) format.  Swap each pair of bytes (16-bit word), if the current machine is Little Endian.
	Why is this the right thing to do?  We are using memory as a byteStream.  High and low bytes are reversed in each 16-bit word, but the stream of words ascends through memory.  Different from a Bitmap."

	Smalltalk isLittleEndian
		ifTrue: [ self swapBytePairsHacky ]! !

!ShortIntegerArray methodsFor: 'objects from disk' stamp: 'hjo 1/17/2011 01:26'!
writeOn: aStream
	aStream nextInt32Put: self basicSize.
	1 to: self basicSize do: [ :i | 
		self write: (self basicAt: i) on: aStream ]! !

!ShortIntegerArray methodsFor: 'objects from disk' stamp: 'hjo 1/17/2011 01:26'!
write: shortInteger on: aStream
	^ Smalltalk isLittleEndian
		ifFalse: [ self write: shortInteger bigEndianOn: aStream ]
		ifTrue: [ self write: shortInteger littleEndianOn: aStream ]! !

!ShortIntegerArray methodsFor: 'objects from disk' stamp: 'hjo 1/17/2011 01:13'!
swapBytePairsHacky

	"The implementation is a hack, but fast for large ranges"
			"XOR"
			"Exchange bytes 0 and 1"
			"Exchange bytes 2 and 3"
	| hack blt |
	hack := Form new hackBits: self.	"The implementation is a hack, but fast for large ranges"
	blt := (BitBlt toForm: hack) sourceForm: hack.
	blt combinationRule: Form reverse.	"XOR"
		
	blt
		sourceY: 0;
		destY: 0;
		height: hack height;
		width: 1.
	#((0 1) (1 0) (0 1) (2 3)(3 2)(2 3))
		do: [:array | [:a :b| blt sourceX: a; destX: b; copyBits ] valueWithArguments: array ].
! !

!ShortIntegerArray methodsFor: 'private' stamp: 'ar 1/15/1999 17:35'!
pvtAt: index put: value
	"Private -- for swapping only"
	<primitive: 144>
	index isInteger
		ifTrue: [
			(index >= 1 and: [index <= self size])
				ifTrue: [self errorImproperStore]
				ifFalse: [self errorSubscriptBounds: index]].
	index isNumber ifTrue: [^ self at: index truncated put: value].
	self errorNonIntegerIndex.
! !

!ShortIntegerArray methodsFor: 'accessing' stamp: 'ar 11/3/1998 15:41'!
at: index put: value
	"Store the given 16-bit integer at the given index in the receiver."

	<primitive: 144>
	index isInteger
		ifTrue: [
			(index >= 1 and: [index <= self size])
				ifTrue: [self errorImproperStore]
				ifFalse: [self errorSubscriptBounds: index]].
	index isNumber ifTrue: [^ self at: index truncated put: value].
	self errorNonIntegerIndex.
! !

!ShortIntegerArray methodsFor: 'accessing' stamp: 'ar 11/3/1998 15:41'!
at: index
	"Return the 16-bit integer value at the given index of the receiver."

	<primitive: 143>
	index isInteger ifTrue: [self errorSubscriptBounds: index].
	index isNumber ifTrue: [^ self at: index truncated].
	self errorNonIntegerIndex.
! !

!ShortIntegerArray methodsFor: 'accessing' stamp: 'ar 11/3/1998 15:41'!
defaultElement
	^0! !

!ShortIntegerArray methodsFor: 'private' stamp: 'ar 1/15/1999 17:35'!
pvtAt: index
	"Private -- for swapping only"
	<primitive: 143>
	index isInteger ifTrue: [self errorSubscriptBounds: index].
	index isNumber ifTrue: [^ self at: index truncated].
	self errorNonIntegerIndex.
! !

!ShortIntegerArray methodsFor: 'objects from disk' stamp: 'hjo 1/17/2011 01:28'!
write: shortInteger littleEndianOn: aStream

	#(2 1 4 3) do: [:digitIndex| aStream nextPut: (shortInteger digitAt: digitIndex) ]! !

!ShortIntegerArray class methodsFor: 'instance creation' stamp: 'ar 1/15/1999 17:28'!
new: n
	^super new: n + 1 // 2! !

!ShortIntegerArray class methodsFor: 'initialization' stamp: 'bf 1/7/2005 16:39'!
initialize
	"ShortIntegerArray initialize"
	Smalltalk addToStartUpList: self after: Delay.
	LastSaveOrder := self new: 2.
	LastSaveOrder at: 1 put: 42.
	LastSaveOrder at: 2 put: 13.! !

!ShortIntegerArray class methodsFor: 'initialization' stamp: 'ar 1/15/1999 17:33'!
startUp
	"Check if the word order has changed from the last save"
	((LastSaveOrder at: 1) = 42 and:[(LastSaveOrder at: 2) = 13]) 
		ifTrue:[^self]. "Okay"
	((LastSaveOrder at: 2) = 42 and:[(LastSaveOrder at: 1) = 13]) 
		ifTrue:[^self swapShortObjects]. "Reverse guys"
	^self error:'This must never happen'! !

!ShortIntegerArray class methodsFor: 'initialization' stamp: 'ar 1/15/1999 17:40'!
swapShortObjects
	self allSubInstancesDo:[:inst| inst swapShortObjects]! !

!ShortIntegerArrayTest commentStamp: 'tbn 3/25/2011 15:07'!
SUnit Test for ShortIntegerArray!
!ShortIntegerArrayTest methodsFor: 'testing' stamp: 'hjo 1/17/2011 10:16'!
testAtPut

	shortIntegerArray at: 3 put: 100.
	self assert: 100  equals: (shortIntegerArray at: 3)
	! !

!ShortIntegerArrayTest methodsFor: 'testing' stamp: 'hjo 1/26/2011 19:34'!
testWriteBigEndianOn

	|stream|
	stream := WriteStream on: Array new.
	shortIntegerArray write: (12 bitShift: 24)+(34 bitShift: 16)+(56 bitShift: 8)+78 bigEndianOn: stream.
	self assert: #(12 34 56 78) equals: stream contents! !

!ShortIntegerArrayTest methodsFor: 'testing' stamp: 'hjo 1/26/2011 19:34'!
testWriteLittleEndianOn

	|stream|
	stream := WriteStream on: Array new.
	shortIntegerArray write: (12 bitShift: 24) +(34 bitShift: 16)+(56 bitShift: 8)+78 littleEndianOn: stream.
	self assert: #(56 78 12 34) equals: stream contents! !

!ShortIntegerArrayTest methodsFor: 'testing' stamp: 'hjo 1/17/2011 10:20'!
testSwapBytePairs

	shortIntegerArray swapBytePairsHacky.
	self assert: 4*256 equals: (shortIntegerArray at:1). 
	self assert: 4*256 + 1 equals: (shortIntegerArray at:2).
	self assert: 2*256 equals: (shortIntegerArray at:3).
	self assert: 1*256 + 10 equals: (shortIntegerArray at:4).
! !

!ShortIntegerArrayTest methodsFor: 'testing' stamp: 'hjo 1/17/2011 10:16'!
testAt

	self assert: 2  equals: (shortIntegerArray at: 3)
	! !

!ShortIntegerArrayTest methodsFor: 'running' stamp: 'hjo 1/17/2011 00:55'!
setUp 

	super setUp.
	shortIntegerArray := ShortIntegerArray with: 4 with: 4+256 with: 2 with: 1+(256*10).
! !

!ShortIntegerArrayTest methodsFor: 'testing' stamp: 'hjo 1/17/2011 10:18'!
testSetUp

	self assert: 4 equals: (shortIntegerArray at:1) . 
	self assert: 4+256 equals: (shortIntegerArray at:2).
	self assert: 2 equals: (shortIntegerArray at:3).
	self assert: 1+(256*10) equals: (shortIntegerArray at:4).
! !

!ShouldBeImplemented commentStamp: 'SvenVanCaekenberghe 4/21/2011 12:34'!
I am ShouldBeImplemented, an exception signaled when some method should have been implemented but was not.

This is more like a placeholder during development.!
!ShouldBeImplemented methodsFor: 'printing' stamp: 'nice 12/2/2011 23:36'!
standardMessageText
	"Generate a standard textual description"
	
	^ String streamContents: [ :stream |
		stream print: self selector.
		stream << ' should have been implemented in '.
		stream print: self signaler class]! !

!ShouldNotImplement commentStamp: 'SvenVanCaekenberghe 4/21/2011 12:33'!
I am ShouldNotImplement, an exception signaled when a method was implemented but should not have been.

This can happen when an implementation is inherited.!
!ShouldNotImplement methodsFor: 'printing' stamp: 'nice 12/2/2011 23:36'!
standardMessageText
	"Generate a standard textual description"
	
	^ String streamContents: [ :stream |
		stream print: self selector.
		stream << ' should not have been implemented in '.
		stream print: self signaler class]! !

!SimpleBalloonMorph methodsFor: 'initialization' stamp: 'AlainPlantec 2/22/2011 17:57'!
initialize
	"Initialize the the receiver."
	
	super initialize.
	self beStraightSegments! !

!SimpleBalloonMorph class methodsFor: 'private' stamp: 'gvc 1/30/2009 15:11'!
getVertices: bounds
	"Construct vertices for a balloon up and to left of anchor."

	^(bounds expandBy: 3) corners atAll: #(1 4 3 2)! !

!SimpleBorder commentStamp: 'kfr 10/27/2003 10:17'!
see BorderedMorph!
!SimpleBorder methodsFor: 'accessing' stamp: 'ar 8/25/2001 16:10'!
width: aNumber
	width = aNumber ifTrue:[^self].
	width := aNumber truncated max: (width isPoint ifTrue:[0@0] ifFalse:[0]).
	self releaseCachedState.! !

!SimpleBorder methodsFor: 'accessing' stamp: 'ar 8/25/2001 16:35'!
width
	^width! !

!SimpleBorder methodsFor: 'drawing' stamp: 'aoy 2/17/2003 01:14'!
drawLineFrom: startPoint to: stopPoint on: aCanvas 
	| lineColor |
	lineColor := (stopPoint truncated quadrantOf: startPoint truncated) > 2 
				ifTrue: [self topLeftColor]
				ifFalse: [self bottomRightColor].
	aCanvas 
		line: startPoint
		to: stopPoint 
		width: self width
		color: lineColor! !

!SimpleBorder methodsFor: 'drawing' stamp: 'ar 8/25/2001 16:27'!
frameRectangle: aRectangle on: aCanvas
	aCanvas frameAndFillRectangle: aRectangle
		fillColor: Color transparent
		borderWidth: self width
		topLeftColor: self topLeftColor
		bottomRightColor: self bottomRightColor.! !

!SimpleBorder methodsFor: 'accessing' stamp: 'ar 8/25/2001 16:10'!
color: aColor
	color = aColor ifTrue:[^self].
	color := aColor.
	self releaseCachedState.! !

!SimpleBorder methodsFor: 'accessing' stamp: 'gvc 1/31/2007 13:50'!
topLeftColor
	"Changed from direct access to color since, if nil,
	self color is transparent."

	^self color! !

!SimpleBorder methodsFor: 'accessing' stamp: 'ar 8/25/2001 17:52'!
style
	^#simple! !

!SimpleBorder methodsFor: 'initialization' stamp: 'sd 11/25/2008 14:47'!
initialize

	super initialize.
	color := Color transparent
	! !

!SimpleBorder methodsFor: 'accessing' stamp: 'ar 8/25/2001 18:19'!
baseColor
	^baseColor ifNil:[Color transparent]! !

!SimpleBorder methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/6/2015 22:27'!
asTwoColorStrokePaintOn: anAthensCanvas
	^ AthensBorderStrokePaint
		topLeftColor: self topLeftColor
		bottomRightColor: self bottomRightColor
		width: self width
		on: anAthensCanvas! !

!SimpleBorder methodsFor: 'accessing' stamp: 'gvc 1/31/2007 13:50'!
bottomRightColor
	"Changed from direct access to color since, if nil,
	self color is transparent."

	^self color! !

!SimpleBorder methodsFor: 'accessing' stamp: 'ar 8/25/2001 18:19'!
color
	^color ifNil:[Color transparent]! !

!SimpleBorder methodsFor: 'accessing' stamp: 'ar 8/25/2001 18:23'!
baseColor: aColor
	| cc |
	cc := aColor isTransparent ifTrue:[nil] ifFalse:[aColor].
	baseColor = cc ifTrue:[^self].
	baseColor := cc.
	self releaseCachedState.
	self color: cc.
! !

!SimpleBorder methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/6/2015 22:28'!
asAthensPaintOn: anAthensCanvas
	^ self topLeftColor = self bottomRightColor
		ifTrue: [ super asAthensPaintOn: anAthensCanvas ]
		ifFalse: [ self asTwoColorStrokePaintOn: anAthensCanvas ]! !

!SimpleButtonMorph commentStamp: 'StephaneDucasse 8/8/2010 17:34'!
I am labeled, rectangular morph which allows the user to click me. I can be configured to send my "target" the message "actionSelector" with "arguments" when I am clicked. I may have a label, implemented as a StringMorph.

Example:

	SimpleButtonMorph new
		target: Beeper;
		label: 'Beep!!';
		actionSelector: #beep; 
		openInWorld

Structure:
instance var 	Type		Description 
target 			Object 		The Object to notify upon a click 
actionSelector 	Symbol 		The message to send to Target (#messageName) 
arguments 		Array 		Arguments to send with #actionSelection (optional) 
actWhen 		Symbol 		When to take action: may be #buttonUp (default), #buttonDown,
								#whilePressed, or #startDrag 
oldColor 		Color 		Used to restore color after click 

Another example: a button which quits the image without saving it.

	SimpleButtonMorph new
		target: Smalltalk;
		label: 'quit';
		actionSelector: #snapshot:andQuit:;
		arguments: (Array with: false with: true); 
		openInWorld

!
!SimpleButtonMorph methodsFor: 't-rotating' stamp: ''!
rotationDegrees
	"Default implementation."

	^ 0.0
! !

!SimpleButtonMorph methodsFor: 'accessing' stamp: 'dgd 2/21/2003 22:57'!
fitContents
	| aMorph aCenter |
	aCenter := self center.
	submorphs isEmpty ifTrue: [^self].
	aMorph := submorphs first.
	self extent: aMorph extent + (borderWidth + 6).
	self center: aCenter.
	aMorph position: aCenter - (aMorph extent // 2)! !

!SimpleButtonMorph methodsFor: 'submorphs-add/remove' stamp: 'nk 6/13/2004 13:46'!
actWhen: condition
	"Accepts symbols:  #buttonDown, #buttonUp, and #whilePressed, #startDrag"
	actWhen := condition.
	actWhen == #startDrag
		ifFalse: [self on: #startDrag send: nil to: nil ]
		ifTrue:[self on: #startDrag send: #doButtonAction to: self].! !

!SimpleButtonMorph methodsFor: 't-rotating' stamp: ''!
forwardDirection: newDirection
	"Set the receiver's forward direction (in eToy terms)"
	self setProperty: #forwardDirection toValue: newDirection.! !

!SimpleButtonMorph methodsFor: 'event handling' stamp: 'wiz 5/18/2006 03:33'!
mouseUp: evt
	super mouseUp: evt.
	oldColor ifNotNil:
		["if oldColor nil, it signals that mouse had not gone DOWN
		inside me, e.g. because of a cmd-drag; in this case we want
		to avoid triggering the action!!"
		self color: oldColor.
		oldColor := nil.
		(self containsPoint: evt cursorPoint) 
				ifTrue: [ actWhen == #buttonUp 
							ifTrue: [self doButtonAction]  ]
				ifFalse: [ self mouseLeave: evt "This is a balk. Note that we have left." ]]
		
! !

!SimpleButtonMorph methodsFor: 'visual properties' stamp: 'yo 8/27/2008 23:58'!
updateVisualState: evt
	
	oldColor ifNotNil: [
		 self color: 
			((self containsPoint: evt cursorPoint)
				ifTrue: [oldColor mixed: 0.5 with: Color white]
				ifFalse: [oldColor])]
! !

!SimpleButtonMorph methodsFor: '*glamour-morphic-widgets' stamp: 'cyrilledelaunay 6/6/2011 16:01'!
setOptimalResizing
	self hResizing: #rigid.
	self vResizing: #rigid! !

!SimpleButtonMorph methodsFor: 'accessing' stamp: ''!
target

	^ target
! !

!SimpleButtonMorph methodsFor: 'copying' stamp: 'tk 1/6/1999 17:55'!
veryDeepFixupWith: deepCopier
	"If target and arguments fields were weakly copied, fix them here.  If they were in the tree being copied, fix them up, otherwise point to the originals!!!!"

super veryDeepFixupWith: deepCopier.
target := deepCopier references at: target ifAbsent: [target].
arguments := arguments collect: [:each |
	deepCopier references at: each ifAbsent: [each]].
! !

!SimpleButtonMorph methodsFor: 'event handling' stamp: 'StephaneDucasse 7/18/2010 16:36'!
handlesMouseDown: evt
	^  true
! !

!SimpleButtonMorph methodsFor: 'event handling' stamp: 'ar 10/25/2000 18:15'!
mouseStillDown: evt
	actWhen == #whilePressed ifFalse:[^self].
	(self containsPoint: evt cursorPoint) ifTrue:[self doButtonAction].! !

!SimpleButtonMorph methodsFor: 't-rotating' stamp: ''!
forwardDirection
	"Return the receiver's forward direction (in eToy terms)"
	^self valueOfProperty: #forwardDirection ifAbsent:[0.0]! !

!SimpleButtonMorph methodsFor: 'accessing' stamp: 'MarcusDenker 2/19/2010 16:01'!
labelString: aString

	label ifNil: [self label: aString]
		ifNotNil:
			[label contents: aString.
			self fitContents]
! !

!SimpleButtonMorph methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 10:40'!
initialize
	super initialize.

	self borderWidth: 1.
	self color: (Color r: 0.4 g: 0.8 b: 0.6).
	self borderColor: self color darker.
	self borderStyle: BorderStyle thinGray.
	target := nil.
	actionSelector := #flash.
	arguments := EmptyArray.
	actWhen := #buttonUp.
	self setDefaultLabel ! !

!SimpleButtonMorph methodsFor: 'balloon' stamp: 'MarcusDenker 5/31/2011 16:24'!
helpText: aString

	helpText := aString! !

!SimpleButtonMorph methodsFor: 'menu' stamp: 'wiz 1/16/2006 20:05'!
clearTarget

	target := nil.
! !

!SimpleButtonMorph methodsFor: 'menu' stamp: 'StephaneDucasse 10/27/2014 09:34'!
addTargetingMenuItems: aCustomMenu hand: aHandMorph 
	"Add targeting menu items"
	aCustomMenu addLine.
	aCustomMenu add: 'set target' selector: #targetWith:.
	target
		ifNotNil: [aCustomMenu add: 'clear target' translated selector: #clearTarget]! !

!SimpleButtonMorph methodsFor: 'button' stamp: 'dgd 2/22/2003 18:53'!
doButtonAction
	"Perform the action of this button. Subclasses may override this method. The default behavior is to send the button's actionSelector to its target object with its arguments."

	(target notNil and: [actionSelector notNil]) 
		ifTrue: 
			[Cursor normal 
				showWhile: [target perform: actionSelector withArguments: arguments]].
	actWhen == #startDrag ifTrue: [oldColor ifNotNil: [self color: oldColor]]! !

!SimpleButtonMorph methodsFor: 't-rotating' stamp: ''!
setDirectionFrom: aPoint
	| delta degrees |
	delta := (self transformFromWorld globalPointToLocal: aPoint) - self referencePosition.
	degrees := delta degrees + 90.0.
	self forwardDirection: (degrees \\ 360) rounded.
! !

!SimpleButtonMorph methodsFor: 'menu' stamp: 'MarcusDenker 8/28/2013 10:22'!
setArguments

	| s newArgs newArgsArray |
	s := WriteStream on: ''.
	arguments do: [:arg | arg printOn: s. s nextPutAll: '. '].
	newArgs :=  UIManager default
		request:
'Please type the arguments to be sent to the target
when this button is pressed separated by periods' translated
		initialAnswer: s contents.
	newArgs isEmptyOrNil ifFalse: [
		newArgsArray := self class compiler source:  '{', newArgs, '}' ;
			receiver: self;
			evaluate.
		self arguments: newArgsArray].
! !

!SimpleButtonMorph methodsFor: 'copying' stamp: 'MarcusDenker 7/8/2014 20:05'!
veryDeepInner: deepCopier
	"Copy all of my instance variables.  Some need to be not copied at all, but shared.  	Warning!!!!  Every instance variable defined in this class must be handled.  We must also implement veryDeepFixupWith:.  See DeepCopier class comment."

super veryDeepInner: deepCopier.
"target := target.		Weakly copied"
"actionSelector := actionSelector.		a Symbol"
"arguments := arguments.		All weakly copied"
actWhen := actWhen veryDeepCopyWith: deepCopier.
oldColor := oldColor veryDeepCopyWith: deepCopier.
label := label veryDeepCopyWith: deepCopier.
helpText := helpText veryDeepCopyWith: deepCopier.! !

!SimpleButtonMorph methodsFor: 'event handling' stamp: 'ar 10/25/2000 18:10'!
mouseMove: evt
	actWhen == #buttonDown ifTrue: [^ self].
	self updateVisualState: evt.! !

!SimpleButtonMorph methodsFor: 'accessing' stamp: 'MarcusDenker 4/21/2013 08:31'!
label: aString
	self label: aString font: StandardFonts buttonFont! !

!SimpleButtonMorph methodsFor: 't-rotating' stamp: ''!
rotationDegrees: degrees	
	"redefined in all morphs which are using myself"! !

!SimpleButtonMorph methodsFor: 'accessing' stamp: ''!
target: anObject

	target := anObject
! !

!SimpleButtonMorph methodsFor: 't-rotating' stamp: ''!
prepareForRotating
	"If I require a flex shell to rotate,
	then wrap it in one and return it.
	Polygons, eg, may override to do nothing."

	^ self addFlexShell! !

!SimpleButtonMorph methodsFor: 'accessing' stamp: ''!
actionSelector: aSymbolOrString

	(nil = aSymbolOrString or:
	 ['nil' = aSymbolOrString or:
	 [aSymbolOrString isEmpty]])
		ifTrue: [^ actionSelector := nil].

	actionSelector := aSymbolOrString asSymbol.
! !

!SimpleButtonMorph methodsFor: 'geometry' stamp: 'MarcusDenker 10/29/2010 11:40'!
extent: newExtent

	super extent: newExtent.
	label ifNotNil: [label position: self center - (label extent // 2)].! !

!SimpleButtonMorph methodsFor: 'menu' stamp: 'wiz 12/4/2006 00:32'!
setTarget: evt 
	| rootMorphs |
	rootMorphs := self world rootMorphsAt: evt hand targetPoint.
	target := rootMorphs size > 1
				ifTrue: [rootMorphs second]! !

!SimpleButtonMorph methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 10:39'!
setDefaultLabel
	self label: self defaultLabel
! !

!SimpleButtonMorph methodsFor: 'menu' stamp: 'StephaneDucasse 10/27/2014 09:34'!
addCustomMenuItems: aCustomMenu hand: aHandMorph

	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
	self addLabelItemsTo: aCustomMenu hand: aHandMorph.
	aCustomMenu add: 'change action selector' selector: #setActionSelector.
	aCustomMenu add: 'change arguments' selector: #setArguments.
	aCustomMenu add: 'change when to act' selector: #setActWhen.
	self addTargetingMenuItems: aCustomMenu hand: aHandMorph.
! !

!SimpleButtonMorph methodsFor: 'menu' stamp: 'DamienCassou 9/29/2009 13:09'!
setActionSelector

	| newSel |
	newSel := UIManager default
		request:
'Please type the selector to be sent to
the target when this button is pressed' translated
		initialAnswer: actionSelector.
	newSel isEmptyOrNil ifFalse: [self actionSelector: newSel].
! !

!SimpleButtonMorph methodsFor: 't-rotating' stamp: ''!
heading
	"Return the receiver's heading"
	^ self owner 
		ifNil: [self forwardDirection]
		ifNotNil: [self forwardDirection + self owner degreesOfFlex]! !

!SimpleButtonMorph methodsFor: 'accessing' stamp: ''!
arguments: aCollection

	arguments := aCollection asArray copy.
! !

!SimpleButtonMorph methodsFor: 'balloon' stamp: 'BenjaminVanRyseghem 5/31/2011 15:09'!
balloonText

	^ self helpText! !

!SimpleButtonMorph methodsFor: 'events-processing' stamp: 'nk 1/11/2004 13:25'!
mouseStillDownStepRate
	"Answer how often I want the #handleMouseStillDown: stepped"
	^200! !

!SimpleButtonMorph methodsFor: 'accessing' stamp: ''!
label

	| s |
	s := ''.
	self allMorphsDo: [:m | (m isKindOf: StringMorph) ifTrue: [s := m contents]].
	^ s! !

!SimpleButtonMorph methodsFor: 'menu' stamp: 'DamienCassou 9/29/2009 13:10'!
setLabel

	| newLabel |
	newLabel := UIManager default
		request: 'Please enter a new label for this button' translated
		initialAnswer: self label.
	newLabel isEmptyOrNil ifFalse: [self labelString: newLabel].
! !

!SimpleButtonMorph methodsFor: 'accessing' stamp: 'AlainPlantec 9/30/2011 16:57'!
label: aString font: aFont

	label ifNotNil: [label delete].
	label := StringMorph contents: aString font: (aFont ifNil: [StandardFonts buttonFont]).
	self extent: (label width + 6) @ (label height + 6).
	label position: self center - (label extent // 2).
	self addMorph: label.
	label lock
! !

!SimpleButtonMorph methodsFor: 'menu' stamp: 'alain.plantec 2/6/2009 17:23'!
setActWhen
	| selections |
	selections := #(#buttonDown #buttonUp #whilePressed #startDrag ).
	actWhen := UIManager default
				chooseFrom: (selections 
						collect: [:t | t translated])
				values: selections
				title: 'Choose one of the following conditions' translated! !

!SimpleButtonMorph methodsFor: 'balloon' stamp: 'BenjaminVanRyseghem 5/31/2011 14:54'!
helpText

	^ helpText! !

!SimpleButtonMorph methodsFor: 'event handling' stamp: 'MarcusDenker 7/8/2014 20:05'!
mouseDown: evt

	super mouseDown: evt.
	evt yellowButtonPressed ifTrue: [ ^self ] .
	oldColor := self fillStyle. 
	actWhen == #buttonDown
		ifTrue: [ self doButtonAction]
		ifFalse: [ self updateVisualState: evt ].
	self mouseStillDown: evt.! !

!SimpleButtonMorph methodsFor: 'submorphs-add/remove' stamp: 'sw 10/8/2000 08:14'!
actWhen
	"acceptable symbols:  #buttonDown, #buttonUp, and #whilePressed"

	^ actWhen! !

!SimpleButtonMorph methodsFor: 'accessing' stamp: ''!
arguments

	^ arguments
! !

!SimpleButtonMorph methodsFor: 'menu' stamp: 'StephaneDucasse 10/27/2014 09:34'!
addLabelItemsTo: aCustomMenu hand: aHandMorph 
	aCustomMenu add: 'change label' selector: #setLabel! !

!SimpleButtonMorph methodsFor: 'accessing' stamp: ''!
actionSelector

	^ actionSelector
! !

!SimpleButtonMorph methodsFor: 'event handling' stamp: 'ar 10/25/2000 18:15'!
handlesMouseStillDown: evt
	^actWhen == #whilePressed! !

!SimpleButtonMorph methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 10:38'!
defaultLabel
	^ 'Flash'.
! !

!SimpleButtonMorph class methodsFor: 'as yet unclassified' stamp: 'alain.plantec 5/28/2009 10:44'!
newWithLabel: labelString

	^ self new label:  labelString
! !

!SimpleEditor commentStamp: '<historical>'!
See comment in Editor!
!SimpleEditor methodsFor: 'testing' stamp: 'jmv 11/17/2008 17:01'!
isAtEnd
	^pointIndex = (string size + 1)! !

!SimpleEditor methodsFor: 'accessing' stamp: 'jmv 11/5/2008 12:22'!
replace: oldInterval with: newString and: selectingBlock 
	"Replace the text in oldInterval with newString and execute selectingBlock to establish the new selection."

	self selectionInterval = oldInterval ifFalse: [self selectInterval: oldInterval].
	self zapSelectionWith: newString.
	selectingBlock value! !

!SimpleEditor methodsFor: 'nonediting/nontyping keys' stamp: 'StephaneDucasse 3/31/2010 22:06'!
cursorEnd: aKeyboardEvent

	"Private - Move cursor end of current line."
	self closeTypeIn.
	self
		moveCursor:
			[ :position | 
				string
					indexOf: Character cr
					startingAt: position
					ifAbsent:[string size + 1]]
		forward: true
		specialBlock: [:dummy | string size + 1]
		event: aKeyboardEvent.
	^true! !

!SimpleEditor methodsFor: 'menu messages' stamp: 'jmv 11/4/2008 23:42'!
copySelection
	"Copy the current selection and store it in the paste buffer, unless a caret.  Undoer & Redoer: undoCutCopy"

	self lineSelectAndEmptyCheck: [^ self].
	self clipboardTextPut: self selection! !

!SimpleEditor methodsFor: 'accessing' stamp: 'AlainPlantec 11/5/2010 10:54'!
replaceSelectionWith: aString
	"Replace the selection text by aText."

	self zapSelectionWith: aString! !

!SimpleEditor methodsFor: 'typing support' stamp: 'jmv 11/4/2008 13:28'!
startOfTyping
	^ beginTypeInIndex! !

!SimpleEditor methodsFor: 'initialize-release' stamp: 'jmv 11/4/2008 13:23'!
stateArray
	^ {	self selectionInterval.
		self startOfTyping}! !

!SimpleEditor methodsFor: 'accessing-selection' stamp: 'jmv 11/5/2008 11:41'!
pointIndex: anIndex
	pointIndex := anIndex min: string size + 1 max: 1! !

!SimpleEditor methodsFor: 'accessing' stamp: 'jmv 11/4/2008 16:09'!
string
	^string! !

!SimpleEditor methodsFor: 'editing keys' stamp: 'jmv 9/2/2009 12:40'!
makeLowercase: aKeyboardEvent
	"Force the current selection to lowercase.  Triggered by Cmd-X."

	self replaceSelectionWith: (self selection asLowercase).
	^ true! !

!SimpleEditor methodsFor: 'events' stamp: 'jmv 11/5/2008 14:10'!
mouseMove: evt index: index
	"Change the selection in response to moue-down drag"

	self pointIndex: index! !

!SimpleEditor methodsFor: 'new selection' stamp: 'jmv 11/4/2008 23:12'!
selectFrom: start to: stop
	"Select the specified characters inclusive."
	self selectInvisiblyFrom: start to: stop.
	self closeTypeIn! !

!SimpleEditor methodsFor: 'initialization' stamp: 'jmv 11/4/2008 13:42'!
initialize
	"Initialize the state of the receiver. Subclasses should include 'super 
	initialize' when redefining this message to insure proper initialization."

	super initialize.
	self changeString: ''! !

!SimpleEditor methodsFor: 'accessing-selection' stamp: 'jmv 11/5/2008 10:24'!
selection

	^string copyFrom: self startIndex to: self stopIndex - 1 ! !

!SimpleEditor methodsFor: 'accessing-selection' stamp: 'jmv 11/4/2008 23:24'!
hasCaret
	^markIndex = pointIndex! !

!SimpleEditor methodsFor: 'accessing-selection' stamp: 'jmv 11/4/2008 13:55'!
stopIndex
	^ pointIndex max: markIndex! !

!SimpleEditor methodsFor: 'editing keys' stamp: 'jmv 9/2/2009 12:40'!
makeCapitalized: aKeyboardEvent
	"Force the current selection to uppercase.  Triggered by Cmd-X."
	| prev |
	prev := $-.  "not a letter"
	self replaceSelectionWith:
		(self selection collect: [:c |
			prev := prev isLetter ifTrue: [c asLowercase] ifFalse: [c asUppercase]]).
	^ true! !

!SimpleEditor methodsFor: 'initialize-release' stamp: 'jmv 11/4/2008 14:12'!
resetState 
	"Establish the initial conditions for editing the paragraph: place caret 
	before first character, set the emphasis to that of the first character,
	and save the paragraph for purposes of canceling."

	pointIndex := 1.	"Like pointBlock in EnhancedTextEditor"
	markIndex := 1.	"Like markIndex in EnhancedTextEditor"
	beginTypeInIndex := nil.	"Like beginTypeInBlock in EnhancedTextEditor"
	selectionShowing := false! !

!SimpleEditor methodsFor: 'new selection' stamp: 'jmv 11/4/2008 23:49'!
selectLine
	"Make the receiver's selection, if it currently consists of an insertion point only, encompass the current line."
	self hasSelection ifTrue:[^self].
	self selectAll! !

!SimpleEditor methodsFor: 'testing' stamp: 'jmv 11/17/2008 17:01'!
isAtStart
	^pointIndex = 1! !

!SimpleEditor methodsFor: 'typing support' stamp: 'jmv 9/2/2009 11:47'!
backTo: startIndex
	"During typing, backspace to startIndex.  Deleted characters fall into three
	 clusters, from left to right in the text: (1) preexisting characters that were
	 backed over; (2) newly typed characters that were backed over; 
	(3) preexisting characters that
	 were highlighted before typing began.  If typing has not yet been opened,
	 open it and watch for the first and third cluster.  If typing has been opened,
	 watch for the first and second cluster.  
	 Delete all the clusters.  The code is shorter than the comment."

	| saveLimit |
	saveLimit := beginTypeInIndex
		ifNil: [self openTypeIn. self stopIndex]
		ifNotNil: [self startOfTyping].
	self markIndex: startIndex.
	startIndex < saveLimit ifTrue: [
		beginTypeInIndex := self startIndex.].
	self zapSelectionWith: ''.
	self unselect! !

!SimpleEditor methodsFor: 'menu messages' stamp: 'jmv 11/5/2008 10:21'!
cut
	"Cut out the current selection and redisplay the paragraph if necessary.  Undoer & Redoer: undoCutCopy:"

	self lineSelectAndEmptyCheck: [^ self].
	self replaceSelectionWith: ''. 
	self clipboardTextPut: self selection! !

!SimpleEditor methodsFor: 'typing/selecting keys' stamp: 'jmv 9/2/2009 13:02'!
forwardDelete: aKeyboardEvent
	"Delete forward over the next character.
	  Make Undo work on the whole type-in, not just the one char.
	wod 11/3/1998: If there was a selection use #zapSelectionWith: rather than #backspace: which was 'one off' in deleting the selection. Handling of things like undo or typeIn area were not fully considered."

	| startIndex stopIndex |
	startIndex := self markIndex.
	startIndex > string size ifTrue: [
		^ false].
	self hasSelection ifTrue: [
		"there was a selection"
		self zapSelectionWith: ''.
		^ false].
	"Null selection - do the delete forward"
	beginTypeInIndex isNil	"no previous typing.  openTypeIn"
		ifTrue: [self openTypeIn].
	stopIndex := startIndex.
	(aKeyboardEvent keyValue = 127 and: [ aKeyboardEvent shiftPressed ])
		ifTrue: [ stopIndex := (self nextWord: stopIndex) - 1 ].
	self selectFrom: startIndex to: stopIndex.
	self replaceSelectionWith: ''.
	self selectFrom: startIndex to: startIndex-1.
	^false! !

!SimpleEditor methodsFor: 'typing support' stamp: 'jmv 9/2/2009 11:47'!
closeTypeIn
	"See comment in openTypeIn.  It is important to call closeTypeIn before executing
	 any non-typing key, making a new selection, etc.  It is called automatically for
	 menu commands."

	beginTypeInIndex := nil! !

!SimpleEditor methodsFor: 'nonediting/nontyping keys' stamp: 'NicolaiHess 11/20/2014 21:49'!
cursorHome: aKeyboardEvent 

	"Private - Move cursor from position in current line to beginning of
	current line. If control key is pressed put cursor at beginning of text"

	self closeTypeIn.
	self
		moveCursor: [ :position |
				(string
					lastIndexOf: Character cr
					startingAt: position - 1
					ifAbsent:[0]) + 1]
		forward: false
		specialBlock: [:dummy | 1]
		event: aKeyboardEvent.
	^true! !

!SimpleEditor methodsFor: 'accessing-selection' stamp: 'jmv 11/5/2008 11:41'!
markIndex: anIndex
	markIndex := anIndex min: string size + 1 max: 1! !

!SimpleEditor methodsFor: 'typing support' stamp: 'jmv 9/2/2009 07:23'!
addString: aString
	"Think of a better name"

	self zapSelectionWith: aString! !

!SimpleEditor methodsFor: 'typing support' stamp: 'FernandoOlivero 5/17/2010 15:14'!
dispatchOn: aKeyboardEvent
	"Carry out the action associated with this character, if any.
	Type-ahead is passed so some routines can flush or use it."

	| asciiValue honorCommandKeys |

	"We don't support multiple lines. Therefore, we don't process cr as a #normalCharacter:"
	asciiValue := aKeyboardEvent keyValue.
	asciiValue = Character cr asciiValue 
		ifTrue: [
			morph acceptOnCR
				ifTrue:[
					morph acceptContents .
					self closeTypeIn.
					^ true].
			aKeyboardEvent controlKeyPressed ifTrue: [ ^ self normalCharacter: aKeyboardEvent ].
			aKeyboardEvent shiftPressed ifTrue: [ ^ self lf: aKeyboardEvent ].
			aKeyboardEvent commandKeyPressed ifTrue: [ ^ self crlf: aKeyboardEvent ].
			^ self crWithIndent: aKeyboardEvent ].

	honorCommandKeys := self cmdKeysInText.

	"Special keys overwrite crtl+key combinations - at least on Windows. To resolve this
	conflict, assume that keys other than cursor keys aren't used together with Crtl." 
	((self class specialShiftCmdKeys includes: asciiValue) and: [ asciiValue < 27])
		ifTrue: [^ aKeyboardEvent controlKeyPressed
			ifTrue: [self perform: (ShiftCmdActions at: asciiValue + 1) with: aKeyboardEvent]
			ifFalse: [self perform: (CmdActions at: asciiValue + 1) with: aKeyboardEvent]].

	"backspace, and escape keys (ascii 8 and 27) are command keys"
	((honorCommandKeys and: [aKeyboardEvent commandKeyPressed]) or: [self class specialShiftCmdKeys includes: asciiValue]) ifTrue: [
		^ aKeyboardEvent shiftPressed
			ifTrue: [
				self perform: (ShiftCmdActions at: asciiValue + 1) with: aKeyboardEvent]
			ifFalse: [
				self perform: (CmdActions at: asciiValue + 1) with: aKeyboardEvent]].

	"the control key can be used to invoke shift-cmd shortcuts"
	(honorCommandKeys and: [aKeyboardEvent controlKeyPressed])
		ifTrue: [
			^ self perform: (ShiftCmdActions at: asciiValue + 1) with: aKeyboardEvent].

	^ self normalCharacter: aKeyboardEvent! !

!SimpleEditor methodsFor: 'initialize-release' stamp: 'jmv 11/4/2008 13:23'!
stateArrayPut: stateArray
	| sel |
	sel := stateArray at: 1.
	self selectFrom: sel first to: sel last.
	beginTypeInIndex := stateArray at: 2! !

!SimpleEditor methodsFor: 'events' stamp: 'jmv 11/5/2008 13:54'!
mouseDown: evt index: index
	
	self closeTypeIn.
	evt shiftPressed
		ifFalse: [
			self pointIndex: index.
			self markIndex: index]
		ifTrue: [
			self mouseMove: evt ]! !

!SimpleEditor methodsFor: 'testing' stamp: 'FernandoOlivero 6/15/2010 13:07'!
isSimpleEditor 
	^ true ! !

!SimpleEditor methodsFor: 'accessing-selection' stamp: 'jmv 11/4/2008 13:57'!
pointIndex
	^ pointIndex! !

!SimpleEditor methodsFor: 'typing support' stamp: 'AlainPlantec 11/5/2010 10:53'!
processKeyStroke: aKeyboardEvent

	"Key struck on the keyboard. Find out which one and, if special, carry 
	out the associated special action. Otherwise, add the character to the 
	stream of characters.  Undoer & Redoer: see closeTypeIn."

	(self dispatchOn: aKeyboardEvent) 
		ifTrue: [self doneTyping.
			^self].
	self openTypeIn.
	self unselect! !

!SimpleEditor methodsFor: 'initialize-release' stamp: 'jmv 11/4/2008 13:08'!
changeString: aString
	"Install aString as the one to be edited by the receiver."

	string := aString.
	self resetState! !

!SimpleEditor methodsFor: 'typing support' stamp: 'jmv 11/4/2008 14:04'!
doneTyping
	beginTypeInIndex := nil! !

!SimpleEditor methodsFor: 'typing support' stamp: 'jmv 7/30/2009 00:45'!
openTypeIn
	"Set up beginTypeInIndex to keep track of the leftmost backspace."

	beginTypeInIndex ifNil: [
		beginTypeInIndex := self startIndex ]! !

!SimpleEditor methodsFor: 'editing keys' stamp: 'jmv 9/2/2009 12:40'!
makeUppercase: aKeyboardEvent
	"Force the current selection to uppercase.  Triggered by Cmd-Y."

	self replaceSelectionWith: (self selection asUppercase).
	^ true! !

!SimpleEditor methodsFor: 'accessing-selection' stamp: 'jmv 11/4/2008 13:55'!
startIndex
	^ pointIndex min: markIndex! !

!SimpleEditor methodsFor: 'accessing-selection' stamp: 'jmv 11/4/2008 13:57'!
markIndex
	^markIndex! !

!SimpleEditor methodsFor: 'mvc compatibility' stamp: 'AlainPlantec 11/5/2010 10:54'!
zapSelectionWith: aString

	| start stop |
	start := self startIndex.
	stop := self stopIndex.
	(start = stop and: [aString size = 0]) ifFalse: [
		string := string copyReplaceFrom: start to: stop-1 with: aString.
		self
			markIndex: start; 
			pointIndex: start + aString size.

		self userHasEdited  " -- note text now dirty" ]! !

!SimpleEditor class methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 2/26/2011 17:11'!
initializeCmdKeyShortcuts
	"Initialize the (unshifted) command-key (or alt-key) shortcut table."

	"NOTE: if you don't know what your keyboard generates, use Sensor kbdTest"

	"
	SimpleEditor initialize
	"

	| cmdMap cmds |
	cmdMap := Array new: 256 withAll: #noop:.	"use temp in case of a crash"
	cmdMap at: 1 + 1 put: #cursorHome:.	"home key"
	cmdMap at: 4 + 1 put: #cursorEnd:.	"end key"
	cmdMap at: 8 + 1 put: #backspace:.	"ctrl-H or delete key"
	cmdMap at: 27 + 1 put: #escape:.	"left arrow key"
	cmdMap at: 28 + 1 put: #cursorLeft:.	"left arrow key"
	cmdMap at: 29 + 1 put: #cursorRight:.	"right arrow key"
	cmdMap at: 32 + 1 put: #selectWord:.	"space bar key"
	cmdMap at: 127 + 1 put: #forwardDelete:.	"del key"
	
	cmds := #($a #selectAll: $c #copySelection: $v #paste: $w #backWord: $x #cut: ).
	1 to: cmds size
		by: 2
		do: [:i | cmdMap at: (cmds at: i) asciiValue + 1 put: (cmds at: i + 1)].
	CmdActions := cmdMap! !

!SimpleEditor class methodsFor: 'as yet unclassified' stamp: 'FernandoOlivero 3/16/2010 00:26'!
initialize 
	"Initialize the keyboard shortcut maps and the shared buffers
	for copying text across views and managing again and undo." 
 
	"
	SimpleEditor initialize
	"

	self initializeCmdKeyShortcuts.
	self initializeShiftCmdKeyShortcuts! !

!SimpleEditor class methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 2/6/2012 11:39'!
initializeShiftCmdKeyShortcuts 
	"Initialize the shift-command-key (or control-key) shortcut table."
	"NOTE: if you don't know what your keyboard generates, use Sensor kbdTest"
	"wod 11/3/1998: Fix setting of cmdMap for shifted keys to actually use the 
	capitalized versions of the letters.
	TPR 2/18/99: add the plain ascii values back in for those VMs that don't return the shifted values."

	| cmdMap |

	"shift-command and control shortcuts"
	cmdMap := Array new: 256 withAll: #noop:.  "use temp in case of a crash"
	cmdMap at: ( 1 + 1) put: #cursorHome:.			"home key"
	cmdMap at: ( 4 + 1) put: #cursorEnd:.			"end key"
	cmdMap at: ( 8 + 1) put: #forwardDelete:.		"ctrl-H or delete key"
	cmdMap at: (28 + 1) put: #cursorLeft:.			"left arrow key"
	cmdMap at: (29 + 1) put: #cursorRight:.			"right arrow key"
	cmdMap at: (27 + 1) put: #escape.					"escape"				
	cmdMap at: (32 + 1) put: #selectWord:.			"space bar key"
	cmdMap at: (127 + 1) put: #forwardDelete:.		"del key"

	#(
		$x	makeLowercase:
		$y	makeUppercase:
		$z	makeCapitalized:
	) pairsDo: [ :char :symbol|
		cmdMap at: char asciiValue + 1 put: symbol.
		cmdMap at: char asciiValue + 1 put: symbol.		"plain keys"
		cmdMap at: char asciiValue - 32 + 1 put:symbol.		"shifted keys"
		cmdMap at: char asciiValue - 96 + 1 put: symbol.		"ctrl keys"
	].
	ShiftCmdActions := cmdMap! !

!SimpleGridExample commentStamp: 'AlainPlantec 2/1/2010 11:58'!
SimpleGridExample new open!
!SimpleGridExample methodsFor: 'instance creation' stamp: 'AlainPlantec 2/1/2010 11:58'!
open
	(self treeMorph buildContents;
		embeddedInMorphicWindowLabeled: 'Simple grid example') openInWorld! !

!SimpleGridExample methodsFor: 'accessing' stamp: 'AlainPlantec 2/7/2010 22:47'!
rootNodeClassFromItem: anItem
	^ SimpleGridNodeExample! !

!SimpleGridExample methodsFor: 'user interface' stamp: 'AlainPlantec 10/10/2011 11:32'!
treeMorph
	| treeMorph oddColor evenColor |
	treeMorph := (self treeMorphClass on: self)
		beCheckList;
		beMultiple;
		columns: {MorphTreeColumn new startWidth: 100;
						rowMorphGetSelector: #firstNameMorph;
						headerButtonLabel: 'First name' font:  nil.
					MorphTreeColumn new startWidth: 150;
						rowMorphGetSelector: #secondNameMorph;
						headerButtonLabel: 'Second name' font:  nil.
					MorphTreeColumn new startWidth: 50;
						rowMorphGetSelector: #ageMorph;
						headerButtonLabel: 'Age' font:  nil.
					MorphTreeColumn new startWidth: 50;
						rowMorphGetSelector: #marriedMorph;
					 	headerButtonLabel: 'Married' font: nil};
		columnInset: 3;
		rowInset: 1;
		preferedPaneColor: Color white;
		rowColorForEven:  Color veryLightGray muchLighter odd: Color white .
	^ treeMorph ! !

!SimpleGridExample methodsFor: 'accessing' stamp: 'AlainPlantec 10/9/2011 11:12'!
rootItems
	^ rootItems ifNil: [rootItems := (1 to: 1000)
		collect: [:i | PersonDataExample
				firstName: 'Person' , i asString
				secondName: 'Person' , i asString , ' second name'
				age: i
				married: false] ]! !

!SimpleGridExample class methodsFor: 'examples' stamp: 'TorstenBergmann 9/30/2014 20:12'!
example

	SimpleGridExample new open! !

!SimpleGridNodeExample commentStamp: 'TorstenBergmann 2/3/2014 23:55'!
Example for a simple grid node!
!SimpleGridNodeExample methodsFor: 'as yet unclassified' stamp: 'FernandoOlivero 4/12/2011 10:19'!
firstNameMorph
	^ ( self theme  
				newTextEntryIn: World
				for: self 
				get: #firstName
				set: #firstName:
				class: String
				getEnabled: nil
				help: nil) color: Color transparent! !

!SimpleGridNodeExample methodsFor: 'as yet unclassified' stamp: 'FernandoOlivero 4/12/2011 10:18'!
ageMorph
	^ ( self theme  
				newTextEntryIn: World
				for: self 
				get: #age
				set: #age:
				class: Integer
				getEnabled: nil
				help: nil) color: Color transparent! !

!SimpleGridNodeExample methodsFor: 'accessing' stamp: 'AlainPlantec 2/2/2010 07:50'!
married: aBoolean
	self item married: aBoolean.
	self changed: #married! !

!SimpleGridNodeExample methodsFor: 'accessing' stamp: 'AlainPlantec 2/2/2010 07:49'!
firstName: aString
	self item firstName: aString.
	self changed: #firstName! !

!SimpleGridNodeExample methodsFor: 'accessing' stamp: 'AlainPlantec 2/2/2010 07:51'!
firstName
	^ self item firstName! !

!SimpleGridNodeExample methodsFor: 'accessing' stamp: 'AlainPlantec 2/2/2010 07:49'!
age: anInteger
	self item age: anInteger.
	self changed: #age! !

!SimpleGridNodeExample methodsFor: 'accessing' stamp: 'AlainPlantec 2/2/2010 07:51'!
secondName
	^ self item secondName! !

!SimpleGridNodeExample methodsFor: 'as yet unclassified' stamp: 'FernandoOlivero 4/12/2011 10:18'!
secondNameMorph
	^ ( self theme  
				newTextEntryIn: World
				for: self 
				get: #secondName
				set: #secondName:
				class: String
				getEnabled: nil
				help: nil) color: Color transparent! !

!SimpleGridNodeExample methodsFor: 'accessing' stamp: 'AlainPlantec 2/2/2010 07:50'!
married
	^ self item married! !

!SimpleGridNodeExample methodsFor: 'as yet unclassified' stamp: 'FernandoOlivero 4/12/2011 10:17'!
marriedMorph
	^ ( self theme  
			newCheckboxIn: World
			for: self 
			getSelected: #married
			setSelected: #married:
			getEnabled: nil
			label: '' 
			help: nil) color: Color transparent! !

!SimpleGridNodeExample methodsFor: 'accessing' stamp: 'AlainPlantec 2/2/2010 07:50'!
secondName: aString
	self item secondName: aString.
	self changed: #secondName! !

!SimpleGridNodeExample methodsFor: 'accessing' stamp: 'AlainPlantec 2/2/2010 07:48'!
age
	^ self item age! !

!SimpleHierarchicalListMorph commentStamp: 'MarcusDenker 12/12/2009 07:36'!
Display a hierarchical list of items.  Each item should be wrapped with a ListItemWrapper.

For a simple example, look at submorphsExample.  For beefier examples, look at ObjectExplorer or FileList.!
!SimpleHierarchicalListMorph methodsFor: 'accessing' stamp: 'RAA 7/18/1998 23:18'!
columns: anArray

	columns := anArray! !

!SimpleHierarchicalListMorph methodsFor: 'obsolete' stamp: 'ar 3/17/2001 17:39'!
startDrag: evt onItem: itemMorph 
	self removeObsoleteEventHandlers.! !

!SimpleHierarchicalListMorph methodsFor: 'initialization' stamp: 'di 4/10/98 16:20'!
autoDeselect: trueOrFalse
	"Enable/disable autoDeselect (see class comment)"
	autoDeselect := trueOrFalse.! !

!SimpleHierarchicalListMorph methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 5/31/2011 15:24'!
initialize
	"initialize the state of the receiver"
	super initialize.
	self initForKeystrokes.
	self
		on: #mouseMove
		send: #mouseStillDown:onItem:
		to: self! !

!SimpleHierarchicalListMorph methodsFor: 'drawing' stamp: 'EstebanLorenzano 4/29/2014 16:52'!
drawOn: aCanvas
	"Draw the selection and lines."
	
	super drawOn: aCanvas.
	searchedElement ifNotNil:
		[aCanvas clipBy: self innerBounds during: [:c |
			c
				fillRectangle: self searchedFrame
				color: (self secondarySelectionColor ifNil: [self theme secondarySelectionColor])]].
	selectedMorph ifNotNil:
		[aCanvas clipBy: self innerBounds during: [:c |
			c
				fillRectangle: self selectionFrame
				color: (self selectionColorToUse ifNil: [ self theme selectionColor ]) ] ].
	self drawLinesOn: aCanvas! !

!SimpleHierarchicalListMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/31/2011 15:25'!
searchedElement

	^ searchedElement! !

!SimpleHierarchicalListMorph methodsFor: 'testing' stamp: 'gvc 1/11/2007 14:06'!
takesKeyboardFocus
	"Answer whether the receiver can normally take keyboard focus."

	^true! !

!SimpleHierarchicalListMorph methodsFor: 'selection' stamp: 'RAA 8/1/1998 00:13'!
selectedMorph: aMorph

	self unhighlightSelection.
	selectedMorph := aMorph.
	self highlightSelection! !

!SimpleHierarchicalListMorph methodsFor: 'keyboard navigation' stamp: 'ThierryGoubier 9/7/2012 12:52'!
arrowKey: aChar
	"Handle a keyboard navigation character. Answer true if handled, false if not."

	| keyEvent |
	keyEvent := aChar asciiValue.
	keyEvent = 31
		ifTrue: [ 
			"down"
			self setSelectionIndex: self getSelectionIndex + 1.
			^ true ].
	keyEvent = 30
		ifTrue: [ 
			"up"
			self setSelectionIndex: (self getSelectionIndex - 1 max: 1).
			^ true ].
	keyEvent = 1
		ifTrue: [ 
			"home"
			self setSelectionIndex: 1.
			^ true ].
	keyEvent = 4
		ifTrue: [ 
			"end"
			self setSelectionIndex: scroller submorphs size.
			^ true ].
	keyEvent = 11
		ifTrue: [ 
			"page up"
			self setSelectionIndex: (self getSelectionIndex - self numSelectionsInView max: 1).
			^ true ].
	keyEvent = 12
		ifTrue: [ 
			"page down"
			self setSelectionIndex: self getSelectionIndex + self numSelectionsInView.
			^ true ].
	keyEvent = 29
		ifTrue: [ 
			"right"
			selectedMorph
				ifNotNil: [ 
					selectedMorph canExpand
						ifTrue: [ 
							selectedMorph isExpanded not
								ifTrue: [ self toggleExpandedState: selectedMorph ]
								ifFalse: [ self setSelectionIndex: self getSelectionIndex + 1 ] ] ].
			^ true ].
	keyEvent = 28
		ifTrue: [ 
			"left"
			selectedMorph
				ifNotNil: [ 
					selectedMorph isExpanded
						ifTrue: [ self toggleExpandedState: selectedMorph ]
						ifFalse: [ 
							| i |
							"Search parent."
							selectedMorph indentLevel > 0
								ifTrue: [ 
									i := self getSelectionIndex max: 1.
									[ i > 1 and: [ (scroller submorphs at: i) indentLevel >= selectedMorph indentLevel ] ]
										whileTrue: [ i := i - 1 max: 1 ].
									self setSelectionIndex: i ] ] ].
			^ true ].
	^ false! !

!SimpleHierarchicalListMorph methodsFor: 'drawing' stamp: 'RAA 8/3/1999 09:44'!
highlightSelection

	selectedMorph ifNotNil: [selectedMorph highlight]! !

!SimpleHierarchicalListMorph methodsFor: 'private' stamp: 'RAA 7/30/2000 19:49'!
addMorphsTo: morphList from: aCollection allowSorting: sortBoolean withExpandedItems: expandedItems atLevel: newIndent

	| priorMorph newCollection firstAddition |
	priorMorph := nil.
	newCollection := (sortBoolean and: [sortingSelector notNil]) ifTrue: [
		(aCollection asSortedCollection: [ :a :b | 
			(a perform: sortingSelector) <= (b perform: sortingSelector)]) asOrderedCollection
	] ifFalse: [
		aCollection
	].
	firstAddition := nil.
	newCollection do: [:item | 
		priorMorph := self indentingItemClass basicNew 
			initWithContents: item 
			prior: priorMorph 
			forList: self
			indentLevel: newIndent.
		firstAddition ifNil: [firstAddition := priorMorph].
		morphList add: priorMorph.
		((item hasEquivalentIn: expandedItems) or: [priorMorph isExpanded]) ifTrue: [
			priorMorph isExpanded: true.
			priorMorph 
				addChildrenForList: self 
				addingTo: morphList
				withExpandedItems: expandedItems.
		].
	].
	^firstAddition
	
! !

!SimpleHierarchicalListMorph methodsFor: 'event handling' stamp: 'AlainPlantec 1/7/2010 22:36'!
mouseEnter: event
	"Changed to take keyboardFocusOnMouseDown into account."
	
	super mouseEnter: event.
	self wantsKeyboardFocus ifFalse: [^self].
	self keyboardFocusOnMouseDown
		ifFalse: [self takeKeyboardFocus]! !

!SimpleHierarchicalListMorph methodsFor: 'updating' stamp: 'gvc 7/24/2007 12:11'!
selectionFrameChanged
	"Invalidate frame of the current selection if any."
	
	selectedMorph ifNil: [ ^self ].
	self invalidRect: self selectionFrame! !

!SimpleHierarchicalListMorph methodsFor: 'actions' stamp: 'nice 1/5/2010 15:59'!
adjustSubmorphPositions
	"Fixed to not require setting item widths to 9999."
	
	| p |
	p := 0@0.
	scroller submorphsDo: [ :each | | h |
		h := each height.
		each privateBounds: (p extent: each width@h).
		p := p + (0@h)
	].
	self 
		changed;
		layoutChanged;
		setScrollDeltas.
! !

!SimpleHierarchicalListMorph methodsFor: 'scrolling' stamp: 'sps 12/24/2002 18:31'!
hExtraScrollRange
	"Return the amount of extra blank space to include below the bottom of the scroll content."
	^5
! !

!SimpleHierarchicalListMorph methodsFor: 'updating' stamp: 'GuillermoPolito 5/23/2012 11:40'!
keyboardFocusChange: aBoolean
	"The message is sent to a morph when its keyboard focus changes.
	Update for focus feedback."
	super keyboardFocusChange: aBoolean.
	self focusChanged! !

!SimpleHierarchicalListMorph methodsFor: 'accessing' stamp: 'gvc 5/24/2007 10:30'!
expandedForm
	"Answer the form to use for expanded items."
	
	^self theme treeExpandedForm! !

!SimpleHierarchicalListMorph methodsFor: 'accessing' stamp: 'gvc 5/24/2007 10:31'!
notExpandedForm
	"Answer the form to use for unexpanded items."
	
	^self theme treeUnexpandedForm! !

!SimpleHierarchicalListMorph methodsFor: 'scrolling' stamp: 'sps 12/26/2002 13:37'!
vUnadjustedScrollRange
"Return the width of the widest item in the list"

	(scroller submorphs size > 0) ifFalse:[ ^0 ].
	^scroller submorphs last fullBounds bottom
! !

!SimpleHierarchicalListMorph methodsFor: 'private' stamp: 'RAA 8/2/1999 12:42'!
noteRemovalOfAll: aCollection

	scroller removeAllMorphsIn: aCollection.
	(aCollection includes: selectedMorph) ifTrue: [self setSelectedMorph: nil].! !

!SimpleHierarchicalListMorph methodsFor: 'drawing' stamp: 'nice 1/5/2010 15:59'!
drawLinesOn: aCanvas
	"Draw the lines for the submorphs.
	Modified for performance."
	
	| lColor|
	lColor := self lineColor.
	aCanvas 
		transformBy: scroller transform
		clippingTo: scroller innerBounds
		during: [:clippedCanvas |
			scroller submorphs do: [ :submorph | | last |
				((submorph isExpanded and: [
					(submorph nextSibling notNil and: [
						clippedCanvas isVisible: (submorph fullBounds topLeft
							corner: submorph nextSibling fullBounds bottomRight)]) or: [
					submorph nextSibling isNil and: [(last := submorph lastChild) notNil and: [
						clippedCanvas isVisible: (submorph fullBounds topLeft
							corner: last fullBounds bottomRight)]]]]) or: [
				(clippedCanvas isVisible: submorph fullBounds) or: [
				(submorph nextSibling notNil and: [
						clippedCanvas isVisible: submorph nextSibling fullBounds])]]) ifTrue:[
					submorph drawLinesOn: clippedCanvas lineColor: lColor]]]
		smoothing: scroller smoothing
! !

!SimpleHierarchicalListMorph methodsFor: 'dropping/grabbing' stamp: 'mir 5/8/2000 15:38'!
resetPotentialDropMorph
	potentialDropMorph ifNotNil: [
		potentialDropMorph resetHighlightForDrop.
		potentialDropMorph := nil]
! !

!SimpleHierarchicalListMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/11/2011 22:41'!
notExpandedFormForMorph: aMorph
	^ (self selectedMorph = aMorph and: [self theme selectionColor luminance < 0.6])
		ifTrue: [self theme whiteTreeUnexpandedForm]
		ifFalse: [self theme treeUnexpandedForm]
! !

!SimpleHierarchicalListMorph methodsFor: 'event handling' stamp: 'LaurentLaffont 8/1/2010 18:59'!
mouseUp: event 
	"Fixed up highlight problems."
	
	| aMorph wasHigh|
	aMorph := self itemFromPoint: event position.
	wasHigh := aMorph notNil ifTrue: [aMorph highlightedForMouseDown] ifFalse: [false].
	scroller submorphsDo: [:m |
		m highlightedForMouseDown ifTrue: [m highlightForMouseDown: false]].
	aMorph ifNil: [^self].
	wasHigh ifFalse: [^self].
	model okToChange ifFalse: [^self].
	"No change if model is locked"
	((autoDeselect == true) and: [aMorph == selectedMorph]) 
		ifTrue: [self setSelectedMorph: nil]
		ifFalse: [self setSelectedMorph: aMorph].
	Cursor normal show! !

!SimpleHierarchicalListMorph methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 5/31/2011 15:32'!
allItems

	^ (submorphs detect:[:each | each class = TransformMorph ]) submorphs! !

!SimpleHierarchicalListMorph methodsFor: 'drawing' stamp: 'RAA 8/3/1999 09:44'!
unhighlightSelection
	selectedMorph ifNotNil: [selectedMorph unhighlight]! !

!SimpleHierarchicalListMorph methodsFor: 'actions' stamp: 'StephaneDucasse 6/22/2014 10:22'!
expandedFormForMorph: aMorph
	"Answer the form to use for expanded items."
	
	^ (self selectedMorph = aMorph and: [self theme selectionColor luminance < 0.6])
		ifTrue: [self theme whiteTreeExpandedForm]
		ifFalse: [self theme treeExpandedForm]! !

!SimpleHierarchicalListMorph methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 4/26/2012 10:29'!
collapseAll
	"Expand all of the roots!!"
	
	self roots do: [:m |
		self collapseAll: m].
	self adjustSubmorphPositions! !

!SimpleHierarchicalListMorph methodsFor: 'accessing' stamp: 'gvc 9/11/2006 10:34'!
lineColor
	"Answer a good color to use for drawing the lines that connect members of the hierarchy view.
	Used the cached color, or derive it if necessary by finding the receiver or the first owner (up to my root) that is not transparent, then picking a contrasting color.
	Fall back to black if all my owners are transparent."

	| colored |
	lineColor ifNotNil: [^lineColor ].
	colored := self color isTransparent
		ifTrue: [self firstOwnerSuchThat: [:o | o isWorldOrHandMorph not and: [o color isTransparent not]]]
		ifFalse: [self].
	colored ifNil: [^Color black].
	^colored color luminance > 0.5
		ifTrue: [Color black]
		ifFalse: [Color white]
	
! !

!SimpleHierarchicalListMorph methodsFor: 'dropping/grabbing' stamp: 'panda 4/25/2000 17:38'!
wantsDroppedMorph: aMorph event: anEvent 
	^ self model wantsDroppedMorph: aMorph event: anEvent inMorph: self! !

!SimpleHierarchicalListMorph methodsFor: 'event handling' stamp: 'ar 3/17/2001 17:26'!
mouseEnterDragging: evt
	| aMorph |
	(evt hand hasSubmorphs and:[self dropEnabled]) ifFalse: ["no d&d"
		^super mouseEnterDragging: evt].
	(self wantsDroppedMorph: evt hand firstSubmorph event: evt )
		ifTrue:[
			aMorph := self itemFromPoint: evt position.
			aMorph ifNotNil:[self potentialDropMorph: aMorph].
			evt hand newMouseFocus: self.
			"above is ugly but necessary for now"
		].! !

!SimpleHierarchicalListMorph methodsFor: 'dropping/grabbing' stamp: 'nk 6/15/2003 11:49'!
acceptDroppingMorph: aMorph event: evt

	self model
		acceptDroppingMorph: aMorph
		event: evt
		inMorph: self.
	self resetPotentialDropMorph.
	evt hand releaseMouseFocus: self.
	Cursor normal show.
! !

!SimpleHierarchicalListMorph methodsFor: 'search' stamp: 'EstebanLorenzano 4/29/2014 17:29'!
secondarySelectionColor
	^ self theme secondarySelectionColor! !

!SimpleHierarchicalListMorph methodsFor: 'selection' stamp: 'RAA 8/31/1999 08:36'!
selection: item
	"Called from outside to request setting a new selection.
	Assumes scroller submorphs is exactly our list.
	Note: MAY NOT work right if list includes repeated items"

	| i |
	item ifNil: [^self selectionIndex: 0].
	i := scroller submorphs findFirst: [:m | m complexContents == item].
	i > 0 ifTrue: [^self selectionIndex: i].
	i := scroller submorphs findFirst: [:m | m withoutListWrapper = item withoutListWrapper].
	self selectionIndex: i! !

!SimpleHierarchicalListMorph methodsFor: 'private' stamp: 'RAA 4/2/1999 15:33'!
insertNewMorphs: morphList

	scroller addAllMorphs: morphList.
	self adjustSubmorphPositions.
	self selection: self getCurrentSelectionItem.
	self setScrollDeltas.
! !

!SimpleHierarchicalListMorph methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 5/16/2013 12:26'!
startDrag: anEvent 
	| aTransferMorph itemMorph passenger |
	self dragEnabled
		ifTrue: [itemMorph := scroller submorphs
						detect: [:any | any highlightedForMouseDown]
						ifNone: []].
	(itemMorph isNil
			or: [anEvent hand hasSubmorphs])
		ifTrue: [^ self].
	itemMorph highlightForMouseDown: false.
	itemMorph ~= self selectedMorph
		ifTrue: [self setSelectedMorph: itemMorph].
	passenger := self model dragPassengerFor: itemMorph inMorph: self.
	passenger
		ifNotNil: [
			aTransferMorph := self model transferFor: passenger from: self.
			aTransferMorph align: aTransferMorph draggedMorph center with: anEvent position.
			aTransferMorph
				dragTransferType: (self model dragTransferTypeForMorph: self).
			anEvent hand grabMorph: aTransferMorph].
	anEvent hand releaseMouseFocus: self! !

!SimpleHierarchicalListMorph methodsFor: 'event handling' stamp: 'ar 3/17/2001 17:27'!
mouseLeaveDragging: anEvent
	(self dropEnabled and:[anEvent hand hasSubmorphs]) ifFalse: ["no d&d"
		^ super mouseLeaveDragging: anEvent].
	self resetPotentialDropMorph.
	anEvent hand releaseMouseFocus: self.
	"above is ugly but necessary for now"
! !

!SimpleHierarchicalListMorph methodsFor: 'events' stamp: ''!
expandAll: aMorph
	| allChildren |
	aMorph toggleExpandedState.
	allChildren := OrderedCollection new: 10.
	aMorph recursiveAddTo: allChildren.
	allChildren do: [:each | 
		(each canExpand and: [each isExpanded not])
			ifTrue: [self expandAll: each]].
! !

!SimpleHierarchicalListMorph methodsFor: 'accessing' stamp: 'RAA 8/1/1998 00:10'!
getList 
	"Answer the list to be displayed."

	^(model perform: (getListSelector ifNil: [^#()])) ifNil: [#()]

! !

!SimpleHierarchicalListMorph methodsFor: 'events' stamp: 'ar 3/17/2001 17:39'!
toggleExpandedState: aMorph event: event
	| oldState |
	"self setSelectedMorph: aMorph."
	event yellowButtonPressed ifTrue: [
		oldState := aMorph isExpanded.
		scroller submorphs copy do: [ :each |
			(each canExpand and: [each isExpanded = oldState]) ifTrue: [
				each toggleExpandedState.
			].
		].
	] ifFalse: [
		aMorph toggleExpandedState.
	].
	self adjustSubmorphPositions.
	! !

!SimpleHierarchicalListMorph methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 5/31/2011 15:24'!
initForKeystrokes
	lastKeystrokeTime := 0.
	lastKeystrokes := ''.
	lastSelection := 0! !

!SimpleHierarchicalListMorph methodsFor: 'accessing' stamp: 'gvc 7/24/2007 12:14'!
selectionColorToUse: aColor
	"Set the colour for selected items."

	aColor = self selectionColorToUse ifTrue: [^self].
	aColor
		ifNil: [self removeProperty: #selectionColorToUse]
		ifNotNil: [self setProperty: #selectionColorToUse toValue: aColor].
	self selectionFrameChanged! !

!SimpleHierarchicalListMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/31/2011 15:47'!
searchedElement: anElement

	searchedElement := anElement.! !

!SimpleHierarchicalListMorph methodsFor: 'accessing' stamp: 'gvc 7/24/2007 12:11'!
selectionFrame
	"Answer the frame of the selected morph in the receiver or nil if none."
	
	^selectedMorph
		ifNotNil: [selectedMorph bounds:  selectedMorph selectionFrame in: self]! !

!SimpleHierarchicalListMorph methodsFor: 'keyboard navigation' stamp: 'ar 10/14/2003 23:39'!
setSelectionIndex: idx
	"Called internally to select the index-th item."
	| theMorph index |
	idx ifNil: [^ self].
	index := idx min: scroller submorphs size max: 0.
	theMorph := index = 0 ifTrue: [nil] ifFalse: [scroller submorphs at: index].
	self setSelectedMorph: theMorph.! !

!SimpleHierarchicalListMorph methodsFor: 'accessing' stamp: 'gvc 5/25/2006 11:41'!
getListSelector
	"Answer for compatibility with PluggableListMorph."
	
	^ getListSelector! !

!SimpleHierarchicalListMorph methodsFor: 'keyboard navigation' stamp: 'ar 10/14/2003 23:39'!
toggleExpandedState: aMorph
	aMorph toggleExpandedState.
	self adjustSubmorphPositions.
! !

!SimpleHierarchicalListMorph methodsFor: 'event handling' stamp: 'CamilloBruni 2/4/2012 14:49'!
mouseDown: evt
	"Changed to take keybaord focus."
	
	| aMorph selectors |
	self wantsKeyboardFocus
		ifTrue: [self takeKeyboardFocus].
	aMorph := self itemFromPoint: evt position.
	(aMorph notNil and:[aMorph inToggleArea: (aMorph point: evt position from: self)])
		ifTrue:[^self toggleExpandedState: aMorph event: evt]. 
	
	evt yellowButtonPressed  "First check for option (menu) click"
		ifTrue: [ 
			(self yellowButtonActivity: evt shiftPressed) 
				ifTrue: [ ^ self ]].
		
	aMorph ifNil:[^super mouseDown: evt].
	aMorph highlightForMouseDown.
	selectors := Array 
		with: #click:
		with: nil
		with: nil
		with: (self dragEnabled ifTrue:[#startDrag:] ifFalse:[nil]).
	evt hand waitForClicksOrDrag: self event: evt selectors: selectors threshold: 10 "pixels".! !

!SimpleHierarchicalListMorph methodsFor: 'accessing' stamp: 'RAA 7/20/1998 12:09'!
sortingSelector: s

	sortingSelector := s! !

!SimpleHierarchicalListMorph methodsFor: 'selection' stamp: 'panda 4/25/2000 18:56'!
selectedMorph
	^selectedMorph! !

!SimpleHierarchicalListMorph methodsFor: 'updating' stamp: 'gvc 5/22/2007 14:50'!
themeChanged
	"Update the selection colour."

	self selectionColor ifNotNil: [
		self selectionColor: self theme selectionColor].
	super themeChanged! !

!SimpleHierarchicalListMorph methodsFor: 'initialization' stamp: 'EstebanLorenzano 5/15/2014 16:35'!
defaultColor
	^ self theme backgroundColor! !

!SimpleHierarchicalListMorph methodsFor: 'events' stamp: 'ar 3/17/2001 17:39'!
expand: aMorph to: level
	| allChildren |
	aMorph toggleExpandedState.
	allChildren := OrderedCollection new: 10.
	aMorph recursiveAddTo: allChildren.
	allChildren do: [:each | 
		((each canExpand
			and: [each isExpanded not])
			and: [level > 0])
			ifTrue: [self expand: each to: level-1]].! !

!SimpleHierarchicalListMorph methodsFor: 'event handling' stamp: 'NicolaiHess 3/11/2014 12:47'!
keyStroke: event 
	"Process potential command keys that are not handled by keymappings yet"
	
	| args aCharacter |
	aCharacter := event keyValue asCharacter. 
	event anyModifierKeyPressed ifFalse: [
		self basicKeyPressed: aCharacter.
		^false].
	(self scrollByKeyboard: event) ifTrue: [^true].
	keystrokeActionSelector isNil ifTrue: [^false].
	(args := keystrokeActionSelector numArgs) = 1 
		ifTrue: [^model perform: keystrokeActionSelector with: aCharacter].
	args = 2 
		ifTrue: 
			[^model 
				perform: keystrokeActionSelector
				with: aCharacter
				with: self].
	^self 
		error: 'The keystrokeActionSelector must be a 1- or 2-keyword symbol'! !

!SimpleHierarchicalListMorph methodsFor: 'private' stamp: 'RAA 7/30/2000 19:15'!
addSubmorphsAfter: parentMorph fromCollection: aCollection allowSorting: sortBoolean

	| priorMorph morphList newCollection |
	priorMorph := nil.
	newCollection := (sortBoolean and: [sortingSelector notNil]) ifTrue: [
		(aCollection asSortedCollection: [ :a :b | 
			(a perform: sortingSelector) <= (b perform: sortingSelector)]) asOrderedCollection
	] ifFalse: [
		aCollection
	].
	morphList := OrderedCollection new.
	newCollection do: [:item | 
		priorMorph := self indentingItemClass basicNew 
			initWithContents: item 
			prior: priorMorph 
			forList: self
			indentLevel: parentMorph indentLevel + 1.
		morphList add: priorMorph.
	].
	scroller addAllMorphs: morphList after: parentMorph.
	^morphList
	
! !

!SimpleHierarchicalListMorph methodsFor: 'selection' stamp: 'nk 4/28/2004 10:26'!
selectionIndex: idx
	"Called internally to select the index-th item."
	| theMorph range index |
	idx ifNil: [^ self].
	index := idx min: scroller submorphs size max: 0.
	(theMorph := index = 0 ifTrue: [nil] ifFalse: [scroller submorphs at: index])
		ifNotNil:
		[((theMorph bounds top - scroller offset y) >= 0
			and: [(theMorph bounds bottom - scroller offset y) <= bounds height]) ifFalse:
			["Scroll into view -- should be elsewhere"
			range := self vTotalScrollRange.
			scrollBar value: (range > 0
				ifTrue: [((index-1 * theMorph height) / self vTotalScrollRange)
									truncateTo: scrollBar scrollDelta]
				ifFalse: [0]).
			scroller offset: -3 @ (range * scrollBar value)]].
	self selectedMorph: theMorph! !

!SimpleHierarchicalListMorph methodsFor: 'obsolete' stamp: 'ar 3/17/2001 17:39'!
mouseLeaveDragging: anEvent onItem: aMorph 
	self removeObsoleteEventHandlers.! !

!SimpleHierarchicalListMorph methodsFor: 'accessing' stamp: 'EstebanLorenzano 4/29/2014 17:05'!
selectionColorToUse
	"Answer the colour to use for selected items."

	^self 
		valueOfProperty: #selectionColorToUse 
		ifAbsent: [ self theme selectionColor ]! !

!SimpleHierarchicalListMorph methodsFor: 'events' stamp: 'dgd 9/26/2004 18:24'!
expandRoots
	"Expand all the receiver's roots"
	self roots
		do: [:each |
			(each canExpand and: [each isExpanded not])
				ifTrue: [each toggleExpandedState]].
	self adjustSubmorphPositions! !

!SimpleHierarchicalListMorph methodsFor: 'selection' stamp: 'RAA 3/31/1999 21:28'!
setSelectedMorph: aMorph

	model 
		perform: (setSelectionSelector ifNil: [^self]) 
		with: aMorph complexContents	"leave last wrapper in place"

 ! !

!SimpleHierarchicalListMorph methodsFor: 'accessing' stamp: 'sps 12/28/2002 02:27'!
lineColor: aColor
	^lineColor := aColor
! !

!SimpleHierarchicalListMorph methodsFor: 'dropping/grabbing' stamp: 'panda 4/25/2000 17:39'!
potentialDropMorph
	^potentialDropMorph! !

!SimpleHierarchicalListMorph methodsFor: 'obsolete' stamp: 'ar 3/17/2001 17:38'!
removeObsoleteEventHandlers
	scroller submorphs do:[:m|
		m eventHandler: nil; highlightForMouseDown: false; resetExtension].! !

!SimpleHierarchicalListMorph methodsFor: 'event handling' stamp: 'ar 9/15/2000 22:58'!
handlesKeyboard: evt
	^true! !

!SimpleHierarchicalListMorph methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 4/26/2012 10:29'!
collapseAll: aMorph
	| allChildren |
	aMorph toggleExpandedState.
	allChildren := OrderedCollection new: 10.
	aMorph recursiveAddTo: allChildren.
	allChildren do: [:each | 
		each isExpanded
			ifTrue: [self collapseAll: each]].
! !

!SimpleHierarchicalListMorph methodsFor: '*Keymapping-Core' stamp: 'StephaneDucasse 6/22/2014 10:22'!
initializeShortcuts: aKMDispatcher

	super initializeShortcuts: aKMDispatcher.
	aKMDispatcher attachCategory: #SimpleHierarchicalList.
	aKMDispatcher attachCategory: #MorphFocusNavigation! !

!SimpleHierarchicalListMorph methodsFor: 'accessing' stamp: 'AlainPlantec 2/11/2011 16:30'!
selectionColor: aColor
	"Set the colour for selected items."

	|w|
	aColor
		ifNil: [self removeProperty: #selectionColor]
		ifNotNil: [self setProperty: #selectionColor toValue: aColor].
	w := self ownerThatIsA: SystemWindow.
	self selectionColorToUse: (
		(self theme settings fadedBackgroundWindows not or: [w isNil or: [w isActive]])
			ifTrue: [aColor]
			ifFalse: [self theme unfocusedSelectionColor])! !

!SimpleHierarchicalListMorph methodsFor: 'search' stamp: 'GabrielOmarCotelli 11/30/2013 16:56'!
basicKeyPressed: aChar
	| nextSelection milliSeconds slowKeyStroke oldSelection list |
	nextSelection := oldSelection := lastSelection.
	milliSeconds := Time millisecondClockValue.
	slowKeyStroke := milliSeconds - lastKeystrokeTime > 500.
	lastKeystrokeTime := milliSeconds.
	self searchedElement: nil.
	slowKeyStroke
		ifTrue: [ 
			"forget previous keystrokes and search in following elements"
			lastKeystrokes := aChar asLowercase asString ]
		ifFalse: [ 
			"append quick keystrokes but don't move selection if it still matches"
			lastKeystrokes := lastKeystrokes , aChar asLowercase asString ].	"Get rid of blanks and style used in some lists"	"No change if model is locked"
	model okToChange
		ifFalse: [ ^ self ].
	list := self allItems.
	list
		detect: [ :a | a searchingString trimBoth asLowercase beginsWith: lastKeystrokes ]
		ifFound: [ :nextSelectionNode | 
			nextSelection := list indexOf: nextSelectionNode ifAbsent: [ 0 ].	"The following line is a workaround around the behaviour of OBColumn>>selection:,
	 which deselects when called twice with the same argument."
			self searchedElement: nextSelectionNode.
			lastSelection := nextSelection.	"change scrollbarvalue"
			^ self vScrollValue: (nextSelection - 1) / list size ]! !

!SimpleHierarchicalListMorph methodsFor: 'accessing' stamp: 'RAA 7/24/1998 22:52'!
columns

	^columns! !

!SimpleHierarchicalListMorph methodsFor: 'obsolete' stamp: 'ar 3/17/2001 17:40'!
mouseEnterDragging: anEvent onItem: aMorph 
	self removeObsoleteEventHandlers.! !

!SimpleHierarchicalListMorph methodsFor: 'initialization' stamp: 'di 5/22/1998 00:32'!
listItemHeight
	"This should be cleaned up.  The list should get spaced by this parameter."
	^ 12! !

!SimpleHierarchicalListMorph methodsFor: 'events-processing' stamp: 'ar 3/17/2001 17:26'!
handleMouseMove: anEvent
	"Reimplemented because we really want #mouseMove when a morph is dragged around"
	anEvent wasHandled ifTrue:[^self]. "not interested"
	(anEvent anyButtonPressed and:[anEvent hand mouseFocus == self]) ifFalse:[^self].
	anEvent wasHandled: true.
	self mouseMove: anEvent.
	(self handlesMouseStillDown: anEvent) ifTrue:[
		"Step at the new location"
		self startStepping: #handleMouseStillDown: 
			at: Time millisecondClockValue
			arguments: {anEvent copy resetHandlerFields}
			stepTime: 1].
! !

!SimpleHierarchicalListMorph methodsFor: 'accessing' stamp: 'gvc 9/11/2006 10:40'!
mouseDownHighlightColor
	"Answer a good color to use for drawing the mouse down highlight.
	Used the line color if not transparent, otherwise a contrasting color in the
	same way as the line color is determined.
	Fall back to black if all my owners are transparent."

	|c colored |
	c := self lineColor.
	c isTransparent ifFalse: [^c].
	colored := self color isTransparent
		ifTrue: [self firstOwnerSuchThat: [:o | o isWorldOrHandMorph not and: [o color isTransparent not]]]
		ifFalse: [self].
	colored ifNil: [^Color black].
	^colored color luminance > 0.5
		ifTrue: [Color black]
		ifFalse: [Color white]
! !

!SimpleHierarchicalListMorph methodsFor: 'actions' stamp: 'gvc 3/28/2007 13:55'!
expandAll
	"Expand all of the roots!!"
	
	self roots do: [:m |
		self expandAll: m].
	self adjustSubmorphPositions! !

!SimpleHierarchicalListMorph methodsFor: 'geometry' stamp: 'dew 11/5/2000 00:15'!
scrollDeltaHeight
	^ scroller firstSubmorph height! !

!SimpleHierarchicalListMorph methodsFor: 'selection' stamp: 'RAA 7/31/1998 00:25'!
maximumSelection

	^ scroller submorphs size
! !

!SimpleHierarchicalListMorph methodsFor: 'events' stamp: 'ar 3/17/2001 17:39'!
expandAll: aMorph except: aBlock
	| allChildren |
	(aBlock value: aMorph complexContents)
		ifFalse: [^self].
	aMorph toggleExpandedState.
	allChildren := OrderedCollection new: 10.
	aMorph recursiveAddTo: allChildren.
	allChildren do: [:each | 
		(each canExpand
			and: [each isExpanded not])
			ifTrue: [self expandAll: each except: aBlock]].! !

!SimpleHierarchicalListMorph methodsFor: 'selection' stamp: 'di 5/22/1998 00:20'!
minimumSelection
	^ 1! !

!SimpleHierarchicalListMorph methodsFor: 'actions' stamp: 'gvc 7/24/2007 12:12'!
adoptPaneColor: paneColor
	"Pass on to the border too."
	
	super adoptPaneColor: paneColor.
	paneColor ifNil: [^self].
	self selectionColor: self selectionColor.
	self borderStyle baseColor: paneColor twiceDarker! !

!SimpleHierarchicalListMorph methodsFor: 'search' stamp: 'BenjaminVanRyseghem 5/31/2011 15:46'!
searchedFrame
	"Answer the frame of the selected morph in the receiver or nil if none."
	
	^searchedElement
		ifNotNil: [:elt | elt bounds: elt selectionFrame in: self]! !

!SimpleHierarchicalListMorph methodsFor: 'accessing' stamp: 'gvc 10/13/2006 11:26'!
selectionColor
	"Answer the colour to use for selected items."

	^self valueOfProperty: #selectionColor ifAbsent: [] ! !

!SimpleHierarchicalListMorph methodsFor: 'dropping/grabbing' stamp: 'mir 5/8/2000 15:37'!
potentialDropMorph: aMorph
	potentialDropMorph := aMorph.
	aMorph highlightForDrop! !

!SimpleHierarchicalListMorph methodsFor: 'event handling' stamp: 'ar 3/17/2001 17:25'!
itemFromPoint: aPoint
	"Return the list element (morph) at the given point or nil if outside"
	| ptY |
	scroller hasSubmorphs ifFalse:[^nil].
	(scroller fullBounds containsPoint: aPoint) ifFalse:[^nil].
	ptY := (scroller firstSubmorph point: aPoint from: self) y.
	"note: following assumes that submorphs are vertical, non-overlapping, and ordered"
	scroller firstSubmorph top > ptY ifTrue:[^nil].
	scroller lastSubmorph bottom < ptY ifTrue:[^nil].
	"now use binary search"
	^scroller 
		findSubmorphBinary:[:item|
			(item top <= ptY and:[item bottom >= ptY])
				ifTrue:[0] "found"
				ifFalse:[ (item top + item bottom // 2) > ptY ifTrue:[-1] ifFalse:[1]]]! !

!SimpleHierarchicalListMorph methodsFor: 'event handling' stamp: 'ar 3/17/2001 17:27'!
handlesMouseOverDragging: evt
	^self dropEnabled! !

!SimpleHierarchicalListMorph methodsFor: 'event handling' stamp: 'gvc 9/12/2006 15:29'!
mouseMove: evt

	|aMorph|
	aMorph := self itemFromPoint: evt position.
	evt hand hasSubmorphs ifFalse: [
		(aMorph isNil or: [aMorph highlightedForMouseDown not])
			ifTrue: [scroller submorphsDo: [:m |
					m highlightedForMouseDown ifTrue: [m highlightForMouseDown: false]].
					aMorph ifNotNil: [aMorph highlightForMouseDown]]].
	(self dropEnabled and:[evt hand hasSubmorphs]) 
		ifFalse:[^super mouseMove: evt].
	potentialDropMorph ifNotNil:[
		(potentialDropMorph containsPoint: (potentialDropMorph point: evt position from: self))
			ifTrue:[^self].
	].
	self mouseLeaveDragging: evt.
	(self containsPoint: evt position) 
		ifTrue:[self mouseEnterDragging: evt].! !

!SimpleHierarchicalListMorph methodsFor: 'selection' stamp: 'RAA 8/1/1998 00:19'!
getCurrentSelectionItem

	^model perform: (getSelectionSelector ifNil: [^nil])
	! !

!SimpleHierarchicalListMorph methodsFor: 'geometry' stamp: 'nk 7/11/2004 20:07'!
extent: newExtent
	bounds extent = newExtent ifTrue: [^ self].
	super extent: newExtent.
	self setScrollDeltas ! !

!SimpleHierarchicalListMorph methodsFor: 'updating' stamp: 'gvc 11/15/2007 14:27'!
update: aSymbol 
	aSymbol == getSelectionSelector 
		ifTrue: 
			[self selection: self getCurrentSelectionItem.
			^self].
	aSymbol == getListSelector 
		ifTrue: 
			[self list: self getList.
			^self].
	((aSymbol isKindOf: Array) 
		and: [aSymbol size > 1 and: [aSymbol first == getListSelector and: [
					aSymbol second == #openPath]]]) "allow directed path opening where multiple trees exist"
			ifTrue: 
				[^(scroller submorphs at: 1 ifAbsent: [^self]) 
					openPath: (aSymbol allButFirst: 2)].
	((aSymbol isKindOf: Array) 
		and: [aSymbol size > 1 and: [aSymbol first == getListSelector and: [
					aSymbol second == #openItemPath]]]) "allow directed path opening where multiple trees exist"
			ifTrue: 
				[^(scroller submorphs at: 1 ifAbsent: [^self]) 
					openItemPath: (aSymbol allButFirst: 2)].
	((aSymbol isKindOf: Array) 
		and: [aSymbol notEmpty and: [aSymbol first == #openPath]]) 
			ifTrue: 
				[^(scroller submorphs at: 1 ifAbsent: [^self]) 
					openPath: aSymbol allButFirst].
	((aSymbol isKindOf: Array) 
		and: [aSymbol size  = 2 and: [aSymbol first = getListSelector and: [
					aSymbol second == #expandRoots]]]) 
			ifTrue: 
				[^self expandRoots].
	((aSymbol isKindOf: Array) 
		and: [aSymbol notEmpty and: [aSymbol first = getListSelector and: [
					aSymbol second == #expandAll]]]) 
			ifTrue: 
				[^self expandAll]! !

!SimpleHierarchicalListMorph methodsFor: 'selection' stamp: 'nice 1/5/2010 15:59'!
selectionOneOf: aListOfItems
	"Set the selection to the first item in the list which is represented by one of my submorphs"

	
	aListOfItems do: [ :item | | index |
		index := scroller submorphs findFirst: [:m | 
			m withoutListWrapper = item withoutListWrapper
		].
		index > 0 ifTrue: [^self selectionIndex: index].
	].
	self selectionIndex: 0.! !

!SimpleHierarchicalListMorph methodsFor: 'initialization' stamp: 'RAA 7/29/2000 22:15'!
indentingItemClass
	
	^IndentingListItemMorph! !

!SimpleHierarchicalListMorph methodsFor: 'keyboard navigation' stamp: 'ar 10/14/2003 23:38'!
getSelectionIndex
	^scroller submorphs indexOf: selectedMorph! !

!SimpleHierarchicalListMorph methodsFor: 'accessing' stamp: 'dgd 9/26/2004 18:23'!
roots
	"Answer the receiver's roots"
	^ scroller submorphs
		select: [:each | each indentLevel isZero]! !

!SimpleHierarchicalListMorph methodsFor: 'obsolete' stamp: 'ar 3/17/2001 17:40'!
mouseDown: event onItem: aMorph
	self removeObsoleteEventHandlers.
! !

!SimpleHierarchicalListMorph methodsFor: 'initialization' stamp: 'ar 3/17/2001 17:39'!
list: aCollection

	| wereExpanded morphList |
	wereExpanded := self currentlyExpanded.
	scroller removeAllMorphs.
	(aCollection isNil or: [aCollection isEmpty]) ifTrue: [^ self selectedMorph: nil].
	morphList := OrderedCollection new.
	self 
		addMorphsTo: morphList
		from: aCollection 
		allowSorting: false
		withExpandedItems: wereExpanded
		atLevel: 0.
	self insertNewMorphs: morphList.! !

!SimpleHierarchicalListMorph methodsFor: 'initialization' stamp: 'RAA 8/1/1998 00:19'!
on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel

	self model: anObject.
	getListSelector := getListSel.
	getSelectionSelector := getSelectionSel.
	setSelectionSelector := setSelectionSel.
	getMenuSelector := getMenuSel.
	keystrokeActionSelector := keyActionSel.
	autoDeselect := true.
	self borderWidth: 1.
	self list: self getList.! !

!SimpleHierarchicalListMorph methodsFor: 'initialization' stamp: 'RAA 3/30/1999 22:29'!
currentlyExpanded

	^(scroller submorphs select: [ :each | each isExpanded]) collect: [ :each |
		each complexContents
	].
	! !

!SimpleHierarchicalListMorph methodsFor: 'geometry' stamp: 'sps 3/9/2004 17:31'!
scrollDeltaWidth
"A guess -- assume that the width of a char is approx 1/2 the height of the font"
	^ self scrollDeltaHeight // 2


! !

!SimpleHierarchicalListMorph class methodsFor: 'instance creation' stamp: 'md 7/13/2005 16:34'!
on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel
	"Create a 'pluggable' list view on the given model parameterized by the given message selectors."

	^ self new
		on: anObject
		list: getListSel
		selected: getSelectionSel
		changeSelected: setSelectionSel
		menu: getMenuSel
		keystroke: keyActionSel
! !

!SimpleHierarchicalListMorph class methodsFor: 'instance creation' stamp: 'md 7/13/2005 16:34'!
on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel
	"Create a 'pluggable' list view on the given model parameterized by the given message selectors."

	^ self new
		on: anObject
		list: getListSel
		selected: getSelectionSel
		changeSelected: setSelectionSel
		menu: nil
		keystroke: #arrowKey:from:		"default"! !

!SimpleHierarchicalListMorph class methodsFor: 'shortcuts' stamp: 'GuillermoPolito 3/19/2013 19:12'!
buildSimpleHierarchicalListShortcuts: aBuilder
	<keymap>
	(aBuilder shortcut: #cursorUp)
		category: #SimpleHierarchicalList
		default: Character arrowUp asKeyCombination
		do: [ :target | target setSelectionIndex: (target getSelectionIndex - 1 max: 1) ].
	(aBuilder shortcut: #cursorDown)
		category: #SimpleHierarchicalList
		default: Character arrowDown asKeyCombination
		do: [ :target | target setSelectionIndex: target getSelectionIndex + 1 ].
	(aBuilder shortcut: #cursorHome)
		category: #SimpleHierarchicalList
		default: Character home asKeyCombination
		do: [ :target | target setSelectionIndex: 1 ].
	(aBuilder shortcut: #cursorEnd)
		category: #SimpleHierarchicalList
		default: Character end asKeyCombination
		do: [ :target | target setSelectionIndex: target scroller submorphs size ].
	(aBuilder shortcut: #cursorPageUp)
		category: #SimpleHierarchicalList
		default: Character pageUp asKeyCombination
		do: [ :target | target setSelectionIndex: (target getSelectionIndex - target numSelectionsInView max: 1) ].
	(aBuilder shortcut: #cursorPageDown)
		category: #SimpleHierarchicalList
		default: Character pageDown asKeyCombination
		do: [ :target | target setSelectionIndex: target getSelectionIndex + target numSelectionsInView ].
	(aBuilder shortcut: #cursorRight)
		category: #SimpleHierarchicalList
		default: Character arrowRight asKeyCombination
		do: [ :target | 
			target selectedMorph
				ifNotNil: [ 
					target selectedMorph canExpand
						ifTrue: [ 
							target selectedMorph isExpanded not
								ifTrue: [ target toggleExpandedState: target selectedMorph ]
								ifFalse: [ target setSelectionIndex: target getSelectionIndex + 1 ] ] ] ].
	(aBuilder shortcut: #cursorLeft)
		category: #SimpleHierarchicalList
		default: Character arrowLeft asKeyCombination
		do: [ :target | 
			| selectedMorph |
			(selectedMorph := target selectedMorph)
				ifNotNil: [ 
					selectedMorph isExpanded
						ifTrue: [ target toggleExpandedState: selectedMorph ]
						ifFalse: [ 
							| i |
							"Search parent."
							selectedMorph indentLevel > 0
								ifTrue: [ 
									i := target getSelectionIndex max: 1.
									[ i > 1 and: [ (target scroller submorphs at: i) indentLevel >= selectedMorph indentLevel ] ]
										whileTrue: [ i := i - 1 max: 1 ].
									target setSelectionIndex: i ] ] ] ]! !

!SimpleHierarchicalListMorph class methodsFor: 'examples' stamp: 'MarcusDenker 7/8/2012 12:10'!
exampleSubmorphs
	"display a hierarchical list of the World plus its submorphs plus its submorphs' submorphs etc."
	"[SimpleHierarchicalListMorph exampleSubmorphs]"
	| morph |
	morph :=
		SimpleHierarchicalListMorph
			on: [ Array with:  (MorphWithSubmorphsWrapper with: World)  ]
			list: #value
			selected: nil
			changeSelected: nil
			menu: nil
			keystroke: nil.

	morph openInWindow! !

!SimpleHierarchicalListMorph class methodsFor: 'instance creation' stamp: 'md 7/13/2005 16:34'!
on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel
	"Create a 'pluggable' list view on the given model parameterized by the given message selectors."

	^ self new
		on: anObject
		list: getListSel
		selected: getSelectionSel
		changeSelected: setSelectionSel
		menu: getMenuSel
		keystroke: #arrowKey:from:		"default"
! !

!SimpleServiceEntry commentStamp: '<historical>'!
I represent a service

provider : the service provider
label : to be display in a menu
selector : to do the service
useLineAfter
stateSelector : a secondary selector (to be able to query state of the provider for example)
description : a description for balloon for example
argumentGetter : a selector to get additional arguments with (if selector requres them)
buttonLabel : a short label

The entire client interface (provided by FileList and other users of the registry)
is this (browse #getArgumentsFrom: and the 
senders of #argumentGetter:):

fullName (returns a String with the full filename)
dirAndFileName (returns {directory. fileName})
readOnlyStream (returns an open read-only stream)
!
!SimpleServiceEntry methodsFor: 'performing service' stamp: 'dgd 9/1/2003 12:13'!
provider: anObject label: aString selector: aSymbol description: anotherString 
	"basic initialization message"
	self
		provider: anObject
		label: aString
		selector: aSymbol.
	stateSelector := #none.
	description := anotherString translated! !

!SimpleServiceEntry methodsFor: 'accessing' stamp: 'sd 1/31/2002 21:09'!
selector
	"normally should not be used directly"

	^selector! !

!SimpleServiceEntry methodsFor: 'accessing' stamp: 'sd 1/31/2002 21:10'!
extraSelector
	"normally should not be used directly"

	^stateSelector! !

!SimpleServiceEntry methodsFor: 'accessing' stamp: 'sd 1/31/2002 21:03'!
description
	"may be used for balloon or other"

	^ description
! !

!SimpleServiceEntry methodsFor: 'accessing' stamp: 'sd 1/31/2002 21:38'!
provider

	^ provider! !

!SimpleServiceEntry methodsFor: 'services menu' stamp: 'StephaneDucasse 10/26/2014 11:17'!
addServiceFor: served toMenu: aMenu
	aMenu 
		add: self label 
		target: self 
		selector: #performServiceFor: 
		argument: served.
	self usingLineAfter ifTrue: [ aMenu addLine ].! !

!SimpleServiceEntry methodsFor: 'accessing' stamp: 'RAA 2/2/2002 08:14'!
argumentGetter: aBlock

	argumentGetter := aBlock! !

!SimpleServiceEntry methodsFor: 'performing service' stamp: 'nk 8/31/2004 19:30'!
performServiceFor: anObject
	"carry out the service I provide"

	^selector numArgs = 0
		ifTrue: [provider perform: selector]
		ifFalse: [
			selector numArgs = 1
				ifTrue: [ provider perform: selector with: (self getArgumentsFrom: anObject) ]
				ifFalse: [ provider perform: selector withArguments: (self getArgumentsFrom: anObject) ]]! !

!SimpleServiceEntry methodsFor: 'services menu' stamp: 'StephaneDucasse 3/5/2010 14:41'!
doNotUseLineAfter

	self usingLineAfter: false! !

!SimpleServiceEntry methodsFor: 'extra' stamp: 'sd 1/31/2002 21:08'!
requestExtraSelector
	"send me this message to ask me to perform secondary service"

	^#performExtraFor:
! !

!SimpleServiceEntry methodsFor: 'accessing' stamp: 'StephaneDucasse 3/5/2010 14:41'!
usingLineAfter: aBoolean

	usingLineAfter := aBoolean! !

!SimpleServiceEntry methodsFor: 'accessing' stamp: 'sd 1/31/2002 21:11'!
extraSelector: aSymbol

	stateSelector := aSymbol! !

!SimpleServiceEntry methodsFor: 'accessing' stamp: 'dgd 9/1/2003 12:12'!
provider: anObject label: aString selector: aSymbol 
	"basic initialization message"
	provider := anObject.
	label := aString translated.
	selector := aSymbol.
	stateSelector := #none.
	description := ''! !

!SimpleServiceEntry methodsFor: 'services menu' stamp: 'StephaneDucasse 3/5/2010 14:42'!
useLineAfter

	self usingLineAfter: true! !

!SimpleServiceEntry methodsFor: 'performing service' stamp: 'RAA 2/2/2002 08:31'!
getArgumentsFrom: aProvider

	argumentGetter ifNil: [^aProvider fullName].
	^argumentGetter value: aProvider! !

!SimpleServiceEntry methodsFor: 'initialization' stamp: 'StephaneDucasse 3/5/2010 14:36'!
initialize
	
	super initialize.
	self useLineAfter! !

!SimpleServiceEntry methodsFor: '*Morphic-Widgets-Basic' stamp: 'jrp 7/30/2005 22:35'!
buttonToTriggerIn: aFileList
	"Answer a button that will trigger the receiver service in a file list"

	| aButton |
	aButton :=  PluggableButtonMorph
					on: self
					getState: nil
					action: #performServiceFor:.
	aButton 
		arguments: { aFileList }.

	aButton
		color: Color transparent;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		label: self buttonLabel;
		askBeforeChanging: true;
		onColor: Color white offColor: Color white.
		aButton setBalloonText: self description.

	^ aButton! !

!SimpleServiceEntry methodsFor: 'accessing' stamp: 'tak 9/25/2008 16:09'!
label
	^label! !

!SimpleServiceEntry methodsFor: 'accessing' stamp: 'sd 1/31/2002 21:03'!
description: aString
	"may be used for balloon or other"

	description := aString
! !

!SimpleServiceEntry methodsFor: 'printing' stamp: 'nk 10/14/2003 10:04'!
printOn: aStream

	aStream nextPutAll: self class name; nextPutAll: ': ('.
	self provider notNil
		ifTrue: [aStream nextPutAll: provider printString].
	aStream nextPutAll: ' --- '. 
	self selector notNil
		ifTrue: [aStream nextPutAll: selector asString].
	aStream nextPut: $)

! !

!SimpleServiceEntry methodsFor: 'extra' stamp: 'nk 6/8/2004 16:42'!
performExtraFor: anObject
	"carry out the extra service I provide"
	"the stateSelector can be used to ask state of the provider to be reflected in button or other"

	^stateSelector numArgs = 0
		ifTrue: [provider perform: stateSelector]
		ifFalse: [provider perform: stateSelector with: (self getArgumentsFrom: anObject) ]
! !

!SimpleServiceEntry methodsFor: 'accessing' stamp: 'StephaneDucasse 3/5/2010 14:40'!
usingLineAfter

	^ usingLineAfter! !

!SimpleServiceEntry methodsFor: 'accessing' stamp: 'sw 2/15/2002 17:53'!
buttonLabel
	"Answer the label to be emblazoned on a button representing the service in a file list, for example"

	^ buttonLabel ifNil: [label]! !

!SimpleServiceEntry methodsFor: 'accessing' stamp: 'dgd 9/1/2003 12:16'!
buttonLabel: aString 
	"Set the receiver's buttonLabel, to be used on a button in a 
	tool-pane; this is split out so that a more abbreviated wording 
	can be deployed if desired"
	buttonLabel := aString translated! !

!SimpleServiceEntry class methodsFor: 'instance creation' stamp: 'sd 1/31/2002 22:05'!
provider: anObject label: aString selector: aSymbol description: anotherString

	^self new provider: anObject label: aString selector: aSymbol description: anotherString! !

!SimpleServiceEntry class methodsFor: 'instance creation' stamp: 'yo 8/22/2008 20:58'!
provider: anObject label: aString selector: aSymbol

	^self provider: anObject label: aString selector: aSymbol description: ''.
! !

!SimpleServiceEntry class methodsFor: 'instance creation' stamp: 'sw 2/17/2002 02:48'!
provider: anObject label: aString selector: aSymbol description: anotherString buttonLabel: aLabel
	"Answer a new service object with the given initializations.  This variant allows a custom button label to be provided, in order to preserve precious horizontal real-estate in the button pane, while still allowing more descriptive wordings in the popup menu"

	^ self new provider: anObject label: aString selector: aSymbol description: anotherString; buttonLabel: aLabel; yourself! !

!SimpleSwitchMorph commentStamp: 'StephaneDucasse 3/9/2012 12:45'!
I represent a switch that can be either on or off.  I chnage my state in response to a mouse click.  When clicked, I also send my actionSelector to my target, just like a SimpleButtonMorph.

	SimpleSwitchMorph new openInWorld!
!SimpleSwitchMorph methodsFor: 'initialization' stamp: 'StephaneDucasse 3/9/2012 12:47'!
initialize

	super initialize.
	self borderWidth: 3.
	self extent: self extent + 2.
	onColor := Color r: 1.0 g: 0.6 b: 0.6.
	offColor := Color lightGray.
	color := offColor
! !

!SimpleSwitchMorph methodsFor: 'switching' stamp: 'StephaneDucasse 3/6/2012 15:08'!
offColor: aColor

	offColor := aColor.
! !

!SimpleSwitchMorph methodsFor: 'event handling' stamp: ''!
mouseUp: evt

	(self containsPoint: evt cursorPoint)
		ifTrue: [  "toggle and do action"
			self setSwitchState: (oldColor = offColor).
			self doButtonAction]
		ifFalse: [  "restore old appearance"
			self setSwitchState: (oldColor = onColor)].
! !

!SimpleSwitchMorph methodsFor: 'switching' stamp: ''!
turnOff
	self borderColor: #raised.
	self color: offColor! !

!SimpleSwitchMorph methodsFor: 'button' stamp: ''!
doButtonAction
	"Perform the action of this button. The last argument of the message sent to the target is the new state of this switch."

	| newState |
	(target notNil and: [actionSelector notNil]) 
		ifTrue: 
			[newState := color = onColor.
			target perform: actionSelector
				withArguments: (arguments copyWith: newState)]! !

!SimpleSwitchMorph methodsFor: 'switching' stamp: ''!
setSwitchState: aBoolean

	aBoolean
		ifTrue: [self turnOn]
		ifFalse: [self turnOff].
! !

!SimpleSwitchMorph methodsFor: 'event handling' stamp: 'StephaneDucasse 3/6/2012 15:08'!
mouseDown: evt

	oldColor := self fillStyle.! !

!SimpleSwitchMorph methodsFor: 'switching' stamp: 'StephaneDucasse 2/9/2015 09:57'!
onColor: aColor

	onColor := aColor.
! !

!SimpleSwitchMorph methodsFor: 'switching' stamp: ''!
turnOn
	self borderColor: #inset.
	self color: onColor! !

!SimpleSwitchMorph methodsFor: 'event handling' stamp: ''!
mouseMove: evt

	(self containsPoint: evt cursorPoint)
		ifTrue: [self setSwitchState: (oldColor = offColor)]
		ifFalse: [self setSwitchState: (oldColor = onColor)].
! !

!SimpleSwitchMorph methodsFor: 'switching' stamp: ''!
isOn
	^ color = onColor! !

!SimpleSwitchMorph methodsFor: 'switching' stamp: ''!
toggleState
	self isOn
		ifTrue: [self turnOff]
		ifFalse: [self turnOn]! !

!SimpleTestResource commentStamp: 'TorstenBergmann 2/12/2014 23:13'!
I'm a simple test ressource for test purposes!
!SimpleTestResource methodsFor: 'running' stamp: 'BaseSystem 8/30/2009 09:40'!
setRun
	hasRun := true! !

!SimpleTestResource methodsFor: 'testing' stamp: 'BaseSystem 8/30/2009 09:40'!
hasRun
	^hasRun! !

!SimpleTestResource methodsFor: 'running' stamp: 'BaseSystem 8/30/2009 09:40'!
startedStateSymbol

	^#started! !

!SimpleTestResource methodsFor: 'testing' stamp: 'BaseSystem 8/30/2009 09:40'!
hasSetup
	^hasSetup! !

!SimpleTestResource methodsFor: 'testing' stamp: ' 17/7/10 17:28'!
isAvailable
	^self class allowAvailability
		and: [self runningState == self startedStateSymbol]! !

!SimpleTestResource methodsFor: 'running' stamp: 'BaseSystem 8/30/2009 09:40'!
tearDown

	self runningState: self stoppedStateSymbol! !

!SimpleTestResource methodsFor: 'running' stamp: 'BaseSystem 8/30/2009 09:40'!
stoppedStateSymbol

	^#stopped! !

!SimpleTestResource methodsFor: 'accessing' stamp: 'BaseSystem 8/30/2009 09:40'!
runningState

	^runningState! !

!SimpleTestResource methodsFor: 'running' stamp: 'BaseSystem 8/30/2009 09:40'!
setUp
	
	self runningState: self startedStateSymbol.
	hasSetup := true! !

!SimpleTestResource methodsFor: 'accessing' stamp: 'BaseSystem 8/30/2009 09:40'!
runningState: aSymbol

	runningState := aSymbol! !

!SimpleTestResource class methodsFor: 'accessing' stamp: 'nfr 1/3/2010 18:13'!
rawCurrentForTest
	^current! !

!SimpleTestResource class methodsFor: 'utility' stamp: ' 17/7/10 17:28'!
preventAvailabilityDuring: aBlock
	"Only setter of preventAvailability."
	
	preventAvailability := false.
	^aBlock ensure: [preventAvailability := nil]! !

!SimpleTestResource class methodsFor: 'accessing' stamp: ' 17/7/10 17:28'!
allowAvailability
	^preventAvailability isNil! !

!SimpleTestResourceA commentStamp: 'TorstenBergmann 2/12/2014 23:13'!
I'm a simple test ressource for test purposes!
!SimpleTestResourceA class methodsFor: 'accessing' stamp: 'nfr 1/3/2010 18:13'!
resources
	^Array with: SimpleTestResourceA1 with: SimpleTestResourceA2! !

!SimpleTestResourceA1 commentStamp: 'TorstenBergmann 2/12/2014 23:13'!
I'm a simple test ressource for test purposes!
!SimpleTestResourceA2 commentStamp: 'TorstenBergmann 2/12/2014 23:13'!
I'm a simple test ressource for test purposes!
!SimpleTestResourceB commentStamp: 'TorstenBergmann 2/12/2014 23:13'!
I'm a simple test ressource for test purposes!
!SimpleTestResourceB class methodsFor: 'accessing' stamp: 'nfr 1/3/2010 18:13'!
resources
	^Array with: SimpleTestResourceA1 with: SimpleTestResourceB1! !

!SimpleTestResourceB1 commentStamp: 'TorstenBergmann 2/12/2014 23:13'!
I'm a simple test ressource for test purposes!
!SimpleTestResourceCircular commentStamp: 'TorstenBergmann 2/12/2014 23:14'!
I'm a simple test ressource for test purposes!
!SimpleTestResourceCircular class methodsFor: 'accessing' stamp: 'nfr 1/3/2010 18:12'!
resources
	^preventAvailability isNil
		ifTrue: [super resources , (Array with: SimpleTestResourceA1)]
		ifFalse:
			[super resources
				, (Array with: SimpleTestResourceA1 with: SimpleTestResourceCircular1)]! !

!SimpleTestResourceCircular1 commentStamp: 'TorstenBergmann 2/12/2014 23:14'!
I'm a simple test ressource for test purposes!
!SimpleTestResourceCircular1 class methodsFor: 'accessing' stamp: 'nfr 1/3/2010 18:12'!
resources
	"Circular prereq:  C wants C1 which wants C."
	
	^Array with: SimpleTestResourceCircular! !

!SimpleTestResourceTestCase commentStamp: 'TorstenBergmann 2/12/2014 23:14'!
SUnit tests for simple test resources!
!SimpleTestResourceTestCase methodsFor: 'running' stamp: 'CamilloBruni 8/24/2012 17:49'!
testRunSuiteWithResource
	| suite |
	suite :=  self classForTestSuite new.
	suite addTest: (SimpleTestResourceTestCase selector: #error).
	suite addTest: (SimpleTestResourceTestCase selector: #fail).
	suite addTest: (self class selector: #dummy).
	self clearOuterResourceStateDuring:
		[self
			assert: suite run printString = '3 run, 1 passes, 0 skipped, 0 expected failures, 1 failures, 1 errors, 0 unexpected passes'
			description: 'A suite of tests needing SimpleTestResource did not run as expected'].! !

!SimpleTestResourceTestCase methodsFor: 'private' stamp: 'BaseSystem 8/30/2009 09:40'!
setRun
	resource setRun! !

!SimpleTestResourceTestCase methodsFor: 'running' stamp: 'nfr 1/3/2010 18:09'!
testDebugTestWithResource
	"The debug will raise an error if the resource is not set up properly."
	
	self clearOuterResourceStateDuring: [(self class selector: #setRun) debug]! !

!SimpleTestResourceTestCase methodsFor: 'not categorized' stamp: 'VincentBlondeau 3/6/2015 17:45'!
testResourceInitRelease
	| suite error failure |
	suite := self classForTestSuite new.
	suite addTest: (error := self class selector: #error).
	suite addTest: (failure := self class selector: #fail).
	suite addTest: (self class selector: #dummy).
	suite run.
	self assert: resource hasSetup! !

!SimpleTestResourceTestCase methodsFor: 'private' stamp: 'BaseSystem 8/30/2009 09:40'!
error
	'foo' odd! !

!SimpleTestResourceTestCase methodsFor: 'running' stamp: 'NiallRoss 7/18/2010 12:28'!
testResourceCollection
	self assert: self class buildSuiteFromSelectors resources size = self resources size
		description: 'The suite should have the same number of resources as its test'.
	self class buildSuiteFromSelectors resources do:
		[:each |
		self assert: (self resources includes: each)
			description: each name , ':  I have this resource but my suite does not'].! !

!SimpleTestResourceTestCase methodsFor: 'running' stamp: 'CamilloBruni 8/24/2012 17:49'!
testRunTestWithResource
	self clearOuterResourceStateDuring:
		[self
			assert: (self class selector: #dummy) run printString =
							'1 run, 1 passes, 0 skipped, 0 expected failures, 0 failures, 0 errors, 0 unexpected passes'
			description: 'A dummy test that needed a resource did not pass']! !

!SimpleTestResourceTestCase methodsFor: 'private' stamp: 'BaseSystem 8/30/2009 09:40'!
dummy
	self assert: resource hasSetup
		description: 'This test uses a resource but it was not set up'.
	self setRun.
	self assert: resource hasRun
		description: 'This test uses a resource but we could not interact with it'.! !

!SimpleTestResourceTestCase methodsFor: 'running' stamp: ' 17/7/10 17:28'!
setUp
	"Ensure that we error, not just fail, if resource is nil so that #should:raise: checks cannot mistake such an error for what they are trapping."
	
	resource := SimpleTestResource rawCurrentForTest.
	self
		deny: resource isNil
		description: 'SimpleTestResource has no current value in test'.
	self
		assert: resource class == SimpleTestResource
		description: 'SimpleTestResource current is not an instance of itself'.
	self
		assert: resource hasSetup
		description: 'This test uses a resource but it was not set up'! !

!SimpleTestResourceTestCase methodsFor: 'utility' stamp: 'NiallRoss 7/18/2010 11:53'!
clearOuterResourceStateDuring: aBlock
	"This self-testing test must clear the outer state of its resources before starting and after finishing, so that it can construct test cases and suites of itself and test them."
	
	self
		assert: SimpleTestResource isAlreadyAvailable
		description: 'The resource was not set up for the test'.
	SimpleTestResource reset.
	self
		deny: SimpleTestResource isAlreadyAvailable
		description: 'The resource was still set up before we began the run'.
	^aBlock
		ensure:
			[self
				deny: SimpleTestResource isAlreadyAvailable
				description: 'The resource was still set up after we finished the run'.
			SimpleTestResource isAvailable.
			self
				assert: SimpleTestResource isAlreadyAvailable
				description: 'The resource was not set up again after the test']! !

!SimpleTestResourceTestCase class methodsFor: 'accessing' stamp: 'BaseSystem 8/30/2009 09:40'!
resources
	^Array with: SimpleTestResource! !

!SimpleTestResourceTestCase class methodsFor: 'history' stamp: 'AdrianLienhard 10/19/2009 10:49'!
lastStoredRun
	^ ((Dictionary new) add: (#passed->((Set new) add: #testResourceInitRelease; add: #testResourcesCollection; yourself)); add: (#timeStamp->'22 November 2008 10:11:35 pm'); add: (#failures->((Set new))); add: (#errors->((Set new))); yourself)! !

!SimpleTextGlyphInfo commentStamp: 'TorstenBergmann 2/12/2014 22:21'!
Simple glyph infos!
!SimpleTextGlyphInfo methodsFor: 'accessing' stamp: 'IgorStasenko 7/13/2011 04:05'!
face
	^ face! !

!SimpleTextGlyphInfo methodsFor: 'initialization' stamp: 'IgorStasenko 10/20/2011 05:09'!
loadFrom: anFT2Face
	"Same as in superclass, but avoid converting coordinates to not waste CPU cycles"
	
	face := anFT2Face.
	self primLoadFrom: anFT2Face.
	format := ((Smalltalk isLittleEndian) ifTrue: [ format reversed ] ifFalse: [ format ]) asString.
! !

!SimpleTextGlyphInfo class methodsFor: 'instance-creation' stamp: 'IgorStasenko 7/13/2011 04:04'!
fromFace: anFT2Face
	^(self new)
		loadFrom: anFT2Face;
		yourself.! !

!SimplestClassListExample commentStamp: 'AlainPlantec 2/18/2010 19:37'!
SimplestClassListExample new openOn: Object!
!SimplestClassListExample methodsFor: 'accessing' stamp: 'AlainPlantec 10/8/2011 18:49'!
selected
	^ selected ifNil: [selected := 1]! !

!SimplestClassListExample methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 10/18/2013 10:46'!
rootItemsTest
	^ (rootClass allSubclasses asArray sort: [:a :b | a name < b name])! !

!SimplestClassListExample methodsFor: 'accessing' stamp: 'AlainPlantec 10/8/2011 18:48'!
selected: x
	selected := x.
	self changed: #selected! !

!SimplestClassListExample methodsFor: 'instance creation' stamp: 'AlainPlantec 10/10/2011 11:55'!
openOn: aClass 
	rootClass := aClass.
	(self defaultTreeMorph buildContents embeddedInMorphicWindowLabeled: 'test') openInWorld
	"(self dialogWindowIn: World title: 'All Object subclasses') openInWorld"
! !

!SimplestClassListExample methodsFor: 'view' stamp: 'AlainPlantec 10/8/2011 14:34'!
defaultTreeMorph
	^ super defaultTreeMorph
		"beCheckList;"
		"autoDeselection: true;"
		multiSelection: true;
		autoMultiSelection: true;
		yourself! !

!SimplestClassListExample methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 10/8/2011 18:48'!
plugOne
	| l |
	rootClass := Object.
	l := PluggableListMorph
		on: self 
		list: #rootItems
		selected: #selected
		changeSelected: #selected:.
	(l embeddedInMorphicWindowLabeled: 'test') openInWorld! !

!SimplestClassListExample methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 10/7/2011 14:10'!
openDialogOn: aClass 
	rootClass := aClass.
	^ self openDialogWindowIn: World title: 'All Object subclasses'
! !

!SimplestClassListExample methodsFor: 'accessing' stamp: 'AlainPlantec 10/10/2011 22:46'!
rootItems
	^ rootClass allSubclasses asArray sort: [:a :b | a name < b name]! !

!SimplestClassListExample methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 10/6/2011 17:24'!
rootItemsOrig
	^ rootClass allSubclasses asArray sort: [:a :b | a name < b name]! !

!SimplestClassListExample class methodsFor: 'examples' stamp: 'TorstenBergmann 9/30/2014 20:13'!
example

	SimplestClassListExample new openOn: Object! !

!SimplestClassListWithChunkExample commentStamp: 'AlainPlantec 1/30/2010 09:16'!
SimplestClassListWithChunkExample new openOn: Object!
!SimplestClassListWithChunkExample methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 10/7/2011 11:31'!
defaultTreeMorph
	^ super defaultTreeMorph chunkSize: 100; yourself! !

!SimplestClassListWithChunkExample class methodsFor: 'examples' stamp: 'TorstenBergmann 9/30/2014 20:14'!
example

	^SimplestClassListWithChunkExample new openOn: Object! !

!SimplestClassListWithPagerExample commentStamp: 'AlainPlantec 1/31/2010 21:13'!
SimplestClassListWithPagerExample new openOn: Object!
!SimplestClassListWithPagerExample methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 10/7/2011 11:47'!
defaultTreeMorph
	^ super defaultTreeMorph pageSize: 100; yourself
! !

!SimplestClassListWithPagerExample class methodsFor: 'examples' stamp: 'TorstenBergmann 9/30/2014 20:15'!
example

	^SimplestClassListWithPagerExample new openOn: Object! !

!SimplestPaginatedClassListExample commentStamp: 'TorstenBergmann 2/3/2014 23:55'!
Example for a paginated class list!
!SimplestPaginatedClassListExample methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 10/10/2011 11:33'!
openDialogOn: aClass 
	rootClass := aClass.
	^ self openDialogWindowIn: World title: 'All Object subclasses'
! !

!SimplestPaginatedClassListExample methodsFor: 'view' stamp: 'AlainPlantec 10/10/2011 11:34'!
defaultTreeMorph
	^ super defaultTreeMorph
		multiSelection: true;
		autoMultiSelection: true;
		yourself! !

!SimplestPaginatedClassListExample methodsFor: 'instance creation' stamp: 'AlainPlantec 10/10/2011 11:33'!
openOn: aClass 
	rootClass := aClass.
	(self dialogWindowIn: World title: 'All Object subclasses') openInWorld
! !

!SimplestPaginatedClassListExample methodsFor: 'accessing' stamp: 'AlainPlantec 10/18/2013 10:47'!
rootItems
	^ self itemsForTest asArray sort: [:a :b | a name < b name]! !

!SimplestPaginatedClassListExample methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 10/10/2011 11:41'!
itemsForTest
	^ rootClass allSubclasses! !

!SimplestPaginatedClassListExample class methodsFor: 'examples' stamp: 'TorstenBergmann 9/30/2014 20:15'!
example

	^SimplestPaginatedClassListExample new openOn: Object! !

!SimplifiedChineseEnvironment commentStamp: '<historical>'!
This class provides the Simplified Chinese support (Used mainly in Mainland China).  Unfortunately, we haven't tested this yet, but as soon as we find somebody who understand the language, probably we can make it work in two days or so, as we have done for Czech support.!
!SimplifiedChineseEnvironment class methodsFor: 'subclass responsibilities' stamp: 'mir 7/1/2004 18:22'!
supportedLanguages
	"Return the languages that this class supports. 
	Any translations for those languages will use this class as their environment."
	
	^#('zh' )! !

!SimplifiedChineseEnvironment class methodsFor: 'class initialization' stamp: 'StephaneDucasse 8/22/2013 14:30'!
initialize

	EncodedCharSet declareEncodedCharSet: self atIndex: 6+1.! !

!SimplifiedChineseEnvironment class methodsFor: 'subclass responsibilities' stamp: 'DrGeoUser 6/21/2012 16:29'!
leadingChar

	^0! !

!SimplifiedChineseEnvironment class methodsFor: 'language methods' stamp: 'yo 3/16/2004 14:55'!
traditionalCharsetClass

	^ GB2312
! !

!SimulateKeystrokesSpecification methodsFor: 'tests' stamp: 'StephaneDucasse 11/2/2012 11:04'!
testSimulateCmdKeystroke

	| ws |
	ws := Workspace open.
	self simulateKeyStrokes: 'var := 3.'.
	self simulateKeyStroke: $s command.
	self assert: ws hasUnacceptedEdits = false.
	ws dependents first delete.! !

!SimulateKeystrokesSpecification methodsFor: 'tests' stamp: 'MartinDias 3/22/2013 16:11'!
testSimulateKeystroke

	| textMorph |
	textMorph := TextMorph new contents: ''; openInWorld.
	self assert: textMorph canChangeText.
	textMorph takeKeyboardFocus.
	self simulateKeyStroke: $s.
	self assert: textMorph contents = 's'.
	textMorph delete.! !

!SimulateKeystrokesSpecification methodsFor: 'tests' stamp: 'MartinDias 3/22/2013 16:16'!
testSimulateKeystrokes

	| textMorph |
	textMorph := TextMorph new contents: ''; openInWorld.
	self assert: textMorph canChangeText.
	textMorph takeKeyboardFocus.
	self simulateKeyStrokes: 'hello'.
	self assert: textMorph contents = 'hello'.
	textMorph delete.! !

!SimulateMouseSpecification methodsFor: 'helpers' stamp: 'SeanDeNigris 12/14/2011 13:57'!
waitForMorphThat: aBlock

	[
		morph := World submorphThat: aBlock ifNone: [ nil ].
		(Delay forMilliseconds: 100) wait.
		morph isNil ] whileTrue.
	^ morph.! !

!SimulateMouseSpecification methodsFor: 'tests' stamp: 'StephaneDucasse 11/2/2012 11:01'!
testSimulateClick
	"self run: #testSimulateClick"

	morph := TextMorph new contents: ''; openInWorld.	
	morph simulateClick.
	self assert: morph hasKeyboardFocus.! !

!SimulateMouseSpecification methodsFor: 'running' stamp: 'SeanDeNigris 12/14/2011 14:05'!
tearDown

	morph delete.! !

!SimulateMouseSpecification methodsFor: 'tests' stamp: 'SeanDeNigris 2/20/2014 08:52'!
testSimulateMiddleClick
	"self run: #testSimulateMiddleClick"
	
	morph := MorphHandlingMiddleButton new openInWorld.
	morph simulateMiddleClick.
	self assert: morph wasClickedWithMiddleButton.
! !

!SimulateMouseSpecification methodsFor: 'tests' stamp: 'StephaneDucasse 11/2/2012 11:02'!
testSimulateRightClick
	"self run: #testSimulateRightClick"
	
	| workspace menu sem before after |
	workspace := Workspace open.
	morph := self waitForMorphThat: [ :its | its model == workspace ].
	menu := self menuOpenedDuring: [ morph simulateRightClick ].
	self assert: menu isNil not.! !

!SimulateMouseSpecification methodsFor: 'helpers' stamp: 'SeanDeNigris 12/9/2011 17:37'!
timeoutAfter: aDuration ifNot: aBlock

	| timer |
	timer := Stopwatch new activate.
	[ timer duration < aDuration and: [ aBlock value not ] ] whileTrue.! !

!SimulateMouseSpecification methodsFor: 'helpers' stamp: 'SeanDeNigris 12/14/2011 14:07'!
menuOpenedDuring: aBlock

	| jailor |
	jailor := MenuCapturingMorph new openInWorld.
	aBlock value.
	^ jailor menu.! !

!SimulationExceptionWrapper commentStamp: 'TorstenBergmann 2/4/2014 21:43'!
Notify about an exception while simulating an execution!
!SimulationExceptionWrapper methodsFor: 'accessing' stamp: 'sig 1/25/2011 18:03'!
exception: anObject

	exception := anObject! !

!SimulationExceptionWrapper methodsFor: 'accessing' stamp: 'sig 1/25/2011 18:03'!
exception

	^ exception! !

!SimulationExceptionWrapper class methodsFor: 'signalling' stamp: 'MarcusDenker 1/26/2011 11:23'!
signalForException: anError

	^ self new
		exception: anError! !

!SingleCodeCriticResultList commentStamp: '<historical>'!
I am a browser for the SmallLint Critics of a rule.!
!SingleCodeCriticResultList methodsFor: 'thread' stamp: 'AlainPlantec 7/9/2013 12:41'!
updateList

	self criticsOf: rule.
	thread ifNotNil: [ thread terminate ].
	thread := [ UIManager default defer:  [ criticsModel updateList ]] fork.! !

!SingleCodeCriticResultList methodsFor: 'api' stamp: 'StephaneDucasse 3/21/2013 09:46'!
resetSelection
	self criticsModel resetSelection! !

!SingleCodeCriticResultList methodsFor: 'private' stamp: 'StephaneDucasse 3/21/2013 09:45'!
defaultColor
	^ Color red! !

!SingleCodeCriticResultList methodsFor: 'menu' stamp: 'SimonAllier 3/27/2013 11:17'!
implementorsOfCritic
	criticsModel selectedItem ifNotNil: [ :item | item browse] 
! !

!SingleCodeCriticResultList methodsFor: 'initialization' stamp: 'GuillermoPolito 8/10/2014 14:04'!
initializeShortcuts
	criticsModel bindKeyCombination: PharoShortcuts current browseShortcut toAction: [ self browseCritic ]! !

!SingleCodeCriticResultList methodsFor: 'private' stamp: 'StephaneDucasse 3/21/2013 09:45'!
toDoColor
	^ Color orange! !

!SingleCodeCriticResultList methodsFor: 'menu' stamp: 'SimonAllier 3/22/2013 15:12'!
addRuleToFalsePositive

	criticsModel selectedItems ifNotNil: [ :criticss |
		criticss do: [ :critic |
			cache addFalsePositiveRule: rule forPackage: critic mcWorkingCopy]].! !

!SingleCodeCriticResultList methodsFor: 'menu' stamp: 'StephaneDucasse 3/21/2013 09:44'!
sendersOfCritic

	| abstractTool |
	abstractTool := AbstractTool new. 	
	criticsModel selectedItem
		ifNotNil: [ :elem | 
			elem isBehavior 
				ifTrue: [ abstractTool browseClassRefsOf: elem ]
				ifFalse: [ abstractTool browseSendersOfMessagesFrom: elem selector ] ] ! !

!SingleCodeCriticResultList methodsFor: 'private' stamp: 'StephaneDucasse 3/21/2013 09:45'!
falsePositiveColor
	^ Color darkGray! !

!SingleCodeCriticResultList methodsFor: 'accessing' stamp: 'SimonAllier 1/23/2013 11:22'!
cache:  acache 
	cache := acache! !

!SingleCodeCriticResultList methodsFor: 'accessing' stamp: 'SimonAllier 3/27/2012 17:18'!
textInputFieldModel
	^ textInputFieldModel! !

!SingleCodeCriticResultList methodsFor: 'initialization' stamp: 'SimonAllier 1/23/2013 11:26'!
initializeDisplayCritic: aCritic forRule: aRule
	
	| criticRepresentation | 
	criticRepresentation := (self formatCritic: aCritic) asMorph.
	^ (cache isFalsePositive: aCritic forRule: aRule) 
			ifTrue: [ criticRepresentation color: self falsePositiveColor ]
			ifFalse: [ (cache isToDo: aCritic forRule: aRule)
						ifTrue: [ criticRepresentation color: self toDoColor ]
						ifFalse: [ criticRepresentation color: self defaultColor ]]! !

!SingleCodeCriticResultList methodsFor: 'initialization' stamp: 'SimonAllier 3/29/2013 10:42'!
whenSelectedItemChangesOnListModel

	criticsModel whenSelectedItemChanged: [ :selection |
		 sourceCodeModel setSelection: (0 to:0). 	
		rule isNil ifFalse: [
			(selection
				ifNil: [ self setTextModelForNil ]
				ifNotNil: [
					toolbarModel critic: selection.
					rule isTransformationRule 
						ifTrue: [ self setTextModelForTransformationRule: selection ]
						ifFalse: [ self setTextModelForClassOrMethod: selection ]]
				)
			]
		]! !

!SingleCodeCriticResultList methodsFor: 'private' stamp: 'SimonAllier 3/22/2013 10:51'!
criticsOf: aRule
	cache ifNil: [^ {}].
	criticsModel items: ((cache criticsOf: aRule)
				sorted: [ :a :b | 
					a name < b name ]).! !

!SingleCodeCriticResultList methodsFor: 'private' stamp: 'StephaneDucasse 3/21/2013 12:46'!
formatCritic: aCritic
	
	^  String streamContents: [:s | aCritic criticNameOn: s ]
! !

!SingleCodeCriticResultList methodsFor: 'initialization' stamp: 'CamilloBruni 9/18/2013 22:50'!
initialize

	super initialize.
	self initializeShortcuts! !

!SingleCodeCriticResultList methodsFor: 'initialization' stamp: 'NicolaiHess 3/6/2015 13:17'!
setTextModelForClassOrMethod: aCritic

	| interval |
	sourceCodeModel aboutToStyle: true.
	sourceCodeModel text: aCritic definition.
	sourceCodeModel behavior: (aCritic isClassOrTrait ifTrue: [ nil ] ifFalse: [aCritic methodClass]).
	interval := self selectionIntervalFor: aCritic definition.
	interval ifNotNil: [ sourceCodeModel setSelection: interval ].
	
	
					! !

!SingleCodeCriticResultList methodsFor: 'initialization' stamp: 'SimonAllier 9/28/2012 13:53'!
initializePresenter

	self whenSelectedItemChangesOnListModel.
	

! !

!SingleCodeCriticResultList methodsFor: 'initialization' stamp: 'SimonAllier 3/27/2013 10:52'!
setTextModelForTransformationRule: selection
	
	| textDiff change |
	rule result.
	change := rule changes detect: [ :ch |
		(ch changeClassName = selection criticTheNonMetaclassClass name) & (ch selector = selection selector)].
	textDiff := (TextDiffBuilder
					from: selection sourceCode
					to:  change source
					inClass: selection methodClass) buildDisplayPatch.
	sourceCodeModel behavior: nil.
	sourceCodeModel text: textDiff.
	sourceCodeModel aboutToStyle: false.

									
					! !

!SingleCodeCriticResultList methodsFor: 'accessing' stamp: 'StephaneDucasse 3/21/2013 09:35'!
textModel
	^ sourceCodeModel! !

!SingleCodeCriticResultList methodsFor: 'menu' stamp: 'StephaneDucasse 3/21/2013 09:35'!
browseCritic

	criticsModel selectedItem
		ifNotNil: [ :elem | 
			elem isBehavior 
				ifTrue: [ elem theNonMetaClass browse ]
				ifFalse: [ elem browse ] ] ! !

!SingleCodeCriticResultList methodsFor: 'initialization' stamp: 'MarcusDenker 5/21/2013 07:42'!
initializeActionToPerformOnTextModel
	
	| selectedItem |
	sourceCodeModel acceptBlock:  [ :text | 	
		selectedItem := criticsModel selectedItem.
		(selectedItem isCompiledMethod and: [ rule isTransformationRule not ])
			ifTrue: [ selectedItem methodClass compile: text ] 
			ifFalse: [ Smalltalk evaluate:  text ]]
	
! !

!SingleCodeCriticResultList methodsFor: 'menu' stamp: 'StephaneDucasse 3/21/2013 09:34'!
addCriticToFalsePositive
	
	criticsModel selectedItems
		ifNotNil: [ :items | items do: [ :item |
			cache addFalsePositive: item forRule: rule ]].
	
	! !

!SingleCodeCriticResultList methodsFor: 'menu' stamp: 'StephaneDucasse 10/22/2014 22:09'!
menu: aMenu shifted: aBoolean
	(rule notNil and: [ criticsModel selectedItems notEmpty ])
		ifTrue: [ 
			self addNavigationMenuItemsTo: aMenu.
			aMenu addLine.
			self addMarkingMenuItemsTo: aMenu.
			rule isTransformationRule ifTrue: [ 
				aMenu
					addLine;
					add: 'Transform selected critic' target: self selector: #transformCritic ] ].
	^ aMenu! !

!SingleCodeCriticResultList methodsFor: 'menu' stamp: 'StephaneDucasse 10/22/2014 22:09'!
addMarkingMenuItemsTo: aMenu
	(criticsModel selectedItems anySatisfy: [ :critic | cache isFalsePositive: critic forRule: rule ]) 
		ifTrue: [ aMenu add: 'Unmark as wrong' target: self selector: #removeCriticToFalsePositive ].
	(criticsModel selectedItems anySatisfy: [ :critic | (cache isFalsePositive: critic forRule: rule) not ]) 
		ifTrue: [ aMenu add: 'Mark as wrong' target: self selector: #addCriticToFalsePositive ].
	(criticsModel selectedItems anySatisfy: [ :critic | cache isToDo: critic forRule: rule ]) 
		ifTrue: [ aMenu add: 'Unmark as TODO' target: self selector: #removeCriticToToDo ].
	(criticsModel selectedItems anySatisfy: [ :critic | (cache isToDo: critic forRule: rule) not ]) 
		ifTrue: [ aMenu add: 'Mark as TODO' target: self selector: #addCriticToToDo ].
	! !

!SingleCodeCriticResultList methodsFor: 'menu' stamp: 'SimonAllier 3/22/2013 15:11'!
removeRuleToFalsePositive

	criticsModel selectedItems ifNotNil: [ :criticss |
		criticss do: [ :critic |
			cache removeFalsePositiveRule: rule forPackage: critic mcWorkingCopy]].! !

!SingleCodeCriticResultList methodsFor: 'menu' stamp: 'StephaneDucasse 3/21/2013 09:43'!
removeCriticToFalsePositive
	
	criticsModel selectedItems
		ifNotNil: [ :items | items do: [ :item |
			cache removeFalsePositive: item forRule: rule ]].
	! !

!SingleCodeCriticResultList methodsFor: 'initialization' stamp: 'StephaneDucasse 3/21/2013 09:38'!
setTextModelForNil

	| text |
	text := rule longDescription isEmpty 
		ifTrue: [ rule name ]
		ifFalse: [ rule longDescription ]. 
	sourceCodeModel aboutToStyle: false.
	sourceCodeModel text: text.
	sourceCodeModel behavior: nil.
	toolbarModel critic: nil 
	
	
					! !

!SingleCodeCriticResultList methodsFor: 'initialization' stamp: 'CamilloBruni 9/18/2013 22:52'!
initializeWidgets
	self instantiateModels: #(
		criticsModel IconListModel
		sourceCodeModel TextModel 
		toolbarModel CriticToolbar
		textInputFieldModel TextInputFieldModel ).

	criticsModel beMultipleSelection.
	self initializeTextInputFieldModel.
	self initializeToolBar.
	self initializeActionToPerformOnTextModel.
	criticsModel displayBlock: [:selec |
		self initializeDisplayCritic: selec forRule: rule]. 
	
	criticsModel menu: [ :a :b | self menu: a shifted: b ].
	criticsModel icons: [ :item | self iconFor: item ].
	
	self focusOrder
		add: criticsModel;
		add: toolbarModel;
		add: sourceCodeModel.
! !

!SingleCodeCriticResultList methodsFor: 'initialization' stamp: 'SimonAllier 1/25/2013 16:25'!
initializeToolBar
	
	self toolbarModel whenFalsePositiveClickedDo: [ self addCriticToFalsePositive ].

! !

!SingleCodeCriticResultList methodsFor: 'menu' stamp: 'StephaneDucasse 10/22/2014 22:09'!
addNavigationMenuItemsTo: aMenu
	aMenu
		add: 'Browse' target: self selector: #browseCritic;
		add: 'Senders' target: self selector: #sendersOfCritic;
		add: 'Implementors' target: self selector: #implementorsOfCritic! !

!SingleCodeCriticResultList methodsFor: 'menu' stamp: 'SimonAllier 3/29/2013 11:09'!
transformCritic
	
	criticsModel selectedItems ifNotNil: [ :items |
		items do: [:critic | rule transform: critic ]  displayingProgress: [:critic|]]! !

!SingleCodeCriticResultList methodsFor: 'initialization' stamp: 'StephaneDucasse 3/21/2013 09:37'!
rule: aRule

	rule := aRule.
	(rule isNil or: [ rule isComposite ]) 
		ifTrue: [ ^ self ].	
	self criticsOf:  aRule.
	toolbarModel rule: rule.! !

!SingleCodeCriticResultList methodsFor: 'initialization' stamp: 'StephaneDucasse 3/21/2013 09:37'!
initializeTextInputFieldModel

	|critics|
	textInputFieldModel 
		autoAccept: true;
		ghostText: 'Search field';
		text: ' ';
		removeEntryCompletion.	
	textInputFieldModel acceptBlock: [ :text | |matchText|
		critics :=cache criticsOf: rule.
		matchText := '*', text, '*'.
		criticsModel items: (text isEmpty 
			ifTrue: [ critics ]
			ifFalse: [ critics select: [ :critic |
				matchText match: (self formatCritic: critic)]]).
		criticsModel updateList ]
! !

!SingleCodeCriticResultList methodsFor: 'accessing' stamp: 'SimonAllier 3/27/2013 11:28'!
rule
	^ rule! !

!SingleCodeCriticResultList methodsFor: 'private' stamp: ''!
selectionIntervalFor: aString
	^ rule result selectionIntervalFor: aString! !

!SingleCodeCriticResultList methodsFor: 'private' stamp: 'SimonAllier 1/23/2013 11:49'!
iconFor: anItem
	
	^  (cache isFalsePositive: anItem forRule: rule) 
			ifFalse: [(cache isToDo: anItem forRule: rule)
				ifTrue: [ self class wrenchOrangeIcon ]
				ifFalse: [ self class exclamationIcon ] ]! !

!SingleCodeCriticResultList methodsFor: 'accessing' stamp: 'StephaneDucasse 3/21/2013 09:35'!
toolbarModel
	^ toolbarModel! !

!SingleCodeCriticResultList methodsFor: 'menu' stamp: 'StephaneDucasse 3/21/2013 09:34'!
addCriticToToDo

	criticsModel selectedItems
		ifNotNil: [ :items | items do: [ :item |
			cache addToDo: item forRule: rule ]].
		
! !

!SingleCodeCriticResultList methodsFor: 'private' stamp: 'SimonAllier 3/21/2013 15:24'!
criticsModelContains: aCritic

	^ criticsModel listItems anySatisfy: [ :each |
			 each name = aCritic name]! !

!SingleCodeCriticResultList methodsFor: 'accessing' stamp: 'StephaneDucasse 3/21/2013 09:35'!
criticsModel
	^ criticsModel! !

!SingleCodeCriticResultList methodsFor: 'menu' stamp: 'StephaneDucasse 3/21/2013 09:44'!
removeCriticToToDo

	criticsModel selectedItems
		ifNotNil: [:items | items do: [ :item |
			cache removeToDo: item forRule: rule ]].
	
	! !

!SingleCodeCriticResultList class methodsFor: 'specs' stamp: 'SimonAllier 9/28/2012 13:53'!
defaultSpec
	<spec>
	
	^ SpecLayout composed
		newColumn: [:c |
			c 
				add: #criticsModel;
				add: #toolbarModel height: 25;
				addSplitter;
				add: #textModel ]! !

!SingleCodeCriticResultList class methodsFor: 'class initialization' stamp: 'StephaneDucasse 11/21/2012 18:11'!
initialize
	
	icons := IdentityDictionary new! !

!SingleCodeCriticResultList class methodsFor: 'icons' stamp: 'StephaneDucasse 11/21/2012 18:13'!
wrenchOrangeIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAHaSURBVDjLlZO7a1NRHMfzfzhI
KQ5OHR1ddRRBLA6lg4iTd5PSas37YR56Y2JiHgg21uoFxSatCVFjbl5iNBBiMmUJgWwZhCB4
pR9/V4QKfSQdDufF5/v7nu85xwJYprV0Oq0kk8luIpEw4vG48f/eVDiVSikCTobDIePxmGg0
yokEBO4OBgNGoxH5fJ5wOHwygVgsZpjVW60WqqqWzbVgMIjf78fn8xlTBcTy736/T7VaJRQK
fQoEArqmafR6Pdxu9/ECkUjkglje63Q6NBoNisUihUKBcrlMpVLB6XR2D4df3VQnmRstsWzU
63WazSZmX6vV0HWdUqmEw+GY2Gw25SC8dV1l1wrZNX5s3qLdbpPL5fB6vXumZalq2O32rtVq
VQ6GuGnCd+HbFnx9AZrC+MkSHo/np8vlmj/M7f4ks6yysyawgB8fwPv70HgKG8v8cp/7fFRO
/+AllewqNJ/DhyBsi9A7J1QTkF4E69mXRws8u6ayvSJwRqoG4K2Md+ygxyF5FdbPaMfdlIXU
ZfiyAUWx/OY25O4JHBP4CtyZ16a9EwuRi1CXs+5K1ew6lB9DXERX517P8tEsPDzfNIP6C5Ye
QewSrJyeCd4P0bnwXYISy3MCn5oZNtsf3pH46e7XBJcAAAAASUVORK5CYII='! !

!SingleCodeCriticResultList class methodsFor: 'icons' stamp: 'StephaneDucasse 11/21/2012 18:11'!
exclamationIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAJPSURBVDjLpZPLS5RhFMYfv9QJ
lelTQZwRb2OKlKuINuHGLlBEBEOLxAu46oL0F0QQFdWizUCrWnjBaDHgThCMoiKkhUONTqmj
mDp2GZ0UnWbmfc/ztrC+GbM2dXbv4ZzfeQ7vefKMMfifyP89IbevNNCYdkN2kawkCZKfSPZT
OGTf6Y/m1uflKlC3LvsNTWArr9BT2LAf+W73dn5jHclIBFZyfYWU3or7T4K7AJmbl/yG7EtX
1BQXNTVCYgtgbAEAYHlqYHlrsTEVQWr63RZFuqsfDAcdQPrGRR/JF5nKGm9xUxMyr0YBAEXX
HgIANq/3ADQobD2J9fAkNiMTMSFb9z8ambMAQER3JC1XttkYGGZXoyZEGyTHRuBuPgBTUu7V
SnUAgAUAWutOV2MjZGkehgYUA6O5A0AlkAyRnotiX3MLlFKduYCqAtuGXpyH0XQmOj+TIURt
51OzURTYZdBKV2UBSsOIcRp/TVTT4ewK6idECAihtUKOArWcjq/B8tQ6UkUR31+OYXP4sTOd
isivrkMyHodWejlXwcC38Fvs8dY5xaIId89VlJy7ACpCNCFCuOp8+BJ6A631gANQSg1mVmOx
xGQYRW2nHMha4B5WA3chsv22T5/B13AIicWZmNZ6cMchTXUe81Okzz54pLi0uQWp+TmkZqMw
xsBV74Or3od4OISPr0e3SHa3PX0f3HXKofNH/UIG9pZ5PeUth+CyS2EMkEqs4fPEOBJLsysk
e48/+xD8oxcAYPzs4QaS7RR2kbLTTOTQieczfzfTv8QPldGvTGoF6/8AAAAASUVORK5CYII='! !

!SingleCodeCriticResultList class methodsFor: 'specs' stamp: ''!
title

	^ 'Critic Browser'! !

!SingleCodeCriticResultList class methodsFor: 'icons' stamp: 'StephaneDucasse 11/21/2012 18:13'!
wrenchOrangeIcon

	^  icons
			at: #'wrenchOrangeIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self  wrenchOrangeIconContents readStream) ].
! !

!SingleCodeCriticResultList class methodsFor: 'icons' stamp: 'StephaneDucasse 11/21/2012 18:11'!
exclamationIcon 

	^  icons
			at: #'exclamationIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self  exclamationIconContents readStream) ].
! !

!SingleTreeTest commentStamp: 'TorstenBergmann 1/31/2014 11:40'!
SUnit tests for a single file system tree (depth one)!
!SingleTreeTest methodsFor: 'running' stamp: 'cwp 11/21/2009 11:30'!
createDirectory: aString 
	filesystem createDirectory: (filesystem pathFromString: aString)! !

!SingleTreeTest methodsFor: 'running' stamp: 'cwp 2/18/2011 16:17'!
createFile: aString 
	filesystem store createFile: (filesystem pathFromString: aString)! !

!SingleTreeTest methodsFor: 'running' stamp: 'EstebanLorenzano 4/2/2012 11:43'!
setUp
	super setUp.
	filesystem := FileSystem memory.
	! !

!SingleTreeTest class methodsFor: 'testing' stamp: 'EstebanLorenzano 4/3/2012 09:42'!
isAbstract
	^ self name = #SingleTreeTest! !

!SizeInMemoryTest commentStamp: 'TorstenBergmann 2/5/2014 08:44'!
SUnit tests for the size of objects in memory!
!SizeInMemoryTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 10/1/2010 12:00'!
testSizeInMemoryLargeInstances
	| amountOfClasses |
	amountOfClasses := Smalltalk allClasses size.
	"Two words for the object header + a world per instance variable"
	self assert: Smalltalk allClasses sizeInMemory = 20.
	
	self assert: Smalltalk allClasses asArray sizeInMemory = ((Smalltalk wordSize * 3) + (Smalltalk allClasses asArray size * Smalltalk wordSize))! !

!SizeInMemoryTest methodsFor: 'tests' stamp: 'GuillermoPolito 6/28/2013 11:01'!
testSizeInMemoryOfByteObjects
	"Byte objects should be padded to words"
	self assert: 'a' sizeInMemory equals: 8.
	self assert: 'abcd' sizeInMemory equals: 8.
	self assert: '' sizeInMemory equals: 4.
	self assert: 'abcde' sizeInMemory equals: 12.
	self assert: 'abcdefghi' sizeInMemory equals: 16.! !

!SizeInMemoryTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 8/2/2011 12:43'!
testSizeInMemoryNormalClasses
	"Two word for the header + one word per instance variable"
	self assert: Date today sizeInMemory = 16.

	"Two word for the header + one word per instance variable"
	self assert: TestCase new sizeInMemory = 16.



! !

!SizeInMemoryTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 10/1/2010 11:29'!
testSizeInMemorySmallIntegers
	self assert: 42 sizeInMemory= 0.
	self assert: -42 sizeInMemory= 0.
	self assert: 0 sizeInMemory= 0.
	self assert: 999999999999999999999 sizeInMemory > 0.

	! !

!SizeInMemoryTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 10/1/2010 11:40'!
testSizeInMemoryCompactClasses
	"One word for the header + one word per instance variable"
	self assert:  (Association key: 'aKey' value: 23) sizeInMemory = 12.

	"One word for the header + one word per instance variable"
	self assert:  Rectangle new sizeInMemory = 12.

! !

!SizeMismatch commentStamp: 'SvenVanCaekenberghe 4/18/2011 14:56'!
I am SizeMismatch, an exception indicating that an operation was attempted
on two or more collections that don't match in size. !
!SizeMismatch methodsFor: 'as yet unclassified' stamp: 'SvenVanCaekenberghe 4/18/2011 15:00'!
standardMessageText
	"Generate a standard textual description"
	
	^ 'Collection sizes to not match'! !

!SizeMismatch methodsFor: 'as yet unclassified' stamp: 'SvenVanCaekenberghe 4/18/2011 14:55'!
messageText
	"Overwritten to initialiaze the message text to a standard text if it has not yet been set"
	
	^ messageText ifNil: [ messageText := self standardMessageText ]! !

!SlReportExtractor commentStamp: 'TommasoDalSasso 3/6/2014 09:55'!
A SlReportExtractor is the abstract class that defines a strategy to extract information from the image and compose a report.
!
!SlReportExtractor methodsFor: 'accessing' stamp: 'TommasoDalSasso 3/6/2014 12:41'!
debugger: anObject
	debugger := anObject! !

!SlReportExtractor methodsFor: 'extraction' stamp: 'TommasoDalSasso 2/24/2015 14:00'!
extractMetadata

	^ {
		#author -> Author fullName.
		#date -> DateAndTime now.
		#version -> self extractVersion.
		#auto -> SlReporter autoSubmit
	} asDictionary! !

!SlReportExtractor methodsFor: 'extraction' stamp: 'TommasoDalSasso 6/10/2014 21:34'!
extract

	^ SlReportMessage new
		metadata: self extractMetadata;
		payload: self extractPayload;
		yourself! !

!SlReportExtractor methodsFor: 'extraction' stamp: 'TommasoDalSasso 3/6/2014 10:17'!
extractPayload

	^ self subclassResponsibility ! !

!SlReportExtractor methodsFor: 'accessing' stamp: 'TommasoDalSasso 3/6/2014 12:41'!
debugger
	^ debugger! !

!SlReportExtractor methodsFor: 'extraction' stamp: 'TommasoDalSasso 6/12/2014 12:25'!
extractVersion

	^ {
		#name -> SystemVersion current version.
		#date -> SystemVersion current date.
		#update -> SystemVersion current highestUpdate
	} asDictionary! !

!SlReportExtractor class methodsFor: 'extraction' stamp: 'TommasoDalSasso 6/11/2014 16:58'!
forDebugger: aDebugger

	^ self basicNew initialize
		debugger: aDebugger;
		yourself! !

!SlReportExtractor class methodsFor: 'extraction' stamp: 'TommasoDalSasso 6/11/2014 16:59'!
extractFrom: aDebugger

	^ (self forDebugger: aDebugger) extract! !

!SlReportMessage commentStamp: 'TommasoDalSasso 2/25/2014 23:50'!
A SlReport is the model of a report generated from an exception.
!
!SlReportMessage methodsFor: 'accessing' stamp: 'TommasoDalSasso 6/12/2014 11:45'!
version
	^ version! !

!SlReportMessage methodsFor: 'accessing' stamp: 'TommasoDalSasso 2/27/2014 00:53'!
date: anObject
	date := anObject! !

!SlReportMessage methodsFor: 'accessing' stamp: 'TommasoDalSasso 2/27/2014 01:02'!
payload: anObject
	payload := anObject! !

!SlReportMessage methodsFor: 'accessing' stamp: 'TommasoDalSasso 4/8/2014 10:45'!
author: anObject
	author := anObject! !

!SlReportMessage methodsFor: 'accessing' stamp: 'TommasoDalSasso 4/8/2014 10:45'!
author
	^ author! !

!SlReportMessage methodsFor: 'accessing' stamp: 'TommasoDalSasso 2/24/2015 14:15'!
auto: anObject
	auto := anObject! !

!SlReportMessage methodsFor: 'accessing' stamp: 'TommasoDalSasso 2/27/2014 00:53'!
date
	^ date! !

!SlReportMessage methodsFor: 'converting' stamp: 'TommasoDalSasso 2/24/2015 14:19'!
metadata

	^ Dictionary new
		at: #date put: date;
		at: #author put: author;
		at: #version put: version;
		at: #auto put: auto;
		yourself! !

!SlReportMessage methodsFor: 'converting' stamp: 'TommasoDalSasso 6/10/2014 14:32'!
metadata: aDictionary

	aDictionary keysAndValuesDo: [ :eachKey :eachValue |
		self perform: (eachKey copyWith: $:) asSymbol with: eachValue ]! !

!SlReportMessage methodsFor: 'accessing' stamp: 'TommasoDalSasso 2/24/2015 14:15'!
auto
	^ auto! !

!SlReportMessage methodsFor: 'converting' stamp: 'TommasoDalSasso 6/10/2014 14:38'!
asDictionary

	^ self metadata
		at: #payload put: payload;
		yourself! !

!SlReportMessage methodsFor: 'accessing' stamp: 'TommasoDalSasso 6/12/2014 11:45'!
version: anObject
	version := anObject! !

!SlReportMessage methodsFor: 'accessing' stamp: 'TommasoDalSasso 2/27/2014 01:02'!
payload
	^ payload! !

!SlReportMessage class methodsFor: 'instance creation' stamp: 'TommasoDalSasso 3/6/2014 10:16'!
withPayload: payload

	^ self basicNew initialize
		date: DateAndTime now;
		payload: payload;
		yourself! !

!SlReportMessage class methodsFor: 'instance creation' stamp: 'TommasoDalSasso 6/10/2014 14:36'!
withMetadata: aDictionary

	^ self basicNew initialize
		metadata: aDictionary;
		yourself! !

!SlReportPreDebugAction commentStamp: 'TommasoDalSasso 10/6/2014 18:42'!
A SlReportPreDebugAction is the debug action to submit a ShoreLine report.
!
!SlReportPreDebugAction methodsFor: 'initialization' stamp: 'TommasoDalSasso 6/11/2014 18:02'!
forDebugger: aDebugger
	super forDebugger: aDebugger.
	
	SlReporter autoSubmit ifTrue: [
		self open.
		self enabled: false ].! !

!SlReportPreDebugAction methodsFor: 'testing' stamp: 'TommasoDalSasso 6/11/2014 18:50'!
autoSubmitWithDebugger: aDebugger

	SlReporter autoSubmit ifTrue: [ self openWithDebugger: aDebugger ].
	^ SlReporter autoSubmit! !

!SlReportPreDebugAction methodsFor: 'accessing' stamp: 'TommasoDalSasso 6/11/2014 18:01'!
enabled
	^ enabled! !

!SlReportPreDebugAction methodsFor: 'testing' stamp: 'TommasoDalSasso 6/11/2014 18:49'!
showWithDebugger: aDebugger

	^ SlReporter enabled & (self autoSubmitWithDebugger: aDebugger) not! !

!SlReportPreDebugAction methodsFor: 'accessing' stamp: 'TommasoDalSasso 6/11/2014 16:17'!
id

	^ #shoreLineDebugAction! !

!SlReportPreDebugAction methodsFor: 'actions' stamp: 'TommasoDalSasso 6/11/2014 18:01'!
executeAction
	
	self open.
	"self preDebugWindow close."! !

!SlReportPreDebugAction methodsFor: 'initialization' stamp: 'TommasoDalSasso 12/2/2014 13:48'!
initialize

	super initialize.
	self enabled: SlReporter enabled.! !

!SlReportPreDebugAction methodsFor: 'testing' stamp: 'TommasoDalSasso 6/11/2014 18:49'!
appliesToDebugger: aDebugger

	^ (self showWithDebugger: aDebugger) & (super appliesToDebugger: aDebugger)! !

!SlReportPreDebugAction methodsFor: 'actions' stamp: 'TommasoDalSasso 6/11/2014 18:48'!
openWithDebugger: aDebugger
	
	SlReportWindow openForDebugger: aDebugger.! !

!SlReportPreDebugAction methodsFor: 'accessing' stamp: 'TommasoDalSasso 6/11/2014 16:14'!
defaultLabel

	^ 'Report'! !

!SlReportPreDebugAction methodsFor: 'accessing' stamp: 'TommasoDalSasso 6/11/2014 16:16'!
defaultOrder

	^ 50! !

!SlReportPreDebugAction methodsFor: 'actions' stamp: 'TommasoDalSasso 6/11/2014 18:48'!
open
	
	self openWithDebugger: self debugger.! !

!SlReportPreDebugAction methodsFor: 'accessing' stamp: 'TommasoDalSasso 6/11/2014 18:01'!
enabled: anObject
	enabled := anObject! !

!SlReportPreDebugAction class methodsFor: 'registration' stamp: 'TommasoDalSasso 10/6/2014 15:03'!
actionType
	<preDebuggingAction>
	"<gtContextCodeDebuggingAction>"! !

!SlReportWindow commentStamp: 'TommasoDalSasso 2/24/2014 11:26'!
A SlReporter is the automatic reporter window.!
!SlReportWindow methodsFor: 'actions' stamp: 'TommasoDalSasso 2/25/2014 11:23'!
close

	self window close! !

!SlReportWindow methodsFor: 'accessing' stamp: 'TommasoDalSasso 2/26/2014 15:23'!
sendButton
	^ sendButton! !

!SlReportWindow methodsFor: 'actions' stamp: 'TommasoDalSasso 12/15/2014 13:41'!
displayReportContents

	stack text: self reportSummary! !

!SlReportWindow methodsFor: 'accessing' stamp: 'TommasoDalSasso 3/6/2014 11:59'!
report

	^ report! !

!SlReportWindow methodsFor: 'accessing' stamp: 'TommasoDalSasso 2/24/2014 16:49'!
cancel
	^ cancel! !

!SlReportWindow methodsFor: 'actions' stamp: 'TommasoDalSasso 2/24/2015 16:14'!
submit

	self reporter serializeAndSend: report.
	self updateSettings.
! !

!SlReportWindow methodsFor: 'accessing' stamp: 'TommasoDalSasso 12/2/2014 14:48'!
granularity: anObject
	granularity := anObject! !

!SlReportWindow methodsFor: 'accessing' stamp: 'TommasoDalSasso 2/24/2014 12:07'!
debugger: anObject
	debugger := anObject! !

!SlReportWindow methodsFor: 'actions' stamp: 'TommasoDalSasso 12/2/2014 17:07'!
updateSettings
	
	autoSubmit state ifTrue: [
		SlReporter
			autoSubmit: true;
			showSummary: false;
			showNotification: false ]! !

!SlReportWindow methodsFor: 'protocol' stamp: 'TommasoDalSasso 2/25/2014 11:04'!
title

	^ 'Report exception'! !

!SlReportWindow methodsFor: 'initialization' stamp: 'TommasoDalSasso 12/15/2014 14:11'!
initializePresenter
	
	sendButton action: [ self submitAndClose ].
	cancel action: [ self close ].
	help action: [ self openHelp ].! !

!SlReportWindow methodsFor: 'accessing' stamp: 'TommasoDalSasso 12/2/2014 14:24'!
autoSubmit
	^ autoSubmit! !

!SlReportWindow methodsFor: 'accessing' stamp: 'TommasoDalSasso 2/24/2014 12:07'!
debugger
	^ debugger! !

!SlReportWindow methodsFor: 'accessing' stamp: 'TommasoDalSasso 2/24/2014 16:49'!
cancel: anObject
	cancel := anObject! !

!SlReportWindow methodsFor: 'accessing' stamp: 'TommasoDalSasso 12/12/2014 15:46'!
help: anObject
	help := anObject! !

!SlReportWindow methodsFor: 'accessing' stamp: 'TommasoDalSasso 3/7/2014 13:07'!
report: aReport

	report := aReport.
	self displayReportContents! !

!SlReportWindow methodsFor: 'accessing' stamp: 'TommasoDalSasso 2/26/2014 15:23'!
sendButton: anObject
	sendButton := anObject! !

!SlReportWindow methodsFor: 'accessing' stamp: 'TommasoDalSasso 12/15/2014 13:50'!
reportSummary

	^ 'Author: {1}
Date: {2}

{3}' format: { report author. report date. (Character cr join: report payload) }.! !

!SlReportWindow methodsFor: 'initialization' stamp: 'TommasoDalSasso 12/15/2014 14:07'!
initializeWidgets

	self instantiateModels: {
		#sendButton -> #ButtonModel.
		#cancel -> #ButtonModel.
		"#granularity -> #DropListModel."
		#autoSubmit -> #CheckBoxModel.
		#help -> #ImageModel.
		#stack -> #TextModel "#SpecDebuggerStack"
	}.
	
	self initializeControls.
	
	"stacktrace := self newList.
	stacktrace items: Smalltalk allClasses."! !

!SlReportWindow methodsFor: 'initialization' stamp: 'TommasoDalSasso 12/2/2014 15:01'!
initializeGranularity

	granularity
		items: {
			#beFullStack -> 'Submit the full stack trace'.
			#beCore -> 'Submit only core classes'.
			#beDisabled -> 'Disable submission' };
		displayBlock: [ :e | e value translated ]! !

!SlReportWindow methodsFor: 'accessing' stamp: 'TommasoDalSasso 12/2/2014 14:24'!
autoSubmit: anObject
	autoSubmit := anObject! !

!SlReportWindow methodsFor: 'initialization' stamp: 'TommasoDalSasso 6/11/2014 17:17'!
generateReport

	self report: (self reporter generateReportForDebugger: self debugger).
	self displayReportContents.! !

!SlReportWindow methodsFor: 'accessing' stamp: 'TommasoDalSasso 2/25/2014 16:00'!
stack: anObject
	stack := anObject! !

!SlReportWindow methodsFor: 'accessing' stamp: 'TommasoDalSasso 6/11/2014 17:11'!
reporter

	^ reporter ifNil: [ reporter := SlReporter default ]! !

!SlReportWindow methodsFor: 'initialization' stamp: 'TommasoDalSasso 12/15/2014 14:11'!
initializeControls

	sendButton label: 'Send' translated.
	cancel label: 'Cancel' translated.

	autoSubmit label: 'Always submit stack traces' translated.
	
	help image: ThemeIcons current helpIcon.
	help help: self class popupText translated.! !

!SlReportWindow methodsFor: 'accessing' stamp: 'TommasoDalSasso 12/2/2014 14:48'!
granularity
	^ granularity! !

!SlReportWindow methodsFor: 'actions' stamp: 'TommasoDalSasso 6/11/2014 14:49'!
open

	SlReporter showSummary
		ifTrue: [ self openWithSpec ]
		ifFalse: [ self submit ]! !

!SlReportWindow methodsFor: 'accessing' stamp: 'TommasoDalSasso 12/12/2014 15:46'!
help
	^ help! !

!SlReportWindow methodsFor: 'actions' stamp: 'TommasoDalSasso 2/24/2015 13:53'!
openHelp

	UIManager default
		longMessage: self class helpText translated
		title: self class popupText translated! !

!SlReportWindow methodsFor: 'actions' stamp: 'TommasoDalSasso 6/11/2014 15:21'!
submitAndClose

	self submit.	
	self close.! !

!SlReportWindow methodsFor: 'accessing' stamp: 'TommasoDalSasso 2/25/2014 16:00'!
stack
	^ stack! !

!SlReportWindow class methodsFor: 'specs' stamp: 'TommasoDalSasso 12/15/2014 13:49'!
defaultSpec
	<spec>

	^ SpecLayout composed
		newColumn: [ :column |
		column
			newRow: [ :row | row
				add: #sendButton;
				add: #cancel ] height: 26;
			newRow: [ :row | row
				"add: #granularity;"
				add: #autoSubmit;
				add: #help width: 16 ] height: 20;
			newRow: #(stack) ]! !

!SlReportWindow class methodsFor: 'instance creation' stamp: 'TommasoDalSasso 6/11/2014 16:58'!
forDebugger: aDebugger

	^ self basicNew initialize
		debugger: aDebugger;
		generateReport;
		yourself! !

!SlReportWindow class methodsFor: 'instance creation' stamp: 'TommasoDalSasso 6/11/2014 16:59'!
openForDebugger: aDebugger

	^ (self forDebugger: aDebugger)
		open;
		yourself! !

!SlReportWindow class methodsFor: 'text' stamp: 'TommasoDalSasso 12/13/2014 03:27'!
popupText

	^ 'Details about data collection'! !

!SlReportWindow class methodsFor: 'text' stamp: 'TommasoDalSasso 12/13/2014 03:52'!
helpText

	^ 'ShoreLine Reporter will send a report of the current exception to the ShoreLine server.
	
The report contains the wollowing information:
- the author name
- a timestamp of the exception
- the version of the current image
- the stack trace of the exception.

The stack trace is a list of method calls in the format ClassName>>methodName. No method parameter or personal data is collected.

You can see the full report in the report summary window.'! !

!SlReporter commentStamp: 'TommasoDalSasso 2/26/2014 15:16'!
A SlReportSender serializes and send a report generated by an exception to the server.
!
!SlReporter methodsFor: 'notification' stamp: 'TommasoDalSasso 6/19/2014 16:01'!
notifyFailure: aString

	self inform: 'A problem has occurred while sending the report: ', aString! !

!SlReporter methodsFor: 'actions' stamp: 'TommasoDalSasso 2/24/2015 16:08'!
serialize: aReport

	^ FLSerializer serializeToByteArray: aReport asDictionary! !

!SlReporter methodsFor: 'accessing' stamp: 'TommasoDalSasso 2/26/2014 23:52'!
path: anObject
	path := anObject! !

!SlReporter methodsFor: 'accessing' stamp: 'TommasoDalSasso 6/11/2014 17:16'!
extractor

	^ extractor ifNil: [ extractor := self class defaultExtractor ]! !

!SlReporter methodsFor: 'notification' stamp: 'TommasoDalSasso 6/19/2014 17:29'!
notifyResponse: response

	SlReporter showNotification ifTrue: [
		response isSuccess
			ifTrue: [ self notifySuccess: response contents ]
			ifFalse: [ self notifyFailure: response contents ] ]! !

!SlReporter methodsFor: 'notification' stamp: 'TommasoDalSasso 6/19/2014 16:01'!
notifySuccess: aString

	self inform: 'Report sent'! !

!SlReporter methodsFor: 'actions' stamp: 'TommasoDalSasso 6/11/2014 17:14'!
generateReportForDebugger: aDebugger

	^ self extractor extractFrom: aDebugger! !

!SlReporter methodsFor: 'accessing' stamp: 'TommasoDalSasso 6/11/2014 13:33'!
url

	^ '{host}:{port}/{path}' format: {
		#host -> self class host.
		#port -> self class port asString.
		#path -> self path } asDictionary! !

!SlReporter methodsFor: 'actions' stamp: 'TommasoDalSasso 2/24/2015 16:14'!
serializeAndSend: aReport

	"asyncronous upload to avoid UI hangups"
	[ self send: (self serialize: aReport) ] fork! !

!SlReporter methodsFor: 'accessing' stamp: 'TommasoDalSasso 2/26/2014 23:52'!
path
	^ path! !

!SlReporter methodsFor: 'actions' stamp: 'TommasoDalSasso 6/19/2014 17:34'!
send: data

	^ [ self notifyResponse: (ZnEasy post: self url data:
				(ZnEntity with: data type: self class mimeType)) ]
			on: NetworkError
			do: [ :error |
				(error isKindOf: ConnectionTimedOut)
					ifTrue: [ self notifyFailure: 'server seems to be offline' ]
					ifFalse: [ self notifyFailure: 'no connection available' ] ]! !

!SlReporter class methodsFor: 'accessing' stamp: 'TommasoDalSasso 2/24/2015 15:54'!
mimeType

	^ ZnMimeType main: 'application' sub: 'x-fuel'! !

!SlReporter class methodsFor: 'configuration' stamp: 'TommasoDalSasso 9/22/2014 11:35'!
defaultHost

	^ 'http://shoreline.inf.usi.ch'! !

!SlReporter class methodsFor: 'settings' stamp: 'TommasoDalSasso 6/11/2014 13:26'!
enabled

	^ enabled ifNil: [ enabled := true ]! !

!SlReporter class methodsFor: 'settings' stamp: 'TommasoDalSasso 6/11/2014 13:32'!
port: aString

	port := aString! !

!SlReporter class methodsFor: 'settings' stamp: 'TommasoDalSasso 12/2/2014 17:07'!
showNotification

	^ showNotification ifNil: [ showNotification := true ]! !

!SlReporter class methodsFor: 'settings' stamp: 'TommasoDalSasso 6/11/2014 13:28'!
autoSubmit: aBoolean

	autoSubmit := aBoolean! !

!SlReporter class methodsFor: 'instance creation' stamp: 'TommasoDalSasso 6/11/2014 14:32'!
default

	^ self basicNew initialize
		path: self defaultPath;
		yourself! !

!SlReporter class methodsFor: 'settings' stamp: 'TommasoDalSasso 6/11/2014 13:28'!
showSummary: aBoolean

	showSummary := aBoolean! !

!SlReporter class methodsFor: 'settings' stamp: 'TommasoDalSasso 6/11/2014 13:34'!
port

	^ port ifNil: [ port := self defaultPort ]! !

!SlReporter class methodsFor: 'settings' stamp: 'TommasoDalSasso 6/11/2014 13:25'!
autoSubmit

	^ autoSubmit ifNil: [ autoSubmit := false ]! !

!SlReporter class methodsFor: 'configuration' stamp: 'TommasoDalSasso 12/2/2014 16:47'!
defaultPath

	^ 'api/stacktraces'! !

!SlReporter class methodsFor: 'settings' stamp: 'TommasoDalSasso 6/11/2014 13:28'!
showNotification: aBoolean

	showNotification := aBoolean! !

!SlReporter class methodsFor: 'settings' stamp: 'TommasoDalSasso 6/11/2014 13:25'!
showSummary

	^ showSummary ifNil: [ showSummary := true ]! !

!SlReporter class methodsFor: 'settings' stamp: 'TommasoDalSasso 6/11/2014 13:31'!
host: aString

	host := aString! !

!SlReporter class methodsFor: 'settings' stamp: 'TommasoDalSasso 6/11/2014 13:28'!
enabled: aBoolean

	enabled := aBoolean! !

!SlReporter class methodsFor: 'settings' stamp: 'TommasoDalSasso 6/11/2014 13:34'!
host

	^ host ifNil: [ host := self defaultHost ]! !

!SlReporter class methodsFor: 'configuration' stamp: 'TommasoDalSasso 9/22/2014 11:35'!
defaultPort

	^ 80! !

!SlReporter class methodsFor: 'configuration' stamp: 'TommasoDalSasso 12/2/2014 16:47'!
defaultExtractor

	^ SlStackTraceReportExtractor! !

!SlStackTraceReportExtractor commentStamp: 'TommasoDalSasso 6/4/2014 10:38'!
A SlStackTraceReportExtractor extracts the stacktrace from the exception context.!
!SlStackTraceReportExtractor methodsFor: 'extraction' stamp: 'TommasoDalSasso 6/4/2014 13:26'!
extractPayload

	^ debugger session stack collect: [ :e | e asString ]! !

!Slice commentStamp: '<historical>'!
I am a Slice representation. I am used only for double disptaching the way to submit me!
!Slice methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/26/2013 20:29'!
commitOn: aSubmitter

	aSubmitter commitSlice: self! !

!Slider methodsFor: 'geometry' stamp: 'ar 12/18/2001 21:19'!
sliderThickness
	^ 7! !

!Slider methodsFor: 'initialization' stamp: 'dgd 2/14/2003 22:30'!
defaultColor
	"answer the default color/fill style for the receiver"
	^ Color lightGray! !

!Slider methodsFor: 'other events' stamp: 'sd 11/8/2003 16:02'!
mouseUpInSlider: event 

	slider borderStyle style == #inset
		ifTrue: [slider borderColor: #raised].
	
	sliderShadow hide! !

!Slider methodsFor: 'geometry' stamp: ''!
sliderExtent
	^ bounds isWide
		ifTrue: [self sliderThickness @ self innerBounds height]
		ifFalse: [self innerBounds width @ self sliderThickness]! !

!Slider methodsFor: 'geometry' stamp: 'sw 3/10/2000 13:44'!
computeSlider
	| r |
	r := self roomToMove.
	self descending
		ifFalse:
			[slider position: (bounds isWide
				ifTrue: [r topLeft + ((r width * value) asInteger @ 0)]
				ifFalse: [r topLeft + (0 @ (r height * value)  asInteger)])]
		ifTrue:
			[slider position: (bounds isWide
				ifTrue:	[r bottomRight - ((r width * value) asInteger @ 0)]
				ifFalse:	[r bottomRight - ((0 @ (r height * value) asInteger))])].
	slider extent: self sliderExtent! !

!Slider methodsFor: 'access' stamp: 'MarcusDenker 7/20/2014 13:13'!
setValueSelector: aSymbol
	"Directly set the selector to make more flexible."
	
	setValueSelector := aSymbol! !

!Slider methodsFor: 'update' stamp: 'CamilloBruni 2/19/2014 20:35'!
updateSliderBounds
	slider bounds: self totalSliderArea.
	sliderShadow bounds: self totalSliderArea.
	
	self computeSlider.
! !

!Slider methodsFor: 'geometry' stamp: ''!
roomToMove
	^ self totalSliderArea insetBy: (0@0 extent: self sliderExtent)! !

!Slider methodsFor: 'initialization' stamp: 'dgd 3/7/2003 15:07'!
defaultBounds
"answer the default bounds for the receiver"
	^ 0 @ 0 corner: 16 @ 100! !

!Slider methodsFor: 'initialization' stamp: 'StephaneDucasse 3/5/2010 14:46'!
initialize
	"initialize the state of the receiver"
	
	super initialize.
	value := 0.0.
	descending := false.
	self initializeSlider! !

!Slider methodsFor: 'model access' stamp: ''!
value: newValue
	"Drive the slider position externally..."
	value := newValue min: 1.0 max: 0.0.
	self computeSlider! !

!Slider methodsFor: 'access' stamp: 'dew 1/21/2002 01:31'!
thumbColor
	"Color of the draggable 'thumb'"
	^ self sliderColor! !

!Slider methodsFor: 'access' stamp: ''!
value
	^ value! !

!Slider methodsFor: 'scrolling' stamp: 'sw 3/10/2000 13:37'!
scrollAbsolute: event
	| r p |
	r := self roomToMove.
	bounds isWide
		ifTrue: [r width = 0 ifTrue: [^ self]]
		ifFalse: [r height = 0 ifTrue: [^ self]].
	p := event targetPoint adhereTo: r.
	self descending
		ifFalse:
			[self setValue: (bounds isWide 
				ifTrue: [(p x - r left) asFloat / r width]
				ifFalse: [(p y - r top) asFloat / r height])]
		ifTrue:
			[self setValue: (bounds isWide
				ifTrue: [(r right - p x) asFloat / r width]
				ifFalse:	[(r bottom - p y) asFloat / r height])]! !

!Slider methodsFor: 'other events' stamp: 'sd 11/8/2003 16:02'!
mouseDownInSlider: event 

	slider borderStyle style == #raised
		ifTrue: [slider borderColor: #inset].
	
	sliderShadow color: self sliderShadowColor.
	sliderShadow cornerStyle: slider cornerStyle.
	sliderShadow bounds: slider bounds.
	sliderShadow show! !

!Slider methodsFor: 'access' stamp: 'dew 2/15/1999 18:24'!
pagingArea
	^self! !

!Slider methodsFor: 'initialization' stamp: 'dgd 2/14/2003 22:39'!
defaultBorderWidth
	"answer the default border width for the receiver"
	^ 1! !

!Slider methodsFor: 'geometry' stamp: 'dew 2/21/1999 03:08'!
extent: newExtent
	newExtent = bounds extent ifTrue: [^ self].
	bounds isWide
		ifTrue: [super extent: (newExtent x max: self sliderThickness * 2) @ newExtent y]
		ifFalse: [super extent: newExtent x @ (newExtent y max: self sliderThickness * 2)].
	self removeAllMorphs; initializeSlider! !

!Slider methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 7/31/2012 18:27'!
setSlider: aMorph withShadow: anotherMorph
	

	slider ifNotNil: [ self removeMorph: slider ].
	sliderShadow ifNotNil: [ self pagingArea removeMorph: sliderShadow ].

	slider := aMorph.
	sliderShadow := anotherMorph.
	slider on: #mouseMove send: #scrollAbsolute: to: self.
	slider on: #mouseDown send: #mouseDownInSlider: to: self.
	slider on: #mouseUp send: #mouseUpInSlider: to: self.

	"(the shadow must have the pagingArea as its owner to highlight properly)"
	self pagingArea addMorph: sliderShadow.
	sliderShadow hide.
	self addMorph: slider.
	self computeSlider.! !

!Slider methodsFor: 'access' stamp: 'dew 3/23/2002 01:38'!
sliderColor
	"color scheme for the whole slider widget"
	sliderColor ifNil: [^ (color alphaMixed: 0.7 with: Color white) slightlyLighter].
	^ sliderColor! !

!Slider methodsFor: 'access' stamp: 'sw 3/12/2000 11:57'!
descending: aBoolean
	descending := aBoolean.
	self value: value! !

!Slider methodsFor: 'access' stamp: 'StephaneDucasse 3/5/2010 14:45'!
descending
	"It may happen that an instance variable is nil, for example, if an instance is in the image when the instance is introduced. This test should probably be removed."
	^ descending == true! !

!Slider methodsFor: 'initialization' stamp: 'dgd 2/14/2003 22:35'!
defaultBorderColor
	"answer the default border color/fill style for the receiver"
	^ #inset! !

!Slider methodsFor: 'geometry' stamp: ''!
totalSliderArea
	^ self innerBounds! !

!Slider methodsFor: 'access' stamp: 'dew 3/4/2002 00:50'!
sliderShadowColor
	^ self sliderColor alphaMixed: 0.2 with: self pagingArea color! !

!Slider methodsFor: 'initialization' stamp: 'MarcusDenker 10/26/2011 15:12'!
initializeSlider
	slider := BorderedMorph newBounds: self totalSliderArea color: self thumbColor.
	sliderShadow := BorderedMorph newBounds: self totalSliderArea
						color: self pagingArea color.
	slider on: #mouseMove send: #scrollAbsolute: to: self.
	slider on: #mouseDown send: #mouseDownInSlider: to: self.
	slider on: #mouseUp send: #mouseUpInSlider: to: self.
	slider 
		borderWidth: 1;
		borderColor: Color lightGray.

	sliderShadow 
		borderWidth: 1;
		borderColor: #inset.
	"(the shadow must have the pagingArea as its owner to highlight properly)"
	self pagingArea addMorph: sliderShadow.
	sliderShadow hide.
	self addMorph: slider.
	self computeSlider.
! !

!Slider methodsFor: 'model access' stamp: 'MarcusDenker 7/20/2014 14:04'!
setValue: newValue
	"Called internally for propagation to model"
	self value: newValue.
	setValueSelector ifNotNil: [
		^model perform: setValueSelector with: value
		].! !

!Slider methodsFor: 'access' stamp: 'sw 3/7/2000 15:39'!
sliderColor: newColor

	sliderColor := newColor.
	slider ifNotNil: [slider color: sliderColor]! !

!SliderModel commentStamp: '<historical>'!
A SliderModel is a spec model for a slider.

See example:
	self example!
!SliderModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:36'!
whenAbsoluteValueChangedDo: aBlock
	"Block performed when the absolute value changed"

	absoluteValue whenChangedDo: aBlock! !

!SliderModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:12'!
absoluteValue
	"<api: #inspect>"
	"Return the position of the slider in a scale between 0 and 1 despite of the min and max value"
	^ absoluteValue value! !

!SliderModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:02'!
max
	"<api: #inspect>"
	"Return the maximun value"
	
	^ max value! !

!SliderModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:36'!
whenMaxChangedDo: aBlock 
	"Block performed when the maximum value changed"

	max whenChangedDo: aBlock! !

!SliderModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:53'!
min: anObject
	"<api: #integer min: 0 max: 99 getter:#min registration: #whenMinChanged:>"
	"Set the minimum value"
	
	min value: anObject! !

!SliderModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:05'!
reset
	"<api:#do>"
	"Reset the cursor to the minimum value"
	
	self value: self min! !

!SliderModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:11'!
min
	"<api: #inspect>"
	"Return the minimum value"
	
	^ min value! !

!SliderModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:52'!
max: anObject
	"<api: #integer min: 1 max: 100 getter:#max registration: #whenMaxChanged:>"
	"Set the maximun value"

	max value: anObject! !

!SliderModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 7/18/2013 14:28'!
color: aColor

	"Hack because during the interpretation, the state is slightly inconistent"
	self widget ifNotNil: [:w | w == self ifFalse: [ super color: aColor ]]! !

!SliderModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:36'!
whenLabelChangedDo: aBlock
	"Block performed when the label changed"

	labelHolder whenChangedDo: aBlock! !

!SliderModel methodsFor: 'initialization' stamp: 'StephaneDucasse 2/27/2015 21:54'!
initialize

	super initialize.
	max := 100 asValueHolder.
	min := 0 asValueHolder.
	quantum := 1 asValueHolder.
	value := 0 asValueHolder.
	absoluteValue := 0 asValueHolder.
	labelHolder := '' asValueHolder.
	isChanging := false.
	
	max whenChangedDo: [:m | self changed: { #max: . m } ].
	min whenChangedDo: [:m | self changed: { #min: . m } ].
	quantum whenChangedDo: [:m | self changed: { #quantum: . m } ].
	
	value whenChangedDo: [:v |
		isChanging ifFalse: [
			isChanging := true.
			self absoluteValue: ((v-self min)/(self max-self min)).
			self changed: { #scaledValue: . v }.
			isChanging := false ].
		self changed: #value.].
	
	absoluteValue whenChangedDo: [:v | 
		isChanging ifFalse: [
			isChanging := true.
			self value: (self min+(v*(self max-self min)) roundTo: self quantum).
			self changed: { #value: . v }.
			isChanging := false ]].
	
	labelHolder whenChangedDo: [:v | self changed: #label ].! !

!SliderModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:05'!
value
	"<api: #inspect>"
	"Return the current value in a range between min and max"

	^ value value! !

!SliderModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:53'!
value: aNumber
	"<api: #integer min: #min max: #max getter:#value registration: #whenValueChanged:>"
	"Set the value in a range between min and max"
	
	value value == aNumber ifTrue: [ ^ self ].
	value value: aNumber.! !

!SliderModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:17'!
label
	"<api: #inspect>"
	"Return the label of the slider"

	^ labelHolder value! !

!SliderModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:16'!
quantum
	"<api: #inspect>"
	"Return the quantum betwen values"

	^ quantum value! !

!SliderModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:36'!
whenQuantumChangedDo: aBlock 
	"Block performed when the quantum value changed"

	quantum whenChangedDo: aBlock! !

!SliderModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:52'!
quantum: aNumber
	"<api: #integer min: #min max: #max getter:#quantum registration: #whenQuantumChanged:>"
	"Set the quantum betwen values"

	quantum value: aNumber! !

!SliderModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:22'!
label: aString
	"<api: #string getter: #label registration: #whenLabelChanged:>"
	"Set the label of the slider"
	
	labelHolder value: aString! !

!SliderModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:37'!
whenValueChangedDo: aBlock 
	"Block performed when the value changed"

	value whenChangedDo: aBlock! !

!SliderModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:53'!
absoluteValue: aFloat
	"<api: #float min: 0 max: 1 getter:#absoluteValue registration: #whenAbsoluteValueChanged:>"
	"Set the position of the slider in a scale between 0 and 1 despite of the min and max value"

	absoluteValue value: aFloat! !

!SliderModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:36'!
whenMinChangedDo: aBlock 
	"Block performed when the minimum value changed"

	min whenChangedDo: aBlock! !

!SliderModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/1/2013 13:39'!
defaultSpec
	<spec: #default>
	
	^ #(SliderAdapter
		adapt: #(model))! !

!SliderModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 5/14/2013 15:38'!
example
	| slider |
	
	slider := self new.
	slider 
		min: 0;
		max: 100;
		whenValueChangedDo: [:value | slider label: value asString ].
		
	slider openWithSpec
	! !

!SliderModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/13/2014 15:24'!
adapterName

	^ #SliderAdapter! !

!Slot commentStamp: 'JurajKubelka 3/4/2015 20:09'!
I'm a meta-object for accessing a slot in an Object. 

I define a protocol to read (#read:) and to write (#write:to:) values. 

For customizing a subclass can override the meta-object-protocol methods. See subclasses for examples.

Vocabulary:
- variable: named accessor for a Slot
- Slot: class-side meta-object, mapping of names to values using a MOP to fields
- field: space occupied in an object, used to hold values accessed via Slots!
!Slot methodsFor: 'private' stamp: 'MarcusDenker 2/7/2015 09:36'!
ensureSlotIniatializationFor: aClass
	self ensureInitalizeMethodExists: aClass. 
	self addSlotInitToInitialize: aClass.! !

!Slot methodsFor: 'code generation' stamp: 'MarcusDenker 6/27/2014 09:41'!
emitStore: aMethodBuilder
	aMethodBuilder
		pushLiteral: self;
		pushReceiver;
		send: #writeToSlot:of:  
		! !

!Slot methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 1/22/2015 21:40'!
phlowValue: anObject
	
	^ anObject! !

!Slot methodsFor: 'class building' stamp: 'MarcusDenker 2/7/2015 09:35'!
installingIn: aClass
	"I am called by the class builder. This way a Slot can change the class it is installed in"
	self wantsInitalization ifTrue: [ self ensureSlotIniatializationFor: aClass ].! !

!Slot methodsFor: 'accessing' stamp: 'CamilloBruni 4/4/2011 18:41'!
parentScopeFor: aScope
	^ aScope! !

!Slot methodsFor: 'testing' stamp: 'MarcusDenker 6/30/2014 17:51'!
isSpecial
	"I am more than just a backward compatible ivar slot"
	^true! !

!Slot methodsFor: 'initialization' stamp: 'CamilloBruni 3/10/2011 17:17'!
initialize: instance
	"nothing to do for the default slot"! !

!Slot methodsFor: '*reflectivity' stamp: 'MarcusDenker 2/26/2015 16:41'!
link: aMetaLink
	| wrapper class methods |
	class := self definingClass.
	methods := self  usingMethods.
	wrapper := LinkWrapper new
		 setLink: aMetaLink;
		 setClass: class;
		 slot: self.
	class layout replaceSlot: self with: wrapper.
	self flag: #TBD. "here instead we need to create a twin and register the link"
 	methods do: [ :each | each recompile ]! !

!Slot methodsFor: 'class building' stamp: 'MarcusDenker 2/6/2015 13:10'!
removingFrom: aClass
	"I am called by the class builder. This way a Slot can change the class it is installed in"! !

!Slot methodsFor: 'meta-object-protocol' stamp: 'MarcusDenker 2/7/2015 09:32'!
wantsInitalization
	"if a slot wants to hable initalization, return true here"
	^false! !

!Slot methodsFor: 'code generation' stamp: 'MarcusDenker 6/27/2014 09:41'!
emitValue: aMethodBuilder
	aMethodBuilder
		pushLiteral: self;
		pushReceiver;
		send: #read:! !

!Slot methodsFor: 'printing' stamp: 'MarcusDenker 2/25/2015 17:12'!
printOn: aStream
	aStream 
		store: self name;
		nextPutAll: ' => ';
		nextPutAll: self class name! !

!Slot methodsFor: 'converting' stamp: 'CAmi 3/15/2011 14:34'!
asSlot
	^ self! !

!Slot methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/24/2015 14:46'!
spotterAccessesFor: aStep
	<spotterOrder: 10>
	(aStep spotter hasPreviousStep and: [
		(aStep spotter previousStep origin isKindOf: Class) or: [
			aStep origin isKindOf: Class]]) ifTrue: [
		aStep listProcessor
				title: 'Accesses';
				allCandidates: [ 
					SystemNavigation default 
						allAccessesTo: self name 
						from: aStep spotter previousStep origin ];
				itemName: [:each | each asString];
				filter: GTFilterSubstring ]! !

!Slot methodsFor: 'class building' stamp: 'MarcusDenker 3/23/2015 18:22'!
layoutChanged: aClass
	"I am called by the class builder. This way a Slot can change the class it is installed in"
	! !

!Slot methodsFor: 'private' stamp: 'MarcusDenker 3/3/2015 18:08'!
addSlotInitToInitialize: aClass
	|  source |
	
	((aClass>>#initialize) hasLiteral: #initializeSlots:)ifTrue: [^self ].
	
	source := (aClass>>#initialize) sourceCode.
	(source endsWith: '.') ifFalse: [ source := source, '.' ].
	source := source, '
	self class initializeSlots: self.'.
	Author useAuthor: 'Generated' during: [aClass compile: source classified: 'initialization']. 
	! !

!Slot methodsFor: 'comparing' stamp: 'MarcusDenker 6/30/2014 18:51'!
hash
	^ self species hash bitXor: self name hash! !

!Slot methodsFor: 'accessing' stamp: 'MarcusDenker 1/18/2015 20:03'!
size
	"normally a slot takes one ivar. Virtual slots do not take space. 
	 We could even have Slots that map to multiple ivars"
	^self isVirtual ifTrue: [0] ifFalse: [1]! !

!Slot methodsFor: 'queries' stamp: 'MarcusDenker 3/19/2015 16:42'!
definingClass
	^(Smalltalk globals allClasses flatCollect: [:each | {each . each classSide} ]) 
		detect: [ :class | class layout definesSlot: self] 
		ifNone: [ nil ]! !

!Slot methodsFor: 'finalization' stamp: 'CAmi 3/15/2011 16:55'!
finalize: layout
	"nothing to do here"! !

!Slot methodsFor: 'printing' stamp: 'MarcusDenker 2/25/2015 17:10'!
storeOn: aStream
	^self printOn: aStream! !

!Slot methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 1/22/2015 21:40'!
phlowValue: anObject value: otherObject
	
	^ self write: otherObject to: anObject! !

!Slot methodsFor: 'testing' stamp: 'MarcusDenker 1/22/2015 17:48'!
isVirtual
	"virtual slots do not take up space in the object and have size = 0"
	^true! !

!Slot methodsFor: 'queries' stamp: 'MarcusDenker 1/9/2015 14:41'!
usingMethods
	"All methods that read or write the slot"
	^self definingClass 
		ifNil: [ #() ]
		ifNotNil: [:class | class allMethodsAccessingSlot: self].! !

!Slot methodsFor: '*OpalTools' stamp: 'MarcusDenker 12/3/2014 09:25'!
gtInspectorUsersIn: composite
	<gtInspectorPresentationOrder: 30>
	| users |
	users := self usingMethods.
	composite list 
		title: 'Users';
		display: [ users collect: #asRingDefinition];
		when: [ users notEmpty ];
		showOnly: 30! !

!Slot methodsFor: 'comparing' stamp: 'MarcusDenker 6/30/2014 18:49'!
= other
	self == other
		ifTrue: [ ^ true ].
	^ (self species == other species) 
			and: [ name = other name ]! !

!Slot methodsFor: 'accessing' stamp: 'MartinDias 7/29/2012 20:58'!
name: aSymbol
	name := aSymbol! !

!Slot methodsFor: 'meta-object-protocol' stamp: 'MarcusDenker 6/30/2014 18:46'!
write: aValue to: anObject
	^self subclassResponsibility! !

!Slot methodsFor: 'private' stamp: 'MarcusDenker 3/3/2015 18:07'!
ensureInitalizeMethodExists: aClass
	(aClass includesSelector:  #initialize) ifTrue: [ ^self ].
	Author useAuthor: 'Generated' during: [
		aClass compile: 'initialize
	super initialize.' classified: 'initialization'.
		] 
	! !

!Slot methodsFor: 'printing' stamp: 'MarcusDenker 1/7/2015 10:38'!
definitionString
	"for Slots, the printString is the defintion"
	^self printString! !

!Slot methodsFor: 'testing' stamp: 'CamilloBruni 3/30/2011 18:46'!
isVisible
	^ true! !

!Slot methodsFor: 'testing' stamp: 'MarcusDenker 7/3/2014 09:39'!
isSelfEvaluating
	^true! !

!Slot methodsFor: 'accessing' stamp: 'CamilloBruni 3/10/2011 15:01'!
name
	^ name! !

!Slot methodsFor: 'meta-object-protocol' stamp: 'MarcusDenker 6/30/2014 18:46'!
read: anObject
	^ self subclassResponsibility! !

!Slot class methodsFor: 'validating' stamp: 'MartinDias 7/24/2013 13:39'!
checkValidName: aSymbol
	aSymbol isPseudovariableName ifTrue: [ 
		^ InvalidSlotName signalFor: aSymbol ]! !

!Slot class methodsFor: 'settings' stamp: 'StephaneDucasse 11/11/2014 18:49'!
slotSetting: aBuilder 
	<systemsettings>
	(aBuilder setting: #showSlotClassDefinition) 
		label: 'Class Template with Slots';
		description: 'If checked then browsers show always the slot class definition';
		parent: #codeBrowsing; 
		target: self! !

!Slot class methodsFor: 'instance creation' stamp: 'MartinDias 8/7/2012 01:12'!
named: aSymbol
	self checkValidName: aSymbol.
	^ self new
		name: aSymbol;
		yourself! !

!Slot class methodsFor: 'instance creation' stamp: 'CamilloBruni 3/22/2011 16:40'!
asSlot
	^ self new! !

!Slot class methodsFor: 'settings' stamp: 'MarcusDenker 7/6/2014 18:40'!
showSlotClassDefinition
	^slotClassDefinition ifNil: [ slotClassDefinition := false ]! !

!Slot class methodsFor: 'settings' stamp: 'MarcusDenker 7/6/2014 18:40'!
showSlotClassDefinition: aBoolean
	slotClassDefinition := aBoolean! !

!SlotAnnouncementsTest methodsFor: 'tests-integration' stamp: 'MartinDias 1/31/2014 16:20'!
testVariableWordClassWithTraitCreatedShouldntAnnounceClassModified

	self subscribeOn: ClassModifiedClassDefinition.	

	"Create a class with a trait composition"
	aClass := Object 
		variableWordSubclass: self aClassName
		uses: TOne 
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: self aCategory.

	self assert: self collectedAnnouncements size isZero.
	self assert: aClass layout isVariable.
	self assert: aClass layout isBits.
	self assert: aClass layout isWords.
	self assert: (aClass traitComposition syntacticallyEquals: TOne asTraitComposition).! !

!SlotAnnouncementsTest methodsFor: 'running' stamp: 'MartinDias 1/17/2014 18:14'!
tearDown 
	super tearDown.
	
	SystemAnnouncer uniqueInstance unsubscribe: collectedAnnouncements.! !

!SlotAnnouncementsTest methodsFor: 'tests-integration' stamp: 'MartinDias 1/31/2014 16:26'!
testWeakClassWhenTraitCompositionChangedShouldAnnounceClassModified

	self subscribeOn: ClassModifiedClassDefinition.	

	"Create a class without trait composition"
	Object 
		weakSubclass: self aClassName
		uses: { } 
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: self aCategory.

	self assert: self collectedAnnouncements size isZero.
	
	"Set a new trait composition"
	Object 
		weakSubclass: self aClassName
		uses: TOne 
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: self aCategory.
	
	self assert: self collectedAnnouncements size equals: 1.
	announcement := self collectedAnnouncements first.
	self assert: (announcement oldClassDefinition traitComposition syntacticallyEquals: {} asTraitComposition).	
	self assert: (announcement newClassDefinition traitComposition syntacticallyEquals: TOne asTraitComposition).! !

!SlotAnnouncementsTest methodsFor: 'helpers' stamp: 'BernardoContreras 10/30/2014 19:07'!
subscribeOn: anAnnouncement

	SystemAnnouncer uniqueInstance weak 
		when: anAnnouncement
		send: #add: 
		to: collectedAnnouncements! !

!SlotAnnouncementsTest methodsFor: 'tests-integration' stamp: 'MartinDias 1/31/2014 16:26'!
testVariableWordClassWhenTraitCompositionChangedShouldAnnounceClassModified

	self subscribeOn: ClassModifiedClassDefinition.	

	"Create a class without trait composition"
	Object 
		variableWordSubclass: self aClassName
		uses: { } 
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: self aCategory.

	self assert: self collectedAnnouncements size isZero.
	
	"Set a new trait composition"
	Object 
		variableWordSubclass: self aClassName
		uses: TOne 
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: self aCategory.
	
	self assert: self collectedAnnouncements size equals: 1.
	announcement := self collectedAnnouncements first.
	self assert: (announcement oldClassDefinition traitComposition syntacticallyEquals: {} asTraitComposition).	
	self assert: (announcement newClassDefinition traitComposition syntacticallyEquals: TOne asTraitComposition).! !

!SlotAnnouncementsTest methodsFor: 'tests-integration' stamp: 'PabloHerrero 2/20/2014 13:04'!
testVariableClassWithTraitCreatedShouldntAnnounceClassModified

	self subscribeOn: ClassModifiedClassDefinition.	

	"Create a class with a trait composition"
	aClass := Object 
		variableSubclass: self aClassName
		uses: TOne 
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: self aCategory.

	self assert: self collectedAnnouncements size isZero.
	self assert: aClass layout isVariable.
	self deny: aClass layout isBits .
	self assert: (aClass traitComposition syntacticallyEquals: TOne asTraitComposition).! !

!SlotAnnouncementsTest methodsFor: 'tests' stamp: 'MarcusDenker 7/12/2014 17:52'!
testChangeInSharedVariablesAndSharedPoolsShouldAnnounceClassModified

	self subscribeOn: ClassModifiedClassDefinition.
	
	"Create a class"
	aClass := self make: [ :builder | 
		builder 
			name: self aClassName ].

	self assert: self collectedAnnouncements size equals: 0.
	
	"Modify the class"
	aClass := self make: [ :builder | 
		builder 
			name: self aClassName;
			sharedPools: 'TestSharedPool';
			sharedVariablesFromString: 'A B' ].

	self assert: self collectedAnnouncements size equals: 1.
	self assert: self collectedAnnouncements first newClassDefinition equals: aClass.! !

!SlotAnnouncementsTest methodsFor: 'tests' stamp: 'MartinDias 1/17/2014 18:29'!
testClassRecategorizationShouldAnnounceClassModified

	self subscribeOn: ClassRecategorized.
	
	aClass := self make: [ :builder|
		builder category: self aCategory ].	
	anotherClass := self make: [ :builder|
		builder category: self anotherCategory ].
	
	self assert: self collectedAnnouncements size equals: 1.
	announcement := self collectedAnnouncements first.	
	self assert: announcement oldCategory equals: self aCategory.
	self assert: announcement newCategory equals: self anotherCategory.
	self assert: announcement classRecategorized == anotherClass.! !

!SlotAnnouncementsTest methodsFor: 'running' stamp: 'MartinDias 1/17/2014 18:14'!
setUp
	super setUp.
	
	collectedAnnouncements := OrderedCollection new.! !

!SlotAnnouncementsTest methodsFor: 'tests' stamp: 'MartinDias 1/17/2014 18:32'!
testLayoutChangeShouldAnnounceClassModified

	| classAdded classModified |
	self subscribeOn: ClassModifiedClassDefinition.
	
	"Create a class"
	classAdded := self makeWithLayout: FixedLayout.
	
	"Modify its format"
	classModified := self makeWithLayout: WeakLayout.

	self assert: self collectedAnnouncements size equals: 1.
	announcement := self collectedAnnouncements first.
	self assert: announcement newClassDefinition equals: classModified.
	self assert: announcement oldClassDefinition format equals: classAdded format.
	self assert: announcement newClassDefinition format equals: classModified format.! !

!SlotAnnouncementsTest methodsFor: 'tests' stamp: 'MartinDias 1/17/2014 18:28'!
testClassCreationShouldAnnounceClassAdded

	self subscribeOn: ClassAdded.
	
	"Create a class"
	aClass := self makeWithLayout: FixedLayout.
	
	self assert: self collectedAnnouncements size equals: 1. 
	self assert: self collectedAnnouncements first classAdded equals: aClass.! !

!SlotAnnouncementsTest methodsFor: 'tests-integration' stamp: 'MartinDias 1/31/2014 16:21'!
testWeakClassWithTraitCreatedShouldntAnnounceClassModified

	self subscribeOn: ClassModifiedClassDefinition.	

	"Create a class with a trait composition"
	aClass := Object 
		weakSubclass: self aClassName
		uses: TOne 
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: self aCategory.

	self assert: self collectedAnnouncements size isZero.
	self assert: aClass layout isVariable.
	self assert: aClass layout isWeak.
	self assert: (aClass traitComposition syntacticallyEquals: TOne asTraitComposition).! !

!SlotAnnouncementsTest methodsFor: 'tests-integration' stamp: 'MartinDias 1/31/2014 16:26'!
testVariableByteClassWhenTraitCompositionChangedShouldAnnounceClassModified

	self subscribeOn: ClassModifiedClassDefinition.	

	"Create a class without trait composition"
	Object 
		variableByteSubclass: self aClassName
		uses: { } 
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: self aCategory.

	self assert: self collectedAnnouncements size isZero.
	
	"Set a new trait composition"
	Object 
		variableByteSubclass: self aClassName
		uses: TOne 
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: self aCategory.
	
	self assert: self collectedAnnouncements size equals: 1.
	announcement := self collectedAnnouncements first.
	self assert: (announcement oldClassDefinition traitComposition syntacticallyEquals: {} asTraitComposition).	
	self assert: (announcement newClassDefinition traitComposition syntacticallyEquals: TOne asTraitComposition).! !

!SlotAnnouncementsTest methodsFor: 'helpers' stamp: 'MartinDias 1/17/2014 18:15'!
collectedAnnouncements
	^ collectedAnnouncements! !

!SlotAnnouncementsTest methodsFor: 'tests-integration' stamp: 'MartinDias 1/31/2014 16:25'!
testVariableClassWhenTraitCompositionChangedShouldAnnounceClassModified

	self subscribeOn: ClassModifiedClassDefinition.	

	"Create a class without trait composition"
	Object 
		variableSubclass: self aClassName
		uses: { } 
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: self aCategory.

	self assert: self collectedAnnouncements size isZero.
	
	"Set a new trait composition"
	Object 
		variableSubclass: self aClassName
		uses: TOne 
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: self aCategory.
	
	self assert: self collectedAnnouncements size equals: 1.
	announcement := self collectedAnnouncements first.
	self assert: (announcement oldClassDefinition traitComposition syntacticallyEquals: {} asTraitComposition).	
	self assert: (announcement newClassDefinition traitComposition syntacticallyEquals: TOne asTraitComposition).! !

!SlotAnnouncementsTest methodsFor: 'tests-integration' stamp: 'MartinDias 2/5/2014 18:21'!
testClassAddedToNewCategoryShouldAnnounceCategoryAdded

	self subscribeOn: CategoryAdded.	

	self deny: (self class environment organization includesCategory: self aCategory).
	
	Object 
		subclass: self aClassName
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: self aCategory.

	self assert: (self class environment organization includesCategory: self aCategory).

	self assert: self collectedAnnouncements size equals: 1.! !

!SlotAnnouncementsTest methodsFor: 'tests' stamp: 'MartinDias 2/7/2014 17:35'!
testChangeInSharedPoolShouldAnnounceClassModified

	self subscribeOn: ClassModifiedClassDefinition.
	
	"Create a class"
	aClass := self make: [ :builder | 
		builder 
			name: self aClassName ].

	self assert: self collectedAnnouncements size equals: 0.
	
	"Modify the class"
	aClass := self make: [ :builder | 
		builder 
			name: self aClassName;
			sharedPools: 'TestSharedPool' ].

	self assert: self collectedAnnouncements size equals: 1.
	self assert: self collectedAnnouncements first newClassDefinition equals: aClass.! !

!SlotAnnouncementsTest methodsFor: 'tests' stamp: 'MartinDias 1/28/2014 14:28'!
testChangeInSuperclassShouldNotAnnounceSubclassModified

	self subscribeOn: ClassModifiedClassDefinition.
	
	"Create a class and a subclass"
	aClass := self make: [ :builder | 
		builder 
			name: self aClassName;
			slots: #() ].

	anotherClass := self make: [ :builder | 
		builder 
			name: self anotherClassName;
			superclass: aClass ].

	self assert: self collectedAnnouncements size equals: 0.
	
	"Modify the superclass"
	aClass := self make: [ :builder | 
		builder 
			name: self aClassName;
			slots: #(a b c) ].

	self assert: self collectedAnnouncements size equals: 1.
	self assert: self collectedAnnouncements first newClassDefinition equals: aClass.! !

!SlotAnnouncementsTest methodsFor: 'tests-integration' stamp: 'MartinDias 1/31/2014 16:25'!
testFixedClassWhenTraitCompositionChangedShouldAnnounceClassModified

	self subscribeOn: ClassModifiedClassDefinition.	

	"Create a class without trait composition"
	Object 
		subclass: self aClassName
		uses: { } 
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: self aCategory.

	self assert: self collectedAnnouncements size isZero.
	
	"Set a new trait composition"
	Object 
		subclass: self aClassName
		uses: TOne 
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: self aCategory.
	
	self assert: self collectedAnnouncements size equals: 1.
	announcement := self collectedAnnouncements first.
	self assert: (announcement oldClassDefinition traitComposition syntacticallyEquals: {} asTraitComposition).	
	self assert: (announcement newClassDefinition traitComposition syntacticallyEquals: TOne asTraitComposition).! !

!SlotAnnouncementsTest methodsFor: 'helpers' stamp: 'MartinDias 1/17/2014 18:14'!
collectedAnnouncementClasses
	^ collectedAnnouncements collect: #class! !

!SlotAnnouncementsTest methodsFor: 'tests-integration' stamp: 'MartinDias 1/31/2014 16:20'!
testFixedClassWithTraitCreatedShouldntAnnounceClassModified

	self subscribeOn: ClassModifiedClassDefinition.	

	"Create a class with a trait composition"
	aClass := Object 
		subclass: self aClassName
		uses: TOne 
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: self aCategory.

	self assert: self collectedAnnouncements size isZero.
	self deny: aClass layout isVariable.
	self assert: (aClass traitComposition syntacticallyEquals: TOne asTraitComposition).! !

!SlotAnnouncementsTest methodsFor: 'tests-integration' stamp: 'MartinDias 1/31/2014 16:20'!
testVariableByteClassWithTraitCreatedShouldntAnnounceClassModified

	self subscribeOn: ClassModifiedClassDefinition.	

	"Create a class with a trait composition"
	aClass := Object 
		variableByteSubclass: self aClassName
		uses: TOne 
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: self aCategory.

	self assert: self collectedAnnouncements size isZero.
	self assert: aClass layout isVariable.
	self assert: aClass layout isBits.
	self assert: aClass layout isBytes.
	self assert: (aClass traitComposition syntacticallyEquals: TOne asTraitComposition).! !

!SlotAnnouncementsTest methodsFor: 'tests' stamp: 'MarcusDenker 7/12/2014 17:51'!
testChangeInSharedVariablesShouldAnnounceClassModified

	self subscribeOn: ClassModifiedClassDefinition.
	
	"Create a class"
	aClass := self make: [ :builder | 
		builder 
			name: self aClassName ].

	self assert: self collectedAnnouncements size equals: 0.
	
	"Modify the class"
	aClass := self make: [ :builder | 
		builder 
			name: self aClassName;
			sharedVariablesFromString: 'A B C' ].

	self assert: self collectedAnnouncements size equals: 1.
	self assert: self collectedAnnouncements first newClassDefinition equals: aClass.! !

!SlotAnnouncementsTest methodsFor: 'tests' stamp: 'MartinDias 1/17/2014 18:29'!
testSlotAdditionShouldAnnounceClassModified

	| classAdded classModified |
	self subscribeOn: ClassModifiedClassDefinition.
	
	"Create a class"
	classAdded := self makeWithLayout: FixedLayout.
	
	"now we extend it with slots.  The class definition should've changed"
	classModified := self makeWithLayout: FixedLayout andSlots: { #aSlot }.

	self assert: self collectedAnnouncements size equals: 1.
	announcement := self collectedAnnouncements first.	
	self assert: announcement newClassDefinition equals: classModified.
	self assert: announcement oldClassDefinition allInstVarNames equals: classAdded allInstVarNames.! !

!SlotBasicTest methodsFor: 'tests-class slots' stamp: 'MartinDias 7/8/2013 16:05'!
testWithoutClassSlots

	aClass := self make: [ :builder | 
		builder classSlots: #() ].
	
	self assert: aClass classVarNames isEmpty! !

!SlotBasicTest methodsFor: 'tests-class slots' stamp: 'MartinDias 7/8/2013 16:05'!
testWithClassSlots

	aClass := self make: [ :builder | 
		builder classSlots: #(a) ].
	
	self assert: aClass class instVarNames equals: #(a).	
	aClass instVarNamed: #a put: $A.
	self assert: (aClass instVarNamed: #a) equals: $A.! !

!SlotBasicTest methodsFor: 'tests-shared variables' stamp: 'MarcusDenker 7/12/2014 17:51'!
testWithSharedVariable

	aClass := self make: [ :builder | 
		builder sharedVariablesFromString: 'Var' ].
	aClass class 
		compile: 'var:x  Var:=x';
		compile: 'var  ^Var'.
	
	aClass var: true.
	
	self assert: aClass classVarNames equals: #(Var).
	self assert: aClass var.! !

!SlotBasicTest methodsFor: 'tests-basic' stamp: 'MartinDias 7/8/2013 16:05'!
testNewVariableWordClass

	aClass := self makeWithLayout: WordLayout.
	
	self deny: aClass isCompact.
	self deny: aClass isPointers.
	self deny: aClass isFixed.
	self assert: aClass isWords.
	self assert: aClass isVariable.! !

!SlotBasicTest methodsFor: 'tests-class slots' stamp: 'MartinDias 7/8/2013 16:05'!
testSwitchClassSlotAndMigrate

	| classAdded classModified |	
	classAdded := 
		self make: [ :builder | 
			builder classSlots: #(a b) ].

	"Add methods"	
	classAdded class 
		compile: 'a ^a';
		compile: 'b ^b'.

	"Put values"
	classAdded instVarNamed: #a put: $A.
	classAdded instVarNamed: #b put: $B.

	"Modify the class"	
	classModified := 
		self make: [ :builder | 
			builder classSlots: #(b a) ].
	
	"The instance was migrated"
	self assert: (classModified instVarNamed: #a) equals: $A.
	self assert: (classModified instVarNamed: #b) equals: $B.
	
	"The methods were migrated"
	self assert: classModified a equals: $A.
	self assert: classModified b equals: $B.
! !

!SlotBasicTest methodsFor: 'tests-shared pools' stamp: 'MartinDias 7/8/2013 16:05'!
testAddSharedPool

	self make: [ :builder | 
		builder sharedPools: '' ].

	aClass := self make: [ :builder | 
		builder sharedPools: 'TestSharedPool' ].
	
	self assert: (aClass sharedPools includes: TestSharedPool).
! !

!SlotBasicTest methodsFor: 'tests-comments' stamp: 'MarcusDenker 1/17/2015 16:26'!
testClassWithComment

	aClass := self make: [ :builder |
		builder 
			name: self aClassName;
			comment: 'A class Comment' ].
	
	self assert: aClass name = self aClassName.
	self assert: aClass comment = 'A class Comment'.
	
! !

!SlotBasicTest methodsFor: 'tests-shared pools' stamp: 'MartinDias 7/8/2013 16:05'!
testWithoutSharedPools

	aClass := self make: [ :builder | 
		builder sharedPools: '' ].
	
	self assert: aClass sharedPools isEmpty! !

!SlotBasicTest methodsFor: 'tests-shared pools' stamp: 'MartinDias 7/8/2013 16:05'!
testRemoveSharedPool

	self make: [ :builder | 
		builder sharedPools: 'TestSharedPool' ].

	aClass := self make: [ :builder | 
		builder sharedPools: '' ].
	
	self assert: aClass sharedPools isEmpty
! !

!SlotBasicTest methodsFor: 'tests-class slots' stamp: 'MartinDias 7/8/2013 16:05'!
testAddClassSlotAndMigrate

	| classAdded classModified |
	classAdded := 
		self make: [ :builder | 
			builder classSlots: #(a) ].

	classAdded instVarNamed: #a put: $A.
	
	classModified := 
		self make: [ :builder | 
			builder classSlots: #(a b) ].
	
	self assert: (classModified instVarNamed: #a) equals: $A.
	self assert: (classModified instVarNamed: #b) isNil.! !

!SlotBasicTest methodsFor: 'tests-shared variables' stamp: 'MarcusDenker 7/12/2014 17:51'!
testWithoutSharedVariables

	aClass := self make: [ :builder | 
		builder sharedVariablesFromString: '' ].
	
	self assert: aClass classVarNames isEmpty! !

!SlotBasicTest methodsFor: 'tests-basic' stamp: 'MartinDias 7/8/2013 16:05'!
testNewWeakClass

	aClass := self makeWithLayout: WeakLayout.
	
	self deny: aClass isCompact.
	self assert: aClass isPointers.
	self deny: aClass isFixed.
	self assert: aClass isWords.
	self assert: aClass isWeak.! !

!SlotBasicTest methodsFor: 'tests-shared variables' stamp: 'MarcusDenker 7/12/2014 17:51'!
testAddSharedVariable

	self make: [ :builder | 
		builder sharedVariablesFromString: '' ].

	aClass := self make: [ :builder | 
		builder sharedVariablesFromString: 'Var' ].
	
	self assert: aClass classVarNames equals: #(Var).
! !

!SlotBasicTest methodsFor: 'tests-basic' stamp: 'MartinDias 7/8/2013 16:05'!
testBasicClassBuilding

	aClass := self make: [ :builder |
		builder name: self aClassName ].
	
	self deny: aClass layout isNil.
	self assert: aClass name = self aClassName.
	self assert: (self class environment at: self aClassName) == aClass.
! !

!SlotBasicTest methodsFor: 'tests-basic' stamp: 'MartinDias 12/9/2013 11:38'!
testNewPointerClass

	aClass := self makeWithLayout: FixedLayout.
	
	self deny: aClass isCompact.
	self assert: aClass isPointers.
	self assert: aClass isFixed.
	self assert: aClass instVarNames isEmpty.! !

!SlotBasicTest methodsFor: 'tests-basic' stamp: 'MartinDias 7/8/2013 16:05'!
testNewVariableByteClass

	aClass := self makeWithLayout: ByteLayout.
	
	self deny: aClass isCompact.
	self deny: aClass isPointers.
	self deny: aClass isFixed.
	self assert: aClass isBytes.
	self assert: aClass isVariable.! !

!SlotBasicTest methodsFor: 'tests-comments' stamp: 'MarcusDenker 1/17/2015 16:40'!
testClassWithCommentAndStamp

	aClass := self make: [ :builder |
		builder 
			name: self aClassName;
			comment: 'A class Comment' stamp: (Object>>#halt) stamp ].
	
	self assert: aClass name = self aClassName.
	self assert: aClass comment = 'A class Comment'.
	self assert: aClass organization commentStamp = (Object>>#halt) stamp.
	
! !

!SlotBasicTest methodsFor: 'tests-shared variables' stamp: 'MarcusDenker 7/12/2014 17:53'!
testRemoveSharedVariable

	self make: [ :builder | 
		builder sharedVariablesFromString: 'Var' ].

	aClass := self make: [ :builder | 
		builder sharedVariablesFromString: '' ].
	
	self assert: aClass classVarNames isEmpty! !

!SlotBasicTest methodsFor: 'tests-basic' stamp: 'MartinDias 12/9/2013 11:38'!
testNewPointerClassWithSlots

	aClass := self 
		makeWithLayout: FixedLayout
		andSlots: { #id. #name }.
	
	self assert: (aClass instVarNames includes: 'id').
	self assert: (aClass instVarNames includes: 'name').! !

!SlotBasicTest methodsFor: 'tests-class slots' stamp: 'MartinDias 7/8/2013 16:05'!
testRemoveClassSlotAndMigrate

	| classAdded classModified |
	classAdded := 
		self make: [ :builder | 
			builder classSlots: #(a b) ].

	classAdded instVarNamed: #a put: $A.
	
	classModified := 
		self make: [ :builder | 
			builder classSlots: #(a) ].
	
	self assert: (classModified instVarNamed: #a) equals: $A.
	self should: [ classModified instVarNamed: #b ] raise: Error
! !

!SlotBasicTest methodsFor: 'tests-basic' stamp: 'MartinDias 7/8/2013 16:05'!
testNewCompiledMethodClass

	aClass := self makeWithLayout: CompiledMethodLayout.

	self deny: aClass isCompact.
	self deny: aClass isPointers.
	self deny: aClass isFixed.
	self assert: aClass isBytes.
	self deny: aClass isWeak.! !

!SlotBasicTest methodsFor: 'tests-shared pools' stamp: 'MartinDias 7/8/2013 16:05'!
testWithSharedPool

	aClass := self make: [ :builder | 
		builder sharedPools: 'TestSharedPool' ].
	aClass class compile: 'one ^One'.
	
	self assert: (aClass sharedPools includes: TestSharedPool).
	self assert: aClass one = 1.! !

!SlotClassBuilder commentStamp: '<historical>'!
I'm responsible for building and verifying new classes. 
The update and modification/installation of classes are managed by installers (AbstractClassInstallation).

The class builder is responsible for the structural part of modifying a class or creating a new class. It relies on the installer to fetch the old version of the class. It then uses the class modification model to compute the method modification and instance modification models. It then validates if these changes are semantically sound.

Example:
	see PharoClassInstaller!
!SlotClassBuilder methodsFor: 'accessing' stamp: 'md 1/19/2015 18:10'!
comment: aString
	comment := aString! !

!SlotClassBuilder methodsFor: 'private validating' stamp: 'MartinDias 7/25/2013 14:15'!
validateSuperChain: oldClass
	superclass ifNil: [ ^ nil ].
	superclass withAllSuperclassesDo: [ :class |
		class == oldClass
			ifTrue: [ CircularHierarchyError signalFor: oldClass ]].! !

!SlotClassBuilder methodsFor: 'private' stamp: 'MartinDias 7/11/2013 15:39'!
applySlotChange: classModification
	result := self applyAndUpdateSlots: classModification.
	classModification allPropagationsDo: [ :propagation | 
		self applyAndUpdateSlots: propagation ]! !

!SlotClassBuilder methodsFor: 'private' stamp: 'MartinDias 4/29/2014 12:39'!
applyAndUpdateSharedVariableOrSharedPool: classModification
	^ self track: classModification during: [ :old :new |
		installer sharedVariableOrSharedPoolChangedFrom: old to:  new by: classModification ].! !

!SlotClassBuilder methodsFor: 'private' stamp: 'MartinDias 1/28/2014 15:10'!
migrateClasses: classModification.
	
	installer
		migrateClasses: oldClasses asArray
		to: newClasses asArray
		using: classModification instanceModification.! !

!SlotClassBuilder methodsFor: 'accessing' stamp: 'MartinDias 7/1/2013 16:02'!
superMetaclass
	 ^ superclass ifNil: [ Class ] ifNotNil: [ superclass class ].! !

!SlotClassBuilder methodsFor: 'accessing' stamp: 'ToonVerwaest 3/31/2011 20:09'!
traitComposition: aTraitComposition
	traitComposition := aTraitComposition asTraitComposition! !

!SlotClassBuilder methodsFor: 'private' stamp: 'MartinDias 1/28/2014 15:10'!
applyAndUpdateSlots: classModification
	^ self track: classModification during: [ :old :new |
		installer slotsChangedFrom: old to: new by: classModification ].! !

!SlotClassBuilder methodsFor: 'accessing' stamp: 'MartinDias 1/28/2014 15:10'!
environment
	^ installer environment! !

!SlotClassBuilder methodsFor: 'private' stamp: 'MartinDias 1/28/2014 15:10'!
applyAndUpdateFormat: classModification
	^ self track: classModification during: [ :old :new |
		installer formatChangedFrom: old to: new by: classModification ].! !

!SlotClassBuilder methodsFor: 'initialization' stamp: 'MarcusDenker 7/12/2014 17:50'!
initialize
	super initialize.
	oldClasses := OrderedCollection new.
	newClasses := OrderedCollection new.
	sharedPoolsString := ''.
	sharedVariables := {}.
	classSlots := {}.
	slots := {}.
	superclass := Object.
	classTraitComposition := {} asTraitComposition.
	traitComposition := {} asTraitComposition.! !

!SlotClassBuilder methodsFor: 'private' stamp: 'MarcusDenker 7/17/2014 21:09'!
apply: classModification

	classModification modifiesSlots
		ifTrue: [self applySlotChange: classModification]
		ifFalse: [ 
			classModification modifiesFormat
				ifTrue: [ self applyFormatChange: classModification]
				ifFalse: [
					classModification modifiesSuperclass
						ifTrue: [ self applySuperclassChange: classModification ]
						ifFalse: [ 
							(classModification modifiesSharedPools or: [ classModification modifiesClassVariables ])
								ifTrue: [ self applySharedVariableOrPoolChange: classModification ]
								ifFalse: [ 
									"Note: In the other cases of this evil if nesting, the trait composition is set
									by the installer."
									^ self installTraitComposition: classModification ] ]]].
	
	self 
		migrateClasses: classModification;
		cleanUp! !

!SlotClassBuilder methodsFor: 'private validating' stamp: 'MarcusDenker 10/9/2014 17:48'!
validateClassName
	"Validate the new class name. Raise warning if invalid."

	name
		detect: [ :c | (c isAlphaNumeric or: [ c = $_ ]) not ]
		ifFound: [ :c | InvalidGlobalName signal: 'Invalid character: ''' , c printString , '''' for: name ].
	name first canBeGlobalVarInitial
		ifFalse: [ InvalidGlobalName signal: 'Class name does not start with a valid Global Var Initial' for: name ].
	name = #NameOfSubclass 
		ifTrue: [ InvalidGlobalName signal: 'NameOfSubclass is not a valid class name' for: name ].! !

!SlotClassBuilder methodsFor: 'private' stamp: 'MartinDias 7/1/2013 15:27'!
track: classModification during: aBlock
	| old new |
	old := classModification target.
	new := classModification apply.

	aBlock value: old value: new.
	
	" Store the modification for updateClasses "
	oldClasses add: old.
	newClasses add: new.
	^ new! !

!SlotClassBuilder methodsFor: 'initialize-release' stamp: 'MarcusDenker 3/23/2015 18:30'!
build
	| oldClass metaChange classChange |
	result := oldClass := installer classAt: name ifAbsent: [ ^ self buildNewClass ].

	self validateSuperChain: oldClass.
	
	metaChange := ClassModification
							modify: oldClass class
							extend: self superMetaclass
							withLayoutType: FixedLayout
							slots: classSlots
							sharedVariables: #()
							sharedPools: ''
							traitComposition: classTraitComposition
							compactClassIndex: oldClass class indexIfCompact.
	
	classChange := ClassModification
							modify: oldClass
							extend: superclass
							withLayoutType: self layoutClass
							slots: slots
							sharedVariables: sharedVariables
							sharedPools: sharedPoolsString
							traitComposition: traitComposition
							compactClassIndex: oldClass indexIfCompact.

	self apply: metaChange.
	self apply: classChange.

	comment ifNotNil: [result classComment: comment stamp: commentStamp].

	result instanceSide 
		declareClassVariables: sharedVariables;
		sharing: sharedPoolsString.

	result isMeta ifFalse: [
		installer recategorize: result to: category ].
	
	"call all slots and allow them to modify the class"
	classChange additions do: [ :each | each installingIn: result].
	classChange removals do: [ :each | each removingFrom: result].
	result layout slots do: [ :each | each layoutChanged: result]. 
	
	^ result instanceSide! !

!SlotClassBuilder methodsFor: 'initialize-release' stamp: 'MarcusDenker 3/23/2015 18:24'!
buildNewClass
	| metaclass newClass |
	metaclass := Metaclass new.
	metaclass
		superclass: self superMetaclass
		withLayoutType: FixedLayout
		slots: classSlots.

	newClass := metaclass new.
	newClass setName: name.
	
	newClass
		superclass: superclass
		withLayoutType: self layoutClass
		slots: slots.

	newClass declareClassVariables: sharedVariables.
	newClass sharing: sharedPoolsString.
	
	comment ifNotNil: [newClass classComment: comment stamp: commentStamp].
	
	installer classAdded: newClass inCategory: category.
	
	installer installTraitComposition: traitComposition on: newClass.
	installer installTraitComposition: classTraitComposition on: metaclass.
	
	newClass layout slots do: [ :each | each installingIn: newClass].
	newClass layout slots do: [ :each | each layoutChanged: newClass].
	^ newClass! !

!SlotClassBuilder methodsFor: 'accessing' stamp: 'MartinDias 8/7/2012 02:12'!
sharedPools: poolString 
	sharedPoolsString := poolString! !

!SlotClassBuilder methodsFor: 'accessing' stamp: 'MartinDias 1/28/2014 15:10'!
environment: globals
	installer environment: globals! !

!SlotClassBuilder methodsFor: 'accessing' stamp: 'MarcusDenker 1/16/2015 12:13'!
sharedVariables: anArray 
	sharedVariables := anArray collect: [ :each | each asClassVariable ]! !

!SlotClassBuilder methodsFor: 'private validating' stamp: 'MartinDias 7/25/2013 14:17'!
validateSuperclass: anObject
	anObject isBehavior ifFalse: [ 
		InvalidSuperclass 
			signal: 'Trying to build classes from non-class objects'
			for: anObject ].

	anObject isMeta ifTrue: [ 
		InvalidSuperclass 
			signal: 'Metaclasses cannot be used for building classes'
			for: anObject ].! !

!SlotClassBuilder methodsFor: 'accessing' stamp: 'MarcusDenker 1/17/2015 16:31'!
comment: aString stamp: aStamp
	comment := aString.
	commentStamp := aStamp.! !

!SlotClassBuilder methodsFor: 'private' stamp: 'MartinDias 1/28/2014 15:10'!
installTraitComposition: classModification
	installer
		installTraitComposition: classModification traitComposition
		on: classModification target.
	! !

!SlotClassBuilder methodsFor: 'accessing' stamp: 'MartinDias 7/1/2013 16:03'!
copyTraitCompositionFromExistingClass
	"Ugly Helper method: I copy over the trait compisition of the class in my builder environment."
	| oldClass |
	oldClass := self environment at: name ifAbsent: [ ^ self ].
	oldClass hasTraitComposition
		ifTrue: [ self traitComposition: oldClass traitComposition copyTraitExpression ].
	oldClass class hasTraitComposition
		ifTrue: [ self classTraitComposition: oldClass class traitComposition copyTraitExpression ]! !

!SlotClassBuilder methodsFor: 'accessing' stamp: 'CamilleTeruel 1/17/2014 11:53'!
layoutClass
	"If not specified the layout class is the same as the superclass"
	^ layoutClass ifNil: [ layoutClass := superclass layout class ]! !

!SlotClassBuilder methodsFor: 'accessing' stamp: 'MartinDias 8/7/2013 14:18'!
copyClassSlotsFromExistingClass
	"Ugly helper method: I copy over the class slots of the class in my builder environment."
	| oldClass |
	oldClass := 
		self environment 
			at: name 
			ifAbsent: [ ^ self ].

	self classSlots: oldClass class layout slotScope visibleSlotNames.! !

!SlotClassBuilder methodsFor: 'private' stamp: 'MartinDias 7/1/2013 15:20'!
cleanUp
	
	oldClasses removeAll.
	newClasses removeAll.! !

!SlotClassBuilder methodsFor: 'accessing' stamp: 'ToonVerwaest 3/28/2011 00:29'!
layoutClass: aLayoutClass
	layoutClass := aLayoutClass! !

!SlotClassBuilder methodsFor: 'private validating' stamp: 'BenComan 2/19/2014 01:31'!
warnOfDangerousClasses
	DangerousClassNotifier check: name ! !

!SlotClassBuilder methodsFor: 'private' stamp: 'MartinDias 1/28/2014 15:10'!
applyAndUpdateSuperclass: classModification
	^ self track: classModification during: [ :old :new |
		installer superclassChangedFrom: old to: new by: classModification ]! !

!SlotClassBuilder methodsFor: 'accessing' stamp: 'BenComan 2/19/2014 01:32'!
name: aName
	[ name := aName asSymbol ]
		on: Error 
		do: [ InvalidGlobalName 
				signal: 'Global names should be symbols' 
				for: aName ].
	self validateClassName.
	self warnOfDangerousClasses.! !

!SlotClassBuilder methodsFor: 'accessing' stamp: 'ToonVerwaest 3/28/2011 00:29'!
slots: someSlots
	slots := someSlots! !

!SlotClassBuilder methodsFor: 'accessing' stamp: 'BernardoContreras 3/7/2015 12:32'!
sharedVariablesFromString: aString 
	sharedVariables :=  (aString substrings: ' ') collect: [:x | x asSymbol => ClassVariable]. ! !

!SlotClassBuilder methodsFor: 'accessing' stamp: 'MartinDias 7/25/2013 14:00'!
superclass: aSuperclass
	superclass := aSuperclass.
	superclass ifNotNil: [ self validateSuperclass: superclass ].! !

!SlotClassBuilder methodsFor: 'private' stamp: 'MartinDias 2/7/2014 16:58'!
applySharedVariableOrPoolChange: classModification
	"This method updates both shared variables and shared pools since they use the same mechanism"
	result := self applyAndUpdateSharedVariableOrSharedPool: classModification.
	classModification allPropagationsDo: [ :propagation | 
		self applyAndUpdateSharedVariableOrSharedPool: propagation ]! !

!SlotClassBuilder methodsFor: 'private' stamp: 'MartinDias 7/11/2013 15:39'!
applySuperclassChange: classModification
	result := self applyAndUpdateSuperclass: classModification.
	classModification allPropagationsDo: [ :propagation | 
		self applyAndUpdateSuperclass: propagation ]! !

!SlotClassBuilder methodsFor: 'private' stamp: 'MartinDias 7/11/2013 15:39'!
applyFormatChange: classModification
	result := self applyAndUpdateFormat: classModification.
	classModification allPropagationsDo: [ :propagation | 
		self applyAndUpdateFormat: propagation ]! !

!SlotClassBuilder methodsFor: 'accessing' stamp: 'MartinDias 1/28/2014 15:14'!
installer: anInstaller
	installer := anInstaller! !

!SlotClassBuilder methodsFor: 'accessing' stamp: 'ToonVerwaest 3/28/2011 00:28'!
classSlots: someClassSlots
	classSlots := someClassSlots! !

!SlotClassBuilder methodsFor: 'accessing' stamp: 'ToonVerwaest 4/2/2011 20:53'!
classTraitComposition: aTraitComposition
	classTraitComposition := aTraitComposition asTraitComposition! !

!SlotClassBuilder methodsFor: 'accessing' stamp: 'MarcusDenker 10/9/2014 17:32'!
category: aCategory
	aCategory isEmpty ifTrue: [ InvalidPackageName signal: 'The Category should not be empty' ].
	category := aCategory! !

!SlotClassBuilderError commentStamp: '<historical>'!
I represent an error raised while building a class. !
!SlotClassBuilderTest methodsFor: 'helpers-building' stamp: 'MartinDias 12/9/2013 11:38'!
make: anUnaryBlock
	"I build a class for testing, providing basic default values, but eventually customized by the received unary block."

	^PharoClassInstaller make: [:builder|
		builder
			superclass: Object;
			name: self aClassName;
			layoutClass: FixedLayout;
			category: self aCategory.
		anUnaryBlock value: builder
		].! !

!SlotClassBuilderTest methodsFor: 'helpers-names' stamp: 'MartinDias 12/9/2013 11:38'!
layoutClassesWithSlots
	^ { FixedLayout. VariableLayout. WeakLayout }! !

!SlotClassBuilderTest methodsFor: 'helpers-names' stamp: 'MartinDias 12/9/2013 11:38'!
layoutClasses
	^ { ByteLayout. WordLayout. FixedLayout. VariableLayout. WeakLayout }! !

!SlotClassBuilderTest methodsFor: 'helpers-names' stamp: 'MartinDias 7/11/2013 15:01'!
yetAnotherClassName
	^ #SlotTestsClassC! !

!SlotClassBuilderTest methodsFor: 'helpers-building' stamp: 'MartinDias 7/8/2013 16:06'!
makeWithLayout: aClassLayout
	^self makeWithLayout: aClassLayout andSlots: {}! !

!SlotClassBuilderTest methodsFor: 'running' stamp: 'EstebanLorenzano 4/11/2014 16:01'!
tearDown
	"We remove the classes that could have been created during test run"
	super tearDown.

	SystemAnnouncer uniqueInstance suspendAllWhile: [
		{ self aClassName. self anotherClassName. self yetAnotherClassName. self yetYetAnotherClassName } do: [ :each | 
			Smalltalk globals 
				at: each 
				ifPresent: [ :class | class removeFromSystem ]]].

	SystemAnnouncer uniqueInstance unsubscribe: self.
	
	self 
		cleanUpTrait: TOne;
		cleanUpTrait: TTwo.
		
	Smalltalk organization removeCategory: self aCategory.
	(RPackageOrganizer default 
		packageNamed: self aCategory
		ifAbsent: [ ^ self ]) 
		unregister.! !

!SlotClassBuilderTest methodsFor: 'helpers-building' stamp: 'MartinDias 7/8/2013 16:06'!
makeWithLayout: aClassLayout andSlots: someSlots
	"
	I create a class using the Slot class builder given a class layout and a collection of slots.
	"

	^self make: [:builder|
		builder
			layoutClass: aClassLayout;
			slots: someSlots
		].! !

!SlotClassBuilderTest methodsFor: 'helpers-names' stamp: 'MartinDias 7/11/2013 15:02'!
aCategory
	^ 'SlotTestsTmp'! !

!SlotClassBuilderTest methodsFor: 'helpers-names' stamp: 'MartinDias 7/11/2013 15:02'!
anotherCategory
	^ 'SlotTestsTmp-Another'! !

!SlotClassBuilderTest methodsFor: 'running' stamp: 'VincentBlondeau 3/6/2015 16:38'!
assertTraitIntegrity
	self assert: TOne traitUsers isHealthy.
	self assert: TOne classTrait traitUsers isHealthy.
	self assert: TTwo traitUsers isHealthy.
	self assert: TTwo classTrait traitUsers isHealthy.! !

!SlotClassBuilderTest methodsFor: 'helpers-names' stamp: 'MartinDias 7/11/2013 15:01'!
yetYetAnotherClassName
	^ #SlotTestsClassD! !

!SlotClassBuilderTest methodsFor: 'helpers-names' stamp: 'MartinDias 7/11/2013 15:01'!
anotherClassName
	^ #SlotTestsClassB! !

!SlotClassBuilderTest methodsFor: 'running' stamp: 'VincentBlondeau 3/6/2015 16:38'!
cleanUpTrait: trait
	"During development some tests might invalidate the trait internal state.
	To avoid follow-up failures we reset the trait state here as good as possible."
	
	trait traitUsers removeAll.
	trait classTrait traitUsers removeAll.! !

!SlotClassBuilderTest methodsFor: 'helpers-names' stamp: 'MartinDias 7/11/2013 15:01'!
aClassName
	^ #SlotTestsClassA! !

!SlotClassBuilderWarning commentStamp: '<historical>'!
I represent a warning signaled while building a class.!
!SlotClassBuilderWarning methodsFor: 'accessing' stamp: 'ToonVerwaest 3/21/2011 01:12'!
defaultAction
	"No one has handled this error, but now give them a chance to decide how to debug it.  If none handle this either then open debugger (see UnhandedError-defaultAction)"

	UnhandledError signalForException: self! !

!SlotClassVariableTest methodsFor: 'tests' stamp: 'MarcusDenker 7/12/2014 17:51'!
testClassVariableDoesNotDuplicatesSubclassesOfSuperclass
	"Issue: 13028"
	| class1 class2 |	
	
	class1 := self make: [ :builder | 
		builder
			name: self aClassName;
			superclass: Object ].
	
	class2 := self make: [ :builder | 
		builder
			name: self anotherClassName;
			superclass: class1 ].
	
	self assert: class1 subclasses equals: { class2 }.
	class2 := self make: [ :builder | 
		builder
			name: self anotherClassName;
			superclass: class1;
			sharedVariablesFromString: 'ASharedVariable' ].
	self assert: class1 subclasses equals: { class2 }.
! !

!SlotEnvironmentTest methodsFor: 'tests' stamp: 'MartinDias 8/7/2013 11:46'!
testBasicEnvironment
	| environment |
	environment := SystemDictionary new.
	environment at: #SystemOrganization put: SystemOrganizer new.

	aClass := self make: [ :builder | 
		builder environment: environment ].

	self assert: (aClass environment == environment).
	self assert: (environment includesKey: aClass name).	
	self assert: (environment at: aClass name) == aClass.
	
	self deny: (Smalltalk globals includesKey: aClass name).! !

!SlotErrorsTest methodsFor: 'helpers' stamp: 'MartinDias 8/7/2013 11:54'!
assertInvalidClassName: aName

	self should: [
		self make: [ :builder | 
			builder name: aName ] ]
		raise: InvalidGlobalName.
	self flag: 'should remove class if not raised'.
		
	self should: [
		PharoClassInstaller 
			validateClassName: aName ]
		raise: InvalidGlobalName! !

!SlotErrorsTest methodsFor: 'tests' stamp: 'VincentBlondeau 3/6/2015 17:43'!
testDirectCircularHierarchyError
	"Tests an error is raised when trying to create a heirarchy A<-A"
	
	| classA |
	classA := self make: [ :builder |
			builder 
				superclass: Object;
				name: self aClassName ].

	self should: [ 
		self make: [ :builder | 
			builder 
				superclass: classA;
				name: self aClassName ] ]
		raise: CircularHierarchyError ! !

!SlotErrorsTest methodsFor: 'tests' stamp: 'BenComan 2/15/2014 22:03'!
testDangerousClassesConditions

	| compactClassesArrayItem specialObjectsArrayItem |
	
	compactClassesArrayItem := ( (Smalltalk compactClassesArray copyWithout: Smalltalk specialObjectsArray) select: [ :x | x isClass ] ) anyOne name.
	specialObjectsArrayItem := ( (Smalltalk specialObjectsArray copyWithout: Smalltalk compactClassesArray) select: [ :x | x isClass ] ) anyOne name.

	self assert: (DangerousClassNotifier tooDangerousClasses includes: #ProtoObject).
	self assert: (DangerousClassNotifier shouldNotBeRedefined: compactClassesArrayItem). 
	self assert: (DangerousClassNotifier shouldNotBeRedefined: specialObjectsArrayItem). ! !

!SlotErrorsTest methodsFor: 'running' stamp: 'MartinDias 8/7/2013 12:11'!
expectedFailures 

	^ #(testCannotBeRecompiled)! !

!SlotErrorsTest methodsFor: 'tests' stamp: 'MartinDias 8/7/2013 11:27'!
testClassNameWithInvalidCharacter

	self assertInvalidClassName: #'Invalid-ClassName'! !

!SlotErrorsTest methodsFor: 'tests' stamp: 'MartinDias 8/7/2013 11:28'!
testCannotBeRecompiled

	| superclass |
	superclass := self make: [ :builder | 
		builder 
			superclass: Object;
			name: self aClassName ].

	self make: [ :builder | 
		builder 
			superclass: superclass;
			name: self anotherClassName ].

	self 
		should: [ 
			self make: [ :builder | 
				builder 
					layoutClass: VariableLayout;
					name: self aClassName ] ]
		raise: Error
		description: 'Old class builder raises: X cannot be recompiled'
! !

!SlotErrorsTest methodsFor: 'tests' stamp: 'MartinDias 8/7/2013 11:27'!
testIndirectCircularHierarchyError
	"Tests an error is raised when trying to create a heirarchy A<-B<-A"
	
	| classA classB |
	classA := self make: [ :builder |
			builder 
				superclass: Object;
				name: self aClassName ].

	classB := self make: [ :builder |
			builder 
				superclass: classA;
				name: self anotherClassName ].

	self should: [ 
		self make: [ :builder | 
			builder 
				superclass: classB;
				name: self aClassName ] ]
		raise: CircularHierarchyError ! !

!SlotErrorsTest methodsFor: 'tests' stamp: 'MartinDias 8/7/2013 11:28'!
testSlotDuplicationConflict

	aClass := self make: [ :builder | 
		builder slots: { #a } ].

	self should: [ 
		self make: [ :builder | 
			builder 
				superclass: aClass;
				name: self anotherClassName;
				slots: { #a } ] ]
		raise: DuplicatedSlotName ! !

!SlotErrorsTest methodsFor: 'tests' stamp: 'MarcusDenker 3/14/2015 08:39'!
testDangerousClassesEnabling

	| savedExistingSystemSetting myExpectedError |

	savedExistingSystemSetting := DangerousClassNotifier enabled.

	DangerousClassNotifier disable.
	self assert: DangerousClassNotifier enabled not.
	DangerousClassNotifier disableDuring: [
      self assert: DangerousClassNotifier enabled not].
	self assert: DangerousClassNotifier enabled not.

	DangerousClassNotifier enable.
	self assert: DangerousClassNotifier enabled.	
	DangerousClassNotifier disableDuring: [
      self assert: DangerousClassNotifier enabled not].
	self assert: DangerousClassNotifier enabled.

	DangerousClassNotifier enable.
	DangerousClassNotifier disableDuring: [
		self assert: (DangerousClassNotifier check: #ProtoObject)].
	myExpectedError := false.
	[ DangerousClassNotifier check: #ProtoObject ] on: Error do: [ myExpectedError := true  ].
	self assert: myExpectedError.

	savedExistingSystemSetting 
		ifTrue: [ DangerousClassNotifier enable ]
		ifFalse: [ DangerousClassNotifier disable ].
	self assert: DangerousClassNotifier enabled equals: savedExistingSystemSetting.
! !

!SlotErrorsTest methodsFor: 'tests' stamp: 'MartinDias 8/7/2013 11:27'!
testClassSlotWithReservedName

	#(#self #super #thisContext #true #false #nil) do: [:reservedName |
		self should: [ 
			self make: [ :builder | 
				builder classSlots: { reservedName } ] ]
			raise: InvalidSlotName ]! !

!SlotErrorsTest methodsFor: 'tests' stamp: 'MartinDias 8/7/2013 11:28'!
testValidateClassName		
		
	PharoClassInstaller 
		validateClassName: #GoodClassNameThatShouldNotExist! !

!SlotErrorsTest methodsFor: 'tests' stamp: 'MartinDias 8/7/2013 11:28'!
testSlotWithReservedName

	#(#self #super #thisContext #true #false #nil) do: [:reservedName |
		self should: [ 
			self make: [ :builder | 
				builder slots: { reservedName } ] ]
			raise: InvalidSlotName ]! !

!SlotErrorsTest methodsFor: 'tests' stamp: 'MartinDias 8/7/2013 11:28'!
testClassNameMustBeSymbol

	self assertInvalidClassName: 1! !

!SlotErrorsTest methodsFor: 'tests' stamp: 'MartinDias 8/7/2013 11:28'!
testClassSlotDuplicationConflict

	aClass := self make: [ :builder | 
		builder classSlots: { #a } ].

	self should: [ 
		self make: [ :builder | 
			builder 
				superclass: aClass;
				name: self anotherClassName;
				classSlots: { #a } ] ]
		raise: DuplicatedSlotName ! !

!SlotErrorsTest methodsFor: 'tests' stamp: 'MartinDias 8/7/2013 11:28'!
testClassNameMustBeCapitalized

	self assertInvalidClassName: #aNotCapitalizedClassName! !

!SlotExampleMovie commentStamp: 'JanVanDeSandt 2/27/2015 11:27'!
A SlotExampleMovie is an example class to demonstrate the workings of relation slots.!
!SlotExampleMovie methodsFor: 'accessing' stamp: 'JanVanDeSandt 2/20/2015 16:42'!
actors: anObject
	actors := anObject! !

!SlotExampleMovie methodsFor: 'initialization' stamp: 'JanVanDeSandt 2/20/2015 16:42'!
initialize
	super initialize.
	self class initializeSlots: self.! !

!SlotExampleMovie methodsFor: 'accessing' stamp: 'JanVanDeSandt 2/20/2015 16:42'!
name: anObject
	name := anObject! !

!SlotExampleMovie methodsFor: 'accessing' stamp: 'JanVanDeSandt 2/21/2015 16:11'!
director: aPerson

	director := aPerson! !

!SlotExampleMovie methodsFor: 'adding/removing' stamp: 'JanVanDeSandt 2/21/2015 19:50'!
addActor: aPerson

	^actors add: aPerson! !

!SlotExampleMovie methodsFor: 'adding/removing' stamp: 'JanVanDeSandt 2/21/2015 19:50'!
removeActor: aPerson

	^actors remove: aPerson! !

!SlotExampleMovie methodsFor: 'accessing' stamp: 'JanVanDeSandt 2/20/2015 16:42'!
director
	^ director! !

!SlotExampleMovie methodsFor: 'accessing' stamp: 'JanVanDeSandt 2/20/2015 16:42'!
name
	^ name! !

!SlotExampleMovie methodsFor: 'accessing' stamp: 'JanVanDeSandt 2/20/2015 16:42'!
actors
	^ actors! !

!SlotExampleMovie class methodsFor: 'instance creation' stamp: 'JanVanDeSandt 2/20/2015 17:03'!
named: aString

	^self new
		name: aString
		! !

!SlotExampleMovieAndPersonTest methodsFor: 'tests' stamp: 'JanVanDeSandt 2/21/2015 16:51'!
testNewMovie

	| movie |
	
	movie := SlotExampleMovie new.
	self assert: movie name isNil.
	self assert: movie director isNil.
	self assert: movie actors isCollection.
	self assert: movie actors isEmpty.! !

!SlotExampleMovieAndPersonTest methodsFor: 'tests' stamp: 'JanVanDeSandt 2/21/2015 17:24'!
testChangeMovieDirector

	| movie p1 p2 |
	
	movie := SlotExampleMovie named: 'Jaws'.
	p1 := SlotExamplePerson named: 'P1'.
	p2 := SlotExamplePerson named: 'P2'.
	
	movie director: p1.
	self assert: movie director equals: p1.
	self assert: p1 directedMovies anyOne equals: movie.
	self assert: p2 directedMovies isEmpty.
	
	movie director: p2.
	self assert: movie director equals: p2.
	self assert: p1 directedMovies isEmpty.
	self assert: p2 directedMovies anyOne equals: movie.! !

!SlotExampleMovieAndPersonTest methodsFor: 'tests' stamp: 'JanVanDeSandt 2/21/2015 17:14'!
testSetMovieDirector

	| movie person |
	
	movie := SlotExampleMovie named: 'Jaws'.
	person := SlotExamplePerson named: 'Peter'.
	
	movie director: person.
	self assert: movie director equals: person.
	self assert: person directedMovies size equals: 1.
	self assert: person directedMovies anyOne equals: movie.! !

!SlotExampleMovieAndPersonTest methodsFor: 'tests' stamp: 'JanVanDeSandt 2/21/2015 19:55'!
testAddActors

	| m1 m2 p1 p2 |
	
	m1 := SlotExampleMovie named: 'M1'.
	m2 := SlotExampleMovie named: 'M2'.
	p1 := SlotExamplePerson named: 'P1'.
	p2 := SlotExamplePerson named: 'P2'.
	
	m1 addActor: p1; addActor: p2.
	self assert: m1 actors size equals: 2.
	self assert: p1 actedInMovies size equals: 1.
	self assert: p1 actedInMovies anyOne equals: m1.
	self assert: p2 actedInMovies anyOne equals: m1.
	
	m2 addActor: p2.
	self assert: p2 actedInMovies size equals: 2.
! !

!SlotExampleMovieAndPersonTest methodsFor: 'tests' stamp: 'JanVanDeSandt 2/20/2015 17:00'!
testNewPerson

	| person |
	
	person := SlotExamplePerson new.
	self assert: person name isNil.
	self assert: person directedMovies isCollection.
	self assert: person directedMovies isEmpty.! !

!SlotExampleMovieAndPersonTest methodsFor: 'tests' stamp: 'JanVanDeSandt 2/21/2015 17:20'!
testSetAndRemoveMovieDirector

	| movie person |
	
	movie := SlotExampleMovie named: 'Jaws'.
	person := SlotExamplePerson named: 'Peter'.
	
	movie director: person.
	self assert: movie director equals: person.
	self assert: person directedMovies anyOne equals: movie.
	
	person directedMovies remove: movie.
	self assert: movie director isNil.
	self assert: person directedMovies isEmpty.	! !

!SlotExampleMovieAndPersonTest methodsFor: 'tests' stamp: 'JanVanDeSandt 2/21/2015 17:20'!
testSetAndUnsetMovieDirector

	| movie person |
	
	movie := SlotExampleMovie named: 'Jaws'.
	person := SlotExamplePerson named: 'Peter'.
	
	movie director: person.
	self assert: movie director equals: person.
	self assert: person directedMovies anyOne equals: movie.
	
	movie director: nil.
	self assert: movie director isNil.
	self assert: person directedMovies isEmpty.! !

!SlotExampleMovieAndPersonTest methodsFor: 'tests' stamp: 'JanVanDeSandt 2/21/2015 16:27'!
testSetMovieDirectorInvalid

	| movie |
	
	movie := SlotExampleMovie named: 'Jaws'.
	
	self should: [ movie director: 'not-a-person' ] raise: Error.
	self assert: movie director isNil! !

!SlotExampleMovieAndPersonTest methodsFor: 'tests' stamp: 'JanVanDeSandt 2/21/2015 20:00'!
testAddAndRemoveActors

	| m1 m2 p1 p2 |
	
	m1 := SlotExampleMovie named: 'M1'.
	m2 := SlotExampleMovie named: 'M2'.
	p1 := SlotExamplePerson named: 'P1'.
	p2 := SlotExamplePerson named: 'P2'.
	
	m1 addActor: p1; addActor: p2.
	m2 addActor: p2.

	m1 removeActor: p2.
	self assert: p2 actedInMovies size equals: 1.
	m2 removeActor: p2.
	self assert: p2 actedInMovies isEmpty.
	
	self should: [ m2 removeActor: p2 ] raise: Error! !

!SlotExampleMovieAndPersonTest methodsFor: 'tests' stamp: 'JanVanDeSandt 2/21/2015 19:47'!
testAddMovieDirectorInvalid

	| person |
	
	person := SlotExamplePerson named: 'Peter'.
	
	self should: [ person directedMovies add: 'not-a-movie' ] raise: Error! !

!SlotExampleMovieAndPersonTest methodsFor: 'tests' stamp: 'JanVanDeSandt 2/21/2015 19:45'!
testAddMovieDirectorTwice

	| movie person |
	
	movie := SlotExampleMovie named: 'Jaws'.
	person := SlotExamplePerson named: 'Peter'.
	
	person directedMovies add: movie; add: movie.
	self assert: movie director equals: person.
	self assert: person directedMovies size equals: 1.
	self assert: person directedMovies anyOne equals: movie.! !

!SlotExampleMovieAndPersonTest methodsFor: 'tests' stamp: 'JanVanDeSandt 2/21/2015 19:46'!
testSetMovieDirectorTwice

	| movie person |
	
	movie := SlotExampleMovie named: 'Jaws'.
	person := SlotExamplePerson named: 'Peter'.
	
	movie director: person; director: person.
	self assert: movie director equals: person.
	self assert: person directedMovies size equals: 1.
	self assert: person directedMovies anyOne equals: movie.! !

!SlotExampleMovieAndPersonTest methodsFor: 'tests' stamp: 'JanVanDeSandt 2/21/2015 17:26'!
testAddMovieDirector

	| movie person |
	
	movie := SlotExampleMovie named: 'Jaws'.
	person := SlotExamplePerson named: 'Peter'.
	
	person directedMovies add: movie.
	self assert: movie director equals: person.
	self assert: person directedMovies size equals: 1.
	self assert: person directedMovies anyOne equals: movie.! !

!SlotExamplePerson commentStamp: 'JanVanDeSandt 2/27/2015 11:27'!
A SlotExamplePerson is an example class to demonstrate the workings of relation slots.!
!SlotExamplePerson methodsFor: 'accessing' stamp: 'JanVanDeSandt 2/20/2015 17:00'!
actedInMovies
	^ actedInMovies! !

!SlotExamplePerson methodsFor: 'initialization' stamp: 'JanVanDeSandt 2/21/2015 19:41'!
initialize
	super initialize.
	self class initializeSlots: self.! !

!SlotExamplePerson methodsFor: 'accessing' stamp: 'JanVanDeSandt 2/20/2015 17:00'!
directedMovies: anObject
	directedMovies := anObject! !

!SlotExamplePerson methodsFor: 'accessing' stamp: 'JanVanDeSandt 2/20/2015 17:00'!
name: anObject
	name := anObject! !

!SlotExamplePerson methodsFor: 'accessing' stamp: 'JanVanDeSandt 2/20/2015 17:00'!
actedInMovies: anObject
	actedInMovies := anObject! !

!SlotExamplePerson methodsFor: 'accessing' stamp: 'JanVanDeSandt 2/20/2015 17:00'!
name
	
	^name! !

!SlotExamplePerson methodsFor: 'accessing' stamp: 'JanVanDeSandt 2/20/2015 17:00'!
directedMovies
	^ directedMovies! !

!SlotExamplePerson class methodsFor: 'instance creation' stamp: 'JanVanDeSandt 2/20/2015 17:03'!
named: aString

	^self new
		name: aString
		! !

!SlotExampleTest methodsFor: 'tests' stamp: 'MarcusDenker 3/19/2015 16:32'!
testExampleSlotWithDefaultValue
	| slot object|
	
	aClass := self make: [ :builder |
		builder 
			slots: {#slot1 => ExampleSlotWithDefaultValue default: 5  }
		].

	self assert: (aClass hasSlotNamed: #slot1).
	
	"test refletive write and read"
	slot := aClass slotNamed: #slot1.
	object := aClass new.

	self assert: (slot read: object) = 5.
	slot write: 10 to: object.
	self assert: (slot read: object) = 10.
	
	
	
	
	! !

!SlotExampleTest methodsFor: 'tests' stamp: 'MarcusDenker 3/21/2015 12:30'!
testExampleTwoSlotWithState
	" add two, remove one"
	aClass := self make: [ :builder |
		builder 
			slots: {#slot1 =>ExampleSlotWithState . #slot2 =>ExampleSlotWithState}
		].

	self assert: (aClass hasSlotNamed: #slot1).
	self assert: (aClass hasSlotNamed: #slot2).
	
	aClass := self make: [ :builder |
		builder 
			slots: {#slot2 =>ExampleSlotWithState}
		].
	self deny: (aClass hasSlotNamed: #slot1).
	self assert: (aClass hasSlotNamed: #slot2).! !

!SlotExampleTest methodsFor: 'tests' stamp: 'MarcusDenker 3/19/2015 16:31'!
testAccessorInstanceVariableSlot
	| slot object |
	
	aClass := self make: [ :builder |
		builder 
			slots: {#slot1 =>AccessorInstanceVariableSlot  }
		].

	self assert: (aClass hasSlotNamed: #slot1).
	
	"test refletive write and read"
	slot := aClass slotNamed: #slot1.
	object := aClass new.
	slot write: 5 to: object.
	self assert: (slot read: object) = 5.
	
	"test generated accessors"
	object slot1: 10.
	self assert: object slot1 = 10.
	
	
	
	
	! !

!SlotExampleTest methodsFor: 'tests' stamp: 'MarcusDenker 3/21/2015 12:32'!
testExampleClassSide
	" can we install a slot on the class side?"
	aClass := self make: [ :builder |
		builder 
			classSlots: {#slot1 =>ExampleSlotWithState}
		].

	self assert: (aClass class hasSlotNamed: #slot1).
	self assert: aClass class slotDefinitionString =  '{ #slot1 => ExampleSlotWithState }'.! !

!SlotExampleTest methodsFor: 'tests' stamp: 'MarcusDenker 3/19/2015 16:27'!
testExampleSlotWithState
	| slot reader writer |
	
	aClass := self make: [ :builder |
		builder 
			slots: {#slot1 =>ExampleSlotWithState  }
		].

	self assert: (aClass hasSlotNamed: #slot1).
	
	"test refletive write and read"
	slot := aClass slotNamed: #slot1.
	slot write: 5 to: aClass new.
	self assert: (slot read: aClass new) = 5.
	
	"compiled accessors to test code gen"
	reader := String streamContents: [ :str |
		str 
			nextPutAll: slot name;
			cr;tab;
			nextPutAll: ' ^';
			nextPutAll: slot name.
		 ].
	writer := String streamContents: [ :str |
		str 
			nextPutAll: slot name;
			nextPutAll: ': anObject';
			cr;tab;
			nextPutAll: slot name;
			nextPutAll: ':= anObject.'.
		].
	aClass compile: reader classified: 'accessing'.
	aClass compile: writer classified: 'accessing'.
	
	aClass new slot1: 10.
	self assert: aClass new slot1 = 10.
	
	
	
	
	! !

!SlotExampleTest methodsFor: 'tests' stamp: 'MartinDias 8/7/2013 11:46'!
testPharoClassInstallerExample
	| newClass |
	[ 
		newClass := PharoClassInstaller example.
		self assert: newClass isBehavior.
	] ensure: [ 
		newClass removeFromSystem ].! !

!SlotIntegrationTest commentStamp: '<historical>'!
I'm a test case of SlotClassBuilder integration in the system. Tipically, my tests assert over Class API.!
!SlotIntegrationTest methodsFor: 'tests' stamp: 'MartinDias 4/28/2014 16:10'!
testSlotScopeParallelism
	"Proposed by Camille Teruel"

	| classesAndMetaclasses candidates classWithWrongSlotScope |
	classesAndMetaclasses := Smalltalk allClasses flatCollect: [ :each | { each. each class } ].

	candidates := classesAndMetaclasses reject: [ :each | 
		each superclass isNil or: [ 
			each layout slotScope isKindOf: LayoutEmptyScope ] ].

	classWithWrongSlotScope := candidates reject: [ :each | 
		each superclass layout slotScope == each layout slotScope parentScope ].

	self assert: classWithWrongSlotScope asArray equals: #()! !

!SlotIntegrationTest methodsFor: 'tests' stamp: 'MartinDias 8/7/2013 11:24'!
testCompiledMethodLayout
	self assert: (CompiledMethod layout isKindOf: CompiledMethodLayout).! !

!SlotIntegrationTest methodsFor: 'tests' stamp: 'MartinDias 8/7/2013 11:24'!
testAddInstVarNamed
	"Add instance variables using the builder interface"
	
	aClass := self make: [ :builder |
		builder 
			name: self aClassName;
			slots: #( x )
		].

	self assert: aClass instVarNames = #(x).	


	anotherClass := self make: [ :builder |
		builder 
			superclass: aClass;
			name: self anotherClassName;
			slots: #( y )
		].
	
	self assert: anotherClass instVarNames = #(y).! !

!SlotIntegrationTest methodsFor: 'tests' stamp: 'MartinDias 8/7/2013 11:24'!
testReshapeClassPropagatesToDeepHierarchyClassInterface
	"Test reshaping a class which is head of a hierarchy of 4 levels"
	
	"level 1"
	aClass := Object
		subclass: self aClassName 
		instanceVariableNames: '' 
		classVariableNames: '' 
		poolDictionaries: '' 
		category: self aCategory.

	self assert: aClass subclasses isEmpty.
	aClass layout checkIntegrity.

	"level 2"
	anotherClass := aClass
		subclass: self anotherClassName 
		instanceVariableNames: '' 
		classVariableNames: '' 
		poolDictionaries: '' 
		category: self aCategory.
	
	self assert: aClass subclasses equals: { anotherClass }.
	self assert: anotherClass subclasses isEmpty.
	aClass layout checkIntegrity.
	anotherClass layout checkIntegrity.

	"level 3"
	yetAnotherClass := anotherClass
		subclass: self yetAnotherClassName 
		instanceVariableNames: '' 
		classVariableNames: '' 
		poolDictionaries: '' 
		category: self aCategory.

	self assert: aClass subclasses equals: { anotherClass }.
	self assert: anotherClass subclasses equals: { yetAnotherClass }.
	self assert: yetAnotherClass subclasses isEmpty.
	aClass layout checkIntegrity.
	anotherClass layout checkIntegrity.
	yetAnotherClass layout checkIntegrity.

	"level 4"
	yetYetAnotherClass := yetAnotherClass
		subclass: self yetYetAnotherClassName 
		instanceVariableNames: '' 
		classVariableNames: '' 
		poolDictionaries: '' 
		category: self aCategory.

	self assert: aClass subclasses equals: { anotherClass }.
	self assert: anotherClass subclasses equals: { yetAnotherClass }.
	self assert: yetAnotherClass subclasses equals: { yetYetAnotherClass }.
	self assert: yetYetAnotherClass subclasses isEmpty.
	aClass layout checkIntegrity.
	anotherClass layout checkIntegrity.
	yetAnotherClass layout checkIntegrity.
	yetYetAnotherClass layout checkIntegrity.

	"reshape level 1"
	aClass := Object
		subclass: self aClassName 
		instanceVariableNames: 'x' 
		classVariableNames: '' 
		poolDictionaries: '' 
		category: self aCategory.

	self assert: aClass instVarNames equals: #(x).
	aClass layout checkIntegrity.
	anotherClass layout checkIntegrity.
	yetAnotherClass layout checkIntegrity.
	yetYetAnotherClass layout checkIntegrity.! !

!SlotIntegrationTest methodsFor: 'tests' stamp: 'MarcusDenker 2/19/2015 15:12'!
testAnonymousSubclass
	
	aClass := self make: [ :builder |
		builder 
			name: self aClassName;
			slots: #(x)
		].

	anotherClass := aClass newAnonymousSubclass.
	self deny: anotherClass == aClass.
	self assert: anotherClass isBehavior.
	self assert: anotherClass superclass == aClass.
	self deny: anotherClass name = aClass name.
	self assert: anotherClass allInstVarNames = #(x)! !

!SlotIntegrationTest methodsFor: 'tests' stamp: 'MartinDias 8/7/2013 11:24'!
testAddInstVarNamedClassInterface

	"Add instance variables using the class interface"
	
	aClass := self make: [ :builder |
		builder name: self aClassName 
		].
	aClass addInstVarNamed: 'x'.

	self assert: aClass instVarNames = #(x).	


	anotherClass := self make: [ :builder |
		builder 
			superclass: aClass;
			name: self anotherClassName.
		].
	anotherClass addInstVarNamed: 'y'.
	
	self assert: anotherClass instVarNames = #(y).! !

!SlotIntegrationTest methodsFor: 'tests' stamp: 'VincentBlondeau 3/6/2015 16:40'!
testAddAndAddInstVarNamedWithTrait2
	"Add instance variables using the builder interface"
	
	aClass := self make: [ :builder |
		builder 
			name: self aClassName;
			traitComposition: TOne;
			slots: #( x )
		].

	self assertTraitIntegrity.
	self assert: aClass instVarNames equals: #(x).
	
	self assert: TOne traitUsers asArray equals: { aClass }.
	
	self assert: (aClass canUnderstand: #one).
	self assert: aClass new one equals: 1.

	aClass addInstVarNamed: #y.
	self assertTraitIntegrity.
	aClass addInstVarNamed: #z.
	
	self assert: aClass instVarNames equals: #(x y z).
	
	self assert: TOne traitUsers asArray equals: { aClass }.
	
	self assert: (aClass canUnderstand: #one).
	self assert: aClass new one equals: 1.! !

!SlotIntegrationTest methodsFor: 'tests-compact index' stamp: 'MartinDias 12/9/2013 11:38'!
testBecomeCompactAndUncompact

	| originalCompactClassesArray |
	aClass := self makeWithLayout: FixedLayout.	
	self assert: aClass indexIfCompact equals: 0.
	originalCompactClassesArray := Smalltalk compactClassesArray copy.

	[ 
		
	"The class becomes compact, so we are not in the original state."	
	aClass becomeCompact.
	self assert: aClass indexIfCompact > 0.
	self deny: Smalltalk compactClassesArray = originalCompactClassesArray. 
	
	] ensure: [ 

	"The class becomes uncompact, so we are back in the original state."
	aClass becomeUncompact.
	self assert: aClass indexIfCompact equals: 0. 
	self assert: Smalltalk compactClassesArray equals: originalCompactClassesArray. 
	
	].

! !

!SlotIntegrationTest methodsFor: 'tests' stamp: 'MarcusDenker 10/9/2014 13:53'!
testCopyPreservesLayout
	aClass := self makeWithLayout: FixedLayout.
	anotherClass := aClass copy.
	self deny: anotherClass layout isNil.
	self deny: anotherClass layout == aClass layout.
	self assert: aClass layout host == aClass.
	self assert: anotherClass layout host == anotherClass! !

!SlotIntegrationTest methodsFor: 'tests' stamp: 'MartinDias 2/10/2015 17:03'!
testSlotNamedIfFoundIfNone

	aClass := self make: [ :builder |
		builder 
			name: self aClassName;
			slots: #(a) 
		].

	self 
		assert: (aClass slotNamed: 'a' ifFound: [ #found ] ifNone: [ #none ])
		equals: #found.

	self 
		assert: (aClass slotNamed: 'b' ifFound: [ #found ] ifNone: [ #none ])
		equals: #none.
! !

!SlotIntegrationTest methodsFor: 'tests' stamp: 'MartinDias 8/7/2013 14:05'!
testReshapeClassWithClassSlot
	
	aClass := 
		Object 
			subclass: self aClassName 
			instanceVariableNames: '' 
			classVariableNames: '' 
			poolDictionaries: ''
			category: self aCategory.	
	aClass class 
		instanceVariableNames: #x.
	
	self assert: aClass class instVarNames equals: #(x).
	
	aClass := 
		Object 
			subclass: self aClassName 
			instanceVariableNames: 'a' 
			classVariableNames: '' 
			poolDictionaries: ''
			category: self aCategory.	

	self assert: aClass class instVarNames equals: #(x).! !

!SlotIntegrationTest methodsFor: 'tests' stamp: 'VincentBlondeau 3/6/2015 16:38'!
testAddInstVarNamedWithTrait2
	"Add instance variables using the builder interface"
	
	aClass := self make: [ :builder |
		builder 
			name: self aClassName;
			traitComposition: TOne;
			slots: #( x )
		].

	self assertTraitIntegrity.
	self assert: aClass instVarNames equals: #(x).
	
	self assert: TOne traitUsers asArray equals: { aClass }.
	
	self assert: (aClass canUnderstand: #one).
	self assert: aClass new one equals: 1.

	aClass addInstVarNamed: #y.
	
	self assertTraitIntegrity.
	self assert: aClass instVarNames = #(x y).
	
	self assert: TOne traitUsers asArray equals: { aClass }.
	
	self assert: (aClass canUnderstand: #one).
	self assert: aClass new one equals: 1.! !

!SlotIntegrationTest methodsFor: 'tests' stamp: 'VincentBlondeau 3/6/2015 16:38'!
testAddInstVarNamedWithTrait
	"Add instance variables using the builder interface"
	
	aClass := self make: [ :builder |
		builder 
			name: self aClassName;
			traitComposition: TOne;
			slots: #( x )
		].
	self assertTraitIntegrity.
	self assert: aClass instVarNames equals: #(x).
	
	self assert: TOne traitUsers asArray equals: { aClass }.
	
	self assert: (aClass canUnderstand: #one).
	self assert: aClass new one equals: 1.

	aClass :=  self make: [ :builder |
		builder 
			name: self aClassName;
			traitComposition: TOne;
			slots: #( x y )].
		
	self assertTraitIntegrity.
	self assert: aClass instVarNames = #(x y).
	
	self assert: TOne traitUsers asArray equals: { aClass }.
	
	self assert: (aClass canUnderstand: #one).
	self assert: aClass new one equals: 1.! !

!SlotIntegrationTest methodsFor: 'tests' stamp: 'VincentBlondeau 3/6/2015 16:38'!
testAddAndRemoveInstVarNamedWithTrait2
	"Add instance variables using the builder interface"
	
	aClass := self make: [ :builder |
		builder 
			name: self aClassName;
			traitComposition: TOne;
			slots: #( x )
		].
	
	self assertTraitIntegrity.
	self assert: aClass instVarNames equals: #(x).
	
	self assert: TOne traitUsers asArray equals: { aClass }.
	
	self assert: (aClass canUnderstand: #one).
	self assert: aClass new one equals: 1.

	aClass addInstVarNamed: #y.
	self assertTraitIntegrity.
	aClass	removeInstVarNamed: #x.
	
	self assert: aClass instVarNames equals: #(y).
	
	self assert: TOne traitUsers asArray equals: { aClass }.
	
	self assert: (aClass canUnderstand: #one).
	self assert: aClass new one equals: 1.! !

!SlotIntegrationTest methodsFor: 'tests' stamp: 'MartinDias 2/10/2015 17:02'!
testRemoveInstVarNamed

	| answer |

	aClass := self make: [ :builder |
		builder 
			name: self aClassName;
			slots: #(a) 
		].

	answer := 
		aClass 
			slotNamed: 'a' 
			ifFound: [ #found ] 
			ifNone: [ #none ].
	self assert: answer equals: #found.

	answer := 
		aClass 
			slotNamed: 'b' 
			ifFound: [ #found ] 
			ifNone: [ #none ].
	self assert: answer equals: #none.
! !

!SlotIntegrationTest methodsFor: 'tests' stamp: 'VincentBlondeau 3/6/2015 16:38'!
testRemoveInstVarNamedWithTrait2
	"Add instance variables using the builder interface"
	
	aClass := self make: [ :builder |
		builder 
			name: self aClassName;
			traitComposition: TOne;
			slots: #( x )
		].

	self assert: aClass instVarNames equals: #(x).
	
	self assert: TOne traitUsers asArray equals: { aClass }.
	
	self assert: (aClass canUnderstand: #one).
	self assert: aClass new one equals: 1.

	aClass removeInstVarNamed: #x.
	
	self assert: aClass instVarNames isEmpty.
	
	self assert: TOne traitUsers asArray equals: { aClass }.
	
	self assert: (aClass canUnderstand: #one).
	self assert: aClass new one equals: 1.! !

!SlotIntegrationTest methodsFor: 'tests' stamp: 'MartinDias 8/7/2013 11:24'!
testSmallIntegerLayout
	self assert: (SmallInteger layout isKindOf: SmallIntegerLayout).! !

!SlotIntegrationTest methodsFor: 'tests-compact index' stamp: 'MarcusDenker 3/14/2015 08:39'!
testReshapeCompactClass

	aClass := self make: [ :builder |
		builder name: self aClassName ].
	
	self assert: aClass indexIfCompact equals: 0.

	[ 
	aClass becomeCompact.

	self assert: aClass indexIfCompact > 0.
	
	DangerousClassNotifier disableDuring: [
		aClass := self make: [ :builder |
			builder name: self aClassName;
			slots:#(x) ]].

	self assert: aClass indexIfCompact > 0 
	
	] ensure: [ aClass becomeUncompact ].

	self assert: aClass indexIfCompact equals: 0.
! !

!SlotIntegrationTest methodsFor: 'tests' stamp: 'MartinDias 8/7/2013 11:24'!
testRemoveInstVarNamedClassInterface

	aClass := self make: [ :builder |
		builder 
			name: self aClassName;
			slots: #(x y z) 
		].
	aClass removeInstVarNamed: #y.

	self assert: aClass instVarNames = #(x z).! !

!SlotLayoutEqualityTest methodsFor: 'tests' stamp: 'MartinDias 8/7/2013 11:30'!
testLayoutNotEquals
 
	self layoutClasses do: [:aLayoutClass |
		(self layoutClasses copyWithout: aLayoutClass) do: [:anotherLayoutClass |
			self 
				assertClassBuiltWith: [:builder | builder layoutClass: aLayoutClass ] 
				isNotEqualToClassBuiltWith: [:builder | builder layoutClass: anotherLayoutClass ]]]! !

!SlotLayoutEqualityTest methodsFor: 'helpers' stamp: 'MartinDias 8/7/2013 11:54'!
assertClassBuiltWith: blockToBuildAClass isNotEqualToClassBuiltWith: blockToBuildAnotherClass
		
	aClass := self make: [ :builder | 
		builder 
			name: self aClassName;
			in: blockToBuildAClass ].
		
	anotherClass := self make: [ :builder | 
		builder 
			name: self anotherClassName;
			in: blockToBuildAnotherClass ].
	
	self assert: aClass layout ~= anotherClass layout.
	self assert: aClass layout hash ~= anotherClass layout hash.! !

!SlotLayoutEqualityTest methodsFor: 'tests' stamp: 'MartinDias 8/7/2013 11:30'!
testLayoutWithSlotsEquals

	self layoutClassesWithSlots do: [:aLayoutClass |
		self 
			assertClassBuiltWith: [:builder | 
				builder 
					layoutClass: aLayoutClass;
					slots: { #field1}  ]
			isEqualToClassBuiltWith: [:builder | 
				builder 
					layoutClass: aLayoutClass;
					slots: { #field1}  ].]! !

!SlotLayoutEqualityTest methodsFor: 'tests' stamp: 'MartinDias 8/7/2013 11:30'!
testLayoutWithSlotsNotEquals

	self layoutClassesWithSlots do: [:aLayoutClass |
		self 
			assertClassBuiltWith: [:builder | 
				builder 
					layoutClass: aLayoutClass;
					slots: { #field1}  ]
			isNotEqualToClassBuiltWith: [:builder | 
				builder 
					layoutClass: aLayoutClass;
					slots: { #field2}  ]]! !

!SlotLayoutEqualityTest methodsFor: 'helpers' stamp: 'MartinDias 8/7/2013 11:54'!
assertClassBuiltWith: blockToBuildAClass isEqualToClassBuiltWith: blockToBuildAnotherClass
	
	aClass := self make: [ :builder | 
		builder 
			name: self aClassName;
			in: blockToBuildAClass ].
		
	anotherClass := self make: [ :builder | 
		builder 
			name: self anotherClassName;
			in: blockToBuildAnotherClass ].
	
	self assert: aClass layout equals: aClass layout.	
	self assert: aClass layout equals: anotherClass layout.
	self assert: aClass layout hash equals: anotherClass layout hash.! !

!SlotLayoutEqualityTest methodsFor: 'tests' stamp: 'MartinDias 8/7/2013 11:30'!
testLayoutEquals

	self layoutClasses do: [:aLayoutClass |
		self 
			assertClassBuiltWith: [:builder | builder layoutClass: aLayoutClass ] 
			isEqualToClassBuiltWith: [:builder | builder layoutClass: aLayoutClass ] ]! !

!SlotLayoutExtensionTest methodsFor: 'tests-valid extensions' stamp: 'MartinDias 8/7/2013 11:36'!
testVariableCanExtendVariable

	self should: [ :builder | 
			builder layoutClass: VariableLayout ]
		extendWith: [ :builder | 
			builder layoutClass: VariableLayout ]! !

!SlotLayoutExtensionTest methodsFor: 'tests-invalid extensions' stamp: 'MartinDias 8/7/2013 11:36'!
testWordCannotExtendByte

	self shouldnt: [ :builder | 
			builder layoutClass: ByteLayout ]
		extendWith: [ :builder | 
			builder layoutClass: WordLayout ]! !

!SlotLayoutExtensionTest methodsFor: 'tests-invalid extensions' stamp: 'MartinDias 8/7/2013 11:36'!
testByteCannotExtendWord

	self shouldnt: [ :builder | 
			builder layoutClass: WordLayout ]
		extendWith: [ :builder | 
			builder layoutClass: ByteLayout ]! !

!SlotLayoutExtensionTest methodsFor: 'tests-valid extensions' stamp: 'MartinDias 8/7/2013 11:36'!
testWordCanExtendWord

	self should: [ :builder | 
			builder layoutClass: WordLayout ]
		extendWith: [ :builder | 
			builder layoutClass: WordLayout ]! !

!SlotLayoutExtensionTest methodsFor: 'tests-valid extensions' stamp: 'MartinDias 12/9/2013 11:38'!
testVariableCanExtendPointer

	self should: [ :builder | 
			builder layoutClass: FixedLayout ]
		extendWith: [ :builder | 
			builder layoutClass: VariableLayout ]! !

!SlotLayoutExtensionTest methodsFor: 'tests-valid extensions' stamp: 'MartinDias 8/7/2013 11:36'!
testByteCanExtendByte

	self should: [ :builder | 
			builder layoutClass: ByteLayout ]
		extendWith: [ :builder | 
			builder layoutClass: ByteLayout ]! !

!SlotLayoutExtensionTest methodsFor: 'tests-invalid extensions' stamp: 'MartinDias 12/9/2013 11:38'!
testPointerCannotExtendWord

	self shouldnt: [ :builder | 
			builder layoutClass: WordLayout ]
		extendWith: [ :builder | 
			builder layoutClass: FixedLayout ]! !

!SlotLayoutExtensionTest methodsFor: 'tests-invalid extensions' stamp: 'MartinDias 12/9/2013 11:38'!
testWordCannotExtendPointerWithFields

	self shouldnt: [ :builder | 
			builder 
				layoutClass: FixedLayout;
				slots: { #a } ]
		extendWith: [ :builder | 
			builder layoutClass: WordLayout ]! !

!SlotLayoutExtensionTest methodsFor: 'tests-invalid extensions' stamp: 'MartinDias 12/9/2013 11:38'!
testByteCannotExtendPointerWithFields

	self shouldnt: [ :builder | 
			builder 
				layoutClass: FixedLayout;
				slots: { #a }. ]
		extendWith: [ :builder | 
			builder layoutClass: ByteLayout ]! !

!SlotLayoutExtensionTest methodsFor: 'tests-invalid extensions' stamp: 'MartinDias 8/7/2013 11:36'!
testInstanceVariableNamesMetaclassInterface
	"Add instance variables using the Metaclass interface"
	
	aClass := self make: [ :builder |
		builder name: self aClassName ].
	aClass class instanceVariableNames: 'x'.

	self assert: aClass class instVarNames equals: #(x).	

	anotherClass := self make: [ :builder |
		builder 
			superclass: aClass;
			name: self anotherClassName ].
	anotherClass class instanceVariableNames: 'y'.
	
	self assert: anotherClass class instVarNames equals: #(y).	
	self assert: (anotherClass class allInstVarNames includesAll: #(x y)).! !

!SlotLayoutExtensionTest methodsFor: 'tests-valid extensions' stamp: 'MartinDias 12/9/2013 11:38'!
testPointerCanExtendPointer

	self should: [ :builder | 
			builder layoutClass: FixedLayout ]
		extendWith: [ :builder | 
			builder layoutClass: FixedLayout ]! !

!SlotLayoutExtensionTest methodsFor: 'tests-invalid extensions' stamp: 'MartinDias 8/7/2013 11:36'!
testVariableCannotExtendByte

	self shouldnt: [ :builder | 
			builder layoutClass: ByteLayout ]
		extendWith: [ :builder | 
			builder layoutClass: VariableLayout ]! !

!SlotLayoutExtensionTest methodsFor: 'helpers' stamp: 'MartinDias 8/7/2013 11:54'!
shouldnt: superclassBlock extendWith: subclassBlock

	| superclass |
	superclass := self make: superclassBlock.

	self should: [
		self make: [ :builder | 
			builder 
				superclass: superclass;
				name: self anotherClassName;
				in: subclassBlock ] ]
		raise: IncompatibleLayoutConflict! !

!SlotLayoutExtensionTest methodsFor: 'tests-valid extensions' stamp: 'MartinDias 12/9/2013 11:38'!
testPointerCanExtendVariable

	self should: [ :builder | 
			builder layoutClass: VariableLayout ]
		extendWith: [ :builder | 
			builder layoutClass: FixedLayout ]! !

!SlotLayoutExtensionTest methodsFor: 'tests-invalid extensions' stamp: 'MartinDias 12/9/2013 11:38'!
testPointerCannotExtendByte

	self shouldnt: [ :builder | 
			builder layoutClass: ByteLayout ]
		extendWith: [ :builder | 
			builder layoutClass: FixedLayout ]! !

!SlotLayoutExtensionTest methodsFor: 'tests-invalid extensions' stamp: 'MartinDias 8/7/2013 11:36'!
testVariableCannotExtendWord

	self shouldnt: [ :builder | 
			builder layoutClass: WordLayout ]
		extendWith: [ :builder | 
			builder layoutClass: VariableLayout ]! !

!SlotLayoutExtensionTest methodsFor: 'tests-valid extensions' stamp: 'MartinDias 8/7/2013 11:36'!
testCompiledMethodCanBeExtended

	self should: [ :builder | 
			builder layoutClass: CompiledMethodLayout ]
		extendWith: [ :builder | 
			builder layoutClass: CompiledMethodLayout ]! !

!SlotLayoutExtensionTest methodsFor: 'helpers' stamp: 'MartinDias 8/7/2013 11:55'!
should: superclassBlock extendWith: subclassBlock

	| superclass |
	superclass := self make: superclassBlock.

	self make: [ :builder | 
		builder 
			superclass: superclass;
			name: self anotherClassName;
			in: subclassBlock ]! !

!SlotLayoutExtensionTest methodsFor: 'tests-valid extensions' stamp: 'MartinDias 8/7/2013 11:36'!
testPointerWithVariableExtensionIsNowVariable
	"This test case reproduces a real bug."

	| superclass subclass |
	superclass := self make: [ :builder | 
		builder 
			superclass: Object;
			name: self aClassName ].

	subclass := self make: [ :builder | 
		builder 
			superclass: superclass;
			layoutClass: VariableLayout;
			name: self anotherClassName ].

	superclass := self make: [ :builder | 
		builder layoutClass: VariableLayout ].

	self assert: superclass isVariable.
	self assert: subclass isVariable.! !

!SlotMethodRecompilationTest methodsFor: 'tests' stamp: 'CamilleTeruel 12/18/2013 13:56'!
reshapeClass
	^ class := self make: [ :builder | builder slots: #(#iv) ]! !

!SlotMethodRecompilationTest methodsFor: 'tests' stamp: 'CamilleTeruel 12/18/2013 13:56'!
testClassReshapeShouldKeepClassBinding
	"Check that when a class is reshaped, the recompilation of the methods gives correct class bindings (in the literal array of the methods)"

	self reshapeClass.
	self assert: self methodBinding == class binding! !

!SlotMethodRecompilationTest methodsFor: 'accessing' stamp: 'CamilleTeruel 12/18/2013 13:50'!
traitMethod
	^ class >> #one! !

!SlotMethodRecompilationTest methodsFor: 'accessing' stamp: 'CamilleTeruel 12/18/2013 13:14'!
method
	^ class >> #m1! !

!SlotMethodRecompilationTest methodsFor: 'tests' stamp: 'CamilleTeruel 12/18/2013 13:58'!
testTraitMethodClassBindingShouldBeClassBinding
	"A method should have the same binding than its class even if it come from a trait"
	self assert: (self traitMethodBinding == class binding).
	
	! !

!SlotMethodRecompilationTest methodsFor: 'accessing' stamp: 'CamilleTeruel 12/18/2013 13:15'!
methodBinding
	^ self method classBinding! !

!SlotMethodRecompilationTest methodsFor: 'tests' stamp: 'CamilleTeruel 12/18/2013 13:15'!
testMethodClassBindingShouldBeClassBinding
	"A method should have the same binding than its class"
	self assert: (self methodBinding == class binding).
	
	! !

!SlotMethodRecompilationTest methodsFor: 'accessing' stamp: 'CamilleTeruel 12/18/2013 13:49'!
traitMethodBinding
	^ self traitMethod classBinding! !

!SlotMethodRecompilationTest methodsFor: 'tests' stamp: 'CamilleTeruel 12/18/2013 13:58'!
testClassReshapeShouldKeepClassBindingForTraitMethods
	"A method should have the same binding than its class even if it come from a trait"
	self reshapeClass.
	self assert: (self traitMethodBinding == class binding).
	
	! !

!SlotMethodRecompilationTest methodsFor: 'running' stamp: 'CamilleTeruel 12/18/2013 13:49'!
setUp
	class := self make: [ :builder |
		builder traitComposition: TOne ].
	class compile: 'm1'.
	! !

!SlotMigrationTest methodsFor: 'tests' stamp: 'MartinDias 12/9/2013 11:38'!
testSwitchSlotsAndMigrate

	aClass := self makeWithLayout: FixedLayout andSlots: { #a. #b }.
	aClass 
		compile: 'a ^a';
		compile: 'b ^b'.

	instance := aClass new.
	instance instVarNamed: #a put: $A.
	instance instVarNamed: #b put: $B.

	"now we switch the slots. The class definition should've changed"
	self makeWithLayout: FixedLayout andSlots: { #b. #a }.

	self assert: (instance instVarAt: 1) equals: $B.
	self assert: (instance instVarAt: 2) equals: $A.
	
	self assert: (instance instVarNamed: #a) equals: $A.
	self assert: (instance instVarNamed: #b) equals: $B.

	"it should have migrated methods"
	self assert: instance a equals: $A.
	self assert: instance b equals: $B.
	aClass layout checkIntegrity.! !

!SlotMigrationTest methodsFor: 'tests' stamp: 'MartinDias 12/9/2013 11:38'!
testReshapePointerToByteVariablePropagatesToDeepHierarchy

	"create the original hierarchy"
	aClass := self make: [ :builder |
		builder 
			name: self aClassName;
			superclass: Object;
			layoutClass: FixedLayout ]. 

	anotherClass := self make: [ :builder |
		builder 
			name:self anotherClassName;
			superclass: aClass;
			layoutClass: FixedLayout ].

	yetAnotherClass := self make: [ :builder |
		builder 
			name:self yetAnotherClassName;
			superclass: anotherClass;
			layoutClass: FixedLayout ].

	yetYetAnotherClass := self make: [ :builder |
		builder 
			name:self yetYetAnotherClassName;
			superclass: yetAnotherClass;
			layoutClass: FixedLayout ].

	"all the classes in the hierarchy should be of type fixed pointers"
	{ aClass. anotherClass. yetAnotherClass. yetYetAnotherClass } do: [ :each | 
		each layout checkIntegrity.
		self assert: each isFixed.
		self assert: each isPointers. ].
	
	"change the top superclass"	
	aClass := self make: [ :builder |
		builder 
			name: self aClassName;
			superclass: Object;
			layoutClass: ByteLayout ]. 

	"all the classes in the hierarchy should be reshaped as fixed"
	{ aClass. anotherClass. yetAnotherClass. yetYetAnotherClass } do: [ :each | 
		each layout checkIntegrity.
		self assert: each isVariable description: each name, ' was not reshaped.'.
		self assert: each isBytes description: each name, ' was not reshaped.' ].! !

!SlotMigrationTest methodsFor: 'tests' stamp: 'MartinDias 12/9/2013 11:38'!
testShiftSlotAndMigrate

	aClass := self makeWithLayout: FixedLayout andSlots: { #a. #c }.
	aClass compile: 'a ^a'.
	aClass compile: 'c ^c'.
	
	instance := aClass new.
	instance instVarNamed: #a put: 1.
	instance instVarNamed: #c put: 3.

	"now we extend it with slots.  The class definition should've changed"
	self makeWithLayout: FixedLayout andSlots: { #a. #b. #c }.

	"it should have added an instance variable with nil in the middle"
	self assert: (instance instVarAt: 1) equals: 1.
	self assert: (instance instVarAt: 2) equals: nil.
	self assert: (instance instVarAt: 3) equals: 3.
	
	self assert: (instance instVarNamed: #a) equals: 1.
	self assert: (instance instVarNamed: #b) equals: nil.
	self assert: (instance instVarNamed: #c) equals: 3.
	
	"it should have migrated methods"
	self assert: instance a equals: 1.
	self assert: instance c equals: 3.
	aClass layout checkIntegrity.! !

!SlotMigrationTest methodsFor: 'tests' stamp: 'MarcusDenker 2/13/2015 16:13'!
testAddTestSlot
	"We create a class without slots and create an instance; then we add a slot and check the instance can hold a value."
	aClass := self makeWithLayout: FixedLayout andSlots: { #aSlot }.
	
	instance := aClass new.
	instance instVarAt: 1 put: 125.
	"now we extend it with a test slots.  The class definition should've changed"
	self makeWithLayout: FixedLayout andSlots: {#anotherSlot => ExampleSlotWithState. #aSlot. }.
	
	"It should not have move the first instance as TestSlot size = 0"
	self assert: (instance instVarAt: 1) equals: 125.
	aClass layout checkIntegrity.! !

!SlotMigrationTest methodsFor: 'tests' stamp: 'MartinDias 8/7/2013 11:30'!
testReshapeClassPropagatesToDeepHierarchy
	"Test reshaping a class which is head of a hierarchy of 4 levels"
	
	"level 1"
	aClass := self make: [ :builder |
		builder name: self aClassName ].

	self assert: aClass subclasses isEmpty.
	aClass layout checkIntegrity.

	"level 2"
	anotherClass := self make: [ :builder |
		builder 
			superclass: aClass;
			name: self anotherClassName ].
	
	self assert: aClass subclasses equals: { anotherClass }.
	self assert: anotherClass subclasses isEmpty.
	aClass layout checkIntegrity.
	anotherClass layout checkIntegrity.

	"level 3"
	yetAnotherClass := self make: [ :builder |
		builder 
			superclass: anotherClass;
			name: self yetAnotherClassName ].

	self assert: aClass subclasses equals: { anotherClass }.
	self assert: anotherClass subclasses equals: { yetAnotherClass }.
	self assert: yetAnotherClass subclasses isEmpty.
	aClass layout checkIntegrity.
	anotherClass layout checkIntegrity.
	yetAnotherClass layout checkIntegrity.

	"level 4"
	yetYetAnotherClass := self make: [ :builder |
		builder 
			superclass: yetAnotherClass;
			name: self yetYetAnotherClassName ].


	self assert: aClass subclasses equals: { anotherClass }.
	self assert: anotherClass subclasses equals: { yetAnotherClass }.
	self assert: yetAnotherClass subclasses equals: { yetYetAnotherClass }.
	self assert: yetYetAnotherClass subclasses isEmpty.
	aClass layout checkIntegrity.
	anotherClass layout checkIntegrity.
	yetAnotherClass layout checkIntegrity.
	yetYetAnotherClass layout checkIntegrity.

	"reshape level 1"
	aClass := self make: [ :builder |
		builder 
			name: self aClassName;
			slots:#(x) ].

	aClass layout checkIntegrity.
	anotherClass layout checkIntegrity.
	yetAnotherClass layout checkIntegrity.
	yetYetAnotherClass layout checkIntegrity.! !

!SlotMigrationTest methodsFor: 'tests' stamp: 'MartinDias 12/9/2013 11:38'!
testChangingFormatKeepsMethod

	aClass := self make: [ :builder | 
		builder 
			name: self aClassName;
			layoutClass: FixedLayout ].

	aClass compile: 'a ^self'.
	self assert: (aClass methodDictionary includesKey: #a).
	
	anotherClass := self make: [ :builder | 
		builder 
			name: self aClassName;
			layoutClass: VariableLayout .
			].

	self assert: (anotherClass methodDictionary includesKey: #a).
	aClass layout checkIntegrity.
	anotherClass layout checkIntegrity.! !

!SlotMigrationTest methodsFor: 'tests' stamp: 'MartinDias 12/9/2013 11:38'!
testChangeLayoutTypeFromByte

	aClass := self makeWithLayout: ByteLayout.
	"Change the layout of the class from bytes to pointer"
	aClass := self 
		makeWithLayout: FixedLayout 
		andSlots: { #id. #name }.
	
	aClass layout checkIntegrity.
	
	self deny: aClass layout isBits.
	self assert: aClass instVarNames equals: { #id. #name }.! !

!SlotMigrationTest methodsFor: 'tests' stamp: 'MartinDias 12/9/2013 11:38'!
testRemoveSlotAndMigrate
	"We create a class with a slot and create an instance; then we remove the slot and check the instance doesn't hold the value."
	aClass := self makeWithLayout: FixedLayout andSlots: { #aSlot }.

	instance := aClass new.
	"it should have an instance variable"
	instance instVarAt: 1 put: 125.
	
	"now we extend it with slots.  The class definition should've changed"
	self makeWithLayout: FixedLayout.
	
	self should: [ instance instVarAt: 1 ] raise: Error.
	aClass layout checkIntegrity.! !

!SlotMigrationTest methodsFor: 'tests' stamp: 'MartinDias 12/9/2013 11:38'!
testSuperclassChangeLayoutType
	"This case reproduces a MNU found loading Moose."

	| superclass class |
	superclass := self makeWithLayout: ByteLayout.
	class := self make: [ :builder |
		builder 
			superclass: superclass;
			layoutClass: ByteLayout;
			name: self anotherClassName.
		 ].
	"Change the layout of the superclass from bytes to pointer"
	self makeWithLayout: FixedLayout.

	superclass layout checkIntegrity.
	class layout checkIntegrity.
	
	self deny: superclass layout isBits.
	self assert: class layout isBits.! !

!SlotMigrationTest methodsFor: 'tests' stamp: 'MartinDias 12/9/2013 11:38'!
testChangeLayoutTypeToByte
	aClass := self 
		makeWithLayout: FixedLayout
		andSlots: { #id. #name }.
	"Change the layout of the class from pointer to bytes"
	aClass := self makeWithLayout: ByteLayout.
	
	aClass layout checkIntegrity.
	
	self assert: aClass layout isBits.
	self assert: aClass instVarNames isEmpty.! !

!SlotMigrationTest methodsFor: 'tests' stamp: 'MartinDias 12/9/2013 11:38'!
testReshapeByteVariableToPointerPropagatesToDeepHierarchy

	"create the original hierarchy"
	aClass := self make: [ :builder |
		builder 
			name: self aClassName;
			superclass: Object;
			layoutClass: ByteLayout ]. 

	anotherClass := self make: [ :builder |
		builder 
			name:self anotherClassName;
			superclass: aClass;
			layoutClass: ByteLayout ].

	yetAnotherClass := self make: [ :builder |
		builder 
			name:self yetAnotherClassName;
			superclass: anotherClass;
			layoutClass: ByteLayout ].

	yetYetAnotherClass := self make: [ :builder |
		builder 
			name:self yetYetAnotherClassName;
			superclass: yetAnotherClass;
			layoutClass: ByteLayout ].

	"all the classes in the hierarchy should be of type variable byte"
	{ aClass. anotherClass. yetAnotherClass. yetYetAnotherClass } do: [ :each | 
		each layout checkIntegrity.
		self assert: each isVariable.
		self assert: each isBytes. ].
	
	"change the top superclass"	
	aClass := self make: [ :builder |
		builder 
			name: self aClassName;
			superclass: Object;
			layoutClass: FixedLayout;
			slots: { #x } ]. 

	"all the classes in the hierarchy should be reshaped as fixed"
	{ aClass. anotherClass. yetAnotherClass. yetYetAnotherClass } do: [ :each | 
		each layout checkIntegrity.
		self assert: each isFixed description: each name, ' was not reshaped.'.
		self assert: each isPointers description: each name, ' was not reshaped.' ].! !

!SlotMigrationTest methodsFor: 'tests' stamp: 'MartinDias 12/9/2013 11:38'!
testAddSlotAndMigrate
	"We create a class without slots and create an instance; then we add a slot and check the instance can hold a value."
	aClass := self makeWithLayout: FixedLayout.
	
	instance := aClass new.
	
	"now we extend it with slots.  The class definition should've changed"
	self makeWithLayout: FixedLayout andSlots: { #aSlot }.
	
	"it should have an instance variable"
	instance instVarAt: 1 put: 125.
	aClass layout checkIntegrity.! !

!SlotMigrationTest methodsFor: 'tests' stamp: 'MartinDias 12/9/2013 11:38'!
testAddSlotPropagateAndMigrate
	"We create a class without slots and a subclass, and create an instance of the latter; then we add a slot to superclass and check the instance can hold a value."

	| superclass subclass |
	superclass := self makeWithLayout: FixedLayout.
	subclass := self make: [ :builder |
		builder 
			superclass: superclass;
			name: self anotherClassName.
		 ].
	
	superclass layout checkIntegrity.
	subclass layout checkIntegrity.
	
	instance := subclass new.
	
	"now we extend it with slots.  The class definition should've changed"
	superclass := self makeWithLayout: FixedLayout andSlots: { #aSlot }.
	
	"it should have an instance variable"
	instance instVarNamed: 'aSlot' put: 42.
	self assert: (instance instVarNamed: 'aSlot') equals: 42.
	superclass layout checkIntegrity.
	subclass layout checkIntegrity.! !

!SlotMigrationTest methodsFor: 'tests' stamp: 'MarcusDenker 2/13/2015 16:13'!
testMigrateTestSlot
	"We create a class with a Test slot, so its  value is shared between instances"
	| instance2 |
	aClass := self makeWithLayout: FixedLayout andSlots: { #aSlot => ExampleSlotWithState. }.
	
	instance := aClass new.
	instance2 := aClass new.
	(aClass slotNamed: #aSlot) write: 125 to: instance2.
	"now we change the TestSlot with a InstanceVariableSlot. Both instances should both shared the same value in this slot."
	self makeWithLayout: FixedLayout andSlots: { #aSlot }.
	
	self assert: ((aClass slotNamed: #aSlot) read: instance) equals: 125.
	self assert: ((aClass slotNamed: #aSlot) read: instance2) equals: 125.
	aClass layout checkIntegrity.! !

!SlotMigrationTest methodsFor: 'tests' stamp: 'MartinDias 8/7/2013 11:30'!
testReshapeSuperSuperClass

	| supersuperclass superclass subclass |

	supersuperclass := self make: [ :builder |
		builder 
			superclass: Object;
			name: self aClassName;
			slots: #(a b).
		 ].

	self assert: supersuperclass subclasses isEmpty.
	supersuperclass layout checkIntegrity.
	
	superclass := self make: [ :builder |
		builder 
			superclass: supersuperclass;
			name: self anotherClassName.
		 ].

	self assert: supersuperclass subclasses equals: { superclass }.
	self assert: superclass subclasses isEmpty.
	superclass layout checkIntegrity.
	supersuperclass layout checkIntegrity.
	
	subclass := self make: [ :builder |
		builder 
			superclass: superclass;
			name: self yetAnotherClassName;
			slots:#(c d).
		 ].

	self assert: supersuperclass subclasses equals: { superclass }.
	self assert: superclass subclasses equals: { subclass }.
	self assert: subclass subclasses isEmpty.
	subclass layout checkIntegrity.
	superclass layout checkIntegrity.
	supersuperclass layout checkIntegrity.

	"reshape the super super class"
	supersuperclass := self make: [ :builder |
		builder 
			superclass: Object;
			name: self aClassName;
			slots: #(a b a2).
		 ].
	
	self assert: supersuperclass subclasses equals: { superclass }.
	self assert: superclass subclasses equals: { subclass }.
	self assert: subclass subclasses isEmpty.	
	subclass layout checkIntegrity.
	superclass layout checkIntegrity.
	supersuperclass layout checkIntegrity.! !

!SlotMigrationTest methodsFor: 'tests' stamp: 'MarcusDenker 2/13/2015 16:13'!
testRemoveTestSlot
	aClass := self makeWithLayout: FixedLayout andSlots: {#anotherSlot => ExampleSlotWithState. #aSlot }.
	
	instance := aClass new.
	instance instVarAt: 1 put: 125.
	"now we remove the TestSlot from the class definition. As testSlot has a size of 0, the object should not change."
	self makeWithLayout: FixedLayout andSlots: {#aSlot. }.
	

	self assert: (instance instVarAt: 1) equals: 125.
	aClass layout checkIntegrity.! !

!SlotMigrationTest methodsFor: 'tests' stamp: 'MarcusDenker 7/12/2014 17:51'!
testAddSharedVariableKeepSubclasses
	"Reproduces fogbugz case 13028"

	"Define original hierarchy"
	aClass := self make: [ :builder |
		builder 
			name: self aClassName;
			superclass: Object ]. 

	anotherClass := self make: [ :builder |
		builder 
			name: self anotherClassName;
			superclass: aClass ].

	self assert: aClass subclasses size equals: 1.
	self assert: aClass subclasses anyOne == anotherClass.

	"Add a shared variable"
	aClass := self make: [ :builder |
		builder 
			name: self aClassName;
			superclass: Object;
			sharedVariablesFromString: 'Var' ]. 
	
	self assert: aClass subclasses size equals: 1.
	self assert: aClass subclasses anyOne == anotherClass.
! !

!SlotMigrationTest methodsFor: 'tests' stamp: 'MartinDias 4/29/2014 12:27'!
testChangeSuperclass

	"Define original hierarchy"
	aClass := self make: [ :builder |
		builder 
			name: self aClassName;
			superclass: Object ]. 

	anotherClass := self make: [ :builder |
		builder 
			name: self anotherClassName;
			superclass: aClass ].

	self assert: aClass subclasses size equals: 1.
	self assert: aClass subclasses anyOne == anotherClass.
	self assert: anotherClass superclass == aClass.

	"Change to a new superclass"
	yetAnotherClass := self make: [ :builder |
		builder 
			name: self yetAnotherClassName;
			superclass: Object ]. 

	anotherClass := self make: [ :builder |
		builder 
			name: self anotherClassName;
			superclass: yetAnotherClass ]. 
	
	self assert: aClass subclasses isEmpty.
	self assert: yetAnotherClass subclasses size equals: 1.
	self assert: yetAnotherClass subclasses anyOne == anotherClass.
	self assert: anotherClass superclass == yetAnotherClass.
! !

!SlotMigrationTest methodsFor: 'tests' stamp: 'MartinDias 12/9/2013 11:38'!
testRedefineSuperclass
	"This case reproduces a MNU found loading Moose."

	| superclass class |
	superclass := self makeWithLayout: FixedLayout.
	class := self make: [ :builder |
		builder 
			superclass: superclass;
			layoutClass: ByteLayout;
			name: self anotherClassName.
		 ].

	self makeWithLayout: FixedLayout.

	superclass layout checkIntegrity.
	class layout checkIntegrity.! !

!SlotNotFound commentStamp: '<historical>'!
I am an exception to indicate that a slot is found in a layout.!
!SlotNotFound methodsFor: 'accessing' stamp: 'CAmi 3/15/2011 18:54'!
targetClass: aClass
	targetClass := aClass! !

!SlotNotFound methodsFor: 'accessing' stamp: 'CamilloBruni 3/23/2011 14:22'!
messageText
	^ 'Slot ''', name asString, ''' not found', (targetClass ifNil: [''] ifNotNil:[' in ', targetClass name])! !

!SlotNotFound methodsFor: 'accessing' stamp: 'CAmi 3/15/2011 18:54'!
name: anObject
	name := anObject! !

!SlotNotFound methodsFor: 'accessing' stamp: 'CAmi 3/15/2011 18:54'!
name
	^ name! !

!SlotNotFound methodsFor: 'accessing' stamp: 'CAmi 3/15/2011 18:55'!
targetClass
	^ targetClass! !

!SlotNotFound class methodsFor: 'signalling' stamp: 'CAmi 3/15/2011 18:53'!
signalForName: aSymbol
	self new
		name: aSymbol;
		signal! !

!SlotNotFound class methodsFor: 'signalling' stamp: 'CAmi 3/15/2011 18:55'!
signalForName: aSymbol inClass: aClass
	self new
		name: aSymbol;
		targetClass: aClass;
		signal! !

!SlotSilentTest methodsFor: 'running' stamp: 'MartinDias 8/7/2013 11:57'!
runCase

	SystemAnnouncer uniqueInstance suspendAllWhile: [ super runCase ]
! !

!SlotTraitsTest methodsFor: 'tests' stamp: 'VincentBlondeau 3/6/2015 16:38'!
testClassWithTrait

	self assert: TOne traitUsers isEmpty.
	self assert: TOne classTrait traitUsers isEmpty.
	
	aClass := self make: [ :builder | 
		builder traitComposition: TOne ].
	
	self assert: TOne traitUsers asArray equals: { aClass }.
	self assert: TOne classTrait traitUsers isEmpty.
	
	self assert: (aClass canUnderstand: #one).
	self assert: aClass new one equals: 1.! !

!SlotTraitsTest methodsFor: 'tests' stamp: 'VincentBlondeau 3/6/2015 16:39'!
testRemoveTrait
	"Tests that when removing a trait from a class, its methods are removed from the method dictionary."
	
	self make: [ :builder | 
		builder traitComposition: TOne ].
	
	aClass := self make: [ :builder | 
		builder traitComposition: {} ].
	
	self assert: TOne traitUsers isEmpty.
	self assert: TOne classTrait traitUsers isEmpty.
	self deny: (aClass canUnderstand: #one).
! !

!SlotTraitsTest methodsFor: 'tests' stamp: 'VincentBlondeau 3/6/2015 16:38'!
testClassWithTrait2

	self assert: TOne traitUsers isEmpty.
	self assert: TOne classTrait traitUsers isEmpty.
	
	aClass := self make: [ :builder | 
		builder traitComposition: TOne classTrait ].
	
	self assert: TOne traitUsers isEmpty.
	self assert: TOne classTrait traitUsers asArray equals: { aClass }.
	
	self deny: (aClass canUnderstand: #one).
	self assert: (aClass canUnderstand: #classOne).
	self assert: aClass new classOne equals: 1.! !

!SlotTraitsTest methodsFor: 'tests' stamp: 'VincentBlondeau 3/6/2015 16:39'!
testModifyClassTraitComposition
	"Tests that when modifing the trait composition on class-side, the old methods are removed from the method dictionary, and the new ones are added."

	self make: [ :builder | 
		builder classTraitComposition: TOne ].

	aClass := self make: [ :builder | 
		builder classTraitComposition: TTwo ].
	
	self assert: TOne traitUsers isEmpty.
	self assert: TOne classTrait traitUsers isEmpty.
	self assert: TTwo traitUsers asArray equals: { aClass class }.
	self assert: TTwo classTrait traitUsers isEmpty.
	
	self deny: (aClass class canUnderstand: #one).
	self deny: (aClass class canUnderstand: #classOne).
	self assert: (aClass class canUnderstand: #two).
	aClass layout checkIntegrity.


	aClass := self make: [ :builder | 
		builder classTraitComposition: { } ].
	
	self assert: TOne traitUsers isEmpty.
	self assert: TOne classTrait traitUsers isEmpty.
	self assert: TTwo traitUsers isEmpty.
	self assert: TTwo classTrait traitUsers isEmpty.
	aClass layout checkIntegrity.
	
	self deny: (aClass canUnderstand: #one).
	self deny: (aClass class canUnderstand: #classOne).
	self deny: (aClass canUnderstand: #two).! !

!SlotTraitsTest methodsFor: 'tests' stamp: 'VincentBlondeau 3/6/2015 16:39'!
testModifyTraitComposition
	"Tests that when modifing the trait composition, the old methods are removed from the method dictionary, and the new ones are added."
	
	self make: [ :builder | 
		builder traitComposition: TOne ].

	aClass := self make: [ :builder | 
		builder traitComposition: TTwo ].
	
	self assert: TOne traitUsers isEmpty.
	self assert: TOne classTrait traitUsers isEmpty.
	self assert: TTwo traitUsers asArray equals: { aClass }.
	"self assert: TTwo classTrait traitUsers isEmpty."
	aClass layout checkIntegrity.
	
	self deny: (aClass canUnderstand: #one).
	self deny: (aClass class canUnderstand: #classOne).
	self assert: (aClass canUnderstand: #two).
	
	
	aClass := self make: [ :builder | 
		builder traitComposition: { } ].
	
	self assert: TOne traitUsers isEmpty.
	self assert: TOne classTrait traitUsers isEmpty.
	self assert: TTwo traitUsers isEmpty.
	self assert: TTwo classTrait traitUsers isEmpty.
	aClass layout checkIntegrity.
	
	self deny: (aClass canUnderstand: #one).
	self deny: (aClass class canUnderstand: #classOne).
	self deny: (aClass canUnderstand: #two).
	
! !

!SlotTraitsTest methodsFor: 'tests' stamp: 'VincentBlondeau 3/6/2015 16:38'!
testClassWithClassTrait

	self assert: TOne traitUsers isEmpty.
	self assert: TOne classTrait traitUsers isEmpty.
	
	aClass := self make: [ :builder | 
		builder classTraitComposition: TOne ].
	
	self assert: TOne traitUsers asArray equals: { aClass class }.
	self assert: TOne classTrait traitUsers isEmpty.
	
	self assert: (aClass class canUnderstand: #one).
	self assert: aClass one equals: 1.! !

!SlotTraitsTest methodsFor: 'tests' stamp: 'VincentBlondeau 3/6/2015 16:39'!
testTraitUsersAfterClassReshape

	aClass := self make: [ :builder | 
		builder
			name: self aClassName ].

	anotherClass := self make: [ :builder | 
		builder
			name: self anotherClassName;
			superclass: aClass;
			traitComposition: TOne;
			classTraitComposition: TOne classTrait + TTwo ].
	
	self assert: TOne traitUsers asArray equals: { anotherClass }.
	self assert: TOne classTrait traitUsers asArray equals: { anotherClass class }.
	self assert: TTwo traitUsers asArray equals: { anotherClass class }.
	self assert: TTwo classTrait traitUsers asArray equals: { }.
	
	self deny: (aClass canUnderstand: #one).
	self assert: (anotherClass canUnderstand: #one).
	self deny: (aClass class canUnderstand: #two).
	self assert: (anotherClass class canUnderstand: #two).
	
	
	"reshape the super class"
	aClass := self make: [ :builder | 
		builder
			name: self aClassName;
			slots: #( x y z ) ].
		
	self assert: TOne traitUsers asArray equals: { anotherClass }.
	self assert: TOne classTrait traitUsers asArray equals: { anotherClass class }.
	self assert: TTwo traitUsers asArray equals: { anotherClass class }.
	self assert: TTwo classTrait traitUsers asArray equals: { }.
	
	self deny: (aClass canUnderstand: #one).
	self assert: (anotherClass canUnderstand: #one).
	self deny: (aClass class canUnderstand: #two).
	self assert: (anotherClass class canUnderstand: #two).

! !

!SlotTraitsTest methodsFor: 'tests' stamp: 'VincentBlondeau 3/6/2015 16:39'!
testTraitUsersAfterMetaclassReshape

	aClass := self make: [ :builder | 
		builder
			name: self aClassName ].

	anotherClass := self make: [ :builder | 
		builder
			name: self anotherClassName;
			superclass: aClass;
			traitComposition: TOne;
			classTraitComposition: TOne classTrait + TTwo ].
	
	
	self assert: TOne traitUsers asArray            equals: { anotherClass }.
	self assert: TOne classTrait traitUsers asArray equals: { anotherClass class }.
	self assert: TTwo traitUsers asArray            equals: { anotherClass class }.
	self assert: TTwo classTrait traitUsers asArray equals: { }.
	
	self deny: (aClass canUnderstand: #one).
	self assert: (anotherClass canUnderstand: #one).
	self deny: (aClass class canUnderstand: #two).
	self assert: (anotherClass class canUnderstand: #two).
	
	"reshape the super class"
	aClass := self make: [ :builder | 
		builder
			name: self aClassName;
			classSlots: #( x y z ) ].
		
	
	self assert: TOne traitUsers asArray            equals: { anotherClass }.
	self assert: TOne classTrait traitUsers asArray equals: { anotherClass class }.
	self assert: TTwo traitUsers asArray            equals: { anotherClass class }.
	self assert: TTwo classTrait traitUsers asArray equals: { }.
	
	self deny: (aClass canUnderstand: #one).
	self assert: (anotherClass canUnderstand: #one).
	self deny: (aClass class canUnderstand: #two).
	self assert: (anotherClass class canUnderstand: #two).

! !

!SlotTraitsTest methodsFor: 'tests' stamp: 'VincentBlondeau 3/6/2015 16:39'!
testRemoveClassTrait
	"Tests that when removing a trait from class-side, its methods are removed from the method dictionary."

	aClass := self make: [ :builder | 
		builder classTraitComposition: TOne ].

	aClass := self make: [ :builder | 
		builder classTraitComposition: {} ].
	
	self deny: (aClass class canUnderstand: #one).
	self assert: TOne traitUsers isEmpty.
	self assert: TOne classTrait traitUsers isEmpty.
! !

!SmallCogInitialState commentStamp: '<historical>'!
Initial state of a small cog turning animation!
!SmallCogInitialState methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/26/2013 22:42'!
nextState

	^ SmallCogState2 new! !

!SmallCogInitialState methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/26/2013 22:42'!
stepTime

	^ 50! !

!SmallCogInitialState class methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/26/2013 22:46'!
imageData

	^ #(0 0 0 0 0 0 733526200 3317349050 3099245242 683260345 0 0 0 0 0 0 0 0 61516458 532002229 0 0 2176498362 4290493371 4290493371 2176498362 0 0 632994490 41975936 0 0 0 41975936 2830875579 4290493371 2629483194 179549107 3166354106 4290493371 4290493371 2881141434 263961531 2696592058 4290493371 2696592058 16777216 0 0 548911031 4290493371 4290493371 4290493371 4240095930 4290493371 4290493371 4290493371 4290493371 4240095930 4290493371 4290493371 4290493371 464761779 0 0 0 2579217339 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2411313593 0 0 0 0 263961531 4256873146 4290493371 4290493371 4290493371 3418012346 3451632571 4290493371 4290493371 4290493371 4189764282 162179754 0 0 548911031 1757067962 2763766715 4290493371 4290493371 4290493371 1438300858 0 0 1572518586 4290493371 4290493371 4290493371 2696592058 1723447737 616085688 3552230074 4290493371 4290493371 4290493371 4290493371 3367680698 0 0 0 0 3485121210 4290493371 4290493371 4290493371 4290493371 3401300923 3569007290 4290493371 4290493371 4290493371 4290493371 3283860411 0 0 0 0 3401300923 4290493371 4290493371 4290493371 4290493371 3535518651 817543866 2042214841 3015424955 4290493371 4290493371 4256873146 1169799609 0 0 1270594491 4273716155 4290493371 4290493371 2981804730 2042214841 767278011 0 0 212511402 4240095930 4290493371 4290493371 4240095930 3099245242 3116022458 4256873146 4290493371 4290493371 4189764282 144678815 0 0 0 0 2361047738 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2210118587 0 0 0 599176886 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4273716155 431536312 0 0 93952409 3065690810 4290493371 2981804730 666351543 2965093307 4290493371 4290493371 3250240186 498710969 3082533819 4290493371 2965093307 41975936 0 0 0 129414838 1002093242 16777216 0 2042214841 4290493371 4290493371 2243607226 0 41975936 1119467961 93952409 0 0 0 0 0 0 0 0 850966712 3518741435 3501898426 834057910 0 0 0 0 0 0)! !

!SmallCogInitialState class methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/26/2013 22:43'!
size 

	^ 16! !

!SmallCogState2 commentStamp: '<historical>'!
Second state of a small cog turning animation!
!SmallCogState2 methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/26/2013 22:42'!
nextState

	^ SmallCogState3 new! !

!SmallCogState2 methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/26/2013 22:42'!
stepTime

	^ 50! !

!SmallCogState2 class methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/26/2013 22:46'!
imageData

	^ #(0 0 0 0 1337505976 649442741 0 0 1186642618 3803888314 2730146490 464761779 0 0 0 0 0 0 0 2914695866 4290493371 4055546554 599176886 16777216 3518741435 4290493371 4290493371 1891351483 0 0 0 0 0 0 0 3585850299 4290493371 4290493371 3585850299 2679814842 4290493371 4290493371 4290493371 1371191994 0 0 0 0 0 0 0 1975105977 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2461776827 1304017337 3132799674 3485121210 279949231 0 279949231 0 1757067962 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2260384442 2864364218 4290493371 4156275643 4206607291 4290493371 4290493371 4290493371 3736779450 3552230074 4290493371 4290493371 4290493371 4290493371 4290493371 4273716155 1656338873 4122655418 4290493371 4290493371 4290493371 4290493371 4290493371 1857665465 0 0 1169799609 4172987066 4290493371 4290493371 4089166779 1253751482 0 2495265466 4206607291 4290493371 4290493371 4290493371 3501898426 0 0 0 0 2713435067 4290493371 4290493371 3569007290 0 0 0 464761779 3401300923 4290493371 4290493371 3099245242 0 0 0 0 2361047738 4290493371 4290493371 4290493371 3250240186 1253751482 0 61516458 3149642683 4290493371 4290493371 4105878202 515619771 0 0 212511402 3736779450 4290493371 4290493371 4290493371 4290493371 4290493371 314095800 3216751547 4290493371 4290493371 4290493371 4290493371 3787176891 1924840122 1807399610 3535518651 4290493371 4290493371 4290493371 4290493371 4290493371 4172987066 1941617338 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3501898426 1555741370 1975105977 1388035003 414561717 4089166779 4290493371 3468409787 3619338938 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2075900859 0 0 0 0 783792055 934918585 0 263961531 4206607291 4290493371 4290493371 4172987066 4256873146 4290493371 4290493371 3686447802 16777216 0 0 0 0 0 0 800635064 4290493371 4290493371 4290493371 1002093242 1069202106 4240095930 4290493371 4223384507 330215086 0 0 0 0 0 0 565819833 4139498427 4290493371 3149642683 0 0 1840888249 3367680698 1136310970 0 0 0)! !

!SmallCogState2 class methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/26/2013 22:43'!
size 

	^ 16! !

!SmallCogState3 commentStamp: '<historical>'!
Last state of a small cog turning animation!
!SmallCogState3 methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/26/2013 22:42'!
nextState

	^ SmallCogInitialState new! !

!SmallCogState3 methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/26/2013 22:42'!
stepTime

	^ 50! !

!SmallCogState3 class methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/26/2013 22:47'!
imageData

	^ #(0 0 0 0 347321267 3401300923 4290493371 2377824954 0 0 431536312 1488566713 93952409 0 0 0 0 0 0 0 901232567 4290493371 4290493371 4139498427 297055412 330215086 3619338938 4290493371 3418012346 229749169 0 0 0 0 0 0 448445114 4290493371 4290493371 4290493371 3283860411 3451632571 4290493371 4290493371 4290493371 498710969 0 0 41975936 2931473082 3132799674 1555741370 1924840122 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3065690810 0 0 0 1505409722 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3015424955 229749169 817543866 632994490 1085781943 4156275643 4290493371 4290493371 4290493371 4290493371 4290493371 3585850299 3367680698 4256873146 4290493371 4290493371 4290493371 4290493371 4290493371 4172987066 0 901232567 3870997178 4290493371 4290493371 4290493371 1689959098 0 0 934918585 4105878202 4290493371 4290493371 4290493371 4290493371 4290493371 0 0 3082533819 4290493371 4290493371 3350903482 0 0 0 0 2545597114 4290493371 4290493371 4290493371 4273716155 3048913594 1152956600 3032202171 4256873146 4290493371 4290493371 2981804730 0 0 0 0 2260384442 4290493371 4290493371 4122655418 599176886 0 4273716155 4290493371 4290493371 4290493371 4290493371 4105878202 448445114 0 0 229749169 3686447802 4290493371 4290493371 3887840187 381270457 0 4139498427 4290493371 4290493371 4290493371 4290493371 4290493371 3770399675 1941617338 1840888249 3552230074 4290493371 4290493371 4290493371 4290493371 3787176891 767278011 1656338873 2528885691 1941617338 3552230074 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 2696592058 0 0 0 1438300858 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 4290493371 3703290811 2814032570 4156275643 4273716155 901232567 0 0 0 3267083195 4290493371 4290493371 4273716155 4172987066 4290493371 4290493371 4290493371 1102624952 0 279949231 716617398 0 0 0 0 3954949051 4290493371 4290493371 1958460347 364295862 4122655418 4290493371 4290493371 1522252731 0 0 0 0 0 0 0 532002229 2730146490 2109389498 0 0 2646326203 4290493371 4290493371 1455143867 0 0 0 0)! !

!SmallCogState3 class methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/26/2013 22:43'!
size 

	^ 16! !

!SmallDictionary commentStamp: '<historical>'!
RBSmallDictionary is a special dictionary optimized for small collections. In addition to the normal dictionary protocol, it also supports an #empty message which "empties" the collection but may hang on to the original elements (so it could collect garbage). Without #empty we would either need to create a new dictionary or explicitly remove everything from the dictionary. Both of these take more time and #empty.

Instance Variables:
keys <Array of: Object> array of keys (we don't use Associations for our key value pairs)
size <Integer> the size of the dictionary
values <Array of: Object> array of our values
!
!SmallDictionary methodsFor: 'adding' stamp: 'cyrille.delaunay 7/20/2009 13:19'!
addAll: aKeyedCollection
	aKeyedCollection == self 
		ifFalse: [
			aKeyedCollection keysAndValuesDo: [:key :value | self at: key put: value]].
	^aKeyedCollection! !

!SmallDictionary methodsFor: 'testing - values' stamp: 'cyrille.delaunay 7/20/2009 13:25'!
includesIdentity: aValue
	"Answer whether aValue is one of the values of the receiver.  Contrast #includes: in which there is only an equality check, here there is an identity check"

	self do: [:each | aValue == each ifTrue: [^ true]].
	^ false! !

!SmallDictionary methodsFor: 'accessing - keys' stamp: 'SvenVanCaekenberghe 4/19/2011 20:31'!
keyAtIdentityValue: value 
	"Answer the key that is the external name for the argument, value. If 
	there is none, answer nil.
	Note: There can be multiple keys with the same value. Only one is returned."

	^self keyAtIdentityValue: value ifAbsent: [self errorValueNotFound: value]! !

!SmallDictionary methodsFor: 'testing - values' stamp: 'cyrille.delaunay 7/20/2009 13:25'!
keyForIdentity: aValue
	"If aValue is one of the values of the receive, return its key, else return nil.  Contrast #keyAtValue: in which there is only an equality check, here there is an identity check"

	self keysAndValuesDo: [:key :value |  value == aValue ifTrue: [^  key]].
	^ nil! !

!SmallDictionary methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 11:04'!
initialize
	super initialize.
	keys := Array new: 2.
	values := Array new: 2.
	size := 0! !

!SmallDictionary methodsFor: 'accessing' stamp: 'CamilleTeruel 4/3/2013 19:06'!
empty
	1 to: size do: [ :index |
		keys at: index put: nil.
		values at: index put: nil ].
	size := 0
! !

!SmallDictionary methodsFor: 'removing - keys' stamp: 'StephaneDucasse 5/28/2011 13:36'!
removeKey: key ifAbsent: aBlock 
	"Remove key (and its associated value) from the receiver. If key is not in 
	the receiver, answer the result of evaluating aBlock. Otherwise, answer 
	the value externally named by key."

	| index value |
	index := self findIndexForKey:  key.
	index = 0 ifTrue: [^aBlock value].
	
	value := values at: index.
	index to: size - 1
		do: 
			[:i | 
			keys at: i put: (keys at: i + 1).
			values at: i put: (values at: i + 1)].
	keys at: size put: nil.
	values at: size put: nil.
	size := size - 1.
	^value! !

!SmallDictionary methodsFor: 'accessing - values' stamp: 'cyrille.delaunay 7/20/2009 13:19'!
at: key ifPresent: aBlock
	"Lookup the given key in the receiver. If it is present, answer the value of evaluating the given block with the value associated with the key. Otherwise, answer nil."

	| v |
	v := self at: key ifAbsent: [^ nil].
	^ aBlock value: v
! !

!SmallDictionary methodsFor: 'enumerating - values' stamp: 'cyrille.delaunay 7/20/2009 13:21'!
valuesDo: aBlock 
	"Evaluate aBlock for each of the receiver's values."

1 to: size do: [:i | aBlock value: (values at: i)]! !

!SmallDictionary methodsFor: 'enumerating - assoctiations' stamp: 'cyrille.delaunay 7/20/2009 13:20'!
associationsSelect: aBlock 
	"Evaluate aBlock with each of my associations as the argument. Collect
	into a new dictionary, only those associations for which aBlock evaluates
	to true."

	| newCollection |
	newCollection := self species new.
	self associationsDo: 
		[:each | 
		(aBlock value: each) ifTrue: [newCollection add: each]].
	^newCollection! !

!SmallDictionary methodsFor: 'printing' stamp: 'pmm 7/4/2009 13:04'!
printElementsOn: aStream
	| noneYet |
	aStream nextPut: $(.
	noneYet := true.
	self associationsDo: [ :each | 
			noneYet
				ifTrue: [ noneYet := false ]
				ifFalse: [ aStream space ].
			aStream print: each].
	aStream nextPut: $)! !

!SmallDictionary methodsFor: 'testing - keys' stamp: 'MarcusDenker 11/1/2014 16:48'!
includesKey: key
	"Answer whether the receiver has a key equal to the argument, key."

	^ (self findIndexForKey: key) ~= 0! !

!SmallDictionary methodsFor: 'removing - keys' stamp: 'cyrille.delaunay 7/20/2009 13:24'!
removeUnreferencedKeys   "Undeclared removeUnreferencedKeys"

	^ self unreferencedKeys do: [:key | self removeKey: key].! !

!SmallDictionary methodsFor: 'accessing - values' stamp: 'PeterHugossonMiller 9/3/2009 11:22'!
values
	"Answer a Collection containing the receiver's values."
	"^ values copyFrom: 1 to: size."
	
| out |
	out := (Array new: self size) writeStream.
	self valuesDo: [:value | out nextPut: value].
	^ out contents! !

!SmallDictionary methodsFor: 'accessing - values' stamp: 'StephaneDucasse 5/28/2011 13:35'!
at: key ifAbsentPut: aBlock 
	"Return the value at the given key. 
	If key is not included in the receiver store the result 
	of evaluating aBlock as new value."
	
	| index |
	index := self findIndexForKey:  key.
	^ index = 0 
		ifFalse: [values at: index]
		ifTrue: [self privateAt: key put: aBlock value]! !

!SmallDictionary methodsFor: 'enumerating - keys and values' stamp: 'CamilloBruni 3/23/2013 12:25'!
difference: aCollection
	"Answer the set theoretic difference of two collections. This is a specialized version for Dictionaries keeping the keys of the objects. At a slightly higher price of an additional Set to track duplicates."

	| other result duplicates |
	
	other := aCollection asSet.
	duplicates := Set new.
	result := self class new: self size.
	
	self keysAndValuesDo: [ :key :value|
		((other includes: value) not and: [ (duplicates includes: value) not ])
			ifTrue: [ 
				duplicates add: value.
				result at: key put: value]].
	
	^ result! !

!SmallDictionary methodsFor: 'testing - associaitons' stamp: 'cyrille.delaunay 7/20/2009 13:25'!
includesAssociation: anAssociation
  ^ (self   
      associationAt: anAssociation key
      ifAbsent: [ ^ false ]) value = anAssociation value
! !

!SmallDictionary methodsFor: 'accessing' stamp: 'nice 12/30/2008 18:55'!
capacity
	^keys size! !

!SmallDictionary methodsFor: 'removing - keys' stamp: 'CamilloBruni 4/11/2011 13:31'!
removeKey: key 
	"Remove key from the receiver.
	If key is not in the receiver, notify an error."

	^ self removeKey: key ifAbsent: [self errorKeyNotFound: key]! !

!SmallDictionary methodsFor: 'putting' stamp: 'StephaneDucasse 5/28/2011 13:35'!
at: key put: value 
	"Set the value at key to be anObject.  If key is not found, create a
	new entry for key and set is value to anObject. Answer anObject."

	| index |
	index := self findIndexForKey:  key.
	^ index = 0
		ifFalse: [values at: index put: value]
		ifTrue: [self privateAt: key put: value]	
	! !

!SmallDictionary methodsFor: 'enumerating - values' stamp: 'cyrille.delaunay 7/20/2009 13:21'!
collect: aBlock 
	"Evaluate aBlock with each of my values as the argument.  Collect the
	resulting values into a collection that is like me. Answer with the new
	collection."
	| newCollection |
	newCollection := self species new.
	self associationsDo:[:each |
		newCollection at: each key put: (aBlock value: each value).
	].
	^newCollection! !

!SmallDictionary methodsFor: 'copying' stamp: ''!
postCopy
	keys := keys copy.
	values := values copy! !

!SmallDictionary methodsFor: 'accessing - keys' stamp: 'cyrille.delaunay 7/20/2009 13:18'!
keysSortedSafely
	"Answer a SortedCollection containing the receiver's keys."
	| sortedKeys |
	sortedKeys := SortedCollection new: self size.
	sortedKeys sortBlock:
		[:x :y |  "Should really be use <obj, string, num> compareSafely..."
		((x isString and: [y isString])
			or: [x isNumber and: [y isNumber]])
			ifTrue: [x < y]
			ifFalse: [x class == y class
				ifTrue: [x printString < y printString]
				ifFalse: [x class name < y class name]]].
	self keysDo: [:each | sortedKeys addLast: each].
	^ sortedKeys reSort! !

!SmallDictionary methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 3/25/2015 09:10'!
gtInspectorItemsIn: composite
	^ (composite table)
		title: 'Items';
		display: [ self associations ];
		children: [ :each | 
			(each value isDictionary) 
				ifTrue: [ each value associations ] 
				ifFalse: [ (each value isArray and: [ each value allSatisfy: #isDictionary ])
						ifTrue: [ each value collectWithIndex: [:x :i | i -> x ] ]
						ifFalse: [ #() ] ] ];
		column: 'Key' 
			evaluated: [:each | GTObjectPrinter new asTruncatedTextFrom: each key ];
		column: 'Value' 
			evaluated: [:each | GTObjectPrinter new asTruncatedTextFrom: each value ];
		selectionAct: [ :table |
			table rawSelection do: [ :assoc | self removeKey: assoc key ].
			table update ]
			entitled: 'Remove item(s)';
		selectionPopulate: #selection 
			entitled: 'Open key'
			with: [ :table | (table rawSelection collect: #key) gtInspectorInterestingObject ];
		beMultiple;
		withSmalltalkSearch;
		send: [ :selection | 
			(selection notNil and: [ selection size = 1 ]) 
				ifTrue: [ selection anyOne value ] 
				ifFalse: [ selection collect: #value ] ];
		showOnly: 50;
		helpMessage: 'Quick selection field. Given your INPUT, it executes: self select: [:each | INPUT ]'! !

!SmallDictionary methodsFor: 'accessing - associations' stamp: 'StephaneDucasse 12/25/2009 12:12'!
associations
	"Answer a Collection containing the receiver's associations."
	"Suggested by l. Uzonyi"
	
	^Array new: self size streamContents: [ :stream |
 		self associationsDo: [ :each | stream nextPut: each ] ]! !

!SmallDictionary methodsFor: 'adding' stamp: 'cyrille.delaunay 7/20/2009 13:19'!
declare: key from: aDictionary 
	"Add key to the receiver. If key already exists, do nothing. If aDictionary 
	includes key, then remove it from aDictionary and use its association as 
	the element of the receiver."

	(self includesKey: key) ifTrue: [^ self].
	(aDictionary includesKey: key)
		ifTrue: 
			[self add: (aDictionary associationAt: key).
			aDictionary removeKey: key]
		ifFalse: 
			[self add: key -> nil]! !

!SmallDictionary methodsFor: 'accessing - keys' stamp: 'StephaneDucasse 5/28/2011 13:35'!
keyAtIdentityValue: value ifAbsent: exceptionBlock
	"Answer the key that is the external name for the argument, value. If 
	there is none, answer the result of evaluating exceptionBlock.
	Note: There can be multiple keys with the same value. Only one is returned."
 	
	| index |
	index := (values identityIndexOf: value).
	index = 0 
		ifTrue: [ ^ exceptionBlock value].
	^ keys at: index.
! !

!SmallDictionary methodsFor: 'removing - keys and values' stamp: 'CamilloBruni 3/23/2013 12:22'!
removeAll
	self initialize.! !

!SmallDictionary methodsFor: 'private - growing' stamp: 'cyrille.delaunay 7/20/2009 13:26'!
privateAt: key put: value 
	size == keys size ifTrue: [self growKeysAndValues].
	size := size + 1.
	keys at: size put: key.
	^values at: size put: value! !

!SmallDictionary methodsFor: 'removing - keys and values' stamp: 'cyrille.delaunay 7/20/2009 13:24'!
keysAndValuesRemove: keyValueBlock
	"Removes all entries for which keyValueBlock returns true."
	"When removing many items, you must not do it while iterating over the dictionary, since it may be changing.  This method takes care of tallying the removals in a first pass, and then performing all the deletions afterward.  Many places in the sytem could be simplified by using this method."

	| removals |
	removals := OrderedCollection new.
	self keysAndValuesDo:
		[:key :value | (keyValueBlock value:  key value:  value)
			ifTrue: [removals add:  key]].
 	removals do:
		[:aKey | self removeKey: aKey]! !

!SmallDictionary methodsFor: 'accessing - values' stamp: 'CamilloBruni 3/23/2013 12:21'!
at: key ifPresent: oneArgBlock ifAbsent: absentBlock
	"Lookup the given key in the receiver. If it is present, answer the value of evaluating the oneArgBlock with the value associated with the key, otherwise answer the value of absentBlock."
	
	self at: key ifPresent: [ :v | ^oneArgBlock value: v ].
	^absentBlock value! !

!SmallDictionary methodsFor: 'enumerating - assoctiations' stamp: ''!
associationsDo: aBlock 
	self keysAndValuesDo: [:key :value | aBlock value: key -> value]! !

!SmallDictionary methodsFor: 'accessing - associations' stamp: 'StephaneDucasse 5/28/2011 13:35'!
associationAt: key ifAbsent: aBlock 
	"Answer the association with the given key.
	If key is not found, return the result of evaluating aBlock."

	| index value |
	index := keys indexOf: key.
	index = 0 ifTrue: [ ^ aBlock value].
	
	value := values at: index.
	^ key->value.! !

!SmallDictionary methodsFor: 'accessing - values' stamp: 'CamilloBruni 4/11/2011 13:31'!
at: key 
	"Answer the value associated with the key."

	^ self at: key ifAbsent: [self errorKeyNotFound: key]! !

!SmallDictionary methodsFor: 'adding' stamp: ''!
add: anAssociation 
	self at: anAssociation key put: anAssociation value.
	^anAssociation! !

!SmallDictionary methodsFor: 'accessing - values' stamp: 'StephaneDucasse 5/28/2011 13:35'!
at: key ifAbsent: aBlock 
	"Answer the value associated with the key or, if key isn't found,
	answer the result of evaluating aBlock."

	| index |
	index := self findIndexForKey:  key.
	index = 0 ifTrue: [^ aBlock value].
	
	^ values at: index.

	"| assoc |
	assoc := array at: (self findElementOrNil: key).
	assoc ifNil: [^ aBlock value].
	^ assoc value"! !

!SmallDictionary methodsFor: 'private' stamp: 'SvenVanCaekenberghe 4/19/2011 20:30'!
errorValueNotFound: value

	ValueNotFound signalFor: value! !

!SmallDictionary methodsFor: 'testing' stamp: 'cyrille.delaunay 7/20/2009 13:24'!
hasBindingThatBeginsWith: aString
	"Answer true if the receiver has a key that begins with aString, false otherwise"
	
	self keysDo:[:each | 
		(each beginsWith: aString)
			ifTrue:[^true]].
	^false! !

!SmallDictionary methodsFor: 'accessing' stamp: ''!
size
	^size! !

!SmallDictionary methodsFor: 'printing' stamp: 'pmm 7/4/2009 12:37'!
storeOn: aStream
	| noneYet |
	aStream nextPutAll: '(('.
	aStream nextPutAll: self class name.
	aStream nextPutAll: ' new)'.
	noneYet := true.
	self associationsDo: [ :each | 
			noneYet
				ifTrue: [ noneYet := false ]
				ifFalse: [ aStream nextPut: $; ].
			aStream nextPutAll: ' add: '.
			aStream store: each].
	noneYet ifFalse: [ aStream nextPutAll: '; yourself'].
	aStream nextPut: $)! !

!SmallDictionary methodsFor: 'accessing - keys' stamp: 'nice 12/5/2009 20:23'!
keys
	"Answer an Array containing the receiver's keys."
	
	^ keys copyFrom: 1 to: size! !

!SmallDictionary methodsFor: 'removing - keys' stamp: 'cyrille.delaunay 7/20/2009 13:23'!
remove: oldObject ifAbsent: anExceptionBlock 
	self removeKey: oldObject key ifAbsent: anExceptionBlock.
	^oldObject! !

!SmallDictionary methodsFor: 'accessing - keys' stamp: 'StephaneDucasse 5/28/2011 13:36'!
keyAtValue: value ifAbsent: exceptionBlock
	"Answer the key that is the external name for the argument, value. If 
	there is none, answer the result of evaluating exceptionBlock.
	: Use =, not ==, so stings like 'this' can be found.  Note that MethodDictionary continues to use == so it will be fast."
	
	| index |
	index := (values indexOf: value).
	index = 0 
		ifTrue: [ ^ exceptionBlock value].
		
	^ keys at: index.

! !

!SmallDictionary methodsFor: 'enumerating - keys' stamp: 'cyrille.delaunay 7/20/2009 13:21'!
keysDo: aBlock 
	1 to: size do: [:i | aBlock value: (keys at: i)]! !

!SmallDictionary methodsFor: 'testing - values' stamp: 'cyrille.delaunay 7/20/2009 13:25'!
includes: aValue
	self do: [:each | aValue = each ifTrue: [^true]].
	^false! !

!SmallDictionary methodsFor: 'enumerating - values' stamp: 'CamilloBruni 10/20/2012 21:51'!
select: aBlock 
	"Evaluate aBlock with each of my values as the argument. Collect into a
	new dictionary, only those associations for which aBlock evaluates to
	true."

	| newCollection |
	newCollection := self copyEmpty.
	self associationsDo: 
		[:each | 
		(aBlock value: each value) ifTrue: [newCollection add: each]].
	^newCollection! !

!SmallDictionary methodsFor: 'accessing - keys' stamp: 'SvenVanCaekenberghe 4/19/2011 20:31'!
keyAtValue: value 
	"Answer the key that is the external name for the argument, value. If 
	there is none, answer nil."

	^self keyAtValue: value ifAbsent: [self errorValueNotFound: value]! !

!SmallDictionary methodsFor: 'enumerating - values' stamp: 'cyrille.delaunay 7/20/2009 13:21'!
do: aBlock

	^ self valuesDo: aBlock.! !

!SmallDictionary methodsFor: 'comparing' stamp: 'cyrille.delaunay 7/20/2009 13:20'!
= aDictionary
	"Two dictionaries are equal if
	 (a) they are the same 'kind' of thing.
	 (b) they have the same set of keys.
	 (c) for each (common) key, they have the same value"

	self == aDictionary ifTrue: [ ^ true ].
	(aDictionary isDictionary) ifFalse: [^false].
	self size = aDictionary size ifFalse: [^false].
	self associationsDo: [:assoc|
		(aDictionary at: assoc key ifAbsent: [^false]) = assoc value
			ifFalse: [^false]].
	^true
! !

!SmallDictionary methodsFor: 'removing - keys' stamp: 'cyrille.delaunay 7/20/2009 13:23'!
remove:anAssociation

	self removeKey:anAssociation key.! !

!SmallDictionary methodsFor: 'private' stamp: 'cyrille.delaunay 7/20/2009 13:30'!
findIndexForKey: aKey 
	^ keys indexOf: aKey.! !

!SmallDictionary methodsFor: 'testing' stamp: 'cyrille.delaunay 7/20/2009 13:24'!
isDictionary
	^true! !

!SmallDictionary methodsFor: 'enumerating - keys and values' stamp: 'cyrille.delaunay 7/20/2009 13:21'!
keysAndValuesDo: aBlock
	1 to: size do: [:i | aBlock value: (keys at: i) value: (values at: i)]! !

!SmallDictionary methodsFor: 'accessing - associations' stamp: 'CamilloBruni 4/11/2011 13:31'!
associationAt: key 
	^ self associationAt: key ifAbsent: [self errorKeyNotFound: key]! !

!SmallDictionary methodsFor: 'private - growing' stamp: 'cyrille.delaunay 7/20/2009 13:26'!
growTo: aSize 
	| newKeys newValues |
	newKeys := Array new: aSize.
	newValues := Array new: aSize.
	1 to: size
		do: 
			[:i | 
			newKeys at: i put: (keys at: i).
			newValues at: i put: (values at: i)].
	keys := newKeys.
	values := newValues! !

!SmallDictionary methodsFor: 'private - growing' stamp: 'cyrille.delaunay 7/20/2009 13:26'!
growKeysAndValues
	self growTo: size * 2! !

!SmallDictionary methodsFor: 'accessing - keys' stamp: 'SeanDeNigris 6/21/2012 08:52'!
unreferencedKeys

	
	^'Scanning for references . . .' 
		displayProgressFrom: 0 to: self size
		during: 
			[:bar | | n | 
			n := 0.
			self keys select: 
					[:key | 
					bar current: (n := n + 1).
					(self systemNavigation allReferencesTo: (self associationAt: key)) isEmpty]]! !

!SmallDictionary methodsFor: 'private' stamp: 'SvenVanCaekenberghe 4/19/2011 19:41'!
errorKeyNotFound: aKey

	KeyNotFound signalFor: aKey! !

!SmallDictionary class methodsFor: 'instance creation' stamp: ''!
new: aSize 
	"Ignore the size"

	^self basicNew initialize! !

!SmallDictionary class methodsFor: '*Spec-Inspector' stamp: 'NicolaiHess 12/14/2013 22:47'!
inspectorClass
    ^ EyeDictionaryInspector! !

!SmallDictionaryTest commentStamp: 'TorstenBergmann 2/20/2014 15:22'!
SUnit tests for small dictionaries!
!SmallDictionaryTest methodsFor: 'requirements' stamp: 'delaunay 5/4/2009 13:43'!
classToBeTested

	^ SmallDictionary! !

!SmallDictionaryTest methodsFor: 'test - printing' stamp: 'sd 7/21/2009 10:17'!
testStoreOn
	"self debug: #testStoreOn"
	
	self assert: self nonEmptyDict storeString = ('((', self nonEmptyDict class printString , ' new) add: (#a->1); add: (#b->30); add: (#c->1); add: (#d->-2); yourself)')! !

!SmallDictionaryTest class methodsFor: 'building suites' stamp: 'cyrille.delaunay 7/1/2009 16:22'!
shouldInheritSelectors

^true! !

!SmallIdentityDictionary commentStamp: 'sd 7/21/2009 10:12'!
I'm a SmallDictionary (this means faster than default one when dealing with limited number of items)
but I check my key based on identity.!
!SmallIdentityDictionary methodsFor: 'private' stamp: 'cyrille.delaunay 7/20/2009 13:30'!
findIndexForKey: aKey 
	^ keys identityIndexOf: aKey! !

!SmallIdentityDictionaryTest commentStamp: 'TorstenBergmann 2/20/2014 15:22'!
SUnit tests for small identity dictionaries!
!SmallIdentityDictionaryTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 7/1/2009 16:23'!
classToBeTested 

^ SmallIdentityDictionary! !

!SmallInteger commentStamp: '<historical>'!
My instances are 31-bit numbers, stored in twos complement form. The allowable range is approximately +- 1 billion (see SmallInteger minVal, maxVal).!
!SmallInteger methodsFor: 'system primitives' stamp: ''!
instVarAt: i 
	"Small integer has to be specially handled."

	i = 1 ifTrue: [^self].
	self error: 'argument too big for small integer instVarAt:'! !

!SmallInteger methodsFor: 'memory' stamp: 'MarianoMartinezPeck 10/1/2010 11:11'!
sizeInMemory
    "SmallInteger occupy 0 bytes since the only space occupied by a SmallInteger is the space of the slot containing it.  There is no SmallInteger object beyond the slot. From another POV, it could be 4, the size of the slot. But we don't count the size of the slots, they are already counted in the containing object, that's why it should answer 0."
   ^0.! !

!SmallInteger methodsFor: 'printing' stamp: 'ul 11/30/2010 01:38'!
printOn: stream base: base length: minimumLength padded: padWithZeroes

	| n numberOfDigits totalLength divisor |
	self < 0
		ifTrue: [
			n := self negated.
			totalLength := 1 ]
		ifFalse: [
			n := self.
			totalLength := 0 ].
	numberOfDigits := n numberOfDigitsInBase: base.
	totalLength := totalLength + numberOfDigits.
	padWithZeroes ifFalse: [
		[ totalLength < minimumLength ] whileTrue: [
			stream space.
			totalLength := totalLength + 1 ] ].
	n = self ifFalse: [ stream nextPut: $- ].
	padWithZeroes ifTrue: [
		[ totalLength < minimumLength ] whileTrue: [
			stream nextPut: $0.
			totalLength := totalLength + 1 ] ].
	divisor := (base raisedToInteger: numberOfDigits - 1).
	[ divisor > 0 ] whileTrue: [
		| digit |
		digit := n // divisor.
		stream nextPut: ('0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ' at: digit + 1).
		n := n - (digit * divisor).
		divisor := divisor // base ]! !

!SmallInteger methodsFor: 'comparing' stamp: ''!
< aNumber 
	"Primitive. Compare the receiver with the argument and answer with
	true if the receiver is less than the argument. Otherwise answer false.
	Fail if the argument is not a SmallInteger. Essential. No Lookup. See
	Object documentation whatIsAPrimitive."

	<primitive: 3>
	^super < aNumber! !

!SmallInteger methodsFor: 'bit manipulation' stamp: 'mir 9/25/2008 15:18'!
bitXor: arg 
	"Primitive. Answer an Integer whose bits are the logical XOR of the
	receiver's bits and those of the argument, arg.
	Numbers are interpreted as having 2's-complement representation.
	Essential.  See Object documentation whatIsAPrimitive."

	<primitive: 16>
	self >= 0 ifTrue: [^ arg bitXor: self].
	^ arg < 0
		ifTrue: [self bitInvert bitXor: arg bitInvert]
		ifFalse: [(self bitInvert bitXor: arg) bitInvert].! !

!SmallInteger methodsFor: 'arithmetic' stamp: 'tk 11/30/2001 11:53'!
\\ aNumber 
	"Primitive. Take the receiver modulo the argument. The result is the
	remainder rounded towards negative infinity, of the receiver divided by
	the argument Fail if the argument is 0 or is not a SmallInteger. Optional.
	No Lookup. See Object documentation whatIsAPrimitive."

	<primitive: 11>
	^ super \\ aNumber 	"will use // to compute it if primitive fails"! !

!SmallInteger methodsFor: 'printing' stamp: 'nice 2/15/2008 22:22'!
numberOfDigitsInBase: b 
	"Return how many digits are necessary to print this number in base b.
	Mostly same as super but an optimized version for base 10 case"
	
	b = 10 ifFalse: [^super numberOfDigitsInBase: b].
	self < 0 ifTrue: [^self negated numberOfDigitsInBase: b].
	^self decimalDigitLength! !

!SmallInteger methodsFor: 'arithmetic' stamp: 'tk 11/30/2001 11:55'!
// aNumber 
	"Primitive. Divide the receiver by the argument and answer with the
	result. Round the result down towards negative infinity to make it a
	whole integer. Fail if the argument is 0 or is not a SmallInteger.
	Essential. No Lookup. See Object documentation whatIsAPrimitive. "

	<primitive: 12>
	^ super // aNumber 	"Do with quo: if primitive fails"! !

!SmallInteger methodsFor: 'printing' stamp: 'RAA 8/24/2001 13:59'!
threeDigitName

	| units answer |

	self = 0 ifTrue: [^''].
	units := #('one' 'two' 'three' 'four' 'five' 'six' 'seven' 'eight' 'nine' 'ten' 
		'eleven' 'twelve' 'thirteen' 'fourteen' 'fifteen' 'sixteen' 'seventeen' 
		'eighteen' 'nineteen').
	self > 99 ifTrue: [
		answer := (units at: self // 100),' hundred'.
		(self \\ 100) = 0 ifFalse: [
			answer := answer,' ',(self \\ 100) threeDigitName
		].
		^answer
	].
	self < 20 ifTrue: [
		^units at: self
	].
	answer := #('twenty' 'thirty' 'forty' 'fifty' 'sixty' 'seventy' 'eighty' 'ninety')
			at: self // 10 - 1.
	(self \\ 10) = 0 ifFalse: [
		answer := answer,'-',(units at: self \\ 10)
	].
	^answer! !

!SmallInteger methodsFor: 'private' stamp: 'nice 11/27/2009 19:58'!
highBitOfPositiveReceiver
	| shifted bitNo |
	"Answer the index of the high order bit of the receiver, or zero if the 
	receiver is zero. Receiver has to be positive!!"
	shifted := self.
	bitNo := 0.
	[shifted < 65536]
		whileFalse: 
			[shifted := shifted bitShift: -16.
			bitNo := bitNo + 16].
	shifted < 256
		ifFalse: 
			[shifted := shifted bitShift: -8.
			bitNo := bitNo + 8].
		
	"The high bits table can be obtained with:
	(1 to: 8) inject: #[0] into: [:highBits :rank | highBits , (highBits collect: [:e | rank])]."
	^bitNo + ( #[0 1 2 2 3 3 3 3 4 4 4 4 4 4 4 4 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8] at: shifted + 1)! !

!SmallInteger methodsFor: 'bit manipulation' stamp: 'bf 9/25/2008 15:18'!
bitAnd: arg 
	"Primitive. Answer an Integer whose bits are the logical OR of the
	receiver's bits and those of the argument, arg.
	Numbers are interpreted as having 2's-complement representation.
	Essential.  See Object documentation whatIsAPrimitive."

	<primitive: 14>
	self >= 0 ifTrue: [^ arg bitAnd: self].
	^ (self bitInvert bitOr: arg bitInvert) bitInvert.! !

!SmallInteger methodsFor: 'testing' stamp: 'nice 8/31/2008 00:07'!
isLarge
	^false! !

!SmallInteger methodsFor: '*Fuel-Collections' stamp: 'MarianoMartinezPeck 4/20/2012 23:30'!
largeIdentityHash
	"Return an integer between 0 and 4095 based on all of my bits. Make sure that for nearby receivers the result will not be nearby with high probability."

	| remainder hash |
	self >= 0 
		ifTrue: [
			remainder := self.
			hash := 0 ]
		ifFalse: [
			remainder := 0 - self.
			hash := 4095 ].
	[ 
		hash := hash bitXor: (remainder bitAnd: 4095).
		(remainder := remainder bitShift: -12) = 0 ] whileFalse.
	^FLLargeIdentityHashedCollection permuteHash: hash + 1! !

!SmallInteger methodsFor: 'comparing' stamp: ''!
>= aNumber 
	"Primitive. Compare the receiver with the argument and answer true if
	the receiver is greater than or equal to the argument. Otherwise answer
	false. Fail if the argument is not a SmallInteger. Optional. No Lookup.
	See Object documentation whatIsAPrimitive."

	<primitive: 6>
	^super >= aNumber! !

!SmallInteger methodsFor: 'system primitives' stamp: 'je 10/22/2002 12:10'!
nextObject
	"SmallIntegers are immediate objects, and, as such, do not have successors in object memory."

	self shouldNotImplement ! !

!SmallInteger methodsFor: 'system primitives' stamp: 'tk 5/14/1999 20:54'!
nextInstance
	"SmallIntegers can't be enumerated this way.  There are a finite number of them from from (SmallInteger minVal) to (SmallInteger maxVal), but you'll have to enumerate them yourself with:
	(SmallInteger minVal) to: (SmallInteger maxVal) do: [:integer | <your code here>].
	"

	self shouldNotImplement ! !

!SmallInteger methodsFor: 'arithmetic' stamp: 'LC 4/22/1998 14:21'!
gcd: anInteger 
	"See SmallInteger (Integer) | gcd:"
	| n m |
	n := self.
	m := anInteger.
	[n = 0]
		whileFalse: 
			[n := m \\ (m := n)].
	^ m abs! !

!SmallInteger methodsFor: 'printing' stamp: 'nice 7/6/2008 00:48'!
printStringBase: b 
	"Return a String representation of this number in base b.
	For SmallIntegers, it is more efficient to print directly in a String,
	rather than using a Stream like super."

	self < 0
		ifTrue: [^ '-'
				, (self negated printStringBase: b)].
	self < b
		ifTrue: [^ String
				with: (Character digitValue: self)].
	^ self printStringBase: b nDigits: (self numberOfDigitsInBase: b)! !

!SmallInteger methodsFor: 'bit manipulation' stamp: 'nice 11/27/2009 19:49'!
lowBit
	" Answer the index of the low order one bit.
		2r00101000 lowBit       (Answers: 4)
		2r-00101000 lowBit      (Answers: 4)
	  First we skip bits in groups of 8, then do a lookup in a table.
	  While not optimal, this is a good tradeoff; long
	  integer #lowBit always invokes us with bytes."
	| n result lastByte |
	n := self.
	n = 0 ifTrue: [ ^ 0 ].
	result := 0.
	[(lastByte := n bitAnd: 16rFF) = 0]
		whileTrue: [
			result := result + 8.
			n := n bitShift: -8 ].

	"The low bits table can be obtained with:
	((1 to: 8) inject: #[1] into: [:lowBits :rank | (lowBits copy at: 1 put: lowBits first + 1; yourself) , lowBits]) allButFirst."
	^result + ( #[1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 6 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 7 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 6 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 8 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 6 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 7 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 6 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1] at: lastByte)! !

!SmallInteger methodsFor: 'pointers' stamp: 'MarianoMartinezPeck 1/18/2012 22:52'!
pointsTo: anObject
	"Answers true if I hold a reference to anObject, or false otherwise. But since SmallIntegers do not have pointers, it always answers false"
	^false
! !

!SmallInteger methodsFor: 'system primitives' stamp: 'MartinMcClure 1/12/2010 21:12'!
basicIdentityHash

	^self! !

!SmallInteger methodsFor: 'private' stamp: ''!
fromString: str radix: radix

	| maxdigit c val |
	maxdigit := 
		radix + (radix > 10
					ifTrue: [55 - 1]
					ifFalse: [48 - 1]).
	val := 0.
	1 to: str size do: 
		[:i | 
		c := str at: i.
		(c < 48 ifFalse: [c > maxdigit])
			ifTrue: [^false].
		val := val * radix + (c <= 57
							ifTrue: [c - 48]
							ifFalse: 
								[c < 65 ifTrue: [^false].
								c - 55])].
	^val! !

!SmallInteger methodsFor: 'testing' stamp: ''!
odd

	^(self bitAnd: 1) = 1! !

!SmallInteger methodsFor: 'arithmetic' stamp: 'tak 9/25/2008 15:14'!
/ aNumber 
	"Primitive. This primitive (for /) divides the receiver by the argument
	and returns the result if the division is exact. Fail if the result is not a
	whole integer. Fail if the argument is 0 or is not a SmallInteger. Optional.
	No Lookup. See Object documentation whatIsAPrimitive."

	<primitive: 10>
	aNumber isZero ifTrue: [^(ZeroDivide dividend: self) signal].
	^(aNumber isMemberOf: SmallInteger)
		ifTrue: [(Fraction numerator: self denominator: aNumber) reduced]
		ifFalse: [super / aNumber]! !

!SmallInteger methodsFor: 'printing' stamp: 'ul 12/8/2010 04:00'!
printOn: aStream base: b nDigits: n 
	"Append a representation of this number in base b on aStream using nDigits.
	self must be positive."

	self printOn: aStream base: b length: n padded: true! !

!SmallInteger methodsFor: 'system primitives' stamp: 'tk 3/24/1999 20:28'!
digitAt: n 
	"Answer the value of an indexable field in the receiver.  LargePositiveInteger uses bytes of base two number, and each is a 'digit' base 256.  Fail if the argument (the index) is not an Integer or is out of bounds."
	n>4 ifTrue: [^ 0].
	self < 0
		ifTrue: 
			[self = SmallInteger minVal ifTrue:
				["Can't negate minVal -- treat specially"
				^ #(0 0 0 64) at: n].
			^ ((0-self) bitShift: (1-n)*8) bitAnd: 16rFF]
		ifFalse: [^ (self bitShift: (1-n)*8) bitAnd: 16rFF]! !

!SmallInteger methodsFor: 'arithmetic' stamp: 'ul 11/15/2010 10:12'!
quo: aNumber 
	"Primitive. Divide the receiver by the argument and answer with the 
	result. Round the result down towards zero to make it a whole integer. 
	Fail if the argument is 0 or is not a SmallInteger. Optional. See Object 
	documentation whatIsAPrimitive."
	<primitive: 13>
	aNumber = 0 ifTrue: [^ (ZeroDivide dividend: self) signal].
	(aNumber isMemberOf: SmallInteger)
		ifFalse: [^ super quo: aNumber].
	(aNumber = -1 and: [self = self class minVal])
		ifTrue: ["result is aLargeInteger" ^ self negated].
	self primitiveFailed! !

!SmallInteger methodsFor: 'bit manipulation' stamp: 'di 4/30/1998 10:33'!
bitOr: arg 
	"Primitive. Answer an Integer whose bits are the logical OR of the
	receiver's bits and those of the argument, arg.
	Numbers are interpreted as having 2's-complement representation.
	Essential.  See Object documentation whatIsAPrimitive."

	<primitive: 15>
	self >= 0 ifTrue: [^ arg bitOr: self].
	^ arg < 0
		ifTrue: [(self bitInvert bitAnd: arg bitInvert) bitInvert]
		ifFalse: [(self bitInvert bitClear: arg) bitInvert]! !

!SmallInteger methodsFor: 'bit manipulation' stamp: 'mir 9/25/2008 15:18'!
bitShift: arg 
	"Primitive. Answer an Integer whose value is the receiver's value shifted
	left by the number of bits indicated by the argument. Negative arguments
	shift right. The receiver is interpreted as having 2's-complement representation.
	Essential.  See Object documentation whatIsAPrimitive."

	<primitive: 17>
	self >= 0 ifTrue: [^ super bitShift: arg].
	^ arg >= 0
		ifTrue: [(self negated bitShift: arg) negated]
		ifFalse: [(self bitInvert bitShift: arg) bitInvert].! !

!SmallInteger methodsFor: 'converting' stamp: 'ajh 7/25/2001 22:34'!
as31BitSmallInt
	"Polymorphic with LargePositiveInteger (see comment there).
	 Return self since all SmallIntegers are 31 bits"

	^ self! !

!SmallInteger methodsFor: 'system primitives' stamp: 'md 6/5/2003 10:42'!
digitAt: n put: value 
	"Fails. The digits of a small integer can not be modified."

	self error: 'You can''t store in a SmallInteger'! !

!SmallInteger methodsFor: '*Fuel' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper

	^aGeneralMapper visitSmallInteger: self! !

!SmallInteger methodsFor: 'arithmetic' stamp: 'di 2/1/1999 21:31'!
+ aNumber 
	"Primitive. Add the receiver to the argument and answer with the result
	if it is a SmallInteger. Fail if the argument or the result is not a
	SmallInteger  Essential  No Lookup. See Object documentation whatIsAPrimitive."

	<primitive: 1>
	^ super + aNumber! !

!SmallInteger methodsFor: 'arithmetic' stamp: ''!
- aNumber 
	"Primitive. Subtract the argument from the receiver and answer with the
	result if it is a SmallInteger. Fail if the argument or the result is not a
	SmallInteger. Essential. No Lookup. See Object documentation
	whatIsAPrimitive."

	<primitive: 2>
	^super - aNumber! !

!SmallInteger methodsFor: 'printing' stamp: 'nice 2/15/2008 21:39'!
printStringBase: b nDigits: n
	"Return a string representation of this number in base b with n digits (left padded with 0).
	Should be invoked with: 0 <= self < (b raisedToInteger: n)."
	
	| integer next result |
	result := String new: n.
	integer := self.
	n to: 1 by: -1 do: [:i |
		next := integer // b.
		result byteAt: i put: (Character digitValue: (integer - (next * b))).
		integer := next].
	^result! !

!SmallInteger methodsFor: 'printing' stamp: 'gk 5/25/2007 15:08'!
printString
	"Highly optimized version for base 10
	and that we know it is a SmallInteger."
	
	| integer next result len |
	self = 0 ifTrue: [^'0'].
	self < 0 ifTrue: [^'-', self negated printString].
	len := self decimalDigitLength.
	result := String new: len.
	integer := self.
	len to: 1 by: -1 do: [:i |
		next := integer // 10.
		result byteAt: i put: 48 + (integer - (next * 10)).
		integer := next].
	^result! !

!SmallInteger methodsFor: 'bit manipulation' stamp: 'SqR 8/3/2000 13:29'!
hashMultiply
	| low |

	low := self bitAnd: 16383.
	^(16r260D * low + ((16r260D * (self bitShift: -14) + (16r0065 * low) bitAnd: 16383) * 16384))
			bitAnd: 16r0FFFFFFF! !

!SmallInteger methodsFor: 'copying' stamp: 'tk 8/19/1998 16:04'!
veryDeepCopyWith: deepCopier
	"Return self.  I can't be copied.  Do not record me."! !

!SmallInteger methodsFor: 'printing' stamp: 'gk 5/25/2007 15:10'!
decimalDigitLength
	"Answer the number of digits printed out in base 10.
	Note that this only works for positive SmallIntegers."
	
	^ self < 10000
		ifTrue: [self < 100
				ifTrue: [self < 10
						ifTrue: [1]
						ifFalse: [2]]
				ifFalse: [self < 1000
						ifTrue: [3]
						ifFalse: [4]]]
		ifFalse: [self < 1000000
				ifTrue: [self < 100000
						ifTrue: [5]
						ifFalse: [6]]
				ifFalse: [self < 100000000
						ifTrue: [self < 10000000
								ifTrue: [7]
								ifFalse: [8]]
						ifFalse: [self < 1000000000
								ifTrue: [9]
								ifFalse: [10]]]]! !

!SmallInteger methodsFor: 'printing' stamp: 'ul 12/8/2010 03:59'!
printOn: stream base: base 
	"Append a representation of this number in base b on aStream."

	self printOn: stream base: base length: 0 padded: false! !

!SmallInteger methodsFor: 'bit manipulation' stamp: 'NicolasCellier 7/29/2011 23:29'!
bitStringLength
      "Always use as many bits as the native format to represent a SmallInteger"

      ^self class maxVal highBit + 1! !

!SmallInteger methodsFor: 'comparing' stamp: ''!
> aNumber 
	"Primitive. Compare the receiver with the argument and answer true if
	the receiver is greater than the argument. Otherwise answer false. Fail if
	the argument is not a SmallInteger. Essential. No Lookup. See Object
	documentation whatIsAPrimitive."

	<primitive: 4>
	^super > aNumber! !

!SmallInteger methodsFor: 'comparing' stamp: ''!
hash

	^self! !

!SmallInteger methodsFor: 'mathematical functions' stamp: 'jmv 10/13/2011 21:41'!
sqrt
	self negative ifTrue: [
		^ DomainError signal: 'sqrt undefined for number less than zero.' ].
	^super sqrt! !

!SmallInteger methodsFor: 'copying' stamp: ''!
deepCopy! !

!SmallInteger methodsFor: 'system primitives' stamp: ''!
digitLength
	"Answer the number of indexable fields in the receiver. This value is the 
	same as the largest legal subscript. Included so that a SmallInteger can 
	behave like a LargePositiveInteger or LargeNegativeInteger."

	(self < 16r100 and: [self > -16r100]) ifTrue: [^ 1].
	(self < 16r10000 and: [self > -16r10000]) ifTrue: [^ 2].
	(self < 16r1000000 and: [self > -16r1000000]) ifTrue: [^ 3].
	^ 4! !

!SmallInteger methodsFor: 'printing' stamp: 'MPW 1/1/1901 00:15'!
destinationBuffer:digitLength
  ^ LargePositiveInteger new: digitLength.! !

!SmallInteger methodsFor: 'copying' stamp: ''!
shallowCopy! !

!SmallInteger methodsFor: 'bit manipulation' stamp: 'VeronicaUquillas 6/11/2010 13:01'!
highBitOfMagnitude
	"Answer the index of the high order bit of the receiver, or zero if the  
	receiver is zero. This method is used for negative SmallIntegers as well,  
	since Pharo's LargeIntegers are sign/magnitude."
	
	self < 0 ifTrue: [
		"Beware: do not use highBitOfPositiveReceiver
		because self negated is not necessarily a SmallInteger
		(see SmallInteger minVal)"
		^self negated highBitOfMagnitude].
	
	"Implementation note: this method could be as well inlined here."
	^self highBitOfPositiveReceiver! !

!SmallInteger methodsFor: 'converting' stamp: ''!
asFloat
	"Primitive. Answer a Float that represents the value of the receiver.
	Essential. See Object documentation whatIsAPrimitive."

	<primitive: 40>
	self primitiveFailed! !

!SmallInteger methodsFor: 'comparing' stamp: ''!
= aNumber 
	"Primitive. Compare the receiver with the argument and answer true if
	the receiver is equal to the argument. Otherwise answer false. Fail if the
	argument is not a SmallInteger. Essential. No Lookup. See Object
	documentation whatIsAPrimitive. "

	<primitive: 7>
	^super = aNumber! !

!SmallInteger methodsFor: 'comparing' stamp: 'MartinMcClure 3/19/2010 00:09'!
identityHash

	^self hashMultiply! !

!SmallInteger methodsFor: 'testing' stamp: ''!
even

	^(self bitAnd: 1) = 0! !

!SmallInteger methodsFor: 'bit manipulation' stamp: 'sr 6/8/2000 02:07'!
highBit
	"Answer the index of the high order bit of the receiver, or zero if the  
	receiver is zero. Raise an error if the receiver is negative, since  
	negative integers are defined to have an infinite number of leading 1's 
	in 2's-complement arithmetic. Use >>highBitOfMagnitude if you want to 
	get the highest bit of the magnitude."
	self < 0 ifTrue: [^ self error: 'highBit is not defined for negative integers'].
	^ self highBitOfPositiveReceiver! !

!SmallInteger methodsFor: 'arithmetic' stamp: 'di 2/1/1999 21:29'!
* aNumber 
	"Primitive. Multiply the receiver by the argument and answer with the
	result if it is a SmallInteger. Fail if the argument or the result is not a
	SmallInteger. Essential. No Lookup. See Object documentation whatIsAPrimitive."

	<primitive: 9>
	^ super * aNumber! !

!SmallInteger methodsFor: 'comparing' stamp: ''!
<= aNumber 
	"Primitive. Compare the receiver with the argument and answer true if
	the receiver is less than or equal to the argument. Otherwise answer
	false. Fail if the argument is not a SmallInteger. Optional. No Lookup.
	See Object documentation whatIsAPrimitive. "

	<primitive: 5>
	^super <= aNumber! !

!SmallInteger methodsFor: 'comparing' stamp: ''!
~= aNumber 
	"Primitive. Compare the receiver with the argument and answer true if
	the receiver is not equal to the argument. Otherwise answer false. Fail if
	the argument is not a SmallInteger. Essential. No Lookup. See Object
	documentation whatIsAPrimitive."

	<primitive: 8>
	^super ~= aNumber! !

!SmallInteger class methodsFor: 'class initialization' stamp: 'EstebanLorenzano 11/23/2014 14:22'!
initialize
	SmalltalkImage current addToStartUpList: self before: Delay.
	self startUp: true! !

!SmallInteger class methodsFor: 'constants' stamp: 'EstebanLorenzano 11/23/2014 14:24'!
minVal
	"Answer the minimum value for a SmallInteger."
	^ minVal! !

!SmallInteger class methodsFor: 'instance creation' stamp: 'tk 4/20/1999 14:17'!
basicNew

	self error: 'SmallIntegers can only be created by performing arithmetic'! !

!SmallInteger class methodsFor: 'instance creation' stamp: 'tk 4/20/1999 14:18'!
new

	self basicNew	"generates an error"! !

!SmallInteger class methodsFor: 'constants' stamp: 'EstebanLorenzano 11/23/2014 14:23'!
maxVal
	"Answer the maximum value for a SmallInteger."
	^ maxVal! !

!SmallInteger class methodsFor: 'class initialization' stamp: 'EstebanLorenzano 11/23/2014 14:22'!
startUp: resuming
	"The image is either being newly started (resuming is true), or it's just been snapshotted.
	 If this has just been a snapshot, skip all the startup stuff."
	| next val |
	resuming ifFalse: [^self].
	val := -32768. "Assume at least 16 bits"
	[next := val + val.
	next class == self] whileTrue:
		[val := next].
	minVal := val.
	maxVal := -1 - val! !

!SmallInteger class methodsFor: 'documentation' stamp: ''!
guideToDivision
	"Handy guide to the kinds of Integer division: 
	/  exact division, returns a fraction if result is not a whole integer. 
	//  returns an Integer, rounded towards negative infinity. 
	\\ is modulo rounded towards negative infinity. 
	quo:  truncated division, rounded towards zero."! !

!SmallIntegerLayout commentStamp: '<historical>'!
I am the special layout for SmallIntegers.

SmallIntegers are typically implemented as tagged pointers and thus require a special format.!
!SmallIntegerLayout methodsFor: 'format' stamp: 'ToonVerwaest 4/1/2011 04:12'!
format
	^ 2! !

!SmallIntegerLayout methodsFor: 'initialization' stamp: 'CamilloBruni 10/16/2011 20:21'!
initialize
	super initialize.
	self host: SmallInteger.! !

!SmallIntegerLayout methodsFor: 'extending' stamp: 'MartinDias 12/9/2013 11:38'!
extend: newScope
	^ FixedLayout new slotScope: newScope! !

!SmallIntegerLayout class methodsFor: 'instance creation' stamp: 'MarcusDenker 11/20/2014 17:01'!
extending: superLayout scope: aScope host: aClass
	^ superLayout extendSmallInteger
		host: aClass;
		yourself! !

!SmallIntegerTest commentStamp: 'fbs 3/8/2004 22:13'!
I provide a test suite for SmallInteger values. Examine my tests to see how SmallIntegers should behave, and see how to use them.!
!SmallIntegerTest methodsFor: 'tests - Class Methods' stamp: 'StephaneDucasse 6/9/2012 22:56'!
testBasicNew

	self should: [SmallInteger basicNew] raise: self defaultTestError. ! !

!SmallIntegerTest methodsFor: 'tests - Class Methods' stamp: 'sd 6/5/2005 08:59'!
testMaxVal

	self assert: (SmallInteger maxVal = 16r3FFFFFFF).! !

!SmallIntegerTest methodsFor: 'tests - Class Methods' stamp: 'SeanDeNigris 5/18/2012 12:37'!
testDigitAt

	| number |
	number := 16rABCDEF.
	self assert: (number digitAt: 1) equals: 16rEF.
	self assert: (number digitAt: 2) equals: 16rCD.
	self assert: (number digitAt: 3) equals: 16rAB.! !

!SmallIntegerTest methodsFor: 'tests - printing' stamp: 'fbs 12/8/2005 12:58'!
testPrintPaddedWith

self assert: (123 printPaddedWith: $0 to: 10 base: 2)  = '0001111011'.
self assert: (123 printPaddedWith: $0 to: 10 base: 8)  = '0000000173'.
self assert: (123 printPaddedWith: $0 to: 10 base: 10) = '0000000123'.
self assert: (123 printPaddedWith: $0 to: 10 base: 16) = '000000007B'.! !

!SmallIntegerTest methodsFor: 'tests - Class Methods' stamp: 'sd 6/5/2005 08:59'!
testMinVal

	self assert: (SmallInteger minVal = -16r40000000).! !

!SmallIntegerTest methodsFor: 'tests - operations' stamp: 'AlexandreBergel 8/21/2011 17:44'!
testCeiling

	self assert: 2 ceiling = 2.
	self assert: -2 ceiling = -2.
	self assert: 2.1 ceiling = 3.
	self assert: -2.1 ceiling = -2.! !

!SmallIntegerTest methodsFor: 'tests - arithmetic' stamp: 'sd 6/5/2005 08:59'!
testDivide

	self assert: 2 / 1 = 2.
	self assert: (3 / 2) isFraction.
	self assert: 4 / 2 = 2.
	self should: [ 1 / 0 ] raise: ZeroDivide.! !

!SmallIntegerTest methodsFor: 'tests - printing' stamp: 'al 7/21/2008 21:48'!
testPrintString
	self assert: 1 printString  = '1'.
	self assert: -1 printString  = '-1'.
	self assert: SmallInteger minVal printString  = '-1073741824'.
	self assert: SmallInteger maxVal printString  = '1073741823'.
	self assert: 12345 printString  = '12345'.
	self assert: -54321 printString  = '-54321'.

	self assert: 0 decimalDigitLength = 1.
	self assert: 4 decimalDigitLength = 1.
	self assert: 12 decimalDigitLength = 2.
	self assert: 123 decimalDigitLength = 3.
	self assert: 1234 decimalDigitLength = 4.
	self assert: 56789 decimalDigitLength = 5.
	self assert: 657483 decimalDigitLength = 6.
	self assert: 6571483 decimalDigitLength = 7.
	self assert: 65174383 decimalDigitLength = 8.
	self assert: 625744831 decimalDigitLength = 9.
	self assert: 1000001111 decimalDigitLength = 10.
	self assert: SmallInteger maxVal decimalDigitLength = 10.! !

!SmallIntegerTest methodsFor: 'tests - Class Methods' stamp: 'StephaneDucasse 6/9/2012 22:56'!
testNew

	self should: [SmallInteger new] raise: self defaultTestError. ! !

!SmalllintManifestChecker commentStamp: '<historical>'!
SmalllintManifestChecker is responsible for running a set of rules on a given subsystem.

| rules checker | 
rules := RBCompositeLintRule allGoodRules resetResult.

"the resetResult is necessary because it will build a knid of cache of the result
and this cannot be done automatically (for example you may want to run several rules without invalidating the results). "

checker := SmalllintManifestChecker new
	runRules: rules onPackage: (RPackageOrganizer default packageNamed: #'Manifest-Core').!
!SmalllintManifestChecker methodsFor: 'actions' stamp: 'CamilleTeruel 11/14/2013 14:11'!
runRules: aCompositeRule onPackage: aPackage withoutTestCase: aBoolean

	rule := aCompositeRule.
	environment := RBPackageEnvironment package: aPackage.
	self flag: 'Instead of manually avoiding the testcases and traits? we should just modify the environment and subtract the testscases from the built package environment.'.
	environment classesDo: [ :class |
		(class isManifest
			or: [aBoolean and: [class allSuperclasses includes: TestCase ]])
					ifFalse: [
						(environment definesClass: class) ifTrue: [ self checkClass: class ].
						self checkMethodsForClass: class ] ]! !

!SmalllintManifestChecker methodsFor: 'manifest' stamp: 'StephaneDucasse 3/21/2013 10:50'!
rejectRulesOf: aPackage
		
	| mb |
	mb := self manifestBuilderOf: aPackage.
	^  mb isNil 
		ifTrue: [{}] 
		ifFalse: [ mb rejectRules]
	! !

!SmalllintManifestChecker methodsFor: 'accessing' stamp: 'StephaneDucasse 3/21/2013 13:09'!
manifestBuilderOfClass: aClass
	| key |
	key := aClass theNonMetaClass category.
	^ manifestClassCache
		at: key
		ifAbsentPut: [ 
			(self builderManifestClass hasManifestFor: aClass)
				ifTrue: [ self builderManifestClass of: aClass ]
				ifFalse: [ nil ] ]! !

!SmalllintManifestChecker methodsFor: 'manifest' stamp: 'StephaneDucasse 3/21/2013 10:43'!
isToDo: aCritic forRuleId: ruleId versionId: versionId 
	
	| mb |
	mb := self manifestBuilderOf: aCritic.
	^  mb isNil 
		ifTrue: [ false ] 
		ifFalse: [ mb containsToDo: aCritic onRule:  ruleId version: versionId ]
! !

!SmalllintManifestChecker methodsFor: 'manifest' stamp: 'StephaneDucasse 3/21/2013 13:11'!
cleanAllManifest
	| manifests |
	manifests := environment packages collect: [ :cl | self builderManifestClass of: cl ] as: Set.
	manifests do: [ :each | each cleanUp ]! !

!SmalllintManifestChecker methodsFor: 'actions' stamp: 'CamilloBruni 8/22/2013 11:49'!
runRules: aCompositeRule onPackage: aPackage

	rule := aCompositeRule.
	environment := RBPackageEnvironment package: aPackage.
	self run.! !

!SmalllintManifestChecker methodsFor: 'accessing' stamp: 'CamilleTeruel 11/12/2013 19:43'!
manifestBuilderOf: aPackage

	^ aPackage manifestBuilderForRuleChecker: self
	! !

!SmalllintManifestChecker methodsFor: 'manifest' stamp: 'StephaneDucasse 3/21/2013 10:51'!
toDoOf: aRule
	
	|critics rId rV mb |
	critics := self criticsOf: aRule. 
	rId := aRule class uniqueIdentifierName.
	rV := aRule class identifierMinorVersionNumber.
	^ critics select: [:critic |
		mb := (self manifestBuilderOf: critic).
		mb isNil 
			ifTrue: [ false ] 
			ifFalse: [ mb containsToDo: critic onRule:  rId version: rV ]]
	
	! !

!SmalllintManifestChecker methodsFor: 'manifest' stamp: 'StephaneDucasse 3/21/2013 10:43'!
falsePositiveOf: aRule
	
	|critics rId rV  mb |
	critics := self criticsOf: aRule. 
	rId := aRule class uniqueIdentifierName.
	rV := aRule class identifierMinorVersionNumber.
	^ critics select: [ :critic | mb := self manifestBuilderOf: critic.
						mb isNil 
							ifTrue: [ false ] 
							ifFalse: [ mb isFalsePositive: critic onRule:  rId version: rV ]]
	! !

!SmalllintManifestChecker methodsFor: 'accessing' stamp: 'StephaneDucasse 3/21/2013 13:10'!
manifestBuilderOfPackage: aPackage
	| key |
	key := aPackage packageName.
	^ manifestClassCache
		at: key
		ifAbsentPut: [ 
			(self builderManifestClass hasPackageNamed: key)
				ifTrue: [ self builderManifestClass ofPackageNamed: key ]
				ifFalse: [ nil ] ]! !

!SmalllintManifestChecker methodsFor: 'accessing' stamp: 'StephaneDucasse 1/6/2014 20:51'!
builderManifestClass
	^ TheManifestBuilder! !

!SmalllintManifestChecker methodsFor: 'accessing' stamp: 'StephaneDucasse 3/21/2013 10:42'!
criticsOf: aRule

	| rules |	
	rules := rule leaves detect: [:r |
		r class = aRule class] ifNone: [^{}].
	^ rules critics! !

!SmalllintManifestChecker methodsFor: 'initialization' stamp: 'StephaneDucasse 3/21/2013 10:43'!
initialize

	super initialize.
	manifestClassCache := Dictionary new.
! !

!SmalllintManifestChecker methodsFor: 'manifest' stamp: 'ChristopheDemarey 11/21/2014 16:22'!
isFalsePositive: aCritic forRuleId: ruleId versionId: versionId
	| mb |
	mb := self manifestBuilderOf: aCritic.
	^  mb isNil 
		ifTrue: [ false ] 
		ifFalse: [ mb isFalsePositive: aCritic onRule: ruleId version: versionId ]
! !

!SmalllintManifestChecker methodsFor: 'manifest' stamp: 'StephaneDucasse 3/21/2013 10:50'!
rejectClassesOf: aPackage
		
	| mb |
	mb := self manifestBuilderOf: aPackage.
	^  mb isNil 
		ifTrue: [{}] 
		ifFalse: [ mb rejectClasses ]
! !

!SmalllintManifestChecker methodsFor: 'manifest' stamp: 'StephaneDucasse 3/21/2013 10:44'!
isTruePositive: aCritic forRuleId: ruleId versionId: versionId 
	
	^ (self manifestBuilderOf: aCritic)
			containsTruePositive: aCritic onRule:  ruleId version: versionId
! !

!SmalllintManifestChecker methodsFor: 'accessing' stamp: 'SimonAllier 1/23/2013 17:12'!
rule
	^ rule! !

!SmalllintManifestChecker methodsFor: 'accessing' stamp: 'StephaneDucasse 3/21/2013 13:10'!
manifestBuilderOfMethod: aMethod
	| key cl |
	cl := aMethod methodClass.
	key := cl name , aMethod category asString.
	^ manifestClassCache
		at: key
		ifAbsentPut: [ 
			(self builderManifestClass hasManifestFor: aMethod)
				ifTrue: [ self builderManifestClass of: aMethod ]
				ifFalse: [ nil ] ]! !

!SmalllintManifestCheckerTest commentStamp: 'TorstenBergmann 2/19/2014 08:34'!
SUnit tests for SmalllintManifestChecker!
!SmalllintManifestCheckerTest methodsFor: 'tests' stamp: 'CamilloBruni 8/22/2013 11:46'!
testIsToDo

	| rule |
	rule  := RBCompositeLintRule allGoodRules.
	checker
		rule: rule;
		environment: self package asEnvironment;
		run.
	
	self assert: (checker isToDo:  (MFClassB>>#method3) forRuleId: (RBOnlyReadOrWrittenTemporaryRule uniqueIdentifierName) versionId:  1).
	self deny: (checker isToDo:  (MFClassB>>#method2) forRuleId: (RBOnlyReadOrWrittenTemporaryRule uniqueIdentifierName) versionId:  1).

! !

!SmalllintManifestCheckerTest methodsFor: 'running' stamp: 'MaxLeske 11/2/2014 17:21'!
tearDown
	
	self cleaningResources.
	ASTCache reset! !

!SmalllintManifestCheckerTest methodsFor: 'tests' stamp: 'CamilloBruni 8/22/2013 11:46'!
testToDoOf

	| rule |
	rule := RBCompositeLintRule allGoodRules.
	checker
		rule: rule;
		environment: self package asEnvironment;
		run.

	self assert: (( checker toDoOf: RBOnlyReadOrWrittenTemporaryRule new) anySatisfy: [:each| each = (MFClassB>>#method3)]).
	self deny: (( checker toDoOf: RBOnlyReadOrWrittenTemporaryRule new) anySatisfy: [:each| each = (MFClassB>>#method2)]).! !

!SmalllintManifestCheckerTest methodsFor: 'private' stamp: 'StephaneDucasse 3/21/2013 13:43'!
package 
	MCWorkingCopy managersForClass: MFClassA  do: [:p | ^ p packageSet packages first].
	" should be equivalent to RPackageOrganizer default packageNamed: #'Manifest-Resources-Tests' "! !

!SmalllintManifestCheckerTest methodsFor: 'tests' stamp: 'CamilloBruni 8/22/2013 11:46'!
testCriticsOf

	| rule |
	rule := RBCompositeLintRule allGoodRules.
	checker 
		rule: rule;
		environment: self package asEnvironment;
		run. 
	
	self assert: (checker criticsOf: RBOnlyReadOrWrittenTemporaryRule new) size  = 3.
	self assert: (( checker criticsOf: RBOnlyReadOrWrittenTemporaryRule new ) anySatisfy: [:each| each = (MFClassB>>#method3)]).
	self assert: (( checker criticsOf: RBOnlyReadOrWrittenTemporaryRule new) anySatisfy: [:each| each = (MFClassA>>#method)]).! !

!SmalllintManifestCheckerTest methodsFor: 'tests' stamp: 'CamilloBruni 8/22/2013 11:46'!
testIsFalsePositive 

	| rule |
	rule  := RBCompositeLintRule allGoodRules.
	checker
		rule: rule;
		environment: self package asEnvironment;
		run.  
	self assert: (checker isFalsePositive:  (MFClassB>>#method3) forRuleId: (RBCodeCruftLeftInMethodsRule uniqueIdentifierName) versionId:  1).
	self deny: (checker isFalsePositive:  (MFClassA>>#method) forRuleId: (RBCodeCruftLeftInMethodsRule uniqueIdentifierName) versionId:  1).

! !

!SmalllintManifestCheckerTest methodsFor: 'running' stamp: 'StephaneDucasse 3/21/2013 13:51'!
cleaningResources
	Smalltalk globals
		at: #ManifestManifestResourcesTests
		ifPresent: [ :cl | 
			cl
				removeFromChanges;
				removeFromSystemUnlogged ]! !

!SmalllintManifestCheckerTest methodsFor: 'running' stamp: 'StephaneDucasse 1/6/2014 20:51'!
setUp
	| bm |
	self cleaningResources.
	bm := TheManifestBuilder of: MFClassA.
	bm installFalsePositiveOf: RBCodeCruftLeftInMethodsRule uniqueIdentifierName version: 1.
	bm addFalsePositive: MFClassB >> #method3 of: RBCodeCruftLeftInMethodsRule uniqueIdentifierName version: 1.
	bm installToDoOf: RBOnlyReadOrWrittenTemporaryRule uniqueIdentifierName version: 1.
	bm
		addAllToDo:
			{(MFClassB >> #method3).
			(MFClassA >> #method)}
		of: RBOnlyReadOrWrittenTemporaryRule uniqueIdentifierName
		version: 1.
	checker := SmalllintManifestChecker new! !

!SmalllintManifestCheckerTest class methodsFor: 'as yet unclassified' stamp: 'SimonAllier 2/1/2013 16:18'!
DoIt
	^ MCWorkingCopy
		managersForClass: MFClassA
		do: [:p | ^ p first] ! !

!SmalltalkEditingState commentStamp: 'StephaneDucasse 2/6/2011 09:56'!
See EditingState comments.
SmalltalkEditingState is made to manage data for Smalltalk code editing sessions (such as a selector chooser).

Instance Variables:
   selectorChooser <SelectorChooserMorph>

- selectorChooser
The basic selector chooser which is popup to fetch available selectors or class names begining with a prefix. The prefix is token from the current caret location (see SelectorChooserMorph comments).
!
!SmalltalkEditingState methodsFor: 'events' stamp: 'GuillermoPolito 4/22/2012 17:22'!
keystroke: aKeyboardEvent from: aTextMorph
	| asciiValue |
	selectorChooser 
		ifNotNil: [(selectorChooser handlesKeyStroke: aKeyboardEvent) 
			ifTrue: [selectorChooser keyStroke: aKeyboardEvent.
				^ true]].
	asciiValue := aKeyboardEvent keyValue.
	asciiValue = Character cr asciiValue
		ifTrue: [self closeSelectorChooser.
			^ true].
	aKeyboardEvent controlKeyPressed
		ifTrue: [self closeSelectorChooser.
			^ true].
	"aKeyboardEvent commandKeyPressed
		ifTrue: [self closeSelectorChooser.
			^ true]."
	self updateSelectorChooserFrom: aTextMorph.
	^ false! !

!SmalltalkEditingState methodsFor: 'selector-chooser' stamp: 'AlainPlantec 11/19/2010 09:53'!
smartQuerySymbolFrom: aTextMorph
	| sel pref caret nextPref |
	sel := aTextMorph editor selectionInterval.
	aTextMorph editor selectPrecedingIdentifier.
	pref := aTextMorph selection asString.
	selectorChooser := SelectorChooserMorph popUpPrefix: pref from: aTextMorph.
	nextPref := selectorChooser 
		ifNotNil: [ selectorChooser nextPrefixWith: pref ].
	nextPref 
		ifNil: [aTextMorph editor selectInterval: sel]
		ifNotNil: [	selectorChooser prefix: nextPref.
			aTextMorph editor selectPrecedingIdentifier.
			aTextMorph editor replaceSelectionWith: nextPref.
			caret := aTextMorph editor selectionInterval first + nextPref size.
			aTextMorph editor selectInterval: (caret to: caret - 1)]! !

!SmalltalkEditingState methodsFor: 'selector-chooser' stamp: 'AlainPlantec 11/14/2010 17:11'!
closeSelectorChooser
	selectorChooser 
		ifNotNil: [ [selectorChooser delete] ensure: [selectorChooser := nil] ]! !

!SmalltalkEditingState methodsFor: 'events' stamp: 'AlainPlantec 11/15/2010 16:55'!
handlesKeyboard: evt from: aTextMorph
	^ (super handlesKeyboard: evt from: aTextMorph)
		or: [selectorChooser notNil and: [selectorChooser handlesKeyboard: evt]]! !

!SmalltalkEditingState methodsFor: 'selector-chooser' stamp: 'SvenVanCaekenberghe 1/8/2012 14:47'!
querySymbolFrom: aTextMorph
	| sel pref caret nextPref |
	sel := aTextMorph editor selectionInterval.
	aTextMorph editor hasSelection
		ifFalse: [aTextMorph editor selectPrecedingIdentifier].
	pref := String streamContents: [:strm |
		aTextMorph selection asString trimBoth do: [:c | c isSeparator ifFalse: [strm nextPut: c]]].
	selectorChooser := SelectorChooserMorph popUpPrefix: pref from: aTextMorph.
! !

!SmalltalkEditingState methodsFor: 'selector-chooser' stamp: 'AlainPlantec 11/14/2010 21:07'!
updateSelectorChooserFrom: aTextMorph
	selectorChooser ifNil: [^ self].
	self closeSelectorChooser.
	self querySymbolFrom: aTextMorph! !

!SmalltalkEditingState methodsFor: 'events' stamp: 'AlainPlantec 11/21/2010 22:16'!
mouseDown: anEvent from: aTextMorph
	super mouseDown: anEvent from: aTextMorph.
	self closeSelectorChooser! !

!SmalltalkEditingState methodsFor: 'selector-chooser' stamp: 'AlainPlantec 11/14/2010 15:49'!
selectorChooser
	^ selectorChooser! !

!SmalltalkEditingState methodsFor: 'events' stamp: 'AlainPlantec 11/19/2010 10:46'!
focused: aBoolean from: aTextMorph
	super focused: aBoolean from: aTextMorph.
	selectorChooser ifNotNil: [selectorChooser comeToFront]! !

!SmalltalkEditingState methodsFor: 'selector-chooser' stamp: 'SvenVanCaekenberghe 1/8/2012 14:47'!
chosenSelector: aSelector for: aTextMorph
	| newStart replacement  caret prevSelection |
	self closeSelectorChooser.
	aSelector ifNil: [^ self].
	aTextMorph editor selectPrecedingIdentifier.
	prevSelection := aTextMorph selection.
	newStart := aTextMorph editor startIndex.
	caret := aTextMorph editor stopIndex.
	replacement := String streamContents: [:strm | | kwds |
		1 to: (kwds := aSelector keywords) size 
		do: [:i | strm nextPutAll: (kwds at: i).
			i = 1 ifTrue: [caret := newStart + strm contents size + 1].
			strm nextPutAll: (i < kwds size ifTrue: ['  '] ifFalse: [' '])]].
	prevSelection asString = replacement trimBoth 
		ifTrue: [aTextMorph flash]
		ifFalse: [aTextMorph replaceSelectionWith: replacement]. 
	aTextMorph selectFrom: caret to: caret - 1.
	(aTextMorph respondsTo: #editView) ifTrue: [aTextMorph editView selectionInterval: aTextMorph editor selectionInterval].
! !

!SmalltalkEditor commentStamp: '<historical>'!
The editor built specifically for Smalltalk code!
!SmalltalkEditor methodsFor: 'editing keys' stamp: 'PavelKrivanek 7/13/2014 13:45'!
referencesToIt: aKeyboardEvent
	"Triggered by Cmd-N; browse references to the current selection"

	UserManager default canBrowse ifFalse: [ ^ false ].
	self referencesToIt.
	^ true! !

!SmalltalkEditor methodsFor: 'menu messages' stamp: 'VincentBlondeau 8/7/2014 15:15'!
fileItIn
	"Make a Stream on the text selection and fileIn it.
	 Moved here from FileController; this function can be useful from any text window that shows stuff in chunk format"

	| selection |
	selection := self selection.
	CodeImporter evaluateReadStream: (ReadWriteStream on: selection string from: 1 to: selection size).
	self inform: 'Code imported'.
! !

!SmalltalkEditor methodsFor: 'shortcuts' stamp: 'DamienPollet 8/1/2014 15:22'!
toggleCommentOnSelectionOrLine
	| originalHasSelection selection selectionInterval originalSelectionInterval quote    modifiedSelection newSelectionLastPosition numberOfDoubleQuoteBeforeCaret |
				
	selectionInterval := originalSelectionInterval := self selectionInterval.
	originalHasSelection := self hasSelection.
			
	originalHasSelection ifFalse: [
		selectionInterval := self string encompassLine: originalSelectionInterval.	
		self selectInvisiblyFrom: selectionInterval first to: selectionInterval last.
	].
					
	selection := self string copyFrom: selectionInterval first to: selectionInterval last.
		
	numberOfDoubleQuoteBeforeCaret := 0.
	selection withIndexDo: [ :char :i | 
		((i + selectionInterval first) < originalSelectionInterval first and: [ char = $" ]) ifTrue: [ 
		numberOfDoubleQuoteBeforeCaret := numberOfDoubleQuoteBeforeCaret  + 1
	]].
				
	quote := selection trimLeft first.
	quote = $" ifTrue: [ 
		modifiedSelection := selection asUncommentedCode.
		numberOfDoubleQuoteBeforeCaret := (((numberOfDoubleQuoteBeforeCaret - 1) // 2) + 1) negated.
		newSelectionLastPosition := (selection size - modifiedSelection size) negated.
	] ifFalse: [ 
		modifiedSelection := selection asComment.
		numberOfDoubleQuoteBeforeCaret := numberOfDoubleQuoteBeforeCaret + 1.
		newSelectionLastPosition := modifiedSelection size - selection size.
	].
			
	self replaceSelectionWith: modifiedSelection.
		
	originalHasSelection 
		ifFalse: [
			self selectAt: (originalSelectionInterval first + numberOfDoubleQuoteBeforeCaret).
		] ifTrue: [ 
			self selectInterval: ((originalSelectionInterval first) to: (originalSelectionInterval last + newSelectionLastPosition))
		]! !

!SmalltalkEditor methodsFor: 'do-its' stamp: 'nice 3/31/2011 22:38'!
evaluateSelection
	"Treat the current selection as an expression; evaluate it and return the result"
	
	^self evaluateSelectionAndDo: [:result | result]! !

!SmalltalkEditor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 11/14/2010 22:38'!
querySymbol: aKeyboardEvent
	"Invoked by Ctrl-q to query the Symbol table and display alternate symbols.
	 See comment in completeSymbol:lastOffering: for details."

	self closeTypeIn.
	self editingState closeSelectorChooser.
	self editingState querySymbolFrom: morph.
	^true! !

!SmalltalkEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 11/8/2010 22:09'!
selectedSymbol
	"Return the currently selected symbol, or nil if none.  Spaces, tabs and returns are ignored"

	| aString |
	self hasCaret ifTrue: [^ nil].
	aString := self selection string copyWithoutAll:
		{Character space.  Character cr.  Character tab}.
	aString size = 0 ifTrue: [^ nil].
	Symbol hasInterned: aString  ifTrue: [:sym | ^ sym].

	^ nil! !

!SmalltalkEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 11/8/2010 22:09'!
spawn
	"Create and schedule a message browser for the code of the model's 
	selected message. Retain any edits that have not yet been accepted."
	| code |
	code := self string.
	self cancel.
	model spawn: code.! !

!SmalltalkEditor methodsFor: 'do-its' stamp: 'AlainPlantec 11/8/2010 22:09'!
tallyIt

	^ self tallySelection! !

!SmalltalkEditor methodsFor: 'editing keys' stamp: 'PavelKrivanek 7/13/2014 13:44'!
debugIt: aKeyboardEvent
	"Evaluate the current selection in the Debugger."

	UserManager default canDebug ifFalse: [ ^ false ].
	self debugIt.
	^ true! !

!SmalltalkEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 11/8/2010 22:09'!
browseIt
	"Launch a browser for the current selection, if appropriate"
	^ self browseClassFromIt
! !

!SmalltalkEditor methodsFor: 'accessing' stamp: 'AlainPlantec 11/9/2010 15:05'!
editingStateClass
	^ SmalltalkEditingState! !

!SmalltalkEditor methodsFor: 'new selection' stamp: 'AlainPlantec 11/8/2010 22:09'!
nextTokenFrom: start direction: dir
	"simple token-finder for compiler automated corrections"
	| loc str |
	loc := start + dir.
	str := self string.
	[(loc between: 1 and: str size) and: [(str at: loc) isSeparator]]
		whileTrue: [loc := loc + dir].
	^ loc! !

!SmalltalkEditor methodsFor: 'menu messages' stamp: 'StephaneDucasse 1/14/2015 00:09'!
sendersOfIt
	"Open a senders browser on the selected selector"

	| selectedSelector mthds aGlobal syst |
	self lineSelectAndEmptyCheck: [^ self].
	selectedSelector  := self selectedSelector.
	selectedSelector isNil ifTrue: [^ morph flash].
	syst := self model systemNavigation.
	mthds := (syst allCallsOn: selectedSelector).
	aGlobal := syst environment at: selectedSelector ifAbsent: [nil].   
	aGlobal isNil or: [ aGlobal isBehavior not 
									ifFalse: [ mthds := mthds , (syst allReferencesTo: aGlobal binding) ]].
	syst browseMessageList: mthds name: 'Senders or Users of ', selectedSelector autoSelect: selectedSelector ! !

!SmalltalkEditor methodsFor: 'editing keys' stamp: 'PavelKrivanek 7/13/2014 13:46'!
spawnIt: aKeyboardEvent
	"Triggered by Cmd-o; spawn a new code window, if it makes sense."

	UserManager default canBrowse ifFalse: [ ^ false ].
	self spawn.
	^ true! !

!SmalltalkEditor methodsFor: 'do-its' stamp: 'MarcusDenker 10/21/2011 17:17'!
debug: aCompiledMethod receiver: anObject in: evalContext

 	 | guineaPig debugger context |

       guineaPig := [
              aCompiledMethod
                       valueWithReceiver: anObject
                       arguments: (evalContext ifNil: [ #() ] ifNotNil: [ { evalContext } ]) ] newProcess.
       context := guineaPig suspendedContext.
       debugger :=  Smalltalk tools debugger new
               process: guineaPig
               controller: nil
               context: context.
       debugger openFullNoSuspendLabel: 'Debug it'.
       [ debugger interruptedContext method == aCompiledMethod ]
               whileFalse: [ debugger send ]! !

!SmalltalkEditor methodsFor: 'menu messages' stamp: 'StephaneDucasse 5/13/2012 21:33'!
methodSourceContainingIt
	"Open a browser on methods which contain the current selection in their source (case-sensitive full-text search of source).   EXTREMELY slow!!"
	self lineSelectAndEmptyCheck: [^ self].
	model systemNavigation  browseMethodsWithSourceString: self selection string matchCase: false.! !

!SmalltalkEditor methodsFor: 'editing keys' stamp: 'PavelKrivanek 7/13/2014 13:45'!
inspectIt: aKeyboardEvent
	"Inspect the selection -- invoked via cmd-i.  If there is no current selection, use the current line.  1/17/96 sw
	 2/29/96 sw: don't call selectLine; it's done by inspectIt now"

	UserManager default canInspect ifFalse: [ ^ false ].
	self inspectIt.
	^ true! !

!SmalltalkEditor methodsFor: 'editing keys' stamp: 'PavelKrivanek 7/13/2014 13:44'!
doIt: aKeyboardEvent
	"Called when user hits cmd-d.  Select the current line, if relevant, then evaluate and execute.  2/1/96 sw.
	2/29/96 sw: don't call selectLine; it's done by doIt now"
	
	UserManager default canEvaluateCode ifFalse: [ ^ false ].
	self doIt.
	^ true! !

!SmalltalkEditor methodsFor: 'editing keys' stamp: 'PavelKrivanek 7/13/2014 13:45'!
sendersOfIt: aKeyboardEvent
	"Triggered by Cmd-n; browse implementors of the selector represented by the current selection, if plausible. 2/1/96 sw"

	UserManager default canBrowse ifFalse: [ ^ false ].
	self sendersOfIt.
	^ true! !

!SmalltalkEditor methodsFor: 'new selection' stamp: 'AlainPlantec 11/8/2010 22:09'!
notify: aString at: anInteger in: aStream 
	"The compilation of text failed. The syntax error is noted as the argument, 
	aString. Insert it in the text at starting character position anInteger."

	| pos |
	pos := self selectionInterval notEmpty
		ifTrue: [self startIndex + anInteger - 1 ]
		ifFalse: [anInteger].
	self insertAndSelect: aString at: (pos max: 1)! !

!SmalltalkEditor methodsFor: 'new selection' stamp: 'AlainPlantec 2/21/2011 20:02'!
selectLine
	"Make the receiver's selection, if it currently consists of an insertion point only, encompass the current line."
	| i left right s |
	self hasSelection ifTrue: [^self].
	s := self string.
	i := s encompassParagraph: self selectionInterval.
	left := i first.
	right := i last.
	[ left <= right and: [ (s at: left) = $" or: [(s at: left) isSeparator] ] ]
		whileTrue: [ left := left + 1 ].
	[ left <= right and: [ (s at: right) = $"  or: [(s at: right) isSeparator] ] ]
		whileTrue: [ right := right - 1 ].
	self selectInterval: (left to: right)! !

!SmalltalkEditor methodsFor: 'do-its' stamp: 'MarcusDenker 9/5/2013 13:20'!
evaluateSelectionAndDo: aBlock
	"Treat the current selection as an expression; evaluate it and invoke aBlock with the result."
	| result rcvr ctxt |

	self lineSelectAndEmptyCheck: [^ ''].
	(model respondsTo: #doItReceiver) 
		ifTrue: [ rcvr := model doItReceiver.
				ctxt := model doItContext]
		ifFalse: [ rcvr := ctxt := nil].
	result := rcvr class compiler
			source: self selectionForDoitAsStream;
			context: ctxt;
			receiver: rcvr;
			requestor: self morph  "don't set it to self.. The receiver can be destroyed as a result of evaluateSelection";
			failBlock:  [self morph flash. ^ nil];
			evaluate.		
			
	^ aBlock value: result! !

!SmalltalkEditor methodsFor: 'menu messages' stamp: 'MarcusDenker 7/30/2014 17:15'!
browseClassFrom: aClassString
	"Launch a hierarchy browser for the class indicated by the current selection.  If multiple classes matching the selection exist, let the user choose among them."
	
	| selectedClass |
	self lineSelectAndEmptyCheck: [^ self].
	selectedClass := model systemNavigation 
				classFromPattern: aClassString
				withCaption: 'choose a class to browse...'.
				
	selectedClass isNil ifTrue: [^ self internalCallToImplementorsOf: aClassString ].
	
	Smalltalk tools browser fullOnClass: selectedClass .! !

!SmalltalkEditor methodsFor: 'menu messages' stamp: 'MarcusDenker 7/30/2014 17:16'!
internalCallToBrowse: aSelector
	"Launch a browser for the class indicated by the given selector. 
	If multiple classes matching the selection exist, let the user choose among them."
	| aClass |
	aClass := model systemNavigation 
				classFromPattern: aSelector
				withCaption: 'choose a class to browse...'.
	aClass ifNil: [^ self].
	Smalltalk tools browser fullOnClass: aClass.! !

!SmalltalkEditor methodsFor: 'testing' stamp: 'AlainPlantec 11/8/2010 22:09'!
isSmalltalkEditor
	^ true ! !

!SmalltalkEditor methodsFor: 'menu messages' stamp: 'CamilloBruni 2/1/2012 19:37'!
implementorsOf: aSelector
	"Open an implementors browser on the given selector"

	(model systemNavigation allImplementorsOf: aSelector) isEmpty
			ifTrue: [self internalCallToBrowse: aSelector ]
			ifFalse: [ model systemNavigation browseAllImplementorsOf: aSelector]! !

!SmalltalkEditor methodsFor: 'do-its' stamp: 'EstebanLorenzano 3/20/2015 16:41'!
exploreIt
	self evaluateSelectionAndDo: [:result | result basicInspect]! !

!SmalltalkEditor methodsFor: 'menu messages' stamp: 'StephaneDucasse 5/13/2012 21:27'!
methodStringsContainingit
	"Open a browser on methods which contain the current selection as part of a string constant."

	self lineSelectAndEmptyCheck: [^ self].
	model systemNavigation  browseMethodsWithString: self selection string matchCase: false.
! !

!SmalltalkEditor methodsFor: 'do-its' stamp: 'nice 3/31/2011 22:45'!
inspectIt
	self evaluateSelectionAndDo: [:result | result inspect]! !

!SmalltalkEditor methodsFor: 'do-its' stamp: 'StephaneDucasse 3/1/2011 19:38'!
debugIt

	| method receiver context |
	(model respondsTo: #doItReceiver) 
		ifTrue: 
			[receiver := model doItReceiver.
			context := model doItContext]
		ifFalse:
			[receiver := context := nil].
	self lineSelectAndEmptyCheck: [^self].
	method := self compileSelectionFor: receiver in: context.
	method notNil ifTrue:
		[self debug: method receiver: receiver in: context].! !

!SmalltalkEditor methodsFor: 'do-its' stamp: 'MarcusDenker 9/5/2013 13:24'!
compileSelectionFor: anObject in: evalContext
	| methodNode  |

	methodNode :=  self class compiler
		source: self selectionAsStream;
		class: anObject class;
		context: evalContext;
		requestor: self morph;
		noPattern: true;
		failBlock:  [ ^nil ];
		translate.
			
	^methodNode generateWithSource.
	! !

!SmalltalkEditor methodsFor: 'editing keys' stamp: 'PavelKrivanek 7/13/2014 13:45'!
pasteInitials: aKeyboardEvent 
	"Replace the current text selection by an authorship name/date stamp; invoked by cmd-shift-v, easy way to put an authorship stamp in the comments of an editor."

	UserManager default canEditCode ifFalse: [ ^ false ].
	self closeTypeIn.
	self replace: self selectionInterval with: (Text fromString: Author changeStamp) and: [self selectAt: self stopIndex].
	^ true! !

!SmalltalkEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 11/8/2010 22:09'!
selectedSelector
	"Try to make a selector out of the current text selection"
	^self selection string findSelector! !

!SmalltalkEditor methodsFor: 'menu messages' stamp: 'CamilloBruni 2/1/2012 19:40'!
referencesToIt
	"Open a references browser on the selected symbol"

	| aSymbol env ref |
	self selectLine.
	((aSymbol := self selectedSymbol) == nil)
			ifTrue: [^ morph flash].

	self referencesTo: aSymbol! !

!SmalltalkEditor methodsFor: '*NodeNavigation' stamp: 'GiselaDecuzzi 5/13/2013 13:33'!
isWorkspace
	^ model isWorkspace! !

!SmalltalkEditor methodsFor: 'do-its' stamp: 'SvenVanCaekenberghe 12/12/2012 09:50'!
printIt
	"Treat the current text selection as an expression; evaluate it. Insert the 
	description of the result of evaluation after the selection and then make 
	this description the new text selection."

	| printString |
	self
		evaluateSelectionAndDo: [ :result | 
			printString := [ result printString ]
				on: Error
				do: [ '<error in printString: try ''Inspect it'' to debug>' ].
			self afterSelectionInsertAndSelect: printString ]! !

!SmalltalkEditor methodsFor: 'menu messages' stamp: 'CamilloBruni 2/1/2012 19:38'!
implementorsOfIt
	"Open an implementors browser on the selected selector"

	| aSelector |
	self lineSelectAndEmptyCheck: [^ self].
	(aSelector := self selectedSelector) == nil ifTrue: [^ morph flash].
	self implementorsOf: aSelector! !

!SmalltalkEditor methodsFor: 'shortcuts' stamp: 'ThierryGoubier 9/14/2012 14:41'!
on: target keyEvent: event do: shortcutActionBlock
	"Setup and break-up to be able to do a shortcut."

	target textMorph
		handleInteraction: [ target textMorph editor handleEditionAction: shortcutActionBlock fromKeyboardEvent: event ].
	target textChanged.
	target scrollSelectionIntoView! !

!SmalltalkEditor methodsFor: 'editing keys' stamp: 'PavelKrivanek 7/13/2014 13:45'!
exploreIt: aKeyboardEvent
	"Explore the selection -- invoked via cmd-shift-I.  If there is no current selection, use the current line."
	
	UserManager default canInspect ifFalse: [ ^ false ].
	self exploreIt.
	^ true! !

!SmalltalkEditor methodsFor: 'menu messages' stamp: 'CamilloBruni 2/1/2012 19:35'!
browseClassFromIt
	"Launch a hierarchy browser for the class indicated by the current selection.  If multiple classes matching the selection exist, let the user choose among them."
	
	self lineSelectAndEmptyCheck: [^ self].
	self browseClassFrom: (self selection string copyWithoutAll: CharacterSet crlf)! !

!SmalltalkEditor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 11/8/2010 22:09'!
displayIfFalse: aKeyboardEvent
	"Replace the current text selection with the text 'ifFalse:'--initiated by 
	ctrl-f."

	self addString: 'ifFalse:'.
	^false! !

!SmalltalkEditor methodsFor: 'menu messages' stamp: 'StephaneDucasse 7/22/2011 16:32'!
classNamesContainingIt
	"Open a browser on classes whose names contain the selected string"

	self lineSelectAndEmptyCheck: [^self].
	model systemNavigation 
		browseClassesWithNamesContaining: self selection string
		caseSensitive: Sensor shiftPressed! !

!SmalltalkEditor methodsFor: 'menu messages' stamp: 'CamilloBruni 2/1/2012 19:39'!
internalCallToBrowseIt
	"Launch a browser for the class indicated by the current selection. 
	If multiple classes matching the selection exist, let the user choose among them."
	| aClass |
	self lineSelectAndEmptyCheck: [^ self].
	self internalCallToBrowse: (self selection string copyWithoutAll: CharacterSet crlf)! !

!SmalltalkEditor methodsFor: 'private' stamp: 'BenjaminVanRyseghem 4/14/2011 14:07'!
modelCurrentSelectedClass
	" ugly dispatch, but current Browser protocol names aren't really cool "
	" for Nautilus ( and other tools), selectedClass sounds better, but I think it shouldn't be hardcoded "
	" IT'S A TEMP SOLUTION -- BenjaminVanRyseghem 14/04/11"

	" From now, all tools should use #selectedBehavior, waiting for a better solution - Thx Nice "
	(model respondsTo: #selectedBehavior)
		ifTrue: [^ model selectedBehavior ].
	
	" old selectors in order of uses "
	(model respondsTo: #selectedClass)
		ifTrue: [^ model selectedClass ].
	(model respondsTo: #selectedClassOrMetaClass)
		ifTrue: [ ^ model selectedClassOrMetaClass ].
	
		
	^ nil! !

!SmalltalkEditor methodsFor: 'editing keys' stamp: 'PavelKrivanek 7/13/2014 13:45'!
methodStringsContainingIt: aKeyboardEvent
	"Invoked from cmd-E -- open a browser on all methods holding string constants containing it."

	UserManager default canBrowse ifFalse: [ ^ false ].
	self methodStringsContainingit.
	^ true! !

!SmalltalkEditor methodsFor: 'editing keys' stamp: 'BenjaminVanRyseghem 10/25/2012 15:39'!
printIt: aKeyboardEvent
	"Print the results of evaluting the selection -- invoked via cmd-p.  If there is no current selection, use the current line.  1/17/96 sw
	 2/29/96 sw: don't call selectLine now, since it's called by doIt"
	self printIt.
	^ true! !

!SmalltalkEditor methodsFor: 'editing keys' stamp: 'PavelKrivanek 7/13/2014 13:45'!
methodNamesContainingIt: aKeyboardEvent
	"Browse methods whose selectors containing the selection in their names"

	UserManager default canBrowse ifFalse: [ ^ false ].
	self methodNamesContainingIt.
	^ true! !

!SmalltalkEditor methodsFor: 'private' stamp: 'AlainPlantec 10/20/2011 00:29'!
codeCompletionAround:  aBlock textMorph:  aTextMorph keyStroke: anEvent
	"I'm a editor for Smalltalk, so, ok do completion around"
	Smalltalk tools codeCompletionAround: aBlock textMorph: aTextMorph keyStroke: anEvent! !

!SmalltalkEditor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 11/8/2010 22:09'!
argAdvance: aKeyboardEvent
	"Invoked by Ctrl-a.  Useful after Ctrl-q.
	 Search forward from the end of the selection for a colon followed by
		a space.  Place the caret after the space.  If none are found, place the
		caret at the end of the text.  Does not affect the undoability of the 
	 	previous command."

	| start |
	self closeTypeIn.
	start := self text findString: ': ' startingAt: self stopIndex.
	start = 0 ifTrue: [ start := self text size + 1].
	self selectAt: start + 2.
	^true! !

!SmalltalkEditor methodsFor: 'menu messages' stamp: 'MarcusDenker 10/13/2013 08:02'!
referencesTo: aVariableOrClassName
	"Open a references browser on the given symbol"
	| env ref |

	" ugly dispatch, but current Browser protocol names aren't really cool "
	env := self modelCurrentSelectedClass ifNil: [ Smalltalk globals ].

	env isBehavior ifTrue: [
		(env instVarIndexFor: aVariableOrClassName) > 0 ifTrue: [
		 ^ self systemNavigation browseAllAccessesTo: aVariableOrClassName from: env]].

	ref:= (env bindingOf: aVariableOrClassName) ifNil: [ ^ self ].
	
	self systemNavigation browseAllReferencesTo: ref! !

!SmalltalkEditor methodsFor: 'new selection' stamp: 'AlainPlantec 11/8/2010 22:09'!
selectPrecedingIdentifier
	"Invisibly select the identifier that ends at the end of the selection, if any."

	| string sep stop tok |
	tok := false.
	string := self string.
	stop := self stopIndex - 1.
	[stop > 0 and: [(string at: stop) isSeparator]] whileTrue: [stop := stop - 1].
	sep := stop.
	[sep > 0 and: [(string at: sep) tokenish]] whileTrue: [tok := true. sep := sep - 1].
	tok ifTrue: [self selectInvisiblyFrom: sep + 1 to: stop]! !

!SmalltalkEditor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 11/8/2010 22:09'!
displayIfTrue: aKeyboardEvent
	"Replace the current text selection with the text 'ifTrue:'--initiated by 
	ctrl-t."

	self addString: 'ifTrue:'.
	^false! !

!SmalltalkEditor methodsFor: 'menu messages' stamp: 'MarcusDenker 8/28/2013 10:29'!
prettyPrint
	"Reformat the contents of the receiver's view (a Browser)."

	| selectedClass newText |
	model selectedMessageName ifNil: [^ morph flash].
	selectedClass := self modelCurrentSelectedClass.
	newText := selectedClass compiler
		source: self text;
		class: selectedClass;
		requestor: self;
		format.
	newText ifNotNil:
		[ self selectInvisiblyFrom: 1 to: self paragraph text size.
		self replaceSelectionWith: newText.
		self selectAt: 1]! !

!SmalltalkEditor methodsFor: 'menu messages' stamp: 'CamilloBruni 2/1/2012 19:36'!
internalCallToImplementorsOf: aSelector
	"Open an implementors browser on the given selector"
	
	 (model systemNavigation allImplementorsOf: aSelector) isEmpty
				ifFalse: [ model systemNavigation browseAllImplementorsOf: aSelector]
			
	! !

!SmalltalkEditor methodsFor: 'editing keys' stamp: 'PavelKrivanek 7/13/2014 13:45'!
implementorsOfIt: aKeyboardEvent
	"Triggered by Cmd-m; browse implementors of the selector represented by the current selection, if plausible. 2/1/96 sw"

	UserManager default canBrowse ifFalse: [ ^ false ].
	self implementorsOfIt.
	^ true! !

!SmalltalkEditor methodsFor: 'editing keys' stamp: 'PavelKrivanek 7/13/2014 13:45'!
save: aKeyboardEvent
	"Submit the current text.  Equivalent to 'accept' 1/18/96 sw"

	UserManager default canEvaluateCode ifFalse: [ ^ false ].
	self closeTypeIn.
	self accept.
	^ true! !

!SmalltalkEditor methodsFor: 'do-its' stamp: 'AlainPlantec 11/8/2010 22:09'!
selectionForDoitAsStream
	"Answer a ReadStream on the text in the paragraph that is currently
	selected. "
	^ ReadWriteStream
		on: self string
		from: self startIndex 
		to: self stopIndex - 1! !

!SmalltalkEditor methodsFor: 'menu messages' stamp: 'MarcusDenker 10/13/2013 07:58'!
sendersOf: selectedSelector
	" opens a Browser on the given selector"
	self model systemNavigation browseAllSendersOf: selectedSelector! !

!SmalltalkEditor methodsFor: 'editing keys' stamp: 'PavelKrivanek 7/13/2014 13:45'!
fileItIn: aKeyboardEvent
	"File in the selection; invoked via a keyboard shortcut, -- for now, cmd-shift-G."

	UserManager default canDropOSFile ifFalse: [ ^ false ].
	self fileItIn.
	^ true! !

!SmalltalkEditor methodsFor: 'do-its' stamp: 'MarcusDenker 5/16/2013 11:13'!
tallySelection
	"Treat the current selection as an expression; evaluate and tally it."
	| receiver context v  compiledMethod profiler |
	(model respondsTo: #doItReceiver) 
		ifTrue: 
			[receiver := model doItReceiver.
			context := model doItContext]
		ifFalse:
			[receiver := context := nil].
	self lineSelectAndEmptyCheck: [ ^ self ].
	compiledMethod := self compileSelectionFor: receiver in: context.
	compiledMethod ifNil: [^ self].
	profiler := TimeProfiler spyOn: [ v:= compiledMethod valueWithReceiver: receiver arguments: #()].
	profiler showResult: v.
	
! !

!SmalltalkEditor methodsFor: 'menu messages' stamp: 'CamilloBruni 2/1/2012 19:36'!
internalCallToImplementorsOfIt
	"Open an implementors browser on the selected selector"

	| aSelector |
	self lineSelectAndEmptyCheck: [^ self].
	(aSelector := self selectedSelector) == nil ifTrue: [^ morph flash].
	self internalCallToImplementorsOf: aSelector.
			
	! !

!SmalltalkEditor methodsFor: '*SmartSuggestions' stamp: 'GiselaDecuzzi 5/3/2013 14:42'!
smartSuggestions
	"Open suggested actions based on the selection"
	SugsMenuBuilder showMenuFor: self.

	

! !

!SmalltalkEditor methodsFor: '*NodeNavigation' stamp: 'GiselaDecuzzi 5/13/2013 11:04'!
sourceTextArea
	^morph! !

!SmalltalkEditor methodsFor: 'do-its' stamp: 'PavelKrivanek 7/13/2014 13:44'!
doIt
	"Set the context to include pool vars of the model.  Then evaluate."
	UserManager default canEvaluateCode ifFalse: [ ^ false ].
	^ self evaluateSelection! !

!SmalltalkEditor methodsFor: 'editing keys' stamp: 'PavelKrivanek 7/13/2014 13:44'!
browseIt: t1 

	UserManager default canBrowse
		ifFalse: [^ false].
	self browseIt.
	^ true! !

!SmalltalkEditor methodsFor: 'shortcuts' stamp: 'ThierryGoubier 9/14/2012 16:40'!
installKeymappingsOn: aMorph
	super installKeymappingsOn: aMorph.
	aMorph attachKeymapCategory: #SmalltalkEditor! !

!SmalltalkEditor methodsFor: 'menu messages' stamp: 'StephaneDucasse 5/13/2012 21:32'!
classCommentsContainingIt
	"Open a browser class comments which contain the current selection somewhere in them."

	self lineSelectAndEmptyCheck: [^ self].
	model systemNavigation  browseClassCommentsWithString: self selection string matchCase: false. ! !

!SmalltalkEditor methodsFor: 'menu messages' stamp: 'SvenVanCaekenberghe 1/8/2012 14:48'!
methodNamesContainingIt
	"Open a browser on methods names containing the selected string"

	self lineSelectAndEmptyCheck: [ ^ self ].
	Cursor wait showWhile: [ 
		model systemNavigation  browseMethodsWhoseNamesContain: self selection string trimBoth ]
	! !

!SmalltalkEditor methodsFor: 'do-its' stamp: 'SvenVanCaekenberghe 1/8/2012 14:48'!
selectionString
	"remove the initial and final quote marks, if present"
	"'''h''' withoutWrappingDoubleQuotes"
	| quote selection  |
	selection :=  self selection string trimBoth .
	selection size < 2 ifTrue: [ ^ selection ].
	quote := selection first.
	^ quote = $"
		ifTrue: [ selection copyFrom: 2 to: selection size - 1 ]
		ifFalse: [ selection ].! !

!SmalltalkEditor class methodsFor: 'shortcuts' stamp: 'GuillermoPolito 8/10/2014 14:02'!
buildSmalltalkEditorKeymappingsOn: aBuilder
	<keymap>
	(aBuilder shortcut: #browseIt)
		category: #SmalltalkEditor
		default: PharoShortcuts current browseShortcut
		do: [ :morph | morph browseIt ].
	(aBuilder shortcut: #doIt)
		category: #SmalltalkEditor
		default: PharoShortcuts current doItShortcut
		do: [ :morph | morph doIt ].
	(aBuilder shortcut: #inspectIt)
		category: #SmalltalkEditor
		default: PharoShortcuts current inspectItShortcut
		do: [ :morph | morph inspectIt ].
	(aBuilder shortcut: #implementorsOfIt)
		category: #SmalltalkEditor
		default: PharoShortcuts current browseImplementorsShortcut
		do: [ :morph | morph implementorsOfIt ].
	(aBuilder shortcut: #sendersOfIt)
		category: #SmalltalkEditor
		default: PharoShortcuts current browseSendersShortcut
		do: [ :morph | morph sendersOfIt ].
	(aBuilder shortcut: #formatCode)
		category: #SmalltalkEditor
		default: PharoShortcuts current formatCodeShortcut
		do: [ :morph | morph formatSourceCode ].
	(aBuilder shortcut: #printIt)
		category: #SmalltalkEditor
		default: PharoShortcuts current printItShortcut
		do: [ :morph | morph printIt ]! !

!SmalltalkEditor class methodsFor: 'menu declaration' stamp: 'EstebanLorenzano 1/30/2013 18:24'!
yellowButtonMenu
	^ (PragmaMenuBuilder 
			pragmaKeyword: self smalltalkEditorMenuKeyword
			model: nil) menu.
! !

!SmalltalkEditor class methodsFor: 'menu declaration' stamp: 'MarcusDenker 1/9/2015 10:09'!
smalltalkEditorShiftedMenuOn: aBuilder 
	"Specify the menu used when writing code. Try it with:
	(PragmaMenuBuilder 
		pragmaKeyword: 'smalltalkEditorShiftedMenu'
		model: nil) menu popUpInWorld"

	<contextMenu>
	<smalltalkEditorShiftedMenu>

	(aBuilder item: #'browse it' translated) 
		keyText: 'b';
		selector: #browseIt.
	(aBuilder item: #'senders of it' translated) 
		keyText: 'n';
		selector: #sendersOfIt.
	(aBuilder item: #'implementors of it' translated) 
		keyText: 'm';
		selector: #implementorsOfIt.
	(aBuilder item: #'references to it' translated) 
		keyText: 'N';
		selector: #referencesToIt; 
		withSeparatorAfter.
	(aBuilder item: #'selectors containing it' translated) 
		keyText: 'W';
		selector: #methodNamesContainingIt.
	(aBuilder item: #'method literal strings with it' translated) 
		keyText: 'E';
		selector: #methodStringsContainingit.
	(aBuilder item: #'method source with it' translated) 
		selector: #methodSourceContainingIt; 
		withSeparatorAfter.
	(aBuilder item: #'class names containing it' translated) 
		selector: #classNamesContainingIt.
	(aBuilder item: #'class comments with it' translated) 
		selector: #classCommentsContainingIt.
! !

!SmalltalkEditor class methodsFor: 'keyboard shortcut tables' stamp: 'MarcusDenker 5/8/2012 10:16'!
initializeShiftCmdKeyShortcuts 
	"Initialize the shift-command-key (or control-key) shortcut table."
	"NOTE: if you don't know what your keyboard generates, use Sensor kbdTest"
	"wod 11/3/1998: Fix setting of cmdMap for shifted keys to actually use the 
	capitalized versions of the letters.
	TPR 2/18/99: add the plain ascii values back in for those VMs that don't return the shifted values."

	"SmalltalkEditor initialize"

	| cmds |
 	self initializeBasicShiftCmdKeyShortcuts.
	
	cmds := #(
		$a	argAdvance:
		$d	debugIt:
		$e	methodStringsContainingIt:
		$f	displayIfFalse:
		$g	fileItIn:
		$i	exploreIt:
		$n	referencesToIt:
		$t	displayIfTrue:
		$v	pasteInitials:
		$w	methodNamesContainingIt:
	).
	1 to: cmds size by: 2 do: [ :i |
		shiftCmdActions at: ((cmds at: i) asciiValue + 1) put: (cmds at: i + 1).			"plain keys"
		shiftCmdActions at: ((cmds at: i) asciiValue - 32 + 1) put: (cmds at: i + 1).		"shifted keys"
		shiftCmdActions at: ((cmds at: i) asciiValue - 96 + 1) put: (cmds at: i + 1).		"ctrl keys"
	].! !

!SmalltalkEditor class methodsFor: 'keyboard shortcut tables' stamp: 'CamilloBruni 11/2/2012 15:44'!
initializeCmdKeyShortcuts
	"Initialize the (unshifted) command-key (or alt-key) shortcut table."

	"NOTE: if you don't know what your keyboard generates, use Sensor kbdTest"

	"SmalltalkEditor initialize"

	| cmds |
	self initializeBasicCmdKeyShortcuts.
	
	cmds := #(
		$b #browseIt: 
		$d #doIt: 
		$i #inspectIt: 
		$z #undo: 
		$j #redo: 
		$l #cancel: 
		$m #implementorsOfIt: 
		$n #sendersOfIt: 
		$p #printIt: 
		$q #querySymbol: 
		$s #save: ).
	1 to: cmds size
		by: 2
		do: [:i | cmdActions at: (cmds at: i) asciiValue + 1 put: (cmds at: i + 1)].
 ! !

!SmalltalkEditor class methodsFor: 'menu declaration' stamp: 'AlainPlantec 11/16/2010 22:19'!
shiftedYellowButtonMenu
	^ (PragmaMenuBuilder 
			pragmaKeyword: self smalltalkEditorShiftedMenuKeyword
			model: nil) menu.
! !

!SmalltalkEditor class methodsFor: 'menu declaration' stamp: 'AlainPlantec 11/16/2010 17:00'!
smalltalkEditorShiftedMenuKeyword
	^ 'smalltalkEditorShiftedMenu'
! !

!SmalltalkEditor class methodsFor: 'menu declaration' stamp: 'EstebanLorenzano 3/20/2015 16:40'!
smalltalkEditorMenuOn: aBuilder 
	"Specify the menu used when writing code. Try it with:
	(PragmaMenuBuilder 
		pragmaKeyword: 'smalltalkEditorMenu'
		model: nil) menu popUpInWorld
	"
	<contextMenu>
	<smalltalkEditorMenu>
	
	aBuilder
				item: 'Suggestions'; 
				selector: #smartSuggestions;
				target: self; 
				keyText: 't';
				order: 0.
	aBuilder items last withSeparatorAfter .
	
	UserManager default canEvaluateCode ifTrue: [
		(aBuilder item: #'Do it' translated) 
			keyText: 'd';
			selector: #doIt; 
			help: nil; 
			icon: Smalltalk ui icons smallDoItIcon.
		(aBuilder item: #'Print it' translated) 
			keyText: 'p';
			selector: #printIt; 
			help: nil; 
			icon: Smalltalk ui icons smallPrintItIcon. ].
	UserManager default canInspect ifTrue: [
		(aBuilder item: #'Inspect it' translated) 
			keyText: 'i';
			selector: #inspectIt; 
			help: nil; 
			icon: Smalltalk ui icons smallInspectItIcon.
		(aBuilder item: #'Basic Inspect it' translated) 
			keyText: 'I';
			selector: #basicInspectIt; 
			help: nil; 
			icon: Smalltalk ui icons smallInspectItIcon ].
	UserManager default canDebug ifTrue: [
		(aBuilder item: #'Debug it' translated) 
			keyText: 'D';
			selector: #debugIt; 
			help: nil; 
			icon: Smalltalk ui icons smallDebugIcon.
		(aBuilder item: #'Profile it' translated) 
			selector: #tallyIt; 
			icon: Smalltalk ui icons smallDebugIcon; 
			withSeparatorAfter. ].
	(aBuilder item: #'Find...' translated) 
		keyText: 'f';
		selector: #find; 
		help: nil; 
		icon: Smalltalk ui icons smallFindIcon.
	(aBuilder item: #'Find again' translated) 
		keyText: 'g';
		selector: #findAgain; 
		help: nil; 
		icon: Smalltalk ui icons smallFindIcon.
	UserManager default canBrowse ifTrue: [
		(aBuilder item: #'Code search...' translated) 
			selector: #shiftedTextPaneMenuRequest; 
			withSeparatorAfter ].
	(aBuilder item: #'Do again' translated) 
		keyText: 'j';
		selector: #again; 
		help: nil; 
		icon: Smalltalk ui icons smallRedoIcon.
	(aBuilder item: #'Undo' translated) 
		keyText: 'z';
		selector: #undo; 
		help: nil; 
		icon: Smalltalk ui icons smallUndoIcon; 
		withSeparatorAfter.
	(aBuilder item: #'Copy' translated) 
		keyText: 'c';
		selector: #copySelection; 
		help: nil; 
		icon: Smalltalk ui icons smallCopyIcon.
	(aBuilder item: #'Cut' translated) 
		keyText: 'x';
		selector: #cut; 
		help: nil; 
		icon: Smalltalk ui icons smallCutIcon.
	(aBuilder item: #'Paste' translated) 
		keyText: 'v';
		selector: #paste; 
		help: nil; 
		icon: Smalltalk ui icons smallPasteIcon.
	(aBuilder item: #'Paste...' translated) 
		selector: #pasteRecent; 
		help: nil; 
		icon: Smalltalk ui icons smallCopyIcon; 
		withSeparatorAfter.
	UserManager default canEvaluateCode ifTrue: [
		(aBuilder item: #'Accept' translated) 
			keyText: 's';
			selector: #accept; 
			help: nil; 
			icon: Smalltalk ui icons smallOkIcon.
		(aBuilder item: #'Cancel' translated) 
			keyText: 'l';
			selector: #cancel; 
			help: nil; 
			icon: Smalltalk ui icons smallCancelIcon ].! !

!SmalltalkEditor class methodsFor: 'menu declaration' stamp: 'AlainPlantec 11/16/2010 17:01'!
smalltalkEditorMenuKeyword
	^'smalltalkEditorMenu'
! !

!SmalltalkImage commentStamp: 'StephaneDucasse 6/7/2011 15:48'!
My singleton is a central entry point to the system.

It has many roles and responsibilities (to be documented)
	- startup/shutdown image
	- source management
	- namespace access
	- tool access
	- platform access
	- VM information and parameters	
	
Startup
-----------
At startup and shutdown the image execute the methods startUp: and shutdown: of registered classes (registered using addToStartUpList:, addToShutDownList:, ... methods and friends).
	
Startup phases
During the first stage of start up the UI manager, the default uimanager is switched to a specific non interactive ui manager (StartupUIManager). Note that this specific non interactive UIManager kills the system on any attempt to open windows and interaction. So be warned, don't use interaction in the first phase. 
Then all registered classes execute their start up procedures (which should not imply interactive behavior). 
After startup list is finished, any deferred startup actions are executed, which you can add using the method
addDeferredStartupAction: method.  





!
!SmalltalkImage methodsFor: '*Tool-Base' stamp: 'NicolaiHess 12/18/2014 10:21'!
tools

	^ Tools ifNil: [
		Tools := PharoCommonTools new ]! !

!SmalltalkImage methodsFor: 'housekeeping' stamp: 'EstebanLorenzano 5/28/2013 13:47'!
removeEmptyMessageCategories
	"Smalltalk removeEmptyMessageCategories"
	self garbageCollect.
	ClassOrganization allInstancesDo: [ :org | org removeEmptyCategories ].
	SystemOrganization removeEmptyCategories.! !

!SmalltalkImage methodsFor: 'saving' stamp: 'S 6/17/2013 13:26'!
saveChangesInFileNamed: aString
	| changesFile |
	changesFile := aString asFileReference.
	changesFile parent ensureCreateDirectory.
	"Ensure that the destination file is not the same as the original one"
	(Smalltalk changesFile absolutePath = changesFile absolutePath)
		ifFalse: [ 
			changesFile deleteIfAbsent: [  ].
			Smalltalk changesFile copyTo: changesFile ].
	self setMacFileInfoOn: changesFile fullName! !

!SmalltalkImage methodsFor: 'image, changes names' stamp: 'CamilloBruni 7/10/2012 21:51'!
vmDirectory
	^ self vm directory! !

!SmalltalkImage methodsFor: 'compiler' stamp: 'MarcusDenker 4/30/2013 11:19'!
evaluate: aString
	^self compiler evaluate: aString! !

!SmalltalkImage methodsFor: 'saving' stamp: 'SqR 11/7/2013 07:01'!
saveAsNewVersion
	"Save the image/changes using the next available version number."
	"SmalltalkImage current saveAsNewVersion"
	
	| newImageFile newChangesFile strippedName |
	newImageFile := self imageFile nextVersion.
	newChangesFile := newImageFile withExtension: self changesSuffix.

	newChangesFile exists ifTrue:
		[^self inform:
'There is already .changes file of the desired name,
', newChangesFile fullName, '
curiously already present, even though there is
no corresponding .', self imageSuffix,' file.   Please remedy
manually and then repeat your request.'].

	strippedName := self stripImageExtensionFrom: newImageFile fullName.
	^self saveAs: strippedName! !

!SmalltalkImage methodsFor: 'class and trait names' stamp: ''!
classNames
	^globals classNames! !

!SmalltalkImage methodsFor: 'image, changes names' stamp: 'CamilloBruni 5/7/2012 01:58'!
sourcesName
	"Answer the full path to the version-stable source code"
	^ self sourcesFile fullName! !

!SmalltalkImage methodsFor: 'special objects' stamp: ''!
specialSelectorAt: anInteger 
	"Answer the special message selector from the interleaved specialSelectors array."

	^ (self specialObjectsArray at: 24) at: anInteger * 2 - 1! !

!SmalltalkImage methodsFor: 'special objects' stamp: ''!
specialSelectorSize
	"Answer the number of special selectors in the system."

	^ (self specialObjectsArray at: 24) size // 2! !

!SmalltalkImage methodsFor: 'to clean later' stamp: ''!
includesKey: key
	"Answer whether the receiver has a key equal to the argument, key."

	^globals includesKey: key! !

!SmalltalkImage methodsFor: 'snapshot and quit' stamp: 'CamilloBruni 11/8/2012 22:52'!
logStartUpErrorDuring: aBlock into: aCollection tryDebugger: tryDebugger
	"handle errors thrown by the given block and log a freezed version of them in aCollection"
	aBlock on: Error, Halt do: [ :err|
		self logStartupError: err into: aCollection tryDebugger: tryDebugger]! !

!SmalltalkImage methodsFor: 'to clean later' stamp: ''!
at: aKey ifAbsentPut: aBlock 
	"Return the global at the given key. 
	If key is not included in the receiver store the result 
	of evaluating aBlock as new value."

	^globals at: aKey ifAbsentPut: aBlock! !

!SmalltalkImage methodsFor: 'special objects' stamp: ''!
registerExternalObject: anObject
	"Register the given object in the external objects array and return its index. If it is already there, just return its index."

	^ExternalSemaphoreTable registerExternalObject: anObject! !

!SmalltalkImage methodsFor: 'accessing' stamp: ''!
globals
	"Answer the global SystemDictionary"
	^globals! !

!SmalltalkImage methodsFor: 'to clean later' stamp: ''!
removeKey: key
	"Obsoleted."

	self flag: #tobeprecated.
	"self deprecated: 'Use Smalltalk globals'."
	^globals removeKey: key! !

!SmalltalkImage methodsFor: 'snapshot and quit' stamp: 'MartinDias 10/30/2013 13:49'!
snapshot: save andQuit: quit
	"Mark the changes file and close all files as part of #processShutdownList.
	If save is true, save the current state of this Smalltalk in the image file.
	If quit is true, then exit to the outer OS shell.
	The latter part of this method runs when resuming a previously saved image. This resume logic checks for a document file to process when starting up."

	| snapshotResult isNewImage |
	ChangesLog default logSnapshot: save andQuit: quit.
	
	self shutDownImage: quit.
									
	save
		ifTrue: [ 
			snapshotResult := self snapshotPrimitive.	"<-- PC frozen here on image file"
			isNewImage := snapshotResult == true.
			SystemAnnouncer uniqueInstance snapshotDone: isNewImage ]
		ifFalse: [ isNewImage := false ].
	(quit and: [ isNewImage not ])
		ifTrue: [ self quitPrimitive ].
	
	"create a new session object if we're booting"
	isNewImage ifTrue: [ Session reset ].
	
	self startupImage: isNewImage snapshotWorked: snapshotResult.
	
	"We return the resuming state, which may be useful for users to know the state of the image"
	^ isNewImage! !

!SmalltalkImage methodsFor: 'startup list' stamp: 'MarcusDenker 4/16/2011 23:07'!
addToShutDownList: aClass
	"This will add a ref to this class at the BEGINNING of the shutDown list."
	"No-op if already in the list."
	
	(ShutDownList includes: aClass name) ifFalse: [ShutDownList addFirst: aClass name]! !

!SmalltalkImage methodsFor: 'image, changes names' stamp: 'CamilloBruni 9/7/2013 11:28'!
imagePath: newPath
	"Set the the full path name for the current image.  All further snapshots will use this."

	self primImagePath: (FilePathEncoder encode: newPath)! !

!SmalltalkImage methodsFor: 'image, changes names' stamp: 'CamilloBruni 7/10/2012 21:50'!
imageDirectory
	"Answer the directory containing the current image."

	^ FileLocator imageDirectory
! !

!SmalltalkImage methodsFor: 'miscellaneous' stamp: 'DamienCassou 6/3/2014 17:58'!
metacelloPlatformAttributes
    "Returns the tags for the conditional platform loading in Metacello. Pay attention the order is important: from most  to least general." 
    "For release integrators, we should not have #'pharo1.3x' **and** #'pharo1.4.x'"
   ^ #(#squeakCommon #pharo #'pharo4.x' #'pharo4.0.x')! !

!SmalltalkImage methodsFor: 'special objects' stamp: 'GuillermoPolito 5/3/2012 11:13'!
specialObjectsArray: anArray
	specialObjectsArray := anArray! !

!SmalltalkImage methodsFor: 'startup list' stamp: ''!
addToShutDownList: aClass after: predecessor

	self add: aClass toList: ShutDownList after: predecessor! !

!SmalltalkImage methodsFor: 'snapshot and quit' stamp: 'PavelKrivanek 7/13/2014 13:46'!
handleStartupErrors: startupErrors
	"Handle the errors produced during startup.
	
	Resume to open a non-interactive debugger on the recorded errors"
	self logError: 'Got startup errors: ' inContext: nil.
	
	startupErrors do: [ :error|
		self logError: '    ', error description inContext: nil ].
	
	self isInteractive 
		ifFalse: [ self exitFailure ]
		ifTrue: [  |answer|
			UserManager default canRunStartupScript
				ifTrue: [ 
					answer := (UIManager default 
						confirm: 'Got startup errors, proceed to open debuggers'
						trueChoice: 'Debug'
						falseChoice: 'Cancel') ]
				ifFalse: [ answer := false ].
			answer == true
				ifTrue: [ startupErrors do: #debug ]]! !

!SmalltalkImage methodsFor: 'image, changes names' stamp: 'CamilloBruni 9/7/2013 10:21'!
changeImagePathTo: aString
	
	self imagePath: aString.
	LastImagePath := self imagePath! !

!SmalltalkImage methodsFor: 'private' stamp: ''!
globals: aSystemDictionary
	"Sets the system-wide globals"
	
	globals ifNotNil: [self error: 'Cannot overwrite existing globals'].
	globals := aSystemDictionary! !

!SmalltalkImage methodsFor: 'snapshot and quit' stamp: 'MartinDias 11/13/2013 15:42'!
shutDown
	^ self closeSourceFiles! !

!SmalltalkImage methodsFor: 'miscellaneous' stamp: 'PavelKrivanek 7/20/2014 09:33'!
openLog
	"This is a _private_ method,
	Because it really belongs to logging facility,
	we should delegate to it at some point "

	^ (FileStream fileNamed: Smalltalk logFileName)
		ifNil: [ NullStream new ]
		ifNotNil: [ :stream | 
			stream
				wantsLineEndConversion: true;
				setToEnd;
				yourself ]! !

!SmalltalkImage methodsFor: 'memory space' stamp: 'AlejandroInfante 11/11/2013 15:20'!
lowSpaceWatcher
	"Wait until the low space semaphore is signalled, then take appropriate
	actions. "
	| free preemptedProcess |
	self garbageCollectMost <= self lowSpaceThreshold
		ifTrue: [self garbageCollect <= self lowSpaceThreshold
				ifTrue: ["free space must be above threshold before
					starting low space watcher"
					^ self inform: 'Not enough memory to launch the lowSpaceWatcher.']].
	self specialObjectsArray at: 23 put: nil.
	"process causing low space will be saved here"
	LowSpaceSemaphore := Semaphore new.
	self primLowSpaceSemaphore: LowSpaceSemaphore.
	self primSignalAtBytesLeft: self lowSpaceThreshold.
	"enable low space interrupts"
	LowSpaceSemaphore wait.
	"wait for a low space condition..."
	self primSignalAtBytesLeft: 0.
	"disable low space interrupts"
	self primLowSpaceSemaphore: nil.
	LowSpaceProcess := nil.
	"The process that was active at the time of the low space interrupt."
	preemptedProcess := Smalltalk specialObjectsArray at: 23.
	Smalltalk specialObjectsArray at: 23 put: nil.
	"Note: user now unprotected until the low space watcher is re-installed"
	self memoryHogs isEmpty
		ifFalse: [free := self bytesLeft.
			self bytesLeft > free
				ifTrue: [^ self installLowSpaceWatcher]].
	UIManager default lowSpaceWatcherDefaultAction: preemptedProcess! !

!SmalltalkImage methodsFor: 'system attribute' stamp: 'ClementBera 4/11/2013 14:06'!
options
	"Answer an array with all the command line options."

	"Smalltalk commandLine options"

	^ Array
		streamContents: [ :str | 
			| arg i |
			i := 1.
			[ i > 1000 or: [ (arg := self optionAt: i) isNil ] ]
				whileFalse: [ 
					str nextPut: arg.
					i := i + 1 ] ]! !

!SmalltalkImage methodsFor: 'snapshot and quit' stamp: 'GuillermoPolito 7/2/2012 12:29'!
recordStartupStamp
	
	ChangesLog default recordStartupStamp! !

!SmalltalkImage methodsFor: '*Slot' stamp: 'MartinDias 7/1/2013 19:12'!
classBuilder
	"Answer the object responsible of creating classes in the system."
	
	^ OldClassBuilderAdapter new! !

!SmalltalkImage methodsFor: 'image, changes names' stamp: 'SqR 11/7/2013 07:07'!
fullNameForChangesNamed: aString

	^(self fileForChangesNamed: aString) fullName! !

!SmalltalkImage methodsFor: 'accessing' stamp: 'MarcusDenker 5/9/2013 08:23'!
vm
	"Answer the object to query about virtual machine."
	
	^ vm ifNil: [vm := VirtualMachine new]! !

!SmalltalkImage methodsFor: 'image, changes name' stamp: ''!
primImageName: newName
	"Set the the full path name for the current image.  All further snapshots will use this."

	<primitive: 121>
	^ self primitiveFailed! !

!SmalltalkImage methodsFor: 'endian' stamp: ''!
calcEndianness
	| bytes word blt |
	"What endian-ness is the current hardware?  The String '1234' will be stored into a machine word.  On BigEndian machines (the Mac), $1 will be the high byte if the word.  On LittleEndian machines (the PC), $4 will be the high byte."
	"SmalltalkImage current endianness"

	bytes := #[0 0 0 0].  "(1 2 3 4) or (4 3 2 1)"
	word := WordArray with: 16r01020304.
	blt := (BitBlt toForm: (Form new hackBits: bytes)) 
				sourceForm: (Form new hackBits: word).
	blt combinationRule: Form over.  "store"
	blt sourceY: 0; destY: 0; height: 1; width: 4.
	blt sourceX: 0; destX: 0.
	blt copyBits.  "paste the word into the bytes"
	bytes first = 1 ifTrue: [^ #big].
	bytes first = 4 ifTrue: [^ #little].
	self error: 'Ted is confused'.! !

!SmalltalkImage methodsFor: 'startup list' stamp: ''!
removeFromShutDownList: aClass

	ShutDownList remove: aClass name ifAbsent: []! !

!SmalltalkImage methodsFor: 'saving' stamp: 'S 6/17/2013 13:26'!
backupImageInFileNamed: aFileReference
	"Save the  the image under the given file. 
	Unlike #saveImageInFileNamed: this method continues evaluation in the original image after saving a backup copy.
	Note: This method does not save the .changes file, use #saveAs:"
	
	| imageFile previousFullImageName isNewSession |
	
	imageFile := aFileReference asFileReference.
	imageFile parent ensureCreateDirectory.
	previousFullImageName := self imagePath.
	isNewSession := false.
	
	[
		"change to the new image name "
		self
			changeImagePathTo: imageFile fullName;
			closeSourceFiles;
			openSourceFiles.  "so SNAPSHOT appears in new changes file"
		
		isNewSession := self snapshot: true andQuit: false.
	] ensure: [
		isNewSession ifFalse: [
			"unlike #saveImageInFileNamed: we do NOT continue in the new image"
			"switch back to the old image"
			self 
				changeImagePathTo: previousFullImageName;
				closeSourceFiles;
				openSourceFiles ]].
		
	^ isNewSession.! !

!SmalltalkImage methodsFor: 'image' stamp: ''!
imageFormatVersion
	"Answer an integer identifying the type of image. The image version number may
	identify the format of the image (e.g. 32 or 64-bit word size) or specific requirements
	of the image (e.g. block closure support required). This invokes an optional primitive
	that may not be available on all virtual machines."

	"Smalltalk image imageFormatVersion"

	<primitive: 'primitiveImageFormatVersion'>
	self notify: 'This virtual machine does not support the optional primitive #primitiveImageFormatVersion' translated.
	^''! !

!SmalltalkImage methodsFor: 'to clean later' stamp: ''!
size
	"Obsoleted."

	self flag: #tobeprecated.
	"self deprecated: 'Use Smalltalk globals'."
	^globals size! !

!SmalltalkImage methodsFor: 'memory space' stamp: ''!
signalLowSpace
	"Signal the low-space semaphore to alert the user that space is running low."

	LowSpaceSemaphore signal.! !

!SmalltalkImage methodsFor: 'cleanup' stamp: ''!
cleanUp: aggressive except: exclusions
	"Clean up. When aggressive is true, this will destroy resources, change sets, etc.
	Leave out any classes specifically listed in exclusions."

	"Smalltalk cleanUp: true except: {Point . ChangeSet}"

	^self cleanUp: aggressive except: exclusions confirming: aggressive! !

!SmalltalkImage methodsFor: 'to clean later' stamp: ''!
includes: element
	"Obsoleted."

	self flag: #tobeprecated.
	"self deprecated: 'Use Smalltalk globals'."
	^globals includes: element! !

!SmalltalkImage methodsFor: 'memory space' stamp: ''!
garbageCollect
	"Primitive. Reclaims all garbage and answers the number of bytes of available space."
	Object flushDependents.
	Object flushEvents.
	^self primitiveGarbageCollect! !

!SmalltalkImage methodsFor: 'private' stamp: 'PavelKrivanek 5/21/2013 17:31'!
privSaveImageWithCleanup

	" Do not use this method for common image saving. This method is designated for saving the image during the shrinking process in headless images."

	(Delay forMilliseconds: 1000) wait.

	Processor yield.

	13 "a magic number (Camillo) "timesRepeat: [ Smalltalk garbageCollect ].
 
	[
		self snapshot: true andQuit: true.
	] ifError: [:e |
		| rep |
		rep := FileStream forceNewFileNamed: 'PharoDebug.log'.
		rep nextPutAll: 'PharoKernel shrinking report'; cr.
		rep nextPutAll: 'Error:'; cr.
		rep nextPutAll: e asString; cr.
  		rep nextPutAll: thisContext stack size asString.
 	  	thisContext stack copy withIndexDo: [:stck :i |
			[ rep nextPutAll: i asString; space; nextPutAll: stck asString; cr] ifError: []].
		rep close. 
		Smalltalk exitFailure ]! !

!SmalltalkImage methodsFor: 'log' stamp: 'PavelKrivanek 7/20/2014 09:30'!
logFileName: newName

	LogFileName := newName! !

!SmalltalkImage methodsFor: '*Morphic-Base' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
aboutThisSystem
	"Identify software version"
	| text dialog width |
	text := Smalltalk systemInformationString withCRs.
	width := 0.
	text
		linesDo: [:l | width := width 
						max: (Smalltalk ui theme textFont widthOfStringOrText: l)].
	dialog := LongMessageDialogWindow new entryText: text.
	dialog iconMorph image: Smalltalk ui icons pharoIcon.
	dialog title: 'About Pharo'.
	dialog open.
	dialog textMorph minWidth: 20;
		 minHeight: 20.
	dialog
		width: (width + 120 min: Display width - 50).
	dialog position: 25 @ 25! !

!SmalltalkImage methodsFor: 'special objects' stamp: ''!
specialNargsAt: anInteger 
	"Answer the number of arguments for the special selector at: anInteger."

	^ (self specialObjectsArray at: 24) at: anInteger * 2! !

!SmalltalkImage methodsFor: 'system attribute' stamp: 'DamienCassou 2/13/2015 18:06'!
extractMinusParametersFrom: arguments
	| dict previous previousWithMinus args |
	dict := Dictionary new.
	arguments isEmptyOrNil
		ifTrue: [ ^ dict ].
	args := OrderedCollection withAll: arguments.
	previous := previousWithMinus := args detect: [ :each | each first = $- ] ifNone: [ String space ].
	[ args isEmpty or: [ args first = previous ] ]
		whileFalse: [ 
			dict at: #* put: (dict at: #* ifAbsent: [ #() ]) , (Array with: args first).
			args removeFirst ].
	args
		do: [ :each | 
			each first = $-
				ifTrue: [ 
					previous first = $-
						ifTrue: [ dict at: previous allButFirst put: #() ].
					previousWithMinus := each ]
				ifFalse: [ 
					dict
						at: previousWithMinus allButFirst
						put: (dict at: previousWithMinus allButFirst ifAbsent: [ #() ]) , (Array with: each) ].
			previous := each ].
	previous first = $-
		ifTrue: [ dict at: previous allButFirst put: #() ].
	^ dict! !

!SmalltalkImage methodsFor: 'sources, change log' stamp: 'GuillermoPolito 7/2/2012 12:29'!
logChange: aStringOrText 
	"Write the argument, aString, onto the changes file."
	ChangesLog default logChange: aStringOrText! !

!SmalltalkImage methodsFor: 'special objects' stamp: ''!
hasSpecialSelector: aLiteral ifTrueSetByte: aBlock
	"Some basic messages such as #+ have their own bytecode for speed.
	To gain some space, the literal array of compiled methods does not contain such message selectors.
	This implies that the cross referencer and other tools have to check if a selector is of the optimized one 
	or not by calling this method. This is an optimization when machines were slow and small and it 
	may be removed in the future to gain simplicity."
	
	1 to: self specialSelectorSize do:
		[:index | 
		(self specialSelectorAt: index) == aLiteral
			ifTrue: [aBlock value: index + 16rAF. ^true]].
	^false! !

!SmalltalkImage methodsFor: 'memory space' stamp: ''!
bytesLeft
	"Answer the number of bytes of space available. Does a full garbage collection."

	^ self garbageCollect
! !

!SmalltalkImage methodsFor: 'memory space' stamp: ''!
primBytesLeft
	"Primitive. Answer the number of bytes available for new object data.
	Not accurate unless preceded by
		Smalltalk garbageCollectMost (for reasonable accuracy), or
		Smalltalk garbageCollect (for real accuracy).
	See Object documentation whatIsAPrimitive."

	<primitive: 112>
	^ 0! !

!SmalltalkImage methodsFor: 'memory space' stamp: ''!
forceTenure
	"Primitive. Tell the GC logic to force a tenure on the next increment GC."
	<primitive: 'primitiveForceTenure'>
	^self primitiveFailed! !

!SmalltalkImage methodsFor: '*System-Platforms' stamp: 'cami 7/22/2013 18:30'!
platform
	"Answer the object to query about os."
	
	^ self os! !

!SmalltalkImage methodsFor: 'private' stamp: ''!
sourceFileVersionString: aString

	SourceFileVersionString := aString! !

!SmalltalkImage methodsFor: 'housekeeping' stamp: 'SeanDeNigris 6/21/2012 08:40'!
removeAllLineFeeds
	"Smalltalk removeAllLineFeeds"
	"Scan all methods for source code with lineFeeds.
	Replaces all occurrences of <CR><LF> or <LF> by <CR>.
	When done, offers to display an Inspector containing the message
	names grouped by author initials.
	In this dictionary, the key 'OK' contains the methods that had literals that contained <LF> characters."
	| totalStripped totalOK authors |
	'Scanning sources for LineFeeds.
This will take a few minutes...'
		displayProgressFrom: 0
		to: CompiledMethod instanceCount
		during: [:bar | | n | 
			n := 0.
			authors := self
						removeAllLineFeedsQuietlyCalling: [(n := n + 1) \\ 100 = 0
								ifTrue: [bar current: n]]].
	totalStripped := authors
				inject: 1
				into: [:sum :set | sum + set size].
	totalOK := (authors at: 'OK') size.
	totalStripped := totalStripped - totalOK.
	self crTrace: totalStripped printString , ' methods stripped of LFs.'.
	self crTrace: totalOK printString , ' methods still correctly contain LFs.'.
	(self confirm: 'Do you want to see the affected methods?')
		ifTrue: [ authors inspect ]! !

!SmalltalkImage methodsFor: 'to clean later' stamp: ''!
removeKey: key ifAbsent: aBlock
	"Obsoleted."

	self flag: #tobeprecated.
	"self deprecated: 'Use Smalltalk globals'."
	^globals removeKey: key ifAbsent: aBlock! !

!SmalltalkImage methodsFor: 'to clean later' stamp: ''!
at: key ifPresent: aBlock
	"Lookup the given key in the globals. If it is present, answer the value of evaluating the given block with the value associated with the key. Otherwise, answer nil."

	^globals at: key ifPresent: aBlock! !

!SmalltalkImage methodsFor: 'miscellaneous' stamp: 'SeanDeNigris 7/12/2012 08:44'!
setMacFileInfoOn: aString
	"On Mac, set the file type and creator (noop on other platforms)"
	aString asFileReference setMacType: 'STch' creator: 'FAST'.! !

!SmalltalkImage methodsFor: 'saving' stamp: 'StephaneDucasse 11/9/2010 18:55'!
saveSession
	"Save the current image without quitting and return it resuming status (whether it was restarted or in the same flow)."
	
	^ self snapshot: true andQuit: false! !

!SmalltalkImage methodsFor: 'class and trait names' stamp: ''!
renamedClass: aClass from: oldName to: newName
	"Inform Smalltalk that aClass has been renamed"
	
	(Array with: StartUpList with: ShutDownList) 
		do: [ :list | | index |  
			index := list indexOf: oldName ifAbsent: [0].
			index > 0 ifTrue: [list at: index put: newName]].
! !

!SmalltalkImage methodsFor: '*Polymorph-Widgets' stamp: 'EstebanLorenzano 5/14/2013 09:42'!
ui 
	^ UIThemeRegistry ! !

!SmalltalkImage methodsFor: '*Tool-Profilers' stamp: 'ar 6/22/2007 15:24'!
profileSample
	"Primitive. Answer the last sample taken by the profiler, or nil if the profiler isn't active.
	See also primitiveProfileStart."
	<primitive: 'primitiveProfileSample'>
	^self primitiveFailed! !

!SmalltalkImage methodsFor: 'shrinking' stamp: 'MarcusDenker 4/27/2011 21:08'!
removeSelector: descriptor 
	"Safely remove a selector from a class (or metaclass). If the
	class or the method doesn't exist anymore, never mind and
	answer nil.
	This method should be used instead of 'Class removeSelector:
	#method' to omit global class references."
	| class sel |
	class := self
				at: descriptor first
				ifAbsent: [^ nil].
	(descriptor size > 2 and: [descriptor second == #class])
		ifTrue: 
			[class := class class.
			sel := descriptor third]
		ifFalse: 
			[sel := descriptor second].
	^ class removeSelector: sel! !

!SmalltalkImage methodsFor: 'sources, change log' stamp: 'MartinDias 10/29/2013 13:25'!
openSourceFiles

	self imagePath = LastImagePath 
		ifFalse: ["Reset the author full name to blank when the image gets moved"
			LastImagePath := self imagePath.
			Author reset].

	SourceFiles ensureOpen.! !

!SmalltalkImage methodsFor: 'compiler' stamp: 'MarcusDenker 10/1/2013 14:17'!
recompile
	Smalltalk globals allClassesAndTraits 
		do: [:classOrTrait | classOrTrait recompile] 
		displayingProgress: 'Recompiling all classes and traits'. ! !

!SmalltalkImage methodsFor: '*Tool-Profilers' stamp: 'IgorStasenko 8/17/2011 16:27'!
reportCPUandRAM
	"Write several text files with useful analysis for profiling purposes.
	Overwrites any existing report.
	SmalltalkImage current reportCPUandRAM
	"	

	| stream |
	"VM statistics (Memory use and GC, mainly)"
	FileStream 
		forceNewFileNamed: 'Log-MemoryStats.txt'
		do: [:aStream | aStream nextPutAll: self vm statisticsReport ].
	
	"Process list"
	stream := FileStream 
				forceNewFileNamed: 'Log-ProcessList.txt' 
				do: [ :aStream |  self tools processBrowser new processNameList 
								do: [ :each | aStream nextPutAll: each; cr ]].

"Fork all these, so they run in sequence, as the system is back running"
[
	"Process taking most CPU"
	stream := FileStream forceNewFileNamed: 'Log-ThePig.txt'.
	self tools processBrowser dumpPigStackOn: stream andClose: true.
	
	"Tally of all processes"
	stream := FileStream forceNewFileNamed: 'Log-FullTally.txt'.
	[ | tally |
		tally := MessageTally new.
		tally reportOtherProcesses: true.
		tally spyAllEvery: 1 on: [ (Delay forMilliseconds: 1000) wait ].
		tally report: stream ] ensure: [ stream close ].

	"Memory Analysis"
	stream := FileStream forceNewFileNamed: 'Log-MemoryAnalysis.txt'.
	[ SpaceTally new printSpaceAnalysis: 1 on: stream ]
		ensure: [ stream close ]

] forkNamed: 'CPU usage analysis'! !

!SmalltalkImage methodsFor: 'miscellaneous' stamp: 'IgorStasenko 1/21/2011 19:12'!
logDuring: aMonadicBlock
	" for safe use, if stream is a file, it needs to be closed after use " 
	| logStream |	

	[
		logStream := self openLog.
		aMonadicBlock value: logStream.
	] ensure: [ self closeLog: logStream ].

! !

!SmalltalkImage methodsFor: 'accessing' stamp: 'CamilloBruni 5/9/2013 19:47'!
session
	"Answer the current session object."
	^ Session current.! !

!SmalltalkImage methodsFor: 'image, changes names' stamp: 'CamilloBruni 5/7/2012 01:47'!
changesSuffix
	^ 'changes'! !

!SmalltalkImage methodsFor: 'class and trait names' stamp: 'ClementBera 7/26/2013 17:04'!
renameClassNamed: oldName as: newName
	"Invoked from fileouts:  if there is currently a class in the system named oldName, then rename it to newName.  If anything untoward happens, report it in the Transcript.  "

	| oldClass |
	(oldClass := self at: oldName asSymbol ifAbsent: [ nil ]) 
		ifNil: [ 
			self crTrace: 'Class-rename for ' , oldName , ' ignored because ' , oldName , ' does not exist.'.
			^ self ].
	oldClass rename: newName! !

!SmalltalkImage methodsFor: 'special objects' stamp: 'GuillermoPolito 5/3/2012 11:13'!
specialObjectsArray
	^specialObjectsArray ifNil: [ specialObjectsArray := self primitiveGetSpecialObjectsArray ].! !

!SmalltalkImage methodsFor: 'memory space' stamp: ''!
memoryHogs
	"Answer the list of objects to notify with #freeSomeSpace if memory gets full."

	^ MemoryHogs ifNil: [MemoryHogs := OrderedCollection new]! !

!SmalltalkImage methodsFor: 'to clean later' stamp: ''!
at: aKey put: anObject 
	"Set the global at key to be anObject.  If key is not found, create a
	new entry for key and set is value to anObject. Answer anObject."

	^globals at: aKey put: anObject! !

!SmalltalkImage methodsFor: 'memory space' stamp: ''!
lowSpaceWatcherProcess
	^LowSpaceProcess! !

!SmalltalkImage methodsFor: 'class and trait names' stamp: ''!
traitNames
	"Answer a SortedCollection of all traits (not including class-traits) names."
	
	^ globals traitNames! !

!SmalltalkImage methodsFor: '*System-Platforms' stamp: 'cami 7/22/2013 18:17'!
os
	"Answer the object to query about os."
	
	^ OSPlatform current! !

!SmalltalkImage methodsFor: 'housekeeping' stamp: ''!
verifyChanges		
	"Smalltalk verifyChanges"
	"Recompile all methods in the changes file."
	self systemNavigation allBehaviorsDo: [:class | class recompileChanges].
! !

!SmalltalkImage methodsFor: 'image, changes name' stamp: 'CamilloBruni 5/13/2012 19:22'!
primImagePath: newName
	"Set the the full path name for the current image.  All further snapshots will use this."

	<primitive: 121>
	^ self primitiveFailed! !

!SmalltalkImage methodsFor: 'miscellaneous' stamp: 'CamilloBruni 2/13/2012 19:21'!
logStdErrorDuring: aBlock
	| stderr |
	[
		"install the line end conversion and force initialize the converter"
		stderr := FileStream  stderr
					wantsLineEndConversion: true;
					converter;
					yourself.
		
		"log in red"
		stderr nextPut: Character escape; nextPutAll: '[31m'.
		"rund the loggin block"
		aBlock value: stderr.
		"reset the coloring"
		stderr nextPut: Character escape; nextPutAll: '[0m'.
	] on: Error do: [ :e| "we don't care if the logging to stdout fails..." ].! !

!SmalltalkImage methodsFor: 'housekeeping' stamp: 'MaxLeske 9/28/2014 21:18'!
fixObsoleteBindings
	CompiledMethod allInstances do: [ :method |
		| obsoleteBindings |
		obsoleteBindings := method literals select: [ :literal |
				literal isVariableBinding and: [
					literal value isBehavior and: [ 
						literal value isObsolete ] ] ].
		obsoleteBindings do: [ :binding |
			| obsName realName realClass |
			obsName := binding value name.
			self 
				trace: 'Binding: ';
				traceCr: obsName.
			realName := obsName copyReplaceAll: 'AnObsolete' with: ''.
			realClass := Smalltalk globals at: realName asSymbol ifAbsent: [ UndefinedObject ].
			binding key: binding key value: realClass ].
		"do not forget to flush the JIT cache"
		obsoleteBindings ifNotEmpty: [ method flushCache ] ]! !

!SmalltalkImage methodsFor: 'accessing' stamp: 'DamienCassou 8/15/2013 10:06'!
lastImagePath
	^ LastImagePath! !

!SmalltalkImage methodsFor: 'housekeeping' stamp: ''!
removeAllLineFeedsQuietlyCalling: aBlock
	"Smalltalk removeAllLineFeedsQuietly"
	"Scan all methods for source code with lineFeeds.
	Replaces all occurrences of <CR><LF> or <LF> by <CR>.
	Answer a Dictionary keyed by author name containing sets of affected method names,
	as well as (at the key 'OK') a list of methods that still contain LF characters inside literal strings or characters.
	Evaluate aBlock for each method so that status can be updated."
	| authors |
	authors := Dictionary new.
	authors at: 'OK' put: Set new.
	self systemNavigation
		allBehaviorsDo: [:cls | cls selectorsAndMethodsDo: [:selector :method |
					| oldStamp newCodeString oldCodeString oldCategory nameString | 
					aBlock cull: cls cull: selector.
					oldCodeString := cls sourceCodeAt: selector.
					(oldCodeString includes: Character lf)
						ifTrue: [
							newCodeString := oldCodeString withSqueakLineEndings.
							nameString := cls name , '>>' , selector.
							((cls compiledMethodAt: selector) hasLiteralSuchThat: [ :lit | lit asString includes: Character lf ])
								ifTrue: [(authors at: 'OK')
										add: nameString]
								ifFalse: [oldStamp := (method timeStamp)
												copy replaceAll: Character cr
												with: Character space.
									(authors
										at: (oldStamp copyFrom: 1 to: (oldStamp findFirst: [ :c | c isAlphaNumeric not ]))
										ifAbsentPut: [Set new])
										add: nameString.
									oldCategory := cls whichCategoryIncludesSelector: selector.
									cls
										compile: newCodeString
										classified: oldCategory
										withStamp: oldStamp
										notifying: nil ]]]].
	^ authors! !

!SmalltalkImage methodsFor: 'to clean later' stamp: 'IgorStasenko 8/17/2011 16:59'!
argumentAt: i
	"Answer the i-th argument of the command line, or nil if not so many argument."
	
	^self vm getSystemAttribute: 2 + i! !

!SmalltalkImage methodsFor: 'snapshot and quit' stamp: 'CamilloBruni 2/21/2012 01:12'!
exitFailure
	"Quit the VM with a failing signal.
	Will lose all current changes."
	self exit: 1! !

!SmalltalkImage methodsFor: 'to clean later' stamp: ''!
associationAt: key ifAbsent: aBlock
	"Obsoleted."

	self flag: #tobeprecated.
	"self deprecated: 'Use Smalltalk globals'."
	^globals associationAt: key ifAbsent: aBlock! !

!SmalltalkImage methodsFor: 'sources, change log' stamp: 'GuillermoPolito 7/2/2012 12:30'!
assureStartupStampLogged
	"If there is a startup stamp not yet actually logged to disk, do it now."
	ChangesLog default assureStartupStampLogged! !

!SmalltalkImage methodsFor: 'image, changes name' stamp: 'CamilloBruni 5/13/2012 19:21'!
primImagePath
	"Answer the full path name for the current image."
	"Smalltalk imageName"

	<primitive: 121>
	self primitiveFailed! !

!SmalltalkImage methodsFor: 'memory space' stamp: ''!
primLowSpaceSemaphore: aSemaphore
	"Primitive. Register the given Semaphore to be signalled when the
	number of free bytes drops below some threshold. Disable low-space
	interrupts if the argument is nil."

	<primitive: 124>
	self primitiveFailed! !

!SmalltalkImage methodsFor: 'startup list' stamp: ''!
removeFromStartUpList: aClass

	StartUpList remove: aClass name ifAbsent: []! !

!SmalltalkImage methodsFor: 'snapshot and quit' stamp: 'Camillobruni 8/11/2011 22:54'!
processStartUpList: resuming
	"Send #startUp to each class that needs to run initialization after a snapshot."

	^ self send: #startUp: toClassesNamedIn: StartUpList with: resuming.
! !

!SmalltalkImage methodsFor: 'copying' stamp: ''!
veryDeepCopyWith: deepCopier
	"Return self.  I can't be copied.  Do not record me."! !

!SmalltalkImage methodsFor: 'saving' stamp: 'CamilloBruni 1/24/2013 21:26'!
saveAs: newNameWithoutSuffix
	"Results:
		true  when continuing in the new session
		false for the current session "
		
	newNameWithoutSuffix ifNil: [ ^ self ].
	(SourceFiles at: 2) ifNotNil:
		[self closeSourceFiles; "so copying the changes file will always work"
			 saveChangesInFileNamed: (self fullNameForChangesNamed: newNameWithoutSuffix)].
	^self saveImageInFileNamed: (self fullNameForImageNamed: newNameWithoutSuffix)! !

!SmalltalkImage methodsFor: 'memory space' stamp: ''!
createStackOverflow
	"For testing the low space handler..."
	"Smalltalk installLowSpaceWatcher; createStackOverflow"

	self createStackOverflow.  "infinite recursion"! !

!SmalltalkImage methodsFor: 'to clean later' stamp: 'MarcusDenker 4/21/2011 14:45'!
allClassesDo: aBlock
	"Evaluate the argument, aBlock, for each class in the system."

	globals allClassesDo: aBlock! !

!SmalltalkImage methodsFor: 'image, changes names' stamp: 'CamilloBruni 7/10/2012 21:49'!
imageFile
	"Answer the file for the current image."
	"SmalltalkImage current imageName"

	^ FileLocator image! !

!SmalltalkImage methodsFor: 'sources, change log' stamp: 'MarcusDenker 9/23/2014 18:09'!
licenseStringTemplate
	^ 'LICENSE
	
Licensed under the MIT License with parts under the Apache License.

Copyright (c) 2008-{1} The Pharo Project, and Contributors
Copyright (c) 2008-{1} Inria
Copyright (c) 1996-2008 Viewpoints Research Institute, and Contributors 
Copyright (c) 1996 Apple Computer, Inc.

Permission is hereby granted, free of charge, to any person obtaining a copy of this
software and associated documentation files (the "Software"), to deal in the Software
without restriction, including without limitation the rights to use, copy, modify, merge,
publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons
to whom the Software is furnished to do so, subject to the following conditions: The
above copyright notice and this permission notice shall be included in all copies or
substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS
OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

You may obtain a copy of the Apache License at
http://www.apache.org/licenses/LICENSE-2.0

Pharo uses icons by Mark James (http://www.famfamfam.com) under 
Creative Commons Attribution 2.5 License.

Pharo uses icons by Eclipse under 
Eclipse Public License - v 1.0
http://www.eclipse.org/legal/epl-v10.html

Pharo uses Source Code Pro Fonts by Adobe under 
SIL Open Font License, v 1.1
http://scripts.sil.org/OFL

Pharo uses Open Sans by Steve Matteson under 
Apache License, 2.0
http://www.apache.org/licenses/LICENSE-2.0.html

Pharo uses  Bitstream Vera Fonts
http://dejavu-fonts.org/wiki/index.php?title=License

Copyright (c) 2003 by Bitstream, Inc. All Rights Reserved. 
Bitstream Vera is a trademark of Bitstream, Inc.
Permission is hereby granted, free of charge, to any person obtaining a copy of the fonts 
accompanying this license ("Fonts") and associated documentation files (the "Font Software"), 
to reproduce and distribute the Font Software, including without limitation the rights to use, copy,
merge, publish, distribute, and/or sell copies of the Font Software, and to permit persons to whom 
the Font Software is furnished to do so, subject to the following conditions:
The above copyright and trademark notices and this permission notice shall be included in all 
copies of one or more of the Font Software typefaces.
The Font Software may be modified, altered, or added to, and in particular the designs of glyphs 
or characters in the Fonts may be modified and additional glyphs or characters may be added to
the Fonts, only if the fonts are renamed to names not containing either the words "Bitstream" 
or the word "Vera".
This License becomes null and void to the extent applicable to Fonts or Font Software that 
has been modified and is distributed under the "Bitstream Vera" names.
The Font Software may be sold as part of a larger software package but no copy of one or more
of the Font Software typefaces may be sold by itself.
THE FONT SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, 
INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR 
PURPOSE AND NONINFRINGEMENT OF COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT 
SHALL BITSTREAM OR THE GNOME FOUNDATION BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 
INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES, WHETHER IN AN 
ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF THE USE OR INABILITY TO USE THE 
FONT SOFTWARE OR FROM OTHER DEALINGS IN THE FONT SOFTWARE.
Except as contained in this notice, the names of Gnome, the Gnome Foundation, 
and Bitstream Inc., shall not be used in advertising or otherwise to promote the sale,
use or other dealings in this Font Software without prior written authorization from 
the Gnome Foundation or Bitstream Inc., respectively. 
For further information, contact: fonts at gnome dot org.'! !

!SmalltalkImage methodsFor: 'image, changes names' stamp: 'CamilloBruni 9/7/2013 11:28'!
imageName: newName
	"Set the the full path name for the current image.  All further snapshots will use this."

	self primImageName: (FilePathEncoder encode: newName)! !

!SmalltalkImage methodsFor: 'to clean later' stamp: 'MarcusDenker 5/3/2011 19:30'!
hasBindingThatBeginsWith: aString
	^globals hasBindingThatBeginsWith: aString! !

!SmalltalkImage methodsFor: 'endian' stamp: ''!
endianness

	EndianCache ifNil: [EndianCache := self calcEndianness].
	^ EndianCache.
! !

!SmalltalkImage methodsFor: 'snapshot and quit' stamp: ''!
quitPrimitive
	"Primitive. Exit to another operating system on the host machine, if one
	exists. All state changes in the object space since the last snapshot are lost.
	Essential. See Object documentation whatIsAPrimitive."

	<primitive: 113>
	self primitiveFailed! !

!SmalltalkImage methodsFor: '*Tool-Profilers' stamp: 'ar 6/22/2007 15:24'!
profileStart: counter
	"Primitive. Begin profiling execution every by using the interrupt check-counter instead of a time-based process (which is limited to timing resolution and triggers off the same signal that many of the processes being profiled trigger off leading to consistently wrong results).
	The argument is the number of interrupt checks (method activations) to let go by before taking a sample. The sample is being stored in the profileSample iVar which can be retrieved by executing primitiveProfileSample. When a sample is taken, it signals the semaphore specified in primitiveProfileSemaphore.
	If the argument is less or equal to zero, it disables profiling."
	<primitive: 'primitiveProfileStart'>
	^self primitiveFailed! !

!SmalltalkImage methodsFor: 'log' stamp: 'PavelKrivanek 7/20/2014 09:31'!
defaultLogFileName
 
	^ 'PharoDebug.log'! !

!SmalltalkImage methodsFor: 'housekeeping' stamp: ''!
removeAllLineFeedsQuietly
	"Smalltalk removeAllLineFeedsQuietly"
	"Scan all methods for source code with lineFeeds.
	Replaces all occurrences of <CR><LF> or <LF> by <CR>.
	Answer a Dictionary keyed by author name containing sets of affected method names,
	as well as (at the key 'OK') a list of methods that still contain LF characters inside literal strings or characters."
	^self removeAllLineFeedsQuietlyCalling: [].! !

!SmalltalkImage methodsFor: 'class and trait names' stamp: 'MarcusDenker 4/21/2011 21:34'!
removeClassNamed: aName
	"Invoked from fileouts:  if there is currently a class in the system named aName, then remove it.  If anything untoward happens, report it in the Transcript.  "

	globals removeClassNamed: aName! !

!SmalltalkImage methodsFor: 'housekeeping' stamp: 'aaef 11/12/2014 17:47'!
fixObsoleteSharedPools
	self allClasses
		select: [ :class |
			class sharedPools isEmptyOrNil not and: [ 
				class sharedPools contains: #isObsolete ] ]
		thenDo: [ :class |
			| obsolete |
			obsolete := class sharedPools select: #isObsolete.
			class sharedPools removeAll: obsolete ].
		
	"#sharedPools is a lazy initializer and most classes don't have a shared pool.
	Resetting the shared pools to nil should therefore save a bit of space."
	self allClasses
		select: [ :class | class sharedPools isEmpty ]
		thenDo: [ :class | class sharedPools: nil ]! !

!SmalltalkImage methodsFor: 'sources, change log' stamp: ''!
lastQuitLogPosition: aNumber
	"should be only use to ensure the transition from SystemDictionary to SmalltalkImage, then  	be removed"
		
	LastQuitLogPosition := aNumber! !

!SmalltalkImage methodsFor: 'image, changes names' stamp: 'SqR 11/7/2013 07:07'!
fullNameForImageNamed: aString

	^(self fileForImageNamed: aString) fullName! !

!SmalltalkImage methodsFor: 'class and trait names' stamp: ''!
renameClass: aClass from: oldName
	"Rename the class, aClass, to have the title newName."

	^globals renameClass: aClass from: oldName! !

!SmalltalkImage methodsFor: 'image, changes names' stamp: 'CamilloBruni 9/7/2013 11:28'!
imageName
	"Answer the full path name for the current image."

	"SmalltalkImage current imageName"

	^ FilePathEncoder decode: self primImageName! !

!SmalltalkImage methodsFor: 'to clean later' stamp: ''!
keyAtValue: anObject
	"Obsoleted."
	self flag: #tobeprecated.
	"self deprecated: 'Use Smalltalk globals'."
	^globals keyAtValue: anObject! !

!SmalltalkImage methodsFor: 'to clean later' stamp: ''!
do: aBlock
	"Obsoleted."
	self flag: #tobeprecated.
	"self deprecated: 'Use Smalltalk globals'."
	^globals do: aBlock
	
! !

!SmalltalkImage methodsFor: 'miscellaneous' stamp: 'IgorStasenko 1/21/2011 18:57'!
closeLog: logger
	"This is a _private_ method,
	Because it really belongs to logging facility,
	we should delegate to it at some point "
	
	logger ifNotNil: [ logger close ]
! !

!SmalltalkImage methodsFor: 'system attribute' stamp: 'IgorStasenko 8/17/2011 17:00'!
extractParameters

	| pName value index dict |
	dict := Dictionary new.
	index := 3. "Muss bei 3 starten, da 2 documentName ist"
	[pName := self vm getSystemAttribute: index.
	pName isEmptyOrNil] whileFalse:[
		index := index + 1.
		value := self vm getSystemAttribute: index.
		value ifNil: [value := ''].
 		dict at: pName asUppercase put: value.
		index := index + 1].
	^dict! !

!SmalltalkImage methodsFor: '*Tool-Profilers' stamp: 'ar 6/22/2007 15:24'!
profilePrimitive
	"Primitive. Answer the primitive sample by the profiler, or nil if the profiler isn't active.
	See also primitiveProfileStart."
	<primitive: 'primitiveProfilePrimitive'>
	^self primitiveFailed! !

!SmalltalkImage methodsFor: 'snapshot and quit' stamp: 'ClementBera 7/26/2013 17:05'!
startupImage: isNewImage snapshotWorked: snapshotResult
	| startupErrors |
	self vm setGCParameters.
	deferredStartupActions := nil.
	isNewImage
		ifTrue: [ Smalltalk clearExternalObjects ].
	startupErrors := OrderedCollection new.
	UIManager default
		boot: isNewImage
		during: [ 
			startupErrors addAll: (self processStartUpList: isNewImage).
			isNewImage
				ifTrue: [ self recordStartupStamp ] ].
	startupErrors addAll: (self executeDeferredStartupActions: isNewImage).
	startupErrors isEmpty
		ifFalse: [ self handleStartupErrors: startupErrors ].
	snapshotResult ifNil: [ self error: 'Failed to write image file (disk full?)' ]! !

!SmalltalkImage methodsFor: 'sources, change log' stamp: 'MarcusDenker 9/30/2013 22:56'!
forceChangesToDisk
	"Ensure that the changes file has been fully written to disk by closing and re-opening it. This makes the system more robust in the face of a power failure or hard-reboot."

	| changesFile |
	changesFile := SourceFiles at: 2.
	(changesFile isKindOf: FileStream)
		ifFalse: [ ^ self ].
	changesFile flush.
	changesFile close.
	changesFile open: changesFile name forWrite: true.
	changesFile setToEnd! !

!SmalltalkImage methodsFor: 'startup list' stamp: ''!
addToStartUpList: aClass after: predecessor

	self add: aClass toList: StartUpList after: predecessor! !

!SmalltalkImage methodsFor: 'saving' stamp: 'RobertoMinelli 11/27/2013 07:52'!
stripImageExtensionFrom: aString

	| answer imageExtension delimitedImageExtension |
	answer := aString.
	imageExtension := Path extensionDelimiter asString, self imageSuffix.
	delimitedImageExtension := imageExtension copyWith: Path extensionDelimiter.
	[answer isNil not and: [(answer endsWith: imageExtension) or: [answer endsWith: delimitedImageExtension]]]
		whileTrue: [answer := answer copyUpToLast: Path extensionDelimiter].
	^answer! !

!SmalltalkImage methodsFor: '*Tool-Base' stamp: 'IgorStasenko 2/7/2011 18:15'!
resetTools

	Tools := nil! !

!SmalltalkImage methodsFor: 'saving' stamp: 'PavelKrivanek 6/14/2011 09:59'!
saveImageInNewContext

	" This method is used for saving the Smalltalk image in a new process so the current process with all stack information may be forgotten.
	
	Do not use this method for common image saving. This method is designated for saving the image during the shrinking process in headless images. "

	[ self privSaveImageWithCleanup ] forkAt: 40.! !

!SmalltalkImage methodsFor: 'image, changes names' stamp: 'SqR 11/7/2013 07:07'!
fileForImageNamed: aString

	^(self imageDirectory resolve: aString), self imageSuffix! !

!SmalltalkImage methodsFor: 'system attribute' stamp: 'DamienCassou 2/13/2015 18:06'!
extractMinusParameters
	"Returns a dictionary matching parameters beginning by a minus character and the list of the next parameters.
	Here is an example: 
		I suppose I run pharo with: `pharo myImage.image 1 2 3 woah -minus1 'Hello' -minus2 -minus3 'Hello' 'World'`.
		This message will return a dictionary with: 
			* --> #(1 2 3 'woah')
			minus1 --> #('Hello')
			minus2 --> #()
			minus3 --> #('Hello' 'World')"
			
	| args str index |
	
	args := OrderedCollection new.

	str := self getSystemAttribute: (index := 2).
	[ str isNil ] whileFalse: [ args add: str. str := self getSystemAttribute: (index := index + 1) ].

	^ self extractMinusParametersFrom: args! !

!SmalltalkImage methodsFor: 'snapshot and quit' stamp: 'SqR 11/7/2013 07:29'!
getFileNameFromUser

	| givenName strippedName imageFile changesFile |
	givenName := UIManager default
		request: 'New File Name?' translated
		initialAnswer: (self imageFile basename copyUpToLast:  Path extensionDelimiter).
	strippedName := self stripImageExtensionFrom: givenName.
	strippedName isEmptyOrNil ifTrue: [^nil].
	imageFile := self fileForImageNamed: strippedName.
	changesFile := self fileForChangesNamed: strippedName.
	((imageFile exists or: [changesFile exists]) and:
		[(self confirm: ('{1} already exists. Overwrite?' translated format: {strippedName})) not])
			ifTrue: [^nil].
	^strippedName! !

!SmalltalkImage methodsFor: 'class and trait names' stamp: 'MarcusDenker 4/21/2011 14:45'!
allClassesAndTraits
	"Return all the classes and traits defined in the Smalltalk SmalltalkImage"

	^ globals allClassesAndTraits! !

!SmalltalkImage methodsFor: 'image, changes names' stamp: 'CamilloBruni 5/7/2012 01:39'!
imageSuffix
	^ 'image'! !

!SmalltalkImage methodsFor: 'saving' stamp: 'CamilloBruni 1/24/2013 21:26'!
backupTo: newNameWithoutSuffix
	"Create a new backup of this image. 
	Unlike #saveAs: do not transfer the default execution to the new image. 
	Results:
		true  when continuing in the new session
		false for the current session"
	(SourceFiles at: 2) ifNotNil:[
		self 
			closeSourceFiles; "so copying the changes file will always work"
			saveChangesInFileNamed: (self fullNameForChangesNamed: newNameWithoutSuffix)].
	
	^self backupImageInFileNamed: (self fullNameForImageNamed: newNameWithoutSuffix)! !

!SmalltalkImage methodsFor: 'special objects' stamp: ''!
clearExternalObjects
	"Clear the array of objects that have been registered for use in non-Smalltalk code."
	"Smalltalk clearExternalObjects"

	ExternalSemaphoreTable clearExternalObjects
! !

!SmalltalkImage methodsFor: 'snapshot and quit' stamp: 'GuillermoPolito 4/23/2012 14:52'!
shutDownImage: quitting
	Object flushDependents.
	Object flushEvents.

	self processShutDownList: quitting.! !

!SmalltalkImage methodsFor: 'miscellaneous' stamp: 'CamilloBruni 2/13/2012 22:29'!
logError: errMsg inContext: aContext

	" we should think about integrating a toothpick here someday"
	self logStdErrorDuring: [ :stderr|
		"install the line end conversion and force initialize the converter"
		stderr
			nextPutAll: errMsg; cr;
			"reset the color"
			nextPut: Character escape; nextPutAll: '[0m'.
		aContext shortDebugStackOn: stderr.].
				
	self logDuring: [:logger | 
		logger	
			nextPutAll: 'THERE_BE_DRAGONS_HERE'; cr; 
		  	nextPutAll: errMsg; cr.
			"just print the error message if no context is given"
			aContext ifNotNil: [
				aContext errorReportOn: logger ].
		" write some type of separator"
		logger nextPutAll: (String new: 79 withAll: $- ); cr; cr]! !

!SmalltalkImage methodsFor: 'class and trait names' stamp: ''!
organization
	"Return the organizer for the receiver"
	^globals organization! !

!SmalltalkImage methodsFor: 'snapshot and quit' stamp: 'CamilloBruni 7/25/2012 10:53'!
exitSuccess
	"Quit the VM with a success signal.
	Will lose all current changes."
	self exit: 0! !

!SmalltalkImage methodsFor: 'snapshot and quit' stamp: 'CamilloBruni 4/20/2013 18:53'!
logStartupError: anError into: aCollection tryDebugger: tryDebugger
	"try to debug the given error or add a freezed version to aCollection"
	tryDebugger ifTrue: [[
		^ (anError isKindOf: Halt) 
			ifTrue: [ anError pass ]
			ifFalse: [ anError debug ]
		] on: Error do: [ 
				"an error occured during error handling... 
				treat the error as a normal startup error " ]].

	self 
		logError: '==== Startup Error: ', anError description 
		inContext: anError signalerContext.
	"freeze the error"
	aCollection add: anError freeze.! !

!SmalltalkImage methodsFor: 'settings' stamp: 'SvenVanCaekenberghe 2/11/2013 14:31'!
shouldDownloadSourcesFile
	"If true, when no sources file can be found, the file will be downloaded.
	The default is false."

	^ self class shouldDownloadSourcesFile ! !

!SmalltalkImage methodsFor: 'snapshot and quit' stamp: 'Camillobruni 8/11/2011 22:56'!
processShutDownList: quitting
	"Send #shutDown to each class that needs to wrap up before a snapshot.
	Also void the endianness chace; this can't safely be done on start-up because
	Smalltalk is too late in the start-up sequence."

	EndianCache := nil.
	^ self send: #shutDown: toClassesNamedIn: ShutDownList with: quitting.
! !

!SmalltalkImage methodsFor: 'system attribute' stamp: ''!
commandLine
	"Answer the object to query about command line."
	
	^self! !

!SmalltalkImage methodsFor: 'sources, change log' stamp: ''!
systemInformationString
	^ String cr, SystemVersion current version, String cr, self lastUpdateString, String cr, String cr, String cr, self licenseString! !

!SmalltalkImage methodsFor: 'to clean later' stamp: 'MarcusDenker 4/21/2011 21:39'!
allTraits
	"Return all traits defined in the Smalltalk SmalltalkImage"

	^globals allTraits! !

!SmalltalkImage methodsFor: 'startup list' stamp: 'MarcusDenker 4/16/2011 22:36'!
addToShutDownList: aClass before: predecessor

	self add: aClass toList: ShutDownList before: predecessor! !

!SmalltalkImage methodsFor: 'to clean later' stamp: ''!
keyAtIdentityValue: anObject ifAbsent: aBlock
	"Obsoleted."

	self flag: #tobeprecated.
	"self deprecated: 'Use Smalltalk globals'."
	^globals keyAtIdentityValue: anObject ifAbsent: aBlock! !

!SmalltalkImage methodsFor: 'endian' stamp: ''!
isLittleEndian
	^self endianness == #little! !

!SmalltalkImage methodsFor: 'class and trait names' stamp: 'MarcusDenker 4/21/2011 21:33'!
allClassesAndTraitsDo: aBlock
	^globals allClassesAndTraitsDo: aBlock! !

!SmalltalkImage methodsFor: 'image, changes names' stamp: 'SqR 11/7/2013 07:07'!
fileForChangesNamed: aString

	^(self imageDirectory resolve: aString), self changesSuffix! !

!SmalltalkImage methodsFor: 'image, changes names' stamp: 'CamilloBruni 9/7/2013 11:28'!
imagePath
	"Answer the full path name for the current image."

	"SmalltalkImage current imageName"

	^ FilePathEncoder decode: self primImagePath! !

!SmalltalkImage methodsFor: 'memory space' stamp: ''!
primitiveGarbageCollect
	"Primitive. Reclaims all garbage and answers the number of bytes of available space."

	<primitive: 130>
	^ self primBytesLeft! !

!SmalltalkImage methodsFor: 'memory space' stamp: ''!
isYoung: oop
	"Primitive. Answer whether the object currently resides in youngSpace."
	<primitive: 'primitiveIsYoung'>
	^self primitiveFailed! !

!SmalltalkImage methodsFor: 'memory space' stamp: ''!
primSignalAtBytesLeft: numBytes
	"Tell the interpreter the low-space threshold in bytes. When the free
	space falls below this threshold, the interpreter will signal the low-space
	semaphore, if one has been registered.  Disable low-space interrupts if the
	argument is zero.  Fail if numBytes is not an Integer."

	<primitive: 125>
	self primitiveFailed! !

!SmalltalkImage methodsFor: 'sources, change log' stamp: ''!
lastQuitLogPosition
	^ LastQuitLogPosition! !

!SmalltalkImage methodsFor: 'class and trait names' stamp: ''!
hasClassNamed: aString
	"Answer whether there is a class of the given name, but don't intern aString if it's not alrady interned."

	^ globals hasClassNamed: aString! !

!SmalltalkImage methodsFor: 'image, changes names' stamp: 'CamilloBruni 5/7/2012 01:53'!
changesName
	"Answer the name for the changes file corresponding to the image file name."
	"Smalltalk changesName"

	^ self changesFile fullName ! !

!SmalltalkImage methodsFor: 'printing' stamp: ''!
printOn: aStream
	self == Smalltalk ifFalse: [^super printOn: aStream].
	aStream nextPutAll: 'Smalltalk'! !

!SmalltalkImage methodsFor: 'to clean later' stamp: ''!
at: key ifAbsent: aBlock
	"Answer the global associated with the key or, if key isn't found,
	answer the result of evaluating aBlock."

	^globals at: key ifAbsent: aBlock! !

!SmalltalkImage methodsFor: 'cleanup' stamp: ''!
cleanUp: aggressive
	"Clean up. When aggressive is true, this will destroy change sets, etc."
	"Smalltalk cleanUp: false"
	"Smalltalk cleanUp: true"

	^self cleanUp: aggressive except: #()! !

!SmalltalkImage methodsFor: 'sources, change log' stamp: 'MartinDias 11/13/2013 15:34'!
closeSourceFiles
	"Shut down the source files if appropriate."

	SourceFiles close! !

!SmalltalkImage methodsFor: 'compiler' stamp: 'MarcusDenker 12/7/2013 23:52'!
compilerClass
	^CompilerClass ifNil: [CompilerClass := OpalCompiler].! !

!SmalltalkImage methodsFor: 'image, changes names' stamp: ''!
sourceFileVersionString

	^ SourceFileVersionString! !

!SmalltalkImage methodsFor: 'memory space' stamp: ''!
okayToProceedEvenIfSpaceIsLow
	"Return true if either there is enough memory to do so safely or if the user gives permission after being given fair warning."

	self garbageCollectMost > self lowSpaceThreshold ifTrue: [^ true].  "quick"
	self garbageCollect > self lowSpaceThreshold ifTrue: [^ true].  "work harder"

	^ self confirm:
'WARNING: There is not enough space to start the low space watcher.
If you proceed, you will not be warned again, and the system may
run out of memory and crash. If you do proceed, you can start the
low space notifier when more space becomes available simply by
opening and then closing a debugger (e.g., by hitting Cmd-period.)
Do you want to proceed?'
! !

!SmalltalkImage methodsFor: 'special objects' stamp: 'GuillermoPolito 5/3/2012 11:12'!
primitiveGetSpecialObjectsArray
	<primitive: 129>
	^ self primitiveFailed! !

!SmalltalkImage methodsFor: 'image' stamp: ''!
image
	"Answer the object to query about the current object memory and execution environment."
	
	^self! !

!SmalltalkImage methodsFor: 'testing' stamp: 'CamilloBruni 5/9/2013 20:14'!
isHeadless
	"Check if vm were run with headless parameter.
	Different VMs for different platform have different multiple way(s) to indicate that"
	
	-1000 to: 1000 do: [ :n | 
		(#('display=none' '-headless' '-vm-display-null' '-nodisplay' '--headless' '--vm-display-null' '--nodisplay') 
			includes: (self vm getSystemAttribute: n)) 
				ifTrue: [ ^ true ]].
	^ false
	
	
! !

!SmalltalkImage methodsFor: 'special objects' stamp: ''!
unregisterExternalObject: anObject
	"Unregister the given object in the external objects array. Do nothing if it isn't registered."

	ExternalSemaphoreTable unregisterExternalObject: anObject! !

!SmalltalkImage methodsFor: 'image, changes names' stamp: 'CamilloBruni 7/10/2012 21:49'!
changesFile
	"Answer the file containing the current changes."

	^ FileLocator changes
! !

!SmalltalkImage methodsFor: 'compiler' stamp: 'MarcusDenker 5/12/2013 11:44'!
compiler
	^self compilerClass new
		environment: self! !

!SmalltalkImage methodsFor: 'external' stamp: ''!
unbindExternalPrimitives
	"Primitive. Force all external primitives to be looked up again afterwards. Since external primitives that have not found are bound for fast failure this method will force the lookup of all primitives again so that after adding some plugin the primitives may be found."
	<primitive: 570>
	"Do nothing if the primitive fails for compatibility with older VMs"
! !

!SmalltalkImage methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 4/6/2015 12:39'!
gtInspectorDetailsIn: composite
	<gtInspectorPresentationOrder: 0>
	composite table
		title: 'Details';
		display: [ 
			{ 
				'Image directory' -> self imageDirectory asFileReference.
				'Image format version' -> self imageFormatVersion.
				'License' -> self licenseString.
				'VM directory' -> self vmDirectory asFileReference.
				'VM version' -> self version
			} ];
		column: 'Property' evaluated: #key;
		column: 'Value' evaluated: #value;
		send: #value! !

!SmalltalkImage methodsFor: 'memory space' stamp: ''!
bytesLeft: aBool
	"Return the amount of available space. If aBool is true, include possibly available swap space. If aBool is false, include possibly available physical memory. For a report on the largest free block currently availabe within Pharo memory but not counting extra memory use #primBytesLeft."
	<primitive: 112>
	^self primBytesLeft! !

!SmalltalkImage methodsFor: 'system attribute' stamp: 'ClementBera 4/11/2013 14:06'!
arguments
	"Answer an array with all the command line arguments.
	This does not include imagePath, documentPath nor any option."

	"Smalltalk commandLine arguments"

	^ Array
		streamContents: [ :str | 
			| arg i |
			i := 1.
			[ i > 998 or: [ (arg := self argumentAt: i) isNil ] ]
				whileFalse: [ 
					str nextPut: arg.
					i := i + 1 ] ]! !

!SmalltalkImage methodsFor: 'sources, change log' stamp: 'TorstenBergmann 1/31/2014 09:20'!
licenseString
	^ self licenseStringTemplate format: (Array with: Date today year asString)! !

!SmalltalkImage methodsFor: 'special objects' stamp: ''!
specialSelectors
	"Used by SystemTracer only."

	^SpecialSelectors! !

!SmalltalkImage methodsFor: 'class and trait names' stamp: 'MarcusDenker 4/21/2011 21:34'!
classOrTraitNamed: aString
	"aString is either a class or trait name or a class or trait name followed by ' class' or 'classTrait' respectively. Answer the class or metaclass it names."

	^ globals classOrTraitNamed: aString! !

!SmalltalkImage methodsFor: 'class and trait names' stamp: ''!
renameClass: aClass as: newName 
	"Rename the class, aClass, to have the title newName."

	^globals renameClass: aClass as: newName! !

!SmalltalkImage methodsFor: 'housekeeping' stamp: 'aaef 11/12/2014 17:33'!
fixObsoleteReferences
	"SmalltalkImage current fixObsoleteReferences.
	SystemNavigation new obsoleteBehaviors size > 0
		ifTrue: [ SystemNavigation new obsoleteBehaviors inspect.
			self error:'Still have obsolete behaviors. See inspector']"
		
	self
		garbageCollect;
		fixObsoleteBindings;
		fixObsoleteSharedPools.
	Behavior flushObsoleteSubclasses! !

!SmalltalkImage methodsFor: 'snapshot and quit' stamp: 'GuillermoPolito 12/12/2014 15:09'!
executeDeferredStartupActions: resuming
	"Execute the deferred actions which where added during startup, resuming is true if the iage was started fresh, false if we just saved an image"

	| errors |
	
	deferredStartupActions ifNil: [^ #()].
	
	errors := OrderedCollection new.	
	

	[ deferredStartupActions notEmpty ] 
		whileTrue: [ | action |
			action := deferredStartupActions removeFirst.
			self 
				logStartUpErrorDuring: [ action cull: resuming ] 
				into: errors
				tryDebugger: self isInteractive ].
		
	^ errors! !

!SmalltalkImage methodsFor: 'image, changes names' stamp: 'CamilloBruni 5/7/2012 01:57'!
sourcesFile
	"Answer the full path to the version-stable source code"
	^ self vmDirectory /  SourceFileVersionString , self sourcesSuffix! !

!SmalltalkImage methodsFor: 'to clean later' stamp: ''!
flushClassNameCache
	"Smalltalk flushClassNameCache"
	"Force recomputation of the cached list of class names."

	globals flushClassNameCache.! !

!SmalltalkImage methodsFor: 'miscellaneous' stamp: ''!
exitToDebugger
	"Primitive. Enter the machine language debugger, if one exists. Essential.
	See Object documentation whatIsAPrimitive."

	<primitive: 114>
	self primitiveFailed! !

!SmalltalkImage methodsFor: 'sources, change log' stamp: 'CamilloBruni 11/5/2013 16:57'!
timeStamp: aStream
	"Writes system version and current time on stream aStream."

	| dateTime |
	dateTime := DateAndTime now.
	aStream
		nextPutAll: 'From ' , self datedVersion , ' [' , self lastUpdateString , '] on ' , dateTime asDate printString;
		nextPutAll: ' at ';
		nextPutAll: dateTime asTime printString! !

!SmalltalkImage methodsFor: 'log' stamp: 'PavelKrivanek 7/20/2014 09:30'!
logFileName

	^ LogFileName ifNil: [ self defaultLogFileName ] ! !

!SmalltalkImage methodsFor: 'image, changes name' stamp: ''!
primImageName
	"Answer the full path name for the current image."
	"Smalltalk imageName"

	<primitive: 121>
	self primitiveFailed! !

!SmalltalkImage methodsFor: 'special objects' stamp: 'GuillermoPolito 3/4/2015 16:32'!
newSpecialObjectsArray
	"Smalltalk recreateSpecialObjectsArray"
	
	"To external package developers:
	**** DO NOT OVERRIDE THIS METHOD.  *****
	If you are writing a plugin and need additional special object(s) for your own use, 
	use addGCRoot() function and use own, separate special objects registry "
	
	"The Special Objects Array is an array of objects used by the Pharo virtual machine.
	 Its contents are critical and accesses to it by the VM are unchecked, so don't even
	 think of playing here unless you know what you are doing."
	
	| newArray |
	newArray := Array new: 59.
	"Nil false and true get used throughout the interpreter"
	newArray at: 1 put: nil.
	newArray at: 2 put: false.
	newArray at: 3 put: true.
	"This association holds the active process (a ProcessScheduler)"
	newArray at: 4 put: (self globals associationAt: #Processor).
	"Numerous classes below used for type checking and instantiation"
	newArray at: 5 put: (self at: #Bitmap ifAbsent: []).
	newArray at: 6 put: SmallInteger.
	newArray at: 7 put: ByteString.
	newArray at: 8 put: Array.
	newArray at: 9 put: Smalltalk.
	newArray at: 10 put: Float.
	newArray at: 11 put: Context.
	newArray at: 12 put: nil. "Was BlockContext"
	newArray at: 13 put: Point.
	newArray at: 14 put: LargePositiveInteger.
	newArray at: 15 put: Display.
	newArray at: 16 put: Message.
	newArray at: 17 put: CompiledMethod.
	newArray at: 18 put: (self specialObjectsArray ifNil: [ Semaphore new ] ifNotNil: [ self specialObjectsArray at: 18 ]). "(low space Semaphore)"
	newArray at: 19 put: Semaphore.
	newArray at: 20 put: Character.
	newArray at: 21 put: #doesNotUnderstand:.
	newArray at: 22 put: #cannotReturn:.
	newArray at: 23 put: nil. "This is the process signalling low space."
	"An array of the 32 selectors that are compiled as special bytecodes,
	 paired alternately with the number of arguments each takes."
	newArray at: 24 put: #(	#+ 1 #- 1 #< 1 #> 1 #<= 1 #>= 1 #= 1 #~= 1
							#* 1 #/ 1 #\\ 1 #@ 1 #bitShift: 1 #// 1 #bitAnd: 1 #bitOr: 1
							#at: 1 #at:put: 2 #size 0 #next 0 #nextPut: 1 #atEnd 0 #== 1 nil 0
							nil 1 #value 0 #value: 1 #do: 1 #new 0 #new: 1 #x 0 #y 0 ).
	"An array of the 255 Characters in ascii order.
	 Cog inlines table into machine code at: prim so do not regenerate it."
	newArray at: 25 put: (self primitiveGetSpecialObjectsArray at: 25).
	newArray at: 26 put: #mustBeBoolean.
	newArray at: 27 put: ByteArray.
	newArray at: 28 put: Process.
	"A 32-element array with up to 32 classes that have compact instances.
	 Cog inlines table into machine code class lookup so do not regenerate it."
	newArray at: 29 put: self compactClassesArray.
	newArray at: 30 put: (self specialObjectsArray ifNil: [ Semaphore new ] ifNotNil: [ self specialObjectsArray at: 30 ]). 	"(delay Semaphore)"
	newArray at: 31 put: (self specialObjectsArray ifNil: [ Semaphore new ] ifNotNil: [ self specialObjectsArray at: 31 ]). 	"(user interrupt Semaphore)"
	"Prototype instances that can be copied for fast initialization"
	newArray at: 32 put: (Float new: 2).
	newArray at: 33 put: (LargePositiveInteger new: 4).
	newArray at: 34 put: 0@0.
	newArray at: 35 put: #cannotInterpret:.
	"Note: This must be fixed once we start using context prototypes (yeah, right)"
	"(Context new: CompiledMethod fullFrameSize)."
	newArray at: 36 put: (self primitiveGetSpecialObjectsArray at: 36). "Is the prototype Context (unused by the VM)"
	newArray at: 37 put: BlockClosure.
	"(BlockContext new: CompiledMethod fullFrameSize)."
	newArray at: 38 put: (self primitiveGetSpecialObjectsArray at: 38). "Is the prototype BlockContext (unused by the VM)"
	"array of objects referred to by external code"
	newArray at: 39 put: (self primitiveGetSpecialObjectsArray at: 39).	"preserve external semaphores"
	newArray at: 40 put: nil. "Reserved for Mutex in Cog VMs"
	newArray at: 41 put: nil. "Reserved for a LinkedList instance for overlapped calls in CogMT"
	"finalization Semaphore"
	newArray at: 42 put: (self specialObjectsArray ifNil: [ Semaphore new ] ifNotNil: [ (self specialObjectsArray at: 42) ifNil: [ Semaphore new ] ]).
	newArray at: 43 put: LargeNegativeInteger.
	"External objects for callout.
	 Note: Written so that one can actually completely remove the FFI."
	newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []).
	newArray at: 45 put: (self at: #ExternalStructure ifAbsent: []).
	newArray at: 46 put: (self at: #ExternalData ifAbsent: []).
	newArray at: 47 put: (self at: #ExternalFunction ifAbsent: []).
	newArray at: 48 put: (self at: #ExternalLibrary ifAbsent: []).
	newArray at: 49 put: #aboutToReturn:through:.
	newArray at: 50 put: #run:with:in:.
	"51 reserved for immutability message"
	"newArray at: 51 put: #attemptToAssign:withIndex:."
	newArray at: 52 put: #(nil "nil => generic error" #'bad receiver'
							#'bad argument' #'bad index'
							#'bad number of arguments'
							#'inappropriate operation'  #'unsupported operation'
							#'no modification' #'insufficient object memory'
							#'insufficient C memory' #'not found' #'bad method'
							#'internal error in named primitive machinery'
							#'object may move').
	"53 to 55 are for Alien"
	newArray at: 53 put: (self at: #Alien ifAbsent: []).
	newArray at: 54 put: #invokeCallback:stack:registers:jmpbuf:.
	newArray at: 55 put: (self at: #UnsafeAlien ifAbsent: []).

	"Weak reference finalization"
	newArray at: 56 put: (self at: #WeakFinalizationList ifAbsent: []).
	
	newArray at: 57 put: nil. "Reserved for ForeignCallbackProcess"
	newArray at: 58 put: #respondsToUnknownBytecode. 
	newArray at: 59 put: #conditionalBranchCounterTrippedOn:. "Reserved for SistaStackToRegisterCogit"

	^newArray! !

!SmalltalkImage methodsFor: 'to clean later' stamp: ''!
bindingOf: varName
	"Answer the binding of some variable resolved in the scope of the receiver"

	^globals bindingOf: varName! !

!SmalltalkImage methodsFor: 'special objects' stamp: ''!
externalObjects
	"Return an array of objects that have been registered for use in non-Smalltalk code. Smalltalk objects should be referrenced by external code only via indirection through this array, thus allowing the objects to move during compaction. This array can be cleared when the VM re-starts, since variables in external code do not survive snapshots. Note that external code should not attempt to access a Smalltalk object, even via this mechanism, while garbage collection is in progress."
	"Smalltalk externalObjects"

	^ ExternalSemaphoreTable externalObjects
! !

!SmalltalkImage methodsFor: 'to clean later' stamp: 'MarcusDenker 4/21/2011 14:45'!
allClasses  
	"Return all the class defines in the SmalltalkImage"
	"Smalltalk allClasses"
	"May be we could discard this one in the future"
	^ globals allClasses! !

!SmalltalkImage methodsFor: 'system attribute' stamp: 'IgorStasenko 8/17/2011 17:04'!
optionAt: i
	"Answer the i-th option of the command line, or nil if not so many options."
	
	^self  vm optionAt: i! !

!SmalltalkImage methodsFor: 'snapshot and quit' stamp: 'CamilloBruni 2/21/2012 01:05'!
exit: exitStatus
	"Primitive. Exit to another operating system on the host machine, if one
	exists. All state changes in the object space since the last snapshot are lost.
	Essential. See Object documentation whatIsAPrimitive.
	
	Possible values for exitStatus:
	0:   success
	> 1: error"

	<primitive: 113>
	self primitiveFailed! !

!SmalltalkImage methodsFor: '*Tool-Profilers' stamp: 'ar 6/22/2007 15:25'!
highResClock	"Smalltalk highResClock"
	"Primitive. Answer the value of the high resolution clock if this computer has one.
	Usually, this should be the highest resolution value available, for example on Intel
	it will be the value of the time stamp counter register."
	<primitive: 'primitiveHighResClock'>
	^0! !

!SmalltalkImage methodsFor: 'snapshot and quit' stamp: 'StephaneDucasse 6/7/2011 15:22'!
addDeferredStartupAction: aBlock
	"Add the monadic or nulladic block to the list of actions that we will be performed immediately after the startup is totally executed."
	
	deferredStartupActions 
		ifNil: [deferredStartupActions := OrderedCollection new].
	deferredStartupActions add: aBlock.
	! !

!SmalltalkImage methodsFor: 'cleanup' stamp: ''!
cleanUp	
	"Smalltalk cleanUp"
	"Gently clean up"
	
	^self cleanUp: false! !

!SmalltalkImage methodsFor: 'snapshot and quit' stamp: ''!
snapshotPrimitive
	"Primitive. Write the current state of the object memory on a file in the
	same format as the Smalltalk-80 release. The file can later be resumed,
	returning you to this exact state. Return normally after writing the file.
	Essential. See Object documentation whatIsAPrimitive."

	<primitive: 97>
	^nil "indicates error writing image file"! !

!SmalltalkImage methodsFor: 'image, changes names' stamp: 'CamilloBruni 5/7/2012 01:57'!
sourcesSuffix
	^ 'sources'! !

!SmalltalkImage methodsFor: 'saving' stamp: 'S 6/17/2013 13:26'!
saveImageInFileNamed: aFile
	"Save the image in the given file.
	Unlike #backupImageInFileNamed: this method continues evaluation in the new image after saving.
	Note: This method does not save the .changes file, use #saveAs:"
	
	| imageFile |
	
	imageFile := aFile  asFileReference.
	imageFile parent ensureCreateDirectory.
	
	^self
		changeImagePathTo: imageFile fullName;
		closeSourceFiles;
		openSourceFiles;  "so SNAPSHOT appears in new changes file"
		snapshot: true andQuit: false! !

!SmalltalkImage methodsFor: 'image, changes names' stamp: 'CamilloBruni 7/10/2012 21:54'!
vmBinary
	^ self vm binary! !

!SmalltalkImage methodsFor: 'memory space' stamp: ''!
rootTable
	"Primitive. Answer a snapshot of the VMs root table. 
	Keep in mind that the primitive may itself cause GC."
	<primitive: 'primitiveRootTable'>
	^self primitiveFailed! !

!SmalltalkImage methodsFor: 'memory space' stamp: 'CamilloBruni 8/21/2013 19:12'!
installLowSpaceWatcher
	"Start a process to watch for low-space conditions."

	"Smalltalk installLowSpaceWatcher"

	self primSignalAtBytesLeft: 0.	"disable low-space interrupts"
	LowSpaceProcess ifNotNil: [ LowSpaceProcess terminate ].
	LowSpaceProcess := [ self lowSpaceWatcher ] newProcess.
	LowSpaceProcess name: 'Low Space Watcher'.
	LowSpaceProcess priority: Processor lowIOPriority.
	LowSpaceProcess resume! !

!SmalltalkImage methodsFor: '*Tool-Profilers' stamp: 'ar 6/22/2007 15:24'!
profileSemaphore: aSemaphore
	"Primitive. Install the semaphore to be used for profiling, 
	or nil if no semaphore should be used.
	See also primitiveProfileStart."
	<primitive: 'primitiveProfileSemaphore'>
	^self primitiveFailed! !

!SmalltalkImage methodsFor: 'memory space' stamp: 'CamilloBruni 10/21/2012 15:09'!
spaceLeftAfterGarbageCollection
	"Return a string describing the amount of memory available"
	| availInternal availPhysical availTotal |
	self garbageCollect.
	availInternal := self primBytesLeft.
	availPhysical := self bytesLeft: false.
	availTotal := self bytesLeft: true.
	(availTotal > (availInternal + 10000)) "compensate for mini allocations inbetween"
		ifFalse:[^availInternal asStringWithCommas, ' bytes available'].
	^String streamContents:[:s|
		availInternal printWithCommasOn: s.
		s nextPutAll: ' bytes (internal) '; cr.
		 availPhysical printWithCommasOn: s.
		s nextPutAll: ' bytes (physical) '; cr.
		availTotal printWithCommasOn: s.
		s nextPutAll: ' bytes (total)     '].! !

!SmalltalkImage methodsFor: 'image, changes names' stamp: 'CamilloBruni 5/7/2012 01:51'!
shortImageName
	"Answer the current image name but only that name and not the full path as with imageName."
	"SmalltalkImage current shortImageName"

	^ self imageFile basename! !

!SmalltalkImage methodsFor: 'class and trait names' stamp: 'MarcusDenker 4/21/2011 21:34'!
classNamed: className 
	^globals classOrTraitNamed: className.! !

!SmalltalkImage methodsFor: 'startup list' stamp: 'MarcusDenker 4/16/2011 22:36'!
addToStartUpList: aClass before: predecessor

	self add: aClass toList: StartUpList before: predecessor! !

!SmalltalkImage methodsFor: 'accessing' stamp: ''!
environment
	"For conversion from Smalltalk to SystemDictionary"

	^globals! !

!SmalltalkImage methodsFor: 'endian' stamp: ''!
isBigEndian
	^self endianness == #big! !

!SmalltalkImage methodsFor: 'to clean later' stamp: ''!
at: aKey
	"Answer the global associated with the key."

	^globals at: aKey! !

!SmalltalkImage methodsFor: 'system attribute' stamp: 'IgorStasenko 8/17/2011 17:04'!
maxFilenameLength

	^self vm maxFilenameLength! !

!SmalltalkImage methodsFor: 'special objects' stamp: 'GuillermoPolito 4/4/2012 18:01'!
recreateSpecialObjectsArray
	"Smalltalk recreateSpecialObjectsArray"
	
	"To external package developers:
	**** DO NOT OVERRIDE THIS METHOD.  *****
	If you are writing a plugin and need additional special object(s) for your own use, 
	use addGCRoot() function and use own, separate special objects registry "
	
	"The Special Objects Array is an array of objects used by the Squeak virtual machine.
	 Its contents are critical and accesses to it by the VM are unchecked, so don't even
	 think of playing here unless you know what you are doing."
	
	"Replace the interpreter's reference in one atomic operation"
	self specialObjectsArray becomeForward: self newSpecialObjectsArray.
	! !

!SmalltalkImage methodsFor: 'startup list' stamp: 'MarcusDenker 4/16/2011 23:09'!
add: aClass toList: startUpOrShutDownList before: successor
	"Add the name of aClass to the startUp or shutDown list.
	Add it before the name of successor"

	(Smalltalk globals includes: aClass) 
		ifFalse: [self error: aClass name , ' cannot be found in Smalltalk dictionary.'].
		
	"Add before successor, moving it if already there."
	(Smalltalk globals includes: successor)  
		ifFalse: [self error: successor name , ' cannot be found in Smalltalk dictionary.'].
	(startUpOrShutDownList includes: successor name) 
		ifFalse: [self error: successor name , ' cannot be found in the list.'].
	startUpOrShutDownList remove: aClass name ifAbsent: [].
	startUpOrShutDownList add: aClass name before: successor name.! !

!SmalltalkImage methodsFor: 'housekeeping' stamp: ''!
cleanOutUndeclared 
	Undeclared removeUnreferencedKeys! !

!SmalltalkImage methodsFor: 'testing' stamp: 'CamilloBruni 2/13/2012 18:55'!
isInteractive
	"Check if vm were run with headless parameter.
	Different VMs for different platform have different multiple way(s) to indicate that"
	
	"non-headless mode is always interactive"
	self isHeadless ifFalse: [ ^ true ].
	
	-1000 to: 1000 do: [ :n | 
		(#('-interactive') includes: (self vm getSystemAttribute: n)) 
			ifTrue: [ ^ true ]].
	
	^ false! !

!SmalltalkImage methodsFor: 'memory space' stamp: ''!
garbageCollectMost
	"Primitive. Reclaims recently created garbage (which is usually most of it) fairly quickly and answers the number of bytes of available space."

	<primitive: 131>
	^ self primBytesLeft! !

!SmalltalkImage methodsFor: 'to clean later' stamp: ''!
keys
	"Obsoleted."

	self flag: #tobeprecated.
	"self deprecated: 'Use Smalltalk globals'."
	^globals keys! !

!SmalltalkImage methodsFor: 'snapshot and quit' stamp: 'ClementBera 7/26/2013 17:04'!
send: startUpOrShutDown toClassesNamedIn: startUpOrShutDownList with: argument
	"Send the message #startUp: or #shutDown: to each class named in the list.
	The argument indicates if the system is about to quit (for #shutDown:) or if
	the image is resuming (for #startUp:).
	If any name cannot be found, then remove it from the list."

	| removals errors |
	removals := OrderedCollection new.
	errors := OrderedCollection new.
	startUpOrShutDownList do: [ :name | 
			| class |
			class := self at: name ifAbsent: [ nil ].
			class 
				ifNil: [ removals add: name ]
				ifNotNil: [ 
					self 
						logStartUpErrorDuring: [ class perform: startUpOrShutDown with: argument ] 
						into: errors 
						tryDebugger: false]].
			
	"Remove any obsolete entries, but after the iteration"
	startUpOrShutDownList removeAll: removals.
	^ errors! !

!SmalltalkImage methodsFor: 'sources, change log' stamp: ''!
version
	"Answer the version of this release."

	^SystemVersion current version! !

!SmalltalkImage methodsFor: 'startup list' stamp: 'MarcusDenker 4/16/2011 23:08'!
addToStartUpList: aClass
	"This will add a ref to this class at the END of the startUp list."
	"No-op if already in the list."

	(StartUpList includes: aClass name) ifFalse: [StartUpList addLast: aClass name]! !

!SmalltalkImage methodsFor: 'memory space' stamp: ''!
isRoot: oop
	"Primitive. Answer whether the object is currently a root for youngSpace."
	<primitive: 'primitiveIsRoot'>
	^self primitiveFailed! !

!SmalltalkImage methodsFor: 'saving' stamp: 'SqR 11/7/2013 06:53'!
saveAs
	"Put up the 'saveAs' prompt, obtain a name, and save the image  under that new name."

	self saveAs: self getFileNameFromUser! !

!SmalltalkImage methodsFor: 'housekeeping' stamp: 'BernardoContreras 10/27/2011 19:18'!
informSpaceLeftAfterGarbageCollection
	"Do a garbage collection, and report results to the user."

	"SmalltalkImage current informSpaceLeftAfterGarbageCollection"

	self inform: self spaceLeftAfterGarbageCollection! !

!SmalltalkImage methodsFor: 'special objects' stamp: ''!
compactClassesArray
	"Smalltalk compactClassesArray"
	"Return the array of 31 classes whose instances may be
	represented compactly"
	^ self specialObjectsArray at: 29! !

!SmalltalkImage methodsFor: 'image' stamp: 'IgorStasenko 8/17/2011 15:04'!
wordSize
	"Answer the size in bytes of an object pointer or word in the object memory.
	The value does not change for a given image, but may be modified by a SystemTracer
	when converting the image to another format. The value is cached in WordSize to
	avoid the performance overhead of repeatedly consulting the VM."

	"this method is deprecated" 
	^ self vm wordSize! !

!SmalltalkImage methodsFor: 'sources, change log' stamp: ''!
datedVersion
	"Answer the version of this release."

	^SystemVersion current datedVersion! !

!SmalltalkImage methodsFor: 'to clean later' stamp: ''!
select: aBlock
	"Obsoleted."
	self flag: #tobeprecated.
	"self deprecated: 'Use Smalltalk globals'."
	^globals select: aBlock
! !

!SmalltalkImage methodsFor: 'cleanup' stamp: 'MarcusDenker 10/5/2013 17:42'!
cleanUp: aggressive except: exclusions confirming: aBool
	"Clean up. When aggressive is true, this will destroy resources, change sets, etc.
	Leave out any classes specifically listed in exclusions."

	"Smalltalk cleanUp: true except: {Point . ChangeSet} 
		- will ask for confirmation"
	"SmalltalkImage current cleanUp: true except: {} confirming: false 
		- will not ask for confirmation"

	| classes |
	aBool ifTrue:[
		"Give the user a chance to bail"
		(self confirm: 'Cleanup will destroy change sets and more.
Are you sure you want to proceed?') ifFalse: [^self]].

	"Find all classes implementing #cleanUp or cleanUp:"
	classes := Smalltalk allClasses select: [:aClass| 
		(aClass class includesSelector: #cleanUp) 
			or: [aClass class includesSelector: #cleanUp:]].

	"Leave out the classes in the exclusion set"
	classes := classes reject: [:aClass| exclusions includes: aClass].

	"Arrange classes in superclass order, superclasses before subclasses.
	This will ensure that specific cleanup (like MethodDictionary compaction)
	will run after generic superclass cleanup (HashedCollection rehashing).
	Otherwise generic superclass cleanup might undo specific one (in this
	case rehashing will undo a good bit of MD compaction)."
	classes := Class superclassOrder: classes.

	"Run the cleanup code"
	classes 
		do:[:aClass| aClass cleanUp: aggressive]
		displayingProgress: [:aClass| 'Cleaning up in ', aClass name].! !

!SmalltalkImage methodsFor: 'memory space' stamp: ''!
rootTableAt: index
	"Primitive. Answer the nth element of the VMs root table"
	<primitive: 'primitiveRootTableAt'>
	^nil! !

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

!SmalltalkImage methodsFor: 'startup list' stamp: 'MarcusDenker 4/16/2011 23:09'!
add: aClass toList: startUpOrShutDownList after: predecessor
	"Add the name of aClass to the startUp or shutDown list.
	Add it after the name of predecessor"

	(Smalltalk globals includes: aClass) 
		ifFalse: [self error: aClass name , ' cannot be found in Smalltalk dictionary.'].

	"Add after predecessor, moving it if already there."
	(Smalltalk globals includes: predecessor)  
		ifFalse: [self error: predecessor name , ' cannot be found in Smalltalk dictionary.'].
	(startUpOrShutDownList includes: predecessor name) 
		ifFalse: [self error: predecessor name , ' cannot be found in the list.'].
	startUpOrShutDownList remove: aClass name ifAbsent:[].
	startUpOrShutDownList add: aClass name after: predecessor name! !

!SmalltalkImage methodsFor: 'to clean later' stamp: ''!
keysAndValuesDo: aBlock
	"Obsoleted."
	self flag: #tobeprecated.
	"self deprecated: 'Use Smalltalk globals'."
	^globals keysAndValuesDo: aBlock
! !

!SmalltalkImage methodsFor: 'printing' stamp: ''!
isSelfEvaluating
	self == Smalltalk ifTrue: [^true].
	^super isSelfEvaluating! !

!SmalltalkImage methodsFor: 'memory space' stamp: 'StephaneDucasse 1/30/2012 12:14'!
lowSpaceThreshold 
	"Return the low space threshold. When the amount of free memory (after garbage collection) falls below this limit, the system is in serious danger of completely exhausting memory and crashing. This limit should be made high enough to allow the user open a debugger to diagnose a problem or to save the image."

	^ 400000  "Enough for JIT compiler"! !

!SmalltalkImage class methodsFor: 'initialization' stamp: 'EstebanLorenzano 11/23/2014 14:27'!
initializeStartUpList
	"SmalltalkImage initializeStartUpList"

	| oldList |
	oldList := StartUpList.
	StartUpList := OrderedCollection new.	"These get processed from the top down..."
	#(
		SmallInteger 
		Delay 
		DisplayScreen
		Cursor
		InputEventFetcher
		ProcessorScheduler
		LanguageEnvironment
		NaturalLanguageTranslator
		ShortIntegerArray
		ShortRunArray)
		do: [ :className | className asClassIfPresent: [ :theClass | Smalltalk addToStartUpList: theClass ] ].
	
	oldList ifNotNil: [ 
		oldList
			do: [ :className | className asClassIfPresent: [ :theClass | Smalltalk addToStartUpList: theClass ] ] ].
		
	#WorldMorph asClassIfPresent: [ :theClass | Smalltalk addToStartUpList: theClass ]! !

!SmalltalkImage class methodsFor: 'settings' stamp: 'SvenVanCaekenberghe 2/11/2013 14:30'!
shouldDownloadSourcesFile: boolean
	"Set whether, when no sources file can be found, the file will be downloaded.
	The default is false."

	ShouldDownloadSourcesFile := boolean! !

!SmalltalkImage class methodsFor: 'settings' stamp: 'SvenVanCaekenberghe 2/11/2013 14:30'!
shouldDownloadSourcesFile
	"If true, when no sources file can be found, the file will be downloaded.
	The default is false."
	
	^ ShouldDownloadSourcesFile ifNil: [ ShouldDownloadSourcesFile := false ]! !

!SmalltalkImage class methodsFor: 'cleanup' stamp: 'AlainPlantec 12/1/2010 09:53'!
cleanUp
	"Flush caches"
	
	"should probably distribute cleaning to systemDictionary"
	
	Smalltalk globals flushClassNameCache.
	Undeclared removeUnreferencedKeys! !

!SmalltalkImage class methodsFor: 'initialize-release' stamp: 'IgorStasenko 8/17/2011 15:04'!
wordSize
	^ Smalltalk vm wordSize! !

!SmalltalkImage class methodsFor: 'initialization' stamp: ''!
initialize
	"SmalltalkImage initialize"

	self initializeStartUpList.
	self initializeShutDownList.
	Smalltalk addToStartUpList: SmalltalkImage! !

!SmalltalkImage class methodsFor: 'instance creation' stamp: ''!
new

	self error: 'Use current'.! !

!SmalltalkImage class methodsFor: 'settings' stamp: 'MarcusDenker 2/7/2013 13:33'!
compilerClass: aClass
	CompilerClass := aClass! !

!SmalltalkImage class methodsFor: 'settings' stamp: 'MarcusDenker 2/7/2013 13:33'!
compilerClass
	^CompilerClass! !

!SmalltalkImage class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 4/6/2015 12:40'!
gtExampleCurrent
	<gtExample>
	^ self current! !

!SmalltalkImage class methodsFor: 'instance creation' stamp: ''!
current
	^Smalltalk! !

!SmalltalkImage class methodsFor: 'initialization' stamp: 'HenrikSperreJohansen 9/25/2012 14:36'!
startUp: resuming
	ChangesLog default.
	resuming ifTrue: [Smalltalk openSourceFiles]! !

!SmalltalkImage class methodsFor: 'initialization' stamp: 'MarcusDenker 7/5/2014 11:22'!
initializeShutDownList
	"SmalltalkImage initializeShutDownList"

	| oldList |
	oldList := ShutDownList.
	ShutDownList := OrderedCollection new.	"These get processed from the bottom up..."
	#(#Delay #DisplayScreen #InputEventFetcher #Form #WorldMorph #StrikeFont #Color #SoundPlayer)
		do: [ :clsName | Smalltalk globals at: clsName ifPresent: [ :cls | Smalltalk addToShutDownList: cls ] ].
	oldList
		ifNotNil: [ 
			oldList
				reverseDo: [ :className | Smalltalk globals at: className ifPresent: [ :theClass | Smalltalk addToShutDownList: theClass ] ] ]! !

!SmalltalkImageTest methodsFor: 'tests-arguments' stamp: 'DamienCassou 2/10/2015 14:09'!
testExtractTwoArgsWithAndWithoutMinus
	| args extract keys |
	args := #('ArgWithoutMinus' '-ArgWithMinus').
	extract := SmalltalkImage current extractMinusParametersFrom: args.
	keys := extract keys sort.
	self assert: extract isDictionary.
	self assert: extract size equals: 2.
	self assert: (keys at: 1) equals: #*.
	self assert: (keys at: 2) equals: #ArgWithMinus.
	self assert: (extract at: #*) equals: (Array with: 'ArgWithoutMinus').
	self assert: (extract at: #ArgWithMinus) isEmpty! !

!SmalltalkImageTest methodsFor: 'testing' stamp: 'DamienCassou 1/23/2014 10:01'!
testOpenLog
	"It must be possible to write to the log even when the log file can''t be created."

	"Standard case where a file can be created with this name."
	self writeToLogWithFileNamed: 'file.log'.

	"Other cases where a file with the given name can not be created."
	self writeToLogWithFileNamed: ''.
	self writeToLogWithFileNamed: '.'.
! !

!SmalltalkImageTest methodsFor: 'tests-arguments' stamp: 'DamienCassou 2/10/2015 14:08'!
testExtractOneArgNoMinus
	| args extract |
	args := #('ArgNoMinus').
	extract := SmalltalkImage current extractMinusParametersFrom: args.
	self assert: extract isDictionary.
	self assert: extract size equals: 1.
	self assert: (extract keys at: 1) equals: #*.
	self assert: (extract at: #*) equals: args! !

!SmalltalkImageTest methodsFor: 'tests-arguments' stamp: 'DamienCassou 2/10/2015 14:08'!
testExtractOneArgWithMinusThenArgsWithout
	| args extract |
	args := #('-ArgWithMinus' 'ArgWithoutMinus1' 'ArgWithoutMinus2').
	extract := SmalltalkImage current extractMinusParametersFrom: args.
	self assert: extract isDictionary.
	self assert: extract size equals: 1.
	self assert: (extract keys at: 1) equals: #ArgWithMinus.
	self assert: (extract at: #ArgWithMinus) equals: #('ArgWithoutMinus1' 'ArgWithoutMinus2')! !

!SmalltalkImageTest methodsFor: 'tests-arguments' stamp: 'DamienCassou 2/10/2015 14:08'!
testExtractOneArgWithMinus
	| args extract |
	args := #('-ArgWithMinus').
	extract := SmalltalkImage current extractMinusParametersFrom: args.
	self assert: extract isDictionary.
	self assert: extract size equals: 1.
	self assert: (extract keys at: 1) equals: #ArgWithMinus.
	self assert: (extract at: #ArgWithMinus) isEmpty! !

!SmalltalkImageTest methodsFor: 'tests-arguments' stamp: 'DamienCassou 2/10/2015 14:06'!
testExtractAllKinds
	| args extract keys |
	args := #('ArgWithoutMinus1' '-ArgWithMinus1' 'ArgWithoutMinus2' 'ArgWithoutMinus3' '-ArgWithMinus2').
	extract := SmalltalkImage current extractMinusParametersFrom: args.
	keys := extract keys sort.
	self assert: extract isDictionary.
	self assert: extract size = 3.
	self assert: (keys at: 1) = #*.
	self assert: (keys at: 2) = #ArgWithMinus1.
	self assert: (keys at: 3) = #ArgWithMinus2.
	self assert: (extract at: #*) = (Array with: 'ArgWithoutMinus1').
	self assert: (extract at: #ArgWithMinus1) = #('ArgWithoutMinus2' 'ArgWithoutMinus3').
	self assert: (extract at: #ArgWithMinus2) isEmpty! !

!SmalltalkImageTest methodsFor: 'tests-arguments' stamp: 'DamienCassou 2/10/2015 14:07'!
testExtractNil
	| args extract |
	args := nil.
	extract := SmalltalkImage current extractMinusParametersFrom: args.
	self assert: extract class equals: Dictionary.
	self assert: extract isEmpty! !

!SmalltalkImageTest methodsFor: 'helpers' stamp: 'MarcusDenker 7/20/2014 12:57'!
writeToLogWithFileNamed: filename
	| oldLogFileName |
	oldLogFileName := Smalltalk logFileName.
	Smalltalk logFileName: filename.
	[ 
	| stream |
	stream := Smalltalk image openLog.
	stream nextPutAll: 'foobar'	"We just make sure we can write something. I don't know any reliable way to check if it has really been written" ]
		ensure: [ Smalltalk logFileName: oldLogFileName ]! !

!SmalltalkImageTest methodsFor: 'tests-arguments' stamp: 'DamienCassou 2/10/2015 14:07'!
testExtractEmpty
	| args extract |
	args := #().
	extract := SmalltalkImage current extractMinusParametersFrom: args.
	self assert: extract class equals: Dictionary.
	self assert: extract isEmpty! !

!SnapshotDone commentStamp: '<historical>'!
I am announced when the image has been saved. 

Note that the announcement is done *after* the execution was frozen. So you can send me #isNewImage to know if the current image instance is the same that started the save action.!
!SnapshotDone methodsFor: 'accessing' stamp: 'PabloEstefo 1/29/2013 16:59'!
isNewImage
	^ isNewImage! !

!SnapshotDone methodsFor: 'accessing' stamp: 'PabloEstefo 1/29/2013 16:59'!
isNewImage: anObject
	isNewImage := anObject! !

!SnapshotDone class methodsFor: 'instance creation' stamp: 'PabloEstefo 1/29/2013 17:04'!
isNewImage: aBoolean
	 ^ self new isNewImage: aBoolean.! !

!Socket commentStamp: 'VeronicaUquillas 6/11/2010 13:03'!
A Socket represents a network connection point. Current sockets are designed to support the TCP/IP and UDP protocols. Sockets are the lowest level of networking object in Pharo and are not normally used directly. SocketStream is a higher level object wrapping a Socket in a stream like protocol.

ProtocolClient and subclasses are in turn wrappers around a SocketStream to provide support for specific network protocols such as POP, NNTP, HTTP, and FTP.!
!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocketCreateNetwork: netType type: socketType receiveBufferSize: rcvBufSize sendBufSize: sendBufSize semaIndex: semaIndex
	"Return a new socket handle for a socket of the given type and buffer sizes. Return nil if socket creation fails.
	The netType parameter is platform dependent and can be used to encode both the protocol type (IP, Xerox XNS, etc.) and/or the physical network interface to use if this host is connected to multiple networks. A zero netType means to use IP protocols and the primary (or only) network interface.
	The socketType parameter specifies:
		0	reliable stream socket (TCP if the protocol is IP)
		1	unreliable datagram socket (UDP if the protocol is IP)
	The buffer size parameters allow performance to be tuned to the application. For example, a larger receive buffer should be used when the application expects to be receiving large amounts of data, especially from a host that is far away. These values are considered requests only; the underlying implementation will ensure that the buffer sizes actually used are within allowable bounds. Note that memory may be limited, so an application that keeps many sockets open should use smaller buffer sizes. Note the macintosh implementation ignores this buffer size. Also see setOption to get/set socket buffer sizes which allows you to set/get the current buffer sizes for reading and writing.
 	If semaIndex is > 0, it is taken to be the index of a Semaphore in the external objects array to be associated with this socket. This semaphore will be signalled when the socket status changes, such as when data arrives or a send completes. All processes waiting on the semaphore will be awoken for each such event; each process must then query the socket state to figure out if the conditions they are waiting for have been met. For example, a process waiting to send some data can see if the last send has completed."

	<primitive: 'primitiveSocketCreate' module: 'SocketPlugin'>
	^ nil  "socket creation failed"
! !

!Socket methodsFor: 'receiving' stamp: 'StephaneDucasse 5/28/2011 13:36'!
receiveDataSignallingClosedInto: aStringOrByteArray startingAt: aNumber
	"Receive data into the given buffer and return the number of bytes received. 
	Note the given buffer may be only partially filled by the received data.
	Waits for data until something is read or the socket is closed, upon which
	we signal."

	| bytesRead |
	bytesRead := 0.
	[bytesRead = 0]
		whileTrue: [
			self waitForData.
			bytesRead := self primSocket: socketHandle
				receiveDataInto: aStringOrByteArray
				startingAt: aNumber
				count: aStringOrByteArray size-aNumber+1].
	^bytesRead
! !

!Socket methodsFor: 'connection open/close' stamp: 'AdrianLienhard 3/13/2010 13:07'!
connectTo: hostAddress port: port waitForConnectionFor: timeout 
	"Initiate a connection to the given port at the given host 
	address. Waits until the connection is established or time outs."
	self connectNonBlockingTo: hostAddress port: port.
	self
		waitForConnectionFor: timeout
		ifTimedOut: [ConnectionTimedOut signal: 'Cannot connect to '
					, (NetNameResolver stringFromAddress: hostAddress) , ':' , port asString]! !

!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocket: socketID sendData: aStringOrByteArray startIndex: startIndex count: count
	"Send data to the remote host through the given socket starting with the given byte index of the given byte array. The data sent is 'pushed' immediately. Return the number of bytes of data actually sent; any remaining data should be re-submitted for sending after the current send operation has completed."
	"Note: In general, it many take several sendData calls to transmit a large data array since the data is sent in send-buffer-sized chunks. The size of the send buffer is determined when the socket is created."

	<primitive: 'primitiveSocketSendDataBufCount' module: 'SocketPlugin'>
	self primitiveFailed
! !

!Socket methodsFor: 'receiving' stamp: 'svp 9/22/2003 23:58'!
receiveDataTimeout: timeout into: aStringOrByteArray startingAt: aNumber
	"Receive data into the given buffer and return the number of bytes received. 
	Note the given buffer may be only partially filled by the received data.
	Wait for data once for the specified nr of seconds.  The answer may be 
	zero (indicating that there was no data available within the given timeout)."

	self waitForDataFor: timeout ifClosed: [] ifTimedOut: [].
	^self primSocket: socketHandle
		receiveDataInto: aStringOrByteArray
		startingAt: aNumber
		count: aStringOrByteArray size-aNumber+1
! !

!Socket methodsFor: 'waiting' stamp: 'nice 4/28/2009 21:26'!
waitForConnectionFor: timeout ifTimedOut: timeoutBlock
	"Wait up until the given deadline for a connection to be established. Return true if it is established by the deadline, false if not."

	| startTime msecsDelta msecsEllapsed status |
	startTime := Time millisecondClockValue.
	msecsDelta := (timeout * 1000) truncated.
	status := self primSocketConnectionStatus: socketHandle.
	[(status = WaitingForConnection) and: [(msecsEllapsed := Time millisecondsSince: startTime) < msecsDelta]]
		whileTrue: [
			semaphore waitTimeoutMSecs: msecsDelta - msecsEllapsed.
			status := self primSocketConnectionStatus: socketHandle].

	status = Connected ifFalse: [^timeoutBlock value].
	^ true! !

!Socket methodsFor: 'connection open/close' stamp: 'ikp 9/1/2003 20:32'!
listenOn: portNumber backlogSize: backlog interface: ifAddr
	"Listen for a connection on the given port.
	If this method succeeds, #accept may be used to establish a new connection"
	| status |
	status := self primSocketConnectionStatus: socketHandle.
	(status == Unconnected)
		ifFalse: [InvalidSocketStatusException signal: 'Socket status must Unconnected before listening for a new connection'].
	self primSocket: socketHandle listenOn: portNumber backlogSize: backlog interface: ifAddr.
! !

!Socket methodsFor: 'sending' stamp: 'mir 2/19/2002 18:33'!
sendStreamContents: stream
	"Send the data in the stream. Close the stream.
	Usefull for directly sending contents of a file without reading into memory first."

	self sendStreamContents: stream checkBlock: [true]! !

!Socket methodsFor: 'accessing' stamp: 'ar 7/16/1999 17:22'!
socketHandle
	^socketHandle! !

!Socket methodsFor: 'receiving' stamp: 'mir 5/15/2003 13:46'!
receiveSomeDataInto: aStringOrByteArray
	"Receive data into the given buffer and return the number of bytes received. Note the given buffer may be only partially filled by the received data."

	^self receiveSomeDataInto: aStringOrByteArray startingAt: 1! !

!Socket methodsFor: 'connection open/close' stamp: 'jm 11/4/97 07:15'!
closeAndDestroy
	"First, try to close this connection gracefully. If the close attempt fails or times out, abort the connection. In either case, destroy the socket. Do nothing if the socket has already been destroyed (i.e., if its socketHandle is nil)."

	self closeAndDestroy: 20.

! !

!Socket methodsFor: 'initialize-destroy' stamp: 'mir 2/22/2002 15:48'!
initializeNetwork
	self class initializeNetwork! !

!Socket methodsFor: 'sending' stamp: 'ls 1/5/1999 15:05'!
sendSomeData: aStringOrByteArray
	"Send as much of the given data as possible and answer the number of bytes actually sent."
	"Note: This operation may have to be repeated multiple times to send a large amount of data."

	^ self
		sendSomeData: aStringOrByteArray
		startIndex: 1
		count: aStringOrByteArray size! !

!Socket methodsFor: 'waiting' stamp: 'nice 4/28/2009 21:20'!
waitForDisconnectionFor: timeout
	"Wait for the given nr of seconds for the connection to be broken.
	Return true if it is broken by the deadline, false if not.
	The client should know the connection is really going to be closed
	(e.g., because he has called 'close' to send a close request to the other end)
	before calling this method."

	| startTime msecsDelta status |
	startTime := Time millisecondClockValue.
	msecsDelta := (timeout * 1000) truncated.
	status := self primSocketConnectionStatus: socketHandle.
	[((status == Connected) or: [(status == ThisEndClosed)]) and:
	 [(Time millisecondsSince: startTime) < msecsDelta]] whileTrue: [
		self discardReceivedData.
		self readSemaphore waitTimeoutMSecs: 
			(msecsDelta - (Time millisecondsSince: startTime) max: 0).
		status := self primSocketConnectionStatus: socketHandle].
	^ status ~= Connected! !

!Socket methodsFor: 'primitives' stamp: 'JMM 5/24/2000 17:19'!
primSocket: socketID receiveUDPDataInto: aStringOrByteArray startingAt: startIndex count: count
	"Receive data from the given socket into the given array starting at the given index. 
	Return an Array containing the amount read, the host address byte array, the host port, and the more flag"

	<primitive: 'primitiveSocketReceiveUDPDataBufCount' module: 'SocketPlugin'>
	self primitiveFailed
! !

!Socket methodsFor: 'primitives' stamp: 'ar 7/18/2000 11:42'!
primSocket: socketID setOption: aString value: aStringValue
	"Set some option information on this socket. Refer to the UNIX 
	man pages for valid SO, TCP, IP, UDP options. In case of doubt
	refer to the source code.
	TCP:=NODELAY, SO:=KEEPALIVE are valid options for example
	returns an array containing the error code and the negotiated value"

	<primitive: 'primitiveSocketSetOptions' module: 'SocketPlugin'>
	^nil! !

!Socket methodsFor: 'primitives-ipv6' stamp: 'ikp 6/9/2007 09:39'!
primSocket: socketID listenWithBacklog: backlogSize

	<primitive: 'primitiveSocketListenWithBacklog' module: 'SocketPlugin'>
	self primitiveFailed
! !

!Socket methodsFor: 'primitives-ipv6' stamp: 'ikp 6/9/2007 10:24'!
primSocketLocalAddressSize: handle

	<primitive: 'primitiveSocketLocalAddressSize' module: 'SocketPlugin'>
	self primitiveFailed
! !

!Socket methodsFor: 'datagrams' stamp: 'SvenVanCaekenberghe 4/24/2011 20:13'!
sendData: aStringOrByteArray toHost: hostAddress port: portNumber
	"Send a UDP packet containing the given data to the specified host/port."

	^ self sendUDPData: aStringOrByteArray toHost: hostAddress port: portNumber! !

!Socket methodsFor: 'connection open/close' stamp: 'mir 5/8/2003 16:03'!
connectToHostNamed: hostName port: portNumber
	| serverIP |
	serverIP := NetNameResolver addressForName: hostName timeout: 20.
	^self connectTo: serverIP port: portNumber
! !

!Socket methodsFor: 'primitives' stamp: 'SvenVanCaekenberghe 4/24/2011 20:08'!
primSocketReceiveDataAvailable: socketID
	"Return true if data may be available for reading from the current socket."

	<primitive: 'primitiveSocketReceiveDataAvailable' module: 'SocketPlugin'>
	self primitiveFailed! !

!Socket methodsFor: 'queries' stamp: 'jm 2/25/1999 13:52'!
dataAvailable
	"Return true if this socket has unread received data."

	socketHandle == nil ifTrue: [^ false].
	^ self primSocketReceiveDataAvailable: socketHandle
! !

!Socket methodsFor: 'finalization' stamp: 'JMM 5/22/2000 22:52'!
finalize
	self primSocketDestroyGently: socketHandle.
	Smalltalk unregisterExternalObject: semaphore.
	Smalltalk unregisterExternalObject: readSemaphore.
	Smalltalk unregisterExternalObject: writeSemaphore.
! !

!Socket methodsFor: 'queries' stamp: 'JMM 5/5/2000 12:17'!
isThisEndClosed
	"Return true if this socket had the this end closed."

	socketHandle == nil ifTrue: [^ false].
	^ (self primSocketConnectionStatus: socketHandle) == ThisEndClosed
! !

!Socket methodsFor: 'initialize-destroy' stamp: 'ClementBera 7/26/2013 17:05'!
acceptFrom: aSocket
	"Initialize a new socket handle from an accept call"

	| semaIndex readSemaIndex writeSemaIndex |
	semaphore := Semaphore new.
	readSemaphore := Semaphore new.
	writeSemaphore := Semaphore new.
	semaIndex := Smalltalk registerExternalObject: semaphore.
	readSemaIndex := Smalltalk registerExternalObject: readSemaphore.
	writeSemaIndex := Smalltalk registerExternalObject: writeSemaphore.
	socketHandle := self
		primAcceptFrom: aSocket socketHandle
		receiveBufferSize: 8000
		sendBufSize: 8000
		semaIndex: semaIndex
		readSemaIndex: readSemaIndex
		writeSemaIndex: writeSemaIndex.
	socketHandle 
		ifNil: [ 
			"socket creation failed"
			Smalltalk unregisterExternalObject: semaphore.
			Smalltalk unregisterExternalObject: readSemaphore.
			Smalltalk unregisterExternalObject: writeSemaphore.
			readSemaphore := writeSemaphore := semaphore := nil ]
		ifNotNil: [ self register ]! !

!Socket methodsFor: 'connection open/close' stamp: 'jm 3/10/98 11:56'!
disconnect
	"Break this connection, no matter what state it is in. Data that has been sent but not received will be lost."

	self primSocketAbortConnection: socketHandle.
! !

!Socket methodsFor: 'receiving' stamp: 'mir 5/15/2003 13:46'!
receiveSomeDataInto: aStringOrByteArray startingAt: aNumber
	"Receive data into the given buffer and return the number of bytes received. Note the given buffer may be only partially filled by the received data."

	^ self primSocket: socketHandle
		receiveDataInto: aStringOrByteArray
		startingAt: aNumber
		count: aStringOrByteArray size-aNumber+1
! !

!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocket: socketID listenOn: port
	"Listen for a connection on the given port. This is an asynchronous call; query the socket status to discover if and when the connection is actually completed."

	<primitive: 'primitiveSocketListenWithOrWithoutBacklog' module: 'SocketPlugin'>
	self primitiveFailed
! !

!Socket methodsFor: 'sending' stamp: 'mir 5/15/2003 18:33'!
sendData: aStringOrByteArray
	"Send all of the data in the given array, even if it requires multiple calls to send it all. Return the number of bytes sent."

	"An experimental version use on slow lines: Longer timeout and smaller writes to try to avoid spurious timeouts."

	| bytesSent bytesToSend count |
	bytesToSend := aStringOrByteArray size.
	bytesSent := 0.
	[bytesSent < bytesToSend] whileTrue: [
		(self waitForSendDoneFor: 60)
			ifFalse: [ConnectionTimedOut signal: 'send data timeout; data not sent'].
		count := self primSocket: socketHandle
			sendData: aStringOrByteArray
			startIndex: bytesSent + 1
			count: (bytesToSend - bytesSent min: 5000).
		bytesSent := bytesSent + count].

	^ bytesSent
! !

!Socket methodsFor: 'receiving' stamp: 'mir 5/15/2003 16:18'!
receiveDataWithTimeout
	"Receive data into the given buffer and return the number of bytes received. 
	Note the given buffer may be only partially filled by the received data.
	Waits for data once.
	Either returns data or signals a time out or connection close."

	| buffer bytesRead |
	buffer := String new: 2000.
	bytesRead := self receiveDataWithTimeoutInto: buffer.
	^buffer copyFrom: 1 to: bytesRead! !

!Socket methodsFor: 'accessing' stamp: 'mu 9/30/2007 04:38'!
remoteAddress

	^ self primSocketRemoteAddress: socketHandle! !

!Socket methodsFor: 'connection open/close' stamp: 'marcus.denker 9/14/2008 21:20'!
closeAndDestroy: timeoutSeconds
	"First, try to close this connection gracefully. If the close attempt fails or times out, abort the connection. In either case, destroy the socket. Do nothing if the socket has already been destroyed (i.e., if its socketHandle is nil)."

	socketHandle ifNotNil: [
			self isConnected ifTrue: [
				self close.  "close this end"
				(self waitForDisconnectionFor: timeoutSeconds) ifFalse: [
						"The other end didn't close so we just abort the connection"
						self primSocketAbortConnection: socketHandle]].
			self destroy].
! !

!Socket methodsFor: 'primitives-ipv6' stamp: 'ikp 6/9/2007 10:23'!
primSocket: socketID remoteAddressResult: socketAddress

	<primitive: 'primitiveSocketRemoteAddressResult' module: 'SocketPlugin'>
	self primitiveFailed
! !

!Socket methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/24/2011 20:10'!
readSemaphore
	^ readSemaphore! !

!Socket methodsFor: 'primitives-ipv6' stamp: 'ikp 6/9/2007 09:36'!
primSocket: socketID bindTo: socketAddress

	<primitive: 'primitiveSocketBindTo' module: 'SocketPlugin'>
	self primitiveFailed
! !

!Socket methodsFor: 'connection open/close' stamp: 'jm 9/11/97 20:29'!
close
	"Close this connection gracefully. For TCP, this sends a close request, but the stream remains open until the other side also closes it."

	self primSocketCloseConnection: socketHandle.  "close this end"
! !

!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocketSendDone: socketID
	"Return true if there is no send in progress on the current socket."

	<primitive: 'primitiveSocketSendDone' module: 'SocketPlugin'>
	self primitiveFailed
! !

!Socket methodsFor: 'registry' stamp: 'ar 3/21/98 17:40'!
register
	^self class register: self! !

!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocketRemoteAddress: socketID
	"Return the remote host address for this socket, or zero if no connection has been made."

	<primitive: 'primitiveSocketRemoteAddress' module: 'SocketPlugin'>
	self primitiveFailed
! !

!Socket methodsFor: 'accessing' stamp: 'ar 4/30/1999 04:25'!
address
	"Shortcut"
	^self localAddress! !

!Socket methodsFor: 'datagrams' stamp: 'mir 5/15/2003 18:34'!
sendUDPData: aStringOrByteArray toHost: hostAddress port: portNumber
	"Send a UDP packet containing the given data to the specified host/port."
	| bytesToSend bytesSent count |

	bytesToSend := aStringOrByteArray size.
	bytesSent := 0.
	[bytesSent < bytesToSend] whileTrue: [
		(self waitForSendDoneFor: 20)
			ifFalse: [ConnectionTimedOut signal: 'send data timeout; data not sent'].
		count := self primSocket: socketHandle
			sendUDPData: aStringOrByteArray
			toHost: hostAddress
			port: portNumber
			startIndex: bytesSent + 1
			count: bytesToSend - bytesSent.
		bytesSent := bytesSent + count].

	^ bytesSent
! !

!Socket methodsFor: 'receiving' stamp: 'svp 9/23/2003 00:01'!
receiveDataTimeout: timeout into: aStringOrByteArray 
	"Receive data into the given buffer and return the number of bytes received. 
	Note the given buffer may be only partially filled by the received data.
	Waits for data once."

	^self receiveDataTimeout: timeout into: aStringOrByteArray startingAt: 1! !

!Socket methodsFor: 'receiving' stamp: 'mir 5/15/2003 16:18'!
receiveDataWithTimeoutInto: aStringOrByteArray
	"Receive data into the given buffer and return the number of bytes received. 
	Note the given buffer may be only partially filled by the received data.
	Waits for data once.
	Either returns data or signals a time out or connection close."

	^self receiveDataWithTimeoutInto: aStringOrByteArray startingAt: 1! !

!Socket methodsFor: 'printing' stamp: 'jm 11/23/1998 11:57'!
printOn: aStream

	super printOn: aStream.
	aStream nextPutAll: '[', self statusString, ']'.
! !

!Socket methodsFor: 'datagrams' stamp: 'JMM 6/3/2000 21:54'!
receiveUDPDataInto: aStringOrByteArray
	"Receive UDP data into the given buffer and return the number of bytes received. Note the given buffer may be only partially filled by the received data. What is returned is an array, the first element is the bytes read, the second the sending bytearray address, the third the senders port, the fourth, true if more of the datagram awaits reading"

	^ self primSocket: socketHandle
		receiveUDPDataInto: aStringOrByteArray
		startingAt: 1
		count: aStringOrByteArray size
! !

!Socket methodsFor: 'primitives' stamp: 'SvenVanCaekenberghe 4/24/2011 20:19'!
primAcceptFrom: aHandle receiveBufferSize: rcvBufSize sendBufSize: sndBufSize semaIndex: semaIndex
	"Create and return a new socket handle based on accepting the connection from the given listening socket"

	<primitive: 'primitiveSocketAccept' module: 'SocketPlugin'>

	^ self primitiveFailed! !

!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocketLocalPort: socketID
	"Return the local port for this socket, or zero if no port has yet been assigned."

	<primitive: 'primitiveSocketLocalPort' module: 'SocketPlugin'>
	self primitiveFailed
! !

!Socket methodsFor: 'connection open/close' stamp: 'AdrianLienhard 3/13/2010 12:52'!
connectTo: hostAddress port: port
	"Initiate a connection to the given port at the given host address.
	Waits until the connection is established or time outs."

	self connectTo: hostAddress port: port waitForConnectionFor: Socket standardTimeout! !

!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocketError: socketID
	"Return an integer encoding the most recent error on this socket. Zero means no error."

	<primitive: 'primitiveSocketError' module: 'SocketPlugin'>
	self primitiveFailed
! !

!Socket methodsFor: 'queries' stamp: 'jm 2/25/1999 13:52'!
isConnected
	"Return true if this socket is connected."

	socketHandle == nil ifTrue: [^ false].
	^ (self primSocketConnectionStatus: socketHandle) == Connected
! !

!Socket methodsFor: 'queries' stamp: 'JMM 5/8/2000 23:24'!
socketError
	^self primSocketError: socketHandle! !

!Socket methodsFor: 'receiving' stamp: 'yo 10/10/2005 18:47'!
receiveAvailableDataIntoBuffer: buffer
	"Receive all available data (if any). Do not wait."
 
	| bytesRead |
	bytesRead := self receiveAvailableDataInto: buffer.
	^buffer copyFrom: 1 to: bytesRead! !

!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocketAbortConnection: socketID
	"Terminate the connection on the given port immediately without going through the normal close sequence. This is an asynchronous call; query the socket status to discover if and when the connection is actually terminated."

	<primitive: 'primitiveSocketAbortConnection' module: 'SocketPlugin'>
	self primitiveFailed
! !

!Socket methodsFor: 'primitives' stamp: 'VeronicaUquillas 6/11/2010 13:08'!
primSocketConnectionStatus: socketID
	"Return an integer reflecting the connection status of this socket. For a list of possible values, see the comment in the 'initialize' method of this class. If the primitive fails, return a status indicating that the socket handle is no longer valid, perhaps because the Pharo image was saved and restored since the socket was created. (Sockets do not survive snapshots.)"

	<primitive: 'primitiveSocketConnectionStatus' module: 'SocketPlugin'>
	^ InvalidSocket
! !

!Socket methodsFor: 'primitives-ipv6' stamp: 'ikp 6/9/2007 10:23'!
primSocket: socketID localAddressResult: socketAddress

	<primitive: 'primitiveSocketLocalAddressResult' module: 'SocketPlugin'>
	self primitiveFailed
! !

!Socket methodsFor: 'waiting' stamp: 'dc 10/21/2008 08:19'!
waitForAcceptFor: timeout
	"Wait and accept an incoming connection. Return nil if it falis"
	self waitForConnectionFor: timeout ifTimedOut: [^ nil].
	^ self isConnected
		ifTrue:[self accept]
		! !

!Socket methodsFor: 'waiting' stamp: 'svp 9/23/2003 00:09'!
waitForData
	"Wait for data to arrive.  This method will block until
	data is available or the socket is closed.  If the socket is closed
	a ConnectionClosed exception will be signaled."

	^self waitForDataIfClosed:
		[ConnectionClosed signal: 'Connection close while waiting for data.']! !

!Socket methodsFor: 'accessing' stamp: 'AdrianLienhard 3/13/2010 15:03'!
peerName
	"Return the name of the host I'm connected to, or nil if its name isn't known to the domain name server or the request times out."
	"Note: Slow. Calls the domain name server, taking up to 20 seconds to time out. Even when sucessful, delays of up to 13 seconds have been observed during periods of high network load." 

	^ NetNameResolver
		nameForAddress: self remoteAddress
		timeout: 20
! !

!Socket methodsFor: 'queries' stamp: 'jm 2/25/1999 13:54'!
isUnconnectedOrInvalid
	"Return true if this socket is completely disconnected or is invalid."

	| status |
	socketHandle == nil ifTrue: [^ true].
	status := self primSocketConnectionStatus: socketHandle.
	^ (status = Unconnected) | (status = InvalidSocket)
! !

!Socket methodsFor: 'waiting' stamp: 'Pmm 11/20/2010 23:47'!
waitForSendDoneFor: timeout
	"Wait up until the given deadline for the current send operation to complete. Return true if it completes by the deadline, false if not."

	| startTime msecsDelta msecsEllapsed sendDone |
	startTime := Time millisecondClockValue.
	msecsDelta := (timeout * 1000) truncated.
	[(sendDone := self primSocketSendDone: socketHandle) not and: [ self isConnected
			"Connection end and final data can happen fast, so test in this order"
		and: [(msecsEllapsed := Time millisecondsSince: startTime) < msecsDelta]]] whileTrue: [
			self writeSemaphore waitTimeoutMSecs: msecsDelta - msecsEllapsed].

	^ sendDone! !

!Socket methodsFor: 'waiting' stamp: 'nice 4/29/2009 21:25'!
waitForDataFor: timeout ifClosed: closedBlock ifTimedOut: timedOutBlock
	"Wait for the given nr of seconds for data to arrive."
	
	| startTime msecsDelta |
	startTime := Time millisecondClockValue.
	msecsDelta := (timeout * 1000) truncated.
	[(Time millisecondsSince: startTime) < msecsDelta] whileTrue: [
		(self primSocketReceiveDataAvailable: socketHandle)
			ifTrue: [^self].
		self isConnected
			ifFalse: [^closedBlock value].
		self readSemaphore waitTimeoutMSecs: 
			(msecsDelta - (Time millisecondsSince: startTime) max: 0).
	].

	(self primSocketReceiveDataAvailable: socketHandle)
		ifFalse: [
			self isConnected
				ifTrue: [^timedOutBlock value]
				ifFalse: [^closedBlock value]].! !

!Socket methodsFor: 'receiving' stamp: 'mir 5/15/2003 13:46'!
receiveSomeData
	"Receive currently available data (if any). Do not wait."
 
	| buffer bytesRead |
	buffer := String new: 2000.
	bytesRead := self receiveSomeDataInto: buffer.
	^buffer copyFrom: 1 to: bytesRead! !

!Socket methodsFor: 'receiving' stamp: 'mir 5/15/2003 16:05'!
receiveData
	"Receive data into the given buffer and return the number of bytes received. 
	Note the given buffer may be only partially filled by the received data.
	Waits for data once.
	Either returns data or signals a time out or connection close."

	| buffer bytesRead |
	buffer := String new: 2000.
	bytesRead := self receiveDataInto: buffer.
	^buffer copyFrom: 1 to: bytesRead! !

!Socket methodsFor: 'sending' stamp: 'ar 7/20/1999 17:23'!
sendData: buffer count: n
	"Send the amount of data from the given buffer"
	| sent |
	sent := 0.
	[sent < n] whileTrue:[
		sent := sent + (self sendSomeData: buffer startIndex: sent+1 count: (n-sent))].! !

!Socket methodsFor: 'initialization' stamp: 'ClementBera 7/26/2013 17:05'!
initialize: socketType
	"Initialize a new socket handle. If socket creation fails, socketHandle will be set to nil."

	| semaIndex readSemaIndex writeSemaIndex |
	semaphore := Semaphore new.
	readSemaphore := Semaphore new.
	writeSemaphore := Semaphore new.
	semaIndex := Smalltalk registerExternalObject: semaphore.
	readSemaIndex := Smalltalk registerExternalObject: readSemaphore.
	writeSemaIndex := Smalltalk registerExternalObject: writeSemaphore.
	socketHandle := self
		primSocketCreateNetwork: 0
		type: socketType
		receiveBufferSize: 8000
		sendBufSize: 8000
		semaIndex: semaIndex
		readSemaIndex: readSemaIndex
		writeSemaIndex: writeSemaIndex.
	socketHandle 
		ifNil: [ 
			"socket creation failed"
			Smalltalk unregisterExternalObject: semaphore.
			Smalltalk unregisterExternalObject: readSemaphore.
			Smalltalk unregisterExternalObject: writeSemaphore.
			readSemaphore := writeSemaphore := semaphore := nil ]
		ifNotNil: [ self register ]! !

!Socket methodsFor: 'connection open/close' stamp: 'mir 2/22/2002 16:25'!
listenOn: port
	"Listen for a connection on the given port. This operation will return immediately; follow it with waitForConnectionUntil: to wait until a connection is established."

	| status |
	status := self primSocketConnectionStatus: socketHandle.
	(status == Unconnected)
		ifFalse: [InvalidSocketStatusException signal: 'Socket status must Unconnected before listening for a new connection'].

	self primSocket: socketHandle listenOn: port.
! !

!Socket methodsFor: 'receiving' stamp: 'mir 5/15/2003 13:52'!
receiveAvailableData
	"Receive all available data (if any). Do not wait."
 
	| buffer bytesRead |
	buffer := String new: 2000.
	bytesRead := self receiveAvailableDataInto: buffer.
	^buffer copyFrom: 1 to: bytesRead! !

!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocketDestroy: socketID
	"Release the resources associated with this socket. If a connection is open, it is aborted."

	<primitive: 'primitiveSocketDestroy' module: 'SocketPlugin'>
	self primitiveFailed
! !

!Socket methodsFor: 'receiving' stamp: 'mir 5/15/2003 13:52'!
receiveAvailableDataInto: buffer
	"Receive all available data into the given buffer and return the number of bytes received.
	Note the given buffer may be only partially filled by the received data.
	Do not wait for data."

	^self receiveAvailableDataInto: buffer startingAt: 1! !

!Socket methodsFor: 'other' stamp: 'SvenVanCaekenberghe 4/24/2011 20:17'!
setOption: aName value: aValue 
	| value |
	"setup options on this socket, see Unix man pages for values for 
	sockets, IP, TCP, UDP. IE SO_KEEPALIVE
	returns an array, element one is the error number
	element two is the resulting of the negotiated value.
	See getOption for list of keys"

	(socketHandle == nil or: [self isValid not])
		ifTrue: [InvalidSocketStatusException signal: 'Socket status must valid before setting an option'].
	value := aValue asString.
	aValue == true ifTrue: [value := '1'].
	aValue == false ifTrue: [value := '0'].
	^ self primSocket: socketHandle setOption: aName value: value! !

!Socket methodsFor: 'datagrams' stamp: 'ar 4/30/1999 04:29'!
setPort: port
	"Associate a local port number with a UDP socket.  Not applicable to TCP sockets."

	self primSocket: socketHandle setPort: port.
! !

!Socket methodsFor: 'primitives' stamp: 'JMM 5/25/2000 21:48'!
primSocket: socketID getOption: aString 
	"Get some option information on this socket. Refer to the UNIX 
	man pages for valid SO, TCP, IP, UDP options. In case of doubt
	refer to the source code.
	TCP:=NODELAY, SO:=KEEPALIVE are valid options for example
	returns an array containing the error code and the option value"

	<primitive: 'primitiveSocketGetOptions' module: 'SocketPlugin'>
	self primitiveFailed
! !

!Socket methodsFor: 'sending' stamp: 'dc 10/21/2008 08:28'!
sendCommand: commandString
	"Send the given command as a single line followed by a <CR><LF> terminator."

	self sendData: commandString, String crlf.! !

!Socket methodsFor: 'queries' stamp: 'jm 2/25/1999 13:54'!
sendDone
	"Return true if the most recent send operation on this socket has completed."

	socketHandle == nil ifTrue: [^ false].
	^ self primSocketSendDone: socketHandle
! !

!Socket methodsFor: 'initialize-destroy' stamp: 'ClementBera 7/26/2013 17:05'!
destroy
	"Destroy this socket. Its connection, if any, is aborted and its resources are freed. Do nothing if the socket has already been destroyed (i.e., if its socketHandle is nil)."

	socketHandle 
		ifNotNil: [ 
			self isValid
				ifTrue: [ self primSocketDestroy: socketHandle ].
			Smalltalk unregisterExternalObject: semaphore.
			Smalltalk unregisterExternalObject: readSemaphore.
			Smalltalk unregisterExternalObject: writeSemaphore.
			socketHandle := nil.
			readSemaphore := writeSemaphore := semaphore := nil.
			self unregister ]! !

!Socket methodsFor: 'accessing' stamp: 'jm 9/17/97 14:34'!
remotePort

	^ self primSocketRemotePort: socketHandle
! !

!Socket methodsFor: 'queries' stamp: 'jm 2/25/1999 13:56'!
statusString
	"Return a string describing the status of this socket."

	| status |
	socketHandle == nil ifTrue: [^ 'destroyed'].
	status := self primSocketConnectionStatus: socketHandle.
	status = InvalidSocket ifTrue: [^ 'invalidSocketHandle'].
	status = Unconnected ifTrue: [^ 'unconnected'].
	status = WaitingForConnection ifTrue: [^ 'waitingForConnection'].
	status = Connected ifTrue: [^ 'connected'].
	status = OtherEndClosed ifTrue: [^ 'otherEndClosedButNotThisEnd'].
	status = ThisEndClosed ifTrue: [^ 'thisEndClosedButNotOtherEnd'].
	^ 'unknown socket status'
! !

!Socket methodsFor: 'primitives' stamp: 'SvenVanCaekenberghe 4/24/2011 20:08'!
primSocket: socketID receiveDataInto: aStringOrByteArray startingAt: startIndex count: count
	"Receive data from the given socket into the given array starting at the given index. Return the number of bytes read or zero if no data is available."

	<primitive: 'primitiveSocketReceiveDataBufCount' module: 'SocketPlugin'>
	self primitiveFailed
! !

!Socket methodsFor: 'primitives' stamp: 'JMM 5/25/2000 00:08'!
primSocket: socketID sendUDPData: aStringOrByteArray toHost: hostAddress  port: portNumber startIndex: startIndex count: count
	"Send data to the remote host through the given socket starting with the given byte index of the given byte array. The data sent is 'pushed' immediately. Return the number of bytes of data actually sent; any remaining data should be re-submitted for sending after the current send operation has completed."
	"Note: In general, it many take several sendData calls to transmit a large data array since the data is sent in send-buffer-sized chunks. The size of the send buffer is determined when the socket is created."

	<primitive:  'primitiveSocketSendUDPDataBufCount' module: 'SocketPlugin'>
	self primitiveFailed

! !

!Socket methodsFor: 'other' stamp: 'SvenVanCaekenberghe 4/24/2011 20:03'!
getOption: aName 
	"Get options on this socket, see Unix man pages for values for 
	sockets, IP, TCP, UDP. IE SO_KEEPALIVE
	returns an array, element one is an status number (0 ok, -1 read only option)
	element two is the resulting of the requested option"

	(socketHandle == nil or: [self isValid not])
		ifTrue: [InvalidSocketStatusException signal: 'Socket status must valid before getting an option'].
	^self primSocket: socketHandle getOption: aName

"| foo options |
Socket initializeNetwork.
foo := Socket newTCP.
foo connectTo: (NetNameResolver addressFromString: '192.168.1.1') port: 80.
foo waitForConnectionUntil: (Socket standardDeadline).

options := {
'SO_DEBUG'. 'SO_REUSEADDR'. 'SO_REUSEPORT'. 'SO_DONTROUTE'.
'SO_BROADCAST'. 'SO_SNDBUF'. 'SO_RCVBUF'. 'SO_KEEPALIVE'.
'SO_OOBINLINE'. 'SO_PRIORITY'. 'SO_LINGER'. 'SO_RCVLOWAT'.
'SO_SNDLOWAT'. 'IP_TTL'. 'IP_HDRINCL'. 'IP_RCVOPTS'.
'IP_RCVDSTADDR'. 'IP_MULTICAST_IF'. 'IP_MULTICAST_TTL'.
'IP_MULTICAST_LOOP'. 'UDP_CHECKSUM'. 'TCP_MAXSEG'.
'TCP_NODELAY'. 'TCP_ABORT_THRESHOLD'. 'TCP_CONN_NOTIFY_THRESHOLD'. 
'TCP_CONN_ABORT_THRESHOLD'. 'TCP_NOTIFY_THRESHOLD'.
'TCP_URGENT_PTR_TYPE'}.

1 to: options size do: [:i | | fum |
	fum :=foo getOption: (options at: i).
	Transcript show: (options at: i),fum printString;cr].

foo := Socket newUDP.
foo setPeer: (NetNameResolver addressFromString: '192.168.1.9') port: 7.
foo waitForConnectionUntil: (Socket standardDeadline).

1 to: options size do: [:i | | fum |
	fum :=foo getOption: (options at: i).
	Transcript show: (options at: i),fum printString;cr].
"! !

!Socket methodsFor: 'sending' stamp: 'mir 2/19/2002 18:31'!
sendStreamContents: stream checkBlock: checkBlock
	"Send the data in the stream. Close the stream after you are done. After each block of data evaluate checkBlock and abort if it returns false.
	Usefull for directly sending contents of a file without reading into memory first."

	| chunkSize buffer |
	chunkSize := 5000.
	buffer := ByteArray new: chunkSize.
	stream binary.
	[[stream atEnd and: [checkBlock value]]
		whileFalse: [
			buffer := stream next: chunkSize into: buffer.
			self sendData: buffer]]
		ensure: [stream close]! !

!Socket methodsFor: 'connection open/close' stamp: 'bolot 7/16/1999 14:36'!
accept
	"Accept a connection from the receiver socket.
	Return a new socket that is connected to the client"
	^Socket acceptFrom: self.! !

!Socket methodsFor: 'datagrams' stamp: 'ar 4/30/1999 04:29'!
setPeer: hostAddress port: port
	"Set the default send/recv address."

	self primSocket: socketHandle connectTo: hostAddress port: port.
! !

!Socket methodsFor: 'connection open/close' stamp: 'mir 2/22/2002 16:25'!
listenOn: portNumber backlogSize: backlog
	"Listen for a connection on the given port.
	If this method succeeds, #accept may be used to establish a new connection"
	| status |
	status := self primSocketConnectionStatus: socketHandle.
	(status == Unconnected)
		ifFalse: [InvalidSocketStatusException signal: 'Socket status must Unconnected before listening for a new connection'].
	self primSocket: socketHandle listenOn: portNumber backlogSize: backlog.
! !

!Socket methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/24/2011 20:10'!
semaphore
	^ semaphore! !

!Socket methodsFor: 'queries' stamp: 'jm 2/25/1999 13:54'!
isWaitingForConnection
	"Return true if this socket is waiting for a connection."

	socketHandle == nil ifTrue: [^ false].
	^ (self primSocketConnectionStatus: socketHandle) == WaitingForConnection
! !

!Socket methodsFor: 'sending' stamp: 'SvenVanCaekenberghe 4/24/2011 20:17'!
sendSomeData: aStringOrByteArray startIndex: startIndex count: count
	"Send up to count bytes of the given data starting at the given index. Answer the number of bytes actually sent."
	"Note: This operation may have to be repeated multiple times to send a large amount of data."

	^ self 
		sendSomeData: aStringOrByteArray 
		startIndex: startIndex 
		count: count 
		for: Socket standardTimeout
! !

!Socket methodsFor: 'registry' stamp: 'ar 3/21/98 17:41'!
unregister
	^self class unregister: self! !

!Socket methodsFor: 'accessing' stamp: 'MU 11/26/2003 16:53'!
localPort
	self isWaitingForConnection
		ifFalse: [[self waitForConnectionFor: Socket standardTimeout]
				on: ConnectionTimedOut
				do: [:ex | ^ 0]].
	^ self primSocketLocalPort: socketHandle! !

!Socket methodsFor: 'receiving' stamp: 'mu 8/9/2003 18:04'!
receiveAvailableDataInto: buffer startingAt: startIndex
	"Receive all available data into the given buffer and return the number of bytes received.
	Note the given buffer may be only partially filled by the received data.
	Do not wait for data."

	| bufferPos bytesRead |
	bufferPos := startIndex.
	[self dataAvailable
		and: [bufferPos-1 < buffer size]] 
		whileTrue: [
			bytesRead := self receiveSomeDataInto: buffer startingAt: bufferPos.
			bufferPos := bufferPos + bytesRead].
	^bufferPos - startIndex! !

!Socket methodsFor: 'waiting' stamp: 'mu 9/30/2007 04:04'!
waitForAcceptFor: timeout ifTimedOut: timeoutBlock
	"Wait and accept an incoming connection"
	self waitForConnectionFor: timeout ifTimedOut: [^timeoutBlock value].
	^self accept! !

!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocketLocalAddress: socketID
	"Return the local host address for this socket."

	<primitive: 'primitiveSocketLocalAddress' module: 'SocketPlugin'>
	self primitiveFailed
! !

!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocketDestroyGently: socketID
	"Release the resources associated with this socket. If a connection is open, it is aborted.
	Do not fail if the receiver is already closed."

	<primitive: 'primitiveSocketDestroy' module: 'SocketPlugin'>
! !

!Socket methodsFor: 'queries' stamp: 'jm 2/25/1999 13:54'!
isUnconnected
	"Return true if this socket's state is Unconnected."

	socketHandle == nil ifTrue: [^ false].
	^ (self primSocketConnectionStatus: socketHandle) == Unconnected
! !

!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocket: aHandle listenOn: portNumber backlogSize: backlog
	"Primitive. Set up the socket to listen on the given port.
	Will be used in conjunction with #accept only."
	<primitive: 'primitiveSocketListenWithOrWithoutBacklog' module: 'SocketPlugin'>
	self destroy. "Accept not supported so clean up"! !

!Socket methodsFor: 'waiting' stamp: 'svp 9/23/2003 00:08'!
waitForDataIfClosed: closedBlock
	"Wait indefinitely for data to arrive.  This method will block until
	data is available or the socket is closed."

	[true]
		whileTrue: [
			(self primSocketReceiveDataAvailable: socketHandle)
				ifTrue: [^self].
			self isConnected
				ifFalse: [^closedBlock value].
			self readSemaphore wait].
! !

!Socket methodsFor: 'receiving' stamp: 'gk 2/9/2005 12:24'!
receiveDataSignallingTimeout: timeout into: aStringOrByteArray startingAt: aNumber
	"Receive data into the given buffer and return the number of bytes received. 
	Note the given buffer may be only partially filled by the received data.
	Wait for data once for the specified nr of seconds.  This method will
	throw exceptions on timeout or the socket closing."

	self waitForDataFor: timeout.
	^self primSocket: socketHandle
		receiveDataInto: aStringOrByteArray
		startingAt: aNumber
		count: aStringOrByteArray size-aNumber+1
! !

!Socket methodsFor: 'accessing' stamp: 'MU 11/26/2003 16:53'!
localAddress
	self isWaitingForConnection
		ifFalse: [[self waitForConnectionFor: Socket standardTimeout]
				on: ConnectionTimedOut
				do: [:ex | ^ ByteArray new: 4]].
	^ self primSocketLocalAddress: socketHandle! !

!Socket methodsFor: 'receiving' stamp: 'gk 12/14/2005 10:02'!
discardReceivedData
	"Discard any data received up until now, and return the number of bytes discarded."

	| buf totalBytesDiscarded |
	buf := String new: 10000.
	totalBytesDiscarded := 0.
	[self isConnected] whileTrue: [
		totalBytesDiscarded :=
			totalBytesDiscarded + (self receiveDataInto: buf)].
	^ totalBytesDiscarded
! !

!Socket methodsFor: 'queries' stamp: 'jm 2/25/1999 13:51'!
isValid
	"Return true if this socket contains a valid, non-nil socket handle."

	| status |
	socketHandle == nil ifTrue: [^ false].
	status := self primSocketConnectionStatus: socketHandle.
	^ status ~= InvalidSocket
! !

!Socket methodsFor: 'primitives-ipv6' stamp: 'ikp 6/8/2007 22:08'!
primSocket: socketID connectTo: socketAddress

	<primitive: 'primitiveSocketConnectTo' module: 'SocketPlugin'>
	self primitiveFailed
! !

!Socket methodsFor: 'connection open/close' stamp: 'AdrianLienhard 3/13/2010 12:53'!
connectNonBlockingTo: hostAddress port: port
	"Initiate a connection to the given port at the given host address. This operation will return immediately; follow it with waitForConnectionUntil: to wait until the connection is established."

	| status |
	self initializeNetwork.
	status := self primSocketConnectionStatus: socketHandle.
	(status == Unconnected)
		ifFalse: [InvalidSocketStatusException signal: 'Socket status must Unconnected before opening a new connection'].

	self primSocket: socketHandle connectTo: hostAddress port: port! !

!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocket: socketID setPort: port
	"Set the local port associated with a UDP socket.
	Note: this primitive is overloaded.  The primitive will not fail on a TCP socket, but
	the effects will not be what was desired.  Best solution would be to split Socket into
	two subclasses, TCPSocket and UDPSocket."

	<primitive: 'primitiveSocketListenWithOrWithoutBacklog' module: 'SocketPlugin'>
	self primitiveFailed
! !

!Socket methodsFor: 'queries' stamp: 'JMM 5/5/2000 12:15'!
isOtherEndClosed
	"Return true if this socket had the other end closed."

	socketHandle == nil ifTrue: [^ false].
	^ (self primSocketConnectionStatus: socketHandle) == OtherEndClosed
! !

!Socket methodsFor: 'primitives' stamp: 'SvenVanCaekenberghe 4/24/2011 20:19'!
primAcceptFrom: aHandle receiveBufferSize: rcvBufSize sendBufSize: sndBufSize semaIndex: semaIndex readSemaIndex: aReadSema writeSemaIndex: aWriteSema
	"Create and return a new socket handle based on accepting the connection from the given listening socket"
	
	<primitive: 'primitiveSocketAccept3Semaphores' module: 'SocketPlugin'>
	
	^ self primitiveFailed! !

!Socket methodsFor: 'primitives' stamp: 'ikp 9/1/2003 20:33'!
primSocket: aHandle listenOn: portNumber backlogSize: backlog interface: ifAddr
	"Primitive. Set up the socket to listen on the given port.
	Will be used in conjunction with #accept only."
	<primitive: 'primitiveSocketListenOnPortBacklogInterface' module: 'SocketPlugin'>
	self destroy. "Accept not supported so clean up"! !

!Socket methodsFor: 'primitives' stamp: 'SvenVanCaekenberghe 4/24/2011 20:19'!
primSocket: socketID connectTo: hostAddress port: port
	"Attempt to establish a connection to the given port of the given host. This is an asynchronous call; query the socket status to discover if and when the connection is actually completed."

	<primitive: 'primitiveSocketConnectToPort' module: 'SocketPlugin'>
	
	self primitiveFailed
! !

!Socket methodsFor: 'receiving' stamp: 'svp 9/23/2003 00:03'!
receiveDataTimeout: timeout
	"Receive data into the given buffer and return the number of bytes received. 
	Note the given buffer may be only partially filled by the received data.
	Waits for data once."

	| buffer bytesRead |
	buffer := String new: 2000.
	bytesRead := self receiveDataTimeout: timeout into: buffer.
	^buffer copyFrom: 1 to: bytesRead! !

!Socket methodsFor: 'waiting' stamp: 'svp 7/27/2003 00:18'!
waitForDataFor: timeout
	"Wait for the given nr of seconds for data to arrive.
	Signal a time out or connection close exception if either happens before data becomes available."

	^self
		waitForDataFor: timeout
		ifClosed: [ConnectionClosed signal: 'Connection closed while waiting for data.']
		ifTimedOut: [ConnectionTimedOut signal: 'Data receive timed out.']
! !

!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocketCloseConnection: socketID
	"Close the connection on the given port. The remote end is informed that this end has closed and will do no further sends. This is an asynchronous call; query the socket status to discover if and when the connection is actually closed."

	<primitive: 'primitiveSocketCloseConnection' module: 'SocketPlugin'>
	self primitiveFailed
! !

!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocketRemotePort: socketID
	"Return the remote port for this socket, or zero if no connection has been made."

	<primitive: 'primitiveSocketRemotePort' module: 'SocketPlugin'>
	self primitiveFailed
! !

!Socket methodsFor: 'sending' stamp: 'ls 3/3/1999 18:59'!
sendSomeData: aStringOrByteArray startIndex: startIndex
	"Send as much of the given data as possible starting at the given index. Answer the number of bytes actually sent."
	"Note: This operation may have to be repeated multiple times to send a large amount of data."

	^ self
		sendSomeData: aStringOrByteArray
		startIndex: startIndex
		count: (aStringOrByteArray size - startIndex + 1)! !

!Socket methodsFor: 'accessing' stamp: 'ar 4/30/1999 04:25'!
port
	"Shortcut"
	^self localPort! !

!Socket methodsFor: 'receiving' stamp: 'StephaneDucasse 5/28/2011 13:36'!
receiveDataInto: aStringOrByteArray startingAt: aNumber
	"Receive data into the given buffer and return the number of bytes received. 
	Note the given buffer may be only partially filled by the received data.
	Waits for data once.  The answer may be zero (indicating that no data was 
	available before the socket closed)."

	| bytesRead closed |
	bytesRead := 0.
	closed := false.
	[closed not and: [bytesRead = 0]]
		whileTrue: [
			self waitForDataIfClosed: [closed := true].
			bytesRead := self primSocket: socketHandle
				receiveDataInto: aStringOrByteArray
				startingAt: aNumber
				count: aStringOrByteArray size-aNumber+1].
	^bytesRead
! !

!Socket methodsFor: 'waiting' stamp: 'mu 8/19/2003 02:57'!
waitForConnectionFor: timeout
	"Wait up until the given deadline for a connection to be established. Return true if it is established by the deadline, false if not."

	^self 
		waitForConnectionFor: timeout 
		ifTimedOut: [ConnectionTimedOut signal: 'Failed to connect in ', timeout asString, ' seconds']
! !

!Socket methodsFor: 'datagrams' stamp: 'SvenVanCaekenberghe 4/24/2011 20:12'!
receiveDataInto: aStringOrByteArray fromHost: hostAddress port: portNumber
	"Receive a UDP packet from the given hostAddress/portNumber, storing the data in the given buffer, and return the number of bytes received. Note the given buffer may be only partially filled by the received data."

	[ | datagram |
		datagram := self receiveUDPDataInto: aStringOrByteArray.
		((datagram at: 2) = hostAddress and: [ (datagram at: 3) = portNumber ]) 
			ifTrue: [ ^ datagram at: 1 ]
			ifFalse: [ ^0 ] ] repeat! !

!Socket methodsFor: 'receiving' stamp: 'svp 9/23/2003 00:01'!
receiveDataWithTimeoutInto: aStringOrByteArray startingAt: aNumber
	"Receive data into the given buffer and return the number of bytes received. 
	Note the given buffer may be only partially filled by the received data.
	Waits for data once."

	^self receiveDataTimeout: Socket standardTimeout into: aStringOrByteArray startingAt: aNumber 
! !

!Socket methodsFor: 'primitives-ipv6' stamp: 'ikp 6/9/2007 10:24'!
primSocketRemoteAddressSize: handle

	<primitive: 'primitiveSocketRemoteAddressSize' module: 'SocketPlugin'>
	self primitiveFailed
! !

!Socket methodsFor: 'receiving' stamp: 'mir 5/15/2003 16:05'!
receiveDataInto: aStringOrByteArray
	"Receive data into the given buffer and return the number of bytes received. 
	Note the given buffer may be only partially filled by the received data.
	Waits for data once.
	Either returns data or signals a time out or connection close."

	^self receiveDataInto: aStringOrByteArray startingAt: 1! !

!Socket methodsFor: 'sending' stamp: 'SvenVanCaekenberghe 4/24/2011 20:16'!
sendSomeData: aStringOrByteArray startIndex: startIndex count: count for: aTimeoutInSeconds
	"Send up to count bytes of the given data starting at the given index. Answer the number of bytes actually sent."
	"Note: This operation may have to be repeated multiple times to send a large amount of data."

	| bytesSent |
	(self waitForSendDoneFor: aTimeoutInSeconds)
		ifTrue: [
			bytesSent := self primSocket: socketHandle
				sendData: aStringOrByteArray
				startIndex: startIndex
				count: count ]
		ifFalse: [ ConnectionTimedOut signal: 'send data timeout; data not sent' ].
	^ bytesSent
! !

!Socket methodsFor: 'primitives' stamp: 'SvenVanCaekenberghe 4/24/2011 20:05'!
primSocketCreateNetwork: netType type: socketType receiveBufferSize: rcvBufSize sendBufSize: sendBufSize semaIndex: semaIndex readSemaIndex: aReadSema writeSemaIndex: aWriteSema
	"See comment in primSocketCreateNetwork: with one semaIndex. However you should know that some implementations
	ignore the buffer size and this interface supports three semaphores,  one for open/close/listen and the other two for
	reading and writing"

	<primitive: 'primitiveSocketCreate3Semaphores' module: 'SocketPlugin'>
	^ self primitiveFailed! !

!Socket methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/24/2011 20:10'!
writeSemaphore
	^ writeSemaphore! !

!Socket class methodsFor: 'registry' stamp: 'HenrikSperreJohansen 5/20/2010 22:38'!
register: anObject
	^self registry add: anObject! !

!Socket class methodsFor: 'tests' stamp: 'gk 12/15/2005 01:18'!
loopbackTest
	"Send data from one socket to another on the local machine.
	Tests most of the socket primitives."

	"100 timesRepeat: [Socket loopbackTest]"

	| sock1 sock2 bytesToSend sendBuf receiveBuf done bytesSent bytesReceived t extraBytes packetsSent packetsRead |
	Transcript
		cr;
		show: 'starting loopback test';
		cr.
	Transcript
		show: '---------- Connecting ----------';
		cr.
	self initializeNetwork.
	sock1 := self new.
	sock2 := self new.
	sock1 listenOn: 54321.
	sock2 connectTo: NetNameResolver localHostAddress port: 54321.
	sock1 waitForConnectionFor: self standardTimeout.
	sock2 waitForConnectionFor: self standardTimeout.
	sock1 isConnected ifFalse: [self error: 'sock1 not connected'].
	sock2 isConnected ifFalse: [self error: 'sock2 not connected'].
	Transcript
		show: 'connection established';
		cr.
	bytesToSend := 5000000.
	sendBuf := String new: 5000 withAll: $x.
	receiveBuf := String new: 50000.
	done := false.
	packetsSent := packetsRead := bytesSent := bytesReceived := 0.
	t := Time millisecondsToRun: 
					[[done] whileFalse: 
							[(sock1 sendDone and: [bytesSent < bytesToSend]) 
								ifTrue: 
									[packetsSent := packetsSent + 1.
									bytesSent := bytesSent + (sock1 sendSomeData: sendBuf)].
							sock2 dataAvailable 
								ifTrue: 
									[packetsRead := packetsRead + 1.
									bytesReceived := bytesReceived + (sock2 receiveDataInto: receiveBuf)].
							done := bytesSent >= bytesToSend and: [bytesReceived = bytesSent]]].
	Transcript
		show: 'closing connection';
		cr.
	sock1 waitForSendDoneFor: self standardTimeout.
	sock1 close.
	sock2 waitForDisconnectionFor: self standardTimeout.
	extraBytes := sock2 discardReceivedData.
	extraBytes > 0 
		ifTrue: 
			[Transcript
				show: ' *** received ' , extraBytes size printString , ' extra bytes ***';
				cr].
	sock2 close.
	sock1 waitForDisconnectionFor: self standardTimeout.
	sock1 isUnconnectedOrInvalid ifFalse: [self error: 'sock1 not closed'].
	sock2 isUnconnectedOrInvalid ifFalse: [self error: 'sock2 not closed'].
	Transcript
		show: '---------- Connection Closed ----------';
		cr.
	sock1 destroy.
	sock2 destroy.
	Transcript
		show: 'loopback test done; time = ' , t printString;
		cr.
	Transcript
		show: (bytesToSend asFloat / t roundTo: 0.01) printString 
					, '* 1000 bytes/sec';
		cr.
	Transcript endEntry! !

!Socket class methodsFor: 'instance creation' stamp: 'ar 4/30/1999 04:15'!
createIfFail: failBlock
	"Attempt to create a new socket. If successful, return the new socket. Otherwise, return the result of evaluating the given block. Socket creation can fail if the network isn't available or if there are not sufficient resources available to create another socket."
	"Note: The default creates a TCP socket"
	^self tcpCreateIfFail: failBlock! !

!Socket class methodsFor: 'utilities' stamp: 'ar 4/30/1999 04:21'!
wildcardAddress
	"Answer a don't-care address for use with UDP sockets."

	^ByteArray new: 4		"0.0.0.0"! !

!Socket class methodsFor: 'tests' stamp: 'gk 12/15/2005 01:03'!
newAcceptCheck
	"Check if the platform has support for the BSD style accept()."

	"Socket newAcceptCheck"
	
	| socket |
	self initializeNetwork.
	socket := self newTCP.
	socket listenOn: 44444 backlogSize: 4.
	socket isValid ifTrue: [
		self inform: 'Everything looks OK for the BSD style accept()'
	] ifFalse: [
		self inform: 'It appears that you DO NOT have support for the BSD style accept()'].
	socket destroy! !

!Socket class methodsFor: 'registry' stamp: 'HenrikSperreJohansen 5/20/2010 22:38'!
unregister: anObject
	^self registry remove: anObject ifAbsent:[]! !

!Socket class methodsFor: 'instance creation' stamp: 'AdrianLienhard 3/13/2010 13:29'!
newTCP
	"Create a socket and initialise it for TCP"
	self initializeNetwork.
	^[ super new initialize: TCPSocketType ]
		repeatWithGCIf: [ :socket | socket isValid not ]! !

!Socket class methodsFor: 'utilities' stamp: 'mir 5/15/2003 16:16'!
standardTimeout

	^45
! !

!Socket class methodsFor: 'registry' stamp: 'ar 12/12/2001 19:12'!
registryThreshold: aNumber
	"Return the registry threshold above which socket creation may fail due to too many already open sockets. If the threshold is reached, a full GC will be issued if the creation of a socket fails."
	RegistryThreshold := aNumber! !

!Socket class methodsFor: 'instance creation' stamp: 'AdrianLienhard 3/13/2010 13:30'!
newUDP
	"Create a socket and initialise it for UDP"
	self initializeNetwork.
	^[ super new initialize: UDPSocketType ]
		repeatWithGCIf: [ :socket | socket isValid not ]! !

!Socket class methodsFor: 'class initialization' stamp: 'ar 12/12/2001 19:12'!
initialize
	"Socket initialize"

	"Socket Types"
	TCPSocketType := 0.
	UDPSocketType := 1.

	"Socket Status Values"
	InvalidSocket := -1.
	Unconnected := 0.
	WaitingForConnection := 1.
	Connected := 2.
	OtherEndClosed := 3.
	ThisEndClosed := 4.

	RegistryThreshold := 100. "# of sockets"! !

!Socket class methodsFor: 'network initialization' stamp: 'VeronicaUquillas 6/11/2010 13:26'!
initializeNetwork
	"Initialize the network drivers and the NetNameResolver. Do nothing if the network is already initialized."
	"Note: The network must be re-initialized every time Pharo starts up, so applications that persist across snapshots should be prepared to re-initialize the network as needed. Such applications should call 'Socket initializeNetwork' before every network transaction. "

	NetNameResolver initializeNetwork! !

!Socket class methodsFor: 'utilities' stamp: 'ar 4/30/1999 04:21'!
wildcardPort
	"Answer a don't-care port for use with UDP sockets.  (The system will allocate an
	unused port number to the socket.)"

	^0! !

!Socket class methodsFor: 'instance creation' stamp: 'michael.rueger 3/30/2009 13:48'!
tcpCreateIfFail: failBlock
	"Attempt to create a new socket. If successful, return the new socket. Otherwise, return the result of evaluating the given block. Socket creation can fail if the network isn't available or if there are not sufficient resources available to create another socket."

	| sock |
	self initializeNetwork.
	sock := self newTCP.
	sock isValid ifFalse: [^ failBlock value].
	^ sock
! !

!Socket class methodsFor: 'utilities' stamp: 'ClementBera 7/26/2013 16:32'!
ping: hostName
	"Ping the given host. Useful for checking network connectivity. The host must be running a TCP echo server."

	"Socket ping: 'pharo-project.org'"

	| tcpPort sock serverAddr startTime echoTime |
	tcpPort := 7.	"7 = echo port, 13 = time port, 19 = character generator port"
	serverAddr := NetNameResolver addressForName: hostName timeout: 10.
	serverAddr 
		ifNil: [ ^ self inform: 'Could not find an address for ' , hostName ].
	sock := Socket new.
	sock connectNonBlockingTo: serverAddr port: tcpPort.
	[ sock waitForConnectionFor: 10 ]
		on: ConnectionTimedOut
		do: [ :ex | 
			(self confirm: 'Continue to wait for connection to ' , hostName , '?')
				ifTrue: [ ex retry ]
				ifFalse: [ 
					sock destroy.
					^ self ] ].
	sock sendData: 'echo!!'.
	startTime := Time millisecondClockValue.
	[ sock waitForDataFor: 15 ]
		on: ConnectionTimedOut
		do: [ :ex | 
			(self confirm: 'Packet sent but no echo yet; keep waiting?')
				ifTrue: [ ex retry ] ].
	echoTime := Time millisecondsSince: startTime.
	sock destroy.
	self inform: hostName , ' responded in ' , echoTime printString , ' milliseconds'! !

!Socket class methodsFor: 'utilities' stamp: 'GabrielOmarCotelli 11/28/2013 19:27'!
nameForWellKnownTCPPort: portNum
	"Answer the name for the given well-known TCP port number. Answer a string containing the port number if it isn't well-known."

	| portList |
	portList := #(#(7 'echo') #(9 'discard') #(13 'time') #(19 'characterGenerator') #(21 'ftp') #(23 'telnet') #(25 'smtp') #(80 'http') #(110 'pop3') #(119 'nntp')).
	^ portList
		detect: [ :pair | pair first = portNum ]
		ifFound: [ :pair | pair last ]
		ifNone: [ 'port-' , portNum printString ]! !

!Socket class methodsFor: 'tests' stamp: 'ClementBera 7/26/2013 16:32'!
sendTest
	"Send data to the 'discard' socket of the given host.
	Tests the speed of one-way data transfers across the
	network to the given host. Note that most hosts
	do not run a discard server."

	"Socket sendTest"

	| sock bytesToSend sendBuf bytesSent t serverName serverAddr |
	Transcript
		cr;
		show: 'starting send test';
		cr.
	self initializeNetwork.
	serverName := UIManager default request: 'What is the destination server?' initialAnswer: 'create.ucsb.edu'.
	serverAddr := NetNameResolver addressForName: serverName timeout: 10.
	serverAddr 
		ifNil: [ ^ self inform: 'Could not find an address for ' , serverName ].
	sock := self new.
	Transcript
		show: '---------- Connecting ----------';
		cr.
	sock connectTo: serverAddr port: 9.
	sock isConnected
		ifFalse: [ 
			sock destroy.
			^ self inform: 'could not connect' ].
	Transcript
		show: 'connection established; sending data';
		cr.
	bytesToSend := 1000000.
	sendBuf := String new: 64 * 1024 withAll: $x.
	bytesSent := 0.
	t := Time
		millisecondsToRun: [ 
			[ bytesSent < bytesToSend ]
				whileTrue: [ 
					sock sendDone
						ifTrue: [ bytesSent := bytesSent + (sock sendSomeData: sendBuf) ] ] ].
	sock waitForSendDoneFor: self standardTimeout.
	sock destroy.
	Transcript
		show: '---------- Connection Closed ----------';
		cr;
		show: 'send test done; time = ' , t printString;
		cr;
		show: (bytesToSend asFloat / t roundTo: 0.01) printString , ' * 1000 bytes/sec';
		cr;
		endEntry! !

!Socket class methodsFor: 'utilities' stamp: 'jm 1/14/1999 17:25'!
pingPortsOn: hostName
	"Attempt to connect to a set of well-known sockets on the given host, and answer the names of the available ports."
	"Socket pingPortsOn: 'www.disney.com'"

	^ Socket
		pingPorts: #(7 13 19 21 23 25 80 110 119)
		on: hostName
		timeOutSecs: 20
! !

!Socket class methodsFor: 'instance creation' stamp: 'ls 9/24/1999 09:45'!
acceptFrom: aSocket
	^[ super new acceptFrom: aSocket ]
		repeatWithGCIf: [ :sock | sock isValid not ]! !

!Socket class methodsFor: 'utilities' stamp: 'ClementBera 7/26/2013 16:32'!
pingPorts: portList on: hostName timeOutSecs: timeOutSecs
	"Attempt to connect to each of the given sockets on the given host. Wait at most timeOutSecs for the connections to be established. Answer an array of strings indicating the available ports."

	"Socket pingPorts: #(7 13 19 21 23 25 80 110 119) on: 'pharo-project.org' timeOutSecs: 15"

	| serverAddr sockets startTime timeoutMsecs done result unconnectedCount connectedCount waitingCount |
	serverAddr := NetNameResolver addressForName: hostName timeout: 10.
	serverAddr 
		ifNil: [ 
			self inform: 'Could not find an address for ' , hostName.
			^ #() ].
	sockets := portList
		collect: [ :portNum | 
			| sock |
			sock := Socket new.
			sock connectTo: serverAddr port: portNum ].
	startTime := Time millisecondClockValue.
	timeoutMsecs := (1000 * timeOutSecs) truncated.
	done := false.
	[ done ]
		whileFalse: [ 
			unconnectedCount := 0.
			connectedCount := 0.
			waitingCount := 0.
			sockets
				do: [ :s | 
					s isUnconnectedOrInvalid
						ifTrue: [ unconnectedCount := unconnectedCount + 1 ]
						ifFalse: [ 
							s isConnected
								ifTrue: [ connectedCount := connectedCount + 1 ].
							s isWaitingForConnection
								ifTrue: [ waitingCount := waitingCount + 1 ] ] ].
			waitingCount = 0
				ifTrue: [ done := true ].
			connectedCount = sockets size
				ifTrue: [ done := true ].
			(Time millisecondsSince: startTime) >= timeoutMsecs
				ifTrue: [ done := true ] ].
	result := (sockets select: [ :s | s isConnected ]) collect: [ :s | self nameForWellKnownTCPPort: s remotePort ].
	sockets do: [ :s | s destroy ].
	^ result! !

!Socket class methodsFor: 'registry' stamp: 'ar 12/12/2001 19:12'!
registryThreshold
	"Return the registry threshold above which socket creation may fail due to too many already open sockets. If the threshold is reached, a full GC will be issued if the creation of a socket fails."
	^RegistryThreshold! !

!Socket class methodsFor: 'instance creation' stamp: 'michael.rueger 3/30/2009 13:48'!
udpCreateIfFail: failBlock
	"Attempt to create a new socket. If successful, return the new socket. Otherwise, return the result of evaluating the given block. Socket creation can fail if the network isn't available or if there are not sufficient resources available to create another socket."

	| sock |
	self initializeNetwork.
	sock := self newUDP.
	sock isValid ifFalse: [^ failBlock value].
	^ sock
! !

!Socket class methodsFor: 'instance creation' stamp: 'ar 4/30/1999 04:13'!
new
	"Return a new, unconnected Socket. Note that since socket creation may fail, it is safer to use the method createIfFail: to handle such failures gracefully; this method is primarily for backward compatibility and may be disallowed in a future release."
	"Note: The default creates a TCP socket - this is also backward compatibility."
	^self newTCP! !

!Socket class methodsFor: 'utilities' stamp: 'tk 4/9/98 15:56'!
deadServer: aStringOrNil
	"Keep the machine name of the most recently encoutered non-responding machine.  Next time the user can move it to the last in a list of servers to try."

	DeadServer := aStringOrNil! !

!Socket class methodsFor: 'registry' stamp: 'HenrikSperreJohansen 5/20/2010 22:38'!
registry
	^Registry ifNil: [Registry := WeakRegistry new]
! !

!Socket class methodsFor: 'utilities' stamp: 'tk 4/9/98 15:54'!
deadServer

	^ DeadServer! !

!SocketAddress commentStamp: '<historical>'!
I represent a socket (network) address consisting of a host internet address and a port number.  My contents are opaque and cannot be interpreted directly.  See the accessing protocol for methods that retrieve the information I contain.!
!SocketAddress methodsFor: 'converting' stamp: 'mir 6/17/2007 23:13'!
asSocketAddress
! !

!SocketAddress class methodsFor: 'instance creation' stamp: 'mir 6/26/2007 18:33'!
fromOldByteAddress: byteArray
	^self newFrom: byteArray! !

!SocketPrimitiveFailed commentStamp: 'TorstenBergmann 2/5/2014 09:59'!
Notify that a socket primitive failed!
!SocketStream commentStamp: 'VeronicaUquillas 6/11/2010 14:38'!
SocketStream is a wrapper for class Socket making it easy to write networking code by giving the programmer a stream-like protocol. A Socket is a two way communication link with two logically separate channels - input and output. The Socket class is the lowest level in Pharo for network communication and using it directly can be difficult and bug prone.

A SocketStream can be in binary or ascii mode, ascii is the default which means you are transmitting and receiving Strings. Most Internet protocols are in clear text ascii, like for example HTTP. Another setting is what timeout you want to use - default is the standardTimeout from Socket. More settings can be found in the method category 'configuration'.

Simplest example of connecting, sending/receiving and closing:

| stream result |
stream := SocketStream openConnectionToHostNamed: 'www.pharo-project.org' port: 80.
[[stream nextPutAll: 'GET / HTTP/1.0'; crlf; crlf; flush.
result := stream upToEnd. "Give us all data until the socket is closed."
Transcript show: result; cr.]
	ensure: [stream close]]
		on: ConnectionTimedOut
		do: [:ex | Transcript show: ex asString;cr. ex resume]

There are two important things to note above:
	- The methods in category "stream in" can signal two exceptions (unless turned off with #shouldSignal:):
		ConnectionClosed and ConnectionTimedOut
	- We close the stream using #ensure:, that is to make sure it isn't left opened.
	- We use #on:do: to catch any signal. In this case we do not need to catch ConnectionClosed since #upToEnd does that for us intrinsically.

----------------
SocketStream (below called SS) is a reimplementation of 'Old'-SocketStream (below called OSS) - the class that originates from the original Comanche implementation but now is included in standard Squeak. SS has the same protocol as OSS and is meant to replace it. SS is faster, more flexible, is better documented and adds a few features:

1. #shouldSignal:, which decides if SS should signal low level Socket exceptions (true) or if it should swallow them like original OSS did. Default is true. The only reason I added this is for backwards compatibility - not signalling causes problems - see bug 4 below.

2. #nextAllInBuffer, #nextInBuffer:, #skip:, #receiveData:, #nextPutAllFlush: and #recentlyRead are new additions to the public protocol.


It also fixes various bugs:

1. #isDataAvailable could theoretically answer false, when there actually is some in the buffer in OSS. If #receiveDataIfAvailable reads the last byte then the following "socket dataAvailable" would answer false. So the last byte would be sitting in the inStream missed.

2. #upToAll: in OSS has several problems, for example - #positionOfSubCollection:ifAbsent: which was introduced answers one position too low. This was compensated in upToAll:, but only in the pushBack: call, not the actual result being returned which was cut short 1 byte. Amusingly this makes KomHttpServer not use "Keep-Alive" since the last $e in 'Alive' was cut short. :)

3. SS doesn't inherit from PositionableStream since that just breaks various inherited messages, like for example #skip:. OSS should IMHO be changed to inherit from Object - or of course, replaced in full with SS. :)

4. Since SocketStream by default signals closes and timeouts the SocketStreamTest now passes. The reason for SocketStream to fail is that while it does timeout on a low level (#SocketStream>>receiveData doesn't hang forever) - the callers of #receiveData sometimes loop - like in #next:, and thus eliminates the timeout. SS warns about some methods (in their method comments) not honouring timeouts if shouldSignal is false, I really don't know what they should do in that case:
	#next:, #upTo:, #upToAll: and #upToEnd (and #receiveData:)


The primary reason for the SS implementation is optimal performance. The main differences in implementation with the old OSS are:

1. SS uses two buffers directly (inBuffer and outBuffer) with pointers marking start and stop within the buffer. OSS instead uses two regular streams, a ReadStream and a WriteStream. Using internal buffers makes it possible to avoid copying and reallocation in various ways, it also makes SS be able to have specialized growing/buffer moving behaviour.

2. #upTo:, #upToAll: and #peekForAll: uses selectged String messages that in turn uses fast primitives for searching. OSS used other messages that fell back on byte per byte reading.

3. #receiveData in OSS creates a temporary buffer stream for each call!! During a long read operation, like say #upToAll: (which for example is used when uploading files using HTTP POST forms), this is devastating - especially since the default size is only 2000 bytes - and leads to a very high number of low level read operations on the Socket, typically 100 times more calls than with OSS. The buffer in OSS is held in an instvar (not recreated for each call), is larger from the start and above all - grows dynamically by doubling. OSS can also avoid a grow/reallocation by doing a "move down" if data has been read from the SS as it comes in and through that making room in the lower part of the inBuffer. The net result is that upToAll: for large files is about 10 times faster.

4. The implementation of upTo: and upToAll: tries to avoid doing unnecessary find operations in the buffer and is greedy by default, which means it favors reading more data - if available - before searching for the stop sequence. If we had #findString:startingAt:stoppingAt: this wouldn't have to be greedy and we wouldn't be needlessly scanning dead buffer area. VM hackers? Also, while you are at it - make it work for ByteArrays too. :)


SS can not be run unbuffered, since that seems unneeded. The option to autoFlush is still available, with it set to true SocketStream (just like OSS) will flush on its own on each nextPut:/nextPutAll:, otherwise flushing it will have to be done manually but is done on close.

The first performance tests shows that, as noted above, receiving large amounts of data using #upToAll: is greatly improved - factor of 10. Serving HTTP with small payloads seemed at first not be faster at all - but this is due to the high overhead of Socket connect/close and other things. Increasing payloads show a difference and especially with keep alive on - where the new SS roughly doubles the throughput!!!
!SocketStream methodsFor: 'configuration' stamp: 'gk 2/10/2005 18:03'!
shouldSignal: aBoolean
	"If shouldSignal is enabled the Socket Exceptions
	ConnectionClosed and ConnectionTimedOut will not be swallowed.
	Default is true. And please - don't set it to false - it is better to
	use an exception handler (see below)  and several methods
	in this class will not honour timeouts (says so in their method comments).
	Also, it is quite hard to understand what for example #upToEnd
	should return to indicate a timeout.
	
	Wrap your use of SocketStream with a handler like:
	
	[stuff := mySocketStream next: 10]
		on: ConnectionClosed, ConnectionTimedOut
		do: [:ex |
			Transcript show: 'Oops!! Did not get my ten bytes!!;cr]
	"

	shouldSignal := aBoolean! !

!SocketStream methodsFor: 'stream in' stamp: 'gk 2/3/2005 20:35'!
nextLine
	^self nextLineCrLf! !

!SocketStream methodsFor: 'configuration' stamp: 'gk 2/10/2005 17:59'!
noTimeout
	"Do not use timeout."

	timeout := 0! !

!SocketStream methodsFor: 'private-socket' stamp: 'gk 2/25/2005 14:20'!
receiveData
	"Receive data with timeout if it has been set.
	If shouldSignal is false we use the Socket methods
	that swallow those Exceptions, if it is true the
	caller will have to handle those Exceptions.
	Return the position in the buffer where the
	new data starts, regardless if anything
	was read, see #adjustInBuffer."
	
	recentlyRead := shouldSignal ifTrue: [
		self shouldTimeout ifTrue: [
				socket receiveDataSignallingTimeout: timeout
					into: inBuffer startingAt: inNextToWrite]
			ifFalse: [
				socket receiveDataSignallingClosedInto: inBuffer
					startingAt: inNextToWrite]]
				ifFalse: [
		self shouldTimeout ifTrue: [
			"This case is tricky, if it times out and is swallowed
			how does other methods calling this method repeatedly
			get to know that? And what should they do?"
				socket receiveDataTimeout: timeout
					into: inBuffer startingAt: inNextToWrite]
			ifFalse: [
				socket receiveDataInto: inBuffer
					startingAt: inNextToWrite]].
	^self adjustInBuffer: recentlyRead! !

!SocketStream methodsFor: 'stream out' stamp: 'gk 2/3/2005 20:35'!
crlf
	self nextPutAll: String crlf! !

!SocketStream methodsFor: 'configuration' stamp: 'nice 3/16/2010 22:35'!
binary
	"Tell the SocketStream to send data
	as ByteArrays instead of Strings.
	Default is ascii."

	binary := true.
	inBuffer
		ifNil: [self resetBuffers]
		ifNotNil:
			[inBuffer := inBuffer asByteArray.
			outBuffer := outBuffer asByteArray]! !

!SocketStream methodsFor: 'testing' stamp: 'gk 2/3/2005 20:35'!
isBinary
	^binary! !

!SocketStream methodsFor: 'stream in' stamp: 'ar 2/23/2010 13:06'!
next: n into: aCollection
	"Read n objects into the given collection.
	Return aCollection or a partial copy if less than
	n elements have been read."
	^self next: n into: aCollection startingAt: 1! !

!SocketStream methodsFor: 'stream in' stamp: 'ar 2/23/2010 13:06'!
nextInto: aCollection
	"Read the next elements of the receiver into aCollection.
	Return aCollection or a partial copy if less than aCollection
	size elements have been read."
	^self next: aCollection size into: aCollection startingAt: 1.! !

!SocketStream methodsFor: 'stream in' stamp: 'nice 1/13/2010 23:16'!
peekFor: aCharacterOrByte
	"Read and return next character or byte
	if it is equal to the argument.
	Otherwise return false."

	| nextObject |
	self atEnd ifTrue: [^false].
	self isInBufferEmpty ifTrue: 
		[self receiveData.
		self atEnd ifTrue: [^false]].
	nextObject := inBuffer at: lastRead + 1.
	nextObject = aCharacterOrByte ifTrue: [
		lastRead := lastRead + 1.
		^true].
	^false
! !

!SocketStream methodsFor: 'stream in' stamp: 'gk 2/15/2005 14:16'!
peekForAll: aString
	"Answer whether or not the next string of characters in the receiver
	matches aString. If a match is made, advance over that string in the receiver and
	answer true. If no match, then leave the receiver alone and answer false.
	We use findString:startingAt: to avoid copying.

	NOTE: This method doesn't honor timeouts if shouldSignal is false!!"

	| sz start |
	sz := aString size.
	self receiveData: sz.
	(inNextToWrite - lastRead - 1) < sz ifTrue: [^false].
	start := lastRead + 1.
	(inBuffer findString: aString startingAt: start) = start
		ifFalse: [^false].
	lastRead := lastRead + sz.
	^true! !

!SocketStream methodsFor: 'private-socket' stamp: 'gk 2/25/2005 14:20'!
receiveAvailableData
	"Receive available data (as much as fits in the inBuffer)
	but not waiting for more to arrive.
	Return the position in the buffer where the
	new data starts, regardless if anything
	was read, see #adjustInBuffer."
	
	recentlyRead := socket receiveAvailableDataInto: inBuffer startingAt: inNextToWrite.
	^self adjustInBuffer: recentlyRead! !

!SocketStream methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 11:05'!
initialize
	super initialize.
	autoFlush := true.
	shouldSignal := true.
	recentlyRead := 0.
	bufferSize := 4096.
	self ascii! !

!SocketStream methodsFor: 'stream in' stamp: 'gk 2/24/2005 12:01'!
nextLineCrLf
	^self upToAll: String crlf! !

!SocketStream methodsFor: 'configuration' stamp: 'gk 2/9/2005 22:27'!
autoFlush: aBoolean
	"If autoFlush is enabled data will be sent through
	the socket (flushed) when the bufferSize is reached
	or the SocketStream is closed. Otherwise the user
	will have to send #flush manually.
	Close will always flush. Default is false."

	autoFlush := aBoolean! !

!SocketStream methodsFor: 'private' stamp: 'gk 2/9/2005 22:35'!
streamBuffer: size
	"Create a buffer of the correct class and given size."

	^(self isBinary
		ifTrue: [ByteArray]
		ifFalse: [String]) new: size! !

!SocketStream methodsFor: 'control' stamp: 'sd 8/8/2010 19:37'!
receiveData: nBytes
	"Keep reading the socket until we have nBytes
	in the inBuffer or we reach the end. This method
	does not return data, but can be used to make sure
	data has been read into the buffer from the Socket
	before actually reading it from the FastSocketStream.
	Mainly used internally. We could also adjust the buffer
	to the expected amount of data and avoiding several
	incremental grow operations.

	NOTE: This method doesn't honor timeouts if shouldSignal
	is false!! And frankly, I am not sure how to handle that
	case or if I care - I think we should always signal."

	[self isConnected and: [nBytes > self inBufferSize]]
		whileTrue: [self receiveData]! !

!SocketStream methodsFor: 'testing' stamp: 'mir 4/25/2007 16:42'!
isStream
	^true! !

!SocketStream methodsFor: 'configuration' stamp: 'gk 2/3/2005 20:35'!
socket: aSocket
	socket := aSocket! !

!SocketStream methodsFor: 'configuration' stamp: 'nice 3/16/2010 22:34'!
ascii
	"Tell the SocketStream to send data
	as Strings instead of ByteArrays.
	This is default."

	binary := false.
	inBuffer
		ifNil: [self resetBuffers]
		ifNotNil:
			[inBuffer := inBuffer asString.
			outBuffer := outBuffer asString]! !

!SocketStream methodsFor: 'configuration' stamp: 'gk 2/3/2005 20:35'!
timeout: seconds
	timeout := seconds! !

!SocketStream methodsFor: 'testing' stamp: 'gk 2/3/2005 20:35'!
shouldTimeout
	^self timeout > 0! !

!SocketStream methodsFor: 'stream in' stamp: 'ar 1/13/2010 22:30'!
peek
	"Return next byte, if inBuffer is empty
	we recieve some more data and try again.
	Do not consume the byte."

	self atEnd ifTrue: [^nil].
	self isInBufferEmpty ifTrue:
		[self receiveData.
		self atEnd ifTrue: [^nil]].
	^inBuffer at: lastRead+1! !

!SocketStream methodsFor: 'configuration' stamp: 'gk 2/10/2005 18:00'!
shouldSignal
	"If shouldSignal is enabled the Socket Exceptions
	ConnectionClosed and ConnectionTimedOut
	will not be swallowed. Default is true.
	For more info, see #shouldSignal:"

	^shouldSignal! !

!SocketStream methodsFor: 'configuration' stamp: 'gk 2/9/2005 22:28'!
bufferSize
	"Default buffer size is 4kb.
	increased from earlier 2000 bytes."
	
	^bufferSize! !

!SocketStream methodsFor: 'stream out' stamp: 'gk 9/9/2005 09:32'!
sendCommand: aString
	"Sends a String ending it with CR LF and then flush
	causing it to block until sent."

	self nextPutAll: aString, String crlf; flush! !

!SocketStream methodsFor: 'stream out' stamp: 'gk 2/10/2005 11:14'!
nextPutAllFlush: aCollection
	"Put a String or a ByteArray onto the stream.
	You can use this if you have very large data - it avoids
	copying into the buffer (and avoids buffer growing)
	and also flushes any other pending data first."

	| toPut |
	toPut := binary ifTrue: [aCollection asByteArray] ifFalse: [aCollection asString].
	self flush. "first flush pending stuff, then directly send"
	socket isOtherEndClosed ifFalse: [
		[socket sendData: toPut count: toPut size]
			on: ConnectionTimedOut
			do: [:ex | shouldSignal ifFalse: ["swallow"]]]! !

!SocketStream methodsFor: 'configuration' stamp: 'gk 2/10/2005 17:59'!
outBufferSize
	"Answers the current size of data in the outBuffer."

	^outNextToWrite - 1! !

!SocketStream methodsFor: 'testing' stamp: 'gk 2/7/2005 13:02'!
isEmpty
	"Test if there are more data to read."

	^self isInBufferEmpty and: [self isDataAvailable not]! !

!SocketStream methodsFor: 'control' stamp: 'StephaneDucasse 8/8/2010 18:18'!
destroy
	"Destroy the receiver and its underlying socket. Does not attempt to flush the output buffers. For a graceful close use SocketStream>>close instead."
	socket ifNotNil: [socket destroy]! !

!SocketStream methodsFor: 'private' stamp: 'gk 2/7/2005 13:09'!
checkFlush
	"If autoFlush is true we flush if
	we have reached the bufferSize
	of data in the outBuffer."

	(autoFlush and: [outNextToWrite > bufferSize])
		ifTrue: [self flush]! !

!SocketStream methodsFor: 'stream in' stamp: 'SvenVanCaekenberghe 4/17/2013 09:21'!
next: anInteger
	"Read count elements and return them in a collection.
	If the receiver is #atEnd before count elements were read, 
	return a smaller collection and don't signal ConnectionClosed."

	^ self nextInto: (self streamBuffer: anInteger)! !

!SocketStream methodsFor: 'configuration' stamp: 'gk 2/3/2005 20:35'!
socket
	^socket! !

!SocketStream methodsFor: 'private' stamp: 'gk 2/9/2005 22:44'!
adjustInBuffer: bytesRead
	"Adjust markers and possibly grow inBuffer or move data down.
	Currently grows through doubling when less than 1024 bytes are left.
	Never shrinks. Returns the position in the buffer where any new
	data can be found."

	| old |
	bytesRead = 0 ifTrue: [^inNextToWrite].
	old := inNextToWrite.
	inNextToWrite := inNextToWrite + bytesRead.
	(inBuffer size - inNextToWrite) < 1024
		ifTrue: [
			"Hit the roof, move data down (if enough has been read) or do we grow?"
			(lastRead > 512)
				ifTrue: [^old - self moveInBufferDown]
				ifFalse: [self growInBuffer]].
	^old! !

!SocketStream methodsFor: 'private' stamp: 'tbn 12/6/2012 11:59'!
position
	^lastRead! !

!SocketStream methodsFor: 'testing' stamp: 'mir 4/22/2007 23:51'!
ifStale: aBlock
	self isConnected
		ifFalse: aBlock! !

!SocketStream methodsFor: 'stream in' stamp: 'gk 2/7/2005 13:47'!
nextAvailable
	"Answer all the data currently available,
	in buffer or in socket."

	self isInBufferEmpty ifFalse: [^self nextAllInBuffer].
	self isDataAvailable ifTrue: [self receiveData].
	^self nextAllInBuffer! !

!SocketStream methodsFor: 'private' stamp: 'gk 9/9/2005 02:29'!
resizeInBuffer: newSize
	"Resize the inBuffer by recreating it.
	This also has the effect of getting rid of
	dead data above inNextToWrite.
	<newSize> must >= inBuffer size!!"

	inBuffer := (self streamBuffer: newSize)
					replaceFrom: 1 to: inNextToWrite - 1 with: inBuffer startingAt: 1! !

!SocketStream methodsFor: 'stream out' stamp: 'nice 3/17/2010 20:27'!
next: n putAll: aCollection startingAt: startIndex
	"Put a String or a ByteArray onto the stream.
	Currently a large collection will allocate a large buffer.
	Warning: this does not work with WideString: they have to be converted first."

	self adjustOutBuffer: n.
	outBuffer replaceFrom: outNextToWrite to: outNextToWrite + n - 1 with: aCollection startingAt: startIndex.
	outNextToWrite := outNextToWrite + n.
	self checkFlush.
	^aCollection! !

!SocketStream methodsFor: 'configuration' stamp: 'gk 2/9/2005 22:28'!
bufferSize: anInt
	"Default buffer size is 4kb.
	increased from earlier 2000 bytes."

	bufferSize := anInt! !

!SocketStream methodsFor: 'testing' stamp: 'gk 2/24/2005 12:23'!
isDataAvailable
	"It the inbuffer is empty, we check the socket for data.
	If it claims to have data available to read, we try to read
	some once and recursively call this method again.
	If something really was available it is now in the inBuffer.
	This is because there has been spurious
	dataAvailable when there really is no data to get."
 
	self isInBufferEmpty ifFalse: [^true].
	^socket dataAvailable
		ifFalse: [false]
		ifTrue: [self receiveDataIfAvailable; isDataAvailable]! !

!SocketStream methodsFor: 'private' stamp: 'gk 2/9/2005 22:42'!
adjustOutBuffer: bytesToWrite
	"Possibly grow outBuffer to accommodate the new data.
	Currently grows through doubling when less
	than 1024 bytes are left. If bytesToWrite is even
	larger we double that instead. Never shrinks."

	(outBuffer size - outNextToWrite - bytesToWrite) < 1024 ifTrue: [
		outBuffer := (self streamBuffer: ((outBuffer size max: bytesToWrite) * 2))
						replaceFrom: 1 to: outBuffer size with: outBuffer startingAt: 1]! !

!SocketStream methodsFor: 'stream in' stamp: 'gk 2/7/2005 21:26'!
nextAllInBuffer
	"Return all data currently in the inBuffer,"

	^self nextInBuffer: inNextToWrite - lastRead - 1! !

!SocketStream methodsFor: 'stream in' stamp: 'gk 2/15/2005 14:15'!
skip: anInteger
	"Skip a number of bytes.
	This is faster than #next: since it does not
	have to copy and return a new String or ByteArray.

	NOTE: This method doesn't honor timeouts if shouldSignal is false!!"

	self receiveData: anInteger.
	lastRead := (lastRead + anInteger) min: inNextToWrite - 1! !

!SocketStream methodsFor: 'stream in' stamp: 'gk 2/7/2005 13:02'!
nextAvailable: howMany
	"Answer all the data currently available,
	in buffer or in socket - but limited to <howMany>."

	self isInBufferEmpty ifFalse: [^self nextInBuffer: howMany].
	self isDataAvailable ifTrue: [self receiveData].
	^self nextInBuffer: howMany! !

!SocketStream methodsFor: 'stream in' stamp: 'ar 8/2/2010 18:48'!
upToAll: aStringOrByteArray
	"Answer a subcollection from the current access position to the occurrence (if any, but not inclusive) of aCollection. If aCollection is not in the stream, answer the entire rest of the stream."

	"Note: The 100k limit below is compatible with the previous version though arguably incorrect. If you need unbounded behavior either up the argument or provide nil in which case we'll read until we get it or run out of memory"

	^self upToAll: aStringOrByteArray limit: 100000! !

!SocketStream methodsFor: 'control' stamp: 'gk 2/24/2005 11:55'!
close
	"Flush any data still not sent
	and take care of the socket."

	self flush.
	socket closeAndDestroy: 30! !

!SocketStream methodsFor: 'configuration' stamp: 'gk 2/10/2005 17:58'!
inBufferSize
	"Answers the current size of data in the inBuffer."

	^inNextToWrite - lastRead - 1! !

!SocketStream methodsFor: 'stream in' stamp: 'gk 2/7/2005 13:33'!
next
	"Return next byte, if inBuffer is empty
	we recieve some more data and try again."

	self atEnd ifTrue: [^nil].
	self isInBufferEmpty ifTrue:
		[self receiveData.
		self atEnd ifTrue: [^nil]].
	lastRead := lastRead + 1.
	^inBuffer at: lastRead! !

!SocketStream methodsFor: 'configuration' stamp: 'gk 2/7/2005 08:41'!
timeout
	"Lazily initialized unless it has been set explicitly."

	timeout ifNil: [timeout := Socket standardTimeout].
	^timeout! !

!SocketStream methodsFor: 'printing' stamp: 'md 7/14/2006 12:28'!
print: anObject
	anObject printOn: self! !

!SocketStream methodsFor: 'stream in' stamp: 'DanielAviv 1/29/2013 14:54'!
upTo: aCharacterOrByte limit: nBytes
	"Return data up to, but not including given character or byte. If the character is not in the stream, or not found within nBytes answer the available contents of the stream"

	| index result searchedSoFar |
	"Look in the current inBuffer first"
	index := inBuffer indexOf: aCharacterOrByte startingAt: lastRead + 1.

	(index > 0 and: [(index + 1) <= inNextToWrite]) ifTrue: ["found it"
		result := self nextInBuffer: index - lastRead - 1.
		self skip: 1.
		^ result
	].

	[searchedSoFar :=  self inBufferSize.
	"Receive more data"
	self receiveData.
	"We only get recentlyRead = 0 in the case of a non-signaling socket close."
	recentlyRead > 0] whileTrue:[
		"Data begins at lastRead + 1, we add searchedSoFar as offset."

		index := inBuffer indexOf: aCharacterOrByte
						startingAt: (lastRead + searchedSoFar + 1).
		(index > 0 and: [(index + 1) <= inNextToWrite]) ifTrue: ["found it"
			result := self nextInBuffer: index - lastRead - 1.
			self skip: 1.
			^ result
		].

		"Check if we've exceeded the max. amount"
		(nBytes notNil and:[inNextToWrite - lastRead > nBytes]) 
			ifTrue:[^self nextAllInBuffer].
	].

	"Windows doesn't raise an Exception when connection is closed at first, so we check here the status of the connection"
	self shouldSignal ifTrue: [
		self isOtherEndConnected ifFalse: [ConnectionClosed signal: 'Connection closed while waiting for data.'].
	].

	"not found and (non-signaling) connection was closed"
	^self nextAllInBuffer! !

!SocketStream methodsFor: 'stream in' stamp: 'ar 2/23/2010 13:06'!
nextInto: aCollection startingAt: startIndex
	"Read the next elements of the receiver into aCollection.
	Return aCollection or a partial copy if less than aCollection
	size elements have been read."
	^self next: (aCollection size - startIndex+1) into: aCollection startingAt: startIndex.! !

!SocketStream methodsFor: 'stream in' stamp: 'DanielAviv 1/29/2013 14:54'!
upToAll: aStringOrByteArray limit: nBytes
	"Answer a subcollection from the current access position to the occurrence (if any, but not inclusive) of aStringOrByteArray. If aCollection is not in the stream, or not found within nBytes answer the available contents of the stream"

	| index sz result searchedSoFar |
	sz := aStringOrByteArray size.
	"Look in the current inBuffer first"
	index := inBuffer indexOfSubCollection: aStringOrByteArray
						startingAt: lastRead - sz + 2.
	(index > 0 and: [(index + sz) <= inNextToWrite]) ifTrue: ["found it"
		result := self nextInBuffer: index - lastRead - 1.
		self skip: sz.
		^ result
	].

	[searchedSoFar :=  self inBufferSize.
	"Receive more data"
	self receiveData.
	recentlyRead > 0] whileTrue:[

		"Data begins at lastRead + 1, we add searchedSoFar as offset and 
		backs up sz - 1 so that we can catch any borderline hits."

		index := inBuffer indexOfSubCollection: aStringOrByteArray
						startingAt: (lastRead + searchedSoFar - sz + 2 max: 1).
		(index > 0 and: [(index + sz) <= inNextToWrite]) ifTrue: ["found it"
			result := self nextInBuffer: index - lastRead - 1.
			self skip: sz.
			^ result
		].
		"Check if we've exceeded the max. amount"
		(nBytes notNil and:[inNextToWrite - lastRead > nBytes]) 
			ifTrue:[^self nextAllInBuffer].
	].

	"Windows doesn't raise an Exception when connection is closed at first, so we check here the status of the connection"
	self shouldSignal ifTrue: [
		self isOtherEndConnected ifFalse: [ConnectionClosed signal: 'Connection closed while waiting for data.'].
	].

	"not found and (non-signaling) connection was closed"
	^self nextAllInBuffer! !

!SocketStream methodsFor: 'private' stamp: 'kph 11/6/2008 16:43'!
<< items

 	items putOn: self.
	
	^ self! !

!SocketStream methodsFor: 'private' stamp: 'gk 2/7/2005 23:05'!
growInBuffer
	"Grows through doubling."

	self resizeInBuffer: inBuffer size * 2! !

!SocketStream methodsFor: 'printing' stamp: 'gk 2/10/2005 11:44'!
printOn: aStream
	"Display buffer sizes."

	aStream nextPutAll: self class name.
	inBuffer ifNotNil: [
		aStream nextPutAll: '[inbuf:',
		(inBuffer size / 1024) rounded asString, 'kb/outbuf:',
		(outBuffer size / 1024) rounded asString, 'kb]']! !

!SocketStream methodsFor: 'configuration' stamp: 'gk 2/9/2005 22:26'!
autoFlush
	"If autoFlush is enabled data will be sent through
	the socket (flushed) when the bufferSize is reached
	or the SocketStream is closed. Otherwise the user
	will have to send #flush manually.
	Close will always flush. Default is false."

	^autoFlush! !

!SocketStream methodsFor: 'stream out' stamp: 'nice 3/19/2010 19:14'!
nextPutAll: aCollection
	"Put a String or a ByteArray onto the stream.
	Currently a large collection will allocate a large buffer."

	| toPut |
	toPut := binary ifTrue: [aCollection asByteArray] ifFalse: [aCollection asString].
	self adjustOutBuffer: toPut size.
	outBuffer replaceFrom: outNextToWrite to: outNextToWrite + toPut size - 1 with: toPut startingAt: 1.
	outNextToWrite := outNextToWrite + toPut size.
	self checkFlush.
	^aCollection! !

!SocketStream methodsFor: 'private-socket' stamp: 'gk 2/9/2005 22:53'!
receiveDataIfAvailable
	"Only used to check that there really is data to read
	from the socket after it signals dataAvailable.
	It has been known to signal true and then still
	not have anything to read. See also isDataAvailable.
	Return the position in the buffer where the
	new data starts, regardless if anything
	was read, see #adjustInBuffer."

	recentlyRead := socket receiveSomeDataInto: inBuffer startingAt: inNextToWrite.
	^self adjustInBuffer: recentlyRead! !

!SocketStream methodsFor: 'testing' stamp: 'gk 2/7/2005 13:02'!
isInBufferEmpty
	"Any data in the buffer?"
 
	^lastRead + 1 = inNextToWrite! !

!SocketStream methodsFor: 'stream in' stamp: 'gk 2/15/2005 14:16'!
peek: anInteger
	"Answer anInteger bytes of data.
	Do not consume data.

	NOTE: This method doesn't honor timeouts if shouldSignal is false!!"

	| start |
	self receiveData: anInteger.
	start := lastRead + 1.
	^inBuffer copyFrom: start to: ((lastRead + anInteger) min: inNextToWrite - 1).! !

!SocketStream methodsFor: 'stream out' stamp: 'gk 2/3/2005 20:35'!
cr
	self nextPutAll: String cr! !

!SocketStream methodsFor: 'private' stamp: 'gk 2/8/2005 22:15'!
moveInBufferDown
	"Move down contents of inBuffer to the start.
	Return distance moved."

	| sz distanceMoved |
	sz := inNextToWrite - lastRead - 1.
	inBuffer replaceFrom: 1 to: sz with: inBuffer startingAt: lastRead + 1.
	distanceMoved := lastRead.
	lastRead := 0.
	inNextToWrite := sz + 1.
	^distanceMoved
! !

!SocketStream methodsFor: 'stream in' stamp: 'gk 2/15/2005 14:16'!
nextLineLf
	| nextLine |
	nextLine := self upToAll: String lf.
	^nextLine! !

!SocketStream methodsFor: 'stream in' stamp: 'gk 2/7/2005 12:51'!
nextInBuffer: anInteger
	"Answer anInteger bytes of data at most,
	but only from the inBuffer."

	| start amount |
	amount := anInteger min: (inNextToWrite - lastRead - 1).
	start := lastRead + 1.
	lastRead := lastRead + amount.
	^inBuffer copyFrom: start to: lastRead! !

!SocketStream methodsFor: 'testing' stamp: 'gk 2/25/2005 14:23'!
atEnd
	"There is nothing more to read when
	there is no more data in our inBuffer, the socket
	is disconnected and there is none available on the socket.
	Note that we need to check isConnected before isDataAvailable,
	otherwise data may sneak in in the meantime. But we check the
	buffer first, because it is faster."

	self isInBufferEmpty ifFalse: [^false].
	^self isConnected not
		and: [self isDataAvailable not]! !

!SocketStream methodsFor: 'stream out' stamp: 'md 2/24/2006 19:51'!
nextPut: char
	"Put a single Character or byte onto the stream."

	| toPut |
	toPut := binary ifTrue: [char asInteger] ifFalse: [char asCharacter].
	self adjustOutBuffer: 1.
	outBuffer at: outNextToWrite put: toPut.
	outNextToWrite := outNextToWrite + 1.
	self checkFlush.
	"return the argument - added by kwl"
	^ char! !

!SocketStream methodsFor: 'testing' stamp: 'gk 2/7/2005 12:24'!
isConnected
	"The stream is connected if the socket is."

	^socket isConnected! !

!SocketStream methodsFor: 'stream out' stamp: 'gk 2/3/2005 20:35'!
space
	self nextPut: Character space! !

!SocketStream methodsFor: 'control' stamp: 'gk 9/9/2005 09:33'!
flush
	"If the other end is connected and we have something
	to send, then we send it and reset the outBuffer."

	((outNextToWrite > 1) and: [socket isOtherEndClosed not])
		ifTrue: [
			[socket sendData: outBuffer count: outNextToWrite - 1]
				on: ConnectionTimedOut
				do: [:ex | shouldSignal ifFalse: ["swallow"]].
			outNextToWrite := 1]! !

!SocketStream methodsFor: 'stream in' stamp: 'NickPapoulias 10/18/2013 13:31'!
upTo: aCharacterOrByte
	"Answer a subcollection from the current access position to the occurrence (if any, but not inclusive) of anObject in the receiver. If  anObject is not in the collection, answer the entire rest of the receiver."

	"Note: The 100k limit below is compatible with the previous version though arguably incorrect. If you need unbounded behavior either up the argument or provide nil in which case we'll read until we get it or run out of memory"

	^ binary 
		ifTrue: [self upTo: aCharacterOrByte asInteger limit: 100000]
		ifFalse: [ self upTo: aCharacterOrByte asCharacter limit: 100000]! !

!SocketStream methodsFor: 'testing' stamp: 'gk 2/7/2005 08:59'!
isOtherEndConnected
	^socket isOtherEndClosed not! !

!SocketStream methodsFor: 'printing' stamp: 'gk 2/25/2005 14:19'!
debug
	"Display debug info."

	| data |
	data := self inBufferSize.
	^String streamContents: [:s |
		s
			nextPutAll: 'Buffer size: ', inBuffer size asString;cr;
			nextPutAll: 'InBuffer data size: ', data asString; cr;
			nextPutAll: 'In data (20):', (inBuffer copyFrom: lastRead + 1 to: lastRead + (data min: 20)); cr;
			nextPutAll: 'OutBuffer data size: ', (outNextToWrite - 1) asString; cr;
			nextPutAll: 'Out data (20):', (outBuffer copyFrom: 1 to: ((outNextToWrite - 1) min: 20)); cr]! !

!SocketStream methodsFor: 'stream in' stamp: 'sd 8/8/2010 19:37'!
upToEnd
	"Answer all data coming in on the socket until the socket
	is closed by the other end, or we get a timeout.
	This means this method catches ConnectionClosed by itself.
	
	NOTE: Does not honour timeouts if shouldSignal is false!!"

	[[self isConnected] whileTrue: [self receiveData]]
		on: ConnectionClosed
		do: [:ex | "swallow it"]. 
	^self nextAllInBuffer! !

!SocketStream methodsFor: 'private' stamp: 'gk 2/9/2005 22:36'!
resetBuffers
	"Recreate the buffers with default start sizes."

	inBuffer := self streamBuffer: bufferSize.
	lastRead := 0.
	inNextToWrite := 1.
	outBuffer := self streamBuffer: bufferSize.
	outNextToWrite := 1! !

!SocketStream methodsFor: 'stream in' stamp: 'SvenVanCaekenberghe 4/26/2011 09:17'!
next: requestedCount into: collection startingAt: startIndex
	"Read requestedCount objects into the given collection. 
	Return collection or a partial copy if less elements have been read."

	| readCount |
	readCount := self readInto: collection startingAt: startIndex count: requestedCount.
	^ readCount = requestedCount
		ifTrue: [ ^ collection ]
		ifFalse: [ ^ collection copyFrom: 1 to: startIndex + readCount - 1 ]! !

!SocketStream methodsFor: 'control' stamp: 'gk 2/9/2005 23:08'!
recentlyRead
	"Return the number of bytes read
	during the last socket operation."
	
	^recentlyRead! !

!SocketStream methodsFor: 'stream in' stamp: 'nice 3/16/2010 23:02'!
readInto: aCollection startingAt: startIndex count: anInteger
	"Read n objects into the given collection starting at startIndex. 
	Return number of elements that have been read."

	"Implementation note: This method DOES signal timeout if not 
	enough elements are received. It does NOT signal
	ConnectionClosed as closing the connection is the only way by
	which partial data can be read."

	| start amount |

	[self receiveData: anInteger] on: ConnectionClosed do:[:ex| ex return].

	"Inlined version of nextInBuffer: to avoid copying the contents"
	amount := anInteger min: (inNextToWrite - lastRead - 1).
	start := lastRead + 1.
	lastRead := lastRead + amount.
	aCollection 
		replaceFrom: startIndex 
		to: startIndex + amount-1 
		with: inBuffer 
		startingAt: start.
	^amount! !

!SocketStream class methodsFor: 'instance creation' stamp: 'gk 2/3/2005 20:35'!
openConnectionToHostNamed: hostName port: portNumber
	| hostIP |
	hostIP := NetNameResolver addressForName: hostName timeout: 20.
	^self openConnectionToHost: hostIP port: portNumber! !

!SocketStream class methodsFor: 'instance creation' stamp: 'gk 2/3/2005 22:19'!
on: socket
	"Create a socket stream on a connected server socket."

	^self basicNew initialize socket: socket! !

!SocketStream class methodsFor: 'example' stamp: 'md 8/14/2005 18:25'!
finger: userName
	"SocketStream finger: 'stp'"

	| addr s |
	addr := NetNameResolver promptUserForHostAddress.
	s := SocketStream openConnectionToHost: addr port: 79.  "finger port number"
	Transcript show: '---------- Connecting ----------'; cr.
	s sendCommand: userName.
	Transcript show: s getLine.
	s close.
	Transcript show: '---------- Connection Closed ----------'; cr; endEntry.
! !

!SocketStream class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 4/24/2011 20:23'!
openConnectionToHost: hostIP port: portNumber
	^ self openConnectionToHost: hostIP port: portNumber timeout: Socket standardTimeout
! !

!SocketStream class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 4/24/2011 20:21'!
openConnectionToHost: hostIP port: portNumber timeout: timeout
	| socket |
	socket := Socket new.
	socket connectTo: hostIP port: portNumber waitForConnectionFor: timeout.
	^self on: socket! !

!SocketStreamTest commentStamp: 'TorstenBergmann 2/5/2014 10:11'!
SUnit tests for socket streams!
!SocketStreamTest methodsFor: 'stream protocol' stamp: 'CamilloBruni 9/1/2013 03:08'!
testUpToAllAfterCloseNonSignaling
	"Tests correct behavior of #upToAll"

	| resp |
	clientStream nextPutAll: 'A line of text'.
	clientStream close.
	serverStream shouldSignal: false.
	resp := serverStream upToAll: String crlf.
	self assert: resp = 'A line of text'.! !

!SocketStreamTest methodsFor: 'stream protocol' stamp: 'ar 8/2/2010 18:49'!
testUpToMax
	"Tests correct behavior of #upToAll:max:"

	clientStream nextPutAll:'A line of text'; flush.
	self assert: (serverStream upTo: Character cr limit: 5) = 'A line of text'.! !

!SocketStreamTest methodsFor: 'stream protocol' stamp: 'ar 8/5/2010 12:20'!
testNextIntoCloseNonSignaling
	"Ensure that #next:into: will function properly when the connection is closed"

	serverStream shouldSignal: false.
	clientStream nextPutAll:'A line of text'; flush.
	[(Delay forMilliseconds: 100) wait.
	clientStream close] fork.
	self assert: (serverStream next: 100 into: (String new: 100) startingAt: 1)
		equals: 'A line of text'.
! !

!SocketStreamTest methodsFor: 'stream protocol' stamp: 'ar 8/2/2010 18:29'!
testUpToAll
	"Tests correct behavior of #upToAll"

	clientStream nextPutAll:'A line of text', String crlf, 'with more text'; flush.
	self assert: (serverStream upToAll: String crlf) = 'A line of text'.
	[(Delay forSeconds: 1) wait.
	clientStream nextPutAll: String crlf; flush] fork.
	self assert: (serverStream upToAll: String crlf) = 'with more text'.
! !

!SocketStreamTest methodsFor: 'stream protocol' stamp: 'NickPapoulias 10/18/2013 11:48'!
testUpToSmallInteger
	"Tests correct behavior of #upTo:"

	clientStream nextPutAll:'A line of text', String cr, 'with more text'; flush.
	self assert: (serverStream upTo: Character cr) = 'A line of text'.
	[(Delay forSeconds: 1) wait.
	clientStream nextPutAll: String cr; flush] fork.
	self assert: (serverStream upTo: 13) = 'with more text'.
! !

!SocketStreamTest methodsFor: 'setup' stamp: 'ar 8/2/2010 17:59'!
tearDown
	clientStream ifNotNil:[clientStream destroy].
	serverStream ifNotNil:[serverStream destroy].! !

!SocketStreamTest methodsFor: 'stream protocol' stamp: 'ar 8/5/2010 12:20'!
testNextIntoClose
	"Ensure that #next:into: will function properly when the connection is closed"

	clientStream nextPutAll:'A line of text'; flush.
	[(Delay forMilliseconds: 100) wait.
	clientStream close] fork.
	self assert: (serverStream next: 100 into: (String new: 100) startingAt: 1) 
		equals: 'A line of text'.
! !

!SocketStreamTest methodsFor: 'stream protocol' stamp: 'ar 8/2/2010 18:32'!
testUpToAfterCloseSignaling
	"Tests correct behavior of #upToAll"

	clientStream nextPutAll:'A line of text'.
	clientStream close.
	self should: [serverStream upTo: Character cr] raise: ConnectionClosed.
! !

!SocketStreamTest methodsFor: 'setup' stamp: 'ar 8/2/2010 18:10'!
setUp
	| listener clientSocket serverSocket |
	listener := Socket newTCP.
	[listener listenOn: 0 backlogSize: 4.

	clientSocket := Socket newTCP.
	clientSocket connectTo: #[127 0 0 1] port: listener localPort.
	clientSocket waitForConnectionFor: 1.
	self assert: clientSocket isConnected.

	serverSocket := listener waitForAcceptFor: 1.
	self assert: serverSocket isConnected.
	] ensure:[listener destroy].

	clientStream := SocketStream on: clientSocket.
	serverStream := SocketStream on: serverSocket.
! !

!SocketStreamTest methodsFor: 'stream protocol' stamp: 'CamilloBruni 9/1/2013 03:08'!
testUpToAfterCloseNonSignaling
	"Tests correct behavior of #upToAll"

	| resp |
	clientStream nextPutAll: 'A line of text'.
	clientStream close.
	serverStream shouldSignal: false.
	resp := serverStream upTo: Character cr.
	self assert: resp = 'A line of text'.! !

!SocketStreamTest methodsFor: 'stream protocol' stamp: 'ar 8/2/2010 18:26'!
testUpToAllAfterCloseSignaling
	"Tests correct behavior of #upToAll"

	clientStream nextPutAll:'A line of text'.
	clientStream close.
	self should: [serverStream upToAll: String crlf] raise: ConnectionClosed.
! !

!SocketStreamTest methodsFor: 'stream protocol' stamp: 'ar 8/2/2010 18:11'!
testUpToAllTimeout
	"Tests correct behavior of #upToAll"

	clientStream nextPutAll: 'A line of text'.
	serverStream timeout: 1.
	self should: [serverStream upToAll: String crlf] raise: ConnectionTimedOut.
! !

!SocketStreamTest methodsFor: 'stream protocol' stamp: 'ar 8/2/2010 18:32'!
testUpTo
	"Tests correct behavior of #upTo:"

	clientStream nextPutAll:'A line of text', String cr, 'with more text'; flush.
	self assert: (serverStream upTo: Character cr) = 'A line of text'.
	[(Delay forSeconds: 1) wait.
	clientStream nextPutAll: String cr; flush] fork.
	self assert: (serverStream upTo: Character cr) = 'with more text'.
! !

!SocketStreamTest methodsFor: 'stream protocol' stamp: 'ar 8/2/2010 18:32'!
testUpToTimeout
	"Tests correct behavior of #upToAll"

	clientStream nextPutAll: 'A line of text'.
	serverStream timeout: 1.
	self should: [serverStream upTo: Character cr] raise: ConnectionTimedOut.
! !

!SocketStreamTest methodsFor: 'stream protocol' stamp: 'ar 8/2/2010 18:48'!
testUpToAllLimit
	"Tests correct behavior of #upToAll:limit:"

	clientStream nextPutAll:'A line of text'; flush.
	self assert: (serverStream upToAll: String crlf limit: 5) = 'A line of text'.! !

!SocketStreamTest methodsFor: 'stream protocol' stamp: 'ar 8/5/2010 12:20'!
testUpToEndClose
	"Ensure that #upToEnd will function properly when the connection is closed"

	clientStream nextPutAll:'A line of text'; flush.
	[(Delay forMilliseconds: 100) wait.
	clientStream close] fork.
	self assert: (serverStream upToEnd) 
		equals: 'A line of text'.
! !

!SocketStreamTest methodsFor: 'stream protocol' stamp: 'ar 8/5/2010 12:20'!
testUpToEndCloseNonSignaling
	"Ensure that #upToEnd will function properly when the connection is closed"

	serverStream shouldSignal: false.
	clientStream nextPutAll:'A line of text'; flush.
	[(Delay forMilliseconds: 100) wait.
	clientStream close] fork.
	self assert: (serverStream upToEnd)
		equals: 'A line of text'.
! !

!SocketStreamTest methodsFor: 'stream protocol' stamp: 'NickPapoulias 10/18/2013 14:10'!
testUpToWithByteArray
	"Tests correct behavior of #upTo:"

	|byteArray|
	
	byteArray := ('A line of text', String cr, 'with more text') asByteArray.
	clientStream binary.
	serverStream binary.
	clientStream nextPutAll: byteArray; flush.
	self assert: (serverStream upTo: Character cr) asString = 'A line of text'.
	[(Delay forSeconds: 1) wait.
	clientStream nextPut: Character cr; flush] fork.
	self assert: (serverStream upTo: Character cr) asString = 'with more text'.
! !

!SocketTest commentStamp: 'TorstenBergmann 2/5/2014 10:11'!
SUnit tests for sockets!
!SocketTest methodsFor: 'setup' stamp: 'SvenVanCaekenberghe 4/15/2011 12:10'!
listenerAddress
	^NetNameResolver loopBackAddress
! !

!SocketTest methodsFor: 'tests' stamp: 'ar 11/26/2010 10:25'!
testServerAccept
	"Tests a server-side accept"

	self testClientConnect.
	serverSocket := listenerSocket waitForAcceptFor: 2.
	self assert: (serverSocket notNil).
	self assert: (serverSocket isConnected).
! !

!SocketTest methodsFor: 'tests' stamp: 'SvenVanCaekenberghe 4/15/2011 12:21'!
testRemoteAddress
	"Tests the various remoteAddress values for sockets"

	self testServerAccept.
	self assert: listenerSocket remoteAddress = #[0 0 0 0].
	self assert: clientSocket remoteAddress asSocketAddress = self listenerAddress.
	self assert: serverSocket remoteAddress asSocketAddress = self listenerAddress.
! !

!SocketTest methodsFor: 'tests' stamp: 'ar 11/26/2010 10:17'!
testClientConnect
	"Tests a client socket connection"

	clientSocket := Socket newTCP.
	clientSocket connectTo: self listenerAddress port: self listenerPort.
	clientSocket waitForConnectionFor: 2.
	self assert: clientSocket isConnected.
! !

!SocketTest methodsFor: 'setup' stamp: 'ar 11/26/2010 10:24'!
tearDown

	listenerSocket ifNotNil:[listenerSocket destroy].
	clientSocket ifNotNil:[clientSocket destroy].
	serverSocket ifNotNil:[serverSocket destroy].
! !

!SocketTest methodsFor: 'tests' stamp: 'ar 11/26/2010 11:08'!
testDataReceive
	"Test data transfer and related methods"

	self testDataSending.
	"It can take a tad for the status change to be visible"
	(Delay forMilliseconds: 200) wait.
	self assert: serverSocket dataAvailable.
	self assert: (serverSocket receiveData = 'Hello World').
	self deny: (serverSocket dataAvailable).
! !

!SocketTest methodsFor: 'tests' stamp: 'SvenVanCaekenberghe 4/15/2011 12:19'!
testLocalAddress
	"Tests the various localAddress values for sockets"

	self testServerAccept.
	self assert: listenerSocket localAddress asSocketAddress = self listenerAddress.
	self assert: clientSocket localAddress asSocketAddress = self listenerAddress.
	self assert: serverSocket localAddress asSocketAddress = self listenerAddress.
! !

!SocketTest methodsFor: 'tests' stamp: 'ar 11/26/2010 10:25'!
testRemotePort
	"Tests the various remoteAddress values for sockets"

	self testServerAccept.
	self assert: listenerSocket remotePort = 0.
	self assert: clientSocket remotePort = self listenerPort.
	self assert: serverSocket remotePort > 0.
! !

!SocketTest methodsFor: 'tests' stamp: 'ar 11/26/2010 11:06'!
testDataSending
	"Test data transfer and related methods"

	self testServerAccept.
	clientSocket sendData: 'Hello World'.
	clientSocket waitForSendDoneFor: 2.
	self assert: clientSocket sendDone.

! !

!SocketTest methodsFor: 'tests' stamp: 'ar 11/26/2010 10:25'!
testLocalPort
	"Tests the various localPort values for sockets"

	self testServerAccept.
	self assert: listenerSocket localPort = self listenerPort.
	self assert: clientSocket localPort > 0.
	self assert: serverSocket localPort > 0.
! !

!SocketTest methodsFor: 'setup' stamp: 'ar 11/26/2010 10:24'!
setUp

	listenerSocket := Socket newTCP listenOn: self listenerPort backlogSize: 4 interface: self listenerAddress.
! !

!SocketTest methodsFor: 'setup' stamp: 'ar 11/26/2010 10:13'!
listenerPort
	^42324
! !

!SolidFillStyle commentStamp: '<historical>'!
SolidFillStyle is a fill which represents a color for the BalloonEngine.

Instance variables:
	color	<Color>	The color to use.
	pixelValue32 <Integer>	The cached pixel value to use.!
!SolidFillStyle methodsFor: '*Morphic-Base' stamp: 'StephaneDucasse 10/26/2014 11:17'!
addFillStyleMenuItems: aMenu hand: aHand from: aMorph
	"Add the items for changing the current fill style of the receiver"
	aMenu add: 'change color...' target: self selector: #changeColorIn:event: argument: aMorph! !

!SolidFillStyle methodsFor: 'testing' stamp: 'ar 10/26/2000 19:25'!
isTransparent
	^color isTransparent! !

!SolidFillStyle methodsFor: 'converting' stamp: 'ar 11/9/1998 13:55'!
asColor
	^color! !

!SolidFillStyle methodsFor: 'printing' stamp: 'ar 11/17/1998 00:29'!
printOn: aStream
	super printOn: aStream.
	aStream nextPut:$(; print: color; nextPut:$).! !

!SolidFillStyle methodsFor: '*Morphic-Base' stamp: 'AlainPlantec 11/5/2011 19:34'!
changeColorIn: aMorph event: evt
	"Note: This is just a workaround to make sure we don't use the old color inst var"
	aMorph changeColorTarget: aMorph selector: #color: originalColor: self asColor hand: evt hand! !

!SolidFillStyle methodsFor: 'testing' stamp: 'ar 11/8/1998 18:34'!
isSolidFill
	^true! !

!SolidFillStyle methodsFor: 'accessing' stamp: 'ar 1/14/1999 15:25'!
scaledPixelValue32
	"Return the alpha scaled pixel value for depth 32"
	^pixelValue32! !

!SolidFillStyle methodsFor: 'testing' stamp: 'ar 9/2/1999 14:30'!
isTranslucent
	^color isTranslucent! !

!SolidFillStyle methodsFor: 'accessing' stamp: 'ar 1/14/1999 15:24'!
color: aColor
	color := aColor.
	pixelValue32 := aColor scaledPixelValue32! !

!SolidFillStyle methodsFor: '*Athens-Core' stamp: 'IgorStasenko 4/21/2011 15:01'!
asAthensPaintOn: anAthensCanvas 

	^ anAthensCanvas surface createSolidColorPaint: color! !

!SolidFillStyle class methodsFor: 'instance creation' stamp: 'ar 11/8/1998 18:31'!
color: aColor
	^self new color: aColor! !

!SortAlphabeticallyClassList commentStamp: 'NicolaiHess 9/7/2014 00:35'!
Like SortHierarchically but sort by name and without indentation.!
!SortAlphabeticallyClassList methodsFor: 'accessing' stamp: 'NicolaiHess 9/7/2014 00:38'!
sortedElements
	^ list! !

!SortAlphabeticallyClassList methodsFor: 'initialization' stamp: 'NicolaiHess 9/7/2014 00:38'!
initialize
	list := OrderedCollection new.! !

!SortAlphabeticallyClassList methodsFor: 'accessing' stamp: 'NicolaiHess 9/7/2014 00:43'!
list: aList
	list := aList! !

!SortAlphabeticallyClassList methodsFor: 'combining' stamp: 'NicolaiHess 9/7/2014 00:37'!
, another 

	^ self class new
		list: (self list, another list);
		yourself! !

!SortAlphabeticallyClassList methodsFor: 'accessing' stamp: 'NicolaiHess 9/7/2014 00:37'!
list
	^ list! !

!SortAlphabeticallyClassList class methodsFor: 'instance creation' stamp: 'NicolaiHess 9/7/2014 00:42'!
buildListFor: aPackageGroup in: anEnvironment
	^ aPackageGroup withClassesIn: anEnvironment createHierarchySorter: self ! !

!SortAlphabeticallyClassList class methodsFor: 'instance creation' stamp: 'NicolaiHess 9/7/2014 00:46'!
buildHierarchyForClasses: aCollection
	| nodes |
	nodes := aCollection asOrderedCollection sort: [:a :b  | a name < b name].
	^ self new
		list: nodes;
		yourself! !

!SortHierarchically commentStamp: '<historical>'!
A SortHierarchically is an algorithm used to display a list of classes where subclasses are indented and follow their superclass.

Instance Variables
	hierarchy: an array of SortHierarchicallyNodes correctly sorted
!
!SortHierarchically methodsFor: 'computation' stamp: 'DamienCassou 3/26/2013 16:29'!
sortedElements
	"Return the list of elements sorted appropriately."
	"Nodes are already sorted, we just return each's element."
	^ hierarchy collect: #element! !

!SortHierarchically methodsFor: 'computation' stamp: 'DamienCassou 3/26/2013 16:27'!
indentationFor: anElement
	"Return the number of spaces needed before anElement to indent it properly."
	"Speed could be enhanced by using a hash-based collection instead of this #detect:."
	^ (hierarchy detect: [ :node | node element = anElement ])
			indent! !

!SortHierarchically methodsFor: 'combining' stamp: 'BenjaminVanRyseghem 5/3/2013 13:26'!
, another 

	^ self class new
		setHierarchy: (self hierarchy, another hierarchy);
		yourself! !

!SortHierarchically methodsFor: 'initialize-release' stamp: 'DamienCassou 3/26/2013 15:14'!
setHierarchy: nodes
	hierarchy := nodes! !

!SortHierarchically methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/3/2013 13:26'!
hierarchy
	^ hierarchy! !

!SortHierarchically class methodsFor: 'instance creation' stamp: 'DamienCassou 3/26/2013 16:32'!
buildHierarchyForClasses: aCollection
	| nodes |
	nodes := aCollection collect: [ :cl | SortHierarchicallyNode on: cl theNonMetaClass].
	^ self new
		setHierarchy: (self sortNodes: nodes);
		yourself! !

!SortHierarchically class methodsFor: 'actions' stamp: 'ClementBera 7/26/2013 16:33'!
sortNodes: nodes
	"Roel Wuyts: Reimplements sortHierarchically in a crude and ugly way that is however much more efficient"
	
	| classNodes sortedResults supersChain superior result chain1 chain2 i max |
	classNodes := (nodes collect: [:classNode | classNode element]) asOrderedCollection.
	sortedResults := SortedCollection sortBlock: [:assoc1 :assoc2 |
		result := nil.
		chain1 := assoc1 key.
		chain2 := assoc2 key. 
		max := chain1 size min: chain2 size.
		i := 1.
		[result isNil and: [i <= max]] whileTrue: [
			(chain1 at: i) = (chain2 at: i)
				ifTrue: [i := i + 1]
				ifFalse: [result := (chain1 at: i) name < (chain2 at: i) name]].
		result ifNil: [
			chain1 size < chain2 size] ifNotNil: [result]
	].
	nodes do: [:classNode |
		supersChain := classNode element withAllSuperclasses reversed.
		supersChain removeAllSuchThat: [:cl | (classNodes includes: cl) not].
		superior := supersChain size > 1
			ifTrue: [superior := supersChain atLast: 2. nodes detect: [:e | e element = superior]]
			ifFalse: [nil].
		sortedResults add: supersChain contents -> (classNode ancestor: superior).
	].
	^(sortedResults collect: [:assoc | assoc value]) asArray! !

!SortHierarchically class methodsFor: 'actions' stamp: 'DamienCassou 3/26/2013 16:31'!
sortElements: elements
	^ self sortNodes: (elements collect: [ :el | SortHierarchicallyNode on: el ])! !

!SortHierarchically class methodsFor: 'instance creation' stamp: 'NicolaiHess 7/30/2014 13:40'!
buildHierarchyFor: aPackageGroup in: anEnvironment
	^ aPackageGroup withClassesIn: anEnvironment createHierarchySorter: self ! !

!SortHierarchicallyNode commentStamp: '<historical>'!
A SortHierarchicallyNode is a wrapper around any object that is used by the sorting algorithm of SortHierarchically to store the ancestry chain of this object.

Instance Variables
	ancestor: a SortHierarchicallyNode that is an ancestor of the receiver if any, nil otherwise.
	element: any model object that is part of a collection we are sorting hierarchically.
!
!SortHierarchicallyNode methodsFor: 'accessing' stamp: 'DamienCassou 3/26/2013 16:13'!
ancestor
	"Return a SortHierarchicallyNode that is an ancestor of the receiver if any. Return nil otherwise."
	^ ancestor! !

!SortHierarchicallyNode methodsFor: 'computation' stamp: 'DamienCassou 3/26/2013 16:15'!
indent
	"Get the indentation value for the current node. The indentation equals the number of ancestors."
	| indent cursor |
	indent := 0.
	cursor := ancestor.
	[ cursor isNil ]
		whileFalse: [ 
			indent := indent + 1.
			cursor := cursor ancestor ].
	^ indent! !

!SortHierarchicallyNode methodsFor: 'accessing' stamp: 'DamienCassou 3/26/2013 16:14'!
element
	"Any model object that is part of a collection we are sorting hierarchically."
	^ element! !

!SortHierarchicallyNode methodsFor: 'initialize-release' stamp: 'DamienCassou 3/26/2013 14:45'!
setElement: anObject
	element := anObject! !

!SortHierarchicallyNode methodsFor: 'printing' stamp: 'DamienCassou 3/26/2013 16:15'!
printOn: aStream
	"Print me->ancestor"
	aStream
		print: element;
		nextPutAll: ' -> ';
		print: (ancestor ifNil: [ '/' ] ifNotNil: [ ancestor element ])! !

!SortHierarchicallyNode methodsFor: 'accessing' stamp: 'DamienCassou 3/26/2013 16:14'!
ancestor: aSortHierarchicallyNode
	ancestor := aSortHierarchicallyNode! !

!SortHierarchicallyNode class methodsFor: 'instance creation' stamp: 'DamienCassou 3/26/2013 14:45'!
on: anObject
	^ self new
			setElement: anObject;
			yourself! !

!SortHierarchicallyTests methodsFor: 'private' stamp: 'DamienCassou 3/26/2013 14:46'!
sortByNameSize: collection

	^collection asSortedCollection: [:x :y | x element name size < y element name size]! !

!SortHierarchicallyTests methodsFor: 'tests' stamp: 'rw 7/7/2006 17:27'!
testPartialTreeUnchanged

	self
		nodes: partialTree
		shouldBe: partialTree! !

!SortHierarchicallyTests methodsFor: 'tests' stamp: 'rw 7/7/2006 17:34'!
testUnrelatedClassesUnsorted

	self
		nodes: (self sortByNameSize: unrelatedClasses)
		shouldBe: unrelatedClasses! !

!SortHierarchicallyTests methodsFor: 'tests' stamp: 'rw 7/20/2006 13:24'!
testArchivesClassesReversed

	self
		nodes: archivesClasses reversed
		shouldBe: archivesClasses! !

!SortHierarchicallyTests methodsFor: 'tests' stamp: 'rw 7/7/2006 17:33'!
testCompleteTreeUnordered

	self
		nodes: (self sortByNameSize: completeTree)
		shouldBe: completeTree! !

!SortHierarchicallyTests methodsFor: 'tests' stamp: 'rw 7/20/2006 13:24'!
testArchivesClassesUnordered

	self
		nodes: (self sortByNameSize: archivesClasses)
		shouldBe: archivesClasses
		
	! !

!SortHierarchicallyTests methodsFor: 'tests' stamp: 'rw 7/7/2006 17:29'!
testPartialTreeReversed

	self
		nodes: partialTree reversed
		shouldBe: partialTree! !

!SortHierarchicallyTests methodsFor: 'private' stamp: 'DamienCassou 3/26/2013 16:30'!
nodes: nodes shouldBe: correctNodes
	"sort the collection of nodes. The result should be the correctNodes"

	| sorted |
	sorted := SortHierarchically sortNodes: nodes asArray.
	self assert: sorted size equals: correctNodes size.
	correctNodes with: sorted do: [:node :sortedNode | self assert: node equals: sortedNode]! !

!SortHierarchicallyTests methodsFor: 'tests' stamp: 'rw 7/7/2006 17:26'!
testCompleteTreeUnchanged

	self
		nodes: completeTree
		shouldBe: completeTree! !

!SortHierarchicallyTests methodsFor: 'setup' stamp: 'MarcusDenker 5/21/2013 07:41'!
setUp

	completeTree := self asNodes: {String . ByteString . Symbol . ByteSymbol . WideSymbol . WideString} .
	partialTree := self asNodes: {String . ByteString . ByteSymbol . WideString}.
	unrelatedClasses := self asNodes: {ArrayedCollection . BlockClosure . Class  . Morph . Point}.
	archivesClasses :=  self asNodes: {Archive . TarArchive . ZipArchive . ArchiveMember . TarArchiveMember . ZipArchiveMember . ZipFileMember . ZipDirectoryMember . ZipNewFileMember . ZipStringMember . ZipFileConstants}! !

!SortHierarchicallyTests methodsFor: 'tests' stamp: 'DamienCassou 3/26/2013 16:30'!
testOneClass

	| pointNode sorted |
	pointNode := SortHierarchicallyNode on: Point.
	sorted := SortHierarchically sortNodes: (Array with: pointNode).
	self assert: sorted size = 1.
	self assert: (sorted includes: pointNode)! !

!SortHierarchicallyTests methodsFor: 'tests' stamp: 'rw 7/7/2006 17:31'!
testUnrelatedClassesUnchanged

	self
		nodes: unrelatedClasses
		shouldBe: unrelatedClasses! !

!SortHierarchicallyTests methodsFor: 'tests' stamp: 'rw 7/20/2006 13:24'!
testArchivesClassesUnchanged

	self
		nodes: archivesClasses
		shouldBe: archivesClasses! !

!SortHierarchicallyTests methodsFor: 'tests' stamp: 'rw 7/7/2006 17:31'!
testUnrelatedClassesReversed

	self
		nodes: unrelatedClasses reversed
		shouldBe: unrelatedClasses! !

!SortHierarchicallyTests methodsFor: 'private' stamp: 'DamienCassou 3/26/2013 14:44'!
asNodes: classCollection

	^classCollection collect: [:cl | SortHierarchicallyNode on: cl]! !

!SortHierarchicallyTests methodsFor: 'tests' stamp: 'rw 7/7/2006 17:34'!
testPartialTreeUnsorted

	self
		nodes: (self sortByNameSize: partialTree)
		shouldBe: partialTree! !

!SortHierarchicallyTests methodsFor: 'tests' stamp: 'rw 7/7/2006 17:26'!
testCompleteTreeReversed

	self
		nodes: completeTree reversed
		shouldBe: completeTree! !

!SortedCollection commentStamp: '<historical>'!
I represent a collection of objects ordered by some property of the objects themselves. The ordering is specified in a BlockContext.!
!SortedCollection methodsFor: 'private' stamp: 'ClementBera 7/26/2013 16:58'!
indexForInserting: newObject

	| index low high |
	low := firstIndex.
	high := lastIndex.
	sortBlock 
		ifNil: [[index := high + low // 2.  low > high]
			whileFalse: 
				[((array at: index) <= newObject)
					ifTrue: [low := index + 1]
					ifFalse: [high := index - 1]]]
		ifNotNil: [[index := high + low // 2.  low > high]
			whileFalse: 
				[(sortBlock value: (array at: index) value: newObject)
					ifTrue: [low := index + 1]
					ifFalse: [high := index - 1]]].
	^low! !

!SortedCollection methodsFor: 'private' stamp: 'stp 04/23/1999 05:33'!
sort: i to: j 
	"Sort elements i through j of self to be nondescending according to
	sortBlock."

	| di dij dj tt ij k l n |
	sortBlock ifNil: [^self defaultSort: i to: j].
	"The prefix d means the data at that index."
	(n := j + 1  - i) <= 1 ifTrue: [^self].	"Nothing to sort." 
	 "Sort di,dj."
	di := array at: i.
	dj := array at: j.
	(sortBlock value: di value: dj) "i.e., should di precede dj?"
		ifFalse: 
			[array swap: i with: j.
			 tt := di.
			 di := dj.
			 dj := tt].
	n > 2
		ifTrue:  "More than two elements."
			[ij := (i + j) // 2.  "ij is the midpoint of i and j."
			 dij := array at: ij.  "Sort di,dij,dj.  Make dij be their median."
			 (sortBlock value: di value: dij) "i.e. should di precede dij?"
			   ifTrue: 
				[(sortBlock value: dij value: dj) "i.e., should dij precede dj?"
				  ifFalse: 
					[array swap: j with: ij.
					 dij := dj]]
			   ifFalse:  "i.e. di should come after dij"
				[array swap: i with: ij.
				 dij := di].
			n > 3
			  ifTrue:  "More than three elements."
				["Find k>i and l<j such that dk,dij,dl are in reverse order.
				Swap k and l.  Repeat this procedure until k and l pass each other."
				 k := i.
				 l := j.
				 [[l := l - 1.  k <= l and: [sortBlock value: dij value: (array at: l)]]
				   whileTrue.  "i.e. while dl succeeds dij"
				  [k := k + 1.  k <= l and: [sortBlock value: (array at: k) value: dij]]
				   whileTrue.  "i.e. while dij succeeds dk"
				  k <= l]
				   whileTrue:
					[array swap: k with: l]. 
	"Now l<k (either 1 or 2 less), and di through dl are all less than or equal to dk
	through dj.  Sort those two segments."
				self sort: i to: l.
				self sort: k to: j]]! !

!SortedCollection methodsFor: 'adding' stamp: 'sma 4/28/2000 18:35'!
addAll: aCollection
	aCollection size > (self size // 3)
		ifTrue:
			[aCollection do: [:each | self addLast: each].
			self reSort]
		ifFalse: [aCollection do: [:each | self add: each]].
	^ aCollection! !

!SortedCollection methodsFor: 'private' stamp: 'sma 4/28/2000 17:46'!
reSort
	self sort: firstIndex to: lastIndex! !

!SortedCollection methodsFor: 'accessing' stamp: 'stephane.ducasse 4/13/2009 21:11'!
sortBlock: aBlock 
	"Make the argument, aBlock, be the criterion for ordering elements of the 
	receiver."

	sortBlock := aBlock.
	"sortBlocks with side effects may not work right"
	self size > 0 ifTrue: [self reSort]! !

!SortedCollection methodsFor: 'adding' stamp: 'MPH 10/23/2000 13:31'!
copyEmpty
	"Answer a copy of the receiver without any of the receiver's elements."

	^self species sortBlock: sortBlock! !

!SortedCollection methodsFor: 'adding' stamp: 'go 4/26/2000 17:26'!
addFirst: newObject
	self shouldNotImplement! !

!SortedCollection methodsFor: 'private' stamp: 'go 4/26/2000 17:17'!
insert: anObject before: spot
	self shouldNotImplement! !

!SortedCollection methodsFor: 'private' stamp: 'stp 04/23/1999 05:32'!
defaultSort: i to: j 
	"Sort elements i through j of self to be nondescending according to
	sortBlock."	"Assume the default sort block ([:x :y | x <= y])."

	| di dij dj tt ij k l n |
	"The prefix d means the data at that index."
	(n := j + 1  - i) <= 1 ifTrue: [^self].	"Nothing to sort." 
	 "Sort di,dj."
	di := array at: i.
	dj := array at: j.
	(di <= dj) "i.e., should di precede dj?"
		ifFalse: 
			[array swap: i with: j.
			 tt := di.
			 di := dj.
			 dj := tt].
	n > 2
		ifTrue:  "More than two elements."
			[ij := (i + j) // 2.  "ij is the midpoint of i and j."
			 dij := array at: ij.  "Sort di,dij,dj.  Make dij be their median."
			 (di <= dij) "i.e. should di precede dij?"
			   ifTrue: 
				[(dij <= dj) "i.e., should dij precede dj?"
				  ifFalse: 
					[array swap: j with: ij.
					 dij := dj]]
			   ifFalse:  "i.e. di should come after dij"
				[array swap: i with: ij.
				 dij := di].
			n > 3
			  ifTrue:  "More than three elements."
				["Find k>i and l<j such that dk,dij,dl are in reverse order.
				Swap k and l.  Repeat this procedure until k and l pass each other."
				 k := i.
				 l := j.
				 [[l := l - 1.  k <= l and: [dij <= (array at: l)]]
				   whileTrue.  "i.e. while dl succeeds dij"
				  [k := k + 1.  k <= l and: [(array at: k) <= dij]]
				   whileTrue.  "i.e. while dij succeeds dk"
				  k <= l]
				   whileTrue:
					[array swap: k with: l]. 
	"Now l<k (either 1 or 2 less), and di through dl are all less than or equal to dk
	through dj.  Sort those two segments."
				self defaultSort: i to: l.
				self defaultSort: k to: j]]! !

!SortedCollection methodsFor: 'accessing' stamp: 'tk 3/28/1999 22:55'!
median
	"Return the middle element, or as close as we can get."

	^ self at: self size + 1 // 2! !

!SortedCollection methodsFor: 'accessing' stamp: 'sma 4/28/2000 17:47'!
at: anInteger put: anObject
	self shouldNotImplement! !

!SortedCollection methodsFor: 'adding' stamp: 'go 4/27/2000 13:19'!
add: newObject
	^ super insert: newObject before: (self indexForInserting: newObject)! !

!SortedCollection methodsFor: 'comparing' stamp: ''!
= aSortedCollection
	"Answer true if my and aSortedCollection's species are the same,
	and if our blocks are the same, and if our elements are the same."

	self species = aSortedCollection species ifFalse: [^ false].
	sortBlock = aSortedCollection sortBlock
		ifTrue: [^ super = aSortedCollection]
		ifFalse: [^ false]! !

!SortedCollection methodsFor: 'enumerating' stamp: 'sma 2/5/2000 15:22'!
collect: aBlock 
	"Evaluate aBlock with each of my elements as the argument. Collect the 
	resulting values into an OrderedCollection. Answer the new collection. 
	Override the superclass in order to produce an OrderedCollection instead
	of a SortedCollection."

	| newCollection | 
	newCollection := OrderedCollection new: self size.
	self do: [:each | newCollection addLast: (aBlock value: each)].
	^ newCollection! !

!SortedCollection methodsFor: 'enumerating' stamp: 'TudorGirba 11/3/2013 20:41'!
flatCollect: aBlock
	^ self flatCollect: aBlock as: OrderedCollection! !

!SortedCollection methodsFor: 'accessing' stamp: 'MarcusDenker 2/15/2010 17:15'!
sort: aSortBlock 
	"Sort this array using aSortBlock. The block should take two arguments
	and return true if the first element should preceed the second one."
 
 	super sort: aSortBlock.
 	sortBlock := aSortBlock! !

!SortedCollection methodsFor: 'splitjoin' stamp: 'onierstrasz 4/12/2009 19:57'!
join: aCollection 
	"Curiously addAllLast: does not trigger a reSort, so we must do it here."
	^ (super join: aCollection) reSort; yourself
! !

!SortedCollection methodsFor: 'accessing' stamp: ''!
sortBlock
	"Answer the blockContext which is the criterion for sorting elements of 
	the receiver."

	^sortBlock! !

!SortedCollection class methodsFor: 'instance creation' stamp: ''!
sortBlock: aBlock 
	"Answer an instance of me such that its elements are sorted according to 
	the criterion specified in aBlock."

	^(super new: 10) sortBlock: aBlock! !

!SortedCollectionTest commentStamp: 'TorstenBergmann 2/20/2014 15:28'!
SUnit tests for sorted collections!
!SortedCollectionTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButLast
	"self debug: #testAllButLast"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButLast.
	self deny: abf last = col last.
	self assert: abf size + 1 = col size! !

!SortedCollectionTest methodsFor: 'tests - begins ends with' stamp: ''!
testsEndsWith
	
	self assert: (self nonEmpty endsWith: self nonEmpty copyWithoutFirst).
	self assert: (self nonEmpty endsWith: self nonEmpty).
	self deny: (self nonEmpty endsWith: (self nonEmpty copyWith: self nonEmpty first)).! !

!SortedCollectionTest methodsFor: 'tests - equality' stamp: ''!
testHasEqualElementsOfIdenticalCollectionObjects
	"self debug: #testHasEqualElementsOfIdenticalCollectionObjects"
	
	self assert: (self empty hasEqualElements: self empty). 
	self assert: (self nonEmpty hasEqualElements: self nonEmpty). 
	! !

!SortedCollectionTest methodsFor: 'tests - index access' stamp: 'delaunay 4/23/2009 15:14'!
testLastIndexOf
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection lastIndexOf: element) = 1.
	self assert: (collection lastIndexOf: self elementNotInForIndexAccessing) = 0! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 10:50'!
moreThan4Elements

" return a collection including at leat 4 elements"
	^ accessCollection ! !

!SortedCollectionTest methodsFor: 'tests - removing by index' stamp: ''!
testRemoveLastNElements

| collection  result oldSize elements |
collection := self collectionWith5Elements .
elements := {  (collection at: (4)). collection last. }.
oldSize := collection size.


result := (collection removeLast: 2).
self assert: result = elements.
self assert: collection size = (oldSize - 2).! !

!SortedCollectionTest methodsFor: 'tests - subcollections access' stamp: ''!
testFirstNElements
	"self debug: #testFirstNElements"
	| result |
	result := self moreThan3Elements first: self moreThan3Elements size - 1.
	1 
		to: result size
		do: [ :i | self assert: (result at: i) = (self moreThan3Elements at: i) ].
	self assert: result size = (self moreThan3Elements size - 1).
	self 
		should: [ self moreThan3Elements first: self moreThan3Elements size + 1 ]
		raise: Error! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 10:48'!
collectionWith2TimeSubcollection
" return a collection including 'oldSubCollection'  two or many time "
	^ (SortedCollection  new add: elementNoteIn ; yourself) , self oldSubCollection , self oldSubCollection  ! !

!SortedCollectionTest methodsFor: 'tests - adding' stamp: ''!
testTWrite
	| added collection elem |
	collection := self otherCollection  .
	elem := self element .
	added := collection  write: elem .
	
	self assert: added == elem .	"test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection  includes: elem )	.
	self assert: (collection  includes: elem ).
	
	! !

!SortedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0TStructuralEqualityTest
	self empty.
	self nonEmpty.
	self assert: self empty isEmpty.
	self deny: self nonEmpty isEmpty! !

!SortedCollectionTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithoutFirst

	| result |
	result := self nonEmpty copyWithoutFirst.
	
	self assert: result size = (self nonEmpty size - 1).
	
	1 to: result size do:
		[:i |
		self assert: (result at: i)= (self nonEmpty at: (i + 1))].! !

!SortedCollectionTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionTwoSimilarElementsInIntersection
	"self debug: #testIntersectionBasic"
	| inter |
	inter := self collection intersection: (self collectionClass with: self anotherElementOrAssociationIn).
	self assert: (self collection occurrencesOf: self anotherElementOrAssociationIn) = self numberOfSimilarElementsInIntersection.
	self assert: (inter includes: self anotherElementOrAssociationIn value)! !

!SortedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testBefore
	"self debug: #testBefore"
	self assert: (self moreThan4Elements before: (self moreThan4Elements at: 2)) = (self moreThan4Elements at: 1).
	self 
		should: [ self moreThan4Elements before: (self moreThan4Elements at: 1) ]
		raise: Error.
	self 
		should: [ self moreThan4Elements before: 66 ]
		raise: Error! !

!SortedCollectionTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testLastIndexOfDuplicate
	"self debug: #testLastIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection first.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'lastIndexOf: should return the position of the last occurrence :'"
	self assert: (collection lastIndexOf: element) = collection size! !

!SortedCollectionTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAnyNoneThere
	"self debug: #testIncludesAnyOfNoneThere'"
	
	self deny: (self nonEmpty includesAny: self empty).
	self deny: (self nonEmpty includesAny: { self elementNotIn. self anotherElementNotIn })! !

!SortedCollectionTest methodsFor: 'basic' stamp: 'DM 3/16/2006 11:43'!
testMedian
	"self run: #testMedian"
	"self debug: #testMedian"
	
	|aSortedCollection|
	aSortedCollection := (1 to: 10) asSortedCollection.
	self assert: aSortedCollection median=5.
	
	aSortedCollection := SortedCollection new.
	aSortedCollection add:'truite' ; add:'porcinet' ; add:'carpe'.
	self assert: (aSortedCollection median = 'porcinet').
	! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 10:31'!
collectionOfFloat
" return a collection only includiing Float elements "
	^ collectionOfFloat ! !

!SortedCollectionTest methodsFor: 'basic' stamp: 'DM 3/16/2006 11:27'!
testAdd
	"self run: #testAdd"
	"self debug: #testAdd"
	
	| collection |
	collection := #(10 9 8 7 5 4 4 2) asSortedCollection.
	self assert: collection first = 2.
	self assert: collection last = 10.
	self assert: (collection size = 8).
	collection add:1.
	self assert: (collection size = 9).
	collection add: 6.
	self assert: ((collection at: 5) = 5).
	self assert: (collection size = 10).
	collection add: 3.
	! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'CamilloBruni 9/9/2011 12:12'!
collectionWithoutEqualElements

" return a collection not including equal elements "
	^withoutEqualElements ! !

!SortedCollectionTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedArray
	| result collection |
	collection := self collectionWithSortableElements .
	result := collection  asArray sort.
	self assert: (result class includesBehavior: Array).
	self assert: result isSorted.
	self assert: result size = collection size! !

!SortedCollectionTest methodsFor: 'tests - converting' stamp: ''!
testAsArray
	"self debug: #testAsArray3"
	self 
		assertSameContents: self collectionWithoutEqualElements
		whenConvertedTo: Array! !

!SortedCollectionTest methodsFor: 'test - creation' stamp: ''!
testWith
	"self debug: #testWith"
	
	| aCol anElement |
	anElement := self collectionMoreThan5Elements anyOne.
	aCol := self collectionClass with: anElement.
	self assert: (aCol includes: anElement).! !

!SortedCollectionTest methodsFor: 'tests - copy' stamp: ''!
testCopyNotSame
	"self debug: #testCopySameClass"
	"A copy of a collection should always be of the same class as the instance it copies"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: copy  == self nonEmpty.! !

!SortedCollectionTest methodsFor: 'tests - set arithmetic' stamp: ''!
testUnionOfEmpties
	"self debug: #testUnionOfEmpties"
	
	self assert:  (self empty union: self empty) isEmpty.
	
	! !

!SortedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindFirst

	| element result |
	element := self nonEmptyMoreThan1Element   at:1.
	 result:=self nonEmptyMoreThan1Element  findFirst: [:each | each =element].
	
	self assert: result=1. ! !

!SortedCollectionTest methodsFor: 'tests - copying part of sequenceable for multipliness' stamp: ''!
testCopyUpToWithDuplicate
	| result element  collection |
	collection := self collectionWithSameAtEndAndBegining .
	element := collection  last.
	
	" collectionWithSameAtEndAndBegining first and last elements are equals.
	'copyUpTo:' should copy until the first occurence :"
	result := collection   copyUpTo: (element ).
	
	"verifying content: "
	self assert: result isEmpty.

! !

!SortedCollectionTest methodsFor: 'tests - adding' stamp: ''!
testTWriteTwice
	| added oldSize collection elem |
	collection := self collectionWithElement .
	elem := self element .
	oldSize := collection  size.
	added := collection 
		write: elem ;
		write: elem .
	self assert: added == elem .	"test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection  includes: elem ).
	self assert: collection  size = (oldSize + 2)! !

!SortedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithIndexCollect
	
	| result index collection |
	index := 0.
	collection := self nonEmptyMoreThan1Element .
	result := collection  withIndexCollect: [:each :i | 
		self assert: i = (index := index + 1).	
		self assert: i = (collection  indexOf: each) .
		each] . 
	
	1 to: result size do:[: i | self assert: (result at:i)= (collection at: i)].
	self assert: result size = collection size.! !

!SortedCollectionTest methodsFor: 'tests - printing' stamp: ''!
testPrintElementsOn

	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printElementsOn: aStream .
	allElementsAsString:=(result findBetweenSubStrs: ' ' ).
	1 to: allElementsAsString size do:
		[:i | 
		self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString).
			].! !

!SortedCollectionTest methodsFor: 'tests - adding' stamp: ''!
testTAddAll
	| added collection toBeAdded |
	collection := self collectionWithElement .
	toBeAdded := self otherCollection .
	added := collection addAll: toBeAdded .
	self assert: added == toBeAdded .	"test for identiy because #addAll: has not reason to copy its parameter."
	self assert: (collection includesAll: toBeAdded )! !

!SortedCollectionTest methodsFor: 'tests - adding' stamp: ''!
testTAddWithOccurences
	| added oldSize collection anElement |
	collection := self collectionWithElement .
	anElement := self element .
	oldSize := collection  size.
	added := collection  add: anElement withOccurrences: 5.
	
	self assert: added == anElement.	"test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection  includes: anElement).
	self assert: collection  size = (oldSize + 5)! !

!SortedCollectionTest methodsFor: 'tests - begins ends with' stamp: ''!
testsEndsWithEmpty
	
	self deny: (self nonEmpty endsWith: self empty).
	self deny: (self empty endsWith: self nonEmpty).
	! !

!SortedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIterateSequencedReadableTest

	| res |
	
	self nonEmptyMoreThan1Element.
	self assert: self nonEmptyMoreThan1Element  size > 1.
	
	
	self empty.
	self assert: self empty isEmpty .
	
	res := true.
	self nonEmptyMoreThan1Element    
	detect: [ :each | (self nonEmptyMoreThan1Element    occurrencesOf: each) > 1 ]
	ifNone: [ res := false ].
	self assert: res = false.! !

!SortedCollectionTest methodsFor: 'tests - removing by index' stamp: ''!
testRemoveFirst

| collection element result oldSize |
collection := self collectionWith5Elements .
element := collection first.
oldSize := collection size.

result := collection removeFirst.
self assert: result = element .
self assert: collection size = (oldSize - 1).! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 14:33'!
anotherElementNotIn
" return an element different of 'elementNotIn'  not included in 'nonEmpty' "
	^666! !

!SortedCollectionTest methodsFor: 'tests - copying part of sequenceable for multipliness' stamp: ''!
testCopyUpToLastWithDuplicate
	| result element  collection |
	collection := self collectionWithSameAtEndAndBegining .
	element := collection  first.
	
	" collectionWithSameAtEndAndBegining first and last elements are equals.
	'copyUpToLast:' should copy until the last occurence :"
	result := collection   copyUpToLast: (element ).
	
	"verifying content: "
	1 to: result size do:
		[:i |
		self assert: (result at: i ) = ( collection at: i )  
		].
	
	self assert: result size = (collection size - 1).

! !

!SortedCollectionTest methodsFor: 'tests - remove' stamp: ''!
testRemoveIfAbsent
	"self debug: #testRemoveElementThatExists"

	| el res |
	el := self elementNotIn.
	res := self nonEmptyWithoutEqualElements remove: el ifAbsent: [ 33 ].
	self assert: res = 33! !

!SortedCollectionTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithSequenceable

	| result index element |
	index := self indexInNonEmpty .
	element := self nonEmpty at: index.
	result := self nonEmpty copyWith: (element ).
	
	self assert: result size = (self nonEmpty size + 1).
	self assert: result last = element .
	
	1 to: (result size - 1) do:
	[ :i |
	self assert: (result at: i) = ( self nonEmpty at: ( i  ))].! !

!SortedCollectionTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterLastEmpty

	| delim emptyStream |
	delim := ', '.
	emptyStream := ReadWriteStream on: ''.
	self empty asStringOn: emptyStream delimiter: delim last:'and'.
	self assert: emptyStream contents = ''.
! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 10:48'!
collectionWith1TimeSubcollection
" return a collection including 'oldSubCollection'  only one time "
	^ (SortedCollection new add: elementNoteIn ; yourself) , self oldSubCollection ! !

!SortedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testAtOutOfBounds
	"self debug: #testAtOutOfBounds"
	self 
		should: [ self moreThan4Elements at: self moreThan4Elements size + 1 ]
		raise: Error.
	self 
		should: [ self moreThan4Elements at: -1 ]
		raise: Error! !

!SortedCollectionTest methodsFor: 'test - creation' stamp: ''!
testOfSize
	"self debug: #testOfSize"
	
	| aCol |
	aCol := self collectionClass ofSize: 3.
	self assert: (aCol size = 3).
! !

!SortedCollectionTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOfEmpty
	| result |
	result := self empty occurrencesOf: (self collectionWithoutEqualElements anyOne).
	self assert: result = 0! !

!SortedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithCollect
	
	| result firstCollection secondCollection index  |

	firstCollection := self nonEmptyMoreThan1Element.
	secondCollection := firstCollection copy.
	index := 0.
	
	result := firstCollection  with: secondCollection collect:
		[:a :b |
		( index := index + 1).
		self assert: (firstCollection at: index) equals:  a. 
		self assert: (secondCollection at: index) equals:  b.
		b].
	
	1 to: result size do:[: i | self assert: (result at:i)= (secondCollection  at: i)].
	self assert: result size = secondCollection  size.! !

!SortedCollectionTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterLastOne

	| delim oneItemStream result |
	
	delim := ', '.
	result:=''.
	oneItemStream := ReadWriteStream on: result.
	self nonEmpty1Element  asStringOn: oneItemStream delimiter: delim last: 'and'.
	oneItemStream do:[:each | self assert: each = (self nonEmpty1Element first asString)].
	

	! !

!SortedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSetAritmeticTest
	self collection.
	self deny: self collection isEmpty.
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self anotherElementOrAssociationNotIn.
	self collection isDictionary
		ifTrue: [ self deny: (self collection associations includes: self anotherElementOrAssociationNotIn key) ]
		ifFalse: [ self deny: (self collection includes: self anotherElementOrAssociationNotIn) ].
	self collectionClass! !

!SortedCollectionTest methodsFor: 'tests - printing' stamp: ''!
testPrintOnDelimiter
	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printOn: aStream delimiter: ', ' .
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString).
			].! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 10:33'!
elementInCollectionOfFloat
" return an element included in 'collectionOfFloat' "
	^ collectionOfFloat anyOne! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/23/2009 11:43'!
collectionWithoutNilElements
" return a collection that doesn't includes a nil element  and that doesn't includes equal elements'"
	^ collectionWithoutNil  ! !

!SortedCollectionTest methodsFor: 'tests - adding' stamp: ''!
testTAddTwice
	| added oldSize collection anElement |
	collection := self collectionWithElement .
	anElement := self element .
	oldSize := collection  size.
	added := collection 
		add: anElement ;
		add: anElement .
	self assert: added == anElement .	"test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection  includes: anElement ).
	self assert: collection  size = (oldSize + 2)! !

!SortedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIncludeWithIdentityTest
	| anElement |
	self collectionWithCopyNonIdentical.
	anElement := self collectionWithCopyNonIdentical anyOne.
	self deny: anElement == anElement copy! !

!SortedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureTConvertTest
	"a collection of number without equal elements:"

	| res |
	self collectionWithoutEqualElements.
	res := true.
	self collectionWithoutEqualElements
		detect: [ :each | (self collectionWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false! !

!SortedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyWithReplacementForSorted
	self collectionOfSize5.
	self assert: self collectionOfSize5 size = 5.
	self replacementCollection.
	self deny: self replacementCollection isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!SortedCollectionTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterMore

	| delim multiItemStream result index |
	"delim := ', '.
	multiItemStream := '' readWrite.
	self oneTwoThreeItemCol asStringOn: multiItemStream delimiter: ', '.
	self assert: multiItemStream contents = '1, 2, 3'."
	
	delim := ', '.
	result:=''.
	multiItemStream := ReadWriteStream on:result.
	self nonEmpty  asStringOn: multiItemStream delimiter: ', '.
	
	index:=1.
	(result findBetweenSubStrs: ', ' )do:
		[:each |
		self assert: each= ((self nonEmpty at:index)asString).
		index:=index+1
		].! !

!SortedCollectionTest methodsFor: 'tests - remove' stamp: ''!
testRemoveElementThatExists
	"self debug: #testRemoveElementThatExists"

	| el res |
	el := self nonEmptyWithoutEqualElements anyOne.
	res := self nonEmptyWithoutEqualElements remove: el.
	self assert: res == el! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 12:18'!
collectionMoreThan5Elements
" return a collection including at least 5 elements"
	
	^ nonEmpty5Elements ! !

!SortedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testDetectSequenced
" testing that detect keep the first element returning true for sequenceable collections "

	| element result |
	element := self nonEmptyMoreThan1Element   at:1.
	result:=self nonEmptyMoreThan1Element  detect: [:each | each notNil ].
	self assert: result = element. ! !

!SortedCollectionTest methodsFor: 'tests - includes' stamp: ''!
testIdentityIncludesNonSpecificComportement
	" test the same comportement than 'includes: '  "
	| collection |	
	collection := self nonEmpty  .
	
	self deny: (collection identityIncludes: self elementNotIn ).
	self assert:(collection identityIncludes: collection anyOne)
! !

!SortedCollectionTest methodsFor: 'tests - removing by index' stamp: ''!
testRemoveLastNElementsNElements

self should: [self empty removeLast: 2] raise: Error.! !

!SortedCollectionTest methodsFor: 'test - iterate' stamp: 'ab 12/26/2008 18:03'!
testDo2

	| res |
	res := self speciesClass sortBlock: [:a :b | a name < b name]..  
	self collection do: [:each | res add: each class].
	self assert: res asArray = self result asArray. 
! !

!SortedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureAsStringCommaAndDelimiterTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty.
	self nonEmpty1Element.
	self assert: self nonEmpty1Element size = 1! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/23/2009 15:21'!
collectionMoreThan1NoDuplicates
	" return a collection of size 5 without equal elements"
	^ withoutEqualElements ! !

!SortedCollectionTest methodsFor: 'basic' stamp: 'DM 3/16/2006 11:33'!
testCollect
	"self run: #testCollect"
	
	|result aSortedCollection|
	aSortedCollection := SortedCollection new.
	result := OrderedCollection new.
	result add:true ; add: true ; add: true ;add: false ; add: false.
	aSortedCollection := (1 to: 5) asSortedCollection.
	self assert: (result = (aSortedCollection collect: [:each | each < 4])).
	! !

!SortedCollectionTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAnyAllThere
	"self debug: #testIncludesAnyOfAllThere'"
	self deny: (self nonEmpty includesAny: self empty).
	self assert: (self nonEmpty includesAny: { self nonEmpty anyOne }).
	self assert: (self nonEmpty includesAny: self nonEmpty).! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/22/2009 14:55'!
elementToAdd
" return an element of type 'nonEmpy' elements'type'"
	^ 5! !

!SortedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testPairsDo
	| index |
	index:=1.
	
	self nonEmptyMoreThan1Element  pairsDo: 
		[:each1 :each2 | 
		self assert:(self nonEmptyMoreThan1Element at:index)=each1.
		self assert:(self nonEmptyMoreThan1Element at:(index+1))=each2.
		index:=index+2].
	
	self nonEmptyMoreThan1Element size odd
		ifTrue:[self assert: index=self nonEmptyMoreThan1Element size]
		ifFalse:[self assert: index=(self nonEmptyMoreThan1Element size+1)].! !

!SortedCollectionTest methodsFor: 'requirements' stamp: ''!
collectionWithCopy
	"return a collection of type 'self collectionWIithoutEqualsElements class' containing no elements equals ( with identity equality)
	but  2 elements only equals with classic equality"
	| result collection |
	collection := OrderedCollection withAll: self elementsCopyNonIdenticalWithoutEqualElements.
	collection add: collection first copy.
	result := self elementsCopyNonIdenticalWithoutEqualElements class withAll: collection.
	^ result! !

!SortedCollectionTest methodsFor: 'tests - subcollections access' stamp: ''!
testLastNElements
	"self debug: #testLastNElements"
	| result |
	result := self moreThan3Elements last: self moreThan3Elements size - 1.
	1 
		to: result size
		do: [ :i | self assert: (result at: i) = (self moreThan3Elements at: i + 1) ].
	self assert: result size = (self moreThan3Elements size - 1).
	self 
		should: [ self moreThan3Elements last: self moreThan3Elements size + 1 ]
		raise: Error! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 10:32'!
accessCollection
" return a collection of size 5 "
	^accessCollection ! !

!SortedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testCollectFromTo
	
	| result |
	result:=self nonEmptyMoreThan1Element 
		collect: [ :each | each ]
		from: 1
		to: (self nonEmptyMoreThan1Element size - 1).
		
	1 to: result size
		do: [ :i | self assert: (self nonEmptyMoreThan1Element at: i) = (result at: i) ].
	self assert: result size = (self nonEmptyMoreThan1Element size - 1)! !

!SortedCollectionTest methodsFor: 'test - enumerating' stamp: 'TudorGirba 11/3/2013 20:42'!
testFlatCollect
	self assert: (#(1 2) asSortedCollection flatCollect: [ :x | { x } ]) = #(1 2) asOrderedCollection! !

!SortedCollectionTest methodsFor: 'tests - printing' stamp: ''!
testPrintNameOn

	| aStream result |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printNameOn: aStream .
	Transcript show: result asString.
	self nonEmpty class name first isVowel
		ifTrue:[ self assert: aStream contents =('an ',self nonEmpty class name ) ]
		ifFalse:[self assert: aStream contents =('a ',self nonEmpty class name)].! !

!SortedCollectionTest methodsFor: 'test - equality' stamp: ''!
testEqualSignIsTrueForNonIdenticalButEqualCollections
	"self debug: #testEqualSignIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty = self empty copy). 
	self assert: (self empty copy = self empty).
	self assert: (self empty copy = self empty copy).
		
	self assert: (self nonEmpty = self nonEmpty copy). 
	self assert: (self nonEmpty copy = self nonEmpty).
	self assert: (self nonEmpty copy = self nonEmpty copy).! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 10:38'!
elementInForElementAccessing
" return an element inculded in 'accessCollection '"
	^ self accessCollection anyOne! !

!SortedCollectionTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testIndexOfStartingAtDuplicate
	"self debug: #testLastIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection last.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'indexOf:ifAbsent:startingAt: should return the position of the first occurrence :'"
	self assert: (collection 
			indexOf: element
			startingAt: 1
			ifAbsent: [ 55 ]) = 1.
	self assert: (collection 
			indexOf: element
			startingAt: 2
			ifAbsent: [ 55 ]) = collection size! !

!SortedCollectionTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsCommaStringMore

	"self assert: self oneTwoThreeItemCol asCommaString = '1, 2, 3'.
	self assert: self oneTwoThreeItemCol asCommaStringAnd = '1, 2 and 3'
"

	| result resultAnd index allElementsAsString |
	result:= self nonEmpty asCommaString .
	resultAnd:= self nonEmpty asCommaStringAnd .
 
	index := 1.
	(result findBetweenSubStrs: ',' )do:
		[:each |
		index = 1
			ifTrue: [self assert: each= ((self nonEmpty at:index)asString)]
			ifFalse: [self assert: each= (' ',(self nonEmpty at:index) asString)].
		index:=index+1
		].
	
	"verifying esultAnd :"
	allElementsAsString:=(resultAnd findBetweenSubStrs: ',' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size )
			ifTrue: [
			i = 1
				ifTrue:[self assert: (allElementsAsString at:i)=((self nonEmpty at:i) asString)]
				ifFalse:[self assert: (allElementsAsString at:i)=(' ',(self nonEmpty at:i) asString)]
				].
		i=(allElementsAsString size)
			ifTrue:[ 
			i = 1
				ifTrue:[self assert: (allElementsAsString at:i)=( (self nonEmpty at:i ) asString ,' and ', (self nonEmpty at: ( i + 1) ) asString )]
				ifFalse:[self assert: (allElementsAsString at:i)=( ' ' , (self nonEmpty at:i ) asString ,' and ', (self nonEmpty at: ( i + 1) ) asString )]
				].
		
		
			].! !

!SortedCollectionTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWith
	"self debug: #testCopyNonEmptyWith"
	| res anElement |
	anElement := self elementToAdd .
	res := self nonEmpty copyWith: anElement.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self assert: (res includes: (anElement value)).
	self nonEmpty do: [ :each | res includes: each ]! !

!SortedCollectionTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfterLastEmpty
	| result |
	result := self empty copyAfterLast: self collectionWithoutEqualElements first.
	self assert: result isEmpty.! !

!SortedCollectionTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutAllNotIncluded
	"self debug: #testCopyNonEmptyWithoutAllNotIncluded"
	| res |
	res := self nonEmpty copyWithoutAll: self collectionNotIncluded.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self nonEmpty do: [ :each | self assert: (res includes: each) ]! !

!SortedCollectionTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyEmptyMethod
	| result |
	result := self collectionWithoutEqualElements  copyEmpty .
	self assert: result isEmpty .
	self assert: result class= self nonEmpty class.! !

!SortedCollectionTest methodsFor: 'tests - index access' stamp: 'delaunay 4/23/2009 15:14'!
testIdentityIndexOfIAbsent
	| collection element |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			identityIndexOf: element
			ifAbsent: [ 0 ]) = 1.
	self assert: (collection 
			identityIndexOf: self elementNotInForIndexAccessing
			ifAbsent: [ 55 ]) = 55! !

!SortedCollectionTest methodsFor: 'basic' stamp: 'nice 9/14/2009 21:02'!
testRemoveAll
	"Allows one to remove all elements of a collection" 
	
	| c1 c2 s2 |
	c1 := #(10 9 8 7 5 4 4 2) asSortedCollection: [:a :b | a >= b].
	c2 := c1 copy.
	s2 := c2 size.
	
	c1 removeAll.
	
	self assert: c1 size = 0.
	self assert: c2 size = s2 description: 'the copy has not been modified'.
	
	c1 add: 13; add: 14.
	self assert: (c1 first = 14 and: [c1 second = 13])  description: 'the sortBlock has been preserved'.! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 5/13/2009 15:48'!
collectionWithEqualElements
" return a collecition including atLeast two elements equal"

^ collectionOfFloatWithDuplicate ! !

!SortedCollectionTest methodsFor: 'tests - index access' stamp: 'delaunay 4/23/2009 15:14'!
testIndexOfSubCollectionStartingAt
	"self debug: #testIndexOfIfAbsent"
	| subcollection index collection |
	collection := self collectionMoreThan1NoDuplicates.
	subcollection := self collectionMoreThan1NoDuplicates.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 1.
	self assert: index = 1.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 2.
	self assert: index = 0! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/24/2009 10:29'!
collectionWithSortableElements
" return a collection elements that can be sorte ( understanding message ' < '  or ' > ')"
	^ collectionOfFloat ! !

!SortedCollectionTest methodsFor: 'tests - copying part of sequenceable for multipliness' stamp: ''!
testCopyAfterWithDuplicate
	| result element  collection |
	collection := self collectionWithSameAtEndAndBegining .
	element := collection  last.
	
	" collectionWithSameAtEndAndBegining first and last elements are equals.
	'copyAfter:' should copy after the first occurence :"
	result := collection   copyAfter: (element ).
	
	"verifying content: "
	1 to: result size do: 
		[:i |
		self assert: (collection  at:(i + 1 )) = (result at: (i))
		].

	"verify size: "
	self assert: result size = (collection size - 1).! !

!SortedCollectionTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedCollectionWithSortBlock
	| result tmp |
	result := self collectionWithSortableElements  asSortedCollection: [:a :b | a > b].
	self assert: (result class includesBehavior: SortedCollection).
	result do: 
		[ :each | 
		self assert: (self collectionWithSortableElements   occurrencesOf: each) = (result occurrencesOf: each) ].
	self assert: result size = self collectionWithSortableElements  size.
	tmp:=result at: 1.
	result do: [:each| self assert: tmp>=each. tmp:=each].
	! !

!SortedCollectionTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:23'!
test0FixtureTConvertAsSetForMultiplinessTest
	"a collection ofFloat with equal elements:"

	| res |
	self withEqualElements.
	self withEqualElements do: [ :each | self assert: each class = Float ].
	res := true.
	self withEqualElements detect: [ :each | (self withEqualElements occurrencesOf: each) > 1 ] ifNone: [ res := false ].
	self assert: res = true.	"a collection of Float without equal elements:"
	self elementsCopyNonIdenticalWithoutEqualElements.
	self elementsCopyNonIdenticalWithoutEqualElements do: [ :each | self assert: each class = Float ].
	res := true.
	self elementsCopyNonIdenticalWithoutEqualElements
		detect: [ :each | (self elementsCopyNonIdenticalWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/22/2009 13:46'!
collectionOfSize5
" return a collection of size 5"
^ accessCollection ! !

!SortedCollectionTest methodsFor: 'tests - index access' stamp: 'delaunay 4/23/2009 15:14'!
testIdentityIndexOf
	"self debug: #testIdentityIndexOf"
	| collection element |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection identityIndexOf: element) = (collection indexOf: element)! !

!SortedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureOccurrencesTest
	| tmp |
	self empty.
	self assert: self empty isEmpty.
	self collectionWithoutEqualElements.
	self deny: self collectionWithoutEqualElements isEmpty.
	tmp := OrderedCollection new.
	self collectionWithoutEqualElements
		do: [ :each | 
			self deny: (tmp includes: each).
			tmp add: each ].
	self elementNotInForOccurrences.
	self deny: (self collectionWithoutEqualElements includes: self elementNotInForOccurrences)! !

!SortedCollectionTest methodsFor: 'test - creation' stamp: ''!
testWithAll
	"self debug: #testWithAll"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection .
	aCol := self collectionClass withAll: collection  .
	
	collection do: [ :each | self assert: (aCol occurrencesOf: each ) = ( collection occurrencesOf: each ) ].
	
	self assert: (aCol size = collection size ).! !

!SortedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithDo
	
	| firstCollection secondCollection index |

	firstCollection := self nonEmptyMoreThan1Element.
	secondCollection := firstCollection copy.
	index := 0.
	
	firstCollection  with: secondCollection do:
		[:a :b |
		( index := index + 1).
		self assert: (firstCollection at: index) equals:  a. 
		self assert: (secondCollection at: index) equals:  b.]
	
	! !

!SortedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testAllButFirstDo
	
	| result |
	result:= OrderedCollection  new.
	
	self nonEmptyMoreThan1Element  allButFirstDo: [:each | result add: each].
	
	1 to: (result size) do:
		[:i|
		self assert: (self nonEmptyMoreThan1Element  at:(i +1))=(result at:i)].
	
	self assert: result size=(self nonEmptyMoreThan1Element  size-1).! !

!SortedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithDoError
	
	self should: [self nonEmptyMoreThan1Element with: self empty do:[:a :b | ]] raise: Error.! !

!SortedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testAtWrap
	"self debug: #testAt"
	"
	self assert: (self accessCollection at: 1) = 1.
	self assert: (self accessCollection at: 2) = 2.
	"
	| index |
	index := self moreThan4Elements indexOf: self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: index) = self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: index + self moreThan4Elements size) = self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: index - self moreThan4Elements size) = self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: 1 + self moreThan4Elements size) = (self moreThan4Elements at: 1)! !

!SortedCollectionTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithout
	"self debug: #testCopyNonEmptyWithout"
	
	| res anElementOfTheCollection |
	anElementOfTheCollection :=  self nonEmpty anyOne.
	res := (self nonEmpty copyWithout: anElementOfTheCollection).
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self deny: (res includes: anElementOfTheCollection).
	self nonEmpty do:
		[:each | (each = anElementOfTheCollection) 
					ifFalse: [self assert: (res includes: each)]].
	
! !

!SortedCollectionTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutNotIncluded
	"self debug: #testCopyNonEmptyWithoutNotIncluded"
	| res |
	res := self nonEmpty copyWithout: self elementToAdd.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self nonEmpty do: [ :each | self assert: (res includes: each) ]! !

!SortedCollectionTest methodsFor: 'tests - converting' stamp: ''!
testAsOrderedCollection
	
	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: OrderedCollection! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 5/13/2009 15:50'!
elementTwiceInForOccurrences
" return an element included exactly two time in # collectionWithEqualElements"
^ duplicateFloat ! !

!SortedCollectionTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionItself
	"self debug: #testIntersectionItself"
	
	| result |
	result :=  (self collectionWithoutEqualElements intersection: self collectionWithoutEqualElements).
	self assert: result size  = self collectionWithoutEqualElements size.
	self collectionWithoutEqualElements do: [ :each|
		self assert: (result includes: each) ].
	! !

!SortedCollectionTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOf
	| collection |
	collection := self collectionWithoutEqualElements .
	
	collection do: [ :each | self assert: (collection occurrencesOf: each) = 1 ].! !

!SortedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testKeysAndValuesDo
	"| result |
	result:= OrderedCollection new.
	
	self nonEmptyMoreThan1Element  keysAndValuesDo: 
		[:i :value|
		result add: (value+i)].
	
	1 to: result size do:
		[:i|
		self assert: (result at:i)=((self nonEmptyMoreThan1Element at:i)+i)]"
	|  indexes elements |
	indexes:= OrderedCollection new.
	elements := OrderedCollection new.
	
	self nonEmptyMoreThan1Element  keysAndValuesDo: 
		[:i :value|
		indexes  add: (i).
		elements add: value].
	
	(1 to: self nonEmptyMoreThan1Element size )do:
		[ :i |
		self assert: (indexes at: i) = i.
		self assert: (elements at: i) = (self nonEmptyMoreThan1Element at: i).	
		].
	
	self assert: indexes size = elements size. 
	self assert: indexes size = self nonEmptyMoreThan1Element size . 
	
	! !

!SortedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0CopyTest
	self empty.
	self assert: self empty size = 0.
	self nonEmpty.
	self assert: (self nonEmpty size = 0) not.
	self collectionWithElementsToRemove.
	self assert: (self collectionWithElementsToRemove size = 0) not.
	self collectionWithElementsToRemove do: [ :each | self assert: (self nonEmpty includes: each) ].
	self elementToAdd.
	self deny: (self nonEmpty includes: self elementToAdd).
	self collectionNotIncluded.
	self collectionNotIncluded do: [ :each | self deny: (self nonEmpty includes: each) ]! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/22/2009 11:58'!
indexInNonEmpty
" return an index between bounds of 'nonEmpty' "

	^ 2! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 14:14'!
collectionWithNonIdentitySameAtEndAndBegining
	" return a collection with elements at end and begining equals only with classic equality (they are not the same object).
(others elements of the collection are not equal to those elements)"
	^ floatCollectionSameEndAndBegining ! !

!SortedCollectionTest methodsFor: 'tests - begins ends with' stamp: ''!
testsBeginsWithEmpty
	
	self deny: (self nonEmpty beginsWith:(self empty)).
	self deny: (self empty beginsWith:(self nonEmpty )).
! !

!SortedCollectionTest methodsFor: 'tests - equality' stamp: ''!
testHasEqualElements
	"self debug: #testHasEqualElements"

	self deny: (self empty hasEqualElements: self nonEmpty).
	self deny: (self nonEmpty hasEqualElements: self nonEmpty asSet). 
	self deny: (self nonEmpty reversed hasEqualElements: self nonEmpty).
	self deny: (self nonEmpty hasEqualElements: self nonEmpty reversed).! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 12/18/2009 12:04'!
result

	 ^ collectResult! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 10:22'!
collectionWithCopyNonIdentical
	" return a collection that include elements for which 'copy' return a different object (this is not the case of SmallInteger)"
	^ collectionOfFloat! !

!SortedCollectionTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testIdentityIndexOfDuplicate
	"self debug: #testIdentityIndexOf"

	| collection element |
	"testing fixture here as this method may not be used by some collections testClass"
	self collectionWithNonIdentitySameAtEndAndBegining.
	collection := self collectionWithNonIdentitySameAtEndAndBegining.
	self assert: collection first = collection last.
	self deny: collection first == collection last.
	1 to: collection size do: [ :i | 
		i > 1 & (i < collection size)
			ifTrue: [ self deny: (collection at: i) = collection first ] ].
	element := collection last.	" floatCollectionWithSameAtEndAndBegining first and last elements are equals but are not the same object"
	self assert: (collection identityIndexOf: element) = collection size! !

!SortedCollectionTest methodsFor: 'test - equality' stamp: ''!
testEqualSign
	"self debug: #testEqualSign"

	self deny: (self empty = self nonEmpty).! !

!SortedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0TSequencedStructuralEqualityTest
	self nonEmpty at: 1	"Ensures #nonEmpty is sequenceable"! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 16:30'!
collectionClass
" return the class to be used to create instances of the class tested"
	^ SortedCollection! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 10:27'!
nonEmpty1Element
" return a collection of size 1 including one element"
	^ nonEmpty1Element ! !

!SortedCollectionTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedCollection

	| aCollection result |
	aCollection := self collectionWithSortableElements .
	result := aCollection asSortedCollection.
	
	self assert: (result class includesBehavior: SortedCollection).
	result do: 
		[ :each | 
		self assert: (aCollection occurrencesOf: each) = (result occurrencesOf: each) ].
	
	self assert: result size = aCollection size.! !

!SortedCollectionTest methodsFor: 'tests - set arithmetic' stamp: ''!
testUnion
	"self debug: #testUnionOfEmpties"
	
	| union |
	union := self empty union: self nonEmpty.
	self containsAll: union of: self empty andOf: self nonEmpty.
	union := self nonEmpty union: self empty.
	self containsAll: union of: self empty andOf: self nonEmpty.
	union := self collection union: self nonEmpty.
	self containsAll: union of: self collection andOf: self nonEmpty.! !

!SortedCollectionTest methodsFor: 'tests - begins ends with' stamp: ''!
testsBeginsWith
	
	self assert: (self nonEmpty beginsWith:(self nonEmpty copyUpTo: self nonEmpty last)).
	self assert: (self nonEmpty beginsWith:(self nonEmpty )).
	self deny: (self nonEmpty beginsWith:(self nonEmpty copyWith:self nonEmpty first)).! !

!SortedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testDo! !

!SortedCollectionTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWithout
	"self debug: #testCopyEmptyWithout"
	| res |
	res := self empty copyWithout: self elementToAdd.
	self assert: res size = self empty size.
	self deny: (res includes: self elementToAdd)! !

!SortedCollectionTest methodsFor: 'tests - equality' stamp: ''!
testHasEqualElementsIsTrueForNonIdenticalButEqualCollections
	"self debug: #testHasEqualElementsIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty hasEqualElements: self empty copy). 
	self assert: (self empty copy hasEqualElements: self empty).
	self assert: (self empty copy hasEqualElements: self empty copy).
		
	self assert: (self nonEmpty hasEqualElements: self nonEmpty copy). 
	self assert: (self nonEmpty copy hasEqualElements: self nonEmpty).
	self assert: (self nonEmpty copy hasEqualElements: self nonEmpty copy).! !

!SortedCollectionTest methodsFor: 'tests - copy' stamp: ''!
testCopySameClass
	"self debug: #testCopySameClass"
	"A copy of a collection should always be of the same class as the instance it copies"
	
	| copy | 
	copy := self empty copy.
	self assert: copy class == self empty class.! !

!SortedCollectionTest methodsFor: 'tests - as identity set' stamp: ''!
testAsIdentitySetWithIdentityEqualsElements
	| result |
	result := self collectionWithIdentical asIdentitySet.
	" Only one element should have been removed as two elements are equals with Identity equality"
	self assert: result size = (self collectionWithIdentical size - 1).
	self collectionWithIdentical do: 
		[ :each | 
		(self collectionWithIdentical occurrencesOf: each) > 1 
			ifTrue: 
				[ "the two elements equals only with classic equality shouldn't 'have been removed"
				self assert: (result asOrderedCollection occurrencesOf: each) = 1
				" the other elements are still here" ]
			ifFalse: [ self assert: (result asOrderedCollection occurrencesOf: each) = 1 ] ].
	self assert: result class = IdentitySet! !

!SortedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testAfter
	"self debug: #testAfter"
	self assert: (self moreThan4Elements after: (self moreThan4Elements at: 1)) = (self moreThan4Elements at: 2).
	self 
		should: 
			[ self moreThan4Elements after: (self moreThan4Elements at: self moreThan4Elements size) ]
		raise: Error.
	self 
		should: [ self moreThan4Elements after: self elementNotInForElementAccessing ]
		raise: Error! !

!SortedCollectionTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButFirstNElements
	"self debug: #testAllButFirst"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButFirst: 2.
	1 
		to: abf size
		do: [ :i | self assert: (abf at: i) = (col at: i + 2) ].
	self assert: abf size + 2 = col size! !

!SortedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureAsSetForIdentityMultiplinessTest
	"a collection (of elements for which copy is not identical ) without equal elements:"

	| anElement res |
	self elementsCopyNonIdenticalWithoutEqualElements.
	anElement := self elementsCopyNonIdenticalWithoutEqualElements anyOne.
	self deny: anElement copy == anElement.
	res := true.
	self elementsCopyNonIdenticalWithoutEqualElements
		detect: [ :each | (self elementsCopyNonIdenticalWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 10:51'!
oldSubCollection
" return a subCollection included in collectionWith1TimeSubcollection .
ex :   subCollection := #( 2 3 4) and collectionWith1TimeSubcollection := #(1 2 3 4 5)"
	^ oldSubcollection ! !

!SortedCollectionTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfter
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyAfter: (collection  at:index ).
	
	"verifying content: "
	(1) to: result size do: 
		[:i |
		self assert: (collection   at:(i + index ))=(result at: (i))].

	"verify size: "
	self assert: result size = (collection   size - index).! !

!SortedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixturePrintTest
	self nonEmpty! !

!SortedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testReverseWithDo
	
	| firstCollection secondCollection index |

	firstCollection := self nonEmptyMoreThan1Element.
	secondCollection := firstCollection copy.
	index := firstCollection size.
	
	firstCollection  reverseWith: secondCollection do:
		[:a :b |
	
		self assert: (firstCollection at: index) equals:  a. 
		self assert: (secondCollection at: index) equals:  b.
			( index := index - 1).]
	
	
	! !

!SortedCollectionTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyFromTo
	| result  index collection |
	collection := self collectionWithoutEqualElements .
	index :=self indexInForCollectionWithoutDuplicates .
	result := collection   copyFrom: index  to: collection  size .
	
	"verify content of 'result' : "
	1 to: result size do:
		[:i | 
		self assert: (result at:i)=(collection  at: (i + index - 1))].
	
	"verify size of 'result' : "
	self assert: result size = (collection  size - index + 1).! !

!SortedCollectionTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAllNoneThere
	"self debug: #testIncludesAllOfNoneThere'"
	self deny: (self empty includesAll: self nonEmpty ).
	self deny: (self nonEmpty includesAll: { self elementNotIn. self anotherElementNotIn })! !

!SortedCollectionTest methodsFor: 'tests - index access' stamp: 'delaunay 4/23/2009 15:14'!
testIndexOfStartingAt
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			indexOf: element
			startingAt: 2
			ifAbsent: [ 99 ]) = 99.
	self assert: (collection 
			indexOf: element
			startingAt: 1
			ifAbsent: [ 99 ]) = 1.
	self assert: (collection 
			indexOf: self elementNotInForIndexAccessing
			startingAt: 1
			ifAbsent: [ 99 ]) = 99! !

!SortedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testKeysAndValuesDoEmpty
	| result |
	result:= OrderedCollection new.
	
	self empty  keysAndValuesDo: 
		[:i :value|
		result add: (value+i)].
	
	self assert: result isEmpty .! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 10:39'!
elementNotInForElementAccessing
" return an element not included in 'accessCollection' "
	^ elementNoteIn ! !

!SortedCollectionTest methodsFor: 'tests - as set tests' stamp: ''!
testAsSetWithEqualsElements
	| result |
	result := self withEqualElements asSet.
	self withEqualElements do: [ :each | self assert: (result occurrencesOf: each) = 1 ].
	self assert: result class = Set! !

!SortedCollectionTest methodsFor: 'tests - printing' stamp: ''!
testPrintOnDelimiterLast

	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printOn: aStream delimiter: ', ' last: 'and'.
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 )
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString)].
		i=(allElementsAsString size-1)
			ifTrue:[ self deny: (allElementsAsString at:i)=('and')asString].
		i=(allElementsAsString size)
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:(i-1))asString)].
			].! !

!SortedCollectionTest methodsFor: 'tests - converting' stamp: ''!
testAsBag

	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: Bag! !

!SortedCollectionTest methodsFor: 'tests - copying part of sequenceable for multipliness' stamp: ''!
testCopyAfterLastWithDuplicate
	| result element  collection |
	collection := self collectionWithSameAtEndAndBegining .
	element := collection  first.
	
	" collectionWithSameAtEndAndBegining first and last elements are equals.
	'copyAfter:' should copy after the last occurence of element :"
	result := collection   copyAfterLast: (element ).
	
	"verifying content: "
	self assert: result isEmpty.

! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/22/2009 10:48'!
indexInForCollectionWithoutDuplicates
" return an index between 'collectionWithoutEqualsElements'  bounds"
	^ 2! !

!SortedCollectionTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWith
	"self debug: #testCopyWith"
	| res anElement |
	anElement := self elementToAdd.
	res := self empty copyWith: anElement.
	self assert: res size = (self empty size + 1).
	self assert: (res includes: (anElement value))! !

!SortedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureConverAsSortedTest
	self collectionWithSortableElements.
	self deny: self collectionWithSortableElements isEmpty! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/22/2009 10:23'!
collectionWith5Elements
" return a collection of size 5 including 5 elements"
^ accessCollection ! !

!SortedCollectionTest methodsFor: 'tests - copying with replacement for sorted' stamp: ''!
testCopyReplaceAllWithForSorted

| collection result |
collection := self collectionOfSize5 .

" testing that elements to be replaced are removed from the copy :"
result := collection copyReplaceAll: collection with: self empty .
self assert: result isEmpty.

" testing that replacement elements  are all put into the copy :"
result := collection copyReplaceAll: collection with: self replacementCollection .
 self replacementCollection do:
	[:each | 
	self assert: (result occurrencesOf: each) = ( self replacementCollection occurrencesOf: each )].

self assert: result size = self replacementCollection size.

! !

!SortedCollectionTest methodsFor: 'tests - removing by index' stamp: ''!
testRemoveAt

| collection element result oldSize |
collection := self collectionWith5Elements .
element := collection at: 3.
oldSize := collection size.

result := collection removeAt: 3.
self assert: result = element .
self assert: collection size = (oldSize - 1).! !

!SortedCollectionTest methodsFor: 'tests - printing' stamp: ''!
testStoreOn
" for the moment work only for collection that include simple elements such that Integer"

"| string str result cuttedResult index elementsAsStringExpected elementsAsStringObtained tmp |
string := ''.
str := ReadWriteStream  on: string.
elementsAsStringExpected := OrderedCollection new.
elementsAsStringObtained := OrderedCollection new.
self nonEmpty do: [ :each | elementsAsStringExpected  add: each asString].

self nonEmpty storeOn: str.
result := str contents .
cuttedResult := ( result findBetweenSubStrs: ';' ).

index := 1.

cuttedResult do:
	[ :each |
	index = 1 
		ifTrue: [ self assert: (each beginsWith: ( tmp := '((' , self nonEmpty class asString , ' new) add: '           )).
				tmp := each copyFrom: ( tmp size + 1) to: ( each size ).
				elementsAsStringObtained add: tmp.
				index := index + 1. ]
		ifFalse:  [ 
		 index < cuttedResult size
			ifTrue:[self assert: (each beginsWith: ( tmp:=  ' add: '   )).
				tmp := each copyFrom: ( tmp size + 1) to: ( each size ).
				elementsAsStringObtained add: tmp.
					index := index + 1.]
			ifFalse: [self assert: ( each = ' yourself)' ) ].
			]
	
	].


	elementsAsStringExpected do: [ :each | self assert: (elementsAsStringExpected occurrencesOf: each ) = ( elementsAsStringObtained occurrencesOf: each) ]"

! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 16:01'!
integerCollection
" return a collection only including SmallInteger elements"
	^ accessCollection ! !

!SortedCollectionTest methodsFor: 'tests - set arithmetic' stamp: ''!
numberOfSimilarElementsInIntersection
	^ self collection occurrencesOf: self anotherElementOrAssociationIn! !

!SortedCollectionTest methodsFor: 'tests - occurrencesOf for multipliness' stamp: ''!
testOccurrencesOfForMultipliness

| collection elem |
collection := self collectionWithEqualElements .
elem := self elementTwiceInForOccurrences .

self assert: (collection occurrencesOf: elem ) = 2.  ! !

!SortedCollectionTest methodsFor: 'tests - remove' stamp: ''!
testRemoveElementReallyRemovesElement
	"self debug: #testRemoveElementReallyRemovesElement"
	| size |
	size := self nonEmptyWithoutEqualElements size.
	self nonEmptyWithoutEqualElements remove: self nonEmptyWithoutEqualElements anyOne.
	self assert: size - 1 = self nonEmptyWithoutEqualElements size! !

!SortedCollectionTest methodsFor: 'tests - converting' stamp: ''!
assertNonDuplicatedContents: aCollection whenConvertedTo: aClass 
	| result |
	result := aCollection perform: ('as' , aClass name) asSymbol.
	self assert: (result class includesBehavior: aClass).
	result do: 
		[ :each | 
		self assert: (aCollection occurrencesOf: each) = (result occurrencesOf: each) ].
	^ result! !

!SortedCollectionTest methodsFor: 'tests - copying same contents' stamp: ''!
testShallowCopy
	| result |
	result := self nonEmpty shallowCopy .
	
	"verify content of 'result: '"
	1 to: self nonEmpty size do:
		[:i | self assert: ((result at:i)=(self nonEmpty at:i))].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!SortedCollectionTest methodsFor: 'tests - index access' stamp: 'delaunay 4/23/2009 15:14'!
testIndexOfIfAbsent
	"self debug: #testIndexOfIfAbsent"
	| collection |
	collection := self collectionMoreThan1NoDuplicates.
	self assert: (collection 
			indexOf: collection first
			ifAbsent: [ 33 ]) = 1.
	self assert: (collection 
			indexOf: self elementNotInForIndexAccessing
			ifAbsent: [ 33 ]) = 33! !

!SortedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyPartOfSequenceableTest
	self collectionWithoutEqualElements.
	self collectionWithoutEqualElements
		do: [ :each | self assert: (self collectionWithoutEqualElements occurrencesOf: each) = 1 ].
	self indexInForCollectionWithoutDuplicates.
	self
		assert:
			(self indexInForCollectionWithoutDuplicates > 0 & self indexInForCollectionWithoutDuplicates)
				< self collectionWithoutEqualElements size.
	self empty.
	self assert: self empty isEmpty! !

!SortedCollectionTest methodsFor: 'test - creation' stamp: ''!
testWithWithWith
	"self debug: #testWithWithWith"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom:1 to: 3 .
	aCol := self collectionClass with: (collection at:1) with: ( collection at:2 ) with: ( collection at: 3).

	1 to: 3 do: [ :i | self assert: ( aCol occurrencesOf: ( collection at: i ) ) = ( collection occurrencesOf: ( collection at: i ) ) ].! !

!SortedCollectionTest methodsFor: 'tests - converting' stamp: ''!
testAsIdentitySet
	"test with a collection without equal elements :"
	self 
		assertSameContents: self collectionWithoutEqualElements
		whenConvertedTo: IdentitySet.
! !

!SortedCollectionTest methodsFor: 'tests - converting' stamp: ''!
testAsByteArray
	| res |
	self integerCollectionWithoutEqualElements.
	self integerCollectionWithoutEqualElements do: [ :each | self assert: each class = SmallInteger ].
	res := true.
	self integerCollectionWithoutEqualElements
		detect: [ :each | (self integerCollectionWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false.
	self assertSameContents: self integerCollectionWithoutEqualElements whenConvertedTo: ByteArray! !

!SortedCollectionTest methodsFor: 'tests - converting' stamp: ''!
testAsSet
	| |
	"test with a collection without equal elements :"
	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: Set.
	! !

!SortedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyWithOrWithoutSpecificElementsTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self indexInNonEmpty.
	self assert: self indexInNonEmpty > 0.
	self assert: self indexInNonEmpty <= self nonEmpty size! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 10:34'!
elementNotInForIndexAccessing
" return an element not included in 'accessCollection' "
	^ elementNoteIn  	! !

!SortedCollectionTest methodsFor: 'tests - includes' stamp: ''!
testIncludesElementIsThere
	"self debug: #testIncludesElementIsThere"
	
	self assert: (self nonEmpty includes: self nonEmpty anyOne).! !

!SortedCollectionTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifferenceWithSeparateCollection
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifferenceWithSeparateCollection"
	| res separateCol |
	
	separateCol := self collectionClass with: self anotherElementOrAssociationNotIn.
	res := self collectionWithoutEqualElements difference: separateCol.
	
	self deny: (res includes: self anotherElementOrAssociationNotIn).
	self assert: res size equals: self collectionWithoutEqualElements size.
	
	self collectionWithoutEqualElements do: [ :each|
		self assert: (res includes: each)].
	
	res := separateCol difference: self collection.
	self deny: (res includes: self collection anyOne).
	self assert: res equals: separateCol! !

!SortedCollectionTest methodsFor: 'tests - index access' stamp: 'delaunay 4/23/2009 15:14'!
testIndexOfSubCollectionStartingAtIfAbsent
	"self debug: #testIndexOfIfAbsent"
	| index absent subcollection collection |
	collection := self collectionMoreThan1NoDuplicates.
	subcollection := self collectionMoreThan1NoDuplicates.
	absent := false.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 1
		ifAbsent: [ absent := true ].
	self assert: absent = false.
	absent := false.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 2
		ifAbsent: [ absent := true ].
	self assert: absent = true! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 15:10'!
collectionWithElement
	"Returns a collection that already includes what is returned by #element."
	^ SortedCollection new add: self element ; add: 5 ; add: 2; yourself.! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 14:11'!
withEqualElements
	" return a collection of float including equal elements (classic equality)"
	^ collectionOfFloatWithDuplicate! !

!SortedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testAtLastError
	"self debug: #testAtLast"
	self 
		should: [ self moreThan4Elements atLast: self moreThan4Elements size + 1 ]
		raise: Error! !

!SortedCollectionTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpToLastEmpty
	| result |
	result := self empty copyUpToLast: self collectionWithoutEqualElements first.
	self assert: result isEmpty.! !

!SortedCollectionTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpToLast
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyUpToLast: (collection  at:index).
	
	"verify content of 'result' :"
	1 to: result size do: [:i| self assert: (collection   at:i)=(result at:i)].
	
	"verify size of 'result' :"
	self assert: result size = (index-1).! !

!SortedCollectionTest methodsFor: 'tests - adding' stamp: ''!
testTAddIfNotPresentWithElementAlreadyIn

	| added oldSize collection anElement |
	collection := self collectionWithElement .
	oldSize := collection size.
	anElement := self element .
	self assert: (collection  includes: anElement ).
	
	added := collection  addIfNotPresent: anElement .
	
	self assert: added == anElement .	"test for identiy because #add: has not reason to copy its parameter."
	self assert: collection  size = oldSize! !

!SortedCollectionTest methodsFor: 'tests - printing' stamp: ''!
testPrintOn
	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printOn: aStream .
	allElementsAsString:=(result findBetweenSubStrs: ' ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i=1
			ifTrue:[
			self accessCollection class name first isVowel 
				ifTrue:[self assert: (allElementsAsString at:i)='an' ]
				ifFalse:[self assert: (allElementsAsString at:i)='a'].].
		i=2
			ifTrue:[self assert: (allElementsAsString at:i)=self accessCollection class name].
		i>2
			ifTrue:[self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString).].	
			].! !

!SortedCollectionTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpTo
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyUpTo: (collection  at:index).
	
	"verify content of 'result' :"
	1 to: result size do: [:i| self assert: (collection   at:i)=(result at:i)].
	
	"verify size of 'result' :"
	self assert: result size = (index-1).
	! !

!SortedCollectionTest methodsFor: 'basic' stamp: 'DM 3/16/2006 11:39'!
testCopy
	"self run: #testCopy"
	"self debug: #testCopy"
	
	|aSortedCollection copySorted|
	aSortedCollection := SortedCollection new.
	aSortedCollection sortBlock: [:a :b | a < b].
	aSortedCollection add: 'truite' ; add: 'brochet'.
	self assert: aSortedCollection first = 'brochet'.
	
	copySorted := aSortedCollection copy.
	
	self assert: (copySorted  hasEqualElements: aSortedCollection).
	self assert: (copySorted  species = aSortedCollection species).
	self assert: (copySorted  sortBlock = aSortedCollection sortBlock).
	self assert: copySorted first = 'brochet'.! !

!SortedCollectionTest methodsFor: 'basic' stamp: 'jannik.laval 5/2/2010 07:52'!
testSpeciesLooseSortBlock
	"This is a non regression test for http://bugs.squeak.org/view.php?id=6535"

	| numbers reverseOrder firstThree |
	numbers := #(1 2 3 4 5).
	reverseOrder := SortedCollection sortBlock: [:x :y | x > y].
	reverseOrder addAll: numbers.

	"The elements are inverted"
	self assert: (reverseOrder asArray = #(5 4 3 2 1)).

	"Copy the first 3 elements"
	firstThree := reverseOrder copyFrom: 1 to: 3.

	"It appears to work"
	self assert: (firstThree asArray = #(5 4 3)).

	"but we have lost the sort block"
	firstThree add: 1.

	" firstThree is now #(1 5 4 3)!! "
	self assert: firstThree asArray = #(5 4 3 1) "fails"! !

!SortedCollectionTest methodsFor: 'tests - remove' stamp: ''!
testRemoveElementFromEmpty
	"self debug: #testRemoveElementFromEmpty"
	self 
		should: [ self empty remove: self nonEmptyWithoutEqualElements anyOne ]
		raise: Error! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/22/2009 14:55'!
collectionWithElementsToRemove
" return a collection of elements included in 'nonEmpty'  "
	^ collectionIncluded ! !

!SortedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testLast
	"self debug: #testLast"
	self assert: self moreThan4Elements last = (self moreThan4Elements at: self moreThan4Elements size)! !

!SortedCollectionTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterLastMore

	| delim multiItemStream result last allElementsAsString |
	
	delim := ', '.
	last := 'and'.
	result:=''.
	multiItemStream := ReadWriteStream on:result.
	self nonEmpty  asStringOn: multiItemStream delimiter: ', ' last: last.
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 )
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString)].
		i=(allElementsAsString size-1)
			ifTrue:[ self deny: (allElementsAsString at:i)=(last)asString].
		i=(allElementsAsString size)
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:(i-1))asString)].
			].
	
! !

!SortedCollectionTest methodsFor: 'tests - copying same contents' stamp: ''!
testReversed
	| result |
	result := self nonEmpty reversed .
	
	"verify content of 'result: '"
	1 to:  result size do:
		[:i | self assert: ((result at:i)=(self nonEmpty at:(self nonEmpty size-i+1)))].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'stephane.ducasse 12/20/2008 22:24'!
expectedSizeAfterReject
	^1! !

!SortedCollectionTest methodsFor: 'tests - adding' stamp: ''!
testTAdd
	| added collection |
	collection :=self otherCollection .
	added := collection add: self element.
	
	self assert: added == self element.	"test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection includes: self element)	.
	self assert: (self collectionWithElement includes: self element).
	
	! !

!SortedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIncludeTest
	| anElementIn |
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self elementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self elementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self anotherElementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self anotherElementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self empty.
	self assert: self empty isEmpty! !

!SortedCollectionTest methodsFor: 'tests - includes' stamp: 'CamilloBruni 8/31/2013 20:23'!
testIdentityIncludes
	" test the comportement in presence of elements 'includes' but not 'identityIncludes' "

	" can not be used by collections that can't include elements for wich copy doesn't return another instance "

	| collection element |
	self collectionWithCopyNonIdentical.
	collection := self collectionWithCopyNonIdentical.
	element := collection anyOne copy.	"self assert: (collection includes: element)."
	self deny: (collection identityIncludes: element)! !

!SortedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIndexAccessFotMultipliness
	self collectionWithSameAtEndAndBegining.
	self assert: self collectionWithSameAtEndAndBegining first = self collectionWithSameAtEndAndBegining last.
	self assert: self collectionWithSameAtEndAndBegining size > 1.
	1 to: self collectionWithSameAtEndAndBegining size do: [ :i | 
		i > 1 & (i < self collectionWithSameAtEndAndBegining size)
			ifTrue: [ self deny: (self collectionWithSameAtEndAndBegining at: i) = self collectionWithSameAtEndAndBegining first ] ]! !

!SortedCollectionTest methodsFor: 'tests - includes' stamp: ''!
testIncludesElementIsNotThere
	"self debug: #testIncludesElementIsNotThere"
	
	self deny: (self nonEmpty includes: self elementNotIn).
	self assert: (self nonEmpty includes: self nonEmpty anyOne).
	self deny: (self empty includes: self elementNotIn)! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 12/18/2009 13:33'!
replacementCollection
" return a collection that will be used to replace 'oldSubcollection' in ' collectionWith1TimeSubcollection'  " 
	^ collectionWith4Elements  ! !

!SortedCollectionTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfterEmpty
	| result |
	result := self empty copyAfter: self collectionWithoutEqualElements first.
	self assert: result isEmpty.
	! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/22/2009 11:12'!
collectionWithSameAtEndAndBegining
" return a collection with elements at end and begining equals .
(others elements of the collection are not equal to those elements)"
	^ floatCollectionSameEndAndBegining ! !

!SortedCollectionTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testLastIndexOfStartingAtDuplicate
	"self debug: #testLastIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection last.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'lastIndexOf:ifAbsent:startingAt: should return the position of the last occurrence :'"
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size
			ifAbsent: [ 55 ]) = collection size.
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size - 1
			ifAbsent: [ 55 ]) = 1! !

!SortedCollectionTest methodsFor: 'tests - removing by index' stamp: ''!
testRemoveLastNotPresent

self should: [self empty removeLast] raise: Error.! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 14:47'!
integerCollectionWithoutEqualElements
" return a collection of integer without equal elements"
	^ withoutEqualElements ! !

!SortedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testReverseDo
	| result |
	result:= OrderedCollection new.
	self nonEmpty reverseDo: [: each | result add: each].
	
	1 to: result size do:
		[:i|
		self assert: (result at: i)=(self nonEmpty at:(self nonEmpty size-i+1))].! !

!SortedCollectionTest methodsFor: 'tests - copy' stamp: ''!
testCopyEquals
	"self debug: #testCopySameClass"
	"A copy should be equivalent to the things it's a copy of"
	
	| copy | 
	copy := self nonEmpty copy.
	self assert: copy  = self nonEmpty.! !

!SortedCollectionTest methodsFor: 'basic' stamp: 'DM 3/16/2006 11:30'!
testCreation
	"self run: #testCreation"
	"self debug: #testCreation"
	
	| collection |
	collection := #(10 9 3 6 1 8 7 5 4 2) asSortedCollection.
	self assert: collection = (1 to: 10) asSortedCollection.
	! !

!SortedCollectionTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testIndexOfDuplicate
	"self debug: #testIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection last.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'indexOf: should return the position of the first occurrence :'"
	self assert: (collection indexOf: element) = 1! !

!SortedCollectionTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWithoutAll
	"self debug: #testCopyEmptyWithoutAll"
	| res |
	res := self empty copyWithoutAll: self collectionWithElementsToRemove.
	self assert: res size = self empty size.
	self collectionWithElementsToRemove do: [ :each | self deny: (res includes: each) ]! !

!SortedCollectionTest methodsFor: 'tests - adding' stamp: ''!
testTAddIfNotPresentWithNewElement

	| added oldSize collection elem |
	collection := self otherCollection .
	oldSize := collection  size.
	elem := self element .
	self deny: (collection  includes: elem ).
	
	added := collection  addIfNotPresent: elem .
	self assert: added == elem . "test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection  size = (oldSize + 1)).

	! !

!SortedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testAtPin
	"self debug: #testAtPin"
	self assert: (self moreThan4Elements atPin: 2) = self moreThan4Elements second.
	self assert: (self moreThan4Elements atPin: 99) = self moreThan4Elements last.
	self assert: (self moreThan4Elements atPin: -99) = self moreThan4Elements first! !

!SortedCollectionTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutAll
	"self debug: #testCopyNonEmptyWithoutAll"
	| res |
	res := self nonEmpty copyWithoutAll: self collectionWithElementsToRemove.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self collectionWithElementsToRemove do: [ :each | self deny: (res includes: (each)) ].
	self nonEmpty do: 
		[ :each | 
		(self collectionWithElementsToRemove includes: each) ifFalse: [ self assert: (res includes: each) ] ]! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 13:46'!
elementsCopyNonIdenticalWithoutEqualElements
	" return a collection that does niot incllude equal elements ( classic equality )"
	^ collectionOfFloat! !

!SortedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testAtLastIfAbsent
	"self debug: #testAtLastIfAbsent"
	self assert: (self moreThan4Elements 
			atLast: 1
			ifAbsent: [ nil ]) = self moreThan4Elements last.
	self assert: (self moreThan4Elements 
			atLast: self moreThan4Elements size + 1
			ifAbsent: [ 222 ]) = 222! !

!SortedCollectionTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButLastNElements
	"self debug: #testAllButFirst"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButLast: 2.
	1 
		to: abf size
		do: [ :i | self assert: (abf at: i) = (col at: i) ].
	self assert: abf size + 2 = col size! !

!SortedCollectionTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfterLast
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyAfterLast: (collection  at:index ).
	
	"verifying content: "
	(1) to: result size do: 
		[:i |
		self assert: (collection   at:(i + index ))=(result at: (i))].

	"verify size: "
	self assert: result size = (collection   size - index).! !

!SortedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindFirstNotIn

	| result |
	
	 result:=self empty findFirst: [:each | true].
	
	self assert: result=0. ! !

!SortedCollectionTest methodsFor: 'test - equality' stamp: ''!
testEqualSignIsTrueForEmptyButNonIdenticalCollections
	"self debug: #testEqualSignIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty = self empty copy). 
	self assert: (self empty copy = self empty).
	self assert: (self empty copy = self empty copy).
		
! !

!SortedCollectionTest methodsFor: 'basic' stamp: 'DM 3/16/2006 11:38'!
testSortBlock
	"self run: #testSortBlock"
	"self debug: #testSortBlock"
	
	|aSortedCollection|
	aSortedCollection := SortedCollection new.
	aSortedCollection sortBlock: [:a :b | a < b].
	aSortedCollection add: 'truite' ; add: 'brochet' ; add: 'tortue'.
	self assert: aSortedCollection first = 'brochet'.
	
	aSortedCollection := SortedCollection new.
	aSortedCollection sortBlock: [:a :b | a >b].
	aSortedCollection add: 'truite' ; add: 'brochet' ; add: 'tortue'.
	self assert: aSortedCollection first = 'truite'.
	
	
	! !

!SortedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureOccurrencesForMultiplinessTest
	| cpt anElement collection |
	self collectionWithEqualElements.
	self collectionWithEqualElements.
	self elementTwiceInForOccurrences.
	anElement := self elementTwiceInForOccurrences.
	collection := self collectionWithEqualElements.
	cpt := 0.	" testing with identity check ( == ) so that identy collections can use this trait : "
	self collectionWithEqualElements
		do: [ :each | 
			each == self elementTwiceInForOccurrences
				ifTrue: [ cpt := cpt + 1 ] ].
	self assert: cpt = 2! !

!SortedCollectionTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsCommaStringEmpty

	self assert: self empty asCommaString = ''.
	self assert: self empty asCommaStringAnd = ''.
	
! !

!SortedCollectionTest methodsFor: 'tests - converting' stamp: ''!
assertNoDuplicates: aCollection whenConvertedTo: aClass 
	| result |
	result := self collectionWithEqualElements asIdentitySet.
	self assert: (result class includesBehavior: IdentitySet).
	self collectionWithEqualElements do: [ :initial | self assert: (result occurrencesOf: initial) = 1 ]! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'stephane.ducasse 12/20/2008 22:17'!
nonEmpty
	
	^ nonEmpty! !

!SortedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testAfterIfAbsent
	"self debug: #testAfterIfAbsent"
	self assert: (self moreThan4Elements 
			after: (self moreThan4Elements at: 1)
			ifAbsent: [ 33 ]) = (self moreThan4Elements at: 2).
	self assert: (self moreThan4Elements 
			after: (self moreThan4Elements at: self moreThan4Elements size)
			ifAbsent: [ 33 ]) = 33.
	self assert: (self moreThan4Elements 
			after: self elementNotInForElementAccessing
			ifAbsent: [ 33 ]) = 33! !

!SortedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCreationWithTest
	self collectionMoreThan5Elements.
	self assert: self collectionMoreThan5Elements size >= 5! !

!SortedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindLast

	| element result |
	element := self nonEmptyMoreThan1Element  at:self nonEmptyMoreThan1Element  size.
	 result:=self nonEmptyMoreThan1Element  findLast: [:each | each =element].
	
	self assert: result=self nonEmptyMoreThan1Element  size. ! !

!SortedCollectionTest methodsFor: 'tests - remove' stamp: ''!
testRemoveAllFoundIn
	"self debug: #testRemoveElementThatExists"
	| el aSubCollection res |
	el := self nonEmptyWithoutEqualElements anyOne.
	aSubCollection := (self nonEmptyWithoutEqualElements copyWithout: el) copyWith: self elementNotIn.
	res := self nonEmptyWithoutEqualElements removeAllFoundIn: aSubCollection.
	self assert: self nonEmptyWithoutEqualElements size = 1.
	self nonEmptyWithoutEqualElements do: [ :each | self assert: each = el ]! !

!SortedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureRequirementsOfTAddTest
	self collectionWithElement.
	self otherCollection.
	self element.
	self assert: (self collectionWithElement includes: self element).
	self deny: (self otherCollection includes: self element)! !

!SortedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testReverseDoEmpty
	| result |
	result:= OrderedCollection new.
	self empty reverseDo: [: each | result add: each].
	
	self assert: result isEmpty .! !

!SortedCollectionTest methodsFor: 'test - creation' stamp: ''!
testWithWith
	"self debug: #testWithWith"
	
	| aCol collection element1 element2 |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom: 1 to: 2  .
	element1 := collection at: 1.
	element2 := collection at:2.
	
	aCol := self collectionClass with: element1  with: element2 .
	self assert: (aCol occurrencesOf: element1 ) = ( collection occurrencesOf: element1).
	self assert: (aCol occurrencesOf: element2 ) = ( collection occurrencesOf: element2).
	
	! !

!SortedCollectionTest methodsFor: 'requirements' stamp: ''!
collectionWithIdentical
	"return a collection of type : 'self collectionWIithoutEqualsElements class containing two elements equals ( with identity equality)"
	| result collection anElement |
	collection := OrderedCollection withAll: self elementsCopyNonIdenticalWithoutEqualElements.
	anElement := collection first.
	collection add: anElement.
	result := self elementsCopyNonIdenticalWithoutEqualElements class withAll: collection.
	^ result! !

!SortedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testFirstSecondThird
	"self debug: #testFirstSecondThird"
	self assert: self moreThan4Elements first = (self moreThan4Elements at: 1).
	self assert: self moreThan4Elements second = (self moreThan4Elements at: 2).
	self assert: self moreThan4Elements third = (self moreThan4Elements at: 3).
	self assert: self moreThan4Elements fourth = (self moreThan4Elements at: 4)! !

!SortedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureTRemoveTest
	| duplicate |
	self empty.
	self nonEmptyWithoutEqualElements.
	self deny: self nonEmptyWithoutEqualElements isEmpty.
	duplicate := true.
	self nonEmptyWithoutEqualElements
		detect: [ :each | (self nonEmptyWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ duplicate := false ].
	self assert: duplicate = false.
	self elementNotIn.
	self assert: self empty isEmpty.
	self deny: self nonEmptyWithoutEqualElements isEmpty.
	self deny: (self nonEmptyWithoutEqualElements includes: self elementNotIn)! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 12/18/2009 13:19'!
sizeCollection
	^ collectionWith4Elements ! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'stephane.ducasse 12/20/2008 22:17'!
empty
	
	^ empty! !

!SortedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testAtLast
	"self debug: #testAtLast"
	| index |
	self assert: (self moreThan4Elements atLast: 1) = self moreThan4Elements last.
	"tmp:=1.
	self do:
		[:each | 
		each =self elementInForIndexAccessing 
			ifTrue:[index:=tmp].
		tmp:=tmp+1]."
	index := self moreThan4Elements indexOf: self elementInForElementAccessing.
	self assert: (self moreThan4Elements atLast: index) = (self moreThan4Elements at: self moreThan4Elements size - index + 1)! !

!SortedCollectionTest methodsFor: 'tests - removing by index' stamp: ''!
testRemoveAtNotPresent

| |
self should: [self empty removeAt: 2] raise: Error.! !

!SortedCollectionTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterEmpty

	| delim emptyStream |
	delim := ', '.
	emptyStream := ReadWriteStream on: ''.
	self empty asStringOn: emptyStream delimiter: delim.
	self assert: emptyStream contents = ''.
! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 12/18/2009 13:15'!
collection

	^ collectionWith4Elements! !

!SortedCollectionTest methodsFor: 'basic' stamp: 'StephaneDucasse 12/29/2009 21:05'!
testSort
	"self run: #testSort"
	| s |
 	s := SortedCollection withAll: #(3 2 1).
 	self assert: s asArray = #(1 2 3).
 	s sort: [:a :b | a >=b]. 
 	self assert: s asArray = #(3 2 1).
 	s add: 4.
 	self assert: s asArray = #(4 3 2 1).
 	s := SortedCollection new 
 		sortBlock: [:a :b | a >=b];
 		addAll: #(1 2 3);
 		yourself.
 	self assert: s asArray = #(3 2 1).
 	s sort.
 	self assert: s asArray = #(1 2 3).
 	s add: 0.
 	self assert: s asArray = #(0 1 2 3)! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 12:00'!
anotherElementOrAssociationIn
	" return an element (or an association for Dictionary ) present  in 'collection' "
	^ self collection anyOne! !

!SortedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureRemoveByIndexTest
	self collectionWith5Elements.
	self assert: self collectionWith5Elements size = 5! !

!SortedCollectionTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionEmpty
	"self debug: #testIntersectionEmpty"
	
	| inter |
	inter := self empty intersection: self empty.
	self assert: inter isEmpty. 
	inter := self empty intersection: self collection .
	self assert: inter =  self empty.
	! !

!SortedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testAtRandom
	| result |
	result := self nonEmpty atRandom .
	self assert: (self nonEmpty includes: result).! !

!SortedCollectionTest methodsFor: 'tests - converting' stamp: ''!
assertSameContents: aCollection whenConvertedTo: aClass 
	| result |
	result := self assertNonDuplicatedContents: aCollection whenConvertedTo: aClass.
	self assert: result size = aCollection size! !

!SortedCollectionTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testIdentityIndexOfIAbsentDuplicate
	"self debug: #testIdentityIndexOfIfAbsent"
	| collection element elementCopy |
	collection := self collectionWithNonIdentitySameAtEndAndBegining .
	element := collection last.
	elementCopy := element copy.
	self deny: element  == elementCopy .
	self assert: (collection 
			identityIndexOf: element
			ifAbsent: [ 0 ]) = collection size.
	self assert: (collection 
			identityIndexOf: elementCopy
			ifAbsent: [ 55 ]) = 55! !

!SortedCollectionTest methodsFor: 'tests - equality' stamp: ''!
testEqualSignForSequenceableCollections
	"self debug: #testEqualSign"

	self deny: (self nonEmpty = self nonEmpty asSet). 
	self deny: (self nonEmpty reversed = self nonEmpty).
	self deny: (self nonEmpty = self nonEmpty reversed).! !

!SortedCollectionTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOfNotIn
	| result |
	result := self collectionWithoutEqualElements occurrencesOf: self elementNotInForOccurrences.
	self assert: result = 0! !

!SortedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureBeginsEndsWithTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self assert: self nonEmpty size > 1.
	self empty.
	self assert: self empty isEmpty! !

!SortedCollectionTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifferenceWithNonNullIntersection
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifferenceWithNonNullIntersection"
	"	#(1 2 3) difference: #(2 4) 
	->  #(1 3)"
	| res overlapping |
	overlapping := self collectionClass 
		with: self anotherElementOrAssociationNotIn
		with: self anotherElementOrAssociationIn.
	res := self collection difference: overlapping.
	self deny: (res includes: self anotherElementOrAssociationIn).
	overlapping do: [ :each | self deny: (res includes: each) ]! !

!SortedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testAtIfAbsent
	"self debug: #testAt"
	| absent |
	absent := false.
	self moreThan4Elements 
		at: self moreThan4Elements size + 1
		ifAbsent: [ absent := true ].
	self assert: absent = true.
	absent := false.
	self moreThan4Elements 
		at: self moreThan4Elements size
		ifAbsent: [ absent := true ].
	self assert: absent = false! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/22/2009 14:55'!
collectionNotIncluded
" return a collection for wich each element is not included in 'nonEmpty' "
	^ collectionNotIncluded ! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/2/2009 11:53'!
elementNotInForOccurrences
	^ 666! !

!SortedCollectionTest methodsFor: 'tests - removing by index' stamp: ''!
testRemoveFirstNElementsNotPresent

self should: [self empty removeFirst: 2] raise: Error.! !

!SortedCollectionTest methodsFor: 'test - equality' stamp: ''!
testEqualSignOfIdenticalCollectionObjects
	"self debug: #testEqualSignOfIdenticalCollectionObjects"
	
	self assert: (self empty = self empty). 
	self assert: (self nonEmpty = self nonEmpty). 
	! !

!SortedCollectionTest methodsFor: 'tests - index access' stamp: 'delaunay 4/23/2009 15:14'!
testIndexOf
	"self debug: #testIndexOf"
	| tmp index collection |
	collection := self collectionMoreThan1NoDuplicates.
	tmp := collection size.
	collection reverseDo: 
		[ :each | 
		each = self elementInForIndexAccessing ifTrue: [ index := tmp ].
		tmp := tmp - 1 ].
	self assert: (collection indexOf: self elementInForIndexAccessing) = index! !

!SortedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSubcollectionAccessTest
	self moreThan3Elements.
	self assert: self moreThan3Elements size > 2! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 12:00'!
anotherElementOrAssociationNotIn
	" return an element (or an association for Dictionary )not present  in 'collection' "
	^ elementNoteIn ! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/23/2009 15:22'!
elementInForIndexAccessing
" return an element included in 'accessCollection' "
	^ self collectionMoreThan1NoDuplicates  anyOne! !

!SortedCollectionTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testLastIndexOfIfAbsentDuplicate
	"self debug: #testIndexOfIfAbsent"
	"self debug: #testLastIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection first.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'lastIndexOf: should return the position of the last occurrence :'"
	self assert: (collection 
			lastIndexOf: element
			ifAbsent: [ 55 ]) = collection size! !

!SortedCollectionTest methodsFor: 'tests - as set tests' stamp: ''!
testAsIdentitySetWithEqualsElements
	| result collection |
	collection := self withEqualElements .
	result := collection asIdentitySet.
	collection do: [ :each | self assert: (result occurrencesOf: each) = 1 ].
	self assert: result class = IdentitySet.! !

!SortedCollectionTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionBasic
	"self debug: #testIntersectionBasic"
	| inter |
	inter := self collection intersection: (self collectionClass with: self anotherElementOrAssociationIn).
	self deny: inter isEmpty.
	self assert: (inter includes: self anotherElementOrAssociationIn value)! !

!SortedCollectionTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifference
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifference"
	
	| difference |
	self assert: (self collectionWithoutEqualElements difference: self collectionWithoutEqualElements) isEmpty.
	self assert: (self empty difference: self collectionWithoutEqualElements) isEmpty.
	difference := (self collectionWithoutEqualElements difference: self empty).
	self assert: difference size = self collectionWithoutEqualElements	 size.
	self collectionWithoutEqualElements do: [ :each |
		self assert: (difference includes: each)].
! !

!SortedCollectionTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButFirst
	"self debug: #testAllButFirst"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButFirst.
	self deny: abf first = col first.
	self assert: abf size + 1 = col size! !

!SortedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSequencedElementAccessTest
	self moreThan4Elements.
	self assert: self moreThan4Elements size >= 4.
	self subCollectionNotIn.
	self subCollectionNotIn detect: [ :each | (self moreThan4Elements includes: each) not ] ifNone: [ self assert: false ].
	self elementNotInForElementAccessing.
	self deny: (self moreThan4Elements includes: self elementNotInForElementAccessing).
	self elementInForElementAccessing.
	self assert: (self moreThan4Elements includes: self elementInForElementAccessing)! !

!SortedCollectionTest methodsFor: 'basic' stamp: 'DM 3/16/2006 11:30'!
testAddAll
	"self run: #testAddAll"
	"self debug: #testAddAll"
	
	| sorted2 sorted|
	sorted2 := SortedCollection new.
	sorted2 add: 'brochet'; add:'truitelle'.
	sorted := SortedCollection new.
	sorted addAll: sorted2.
	self assert: (sorted hasEqualElements: sorted2).
	 ! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 15:09'!
element
	"Returns an object that can be added to the collection returned by #collection."
	^ 88! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 15:11'!
otherCollection
	"Returns a collection that does not include what is returned by #element."
	 ^ SortedCollection new add:  7 ; add: 5 ; add: 2; yourself.! !

!SortedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testAllButLastDo
	
	| result |
	result:= OrderedCollection  new.
	
	self nonEmptyMoreThan1Element  allButLastDo: [:each | result add: each].
	
	1 to: (result size) do:
		[:i|
		self assert: (self nonEmptyMoreThan1Element  at:(i ))=(result at:i)].
	
	self assert: result size=(self nonEmptyMoreThan1Element  size-1).! !

!SortedCollectionTest methodsFor: 'tests - remove' stamp: ''!
testRemoveAllSuchThat
	"self debug: #testRemoveElementThatExists"
	| el aSubCollection |
	el := self nonEmptyWithoutEqualElements anyOne.
	aSubCollection := self nonEmptyWithoutEqualElements copyWithout: el.
	self nonEmptyWithoutEqualElements removeAllSuchThat: [ :each | aSubCollection includes: each ].
	self assert: self nonEmptyWithoutEqualElements size = 1.
	self nonEmptyWithoutEqualElements do: [ :each | self assert: each = el ]! !

!SortedCollectionTest methodsFor: 'basic' stamp: 'DM 3/16/2006 11:42'!
testEquals
	"self run: #testEquals"
	"self debug: #testEquals"
	
	|aSortedCollection|
	aSortedCollection := SortedCollection new.
	aSortedCollection add:'truite' ; add: 'brochet'.
	self assert: aSortedCollection copy = aSortedCollection.! !

!SortedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyPartOfForMultipliness
	self collectionWithSameAtEndAndBegining.
	self assert: self collectionWithSameAtEndAndBegining first = self collectionWithSameAtEndAndBegining last.
	self assert: self collectionWithSameAtEndAndBegining size > 1.
	1 to: self collectionWithSameAtEndAndBegining size do: [ :i | 
		i > 1 & (i < self collectionWithSameAtEndAndBegining size)
			ifTrue: [ self deny: (self collectionWithSameAtEndAndBegining at: i) = self collectionWithSameAtEndAndBegining first ] ]! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 11:28'!
nonEmptyWithoutEqualElements
" return a collection without equal elements "
	^ withoutEqualElements ! !

!SortedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testPairsCollect
	
	| index result |
	index:=0.
	
	result:=self nonEmptyMoreThan1Element  pairsCollect: 
		[:each1 :each2 | 
		self assert: ( self nonEmptyMoreThan1Element indexOf: each2 ) = (index := index + 2).
		(self nonEmptyMoreThan1Element indexOf: each2) = ((self nonEmptyMoreThan1Element indexOf: each1) + 1).
		].
	
	result do: 
		[:each | self assert: each = true].
	
! !

!SortedCollectionTest methodsFor: 'tests - removing by index' stamp: ''!
testRemoveLast

| collection element result oldSize |
collection := self collectionWith5Elements .
element := collection last.
oldSize := collection size.

result := collection removeLast.
self assert: result = element .
self assert: collection size = (oldSize - 1).! !

!SortedCollectionTest methodsFor: 'tests - copying same contents' stamp: ''!
testShallowCopyEmpty
	| result |
	result := self empty shallowCopy .
	self assert: result isEmpty .! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 10:49'!
subCollectionNotIn
" return a collection for which at least one element is not included in 'accessCollection' "
	^ SortedCollection new add: elementNoteIn ; add: elementNoteIn ; yourself.! !

!SortedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithIndexDo
	
	"| result |
	result:=Array new: self nonEmptyMoreThan1Element size.
	self nonEmptyMoreThan1Element  withIndexDo: [:each :i | result at:i put:(each+i)].
	
	1 to: result size do:[: i | self assert: (result at:i)= ((self nonEmptyMoreThan1Element at: i) + i)]"
	|  indexes elements |
	indexes:= OrderedCollection new.
	elements := OrderedCollection new.
	
	self nonEmptyMoreThan1Element  withIndexDo: 
		[:value :i  |
		indexes  add: (i).
		elements add: value].
	
	(1 to: self nonEmptyMoreThan1Element size )do:
		[ :i |
		self assert: (indexes at: i) = i.
		self assert: (elements at: i) = (self nonEmptyMoreThan1Element at: i).	
		].
	
	self assert: indexes size = elements size. 
	self assert: indexes size = self nonEmptyMoreThan1Element size . 
	! !

!SortedCollectionTest methodsFor: 'tests - copying same contents' stamp: ''!
testReverse

	| result |
	result := self nonEmpty reversed.	
	"verify content of 'result: '"
	1 to: result size do:
		[:i | self assert: ((result at: i) 
			= (self nonEmpty at: (self nonEmpty size - i + 1)))].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!SortedCollectionTest methodsFor: 'test - creation' stamp: ''!
testWithWithWithWith
	"self debug: #testWithWithWithWith"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom: 1 to: 4.
	aCol := self collectionClass with: (collection at:1) with: ( collection at:2 ) with: ( collection at: 3) with: ( collection at: 4).

	1 to: 3 do: [ :i | self assert: ( aCol occurrencesOf: ( collection at: i ) ) = ( collection occurrencesOf: ( collection at: i ) ) ].! !

!SortedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testBeforeIfAbsent
	"self debug: #testBefore"
	self assert: (self moreThan4Elements 
			before: (self moreThan4Elements at: 1)
			ifAbsent: [ 99 ]) = 99.
	self assert: (self moreThan4Elements 
			before: (self moreThan4Elements at: 2)
			ifAbsent: [ 99 ]) = (self moreThan4Elements at: 1)! !

!SortedCollectionTest methodsFor: 'tests - as identity set' stamp: ''!
testAsIdentitySetWithoutIdentityEqualsElements
	| result collection |
	collection := self collectionWithCopy.
	result := collection asIdentitySet.
	" no elements should have been removed as no elements are equels with Identity equality"
	self assert: result size = collection size.
	collection do: 
		[ :each | 
		(collection occurrencesOf: each) = (result asOrderedCollection occurrencesOf: each) ].
	self assert: result class = IdentitySet! !

!SortedCollectionTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpToEmpty
	| result |
	result := self empty copyUpTo: self collectionWithoutEqualElements first.
	self assert: result isEmpty.
	! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'stephane.ducasse 12/20/2008 22:23'!
speciesClass
	
	^ SortedCollection! !

!SortedCollectionTest methodsFor: 'tests - set arithmetic' stamp: ''!
containsAll: union of: one andOf: another
			
	self assert: (one allSatisfy: [:each | union includes: each]).
	self assert: (another allSatisfy: [:each | union includes: each])! !

!SortedCollectionTest methodsFor: 'tests - removing by index' stamp: ''!
testRemoveFirstNotPresent

self should: [self empty removeFirst] raise: Error.! !

!SortedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFromToDo
	
	| result |
	result:= OrderedCollection  new.
	
	self nonEmptyMoreThan1Element  from: 1 to: (self nonEmptyMoreThan1Element  size -1) do: [:each | result add: each].
	
	1 to: (self nonEmptyMoreThan1Element  size -1) do:
		[:i|
		self assert: (self nonEmptyMoreThan1Element  at:i )=(result at:i)].
	self assert: result size=(self nonEmptyMoreThan1Element  size-1).! !

!SortedCollectionTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopySameContentsTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!SortedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindLastNotIn

	| result |
	
	 result:=self empty findFirst: [:each | true].
	
	self assert: result=0. ! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 13:41'!
floatCollectionWithSameAtEndAndBegining
" return a collection with elements at end and begining equals only with classic equality (they are not the same object).
(others elements of the collection are not equal to those elements)"
	^ floatCollectionSameEndAndBegining ! !

!SortedCollectionTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsCommaStringOne
	
	"self assert: self oneItemCol asCommaString = '1'.
	self assert: self oneItemCol asCommaStringAnd = '1'."

	self assert: self nonEmpty1Element  asCommaString = (self nonEmpty1Element first asString).
	self assert: self nonEmpty1Element  asCommaStringAnd = (self nonEmpty1Element first asString).
	! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 14:34'!
elementNotIn
"return an element not included in 'nonEmpty' "

	^ elementNoteIn ! !

!SortedCollectionTest methodsFor: 'setup' stamp: 'cyrille.delaunay 12/18/2009 13:15'!
setUp

	nonEmpty := SortedCollection new.
	elementExistsTwice := 12332312321.
	nonEmpty add: 2.
	nonEmpty add: elementExistsTwice.
	nonEmpty add: elementExistsTwice.
	collectionIncluded := SortedCollection new add: 2; add: elementExistsTwice ;yourself.
	collectionNotIncluded := SortedCollection new add: 312; add: 313 ;yourself.
	empty := SortedCollection  new. 
	collectionWith4Elements := SortedCollection new.
	collectionWith4Elements add: 1.
	collectionWith4Elements add: -2.
	collectionWith4Elements add: 3.
	collectionWith4Elements add: 1.
	collectionWithoutNil := SortedCollection new add: 1;add: 2 ;add:4 ;add:5;yourself.
	collectResult := OrderedCollection new. "SortedCollection sortBlock: [:a :b | a name < b name]."
	collectResult add: SmallInteger.
	collectResult add: SmallInteger.
	collectResult add: SmallInteger.
	collectResult add: SmallInteger.
	nonEmpty1Element := SortedCollection new add:5; yourself.
	collectionOfFloat := SortedCollection new add:1.2 ; add: 5.6 ; add:4.4 ; add: 1.9 ; yourself.
	duplicateFloat := 1.2.
	collectionOfFloatWithDuplicate := SortedCollection new add: duplicateFloat  ; add: 5.6 ; add:4.4 ; add: duplicateFloat  ; yourself.
	accessCollection := SortedCollection new add:1 ; add: 5 ; add:4 ; add: 2 ; add:7 ; yourself.
	elementNoteIn := 999.
	oldSubcollection := SortedCollection new add: 2 ; add: 2 ; add: 2 ; yourself.
	floatCollectionSameEndAndBegining := SortedCollection new add: 1.5 ; add: 1.5 copy ; yourself.
	withoutEqualElements := SortedCollection new add: 1 ; add: 8 copy ; add: 4;yourself.
	nonEmpty5Elements := SortedCollection new add: 1 ; add: 8 copy ; add: 4; add: 4; add: 4;yourself.! !

!SortedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testAt
	"self debug: #testAt"
	"
	self assert: (self accessCollection at: 1) = 1.
	self assert: (self accessCollection at: 2) = 2.
	"
	| index |
	index := self moreThan4Elements indexOf: self elementInForElementAccessing.
	self assert: (self moreThan4Elements at: index) = self elementInForElementAccessing! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 10:50'!
moreThan3Elements
	" return a collection including atLeast 3 elements"
	^ accessCollection ! !

!SortedCollectionTest methodsFor: 'tests - element accessing' stamp: ''!
testMiddle
	"self debug: #testMiddle"
	self assert: self moreThan4Elements middle = (self moreThan4Elements at: self moreThan4Elements size // 2 + 1)! !

!SortedCollectionTest methodsFor: 'test - creation' stamp: ''!
testWithWithWithWithWith
	"self debug: #testWithWithWithWithWith"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom: 1 to: 5 .
	aCol := self collectionClass with: (collection at:1) with: ( collection at:2 ) with: ( collection at: 3) with: (collection at: 4 ) with: ( collection at: 5 ).

	1 to: 3 do: [ :i | self assert: ( aCol occurrencesOf: ( collection at: i ) ) = ( collection occurrencesOf: ( collection at: i ) ) ].! !

!SortedCollectionTest methodsFor: 'basic' stamp: 'DM 3/16/2006 11:32'!
testAddAll2
	"self run: #testAddAll2"
	"self debug: #testAddAll2"
	
	| sorted2 sorted|
	sorted2 := SortedCollection new.
	sorted2 add: 'brochet'; add:'truitelle'.
	sorted := SortedCollection new.
	sorted add: 'perche'.
	sorted addAll: sorted2.
	self assert: (sorted size = (sorted2 size + 1)).
	sorted2 do: 
			[ :each | self assert: (sorted includes: each)]
	 ! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/23/2009 14:07'!
nonEmptyMoreThan1Element
" return a collection of integer with more than one element" 
	^withoutEqualElements 
	.! !

!SortedCollectionTest methodsFor: 'tests - copying with replacement for sorted' stamp: ''!
testCopyFromToWithForSorted
| collection result |
collection := self collectionOfSize5 .

" testing that elements to be replaced are removed from the copy :"
result := collection copyReplaceFrom: 1 to: collection size with: self empty .
self assert: result isEmpty.

" testing that replacement elements  are all put into the copy :"
result := collection copyReplaceFrom: 1 to: collection size with: self replacementCollection .
 self replacementCollection do:
	[:each | 
	self assert: (result occurrencesOf: each) = ( self replacementCollection occurrencesOf: each )].

self assert: result size = self replacementCollection size.

! !

!SortedCollectionTest methodsFor: 'tests - removing by index' stamp: ''!
testRemoveFirstNElements

| collection elements result oldSize |
collection := self collectionWith5Elements .
elements := {collection first. collection at:2}.
oldSize := collection size.

result := collection removeFirst: 2.
self assert: result = elements .
self assert: collection size = (oldSize - 2).! !

!SortedCollectionTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterOne

	| delim oneItemStream result |
	"delim := ', '.
	oneItemStream := '' readWrite.
	self oneItemCol asStringOn: oneItemStream delimiter: delim.
	self assert: oneItemStream contents = '1'."
	
	delim := ', '.
	result:=''.
	oneItemStream := ReadWriteStream on: result.
	self nonEmpty1Element  asStringOn: oneItemStream delimiter: delim.
	oneItemStream do:[:each | self assert: each = (self nonEmpty1Element first asString)].
	

	! !

!SortedCollectionTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testIndexOfIfAbsentDuplicate
	"self debug: #testIndexOfIfAbsent"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection last.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'indexOf:ifAbsent: should return the position of the first occurrence :'"
	self assert: (collection 
			indexOf: element
			ifAbsent: [ 55 ]) = 1! !

!SortedCollectionTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 14:34'!
elementInForIncludesTest
" return an element included in nonEmpty "
	^ nonEmpty anyOne ! !

!SortedCollectionTest methodsFor: 'tests - index access' stamp: 'delaunay 4/23/2009 15:14'!
testLastIndexOfStartingAt
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection last.
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size
			ifAbsent: [ 99 ]) = collection size.
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size - 1
			ifAbsent: [ 99 ]) = 99.
	self assert: (collection 
			lastIndexOf: self elementNotInForIndexAccessing
			startingAt: collection size
			ifAbsent: [ 99 ]) = 99! !

!SortedCollectionTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithCollectError
	self should: [self nonEmptyMoreThan1Element with: self empty collect:[:a :b | ]] raise: Error.! !

!SortedCollectionTest methodsFor: 'tests - remove' stamp: ''!
testRemoveAllError
	"self debug: #testRemoveElementThatExists"
	| el aSubCollection |
	el := self elementNotIn.
	aSubCollection := self nonEmptyWithoutEqualElements copyWith: el.
	self 
		should: [ | res | res := self nonEmptyWithoutEqualElements removeAll: aSubCollection ]
		raise: Error! !

!SoundSystem commentStamp: '<historical>'!
This is the base class for a sound system. A sound system offers a small protocol for playing sounds and making beeps. 

While SoundSystem is an abstract class, it acts as a facade to 
the actual SoundSystem.

When the SoundPackage is not loaded, SoundSystem current refers to DummySoundSystem. 

SoundSystem current gives access to the currently installed SoundSystem.

When no SoundSystem is available, a dummy one is installed as current.  
    
SoundSystem soundEnabled: true.
SoundSystem current beep


SoundSystem current: BaseSoundSystem new


!
!SoundSystem methodsFor: 'activation hooks' stamp: 'StephaneDucasse 8/3/2013 21:30'!
deactivate
	"Hook for possible specialization when activating a sound system"! !

!SoundSystem methodsFor: 'sounds' stamp: 'StephaneDucasse 8/3/2013 22:10'!
playSoundNamed: soundName ifAbsentReadFrom: aifFileName

	self subclassResponsibility! !

!SoundSystem methodsFor: 'to deprecate' stamp: 'StephaneDucasse 8/3/2013 22:10'!
randomBitsFromSoundInput: bitCount

	self subclassResponsibility! !

!SoundSystem methodsFor: 'activation hooks' stamp: 'StephaneDucasse 8/3/2013 22:09'!
shutDown
	"by default do nothing"! !

!SoundSystem methodsFor: 'sounds' stamp: 'StephaneDucasse 8/3/2013 22:10'!
playSoundNamedOrBeep: soundName

	self subclassResponsibility! !

!SoundSystem methodsFor: 'accessing' stamp: 'YuriyTymchuk 10/25/2013 19:36'!
soundEnabled: aBoolean

	^ self class soundEnabled: aBoolean! !

!SoundSystem methodsFor: 'accessing' stamp: 'StephaneDucasse 8/3/2013 22:39'!
soundEnabled

	^ self class soundEnabled! !

!SoundSystem methodsFor: 'query' stamp: 'StephaneDucasse 8/3/2013 22:09'!
soundNamed: soundName

	self subclassResponsibility! !

!SoundSystem methodsFor: 'sounds' stamp: 'StephaneDucasse 8/3/2013 22:10'!
playSampledSound: samples rate: rate

	self subclassResponsibility! !

!SoundSystem methodsFor: 'beep' stamp: 'StephaneDucasse 8/3/2013 22:11'!
beep
	"Make a primitive beep."

	self subclassResponsibility! !

!SoundSystem methodsFor: 'sounds' stamp: 'StephaneDucasse 8/3/2013 22:10'!
playSoundNamed: soundName

	self subclassResponsibility! !

!SoundSystem methodsFor: 'activation hooks' stamp: 'StephaneDucasse 8/3/2013 21:30'!
activate
	"Hook for possible specialization when activating a sound system"! !

!SoundSystem methodsFor: 'to deprecate' stamp: 'StephaneDucasse 8/3/2013 22:10'!
sampledSoundChoices

	self subclassResponsibility! !

!SoundSystem class methodsFor: 'setting' stamp: 'StephaneDucasse 8/3/2013 21:31'!
soundEnabled
	^ SoundEnabled ifNil: [SoundEnabled := false]! !

!SoundSystem class methodsFor: 'setting' stamp: 'StephaneDucasse 8/3/2013 21:31'!
soundQuickStart
	^ SoundQuickStart ifNil: [SoundQuickStart := false]! !

!SoundSystem class methodsFor: 'current ' stamp: 'StephaneDucasse 8/12/2013 13:10'!
current: aSoundSystem

	Current ifNotNil: [Current deactivate].
	Current := aSoundSystem.
	Current activate.! !

!SoundSystem class methodsFor: 'current ' stamp: 'StephaneDucasse 8/3/2013 22:54'!
resetSoundSystem
	Current := nil! !

!SoundSystem class methodsFor: 'setting' stamp: 'StephaneDucasse 8/3/2013 21:31'!
soundEnabled: aBoolean
	SoundEnabled := aBoolean! !

!SoundSystem class methodsFor: 'setting' stamp: 'StephaneDucasse 8/3/2013 21:31'!
soundQuickStart: aBoolean
	SoundQuickStart := aBoolean! !

!SoundSystem class methodsFor: 'current ' stamp: 'StephaneDucasse 8/4/2013 13:42'!
current

	^ Current ifNil: [ Current := DummySoundSystem new ]! !

!SoundTheme commentStamp: 'AlainPlantec 1/7/2010 22:41'!
Groups a set of sounds to use with a UITheme.
Note that, although instances may have their sounds changed the settings will still indicate the class of theme that is current.!
!SoundTheme methodsFor: 'sounds' stamp: 'gvc 7/30/2009 17:48'!
messageSound
	"Answer the message sound."

	^self sounds at: #message ifAbsent: [self defaultSound]! !

!SoundTheme methodsFor: 'initialize-release' stamp: 'gvc 9/12/2007 17:50'!
defaultWindowOpenSound
	"Answer the default window open sound."

	^self defaultSound! !

!SoundTheme methodsFor: 'sounds' stamp: 'gvc 7/30/2009 17:48'!
alertSound
	"Answer the alert sound."

	^self sounds at: #alert ifAbsent: [self defaultSound]! !

!SoundTheme methodsFor: 'initialization' stamp: 'gvc 9/12/2007 14:38'!
initialize
	"Initialize the receiver."

	super initialize.
	self initializeSounds! !

!SoundTheme methodsFor: 'sounds' stamp: 'gvc 7/30/2009 17:48'!
windowMinimizeSound
	"Answer the window minimize sound."

	^self sounds at: #windowMinimize ifAbsent: [self defaultSound]! !

!SoundTheme methodsFor: 'initialize-release' stamp: 'gvc 9/12/2007 17:37'!
initializeSounds
	"Initialize the receiver's event sounds."

	self sounds: Dictionary new.
	self sounds
		at: #default put: self defaultDefaultSound;
		at: #abort put: self defaultAbortSound;
		at: #alert put: self defaultAlertSound;
		at: #deny put: self defaultDenySound;
		at: #message put: self defaultMessageSound;
		at: #question put: self defaultQuestionSound;
		at: #windowMinimize put: self defaultWindowMinimizeSound;
		at: #windowMaximize put: self defaultWindowMaximizeSound;
		at: #windowRestoreUp put: self defaultWindowRestoreUpSound;
		at: #windowRestoreDown put: self defaultWindowRestoreDownSound;
		at: #windowClose put: self defaultWindowCloseSound! !

!SoundTheme methodsFor: 'initialize-release' stamp: 'gvc 9/12/2007 17:36'!
defaultMessageSound
	"Answer the default message sound."

	^self defaultSound! !

!SoundTheme methodsFor: 'sounds' stamp: 'gvc 7/30/2009 17:48'!
windowCloseSound
	"Answer the window close sound."

	^self sounds at: #windowClose ifAbsent: [self defaultSound]! !

!SoundTheme methodsFor: 'sounds' stamp: 'gvc 7/30/2009 17:48'!
abortSound
	"Answer the abort sound."

	^self sounds at: #abort ifAbsent: [self defaultSound]! !

!SoundTheme methodsFor: 'initialize-release' stamp: 'gvc 9/12/2007 17:35'!
defaultAbortSound
	"Answer the default abort sound."

	^self defaultSound! !

!SoundTheme methodsFor: 'sounds' stamp: 'gvc 7/30/2009 17:48'!
windowMaximizeSound
	"Answer the window maximize sound."

	^self sounds at: #windowMaximize ifAbsent: [self defaultSound]! !

!SoundTheme methodsFor: 'accessing' stamp: 'gvc 9/12/2007 14:34'!
sounds: anObject
	"Set the value of sounds"

	sounds := anObject! !

!SoundTheme methodsFor: 'initialize-release' stamp: 'gvc 9/12/2007 17:36'!
defaultAlertSound
	"Answer the default alert sound."

	^self defaultSound! !

!SoundTheme methodsFor: 'initialize-release' stamp: 'gvc 7/30/2009 17:49'!
defaultDefaultSound
	"Answer the default default sound!!"

	^Beeper default! !

!SoundTheme methodsFor: 'sounds' stamp: 'gvc 7/30/2009 17:48'!
denySound
	"Answer the deny sound."

	^self sounds at: #deny ifAbsent: [self defaultSound]! !

!SoundTheme methodsFor: 'initialize-release' stamp: 'gvc 9/12/2007 17:36'!
defaultQuestionSound
	"Answer the default question sound."

	^self defaultSound! !

!SoundTheme methodsFor: 'sounds' stamp: 'gvc 7/30/2009 17:49'!
windowOpenSound
	"Answer the window open sound."

	^self sounds at: #windowOpen ifAbsent: [self defaultSound]! !

!SoundTheme methodsFor: 'sounds' stamp: 'gvc 7/30/2009 17:49'!
windowRestoreUpSound
	"Answer the window restore up sound."

	^self sounds at: #windowRestoreUp ifAbsent: [self defaultSound]! !

!SoundTheme methodsFor: 'initialize-release' stamp: 'gvc 9/12/2007 17:36'!
defaultWindowRestoreUpSound
	"Answer the default window restore up sound."

	^self defaultSound! !

!SoundTheme methodsFor: 'sounds' stamp: 'gvc 7/30/2009 17:48'!
defaultSound
	"Answer the default sound."

	^self sounds at: #default ifAbsent: [self defaultDefaultSound]! !

!SoundTheme methodsFor: 'sounds' stamp: 'gvc 7/30/2009 17:49'!
windowRestoreDownSound
	"Answer the window restore down sound."

	^self sounds at: #windowRestoreDown ifAbsent: [self defaultSound]! !

!SoundTheme methodsFor: 'initialize-release' stamp: 'gvc 9/12/2007 17:36'!
defaultDenySound
	"Answer the default deny sound."

	^self defaultSound! !

!SoundTheme methodsFor: 'initialize-release' stamp: 'gvc 9/12/2007 17:36'!
defaultWindowRestoreDownSound
	"Answer the default window restore down sound."

	^self defaultSound! !

!SoundTheme methodsFor: 'initialize-release' stamp: 'gvc 9/12/2007 17:36'!
defaultWindowMinimizeSound
	"Answer the default window minimize sound."

	^self defaultSound! !

!SoundTheme methodsFor: 'sounds' stamp: 'gvc 7/30/2009 17:48'!
questionSound
	"Answer the question sound."

	^self sounds at: #question ifAbsent: [self defaultSound]! !

!SoundTheme methodsFor: 'initialize-release' stamp: 'gvc 9/12/2007 17:36'!
defaultWindowCloseSound
	"Answer the default window close sound."

	^self defaultSound! !

!SoundTheme methodsFor: 'initialize-release' stamp: 'gvc 9/12/2007 17:36'!
defaultWindowMaximizeSound
	"Answer the default window maximize sound."

	^self defaultSound! !

!SoundTheme methodsFor: 'accessing' stamp: 'gvc 9/12/2007 14:34'!
sounds
	"Answer the value of sounds"

	^ sounds! !

!SoundTheme class methodsFor: 'as yet unclassified' stamp: 'gvc 7/30/2009 18:27'!
isCurrent
	"Answer whether an instance of the receiver is the current theme."

	^self current class == self! !

!SoundTheme class methodsFor: 'as yet unclassified' stamp: 'gvc 9/12/2007 14:48'!
isAbstract
	"Answer whether the receiver is considered to be abstract."

	^false! !

!SoundTheme class methodsFor: 'as yet unclassified' stamp: 'BenjaminVanRyseghem 7/22/2013 14:59'!
current: aSoundTheme
	"Set the current sound theme."

	Current := aSoundTheme! !

!SoundTheme class methodsFor: 'settings' stamp: 'HenrikSperreJohansen 1/21/2011 14:19'!
useThemeSounds: aBoolean
	UseThemeSounds := aBoolean! !

!SoundTheme class methodsFor: 'as yet unclassified' stamp: 'gvc 9/12/2007 15:20'!
allThemeClasses
	"Answer the subclasses of the receiver that are considered to be
	concrete (useable as a theme)."

	^self withAllSubclasses reject: [:c | c isAbstract]! !

!SoundTheme class methodsFor: 'as yet unclassified' stamp: 'gvc 7/30/2009 18:27'!
beCurrent
	"Make a new instance of the receiver be the current theme."

	self isAbstract ifTrue: [^self error: self name, ' is abstract, send #beCurrent to a subclass.'].
	self current: self newDefault! !

!SoundTheme class methodsFor: 'as yet unclassified' stamp: 'gvc 7/30/2009 18:04'!
themeName
	"Answer the friendly name of the theme."

	^'Beeper sounds'! !

!SoundTheme class methodsFor: 'as yet unclassified' stamp: 'gvc 7/30/2009 18:25'!
current
	"Answer the current ui theme."

	^Current ifNil: [Current := NullSoundTheme newDefault. Current]! !

!SoundTheme class methodsFor: 'as yet unclassified' stamp: 'gvc 9/13/2007 10:39'!
newDefault
	"Answer a new instance of the sound theme with
	its default sounds."

	^self new! !

!SoundTheme class methodsFor: 'settings' stamp: 'HenrikSperreJohansen 1/21/2011 14:19'!
useThemeSounds
	 ^ UseThemeSounds ifNil: [UseThemeSounds := true]! !

!SourceCodeFonts commentStamp: '<historical>'!
I'm a font setting for Source Code Pro fonts.!
!SourceCodeFonts methodsFor: 'notes' stamp: 'EstebanLorenzano 10/11/2013 11:36'!
seeClassSide! !

!SourceCodeFonts class methodsFor: 'accessing' stamp: 'EstebanLorenzano 12/1/2014 15:19'!
setSourceCodeFontsDefault
	self setSourceCodeFonts: self sizeSmall! !

!SourceCodeFonts class methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/11/2013 12:27'!
sizeHuge
	^ 22! !

!SourceCodeFonts class methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/11/2013 11:36'!
sizeSmall 
	^ 10! !

!SourceCodeFonts class methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/11/2013 14:19'!
setSourceCodeFonts: pointSize
	StandardFonts
		setAllStandardFontsTo: (LogicalFont familyName: self defaultFontName pointSize: pointSize);
		haloFont: (LogicalFont familyName: self defaultFontName pointSize: pointSize - 1);
		balloonFont: (LogicalFont familyName: self defaultFontName pointSize: pointSize - 1);
		windowTitleFont: (LogicalFont familyName: self defaultFontName pointSize: pointSize + 1);
		listFont: (LogicalFont familyName: self defaultFontName pointSize: pointSize);
		menuFont: (LogicalFont familyName: self defaultFontName pointSize: pointSize);
		codeFont: (LogicalFont familyName: self fontName pointSize: pointSize)! !

!SourceCodeFonts class methodsFor: 'accessing' stamp: 'EstebanLorenzano 12/1/2014 14:57'!
defaultFontName
	^ 'Source Sans Pro'! !

!SourceCodeFonts class methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/11/2013 12:27'!
sizeVeryLarge
	^ 18! !

!SourceCodeFonts class methodsFor: 'settings' stamp: 'EstebanLorenzano 10/11/2013 12:47'!
fontSourceCodeRow
	| theme |
	
	theme := Smalltalk ui theme.
	^ theme newRowIn: World for: {
		theme buttonLabelForText: 'Predefined styles: ' translated.
		self fontButton: 'Small' size: self sizeSmall.
		self fontButton: 'Medium' size: self sizeMedium.
		self fontButton: 'Large' size: self sizeLarge.
		self fontButton: 'Very Large' size: self sizeVeryLarge.
		self fontButton: 'Huge' size: self sizeHuge	}	
		
		! !

!SourceCodeFonts class methodsFor: 'font registration' stamp: 'EstebanLorenzano 12/1/2014 14:55'!
registerFonts: freeTypeFontManager
	{ SourceSansProRegular. SourceCodeProRegular } do: [ :each |
		| font |
		font := each new.
		freeTypeFontManager 
			addFromFileContents: font fontContents 
			baseName: font originalFileName ]! !

!SourceCodeFonts class methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/11/2013 14:06'!
codeFontName 
	^ 'Source Code Pro'! !

!SourceCodeFonts class methodsFor: 'settings' stamp: 'StephaneDucasse 11/11/2014 18:49'!
settingsOn: aBuilder 
	<systemsettings>

	(aBuilder setting: #useSourceCode)
		parent: #appearance; 
		order: 4;
		target: self;
		icon: Smalltalk ui icons smallConfigurationIcon;
		label: 'Source Code Fonts';
		description: 'Use Source Code Pro Fonts';
		precondition: [ FT2Library current notNil ];
		dialog: [ self fontSourceCodeRow ].
		! !

!SourceCodeFonts class methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/11/2013 12:27'!
sizeMedium 
	^ 13! !

!SourceCodeFonts class methodsFor: 'accessing' stamp: 'StephaneDucasse 11/11/2014 18:31'!
fontButton: aString size: size 
	^ (Smalltalk ui theme 
		newButtonIn: World
			for: self
			getState: nil 
			action: #setSourceCodeFonts:	
			arguments: { size }
			getEnabled: nil
			getLabel: nil
			help: 'Change font style to Source Code Pro' translated)
		label: aString;
		yourself! !

!SourceCodeFonts class methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/11/2013 11:36'!
fontName
	^ 'Source Code Pro'! !

!SourceCodeFonts class methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/11/2013 11:36'!
useSourceCode: aBoolean
	! !

!SourceCodeFonts class methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/11/2013 12:27'!
sizeLarge
	^ 16! !

!SourceCodeFonts class methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/11/2013 11:36'!
useSourceCode
	! !

!SourceCodeProRegular commentStamp: '<historical>'!
http://sourceforge.net/projects/sourcecodepro.adobe/

Copyright 2010, 2012 Adobe Systems Incorporated (http://www.adobe.com/), with Reserved Font Name 'Source'. All Rights Reserved. Source is a trademark of Adobe Systems Incorporated in the United States and/or other countries.

This Font Software is licensed under the SIL Open Font License, Version 1.1.

This license is copied below, and is also available with a FAQ at: http://scripts.sil.org/OFL


-----------------------------------------------------------
SIL OPEN FONT LICENSE Version 1.1 - 26 February 2007
-----------------------------------------------------------

PREAMBLE
The goals of the Open Font License (OFL) are to stimulate worldwide
development of collaborative font projects, to support the font creation
efforts of academic and linguistic communities, and to provide a free and
open framework in which fonts may be shared and improved in partnership
with others.

The OFL allows the licensed fonts to be used, studied, modified and
redistributed freely as long as they are not sold by themselves. The
fonts, including any derivative works, can be bundled, embedded, 
redistributed and/or sold with any software provided that any reserved
names are not used by derivative works. The fonts and derivatives,
however, cannot be released under any other type of license. The
requirement for fonts to remain under this license does not apply
to any document created using the fonts or their derivatives.

DEFINITIONS
"Font Software" refers to the set of files released by the Copyright
Holder(s) under this license and clearly marked as such. This may
include source files, build scripts and documentation.

"Reserved Font Name" refers to any names specified as such after the
copyright statement(s).

"Original Version" refers to the collection of Font Software components as
distributed by the Copyright Holder(s).

"Modified Version" refers to any derivative made by adding to, deleting,
or substituting -- in part or in whole -- any of the components of the
Original Version, by changing formats or by porting the Font Software to a
new environment.

"Author" refers to any designer, engineer, programmer, technical
writer or other person who contributed to the Font Software.

PERMISSION & CONDITIONS
Permission is hereby granted, free of charge, to any person obtaining
a copy of the Font Software, to use, study, copy, merge, embed, modify,
redistribute, and sell modified and unmodified copies of the Font
Software, subject to the following conditions:

1) Neither the Font Software nor any of its individual components,
in Original or Modified Versions, may be sold by itself.

2) Original or Modified Versions of the Font Software may be bundled,
redistributed and/or sold with any software, provided that each copy
contains the above copyright notice and this license. These can be
included either as stand-alone text files, human-readable headers or
in the appropriate machine-readable metadata fields within text or
binary files as long as those fields can be easily viewed by the user.

3) No Modified Version of the Font Software may use the Reserved Font
Name(s) unless explicit written permission is granted by the corresponding
Copyright Holder. This restriction only applies to the primary font name as
presented to the users.

4) The name(s) of the Copyright Holder(s) or the Author(s) of the Font
Software shall not be used to promote, endorse or advertise any
Modified Version, except to acknowledge the contribution(s) of the
Copyright Holder(s) and the Author(s) or with their explicit written
permission.

5) The Font Software, modified or unmodified, in part or in whole,
must be distributed entirely under this license, and must not be
distributed under any other license. The requirement for fonts to
remain under this license does not apply to any document created
using the Font Software.

TERMINATION
This license becomes null and void if any of the above conditions are
not met.

DISCLAIMER
THE FONT SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT
OF COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL THE
COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL
DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
FROM, OUT OF THE USE OR INABILITY TO USE THE FONT SOFTWARE OR FROM
OTHER DEALINGS IN THE FONT SOFTWARE.
!
!SourceCodeProRegular class methodsFor: 'accessing' stamp: 'IgorStasenko 4/8/2014 16:49'!
fontContents
	^#[0 1 0 0 0 19 1 0 0 4 0 48 66 65 83 69 139 25 148 177 0 1 182 80 0 0 0 58 68 83 73 71 179 26 106 126 0 1 182 140 0 0 32 88 71 68 69 70 47 108 48 16 0 1 161 120 0 0 0 212 71 80 79 83 11 100 7 54 0 1 162 76 0 0 8 208 71 83 85 66 224 72 244 203 0 1 171 28 0 0 11 50 79 83 47 50 114 180 208 244 0 0 1 184 0 0 0 96 99 109 97 112 236 246 201 18 0 0 17 44 0 0 10 32 99 118 116 32 0 191 11 113 0 0 29 4 0 0 0 34 102 112 103 109 6 89 156 55 0 0 27 76 0 0 1 115 103 97 115 112 255 255 0 3 0 1 161 112 0 0 0 8 103 108 121 102 219 101 123 69 0 0 36 180 0 1 31 160 104 101 97 100 251 227 249 23 0 0 1 60 0 0 0 54 104 104 101 97 6 118 4 163 0 0 1 116 0 0 0 36 104 109 116 120 211 182 88 117 0 0 2 24 0 0 15 20 108 111 99 97 94 20 165 232 0 0 29 40 0 0 7 140 109 97 120 112 5 233 2 56 0 0 1 152 0 0 0 32 110 97 109 101 200 95 235 243 0 1 68 84 0 0 60 190 112 111 115 116 132 72 4 169 0 1 129 20 0 0 32 92 112 114 101 112 38 179 35 176 0 0 28 192 0 0 0 65 0 1 0 0 0 1 4 90 21 138 51 199 95 15 60 245 0 9 3 232 0 0 0 0 205 21 160 127 0 0 0 0 205 22 17 0 255 217 254 112 2 194 3 232 0 0 0 9 0 2 0 0 0 0 0 0 0 1 0 0 3 216 254 239 0 0 2 88 255 217 255 150 2 194 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3 197 0 1 0 0 3 197 0 86 0 16 0 109 0 6 0 1 0 0 0 0 0 10 0 0 2 0 1 115 0 3 0 1 0 3 2 87 1 144 0 5 0 0 2 138 2 88 0 0 0 75 2 138 2 88 0 0 1 94 0 50 1 32 0 0 2 11 5 9 3 4 3 2 2 4 32 0 0 7 0 0 24 1 0 0 0 0 0 0 0 0 65 68 66 69 0 64 0 0 251 2 2 238 255 6 0 0 3 216 1 17 96 0 1 147 0 0 0 0 1 224 2 148 0 0 0 32 0 3 2 88 0 62 0 0 0 0 2 88 0 0 2 88 0 0 2 88 0 32 2 88 0 103 2 88 0 66 2 88 0 85 2 88 0 115 2 88 0 135 2 88 0 53 2 88 0 79 2 88 0 95 2 88 0 81 2 88 0 98 2 88 0 134 2 88 0 81 2 88 0 83 2 88 0 48 2 88 0 102 2 88 0 49 2 88 0 100 2 88 0 67 2 88 0 42 2 88 0 79 2 88 0 43 2 88 0 10 2 88 0 54 2 88 0 38 2 88 0 65 2 88 0 81 2 88 0 93 2 88 0 80 2 88 0 60 2 88 0 69 2 88 0 103 2 88 0 72 2 88 0 93 2 88 0 90 2 88 0 55 2 88 0 106 2 88 0 81 2 88 0 60 2 88 0 93 2 88 0 60 2 88 0 93 2 88 0 60 2 88 0 146 2 88 0 72 2 88 0 69 2 88 0 77 2 88 0 51 2 88 0 8 2 88 0 64 2 88 0 49 2 88 0 71 2 88 0 32 2 88 0 32 2 88 0 32 2 88 0 32 2 88 0 32 2 88 0 32 2 88 0 32 2 88 0 32 2 88 0 32 2 88 0 32 2 88 0 32 2 88 0 32 2 88 0 32 2 88 0 32 2 88 0 32 2 88 0 32 2 88 0 32 2 88 0 32 2 88 0 32 2 88 0 32 2 88 0 32 2 88 0 32 2 88 255 255 2 88 0 27 2 88 0 66 2 88 0 66 2 88 0 66 2 88 0 66 2 88 0 66 2 88 0 85 2 88 0 85 2 88 0 85 2 88 0 16 2 88 0 115 2 88 0 115 2 88 0 115 2 88 0 115 2 88 0 115 2 88 0 115 2 88 0 115 2 88 0 115 2 88 0 115 2 88 0 115 2 88 0 115 2 88 0 115 2 88 0 115 2 88 0 115 2 88 0 115 2 88 0 115 2 88 0 115 2 88 0 53 2 88 0 53 2 88 0 53 2 88 0 53 2 88 0 53 2 88 0 53 2 88 0 53 2 88 0 79 2 88 0 79 2 88 0 79 2 88 0 10 2 88 0 95 2 88 0 95 2 88 0 95 2 88 0 95 2 88 0 95 2 88 0 95 2 88 0 95 2 88 0 95 2 88 0 95 2 88 0 95 2 88 0 95 2 88 0 95 2 88 0 81 2 88 0 98 2 88 0 134 2 88 0 134 2 88 0 134 2 88 0 134 2 88 0 134 2 88 0 67 2 88 0 134 2 88 0 53 2 88 0 81 2 88 0 83 2 88 0 83 2 88 0 83 2 88 0 83 2 88 0 83 2 88 0 83 2 88 0 83 2 88 0 48 2 88 0 48 2 88 0 48 2 88 0 48 2 88 0 48 2 88 0 48 2 88 0 48 2 88 0 48 2 88 0 48 2 88 0 48 2 88 0 48 2 88 0 48 2 88 0 48 2 88 0 48 2 88 0 48 2 88 0 48 2 88 0 45 2 88 0 33 2 88 0 48 2 88 0 48 2 88 0 48 2 88 0 48 2 88 0 48 2 88 0 48 2 88 0 48 2 88 0 100 2 88 0 100 2 88 0 100 2 88 0 100 2 88 0 100 2 88 0 100 2 88 0 67 2 88 0 67 2 88 0 67 2 88 0 67 2 88 0 67 2 88 0 67 2 88 0 67 2 88 0 79 2 88 0 42 2 88 0 42 2 88 0 42 2 88 0 42 2 88 0 42 2 88 0 79 2 88 0 79 2 88 0 79 2 88 0 79 2 88 0 79 2 88 0 79 2 88 0 79 2 88 0 79 2 88 0 79 2 88 0 79 2 88 0 79 2 88 0 79 2 88 0 79 2 88 0 79 2 88 0 79 2 88 0 79 2 88 0 79 2 88 0 79 2 88 0 79 2 88 0 79 2 88 0 79 2 88 0 79 2 88 0 79 2 88 0 10 2 88 0 10 2 88 0 10 2 88 0 10 2 88 0 38 2 88 0 38 2 88 0 38 2 88 0 38 2 88 0 38 2 88 0 38 2 88 0 38 2 88 0 38 2 88 0 65 2 88 0 65 2 88 0 65 2 88 0 65 2 88 0 16 2 88 0 101 2 88 0 62 2 88 0 81 2 88 0 81 2 88 0 81 2 88 0 81 2 88 0 81 2 88 0 81 2 88 0 81 2 88 0 81 2 88 0 81 2 88 0 81 2 88 0 81 2 88 0 81 2 88 0 81 2 88 0 81 2 88 0 81 2 88 0 81 2 88 0 81 2 88 0 81 2 88 0 81 2 88 0 81 2 88 0 81 2 88 0 81 2 88 0 17 2 88 0 20 2 88 0 80 2 88 0 80 2 88 0 80 2 88 0 80 2 88 0 80 2 88 0 51 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 69 2 88 0 69 2 88 0 69 2 88 0 69 2 88 0 69 2 88 0 69 2 88 0 69 2 88 0 69 2 88 0 69 2 88 0 69 2 88 0 69 2 88 0 69 2 88 0 69 2 88 0 69 2 88 0 69 2 88 0 69 2 88 0 69 2 88 0 72 2 88 0 72 2 88 0 72 2 88 0 72 2 88 0 72 2 88 0 72 2 88 0 72 2 88 0 10 2 88 0 93 2 88 0 93 2 88 0 20 2 88 0 90 2 88 0 90 2 88 0 90 2 88 0 90 2 88 0 90 2 88 0 90 2 88 0 90 2 88 0 90 2 88 0 90 2 88 0 90 2 88 0 90 2 88 0 90 2 88 0 90 2 88 0 55 2 88 0 106 2 88 0 106 2 88 0 81 2 88 0 81 2 88 0 43 2 88 0 81 2 88 0 81 2 88 0 81 2 88 0 81 2 88 0 81 2 88 0 60 2 88 0 93 2 88 0 93 2 88 0 93 2 88 0 93 2 88 0 93 2 88 0 93 2 88 0 93 2 88 255 234 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 11 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 146 2 88 0 116 2 88 0 146 2 88 0 135 2 88 0 135 2 88 0 77 2 88 0 72 2 88 0 72 2 88 0 72 2 88 0 72 2 88 0 72 2 88 0 72 2 88 0 72 2 88 0 88 2 88 0 69 2 88 0 69 2 88 0 69 2 88 0 69 2 88 0 69 2 88 0 69 2 88 0 77 2 88 0 77 2 88 0 77 2 88 0 77 2 88 0 77 2 88 0 77 2 88 0 77 2 88 0 77 2 88 0 77 2 88 0 77 2 88 0 77 2 88 0 77 2 88 0 77 2 88 0 77 2 88 0 77 2 88 0 77 2 88 0 77 2 88 0 77 2 88 0 77 2 88 0 77 2 88 0 77 2 88 0 77 2 88 0 77 2 88 0 8 2 88 0 8 2 88 0 8 2 88 0 8 2 88 0 49 2 88 0 49 2 88 0 49 2 88 0 49 2 88 0 49 2 88 0 49 2 88 0 49 2 88 0 49 2 88 0 71 2 88 0 71 2 88 0 71 2 88 0 71 2 88 0 60 2 88 0 93 2 88 0 55 2 88 0 94 2 88 0 60 2 88 0 93 2 88 0 61 2 88 0 63 2 88 0 69 2 88 0 60 2 88 0 77 2 88 0 46 2 88 0 63 2 88 0 54 2 88 0 51 2 88 0 8 2 88 0 49 2 88 0 26 2 88 0 52 2 88 0 57 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 60 2 88 0 42 2 88 0 71 2 88 0 98 2 88 0 69 2 88 0 57 2 88 0 39 2 88 0 56 2 88 0 77 2 88 0 70 2 88 0 68 2 88 0 67 2 88 0 71 2 88 0 98 2 88 0 69 2 88 0 57 2 88 0 39 2 88 0 56 2 88 0 78 2 88 0 70 2 88 0 68 2 88 0 67 2 88 0 219 2 88 0 197 2 88 0 219 2 88 0 197 2 88 0 32 2 88 0 227 2 88 0 227 2 88 0 109 2 88 0 123 2 88 0 245 2 88 0 131 2 88 0 209 2 88 0 217 2 88 0 95 2 88 0 103 2 88 0 217 2 88 0 103 2 88 0 197 2 88 0 211 2 88 0 83 2 88 0 97 2 88 0 85 2 88 0 85 2 88 0 80 2 88 0 20 2 88 0 80 2 88 0 20 2 88 0 219 2 88 0 151 2 88 0 60 2 88 0 208 2 88 0 122 2 88 0 226 2 88 0 99 2 88 0 120 2 88 0 99 2 88 0 99 2 88 1 7 2 88 0 99 2 88 1 7 2 88 0 84 2 88 0 127 2 88 0 127 2 88 0 91 2 88 0 72 2 88 0 30 2 88 0 30 2 88 0 112 2 88 255 251 2 88 0 15 2 88 0 49 2 88 0 49 2 88 0 87 2 88 0 104 2 88 0 134 2 88 0 134 2 88 0 85 2 88 0 161 2 88 0 208 2 88 0 174 2 88 0 172 2 88 0 172 2 88 0 172 2 88 0 176 2 88 0 183 2 88 0 175 2 88 0 173 2 88 0 236 2 88 0 213 2 88 0 254 2 88 0 244 2 88 0 161 2 88 0 208 2 88 0 174 2 88 0 172 2 88 0 172 2 88 0 172 2 88 0 176 2 88 0 183 2 88 0 175 2 88 0 173 2 88 0 236 2 88 0 213 2 88 0 254 2 88 0 244 2 88 0 161 2 88 0 208 2 88 0 173 2 88 0 172 2 88 0 172 2 88 0 172 2 88 0 176 2 88 0 183 2 88 0 175 2 88 0 173 2 88 0 236 2 88 0 213 2 88 0 254 2 88 0 244 2 88 0 161 2 88 0 208 2 88 0 174 2 88 0 172 2 88 0 172 2 88 0 172 2 88 0 176 2 88 0 183 2 88 0 175 2 88 0 173 2 88 0 236 2 88 0 213 2 88 0 254 2 88 0 244 2 88 0 167 2 88 0 137 2 88 0 142 2 88 0 167 2 88 0 172 2 88 0 181 2 88 0 137 2 88 0 160 2 88 0 198 2 88 0 149 2 88 0 175 2 88 0 175 2 88 0 140 2 88 0 189 2 88 0 196 2 88 0 130 2 88 0 175 2 88 0 142 2 88 0 172 2 88 0 137 2 88 0 243 2 88 0 162 2 88 0 164 2 88 0 159 2 88 0 147 2 88 0 82 2 88 0 159 2 88 0 140 2 88 0 146 2 88 0 160 2 88 0 160 2 88 0 154 2 88 0 137 2 88 0 137 2 88 0 175 2 88 0 58 2 88 0 85 2 88 0 77 2 88 0 53 2 88 0 58 2 88 0 113 2 88 0 49 2 88 0 96 2 88 0 78 2 88 0 47 2 88 0 43 2 88 0 109 2 88 0 43 2 88 0 84 2 88 0 96 2 88 0 108 2 88 0 56 2 88 0 28 2 88 0 28 2 88 0 28 2 88 0 28 2 88 0 48 2 88 0 28 2 88 0 28 2 88 0 39 2 88 0 28 2 88 0 28 2 88 0 28 2 88 0 28 2 88 0 28 2 88 0 28 2 88 0 85 2 88 0 85 2 88 0 102 2 88 0 85 2 88 0 216 2 88 0 85 2 88 0 120 2 88 0 107 2 88 0 85 2 88 0 85 2 88 0 85 2 88 0 111 2 88 0 85 2 88 0 76 2 88 0 76 2 88 0 85 2 88 0 39 2 88 255 252 2 88 0 77 2 88 0 76 2 88 0 186 2 88 0 62 2 88 0 36 2 88 0 29 2 88 0 70 2 88 0 52 2 88 0 117 2 88 0 26 2 88 0 17 2 88 0 33 2 88 0 29 2 88 0 33 2 88 0 201 2 88 0 159 2 88 0 119 2 88 0 166 2 88 0 38 2 88 0 38 2 88 0 72 2 88 0 72 2 88 0 38 2 88 0 38 2 88 0 33 2 88 0 33 2 88 255 231 2 88 255 231 2 88 255 250 2 88 0 77 2 88 0 98 2 88 1 0 2 88 0 169 2 88 0 209 2 88 0 217 2 88 0 245 2 88 0 219 2 88 0 185 2 88 0 235 2 88 0 168 2 88 0 168 2 88 0 249 2 88 0 177 2 88 0 235 2 88 0 185 2 88 0 249 2 88 0 158 2 88 0 150 2 88 0 177 2 88 0 170 2 88 0 207 2 88 0 202 2 88 0 234 2 88 0 221 2 88 0 234 2 88 0 185 2 88 0 169 2 88 0 235 2 88 0 249 2 88 0 168 2 88 0 164 2 88 0 158 2 88 0 155 2 88 0 177 2 88 0 176 2 88 0 170 2 88 0 177 2 88 0 234 2 88 0 243 2 88 0 150 2 88 0 165 2 88 0 236 2 88 0 236 2 88 0 207 2 88 0 207 2 88 0 202 2 88 0 191 2 88 0 168 2 88 0 164 2 88 0 108 2 88 0 108 2 88 0 247 2 88 0 253 2 88 1 35 2 88 0 234 2 88 0 165 2 88 0 215 2 88 0 215 2 88 0 210 2 88 0 234 2 88 0 234 2 88 0 174 2 88 0 176 2 88 0 168 2 88 0 168 2 88 0 168 2 88 0 168 2 88 0 168 2 88 0 164 2 88 0 168 2 88 0 168 2 88 0 184 2 88 0 172 2 88 0 184 2 88 0 172 2 88 0 184 2 88 0 172 2 88 0 169 2 88 0 168 2 88 0 174 2 88 0 178 2 88 0 174 2 88 0 178 2 88 0 174 2 88 0 178 2 88 0 169 2 88 0 167 2 88 0 176 2 88 0 172 2 88 1 6 2 88 0 231 2 88 0 0 2 88 0 0 2 88 0 0 2 88 0 0 2 88 255 217 2 88 255 217 2 88 1 5 2 88 0 222 2 88 0 33 2 88 0 33 2 88 1 5 2 88 0 222 2 88 0 18 2 88 0 18 2 88 1 5 2 88 0 222 2 88 1 5 2 88 1 5 2 88 0 222 2 88 0 222 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 1 5 2 88 1 5 2 88 0 222 2 88 0 222 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 1 5 2 88 1 5 2 88 0 222 2 88 0 222 2 88 0 222 2 88 0 222 2 88 0 222 2 88 0 222 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 0 75 2 88 0 75 2 88 1 5 2 88 0 222 2 88 255 217 2 88 0 183 2 88 1 5 2 88 0 183 2 88 0 183 2 88 255 217 2 88 255 217 2 88 255 217 2 88 1 5 2 88 0 183 2 88 0 183 2 88 255 217 2 88 255 217 2 88 255 217 2 88 1 5 2 88 0 183 2 88 0 183 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 1 5 2 88 255 217 2 88 255 217 2 88 1 5 2 88 255 217 2 88 255 217 2 88 255 217 2 88 255 217 2 88 1 5 2 88 1 5 2 88 1 5 2 88 255 217 2 88 0 222 2 88 1 5 2 88 0 222 2 88 255 217 2 88 0 222 2 88 255 217 2 88 0 222 2 88 0 0 2 88 0 0 2 88 0 0 2 88 0 0 2 88 0 0 2 88 0 0 2 88 0 0 2 88 0 0 2 88 0 0 2 88 0 0 2 88 0 0 2 88 0 0 2 88 0 0 2 88 0 0 2 88 0 0 2 88 0 0 2 88 1 44 2 88 0 0 2 88 0 0 2 88 0 0 2 88 0 0 2 88 2 13 2 88 0 0 2 88 1 44 2 88 0 0 2 88 0 0 2 88 0 0 2 88 0 0 2 88 0 0 2 88 1 44 2 88 0 0 2 88 0 0 0 0 0 3 0 0 0 3 0 0 2 20 0 1 0 0 0 0 0 28 0 3 0 1 0 0 2 20 0 6 1 248 0 0 0 9 0 247 0 3 0 0 0 0 0 0 0 3 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3 1 232 1 237 2 23 2 120 2 139 1 206 1 236 2 1 2 2 2 11 2 150 1 228 1 248 1 227 2 7 1 207 1 208 1 209 1 210 1 211 1 212 1 213 1 214 1 215 1 216 1 229 1 230 2 156 2 155 2 157 1 234 2 21 0 4 0 5 0 6 0 7 0 8 0 9 0 10 0 11 0 12 0 13 0 14 0 15 0 16 0 17 0 18 0 19 0 20 0 21 0 22 0 23 0 24 0 25 0 26 0 27 0 28 0 29 2 3 2 9 2 4 2 161 2 0 2 205 0 30 0 31 0 32 0 33 0 34 0 35 0 36 0 37 0 38 0 39 0 40 0 41 0 42 0 43 0 44 0 45 0 46 0 47 0 48 0 49 0 50 0 51 0 52 0 53 0 54 0 55 2 5 2 8 2 6 2 163 0 0 0 60 0 63 0 80 0 90 0 142 0 151 0 195 0 234 0 233 0 235 0 237 0 236 0 240 1 1 1 11 1 10 1 12 1 14 1 39 1 38 1 40 1 42 1 65 1 72 1 71 1 73 1 75 1 74 1 117 1 116 1 118 1 120 2 12 2 118 2 124 2 121 2 14 1 255 2 15 1 109 2 18 2 16 2 19 2 206 2 215 2 162 0 78 0 163 2 167 2 160 2 158 2 159 2 122 2 168 2 169 2 174 2 175 2 166 2 170 2 84 2 86 0 0 0 255 1 87 1 235 1 233 2 165 2 171 2 125 2 164 2 172 1 246 1 247 1 231 3 33 0 56 0 59 0 150 0 164 1 88 1 250 1 251 1 240 1 241 1 238 1 239 2 153 2 198 1 146 0 221 2 136 2 123 1 244 1 245 1 173 1 174 2 13 1 254 1 242 1 243 2 140 0 58 0 91 0 57 0 93 0 89 0 118 0 119 0 121 0 117 0 148 0 149 0 0 0 147 0 192 0 193 0 191 1 50 2 207 2 214 2 216 2 217 2 220 2 218 2 221 2 219 2 222 2 208 0 4 8 12 0 0 1 26 1 0 0 7 0 26 0 0 0 13 0 47 0 57 0 64 0 90 0 96 0 122 0 126 0 191 0 196 0 209 0 214 0 223 0 228 0 241 0 246 1 49 1 73 1 101 1 126 1 128 1 143 1 146 1 161 1 176 1 220 1 231 1 235 2 27 2 55 2 67 2 82 2 84 2 89 2 97 2 101 2 111 2 121 2 135 2 142 2 158 2 176 2 179 2 184 2 188 2 191 2 204 2 221 2 227 3 4 3 12 3 15 3 19 3 27 3 36 3 40 3 46 3 49 3 192 29 67 29 73 29 77 29 80 29 82 29 88 29 91 29 156 29 160 29 187 30 15 30 33 30 37 30 43 30 59 30 73 30 99 30 111 30 133 30 143 30 147 30 151 30 158 30 249 32 7 32 21 32 26 32 30 32 34 32 38 32 48 32 51 32 58 32 68 32 113 32 121 32 127 32 137 32 142 32 148 32 161 32 164 32 167 32 172 32 178 32 181 32 186 33 19 33 23 33 32 33 34 33 38 33 46 33 84 33 94 33 147 34 2 34 6 34 15 34 18 34 21 34 26 34 30 34 43 34 72 34 96 34 101 37 159 37 160 37 179 37 183 37 189 37 193 37 198 37 202 38 17 38 106 39 19 39 82 251 2 255 255 0 0 0 0 0 13 0 32 0 48 0 58 0 65 0 91 0 97 0 123 0 160 0 192 0 197 0 210 0 215 0 224 0 229 0 242 0 247 1 52 1 76 1 104 1 128 1 143 1 146 1 160 1 175 1 205 1 230 1 234 2 24 2 55 2 67 2 80 2 84 2 88 2 97 2 101 2 111 2 121 2 135 2 140 2 158 2 176 2 178 2 183 2 187 2 190 2 198 2 216 2 225 3 0 3 6 3 15 3 18 3 27 3 35 3 38 3 46 3 49 3 192 29 67 29 71 29 77 29 79 29 82 29 86 29 91 29 156 29 160 29 187 30 12 30 32 30 36 30 42 30 54 30 66 30 90 30 108 30 128 30 142 30 146 30 151 30 158 30 160 32 7 32 18 32 24 32 28 32 32 32 38 32 48 32 50 32 57 32 68 32 112 32 116 32 125 32 128 32 141 32 148 32 161 32 164 32 166 32 171 32 177 32 181 32 185 33 19 33 23 33 32 33 34 33 38 33 46 33 83 33 91 33 144 34 2 34 6 34 15 34 17 34 21 34 25 34 30 34 43 34 72 34 96 34 100 37 0 37 160 37 178 37 182 37 188 37 192 37 198 37 201 38 16 38 106 39 19 39 82 251 1 255 255 0 1 255 245 0 0 1 159 0 0 255 195 0 0 255 189 0 0 0 0 255 120 0 0 255 193 0 0 0 9 0 0 0 85 0 0 0 0 0 0 0 0 255 128 255 89 0 235 0 0 0 0 0 0 0 0 0 0 0 0 255 102 254 12 255 78 255 77 255 74 255 67 255 64 255 55 255 46 255 33 255 29 255 14 255 174 0 0 0 0 0 14 0 13 0 9 0 0 0 0 0 0 0 0 255 232 255 231 255 224 255 217 0 0 255 213 255 211 254 230 229 20 0 0 229 16 0 0 229 19 0 0 229 17 228 189 228 188 228 181 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 226 220 226 27 0 0 227 27 0 0 0 0 0 0 0 0 225 193 226 92 226 149 225 187 226 68 0 0 225 172 0 0 225 170 225 167 225 223 225 221 225 219 225 218 0 0 225 210 225 208 225 205 225 157 224 250 224 244 224 241 225 135 225 131 225 61 225 55 225 34 224 167 224 166 224 160 0 0 224 116 0 0 224 137 224 127 224 92 224 66 224 58 222 37 221 22 221 8 221 6 221 2 221 0 220 241 0 0 220 178 220 91 219 177 219 103 6 172 0 1 0 0 0 0 1 22 0 0 1 50 0 0 1 60 0 0 1 68 1 74 0 0 1 134 0 0 1 156 0 0 1 170 0 0 1 192 2 52 2 94 2 144 0 0 0 0 0 0 2 182 2 184 2 186 2 216 2 218 2 220 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 200 2 202 0 0 0 0 0 0 2 198 2 208 2 212 2 220 0 0 0 0 0 0 0 0 2 224 0 0 0 0 0 0 0 0 2 220 0 0 2 222 0 0 2 222 0 0 0 0 0 0 0 0 2 218 2 224 2 226 2 228 2 230 2 240 2 254 3 16 3 22 3 32 3 34 0 0 0 0 3 32 0 0 3 208 3 214 3 218 3 222 0 0 0 0 0 0 0 0 0 0 3 216 0 0 3 216 0 0 0 0 0 0 0 0 0 0 0 0 3 208 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3 180 0 0 3 180 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3 158 0 0 0 0 0 0 0 0 0 0 0 0 0 3 1 232 1 237 2 23 2 120 2 139 1 206 1 236 2 1 2 2 2 11 2 150 1 228 1 248 1 227 2 7 1 229 1 230 2 156 2 155 2 157 1 234 2 21 2 3 2 9 2 4 2 161 2 0 2 205 2 5 2 8 2 6 2 163 3 33 1 233 2 124 2 121 2 119 2 122 2 10 2 14 2 215 2 16 2 84 1 246 2 165 1 249 2 18 2 216 2 118 2 160 2 30 2 31 2 206 2 168 2 15 1 254 2 221 2 29 2 86 1 247 2 141 2 142 2 143 1 235 0 63 0 78 0 80 0 89 0 90 0 91 0 93 0 117 0 118 0 119 0 121 0 230 0 142 2 152 0 163 0 191 0 192 0 193 0 195 0 219 0 231 1 109 0 240 0 255 1 1 1 10 1 11 1 12 1 14 1 38 1 39 1 40 1 42 1 155 1 65 2 153 1 87 1 116 1 117 1 118 1 120 1 144 1 156 1 146 0 61 0 238 0 62 0 239 0 77 0 254 0 81 1 2 0 82 1 3 0 84 1 5 0 83 1 4 0 85 1 6 0 88 1 9 0 94 1 15 0 95 1 16 0 96 1 17 0 105 1 26 0 92 1 13 0 106 1 27 0 107 1 28 0 108 1 29 0 109 1 30 0 113 1 34 0 116 1 37 0 120 1 41 0 122 1 43 0 123 1 44 0 128 1 48 0 124 1 50 0 129 1 51 0 130 1 52 1 53 0 131 1 54 0 133 1 57 0 132 1 55 0 134 1 56 0 138 1 61 0 140 1 63 0 143 1 66 0 141 1 64 1 70 0 152 1 76 0 153 1 77 0 154 1 78 0 164 1 88 0 172 1 96 0 174 1 97 0 173 1 98 0 178 1 102 0 179 1 103 0 181 1 105 0 180 1 104 0 187 1 111 0 186 1 110 0 194 1 119 0 196 1 121 0 197 1 122 0 198 1 123 0 199 1 124 0 207 1 132 0 216 1 141 0 220 1 145 0 221 0 226 1 151 0 228 1 153 0 227 1 152 0 165 1 89 0 208 1 133 0 64 0 241 0 125 1 45 0 155 1 79 0 200 1 125 0 201 1 126 0 202 1 127 0 203 1 128 0 204 1 129 0 110 1 31 0 171 1 95 0 182 1 106 0 188 1 112 2 96 2 104 2 109 2 111 2 217 2 220 2 218 2 222 2 214 2 219 2 98 2 105 2 110 2 223 2 225 2 227 2 229 2 231 2 233 2 235 2 237 2 239 2 241 2 243 2 245 2 254 2 255 3 1 2 88 2 90 2 91 2 97 2 99 2 102 2 106 2 107 0 86 1 7 0 87 1 8 0 111 1 32 0 114 1 35 0 115 1 36 0 135 1 58 0 136 1 59 0 137 1 60 0 139 1 62 0 144 1 67 0 145 1 68 0 146 1 69 0 175 1 99 0 176 1 100 0 177 1 101 0 183 1 107 0 184 1 108 0 189 1 113 0 190 1 114 0 214 1 139 0 215 1 140 0 217 1 142 0 222 1 147 0 229 1 154 0 65 0 242 0 66 0 243 0 67 0 244 0 68 0 245 0 69 0 246 0 70 0 247 0 71 0 248 0 72 0 249 0 73 0 250 0 74 0 251 0 75 0 252 0 76 0 253 0 97 1 18 0 98 1 19 0 99 1 20 0 100 1 21 0 101 1 22 0 102 1 23 0 103 1 24 0 104 1 25 0 126 1 46 0 127 1 47 0 156 1 80 0 157 1 81 0 158 1 82 0 159 1 83 0 160 1 84 0 161 1 85 0 162 1 86 0 166 1 90 0 167 1 91 0 168 1 92 0 169 1 93 0 170 1 94 0 205 1 130 0 206 1 131 0 209 1 134 0 210 1 135 0 211 1 136 0 212 1 137 0 213 1 138 0 218 1 143 0 223 1 148 0 224 1 149 0 225 1 150 1 252 1 250 1 251 1 253 1 238 1 239 1 242 1 240 1 241 1 243 2 12 2 13 1 255 2 28 2 95 2 38 2 39 2 100 2 130 2 123 2 174 2 151 2 154 2 171 2 184 2 198 184 0 0 44 75 184 0 9 80 88 177 1 1 142 89 184 1 255 133 184 0 68 29 185 0 9 0 3 95 94 45 184 0 1 44 32 32 69 105 68 176 1 96 45 184 0 2 44 184 0 1 42 33 45 184 0 3 44 32 70 176 3 37 70 82 88 35 89 32 138 32 138 73 100 138 32 70 32 104 97 100 176 4 37 70 32 104 97 100 82 88 35 101 138 89 47 32 176 0 83 88 105 32 176 0 84 88 33 176 64 89 27 105 32 176 0 84 88 33 176 64 101 89 89 58 45 184 0 4 44 32 70 176 4 37 70 82 88 35 138 89 32 70 32 106 97 100 176 4 37 70 32 106 97 100 82 88 35 138 89 47 253 45 184 0 5 44 75 32 176 3 38 80 88 81 88 176 128 68 27 176 64 68 89 27 33 33 32 69 176 192 80 88 176 192 68 27 33 89 89 45 184 0 6 44 32 32 69 105 68 176 1 96 32 32 69 125 105 24 68 176 1 96 45 184 0 7 44 184 0 6 42 45 184 0 8 44 75 32 176 3 38 83 88 176 64 27 176 0 89 138 138 32 176 3 38 83 88 35 33 176 128 138 138 27 138 35 89 32 176 3 38 83 88 35 33 184 0 192 138 138 27 138 35 89 32 176 3 38 83 88 35 33 184 1 0 138 138 27 138 35 89 32 176 3 38 83 88 35 33 184 1 64 138 138 27 138 35 89 32 184 0 3 38 83 88 176 3 37 69 184 1 128 80 88 35 33 184 1 128 35 33 27 176 3 37 69 35 33 35 33 89 27 33 89 68 45 184 0 9 44 75 83 88 69 68 27 33 33 89 45 0 176 0 43 0 178 1 1 2 43 1 178 2 1 2 43 1 183 2 64 54 42 33 20 0 8 43 0 183 1 77 64 50 36 23 0 8 43 0 178 3 7 7 43 176 0 32 69 125 105 24 68 75 176 96 82 88 176 1 27 176 0 89 176 1 142 0 0 0 0 20 0 68 0 86 0 0 0 12 255 51 0 12 1 230 0 12 2 62 0 12 2 126 0 12 2 144 0 12 2 200 0 12 0 0 0 0 0 76 0 76 0 76 0 76 0 144 0 244 1 68 1 130 1 192 1 246 2 86 2 146 2 200 3 4 3 84 3 122 3 208 4 32 4 116 4 190 5 48 5 132 5 242 6 30 6 96 6 152 6 248 7 84 7 146 7 200 8 78 8 202 9 26 9 146 9 240 10 64 11 14 11 102 11 164 11 250 12 74 12 130 13 6 13 94 13 178 14 44 14 164 14 240 15 86 15 166 15 250 16 52 16 166 17 4 17 98 17 152 17 164 17 176 17 188 17 200 17 212 17 224 17 236 17 248 18 4 18 16 18 28 18 40 18 52 18 64 18 76 18 90 18 102 18 114 18 126 18 138 18 152 19 8 19 98 19 212 19 224 19 236 19 248 20 4 20 16 20 28 20 40 20 52 20 60 20 72 20 84 20 96 20 108 20 120 20 132 20 144 20 156 20 168 20 180 20 192 20 204 20 216 20 228 20 240 20 254 21 96 21 108 21 120 21 132 21 144 21 156 21 168 21 180 21 192 21 204 21 216 22 64 22 76 22 88 22 100 22 112 22 124 22 136 22 148 22 160 22 172 22 184 22 196 23 34 23 46 23 58 23 70 23 82 23 94 23 106 23 118 23 132 23 144 23 206 23 218 23 230 23 242 23 254 24 10 24 22 24 34 24 46 24 58 24 70 24 82 24 94 24 106 24 118 24 130 24 142 24 154 24 166 24 178 24 190 24 202 24 214 24 226 24 240 25 120 25 202 26 58 26 70 26 82 26 94 26 106 26 118 26 236 26 248 27 4 27 16 27 28 27 42 27 54 27 66 27 78 27 90 27 102 27 114 27 126 27 138 27 254 28 10 28 22 28 34 28 46 28 58 28 70 28 82 28 94 28 106 28 118 28 130 28 142 28 154 28 166 28 178 28 190 28 202 28 214 28 226 28 238 28 250 29 98 29 196 29 208 29 220 29 232 29 244 30 0 30 12 30 24 30 36 30 48 30 60 30 72 30 84 30 96 30 108 30 120 30 132 30 144 30 156 30 168 30 180 30 192 31 16 31 84 31 174 31 186 31 198 31 210 31 222 31 234 31 246 32 2 32 14 32 26 32 38 32 50 32 62 32 74 32 86 32 98 32 112 32 124 32 136 32 148 32 160 32 174 33 78 34 6 34 150 34 162 34 174 34 186 34 198 34 210 34 222 34 234 34 246 35 138 35 150 35 162 35 174 35 186 35 198 35 210 35 222 35 234 35 246 36 2 36 14 36 26 36 38 36 50 36 62 36 76 36 212 36 224 36 236 36 248 37 4 37 16 37 28 37 40 37 52 37 64 37 76 37 190 37 202 37 214 37 226 37 238 37 250 38 6 38 18 38 30 38 42 38 54 38 164 38 252 39 36 39 48 39 60 39 140 39 152 39 164 39 176 39 188 39 200 39 216 39 228 40 54 40 66 40 78 40 90 40 102 40 114 40 126 40 138 40 150 41 8 41 20 41 32 41 44 41 56 41 68 41 80 41 92 41 104 41 116 41 128 41 140 41 152 41 164 41 176 41 188 41 202 42 82 42 250 43 106 43 118 43 130 43 142 43 154 43 166 44 42 44 54 44 66 44 78 44 90 44 104 44 116 44 128 44 140 44 152 44 164 44 176 44 188 44 200 45 68 45 80 45 92 45 104 45 116 45 128 45 140 45 152 45 164 45 176 45 188 45 200 45 212 45 224 45 236 45 248 46 4 46 16 46 28 46 40 46 52 46 64 46 76 46 200 47 48 47 60 47 72 47 84 47 96 47 108 47 120 47 132 47 144 47 156 47 168 47 180 47 192 47 204 47 216 47 228 47 240 47 252 48 8 48 20 48 32 48 44 48 184 49 50 49 114 49 244 50 106 50 228 51 50 51 144 51 232 52 116 52 202 53 78 53 152 53 224 54 28 54 136 54 228 55 48 55 170 56 36 56 44 56 56 56 68 56 80 56 92 56 104 56 116 56 128 56 140 56 152 56 164 56 176 56 188 56 200 56 212 56 224 56 238 56 250 57 6 57 18 57 30 57 44 57 204 57 212 57 224 57 236 57 248 58 4 58 16 58 28 58 40 58 218 59 60 59 116 59 198 60 56 60 138 60 240 61 100 61 154 62 32 62 148 62 246 63 46 63 124 63 226 64 38 64 132 64 140 64 184 64 192 65 42 65 76 65 114 65 126 65 138 65 226 66 26 66 72 66 154 66 234 67 0 67 12 67 50 67 86 67 98 67 110 67 120 67 134 67 158 67 182 67 194 67 206 67 214 67 222 67 242 68 6 68 26 68 34 68 44 68 82 68 102 68 136 68 168 68 198 68 228 69 70 69 168 69 194 69 214 69 240 70 14 70 68 70 116 70 198 71 82 71 132 72 12 72 142 73 6 73 90 73 226 74 88 74 224 75 86 75 126 75 146 75 154 76 10 76 20 76 30 76 40 76 50 76 60 76 70 76 80 76 90 76 100 76 110 76 120 76 130 76 140 76 150 76 160 76 170 76 180 76 190 76 200 76 210 76 220 76 230 76 240 76 250 77 4 77 14 77 24 77 34 77 92 77 126 77 188 78 16 78 74 78 154 78 248 79 38 79 150 79 240 80 16 80 50 80 86 80 138 80 148 80 158 80 168 80 178 80 188 80 198 80 208 80 218 80 228 80 238 80 248 81 2 81 12 81 22 81 30 81 38 81 46 81 130 81 222 82 24 82 116 82 184 82 250 83 150 83 212 84 8 84 82 84 148 84 200 85 32 85 94 85 154 85 244 86 80 86 138 86 226 87 44 87 110 87 164 88 8 88 90 88 170 88 216 89 46 89 132 89 198 90 34 90 146 90 206 91 40 91 146 91 250 92 92 92 218 93 68 93 162 94 84 94 226 95 140 95 242 96 100 96 246 97 110 97 232 98 80 98 182 98 210 98 218 98 226 98 242 99 156 99 172 99 188 99 204 99 220 99 236 99 252 100 12 100 28 100 44 100 80 100 100 100 146 100 210 100 220 100 232 101 26 101 76 101 144 101 212 102 18 102 60 102 128 102 190 102 202 102 224 103 62 103 192 104 54 104 170 104 238 105 20 105 82 105 198 106 8 106 44 106 160 107 10 107 40 107 76 107 108 107 144 107 162 107 182 108 20 108 52 108 76 108 108 108 132 108 178 108 200 108 236 109 4 109 54 109 98 109 198 109 234 110 50 110 110 110 130 110 142 110 150 110 158 110 196 110 234 110 242 110 250 111 2 111 10 111 36 111 44 111 52 111 60 111 80 111 88 111 96 111 104 111 112 111 120 111 128 111 136 111 144 111 152 111 170 111 188 111 208 111 228 112 4 112 36 112 92 112 152 112 172 112 192 112 238 113 26 113 56 113 86 113 138 113 190 113 232 114 18 114 68 114 118 114 152 114 186 114 216 114 248 115 26 115 60 115 100 115 138 115 178 115 208 116 4 116 48 116 94 116 140 116 188 116 240 117 22 117 42 117 106 117 170 117 232 118 40 118 110 118 180 118 244 119 52 119 90 119 128 119 166 119 204 120 8 120 66 120 142 120 220 121 14 121 64 121 114 121 164 121 236 122 52 122 140 122 232 123 36 123 92 123 114 123 160 123 160 123 160 123 160 123 160 123 180 123 200 123 220 123 238 124 28 124 74 124 112 124 148 124 208 125 10 125 56 125 102 125 126 125 148 125 170 125 192 125 216 125 238 126 6 126 28 126 52 126 74 126 96 126 118 126 142 126 164 126 188 126 210 126 236 127 4 127 36 127 68 127 94 127 124 127 154 127 178 127 204 127 228 128 4 128 36 128 62 128 94 128 126 128 150 128 180 128 212 128 244 129 16 129 46 129 78 129 110 129 138 129 168 129 200 129 232 130 4 130 34 130 66 130 98 130 126 130 166 130 202 130 238 131 20 131 60 131 100 131 140 131 182 131 224 132 10 132 52 132 90 132 128 132 164 132 200 132 238 133 16 133 48 133 72 133 100 133 132 133 166 133 200 133 236 134 16 134 50 134 82 134 118 134 152 134 184 134 220 134 254 135 30 135 66 135 102 135 134 135 176 135 212 135 244 136 32 136 72 136 110 136 162 136 202 136 240 137 36 137 98 137 154 137 224 138 2 138 36 138 70 138 104 138 126 138 148 138 208 138 228 138 248 139 12 139 32 139 52 139 70 139 90 139 108 139 134 139 158 139 184 139 208 139 228 139 246 140 8 140 26 140 46 140 66 140 86 140 106 140 126 140 146 140 166 140 186 140 206 140 224 140 242 141 4 141 24 141 82 141 204 142 200 142 220 142 240 143 4 143 24 143 44 143 66 143 94 143 116 143 138 143 158 143 186 143 208 0 5 0 62 0 0 2 26 2 148 0 3 0 6 0 9 0 15 0 21 0 61 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 13 62 89 184 0 0 69 88 184 0 2 47 27 185 0 2 0 3 62 89 185 0 10 0 1 244 184 0 12 220 184 0 0 16 185 0 18 0 1 244 184 0 16 220 48 49 19 33 17 33 19 39 17 33 17 7 19 47 1 35 15 1 19 63 1 35 31 1 62 1 220 254 36 193 128 1 89 127 82 73 52 4 54 74 132 49 66 235 66 50 2 148 253 108 1 84 232 254 50 1 206 232 254 230 132 103 103 132 1 73 94 119 119 94 0 0 2 0 32 0 0 2 56 2 144 0 9 0 17 0 65 0 184 0 0 69 88 184 0 14 47 27 185 0 14 0 13 62 89 184 0 0 69 88 184 0 13 47 27 185 0 13 0 3 62 89 187 0 10 0 1 0 9 0 4 43 184 0 14 16 185 0 5 0 1 244 184 0 13 16 184 0 17 208 48 49 1 39 46 1 39 35 14 1 15 1 23 35 7 35 19 51 19 35 1 141 31 17 32 16 4 16 32 17 31 217 238 63 85 221 94 221 88 1 11 100 55 109 57 57 109 55 100 67 200 2 144 253 112 0 0 0 3 0 103 0 0 2 33 2 144 0 19 0 28 0 37 0 87 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 13 62 89 184 0 0 69 88 184 0 19 47 27 185 0 19 0 3 62 89 186 0 36 0 19 0 0 17 18 57 184 0 36 47 185 0 28 0 1 244 186 0 10 0 36 0 28 17 18 57 184 0 0 16 185 0 27 0 1 244 184 0 19 16 185 0 37 0 1 244 48 49 19 51 50 30 2 21 20 6 7 21 30 1 21 20 14 2 43 1 19 50 54 53 52 38 43 1 21 19 50 54 53 52 38 43 1 21 103 180 50 83 59 33 57 58 72 80 36 65 91 55 195 166 84 73 77 76 86 99 85 92 90 87 99 2 144 18 38 61 43 49 79 15 4 11 78 68 48 72 48 24 1 120 58 55 54 47 214 254 202 63 67 61 57 248 0 0 1 0 66 255 244 2 42 2 156 0 33 0 57 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 13 62 89 184 0 0 69 88 184 0 29 47 27 185 0 29 0 3 62 89 184 0 5 16 185 0 12 0 1 244 184 0 29 16 185 0 22 0 1 244 48 49 19 52 62 2 51 50 22 23 7 46 1 35 34 14 2 21 20 30 2 51 50 54 55 23 14 1 35 34 46 2 66 43 78 108 64 60 90 29 47 26 64 42 47 77 54 29 29 54 77 47 45 70 32 48 39 98 63 62 105 77 44 1 72 79 126 88 47 48 32 53 27 33 37 69 98 61 62 99 70 38 38 35 51 45 50 46 87 127 0 0 2 0 85 0 0 2 37 2 144 0 10 0 19 0 57 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 13 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 3 62 89 184 0 0 16 185 0 18 0 1 244 184 0 10 16 185 0 19 0 1 244 48 49 19 51 50 22 21 20 14 2 43 1 55 50 54 53 52 38 43 1 17 85 160 149 155 39 76 112 73 164 155 112 111 111 112 72 2 144 168 157 78 123 85 45 68 138 125 125 132 253 248 0 0 0 1 0 115 0 0 2 18 2 144 0 11 0 77 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 13 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 3 62 89 184 0 0 16 185 0 3 0 1 244 186 0 7 0 11 0 0 17 18 57 184 0 7 47 185 0 4 0 1 244 184 0 11 16 185 0 8 0 1 244 48 49 19 33 21 33 21 33 21 33 21 33 21 33 115 1 149 254 191 1 15 254 241 1 75 254 97 2 144 70 206 71 238 71 0 0 1 0 135 0 0 2 24 2 144 0 9 0 67 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 13 62 89 184 0 0 69 88 184 0 9 47 27 185 0 9 0 3 62 89 184 0 0 16 185 0 3 0 1 244 186 0 7 0 9 0 0 17 18 57 184 0 7 47 185 0 4 0 1 244 48 49 19 33 21 33 21 33 21 33 17 35 135 1 145 254 194 1 13 254 243 83 2 144 70 222 70 254 218 0 1 0 53 255 244 2 21 2 156 0 39 0 77 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 13 62 89 184 0 0 69 88 184 0 35 47 27 185 0 35 0 3 62 89 184 0 5 16 185 0 14 0 1 244 184 0 35 16 185 0 24 0 1 244 186 0 29 0 35 0 5 17 18 57 184 0 29 47 185 0 30 0 1 244 48 49 19 52 62 2 51 50 30 2 23 7 46 1 35 34 14 2 21 20 30 2 51 50 54 55 53 35 53 51 17 14 1 35 34 46 2 53 43 77 107 64 33 54 45 35 14 47 24 62 48 46 75 54 29 27 51 76 48 35 60 19 131 208 32 100 64 62 104 76 42 1 72 79 127 87 47 14 23 28 15 53 26 34 37 69 98 61 62 99 70 38 21 18 171 69 254 236 32 44 46 87 127 0 1 0 79 0 0 2 9 2 144 0 11 0 73 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 13 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 3 62 89 186 0 9 0 11 0 0 17 18 57 184 0 9 47 185 0 2 0 1 244 184 0 0 16 184 0 4 208 184 0 11 16 184 0 7 208 48 49 19 51 17 33 17 51 17 35 17 33 17 35 79 84 1 18 84 84 254 238 84 2 144 254 237 1 19 253 112 1 53 254 203 0 1 0 95 0 0 1 249 2 144 0 11 0 65 0 184 0 0 69 88 184 0 4 47 27 185 0 4 0 13 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 3 62 89 185 0 0 0 1 244 184 0 4 16 185 0 3 0 1 244 184 0 6 208 184 0 0 16 184 0 9 208 48 49 55 51 17 35 53 33 21 35 17 51 21 33 95 163 163 1 154 163 163 254 102 71 2 3 70 70 253 253 71 0 1 0 81 255 244 1 237 2 145 0 19 0 53 0 184 0 0 69 88 184 0 9 47 27 185 0 9 0 13 62 89 184 0 0 69 88 184 0 16 47 27 185 0 16 0 3 62 89 185 0 3 0 1 244 184 0 9 16 185 0 7 0 1 244 48 49 55 30 1 51 50 54 53 17 33 53 33 17 20 14 2 35 34 38 39 135 29 72 38 71 65 254 237 1 102 22 51 83 61 56 105 34 147 44 42 75 81 1 114 70 254 65 46 81 60 35 52 57 0 0 1 0 98 0 0 2 67 2 144 0 12 0 107 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 13 62 89 184 0 0 69 88 184 0 4 47 27 185 0 4 0 13 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 3 62 89 184 0 0 69 88 184 0 8 47 27 185 0 8 0 3 62 89 186 0 3 0 7 0 0 17 18 57 186 0 9 0 7 0 0 17 18 57 184 0 9 16 184 0 6 208 184 0 3 16 184 0 10 208 48 49 19 51 17 51 1 51 7 19 35 3 7 21 35 98 84 3 1 20 94 207 231 93 190 114 84 2 144 254 183 1 73 250 254 106 1 85 133 208 0 0 1 0 134 0 0 2 29 2 144 0 5 0 43 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 13 62 89 184 0 0 69 88 184 0 5 47 27 185 0 5 0 3 62 89 185 0 2 0 1 244 48 49 19 51 17 33 21 33 134 82 1 69 254 105 2 144 253 183 71 0 0 0 1 0 81 0 0 2 7 2 144 0 29 0 77 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 13 62 89 184 0 0 69 88 184 0 29 47 27 185 0 29 0 3 62 89 187 0 18 0 1 0 4 0 4 43 184 0 0 16 184 0 6 208 184 0 29 16 184 0 9 208 184 0 0 16 185 0 22 0 1 244 184 0 16 208 48 49 19 51 19 23 51 55 19 51 17 35 17 52 62 2 55 35 15 1 35 47 1 35 30 3 21 17 35 81 92 93 33 4 32 92 92 71 2 3 3 2 3 43 90 45 90 44 3 1 4 4 2 70 2 144 254 233 106 106 1 23 253 112 1 113 20 54 55 53 20 140 253 253 140 20 53 55 54 20 254 143 0 0 1 0 83 0 0 2 5 2 144 0 19 0 89 0 184 0 0 69 88 184 0 1 47 27 185 0 1 0 13 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 3 62 89 186 0 2 0 1 0 11 17 18 57 185 0 4 0 1 244 184 0 1 16 184 0 8 208 186 0 12 0 11 0 1 17 18 57 184 0 1 16 185 0 13 0 1 244 184 0 11 16 184 0 18 208 48 49 19 51 19 23 51 46 1 53 17 51 17 35 3 39 35 30 1 21 17 35 83 85 213 66 2 2 9 79 85 213 66 2 2 9 79 2 144 254 98 134 49 107 52 1 84 253 112 1 158 134 51 103 51 254 169 0 0 0 2 0 48 255 244 2 40 2 156 0 19 0 39 0 53 0 184 0 0 69 88 184 0 10 47 27 185 0 10 0 13 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 3 62 89 185 0 20 0 1 244 184 0 10 16 185 0 30 0 1 244 48 49 5 34 46 2 53 52 62 2 51 50 30 2 21 20 14 2 39 50 62 2 53 52 46 2 35 34 14 2 21 20 30 2 1 44 56 92 67 37 37 67 92 56 55 93 67 37 37 67 93 55 37 62 43 24 24 43 62 37 38 61 43 24 24 43 61 12 48 89 127 79 79 125 87 46 47 87 125 78 79 127 89 48 73 38 71 99 62 61 98 68 37 37 68 98 61 62 99 71 38 0 2 0 102 0 0 2 33 2 144 0 14 0 23 0 71 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 13 62 89 184 0 0 69 88 184 0 14 47 27 185 0 14 0 3 62 89 186 0 12 0 14 0 0 17 18 57 184 0 12 47 184 0 0 16 185 0 22 0 1 244 184 0 12 16 185 0 23 0 1 244 48 49 19 51 50 30 2 21 20 14 2 43 1 17 35 19 50 54 53 52 38 43 1 17 102 201 54 90 63 35 35 64 89 54 118 83 190 87 83 85 85 107 2 144 20 45 74 54 52 76 50 25 254 252 1 72 65 70 71 55 254 251 0 0 2 0 49 255 93 2 41 2 157 0 19 0 52 0 75 0 184 0 0 69 88 184 0 36 47 27 185 0 36 0 13 62 89 184 0 0 69 88 184 0 26 47 27 185 0 26 0 3 62 89 187 0 49 0 1 0 23 0 4 43 184 0 26 16 185 0 5 0 1 244 184 0 36 16 185 0 15 0 1 244 184 0 26 16 184 0 46 208 48 49 19 20 30 2 51 50 62 2 53 52 46 2 35 34 14 2 1 14 1 35 34 38 39 46 3 53 52 62 2 51 50 30 2 21 20 14 2 7 30 1 51 50 54 55 134 23 43 61 38 37 61 43 23 23 43 61 37 38 61 43 23 1 163 16 36 22 87 109 25 47 77 55 30 36 66 92 56 55 92 66 36 29 52 75 45 17 74 51 15 25 9 1 75 61 100 71 39 39 71 100 61 61 99 69 37 37 69 99 253 227 6 8 88 67 8 55 87 118 71 79 125 87 47 47 87 126 78 70 116 87 56 9 42 43 6 4 0 0 2 0 100 0 0 2 41 2 144 0 8 0 24 0 83 0 184 0 0 69 88 184 0 14 47 27 185 0 14 0 13 62 89 184 0 0 69 88 184 0 13 47 27 185 0 13 0 3 62 89 186 0 11 0 13 0 14 17 18 57 184 0 11 47 185 0 0 0 1 244 184 0 14 16 185 0 8 0 1 244 184 0 13 16 184 0 9 208 184 0 11 16 184 0 23 208 48 49 19 51 50 54 53 52 38 43 1 1 3 35 17 35 17 51 50 30 2 21 20 6 7 19 183 109 77 81 81 77 109 1 19 158 117 83 204 50 84 61 34 80 67 167 1 89 63 64 65 52 253 179 1 21 254 235 2 144 19 44 70 51 77 92 17 254 226 0 0 0 1 0 67 255 244 2 25 2 156 0 51 0 73 0 184 0 0 69 88 184 0 22 47 27 185 0 22 0 13 62 89 184 0 0 69 88 184 0 48 47 27 185 0 48 0 3 62 89 185 0 3 0 1 244 186 0 6 0 48 0 22 17 18 57 184 0 22 16 185 0 29 0 1 244 186 0 32 0 22 0 48 17 18 57 48 49 55 30 1 51 50 54 53 52 46 2 47 1 46 3 53 52 62 2 51 50 22 23 7 46 1 35 34 6 21 20 30 2 31 1 30 3 21 20 14 2 35 34 38 39 117 37 98 54 70 76 18 32 43 25 94 25 50 41 26 32 57 79 47 62 104 36 44 32 77 49 60 70 21 33 42 21 92 30 53 39 23 32 60 86 54 72 121 45 143 37 45 59 48 25 35 25 20 11 41 10 28 40 55 36 37 64 47 26 45 36 54 29 33 51 45 24 33 25 18 9 40 12 31 41 55 36 39 68 51 29 52 45 0 0 1 0 42 0 0 2 46 2 144 0 7 0 51 0 184 0 0 69 88 184 0 2 47 27 185 0 2 0 13 62 89 184 0 0 69 88 184 0 7 47 27 185 0 7 0 3 62 89 184 0 2 16 185 0 1 0 1 244 184 0 5 208 48 49 1 35 53 33 21 35 17 35 1 2 216 2 4 216 84 2 74 70 70 253 182 0 0 0 1 0 79 255 244 2 9 2 144 0 25 0 51 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 13 62 89 184 0 0 69 88 184 0 20 47 27 185 0 20 0 3 62 89 185 0 7 0 1 244 184 0 0 16 184 0 13 208 48 49 19 51 17 20 30 2 51 50 62 2 53 17 51 17 20 14 2 35 34 46 2 53 79 84 21 37 50 30 30 50 38 21 81 33 58 81 48 48 82 59 33 2 144 254 102 51 71 43 20 20 43 71 51 1 154 254 104 71 98 63 28 28 63 98 71 0 0 0 1 0 43 0 0 2 45 2 144 0 15 0 51 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 13 62 89 184 0 0 69 88 184 0 15 47 27 185 0 15 0 3 62 89 185 0 5 0 1 244 184 0 0 16 184 0 12 208 48 49 19 51 19 30 1 23 51 62 3 55 19 51 3 35 43 88 106 17 28 18 4 9 16 15 15 8 105 85 208 97 2 144 254 158 59 100 58 29 53 52 54 29 1 98 253 112 0 0 1 0 10 0 0 2 78 2 145 0 33 0 77 0 184 0 0 69 88 184 0 1 47 27 185 0 1 0 13 62 89 184 0 0 69 88 184 0 32 47 27 185 0 32 0 3 62 89 187 0 28 0 1 0 10 0 4 43 184 0 32 16 185 0 6 0 1 244 184 0 15 208 184 0 1 16 184 0 20 208 184 0 32 16 184 0 23 208 48 49 19 51 19 30 1 23 51 62 1 63 1 51 23 30 1 23 51 62 1 55 19 51 3 35 3 46 1 39 35 14 1 7 3 35 10 83 53 2 9 3 3 11 21 10 69 59 69 9 21 11 4 3 8 3 50 79 97 92 75 7 12 5 3 6 12 8 72 90 2 145 254 100 42 79 41 41 80 41 242 242 40 81 41 41 80 41 1 156 253 111 1 19 29 60 29 29 60 29 254 237 0 0 1 0 54 0 0 2 34 2 144 0 25 0 93 0 184 0 0 69 88 184 0 2 47 27 185 0 2 0 13 62 89 184 0 0 69 88 184 0 24 47 27 185 0 24 0 3 62 89 186 0 0 0 24 0 2 17 18 57 186 0 6 0 24 0 2 17 18 57 184 0 2 16 184 0 11 208 186 0 13 0 24 0 2 17 18 57 184 0 24 16 184 0 15 208 186 0 20 0 24 0 2 17 18 57 48 49 19 3 51 23 30 1 23 51 62 1 63 1 51 3 19 35 39 46 1 39 35 14 1 15 1 35 250 183 92 92 13 24 16 4 14 21 12 90 88 183 196 92 99 14 27 17 4 14 26 13 98 88 1 83 1 61 168 23 43 29 29 43 23 168 254 191 254 177 177 24 51 30 30 51 24 177 0 0 1 0 38 0 0 2 50 2 144 0 15 0 64 0 184 0 0 69 88 184 0 1 47 27 185 0 1 0 13 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 13 62 89 184 0 0 69 88 184 0 14 47 27 185 0 14 0 3 62 89 186 0 7 0 14 0 1 17 18 57 48 49 37 3 51 23 30 1 23 51 62 1 63 1 51 3 21 35 1 2 220 88 99 19 36 20 4 20 38 19 95 86 220 84 234 1 166 195 38 75 40 40 76 38 194 254 90 234 0 1 0 65 0 0 2 27 2 145 0 9 0 61 0 184 0 0 69 88 184 0 3 47 27 185 0 3 0 13 62 89 184 0 0 69 88 184 0 8 47 27 185 0 8 0 3 62 89 185 0 6 0 1 244 184 0 0 208 184 0 3 16 185 0 1 0 1 244 184 0 5 208 48 49 55 1 33 53 33 21 1 33 21 33 65 1 111 254 177 1 181 254 144 1 117 254 38 50 2 25 70 50 253 232 71 0 0 0 2 0 81 255 244 2 3 1 242 0 33 0 47 0 128 0 184 0 0 69 88 184 0 19 47 27 185 0 19 0 7 62 89 184 0 0 69 88 184 0 29 47 27 185 0 29 0 3 62 89 184 0 0 69 88 184 0 23 47 27 185 0 23 0 3 62 89 186 0 5 0 19 0 23 17 18 57 184 0 5 47 184 0 19 16 185 0 10 0 1 244 184 0 29 16 185 0 39 0 1 244 186 0 13 0 10 0 39 17 18 57 186 0 25 0 23 0 19 17 18 57 184 0 25 16 185 0 42 0 1 244 184 0 5 16 185 0 43 0 1 244 48 49 55 52 62 2 55 46 3 35 34 6 7 39 62 3 51 50 22 21 17 35 39 35 14 1 35 34 46 2 55 20 30 2 51 50 54 55 53 14 3 81 39 85 134 94 1 14 30 49 35 48 88 34 32 18 49 55 62 32 100 97 67 7 3 41 99 52 34 60 45 26 80 18 29 39 21 42 81 42 78 105 63 26 126 41 61 44 28 8 25 44 33 20 37 21 56 12 25 20 13 109 91 254 214 66 32 46 19 35 51 39 21 29 19 9 37 35 128 6 22 31 39 0 0 0 0 2 0 93 255 244 2 28 2 200 0 22 0 39 0 131 0 184 0 0 69 88 184 0 6 47 27 185 0 6 0 7 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 15 62 89 184 0 0 69 88 184 0 16 47 27 185 0 16 0 3 62 89 184 0 0 69 88 184 0 22 47 27 185 0 22 0 3 62 89 186 0 3 0 6 0 16 17 18 57 186 0 20 0 16 0 6 17 18 57 184 0 20 16 185 0 23 0 1 244 184 0 16 16 185 0 26 0 1 244 184 0 6 16 185 0 36 0 1 244 184 0 3 16 185 0 39 0 1 244 48 49 19 51 21 7 62 1 51 50 30 2 21 20 14 2 35 34 38 39 35 7 35 55 30 1 51 50 62 2 53 52 46 2 35 34 6 7 93 82 2 35 87 43 49 76 51 26 36 61 80 43 35 81 35 3 7 66 82 35 71 26 32 54 40 22 16 33 52 36 32 73 38 2 200 194 94 34 40 35 65 91 56 62 98 68 35 35 31 54 114 31 26 27 49 72 45 40 66 47 26 35 38 0 1 0 80 255 244 2 27 1 242 0 33 0 57 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 7 62 89 184 0 0 69 88 184 0 29 47 27 185 0 29 0 3 62 89 184 0 5 16 185 0 12 0 1 244 184 0 29 16 185 0 22 0 1 244 48 49 55 52 62 2 51 50 22 23 7 46 1 35 34 14 2 21 20 30 2 51 50 54 55 23 14 1 35 34 46 2 80 43 74 99 55 60 87 30 41 30 65 38 42 70 49 28 27 49 69 42 45 75 31 36 40 99 54 57 97 72 40 242 61 95 66 34 42 29 53 26 30 27 50 69 42 42 68 49 27 35 26 53 36 40 34 65 95 0 0 0 2 0 60 255 244 1 251 2 200 0 22 0 36 0 131 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 7 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 15 62 89 184 0 0 69 88 184 0 18 47 27 185 0 18 0 3 62 89 184 0 0 69 88 184 0 12 47 27 185 0 12 0 3 62 89 186 0 8 0 5 0 18 17 18 57 186 0 14 0 18 0 5 17 18 57 184 0 18 16 185 0 26 0 1 244 184 0 14 16 185 0 28 0 1 244 184 0 8 16 185 0 29 0 1 244 184 0 5 16 185 0 32 0 1 244 48 49 55 52 62 2 51 50 22 23 39 53 51 17 35 39 35 14 1 35 34 46 2 55 20 22 51 50 55 53 46 1 35 34 14 2 60 37 61 80 43 45 68 34 3 82 68 7 3 30 83 45 48 77 56 30 85 75 68 72 65 33 63 32 32 55 41 24 242 59 95 66 36 34 29 90 187 253 56 64 31 45 34 65 94 62 88 98 73 242 31 26 27 49 68 0 2 0 69 255 244 2 25 1 242 0 30 0 39 0 67 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 7 62 89 184 0 0 69 88 184 0 26 47 27 185 0 26 0 3 62 89 187 0 39 0 1 0 13 0 4 43 184 0 26 16 185 0 19 0 1 244 184 0 5 16 185 0 34 0 1 244 48 49 55 52 62 2 51 50 30 2 21 20 6 7 33 30 3 51 50 54 55 23 14 1 35 34 46 2 37 52 38 35 34 14 2 7 69 42 69 89 47 52 82 57 30 1 2 254 132 1 29 49 67 40 43 71 34 29 36 92 59 54 95 71 41 1 136 76 68 30 55 44 30 5 242 60 95 66 35 33 60 84 51 13 25 9 39 62 44 24 24 21 54 23 34 35 65 94 100 73 78 20 39 56 36 0 0 0 1 0 103 0 0 2 66 2 212 0 22 0 86 0 184 0 0 69 88 184 0 20 47 27 185 0 20 0 15 62 89 184 0 0 69 88 184 0 16 47 27 185 0 16 0 7 62 89 184 0 0 69 88 184 0 12 47 27 185 0 12 0 3 62 89 184 0 20 16 185 0 3 0 1 244 184 0 16 16 184 0 7 208 184 0 16 16 185 0 13 0 1 244 184 0 10 208 48 49 1 46 1 35 34 6 29 1 51 21 35 17 35 17 35 53 55 53 52 54 51 50 23 2 47 30 51 32 66 57 204 204 81 139 139 95 101 72 68 2 122 14 9 67 60 44 67 254 93 1 163 62 5 41 89 108 28 0 0 0 0 3 0 72 255 32 2 54 1 242 0 17 0 69 0 85 0 178 0 184 0 0 69 88 184 0 37 47 27 185 0 37 0 7 62 89 184 0 0 69 88 184 0 40 47 27 185 0 40 0 7 62 89 184 0 0 69 88 184 0 39 47 27 185 0 39 0 7 62 89 184 0 0 69 88 184 0 67 47 27 185 0 67 0 5 62 89 184 0 0 69 88 184 0 12 47 27 185 0 12 0 3 62 89 184 0 67 16 185 0 3 0 1 244 184 0 12 16 184 0 15 208 184 0 21 208 184 0 12 16 185 0 58 0 1 244 184 0 50 220 185 0 70 0 1 244 186 0 53 0 70 0 50 17 18 57 184 0 53 16 184 0 28 208 184 0 40 16 185 0 41 0 1 244 184 0 39 16 185 0 42 0 1 244 184 0 37 16 185 0 78 0 1 244 48 49 23 20 22 51 50 62 2 53 52 38 43 1 34 38 39 14 1 7 52 54 55 53 46 1 53 52 54 55 53 46 1 53 52 62 2 51 50 23 51 21 35 30 1 21 20 14 2 35 34 38 39 6 21 20 22 59 1 50 22 21 20 14 2 35 34 38 19 50 54 53 52 46 2 35 34 14 2 21 20 22 143 81 78 42 68 48 25 55 56 95 21 37 16 35 27 71 41 39 20 30 30 28 25 35 31 52 69 39 40 32 201 130 17 28 29 51 69 39 19 43 20 38 53 48 109 94 91 38 70 100 62 107 117 219 47 65 18 30 41 23 23 41 30 18 66 81 38 48 17 28 36 19 35 24 3 5 19 41 29 29 56 23 4 11 38 31 23 49 19 4 19 63 44 40 64 45 25 12 63 18 52 32 39 62 43 23 9 9 24 32 29 27 52 62 34 62 46 28 70 1 107 62 53 25 42 30 17 17 30 42 25 53 62 0 0 0 0 1 0 93 0 0 2 11 2 200 0 22 0 101 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 15 62 89 184 0 0 69 88 184 0 6 47 27 185 0 6 0 7 62 89 184 0 0 69 88 184 0 22 47 27 185 0 22 0 3 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 3 62 89 186 0 3 0 6 0 11 17 18 57 184 0 6 16 185 0 15 0 1 244 184 0 3 16 185 0 20 0 1 244 48 49 19 51 21 7 62 1 51 50 22 21 17 35 17 52 38 35 34 14 2 7 17 35 93 82 4 39 88 57 87 81 82 52 60 22 37 36 38 21 82 2 200 194 115 41 54 99 97 254 210 1 35 69 67 11 22 33 22 254 173 0 0 0 2 0 90 0 0 1 158 2 201 0 5 0 17 0 59 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 7 62 89 184 0 0 69 88 184 0 2 47 27 185 0 2 0 3 62 89 184 0 0 16 185 0 4 0 1 244 184 0 0 16 184 0 6 220 184 0 12 220 48 49 19 33 17 35 17 35 37 34 38 53 52 54 51 50 22 21 20 6 90 1 52 82 226 1 2 29 37 37 29 28 38 38 1 230 254 26 1 163 167 34 29 29 35 35 29 29 34 0 0 0 2 0 55 255 39 1 158 2 201 0 21 0 33 0 65 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 7 62 89 184 0 0 69 88 184 0 7 47 27 185 0 7 0 5 62 89 185 0 14 0 1 244 184 0 0 16 185 0 20 0 1 244 184 0 0 16 184 0 22 220 184 0 28 220 48 49 19 33 17 20 14 2 35 34 38 39 55 30 1 51 50 62 2 53 17 35 37 34 38 53 52 54 51 50 22 21 20 6 90 1 52 20 47 78 59 38 72 29 27 26 57 28 36 48 28 11 226 1 2 29 37 37 29 28 38 38 1 230 254 14 45 75 55 30 19 14 61 13 14 18 34 49 31 1 181 167 34 29 29 35 35 29 29 34 0 0 0 0 1 0 106 0 0 2 62 2 200 0 12 0 109 0 184 0 0 69 88 184 0 4 47 27 185 0 4 0 7 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 15 62 89 184 0 0 69 88 184 0 12 47 27 185 0 12 0 3 62 89 184 0 0 69 88 184 0 8 47 27 185 0 8 0 3 62 89 186 0 2 0 0 0 12 17 18 57 186 0 9 0 0 0 8 17 18 57 184 0 9 16 184 0 6 208 184 0 2 16 185 0 10 0 1 244 48 49 19 51 17 51 1 51 7 19 35 39 7 21 35 106 82 4 1 6 94 194 220 92 179 115 82 2 200 254 30 1 0 193 254 219 243 111 132 0 1 0 81 255 244 2 25 2 200 0 16 0 53 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 15 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 3 62 89 185 0 5 0 1 244 184 0 0 16 185 0 16 0 1 244 48 49 19 51 17 20 22 51 50 55 23 14 1 35 34 38 53 17 35 81 248 51 44 40 52 21 33 58 40 78 81 166 2 200 253 213 54 47 23 62 12 17 88 87 1 226 0 0 1 0 60 0 0 2 44 1 242 0 32 0 163 0 184 0 0 69 88 184 0 6 47 27 185 0 6 0 7 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 7 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 7 62 89 184 0 0 69 88 184 0 32 47 27 185 0 32 0 3 62 89 184 0 0 69 88 184 0 24 47 27 185 0 24 0 3 62 89 184 0 0 69 88 184 0 16 47 27 185 0 16 0 3 62 89 186 0 2 0 32 0 0 17 18 57 184 0 2 16 184 0 8 208 184 0 11 16 185 0 19 0 1 244 184 0 8 16 185 0 22 0 1 244 184 0 6 16 185 0 27 0 1 244 184 0 2 16 185 0 30 0 1 244 48 49 19 51 23 51 62 1 51 50 23 62 1 51 50 22 21 17 35 17 52 35 34 6 7 17 35 17 52 35 34 6 7 17 35 60 64 7 3 18 49 42 74 18 22 52 41 51 55 79 53 26 38 19 66 55 26 36 19 79 1 230 64 34 42 84 38 46 77 73 254 164 1 85 86 37 38 254 160 1 85 86 37 38 254 160 0 0 0 0 1 0 93 0 0 2 11 1 242 0 22 0 101 0 184 0 0 69 88 184 0 6 47 27 185 0 6 0 7 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 7 62 89 184 0 0 69 88 184 0 22 47 27 185 0 22 0 3 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 3 62 89 186 0 2 0 6 0 22 17 18 57 184 0 6 16 185 0 15 0 1 244 184 0 2 16 185 0 20 0 1 244 48 49 19 51 23 51 62 1 51 50 22 21 17 35 17 52 38 35 34 14 2 7 17 35 93 68 7 4 38 88 57 87 81 82 52 60 22 37 36 38 21 82 1 230 83 41 54 99 97 254 210 1 35 69 67 11 22 33 22 254 173 0 0 0 2 0 60 255 244 2 28 1 242 0 19 0 39 0 53 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 7 62 89 184 0 0 69 88 184 0 15 47 27 185 0 15 0 3 62 89 185 0 25 0 1 244 184 0 5 16 185 0 35 0 1 244 48 49 55 52 62 2 51 50 30 2 21 20 14 2 35 34 46 2 55 20 30 2 51 50 62 2 53 52 46 2 35 34 14 2 60 39 66 87 48 48 87 66 39 39 66 87 48 48 87 66 39 85 22 41 57 35 35 57 41 22 22 41 57 35 35 57 41 22 242 61 95 66 34 34 66 95 61 60 95 65 34 34 65 95 60 42 68 49 27 27 49 68 42 42 69 50 27 27 50 69 0 0 2 0 93 255 51 2 28 1 242 0 22 0 37 0 131 0 184 0 0 69 88 184 0 9 47 27 185 0 9 0 7 62 89 184 0 0 69 88 184 0 3 47 27 185 0 3 0 7 62 89 184 0 0 69 88 184 0 19 47 27 185 0 19 0 3 62 89 184 0 0 69 88 184 0 2 47 27 185 0 2 0 5 62 89 186 0 5 0 9 0 19 17 18 57 186 0 22 0 19 0 9 17 18 57 184 0 22 16 185 0 23 0 1 244 184 0 19 16 185 0 26 0 1 244 184 0 9 16 185 0 34 0 1 244 184 0 5 16 185 0 37 0 1 244 48 49 23 21 35 17 51 23 51 62 1 51 50 30 2 21 20 14 2 35 34 38 39 55 30 1 51 50 54 53 52 46 2 35 34 6 7 175 82 68 7 3 34 89 45 49 75 51 26 36 61 80 44 34 79 33 2 35 70 25 66 84 16 33 52 36 32 73 38 41 164 2 179 62 32 42 35 65 91 57 62 97 68 35 33 30 63 31 26 102 91 40 66 47 26 35 38 0 0 0 2 0 60 255 51 1 251 1 242 0 22 0 36 0 131 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 7 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 7 62 89 184 0 0 69 88 184 0 18 47 27 185 0 18 0 3 62 89 184 0 0 69 88 184 0 13 47 27 185 0 13 0 5 62 89 186 0 8 0 5 0 18 17 18 57 186 0 15 0 18 0 5 17 18 57 184 0 18 16 185 0 26 0 1 244 184 0 15 16 185 0 28 0 1 244 184 0 8 16 185 0 29 0 1 244 184 0 5 16 185 0 32 0 1 244 48 49 55 52 62 2 51 50 22 23 51 55 51 17 35 53 55 14 1 35 34 46 2 55 20 22 51 50 55 53 46 1 35 34 14 2 60 37 61 80 43 45 70 35 3 7 66 82 4 32 81 45 48 77 56 30 85 75 68 72 65 33 63 32 32 55 41 24 242 59 95 66 36 34 32 54 253 77 179 88 31 43 34 65 94 62 88 98 73 242 31 26 27 49 68 0 1 0 146 0 0 2 25 1 242 0 18 0 84 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 7 62 89 184 0 0 69 88 184 0 6 47 27 185 0 6 0 7 62 89 184 0 0 69 88 184 0 17 47 27 185 0 17 0 3 62 89 186 0 2 0 17 0 0 17 18 57 184 0 6 16 185 0 13 0 1 244 184 0 2 16 185 0 16 0 1 244 48 49 19 51 23 51 62 1 51 50 22 23 7 46 1 35 34 6 7 17 35 146 68 7 3 38 111 68 27 46 23 19 26 35 29 55 101 44 82 1 230 115 59 68 9 11 71 9 8 63 76 254 227 0 0 0 0 1 0 72 255 244 2 14 1 242 0 45 0 73 0 184 0 0 69 88 184 0 19 47 27 185 0 19 0 7 62 89 184 0 0 69 88 184 0 42 47 27 185 0 42 0 3 62 89 185 0 3 0 1 244 186 0 6 0 42 0 19 17 18 57 184 0 19 16 185 0 26 0 1 244 186 0 31 0 19 0 42 17 18 57 48 49 55 30 1 51 50 54 53 52 38 39 46 3 53 52 62 2 51 50 22 23 7 46 1 35 34 14 2 21 20 22 23 30 1 21 20 14 2 35 34 38 39 112 41 94 66 66 64 69 89 38 67 50 30 26 51 77 50 55 104 36 40 32 78 45 34 46 28 12 82 66 99 95 28 55 81 52 72 121 45 118 30 36 44 32 28 44 22 9 26 35 42 26 29 51 37 21 37 25 53 23 28 11 19 26 14 30 39 17 25 64 56 30 52 40 23 45 31 0 1 0 69 255 244 2 34 2 110 0 27 0 77 0 184 0 5 47 184 0 0 69 88 184 0 3 47 27 185 0 3 0 7 62 89 184 0 0 69 88 184 0 22 47 27 185 0 22 0 3 62 89 184 0 3 16 185 0 1 0 1 244 184 0 3 16 184 0 7 208 184 0 1 16 184 0 8 208 184 0 22 16 185 0 15 0 1 244 48 49 19 35 53 63 1 51 21 51 21 35 21 20 30 2 51 50 54 55 23 14 1 35 34 46 2 53 206 137 140 11 68 239 239 12 28 48 35 35 56 26 18 33 80 40 53 72 43 19 1 163 62 5 136 136 67 231 33 49 34 17 12 10 60 12 17 29 53 74 45 0 1 0 77 255 244 1 249 1 230 0 20 0 101 0 184 0 0 69 88 184 0 10 47 27 185 0 10 0 7 62 89 184 0 0 69 88 184 0 19 47 27 185 0 19 0 7 62 89 184 0 0 69 88 184 0 6 47 27 185 0 6 0 3 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 3 62 89 186 0 2 0 6 0 19 17 18 57 184 0 6 16 185 0 15 0 1 244 184 0 2 16 185 0 18 0 1 244 48 49 33 35 39 35 14 1 35 34 38 53 17 51 17 20 22 51 50 54 55 17 51 1 249 67 7 4 37 87 57 88 81 83 51 61 42 68 41 82 85 43 54 99 97 1 46 254 221 69 67 43 47 1 81 0 1 0 51 0 0 2 37 1 230 0 13 0 60 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 7 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 7 62 89 184 0 0 69 88 184 0 13 47 27 185 0 13 0 3 62 89 185 0 5 0 1 244 48 49 19 51 19 30 1 23 51 62 1 55 19 51 3 35 51 83 112 15 27 13 4 13 25 15 112 79 201 92 1 230 254 236 37 71 35 35 71 37 1 20 254 26 0 1 0 8 0 0 2 80 1 230 0 33 0 116 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 7 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 7 62 89 184 0 0 69 88 184 0 20 47 27 185 0 20 0 7 62 89 184 0 0 69 88 184 0 33 47 27 185 0 33 0 3 62 89 184 0 0 69 88 184 0 23 47 27 185 0 23 0 3 62 89 186 0 6 0 0 0 33 17 18 57 184 0 6 16 184 0 15 208 186 0 28 0 0 0 23 17 18 57 48 49 19 51 19 30 1 23 51 62 1 63 1 51 23 30 1 23 51 62 1 55 19 51 3 35 39 46 1 39 35 14 1 15 1 35 8 84 59 7 12 5 4 7 14 8 59 70 60 8 14 8 4 7 11 6 59 78 106 99 58 7 12 8 4 6 12 9 56 98 1 230 254 231 35 66 34 34 67 34 252 252 35 66 34 34 66 35 1 25 254 26 246 35 69 37 32 68 42 245 0 1 0 64 0 0 2 23 1 230 0 25 0 101 0 184 0 0 69 88 184 0 1 47 27 185 0 1 0 7 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 7 62 89 184 0 0 69 88 184 0 25 47 27 185 0 25 0 3 62 89 184 0 0 69 88 184 0 15 47 27 185 0 15 0 3 62 89 186 0 19 0 1 0 25 17 18 57 184 0 19 16 184 0 0 208 184 0 19 16 184 0 13 208 184 0 7 208 48 49 55 39 51 23 30 1 23 51 62 1 63 1 51 7 23 35 39 46 1 39 35 14 1 15 1 35 249 171 91 77 13 29 15 4 14 28 13 73 87 173 186 90 85 15 33 16 4 15 30 15 80 88 252 234 107 20 42 20 20 44 20 105 241 245 112 21 46 21 22 43 23 112 0 0 1 0 49 255 47 2 39 1 230 0 28 0 91 0 184 0 0 69 88 184 0 8 47 27 185 0 8 0 7 62 89 184 0 0 69 88 184 0 18 47 27 185 0 18 0 7 62 89 184 0 0 69 88 184 0 25 47 27 185 0 25 0 5 62 89 184 0 0 69 88 184 0 7 47 27 185 0 7 0 3 62 89 184 0 25 16 185 0 3 0 1 244 186 0 14 0 8 0 7 17 18 57 48 49 23 30 1 51 50 54 63 1 3 51 19 30 1 23 51 62 1 55 19 51 3 14 3 35 34 39 55 84 10 23 11 51 64 18 15 227 83 119 14 31 15 4 13 27 12 106 78 214 14 36 50 65 41 36 28 17 134 3 4 59 45 36 1 231 254 243 32 74 35 35 73 33 1 13 253 242 36 62 45 26 10 65 0 0 1 0 71 0 0 2 20 1 230 0 9 0 61 0 184 0 0 69 88 184 0 3 47 27 185 0 3 0 7 62 89 184 0 0 69 88 184 0 8 47 27 185 0 8 0 3 62 89 185 0 6 0 1 244 184 0 0 208 184 0 3 16 185 0 1 0 1 244 184 0 5 208 48 49 55 1 33 53 33 21 1 33 21 33 71 1 77 254 216 1 158 254 178 1 88 254 51 44 1 119 67 44 254 137 67 0 0 255 255 0 32 0 0 2 56 3 50 2 38 0 4 0 0 0 6 2 224 0 0 0 0 255 255 0 32 0 0 2 56 3 50 2 38 0 4 0 0 0 6 2 226 0 0 0 0 255 255 0 32 0 0 2 56 3 50 2 38 0 4 0 0 0 6 2 228 0 0 0 0 255 255 0 32 0 0 2 56 3 51 2 38 0 4 0 0 0 6 2 230 0 0 0 0 255 255 0 32 0 0 2 56 3 45 2 38 0 4 0 0 0 6 2 238 0 0 0 0 255 255 0 32 0 0 2 56 3 18 2 38 0 4 0 0 0 6 2 232 0 0 0 0 255 255 0 32 0 0 2 56 3 50 2 38 0 4 0 0 0 6 2 234 0 0 0 0 255 255 0 32 0 0 2 56 3 107 2 38 0 4 0 0 0 6 2 242 0 0 0 0 255 255 0 32 0 0 2 56 3 50 2 38 0 4 0 0 0 6 2 246 0 0 0 0 255 255 0 32 255 30 2 56 2 144 2 38 0 4 0 0 0 6 2 252 0 0 0 0 255 255 0 32 0 0 2 56 3 104 2 38 0 4 0 0 0 6 2 240 0 0 0 0 255 255 0 32 0 0 2 56 3 113 2 38 0 4 0 0 0 6 3 14 0 0 0 0 255 255 0 32 0 0 2 56 3 113 2 38 0 4 0 0 0 6 3 16 0 0 0 0 255 255 0 32 0 0 2 56 3 138 2 38 0 4 0 0 0 6 3 18 0 0 0 0 255 255 0 32 0 0 2 56 3 170 2 38 0 4 0 0 0 6 3 20 0 0 0 0 255 255 0 32 255 30 2 56 3 50 2 38 0 4 0 0 0 38 2 228 0 0 0 6 2 252 0 0 255 255 0 32 0 0 2 56 3 139 2 38 0 4 0 0 0 6 3 22 0 0 0 0 255 255 0 32 0 0 2 56 3 139 2 38 0 4 0 0 0 6 3 24 0 0 0 0 255 255 0 32 0 0 2 56 3 184 2 38 0 4 0 0 0 6 3 26 0 0 0 0 255 255 0 32 0 0 2 56 3 171 2 38 0 4 0 0 0 6 3 28 0 0 0 0 255 255 0 32 255 30 2 56 3 50 2 38 0 4 0 0 0 38 2 234 0 0 0 6 2 252 0 0 0 2 0 32 255 44 2 87 2 144 0 9 0 37 0 101 0 184 0 0 69 88 184 0 27 47 27 185 0 27 0 13 62 89 184 0 0 69 88 184 0 21 47 27 185 0 21 0 3 62 89 184 0 0 69 88 184 0 25 47 27 185 0 25 0 3 62 89 184 0 0 69 88 184 0 29 47 27 185 0 29 0 3 62 89 187 0 35 0 1 0 13 0 4 43 187 0 0 0 1 0 23 0 4 43 184 0 27 16 185 0 4 0 1 244 48 49 1 39 46 1 39 35 14 1 15 1 1 14 1 35 34 38 53 52 62 2 55 35 39 35 7 35 19 51 19 14 1 21 20 22 51 50 55 1 141 31 17 32 16 4 16 32 17 31 1 142 14 46 20 40 55 14 21 27 13 19 62 238 63 85 221 94 221 35 45 29 17 23 19 1 11 100 55 109 57 57 109 55 100 254 61 11 17 44 43 20 38 32 26 9 200 200 2 144 253 112 14 61 32 23 23 14 0 0 2 255 255 0 0 2 79 2 144 0 6 0 22 0 102 0 184 0 0 69 88 184 0 14 47 27 185 0 14 0 13 62 89 184 0 0 69 88 184 0 8 47 27 185 0 8 0 3 62 89 184 0 0 69 88 184 0 12 47 27 185 0 12 0 3 62 89 187 0 0 0 1 0 10 0 4 43 187 0 19 0 1 0 20 0 4 43 184 0 14 16 185 0 1 0 1 244 184 0 8 16 185 0 7 0 1 244 184 0 1 16 184 0 17 208 48 49 1 17 35 14 1 15 1 5 21 33 53 35 7 35 1 33 21 35 21 51 21 35 21 1 61 3 20 43 20 46 1 150 254 238 158 73 87 1 4 1 67 189 147 147 1 2 1 76 54 105 54 119 187 71 191 191 2 144 70 205 71 239 0 3 0 27 0 0 2 41 2 144 0 12 0 21 0 45 0 99 0 184 0 0 69 88 184 0 37 47 27 185 0 37 0 13 62 89 184 0 0 69 88 184 0 30 47 27 185 0 30 0 3 62 89 185 0 0 0 1 244 184 0 11 208 184 0 8 208 184 0 7 208 184 0 13 208 184 0 37 16 185 0 20 0 1 244 186 0 22 0 13 0 7 17 18 57 184 0 11 16 184 0 33 208 184 0 8 16 184 0 35 208 184 0 34 208 48 49 37 50 54 53 52 38 43 1 21 51 21 35 21 17 51 50 54 53 52 38 43 1 23 30 1 21 20 14 2 43 1 53 35 53 55 17 51 50 30 2 21 20 6 7 1 38 85 94 92 87 107 143 143 90 84 74 78 76 94 214 72 80 36 65 91 55 202 77 77 187 50 83 59 33 56 59 63 67 70 65 60 101 47 114 1 61 56 56 54 48 238 11 80 69 50 73 49 24 177 42 5 1 176 18 38 60 42 48 75 15 0 255 255 0 66 255 43 2 42 2 156 2 38 0 6 0 0 0 6 3 0 47 0 0 0 255 255 0 66 255 244 2 42 3 50 2 38 0 6 0 0 0 6 2 226 47 0 0 0 255 255 0 66 255 244 2 42 3 50 2 38 0 6 0 0 0 6 2 228 47 0 0 0 255 255 0 66 255 244 2 42 3 50 2 38 0 6 0 0 0 6 2 246 47 0 0 0 255 255 0 66 255 244 2 42 3 53 2 38 0 6 0 0 0 6 2 236 47 0 0 0 255 255 0 85 0 0 2 37 3 50 2 38 0 7 0 0 0 6 2 246 0 0 0 0 255 255 0 85 255 30 2 37 2 144 2 38 0 7 0 0 0 6 2 252 247 0 0 0 255 255 0 85 255 85 2 37 2 144 2 38 0 7 0 0 0 6 3 4 247 0 0 0 255 255 0 16 0 0 2 43 2 144 2 6 0 230 0 0 255 255 0 115 0 0 2 18 3 50 2 38 0 8 0 0 0 6 2 224 31 0 0 0 255 255 0 115 0 0 2 18 3 50 2 38 0 8 0 0 0 6 2 226 31 0 0 0 255 255 0 115 0 0 2 18 3 50 2 38 0 8 0 0 0 6 2 228 31 0 0 0 255 255 0 115 0 0 2 18 3 50 2 38 0 8 0 0 0 6 2 246 31 0 0 0 255 255 0 115 0 0 2 18 3 45 2 38 0 8 0 0 0 6 2 238 31 0 0 0 255 255 0 115 0 0 2 18 3 18 2 38 0 8 0 0 0 6 2 232 31 0 0 0 255 255 0 115 0 0 2 18 3 50 2 38 0 8 0 0 0 6 2 234 31 0 0 0 255 255 0 115 0 0 2 18 3 53 2 38 0 8 0 0 0 6 2 236 31 0 0 0 255 255 0 115 255 30 2 18 2 144 2 38 0 8 0 0 0 6 2 252 32 0 0 0 255 255 0 115 0 0 2 18 3 104 2 38 0 8 0 0 0 6 2 240 31 0 0 0 255 255 0 115 0 0 2 18 3 51 2 38 0 8 0 0 0 6 2 230 31 0 0 0 255 255 0 115 0 0 2 53 3 113 2 38 0 8 0 0 0 6 3 14 31 0 0 0 255 255 0 115 0 0 2 18 3 113 2 38 0 8 0 0 0 6 3 16 31 0 0 0 255 255 0 115 0 0 2 26 3 138 2 38 0 8 0 0 0 6 3 18 31 0 0 0 255 255 0 115 0 0 2 18 3 170 2 38 0 8 0 0 0 6 3 20 31 0 0 0 255 255 0 115 255 30 2 18 3 50 2 38 0 8 0 0 0 38 2 228 31 0 0 6 2 252 32 0 0 1 0 115 255 44 2 33 2 144 0 33 0 94 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 13 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 3 62 89 184 0 0 69 88 184 0 32 47 27 185 0 32 0 3 62 89 187 0 19 0 1 0 26 0 4 43 187 0 5 0 1 0 6 0 4 43 184 0 0 16 185 0 2 0 1 244 184 0 32 16 185 0 8 0 1 244 48 49 19 33 21 33 21 33 21 33 21 33 21 35 14 3 21 20 22 51 50 54 55 23 14 1 35 34 38 53 52 54 55 33 115 1 149 254 191 1 15 254 241 1 75 4 17 33 25 16 29 18 12 19 10 22 14 46 20 39 56 47 28 254 182 2 144 70 206 71 238 71 2 19 29 37 20 23 23 7 7 45 11 17 44 43 42 65 18 0 255 255 0 53 255 244 2 21 3 50 2 38 0 10 0 0 0 6 2 228 31 0 0 0 255 255 0 53 255 244 2 21 3 50 2 38 0 10 0 0 0 6 2 234 31 0 0 0 255 255 0 53 255 244 2 21 3 53 2 38 0 10 0 0 0 6 2 236 31 0 0 0 255 255 0 53 255 40 2 21 2 156 2 38 0 10 0 0 0 6 2 254 35 0 0 0 255 255 0 53 255 244 2 21 3 50 2 38 0 10 0 0 0 6 2 246 31 0 0 0 255 255 0 53 255 244 2 21 3 18 2 38 0 10 0 0 0 6 2 232 31 0 0 0 255 255 0 53 255 244 2 21 3 51 2 38 0 10 0 0 0 6 2 230 31 0 0 0 255 255 0 79 0 0 2 9 3 50 2 38 0 11 0 0 0 6 2 228 0 0 0 0 255 255 0 79 255 30 2 9 2 144 2 38 0 11 0 0 0 6 2 252 0 0 0 0 255 255 0 79 255 50 2 9 2 144 2 38 0 11 0 0 0 6 3 3 0 0 0 0 0 2 0 10 0 0 2 78 2 144 0 3 0 23 0 131 0 184 0 0 69 88 184 0 16 47 27 185 0 16 0 13 62 89 184 0 0 69 88 184 0 20 47 27 185 0 20 0 13 62 89 184 0 0 69 88 184 0 7 47 27 185 0 7 0 3 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 3 62 89 184 0 20 16 184 0 19 220 185 0 0 0 1 244 184 0 3 220 184 0 0 16 184 0 5 208 184 0 3 16 185 0 8 0 1 244 184 0 0 16 184 0 12 208 184 0 19 16 184 0 15 208 184 0 19 16 184 0 22 208 48 49 1 33 21 33 55 35 17 35 17 33 17 35 17 35 53 55 53 51 21 33 53 51 21 51 1 181 254 238 1 18 153 69 84 254 238 84 69 69 84 1 18 84 69 1 236 111 111 254 20 1 53 254 203 1 236 42 5 117 117 117 117 255 255 0 95 0 0 1 249 3 50 2 38 0 12 0 0 0 6 2 224 0 0 0 0 255 255 0 95 0 0 1 249 3 50 2 38 0 12 0 0 0 6 2 226 0 0 0 0 255 255 0 95 0 0 1 249 3 50 2 38 0 12 0 0 0 6 2 228 0 0 0 0 255 255 0 95 0 0 1 249 3 51 2 38 0 12 0 0 0 6 2 230 0 0 0 0 255 255 0 95 0 0 1 249 3 45 2 38 0 12 0 0 0 6 2 238 0 0 0 0 255 255 0 95 0 0 1 249 3 18 2 38 0 12 0 0 0 6 2 232 0 0 0 0 255 255 0 95 0 0 1 249 3 50 2 38 0 12 0 0 0 6 2 234 0 0 0 0 255 255 0 95 0 0 1 249 3 53 2 38 0 12 0 0 0 6 2 236 0 0 0 0 255 255 0 95 0 0 1 249 3 50 2 38 0 12 0 0 0 6 2 246 0 0 0 0 255 255 0 95 0 0 1 249 3 104 2 38 0 12 0 0 0 6 2 240 0 0 0 0 255 255 0 95 255 30 1 249 2 144 2 38 0 12 0 0 0 6 2 252 1 0 0 0 0 1 0 95 255 44 1 249 2 144 0 30 0 96 0 184 0 0 69 88 184 0 4 47 27 185 0 4 0 13 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 3 62 89 184 0 0 69 88 184 0 29 47 27 185 0 29 0 3 62 89 187 0 17 0 1 0 23 0 4 43 184 0 29 16 185 0 0 0 1 244 184 0 4 16 185 0 2 0 1 244 184 0 6 208 184 0 0 16 184 0 8 208 48 49 55 51 17 35 53 33 21 35 17 51 21 35 14 1 21 20 22 51 50 55 23 14 1 35 34 38 53 52 54 55 35 95 163 163 1 154 163 163 163 32 34 30 18 23 17 23 14 46 20 40 55 42 24 183 71 2 3 70 70 253 253 71 24 52 31 23 23 14 45 11 17 44 43 43 60 22 0 0 255 255 0 81 255 244 1 237 3 50 2 38 0 13 0 0 0 6 2 228 21 0 0 0 255 255 0 98 255 40 2 67 2 144 2 38 0 14 0 0 0 6 2 254 38 0 0 0 255 255 0 134 0 0 2 29 3 50 2 38 0 15 0 0 0 6 2 226 147 0 0 0 255 255 0 134 0 0 2 29 2 215 2 38 0 15 0 0 0 6 3 31 124 223 0 0 255 255 0 134 255 40 2 29 2 144 2 38 0 15 0 0 0 6 2 254 46 0 0 0 255 255 0 134 0 0 2 29 2 144 2 38 0 15 0 0 0 7 2 235 0 130 254 211 255 255 0 134 255 30 2 29 2 144 2 38 0 15 0 0 0 6 2 252 46 0 0 0 255 255 0 67 255 30 2 29 3 18 2 38 0 15 0 0 0 38 2 232 147 0 0 6 2 252 46 0 255 255 0 134 255 85 2 29 2 144 2 38 0 15 0 0 0 6 3 4 46 0 0 0 0 1 0 53 0 0 2 29 2 144 0 13 0 73 0 184 0 0 69 88 184 0 7 47 27 185 0 7 0 13 62 89 184 0 0 69 88 184 0 1 47 27 185 0 1 0 3 62 89 185 0 0 0 1 244 186 0 3 0 1 0 7 17 18 57 184 0 3 16 184 0 6 208 184 0 3 16 184 0 12 208 184 0 9 208 48 49 37 21 33 53 7 53 55 17 51 17 55 21 7 21 2 29 254 105 81 81 82 226 226 71 71 227 43 67 44 1 105 254 191 120 68 120 196 255 255 0 81 255 30 2 7 2 144 2 38 0 16 0 0 0 6 2 252 0 0 0 0 255 255 0 83 0 0 2 5 3 50 2 38 0 17 0 0 0 6 2 226 6 0 0 0 255 255 0 83 0 0 2 5 3 50 2 38 0 17 0 0 0 6 2 246 6 0 0 0 255 255 0 83 0 0 2 5 3 51 2 38 0 17 0 0 0 6 2 230 6 0 0 0 255 255 0 83 255 40 2 5 2 144 2 38 0 17 0 0 0 6 2 254 0 0 0 0 255 255 0 83 0 0 2 5 3 53 2 38 0 17 0 0 0 6 2 236 6 0 0 0 255 255 0 83 255 30 2 5 2 144 2 38 0 17 0 0 0 6 2 252 0 0 0 0 255 255 0 83 255 85 2 5 2 144 2 38 0 17 0 0 0 6 3 4 0 0 0 0 255 255 0 48 255 244 2 40 3 50 2 38 0 18 0 0 0 6 2 224 0 0 0 0 255 255 0 48 255 244 2 40 3 50 2 38 0 18 0 0 0 6 2 226 0 0 0 0 255 255 0 48 255 244 2 40 3 50 2 38 0 18 0 0 0 6 2 228 0 0 0 0 255 255 0 48 255 244 2 40 3 51 2 38 0 18 0 0 0 6 2 230 0 0 0 0 255 255 0 48 255 244 2 40 3 45 2 38 0 18 0 0 0 6 2 238 0 0 0 0 255 255 0 48 255 244 2 40 3 18 2 38 0 18 0 0 0 6 2 232 0 0 0 0 255 255 0 48 255 244 2 40 3 50 2 38 0 18 0 0 0 6 2 234 0 0 0 0 255 255 0 48 255 244 2 40 3 50 2 38 0 18 0 0 0 6 2 244 0 0 0 0 255 255 0 48 255 244 2 40 3 50 2 38 0 18 0 0 0 6 2 246 0 0 0 0 255 255 0 48 255 30 2 40 2 156 2 38 0 18 0 0 0 6 2 252 0 0 0 0 255 255 0 48 255 244 2 40 3 104 2 38 0 18 0 0 0 6 2 240 0 0 0 0 255 255 0 48 255 244 2 40 3 113 2 38 0 18 0 0 0 6 3 14 0 0 0 0 255 255 0 48 255 244 2 40 3 113 2 38 0 18 0 0 0 6 3 16 0 0 0 0 255 255 0 48 255 244 2 40 3 138 2 38 0 18 0 0 0 6 3 18 0 0 0 0 255 255 0 48 255 244 2 40 3 170 2 38 0 18 0 0 0 6 3 20 0 0 0 0 255 255 0 48 255 30 2 40 3 50 2 38 0 18 0 0 0 38 2 228 0 0 0 6 2 252 0 0 0 3 0 45 255 226 2 44 2 174 0 10 0 21 0 47 0 125 0 184 0 0 69 88 184 0 43 47 27 185 0 43 0 13 62 89 184 0 0 69 88 184 0 30 47 27 185 0 30 0 3 62 89 186 0 21 0 30 0 43 17 18 57 184 0 21 16 184 0 0 208 184 0 30 16 185 0 3 0 1 244 186 0 10 0 30 0 43 17 18 57 184 0 10 16 184 0 11 208 184 0 43 16 185 0 14 0 1 244 184 0 10 16 184 0 22 208 184 0 0 16 184 0 32 208 184 0 21 16 184 0 35 208 184 0 11 16 184 0 45 208 48 49 55 30 1 51 50 62 2 53 52 47 1 46 1 35 34 14 2 21 20 23 1 30 1 21 20 14 2 35 34 39 7 39 55 46 1 53 52 62 2 51 50 23 55 23 192 21 55 32 37 62 43 24 25 31 21 56 33 38 61 43 24 27 1 76 29 30 37 67 93 55 90 64 53 48 63 29 31 37 67 92 56 92 63 54 47 116 26 29 38 71 99 62 89 64 56 26 29 37 68 98 61 95 64 1 133 43 115 72 79 127 89 48 61 79 32 93 45 118 73 79 125 87 46 61 79 32 0 0 0 0 2 0 33 0 0 2 79 2 145 0 18 0 27 0 79 0 184 0 0 69 88 184 0 3 47 27 185 0 3 0 13 62 89 184 0 0 69 88 184 0 13 47 27 185 0 13 0 3 62 89 187 0 8 0 1 0 9 0 4 43 184 0 3 16 185 0 6 0 1 244 184 0 13 16 185 0 11 0 1 244 184 0 22 208 184 0 6 16 184 0 24 208 48 49 19 52 54 51 33 21 35 21 51 21 35 21 51 21 33 34 46 2 55 20 22 59 1 17 35 34 6 33 141 125 1 26 194 148 148 204 254 217 62 97 68 36 86 84 86 21 21 86 84 1 75 158 168 70 207 71 238 71 45 85 123 78 126 137 2 8 131 0 0 0 2 0 48 255 244 2 50 3 5 0 19 0 52 0 71 0 184 0 0 69 88 184 0 44 47 27 185 0 44 0 13 62 89 184 0 0 69 88 184 0 34 47 27 185 0 34 0 3 62 89 185 0 0 0 1 244 184 0 44 16 185 0 10 0 1 244 186 0 26 0 34 0 44 17 18 57 184 0 26 16 184 0 46 208 48 49 37 50 62 2 53 52 46 2 35 34 14 2 21 20 30 2 1 30 1 21 20 6 7 30 1 21 20 14 2 35 34 46 2 53 52 62 2 51 50 23 62 1 53 52 38 39 1 44 37 62 43 24 24 43 62 37 38 61 43 24 24 43 61 1 21 11 12 57 45 44 48 37 67 93 55 56 92 67 37 37 67 92 56 63 53 39 40 8 7 61 38 71 99 62 61 98 68 37 37 68 98 61 62 99 71 38 2 200 14 32 19 45 50 11 43 137 91 79 127 89 48 48 89 127 79 79 125 87 46 31 6 30 30 11 20 10 0 255 255 0 48 255 244 2 50 3 50 2 38 0 165 0 0 0 6 2 226 0 0 0 0 255 255 0 48 255 244 2 50 3 50 2 38 0 165 0 0 0 6 2 224 0 0 0 0 255 255 0 48 255 244 2 50 3 104 2 38 0 165 0 0 0 6 2 240 0 0 0 0 255 255 0 48 255 244 2 50 3 51 2 38 0 165 0 0 0 6 2 230 0 0 0 0 255 255 0 48 255 30 2 50 3 5 2 38 0 165 0 0 0 6 2 252 0 0 0 0 0 2 0 48 255 44 2 40 2 156 0 37 0 57 0 75 0 184 0 0 69 88 184 0 19 47 27 185 0 19 0 13 62 89 184 0 0 69 88 184 0 9 47 27 185 0 9 0 3 62 89 187 0 35 0 1 0 3 0 4 43 184 0 9 16 184 0 27 208 184 0 9 16 185 0 38 0 1 244 184 0 19 16 185 0 48 0 1 244 48 49 5 14 1 35 34 38 53 52 54 55 46 3 53 52 62 2 51 50 30 2 21 20 6 7 14 3 21 20 22 51 50 55 39 50 62 2 53 52 46 2 35 34 14 2 21 20 30 2 1 154 15 45 20 40 56 36 26 65 93 61 29 37 67 92 56 55 93 67 37 96 79 20 30 19 9 30 17 22 19 87 37 62 43 24 24 43 62 37 38 61 43 24 24 43 61 184 11 17 44 43 33 59 22 2 58 95 122 65 79 125 87 46 47 87 125 78 133 164 34 9 25 29 31 13 23 23 14 200 38 71 99 62 61 98 68 37 37 68 98 61 62 99 71 38 0 255 255 0 100 0 0 2 41 3 50 2 38 0 21 0 0 0 6 2 226 5 0 0 0 255 255 0 100 0 0 2 41 3 50 2 38 0 21 0 0 0 6 2 246 5 0 0 0 255 255 0 100 255 40 2 41 2 144 2 38 0 21 0 0 0 6 2 254 20 0 0 0 255 255 0 100 255 30 2 41 2 144 2 38 0 21 0 0 0 6 2 252 20 0 0 0 255 255 0 100 255 30 2 41 3 18 2 38 0 21 0 0 0 38 2 232 5 0 0 6 2 252 20 0 255 255 0 100 255 85 2 41 2 144 2 38 0 21 0 0 0 6 3 4 20 0 0 0 255 255 0 67 255 244 2 25 3 50 2 38 0 22 0 0 0 6 2 226 11 0 0 0 255 255 0 67 255 244 2 25 3 50 2 38 0 22 0 0 0 6 2 228 11 0 0 0 255 255 0 67 255 244 2 25 3 50 2 38 0 22 0 0 0 6 2 246 11 0 0 0 255 255 0 67 255 43 2 25 2 156 2 38 0 22 0 0 0 6 3 0 13 0 0 0 255 255 0 67 255 40 2 25 2 156 2 38 0 22 0 0 0 6 2 254 10 0 0 0 255 255 0 67 255 244 2 25 3 53 2 38 0 22 0 0 0 6 2 236 11 0 0 0 255 255 0 67 255 30 2 25 2 156 2 38 0 22 0 0 0 6 2 252 10 0 0 0 0 1 0 79 255 244 2 51 2 156 0 42 0 104 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 13 62 89 184 0 0 69 88 184 0 41 47 27 185 0 41 0 3 62 89 184 0 0 69 88 184 0 17 47 27 185 0 17 0 3 62 89 187 0 33 0 1 0 32 0 4 43 186 0 9 0 33 0 32 17 18 57 184 0 17 16 185 0 24 0 1 244 184 0 5 16 185 0 37 0 1 244 186 0 27 0 37 0 17 17 18 57 48 49 19 52 62 2 51 50 22 23 7 30 1 21 20 14 2 35 34 38 39 55 30 1 51 50 54 53 52 46 2 47 1 55 46 1 35 34 6 21 17 35 79 28 57 88 59 78 98 23 117 88 82 24 45 63 40 52 83 27 48 25 51 30 44 48 15 38 63 49 5 118 14 57 44 68 76 85 1 176 50 87 63 36 84 70 152 21 98 72 39 67 49 28 40 33 53 29 27 63 50 23 42 36 28 10 54 153 34 48 89 94 254 96 0 0 255 255 0 42 0 0 2 46 3 50 2 38 0 23 0 0 0 6 2 246 0 0 0 0 255 255 0 42 255 43 2 46 2 144 2 38 0 23 0 0 0 6 3 0 0 0 0 0 255 255 0 42 255 40 2 46 2 144 2 38 0 23 0 0 0 6 2 254 1 0 0 0 255 255 0 42 255 30 2 46 2 144 2 38 0 23 0 0 0 6 2 252 1 0 0 0 255 255 0 42 255 85 2 46 2 144 2 38 0 23 0 0 0 6 3 4 1 0 0 0 255 255 0 79 255 244 2 9 3 50 2 38 0 24 0 0 0 6 2 224 0 0 0 0 255 255 0 79 255 244 2 9 3 50 2 38 0 24 0 0 0 6 2 226 0 0 0 0 255 255 0 79 255 244 2 9 3 50 2 38 0 24 0 0 0 6 2 228 0 0 0 0 255 255 0 79 255 244 2 9 3 51 2 38 0 24 0 0 0 6 2 230 0 0 0 0 255 255 0 79 255 244 2 9 3 45 2 38 0 24 0 0 0 6 2 238 0 0 0 0 255 255 0 79 255 244 2 9 3 18 2 38 0 24 0 0 0 6 2 232 0 0 0 0 255 255 0 79 255 244 2 9 3 50 2 38 0 24 0 0 0 6 2 234 0 0 0 0 255 255 0 79 255 244 2 9 3 107 2 38 0 24 0 0 0 6 2 242 0 0 0 0 255 255 0 79 255 244 2 9 3 50 2 38 0 24 0 0 0 6 2 244 0 0 0 0 255 255 0 79 255 244 2 9 3 50 2 38 0 24 0 0 0 6 2 246 0 0 0 0 255 255 0 79 255 244 2 9 3 139 2 38 0 24 0 0 0 6 3 6 0 0 0 0 255 255 0 79 255 244 2 9 3 182 2 38 0 24 0 0 0 6 3 8 0 0 0 0 255 255 0 79 255 244 2 9 3 182 2 38 0 24 0 0 0 6 3 10 0 0 0 0 255 255 0 79 255 244 2 9 3 182 2 38 0 24 0 0 0 6 3 12 0 0 0 0 255 255 0 79 255 30 2 9 2 144 2 38 0 24 0 0 0 6 2 252 0 0 0 0 255 255 0 79 255 244 2 9 3 104 2 38 0 24 0 0 0 6 2 240 0 0 0 0 0 1 0 79 255 44 2 9 2 144 0 42 0 82 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 13 62 89 184 0 0 69 88 184 0 13 47 27 185 0 13 0 13 62 89 184 0 0 69 88 184 0 39 47 27 185 0 39 0 3 62 89 187 0 24 0 1 0 31 0 4 43 184 0 39 16 185 0 7 0 1 244 184 0 39 16 184 0 18 208 48 49 19 51 17 20 30 2 51 50 62 2 53 17 51 17 20 6 7 14 1 21 20 22 51 50 54 55 23 14 1 35 34 38 53 52 62 2 55 46 1 53 79 84 21 36 50 30 30 51 37 22 81 69 55 53 48 29 18 12 19 10 22 14 45 20 40 56 13 20 23 9 110 107 2 144 254 102 51 71 43 20 20 43 71 51 1 154 254 104 102 116 25 24 61 27 23 23 7 7 45 11 17 44 43 21 33 28 23 9 2 132 125 0 0 1 0 79 255 244 2 118 3 25 0 40 0 74 0 184 0 0 69 88 184 0 20 47 27 185 0 20 0 13 62 89 184 0 0 69 88 184 0 33 47 27 185 0 33 0 13 62 89 184 0 0 69 88 184 0 14 47 27 185 0 14 0 3 62 89 184 0 33 16 185 0 8 0 1 244 184 0 14 16 185 0 27 0 1 244 48 49 1 30 1 21 20 14 2 7 17 20 14 2 35 34 46 2 53 17 51 17 20 30 2 51 50 62 2 53 17 51 62 1 53 52 38 39 2 95 11 12 18 30 39 22 33 58 81 48 48 82 59 33 84 21 37 50 30 30 50 38 21 35 40 48 8 7 3 25 14 32 19 25 36 26 16 5 254 140 71 98 63 28 28 63 98 71 1 152 254 102 51 71 43 20 20 43 71 51 1 154 5 27 35 11 20 10 0 0 255 255 0 79 255 244 2 118 3 50 2 38 0 208 0 0 0 6 2 226 0 0 0 0 255 255 0 79 255 244 2 118 3 50 2 38 0 208 0 0 0 6 2 224 0 0 0 0 255 255 0 79 255 244 2 118 3 104 2 38 0 208 0 0 0 6 2 240 0 0 0 0 255 255 0 79 255 244 2 118 3 51 2 38 0 208 0 0 0 6 2 230 0 0 0 0 255 255 0 79 255 30 2 118 3 25 2 38 0 208 0 0 0 6 2 252 0 0 0 0 255 255 0 10 0 0 2 78 3 50 2 38 0 26 0 0 0 6 2 224 0 0 0 0 255 255 0 10 0 0 2 78 3 50 2 38 0 26 0 0 0 6 2 226 0 0 0 0 255 255 0 10 0 0 2 78 3 50 2 38 0 26 0 0 0 6 2 228 0 0 0 0 255 255 0 10 0 0 2 78 3 45 2 38 0 26 0 0 0 6 2 238 0 0 0 0 255 255 0 38 0 0 2 50 3 50 2 38 0 28 0 0 0 6 2 224 0 0 0 0 255 255 0 38 0 0 2 50 3 50 2 38 0 28 0 0 0 6 2 226 0 0 0 0 255 255 0 38 0 0 2 50 3 50 2 38 0 28 0 0 0 6 2 228 0 0 0 0 255 255 0 38 0 0 2 50 3 45 2 38 0 28 0 0 0 6 2 238 0 0 0 0 255 255 0 38 0 0 2 50 3 53 2 38 0 28 0 0 0 6 2 236 0 0 0 0 255 255 0 38 255 30 2 50 2 144 2 38 0 28 0 0 0 6 2 252 0 0 0 0 255 255 0 38 0 0 2 50 3 104 2 38 0 28 0 0 0 6 2 240 0 0 0 0 255 255 0 38 0 0 2 50 3 51 2 38 0 28 0 0 0 6 2 230 0 0 0 0 255 255 0 65 0 0 2 27 3 50 2 38 0 29 0 0 0 6 2 226 15 0 0 0 255 255 0 65 0 0 2 27 3 50 2 38 0 29 0 0 0 6 2 246 15 0 0 0 255 255 0 65 0 0 2 27 3 53 2 38 0 29 0 0 0 6 2 236 15 0 0 0 255 255 0 65 255 30 2 27 2 145 2 38 0 29 0 0 0 6 2 252 11 0 0 0 0 2 0 16 0 0 2 43 2 144 0 12 0 25 0 83 0 184 0 0 69 88 184 0 4 47 27 185 0 4 0 13 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 3 62 89 187 0 3 0 1 0 0 0 4 43 184 0 11 16 185 0 13 0 1 244 184 0 4 16 185 0 19 0 1 244 184 0 3 16 184 0 21 208 184 0 0 16 184 0 23 208 48 49 19 35 53 55 17 51 50 22 21 20 6 43 1 55 50 54 53 52 38 43 1 21 51 21 35 21 91 75 75 161 148 155 155 145 164 155 112 111 111 112 72 143 143 1 65 42 5 1 32 168 157 157 174 68 138 125 125 132 220 47 253 0 2 0 101 0 0 2 33 2 144 0 16 0 25 0 57 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 13 62 89 184 0 0 69 88 184 0 15 47 27 185 0 15 0 3 62 89 187 0 17 0 1 0 13 0 4 43 187 0 3 0 1 0 23 0 4 43 48 49 19 51 21 51 50 30 2 21 20 14 2 43 1 21 35 55 50 54 53 52 38 43 1 17 101 84 118 54 90 63 35 35 64 89 54 118 84 191 87 83 85 85 107 2 144 110 20 46 73 54 52 77 50 24 150 218 64 71 71 54 254 252 0 0 2 0 62 255 244 2 38 2 156 0 6 0 35 0 67 0 184 0 0 69 88 184 0 10 47 27 185 0 10 0 13 62 89 184 0 0 69 88 184 0 20 47 27 185 0 20 0 3 62 89 187 0 29 0 1 0 6 0 4 43 184 0 20 16 185 0 3 0 1 244 184 0 10 16 185 0 32 0 1 244 48 49 19 30 1 51 50 54 55 1 62 1 51 50 30 2 21 20 14 2 35 34 46 2 53 52 54 55 33 46 1 35 34 6 7 147 7 82 66 68 87 8 254 178 31 86 58 57 90 63 34 36 65 92 55 55 89 62 34 1 1 1 147 3 84 80 41 65 25 1 27 106 118 120 105 1 55 32 41 47 87 125 79 79 126 89 48 48 89 124 76 5 12 5 118 132 33 26 0 255 255 0 81 255 244 2 3 2 209 2 38 0 30 0 0 0 6 2 223 14 0 0 0 255 255 0 81 255 244 2 3 2 209 2 38 0 30 0 0 0 6 2 225 14 0 0 0 255 255 0 81 255 244 2 3 2 209 2 38 0 30 0 0 0 6 2 227 14 0 0 0 255 255 0 81 255 244 2 3 2 176 2 38 0 30 0 0 0 6 2 229 14 0 0 0 255 255 0 81 255 244 2 3 2 186 2 38 0 30 0 0 0 6 2 237 14 0 0 0 255 255 0 81 255 244 2 3 2 146 2 38 0 30 0 0 0 6 2 231 14 0 0 0 255 255 0 81 255 244 2 3 2 197 2 38 0 30 0 0 0 6 2 233 14 0 0 0 255 255 0 81 255 244 2 3 2 215 2 38 0 30 0 0 0 6 2 241 14 0 0 0 255 255 0 81 255 244 2 3 2 209 2 38 0 30 0 0 0 6 2 245 14 0 0 0 255 255 0 81 255 30 2 3 1 242 2 38 0 30 0 0 0 6 2 252 3 0 0 0 255 255 0 81 255 244 2 3 2 215 2 38 0 30 0 0 0 6 2 239 14 0 0 0 255 255 0 81 255 244 2 34 2 242 2 38 0 30 0 0 0 6 3 13 14 0 0 0 255 255 0 81 255 244 2 3 2 242 2 38 0 30 0 0 0 6 3 15 14 0 0 0 255 255 0 81 255 244 2 11 3 16 2 38 0 30 0 0 0 6 3 17 14 0 0 0 255 255 0 81 255 244 2 3 3 34 2 38 0 30 0 0 0 6 3 19 14 0 0 0 255 255 0 81 255 30 2 3 2 209 2 38 0 30 0 0 0 38 2 227 14 0 0 6 2 252 3 0 255 255 0 81 255 244 2 3 3 21 2 38 0 30 0 0 0 6 3 21 14 0 0 0 255 255 0 81 255 244 2 3 3 21 2 38 0 30 0 0 0 6 3 23 14 0 0 0 255 255 0 81 255 244 2 3 3 71 2 38 0 30 0 0 0 6 3 25 14 0 0 0 255 255 0 81 255 244 2 3 3 34 2 38 0 30 0 0 0 6 3 27 14 0 0 0 255 255 0 81 255 30 2 3 2 197 2 38 0 30 0 0 0 38 2 233 14 0 0 6 2 252 3 0 0 2 0 81 255 50 2 25 1 242 0 52 0 66 0 133 0 184 0 0 69 88 184 0 19 47 27 185 0 19 0 7 62 89 184 0 0 69 88 184 0 48 47 27 185 0 48 0 3 62 89 184 0 0 69 88 184 0 23 47 27 185 0 23 0 3 62 89 184 0 0 69 88 184 0 35 47 27 185 0 35 0 5 62 89 186 0 5 0 19 0 48 17 18 57 184 0 5 47 184 0 19 16 185 0 10 0 1 244 184 0 35 16 185 0 29 0 1 244 184 0 23 16 184 0 43 208 184 0 48 16 185 0 58 0 1 244 184 0 5 16 185 0 62 0 1 244 48 49 55 52 62 2 55 46 3 35 34 6 7 39 62 3 51 50 22 21 17 14 1 21 20 22 51 50 55 23 14 1 35 34 38 53 52 62 2 55 39 35 14 1 35 34 46 2 55 20 30 2 51 50 54 55 53 14 3 81 39 85 134 94 1 14 30 49 35 48 88 34 32 18 49 55 62 32 100 97 42 44 28 18 22 18 22 14 46 19 38 52 14 23 28 15 7 3 41 99 52 34 60 45 26 80 18 29 39 21 42 81 42 78 105 63 26 126 41 61 44 28 8 25 44 33 20 37 21 56 12 25 20 13 109 91 254 214 17 59 29 23 23 13 41 11 16 43 42 20 37 32 27 9 62 32 46 19 35 51 39 21 29 19 9 37 35 128 6 22 31 39 0 0 3 0 17 255 244 2 85 1 242 0 46 0 55 0 68 0 165 0 184 0 0 69 88 184 0 13 47 27 185 0 13 0 7 62 89 184 0 0 69 88 184 0 19 47 27 185 0 19 0 7 62 89 184 0 0 69 88 184 0 38 47 27 185 0 38 0 3 62 89 184 0 0 69 88 184 0 44 47 27 185 0 44 0 3 62 89 187 0 47 0 1 0 27 0 4 43 186 0 3 0 13 0 44 17 18 57 184 0 3 47 184 0 13 16 185 0 6 0 1 244 186 0 16 0 38 0 13 17 18 57 184 0 38 16 185 0 31 0 1 244 186 0 41 0 38 0 13 17 18 57 184 0 19 16 185 0 52 0 1 244 184 0 44 16 185 0 59 0 1 244 184 0 3 16 185 0 66 0 1 244 48 49 55 52 54 55 46 1 35 34 6 7 39 62 1 51 50 22 23 62 1 51 50 30 2 21 20 6 7 33 30 1 51 50 54 55 23 14 1 35 34 38 39 14 1 35 34 38 37 52 46 2 35 34 6 15 1 20 22 51 50 54 55 46 1 47 1 14 1 17 124 124 1 39 47 26 65 23 31 30 80 45 48 59 14 24 69 48 37 55 37 18 2 2 254 254 3 60 59 28 47 21 29 25 65 38 53 72 24 41 79 38 60 70 1 255 8 20 33 24 47 57 5 241 40 34 26 62 26 8 7 1 1 92 79 129 73 87 19 54 69 25 16 56 20 32 56 42 47 51 36 61 80 45 14 26 13 76 93 18 13 54 17 26 48 43 45 46 75 215 31 56 43 25 82 73 145 39 40 36 35 22 53 29 25 16 58 0 2 0 20 255 244 2 28 2 200 0 12 0 43 0 165 0 184 0 0 69 88 184 0 16 47 27 185 0 16 0 7 62 89 184 0 0 69 88 184 0 37 47 27 185 0 37 0 15 62 89 184 0 0 69 88 184 0 32 47 27 185 0 32 0 3 62 89 184 0 0 69 88 184 0 26 47 27 185 0 26 0 3 62 89 187 0 33 0 1 0 36 0 4 43 186 0 29 0 26 0 16 17 18 57 184 0 29 16 185 0 0 0 1 244 184 0 26 16 185 0 3 0 1 244 184 0 16 16 185 0 9 0 1 244 186 0 13 0 16 0 26 17 18 57 184 0 13 16 185 0 12 0 1 244 184 0 36 16 184 0 35 208 184 0 36 16 184 0 40 208 184 0 33 16 184 0 41 208 48 49 55 30 1 51 50 54 53 52 38 35 34 6 7 39 62 1 51 50 30 2 21 20 14 2 35 34 38 39 35 7 35 17 35 53 55 53 51 21 51 21 35 21 175 35 71 26 64 84 64 73 32 73 38 2 35 87 43 49 76 51 26 36 61 80 43 35 81 35 3 7 66 73 73 82 212 212 114 31 26 97 86 76 93 35 38 68 34 40 34 61 88 54 60 94 65 34 35 31 54 2 59 43 5 93 93 48 73 255 255 0 80 255 43 2 27 1 242 2 38 0 32 0 0 0 6 2 255 42 0 0 0 255 255 0 80 255 244 2 27 2 209 2 38 0 32 0 0 0 6 2 225 43 0 0 0 255 255 0 80 255 244 2 27 2 209 2 38 0 32 0 0 0 6 2 227 43 0 0 0 255 255 0 80 255 244 2 27 2 209 2 38 0 32 0 0 0 6 2 245 43 0 0 0 255 255 0 80 255 244 2 27 2 201 2 38 0 32 0 0 0 6 2 235 43 0 0 0 255 255 0 51 255 244 2 84 2 248 2 38 0 33 247 0 0 7 3 31 1 19 0 0 255 255 0 60 255 30 1 251 2 200 2 38 0 33 0 0 0 6 2 252 6 0 0 0 255 255 0 60 255 85 1 251 2 200 2 38 0 33 0 0 0 6 3 4 6 0 0 0 0 2 0 60 255 244 2 67 2 200 0 13 0 44 0 165 0 184 0 0 69 88 184 0 32 47 27 185 0 32 0 7 62 89 184 0 0 69 88 184 0 41 47 27 185 0 41 0 15 62 89 184 0 0 69 88 184 0 16 47 27 185 0 16 0 3 62 89 184 0 0 69 88 184 0 22 47 27 185 0 22 0 3 62 89 187 0 15 0 1 0 43 0 4 43 186 0 35 0 32 0 22 17 18 57 184 0 35 16 185 0 0 0 1 244 184 0 32 16 185 0 3 0 1 244 184 0 22 16 185 0 11 0 1 244 186 0 18 0 22 0 32 17 18 57 184 0 18 16 185 0 13 0 1 244 184 0 15 16 184 0 14 208 184 0 15 16 184 0 38 208 184 0 43 16 184 0 39 208 48 49 1 46 1 35 34 14 2 21 20 22 51 50 55 19 7 17 35 39 35 14 1 35 34 46 2 53 52 62 2 51 50 22 23 39 53 35 53 51 53 51 21 51 1 169 33 63 31 32 56 41 24 75 68 72 65 154 72 68 7 3 30 83 45 48 77 56 30 37 61 80 43 45 68 34 3 174 174 82 72 1 96 31 26 26 46 65 39 83 93 73 1 190 5 253 197 64 31 45 32 63 90 59 57 91 64 34 34 29 90 66 48 93 93 0 0 255 255 0 69 255 244 2 25 2 209 2 38 0 34 0 0 0 6 2 223 15 0 0 0 255 255 0 69 255 244 2 25 2 209 2 38 0 34 0 0 0 6 2 225 15 0 0 0 255 255 0 69 255 244 2 25 2 209 2 38 0 34 0 0 0 6 2 227 15 0 0 0 255 255 0 69 255 244 2 25 2 209 2 38 0 34 0 0 0 6 2 245 15 0 0 0 255 255 0 69 255 244 2 25 2 186 2 38 0 34 0 0 0 6 2 237 15 0 0 0 255 255 0 69 255 244 2 25 2 146 2 38 0 34 0 0 0 6 2 231 15 0 0 0 255 255 0 69 255 244 2 25 2 197 2 38 0 34 0 0 0 6 2 233 15 0 0 0 255 255 0 69 255 244 2 25 2 201 2 38 0 34 0 0 0 6 2 235 15 0 0 0 255 255 0 69 255 30 2 25 1 242 2 38 0 34 0 0 0 6 2 252 15 0 0 0 255 255 0 69 255 244 2 25 2 215 2 38 0 34 0 0 0 6 2 239 15 0 0 0 255 255 0 69 255 244 2 25 2 176 2 38 0 34 0 0 0 6 2 229 15 0 0 0 255 255 0 69 255 244 2 35 2 242 2 38 0 34 0 0 0 6 3 13 15 0 0 0 255 255 0 69 255 244 2 25 2 242 2 38 0 34 0 0 0 6 3 15 15 0 0 0 255 255 0 69 255 244 2 25 3 16 2 38 0 34 0 0 0 6 3 17 15 0 0 0 255 255 0 69 255 244 2 25 3 34 2 38 0 34 0 0 0 6 3 19 15 0 0 0 255 255 0 69 255 30 2 25 2 209 2 38 0 34 0 0 0 38 2 227 15 0 0 6 2 252 15 0 0 2 0 69 255 50 2 25 1 242 0 53 0 62 0 94 0 184 0 0 69 88 184 0 36 47 27 185 0 36 0 7 62 89 184 0 0 69 88 184 0 26 47 27 185 0 26 0 3 62 89 184 0 0 69 88 184 0 15 47 27 185 0 15 0 5 62 89 187 0 62 0 1 0 44 0 4 43 184 0 15 16 185 0 8 0 1 244 184 0 26 16 185 0 50 0 1 244 184 0 36 16 185 0 57 0 1 244 48 49 37 14 3 21 20 22 51 50 54 55 23 14 1 35 34 38 53 52 62 2 55 14 1 35 34 46 2 53 52 62 2 51 50 30 2 21 20 6 7 33 30 3 51 50 54 55 39 52 38 35 34 14 2 7 2 5 34 45 27 11 28 19 11 19 10 21 14 45 19 38 52 12 20 23 11 22 34 20 54 95 71 41 42 69 89 47 52 82 57 30 1 2 254 132 1 29 49 67 40 43 71 34 27 76 68 30 55 44 30 5 45 24 41 36 33 16 23 23 7 6 41 11 16 43 42 19 36 32 25 9 8 4 35 65 94 60 60 95 66 35 33 60 84 51 13 25 9 39 62 44 24 24 21 183 73 78 20 39 56 36 0 0 255 255 0 72 255 32 2 54 2 209 2 38 0 36 0 0 0 6 2 227 7 0 0 0 255 255 0 72 255 32 2 54 2 197 2 38 0 36 0 0 0 6 2 233 7 0 0 0 255 255 0 72 255 32 2 54 2 201 2 38 0 36 0 0 0 6 2 235 7 0 0 0 255 255 0 72 255 32 2 54 2 198 2 38 0 36 0 0 0 6 3 32 7 0 0 0 255 255 0 72 255 32 2 54 2 209 2 38 0 36 0 0 0 6 2 245 7 0 0 0 255 255 0 72 255 32 2 54 2 146 2 38 0 36 0 0 0 6 2 231 7 0 0 0 255 255 0 72 255 32 2 54 2 176 2 38 0 36 0 0 0 6 2 229 7 0 0 0 255 255 0 10 0 0 2 11 3 92 2 38 0 37 0 0 0 7 2 228 255 102 0 42 255 255 0 93 255 30 2 11 2 200 2 38 0 37 0 0 0 6 2 252 14 0 0 0 255 255 0 93 255 50 2 11 2 200 2 38 0 37 0 0 0 6 3 3 13 0 0 0 0 1 0 20 0 0 2 11 2 200 0 30 0 135 0 184 0 0 69 88 184 0 3 47 27 185 0 3 0 7 62 89 184 0 0 69 88 184 0 24 47 27 185 0 24 0 15 62 89 184 0 0 69 88 184 0 19 47 27 185 0 19 0 3 62 89 184 0 0 69 88 184 0 8 47 27 185 0 8 0 3 62 89 187 0 20 0 1 0 23 0 4 43 186 0 0 0 3 0 19 17 18 57 184 0 3 16 185 0 12 0 1 244 184 0 0 16 185 0 17 0 1 244 184 0 23 16 184 0 22 208 184 0 23 16 184 0 27 208 184 0 20 16 184 0 28 208 48 49 19 62 1 51 50 22 21 17 35 17 52 38 35 34 14 2 7 17 35 17 35 53 55 53 51 21 51 21 35 21 171 39 88 57 87 81 82 52 60 22 37 36 38 21 82 73 73 82 212 212 1 127 41 54 99 97 254 230 1 15 69 67 11 22 33 22 254 193 2 59 43 5 93 93 48 73 0 0 0 255 255 0 90 0 0 1 157 2 209 2 38 1 50 0 0 0 6 2 223 48 0 0 0 255 255 0 90 0 0 1 207 2 209 2 38 1 50 0 0 0 6 2 225 48 0 0 0 255 255 0 90 0 0 1 224 2 209 2 38 1 50 0 0 0 6 2 227 48 0 0 0 255 255 0 90 0 0 1 234 2 176 2 38 1 50 0 0 0 6 2 229 48 0 0 0 255 255 0 90 0 0 1 242 2 186 2 38 1 50 0 0 0 6 2 237 48 0 0 0 255 255 0 90 0 0 1 215 2 146 2 38 1 50 0 0 0 6 2 231 48 0 0 0 255 255 0 90 0 0 1 222 2 197 2 38 1 50 0 0 0 6 2 233 48 0 0 0 255 255 0 90 0 0 1 224 2 209 2 38 1 50 0 0 0 6 2 245 48 0 0 0 255 255 0 90 0 0 1 175 2 215 2 38 1 50 0 0 0 6 2 239 48 0 0 0 255 255 0 90 255 30 1 158 2 201 2 38 0 38 0 0 0 6 2 252 48 0 0 0 0 2 0 90 255 50 1 185 2 201 0 26 0 38 0 103 0 184 0 0 69 88 184 0 2 47 27 185 0 2 0 7 62 89 184 0 0 69 88 184 0 4 47 27 185 0 4 0 3 62 89 184 0 0 69 88 184 0 25 47 27 185 0 25 0 3 62 89 184 0 0 69 88 184 0 17 47 27 185 0 17 0 5 62 89 184 0 2 16 185 0 0 0 1 244 184 0 17 16 185 0 10 0 1 244 184 0 2 16 184 0 27 220 184 0 33 220 48 49 1 35 53 33 17 14 1 21 20 22 51 50 54 55 23 14 1 35 34 38 53 52 62 2 55 35 19 34 38 53 52 54 51 50 22 21 20 6 1 60 226 1 52 30 35 28 19 11 19 10 21 14 45 19 38 53 12 19 22 10 19 32 29 37 37 29 28 38 38 1 163 67 254 26 22 54 29 23 23 7 6 41 11 16 43 42 20 35 30 25 11 2 74 34 29 29 35 35 29 29 34 0 1 0 90 255 50 1 185 1 230 0 26 0 91 0 184 0 0 69 88 184 0 2 47 27 185 0 2 0 7 62 89 184 0 0 69 88 184 0 4 47 27 185 0 4 0 3 62 89 184 0 0 69 88 184 0 25 47 27 185 0 25 0 3 62 89 184 0 0 69 88 184 0 17 47 27 185 0 17 0 5 62 89 184 0 2 16 185 0 0 0 1 244 184 0 17 16 185 0 10 0 1 244 48 49 1 35 53 33 17 14 1 21 20 22 51 50 54 55 23 14 1 35 34 38 53 52 62 2 55 35 1 60 226 1 52 30 35 28 19 11 19 10 21 14 45 19 38 53 12 19 22 10 19 1 163 67 254 26 22 54 29 23 23 7 6 41 11 16 43 42 20 35 30 25 11 0 1 0 90 0 0 1 142 1 230 0 5 0 47 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 7 62 89 184 0 0 69 88 184 0 2 47 27 185 0 2 0 3 62 89 184 0 0 16 185 0 4 0 1 244 48 49 19 33 17 35 17 35 90 1 52 82 226 1 230 254 26 1 163 0 0 255 255 0 55 255 39 1 224 2 209 2 38 1 157 0 0 0 6 2 227 48 0 0 0 255 255 0 106 255 40 2 62 2 200 2 38 0 40 0 0 0 6 2 254 35 0 0 0 0 1 0 106 0 0 2 62 1 230 0 12 0 109 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 7 62 89 184 0 0 69 88 184 0 4 47 27 185 0 4 0 7 62 89 184 0 0 69 88 184 0 7 47 27 185 0 7 0 3 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 3 62 89 186 0 2 0 11 0 0 17 18 57 186 0 9 0 11 0 0 17 18 57 184 0 9 16 184 0 6 208 184 0 2 16 185 0 10 0 1 244 48 49 19 51 17 55 37 51 7 19 35 39 7 21 35 106 82 3 1 7 94 194 220 92 179 115 82 1 230 255 0 1 255 193 254 219 240 110 130 255 255 0 81 255 244 2 25 3 102 2 38 0 41 0 0 0 6 2 226 233 52 0 0 255 255 0 81 255 244 2 25 2 248 2 38 0 41 0 0 0 7 3 31 0 136 0 0 255 255 0 43 255 244 1 247 2 200 2 38 0 41 218 0 0 7 2 235 0 137 254 210 255 255 0 81 255 40 2 25 2 200 2 38 0 41 0 0 0 6 2 254 71 0 0 0 255 255 0 81 255 30 2 25 2 200 2 38 0 41 0 0 0 6 2 252 71 0 0 0 255 255 0 81 255 30 2 25 3 112 2 38 0 41 0 0 0 39 2 231 255 241 0 222 0 6 2 252 71 0 0 0 255 255 0 81 255 85 2 25 2 200 2 38 0 41 0 0 0 6 3 4 71 0 0 0 0 1 0 81 255 244 2 25 2 200 0 24 0 87 0 184 0 0 69 88 184 0 13 47 27 185 0 13 0 15 62 89 184 0 0 69 88 184 0 3 47 27 185 0 3 0 3 62 89 186 0 7 0 3 0 13 17 18 57 184 0 7 16 184 0 10 208 184 0 13 16 185 0 11 0 1 244 184 0 7 16 184 0 18 208 184 0 15 208 184 0 3 16 185 0 22 0 1 244 48 49 37 14 1 35 34 38 61 1 7 53 55 53 35 53 51 17 55 21 7 21 20 22 51 50 55 2 25 33 58 40 78 81 124 124 166 248 163 163 51 44 40 52 17 12 17 88 87 169 71 70 71 243 67 254 245 91 71 91 217 54 47 23 0 255 255 0 60 255 30 2 44 1 242 2 38 0 42 0 0 0 6 2 252 5 0 0 0 255 255 0 93 0 0 2 11 2 209 2 38 0 43 0 0 0 6 2 225 18 0 0 0 255 255 0 93 0 0 2 11 2 209 2 38 0 43 0 0 0 6 2 245 18 0 0 0 255 255 0 93 0 0 2 11 2 176 2 38 0 43 0 0 0 6 2 229 18 0 0 0 255 255 0 93 255 40 2 11 1 242 2 38 0 43 0 0 0 6 2 254 13 0 0 0 255 255 0 93 0 0 2 11 2 201 2 38 0 43 0 0 0 6 2 235 18 0 0 0 255 255 0 93 255 30 2 11 1 242 2 38 0 43 0 0 0 6 2 252 13 0 0 0 255 255 0 93 255 85 2 11 1 242 2 38 0 43 0 0 0 6 3 4 13 0 0 0 0 2 255 234 0 0 2 86 2 187 0 17 0 38 0 109 0 184 0 0 69 88 184 0 21 47 27 185 0 21 0 7 62 89 184 0 0 69 88 184 0 36 47 27 185 0 36 0 7 62 89 184 0 0 69 88 184 0 35 47 27 185 0 35 0 3 62 89 184 0 0 69 88 184 0 26 47 27 185 0 26 0 3 62 89 186 0 11 0 5 0 3 43 184 0 21 16 185 0 30 0 1 244 186 0 38 0 21 0 35 17 18 57 184 0 38 16 185 0 33 0 1 244 48 49 3 62 1 55 6 35 34 38 53 52 54 51 50 22 21 20 6 7 37 62 1 51 50 22 21 17 35 17 52 38 35 34 6 7 17 35 17 51 23 22 48 53 3 12 14 32 39 42 32 40 50 76 67 1 13 35 80 53 79 76 83 46 52 39 61 39 82 68 7 1 142 26 79 53 6 39 32 35 43 64 57 75 118 35 60 37 51 96 94 254 204 1 41 66 64 41 40 254 166 1 230 76 0 255 255 0 60 255 244 2 28 2 209 2 38 0 44 0 0 0 6 2 223 0 0 0 0 255 255 0 60 255 244 2 28 2 209 2 38 0 44 0 0 0 6 2 225 0 0 0 0 255 255 0 60 255 244 2 28 2 209 2 38 0 44 0 0 0 6 2 227 0 0 0 0 255 255 0 60 255 244 2 28 2 176 2 38 0 44 0 0 0 6 2 229 0 0 0 0 255 255 0 60 255 244 2 28 2 186 2 38 0 44 0 0 0 6 2 237 0 0 0 0 255 255 0 60 255 244 2 28 2 146 2 38 0 44 0 0 0 6 2 231 0 0 0 0 255 255 0 60 255 244 2 28 2 197 2 38 0 44 0 0 0 6 2 233 0 0 0 0 255 255 0 60 255 244 2 28 2 202 2 38 0 44 0 0 0 6 2 243 0 0 0 0 255 255 0 60 255 244 2 28 2 209 2 38 0 44 0 0 0 6 2 245 0 0 0 0 255 255 0 60 255 30 2 28 1 242 2 38 0 44 0 0 0 6 2 252 1 0 0 0 255 255 0 60 255 244 2 28 2 215 2 38 0 44 0 0 0 6 2 239 0 0 0 0 255 255 0 60 255 244 2 28 2 242 2 38 0 44 0 0 0 6 3 13 0 0 0 0 255 255 0 60 255 244 2 28 2 242 2 38 0 44 0 0 0 6 3 15 0 0 0 0 255 255 0 60 255 244 2 28 3 16 2 38 0 44 0 0 0 6 3 17 0 0 0 0 255 255 0 60 255 244 2 28 3 34 2 38 0 44 0 0 0 6 3 19 0 0 0 0 255 255 0 60 255 30 2 28 2 209 2 38 0 44 0 0 0 38 2 227 0 0 0 6 2 252 0 0 0 3 0 60 255 233 2 28 1 253 0 10 0 22 0 48 0 125 0 184 0 0 69 88 184 0 44 47 27 185 0 44 0 7 62 89 184 0 0 69 88 184 0 31 47 27 185 0 31 0 3 62 89 186 0 22 0 31 0 44 17 18 57 184 0 22 16 184 0 0 208 184 0 31 16 185 0 2 0 1 244 186 0 10 0 44 0 31 17 18 57 184 0 10 16 184 0 11 208 184 0 44 16 185 0 14 0 1 244 184 0 10 16 184 0 23 208 184 0 0 16 184 0 33 208 184 0 22 16 184 0 36 208 184 0 11 16 184 0 46 208 48 49 55 22 51 50 62 2 53 52 38 47 1 46 1 35 34 14 2 21 20 22 23 1 30 1 21 20 14 2 35 34 39 7 39 55 46 1 53 52 62 2 51 50 23 55 23 201 41 58 35 57 41 22 14 13 30 19 50 29 35 57 41 22 14 13 1 53 27 32 39 66 87 48 83 63 51 37 53 27 32 39 66 87 48 83 63 51 37 92 38 28 49 69 42 33 58 23 38 18 20 28 50 70 42 33 56 23 1 32 32 89 55 60 95 65 34 48 59 29 62 32 88 54 61 95 66 34 48 59 29 0 3 0 11 255 244 2 84 1 242 0 19 0 59 0 68 0 141 0 184 0 0 69 88 184 0 25 47 27 185 0 25 0 7 62 89 184 0 0 69 88 184 0 31 47 27 185 0 31 0 7 62 89 184 0 0 69 88 184 0 50 47 27 185 0 50 0 3 62 89 184 0 0 69 88 184 0 55 47 27 185 0 55 0 3 62 89 187 0 60 0 1 0 39 0 4 43 184 0 55 16 185 0 5 0 1 244 184 0 25 16 185 0 15 0 1 244 186 0 28 0 50 0 25 17 18 57 184 0 50 16 185 0 43 0 1 244 186 0 53 0 50 0 25 17 18 57 184 0 31 16 185 0 65 0 1 244 48 49 55 20 30 2 51 50 62 2 53 52 46 2 35 34 14 2 7 52 62 2 51 50 22 23 62 1 51 50 30 2 21 20 6 7 35 30 1 51 50 54 55 23 14 1 35 34 38 39 6 35 34 46 2 37 52 46 2 35 34 6 7 88 13 26 38 26 22 37 26 14 14 26 37 22 26 38 26 13 77 27 48 64 37 47 69 20 20 65 48 34 53 35 18 1 2 241 4 58 54 26 39 20 29 23 59 35 48 72 22 43 93 38 64 47 27 2 5 8 18 30 22 45 48 6 243 42 69 49 28 28 49 69 42 42 68 50 27 27 50 68 42 61 95 65 34 61 56 55 62 36 60 81 45 14 23 16 76 93 17 14 54 17 26 57 55 112 34 65 95 96 31 56 43 25 83 72 0 0 2 0 60 255 244 2 44 2 101 0 19 0 52 0 71 0 184 0 0 69 88 184 0 44 47 27 185 0 44 0 7 62 89 184 0 0 69 88 184 0 34 47 27 185 0 34 0 3 62 89 185 0 0 0 1 244 184 0 44 16 185 0 10 0 1 244 186 0 26 0 34 0 44 17 18 57 184 0 26 16 184 0 46 208 48 49 37 50 62 2 53 52 46 2 35 34 14 2 21 20 30 2 1 30 1 21 20 6 7 30 1 21 20 14 2 35 34 46 2 53 52 62 2 51 50 23 62 1 53 52 38 39 1 44 35 57 41 22 22 41 57 35 35 57 41 22 22 41 57 1 11 11 13 56 44 38 46 39 66 87 48 48 87 66 39 39 66 87 48 54 49 44 41 8 7 56 27 49 68 42 42 69 50 27 27 50 69 42 42 68 49 27 2 45 14 32 19 44 50 11 33 101 67 60 95 65 34 34 65 95 60 61 95 66 34 22 6 31 29 11 21 10 0 255 255 0 60 255 244 2 44 2 209 2 38 1 89 0 0 0 6 2 225 0 0 0 0 255 255 0 60 255 244 2 44 2 209 2 38 1 89 0 0 0 6 2 223 0 0 0 0 255 255 0 60 255 244 2 44 2 215 2 38 1 89 0 0 0 6 2 239 0 0 0 0 255 255 0 60 255 244 2 44 2 176 2 38 1 89 0 0 0 6 2 229 0 0 0 0 255 255 0 60 255 30 2 44 2 101 2 38 1 89 0 0 0 6 2 252 1 0 0 0 0 2 0 60 255 50 2 28 1 242 0 40 0 60 0 92 0 184 0 0 69 88 184 0 15 47 27 185 0 15 0 7 62 89 184 0 0 69 88 184 0 5 47 27 185 0 5 0 3 62 89 184 0 0 69 88 184 0 38 47 27 185 0 38 0 5 62 89 184 0 5 16 184 0 25 208 184 0 38 16 185 0 31 0 1 244 184 0 5 16 185 0 46 0 1 244 184 0 15 16 185 0 56 0 1 244 48 49 23 52 62 2 55 46 3 53 52 62 2 51 50 30 2 21 20 14 2 7 14 1 21 20 22 51 50 54 55 23 14 1 35 34 38 3 20 30 2 51 50 62 2 53 52 46 2 35 34 14 2 234 11 16 20 8 47 84 62 36 39 66 87 48 48 87 66 39 25 45 64 40 35 36 28 18 12 19 9 22 14 46 19 38 52 89 22 41 57 35 35 57 41 22 22 41 57 35 35 57 41 22 121 19 33 29 22 7 2 36 65 92 58 61 95 66 34 34 66 95 61 51 77 59 43 16 16 56 29 23 23 7 6 41 11 16 43 1 149 42 68 49 27 27 49 68 42 42 69 50 27 27 50 69 0 0 255 255 0 146 0 0 2 25 2 209 2 38 0 47 0 0 0 6 2 225 42 0 0 0 255 255 0 116 255 40 2 25 1 242 2 38 0 47 0 0 0 6 2 254 157 0 0 0 255 255 0 146 0 0 2 25 2 209 2 38 0 47 0 0 0 6 2 245 42 0 0 0 255 255 0 135 255 30 2 25 1 242 2 38 0 47 0 0 0 6 2 252 157 0 0 0 255 255 0 135 255 30 2 25 2 146 2 38 0 47 0 0 0 38 2 231 42 0 0 6 2 252 157 0 255 255 0 77 255 85 2 25 1 242 2 38 0 47 0 0 0 6 3 4 157 0 0 0 255 255 0 72 255 244 2 14 2 209 2 38 0 48 0 0 0 6 2 225 3 0 0 0 255 255 0 72 255 244 2 14 2 209 2 38 0 48 0 0 0 6 2 227 3 0 0 0 255 255 0 72 255 244 2 14 2 209 2 38 0 48 0 0 0 6 2 245 3 0 0 0 255 255 0 72 255 43 2 14 1 242 2 38 0 48 0 0 0 6 2 255 14 0 0 0 255 255 0 72 255 40 2 14 1 242 2 38 0 48 0 0 0 6 2 254 10 0 0 0 255 255 0 72 255 244 2 14 2 201 2 38 0 48 0 0 0 6 2 235 3 0 0 0 255 255 0 72 255 30 2 14 1 242 2 38 0 48 0 0 0 6 2 252 10 0 0 0 0 1 0 88 255 244 2 52 2 212 0 57 0 90 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 15 62 89 184 0 0 69 88 184 0 57 47 27 185 0 57 0 3 62 89 184 0 0 69 88 184 0 27 47 27 185 0 27 0 3 62 89 185 0 34 0 1 244 186 0 15 0 5 0 34 17 18 57 184 0 5 16 185 0 52 0 1 244 186 0 37 0 27 0 52 17 18 57 48 49 19 52 62 2 51 50 30 2 21 20 14 2 21 20 30 4 21 20 14 2 35 34 38 39 55 30 1 51 50 54 53 52 46 4 53 52 62 2 53 52 38 35 34 6 21 17 35 88 28 52 74 47 40 61 42 21 28 34 28 30 44 53 44 30 23 43 60 37 42 70 32 33 28 52 29 42 45 30 45 52 45 30 28 34 28 44 42 55 63 82 2 7 46 76 54 29 24 41 53 30 38 53 44 41 26 24 32 27 26 36 53 39 32 54 40 23 24 21 58 20 19 47 31 29 38 29 25 33 45 35 34 49 45 47 32 37 49 75 75 254 5 0 0 0 255 255 0 69 255 244 2 34 2 248 2 38 0 49 0 0 0 7 3 31 0 130 0 0 255 255 0 69 255 43 2 34 2 110 2 38 0 49 0 0 0 6 2 255 76 0 0 0 255 255 0 69 255 40 2 34 2 110 2 38 0 49 0 0 0 6 2 254 79 0 0 0 255 255 0 69 255 30 2 34 2 110 2 38 0 49 0 0 0 6 2 252 79 0 0 0 255 255 0 69 255 85 2 34 2 110 2 38 0 49 0 0 0 6 3 4 79 0 0 0 255 255 0 69 255 244 2 34 3 64 2 38 0 49 0 0 0 7 2 237 255 220 0 134 255 255 0 77 255 244 1 249 2 209 2 38 0 50 0 0 0 6 2 223 252 0 0 0 255 255 0 77 255 244 1 249 2 209 2 38 0 50 0 0 0 6 2 225 252 0 0 0 255 255 0 77 255 244 1 249 2 209 2 38 0 50 0 0 0 6 2 227 252 0 0 0 255 255 0 77 255 244 1 249 2 176 2 38 0 50 0 0 0 6 2 229 252 0 0 0 255 255 0 77 255 244 1 249 2 186 2 38 0 50 0 0 0 6 2 237 252 0 0 0 255 255 0 77 255 244 1 249 2 146 2 38 0 50 0 0 0 6 2 231 252 0 0 0 255 255 0 77 255 244 1 249 2 197 2 38 0 50 0 0 0 6 2 233 252 0 0 0 255 255 0 77 255 244 1 249 2 215 2 38 0 50 0 0 0 6 2 241 252 0 0 0 255 255 0 77 255 244 1 249 2 202 2 38 0 50 0 0 0 6 2 243 252 0 0 0 255 255 0 77 255 244 1 249 2 209 2 38 0 50 0 0 0 6 2 245 252 0 0 0 255 255 0 77 255 244 1 249 3 29 2 38 0 50 0 0 0 6 3 5 252 0 0 0 255 255 0 77 255 244 1 249 3 55 2 38 0 50 0 0 0 6 3 7 252 0 0 0 255 255 0 77 255 244 1 249 3 55 2 38 0 50 0 0 0 6 3 9 252 0 0 0 255 255 0 77 255 244 1 249 3 55 2 38 0 50 0 0 0 6 3 11 252 0 0 0 255 255 0 77 255 30 1 249 1 230 2 38 0 50 0 0 0 6 2 252 21 0 0 0 255 255 0 77 255 244 1 249 2 215 2 38 0 50 0 0 0 6 2 239 252 0 0 0 0 1 0 77 255 50 2 15 1 230 0 37 0 136 0 184 0 0 69 88 184 0 27 47 27 185 0 27 0 7 62 89 184 0 0 69 88 184 0 36 47 27 185 0 36 0 7 62 89 184 0 0 69 88 184 0 23 47 27 185 0 23 0 3 62 89 184 0 0 69 88 184 0 12 47 27 185 0 12 0 5 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 3 62 89 184 0 12 16 185 0 6 0 1 244 184 0 0 16 184 0 18 208 186 0 20 0 27 0 23 17 18 57 184 0 23 16 185 0 32 0 1 244 184 0 20 16 185 0 35 0 1 244 48 49 33 14 1 21 20 22 51 50 55 23 14 1 35 34 38 53 52 54 55 39 35 14 1 35 34 38 53 17 51 17 20 22 51 50 54 55 17 51 1 249 45 41 28 18 22 18 22 14 46 19 38 52 48 32 7 4 37 87 57 88 81 83 51 61 42 68 41 82 22 54 29 23 23 13 41 11 16 43 42 41 61 23 81 43 54 99 97 1 46 254 221 69 67 43 47 1 81 0 0 1 0 77 255 244 2 86 2 111 0 35 0 97 0 184 0 0 69 88 184 0 19 47 27 185 0 19 0 7 62 89 184 0 0 69 88 184 0 28 47 27 185 0 28 0 7 62 89 184 0 0 69 88 184 0 9 47 27 185 0 9 0 3 62 89 184 0 0 69 88 184 0 15 47 27 185 0 15 0 3 62 89 186 0 11 0 15 0 28 17 18 57 185 0 24 0 1 244 184 0 11 16 185 0 27 0 1 244 48 49 1 30 1 21 20 14 2 7 17 35 39 35 14 1 35 34 38 53 17 51 17 20 22 51 50 54 55 17 51 62 1 53 52 38 39 2 63 10 13 16 26 34 17 67 7 4 37 87 57 88 81 83 51 61 42 68 41 24 35 48 8 6 2 111 14 32 19 23 35 25 16 5 254 58 85 43 54 99 97 1 46 254 221 69 67 43 47 1 81 4 28 34 11 21 10 0 0 255 255 0 77 255 244 2 86 2 209 2 38 1 133 0 0 0 6 2 225 251 0 0 0 255 255 0 77 255 244 2 86 2 209 2 38 1 133 0 0 0 6 2 223 251 0 0 0 255 255 0 77 255 244 2 86 2 215 2 38 1 133 0 0 0 6 2 239 251 0 0 0 255 255 0 77 255 244 2 86 2 176 2 38 1 133 0 0 0 6 2 229 251 0 0 0 255 255 0 77 255 30 2 86 2 111 2 38 1 133 0 0 0 6 2 252 8 0 0 0 255 255 0 8 0 0 2 80 2 209 2 38 0 52 0 0 0 6 2 223 0 0 0 0 255 255 0 8 0 0 2 80 2 209 2 38 0 52 0 0 0 6 2 225 0 0 0 0 255 255 0 8 0 0 2 80 2 209 2 38 0 52 0 0 0 6 2 227 0 0 0 0 255 255 0 8 0 0 2 80 2 186 2 38 0 52 0 0 0 6 2 237 0 0 0 0 255 255 0 49 255 47 2 39 2 209 2 38 0 54 0 0 0 6 2 223 4 0 0 0 255 255 0 49 255 47 2 39 2 209 2 38 0 54 0 0 0 6 2 225 4 0 0 0 255 255 0 49 255 47 2 39 2 209 2 38 0 54 0 0 0 6 2 227 4 0 0 0 255 255 0 49 255 47 2 39 2 186 2 38 0 54 0 0 0 6 2 237 4 0 0 0 255 255 0 49 255 47 2 39 2 201 2 38 0 54 0 0 0 6 2 235 4 0 0 0 255 255 0 49 255 34 2 39 1 230 2 38 0 54 0 0 0 7 2 252 0 158 0 4 255 255 0 49 255 47 2 39 2 215 2 38 0 54 0 0 0 6 2 239 9 0 0 0 255 255 0 49 255 47 2 39 2 176 2 38 0 54 0 0 0 6 2 229 4 0 0 0 255 255 0 71 0 0 2 20 2 209 2 38 0 55 0 0 0 6 2 225 20 0 0 0 255 255 0 71 0 0 2 20 2 209 2 38 0 55 0 0 0 6 2 245 20 0 0 0 255 255 0 71 0 0 2 20 2 201 2 38 0 55 0 0 0 6 2 235 20 0 0 0 255 255 0 71 255 30 2 20 1 230 2 38 0 55 0 0 0 6 2 252 17 0 0 0 0 2 0 60 255 244 2 24 2 218 0 20 0 57 0 107 0 184 0 0 69 88 184 0 52 47 27 185 0 52 0 15 62 89 184 0 0 69 88 184 0 29 47 27 185 0 29 0 3 62 89 187 0 39 0 1 0 11 0 4 43 184 0 29 16 185 0 0 0 1 244 186 0 42 0 52 0 29 17 18 57 184 0 42 16 185 0 8 0 1 244 186 0 21 0 52 0 29 17 18 57 184 0 21 16 184 0 45 208 184 0 21 16 184 0 55 208 184 0 48 208 48 49 37 50 62 2 53 60 1 39 46 1 35 34 14 2 21 20 30 2 19 30 1 21 20 14 2 35 34 46 2 53 52 62 2 51 50 22 23 46 1 39 7 39 55 46 1 39 55 30 1 23 55 23 1 44 40 59 39 19 1 35 82 39 40 61 41 21 26 44 60 123 66 80 33 62 88 55 47 86 66 39 34 61 83 50 47 84 28 14 61 46 150 23 132 26 60 34 38 40 74 34 135 23 56 29 53 72 44 11 22 11 47 38 24 44 59 34 38 61 43 24 2 42 61 171 121 60 99 71 39 32 61 87 54 51 83 59 32 42 38 69 101 40 77 41 68 19 33 17 52 19 42 26 69 41 0 0 0 0 2 0 93 255 51 2 28 2 200 0 22 0 37 0 131 0 184 0 0 69 88 184 0 2 47 27 185 0 2 0 15 62 89 184 0 0 69 88 184 0 8 47 27 185 0 8 0 7 62 89 184 0 0 69 88 184 0 1 47 27 185 0 1 0 5 62 89 184 0 0 69 88 184 0 18 47 27 185 0 18 0 3 62 89 186 0 5 0 8 0 18 17 18 57 186 0 21 0 18 0 8 17 18 57 184 0 21 16 185 0 23 0 1 244 184 0 18 16 185 0 26 0 1 244 184 0 8 16 185 0 34 0 1 244 184 0 5 16 185 0 37 0 1 244 48 49 23 35 17 51 21 7 62 1 51 50 30 2 21 20 14 2 35 34 38 39 23 53 30 1 51 50 62 2 53 52 38 35 34 6 7 175 82 82 2 35 86 43 49 76 51 27 37 61 80 43 36 76 33 1 35 69 26 32 55 40 23 65 73 32 72 38 205 3 149 201 87 34 40 35 65 91 57 62 97 68 35 34 29 92 155 31 26 27 49 72 45 80 99 35 38 0 0 0 1 0 55 255 39 1 142 1 230 0 21 0 53 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 7 62 89 184 0 0 69 88 184 0 7 47 27 185 0 7 0 5 62 89 185 0 14 0 1 244 184 0 0 16 185 0 20 0 1 244 48 49 19 33 17 20 14 2 35 34 38 39 55 30 1 51 50 62 2 53 17 35 90 1 52 20 47 78 59 38 72 29 27 26 57 28 36 48 28 11 226 1 230 254 14 45 75 55 30 19 14 61 13 14 18 34 49 31 1 181 0 0 0 0 2 0 94 255 244 2 17 1 242 0 33 0 47 0 118 0 184 0 0 69 88 184 0 29 47 27 185 0 29 0 7 62 89 184 0 0 69 88 184 0 23 47 27 185 0 23 0 7 62 89 184 0 0 69 88 184 0 19 47 27 185 0 19 0 3 62 89 186 0 5 0 29 0 19 17 18 57 184 0 5 47 184 0 19 16 185 0 10 0 1 244 186 0 25 0 29 0 19 17 18 57 184 0 29 16 185 0 39 0 1 244 184 0 25 16 185 0 42 0 1 244 184 0 5 16 185 0 43 0 1 244 48 49 1 20 14 2 7 30 3 51 50 54 55 23 14 3 35 34 38 53 17 51 23 51 62 1 51 50 30 2 7 52 46 2 35 34 6 7 21 62 3 2 17 40 85 133 94 1 14 30 48 35 48 89 34 32 18 49 55 62 32 100 98 68 7 3 40 100 51 34 61 45 26 80 18 29 39 21 42 81 42 78 104 63 27 1 104 41 61 44 28 7 25 45 33 20 37 21 56 12 25 20 13 109 91 1 42 66 32 46 18 36 51 39 21 29 19 9 37 35 128 6 22 31 39 0 0 0 0 2 0 60 255 244 1 251 1 242 0 13 0 36 0 127 0 184 0 0 69 88 184 0 24 47 27 185 0 24 0 7 62 89 184 0 0 69 88 184 0 19 47 27 185 0 19 0 7 62 89 184 0 0 69 88 184 0 26 47 27 185 0 26 0 3 62 89 184 0 0 69 88 184 0 32 47 27 185 0 32 0 3 62 89 185 0 3 0 1 244 186 0 28 0 32 0 19 17 18 57 184 0 28 16 185 0 5 0 1 244 186 0 23 0 32 0 19 17 18 57 184 0 23 16 185 0 6 0 1 244 184 0 19 16 185 0 9 0 1 244 48 49 55 20 22 51 50 55 53 46 1 35 34 14 2 7 52 62 2 51 50 22 23 51 55 51 17 35 39 35 14 1 35 34 46 2 145 75 68 72 65 33 63 32 32 55 41 24 85 36 62 80 44 43 72 34 3 7 66 68 7 3 29 84 46 47 77 56 30 243 88 98 73 242 31 26 27 49 68 43 59 95 66 36 34 32 54 254 26 64 31 45 34 65 94 0 2 0 93 255 244 2 28 1 242 0 14 0 37 0 131 0 184 0 0 69 88 184 0 27 47 27 185 0 27 0 7 62 89 184 0 0 69 88 184 0 33 47 27 185 0 33 0 7 62 89 184 0 0 69 88 184 0 26 47 27 185 0 26 0 3 62 89 184 0 0 69 88 184 0 20 47 27 185 0 20 0 3 62 89 184 0 33 16 185 0 3 0 1 244 186 0 29 0 33 0 20 17 18 57 184 0 29 16 185 0 6 0 1 244 186 0 24 0 20 0 33 17 18 57 184 0 24 16 185 0 7 0 1 244 184 0 20 16 185 0 10 0 1 244 48 49 37 52 38 35 34 6 7 21 30 1 51 50 62 2 55 20 14 2 35 34 38 39 35 7 35 17 51 23 51 62 1 51 50 30 2 1 199 65 73 36 74 32 35 69 27 32 54 40 23 85 36 61 80 43 36 80 35 3 7 66 68 7 3 29 90 49 49 75 51 26 247 83 99 37 36 242 32 25 26 50 70 48 62 98 68 35 35 31 54 1 230 64 31 45 35 65 91 0 1 0 61 255 244 2 8 1 242 0 33 0 53 0 184 0 0 69 88 184 0 29 47 27 185 0 29 0 7 62 89 184 0 0 69 88 184 0 5 47 27 185 0 5 0 3 62 89 185 0 12 0 1 244 184 0 29 16 185 0 22 0 1 244 48 49 37 20 14 2 35 34 38 39 55 30 1 51 50 62 2 53 52 46 2 35 34 6 7 39 62 1 51 50 30 2 2 8 41 70 97 55 57 100 39 37 29 77 45 41 69 49 27 26 46 66 39 44 70 31 42 31 95 66 53 93 70 41 242 60 95 65 34 40 36 53 26 35 27 49 68 42 42 69 50 27 30 26 53 29 42 34 66 95 0 0 2 0 63 255 244 2 19 1 242 0 30 0 39 0 67 0 184 0 0 69 88 184 0 26 47 27 185 0 26 0 7 62 89 184 0 0 69 88 184 0 5 47 27 185 0 5 0 3 62 89 187 0 31 0 1 0 18 0 4 43 184 0 5 16 185 0 12 0 1 244 184 0 26 16 185 0 34 0 1 244 48 49 37 20 14 2 35 34 38 39 55 30 1 51 50 62 2 55 33 46 1 53 52 62 2 51 50 30 2 7 46 1 35 34 14 2 21 2 19 41 71 95 54 59 92 36 29 34 71 43 40 66 48 29 3 254 132 2 1 34 62 85 51 49 86 64 37 84 10 80 66 31 55 42 24 242 60 94 65 35 34 23 54 21 24 24 43 63 39 9 25 13 51 84 60 33 35 66 95 20 72 79 20 38 57 36 0 0 2 0 69 255 244 2 25 1 242 0 28 0 35 0 67 0 184 0 0 69 88 184 0 14 47 27 185 0 14 0 7 62 89 184 0 0 69 88 184 0 24 47 27 185 0 24 0 3 62 89 187 0 35 0 1 0 3 0 4 43 184 0 14 16 185 0 7 0 1 244 184 0 24 16 185 0 32 0 1 244 48 49 55 52 54 55 33 46 1 35 34 6 7 39 62 1 51 50 30 2 21 20 14 2 35 34 46 2 55 20 22 51 50 54 55 69 2 2 1 123 5 85 84 42 74 33 29 36 94 57 57 92 65 36 36 65 89 53 51 83 59 32 76 81 66 72 82 7 222 14 25 9 74 89 23 20 56 23 29 34 66 94 60 60 95 66 35 32 61 87 43 79 78 82 75 0 2 0 60 255 39 1 251 1 242 0 33 0 47 0 141 0 184 0 0 69 88 184 0 25 47 27 185 0 25 0 7 62 89 184 0 0 69 88 184 0 20 47 27 185 0 20 0 7 62 89 184 0 0 69 88 184 0 30 47 27 185 0 30 0 5 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 3 62 89 184 0 30 16 185 0 3 0 1 244 186 0 7 0 30 0 20 17 18 57 186 0 24 0 30 0 20 17 18 57 184 0 10 16 185 0 34 0 1 244 184 0 7 16 185 0 36 0 1 244 184 0 24 16 185 0 37 0 1 244 184 0 20 16 185 0 40 0 1 244 48 49 23 30 1 51 50 54 63 1 14 1 35 34 46 2 53 52 62 2 51 50 22 23 51 55 51 17 20 6 35 34 38 39 55 50 55 53 46 1 35 34 14 2 21 20 22 125 38 80 37 70 75 2 1 29 84 45 47 77 56 30 36 61 81 44 43 74 32 3 7 66 118 109 48 97 40 193 70 67 33 64 32 31 55 42 24 77 106 24 21 70 59 98 29 42 34 63 91 57 57 92 64 35 35 31 54 254 7 92 106 26 26 238 73 226 31 26 26 48 65 39 82 96 0 0 1 0 77 255 51 1 251 1 230 0 22 0 97 0 184 0 0 69 88 184 0 10 47 27 185 0 10 0 7 62 89 184 0 0 69 88 184 0 21 47 27 185 0 21 0 7 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 5 62 89 184 0 0 69 88 184 0 6 47 27 185 0 6 0 3 62 89 186 0 3 0 10 0 6 17 18 57 185 0 15 0 1 244 184 0 3 16 185 0 20 0 1 244 48 49 5 35 53 55 14 1 35 34 38 53 17 51 17 20 22 51 50 62 2 55 17 51 1 251 82 4 39 88 57 87 81 82 52 60 22 37 36 38 21 82 205 174 114 40 55 99 97 1 46 254 221 69 67 11 22 33 22 1 83 0 0 0 1 0 46 255 244 2 30 1 230 0 32 0 165 0 184 0 0 69 88 184 0 15 47 27 185 0 15 0 7 62 89 184 0 0 69 88 184 0 23 47 27 185 0 23 0 7 62 89 184 0 0 69 88 184 0 31 47 27 185 0 31 0 7 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 3 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 3 62 89 184 0 0 69 88 184 0 6 47 27 185 0 6 0 3 62 89 186 0 2 0 23 0 0 17 18 57 186 0 8 0 15 0 11 17 18 57 184 0 11 16 185 0 19 0 1 244 184 0 8 16 185 0 22 0 1 244 184 0 6 16 185 0 27 0 1 244 184 0 2 16 185 0 30 0 1 244 48 49 33 35 39 35 14 1 35 34 39 14 1 35 34 38 53 17 51 17 20 51 50 54 55 17 51 17 20 51 50 54 55 17 51 2 30 64 7 3 18 49 42 74 18 21 52 41 51 56 79 53 26 38 19 67 54 26 37 19 78 64 34 42 84 38 46 77 73 1 92 254 171 86 37 38 1 96 254 171 86 37 38 1 96 0 0 0 1 0 63 255 244 1 198 1 230 0 18 0 84 0 184 0 0 69 88 184 0 17 47 27 185 0 17 0 7 62 89 184 0 0 69 88 184 0 6 47 27 185 0 6 0 3 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 3 62 89 186 0 3 0 6 0 17 17 18 57 184 0 6 16 185 0 13 0 1 244 184 0 3 16 185 0 16 0 1 244 48 49 33 35 39 35 14 1 35 34 38 39 55 30 1 51 50 54 55 17 51 1 198 68 7 3 38 111 68 27 46 23 19 26 35 29 55 101 44 82 115 59 68 9 11 71 9 8 63 76 1 29 0 1 0 54 255 120 2 19 1 242 0 25 0 65 0 184 0 0 69 88 184 0 20 47 27 185 0 20 0 7 62 89 184 0 0 69 88 184 0 7 47 27 185 0 7 0 3 62 89 185 0 8 0 1 244 184 0 0 208 184 0 7 16 184 0 3 208 184 0 20 16 185 0 13 0 1 244 48 49 37 51 21 35 7 35 53 35 53 51 53 52 38 35 34 6 7 39 62 1 51 50 30 2 21 1 138 137 140 11 68 239 239 53 70 35 56 26 18 33 80 40 53 72 43 19 67 67 136 136 67 231 65 68 12 10 61 11 17 29 53 74 45 0 0 0 1 0 51 0 0 2 37 1 230 0 13 0 64 0 184 0 0 69 88 184 0 12 47 27 185 0 12 0 7 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 3 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 3 62 89 186 0 6 0 12 0 0 17 18 57 48 49 33 35 3 46 1 39 35 14 1 7 3 35 19 51 2 37 83 112 15 27 13 4 13 25 15 112 79 201 92 1 20 37 72 35 35 72 37 254 236 1 230 0 0 1 0 8 0 0 2 80 1 230 0 33 0 105 0 184 0 11 47 184 0 0 69 88 184 0 22 47 27 185 0 22 0 7 62 89 184 0 0 69 88 184 0 32 47 27 185 0 32 0 7 62 89 184 0 0 69 88 184 0 21 47 27 185 0 21 0 3 62 89 184 0 0 69 88 184 0 1 47 27 185 0 1 0 3 62 89 186 0 6 0 32 0 1 17 18 57 186 0 16 0 22 0 21 17 18 57 186 0 27 0 22 0 1 17 18 57 48 49 33 35 3 46 1 39 35 14 1 15 1 35 39 46 1 39 35 14 1 7 3 35 19 51 23 30 1 23 51 62 1 63 1 51 2 80 84 59 7 12 5 4 7 14 8 59 70 60 8 14 8 4 7 11 6 59 78 106 99 58 7 12 8 4 6 12 9 56 98 1 25 35 66 34 34 67 34 252 252 35 66 34 34 66 35 254 231 1 230 246 35 69 37 32 68 42 245 0 1 0 49 0 0 2 39 2 212 0 29 0 82 0 184 0 0 69 88 184 0 25 47 27 185 0 25 0 15 62 89 184 0 0 69 88 184 0 19 47 27 185 0 19 0 3 62 89 184 0 0 69 88 184 0 8 47 27 185 0 8 0 3 62 89 184 0 25 16 185 0 3 0 1 244 186 0 14 0 8 0 25 17 18 57 184 0 14 16 184 0 7 208 48 49 1 46 1 35 34 6 15 1 19 35 3 46 1 39 35 14 1 7 3 35 19 62 3 51 50 22 23 7 2 7 9 21 12 48 61 17 27 227 83 119 14 31 15 4 13 27 12 106 78 226 13 36 48 62 39 17 33 14 18 2 137 3 4 60 46 63 254 25 1 13 32 74 35 35 73 33 254 243 2 42 36 62 46 26 5 5 65 0 0 1 0 26 255 51 1 238 1 230 0 12 0 99 0 184 0 0 69 88 184 0 7 47 27 185 0 7 0 7 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 7 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 5 62 89 184 0 0 69 88 184 0 4 47 27 185 0 4 0 3 62 89 186 0 2 0 7 0 0 17 18 57 186 0 9 0 7 0 0 17 18 57 184 0 9 16 184 0 6 208 48 49 5 35 17 35 5 35 55 3 51 23 55 53 51 1 238 82 4 254 250 94 194 220 92 179 115 82 205 1 204 255 193 1 37 240 110 130 0 0 0 0 3 0 52 0 0 2 10 2 212 0 21 0 25 0 37 0 132 0 184 0 0 69 88 184 0 3 47 27 185 0 3 0 15 62 89 184 0 0 69 88 184 0 12 47 27 185 0 12 0 7 62 89 184 0 0 69 88 184 0 22 47 27 185 0 22 0 7 62 89 184 0 0 69 88 184 0 16 47 27 185 0 16 0 3 62 89 184 0 0 69 88 184 0 24 47 27 185 0 24 0 3 62 89 184 0 3 16 185 0 9 0 1 244 184 0 12 16 185 0 15 0 1 244 184 0 18 208 184 0 12 16 184 0 21 208 184 0 22 16 184 0 32 220 184 0 26 220 48 49 19 52 54 51 50 22 23 7 38 35 34 29 1 51 21 35 17 35 17 35 53 55 33 51 17 35 19 50 22 21 20 6 35 34 38 53 52 54 118 69 73 23 41 17 17 29 26 69 103 103 82 66 66 1 40 82 82 41 29 38 38 29 29 39 39 2 51 75 86 9 7 63 12 94 77 67 254 93 1 163 62 5 254 26 2 202 35 29 29 35 35 29 29 35 0 2 0 57 255 244 2 23 2 212 0 21 0 37 0 130 0 184 0 0 69 88 184 0 29 47 27 185 0 29 0 15 62 89 184 0 0 69 88 184 0 3 47 27 185 0 3 0 15 62 89 184 0 0 69 88 184 0 12 47 27 185 0 12 0 7 62 89 184 0 0 69 88 184 0 16 47 27 185 0 16 0 3 62 89 184 0 0 69 88 184 0 25 47 27 185 0 25 0 3 62 89 184 0 3 16 185 0 9 0 1 244 184 0 12 16 185 0 15 0 1 244 184 0 18 208 184 0 12 16 184 0 21 208 184 0 25 16 185 0 34 0 1 244 48 49 19 52 54 51 50 22 23 7 38 35 34 29 1 51 21 35 17 35 17 35 53 55 1 14 1 35 34 38 53 17 51 17 20 22 51 58 1 55 123 69 73 23 41 17 18 27 28 68 103 103 82 66 66 1 156 9 22 16 47 40 82 14 9 4 7 7 2 51 75 86 9 7 63 12 94 77 67 254 93 1 163 62 5 254 22 4 4 56 54 2 102 253 148 20 16 2 0 0 255 255 0 60 255 244 1 251 1 242 2 6 1 159 0 0 255 255 0 60 255 244 1 251 2 209 2 38 1 159 0 0 0 6 2 223 7 0 0 0 255 255 0 60 255 244 1 251 2 209 2 38 1 159 0 0 0 6 2 225 7 0 0 0 255 255 0 60 255 244 1 251 2 209 2 38 1 159 0 0 0 6 2 227 7 0 0 0 255 255 0 60 255 244 1 251 2 176 2 38 1 159 0 0 0 6 2 229 7 0 0 0 255 255 0 60 255 244 1 251 2 186 2 38 1 159 0 0 0 6 2 237 7 0 0 0 255 255 0 60 255 244 1 251 2 146 2 38 1 159 0 0 0 6 2 231 7 0 0 0 255 255 0 60 255 244 1 251 2 197 2 38 1 159 0 0 0 6 2 233 7 0 0 0 255 255 0 60 255 244 1 251 2 215 2 38 1 159 0 0 0 6 2 241 7 0 0 0 255 255 0 60 255 244 1 251 2 209 2 38 1 159 0 0 0 6 2 245 7 0 0 0 255 255 0 60 255 30 1 251 1 242 2 38 1 159 0 0 0 6 2 252 9 0 0 0 255 255 0 60 255 244 1 251 2 215 2 38 1 159 0 0 0 6 2 239 7 0 0 0 255 255 0 60 255 244 2 27 2 242 2 38 1 159 0 0 0 6 3 13 7 0 0 0 255 255 0 60 255 244 1 252 2 242 2 38 1 159 0 0 0 6 3 15 7 0 0 0 255 255 0 60 255 244 2 4 3 16 2 38 1 159 0 0 0 6 3 17 7 0 0 0 255 255 0 60 255 244 1 251 3 34 2 38 1 159 0 0 0 6 3 19 7 0 0 0 255 255 0 60 255 30 1 251 2 209 2 38 1 159 0 0 0 38 2 227 7 0 0 6 2 252 8 0 255 255 0 60 255 244 1 251 3 21 2 38 1 159 0 0 0 6 3 21 7 0 0 0 255 255 0 60 255 244 1 251 3 21 2 38 1 159 0 0 0 6 3 23 7 0 0 0 255 255 0 60 255 244 1 251 3 71 2 38 1 159 0 0 0 6 3 25 7 0 0 0 255 255 0 60 255 244 1 251 3 34 2 38 1 159 0 0 0 6 3 27 7 0 0 0 255 255 0 60 255 30 1 251 2 197 2 38 1 159 0 0 0 38 2 233 7 0 0 6 2 252 8 0 0 2 0 60 255 50 2 16 1 242 0 13 0 53 0 166 0 184 0 0 69 88 184 0 19 47 27 185 0 19 0 7 62 89 184 0 0 69 88 184 0 25 47 27 185 0 25 0 7 62 89 184 0 0 69 88 184 0 49 47 27 185 0 49 0 3 62 89 184 0 0 69 88 184 0 38 47 27 185 0 38 0 5 62 89 184 0 0 69 88 184 0 26 47 27 185 0 26 0 3 62 89 184 0 49 16 185 0 3 0 1 244 186 0 46 0 49 0 19 17 18 57 184 0 46 16 185 0 5 0 1 244 186 0 22 0 19 0 49 17 18 57 184 0 22 16 185 0 6 0 1 244 184 0 19 16 185 0 9 0 1 244 184 0 38 16 185 0 32 0 1 244 184 0 26 16 184 0 44 208 48 49 55 20 22 51 50 55 53 46 1 35 34 14 2 7 52 62 2 51 50 22 23 51 55 51 17 14 1 21 20 22 51 50 55 23 14 1 35 34 38 53 52 54 55 39 35 14 1 35 34 46 2 145 75 68 72 65 33 63 32 32 55 41 24 85 36 62 80 44 43 72 34 3 7 66 45 42 28 19 20 20 21 14 45 19 38 53 49 32 8 3 29 84 46 47 77 56 30 243 88 98 73 242 31 26 27 49 68 43 59 95 66 36 34 32 54 254 26 22 54 29 23 23 13 41 11 16 43 42 41 61 23 60 31 45 34 65 94 0 255 255 0 60 255 39 1 251 1 242 2 6 1 164 0 0 255 255 0 60 255 39 1 251 2 209 2 38 1 164 0 0 0 6 2 227 7 0 0 0 255 255 0 60 255 39 1 251 2 197 2 38 1 164 0 0 0 6 2 233 7 0 0 0 255 255 0 60 255 39 1 251 2 201 2 38 1 164 0 0 0 6 2 235 7 0 0 0 255 255 0 60 255 39 1 251 2 198 2 38 1 164 0 0 0 6 3 32 7 0 0 0 255 255 0 60 255 39 1 251 2 209 2 38 1 164 0 0 0 6 2 245 7 0 0 0 255 255 0 60 255 39 1 251 2 146 2 38 1 164 0 0 0 6 2 231 7 0 0 0 255 255 0 60 255 39 1 251 2 176 2 38 1 164 0 0 0 6 2 229 7 0 0 0 0 3 0 42 255 244 2 65 2 156 0 13 0 27 0 71 0 144 0 184 0 0 69 88 184 0 51 47 27 185 0 51 0 13 62 89 184 0 0 69 88 184 0 33 47 27 185 0 33 0 3 62 89 184 0 0 69 88 184 0 28 47 27 185 0 28 0 3 62 89 184 0 33 16 185 0 5 0 1 244 186 0 8 0 33 0 51 17 18 57 186 0 17 0 51 0 33 17 18 57 184 0 17 16 184 0 43 208 184 0 11 208 184 0 51 16 185 0 25 0 1 244 184 0 8 16 184 0 30 208 184 0 17 16 185 0 59 0 1 244 184 0 30 16 184 0 69 208 184 0 62 208 184 0 28 16 184 0 71 208 48 49 55 20 30 2 51 50 54 55 46 1 39 14 1 19 20 22 23 62 3 53 52 38 35 34 6 1 38 39 14 1 35 34 46 2 53 52 62 2 55 46 1 53 52 62 2 51 50 22 21 20 14 2 7 30 1 23 62 1 55 51 14 1 7 22 23 122 20 34 46 26 31 58 26 48 85 34 32 42 70 16 14 21 37 29 16 27 33 35 38 1 106 65 72 36 87 56 44 72 51 29 20 35 44 24 21 23 21 37 53 33 61 66 25 40 50 26 32 83 45 28 41 14 76 18 52 36 60 53 175 27 45 32 17 28 24 42 100 54 28 61 1 45 27 58 30 15 31 33 37 22 29 43 54 253 201 20 55 35 40 27 48 67 40 32 54 45 39 18 41 79 35 33 56 42 24 72 58 32 52 47 41 20 51 94 39 40 95 57 65 118 52 46 17 0 0 3 0 71 255 244 2 17 2 138 0 11 0 27 0 39 0 75 0 184 0 0 69 88 184 0 6 47 27 185 0 6 0 11 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 3 62 89 184 0 6 16 185 0 12 0 1 244 184 0 0 16 185 0 20 0 1 244 186 0 28 0 20 0 12 17 18 57 184 0 28 47 184 0 34 220 48 49 5 34 38 53 52 54 51 50 22 21 20 6 3 34 14 2 21 20 22 51 50 54 53 52 46 2 3 34 38 53 52 54 51 50 22 21 20 6 1 44 107 122 122 107 107 122 122 107 33 56 41 22 85 67 67 85 22 41 56 33 25 37 37 25 25 37 37 12 173 160 161 168 168 161 160 173 2 84 30 65 99 69 137 130 130 137 69 99 65 30 254 189 35 32 31 35 35 31 32 35 0 0 0 0 1 0 98 0 0 2 16 2 126 0 12 0 61 0 184 0 0 69 88 184 0 10 47 27 185 0 10 0 11 62 89 184 0 0 69 88 184 0 2 47 27 185 0 2 0 3 62 89 185 0 3 0 1 244 184 0 0 208 184 0 10 16 184 0 5 208 185 0 7 0 1 244 48 49 37 21 33 53 51 17 35 53 62 1 55 51 17 2 16 254 82 181 136 51 76 30 61 68 68 68 1 214 53 8 23 16 253 198 0 0 0 0 1 0 69 0 0 2 10 2 138 0 31 0 67 0 184 0 0 69 88 184 0 15 47 27 185 0 15 0 11 62 89 184 0 0 69 88 184 0 30 47 27 185 0 30 0 3 62 89 185 0 28 0 1 244 184 0 0 208 186 0 5 0 15 0 30 17 18 57 184 0 15 16 185 0 8 0 1 244 48 49 55 62 3 53 52 38 35 34 6 7 39 62 1 51 50 30 2 21 20 14 2 7 62 1 59 1 21 33 73 81 125 85 44 68 71 45 77 31 47 43 99 68 48 77 54 29 43 78 108 65 29 61 29 210 254 63 49 72 116 97 84 40 55 70 45 32 47 44 53 27 49 70 42 45 91 97 105 59 2 4 71 0 0 0 1 0 57 255 244 2 6 2 138 0 51 0 83 0 184 0 0 69 88 184 0 29 47 27 185 0 29 0 11 62 89 184 0 0 69 88 184 0 48 47 27 185 0 48 0 3 62 89 185 0 3 0 1 244 186 0 13 0 29 0 48 17 18 57 184 0 13 47 185 0 14 0 1 244 184 0 29 16 185 0 22 0 1 244 186 0 38 0 13 0 14 17 18 57 48 49 55 30 1 51 50 62 2 53 52 46 2 35 53 50 62 2 53 52 38 35 34 6 7 39 62 1 51 50 30 2 21 20 6 7 21 30 3 21 20 14 2 35 34 38 39 99 32 89 62 33 56 41 23 25 56 88 63 57 79 50 23 71 59 45 80 32 44 40 102 62 45 77 57 32 76 60 32 57 44 25 36 63 84 48 83 112 35 132 30 46 17 30 43 27 28 47 34 18 63 18 32 44 25 47 54 36 29 52 35 45 22 41 60 39 58 74 20 4 7 27 41 54 33 42 68 47 25 55 35 0 0 0 2 0 39 0 0 2 33 2 126 0 9 0 20 0 89 0 184 0 0 69 88 184 0 17 47 27 185 0 17 0 11 62 89 184 0 0 69 88 184 0 13 47 27 185 0 13 0 3 62 89 187 0 14 0 1 0 0 0 4 43 184 0 17 16 185 0 4 0 1 244 184 0 0 16 184 0 9 208 184 0 14 16 184 0 11 208 184 0 9 16 184 0 16 208 184 0 0 16 184 0 19 208 48 49 37 53 62 1 55 35 14 1 15 1 5 35 21 35 53 33 53 1 51 17 51 1 112 1 2 2 5 15 34 16 173 1 159 99 78 254 183 1 63 88 99 242 198 26 61 26 23 47 23 218 66 176 176 55 1 151 254 116 0 0 1 0 56 255 244 2 10 2 126 0 40 0 85 0 184 0 0 69 88 184 0 18 47 27 185 0 18 0 11 62 89 184 0 0 69 88 184 0 35 47 27 185 0 35 0 3 62 89 187 0 25 0 1 0 13 0 4 43 184 0 35 16 185 0 5 0 1 244 186 0 22 0 35 0 18 17 18 57 184 0 22 16 184 0 17 208 184 0 18 16 185 0 20 0 1 244 48 49 55 30 3 51 50 62 2 53 52 38 35 34 6 7 39 19 33 21 33 7 62 1 51 50 30 2 21 20 14 2 35 34 46 2 39 97 16 36 43 53 32 34 59 44 25 85 72 40 56 34 44 21 1 105 254 224 17 28 53 37 46 80 59 34 39 66 85 46 43 69 55 45 18 129 14 27 20 12 21 38 54 33 66 74 20 19 28 1 51 71 189 12 14 24 49 75 52 52 80 55 29 15 24 31 17 0 2 0 77 255 244 2 22 2 138 0 13 0 48 0 87 0 184 0 0 69 88 184 0 45 47 27 185 0 45 0 11 62 89 184 0 0 69 88 184 0 35 47 27 185 0 35 0 3 62 89 187 0 8 0 1 0 25 0 4 43 184 0 35 16 185 0 0 0 1 244 186 0 22 0 35 0 45 17 18 57 184 0 22 16 185 0 11 0 1 244 184 0 45 16 185 0 17 0 1 244 48 49 37 50 62 2 53 52 38 35 34 6 7 30 1 19 46 1 35 34 14 2 7 62 1 51 50 30 2 21 20 14 2 35 34 46 2 53 52 62 2 51 50 22 23 1 65 28 50 36 21 70 66 38 84 41 9 85 225 25 66 36 38 70 53 33 1 38 95 48 44 73 53 29 35 58 77 43 52 89 66 37 44 74 97 52 59 87 32 53 20 37 51 32 66 69 39 47 93 96 1 222 23 27 28 64 105 77 38 45 25 49 74 49 46 75 54 30 38 77 115 77 96 135 85 39 39 29 0 0 0 0 1 0 70 0 0 2 20 2 126 0 15 0 51 0 184 0 0 69 88 184 0 7 47 27 185 0 7 0 11 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 3 62 89 184 0 7 16 185 0 5 0 1 244 184 0 9 208 48 49 51 62 3 55 33 53 33 21 14 3 7 35 226 4 26 50 77 55 254 144 1 206 63 82 50 22 3 86 91 149 134 126 67 71 51 72 132 137 152 94 0 0 0 0 3 0 68 255 244 2 19 2 138 0 13 0 26 0 64 0 87 0 184 0 0 69 88 184 0 41 47 27 185 0 41 0 11 62 89 184 0 0 69 88 184 0 60 47 27 185 0 60 0 3 62 89 185 0 3 0 1 244 184 0 41 16 185 0 19 0 1 244 186 0 11 0 3 0 19 17 18 57 184 0 11 47 184 0 49 208 184 0 49 47 184 0 14 220 184 0 11 16 184 0 32 220 48 49 55 20 22 51 50 54 53 52 46 2 39 14 1 55 54 53 52 38 35 34 6 21 20 30 2 7 52 62 2 55 53 46 1 53 52 62 2 51 50 30 2 21 20 6 7 21 30 3 21 20 14 2 35 34 46 2 143 87 74 72 76 31 54 73 42 47 62 209 80 66 63 54 66 26 46 61 248 24 38 49 26 40 57 29 53 72 43 47 73 51 27 57 40 26 46 34 19 31 58 85 55 54 87 60 33 171 54 68 62 50 33 45 32 25 14 26 65 129 58 70 48 65 56 47 29 41 32 25 196 33 52 42 31 12 4 25 73 51 37 60 43 24 25 45 63 37 45 79 28 4 13 30 38 51 34 36 62 46 26 26 47 64 0 0 2 0 67 255 244 2 12 2 138 0 13 0 48 0 87 0 184 0 0 69 88 184 0 35 47 27 185 0 35 0 11 62 89 184 0 0 69 88 184 0 45 47 27 185 0 45 0 3 62 89 187 0 0 0 1 0 25 0 4 43 186 0 22 0 45 0 35 17 18 57 184 0 22 16 185 0 3 0 1 244 184 0 35 16 185 0 6 0 1 244 184 0 45 16 185 0 17 0 1 244 48 49 1 50 54 55 46 1 35 34 14 2 21 20 22 7 30 1 51 50 62 2 55 14 1 35 34 46 2 53 52 62 2 51 50 30 2 21 20 14 2 35 34 38 39 1 25 37 84 42 10 83 71 29 49 36 21 69 89 24 66 37 38 69 53 32 2 39 93 49 44 73 52 29 34 59 77 42 52 90 66 37 45 74 96 52 59 87 32 1 54 39 46 94 96 20 37 52 31 66 69 203 23 28 28 65 104 77 38 44 25 49 74 49 46 75 54 30 38 77 115 77 96 135 85 39 38 29 0 0 0 0 3 0 71 255 244 2 17 2 74 0 11 0 27 0 39 0 75 0 184 0 0 69 88 184 0 6 47 27 185 0 6 0 9 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 3 62 89 184 0 6 16 185 0 12 0 1 244 184 0 0 16 185 0 20 0 1 244 186 0 28 0 20 0 12 17 18 57 184 0 28 47 184 0 34 220 48 49 5 34 38 53 52 54 51 50 22 21 20 6 3 34 6 21 20 30 2 51 50 62 2 53 52 38 3 34 38 53 52 54 51 50 22 21 20 6 1 44 107 122 122 107 107 122 122 107 67 85 22 41 56 33 33 56 41 22 85 67 25 37 37 25 25 37 37 12 156 146 144 152 152 144 146 156 2 19 111 118 61 89 58 28 28 58 89 61 118 111 254 223 35 32 31 35 35 31 32 35 0 0 0 0 1 0 98 0 0 2 16 2 62 0 12 0 61 0 184 0 0 69 88 184 0 10 47 27 185 0 10 0 9 62 89 184 0 0 69 88 184 0 1 47 27 185 0 1 0 3 62 89 185 0 0 0 1 244 184 0 3 208 184 0 10 16 184 0 5 208 185 0 7 0 1 244 48 49 37 21 33 53 51 17 35 53 62 1 55 51 17 2 16 254 82 181 136 51 76 30 61 68 68 68 1 150 53 8 23 16 254 6 0 0 0 0 1 0 69 0 0 2 10 2 74 0 29 0 65 0 184 0 0 69 88 184 0 13 47 27 185 0 13 0 9 62 89 184 0 0 69 88 184 0 28 47 27 185 0 28 0 3 62 89 185 0 23 0 1 244 184 0 0 208 184 0 13 16 185 0 6 0 1 244 184 0 23 16 184 0 26 208 48 49 55 62 1 53 52 38 35 34 6 7 39 62 1 51 50 30 2 21 20 14 2 7 62 1 59 1 21 33 73 165 170 68 71 45 77 31 47 43 99 68 48 77 54 29 39 72 103 64 29 61 29 194 254 63 49 110 166 64 58 72 45 32 47 44 53 27 51 71 44 38 78 81 85 46 2 4 71 0 1 0 57 255 170 2 6 2 74 0 51 0 60 0 184 0 0 69 88 184 0 29 47 27 185 0 29 0 9 62 89 187 0 3 0 1 0 48 0 4 43 187 0 14 0 1 0 13 0 4 43 184 0 29 16 185 0 22 0 1 244 186 0 38 0 13 0 14 17 18 57 48 49 55 30 1 51 50 62 2 53 52 46 2 35 53 50 62 2 53 52 38 35 34 6 7 39 62 1 51 50 30 2 21 20 6 7 21 30 3 21 20 14 2 35 34 38 39 99 32 89 62 33 56 41 23 25 56 88 63 57 79 50 23 71 59 45 80 32 44 40 102 62 45 77 57 32 76 60 32 57 44 25 36 63 84 48 83 112 35 58 30 45 17 31 44 28 29 48 33 18 64 18 33 44 26 47 56 36 29 52 35 45 22 42 61 39 59 75 20 4 7 28 41 54 34 44 69 48 25 55 35 0 0 2 0 39 255 182 2 33 2 62 0 9 0 20 0 60 0 184 0 13 47 184 0 0 69 88 184 0 17 47 27 185 0 17 0 9 62 89 187 0 20 0 1 0 10 0 4 43 184 0 20 16 184 0 0 208 186 0 4 0 17 0 13 17 18 57 184 0 10 16 184 0 14 208 48 49 37 53 62 1 55 35 14 1 15 1 5 35 21 35 53 33 53 1 51 17 51 1 112 1 2 2 5 15 33 16 175 1 160 99 78 254 183 1 63 88 99 161 215 26 61 26 25 49 23 231 67 168 168 55 1 169 254 99 0 0 0 1 0 56 255 170 2 10 2 62 0 40 0 68 0 184 0 0 69 88 184 0 18 47 27 185 0 18 0 9 62 89 187 0 5 0 1 0 35 0 4 43 187 0 25 0 1 0 13 0 4 43 186 0 22 0 35 0 18 17 18 57 184 0 22 16 184 0 17 208 184 0 18 16 185 0 20 0 1 244 48 49 55 30 3 51 50 62 2 53 52 38 35 34 6 7 39 19 33 21 33 7 62 1 51 50 30 2 21 20 14 2 35 34 46 2 39 97 16 36 43 53 32 34 59 44 25 85 72 40 56 34 44 21 1 105 254 224 17 28 53 37 46 80 59 34 39 66 85 46 43 69 55 45 18 55 14 26 20 12 21 38 55 35 68 74 20 19 28 1 55 71 193 13 13 23 50 76 53 53 81 57 29 15 24 32 17 0 255 255 0 78 255 244 2 23 2 138 2 6 1 213 1 0 0 1 0 70 255 182 2 20 2 62 0 15 0 30 0 184 0 0 69 88 184 0 7 47 27 185 0 7 0 9 62 89 185 0 5 0 1 244 184 0 9 208 48 49 23 62 3 55 33 53 33 21 14 3 7 35 226 4 26 50 77 55 254 144 1 206 63 82 49 22 4 86 74 92 152 137 128 68 71 51 73 133 140 155 96 0 0 0 255 255 0 68 255 244 2 19 2 138 2 6 1 215 0 0 0 2 0 67 255 170 2 12 2 74 0 13 0 48 0 70 0 184 0 0 69 88 184 0 35 47 27 185 0 35 0 9 62 89 187 0 17 0 1 0 45 0 4 43 187 0 0 0 1 0 25 0 4 43 186 0 22 0 45 0 35 17 18 57 184 0 22 16 185 0 3 0 1 244 184 0 35 16 185 0 6 0 1 244 48 49 37 50 54 55 46 1 35 34 14 2 21 20 22 7 30 1 51 50 62 2 55 14 1 35 34 46 2 53 52 62 2 51 50 30 2 21 20 14 2 35 34 38 39 1 25 37 84 42 8 84 72 29 49 36 21 69 89 24 66 37 37 69 53 33 2 39 93 49 44 73 52 29 34 59 77 42 52 90 66 37 45 74 96 52 59 87 32 237 39 47 97 101 20 38 52 33 68 73 204 23 27 28 64 105 77 38 44 26 51 76 50 46 77 55 30 38 77 115 77 99 139 87 40 39 29 0 0 1 0 219 255 244 1 125 0 157 0 11 0 24 0 184 0 0 69 88 184 0 9 47 27 185 0 9 0 3 62 89 184 0 3 220 48 49 55 52 54 51 50 22 21 20 6 35 34 38 219 47 34 34 47 47 34 34 47 72 38 47 47 38 38 46 46 0 0 1 0 197 255 43 1 140 0 155 0 18 0 11 0 186 0 12 0 6 0 3 43 48 49 23 62 1 55 14 1 35 34 38 53 52 54 51 50 22 21 20 6 7 197 62 62 2 5 9 5 32 46 48 32 45 45 93 83 161 28 79 60 1 1 37 38 37 39 69 59 88 121 31 0 0 255 255 0 219 255 244 1 125 2 3 2 39 1 227 0 0 1 102 0 6 1 227 0 0 255 255 0 197 255 43 1 140 2 3 2 39 1 227 0 0 1 102 0 6 1 228 0 0 0 3 0 32 255 244 2 56 0 138 0 11 0 23 0 35 0 70 0 184 0 0 69 88 184 0 9 47 27 185 0 9 0 3 62 89 184 0 0 69 88 184 0 21 47 27 185 0 21 0 3 62 89 184 0 0 69 88 184 0 33 47 27 185 0 33 0 3 62 89 184 0 9 16 184 0 3 220 184 0 15 208 184 0 27 208 48 49 55 52 54 51 50 22 21 20 6 35 34 38 55 52 54 51 50 22 21 20 6 35 34 38 55 52 54 51 50 22 21 20 6 35 34 38 32 41 29 29 40 40 29 29 41 198 41 29 29 41 41 29 29 41 199 40 29 29 41 41 29 29 40 63 34 41 41 34 33 42 42 33 34 41 41 34 33 42 42 33 34 41 41 34 33 42 42 0 0 2 0 227 255 244 1 117 2 158 0 5 0 17 0 45 0 184 0 0 69 88 184 0 1 47 27 185 0 1 0 13 62 89 184 0 0 69 88 184 0 15 47 27 185 0 15 0 3 62 89 184 0 9 220 184 0 5 220 48 49 1 39 51 7 3 35 7 52 54 51 50 22 21 20 6 35 34 38 1 6 2 80 2 10 56 45 43 30 30 43 43 30 30 43 2 64 94 94 254 168 166 35 41 41 35 36 42 42 0 0 0 0 2 0 227 255 72 1 117 1 242 0 5 0 17 0 28 0 184 0 0 69 88 184 0 15 47 27 185 0 15 0 7 62 89 184 0 9 220 184 0 4 220 48 49 5 23 35 55 19 51 55 20 6 35 34 38 53 52 54 51 50 22 1 82 2 80 2 10 56 45 43 30 30 43 43 30 30 43 90 94 94 1 88 167 36 41 41 36 35 42 42 0 0 2 0 109 255 244 1 223 2 170 0 29 0 41 0 42 0 184 0 0 69 88 184 0 39 47 27 185 0 39 0 3 62 89 187 0 17 0 1 0 10 0 4 43 184 0 39 16 184 0 33 220 184 0 0 220 48 49 55 38 62 4 53 52 38 35 34 6 7 39 62 1 51 50 30 2 21 20 14 4 23 7 52 54 51 50 22 21 20 6 35 34 38 242 6 18 35 44 39 26 55 55 38 65 27 49 34 92 58 42 68 49 27 27 39 45 37 21 5 102 43 30 30 43 43 30 30 43 232 36 56 46 40 39 42 26 42 55 31 27 45 35 46 22 41 57 36 33 51 43 40 44 51 32 166 35 41 41 35 36 42 42 0 0 0 2 0 123 255 60 1 236 1 242 0 27 0 39 0 42 0 184 0 0 69 88 184 0 37 47 27 185 0 37 0 7 62 89 187 0 10 0 1 0 17 0 4 43 184 0 37 16 184 0 31 220 184 0 27 220 48 49 37 22 14 4 21 20 22 51 50 54 55 23 14 1 35 34 38 53 52 62 4 39 55 20 6 35 34 38 53 52 54 51 50 22 1 103 6 18 35 44 39 26 56 55 38 65 27 48 33 93 58 84 101 27 39 45 36 20 4 103 44 30 30 43 43 30 30 44 254 36 56 46 40 39 43 25 42 54 30 27 45 35 46 84 72 33 51 43 40 44 50 33 167 36 41 41 36 35 42 42 0 0 0 1 0 245 1 96 1 99 2 175 0 5 0 11 0 186 0 2 0 4 0 3 43 48 49 19 39 51 15 1 35 247 2 110 2 25 56 2 65 110 110 225 0 0 255 255 0 131 1 96 1 214 2 175 2 38 1 236 142 0 0 6 1 236 115 0 0 0 0 1 0 209 1 94 1 124 2 187 0 17 0 11 0 186 0 5 0 11 0 3 43 48 49 1 14 1 7 54 51 50 22 21 20 6 35 34 38 53 52 54 55 1 124 47 53 3 12 14 31 39 42 32 39 51 76 68 2 139 27 79 52 6 40 32 35 42 63 57 75 119 35 0 0 0 0 1 0 217 1 94 1 132 2 187 0 17 0 11 0 186 0 5 0 11 0 3 43 48 49 19 62 1 55 6 35 34 38 53 52 54 51 50 22 21 20 6 7 217 48 53 3 12 14 32 39 42 32 40 50 76 67 1 142 26 79 53 6 39 32 35 43 64 57 75 118 35 255 255 0 95 1 94 1 239 2 187 2 38 1 238 142 0 0 6 1 238 115 0 0 0 255 255 0 103 1 94 1 247 2 187 2 38 1 239 142 0 0 6 1 239 115 0 0 0 255 255 0 217 255 31 1 132 0 124 2 7 1 239 0 0 253 193 0 0 255 255 0 103 255 31 1 247 0 124 2 39 1 239 255 142 253 193 0 7 1 239 0 115 253 193 0 0 0 1 0 197 0 52 1 133 1 196 0 6 0 11 0 186 0 2 0 6 0 3 43 48 49 55 53 55 23 7 23 7 197 153 39 127 127 39 212 80 160 35 165 166 34 0 0 0 0 1 0 211 0 52 1 147 1 196 0 6 0 11 0 186 0 2 0 5 0 3 43 48 49 37 39 55 23 21 7 39 1 82 127 39 153 153 39 252 165 35 160 80 160 34 0 0 255 255 0 83 0 52 1 248 1 196 2 38 1 244 142 0 0 6 1 244 115 0 0 0 255 255 0 97 0 52 2 6 1 196 2 38 1 245 142 0 0 6 1 245 115 0 0 0 255 255 0 85 1 43 2 3 1 105 2 6 2 151 0 0 255 255 0 85 1 43 2 3 1 105 2 6 2 151 0 0 0 1 0 80 0 216 2 8 1 32 0 3 0 13 0 187 0 1 0 1 0 2 0 4 43 48 49 19 33 21 33 80 1 184 254 72 1 32 72 0 0 1 0 20 0 216 2 68 1 32 0 3 0 13 0 187 0 1 0 1 0 2 0 4 43 48 49 19 33 21 33 20 2 48 253 208 1 32 72 0 0 1 0 80 0 216 2 8 1 32 0 3 0 13 0 187 0 1 0 1 0 2 0 4 43 48 49 19 33 21 33 80 1 184 254 72 1 32 72 0 255 255 0 20 0 216 2 68 1 32 2 6 1 251 0 0 255 255 0 219 1 7 1 125 1 176 2 7 1 227 0 0 1 19 0 0 0 1 0 151 0 115 1 193 1 153 0 19 0 11 0 186 0 10 0 0 0 3 43 48 49 37 34 46 2 53 52 62 2 51 50 30 2 21 20 14 2 1 44 30 54 41 24 24 41 54 30 30 54 41 24 24 41 54 115 21 39 54 33 33 54 39 21 21 39 54 33 33 54 39 21 0 0 1 0 60 255 116 2 28 255 187 0 3 0 13 0 187 0 0 0 1 0 1 0 4 43 48 49 5 21 33 53 2 28 254 32 69 71 71 0 0 0 1 0 208 255 80 1 222 2 220 0 14 0 11 0 186 0 6 0 0 0 3 43 48 49 5 46 1 53 52 54 55 23 14 1 21 20 22 23 7 1 177 104 121 121 104 45 101 95 95 101 45 176 81 228 145 145 228 81 42 85 200 127 127 200 85 42 0 0 1 0 122 255 80 1 136 2 220 0 13 0 11 0 186 0 7 0 13 0 3 43 48 49 23 62 1 53 52 38 39 55 30 1 21 20 6 7 122 101 95 95 101 45 104 121 121 104 134 85 200 127 127 200 85 42 81 228 145 145 228 81 0 0 1 0 226 255 104 1 246 2 196 0 7 0 23 0 187 0 5 0 1 0 6 0 4 43 187 0 1 0 1 0 2 0 4 43 48 49 19 33 21 35 17 51 21 33 226 1 20 211 211 254 236 2 196 48 253 4 48 0 0 0 1 0 99 255 104 1 119 2 196 0 7 0 23 0 187 0 0 0 1 0 5 0 4 43 187 0 4 0 1 0 1 0 4 43 48 49 5 17 35 53 33 17 33 53 1 53 210 1 20 254 236 104 2 252 48 252 164 48 0 0 1 0 120 255 104 1 246 2 196 0 57 0 43 0 187 0 51 0 1 0 52 0 4 43 187 0 25 0 1 0 26 0 4 43 187 0 11 0 1 0 10 0 4 43 186 0 39 0 10 0 11 17 18 57 48 49 5 52 62 2 53 52 46 2 35 53 50 62 2 53 52 38 53 52 62 2 59 1 21 35 34 14 2 21 20 22 21 20 6 7 21 30 1 21 20 6 21 20 30 2 59 1 21 35 34 46 2 1 0 3 3 3 12 32 57 44 44 57 32 12 9 22 46 70 47 61 52 38 49 27 10 6 39 52 52 39 6 10 27 49 38 52 61 47 70 46 22 19 27 49 46 46 25 15 27 22 14 52 14 22 27 15 48 93 52 39 51 30 13 48 10 21 35 24 43 91 47 49 51 9 4 9 51 49 51 84 46 24 35 21 10 48 13 30 51 0 1 0 99 255 104 1 224 2 196 0 57 0 43 0 187 0 0 0 1 0 55 0 4 43 187 0 26 0 1 0 23 0 4 43 187 0 39 0 1 0 40 0 4 43 186 0 12 0 40 0 39 17 18 57 48 49 23 50 62 2 53 52 38 53 52 54 55 53 46 1 53 52 54 53 52 46 2 43 1 53 51 50 30 2 21 20 6 21 20 30 2 51 21 34 14 2 21 20 30 2 21 20 14 2 43 1 53 150 38 49 28 10 6 38 52 52 38 6 10 28 49 38 51 61 47 69 46 22 9 12 32 57 44 44 57 32 12 3 3 3 22 46 69 47 61 104 10 21 35 24 46 84 51 49 51 9 4 9 51 49 47 91 43 24 35 21 10 48 13 30 51 39 52 93 48 15 27 22 14 52 14 22 27 15 25 46 46 49 27 39 51 30 13 48 0 0 1 0 99 255 96 1 245 2 198 0 3 0 24 0 184 0 0 69 88 184 0 2 47 27 185 0 2 0 15 62 89 184 0 0 220 48 49 23 35 1 51 173 74 1 72 74 160 3 102 0 0 0 1 1 7 255 6 1 81 2 238 0 3 0 11 0 186 0 1 0 2 0 3 43 48 49 1 51 17 35 1 7 74 74 2 238 252 24 0 0 0 0 1 0 99 255 96 1 245 2 198 0 3 0 24 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 15 62 89 184 0 2 220 48 49 19 51 1 35 99 74 1 72 74 2 198 252 154 0 0 2 1 7 255 6 1 81 2 238 0 3 0 7 0 19 0 186 0 1 0 5 0 3 43 186 0 3 0 7 0 3 43 48 49 1 51 17 35 23 17 35 17 1 7 74 74 74 74 2 238 254 53 77 254 48 1 208 0 0 0 1 0 84 0 111 2 4 2 44 0 14 0 47 0 184 0 14 47 186 0 1 0 14 0 5 17 18 57 184 0 1 16 185 0 4 0 1 244 184 0 7 208 184 0 1 16 184 0 10 208 184 0 14 16 184 0 12 208 48 49 63 1 39 55 23 55 51 23 55 23 7 23 7 39 7 138 108 162 16 167 9 48 9 167 16 162 108 42 120 120 141 165 70 46 55 189 189 55 46 70 165 30 159 159 0 0 0 0 1 0 127 255 176 1 217 2 200 0 11 0 45 0 187 0 3 0 1 0 0 0 4 43 184 0 0 16 184 0 9 208 184 0 8 208 184 0 1 208 184 0 3 16 184 0 6 208 184 0 7 208 184 0 2 208 48 49 1 7 53 23 39 51 7 55 21 39 19 35 1 14 143 143 5 70 5 143 143 5 70 1 235 5 71 5 160 160 5 71 5 253 197 0 0 0 1 0 127 255 176 1 217 2 200 0 21 0 87 0 187 0 6 0 1 0 3 0 4 43 187 0 1 0 1 0 20 0 4 43 184 0 1 16 184 0 14 208 184 0 15 208 184 0 0 208 184 0 3 16 184 0 12 208 184 0 11 208 184 0 4 208 184 0 6 16 184 0 9 208 184 0 10 208 184 0 5 208 184 0 20 16 184 0 17 208 184 0 16 208 184 0 21 208 48 49 55 23 39 55 7 53 23 39 51 7 55 21 39 23 7 55 21 39 23 35 55 7 127 143 5 5 143 143 5 70 5 143 143 5 5 143 143 5 70 5 143 146 7 177 177 7 71 5 160 160 5 71 7 177 177 7 71 5 160 160 5 0 0 0 2 0 91 255 192 1 253 2 172 0 15 0 71 0 79 0 187 0 47 0 1 0 40 0 4 43 187 0 68 0 1 0 19 0 4 43 186 0 50 0 40 0 19 17 18 57 186 0 22 0 68 0 47 17 18 57 186 0 32 0 50 0 22 17 18 57 184 0 32 16 184 0 0 208 186 0 60 0 22 0 50 17 18 57 184 0 60 16 184 0 8 208 48 49 37 62 1 53 52 46 2 39 14 1 21 20 30 2 19 46 1 35 34 6 21 20 30 4 21 20 6 7 30 1 21 20 14 2 35 34 38 39 55 30 1 51 50 54 53 52 46 4 53 52 54 55 46 1 53 52 62 2 51 50 22 23 1 115 32 35 41 62 73 32 31 37 41 63 73 84 26 56 35 42 38 42 63 73 63 42 49 41 14 15 24 42 59 36 55 92 32 50 26 61 42 41 45 42 62 74 62 42 51 40 14 17 19 38 56 38 50 81 30 192 14 38 34 34 44 33 29 18 16 41 31 33 43 33 28 1 107 20 26 37 26 27 36 30 30 43 61 46 48 60 22 16 39 26 30 50 36 21 38 33 45 24 28 40 29 28 38 30 29 42 61 46 45 64 21 16 39 26 26 47 36 21 34 23 0 0 2 0 72 255 176 1 229 2 144 0 3 0 16 0 37 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 13 62 89 184 0 0 69 88 184 0 15 47 27 185 0 15 0 13 62 89 48 49 1 51 17 35 3 35 34 46 2 53 52 62 2 59 1 1 148 81 81 54 32 53 90 66 37 36 63 86 50 43 2 144 253 32 1 50 25 53 82 57 59 81 51 22 0 0 0 0 3 0 30 255 245 2 58 2 141 0 19 0 39 0 69 0 77 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 11 62 89 184 0 0 69 88 184 0 15 47 27 185 0 15 0 3 62 89 185 0 25 0 1 244 184 0 5 16 185 0 35 0 1 244 184 0 45 208 185 0 52 0 1 244 184 0 25 16 184 0 65 208 185 0 58 0 1 244 48 49 19 52 62 2 51 50 30 2 21 20 14 2 35 34 46 2 55 20 30 2 51 50 62 2 53 52 46 2 35 34 14 2 23 52 62 2 51 50 22 23 7 46 1 35 34 6 21 20 22 51 50 54 55 23 14 1 35 34 46 2 30 41 73 99 57 57 99 73 41 41 73 99 57 57 99 73 41 46 32 59 83 50 50 83 59 32 32 59 83 50 50 83 59 32 70 27 46 59 33 35 49 20 34 16 31 20 46 56 53 45 26 38 17 30 23 52 38 34 59 44 25 1 67 76 123 85 46 46 85 123 76 77 123 87 47 47 87 123 77 66 107 77 42 42 77 107 66 66 106 76 41 41 76 106 66 43 70 50 26 27 20 39 14 17 75 59 66 77 20 14 42 20 27 27 51 73 0 0 4 0 30 255 245 2 58 2 141 0 14 0 23 0 43 0 63 0 85 0 184 0 0 69 88 184 0 29 47 27 185 0 29 0 11 62 89 184 0 0 69 88 184 0 39 47 27 185 0 39 0 3 62 89 187 0 15 0 1 0 11 0 4 43 184 0 29 16 185 0 59 0 1 244 184 0 1 208 184 0 39 16 185 0 49 0 1 244 184 0 13 208 184 0 1 16 185 0 21 0 1 244 48 49 19 51 50 30 2 21 20 14 2 43 1 21 35 55 50 54 53 52 38 43 1 21 39 52 62 2 51 50 30 2 21 20 14 2 35 34 46 2 55 20 30 2 51 50 62 2 53 52 46 2 35 34 14 2 193 114 28 50 37 21 21 37 50 28 49 65 104 39 42 43 38 39 228 41 73 99 57 57 99 73 41 41 73 99 57 57 99 73 41 46 32 59 83 50 50 83 59 32 32 59 83 50 50 83 59 32 1 244 14 28 45 30 33 49 33 16 115 165 37 42 36 32 147 21 76 123 85 46 46 85 123 76 77 123 87 47 47 87 123 77 66 107 77 42 42 77 107 66 66 106 76 41 41 76 106 0 4 0 112 1 63 1 232 2 201 0 19 0 39 0 53 0 62 0 61 0 187 0 20 0 1 0 0 0 4 43 187 0 10 0 1 0 30 0 4 43 187 0 54 0 1 0 50 0 4 43 184 0 30 16 184 0 41 208 184 0 50 16 184 0 47 208 184 0 20 16 184 0 52 208 184 0 49 208 48 49 1 34 46 2 53 52 62 2 51 50 30 2 21 20 14 2 39 50 62 2 53 52 46 2 35 34 14 2 21 20 30 2 3 51 50 22 21 20 6 7 23 35 39 35 21 35 55 50 54 53 52 38 43 1 21 1 44 39 69 51 29 29 51 69 39 39 68 51 30 30 51 68 39 31 55 39 23 23 39 55 31 32 54 40 23 23 40 54 41 76 32 47 21 17 46 46 35 41 41 67 20 24 19 23 28 1 63 29 52 72 44 44 72 52 29 29 52 72 44 44 72 52 29 37 23 42 59 36 35 59 43 24 24 43 59 35 36 59 42 23 1 8 29 36 18 31 6 83 70 70 102 17 17 15 18 67 0 0 0 0 2 255 251 1 110 2 68 2 164 0 19 0 27 0 81 0 184 0 26 47 187 0 22 0 1 0 21 0 4 43 187 0 4 0 1 0 13 0 4 43 184 0 22 16 184 0 0 208 184 0 22 16 184 0 6 208 184 0 1 208 184 0 26 16 184 0 19 208 184 0 9 208 184 0 6 16 185 0 12 0 1 244 184 0 15 208 184 0 21 16 184 0 24 208 48 49 1 51 31 1 51 63 1 51 17 35 53 55 35 7 35 39 35 23 21 35 3 35 53 51 21 35 17 35 1 36 71 45 27 4 26 44 71 55 7 4 71 42 72 4 7 54 201 96 252 96 60 2 164 114 80 80 114 254 202 137 105 187 187 105 137 1 0 54 54 255 0 0 2 0 15 1 98 2 68 2 171 0 41 0 61 0 91 0 184 0 0 47 187 0 20 0 1 0 27 0 4 43 187 0 46 0 1 0 55 0 4 43 184 0 0 16 185 0 7 0 1 244 184 0 20 16 184 0 42 208 184 0 42 47 184 0 20 16 184 0 48 208 184 0 48 47 184 0 43 208 184 0 0 16 184 0 61 208 184 0 51 208 184 0 48 16 185 0 54 0 1 244 184 0 57 208 48 49 19 34 38 39 55 30 1 51 50 54 53 52 38 47 1 46 1 53 52 54 51 50 22 23 7 46 1 35 34 6 21 20 22 31 1 30 1 21 20 14 2 19 51 31 1 51 63 1 51 17 35 53 55 35 7 35 39 35 23 21 35 125 33 54 23 33 19 37 25 23 26 19 23 46 22 37 56 48 28 50 17 30 15 35 17 23 24 21 20 46 29 32 15 28 41 142 71 45 27 4 26 44 71 55 7 4 71 42 72 4 7 54 1 98 25 23 37 17 21 21 18 20 15 11 24 11 39 35 39 49 22 16 39 12 18 23 15 15 19 9 23 14 38 35 18 32 26 15 1 66 114 80 80 114 254 202 137 105 187 187 105 137 0 0 0 0 2 0 49 255 112 2 34 2 123 0 52 0 61 0 63 0 187 0 30 0 1 0 37 0 4 43 187 0 47 0 1 0 20 0 4 43 187 0 56 0 1 0 6 0 4 43 187 0 59 0 1 0 14 0 4 43 186 0 2 0 6 0 47 17 18 57 184 0 2 16 185 0 58 0 1 244 48 49 37 35 39 35 14 1 35 34 46 2 53 52 54 55 53 52 46 2 35 34 14 2 21 20 30 2 51 50 54 55 23 14 1 35 34 46 2 53 52 62 2 51 50 30 2 21 5 20 22 51 50 55 53 14 1 2 34 50 7 4 22 71 39 27 47 35 20 136 128 17 36 57 39 45 82 63 37 36 62 84 49 45 67 29 28 39 82 50 59 106 80 47 45 80 107 62 52 76 50 25 255 0 43 37 56 56 104 88 100 58 28 42 18 34 49 30 77 78 16 14 36 64 48 28 42 83 125 83 80 125 86 45 23 22 45 27 28 51 99 148 96 96 144 96 49 36 64 87 51 176 35 40 64 126 14 55 0 0 2 0 49 255 238 2 34 2 156 0 52 0 61 0 97 0 184 0 0 69 88 184 0 47 47 27 185 0 47 0 13 62 89 184 0 0 69 88 184 0 37 47 27 185 0 37 0 3 62 89 187 0 56 0 1 0 6 0 4 43 187 0 14 0 1 0 59 0 4 43 186 0 2 0 6 0 47 17 18 57 184 0 47 16 185 0 20 0 1 244 184 0 37 16 185 0 30 0 1 244 184 0 2 16 185 0 58 0 1 244 48 49 37 35 39 35 14 1 35 34 46 2 53 52 54 55 53 52 46 2 35 34 14 2 21 20 30 2 51 50 54 55 23 14 1 35 34 46 2 53 52 62 2 51 50 30 2 21 5 20 22 51 50 55 53 14 1 2 34 50 7 4 22 71 39 27 47 35 20 136 128 17 36 55 38 45 84 63 38 36 62 84 49 45 67 29 28 39 82 50 59 106 80 47 46 80 109 62 51 75 50 24 255 0 43 37 56 56 104 88 173 58 29 41 18 34 49 30 76 79 16 10 28 51 38 23 37 73 110 73 68 105 72 38 23 22 45 26 29 44 86 127 84 86 129 87 43 32 56 75 42 170 35 39 64 126 15 54 0 0 0 0 2 0 87 0 0 2 7 2 138 0 27 0 31 0 139 0 184 0 0 69 88 184 0 8 47 27 185 0 8 0 11 62 89 184 0 0 69 88 184 0 12 47 27 185 0 12 0 11 62 89 184 0 0 69 88 184 0 27 47 27 185 0 27 0 3 62 89 184 0 0 69 88 184 0 23 47 27 185 0 23 0 3 62 89 187 0 2 0 1 0 1 0 4 43 187 0 6 0 1 0 5 0 4 43 184 0 6 16 184 0 10 208 184 0 14 208 184 0 5 16 184 0 30 208 184 0 17 208 184 0 2 16 184 0 31 208 184 0 18 208 184 0 1 16 184 0 25 208 184 0 21 208 48 49 55 35 53 51 55 35 53 51 55 51 7 51 55 51 7 51 21 35 7 51 21 35 7 35 55 35 7 35 19 55 35 7 166 79 86 19 85 91 24 53 23 132 24 53 23 81 87 19 86 93 24 54 25 133 24 54 217 19 133 18 204 57 148 58 183 183 183 183 58 148 57 204 204 204 1 5 148 148 0 0 0 0 1 0 104 1 60 1 240 2 200 0 14 0 20 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 15 62 89 48 49 19 55 39 55 23 55 51 23 55 23 7 23 7 39 7 155 92 143 16 147 9 48 9 147 16 143 92 42 103 103 1 89 147 57 46 44 161 159 42 46 57 147 29 140 140 0 0 1 0 134 0 216 1 210 1 32 0 3 0 13 0 187 0 1 0 1 0 2 0 4 43 48 49 19 33 21 33 134 1 76 254 180 1 32 72 0 255 255 0 134 0 216 1 210 1 32 2 6 2 25 0 0 0 3 0 85 255 143 2 3 2 239 0 9 0 19 0 67 0 23 0 187 0 3 0 1 0 30 0 4 43 187 0 54 0 1 0 13 0 4 43 48 49 37 22 50 51 50 54 53 52 38 39 3 38 34 35 34 6 21 20 22 31 1 30 3 21 20 14 2 35 42 1 39 7 39 55 46 1 39 55 30 1 23 55 46 3 53 52 62 2 51 58 1 23 55 23 7 30 1 23 7 46 1 39 1 37 5 11 5 59 62 63 45 8 5 9 5 51 59 56 42 53 32 62 50 30 31 55 78 47 6 12 6 27 56 28 42 72 26 39 25 57 32 36 31 59 46 28 29 52 72 43 7 12 6 25 56 25 33 52 23 44 20 37 20 103 1 49 38 36 44 18 1 6 1 45 38 30 38 16 20 12 29 39 52 36 36 59 43 23 1 148 6 151 11 36 22 57 17 31 9 195 12 28 36 48 33 35 57 40 21 1 134 7 137 10 34 22 48 15 23 7 0 0 0 255 255 0 161 1 172 1 183 2 245 2 7 2 56 0 0 1 184 0 0 255 255 0 208 1 184 1 97 2 233 2 7 2 57 0 0 1 184 0 0 255 255 0 174 1 184 1 167 2 245 2 7 2 58 0 1 1 184 0 0 255 255 0 172 1 172 1 164 2 245 2 7 2 59 0 0 1 184 0 0 255 255 0 172 1 184 1 185 2 233 2 7 2 60 0 0 1 184 0 0 255 255 0 172 1 172 1 169 2 233 2 7 2 61 0 0 1 184 0 0 255 255 0 176 1 172 1 173 2 245 2 7 2 62 0 0 1 184 0 0 255 255 0 183 1 184 1 170 2 233 2 7 2 63 0 0 1 184 0 0 255 255 0 175 1 172 1 169 2 245 2 7 2 64 0 0 1 184 0 0 255 255 0 173 1 172 1 169 2 245 2 7 2 65 0 0 1 184 0 0 255 255 0 236 1 108 1 131 3 67 2 7 2 66 0 0 1 184 0 0 255 255 0 213 1 108 1 108 3 67 2 7 2 67 0 0 1 184 0 0 255 255 0 254 1 176 1 90 2 15 2 7 2 68 0 0 1 184 0 0 255 255 0 244 1 68 1 100 2 15 2 7 2 69 0 0 1 184 0 0 255 255 0 161 255 75 1 183 0 148 2 7 2 56 0 0 255 87 0 0 255 255 0 208 255 87 1 97 0 136 2 7 2 57 0 0 255 87 0 0 255 255 0 174 255 87 1 167 0 148 2 7 2 58 0 1 255 87 0 0 255 255 0 172 255 75 1 164 0 148 2 7 2 59 0 0 255 87 0 0 255 255 0 172 255 87 1 185 0 136 2 7 2 60 0 0 255 87 0 0 255 255 0 172 255 75 1 169 0 136 2 7 2 61 0 0 255 87 0 0 255 255 0 176 255 75 1 173 0 148 2 7 2 62 0 0 255 87 0 0 255 255 0 183 255 87 1 170 0 136 2 7 2 63 0 0 255 87 0 0 255 255 0 175 255 75 1 169 0 148 2 7 2 64 0 0 255 87 0 0 255 255 0 173 255 75 1 169 0 148 2 7 2 65 0 0 255 87 0 0 255 255 0 236 255 11 1 131 0 226 2 7 2 66 0 0 255 87 0 0 255 255 0 213 255 11 1 108 0 226 2 7 2 67 0 0 255 87 0 0 255 255 0 254 255 79 1 90 255 174 2 7 2 68 0 0 255 87 0 0 255 255 0 244 254 227 1 100 255 174 2 7 2 69 0 0 255 87 0 0 0 2 0 161 255 244 1 183 1 61 0 11 0 23 0 40 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 3 62 89 187 0 6 0 1 0 18 0 4 43 184 0 0 16 185 0 12 0 1 244 48 49 5 34 38 53 52 54 51 50 22 21 20 6 39 50 54 53 52 38 35 34 6 21 20 22 1 44 61 78 78 61 61 78 78 61 32 46 46 32 32 46 46 12 88 79 78 84 84 78 79 88 50 57 60 60 53 53 60 60 57 0 0 1 0 208 0 0 1 97 1 49 0 8 0 30 0 184 0 0 69 88 184 0 8 47 27 185 0 8 0 3 62 89 187 0 5 0 1 0 0 0 4 43 48 49 37 35 53 62 1 55 51 17 35 1 34 82 33 41 21 50 63 230 42 5 16 12 254 207 0 1 0 173 0 0 1 166 1 61 0 24 0 44 0 184 0 0 69 88 184 0 23 47 27 185 0 23 0 3 62 89 187 0 13 0 1 0 6 0 4 43 184 0 23 16 185 0 21 0 1 244 184 0 0 208 48 49 55 62 1 53 52 38 35 34 6 7 39 62 1 51 50 22 21 20 14 2 7 51 21 35 183 78 83 31 29 20 38 14 39 23 59 36 54 62 19 33 44 25 136 239 36 59 78 33 27 32 23 19 33 26 35 53 50 20 39 39 41 22 53 0 0 0 0 1 0 172 255 244 1 164 1 61 0 36 0 60 0 184 0 0 69 88 184 0 33 47 27 185 0 33 0 3 62 89 187 0 22 0 1 0 15 0 4 43 187 0 9 0 1 0 8 0 4 43 184 0 33 16 185 0 3 0 1 244 186 0 27 0 8 0 9 17 18 57 48 49 55 30 1 51 50 54 53 52 35 53 50 54 53 52 38 35 34 6 7 39 62 1 51 50 22 21 20 7 30 1 21 20 6 35 34 38 39 204 15 49 27 27 35 96 42 39 26 29 18 40 15 30 19 61 35 47 59 56 32 39 70 51 35 67 25 81 18 25 22 25 51 38 28 23 20 23 19 15 38 20 25 44 40 55 20 8 38 31 45 48 28 26 0 0 0 2 0 172 0 0 1 185 1 49 0 5 0 16 0 56 0 184 0 0 69 88 184 0 9 47 27 185 0 9 0 3 62 89 187 0 16 0 1 0 6 0 4 43 187 0 2 0 1 0 13 0 4 43 184 0 16 16 184 0 0 208 184 0 6 16 184 0 10 208 48 49 37 53 55 35 15 1 23 35 21 35 53 35 53 55 51 21 51 1 78 4 3 45 54 205 50 57 162 148 71 50 116 56 82 65 73 43 73 73 31 201 189 0 0 0 0 1 0 172 255 244 1 169 1 49 0 29 0 68 0 184 0 0 69 88 184 0 26 47 27 185 0 26 0 3 62 89 187 0 15 0 1 0 16 0 4 43 187 0 20 0 1 0 9 0 4 43 184 0 26 16 185 0 3 0 1 244 186 0 18 0 9 0 20 17 18 57 184 0 18 16 184 0 13 208 48 49 55 30 1 51 50 54 53 52 38 35 34 6 7 39 55 51 21 35 7 54 51 50 22 21 20 6 35 34 38 39 204 17 45 30 29 37 36 31 20 29 15 31 17 189 139 10 24 32 50 62 70 54 42 60 27 81 18 25 30 27 29 29 12 11 20 155 54 70 12 51 48 48 58 28 26 0 0 0 0 2 0 176 255 244 1 173 1 61 0 11 0 38 0 70 0 184 0 0 69 88 184 0 29 47 27 185 0 29 0 3 62 89 187 0 35 0 1 0 15 0 4 43 187 0 21 0 1 0 6 0 4 43 184 0 29 16 185 0 0 0 1 244 186 0 18 0 29 0 35 17 18 57 184 0 18 16 185 0 9 0 1 244 48 49 37 50 54 53 52 38 35 34 6 7 30 1 55 46 1 35 34 6 7 62 1 51 50 22 21 20 14 2 35 34 38 53 52 54 51 50 22 23 1 56 28 30 28 31 20 35 20 6 44 111 14 30 20 43 52 3 19 45 27 51 52 17 31 43 25 59 78 85 69 30 44 19 38 29 25 23 30 16 19 38 34 206 11 13 59 57 17 18 53 42 21 38 29 16 81 71 86 91 18 14 0 0 0 1 0 183 0 0 1 170 1 49 0 15 0 38 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 3 62 89 187 0 8 0 1 0 5 0 4 43 184 0 5 16 184 0 9 208 48 49 51 62 3 55 35 53 51 21 14 3 7 35 253 2 13 24 36 24 169 243 32 40 24 10 2 65 39 65 59 58 31 53 36 35 63 63 68 40 0 0 0 3 0 175 255 244 1 169 1 61 0 12 0 24 0 56 0 60 0 184 0 0 69 88 184 0 52 47 27 185 0 52 0 3 62 89 187 0 37 0 1 0 19 0 4 43 184 0 52 16 185 0 3 0 1 244 186 0 6 0 52 0 19 17 18 57 186 0 22 0 37 0 3 17 18 57 48 49 55 20 22 51 50 54 53 52 46 2 39 6 55 62 1 53 52 38 35 34 6 21 20 22 7 52 54 55 53 46 1 53 52 62 2 51 50 22 21 20 6 7 21 30 1 21 20 14 2 35 34 46 2 233 39 28 26 41 15 24 31 17 47 87 20 16 29 27 25 30 44 114 39 26 23 31 18 31 42 23 50 65 33 20 26 37 19 34 45 27 28 46 33 18 80 20 27 25 20 14 19 13 10 5 22 60 12 26 15 18 24 23 17 22 24 110 32 37 12 4 14 31 27 18 31 23 12 47 37 28 33 11 4 11 37 33 18 32 24 14 14 24 32 0 0 0 0 2 0 173 255 244 1 169 1 61 0 11 0 36 0 70 0 184 0 0 69 88 184 0 33 47 27 185 0 33 0 3 62 89 187 0 27 0 1 0 9 0 4 43 187 0 3 0 1 0 21 0 4 43 186 0 18 0 27 0 33 17 18 57 184 0 18 16 185 0 6 0 1 244 184 0 33 16 185 0 15 0 1 244 48 49 55 20 22 51 50 54 55 46 1 35 34 6 7 30 1 51 50 54 55 14 1 35 34 38 53 52 54 51 50 22 21 20 6 35 34 38 39 231 28 31 20 35 19 5 44 26 27 31 27 14 31 20 42 50 4 19 45 26 51 51 64 51 59 78 85 69 29 45 19 213 23 29 15 18 38 36 30 177 11 12 57 57 16 18 53 42 44 60 81 71 86 91 19 14 0 1 0 236 255 180 1 131 1 139 0 13 0 11 0 186 0 3 0 11 0 3 43 48 49 55 52 54 55 23 14 1 21 20 22 23 7 46 1 236 55 50 46 45 40 40 45 46 50 55 159 75 111 50 33 45 99 59 59 99 45 32 49 111 0 1 0 213 255 180 1 108 1 139 0 13 0 11 0 186 0 11 0 3 0 3 43 48 49 37 20 6 7 39 62 1 53 52 38 39 55 30 1 1 108 55 50 46 45 40 40 45 46 50 55 159 75 111 49 32 45 99 59 59 99 45 33 50 111 0 0 0 0 1 0 254 255 248 1 90 0 87 0 11 0 26 0 184 0 0 69 88 184 0 9 47 27 185 0 9 0 3 62 89 185 0 3 0 1 244 48 49 55 52 54 51 50 22 21 20 6 35 34 38 254 26 20 20 26 26 20 20 26 39 22 26 26 22 21 26 26 0 0 0 0 1 0 244 255 140 1 100 0 87 0 17 0 43 0 184 0 0 69 88 184 0 3 47 27 185 0 3 0 3 62 89 184 0 0 69 88 184 0 5 47 27 185 0 5 0 3 62 89 185 0 11 0 1 244 48 49 23 62 1 53 6 35 34 38 53 52 54 51 50 22 21 20 6 7 244 29 35 2 5 17 29 28 19 26 28 51 45 79 11 39 29 1 21 21 21 25 37 36 45 68 17 0 0 255 255 0 161 1 64 1 183 2 137 2 7 2 56 0 0 1 76 0 0 255 255 0 208 1 76 1 97 2 125 2 7 2 57 0 0 1 76 0 0 255 255 0 174 1 76 1 167 2 137 2 7 2 58 0 1 1 76 0 0 255 255 0 172 1 64 1 164 2 137 2 7 2 59 0 0 1 76 0 0 255 255 0 172 1 76 1 185 2 125 2 7 2 60 0 0 1 76 0 0 255 255 0 172 1 64 1 169 2 125 2 7 2 61 0 0 1 76 0 0 255 255 0 176 1 64 1 173 2 137 2 7 2 62 0 0 1 76 0 0 255 255 0 183 1 76 1 170 2 125 2 7 2 63 0 0 1 76 0 0 255 255 0 175 1 64 1 169 2 137 2 7 2 64 0 0 1 76 0 0 255 255 0 173 1 64 1 169 2 137 2 7 2 65 0 0 1 76 0 0 255 255 0 236 0 190 1 131 2 149 2 7 2 66 0 0 1 10 0 0 255 255 0 213 0 190 1 108 2 149 2 7 2 67 0 0 1 10 0 0 255 255 0 254 1 2 1 90 1 97 2 7 2 68 0 0 1 10 0 0 255 255 0 244 0 150 1 100 1 97 2 7 2 69 0 0 1 10 0 0 255 255 0 167 0 252 1 186 2 78 2 6 2 87 0 0 255 255 0 137 0 252 1 182 2 78 2 6 2 116 0 0 255 255 0 142 0 252 1 202 2 78 2 6 2 101 0 0 0 2 0 167 0 252 1 186 2 78 0 25 0 35 0 57 0 184 0 18 47 187 0 29 0 1 0 23 0 4 43 187 0 13 0 1 0 6 0 4 43 187 0 3 0 1 0 33 0 4 43 186 0 19 0 13 0 23 17 18 57 184 0 19 16 185 0 32 0 1 244 48 49 19 52 54 55 46 1 35 34 6 7 39 62 1 51 50 22 29 1 35 39 35 14 1 35 34 38 55 20 22 51 50 54 55 53 14 1 167 102 109 1 30 39 29 52 22 25 26 72 40 63 61 52 5 2 24 57 32 43 60 63 34 25 23 43 23 81 67 1 89 53 56 11 30 44 21 13 43 15 27 72 63 195 37 19 26 50 47 24 23 21 19 82 9 37 0 0 2 0 172 0 252 1 216 2 216 0 20 0 32 0 84 0 184 0 19 47 184 0 0 69 88 184 0 1 47 27 185 0 1 0 15 62 89 187 0 24 0 1 0 14 0 4 43 187 0 6 0 1 0 30 0 4 43 186 0 3 0 6 0 14 17 18 57 186 0 17 0 14 0 6 17 18 57 184 0 17 16 185 0 21 0 1 244 184 0 3 16 185 0 32 0 1 244 48 49 19 51 21 7 62 1 51 50 22 21 20 14 2 35 34 38 39 35 7 35 55 30 1 51 50 54 53 52 38 35 34 7 172 64 2 23 53 28 66 68 24 40 53 28 24 50 23 1 7 50 64 21 40 17 40 52 39 46 41 44 2 216 125 56 19 24 89 75 41 65 45 23 21 19 32 75 17 13 63 57 51 61 40 0 0 1 0 181 0 252 1 205 2 78 0 29 0 23 0 187 0 18 0 1 0 25 0 4 43 187 0 5 0 1 0 12 0 4 43 48 49 19 52 62 2 51 50 22 23 7 46 1 35 34 6 21 20 22 51 50 54 55 23 14 1 35 34 46 2 181 28 47 61 34 35 50 18 32 15 33 20 48 60 58 48 25 40 17 27 24 59 32 35 61 44 25 1 165 40 63 43 23 22 16 41 13 14 65 52 53 64 18 13 41 20 22 23 43 63 0 0 2 0 137 0 252 1 182 2 216 0 20 0 32 0 84 0 184 0 13 47 184 0 0 69 88 184 0 10 47 27 185 0 10 0 15 62 89 187 0 24 0 1 0 18 0 4 43 187 0 5 0 1 0 30 0 4 43 186 0 8 0 5 0 18 17 18 57 186 0 14 0 18 0 5 17 18 57 184 0 14 16 185 0 26 0 1 244 184 0 8 16 185 0 27 0 1 244 48 49 19 52 62 2 51 50 22 23 39 53 51 17 35 39 35 14 1 35 34 38 55 20 22 51 50 55 53 46 1 35 34 6 137 24 40 53 29 29 43 21 2 64 53 5 2 20 53 29 63 76 66 46 42 43 40 21 38 20 39 53 1 165 39 63 44 23 20 17 54 121 254 44 37 19 26 88 81 55 61 40 161 17 14 62 0 2 0 160 0 252 1 201 2 78 0 25 0 32 0 33 0 187 0 14 0 1 0 21 0 4 43 187 0 5 0 1 0 29 0 4 43 187 0 10 0 1 0 26 0 4 43 48 49 19 52 62 2 51 50 22 21 20 7 35 30 1 51 50 54 55 23 14 1 35 34 46 2 55 52 38 35 34 6 7 160 27 43 57 30 68 72 3 231 4 61 47 24 42 20 23 24 59 35 35 60 45 26 241 43 40 35 55 6 1 165 39 63 44 23 83 69 20 12 49 55 13 12 41 14 20 23 43 63 66 45 48 48 45 0 0 0 1 0 198 1 4 1 247 2 224 0 23 0 56 0 184 0 11 47 184 0 0 69 88 184 0 7 47 27 185 0 7 0 9 62 89 187 0 20 0 1 0 3 0 4 43 184 0 7 16 185 0 9 0 1 244 184 0 13 208 184 0 7 16 184 0 16 208 48 49 1 46 1 35 34 6 29 1 51 21 35 17 35 17 35 53 55 53 52 54 51 50 22 23 1 233 17 34 20 42 36 128 128 63 79 79 65 69 25 45 22 2 160 7 7 42 35 27 51 254 241 1 15 48 3 25 58 71 8 8 0 0 0 3 0 149 0 114 1 226 2 78 0 15 0 65 0 77 0 100 0 184 0 0 69 88 184 0 37 47 27 185 0 37 0 9 62 89 187 0 3 0 1 0 63 0 4 43 187 0 34 0 1 0 72 0 4 43 187 0 55 0 1 0 9 0 4 43 187 0 66 0 1 0 48 0 4 43 186 0 19 0 9 0 55 17 18 57 184 0 19 16 184 0 13 208 184 0 48 16 184 0 50 208 184 0 26 208 184 0 37 16 185 0 40 0 1 244 48 49 55 20 22 51 50 54 53 52 38 43 1 34 38 39 14 1 7 52 55 53 46 1 53 52 54 55 53 46 1 53 52 62 2 51 50 22 23 51 21 35 30 1 21 20 14 2 35 34 39 6 21 20 59 1 50 22 21 20 14 2 35 34 38 55 50 54 53 52 38 35 34 6 21 20 22 203 51 50 54 63 37 35 59 15 23 11 21 17 54 53 13 20 21 18 17 24 21 35 47 27 14 24 11 134 82 11 14 19 34 46 27 23 30 22 63 71 64 62 26 48 68 42 70 79 148 29 40 40 29 29 40 40 210 24 29 37 23 21 15 2 3 11 25 20 40 30 3 7 26 20 16 32 12 3 13 41 29 27 43 30 16 3 5 48 11 31 19 27 41 28 15 11 14 20 34 36 41 24 41 31 18 45 245 38 32 32 40 40 32 32 38 0 0 0 0 1 0 175 1 4 1 204 2 216 0 20 0 58 0 184 0 20 47 184 0 11 47 184 0 0 69 88 184 0 0 47 27 185 0 0 0 15 62 89 187 0 6 0 1 0 15 0 4 43 186 0 3 0 6 0 20 17 18 57 184 0 3 16 185 0 18 0 1 244 48 49 19 51 21 7 62 1 51 50 22 29 1 35 53 52 38 35 34 6 7 21 35 175 64 4 24 56 36 57 52 64 31 36 26 39 25 64 2 216 125 69 23 33 65 62 203 195 42 39 25 24 227 0 0 2 0 175 1 4 1 139 2 224 0 5 0 17 0 42 0 184 0 3 47 184 0 0 69 88 184 0 0 47 27 185 0 0 0 9 62 89 185 0 4 0 1 244 184 0 0 16 184 0 6 220 184 0 12 220 48 49 19 51 17 35 17 35 55 34 38 53 52 54 51 50 22 21 20 6 175 205 64 141 172 21 27 27 21 21 27 27 2 70 254 190 1 15 114 24 21 20 26 26 20 21 24 0 0 2 0 140 0 119 1 128 2 224 0 18 0 30 0 52 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 9 62 89 187 0 13 0 1 0 7 0 4 43 184 0 0 16 185 0 17 0 1 244 184 0 0 16 184 0 19 220 184 0 25 220 48 49 19 51 17 20 14 2 35 34 38 39 55 22 51 50 54 53 17 35 55 34 38 53 52 54 51 50 22 21 20 6 164 204 13 32 54 40 26 45 18 20 34 32 47 32 141 172 21 28 28 21 20 28 28 2 70 254 188 30 50 38 21 13 10 46 17 43 40 1 21 114 24 21 20 26 26 20 21 24 0 0 0 1 0 189 1 4 1 245 2 216 0 12 0 83 0 184 0 8 47 184 0 11 47 184 0 0 69 88 184 0 0 47 27 185 0 0 0 15 62 89 184 0 0 69 88 184 0 4 47 27 185 0 4 0 9 62 89 186 0 10 0 11 0 0 17 18 57 184 0 10 16 185 0 2 0 1 244 186 0 9 0 8 0 4 17 18 57 184 0 9 16 184 0 6 208 48 49 19 51 17 51 55 51 7 23 35 39 7 21 35 189 64 2 159 71 124 140 71 107 70 64 2 216 254 206 160 128 194 152 67 85 0 0 1 0 196 0 252 1 202 2 216 0 17 0 40 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 15 62 89 187 0 5 0 1 0 12 0 4 43 184 0 0 16 185 0 17 0 1 244 48 49 19 51 17 20 22 51 50 54 55 23 14 1 35 34 38 53 17 35 196 145 29 26 11 23 16 12 20 34 23 54 50 81 2 216 254 148 32 28 6 5 50 5 8 60 56 1 54 0 0 0 0 1 0 130 1 4 1 212 2 78 0 31 0 84 0 184 0 31 47 184 0 23 47 184 0 16 47 184 0 0 69 88 184 0 1 47 27 185 0 1 0 9 62 89 187 0 11 0 1 0 19 0 4 43 187 0 26 0 1 0 6 0 4 43 186 0 2 0 31 0 1 17 18 57 184 0 2 16 184 0 8 208 184 0 2 16 185 0 29 0 1 244 184 0 21 208 48 49 19 51 23 51 62 1 51 50 23 62 1 51 50 22 29 1 35 53 52 35 34 7 21 35 53 52 35 34 6 7 21 35 130 50 5 2 12 33 28 49 12 13 36 27 34 37 61 31 29 21 53 32 15 23 12 61 2 70 42 22 28 55 25 30 52 48 230 225 51 46 230 225 51 23 23 230 0 0 0 1 0 175 1 4 1 204 2 78 0 20 0 58 0 184 0 20 47 184 0 11 47 184 0 0 69 88 184 0 1 47 27 185 0 1 0 9 62 89 187 0 6 0 1 0 15 0 4 43 186 0 2 0 20 0 1 17 18 57 184 0 2 16 185 0 18 0 1 244 48 49 19 51 23 51 62 1 51 50 22 29 1 35 53 52 38 35 34 6 7 21 35 175 53 5 3 23 55 37 56 53 64 31 36 26 39 25 64 2 70 48 23 33 65 62 203 195 42 39 25 24 227 0 0 2 0 142 0 252 1 202 2 78 0 19 0 31 0 23 0 187 0 23 0 1 0 15 0 4 43 187 0 5 0 1 0 29 0 4 43 48 49 19 52 62 2 51 50 30 2 21 20 14 2 35 34 46 2 55 20 22 51 50 54 53 52 38 35 34 6 142 26 43 57 32 32 57 44 25 25 44 57 32 32 57 43 26 66 49 43 43 49 49 43 43 49 1 165 40 63 43 23 23 43 63 40 40 63 43 23 23 43 63 40 53 64 64 53 52 65 65 0 0 0 2 0 172 0 127 1 216 2 78 0 19 0 31 0 84 0 184 0 1 47 184 0 0 69 88 184 0 4 47 27 185 0 4 0 9 62 89 187 0 9 0 1 0 29 0 4 43 187 0 23 0 1 0 17 0 4 43 186 0 5 0 9 0 17 17 18 57 186 0 19 0 17 0 9 17 18 57 184 0 19 16 185 0 20 0 1 244 184 0 5 16 185 0 31 0 1 244 48 49 55 21 35 17 51 23 51 62 1 51 50 22 21 20 14 2 35 34 39 55 30 1 51 50 54 53 52 38 35 34 7 236 64 52 5 3 23 54 30 65 68 24 40 53 28 47 46 2 21 40 17 40 52 39 46 39 46 234 107 1 199 36 18 26 89 75 41 65 45 23 37 46 17 13 63 57 51 61 40 0 0 2 0 137 0 127 1 182 2 78 0 20 0 32 0 84 0 184 0 13 47 184 0 0 69 88 184 0 10 47 27 185 0 10 0 9 62 89 187 0 5 0 1 0 30 0 4 43 187 0 24 0 1 0 18 0 4 43 186 0 9 0 5 0 18 17 18 57 186 0 15 0 18 0 30 17 18 57 184 0 15 16 185 0 26 0 1 244 184 0 9 16 185 0 27 0 1 244 48 49 19 52 62 2 51 50 22 23 51 55 51 17 35 53 55 14 1 35 34 38 55 20 22 51 50 55 53 46 1 35 34 6 137 24 40 53 29 29 44 23 2 5 52 64 3 20 52 29 63 76 66 46 42 43 40 21 38 20 39 53 1 165 39 63 44 23 19 20 31 254 57 112 55 17 25 88 81 55 61 40 161 17 14 62 0 1 0 243 1 4 1 240 2 78 0 17 0 54 0 184 0 16 47 184 0 0 69 88 184 0 1 47 27 185 0 1 0 9 62 89 187 0 6 0 1 0 12 0 4 43 186 0 2 0 16 0 1 17 18 57 184 0 2 16 185 0 15 0 1 244 48 49 19 51 23 51 62 1 51 50 23 7 46 1 35 34 6 7 21 35 243 54 5 2 23 66 39 35 29 13 17 25 18 31 61 24 64 2 70 75 39 44 13 54 5 5 40 50 183 0 0 1 0 162 0 252 1 195 2 78 0 45 0 43 0 187 0 3 0 1 0 42 0 4 43 187 0 19 0 1 0 26 0 4 43 186 0 6 0 42 0 26 17 18 57 186 0 29 0 19 0 3 17 18 57 48 49 19 30 1 51 50 54 53 52 46 2 39 46 3 53 52 54 51 50 22 23 7 46 1 35 34 6 21 20 30 2 23 30 3 21 20 6 35 34 38 39 192 26 55 37 40 38 15 25 32 16 21 43 34 22 71 64 36 63 23 30 20 45 27 38 33 14 24 30 16 22 44 35 22 73 70 43 76 27 1 83 18 20 26 19 11 17 14 10 5 6 16 22 29 21 40 53 22 15 40 13 16 25 17 11 15 12 10 5 6 15 22 31 23 41 57 26 19 0 0 0 1 0 164 0 252 1 207 2 160 0 23 0 73 0 184 0 0 69 88 184 0 6 47 27 185 0 6 0 9 62 89 184 0 0 69 88 184 0 5 47 27 185 0 5 0 13 62 89 187 0 13 0 1 0 20 0 4 43 184 0 6 16 185 0 0 0 1 244 184 0 6 16 184 0 3 208 184 0 0 16 184 0 9 208 48 49 19 35 53 63 1 51 21 51 21 35 21 20 22 51 50 54 55 23 14 1 35 34 38 53 241 77 80 8 53 145 145 34 45 20 31 15 13 20 48 26 72 56 2 19 48 3 90 90 51 144 42 42 8 6 46 8 11 74 61 0 0 0 1 0 159 0 252 1 187 2 70 0 20 0 65 0 184 0 0 69 88 184 0 11 47 27 185 0 11 0 9 62 89 184 0 0 69 88 184 0 20 47 27 185 0 20 0 9 62 89 187 0 15 0 1 0 6 0 4 43 186 0 2 0 6 0 20 17 18 57 184 0 2 16 184 0 18 208 48 49 1 35 39 35 14 1 35 34 38 61 1 51 21 20 22 51 50 54 55 53 51 1 187 52 6 2 23 57 37 55 52 64 30 35 26 41 24 64 1 4 51 26 33 65 62 203 195 42 38 23 28 224 0 0 1 0 147 1 4 1 205 2 70 0 13 0 51 0 184 0 12 47 184 0 0 69 88 184 0 10 47 27 185 0 10 0 9 62 89 184 0 0 69 88 184 0 1 47 27 185 0 1 0 9 62 89 184 0 12 16 185 0 6 0 1 244 48 49 19 51 23 30 1 23 51 62 1 63 1 51 3 35 147 66 61 9 14 8 2 8 15 8 62 61 118 74 2 70 176 24 48 24 24 48 24 176 254 190 0 0 0 0 1 0 82 1 4 1 220 2 70 0 33 0 90 0 184 0 23 47 184 0 0 69 88 184 0 0 47 27 185 0 0 0 9 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 9 62 89 184 0 0 69 88 184 0 20 47 27 185 0 20 0 9 62 89 184 0 23 16 185 0 15 0 1 244 184 0 6 208 184 0 10 16 185 0 28 0 1 244 184 0 23 16 184 0 32 208 48 49 19 51 23 30 1 23 51 62 1 63 1 51 23 30 1 23 51 62 1 63 1 51 3 35 39 46 1 39 35 14 1 15 1 35 82 64 37 5 6 4 3 4 9 5 36 51 37 5 8 5 3 5 6 5 36 60 67 77 35 5 7 5 3 4 7 6 34 74 2 70 178 23 45 23 23 45 23 154 154 23 45 23 23 45 23 178 254 190 151 23 45 25 20 44 29 151 0 1 0 159 1 4 1 203 2 70 0 25 0 75 0 184 0 15 47 184 0 24 47 184 0 0 69 88 184 0 1 47 27 185 0 1 0 9 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 9 62 89 186 0 19 0 15 0 11 17 18 57 184 0 19 16 184 0 0 208 184 0 19 16 184 0 13 208 184 0 6 208 48 49 1 39 51 23 30 1 23 51 62 1 63 1 51 7 23 35 39 46 1 39 35 14 1 15 1 35 1 14 102 68 43 8 17 8 3 8 15 8 38 68 104 111 69 47 8 20 10 2 8 17 9 43 67 1 172 154 66 14 26 14 14 26 14 66 161 161 70 15 29 14 14 29 15 70 0 0 1 0 140 0 124 1 204 2 70 0 27 0 65 0 184 0 0 69 88 184 0 18 47 27 185 0 18 0 9 62 89 184 0 0 69 88 184 0 9 47 27 185 0 9 0 9 62 89 187 0 3 0 1 0 23 0 4 43 186 0 14 0 23 0 18 17 18 57 184 0 14 16 184 0 7 208 48 49 55 30 1 51 50 54 63 1 3 51 23 30 1 23 51 62 1 63 1 51 3 14 1 35 34 38 39 55 168 5 14 7 29 37 11 7 138 64 69 8 17 9 2 8 14 7 60 62 130 19 60 53 13 21 9 13 180 1 3 35 28 23 1 64 170 20 47 23 22 47 21 170 254 169 51 64 4 3 49 0 0 0 1 0 146 1 4 1 200 2 70 0 9 0 52 0 184 0 9 47 184 0 0 69 88 184 0 3 47 27 185 0 3 0 9 62 89 184 0 9 16 185 0 6 0 1 244 184 0 0 208 184 0 3 16 185 0 1 0 1 244 184 0 5 208 48 49 19 55 35 53 33 21 7 51 21 33 146 213 189 1 23 212 219 254 202 1 38 237 51 34 237 51 0 3 0 160 0 252 1 201 2 227 0 25 0 32 0 36 0 58 0 184 0 0 69 88 184 0 33 47 27 185 0 33 0 15 62 89 187 0 14 0 1 0 21 0 4 43 187 0 5 0 1 0 29 0 4 43 187 0 10 0 1 0 26 0 4 43 184 0 33 16 184 0 35 220 48 49 19 52 62 2 51 50 22 21 20 7 35 30 1 51 50 54 55 23 14 1 35 34 46 2 55 52 38 35 34 6 7 19 51 23 35 160 27 43 57 30 68 72 3 231 4 61 47 24 42 20 23 24 59 35 35 60 45 26 241 43 40 35 55 6 11 69 60 49 1 165 39 63 44 23 83 69 20 12 49 55 13 12 41 14 20 23 43 63 66 45 48 48 45 1 36 101 0 3 0 160 0 252 1 201 2 227 0 25 0 32 0 36 0 58 0 184 0 0 69 88 184 0 35 47 27 185 0 35 0 15 62 89 187 0 14 0 1 0 21 0 4 43 187 0 5 0 1 0 29 0 4 43 187 0 10 0 1 0 26 0 4 43 184 0 35 16 184 0 33 220 48 49 19 52 62 2 51 50 22 21 20 7 35 30 1 51 50 54 55 23 14 1 35 34 46 2 55 52 38 35 34 6 7 55 35 55 51 160 27 43 57 30 68 72 3 231 4 61 47 24 42 20 23 24 59 35 35 60 45 26 241 43 40 35 55 6 96 48 61 68 1 165 39 63 44 23 83 69 20 12 49 55 13 12 41 14 20 23 43 63 66 45 48 48 45 191 101 0 0 2 0 154 0 252 1 194 2 78 0 24 0 31 0 33 0 187 0 28 0 1 0 22 0 4 43 187 0 14 0 1 0 7 0 4 43 187 0 25 0 1 0 3 0 4 43 48 49 19 52 54 55 51 46 1 35 34 6 7 39 62 1 51 50 22 21 20 14 2 35 34 38 55 20 22 51 50 54 55 154 2 2 229 3 51 47 26 42 21 22 24 59 35 71 86 24 41 55 32 67 77 57 45 41 39 47 5 1 152 9 17 6 47 53 14 12 41 16 19 88 81 39 63 43 24 84 62 48 48 49 47 0 2 0 137 0 252 1 182 2 78 0 11 0 32 0 84 0 184 0 25 47 184 0 0 69 88 184 0 22 47 27 185 0 22 0 9 62 89 187 0 3 0 1 0 30 0 4 43 187 0 17 0 1 0 9 0 4 43 186 0 26 0 30 0 17 17 18 57 184 0 26 16 185 0 5 0 1 244 186 0 21 0 17 0 30 17 18 57 184 0 21 16 185 0 6 0 1 244 48 49 19 20 22 51 50 55 53 46 1 35 34 6 7 52 62 2 51 50 22 23 51 55 51 17 35 39 35 14 1 35 34 38 203 46 42 44 39 20 40 20 38 53 66 24 40 53 29 28 45 23 2 5 52 53 5 2 20 53 29 63 76 1 165 55 61 40 161 17 14 62 54 39 63 44 23 19 20 31 254 190 37 19 26 88 0 2 0 137 0 121 1 182 2 78 0 31 0 44 0 90 0 184 0 0 69 88 184 0 23 47 27 185 0 23 0 9 62 89 187 0 3 0 1 0 28 0 4 43 187 0 18 0 1 0 39 0 4 43 187 0 32 0 1 0 10 0 4 43 186 0 7 0 10 0 18 17 18 57 186 0 22 0 18 0 10 17 18 57 184 0 7 16 185 0 35 0 1 244 184 0 22 16 185 0 36 0 1 244 48 49 55 30 1 51 50 54 63 1 14 1 35 34 38 53 52 62 2 51 50 22 23 51 55 51 17 20 6 35 34 38 39 55 50 54 55 53 46 1 35 34 6 21 20 22 183 25 52 23 45 45 1 1 19 51 29 63 76 25 40 53 28 28 45 22 1 6 53 81 74 31 65 27 131 23 40 20 20 40 20 38 54 47 200 16 13 42 36 56 17 24 87 75 37 61 43 23 19 19 30 254 178 60 67 18 17 160 21 21 148 17 14 60 50 51 60 0 0 0 0 2 0 175 1 173 1 170 2 173 0 19 0 31 0 23 0 187 0 10 0 1 0 26 0 4 43 187 0 20 0 1 0 0 0 4 43 48 49 1 34 46 2 53 52 62 2 51 50 30 2 21 20 14 2 39 50 54 53 52 38 35 34 6 21 20 22 1 44 25 45 35 20 20 35 45 25 25 46 34 21 21 34 46 25 34 42 42 34 33 42 42 1 173 18 33 47 29 30 47 34 18 18 34 47 30 29 47 33 18 46 46 35 37 46 46 37 35 46 0 0 2 0 58 0 83 2 30 2 65 0 32 0 52 0 23 0 187 0 38 0 1 0 29 0 4 43 187 0 12 0 1 0 48 0 4 43 48 49 63 1 46 1 53 52 54 55 39 55 23 54 51 50 23 55 23 7 30 1 21 20 6 7 23 7 39 14 1 35 34 39 7 55 20 30 2 51 50 62 2 53 52 46 2 35 34 14 2 58 84 17 19 18 17 83 44 87 48 63 62 49 87 44 84 17 19 19 17 84 44 88 23 57 30 62 49 87 80 19 32 43 24 24 43 32 19 19 32 43 24 24 43 32 19 128 85 23 58 35 35 59 23 86 45 90 37 37 90 45 86 23 59 35 35 58 23 85 45 89 19 19 38 89 246 30 49 36 19 19 36 49 30 30 49 36 19 19 36 49 0 0 1 0 85 255 146 2 0 2 236 0 49 0 71 0 184 0 22 47 184 0 44 47 184 0 43 220 185 0 5 0 1 244 184 0 22 16 184 0 23 220 186 0 8 0 23 0 43 17 18 57 184 0 20 208 184 0 23 16 185 0 30 0 1 244 186 0 33 0 43 0 23 17 18 57 184 0 43 16 184 0 46 208 48 49 1 46 3 35 34 6 21 20 30 4 21 20 14 2 7 21 35 53 46 1 39 55 30 1 51 50 54 53 52 46 4 53 52 54 55 53 51 21 30 1 23 1 195 17 31 34 40 25 51 59 47 71 82 71 47 25 47 65 39 60 56 100 35 39 38 91 57 60 61 47 70 83 70 47 89 73 60 55 74 30 1 237 13 21 15 8 45 38 28 36 30 30 42 60 46 32 55 41 27 4 146 145 5 44 29 57 27 41 49 38 31 41 32 30 41 57 44 63 80 8 132 131 5 42 29 0 0 0 1 0 77 0 0 2 19 2 138 0 41 0 87 0 184 0 0 69 88 184 0 19 47 27 185 0 19 0 11 62 89 184 0 0 69 88 184 0 1 47 27 185 0 1 0 3 62 89 187 0 8 0 1 0 11 0 4 43 184 0 1 16 185 0 0 0 1 244 184 0 3 208 184 0 19 16 185 0 26 0 1 244 184 0 11 16 184 0 32 208 184 0 8 16 184 0 35 208 48 49 37 21 33 53 62 1 53 52 39 35 53 55 46 1 53 52 62 2 51 50 22 23 7 46 1 35 34 6 21 20 22 23 51 21 35 22 21 20 6 7 21 2 19 254 59 63 61 8 117 99 11 21 30 55 77 48 62 85 29 48 23 59 42 66 69 19 11 189 173 6 37 38 71 71 50 28 95 57 26 29 52 4 32 61 32 42 68 48 26 43 32 47 23 30 65 52 32 59 32 56 27 29 53 70 31 4 0 0 1 0 53 0 0 2 35 2 126 0 29 0 108 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 11 62 89 184 0 0 69 88 184 0 9 47 27 185 0 9 0 11 62 89 184 0 0 69 88 184 0 19 47 27 185 0 19 0 3 62 89 186 0 5 0 19 0 9 17 18 57 184 0 5 16 184 0 11 208 185 0 14 0 1 244 184 0 25 208 184 0 24 220 184 0 15 208 185 0 18 0 1 244 184 0 21 208 184 0 11 16 184 0 28 208 48 49 19 23 30 1 23 51 62 1 63 1 51 3 51 21 35 21 51 21 35 21 35 53 35 53 51 53 35 53 51 3 138 92 17 33 19 4 18 34 18 92 82 186 162 183 183 183 82 181 181 181 161 185 2 126 171 33 67 35 35 67 33 171 254 192 47 65 48 158 158 48 65 47 1 64 0 1 0 58 255 244 2 54 2 138 0 49 0 109 0 184 0 0 69 88 184 0 21 47 27 185 0 21 0 11 62 89 184 0 0 69 88 184 0 3 47 27 185 0 3 0 3 62 89 186 0 40 0 34 0 3 43 184 0 40 16 185 0 43 0 1 244 184 0 6 208 184 0 40 16 184 0 9 208 184 0 34 16 184 0 15 208 184 0 34 16 185 0 31 0 1 244 184 0 18 208 184 0 21 16 185 0 28 0 1 244 184 0 3 16 185 0 46 0 1 244 48 49 37 14 1 35 34 38 39 35 53 55 38 52 53 60 1 55 35 53 55 62 1 51 50 22 23 7 46 1 35 34 6 7 33 21 33 6 20 21 28 1 23 33 21 35 30 1 51 50 54 55 2 54 38 92 62 98 135 19 64 59 1 1 59 64 19 141 106 51 88 30 49 26 59 38 74 90 14 1 38 254 213 1 1 1 3 253 14 88 69 43 65 30 81 44 49 129 118 43 4 9 18 9 8 16 8 44 5 118 133 45 33 47 26 33 98 87 49 7 14 8 10 19 9 48 85 96 36 35 0 0 2 0 113 255 223 1 250 2 141 0 6 0 37 0 92 0 184 0 0 69 88 184 0 24 47 27 185 0 24 0 11 62 89 187 0 34 0 1 0 10 0 4 43 187 0 26 0 1 0 33 0 4 43 184 0 33 16 184 0 0 208 184 0 0 47 184 0 34 16 184 0 6 208 184 0 6 47 184 0 10 16 184 0 13 208 184 0 13 47 184 0 12 220 184 0 26 16 184 0 23 208 184 0 23 47 48 49 1 14 1 21 20 22 31 1 14 1 7 21 35 53 46 3 53 52 62 2 55 53 51 21 30 1 23 7 46 1 39 17 62 1 55 1 58 56 64 63 57 192 30 72 39 51 45 74 53 29 31 54 74 42 51 44 64 23 40 20 45 26 32 52 21 1 221 13 88 66 67 88 13 9 26 34 3 103 104 5 36 61 84 53 52 83 60 36 6 106 103 2 34 22 52 18 22 2 254 168 2 27 18 0 0 1 0 49 255 159 2 24 2 156 0 40 0 66 0 184 0 0 69 88 184 0 37 47 27 185 0 37 0 13 62 89 187 0 25 0 1 0 18 0 4 43 187 0 10 0 1 0 11 0 4 43 184 0 37 16 185 0 3 0 1 244 184 0 11 16 184 0 29 208 184 0 10 16 184 0 33 208 48 49 1 46 1 35 34 14 2 15 1 51 21 35 7 14 3 35 34 38 39 55 30 1 51 50 54 63 1 35 53 55 51 55 62 1 51 50 22 23 2 4 14 31 22 25 35 24 14 3 7 142 149 27 6 23 40 62 44 26 42 15 16 14 29 16 52 45 10 24 104 70 41 6 13 80 84 26 48 17 2 74 7 8 22 36 47 25 63 63 237 46 75 54 30 11 7 62 5 8 79 77 219 59 4 56 100 104 12 8 0 3 0 96 255 146 2 34 2 236 0 9 0 16 0 55 0 177 0 184 0 0 69 88 184 0 38 47 27 185 0 38 0 11 62 89 184 0 0 69 88 184 0 23 47 27 185 0 23 0 3 62 89 184 0 26 208 185 0 0 0 1 244 184 0 23 16 185 0 2 0 1 244 184 0 38 16 185 0 9 0 1 244 184 0 3 208 184 0 9 16 184 0 10 208 184 0 0 16 184 0 16 208 184 0 23 16 184 0 20 208 184 0 23 16 184 0 22 220 184 0 27 208 184 0 26 16 184 0 29 208 184 0 38 16 184 0 35 208 184 0 38 16 184 0 37 220 184 0 3 16 185 0 41 0 1 244 184 0 37 16 184 0 42 208 184 0 41 16 184 0 44 208 184 0 3 16 184 0 51 208 184 0 2 16 184 0 52 208 184 0 52 47 48 49 37 22 23 19 46 1 35 42 1 15 1 14 1 21 20 22 23 5 14 1 15 1 35 55 46 1 39 7 35 55 46 1 53 52 54 63 1 51 7 51 50 23 55 51 7 30 1 23 7 46 1 39 3 62 1 55 1 31 23 33 62 10 19 11 5 8 5 39 62 65 36 35 1 38 35 84 54 12 38 12 15 28 14 13 38 15 68 78 118 103 12 38 12 15 20 23 12 38 14 26 45 17 49 11 23 13 60 35 55 26 71 13 3 2 12 2 3 1 8 21 133 100 76 115 33 16 40 48 4 99 99 1 5 4 109 124 35 156 113 138 171 18 103 98 5 103 114 11 32 19 47 11 19 8 254 4 5 35 30 0 0 0 1 0 78 0 0 2 19 2 138 0 52 0 135 0 184 0 0 69 88 184 0 25 47 27 185 0 25 0 11 62 89 184 0 0 69 88 184 0 1 47 27 185 0 1 0 3 62 89 187 0 14 0 1 0 17 0 4 43 184 0 1 16 185 0 0 0 1 244 184 0 3 208 184 0 14 16 185 0 11 0 1 244 185 0 7 0 1 244 184 0 11 16 184 0 9 208 184 0 17 16 184 0 16 208 184 0 25 16 185 0 32 0 1 244 184 0 17 16 184 0 39 208 184 0 14 16 184 0 40 208 184 0 11 16 184 0 45 208 184 0 7 16 184 0 46 208 48 49 37 21 33 53 62 1 61 1 35 53 55 51 46 1 39 35 53 55 46 1 53 52 62 2 51 50 22 23 7 46 1 35 34 6 21 20 22 23 51 21 35 30 1 23 51 21 35 21 20 6 7 21 2 19 254 59 63 61 124 87 30 4 11 5 97 80 6 8 30 55 77 48 62 85 29 48 23 59 42 66 69 7 6 206 190 5 9 3 173 167 37 38 71 71 50 28 95 57 5 44 5 15 29 15 45 4 18 37 19 42 68 48 26 43 32 47 23 30 65 52 19 35 18 49 14 30 15 49 6 53 70 31 4 0 0 0 5 0 47 0 0 2 39 2 126 0 5 0 9 0 15 0 19 0 47 0 203 0 184 0 0 69 88 184 0 39 47 27 185 0 39 0 11 62 89 184 0 0 69 88 184 0 43 47 27 185 0 43 0 11 62 89 184 0 0 69 88 184 0 29 47 27 185 0 29 0 3 62 89 184 0 0 69 88 184 0 26 47 27 185 0 26 0 3 62 89 184 0 39 16 184 0 16 220 185 0 13 0 1 244 184 0 2 208 184 0 13 16 184 0 15 208 184 0 4 208 184 0 15 16 185 0 28 0 1 244 184 0 7 208 184 0 26 16 185 0 8 0 1 244 184 0 39 16 185 0 19 0 1 244 184 0 2 16 184 0 20 208 184 0 4 16 184 0 21 208 184 0 7 16 184 0 24 208 184 0 28 16 184 0 31 208 184 0 15 16 184 0 34 208 184 0 13 16 184 0 35 208 184 0 16 16 184 0 38 208 184 0 16 16 184 0 41 208 184 0 45 208 48 49 1 53 35 31 1 51 23 35 23 51 47 1 53 35 23 21 39 51 39 35 5 21 51 21 35 21 35 39 35 21 35 53 35 53 55 53 35 53 55 53 51 23 51 53 51 21 51 21 1 158 90 19 5 68 3 55 62 4 149 24 72 1 4 59 67 4 1 53 72 72 84 97 112 65 74 74 74 74 84 102 107 65 72 1 61 26 46 14 43 166 209 59 1 22 38 102 178 220 60 43 240 240 240 240 38 5 60 37 5 253 253 253 253 42 0 0 3 0 43 0 0 2 42 2 126 0 5 0 11 0 33 0 99 0 184 0 0 69 88 184 0 27 47 27 185 0 27 0 11 62 89 184 0 0 69 88 184 0 20 47 27 185 0 20 0 3 62 89 187 0 4 0 1 0 7 0 4 43 187 0 19 0 1 0 5 0 4 43 184 0 27 16 185 0 11 0 1 244 184 0 4 16 184 0 13 208 184 0 4 16 184 0 23 208 184 0 7 16 184 0 24 208 184 0 7 16 184 0 32 208 48 49 1 50 54 55 35 21 17 21 51 46 1 35 5 35 14 3 43 1 21 35 17 35 53 55 53 51 50 30 2 23 51 1 0 69 78 8 214 214 8 78 69 1 42 64 5 37 60 77 45 69 79 75 75 148 45 78 59 37 5 64 1 46 58 57 115 1 23 108 59 49 164 44 65 42 21 245 1 161 51 5 165 18 39 63 45 0 0 0 3 0 109 0 0 2 34 2 153 0 3 0 18 0 47 0 86 0 184 0 0 69 88 184 0 2 47 27 185 0 2 0 3 62 89 187 0 36 0 1 0 7 0 4 43 184 0 2 16 185 0 0 0 1 244 185 0 28 0 1 244 185 0 15 0 1 244 184 0 36 16 184 0 21 220 184 0 41 208 184 0 21 16 185 0 47 0 1 244 184 0 43 208 184 0 47 16 184 0 46 220 48 49 55 33 21 33 1 46 1 35 34 14 2 21 20 22 51 50 54 55 19 21 7 17 35 39 35 14 1 35 34 38 53 52 62 2 51 50 22 23 39 53 35 53 51 53 51 21 121 1 122 254 134 1 20 27 45 30 23 41 31 18 57 52 28 52 26 149 78 58 6 4 23 62 39 76 91 29 49 63 33 39 53 26 4 155 155 71 49 49 1 121 22 19 18 32 43 25 62 69 25 28 1 120 44 5 254 83 43 23 30 97 92 41 66 47 25 24 22 83 34 49 67 67 0 0 0 4 0 43 0 0 2 42 2 126 0 8 0 13 0 19 0 52 0 141 0 184 0 0 69 88 184 0 47 47 27 185 0 47 0 11 62 89 184 0 0 69 88 184 0 37 47 27 185 0 37 0 3 62 89 187 0 9 0 1 0 35 0 4 43 184 0 47 16 185 0 14 0 1 244 184 0 16 208 185 0 6 0 1 244 184 0 0 220 185 0 11 0 1 244 184 0 6 16 184 0 21 208 184 0 0 16 184 0 27 208 184 0 11 16 184 0 29 208 184 0 11 16 184 0 39 208 184 0 0 16 184 0 42 208 184 0 6 16 184 0 43 208 184 0 16 16 184 0 46 208 184 0 16 16 184 0 51 208 48 49 1 62 1 53 52 38 39 35 21 23 50 55 35 21 17 21 51 46 1 35 5 35 30 1 21 28 1 7 51 21 35 14 3 43 1 21 35 17 35 53 55 53 35 53 55 53 51 50 22 23 51 1 155 1 1 1 1 214 59 112 33 204 201 17 71 54 1 42 65 1 1 1 64 72 10 41 56 70 39 69 79 75 75 75 75 148 78 115 21 74 1 162 6 13 7 9 16 8 59 116 75 75 1 23 63 34 29 104 8 16 9 7 13 6 41 34 49 33 16 245 1 121 36 5 59 37 4 120 55 65 0 0 1 0 84 255 146 2 14 2 236 0 42 0 117 0 184 0 0 69 88 184 0 15 47 27 185 0 15 0 11 62 89 184 0 0 69 88 184 0 18 47 27 185 0 18 0 11 62 89 184 0 0 69 88 184 0 2 47 27 185 0 2 0 3 62 89 184 0 0 69 88 184 0 5 47 27 185 0 5 0 3 62 89 187 0 42 0 1 0 39 0 4 43 184 0 2 16 184 0 3 220 184 0 18 16 184 0 17 220 184 0 18 16 185 0 25 0 1 244 184 0 5 16 185 0 35 0 1 244 48 49 37 6 7 21 35 53 46 3 53 52 62 2 55 53 51 21 30 1 23 7 46 1 35 34 14 2 21 20 30 2 51 50 54 55 53 35 53 51 2 14 67 88 60 50 84 60 33 32 59 84 52 60 46 79 27 49 26 59 38 44 67 47 24 24 45 65 42 32 58 16 116 191 61 62 9 100 100 6 50 84 116 72 70 115 85 51 8 101 99 4 44 31 46 27 33 37 68 98 60 62 98 68 37 22 15 169 69 0 0 0 2 0 96 255 146 2 34 2 233 0 6 0 37 0 123 0 184 0 0 69 88 184 0 23 47 27 185 0 23 0 11 62 89 184 0 0 69 88 184 0 26 47 27 185 0 26 0 11 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 3 62 89 184 0 0 69 88 184 0 13 47 27 185 0 13 0 3 62 89 184 0 23 16 185 0 0 0 1 244 184 0 13 16 185 0 6 0 1 244 184 0 13 16 184 0 12 220 184 0 26 16 184 0 25 220 184 0 0 16 184 0 33 208 184 0 6 16 184 0 34 208 48 49 1 14 1 21 20 22 23 55 14 1 7 21 35 53 46 3 53 52 62 2 55 53 51 21 30 1 23 7 46 1 39 17 62 1 55 1 74 72 77 77 72 216 33 79 51 53 52 86 62 34 33 61 87 53 53 47 79 28 49 23 50 32 34 54 26 2 69 14 138 108 112 140 13 25 38 48 5 100 99 5 49 84 118 73 71 116 84 52 7 97 96 3 43 31 47 23 31 4 253 241 5 35 29 0 0 0 1 0 108 0 0 2 12 2 126 0 29 0 112 0 184 0 0 69 88 184 0 28 47 27 185 0 28 0 11 62 89 184 0 0 69 88 184 0 29 47 27 185 0 29 0 11 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 3 62 89 184 0 29 16 185 0 1 0 1 244 184 0 26 208 184 0 23 208 184 0 4 208 184 0 23 16 185 0 19 0 1 244 184 0 7 208 184 0 19 16 184 0 16 208 185 0 13 0 1 244 184 0 10 208 184 0 10 47 48 49 1 35 30 1 23 51 21 35 14 1 7 19 35 39 35 53 51 50 54 55 33 53 55 51 46 1 43 1 53 33 2 12 157 33 43 8 73 71 5 93 73 208 94 199 89 79 83 96 5 254 249 76 184 12 93 76 79 1 160 2 77 15 53 35 49 76 88 14 254 253 252 67 58 60 44 5 46 38 68 0 0 0 0 1 0 56 255 242 2 24 2 126 0 36 0 93 0 184 0 0 69 88 184 0 26 47 27 185 0 26 0 11 62 89 184 0 0 69 88 184 0 17 47 27 185 0 17 0 3 62 89 185 0 0 0 1 244 186 0 32 0 17 0 26 17 18 57 184 0 32 16 184 0 35 208 184 0 18 208 184 0 32 16 184 0 21 208 184 0 31 208 184 0 22 208 184 0 31 16 184 0 28 208 184 0 25 208 48 49 55 62 3 53 52 38 39 55 30 1 21 20 14 2 39 17 7 53 55 53 7 53 55 53 51 21 55 21 7 21 55 21 7 21 244 37 78 65 41 1 5 69 5 3 58 102 137 79 104 104 104 104 84 182 182 182 182 66 1 22 41 61 39 8 21 14 18 17 27 13 63 94 62 29 2 1 17 48 53 48 72 48 52 49 199 158 86 53 86 72 86 52 87 236 0 0 0 0 2 0 28 0 32 2 60 2 112 0 3 0 7 0 11 0 186 0 7 0 3 0 3 43 48 49 63 1 23 7 1 7 39 55 28 183 33 167 1 239 183 33 167 77 188 30 203 2 35 188 30 203 0 0 0 255 255 0 28 0 32 2 60 2 112 2 6 2 136 0 0 255 255 0 28 0 32 2 60 2 112 2 6 2 136 0 0 255 255 0 28 255 244 2 61 2 138 2 39 2 56 255 123 1 77 0 38 2 136 0 0 0 7 2 56 0 134 0 0 0 7 0 48 255 244 2 63 2 138 0 11 0 23 0 27 0 39 0 51 0 63 0 75 0 118 0 184 0 0 69 88 184 0 6 47 27 185 0 6 0 11 62 89 184 0 0 69 88 184 0 28 47 27 185 0 28 0 3 62 89 184 0 0 69 88 184 0 52 47 27 185 0 52 0 3 62 89 187 0 34 0 1 0 46 0 4 43 187 0 12 0 1 0 0 0 4 43 184 0 6 16 185 0 18 0 1 244 184 0 28 16 185 0 40 0 1 244 184 0 34 16 184 0 58 208 184 0 40 16 184 0 64 208 184 0 46 16 184 0 70 208 48 49 19 34 38 53 52 54 51 50 22 21 20 6 39 50 54 53 52 38 35 34 6 21 20 22 37 5 39 37 1 34 38 53 52 54 51 50 22 21 20 6 39 50 54 53 52 38 35 34 6 21 20 22 5 34 38 53 52 54 51 50 22 21 20 6 39 50 54 53 52 38 35 34 6 21 20 22 165 52 65 65 52 52 65 65 52 27 35 35 27 27 36 36 1 181 254 56 14 1 190 254 126 52 65 65 52 52 65 65 52 27 35 35 27 27 36 36 1 42 52 65 65 52 52 65 65 52 27 35 35 27 27 36 36 1 133 69 63 61 68 68 61 63 69 42 43 47 45 42 42 45 47 43 21 174 31 201 253 246 69 63 61 68 68 61 63 69 42 43 47 45 41 41 45 47 43 42 69 63 61 68 68 61 63 69 42 43 47 45 41 41 45 47 43 0 0 0 255 255 0 28 0 0 2 63 2 126 2 39 2 57 255 123 1 77 0 38 2 136 0 0 0 7 2 60 0 134 0 0 255 255 0 28 0 0 2 60 2 126 2 39 2 57 255 123 1 77 0 38 2 136 0 0 0 7 2 58 0 135 0 0 255 255 0 39 0 0 2 85 2 138 2 39 2 59 255 123 1 77 0 38 2 136 25 0 0 7 2 60 0 134 0 0 255 255 0 28 255 244 2 60 2 126 2 39 2 57 255 123 1 77 0 38 2 136 0 0 0 7 2 59 0 135 0 0 255 255 0 28 255 244 2 60 2 138 2 39 2 58 255 123 1 77 0 38 2 136 0 0 0 7 2 59 0 135 0 0 255 255 0 28 255 244 2 60 2 126 2 39 2 57 255 123 1 77 0 38 2 136 0 0 0 7 2 64 0 135 0 0 255 255 0 28 255 244 2 60 2 138 2 39 2 59 255 123 1 77 0 38 2 136 0 0 0 7 2 64 0 135 0 0 255 255 0 28 255 244 2 60 2 126 2 39 2 61 255 123 1 77 0 38 2 136 0 0 0 7 2 64 0 135 0 0 255 255 0 28 255 244 2 60 2 126 2 39 2 63 255 123 1 77 0 38 2 136 0 0 0 7 2 64 0 135 0 0 0 1 0 85 0 104 2 3 2 44 0 11 0 29 0 187 0 2 0 1 0 1 0 4 43 184 0 2 16 184 0 6 208 184 0 1 16 184 0 9 208 48 49 1 35 53 51 53 51 21 51 21 35 21 35 1 11 182 182 66 182 182 66 1 43 62 195 195 62 195 0 0 0 1 0 85 1 43 2 3 1 105 0 3 0 13 0 187 0 1 0 1 0 2 0 4 43 48 49 19 33 21 33 85 1 174 254 82 1 105 62 0 0 1 0 102 0 126 1 242 2 21 0 11 0 41 0 186 0 5 0 9 0 3 43 186 0 10 0 9 0 5 17 18 57 184 0 10 16 184 0 1 208 184 0 10 16 184 0 7 208 184 0 4 208 48 49 63 1 39 55 23 55 23 7 23 7 39 7 102 154 154 44 154 154 44 154 154 44 154 154 171 159 158 45 159 159 45 158 159 45 160 160 0 0 3 0 85 0 96 2 3 2 51 0 11 0 23 0 27 0 37 0 187 0 25 0 1 0 26 0 4 43 184 0 25 16 184 0 0 220 184 0 6 220 184 0 26 16 184 0 15 220 184 0 21 220 48 49 1 34 38 53 52 54 51 50 22 21 20 6 3 52 54 51 50 22 21 20 6 35 34 38 39 33 21 33 1 44 23 31 31 23 23 31 31 77 31 23 23 31 31 23 23 31 161 1 174 254 82 1 200 30 24 23 30 30 23 24 30 254 206 23 30 30 23 24 30 30 235 62 0 255 255 0 216 1 7 1 122 1 176 2 7 1 227 255 253 1 19 0 0 255 255 0 85 0 193 2 3 1 212 2 38 2 151 0 107 0 6 2 151 0 150 0 0 0 1 0 120 0 48 1 237 2 104 0 7 0 59 0 187 0 0 0 1 0 7 0 4 43 184 0 0 16 184 0 2 208 184 0 2 47 185 0 1 0 1 244 186 0 4 0 0 0 7 17 18 57 184 0 7 16 184 0 5 208 184 0 5 47 185 0 6 0 1 244 48 49 19 37 21 5 21 5 21 37 120 1 117 254 211 1 45 254 139 1 107 253 79 203 4 203 79 253 0 0 1 0 107 0 48 1 224 2 104 0 7 0 59 0 187 0 7 0 1 0 0 0 4 43 184 0 0 16 184 0 2 208 184 0 2 47 185 0 1 0 1 244 186 0 4 0 7 0 0 17 18 57 184 0 7 16 184 0 5 208 184 0 5 47 185 0 6 0 1 244 48 49 1 5 53 37 53 37 53 5 1 224 254 139 1 45 254 211 1 117 1 45 253 79 203 4 203 79 253 0 2 0 85 0 0 2 3 2 21 0 3 0 13 0 78 0 184 0 0 69 88 184 0 2 47 27 185 0 2 0 3 62 89 187 0 4 0 1 0 13 0 4 43 184 0 2 16 185 0 0 0 1 244 186 0 9 0 4 0 13 17 18 57 184 0 9 16 184 0 5 208 185 0 6 0 1 244 184 0 9 16 184 0 12 208 185 0 11 0 1 244 48 49 55 33 21 33 17 37 21 15 1 21 31 1 21 37 85 1 174 254 82 1 174 210 135 135 210 254 82 62 62 1 124 153 71 73 44 4 44 73 71 153 0 0 0 2 0 85 0 0 2 3 2 21 0 3 0 13 0 78 0 184 0 0 69 88 184 0 2 47 27 185 0 2 0 3 62 89 187 0 13 0 1 0 4 0 4 43 184 0 2 16 185 0 0 0 1 244 186 0 8 0 13 0 4 17 18 57 184 0 8 16 184 0 5 208 185 0 6 0 1 244 184 0 8 16 184 0 12 208 185 0 11 0 1 244 48 49 55 33 21 33 1 5 53 63 1 53 47 1 53 5 85 1 174 254 82 1 174 254 82 210 135 135 210 1 174 62 62 1 50 153 71 73 44 4 44 73 71 153 0 2 0 85 0 0 2 3 2 44 0 11 0 15 0 68 0 184 0 0 69 88 184 0 14 47 27 185 0 14 0 3 62 89 187 0 3 0 1 0 0 0 4 43 184 0 3 16 184 0 4 220 184 0 3 16 184 0 6 208 184 0 0 16 184 0 8 208 184 0 14 16 185 0 12 0 1 244 184 0 11 220 48 49 1 35 53 51 53 51 21 51 21 35 21 35 7 33 21 33 1 11 182 182 66 182 182 66 182 1 174 254 82 1 48 62 190 190 62 177 65 62 0 0 0 1 0 111 1 28 1 233 2 158 0 9 0 38 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 13 62 89 184 0 2 220 186 0 5 0 0 0 2 17 18 57 184 0 9 208 48 49 1 51 19 35 47 1 35 15 1 35 1 8 72 153 72 66 49 4 49 66 72 2 158 254 126 176 133 133 176 0 0 0 0 1 0 85 0 65 2 3 2 83 0 19 0 71 0 187 0 7 0 1 0 13 0 4 43 184 0 13 16 184 0 14 220 185 0 17 0 1 244 184 0 0 208 184 0 14 16 184 0 3 208 184 0 13 16 184 0 4 208 184 0 7 16 184 0 8 220 184 0 7 16 184 0 10 208 184 0 0 16 184 0 19 220 48 49 55 35 53 51 55 35 53 33 55 51 7 51 21 35 7 51 21 33 7 35 188 103 139 91 230 1 10 76 61 76 103 139 91 230 254 246 76 61 192 62 152 62 127 127 62 152 62 127 0 0 0 0 1 0 76 0 255 2 12 1 149 0 25 0 39 0 187 0 3 0 1 0 22 0 4 43 187 0 17 0 1 0 8 0 4 43 184 0 3 16 184 0 13 208 184 0 17 16 184 0 25 208 48 49 19 62 1 51 50 30 2 51 50 62 2 55 23 14 1 35 34 46 2 35 34 6 7 76 26 72 38 30 47 41 39 21 12 21 21 18 9 53 26 72 38 30 47 41 39 21 23 41 17 1 22 70 55 26 32 26 7 19 34 26 24 70 54 26 32 26 34 52 0 0 0 255 255 0 76 0 149 2 12 2 0 2 38 2 163 0 107 0 6 2 163 0 150 0 0 0 1 0 85 0 104 2 3 1 105 0 5 0 13 0 187 0 1 0 1 0 4 0 4 43 48 49 19 33 17 35 53 33 85 1 174 66 254 148 1 105 254 255 195 0 1 0 39 255 244 2 49 1 230 0 35 0 82 0 184 0 0 69 88 184 0 16 47 27 185 0 16 0 7 62 89 184 0 0 69 88 184 0 33 47 27 185 0 33 0 3 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 3 62 89 184 0 16 16 185 0 13 0 1 244 184 0 5 208 184 0 18 208 184 0 33 16 185 0 27 0 1 244 48 49 37 52 62 2 55 35 20 6 7 39 62 1 53 35 53 55 33 21 35 14 2 20 21 20 22 51 50 55 23 14 1 35 34 38 1 134 1 2 2 1 185 7 7 83 12 8 95 70 1 196 86 2 3 2 22 23 7 20 11 11 25 19 57 49 110 19 71 86 92 40 103 213 107 5 108 211 99 63 5 68 41 95 89 71 18 26 22 6 63 5 6 62 0 3 255 252 0 150 2 92 1 251 0 37 0 49 0 60 0 90 0 184 0 0 69 88 184 0 19 47 27 185 0 19 0 7 62 89 187 0 41 0 1 0 29 0 4 43 187 0 50 0 1 0 0 0 4 43 187 0 10 0 1 0 55 0 4 43 186 0 32 0 29 0 19 17 18 57 184 0 32 16 184 0 38 208 184 0 15 208 184 0 19 16 185 0 47 0 1 244 184 0 32 16 184 0 52 208 48 49 55 34 46 2 53 52 62 2 51 50 30 2 23 51 62 1 51 50 30 2 21 20 14 2 35 34 38 39 35 14 3 55 30 1 51 50 54 53 52 38 35 34 6 7 50 55 46 1 35 34 6 21 20 22 130 27 49 37 21 23 39 53 31 25 41 35 28 11 4 31 79 54 33 57 41 23 23 41 57 34 55 79 38 4 11 28 35 43 157 33 62 38 45 48 52 48 35 61 201 64 40 25 52 29 36 43 47 170 24 42 56 32 39 62 43 23 16 28 36 21 53 64 25 46 63 37 42 69 48 27 57 62 18 35 29 17 170 62 49 61 43 48 63 49 162 88 49 43 45 41 41 53 0 1 0 77 255 69 2 46 1 230 0 40 0 115 0 184 0 40 47 184 0 0 69 88 184 0 0 47 27 185 0 0 0 7 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 7 62 89 184 0 0 69 88 184 0 31 47 27 185 0 31 0 3 62 89 184 0 0 69 88 184 0 24 47 27 185 0 24 0 3 62 89 184 0 31 16 185 0 5 0 1 244 186 0 28 0 11 0 31 17 18 57 184 0 28 16 185 0 10 0 1 244 184 0 24 16 185 0 18 0 1 244 48 49 19 51 17 20 22 51 50 62 2 55 17 51 14 1 21 20 22 51 58 1 55 23 6 35 34 38 39 35 14 1 35 34 38 39 28 1 30 1 23 35 77 83 52 57 19 38 38 39 20 83 2 3 16 11 4 7 7 12 19 29 38 36 5 3 32 81 47 35 59 20 2 2 2 83 1 230 254 221 67 69 9 24 43 35 1 60 99 207 88 20 16 2 62 8 53 58 56 53 21 32 38 59 52 51 30 0 0 0 2 0 76 255 244 2 11 2 160 0 15 0 49 0 87 0 184 0 0 69 88 184 0 19 47 27 185 0 19 0 13 62 89 184 0 0 69 88 184 0 27 47 27 185 0 27 0 3 62 89 187 0 37 0 1 0 6 0 4 43 184 0 27 16 185 0 0 0 1 244 186 0 40 0 27 0 37 17 18 57 184 0 40 16 185 0 3 0 1 244 184 0 19 16 185 0 46 0 1 244 48 49 37 50 54 55 46 1 35 34 14 2 21 20 30 2 3 62 1 51 50 22 21 20 14 2 35 34 46 2 53 52 62 2 51 50 22 23 54 52 53 52 38 35 34 6 7 1 10 65 89 16 33 70 33 37 55 36 18 18 31 40 90 32 79 47 97 115 38 70 98 59 36 66 50 30 30 56 80 51 41 79 29 1 76 64 32 56 24 56 108 100 42 34 24 41 57 33 30 47 34 18 2 37 32 35 152 155 84 139 99 55 27 49 71 45 49 83 60 34 38 34 8 17 8 125 112 27 24 0 0 0 1 0 186 255 98 1 185 3 21 0 38 0 23 0 187 0 2 0 1 0 35 0 4 43 187 0 15 0 1 0 22 0 4 43 48 49 23 22 51 50 54 53 52 46 2 53 52 62 2 51 50 22 23 7 46 1 35 34 6 21 20 30 2 21 20 14 2 35 34 39 55 195 12 23 42 25 13 16 13 11 31 54 43 15 26 6 10 7 17 11 41 24 13 15 13 11 31 54 43 31 16 9 89 4 82 78 55 126 130 127 56 48 84 61 35 4 2 62 2 2 85 77 54 126 130 127 55 49 84 61 35 7 62 0 0 0 1 0 62 255 161 2 71 3 52 0 15 0 13 0 187 0 4 0 1 0 11 0 4 43 48 49 37 30 1 23 51 62 1 55 19 51 3 35 3 7 39 55 1 56 5 8 4 4 3 5 4 178 60 218 62 150 71 20 134 59 16 32 16 16 32 16 2 249 252 109 1 172 32 45 59 0 2 0 36 0 0 2 53 2 144 0 5 0 11 0 69 0 184 0 0 69 88 184 0 1 47 27 185 0 1 0 13 62 89 184 0 0 69 88 184 0 4 47 27 185 0 4 0 3 62 89 185 0 6 0 1 244 184 0 11 208 184 0 0 208 184 0 6 16 184 0 3 208 184 0 1 16 185 0 8 0 1 244 48 49 55 19 51 19 21 33 37 3 39 35 7 3 36 217 95 217 253 239 1 181 103 68 4 69 102 50 2 94 253 162 50 71 1 44 210 210 254 212 0 0 1 0 29 0 0 2 59 2 156 0 49 0 96 0 184 0 0 69 88 184 0 12 47 27 185 0 12 0 13 62 89 184 0 0 69 88 184 0 48 47 27 185 0 48 0 3 62 89 184 0 0 69 88 184 0 26 47 27 185 0 26 0 3 62 89 184 0 48 16 185 0 1 0 1 244 184 0 26 16 185 0 23 0 1 244 184 0 27 208 184 0 12 16 185 0 37 0 1 244 184 0 1 16 184 0 47 208 48 49 55 51 53 46 3 53 52 62 2 51 50 30 2 21 20 14 2 7 21 51 21 35 53 62 3 53 52 46 2 35 34 14 2 21 20 30 2 23 21 35 29 123 20 40 31 19 36 67 96 59 59 96 67 36 19 31 40 20 123 210 24 41 29 17 23 44 64 41 41 64 44 23 17 29 41 24 210 68 4 21 55 70 83 50 69 116 85 47 47 85 116 69 50 83 70 55 21 4 68 61 22 56 70 85 52 53 91 67 38 38 67 91 53 52 85 70 56 22 61 0 0 0 0 1 0 70 255 136 2 37 2 126 0 13 0 74 0 184 0 0 69 88 184 0 2 47 27 185 0 2 0 11 62 89 187 0 10 0 1 0 11 0 4 43 184 0 2 16 185 0 4 0 1 244 186 0 7 0 10 0 4 17 18 57 184 0 7 16 184 0 0 208 184 0 4 16 184 0 1 208 184 0 10 16 184 0 13 208 48 49 1 3 53 33 21 33 21 19 3 21 33 21 33 53 1 52 227 1 184 254 175 212 222 1 119 254 33 1 3 1 70 53 71 4 254 209 254 207 4 71 53 0 0 0 0 1 0 52 255 136 2 36 2 126 0 7 0 34 0 184 0 6 47 184 0 3 47 184 0 0 69 88 184 0 0 47 27 185 0 0 0 11 62 89 185 0 4 0 1 244 48 49 19 33 17 35 17 33 17 35 52 1 240 85 254 184 83 2 126 253 10 2 173 253 83 0 0 2 0 117 255 244 1 241 2 208 0 9 0 46 0 89 0 184 0 0 69 88 184 0 31 47 27 185 0 31 0 15 62 89 184 0 0 69 88 184 0 13 47 27 185 0 13 0 3 62 89 186 0 0 0 13 0 31 17 18 57 184 0 31 16 185 0 6 0 1 244 184 0 0 16 185 0 37 0 1 244 184 0 18 208 184 0 0 16 184 0 25 208 184 0 13 16 185 0 43 0 1 244 48 49 1 62 1 53 52 38 35 34 6 21 19 14 1 35 34 46 2 39 14 1 7 39 62 1 55 17 52 62 2 51 50 22 21 20 6 7 21 20 30 2 51 50 54 55 1 27 59 66 33 25 27 40 214 25 67 44 31 55 44 27 2 12 26 14 33 23 42 20 22 39 54 31 57 73 103 92 14 25 33 18 30 43 18 1 51 59 128 71 50 42 67 73 254 46 23 40 22 42 64 42 9 17 9 52 14 31 15 1 12 58 82 53 24 80 75 94 173 78 34 35 49 30 14 27 17 0 0 0 2 0 26 255 244 2 62 2 148 0 32 0 50 0 67 0 184 0 0 69 88 184 0 20 47 27 185 0 20 0 13 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 3 62 89 187 0 50 0 1 0 27 0 4 43 184 0 10 16 185 0 3 0 1 244 184 0 20 16 185 0 41 0 1 244 48 49 55 30 1 51 50 54 55 51 14 1 35 34 46 2 53 52 62 2 51 50 30 2 29 1 33 34 29 1 20 22 1 50 61 1 52 39 46 1 35 34 6 7 14 1 29 1 20 51 164 26 71 41 53 94 35 38 41 113 68 57 99 75 43 43 75 99 57 57 99 75 43 254 98 4 5 1 23 6 10 26 70 38 41 71 26 3 5 4 68 29 31 61 51 60 72 53 91 122 70 70 122 91 53 53 91 122 70 8 4 224 6 9 1 5 6 224 12 10 26 28 31 27 5 12 5 220 6 0 0 0 1 0 17 255 241 2 57 2 7 0 9 0 13 0 187 0 4 0 1 0 5 0 4 43 48 49 55 1 23 7 33 21 33 23 7 1 17 1 16 43 201 1 182 254 74 201 43 254 240 254 1 9 46 187 68 187 46 1 9 0 1 0 33 255 231 2 55 2 15 0 9 0 21 0 186 0 0 0 4 0 3 43 186 0 6 0 4 0 0 17 18 57 48 49 9 1 7 39 17 35 17 7 39 1 1 46 1 9 46 187 68 187 46 1 9 2 15 254 240 42 201 254 73 1 183 201 42 1 16 0 0 0 1 0 29 255 241 2 70 2 7 0 9 0 13 0 187 0 6 0 1 0 3 0 4 43 48 49 37 1 39 55 33 53 33 39 55 1 2 70 254 239 42 201 254 73 1 183 201 42 1 17 250 254 247 46 187 68 187 46 254 247 0 0 0 0 1 0 33 255 231 2 55 2 15 0 9 0 21 0 186 0 4 0 0 0 3 43 186 0 6 0 0 0 4 17 18 57 48 49 5 1 55 23 17 51 17 55 23 1 1 42 254 247 46 187 68 187 46 254 247 25 1 17 42 201 1 182 254 74 201 42 254 239 0 0 0 0 1 0 201 0 162 1 143 1 109 0 3 0 11 0 186 0 1 0 2 0 3 43 48 49 19 51 21 35 201 198 198 1 109 203 0 0 1 0 159 0 123 1 185 1 147 0 3 0 11 0 186 0 1 0 3 0 3 43 48 49 19 55 23 7 159 142 140 140 1 7 140 140 140 0 0 0 3 0 119 0 79 1 225 1 191 0 11 0 31 0 51 0 39 0 187 0 32 0 1 0 12 0 4 43 187 0 22 0 1 0 42 0 4 43 184 0 32 16 184 0 0 208 184 0 42 16 184 0 6 208 48 49 37 34 38 53 52 54 51 50 22 21 20 6 7 34 46 2 53 52 62 2 51 50 30 2 21 20 14 2 39 50 62 2 53 52 46 2 35 34 14 2 21 20 30 2 1 44 23 34 34 23 23 34 34 23 37 66 49 29 29 49 66 37 37 66 49 29 29 49 66 37 25 46 36 21 21 36 46 25 25 46 36 21 21 36 46 202 34 27 27 33 33 27 27 34 123 26 48 68 42 42 68 48 26 26 48 68 42 42 68 48 26 49 18 35 50 32 32 51 35 18 18 35 51 32 32 50 35 18 0 0 0 0 2 0 166 0 122 1 178 1 139 0 3 0 9 0 23 0 187 0 0 0 1 0 8 0 4 43 187 0 6 0 1 0 1 0 4 43 48 49 37 53 35 21 39 55 51 21 7 35 1 106 158 38 59 209 49 219 158 165 165 188 49 215 58 0 1 0 38 0 38 2 50 2 22 0 5 0 11 0 186 0 2 0 4 0 3 43 48 49 55 1 51 1 21 33 38 1 5 4 1 3 253 244 40 1 238 254 18 2 0 0 0 0 2 0 38 0 38 2 50 2 22 0 2 0 8 0 13 0 187 0 0 0 1 0 7 0 4 43 48 49 37 11 1 7 1 51 1 21 33 1 204 159 160 103 1 5 4 1 3 253 244 96 1 57 254 199 56 1 238 254 18 2 0 0 0 0 1 0 72 0 19 2 55 2 32 0 5 0 11 0 186 0 1 0 4 0 3 43 48 49 19 51 1 21 1 35 72 2 1 237 254 19 2 2 32 254 252 4 254 251 0 0 0 0 2 0 72 0 19 2 55 2 32 0 2 0 8 0 41 0 186 0 4 0 7 0 3 43 186 0 0 0 7 0 4 17 18 57 186 0 1 0 7 0 4 17 18 57 186 0 2 0 7 0 4 17 18 57 48 49 1 37 17 3 51 1 21 1 35 1 184 254 203 59 2 1 237 254 19 2 1 26 159 254 193 1 166 254 252 4 254 251 0 0 0 0 1 0 38 0 30 2 50 2 13 0 5 0 11 0 186 0 2 0 4 0 3 43 48 49 19 53 33 21 1 35 38 2 12 254 253 4 2 11 2 2 254 19 0 0 2 0 38 0 29 2 50 2 13 0 2 0 8 0 23 0 187 0 3 0 1 0 0 0 4 43 186 0 5 0 0 0 3 17 18 57 48 49 27 2 37 33 21 1 35 1 141 160 159 254 90 2 12 254 253 4 254 251 1 211 254 198 1 58 58 2 254 18 1 238 0 0 1 0 33 0 19 2 16 2 32 0 5 0 11 0 186 0 2 0 3 0 3 43 48 49 19 1 51 17 35 1 33 1 237 2 2 254 19 1 28 1 4 253 243 1 5 0 0 0 2 0 33 0 19 2 16 2 32 0 2 0 8 0 51 0 186 0 8 0 3 0 3 43 186 0 0 0 3 0 8 17 18 57 186 0 1 0 3 0 8 17 18 57 186 0 2 0 3 0 8 17 18 57 186 0 6 0 3 0 8 17 18 57 48 49 37 17 5 1 35 1 53 1 51 1 213 254 203 1 112 2 254 19 1 237 2 122 1 63 159 254 249 1 5 4 1 4 0 0 2 255 231 255 246 2 113 2 159 0 3 0 9 0 40 0 184 0 0 69 88 184 0 8 47 27 185 0 8 0 3 62 89 187 0 6 0 1 0 1 0 4 43 184 0 8 16 185 0 0 0 1 244 48 49 37 17 33 17 3 55 33 17 7 33 2 38 253 235 42 61 2 77 52 253 170 33 2 52 253 204 2 75 51 253 148 61 0 2 255 231 255 246 2 194 3 27 0 18 0 30 0 88 0 184 0 0 69 88 184 0 22 47 27 185 0 22 0 13 62 89 184 0 0 69 88 184 0 27 47 27 185 0 27 0 13 62 89 184 0 0 69 88 184 0 24 47 27 185 0 24 0 3 62 89 187 0 12 0 1 0 3 0 4 43 184 0 22 16 185 0 15 0 1 244 184 0 0 208 184 0 24 16 185 0 17 0 1 244 48 49 1 14 1 15 1 46 1 39 55 30 1 23 51 62 1 55 33 17 33 19 14 1 7 17 7 33 17 55 33 54 55 2 38 68 111 35 86 28 69 43 56 37 61 20 4 32 105 66 254 38 2 21 156 20 41 20 52 253 170 61 1 252 51 57 2 53 95 227 129 10 77 136 64 38 58 126 63 110 218 97 253 204 2 200 20 41 23 253 158 61 2 118 51 67 57 0 0 1 255 250 255 236 2 98 2 172 0 19 0 0 23 46 1 39 55 30 1 23 51 62 3 55 23 14 3 7 145 30 73 48 56 42 67 23 4 27 78 96 110 59 54 59 112 98 82 28 20 83 143 69 38 63 135 67 89 178 165 146 58 50 55 139 164 185 101 0 0 0 0 1 0 77 255 232 2 17 2 182 0 40 0 23 0 184 0 9 47 186 0 5 0 36 0 3 43 184 0 9 16 184 0 30 208 48 49 55 52 62 2 51 50 22 23 17 51 30 3 23 30 3 21 20 6 7 39 62 1 53 52 38 39 17 20 14 2 35 34 46 2 77 23 42 58 35 20 33 8 49 4 9 15 24 19 34 43 26 10 20 12 35 8 5 64 60 28 48 63 34 20 36 28 17 52 23 42 33 19 7 5 2 25 10 15 15 19 13 24 46 47 51 28 39 69 23 13 24 41 27 48 83 19 254 105 41 63 42 21 10 19 28 0 0 0 2 0 98 255 246 1 246 2 158 0 5 0 15 0 53 0 184 0 0 69 88 184 0 1 47 27 185 0 1 0 13 62 89 184 0 0 69 88 184 0 4 47 27 185 0 4 0 3 62 89 185 0 6 0 1 244 184 0 1 16 185 0 10 0 1 244 48 49 27 1 51 19 3 35 63 2 47 1 35 15 1 31 1 98 164 76 164 164 76 40 63 64 64 63 4 63 64 64 63 1 74 1 84 254 172 254 172 69 133 138 137 134 134 137 138 133 0 0 0 0 1 1 0 1 178 1 104 2 178 0 4 0 11 0 186 0 0 0 4 0 3 43 48 49 1 51 15 1 35 1 23 81 16 34 54 2 178 100 156 255 255 0 169 1 178 1 192 2 178 2 38 2 199 169 0 0 6 2 199 88 0 0 0 255 255 0 209 1 94 1 124 2 187 2 6 1 238 0 0 255 255 0 217 1 94 1 132 2 187 2 6 1 239 0 0 0 1 0 245 1 244 1 130 2 217 0 13 0 23 0 187 0 0 0 1 0 13 0 4 43 187 0 7 0 1 0 6 0 4 43 48 49 19 50 54 53 52 38 35 53 54 22 21 20 6 39 245 51 44 44 51 69 72 72 69 2 26 42 35 34 42 36 2 62 52 53 62 2 0 0 0 0 1 0 219 1 244 1 104 2 217 0 13 0 23 0 187 0 6 0 1 0 7 0 4 43 187 0 13 0 1 0 0 0 4 43 48 49 1 34 6 21 20 22 51 21 6 38 53 52 54 23 1 104 51 43 43 51 69 72 72 69 2 179 42 34 35 42 36 2 62 53 52 62 2 0 0 255 255 0 185 2 61 1 109 2 209 2 6 2 223 0 0 255 255 0 235 2 61 1 159 2 209 2 6 2 225 0 0 255 255 0 168 2 61 1 176 2 209 2 6 2 227 0 0 255 255 0 168 2 61 1 176 2 209 2 6 2 245 0 0 0 1 0 249 1 141 1 95 2 204 0 3 0 24 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 15 62 89 184 0 2 220 48 49 19 51 3 35 249 102 23 56 2 204 254 193 0 0 255 255 0 177 2 89 1 167 2 146 2 6 2 231 0 0 255 255 0 235 2 61 1 159 2 209 2 6 2 225 0 0 255 255 0 185 2 61 1 109 2 209 2 6 2 223 0 0 0 1 0 249 255 2 1 95 0 66 0 3 0 11 0 186 0 3 0 0 0 3 43 48 49 5 35 19 51 1 95 102 23 56 254 1 64 0 0 0 255 255 0 158 2 67 1 186 2 176 2 6 2 229 0 0 255 255 0 150 2 76 1 194 2 186 2 6 2 237 0 0 255 255 0 177 2 89 1 167 2 146 2 6 2 231 0 0 255 255 0 170 2 63 1 174 2 197 2 6 2 233 0 0 255 255 0 207 2 30 1 137 2 215 2 6 2 241 0 0 255 255 0 202 2 59 1 236 2 202 2 6 2 243 0 0 255 255 0 234 2 74 1 110 2 201 2 6 2 235 0 0 255 255 0 221 255 43 1 118 0 3 2 6 2 255 6 0 255 255 0 234 255 50 1 147 0 3 2 6 3 1 0 0 0 1 0 185 2 61 1 109 2 209 0 3 0 11 0 186 0 1 0 3 0 3 43 48 49 19 51 23 35 185 90 90 63 2 209 148 0 1 0 169 2 194 1 95 3 50 0 3 0 11 0 186 0 1 0 3 0 3 43 48 49 19 51 23 35 169 94 88 69 3 50 112 0 1 0 235 2 61 1 159 2 209 0 3 0 11 0 186 0 2 0 0 0 3 43 48 49 1 35 55 51 1 42 63 90 90 2 61 148 0 0 0 0 1 0 249 2 194 1 175 3 50 0 3 0 11 0 186 0 2 0 0 0 3 43 48 49 1 35 55 51 1 62 69 88 94 2 194 112 0 0 0 0 1 0 168 2 61 1 176 2 209 0 7 0 25 0 187 0 1 0 1 0 4 0 4 43 184 0 4 16 184 0 3 220 184 0 6 208 48 49 1 51 23 35 39 35 7 35 1 9 70 97 63 67 4 67 63 2 209 148 99 99 0 0 0 0 1 0 164 2 194 1 180 3 50 0 7 0 25 0 187 0 2 0 1 0 5 0 4 43 184 0 5 16 184 0 4 220 184 0 7 208 48 49 19 55 51 23 35 39 35 7 164 96 80 96 67 67 4 67 2 194 112 112 68 68 0 0 0 0 1 0 158 2 67 1 186 2 176 0 22 0 39 0 187 0 8 0 1 0 14 0 4 43 184 0 14 16 184 0 19 220 185 0 3 0 1 244 184 0 10 208 184 0 14 16 184 0 21 208 48 49 19 62 1 51 50 30 2 51 50 55 51 14 1 35 34 46 2 35 34 7 35 158 5 43 40 18 30 25 24 12 31 9 47 5 43 40 18 30 25 24 12 31 9 47 2 67 48 61 17 20 17 54 47 62 17 21 17 55 0 0 1 0 155 2 199 1 189 3 51 0 23 0 43 0 187 0 17 0 1 0 0 0 4 43 184 0 0 16 184 0 5 220 184 0 0 16 184 0 8 208 184 0 5 16 185 0 12 0 1 244 184 0 20 208 48 49 1 34 46 2 35 34 6 7 35 62 1 51 50 30 2 51 50 54 55 51 14 1 1 104 20 32 27 26 14 14 22 4 46 5 44 36 20 32 27 26 14 14 22 4 46 5 44 2 199 16 20 16 26 26 47 61 16 20 16 27 25 46 62 0 1 0 177 2 89 1 167 2 146 0 3 0 13 0 187 0 1 0 1 0 2 0 4 43 48 49 19 51 21 35 177 246 246 2 146 57 0 0 0 0 1 0 176 2 217 1 168 3 18 0 3 0 13 0 187 0 1 0 1 0 2 0 4 43 48 49 19 51 21 35 176 248 248 3 18 57 0 0 0 0 1 0 170 2 63 1 174 2 197 0 19 0 25 0 187 0 9 0 1 0 0 0 4 43 184 0 9 16 184 0 14 220 184 0 6 208 48 49 1 34 46 2 39 51 30 1 51 50 62 2 55 51 14 3 1 44 33 47 32 16 2 51 4 38 37 18 28 19 12 2 51 2 16 32 47 2 63 24 39 47 24 32 51 14 23 30 16 24 47 39 24 0 1 0 177 2 196 1 167 3 50 0 17 0 25 0 187 0 9 0 1 0 0 0 4 43 184 0 9 16 184 0 6 220 184 0 12 208 48 49 1 34 46 2 39 51 30 1 51 50 54 55 51 14 3 1 44 30 44 30 16 3 50 5 34 34 34 34 5 50 3 16 30 44 2 196 19 30 40 21 24 39 39 24 21 40 30 19 0 0 1 0 234 2 74 1 110 2 201 0 11 0 13 0 187 0 6 0 1 0 0 0 4 43 48 49 1 34 38 53 52 54 51 50 22 21 20 6 1 44 28 38 38 28 28 38 38 2 74 34 29 29 35 35 29 29 34 0 0 0 1 0 243 2 202 1 101 3 53 0 11 0 13 0 187 0 6 0 1 0 0 0 4 43 48 49 1 34 38 53 52 54 51 50 22 21 20 6 1 44 24 33 33 24 24 33 33 2 202 30 24 23 30 30 23 24 30 0 0 0 2 0 150 2 76 1 194 2 186 0 11 0 23 0 29 0 187 0 0 0 1 0 6 0 4 43 184 0 0 16 184 0 12 208 184 0 6 16 184 0 18 208 48 49 19 34 38 53 52 54 51 50 22 21 20 6 51 34 38 53 52 54 51 50 22 21 20 6 204 24 30 30 24 23 31 31 169 23 31 31 23 24 30 30 2 76 32 23 23 32 32 23 23 32 32 23 23 32 32 23 23 32 0 0 2 0 165 2 203 1 179 3 45 0 11 0 23 0 29 0 187 0 6 0 1 0 0 0 4 43 184 0 0 16 184 0 12 208 184 0 6 16 184 0 18 208 48 49 19 34 38 53 52 54 51 50 22 21 20 6 51 34 38 53 52 54 51 50 22 21 20 6 214 22 27 27 22 21 28 28 151 21 28 28 21 22 27 27 2 203 28 21 22 27 27 22 21 28 28 21 22 27 27 22 21 28 0 0 1 0 236 2 41 1 127 2 215 0 14 0 27 0 187 0 0 0 1 0 14 0 4 43 184 0 0 16 184 0 5 220 185 0 6 0 1 244 48 49 1 62 1 53 52 39 55 30 1 21 20 14 2 7 1 7 24 32 83 9 66 72 18 31 40 22 2 79 7 20 19 39 3 48 2 41 38 22 31 23 13 4 0 0 1 0 236 2 186 1 127 3 104 0 14 0 25 0 186 0 0 0 14 0 3 43 184 0 0 16 184 0 5 220 185 0 6 0 1 244 48 49 1 62 1 53 52 39 55 30 1 21 20 14 2 7 1 7 24 32 83 9 66 72 18 31 40 22 2 224 7 20 19 39 3 48 2 41 38 22 31 23 13 4 0 0 0 0 2 0 207 2 30 1 137 2 215 0 11 0 23 0 23 0 186 0 12 0 0 0 3 43 184 0 12 16 184 0 18 220 184 0 6 220 48 49 1 34 38 53 52 54 51 50 22 21 20 6 39 50 54 53 52 38 35 34 6 21 20 22 1 44 41 52 52 41 41 52 52 41 20 28 28 20 20 28 28 2 30 51 42 42 50 50 42 42 51 37 30 26 25 30 30 25 26 30 0 0 2 0 207 2 187 1 137 3 107 0 11 0 23 0 23 0 186 0 12 0 0 0 3 43 184 0 12 16 184 0 18 220 184 0 6 220 48 49 1 34 38 53 52 54 51 50 22 21 20 6 39 50 54 53 52 38 35 34 6 21 20 22 1 44 41 52 52 41 40 53 53 40 19 28 28 19 20 28 28 2 187 47 41 40 48 48 40 41 47 36 27 25 23 28 28 23 25 27 0 0 2 0 202 2 59 1 236 2 202 0 3 0 7 0 29 0 187 0 0 0 1 0 2 0 4 43 184 0 0 16 184 0 4 208 184 0 2 16 184 0 6 208 48 49 1 51 7 35 55 51 7 35 1 16 73 88 55 218 72 88 55 2 202 143 143 143 0 0 2 0 191 2 194 1 236 3 50 0 3 0 7 0 29 0 187 0 1 0 1 0 3 0 4 43 184 0 1 16 184 0 4 208 184 0 3 16 184 0 6 208 48 49 19 55 51 7 55 51 7 35 191 66 77 83 164 77 84 59 2 194 112 112 112 112 0 0 1 0 168 2 61 1 176 2 209 0 7 0 25 0 187 0 3 0 1 0 6 0 4 43 184 0 3 16 184 0 4 220 184 0 1 208 48 49 19 51 23 51 55 51 7 35 168 63 67 4 67 63 97 70 2 209 99 99 148 0 1 0 164 2 194 1 180 3 50 0 7 0 25 0 187 0 6 0 1 0 1 0 4 43 184 0 6 16 184 0 7 220 184 0 4 208 48 49 1 7 35 39 51 23 51 55 1 180 96 80 96 67 67 4 67 3 50 112 112 68 68 0 0 0 2 0 108 2 59 1 142 2 202 0 3 0 7 0 29 0 187 0 3 0 1 0 1 0 4 43 184 0 1 16 184 0 4 208 184 0 3 16 184 0 6 208 48 49 1 35 39 51 7 35 39 51 1 142 55 88 73 77 55 88 72 2 59 143 143 143 0 0 2 0 108 2 194 1 153 3 50 0 3 0 7 0 29 0 187 0 2 0 1 0 0 0 4 43 184 0 0 16 184 0 4 208 184 0 2 16 184 0 6 208 48 49 1 39 51 23 43 1 39 51 1 93 83 77 66 158 59 84 77 2 194 112 112 112 0 0 1 0 247 2 33 1 90 2 220 0 16 0 21 0 187 0 5 0 1 0 11 0 4 43 184 0 5 16 184 0 16 220 48 49 1 14 1 7 54 51 50 22 21 20 6 35 34 53 52 54 55 1 90 29 26 2 3 5 15 26 23 17 51 38 43 2 188 14 35 23 1 19 20 23 22 69 35 63 20 0 1 0 253 2 32 1 95 2 218 0 15 0 21 0 187 0 10 0 1 0 4 0 4 43 184 0 4 16 184 0 15 220 48 49 19 54 55 6 35 34 38 53 52 54 51 50 21 20 6 7 253 54 3 3 6 15 26 24 17 50 38 43 2 64 26 46 1 19 20 22 22 69 35 62 20 0 1 1 35 1 179 1 187 2 101 0 15 0 21 0 187 0 0 0 1 0 15 0 4 43 184 0 0 16 184 0 6 220 48 49 1 62 1 53 52 38 39 55 30 1 21 20 14 2 7 1 35 42 42 8 6 59 10 13 22 39 52 31 1 220 6 30 30 11 21 10 29 14 32 19 27 40 27 16 3 0 1 0 234 255 30 1 110 255 157 0 11 0 13 0 187 0 6 0 1 0 0 0 4 43 48 49 5 34 38 53 52 54 51 50 22 21 20 6 1 44 28 38 38 28 28 38 38 226 34 29 29 35 35 29 29 34 0 0 0 0 2 0 165 255 55 1 179 255 153 0 11 0 23 0 29 0 187 0 6 0 1 0 0 0 4 43 184 0 0 16 184 0 12 208 184 0 6 16 184 0 18 208 48 49 23 34 38 53 52 54 51 50 22 21 20 6 51 34 38 53 52 54 51 50 22 21 20 6 214 22 27 27 22 21 28 28 151 21 28 28 21 22 27 27 201 29 20 21 28 28 21 20 29 29 20 21 28 28 21 20 29 0 0 0 1 0 215 255 40 1 112 255 208 0 16 0 27 0 187 0 15 0 1 0 0 0 4 43 184 0 15 16 184 0 9 220 185 0 8 0 1 244 48 49 5 30 1 21 20 14 2 7 39 62 1 53 52 38 39 55 1 15 51 46 24 40 53 28 8 40 49 30 21 18 48 8 35 34 22 32 22 13 2 40 5 21 20 20 19 5 38 0 1 0 215 255 43 1 112 0 3 0 17 0 29 0 186 0 1 0 2 0 3 43 184 0 2 16 184 0 17 208 184 0 11 220 185 0 10 0 1 244 48 49 37 51 7 30 1 21 20 14 2 7 39 62 1 53 52 38 39 1 25 53 25 24 35 24 40 53 28 8 40 49 33 30 3 53 8 32 31 22 32 22 13 3 41 5 23 20 20 21 8 0 1 0 210 255 43 1 107 0 3 0 17 0 29 0 186 0 1 0 2 0 3 43 184 0 2 16 184 0 17 208 184 0 11 220 185 0 10 0 1 244 48 49 37 51 7 30 1 21 20 14 2 7 39 62 1 53 52 38 39 1 19 54 25 24 35 24 40 53 28 8 40 49 33 31 3 53 8 32 31 22 32 22 13 3 41 5 23 20 20 21 8 0 1 0 234 255 50 1 147 0 3 0 18 0 30 0 184 0 0 69 88 184 0 4 47 27 185 0 4 0 3 62 89 187 0 10 0 1 0 16 0 4 43 48 49 23 52 54 55 51 14 1 21 20 22 51 50 55 23 14 1 35 34 38 234 46 25 58 32 36 28 18 22 18 22 14 46 19 38 52 121 41 64 19 24 55 29 23 23 13 41 11 16 43 0 0 0 0 1 0 234 255 44 1 153 0 3 0 21 0 30 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 3 62 89 187 0 6 0 1 0 13 0 4 43 48 49 37 14 1 21 20 22 51 50 54 55 23 14 1 35 34 38 53 52 62 2 55 1 110 32 36 30 18 12 19 9 23 14 46 20 40 55 13 21 26 12 3 24 57 29 23 23 7 7 45 11 17 44 43 21 38 33 27 9 0 0 0 1 0 174 255 50 1 170 255 177 0 17 0 13 0 187 0 9 0 1 0 0 0 4 43 48 49 5 34 46 2 39 51 30 1 51 50 54 55 51 14 3 1 44 32 47 30 16 1 51 4 36 35 35 36 4 51 2 15 30 47 206 23 37 45 22 29 47 47 29 22 45 37 23 0 0 0 1 0 176 255 85 1 167 255 143 0 3 0 13 0 187 0 0 0 1 0 3 0 4 43 48 49 5 35 53 51 1 167 247 247 171 58 0 0 0 0 3 0 168 2 76 1 176 3 29 0 11 0 23 0 27 0 43 0 187 0 0 0 1 0 6 0 4 43 184 0 0 16 184 0 12 208 184 0 6 16 184 0 18 208 184 0 6 16 184 0 26 220 185 0 25 0 1 244 48 49 19 34 38 53 52 54 51 50 22 21 20 6 51 34 38 53 52 54 51 50 22 21 20 6 39 51 21 35 214 20 26 26 20 20 25 25 152 20 25 25 20 20 26 26 230 247 247 2 76 26 19 20 26 26 20 19 26 26 19 20 26 26 20 19 26 209 47 0 3 0 168 2 203 1 176 3 139 0 3 0 15 0 27 0 43 0 187 0 10 0 1 0 4 0 4 43 184 0 10 16 184 0 2 220 185 0 1 0 1 244 184 0 4 16 184 0 16 208 184 0 10 16 184 0 22 208 48 49 19 51 21 35 23 34 38 53 52 54 51 50 22 21 20 6 51 34 38 53 52 54 51 50 22 21 20 6 176 248 248 38 20 26 26 20 20 25 25 152 20 25 25 20 20 26 26 3 139 46 146 26 20 20 25 25 20 20 26 26 20 20 25 25 20 20 26 0 3 0 168 2 76 1 176 3 55 0 3 0 15 0 27 0 37 0 186 0 0 0 2 0 3 43 187 0 4 0 1 0 10 0 4 43 184 0 4 16 184 0 16 208 184 0 10 16 184 0 22 208 48 49 1 51 7 35 7 34 38 53 52 54 51 50 22 21 20 6 51 34 38 53 52 54 51 50 22 21 20 6 1 73 79 103 58 33 20 26 26 20 20 25 25 152 20 25 25 20 20 26 26 3 55 103 132 26 19 20 26 26 20 19 26 26 19 20 26 26 20 19 26 0 3 0 168 2 203 1 176 3 182 0 3 0 15 0 27 0 41 0 187 0 10 0 1 0 4 0 4 43 184 0 10 16 184 0 2 220 184 0 0 220 184 0 4 16 184 0 16 208 184 0 10 16 184 0 22 208 48 49 1 51 7 35 7 34 38 53 52 54 51 50 22 21 20 6 51 34 38 53 52 54 51 50 22 21 20 6 1 82 91 112 68 35 20 26 26 20 20 25 25 152 20 25 25 20 20 26 26 3 182 111 124 26 20 20 25 25 20 20 26 26 20 20 25 25 20 20 26 0 3 0 168 2 76 1 176 3 55 0 7 0 19 0 31 0 43 0 187 0 8 0 1 0 14 0 4 43 184 0 14 16 184 0 6 220 185 0 3 0 1 244 184 0 8 16 184 0 20 208 184 0 14 16 184 0 26 208 48 49 19 51 23 51 55 51 7 35 7 34 38 53 52 54 51 50 22 21 20 6 51 34 38 53 52 54 51 50 22 21 20 6 174 61 63 4 63 61 91 70 51 20 26 26 20 20 25 25 152 20 25 25 20 20 26 26 3 55 64 64 103 132 26 19 20 26 26 20 19 26 26 19 20 26 26 20 19 26 0 0 3 0 164 2 203 1 180 3 182 0 11 0 23 0 31 0 43 0 187 0 6 0 1 0 0 0 4 43 184 0 0 16 184 0 12 208 184 0 6 16 184 0 18 208 184 0 6 16 184 0 25 220 185 0 30 0 1 244 48 49 19 34 38 53 52 54 51 50 22 21 20 6 51 34 38 53 52 54 51 50 22 21 20 6 55 7 35 39 51 23 51 55 214 20 26 26 20 20 25 25 152 20 25 25 20 20 26 26 30 96 80 96 67 67 4 67 2 203 26 20 20 25 25 20 20 26 26 20 20 25 25 20 20 26 235 111 111 68 68 0 3 0 168 2 76 1 176 3 55 0 3 0 15 0 27 0 41 0 187 0 4 0 1 0 10 0 4 43 184 0 10 16 184 0 1 220 184 0 3 220 184 0 4 16 184 0 16 208 184 0 10 16 184 0 22 208 48 49 1 35 39 51 23 34 38 53 52 54 51 50 22 21 20 6 35 34 38 53 52 54 51 50 22 21 20 6 1 97 58 103 79 115 20 25 25 20 20 26 26 192 20 26 26 20 20 25 25 2 208 103 235 26 19 20 26 26 20 19 26 26 19 20 26 26 20 19 26 0 3 0 168 2 203 1 176 3 182 0 3 0 15 0 27 0 41 0 187 0 10 0 1 0 4 0 4 43 184 0 10 16 184 0 0 220 184 0 3 220 184 0 4 16 184 0 16 208 184 0 10 16 184 0 22 208 48 49 1 35 39 51 23 34 38 53 52 54 51 50 22 21 20 6 35 34 38 53 52 54 51 50 22 21 20 6 1 95 68 112 91 124 20 25 25 20 20 26 26 192 20 26 26 20 20 25 25 3 71 111 235 26 20 20 25 25 20 20 26 26 20 20 25 25 20 20 26 0 2 0 184 2 61 2 20 2 242 0 7 0 11 0 25 0 187 0 1 0 1 0 4 0 4 43 184 0 4 16 184 0 11 208 184 0 8 220 48 49 1 51 23 35 39 35 7 35 37 51 7 35 1 10 68 82 56 58 4 58 56 1 22 70 92 51 2 180 119 73 73 181 114 0 0 0 2 0 172 2 194 2 22 3 113 0 3 0 11 0 25 0 187 0 8 0 1 0 5 0 4 43 184 0 8 16 184 0 3 208 184 0 0 220 48 49 1 51 7 35 39 51 23 35 39 35 7 35 1 206 72 91 52 127 72 92 63 63 4 63 63 3 113 111 42 106 62 62 0 0 0 0 2 0 184 2 61 1 245 2 242 0 7 0 11 0 25 0 187 0 1 0 1 0 4 0 4 43 184 0 4 16 184 0 9 208 184 0 11 220 48 49 1 51 23 35 39 35 7 35 37 35 39 51 1 10 68 82 56 58 4 58 56 1 61 51 92 69 2 180 119 73 73 67 114 0 0 0 2 0 172 2 194 1 228 3 113 0 3 0 11 0 25 0 187 0 8 0 1 0 5 0 4 43 184 0 8 16 184 0 1 208 184 0 3 220 48 49 1 35 39 51 7 51 23 35 39 35 7 35 1 228 52 91 72 149 72 92 63 63 4 63 63 3 2 111 69 106 62 62 0 0 0 0 2 0 184 2 61 1 253 3 16 0 7 0 23 0 37 0 187 0 1 0 1 0 4 0 4 43 184 0 4 16 184 0 23 208 185 0 8 0 1 244 184 0 14 220 185 0 15 0 1 244 48 49 1 51 23 35 39 35 7 35 55 62 1 53 52 38 39 55 30 1 21 20 14 2 7 1 10 68 82 56 58 4 58 56 223 19 23 32 37 7 59 63 16 26 33 18 2 180 119 73 73 90 5 18 16 20 19 2 41 2 36 35 20 28 19 12 4 0 0 0 2 0 172 2 194 1 251 3 138 0 13 0 21 0 37 0 187 0 18 0 1 0 15 0 4 43 184 0 18 16 184 0 13 208 185 0 0 0 1 244 184 0 6 220 185 0 7 0 1 244 48 49 1 62 1 53 52 38 39 55 30 1 21 20 6 7 39 51 23 35 39 35 7 35 1 148 19 26 33 38 9 59 61 56 36 151 72 92 63 63 4 63 63 3 21 5 15 16 20 17 2 42 2 36 35 38 35 6 58 106 62 62 0 0 0 0 2 0 169 2 59 1 175 3 34 0 7 0 29 0 57 0 187 0 1 0 1 0 4 0 4 43 184 0 1 16 184 0 22 220 184 0 27 220 185 0 11 0 1 244 184 0 22 16 185 0 16 0 1 244 184 0 11 16 184 0 18 208 184 0 22 16 184 0 29 208 48 49 1 51 23 35 39 35 7 35 39 62 1 51 50 30 2 51 50 55 51 14 1 35 34 46 2 35 34 7 1 6 76 86 58 64 4 64 58 7 4 40 35 19 27 23 21 12 32 7 42 4 40 35 19 27 23 21 12 32 7 2 163 104 65 65 140 40 51 13 17 13 43 40 51 13 17 13 43 0 0 0 2 0 168 2 194 1 176 3 170 0 7 0 31 0 57 0 187 0 1 0 1 0 4 0 4 43 184 0 1 16 184 0 23 220 184 0 8 208 184 0 23 16 184 0 28 220 185 0 11 0 1 244 184 0 23 16 185 0 16 0 1 244 184 0 11 16 184 0 19 208 48 49 1 51 23 35 39 35 7 35 39 62 1 51 50 30 2 51 50 54 55 51 14 1 35 34 46 2 35 34 6 7 1 8 72 92 63 63 4 63 63 4 4 39 35 19 29 24 21 12 15 21 3 42 4 39 35 19 29 24 21 12 15 21 3 3 44 106 62 62 142 39 51 13 16 13 21 21 40 50 13 16 13 21 21 0 2 0 174 2 63 1 170 3 21 0 3 0 21 0 25 0 187 0 13 0 1 0 4 0 4 43 184 0 13 16 184 0 2 220 184 0 0 220 48 49 1 51 7 35 23 34 46 2 39 51 30 1 51 50 54 55 51 14 3 1 75 68 88 48 37 32 47 30 16 1 43 5 40 38 38 40 5 43 2 15 30 47 3 21 112 102 23 37 45 22 31 49 49 31 22 45 37 23 0 0 2 0 178 2 196 1 166 3 139 0 3 0 21 0 25 0 187 0 13 0 1 0 4 0 4 43 184 0 13 16 184 0 2 220 184 0 0 220 48 49 1 51 7 35 23 34 46 2 39 51 30 1 51 50 54 55 51 14 3 1 79 72 97 49 39 29 43 30 17 3 45 6 35 36 36 35 6 45 3 17 30 43 3 139 105 94 18 30 38 21 26 38 38 26 21 38 30 18 0 0 2 0 174 2 63 1 170 3 21 0 3 0 21 0 25 0 187 0 13 0 1 0 4 0 4 43 184 0 13 16 184 0 0 220 184 0 3 220 48 49 1 35 39 51 23 34 46 2 39 51 30 1 51 50 54 55 51 14 3 1 81 48 88 68 31 32 47 30 16 1 43 5 40 38 38 40 5 43 2 15 30 47 2 165 112 214 23 37 45 22 31 49 49 31 22 45 37 23 0 0 2 0 178 2 196 1 166 3 139 0 3 0 21 0 25 0 187 0 13 0 1 0 4 0 4 43 184 0 13 16 184 0 0 220 184 0 3 220 48 49 1 35 39 51 23 34 46 2 39 51 30 1 51 50 54 55 51 14 3 1 83 49 97 72 35 29 43 30 17 3 45 6 35 36 36 35 6 45 3 17 30 43 3 34 105 199 18 30 38 21 26 38 38 26 21 38 30 18 0 0 2 0 174 2 63 1 170 3 71 0 17 0 33 0 37 0 187 0 9 0 1 0 0 0 4 43 184 0 9 16 184 0 33 220 185 0 18 0 1 244 184 0 24 220 185 0 25 0 1 244 48 49 1 34 46 2 39 51 30 1 51 50 54 55 51 14 3 39 62 1 53 52 38 39 55 30 1 21 20 14 2 7 1 44 32 47 30 16 1 43 5 40 38 38 40 5 43 2 15 30 47 67 18 24 32 37 7 59 63 16 26 34 18 2 63 23 37 45 22 31 49 49 31 22 45 37 23 143 5 18 16 20 19 2 41 2 35 36 20 28 19 12 4 0 2 0 178 2 196 1 166 3 184 0 15 0 33 0 37 0 187 0 25 0 1 0 16 0 4 43 184 0 25 16 184 0 15 220 185 0 0 0 1 244 184 0 6 220 185 0 7 0 1 244 48 49 1 62 1 53 52 38 39 55 30 1 21 20 14 2 7 23 34 46 2 39 51 30 1 51 50 54 55 51 14 3 1 11 18 26 33 37 8 59 62 16 25 34 18 23 29 43 30 17 3 45 6 35 36 36 35 6 45 3 17 30 43 3 67 5 15 16 20 17 2 42 2 36 35 19 27 19 11 3 92 18 30 38 21 26 38 38 26 21 38 30 18 0 2 0 169 2 63 1 175 3 34 0 17 0 39 0 57 0 187 0 9 0 1 0 0 0 4 43 184 0 9 16 184 0 32 220 184 0 37 220 185 0 21 0 1 244 184 0 32 16 185 0 26 0 1 244 184 0 21 16 184 0 28 208 184 0 32 16 184 0 39 208 48 49 1 34 46 2 39 51 30 1 51 50 54 55 51 14 3 39 62 1 51 50 30 2 51 50 55 51 14 1 35 34 46 2 35 34 7 1 44 32 46 30 16 1 45 5 37 38 38 37 5 45 2 15 30 46 163 4 40 35 19 27 23 21 12 32 7 42 4 40 35 19 27 23 21 12 32 7 2 63 19 30 38 20 24 38 38 24 20 38 30 19 136 40 51 13 17 13 43 40 51 13 17 13 43 0 2 0 167 2 196 1 175 3 171 0 17 0 41 0 57 0 187 0 9 0 1 0 0 0 4 43 184 0 9 16 184 0 33 220 184 0 18 208 184 0 33 16 184 0 38 220 185 0 21 0 1 244 184 0 33 16 185 0 26 0 1 244 184 0 21 16 184 0 29 208 48 49 1 34 46 2 39 51 30 1 51 50 54 55 51 14 3 39 62 1 51 50 30 2 51 50 54 55 51 14 1 35 34 46 2 35 34 6 7 1 44 29 43 30 17 3 45 6 35 36 36 35 6 45 3 17 30 43 162 3 41 35 17 28 24 22 12 15 21 4 42 4 40 35 18 27 24 22 12 15 22 3 2 196 18 30 38 21 26 38 38 26 21 38 30 18 138 40 53 14 17 14 24 21 39 54 14 17 14 24 21 0 0 0 2 0 176 2 59 1 168 3 34 0 7 0 25 0 35 0 187 0 1 0 1 0 4 0 4 43 184 0 1 16 184 0 8 220 185 0 17 0 1 244 184 0 20 220 184 0 14 208 48 49 1 51 23 35 39 35 7 35 55 34 46 2 39 51 30 1 51 50 54 55 51 14 3 1 6 76 86 58 64 4 64 58 124 29 41 29 15 1 45 4 33 33 33 33 4 45 2 14 29 42 2 163 104 65 65 134 16 27 35 19 22 30 30 22 19 35 27 16 0 0 2 0 172 2 194 1 172 3 170 0 7 0 21 0 35 0 187 0 1 0 1 0 4 0 4 43 184 0 1 16 184 0 8 220 185 0 15 0 1 244 184 0 18 220 184 0 12 208 48 49 1 51 23 35 39 35 7 35 55 34 38 39 51 30 1 51 50 54 55 51 14 1 1 8 72 92 63 63 4 63 63 128 58 59 5 45 6 35 36 36 35 6 45 5 59 3 44 106 62 62 135 57 40 23 30 30 23 40 57 0 0 0 1 1 6 2 36 1 65 2 248 0 4 0 11 0 186 0 1 0 0 0 3 43 48 49 1 39 51 15 1 1 10 4 59 1 14 2 36 212 57 155 0 0 0 0 1 0 231 2 29 1 127 2 198 0 16 0 27 0 187 0 15 0 1 0 0 0 4 43 184 0 15 16 184 0 9 220 185 0 8 0 1 244 48 49 1 46 1 53 52 62 2 55 23 14 1 21 20 22 23 7 1 72 51 46 24 40 52 28 8 39 49 29 22 18 2 29 8 36 33 22 32 22 13 3 41 5 21 19 20 20 5 38 0 0 0 0 1 255 217 1 5 2 127 1 83 0 3 0 13 0 187 0 1 0 1 0 2 0 4 43 48 49 3 33 21 33 39 2 166 253 90 1 83 78 0 0 1 255 217 0 222 2 127 1 122 0 3 0 11 0 186 0 1 0 2 0 3 43 48 49 3 33 21 33 39 2 166 253 90 1 122 156 0 0 0 0 1 1 5 254 112 1 83 3 232 0 3 0 11 0 186 0 1 0 2 0 3 43 48 49 1 51 17 35 1 5 78 78 3 232 250 136 0 0 0 0 1 0 222 254 112 1 122 3 232 0 3 0 11 0 186 0 1 0 2 0 3 43 48 49 19 51 17 35 222 156 156 3 232 250 136 0 3 0 33 1 5 2 55 1 83 0 3 0 7 0 11 0 45 0 187 0 1 0 1 0 2 0 4 43 184 0 1 16 184 0 4 208 184 0 2 16 184 0 6 208 184 0 1 16 184 0 8 208 184 0 2 16 184 0 10 208 48 49 19 51 21 35 55 51 21 35 55 51 21 35 33 134 134 200 134 134 200 134 134 1 83 78 78 78 78 78 0 0 3 0 33 0 222 2 55 1 122 0 3 0 7 0 11 0 43 0 186 0 1 0 2 0 3 43 184 0 1 16 184 0 4 208 184 0 2 16 184 0 6 208 184 0 1 16 184 0 8 208 184 0 2 16 184 0 10 208 48 49 19 51 21 35 55 51 21 35 55 51 21 35 33 134 134 200 134 134 200 134 134 1 122 156 156 156 156 156 0 0 0 0 3 1 5 255 111 1 83 2 231 0 3 0 7 0 11 0 27 0 186 0 1 0 2 0 3 43 186 0 9 0 10 0 3 43 186 0 5 0 6 0 3 43 48 49 37 51 21 35 17 51 21 35 17 51 21 35 1 5 78 78 78 78 78 78 77 222 2 43 222 2 43 222 0 0 0 0 3 0 222 255 111 1 122 2 231 0 3 0 7 0 11 0 27 0 186 0 1 0 2 0 3 43 186 0 9 0 10 0 3 43 186 0 5 0 6 0 3 43 48 49 55 51 21 35 17 51 21 35 17 51 21 35 222 156 156 156 156 156 156 77 222 2 43 222 2 43 222 0 4 0 18 1 5 2 69 1 83 0 3 0 7 0 11 0 15 0 61 0 187 0 1 0 1 0 2 0 4 43 184 0 1 16 184 0 4 208 184 0 2 16 184 0 6 208 184 0 1 16 184 0 8 208 184 0 2 16 184 0 10 208 184 0 1 16 184 0 12 208 184 0 2 16 184 0 14 208 48 49 19 51 21 35 55 51 21 35 55 51 21 35 55 51 21 35 18 113 113 150 113 113 150 113 113 150 113 113 1 83 78 78 78 78 78 78 78 0 0 0 4 0 18 0 222 2 69 1 122 0 3 0 7 0 11 0 15 0 59 0 186 0 1 0 2 0 3 43 184 0 1 16 184 0 4 208 184 0 2 16 184 0 6 208 184 0 1 16 184 0 8 208 184 0 2 16 184 0 10 208 184 0 1 16 184 0 12 208 184 0 2 16 184 0 14 208 48 49 19 51 21 35 55 51 21 35 55 51 21 35 55 51 21 35 18 113 113 150 113 113 150 113 113 150 113 113 1 122 156 156 156 156 156 156 156 0 4 1 5 255 87 1 83 3 1 0 3 0 7 0 11 0 15 0 35 0 186 0 1 0 2 0 3 43 186 0 13 0 14 0 3 43 186 0 5 0 6 0 3 43 186 0 9 0 10 0 3 43 48 49 37 51 21 35 17 51 21 35 17 51 21 35 17 51 21 35 1 5 78 78 78 78 78 78 78 78 19 188 1 182 188 1 182 188 1 182 188 0 4 0 222 255 87 1 122 3 1 0 3 0 7 0 11 0 15 0 35 0 186 0 1 0 2 0 3 43 186 0 13 0 14 0 3 43 186 0 5 0 6 0 3 43 186 0 9 0 10 0 3 43 48 49 55 51 21 35 17 51 21 35 17 51 21 35 17 51 21 35 222 156 156 156 156 156 156 156 156 19 188 1 182 188 1 182 188 1 182 188 0 0 1 1 5 254 112 2 127 1 83 0 5 0 13 0 187 0 1 0 1 0 2 0 4 43 48 49 1 33 21 33 17 35 1 5 1 122 254 212 78 1 83 78 253 107 0 0 0 0 1 1 5 254 112 2 127 1 122 0 5 0 11 0 186 0 1 0 2 0 3 43 48 49 1 33 21 33 17 35 1 5 1 122 254 212 78 1 122 156 253 146 0 0 1 0 222 254 112 2 127 1 83 0 5 0 13 0 187 0 1 0 1 0 2 0 4 43 48 49 19 33 21 33 17 35 222 1 161 254 251 156 1 83 78 253 107 0 1 0 222 254 112 2 127 1 122 0 5 0 11 0 186 0 1 0 2 0 3 43 48 49 19 33 21 33 17 35 222 1 161 254 251 156 1 122 156 253 146 0 0 0 1 255 217 254 112 1 83 1 83 0 5 0 13 0 187 0 1 0 1 0 4 0 4 43 48 49 3 33 17 35 17 33 39 1 122 78 254 212 1 83 253 29 2 149 0 0 0 0 1 255 217 254 112 1 83 1 122 0 5 0 11 0 186 0 1 0 4 0 3 43 48 49 3 33 17 35 17 33 39 1 122 78 254 212 1 122 252 246 2 110 0 0 1 255 217 254 112 1 122 1 83 0 5 0 13 0 187 0 1 0 1 0 4 0 4 43 48 49 3 33 17 35 17 33 39 1 161 156 254 251 1 83 253 29 2 149 0 0 0 0 1 255 217 254 112 1 122 1 122 0 5 0 11 0 186 0 1 0 4 0 3 43 48 49 3 33 17 35 17 33 39 1 161 156 254 251 1 122 252 246 2 110 0 0 1 1 5 1 5 2 127 3 232 0 5 0 13 0 187 0 3 0 1 0 4 0 4 43 48 49 1 51 17 33 21 33 1 5 78 1 44 254 134 3 232 253 107 78 0 0 0 0 1 1 5 0 222 2 127 3 232 0 5 0 11 0 186 0 3 0 4 0 3 43 48 49 1 51 17 33 21 33 1 5 78 1 44 254 134 3 232 253 146 156 0 0 1 0 222 1 5 2 127 3 232 0 5 0 13 0 187 0 3 0 1 0 4 0 4 43 48 49 19 51 17 33 21 33 222 156 1 5 254 95 3 232 253 107 78 0 1 0 222 0 222 2 127 3 232 0 5 0 11 0 186 0 3 0 4 0 3 43 48 49 19 51 17 33 21 33 222 156 1 5 254 95 3 232 253 146 156 0 0 0 1 255 217 1 5 1 83 3 232 0 5 0 13 0 187 0 1 0 1 0 4 0 4 43 48 49 3 33 17 51 17 33 39 1 44 78 254 134 1 83 2 149 253 29 0 0 0 0 1 255 217 0 222 1 83 3 232 0 5 0 11 0 186 0 1 0 4 0 3 43 48 49 3 33 17 51 17 33 39 1 44 78 254 134 1 122 2 110 252 246 0 0 1 255 217 1 5 1 122 3 232 0 5 0 13 0 187 0 1 0 1 0 4 0 4 43 48 49 3 33 17 51 17 33 39 1 5 156 254 95 1 83 2 149 253 29 0 0 0 0 1 255 217 0 222 1 122 3 232 0 5 0 11 0 186 0 1 0 4 0 3 43 48 49 3 33 17 51 17 33 39 1 5 156 254 95 1 122 2 110 252 246 0 0 1 1 5 254 112 2 127 3 232 0 7 0 13 0 187 0 3 0 1 0 4 0 4 43 48 49 1 51 17 33 21 33 17 35 1 5 78 1 44 254 212 78 3 232 253 107 78 253 107 0 0 0 1 1 5 254 112 2 127 3 232 0 7 0 11 0 186 0 3 0 4 0 3 43 48 49 1 51 17 33 21 33 17 35 1 5 78 1 44 254 212 78 3 232 253 146 156 253 146 0 1 0 222 254 112 2 127 3 232 0 9 0 21 0 187 0 3 0 1 0 4 0 4 43 184 0 4 16 184 0 8 208 48 49 19 51 17 33 21 33 17 35 17 35 222 156 1 5 254 212 78 39 3 232 253 107 78 253 107 2 149 0 0 0 1 0 222 254 112 2 127 3 232 0 9 0 21 0 187 0 5 0 1 0 6 0 4 43 184 0 5 16 184 0 0 208 48 49 19 51 17 51 17 33 21 33 17 35 222 39 78 1 44 254 251 156 1 83 2 149 253 107 78 253 107 0 0 0 1 0 222 254 112 2 127 3 232 0 7 0 13 0 187 0 3 0 1 0 4 0 4 43 48 49 19 51 17 33 21 33 17 35 222 156 1 5 254 251 156 3 232 253 107 78 253 107 0 0 0 0 1 0 222 254 112 2 127 3 232 0 9 0 19 0 186 0 3 0 4 0 3 43 184 0 4 16 184 0 8 208 48 49 19 51 17 33 21 33 17 35 17 35 222 156 1 5 254 212 78 39 3 232 253 146 156 253 146 2 110 0 1 0 222 254 112 2 127 3 232 0 9 0 19 0 186 0 5 0 6 0 3 43 184 0 5 16 184 0 0 208 48 49 19 51 17 51 17 33 21 33 17 35 222 39 78 1 44 254 251 156 1 122 2 110 253 146 156 253 146 0 1 0 222 254 112 2 127 3 232 0 7 0 11 0 186 0 3 0 4 0 3 43 48 49 19 51 17 33 21 33 17 35 222 156 1 5 254 251 156 3 232 253 146 156 253 146 0 0 1 255 217 254 112 1 83 3 232 0 7 0 13 0 187 0 1 0 1 0 6 0 4 43 48 49 3 33 17 51 17 35 17 33 39 1 44 78 78 254 212 1 83 2 149 250 136 2 149 0 0 0 1 255 217 254 112 1 83 3 232 0 7 0 11 0 186 0 1 0 6 0 3 43 48 49 3 33 17 51 17 35 17 33 39 1 44 78 78 254 212 1 122 2 110 250 136 2 110 0 1 255 217 254 112 1 122 3 232 0 9 0 21 0 187 0 1 0 1 0 8 0 4 43 184 0 8 16 184 0 4 208 48 49 3 33 17 51 17 35 17 35 17 33 39 1 5 156 39 78 254 212 1 83 2 149 253 29 253 107 2 149 0 0 1 255 217 254 112 1 122 3 232 0 9 0 21 0 187 0 1 0 1 0 8 0 4 43 184 0 1 16 184 0 4 208 48 49 3 33 17 51 17 51 17 35 17 33 39 1 44 78 39 156 254 251 1 83 2 149 253 107 253 29 2 149 0 0 1 255 217 254 112 1 122 3 232 0 7 0 13 0 187 0 1 0 1 0 6 0 4 43 48 49 3 33 17 51 17 35 17 33 39 1 5 156 156 254 251 1 83 2 149 250 136 2 149 0 0 0 1 255 217 254 112 1 122 3 232 0 9 0 19 0 186 0 1 0 8 0 3 43 184 0 8 16 184 0 4 208 48 49 3 33 17 51 17 35 17 35 17 33 39 1 5 156 39 78 254 212 1 122 2 110 252 246 253 146 2 110 0 0 0 0 1 255 217 254 112 1 122 3 232 0 9 0 19 0 186 0 1 0 8 0 3 43 184 0 1 16 184 0 4 208 48 49 3 33 17 51 17 51 17 35 17 33 39 1 44 78 39 156 254 251 1 122 2 110 253 146 252 246 2 110 0 0 0 0 1 255 217 254 112 1 122 3 232 0 7 0 11 0 186 0 1 0 6 0 3 43 48 49 3 33 17 51 17 35 17 33 39 1 5 156 156 254 251 1 122 2 110 250 136 2 110 0 1 255 217 254 112 2 127 1 83 0 7 0 21 0 187 0 1 0 1 0 2 0 4 43 184 0 2 16 184 0 6 208 48 49 3 33 21 33 17 35 17 33 39 2 166 254 212 78 254 212 1 83 78 253 107 2 149 0 0 0 1 255 217 254 112 2 127 1 122 0 9 0 21 0 187 0 3 0 1 0 4 0 4 43 186 0 1 0 8 0 3 43 48 49 3 33 21 33 21 33 17 35 17 33 39 1 122 1 44 254 212 78 254 212 1 122 39 78 253 107 2 110 0 0 1 255 217 254 112 2 127 1 122 0 9 0 21 0 187 0 1 0 1 0 8 0 4 43 186 0 3 0 4 0 3 43 48 49 3 33 53 33 21 33 17 35 17 33 39 1 44 1 122 254 212 78 254 212 1 83 39 156 253 146 2 149 0 0 1 255 217 254 112 2 127 1 122 0 7 0 19 0 186 0 1 0 2 0 3 43 184 0 2 16 184 0 6 208 48 49 3 33 21 33 17 35 17 33 39 2 166 254 212 78 254 212 1 122 156 253 146 2 110 0 1 255 217 254 112 2 127 1 83 0 7 0 21 0 187 0 1 0 1 0 2 0 4 43 184 0 2 16 184 0 6 208 48 49 3 33 21 33 17 35 17 33 39 2 166 254 251 156 254 251 1 83 78 253 107 2 149 0 0 0 1 255 217 254 112 2 127 1 122 0 9 0 21 0 187 0 3 0 1 0 4 0 4 43 186 0 1 0 8 0 3 43 48 49 3 33 21 33 21 33 17 35 17 33 39 1 161 1 5 254 251 156 254 251 1 122 39 78 253 107 2 110 0 0 1 255 217 254 112 2 127 1 122 0 9 0 21 0 187 0 1 0 1 0 8 0 4 43 186 0 3 0 4 0 3 43 48 49 3 33 53 33 21 33 17 35 17 33 39 1 5 1 161 254 251 156 254 251 1 83 39 156 253 146 2 149 0 0 1 255 217 254 112 2 127 1 122 0 7 0 19 0 186 0 1 0 2 0 3 43 184 0 2 16 184 0 6 208 48 49 3 33 21 33 17 35 17 33 39 2 166 254 251 156 254 251 1 122 156 253 146 2 110 0 1 255 217 1 5 2 127 3 232 0 7 0 21 0 187 0 5 0 1 0 6 0 4 43 184 0 5 16 184 0 0 208 48 49 3 33 17 51 17 33 21 33 39 1 44 78 1 44 253 90 1 83 2 149 253 107 78 0 0 0 1 255 217 0 222 2 127 3 232 0 9 0 21 0 186 0 1 0 8 0 3 43 187 0 5 0 1 0 6 0 4 43 48 49 3 33 17 51 17 33 21 33 21 33 39 1 44 78 1 44 254 212 254 134 1 122 2 110 253 107 78 39 0 0 1 255 217 0 222 2 127 3 232 0 9 0 21 0 186 0 5 0 6 0 3 43 187 0 1 0 1 0 8 0 4 43 48 49 3 33 17 51 17 33 21 33 53 33 39 1 44 78 1 44 254 134 254 212 1 83 2 149 253 146 156 39 0 0 1 255 217 0 222 2 127 3 232 0 7 0 19 0 186 0 5 0 6 0 3 43 184 0 5 16 184 0 0 208 48 49 3 33 17 51 17 33 21 33 39 1 44 78 1 44 253 90 1 122 2 110 253 146 156 0 1 255 217 1 5 2 127 3 232 0 7 0 21 0 187 0 5 0 1 0 6 0 4 43 184 0 5 16 184 0 0 208 48 49 3 33 17 51 17 33 21 33 39 1 5 156 1 5 253 90 1 83 2 149 253 107 78 0 0 0 1 255 217 0 222 2 127 3 232 0 9 0 21 0 186 0 1 0 8 0 3 43 187 0 5 0 1 0 6 0 4 43 48 49 3 33 17 51 17 33 21 33 21 33 39 1 5 156 1 5 254 251 254 95 1 122 2 110 253 107 78 39 0 0 1 255 217 0 222 2 127 3 232 0 9 0 21 0 186 0 5 0 6 0 3 43 187 0 1 0 1 0 8 0 4 43 48 49 3 33 17 51 17 33 21 33 53 33 39 1 5 156 1 5 254 95 254 251 1 83 2 149 253 146 156 39 0 0 1 255 217 0 222 2 127 3 232 0 7 0 19 0 186 0 5 0 6 0 3 43 184 0 5 16 184 0 0 208 48 49 3 33 17 51 17 33 21 33 39 1 5 156 1 5 253 90 1 122 2 110 253 146 156 0 1 255 217 254 112 2 127 3 232 0 11 0 29 0 187 0 5 0 1 0 6 0 4 43 184 0 5 16 184 0 0 208 184 0 6 16 184 0 10 208 48 49 3 33 17 51 17 33 21 33 17 35 17 33 39 1 44 78 1 44 254 212 78 254 212 1 83 2 149 253 107 78 253 107 2 149 0 0 0 0 1 255 217 254 112 2 127 3 232 0 11 0 21 0 186 0 1 0 10 0 3 43 187 0 5 0 1 0 6 0 4 43 48 49 3 33 17 51 17 33 21 33 17 35 17 33 39 1 44 78 1 44 254 212 78 254 212 1 122 2 110 253 107 78 253 107 2 110 0 0 0 0 1 255 217 254 112 2 127 3 232 0 11 0 21 0 186 0 5 0 6 0 3 43 187 0 1 0 1 0 10 0 4 43 48 49 3 33 17 51 17 33 21 33 17 35 17 33 39 1 44 78 1 44 254 212 78 254 212 1 83 2 149 253 146 156 253 146 2 149 0 0 0 0 1 255 217 254 112 2 127 3 232 0 11 0 27 0 186 0 5 0 6 0 3 43 184 0 5 16 184 0 0 208 184 0 6 16 184 0 10 208 48 49 3 33 17 51 17 33 21 33 17 35 17 33 39 1 44 78 1 44 254 212 78 254 212 1 122 2 110 253 146 156 253 146 2 110 0 0 1 255 217 254 112 2 127 3 232 0 11 0 29 0 187 0 5 0 1 0 6 0 4 43 184 0 5 16 184 0 0 208 184 0 6 16 184 0 10 208 48 49 3 33 17 51 17 33 21 33 17 35 17 33 39 1 5 156 1 5 254 212 78 254 212 1 83 2 149 253 107 78 253 107 2 149 0 0 0 0 1 255 217 254 112 2 127 3 232 0 11 0 29 0 187 0 5 0 1 0 6 0 4 43 184 0 5 16 184 0 0 208 184 0 6 16 184 0 10 208 48 49 3 33 17 51 17 33 21 33 17 35 17 33 39 1 44 78 1 44 254 251 156 254 251 1 83 2 149 253 107 78 253 107 2 149 0 0 0 0 1 255 217 254 112 2 127 3 232 0 11 0 29 0 187 0 5 0 1 0 6 0 4 43 184 0 5 16 184 0 0 208 184 0 6 16 184 0 10 208 48 49 3 33 17 51 17 33 21 33 17 35 17 33 39 1 5 156 1 5 254 251 156 254 251 1 83 2 149 253 107 78 253 107 2 149 0 0 0 0 1 255 217 254 112 2 127 3 232 0 13 0 29 0 186 0 1 0 12 0 3 43 187 0 5 0 1 0 6 0 4 43 184 0 12 16 184 0 8 208 48 49 3 33 17 51 17 33 21 33 21 35 17 35 17 33 39 1 5 156 1 5 254 251 39 78 254 212 1 122 2 110 253 107 78 39 253 146 2 110 0 0 0 0 1 255 217 254 112 2 127 3 232 0 13 0 29 0 186 0 5 0 6 0 3 43 187 0 1 0 1 0 12 0 4 43 184 0 6 16 184 0 10 208 48 49 3 33 17 51 17 33 21 33 17 35 17 35 53 33 39 1 5 156 1 5 254 212 78 39 254 251 1 83 2 149 253 146 156 253 146 2 110 39 0 0 0 0 1 255 217 254 112 2 127 3 232 0 13 0 29 0 186 0 1 0 12 0 3 43 187 0 7 0 1 0 8 0 4 43 184 0 1 16 184 0 4 208 48 49 3 33 17 51 17 51 21 33 21 33 17 35 17 33 39 1 44 78 39 1 5 254 251 156 254 251 1 122 2 110 253 146 39 78 253 107 2 110 0 0 0 0 1 255 217 254 112 2 127 3 232 0 13 0 29 0 186 0 7 0 8 0 3 43 187 0 1 0 1 0 12 0 4 43 184 0 7 16 184 0 2 208 48 49 3 33 53 51 17 51 17 33 21 33 17 35 17 33 39 1 5 39 78 1 44 254 251 156 254 251 1 83 39 2 110 253 146 156 253 146 2 149 0 0 0 0 1 255 217 254 112 2 127 3 232 0 11 0 27 0 186 0 5 0 6 0 3 43 184 0 5 16 184 0 0 208 184 0 6 16 184 0 10 208 48 49 3 33 17 51 17 33 21 33 17 35 17 33 39 1 5 156 1 5 254 212 78 254 212 1 122 2 110 253 146 156 253 146 2 110 0 0 1 255 217 254 112 2 127 3 232 0 11 0 27 0 186 0 5 0 6 0 3 43 184 0 5 16 184 0 0 208 184 0 6 16 184 0 10 208 48 49 3 33 17 51 17 33 21 33 17 35 17 33 39 1 44 78 1 44 254 251 156 254 251 1 122 2 110 253 146 156 253 146 2 110 0 0 1 255 217 254 112 2 127 3 232 0 11 0 21 0 186 0 1 0 10 0 3 43 187 0 5 0 1 0 6 0 4 43 48 49 3 33 17 51 17 33 21 33 17 35 17 33 39 1 5 156 1 5 254 251 156 254 251 1 122 2 110 253 107 78 253 107 2 110 0 0 0 0 1 255 217 254 112 2 127 3 232 0 11 0 21 0 186 0 5 0 6 0 3 43 187 0 1 0 1 0 10 0 4 43 48 49 3 33 17 51 17 33 21 33 17 35 17 33 39 1 5 156 1 5 254 251 156 254 251 1 83 2 149 253 146 156 253 146 2 149 0 0 0 0 1 255 217 254 112 2 127 3 232 0 11 0 27 0 186 0 5 0 6 0 3 43 184 0 5 16 184 0 0 208 184 0 6 16 184 0 10 208 48 49 3 33 17 51 17 33 21 33 17 35 17 33 39 1 5 156 1 5 254 251 156 254 251 1 122 2 110 253 146 156 253 146 2 110 0 0 2 0 75 1 5 2 13 1 83 0 3 0 7 0 29 0 187 0 1 0 1 0 2 0 4 43 184 0 1 16 184 0 4 208 184 0 2 16 184 0 6 208 48 49 19 51 21 35 37 51 21 35 75 150 150 1 44 150 150 1 83 78 78 78 0 0 0 0 2 0 75 0 222 2 13 1 122 0 3 0 7 0 27 0 186 0 1 0 2 0 3 43 184 0 1 16 184 0 4 208 184 0 2 16 184 0 6 208 48 49 19 51 21 35 37 51 21 35 75 150 150 1 44 150 150 1 122 156 156 156 0 0 2 1 5 255 181 1 83 2 163 0 3 0 7 0 11 0 186 0 1 0 2 0 3 43 48 49 37 51 21 35 17 51 21 35 1 5 78 78 78 78 175 250 2 238 250 0 0 0 2 0 222 255 181 1 122 2 163 0 3 0 7 0 19 0 186 0 1 0 2 0 3 43 186 0 5 0 6 0 3 43 48 49 55 51 21 35 17 51 21 35 222 156 156 156 156 175 250 2 238 250 0 0 0 0 2 255 217 0 183 2 127 1 161 0 3 0 7 0 23 0 187 0 5 0 1 0 6 0 4 43 187 0 1 0 1 0 2 0 4 43 48 49 3 33 21 33 21 33 21 33 39 2 166 253 90 2 166 253 90 1 161 78 78 78 0 0 0 0 2 0 183 254 112 1 161 3 232 0 3 0 7 0 27 0 186 0 1 0 2 0 3 43 184 0 1 16 184 0 4 208 184 0 2 16 184 0 6 208 48 49 19 51 17 35 19 51 17 35 183 78 78 156 78 78 3 232 250 136 5 120 250 136 0 0 0 0 1 1 5 254 112 2 127 1 161 0 9 0 23 0 187 0 1 0 1 0 2 0 4 43 187 0 5 0 1 0 6 0 4 43 48 49 1 33 21 33 21 33 21 33 17 35 1 5 1 122 254 212 1 44 254 212 78 1 161 78 78 78 253 185 0 0 0 0 1 0 183 254 112 2 127 1 83 0 10 0 29 0 187 0 2 0 1 0 3 0 4 43 184 0 2 16 184 0 0 208 184 0 3 16 184 0 7 208 48 49 19 51 33 21 35 17 35 17 35 17 35 183 78 1 122 222 78 78 78 1 83 78 253 107 2 149 253 107 0 0 2 0 183 254 112 2 127 1 161 0 5 0 11 0 23 0 187 0 1 0 1 0 2 0 4 43 187 0 7 0 1 0 8 0 4 43 48 49 19 33 21 33 17 35 19 33 21 35 17 35 183 1 200 254 134 78 156 1 44 222 78 1 161 78 253 29 2 149 78 253 185 0 1 255 217 254 112 1 83 1 161 0 9 0 23 0 187 0 1 0 1 0 8 0 4 43 187 0 7 0 1 0 4 0 4 43 48 49 3 33 17 35 17 33 53 33 53 33 39 1 122 78 254 212 1 44 254 212 1 161 252 207 2 71 78 78 0 0 0 0 1 255 217 254 112 1 161 1 83 0 9 0 21 0 187 0 7 0 1 0 0 0 4 43 184 0 0 16 184 0 4 208 48 49 1 35 17 35 17 35 53 33 17 35 1 83 78 78 222 1 200 78 1 5 253 107 2 149 78 253 29 0 0 0 2 255 217 254 112 1 161 1 161 0 5 0 11 0 23 0 187 0 1 0 1 0 4 0 4 43 187 0 7 0 1 0 10 0 4 43 48 49 3 33 17 35 17 33 21 33 17 35 17 35 39 1 200 78 254 134 1 44 78 222 1 161 252 207 2 227 78 253 107 2 71 0 1 1 5 0 183 2 127 3 232 0 9 0 23 0 187 0 7 0 1 0 8 0 4 43 187 0 3 0 1 0 4 0 4 43 48 49 1 51 17 33 21 33 21 33 21 33 1 5 78 1 44 254 212 1 44 254 134 3 232 253 185 78 78 78 0 0 0 0 1 0 183 1 5 2 127 3 232 0 9 0 21 0 187 0 7 0 1 0 8 0 4 43 184 0 7 16 184 0 2 208 48 49 19 51 17 51 17 51 17 51 21 33 183 78 78 78 222 254 56 3 232 253 107 2 149 253 107 78 0 0 0 0 2 0 183 0 183 2 127 3 232 0 5 0 11 0 23 0 187 0 3 0 1 0 4 0 4 43 187 0 9 0 1 0 10 0 4 43 48 49 19 51 17 33 21 33 19 51 17 51 21 33 183 78 1 122 254 56 156 78 222 254 212 3 232 253 29 78 3 49 253 185 78 0 1 255 217 0 183 1 83 3 232 0 9 0 23 0 187 0 7 0 1 0 4 0 4 43 187 0 1 0 1 0 8 0 4 43 48 49 3 33 17 51 17 33 53 33 53 33 39 1 44 78 254 134 1 44 254 212 1 161 2 71 252 207 78 78 0 0 0 0 1 255 217 1 5 1 161 3 232 0 9 0 21 0 187 0 5 0 1 0 8 0 4 43 184 0 5 16 184 0 0 208 48 49 3 51 17 51 17 51 17 51 17 33 39 222 78 78 78 254 56 1 83 2 149 253 107 2 149 253 29 0 0 0 2 255 217 0 183 1 161 3 232 0 5 0 11 0 23 0 187 0 1 0 1 0 4 0 4 43 187 0 7 0 1 0 10 0 4 43 48 49 3 33 17 51 17 33 53 51 17 51 17 33 39 1 122 78 254 56 222 78 254 212 1 5 2 227 252 207 234 2 71 253 107 0 1 1 5 254 112 2 127 3 232 0 11 0 23 0 187 0 7 0 1 0 8 0 4 43 187 0 3 0 1 0 4 0 4 43 48 49 1 51 17 33 21 33 21 33 21 33 17 35 1 5 78 1 44 254 212 1 44 254 212 78 3 232 253 185 78 78 78 253 185 0 0 0 2 0 183 254 112 2 127 3 232 0 7 0 11 0 13 0 187 0 3 0 1 0 4 0 4 43 48 49 1 51 17 51 21 35 17 35 3 51 17 35 1 83 78 222 222 78 156 78 78 3 232 253 107 78 253 107 5 120 250 136 0 0 0 0 3 0 183 254 112 2 127 3 232 0 3 0 9 0 15 0 23 0 187 0 11 0 1 0 12 0 4 43 187 0 7 0 1 0 8 0 4 43 48 49 19 51 17 35 19 51 17 51 21 33 21 33 21 35 17 35 183 78 78 156 78 222 254 212 1 44 222 78 3 232 250 136 5 120 253 185 78 78 78 253 185 0 0 0 1 255 217 254 112 1 83 3 232 0 11 0 23 0 187 0 9 0 1 0 6 0 4 43 187 0 1 0 1 0 10 0 4 43 48 49 3 33 17 51 17 35 17 33 53 33 53 33 39 1 44 78 78 254 212 1 44 254 212 1 161 2 71 250 136 2 71 78 78 0 0 0 2 255 217 254 112 1 161 3 232 0 7 0 11 0 13 0 187 0 1 0 1 0 6 0 4 43 48 49 3 51 17 51 17 35 17 35 1 51 17 35 39 222 78 78 222 1 122 78 78 1 83 2 149 250 136 2 149 2 227 250 136 0 0 0 3 255 217 254 112 1 161 3 232 0 3 0 9 0 15 0 23 0 187 0 5 0 1 0 8 0 4 43 187 0 11 0 1 0 14 0 4 43 48 49 1 51 17 35 1 33 17 35 17 35 53 51 17 51 17 33 1 83 78 78 254 134 1 44 78 222 222 78 254 212 3 232 250 136 2 149 253 107 2 71 234 2 71 253 107 0 0 0 2 255 217 254 112 2 127 1 161 0 7 0 11 0 31 0 187 0 9 0 1 0 10 0 4 43 187 0 1 0 1 0 2 0 4 43 184 0 2 16 184 0 6 208 48 49 3 33 21 33 17 35 17 33 53 33 21 33 39 2 166 254 212 78 254 212 2 166 253 90 1 5 78 253 185 2 71 234 78 0 1 255 217 254 112 2 127 1 83 0 11 0 29 0 187 0 1 0 1 0 2 0 4 43 184 0 2 16 184 0 6 208 184 0 2 16 184 0 10 208 48 49 3 33 21 35 17 35 17 35 17 35 17 35 39 2 166 222 78 78 78 222 1 83 78 253 107 2 149 253 107 2 149 0 0 0 3 255 217 254 112 2 127 1 161 0 5 0 11 0 15 0 39 0 187 0 13 0 1 0 14 0 4 43 187 0 1 0 1 0 4 0 4 43 184 0 1 16 184 0 6 208 184 0 4 16 184 0 8 208 48 49 3 33 17 35 17 35 37 33 21 35 17 35 1 33 21 33 39 1 44 78 222 1 122 1 44 222 78 254 134 2 166 253 90 1 5 253 107 2 71 78 78 253 185 3 49 78 0 0 2 255 217 0 183 2 127 3 232 0 7 0 11 0 31 0 187 0 9 0 1 0 10 0 4 43 187 0 5 0 1 0 6 0 4 43 184 0 5 16 184 0 0 208 48 49 3 33 17 51 17 33 21 33 21 33 21 33 39 1 44 78 1 44 253 90 2 166 253 90 1 161 2 71 253 185 78 78 78 0 1 255 217 1 5 2 127 3 232 0 11 0 29 0 187 0 9 0 1 0 10 0 4 43 184 0 9 16 184 0 0 208 184 0 9 16 184 0 4 208 48 49 3 51 17 51 17 51 17 51 17 51 21 33 39 222 78 78 78 222 253 90 1 83 2 149 253 107 2 149 253 107 78 0 0 0 3 255 217 0 183 2 127 3 232 0 5 0 11 0 15 0 39 0 187 0 13 0 1 0 14 0 4 43 187 0 1 0 1 0 4 0 4 43 184 0 1 16 184 0 8 208 184 0 4 16 184 0 10 208 48 49 3 51 17 51 17 33 1 51 17 51 21 33 5 33 21 33 39 222 78 254 212 1 122 78 222 254 212 254 134 2 166 253 90 1 161 2 71 253 107 2 149 253 185 78 78 78 0 0 1 255 217 254 112 2 127 3 232 0 19 0 55 0 187 0 9 0 1 0 10 0 4 43 187 0 5 0 1 0 6 0 4 43 184 0 5 16 184 0 0 208 184 0 10 16 184 0 14 208 184 0 9 16 184 0 16 208 184 0 6 16 184 0 18 208 48 49 3 33 17 51 17 33 21 33 21 33 21 33 17 35 17 33 53 33 53 33 39 1 44 78 1 44 254 212 1 44 254 212 78 254 212 1 44 254 212 1 161 2 71 253 185 78 78 78 253 185 2 71 78 78 0 0 1 255 217 254 112 2 127 3 232 0 19 0 45 0 187 0 9 0 1 0 10 0 4 43 184 0 9 16 184 0 0 208 184 0 9 16 184 0 4 208 184 0 10 16 184 0 14 208 184 0 10 16 184 0 18 208 48 49 3 51 17 51 17 51 17 51 17 51 21 35 17 35 17 35 17 35 17 35 39 222 78 78 78 222 222 78 78 78 222 1 83 2 149 253 107 2 149 253 107 78 253 107 2 149 253 107 2 149 0 0 0 0 4 255 217 254 112 2 127 3 232 0 5 0 11 0 17 0 23 0 55 0 187 0 7 0 1 0 10 0 4 43 187 0 1 0 1 0 4 0 4 43 184 0 1 16 184 0 14 208 184 0 4 16 184 0 16 208 184 0 7 16 184 0 18 208 184 0 10 16 184 0 20 208 48 49 3 51 17 51 17 33 21 33 17 35 17 35 1 51 17 51 21 33 21 33 21 35 17 35 39 222 78 254 212 1 44 78 222 1 122 78 222 254 212 1 44 222 78 1 161 2 71 253 107 78 253 107 2 71 3 49 253 185 78 78 78 253 185 0 0 0 1 1 5 254 112 2 127 1 83 0 15 0 13 0 187 0 6 0 1 0 7 0 4 43 48 49 33 52 62 2 59 1 21 35 34 14 2 21 17 35 1 5 53 92 124 70 39 39 54 95 71 41 78 70 124 92 53 78 41 71 95 54 254 112 0 0 0 0 1 255 217 254 112 1 83 1 83 0 15 0 13 0 187 0 10 0 1 0 7 0 4 43 48 49 1 35 17 52 46 2 43 1 53 51 50 30 2 21 1 83 78 41 71 95 54 39 39 70 124 92 53 254 112 1 144 54 95 71 41 78 53 92 124 70 0 0 1 255 217 1 5 1 83 3 232 0 15 0 13 0 187 0 8 0 1 0 5 0 4 43 48 49 1 20 14 2 43 1 53 51 50 62 2 53 17 51 1 83 53 92 124 70 39 39 54 95 71 41 78 2 88 70 124 92 53 78 41 71 95 54 1 144 0 0 1 1 5 1 5 2 127 3 232 0 15 0 13 0 187 0 8 0 1 0 9 0 4 43 48 49 1 51 17 20 30 2 59 1 21 35 34 46 2 53 1 5 78 41 71 95 54 39 39 70 124 92 53 3 232 254 112 54 95 71 41 78 53 92 124 70 0 0 1 255 217 255 17 2 127 3 71 0 5 0 11 0 186 0 0 0 3 0 3 43 48 49 1 51 21 1 35 53 2 49 78 253 168 78 3 71 78 252 24 78 0 0 1 255 217 255 17 2 127 3 71 0 5 0 11 0 186 0 5 0 2 0 3 43 48 49 5 21 35 1 53 51 2 127 78 253 168 78 161 78 3 232 78 0 0 0 1 255 217 255 17 2 127 3 71 0 15 0 47 0 186 0 2 0 6 0 3 43 186 0 0 0 6 0 2 17 18 57 186 0 8 0 6 0 2 17 18 57 184 0 6 16 184 0 9 208 184 0 2 16 184 0 14 208 48 49 9 1 51 21 9 1 21 35 9 1 35 53 9 1 53 51 1 44 1 5 78 254 235 1 21 78 254 251 254 251 78 1 21 254 235 78 1 148 1 179 78 254 51 254 51 78 1 179 254 77 78 1 205 1 205 78 0 0 0 0 1 255 217 1 5 1 83 1 83 0 3 0 13 0 187 0 1 0 1 0 2 0 4 43 48 49 3 33 21 33 39 1 122 254 134 1 83 78 0 0 1 1 5 1 5 1 83 3 232 0 3 0 11 0 186 0 1 0 2 0 3 43 48 49 1 51 17 35 1 5 78 78 3 232 253 29 0 0 0 0 1 1 5 1 5 2 127 1 83 0 3 0 13 0 187 0 1 0 1 0 2 0 4 43 48 49 1 33 21 33 1 5 1 122 254 134 1 83 78 0 1 1 5 254 112 1 83 1 83 0 3 0 11 0 186 0 1 0 2 0 3 43 48 49 1 51 17 35 1 5 78 78 1 83 253 29 0 0 0 0 1 255 217 0 222 1 83 1 122 0 3 0 11 0 186 0 1 0 2 0 3 43 48 49 3 33 21 33 39 1 122 254 134 1 122 156 0 0 0 0 1 0 222 1 5 1 122 3 232 0 3 0 11 0 186 0 1 0 2 0 3 43 48 49 19 51 17 35 222 156 156 3 232 253 29 0 1 1 5 0 222 2 127 1 122 0 3 0 11 0 186 0 1 0 2 0 3 43 48 49 1 33 21 33 1 5 1 122 254 134 1 122 156 0 0 0 1 0 222 254 112 1 122 1 83 0 3 0 11 0 186 0 1 0 2 0 3 43 48 49 19 51 17 35 222 156 156 1 83 253 29 0 1 255 217 0 222 2 127 1 122 0 7 0 13 0 187 0 1 0 1 0 6 0 4 43 48 49 3 33 53 33 21 33 53 33 39 1 44 1 122 254 134 254 212 1 83 39 156 39 0 0 0 0 1 0 222 254 112 1 122 3 232 0 7 0 11 0 186 0 3 0 6 0 3 43 48 49 19 51 17 51 17 51 17 35 222 39 78 39 156 1 83 2 149 253 107 253 29 0 0 0 1 255 217 0 222 2 127 1 122 0 7 0 13 0 187 0 3 0 1 0 4 0 4 43 48 49 3 33 21 33 21 33 21 33 39 1 122 1 44 254 212 254 134 1 122 39 78 39 0 0 0 0 1 0 222 254 112 1 122 3 232 0 7 0 11 0 186 0 1 0 4 0 3 43 48 49 19 51 17 35 17 35 17 35 222 156 39 78 39 3 232 253 29 253 107 2 149 0 0 0 1 0 0 1 44 2 88 3 32 0 3 0 11 0 184 0 2 47 184 0 1 220 48 49 17 33 17 33 2 88 253 168 3 32 254 12 0 0 0 0 1 0 0 255 56 2 88 255 181 0 3 0 11 0 184 0 2 47 184 0 1 220 48 49 21 33 21 33 2 88 253 168 75 125 0 0 1 0 0 255 56 2 88 0 50 0 3 0 11 0 184 0 2 47 184 0 1 220 48 49 53 33 21 33 2 88 253 168 50 250 0 0 1 0 0 255 56 2 88 0 175 0 3 0 11 0 184 0 2 47 184 0 1 220 48 49 53 33 17 33 2 88 253 168 175 254 137 0 1 0 0 255 56 2 88 1 44 0 3 0 11 0 184 0 2 47 184 0 1 220 48 49 17 33 17 33 2 88 253 168 1 44 254 12 0 0 0 0 1 0 0 255 56 2 88 1 169 0 3 0 11 0 184 0 2 47 184 0 1 220 48 49 17 33 17 33 2 88 253 168 1 169 253 143 0 0 0 0 1 0 0 255 56 2 88 2 38 0 3 0 11 0 184 0 2 47 184 0 1 220 48 49 17 33 17 33 2 88 253 168 2 38 253 18 0 0 0 0 1 0 0 255 56 2 88 2 163 0 3 0 11 0 184 0 2 47 184 0 1 220 48 49 17 33 17 33 2 88 253 168 2 163 252 149 0 0 0 0 1 0 0 255 56 2 88 3 32 0 3 0 11 0 184 0 2 47 184 0 1 220 48 49 17 33 17 33 2 88 253 168 3 32 252 24 0 0 0 0 1 0 0 255 56 2 13 3 32 0 3 0 11 0 184 0 2 47 184 0 1 220 48 49 17 33 17 33 2 13 253 243 3 32 252 24 0 0 0 0 1 0 0 255 56 1 194 3 32 0 3 0 11 0 184 0 2 47 184 0 1 220 48 49 17 33 17 33 1 194 254 62 3 32 252 24 0 0 0 0 1 0 0 255 56 1 119 3 32 0 3 0 11 0 184 0 2 47 184 0 1 220 48 49 17 33 17 33 1 119 254 137 3 32 252 24 0 0 0 0 1 0 0 255 56 1 44 3 32 0 3 0 11 0 184 0 2 47 184 0 1 220 48 49 17 33 17 33 1 44 254 212 3 32 252 24 0 0 0 0 1 0 0 255 56 0 225 3 32 0 3 0 11 0 184 0 2 47 184 0 1 220 48 49 17 51 17 35 225 225 3 32 252 24 0 0 1 0 0 255 56 0 150 3 32 0 3 0 11 0 184 0 2 47 184 0 1 220 48 49 17 51 17 35 150 150 3 32 252 24 0 0 1 0 0 255 56 0 75 3 32 0 3 0 11 0 184 0 2 47 184 0 1 220 48 49 17 51 17 35 75 75 3 32 252 24 0 0 1 1 44 255 56 2 88 3 32 0 3 0 11 0 184 0 2 47 184 0 1 220 48 49 1 33 17 33 1 44 1 44 254 212 3 32 252 24 0 0 4 0 0 255 56 2 88 3 32 0 2 0 6 0 10 0 14 0 47 0 186 0 8 0 1 0 3 43 186 0 4 0 1 0 8 17 18 57 184 0 1 16 184 0 5 208 184 0 8 16 184 0 11 208 186 0 14 0 1 0 8 17 18 57 48 49 21 23 35 17 53 1 35 1 51 1 21 1 51 1 21 30 30 1 74 30 254 212 30 2 58 254 212 30 1 14 150 50 1 244 50 253 218 3 232 252 74 50 3 232 254 62 50 0 0 0 8 0 0 255 56 2 88 3 32 0 2 0 6 0 10 0 14 0 18 0 22 0 26 0 30 0 119 0 186 0 16 0 1 0 3 43 186 0 4 0 1 0 16 17 18 57 184 0 1 16 184 0 5 208 186 0 8 0 1 0 16 17 18 57 184 0 1 16 184 0 9 208 186 0 12 0 1 0 16 17 18 57 184 0 1 16 184 0 13 208 184 0 16 16 184 0 19 208 186 0 22 0 1 0 16 17 18 57 184 0 16 16 184 0 23 208 186 0 26 0 1 0 16 17 18 57 184 0 16 16 184 0 27 208 186 0 30 0 1 0 16 17 18 57 48 49 21 23 35 61 1 19 35 3 53 1 35 1 53 1 35 1 51 1 21 1 51 1 21 1 51 1 21 3 51 23 21 30 30 180 30 150 1 74 30 254 212 1 224 30 254 62 30 2 58 254 62 30 1 164 254 212 30 1 14 150 30 120 150 50 250 50 254 212 1 244 50 253 218 2 238 50 252 224 3 232 252 74 50 3 232 253 68 50 2 238 254 62 50 1 244 200 50 0 16 0 0 255 56 2 88 3 32 0 2 0 6 0 10 0 14 0 18 0 22 0 26 0 30 0 34 0 38 0 42 0 46 0 50 0 54 0 58 0 62 1 7 0 186 0 32 0 1 0 3 43 186 0 4 0 1 0 32 17 18 57 184 0 1 16 184 0 5 208 186 0 8 0 1 0 32 17 18 57 184 0 1 16 184 0 9 208 186 0 12 0 1 0 32 17 18 57 184 0 1 16 184 0 13 208 186 0 16 0 1 0 32 17 18 57 184 0 1 16 184 0 17 208 186 0 20 0 1 0 32 17 18 57 184 0 1 16 184 0 21 208 186 0 24 0 1 0 32 17 18 57 184 0 1 16 184 0 25 208 186 0 28 0 1 0 32 17 18 57 184 0 1 16 184 0 29 208 184 0 32 16 184 0 35 208 186 0 38 0 1 0 32 17 18 57 184 0 32 16 184 0 39 208 186 0 42 0 1 0 32 17 18 57 184 0 32 16 184 0 43 208 186 0 46 0 1 0 32 17 18 57 184 0 32 16 184 0 47 208 186 0 50 0 1 0 32 17 18 57 184 0 32 16 184 0 51 208 186 0 54 0 1 0 32 17 18 57 184 0 32 16 184 0 55 208 186 0 58 0 1 0 32 17 18 57 184 0 32 16 184 0 59 208 186 0 62 0 1 0 32 17 18 57 48 49 21 23 35 61 1 23 35 39 53 19 35 3 53 19 35 3 53 1 35 1 53 1 35 1 53 1 35 1 53 1 35 1 51 1 21 1 51 1 21 1 51 1 21 1 51 1 21 1 51 1 21 3 51 19 21 3 51 23 21 39 51 23 21 30 30 105 30 75 180 30 150 255 30 225 1 74 30 254 212 1 149 30 254 137 1 224 30 254 62 2 43 30 253 243 30 2 58 253 243 30 1 239 254 62 30 1 164 254 137 30 1 89 254 212 30 1 14 225 30 195 150 30 120 75 30 45 150 50 125 50 175 250 50 254 212 1 119 50 254 87 1 244 50 253 218 2 113 50 253 93 2 238 50 252 224 3 107 50 252 99 3 232 252 74 50 3 232 252 199 50 3 107 253 68 50 2 238 253 193 50 2 113 254 62 50 1 244 254 187 50 1 119 200 50 250 75 50 0 1 0 0 2 163 2 88 3 32 0 3 0 13 0 184 0 2 47 185 0 1 0 1 244 48 49 17 33 21 33 2 88 253 168 3 32 125 0 0 0 1 2 13 255 56 2 88 3 32 0 3 0 11 0 184 0 2 47 184 0 1 220 48 49 1 51 17 35 2 13 75 75 3 32 252 24 0 0 0 0 1 0 0 255 56 1 44 1 44 0 3 0 11 0 184 0 2 47 184 0 1 220 48 49 17 33 17 33 1 44 254 212 1 44 254 12 0 0 0 0 1 1 44 255 56 2 88 1 44 0 3 0 11 0 184 0 2 47 184 0 1 220 48 49 1 33 17 33 1 44 1 44 254 212 1 44 254 12 0 0 1 0 0 1 44 1 44 3 32 0 3 0 11 0 184 0 2 47 184 0 1 220 48 49 17 33 17 33 1 44 254 212 3 32 254 12 0 0 0 0 1 0 0 255 56 2 88 3 32 0 5 0 11 0 184 0 5 47 184 0 0 220 48 49 17 33 17 33 17 33 1 44 1 44 253 168 3 32 254 12 254 12 0 0 2 0 0 255 56 2 88 3 32 0 3 0 7 0 11 0 184 0 6 47 184 0 0 220 48 49 1 17 33 17 1 17 33 17 1 44 254 212 2 88 254 212 3 32 254 12 1 244 254 12 254 12 1 244 0 0 1 0 0 255 56 2 88 3 32 0 5 0 11 0 184 0 5 47 184 0 0 220 48 49 17 33 17 33 17 33 2 88 254 212 254 212 3 32 254 12 254 12 0 0 1 0 0 255 56 2 88 3 32 0 5 0 11 0 184 0 2 47 184 0 1 220 48 49 17 33 17 33 17 33 2 88 254 212 254 212 3 32 252 24 1 244 0 0 1 1 44 1 44 2 88 3 32 0 3 0 11 0 184 0 2 47 184 0 1 220 48 49 1 33 17 33 1 44 1 44 254 212 3 32 254 12 0 0 2 0 0 255 56 2 88 3 32 0 3 0 7 0 11 0 184 0 2 47 184 0 4 220 48 49 17 33 17 33 1 33 17 33 1 44 254 212 1 44 1 44 254 212 1 44 254 12 3 232 254 12 0 0 0 0 1 0 0 255 56 2 88 3 32 0 5 0 11 0 184 0 4 47 184 0 3 220 48 49 17 33 17 33 17 33 1 44 1 44 253 168 1 44 1 244 252 24 0 0 0 0 34 1 158 0 1 0 0 0 0 0 0 0 69 0 0 0 1 0 0 0 0 0 1 0 15 0 69 0 1 0 0 0 0 0 2 0 7 0 84 0 1 0 0 0 0 0 3 0 38 0 91 0 1 0 0 0 0 0 4 0 15 0 69 0 1 0 0 0 0 0 5 0 65 0 129 0 1 0 0 0 0 0 6 0 21 0 194 0 1 0 0 0 0 0 7 0 96 0 215 0 1 0 0 0 0 0 8 0 26 1 55 0 1 0 0 0 0 0 9 0 12 1 81 0 1 0 0 0 0 0 11 0 25 1 93 0 1 0 0 0 0 0 13 17 217 1 118 0 1 0 0 0 0 0 14 0 36 19 79 0 1 0 0 0 0 1 0 0 22 19 115 0 1 0 0 0 0 1 1 0 11 19 137 0 1 0 0 0 0 1 2 0 11 19 148 0 1 0 0 0 0 1 3 0 21 19 159 0 3 0 1 4 9 0 0 0 138 19 180 0 3 0 1 4 9 0 1 0 30 20 62 0 3 0 1 4 9 0 2 0 14 20 92 0 3 0 1 4 9 0 3 0 76 20 106 0 3 0 1 4 9 0 4 0 30 20 62 0 3 0 1 4 9 0 5 0 130 20 182 0 3 0 1 4 9 0 6 0 42 21 56 0 3 0 1 4 9 0 7 0 192 21 98 0 3 0 1 4 9 0 8 0 52 22 34 0 3 0 1 4 9 0 9 0 24 22 86 0 3 0 1 4 9 0 11 0 50 22 110 0 3 0 1 4 9 0 13 35 182 22 160 0 3 0 1 4 9 0 14 0 72 58 86 0 3 0 1 4 9 1 0 0 44 58 158 0 3 0 1 4 9 1 1 0 22 58 202 0 3 0 1 4 9 1 2 0 22 58 224 0 3 0 1 4 9 1 3 0 42 58 246 67 111 112 121 114 105 103 104 116 32 50 48 49 48 44 32 50 48 49 50 32 65 100 111 98 101 32 83 121 115 116 101 109 115 32 73 110 99 111 114 112 111 114 97 116 101 100 46 32 65 108 108 32 82 105 103 104 116 115 32 82 101 115 101 114 118 101 100 46 83 111 117 114 99 101 32 67 111 100 101 32 80 114 111 82 101 103 117 108 97 114 49 46 48 49 55 59 65 68 66 69 59 83 111 117 114 99 101 67 111 100 101 80 114 111 45 82 101 103 117 108 97 114 59 65 68 79 66 69 86 101 114 115 105 111 110 32 49 46 48 49 55 59 80 83 32 86 101 114 115 105 111 110 32 49 46 48 48 48 59 104 111 116 99 111 110 118 32 49 46 48 46 55 48 59 109 97 107 101 111 116 102 46 108 105 98 50 46 53 46 53 57 48 48 83 111 117 114 99 101 67 111 100 101 80 114 111 45 82 101 103 117 108 97 114 83 111 117 114 99 101 32 105 115 32 97 32 116 114 97 100 101 109 97 114 107 32 111 102 32 65 100 111 98 101 32 83 121 115 116 101 109 115 32 73 110 99 111 114 112 111 114 97 116 101 100 32 105 110 32 116 104 101 32 85 110 105 116 101 100 32 83 116 97 116 101 115 32 97 110 100 47 111 114 32 111 116 104 101 114 32 99 111 117 110 116 114 105 101 115 46 65 100 111 98 101 32 83 121 115 116 101 109 115 32 73 110 99 111 114 112 111 114 97 116 101 100 80 97 117 108 32 68 46 32 72 117 110 116 104 116 116 112 58 47 47 119 119 119 46 97 100 111 98 101 46 99 111 109 47 116 121 112 101 67 111 112 121 114 105 103 104 116 32 50 48 49 48 44 32 50 48 49 50 32 65 100 111 98 101 32 83 121 115 116 101 109 115 32 73 110 99 111 114 112 111 114 97 116 101 100 32 40 104 116 116 112 58 47 47 119 119 119 46 97 100 111 98 101 46 99 111 109 47 41 44 32 119 105 116 104 32 82 101 115 101 114 118 101 100 32 70 111 110 116 32 78 97 109 101 32 39 83 111 117 114 99 101 39 46 32 65 108 108 32 82 105 103 104 116 115 32 82 101 115 101 114 118 101 100 46 32 83 111 117 114 99 101 32 105 115 32 97 32 116 114 97 100 101 109 97 114 107 32 111 102 32 65 100 111 98 101 32 83 121 115 116 101 109 115 32 73 110 99 111 114 112 111 114 97 116 101 100 32 105 110 32 116 104 101 32 85 110 105 116 101 100 32 83 116 97 116 101 115 32 97 110 100 47 111 114 32 111 116 104 101 114 32 99 111 117 110 116 114 105 101 115 46 13 10 13 10 84 104 105 115 32 70 111 110 116 32 83 111 102 116 119 97 114 101 32 105 115 32 108 105 99 101 110 115 101 100 32 117 110 100 101 114 32 116 104 101 32 83 73 76 32 79 112 101 110 32 70 111 110 116 32 76 105 99 101 110 115 101 44 32 86 101 114 115 105 111 110 32 49 46 49 46 13 10 13 10 84 104 105 115 32 108 105 99 101 110 115 101 32 105 115 32 99 111 112 105 101 100 32 98 101 108 111 119 44 32 97 110 100 32 105 115 32 97 108 115 111 32 97 118 97 105 108 97 98 108 101 32 119 105 116 104 32 97 32 70 65 81 32 97 116 58 32 104 116 116 112 58 47 47 115 99 114 105 112 116 115 46 115 105 108 46 111 114 103 47 79 70 76 13 10 13 10 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 13 10 83 73 76 32 79 80 69 78 32 70 79 78 84 32 76 73 67 69 78 83 69 32 86 101 114 115 105 111 110 32 49 46 49 32 45 32 50 54 32 70 101 98 114 117 97 114 121 32 50 48 48 55 13 10 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 13 10 13 10 80 82 69 65 77 66 76 69 13 10 84 104 101 32 103 111 97 108 115 32 111 102 32 116 104 101 32 79 112 101 110 32 70 111 110 116 32 76 105 99 101 110 115 101 32 40 79 70 76 41 32 97 114 101 32 116 111 32 115 116 105 109 117 108 97 116 101 32 119 111 114 108 100 119 105 100 101 32 100 101 118 101 108 111 112 109 101 110 116 32 111 102 32 99 111 108 108 97 98 111 114 97 116 105 118 101 32 102 111 110 116 32 112 114 111 106 101 99 116 115 44 32 116 111 32 115 117 112 112 111 114 116 32 116 104 101 32 102 111 110 116 32 99 114 101 97 116 105 111 110 32 101 102 102 111 114 116 115 32 111 102 32 97 99 97 100 101 109 105 99 32 97 110 100 32 108 105 110 103 117 105 115 116 105 99 32 99 111 109 109 117 110 105 116 105 101 115 44 32 97 110 100 32 116 111 32 112 114 111 118 105 100 101 32 97 32 102 114 101 101 32 97 110 100 32 111 112 101 110 32 102 114 97 109 101 119 111 114 107 32 105 110 32 119 104 105 99 104 32 102 111 110 116 115 32 109 97 121 32 98 101 32 115 104 97 114 101 100 32 97 110 100 32 105 109 112 114 111 118 101 100 32 105 110 32 112 97 114 116 110 101 114 115 104 105 112 32 119 105 116 104 32 111 116 104 101 114 115 46 13 10 13 10 84 104 101 32 79 70 76 32 97 108 108 111 119 115 32 116 104 101 32 108 105 99 101 110 115 101 100 32 102 111 110 116 115 32 116 111 32 98 101 32 117 115 101 100 44 32 115 116 117 100 105 101 100 44 32 109 111 100 105 102 105 101 100 32 97 110 100 32 114 101 100 105 115 116 114 105 98 117 116 101 100 32 102 114 101 101 108 121 32 97 115 32 108 111 110 103 32 97 115 32 116 104 101 121 32 97 114 101 32 110 111 116 32 115 111 108 100 32 98 121 32 116 104 101 109 115 101 108 118 101 115 46 32 84 104 101 32 102 111 110 116 115 44 32 105 110 99 108 117 100 105 110 103 32 97 110 121 32 100 101 114 105 118 97 116 105 118 101 32 119 111 114 107 115 44 32 99 97 110 32 98 101 32 98 117 110 100 108 101 100 44 32 101 109 98 101 100 100 101 100 44 32 114 101 100 105 115 116 114 105 98 117 116 101 100 32 97 110 100 47 111 114 32 115 111 108 100 32 119 105 116 104 32 97 110 121 32 115 111 102 116 119 97 114 101 32 112 114 111 118 105 100 101 100 32 116 104 97 116 32 97 110 121 32 114 101 115 101 114 118 101 100 32 110 97 109 101 115 32 97 114 101 32 110 111 116 32 117 115 101 100 32 98 121 32 100 101 114 105 118 97 116 105 118 101 32 119 111 114 107 115 46 32 84 104 101 32 102 111 110 116 115 32 97 110 100 32 100 101 114 105 118 97 116 105 118 101 115 44 32 104 111 119 101 118 101 114 44 32 99 97 110 110 111 116 32 98 101 32 114 101 108 101 97 115 101 100 32 117 110 100 101 114 32 97 110 121 32 111 116 104 101 114 32 116 121 112 101 32 111 102 32 108 105 99 101 110 115 101 46 32 84 104 101 32 114 101 113 117 105 114 101 109 101 110 116 32 102 111 114 32 102 111 110 116 115 32 116 111 32 114 101 109 97 105 110 32 117 110 100 101 114 32 116 104 105 115 32 108 105 99 101 110 115 101 32 100 111 101 115 32 110 111 116 32 97 112 112 108 121 32 116 111 32 97 110 121 32 100 111 99 117 109 101 110 116 32 99 114 101 97 116 101 100 32 117 115 105 110 103 32 116 104 101 32 102 111 110 116 115 32 111 114 32 116 104 101 105 114 32 100 101 114 105 118 97 116 105 118 101 115 46 13 10 13 10 68 69 70 73 78 73 84 73 79 78 83 13 10 34 70 111 110 116 32 83 111 102 116 119 97 114 101 34 32 114 101 102 101 114 115 32 116 111 32 116 104 101 32 115 101 116 32 111 102 32 102 105 108 101 115 32 114 101 108 101 97 115 101 100 32 98 121 32 116 104 101 32 67 111 112 121 114 105 103 104 116 32 72 111 108 100 101 114 40 115 41 32 117 110 100 101 114 32 116 104 105 115 32 108 105 99 101 110 115 101 32 97 110 100 32 99 108 101 97 114 108 121 32 109 97 114 107 101 100 32 97 115 32 115 117 99 104 46 32 84 104 105 115 32 109 97 121 32 105 110 99 108 117 100 101 32 115 111 117 114 99 101 32 102 105 108 101 115 44 32 98 117 105 108 100 32 115 99 114 105 112 116 115 32 97 110 100 32 100 111 99 117 109 101 110 116 97 116 105 111 110 46 13 10 13 10 34 82 101 115 101 114 118 101 100 32 70 111 110 116 32 78 97 109 101 34 32 114 101 102 101 114 115 32 116 111 32 97 110 121 32 110 97 109 101 115 32 115 112 101 99 105 102 105 101 100 32 97 115 32 115 117 99 104 32 97 102 116 101 114 32 116 104 101 32 99 111 112 121 114 105 103 104 116 32 115 116 97 116 101 109 101 110 116 40 115 41 46 13 10 13 10 34 79 114 105 103 105 110 97 108 32 86 101 114 115 105 111 110 34 32 114 101 102 101 114 115 32 116 111 32 116 104 101 32 99 111 108 108 101 99 116 105 111 110 32 111 102 32 70 111 110 116 32 83 111 102 116 119 97 114 101 32 99 111 109 112 111 110 101 110 116 115 32 97 115 32 100 105 115 116 114 105 98 117 116 101 100 32 98 121 32 116 104 101 32 67 111 112 121 114 105 103 104 116 32 72 111 108 100 101 114 40 115 41 46 13 10 13 10 34 77 111 100 105 102 105 101 100 32 86 101 114 115 105 111 110 34 32 114 101 102 101 114 115 32 116 111 32 97 110 121 32 100 101 114 105 118 97 116 105 118 101 32 109 97 100 101 32 98 121 32 97 100 100 105 110 103 32 116 111 44 32 100 101 108 101 116 105 110 103 44 32 111 114 32 115 117 98 115 116 105 116 117 116 105 110 103 32 45 45 32 105 110 32 112 97 114 116 32 111 114 32 105 110 32 119 104 111 108 101 32 45 45 32 97 110 121 32 111 102 32 116 104 101 32 99 111 109 112 111 110 101 110 116 115 32 111 102 32 116 104 101 32 79 114 105 103 105 110 97 108 32 86 101 114 115 105 111 110 44 32 98 121 32 99 104 97 110 103 105 110 103 32 102 111 114 109 97 116 115 32 111 114 32 98 121 32 112 111 114 116 105 110 103 32 116 104 101 32 70 111 110 116 32 83 111 102 116 119 97 114 101 32 116 111 32 97 32 110 101 119 32 101 110 118 105 114 111 110 109 101 110 116 46 13 10 13 10 34 65 117 116 104 111 114 34 32 114 101 102 101 114 115 32 116 111 32 97 110 121 32 100 101 115 105 103 110 101 114 44 32 101 110 103 105 110 101 101 114 44 32 112 114 111 103 114 97 109 109 101 114 44 32 116 101 99 104 110 105 99 97 108 32 119 114 105 116 101 114 32 111 114 32 111 116 104 101 114 32 112 101 114 115 111 110 32 119 104 111 32 99 111 110 116 114 105 98 117 116 101 100 32 116 111 32 116 104 101 32 70 111 110 116 32 83 111 102 116 119 97 114 101 46 13 10 13 10 80 69 82 77 73 83 83 73 79 78 32 38 32 67 79 78 68 73 84 73 79 78 83 13 10 80 101 114 109 105 115 115 105 111 110 32 105 115 32 104 101 114 101 98 121 32 103 114 97 110 116 101 100 44 32 102 114 101 101 32 111 102 32 99 104 97 114 103 101 44 32 116 111 32 97 110 121 32 112 101 114 115 111 110 32 111 98 116 97 105 110 105 110 103 32 97 32 99 111 112 121 32 111 102 32 116 104 101 32 70 111 110 116 32 83 111 102 116 119 97 114 101 44 32 116 111 32 117 115 101 44 32 115 116 117 100 121 44 32 99 111 112 121 44 32 109 101 114 103 101 44 32 101 109 98 101 100 44 32 109 111 100 105 102 121 44 32 114 101 100 105 115 116 114 105 98 117 116 101 44 32 97 110 100 32 115 101 108 108 32 109 111 100 105 102 105 101 100 32 97 110 100 32 117 110 109 111 100 105 102 105 101 100 32 99 111 112 105 101 115 32 111 102 32 116 104 101 32 70 111 110 116 32 83 111 102 116 119 97 114 101 44 32 115 117 98 106 101 99 116 32 116 111 32 116 104 101 32 102 111 108 108 111 119 105 110 103 32 99 111 110 100 105 116 105 111 110 115 58 13 10 13 10 49 41 32 78 101 105 116 104 101 114 32 116 104 101 32 70 111 110 116 32 83 111 102 116 119 97 114 101 32 110 111 114 32 97 110 121 32 111 102 32 105 116 115 32 105 110 100 105 118 105 100 117 97 108 32 99 111 109 112 111 110 101 110 116 115 44 32 105 110 32 79 114 105 103 105 110 97 108 32 111 114 32 77 111 100 105 102 105 101 100 32 86 101 114 115 105 111 110 115 44 32 109 97 121 32 98 101 32 115 111 108 100 32 98 121 32 105 116 115 101 108 102 46 13 10 13 10 50 41 32 79 114 105 103 105 110 97 108 32 111 114 32 77 111 100 105 102 105 101 100 32 86 101 114 115 105 111 110 115 32 111 102 32 116 104 101 32 70 111 110 116 32 83 111 102 116 119 97 114 101 32 109 97 121 32 98 101 32 98 117 110 100 108 101 100 44 32 114 101 100 105 115 116 114 105 98 117 116 101 100 32 97 110 100 47 111 114 32 115 111 108 100 32 119 105 116 104 32 97 110 121 32 115 111 102 116 119 97 114 101 44 32 112 114 111 118 105 100 101 100 32 116 104 97 116 32 101 97 99 104 32 99 111 112 121 32 99 111 110 116 97 105 110 115 32 116 104 101 32 97 98 111 118 101 32 99 111 112 121 114 105 103 104 116 32 110 111 116 105 99 101 32 97 110 100 32 116 104 105 115 32 108 105 99 101 110 115 101 46 32 84 104 101 115 101 32 99 97 110 32 98 101 32 105 110 99 108 117 100 101 100 32 101 105 116 104 101 114 32 97 115 32 115 116 97 110 100 45 97 108 111 110 101 32 116 101 120 116 32 102 105 108 101 115 44 32 104 117 109 97 110 45 114 101 97 100 97 98 108 101 32 104 101 97 100 101 114 115 32 111 114 32 105 110 32 116 104 101 32 97 112 112 114 111 112 114 105 97 116 101 32 109 97 99 104 105 110 101 45 114 101 97 100 97 98 108 101 32 109 101 116 97 100 97 116 97 32 102 105 101 108 100 115 32 119 105 116 104 105 110 32 116 101 120 116 32 111 114 32 98 105 110 97 114 121 32 102 105 108 101 115 32 97 115 32 108 111 110 103 32 97 115 32 116 104 111 115 101 32 102 105 101 108 100 115 32 99 97 110 32 98 101 32 101 97 115 105 108 121 32 118 105 101 119 101 100 32 98 121 32 116 104 101 32 117 115 101 114 46 13 10 13 10 51 41 32 78 111 32 77 111 100 105 102 105 101 100 32 86 101 114 115 105 111 110 32 111 102 32 116 104 101 32 70 111 110 116 32 83 111 102 116 119 97 114 101 32 109 97 121 32 117 115 101 32 116 104 101 32 82 101 115 101 114 118 101 100 32 70 111 110 116 32 78 97 109 101 40 115 41 32 117 110 108 101 115 115 32 101 120 112 108 105 99 105 116 32 119 114 105 116 116 101 110 32 112 101 114 109 105 115 115 105 111 110 32 105 115 32 103 114 97 110 116 101 100 32 98 121 32 116 104 101 32 99 111 114 114 101 115 112 111 110 100 105 110 103 32 67 111 112 121 114 105 103 104 116 32 72 111 108 100 101 114 46 32 84 104 105 115 32 114 101 115 116 114 105 99 116 105 111 110 32 111 110 108 121 32 97 112 112 108 105 101 115 32 116 111 32 116 104 101 32 112 114 105 109 97 114 121 32 102 111 110 116 32 110 97 109 101 32 97 115 32 112 114 101 115 101 110 116 101 100 32 116 111 32 116 104 101 32 117 115 101 114 115 46 13 10 13 10 52 41 32 84 104 101 32 110 97 109 101 40 115 41 32 111 102 32 116 104 101 32 67 111 112 121 114 105 103 104 116 32 72 111 108 100 101 114 40 115 41 32 111 114 32 116 104 101 32 65 117 116 104 111 114 40 115 41 32 111 102 32 116 104 101 32 70 111 110 116 32 83 111 102 116 119 97 114 101 32 115 104 97 108 108 32 110 111 116 32 98 101 32 117 115 101 100 32 116 111 32 112 114 111 109 111 116 101 44 32 101 110 100 111 114 115 101 32 111 114 32 97 100 118 101 114 116 105 115 101 32 97 110 121 32 77 111 100 105 102 105 101 100 32 86 101 114 115 105 111 110 44 32 101 120 99 101 112 116 32 116 111 32 97 99 107 110 111 119 108 101 100 103 101 32 116 104 101 32 99 111 110 116 114 105 98 117 116 105 111 110 40 115 41 32 111 102 32 116 104 101 32 67 111 112 121 114 105 103 104 116 32 72 111 108 100 101 114 40 115 41 32 97 110 100 32 116 104 101 32 65 117 116 104 111 114 40 115 41 32 111 114 32 119 105 116 104 32 116 104 101 105 114 32 101 120 112 108 105 99 105 116 32 119 114 105 116 116 101 110 32 112 101 114 109 105 115 115 105 111 110 46 13 10 13 10 53 41 32 84 104 101 32 70 111 110 116 32 83 111 102 116 119 97 114 101 44 32 109 111 100 105 102 105 101 100 32 111 114 32 117 110 109 111 100 105 102 105 101 100 44 32 105 110 32 112 97 114 116 32 111 114 32 105 110 32 119 104 111 108 101 44 32 109 117 115 116 32 98 101 32 100 105 115 116 114 105 98 117 116 101 100 32 101 110 116 105 114 101 108 121 32 117 110 100 101 114 32 116 104 105 115 32 108 105 99 101 110 115 101 44 32 97 110 100 32 109 117 115 116 32 110 111 116 32 98 101 32 100 105 115 116 114 105 98 117 116 101 100 32 117 110 100 101 114 32 97 110 121 32 111 116 104 101 114 32 108 105 99 101 110 115 101 46 32 84 104 101 32 114 101 113 117 105 114 101 109 101 110 116 32 102 111 114 32 102 111 110 116 115 32 116 111 32 114 101 109 97 105 110 32 117 110 100 101 114 32 116 104 105 115 32 108 105 99 101 110 115 101 32 100 111 101 115 32 110 111 116 32 97 112 112 108 121 32 116 111 32 97 110 121 32 100 111 99 117 109 101 110 116 32 99 114 101 97 116 101 100 32 117 115 105 110 103 32 116 104 101 32 70 111 110 116 32 83 111 102 116 119 97 114 101 46 13 10 13 10 84 69 82 77 73 78 65 84 73 79 78 13 10 84 104 105 115 32 108 105 99 101 110 115 101 32 98 101 99 111 109 101 115 32 110 117 108 108 32 97 110 100 32 118 111 105 100 32 105 102 32 97 110 121 32 111 102 32 116 104 101 32 97 98 111 118 101 32 99 111 110 100 105 116 105 111 110 115 32 97 114 101 32 110 111 116 32 109 101 116 46 13 10 13 10 68 73 83 67 76 65 73 77 69 82 13 10 84 72 69 32 70 79 78 84 32 83 79 70 84 87 65 82 69 32 73 83 32 80 82 79 86 73 68 69 68 32 34 65 83 32 73 83 34 44 32 87 73 84 72 79 85 84 32 87 65 82 82 65 78 84 89 32 79 70 32 65 78 89 32 75 73 78 68 44 32 69 88 80 82 69 83 83 32 79 82 32 73 77 80 76 73 69 68 44 32 73 78 67 76 85 68 73 78 71 32 66 85 84 32 78 79 84 32 76 73 77 73 84 69 68 32 84 79 32 65 78 89 32 87 65 82 82 65 78 84 73 69 83 32 79 70 32 77 69 82 67 72 65 78 84 65 66 73 76 73 84 89 44 32 70 73 84 78 69 83 83 32 70 79 82 32 65 32 80 65 82 84 73 67 85 76 65 82 32 80 85 82 80 79 83 69 32 65 78 68 32 78 79 78 73 78 70 82 73 78 71 69 77 69 78 84 32 79 70 32 67 79 80 89 82 73 71 72 84 44 32 80 65 84 69 78 84 44 32 84 82 65 68 69 77 65 82 75 44 32 79 82 32 79 84 72 69 82 32 82 73 71 72 84 46 32 73 78 32 78 79 32 69 86 69 78 84 32 83 72 65 76 76 32 84 72 69 32 67 79 80 89 82 73 71 72 84 32 72 79 76 68 69 82 32 66 69 32 76 73 65 66 76 69 32 70 79 82 32 65 78 89 32 67 76 65 73 77 44 32 68 65 77 65 71 69 83 32 79 82 32 79 84 72 69 82 32 76 73 65 66 73 76 73 84 89 44 32 73 78 67 76 85 68 73 78 71 32 65 78 89 32 71 69 78 69 82 65 76 44 32 83 80 69 67 73 65 76 44 32 73 78 68 73 82 69 67 84 44 32 73 78 67 73 68 69 78 84 65 76 44 32 79 82 32 67 79 78 83 69 81 85 69 78 84 73 65 76 32 68 65 77 65 71 69 83 44 32 87 72 69 84 72 69 82 32 73 78 32 65 78 32 65 67 84 73 79 78 32 79 70 32 67 79 78 84 82 65 67 84 44 32 84 79 82 84 32 79 82 32 79 84 72 69 82 87 73 83 69 44 32 65 82 73 83 73 78 71 32 70 82 79 77 44 32 79 85 84 32 79 70 32 84 72 69 32 85 83 69 32 79 82 32 73 78 65 66 73 76 73 84 89 32 84 79 32 85 83 69 32 84 72 69 32 70 79 78 84 32 83 79 70 84 87 65 82 69 32 79 82 32 70 82 79 77 32 79 84 72 69 82 32 68 69 65 76 73 78 71 83 32 73 78 32 84 72 69 32 70 79 78 84 32 83 79 70 84 87 65 82 69 46 104 116 116 112 58 47 47 119 119 119 46 97 100 111 98 101 46 99 111 109 47 116 121 112 101 47 108 101 103 97 108 46 104 116 109 108 84 121 112 111 103 114 97 112 104 105 99 32 97 108 116 101 114 110 97 116 101 115 65 108 116 101 114 110 97 116 101 32 97 65 108 116 101 114 110 97 116 101 32 103 65 108 116 101 114 110 97 116 101 32 100 111 108 108 97 114 32 115 105 103 110 0 67 0 111 0 112 0 121 0 114 0 105 0 103 0 104 0 116 0 32 0 50 0 48 0 49 0 48 0 44 0 32 0 50 0 48 0 49 0 50 0 32 0 65 0 100 0 111 0 98 0 101 0 32 0 83 0 121 0 115 0 116 0 101 0 109 0 115 0 32 0 73 0 110 0 99 0 111 0 114 0 112 0 111 0 114 0 97 0 116 0 101 0 100 0 46 0 32 0 65 0 108 0 108 0 32 0 82 0 105 0 103 0 104 0 116 0 115 0 32 0 82 0 101 0 115 0 101 0 114 0 118 0 101 0 100 0 46 0 83 0 111 0 117 0 114 0 99 0 101 0 32 0 67 0 111 0 100 0 101 0 32 0 80 0 114 0 111 0 82 0 101 0 103 0 117 0 108 0 97 0 114 0 49 0 46 0 48 0 49 0 55 0 59 0 65 0 68 0 66 0 69 0 59 0 83 0 111 0 117 0 114 0 99 0 101 0 67 0 111 0 100 0 101 0 80 0 114 0 111 0 45 0 82 0 101 0 103 0 117 0 108 0 97 0 114 0 59 0 65 0 68 0 79 0 66 0 69 0 86 0 101 0 114 0 115 0 105 0 111 0 110 0 32 0 49 0 46 0 48 0 49 0 55 0 59 0 80 0 83 0 32 0 86 0 101 0 114 0 115 0 105 0 111 0 110 0 32 0 49 0 46 0 48 0 48 0 48 0 59 0 104 0 111 0 116 0 99 0 111 0 110 0 118 0 32 0 49 0 46 0 48 0 46 0 55 0 48 0 59 0 109 0 97 0 107 0 101 0 111 0 116 0 102 0 46 0 108 0 105 0 98 0 50 0 46 0 53 0 46 0 53 0 57 0 48 0 48 0 83 0 111 0 117 0 114 0 99 0 101 0 67 0 111 0 100 0 101 0 80 0 114 0 111 0 45 0 82 0 101 0 103 0 117 0 108 0 97 0 114 0 83 0 111 0 117 0 114 0 99 0 101 0 32 0 105 0 115 0 32 0 97 0 32 0 116 0 114 0 97 0 100 0 101 0 109 0 97 0 114 0 107 0 32 0 111 0 102 0 32 0 65 0 100 0 111 0 98 0 101 0 32 0 83 0 121 0 115 0 116 0 101 0 109 0 115 0 32 0 73 0 110 0 99 0 111 0 114 0 112 0 111 0 114 0 97 0 116 0 101 0 100 0 32 0 105 0 110 0 32 0 116 0 104 0 101 0 32 0 85 0 110 0 105 0 116 0 101 0 100 0 32 0 83 0 116 0 97 0 116 0 101 0 115 0 32 0 97 0 110 0 100 0 47 0 111 0 114 0 32 0 111 0 116 0 104 0 101 0 114 0 32 0 99 0 111 0 117 0 110 0 116 0 114 0 105 0 101 0 115 0 46 0 65 0 100 0 111 0 98 0 101 0 32 0 83 0 121 0 115 0 116 0 101 0 109 0 115 0 32 0 73 0 110 0 99 0 111 0 114 0 112 0 111 0 114 0 97 0 116 0 101 0 100 0 80 0 97 0 117 0 108 0 32 0 68 0 46 0 32 0 72 0 117 0 110 0 116 0 104 0 116 0 116 0 112 0 58 0 47 0 47 0 119 0 119 0 119 0 46 0 97 0 100 0 111 0 98 0 101 0 46 0 99 0 111 0 109 0 47 0 116 0 121 0 112 0 101 0 67 0 111 0 112 0 121 0 114 0 105 0 103 0 104 0 116 0 32 0 50 0 48 0 49 0 48 0 44 0 32 0 50 0 48 0 49 0 50 0 32 0 65 0 100 0 111 0 98 0 101 0 32 0 83 0 121 0 115 0 116 0 101 0 109 0 115 0 32 0 73 0 110 0 99 0 111 0 114 0 112 0 111 0 114 0 97 0 116 0 101 0 100 0 32 0 40 0 104 0 116 0 116 0 112 0 58 0 47 0 47 0 119 0 119 0 119 0 46 0 97 0 100 0 111 0 98 0 101 0 46 0 99 0 111 0 109 0 47 0 41 0 44 0 32 0 119 0 105 0 116 0 104 0 32 0 82 0 101 0 115 0 101 0 114 0 118 0 101 0 100 0 32 0 70 0 111 0 110 0 116 0 32 0 78 0 97 0 109 0 101 0 32 0 39 0 83 0 111 0 117 0 114 0 99 0 101 0 39 0 46 0 32 0 65 0 108 0 108 0 32 0 82 0 105 0 103 0 104 0 116 0 115 0 32 0 82 0 101 0 115 0 101 0 114 0 118 0 101 0 100 0 46 0 32 0 83 0 111 0 117 0 114 0 99 0 101 0 32 0 105 0 115 0 32 0 97 0 32 0 116 0 114 0 97 0 100 0 101 0 109 0 97 0 114 0 107 0 32 0 111 0 102 0 32 0 65 0 100 0 111 0 98 0 101 0 32 0 83 0 121 0 115 0 116 0 101 0 109 0 115 0 32 0 73 0 110 0 99 0 111 0 114 0 112 0 111 0 114 0 97 0 116 0 101 0 100 0 32 0 105 0 110 0 32 0 116 0 104 0 101 0 32 0 85 0 110 0 105 0 116 0 101 0 100 0 32 0 83 0 116 0 97 0 116 0 101 0 115 0 32 0 97 0 110 0 100 0 47 0 111 0 114 0 32 0 111 0 116 0 104 0 101 0 114 0 32 0 99 0 111 0 117 0 110 0 116 0 114 0 105 0 101 0 115 0 46 0 13 0 10 0 13 0 10 0 84 0 104 0 105 0 115 0 32 0 70 0 111 0 110 0 116 0 32 0 83 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 32 0 105 0 115 0 32 0 108 0 105 0 99 0 101 0 110 0 115 0 101 0 100 0 32 0 117 0 110 0 100 0 101 0 114 0 32 0 116 0 104 0 101 0 32 0 83 0 73 0 76 0 32 0 79 0 112 0 101 0 110 0 32 0 70 0 111 0 110 0 116 0 32 0 76 0 105 0 99 0 101 0 110 0 115 0 101 0 44 0 32 0 86 0 101 0 114 0 115 0 105 0 111 0 110 0 32 0 49 0 46 0 49 0 46 0 13 0 10 0 13 0 10 0 84 0 104 0 105 0 115 0 32 0 108 0 105 0 99 0 101 0 110 0 115 0 101 0 32 0 105 0 115 0 32 0 99 0 111 0 112 0 105 0 101 0 100 0 32 0 98 0 101 0 108 0 111 0 119 0 44 0 32 0 97 0 110 0 100 0 32 0 105 0 115 0 32 0 97 0 108 0 115 0 111 0 32 0 97 0 118 0 97 0 105 0 108 0 97 0 98 0 108 0 101 0 32 0 119 0 105 0 116 0 104 0 32 0 97 0 32 0 70 0 65 0 81 0 32 0 97 0 116 0 58 0 32 0 104 0 116 0 116 0 112 0 58 0 47 0 47 0 115 0 99 0 114 0 105 0 112 0 116 0 115 0 46 0 115 0 105 0 108 0 46 0 111 0 114 0 103 0 47 0 79 0 70 0 76 0 13 0 10 0 13 0 10 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 13 0 10 0 83 0 73 0 76 0 32 0 79 0 80 0 69 0 78 0 32 0 70 0 79 0 78 0 84 0 32 0 76 0 73 0 67 0 69 0 78 0 83 0 69 0 32 0 86 0 101 0 114 0 115 0 105 0 111 0 110 0 32 0 49 0 46 0 49 0 32 0 45 0 32 0 50 0 54 0 32 0 70 0 101 0 98 0 114 0 117 0 97 0 114 0 121 0 32 0 50 0 48 0 48 0 55 0 13 0 10 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 13 0 10 0 13 0 10 0 80 0 82 0 69 0 65 0 77 0 66 0 76 0 69 0 13 0 10 0 84 0 104 0 101 0 32 0 103 0 111 0 97 0 108 0 115 0 32 0 111 0 102 0 32 0 116 0 104 0 101 0 32 0 79 0 112 0 101 0 110 0 32 0 70 0 111 0 110 0 116 0 32 0 76 0 105 0 99 0 101 0 110 0 115 0 101 0 32 0 40 0 79 0 70 0 76 0 41 0 32 0 97 0 114 0 101 0 32 0 116 0 111 0 32 0 115 0 116 0 105 0 109 0 117 0 108 0 97 0 116 0 101 0 32 0 119 0 111 0 114 0 108 0 100 0 119 0 105 0 100 0 101 0 32 0 100 0 101 0 118 0 101 0 108 0 111 0 112 0 109 0 101 0 110 0 116 0 32 0 111 0 102 0 32 0 99 0 111 0 108 0 108 0 97 0 98 0 111 0 114 0 97 0 116 0 105 0 118 0 101 0 32 0 102 0 111 0 110 0 116 0 32 0 112 0 114 0 111 0 106 0 101 0 99 0 116 0 115 0 44 0 32 0 116 0 111 0 32 0 115 0 117 0 112 0 112 0 111 0 114 0 116 0 32 0 116 0 104 0 101 0 32 0 102 0 111 0 110 0 116 0 32 0 99 0 114 0 101 0 97 0 116 0 105 0 111 0 110 0 32 0 101 0 102 0 102 0 111 0 114 0 116 0 115 0 32 0 111 0 102 0 32 0 97 0 99 0 97 0 100 0 101 0 109 0 105 0 99 0 32 0 97 0 110 0 100 0 32 0 108 0 105 0 110 0 103 0 117 0 105 0 115 0 116 0 105 0 99 0 32 0 99 0 111 0 109 0 109 0 117 0 110 0 105 0 116 0 105 0 101 0 115 0 44 0 32 0 97 0 110 0 100 0 32 0 116 0 111 0 32 0 112 0 114 0 111 0 118 0 105 0 100 0 101 0 32 0 97 0 32 0 102 0 114 0 101 0 101 0 32 0 97 0 110 0 100 0 32 0 111 0 112 0 101 0 110 0 32 0 102 0 114 0 97 0 109 0 101 0 119 0 111 0 114 0 107 0 32 0 105 0 110 0 32 0 119 0 104 0 105 0 99 0 104 0 32 0 102 0 111 0 110 0 116 0 115 0 32 0 109 0 97 0 121 0 32 0 98 0 101 0 32 0 115 0 104 0 97 0 114 0 101 0 100 0 32 0 97 0 110 0 100 0 32 0 105 0 109 0 112 0 114 0 111 0 118 0 101 0 100 0 32 0 105 0 110 0 32 0 112 0 97 0 114 0 116 0 110 0 101 0 114 0 115 0 104 0 105 0 112 0 32 0 119 0 105 0 116 0 104 0 32 0 111 0 116 0 104 0 101 0 114 0 115 0 46 0 13 0 10 0 13 0 10 0 84 0 104 0 101 0 32 0 79 0 70 0 76 0 32 0 97 0 108 0 108 0 111 0 119 0 115 0 32 0 116 0 104 0 101 0 32 0 108 0 105 0 99 0 101 0 110 0 115 0 101 0 100 0 32 0 102 0 111 0 110 0 116 0 115 0 32 0 116 0 111 0 32 0 98 0 101 0 32 0 117 0 115 0 101 0 100 0 44 0 32 0 115 0 116 0 117 0 100 0 105 0 101 0 100 0 44 0 32 0 109 0 111 0 100 0 105 0 102 0 105 0 101 0 100 0 32 0 97 0 110 0 100 0 32 0 114 0 101 0 100 0 105 0 115 0 116 0 114 0 105 0 98 0 117 0 116 0 101 0 100 0 32 0 102 0 114 0 101 0 101 0 108 0 121 0 32 0 97 0 115 0 32 0 108 0 111 0 110 0 103 0 32 0 97 0 115 0 32 0 116 0 104 0 101 0 121 0 32 0 97 0 114 0 101 0 32 0 110 0 111 0 116 0 32 0 115 0 111 0 108 0 100 0 32 0 98 0 121 0 32 0 116 0 104 0 101 0 109 0 115 0 101 0 108 0 118 0 101 0 115 0 46 0 32 0 84 0 104 0 101 0 32 0 102 0 111 0 110 0 116 0 115 0 44 0 32 0 105 0 110 0 99 0 108 0 117 0 100 0 105 0 110 0 103 0 32 0 97 0 110 0 121 0 32 0 100 0 101 0 114 0 105 0 118 0 97 0 116 0 105 0 118 0 101 0 32 0 119 0 111 0 114 0 107 0 115 0 44 0 32 0 99 0 97 0 110 0 32 0 98 0 101 0 32 0 98 0 117 0 110 0 100 0 108 0 101 0 100 0 44 0 32 0 101 0 109 0 98 0 101 0 100 0 100 0 101 0 100 0 44 0 32 0 114 0 101 0 100 0 105 0 115 0 116 0 114 0 105 0 98 0 117 0 116 0 101 0 100 0 32 0 97 0 110 0 100 0 47 0 111 0 114 0 32 0 115 0 111 0 108 0 100 0 32 0 119 0 105 0 116 0 104 0 32 0 97 0 110 0 121 0 32 0 115 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 32 0 112 0 114 0 111 0 118 0 105 0 100 0 101 0 100 0 32 0 116 0 104 0 97 0 116 0 32 0 97 0 110 0 121 0 32 0 114 0 101 0 115 0 101 0 114 0 118 0 101 0 100 0 32 0 110 0 97 0 109 0 101 0 115 0 32 0 97 0 114 0 101 0 32 0 110 0 111 0 116 0 32 0 117 0 115 0 101 0 100 0 32 0 98 0 121 0 32 0 100 0 101 0 114 0 105 0 118 0 97 0 116 0 105 0 118 0 101 0 32 0 119 0 111 0 114 0 107 0 115 0 46 0 32 0 84 0 104 0 101 0 32 0 102 0 111 0 110 0 116 0 115 0 32 0 97 0 110 0 100 0 32 0 100 0 101 0 114 0 105 0 118 0 97 0 116 0 105 0 118 0 101 0 115 0 44 0 32 0 104 0 111 0 119 0 101 0 118 0 101 0 114 0 44 0 32 0 99 0 97 0 110 0 110 0 111 0 116 0 32 0 98 0 101 0 32 0 114 0 101 0 108 0 101 0 97 0 115 0 101 0 100 0 32 0 117 0 110 0 100 0 101 0 114 0 32 0 97 0 110 0 121 0 32 0 111 0 116 0 104 0 101 0 114 0 32 0 116 0 121 0 112 0 101 0 32 0 111 0 102 0 32 0 108 0 105 0 99 0 101 0 110 0 115 0 101 0 46 0 32 0 84 0 104 0 101 0 32 0 114 0 101 0 113 0 117 0 105 0 114 0 101 0 109 0 101 0 110 0 116 0 32 0 102 0 111 0 114 0 32 0 102 0 111 0 110 0 116 0 115 0 32 0 116 0 111 0 32 0 114 0 101 0 109 0 97 0 105 0 110 0 32 0 117 0 110 0 100 0 101 0 114 0 32 0 116 0 104 0 105 0 115 0 32 0 108 0 105 0 99 0 101 0 110 0 115 0 101 0 32 0 100 0 111 0 101 0 115 0 32 0 110 0 111 0 116 0 32 0 97 0 112 0 112 0 108 0 121 0 32 0 116 0 111 0 32 0 97 0 110 0 121 0 32 0 100 0 111 0 99 0 117 0 109 0 101 0 110 0 116 0 32 0 99 0 114 0 101 0 97 0 116 0 101 0 100 0 32 0 117 0 115 0 105 0 110 0 103 0 32 0 116 0 104 0 101 0 32 0 102 0 111 0 110 0 116 0 115 0 32 0 111 0 114 0 32 0 116 0 104 0 101 0 105 0 114 0 32 0 100 0 101 0 114 0 105 0 118 0 97 0 116 0 105 0 118 0 101 0 115 0 46 0 13 0 10 0 13 0 10 0 68 0 69 0 70 0 73 0 78 0 73 0 84 0 73 0 79 0 78 0 83 0 13 0 10 0 34 0 70 0 111 0 110 0 116 0 32 0 83 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 34 0 32 0 114 0 101 0 102 0 101 0 114 0 115 0 32 0 116 0 111 0 32 0 116 0 104 0 101 0 32 0 115 0 101 0 116 0 32 0 111 0 102 0 32 0 102 0 105 0 108 0 101 0 115 0 32 0 114 0 101 0 108 0 101 0 97 0 115 0 101 0 100 0 32 0 98 0 121 0 32 0 116 0 104 0 101 0 32 0 67 0 111 0 112 0 121 0 114 0 105 0 103 0 104 0 116 0 32 0 72 0 111 0 108 0 100 0 101 0 114 0 40 0 115 0 41 0 32 0 117 0 110 0 100 0 101 0 114 0 32 0 116 0 104 0 105 0 115 0 32 0 108 0 105 0 99 0 101 0 110 0 115 0 101 0 32 0 97 0 110 0 100 0 32 0 99 0 108 0 101 0 97 0 114 0 108 0 121 0 32 0 109 0 97 0 114 0 107 0 101 0 100 0 32 0 97 0 115 0 32 0 115 0 117 0 99 0 104 0 46 0 32 0 84 0 104 0 105 0 115 0 32 0 109 0 97 0 121 0 32 0 105 0 110 0 99 0 108 0 117 0 100 0 101 0 32 0 115 0 111 0 117 0 114 0 99 0 101 0 32 0 102 0 105 0 108 0 101 0 115 0 44 0 32 0 98 0 117 0 105 0 108 0 100 0 32 0 115 0 99 0 114 0 105 0 112 0 116 0 115 0 32 0 97 0 110 0 100 0 32 0 100 0 111 0 99 0 117 0 109 0 101 0 110 0 116 0 97 0 116 0 105 0 111 0 110 0 46 0 13 0 10 0 13 0 10 0 34 0 82 0 101 0 115 0 101 0 114 0 118 0 101 0 100 0 32 0 70 0 111 0 110 0 116 0 32 0 78 0 97 0 109 0 101 0 34 0 32 0 114 0 101 0 102 0 101 0 114 0 115 0 32 0 116 0 111 0 32 0 97 0 110 0 121 0 32 0 110 0 97 0 109 0 101 0 115 0 32 0 115 0 112 0 101 0 99 0 105 0 102 0 105 0 101 0 100 0 32 0 97 0 115 0 32 0 115 0 117 0 99 0 104 0 32 0 97 0 102 0 116 0 101 0 114 0 32 0 116 0 104 0 101 0 32 0 99 0 111 0 112 0 121 0 114 0 105 0 103 0 104 0 116 0 32 0 115 0 116 0 97 0 116 0 101 0 109 0 101 0 110 0 116 0 40 0 115 0 41 0 46 0 13 0 10 0 13 0 10 0 34 0 79 0 114 0 105 0 103 0 105 0 110 0 97 0 108 0 32 0 86 0 101 0 114 0 115 0 105 0 111 0 110 0 34 0 32 0 114 0 101 0 102 0 101 0 114 0 115 0 32 0 116 0 111 0 32 0 116 0 104 0 101 0 32 0 99 0 111 0 108 0 108 0 101 0 99 0 116 0 105 0 111 0 110 0 32 0 111 0 102 0 32 0 70 0 111 0 110 0 116 0 32 0 83 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 32 0 99 0 111 0 109 0 112 0 111 0 110 0 101 0 110 0 116 0 115 0 32 0 97 0 115 0 32 0 100 0 105 0 115 0 116 0 114 0 105 0 98 0 117 0 116 0 101 0 100 0 32 0 98 0 121 0 32 0 116 0 104 0 101 0 32 0 67 0 111 0 112 0 121 0 114 0 105 0 103 0 104 0 116 0 32 0 72 0 111 0 108 0 100 0 101 0 114 0 40 0 115 0 41 0 46 0 13 0 10 0 13 0 10 0 34 0 77 0 111 0 100 0 105 0 102 0 105 0 101 0 100 0 32 0 86 0 101 0 114 0 115 0 105 0 111 0 110 0 34 0 32 0 114 0 101 0 102 0 101 0 114 0 115 0 32 0 116 0 111 0 32 0 97 0 110 0 121 0 32 0 100 0 101 0 114 0 105 0 118 0 97 0 116 0 105 0 118 0 101 0 32 0 109 0 97 0 100 0 101 0 32 0 98 0 121 0 32 0 97 0 100 0 100 0 105 0 110 0 103 0 32 0 116 0 111 0 44 0 32 0 100 0 101 0 108 0 101 0 116 0 105 0 110 0 103 0 44 0 32 0 111 0 114 0 32 0 115 0 117 0 98 0 115 0 116 0 105 0 116 0 117 0 116 0 105 0 110 0 103 0 32 0 45 0 45 0 32 0 105 0 110 0 32 0 112 0 97 0 114 0 116 0 32 0 111 0 114 0 32 0 105 0 110 0 32 0 119 0 104 0 111 0 108 0 101 0 32 0 45 0 45 0 32 0 97 0 110 0 121 0 32 0 111 0 102 0 32 0 116 0 104 0 101 0 32 0 99 0 111 0 109 0 112 0 111 0 110 0 101 0 110 0 116 0 115 0 32 0 111 0 102 0 32 0 116 0 104 0 101 0 32 0 79 0 114 0 105 0 103 0 105 0 110 0 97 0 108 0 32 0 86 0 101 0 114 0 115 0 105 0 111 0 110 0 44 0 32 0 98 0 121 0 32 0 99 0 104 0 97 0 110 0 103 0 105 0 110 0 103 0 32 0 102 0 111 0 114 0 109 0 97 0 116 0 115 0 32 0 111 0 114 0 32 0 98 0 121 0 32 0 112 0 111 0 114 0 116 0 105 0 110 0 103 0 32 0 116 0 104 0 101 0 32 0 70 0 111 0 110 0 116 0 32 0 83 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 32 0 116 0 111 0 32 0 97 0 32 0 110 0 101 0 119 0 32 0 101 0 110 0 118 0 105 0 114 0 111 0 110 0 109 0 101 0 110 0 116 0 46 0 13 0 10 0 13 0 10 0 34 0 65 0 117 0 116 0 104 0 111 0 114 0 34 0 32 0 114 0 101 0 102 0 101 0 114 0 115 0 32 0 116 0 111 0 32 0 97 0 110 0 121 0 32 0 100 0 101 0 115 0 105 0 103 0 110 0 101 0 114 0 44 0 32 0 101 0 110 0 103 0 105 0 110 0 101 0 101 0 114 0 44 0 32 0 112 0 114 0 111 0 103 0 114 0 97 0 109 0 109 0 101 0 114 0 44 0 32 0 116 0 101 0 99 0 104 0 110 0 105 0 99 0 97 0 108 0 32 0 119 0 114 0 105 0 116 0 101 0 114 0 32 0 111 0 114 0 32 0 111 0 116 0 104 0 101 0 114 0 32 0 112 0 101 0 114 0 115 0 111 0 110 0 32 0 119 0 104 0 111 0 32 0 99 0 111 0 110 0 116 0 114 0 105 0 98 0 117 0 116 0 101 0 100 0 32 0 116 0 111 0 32 0 116 0 104 0 101 0 32 0 70 0 111 0 110 0 116 0 32 0 83 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 46 0 13 0 10 0 13 0 10 0 80 0 69 0 82 0 77 0 73 0 83 0 83 0 73 0 79 0 78 0 32 0 38 0 32 0 67 0 79 0 78 0 68 0 73 0 84 0 73 0 79 0 78 0 83 0 13 0 10 0 80 0 101 0 114 0 109 0 105 0 115 0 115 0 105 0 111 0 110 0 32 0 105 0 115 0 32 0 104 0 101 0 114 0 101 0 98 0 121 0 32 0 103 0 114 0 97 0 110 0 116 0 101 0 100 0 44 0 32 0 102 0 114 0 101 0 101 0 32 0 111 0 102 0 32 0 99 0 104 0 97 0 114 0 103 0 101 0 44 0 32 0 116 0 111 0 32 0 97 0 110 0 121 0 32 0 112 0 101 0 114 0 115 0 111 0 110 0 32 0 111 0 98 0 116 0 97 0 105 0 110 0 105 0 110 0 103 0 32 0 97 0 32 0 99 0 111 0 112 0 121 0 32 0 111 0 102 0 32 0 116 0 104 0 101 0 32 0 70 0 111 0 110 0 116 0 32 0 83 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 44 0 32 0 116 0 111 0 32 0 117 0 115 0 101 0 44 0 32 0 115 0 116 0 117 0 100 0 121 0 44 0 32 0 99 0 111 0 112 0 121 0 44 0 32 0 109 0 101 0 114 0 103 0 101 0 44 0 32 0 101 0 109 0 98 0 101 0 100 0 44 0 32 0 109 0 111 0 100 0 105 0 102 0 121 0 44 0 32 0 114 0 101 0 100 0 105 0 115 0 116 0 114 0 105 0 98 0 117 0 116 0 101 0 44 0 32 0 97 0 110 0 100 0 32 0 115 0 101 0 108 0 108 0 32 0 109 0 111 0 100 0 105 0 102 0 105 0 101 0 100 0 32 0 97 0 110 0 100 0 32 0 117 0 110 0 109 0 111 0 100 0 105 0 102 0 105 0 101 0 100 0 32 0 99 0 111 0 112 0 105 0 101 0 115 0 32 0 111 0 102 0 32 0 116 0 104 0 101 0 32 0 70 0 111 0 110 0 116 0 32 0 83 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 44 0 32 0 115 0 117 0 98 0 106 0 101 0 99 0 116 0 32 0 116 0 111 0 32 0 116 0 104 0 101 0 32 0 102 0 111 0 108 0 108 0 111 0 119 0 105 0 110 0 103 0 32 0 99 0 111 0 110 0 100 0 105 0 116 0 105 0 111 0 110 0 115 0 58 0 13 0 10 0 13 0 10 0 49 0 41 0 32 0 78 0 101 0 105 0 116 0 104 0 101 0 114 0 32 0 116 0 104 0 101 0 32 0 70 0 111 0 110 0 116 0 32 0 83 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 32 0 110 0 111 0 114 0 32 0 97 0 110 0 121 0 32 0 111 0 102 0 32 0 105 0 116 0 115 0 32 0 105 0 110 0 100 0 105 0 118 0 105 0 100 0 117 0 97 0 108 0 32 0 99 0 111 0 109 0 112 0 111 0 110 0 101 0 110 0 116 0 115 0 44 0 32 0 105 0 110 0 32 0 79 0 114 0 105 0 103 0 105 0 110 0 97 0 108 0 32 0 111 0 114 0 32 0 77 0 111 0 100 0 105 0 102 0 105 0 101 0 100 0 32 0 86 0 101 0 114 0 115 0 105 0 111 0 110 0 115 0 44 0 32 0 109 0 97 0 121 0 32 0 98 0 101 0 32 0 115 0 111 0 108 0 100 0 32 0 98 0 121 0 32 0 105 0 116 0 115 0 101 0 108 0 102 0 46 0 13 0 10 0 13 0 10 0 50 0 41 0 32 0 79 0 114 0 105 0 103 0 105 0 110 0 97 0 108 0 32 0 111 0 114 0 32 0 77 0 111 0 100 0 105 0 102 0 105 0 101 0 100 0 32 0 86 0 101 0 114 0 115 0 105 0 111 0 110 0 115 0 32 0 111 0 102 0 32 0 116 0 104 0 101 0 32 0 70 0 111 0 110 0 116 0 32 0 83 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 32 0 109 0 97 0 121 0 32 0 98 0 101 0 32 0 98 0 117 0 110 0 100 0 108 0 101 0 100 0 44 0 32 0 114 0 101 0 100 0 105 0 115 0 116 0 114 0 105 0 98 0 117 0 116 0 101 0 100 0 32 0 97 0 110 0 100 0 47 0 111 0 114 0 32 0 115 0 111 0 108 0 100 0 32 0 119 0 105 0 116 0 104 0 32 0 97 0 110 0 121 0 32 0 115 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 44 0 32 0 112 0 114 0 111 0 118 0 105 0 100 0 101 0 100 0 32 0 116 0 104 0 97 0 116 0 32 0 101 0 97 0 99 0 104 0 32 0 99 0 111 0 112 0 121 0 32 0 99 0 111 0 110 0 116 0 97 0 105 0 110 0 115 0 32 0 116 0 104 0 101 0 32 0 97 0 98 0 111 0 118 0 101 0 32 0 99 0 111 0 112 0 121 0 114 0 105 0 103 0 104 0 116 0 32 0 110 0 111 0 116 0 105 0 99 0 101 0 32 0 97 0 110 0 100 0 32 0 116 0 104 0 105 0 115 0 32 0 108 0 105 0 99 0 101 0 110 0 115 0 101 0 46 0 32 0 84 0 104 0 101 0 115 0 101 0 32 0 99 0 97 0 110 0 32 0 98 0 101 0 32 0 105 0 110 0 99 0 108 0 117 0 100 0 101 0 100 0 32 0 101 0 105 0 116 0 104 0 101 0 114 0 32 0 97 0 115 0 32 0 115 0 116 0 97 0 110 0 100 0 45 0 97 0 108 0 111 0 110 0 101 0 32 0 116 0 101 0 120 0 116 0 32 0 102 0 105 0 108 0 101 0 115 0 44 0 32 0 104 0 117 0 109 0 97 0 110 0 45 0 114 0 101 0 97 0 100 0 97 0 98 0 108 0 101 0 32 0 104 0 101 0 97 0 100 0 101 0 114 0 115 0 32 0 111 0 114 0 32 0 105 0 110 0 32 0 116 0 104 0 101 0 32 0 97 0 112 0 112 0 114 0 111 0 112 0 114 0 105 0 97 0 116 0 101 0 32 0 109 0 97 0 99 0 104 0 105 0 110 0 101 0 45 0 114 0 101 0 97 0 100 0 97 0 98 0 108 0 101 0 32 0 109 0 101 0 116 0 97 0 100 0 97 0 116 0 97 0 32 0 102 0 105 0 101 0 108 0 100 0 115 0 32 0 119 0 105 0 116 0 104 0 105 0 110 0 32 0 116 0 101 0 120 0 116 0 32 0 111 0 114 0 32 0 98 0 105 0 110 0 97 0 114 0 121 0 32 0 102 0 105 0 108 0 101 0 115 0 32 0 97 0 115 0 32 0 108 0 111 0 110 0 103 0 32 0 97 0 115 0 32 0 116 0 104 0 111 0 115 0 101 0 32 0 102 0 105 0 101 0 108 0 100 0 115 0 32 0 99 0 97 0 110 0 32 0 98 0 101 0 32 0 101 0 97 0 115 0 105 0 108 0 121 0 32 0 118 0 105 0 101 0 119 0 101 0 100 0 32 0 98 0 121 0 32 0 116 0 104 0 101 0 32 0 117 0 115 0 101 0 114 0 46 0 13 0 10 0 13 0 10 0 51 0 41 0 32 0 78 0 111 0 32 0 77 0 111 0 100 0 105 0 102 0 105 0 101 0 100 0 32 0 86 0 101 0 114 0 115 0 105 0 111 0 110 0 32 0 111 0 102 0 32 0 116 0 104 0 101 0 32 0 70 0 111 0 110 0 116 0 32 0 83 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 32 0 109 0 97 0 121 0 32 0 117 0 115 0 101 0 32 0 116 0 104 0 101 0 32 0 82 0 101 0 115 0 101 0 114 0 118 0 101 0 100 0 32 0 70 0 111 0 110 0 116 0 32 0 78 0 97 0 109 0 101 0 40 0 115 0 41 0 32 0 117 0 110 0 108 0 101 0 115 0 115 0 32 0 101 0 120 0 112 0 108 0 105 0 99 0 105 0 116 0 32 0 119 0 114 0 105 0 116 0 116 0 101 0 110 0 32 0 112 0 101 0 114 0 109 0 105 0 115 0 115 0 105 0 111 0 110 0 32 0 105 0 115 0 32 0 103 0 114 0 97 0 110 0 116 0 101 0 100 0 32 0 98 0 121 0 32 0 116 0 104 0 101 0 32 0 99 0 111 0 114 0 114 0 101 0 115 0 112 0 111 0 110 0 100 0 105 0 110 0 103 0 32 0 67 0 111 0 112 0 121 0 114 0 105 0 103 0 104 0 116 0 32 0 72 0 111 0 108 0 100 0 101 0 114 0 46 0 32 0 84 0 104 0 105 0 115 0 32 0 114 0 101 0 115 0 116 0 114 0 105 0 99 0 116 0 105 0 111 0 110 0 32 0 111 0 110 0 108 0 121 0 32 0 97 0 112 0 112 0 108 0 105 0 101 0 115 0 32 0 116 0 111 0 32 0 116 0 104 0 101 0 32 0 112 0 114 0 105 0 109 0 97 0 114 0 121 0 32 0 102 0 111 0 110 0 116 0 32 0 110 0 97 0 109 0 101 0 32 0 97 0 115 0 32 0 112 0 114 0 101 0 115 0 101 0 110 0 116 0 101 0 100 0 32 0 116 0 111 0 32 0 116 0 104 0 101 0 32 0 117 0 115 0 101 0 114 0 115 0 46 0 13 0 10 0 13 0 10 0 52 0 41 0 32 0 84 0 104 0 101 0 32 0 110 0 97 0 109 0 101 0 40 0 115 0 41 0 32 0 111 0 102 0 32 0 116 0 104 0 101 0 32 0 67 0 111 0 112 0 121 0 114 0 105 0 103 0 104 0 116 0 32 0 72 0 111 0 108 0 100 0 101 0 114 0 40 0 115 0 41 0 32 0 111 0 114 0 32 0 116 0 104 0 101 0 32 0 65 0 117 0 116 0 104 0 111 0 114 0 40 0 115 0 41 0 32 0 111 0 102 0 32 0 116 0 104 0 101 0 32 0 70 0 111 0 110 0 116 0 32 0 83 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 32 0 115 0 104 0 97 0 108 0 108 0 32 0 110 0 111 0 116 0 32 0 98 0 101 0 32 0 117 0 115 0 101 0 100 0 32 0 116 0 111 0 32 0 112 0 114 0 111 0 109 0 111 0 116 0 101 0 44 0 32 0 101 0 110 0 100 0 111 0 114 0 115 0 101 0 32 0 111 0 114 0 32 0 97 0 100 0 118 0 101 0 114 0 116 0 105 0 115 0 101 0 32 0 97 0 110 0 121 0 32 0 77 0 111 0 100 0 105 0 102 0 105 0 101 0 100 0 32 0 86 0 101 0 114 0 115 0 105 0 111 0 110 0 44 0 32 0 101 0 120 0 99 0 101 0 112 0 116 0 32 0 116 0 111 0 32 0 97 0 99 0 107 0 110 0 111 0 119 0 108 0 101 0 100 0 103 0 101 0 32 0 116 0 104 0 101 0 32 0 99 0 111 0 110 0 116 0 114 0 105 0 98 0 117 0 116 0 105 0 111 0 110 0 40 0 115 0 41 0 32 0 111 0 102 0 32 0 116 0 104 0 101 0 32 0 67 0 111 0 112 0 121 0 114 0 105 0 103 0 104 0 116 0 32 0 72 0 111 0 108 0 100 0 101 0 114 0 40 0 115 0 41 0 32 0 97 0 110 0 100 0 32 0 116 0 104 0 101 0 32 0 65 0 117 0 116 0 104 0 111 0 114 0 40 0 115 0 41 0 32 0 111 0 114 0 32 0 119 0 105 0 116 0 104 0 32 0 116 0 104 0 101 0 105 0 114 0 32 0 101 0 120 0 112 0 108 0 105 0 99 0 105 0 116 0 32 0 119 0 114 0 105 0 116 0 116 0 101 0 110 0 32 0 112 0 101 0 114 0 109 0 105 0 115 0 115 0 105 0 111 0 110 0 46 0 13 0 10 0 13 0 10 0 53 0 41 0 32 0 84 0 104 0 101 0 32 0 70 0 111 0 110 0 116 0 32 0 83 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 44 0 32 0 109 0 111 0 100 0 105 0 102 0 105 0 101 0 100 0 32 0 111 0 114 0 32 0 117 0 110 0 109 0 111 0 100 0 105 0 102 0 105 0 101 0 100 0 44 0 32 0 105 0 110 0 32 0 112 0 97 0 114 0 116 0 32 0 111 0 114 0 32 0 105 0 110 0 32 0 119 0 104 0 111 0 108 0 101 0 44 0 32 0 109 0 117 0 115 0 116 0 32 0 98 0 101 0 32 0 100 0 105 0 115 0 116 0 114 0 105 0 98 0 117 0 116 0 101 0 100 0 32 0 101 0 110 0 116 0 105 0 114 0 101 0 108 0 121 0 32 0 117 0 110 0 100 0 101 0 114 0 32 0 116 0 104 0 105 0 115 0 32 0 108 0 105 0 99 0 101 0 110 0 115 0 101 0 44 0 32 0 97 0 110 0 100 0 32 0 109 0 117 0 115 0 116 0 32 0 110 0 111 0 116 0 32 0 98 0 101 0 32 0 100 0 105 0 115 0 116 0 114 0 105 0 98 0 117 0 116 0 101 0 100 0 32 0 117 0 110 0 100 0 101 0 114 0 32 0 97 0 110 0 121 0 32 0 111 0 116 0 104 0 101 0 114 0 32 0 108 0 105 0 99 0 101 0 110 0 115 0 101 0 46 0 32 0 84 0 104 0 101 0 32 0 114 0 101 0 113 0 117 0 105 0 114 0 101 0 109 0 101 0 110 0 116 0 32 0 102 0 111 0 114 0 32 0 102 0 111 0 110 0 116 0 115 0 32 0 116 0 111 0 32 0 114 0 101 0 109 0 97 0 105 0 110 0 32 0 117 0 110 0 100 0 101 0 114 0 32 0 116 0 104 0 105 0 115 0 32 0 108 0 105 0 99 0 101 0 110 0 115 0 101 0 32 0 100 0 111 0 101 0 115 0 32 0 110 0 111 0 116 0 32 0 97 0 112 0 112 0 108 0 121 0 32 0 116 0 111 0 32 0 97 0 110 0 121 0 32 0 100 0 111 0 99 0 117 0 109 0 101 0 110 0 116 0 32 0 99 0 114 0 101 0 97 0 116 0 101 0 100 0 32 0 117 0 115 0 105 0 110 0 103 0 32 0 116 0 104 0 101 0 32 0 70 0 111 0 110 0 116 0 32 0 83 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 46 0 13 0 10 0 13 0 10 0 84 0 69 0 82 0 77 0 73 0 78 0 65 0 84 0 73 0 79 0 78 0 13 0 10 0 84 0 104 0 105 0 115 0 32 0 108 0 105 0 99 0 101 0 110 0 115 0 101 0 32 0 98 0 101 0 99 0 111 0 109 0 101 0 115 0 32 0 110 0 117 0 108 0 108 0 32 0 97 0 110 0 100 0 32 0 118 0 111 0 105 0 100 0 32 0 105 0 102 0 32 0 97 0 110 0 121 0 32 0 111 0 102 0 32 0 116 0 104 0 101 0 32 0 97 0 98 0 111 0 118 0 101 0 32 0 99 0 111 0 110 0 100 0 105 0 116 0 105 0 111 0 110 0 115 0 32 0 97 0 114 0 101 0 32 0 110 0 111 0 116 0 32 0 109 0 101 0 116 0 46 0 13 0 10 0 13 0 10 0 68 0 73 0 83 0 67 0 76 0 65 0 73 0 77 0 69 0 82 0 13 0 10 0 84 0 72 0 69 0 32 0 70 0 79 0 78 0 84 0 32 0 83 0 79 0 70 0 84 0 87 0 65 0 82 0 69 0 32 0 73 0 83 0 32 0 80 0 82 0 79 0 86 0 73 0 68 0 69 0 68 0 32 0 34 0 65 0 83 0 32 0 73 0 83 0 34 0 44 0 32 0 87 0 73 0 84 0 72 0 79 0 85 0 84 0 32 0 87 0 65 0 82 0 82 0 65 0 78 0 84 0 89 0 32 0 79 0 70 0 32 0 65 0 78 0 89 0 32 0 75 0 73 0 78 0 68 0 44 0 32 0 69 0 88 0 80 0 82 0 69 0 83 0 83 0 32 0 79 0 82 0 32 0 73 0 77 0 80 0 76 0 73 0 69 0 68 0 44 0 32 0 73 0 78 0 67 0 76 0 85 0 68 0 73 0 78 0 71 0 32 0 66 0 85 0 84 0 32 0 78 0 79 0 84 0 32 0 76 0 73 0 77 0 73 0 84 0 69 0 68 0 32 0 84 0 79 0 32 0 65 0 78 0 89 0 32 0 87 0 65 0 82 0 82 0 65 0 78 0 84 0 73 0 69 0 83 0 32 0 79 0 70 0 32 0 77 0 69 0 82 0 67 0 72 0 65 0 78 0 84 0 65 0 66 0 73 0 76 0 73 0 84 0 89 0 44 0 32 0 70 0 73 0 84 0 78 0 69 0 83 0 83 0 32 0 70 0 79 0 82 0 32 0 65 0 32 0 80 0 65 0 82 0 84 0 73 0 67 0 85 0 76 0 65 0 82 0 32 0 80 0 85 0 82 0 80 0 79 0 83 0 69 0 32 0 65 0 78 0 68 0 32 0 78 0 79 0 78 0 73 0 78 0 70 0 82 0 73 0 78 0 71 0 69 0 77 0 69 0 78 0 84 0 32 0 79 0 70 0 32 0 67 0 79 0 80 0 89 0 82 0 73 0 71 0 72 0 84 0 44 0 32 0 80 0 65 0 84 0 69 0 78 0 84 0 44 0 32 0 84 0 82 0 65 0 68 0 69 0 77 0 65 0 82 0 75 0 44 0 32 0 79 0 82 0 32 0 79 0 84 0 72 0 69 0 82 0 32 0 82 0 73 0 71 0 72 0 84 0 46 0 32 0 73 0 78 0 32 0 78 0 79 0 32 0 69 0 86 0 69 0 78 0 84 0 32 0 83 0 72 0 65 0 76 0 76 0 32 0 84 0 72 0 69 0 32 0 67 0 79 0 80 0 89 0 82 0 73 0 71 0 72 0 84 0 32 0 72 0 79 0 76 0 68 0 69 0 82 0 32 0 66 0 69 0 32 0 76 0 73 0 65 0 66 0 76 0 69 0 32 0 70 0 79 0 82 0 32 0 65 0 78 0 89 0 32 0 67 0 76 0 65 0 73 0 77 0 44 0 32 0 68 0 65 0 77 0 65 0 71 0 69 0 83 0 32 0 79 0 82 0 32 0 79 0 84 0 72 0 69 0 82 0 32 0 76 0 73 0 65 0 66 0 73 0 76 0 73 0 84 0 89 0 44 0 32 0 73 0 78 0 67 0 76 0 85 0 68 0 73 0 78 0 71 0 32 0 65 0 78 0 89 0 32 0 71 0 69 0 78 0 69 0 82 0 65 0 76 0 44 0 32 0 83 0 80 0 69 0 67 0 73 0 65 0 76 0 44 0 32 0 73 0 78 0 68 0 73 0 82 0 69 0 67 0 84 0 44 0 32 0 73 0 78 0 67 0 73 0 68 0 69 0 78 0 84 0 65 0 76 0 44 0 32 0 79 0 82 0 32 0 67 0 79 0 78 0 83 0 69 0 81 0 85 0 69 0 78 0 84 0 73 0 65 0 76 0 32 0 68 0 65 0 77 0 65 0 71 0 69 0 83 0 44 0 32 0 87 0 72 0 69 0 84 0 72 0 69 0 82 0 32 0 73 0 78 0 32 0 65 0 78 0 32 0 65 0 67 0 84 0 73 0 79 0 78 0 32 0 79 0 70 0 32 0 67 0 79 0 78 0 84 0 82 0 65 0 67 0 84 0 44 0 32 0 84 0 79 0 82 0 84 0 32 0 79 0 82 0 32 0 79 0 84 0 72 0 69 0 82 0 87 0 73 0 83 0 69 0 44 0 32 0 65 0 82 0 73 0 83 0 73 0 78 0 71 0 32 0 70 0 82 0 79 0 77 0 44 0 32 0 79 0 85 0 84 0 32 0 79 0 70 0 32 0 84 0 72 0 69 0 32 0 85 0 83 0 69 0 32 0 79 0 82 0 32 0 73 0 78 0 65 0 66 0 73 0 76 0 73 0 84 0 89 0 32 0 84 0 79 0 32 0 85 0 83 0 69 0 32 0 84 0 72 0 69 0 32 0 70 0 79 0 78 0 84 0 32 0 83 0 79 0 70 0 84 0 87 0 65 0 82 0 69 0 32 0 79 0 82 0 32 0 70 0 82 0 79 0 77 0 32 0 79 0 84 0 72 0 69 0 82 0 32 0 68 0 69 0 65 0 76 0 73 0 78 0 71 0 83 0 32 0 73 0 78 0 32 0 84 0 72 0 69 0 32 0 70 0 79 0 78 0 84 0 32 0 83 0 79 0 70 0 84 0 87 0 65 0 82 0 69 0 46 0 13 0 10 0 104 0 116 0 116 0 112 0 58 0 47 0 47 0 119 0 119 0 119 0 46 0 97 0 100 0 111 0 98 0 101 0 46 0 99 0 111 0 109 0 47 0 116 0 121 0 112 0 101 0 47 0 108 0 101 0 103 0 97 0 108 0 46 0 104 0 116 0 109 0 108 0 84 0 121 0 112 0 111 0 103 0 114 0 97 0 112 0 104 0 105 0 99 0 32 0 97 0 108 0 116 0 101 0 114 0 110 0 97 0 116 0 101 0 115 0 65 0 108 0 116 0 101 0 114 0 110 0 97 0 116 0 101 0 32 0 97 0 65 0 108 0 116 0 101 0 114 0 110 0 97 0 116 0 101 0 32 0 103 0 65 0 108 0 116 0 101 0 114 0 110 0 97 0 116 0 101 0 32 0 100 0 111 0 108 0 108 0 97 0 114 0 32 0 115 0 105 0 103 0 110 0 0 0 2 0 0 0 0 0 0 255 181 0 50 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3 197 0 0 1 2 1 3 0 3 0 36 0 37 0 38 0 39 0 40 0 41 0 42 0 43 0 44 0 45 0 46 0 47 0 48 0 49 0 50 0 51 0 52 0 53 0 54 0 55 0 56 0 57 0 58 0 59 0 60 0 61 0 68 0 69 0 70 0 71 0 72 0 73 0 74 0 75 0 76 0 77 0 78 0 79 0 80 0 81 0 82 0 83 0 84 0 85 0 86 0 87 0 88 0 89 0 90 0 91 0 92 0 93 0 173 0 201 0 199 0 174 0 98 1 4 1 5 0 99 1 6 1 7 1 8 1 9 1 10 1 11 1 12 1 13 1 14 1 15 1 16 1 17 1 18 1 19 0 144 1 20 0 100 0 253 1 21 0 255 1 22 1 23 1 24 1 25 1 26 0 203 0 101 0 200 1 27 0 202 1 28 1 29 1 30 1 31 1 32 1 33 1 34 1 35 1 36 1 37 1 38 1 39 1 40 0 248 1 41 1 42 1 43 1 44 1 45 1 46 1 47 1 48 1 49 0 207 0 204 0 205 1 50 0 206 1 51 1 52 0 250 1 53 1 54 1 55 1 56 1 57 1 58 1 59 1 60 1 61 1 62 1 63 1 64 1 65 0 226 1 66 1 67 1 68 0 102 1 69 1 70 1 71 1 72 0 211 0 208 0 209 0 175 0 103 1 73 1 74 1 75 1 76 1 77 1 78 1 79 1 80 1 81 1 82 1 83 0 145 0 176 1 84 1 85 1 86 1 87 1 88 1 89 1 90 1 91 1 92 1 93 1 94 1 95 1 96 1 97 1 98 0 228 1 99 1 100 1 101 1 102 1 103 1 104 1 105 1 106 1 107 1 108 0 214 0 212 0 213 1 109 0 104 1 110 1 111 1 112 1 113 1 114 1 115 1 116 1 117 1 118 1 119 1 120 1 121 1 122 1 123 1 124 1 125 1 126 1 127 1 128 1 129 1 130 1 131 1 132 0 235 1 133 0 187 1 134 1 135 1 136 1 137 1 138 0 230 1 139 1 140 0 233 0 237 1 141 0 106 0 105 0 107 0 109 0 108 1 142 1 143 0 110 1 144 1 145 1 146 1 147 1 148 1 149 1 150 1 151 1 152 1 153 1 154 1 155 1 156 1 157 0 160 1 158 0 111 0 254 1 159 1 0 1 160 1 161 1 162 1 163 1 1 0 113 0 112 0 114 1 164 0 115 1 165 1 166 1 167 1 168 1 169 1 170 1 171 1 172 1 173 1 174 1 175 1 176 1 177 0 249 1 178 1 179 1 180 1 181 1 182 1 183 1 184 1 185 1 186 0 117 0 116 0 118 1 187 0 119 1 188 1 189 1 190 1 191 1 192 1 193 1 194 0 215 1 195 1 196 1 197 1 198 1 199 1 200 1 201 1 202 1 203 1 204 0 227 1 205 1 206 1 207 0 120 1 208 1 209 1 210 1 211 1 212 0 122 0 121 0 123 0 125 0 124 1 213 1 214 1 215 1 216 1 217 1 218 1 219 1 220 1 221 1 222 1 223 0 161 0 177 1 224 1 225 1 226 1 227 1 228 1 229 1 230 1 231 1 232 1 233 1 234 1 235 1 236 1 237 1 238 0 229 1 239 1 240 1 241 1 242 0 137 1 243 1 244 1 245 1 246 1 247 1 248 0 127 0 126 0 128 1 249 0 129 1 250 1 251 1 252 1 253 1 254 1 255 2 0 2 1 2 2 2 3 2 4 2 5 2 6 2 7 2 8 2 9 2 10 2 11 2 12 2 13 2 14 2 15 2 16 0 236 2 17 0 186 2 18 2 19 2 20 2 21 2 22 0 231 2 23 2 24 0 234 0 238 2 25 2 26 2 27 2 28 2 29 2 30 2 31 2 32 2 33 2 34 2 35 2 36 2 37 2 38 2 39 2 40 0 192 0 193 2 41 2 42 2 43 2 44 2 45 2 46 2 47 2 48 2 49 2 50 2 51 2 52 2 53 2 54 2 55 2 56 2 57 2 58 2 59 2 60 2 61 2 62 2 63 2 64 2 65 2 66 2 67 2 68 2 69 2 70 2 71 0 9 0 19 0 20 0 21 0 22 0 23 0 24 0 25 0 26 0 27 0 28 2 72 2 73 2 74 2 75 2 76 2 77 2 78 2 79 2 80 2 81 0 17 0 15 0 29 0 30 0 171 0 4 0 163 0 34 0 162 0 10 0 5 0 182 0 183 0 180 0 181 0 196 0 197 0 190 0 191 0 169 0 170 0 16 2 82 0 178 0 179 2 83 2 84 0 195 0 135 0 66 0 11 0 12 0 62 0 64 0 94 0 96 0 18 0 95 0 63 0 232 0 13 0 130 0 194 0 134 0 136 0 139 2 85 0 138 0 140 2 86 0 35 2 87 0 6 2 88 2 89 2 90 2 91 2 92 2 93 2 94 2 95 2 96 2 97 2 98 2 99 2 100 2 101 2 102 2 103 2 104 2 105 2 106 2 107 2 108 2 109 2 110 2 111 2 112 2 113 2 114 2 115 2 116 2 117 2 118 2 119 2 120 2 121 2 122 2 123 2 124 2 125 2 126 2 127 2 128 2 129 2 130 2 131 2 132 2 133 2 134 2 135 2 136 2 137 2 138 2 139 2 140 2 141 2 142 2 143 2 144 2 145 2 146 2 147 0 157 2 148 0 158 2 149 2 150 2 151 2 152 2 153 2 154 2 155 2 156 2 157 2 158 2 159 2 160 2 161 2 162 2 163 2 164 2 165 2 166 2 167 2 168 2 169 2 170 2 171 2 172 2 173 2 174 2 175 2 176 2 177 2 178 2 179 0 131 0 189 0 7 0 133 0 150 2 180 0 132 2 181 2 182 2 183 2 184 2 185 2 186 2 187 2 188 2 189 2 190 2 191 0 188 2 192 2 193 0 8 0 198 0 245 0 244 0 246 2 194 2 195 2 196 2 197 2 198 2 199 0 14 0 239 0 240 0 184 2 200 0 32 0 31 0 33 0 148 0 149 0 147 0 65 0 143 0 97 0 167 0 164 0 155 0 146 2 201 0 152 0 156 0 165 2 202 2 203 0 153 0 154 2 204 2 205 2 206 2 207 2 208 2 209 2 210 2 211 2 212 2 213 2 214 2 215 2 216 2 217 2 218 2 219 2 220 2 221 2 222 2 223 2 224 2 225 0 185 2 226 2 227 2 228 2 229 2 230 2 231 0 67 0 141 0 216 0 225 2 232 2 233 2 234 2 235 2 236 0 217 0 142 0 218 0 219 0 221 0 223 0 220 0 222 0 224 2 237 2 238 2 239 2 240 2 241 2 242 2 243 2 244 2 245 2 246 2 247 2 248 2 249 2 250 2 251 2 252 2 253 2 254 2 255 3 0 3 1 3 2 3 3 3 4 3 5 3 6 3 7 3 8 3 9 3 10 3 11 3 12 3 13 3 14 3 15 3 16 3 17 3 18 3 19 3 20 3 21 3 22 3 23 3 24 3 25 3 26 3 27 3 28 3 29 3 30 3 31 3 32 3 33 3 34 3 35 3 36 3 37 3 38 3 39 3 40 3 41 3 42 3 43 3 44 3 45 3 46 3 47 3 48 3 49 3 50 3 51 3 52 3 53 3 54 3 55 3 56 3 57 3 58 3 59 3 60 3 61 3 62 3 63 3 64 3 65 3 66 3 67 3 68 3 69 3 70 3 71 3 72 3 73 3 74 3 75 3 76 3 77 3 78 3 79 3 80 3 81 3 82 3 83 3 84 3 85 3 86 3 87 3 88 3 89 3 90 3 91 3 92 3 93 3 94 3 95 3 96 3 97 3 98 3 99 3 100 3 101 3 102 3 103 3 104 3 105 3 106 3 107 3 108 3 109 3 110 3 111 3 112 3 113 3 114 3 115 3 116 3 117 3 118 3 119 3 120 3 121 3 122 3 123 3 124 3 125 3 126 3 127 3 128 3 129 3 130 3 131 3 132 3 133 3 134 3 135 3 136 3 137 3 138 3 139 3 140 3 141 3 142 3 143 3 144 3 145 3 146 3 147 3 148 3 149 3 150 3 151 3 152 3 153 3 154 3 155 3 156 3 157 3 158 3 159 3 160 3 161 3 162 3 163 3 164 3 165 3 166 3 167 3 168 3 169 3 170 3 171 3 172 3 173 3 174 3 175 3 176 3 177 3 178 3 179 3 180 3 181 3 182 3 183 3 184 3 185 3 186 3 187 3 188 3 189 3 190 3 191 3 192 3 193 3 194 3 195 3 196 3 197 3 198 3 199 3 200 3 201 3 202 3 203 3 204 3 205 3 206 3 207 3 208 3 209 3 210 4 78 85 76 76 2 67 82 7 65 109 97 99 114 111 110 6 65 98 114 101 118 101 7 117 110 105 48 49 67 68 7 117 110 105 49 69 65 48 7 117 110 105 49 69 65 50 7 117 110 105 49 69 65 52 7 117 110 105 49 69 65 54 7 117 110 105 49 69 65 56 7 117 110 105 49 69 65 65 7 117 110 105 49 69 65 67 7 117 110 105 49 69 65 69 7 117 110 105 49 69 66 48 7 117 110 105 49 69 66 50 7 117 110 105 49 69 66 52 7 117 110 105 49 69 66 54 7 65 111 103 111 110 101 107 7 117 110 105 48 50 52 51 11 67 99 105 114 99 117 109 102 108 101 120 10 67 100 111 116 97 99 99 101 110 116 6 68 99 97 114 111 110 7 117 110 105 49 69 48 67 7 117 110 105 49 69 48 69 6 68 99 114 111 97 116 6 69 99 97 114 111 110 7 69 109 97 99 114 111 110 6 69 98 114 101 118 101 10 69 100 111 116 97 99 99 101 110 116 7 117 110 105 49 69 66 56 7 117 110 105 49 69 66 65 7 117 110 105 49 69 66 67 7 117 110 105 49 69 66 69 7 117 110 105 49 69 67 48 7 117 110 105 49 69 67 50 7 117 110 105 49 69 67 52 7 117 110 105 49 69 67 54 7 69 111 103 111 110 101 107 11 71 99 105 114 99 117 109 102 108 101 120 10 71 100 111 116 97 99 99 101 110 116 7 117 110 105 48 49 50 50 6 71 99 97 114 111 110 7 117 110 105 49 69 50 48 11 117 110 105 48 48 52 55 48 51 48 51 11 72 99 105 114 99 117 109 102 108 101 120 7 117 110 105 49 69 50 52 7 117 110 105 49 69 50 65 4 72 98 97 114 6 73 116 105 108 100 101 7 73 109 97 99 114 111 110 7 117 110 105 48 49 50 67 7 117 110 105 48 49 67 70 7 117 110 105 49 69 67 56 7 117 110 105 49 69 67 65 7 73 111 103 111 110 101 107 11 74 99 105 114 99 117 109 102 108 101 120 7 117 110 105 48 49 51 54 6 76 97 99 117 116 101 6 76 99 97 114 111 110 7 117 110 105 48 49 51 66 4 76 100 111 116 7 117 110 105 49 69 51 54 7 117 110 105 49 69 51 56 7 117 110 105 49 69 51 65 7 117 110 105 49 69 52 50 6 78 97 99 117 116 101 6 78 99 97 114 111 110 7 117 110 105 48 49 52 53 7 117 110 105 49 69 52 52 7 117 110 105 49 69 52 54 7 117 110 105 49 69 52 56 7 79 109 97 99 114 111 110 7 117 110 105 48 49 52 69 13 79 104 117 110 103 97 114 117 109 108 97 117 116 7 117 110 105 48 49 68 49 7 117 110 105 49 69 67 67 7 117 110 105 49 69 67 69 7 117 110 105 49 69 68 48 7 117 110 105 49 69 68 50 7 117 110 105 49 69 68 52 7 117 110 105 49 69 68 54 7 117 110 105 49 69 68 56 5 79 104 111 114 110 7 117 110 105 49 69 68 65 7 117 110 105 49 69 68 67 7 117 110 105 49 69 68 69 7 117 110 105 49 69 69 48 7 117 110 105 49 69 69 50 7 117 110 105 48 49 69 65 6 82 97 99 117 116 101 6 82 99 97 114 111 110 7 117 110 105 48 49 53 54 7 117 110 105 49 69 53 65 7 117 110 105 49 69 53 67 7 117 110 105 49 69 53 69 6 83 97 99 117 116 101 11 83 99 105 114 99 117 109 102 108 101 120 7 117 110 105 48 49 53 69 7 117 110 105 48 50 49 56 7 117 110 105 49 69 54 48 7 117 110 105 49 69 54 50 7 117 110 105 49 69 57 69 6 84 99 97 114 111 110 7 117 110 105 48 49 54 50 7 117 110 105 48 50 49 65 7 117 110 105 49 69 54 67 7 117 110 105 49 69 54 69 6 85 116 105 108 100 101 7 85 109 97 99 114 111 110 6 85 98 114 101 118 101 5 85 114 105 110 103 13 85 104 117 110 103 97 114 117 109 108 97 117 116 7 117 110 105 48 49 68 51 7 117 110 105 48 49 68 53 7 117 110 105 48 49 68 55 7 117 110 105 48 49 68 57 7 117 110 105 48 49 68 66 7 117 110 105 49 69 69 52 7 117 110 105 49 69 69 54 7 85 111 103 111 110 101 107 5 85 104 111 114 110 7 117 110 105 49 69 69 56 7 117 110 105 49 69 69 65 7 117 110 105 49 69 69 67 7 117 110 105 49 69 69 69 7 117 110 105 49 69 70 48 6 87 103 114 97 118 101 6 87 97 99 117 116 101 11 87 99 105 114 99 117 109 102 108 101 120 9 87 100 105 101 114 101 115 105 115 6 89 103 114 97 118 101 11 89 99 105 114 99 117 109 102 108 101 120 7 117 110 105 49 69 56 69 7 117 110 105 49 69 70 52 7 117 110 105 49 69 70 54 7 117 110 105 49 69 70 56 6 90 97 99 117 116 101 10 90 100 111 116 97 99 99 101 110 116 7 117 110 105 49 69 57 50 7 117 110 105 48 49 56 70 7 97 109 97 99 114 111 110 6 97 98 114 101 118 101 7 117 110 105 48 49 67 69 7 117 110 105 49 69 65 49 7 117 110 105 49 69 65 51 7 117 110 105 49 69 65 53 7 117 110 105 49 69 65 55 7 117 110 105 49 69 65 57 7 117 110 105 49 69 65 66 7 117 110 105 49 69 65 68 7 117 110 105 49 69 65 70 7 117 110 105 49 69 66 49 7 117 110 105 49 69 66 51 7 117 110 105 49 69 66 53 7 117 110 105 49 69 66 55 7 97 111 103 111 110 101 107 7 117 110 105 48 49 56 48 11 99 99 105 114 99 117 109 102 108 101 120 10 99 100 111 116 97 99 99 101 110 116 6 100 99 97 114 111 110 7 117 110 105 49 69 48 68 7 117 110 105 49 69 48 70 6 101 99 97 114 111 110 7 101 109 97 99 114 111 110 6 101 98 114 101 118 101 10 101 100 111 116 97 99 99 101 110 116 7 117 110 105 49 69 66 57 7 117 110 105 49 69 66 66 7 117 110 105 49 69 66 68 7 117 110 105 49 69 66 70 7 117 110 105 49 69 67 49 7 117 110 105 49 69 67 51 7 117 110 105 49 69 67 53 7 117 110 105 49 69 67 55 7 101 111 103 111 110 101 107 11 103 99 105 114 99 117 109 102 108 101 120 10 103 100 111 116 97 99 99 101 110 116 7 117 110 105 48 49 50 51 6 103 99 97 114 111 110 7 117 110 105 49 69 50 49 11 117 110 105 48 48 54 55 48 51 48 51 11 104 99 105 114 99 117 109 102 108 101 120 7 117 110 105 49 69 50 53 7 117 110 105 49 69 50 66 4 104 98 97 114 6 105 116 105 108 100 101 7 105 109 97 99 114 111 110 7 117 110 105 48 49 50 68 7 117 110 105 48 49 68 48 7 117 110 105 49 69 67 57 7 117 110 105 49 69 67 66 7 105 111 103 111 110 101 107 9 105 111 103 111 110 101 107 46 100 11 106 99 105 114 99 117 109 102 108 101 120 7 117 110 105 48 49 51 55 12 107 103 114 101 101 110 108 97 110 100 105 99 6 108 97 99 117 116 101 6 108 99 97 114 111 110 4 108 100 111 116 7 117 110 105 48 49 51 67 7 117 110 105 49 69 51 55 7 117 110 105 49 69 51 57 7 117 110 105 49 69 51 66 7 117 110 105 49 69 52 51 6 110 97 99 117 116 101 6 110 99 97 114 111 110 7 117 110 105 48 49 52 54 7 117 110 105 49 69 52 53 7 117 110 105 49 69 52 55 7 117 110 105 49 69 52 57 11 110 97 112 111 115 116 114 111 112 104 101 7 111 109 97 99 114 111 110 7 117 110 105 48 49 52 70 13 111 104 117 110 103 97 114 117 109 108 97 117 116 7 117 110 105 48 49 68 50 7 117 110 105 49 69 67 68 7 117 110 105 49 69 67 70 7 117 110 105 49 69 68 49 7 117 110 105 49 69 68 51 7 117 110 105 49 69 68 53 7 117 110 105 49 69 68 55 7 117 110 105 49 69 68 57 5 111 104 111 114 110 7 117 110 105 49 69 68 66 7 117 110 105 49 69 68 68 7 117 110 105 49 69 68 70 7 117 110 105 49 69 69 49 7 117 110 105 49 69 69 51 7 117 110 105 48 49 69 66 6 114 97 99 117 116 101 7 117 110 105 48 49 53 55 6 114 99 97 114 111 110 7 117 110 105 49 69 53 66 7 117 110 105 49 69 53 68 7 117 110 105 49 69 53 70 6 115 97 99 117 116 101 11 115 99 105 114 99 117 109 102 108 101 120 7 117 110 105 48 49 53 70 7 117 110 105 48 50 49 57 7 117 110 105 49 69 54 49 7 117 110 105 49 69 54 51 6 116 99 97 114 111 110 7 117 110 105 48 49 54 51 7 117 110 105 48 50 49 66 7 117 110 105 49 69 54 68 7 117 110 105 49 69 54 70 7 117 110 105 49 69 57 55 6 117 116 105 108 100 101 7 117 109 97 99 114 111 110 6 117 98 114 101 118 101 5 117 114 105 110 103 13 117 104 117 110 103 97 114 117 109 108 97 117 116 7 117 110 105 48 49 68 52 7 117 110 105 48 49 68 54 7 117 110 105 48 49 68 56 7 117 110 105 48 49 68 65 7 117 110 105 48 49 68 67 7 117 110 105 49 69 69 53 7 117 110 105 49 69 69 55 7 117 111 103 111 110 101 107 5 117 104 111 114 110 7 117 110 105 49 69 69 57 7 117 110 105 49 69 69 66 7 117 110 105 49 69 69 68 7 117 110 105 49 69 69 70 7 117 110 105 49 69 70 49 6 119 103 114 97 118 101 6 119 97 99 117 116 101 11 119 99 105 114 99 117 109 102 108 101 120 9 119 100 105 101 114 101 115 105 115 6 121 103 114 97 118 101 11 121 99 105 114 99 117 109 102 108 101 120 7 117 110 105 49 69 56 70 7 117 110 105 49 69 70 53 7 117 110 105 49 69 70 55 7 117 110 105 49 69 70 57 6 122 97 99 117 116 101 10 122 100 111 116 97 99 99 101 110 116 7 117 110 105 49 69 57 51 7 117 110 105 48 50 51 55 7 117 110 105 48 50 53 48 7 117 110 105 48 50 53 49 7 117 110 105 48 50 53 50 7 117 110 105 48 50 53 52 7 117 110 105 48 50 53 56 7 117 110 105 48 50 53 57 7 117 110 105 48 50 54 49 7 117 110 105 48 50 54 53 7 117 110 105 48 50 54 70 7 117 110 105 48 50 55 57 7 117 110 105 48 50 56 55 7 117 110 105 48 50 56 67 7 117 110 105 48 50 56 68 7 117 110 105 48 50 56 69 7 117 110 105 48 50 57 69 3 97 46 97 8 97 103 114 97 118 101 46 97 8 97 97 99 117 116 101 46 97 13 97 99 105 114 99 117 109 102 108 101 120 46 97 8 97 116 105 108 100 101 46 97 11 97 100 105 101 114 101 115 105 115 46 97 9 97 109 97 99 114 111 110 46 97 8 97 98 114 101 118 101 46 97 7 97 114 105 110 103 46 97 9 117 110 105 48 49 67 69 46 97 9 117 110 105 49 69 65 49 46 97 9 117 110 105 49 69 65 51 46 97 9 117 110 105 49 69 65 53 46 97 9 117 110 105 49 69 65 55 46 97 9 117 110 105 49 69 65 57 46 97 9 117 110 105 49 69 65 66 46 97 9 117 110 105 49 69 65 68 46 97 9 117 110 105 49 69 65 70 46 97 9 117 110 105 49 69 66 49 46 97 9 117 110 105 49 69 66 51 46 97 9 117 110 105 49 69 66 53 46 97 9 117 110 105 49 69 66 55 46 97 9 97 111 103 111 110 101 107 46 97 3 103 46 97 13 103 99 105 114 99 117 109 102 108 101 120 46 97 8 103 98 114 101 118 101 46 97 12 103 100 111 116 97 99 99 101 110 116 46 97 9 117 110 105 48 49 50 51 46 97 8 103 99 97 114 111 110 46 97 9 117 110 105 49 69 50 49 46 97 13 117 110 105 48 48 54 55 48 51 48 51 46 97 9 122 101 114 111 46 111 110 117 109 8 111 110 101 46 111 110 117 109 8 116 119 111 46 111 110 117 109 10 116 104 114 101 101 46 111 110 117 109 9 102 111 117 114 46 111 110 117 109 9 102 105 118 101 46 111 110 117 109 8 115 105 120 46 111 110 117 109 10 115 101 118 101 110 46 111 110 117 109 10 101 105 103 104 116 46 111 110 117 109 9 110 105 110 101 46 111 110 117 109 7 117 110 105 48 48 65 68 10 102 105 103 117 114 101 100 97 115 104 7 117 110 105 50 48 49 53 7 117 110 105 50 49 49 55 7 117 110 105 50 49 50 48 7 97 116 46 99 97 115 101 10 97 115 116 101 114 105 115 107 46 97 8 104 121 112 104 101 110 46 97 9 117 110 105 48 48 65 68 46 97 8 100 111 108 108 97 114 46 97 9 122 101 114 111 46 115 117 112 115 8 111 110 101 46 115 117 112 115 8 116 119 111 46 115 117 112 115 10 116 104 114 101 101 46 115 117 112 115 9 102 111 117 114 46 115 117 112 115 9 102 105 118 101 46 115 117 112 115 8 115 105 120 46 115 117 112 115 10 115 101 118 101 110 46 115 117 112 115 10 101 105 103 104 116 46 115 117 112 115 9 110 105 110 101 46 115 117 112 115 14 112 97 114 101 110 108 101 102 116 46 115 117 112 115 15 112 97 114 101 110 114 105 103 104 116 46 115 117 112 115 11 112 101 114 105 111 100 46 115 117 112 115 10 99 111 109 109 97 46 115 117 112 115 9 122 101 114 111 46 115 117 98 115 8 111 110 101 46 115 117 98 115 8 116 119 111 46 115 117 98 115 10 116 104 114 101 101 46 115 117 98 115 9 102 111 117 114 46 115 117 98 115 9 102 105 118 101 46 115 117 98 115 8 115 105 120 46 115 117 98 115 10 115 101 118 101 110 46 115 117 98 115 10 101 105 103 104 116 46 115 117 98 115 9 110 105 110 101 46 115 117 98 115 14 112 97 114 101 110 108 101 102 116 46 115 117 98 115 15 112 97 114 101 110 114 105 103 104 116 46 115 117 98 115 11 112 101 114 105 111 100 46 115 117 98 115 10 99 111 109 109 97 46 115 117 98 115 9 122 101 114 111 46 100 110 111 109 8 111 110 101 46 100 110 111 109 8 116 119 111 46 100 110 111 109 10 116 104 114 101 101 46 100 110 111 109 9 102 111 117 114 46 100 110 111 109 9 102 105 118 101 46 100 110 111 109 8 115 105 120 46 100 110 111 109 10 115 101 118 101 110 46 100 110 111 109 10 101 105 103 104 116 46 100 110 111 109 9 110 105 110 101 46 100 110 111 109 14 112 97 114 101 110 108 101 102 116 46 100 110 111 109 15 112 97 114 101 110 114 105 103 104 116 46 100 110 111 109 11 112 101 114 105 111 100 46 100 110 111 109 10 99 111 109 109 97 46 100 110 111 109 9 122 101 114 111 46 110 117 109 114 8 111 110 101 46 110 117 109 114 8 116 119 111 46 110 117 109 114 10 116 104 114 101 101 46 110 117 109 114 9 102 111 117 114 46 110 117 109 114 9 102 105 118 101 46 110 117 109 114 8 115 105 120 46 110 117 109 114 10 115 101 118 101 110 46 110 117 109 114 10 101 105 103 104 116 46 110 117 109 114 9 110 105 110 101 46 110 117 109 114 14 112 97 114 101 110 108 101 102 116 46 110 117 109 114 15 112 97 114 101 110 114 105 103 104 116 46 110 117 109 114 11 112 101 114 105 111 100 46 110 117 109 114 10 99 111 109 109 97 46 110 117 109 114 13 111 114 100 102 101 109 105 110 105 110 101 46 97 6 97 46 115 117 112 115 6 98 46 115 117 112 115 6 99 46 115 117 112 115 6 100 46 115 117 112 115 6 101 46 115 117 112 115 6 102 46 115 117 112 115 6 103 46 115 117 112 115 6 104 46 115 117 112 115 6 105 46 115 117 112 115 6 106 46 115 117 112 115 6 107 46 115 117 112 115 6 108 46 115 117 112 115 6 109 46 115 117 112 115 6 110 46 115 117 112 115 6 111 46 115 117 112 115 6 112 46 115 117 112 115 6 113 46 115 117 112 115 6 114 46 115 117 112 115 6 115 46 115 117 112 115 6 116 46 115 117 112 115 6 117 46 115 117 112 115 6 118 46 115 117 112 115 6 119 46 115 117 112 115 6 120 46 115 117 112 115 6 121 46 115 117 112 115 6 122 46 115 117 112 115 11 101 103 114 97 118 101 46 115 117 112 115 11 101 97 99 117 116 101 46 115 117 112 115 12 117 110 105 48 50 53 57 46 115 117 112 115 6 97 46 115 117 112 97 6 103 46 115 117 112 97 4 69 117 114 111 7 117 110 105 48 49 57 50 13 99 111 108 111 110 109 111 110 101 116 97 114 121 4 108 105 114 97 7 117 110 105 50 48 65 54 6 112 101 115 101 116 97 4 100 111 110 103 7 117 110 105 50 48 66 49 7 117 110 105 50 48 66 50 7 117 110 105 50 48 66 53 7 117 110 105 50 48 66 57 7 117 110 105 50 48 66 65 7 117 110 105 50 50 49 53 10 115 108 97 115 104 46 102 114 97 99 8 111 110 101 116 104 105 114 100 9 116 119 111 116 104 105 114 100 115 9 111 110 101 101 105 103 104 116 104 12 116 104 114 101 101 101 105 103 104 116 104 115 11 102 105 118 101 101 105 103 104 116 104 115 12 115 101 118 101 110 101 105 103 104 116 104 115 7 117 110 105 50 50 49 57 7 117 110 105 48 48 66 53 7 117 110 105 50 50 48 54 7 117 110 105 50 49 50 54 7 117 110 105 50 49 49 51 9 101 115 116 105 109 97 116 101 100 7 117 110 105 50 49 57 48 7 97 114 114 111 119 117 112 7 117 110 105 50 49 57 50 9 97 114 114 111 119 100 111 119 110 7 117 110 105 50 53 65 48 7 117 110 105 50 53 67 54 7 117 110 105 50 53 67 57 7 117 110 105 50 55 53 50 7 116 114 105 97 103 117 112 7 117 110 105 50 53 66 51 7 117 110 105 50 53 66 54 7 117 110 105 50 53 66 55 7 116 114 105 97 103 100 110 7 117 110 105 50 53 66 68 7 117 110 105 50 53 67 48 7 117 110 105 50 53 67 49 7 117 110 105 50 54 49 48 7 117 110 105 50 54 49 49 7 117 110 105 50 55 49 51 7 117 110 105 50 54 54 65 7 117 110 105 50 48 51 50 7 117 110 105 50 48 51 51 7 117 110 105 48 50 66 66 7 117 110 105 48 50 66 67 7 117 110 105 48 50 66 69 7 117 110 105 48 50 66 70 7 117 110 105 48 50 67 56 7 117 110 105 48 50 67 57 7 117 110 105 48 50 67 65 7 117 110 105 48 50 67 66 7 117 110 105 48 50 67 67 7 117 110 105 48 51 48 48 11 117 110 105 48 51 48 48 46 99 97 112 7 117 110 105 48 51 48 49 11 117 110 105 48 51 48 49 46 99 97 112 7 117 110 105 48 51 48 50 11 117 110 105 48 51 48 50 46 99 97 112 7 117 110 105 48 51 48 51 11 117 110 105 48 51 48 51 46 99 97 112 7 117 110 105 48 51 48 52 11 117 110 105 48 51 48 52 46 99 97 112 7 117 110 105 48 51 48 54 11 117 110 105 48 51 48 54 46 99 97 112 7 117 110 105 48 51 48 55 11 117 110 105 48 51 48 55 46 99 97 112 7 117 110 105 48 51 48 56 11 117 110 105 48 51 48 56 46 99 97 112 7 117 110 105 48 51 48 57 11 117 110 105 48 51 48 57 46 99 97 112 7 117 110 105 48 51 48 65 11 117 110 105 48 51 48 65 46 99 97 112 7 117 110 105 48 51 48 66 11 117 110 105 48 51 48 66 46 99 97 112 7 117 110 105 48 51 48 67 11 117 110 105 48 51 48 67 46 99 97 112 7 117 110 105 48 51 48 70 11 117 110 105 48 51 48 70 46 99 97 112 7 117 110 105 48 51 49 50 7 117 110 105 48 51 49 51 7 117 110 105 48 51 49 66 7 117 110 105 48 51 50 51 7 117 110 105 48 51 50 52 7 117 110 105 48 51 50 54 7 117 110 105 48 51 50 55 11 117 110 105 48 51 50 55 46 99 97 112 7 117 110 105 48 51 50 56 11 117 110 105 48 51 50 56 46 99 97 112 7 117 110 105 48 51 50 69 7 117 110 105 48 51 51 49 11 117 110 105 48 51 48 56 48 51 48 52 15 117 110 105 48 51 48 56 48 51 48 52 46 99 97 112 11 117 110 105 48 51 48 56 48 51 48 49 15 117 110 105 48 51 48 56 48 51 48 49 46 99 97 112 11 117 110 105 48 51 48 56 48 51 48 67 15 117 110 105 48 51 48 56 48 51 48 67 46 99 97 112 11 117 110 105 48 51 48 56 48 51 48 48 15 117 110 105 48 51 48 56 48 51 48 48 46 99 97 112 11 117 110 105 48 51 48 50 48 51 48 49 15 117 110 105 48 51 48 50 48 51 48 49 46 99 97 112 11 117 110 105 48 51 48 50 48 51 48 48 15 117 110 105 48 51 48 50 48 51 48 48 46 99 97 112 11 117 110 105 48 51 48 50 48 51 48 57 15 117 110 105 48 51 48 50 48 51 48 57 46 99 97 112 11 117 110 105 48 51 48 50 48 51 48 51 15 117 110 105 48 51 48 50 48 51 48 51 46 99 97 112 11 117 110 105 48 51 48 54 48 51 48 49 15 117 110 105 48 51 48 54 48 51 48 49 46 99 97 112 11 117 110 105 48 51 48 54 48 51 48 48 15 117 110 105 48 51 48 54 48 51 48 48 46 99 97 112 11 117 110 105 48 51 48 54 48 51 48 57 15 117 110 105 48 51 48 54 48 51 48 57 46 99 97 112 11 117 110 105 48 51 48 54 48 51 48 51 15 117 110 105 48 51 48 54 48 51 48 51 46 99 97 112 11 117 110 105 48 51 48 50 48 51 48 54 15 117 110 105 48 51 48 50 48 51 48 54 46 99 97 112 9 117 110 105 48 51 48 67 46 97 9 117 110 105 48 51 50 54 46 97 7 117 110 105 48 48 65 48 7 117 110 105 50 48 48 55 10 115 112 97 99 101 46 102 114 97 99 12 110 98 115 112 97 99 101 46 102 114 97 99 7 117 110 105 50 53 48 48 7 117 110 105 50 53 48 49 7 117 110 105 50 53 48 50 7 117 110 105 50 53 48 51 7 117 110 105 50 53 48 52 7 117 110 105 50 53 48 53 7 117 110 105 50 53 48 54 7 117 110 105 50 53 48 55 7 117 110 105 50 53 48 56 7 117 110 105 50 53 48 57 7 117 110 105 50 53 48 65 7 117 110 105 50 53 48 66 7 117 110 105 50 53 48 67 7 117 110 105 50 53 48 68 7 117 110 105 50 53 48 69 7 117 110 105 50 53 48 70 7 117 110 105 50 53 49 48 7 117 110 105 50 53 49 49 7 117 110 105 50 53 49 50 7 117 110 105 50 53 49 51 7 117 110 105 50 53 49 52 7 117 110 105 50 53 49 53 7 117 110 105 50 53 49 54 7 117 110 105 50 53 49 55 7 117 110 105 50 53 49 56 7 117 110 105 50 53 49 57 7 117 110 105 50 53 49 65 7 117 110 105 50 53 49 66 7 117 110 105 50 53 49 67 7 117 110 105 50 53 49 68 7 117 110 105 50 53 49 69 7 117 110 105 50 53 49 70 7 117 110 105 50 53 50 48 7 117 110 105 50 53 50 49 7 117 110 105 50 53 50 50 7 117 110 105 50 53 50 51 7 117 110 105 50 53 50 52 7 117 110 105 50 53 50 53 7 117 110 105 50 53 50 54 7 117 110 105 50 53 50 55 7 117 110 105 50 53 50 56 7 117 110 105 50 53 50 57 7 117 110 105 50 53 50 65 7 117 110 105 50 53 50 66 7 117 110 105 50 53 50 67 7 117 110 105 50 53 50 68 7 117 110 105 50 53 50 69 7 117 110 105 50 53 50 70 7 117 110 105 50 53 51 48 7 117 110 105 50 53 51 49 7 117 110 105 50 53 51 50 7 117 110 105 50 53 51 51 7 117 110 105 50 53 51 52 7 117 110 105 50 53 51 53 7 117 110 105 50 53 51 54 7 117 110 105 50 53 51 55 7 117 110 105 50 53 51 56 7 117 110 105 50 53 51 57 7 117 110 105 50 53 51 65 7 117 110 105 50 53 51 66 7 117 110 105 50 53 51 67 7 117 110 105 50 53 51 68 7 117 110 105 50 53 51 69 7 117 110 105 50 53 51 70 7 117 110 105 50 53 52 48 7 117 110 105 50 53 52 49 7 117 110 105 50 53 52 50 7 117 110 105 50 53 52 51 7 117 110 105 50 53 52 52 7 117 110 105 50 53 52 53 7 117 110 105 50 53 52 54 7 117 110 105 50 53 52 55 7 117 110 105 50 53 52 56 7 117 110 105 50 53 52 57 7 117 110 105 50 53 52 65 7 117 110 105 50 53 52 66 7 117 110 105 50 53 52 67 7 117 110 105 50 53 52 68 7 117 110 105 50 53 52 69 7 117 110 105 50 53 52 70 7 117 110 105 50 53 53 48 7 117 110 105 50 53 53 49 7 117 110 105 50 53 53 50 7 117 110 105 50 53 53 51 7 117 110 105 50 53 53 52 7 117 110 105 50 53 53 53 7 117 110 105 50 53 53 54 7 117 110 105 50 53 53 55 7 117 110 105 50 53 53 56 7 117 110 105 50 53 53 57 7 117 110 105 50 53 53 65 7 117 110 105 50 53 53 66 7 117 110 105 50 53 53 67 7 117 110 105 50 53 53 68 7 117 110 105 50 53 53 69 7 117 110 105 50 53 53 70 7 117 110 105 50 53 54 48 7 117 110 105 50 53 54 49 7 117 110 105 50 53 54 50 7 117 110 105 50 53 54 51 7 117 110 105 50 53 54 52 7 117 110 105 50 53 54 53 7 117 110 105 50 53 54 54 7 117 110 105 50 53 54 55 7 117 110 105 50 53 54 56 7 117 110 105 50 53 54 57 7 117 110 105 50 53 54 65 7 117 110 105 50 53 54 66 7 117 110 105 50 53 54 67 7 117 110 105 50 53 54 68 7 117 110 105 50 53 54 69 7 117 110 105 50 53 54 70 7 117 110 105 50 53 55 48 7 117 110 105 50 53 55 49 7 117 110 105 50 53 55 50 7 117 110 105 50 53 55 51 7 117 110 105 50 53 55 52 7 117 110 105 50 53 55 53 7 117 110 105 50 53 55 54 7 117 110 105 50 53 55 55 7 117 110 105 50 53 55 56 7 117 110 105 50 53 55 57 7 117 110 105 50 53 55 65 7 117 110 105 50 53 55 66 7 117 110 105 50 53 55 67 7 117 110 105 50 53 55 68 7 117 110 105 50 53 55 69 7 117 110 105 50 53 55 70 7 117 110 105 50 53 56 48 7 117 110 105 50 53 56 49 7 117 110 105 50 53 56 50 7 117 110 105 50 53 56 51 7 117 110 105 50 53 56 52 7 117 110 105 50 53 56 53 7 117 110 105 50 53 56 54 7 117 110 105 50 53 56 55 7 117 110 105 50 53 56 56 7 117 110 105 50 53 56 57 7 117 110 105 50 53 56 65 7 117 110 105 50 53 56 66 7 117 110 105 50 53 56 67 7 117 110 105 50 53 56 68 7 117 110 105 50 53 56 69 7 117 110 105 50 53 56 70 7 117 110 105 50 53 57 48 7 117 110 105 50 53 57 49 7 117 110 105 50 53 57 50 7 117 110 105 50 53 57 51 7 117 110 105 50 53 57 52 7 117 110 105 50 53 57 53 7 117 110 105 50 53 57 54 7 117 110 105 50 53 57 55 7 117 110 105 50 53 57 56 7 117 110 105 50 53 57 57 7 117 110 105 50 53 57 65 7 117 110 105 50 53 57 66 7 117 110 105 50 53 57 67 7 117 110 105 50 53 57 68 7 117 110 105 50 53 57 69 7 117 110 105 50 53 57 70 0 0 0 1 255 255 0 2 0 1 0 0 0 12 0 0 0 0 0 190 0 2 0 29 0 4 0 55 0 1 0 77 0 78 0 1 0 105 0 105 0 1 0 112 0 112 0 2 0 128 0 128 0 1 0 163 0 165 0 1 0 171 0 171 0 1 0 207 0 208 0 1 0 232 0 232 0 1 0 254 0 254 0 1 1 6 1 6 0 2 1 26 1 26 0 1 1 30 1 30 0 2 1 33 1 33 0 2 1 48 1 48 0 2 1 49 1 50 0 1 1 55 1 55 0 2 1 87 1 89 0 1 1 95 1 95 0 1 1 110 1 110 0 2 1 132 1 133 0 1 1 156 1 172 0 1 1 175 1 175 0 1 1 197 1 198 0 1 1 202 1 202 0 2 2 207 2 207 0 1 2 217 2 217 0 1 2 223 3 30 0 3 3 32 3 32 0 3 0 2 0 3 2 223 2 250 0 1 3 5 3 30 0 1 3 32 3 32 0 1 0 1 0 0 0 10 0 56 0 146 0 2 68 70 76 84 0 14 108 97 116 110 0 30 0 4 0 0 0 0 255 255 0 3 0 0 0 2 0 4 0 4 0 0 0 0 255 255 0 3 0 1 0 3 0 5 0 6 109 97 114 107 0 38 109 97 114 107 0 54 109 107 109 107 0 70 109 107 109 107 0 76 115 105 122 101 0 82 115 105 122 101 0 86 0 0 0 6 0 0 0 1 0 2 0 3 0 4 0 5 0 0 0 6 0 0 0 1 0 2 0 3 0 4 0 5 0 0 0 1 0 6 0 0 0 1 0 6 0 82 0 0 0 78 0 0 0 7 0 16 0 26 0 34 0 42 0 50 0 58 0 66 0 1 0 0 0 2 0 68 0 78 0 4 0 0 0 1 0 76 0 4 0 0 0 1 3 26 0 4 0 0 0 1 3 90 0 4 0 0 0 1 5 14 0 4 0 0 0 1 5 56 0 6 1 0 0 1 5 162 0 100 0 0 0 0 0 0 0 0 0 1 6 154 0 5 254 212 253 168 0 1 6 154 0 4 253 168 0 1 6 156 6 178 0 1 0 12 0 234 0 55 0 0 1 158 0 0 1 164 0 0 1 158 0 0 1 164 0 0 1 158 0 0 1 164 0 0 1 158 0 0 1 164 0 0 1 158 0 0 1 164 0 0 1 158 0 0 1 164 0 0 1 158 0 0 1 164 0 0 1 158 0 0 1 164 0 0 1 158 0 0 1 164 0 0 1 158 0 0 1 164 0 0 1 158 0 0 1 164 0 0 1 158 0 0 1 164 0 0 1 158 0 0 1 164 0 0 1 158 0 0 1 158 0 0 1 158 0 0 1 164 0 0 1 158 0 0 1 164 0 0 1 158 0 0 1 164 0 0 1 158 0 0 1 164 0 0 1 158 0 0 1 164 0 0 1 158 0 0 1 164 0 0 1 158 0 0 1 164 0 0 1 158 0 0 1 164 0 0 1 158 0 0 1 164 0 0 1 158 0 0 1 164 0 0 1 158 0 0 1 164 0 0 1 158 0 0 1 164 0 0 1 158 0 0 1 164 0 0 1 158 0 95 0 198 0 204 0 210 0 216 0 222 0 228 0 222 0 216 0 198 0 234 0 234 0 240 0 198 0 246 0 198 0 252 1 2 1 8 1 14 0 216 0 216 0 216 0 198 1 20 0 198 0 252 1 26 1 32 1 38 1 44 1 50 1 56 1 62 1 68 1 74 1 74 1 80 1 86 1 92 1 98 0 192 1 26 1 104 1 110 1 116 1 122 1 128 1 104 0 192 0 192 1 134 1 140 0 198 1 146 0 222 0 198 1 20 1 152 0 216 0 198 0 216 0 198 1 158 1 26 1 50 1 164 1 164 0 192 1 170 0 192 0 192 1 128 1 128 1 32 1 164 1 176 1 62 1 50 1 182 1 188 0 192 1 194 1 200 1 128 1 206 1 212 1 104 0 192 1 116 1 218 1 62 1 62 1 62 1 224 1 230 0 1 1 44 1 252 0 1 1 44 2 166 0 1 1 35 2 166 0 1 1 91 2 166 0 1 1 43 2 166 0 1 1 75 2 166 0 1 1 83 2 166 0 1 1 65 2 166 0 1 0 190 2 166 0 1 1 50 2 166 0 1 1 59 2 166 0 1 1 45 2 174 0 1 1 49 2 166 0 1 1 55 2 166 0 1 1 45 2 166 0 1 1 58 1 252 0 1 0 138 2 218 0 1 1 87 1 252 0 1 1 193 2 218 0 1 1 59 1 252 0 1 1 164 2 228 0 1 1 51 1 252 0 1 0 151 2 218 0 1 1 92 2 182 0 1 0 178 2 218 0 1 1 28 2 218 0 1 1 60 1 252 0 1 1 62 1 252 0 1 1 45 1 252 0 1 1 86 1 252 0 1 1 47 1 252 0 1 1 7 2 131 0 1 1 39 1 252 0 1 1 48 1 252 0 1 1 64 1 252 0 1 1 195 2 182 0 1 1 152 2 166 0 1 1 61 2 166 0 1 1 92 1 252 0 1 1 63 1 252 0 1 1 56 1 252 0 1 1 26 1 252 0 1 1 32 1 252 0 1 1 50 1 252 0 1 1 37 1 252 0 1 1 145 1 252 0 1 0 235 1 252 0 1 1 23 1 252 0 1 1 44 2 207 0 1 1 44 2 194 0 1 4 82 4 90 0 1 0 12 0 22 0 2 0 0 0 24 0 0 0 24 0 6 0 20 0 26 0 14 0 32 0 38 0 44 0 1 1 44 0 0 0 1 1 91 0 0 0 1 1 57 0 0 0 1 1 86 0 0 0 1 1 58 0 0 0 1 1 120 0 0 0 1 4 34 4 48 0 1 0 12 0 34 0 5 0 0 0 174 0 0 0 174 0 0 0 174 0 0 0 174 0 0 0 174 0 75 0 152 0 158 0 164 0 170 0 176 0 182 0 188 0 194 0 152 0 200 0 206 0 212 0 152 0 152 0 152 0 218 0 224 0 230 0 152 0 194 0 152 0 236 0 242 0 152 0 248 0 236 0 152 0 254 1 4 1 10 1 16 1 22 1 28 1 34 1 40 0 188 1 46 1 52 1 58 0 152 1 64 1 70 1 76 0 230 1 82 1 88 0 200 0 152 0 152 1 94 1 100 0 194 0 152 1 88 1 34 0 152 1 88 1 4 1 106 0 158 1 4 1 106 0 158 1 112 1 118 1 124 1 124 1 130 1 136 0 200 0 152 1 94 1 142 0 158 1 148 0 1 1 44 255 234 0 1 1 52 255 234 0 1 1 91 255 234 0 1 1 34 255 234 0 1 1 76 255 234 0 1 0 188 255 234 0 1 1 79 255 234 0 1 1 43 255 234 0 1 1 45 255 234 0 1 1 82 255 234 0 1 1 90 255 234 0 1 0 149 255 234 0 1 1 64 255 234 0 1 1 54 255 234 0 1 1 47 255 234 0 1 1 39 255 234 0 1 1 55 255 234 0 1 1 86 255 234 0 1 1 50 255 234 0 1 1 59 255 234 0 1 1 35 255 234 0 1 1 41 255 26 0 1 1 58 255 234 0 1 1 92 255 234 0 1 0 236 255 25 0 1 1 115 255 234 0 1 1 53 255 234 0 1 1 57 255 234 0 1 0 136 255 38 0 1 1 193 255 38 0 1 0 200 255 234 0 1 1 123 255 234 0 1 1 65 255 234 0 1 1 10 255 14 0 1 1 61 255 234 0 1 1 67 255 234 0 1 1 32 255 234 0 1 1 203 255 38 0 1 1 42 255 234 0 1 0 118 255 234 0 1 1 109 255 234 0 1 0 254 255 234 0 1 1 204 255 38 0 1 2 192 2 198 0 1 0 12 0 18 0 1 0 0 0 14 0 3 0 14 0 20 0 26 0 1 1 44 1 230 0 1 1 164 2 134 0 1 1 247 2 154 0 1 1 157 1 230 0 1 2 158 2 166 0 1 0 12 0 22 0 2 0 0 0 36 0 0 0 36 0 12 0 32 0 38 0 44 0 26 0 50 0 56 0 62 0 68 0 62 0 74 0 80 0 86 0 1 1 44 0 0 0 1 1 239 0 0 0 1 1 169 0 0 0 1 1 21 0 0 0 1 1 43 0 0 0 1 1 149 0 0 0 1 1 129 0 0 0 1 1 93 0 0 0 1 1 143 0 0 0 1 1 32 0 0 0 1 1 162 0 0 0 1 1 30 2 80 0 1 0 12 0 234 0 55 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 230 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 3 0 20 0 26 0 26 0 1 1 44 1 252 0 1 1 44 2 166 0 1 1 44 2 220 0 1 1 44 2 183 0 2 0 1 2 136 2 138 0 0 0 2 0 1 2 223 3 32 0 0 0 2 0 3 2 223 2 250 0 0 3 5 3 30 0 28 3 32 3 32 0 54 0 2 0 19 0 4 0 55 0 0 0 77 0 78 0 52 0 105 0 105 0 54 0 128 0 128 0 55 0 163 0 165 0 56 0 171 0 171 0 59 0 207 0 208 0 60 0 232 0 232 0 62 0 254 0 254 0 63 1 26 1 26 0 64 1 49 1 50 0 65 1 87 1 89 0 67 1 95 1 95 0 70 1 132 1 133 0 71 1 156 1 172 0 73 1 175 1 175 0 90 1 197 1 198 0 91 2 207 2 207 0 93 2 217 2 217 0 94 0 1 0 2 2 255 3 0 0 1 0 6 0 6 0 22 0 23 0 32 0 48 0 49 0 1 0 5 2 252 2 253 2 254 3 3 3 4 0 2 0 12 0 4 0 19 0 0 0 21 0 55 0 16 0 165 0 165 0 51 0 208 0 208 0 52 0 232 0 232 0 53 1 50 1 50 0 54 1 89 1 89 0 55 1 133 1 133 0 56 1 156 1 156 0 57 1 158 1 172 0 58 1 175 1 175 0 73 1 198 1 198 0 74 0 1 0 1 2 251 0 1 0 3 0 18 0 24 0 44 0 1 0 2 3 1 3 2 0 1 0 12 0 4 0 8 0 12 0 18 0 24 0 34 0 38 0 44 1 50 1 162 1 163 1 175 0 1 0 3 2 227 2 235 2 237 0 1 0 0 0 10 0 108 2 26 0 2 68 70 76 84 0 14 108 97 116 110 0 56 0 4 0 0 0 0 255 255 0 16 0 0 0 2 0 4 0 6 0 8 0 10 0 12 0 14 0 16 0 18 0 20 0 22 0 24 0 26 0 28 0 30 0 4 0 0 0 0 255 255 0 16 0 1 0 3 0 5 0 7 0 9 0 11 0 13 0 15 0 17 0 19 0 21 0 23 0 25 0 27 0 29 0 31 0 32 97 97 108 116 0 194 97 97 108 116 0 202 99 97 115 101 0 210 99 97 115 101 0 216 99 99 109 112 0 222 99 99 109 112 0 236 100 110 111 109 0 250 100 110 111 109 1 0 102 114 97 99 1 6 102 114 97 99 1 16 110 117 109 114 1 26 110 117 109 114 1 32 111 110 117 109 1 38 111 110 117 109 1 44 111 114 100 110 1 50 111 114 100 110 1 56 115 97 108 116 1 62 115 97 108 116 1 74 115 105 110 102 1 86 115 105 110 102 1 92 115 115 48 49 1 98 115 115 48 49 1 104 115 115 48 50 1 110 115 115 48 50 1 116 115 115 48 51 1 122 115 115 48 51 1 128 115 115 48 52 1 134 115 115 48 52 1 140 115 117 98 115 1 146 115 117 98 115 1 152 115 117 112 115 1 158 115 117 112 115 1 166 0 0 0 2 0 0 0 1 0 0 0 2 0 0 0 1 0 0 0 1 0 16 0 0 0 1 0 16 0 0 0 5 0 3 0 4 0 5 0 6 0 7 0 0 0 5 0 3 0 4 0 5 0 6 0 7 0 0 0 1 0 9 0 0 0 1 0 9 0 0 0 3 0 8 0 10 0 11 0 0 0 3 0 8 0 10 0 11 0 0 0 1 0 8 0 0 0 1 0 8 0 0 0 1 0 15 0 0 0 1 0 15 0 0 0 1 0 12 0 0 0 1 0 12 0 0 0 4 0 17 0 18 0 19 0 20 0 0 0 4 0 17 0 18 0 19 0 20 0 0 0 1 0 14 0 0 0 1 0 14 4 4 0 1 0 17 3 254 0 1 0 17 4 8 0 1 0 18 4 2 0 1 0 18 4 56 0 1 0 19 4 50 0 1 0 19 4 72 0 1 0 20 4 66 0 1 0 20 0 0 0 1 0 14 0 0 0 1 0 14 0 0 0 2 0 12 0 13 0 0 0 2 0 12 0 13 0 23 0 48 0 56 0 64 0 72 0 80 0 90 0 98 0 106 0 114 0 122 0 130 0 138 0 150 0 158 0 166 0 174 0 182 0 190 0 198 0 206 0 214 0 222 0 230 0 1 0 0 0 1 3 250 0 3 0 0 0 1 4 176 0 2 0 0 0 1 0 174 0 6 0 0 0 1 0 204 0 6 0 0 0 2 0 214 0 234 0 4 0 0 0 1 0 242 0 4 0 0 0 1 1 100 0 6 0 0 0 1 2 42 0 1 0 0 0 1 2 52 0 1 0 0 0 1 2 78 0 1 0 0 0 1 2 104 0 6 0 0 0 3 2 102 2 120 2 138 0 1 0 0 0 1 2 146 0 1 0 0 0 1 2 202 0 1 0 0 0 1 2 228 0 1 0 0 0 1 2 254 0 1 0 0 0 1 2 252 0 1 0 0 0 1 2 254 0 1 0 0 0 1 3 6 0 1 0 0 0 1 3 58 0 1 0 0 0 1 3 78 0 4 0 0 0 1 4 220 0 1 0 0 0 1 4 230 0 1 5 62 0 4 0 14 0 20 0 26 0 32 0 2 0 8 2 227 0 2 0 18 2 227 0 2 0 34 2 227 0 2 0 44 2 227 0 3 0 0 0 1 5 24 0 1 5 36 0 1 0 0 0 2 0 3 0 0 0 2 5 24 5 30 0 1 5 36 0 1 0 0 0 21 0 3 0 0 0 1 5 22 0 1 5 16 0 1 0 0 0 22 0 1 5 10 0 3 0 12 0 54 0 88 0 5 0 12 0 18 0 24 0 30 0 36 3 15 0 2 2 223 3 13 0 2 2 225 3 19 0 2 2 229 3 29 0 2 2 233 3 17 0 2 2 239 0 4 0 10 0 16 0 22 0 28 3 23 0 2 2 223 3 21 0 2 2 225 3 27 0 2 2 229 3 25 0 2 2 239 0 4 0 10 0 16 0 22 0 28 3 11 0 2 2 223 3 7 0 2 2 225 3 5 0 2 2 231 3 9 0 2 2 245 0 1 4 154 0 16 0 38 0 48 0 58 0 68 0 78 0 88 0 98 0 108 0 118 0 128 0 146 0 156 0 166 0 176 0 186 0 196 0 1 0 4 0 77 0 2 3 1 0 1 0 4 0 105 0 2 3 1 0 1 0 4 0 112 0 2 2 229 0 1 0 4 0 128 0 2 3 1 0 1 0 4 0 171 0 2 3 1 0 1 0 4 0 207 0 2 3 1 0 1 0 4 0 254 0 2 3 1 0 1 0 4 1 6 0 2 2 245 0 1 0 4 1 26 0 2 3 1 0 2 0 6 0 12 1 33 0 2 2 229 1 30 0 2 2 255 0 1 0 4 1 48 0 2 3 1 0 1 0 4 1 55 0 2 2 245 0 1 0 4 1 95 0 2 3 1 0 1 0 4 1 110 0 2 2 245 0 1 0 4 1 132 0 2 3 1 0 1 0 4 1 202 0 2 2 255 0 3 0 1 3 240 0 1 4 18 0 0 0 1 0 0 0 22 0 2 4 60 0 14 2 70 2 71 2 72 2 73 2 74 2 75 2 76 2 77 2 78 2 79 2 82 2 83 2 80 2 81 0 2 4 26 0 14 2 56 2 57 2 58 2 59 2 60 2 61 2 62 2 63 2 64 2 65 2 68 2 69 2 66 2 67 0 1 4 14 0 131 0 3 0 1 4 14 0 1 4 24 0 0 0 1 0 0 0 22 0 3 0 1 4 14 0 1 4 30 0 0 0 1 0 0 0 22 0 3 0 2 4 32 4 22 0 1 4 12 0 0 0 1 0 0 0 22 0 2 4 20 0 29 2 87 2 88 2 89 2 90 2 91 2 92 2 93 2 94 2 95 2 96 2 97 2 98 2 99 2 100 2 101 2 102 2 103 2 104 2 105 2 106 2 107 2 108 2 109 2 110 2 111 2 112 2 113 2 114 2 115 0 2 3 122 0 14 2 28 2 29 2 30 2 31 2 32 2 33 2 34 2 35 2 36 2 37 2 40 2 41 2 38 2 39 0 2 3 88 0 14 2 42 2 43 2 44 2 45 2 46 2 47 2 48 2 49 2 50 2 51 2 54 2 55 2 52 2 53 0 1 3 166 0 10 0 1 3 170 0 1 0 0 1 0 0 2 3 222 0 3 2 25 2 26 2 24 0 0 1 1 0 2 3 216 0 25 1 175 1 176 1 177 1 178 1 179 1 180 1 181 1 182 1 183 1 184 1 185 1 186 1 187 1 188 1 189 1 190 1 191 1 192 1 193 1 194 1 195 1 196 1 197 2 85 2 116 0 0 1 2 0 2 3 184 0 9 1 198 1 199 1 200 1 201 1 202 1 203 1 204 1 205 2 117 0 0 1 3 0 1 3 178 255 163 0 2 3 178 0 92 2 88 2 89 2 90 2 91 2 92 2 94 2 95 2 96 2 97 2 98 2 99 2 100 2 101 2 102 2 103 2 104 2 105 2 106 2 107 2 108 2 109 2 110 2 111 2 112 1 176 1 177 1 178 1 179 1 180 1 181 1 182 1 183 1 184 1 185 1 186 1 187 1 188 1 189 1 190 1 191 1 192 1 193 1 194 1 195 1 196 1 197 2 113 2 114 1 199 1 200 1 201 1 202 1 203 1 204 1 205 2 115 2 25 2 26 2 24 2 22 2 85 2 116 2 117 2 27 2 224 2 226 2 228 2 230 2 232 2 234 2 236 2 238 2 240 2 242 2 244 2 246 2 248 3 0 3 2 3 6 3 8 3 10 3 12 3 14 3 16 3 18 3 20 3 22 3 24 3 26 3 28 3 30 0 1 3 176 0 16 0 38 0 44 0 50 0 62 0 74 0 86 0 98 0 110 0 122 0 134 0 146 0 158 0 170 0 180 0 190 0 200 0 2 2 87 1 175 0 2 2 93 1 198 0 5 2 70 2 56 2 28 2 42 1 217 0 5 2 71 2 57 2 29 2 43 1 218 0 5 2 72 2 58 2 30 2 44 1 219 0 5 2 73 2 59 2 31 2 45 1 220 0 5 2 74 2 60 2 32 2 46 1 221 0 5 2 75 2 61 2 33 2 47 1 222 0 5 2 76 2 62 2 34 2 48 1 223 0 5 2 77 2 63 2 35 2 49 1 224 0 5 2 78 2 64 2 36 2 50 1 225 0 5 2 79 2 65 2 37 2 51 1 226 0 4 2 82 2 68 2 40 2 54 0 4 2 83 2 69 2 41 2 55 0 4 2 80 2 66 2 38 2 52 0 4 2 81 2 67 2 39 2 53 0 1 0 132 0 1 0 8 0 1 0 4 1 49 0 2 3 1 0 2 2 238 0 45 3 35 1 49 2 56 2 57 2 58 2 59 2 60 2 61 2 62 2 63 2 64 2 65 2 66 2 67 2 68 2 69 2 224 2 226 2 228 2 230 2 232 2 234 2 236 2 238 2 240 2 242 2 244 2 246 2 248 3 0 3 2 3 6 3 8 3 10 3 12 3 14 3 16 3 18 3 20 3 22 3 24 3 26 3 28 3 30 3 36 0 1 0 4 0 91 0 149 1 12 1 73 0 1 0 1 2 233 0 1 0 1 0 38 0 1 0 1 3 1 0 1 0 1 2 225 0 1 0 1 1 48 0 1 0 3 2 227 2 233 2 237 0 1 0 16 0 4 0 8 0 10 0 12 0 18 0 24 0 30 0 33 0 34 0 36 0 38 0 41 0 44 0 49 0 50 1 198 0 2 0 5 0 4 0 29 0 0 0 56 0 78 0 26 0 80 0 122 0 49 0 124 0 152 0 92 0 154 0 232 0 121 0 1 0 28 2 223 2 225 2 227 2 229 2 231 2 233 2 235 2 237 2 239 2 241 2 243 2 245 2 247 2 255 3 1 3 5 3 7 3 9 3 11 3 13 3 15 3 17 3 19 3 21 3 23 3 25 3 27 3 29 0 2 0 3 1 207 1 216 0 0 1 227 1 228 0 10 2 1 2 2 0 12 0 1 0 1 2 7 0 2 0 1 2 70 2 79 0 0 0 1 0 2 0 3 3 33 0 2 0 2 2 56 2 69 0 0 2 136 2 138 0 14 0 2 0 1 2 70 2 83 0 0 0 2 0 1 2 56 2 65 0 0 0 1 0 2 3 35 3 36 0 2 0 3 0 30 0 55 0 0 1 10 1 11 0 26 1 163 1 163 0 28 0 2 0 1 1 207 1 216 0 0 0 1 0 29 2 21 2 223 2 225 2 227 2 229 2 231 2 233 2 235 2 237 2 239 2 241 2 243 2 245 2 247 2 255 3 1 3 5 3 7 3 9 3 11 3 13 3 15 3 17 3 19 3 21 3 23 3 25 3 27 3 29 0 1 0 3 1 248 1 249 2 11 0 2 0 4 0 30 0 30 0 0 0 233 0 254 0 1 2 84 2 84 0 23 2 87 2 87 0 24 0 2 0 3 0 36 0 36 0 0 1 27 1 33 0 1 2 93 2 93 0 8 0 1 0 1 2 120 0 1 0 92 0 31 0 32 0 33 0 34 0 35 0 37 0 38 0 39 0 40 0 41 0 42 0 43 0 44 0 45 0 46 0 47 0 48 0 49 0 50 0 51 0 52 0 53 0 54 0 55 0 233 0 234 0 235 0 236 0 237 0 238 0 239 0 240 0 241 0 242 0 243 0 244 0 245 0 246 0 247 0 248 0 249 0 250 0 251 0 252 0 253 0 254 1 10 1 11 1 27 1 28 1 29 1 30 1 31 1 32 1 33 1 163 1 248 1 249 2 11 2 21 2 84 2 87 2 93 2 120 2 223 2 225 2 227 2 229 2 231 2 233 2 235 2 237 2 239 2 241 2 243 2 245 2 247 2 255 3 1 3 5 3 7 3 9 3 11 3 13 3 15 3 17 3 19 3 21 3 23 3 25 3 27 3 29 0 2 0 5 0 30 0 30 0 0 0 36 0 36 0 1 1 207 1 216 0 2 1 227 1 228 0 12 2 1 2 2 0 14 0 1 0 45 0 3 1 48 2 70 2 71 2 72 2 73 2 74 2 75 2 76 2 77 2 78 2 79 2 80 2 81 2 82 2 83 2 223 2 225 2 227 2 229 2 231 2 233 2 235 2 237 2 239 2 241 2 243 2 245 2 247 2 255 3 1 3 5 3 7 3 9 3 11 3 13 3 15 3 17 3 19 3 21 3 23 3 25 3 27 3 29 3 33 0 0 0 1 0 0 0 8 0 0 0 4 0 14 0 2 105 100 101 111 114 111 109 110 0 2 68 70 76 84 0 14 108 97 116 110 0 14 0 6 0 0 0 0 0 1 0 2 0 8 0 12 0 1 255 86 0 1 0 0 0 0 0 0 0 1 0 1 0 1 0 0 0 1 0 0 32 68 0 0 0 20 0 0 0 0 0 0 32 60 48 130 32 56 6 9 42 134 72 134 247 13 1 7 2 160 130 32 41 48 130 32 37 2 1 1 49 11 48 9 6 5 43 14 3 2 26 5 0 48 97 6 10 43 6 1 4 1 130 55 2 1 4 160 83 48 81 48 44 6 10 43 6 1 4 1 130 55 2 1 28 162 30 128 28 0 60 0 60 0 60 0 79 0 98 0 115 0 111 0 108 0 101 0 116 0 101 0 62 0 62 0 62 48 33 48 9 6 5 43 14 3 2 26 5 0 4 20 100 230 183 224 68 29 217 171 22 228 33 234 41 10 75 105 164 243 16 171 160 130 27 15 48 130 2 60 48 130 1 165 2 16 112 186 228 29 16 217 41 52 182 56 202 123 3 204 186 191 48 13 6 9 42 134 72 134 247 13 1 1 2 5 0 48 95 49 11 48 9 6 3 85 4 6 19 2 85 83 49 23 48 21 6 3 85 4 10 19 14 86 101 114 105 83 105 103 110 44 32 73 110 99 46 49 55 48 53 6 3 85 4 11 19 46 67 108 97 115 115 32 51 32 80 117 98 108 105 99 32 80 114 105 109 97 114 121 32 67 101 114 116 105 102 105 99 97 116 105 111 110 32 65 117 116 104 111 114 105 116 121 48 30 23 13 57 54 48 49 50 57 48 48 48 48 48 48 90 23 13 50 56 48 56 48 49 50 51 53 57 53 57 90 48 95 49 11 48 9 6 3 85 4 6 19 2 85 83 49 23 48 21 6 3 85 4 10 19 14 86 101 114 105 83 105 103 110 44 32 73 110 99 46 49 55 48 53 6 3 85 4 11 19 46 67 108 97 115 115 32 51 32 80 117 98 108 105 99 32 80 114 105 109 97 114 121 32 67 101 114 116 105 102 105 99 97 116 105 111 110 32 65 117 116 104 111 114 105 116 121 48 129 159 48 13 6 9 42 134 72 134 247 13 1 1 1 5 0 3 129 141 0 48 129 137 2 129 129 0 201 92 89 158 242 27 138 1 20 180 16 223 4 64 219 227 87 175 106 69 64 143 132 12 11 209 51 217 217 17 207 238 2 88 31 37 247 42 168 68 5 170 236 3 31 120 127 158 147 185 154 0 170 35 125 214 172 133 162 99 69 199 114 39 204 244 76 198 117 113 210 57 239 79 66 240 117 223 10 144 198 142 32 111 152 15 248 172 35 95 112 41 54 164 201 134 231 177 154 32 203 83 165 133 231 61 190 125 154 254 36 69 51 220 118 21 237 15 162 113 100 76 101 46 129 104 69 167 2 3 1 0 1 48 13 6 9 42 134 72 134 247 13 1 1 2 5 0 3 129 129 0 187 76 18 43 207 44 38 0 79 20 19 221 166 251 252 10 17 132 140 243 40 28 103 146 47 124 182 197 250 223 240 232 149 188 29 143 108 44 168 81 204 115 216 164 192 83 240 78 214 38 192 118 1 87 129 146 94 33 241 209 177 255 231 208 33 88 205 105 23 227 68 28 156 25 68 57 137 92 220 156 0 15 86 141 2 153 237 162 144 69 76 228 187 16 164 61 240 50 3 14 241 206 248 232 201 81 140 230 98 159 230 159 192 125 183 114 156 201 54 58 107 159 78 168 255 100 13 100 48 130 3 238 48 130 3 87 160 3 2 1 2 2 16 126 147 235 251 124 198 78 89 234 75 154 119 212 6 252 59 48 13 6 9 42 134 72 134 247 13 1 1 5 5 0 48 129 139 49 11 48 9 6 3 85 4 6 19 2 90 65 49 21 48 19 6 3 85 4 8 19 12 87 101 115 116 101 114 110 32 67 97 112 101 49 20 48 18 6 3 85 4 7 19 11 68 117 114 98 97 110 118 105 108 108 101 49 15 48 13 6 3 85 4 10 19 6 84 104 97 119 116 101 49 29 48 27 6 3 85 4 11 19 20 84 104 97 119 116 101 32 67 101 114 116 105 102 105 99 97 116 105 111 110 49 31 48 29 6 3 85 4 3 19 22 84 104 97 119 116 101 32 84 105 109 101 115 116 97 109 112 105 110 103 32 67 65 48 30 23 13 49 50 49 50 50 49 48 48 48 48 48 48 90 23 13 50 48 49 50 51 48 50 51 53 57 53 57 90 48 94 49 11 48 9 6 3 85 4 6 19 2 85 83 49 29 48 27 6 3 85 4 10 19 20 83 121 109 97 110 116 101 99 32 67 111 114 112 111 114 97 116 105 111 110 49 48 48 46 6 3 85 4 3 19 39 83 121 109 97 110 116 101 99 32 84 105 109 101 32 83 116 97 109 112 105 110 103 32 83 101 114 118 105 99 101 115 32 67 65 32 45 32 71 50 48 130 1 34 48 13 6 9 42 134 72 134 247 13 1 1 1 5 0 3 130 1 15 0 48 130 1 10 2 130 1 1 0 177 172 179 73 84 75 151 28 18 10 216 37 121 145 34 87 42 111 220 184 38 196 67 115 107 194 191 46 80 90 251 20 194 118 142 67 1 37 67 180 161 226 69 244 232 183 123 195 116 204 34 215 180 148 0 2 247 77 237 191 180 183 68 36 107 205 95 69 59 209 68 206 67 18 115 23 130 139 105 180 43 203 153 30 172 114 27 38 77 113 31 177 49 221 251 81 97 2 83 166 170 245 73 44 5 120 69 165 47 137 206 231 153 231 254 140 226 87 63 61 198 146 220 74 248 123 51 228 121 10 251 240 117 136 65 156 255 197 3 81 153 170 215 108 159 147 105 135 101 41 131 133 194 96 20 196 200 201 59 20 218 192 129 240 31 13 116 222 146 34 171 202 247 251 116 124 39 230 247 74 27 127 167 195 158 45 174 138 234 166 230 170 39 22 125 97 247 152 113 17 188 226 80 161 75 229 93 250 229 14 167 44 159 170 101 32 211 216 150 232 200 124 165 78 72 68 255 25 226 68 7 146 11 215 104 132 128 93 106 120 100 69 205 96 70 126 84 193 19 124 197 121 241 201 193 113 2 3 1 0 1 163 129 250 48 129 247 48 29 6 3 85 29 14 4 22 4 20 95 154 245 110 92 204 204 116 154 212 221 125 239 63 219 236 76 128 46 221 48 50 6 8 43 6 1 5 5 7 1 1 4 38 48 36 48 34 6 8 43 6 1 5 5 7 48 1 134 22 104 116 116 112 58 47 47 111 99 115 112 46 116 104 97 119 116 101 46 99 111 109 48 18 6 3 85 29 19 1 1 255 4 8 48 6 1 1 255 2 1 0 48 63 6 3 85 29 31 4 56 48 54 48 52 160 50 160 48 134 46 104 116 116 112 58 47 47 99 114 108 46 116 104 97 119 116 101 46 99 111 109 47 84 104 97 119 116 101 84 105 109 101 115 116 97 109 112 105 110 103 67 65 46 99 114 108 48 19 6 3 85 29 37 4 12 48 10 6 8 43 6 1 5 5 7 3 8 48 14 6 3 85 29 15 1 1 255 4 4 3 2 1 6 48 40 6 3 85 29 17 4 33 48 31 164 29 48 27 49 25 48 23 6 3 85 4 3 19 16 84 105 109 101 83 116 97 109 112 45 50 48 52 56 45 49 48 13 6 9 42 134 72 134 247 13 1 1 5 5 0 3 129 129 0 3 9 155 143 121 239 127 89 48 170 239 104 181 250 227 9 29 187 79 130 6 93 55 95 166 82 159 22 141 234 28 146 9 68 110 245 109 235 88 124 48 232 249 105 141 35 115 11 18 111 71 169 174 57 17 248 42 177 155 176 26 195 142 235 89 150 0 173 206 12 77 178 208 49 166 8 92 42 122 252 226 122 29 87 76 168 101 24 233 121 64 98 37 150 110 199 199 55 106 131 33 8 142 65 234 221 217 87 63 29 119 73 135 42 22 6 94 166 56 106 34 18 163 81 25 131 126 182 48 130 4 144 48 130 3 249 160 3 2 1 2 2 16 27 9 59 120 96 150 218 55 187 164 81 148 70 200 150 120 48 13 6 9 42 134 72 134 247 13 1 1 5 5 0 48 95 49 11 48 9 6 3 85 4 6 19 2 85 83 49 23 48 21 6 3 85 4 10 19 14 86 101 114 105 83 105 103 110 44 32 73 110 99 46 49 55 48 53 6 3 85 4 11 19 46 67 108 97 115 115 32 51 32 80 117 98 108 105 99 32 80 114 105 109 97 114 121 32 67 101 114 116 105 102 105 99 97 116 105 111 110 32 65 117 116 104 111 114 105 116 121 48 30 23 13 48 54 49 49 48 56 48 48 48 48 48 48 90 23 13 50 49 49 49 48 55 50 51 53 57 53 57 90 48 129 202 49 11 48 9 6 3 85 4 6 19 2 85 83 49 23 48 21 6 3 85 4 10 19 14 86 101 114 105 83 105 103 110 44 32 73 110 99 46 49 31 48 29 6 3 85 4 11 19 22 86 101 114 105 83 105 103 110 32 84 114 117 115 116 32 78 101 116 119 111 114 107 49 58 48 56 6 3 85 4 11 19 49 40 99 41 32 50 48 48 54 32 86 101 114 105 83 105 103 110 44 32 73 110 99 46 32 45 32 70 111 114 32 97 117 116 104 111 114 105 122 101 100 32 117 115 101 32 111 110 108 121 49 69 48 67 6 3 85 4 3 19 60 86 101 114 105 83 105 103 110 32 67 108 97 115 115 32 51 32 80 117 98 108 105 99 32 80 114 105 109 97 114 121 32 67 101 114 116 105 102 105 99 97 116 105 111 110 32 65 117 116 104 111 114 105 116 121 32 45 32 71 53 48 130 1 34 48 13 6 9 42 134 72 134 247 13 1 1 1 5 0 3 130 1 15 0 48 130 1 10 2 130 1 1 0 175 36 8 8 41 122 53 158 96 12 170 231 75 59 78 220 124 188 60 69 28 187 43 224 254 41 2 249 87 8 163 100 133 21 39 245 241 173 200 49 137 93 34 232 42 170 166 66 179 143 248 185 85 183 177 183 75 179 254 143 126 7 87 236 239 67 219 102 98 21 97 207 96 13 164 216 222 248 224 195 98 8 61 84 19 235 73 202 89 84 133 38 229 43 143 27 159 235 245 161 145 194 51 73 216 67 99 106 82 75 210 143 232 112 81 77 209 137 105 123 199 112 246 179 220 18 116 219 123 93 75 86 211 150 191 21 119 161 176 244 162 37 242 175 28 146 103 24 229 244 6 4 239 144 185 228 0 228 221 58 181 25 255 2 186 244 60 238 224 139 235 55 139 236 244 215 172 242 246 240 61 175 221 117 145 51 25 29 28 64 203 116 36 25 33 147 217 20 254 172 42 82 199 143 213 4 73 228 141 99 71 136 60 105 131 203 254 71 189 43 126 79 197 149 174 14 157 212 209 67 192 103 115 227 20 8 126 229 63 159 115 184 51 10 207 93 63 52 135 150 138 238 83 232 37 21 2 3 1 0 1 163 130 1 91 48 130 1 87 48 15 6 3 85 29 19 1 1 255 4 5 48 3 1 1 255 48 49 6 3 85 29 31 4 42 48 40 48 38 160 36 160 34 134 32 104 116 116 112 58 47 47 99 114 108 46 118 101 114 105 115 105 103 110 46 99 111 109 47 112 99 97 51 46 99 114 108 48 14 6 3 85 29 15 1 1 255 4 4 3 2 1 6 48 61 6 3 85 29 32 4 54 48 52 48 50 6 4 85 29 32 0 48 42 48 40 6 8 43 6 1 5 5 7 2 1 22 28 104 116 116 112 115 58 47 47 119 119 119 46 118 101 114 105 115 105 103 110 46 99 111 109 47 99 112 115 48 29 6 3 85 29 14 4 22 4 20 127 211 101 167 194 221 236 187 240 48 9 243 67 57 250 2 175 51 49 51 48 109 6 8 43 6 1 5 5 7 1 12 4 97 48 95 161 93 160 91 48 89 48 87 48 85 22 9 105 109 97 103 101 47 103 105 102 48 33 48 31 48 7 6 5 43 14 3 2 26 4 20 143 229 211 26 134 172 141 142 107 195 207 128 106 212 72 24 44 123 25 46 48 37 22 35 104 116 116 112 58 47 47 108 111 103 111 46 118 101 114 105 115 105 103 110 46 99 111 109 47 118 115 108 111 103 111 46 103 105 102 48 52 6 8 43 6 1 5 5 7 1 1 4 40 48 38 48 36 6 8 43 6 1 5 5 7 48 1 134 24 104 116 116 112 58 47 47 111 99 115 112 46 118 101 114 105 115 105 103 110 46 99 111 109 48 13 6 9 42 134 72 134 247 13 1 1 5 5 0 3 129 129 0 163 205 125 30 247 199 117 141 72 231 86 52 76 0 144 117 169 81 165 86 193 109 188 254 245 83 34 233 152 162 172 154 126 112 30 179 142 59 69 227 134 149 49 218 109 76 251 52 80 128 150 205 36 242 64 223 4 63 226 101 206 52 34 97 21 234 102 112 100 210 241 110 243 202 24 89 106 65 70 126 130 222 25 176 112 49 86 105 13 12 230 29 157 113 88 220 204 222 98 245 225 122 16 2 216 122 220 59 250 87 189 201 233 143 70 33 57 159 81 101 76 142 58 190 40 65 112 29 48 130 4 163 48 130 3 139 160 3 2 1 2 2 16 14 207 244 56 200 254 191 53 110 4 216 106 152 27 26 80 48 13 6 9 42 134 72 134 247 13 1 1 5 5 0 48 94 49 11 48 9 6 3 85 4 6 19 2 85 83 49 29 48 27 6 3 85 4 10 19 20 83 121 109 97 110 116 101 99 32 67 111 114 112 111 114 97 116 105 111 110 49 48 48 46 6 3 85 4 3 19 39 83 121 109 97 110 116 101 99 32 84 105 109 101 32 83 116 97 109 112 105 110 103 32 83 101 114 118 105 99 101 115 32 67 65 32 45 32 71 50 48 30 23 13 49 50 49 48 49 56 48 48 48 48 48 48 90 23 13 50 48 49 50 50 57 50 51 53 57 53 57 90 48 98 49 11 48 9 6 3 85 4 6 19 2 85 83 49 29 48 27 6 3 85 4 10 19 20 83 121 109 97 110 116 101 99 32 67 111 114 112 111 114 97 116 105 111 110 49 52 48 50 6 3 85 4 3 19 43 83 121 109 97 110 116 101 99 32 84 105 109 101 32 83 116 97 109 112 105 110 103 32 83 101 114 118 105 99 101 115 32 83 105 103 110 101 114 32 45 32 71 52 48 130 1 34 48 13 6 9 42 134 72 134 247 13 1 1 1 5 0 3 130 1 15 0 48 130 1 10 2 130 1 1 0 162 99 11 57 68 184 187 35 167 68 73 187 14 255 161 240 97 10 83 147 176 152 219 173 44 15 74 197 110 255 134 60 83 85 15 21 206 4 63 43 253 169 150 150 217 190 97 121 11 91 201 76 134 118 229 224 67 75 34 149 238 194 43 67 193 159 216 104 180 142 64 79 238 133 56 185 17 197 35 242 100 88 240 21 50 111 78 87 161 174 136 164 2 215 42 30 205 75 225 221 99 213 23 137 50 91 176 94 153 90 168 157 40 80 14 23 238 150 219 97 59 69 81 29 207 18 86 11 146 71 252 171 174 246 102 61 71 172 112 114 231 146 231 95 205 16 185 196 131 100 148 25 189 37 128 225 232 210 34 165 208 186 2 122 161 119 147 91 101 195 238 23 116 188 65 134 42 220 8 76 140 146 140 145 45 158 119 68 31 104 214 168 116 119 219 14 91 50 139 86 139 51 189 217 99 200 73 157 58 197 197 234 51 11 210 241 163 27 244 139 190 217 179 87 139 59 222 4 167 122 34 178 36 174 46 199 112 197 190 78 131 38 8 251 11 189 169 79 153 8 225 16 40 114 170 205 2 3 1 0 1 163 130 1 87 48 130 1 83 48 12 6 3 85 29 19 1 1 255 4 2 48 0 48 22 6 3 85 29 37 1 1 255 4 12 48 10 6 8 43 6 1 5 5 7 3 8 48 14 6 3 85 29 15 1 1 255 4 4 3 2 7 128 48 115 6 8 43 6 1 5 5 7 1 1 4 103 48 101 48 42 6 8 43 6 1 5 5 7 48 1 134 30 104 116 116 112 58 47 47 116 115 45 111 99 115 112 46 119 115 46 115 121 109 97 110 116 101 99 46 99 111 109 48 55 6 8 43 6 1 5 5 7 48 2 134 43 104 116 116 112 58 47 47 116 115 45 97 105 97 46 119 115 46 115 121 109 97 110 116 101 99 46 99 111 109 47 116 115 115 45 99 97 45 103 50 46 99 101 114 48 60 6 3 85 29 31 4 53 48 51 48 49 160 47 160 45 134 43 104 116 116 112 58 47 47 116 115 45 99 114 108 46 119 115 46 115 121 109 97 110 116 101 99 46 99 111 109 47 116 115 115 45 99 97 45 103 50 46 99 114 108 48 40 6 3 85 29 17 4 33 48 31 164 29 48 27 49 25 48 23 6 3 85 4 3 19 16 84 105 109 101 83 116 97 109 112 45 50 48 52 56 45 50 48 29 6 3 85 29 14 4 22 4 20 70 198 105 163 14 74 20 30 213 76 218 82 99 23 63 94 54 188 13 230 48 31 6 3 85 29 35 4 24 48 22 128 20 95 154 245 110 92 204 204 116 154 212 221 125 239 63 219 236 76 128 46 221 48 13 6 9 42 134 72 134 247 13 1 1 5 5 0 3 130 1 1 0 120 59 180 145 42 0 76 240 143 98 48 55 120 163 132 39 7 111 24 178 222 37 220 160 212 148 3 170 134 78 37 159 154 64 3 28 221 206 227 121 203 33 104 6 218 182 50 180 109 191 244 44 38 99 51 228 73 100 109 13 230 195 103 14 247 5 164 53 108 124 137 22 198 233 178 223 178 233 221 32 198 113 15 205 149 116 220 182 92 222 189 55 31 67 120 230 120 181 205 40 4 32 163 170 241 75 196 136 41 145 14 128 209 17 252 221 92 118 110 79 94 14 69 70 65 110 13 176 234 56 154 177 58 218 9 113 16 252 28 121 180 128 123 172 105 244 253 156 182 12 22 43 241 127 91 9 61 155 91 226 22 202 19 129 109 0 46 56 13 168 41 143 44 225 178 244 90 169 1 175 21 156 44 47 73 27 219 34 187 195 254 120 148 81 195 134 177 130 136 93 240 61 180 81 161 121 51 43 46 123 185 220 32 9 19 113 235 106 25 91 207 232 165 48 87 44 137 73 63 185 207 127 201 191 62 34 104 99 83 154 189 105 116 172 197 29 60 127 146 224 195 188 28 216 4 117 48 130 5 144 48 130 4 120 160 3 2 1 2 2 16 116 37 83 173 7 228 175 209 21 4 175 152 77 73 237 104 48 13 6 9 42 134 72 134 247 13 1 1 5 5 0 48 129 180 49 11 48 9 6 3 85 4 6 19 2 85 83 49 23 48 21 6 3 85 4 10 19 14 86 101 114 105 83 105 103 110 44 32 73 110 99 46 49 31 48 29 6 3 85 4 11 19 22 86 101 114 105 83 105 103 110 32 84 114 117 115 116 32 78 101 116 119 111 114 107 49 59 48 57 6 3 85 4 11 19 50 84 101 114 109 115 32 111 102 32 117 115 101 32 97 116 32 104 116 116 112 115 58 47 47 119 119 119 46 118 101 114 105 115 105 103 110 46 99 111 109 47 114 112 97 32 40 99 41 49 48 49 46 48 44 6 3 85 4 3 19 37 86 101 114 105 83 105 103 110 32 67 108 97 115 115 32 51 32 67 111 100 101 32 83 105 103 110 105 110 103 32 50 48 49 48 32 67 65 48 30 23 13 49 50 48 57 49 56 48 48 48 48 48 48 90 23 13 49 51 48 57 49 56 50 51 53 57 53 57 90 48 129 211 49 11 48 9 6 3 85 4 6 19 2 85 83 49 19 48 17 6 3 85 4 8 19 10 67 97 108 105 102 111 114 110 105 97 49 17 48 15 6 3 85 4 7 19 8 83 97 110 32 74 111 115 101 49 35 48 33 6 3 85 4 10 20 26 65 100 111 98 101 32 83 121 115 116 101 109 115 32 73 110 99 111 114 112 111 114 97 116 101 100 49 18 48 16 6 3 85 4 11 20 9 84 121 112 101 32 70 111 110 116 49 62 48 60 6 3 85 4 11 19 53 68 105 103 105 116 97 108 32 73 68 32 67 108 97 115 115 32 51 32 45 32 77 105 99 114 111 115 111 102 116 32 83 111 102 116 119 97 114 101 32 86 97 108 105 100 97 116 105 111 110 32 118 50 49 35 48 33 6 3 85 4 3 20 26 65 100 111 98 101 32 83 121 115 116 101 109 115 32 73 110 99 111 114 112 111 114 97 116 101 100 48 130 1 34 48 13 6 9 42 134 72 134 247 13 1 1 1 5 0 3 130 1 15 0 48 130 1 10 2 130 1 1 0 183 194 17 83 93 40 162 97 211 4 212 113 190 60 57 62 90 192 30 28 186 237 226 148 195 199 56 131 193 235 45 107 15 74 184 138 39 255 23 21 5 202 222 234 75 161 119 146 100 14 79 246 242 211 246 6 190 153 149 179 99 26 198 178 173 225 166 11 112 231 214 53 82 194 33 138 150 50 44 13 98 138 214 31 215 147 231 18 113 245 12 209 174 113 96 85 116 82 208 174 226 85 149 15 224 15 92 233 55 166 8 75 92 145 255 212 146 186 21 228 98 140 106 115 221 80 171 168 86 158 74 94 114 191 19 205 233 192 211 146 155 140 185 107 10 185 39 79 184 81 155 94 22 105 29 211 238 103 213 40 247 228 12 143 235 124 216 90 200 120 107 245 118 234 50 67 223 114 63 154 114 105 141 0 84 210 9 251 158 218 233 194 224 169 67 212 146 116 74 183 196 1 143 227 48 75 173 177 64 88 87 96 214 143 131 243 139 235 192 189 213 67 79 101 17 63 114 21 23 94 173 218 255 113 5 178 41 158 156 13 120 136 231 237 75 156 146 164 205 161 26 253 143 8 158 173 2 3 1 0 1 163 130 1 123 48 130 1 119 48 9 6 3 85 29 19 4 2 48 0 48 14 6 3 85 29 15 1 1 255 4 4 3 2 7 128 48 64 6 3 85 29 31 4 57 48 55 48 53 160 51 160 49 134 47 104 116 116 112 58 47 47 99 115 99 51 45 50 48 49 48 45 99 114 108 46 118 101 114 105 115 105 103 110 46 99 111 109 47 67 83 67 51 45 50 48 49 48 46 99 114 108 48 68 6 3 85 29 32 4 61 48 59 48 57 6 11 96 134 72 1 134 248 69 1 7 23 3 48 42 48 40 6 8 43 6 1 5 5 7 2 1 22 28 104 116 116 112 115 58 47 47 119 119 119 46 118 101 114 105 115 105 103 110 46 99 111 109 47 99 112 115 48 19 6 3 85 29 37 4 12 48 10 6 8 43 6 1 5 5 7 3 3 48 113 6 8 43 6 1 5 5 7 1 1 4 101 48 99 48 36 6 8 43 6 1 5 5 7 48 1 134 24 104 116 116 112 58 47 47 111 99 115 112 46 118 101 114 105 115 105 103 110 46 99 111 109 48 59 6 8 43 6 1 5 5 7 48 2 134 47 104 116 116 112 58 47 47 99 115 99 51 45 50 48 49 48 45 97 105 97 46 118 101 114 105 115 105 103 110 46 99 111 109 47 67 83 67 51 45 50 48 49 48 46 99 101 114 48 31 6 3 85 29 35 4 24 48 22 128 20 207 153 169 234 123 38 244 75 201 142 143 215 240 5 38 239 227 210 167 157 48 17 6 9 96 134 72 1 134 248 66 1 1 4 4 3 2 4 16 48 22 6 10 43 6 1 4 1 130 55 2 1 27 4 8 48 6 1 1 0 1 1 255 48 13 6 9 42 134 72 134 247 13 1 1 5 5 0 3 130 1 1 0 170 104 97 189 175 221 82 2 196 142 65 165 125 111 136 158 190 254 185 203 183 107 237 194 56 101 27 98 49 68 219 155 173 57 51 191 133 148 255 108 0 249 186 148 148 160 155 91 231 79 31 45 3 89 224 227 162 221 99 214 188 229 43 116 1 123 45 164 0 116 54 219 94 146 153 155 248 123 23 185 191 221 56 76 230 44 132 250 78 42 218 16 153 213 244 141 149 129 51 237 100 15 155 72 68 34 52 95 7 99 113 219 104 204 209 81 255 56 223 218 232 14 179 193 234 37 175 8 179 12 157 202 48 147 202 12 126 221 59 128 216 35 162 10 213 22 37 220 12 218 219 221 50 3 181 155 31 250 209 82 249 217 154 42 16 62 140 177 151 27 65 46 169 31 1 47 111 73 9 220 108 183 43 206 127 216 47 220 204 125 246 105 30 223 148 29 201 197 118 165 226 247 52 43 118 211 244 46 62 20 226 234 106 65 242 223 237 127 14 47 220 238 174 246 5 108 10 64 64 241 79 33 138 131 131 164 182 142 7 103 21 115 212 6 96 220 196 218 25 139 75 40 53 182 193 225 48 130 6 10 48 130 4 242 160 3 2 1 2 2 16 82 0 229 170 37 86 252 26 134 237 150 201 212 75 51 199 48 13 6 9 42 134 72 134 247 13 1 1 5 5 0 48 129 202 49 11 48 9 6 3 85 4 6 19 2 85 83 49 23 48 21 6 3 85 4 10 19 14 86 101 114 105 83 105 103 110 44 32 73 110 99 46 49 31 48 29 6 3 85 4 11 19 22 86 101 114 105 83 105 103 110 32 84 114 117 115 116 32 78 101 116 119 111 114 107 49 58 48 56 6 3 85 4 11 19 49 40 99 41 32 50 48 48 54 32 86 101 114 105 83 105 103 110 44 32 73 110 99 46 32 45 32 70 111 114 32 97 117 116 104 111 114 105 122 101 100 32 117 115 101 32 111 110 108 121 49 69 48 67 6 3 85 4 3 19 60 86 101 114 105 83 105 103 110 32 67 108 97 115 115 32 51 32 80 117 98 108 105 99 32 80 114 105 109 97 114 121 32 67 101 114 116 105 102 105 99 97 116 105 111 110 32 65 117 116 104 111 114 105 116 121 32 45 32 71 53 48 30 23 13 49 48 48 50 48 56 48 48 48 48 48 48 90 23 13 50 48 48 50 48 55 50 51 53 57 53 57 90 48 129 180 49 11 48 9 6 3 85 4 6 19 2 85 83 49 23 48 21 6 3 85 4 10 19 14 86 101 114 105 83 105 103 110 44 32 73 110 99 46 49 31 48 29 6 3 85 4 11 19 22 86 101 114 105 83 105 103 110 32 84 114 117 115 116 32 78 101 116 119 111 114 107 49 59 48 57 6 3 85 4 11 19 50 84 101 114 109 115 32 111 102 32 117 115 101 32 97 116 32 104 116 116 112 115 58 47 47 119 119 119 46 118 101 114 105 115 105 103 110 46 99 111 109 47 114 112 97 32 40 99 41 49 48 49 46 48 44 6 3 85 4 3 19 37 86 101 114 105 83 105 103 110 32 67 108 97 115 115 32 51 32 67 111 100 101 32 83 105 103 110 105 110 103 32 50 48 49 48 32 67 65 48 130 1 34 48 13 6 9 42 134 72 134 247 13 1 1 1 5 0 3 130 1 15 0 48 130 1 10 2 130 1 1 0 245 35 75 94 165 215 138 187 50 233 212 87 247 239 228 199 38 126 173 25 152 254 168 157 125 148 246 54 107 16 215 117 129 48 127 4 104 127 203 43 117 30 205 29 8 140 223 105 148 167 55 163 156 123 128 224 153 225 238 55 77 95 206 59 20 238 134 212 208 245 39 53 188 37 11 56 167 140 99 157 23 163 8 165 171 176 251 205 106 98 130 76 213 33 218 27 217 241 227 132 59 138 42 79 133 91 144 1 79 201 167 118 16 127 39 3 124 190 174 126 125 193 221 249 5 188 27 72 156 105 231 192 164 60 60 65 0 62 223 150 229 197 228 148 113 214 85 1 199 0 38 74 64 60 181 161 38 169 12 167 109 128 142 144 37 123 207 191 63 28 235 47 150 250 229 135 119 198 181 86 178 122 59 84 48 83 27 223 98 52 255 30 209 244 90 147 40 133 229 76 23 78 126 91 253 164 147 153 127 223 205 239 164 117 239 239 21 246 71 231 248 25 114 216 46 52 26 166 180 167 76 126 189 187 79 12 61 87 241 48 214 166 54 142 214 128 118 215 25 46 165 205 126 52 45 137 2 3 1 0 1 163 130 1 254 48 130 1 250 48 18 6 3 85 29 19 1 1 255 4 8 48 6 1 1 255 2 1 0 48 112 6 3 85 29 32 4 105 48 103 48 101 6 11 96 134 72 1 134 248 69 1 7 23 3 48 86 48 40 6 8 43 6 1 5 5 7 2 1 22 28 104 116 116 112 115 58 47 47 119 119 119 46 118 101 114 105 115 105 103 110 46 99 111 109 47 99 112 115 48 42 6 8 43 6 1 5 5 7 2 2 48 30 26 28 104 116 116 112 115 58 47 47 119 119 119 46 118 101 114 105 115 105 103 110 46 99 111 109 47 114 112 97 48 14 6 3 85 29 15 1 1 255 4 4 3 2 1 6 48 109 6 8 43 6 1 5 5 7 1 12 4 97 48 95 161 93 160 91 48 89 48 87 48 85 22 9 105 109 97 103 101 47 103 105 102 48 33 48 31 48 7 6 5 43 14 3 2 26 4 20 143 229 211 26 134 172 141 142 107 195 207 128 106 212 72 24 44 123 25 46 48 37 22 35 104 116 116 112 58 47 47 108 111 103 111 46 118 101 114 105 115 105 103 110 46 99 111 109 47 118 115 108 111 103 111 46 103 105 102 48 52 6 3 85 29 31 4 45 48 43 48 41 160 39 160 37 134 35 104 116 116 112 58 47 47 99 114 108 46 118 101 114 105 115 105 103 110 46 99 111 109 47 112 99 97 51 45 103 53 46 99 114 108 48 52 6 8 43 6 1 5 5 7 1 1 4 40 48 38 48 36 6 8 43 6 1 5 5 7 48 1 134 24 104 116 116 112 58 47 47 111 99 115 112 46 118 101 114 105 115 105 103 110 46 99 111 109 48 29 6 3 85 29 37 4 22 48 20 6 8 43 6 1 5 5 7 3 2 6 8 43 6 1 5 5 7 3 3 48 40 6 3 85 29 17 4 33 48 31 164 29 48 27 49 25 48 23 6 3 85 4 3 19 16 86 101 114 105 83 105 103 110 77 80 75 73 45 50 45 56 48 29 6 3 85 29 14 4 22 4 20 207 153 169 234 123 38 244 75 201 142 143 215 240 5 38 239 227 210 167 157 48 31 6 3 85 29 35 4 24 48 22 128 20 127 211 101 167 194 221 236 187 240 48 9 243 67 57 250 2 175 51 49 51 48 13 6 9 42 134 72 134 247 13 1 1 5 5 0 3 130 1 1 0 86 34 230 52 164 196 97 203 72 185 1 173 86 168 100 15 217 140 145 196 187 204 12 229 173 122 160 34 127 223 71 56 74 45 108 209 127 113 26 124 236 112 169 177 240 79 228 15 12 83 250 21 94 254 116 152 73 36 133 129 38 28 145 20 71 176 76 99 140 187 161 52 212 198 69 232 13 133 38 115 3 208 169 140 100 109 220 113 146 230 69 5 96 21 89 81 57 252 88 20 107 254 212 164 237 121 107 8 12 65 114 231 55 34 6 9 190 35 233 63 68 154 30 233 97 157 204 177 144 92 252 61 210 141 172 66 61 101 54 212 180 61 64 40 143 155 16 207 35 38 204 75 32 203 144 31 93 140 76 52 202 60 216 229 55 214 111 165 32 189 52 235 38 217 174 13 231 197 154 247 161 180 33 145 51 111 134 232 88 187 37 124 116 14 88 254 117 27 99 63 206 49 124 155 143 27 150 158 197 83 118 132 91 156 173 145 250 172 237 147 186 93 200 33 83 194 130 83 99 175 18 13 80 135 17 27 61 84 82 150 138 44 156 61 146 26 8 154 5 46 199 147 165 72 145 211 49 130 4 155 48 130 4 151 2 1 1 48 129 201 48 129 180 49 11 48 9 6 3 85 4 6 19 2 85 83 49 23 48 21 6 3 85 4 10 19 14 86 101 114 105 83 105 103 110 44 32 73 110 99 46 49 31 48 29 6 3 85 4 11 19 22 86 101 114 105 83 105 103 110 32 84 114 117 115 116 32 78 101 116 119 111 114 107 49 59 48 57 6 3 85 4 11 19 50 84 101 114 109 115 32 111 102 32 117 115 101 32 97 116 32 104 116 116 112 115 58 47 47 119 119 119 46 118 101 114 105 115 105 103 110 46 99 111 109 47 114 112 97 32 40 99 41 49 48 49 46 48 44 6 3 85 4 3 19 37 86 101 114 105 83 105 103 110 32 67 108 97 115 115 32 51 32 67 111 100 101 32 83 105 103 110 105 110 103 32 50 48 49 48 32 67 65 2 16 116 37 83 173 7 228 175 209 21 4 175 152 77 73 237 104 48 9 6 5 43 14 3 2 26 5 0 160 129 152 48 20 6 9 43 6 1 4 1 130 55 40 1 49 7 3 5 0 3 0 0 0 48 25 6 9 42 134 72 134 247 13 1 9 3 49 12 6 10 43 6 1 4 1 130 55 2 1 4 48 28 6 10 43 6 1 4 1 130 55 2 1 11 49 14 48 12 6 10 43 6 1 4 1 130 55 2 1 21 48 34 6 10 43 6 1 4 1 130 55 2 1 12 49 20 48 18 161 16 128 14 119 119 119 46 97 100 111 98 101 46 99 111 109 32 48 35 6 9 42 134 72 134 247 13 1 9 4 49 22 4 20 57 92 28 252 60 84 58 38 241 171 91 25 239 3 40 3 55 167 213 65 48 13 6 9 42 134 72 134 247 13 1 1 1 5 0 4 130 1 0 14 66 218 192 18 10 120 88 19 44 82 169 6 139 217 84 89 18 216 168 25 185 123 64 155 27 101 197 92 241 52 14 57 230 204 14 177 23 107 250 17 78 159 171 120 46 114 35 145 154 3 132 72 110 34 182 130 177 34 79 84 69 67 160 4 203 235 15 98 231 145 148 20 81 95 186 42 199 1 220 168 212 169 58 195 246 207 36 109 160 40 20 93 115 92 147 70 19 26 240 10 137 244 190 130 42 174 209 162 79 96 227 133 248 4 137 209 163 169 166 58 92 80 100 103 47 65 150 101 221 94 40 118 49 36 32 251 190 96 147 218 166 173 24 166 116 5 59 237 244 31 147 238 112 163 19 131 33 216 177 180 29 152 102 62 60 81 7 199 173 107 223 219 150 181 255 92 231 0 251 94 154 48 53 41 83 7 127 26 99 133 90 167 30 231 222 183 88 237 246 86 126 33 245 1 211 96 107 223 106 40 64 171 224 90 241 240 210 90 166 204 147 24 130 116 212 195 54 7 212 67 255 23 217 199 122 28 113 198 151 154 80 251 206 39 233 33 209 153 154 137 184 225 85 94 99 161 130 2 11 48 130 2 7 6 9 42 134 72 134 247 13 1 9 6 49 130 1 248 48 130 1 244 2 1 1 48 114 48 94 49 11 48 9 6 3 85 4 6 19 2 85 83 49 29 48 27 6 3 85 4 10 19 20 83 121 109 97 110 116 101 99 32 67 111 114 112 111 114 97 116 105 111 110 49 48 48 46 6 3 85 4 3 19 39 83 121 109 97 110 116 101 99 32 84 105 109 101 32 83 116 97 109 112 105 110 103 32 83 101 114 118 105 99 101 115 32 67 65 32 45 32 71 50 2 16 14 207 244 56 200 254 191 53 110 4 216 106 152 27 26 80 48 9 6 5 43 14 3 2 26 5 0 160 93 48 24 6 9 42 134 72 134 247 13 1 9 3 49 11 6 9 42 134 72 134 247 13 1 7 1 48 28 6 9 42 134 72 134 247 13 1 9 5 49 15 23 13 49 51 48 49 49 49 49 57 50 53 53 57 90 48 35 6 9 42 134 72 134 247 13 1 9 4 49 22 4 20 112 141 209 226 152 174 39 75 248 25 139 153 73 75 216 39 37 197 109 57 48 13 6 9 42 134 72 134 247 13 1 1 1 5 0 4 130 1 0 24 154 16 174 148 240 53 183 57 132 123 57 109 200 171 206 135 250 94 50 68 179 14 112 200 146 191 38 149 206 141 140 38 148 4 186 163 157 138 189 250 135 139 38 83 250 166 27 216 134 51 225 62 148 150 43 214 180 223 170 248 214 109 55 15 3 236 81 96 3 147 235 35 170 255 31 15 193 89 43 25 97 64 142 198 61 160 238 90 50 11 80 79 110 195 224 52 222 145 52 133 140 43 213 173 101 100 97 4 238 200 151 47 78 245 216 228 24 124 23 123 191 47 75 98 105 79 70 116 135 102 223 239 102 88 11 28 71 6 15 90 153 109 185 136 218 16 181 69 227 141 71 37 32 30 83 90 225 146 125 175 225 131 13 85 252 217 56 10 91 252 103 159 53 243 34 191 98 60 226 75 145 122 223 181 37 19 179 184 18 70 148 129 252 102 225 16 91 117 155 177 62 44 71 121 211 181 185 231 55 33 86 189 94 114 88 201 254 233 208 9 77 104 186 207 252 59 109 154 254 221 59 241 201 0 0 111 242 204 157 88 187 125 56 118 0 101 229 164 86 111 87 168 125 98 189]! !

!SourceCodeProRegular class methodsFor: 'class initialization' stamp: 'JurajKubelka 8/23/2014 15:50'!
initialize 
	EmbeddedFreeTypeFontInstaller registerFont: self! !

!SourceCodeProRegular class methodsFor: 'accessing' stamp: 'IgorStasenko 4/8/2014 16:49'!
originalFileName
	^ 'SourceCodePro-Regular.ttf'! !

!SourceFileArray commentStamp: '<historical>'!
This is a variation on StandardSourceFileArray that provides a larger maximum changes file size.

The available address space for source pointers in a traditional CompiledMethod is 16r1000000 through 16r4FFFFFF. StandardSourceFileArray maps positions in the sources file to address range 16r1000000 through 16r1FFFFFF and 16r3000000 through 16r3FFFFFF, and positions in the changes file to address range 16r2000000 through 16r2FFFFFF and 16r4000000 through 16r4FFFFFF. This permits a maximum file size of 16r2000000 (32MB) for both the sources file and the changes file. 

This implementation extends the source pointer address space using bit 25 of the source pointer to identify the external sources and changes files, with the remaining high order bits treated as address extension. This limits the number of external file references to two (the traditional sources and changes files). If additional external file references are needed in the future, some higher order bits in the source pointer address space should be allocated for that purpose.

The use of bit 25 of the source pointer for file references permits backward compatibility with StandardSourceFileArray, with essentially unlimited address space expansion for the sources and changes files.
!
!SourceFileArray methodsFor: 'source code management' stamp: 'VeronicaUquillas 8/2/2011 11:12'!
protocolAt: sourcePointer
	"Answer the protocol for a given method, retrieved from the sources or changes file. Answer unfound protocol if no protocol is available"
				
	^ self protocolAt: sourcePointer for: self sourceDataPointers! !

!SourceFileArray methodsFor: 'file system' stamp: 'MartinDias 11/4/2013 17:27'!
ensureOpen
	"Ensure that the source and changes files are opened."

	files :=
		Array
			with: PharoFilesOpener default sourcesFileOrNil
			with: PharoFilesOpener default changesFileOrNil! !

!SourceFileArray methodsFor: 'accessing' stamp: 'MarcusDenker 5/3/2012 13:28'!
size
	^files size! !

!SourceFileArray methodsFor: 'source code management' stamp: 'MartinDias 11/6/2013 17:14'!
changeRecordsFor: aMethodDefinition do: aUnaryBlock
	"Evaluate aUnaryBlock with each of the ChangeRecords of aMethodDefinition. Most recent changes are evaluated first."

	| method |
	method := aMethodDefinition actualClass 
		compiledMethodAt: aMethodDefinition selector
		ifAbsent: [ ^ self ].

	self 
		changeRecordsFrom: method sourcePointer 
		className: aMethodDefinition theNonMetaClassName
		isMeta: aMethodDefinition classIsMeta
		do: aUnaryBlock! !

!SourceFileArray methodsFor: 'file system' stamp: 'MartinDias 11/13/2013 15:40'!
close
	"Shut down the source files if appropriate. Closing and nilification only takes place if the entry was a FileStream, thus allowing stringified sources to remain in the saved image file. 
	MartinDias, 13-11-2013: Copied from SmalltalkImage>>closeSourceFiles, no idea if isKindOf: is needed."

	1 to: files size do: [ :index |
		((files at: index) isKindOf: FileStream)
			ifTrue: [
				(files at: index) close.
				files at: index put: nil ] ]! !

!SourceFileArray methodsFor: 'accessing' stamp: 'MartinDias 10/23/2013 18:20'!
readOnlyDo: aBlock
	| sourceFilesCopy |
	"get a read only copy of each file"
	sourceFilesCopy := self collect: [:aFile | aFile ifNotNil: [ aFile readOnlyCopy ] ].

	[ aBlock value: sourceFilesCopy ] ensure: [
		"close the files"
		sourceFilesCopy do: [ :aFile | aFile ifNotNil: [ aFile close ] ] ]! !

!SourceFileArray methodsFor: 'initialize-release' stamp: 'MarcusDenker 5/3/2012 13:28'!
initialize: nFiles
	files := Array new: nFiles! !

!SourceFileArray methodsFor: 'source code management' stamp: 'MarcusDenker 6/11/2013 14:40'!
protocolAt: sourcePointer for: sourceDataPointers
	"Answer the protocol for a given method, retrieved from the sources or changes file. Answer unfound protocol if no protocol is available."	
				
	| preamble protocol tokens protocolPosition |
	protocol := 'unfound protocol'.
	"this is to indicate that the tagging in the source does not use the correct format.
	We will have to fix that. For example some traits methods are wrongly tagged.
	see http://code.google.com/p/pharo/issues/detail?id=4581"
	preamble := self sourcedDataAt: sourcePointer.	
	preamble = 'Trait method' ifTrue: [ ^nil ].
	(preamble includesSubstring: (sourceDataPointers key))
			ifTrue: [ tokens := preamble parseLiterals.
				     	protocolPosition := tokens indexOf: sourceDataPointers key.
					protocolPosition = 0
						ifFalse: [
							"New format gives change protocol and unified prior pointer"
							protocol := tokens at: protocolPosition + 1] ].
 	^protocol! !

!SourceFileArray methodsFor: 'source code management' stamp: 'MarcusDenker 6/11/2013 14:40'!
timeStampAt: sourcePointer for: sourceDataPointers
	"Answer the authoring time-stamp for the given method, retrieved from the sources or changes file. Answer the empty string if no time stamp is available."		
				
	| preamble stamp tokens stampPosition |
	stamp := ''.
	preamble := self sourcedDataAt: sourcePointer.
	(preamble includesSubstring: sourceDataPointers key)
			ifTrue: [ tokens := preamble parseLiterals.
				     	stampPosition := tokens indexOf: sourceDataPointers value.
					stampPosition = 0
						ifFalse: [
							"New format gives change stamp and unified prior pointer"
							stamp := tokens at: stampPosition + 1]].
 	^stamp! !

!SourceFileArray methodsFor: 'initialization' stamp: 'MarcusDenker 5/3/2012 13:27'!
initialize
	files := Array new: 2.
	files at: 1 put: (SourceFiles at: 1).
	files at: 2 put: (SourceFiles at: 2)! !

!SourceFileArray methodsFor: 'accessing' stamp: 'MarcusDenker 5/3/2012 13:27'!
at: index put: aFile
	^ files at: index put: aFile! !

!SourceFileArray methodsFor: 'accessing' stamp: 'MarcusDenker 5/3/2012 13:27'!
at: index
	^files at: index! !

!SourceFileArray methodsFor: 'source code management' stamp: 'MartinDias 10/28/2013 15:13'!
getPreambleFrom: aFileStream at: position

	|  writeStream |
	writeStream := String new writeStream.
	position to: 0 by: -1 do: [ :p | 
			| c | 
			aFileStream position: p.
			c := aFileStream basicNext.
			c == $!!
				ifTrue: [^ writeStream contents reversed]
				ifFalse: [writeStream nextPut: c]]! !

!SourceFileArray methodsFor: 'source code management' stamp: 'MarcusDenker 10/7/2013 13:03'!
sourcedDataAt: sourcePointer

	| index position file preamble |
	index:= self fileIndexFromSourcePointer: sourcePointer.
	index = 0 ifTrue: [ ^'' ].  "no source pointer for this element"
	position := self filePositionFromSourcePointer: sourcePointer.
	file := self at: index.
	file ifNil: [ ^'' ].  "sources file not available"
	"file does not exist happens in secure mode"
	file := [file readOnlyCopy] 
			on: FileDoesNotExistException 
			do:[:ex| ^'' ].
	self flag: 'I do not know why 3 is a good number'.
	preamble :=  self getPreambleFrom: file at: (0 max: position - 3).
	file close.
	^preamble! !

!SourceFileArray methodsFor: 'source code management' stamp: 'StephaneDucasse 8/1/2011 19:37'!
timeStampAt: sourcePointer 
	"Answer the authoring time-stamp for the given method, retrieved from the sources or changes file. Answer the empty string if no time stamp is available."		
				
	^ self timeStampAt: sourcePointer for: self  sourceDataPointers ! !

!SourceFileArray methodsFor: 'source code management' stamp: 'MartinDias 11/6/2013 17:14'!
changeRecordsFor: aMethodDefinition detect: aUnaryBlock
	"Try to detect the most recent ChangeRecord that satisfies aUnaryBlock. Answer nil if none satisfies."

	self
		changeRecordsFor: aMethodDefinition
		do: [ :changeRecord | 
			(aUnaryBlock value: changeRecord category) 
				ifTrue: [ ^ changeRecord ] ].
	^ nil! !

!SourceFileArray methodsFor: 'sourcepointer conversion' stamp: 'MarcusDenker 5/3/2012 13:28'!
filePositionFromSourcePointer: anInteger 
	"Return the position of the source chunk addressed by anInteger"

	| hi lo |
	hi := anInteger // 33554432.
	lo := anInteger \\ 16777216.
	((anInteger bitAnd: 16777216) ~= 0
			or: [anInteger < 16777216 "compatibility with StandardSourceFileArray"])
		ifTrue: [^ hi * 16777216 + lo"sources file"]
		ifFalse: [^ hi - 1 * 16777216 + lo"changes file"]! !

!SourceFileArray methodsFor: 'sourcepointer conversion' stamp: 'MarcusDenker 5/3/2012 13:28'!
fileIndexFromSourcePointer: anInteger
	"Return the index of the source file which contains the source chunk addressed by anInteger"

	(anInteger bitAnd: 16r1000000) ~= 0
		ifTrue: [^1 "sources file"]
		ifFalse: [anInteger >= 16r1000000
			ifTrue: [^2 "changes file"]
			ifFalse: [^0 "compatibility with StandardSourceFileArray"]]! !

!SourceFileArray methodsFor: 'source code management' stamp: 'StephaneDucasse 8/1/2011 19:34'!
sourceCodeAt: sourcePointer 
	"Retrieves the source code for the pointer received as argument"
	
	| fileIndex filePosition |
	filePosition := self filePositionFromSourcePointer: sourcePointer.
	^filePosition = 0
		ifTrue: [ '' ]
		ifFalse:[ fileIndex := self fileIndexFromSourcePointer: sourcePointer.
				(RemoteString newFileNumber: fileIndex position: filePosition) string ]! !

!SourceFileArray methodsFor: 'sourcepointer conversion' stamp: 'MarcusDenker 5/3/2012 13:29'!
sourcePointerFromFileIndex: index andPosition: position
	"Return a sourcePointer encoding the given file index and position"

	| hi lo |
	(index = 1 or: [index = 2])
		ifFalse: [self error: 'invalid source file index'].
	position < 0 ifTrue: [self error: 'invalid source code pointer'].
	hi := position // 16r1000000 *2 + index.
	lo := position \\ 16r1000000.
	^ hi * 16r1000000 + lo
! !

!SourceFileArray methodsFor: 'source code management' stamp: 'NicolaiHess 12/21/2014 18:38'!
changeRecordsFrom: initialSourcePointer className: theNonMetaClassName isMeta: classIsMeta do: aUnaryBlock
	"Evaluate aUnaryBlock with each of the ChangeRecords of a method or class comment, starting from the initialSourcePointer. 
	Most recent changes are evaluated first."

	| filePosition fileIndex |
	fileIndex := self fileIndexFromSourcePointer: initialSourcePointer.
	filePosition := self filePositionFromSourcePointer: initialSourcePointer.	

	self readOnlyDo: [ :sourceFilesCopy | 
		| file previousFilePosition previousFileIndex preamble stamp protocol preambleTokens |
		file := sourceFilesCopy 
			at: fileIndex 
			ifAbsent: [ ^ self ].
		
		[ filePosition notNil & file notNil ]
			whileTrue: [ 
				file position: (0 max: filePosition - 150).	"Skip back to before the preamble"
				[ file position < (filePosition - 1) ] whileTrue: [ preamble := file nextChunk ].	"then pick it up from the front"	
					"Preamble is likely a linked method preamble, if we're in
					a changes file (not the sources file).  Try to parse it
					for prior source position and file index"

				previousFilePosition := nil.
				stamp := ''.
				"method records"
				(preamble includesSubstring: 'methodsFor:')
					ifTrue: [ preambleTokens := preamble parseLiterals ]
					ifFalse: [ preambleTokens := Array new	"ie cant be back ref" ].
				((preambleTokens size between: 7 and: 8) and: [ (preambleTokens at: preambleTokens size - 5) = #methodsFor: ])
					ifTrue: [ 
						(preambleTokens at: preambleTokens size - 3) = #stamp:
							ifTrue: [ 
								"New format gives change stamp and unified prior pointer"
								stamp := preambleTokens at: preambleTokens size - 2.
								previousFilePosition := preambleTokens last.
								previousFileIndex := self fileIndexFromSourcePointer: previousFilePosition.
								previousFilePosition := self filePositionFromSourcePointer: previousFilePosition ]
							ifFalse: [ 
								"Old format gives no stamp; prior pointer in two parts"
								previousFilePosition := preambleTokens at: preambleTokens size - 2.
								previousFileIndex := preambleTokens last ].
						(previousFilePosition = 0 or: [ previousFileIndex = 0 ])
							ifTrue: [ previousFilePosition := nil ] ].

				((preambleTokens size between: 5 and: 6) and: [ (preambleTokens at: preambleTokens size - 3) = #methodsFor: ])
					ifTrue: [ 
						(preambleTokens at: preambleTokens size - 1) = #stamp:
							ifTrue: [ 
								"New format gives change stamp and unified prior pointer"
								stamp := preambleTokens at: preambleTokens size ] ].
				"class comment records"
				(preamble includesSubstring: 'commentStamp:')
					ifTrue: [ preambleTokens := preamble parseLiterals ].
				((preambleTokens size = 5 or: [ preambleTokens size = 3 ]) and: [ (preambleTokens at: 2) = #commentStamp: ])
					ifTrue: [ 
						stamp := preambleTokens at: 3.
						preambleTokens size > 3
							ifTrue: [ 
								previousFilePosition := preambleTokens last.
								previousFileIndex := self fileIndexFromSourcePointer: previousFilePosition.
								previousFilePosition := self filePositionFromSourcePointer: previousFilePosition ].
						aUnaryBlock
							value:
								(ChangeRecord new
									file: file
									position: filePosition
									type: #classComment
									class: theNonMetaClassName
									category: nil
									meta: classIsMeta
									stamp: stamp) ]
					ifFalse: [ 
						protocol := preambleTokens after: #methodsFor: ifAbsent: [ Protocol unclassified ].
						aUnaryBlock
							value:
								(ChangeRecord new
									file: file
									position: filePosition
									type: #method
									class: theNonMetaClassName
									category: protocol
									meta: classIsMeta
									stamp: stamp) ].
									
				filePosition := previousFilePosition.
				previousFilePosition ifNotNil: [ 
					file := sourceFilesCopy 
						at: previousFileIndex
						ifAbsent: [  ^ self ] ] ] ]! !

!SourceFileArray methodsFor: 'private' stamp: 'StephaneDucasse 8/1/2011 21:45'!
sourceDataPointers
	"Retrieves the combination key to look for information of the receiver in the source file"
	"'Point methodsFor: ''point functions'' stamp: ''lr 7/4/2009 10:42'''."
	
	^'methodsFor:' -> #stamp:! !

!SourceFileArray class methodsFor: 'instance creation' stamp: 'MarcusDenker 5/3/2012 13:30'!
new: nFiles
	^self new initialize: nFiles.! !

!SourceFileArray class methodsFor: 'initialize-release' stamp: 'MarcusDenker 5/3/2012 13:30'!
install
	"Replace SourceFiles by an instance of me with the standard sources and changes files.
	This only works if SourceFiles is either an Array or an instance of this class"

	"SourceFileArray install"

	^ SourceFiles := self new! !

!SourceFileArrayTest commentStamp: 'dtl 12/22/2009 23:10'!
This test documents the source pointer address conversion methods for ExpandedSourceFileArray.

The available address space for source pointers in a traditional CompiledMethod is 16r1000000 through 16r4FFFFFF. StandardSourceFileArray maps positions in the sources file to address range 16r1000000 through 16r1FFFFFF and 16r3000000 through 16r3FFFFFF, and positions in the changes file to address range 16r2000000 through 16r2FFFFFF and 16r4000000 through 16r4FFFFFF. This permits a maximum file size of 16r2000000 (32MB) for both the sources file and the changes file. 

ExpandedSourceFileArray extends the source pointer address space using bit 25 of the source pointer to identify the external sources and changes files, with the remaining high order bits treated as address extension. This limits the number of external file references to two (the traditional sources and changes files). If additional external file references are needed in the future, some higher order bits in the source pointer address space should be allocated for that purpose.

The use of bit 25 of the source pointer for file references permits backward compatibility with StandardSourceFileArray, with essentially unlimited address space expansion for the sources and changes files.
!
!SourceFileArrayTest methodsFor: 'testing' stamp: 'MarcusDenker 5/3/2012 13:57'!
testChangesFileAddressRange
	"Test file position to source pointer address translation for the changes file"
	
	| sf i p a a2 |
	sf := SourceFileArray new.
	0 to: 16r1FFFFFFF by: 4093 do: [:e |
		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
		i := sf fileIndexFromSourcePointer: a.
		self assert: i = 2.
		p := sf filePositionFromSourcePointer: a.
		self assert: p = e.
		a2 := sf sourcePointerFromFileIndex: 2 andPosition: p.
		self assert: a2 = a].
	0 to: 16rFFFFFF by: 811 do: [:e |
		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
		self assert: (a between: 16r2000000 and: 16r2FFFFFF)].
	16r1000000 to: 16r1FFFFFF by: 811 do: [:e |
		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
		self assert: (a between: 16r4000000 and: 16r4FFFFFF)].
	16r2000000 to: 16r2FFFFFF by: 811 do: [:e |
		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
		self assert: (a between: 16r6000000 and: 16r6FFFFFF)].
	16r3000000 to: 16r3FFFFFF by: 811 do: [:e |
		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
		self assert: (a between: 16r8000000 and: 16r8FFFFFF)].
	16r4000000 to: 16r4FFFFFF by: 811 do: [:e |
		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
		self assert: (a between: 16rA000000 and: 16rAFFFFFF)].
	16r5000000 to: 16r5FFFFFF by: 811 do: [:e |
		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
		self assert: (a between: 16rC000000 and: 16rCFFFFFF)].
	16r6000000 to: 16r6FFFFFF by: 811 do: [:e |
		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
		self assert: (a between: 16rE000000 and: 16rEFFFFFF)].
	16r7000000 to: 16r7FFFFFF by: 811 do: [:e |
		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
		self assert: (a between: 16r10000000 and: 16r10FFFFFF)]



! !

!SourceFileArrayTest methodsFor: 'testing' stamp: 'ST 6/18/2013 21:48'!
testProtocol
	"Test that we can access protocol correctly"
	"self debug: #testProtocol"

	| okCm notOkCm |
	okCm := Point>>#dist: .
	self assert: (SourceFiles sourcedDataAt: okCm sourcePointer) =   'Point methodsFor: ''point functions'' stamp: ''lr 7/4/2009 10:42'''.
	self assert: (SourceFiles protocolAt: okCm sourcePointer) = 'point functions'.
	
	notOkCm := Behavior >> #superclass.
	self assert: (SourceFiles protocolAt: notOkCm sourcePointer) =  'accessing class hierarchy'.
	! !

!SourceFileArrayTest methodsFor: 'testing' stamp: 'MarcusDenker 5/3/2012 13:57'!
testFileIndexFromSourcePointer
	"Test derivation of file index for sources or changes file from source pointers"

	| sf |
	sf := SourceFileArray new.
	"sources file mapping"
	self assert: 1 = (sf fileIndexFromSourcePointer: 16r1000000).
	self assert: 1 = (sf fileIndexFromSourcePointer: 16r1000013).
	self assert: 1 = (sf fileIndexFromSourcePointer: 16r1FFFFFF).
	self assert: 1 = (sf fileIndexFromSourcePointer: 16r3000000).
	self assert: 1 = (sf fileIndexFromSourcePointer: 16r3000013).
	self assert: 1 = (sf fileIndexFromSourcePointer: 16r3FFFFFF).

	self assert: 1 = (sf fileIndexFromSourcePointer: 16r5000000).
	self assert: 1 = (sf fileIndexFromSourcePointer: 16r5000013).
	self assert: 1 = (sf fileIndexFromSourcePointer: 16r5FFFFFF).

	(16r1000000 to: 16r1FFFFFF by: 811) do: [:e | self assert: 1 = (sf fileIndexFromSourcePointer: e)].
	(16r3000000 to: 16r3FFFFFF by: 811) do: [:e | self assert: 1 = (sf fileIndexFromSourcePointer: e)].
	"changes file mapping"
	self assert: 2 = (sf fileIndexFromSourcePointer: 16r2000000).
	self assert: 2 = (sf fileIndexFromSourcePointer: 16r2000013).
	self assert: 2 = (sf fileIndexFromSourcePointer: 16r2FFFFFF).
	self assert: 2 = (sf fileIndexFromSourcePointer: 16r4000000).
	self assert: 2 = (sf fileIndexFromSourcePointer: 16r4000013).
	self assert: 2 = (sf fileIndexFromSourcePointer: 16r4FFFFFF).

	self assert: 2 = (sf fileIndexFromSourcePointer: 16r6000000).
	self assert: 2 = (sf fileIndexFromSourcePointer: 16r6000013).
	self assert: 2 = (sf fileIndexFromSourcePointer: 16r6FFFFFF).

	(16r2000000 to: 16r2FFFFFF by: 811) do: [:e | self assert: 2 = (sf fileIndexFromSourcePointer: e)].
	(16r4000000 to: 16r4FFFFFF by: 811) do: [:e | self assert: 2 = (sf fileIndexFromSourcePointer: e)].

	"the following numeric ranges are unused but currently produces results as follows"
	self assert: 0 = (sf fileIndexFromSourcePointer: 16r0000000).
	self assert: 0 = (sf fileIndexFromSourcePointer: 16r0000013).
	self assert: 0 = (sf fileIndexFromSourcePointer: 16r0FFFFFF)

! !

!SourceFileArrayTest methodsFor: 'testing' stamp: 'MarcusDenker 3/4/2013 16:24'!
testTimeStamp
	"Test that we can access timeStamp correctly"
	"self debug: #testTimeStamp"

	| okCm notOkCm |
	okCm := Point>>#dist: .
	self assert: (SourceFiles sourcedDataAt: okCm sourcePointer) =   'Point methodsFor: ''point functions'' stamp: ''lr 7/4/2009 10:42'''.
	self assert: (SourceFiles timeStampAt: okCm sourcePointer) = 'lr 7/4/2009 10:42'.
	
	notOkCm := Behavior >> #supermostPrecodeCommentFor:.
	self assert: (SourceFiles timeStampAt: notOkCm sourcePointer) = ''.
	! !

!SourceFileArrayTest methodsFor: 'testing' stamp: 'MarcusDenker 5/3/2012 13:57'!
testAddressRange
	"Test source pointer to file position address translation across a wide address range"
	
	| sf i p a |
	sf := SourceFileArray new.
	16r1000000 to: 16r10000000 by: 4093 do: [:e |
		i := sf fileIndexFromSourcePointer: e.
		p := sf filePositionFromSourcePointer: e.
		a := sf sourcePointerFromFileIndex: i andPosition: p.
		self assert: a = e]
! !

!SourceFileArrayTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testSourcePointerFromFileIndexAndPosition
	"Test valid input ranges"

	| sf |
	sf := SourceFileArray new.
	self should: [ sf sourcePointerFromFileIndex: 0 andPosition: 0 ] raise: Error.
	sf sourcePointerFromFileIndex: 1 andPosition: 0.
	sf sourcePointerFromFileIndex: 2 andPosition: 0.
	self should: [ sf sourcePointerFromFileIndex: 0 andPosition: 3 ] raise: Error.
	self should: [ sf sourcePointerFromFileIndex: 1 andPosition: -1 ] raise: Error.
	sf sourcePointerFromFileIndex: 1 andPosition: 16r1FFFFFF.
	sf sourcePointerFromFileIndex: 1 andPosition: 16r2000000.
	self should: [ sf sourcePointerFromFileIndex: 3 andPosition: 0 ] raise: Error.
	self should: [ sf sourcePointerFromFileIndex: 4 andPosition: 0 ] raise: Error.
	self assert: 16r1000000 = (sf sourcePointerFromFileIndex: 1 andPosition: 0).
	self assert: 16r1000013 = (sf sourcePointerFromFileIndex: 1 andPosition: 16r13).
	self assert: 16r1FFFFFF = (sf sourcePointerFromFileIndex: 1 andPosition: 16rFFFFFF).
	self assert: 16r2000000 = (sf sourcePointerFromFileIndex: 2 andPosition: 0).
	self assert: 16r2000013 = (sf sourcePointerFromFileIndex: 2 andPosition: 16r13).
	self assert: 16r2FFFFFF = (sf sourcePointerFromFileIndex: 2 andPosition: 16rFFFFFF).
	self assert: 16r3000000 = (sf sourcePointerFromFileIndex: 1 andPosition: 16r1000000).
	self assert: 16r3000013 = (sf sourcePointerFromFileIndex: 1 andPosition: 16r1000013).
	self assert: 16r3FFFFFF = (sf sourcePointerFromFileIndex: 1 andPosition: 16r1FFFFFF).
	self assert: 16r4000000 = (sf sourcePointerFromFileIndex: 2 andPosition: 16r1000000).
	self assert: 16r4000013 = (sf sourcePointerFromFileIndex: 2 andPosition: 16r1000013).
	self assert: 16r4FFFFFF = (sf sourcePointerFromFileIndex: 2 andPosition: 16r1FFFFFF)! !

!SourceFileArrayTest methodsFor: 'testing' stamp: 'MarcusDenker 5/3/2012 13:57'!
testSourcesFileAddressRange
	"Test file position to source pointer address translation for the sources file"
	
	| sf i p a a2 |
	sf := SourceFileArray new.
	0 to: 16r1FFFFFFF by: 4093 do: [:e |
		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
		i := sf fileIndexFromSourcePointer: a.
		self assert: i = 1.
		p := sf filePositionFromSourcePointer: a.
		self assert: p = e.
		a2 := sf sourcePointerFromFileIndex: 1 andPosition: p.
		self assert: a2 = a].
	0 to: 16rFFFFFF by: 811 do: [:e |
		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
		self assert: (a between: 16r1000000 and: 16r1FFFFFF)].
	16r1000000 to: 16r1FFFFFF by: 811 do: [:e |
		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
		self assert: (a between: 16r3000000 and: 16r3FFFFFF)].

	16r2000000 to: 16r2FFFFFF by: 811 do: [:e |
		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
		self assert: (a between: 16r5000000 and: 16r5FFFFFF)].
	16r3000000 to: 16r3FFFFFF by: 811 do: [:e |
		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
		self assert: (a between: 16r7000000 and: 16r7FFFFFF)].
	16r4000000 to: 16r4FFFFFF by: 811 do: [:e |
		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
		self assert: (a between: 16r9000000 and: 16r9FFFFFF)].
	16r5000000 to: 16r5FFFFFF by: 811 do: [:e |
		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
		self assert: (a between: 16rB000000 and: 16rBFFFFFF)].
	16r6000000 to: 16r6FFFFFF by: 811 do: [:e |
		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
		self assert: (a between: 16rD000000 and: 16rDFFFFFF)].
	16r7000000 to: 16r7FFFFFF by: 811 do: [:e |
		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
		self assert: (a between: 16rF000000 and: 16rFFFFFFF)]
! !

!SourceFileArrayTest methodsFor: 'testing' stamp: 'MarcusDenker 5/3/2012 13:57'!
testFilePositionFromSourcePointer
	"Test derivation of file position for sources or changes file from source pointers"

	| sf |
	sf := SourceFileArray new.
	"sources file"
	self assert: 0 = (sf filePositionFromSourcePointer: 16r1000000).
	self assert: 16r13 = (sf filePositionFromSourcePointer: 16r1000013).
	self assert: 16rFFFFFF = (sf filePositionFromSourcePointer: 16r1FFFFFF).
	self assert: 16r1000000 = (sf filePositionFromSourcePointer: 16r3000000).
	self assert: 16r1000013 = (sf filePositionFromSourcePointer: 16r3000013).
	self assert: 16r1FFFFFF = (sf filePositionFromSourcePointer: 16r3FFFFFF).
	"changes file"
	self assert: 0 = (sf filePositionFromSourcePointer: 16r2000000).
	self assert: 16r13 = (sf filePositionFromSourcePointer: 16r2000013).
	self assert: 16rFFFFFF = (sf filePositionFromSourcePointer: 16r2FFFFFF).
	self assert: 16r1000000 = (sf filePositionFromSourcePointer: 16r4000000).
	self assert: 16r1000013 = (sf filePositionFromSourcePointer: 16r4000013).
	self assert: 16r1FFFFFF = (sf filePositionFromSourcePointer: 16r4FFFFFF).
	"the following numeric ranges are unused but currently produces results as follows"
	self assert: 0 = (sf filePositionFromSourcePointer: 16r0000000).
	self assert: 16r13 = (sf filePositionFromSourcePointer: 16r0000013).
	self assert: 16rFFFFFF = (sf filePositionFromSourcePointer: 16r0FFFFFF)
! !

!SourceMethodConverter commentStamp: '<historical>'!
A SourceMessageConverter is a wrapper wich display the source code of the provided message!
!SourceMethodConverter methodsFor: 'private' stamp: ''!
internalGetText

	^ method sourceCode! !

!SourceMethodConverter methodsFor: 'initialization' stamp: ''!
shouldShout

	^ true.! !

!SourceSansProRegular commentStamp: 'EstebanLorenzano 12/1/2014 14:54'!
http://sourceforge.net/projects/sourcesans.adobe/

Copyright 2010, 2012 Adobe Systems Incorporated (http://www.adobe.com/), with Reserved Font Name 'Source'. All Rights Reserved. Source is a trademark of Adobe Systems Incorporated in the United States and/or other countries.

This Font Software is licensed under the SIL Open Font License, Version 1.1.

This license is copied below, and is also available with a FAQ at: http://scripts.sil.org/OFL


-----------------------------------------------------------
SIL OPEN FONT LICENSE Version 1.1 - 26 February 2007
-----------------------------------------------------------

PREAMBLE
The goals of the Open Font License (OFL) are to stimulate worldwide
development of collaborative font projects, to support the font creation
efforts of academic and linguistic communities, and to provide a free and
open framework in which fonts may be shared and improved in partnership
with others.

The OFL allows the licensed fonts to be used, studied, modified and
redistributed freely as long as they are not sold by themselves. The
fonts, including any derivative works, can be bundled, embedded, 
redistributed and/or sold with any software provided that any reserved
names are not used by derivative works. The fonts and derivatives,
however, cannot be released under any other type of license. The
requirement for fonts to remain under this license does not apply
to any document created using the fonts or their derivatives.

DEFINITIONS
"Font Software" refers to the set of files released by the Copyright
Holder(s) under this license and clearly marked as such. This may
include source files, build scripts and documentation.

"Reserved Font Name" refers to any names specified as such after the
copyright statement(s).

"Original Version" refers to the collection of Font Software components as
distributed by the Copyright Holder(s).

"Modified Version" refers to any derivative made by adding to, deleting,
or substituting -- in part or in whole -- any of the components of the
Original Version, by changing formats or by porting the Font Software to a
new environment.

"Author" refers to any designer, engineer, programmer, technical
writer or other person who contributed to the Font Software.

PERMISSION & CONDITIONS
Permission is hereby granted, free of charge, to any person obtaining
a copy of the Font Software, to use, study, copy, merge, embed, modify,
redistribute, and sell modified and unmodified copies of the Font
Software, subject to the following conditions:

1) Neither the Font Software nor any of its individual components,
in Original or Modified Versions, may be sold by itself.

2) Original or Modified Versions of the Font Software may be bundled,
redistributed and/or sold with any software, provided that each copy
contains the above copyright notice and this license. These can be
included either as stand-alone text files, human-readable headers or
in the appropriate machine-readable metadata fields within text or
binary files as long as those fields can be easily viewed by the user.

3) No Modified Version of the Font Software may use the Reserved Font
Name(s) unless explicit written permission is granted by the corresponding
Copyright Holder. This restriction only applies to the primary font name as
presented to the users.

4) The name(s) of the Copyright Holder(s) or the Author(s) of the Font
Software shall not be used to promote, endorse or advertise any
Modified Version, except to acknowledge the contribution(s) of the
Copyright Holder(s) and the Author(s) or with their explicit written
permission.

5) The Font Software, modified or unmodified, in part or in whole,
must be distributed entirely under this license, and must not be
distributed under any other license. The requirement for fonts to
remain under this license does not apply to any document created
using the Font Software.

TERMINATION
This license becomes null and void if any of the above conditions are
not met.

DISCLAIMER
THE FONT SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT
OF COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL THE
COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL
DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
FROM, OUT OF THE USE OR INABILITY TO USE THE FONT SOFTWARE OR FROM
OTHER DEALINGS IN THE FONT SOFTWARE.
!
!SourceSansProRegular class methodsFor: 'accessing' stamp: 'EstebanLorenzano 12/1/2014 14:54'!
fontContents
	^#[0 1 0 0 0 19 1 0 0 4 0 48 66 65 83 69 139 25 148 177 0 2 41 64 0 0 0 58 68 83 73 71 177 23 225 234 0 2 41 124 0 0 32 88 71 68 69 70 88 132 89 247 0 1 192 64 0 0 1 40 71 80 79 83 14 157 190 227 0 1 193 104 0 0 76 42 71 83 85 66 126 148 155 223 0 2 13 148 0 0 27 172 79 83 47 50 90 180 148 91 0 0 1 184 0 0 0 96 99 109 97 112 110 23 68 69 0 0 19 132 0 0 10 40 99 118 116 32 13 153 0 250 0 0 31 108 0 0 0 40 102 112 103 109 6 89 156 55 0 0 29 172 0 0 1 115 103 97 115 112 255 255 0 3 0 1 192 56 0 0 0 8 103 108 121 102 233 113 161 67 0 0 40 76 0 1 50 212 104 101 97 100 254 20 179 226 0 0 1 60 0 0 0 54 104 104 101 97 7 163 7 11 0 0 1 116 0 0 0 36 104 109 116 120 191 168 172 255 0 0 2 24 0 0 17 108 108 111 99 97 185 54 7 102 0 0 31 148 0 0 8 184 109 97 120 112 6 117 2 64 0 0 1 152 0 0 0 32 110 97 109 101 157 24 237 18 0 1 91 32 0 0 60 178 112 111 115 116 223 235 189 176 0 1 151 212 0 0 40 98 112 114 101 112 150 4 250 235 0 0 31 32 0 0 0 75 0 1 0 0 0 1 12 204 166 237 33 15 95 15 60 245 0 9 3 232 0 0 0 0 205 151 128 165 0 0 0 0 205 151 227 22 255 64 254 189 4 136 3 184 0 0 0 9 0 2 0 0 0 0 0 0 0 1 0 0 3 216 254 239 0 0 4 170 255 64 255 22 4 136 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4 91 0 1 0 0 4 91 0 90 0 7 0 113 0 5 0 1 0 0 0 0 0 10 0 0 2 0 1 115 0 3 0 1 0 3 1 199 1 144 0 5 0 0 2 138 2 88 0 0 0 75 2 138 2 88 0 0 1 94 0 50 1 32 0 0 2 11 5 3 3 4 3 2 2 4 32 0 0 7 0 0 0 1 0 0 0 0 0 0 0 0 65 68 66 69 0 64 0 0 254 255 2 238 255 6 0 0 3 216 1 17 32 0 1 147 0 0 0 0 1 224 2 148 0 0 0 32 0 3 2 141 0 89 0 0 0 0 0 202 0 0 0 202 0 0 2 32 0 3 2 76 0 90 2 59 0 52 2 103 0 90 2 15 0 90 1 238 0 90 2 105 0 52 2 140 0 90 1 7 0 90 1 224 0 31 2 67 0 90 1 230 0 90 2 215 0 90 2 135 0 90 2 152 0 52 2 64 0 90 2 152 0 52 2 69 0 90 2 22 0 42 2 24 0 28 2 133 0 87 2 3 0 0 3 18 0 23 2 1 0 15 1 220 255 255 2 27 0 45 2 0 0 58 2 43 0 82 1 200 0 46 2 43 0 47 1 240 0 46 1 36 0 30 1 248 0 45 2 32 0 82 0 246 0 67 0 247 255 216 1 239 0 82 0 255 0 82 3 61 0 82 2 35 0 82 2 30 0 46 2 43 0 82 2 38 0 47 1 91 0 82 1 163 0 28 1 82 0 24 2 32 0 75 1 211 0 12 2 206 0 24 1 190 0 14 1 211 0 12 1 169 0 31 2 32 0 3 2 32 0 3 2 32 0 3 2 32 0 3 2 32 0 3 2 32 0 3 2 32 0 3 2 32 0 3 2 32 0 3 2 32 0 3 2 32 0 3 2 32 0 3 2 32 0 3 2 32 0 3 2 32 0 3 2 32 0 3 2 32 0 3 2 32 0 3 2 32 0 3 2 32 0 3 2 32 0 3 2 32 0 3 3 54 0 8 2 59 0 52 2 59 0 52 2 59 0 52 2 59 0 52 2 59 0 52 2 103 0 90 2 103 0 90 2 103 0 90 2 126 0 33 2 15 0 90 2 15 0 90 2 15 0 90 2 15 0 90 2 15 0 90 2 15 0 90 2 15 0 90 2 15 0 90 2 15 0 90 2 15 0 90 2 15 0 90 2 15 0 90 2 15 0 90 2 15 0 90 2 15 0 90 2 15 0 90 2 15 0 90 2 105 0 52 2 105 0 52 2 105 0 52 2 105 0 52 2 105 0 52 2 105 0 52 2 105 0 52 2 140 0 90 2 140 0 90 2 140 0 90 2 175 0 32 1 7 0 0 1 7 0 80 1 7 255 251 1 7 255 242 1 7 255 252 1 7 0 7 1 7 0 74 1 7 255 251 1 7 0 67 1 7 0 78 1 7 0 43 1 224 0 31 2 67 0 90 1 230 0 83 1 230 0 90 1 230 0 90 1 230 0 90 1 230 0 90 1 230 0 10 1 230 0 90 1 233 0 13 2 215 0 90 2 135 0 90 2 135 0 90 2 135 0 90 2 135 0 90 2 135 0 90 2 135 0 90 2 135 0 90 2 152 0 52 2 152 0 52 2 152 0 52 2 152 0 52 2 152 0 52 2 152 0 52 2 152 0 52 2 152 0 52 2 152 0 52 2 152 0 52 2 152 0 52 2 152 0 52 2 152 0 52 2 152 0 52 2 152 0 52 2 152 0 50 3 79 0 52 2 152 0 54 2 152 0 54 2 152 0 54 2 152 0 54 2 152 0 54 2 152 0 54 2 152 0 52 2 69 0 90 2 69 0 90 2 69 0 90 2 69 0 90 2 69 0 90 2 69 0 90 2 22 0 42 2 22 0 42 2 22 0 42 2 22 0 42 2 22 0 42 2 22 0 42 2 22 0 42 2 155 0 91 2 24 0 28 2 24 0 28 2 24 0 28 2 24 0 28 2 24 0 28 2 133 0 87 2 133 0 87 2 133 0 87 2 133 0 87 2 133 0 87 2 133 0 87 2 133 0 87 2 133 0 87 2 133 0 87 2 133 0 87 2 133 0 87 2 133 0 87 2 133 0 87 2 133 0 87 2 133 0 87 2 133 0 87 2 133 0 87 2 147 0 87 2 147 0 87 2 147 0 87 2 147 0 87 2 147 0 87 2 147 0 87 3 18 0 23 3 18 0 23 3 18 0 23 3 18 0 23 1 220 255 255 1 220 255 255 1 220 255 255 1 220 255 255 1 220 255 255 1 220 255 255 1 220 255 255 1 220 255 255 2 27 0 45 2 27 0 45 2 27 0 45 2 27 0 45 2 126 0 33 2 71 0 90 2 147 0 58 2 0 0 58 2 0 0 58 2 0 0 58 2 0 0 58 2 0 0 58 2 0 0 58 2 0 0 58 2 0 0 58 2 0 0 58 2 0 0 58 2 0 0 58 2 0 0 58 2 0 0 58 2 0 0 58 2 0 0 58 2 0 0 58 2 0 0 58 2 0 0 58 2 0 0 58 2 0 0 58 2 0 0 58 2 0 0 58 3 17 0 58 1 200 0 46 1 200 0 46 1 200 0 46 1 200 0 46 1 200 0 46 2 61 0 47 2 43 0 47 2 43 0 47 2 43 0 47 1 240 0 46 1 240 0 46 1 240 0 46 1 240 0 46 1 240 0 46 1 240 0 46 1 240 0 46 1 240 0 46 1 240 0 46 1 240 0 46 1 240 0 46 1 240 0 46 1 240 0 46 1 240 0 46 1 240 0 46 1 240 0 46 1 240 0 46 1 248 0 45 1 248 0 45 1 248 0 45 1 248 0 45 1 248 0 45 1 248 0 45 1 248 0 45 2 32 255 244 2 32 0 82 2 32 0 82 2 32 0 8 0 246 0 12 0 246 0 58 0 246 255 250 0 246 255 240 0 246 255 244 0 246 0 0 0 246 255 250 0 246 0 59 0 246 0 67 0 246 0 38 0 246 0 38 0 246 0 82 0 247 255 216 1 239 0 82 1 239 0 82 0 255 0 68 1 8 0 82 1 106 0 82 0 255 0 82 0 255 0 82 0 255 255 255 0 255 0 46 1 6 0 23 3 61 0 82 2 35 0 82 2 35 0 82 2 35 0 82 2 35 0 82 2 35 0 82 2 35 0 82 2 35 0 82 3 7 0 63 2 30 0 46 2 30 0 46 2 30 0 46 2 30 0 46 2 30 0 46 2 30 0 46 2 30 0 46 2 30 0 46 2 30 0 46 2 30 0 46 2 30 0 46 2 30 0 46 2 30 0 46 2 30 0 46 2 30 0 46 2 30 0 46 3 71 0 46 2 30 0 46 2 30 0 46 2 30 0 46 2 30 0 46 2 30 0 46 2 30 0 46 2 30 0 46 1 91 0 82 1 91 0 36 1 91 0 82 1 91 0 67 1 91 0 67 1 91 255 253 1 163 0 28 1 163 0 28 1 163 0 28 1 163 0 28 1 163 0 28 1 163 0 28 1 163 0 28 2 64 0 82 1 82 0 24 1 82 0 24 1 82 0 24 1 82 0 24 1 82 0 24 1 82 0 9 2 32 0 75 2 32 0 75 2 32 0 75 2 32 0 75 2 32 0 75 2 32 0 75 2 32 0 75 2 32 0 75 2 32 0 75 2 32 0 75 2 32 0 75 2 32 0 75 2 32 0 75 2 32 0 75 2 32 0 75 2 32 0 75 2 32 0 75 2 32 0 75 2 32 0 75 2 32 0 75 2 32 0 75 2 32 0 75 2 32 0 75 2 206 0 24 2 206 0 24 2 206 0 24 2 206 0 24 1 211 0 12 1 211 0 12 1 211 0 12 1 211 0 12 1 211 0 12 1 211 0 12 1 211 0 12 1 211 0 12 1 169 0 31 1 169 0 31 1 169 0 31 1 169 0 31 2 33 0 53 2 43 0 82 0 247 255 216 2 43 0 47 1 240 0 37 2 47 0 50 2 62 0 30 2 44 0 30 2 35 0 30 2 82 0 30 1 88 0 46 1 88 0 41 1 88 0 46 1 88 0 36 1 88 0 27 1 88 0 37 1 88 0 46 1 88 0 46 1 88 0 36 1 88 0 46 1 88 0 46 1 88 0 46 2 43 0 47 2 43 0 47 2 43 0 47 2 43 0 47 2 43 0 47 2 43 0 47 2 43 0 47 2 43 0 47 2 43 0 47 2 43 0 47 2 43 0 47 2 43 0 47 2 43 0 47 2 43 0 47 2 43 0 47 2 43 0 47 2 43 0 47 2 43 0 47 2 43 0 47 2 43 0 47 2 43 0 47 2 43 0 47 2 43 0 47 2 47 0 50 2 47 0 50 2 47 0 50 2 47 0 50 2 47 0 50 2 47 0 50 2 47 0 50 2 47 0 50 0 246 0 82 0 246 0 69 1 8 0 82 1 106 0 82 0 246 0 38 0 246 0 69 0 246 0 0 0 246 255 255 1 1 0 23 2 44 0 30 2 97 0 32 1 241 0 44 1 241 0 79 1 241 0 36 1 241 0 26 1 241 0 17 1 241 0 25 1 241 0 48 1 241 0 44 1 241 0 41 1 241 0 40 2 26 0 55 1 113 0 50 1 245 0 37 1 241 0 26 2 7 0 34 1 241 0 25 2 13 0 61 1 235 0 44 2 13 0 55 2 13 0 52 1 241 0 44 1 241 0 79 1 241 0 36 1 241 0 26 1 241 0 17 1 241 0 25 1 241 0 49 1 241 0 44 1 241 0 41 1 241 0 30 2 6 0 52 1 113 0 50 1 241 0 41 1 241 0 26 2 6 0 25 1 241 0 25 2 6 0 57 1 233 0 44 2 7 0 49 2 6 0 38 0 249 0 65 0 249 0 47 0 249 0 65 0 249 0 47 3 180 0 94 1 33 0 85 1 33 0 85 1 169 0 38 1 169 0 48 0 249 0 80 1 169 0 80 0 249 0 57 0 249 0 63 1 169 0 57 1 169 0 63 0 249 0 63 1 169 0 63 1 15 0 45 1 15 0 54 1 173 0 45 1 173 0 54 1 55 0 41 1 55 0 41 1 224 0 41 3 32 0 41 1 241 0 41 3 32 0 41 0 249 0 65 1 48 0 40 1 244 0 12 1 47 0 82 1 47 0 38 1 47 0 94 1 47 0 31 1 47 0 34 1 47 0 31 1 94 0 10 0 241 0 92 1 94 0 14 0 241 0 92 1 162 0 58 1 198 0 54 1 198 0 54 1 241 0 45 2 48 0 41 2 232 0 49 2 231 0 49 1 167 0 23 2 125 0 3 2 125 0 27 3 79 0 51 3 14 0 51 1 241 0 35 1 111 0 35 1 111 0 87 1 111 0 40 1 111 0 35 1 111 0 42 1 111 0 35 1 111 0 45 1 111 0 50 1 111 0 45 1 111 0 39 0 237 0 65 0 237 0 39 0 177 0 43 0 177 0 33 1 111 0 35 1 111 0 87 1 111 0 40 1 111 0 35 1 111 0 42 1 111 0 35 1 111 0 45 1 111 0 50 1 111 0 45 1 111 0 39 0 237 0 65 0 237 0 39 0 177 0 43 0 177 0 33 1 111 0 35 1 111 0 87 1 111 0 40 1 111 0 35 1 111 0 42 1 111 0 35 1 111 0 45 1 111 0 50 1 111 0 45 1 111 0 39 0 237 0 65 0 237 0 39 0 177 0 43 0 177 0 33 1 111 0 35 1 111 0 87 1 111 0 40 1 111 0 35 1 111 0 42 1 111 0 35 1 111 0 45 1 111 0 50 1 111 0 45 1 111 0 39 0 237 0 65 0 237 0 39 0 177 0 43 0 177 0 33 1 89 0 37 1 118 0 33 1 109 0 30 1 89 0 37 1 118 0 52 1 50 0 30 1 118 0 33 1 80 0 28 0 201 0 19 1 87 0 30 1 110 0 52 0 166 0 42 0 169 255 230 1 81 0 52 0 174 0 52 2 47 0 52 1 113 0 52 1 109 0 30 1 118 0 52 1 118 0 33 0 240 0 52 1 27 0 19 0 232 0 16 1 114 0 50 1 65 0 8 1 231 0 16 1 51 0 8 1 63 0 8 1 34 0 21 1 80 0 28 1 80 0 28 1 80 0 25 1 118 0 33 1 121 0 34 0 166 0 52 1 75 0 41 1 241 0 26 1 241 0 52 1 241 0 53 1 241 0 23 1 241 0 23 1 241 0 61 1 241 0 18 1 241 0 61 1 241 0 53 1 241 0 11 1 241 0 10 1 241 0 68 1 241 0 10 1 241 0 47 1 241 0 61 1 241 0 72 1 241 0 23 0 86 255 89 0 86 255 89 0 86 255 89 3 56 0 35 4 170 0 35 3 13 0 64 3 40 0 64 3 28 0 35 3 36 0 64 3 53 0 41 3 36 0 64 3 53 0 35 3 53 0 35 3 33 0 31 1 241 0 34 1 241 0 34 1 241 0 50 1 241 0 34 1 246 0 188 1 241 0 34 1 241 0 34 1 241 0 34 1 241 0 34 1 241 0 34 1 241 0 34 1 241 0 60 1 241 0 34 1 241 0 36 1 241 0 36 1 241 0 34 2 49 0 24 3 14 0 40 2 38 0 82 2 16 0 40 1 76 0 52 2 45 0 41 2 80 0 30 2 174 0 43 1 248 0 22 2 161 0 89 1 153 0 21 3 32 0 46 2 107 0 26 2 107 0 42 2 107 0 39 2 107 0 42 1 50 0 54 1 50 0 12 1 188 0 41 1 120 0 54 2 59 0 23 2 59 0 23 2 59 0 57 2 59 0 57 2 59 0 23 2 59 0 23 2 59 0 18 2 59 0 18 3 31 0 74 3 31 0 74 2 100 0 0 1 247 0 29 2 5 0 56 0 249 0 81 1 170 0 81 0 249 0 57 0 249 0 63 0 150 0 30 0 162 0 20 2 30 0 160 2 30 0 206 2 30 0 142 2 30 0 142 0 114 0 22 1 21 0 16 0 225 0 46 0 225 0 0 0 114 0 22 2 30 0 132 2 30 0 136 2 30 0 148 2 30 0 145 2 30 0 178 2 30 0 173 2 30 0 217 2 30 0 192 2 30 0 205 0 0 255 145 0 0 255 125 0 0 255 191 0 0 255 205 0 0 255 127 0 0 255 120 0 0 255 117 0 0 255 111 0 0 255 133 0 0 255 132 0 0 255 130 0 0 255 133 0 0 255 202 0 0 255 199 0 0 255 121 0 0 255 121 0 0 255 192 0 0 255 192 0 0 255 163 0 0 255 163 0 0 255 158 0 0 255 147 0 0 255 127 0 0 255 120 0 0 255 64 0 0 255 64 0 0 255 203 0 0 255 209 0 0 255 247 0 0 255 202 0 0 255 121 0 0 255 171 0 0 255 171 0 0 255 171 0 0 255 190 0 0 255 190 0 0 255 130 0 0 255 132 0 0 255 124 0 0 255 124 0 0 255 124 0 0 255 124 0 0 255 124 0 0 255 120 0 0 255 124 0 0 255 124 0 0 255 140 0 0 255 128 0 0 255 140 0 0 255 128 0 0 255 140 0 0 255 128 0 0 255 125 0 0 255 124 0 0 255 130 0 0 255 134 0 0 255 130 0 0 255 134 0 0 255 130 0 0 255 134 0 0 255 125 0 0 255 124 0 18 255 227 0 0 255 187 0 202 0 0 1 241 0 0 0 135 0 0 0 135 0 0 2 91 0 30 1 7 0 8 2 152 0 52 2 32 0 8 0 246 255 254 2 30 0 46 0 0 255 132 0 0 255 128 2 76 0 90 2 43 0 82 2 67 0 90 1 239 0 82 2 15 0 90 1 240 0 46 2 152 0 52 2 30 0 46 1 134 0 92 1 176 0 27 1 47 0 94 1 47 0 31 1 47 0 94 1 47 0 31 1 122 0 94 1 122 0 31 1 47 0 94 1 47 0 31 1 47 0 94 1 47 0 31 1 241 0 44 1 241 0 44 2 26 0 55 2 26 0 55 0 246 0 67 1 214 0 3 2 14 0 90 1 247 0 52 2 43 0 90 1 219 0 90 1 187 0 90 2 37 0 52 2 82 0 90 1 7 0 90 1 182 0 31 2 2 0 90 1 181 0 90 2 135 0 90 2 73 0 90 2 77 0 52 2 6 0 90 2 77 0 51 2 11 0 90 1 218 0 42 1 211 0 28 2 71 0 87 1 191 0 0 2 172 0 23 1 197 0 15 1 159 255 255 1 219 0 45 1 214 0 3 1 214 0 3 1 214 0 3 1 214 0 3 1 214 0 3 1 214 0 3 1 214 0 3 1 214 0 3 1 214 0 3 1 214 0 3 1 214 0 3 1 214 0 3 1 214 0 3 1 214 0 3 1 214 0 3 1 214 0 3 1 214 0 3 1 214 0 3 1 214 0 3 1 214 0 3 1 214 0 3 1 214 0 3 2 200 0 8 2 33 0 33 2 14 0 90 1 247 0 52 1 247 0 52 1 247 0 52 1 247 0 52 1 247 0 52 2 42 0 90 2 42 0 90 2 42 0 90 2 62 0 33 1 219 0 90 1 219 0 90 1 219 0 90 1 219 0 90 1 219 0 90 1 219 0 90 1 219 0 90 1 219 0 90 1 219 0 90 1 219 0 90 1 219 0 90 1 219 0 90 1 219 0 90 1 219 0 90 1 219 0 90 1 219 0 90 1 219 0 90 1 219 0 90 2 37 0 52 2 37 0 52 2 37 0 52 2 37 0 52 2 37 0 52 2 37 0 52 2 37 0 52 2 82 0 90 2 82 0 90 2 82 0 90 2 118 0 32 1 7 0 0 1 7 0 80 1 7 255 251 1 7 255 242 1 7 255 252 1 7 0 7 1 7 0 74 1 7 255 251 1 7 0 67 1 7 0 77 1 7 0 43 1 7 0 8 1 182 0 31 2 2 0 90 2 2 0 90 1 181 0 86 1 181 0 90 1 181 0 90 1 181 0 90 1 181 0 90 1 181 0 13 1 181 0 90 1 181 0 13 2 135 0 90 2 73 0 90 2 73 0 90 2 73 0 90 2 73 0 90 2 73 0 90 2 73 0 90 2 73 0 90 2 77 0 52 2 77 0 52 2 77 0 52 2 77 0 52 2 77 0 52 2 77 0 52 2 77 0 52 2 77 0 52 2 77 0 52 2 77 0 52 2 77 0 52 2 77 0 52 2 77 0 52 2 77 0 52 2 77 0 52 2 77 0 47 2 223 0 52 2 77 0 52 2 77 0 52 2 77 0 52 2 77 0 52 2 77 0 52 2 77 0 52 2 77 0 52 2 77 0 52 2 77 0 52 2 11 0 90 2 11 0 90 2 11 0 90 2 11 0 90 2 11 0 90 2 11 0 90 1 218 0 42 1 218 0 42 1 218 0 42 1 218 0 42 1 218 0 42 1 218 0 42 1 218 0 42 3 180 0 42 2 82 0 91 1 211 0 28 1 211 0 28 1 211 0 28 1 211 0 28 1 211 0 28 2 71 0 87 2 71 0 87 2 71 0 87 2 71 0 87 2 71 0 87 2 71 0 87 2 71 0 87 2 71 0 87 2 71 0 87 2 71 0 87 2 71 0 87 2 71 0 87 2 71 0 87 2 71 0 87 2 71 0 87 2 71 0 87 2 71 0 87 2 85 0 87 2 85 0 87 2 85 0 87 2 85 0 87 2 85 0 87 2 85 0 87 2 172 0 23 2 172 0 23 2 172 0 23 2 172 0 23 1 159 255 255 1 159 255 255 1 159 255 255 1 159 255 255 1 159 255 255 1 159 255 255 1 159 255 255 1 159 255 255 1 219 0 45 1 219 0 45 1 219 0 45 1 219 0 45 2 62 0 33 2 13 0 90 2 70 0 58 2 22 0 32 1 249 0 55 1 102 0 50 1 197 0 34 1 203 0 23 1 225 0 36 1 209 0 31 1 232 0 62 1 175 0 33 1 233 0 54 1 227 0 49 1 22 0 41 1 158 0 41 2 175 0 41 0 249 0 81 1 107 255 255 1 136 0 57 1 123 0 32 1 155 0 57 1 95 0 57 1 74 0 57 1 155 0 32 1 178 0 57 0 176 0 57 1 65 0 18 1 131 0 57 1 69 0 57 1 230 0 57 1 175 0 57 1 187 0 32 1 129 0 57 1 187 0 31 1 133 0 57 1 100 0 26 1 100 0 17 1 175 0 56 1 90 255 254 2 14 0 13 1 90 0 8 1 64 255 253 1 102 0 27 0 177 0 43 0 236 0 41 1 92 0 41 2 50 0 41 0 0 255 133 0 0 255 132 0 0 0 0 0 0 0 3 0 0 0 3 0 0 2 20 0 1 0 0 0 0 0 28 0 3 0 1 0 0 2 20 0 6 1 248 0 0 0 9 0 247 0 3 0 0 0 0 0 0 0 3 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3 2 2 2 7 2 49 2 143 2 162 1 212 2 6 2 27 2 28 2 37 2 173 1 254 2 18 1 253 2 33 1 213 1 214 1 215 1 216 1 217 1 218 1 219 1 220 1 221 1 222 1 255 2 0 2 179 2 178 2 180 2 4 2 47 0 4 0 5 0 6 0 7 0 8 0 9 0 10 0 11 0 12 0 13 0 14 0 15 0 16 0 17 0 18 0 19 0 20 0 21 0 22 0 23 0 24 0 25 0 26 0 27 0 28 0 29 2 29 2 35 2 30 2 184 2 26 2 228 0 30 0 31 0 32 0 33 0 34 0 35 0 36 0 37 0 38 0 39 0 40 0 41 0 42 0 43 0 44 0 45 0 46 0 47 0 48 0 49 0 50 0 51 0 52 0 53 0 54 0 55 2 31 2 34 2 32 2 186 0 0 0 60 0 63 0 79 0 89 0 140 0 149 0 192 0 231 0 230 0 232 0 234 0 233 0 237 0 253 1 7 1 6 1 8 1 10 1 35 1 34 1 36 1 38 1 60 1 67 1 66 1 68 1 70 1 69 1 111 1 110 1 112 1 114 2 38 2 141 2 147 2 144 2 40 2 25 2 41 1 103 2 44 2 42 2 45 2 229 2 238 2 185 0 78 0 160 2 190 2 183 2 181 2 182 2 145 2 191 2 192 2 197 2 198 2 189 2 193 2 106 2 108 0 0 0 252 1 81 2 5 2 3 2 188 2 194 2 148 2 187 2 195 2 16 2 17 2 1 3 54 0 56 0 59 0 148 0 161 1 82 2 20 2 21 2 10 2 11 2 8 2 9 2 176 2 221 1 140 0 218 2 159 2 146 2 14 2 15 1 156 1 157 2 39 2 24 2 12 2 13 2 163 0 58 0 90 0 57 0 92 0 88 0 117 0 118 0 120 0 116 0 146 0 147 0 0 0 145 0 189 0 190 0 188 1 45 2 230 2 237 2 239 2 240 2 243 2 241 2 244 2 242 2 245 2 231 0 4 8 20 0 0 1 26 1 0 0 7 0 26 0 0 0 13 0 47 0 57 0 64 0 90 0 96 0 122 0 126 0 191 0 196 0 209 0 214 0 223 0 228 0 241 0 246 1 49 1 73 1 101 1 126 1 128 1 143 1 146 1 161 1 176 1 220 1 231 1 235 2 27 2 55 2 67 2 81 2 89 2 97 2 176 2 179 2 185 2 188 2 191 2 204 2 221 2 227 3 4 3 12 3 15 3 19 3 27 3 36 3 40 3 46 3 49 3 192 29 67 29 73 29 77 29 80 29 82 29 88 29 91 29 156 29 160 29 187 30 7 30 15 30 23 30 33 30 37 30 43 30 59 30 73 30 83 30 99 30 111 30 133 30 143 30 147 30 151 30 158 30 249 32 7 32 22 32 26 32 30 32 34 32 38 32 48 32 51 32 58 32 61 32 68 32 113 32 121 32 127 32 137 32 142 32 148 32 161 32 164 32 167 32 172 32 178 32 181 32 186 33 19 33 23 33 32 33 34 33 38 33 46 33 84 33 94 33 147 34 2 34 6 34 15 34 18 34 21 34 26 34 30 34 43 34 72 34 96 34 101 35 31 37 160 37 179 37 183 37 189 37 193 37 198 37 202 38 17 38 106 39 19 39 82 39 231 46 37 251 2 254 255 255 255 0 0 0 0 0 13 0 32 0 48 0 58 0 65 0 91 0 97 0 123 0 160 0 192 0 197 0 210 0 215 0 224 0 229 0 242 0 247 1 52 1 76 1 104 1 128 1 143 1 146 1 160 1 175 1 205 1 230 1 234 2 24 2 55 2 67 2 81 2 89 2 97 2 176 2 178 2 183 2 187 2 190 2 198 2 216 2 225 3 0 3 6 3 15 3 18 3 27 3 35 3 38 3 46 3 49 3 192 29 67 29 71 29 77 29 79 29 82 29 86 29 91 29 156 29 160 29 187 30 6 30 12 30 22 30 32 30 36 30 42 30 52 30 66 30 82 30 90 30 108 30 128 30 142 30 146 30 151 30 158 30 160 32 7 32 18 32 24 32 28 32 32 32 38 32 48 32 50 32 57 32 61 32 68 32 112 32 116 32 125 32 128 32 141 32 148 32 161 32 164 32 166 32 171 32 177 32 181 32 185 33 19 33 23 33 32 33 34 33 38 33 46 33 83 33 91 33 144 34 2 34 6 34 15 34 17 34 21 34 25 34 30 34 43 34 72 34 96 34 100 35 28 37 160 37 178 37 182 37 188 37 192 37 198 37 201 38 16 38 106 39 19 39 82 39 230 46 34 251 0 254 255 255 255 0 1 255 245 0 0 1 165 0 0 255 195 0 0 255 189 0 0 0 0 255 120 0 0 255 191 0 0 0 6 0 0 0 80 0 0 0 0 0 0 0 0 1 189 255 86 1 2 0 0 0 0 0 0 0 0 0 0 0 0 255 96 0 247 255 71 255 64 255 57 255 196 0 0 0 0 0 37 0 36 0 32 0 0 0 0 0 0 0 0 255 255 255 254 255 247 255 240 0 0 255 236 255 234 254 253 229 42 0 0 229 38 0 0 229 41 0 0 229 39 228 211 228 210 228 203 229 60 0 0 229 48 0 0 0 0 0 0 0 0 0 0 228 246 0 0 0 0 0 0 0 0 0 0 226 214 226 24 0 0 227 48 0 0 0 0 0 0 0 0 225 219 226 115 226 172 225 213 227 14 226 91 0 0 225 194 0 0 225 192 225 189 225 245 225 244 225 242 225 241 0 0 225 233 225 231 225 228 225 180 225 20 225 14 225 11 225 158 225 154 225 84 225 78 225 57 224 190 224 189 224 183 0 0 224 139 0 0 224 160 224 150 224 115 224 89 224 81 224 48 221 45 221 31 221 29 221 25 221 23 221 8 0 0 220 201 220 114 219 200 219 126 219 106 213 48 6 155 5 91 0 1 0 0 0 0 1 22 0 0 1 50 0 0 1 60 0 0 1 68 1 74 0 0 1 134 0 0 1 156 0 0 1 170 0 0 1 192 2 52 2 94 2 144 0 0 0 0 0 0 2 182 2 184 2 186 2 216 2 218 2 220 0 0 0 0 0 0 0 0 0 0 0 0 2 214 2 216 0 0 0 0 0 0 2 214 2 224 2 228 2 236 0 0 0 0 0 0 0 0 2 240 0 0 0 0 0 0 0 0 2 236 0 0 2 238 0 0 2 238 0 0 0 0 0 0 0 0 0 0 2 232 0 0 2 236 2 238 2 240 2 242 3 0 0 0 3 12 3 30 3 36 3 46 3 48 0 0 0 0 3 46 0 0 3 222 3 230 3 234 3 238 0 0 0 0 0 0 0 0 0 0 0 0 3 230 0 0 3 230 0 0 0 0 0 0 0 0 0 0 0 0 3 222 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3 194 0 0 3 194 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3 172 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3 2 2 2 7 2 49 2 143 2 162 1 212 2 6 2 27 2 28 2 37 2 173 1 254 2 18 1 253 2 33 1 255 2 0 2 179 2 178 2 180 2 4 2 47 2 29 2 35 2 30 2 184 2 26 2 228 2 31 2 34 2 32 2 186 3 54 2 3 2 147 2 144 2 142 2 145 2 36 2 40 2 238 2 42 2 106 2 16 2 188 2 19 2 44 2 239 2 141 2 183 2 52 2 53 2 229 2 191 2 41 2 24 2 244 2 51 2 108 2 17 2 164 2 165 2 166 2 5 0 63 0 78 0 79 0 88 0 89 0 90 0 92 0 116 0 117 0 118 0 120 0 227 0 140 2 175 0 160 0 188 0 189 0 190 0 192 0 216 0 228 1 103 0 237 0 252 0 253 1 6 1 7 1 8 1 10 1 34 1 35 1 36 1 38 1 149 1 60 2 176 1 81 1 110 1 111 1 112 1 114 1 138 1 150 1 140 0 61 0 235 0 62 0 236 0 77 0 251 0 80 0 254 0 81 0 255 0 83 1 1 0 82 1 0 0 84 1 2 0 87 1 5 0 93 1 11 0 94 1 12 0 95 1 13 0 104 1 22 0 91 1 9 0 105 1 23 0 106 1 24 0 107 1 25 0 108 1 26 0 112 1 30 0 115 1 33 0 119 1 37 0 121 1 39 3 59 3 62 0 126 1 43 0 122 1 45 0 127 1 46 0 128 1 47 1 48 0 129 1 49 0 131 1 52 0 130 1 50 0 132 1 51 0 136 1 56 0 138 1 58 0 141 1 61 0 139 1 59 1 65 0 150 1 71 3 60 3 63 0 151 1 72 0 161 1 82 0 169 1 90 0 171 1 91 0 170 1 92 0 175 1 96 0 176 1 97 0 178 1 99 0 177 1 98 0 184 1 105 0 183 1 104 0 191 1 113 0 193 1 115 0 194 1 116 0 195 1 117 0 196 1 118 0 204 1 126 0 213 1 135 0 217 1 139 0 218 0 223 1 145 0 225 1 147 0 224 1 146 0 162 1 83 0 205 1 127 0 64 0 238 0 123 1 40 0 152 1 73 0 197 1 119 0 198 1 120 0 199 1 121 0 200 1 122 0 201 1 123 0 109 1 27 0 168 1 89 0 179 1 100 0 185 1 106 2 118 2 126 2 131 2 133 4 57 2 240 2 243 2 241 2 245 2 237 2 242 2 120 2 127 2 132 2 246 2 248 2 250 2 252 2 254 3 0 3 2 3 4 3 6 3 8 3 10 3 12 3 21 3 22 3 24 2 110 2 112 2 113 2 119 2 121 2 124 2 128 2 129 0 85 1 3 0 86 1 4 0 110 1 28 0 113 1 31 0 114 1 32 3 68 3 69 0 133 1 53 0 134 1 54 0 135 1 55 0 137 1 57 0 142 1 62 0 143 1 63 0 144 1 64 0 172 1 93 0 173 1 94 0 174 1 95 0 180 1 101 0 181 1 102 0 186 1 107 0 187 1 108 0 211 1 133 0 212 1 134 0 214 1 136 0 219 1 141 0 226 1 148 0 65 0 239 0 66 0 240 0 67 0 241 0 68 0 242 0 69 0 243 0 70 0 244 0 71 0 245 0 72 0 246 0 73 0 247 0 74 0 248 0 75 0 249 0 76 0 250 0 96 1 14 0 97 1 15 0 98 1 16 0 99 1 17 0 100 1 18 0 101 1 19 0 102 1 20 0 103 1 21 0 124 1 41 0 125 1 42 0 153 1 74 0 154 1 75 0 155 1 76 0 156 1 77 0 157 1 78 0 158 1 79 0 159 1 80 0 163 1 84 0 164 1 85 0 165 1 86 0 166 1 87 0 167 1 88 0 202 1 124 0 203 1 125 0 206 1 128 0 207 1 129 0 208 1 130 0 209 1 131 0 210 1 132 0 215 1 137 0 220 1 142 0 221 1 143 0 222 1 144 2 22 2 20 2 21 2 23 3 74 2 8 2 9 2 12 2 10 2 11 2 13 2 38 2 39 2 25 2 50 2 117 2 60 2 61 2 122 2 153 2 146 2 197 2 174 2 177 2 194 2 207 2 221 184 0 0 44 75 184 0 9 80 88 177 1 1 142 89 184 1 255 133 184 0 68 29 185 0 9 0 3 95 94 45 184 0 1 44 32 32 69 105 68 176 1 96 45 184 0 2 44 184 0 1 42 33 45 184 0 3 44 32 70 176 3 37 70 82 88 35 89 32 138 32 138 73 100 138 32 70 32 104 97 100 176 4 37 70 32 104 97 100 82 88 35 101 138 89 47 32 176 0 83 88 105 32 176 0 84 88 33 176 64 89 27 105 32 176 0 84 88 33 176 64 101 89 89 58 45 184 0 4 44 32 70 176 4 37 70 82 88 35 138 89 32 70 32 106 97 100 176 4 37 70 32 106 97 100 82 88 35 138 89 47 253 45 184 0 5 44 75 32 176 3 38 80 88 81 88 176 128 68 27 176 64 68 89 27 33 33 32 69 176 192 80 88 176 192 68 27 33 89 89 45 184 0 6 44 32 32 69 105 68 176 1 96 32 32 69 125 105 24 68 176 1 96 45 184 0 7 44 184 0 6 42 45 184 0 8 44 75 32 176 3 38 83 88 176 64 27 176 0 89 138 138 32 176 3 38 83 88 35 33 176 128 138 138 27 138 35 89 32 176 3 38 83 88 35 33 184 0 192 138 138 27 138 35 89 32 176 3 38 83 88 35 33 184 1 0 138 138 27 138 35 89 32 176 3 38 83 88 35 33 184 1 64 138 138 27 138 35 89 32 184 0 3 38 83 88 176 3 37 69 184 1 128 80 88 35 33 184 1 128 35 33 27 176 3 37 69 35 33 35 33 89 27 33 89 68 45 184 0 9 44 75 83 88 69 68 27 33 33 89 45 0 176 0 43 0 178 1 1 2 43 1 178 2 2 2 43 1 183 2 68 54 42 33 20 0 8 43 183 3 64 54 42 33 20 0 8 43 0 183 1 81 67 52 36 23 0 8 43 0 178 4 8 7 43 176 0 32 69 125 105 24 68 75 176 96 82 88 176 1 27 176 0 89 176 1 142 0 0 20 0 68 0 82 0 86 0 0 0 12 255 51 0 12 1 230 0 12 2 6 0 12 2 62 0 12 2 126 0 12 2 144 0 12 2 200 0 12 0 0 0 98 0 98 0 98 0 98 0 176 1 22 1 102 1 162 1 224 2 22 2 116 2 176 2 208 3 2 3 74 3 112 3 212 4 36 4 120 4 192 5 50 5 134 5 244 6 32 6 102 6 162 7 24 7 116 7 178 7 232 8 94 8 218 9 42 9 162 10 4 10 82 11 2 11 80 11 132 11 204 12 20 12 70 12 198 13 28 13 112 13 236 14 98 14 170 15 22 15 96 15 182 15 242 16 104 16 194 17 24 17 78 17 90 17 102 17 114 17 126 17 138 17 150 17 162 17 174 17 186 17 198 17 210 17 222 17 234 17 246 18 2 18 18 18 30 18 42 18 54 18 66 18 82 18 198 19 42 19 54 19 66 19 78 19 90 19 102 19 114 19 126 19 138 19 146 19 158 19 170 19 182 19 194 19 206 19 218 19 230 19 242 19 254 20 10 20 22 20 34 20 46 20 58 20 70 20 86 20 186 20 198 20 210 20 222 20 234 20 246 21 2 21 14 21 26 21 38 21 50 21 154 21 166 21 178 21 190 21 202 21 214 21 226 21 238 21 250 22 6 22 18 22 92 22 104 22 116 22 128 22 140 22 152 22 164 22 176 22 192 22 204 23 12 23 24 23 36 23 48 23 60 23 72 23 84 23 96 23 108 23 120 23 132 23 144 23 156 23 168 23 180 23 192 23 204 23 216 23 228 23 240 23 252 24 8 24 20 24 36 24 176 25 6 25 118 25 130 25 142 25 154 25 166 25 178 26 50 26 62 26 74 26 86 26 98 26 114 26 126 26 138 26 150 26 162 26 174 26 186 26 198 26 210 27 60 27 72 27 84 27 96 27 108 27 120 27 132 27 144 27 156 27 168 27 180 27 192 27 204 27 216 27 228 27 240 27 252 28 8 28 20 28 32 28 44 28 56 28 170 29 10 29 22 29 34 29 46 29 58 29 70 29 82 29 94 29 106 29 118 29 130 29 142 29 154 29 166 29 178 29 190 29 202 29 214 29 226 29 238 29 250 30 6 30 94 30 162 31 2 31 14 31 26 31 38 31 50 31 62 31 74 31 86 31 98 31 110 31 122 31 134 31 146 31 158 31 170 31 182 31 198 31 210 31 222 31 234 31 246 32 6 32 146 33 72 33 84 33 96 33 108 33 120 33 132 33 144 33 156 33 168 34 32 34 44 34 56 34 68 34 80 34 92 34 104 34 116 34 128 34 140 34 152 34 164 34 176 34 188 34 200 34 212 34 228 35 102 35 114 35 126 35 138 35 150 35 162 35 174 35 186 35 198 35 210 35 222 36 54 36 66 36 78 36 90 36 102 36 114 36 126 36 138 36 150 36 162 36 246 37 54 37 86 37 98 37 110 37 178 37 190 37 202 37 214 37 226 37 238 37 254 38 10 38 88 38 100 38 112 38 124 38 136 38 148 38 160 38 172 38 184 38 196 38 208 38 220 38 232 38 244 39 0 39 12 39 24 39 36 39 48 39 60 39 72 39 84 39 96 39 108 39 124 39 232 40 128 40 240 40 252 41 8 41 20 41 32 41 44 41 166 41 178 41 190 41 202 41 214 41 230 41 242 41 254 42 10 42 22 42 34 42 46 42 58 42 70 42 196 42 208 42 220 42 232 42 244 43 0 43 12 43 24 43 36 43 48 43 60 43 72 43 84 43 96 43 108 43 120 43 132 43 144 43 156 43 168 43 180 43 192 43 204 44 50 44 150 44 162 44 174 44 186 44 198 44 210 44 222 44 234 44 246 45 2 45 14 45 26 45 38 45 50 45 62 45 74 45 86 45 98 45 110 45 122 45 134 45 146 46 20 46 122 46 172 47 8 47 104 47 218 48 82 48 94 48 106 48 236 49 34 49 46 49 58 49 70 49 82 49 94 49 106 49 118 49 130 49 142 49 154 49 248 50 0 50 12 50 24 50 36 50 48 50 60 50 72 50 84 50 96 50 108 50 120 50 132 50 144 50 156 50 168 50 180 50 196 50 208 50 220 50 232 50 244 51 4 51 126 51 134 51 146 51 158 51 170 51 182 51 194 51 206 51 218 51 250 52 6 52 18 52 30 52 42 52 54 52 70 52 82 52 140 52 152 53 76 53 148 53 206 54 26 54 140 54 220 55 58 55 160 55 214 56 98 56 200 57 14 57 60 57 136 57 144 57 152 57 160 57 168 57 222 57 230 57 238 58 46 58 104 58 180 59 26 59 96 59 184 59 192 59 236 59 244 60 80 60 88 60 134 60 212 60 220 60 228 60 236 60 244 61 32 61 40 61 48 61 82 61 124 61 136 61 148 61 164 61 210 61 254 62 76 62 156 62 178 62 190 62 228 63 10 63 22 63 34 63 44 63 58 63 82 63 106 63 118 63 130 63 150 63 158 63 178 63 198 63 218 63 226 63 236 64 18 64 38 64 72 64 106 64 134 64 162 64 250 65 86 65 112 65 130 65 156 65 182 65 222 66 18 66 96 66 208 67 2 67 126 67 254 68 128 68 220 69 116 70 6 70 158 71 28 71 38 71 48 71 58 71 68 71 78 71 88 71 98 71 108 71 118 71 128 71 138 71 148 71 158 71 168 71 178 71 188 71 198 71 208 71 218 71 228 71 238 71 248 72 2 72 12 72 22 72 32 72 42 72 52 72 110 72 146 72 210 73 46 73 112 73 190 74 20 74 66 74 186 75 16 75 50 75 84 75 120 75 172 75 182 75 192 75 202 75 212 75 222 75 232 75 242 75 252 76 6 76 16 76 26 76 36 76 46 76 56 76 64 76 72 76 80 76 164 76 246 77 50 77 134 77 212 78 16 78 154 78 200 78 240 79 44 79 88 79 126 79 198 79 246 80 52 80 124 80 194 80 238 81 72 81 126 81 174 81 206 82 14 82 66 82 130 82 168 83 0 83 88 83 162 83 236 84 70 84 88 84 148 84 248 85 104 85 214 86 68 86 198 87 30 87 124 88 36 88 166 89 86 89 192 90 84 90 236 91 90 91 194 92 32 92 134 92 162 92 170 92 178 92 196 93 126 93 144 93 162 93 180 93 198 93 216 93 234 93 252 94 14 94 32 94 68 94 88 94 120 94 182 94 192 94 204 94 238 95 16 95 58 95 100 95 156 95 190 95 250 96 52 96 64 96 86 96 168 97 38 97 94 97 190 98 2 98 40 98 94 98 194 98 242 99 18 99 122 99 230 100 4 100 46 100 78 100 120 100 138 100 158 100 248 101 24 101 48 101 80 101 104 101 150 101 190 101 240 102 8 102 58 102 102 102 178 102 214 103 26 103 86 103 106 103 118 103 126 103 134 103 180 103 226 103 236 103 246 104 0 104 10 104 36 104 46 104 54 104 62 104 80 104 90 104 100 104 110 104 120 104 130 104 140 104 150 104 160 104 170 104 196 104 214 104 240 105 2 105 48 105 78 105 148 105 204 105 222 105 240 106 40 106 82 106 116 106 144 106 202 106 254 107 36 107 74 107 122 107 170 107 208 107 242 108 32 108 62 108 100 108 132 108 168 108 202 108 238 109 10 109 60 109 100 109 142 109 184 109 222 110 8 110 50 110 68 110 128 110 188 110 250 111 56 111 126 111 196 112 2 112 64 112 102 112 140 112 178 112 216 113 18 113 74 113 146 113 220 114 16 114 68 114 120 114 172 114 244 115 62 115 148 115 236 116 0 116 40 116 40 116 40 116 40 116 40 116 168 116 180 116 192 117 50 117 62 117 74 117 134 117 190 117 202 117 214 117 226 117 238 117 250 118 6 118 18 118 30 118 64 118 152 118 174 118 194 118 216 118 238 119 24 119 68 119 90 119 112 119 134 119 156 119 244 120 88 120 182 121 28 121 36 121 112 121 212 122 32 122 90 122 150 122 198 123 26 123 88 123 120 123 170 123 246 124 28 124 132 124 212 125 30 125 96 125 200 126 24 126 132 126 178 126 248 127 52 127 170 128 14 128 76 128 130 128 142 128 154 128 166 128 178 128 190 128 202 128 214 128 226 128 238 128 250 129 6 129 18 129 30 129 42 129 54 129 70 129 82 129 94 129 106 129 118 129 134 130 2 130 92 130 204 130 216 130 228 130 240 130 252 131 8 131 20 131 32 131 44 131 56 131 64 131 76 131 88 131 100 131 112 131 124 131 136 131 148 131 160 131 172 131 184 131 196 131 208 131 220 131 232 131 244 132 4 132 112 132 124 132 136 132 148 132 160 132 172 132 184 132 196 132 208 132 220 132 232 132 244 133 90 133 102 133 114 133 126 133 138 133 150 133 162 133 174 133 186 133 198 133 210 134 28 134 40 134 52 134 64 134 76 134 88 134 100 134 112 134 124 134 136 134 152 134 164 134 240 134 252 135 8 135 20 135 32 135 44 135 56 135 68 135 80 135 92 135 104 135 116 135 128 135 140 135 152 135 164 135 176 135 188 135 200 135 212 135 224 135 236 135 248 136 8 136 140 136 230 137 78 137 90 137 102 137 114 137 126 137 138 137 254 138 10 138 22 138 34 138 46 138 58 138 70 138 86 138 98 138 110 138 122 138 134 138 146 138 158 138 170 138 182 138 194 139 42 139 54 139 66 139 78 139 90 139 102 139 114 139 126 139 138 139 150 139 162 139 174 139 186 139 198 139 210 139 222 139 234 139 246 140 2 140 14 140 26 140 38 140 150 140 246 141 2 141 14 141 26 141 38 141 50 141 62 141 74 141 86 141 98 141 110 141 122 141 134 141 146 141 158 141 170 141 182 141 194 141 206 141 218 141 230 141 242 142 70 142 138 142 230 143 152 143 222 144 12 144 88 144 194 145 18 145 106 145 212 146 10 146 148 146 252 147 16 147 36 147 56 147 64 147 122 147 196 148 0 148 44 148 86 148 120 148 190 148 226 148 244 149 26 149 76 149 100 149 170 149 224 150 30 150 78 150 164 150 226 151 62 151 90 151 140 151 180 152 6 152 80 152 124 152 164 152 216 152 242 153 12 153 38 153 76 153 106 153 106 0 5 0 89 0 0 2 53 2 148 0 3 0 6 0 9 0 15 0 21 0 103 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 16 62 89 184 0 0 69 88 184 0 2 47 27 185 0 2 0 4 62 89 186 0 5 0 2 0 0 17 18 57 186 0 6 0 2 0 0 17 18 57 186 0 7 0 2 0 0 17 18 57 186 0 8 0 2 0 0 17 18 57 185 0 10 0 1 244 186 0 13 0 2 0 0 17 18 57 184 0 0 16 185 0 18 0 1 244 48 49 19 33 17 33 19 39 17 33 17 7 19 47 1 35 15 1 19 63 1 35 31 1 89 1 220 254 36 192 127 1 88 126 82 73 52 4 54 74 132 49 66 235 66 50 2 148 253 108 1 84 232 254 50 1 206 232 254 230 132 103 103 132 1 73 94 119 119 94 0 0 0 0 2 0 3 0 0 2 29 2 144 0 9 0 17 0 84 0 184 0 0 69 88 184 0 14 47 27 185 0 14 0 16 62 89 184 0 0 69 88 184 0 12 47 27 185 0 12 0 4 62 89 184 0 0 69 88 184 0 17 47 27 185 0 17 0 4 62 89 186 0 5 0 12 0 14 17 18 57 186 0 11 0 12 0 14 17 18 57 184 0 11 47 185 0 9 0 1 244 48 49 1 39 46 1 39 35 14 1 15 1 23 35 7 35 19 51 19 35 1 113 31 18 32 16 4 15 32 18 31 218 239 63 85 222 94 222 89 1 11 100 55 109 57 57 109 55 100 67 200 2 144 253 112 0 0 0 0 3 0 90 0 0 2 36 2 144 0 19 0 28 0 37 0 91 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 16 62 89 184 0 0 69 88 184 0 19 47 27 185 0 19 0 4 62 89 186 0 35 0 0 0 19 17 18 57 184 0 35 47 186 0 10 0 35 0 20 17 18 57 184 0 0 16 185 0 27 0 1 244 184 0 35 16 185 0 28 0 1 244 184 0 19 16 185 0 37 0 1 244 48 49 19 51 50 30 2 21 20 6 7 21 30 1 21 20 14 2 43 1 19 50 54 53 52 38 43 1 21 19 50 54 53 52 38 43 1 21 90 195 50 83 59 33 56 58 72 80 36 66 92 55 209 180 85 73 77 77 101 114 85 94 92 87 114 2 144 18 38 61 43 49 79 15 4 11 78 68 48 72 48 24 1 120 58 55 54 47 214 254 202 63 67 61 57 248 0 0 1 0 52 255 244 2 27 2 156 0 33 0 57 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 16 62 89 184 0 0 69 88 184 0 29 47 27 185 0 29 0 4 62 89 184 0 5 16 185 0 12 0 1 244 184 0 29 16 185 0 22 0 1 244 48 49 19 52 62 2 51 50 22 23 7 46 1 35 34 14 2 21 20 30 2 51 50 54 55 23 14 1 35 34 46 2 52 44 78 107 63 60 90 29 47 26 63 42 47 76 54 30 29 52 75 47 48 71 32 47 39 98 63 62 105 77 43 1 72 79 126 88 47 49 32 53 28 33 37 69 98 61 62 99 70 38 38 35 51 45 50 46 87 127 0 0 2 0 90 0 0 2 52 2 144 0 10 0 19 0 53 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 16 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 4 62 89 185 0 11 0 1 244 184 0 0 16 185 0 17 0 1 244 48 49 19 51 50 22 21 20 14 2 43 1 55 50 54 53 52 38 43 1 17 90 164 152 158 40 78 114 74 168 158 115 115 115 115 75 2 144 168 157 78 123 85 45 68 138 125 125 132 253 248 0 0 0 1 0 90 0 0 1 222 2 144 0 11 0 77 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 16 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 4 62 89 184 0 0 16 185 0 3 0 1 244 186 0 7 0 0 0 11 17 18 57 184 0 7 47 185 0 5 0 1 244 184 0 11 16 185 0 8 0 1 244 48 49 19 33 21 33 21 51 21 35 21 33 21 33 90 1 122 254 217 249 249 1 49 254 124 2 144 70 206 71 238 71 0 0 0 0 1 0 90 0 0 1 212 2 144 0 9 0 67 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 16 62 89 184 0 0 69 88 184 0 9 47 27 185 0 9 0 4 62 89 184 0 0 16 185 0 3 0 1 244 186 0 7 0 0 0 9 17 18 57 184 0 7 47 185 0 5 0 1 244 48 49 19 33 21 33 21 51 21 35 17 35 90 1 122 254 217 250 250 83 2 144 70 222 70 254 218 0 0 0 1 0 52 255 244 2 38 2 156 0 37 0 77 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 16 62 89 184 0 0 69 88 184 0 33 47 27 185 0 33 0 4 62 89 184 0 5 16 185 0 12 0 1 244 184 0 33 16 185 0 22 0 1 244 186 0 29 0 5 0 33 17 18 57 184 0 29 47 185 0 27 0 1 244 48 49 19 52 62 2 51 50 22 23 7 46 1 35 34 14 2 21 20 30 2 51 50 54 55 53 35 53 51 17 14 1 35 34 46 2 52 45 81 110 66 68 91 29 47 25 65 50 50 80 56 31 29 55 81 53 35 63 20 139 215 32 105 66 65 108 78 44 1 72 79 126 88 47 51 30 53 26 35 37 69 98 61 62 99 70 38 21 18 171 69 254 236 33 43 46 87 127 0 0 1 0 90 0 0 2 50 2 144 0 11 0 73 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 16 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 4 62 89 186 0 9 0 0 0 11 17 18 57 184 0 9 47 185 0 3 0 1 244 184 0 0 16 184 0 4 208 184 0 11 16 184 0 7 208 48 49 19 51 17 33 17 51 17 35 17 33 17 35 90 83 1 49 84 84 254 207 83 2 144 254 237 1 19 253 112 1 53 254 203 0 1 0 90 0 0 0 173 2 144 0 3 0 37 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 16 62 89 184 0 0 69 88 184 0 3 47 27 185 0 3 0 4 62 89 48 49 19 51 17 35 90 83 83 2 144 253 112 0 0 0 1 0 31 255 244 1 137 2 144 0 16 0 43 0 184 0 0 69 88 184 0 7 47 27 185 0 7 0 16 62 89 184 0 0 69 88 184 0 14 47 27 185 0 14 0 4 62 89 185 0 3 0 1 244 48 49 55 30 1 51 50 54 53 17 51 17 20 14 2 35 34 39 91 22 56 35 53 52 84 21 43 69 48 123 58 135 39 35 65 75 1 199 254 49 42 75 56 32 105 0 1 0 90 0 0 2 63 2 144 0 12 0 91 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 16 62 89 184 0 0 69 88 184 0 4 47 27 185 0 4 0 16 62 89 184 0 0 69 88 184 0 12 47 27 185 0 12 0 4 62 89 184 0 0 69 88 184 0 8 47 27 185 0 8 0 4 62 89 186 0 2 0 0 0 12 17 18 57 186 0 9 0 4 0 8 17 18 57 48 49 19 51 17 51 1 51 7 19 35 3 7 21 35 90 83 3 1 17 94 205 237 93 196 113 83 2 144 254 183 1 73 250 254 106 1 85 133 208 0 0 1 0 90 0 0 1 204 2 144 0 5 0 43 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 16 62 89 184 0 0 69 88 184 0 5 47 27 185 0 5 0 4 62 89 185 0 2 0 1 244 48 49 19 51 17 33 21 33 90 83 1 31 254 142 2 144 253 183 71 0 0 0 1 0 90 0 0 2 125 2 144 0 25 0 111 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 16 62 89 184 0 0 69 88 184 0 6 47 27 185 0 6 0 16 62 89 184 0 0 69 88 184 0 25 47 27 185 0 25 0 4 62 89 184 0 0 69 88 184 0 9 47 27 185 0 9 0 4 62 89 186 0 3 0 6 0 9 17 18 57 186 0 14 0 6 0 9 17 18 57 186 0 17 0 25 0 6 17 18 57 186 0 20 0 0 0 25 17 18 57 48 49 19 51 19 23 51 55 19 51 17 35 17 52 54 55 35 7 3 35 3 39 35 30 1 21 17 35 90 98 127 48 4 46 126 98 79 7 4 4 53 126 47 127 52 4 3 8 77 2 144 254 160 134 134 1 96 253 112 1 105 44 106 44 146 254 169 1 87 146 44 106 44 254 151 0 0 0 1 0 90 0 0 2 45 2 144 0 19 0 91 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 16 62 89 184 0 0 69 88 184 0 8 47 27 185 0 8 0 16 62 89 184 0 0 69 88 184 0 19 47 27 185 0 19 0 4 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 4 62 89 186 0 4 0 11 0 8 17 18 57 186 0 14 0 0 0 19 17 18 57 48 49 19 51 19 23 51 46 1 53 17 51 17 35 3 39 35 30 1 21 17 35 90 86 237 71 4 3 7 79 86 238 71 4 4 7 79 2 144 254 100 136 50 107 52 1 83 253 112 1 157 135 50 103 52 254 169 0 2 0 52 255 244 2 101 2 156 0 19 0 39 0 53 0 184 0 0 69 88 184 0 10 47 27 185 0 10 0 16 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 4 62 89 185 0 20 0 1 244 184 0 10 16 185 0 30 0 1 244 48 49 5 34 46 2 53 52 62 2 51 50 30 2 21 20 14 2 39 50 62 2 53 52 46 2 35 34 14 2 21 20 30 2 1 76 62 103 74 41 41 74 103 62 62 103 75 41 41 75 103 62 44 71 51 28 28 51 71 44 44 71 51 28 28 51 71 12 48 89 127 79 79 125 87 46 47 87 125 78 79 127 89 48 73 38 71 99 62 61 98 68 37 37 68 98 61 62 99 71 38 0 2 0 90 0 0 2 21 2 144 0 14 0 23 0 67 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 16 62 89 184 0 0 69 88 184 0 14 47 27 185 0 14 0 4 62 89 186 0 12 0 0 0 14 17 18 57 184 0 12 47 185 0 15 0 1 244 184 0 0 16 185 0 22 0 1 244 48 49 19 51 50 30 2 21 20 14 2 43 1 17 35 19 50 54 53 52 38 43 1 17 90 201 54 90 63 35 35 64 89 54 118 83 191 86 83 84 85 108 2 144 20 45 74 54 52 76 50 25 254 252 1 72 65 70 71 55 254 251 0 0 2 0 52 255 92 2 115 2 156 0 19 0 52 0 75 0 184 0 0 69 88 184 0 36 47 27 185 0 36 0 16 62 89 184 0 0 69 88 184 0 26 47 27 185 0 26 0 4 62 89 187 0 49 0 1 0 23 0 4 43 184 0 26 16 185 0 5 0 1 244 184 0 36 16 185 0 15 0 1 244 184 0 26 16 184 0 46 208 48 49 19 20 30 2 51 50 62 2 53 52 46 2 35 34 14 2 1 14 1 35 34 38 39 46 3 53 52 62 2 51 50 30 2 21 20 14 2 7 30 1 51 50 54 55 138 28 51 71 44 44 71 51 28 28 51 71 44 44 71 51 28 1 233 15 50 29 91 122 29 54 88 63 34 41 74 103 62 62 103 75 41 33 61 86 52 23 84 54 22 33 14 1 75 63 101 72 38 38 72 101 63 61 98 68 37 37 68 98 253 227 5 10 87 68 7 54 88 119 72 79 125 87 46 47 87 125 78 71 117 87 55 9 44 42 6 4 0 0 2 0 90 0 0 2 32 2 144 0 8 0 24 0 84 0 184 0 0 69 88 184 0 14 47 27 185 0 14 0 16 62 89 184 0 0 69 88 184 0 12 47 27 185 0 12 0 4 62 89 184 0 0 69 88 184 0 9 47 27 185 0 9 0 4 62 89 187 0 1 0 1 0 10 0 4 43 184 0 14 16 185 0 8 0 1 244 186 0 23 0 1 0 10 17 18 57 48 49 19 51 50 54 53 52 38 43 1 1 3 35 17 35 17 51 50 30 2 21 20 6 7 19 173 110 77 82 82 77 110 1 21 158 119 83 205 50 85 61 34 80 67 166 1 89 63 64 65 52 253 179 1 21 254 235 2 144 19 44 70 51 77 92 17 254 226 0 0 1 0 42 255 244 1 239 2 156 0 51 0 73 0 184 0 0 69 88 184 0 22 47 27 185 0 22 0 16 62 89 184 0 0 69 88 184 0 48 47 27 185 0 48 0 4 62 89 185 0 3 0 1 244 186 0 11 0 22 0 48 17 18 57 184 0 22 16 185 0 29 0 1 244 186 0 37 0 48 0 22 17 18 57 48 49 55 30 1 51 50 54 53 52 46 2 47 1 46 3 53 52 62 2 51 50 22 23 7 46 1 35 34 6 21 20 30 2 31 1 30 3 21 20 14 2 35 34 38 39 92 35 95 51 65 72 17 29 40 23 94 23 48 38 24 31 55 75 45 59 100 35 45 30 73 46 55 67 19 32 38 20 93 28 50 36 21 31 58 82 52 69 118 43 143 37 45 59 48 25 35 25 20 11 41 10 28 40 55 36 37 64 47 26 45 36 54 29 33 51 45 24 33 25 19 8 40 12 31 41 55 36 39 68 51 29 52 45 0 0 1 0 28 0 0 1 252 2 144 0 7 0 51 0 184 0 0 69 88 184 0 2 47 27 185 0 2 0 16 62 89 184 0 0 69 88 184 0 7 47 27 185 0 7 0 4 62 89 184 0 2 16 185 0 0 0 1 244 184 0 5 208 48 49 19 35 53 33 21 35 17 35 226 198 1 224 198 84 2 74 70 70 253 182 0 0 0 0 1 0 87 255 244 2 46 2 144 0 25 0 60 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 16 62 89 184 0 0 69 88 184 0 13 47 27 185 0 13 0 16 62 89 184 0 0 69 88 184 0 20 47 27 185 0 20 0 4 62 89 185 0 7 0 1 244 48 49 19 51 17 20 30 2 51 50 62 2 53 17 51 17 20 14 2 35 34 46 2 53 87 83 24 41 56 32 33 56 42 24 80 36 63 86 50 50 87 63 36 2 144 254 125 59 80 48 21 21 48 80 59 1 131 254 127 79 108 67 29 29 67 108 79 0 0 1 0 0 0 0 2 3 2 144 0 13 0 64 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 16 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 16 62 89 184 0 0 69 88 184 0 13 47 27 185 0 13 0 4 62 89 186 0 5 0 0 0 13 17 18 57 48 49 17 51 19 30 1 23 51 62 1 55 19 51 3 35 89 105 18 27 19 4 18 28 17 105 85 208 97 2 144 254 158 59 100 58 58 100 59 1 98 253 112 0 0 1 0 23 0 0 2 250 2 144 0 33 0 118 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 16 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 16 62 89 184 0 0 69 88 184 0 20 47 27 185 0 20 0 16 62 89 184 0 0 69 88 184 0 33 47 27 185 0 33 0 4 62 89 184 0 0 69 88 184 0 23 47 27 185 0 23 0 4 62 89 186 0 5 0 0 0 33 17 18 57 186 0 15 0 20 0 23 17 18 57 186 0 28 0 33 0 10 17 18 57 48 49 19 51 19 30 1 23 51 62 1 55 19 51 19 30 1 23 51 62 1 55 19 51 3 35 3 46 1 39 35 14 1 7 3 35 23 86 69 9 20 9 4 11 24 11 91 76 91 12 24 12 4 9 18 10 69 80 136 100 99 9 15 8 4 8 17 8 97 99 2 144 254 155 54 104 54 54 105 53 1 101 254 155 52 106 54 54 105 53 1 101 253 112 1 139 38 73 38 38 73 38 254 117 0 0 0 1 0 15 0 0 1 242 2 144 0 25 0 91 0 184 0 0 69 88 184 0 1 47 27 185 0 1 0 16 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 16 62 89 184 0 0 69 88 184 0 25 47 27 185 0 25 0 4 62 89 184 0 0 69 88 184 0 15 47 27 185 0 15 0 4 62 89 186 0 6 0 1 0 25 17 18 57 186 0 19 0 15 0 11 17 18 57 48 49 19 3 51 23 30 1 23 51 62 1 63 1 51 3 19 35 39 46 1 39 35 14 1 15 1 35 206 178 92 89 13 23 15 4 14 21 12 87 88 179 191 92 96 13 27 16 4 14 26 12 95 88 1 83 1 61 168 23 43 29 29 43 23 168 254 191 254 177 177 24 51 30 30 51 24 177 0 0 0 0 1 255 255 0 0 1 221 2 144 0 15 0 64 0 184 0 0 69 88 184 0 1 47 27 185 0 1 0 16 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 16 62 89 184 0 0 69 88 184 0 15 47 27 185 0 15 0 4 62 89 186 0 6 0 1 0 15 17 18 57 48 49 55 3 51 23 30 1 23 51 62 1 63 1 51 3 21 35 196 197 89 85 16 30 17 4 17 34 15 84 87 197 84 254 1 146 185 36 70 37 37 70 36 185 254 110 254 0 0 1 0 45 0 0 1 241 2 144 0 9 0 61 0 184 0 0 69 88 184 0 3 47 27 185 0 3 0 16 62 89 184 0 0 69 88 184 0 8 47 27 185 0 8 0 4 62 89 185 0 6 0 1 244 184 0 0 208 184 0 3 16 185 0 1 0 1 244 184 0 5 208 48 49 55 1 33 53 33 21 1 33 21 33 45 1 89 254 198 1 162 254 166 1 93 254 60 50 2 24 70 49 253 232 71 0 0 0 2 0 58 255 244 1 183 1 242 0 27 0 39 0 118 0 184 0 0 69 88 184 0 15 47 27 185 0 15 0 8 62 89 184 0 0 69 88 184 0 25 47 27 185 0 25 0 4 62 89 184 0 0 69 88 184 0 20 47 27 185 0 20 0 4 62 89 186 0 3 0 15 0 25 17 18 57 184 0 3 47 184 0 15 16 185 0 8 0 1 244 186 0 21 0 20 0 15 17 18 57 184 0 25 16 185 0 31 0 1 244 184 0 21 16 185 0 34 0 1 244 184 0 3 16 185 0 35 0 1 244 48 49 55 52 54 55 52 46 2 35 34 6 7 39 62 1 51 50 22 21 17 35 39 35 14 1 35 34 38 55 20 22 51 50 54 55 53 14 3 58 143 156 9 23 38 30 43 73 29 33 34 98 59 89 80 68 7 2 35 81 45 62 81 81 49 36 35 63 35 61 84 51 22 126 80 85 17 23 44 34 21 32 20 57 22 41 109 91 254 214 58 29 41 72 72 42 36 33 32 135 8 22 30 39 0 2 0 82 255 244 1 251 2 200 0 22 0 38 0 131 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 18 62 89 184 0 0 69 88 184 0 6 47 27 185 0 6 0 8 62 89 184 0 0 69 88 184 0 16 47 27 185 0 16 0 4 62 89 184 0 0 69 88 184 0 22 47 27 185 0 22 0 4 62 89 186 0 3 0 6 0 16 17 18 57 186 0 19 0 16 0 6 17 18 57 184 0 19 16 185 0 23 0 1 244 184 0 16 16 185 0 26 0 1 244 184 0 6 16 185 0 36 0 1 244 184 0 3 16 185 0 38 0 1 244 48 49 19 51 21 7 62 1 51 50 30 2 21 20 14 2 35 34 38 39 35 7 35 55 30 1 51 50 62 2 53 52 46 2 35 34 7 82 82 2 33 78 41 47 72 49 25 34 58 76 42 34 73 32 3 7 66 82 32 63 24 30 51 37 21 14 31 49 34 59 71 2 200 194 88 29 39 35 65 91 56 62 98 68 35 31 29 48 108 28 23 27 49 72 45 40 66 47 26 66 0 0 0 0 1 0 46 255 244 1 176 1 242 0 33 0 57 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 8 62 89 184 0 0 69 88 184 0 29 47 27 185 0 29 0 4 62 89 184 0 5 16 185 0 12 0 1 244 184 0 29 16 185 0 22 0 1 244 48 49 55 52 62 2 51 50 22 23 7 46 1 35 34 14 2 21 20 30 2 51 50 54 55 23 14 1 35 34 46 2 46 38 64 85 47 48 69 25 41 22 47 29 33 56 40 23 22 39 56 33 35 57 22 37 33 81 44 48 84 61 35 242 61 95 66 34 35 23 53 19 24 27 50 69 42 42 68 49 27 29 20 54 29 34 34 65 95 0 0 0 2 0 47 255 244 1 217 2 200 0 20 0 35 0 131 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 8 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 18 62 89 184 0 0 69 88 184 0 18 47 27 185 0 18 0 4 62 89 184 0 0 69 88 184 0 13 47 27 185 0 13 0 4 62 89 186 0 8 0 18 0 5 17 18 57 186 0 14 0 5 0 18 17 18 57 184 0 18 16 185 0 24 0 1 244 184 0 14 16 185 0 27 0 1 244 184 0 8 16 185 0 28 0 1 244 184 0 5 16 185 0 31 0 1 244 48 49 55 52 62 2 51 50 22 23 39 53 51 17 35 39 35 14 1 35 34 38 55 20 22 51 50 54 55 53 46 1 35 34 14 2 47 35 58 76 42 42 62 32 4 83 68 7 3 29 75 43 92 109 85 70 64 34 60 30 31 57 30 29 51 38 22 242 59 95 66 36 30 26 83 187 253 56 57 28 41 132 123 88 98 33 34 254 28 23 27 49 68 0 0 0 2 0 46 255 244 1 202 1 242 0 27 0 36 0 81 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 8 62 89 184 0 0 69 88 184 0 23 47 27 185 0 23 0 4 62 89 186 0 12 0 5 0 23 17 18 57 184 0 12 47 184 0 23 16 185 0 16 0 1 244 184 0 5 16 185 0 31 0 1 244 184 0 12 16 185 0 36 0 1 244 48 49 55 52 62 2 51 50 30 2 21 20 7 33 30 1 51 50 54 55 23 14 1 35 34 46 2 37 52 38 35 34 14 2 7 46 37 61 78 42 46 73 49 26 3 254 184 5 87 70 35 59 27 29 32 78 50 49 85 63 36 1 84 63 57 26 47 38 25 4 242 60 95 66 35 32 60 84 52 27 18 79 92 21 17 54 20 30 35 65 94 97 75 79 21 39 57 37 0 0 0 0 1 0 30 0 0 1 63 2 212 0 21 0 86 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 8 62 89 184 0 0 69 88 184 0 18 47 27 185 0 18 0 18 62 89 184 0 0 69 88 184 0 9 47 27 185 0 9 0 4 62 89 184 0 18 16 185 0 2 0 1 244 184 0 5 16 185 0 8 0 1 244 184 0 11 208 184 0 5 16 184 0 14 208 48 49 1 38 35 34 29 1 51 21 35 17 35 17 35 53 55 53 52 54 51 50 22 23 1 45 27 28 68 103 103 82 66 66 69 73 23 41 17 2 133 12 94 77 67 254 93 1 163 62 5 77 75 86 9 7 0 0 0 3 0 45 255 32 1 236 1 242 0 17 0 73 0 89 0 109 0 184 0 0 69 88 184 0 37 47 27 185 0 37 0 8 62 89 184 0 0 69 88 184 0 69 47 27 185 0 69 0 6 62 89 185 0 3 0 1 244 186 0 60 0 37 0 69 17 18 57 184 0 60 47 185 0 11 0 1 244 184 0 37 16 184 0 41 208 184 0 41 47 185 0 42 0 1 244 184 0 60 16 184 0 51 208 184 0 51 47 185 0 74 0 1 244 184 0 37 16 185 0 82 0 1 244 48 49 23 20 22 51 50 62 2 53 52 38 43 1 34 38 39 14 1 7 52 54 55 53 46 1 53 52 54 55 53 46 1 53 52 62 2 51 50 22 23 51 21 35 30 1 21 20 14 2 35 34 38 39 14 1 21 20 22 59 1 50 22 21 20 14 2 35 34 46 2 19 50 62 2 53 52 38 35 34 6 21 20 30 2 117 75 66 35 57 40 22 50 48 84 14 33 16 26 24 72 38 33 18 25 34 19 24 39 29 50 67 37 20 35 14 169 100 17 23 28 48 65 37 18 38 17 13 18 36 50 94 85 85 34 64 91 57 45 74 53 29 201 21 37 29 16 60 43 43 60 16 29 37 82 39 46 17 27 36 19 34 26 3 5 19 42 32 31 56 23 4 11 39 29 31 46 13 4 20 67 44 40 64 45 24 7 5 63 17 52 31 39 63 43 24 9 8 11 27 20 23 30 55 61 34 61 46 27 17 34 48 1 78 16 30 43 27 54 59 59 54 27 43 30 16 0 0 1 0 82 0 0 1 215 2 200 0 20 0 88 0 184 0 0 69 88 184 0 6 47 27 185 0 6 0 8 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 18 62 89 184 0 0 69 88 184 0 20 47 27 185 0 20 0 4 62 89 186 0 3 0 6 0 20 17 18 57 184 0 11 208 184 0 6 16 185 0 15 0 1 244 184 0 3 16 185 0 18 0 1 244 48 49 19 51 21 7 62 1 51 50 22 21 17 35 17 52 38 35 34 6 7 17 35 82 82 3 35 76 51 77 71 82 44 48 38 58 37 82 2 200 194 100 33 47 96 94 254 204 1 41 69 61 38 37 254 160 0 2 0 67 0 0 0 181 2 180 0 11 0 15 0 45 0 184 0 0 69 88 184 0 12 47 27 185 0 12 0 8 62 89 184 0 0 69 88 184 0 14 47 27 185 0 14 0 4 62 89 186 0 6 0 0 0 3 43 48 49 19 34 38 53 52 54 51 50 22 21 20 6 7 51 17 35 124 24 33 33 24 24 33 33 66 82 82 2 74 30 23 24 29 29 24 23 30 100 254 26 0 0 0 0 2 255 216 255 39 0 181 2 180 0 15 0 27 0 55 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 8 62 89 184 0 0 69 88 184 0 5 47 27 185 0 5 0 6 62 89 186 0 22 0 16 0 3 43 184 0 5 16 185 0 12 0 1 244 48 49 19 51 17 20 6 35 34 38 39 55 30 1 51 50 54 53 19 34 38 53 52 54 51 50 22 21 20 6 83 82 60 73 23 36 13 17 9 24 13 36 24 42 24 33 33 24 23 33 33 1 230 253 227 74 88 8 5 62 3 5 50 45 2 129 30 23 24 29 29 24 23 30 0 0 1 0 82 0 0 1 230 2 200 0 12 0 91 0 184 0 0 69 88 184 0 4 47 27 185 0 4 0 8 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 18 62 89 184 0 0 69 88 184 0 12 47 27 185 0 12 0 4 62 89 184 0 0 69 88 184 0 8 47 27 185 0 8 0 4 62 89 186 0 2 0 0 0 12 17 18 57 186 0 9 0 0 0 8 17 18 57 48 49 19 51 17 51 19 51 7 19 35 39 7 21 35 82 81 3 207 91 163 185 90 142 91 81 2 200 254 30 1 0 195 254 221 234 106 128 0 0 0 0 1 0 82 255 244 0 216 2 200 0 15 0 43 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 18 62 89 184 0 0 69 88 184 0 12 47 27 185 0 12 0 4 62 89 185 0 5 0 1 244 48 49 19 51 17 20 22 51 58 1 55 23 14 1 35 34 38 53 82 82 14 9 4 7 7 11 8 22 17 47 40 2 200 253 148 20 16 2 62 4 4 56 54 0 0 0 1 0 82 0 0 2 241 1 242 0 33 0 152 0 184 0 0 69 88 184 0 6 47 27 185 0 6 0 8 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 8 62 89 184 0 0 69 88 184 0 33 47 27 185 0 33 0 4 62 89 184 0 0 69 88 184 0 25 47 27 185 0 25 0 4 62 89 184 0 0 69 88 184 0 17 47 27 185 0 17 0 4 62 89 186 0 2 0 0 0 33 17 18 57 186 0 9 0 0 0 33 17 18 57 184 0 6 16 184 0 12 208 185 0 21 0 1 244 184 0 9 16 185 0 23 0 1 244 184 0 6 16 185 0 29 0 1 244 184 0 2 16 185 0 31 0 1 244 48 49 19 51 23 51 62 1 51 50 22 23 62 1 51 50 22 21 17 35 17 52 38 35 34 7 17 35 17 52 38 35 34 7 17 35 82 68 7 3 32 75 44 56 63 15 38 77 45 75 73 82 44 46 55 67 82 44 47 55 67 82 1 230 70 35 47 49 44 42 51 96 94 254 204 1 41 69 61 75 254 160 1 41 69 61 75 254 160 0 0 0 0 1 0 82 0 0 1 215 1 242 0 20 0 101 0 184 0 0 69 88 184 0 6 47 27 185 0 6 0 8 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 8 62 89 184 0 0 69 88 184 0 20 47 27 185 0 20 0 4 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 4 62 89 186 0 2 0 0 0 20 17 18 57 184 0 6 16 185 0 15 0 1 244 184 0 2 16 185 0 18 0 1 244 48 49 19 51 23 51 62 1 51 50 22 21 17 35 17 52 38 35 34 6 7 17 35 82 68 7 3 35 77 51 77 71 82 44 48 38 58 37 82 1 230 70 35 47 96 94 254 204 1 41 69 61 38 37 254 160 0 0 0 0 2 0 46 255 244 1 240 1 242 0 19 0 39 0 53 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 8 62 89 184 0 0 69 88 184 0 15 47 27 185 0 15 0 4 62 89 185 0 25 0 1 244 184 0 5 16 185 0 35 0 1 244 48 49 55 52 62 2 51 50 30 2 21 20 14 2 35 34 46 2 55 20 30 2 51 50 62 2 53 52 46 2 35 34 14 2 46 37 62 81 45 45 81 62 37 37 62 81 45 45 81 62 37 85 20 37 52 31 31 52 37 20 20 37 52 31 31 52 37 20 242 61 95 66 34 34 66 95 61 60 95 65 34 34 65 95 60 42 68 49 27 27 49 68 42 42 69 50 27 27 50 69 0 0 2 0 82 255 51 1 251 1 242 0 22 0 39 0 131 0 184 0 0 69 88 184 0 9 47 27 185 0 9 0 8 62 89 184 0 0 69 88 184 0 3 47 27 185 0 3 0 8 62 89 184 0 0 69 88 184 0 2 47 27 185 0 2 0 6 62 89 184 0 0 69 88 184 0 19 47 27 185 0 19 0 4 62 89 186 0 5 0 9 0 19 17 18 57 186 0 22 0 19 0 9 17 18 57 184 0 22 16 185 0 23 0 1 244 184 0 19 16 185 0 26 0 1 244 184 0 9 16 185 0 36 0 1 244 184 0 5 16 185 0 39 0 1 244 48 49 23 21 35 17 51 23 51 62 1 51 50 30 2 21 20 14 2 35 34 38 39 55 30 1 51 50 62 2 53 52 46 2 35 34 6 7 164 82 68 7 3 33 79 43 47 72 48 25 34 58 76 42 34 67 34 2 33 62 24 30 51 37 21 14 31 49 34 31 63 36 41 164 2 179 56 28 40 35 65 91 57 62 97 68 35 30 26 64 28 23 27 49 72 45 40 66 47 26 34 32 0 0 2 0 47 255 51 1 217 1 242 0 20 0 35 0 127 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 8 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 8 62 89 184 0 0 69 88 184 0 13 47 27 185 0 13 0 6 62 89 184 0 0 69 88 184 0 18 47 27 185 0 18 0 4 62 89 186 0 8 0 5 0 18 17 18 57 186 0 15 0 18 0 5 17 18 57 185 0 24 0 1 244 184 0 15 16 185 0 27 0 1 244 184 0 8 16 185 0 28 0 1 244 184 0 5 16 185 0 31 0 1 244 48 49 55 52 62 2 51 50 22 23 51 55 51 17 35 53 55 14 1 35 34 38 55 20 22 51 50 54 55 53 46 1 35 34 14 2 47 35 58 76 42 42 64 33 2 8 66 83 4 29 75 42 92 109 85 70 64 34 60 30 31 57 30 29 51 38 22 242 59 95 66 36 29 29 46 253 77 173 86 27 39 132 123 88 98 33 34 254 28 23 27 49 68 0 0 0 1 0 82 0 0 1 94 1 242 0 17 0 82 0 184 0 0 69 88 184 0 6 47 27 185 0 6 0 8 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 8 62 89 184 0 0 69 88 184 0 17 47 27 185 0 17 0 4 62 89 186 0 2 0 0 0 17 17 18 57 184 0 6 16 184 0 12 220 184 0 2 16 185 0 15 0 1 244 48 49 19 51 23 51 62 1 51 50 23 7 46 1 35 34 6 7 17 35 82 68 7 3 25 71 42 29 23 16 12 20 15 31 67 25 82 1 230 88 46 54 10 72 4 4 50 62 254 200 0 1 0 28 255 244 1 131 1 242 0 49 0 73 0 184 0 0 69 88 184 0 21 47 27 185 0 21 0 8 62 89 184 0 0 69 88 184 0 46 47 27 185 0 46 0 4 62 89 185 0 3 0 1 244 186 0 11 0 46 0 21 17 18 57 184 0 21 16 185 0 28 0 1 244 186 0 36 0 21 0 46 17 18 57 48 49 55 30 1 51 50 54 53 52 46 2 39 46 3 53 52 62 2 51 50 22 23 7 46 1 35 34 6 21 20 30 2 23 30 3 21 20 14 2 35 34 38 39 69 32 67 44 48 48 20 31 40 20 26 52 41 26 23 43 62 39 46 77 28 39 25 54 32 46 43 18 30 39 21 26 53 42 27 23 45 67 43 52 94 35 110 26 32 44 32 19 28 21 16 8 9 23 33 44 31 29 51 37 21 32 23 52 19 24 42 28 17 25 19 15 8 10 22 33 48 34 30 52 40 23 38 29 0 0 0 0 1 0 24 255 244 1 69 2 110 0 25 0 69 0 184 0 0 69 88 184 0 6 47 27 185 0 6 0 8 62 89 184 0 0 69 88 184 0 20 47 27 185 0 20 0 4 62 89 184 0 6 16 185 0 9 0 1 244 184 0 0 208 184 0 6 16 184 0 3 208 184 0 20 16 185 0 13 0 1 244 48 49 19 35 53 63 1 51 21 51 21 35 17 20 22 51 50 54 55 23 14 1 35 34 46 2 53 96 72 76 10 69 131 131 33 42 13 30 12 16 20 47 23 39 53 33 14 1 163 62 5 136 136 67 254 242 45 49 8 5 62 7 11 24 42 60 36 0 1 0 75 255 244 1 206 1 230 0 20 0 101 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 8 62 89 184 0 0 69 88 184 0 9 47 27 185 0 9 0 8 62 89 184 0 0 69 88 184 0 17 47 27 185 0 17 0 4 62 89 184 0 0 69 88 184 0 12 47 27 185 0 12 0 4 62 89 184 0 17 16 185 0 5 0 1 244 186 0 13 0 9 0 12 17 18 57 184 0 13 16 185 0 8 0 1 244 48 49 19 51 17 20 22 51 50 54 55 17 51 17 35 39 35 14 1 35 34 38 53 75 83 43 48 38 58 35 82 68 7 3 34 75 51 78 71 1 230 254 215 69 61 39 43 1 89 254 26 76 40 48 96 94 0 0 0 0 1 0 12 0 0 1 199 1 230 0 13 0 64 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 8 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 8 62 89 184 0 0 69 88 184 0 13 47 27 185 0 13 0 4 62 89 186 0 5 0 0 0 13 17 18 57 48 49 19 51 19 30 1 23 51 62 1 55 19 51 3 35 12 85 92 11 23 11 4 11 22 11 92 81 172 96 1 230 254 236 36 72 35 35 72 36 1 20 254 26 0 1 0 24 0 0 2 182 1 230 0 33 0 118 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 8 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 8 62 89 184 0 0 69 88 184 0 20 47 27 185 0 20 0 8 62 89 184 0 0 69 88 184 0 33 47 27 185 0 33 0 4 62 89 184 0 0 69 88 184 0 23 47 27 185 0 23 0 4 62 89 186 0 5 0 33 0 0 17 18 57 186 0 15 0 23 0 20 17 18 57 186 0 28 0 0 0 32 17 18 57 48 49 19 51 19 30 1 23 51 62 1 55 19 51 19 30 1 23 51 62 1 55 19 51 3 35 3 46 1 39 35 14 1 7 3 35 24 84 72 8 14 7 4 8 16 9 75 80 76 9 17 8 4 8 14 8 71 78 130 100 70 9 15 9 4 8 16 10 68 96 1 230 254 231 35 66 34 34 67 34 1 25 254 231 35 66 34 34 66 35 1 25 254 26 1 5 35 68 37 37 69 35 254 252 0 0 0 1 0 14 0 0 1 176 1 230 0 25 0 91 0 184 0 0 69 88 184 0 1 47 27 185 0 1 0 8 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 8 62 89 184 0 0 69 88 184 0 25 47 27 185 0 25 0 4 62 89 184 0 0 69 88 184 0 15 47 27 185 0 15 0 4 62 89 186 0 6 0 11 0 15 17 18 57 186 0 20 0 1 0 25 17 18 57 48 49 55 39 51 23 30 1 23 51 62 1 63 1 51 7 23 35 39 46 1 39 35 14 1 15 1 35 173 147 89 65 11 24 13 4 11 22 11 59 86 147 158 89 71 13 26 14 4 13 24 12 66 86 254 232 107 20 41 20 20 41 20 107 241 245 113 22 44 21 21 43 23 113 0 0 0 0 1 0 12 255 47 1 199 1 230 0 29 0 70 0 184 0 0 69 88 184 0 8 47 27 185 0 8 0 8 62 89 184 0 0 69 88 184 0 18 47 27 185 0 18 0 8 62 89 184 0 0 69 88 184 0 25 47 27 185 0 25 0 6 62 89 185 0 3 0 1 244 186 0 13 0 8 0 25 17 18 57 48 49 23 30 1 51 50 54 63 1 3 51 19 30 1 23 51 62 1 55 19 51 3 14 3 35 34 38 39 55 49 8 20 9 42 53 15 11 195 85 99 11 25 11 4 11 20 10 87 80 183 13 32 44 56 37 17 28 12 16 134 2 5 59 45 36 1 231 254 243 32 71 34 33 72 32 1 13 253 242 36 62 45 26 5 5 65 0 0 0 0 1 0 31 0 0 1 143 1 230 0 9 0 61 0 184 0 0 69 88 184 0 3 47 27 185 0 3 0 8 62 89 184 0 0 69 88 184 0 8 47 27 185 0 8 0 4 62 89 185 0 6 0 1 244 184 0 0 208 184 0 3 16 185 0 1 0 1 244 184 0 5 208 48 49 55 1 35 53 33 21 1 33 21 33 31 1 0 228 1 76 255 0 1 8 254 144 44 1 119 67 44 254 137 67 0 0 0 255 255 0 3 0 0 2 29 3 50 2 38 0 4 0 0 0 7 2 247 1 15 0 0 255 255 0 3 0 0 2 29 3 50 2 38 0 4 0 0 0 7 2 249 1 15 0 0 255 255 0 3 0 0 2 29 3 50 2 38 0 4 0 0 0 7 2 251 1 15 0 0 255 255 0 3 0 0 2 29 3 51 2 38 0 4 0 0 0 7 2 253 1 15 0 0 255 255 0 3 0 0 2 29 3 45 2 38 0 4 0 0 0 7 3 5 1 15 0 0 255 255 0 3 0 0 2 29 3 18 2 38 0 4 0 0 0 7 2 255 1 15 0 0 255 255 0 3 0 0 2 29 3 50 2 38 0 4 0 0 0 7 3 1 1 15 0 0 255 255 0 3 0 0 2 29 3 107 2 38 0 4 0 0 0 7 3 9 1 15 0 0 255 255 0 3 0 0 2 29 3 50 2 38 0 4 0 0 0 7 3 13 1 15 0 0 255 255 0 3 255 50 2 29 2 144 2 38 0 4 0 0 0 7 3 19 1 15 0 0 255 255 0 3 0 0 2 29 3 104 2 38 0 4 0 0 0 7 3 7 1 15 0 0 255 255 0 3 0 0 2 29 3 113 2 38 0 4 0 0 0 7 3 37 1 15 0 0 255 255 0 3 0 0 2 29 3 113 2 38 0 4 0 0 0 7 3 39 1 15 0 0 255 255 0 3 0 0 2 29 3 138 2 38 0 4 0 0 0 7 3 41 1 15 0 0 255 255 0 3 0 0 2 29 3 171 2 38 0 4 0 0 0 7 3 43 1 15 0 0 255 255 0 3 255 50 2 29 3 50 2 38 0 4 0 0 0 39 2 251 1 15 0 0 0 7 3 19 1 15 0 0 255 255 0 3 0 0 2 29 3 139 2 38 0 4 0 0 0 7 3 45 1 15 0 0 255 255 0 3 0 0 2 29 3 139 2 38 0 4 0 0 0 7 3 47 1 15 0 0 255 255 0 3 0 0 2 29 3 184 2 38 0 4 0 0 0 7 3 49 1 15 0 0 255 255 0 3 0 0 2 29 3 171 2 38 0 4 0 0 0 7 3 51 1 15 0 0 255 255 0 3 255 50 2 29 3 50 2 38 0 4 0 0 0 39 3 1 1 15 0 0 0 7 3 19 1 15 0 0 0 2 0 3 255 44 2 60 2 144 0 9 0 37 0 109 0 184 0 0 69 88 184 0 27 47 27 185 0 27 0 16 62 89 184 0 0 69 88 184 0 21 47 27 185 0 21 0 4 62 89 184 0 0 69 88 184 0 25 47 27 185 0 25 0 4 62 89 184 0 0 69 88 184 0 29 47 27 185 0 29 0 4 62 89 186 0 35 0 13 0 3 43 186 0 5 0 25 0 27 17 18 57 186 0 24 0 25 0 27 17 18 57 184 0 24 47 185 0 9 0 1 244 48 49 1 39 46 1 39 35 14 1 15 1 1 14 1 35 34 38 53 52 62 2 55 35 39 35 7 35 19 51 19 14 1 21 20 22 51 50 55 1 113 31 18 32 16 4 15 32 18 31 1 144 15 45 20 40 56 14 22 26 13 19 62 239 63 85 222 94 222 35 45 28 18 23 19 1 11 100 55 109 57 57 109 55 100 254 61 11 17 44 43 20 38 32 26 9 200 200 2 144 253 112 14 62 31 23 23 14 0 0 2 0 8 0 0 3 5 2 144 0 5 0 21 0 124 0 184 0 0 69 88 184 0 13 47 27 185 0 13 0 16 62 89 184 0 0 69 88 184 0 12 47 27 185 0 12 0 4 62 89 184 0 0 69 88 184 0 8 47 27 185 0 8 0 4 62 89 186 0 2 0 13 0 12 17 18 57 186 0 9 0 13 0 12 17 18 57 184 0 9 47 185 0 5 0 1 244 184 0 8 16 185 0 6 0 1 244 184 0 13 16 185 0 15 0 1 244 186 0 20 0 13 0 8 17 18 57 184 0 20 47 185 0 18 0 1 244 48 49 1 17 35 6 15 1 5 21 33 53 35 7 35 1 33 21 33 21 51 21 35 21 1 145 4 53 54 61 2 32 254 140 206 99 88 1 88 1 155 254 234 232 232 1 2 1 76 107 107 118 187 71 191 191 2 144 70 206 71 238 255 255 0 52 255 43 2 27 2 156 2 38 0 6 0 0 0 7 3 23 1 87 0 0 255 255 0 52 255 244 2 27 3 50 2 38 0 6 0 0 0 7 2 249 1 74 0 0 255 255 0 52 255 244 2 27 3 50 2 38 0 6 0 0 0 7 2 251 1 74 0 0 255 255 0 52 255 244 2 27 3 50 2 38 0 6 0 0 0 7 3 13 1 74 0 0 255 255 0 52 255 244 2 27 3 53 2 38 0 6 0 0 0 7 3 3 1 74 0 0 255 255 0 90 0 0 2 52 3 50 2 38 0 7 0 0 0 7 3 13 1 51 0 0 255 255 0 90 255 50 2 52 2 144 2 38 0 7 0 0 0 7 3 19 1 48 0 0 255 255 0 90 255 85 2 52 2 144 2 38 0 7 0 0 0 7 3 27 1 48 0 0 255 255 0 33 0 0 2 74 2 144 2 6 0 227 0 0 255 255 0 90 0 0 1 222 3 50 2 38 0 8 0 0 0 7 2 247 1 28 0 0 255 255 0 90 0 0 1 222 3 50 2 38 0 8 0 0 0 7 2 249 1 28 0 0 255 255 0 90 0 0 1 222 3 50 2 38 0 8 0 0 0 7 2 251 1 28 0 0 255 255 0 90 0 0 1 222 3 50 2 38 0 8 0 0 0 7 3 13 1 28 0 0 255 255 0 90 0 0 1 222 3 45 2 38 0 8 0 0 0 7 3 5 1 28 0 0 255 255 0 90 0 0 1 222 3 18 2 38 0 8 0 0 0 7 2 255 1 28 0 0 255 255 0 90 0 0 1 222 3 50 2 38 0 8 0 0 0 7 3 1 1 28 0 0 255 255 0 90 0 0 1 222 3 53 2 38 0 8 0 0 0 7 3 3 1 28 0 0 255 255 0 90 255 50 1 222 2 144 2 38 0 8 0 0 0 7 3 19 1 39 0 0 255 255 0 90 0 0 1 222 3 104 2 38 0 8 0 0 0 7 3 7 1 28 0 0 255 255 0 90 0 0 1 222 3 51 2 38 0 8 0 0 0 7 2 253 1 28 0 0 255 255 0 90 0 0 2 6 3 113 2 38 0 8 0 0 0 7 3 37 1 28 0 0 255 255 0 90 0 0 1 222 3 113 2 38 0 8 0 0 0 7 3 39 1 28 0 0 255 255 0 90 0 0 1 235 3 138 2 38 0 8 0 0 0 7 3 41 1 28 0 0 255 255 0 90 0 0 1 222 3 171 2 38 0 8 0 0 0 7 3 43 1 28 0 0 255 255 0 90 255 50 1 222 3 50 2 38 0 8 0 0 0 39 2 251 1 28 0 0 0 7 3 19 1 39 0 0 0 1 0 90 255 44 1 238 2 144 0 32 0 102 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 16 62 89 184 0 0 69 88 184 0 32 47 27 185 0 32 0 4 62 89 184 0 0 69 88 184 0 25 47 27 185 0 25 0 6 62 89 184 0 0 16 185 0 2 0 1 244 186 0 6 0 0 0 32 17 18 57 184 0 6 47 185 0 4 0 1 244 184 0 32 16 185 0 9 0 1 244 184 0 25 16 184 0 19 220 48 49 19 33 21 33 21 51 21 35 21 33 21 35 14 3 21 20 22 51 50 55 23 14 1 35 34 38 53 52 54 55 33 90 1 122 254 217 249 249 1 49 3 17 33 26 16 30 18 21 19 23 14 46 20 40 56 47 28 254 209 2 144 70 206 71 238 71 2 19 29 37 20 23 23 14 45 11 17 44 43 42 65 18 0 0 255 255 0 52 255 244 2 38 3 50 2 38 0 10 0 0 0 7 2 251 1 97 0 0 255 255 0 52 255 244 2 38 3 50 2 38 0 10 0 0 0 7 3 1 1 97 0 0 255 255 0 52 255 244 2 38 3 53 2 38 0 10 0 0 0 7 3 3 1 97 0 0 255 255 0 52 255 40 2 38 2 156 2 38 0 10 0 0 0 7 3 21 1 92 0 0 255 255 0 52 255 244 2 38 3 50 2 38 0 10 0 0 0 7 3 13 1 97 0 0 255 255 0 52 255 244 2 38 3 18 2 38 0 10 0 0 0 7 2 255 1 97 0 0 255 255 0 52 255 244 2 38 3 51 2 38 0 10 0 0 0 7 2 253 1 97 0 0 255 255 0 90 0 0 2 50 3 50 2 38 0 11 0 0 0 7 2 251 1 70 0 0 255 255 0 90 255 50 2 50 2 144 2 38 0 11 0 0 0 7 3 19 1 70 0 0 255 255 0 90 255 50 2 50 2 144 2 38 0 11 0 0 0 7 3 26 1 70 0 0 0 2 0 32 0 0 2 142 2 144 0 3 0 23 0 129 0 184 0 0 69 88 184 0 17 47 27 185 0 17 0 16 62 89 184 0 0 69 88 184 0 20 47 27 185 0 20 0 16 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 4 62 89 184 0 0 69 88 184 0 7 47 27 185 0 7 0 4 62 89 186 0 9 0 10 0 17 17 18 57 184 0 9 47 185 0 2 0 1 244 184 0 1 220 184 0 5 208 184 0 1 16 184 0 12 208 184 0 1 16 185 0 18 0 1 244 184 0 15 208 184 0 18 16 184 0 22 208 48 49 1 33 21 33 55 35 17 35 17 33 17 35 17 35 53 55 53 51 21 33 53 51 21 51 1 242 254 207 1 49 156 72 84 254 207 83 78 78 83 1 49 84 72 1 236 111 111 254 20 1 53 254 203 1 236 42 5 117 117 117 117 0 0 255 255 0 0 0 0 0 182 3 50 2 38 0 12 0 0 0 7 2 247 0 131 0 0 255 255 0 80 0 0 1 6 3 50 2 38 0 12 0 0 0 7 2 249 0 131 0 0 255 255 255 251 0 0 1 11 3 50 2 38 0 12 0 0 0 7 2 251 0 131 0 0 255 255 255 242 0 0 1 20 3 51 2 38 0 12 0 0 0 7 2 253 0 131 0 0 255 255 255 252 0 0 1 10 3 45 2 38 0 12 0 0 0 7 3 5 0 131 0 0 255 255 0 7 0 0 0 255 3 18 2 38 0 12 0 0 0 7 2 255 0 131 0 0 255 255 0 74 0 0 0 188 3 53 2 38 0 12 0 0 0 7 3 3 0 131 0 0 255 255 255 251 0 0 1 11 3 50 2 38 0 12 0 0 0 7 3 13 0 131 0 0 255 255 0 67 0 0 0 214 3 104 2 38 0 12 0 0 0 7 3 7 0 131 0 0 255 255 0 78 255 50 0 186 2 144 2 38 0 12 0 0 0 7 3 19 0 132 0 0 0 1 0 43 255 44 0 219 2 144 0 21 0 75 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 16 62 89 184 0 0 69 88 184 0 21 47 27 185 0 21 0 4 62 89 184 0 0 69 88 184 0 2 47 27 185 0 2 0 4 62 89 184 0 0 69 88 184 0 14 47 27 185 0 14 0 6 62 89 184 0 8 220 48 49 19 51 17 14 1 21 20 22 51 50 55 23 14 1 35 34 38 53 52 54 55 35 90 83 31 34 30 17 22 19 23 15 45 20 40 56 43 24 20 2 144 253 112 24 52 31 23 23 14 45 11 17 44 43 43 60 22 0 0 255 255 0 31 255 244 1 228 3 50 2 38 0 13 0 0 0 7 2 251 1 92 0 0 255 255 0 90 255 40 2 63 2 144 2 38 0 14 0 0 0 7 3 21 1 69 0 0 255 255 0 83 0 0 1 204 3 50 2 38 0 15 0 0 0 7 2 249 0 134 0 0 255 255 0 90 0 0 1 204 2 215 2 38 0 15 0 0 0 7 3 52 1 103 255 223 255 255 0 90 255 40 1 204 2 144 2 38 0 15 0 0 0 7 3 21 1 32 0 0 255 255 0 90 0 0 1 204 2 144 2 38 0 15 0 0 0 7 1 253 0 252 1 19 255 255 0 90 255 50 1 204 2 144 2 38 0 15 0 0 0 7 3 19 1 32 0 0 255 255 0 10 255 50 1 204 3 18 2 38 0 15 0 0 0 39 2 255 0 134 0 0 0 7 3 19 1 32 0 0 255 255 0 90 255 85 1 204 2 144 2 38 0 15 0 0 0 7 3 27 1 32 0 0 0 1 0 13 0 0 1 209 2 144 0 13 0 77 0 184 0 0 69 88 184 0 8 47 27 185 0 8 0 16 62 89 184 0 0 69 88 184 0 2 47 27 185 0 2 0 4 62 89 186 0 3 0 2 0 8 17 18 57 184 0 3 47 184 0 6 220 184 0 9 208 184 0 3 16 184 0 12 208 184 0 2 16 185 0 13 0 1 244 48 49 37 21 33 53 7 53 55 17 51 17 55 21 7 21 1 209 254 142 82 82 84 185 185 71 71 240 46 67 47 1 92 254 201 100 68 99 207 255 255 0 90 255 50 2 125 2 144 2 38 0 16 0 0 0 7 3 19 1 108 0 0 255 255 0 90 0 0 2 45 3 50 2 38 0 17 0 0 0 7 2 249 1 70 0 0 255 255 0 90 0 0 2 45 3 50 2 38 0 17 0 0 0 7 3 13 1 70 0 0 255 255 0 90 0 0 2 45 3 51 2 38 0 17 0 0 0 7 2 253 1 70 0 0 255 255 0 90 255 40 2 45 2 144 2 38 0 17 0 0 0 7 3 21 1 72 0 0 255 255 0 90 0 0 2 45 3 53 2 38 0 17 0 0 0 7 3 3 1 70 0 0 255 255 0 90 255 50 2 45 2 144 2 38 0 17 0 0 0 7 3 19 1 72 0 0 255 255 0 90 255 85 2 45 2 144 2 38 0 17 0 0 0 7 3 27 1 72 0 0 255 255 0 52 255 244 2 101 3 50 2 38 0 18 0 0 0 7 2 247 1 76 0 0 255 255 0 52 255 244 2 101 3 50 2 38 0 18 0 0 0 7 2 249 1 76 0 0 255 255 0 52 255 244 2 101 3 50 2 38 0 18 0 0 0 7 2 251 1 76 0 0 255 255 0 52 255 244 2 101 3 51 2 38 0 18 0 0 0 7 2 253 1 76 0 0 255 255 0 52 255 244 2 101 3 45 2 38 0 18 0 0 0 7 3 5 1 76 0 0 255 255 0 52 255 244 2 101 3 18 2 38 0 18 0 0 0 7 2 255 1 76 0 0 255 255 0 52 255 244 2 101 3 50 2 38 0 18 0 0 0 7 3 11 1 76 0 0 255 255 0 52 255 244 2 101 3 50 2 38 0 18 0 0 0 7 3 13 1 76 0 0 255 255 0 52 255 50 2 101 2 156 2 38 0 18 0 0 0 7 3 19 1 76 0 0 255 255 0 52 255 244 2 101 3 104 2 38 0 18 0 0 0 7 3 7 1 76 0 0 255 255 0 52 255 244 2 101 3 113 2 38 0 18 0 0 0 7 3 37 1 76 0 0 255 255 0 52 255 244 2 101 3 113 2 38 0 18 0 0 0 7 3 39 1 76 0 0 255 255 0 52 255 244 2 101 3 138 2 38 0 18 0 0 0 7 3 41 1 76 0 0 255 255 0 52 255 244 2 101 3 171 2 38 0 18 0 0 0 7 3 43 1 76 0 0 255 255 0 52 255 50 2 101 3 50 2 38 0 18 0 0 0 39 2 251 1 76 0 0 0 7 3 19 1 76 0 0 0 3 0 50 255 226 2 107 2 174 0 11 0 21 0 48 0 133 0 184 0 0 69 88 184 0 44 47 27 185 0 44 0 16 62 89 184 0 0 69 88 184 0 30 47 27 185 0 30 0 4 62 89 186 0 0 0 30 0 44 17 18 57 185 0 3 0 1 244 186 0 11 0 44 0 30 17 18 57 186 0 12 0 44 0 30 17 18 57 184 0 44 16 185 0 14 0 1 244 186 0 21 0 30 0 44 17 18 57 186 0 22 0 44 0 30 17 18 57 186 0 33 0 30 0 44 17 18 57 186 0 36 0 30 0 44 17 18 57 186 0 46 0 44 0 30 17 18 57 48 49 55 30 1 51 50 62 2 53 52 38 47 1 38 35 34 14 2 21 20 23 1 30 1 21 20 14 2 35 34 38 39 7 39 55 46 1 53 52 62 2 51 50 23 55 23 208 25 64 38 44 71 51 28 17 16 34 51 76 44 72 51 28 34 1 120 31 34 41 75 103 61 52 89 35 63 46 70 32 34 41 75 103 62 104 71 63 46 116 26 29 38 71 99 62 48 80 32 50 54 37 68 98 61 96 68 1 138 43 115 72 79 127 89 48 33 32 83 36 91 44 118 72 79 125 87 46 63 81 35 0 2 0 52 0 0 3 30 2 144 0 18 0 27 0 85 0 184 0 0 69 88 184 0 3 47 27 185 0 3 0 16 62 89 184 0 0 69 88 184 0 14 47 27 185 0 14 0 4 62 89 184 0 3 16 185 0 24 0 1 244 184 0 5 208 186 0 10 0 3 0 14 17 18 57 184 0 10 47 185 0 8 0 1 244 184 0 14 16 185 0 23 0 1 244 184 0 12 208 48 49 19 52 54 51 33 21 33 21 51 21 35 21 33 21 33 34 46 2 55 20 22 59 1 17 35 34 6 52 168 153 1 159 254 234 232 232 1 32 254 83 75 117 82 43 86 122 119 48 48 119 122 1 75 157 168 70 206 71 238 71 45 85 123 78 126 137 2 8 132 0 0 0 2 0 54 255 244 2 103 3 5 0 19 0 52 0 71 0 184 0 0 69 88 184 0 44 47 27 185 0 44 0 16 62 89 184 0 0 69 88 184 0 34 47 27 185 0 34 0 4 62 89 185 0 0 0 1 244 184 0 44 16 185 0 10 0 1 244 186 0 26 0 44 0 10 17 18 57 184 0 26 16 184 0 46 220 48 49 37 50 62 2 53 52 46 2 35 34 14 2 21 20 30 2 1 30 1 21 20 6 7 30 1 21 20 14 2 35 34 46 2 53 52 62 2 51 50 23 62 1 53 52 38 39 1 79 44 71 51 28 28 51 71 44 44 72 51 28 28 51 72 1 44 10 13 55 47 48 55 41 75 103 61 62 103 75 41 41 75 103 62 72 58 42 39 8 6 61 38 71 99 62 61 98 68 37 37 68 98 61 62 99 71 38 2 200 14 32 19 43 51 11 44 137 91 79 127 89 48 48 89 127 79 79 125 87 46 32 8 31 28 11 20 10 0 255 255 0 54 255 244 2 103 3 50 2 38 0 162 0 0 0 7 2 249 1 76 0 0 255 255 0 54 255 244 2 103 3 50 2 38 0 162 0 0 0 7 2 247 1 76 0 0 255 255 0 54 255 244 2 103 3 104 2 38 0 162 0 0 0 7 3 7 1 76 0 0 255 255 0 54 255 244 2 103 3 51 2 38 0 162 0 0 0 7 2 253 1 76 0 0 255 255 0 54 255 50 2 103 3 5 2 38 0 162 0 0 0 7 3 19 1 76 0 0 0 2 0 52 255 44 2 101 2 156 0 38 0 58 0 90 0 184 0 0 69 88 184 0 13 47 27 185 0 13 0 16 62 89 184 0 0 69 88 184 0 3 47 27 185 0 3 0 4 62 89 184 0 0 69 88 184 0 36 47 27 185 0 36 0 6 62 89 184 0 3 16 184 0 23 208 184 0 36 16 184 0 29 220 184 0 3 16 185 0 39 0 1 244 184 0 13 16 185 0 49 0 1 244 48 49 5 52 54 55 46 3 53 52 62 2 51 50 30 2 21 20 14 2 7 14 1 21 20 22 51 50 54 55 23 14 1 35 34 38 55 50 62 2 53 52 46 2 35 34 14 2 21 20 30 2 1 10 35 26 63 102 72 38 41 74 103 62 62 103 75 41 27 53 76 49 41 37 30 18 12 19 9 23 14 46 20 40 55 66 44 71 51 28 28 51 71 44 44 71 51 28 28 51 71 125 33 59 22 1 50 89 125 77 79 125 87 46 47 87 125 78 67 106 82 61 22 18 56 26 23 23 7 7 45 11 17 44 229 38 71 99 62 61 98 68 37 37 68 98 61 62 99 71 38 0 255 255 0 90 0 0 2 32 3 50 2 38 0 21 0 0 0 7 2 249 1 38 0 0 255 255 0 90 0 0 2 32 3 50 2 38 0 21 0 0 0 7 3 13 1 38 0 0 255 255 0 90 255 40 2 32 2 144 2 38 0 21 0 0 0 7 3 21 1 53 0 0 255 255 0 90 255 50 2 32 2 144 2 38 0 21 0 0 0 7 3 19 1 53 0 0 255 255 0 90 255 50 2 32 3 18 2 38 0 21 0 0 0 39 2 255 1 38 0 0 0 7 3 19 1 53 0 0 255 255 0 90 255 85 2 32 2 144 2 38 0 21 0 0 0 7 3 27 1 53 0 0 255 255 0 42 255 244 1 239 3 50 2 38 0 22 0 0 0 7 2 249 1 23 0 0 255 255 0 42 255 244 1 239 3 50 2 38 0 22 0 0 0 7 2 251 1 23 0 0 255 255 0 42 255 244 1 239 3 50 2 38 0 22 0 0 0 7 3 13 1 23 0 0 255 255 0 42 255 43 1 239 2 156 2 38 0 22 0 0 0 7 3 23 1 17 0 0 255 255 0 42 255 40 1 239 2 156 2 38 0 22 0 0 0 7 3 21 1 17 0 0 255 255 0 42 255 244 1 239 3 53 2 38 0 22 0 0 0 7 3 3 1 23 0 0 255 255 0 42 255 50 1 239 2 156 2 38 0 22 0 0 0 7 3 19 1 17 0 0 0 1 0 91 255 244 2 112 2 156 0 40 0 90 0 184 0 0 69 88 184 0 3 47 27 185 0 3 0 16 62 89 184 0 0 69 88 184 0 40 47 27 185 0 40 0 4 62 89 184 0 0 69 88 184 0 15 47 27 185 0 15 0 4 62 89 186 0 30 0 3 0 15 17 18 57 186 0 7 0 30 0 31 17 18 57 185 0 22 0 1 244 184 0 3 16 185 0 35 0 1 244 48 49 19 52 54 51 50 22 23 7 30 1 21 20 14 2 35 34 38 39 55 30 1 51 50 54 53 52 46 2 47 1 55 46 1 35 34 6 21 17 35 91 134 122 84 106 27 138 105 93 27 50 70 43 58 92 31 48 29 60 37 53 58 17 44 75 57 5 137 17 65 51 80 89 84 1 161 118 133 84 70 152 21 98 72 39 67 49 28 42 34 54 32 28 63 50 23 42 36 28 10 54 153 34 48 95 102 254 110 0 255 255 0 28 0 0 1 252 3 50 2 38 0 23 0 0 0 7 3 13 1 11 0 0 255 255 0 28 255 43 1 252 2 144 2 38 0 23 0 0 0 7 3 23 1 8 0 0 255 255 0 28 255 40 1 252 2 144 2 38 0 23 0 0 0 7 3 21 1 13 0 0 255 255 0 28 255 50 1 252 2 144 2 38 0 23 0 0 0 7 3 19 1 13 0 0 255 255 0 28 255 85 1 252 2 144 2 38 0 23 0 0 0 7 3 27 1 13 0 0 255 255 0 87 255 244 2 46 3 50 2 38 0 24 0 0 0 7 2 247 1 66 0 0 255 255 0 87 255 244 2 46 3 50 2 38 0 24 0 0 0 7 2 249 1 66 0 0 255 255 0 87 255 244 2 46 3 50 2 38 0 24 0 0 0 7 2 251 1 66 0 0 255 255 0 87 255 244 2 46 3 51 2 38 0 24 0 0 0 7 2 253 1 66 0 0 255 255 0 87 255 244 2 46 3 45 2 38 0 24 0 0 0 7 3 5 1 66 0 0 255 255 0 87 255 244 2 46 3 18 2 38 0 24 0 0 0 7 2 255 1 66 0 0 255 255 0 87 255 244 2 46 3 50 2 38 0 24 0 0 0 7 3 1 1 66 0 0 255 255 0 87 255 244 2 46 3 107 2 38 0 24 0 0 0 7 3 9 1 66 0 0 255 255 0 87 255 244 2 46 3 50 2 38 0 24 0 0 0 7 3 11 1 66 0 0 255 255 0 87 255 244 2 46 3 50 2 38 0 24 0 0 0 7 3 13 1 66 0 0 255 255 0 87 255 244 2 46 3 139 2 38 0 24 0 0 0 7 3 29 1 66 0 0 255 255 0 87 255 244 2 46 3 182 2 38 0 24 0 0 0 7 3 31 1 66 0 0 255 255 0 87 255 244 2 46 3 182 2 38 0 24 0 0 0 7 3 33 1 66 0 0 255 255 0 87 255 244 2 46 3 182 2 38 0 24 0 0 0 7 3 35 1 66 0 0 255 255 0 87 255 50 2 46 2 144 2 38 0 24 0 0 0 7 3 19 1 66 0 0 255 255 0 87 255 244 2 46 3 104 2 38 0 24 0 0 0 7 3 7 1 66 0 0 0 1 0 87 255 44 2 46 2 144 0 45 0 97 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 16 62 89 184 0 0 69 88 184 0 13 47 27 185 0 13 0 16 62 89 184 0 0 69 88 184 0 40 47 27 185 0 40 0 4 62 89 184 0 0 69 88 184 0 32 47 27 185 0 32 0 6 62 89 184 0 40 16 185 0 7 0 1 244 184 0 40 16 184 0 20 208 184 0 32 16 184 0 26 220 48 49 19 51 17 20 30 2 51 50 62 2 53 17 51 17 20 14 2 7 14 1 21 20 22 51 50 55 23 14 1 35 34 38 53 52 62 2 55 46 3 53 87 83 24 41 56 32 33 56 42 24 80 23 42 59 36 39 40 30 18 21 19 23 14 46 20 40 56 13 19 23 9 51 85 61 34 2 144 254 125 59 80 48 21 21 48 80 59 1 131 254 127 66 91 63 41 17 19 56 25 23 23 14 45 11 17 44 43 21 33 28 23 9 1 32 67 106 76 0 1 0 87 255 244 2 156 3 25 0 40 0 72 0 184 0 0 69 88 184 0 20 47 27 185 0 20 0 16 62 89 184 0 0 69 88 184 0 33 47 27 185 0 33 0 16 62 89 184 0 0 69 88 184 0 14 47 27 185 0 14 0 4 62 89 184 0 33 16 184 0 8 220 184 0 14 16 185 0 27 0 1 244 48 49 1 30 1 21 20 14 2 7 17 20 14 2 35 34 46 2 53 17 51 17 20 30 2 51 50 62 2 53 17 51 62 1 53 52 38 39 2 133 11 12 18 30 40 22 36 63 86 50 50 87 63 36 83 24 41 56 32 33 56 42 24 33 42 48 8 7 3 25 14 32 19 25 36 26 16 5 254 163 79 108 67 29 29 67 108 79 1 129 254 125 59 80 48 21 21 48 80 59 1 131 4 28 35 11 20 10 255 255 0 87 255 244 2 156 3 50 2 38 0 205 0 0 0 7 2 249 1 66 0 0 255 255 0 87 255 244 2 156 3 50 2 38 0 205 0 0 0 7 2 247 1 66 0 0 255 255 0 87 255 244 2 156 3 104 2 38 0 205 0 0 0 7 3 7 1 66 0 0 255 255 0 87 255 244 2 156 3 51 2 38 0 205 0 0 0 7 2 253 1 66 0 0 255 255 0 87 255 50 2 156 3 25 2 38 0 205 0 0 0 7 3 19 1 66 0 0 255 255 0 23 0 0 2 250 3 50 2 38 0 26 0 0 0 7 2 247 1 137 0 0 255 255 0 23 0 0 2 250 3 50 2 38 0 26 0 0 0 7 2 249 1 137 0 0 255 255 0 23 0 0 2 250 3 50 2 38 0 26 0 0 0 7 2 251 1 137 0 0 255 255 0 23 0 0 2 250 3 45 2 38 0 26 0 0 0 7 3 5 1 137 0 0 255 255 255 255 0 0 1 221 3 50 2 38 0 28 0 0 0 7 2 247 0 238 0 0 255 255 255 255 0 0 1 221 3 50 2 38 0 28 0 0 0 7 2 249 0 238 0 0 255 255 255 255 0 0 1 221 3 50 2 38 0 28 0 0 0 7 2 251 0 238 0 0 255 255 255 255 0 0 1 221 3 45 2 38 0 28 0 0 0 7 3 5 0 238 0 0 255 255 255 255 0 0 1 221 3 53 2 38 0 28 0 0 0 7 3 3 0 238 0 0 255 255 255 255 255 50 1 221 2 144 2 38 0 28 0 0 0 7 3 19 0 240 0 0 255 255 255 255 0 0 1 221 3 104 2 38 0 28 0 0 0 7 3 7 0 238 0 0 255 255 255 255 0 0 1 221 3 51 2 38 0 28 0 0 0 7 2 253 0 238 0 0 255 255 0 45 0 0 1 241 3 50 2 38 0 29 0 0 0 7 2 249 1 24 0 0 255 255 0 45 0 0 1 241 3 50 2 38 0 29 0 0 0 7 3 13 1 24 0 0 255 255 0 45 0 0 1 241 3 53 2 38 0 29 0 0 0 7 3 3 1 24 0 0 255 255 0 45 255 50 1 241 2 144 2 38 0 29 0 0 0 7 3 19 1 25 0 0 0 2 0 33 0 0 2 74 2 144 0 12 0 27 0 89 0 184 0 0 69 88 184 0 27 47 27 185 0 27 0 16 62 89 184 0 0 69 88 184 0 22 47 27 185 0 22 0 4 62 89 185 0 0 0 1 244 184 0 27 16 185 0 6 0 1 244 186 0 10 0 27 0 22 17 18 57 184 0 10 47 185 0 9 0 1 244 184 0 10 16 184 0 24 208 184 0 9 16 184 0 25 208 48 49 37 50 54 53 52 38 43 1 21 51 21 35 21 19 50 22 21 20 14 2 43 1 17 35 53 55 17 1 14 115 115 115 115 75 149 149 81 152 158 40 78 114 74 168 79 79 68 138 125 125 132 220 47 253 2 76 168 157 78 123 85 45 1 65 43 4 1 32 0 0 0 0 2 0 90 0 0 2 21 2 144 0 16 0 25 0 57 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 16 62 89 184 0 0 69 88 184 0 16 47 27 185 0 16 0 4 62 89 187 0 25 0 1 0 14 0 4 43 187 0 2 0 1 0 24 0 4 43 48 49 19 51 21 51 50 30 2 21 20 14 2 43 1 21 35 55 50 54 53 52 38 43 1 17 90 83 118 54 90 63 35 35 64 89 54 118 83 191 86 83 84 85 108 2 144 110 20 46 73 54 52 77 50 24 150 218 64 71 71 54 254 252 0 0 2 0 58 255 244 2 95 2 156 0 8 0 37 0 73 0 184 0 0 69 88 184 0 12 47 27 185 0 12 0 16 62 89 184 0 0 69 88 184 0 22 47 27 185 0 22 0 4 62 89 185 0 5 0 1 244 186 0 8 0 22 0 12 17 18 57 184 0 8 47 185 0 31 0 1 244 184 0 12 16 185 0 34 0 1 244 48 49 19 30 3 51 50 54 55 1 62 1 51 50 30 2 21 20 14 2 35 34 46 2 53 52 54 55 33 46 1 35 34 6 7 143 3 29 49 65 39 80 104 10 254 115 35 105 67 63 102 71 39 41 74 103 61 62 99 71 38 1 1 1 208 5 101 93 49 82 29 1 30 54 85 59 31 122 107 1 49 34 43 47 87 125 79 79 126 89 48 48 89 124 76 5 13 7 116 133 36 29 0 0 0 255 255 0 58 255 244 1 183 2 202 2 38 0 30 0 0 0 7 2 246 1 13 0 0 255 255 0 58 255 244 1 183 2 202 2 38 0 30 0 0 0 7 2 248 1 13 0 0 255 255 0 58 255 244 1 183 2 202 2 38 0 30 0 0 0 7 2 250 1 13 0 0 255 255 0 58 255 244 1 183 2 173 2 38 0 30 0 0 0 7 2 252 1 13 0 0 255 255 0 58 255 244 1 183 2 174 2 38 0 30 0 0 0 7 3 4 1 13 0 0 255 255 0 58 255 244 1 183 2 146 2 38 0 30 0 0 0 7 2 254 1 13 0 0 255 255 0 58 255 244 1 183 2 190 2 38 0 30 0 0 0 7 3 0 1 13 0 0 255 255 0 58 255 244 1 183 2 215 2 38 0 30 0 0 0 7 3 8 1 13 0 0 255 255 0 58 255 244 1 183 2 202 2 38 0 30 0 0 0 7 3 12 1 13 0 0 255 255 0 58 255 50 1 183 1 242 2 38 0 30 0 0 0 7 3 19 0 253 0 0 255 255 0 58 255 244 1 183 2 215 2 38 0 30 0 0 0 7 3 6 1 13 0 0 255 255 0 58 255 244 1 245 2 242 2 38 0 30 0 0 0 7 3 36 1 13 0 0 255 255 0 58 255 244 1 214 2 242 2 38 0 30 0 0 0 7 3 38 1 13 0 0 255 255 0 58 255 244 1 222 3 16 2 38 0 30 0 0 0 7 3 40 1 13 0 0 255 255 0 58 255 244 1 183 3 34 2 38 0 30 0 0 0 7 3 42 1 13 0 0 255 255 0 58 255 50 1 183 2 202 2 38 0 30 0 0 0 39 2 250 1 13 0 0 0 7 3 19 0 253 0 0 255 255 0 58 255 244 1 183 3 21 2 38 0 30 0 0 0 7 3 44 1 13 0 0 255 255 0 58 255 244 1 183 3 21 2 38 0 30 0 0 0 7 3 46 1 13 0 0 255 255 0 58 255 244 1 183 3 71 2 38 0 30 0 0 0 7 3 48 1 13 0 0 255 255 0 58 255 244 1 183 3 34 2 38 0 30 0 0 0 7 3 50 1 13 0 0 255 255 0 58 255 50 1 183 2 190 2 38 0 30 0 0 0 39 3 0 1 13 0 0 0 7 3 19 0 253 0 0 0 2 0 58 255 50 1 204 1 242 0 11 0 59 0 108 0 184 0 0 69 88 184 0 27 47 27 185 0 27 0 8 62 89 184 0 0 69 88 184 0 57 47 27 185 0 57 0 4 62 89 184 0 0 69 88 184 0 31 47 27 185 0 31 0 4 62 89 186 0 37 0 44 0 3 43 184 0 57 16 185 0 3 0 1 244 186 0 15 0 27 0 57 17 18 57 184 0 15 47 184 0 7 208 184 0 27 16 185 0 20 0 1 244 184 0 31 16 184 0 52 208 48 49 55 20 22 51 50 54 55 53 14 3 7 52 54 55 52 46 2 35 34 6 7 39 62 1 51 50 22 21 17 14 1 21 20 22 51 50 54 55 23 14 1 35 34 38 53 52 62 2 55 39 35 14 1 35 34 38 139 49 36 35 63 35 61 84 51 22 81 143 156 9 23 38 30 43 73 29 33 34 98 59 89 80 42 45 29 18 12 19 9 21 14 45 19 38 52 14 23 28 15 8 2 35 81 45 62 81 132 42 36 33 32 135 8 22 30 39 29 80 85 17 23 44 34 21 32 20 57 22 41 109 91 254 214 17 59 29 23 23 7 6 41 11 16 43 42 20 37 32 27 9 54 29 41 72 0 0 0 3 0 58 255 244 2 235 1 242 0 14 0 64 0 71 0 155 0 184 0 0 69 88 184 0 18 47 27 185 0 18 0 8 62 89 184 0 0 69 88 184 0 24 47 27 185 0 24 0 8 62 89 184 0 0 69 88 184 0 50 47 27 185 0 50 0 4 62 89 184 0 0 69 88 184 0 44 47 27 185 0 44 0 4 62 89 184 0 50 16 185 0 3 0 1 244 186 0 56 0 50 0 18 17 18 57 184 0 56 47 185 0 10 0 1 244 186 0 31 0 24 0 44 17 18 57 184 0 31 47 184 0 44 16 185 0 37 0 1 244 184 0 18 16 185 0 61 0 1 244 184 0 24 16 185 0 68 0 1 244 184 0 31 16 185 0 71 0 1 244 48 49 55 20 22 51 50 54 55 46 1 39 53 14 3 3 62 1 51 50 22 23 62 1 51 50 30 2 21 20 7 33 30 3 51 50 54 55 23 14 1 35 34 38 39 14 1 35 34 38 53 52 54 55 52 46 2 35 34 6 7 5 52 38 35 34 6 7 139 49 36 34 80 33 8 10 1 58 81 51 23 60 34 96 54 54 70 15 29 81 50 45 69 47 24 3 254 197 1 25 40 54 31 35 56 27 30 32 76 50 61 82 28 50 101 47 62 81 142 152 8 23 38 30 40 72 29 2 51 59 56 51 73 7 132 42 36 39 36 19 53 28 25 8 22 30 39 1 24 22 41 55 48 48 55 32 60 85 52 28 18 38 62 44 24 23 17 57 20 30 55 36 45 46 72 66 80 85 17 23 44 34 21 32 20 100 75 80 83 72 0 0 0 255 255 0 46 255 43 1 176 1 242 2 38 0 32 0 0 0 7 3 22 1 16 0 0 255 255 0 46 255 244 1 176 2 202 2 38 0 32 0 0 0 7 2 248 1 23 0 0 255 255 0 46 255 244 1 176 2 202 2 38 0 32 0 0 0 7 2 250 1 23 0 0 255 255 0 46 255 244 1 176 2 202 2 38 0 32 0 0 0 7 3 12 1 23 0 0 255 255 0 46 255 244 1 176 2 182 2 38 0 32 0 0 0 7 3 2 1 23 0 0 255 255 0 47 255 244 2 73 2 248 0 38 0 33 0 0 0 7 3 52 2 43 0 0 255 255 0 47 255 50 1 217 2 200 2 38 0 33 0 0 0 7 3 19 1 46 0 0 255 255 0 47 255 85 1 217 2 200 2 38 0 33 0 0 0 7 3 27 1 45 0 0 0 2 0 47 255 244 2 33 2 200 0 14 0 43 0 110 0 184 0 31 47 184 0 0 69 88 184 0 40 47 27 185 0 40 0 18 62 89 184 0 0 69 88 184 0 23 47 27 185 0 23 0 4 62 89 184 0 0 69 88 184 0 18 47 27 185 0 18 0 4 62 89 184 0 31 16 185 0 3 0 1 244 184 0 23 16 185 0 11 0 1 244 186 0 36 0 18 0 40 17 18 57 184 0 36 47 184 0 16 208 184 0 36 16 185 0 39 0 1 244 184 0 42 208 48 49 1 46 1 35 34 14 2 21 20 22 51 50 54 55 19 7 17 35 39 35 14 1 35 34 38 53 52 62 2 51 50 22 23 39 53 35 53 51 53 51 21 51 1 134 31 57 30 29 51 38 22 70 64 34 60 30 155 72 70 6 3 28 74 44 92 109 35 58 76 42 42 62 32 4 161 161 83 72 1 102 28 23 25 47 65 39 84 92 33 34 1 196 5 253 197 55 28 39 126 118 57 91 64 34 30 26 83 66 48 93 93 0 0 0 255 255 0 46 255 244 1 202 2 202 2 38 0 34 0 0 0 7 2 246 1 9 0 0 255 255 0 46 255 244 1 202 2 202 2 38 0 34 0 0 0 7 2 248 1 9 0 0 255 255 0 46 255 244 1 202 2 202 2 38 0 34 0 0 0 7 2 250 1 9 0 0 255 255 0 46 255 244 1 202 2 202 2 38 0 34 0 0 0 7 3 12 1 9 0 0 255 255 0 46 255 244 1 202 2 174 2 38 0 34 0 0 0 7 3 4 1 9 0 0 255 255 0 46 255 244 1 202 2 146 2 38 0 34 0 0 0 7 2 254 1 9 0 0 255 255 0 46 255 244 1 202 2 190 2 38 0 34 0 0 0 7 3 0 1 9 0 0 255 255 0 46 255 244 1 202 2 182 2 38 0 34 0 0 0 7 3 2 1 9 0 0 255 255 0 46 255 50 1 202 1 242 2 38 0 34 0 0 0 7 3 19 1 7 0 0 255 255 0 46 255 244 1 202 2 215 2 38 0 34 0 0 0 7 3 6 1 9 0 0 255 255 0 46 255 244 1 202 2 173 2 38 0 34 0 0 0 7 2 252 1 9 0 0 255 255 0 46 255 244 1 241 2 242 2 38 0 34 0 0 0 7 3 36 1 9 0 0 255 255 0 46 255 244 1 210 2 242 2 38 0 34 0 0 0 7 3 38 1 9 0 0 255 255 0 46 255 244 1 218 3 16 2 38 0 34 0 0 0 7 3 40 1 9 0 0 255 255 0 46 255 244 1 202 3 34 2 38 0 34 0 0 0 7 3 42 1 9 0 0 255 255 0 46 255 50 1 202 2 202 2 38 0 34 0 0 0 39 2 250 1 9 0 0 0 7 3 19 1 6 0 0 0 2 0 46 255 50 1 202 1 242 0 50 0 59 0 89 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 8 62 89 184 0 0 69 88 184 0 46 47 27 185 0 46 0 4 62 89 186 0 28 0 35 0 3 43 186 0 12 0 5 0 46 17 18 57 184 0 12 47 184 0 46 16 185 0 16 0 1 244 184 0 5 16 185 0 54 0 1 244 184 0 12 16 185 0 59 0 1 244 48 49 55 52 62 2 51 50 30 2 21 20 7 33 30 1 51 50 54 55 23 14 3 21 20 22 51 50 54 55 23 14 1 35 34 38 53 52 62 2 55 14 1 35 34 46 2 37 52 38 35 34 14 2 7 46 37 61 78 42 46 73 49 26 3 254 184 5 87 70 35 59 27 29 33 42 26 10 28 19 12 19 9 21 14 45 19 38 52 11 18 21 10 13 24 12 49 85 63 36 1 84 62 58 26 47 38 25 4 242 60 95 66 35 32 60 84 52 27 18 79 92 21 17 54 23 39 34 31 16 23 23 7 6 41 11 16 43 42 19 34 30 24 9 5 2 35 65 94 97 75 79 21 39 57 37 0 255 255 0 45 255 32 1 236 2 202 2 38 0 36 0 0 0 7 2 250 0 239 0 0 255 255 0 45 255 32 1 236 2 190 2 38 0 36 0 0 0 7 3 0 0 239 0 0 255 255 0 45 255 32 1 236 2 182 2 38 0 36 0 0 0 7 3 2 0 239 0 0 255 255 0 45 255 32 1 236 2 198 2 38 0 36 0 0 0 7 3 53 0 239 0 0 255 255 0 45 255 32 1 236 2 202 2 38 0 36 0 0 0 7 3 12 0 239 0 0 255 255 0 45 255 32 1 236 2 146 2 38 0 36 0 0 0 7 2 254 0 239 0 0 255 255 0 45 255 32 1 236 2 173 2 38 0 36 0 0 0 7 2 252 0 239 0 0 255 255 255 244 0 0 1 215 3 92 2 38 0 37 0 0 0 6 2 251 124 42 0 0 255 255 0 82 255 50 1 215 2 200 2 38 0 37 0 0 0 7 3 19 1 30 0 0 255 255 0 82 255 50 1 215 2 200 2 38 0 37 0 0 0 7 3 26 1 29 0 0 0 1 0 8 0 0 1 215 2 200 0 28 0 89 0 184 0 0 69 88 184 0 22 47 27 185 0 22 0 18 62 89 184 0 0 69 88 184 0 17 47 27 185 0 17 0 4 62 89 184 0 22 16 184 0 21 208 184 0 21 47 185 0 18 0 1 244 184 0 26 208 184 0 3 208 184 0 17 16 184 0 8 208 184 0 3 16 185 0 12 0 1 244 184 0 21 16 184 0 25 208 48 49 19 62 1 51 50 22 21 17 35 17 52 38 35 34 6 7 17 35 17 35 53 55 53 51 21 51 21 35 21 161 35 76 51 77 71 82 44 48 38 58 37 82 74 74 82 182 182 1 142 33 47 96 94 254 224 1 21 69 61 38 37 254 180 2 59 43 5 93 93 48 73 0 0 255 255 0 12 0 0 0 188 2 202 2 38 1 45 0 0 0 6 2 246 123 0 0 0 255 255 0 58 0 0 0 234 2 202 2 38 1 45 0 0 0 6 2 248 123 0 0 0 255 255 255 250 0 0 0 252 2 202 2 38 1 45 0 0 0 6 2 250 123 0 0 0 255 255 255 240 0 0 1 6 2 173 2 38 1 45 0 0 0 6 2 252 123 0 0 0 255 255 255 244 0 0 1 2 2 174 2 38 1 45 0 0 0 6 3 4 123 0 0 0 255 255 0 0 0 0 0 246 2 146 2 38 1 45 0 0 0 6 2 254 123 0 0 0 255 255 255 250 0 0 0 252 2 202 2 38 1 45 0 0 0 6 3 12 123 0 0 0 255 255 0 59 0 0 0 206 2 215 2 38 1 45 0 0 0 6 3 6 123 0 0 0 255 255 0 67 255 50 0 181 2 180 2 38 0 38 0 0 0 6 3 19 124 0 0 0 0 2 0 38 255 50 0 207 2 180 0 22 0 34 0 61 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 8 62 89 184 0 0 69 88 184 0 22 47 27 185 0 22 0 4 62 89 186 0 23 0 29 0 3 43 186 0 8 0 15 0 3 43 184 0 22 16 184 0 2 208 48 49 19 51 17 14 1 21 20 22 51 50 54 55 23 14 1 35 34 38 53 52 54 55 35 19 34 38 53 52 54 51 50 22 21 20 6 82 82 30 35 28 19 11 19 10 21 14 45 19 38 53 43 21 20 41 24 33 33 24 23 33 33 1 230 254 26 22 54 29 23 23 7 6 41 11 16 43 42 40 60 21 2 74 30 23 24 29 29 24 23 30 0 0 1 0 38 255 50 0 207 1 230 0 22 0 53 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 8 62 89 184 0 0 69 88 184 0 22 47 27 185 0 22 0 4 62 89 186 0 8 0 15 0 3 43 184 0 22 16 184 0 2 208 48 49 19 51 17 14 1 21 20 22 51 50 54 55 23 14 1 35 34 38 53 52 54 55 35 82 82 30 35 28 19 11 19 10 21 14 45 19 38 53 43 21 20 1 230 254 26 22 54 29 23 23 7 6 41 11 16 43 42 40 60 21 0 0 1 0 82 0 0 0 164 1 230 0 3 0 37 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 8 62 89 184 0 0 69 88 184 0 2 47 27 185 0 2 0 4 62 89 48 49 19 51 17 35 82 82 82 1 230 254 26 0 0 255 255 255 216 255 39 0 252 2 202 2 38 1 151 0 0 0 6 2 250 123 0 0 0 255 255 0 82 255 40 1 230 2 200 2 38 0 40 0 0 0 7 3 21 1 15 0 0 0 1 0 82 0 0 1 230 1 230 0 12 0 83 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 8 62 89 184 0 0 69 88 184 0 12 47 27 185 0 12 0 4 62 89 186 0 2 0 0 0 12 17 18 57 184 0 0 16 184 0 4 208 184 0 12 16 184 0 8 208 186 0 6 0 0 0 8 17 18 57 186 0 9 0 0 0 12 17 18 57 48 49 19 51 17 51 19 51 7 19 35 39 7 21 35 82 82 3 206 91 161 183 90 142 90 82 1 230 254 254 1 2 195 254 221 231 106 125 0 0 0 255 255 0 68 255 244 0 250 3 102 2 38 0 41 0 0 0 6 2 249 119 52 0 0 255 255 0 82 255 244 1 20 2 248 0 38 0 41 0 0 0 7 3 52 0 246 0 0 255 255 0 82 255 244 1 107 2 200 0 38 0 41 0 0 0 7 1 253 0 179 1 19 255 255 0 82 255 40 0 238 2 200 2 38 0 41 0 0 0 7 3 21 0 170 0 0 255 255 0 82 255 50 0 224 2 200 2 38 0 41 0 0 0 7 3 19 0 170 0 0 255 255 255 255 255 50 0 245 3 111 2 38 0 41 0 0 0 39 2 254 0 122 0 221 0 7 3 19 0 170 0 0 255 255 0 46 255 85 1 37 2 200 2 38 0 41 0 0 0 7 3 27 0 170 0 0 0 1 0 23 255 244 0 239 2 200 0 23 0 77 0 184 0 0 69 88 184 0 19 47 27 185 0 19 0 18 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 4 62 89 186 0 15 0 11 0 19 17 18 57 184 0 15 47 184 0 0 208 184 0 11 16 185 0 4 0 1 244 184 0 15 16 184 0 18 220 184 0 21 208 48 49 19 17 20 22 51 58 1 55 23 14 1 35 34 38 61 1 7 53 55 17 51 17 55 21 169 14 9 3 7 8 11 9 22 17 46 41 63 63 83 70 1 118 254 230 20 16 2 62 4 4 56 54 233 40 70 40 1 55 254 244 45 70 0 0 0 255 255 0 82 255 50 2 241 1 242 2 38 0 42 0 0 0 7 3 19 1 170 0 0 255 255 0 82 0 0 1 215 2 202 2 38 0 43 0 0 0 7 2 248 1 36 0 0 255 255 0 82 0 0 1 215 2 202 2 38 0 43 0 0 0 7 3 12 1 36 0 0 255 255 0 82 0 0 1 215 2 173 2 38 0 43 0 0 0 7 2 252 1 36 0 0 255 255 0 82 255 40 1 215 1 242 2 38 0 43 0 0 0 7 3 21 1 23 0 0 255 255 0 82 0 0 1 215 2 182 2 38 0 43 0 0 0 7 3 2 1 36 0 0 255 255 0 82 255 50 1 215 1 242 2 38 0 43 0 0 0 7 3 19 1 23 0 0 255 255 0 82 255 85 1 215 1 242 2 38 0 43 0 0 0 7 3 27 1 23 0 0 255 255 0 63 0 0 2 181 2 187 0 38 2 9 0 0 0 7 0 43 0 222 0 0 255 255 0 46 255 244 1 240 2 202 2 38 0 44 0 0 0 7 2 246 1 15 0 0 255 255 0 46 255 244 1 240 2 202 2 38 0 44 0 0 0 7 2 248 1 15 0 0 255 255 0 46 255 244 1 240 2 202 2 38 0 44 0 0 0 7 2 250 1 15 0 0 255 255 0 46 255 244 1 240 2 173 2 38 0 44 0 0 0 7 2 252 1 15 0 0 255 255 0 46 255 244 1 240 2 174 2 38 0 44 0 0 0 7 3 4 1 15 0 0 255 255 0 46 255 244 1 240 2 146 2 38 0 44 0 0 0 7 2 254 1 15 0 0 255 255 0 46 255 244 1 240 2 202 2 38 0 44 0 0 0 7 3 10 1 15 0 0 255 255 0 46 255 244 1 240 2 202 2 38 0 44 0 0 0 7 3 12 1 15 0 0 255 255 0 46 255 50 1 240 1 242 2 38 0 44 0 0 0 7 3 19 1 16 0 0 255 255 0 46 255 244 1 240 2 215 2 38 0 44 0 0 0 7 3 6 1 15 0 0 255 255 0 46 255 244 1 247 2 242 2 38 0 44 0 0 0 7 3 36 1 15 0 0 255 255 0 46 255 244 1 240 2 242 2 38 0 44 0 0 0 7 3 38 1 15 0 0 255 255 0 46 255 244 1 240 3 16 2 38 0 44 0 0 0 7 3 40 1 15 0 0 255 255 0 46 255 244 1 240 3 34 2 38 0 44 0 0 0 7 3 42 1 15 0 0 255 255 0 46 255 50 1 240 2 202 2 38 0 44 0 0 0 39 2 250 1 15 0 0 0 7 3 19 1 16 0 0 0 3 0 46 255 233 1 240 1 253 0 9 0 19 0 46 0 73 0 184 0 0 69 88 184 0 41 47 27 185 0 41 0 8 62 89 184 0 0 69 88 184 0 28 47 27 185 0 28 0 4 62 89 186 0 0 0 28 0 41 17 18 57 185 0 2 0 1 244 186 0 10 0 41 0 28 17 18 57 184 0 41 16 185 0 12 0 1 244 48 49 55 22 51 50 62 2 53 52 47 1 38 35 34 14 2 21 20 23 1 30 1 21 20 14 2 35 34 39 7 39 55 46 1 53 52 62 2 51 50 22 23 55 23 178 39 54 31 53 39 21 24 27 37 56 31 53 38 22 23 1 36 25 29 37 62 81 45 79 60 49 37 54 25 29 37 62 81 45 38 72 29 50 36 93 39 27 49 68 41 67 47 39 40 27 49 69 41 67 46 1 26 32 87 54 60 95 65 34 49 60 29 65 32 85 54 61 95 66 34 25 25 61 29 0 0 0 3 0 46 255 244 3 33 1 242 0 19 0 60 0 67 0 113 0 184 0 0 69 88 184 0 25 47 27 185 0 25 0 8 62 89 184 0 0 69 88 184 0 56 47 27 185 0 56 0 4 62 89 185 0 5 0 1 244 184 0 25 16 185 0 15 0 1 244 184 0 25 16 184 0 31 208 184 0 56 16 184 0 51 208 186 0 38 0 31 0 51 17 18 57 184 0 38 47 184 0 51 16 185 0 44 0 1 244 184 0 31 16 185 0 64 0 1 244 184 0 38 16 185 0 67 0 1 244 48 49 55 20 30 2 51 50 62 2 53 52 46 2 35 34 14 2 7 52 62 2 51 50 22 23 62 1 51 50 30 2 21 20 7 33 30 3 51 50 54 55 23 14 1 35 34 38 39 6 35 34 46 2 37 52 38 35 34 6 7 130 20 36 50 30 30 50 36 20 20 36 50 30 30 50 36 20 84 36 60 80 44 56 94 26 28 89 54 45 70 48 25 3 254 193 1 25 41 55 31 35 58 27 30 32 78 50 57 94 28 57 122 44 79 60 35 2 171 62 56 51 74 7 242 42 68 49 27 27 49 68 42 42 69 50 27 27 50 69 42 61 95 66 34 62 60 57 65 32 60 85 52 28 18 38 62 44 24 23 17 57 20 30 64 57 121 34 65 95 96 75 80 83 72 0 2 0 46 255 244 1 251 2 101 0 19 0 52 0 71 0 184 0 0 69 88 184 0 44 47 27 185 0 44 0 8 62 89 184 0 0 69 88 184 0 34 47 27 185 0 34 0 4 62 89 185 0 0 0 1 244 184 0 44 16 185 0 10 0 1 244 186 0 26 0 44 0 10 17 18 57 184 0 26 16 184 0 46 220 48 49 37 50 62 2 53 52 46 2 35 34 14 2 21 20 30 2 19 30 1 21 20 6 7 30 1 21 20 14 2 35 34 46 2 53 52 62 2 51 50 23 62 1 53 52 38 39 1 15 31 52 37 20 20 37 52 31 31 52 37 20 20 37 52 244 10 13 56 37 37 45 37 62 81 45 45 81 62 37 37 62 81 45 50 44 35 39 8 7 56 27 49 68 42 42 69 50 27 27 50 69 42 42 68 49 27 2 45 14 32 19 45 47 11 33 102 68 60 95 65 34 34 65 95 60 61 95 66 34 21 6 31 28 11 21 10 0 0 255 255 0 46 255 244 1 251 2 202 2 38 1 83 0 0 0 7 2 248 1 15 0 0 255 255 0 46 255 244 1 251 2 202 2 38 1 83 0 0 0 7 2 246 1 15 0 0 255 255 0 46 255 244 1 251 2 215 2 38 1 83 0 0 0 7 3 6 1 15 0 0 255 255 0 46 255 244 1 251 2 173 2 38 1 83 0 0 0 7 2 252 1 15 0 0 255 255 0 46 255 50 1 251 2 101 2 38 1 83 0 0 0 7 3 19 1 16 0 0 0 2 0 46 255 50 1 240 1 242 0 40 0 60 0 73 0 184 0 0 69 88 184 0 15 47 27 185 0 15 0 8 62 89 184 0 0 69 88 184 0 5 47 27 185 0 5 0 4 62 89 186 0 31 0 38 0 3 43 184 0 5 16 184 0 25 208 184 0 5 16 185 0 46 0 1 244 184 0 15 16 185 0 56 0 1 244 48 49 23 52 62 2 55 46 3 53 52 62 2 51 50 30 2 21 20 14 2 7 14 1 21 20 22 51 50 54 55 23 14 1 35 34 38 3 20 30 2 51 50 62 2 53 52 46 2 35 34 14 2 205 11 17 19 9 44 78 59 34 37 62 81 45 45 81 62 37 23 42 58 36 34 37 28 18 12 19 10 21 14 45 20 38 52 74 20 37 52 31 31 52 37 20 20 37 52 31 31 52 37 20 121 19 33 29 22 7 2 37 64 92 58 61 95 66 34 34 66 95 61 51 77 59 43 16 16 56 29 23 23 7 6 41 11 16 43 1 149 42 68 49 27 27 49 68 42 42 69 50 27 27 50 69 0 255 255 0 82 0 0 1 94 2 202 2 38 0 47 0 0 0 7 2 248 0 217 0 0 255 255 0 36 255 40 1 94 1 242 2 38 0 47 0 0 0 6 3 21 121 0 0 0 255 255 0 82 0 0 1 94 2 202 2 38 0 47 0 0 0 7 3 12 0 217 0 0 255 255 0 67 255 50 1 94 1 242 2 38 0 47 0 0 0 6 3 19 121 0 0 0 255 255 0 67 255 50 1 94 2 146 2 38 0 47 0 0 0 39 2 254 0 217 0 0 0 6 3 19 121 0 0 0 255 255 255 253 255 85 1 94 1 242 2 38 0 47 0 0 0 6 3 27 121 0 0 0 255 255 0 28 255 244 1 131 2 202 2 38 0 48 0 0 0 7 2 248 0 219 0 0 255 255 0 28 255 244 1 131 2 202 2 38 0 48 0 0 0 7 2 250 0 219 0 0 255 255 0 28 255 244 1 131 2 202 2 38 0 48 0 0 0 7 3 12 0 219 0 0 255 255 0 28 255 43 1 131 1 242 2 38 0 48 0 0 0 7 3 22 0 222 0 0 255 255 0 28 255 40 1 131 1 242 2 38 0 48 0 0 0 7 3 21 0 222 0 0 255 255 0 28 255 244 1 131 2 182 2 38 0 48 0 0 0 7 3 2 0 219 0 0 255 255 0 28 255 50 1 131 1 242 2 38 0 48 0 0 0 7 3 19 0 223 0 0 0 1 0 82 255 244 2 35 2 210 0 55 0 100 0 184 0 0 69 88 184 0 3 47 27 185 0 3 0 18 62 89 184 0 0 69 88 184 0 55 47 27 185 0 55 0 4 62 89 184 0 0 69 88 184 0 25 47 27 185 0 25 0 4 62 89 186 0 13 0 25 0 3 17 18 57 185 0 32 0 1 244 186 0 35 0 25 0 3 17 18 57 186 0 47 0 25 0 3 17 18 57 184 0 3 16 185 0 50 0 1 244 48 49 19 52 54 51 50 30 2 21 20 14 2 21 20 30 4 21 20 14 2 35 34 38 39 55 30 1 51 50 54 53 52 46 4 53 52 62 2 53 52 38 35 34 6 21 17 35 82 102 94 39 61 42 21 28 35 28 29 44 51 44 29 22 42 59 37 42 68 31 33 26 51 29 42 42 29 44 51 44 29 27 33 28 41 42 54 59 82 2 3 94 113 23 40 53 30 38 53 44 41 26 24 32 25 26 36 54 40 32 54 40 23 26 23 58 22 21 48 32 29 38 28 25 32 45 35 34 48 44 46 32 38 49 77 78 254 12 0 0 255 255 0 24 255 244 1 69 2 248 2 38 0 49 0 0 0 7 3 52 1 26 0 0 255 255 0 24 255 43 1 69 2 110 2 38 0 49 0 0 0 7 3 22 0 216 0 0 255 255 0 24 255 40 1 69 2 110 2 38 0 49 0 0 0 7 3 21 0 213 0 0 255 255 0 24 255 50 1 69 2 110 2 38 0 49 0 0 0 7 3 19 0 214 0 0 255 255 0 24 255 85 1 80 2 110 2 38 0 49 0 0 0 7 3 27 0 213 0 0 255 255 0 9 255 244 1 69 3 54 2 38 0 49 0 0 0 7 3 4 0 144 0 136 255 255 0 75 255 244 1 206 2 202 2 38 0 50 0 0 0 7 2 246 1 16 0 0 255 255 0 75 255 244 1 206 2 202 2 38 0 50 0 0 0 7 2 248 1 16 0 0 255 255 0 75 255 244 1 206 2 202 2 38 0 50 0 0 0 7 2 250 1 16 0 0 255 255 0 75 255 244 1 206 2 173 2 38 0 50 0 0 0 7 2 252 1 16 0 0 255 255 0 75 255 244 1 206 2 174 2 38 0 50 0 0 0 7 3 4 1 16 0 0 255 255 0 75 255 244 1 206 2 146 2 38 0 50 0 0 0 7 2 254 1 13 0 0 255 255 0 75 255 244 1 206 2 190 2 38 0 50 0 0 0 7 3 0 1 16 0 0 255 255 0 75 255 244 1 206 2 215 2 38 0 50 0 0 0 7 3 8 1 16 0 0 255 255 0 75 255 244 1 208 2 202 2 38 0 50 0 0 0 7 3 10 1 16 0 0 255 255 0 75 255 244 1 206 2 202 2 38 0 50 0 0 0 7 3 12 1 16 0 0 255 255 0 75 255 244 1 206 3 29 2 38 0 50 0 0 0 7 3 28 1 16 0 0 255 255 0 75 255 244 1 206 3 55 2 38 0 50 0 0 0 7 3 30 1 16 0 0 255 255 0 75 255 244 1 206 3 55 2 38 0 50 0 0 0 7 3 32 1 16 0 0 255 255 0 75 255 244 1 206 3 55 2 38 0 50 0 0 0 7 3 34 1 16 0 0 255 255 0 75 255 50 1 206 1 230 2 38 0 50 0 0 0 7 3 19 1 34 0 0 255 255 0 75 255 244 1 206 2 215 2 38 0 50 0 0 0 7 3 6 1 16 0 0 0 1 0 75 255 50 1 227 1 230 0 38 0 88 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 8 62 89 184 0 0 69 88 184 0 35 47 27 185 0 35 0 4 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 4 62 89 186 0 17 0 24 0 3 43 184 0 35 16 185 0 5 0 1 244 184 0 0 16 184 0 9 208 184 0 11 16 184 0 30 208 48 49 19 51 17 20 22 51 50 54 55 17 51 17 14 1 21 20 22 51 50 54 55 23 14 1 35 34 38 53 52 54 55 39 35 14 1 35 34 38 53 75 83 42 49 38 58 35 82 45 42 29 17 12 20 9 21 14 45 19 38 53 49 32 8 3 34 75 51 78 71 1 230 254 215 69 61 39 43 1 89 254 26 22 54 29 23 23 7 6 41 11 16 43 42 41 61 23 72 40 48 96 94 0 0 1 0 75 255 244 2 41 2 111 0 35 0 89 0 184 0 0 69 88 184 0 19 47 27 185 0 19 0 8 62 89 184 0 0 69 88 184 0 29 47 27 185 0 29 0 8 62 89 184 0 0 69 88 184 0 15 47 27 185 0 15 0 4 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 4 62 89 184 0 29 16 184 0 8 220 184 0 15 16 185 0 24 0 1 244 48 49 1 30 1 21 20 14 2 7 17 35 39 35 14 1 35 34 38 53 17 51 17 20 22 51 50 54 55 17 51 62 1 53 52 38 39 2 18 10 13 16 25 33 17 68 7 3 34 75 51 78 71 83 43 48 38 58 35 21 35 49 8 6 2 111 14 32 19 23 34 25 16 5 254 57 76 40 48 96 94 1 52 254 215 69 61 39 43 1 89 4 28 34 11 21 10 0 0 255 255 0 75 255 244 2 41 2 202 2 38 1 127 0 0 0 7 2 248 1 10 0 0 255 255 0 75 255 244 2 41 2 202 2 38 1 127 0 0 0 7 2 246 1 10 0 0 255 255 0 75 255 244 2 41 2 215 2 38 1 127 0 0 0 7 3 6 1 10 0 0 255 255 0 75 255 244 2 41 2 173 2 38 1 127 0 0 0 7 2 252 1 10 0 0 255 255 0 75 255 50 2 41 2 111 2 38 1 127 0 0 0 7 3 19 1 28 0 0 255 255 0 24 0 0 2 182 2 202 2 38 0 52 0 0 0 7 2 246 1 104 0 0 255 255 0 24 0 0 2 182 2 202 2 38 0 52 0 0 0 7 2 248 1 104 0 0 255 255 0 24 0 0 2 182 2 202 2 38 0 52 0 0 0 7 2 250 1 104 0 0 255 255 0 24 0 0 2 182 2 174 2 38 0 52 0 0 0 7 3 4 1 104 0 0 255 255 0 12 255 47 1 199 2 202 2 38 0 54 0 0 0 7 2 246 0 242 0 0 255 255 0 12 255 47 1 199 2 202 2 38 0 54 0 0 0 7 2 248 0 242 0 0 255 255 0 12 255 47 1 199 2 202 2 38 0 54 0 0 0 7 2 250 0 242 0 0 255 255 0 12 255 47 1 199 2 174 2 38 0 54 0 0 0 7 3 4 0 242 0 0 255 255 0 12 255 47 1 199 2 182 2 38 0 54 0 0 0 7 3 2 0 242 0 0 255 255 0 12 255 47 1 199 1 230 2 38 0 54 0 0 0 7 3 19 1 135 0 4 255 255 0 12 255 47 1 199 2 215 2 38 0 54 0 0 0 7 3 6 0 242 0 0 255 255 0 12 255 47 1 199 2 173 2 38 0 54 0 0 0 7 2 252 0 242 0 0 255 255 0 31 0 0 1 143 2 202 2 38 0 55 0 0 0 7 2 248 0 228 0 0 255 255 0 31 0 0 1 143 2 202 2 38 0 55 0 0 0 7 3 12 0 228 0 0 255 255 0 31 0 0 1 143 2 182 2 38 0 55 0 0 0 7 3 2 0 228 0 0 255 255 0 31 255 50 1 143 1 230 2 38 0 55 0 0 0 7 3 19 0 228 0 0 0 2 0 53 255 244 1 229 2 218 0 20 0 56 0 89 0 184 0 0 69 88 184 0 51 47 27 185 0 51 0 18 62 89 184 0 0 69 88 184 0 29 47 27 185 0 29 0 4 62 89 187 0 39 0 1 0 11 0 4 43 186 0 48 0 45 0 3 43 184 0 29 16 185 0 0 0 1 244 184 0 45 16 184 0 21 208 184 0 48 16 184 0 51 220 184 0 48 16 184 0 54 208 48 49 37 50 62 2 53 52 38 39 46 1 35 34 14 2 21 20 30 2 19 30 1 21 20 14 2 35 34 46 2 53 52 62 2 51 50 22 23 46 1 39 7 39 55 38 39 55 30 1 23 55 23 1 15 34 50 34 17 1 1 33 66 34 33 52 36 19 22 39 50 107 60 76 31 57 79 49 42 78 60 36 32 55 75 44 38 70 26 14 55 38 141 24 127 52 60 38 36 70 32 142 24 56 29 52 73 44 14 28 13 44 30 24 44 59 34 38 61 43 24 2 37 61 168 119 60 99 71 39 32 61 87 54 51 83 59 32 32 34 62 92 38 73 41 65 40 32 52 20 44 27 73 41 0 0 0 0 2 0 82 255 51 1 251 2 200 0 22 0 39 0 87 0 184 0 0 69 88 184 0 8 47 27 185 0 8 0 8 62 89 184 0 0 69 88 184 0 2 47 27 185 0 2 0 18 62 89 184 0 0 69 88 184 0 1 47 27 185 0 1 0 6 62 89 184 0 0 69 88 184 0 18 47 27 185 0 18 0 4 62 89 185 0 26 0 1 244 184 0 8 16 185 0 36 0 1 244 48 49 23 35 17 51 21 7 62 1 51 50 30 2 21 20 14 2 35 34 38 39 23 53 30 1 51 50 62 2 53 52 46 2 35 34 6 7 164 82 82 1 32 76 40 48 73 50 25 34 58 76 42 35 66 33 1 33 62 24 30 51 37 21 14 31 49 34 31 63 36 205 3 149 194 83 26 37 35 65 91 57 62 97 68 35 28 26 83 149 28 23 27 49 72 45 40 66 47 26 34 32 0 0 1 255 216 255 39 0 165 1 230 0 15 0 43 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 8 62 89 184 0 0 69 88 184 0 5 47 27 185 0 5 0 6 62 89 185 0 12 0 1 244 48 49 19 51 17 20 6 35 34 38 39 55 30 1 51 50 54 53 83 82 60 73 23 36 13 17 9 24 13 36 24 1 230 253 227 74 88 8 5 62 3 5 50 45 0 0 2 0 47 255 244 1 217 1 242 0 14 0 35 0 77 0 184 0 0 69 88 184 0 20 47 27 185 0 20 0 8 62 89 184 0 0 69 88 184 0 33 47 27 185 0 33 0 4 62 89 185 0 3 0 1 244 184 0 20 16 185 0 10 0 1 244 184 0 20 16 184 0 26 208 184 0 26 47 184 0 33 16 184 0 27 208 184 0 27 47 48 49 55 20 22 51 50 54 55 53 46 1 35 34 14 2 7 52 62 2 51 50 22 23 51 55 51 17 35 39 35 14 1 35 34 38 132 70 64 34 60 30 31 57 30 29 51 38 22 85 35 59 76 42 41 64 33 2 7 67 68 7 3 29 75 43 92 109 243 88 98 33 34 254 28 23 27 49 68 43 59 95 66 36 30 29 47 254 26 57 28 41 132 0 2 0 37 255 244 1 194 1 242 0 28 0 35 0 81 0 184 0 0 69 88 184 0 14 47 27 185 0 14 0 8 62 89 184 0 0 69 88 184 0 24 47 27 185 0 24 0 4 62 89 186 0 4 0 14 0 24 17 18 57 184 0 4 47 184 0 14 16 185 0 7 0 1 244 184 0 4 16 185 0 29 0 1 244 184 0 24 16 185 0 32 0 1 244 48 49 55 52 54 55 33 46 1 35 34 6 7 39 62 1 51 50 30 2 21 20 14 2 35 34 46 2 55 20 22 51 50 54 55 37 2 2 1 71 4 75 66 37 60 29 29 34 83 51 46 78 57 33 33 57 78 44 46 74 53 28 73 68 58 57 69 7 222 14 23 9 75 90 23 19 54 23 30 34 66 94 60 60 95 66 35 32 61 87 45 81 78 82 77 0 0 0 2 0 50 255 40 1 219 1 242 0 33 0 48 0 84 0 184 0 0 69 88 184 0 20 47 27 185 0 20 0 8 62 89 184 0 0 69 88 184 0 25 47 27 185 0 25 0 8 62 89 184 0 0 69 88 184 0 30 47 27 185 0 30 0 6 62 89 187 0 34 0 1 0 10 0 4 43 184 0 30 16 185 0 3 0 1 244 184 0 20 16 185 0 41 0 1 244 48 49 23 30 1 51 50 54 63 1 14 1 35 34 46 2 53 52 62 2 51 50 22 23 51 55 51 17 20 6 35 34 38 39 55 50 54 55 53 46 1 35 34 14 2 21 20 22 115 36 73 35 67 65 2 1 28 73 43 46 74 52 28 35 58 77 41 42 63 31 2 7 69 112 104 45 91 38 183 34 59 32 32 57 30 29 51 38 22 70 105 24 21 69 59 92 27 38 34 63 91 57 57 92 64 35 29 28 45 254 2 91 101 27 26 236 33 34 238 28 23 26 48 65 39 82 96 0 0 0 0 1 0 30 0 0 2 91 2 212 0 40 0 124 0 184 0 0 69 88 184 0 18 47 27 185 0 18 0 8 62 89 184 0 0 69 88 184 0 37 47 27 185 0 37 0 18 62 89 184 0 0 69 88 184 0 14 47 27 185 0 14 0 4 62 89 184 0 37 16 185 0 2 0 1 244 184 0 18 16 184 0 33 208 184 0 6 208 184 0 18 16 185 0 15 0 1 244 184 0 11 208 184 0 7 208 184 0 14 16 184 0 10 208 184 0 18 16 184 0 17 208 184 0 37 16 184 0 22 208 185 0 28 0 1 244 48 49 1 38 35 34 29 1 51 21 35 17 35 17 35 17 35 17 35 53 55 53 52 54 51 50 22 23 7 38 35 34 6 29 1 51 53 52 54 51 50 22 23 2 74 29 26 69 103 103 82 202 82 66 66 75 76 24 47 18 17 30 35 36 40 202 69 73 23 41 17 2 133 12 94 77 67 254 93 1 163 254 93 1 163 62 5 64 76 88 10 8 62 13 51 48 62 77 75 86 9 7 0 0 255 255 0 30 0 0 1 235 2 212 0 38 0 35 0 0 0 7 0 38 1 54 0 0 255 255 0 30 255 244 1 252 2 212 0 38 0 35 0 0 0 7 0 41 1 36 0 0 0 1 0 30 255 244 2 69 2 212 0 43 0 137 0 184 0 0 69 88 184 0 16 47 27 185 0 16 0 8 62 89 184 0 0 69 88 184 0 20 47 27 185 0 20 0 18 62 89 184 0 0 69 88 184 0 12 47 27 185 0 12 0 4 62 89 184 0 0 69 88 184 0 3 47 27 185 0 3 0 4 62 89 184 0 16 16 185 0 13 0 1 244 184 0 9 208 184 0 16 16 184 0 15 208 184 0 15 47 184 0 20 16 185 0 26 0 1 244 184 0 16 16 184 0 30 208 184 0 34 208 184 0 9 16 184 0 35 208 184 0 3 16 185 0 40 0 1 244 48 49 37 14 1 35 34 46 2 53 17 35 17 35 17 35 53 55 53 52 54 51 50 22 23 7 38 35 34 29 1 51 55 51 21 51 21 35 17 20 22 51 50 54 55 2 69 20 47 23 39 53 33 14 174 82 66 66 69 73 23 41 17 18 27 28 68 178 10 68 132 132 34 42 13 30 12 6 7 11 24 42 60 36 1 13 254 93 1 163 62 5 77 75 86 9 7 63 12 94 77 136 136 67 254 242 45 49 8 5 0 0 1 0 46 0 0 1 40 2 144 0 11 0 65 0 184 0 0 69 88 184 0 4 47 27 185 0 4 0 16 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 4 62 89 185 0 1 0 1 244 184 0 4 16 185 0 2 0 1 244 184 0 7 208 184 0 1 16 184 0 8 208 48 49 55 51 17 35 53 51 21 35 17 51 21 35 46 84 84 250 83 83 250 71 2 3 70 70 253 253 71 0 0 255 255 0 41 0 0 1 40 3 50 2 38 1 159 0 0 0 7 2 247 0 172 0 0 255 255 0 46 0 0 1 47 3 50 2 38 1 159 0 0 0 7 2 249 0 172 0 0 255 255 0 36 0 0 1 52 3 50 2 38 1 159 0 0 0 7 2 251 0 172 0 0 255 255 0 27 0 0 1 61 3 51 2 38 1 159 0 0 0 7 2 253 0 172 0 0 255 255 0 37 0 0 1 51 3 45 2 38 1 159 0 0 0 7 3 5 0 172 0 0 255 255 0 46 0 0 1 40 3 18 2 38 1 159 0 0 0 7 2 255 0 172 0 0 255 255 0 46 0 0 1 40 3 53 2 38 1 159 0 0 0 7 3 3 0 172 0 0 255 255 0 36 0 0 1 52 3 50 2 38 1 159 0 0 0 7 3 13 0 172 0 0 255 255 0 46 0 0 1 40 3 104 2 38 1 159 0 0 0 7 3 7 0 172 0 0 255 255 0 46 255 50 1 40 2 144 2 38 1 159 0 0 0 7 3 19 0 173 0 0 0 1 0 46 255 44 1 40 2 144 0 31 0 94 0 184 0 0 69 88 184 0 4 47 27 185 0 4 0 16 62 89 184 0 0 69 88 184 0 31 47 27 185 0 31 0 4 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 4 62 89 186 0 17 0 24 0 3 43 184 0 31 16 185 0 1 0 1 244 184 0 4 16 185 0 2 0 1 244 184 0 7 208 184 0 1 16 184 0 8 208 48 49 55 51 17 35 53 51 21 35 17 51 21 35 14 1 21 20 22 51 50 54 55 23 14 1 35 34 38 53 52 54 55 35 46 84 84 250 83 83 87 29 34 30 18 12 19 9 23 14 46 20 39 56 44 24 104 71 2 3 70 70 253 253 71 23 55 29 23 23 7 7 45 11 17 44 43 41 64 20 0 0 255 255 0 47 255 244 1 217 1 242 2 6 1 152 0 0 255 255 0 47 255 244 1 217 2 202 2 38 1 152 0 0 0 7 2 246 1 26 0 0 255 255 0 47 255 244 1 217 2 202 2 38 1 152 0 0 0 7 2 248 1 26 0 0 255 255 0 47 255 244 1 217 2 202 2 38 1 152 0 0 0 7 2 250 1 26 0 0 255 255 0 47 255 244 1 217 2 173 2 38 1 152 0 0 0 7 2 252 1 26 0 0 255 255 0 47 255 244 1 217 2 174 2 38 1 152 0 0 0 7 3 4 1 26 0 0 255 255 0 47 255 244 1 217 2 146 2 38 1 152 0 0 0 7 2 254 1 26 0 0 255 255 0 47 255 244 1 217 2 190 2 38 1 152 0 0 0 7 3 0 1 26 0 0 255 255 0 47 255 244 1 217 2 215 2 38 1 152 0 0 0 7 3 8 1 26 0 0 255 255 0 47 255 244 1 217 2 202 2 38 1 152 0 0 0 7 3 12 1 26 0 0 255 255 0 47 255 50 1 217 1 242 2 38 1 152 0 0 0 7 3 19 1 28 0 0 255 255 0 47 255 244 1 217 2 215 2 38 1 152 0 0 0 7 3 6 1 26 0 0 255 255 0 47 255 244 2 2 2 242 2 38 1 152 0 0 0 7 3 36 1 26 0 0 255 255 0 47 255 244 1 227 2 242 2 38 1 152 0 0 0 7 3 38 1 26 0 0 255 255 0 47 255 244 1 235 3 16 2 38 1 152 0 0 0 7 3 40 1 26 0 0 255 255 0 47 255 244 1 217 3 34 2 38 1 152 0 0 0 7 3 42 1 26 0 0 255 255 0 47 255 50 1 217 2 202 2 38 1 152 0 0 0 39 2 250 1 26 0 0 0 7 3 19 1 28 0 0 255 255 0 47 255 244 1 217 3 21 2 38 1 152 0 0 0 7 3 44 1 26 0 0 255 255 0 47 255 244 1 217 3 21 2 38 1 152 0 0 0 7 3 46 1 26 0 0 255 255 0 47 255 244 1 217 3 71 2 38 1 152 0 0 0 7 3 48 1 26 0 0 255 255 0 47 255 244 1 217 3 34 2 38 1 152 0 0 0 7 3 50 1 26 0 0 255 255 0 47 255 50 1 217 2 190 2 38 1 152 0 0 0 39 3 0 1 26 0 0 0 7 3 19 1 28 0 0 0 2 0 47 255 50 1 238 1 242 0 14 0 53 0 90 0 184 0 0 69 88 184 0 20 47 27 185 0 20 0 8 62 89 184 0 0 69 88 184 0 51 47 27 185 0 51 0 4 62 89 184 0 0 69 88 184 0 27 47 27 185 0 27 0 4 62 89 186 0 33 0 40 0 3 43 184 0 51 16 185 0 3 0 1 244 184 0 20 16 185 0 10 0 1 244 184 0 27 16 184 0 46 208 48 49 55 20 22 51 50 54 55 53 46 1 35 34 14 2 7 52 62 2 51 50 22 23 51 55 51 17 14 1 21 20 22 51 50 54 55 23 14 1 35 34 38 53 52 54 55 39 35 14 1 35 34 38 132 70 64 34 60 30 31 57 30 29 51 38 22 85 35 59 76 42 41 64 33 2 7 67 45 42 28 18 12 20 9 21 14 45 19 38 53 48 32 7 3 29 75 43 92 109 243 88 98 33 34 254 28 23 27 49 68 43 59 95 66 36 30 29 47 254 26 22 54 29 23 23 7 6 41 11 16 43 42 41 61 23 53 28 41 132 255 255 0 50 255 40 1 219 1 242 2 6 1 154 0 0 255 255 0 50 255 40 1 219 2 202 2 38 1 154 0 0 0 7 2 250 1 31 0 0 255 255 0 50 255 40 1 219 2 190 2 38 1 154 0 0 0 7 3 0 1 31 0 0 255 255 0 50 255 40 1 219 2 182 2 38 1 154 0 0 0 7 3 2 1 31 0 0 255 255 0 50 255 40 1 219 2 198 2 38 1 154 0 0 0 7 3 53 1 31 0 0 255 255 0 50 255 40 1 219 2 202 2 38 1 154 0 0 0 7 3 12 1 31 0 0 255 255 0 50 255 40 1 219 2 146 2 38 1 154 0 0 0 7 2 254 1 31 0 0 255 255 0 50 255 40 1 219 2 173 2 38 1 154 0 0 0 7 2 252 1 31 0 0 0 1 0 82 0 0 0 164 2 200 0 3 0 37 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 18 62 89 184 0 0 69 88 184 0 2 47 27 185 0 2 0 4 62 89 48 49 19 51 17 35 82 82 82 2 200 253 56 0 0 255 255 0 69 0 0 0 251 3 102 2 38 1 202 0 0 0 6 2 249 120 52 0 0 255 255 0 82 0 0 1 20 2 248 0 38 1 202 0 0 0 7 3 52 0 246 0 0 255 255 0 82 0 0 1 108 2 200 0 38 1 202 0 0 0 7 1 253 0 180 1 19 255 255 0 38 255 40 0 191 2 200 2 38 1 202 0 0 0 6 3 21 123 0 0 0 255 255 0 69 255 50 0 177 2 200 2 38 1 202 0 0 0 6 3 19 123 0 0 0 255 255 0 0 255 50 0 246 3 111 2 38 1 202 0 0 0 39 2 254 0 123 0 221 0 6 3 19 123 0 0 0 255 255 255 255 255 85 0 246 2 200 2 38 1 202 0 0 0 6 3 27 123 0 0 0 0 1 0 23 0 0 0 239 2 200 0 11 0 67 0 184 0 0 69 88 184 0 8 47 27 185 0 8 0 18 62 89 184 0 0 69 88 184 0 3 47 27 185 0 3 0 4 62 89 186 0 4 0 3 0 8 17 18 57 184 0 4 47 184 0 1 208 184 0 4 16 184 0 7 220 184 0 10 220 48 49 19 7 17 35 17 7 53 55 17 51 17 55 239 75 82 59 59 82 75 1 163 48 254 141 1 73 38 70 38 1 57 254 241 48 0 255 255 0 30 0 0 1 218 2 212 0 38 0 35 0 0 0 7 1 202 1 54 0 0 0 3 0 32 255 244 2 82 2 156 0 13 0 27 0 73 0 140 0 184 0 0 69 88 184 0 52 47 27 185 0 52 0 16 62 89 184 0 0 69 88 184 0 34 47 27 185 0 34 0 4 62 89 184 0 0 69 88 184 0 28 47 27 185 0 28 0 4 62 89 186 0 63 0 31 0 3 43 184 0 34 16 185 0 5 0 1 244 186 0 8 0 31 0 63 17 18 57 186 0 11 0 34 0 52 17 18 57 184 0 11 47 184 0 17 220 184 0 52 16 185 0 25 0 1 244 186 0 44 0 11 0 17 17 18 57 186 0 60 0 11 0 17 17 18 57 186 0 70 0 31 0 63 17 18 57 48 49 55 20 30 2 51 50 54 55 46 1 39 14 1 19 20 22 23 62 3 53 52 38 35 34 6 1 46 1 39 14 1 35 34 46 2 53 52 62 2 55 46 1 53 52 62 2 51 50 22 21 20 14 2 7 30 1 23 62 1 55 51 14 1 7 30 1 23 112 20 35 47 27 34 62 29 48 89 35 35 47 77 17 14 22 41 31 18 29 33 37 44 1 127 35 76 40 38 93 58 45 73 53 29 21 36 47 25 20 23 22 40 56 34 61 68 26 42 53 27 32 87 47 30 47 15 77 20 56 39 34 62 27 175 27 45 32 17 28 25 42 100 53 28 61 1 45 27 58 30 15 31 33 37 22 29 43 54 253 201 10 37 28 34 41 27 48 67 40 33 54 46 39 17 41 77 36 33 56 42 24 72 58 32 54 47 41 20 51 94 39 41 96 57 65 118 52 23 32 8 0 0 0 0 2 0 44 255 244 1 197 2 138 0 11 0 29 0 53 0 184 0 0 69 88 184 0 6 47 27 185 0 6 0 14 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 4 62 89 185 0 12 0 1 244 184 0 6 16 185 0 22 0 1 244 48 49 23 34 38 53 52 54 51 50 22 21 20 6 39 50 62 2 53 52 46 2 35 34 14 2 21 20 22 249 97 108 108 97 96 108 108 96 28 45 33 18 18 33 45 28 28 46 33 18 69 12 172 161 161 168 168 161 161 172 66 31 65 101 70 70 100 63 30 30 63 100 70 140 127 0 0 0 1 0 79 0 0 1 183 2 126 0 12 0 67 0 184 0 0 69 88 184 0 7 47 27 185 0 7 0 14 62 89 184 0 0 69 88 184 0 12 47 27 185 0 12 0 4 62 89 185 0 1 0 1 244 184 0 7 16 185 0 4 0 1 244 185 0 2 0 1 244 184 0 1 16 184 0 9 208 48 49 55 51 17 35 53 62 1 55 51 17 51 21 33 79 146 116 44 65 26 63 132 254 152 68 1 214 53 8 23 16 253 198 68 0 0 0 1 0 36 0 0 1 196 2 138 0 29 0 61 0 184 0 0 69 88 184 0 15 47 27 185 0 15 0 14 62 89 184 0 0 69 88 184 0 28 47 27 185 0 28 0 4 62 89 185 0 26 0 1 244 184 0 23 208 184 0 0 208 184 0 15 16 185 0 8 0 1 244 48 49 55 62 3 53 52 38 35 34 6 7 39 62 1 51 50 22 21 20 14 2 7 62 1 59 1 21 33 40 72 112 76 40 60 61 40 68 28 47 40 90 63 89 102 39 69 95 57 26 56 25 185 254 100 49 72 116 99 83 39 55 70 45 32 47 44 53 103 85 45 91 97 105 59 2 4 71 0 0 1 0 26 255 244 1 190 2 138 0 51 0 83 0 184 0 0 69 88 184 0 27 47 27 185 0 27 0 14 62 89 184 0 0 69 88 184 0 46 47 27 185 0 46 0 4 62 89 185 0 3 0 1 244 186 0 11 0 27 0 46 17 18 57 184 0 11 47 185 0 12 0 1 244 184 0 27 16 185 0 20 0 1 244 186 0 36 0 12 0 11 17 18 57 48 49 55 30 1 51 50 54 53 52 46 2 35 53 50 62 2 53 52 38 35 34 6 7 39 62 1 51 50 30 2 21 20 6 7 21 30 3 21 20 14 2 35 34 46 2 39 68 29 77 57 58 74 21 48 78 57 51 69 43 18 59 51 40 67 29 44 37 89 57 42 70 51 28 64 52 29 50 38 21 33 57 76 44 38 63 52 41 16 132 30 46 63 54 28 47 34 18 63 18 32 44 25 47 54 36 29 52 35 45 22 41 60 39 58 74 20 4 7 27 41 54 33 42 68 47 25 15 25 32 18 0 0 0 2 0 17 0 0 1 213 2 126 0 9 0 20 0 87 0 184 0 0 69 88 184 0 18 47 27 185 0 18 0 14 62 89 184 0 0 69 88 184 0 13 47 27 185 0 13 0 4 62 89 187 0 14 0 1 0 0 0 4 43 184 0 18 16 184 0 4 220 184 0 0 16 184 0 9 208 184 0 14 16 184 0 11 208 184 0 9 16 184 0 16 208 184 0 0 16 184 0 19 208 48 49 37 53 52 54 55 35 14 1 15 1 5 35 21 35 53 33 53 1 51 17 51 1 48 3 2 4 12 26 14 149 1 109 87 78 254 225 1 17 92 87 242 185 26 71 26 23 44 23 218 66 176 176 54 1 152 254 116 0 1 0 25 255 244 1 193 2 126 0 38 0 71 0 184 0 0 69 88 184 0 16 47 27 185 0 16 0 14 62 89 184 0 0 69 88 184 0 33 47 27 185 0 33 0 4 62 89 185 0 3 0 1 244 186 0 23 0 16 0 33 17 18 57 184 0 23 47 184 0 11 220 184 0 16 16 185 0 18 0 1 244 48 49 55 30 1 51 50 62 2 53 52 38 35 34 6 7 39 19 33 21 35 7 62 1 51 50 30 2 21 20 14 2 35 34 46 2 39 65 28 77 56 29 51 38 22 74 62 33 47 29 44 21 1 63 247 17 23 46 29 41 72 54 31 36 60 77 42 38 63 51 41 16 129 29 44 21 38 54 33 66 74 20 19 28 1 51 71 189 12 14 24 49 75 52 52 80 55 29 15 24 31 17 0 0 0 0 2 0 48 255 244 1 201 2 138 0 13 0 46 0 67 0 184 0 0 69 88 184 0 43 47 27 185 0 43 0 14 62 89 184 0 0 69 88 184 0 33 47 27 185 0 33 0 4 62 89 187 0 25 0 1 0 8 0 4 43 184 0 33 16 185 0 0 0 1 244 184 0 43 16 185 0 17 0 1 244 48 49 37 50 62 2 53 52 38 35 34 6 7 30 1 19 46 1 35 34 14 2 7 62 1 51 50 22 21 20 14 2 35 34 46 2 53 52 62 2 51 50 22 23 1 12 24 40 30 17 58 60 30 71 32 8 71 192 20 55 30 33 60 46 28 1 30 80 39 83 99 30 52 68 39 47 80 59 34 40 68 87 48 52 75 27 53 20 37 51 32 63 72 39 45 94 97 1 222 23 27 28 64 103 76 37 43 98 99 46 75 54 30 38 77 115 77 96 135 85 39 39 29 0 1 0 44 0 0 1 199 2 126 0 15 0 51 0 184 0 0 69 88 184 0 7 47 27 185 0 7 0 14 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 4 62 89 184 0 7 16 185 0 5 0 1 244 184 0 9 208 48 49 51 62 3 55 33 53 33 21 14 3 7 35 177 4 24 43 67 47 254 194 1 155 57 71 42 19 4 85 90 150 135 126 66 71 51 72 132 137 153 93 0 0 0 0 3 0 41 255 244 1 200 2 138 0 15 0 29 0 69 0 87 0 184 0 0 69 88 184 0 44 47 27 185 0 44 0 14 62 89 184 0 0 69 88 184 0 65 47 27 185 0 65 0 4 62 89 185 0 5 0 1 244 186 0 13 0 65 0 44 17 18 57 184 0 13 47 184 0 16 208 184 0 44 16 185 0 22 0 1 244 184 0 13 16 184 0 35 220 184 0 16 16 184 0 54 220 48 49 55 20 30 2 51 50 54 53 52 46 2 39 14 1 55 62 1 53 52 38 35 34 6 21 20 30 2 7 52 62 2 55 53 46 1 53 52 62 2 51 50 30 2 21 20 14 2 7 21 30 3 21 20 14 2 35 34 46 2 115 21 37 50 29 56 69 28 48 63 34 38 51 180 32 35 58 53 45 58 24 41 53 225 21 33 43 23 35 54 28 48 66 39 42 66 47 25 17 25 31 15 21 40 31 19 30 54 76 46 45 77 55 32 171 27 44 33 18 62 50 31 44 33 27 14 26 69 133 29 64 35 48 65 56 47 29 41 32 25 196 31 53 43 33 12 4 25 71 51 37 60 43 24 25 45 63 37 25 46 40 32 11 4 12 31 39 50 32 36 62 46 26 26 47 64 0 2 0 40 255 244 1 192 2 138 0 13 0 46 0 67 0 184 0 0 69 88 184 0 33 47 27 185 0 33 0 14 62 89 184 0 0 69 88 184 0 43 47 27 185 0 43 0 4 62 89 187 0 0 0 1 0 25 0 4 43 184 0 33 16 185 0 6 0 1 244 184 0 43 16 185 0 17 0 1 244 48 49 19 50 54 55 46 1 35 34 14 2 21 20 22 7 30 1 51 50 62 2 55 14 1 35 34 38 53 52 62 2 51 50 30 2 21 20 14 2 35 34 38 39 235 31 71 32 8 72 61 23 41 30 17 58 78 20 55 30 34 60 46 28 1 30 80 40 83 98 30 51 69 38 47 81 59 33 40 68 87 48 51 77 26 1 54 39 46 94 96 20 37 52 31 63 72 203 23 28 28 65 104 77 38 44 98 99 46 75 54 30 38 77 115 77 96 135 85 39 38 29 0 0 2 0 55 255 244 1 227 2 138 0 15 0 27 0 53 0 184 0 0 69 88 184 0 8 47 27 185 0 8 0 14 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 4 62 89 185 0 16 0 1 244 184 0 8 16 185 0 22 0 1 244 48 49 5 34 46 2 53 52 54 51 50 22 21 20 14 2 39 50 54 53 52 38 35 34 6 21 20 22 1 13 50 79 56 29 114 100 100 114 29 56 79 50 59 72 72 59 59 72 72 12 45 85 124 79 159 170 171 158 79 124 85 45 68 127 138 138 122 122 138 138 127 0 0 0 1 0 50 0 0 0 249 2 126 0 8 0 53 0 184 0 0 69 88 184 0 6 47 27 185 0 6 0 14 62 89 184 0 0 69 88 184 0 7 47 27 185 0 7 0 4 62 89 184 0 6 16 185 0 2 0 1 244 185 0 0 0 1 244 48 49 19 35 53 62 1 55 51 17 35 167 117 45 65 26 63 82 2 26 53 8 23 16 253 130 0 0 1 0 37 0 0 1 192 2 138 0 29 0 61 0 184 0 0 69 88 184 0 15 47 27 185 0 15 0 14 62 89 184 0 0 69 88 184 0 28 47 27 185 0 28 0 4 62 89 185 0 26 0 1 244 184 0 23 208 184 0 0 208 184 0 15 16 185 0 8 0 1 244 48 49 55 62 3 53 52 38 35 34 6 7 39 62 1 51 50 22 21 20 14 2 7 62 1 59 1 21 33 43 72 110 76 39 57 62 40 69 27 48 42 91 61 89 100 38 69 94 55 26 56 25 177 254 107 49 72 116 99 83 39 55 70 45 32 47 46 51 103 85 45 91 97 105 59 2 4 71 0 255 255 0 26 255 244 1 190 2 138 2 6 1 216 0 0 255 255 0 34 0 0 1 230 2 126 0 6 1 217 17 0 255 255 0 25 255 244 1 193 2 126 2 6 1 218 0 0 255 255 0 61 255 244 1 214 2 138 0 6 1 219 13 0 0 1 0 44 0 0 1 185 2 126 0 15 0 51 0 184 0 0 69 88 184 0 7 47 27 185 0 7 0 14 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 4 62 89 184 0 7 16 185 0 5 0 1 244 184 0 9 208 48 49 51 62 3 55 33 53 33 21 14 3 7 35 167 4 23 42 65 47 254 208 1 141 56 70 41 18 4 85 90 150 135 126 66 71 51 72 132 137 153 93 0 0 0 255 255 0 55 255 244 1 214 2 138 0 6 1 221 14 0 255 255 0 52 255 244 1 204 2 138 0 6 1 222 12 0 0 2 0 44 255 244 1 197 2 74 0 11 0 23 0 53 0 184 0 0 69 88 184 0 6 47 27 185 0 6 0 12 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 4 62 89 185 0 12 0 1 244 184 0 6 16 185 0 18 0 1 244 48 49 23 34 38 53 52 54 51 50 22 21 20 6 39 50 54 53 52 38 35 34 6 21 20 22 249 94 111 111 94 94 110 110 94 59 65 65 59 60 65 65 12 150 149 149 150 150 149 149 150 66 123 110 110 122 122 110 110 123 0 0 1 0 79 0 0 1 183 2 62 0 12 0 67 0 184 0 0 69 88 184 0 7 47 27 185 0 7 0 12 62 89 184 0 0 69 88 184 0 12 47 27 185 0 12 0 4 62 89 185 0 1 0 1 244 184 0 7 16 185 0 4 0 1 244 185 0 2 0 1 244 184 0 1 16 184 0 9 208 48 49 55 51 17 35 53 62 1 55 51 17 51 21 33 79 146 116 44 65 26 63 132 254 152 68 1 150 53 8 23 16 254 6 68 0 0 0 1 0 36 0 0 1 196 2 72 0 29 0 61 0 184 0 0 69 88 184 0 15 47 27 185 0 15 0 12 62 89 184 0 0 69 88 184 0 28 47 27 185 0 28 0 4 62 89 185 0 26 0 1 244 184 0 23 208 184 0 0 208 184 0 15 16 185 0 8 0 1 244 48 49 55 62 3 53 52 38 35 34 6 7 39 62 1 51 50 22 21 20 14 2 7 62 1 59 1 21 33 40 71 111 76 40 58 60 41 68 28 47 40 90 63 88 101 37 67 91 54 26 56 25 176 254 100 49 59 97 83 73 35 53 68 44 32 46 45 52 101 84 41 76 80 87 50 2 4 71 0 0 1 0 26 255 170 1 190 2 74 0 51 0 60 0 184 0 0 69 88 184 0 27 47 27 185 0 27 0 12 62 89 187 0 3 0 1 0 46 0 4 43 187 0 12 0 1 0 11 0 4 43 184 0 27 16 185 0 20 0 1 244 186 0 36 0 11 0 12 17 18 57 48 49 55 30 1 51 50 54 53 52 46 2 35 53 50 62 2 53 52 38 35 34 6 7 39 62 1 51 50 30 2 21 20 6 7 21 30 3 21 20 14 2 35 34 46 2 39 68 29 77 57 58 74 21 48 78 57 51 69 43 18 59 51 40 67 29 44 37 89 57 42 70 51 28 64 52 29 50 38 21 33 57 76 44 38 63 52 41 16 58 30 45 66 54 28 47 34 19 64 19 33 44 25 47 56 36 29 52 35 45 22 42 61 39 58 77 19 4 7 28 42 55 33 42 69 48 26 15 25 32 18 0 0 2 0 17 255 182 1 213 2 62 0 8 0 19 0 70 0 184 0 0 69 88 184 0 17 47 27 185 0 17 0 12 62 89 187 0 0 0 1 0 13 0 4 43 184 0 17 16 184 0 4 220 184 0 0 16 184 0 8 208 184 0 13 16 184 0 10 208 184 0 8 16 184 0 15 208 184 0 0 16 184 0 18 208 48 49 37 53 52 54 55 35 6 15 1 5 35 21 35 53 33 53 1 51 17 51 1 48 3 2 4 25 27 149 1 109 87 78 254 225 1 17 92 87 160 203 26 68 26 50 48 225 66 168 168 55 1 169 254 98 0 1 0 25 255 170 1 193 2 62 0 38 0 60 0 184 0 0 69 88 184 0 16 47 27 185 0 16 0 12 62 89 187 0 3 0 1 0 33 0 4 43 187 0 23 0 1 0 11 0 4 43 184 0 16 16 185 0 18 0 1 244 186 0 20 0 11 0 23 17 18 57 48 49 55 30 1 51 50 62 2 53 52 38 35 34 6 7 39 19 33 21 35 7 62 1 51 50 30 2 21 20 14 2 35 34 46 2 39 65 28 77 56 29 51 38 22 74 62 33 47 29 44 21 1 63 247 17 23 46 29 41 72 54 31 36 60 77 42 38 63 51 41 16 55 28 44 21 39 54 34 67 75 19 20 28 1 56 71 194 12 15 24 50 76 52 53 82 56 29 15 25 32 17 0 0 255 255 0 49 255 244 1 202 2 138 2 6 1 219 1 0 0 1 0 44 255 182 1 199 2 62 0 15 0 30 0 184 0 0 69 88 184 0 7 47 27 185 0 7 0 12 62 89 185 0 5 0 1 244 184 0 9 208 48 49 23 62 3 55 33 53 33 21 14 3 7 35 177 4 24 43 67 47 254 194 1 155 57 71 42 19 4 85 74 91 153 138 129 66 71 51 73 134 140 156 94 0 0 0 255 255 0 41 255 244 1 200 2 138 2 6 1 221 0 0 0 2 0 30 255 170 1 194 2 74 0 13 0 45 0 50 0 184 0 0 69 88 184 0 32 47 27 185 0 32 0 12 62 89 187 0 16 0 1 0 42 0 4 43 187 0 0 0 1 0 24 0 4 43 184 0 32 16 185 0 6 0 1 244 48 49 55 50 54 55 46 1 35 34 14 2 21 20 22 7 22 51 50 62 2 55 14 1 35 34 38 53 52 62 2 51 50 30 2 21 20 14 2 35 34 38 39 229 34 74 33 6 74 65 25 43 31 18 58 77 49 62 35 60 45 28 3 31 83 42 89 96 31 53 71 40 52 84 58 31 36 65 90 55 48 70 32 227 39 47 103 105 22 39 54 33 68 78 198 46 27 61 100 74 38 42 108 100 47 79 56 31 43 81 115 73 92 135 89 44 30 27 0 0 255 255 0 52 255 244 1 205 2 74 0 6 1 233 8 0 0 1 0 50 0 0 0 249 2 62 0 8 0 53 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 12 62 89 184 0 0 69 88 184 0 7 47 27 185 0 7 0 4 62 89 184 0 5 16 185 0 2 0 1 244 185 0 0 0 1 244 48 49 19 35 53 62 1 55 51 17 35 167 117 45 65 26 63 82 1 218 53 8 23 16 253 194 0 0 1 0 41 0 0 1 188 2 72 0 31 0 61 0 184 0 0 69 88 184 0 15 47 27 185 0 15 0 12 62 89 184 0 0 69 88 184 0 30 47 27 185 0 30 0 4 62 89 185 0 28 0 1 244 184 0 25 208 184 0 0 208 184 0 15 16 185 0 8 0 1 244 48 49 55 62 3 53 52 38 35 34 6 7 39 62 1 51 50 30 2 21 20 14 2 7 62 1 59 1 21 33 48 71 108 72 36 55 60 41 63 28 47 40 86 62 44 69 48 25 35 63 89 54 26 56 25 163 254 116 49 59 97 83 73 35 53 68 44 32 46 44 53 27 48 68 42 41 76 80 87 50 2 4 71 255 255 0 26 255 170 1 190 2 74 2 6 1 236 0 0 255 255 0 25 255 182 1 221 2 62 0 6 1 237 8 0 255 255 0 25 255 170 1 193 2 62 2 6 1 238 0 0 255 255 0 57 255 244 1 210 2 138 0 6 1 219 9 0 0 1 0 44 255 182 1 185 2 62 0 15 0 30 0 184 0 0 69 88 184 0 7 47 27 185 0 7 0 12 62 89 185 0 5 0 1 244 184 0 9 208 48 49 23 62 3 55 33 53 33 21 14 3 7 35 165 4 23 44 65 47 254 208 1 141 56 71 42 18 4 85 74 91 154 137 129 66 71 51 73 134 140 155 95 0 0 0 255 255 0 49 255 244 1 208 2 138 0 6 1 221 8 0 255 255 0 38 255 170 1 202 2 74 0 6 1 242 8 0 0 1 0 65 255 244 0 184 0 114 0 11 0 24 0 184 0 0 69 88 184 0 9 47 27 185 0 9 0 4 62 89 184 0 3 220 48 49 55 52 54 51 50 22 21 20 6 35 34 38 65 35 25 24 35 35 24 25 35 50 29 35 35 29 27 35 35 0 0 1 0 47 255 86 0 198 0 114 0 17 0 24 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 4 62 89 184 0 11 220 48 49 23 62 1 53 6 35 34 38 53 52 54 51 50 22 21 20 6 7 47 42 48 3 7 24 35 36 25 32 37 70 61 122 19 62 41 1 29 28 27 31 52 45 65 96 26 0 255 255 0 65 255 244 0 184 1 219 2 39 1 253 0 0 1 105 0 6 1 253 0 0 255 255 0 47 255 86 0 198 1 219 2 39 1 253 0 0 1 105 0 6 1 254 0 0 255 255 0 94 255 244 3 115 0 114 0 38 1 253 29 0 0 39 1 253 1 108 0 0 0 7 1 253 2 187 0 0 0 2 0 85 255 244 0 204 2 158 0 5 0 17 0 26 0 184 0 0 69 88 184 0 15 47 27 185 0 15 0 4 62 89 185 0 9 0 1 244 48 49 19 39 51 7 3 35 7 52 54 51 50 22 21 20 6 35 34 38 105 2 83 2 11 57 31 35 25 24 35 35 24 25 35 2 64 94 94 254 134 148 29 35 35 29 27 35 35 0 0 0 0 2 0 85 255 72 0 204 1 242 0 5 0 17 0 26 0 184 0 0 69 88 184 0 15 47 27 185 0 15 0 8 62 89 185 0 9 0 1 244 48 49 31 1 35 55 19 51 55 20 6 35 34 38 53 52 54 51 50 22 184 2 83 2 11 57 31 35 24 25 35 35 25 24 35 90 94 94 1 122 148 29 35 35 29 27 35 35 0 2 0 38 255 244 1 121 2 170 0 27 0 39 0 40 0 184 0 0 69 88 184 0 37 47 27 185 0 37 0 4 62 89 187 0 17 0 1 0 10 0 4 43 184 0 37 16 185 0 31 0 1 244 48 49 55 38 62 4 53 52 38 35 34 6 7 39 62 1 51 50 22 21 20 14 4 23 7 52 54 51 50 22 21 20 6 35 34 38 160 6 17 30 39 34 23 49 48 33 59 23 47 32 82 54 78 93 24 35 39 33 18 4 93 34 25 25 35 35 25 25 34 198 39 63 53 46 45 46 27 40 57 31 27 43 36 47 85 75 33 54 48 47 50 57 35 148 29 35 35 29 27 35 35 0 0 2 0 48 255 60 1 131 1 242 0 27 0 39 0 40 0 184 0 0 69 88 184 0 37 47 27 185 0 37 0 8 62 89 187 0 10 0 1 0 17 0 4 43 184 0 37 16 185 0 31 0 1 244 48 49 1 22 14 4 21 20 22 51 50 54 55 23 14 1 35 34 38 53 52 62 4 39 55 20 6 35 34 38 53 52 54 51 50 22 1 9 5 16 30 39 34 23 48 49 33 58 23 48 32 82 54 78 93 24 35 39 32 18 4 94 35 24 25 35 35 25 24 35 1 32 39 63 53 46 45 47 26 40 56 30 27 43 35 48 85 75 33 54 48 47 50 57 35 148 29 35 35 29 27 35 35 0 0 0 0 1 0 80 1 175 0 168 2 178 0 5 0 11 0 186 0 2 0 4 0 3 43 48 49 19 39 51 15 1 35 83 3 88 3 16 50 2 86 92 92 167 0 0 255 255 0 80 1 175 1 88 2 178 0 38 2 6 0 0 0 7 2 6 0 176 0 0 0 1 0 57 1 172 0 187 2 184 0 17 0 13 0 187 0 5 0 1 0 11 0 4 43 48 49 19 14 1 21 54 51 50 22 21 20 6 35 34 38 53 52 54 55 187 38 38 3 6 20 33 30 23 30 33 54 52 2 145 25 56 43 1 26 25 26 29 46 44 60 88 30 0 0 0 0 1 0 63 1 175 0 193 2 187 0 17 0 13 0 187 0 11 0 1 0 5 0 4 43 48 49 19 62 1 53 6 35 34 38 53 52 54 51 50 22 21 20 6 7 63 38 37 3 5 21 32 30 23 29 34 55 52 1 213 25 56 44 1 26 24 26 30 47 44 60 87 30 0 0 0 255 255 0 57 1 172 1 107 2 184 0 38 2 8 0 0 0 7 2 8 0 176 0 0 255 255 0 63 1 175 1 113 2 187 0 38 2 9 0 0 0 7 2 9 0 176 0 0 255 255 0 63 255 112 0 193 0 124 2 7 2 9 0 0 253 193 0 0 255 255 0 63 255 112 1 113 0 124 0 39 2 9 0 0 253 193 0 7 2 9 0 176 253 193 0 0 0 1 0 45 0 66 0 217 1 182 0 6 0 11 0 186 0 2 0 6 0 3 43 48 49 55 53 55 23 7 23 7 45 136 36 118 118 36 221 62 155 30 156 158 28 0 0 0 0 1 0 54 0 66 0 226 1 182 0 6 0 11 0 186 0 2 0 5 0 3 43 48 49 55 39 55 23 21 7 39 172 118 35 137 137 35 252 156 30 155 62 155 28 0 0 0 255 255 0 45 0 66 1 119 1 182 0 38 2 14 0 0 0 7 2 14 0 158 0 0 255 255 0 54 0 66 1 128 1 182 0 38 2 15 0 0 0 7 2 15 0 158 0 0 0 1 0 41 0 219 1 15 1 26 0 3 0 13 0 187 0 1 0 1 0 2 0 4 43 48 49 19 51 21 35 41 230 230 1 26 63 0 0 0 255 255 0 41 0 219 1 15 1 26 2 6 2 18 0 0 0 1 0 41 0 223 1 183 1 24 0 3 0 13 0 187 0 1 0 1 0 2 0 4 43 48 49 19 33 21 33 41 1 142 254 114 1 24 57 0 0 1 0 41 0 223 2 247 1 24 0 3 0 13 0 187 0 1 0 1 0 2 0 4 43 48 49 19 33 21 33 41 2 206 253 50 1 24 57 0 0 1 0 41 0 223 1 201 1 24 0 3 0 13 0 187 0 1 0 1 0 2 0 4 43 48 49 19 33 21 33 41 1 160 254 96 1 24 57 0 255 255 0 41 0 223 2 247 1 24 2 6 2 21 0 0 255 255 0 65 1 3 0 184 1 129 2 7 1 253 0 0 1 15 0 0 0 1 0 40 0 143 1 8 1 128 0 19 0 11 0 186 0 10 0 0 0 3 43 48 49 55 34 46 2 53 52 62 2 51 50 30 2 21 20 14 2 152 23 40 31 18 18 31 40 23 22 41 31 18 18 31 41 143 17 32 44 27 27 45 31 18 18 31 45 27 27 44 32 17 0 0 0 1 0 12 255 130 1 232 255 185 0 3 0 13 0 187 0 0 0 1 0 1 0 4 43 48 49 5 21 33 53 1 232 254 36 71 55 55 0 0 0 1 0 82 255 80 1 9 2 220 0 14 0 11 0 186 0 6 0 0 0 3 43 48 49 23 46 1 53 52 54 55 23 14 1 21 20 22 23 7 214 62 70 70 62 51 58 57 57 58 51 176 100 222 132 132 221 101 24 96 219 115 115 219 96 24 0 0 0 1 0 38 255 80 0 221 2 220 0 14 0 11 0 186 0 7 0 13 0 3 43 48 49 23 62 1 53 52 38 39 55 30 1 21 20 6 7 39 38 58 57 57 58 51 62 70 70 62 51 152 96 219 115 115 219 96 24 101 221 132 132 222 100 24 0 0 0 1 0 94 255 104 1 17 2 196 0 7 0 23 0 187 0 5 0 1 0 6 0 4 43 187 0 1 0 1 0 2 0 4 43 48 49 19 51 21 35 17 51 21 35 94 179 117 117 179 2 196 47 253 2 47 0 1 0 31 255 104 0 209 2 196 0 7 0 23 0 187 0 0 0 1 0 5 0 4 43 187 0 4 0 1 0 1 0 4 43 48 49 23 17 35 53 51 17 35 53 147 116 178 178 105 2 254 47 252 164 47 0 1 0 34 255 104 1 17 2 196 0 49 0 43 0 187 0 0 0 1 0 1 0 4 43 187 0 28 0 1 0 29 0 4 43 187 0 16 0 1 0 15 0 4 43 186 0 40 0 15 0 16 17 18 57 48 49 5 21 35 34 38 53 52 62 2 53 52 46 2 35 53 50 62 2 53 52 38 53 52 54 59 1 21 35 34 6 21 20 22 21 20 6 7 21 30 1 21 20 6 21 20 22 51 1 17 45 59 58 3 3 3 8 19 34 25 25 34 19 8 9 58 59 45 27 41 27 6 28 32 32 28 6 27 41 105 47 56 77 27 49 46 46 25 15 27 22 14 52 14 21 28 14 51 88 55 77 56 47 42 49 46 84 51 49 51 9 4 9 52 48 51 84 46 49 42 0 1 0 31 255 104 1 13 2 196 0 51 0 43 0 187 0 0 0 1 0 49 0 4 43 187 0 22 0 1 0 19 0 4 43 187 0 33 0 1 0 34 0 4 43 186 0 10 0 34 0 33 17 18 57 48 49 23 50 54 53 52 38 53 52 54 55 53 46 1 53 52 54 53 52 38 43 1 53 51 50 30 2 21 20 6 21 20 22 23 21 34 14 2 21 20 30 2 21 20 14 2 43 1 53 57 41 27 5 27 32 32 27 5 27 41 26 44 30 44 29 14 9 36 50 25 33 20 8 3 3 3 14 29 44 30 44 105 42 49 46 84 51 48 52 9 4 9 51 49 51 84 46 49 42 47 13 30 51 39 55 88 51 29 47 1 52 14 22 27 15 25 46 46 49 27 39 51 30 13 47 0 0 0 0 1 0 10 255 96 1 81 2 198 0 3 0 24 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 18 62 89 184 0 2 220 48 49 1 51 1 35 1 21 60 254 245 60 2 198 252 154 0 1 0 92 255 6 0 150 2 238 0 3 0 11 0 186 0 1 0 2 0 3 43 48 49 19 51 17 35 92 58 58 2 238 252 24 0 1 0 14 255 96 1 84 2 198 0 3 0 24 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 18 62 89 184 0 2 220 48 49 19 51 1 35 14 59 1 11 59 2 198 252 154 0 0 2 0 92 255 6 0 150 2 238 0 3 0 7 0 11 0 186 0 1 0 5 0 3 43 48 49 19 51 17 35 23 17 35 17 92 58 58 58 58 2 238 254 53 77 254 48 1 208 0 0 0 0 1 0 58 1 164 1 104 2 200 0 14 0 20 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 18 62 89 48 49 19 55 39 55 23 55 51 23 55 23 7 23 7 39 7 98 57 97 15 102 9 49 9 103 15 97 56 39 71 71 1 193 94 40 46 25 108 107 24 46 40 94 29 86 86 0 0 1 0 54 255 176 1 144 2 200 0 11 0 54 0 184 0 0 69 88 184 0 4 47 27 185 0 4 0 18 62 89 187 0 2 0 1 0 0 0 4 43 184 0 2 16 184 0 6 208 184 0 6 47 184 0 0 16 184 0 8 208 184 0 8 47 48 49 19 7 53 23 39 51 7 55 21 39 19 35 197 143 143 5 70 5 143 143 5 70 1 235 5 71 5 160 160 5 71 5 253 197 0 0 0 1 0 54 255 176 1 144 2 200 0 21 0 80 0 184 0 0 69 88 184 0 7 47 27 185 0 7 0 18 62 89 187 0 15 0 1 0 17 0 4 43 187 0 5 0 1 0 3 0 4 43 184 0 15 16 184 0 0 208 184 0 5 16 184 0 9 208 184 0 9 47 184 0 3 16 184 0 11 208 184 0 11 47 184 0 17 16 184 0 20 208 48 49 55 23 39 55 7 53 23 39 51 7 55 21 39 23 7 55 21 39 23 35 55 7 54 143 5 5 143 143 5 70 5 143 143 5 5 143 143 5 70 5 143 146 7 177 177 7 71 5 160 160 5 71 7 177 177 7 71 5 160 160 5 0 0 2 0 45 255 192 1 196 2 172 0 15 0 71 0 23 0 187 0 47 0 1 0 40 0 4 43 187 0 68 0 1 0 19 0 4 43 48 49 37 62 1 53 52 46 2 39 14 1 21 20 30 2 19 46 1 35 34 6 21 20 30 4 21 20 6 7 30 1 21 20 14 2 35 34 38 39 55 30 1 51 50 54 53 52 46 4 53 52 54 55 46 1 53 52 62 2 51 50 22 23 1 64 29 31 40 60 71 31 29 32 40 61 71 76 24 54 33 42 37 41 62 71 62 41 47 38 14 16 24 43 59 35 54 88 31 50 25 58 40 40 45 41 61 72 61 41 48 38 15 17 19 39 56 38 48 77 29 193 14 38 33 34 44 33 28 18 16 40 31 33 43 32 29 1 107 20 26 37 26 27 36 30 30 43 61 46 48 59 22 17 39 26 30 50 36 21 38 33 45 24 28 40 29 28 38 30 29 42 61 46 44 64 21 16 40 26 26 47 36 21 34 23 0 0 2 0 41 255 176 1 208 2 144 0 3 0 16 0 37 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 16 62 89 184 0 0 69 88 184 0 14 47 27 185 0 14 0 16 62 89 48 49 1 51 17 35 3 34 46 2 53 52 62 2 59 1 17 1 124 84 84 87 54 93 67 38 36 65 88 52 44 2 144 253 32 1 50 25 53 82 57 59 81 51 22 254 82 0 0 0 3 0 49 255 245 2 183 2 141 0 19 0 39 0 69 0 51 0 187 0 58 0 1 0 65 0 4 43 187 0 45 0 1 0 52 0 4 43 184 0 45 16 184 0 35 220 185 0 5 0 1 244 184 0 65 16 184 0 25 220 185 0 15 0 1 244 48 49 19 52 62 2 51 50 30 2 21 20 14 2 35 34 46 2 55 20 30 2 51 50 62 2 53 52 46 2 35 34 14 2 23 52 62 2 51 50 22 23 7 46 1 35 34 6 21 20 22 51 50 54 55 23 14 1 35 34 46 2 49 52 88 118 65 65 117 89 52 52 89 117 65 65 118 88 52 47 44 75 100 57 57 100 75 44 44 75 100 57 57 100 75 44 102 31 51 67 36 42 59 24 35 20 41 26 55 67 65 54 32 48 22 30 28 62 45 38 66 50 28 1 67 76 122 86 46 46 86 122 76 77 123 87 47 47 87 123 77 66 107 77 42 42 77 107 66 65 107 76 41 41 76 107 65 43 70 50 26 33 24 39 20 21 75 59 66 77 25 19 42 24 33 27 51 73 0 0 0 0 4 0 49 255 245 2 183 2 141 0 14 0 23 0 43 0 63 0 77 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 8 62 89 184 0 0 69 88 184 0 39 47 27 185 0 39 0 4 62 89 187 0 29 0 1 0 59 0 4 43 187 0 15 0 1 0 11 0 4 43 184 0 0 16 185 0 21 0 1 244 184 0 39 16 185 0 49 0 1 244 48 49 19 51 50 30 2 21 20 14 2 43 1 21 35 55 50 54 53 52 38 43 1 21 37 52 62 2 51 50 30 2 21 20 14 2 35 34 46 2 55 20 30 2 51 50 62 2 53 52 46 2 35 34 14 2 253 138 31 54 40 23 23 40 54 31 73 65 127 45 49 49 45 62 254 243 52 88 118 65 65 117 89 52 52 89 117 65 65 118 88 52 47 44 75 100 57 57 100 75 44 44 75 100 57 57 100 75 44 1 244 14 28 45 30 33 49 33 16 115 165 37 42 36 32 147 21 76 122 86 46 46 86 122 76 77 123 87 47 47 87 123 77 66 107 77 42 42 77 107 66 65 107 76 41 41 76 107 0 0 0 0 4 0 23 1 63 1 144 2 201 0 19 0 39 0 53 0 61 0 87 0 184 0 52 47 184 0 41 47 184 0 52 16 184 0 20 220 185 0 0 0 1 244 184 0 41 16 184 0 30 220 185 0 10 0 1 244 186 0 50 0 52 0 41 17 18 57 184 0 50 47 185 0 54 0 1 244 186 0 47 0 54 0 50 17 18 57 184 0 52 16 184 0 49 208 184 0 41 16 185 0 59 0 1 244 48 49 19 34 46 2 53 52 62 2 51 50 30 2 21 20 14 2 39 50 62 2 53 52 46 2 35 34 14 2 21 20 30 2 3 51 50 22 21 20 6 7 23 35 39 35 21 35 55 50 53 52 38 43 1 21 211 39 68 51 30 30 51 68 39 39 69 51 30 30 51 69 39 31 55 40 23 23 40 55 31 32 54 39 23 23 39 54 40 76 32 46 20 17 46 46 35 41 41 67 43 18 23 28 1 63 29 52 72 44 44 72 52 29 29 52 72 44 44 72 52 29 37 23 42 59 36 35 59 43 24 24 43 59 35 36 59 42 23 1 8 29 36 18 31 6 83 70 70 102 34 15 18 67 0 0 2 0 3 1 110 2 96 2 164 0 19 0 27 0 93 0 184 0 26 47 184 0 23 47 184 0 0 208 184 0 26 16 184 0 18 208 186 0 14 0 18 0 0 17 18 57 184 0 14 47 185 0 3 0 1 244 184 0 0 16 184 0 6 208 184 0 18 16 184 0 9 208 184 0 6 16 185 0 12 0 1 244 184 0 0 16 185 0 16 0 1 244 184 0 23 16 185 0 25 0 1 244 184 0 20 208 48 49 1 51 31 1 51 63 1 51 17 35 53 55 35 7 35 39 35 23 21 35 3 35 53 33 21 35 17 35 1 54 75 46 27 4 27 45 74 57 6 4 71 45 72 4 7 58 208 99 1 3 100 60 2 164 112 79 79 112 254 202 137 105 194 194 105 137 1 0 54 54 255 0 0 0 0 0 2 0 27 1 98 2 96 2 171 0 41 0 61 0 123 0 184 0 60 47 184 0 42 47 184 0 60 16 184 0 0 208 184 0 0 47 185 0 7 0 1 244 184 0 42 16 184 0 20 208 184 0 20 47 186 0 10 0 0 0 20 17 18 57 185 0 27 0 1 244 186 0 30 0 20 0 0 17 18 57 186 0 56 0 60 0 42 17 18 57 184 0 56 47 185 0 45 0 1 244 184 0 42 16 184 0 48 208 184 0 60 16 184 0 51 208 184 0 48 16 185 0 54 0 1 244 184 0 42 16 185 0 58 0 1 244 48 49 19 34 38 39 55 30 1 51 50 54 53 52 38 47 1 46 1 53 52 54 51 50 22 23 7 46 1 35 34 6 21 20 22 31 1 30 1 21 20 14 2 19 51 31 1 51 63 1 51 17 35 53 55 35 7 35 39 35 23 21 35 140 33 57 23 33 18 41 25 23 26 21 22 47 23 37 58 47 28 50 17 29 16 36 17 23 24 22 20 46 29 34 15 29 40 145 75 46 27 4 27 45 74 57 6 4 71 45 72 4 7 58 1 98 25 23 37 17 21 21 18 20 15 11 23 11 40 35 39 49 22 16 39 12 18 23 15 15 19 9 23 13 39 35 18 32 26 15 1 66 112 79 79 112 254 202 137 105 194 194 105 137 0 0 0 0 2 0 51 255 101 3 28 2 134 0 69 0 84 0 63 0 187 0 59 0 1 0 65 0 4 43 187 0 39 0 1 0 15 0 4 43 187 0 73 0 1 0 22 0 4 43 187 0 30 0 1 0 80 0 4 43 187 0 5 0 1 0 49 0 4 43 186 0 34 0 80 0 30 17 18 57 48 49 55 52 62 2 51 50 30 2 21 20 14 2 35 34 38 39 35 14 1 35 34 38 53 52 62 2 51 50 22 23 51 55 51 7 6 51 50 62 2 53 52 46 2 35 34 14 2 21 20 30 2 51 50 54 55 23 6 35 34 46 2 37 20 22 51 50 54 63 1 46 1 35 34 14 2 51 67 115 151 84 76 121 85 46 37 58 71 34 41 57 5 2 25 64 33 51 69 27 50 71 44 26 40 14 2 11 55 39 30 84 24 47 39 24 35 70 104 68 67 126 98 59 45 80 109 64 46 82 34 22 85 105 74 128 95 55 1 8 40 30 21 45 26 29 14 30 20 30 47 33 17 203 100 164 116 63 48 87 122 74 66 99 67 34 38 38 29 39 72 69 40 83 67 42 23 25 40 200 117 28 53 77 49 60 103 74 42 55 100 142 88 73 114 78 41 25 20 49 51 46 91 134 87 48 42 28 31 159 23 19 32 50 60 0 2 0 51 255 232 2 220 2 176 0 73 0 87 0 63 0 187 0 62 0 1 0 69 0 4 43 187 0 5 0 1 0 52 0 4 43 187 0 42 0 1 0 15 0 4 43 187 0 74 0 1 0 22 0 4 43 187 0 32 0 1 0 80 0 4 43 186 0 36 0 80 0 32 17 18 57 48 49 19 52 62 2 51 50 30 2 21 20 14 2 35 34 38 39 35 14 1 35 34 46 2 53 52 62 2 51 50 22 23 51 55 51 7 6 22 51 50 62 2 53 52 46 2 35 34 14 2 21 20 30 2 51 50 54 55 23 14 1 35 34 46 2 37 50 63 1 46 1 35 34 14 2 21 20 22 51 62 105 139 78 67 109 78 43 31 52 66 34 38 48 5 2 23 62 35 22 39 30 17 25 47 68 42 24 39 13 2 12 56 40 14 21 35 19 42 33 22 32 62 92 61 61 114 89 53 41 71 96 55 35 68 28 23 38 78 44 65 114 87 50 1 47 40 49 27 14 26 20 27 43 30 16 34 1 34 90 147 104 57 42 76 107 66 60 93 63 33 41 36 29 40 18 34 48 29 38 78 63 40 23 25 40 178 60 54 24 48 71 46 54 89 64 35 48 90 126 78 68 99 65 32 17 17 46 22 19 39 78 118 1 58 137 23 18 29 46 55 26 41 39 0 0 0 0 2 0 35 0 0 1 211 2 138 0 27 0 31 0 155 0 184 0 0 69 88 184 0 8 47 27 185 0 8 0 14 62 89 184 0 0 69 88 184 0 12 47 27 185 0 12 0 14 62 89 184 0 0 69 88 184 0 22 47 27 185 0 22 0 4 62 89 184 0 0 69 88 184 0 26 47 27 185 0 26 0 4 62 89 187 0 3 0 1 0 0 0 4 43 187 0 7 0 1 0 4 0 4 43 184 0 7 16 184 0 10 208 184 0 7 16 184 0 14 208 184 0 4 16 184 0 16 208 184 0 3 16 184 0 18 208 184 0 0 16 184 0 20 208 184 0 0 16 184 0 24 208 184 0 3 16 184 0 28 208 184 0 4 16 184 0 29 208 48 49 55 35 53 51 55 35 53 51 55 51 7 51 55 51 7 51 21 35 7 51 21 35 7 35 55 35 7 35 19 55 35 7 115 80 87 18 85 92 23 53 23 133 24 53 24 81 87 18 85 92 25 53 24 132 25 54 218 18 132 18 204 57 148 58 183 183 183 183 58 148 57 204 204 204 1 5 148 148 0 0 0 255 255 0 35 1 172 1 77 3 74 2 7 2 78 0 0 1 184 0 0 255 255 0 87 1 184 0 236 3 62 2 7 2 79 0 0 1 184 0 0 255 255 0 40 1 184 1 64 3 74 2 7 2 80 0 0 1 184 0 0 255 255 0 35 1 172 1 63 3 74 2 7 2 81 0 0 1 184 0 0 255 255 0 42 1 184 1 80 3 62 2 7 2 82 0 0 1 184 0 0 255 255 0 35 1 172 1 67 3 62 2 7 2 83 0 0 1 184 0 0 255 255 0 45 1 172 1 70 3 74 2 7 2 84 0 0 1 184 0 0 255 255 0 50 1 184 1 67 3 62 2 7 2 85 0 0 1 184 0 0 255 255 0 45 1 172 1 64 3 74 2 7 2 86 0 0 1 184 0 0 255 255 0 39 1 172 1 64 3 74 2 7 2 87 0 0 1 184 0 0 255 255 0 65 1 105 0 198 3 139 2 7 2 88 0 0 1 184 0 0 255 255 0 39 1 105 0 172 3 139 2 7 2 89 0 0 1 184 0 0 255 255 0 43 1 176 0 134 2 15 2 7 2 90 0 0 1 184 0 0 255 255 0 33 1 68 0 144 2 15 2 7 2 91 0 0 1 184 0 0 255 255 0 35 255 37 1 77 0 195 2 7 2 78 0 0 255 49 0 0 255 255 0 87 255 49 0 236 0 183 2 7 2 79 0 0 255 49 0 0 255 255 0 40 255 49 1 64 0 195 2 7 2 80 0 0 255 49 0 0 255 255 0 35 255 37 1 63 0 195 2 7 2 81 0 0 255 49 0 0 255 255 0 42 255 49 1 80 0 183 2 7 2 82 0 0 255 49 0 0 255 255 0 35 255 37 1 67 0 183 2 7 2 83 0 0 255 49 0 0 255 255 0 45 255 37 1 70 0 195 2 7 2 84 0 0 255 49 0 0 255 255 0 50 255 49 1 67 0 183 2 7 2 85 0 0 255 49 0 0 255 255 0 45 255 37 1 64 0 195 2 7 2 86 0 0 255 49 0 0 255 255 0 39 255 37 1 64 0 195 2 7 2 87 0 0 255 49 0 0 255 255 0 65 254 226 0 198 1 4 2 7 2 88 0 0 255 49 0 0 255 255 0 39 254 226 0 172 1 4 2 7 2 89 0 0 255 49 0 0 255 255 0 43 255 41 0 134 255 136 2 7 2 90 0 0 255 49 0 0 255 255 0 33 254 189 0 144 255 136 2 7 2 91 0 0 255 49 0 0 0 2 0 35 255 244 1 77 1 146 0 11 0 23 0 40 0 184 0 6 47 184 0 0 69 88 184 0 0 47 27 185 0 0 0 4 62 89 185 0 12 0 1 244 184 0 6 16 185 0 18 0 1 244 48 49 23 34 38 53 52 54 51 50 22 21 20 6 39 50 54 53 52 38 35 34 6 21 20 22 184 68 81 81 68 67 82 82 67 38 48 48 38 39 48 48 12 108 100 99 107 107 99 100 108 51 79 78 78 77 77 78 78 79 0 0 0 1 0 87 0 0 0 236 1 134 0 8 0 34 0 184 0 6 47 184 0 0 69 88 184 0 8 47 27 185 0 8 0 4 62 89 184 0 6 16 185 0 0 0 1 244 48 49 19 35 53 62 1 55 51 17 35 172 85 33 44 20 52 64 1 52 42 6 19 15 254 122 0 1 0 40 0 0 1 64 1 146 0 26 0 44 0 184 0 15 47 184 0 0 69 88 184 0 25 47 27 185 0 25 0 4 62 89 185 0 23 0 1 244 184 0 0 208 184 0 15 16 185 0 8 0 1 244 48 49 55 62 3 53 52 38 35 34 6 7 39 62 1 51 50 22 21 20 14 2 7 51 21 33 52 45 70 46 24 40 35 25 42 17 38 23 67 40 59 71 22 39 53 31 165 254 244 37 41 65 54 47 22 38 44 33 24 35 34 42 64 62 28 52 53 56 32 55 0 0 0 1 0 35 255 244 1 63 1 146 0 42 0 62 0 184 0 23 47 184 0 0 69 88 184 0 39 47 27 185 0 39 0 4 62 89 186 0 10 0 9 0 3 43 184 0 39 16 185 0 3 0 1 244 184 0 23 16 185 0 16 0 1 244 186 0 31 0 9 0 10 17 18 57 48 49 55 30 1 51 50 54 53 52 38 35 53 50 54 53 52 38 35 34 6 7 39 62 1 51 50 30 2 21 20 6 7 30 1 21 20 14 2 35 34 38 39 78 18 50 31 32 46 64 57 51 55 39 32 22 40 17 39 26 61 41 25 45 34 20 38 30 33 51 22 38 51 28 48 74 23 97 27 31 36 34 34 35 41 40 30 28 34 27 20 34 29 35 14 27 39 25 35 47 14 8 49 39 27 43 31 16 43 33 0 2 0 42 0 0 1 80 1 134 0 5 0 16 0 76 0 184 0 14 47 184 0 0 69 88 184 0 9 47 27 185 0 9 0 4 62 89 187 0 0 0 1 0 10 0 4 43 184 0 14 16 185 0 2 0 1 244 184 0 0 16 184 0 5 208 184 0 10 16 184 0 7 208 184 0 5 16 184 0 12 208 184 0 0 16 184 0 15 208 48 49 55 53 55 35 15 1 23 35 21 35 53 35 53 55 51 21 51 220 4 4 50 61 227 58 58 178 164 72 58 150 70 109 81 98 46 104 104 33 253 240 0 1 0 35 255 244 1 67 1 134 0 34 0 52 0 184 0 14 47 184 0 0 69 88 184 0 31 47 27 185 0 31 0 4 62 89 186 0 21 0 9 0 3 43 184 0 31 16 185 0 3 0 1 244 184 0 14 16 185 0 16 0 1 244 48 49 55 30 1 51 50 54 53 52 38 35 34 6 7 39 55 51 21 35 7 62 1 51 50 30 2 21 20 14 2 35 34 38 39 78 19 48 34 35 45 46 36 23 35 16 31 18 213 160 11 14 32 17 26 47 35 20 22 37 51 30 52 73 23 97 27 31 48 38 40 46 18 14 23 188 56 95 6 9 17 34 49 31 30 50 35 20 43 33 0 0 0 2 0 45 255 244 1 70 1 146 0 11 0 39 0 54 0 184 0 36 47 184 0 0 69 88 184 0 28 47 27 185 0 28 0 4 62 89 187 0 6 0 1 0 20 0 4 43 184 0 28 16 185 0 0 0 1 244 184 0 36 16 185 0 15 0 1 244 48 49 55 50 54 53 52 38 35 34 6 7 30 1 19 46 1 35 34 6 7 54 51 50 22 21 20 14 2 35 34 38 53 52 62 2 51 50 22 23 195 32 39 38 37 22 40 23 5 48 125 14 33 20 44 62 5 43 55 59 63 20 35 47 28 69 82 26 46 62 36 34 44 17 39 45 35 35 44 19 24 58 58 1 32 10 14 71 75 40 69 56 28 48 36 20 104 93 55 82 54 26 18 12 0 1 0 50 0 0 1 67 1 134 0 15 0 38 0 184 0 7 47 184 0 0 69 88 184 0 0 47 27 185 0 0 0 4 62 89 184 0 7 16 185 0 5 0 1 244 184 0 9 208 48 49 51 62 3 55 35 53 33 21 14 3 7 35 131 3 16 28 43 30 201 1 17 36 45 28 13 3 67 51 86 80 77 41 55 36 45 84 85 89 51 0 0 3 0 45 255 244 1 64 1 146 0 12 0 24 0 58 0 74 0 184 0 37 47 184 0 0 69 88 184 0 54 47 27 185 0 54 0 4 62 89 185 0 3 0 1 244 186 0 11 0 54 0 37 17 18 57 184 0 11 47 184 0 13 208 184 0 37 16 185 0 19 0 1 244 184 0 11 16 184 0 28 220 184 0 13 16 184 0 45 220 48 49 55 20 22 51 50 54 53 52 46 2 39 6 55 62 1 53 52 38 35 34 6 21 20 22 7 52 54 55 53 46 1 53 52 62 2 51 50 22 21 20 14 2 7 21 30 1 21 20 14 2 35 34 46 2 105 42 35 32 46 17 28 36 20 54 100 22 20 38 27 26 36 50 125 45 29 26 32 19 33 44 25 53 72 11 18 21 10 34 39 21 37 50 30 31 50 36 20 103 26 42 39 28 18 24 18 14 8 32 71 17 37 20 26 30 31 24 30 34 137 37 55 17 4 17 41 31 23 38 27 15 55 48 17 28 24 18 7 4 17 49 35 24 41 30 17 17 30 40 0 2 0 39 255 244 1 64 1 146 0 11 0 39 0 54 0 184 0 28 47 184 0 0 69 88 184 0 36 47 27 185 0 36 0 4 62 89 187 0 20 0 1 0 0 0 4 43 184 0 28 16 185 0 6 0 1 244 184 0 36 16 185 0 15 0 1 244 48 49 55 50 54 55 46 1 35 34 6 21 20 22 7 30 1 51 50 54 55 6 35 34 38 53 52 62 2 51 50 22 21 20 14 2 35 34 38 39 173 23 40 23 5 48 37 31 40 39 56 14 33 20 44 62 5 43 55 59 63 20 34 48 27 70 82 26 46 62 36 34 45 17 192 19 24 58 58 45 35 35 44 129 10 14 72 75 41 69 56 28 48 36 20 104 93 55 82 54 26 18 12 0 0 1 0 65 255 177 0 198 1 211 0 14 0 11 0 186 0 6 0 0 0 3 43 48 49 23 46 1 53 52 54 55 23 14 1 21 20 22 23 7 153 43 45 45 43 45 38 33 33 38 45 79 61 128 85 84 127 61 22 59 125 66 67 125 60 22 0 0 0 1 0 39 255 177 0 172 1 211 0 14 0 11 0 186 0 7 0 13 0 3 43 48 49 23 62 1 53 52 38 39 55 30 1 21 20 6 7 39 39 38 33 33 38 47 41 45 44 42 47 57 60 125 67 66 125 59 22 61 127 84 85 128 61 22 0 0 0 1 0 43 255 248 0 134 0 87 0 11 0 26 0 184 0 0 69 88 184 0 9 47 27 185 0 9 0 4 62 89 185 0 3 0 1 244 48 49 55 52 54 51 50 22 21 20 6 35 34 38 43 26 20 20 25 25 20 20 26 39 22 26 26 22 21 26 26 0 0 0 0 1 0 33 255 140 0 144 0 87 0 17 0 43 0 184 0 0 69 88 184 0 3 47 27 185 0 3 0 4 62 89 184 0 0 69 88 184 0 5 47 27 185 0 5 0 4 62 89 185 0 11 0 1 244 48 49 23 62 1 55 6 35 34 38 53 52 54 51 50 22 21 20 6 7 33 29 34 1 3 5 17 28 28 19 25 28 50 45 79 11 39 29 1 21 21 21 25 37 36 45 68 17 0 255 255 0 35 0 254 1 77 2 156 2 7 2 78 0 0 1 10 0 0 255 255 0 87 1 10 0 236 2 144 2 7 2 79 0 0 1 10 0 0 255 255 0 40 1 10 1 64 2 156 2 7 2 80 0 0 1 10 0 0 255 255 0 35 0 254 1 63 2 156 2 7 2 81 0 0 1 10 0 0 255 255 0 42 1 10 1 80 2 144 2 7 2 82 0 0 1 10 0 0 255 255 0 35 0 254 1 67 2 144 2 7 2 83 0 0 1 10 0 0 255 255 0 45 0 254 1 70 2 156 2 7 2 84 0 0 1 10 0 0 255 255 0 50 1 10 1 67 2 144 2 7 2 85 0 0 1 10 0 0 255 255 0 45 0 254 1 64 2 156 2 7 2 86 0 0 1 10 0 0 255 255 0 39 0 254 1 64 2 156 2 7 2 87 0 0 1 10 0 0 255 255 0 65 0 187 0 198 2 221 2 7 2 88 0 0 1 10 0 0 255 255 0 39 0 187 0 172 2 221 2 7 2 89 0 0 1 10 0 0 255 255 0 43 1 2 0 134 1 97 2 7 2 90 0 0 1 10 0 0 255 255 0 33 0 150 0 144 1 97 2 7 2 91 0 0 1 10 0 0 255 255 0 37 1 2 1 42 2 84 2 6 2 109 0 0 255 255 0 33 1 2 1 66 2 84 2 6 2 138 0 0 255 255 0 30 1 2 1 78 2 84 2 6 2 123 0 0 0 2 0 37 1 2 1 42 2 84 0 25 0 34 0 59 0 184 0 0 47 184 0 16 47 187 0 6 0 1 0 29 0 4 43 184 0 16 16 185 0 9 0 1 244 184 0 0 16 184 0 21 208 184 0 0 16 185 0 26 0 1 244 186 0 23 0 0 0 26 17 18 57 48 49 19 34 38 53 52 54 55 46 1 35 34 6 7 39 62 1 51 50 22 29 1 35 39 35 14 1 39 50 55 53 14 1 21 20 22 136 45 54 95 104 1 26 35 26 55 20 23 25 69 39 60 55 50 7 4 20 50 13 39 43 77 61 30 1 2 52 43 53 55 10 32 42 21 13 42 16 27 70 64 196 37 18 27 50 40 85 9 38 28 26 24 0 0 0 2 0 52 1 2 1 85 2 223 0 20 0 32 0 63 0 184 0 6 47 184 0 14 47 184 0 1 47 184 0 6 16 185 0 30 0 1 244 186 0 3 0 30 0 6 17 18 57 184 0 14 16 185 0 24 0 1 244 186 0 18 0 14 0 24 17 18 57 184 0 14 16 184 0 19 208 48 49 19 51 21 7 62 1 51 50 22 21 20 14 2 35 34 38 39 35 7 35 55 30 1 51 50 54 53 52 38 35 34 7 52 62 3 23 49 28 63 67 23 39 50 28 23 48 20 4 6 48 62 20 41 17 36 49 39 42 40 42 2 223 126 58 19 26 88 75 42 65 45 23 21 20 33 75 17 15 64 60 52 59 42 0 0 0 1 0 30 1 2 1 34 2 84 0 27 0 31 0 184 0 8 47 184 0 0 47 184 0 8 16 185 0 15 0 1 244 184 0 0 16 185 0 21 0 1 244 48 49 19 34 38 53 52 62 2 51 50 22 23 7 46 1 35 34 6 21 20 22 51 50 54 55 23 14 1 184 67 87 25 43 57 31 35 49 15 30 15 28 22 42 55 54 43 26 34 14 26 17 51 1 2 88 81 40 63 43 23 22 13 41 13 12 65 53 52 66 17 11 41 14 24 0 0 0 2 0 33 1 2 1 66 2 223 0 20 0 33 0 63 0 184 0 0 47 184 0 8 47 184 0 13 47 184 0 8 16 185 0 28 0 1 244 186 0 11 0 28 0 8 17 18 57 184 0 0 16 184 0 16 208 184 0 0 16 185 0 21 0 1 244 186 0 18 0 0 0 21 17 18 57 48 49 19 34 38 53 52 62 2 51 50 22 23 39 53 51 17 35 39 35 14 1 39 50 54 55 53 46 1 35 34 6 21 20 22 170 64 73 23 39 51 27 26 44 20 3 62 50 7 3 20 44 14 20 36 20 20 39 18 35 51 42 1 2 91 84 37 61 42 23 19 17 55 120 254 43 35 17 26 51 22 20 162 17 15 62 50 60 64 0 0 0 2 0 28 1 2 1 54 2 84 0 28 0 37 0 41 0 184 0 10 47 184 0 0 47 187 0 18 0 1 0 29 0 4 43 184 0 0 16 185 0 22 0 1 244 184 0 10 16 185 0 34 0 1 244 48 49 19 34 46 2 53 52 62 2 51 50 30 2 21 20 6 7 35 30 1 51 50 54 55 23 14 1 55 52 46 2 35 34 6 7 186 33 58 42 25 24 41 55 30 37 51 31 13 2 2 217 3 56 45 23 42 17 24 23 57 36 8 18 29 22 36 48 6 1 2 22 44 62 41 39 63 43 24 28 44 52 24 11 13 11 50 55 14 11 39 15 21 196 16 34 26 17 49 44 0 0 1 0 19 1 10 0 220 2 234 0 22 0 47 0 184 0 20 47 184 0 11 47 184 0 7 47 184 0 20 16 185 0 3 0 1 244 184 0 7 16 185 0 10 0 1 244 184 0 13 208 184 0 7 16 184 0 16 208 48 49 19 46 1 35 34 6 29 1 51 21 35 17 35 17 35 53 55 53 52 54 51 50 23 207 7 18 12 22 22 68 68 62 45 45 48 52 33 23 2 177 3 4 33 29 46 49 254 239 1 17 46 3 42 50 66 11 0 0 0 0 3 0 30 0 120 1 76 2 84 0 14 0 66 0 78 0 61 0 184 0 33 47 184 0 64 47 187 0 56 0 1 0 9 0 4 43 187 0 67 0 1 0 46 0 4 43 184 0 64 16 185 0 3 0 1 244 186 0 18 0 9 0 56 17 18 57 184 0 33 16 185 0 73 0 1 244 48 49 55 20 22 51 50 54 53 52 38 43 1 34 38 39 6 7 52 55 53 46 1 53 52 54 55 53 46 1 53 52 62 2 51 50 23 51 21 35 30 1 21 20 14 2 35 34 38 39 14 1 21 20 22 59 1 50 22 21 20 14 2 35 34 38 55 50 54 53 52 38 35 34 6 21 20 22 83 48 43 44 54 33 30 53 8 23 11 31 53 46 13 16 22 14 17 26 20 35 45 26 28 23 110 62 10 13 19 33 45 25 11 25 12 8 11 24 32 62 59 56 23 44 62 39 60 74 136 27 39 39 27 29 38 38 215 25 27 37 23 20 16 1 3 22 35 42 28 4 8 26 19 19 30 9 4 13 44 29 27 43 29 16 9 48 10 33 17 26 42 29 15 4 6 7 16 12 15 16 37 42 23 41 30 18 44 245 39 33 33 37 36 34 33 39 0 0 0 0 1 0 52 1 10 1 65 2 223 0 19 0 29 0 184 0 6 47 184 0 18 47 184 0 11 47 184 0 1 47 184 0 6 16 185 0 15 0 1 244 48 49 19 51 21 7 62 1 51 50 22 29 1 35 53 52 38 35 34 7 21 35 52 62 3 20 56 32 56 46 62 23 38 37 47 62 2 223 126 66 21 32 70 56 204 195 38 44 47 230 0 0 2 0 42 1 10 0 126 2 216 0 11 0 15 0 21 0 184 0 14 47 184 0 13 47 187 0 6 0 1 0 0 0 4 43 48 49 19 34 38 53 52 54 51 50 22 21 20 6 7 51 17 35 84 18 24 24 18 18 24 24 50 62 62 2 138 22 17 17 22 22 17 17 22 62 254 190 0 0 0 0 2 255 230 0 122 0 128 2 216 0 15 0 27 0 31 0 184 0 0 47 184 0 12 47 187 0 22 0 1 0 16 0 4 43 184 0 0 16 185 0 7 0 1 244 48 49 55 34 38 39 55 30 1 51 50 54 53 17 51 17 20 6 19 34 38 53 52 54 51 50 22 21 20 6 23 17 21 11 13 6 12 10 23 16 62 42 12 18 24 24 18 18 24 24 122 3 5 48 2 3 31 29 1 99 254 161 54 61 2 16 22 17 17 22 22 17 17 22 0 0 1 0 52 1 10 1 76 2 223 0 12 0 39 0 184 0 11 47 184 0 8 47 184 0 4 47 184 0 1 47 186 0 2 0 11 0 1 17 18 57 186 0 9 0 11 0 1 17 18 57 48 49 19 51 17 51 55 51 7 23 35 39 7 21 35 52 62 4 131 69 112 126 69 93 56 62 2 223 254 204 161 132 190 148 66 82 0 0 1 0 52 1 2 0 153 2 223 0 14 0 21 0 184 0 11 47 184 0 1 47 184 0 11 16 185 0 4 0 1 244 48 49 19 51 17 20 51 58 1 55 23 14 1 35 34 38 53 52 62 16 3 6 5 9 7 16 13 36 29 2 223 254 111 25 2 46 3 4 44 38 0 0 0 0 1 0 52 1 10 1 255 2 84 0 34 0 45 0 184 0 33 47 184 0 24 47 184 0 15 47 184 0 6 47 184 0 1 208 184 0 6 16 184 0 11 208 184 0 6 16 185 0 29 0 1 244 184 0 20 208 48 49 19 51 23 51 62 1 51 50 23 62 1 51 50 22 29 1 35 53 52 38 35 34 6 7 21 35 53 52 38 35 34 6 7 21 35 52 50 5 4 20 48 33 67 23 23 53 32 54 47 62 24 35 18 37 23 62 24 35 17 37 23 62 2 76 46 23 31 60 24 36 69 57 204 195 38 44 22 25 230 195 38 44 22 25 230 0 1 0 52 1 10 1 65 2 84 0 19 0 33 0 184 0 6 47 184 0 18 47 184 0 11 47 184 0 6 16 184 0 1 208 184 0 6 16 185 0 15 0 1 244 48 49 19 51 23 51 62 1 51 50 22 29 1 35 53 52 38 35 34 7 21 35 52 49 6 4 21 55 32 56 46 62 23 37 38 47 62 2 76 46 23 31 70 56 204 195 38 44 47 230 0 0 2 0 30 1 2 1 78 2 84 0 19 0 31 0 27 0 184 0 10 47 184 0 0 47 185 0 20 0 1 244 184 0 10 16 185 0 26 0 1 244 48 49 19 34 46 2 53 52 62 2 51 50 30 2 21 20 14 2 39 50 54 53 52 38 35 34 6 21 20 22 182 31 55 42 24 24 42 55 31 31 55 42 24 24 42 55 31 42 46 46 42 42 47 47 1 2 23 43 63 40 40 63 43 23 23 43 63 40 40 63 43 23 51 65 53 54 64 64 54 53 65 0 0 0 2 0 52 0 129 1 85 2 84 0 20 0 32 0 43 0 184 0 6 47 184 0 14 47 184 0 19 47 184 0 6 16 184 0 1 208 184 0 14 16 185 0 24 0 1 244 184 0 6 16 185 0 30 0 1 244 48 49 19 51 23 51 62 1 51 50 22 21 20 14 2 35 34 38 39 23 21 35 55 30 1 51 50 54 53 52 38 35 34 7 52 49 7 3 20 51 29 63 67 23 39 50 28 22 49 20 4 62 62 20 41 17 36 49 39 42 40 42 2 76 37 17 28 88 75 42 65 45 23 20 17 62 104 212 17 15 64 60 52 59 42 0 0 0 2 0 33 0 129 1 66 2 84 0 19 0 31 0 43 0 184 0 12 47 184 0 4 47 184 0 19 47 184 0 12 16 184 0 16 208 184 0 4 16 185 0 20 0 1 244 184 0 12 16 185 0 26 0 1 244 48 49 37 55 14 1 35 34 38 53 52 62 2 51 50 23 51 55 51 17 35 39 50 55 53 46 1 35 34 6 21 20 22 1 4 3 18 48 26 64 74 24 39 51 27 52 38 4 6 48 62 76 38 38 20 39 18 35 51 42 240 59 18 23 90 79 40 62 44 23 40 32 254 53 181 37 165 17 15 62 54 55 63 0 1 0 52 1 10 0 241 2 84 0 16 0 29 0 184 0 5 47 184 0 15 47 184 0 5 16 184 0 1 208 184 0 5 16 185 0 11 0 1 244 48 49 19 51 23 51 54 51 50 23 7 46 1 35 34 6 7 21 35 52 50 7 3 38 53 24 14 12 6 18 8 21 44 17 63 2 76 57 65 7 55 2 3 31 38 204 0 0 1 0 19 1 2 1 7 2 84 0 45 0 47 0 184 0 19 47 184 0 42 47 185 0 3 0 1 244 186 0 6 0 42 0 19 17 18 57 184 0 19 16 185 0 26 0 1 244 186 0 29 0 19 0 42 17 18 57 48 49 19 30 1 51 50 54 53 52 46 2 39 46 3 53 52 54 51 50 22 23 7 46 1 35 34 6 21 20 30 2 23 30 3 21 20 6 35 34 38 39 49 22 47 27 28 30 12 21 26 14 17 34 27 17 58 53 35 52 20 31 18 33 23 27 27 12 20 26 14 17 35 28 17 64 55 36 65 24 1 87 17 20 26 20 11 17 12 11 5 7 16 22 30 21 37 55 22 14 40 13 15 25 16 11 16 12 9 6 7 15 21 31 22 43 56 26 18 0 0 0 1 0 16 1 2 0 225 2 167 0 21 0 39 0 184 0 18 47 184 0 6 47 185 0 9 0 1 244 184 0 0 208 184 0 6 16 184 0 3 208 184 0 18 16 185 0 12 0 1 244 48 49 19 35 53 63 1 51 21 51 21 35 21 20 51 50 55 23 14 1 35 34 38 53 64 48 50 8 52 88 88 49 20 17 13 14 34 17 53 43 2 26 47 3 91 91 50 167 62 7 46 5 7 63 50 0 0 0 1 0 50 1 2 1 63 2 76 0 19 0 33 0 184 0 0 47 184 0 12 47 184 0 5 47 184 0 0 16 185 0 9 0 1 244 184 0 0 16 184 0 15 208 48 49 19 34 38 61 1 51 21 20 22 51 50 55 53 51 17 35 39 35 14 1 153 56 47 62 23 38 39 45 62 49 7 3 20 55 1 2 70 56 204 195 38 43 46 230 254 190 45 21 32 0 1 0 8 1 10 1 57 2 76 0 9 0 21 0 184 0 1 47 184 0 6 47 184 0 9 47 185 0 3 0 1 244 48 49 19 51 31 1 51 63 1 51 3 35 8 62 58 31 4 31 58 61 116 73 2 76 176 96 96 176 254 190 0 0 1 0 16 1 10 1 215 2 76 0 21 0 53 0 184 0 21 47 184 0 15 47 184 0 6 47 184 0 1 47 184 0 12 47 184 0 21 16 185 0 3 0 1 244 184 0 15 16 185 0 9 0 1 244 184 0 6 16 185 0 18 0 1 244 48 49 19 51 31 1 51 63 1 51 31 1 51 63 1 51 3 35 47 1 35 15 1 35 16 64 44 19 4 22 47 56 50 22 4 21 43 59 87 75 43 21 2 21 43 74 2 76 179 92 92 179 179 92 92 179 254 190 164 91 91 164 0 0 1 0 8 1 10 1 42 2 76 0 17 0 39 0 184 0 16 47 184 0 11 47 184 0 2 47 184 0 7 47 186 0 4 0 2 0 16 17 18 57 186 0 13 0 11 0 7 17 18 57 48 49 19 39 51 31 1 51 63 1 51 7 23 35 47 1 35 15 1 35 116 99 68 41 31 4 27 37 66 98 105 68 43 35 4 33 41 66 1 179 153 66 51 51 66 160 162 70 55 55 70 0 0 0 1 0 8 0 132 1 55 2 76 0 25 0 41 0 184 0 17 47 184 0 8 47 184 0 22 47 185 0 2 0 1 244 186 0 6 0 22 0 8 17 18 57 186 0 13 0 22 0 17 17 18 57 48 49 55 22 51 50 54 63 1 3 51 23 30 1 23 51 62 1 63 1 51 3 14 1 35 34 39 55 37 11 13 26 36 9 7 131 63 63 8 15 8 4 7 14 8 52 61 119 18 58 51 23 18 13 188 5 36 29 20 1 64 169 22 46 25 24 46 23 169 254 172 51 65 6 50 0 1 0 21 1 10 1 16 2 76 0 9 0 35 0 184 0 3 47 184 0 8 47 185 0 6 0 1 244 184 0 0 208 184 0 3 16 185 0 1 0 1 244 184 0 5 208 48 49 19 55 35 53 51 21 7 51 21 35 21 168 148 226 167 172 251 1 44 238 50 35 236 51 0 0 0 0 3 0 28 1 9 1 54 2 227 0 3 0 32 0 41 0 49 0 184 0 14 47 184 0 4 47 187 0 22 0 1 0 33 0 4 43 186 0 3 0 1 0 3 43 184 0 4 16 185 0 26 0 1 244 184 0 14 16 185 0 38 0 1 244 48 49 19 51 23 35 19 34 46 2 53 52 62 2 51 50 30 2 21 20 6 7 35 30 1 51 50 54 55 23 14 1 55 52 46 2 35 34 6 7 100 65 59 49 11 33 58 42 25 24 41 55 30 37 51 31 13 2 2 217 3 56 45 23 42 17 24 23 57 36 8 18 29 22 36 48 6 2 227 94 254 132 22 44 62 41 39 62 44 24 29 43 53 24 10 13 12 50 55 15 11 40 15 20 195 16 34 26 17 48 45 0 3 0 28 1 9 1 54 2 227 0 3 0 32 0 41 0 49 0 184 0 14 47 184 0 4 47 186 0 0 0 2 0 3 43 187 0 22 0 1 0 33 0 4 43 184 0 4 16 185 0 26 0 1 244 184 0 14 16 185 0 38 0 1 244 48 49 19 51 7 35 19 34 46 2 53 52 62 2 51 50 30 2 21 20 6 7 35 30 1 51 50 54 55 23 14 1 55 52 46 2 35 34 6 7 192 65 76 49 54 33 58 42 25 24 41 55 30 37 51 31 13 2 2 217 3 56 45 23 42 17 24 23 57 36 8 18 29 22 36 48 6 2 227 94 254 132 22 44 62 41 39 62 44 24 29 43 53 24 10 13 12 50 55 15 11 40 15 20 195 16 34 26 17 48 45 0 2 0 25 1 2 1 51 2 84 0 26 0 33 0 41 0 184 0 19 47 184 0 0 47 187 0 8 0 1 0 31 0 4 43 184 0 19 16 185 0 12 0 1 244 184 0 0 16 185 0 27 0 1 244 48 49 19 34 46 2 53 52 54 55 51 46 1 35 34 6 7 39 62 1 51 50 22 21 20 14 2 39 50 54 55 35 20 22 160 38 52 32 13 2 2 217 2 47 45 24 39 18 23 23 53 32 69 82 23 40 53 32 37 47 3 166 36 1 2 29 44 54 25 11 13 11 46 56 15 11 40 14 21 88 81 39 62 44 24 50 48 49 41 56 0 0 0 0 2 0 33 1 2 1 66 2 84 0 12 0 33 0 43 0 184 0 18 47 184 0 31 47 185 0 3 0 1 244 184 0 18 16 185 0 10 0 1 244 184 0 18 16 184 0 23 208 184 0 31 16 184 0 26 208 48 49 19 20 22 51 50 54 55 53 46 1 35 34 6 7 52 62 2 51 50 22 23 51 55 51 17 35 39 35 14 1 35 34 38 97 42 45 20 36 20 20 39 18 35 51 64 24 39 51 27 26 44 20 4 6 48 51 5 4 20 44 28 64 73 1 177 60 62 20 20 162 17 15 62 52 38 61 43 23 20 19 31 254 190 35 17 26 91 0 0 0 2 0 34 0 121 1 67 2 84 0 31 0 44 0 49 0 184 0 19 47 184 0 28 47 187 0 11 0 1 0 32 0 4 43 184 0 28 16 185 0 3 0 1 244 184 0 19 16 184 0 23 208 184 0 19 16 185 0 39 0 1 244 48 49 55 30 1 51 50 54 61 1 55 14 1 35 34 38 53 52 62 2 51 50 23 51 55 51 17 20 6 35 34 38 39 55 50 54 55 53 46 1 35 34 6 21 20 22 79 23 49 23 43 45 2 22 44 26 64 74 24 39 51 27 51 39 3 6 49 78 72 29 62 26 129 20 36 21 20 40 18 35 51 42 200 14 14 49 38 13 44 19 23 87 72 37 61 42 23 39 31 254 180 63 72 19 17 169 20 21 145 17 15 60 49 50 59 0 0 0 1 0 52 1 10 0 114 2 223 0 3 0 11 0 184 0 1 47 184 0 2 47 48 49 19 51 17 35 52 62 62 2 223 254 43 0 2 0 41 1 173 1 35 2 173 0 19 0 31 0 23 0 187 0 20 0 1 0 0 0 4 43 187 0 10 0 1 0 26 0 4 43 48 49 19 34 46 2 53 52 62 2 51 50 30 2 21 20 14 2 39 50 54 53 52 38 35 34 6 21 20 22 166 25 45 35 20 20 35 45 25 25 45 35 20 20 35 45 25 33 42 42 33 33 42 42 1 173 18 33 47 29 30 47 34 18 18 34 47 30 29 47 33 18 46 46 35 37 46 46 37 35 46 0 0 0 2 0 26 0 103 1 215 2 45 0 33 0 53 0 40 0 184 0 0 69 88 184 0 12 47 27 185 0 12 0 10 62 89 187 0 39 0 1 0 30 0 4 43 184 0 12 16 185 0 49 0 1 244 48 49 63 1 46 1 53 52 54 55 39 55 23 54 51 50 22 23 55 23 7 30 1 21 20 6 7 23 7 39 14 1 35 34 39 7 55 20 30 2 51 50 62 2 53 52 46 2 35 34 14 2 26 64 17 19 19 17 64 44 68 48 63 29 58 23 68 44 65 17 20 20 17 65 44 68 23 58 29 64 47 68 60 19 32 44 24 24 43 32 19 19 32 43 24 24 44 32 19 148 65 23 58 35 35 59 23 66 45 70 37 19 18 70 45 66 23 59 35 35 58 23 65 45 69 19 19 38 69 226 30 49 36 19 19 36 49 30 30 49 36 19 19 36 49 0 0 1 0 52 255 146 1 181 2 236 0 45 0 93 0 184 0 0 69 88 184 0 39 47 27 185 0 39 0 14 62 89 184 0 0 69 88 184 0 19 47 27 185 0 19 0 4 62 89 184 0 39 16 185 0 3 0 1 244 186 0 6 0 19 0 39 17 18 57 184 0 19 16 184 0 16 208 184 0 19 16 185 0 26 0 1 244 186 0 29 0 39 0 19 17 18 57 184 0 39 16 184 0 42 208 48 49 1 46 1 35 34 6 21 20 30 4 21 20 6 7 21 35 53 46 1 39 55 30 1 51 50 54 53 52 46 4 53 52 54 55 53 51 21 30 1 23 1 124 28 53 41 46 54 41 62 73 62 41 83 72 60 48 90 32 38 32 77 46 56 55 41 62 73 62 41 79 66 60 48 67 27 2 12 27 30 52 44 36 46 35 33 47 69 54 72 92 10 101 99 5 43 29 57 28 39 56 47 40 53 39 34 44 63 49 67 89 11 100 99 5 42 29 0 0 1 0 53 0 0 1 197 2 138 0 44 0 89 0 184 0 0 69 88 184 0 21 47 27 185 0 21 0 14 62 89 184 0 0 69 88 184 0 2 47 27 185 0 2 0 4 62 89 185 0 0 0 1 244 186 0 36 0 21 0 2 17 18 57 184 0 36 47 184 0 10 208 184 0 36 16 185 0 35 0 1 244 184 0 11 208 184 0 11 47 184 0 21 16 185 0 28 0 1 244 48 49 37 21 33 53 62 1 53 52 38 39 35 53 55 51 46 1 53 52 62 2 51 50 22 23 7 46 1 35 34 6 21 20 22 23 51 21 35 30 1 21 20 6 7 21 1 197 254 113 51 55 4 3 100 67 18 10 17 27 49 68 42 54 75 26 48 19 48 34 54 57 15 9 159 146 2 3 32 30 71 71 50 28 95 57 14 27 14 52 4 32 61 32 42 68 48 26 43 32 47 23 30 65 52 32 59 32 56 14 27 15 53 70 31 4 0 0 0 0 1 0 23 0 0 1 218 2 126 0 29 0 132 0 184 0 0 69 88 184 0 29 47 27 185 0 29 0 14 62 89 184 0 0 69 88 184 0 9 47 27 185 0 9 0 14 62 89 184 0 0 69 88 184 0 20 47 27 185 0 20 0 4 62 89 186 0 4 0 29 0 20 17 18 57 186 0 25 0 29 0 20 17 18 57 184 0 25 47 185 0 12 0 1 244 184 0 25 16 184 0 13 208 184 0 25 16 184 0 24 208 184 0 24 47 184 0 16 208 184 0 24 16 185 0 21 0 1 244 184 0 17 208 184 0 25 16 185 0 27 0 1 244 48 49 19 23 30 1 23 51 62 1 63 1 51 3 51 21 35 21 51 21 35 21 35 53 35 53 51 53 35 53 51 3 109 78 15 29 16 4 17 29 15 78 84 164 142 163 163 163 82 162 162 162 141 163 2 126 171 33 67 35 35 67 33 171 254 192 47 65 48 158 158 48 65 47 1 64 0 1 0 23 255 244 1 235 2 138 0 53 0 109 0 184 0 0 69 88 184 0 25 47 27 185 0 25 0 14 62 89 184 0 0 69 88 184 0 3 47 27 185 0 3 0 4 62 89 187 0 45 0 1 0 46 0 4 43 184 0 46 16 184 0 9 208 184 0 45 16 184 0 10 208 184 0 45 16 184 0 37 220 184 0 18 208 184 0 37 16 185 0 36 0 1 244 184 0 19 208 184 0 25 16 185 0 32 0 1 244 184 0 3 16 185 0 50 0 1 244 48 49 37 14 1 35 34 46 2 39 35 53 55 38 52 53 60 1 55 35 53 55 62 3 51 50 22 23 7 46 1 35 34 6 7 51 21 33 6 20 21 28 1 23 51 21 35 30 1 51 50 54 55 1 235 33 84 55 45 77 60 41 9 64 59 1 1 59 64 9 42 63 83 49 45 78 26 49 21 50 32 66 81 12 254 254 254 1 1 218 213 13 77 62 37 55 26 81 44 49 33 64 91 59 43 4 9 18 9 8 16 8 44 5 59 93 65 34 45 33 47 26 33 98 87 49 7 14 8 10 19 9 48 85 96 36 35 0 0 0 2 0 61 255 223 1 198 2 141 0 6 0 37 0 55 0 187 0 34 0 1 0 10 0 4 43 187 0 26 0 1 0 33 0 4 43 184 0 33 16 184 0 0 208 184 0 34 16 184 0 6 208 184 0 10 16 184 0 13 208 184 0 26 16 184 0 23 208 48 49 1 14 1 21 20 22 31 1 14 1 7 21 35 53 46 3 53 52 62 2 55 53 51 21 30 1 23 7 46 1 39 17 62 1 55 1 6 55 64 62 57 192 29 72 39 52 45 74 53 29 31 54 74 42 52 44 64 23 40 20 45 26 32 52 20 1 221 13 88 66 67 88 13 9 26 34 3 103 104 5 37 60 84 53 52 82 60 37 6 106 103 2 34 22 52 18 22 2 254 168 2 27 18 0 0 0 1 0 18 255 159 1 206 2 156 0 39 0 66 0 184 0 0 69 88 184 0 36 47 27 185 0 36 0 16 62 89 187 0 24 0 1 0 18 0 4 43 187 0 10 0 1 0 11 0 4 43 184 0 36 16 185 0 3 0 1 244 184 0 11 16 184 0 28 208 184 0 10 16 184 0 30 208 48 49 1 46 1 35 34 14 2 15 1 51 21 35 7 14 3 35 34 38 39 55 22 51 50 54 63 1 35 53 55 51 55 62 1 51 50 22 23 1 188 11 26 19 23 32 21 13 3 7 126 133 26 5 22 38 58 42 23 38 12 15 23 27 47 41 8 24 87 69 25 6 11 77 80 22 42 14 2 75 5 9 22 36 47 25 63 63 237 46 75 54 30 8 7 62 10 79 77 219 59 4 56 100 104 11 7 0 0 0 0 3 0 61 255 146 1 222 2 236 0 9 0 16 0 55 0 159 0 184 0 0 69 88 184 0 34 47 27 185 0 34 0 14 62 89 184 0 0 69 88 184 0 37 47 27 185 0 37 0 14 62 89 184 0 0 69 88 184 0 40 47 27 185 0 40 0 14 62 89 184 0 0 69 88 184 0 42 47 27 185 0 42 0 14 62 89 184 0 0 69 88 184 0 20 47 27 185 0 20 0 4 62 89 184 0 0 69 88 184 0 23 47 27 185 0 23 0 4 62 89 185 0 2 0 1 244 184 0 40 16 185 0 6 0 1 244 186 0 10 0 20 0 40 17 18 57 186 0 16 0 20 0 40 17 18 57 186 0 51 0 20 0 40 17 18 57 184 0 2 16 184 0 52 208 48 49 55 22 23 19 46 1 35 34 6 15 1 14 1 21 20 22 23 5 14 1 15 1 35 55 38 39 7 35 55 46 1 53 52 54 63 1 51 7 54 50 51 50 23 55 51 7 30 1 23 7 38 39 3 62 1 55 230 25 31 62 8 14 8 8 13 7 39 51 54 26 25 1 25 32 79 51 12 38 12 28 29 13 38 16 58 67 107 92 12 38 12 5 12 5 20 16 12 38 14 24 41 16 49 19 21 60 32 51 23 78 18 4 2 12 2 2 1 1 13 26 128 94 68 105 35 32 41 49 3 98 99 3 11 113 131 38 151 108 134 169 22 105 99 1 4 102 114 11 35 20 46 24 15 254 6 4 35 31 0 0 1 0 53 0 0 1 197 2 138 0 52 0 113 0 184 0 0 69 88 184 0 26 47 27 185 0 26 0 14 62 89 184 0 0 69 88 184 0 2 47 27 185 0 2 0 4 62 89 185 0 0 0 1 244 186 0 41 0 26 0 2 17 18 57 184 0 41 47 185 0 45 0 1 244 185 0 46 0 1 244 184 0 8 208 184 0 45 16 184 0 9 208 184 0 41 16 184 0 15 208 184 0 41 16 185 0 40 0 1 244 184 0 16 208 184 0 26 16 185 0 33 0 1 244 48 49 37 21 33 53 62 1 61 1 35 53 55 51 46 1 39 35 53 55 51 46 1 53 52 62 2 51 50 22 23 7 46 1 35 34 6 21 20 22 23 51 21 35 22 23 51 21 35 21 20 6 7 21 1 197 254 113 51 55 107 69 32 4 8 5 84 61 9 5 7 27 49 68 42 54 75 26 48 19 48 34 54 57 5 5 173 160 10 4 146 141 32 30 71 71 50 28 95 57 5 44 5 15 29 15 44 5 19 36 19 42 68 48 26 43 32 47 23 30 65 52 19 35 18 49 31 28 49 6 53 70 31 4 0 0 5 0 11 0 0 1 227 2 126 0 5 0 9 0 15 0 19 0 47 0 215 0 184 0 0 69 88 184 0 39 47 27 185 0 39 0 14 62 89 184 0 0 69 88 184 0 43 47 27 185 0 43 0 14 62 89 184 0 0 69 88 184 0 25 47 27 185 0 25 0 4 62 89 184 0 0 69 88 184 0 29 47 27 185 0 29 0 4 62 89 187 0 5 0 1 0 6 0 4 43 187 0 42 0 1 0 1 0 4 43 184 0 25 16 185 0 8 0 1 244 184 0 5 16 184 0 10 208 184 0 1 16 184 0 12 208 184 0 42 16 184 0 16 208 184 0 39 16 185 0 18 0 1 244 184 0 1 16 184 0 20 208 184 0 5 16 184 0 21 208 184 0 6 16 184 0 23 208 184 0 6 16 184 0 27 208 184 0 6 16 184 0 31 208 184 0 5 16 184 0 33 208 184 0 33 47 184 0 1 16 184 0 35 208 184 0 42 16 184 0 37 208 184 0 37 47 184 0 42 16 184 0 45 208 48 49 1 53 35 31 1 51 23 35 23 51 47 1 53 35 23 21 39 51 39 35 5 21 51 21 35 21 35 39 35 21 35 53 35 53 55 53 35 53 55 53 51 23 51 53 51 21 51 21 1 90 72 16 4 54 3 44 51 4 134 21 57 1 4 47 55 4 1 20 72 72 84 84 92 65 75 75 75 75 84 89 87 65 72 1 61 26 46 14 43 166 209 59 1 22 38 102 178 220 60 43 240 240 240 240 38 5 60 37 5 253 253 253 253 42 0 0 3 0 10 0 0 1 228 2 126 0 5 0 11 0 33 0 109 0 184 0 0 69 88 184 0 26 47 27 185 0 26 0 14 62 89 184 0 0 69 88 184 0 21 47 27 185 0 21 0 4 62 89 187 0 19 0 1 0 5 0 4 43 184 0 26 16 185 0 6 0 1 244 186 0 4 0 5 0 6 17 18 57 184 0 4 47 185 0 7 0 1 244 184 0 4 16 184 0 13 208 184 0 4 16 184 0 22 208 184 0 7 16 184 0 25 208 184 0 7 16 184 0 32 208 48 49 19 50 54 55 35 21 17 21 51 46 1 35 5 35 14 3 43 1 21 35 17 35 53 55 53 51 50 30 2 23 51 194 66 76 7 181 181 8 75 66 1 34 62 5 36 58 76 43 42 79 73 73 121 44 76 57 36 5 62 1 45 59 57 116 1 24 108 59 49 164 44 65 43 21 244 1 161 51 5 165 18 39 63 45 0 0 3 0 68 0 0 1 228 2 153 0 3 0 18 0 47 0 153 0 184 0 0 69 88 184 0 45 47 27 185 0 45 0 16 62 89 184 0 0 69 88 184 0 3 47 27 185 0 3 0 4 62 89 185 0 0 0 1 244 184 0 45 16 184 0 44 220 185 0 41 0 1 244 184 0 36 220 184 0 0 16 184 0 28 220 186 0 39 0 36 0 28 17 18 57 184 0 39 16 185 0 4 0 1 244 184 0 36 16 185 0 7 0 1 244 184 0 28 16 185 0 15 0 1 244 186 0 24 0 28 0 36 17 18 57 184 0 24 16 185 0 18 0 1 244 184 0 41 16 184 0 21 208 184 0 28 16 184 0 23 208 184 0 44 16 184 0 47 208 48 49 55 33 21 33 1 46 1 35 34 14 2 21 20 22 51 50 54 55 19 21 7 17 35 39 35 14 1 35 34 38 53 52 62 2 51 50 22 23 39 53 35 53 51 53 51 21 79 1 103 254 153 1 1 25 40 28 21 37 28 16 51 47 26 47 24 148 78 58 6 3 22 57 35 72 85 27 46 58 32 37 47 25 4 146 146 70 49 49 1 121 22 19 18 32 43 25 62 69 25 28 1 120 44 5 254 83 43 23 30 97 92 41 66 47 25 24 22 83 34 49 67 67 0 0 0 0 4 0 10 0 0 1 228 2 126 0 8 0 13 0 19 0 50 0 155 0 184 0 0 69 88 184 0 45 47 27 185 0 45 0 14 62 89 184 0 0 69 88 184 0 36 47 27 185 0 36 0 4 62 89 187 0 34 0 1 0 13 0 4 43 184 0 45 16 185 0 14 0 1 244 186 0 8 0 13 0 14 17 18 57 184 0 8 47 184 0 7 220 184 0 8 16 184 0 12 220 184 0 7 16 184 0 15 220 184 0 7 16 184 0 21 208 184 0 8 16 184 0 27 208 184 0 12 16 184 0 30 208 184 0 12 16 184 0 37 208 184 0 8 16 184 0 40 208 184 0 7 16 184 0 41 208 184 0 15 16 184 0 44 208 184 0 15 16 184 0 49 208 48 49 1 62 1 53 52 38 39 35 21 23 50 55 35 21 17 21 51 46 1 35 5 35 30 1 21 28 1 7 51 21 35 14 1 43 1 21 35 17 35 53 55 53 35 53 55 53 51 50 22 23 51 1 87 1 1 1 1 181 32 107 32 171 169 17 69 51 1 34 63 1 1 1 62 70 20 113 77 42 79 73 73 73 73 121 76 112 21 71 1 162 6 13 7 9 16 8 59 117 76 76 1 24 63 34 29 104 8 16 9 7 13 6 41 68 65 244 1 121 36 5 59 37 4 120 55 65 0 0 0 0 1 0 47 255 146 1 204 2 236 0 41 0 97 0 184 0 0 69 88 184 0 17 47 27 185 0 17 0 14 62 89 184 0 0 69 88 184 0 7 47 27 185 0 7 0 4 62 89 186 0 0 0 17 0 7 17 18 57 184 0 0 47 184 0 7 16 184 0 4 208 184 0 17 16 184 0 20 208 184 0 17 16 185 0 27 0 1 244 184 0 7 16 185 0 35 0 1 244 184 0 0 16 185 0 40 0 1 244 48 49 1 17 14 1 7 21 35 53 46 3 53 52 62 2 55 53 51 21 30 1 23 7 46 1 35 34 14 2 21 20 22 51 50 54 55 53 35 53 1 204 29 71 41 60 47 78 56 31 30 55 78 49 60 42 70 26 49 23 51 34 41 63 43 22 85 77 29 49 14 101 1 75 254 242 30 36 5 100 100 6 50 84 116 72 70 114 84 53 8 101 99 4 44 31 46 27 33 37 68 98 60 123 142 22 15 169 69 0 0 0 2 0 61 255 146 1 222 2 233 0 6 0 37 0 89 0 184 0 0 69 88 184 0 23 47 27 185 0 23 0 14 62 89 184 0 0 69 88 184 0 13 47 27 185 0 13 0 4 62 89 184 0 23 16 185 0 0 0 1 244 184 0 13 16 185 0 6 0 1 244 184 0 13 16 184 0 10 208 184 0 23 16 184 0 26 208 184 0 0 16 184 0 33 208 184 0 6 16 184 0 34 208 48 49 1 14 1 21 20 22 23 55 14 1 7 21 35 53 46 3 53 52 62 2 55 53 51 21 30 1 23 7 46 1 39 17 62 1 55 1 23 65 68 69 64 199 29 72 46 52 49 80 57 32 31 57 80 50 52 42 71 25 49 18 43 28 29 48 22 2 67 16 136 106 112 139 13 24 38 47 6 100 99 5 49 84 118 73 70 115 84 52 8 98 95 3 44 31 47 24 31 3 253 241 5 35 29 0 1 0 72 0 0 1 195 2 126 0 29 0 95 0 184 0 0 69 88 184 0 28 47 27 185 0 28 0 14 62 89 184 0 0 69 88 184 0 12 47 27 185 0 12 0 4 62 89 187 0 16 0 1 0 13 0 4 43 186 0 19 0 23 0 3 43 184 0 28 16 185 0 26 0 1 244 184 0 1 208 184 0 23 16 184 0 4 208 184 0 19 16 184 0 7 208 186 0 10 0 16 0 13 17 18 57 48 49 1 35 30 1 23 51 21 35 14 1 7 19 35 39 35 53 51 50 54 55 35 53 55 51 46 1 43 1 53 33 1 195 142 29 38 7 68 66 5 82 65 188 94 178 77 71 72 83 5 231 69 160 11 81 66 71 1 123 2 77 15 53 35 49 75 87 15 254 252 252 67 58 60 44 5 46 38 68 0 0 1 0 23 255 242 1 209 2 126 0 35 0 97 0 184 0 0 69 88 184 0 25 47 27 185 0 25 0 14 62 89 184 0 0 69 88 184 0 16 47 27 185 0 16 0 4 62 89 185 0 0 0 1 244 186 0 17 0 16 0 25 17 18 57 184 0 17 47 184 0 20 220 184 0 21 220 184 0 24 220 184 0 27 208 184 0 21 16 184 0 30 208 184 0 20 16 184 0 31 208 184 0 17 16 184 0 34 208 48 49 55 62 3 53 52 38 39 55 22 21 20 14 2 39 17 7 53 55 53 7 53 55 53 51 21 55 21 7 21 55 21 7 21 199 33 69 56 36 1 4 70 7 53 94 128 75 92 92 92 92 84 164 164 164 164 66 1 22 41 61 39 8 21 14 18 32 25 63 94 62 29 2 1 17 48 53 48 72 48 52 49 199 158 86 53 86 72 86 52 87 236 0 0 0 1 255 89 255 244 0 251 2 156 0 3 0 24 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 4 62 89 184 0 1 220 48 49 7 1 51 1 167 1 106 56 254 150 12 2 168 253 88 0 0 0 255 255 255 89 255 244 0 251 2 156 2 6 2 159 0 0 255 255 255 89 255 244 0 251 2 156 2 6 2 159 0 0 255 255 0 35 255 244 3 22 2 156 0 39 2 78 0 0 1 10 0 39 2 159 1 113 0 0 0 7 2 78 1 201 0 0 0 0 0 7 0 35 255 244 4 136 2 156 0 3 0 15 0 27 0 39 0 51 0 63 0 75 0 152 0 184 0 0 69 88 184 0 1 47 27 185 0 1 0 16 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 16 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 4 62 89 184 0 0 69 88 184 0 28 47 27 185 0 28 0 4 62 89 184 0 0 69 88 184 0 52 47 27 185 0 52 0 4 62 89 187 0 16 0 1 0 4 0 4 43 187 0 34 0 1 0 46 0 4 43 184 0 10 16 185 0 22 0 1 244 184 0 28 16 185 0 40 0 1 244 184 0 34 16 184 0 58 208 184 0 40 16 184 0 64 208 184 0 46 16 184 0 70 208 48 49 23 1 51 1 3 34 38 53 52 54 51 50 22 21 20 6 39 50 54 53 52 38 35 34 6 21 20 22 1 34 38 53 52 54 51 50 22 21 20 6 39 50 54 53 52 38 35 34 6 21 20 22 5 34 38 53 52 54 51 50 22 21 20 6 39 50 54 53 52 38 35 34 6 21 20 22 200 1 106 56 254 150 72 68 81 81 68 67 82 82 67 38 48 48 38 39 48 48 1 237 67 82 82 67 68 81 81 68 39 48 48 39 38 48 48 1 154 67 82 82 67 68 82 82 68 39 48 48 39 38 48 48 12 2 168 253 88 1 10 108 100 100 106 106 100 100 108 51 79 78 79 76 76 79 78 79 254 195 108 100 99 107 107 99 100 108 51 79 78 78 77 77 78 78 79 51 108 100 99 107 107 99 100 108 51 79 78 78 77 77 78 78 79 0 255 255 0 64 255 244 2 237 2 156 0 39 2 79 255 233 1 10 0 39 2 159 1 91 0 0 0 7 2 82 1 157 0 0 0 0 255 255 0 64 255 244 2 249 2 156 0 39 2 79 255 233 1 10 0 39 2 159 1 70 0 0 0 7 2 80 1 185 0 0 0 0 255 255 0 35 255 244 2 252 2 156 0 39 2 81 0 0 1 10 0 39 2 159 1 128 0 0 0 7 2 82 1 172 0 0 0 0 255 255 0 64 255 244 2 244 2 156 0 39 2 79 255 233 1 10 0 39 2 159 1 64 0 0 0 7 2 81 1 181 0 0 0 0 255 255 0 41 255 244 3 4 2 156 0 39 2 80 0 1 1 10 0 39 2 159 1 114 0 0 0 7 2 81 1 197 0 0 0 0 255 255 0 64 255 244 2 245 2 156 0 39 2 79 255 233 1 10 0 39 2 159 1 74 0 0 0 7 2 86 1 181 0 0 0 0 255 255 0 35 255 244 3 5 2 156 0 39 2 81 0 0 1 10 0 39 2 159 1 111 0 0 0 7 2 86 1 197 0 0 0 0 255 255 0 35 255 244 3 5 2 156 0 39 2 83 0 0 1 10 0 39 2 159 1 111 0 0 0 7 2 86 1 197 0 0 0 0 255 255 0 31 255 244 2 241 2 156 0 39 2 85 255 237 1 10 0 39 2 159 1 61 0 0 0 7 2 86 1 177 0 0 0 0 0 1 0 34 0 104 1 207 2 44 0 11 0 29 0 187 0 3 0 1 0 0 0 4 43 184 0 3 16 184 0 6 208 184 0 0 16 184 0 8 208 48 49 19 35 53 51 53 51 21 51 21 35 21 35 216 182 182 65 182 182 65 1 43 62 195 195 62 195 0 0 0 0 1 0 34 1 43 1 207 1 105 0 3 0 13 0 187 0 1 0 1 0 2 0 4 43 48 49 19 33 21 33 34 1 173 254 83 1 105 62 0 0 1 0 50 0 126 1 191 2 21 0 11 0 11 0 186 0 5 0 9 0 3 43 48 49 63 1 39 55 23 55 23 7 23 7 39 7 50 155 155 44 155 154 44 155 155 44 154 155 171 159 158 45 159 159 45 158 159 45 160 160 0 0 0 0 3 0 34 0 96 1 207 2 51 0 11 0 23 0 27 0 33 0 187 0 15 0 1 0 21 0 4 43 187 0 6 0 1 0 0 0 4 43 187 0 25 0 1 0 26 0 4 43 48 49 19 34 38 53 52 54 51 50 22 21 20 6 3 52 54 51 50 22 21 20 6 35 34 38 39 33 21 33 249 23 32 32 23 23 31 31 78 32 23 23 31 31 23 23 32 160 1 173 254 83 1 200 30 24 23 30 30 23 24 30 254 206 23 30 30 23 24 30 30 235 62 0 0 255 255 0 188 1 7 1 51 1 133 0 7 1 253 0 123 1 19 0 0 255 255 0 34 0 193 1 207 1 212 2 38 2 174 0 107 0 6 2 174 0 150 0 0 0 1 0 34 0 131 1 207 2 21 0 9 0 21 0 186 0 1 0 8 0 3 43 186 0 5 0 8 0 1 17 18 57 48 49 19 37 21 15 1 21 31 1 21 37 34 1 173 211 134 134 211 254 83 1 109 168 71 78 50 4 50 78 71 168 0 0 0 0 1 0 34 0 131 1 207 2 21 0 9 0 21 0 186 0 8 0 1 0 3 43 186 0 5 0 1 0 8 17 18 57 48 49 1 5 53 63 1 53 47 1 53 5 1 207 254 83 211 134 134 211 1 173 1 43 168 71 78 50 4 50 78 71 168 0 0 0 2 0 34 0 0 1 207 2 21 0 3 0 13 0 26 0 184 0 0 69 88 184 0 2 47 27 185 0 2 0 4 62 89 185 0 0 0 1 244 48 49 55 33 21 33 17 37 21 15 1 21 31 1 21 37 34 1 173 254 83 1 173 210 135 135 210 254 83 62 62 1 124 153 71 73 44 4 44 73 71 153 0 0 0 2 0 34 0 0 1 207 2 21 0 3 0 13 0 26 0 184 0 0 69 88 184 0 2 47 27 185 0 2 0 4 62 89 185 0 0 0 1 244 48 49 55 33 21 33 1 5 53 63 1 53 47 1 53 5 34 1 173 254 83 1 173 254 83 210 135 135 210 1 173 62 62 1 50 153 71 73 44 4 44 73 71 153 0 2 0 34 0 0 1 207 2 44 0 11 0 15 0 56 0 184 0 0 69 88 184 0 14 47 27 185 0 14 0 4 62 89 187 0 3 0 1 0 0 0 4 43 184 0 3 16 184 0 6 208 184 0 0 16 184 0 8 208 184 0 14 16 185 0 12 0 1 244 48 49 19 35 53 51 53 51 21 51 21 35 21 35 7 33 21 33 216 182 182 65 182 182 65 182 1 173 254 83 1 48 62 190 190 62 177 65 62 0 0 0 0 1 0 60 1 28 1 181 2 158 0 9 0 26 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 16 62 89 185 0 5 0 1 244 48 49 19 51 19 35 47 1 35 15 1 35 212 73 152 72 65 49 4 50 65 72 2 158 254 126 176 133 133 176 0 1 0 34 0 65 1 207 2 83 0 19 0 55 0 187 0 3 0 1 0 17 0 4 43 187 0 7 0 1 0 13 0 4 43 184 0 17 16 184 0 0 208 184 0 13 16 184 0 4 208 184 0 7 16 184 0 10 208 184 0 3 16 184 0 14 208 48 49 55 35 53 51 55 35 53 33 55 51 7 51 21 35 7 51 21 33 7 35 137 103 139 91 230 1 10 76 60 76 103 139 91 230 254 246 76 60 192 62 152 62 127 127 62 152 62 127 0 0 0 0 1 0 36 1 1 1 205 1 147 0 23 0 39 0 187 0 8 0 1 0 15 0 4 43 184 0 15 16 184 0 20 220 185 0 3 0 1 244 184 0 11 208 184 0 15 16 184 0 23 208 48 49 19 62 1 51 50 30 2 51 50 54 55 23 14 1 35 34 46 2 35 34 6 7 36 27 66 32 30 47 41 38 21 22 38 17 46 27 66 32 30 47 41 38 21 22 38 17 1 57 48 42 26 32 26 29 32 34 48 41 26 32 26 29 32 255 255 0 36 0 151 1 205 1 254 2 38 2 186 0 107 0 6 2 186 0 150 0 0 0 1 0 34 0 104 1 207 1 105 0 5 0 13 0 187 0 1 0 1 0 4 0 4 43 48 49 19 33 17 35 53 33 34 1 173 66 254 149 1 105 254 255 195 0 1 0 24 255 244 2 18 1 230 0 23 0 86 0 184 0 0 69 88 184 0 4 47 27 185 0 4 0 8 62 89 184 0 0 69 88 184 0 16 47 27 185 0 16 0 4 62 89 184 0 0 69 88 184 0 22 47 27 185 0 22 0 4 62 89 184 0 4 16 185 0 20 0 1 244 184 0 0 208 184 0 20 16 184 0 6 208 184 0 16 16 185 0 10 0 1 244 48 49 19 35 53 55 33 21 35 17 20 22 51 50 54 55 23 6 35 34 38 53 17 35 17 35 110 86 69 1 181 74 17 17 5 11 8 11 23 32 54 43 182 81 1 162 63 5 68 254 201 24 27 3 2 63 10 67 58 1 49 254 94 0 0 0 0 3 0 40 0 147 2 230 1 255 0 39 0 53 0 65 0 68 0 184 0 0 69 88 184 0 10 47 27 185 0 10 0 8 62 89 187 0 43 0 1 0 31 0 4 43 187 0 21 0 1 0 51 0 4 43 184 0 43 16 184 0 54 208 184 0 54 47 185 0 0 0 1 244 184 0 10 16 185 0 60 0 1 244 48 49 55 34 46 2 53 52 62 2 51 50 30 2 23 51 62 3 51 50 30 2 21 20 14 2 35 34 38 39 35 14 3 55 30 1 51 50 62 2 53 52 38 35 34 6 7 50 54 55 46 1 35 34 6 21 20 22 191 31 55 41 24 25 43 60 35 30 51 42 33 14 4 18 41 48 55 32 37 63 45 26 26 46 63 37 64 93 45 4 13 34 43 52 185 42 75 47 25 40 27 14 60 54 43 76 245 42 66 26 32 66 38 41 52 55 166 25 43 57 33 40 63 44 24 19 31 37 18 24 43 34 20 26 47 64 38 43 70 49 27 65 57 15 36 31 21 174 56 59 17 30 39 22 51 63 55 163 54 38 43 52 47 42 42 56 0 0 0 1 0 82 255 56 1 212 1 230 0 23 0 36 0 184 0 0 69 88 184 0 17 47 27 185 0 17 0 4 62 89 185 0 5 0 1 244 186 0 20 0 17 0 5 17 18 57 48 49 19 51 17 20 22 51 50 54 55 17 51 17 35 39 35 14 1 35 34 38 39 23 21 35 82 82 44 48 38 57 35 82 68 7 2 29 69 42 29 46 17 5 82 1 230 254 215 69 61 39 43 1 89 254 26 76 39 45 17 26 90 145 0 2 0 40 255 244 1 231 2 160 0 15 0 49 0 50 0 184 0 0 69 88 184 0 27 47 27 185 0 27 0 4 62 89 187 0 19 0 1 0 46 0 4 43 187 0 37 0 1 0 6 0 4 43 184 0 27 16 185 0 0 0 1 244 48 49 55 50 54 55 46 1 35 34 14 2 21 20 30 2 3 62 1 51 50 22 21 20 14 2 35 34 46 2 53 52 62 2 51 50 22 23 54 52 53 52 38 35 34 6 7 230 65 89 16 34 69 33 37 55 36 18 18 31 40 90 32 79 47 97 115 38 70 98 59 36 66 50 30 30 56 80 51 41 79 29 1 76 64 32 57 23 56 108 100 42 34 24 41 57 33 30 47 34 18 2 37 32 35 152 155 84 139 99 55 27 49 71 45 49 83 60 34 38 34 8 17 8 125 112 27 24 0 1 0 52 255 98 1 51 3 21 0 38 0 23 0 187 0 2 0 1 0 35 0 4 43 187 0 15 0 1 0 22 0 4 43 48 49 23 22 51 50 54 53 52 46 2 53 52 62 2 51 50 22 23 7 46 1 35 34 6 21 20 30 2 21 20 14 2 35 34 39 55 62 11 23 43 24 13 16 13 11 31 54 43 15 26 6 10 7 17 11 41 24 13 15 13 11 30 54 43 32 16 10 89 4 82 78 55 126 130 127 56 48 84 61 35 4 2 62 2 2 85 77 54 126 130 127 55 49 84 61 35 7 62 0 0 0 1 0 41 255 161 2 49 3 52 0 15 0 13 0 187 0 4 0 1 0 11 0 4 43 48 49 37 30 1 23 51 62 1 55 19 51 3 35 3 7 39 55 1 34 5 8 4 4 3 6 3 178 60 217 63 150 71 19 133 59 16 32 16 16 32 16 2 249 252 109 1 172 32 45 59 0 2 0 30 0 0 2 51 2 148 0 5 0 11 0 53 0 184 0 0 69 88 184 0 1 47 27 185 0 1 0 16 62 89 184 0 0 69 88 184 0 4 47 27 185 0 4 0 4 62 89 185 0 6 0 1 244 184 0 1 16 185 0 8 0 1 244 48 49 55 19 51 19 21 33 37 3 39 35 7 3 30 218 96 219 253 235 1 183 106 64 4 65 106 50 2 98 253 158 50 71 1 47 200 200 254 209 0 0 1 0 43 0 0 2 131 2 160 0 49 0 65 0 184 0 0 69 88 184 0 25 47 27 185 0 25 0 4 62 89 184 0 0 69 88 184 0 48 47 27 185 0 48 0 4 62 89 187 0 12 0 1 0 37 0 4 43 184 0 48 16 185 0 0 0 1 244 184 0 23 208 184 0 24 208 48 49 55 51 53 46 3 53 52 62 2 51 50 30 2 21 20 14 2 7 21 51 21 35 53 62 3 53 52 46 2 35 34 14 2 21 20 30 2 23 21 35 43 133 21 43 34 21 41 75 105 65 64 106 75 41 21 34 43 21 133 238 29 51 37 21 28 51 75 46 47 74 52 27 21 37 51 29 238 68 4 21 56 69 84 50 73 119 83 45 45 83 119 73 50 84 69 56 21 4 68 56 22 58 72 88 53 56 92 66 36 36 66 92 56 53 88 72 58 22 56 0 0 0 1 0 22 255 136 1 245 2 126 0 13 0 40 0 184 0 0 69 88 184 0 2 47 27 185 0 2 0 14 62 89 187 0 10 0 1 0 11 0 4 43 184 0 2 16 185 0 4 0 1 244 48 49 1 3 53 33 21 33 21 19 3 21 33 21 33 53 1 4 227 1 184 254 175 212 222 1 119 254 33 1 3 1 70 53 71 4 254 209 254 207 4 71 53 0 0 1 0 89 255 136 2 73 2 126 0 7 0 26 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 14 62 89 185 0 4 0 1 244 48 49 19 33 17 35 17 33 17 35 89 1 240 85 254 184 83 2 126 253 10 2 173 253 83 0 0 2 0 21 255 244 1 146 2 208 0 9 0 42 0 77 0 184 0 0 69 88 184 0 29 47 27 185 0 29 0 18 62 89 184 0 0 69 88 184 0 13 47 27 185 0 13 0 4 62 89 186 0 0 0 13 0 29 17 18 57 184 0 29 16 185 0 6 0 1 244 186 0 16 0 13 0 29 17 18 57 184 0 13 16 185 0 39 0 1 244 48 49 19 62 1 53 52 38 35 34 6 21 19 14 1 35 34 38 39 14 1 7 39 62 1 55 17 52 62 2 51 50 22 21 20 6 7 21 20 22 51 50 54 55 188 59 66 33 25 27 40 214 26 66 44 63 91 5 13 26 14 33 23 43 20 22 39 54 31 57 73 103 92 52 37 31 43 18 1 51 60 128 70 50 42 67 73 254 46 23 40 86 85 9 18 9 52 15 30 16 1 11 58 82 53 24 80 75 94 172 78 35 70 58 27 17 0 0 2 0 46 255 244 2 242 2 148 0 32 0 50 0 71 0 184 0 0 69 88 184 0 20 47 27 185 0 20 0 16 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 4 62 89 186 0 33 0 26 0 3 43 184 0 10 16 184 0 3 220 186 0 7 0 10 0 20 17 18 57 184 0 20 16 184 0 41 220 48 49 55 30 1 51 50 54 55 51 14 1 35 34 46 2 53 52 62 2 51 50 30 2 29 1 33 34 29 1 20 22 37 50 61 1 52 39 46 1 35 34 6 7 14 1 29 1 20 51 184 41 112 65 68 118 42 52 50 146 86 74 129 96 55 55 96 129 74 73 129 96 56 253 194 4 5 1 183 6 10 42 110 62 65 111 42 3 5 4 108 47 53 61 51 60 72 53 91 122 70 70 122 91 53 53 91 122 70 8 4 184 6 9 221 6 184 12 10 44 50 53 45 5 11 6 180 6 0 0 0 0 1 0 26 255 241 2 67 2 7 0 9 0 13 0 187 0 4 0 1 0 5 0 4 43 48 49 55 1 23 7 33 21 33 23 7 1 26 1 17 42 201 1 183 254 73 201 42 254 239 254 1 9 46 187 68 187 46 1 9 0 1 0 42 255 231 2 65 2 15 0 9 0 34 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 10 62 89 184 0 4 220 186 0 6 0 0 0 4 17 18 57 48 49 9 1 7 39 17 35 17 7 39 1 1 55 1 10 47 187 68 187 46 1 9 2 15 254 240 42 201 254 73 1 183 201 42 1 16 0 0 1 0 39 255 241 2 79 2 7 0 9 0 13 0 187 0 6 0 1 0 3 0 4 43 48 49 37 1 39 55 33 53 33 39 55 1 2 79 254 240 43 201 254 74 1 182 201 43 1 16 250 254 247 46 187 68 187 46 254 247 0 0 0 0 1 0 42 255 231 2 65 2 15 0 9 0 34 0 184 0 0 69 88 184 0 4 47 27 185 0 4 0 10 62 89 184 0 0 220 186 0 6 0 4 0 0 17 18 57 48 49 5 1 55 23 17 51 17 55 23 1 1 51 254 247 46 187 68 187 47 254 246 25 1 17 42 201 1 182 254 74 201 42 254 239 0 0 0 1 0 54 0 162 0 252 1 109 0 3 0 11 0 186 0 1 0 2 0 3 43 48 49 19 51 21 35 54 198 198 1 109 203 0 0 1 0 12 0 123 1 37 1 147 0 3 0 11 0 186 0 1 0 3 0 3 43 48 49 19 55 23 7 12 141 140 140 1 7 140 140 140 0 0 0 3 0 41 0 79 1 147 1 191 0 11 0 31 0 51 0 33 0 187 0 32 0 1 0 12 0 4 43 187 0 22 0 1 0 42 0 4 43 187 0 6 0 1 0 0 0 4 43 48 49 55 34 38 53 52 54 51 50 22 21 20 6 7 34 46 2 53 52 62 2 51 50 30 2 21 20 14 2 39 50 62 2 53 52 46 2 35 34 14 2 21 20 30 2 222 23 34 34 23 23 35 35 23 37 66 49 29 29 49 66 37 37 66 49 29 29 49 66 37 25 47 36 21 21 36 47 25 25 46 36 21 21 36 46 202 34 27 27 33 33 27 27 34 123 26 48 68 42 42 68 48 26 26 48 68 42 42 68 48 26 49 18 35 50 32 32 51 35 18 18 35 51 32 32 50 35 18 0 0 0 2 0 54 0 122 1 66 1 139 0 3 0 9 0 23 0 187 0 0 0 1 0 8 0 4 43 187 0 6 0 1 0 1 0 4 43 48 49 55 53 35 21 39 55 51 21 7 35 250 158 38 59 209 49 219 158 165 165 188 49 215 58 0 0 1 0 23 0 38 2 36 2 22 0 5 0 11 0 186 0 2 0 4 0 3 43 48 49 55 1 51 1 21 33 23 1 5 4 1 4 253 243 40 1 238 254 18 2 0 0 0 0 2 0 23 0 38 2 36 2 22 0 2 0 8 0 13 0 187 0 0 0 1 0 7 0 4 43 48 49 37 11 1 7 1 51 1 21 33 1 190 160 159 104 1 5 4 1 4 253 243 96 1 57 254 199 56 1 238 254 18 2 0 0 0 0 1 0 57 0 19 2 41 2 32 0 5 0 11 0 186 0 1 0 4 0 3 43 48 49 19 51 1 21 1 35 57 2 1 238 254 18 2 2 32 254 252 4 254 251 0 0 0 0 2 0 57 0 19 2 41 2 32 0 2 0 8 0 41 0 186 0 4 0 7 0 3 43 186 0 0 0 7 0 4 17 18 57 186 0 1 0 7 0 4 17 18 57 186 0 2 0 7 0 4 17 18 57 48 49 1 37 17 3 51 1 21 1 35 1 170 254 202 59 2 1 238 254 18 2 1 26 159 254 193 1 166 254 252 4 254 251 0 0 0 0 1 0 23 0 30 2 36 2 13 0 5 0 45 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 10 62 89 184 0 0 69 88 184 0 2 47 27 185 0 2 0 10 62 89 184 0 4 220 184 0 5 208 48 49 19 53 33 21 1 35 23 2 13 254 252 4 2 11 2 2 254 19 0 0 0 0 2 0 23 0 29 2 36 2 13 0 2 0 8 0 51 0 184 0 0 69 88 184 0 3 47 27 185 0 3 0 10 62 89 184 0 0 69 88 184 0 5 47 27 185 0 5 0 10 62 89 184 0 3 16 185 0 0 0 1 244 184 0 2 208 48 49 27 2 37 33 21 1 35 1 127 159 160 254 89 2 13 254 252 4 254 251 1 211 254 198 1 58 58 2 254 18 1 238 0 0 1 0 18 0 19 2 2 2 32 0 5 0 11 0 186 0 2 0 3 0 3 43 48 49 19 1 51 17 35 1 18 1 238 2 2 254 18 1 28 1 4 253 243 1 5 0 0 0 2 0 18 0 19 2 2 2 32 0 2 0 8 0 51 0 186 0 8 0 3 0 3 43 186 0 0 0 3 0 8 17 18 57 186 0 1 0 3 0 8 17 18 57 186 0 2 0 3 0 8 17 18 57 186 0 6 0 3 0 8 17 18 57 48 49 37 17 5 1 35 1 53 1 51 1 198 254 203 1 113 2 254 18 1 238 2 122 1 63 159 254 249 1 5 4 1 4 0 0 2 0 74 255 246 2 213 2 159 0 3 0 9 0 40 0 184 0 0 69 88 184 0 8 47 27 185 0 8 0 4 62 89 187 0 6 0 1 0 1 0 4 43 184 0 8 16 185 0 0 0 1 244 48 49 37 17 33 17 3 55 33 17 7 33 2 138 253 235 43 61 2 78 53 253 170 33 2 52 253 204 2 75 51 253 148 61 0 2 0 74 255 246 3 37 3 27 0 18 0 30 0 40 0 184 0 0 69 88 184 0 23 47 27 185 0 23 0 4 62 89 187 0 27 0 1 0 15 0 4 43 184 0 23 16 185 0 17 0 1 244 48 49 1 14 1 15 1 46 1 39 55 30 1 23 51 62 1 55 33 17 33 19 6 7 17 7 33 17 55 33 62 1 55 2 138 68 111 36 86 27 70 43 56 37 61 20 4 32 105 66 254 39 2 21 155 41 39 53 253 170 61 1 252 26 55 28 2 54 95 227 130 10 77 136 64 38 58 126 63 110 218 97 253 204 2 200 38 45 253 157 61 2 118 51 35 61 28 0 0 1 0 0 255 236 2 104 2 172 0 19 0 0 23 46 1 39 55 30 1 23 51 62 3 55 23 14 3 7 151 30 73 48 56 42 67 23 4 27 78 96 110 59 54 59 112 98 82 28 20 83 143 69 38 63 135 67 89 178 165 146 58 50 55 139 164 185 101 0 0 0 0 1 0 29 255 232 1 225 2 182 0 38 0 21 0 186 0 5 0 36 0 3 43 186 0 8 0 36 0 5 17 18 57 48 49 55 52 62 2 51 50 22 23 17 51 30 3 23 30 3 21 20 6 7 39 62 1 53 52 38 39 17 20 14 2 35 34 38 29 23 42 58 35 20 33 7 50 4 8 15 24 19 34 44 26 10 21 11 35 8 5 65 60 28 47 63 34 41 60 52 23 42 33 19 7 5 2 25 10 15 15 19 13 24 46 47 51 28 39 69 23 13 24 41 27 48 83 19 254 105 41 63 42 21 38 0 0 2 0 56 255 246 1 205 2 158 0 5 0 15 0 53 0 184 0 0 69 88 184 0 1 47 27 185 0 1 0 16 62 89 184 0 0 69 88 184 0 4 47 27 185 0 4 0 4 62 89 185 0 6 0 1 244 184 0 1 16 185 0 10 0 1 244 48 49 27 1 51 19 3 35 63 2 47 1 35 15 1 31 1 56 165 75 165 165 75 40 62 65 65 62 4 63 65 65 63 1 74 1 84 254 172 254 172 69 133 138 137 134 134 137 138 133 0 0 0 0 1 0 81 1 178 0 185 2 178 0 4 0 11 0 186 0 0 0 4 0 3 43 48 49 19 51 15 1 35 104 81 16 34 54 2 178 100 156 0 255 255 0 81 1 178 1 106 2 178 0 38 2 222 0 0 0 7 2 222 0 177 0 0 255 255 0 57 1 172 0 187 2 184 2 6 2 8 0 0 255 255 0 63 1 175 0 193 2 187 2 6 2 9 0 0 0 1 0 30 2 28 0 141 2 217 0 13 0 40 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 12 62 89 187 0 7 0 1 0 6 0 4 43 184 0 0 16 185 0 13 0 1 244 48 49 19 50 54 53 52 38 35 53 54 22 21 20 6 39 30 35 29 29 35 54 57 57 54 2 66 31 26 25 31 36 2 51 43 44 51 2 0 0 0 1 0 20 2 28 0 131 2 217 0 13 0 40 0 184 0 0 69 88 184 0 6 47 27 185 0 6 0 12 62 89 187 0 13 0 1 0 0 0 4 43 184 0 6 16 185 0 7 0 1 244 48 49 19 34 6 21 20 22 51 21 6 38 53 52 54 23 131 35 29 29 35 54 57 57 54 2 179 31 25 26 31 36 2 51 44 43 51 2 0 0 255 255 0 160 2 61 1 80 2 202 0 7 2 246 1 15 0 0 0 0 255 255 0 206 2 61 1 126 2 202 0 7 2 248 1 15 0 0 0 0 255 255 0 142 2 61 1 144 2 202 0 7 2 250 1 15 0 0 0 0 255 255 0 142 2 61 1 144 2 202 0 7 3 12 1 15 0 0 0 0 0 1 0 22 2 21 0 92 2 204 0 3 0 24 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 18 62 89 184 0 2 220 48 49 19 51 7 35 22 70 6 58 2 204 183 0 0 0 255 255 0 16 2 89 1 6 2 146 0 7 2 254 0 139 0 0 0 0 255 255 0 46 2 61 0 222 2 202 0 6 2 248 111 0 255 255 0 0 2 61 0 176 2 202 0 6 2 246 111 0 0 1 0 22 255 2 0 92 255 185 0 3 0 11 0 186 0 0 0 1 0 3 43 48 49 31 1 35 55 86 6 70 6 71 183 183 255 255 0 132 2 67 1 154 2 173 0 7 2 252 1 15 0 0 0 0 255 255 0 136 2 76 1 150 2 174 0 7 3 4 1 15 0 0 0 0 255 255 0 148 2 89 1 138 2 146 0 7 2 254 1 15 0 0 0 0 255 255 0 145 2 63 1 141 2 190 0 7 3 0 1 15 0 0 0 0 255 255 0 178 2 30 1 108 2 215 0 7 3 8 1 15 0 0 0 0 255 255 0 173 2 59 1 207 2 202 0 7 3 10 1 15 0 0 0 0 255 255 0 217 2 74 1 69 2 182 0 7 3 2 1 15 0 0 0 0 255 255 0 192 255 43 1 89 0 3 0 7 3 22 1 21 0 0 0 0 255 255 0 205 255 50 1 118 0 3 0 7 3 24 1 15 0 0 0 0 0 1 255 145 2 61 0 65 2 202 0 3 0 24 0 184 0 0 69 88 184 0 3 47 27 185 0 3 0 12 62 89 184 0 1 220 48 49 3 51 23 35 111 86 90 63 2 202 141 0 0 0 0 1 255 125 2 194 0 51 3 50 0 3 0 11 0 186 0 1 0 3 0 3 43 48 49 3 51 23 35 131 94 88 69 3 50 112 0 1 255 191 2 61 0 111 2 202 0 3 0 24 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 12 62 89 184 0 2 220 48 49 3 35 55 51 2 63 90 86 2 61 141 0 0 0 0 1 255 205 2 194 0 131 3 50 0 3 0 11 0 186 0 2 0 0 0 3 43 48 49 19 35 55 51 18 69 88 94 2 194 112 0 1 255 127 2 61 0 129 2 202 0 7 0 55 0 184 0 0 69 88 184 0 6 47 27 185 0 6 0 12 62 89 184 0 0 69 88 184 0 3 47 27 185 0 3 0 12 62 89 184 0 6 16 184 0 0 220 186 0 5 0 0 0 6 17 18 57 48 49 3 51 23 35 39 35 7 35 34 68 95 60 67 4 67 60 2 202 141 91 91 0 0 0 1 255 120 2 194 0 136 3 50 0 7 0 23 0 186 0 6 0 1 0 3 43 184 0 6 16 184 0 7 220 184 0 3 208 48 49 3 55 51 23 35 39 35 7 136 96 80 96 67 67 4 67 2 194 112 112 68 68 0 0 1 255 117 2 67 0 139 2 173 0 22 0 65 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 12 62 89 184 0 0 69 88 184 0 14 47 27 185 0 14 0 12 62 89 187 0 19 0 1 0 3 0 4 43 184 0 14 16 185 0 8 0 1 244 184 0 3 16 184 0 11 208 48 49 3 62 1 51 50 30 2 51 50 55 51 14 1 35 34 46 2 35 34 7 35 139 4 40 37 19 32 27 24 12 28 9 46 4 40 37 19 31 27 24 13 28 9 46 2 67 45 61 16 19 16 51 45 61 16 19 16 51 0 0 0 0 1 255 111 2 199 0 145 3 51 0 23 0 35 0 186 0 0 0 17 0 3 43 186 0 5 0 12 0 3 43 184 0 0 16 184 0 8 208 184 0 12 16 184 0 20 208 48 49 19 34 46 2 35 34 6 7 35 62 1 51 50 30 2 51 50 54 55 51 14 1 60 20 32 27 26 14 14 22 4 46 5 44 36 20 32 27 26 14 14 22 4 46 5 44 2 199 16 20 16 26 26 47 61 16 20 16 27 25 46 62 0 0 1 255 133 2 89 0 123 2 146 0 3 0 11 0 184 0 3 47 184 0 1 220 48 49 3 51 21 35 123 246 246 2 146 57 0 0 1 255 132 2 217 0 124 3 18 0 3 0 11 0 186 0 1 0 2 0 3 43 48 49 3 51 21 35 124 248 248 3 18 57 0 0 1 255 130 2 63 0 126 2 190 0 17 0 49 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 18 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 12 62 89 184 0 9 220 184 0 5 16 184 0 12 208 48 49 17 34 46 2 39 51 30 1 51 50 54 55 51 14 3 32 47 30 16 1 51 4 36 35 35 36 4 51 2 15 30 47 2 63 23 37 45 22 29 47 47 29 22 45 37 23 0 0 0 0 1 255 133 2 196 0 123 3 50 0 17 0 23 0 186 0 9 0 0 0 3 43 184 0 9 16 184 0 6 220 184 0 12 208 48 49 17 34 46 2 39 51 30 1 51 50 54 55 51 14 3 30 44 30 16 3 50 5 34 34 34 34 5 50 3 16 30 44 2 196 19 30 40 21 24 39 39 24 21 40 30 19 0 0 1 255 202 2 74 0 54 2 182 0 11 0 24 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 12 62 89 184 0 6 220 48 49 17 34 38 53 52 54 51 50 22 21 20 6 23 31 31 23 23 31 31 2 74 30 24 23 31 31 23 24 30 0 0 1 255 199 2 202 0 57 3 53 0 11 0 11 0 186 0 6 0 0 0 3 43 48 49 17 34 38 53 52 54 51 50 22 21 20 6 24 33 33 24 24 33 33 2 202 30 24 23 30 30 23 24 30 0 0 0 2 255 121 2 76 0 135 2 174 0 11 0 23 0 40 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 12 62 89 184 0 6 220 184 0 0 16 184 0 12 208 184 0 6 16 184 0 18 208 48 49 3 34 38 53 52 54 51 50 22 21 20 6 51 34 38 53 52 54 51 50 22 21 20 6 86 22 27 27 22 21 28 28 151 21 28 28 21 22 27 27 2 76 28 21 21 28 28 21 21 28 28 21 21 28 28 21 21 28 0 0 0 2 255 121 2 203 0 135 3 45 0 11 0 23 0 27 0 186 0 6 0 0 0 3 43 184 0 0 16 184 0 12 208 184 0 6 16 184 0 18 208 48 49 3 34 38 53 52 54 51 50 22 21 20 6 51 34 38 53 52 54 51 50 22 21 20 6 86 22 27 27 22 21 28 28 151 21 28 28 21 22 27 27 2 203 28 21 22 27 27 22 21 28 28 21 22 27 27 22 21 28 0 0 0 0 1 255 192 2 41 0 83 2 215 0 14 0 19 0 186 0 6 0 5 0 3 43 186 0 0 0 14 0 3 43 48 49 3 62 1 53 52 39 55 30 1 21 20 14 2 7 37 24 32 83 9 66 72 18 31 40 22 2 79 7 20 19 39 3 48 2 41 38 22 31 23 13 4 0 0 0 1 255 192 2 186 0 83 3 104 0 14 0 19 0 186 0 6 0 5 0 3 43 186 0 0 0 14 0 3 43 48 49 3 62 1 53 52 39 55 30 1 21 20 14 2 7 37 24 32 83 9 66 72 18 31 40 22 2 224 7 20 19 39 3 48 2 41 38 22 31 23 13 4 0 0 0 2 255 163 2 30 0 93 2 215 0 11 0 23 0 19 0 186 0 12 0 0 0 3 43 186 0 6 0 18 0 3 43 48 49 17 34 38 53 52 54 51 50 22 21 20 6 39 50 54 53 52 38 35 34 6 21 20 22 41 52 52 41 41 52 52 41 20 28 28 20 20 28 28 2 30 51 42 42 50 50 42 42 51 37 30 26 25 30 30 25 26 30 0 0 0 0 2 255 163 2 187 0 93 3 107 0 11 0 23 0 19 0 186 0 12 0 0 0 3 43 186 0 6 0 18 0 3 43 48 49 17 34 38 53 52 54 51 50 22 21 20 6 39 50 54 53 52 38 35 34 6 21 20 22 41 52 52 41 40 53 53 40 19 28 28 19 20 28 28 2 187 47 41 40 48 48 40 41 47 36 27 25 23 28 28 23 25 27 0 0 0 0 2 255 158 2 59 0 192 2 202 0 3 0 7 0 36 0 184 0 0 69 88 184 0 2 47 27 185 0 2 0 12 62 89 184 0 0 220 184 0 5 208 184 0 2 16 184 0 6 208 48 49 3 51 7 35 55 51 7 35 28 73 88 55 218 72 88 55 2 202 143 143 143 0 0 0 0 2 255 147 2 194 0 192 3 50 0 3 0 7 0 27 0 186 0 1 0 3 0 3 43 184 0 1 16 184 0 4 208 184 0 3 16 184 0 6 208 48 49 3 55 51 7 55 51 7 35 109 66 77 83 164 77 84 59 2 194 112 112 112 112 0 0 0 0 1 255 127 2 61 0 129 2 202 0 7 0 55 0 184 0 0 69 88 184 0 7 47 27 185 0 7 0 12 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 18 62 89 186 0 2 0 0 0 7 17 18 57 184 0 7 16 184 0 5 220 48 49 3 51 23 51 55 51 7 35 129 60 67 4 67 60 95 68 2 202 92 92 141 0 0 0 1 255 120 2 194 0 136 3 50 0 7 0 23 0 186 0 5 0 2 0 3 43 184 0 5 16 184 0 4 220 184 0 7 208 48 49 19 7 35 39 51 23 51 55 136 96 80 96 67 67 4 67 3 50 112 112 68 68 0 0 2 255 64 2 59 0 98 2 202 0 3 0 7 0 36 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 12 62 89 184 0 0 208 184 0 5 16 184 0 7 220 184 0 3 208 48 49 19 35 39 51 7 35 39 51 98 55 88 73 77 55 88 72 2 59 143 143 143 0 0 0 0 2 255 64 2 194 0 109 3 50 0 3 0 7 0 27 0 186 0 2 0 0 0 3 43 184 0 0 16 184 0 4 208 184 0 2 16 184 0 6 208 48 49 19 39 51 23 43 1 39 51 49 83 77 66 158 59 84 77 2 194 112 112 112 0 1 255 203 2 33 0 46 2 220 0 16 0 11 0 186 0 5 0 11 0 3 43 48 49 19 14 1 7 54 51 50 22 21 20 6 35 34 53 52 54 55 46 29 26 2 3 5 15 26 23 17 51 38 43 2 188 14 35 23 1 19 20 23 22 69 35 63 20 0 0 0 0 1 255 209 2 32 0 51 2 218 0 15 0 11 0 186 0 10 0 4 0 3 43 48 49 3 54 55 6 35 34 38 53 52 54 51 50 21 20 6 7 47 54 3 3 6 15 26 24 17 50 38 43 2 64 26 46 1 19 20 22 22 69 35 62 20 0 0 0 1 255 247 1 178 0 143 2 99 0 15 0 11 0 186 0 0 0 15 0 3 43 48 49 3 62 1 53 52 38 39 55 30 1 21 20 14 2 7 9 42 42 8 6 59 10 13 22 39 52 31 1 219 5 30 31 11 21 10 28 14 32 18 27 40 27 16 3 0 0 0 0 1 255 202 255 50 0 54 255 157 0 11 0 11 0 186 0 6 0 0 0 3 43 48 49 21 34 38 53 52 54 51 50 22 21 20 6 23 31 31 23 23 31 31 206 30 24 23 30 30 23 24 30 0 0 0 0 2 255 121 255 55 0 135 255 153 0 11 0 23 0 27 0 186 0 6 0 0 0 3 43 184 0 0 16 184 0 12 208 184 0 6 16 184 0 18 208 48 49 7 34 38 53 52 54 51 50 22 21 20 6 51 34 38 53 52 54 51 50 22 21 20 6 86 22 27 27 22 21 28 28 151 21 28 28 21 22 27 27 201 29 20 21 28 28 21 20 29 29 20 21 28 28 21 20 29 0 1 255 171 255 40 0 68 255 208 0 16 0 19 0 186 0 0 0 15 0 3 43 186 0 9 0 8 0 3 43 48 49 7 30 1 21 20 14 2 7 39 62 1 53 52 38 39 55 29 51 46 24 40 53 28 8 40 49 30 21 18 48 8 35 34 22 32 22 13 2 40 5 21 20 20 19 5 38 0 0 1 255 171 255 43 0 68 0 3 0 17 0 19 0 186 0 2 0 17 0 3 43 186 0 11 0 10 0 3 43 48 49 39 51 7 30 1 21 20 14 2 7 39 62 1 53 52 38 39 19 53 25 24 35 24 40 53 28 8 40 49 33 30 3 53 8 32 31 22 32 22 13 3 41 5 23 20 20 21 8 0 0 0 0 1 255 171 255 43 0 68 0 3 0 17 0 19 0 186 0 17 0 2 0 3 43 186 0 10 0 11 0 3 43 48 49 39 51 7 30 1 21 20 14 2 7 39 62 1 53 52 38 39 19 53 25 24 35 24 40 53 28 8 40 49 33 30 3 53 8 32 31 22 32 22 13 3 41 5 23 20 20 21 8 0 0 0 0 1 255 190 255 50 0 103 0 3 0 18 0 11 0 186 0 16 0 10 0 3 43 48 49 7 52 54 55 51 14 1 21 20 22 51 50 55 23 14 1 35 34 38 66 46 25 58 32 36 28 18 22 18 22 14 46 19 38 52 121 41 64 19 24 55 29 23 23 13 41 11 16 43 0 0 0 1 255 190 255 44 0 109 0 3 0 21 0 11 0 186 0 13 0 6 0 3 43 48 49 55 14 1 21 20 22 51 50 54 55 23 14 1 35 34 38 53 52 62 2 55 66 32 36 30 18 12 19 9 23 14 46 20 40 55 13 21 26 12 3 24 57 29 23 23 7 7 45 11 17 44 43 21 38 33 27 9 0 0 0 1 255 130 255 50 0 126 255 177 0 17 0 23 0 186 0 0 0 9 0 3 43 184 0 9 16 184 0 6 220 184 0 12 208 48 49 21 34 46 2 39 51 30 1 51 50 54 55 51 14 3 32 47 30 16 1 51 4 36 35 35 36 4 51 2 15 30 47 206 23 37 45 22 29 47 47 29 22 45 37 23 0 0 0 1 255 132 255 85 0 123 255 143 0 3 0 11 0 186 0 3 0 0 0 3 43 48 49 23 35 53 51 123 247 247 171 58 0 0 0 3 255 124 2 76 0 132 3 29 0 11 0 23 0 27 0 35 0 186 0 6 0 0 0 3 43 186 0 25 0 26 0 3 43 184 0 0 16 184 0 12 208 184 0 6 16 184 0 18 208 48 49 3 34 38 53 52 54 51 50 22 21 20 6 51 34 38 53 52 54 51 50 22 21 20 6 39 51 21 35 86 20 26 26 20 20 25 25 152 20 25 25 20 20 26 26 230 247 247 2 76 26 19 20 26 26 20 19 26 26 19 20 26 26 20 19 26 209 47 0 3 255 124 2 203 0 132 3 139 0 3 0 15 0 27 0 35 0 186 0 10 0 4 0 3 43 186 0 1 0 2 0 3 43 184 0 4 16 184 0 16 208 184 0 10 16 184 0 22 208 48 49 3 51 21 35 23 34 38 53 52 54 51 50 22 21 20 6 51 34 38 53 52 54 51 50 22 21 20 6 124 248 248 38 20 26 26 20 20 25 25 152 20 25 25 20 20 26 26 3 139 46 146 26 20 20 25 25 20 20 26 26 20 20 25 25 20 20 26 0 3 255 124 2 76 0 132 3 55 0 3 0 15 0 27 0 35 0 186 0 10 0 4 0 3 43 186 0 0 0 2 0 3 43 184 0 4 16 184 0 16 208 184 0 10 16 184 0 22 208 48 49 19 51 7 35 7 34 38 53 52 54 51 50 22 21 20 6 51 34 38 53 52 54 51 50 22 21 20 6 29 79 103 58 33 20 26 26 20 20 25 25 152 20 25 25 20 20 26 26 3 55 103 132 26 19 20 26 26 20 19 26 26 19 20 26 26 20 19 26 0 0 0 0 3 255 124 2 203 0 132 3 182 0 3 0 15 0 27 0 35 0 186 0 10 0 4 0 3 43 186 0 0 0 2 0 3 43 184 0 4 16 184 0 16 208 184 0 10 16 184 0 22 208 48 49 19 51 7 35 7 34 38 53 52 54 51 50 22 21 20 6 51 34 38 53 52 54 51 50 22 21 20 6 38 91 112 68 35 20 26 26 20 20 25 25 152 20 25 25 20 20 26 26 3 182 111 124 26 20 20 25 25 20 20 26 26 20 20 25 25 20 20 26 0 0 0 0 3 255 124 2 76 0 132 3 55 0 7 0 19 0 31 0 43 0 186 0 14 0 8 0 3 43 186 0 4 0 6 0 3 43 184 0 4 16 184 0 0 208 184 0 8 16 184 0 20 208 184 0 14 16 184 0 26 208 48 49 3 51 23 51 55 51 7 35 7 34 38 53 52 54 51 50 22 21 20 6 51 34 38 53 52 54 51 50 22 21 20 6 126 61 63 4 63 61 91 70 51 20 26 26 20 20 25 25 152 20 25 25 20 20 26 26 3 55 64 64 103 132 26 19 20 26 26 20 19 26 26 19 20 26 26 20 19 26 0 0 3 255 120 2 203 0 136 3 182 0 11 0 23 0 31 0 43 0 186 0 6 0 0 0 3 43 186 0 31 0 25 0 3 43 184 0 0 16 184 0 12 208 184 0 6 16 184 0 18 208 184 0 31 16 184 0 27 208 48 49 3 34 38 53 52 54 51 50 22 21 20 6 51 34 38 53 52 54 51 50 22 21 20 6 55 7 35 39 51 23 51 55 86 20 26 26 20 20 25 25 152 20 25 25 20 20 26 26 30 96 80 96 67 67 4 67 2 203 26 20 20 25 25 20 20 26 26 20 20 25 25 20 20 26 235 111 111 68 68 0 3 255 124 2 76 0 132 3 55 0 3 0 15 0 27 0 35 0 186 0 10 0 4 0 3 43 186 0 3 0 1 0 3 43 184 0 4 16 184 0 16 208 184 0 10 16 184 0 22 208 48 49 19 35 39 51 23 34 38 53 52 54 51 50 22 21 20 6 35 34 38 53 52 54 51 50 22 21 20 6 53 58 103 79 115 20 25 25 20 20 26 26 192 20 26 26 20 20 25 25 2 208 103 235 26 19 20 26 26 20 19 26 26 19 20 26 26 20 19 26 0 0 0 0 3 255 124 2 203 0 132 3 182 0 3 0 15 0 27 0 35 0 186 0 10 0 4 0 3 43 186 0 3 0 1 0 3 43 184 0 4 16 184 0 16 208 184 0 10 16 184 0 22 208 48 49 19 35 39 51 23 34 38 53 52 54 51 50 22 21 20 6 35 34 38 53 52 54 51 50 22 21 20 6 51 68 112 91 124 20 25 25 20 20 26 26 192 20 26 26 20 20 25 25 3 71 111 235 26 20 20 25 25 20 20 26 26 20 20 25 25 20 20 26 0 0 0 0 2 255 140 2 61 0 232 2 242 0 7 0 11 0 27 0 186 0 8 0 10 0 3 43 186 0 0 0 6 0 3 43 184 0 6 16 184 0 3 208 48 49 3 51 23 35 39 35 7 35 37 51 7 35 34 68 82 56 58 4 58 56 1 22 70 92 51 2 180 119 73 73 181 114 0 0 2 255 128 2 194 0 234 3 113 0 3 0 11 0 27 0 186 0 0 0 2 0 3 43 186 0 4 0 10 0 3 43 184 0 10 16 184 0 7 208 48 49 19 51 7 35 39 51 23 35 39 35 7 35 162 72 91 52 127 72 92 63 63 4 63 63 3 113 111 42 106 62 62 0 0 0 2 255 140 2 61 0 201 2 242 0 7 0 11 0 27 0 186 0 11 0 9 0 3 43 186 0 0 0 6 0 3 43 184 0 6 16 184 0 3 208 48 49 3 51 23 35 39 35 7 35 37 35 39 51 34 68 82 56 58 4 58 56 1 61 51 92 69 2 180 119 73 73 67 114 0 0 2 255 128 2 194 0 184 3 113 0 3 0 11 0 27 0 186 0 3 0 1 0 3 43 186 0 4 0 10 0 3 43 184 0 10 16 184 0 7 208 48 49 19 35 39 51 7 51 23 35 39 35 7 35 184 52 91 72 149 72 92 63 63 4 63 63 3 2 111 69 106 62 62 0 0 0 2 255 140 2 61 0 209 3 16 0 7 0 23 0 35 0 186 0 1 0 3 0 3 43 186 0 15 0 14 0 3 43 186 0 8 0 23 0 3 43 184 0 3 16 184 0 6 208 48 49 3 51 23 35 39 35 7 35 55 62 1 53 52 38 39 55 30 1 21 20 14 2 7 34 68 82 56 58 4 58 56 223 19 23 32 37 7 59 63 16 26 33 18 2 180 119 73 73 90 5 18 16 20 19 2 41 2 36 35 20 28 19 12 4 0 0 2 255 128 2 194 0 207 3 138 0 13 0 21 0 35 0 186 0 15 0 17 0 3 43 186 0 7 0 6 0 3 43 186 0 0 0 13 0 3 43 184 0 17 16 184 0 20 208 48 49 19 62 1 53 52 38 39 55 30 1 21 20 6 7 39 51 23 35 39 35 7 35 104 19 26 33 38 9 59 61 56 36 151 72 92 63 63 4 63 63 3 21 5 15 16 20 17 2 42 2 36 35 38 35 6 58 106 62 62 0 0 0 2 255 125 2 59 0 131 3 34 0 7 0 29 0 51 0 186 0 0 0 6 0 3 43 186 0 16 0 22 0 3 43 186 0 11 0 27 0 3 43 184 0 6 16 184 0 3 208 184 0 11 16 184 0 18 208 184 0 22 16 184 0 29 208 48 49 3 51 23 35 39 35 7 35 39 62 1 51 50 30 2 51 50 55 51 14 1 35 34 46 2 35 34 7 38 76 86 58 64 4 64 58 7 4 40 35 19 27 23 21 12 32 7 42 4 40 35 19 27 23 21 12 32 7 2 163 104 65 65 140 40 51 13 17 13 43 40 51 13 17 13 43 0 0 2 255 124 2 194 0 132 3 171 0 7 0 30 0 51 0 186 0 11 0 28 0 3 43 186 0 16 0 23 0 3 43 186 0 0 0 6 0 3 43 184 0 6 16 184 0 3 208 184 0 11 16 184 0 19 208 184 0 23 16 184 0 30 208 48 49 3 51 23 35 39 35 7 35 39 62 1 51 50 30 2 51 50 54 55 51 14 1 35 34 46 2 35 34 7 36 72 92 63 63 4 63 63 4 4 40 35 18 28 23 22 12 15 21 4 42 4 40 35 18 28 23 22 12 32 8 3 44 106 62 62 140 40 53 14 17 14 24 21 39 54 14 17 14 45 0 0 0 2 255 130 2 63 0 126 3 21 0 3 0 21 0 31 0 186 0 0 0 2 0 3 43 186 0 13 0 4 0 3 43 184 0 13 16 184 0 10 220 184 0 16 208 48 49 19 51 7 35 23 34 46 2 39 51 30 1 51 50 54 55 51 14 3 31 68 88 48 37 32 47 30 16 1 43 5 40 38 38 40 5 43 2 15 30 47 3 21 112 102 23 37 45 22 31 49 49 31 22 45 37 23 0 2 255 134 2 196 0 122 3 139 0 3 0 21 0 31 0 186 0 0 0 2 0 3 43 186 0 13 0 4 0 3 43 184 0 13 16 184 0 10 220 184 0 16 208 48 49 19 51 7 35 23 34 46 2 39 51 30 1 51 50 54 55 51 14 3 35 72 97 49 39 29 43 30 17 3 45 6 35 36 36 35 6 45 3 17 30 43 3 139 105 94 18 30 38 21 26 38 38 26 21 38 30 18 0 2 255 130 2 63 0 126 3 21 0 3 0 21 0 31 0 186 0 3 0 1 0 3 43 186 0 13 0 4 0 3 43 184 0 13 16 184 0 10 220 184 0 16 208 48 49 19 35 39 51 23 34 46 2 39 51 30 1 51 50 54 55 51 14 3 37 48 88 68 31 32 47 30 16 1 43 5 40 38 38 40 5 43 2 15 30 47 2 165 112 214 23 37 45 22 31 49 49 31 22 45 37 23 0 2 255 134 2 196 0 122 3 139 0 3 0 21 0 31 0 186 0 3 0 1 0 3 43 186 0 13 0 4 0 3 43 184 0 13 16 184 0 10 220 184 0 16 208 48 49 19 35 39 51 23 34 46 2 39 51 30 1 51 50 54 55 51 14 3 39 49 97 72 35 29 43 30 17 3 45 6 35 36 36 35 6 45 3 17 30 43 3 34 105 199 18 30 38 21 26 38 38 26 21 38 30 18 0 2 255 130 2 63 0 126 3 71 0 17 0 33 0 39 0 186 0 9 0 0 0 3 43 186 0 25 0 24 0 3 43 186 0 18 0 33 0 3 43 184 0 9 16 184 0 6 220 184 0 12 208 48 49 17 34 46 2 39 51 30 1 51 50 54 55 51 14 3 39 62 1 53 52 38 39 55 30 1 21 20 14 2 7 32 47 30 16 1 43 5 40 38 38 40 5 43 2 15 30 47 67 18 24 32 37 7 59 63 16 26 34 18 2 63 23 37 45 22 31 49 49 31 22 45 37 23 143 5 18 16 20 19 2 41 2 35 36 20 28 19 12 4 0 2 255 134 2 196 0 122 3 184 0 15 0 33 0 39 0 186 0 25 0 16 0 3 43 186 0 7 0 6 0 3 43 186 0 0 0 15 0 3 43 184 0 25 16 184 0 22 220 184 0 28 208 48 49 3 62 1 53 52 38 39 55 30 1 21 20 14 2 7 23 34 46 2 39 51 30 1 51 50 54 55 51 14 3 33 18 26 33 37 8 59 62 16 25 34 18 23 29 43 30 17 3 45 6 35 36 36 35 6 45 3 17 30 43 3 67 5 15 16 20 17 2 42 2 36 35 19 27 19 11 3 92 18 30 38 21 26 38 38 26 21 38 30 18 0 0 0 0 2 255 125 2 63 0 131 3 34 0 17 0 39 0 55 0 186 0 26 0 32 0 3 43 186 0 21 0 37 0 3 43 186 0 9 0 0 0 3 43 184 0 9 16 184 0 6 220 184 0 12 208 184 0 21 16 184 0 28 208 184 0 32 16 184 0 39 208 48 49 17 34 46 2 39 51 30 1 51 50 54 55 51 14 3 39 62 1 51 50 30 2 51 50 55 51 14 1 35 34 46 2 35 34 7 32 46 30 16 1 45 5 37 38 38 37 5 45 2 15 30 46 163 4 40 35 19 27 23 21 12 32 7 42 4 40 35 19 27 23 21 12 32 7 2 63 19 30 38 20 24 38 38 24 20 38 30 19 136 40 51 13 17 13 43 40 51 13 17 13 43 0 2 255 124 2 196 0 132 3 171 0 17 0 40 0 55 0 186 0 26 0 33 0 3 43 186 0 21 0 38 0 3 43 186 0 9 0 0 0 3 43 184 0 9 16 184 0 6 220 184 0 12 208 184 0 21 16 184 0 29 208 184 0 33 16 184 0 40 208 48 49 17 34 46 2 39 51 30 1 51 50 54 55 51 14 3 39 62 1 51 50 30 2 51 50 54 55 51 14 1 35 34 46 2 35 34 7 29 43 30 17 3 45 6 35 36 36 35 6 45 3 17 30 43 161 4 40 35 18 28 23 22 12 15 21 4 42 4 40 35 18 28 23 22 12 32 8 2 196 18 30 38 21 26 38 38 26 21 38 30 18 138 40 53 14 17 14 24 21 39 54 14 17 14 45 0 0 1 255 227 2 36 0 30 2 248 0 4 0 11 0 186 0 1 0 0 0 3 43 48 49 3 39 51 15 1 25 4 59 1 14 2 36 212 57 155 0 1 255 187 2 29 0 83 2 198 0 16 0 19 0 186 0 15 0 0 0 3 43 186 0 8 0 9 0 3 43 48 49 19 46 1 53 52 62 2 55 23 14 1 21 20 22 23 7 28 51 46 24 40 52 28 8 39 49 29 22 18 2 29 8 36 33 22 32 22 13 3 41 5 21 19 20 20 5 38 0 3 0 30 0 0 2 53 2 144 0 12 0 21 0 45 0 127 0 184 0 0 69 88 184 0 36 47 27 185 0 36 0 16 62 89 184 0 0 69 88 184 0 31 47 27 185 0 31 0 4 62 89 186 0 6 0 31 0 36 17 18 57 184 0 6 47 184 0 31 16 185 0 12 0 1 244 186 0 11 0 12 0 6 17 18 57 184 0 11 47 185 0 8 0 1 244 184 0 6 16 185 0 14 0 1 244 184 0 36 16 185 0 21 0 1 244 186 0 22 0 6 0 14 17 18 57 184 0 11 16 184 0 32 208 184 0 8 16 184 0 35 208 48 49 37 50 54 53 52 38 43 1 21 51 21 35 21 17 51 50 54 53 52 38 43 1 23 30 1 21 20 14 2 43 1 53 35 53 55 17 51 50 30 2 21 20 6 7 1 49 85 94 93 86 115 152 152 98 84 75 79 77 101 223 72 80 36 66 91 55 210 77 77 195 50 83 59 33 56 58 63 67 70 65 60 101 47 114 1 61 57 55 54 48 238 11 80 69 50 73 49 24 177 43 4 1 176 18 38 60 42 48 75 15 0 255 255 0 8 0 0 0 254 3 50 2 38 0 12 0 0 0 7 3 1 0 131 0 0 255 255 0 52 255 244 2 101 3 50 2 38 0 18 0 0 0 7 3 1 1 76 0 0 0 2 0 8 255 244 1 251 2 200 0 13 0 44 0 100 0 184 0 0 69 88 184 0 38 47 27 185 0 38 0 18 62 89 184 0 0 69 88 184 0 32 47 27 185 0 32 0 4 62 89 184 0 0 69 88 184 0 27 47 27 185 0 27 0 4 62 89 187 0 17 0 1 0 11 0 4 43 187 0 37 0 1 0 34 0 4 43 184 0 27 16 185 0 3 0 1 244 184 0 37 16 184 0 40 208 184 0 34 16 184 0 43 208 48 49 55 30 1 51 50 62 2 53 52 38 35 34 7 39 62 1 51 50 30 2 21 20 14 2 35 34 38 39 35 7 35 17 35 53 55 53 51 21 51 21 35 21 164 32 63 24 30 51 37 21 59 69 59 71 2 33 78 41 47 72 49 25 34 58 76 42 34 73 32 3 7 66 74 74 82 182 182 108 28 23 25 47 68 43 76 93 66 67 29 39 34 61 88 54 60 94 65 34 31 29 48 2 59 43 5 93 93 48 73 0 0 0 255 255 255 254 0 0 0 250 2 190 2 38 1 45 0 0 0 6 3 0 124 0 0 0 255 255 0 46 255 244 1 240 2 190 2 38 0 44 0 0 0 7 3 0 1 15 0 0 0 2 255 132 2 59 0 124 3 34 0 7 0 25 0 35 0 187 0 1 0 1 0 3 0 4 43 184 0 3 16 184 0 6 208 184 0 1 16 184 0 8 220 185 0 17 0 1 244 48 49 3 51 23 35 39 35 7 35 55 34 46 2 39 51 30 1 51 50 54 55 51 14 3 38 76 86 58 64 4 64 58 124 29 41 29 15 1 45 4 33 33 33 33 4 45 2 14 29 42 2 163 104 65 65 134 16 27 35 19 22 30 30 22 19 35 27 16 0 0 0 2 255 128 2 194 0 128 3 170 0 7 0 21 0 35 0 187 0 1 0 1 0 3 0 4 43 184 0 3 16 184 0 6 208 184 0 1 16 184 0 8 220 185 0 15 0 1 244 48 49 3 51 23 35 39 35 7 35 55 34 38 39 51 30 1 51 50 54 55 51 14 1 36 72 92 63 63 4 63 63 128 58 59 5 45 6 35 36 36 35 6 45 5 59 3 44 106 62 62 135 57 40 23 30 30 23 40 57 0 0 0 255 255 0 90 255 85 2 36 2 144 2 38 0 5 0 0 0 7 3 27 1 44 0 0 255 255 0 82 255 85 1 251 2 200 2 38 0 31 0 0 0 7 3 27 1 27 0 0 255 255 0 90 255 85 2 63 2 144 2 38 0 14 0 0 0 7 3 27 1 69 0 0 255 255 0 82 255 85 1 230 2 200 2 38 0 40 0 0 0 7 3 27 1 15 0 0 255 255 0 90 0 0 1 222 3 182 2 38 0 8 0 0 0 7 4 89 1 26 0 0 255 255 0 46 255 244 1 202 3 55 2 38 0 34 0 0 0 7 4 88 1 9 0 0 255 255 0 52 255 244 2 101 3 182 2 38 0 18 0 0 0 7 4 89 1 73 0 0 255 255 0 46 255 244 1 240 3 55 2 38 0 44 0 0 0 7 4 88 1 15 0 0 0 2 0 92 255 6 1 42 2 238 0 3 0 7 0 27 0 186 0 1 0 2 0 3 43 184 0 1 16 184 0 4 208 184 0 2 16 184 0 6 208 48 49 19 51 17 35 19 51 17 35 92 58 58 148 58 58 2 238 252 24 3 232 252 24 0 0 0 0 2 0 27 255 244 1 129 2 170 0 34 0 46 0 40 0 184 0 0 69 88 184 0 41 47 27 185 0 41 0 4 62 89 187 0 15 0 1 0 8 0 4 43 184 0 41 16 185 0 35 0 1 244 48 49 19 62 3 53 52 38 35 34 6 7 39 62 1 51 50 30 2 21 20 14 4 23 43 2 47 1 51 7 3 50 22 21 20 6 35 34 38 53 52 54 223 13 29 26 17 55 53 36 64 26 47 33 92 54 40 67 46 26 25 38 43 34 20 4 8 29 21 10 5 70 2 26 25 35 35 25 25 34 34 1 82 22 39 41 45 27 44 61 32 29 43 37 46 23 42 58 34 37 60 51 47 47 53 32 251 83 83 254 177 35 29 27 35 35 27 29 35 0 0 0 0 1 0 94 0 0 1 17 2 177 0 5 0 13 0 187 0 1 0 1 0 2 0 4 43 48 49 19 51 21 35 17 35 94 179 117 62 2 177 47 253 126 0 0 0 1 0 31 0 0 0 209 2 177 0 5 0 13 0 187 0 5 0 1 0 2 0 4 43 48 49 51 35 17 35 53 51 209 62 116 178 2 130 47 0 1 0 94 255 204 1 17 2 126 0 5 0 13 0 187 0 3 0 1 0 4 0 4 43 48 49 19 51 17 51 21 35 94 62 117 179 2 126 253 125 47 0 0 0 1 0 31 255 204 0 209 2 126 0 5 0 13 0 187 0 3 0 1 0 0 0 4 43 48 49 23 35 53 51 17 51 209 178 116 62 52 47 2 131 0 0 0 0 2 0 94 255 104 1 91 2 196 0 7 0 11 0 39 0 187 0 5 0 1 0 6 0 4 43 187 0 1 0 1 0 2 0 4 43 184 0 5 16 184 0 8 208 184 0 2 16 184 0 10 208 48 49 19 51 21 35 17 51 21 35 55 51 17 35 94 253 110 110 253 51 45 45 2 196 47 253 2 47 47 2 254 0 2 0 31 255 104 1 28 2 196 0 7 0 11 0 39 0 187 0 10 0 1 0 0 0 4 43 187 0 6 0 1 0 5 0 4 43 184 0 10 16 184 0 2 208 184 0 5 16 184 0 8 208 48 49 5 35 53 51 17 35 53 51 7 17 51 17 1 28 253 110 110 253 96 44 152 47 2 254 47 47 253 2 2 254 0 0 0 0 1 0 94 1 22 1 17 2 196 0 5 0 13 0 187 0 1 0 1 0 2 0 4 43 48 49 19 51 21 35 17 35 94 179 117 62 2 196 47 254 129 0 0 0 1 0 31 1 22 0 209 2 196 0 5 0 13 0 187 0 5 0 1 0 2 0 4 43 48 49 19 35 17 35 53 51 209 62 116 178 1 22 1 127 47 0 0 0 1 0 94 255 104 1 17 1 22 0 5 0 13 0 187 0 3 0 1 0 4 0 4 43 48 49 19 51 17 51 21 35 94 62 117 179 1 22 254 129 47 0 0 0 1 0 31 255 104 0 209 1 22 0 5 0 13 0 187 0 3 0 1 0 0 0 4 43 48 49 23 35 53 51 17 51 209 178 116 62 152 47 1 127 0 0 0 0 3 0 44 255 244 1 197 2 138 0 11 0 23 0 35 0 71 0 184 0 0 69 88 184 0 6 47 27 185 0 6 0 14 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 4 62 89 185 0 12 0 1 244 184 0 6 16 185 0 18 0 1 244 186 0 24 0 6 0 0 17 18 57 184 0 24 16 184 0 30 220 48 49 23 34 38 53 52 54 51 50 22 21 20 6 39 50 54 53 52 38 35 34 6 21 20 22 55 34 38 53 52 54 51 50 22 21 20 6 249 97 108 108 97 96 108 108 96 56 72 72 56 57 72 72 57 26 35 35 26 25 35 35 12 172 161 161 168 168 161 161 172 66 130 137 138 125 125 138 138 129 205 34 32 32 34 34 32 32 34 0 3 0 44 255 244 1 197 2 138 0 9 0 21 0 33 0 93 0 184 0 0 69 88 184 0 22 47 27 185 0 22 0 14 62 89 184 0 0 69 88 184 0 28 47 27 185 0 28 0 4 62 89 186 0 0 0 28 0 22 17 18 57 185 0 6 0 1 244 186 0 9 0 28 0 22 17 18 57 186 0 10 0 28 0 22 17 18 57 184 0 22 16 185 0 18 0 1 244 186 0 21 0 22 0 28 17 18 57 48 49 19 14 1 21 20 22 51 50 54 63 1 62 1 53 52 46 2 35 34 6 7 55 50 22 21 20 6 35 34 38 53 52 54 130 5 5 72 57 32 51 17 18 5 5 19 34 47 28 32 52 17 101 96 108 108 96 97 108 108 1 190 26 62 37 140 130 40 43 62 26 62 37 70 100 65 31 38 41 142 168 161 161 172 172 161 161 168 0 0 0 3 0 55 255 244 1 227 2 138 0 15 0 27 0 39 0 71 0 184 0 0 69 88 184 0 8 47 27 185 0 8 0 14 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 4 62 89 185 0 16 0 1 244 184 0 8 16 185 0 22 0 1 244 186 0 28 0 8 0 0 17 18 57 184 0 28 16 184 0 34 220 48 49 5 34 46 2 53 52 54 51 50 22 21 20 14 2 39 50 54 53 52 38 35 34 6 21 20 22 55 34 38 53 52 54 51 50 22 21 20 6 1 13 50 79 56 29 114 100 100 114 29 56 79 50 62 73 74 61 62 73 73 62 25 36 36 25 25 36 36 12 45 85 124 79 159 170 171 158 79 124 85 45 68 129 136 136 124 124 136 136 129 203 34 32 32 34 34 32 32 34 0 0 3 0 55 255 244 1 227 2 138 0 10 0 19 0 35 0 93 0 184 0 0 69 88 184 0 20 47 27 185 0 20 0 14 62 89 184 0 0 69 88 184 0 28 47 27 185 0 28 0 4 62 89 186 0 0 0 28 0 20 17 18 57 185 0 7 0 1 244 186 0 10 0 28 0 20 17 18 57 186 0 11 0 28 0 20 17 18 57 184 0 20 16 185 0 16 0 1 244 186 0 19 0 20 0 28 17 18 57 48 49 19 6 21 20 30 2 51 50 54 63 1 54 53 52 38 35 34 6 7 55 50 22 21 20 14 2 35 34 46 2 53 52 54 143 12 20 37 51 30 35 55 18 18 12 77 61 34 55 19 108 100 114 29 56 79 50 50 79 56 29 114 1 193 54 74 70 102 66 32 41 42 59 54 74 139 127 38 42 143 171 158 79 124 85 45 45 85 124 79 159 170 0 0 255 255 0 67 0 0 0 181 2 180 2 6 0 38 0 0 0 2 0 3 0 0 1 212 2 6 0 9 0 17 0 84 0 184 0 0 69 88 184 0 14 47 27 185 0 14 0 10 62 89 184 0 0 69 88 184 0 12 47 27 185 0 12 0 4 62 89 184 0 0 69 88 184 0 16 47 27 185 0 16 0 4 62 89 186 0 0 0 14 0 12 17 18 57 184 0 0 47 186 0 5 0 14 0 12 17 18 57 185 0 11 0 1 244 48 49 37 39 46 1 39 35 14 1 15 1 23 35 7 35 19 51 19 35 1 56 24 14 24 14 4 14 24 14 24 176 197 48 84 185 94 186 88 208 74 43 83 43 44 82 43 74 62 146 2 6 253 250 0 3 0 90 0 0 1 229 2 6 0 19 0 28 0 37 0 87 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 10 62 89 184 0 0 69 88 184 0 18 47 27 185 0 18 0 4 62 89 186 0 35 0 0 0 18 17 18 57 184 0 35 47 185 0 20 0 1 244 186 0 9 0 20 0 35 17 18 57 184 0 0 16 185 0 26 0 1 244 184 0 18 16 185 0 29 0 1 244 48 49 19 51 50 30 2 21 20 6 7 21 30 1 21 20 14 2 43 1 19 50 54 53 52 38 43 1 21 23 50 54 53 52 38 43 1 21 90 170 43 71 52 29 45 45 55 65 31 57 78 46 183 161 69 58 62 62 81 90 65 77 73 69 90 2 6 14 30 49 35 38 61 12 4 11 59 54 39 56 38 18 1 43 42 40 40 35 157 237 43 51 45 42 181 0 0 0 1 0 52 255 244 1 215 2 18 0 29 0 57 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 10 62 89 184 0 0 69 88 184 0 25 47 27 185 0 25 0 4 62 89 184 0 5 16 185 0 12 0 1 244 184 0 25 16 185 0 18 0 1 244 48 49 19 52 62 2 51 50 22 23 7 46 1 35 34 6 21 20 22 51 50 54 55 23 14 1 35 34 46 2 52 39 67 93 54 50 79 26 47 22 51 34 77 92 88 77 39 59 25 46 34 85 54 53 90 66 37 1 2 63 101 71 37 40 26 51 22 25 106 94 95 107 29 26 50 37 38 36 69 100 0 0 0 0 2 0 90 0 0 1 247 2 6 0 8 0 17 0 53 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 10 62 89 184 0 0 69 88 184 0 7 47 27 185 0 7 0 4 62 89 185 0 9 0 1 244 184 0 0 16 185 0 15 0 1 244 48 49 19 51 50 22 21 20 6 43 1 55 50 54 53 52 38 43 1 17 90 143 129 141 140 126 147 145 93 89 89 93 62 2 6 129 128 129 132 65 99 97 91 100 254 125 0 0 0 0 1 0 90 0 0 1 170 2 6 0 11 0 77 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 10 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 4 62 89 184 0 0 16 185 0 2 0 1 244 186 0 6 0 0 0 10 17 18 57 184 0 6 47 185 0 4 0 1 244 184 0 10 16 185 0 8 0 1 244 48 49 19 33 21 35 21 51 21 35 21 51 21 33 90 1 70 243 206 206 253 254 176 2 6 66 150 63 173 66 0 0 1 0 90 0 0 1 161 2 6 0 9 0 57 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 10 62 89 184 0 0 69 88 184 0 8 47 27 185 0 8 0 4 62 89 187 0 5 0 1 0 6 0 4 43 184 0 0 16 185 0 2 0 1 244 48 49 19 33 21 35 21 51 21 35 21 35 90 1 71 244 207 207 83 2 6 68 163 64 223 0 0 0 1 0 52 255 244 1 227 2 18 0 33 0 67 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 10 62 89 184 0 0 69 88 184 0 29 47 27 185 0 29 0 4 62 89 187 0 25 0 1 0 22 0 4 43 184 0 5 16 185 0 12 0 1 244 184 0 29 16 185 0 18 0 1 244 48 49 19 52 62 2 51 50 22 23 7 46 1 35 34 6 21 20 22 51 50 54 55 53 35 53 51 21 14 1 35 34 46 2 52 39 70 96 56 57 78 26 46 21 53 40 81 96 90 87 29 48 16 112 188 29 90 57 56 93 68 38 1 2 64 101 70 37 41 24 51 20 26 106 96 94 107 14 14 127 61 226 26 33 36 69 100 0 0 0 1 0 90 0 0 1 248 2 6 0 11 0 81 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 10 62 89 184 0 0 69 88 184 0 4 47 27 185 0 4 0 10 62 89 184 0 0 69 88 184 0 6 47 27 185 0 6 0 4 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 4 62 89 187 0 3 0 1 0 8 0 4 43 48 49 19 51 21 51 53 51 17 35 53 35 21 35 90 83 248 83 83 248 83 2 6 211 211 253 250 235 235 0 0 0 1 0 90 0 0 0 173 2 6 0 3 0 37 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 10 62 89 184 0 0 69 88 184 0 2 47 27 185 0 2 0 4 62 89 48 49 19 51 17 35 90 83 83 2 6 253 250 0 0 0 1 0 31 255 244 1 95 2 6 0 15 0 43 0 184 0 0 69 88 184 0 6 47 27 185 0 6 0 10 62 89 184 0 0 69 88 184 0 13 47 27 185 0 13 0 4 62 89 185 0 2 0 1 244 48 49 55 22 51 50 54 53 17 51 17 20 14 2 35 34 39 89 36 57 42 43 84 19 39 61 42 107 52 117 58 47 57 1 99 254 151 35 61 46 27 88 0 0 0 0 1 0 90 0 0 1 254 2 6 0 12 0 101 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 10 62 89 184 0 0 69 88 184 0 4 47 27 185 0 4 0 10 62 89 184 0 0 69 88 184 0 7 47 27 185 0 7 0 4 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 4 62 89 186 0 3 0 7 0 0 17 18 57 186 0 6 0 0 0 7 17 18 57 186 0 9 0 7 0 0 17 18 57 48 49 19 51 21 51 55 51 7 19 35 3 7 21 35 90 83 3 218 92 173 197 89 158 90 83 2 6 246 246 200 254 194 1 4 95 165 0 0 0 1 0 90 0 0 1 154 2 6 0 5 0 43 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 10 62 89 184 0 0 69 88 184 0 4 47 27 185 0 4 0 4 62 89 185 0 2 0 1 244 48 49 19 51 17 51 21 33 90 83 237 254 192 2 6 254 63 69 0 0 0 0 1 0 90 0 0 2 45 2 6 0 29 0 111 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 10 62 89 184 0 0 69 88 184 0 6 47 27 185 0 6 0 10 62 89 184 0 0 69 88 184 0 8 47 27 185 0 8 0 4 62 89 184 0 0 69 88 184 0 28 47 27 185 0 28 0 4 62 89 186 0 3 0 0 0 28 17 18 57 186 0 15 0 8 0 6 17 18 57 186 0 18 0 0 0 8 17 18 57 186 0 22 0 0 0 28 17 18 57 48 49 19 51 19 23 51 55 19 51 17 35 17 52 62 2 55 35 15 1 35 47 1 35 30 3 21 17 35 90 93 102 37 4 38 100 93 75 2 2 3 2 4 45 99 40 99 45 4 1 4 3 2 75 2 6 254 248 103 103 1 8 253 250 1 0 18 42 43 43 18 117 253 253 117 18 42 44 42 18 255 0 0 0 0 0 1 0 90 0 0 1 239 2 6 0 19 0 91 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 10 62 89 184 0 0 69 88 184 0 8 47 27 185 0 8 0 10 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 4 62 89 184 0 0 69 88 184 0 18 47 27 185 0 18 0 4 62 89 186 0 4 0 10 0 8 17 18 57 186 0 14 0 0 0 18 17 18 57 48 49 19 51 19 23 51 46 1 61 1 51 17 35 3 39 35 30 1 29 1 35 90 84 191 60 4 3 8 77 83 192 60 4 3 8 77 2 6 254 206 111 39 93 42 243 253 250 1 50 111 41 89 42 245 0 0 0 2 0 52 255 244 2 26 2 18 0 19 0 31 0 53 0 184 0 0 69 88 184 0 10 47 27 185 0 10 0 10 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 4 62 89 185 0 20 0 1 244 184 0 10 16 185 0 26 0 1 244 48 49 5 34 46 2 53 52 62 2 51 50 30 2 21 20 14 2 39 50 54 53 52 38 35 34 6 21 20 22 1 39 54 89 64 36 36 64 89 54 53 89 65 36 36 65 89 53 72 85 85 72 72 85 85 12 38 70 102 63 63 100 69 37 37 69 100 63 63 102 70 38 70 109 94 94 105 105 94 94 109 0 2 0 90 0 0 1 220 2 6 0 14 0 23 0 57 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 10 62 89 184 0 0 69 88 184 0 13 47 27 185 0 13 0 4 62 89 187 0 15 0 1 0 11 0 4 43 184 0 0 16 185 0 21 0 1 244 48 49 19 51 50 30 2 21 20 14 2 43 1 21 35 19 50 54 53 52 38 43 1 21 90 177 46 77 55 31 31 56 76 46 94 83 171 69 65 67 69 86 2 6 16 37 60 44 42 63 40 20 196 1 0 50 51 53 42 196 0 0 2 0 51 255 104 2 35 2 18 0 11 0 44 0 75 0 184 0 0 69 88 184 0 28 47 27 185 0 28 0 10 62 89 184 0 0 69 88 184 0 18 47 27 185 0 18 0 4 62 89 187 0 41 0 1 0 15 0 4 43 184 0 18 16 185 0 3 0 1 244 184 0 28 16 185 0 9 0 1 244 184 0 18 16 184 0 38 208 48 49 19 20 22 51 50 54 53 52 38 35 34 6 1 14 1 35 34 38 39 46 3 53 52 62 2 51 50 30 2 21 20 14 2 7 30 1 51 50 54 55 137 85 72 72 85 85 72 72 85 1 154 14 44 26 81 106 25 45 74 52 29 36 64 89 54 53 89 65 36 29 53 73 45 19 69 47 18 29 12 1 5 96 111 110 97 94 105 105 254 19 7 7 80 63 7 44 69 93 57 63 100 69 37 37 69 100 63 57 93 69 44 7 42 34 5 4 0 0 2 0 90 0 0 1 231 2 6 0 7 0 23 0 84 0 184 0 0 69 88 184 0 13 47 27 185 0 13 0 10 62 89 184 0 0 69 88 184 0 12 47 27 185 0 12 0 4 62 89 184 0 0 69 88 184 0 8 47 27 185 0 8 0 4 62 89 187 0 1 0 1 0 9 0 4 43 184 0 13 16 185 0 6 0 1 244 186 0 22 0 1 0 9 17 18 57 48 49 19 51 50 53 52 38 43 1 19 39 35 21 35 17 51 50 30 2 21 20 6 7 23 173 87 129 67 63 86 225 129 96 83 179 43 73 53 30 65 54 138 1 12 94 50 40 254 60 208 208 2 6 15 36 58 42 59 75 15 218 0 1 0 42 255 244 1 180 2 18 0 49 0 73 0 184 0 0 69 88 184 0 22 47 27 185 0 22 0 10 62 89 184 0 0 69 88 184 0 46 47 27 185 0 46 0 4 62 89 185 0 3 0 1 244 184 0 22 16 185 0 29 0 1 244 186 0 6 0 46 0 29 17 18 57 186 0 32 0 22 0 3 17 18 57 48 49 55 30 1 51 50 54 53 52 46 2 47 1 46 3 53 52 62 2 51 50 22 23 7 46 1 35 34 6 21 20 22 31 1 30 3 21 20 14 2 35 34 38 39 86 33 81 46 51 55 13 23 31 18 65 27 47 35 21 27 48 66 39 57 86 29 43 26 66 38 45 51 45 40 66 28 48 35 19 27 50 71 45 63 101 37 120 30 36 44 35 19 26 19 15 8 26 10 26 33 44 28 32 53 37 21 38 25 54 23 28 38 35 31 34 16 26 11 23 33 45 33 32 56 40 23 42 33 0 0 0 1 0 28 0 0 1 183 2 6 0 7 0 55 0 184 0 0 69 88 184 0 2 47 27 185 0 2 0 10 62 89 184 0 0 69 88 184 0 6 47 27 185 0 6 0 4 62 89 184 0 2 16 185 0 0 0 1 244 184 0 4 208 184 0 5 208 48 49 19 35 53 33 21 35 17 35 192 164 1 155 164 83 1 194 68 68 254 62 0 0 0 0 1 0 87 255 244 1 240 2 6 0 25 0 60 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 10 62 89 184 0 0 69 88 184 0 13 47 27 185 0 13 0 10 62 89 184 0 0 69 88 184 0 20 47 27 185 0 20 0 4 62 89 185 0 7 0 1 244 48 49 19 51 17 20 30 2 51 50 62 2 53 17 51 17 20 14 2 35 34 46 2 53 87 83 18 33 45 27 27 45 33 19 79 30 54 75 45 44 75 55 31 2 6 254 209 45 60 36 16 16 36 60 45 1 47 254 210 64 87 54 23 23 54 87 64 0 0 1 0 0 0 0 1 191 2 6 0 13 0 64 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 10 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 10 62 89 184 0 0 69 88 184 0 12 47 27 185 0 12 0 4 62 89 186 0 5 0 0 0 12 17 18 57 48 49 17 51 19 30 1 23 51 62 1 55 19 51 3 35 87 85 14 24 14 4 15 23 14 83 84 175 96 2 6 254 244 45 80 45 45 80 45 1 12 253 250 0 0 1 0 23 0 0 2 148 2 6 0 33 0 118 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 10 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 10 62 89 184 0 0 69 88 184 0 20 47 27 185 0 20 0 10 62 89 184 0 0 69 88 184 0 22 47 27 185 0 22 0 4 62 89 184 0 0 69 88 184 0 32 47 27 185 0 32 0 4 62 89 186 0 6 0 22 0 0 17 18 57 186 0 15 0 22 0 20 17 18 57 186 0 28 0 10 0 22 17 18 57 48 49 19 51 19 30 1 23 51 62 1 55 19 51 19 30 1 23 51 62 1 55 19 51 3 35 3 46 1 39 35 14 1 7 3 35 23 82 55 8 16 8 3 9 21 10 74 72 72 10 20 11 4 8 14 8 55 77 113 97 80 8 12 6 4 7 12 8 78 96 2 6 254 242 42 83 42 42 83 42 1 14 254 242 42 83 42 42 83 42 1 14 253 250 1 34 31 59 29 29 59 31 254 222 0 0 0 1 0 15 0 0 1 182 2 6 0 25 0 111 0 184 0 0 69 88 184 0 1 47 27 185 0 1 0 10 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 10 62 89 184 0 0 69 88 184 0 14 47 27 185 0 14 0 4 62 89 184 0 0 69 88 184 0 24 47 27 185 0 24 0 4 62 89 186 0 0 0 1 0 24 17 18 57 186 0 7 0 14 0 1 17 18 57 186 0 13 0 14 0 11 17 18 57 186 0 20 0 14 0 1 17 18 57 48 49 19 39 51 23 30 1 23 51 62 1 63 1 51 7 19 35 39 46 1 39 35 14 1 15 1 35 176 150 91 70 10 19 13 4 11 19 9 67 88 150 161 92 76 11 22 13 4 11 21 11 74 88 1 11 251 122 17 37 23 23 37 17 122 255 254 249 128 20 41 24 24 41 20 128 0 0 1 255 255 0 0 1 160 2 6 0 15 0 64 0 184 0 0 69 88 184 0 1 47 27 185 0 1 0 10 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 10 62 89 184 0 0 69 88 184 0 14 47 27 185 0 14 0 4 62 89 186 0 7 0 14 0 1 17 18 57 48 49 55 3 51 23 30 1 23 51 62 1 63 1 51 3 21 35 166 167 88 66 13 27 14 4 14 25 14 66 86 167 83 196 1 66 137 29 55 29 29 55 29 137 254 190 196 0 0 1 0 45 0 0 1 177 2 6 0 9 0 61 0 184 0 0 69 88 184 0 3 47 27 185 0 3 0 10 62 89 184 0 0 69 88 184 0 8 47 27 185 0 8 0 4 62 89 185 0 6 0 1 244 184 0 0 208 184 0 3 16 185 0 1 0 1 244 184 0 5 208 48 49 55 1 33 53 33 21 1 33 21 33 45 1 27 254 254 1 103 254 229 1 31 254 124 49 1 145 68 49 254 112 69 0 0 255 255 0 3 0 0 1 212 2 191 2 38 3 91 0 0 0 7 2 247 0 234 255 141 255 255 0 3 0 0 1 212 2 191 2 38 3 91 0 0 0 7 2 249 0 234 255 141 255 255 0 3 0 0 1 212 2 191 2 38 3 91 0 0 0 7 2 251 0 234 255 141 255 255 0 3 0 0 1 212 2 192 2 38 3 91 0 0 0 7 2 253 0 234 255 141 255 255 0 3 0 0 1 212 2 186 2 38 3 91 0 0 0 7 3 5 0 234 255 141 255 255 0 3 0 0 1 212 2 159 2 38 3 91 0 0 0 7 2 255 0 234 255 141 255 255 0 3 0 0 1 212 2 191 2 38 3 91 0 0 0 7 3 1 0 234 255 141 255 255 0 3 0 0 1 212 2 248 2 38 3 91 0 0 0 7 3 9 0 234 255 141 255 255 0 3 0 0 1 212 2 191 2 38 3 91 0 0 0 7 3 13 0 234 255 141 255 255 0 3 255 50 1 212 2 6 2 38 3 91 0 0 0 7 3 19 0 234 0 0 255 255 0 3 0 0 1 212 2 245 2 38 3 91 0 0 0 7 3 7 0 234 255 141 255 255 0 3 0 0 1 212 2 254 2 38 3 91 0 0 0 7 3 37 0 234 255 141 255 255 0 3 0 0 1 212 2 254 2 38 3 91 0 0 0 7 3 39 0 234 255 141 255 255 0 3 0 0 1 212 3 23 2 38 3 91 0 0 0 7 3 41 0 234 255 141 255 255 0 3 0 0 1 212 3 56 2 38 3 91 0 0 0 7 3 43 0 234 255 141 255 255 0 3 255 50 1 212 2 191 2 38 3 91 0 0 0 39 2 251 0 234 255 141 0 7 3 19 0 234 0 0 255 255 0 3 0 0 1 212 3 24 2 38 3 91 0 0 0 7 3 45 0 234 255 141 255 255 0 3 0 0 1 212 3 24 2 38 3 91 0 0 0 7 3 47 0 234 255 141 255 255 0 3 0 0 1 212 3 69 2 38 3 91 0 0 0 7 3 49 0 234 255 141 255 255 0 3 0 0 1 212 3 56 2 38 3 91 0 0 0 7 3 51 0 234 255 141 255 255 0 3 255 50 1 212 2 191 2 38 3 91 0 0 0 39 3 1 0 234 255 141 0 7 3 19 0 234 0 0 0 2 0 3 255 44 1 242 2 6 0 9 0 37 0 126 0 184 0 0 69 88 184 0 27 47 27 185 0 27 0 10 62 89 184 0 0 69 88 184 0 21 47 27 185 0 21 0 4 62 89 184 0 0 69 88 184 0 25 47 27 185 0 25 0 4 62 89 184 0 0 69 88 184 0 29 47 27 185 0 29 0 4 62 89 184 0 0 69 88 184 0 13 47 27 185 0 13 0 6 62 89 186 0 5 0 27 0 25 17 18 57 186 0 23 0 27 0 25 17 18 57 184 0 23 47 185 0 9 0 1 244 184 0 13 16 184 0 35 220 48 49 37 39 46 1 39 35 14 1 15 1 1 14 1 35 34 38 53 52 62 2 55 35 39 35 7 35 19 51 19 14 1 21 20 22 51 50 55 1 56 24 14 24 14 4 14 24 14 24 1 86 14 45 20 40 56 14 22 26 13 18 48 197 48 84 185 94 186 35 45 28 18 23 19 208 74 43 83 43 44 82 43 74 254 120 11 17 44 43 20 38 32 26 9 146 146 2 6 253 250 14 62 31 23 23 14 0 0 2 0 8 0 0 2 151 2 6 0 6 0 22 0 104 0 184 0 0 69 88 184 0 14 47 27 185 0 14 0 10 62 89 184 0 0 69 88 184 0 8 47 27 185 0 8 0 4 62 89 184 0 0 69 88 184 0 12 47 27 185 0 12 0 4 62 89 187 0 0 0 1 0 10 0 4 43 187 0 19 0 1 0 20 0 4 43 186 0 1 0 14 0 12 17 18 57 184 0 8 16 185 0 7 0 1 244 184 0 14 16 185 0 16 0 1 244 48 49 37 53 35 14 1 15 1 5 21 33 53 35 7 35 1 33 21 35 21 51 21 35 21 1 86 3 22 43 22 48 1 203 254 191 172 76 86 1 30 1 103 227 190 190 203 252 41 83 39 89 137 66 141 141 2 6 66 150 63 173 0 3 0 33 0 0 1 249 2 6 0 12 0 21 0 45 0 97 0 184 0 0 69 88 184 0 36 47 27 185 0 36 0 10 62 89 184 0 0 69 88 184 0 30 47 27 185 0 30 0 4 62 89 187 0 9 0 1 0 10 0 4 43 187 0 14 0 1 0 6 0 4 43 184 0 30 16 185 0 0 0 1 244 184 0 36 16 185 0 20 0 1 244 184 0 10 16 184 0 32 208 184 0 9 16 184 0 34 208 184 0 34 47 48 49 37 50 54 53 52 38 43 1 21 51 21 35 21 53 51 50 54 53 52 38 43 1 23 30 1 21 20 14 2 43 1 53 35 53 55 17 51 50 30 2 21 20 6 7 1 27 65 77 73 69 90 126 126 78 68 59 62 62 81 191 56 65 31 57 78 46 184 76 76 170 43 72 52 29 45 46 55 45 53 47 45 73 40 77 242 45 42 42 37 188 11 59 54 39 56 38 18 132 36 4 1 90 14 30 49 35 38 61 12 255 255 0 90 255 85 1 229 2 6 2 38 3 92 0 0 0 7 3 27 1 31 0 0 255 255 0 52 255 43 1 215 2 18 2 38 3 93 0 0 0 7 3 23 1 38 0 0 255 255 0 52 255 244 1 215 2 191 2 38 3 93 0 0 0 7 2 249 1 38 255 141 255 255 0 52 255 244 1 215 2 191 2 38 3 93 0 0 0 7 2 251 1 38 255 141 255 255 0 52 255 244 1 215 2 191 2 38 3 93 0 0 0 7 3 13 1 38 255 141 255 255 0 52 255 244 1 215 2 194 2 38 3 93 0 0 0 7 3 3 1 38 255 141 255 255 0 90 0 0 1 247 2 191 0 38 3 94 0 0 0 7 3 13 1 27 255 141 255 255 0 90 255 50 1 247 2 6 0 38 3 94 0 0 0 7 3 19 1 24 0 0 255 255 0 90 255 85 1 247 2 6 0 38 3 94 0 0 0 7 3 27 1 24 0 0 255 255 0 33 0 0 2 11 2 6 2 6 4 40 0 0 255 255 0 90 0 0 1 170 2 191 2 38 3 95 0 0 0 7 2 247 1 8 255 141 255 255 0 90 0 0 1 170 2 191 2 38 3 95 0 0 0 7 2 249 1 8 255 141 255 255 0 90 0 0 1 170 2 191 2 38 3 95 0 0 0 7 2 251 1 8 255 141 255 255 0 90 0 0 1 170 2 191 2 38 3 95 0 0 0 7 3 13 1 8 255 141 255 255 0 90 0 0 1 170 2 186 2 38 3 95 0 0 0 7 3 5 1 8 255 141 255 255 0 90 0 0 1 170 2 159 2 38 3 95 0 0 0 7 2 255 1 8 255 141 255 255 0 90 0 0 1 170 2 191 2 38 3 95 0 0 0 7 3 1 1 8 255 141 255 255 0 90 0 0 1 170 2 194 2 38 3 95 0 0 0 7 3 3 1 8 255 141 255 255 0 90 255 50 1 170 2 6 2 38 3 95 0 0 0 7 3 19 1 10 0 0 255 255 0 90 0 0 1 170 2 245 2 38 3 95 0 0 0 7 3 7 1 8 255 141 255 255 0 90 0 0 1 170 2 192 2 38 3 95 0 0 0 7 2 253 1 8 255 141 255 255 0 90 0 0 1 242 2 254 2 38 3 95 0 0 0 7 3 37 1 8 255 141 255 255 0 90 0 0 1 192 2 254 2 38 3 95 0 0 0 7 3 39 1 8 255 141 255 255 0 90 0 0 1 215 3 23 2 38 3 95 0 0 0 7 3 41 1 8 255 141 255 255 0 90 0 0 1 170 3 56 2 38 3 95 0 0 0 7 3 43 1 8 255 141 255 255 0 90 255 50 1 170 2 191 2 38 3 95 0 0 0 39 2 251 1 8 255 141 0 7 3 19 1 10 0 0 0 1 0 90 255 44 1 186 2 6 0 33 0 119 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 10 62 89 184 0 0 69 88 184 0 26 47 27 185 0 26 0 6 62 89 184 0 0 69 88 184 0 10 47 27 185 0 10 0 4 62 89 184 0 0 69 88 184 0 32 47 27 185 0 32 0 4 62 89 184 0 0 16 185 0 2 0 1 244 186 0 6 0 0 0 10 17 18 57 184 0 6 47 185 0 5 0 1 244 184 0 32 16 185 0 8 0 1 244 184 0 26 16 184 0 19 220 48 49 19 33 21 35 21 51 21 35 21 51 21 35 14 3 21 20 22 51 50 54 55 23 14 1 35 34 38 53 52 54 55 35 90 1 70 243 206 206 253 3 17 33 26 16 30 18 12 19 9 23 14 46 20 40 55 46 28 251 2 6 66 150 63 173 66 2 19 29 37 20 23 23 7 7 45 11 17 44 43 42 65 18 0 255 255 0 90 0 0 1 170 3 67 2 38 3 95 0 0 0 7 4 89 1 8 255 141 255 255 0 52 255 244 1 227 2 191 2 38 3 97 0 0 0 7 2 251 1 52 255 141 255 255 0 52 255 244 1 227 2 191 2 38 3 97 0 0 0 7 3 1 1 52 255 141 255 255 0 52 255 244 1 227 2 194 2 38 3 97 0 0 0 7 3 3 1 52 255 141 255 255 0 52 255 40 1 227 2 18 2 38 3 97 0 0 0 7 3 21 1 49 0 0 255 255 0 52 255 244 1 227 2 191 2 38 3 97 0 0 0 7 3 13 1 52 255 141 255 255 0 52 255 244 1 227 2 159 2 38 3 97 0 0 0 7 2 255 1 52 255 141 255 255 0 52 255 244 1 227 2 192 2 38 3 97 0 0 0 7 2 253 1 52 255 141 255 255 0 90 0 0 1 248 2 191 2 38 3 98 0 0 0 7 2 251 1 41 255 141 255 255 0 90 255 50 1 248 2 6 2 38 3 98 0 0 0 7 3 19 1 41 0 0 255 255 0 90 255 50 1 248 2 6 2 38 3 98 0 0 0 7 3 26 1 41 0 0 0 2 0 32 0 0 2 86 2 6 0 3 0 23 0 133 0 184 0 0 69 88 184 0 16 47 27 185 0 16 0 10 62 89 184 0 0 69 88 184 0 21 47 27 185 0 21 0 10 62 89 184 0 0 69 88 184 0 6 47 27 185 0 6 0 4 62 89 184 0 0 69 88 184 0 11 47 27 185 0 11 0 4 62 89 186 0 3 0 16 0 11 17 18 57 184 0 3 47 184 0 0 220 184 0 4 208 184 0 3 16 185 0 9 0 1 244 184 0 0 16 184 0 13 208 184 0 0 16 185 0 19 0 1 244 184 0 14 208 184 0 19 16 184 0 23 208 48 49 1 35 21 51 55 35 17 35 53 35 21 35 17 35 53 55 53 51 21 51 53 51 21 51 1 185 248 248 157 74 83 248 83 78 78 83 248 83 74 1 128 80 80 254 128 239 239 1 128 41 5 88 88 88 88 255 255 0 0 0 0 0 182 2 191 2 38 3 99 0 0 0 7 2 247 0 131 255 141 255 255 0 80 0 0 1 6 2 191 2 38 3 99 0 0 0 7 2 249 0 131 255 141 255 255 255 251 0 0 1 11 2 191 2 38 3 99 0 0 0 7 2 251 0 131 255 141 255 255 255 242 0 0 1 20 2 192 2 38 3 99 0 0 0 7 2 253 0 131 255 141 255 255 255 252 0 0 1 10 2 186 2 38 3 99 0 0 0 7 3 5 0 131 255 141 255 255 0 7 0 0 0 255 2 159 2 38 3 99 0 0 0 7 2 255 0 131 255 141 255 255 0 74 0 0 0 188 2 194 2 38 3 99 0 0 0 7 3 3 0 131 255 141 255 255 255 251 0 0 1 11 2 191 2 38 3 99 0 0 0 7 3 13 0 131 255 141 255 255 0 67 0 0 0 214 2 245 2 38 3 99 0 0 0 7 3 7 0 131 255 141 255 255 0 77 255 50 0 185 2 6 2 38 3 99 0 0 0 7 3 19 0 131 0 0 0 1 0 43 255 44 0 219 2 6 0 21 0 75 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 10 62 89 184 0 0 69 88 184 0 2 47 27 185 0 2 0 4 62 89 184 0 0 69 88 184 0 20 47 27 185 0 20 0 4 62 89 184 0 0 69 88 184 0 14 47 27 185 0 14 0 6 62 89 184 0 8 220 48 49 19 51 17 14 1 21 20 22 51 50 55 23 14 1 35 34 38 53 52 54 55 35 90 83 31 34 30 17 22 19 23 15 45 20 40 56 43 24 20 2 6 253 250 24 52 31 23 23 14 45 11 17 44 43 43 60 22 0 0 255 255 0 8 0 0 0 254 2 191 2 38 3 99 0 0 0 7 3 1 0 131 255 141 255 255 0 31 255 244 1 183 2 191 2 38 3 100 0 0 0 7 2 251 1 47 255 141 255 255 0 90 255 40 1 254 2 6 2 38 3 101 0 0 0 7 3 21 1 43 0 0 255 255 0 90 255 85 1 254 2 6 2 38 3 101 0 0 0 7 3 27 1 43 0 0 255 255 0 86 0 0 1 154 2 191 2 38 3 102 0 0 0 7 2 249 0 137 255 141 255 255 0 90 0 0 1 154 2 103 2 38 3 102 0 0 0 7 3 52 1 81 255 111 255 255 0 90 255 40 1 154 2 6 2 38 3 102 0 0 0 7 3 21 1 4 0 0 255 255 0 90 0 0 1 154 2 6 2 38 3 102 0 0 0 7 1 253 0 224 0 237 255 255 0 90 255 50 1 154 2 6 2 38 3 102 0 0 0 7 3 19 1 4 0 0 255 255 0 13 255 50 1 154 2 159 2 38 3 102 0 0 0 39 2 255 0 137 255 141 0 7 3 19 1 4 0 0 255 255 0 90 255 85 1 154 2 6 2 38 3 102 0 0 0 7 3 27 1 4 0 0 0 1 0 13 0 0 1 159 2 6 0 13 0 101 0 184 0 0 69 88 184 0 7 47 27 185 0 7 0 10 62 89 184 0 0 69 88 184 0 1 47 27 185 0 1 0 4 62 89 187 0 10 0 1 0 11 0 4 43 187 0 5 0 1 0 4 0 4 43 184 0 1 16 185 0 0 0 1 244 186 0 3 0 1 0 7 17 18 57 184 0 3 16 185 0 6 0 1 244 184 0 3 16 184 0 12 208 185 0 9 0 1 244 48 49 37 21 33 53 7 53 55 17 51 21 55 21 7 21 1 159 254 192 82 82 84 155 155 69 69 174 46 65 46 1 23 241 84 66 83 143 0 255 255 0 90 255 50 2 45 2 6 2 38 3 103 0 0 0 7 3 19 1 67 0 0 255 255 0 90 0 0 1 239 2 191 2 38 3 104 0 0 0 7 2 249 1 44 255 141 255 255 0 90 0 0 1 239 2 191 2 38 3 104 0 0 0 7 3 13 1 44 255 141 255 255 0 90 0 0 1 239 2 192 2 38 3 104 0 0 0 7 2 253 1 44 255 141 255 255 0 90 255 40 1 239 2 6 2 38 3 104 0 0 0 7 3 21 1 43 0 0 255 255 0 90 0 0 1 239 2 194 2 38 3 104 0 0 0 7 3 3 1 44 255 141 255 255 0 90 255 50 1 239 2 6 2 38 3 104 0 0 0 7 3 19 1 43 0 0 255 255 0 90 255 85 1 239 2 6 2 38 3 104 0 0 0 7 3 27 1 43 0 0 255 255 0 52 255 244 2 26 2 191 2 38 3 105 0 0 0 7 2 247 1 38 255 141 255 255 0 52 255 244 2 26 2 191 2 38 3 105 0 0 0 7 2 249 1 38 255 141 255 255 0 52 255 244 2 26 2 191 2 38 3 105 0 0 0 7 2 251 1 38 255 141 255 255 0 52 255 244 2 26 2 192 2 38 3 105 0 0 0 7 2 253 1 38 255 141 255 255 0 52 255 244 2 26 2 186 2 38 3 105 0 0 0 7 3 5 1 38 255 141 255 255 0 52 255 244 2 26 2 159 2 38 3 105 0 0 0 7 2 255 1 38 255 141 255 255 0 52 255 244 2 26 2 191 2 38 3 105 0 0 0 7 3 11 1 38 255 141 255 255 0 52 255 244 2 26 2 191 2 38 3 105 0 0 0 7 3 13 1 38 255 141 255 255 0 52 255 50 2 26 2 18 2 38 3 105 0 0 0 7 3 19 1 39 0 0 255 255 0 52 255 244 2 26 2 245 2 38 3 105 0 0 0 7 3 7 1 38 255 141 255 255 0 52 255 244 2 26 2 254 2 38 3 105 0 0 0 7 3 37 1 38 255 141 255 255 0 52 255 244 2 26 2 254 2 38 3 105 0 0 0 7 3 39 1 38 255 141 255 255 0 52 255 244 2 26 3 23 2 38 3 105 0 0 0 7 3 41 1 38 255 141 255 255 0 52 255 244 2 26 3 56 2 38 3 105 0 0 0 7 3 43 1 38 255 141 255 255 0 52 255 50 2 26 2 191 2 38 3 105 0 0 0 39 2 251 1 38 255 141 0 7 3 19 1 39 0 0 0 3 0 47 255 233 2 31 2 30 0 7 0 15 0 42 0 133 0 184 0 0 69 88 184 0 37 47 27 185 0 37 0 10 62 89 184 0 0 69 88 184 0 24 47 27 185 0 24 0 4 62 89 186 0 0 0 24 0 37 17 18 57 185 0 2 0 1 244 186 0 7 0 24 0 37 17 18 57 186 0 8 0 37 0 24 17 18 57 184 0 37 16 185 0 10 0 1 244 186 0 15 0 24 0 37 17 18 57 186 0 16 0 37 0 24 17 18 57 186 0 26 0 24 0 37 17 18 57 186 0 29 0 24 0 37 17 18 57 186 0 40 0 37 0 24 17 18 57 48 49 55 22 51 50 54 53 52 47 1 38 35 34 6 21 20 23 1 30 1 21 20 14 2 35 34 39 7 39 55 46 1 53 52 62 2 51 50 22 23 55 23 188 42 65 73 87 25 28 41 66 74 87 26 1 67 26 29 36 65 89 53 93 63 56 36 60 26 29 36 64 89 54 46 78 31 56 37 99 44 110 96 70 50 39 43 107 95 73 50 1 49 34 91 57 63 102 70 38 54 65 29 70 35 93 57 63 100 69 37 27 26 65 29 0 2 0 52 0 0 2 174 2 6 0 16 0 25 0 97 0 184 0 0 69 88 184 0 3 47 27 185 0 3 0 10 62 89 184 0 0 69 88 184 0 14 47 27 185 0 14 0 4 62 89 184 0 3 16 185 0 5 0 1 244 186 0 9 0 3 0 14 17 18 57 184 0 9 47 185 0 8 0 1 244 184 0 14 16 185 0 12 0 1 244 184 0 3 16 185 0 17 0 1 244 184 0 14 16 185 0 23 0 1 244 48 49 19 52 54 51 33 21 35 21 51 21 35 21 51 21 33 34 38 1 34 6 21 20 22 59 1 17 52 143 129 1 96 229 192 192 239 254 154 132 144 1 18 97 91 91 97 38 1 1 129 132 66 150 63 173 66 129 1 68 99 97 91 100 1 131 0 0 0 0 2 0 52 255 244 2 54 2 113 0 11 0 44 0 73 0 184 0 0 69 88 184 0 36 47 27 185 0 36 0 10 62 89 184 0 0 69 88 184 0 26 47 27 185 0 26 0 4 62 89 185 0 0 0 1 244 184 0 36 16 185 0 6 0 1 244 186 0 18 0 26 0 36 17 18 57 184 0 18 16 185 0 38 0 1 244 48 49 37 50 54 53 52 38 35 34 6 21 20 22 1 30 1 21 20 6 7 30 1 21 20 14 2 35 34 46 2 53 52 62 2 51 50 23 62 1 53 52 38 39 1 39 72 85 85 72 72 85 85 1 63 11 13 52 42 32 34 36 65 89 53 54 89 64 36 36 64 89 54 77 59 33 34 8 7 58 109 94 94 105 105 94 94 109 2 55 14 32 19 42 51 11 35 98 62 63 102 70 38 38 70 102 63 63 100 69 37 39 7 29 27 11 21 10 0 0 0 255 255 0 52 255 244 2 54 2 191 2 38 3 228 0 0 0 7 2 249 1 38 255 141 255 255 0 52 255 244 2 54 2 191 2 38 3 228 0 0 0 7 2 247 1 38 255 141 255 255 0 52 255 244 2 54 2 245 2 38 3 228 0 0 0 7 3 7 1 38 255 141 255 255 0 52 255 244 2 54 2 192 2 38 3 228 0 0 0 7 2 253 1 38 255 141 255 255 0 52 255 50 2 54 2 113 2 38 3 228 0 0 0 7 3 19 1 39 0 0 0 2 0 52 255 44 2 26 2 18 0 36 0 48 0 88 0 184 0 0 69 88 184 0 32 47 27 185 0 32 0 10 62 89 184 0 0 69 88 184 0 16 47 27 185 0 16 0 6 62 89 184 0 0 69 88 184 0 22 47 27 185 0 22 0 4 62 89 184 0 3 208 184 0 16 16 185 0 9 0 1 244 184 0 22 16 185 0 37 0 1 244 184 0 32 16 185 0 43 0 1 244 48 49 1 20 6 7 14 1 21 20 22 51 50 54 55 23 14 1 35 34 38 53 52 54 55 46 3 53 52 62 2 51 50 30 2 3 50 54 53 52 38 35 34 6 21 20 22 2 26 87 80 41 37 30 18 12 19 9 23 14 46 20 40 55 35 26 55 88 62 33 36 64 89 54 53 89 65 36 243 72 85 85 72 72 85 85 1 5 105 129 34 18 56 26 23 23 7 7 45 11 17 44 43 33 59 22 1 39 71 99 62 63 100 69 37 37 69 100 254 246 109 94 94 105 105 94 94 109 0 0 255 255 0 52 255 244 2 26 2 191 2 38 3 105 0 0 0 7 3 1 1 38 255 141 255 255 0 52 255 244 2 26 3 67 2 38 3 105 0 0 0 7 4 89 1 38 255 141 255 255 0 90 0 0 1 231 2 191 2 38 3 108 0 0 0 7 2 249 1 26 255 141 255 255 0 90 0 0 1 231 2 191 2 38 3 108 0 0 0 7 3 13 1 26 255 141 255 255 0 90 255 40 1 231 2 6 2 38 3 108 0 0 0 7 3 21 1 29 0 0 255 255 0 90 255 50 1 231 2 6 2 38 3 108 0 0 0 7 3 19 1 29 0 0 255 255 0 90 255 50 1 231 2 159 2 38 3 108 0 0 0 39 2 255 1 26 255 141 0 7 3 19 1 29 0 0 255 255 0 90 255 85 1 231 2 6 2 38 3 108 0 0 0 7 3 27 1 29 0 0 255 255 0 42 255 244 1 180 2 191 2 38 3 109 0 0 0 7 2 249 0 254 255 141 255 255 0 42 255 244 1 180 2 191 2 38 3 109 0 0 0 7 2 251 0 254 255 141 255 255 0 42 255 244 1 180 2 191 2 38 3 109 0 0 0 7 3 13 0 254 255 141 255 255 0 42 255 43 1 180 2 18 2 38 3 109 0 0 0 7 3 23 0 244 0 0 255 255 0 42 255 40 1 180 2 18 2 38 3 109 0 0 0 7 3 21 1 3 0 0 255 255 0 42 255 244 1 180 2 194 2 38 3 109 0 0 0 7 3 3 0 254 255 141 255 255 0 42 255 50 1 180 2 18 2 38 3 109 0 0 0 7 3 19 1 3 0 0 255 255 0 42 255 244 3 142 2 18 0 38 3 109 0 0 0 7 3 109 1 218 0 0 0 1 0 91 255 244 2 39 2 18 0 42 0 80 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 10 62 89 184 0 0 69 88 184 0 41 47 27 185 0 41 0 4 62 89 184 0 0 69 88 184 0 17 47 27 185 0 17 0 4 62 89 186 0 9 0 17 0 5 17 18 57 185 0 24 0 1 244 184 0 5 16 185 0 37 0 1 244 48 49 19 52 62 2 51 50 22 23 7 30 1 21 20 14 2 35 34 38 39 55 30 1 51 50 54 53 52 46 2 47 1 55 46 1 35 34 6 21 17 35 91 30 57 82 53 73 94 22 113 84 78 23 42 60 38 50 78 26 43 24 51 29 41 44 14 35 60 45 6 113 14 54 42 63 71 84 1 71 46 75 53 29 74 59 113 17 73 58 30 54 41 23 35 26 50 23 21 46 36 18 32 27 20 6 46 114 26 37 75 75 254 199 0 0 255 255 0 28 0 0 1 183 2 191 2 38 3 110 0 0 0 7 3 13 0 233 255 141 255 255 0 28 255 43 1 183 2 6 2 38 3 110 0 0 0 7 3 23 0 228 0 0 255 255 0 28 255 40 1 183 2 6 2 38 3 110 0 0 0 7 3 21 0 233 0 0 255 255 0 28 255 50 1 183 2 6 2 38 3 110 0 0 0 7 3 19 0 233 0 0 255 255 0 28 255 85 1 183 2 6 2 38 3 110 0 0 0 7 3 27 0 233 0 0 255 255 0 87 255 244 1 240 2 191 2 38 3 111 0 0 0 7 2 247 1 35 255 141 255 255 0 87 255 244 1 240 2 191 2 38 3 111 0 0 0 7 2 249 1 35 255 141 255 255 0 87 255 244 1 240 2 191 2 38 3 111 0 0 0 7 2 251 1 35 255 141 255 255 0 87 255 244 1 240 2 192 2 38 3 111 0 0 0 7 2 253 1 35 255 141 255 255 0 87 255 244 1 240 2 186 2 38 3 111 0 0 0 7 3 5 1 35 255 141 255 255 0 87 255 244 1 240 2 159 2 38 3 111 0 0 0 7 2 255 1 35 255 141 255 255 0 87 255 244 1 240 2 191 2 38 3 111 0 0 0 7 3 1 1 35 255 141 255 255 0 87 255 244 1 240 2 248 2 38 3 111 0 0 0 7 3 9 1 35 255 141 255 255 0 87 255 244 1 240 2 191 2 38 3 111 0 0 0 7 3 11 1 35 255 141 255 255 0 87 255 244 1 240 2 191 2 38 3 111 0 0 0 7 3 13 1 35 255 141 255 255 0 87 255 244 1 240 3 24 2 38 3 111 0 0 0 7 3 29 1 35 255 141 255 255 0 87 255 244 1 240 3 67 2 38 3 111 0 0 0 7 3 31 1 35 255 141 255 255 0 87 255 244 1 240 3 67 2 38 3 111 0 0 0 7 3 33 1 35 255 141 255 255 0 87 255 244 1 240 3 67 2 38 3 111 0 0 0 7 3 35 1 35 255 141 255 255 0 87 255 50 1 240 2 6 2 38 3 111 0 0 0 7 3 19 1 35 0 0 255 255 0 87 255 244 1 240 2 245 2 38 3 111 0 0 0 7 3 7 1 35 255 141 0 1 0 87 255 44 1 240 2 6 0 45 0 93 0 184 0 0 69 88 184 0 31 47 27 185 0 31 0 10 62 89 184 0 0 69 88 184 0 44 47 27 185 0 44 0 10 62 89 184 0 0 69 88 184 0 17 47 27 185 0 17 0 6 62 89 184 0 0 69 88 184 0 25 47 27 185 0 25 0 4 62 89 184 0 5 208 184 0 17 16 184 0 11 220 184 0 25 16 185 0 38 0 1 244 48 49 37 20 14 2 7 14 1 21 20 22 51 50 55 23 14 1 35 34 38 53 52 62 2 55 46 3 53 17 51 17 20 30 2 51 50 62 2 53 17 51 1 240 19 33 47 28 39 40 30 17 22 19 22 14 45 20 40 56 13 19 23 9 45 74 54 29 83 18 33 45 27 27 45 33 19 79 216 53 73 50 34 13 19 56 25 23 23 14 45 11 17 44 43 21 33 28 23 9 1 25 53 86 62 1 46 254 209 45 60 36 16 16 36 60 45 1 47 0 1 0 87 255 244 2 94 2 143 0 39 0 72 0 184 0 0 69 88 184 0 20 47 27 185 0 20 0 10 62 89 184 0 0 69 88 184 0 33 47 27 185 0 33 0 10 62 89 184 0 0 69 88 184 0 14 47 27 185 0 14 0 4 62 89 184 0 33 16 184 0 8 220 184 0 14 16 185 0 27 0 1 244 48 49 1 30 1 21 20 14 2 7 17 20 14 2 35 34 46 2 53 17 51 17 20 30 2 51 50 62 2 53 17 51 62 1 53 52 39 2 71 10 13 18 30 40 22 30 54 75 45 44 75 55 31 83 18 33 45 27 27 45 33 19 31 42 48 14 2 143 14 32 19 25 37 25 17 4 254 246 64 87 54 23 23 54 87 64 1 46 254 209 45 60 36 16 16 36 60 45 1 47 4 28 34 22 20 0 0 0 255 255 0 87 255 244 2 94 2 191 2 38 4 18 0 0 0 7 2 249 1 35 255 141 255 255 0 87 255 244 2 94 2 191 2 38 4 18 0 0 0 7 2 247 1 35 255 141 255 255 0 87 255 244 2 94 2 245 2 38 4 18 0 0 0 7 3 7 1 35 255 141 255 255 0 87 255 244 2 94 2 192 2 38 4 18 0 0 0 7 2 253 1 35 255 141 255 255 0 87 255 50 2 94 2 143 2 38 4 18 0 0 0 7 3 19 1 35 0 0 255 255 0 23 0 0 2 148 2 191 2 38 3 113 0 0 0 7 2 247 1 86 255 141 255 255 0 23 0 0 2 148 2 191 2 38 3 113 0 0 0 7 2 249 1 86 255 141 255 255 0 23 0 0 2 148 2 191 2 38 3 113 0 0 0 7 2 251 1 86 255 141 255 255 0 23 0 0 2 148 2 186 2 38 3 113 0 0 0 7 3 5 1 86 255 141 255 255 255 255 0 0 1 160 2 191 2 38 3 115 0 0 0 7 2 247 0 208 255 141 255 255 255 255 0 0 1 160 2 191 2 38 3 115 0 0 0 7 2 249 0 208 255 141 255 255 255 255 0 0 1 160 2 191 2 38 3 115 0 0 0 7 2 251 0 208 255 141 255 255 255 255 0 0 1 160 2 186 2 38 3 115 0 0 0 7 3 5 0 208 255 141 255 255 255 255 0 0 1 160 2 194 2 38 3 115 0 0 0 7 3 3 0 208 255 141 255 255 255 255 255 50 1 160 2 6 2 38 3 115 0 0 0 7 3 19 0 207 0 0 255 255 255 255 0 0 1 160 2 245 2 38 3 115 0 0 0 7 3 7 0 208 255 141 255 255 255 255 0 0 1 160 2 192 2 38 3 115 0 0 0 7 2 253 0 208 255 141 255 255 0 45 0 0 1 177 2 191 2 38 3 116 0 0 0 7 2 249 0 250 255 141 255 255 0 45 0 0 1 177 2 191 2 38 3 116 0 0 0 7 3 13 0 250 255 141 255 255 0 45 0 0 1 177 2 194 2 38 3 116 0 0 0 7 3 3 0 250 255 141 255 255 0 45 255 50 1 177 2 6 2 38 3 116 0 0 0 7 3 19 0 253 0 0 0 2 0 33 0 0 2 11 2 6 0 12 0 25 0 89 0 184 0 0 69 88 184 0 13 47 27 185 0 13 0 10 62 89 184 0 0 69 88 184 0 19 47 27 185 0 19 0 4 62 89 185 0 0 0 1 244 184 0 13 16 185 0 6 0 1 244 186 0 10 0 13 0 19 17 18 57 184 0 10 47 185 0 9 0 1 244 184 0 10 16 184 0 22 208 184 0 9 16 184 0 23 208 48 49 55 50 54 53 52 38 43 1 21 51 21 35 21 19 50 22 21 20 6 43 1 53 35 53 55 53 255 93 88 88 93 62 126 126 60 129 141 140 126 148 76 76 65 99 97 91 100 157 47 183 1 197 129 128 129 132 248 43 4 223 0 0 0 0 2 0 90 0 0 1 220 2 6 0 16 0 25 0 57 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 10 62 89 184 0 0 69 88 184 0 15 47 27 185 0 15 0 4 62 89 187 0 17 0 1 0 13 0 4 43 187 0 23 0 1 0 3 0 4 43 48 49 19 51 21 51 50 30 2 21 20 14 2 43 1 21 35 55 50 54 53 52 38 43 1 21 90 83 94 46 76 56 31 31 56 77 45 94 83 168 69 66 67 68 85 2 6 86 16 36 60 44 42 62 41 19 112 175 48 53 53 40 194 0 0 0 2 0 58 255 244 2 18 2 18 0 6 0 35 0 73 0 184 0 0 69 88 184 0 10 47 27 185 0 10 0 10 62 89 184 0 0 69 88 184 0 20 47 27 185 0 20 0 4 62 89 185 0 3 0 1 244 186 0 6 0 10 0 20 17 18 57 184 0 6 47 185 0 28 0 1 244 184 0 10 16 185 0 32 0 1 244 48 49 55 30 1 51 50 54 55 37 62 1 51 50 30 2 21 20 14 2 35 34 46 2 53 52 54 55 33 46 1 35 34 6 7 141 5 81 63 63 84 8 254 182 30 91 58 53 87 62 34 36 63 89 52 53 85 61 33 1 1 1 130 5 81 75 39 66 25 222 78 88 86 80 243 27 38 37 70 100 63 63 100 71 38 38 71 99 60 6 11 8 86 95 31 21 0 0 3 0 32 255 244 2 7 2 18 0 11 0 23 0 68 0 150 0 184 0 0 69 88 184 0 47 47 27 185 0 47 0 10 62 89 184 0 0 69 88 184 0 29 47 27 185 0 29 0 4 62 89 184 0 0 69 88 184 0 24 47 27 185 0 24 0 4 62 89 184 0 29 16 185 0 3 0 1 244 186 0 26 0 47 0 29 17 18 57 184 0 26 16 184 0 58 220 186 0 6 0 58 0 26 17 18 57 186 0 9 0 29 0 47 17 18 57 184 0 9 16 184 0 15 220 184 0 47 16 185 0 21 0 1 244 186 0 39 0 15 0 9 17 18 57 186 0 55 0 9 0 15 17 18 57 186 0 65 0 26 0 58 17 18 57 48 49 55 20 22 51 50 54 55 46 1 39 14 1 55 20 22 23 62 1 53 52 38 35 34 6 1 38 39 14 1 35 34 46 2 53 52 62 2 55 46 1 53 52 62 2 51 50 22 21 20 14 2 7 30 1 23 62 1 55 51 14 1 7 30 1 23 108 60 45 26 51 23 40 72 29 28 36 62 14 12 38 53 23 27 30 37 1 72 62 69 32 80 51 39 64 45 24 18 30 40 21 17 20 19 35 49 30 54 59 22 35 45 23 28 72 38 25 38 12 75 17 47 33 28 52 23 140 41 48 20 17 32 74 40 20 46 233 20 43 23 22 48 33 22 33 41 254 68 15 45 27 33 23 40 53 31 26 43 35 30 13 31 60 28 26 47 35 21 63 48 25 41 36 32 15 37 69 29 31 74 42 51 91 41 17 22 6 0 0 0 2 0 55 255 244 1 194 2 18 0 15 0 27 0 53 0 184 0 0 69 88 184 0 8 47 27 185 0 8 0 10 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 4 62 89 185 0 16 0 1 244 184 0 8 16 185 0 22 0 1 244 48 49 23 34 46 2 53 52 54 51 50 22 21 20 14 2 39 50 54 53 52 38 35 34 6 21 20 22 252 45 73 51 28 106 91 91 107 28 51 74 45 51 64 64 51 50 65 64 12 38 70 102 63 127 142 142 127 63 102 70 38 66 101 106 107 96 97 106 106 101 0 0 0 0 1 0 50 0 0 0 238 2 6 0 8 0 53 0 184 0 0 69 88 184 0 5 47 27 185 0 5 0 10 62 89 184 0 0 69 88 184 0 7 47 27 185 0 7 0 4 62 89 184 0 5 16 185 0 2 0 1 244 185 0 0 0 1 244 48 49 19 35 53 62 1 55 51 17 35 156 106 41 58 26 63 82 1 169 53 7 19 14 253 250 0 0 1 0 34 0 0 1 152 2 18 0 31 0 57 0 184 0 0 69 88 184 0 15 47 27 185 0 15 0 10 62 89 184 0 0 69 88 184 0 30 47 27 185 0 30 0 4 62 89 185 0 28 0 1 244 184 0 0 208 184 0 15 16 185 0 8 0 1 244 48 49 55 62 3 53 52 38 35 34 6 7 39 62 1 51 50 30 2 21 20 14 2 7 62 1 59 1 21 33 40 63 99 68 35 51 52 37 61 24 46 37 86 53 40 65 45 24 35 60 82 48 22 53 27 147 254 144 48 55 91 78 67 30 44 51 35 24 45 38 42 22 41 57 34 37 73 76 81 44 2 3 70 0 1 0 23 255 244 1 151 2 18 0 47 0 77 0 184 0 0 69 88 184 0 27 47 27 185 0 27 0 10 62 89 184 0 0 69 88 184 0 44 47 27 185 0 44 0 4 62 89 187 0 12 0 1 0 11 0 4 43 184 0 44 16 185 0 3 0 1 244 184 0 27 16 185 0 20 0 1 244 186 0 36 0 11 0 12 17 18 57 48 49 55 30 1 51 50 54 53 52 46 2 35 53 50 62 2 53 52 38 35 34 6 7 39 62 1 51 50 30 2 21 20 6 7 21 30 1 21 20 14 2 35 34 38 39 63 26 71 53 48 63 18 42 69 51 45 61 37 17 50 45 35 62 26 42 34 82 51 38 65 47 26 57 46 52 71 30 53 71 40 66 95 29 114 24 36 48 40 22 35 25 14 60 14 24 33 19 36 42 28 25 51 29 37 18 35 51 32 45 60 17 3 11 66 54 35 56 39 20 44 30 0 0 2 0 36 0 0 1 191 2 6 0 9 0 20 0 87 0 184 0 0 69 88 184 0 17 47 27 185 0 17 0 10 62 89 184 0 0 69 88 184 0 12 47 27 185 0 12 0 4 62 89 186 0 10 0 17 0 12 17 18 57 184 0 10 47 185 0 20 0 1 244 184 0 0 208 186 0 4 0 17 0 12 17 18 57 184 0 10 16 184 0 14 208 184 0 0 16 184 0 16 208 48 49 37 53 52 54 55 35 14 1 15 1 5 35 21 35 53 33 53 19 51 17 51 1 37 2 1 3 13 20 14 126 1 71 77 77 254 255 241 93 77 201 133 22 59 22 20 30 21 165 63 138 138 54 1 70 254 195 0 0 1 0 31 255 244 1 158 2 6 0 36 0 67 0 184 0 0 69 88 184 0 16 47 27 185 0 16 0 10 62 89 184 0 0 69 88 184 0 33 47 27 185 0 33 0 4 62 89 187 0 23 0 1 0 11 0 4 43 184 0 33 16 185 0 3 0 1 244 184 0 16 16 185 0 18 0 1 244 48 49 55 30 1 51 50 62 2 53 52 38 35 34 6 7 39 55 33 21 35 7 62 1 51 50 30 2 21 20 14 2 35 34 38 39 69 26 67 51 25 44 32 18 64 51 31 43 25 42 18 1 36 223 12 19 41 25 36 65 49 28 33 54 71 38 68 89 30 113 23 36 15 29 40 26 50 57 17 16 25 255 68 143 9 13 20 40 61 42 43 66 45 24 44 28 0 0 2 0 62 255 244 1 186 2 18 0 11 0 44 0 77 0 184 0 0 69 88 184 0 41 47 27 185 0 41 0 10 62 89 184 0 0 69 88 184 0 31 47 27 185 0 31 0 4 62 89 187 0 23 0 1 0 6 0 4 43 184 0 31 16 185 0 0 0 1 244 184 0 41 16 185 0 15 0 1 244 186 0 20 0 31 0 41 17 18 57 48 49 37 50 54 53 52 38 35 34 6 7 30 1 19 46 1 35 34 14 2 7 62 1 51 50 22 21 20 14 2 35 34 46 2 53 52 62 2 51 50 22 23 1 11 41 57 53 53 26 63 29 8 64 173 18 51 29 30 52 41 25 1 27 74 38 75 89 28 48 64 36 44 74 55 31 37 62 81 45 48 70 26 51 57 47 47 57 29 35 74 70 1 116 18 22 21 49 80 58 29 35 81 81 38 63 44 24 31 62 95 65 77 110 70 32 33 24 0 0 0 0 1 0 33 0 0 1 140 2 6 0 15 0 51 0 184 0 0 69 88 184 0 7 47 27 185 0 7 0 10 62 89 184 0 0 69 88 184 0 0 47 27 185 0 0 0 4 62 89 184 0 7 16 185 0 5 0 1 244 184 0 9 208 48 49 51 62 3 55 33 53 33 21 14 3 7 35 142 4 20 37 58 42 254 242 1 107 51 63 36 17 4 83 71 119 107 100 53 68 49 58 104 109 122 76 0 0 0 0 3 0 54 255 244 1 181 2 18 0 13 0 27 0 65 0 93 0 184 0 0 69 88 184 0 42 47 27 185 0 42 0 10 62 89 184 0 0 69 88 184 0 61 47 27 185 0 61 0 4 62 89 185 0 3 0 1 244 186 0 11 0 61 0 42 17 18 57 186 0 14 0 42 0 61 17 18 57 184 0 42 16 185 0 20 0 1 244 186 0 34 0 61 0 42 17 18 57 186 0 51 0 61 0 42 17 18 57 48 49 55 20 22 51 50 54 53 52 46 2 39 14 1 55 62 1 53 52 38 35 34 6 21 20 30 2 7 52 62 2 55 53 46 1 53 52 62 2 51 50 22 21 20 14 2 7 21 30 3 21 20 14 2 35 34 46 2 129 69 52 51 61 24 40 56 31 33 49 156 29 31 52 47 40 51 21 36 47 205 19 31 39 20 33 49 26 45 61 35 78 90 15 23 28 14 20 36 28 17 27 50 70 43 42 70 52 29 140 41 52 46 39 23 34 26 21 11 18 53 110 22 51 26 37 49 42 36 21 33 25 19 166 26 43 34 27 10 4 20 59 41 31 51 36 19 78 60 21 38 31 26 9 3 11 24 32 41 26 30 52 38 22 21 38 52 0 2 0 49 255 244 1 170 2 18 0 10 0 43 0 77 0 184 0 0 69 88 184 0 30 47 27 185 0 30 0 10 62 89 184 0 0 69 88 184 0 40 47 27 185 0 40 0 4 62 89 187 0 0 0 1 0 22 0 4 43 184 0 30 16 185 0 5 0 1 244 184 0 40 16 185 0 14 0 1 244 186 0 19 0 40 0 30 17 18 57 48 49 19 50 54 55 38 35 34 6 21 20 22 7 30 1 51 50 62 2 55 14 1 35 34 38 53 52 62 2 51 50 30 2 21 20 14 2 35 34 38 39 229 26 63 28 15 109 39 57 52 75 18 51 29 29 52 40 24 2 26 72 37 74 90 28 47 63 35 43 75 55 31 37 61 81 43 49 72 24 1 2 29 35 145 57 48 49 55 164 17 22 22 49 79 57 29 34 81 81 38 63 44 24 31 62 96 64 78 109 70 32 33 23 0 0 0 0 1 0 41 0 239 0 237 1 46 0 3 0 13 0 187 0 1 0 1 0 2 0 4 43 48 49 19 51 21 35 41 196 196 1 46 63 0 0 0 0 1 0 41 0 243 1 115 1 44 0 3 0 13 0 187 0 1 0 1 0 2 0 4 43 48 49 19 33 21 33 41 1 74 254 182 1 44 57 0 0 1 0 41 0 243 2 134 1 44 0 3 0 13 0 187 0 1 0 1 0 2 0 4 43 48 49 19 33 21 33 41 2 93 253 163 1 44 57 0 255 255 0 81 1 178 0 185 2 178 2 6 2 222 0 0 0 2 255 255 1 10 1 109 2 186 0 9 0 17 0 45 0 184 0 13 47 184 0 16 47 184 0 14 47 186 0 5 0 14 0 13 17 18 57 186 0 10 0 14 0 13 17 18 57 184 0 10 16 185 0 9 0 1 244 48 49 19 39 46 1 39 35 14 1 15 1 23 35 7 35 19 51 19 35 244 19 11 21 11 2 11 21 11 19 141 156 40 64 147 72 147 67 1 187 62 36 72 35 37 71 35 62 49 128 1 176 254 80 0 0 0 0 3 0 57 1 10 1 111 2 186 0 15 0 23 0 32 0 51 0 184 0 14 47 184 0 1 47 187 0 30 0 1 0 16 0 4 43 186 0 8 0 16 0 30 17 18 57 184 0 1 16 185 0 21 0 1 244 184 0 14 16 185 0 24 0 1 244 48 49 19 51 50 22 21 20 6 7 21 30 1 21 20 6 43 1 55 50 54 53 52 43 1 21 23 50 54 53 52 38 43 1 21 57 134 67 85 38 38 48 52 93 73 144 125 54 46 98 64 73 54 59 58 55 73 2 186 48 57 32 51 11 2 8 51 45 64 63 250 36 34 64 134 201 38 43 38 37 156 0 1 0 32 1 2 1 104 2 194 0 29 0 27 0 184 0 25 47 184 0 5 47 185 0 12 0 1 244 184 0 25 16 185 0 18 0 1 244 48 49 19 52 62 2 51 50 22 23 7 46 1 35 34 6 21 20 22 51 50 54 55 23 14 1 35 34 46 2 32 30 53 72 42 41 61 20 35 18 41 26 60 74 71 60 30 47 20 35 26 66 43 41 71 52 29 1 225 52 83 59 31 31 23 38 17 21 91 78 79 92 24 23 38 30 33 30 57 83 0 0 2 0 57 1 10 1 122 2 186 0 8 0 16 0 31 0 184 0 7 47 184 0 1 47 184 0 7 16 185 0 9 0 1 244 184 0 1 16 185 0 14 0 1 244 48 49 19 51 50 22 21 20 6 43 1 55 50 54 53 52 43 1 17 57 112 102 107 106 100 115 111 72 73 147 46 2 186 109 104 106 113 51 86 81 164 254 181 0 1 0 57 1 10 1 63 2 186 0 11 0 41 0 184 0 0 47 184 0 11 47 187 0 5 0 1 0 6 0 4 43 184 0 0 16 185 0 2 0 1 244 184 0 11 16 185 0 9 0 1 244 48 49 19 33 21 35 21 51 21 35 21 51 21 33 57 1 0 193 164 164 199 254 250 2 186 52 127 52 148 53 0 0 1 0 57 1 10 1 58 2 186 0 9 0 31 0 184 0 9 47 184 0 0 47 187 0 5 0 1 0 6 0 4 43 184 0 0 16 185 0 2 0 1 244 48 49 19 33 21 35 21 51 21 35 21 35 57 1 1 194 165 165 63 2 186 52 138 53 189 0 1 0 32 1 2 1 114 2 194 0 33 0 41 0 184 0 5 47 184 0 29 47 187 0 22 0 1 0 24 0 4 43 184 0 5 16 185 0 12 0 1 244 184 0 29 16 185 0 18 0 1 244 48 49 19 52 62 2 51 50 22 23 7 46 1 35 34 6 21 20 22 51 50 54 55 53 35 53 51 21 14 1 35 34 46 2 32 31 55 75 44 45 62 20 36 16 43 32 64 76 72 69 23 40 12 89 146 23 70 45 43 73 54 30 1 226 52 83 58 31 32 20 40 17 22 91 78 80 92 13 11 106 52 185 21 30 30 58 83 0 1 0 57 1 10 1 122 2 186 0 11 0 29 0 184 0 0 47 184 0 4 47 184 0 11 47 184 0 7 47 187 0 8 0 1 0 2 0 4 43 48 49 19 51 21 51 53 51 17 35 53 35 21 35 57 63 195 63 63 195 63 2 186 178 178 254 80 201 201 0 0 0 1 0 57 1 10 0 120 2 186 0 3 0 11 0 184 0 0 47 184 0 2 47 48 49 19 51 17 35 57 63 63 2 186 254 80 0 1 0 18 1 2 1 10 2 186 0 16 0 17 0 184 0 6 47 184 0 13 47 185 0 2 0 1 244 48 49 19 22 51 50 54 53 17 51 17 20 14 2 35 34 38 39 62 28 45 34 34 63 14 31 48 33 43 59 20 1 104 48 41 49 1 40 254 211 29 51 37 22 36 35 0 0 1 0 57 1 10 1 131 2 186 0 12 0 49 0 184 0 12 47 184 0 8 47 184 0 0 47 184 0 4 47 186 0 2 0 0 0 12 17 18 57 186 0 6 0 0 0 8 17 18 57 186 0 9 0 12 0 0 17 18 57 48 49 19 51 21 51 55 51 7 19 35 39 7 21 35 57 63 2 174 70 136 157 69 126 72 63 2 186 209 209 164 254 244 220 84 136 0 0 0 0 1 0 57 1 10 1 52 2 186 0 5 0 17 0 184 0 0 47 184 0 5 47 185 0 3 0 1 244 48 49 19 51 17 51 21 35 57 63 188 251 2 186 254 133 53 0 0 0 1 0 57 1 10 1 174 2 186 0 25 0 59 0 184 0 25 47 184 0 9 47 184 0 0 47 184 0 7 47 186 0 4 0 7 0 9 17 18 57 186 0 13 0 9 0 7 17 18 57 186 0 17 0 25 0 0 17 18 57 186 0 20 0 0 0 25 17 18 57 48 49 19 51 31 1 51 63 1 51 17 35 53 52 54 55 35 15 1 35 47 1 35 30 1 29 1 35 57 73 83 31 3 30 80 73 59 6 2 3 35 81 33 82 36 2 2 6 58 2 186 224 86 86 224 254 80 225 29 72 29 97 216 216 97 29 72 29 225 0 1 0 57 1 10 1 118 2 186 0 19 0 39 0 184 0 0 47 184 0 9 47 184 0 10 47 184 0 19 47 186 0 4 0 10 0 9 17 18 57 186 0 14 0 0 0 19 17 18 57 48 49 19 51 19 23 51 46 1 61 1 51 17 35 3 39 35 30 1 29 1 35 57 66 151 46 3 2 5 58 65 151 47 2 2 4 58 2 186 254 250 90 32 74 35 211 254 80 1 8 89 33 70 34 216 0 0 0 2 0 32 1 2 1 155 2 194 0 19 0 31 0 27 0 184 0 10 47 184 0 0 47 185 0 20 0 1 244 184 0 10 16 185 0 26 0 1 244 48 49 19 34 46 2 53 52 62 2 51 50 30 2 21 20 14 2 39 50 54 53 52 38 35 34 6 21 20 22 221 42 69 50 28 28 50 69 42 42 70 50 28 28 50 70 42 57 68 68 57 57 67 67 1 2 32 58 84 52 52 83 57 30 31 57 82 52 52 84 58 32 54 94 78 78 91 91 78 78 94 0 0 0 2 0 57 1 10 1 103 2 186 0 12 0 20 0 31 0 184 0 0 47 184 0 12 47 187 0 13 0 1 0 9 0 4 43 184 0 0 16 185 0 18 0 1 244 48 49 19 51 50 22 21 20 14 2 43 1 21 35 55 50 53 52 38 43 1 21 57 139 73 90 24 44 59 36 76 63 132 108 54 54 69 2 186 57 71 35 51 34 16 168 218 86 45 33 164 0 2 0 31 0 158 1 165 2 194 0 11 0 40 0 49 0 184 0 18 47 184 0 26 47 187 0 37 0 1 0 15 0 4 43 184 0 18 16 185 0 3 0 1 244 184 0 26 16 185 0 9 0 1 244 184 0 18 16 184 0 34 208 48 49 19 20 22 51 50 54 53 52 38 35 34 6 1 14 1 35 34 38 39 46 1 53 52 62 2 51 50 30 2 21 20 6 7 30 1 51 50 54 55 96 67 57 57 68 68 57 57 67 1 69 10 34 21 62 83 20 72 88 28 50 69 42 42 70 50 28 84 69 16 55 35 15 22 9 1 229 80 94 94 80 78 90 90 254 117 4 6 57 45 11 117 97 52 82 57 30 31 57 82 51 94 116 14 27 25 4 2 0 2 0 57 1 10 1 112 2 186 0 7 0 23 0 45 0 184 0 12 47 184 0 8 47 184 0 13 47 187 0 1 0 1 0 9 0 4 43 184 0 13 16 185 0 6 0 1 244 186 0 22 0 1 0 9 17 18 57 48 49 19 51 50 53 52 38 43 1 19 39 35 21 35 17 51 50 30 2 21 20 6 7 23 120 70 101 51 50 70 177 101 76 63 141 33 57 42 23 52 43 110 1 239 79 41 33 254 130 179 179 1 176 13 29 46 34 51 60 12 187 0 0 0 0 1 0 26 1 2 1 76 2 195 0 45 0 51 0 184 0 42 47 184 0 20 47 184 0 42 16 185 0 3 0 1 244 186 0 6 0 20 0 3 17 18 57 184 0 20 16 185 0 27 0 1 244 186 0 30 0 3 0 20 17 18 57 48 49 19 30 1 51 50 54 53 52 38 47 1 46 3 53 52 62 2 51 50 22 23 7 46 1 35 34 6 21 20 30 2 31 1 30 1 21 20 6 35 34 38 39 63 24 64 33 42 43 40 31 63 16 32 25 16 21 38 52 31 38 69 24 33 21 48 31 35 41 13 20 25 12 63 42 47 80 71 46 79 30 1 109 25 27 37 29 31 28 13 28 7 19 26 35 24 25 43 31 18 30 24 39 18 22 33 27 15 21 16 12 5 27 18 48 45 55 74 34 31 0 1 0 17 1 10 1 84 2 186 0 7 0 21 0 184 0 7 47 184 0 2 47 185 0 1 0 1 244 184 0 4 208 48 49 19 35 53 33 21 35 17 35 148 131 1 67 130 62 2 134 52 52 254 132 0 0 1 0 56 1 2 1 120 2 186 0 25 0 21 0 184 0 0 47 184 0 13 47 184 0 20 47 185 0 7 0 1 244 48 49 19 51 21 20 30 2 51 50 62 2 61 1 51 21 20 14 2 35 34 46 2 53 56 62 15 26 37 21 21 36 27 15 60 24 42 59 34 36 59 43 23 2 186 252 38 52 31 13 13 31 52 38 252 249 53 72 46 20 20 46 72 53 0 0 0 0 1 255 254 1 10 1 92 2 186 0 13 0 25 0 184 0 0 47 184 0 10 47 184 0 13 47 186 0 5 0 0 0 13 17 18 57 48 49 3 51 23 30 1 23 51 62 1 63 1 51 3 35 2 66 69 11 18 12 3 12 17 11 67 64 138 72 2 186 227 38 66 38 38 66 38 227 254 80 0 0 1 0 13 1 10 2 1 2 186 0 33 0 53 0 184 0 33 47 184 0 23 47 184 0 0 47 184 0 10 47 184 0 21 47 186 0 5 0 0 0 33 17 18 57 186 0 15 0 10 0 23 17 18 57 186 0 28 0 33 0 10 17 18 57 48 49 19 51 23 30 1 23 51 62 1 63 1 51 23 30 1 23 51 62 1 63 1 51 3 35 39 46 1 39 35 14 1 15 1 35 13 65 43 7 12 6 3 7 14 8 59 56 59 8 15 8 2 6 11 7 44 60 90 75 63 6 10 5 2 5 11 5 61 76 2 186 228 35 69 35 35 69 35 228 228 35 69 35 35 69 35 228 254 80 250 25 48 25 25 48 25 250 0 0 1 0 8 1 10 1 82 2 186 0 25 0 59 0 184 0 1 47 184 0 12 47 184 0 14 47 184 0 25 47 186 0 0 0 1 0 25 17 18 57 186 0 6 0 14 0 12 17 18 57 186 0 13 0 14 0 12 17 18 57 186 0 20 0 1 0 25 17 18 57 48 49 19 39 51 23 30 1 23 51 62 1 63 1 51 7 23 35 39 46 1 39 35 14 1 15 1 35 135 118 69 56 8 15 10 3 9 14 8 54 67 119 127 69 60 8 18 11 3 9 18 8 60 66 1 234 208 105 15 29 20 20 29 15 105 211 221 113 16 33 20 20 33 16 113 0 0 0 1 255 253 1 10 1 67 2 186 0 15 0 25 0 184 0 1 47 184 0 12 47 184 0 15 47 186 0 6 0 1 0 15 17 18 57 48 49 19 3 51 23 30 1 23 51 62 1 63 1 51 3 21 35 129 132 66 55 11 20 11 3 11 21 10 53 65 131 63 1 176 1 10 117 25 45 25 25 45 25 117 254 246 166 0 0 0 0 1 0 27 1 10 1 76 2 186 0 9 0 35 0 184 0 3 47 184 0 8 47 185 0 6 0 1 244 184 0 0 208 184 0 3 16 185 0 1 0 1 244 184 0 5 208 48 49 27 1 35 53 33 21 3 51 21 33 27 226 206 1 27 225 227 254 207 1 48 1 86 52 37 254 170 53 0 0 0 0 2 0 43 1 176 0 134 2 241 0 11 0 23 0 27 0 184 0 9 47 187 0 21 0 1 0 15 0 4 43 184 0 9 16 185 0 3 0 1 244 48 49 19 52 54 51 50 22 21 20 6 35 34 38 53 52 54 51 50 22 21 20 6 35 34 38 43 26 20 20 25 25 20 20 26 26 20 20 25 25 20 20 26 1 223 22 26 26 22 21 26 26 247 21 27 27 21 22 26 26 0 0 0 0 1 0 41 2 101 0 197 2 147 0 3 0 26 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 16 62 89 185 0 2 0 1 244 48 49 19 51 21 35 41 156 156 2 147 46 0 0 0 1 0 41 2 104 1 51 2 145 0 3 0 26 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 16 62 89 185 0 2 0 1 244 48 49 19 33 21 33 41 1 10 254 246 2 145 41 0 1 0 41 2 104 2 10 2 145 0 3 0 26 0 184 0 0 69 88 184 0 0 47 27 185 0 0 0 16 62 89 185 0 2 0 1 244 48 49 19 33 21 33 41 1 225 254 31 2 145 41 0 2 255 133 2 89 0 123 3 55 0 3 0 7 0 40 0 184 0 0 69 88 184 0 4 47 27 185 0 4 0 16 62 89 187 0 0 0 1 0 2 0 4 43 184 0 4 16 185 0 6 0 1 244 48 49 19 51 7 35 7 51 21 35 29 79 103 58 70 246 246 3 55 103 62 57 0 2 255 132 2 217 0 129 3 182 0 3 0 7 0 23 0 187 0 5 0 1 0 6 0 4 43 187 0 0 0 1 0 2 0 4 43 48 49 19 51 7 35 7 51 21 35 38 91 112 68 73 248 248 3 182 111 53 57 0 0 0 0 36 1 182 0 1 0 0 0 0 0 0 0 69 0 0 0 1 0 0 0 0 0 1 0 15 0 69 0 1 0 0 0 0 0 2 0 7 0 84 0 1 0 0 0 0 0 3 0 38 0 91 0 1 0 0 0 0 0 4 0 15 0 69 0 1 0 0 0 0 0 5 0 65 0 129 0 1 0 0 0 0 0 6 0 21 0 194 0 1 0 0 0 0 0 7 0 96 0 215 0 1 0 0 0 0 0 8 0 26 1 55 0 1 0 0 0 0 0 9 0 12 1 81 0 1 0 0 0 0 0 11 0 25 1 93 0 1 0 0 0 0 0 13 17 217 1 118 0 1 0 0 0 0 0 14 0 36 19 79 0 1 0 0 0 0 1 0 0 12 19 115 0 1 0 0 0 0 1 1 0 10 19 127 0 1 0 0 0 0 1 2 0 11 19 137 0 1 0 0 0 0 1 3 0 11 19 148 0 1 0 0 0 0 1 4 0 9 19 159 0 3 0 1 4 9 0 0 0 138 19 168 0 3 0 1 4 9 0 1 0 30 20 50 0 3 0 1 4 9 0 2 0 14 20 80 0 3 0 1 4 9 0 3 0 76 20 94 0 3 0 1 4 9 0 4 0 30 20 50 0 3 0 1 4 9 0 5 0 130 20 170 0 3 0 1 4 9 0 6 0 42 21 44 0 3 0 1 4 9 0 7 0 192 21 86 0 3 0 1 4 9 0 8 0 52 22 22 0 3 0 1 4 9 0 9 0 24 22 74 0 3 0 1 4 9 0 11 0 50 22 98 0 3 0 1 4 9 0 13 35 182 22 148 0 3 0 1 4 9 0 14 0 72 58 74 0 3 0 1 4 9 1 0 0 24 58 146 0 3 0 1 4 9 1 1 0 20 58 170 0 3 0 1 4 9 1 2 0 22 58 190 0 3 0 1 4 9 1 3 0 22 58 212 0 3 0 1 4 9 1 4 0 18 58 234 67 111 112 121 114 105 103 104 116 32 50 48 49 48 44 32 50 48 49 50 32 65 100 111 98 101 32 83 121 115 116 101 109 115 32 73 110 99 111 114 112 111 114 97 116 101 100 46 32 65 108 108 32 82 105 103 104 116 115 32 82 101 115 101 114 118 101 100 46 83 111 117 114 99 101 32 83 97 110 115 32 80 114 111 82 101 103 117 108 97 114 49 46 48 53 48 59 65 68 66 69 59 83 111 117 114 99 101 83 97 110 115 80 114 111 45 82 101 103 117 108 97 114 59 65 68 79 66 69 86 101 114 115 105 111 110 32 49 46 48 53 48 59 80 83 32 86 101 114 115 105 111 110 32 49 46 48 48 48 59 104 111 116 99 111 110 118 32 49 46 48 46 55 48 59 109 97 107 101 111 116 102 46 108 105 98 50 46 53 46 53 57 48 48 83 111 117 114 99 101 83 97 110 115 80 114 111 45 82 101 103 117 108 97 114 83 111 117 114 99 101 32 105 115 32 97 32 116 114 97 100 101 109 97 114 107 32 111 102 32 65 100 111 98 101 32 83 121 115 116 101 109 115 32 73 110 99 111 114 112 111 114 97 116 101 100 32 105 110 32 116 104 101 32 85 110 105 116 101 100 32 83 116 97 116 101 115 32 97 110 100 47 111 114 32 111 116 104 101 114 32 99 111 117 110 116 114 105 101 115 46 65 100 111 98 101 32 83 121 115 116 101 109 115 32 73 110 99 111 114 112 111 114 97 116 101 100 80 97 117 108 32 68 46 32 72 117 110 116 104 116 116 112 58 47 47 119 119 119 46 97 100 111 98 101 46 99 111 109 47 116 121 112 101 67 111 112 121 114 105 103 104 116 32 50 48 49 48 44 32 50 48 49 50 32 65 100 111 98 101 32 83 121 115 116 101 109 115 32 73 110 99 111 114 112 111 114 97 116 101 100 32 40 104 116 116 112 58 47 47 119 119 119 46 97 100 111 98 101 46 99 111 109 47 41 44 32 119 105 116 104 32 82 101 115 101 114 118 101 100 32 70 111 110 116 32 78 97 109 101 32 39 83 111 117 114 99 101 39 46 32 65 108 108 32 82 105 103 104 116 115 32 82 101 115 101 114 118 101 100 46 32 83 111 117 114 99 101 32 105 115 32 97 32 116 114 97 100 101 109 97 114 107 32 111 102 32 65 100 111 98 101 32 83 121 115 116 101 109 115 32 73 110 99 111 114 112 111 114 97 116 101 100 32 105 110 32 116 104 101 32 85 110 105 116 101 100 32 83 116 97 116 101 115 32 97 110 100 47 111 114 32 111 116 104 101 114 32 99 111 117 110 116 114 105 101 115 46 13 10 13 10 84 104 105 115 32 70 111 110 116 32 83 111 102 116 119 97 114 101 32 105 115 32 108 105 99 101 110 115 101 100 32 117 110 100 101 114 32 116 104 101 32 83 73 76 32 79 112 101 110 32 70 111 110 116 32 76 105 99 101 110 115 101 44 32 86 101 114 115 105 111 110 32 49 46 49 46 13 10 13 10 84 104 105 115 32 108 105 99 101 110 115 101 32 105 115 32 99 111 112 105 101 100 32 98 101 108 111 119 44 32 97 110 100 32 105 115 32 97 108 115 111 32 97 118 97 105 108 97 98 108 101 32 119 105 116 104 32 97 32 70 65 81 32 97 116 58 32 104 116 116 112 58 47 47 115 99 114 105 112 116 115 46 115 105 108 46 111 114 103 47 79 70 76 13 10 13 10 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 13 10 83 73 76 32 79 80 69 78 32 70 79 78 84 32 76 73 67 69 78 83 69 32 86 101 114 115 105 111 110 32 49 46 49 32 45 32 50 54 32 70 101 98 114 117 97 114 121 32 50 48 48 55 13 10 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 45 13 10 13 10 80 82 69 65 77 66 76 69 13 10 84 104 101 32 103 111 97 108 115 32 111 102 32 116 104 101 32 79 112 101 110 32 70 111 110 116 32 76 105 99 101 110 115 101 32 40 79 70 76 41 32 97 114 101 32 116 111 32 115 116 105 109 117 108 97 116 101 32 119 111 114 108 100 119 105 100 101 32 100 101 118 101 108 111 112 109 101 110 116 32 111 102 32 99 111 108 108 97 98 111 114 97 116 105 118 101 32 102 111 110 116 32 112 114 111 106 101 99 116 115 44 32 116 111 32 115 117 112 112 111 114 116 32 116 104 101 32 102 111 110 116 32 99 114 101 97 116 105 111 110 32 101 102 102 111 114 116 115 32 111 102 32 97 99 97 100 101 109 105 99 32 97 110 100 32 108 105 110 103 117 105 115 116 105 99 32 99 111 109 109 117 110 105 116 105 101 115 44 32 97 110 100 32 116 111 32 112 114 111 118 105 100 101 32 97 32 102 114 101 101 32 97 110 100 32 111 112 101 110 32 102 114 97 109 101 119 111 114 107 32 105 110 32 119 104 105 99 104 32 102 111 110 116 115 32 109 97 121 32 98 101 32 115 104 97 114 101 100 32 97 110 100 32 105 109 112 114 111 118 101 100 32 105 110 32 112 97 114 116 110 101 114 115 104 105 112 32 119 105 116 104 32 111 116 104 101 114 115 46 13 10 13 10 84 104 101 32 79 70 76 32 97 108 108 111 119 115 32 116 104 101 32 108 105 99 101 110 115 101 100 32 102 111 110 116 115 32 116 111 32 98 101 32 117 115 101 100 44 32 115 116 117 100 105 101 100 44 32 109 111 100 105 102 105 101 100 32 97 110 100 32 114 101 100 105 115 116 114 105 98 117 116 101 100 32 102 114 101 101 108 121 32 97 115 32 108 111 110 103 32 97 115 32 116 104 101 121 32 97 114 101 32 110 111 116 32 115 111 108 100 32 98 121 32 116 104 101 109 115 101 108 118 101 115 46 32 84 104 101 32 102 111 110 116 115 44 32 105 110 99 108 117 100 105 110 103 32 97 110 121 32 100 101 114 105 118 97 116 105 118 101 32 119 111 114 107 115 44 32 99 97 110 32 98 101 32 98 117 110 100 108 101 100 44 32 101 109 98 101 100 100 101 100 44 32 114 101 100 105 115 116 114 105 98 117 116 101 100 32 97 110 100 47 111 114 32 115 111 108 100 32 119 105 116 104 32 97 110 121 32 115 111 102 116 119 97 114 101 32 112 114 111 118 105 100 101 100 32 116 104 97 116 32 97 110 121 32 114 101 115 101 114 118 101 100 32 110 97 109 101 115 32 97 114 101 32 110 111 116 32 117 115 101 100 32 98 121 32 100 101 114 105 118 97 116 105 118 101 32 119 111 114 107 115 46 32 84 104 101 32 102 111 110 116 115 32 97 110 100 32 100 101 114 105 118 97 116 105 118 101 115 44 32 104 111 119 101 118 101 114 44 32 99 97 110 110 111 116 32 98 101 32 114 101 108 101 97 115 101 100 32 117 110 100 101 114 32 97 110 121 32 111 116 104 101 114 32 116 121 112 101 32 111 102 32 108 105 99 101 110 115 101 46 32 84 104 101 32 114 101 113 117 105 114 101 109 101 110 116 32 102 111 114 32 102 111 110 116 115 32 116 111 32 114 101 109 97 105 110 32 117 110 100 101 114 32 116 104 105 115 32 108 105 99 101 110 115 101 32 100 111 101 115 32 110 111 116 32 97 112 112 108 121 32 116 111 32 97 110 121 32 100 111 99 117 109 101 110 116 32 99 114 101 97 116 101 100 32 117 115 105 110 103 32 116 104 101 32 102 111 110 116 115 32 111 114 32 116 104 101 105 114 32 100 101 114 105 118 97 116 105 118 101 115 46 13 10 13 10 68 69 70 73 78 73 84 73 79 78 83 13 10 34 70 111 110 116 32 83 111 102 116 119 97 114 101 34 32 114 101 102 101 114 115 32 116 111 32 116 104 101 32 115 101 116 32 111 102 32 102 105 108 101 115 32 114 101 108 101 97 115 101 100 32 98 121 32 116 104 101 32 67 111 112 121 114 105 103 104 116 32 72 111 108 100 101 114 40 115 41 32 117 110 100 101 114 32 116 104 105 115 32 108 105 99 101 110 115 101 32 97 110 100 32 99 108 101 97 114 108 121 32 109 97 114 107 101 100 32 97 115 32 115 117 99 104 46 32 84 104 105 115 32 109 97 121 32 105 110 99 108 117 100 101 32 115 111 117 114 99 101 32 102 105 108 101 115 44 32 98 117 105 108 100 32 115 99 114 105 112 116 115 32 97 110 100 32 100 111 99 117 109 101 110 116 97 116 105 111 110 46 13 10 13 10 34 82 101 115 101 114 118 101 100 32 70 111 110 116 32 78 97 109 101 34 32 114 101 102 101 114 115 32 116 111 32 97 110 121 32 110 97 109 101 115 32 115 112 101 99 105 102 105 101 100 32 97 115 32 115 117 99 104 32 97 102 116 101 114 32 116 104 101 32 99 111 112 121 114 105 103 104 116 32 115 116 97 116 101 109 101 110 116 40 115 41 46 13 10 13 10 34 79 114 105 103 105 110 97 108 32 86 101 114 115 105 111 110 34 32 114 101 102 101 114 115 32 116 111 32 116 104 101 32 99 111 108 108 101 99 116 105 111 110 32 111 102 32 70 111 110 116 32 83 111 102 116 119 97 114 101 32 99 111 109 112 111 110 101 110 116 115 32 97 115 32 100 105 115 116 114 105 98 117 116 101 100 32 98 121 32 116 104 101 32 67 111 112 121 114 105 103 104 116 32 72 111 108 100 101 114 40 115 41 46 13 10 13 10 34 77 111 100 105 102 105 101 100 32 86 101 114 115 105 111 110 34 32 114 101 102 101 114 115 32 116 111 32 97 110 121 32 100 101 114 105 118 97 116 105 118 101 32 109 97 100 101 32 98 121 32 97 100 100 105 110 103 32 116 111 44 32 100 101 108 101 116 105 110 103 44 32 111 114 32 115 117 98 115 116 105 116 117 116 105 110 103 32 45 45 32 105 110 32 112 97 114 116 32 111 114 32 105 110 32 119 104 111 108 101 32 45 45 32 97 110 121 32 111 102 32 116 104 101 32 99 111 109 112 111 110 101 110 116 115 32 111 102 32 116 104 101 32 79 114 105 103 105 110 97 108 32 86 101 114 115 105 111 110 44 32 98 121 32 99 104 97 110 103 105 110 103 32 102 111 114 109 97 116 115 32 111 114 32 98 121 32 112 111 114 116 105 110 103 32 116 104 101 32 70 111 110 116 32 83 111 102 116 119 97 114 101 32 116 111 32 97 32 110 101 119 32 101 110 118 105 114 111 110 109 101 110 116 46 13 10 13 10 34 65 117 116 104 111 114 34 32 114 101 102 101 114 115 32 116 111 32 97 110 121 32 100 101 115 105 103 110 101 114 44 32 101 110 103 105 110 101 101 114 44 32 112 114 111 103 114 97 109 109 101 114 44 32 116 101 99 104 110 105 99 97 108 32 119 114 105 116 101 114 32 111 114 32 111 116 104 101 114 32 112 101 114 115 111 110 32 119 104 111 32 99 111 110 116 114 105 98 117 116 101 100 32 116 111 32 116 104 101 32 70 111 110 116 32 83 111 102 116 119 97 114 101 46 13 10 13 10 80 69 82 77 73 83 83 73 79 78 32 38 32 67 79 78 68 73 84 73 79 78 83 13 10 80 101 114 109 105 115 115 105 111 110 32 105 115 32 104 101 114 101 98 121 32 103 114 97 110 116 101 100 44 32 102 114 101 101 32 111 102 32 99 104 97 114 103 101 44 32 116 111 32 97 110 121 32 112 101 114 115 111 110 32 111 98 116 97 105 110 105 110 103 32 97 32 99 111 112 121 32 111 102 32 116 104 101 32 70 111 110 116 32 83 111 102 116 119 97 114 101 44 32 116 111 32 117 115 101 44 32 115 116 117 100 121 44 32 99 111 112 121 44 32 109 101 114 103 101 44 32 101 109 98 101 100 44 32 109 111 100 105 102 121 44 32 114 101 100 105 115 116 114 105 98 117 116 101 44 32 97 110 100 32 115 101 108 108 32 109 111 100 105 102 105 101 100 32 97 110 100 32 117 110 109 111 100 105 102 105 101 100 32 99 111 112 105 101 115 32 111 102 32 116 104 101 32 70 111 110 116 32 83 111 102 116 119 97 114 101 44 32 115 117 98 106 101 99 116 32 116 111 32 116 104 101 32 102 111 108 108 111 119 105 110 103 32 99 111 110 100 105 116 105 111 110 115 58 13 10 13 10 49 41 32 78 101 105 116 104 101 114 32 116 104 101 32 70 111 110 116 32 83 111 102 116 119 97 114 101 32 110 111 114 32 97 110 121 32 111 102 32 105 116 115 32 105 110 100 105 118 105 100 117 97 108 32 99 111 109 112 111 110 101 110 116 115 44 32 105 110 32 79 114 105 103 105 110 97 108 32 111 114 32 77 111 100 105 102 105 101 100 32 86 101 114 115 105 111 110 115 44 32 109 97 121 32 98 101 32 115 111 108 100 32 98 121 32 105 116 115 101 108 102 46 13 10 13 10 50 41 32 79 114 105 103 105 110 97 108 32 111 114 32 77 111 100 105 102 105 101 100 32 86 101 114 115 105 111 110 115 32 111 102 32 116 104 101 32 70 111 110 116 32 83 111 102 116 119 97 114 101 32 109 97 121 32 98 101 32 98 117 110 100 108 101 100 44 32 114 101 100 105 115 116 114 105 98 117 116 101 100 32 97 110 100 47 111 114 32 115 111 108 100 32 119 105 116 104 32 97 110 121 32 115 111 102 116 119 97 114 101 44 32 112 114 111 118 105 100 101 100 32 116 104 97 116 32 101 97 99 104 32 99 111 112 121 32 99 111 110 116 97 105 110 115 32 116 104 101 32 97 98 111 118 101 32 99 111 112 121 114 105 103 104 116 32 110 111 116 105 99 101 32 97 110 100 32 116 104 105 115 32 108 105 99 101 110 115 101 46 32 84 104 101 115 101 32 99 97 110 32 98 101 32 105 110 99 108 117 100 101 100 32 101 105 116 104 101 114 32 97 115 32 115 116 97 110 100 45 97 108 111 110 101 32 116 101 120 116 32 102 105 108 101 115 44 32 104 117 109 97 110 45 114 101 97 100 97 98 108 101 32 104 101 97 100 101 114 115 32 111 114 32 105 110 32 116 104 101 32 97 112 112 114 111 112 114 105 97 116 101 32 109 97 99 104 105 110 101 45 114 101 97 100 97 98 108 101 32 109 101 116 97 100 97 116 97 32 102 105 101 108 100 115 32 119 105 116 104 105 110 32 116 101 120 116 32 111 114 32 98 105 110 97 114 121 32 102 105 108 101 115 32 97 115 32 108 111 110 103 32 97 115 32 116 104 111 115 101 32 102 105 101 108 100 115 32 99 97 110 32 98 101 32 101 97 115 105 108 121 32 118 105 101 119 101 100 32 98 121 32 116 104 101 32 117 115 101 114 46 13 10 13 10 51 41 32 78 111 32 77 111 100 105 102 105 101 100 32 86 101 114 115 105 111 110 32 111 102 32 116 104 101 32 70 111 110 116 32 83 111 102 116 119 97 114 101 32 109 97 121 32 117 115 101 32 116 104 101 32 82 101 115 101 114 118 101 100 32 70 111 110 116 32 78 97 109 101 40 115 41 32 117 110 108 101 115 115 32 101 120 112 108 105 99 105 116 32 119 114 105 116 116 101 110 32 112 101 114 109 105 115 115 105 111 110 32 105 115 32 103 114 97 110 116 101 100 32 98 121 32 116 104 101 32 99 111 114 114 101 115 112 111 110 100 105 110 103 32 67 111 112 121 114 105 103 104 116 32 72 111 108 100 101 114 46 32 84 104 105 115 32 114 101 115 116 114 105 99 116 105 111 110 32 111 110 108 121 32 97 112 112 108 105 101 115 32 116 111 32 116 104 101 32 112 114 105 109 97 114 121 32 102 111 110 116 32 110 97 109 101 32 97 115 32 112 114 101 115 101 110 116 101 100 32 116 111 32 116 104 101 32 117 115 101 114 115 46 13 10 13 10 52 41 32 84 104 101 32 110 97 109 101 40 115 41 32 111 102 32 116 104 101 32 67 111 112 121 114 105 103 104 116 32 72 111 108 100 101 114 40 115 41 32 111 114 32 116 104 101 32 65 117 116 104 111 114 40 115 41 32 111 102 32 116 104 101 32 70 111 110 116 32 83 111 102 116 119 97 114 101 32 115 104 97 108 108 32 110 111 116 32 98 101 32 117 115 101 100 32 116 111 32 112 114 111 109 111 116 101 44 32 101 110 100 111 114 115 101 32 111 114 32 97 100 118 101 114 116 105 115 101 32 97 110 121 32 77 111 100 105 102 105 101 100 32 86 101 114 115 105 111 110 44 32 101 120 99 101 112 116 32 116 111 32 97 99 107 110 111 119 108 101 100 103 101 32 116 104 101 32 99 111 110 116 114 105 98 117 116 105 111 110 40 115 41 32 111 102 32 116 104 101 32 67 111 112 121 114 105 103 104 116 32 72 111 108 100 101 114 40 115 41 32 97 110 100 32 116 104 101 32 65 117 116 104 111 114 40 115 41 32 111 114 32 119 105 116 104 32 116 104 101 105 114 32 101 120 112 108 105 99 105 116 32 119 114 105 116 116 101 110 32 112 101 114 109 105 115 115 105 111 110 46 13 10 13 10 53 41 32 84 104 101 32 70 111 110 116 32 83 111 102 116 119 97 114 101 44 32 109 111 100 105 102 105 101 100 32 111 114 32 117 110 109 111 100 105 102 105 101 100 44 32 105 110 32 112 97 114 116 32 111 114 32 105 110 32 119 104 111 108 101 44 32 109 117 115 116 32 98 101 32 100 105 115 116 114 105 98 117 116 101 100 32 101 110 116 105 114 101 108 121 32 117 110 100 101 114 32 116 104 105 115 32 108 105 99 101 110 115 101 44 32 97 110 100 32 109 117 115 116 32 110 111 116 32 98 101 32 100 105 115 116 114 105 98 117 116 101 100 32 117 110 100 101 114 32 97 110 121 32 111 116 104 101 114 32 108 105 99 101 110 115 101 46 32 84 104 101 32 114 101 113 117 105 114 101 109 101 110 116 32 102 111 114 32 102 111 110 116 115 32 116 111 32 114 101 109 97 105 110 32 117 110 100 101 114 32 116 104 105 115 32 108 105 99 101 110 115 101 32 100 111 101 115 32 110 111 116 32 97 112 112 108 121 32 116 111 32 97 110 121 32 100 111 99 117 109 101 110 116 32 99 114 101 97 116 101 100 32 117 115 105 110 103 32 116 104 101 32 70 111 110 116 32 83 111 102 116 119 97 114 101 46 13 10 13 10 84 69 82 77 73 78 65 84 73 79 78 13 10 84 104 105 115 32 108 105 99 101 110 115 101 32 98 101 99 111 109 101 115 32 110 117 108 108 32 97 110 100 32 118 111 105 100 32 105 102 32 97 110 121 32 111 102 32 116 104 101 32 97 98 111 118 101 32 99 111 110 100 105 116 105 111 110 115 32 97 114 101 32 110 111 116 32 109 101 116 46 13 10 13 10 68 73 83 67 76 65 73 77 69 82 13 10 84 72 69 32 70 79 78 84 32 83 79 70 84 87 65 82 69 32 73 83 32 80 82 79 86 73 68 69 68 32 34 65 83 32 73 83 34 44 32 87 73 84 72 79 85 84 32 87 65 82 82 65 78 84 89 32 79 70 32 65 78 89 32 75 73 78 68 44 32 69 88 80 82 69 83 83 32 79 82 32 73 77 80 76 73 69 68 44 32 73 78 67 76 85 68 73 78 71 32 66 85 84 32 78 79 84 32 76 73 77 73 84 69 68 32 84 79 32 65 78 89 32 87 65 82 82 65 78 84 73 69 83 32 79 70 32 77 69 82 67 72 65 78 84 65 66 73 76 73 84 89 44 32 70 73 84 78 69 83 83 32 70 79 82 32 65 32 80 65 82 84 73 67 85 76 65 82 32 80 85 82 80 79 83 69 32 65 78 68 32 78 79 78 73 78 70 82 73 78 71 69 77 69 78 84 32 79 70 32 67 79 80 89 82 73 71 72 84 44 32 80 65 84 69 78 84 44 32 84 82 65 68 69 77 65 82 75 44 32 79 82 32 79 84 72 69 82 32 82 73 71 72 84 46 32 73 78 32 78 79 32 69 86 69 78 84 32 83 72 65 76 76 32 84 72 69 32 67 79 80 89 82 73 71 72 84 32 72 79 76 68 69 82 32 66 69 32 76 73 65 66 76 69 32 70 79 82 32 65 78 89 32 67 76 65 73 77 44 32 68 65 77 65 71 69 83 32 79 82 32 79 84 72 69 82 32 76 73 65 66 73 76 73 84 89 44 32 73 78 67 76 85 68 73 78 71 32 65 78 89 32 71 69 78 69 82 65 76 44 32 83 80 69 67 73 65 76 44 32 73 78 68 73 82 69 67 84 44 32 73 78 67 73 68 69 78 84 65 76 44 32 79 82 32 67 79 78 83 69 81 85 69 78 84 73 65 76 32 68 65 77 65 71 69 83 44 32 87 72 69 84 72 69 82 32 73 78 32 65 78 32 65 67 84 73 79 78 32 79 70 32 67 79 78 84 82 65 67 84 44 32 84 79 82 84 32 79 82 32 79 84 72 69 82 87 73 83 69 44 32 65 82 73 83 73 78 71 32 70 82 79 77 44 32 79 85 84 32 79 70 32 84 72 69 32 85 83 69 32 79 82 32 73 78 65 66 73 76 73 84 89 32 84 79 32 85 83 69 32 84 72 69 32 70 79 78 84 32 83 79 70 84 87 65 82 69 32 79 82 32 70 82 79 77 32 79 84 72 69 82 32 68 69 65 76 73 78 71 83 32 73 78 32 84 72 69 32 70 79 78 84 32 83 79 70 84 87 65 82 69 46 104 116 116 112 58 47 47 119 119 119 46 97 100 111 98 101 46 99 111 109 47 116 121 112 101 47 108 101 103 97 108 46 104 116 109 108 83 108 97 115 104 101 100 32 122 101 114 111 83 116 114 97 105 103 104 116 32 108 65 108 116 101 114 110 97 116 101 32 97 65 108 116 101 114 110 97 116 101 32 103 83 101 114 105 102 101 100 32 73 0 67 0 111 0 112 0 121 0 114 0 105 0 103 0 104 0 116 0 32 0 50 0 48 0 49 0 48 0 44 0 32 0 50 0 48 0 49 0 50 0 32 0 65 0 100 0 111 0 98 0 101 0 32 0 83 0 121 0 115 0 116 0 101 0 109 0 115 0 32 0 73 0 110 0 99 0 111 0 114 0 112 0 111 0 114 0 97 0 116 0 101 0 100 0 46 0 32 0 65 0 108 0 108 0 32 0 82 0 105 0 103 0 104 0 116 0 115 0 32 0 82 0 101 0 115 0 101 0 114 0 118 0 101 0 100 0 46 0 83 0 111 0 117 0 114 0 99 0 101 0 32 0 83 0 97 0 110 0 115 0 32 0 80 0 114 0 111 0 82 0 101 0 103 0 117 0 108 0 97 0 114 0 49 0 46 0 48 0 53 0 48 0 59 0 65 0 68 0 66 0 69 0 59 0 83 0 111 0 117 0 114 0 99 0 101 0 83 0 97 0 110 0 115 0 80 0 114 0 111 0 45 0 82 0 101 0 103 0 117 0 108 0 97 0 114 0 59 0 65 0 68 0 79 0 66 0 69 0 86 0 101 0 114 0 115 0 105 0 111 0 110 0 32 0 49 0 46 0 48 0 53 0 48 0 59 0 80 0 83 0 32 0 86 0 101 0 114 0 115 0 105 0 111 0 110 0 32 0 49 0 46 0 48 0 48 0 48 0 59 0 104 0 111 0 116 0 99 0 111 0 110 0 118 0 32 0 49 0 46 0 48 0 46 0 55 0 48 0 59 0 109 0 97 0 107 0 101 0 111 0 116 0 102 0 46 0 108 0 105 0 98 0 50 0 46 0 53 0 46 0 53 0 57 0 48 0 48 0 83 0 111 0 117 0 114 0 99 0 101 0 83 0 97 0 110 0 115 0 80 0 114 0 111 0 45 0 82 0 101 0 103 0 117 0 108 0 97 0 114 0 83 0 111 0 117 0 114 0 99 0 101 0 32 0 105 0 115 0 32 0 97 0 32 0 116 0 114 0 97 0 100 0 101 0 109 0 97 0 114 0 107 0 32 0 111 0 102 0 32 0 65 0 100 0 111 0 98 0 101 0 32 0 83 0 121 0 115 0 116 0 101 0 109 0 115 0 32 0 73 0 110 0 99 0 111 0 114 0 112 0 111 0 114 0 97 0 116 0 101 0 100 0 32 0 105 0 110 0 32 0 116 0 104 0 101 0 32 0 85 0 110 0 105 0 116 0 101 0 100 0 32 0 83 0 116 0 97 0 116 0 101 0 115 0 32 0 97 0 110 0 100 0 47 0 111 0 114 0 32 0 111 0 116 0 104 0 101 0 114 0 32 0 99 0 111 0 117 0 110 0 116 0 114 0 105 0 101 0 115 0 46 0 65 0 100 0 111 0 98 0 101 0 32 0 83 0 121 0 115 0 116 0 101 0 109 0 115 0 32 0 73 0 110 0 99 0 111 0 114 0 112 0 111 0 114 0 97 0 116 0 101 0 100 0 80 0 97 0 117 0 108 0 32 0 68 0 46 0 32 0 72 0 117 0 110 0 116 0 104 0 116 0 116 0 112 0 58 0 47 0 47 0 119 0 119 0 119 0 46 0 97 0 100 0 111 0 98 0 101 0 46 0 99 0 111 0 109 0 47 0 116 0 121 0 112 0 101 0 67 0 111 0 112 0 121 0 114 0 105 0 103 0 104 0 116 0 32 0 50 0 48 0 49 0 48 0 44 0 32 0 50 0 48 0 49 0 50 0 32 0 65 0 100 0 111 0 98 0 101 0 32 0 83 0 121 0 115 0 116 0 101 0 109 0 115 0 32 0 73 0 110 0 99 0 111 0 114 0 112 0 111 0 114 0 97 0 116 0 101 0 100 0 32 0 40 0 104 0 116 0 116 0 112 0 58 0 47 0 47 0 119 0 119 0 119 0 46 0 97 0 100 0 111 0 98 0 101 0 46 0 99 0 111 0 109 0 47 0 41 0 44 0 32 0 119 0 105 0 116 0 104 0 32 0 82 0 101 0 115 0 101 0 114 0 118 0 101 0 100 0 32 0 70 0 111 0 110 0 116 0 32 0 78 0 97 0 109 0 101 0 32 0 39 0 83 0 111 0 117 0 114 0 99 0 101 0 39 0 46 0 32 0 65 0 108 0 108 0 32 0 82 0 105 0 103 0 104 0 116 0 115 0 32 0 82 0 101 0 115 0 101 0 114 0 118 0 101 0 100 0 46 0 32 0 83 0 111 0 117 0 114 0 99 0 101 0 32 0 105 0 115 0 32 0 97 0 32 0 116 0 114 0 97 0 100 0 101 0 109 0 97 0 114 0 107 0 32 0 111 0 102 0 32 0 65 0 100 0 111 0 98 0 101 0 32 0 83 0 121 0 115 0 116 0 101 0 109 0 115 0 32 0 73 0 110 0 99 0 111 0 114 0 112 0 111 0 114 0 97 0 116 0 101 0 100 0 32 0 105 0 110 0 32 0 116 0 104 0 101 0 32 0 85 0 110 0 105 0 116 0 101 0 100 0 32 0 83 0 116 0 97 0 116 0 101 0 115 0 32 0 97 0 110 0 100 0 47 0 111 0 114 0 32 0 111 0 116 0 104 0 101 0 114 0 32 0 99 0 111 0 117 0 110 0 116 0 114 0 105 0 101 0 115 0 46 0 13 0 10 0 13 0 10 0 84 0 104 0 105 0 115 0 32 0 70 0 111 0 110 0 116 0 32 0 83 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 32 0 105 0 115 0 32 0 108 0 105 0 99 0 101 0 110 0 115 0 101 0 100 0 32 0 117 0 110 0 100 0 101 0 114 0 32 0 116 0 104 0 101 0 32 0 83 0 73 0 76 0 32 0 79 0 112 0 101 0 110 0 32 0 70 0 111 0 110 0 116 0 32 0 76 0 105 0 99 0 101 0 110 0 115 0 101 0 44 0 32 0 86 0 101 0 114 0 115 0 105 0 111 0 110 0 32 0 49 0 46 0 49 0 46 0 13 0 10 0 13 0 10 0 84 0 104 0 105 0 115 0 32 0 108 0 105 0 99 0 101 0 110 0 115 0 101 0 32 0 105 0 115 0 32 0 99 0 111 0 112 0 105 0 101 0 100 0 32 0 98 0 101 0 108 0 111 0 119 0 44 0 32 0 97 0 110 0 100 0 32 0 105 0 115 0 32 0 97 0 108 0 115 0 111 0 32 0 97 0 118 0 97 0 105 0 108 0 97 0 98 0 108 0 101 0 32 0 119 0 105 0 116 0 104 0 32 0 97 0 32 0 70 0 65 0 81 0 32 0 97 0 116 0 58 0 32 0 104 0 116 0 116 0 112 0 58 0 47 0 47 0 115 0 99 0 114 0 105 0 112 0 116 0 115 0 46 0 115 0 105 0 108 0 46 0 111 0 114 0 103 0 47 0 79 0 70 0 76 0 13 0 10 0 13 0 10 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 13 0 10 0 83 0 73 0 76 0 32 0 79 0 80 0 69 0 78 0 32 0 70 0 79 0 78 0 84 0 32 0 76 0 73 0 67 0 69 0 78 0 83 0 69 0 32 0 86 0 101 0 114 0 115 0 105 0 111 0 110 0 32 0 49 0 46 0 49 0 32 0 45 0 32 0 50 0 54 0 32 0 70 0 101 0 98 0 114 0 117 0 97 0 114 0 121 0 32 0 50 0 48 0 48 0 55 0 13 0 10 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 45 0 13 0 10 0 13 0 10 0 80 0 82 0 69 0 65 0 77 0 66 0 76 0 69 0 13 0 10 0 84 0 104 0 101 0 32 0 103 0 111 0 97 0 108 0 115 0 32 0 111 0 102 0 32 0 116 0 104 0 101 0 32 0 79 0 112 0 101 0 110 0 32 0 70 0 111 0 110 0 116 0 32 0 76 0 105 0 99 0 101 0 110 0 115 0 101 0 32 0 40 0 79 0 70 0 76 0 41 0 32 0 97 0 114 0 101 0 32 0 116 0 111 0 32 0 115 0 116 0 105 0 109 0 117 0 108 0 97 0 116 0 101 0 32 0 119 0 111 0 114 0 108 0 100 0 119 0 105 0 100 0 101 0 32 0 100 0 101 0 118 0 101 0 108 0 111 0 112 0 109 0 101 0 110 0 116 0 32 0 111 0 102 0 32 0 99 0 111 0 108 0 108 0 97 0 98 0 111 0 114 0 97 0 116 0 105 0 118 0 101 0 32 0 102 0 111 0 110 0 116 0 32 0 112 0 114 0 111 0 106 0 101 0 99 0 116 0 115 0 44 0 32 0 116 0 111 0 32 0 115 0 117 0 112 0 112 0 111 0 114 0 116 0 32 0 116 0 104 0 101 0 32 0 102 0 111 0 110 0 116 0 32 0 99 0 114 0 101 0 97 0 116 0 105 0 111 0 110 0 32 0 101 0 102 0 102 0 111 0 114 0 116 0 115 0 32 0 111 0 102 0 32 0 97 0 99 0 97 0 100 0 101 0 109 0 105 0 99 0 32 0 97 0 110 0 100 0 32 0 108 0 105 0 110 0 103 0 117 0 105 0 115 0 116 0 105 0 99 0 32 0 99 0 111 0 109 0 109 0 117 0 110 0 105 0 116 0 105 0 101 0 115 0 44 0 32 0 97 0 110 0 100 0 32 0 116 0 111 0 32 0 112 0 114 0 111 0 118 0 105 0 100 0 101 0 32 0 97 0 32 0 102 0 114 0 101 0 101 0 32 0 97 0 110 0 100 0 32 0 111 0 112 0 101 0 110 0 32 0 102 0 114 0 97 0 109 0 101 0 119 0 111 0 114 0 107 0 32 0 105 0 110 0 32 0 119 0 104 0 105 0 99 0 104 0 32 0 102 0 111 0 110 0 116 0 115 0 32 0 109 0 97 0 121 0 32 0 98 0 101 0 32 0 115 0 104 0 97 0 114 0 101 0 100 0 32 0 97 0 110 0 100 0 32 0 105 0 109 0 112 0 114 0 111 0 118 0 101 0 100 0 32 0 105 0 110 0 32 0 112 0 97 0 114 0 116 0 110 0 101 0 114 0 115 0 104 0 105 0 112 0 32 0 119 0 105 0 116 0 104 0 32 0 111 0 116 0 104 0 101 0 114 0 115 0 46 0 13 0 10 0 13 0 10 0 84 0 104 0 101 0 32 0 79 0 70 0 76 0 32 0 97 0 108 0 108 0 111 0 119 0 115 0 32 0 116 0 104 0 101 0 32 0 108 0 105 0 99 0 101 0 110 0 115 0 101 0 100 0 32 0 102 0 111 0 110 0 116 0 115 0 32 0 116 0 111 0 32 0 98 0 101 0 32 0 117 0 115 0 101 0 100 0 44 0 32 0 115 0 116 0 117 0 100 0 105 0 101 0 100 0 44 0 32 0 109 0 111 0 100 0 105 0 102 0 105 0 101 0 100 0 32 0 97 0 110 0 100 0 32 0 114 0 101 0 100 0 105 0 115 0 116 0 114 0 105 0 98 0 117 0 116 0 101 0 100 0 32 0 102 0 114 0 101 0 101 0 108 0 121 0 32 0 97 0 115 0 32 0 108 0 111 0 110 0 103 0 32 0 97 0 115 0 32 0 116 0 104 0 101 0 121 0 32 0 97 0 114 0 101 0 32 0 110 0 111 0 116 0 32 0 115 0 111 0 108 0 100 0 32 0 98 0 121 0 32 0 116 0 104 0 101 0 109 0 115 0 101 0 108 0 118 0 101 0 115 0 46 0 32 0 84 0 104 0 101 0 32 0 102 0 111 0 110 0 116 0 115 0 44 0 32 0 105 0 110 0 99 0 108 0 117 0 100 0 105 0 110 0 103 0 32 0 97 0 110 0 121 0 32 0 100 0 101 0 114 0 105 0 118 0 97 0 116 0 105 0 118 0 101 0 32 0 119 0 111 0 114 0 107 0 115 0 44 0 32 0 99 0 97 0 110 0 32 0 98 0 101 0 32 0 98 0 117 0 110 0 100 0 108 0 101 0 100 0 44 0 32 0 101 0 109 0 98 0 101 0 100 0 100 0 101 0 100 0 44 0 32 0 114 0 101 0 100 0 105 0 115 0 116 0 114 0 105 0 98 0 117 0 116 0 101 0 100 0 32 0 97 0 110 0 100 0 47 0 111 0 114 0 32 0 115 0 111 0 108 0 100 0 32 0 119 0 105 0 116 0 104 0 32 0 97 0 110 0 121 0 32 0 115 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 32 0 112 0 114 0 111 0 118 0 105 0 100 0 101 0 100 0 32 0 116 0 104 0 97 0 116 0 32 0 97 0 110 0 121 0 32 0 114 0 101 0 115 0 101 0 114 0 118 0 101 0 100 0 32 0 110 0 97 0 109 0 101 0 115 0 32 0 97 0 114 0 101 0 32 0 110 0 111 0 116 0 32 0 117 0 115 0 101 0 100 0 32 0 98 0 121 0 32 0 100 0 101 0 114 0 105 0 118 0 97 0 116 0 105 0 118 0 101 0 32 0 119 0 111 0 114 0 107 0 115 0 46 0 32 0 84 0 104 0 101 0 32 0 102 0 111 0 110 0 116 0 115 0 32 0 97 0 110 0 100 0 32 0 100 0 101 0 114 0 105 0 118 0 97 0 116 0 105 0 118 0 101 0 115 0 44 0 32 0 104 0 111 0 119 0 101 0 118 0 101 0 114 0 44 0 32 0 99 0 97 0 110 0 110 0 111 0 116 0 32 0 98 0 101 0 32 0 114 0 101 0 108 0 101 0 97 0 115 0 101 0 100 0 32 0 117 0 110 0 100 0 101 0 114 0 32 0 97 0 110 0 121 0 32 0 111 0 116 0 104 0 101 0 114 0 32 0 116 0 121 0 112 0 101 0 32 0 111 0 102 0 32 0 108 0 105 0 99 0 101 0 110 0 115 0 101 0 46 0 32 0 84 0 104 0 101 0 32 0 114 0 101 0 113 0 117 0 105 0 114 0 101 0 109 0 101 0 110 0 116 0 32 0 102 0 111 0 114 0 32 0 102 0 111 0 110 0 116 0 115 0 32 0 116 0 111 0 32 0 114 0 101 0 109 0 97 0 105 0 110 0 32 0 117 0 110 0 100 0 101 0 114 0 32 0 116 0 104 0 105 0 115 0 32 0 108 0 105 0 99 0 101 0 110 0 115 0 101 0 32 0 100 0 111 0 101 0 115 0 32 0 110 0 111 0 116 0 32 0 97 0 112 0 112 0 108 0 121 0 32 0 116 0 111 0 32 0 97 0 110 0 121 0 32 0 100 0 111 0 99 0 117 0 109 0 101 0 110 0 116 0 32 0 99 0 114 0 101 0 97 0 116 0 101 0 100 0 32 0 117 0 115 0 105 0 110 0 103 0 32 0 116 0 104 0 101 0 32 0 102 0 111 0 110 0 116 0 115 0 32 0 111 0 114 0 32 0 116 0 104 0 101 0 105 0 114 0 32 0 100 0 101 0 114 0 105 0 118 0 97 0 116 0 105 0 118 0 101 0 115 0 46 0 13 0 10 0 13 0 10 0 68 0 69 0 70 0 73 0 78 0 73 0 84 0 73 0 79 0 78 0 83 0 13 0 10 0 34 0 70 0 111 0 110 0 116 0 32 0 83 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 34 0 32 0 114 0 101 0 102 0 101 0 114 0 115 0 32 0 116 0 111 0 32 0 116 0 104 0 101 0 32 0 115 0 101 0 116 0 32 0 111 0 102 0 32 0 102 0 105 0 108 0 101 0 115 0 32 0 114 0 101 0 108 0 101 0 97 0 115 0 101 0 100 0 32 0 98 0 121 0 32 0 116 0 104 0 101 0 32 0 67 0 111 0 112 0 121 0 114 0 105 0 103 0 104 0 116 0 32 0 72 0 111 0 108 0 100 0 101 0 114 0 40 0 115 0 41 0 32 0 117 0 110 0 100 0 101 0 114 0 32 0 116 0 104 0 105 0 115 0 32 0 108 0 105 0 99 0 101 0 110 0 115 0 101 0 32 0 97 0 110 0 100 0 32 0 99 0 108 0 101 0 97 0 114 0 108 0 121 0 32 0 109 0 97 0 114 0 107 0 101 0 100 0 32 0 97 0 115 0 32 0 115 0 117 0 99 0 104 0 46 0 32 0 84 0 104 0 105 0 115 0 32 0 109 0 97 0 121 0 32 0 105 0 110 0 99 0 108 0 117 0 100 0 101 0 32 0 115 0 111 0 117 0 114 0 99 0 101 0 32 0 102 0 105 0 108 0 101 0 115 0 44 0 32 0 98 0 117 0 105 0 108 0 100 0 32 0 115 0 99 0 114 0 105 0 112 0 116 0 115 0 32 0 97 0 110 0 100 0 32 0 100 0 111 0 99 0 117 0 109 0 101 0 110 0 116 0 97 0 116 0 105 0 111 0 110 0 46 0 13 0 10 0 13 0 10 0 34 0 82 0 101 0 115 0 101 0 114 0 118 0 101 0 100 0 32 0 70 0 111 0 110 0 116 0 32 0 78 0 97 0 109 0 101 0 34 0 32 0 114 0 101 0 102 0 101 0 114 0 115 0 32 0 116 0 111 0 32 0 97 0 110 0 121 0 32 0 110 0 97 0 109 0 101 0 115 0 32 0 115 0 112 0 101 0 99 0 105 0 102 0 105 0 101 0 100 0 32 0 97 0 115 0 32 0 115 0 117 0 99 0 104 0 32 0 97 0 102 0 116 0 101 0 114 0 32 0 116 0 104 0 101 0 32 0 99 0 111 0 112 0 121 0 114 0 105 0 103 0 104 0 116 0 32 0 115 0 116 0 97 0 116 0 101 0 109 0 101 0 110 0 116 0 40 0 115 0 41 0 46 0 13 0 10 0 13 0 10 0 34 0 79 0 114 0 105 0 103 0 105 0 110 0 97 0 108 0 32 0 86 0 101 0 114 0 115 0 105 0 111 0 110 0 34 0 32 0 114 0 101 0 102 0 101 0 114 0 115 0 32 0 116 0 111 0 32 0 116 0 104 0 101 0 32 0 99 0 111 0 108 0 108 0 101 0 99 0 116 0 105 0 111 0 110 0 32 0 111 0 102 0 32 0 70 0 111 0 110 0 116 0 32 0 83 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 32 0 99 0 111 0 109 0 112 0 111 0 110 0 101 0 110 0 116 0 115 0 32 0 97 0 115 0 32 0 100 0 105 0 115 0 116 0 114 0 105 0 98 0 117 0 116 0 101 0 100 0 32 0 98 0 121 0 32 0 116 0 104 0 101 0 32 0 67 0 111 0 112 0 121 0 114 0 105 0 103 0 104 0 116 0 32 0 72 0 111 0 108 0 100 0 101 0 114 0 40 0 115 0 41 0 46 0 13 0 10 0 13 0 10 0 34 0 77 0 111 0 100 0 105 0 102 0 105 0 101 0 100 0 32 0 86 0 101 0 114 0 115 0 105 0 111 0 110 0 34 0 32 0 114 0 101 0 102 0 101 0 114 0 115 0 32 0 116 0 111 0 32 0 97 0 110 0 121 0 32 0 100 0 101 0 114 0 105 0 118 0 97 0 116 0 105 0 118 0 101 0 32 0 109 0 97 0 100 0 101 0 32 0 98 0 121 0 32 0 97 0 100 0 100 0 105 0 110 0 103 0 32 0 116 0 111 0 44 0 32 0 100 0 101 0 108 0 101 0 116 0 105 0 110 0 103 0 44 0 32 0 111 0 114 0 32 0 115 0 117 0 98 0 115 0 116 0 105 0 116 0 117 0 116 0 105 0 110 0 103 0 32 0 45 0 45 0 32 0 105 0 110 0 32 0 112 0 97 0 114 0 116 0 32 0 111 0 114 0 32 0 105 0 110 0 32 0 119 0 104 0 111 0 108 0 101 0 32 0 45 0 45 0 32 0 97 0 110 0 121 0 32 0 111 0 102 0 32 0 116 0 104 0 101 0 32 0 99 0 111 0 109 0 112 0 111 0 110 0 101 0 110 0 116 0 115 0 32 0 111 0 102 0 32 0 116 0 104 0 101 0 32 0 79 0 114 0 105 0 103 0 105 0 110 0 97 0 108 0 32 0 86 0 101 0 114 0 115 0 105 0 111 0 110 0 44 0 32 0 98 0 121 0 32 0 99 0 104 0 97 0 110 0 103 0 105 0 110 0 103 0 32 0 102 0 111 0 114 0 109 0 97 0 116 0 115 0 32 0 111 0 114 0 32 0 98 0 121 0 32 0 112 0 111 0 114 0 116 0 105 0 110 0 103 0 32 0 116 0 104 0 101 0 32 0 70 0 111 0 110 0 116 0 32 0 83 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 32 0 116 0 111 0 32 0 97 0 32 0 110 0 101 0 119 0 32 0 101 0 110 0 118 0 105 0 114 0 111 0 110 0 109 0 101 0 110 0 116 0 46 0 13 0 10 0 13 0 10 0 34 0 65 0 117 0 116 0 104 0 111 0 114 0 34 0 32 0 114 0 101 0 102 0 101 0 114 0 115 0 32 0 116 0 111 0 32 0 97 0 110 0 121 0 32 0 100 0 101 0 115 0 105 0 103 0 110 0 101 0 114 0 44 0 32 0 101 0 110 0 103 0 105 0 110 0 101 0 101 0 114 0 44 0 32 0 112 0 114 0 111 0 103 0 114 0 97 0 109 0 109 0 101 0 114 0 44 0 32 0 116 0 101 0 99 0 104 0 110 0 105 0 99 0 97 0 108 0 32 0 119 0 114 0 105 0 116 0 101 0 114 0 32 0 111 0 114 0 32 0 111 0 116 0 104 0 101 0 114 0 32 0 112 0 101 0 114 0 115 0 111 0 110 0 32 0 119 0 104 0 111 0 32 0 99 0 111 0 110 0 116 0 114 0 105 0 98 0 117 0 116 0 101 0 100 0 32 0 116 0 111 0 32 0 116 0 104 0 101 0 32 0 70 0 111 0 110 0 116 0 32 0 83 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 46 0 13 0 10 0 13 0 10 0 80 0 69 0 82 0 77 0 73 0 83 0 83 0 73 0 79 0 78 0 32 0 38 0 32 0 67 0 79 0 78 0 68 0 73 0 84 0 73 0 79 0 78 0 83 0 13 0 10 0 80 0 101 0 114 0 109 0 105 0 115 0 115 0 105 0 111 0 110 0 32 0 105 0 115 0 32 0 104 0 101 0 114 0 101 0 98 0 121 0 32 0 103 0 114 0 97 0 110 0 116 0 101 0 100 0 44 0 32 0 102 0 114 0 101 0 101 0 32 0 111 0 102 0 32 0 99 0 104 0 97 0 114 0 103 0 101 0 44 0 32 0 116 0 111 0 32 0 97 0 110 0 121 0 32 0 112 0 101 0 114 0 115 0 111 0 110 0 32 0 111 0 98 0 116 0 97 0 105 0 110 0 105 0 110 0 103 0 32 0 97 0 32 0 99 0 111 0 112 0 121 0 32 0 111 0 102 0 32 0 116 0 104 0 101 0 32 0 70 0 111 0 110 0 116 0 32 0 83 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 44 0 32 0 116 0 111 0 32 0 117 0 115 0 101 0 44 0 32 0 115 0 116 0 117 0 100 0 121 0 44 0 32 0 99 0 111 0 112 0 121 0 44 0 32 0 109 0 101 0 114 0 103 0 101 0 44 0 32 0 101 0 109 0 98 0 101 0 100 0 44 0 32 0 109 0 111 0 100 0 105 0 102 0 121 0 44 0 32 0 114 0 101 0 100 0 105 0 115 0 116 0 114 0 105 0 98 0 117 0 116 0 101 0 44 0 32 0 97 0 110 0 100 0 32 0 115 0 101 0 108 0 108 0 32 0 109 0 111 0 100 0 105 0 102 0 105 0 101 0 100 0 32 0 97 0 110 0 100 0 32 0 117 0 110 0 109 0 111 0 100 0 105 0 102 0 105 0 101 0 100 0 32 0 99 0 111 0 112 0 105 0 101 0 115 0 32 0 111 0 102 0 32 0 116 0 104 0 101 0 32 0 70 0 111 0 110 0 116 0 32 0 83 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 44 0 32 0 115 0 117 0 98 0 106 0 101 0 99 0 116 0 32 0 116 0 111 0 32 0 116 0 104 0 101 0 32 0 102 0 111 0 108 0 108 0 111 0 119 0 105 0 110 0 103 0 32 0 99 0 111 0 110 0 100 0 105 0 116 0 105 0 111 0 110 0 115 0 58 0 13 0 10 0 13 0 10 0 49 0 41 0 32 0 78 0 101 0 105 0 116 0 104 0 101 0 114 0 32 0 116 0 104 0 101 0 32 0 70 0 111 0 110 0 116 0 32 0 83 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 32 0 110 0 111 0 114 0 32 0 97 0 110 0 121 0 32 0 111 0 102 0 32 0 105 0 116 0 115 0 32 0 105 0 110 0 100 0 105 0 118 0 105 0 100 0 117 0 97 0 108 0 32 0 99 0 111 0 109 0 112 0 111 0 110 0 101 0 110 0 116 0 115 0 44 0 32 0 105 0 110 0 32 0 79 0 114 0 105 0 103 0 105 0 110 0 97 0 108 0 32 0 111 0 114 0 32 0 77 0 111 0 100 0 105 0 102 0 105 0 101 0 100 0 32 0 86 0 101 0 114 0 115 0 105 0 111 0 110 0 115 0 44 0 32 0 109 0 97 0 121 0 32 0 98 0 101 0 32 0 115 0 111 0 108 0 100 0 32 0 98 0 121 0 32 0 105 0 116 0 115 0 101 0 108 0 102 0 46 0 13 0 10 0 13 0 10 0 50 0 41 0 32 0 79 0 114 0 105 0 103 0 105 0 110 0 97 0 108 0 32 0 111 0 114 0 32 0 77 0 111 0 100 0 105 0 102 0 105 0 101 0 100 0 32 0 86 0 101 0 114 0 115 0 105 0 111 0 110 0 115 0 32 0 111 0 102 0 32 0 116 0 104 0 101 0 32 0 70 0 111 0 110 0 116 0 32 0 83 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 32 0 109 0 97 0 121 0 32 0 98 0 101 0 32 0 98 0 117 0 110 0 100 0 108 0 101 0 100 0 44 0 32 0 114 0 101 0 100 0 105 0 115 0 116 0 114 0 105 0 98 0 117 0 116 0 101 0 100 0 32 0 97 0 110 0 100 0 47 0 111 0 114 0 32 0 115 0 111 0 108 0 100 0 32 0 119 0 105 0 116 0 104 0 32 0 97 0 110 0 121 0 32 0 115 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 44 0 32 0 112 0 114 0 111 0 118 0 105 0 100 0 101 0 100 0 32 0 116 0 104 0 97 0 116 0 32 0 101 0 97 0 99 0 104 0 32 0 99 0 111 0 112 0 121 0 32 0 99 0 111 0 110 0 116 0 97 0 105 0 110 0 115 0 32 0 116 0 104 0 101 0 32 0 97 0 98 0 111 0 118 0 101 0 32 0 99 0 111 0 112 0 121 0 114 0 105 0 103 0 104 0 116 0 32 0 110 0 111 0 116 0 105 0 99 0 101 0 32 0 97 0 110 0 100 0 32 0 116 0 104 0 105 0 115 0 32 0 108 0 105 0 99 0 101 0 110 0 115 0 101 0 46 0 32 0 84 0 104 0 101 0 115 0 101 0 32 0 99 0 97 0 110 0 32 0 98 0 101 0 32 0 105 0 110 0 99 0 108 0 117 0 100 0 101 0 100 0 32 0 101 0 105 0 116 0 104 0 101 0 114 0 32 0 97 0 115 0 32 0 115 0 116 0 97 0 110 0 100 0 45 0 97 0 108 0 111 0 110 0 101 0 32 0 116 0 101 0 120 0 116 0 32 0 102 0 105 0 108 0 101 0 115 0 44 0 32 0 104 0 117 0 109 0 97 0 110 0 45 0 114 0 101 0 97 0 100 0 97 0 98 0 108 0 101 0 32 0 104 0 101 0 97 0 100 0 101 0 114 0 115 0 32 0 111 0 114 0 32 0 105 0 110 0 32 0 116 0 104 0 101 0 32 0 97 0 112 0 112 0 114 0 111 0 112 0 114 0 105 0 97 0 116 0 101 0 32 0 109 0 97 0 99 0 104 0 105 0 110 0 101 0 45 0 114 0 101 0 97 0 100 0 97 0 98 0 108 0 101 0 32 0 109 0 101 0 116 0 97 0 100 0 97 0 116 0 97 0 32 0 102 0 105 0 101 0 108 0 100 0 115 0 32 0 119 0 105 0 116 0 104 0 105 0 110 0 32 0 116 0 101 0 120 0 116 0 32 0 111 0 114 0 32 0 98 0 105 0 110 0 97 0 114 0 121 0 32 0 102 0 105 0 108 0 101 0 115 0 32 0 97 0 115 0 32 0 108 0 111 0 110 0 103 0 32 0 97 0 115 0 32 0 116 0 104 0 111 0 115 0 101 0 32 0 102 0 105 0 101 0 108 0 100 0 115 0 32 0 99 0 97 0 110 0 32 0 98 0 101 0 32 0 101 0 97 0 115 0 105 0 108 0 121 0 32 0 118 0 105 0 101 0 119 0 101 0 100 0 32 0 98 0 121 0 32 0 116 0 104 0 101 0 32 0 117 0 115 0 101 0 114 0 46 0 13 0 10 0 13 0 10 0 51 0 41 0 32 0 78 0 111 0 32 0 77 0 111 0 100 0 105 0 102 0 105 0 101 0 100 0 32 0 86 0 101 0 114 0 115 0 105 0 111 0 110 0 32 0 111 0 102 0 32 0 116 0 104 0 101 0 32 0 70 0 111 0 110 0 116 0 32 0 83 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 32 0 109 0 97 0 121 0 32 0 117 0 115 0 101 0 32 0 116 0 104 0 101 0 32 0 82 0 101 0 115 0 101 0 114 0 118 0 101 0 100 0 32 0 70 0 111 0 110 0 116 0 32 0 78 0 97 0 109 0 101 0 40 0 115 0 41 0 32 0 117 0 110 0 108 0 101 0 115 0 115 0 32 0 101 0 120 0 112 0 108 0 105 0 99 0 105 0 116 0 32 0 119 0 114 0 105 0 116 0 116 0 101 0 110 0 32 0 112 0 101 0 114 0 109 0 105 0 115 0 115 0 105 0 111 0 110 0 32 0 105 0 115 0 32 0 103 0 114 0 97 0 110 0 116 0 101 0 100 0 32 0 98 0 121 0 32 0 116 0 104 0 101 0 32 0 99 0 111 0 114 0 114 0 101 0 115 0 112 0 111 0 110 0 100 0 105 0 110 0 103 0 32 0 67 0 111 0 112 0 121 0 114 0 105 0 103 0 104 0 116 0 32 0 72 0 111 0 108 0 100 0 101 0 114 0 46 0 32 0 84 0 104 0 105 0 115 0 32 0 114 0 101 0 115 0 116 0 114 0 105 0 99 0 116 0 105 0 111 0 110 0 32 0 111 0 110 0 108 0 121 0 32 0 97 0 112 0 112 0 108 0 105 0 101 0 115 0 32 0 116 0 111 0 32 0 116 0 104 0 101 0 32 0 112 0 114 0 105 0 109 0 97 0 114 0 121 0 32 0 102 0 111 0 110 0 116 0 32 0 110 0 97 0 109 0 101 0 32 0 97 0 115 0 32 0 112 0 114 0 101 0 115 0 101 0 110 0 116 0 101 0 100 0 32 0 116 0 111 0 32 0 116 0 104 0 101 0 32 0 117 0 115 0 101 0 114 0 115 0 46 0 13 0 10 0 13 0 10 0 52 0 41 0 32 0 84 0 104 0 101 0 32 0 110 0 97 0 109 0 101 0 40 0 115 0 41 0 32 0 111 0 102 0 32 0 116 0 104 0 101 0 32 0 67 0 111 0 112 0 121 0 114 0 105 0 103 0 104 0 116 0 32 0 72 0 111 0 108 0 100 0 101 0 114 0 40 0 115 0 41 0 32 0 111 0 114 0 32 0 116 0 104 0 101 0 32 0 65 0 117 0 116 0 104 0 111 0 114 0 40 0 115 0 41 0 32 0 111 0 102 0 32 0 116 0 104 0 101 0 32 0 70 0 111 0 110 0 116 0 32 0 83 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 32 0 115 0 104 0 97 0 108 0 108 0 32 0 110 0 111 0 116 0 32 0 98 0 101 0 32 0 117 0 115 0 101 0 100 0 32 0 116 0 111 0 32 0 112 0 114 0 111 0 109 0 111 0 116 0 101 0 44 0 32 0 101 0 110 0 100 0 111 0 114 0 115 0 101 0 32 0 111 0 114 0 32 0 97 0 100 0 118 0 101 0 114 0 116 0 105 0 115 0 101 0 32 0 97 0 110 0 121 0 32 0 77 0 111 0 100 0 105 0 102 0 105 0 101 0 100 0 32 0 86 0 101 0 114 0 115 0 105 0 111 0 110 0 44 0 32 0 101 0 120 0 99 0 101 0 112 0 116 0 32 0 116 0 111 0 32 0 97 0 99 0 107 0 110 0 111 0 119 0 108 0 101 0 100 0 103 0 101 0 32 0 116 0 104 0 101 0 32 0 99 0 111 0 110 0 116 0 114 0 105 0 98 0 117 0 116 0 105 0 111 0 110 0 40 0 115 0 41 0 32 0 111 0 102 0 32 0 116 0 104 0 101 0 32 0 67 0 111 0 112 0 121 0 114 0 105 0 103 0 104 0 116 0 32 0 72 0 111 0 108 0 100 0 101 0 114 0 40 0 115 0 41 0 32 0 97 0 110 0 100 0 32 0 116 0 104 0 101 0 32 0 65 0 117 0 116 0 104 0 111 0 114 0 40 0 115 0 41 0 32 0 111 0 114 0 32 0 119 0 105 0 116 0 104 0 32 0 116 0 104 0 101 0 105 0 114 0 32 0 101 0 120 0 112 0 108 0 105 0 99 0 105 0 116 0 32 0 119 0 114 0 105 0 116 0 116 0 101 0 110 0 32 0 112 0 101 0 114 0 109 0 105 0 115 0 115 0 105 0 111 0 110 0 46 0 13 0 10 0 13 0 10 0 53 0 41 0 32 0 84 0 104 0 101 0 32 0 70 0 111 0 110 0 116 0 32 0 83 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 44 0 32 0 109 0 111 0 100 0 105 0 102 0 105 0 101 0 100 0 32 0 111 0 114 0 32 0 117 0 110 0 109 0 111 0 100 0 105 0 102 0 105 0 101 0 100 0 44 0 32 0 105 0 110 0 32 0 112 0 97 0 114 0 116 0 32 0 111 0 114 0 32 0 105 0 110 0 32 0 119 0 104 0 111 0 108 0 101 0 44 0 32 0 109 0 117 0 115 0 116 0 32 0 98 0 101 0 32 0 100 0 105 0 115 0 116 0 114 0 105 0 98 0 117 0 116 0 101 0 100 0 32 0 101 0 110 0 116 0 105 0 114 0 101 0 108 0 121 0 32 0 117 0 110 0 100 0 101 0 114 0 32 0 116 0 104 0 105 0 115 0 32 0 108 0 105 0 99 0 101 0 110 0 115 0 101 0 44 0 32 0 97 0 110 0 100 0 32 0 109 0 117 0 115 0 116 0 32 0 110 0 111 0 116 0 32 0 98 0 101 0 32 0 100 0 105 0 115 0 116 0 114 0 105 0 98 0 117 0 116 0 101 0 100 0 32 0 117 0 110 0 100 0 101 0 114 0 32 0 97 0 110 0 121 0 32 0 111 0 116 0 104 0 101 0 114 0 32 0 108 0 105 0 99 0 101 0 110 0 115 0 101 0 46 0 32 0 84 0 104 0 101 0 32 0 114 0 101 0 113 0 117 0 105 0 114 0 101 0 109 0 101 0 110 0 116 0 32 0 102 0 111 0 114 0 32 0 102 0 111 0 110 0 116 0 115 0 32 0 116 0 111 0 32 0 114 0 101 0 109 0 97 0 105 0 110 0 32 0 117 0 110 0 100 0 101 0 114 0 32 0 116 0 104 0 105 0 115 0 32 0 108 0 105 0 99 0 101 0 110 0 115 0 101 0 32 0 100 0 111 0 101 0 115 0 32 0 110 0 111 0 116 0 32 0 97 0 112 0 112 0 108 0 121 0 32 0 116 0 111 0 32 0 97 0 110 0 121 0 32 0 100 0 111 0 99 0 117 0 109 0 101 0 110 0 116 0 32 0 99 0 114 0 101 0 97 0 116 0 101 0 100 0 32 0 117 0 115 0 105 0 110 0 103 0 32 0 116 0 104 0 101 0 32 0 70 0 111 0 110 0 116 0 32 0 83 0 111 0 102 0 116 0 119 0 97 0 114 0 101 0 46 0 13 0 10 0 13 0 10 0 84 0 69 0 82 0 77 0 73 0 78 0 65 0 84 0 73 0 79 0 78 0 13 0 10 0 84 0 104 0 105 0 115 0 32 0 108 0 105 0 99 0 101 0 110 0 115 0 101 0 32 0 98 0 101 0 99 0 111 0 109 0 101 0 115 0 32 0 110 0 117 0 108 0 108 0 32 0 97 0 110 0 100 0 32 0 118 0 111 0 105 0 100 0 32 0 105 0 102 0 32 0 97 0 110 0 121 0 32 0 111 0 102 0 32 0 116 0 104 0 101 0 32 0 97 0 98 0 111 0 118 0 101 0 32 0 99 0 111 0 110 0 100 0 105 0 116 0 105 0 111 0 110 0 115 0 32 0 97 0 114 0 101 0 32 0 110 0 111 0 116 0 32 0 109 0 101 0 116 0 46 0 13 0 10 0 13 0 10 0 68 0 73 0 83 0 67 0 76 0 65 0 73 0 77 0 69 0 82 0 13 0 10 0 84 0 72 0 69 0 32 0 70 0 79 0 78 0 84 0 32 0 83 0 79 0 70 0 84 0 87 0 65 0 82 0 69 0 32 0 73 0 83 0 32 0 80 0 82 0 79 0 86 0 73 0 68 0 69 0 68 0 32 0 34 0 65 0 83 0 32 0 73 0 83 0 34 0 44 0 32 0 87 0 73 0 84 0 72 0 79 0 85 0 84 0 32 0 87 0 65 0 82 0 82 0 65 0 78 0 84 0 89 0 32 0 79 0 70 0 32 0 65 0 78 0 89 0 32 0 75 0 73 0 78 0 68 0 44 0 32 0 69 0 88 0 80 0 82 0 69 0 83 0 83 0 32 0 79 0 82 0 32 0 73 0 77 0 80 0 76 0 73 0 69 0 68 0 44 0 32 0 73 0 78 0 67 0 76 0 85 0 68 0 73 0 78 0 71 0 32 0 66 0 85 0 84 0 32 0 78 0 79 0 84 0 32 0 76 0 73 0 77 0 73 0 84 0 69 0 68 0 32 0 84 0 79 0 32 0 65 0 78 0 89 0 32 0 87 0 65 0 82 0 82 0 65 0 78 0 84 0 73 0 69 0 83 0 32 0 79 0 70 0 32 0 77 0 69 0 82 0 67 0 72 0 65 0 78 0 84 0 65 0 66 0 73 0 76 0 73 0 84 0 89 0 44 0 32 0 70 0 73 0 84 0 78 0 69 0 83 0 83 0 32 0 70 0 79 0 82 0 32 0 65 0 32 0 80 0 65 0 82 0 84 0 73 0 67 0 85 0 76 0 65 0 82 0 32 0 80 0 85 0 82 0 80 0 79 0 83 0 69 0 32 0 65 0 78 0 68 0 32 0 78 0 79 0 78 0 73 0 78 0 70 0 82 0 73 0 78 0 71 0 69 0 77 0 69 0 78 0 84 0 32 0 79 0 70 0 32 0 67 0 79 0 80 0 89 0 82 0 73 0 71 0 72 0 84 0 44 0 32 0 80 0 65 0 84 0 69 0 78 0 84 0 44 0 32 0 84 0 82 0 65 0 68 0 69 0 77 0 65 0 82 0 75 0 44 0 32 0 79 0 82 0 32 0 79 0 84 0 72 0 69 0 82 0 32 0 82 0 73 0 71 0 72 0 84 0 46 0 32 0 73 0 78 0 32 0 78 0 79 0 32 0 69 0 86 0 69 0 78 0 84 0 32 0 83 0 72 0 65 0 76 0 76 0 32 0 84 0 72 0 69 0 32 0 67 0 79 0 80 0 89 0 82 0 73 0 71 0 72 0 84 0 32 0 72 0 79 0 76 0 68 0 69 0 82 0 32 0 66 0 69 0 32 0 76 0 73 0 65 0 66 0 76 0 69 0 32 0 70 0 79 0 82 0 32 0 65 0 78 0 89 0 32 0 67 0 76 0 65 0 73 0 77 0 44 0 32 0 68 0 65 0 77 0 65 0 71 0 69 0 83 0 32 0 79 0 82 0 32 0 79 0 84 0 72 0 69 0 82 0 32 0 76 0 73 0 65 0 66 0 73 0 76 0 73 0 84 0 89 0 44 0 32 0 73 0 78 0 67 0 76 0 85 0 68 0 73 0 78 0 71 0 32 0 65 0 78 0 89 0 32 0 71 0 69 0 78 0 69 0 82 0 65 0 76 0 44 0 32 0 83 0 80 0 69 0 67 0 73 0 65 0 76 0 44 0 32 0 73 0 78 0 68 0 73 0 82 0 69 0 67 0 84 0 44 0 32 0 73 0 78 0 67 0 73 0 68 0 69 0 78 0 84 0 65 0 76 0 44 0 32 0 79 0 82 0 32 0 67 0 79 0 78 0 83 0 69 0 81 0 85 0 69 0 78 0 84 0 73 0 65 0 76 0 32 0 68 0 65 0 77 0 65 0 71 0 69 0 83 0 44 0 32 0 87 0 72 0 69 0 84 0 72 0 69 0 82 0 32 0 73 0 78 0 32 0 65 0 78 0 32 0 65 0 67 0 84 0 73 0 79 0 78 0 32 0 79 0 70 0 32 0 67 0 79 0 78 0 84 0 82 0 65 0 67 0 84 0 44 0 32 0 84 0 79 0 82 0 84 0 32 0 79 0 82 0 32 0 79 0 84 0 72 0 69 0 82 0 87 0 73 0 83 0 69 0 44 0 32 0 65 0 82 0 73 0 83 0 73 0 78 0 71 0 32 0 70 0 82 0 79 0 77 0 44 0 32 0 79 0 85 0 84 0 32 0 79 0 70 0 32 0 84 0 72 0 69 0 32 0 85 0 83 0 69 0 32 0 79 0 82 0 32 0 73 0 78 0 65 0 66 0 73 0 76 0 73 0 84 0 89 0 32 0 84 0 79 0 32 0 85 0 83 0 69 0 32 0 84 0 72 0 69 0 32 0 70 0 79 0 78 0 84 0 32 0 83 0 79 0 70 0 84 0 87 0 65 0 82 0 69 0 32 0 79 0 82 0 32 0 70 0 82 0 79 0 77 0 32 0 79 0 84 0 72 0 69 0 82 0 32 0 68 0 69 0 65 0 76 0 73 0 78 0 71 0 83 0 32 0 73 0 78 0 32 0 84 0 72 0 69 0 32 0 70 0 79 0 78 0 84 0 32 0 83 0 79 0 70 0 84 0 87 0 65 0 82 0 69 0 46 0 13 0 10 0 104 0 116 0 116 0 112 0 58 0 47 0 47 0 119 0 119 0 119 0 46 0 97 0 100 0 111 0 98 0 101 0 46 0 99 0 111 0 109 0 47 0 116 0 121 0 112 0 101 0 47 0 108 0 101 0 103 0 97 0 108 0 46 0 104 0 116 0 109 0 108 0 83 0 108 0 97 0 115 0 104 0 101 0 100 0 32 0 122 0 101 0 114 0 111 0 83 0 116 0 114 0 97 0 105 0 103 0 104 0 116 0 32 0 108 0 65 0 108 0 116 0 101 0 114 0 110 0 97 0 116 0 101 0 32 0 97 0 65 0 108 0 116 0 101 0 114 0 110 0 97 0 116 0 101 0 32 0 103 0 83 0 101 0 114 0 105 0 102 0 101 0 100 0 32 0 73 0 0 0 2 0 0 0 0 0 0 255 181 0 50 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4 91 0 0 1 2 1 3 0 3 0 36 0 37 0 38 0 39 0 40 0 41 0 42 0 43 0 44 0 45 0 46 0 47 0 48 0 49 0 50 0 51 0 52 0 53 0 54 0 55 0 56 0 57 0 58 0 59 0 60 0 61 0 68 0 69 0 70 0 71 0 72 0 73 0 74 0 75 0 76 0 77 0 78 0 79 0 80 0 81 0 82 0 83 0 84 0 85 0 86 0 87 0 88 0 89 0 90 0 91 0 92 0 93 0 173 0 201 0 199 0 174 0 98 1 4 1 5 0 99 1 6 1 7 1 8 1 9 1 10 1 11 1 12 1 13 1 14 1 15 1 16 1 17 1 18 1 19 0 144 0 100 0 253 1 20 0 255 1 21 1 22 1 23 1 24 1 25 0 203 0 101 0 200 1 26 0 202 1 27 1 28 1 29 1 30 1 31 1 32 1 33 1 34 1 35 1 36 1 37 1 38 1 39 0 248 1 40 1 41 1 42 1 43 1 44 1 45 1 46 1 47 1 48 0 207 0 204 0 205 1 49 0 206 1 50 0 250 1 51 1 52 1 53 1 54 1 55 1 56 1 57 1 58 1 59 1 60 1 61 1 62 1 63 0 226 1 64 1 65 1 66 0 102 1 67 1 68 1 69 1 70 0 211 0 208 0 209 0 175 0 103 1 71 1 72 1 73 1 74 1 75 1 76 1 77 1 78 1 79 1 80 0 145 0 176 1 81 1 82 1 83 1 84 1 85 1 86 1 87 1 88 1 89 1 90 1 91 1 92 1 93 1 94 1 95 0 228 1 96 1 97 1 98 1 99 1 100 1 101 1 102 1 103 1 104 1 105 0 214 0 212 0 213 1 106 0 104 1 107 1 108 1 109 1 110 1 111 1 112 1 113 1 114 1 115 1 116 1 117 1 118 1 119 1 120 1 121 1 122 1 123 1 124 1 125 1 126 1 127 1 128 1 129 0 235 1 130 0 187 1 131 1 132 1 133 1 134 1 135 0 230 1 136 1 137 0 233 0 237 1 138 0 106 0 105 0 107 0 109 0 108 1 139 1 140 0 110 1 141 1 142 1 143 1 144 1 145 1 146 1 147 1 148 1 149 1 150 1 151 1 152 1 153 1 154 0 160 0 111 0 254 1 155 1 0 1 156 1 157 1 158 1 159 1 1 0 113 0 112 0 114 1 160 0 115 1 161 1 162 1 163 1 164 1 165 1 166 1 167 1 168 1 169 1 170 1 171 1 172 1 173 0 249 1 174 1 175 1 176 1 177 1 178 1 179 1 180 1 181 1 182 0 117 0 116 0 118 1 183 0 119 1 184 1 185 1 186 1 187 1 188 1 189 0 215 1 190 1 191 1 192 1 193 1 194 1 195 1 196 1 197 1 198 1 199 0 227 1 200 1 201 1 202 0 120 1 203 1 204 1 205 1 206 1 207 0 122 0 121 0 123 0 125 0 124 1 208 1 209 1 210 1 211 1 212 1 213 1 214 1 215 1 216 1 217 0 161 0 177 1 218 1 219 1 220 1 221 1 222 1 223 1 224 1 225 1 226 1 227 1 228 1 229 1 230 1 231 1 232 0 229 1 233 1 234 1 235 1 236 0 137 1 237 1 238 1 239 1 240 1 241 1 242 0 127 0 126 0 128 1 243 0 129 1 244 1 245 1 246 1 247 1 248 1 249 1 250 1 251 1 252 1 253 1 254 1 255 2 0 2 1 2 2 2 3 2 4 2 5 2 6 2 7 2 8 2 9 2 10 0 236 2 11 0 186 2 12 2 13 2 14 2 15 2 16 0 231 2 17 2 18 0 234 0 238 2 19 2 20 2 21 2 22 2 23 0 192 0 193 2 24 2 25 2 26 2 27 2 28 2 29 2 30 2 31 2 32 2 33 2 34 2 35 2 36 2 37 2 38 2 39 2 40 2 41 2 42 2 43 2 44 2 45 2 46 2 47 2 48 2 49 2 50 2 51 2 52 2 53 2 54 2 55 2 56 2 57 2 58 2 59 2 60 2 61 2 62 2 63 2 64 2 65 2 66 2 67 2 68 2 69 2 70 2 71 2 72 2 73 2 74 2 75 2 76 2 77 0 9 0 19 0 20 0 21 0 22 0 23 0 24 0 25 0 26 0 27 0 28 2 78 2 79 2 80 2 81 2 82 2 83 2 84 2 85 2 86 2 87 2 88 2 89 2 90 2 91 2 92 2 93 2 94 2 95 2 96 2 97 2 98 2 99 2 100 2 101 2 102 2 103 2 104 2 105 2 106 2 107 0 17 0 15 0 29 0 30 0 171 0 4 0 163 0 34 0 162 0 10 0 5 0 182 0 183 0 180 0 181 0 196 0 197 0 190 0 191 0 169 0 170 0 16 2 108 0 178 0 179 2 109 2 110 0 195 0 135 0 66 0 11 0 12 0 62 0 64 0 94 0 96 0 18 0 95 0 63 0 232 0 13 0 130 0 194 0 134 0 136 0 139 2 111 0 138 0 140 2 112 0 35 2 113 0 6 2 114 2 115 2 116 2 117 2 118 2 119 2 120 2 121 2 122 2 123 2 124 2 125 2 126 2 127 2 128 2 129 2 130 2 131 2 132 2 133 2 134 2 135 2 136 2 137 2 138 2 139 2 140 2 141 2 142 2 143 2 144 2 145 2 146 2 147 2 148 2 149 2 150 2 151 2 152 2 153 2 154 2 155 2 156 2 157 2 158 2 159 2 160 2 161 2 162 2 163 2 164 2 165 2 166 2 167 2 168 2 169 0 157 2 170 0 158 2 171 2 172 2 173 2 174 2 175 2 176 2 177 2 178 2 179 2 180 2 181 2 182 2 183 2 184 2 185 2 186 2 187 2 188 2 189 2 190 2 191 2 192 2 193 2 194 2 195 2 196 2 197 2 198 2 199 2 200 2 201 2 202 0 131 0 189 0 7 0 133 0 150 2 203 0 132 2 204 2 205 2 206 2 207 2 208 2 209 2 210 2 211 2 212 2 213 2 214 0 188 2 215 2 216 0 8 0 198 0 245 0 244 0 246 2 217 2 218 2 219 2 220 2 221 2 222 0 14 0 239 0 240 0 184 2 223 0 32 0 31 0 33 0 148 0 149 0 147 0 65 0 143 0 97 0 167 0 164 0 155 0 146 2 224 0 152 0 156 0 165 2 225 2 226 0 153 0 154 2 227 2 228 2 229 2 230 2 231 2 232 2 233 2 234 2 235 2 236 2 237 2 238 2 239 2 240 2 241 2 242 2 243 2 244 2 245 2 246 2 247 2 248 0 185 2 249 2 250 2 251 2 252 2 253 2 254 0 67 0 141 0 216 0 225 2 255 3 0 3 1 3 2 3 3 0 217 0 142 0 218 0 219 0 221 0 223 0 220 0 222 0 224 3 4 3 5 3 6 3 7 3 8 3 9 3 10 3 11 3 12 3 13 3 14 3 15 3 16 3 17 3 18 3 19 3 20 3 21 3 22 3 23 3 24 3 25 3 26 3 27 3 28 3 29 3 30 3 31 3 32 3 33 3 34 3 35 3 36 3 37 3 38 3 39 3 40 3 41 3 42 3 43 3 44 3 45 3 46 3 47 3 48 3 49 3 50 3 51 3 52 3 53 3 54 3 55 3 56 3 57 3 58 3 59 3 60 3 61 3 62 3 63 3 64 3 65 3 66 3 67 3 68 3 69 3 70 3 71 3 72 3 73 3 74 3 75 3 76 3 77 3 78 3 79 3 80 3 81 3 82 3 83 3 84 3 85 3 86 3 87 3 88 3 89 3 90 3 91 3 92 3 93 3 94 3 95 3 96 3 97 3 98 3 99 3 100 3 101 3 102 3 103 3 104 3 105 3 106 3 107 3 108 3 109 3 110 3 111 3 112 3 113 3 114 3 115 3 116 3 117 3 118 3 119 3 120 3 121 3 122 3 123 3 124 3 125 3 126 3 127 3 128 3 129 3 130 3 131 3 132 3 133 3 134 3 135 3 136 3 137 3 138 3 139 3 140 3 141 3 142 3 143 3 144 3 145 3 146 3 147 3 148 3 149 3 150 3 151 3 152 3 153 3 154 3 155 3 156 3 157 3 158 3 159 3 160 3 161 3 162 3 163 3 164 3 165 3 166 3 167 3 168 3 169 3 170 3 171 3 172 3 173 3 174 3 175 3 176 3 177 3 178 3 179 3 180 3 181 3 182 3 183 3 184 3 185 3 186 3 187 3 188 3 189 3 190 3 191 3 192 3 193 3 194 3 195 3 196 3 197 3 198 3 199 3 200 3 201 3 202 3 203 3 204 3 205 3 206 3 207 3 208 3 209 3 210 3 211 3 212 3 213 3 214 3 215 3 216 3 217 3 218 3 219 3 220 3 221 3 222 3 223 3 224 3 225 3 226 3 227 3 228 3 229 3 230 3 231 3 232 3 233 3 234 3 235 3 236 3 237 3 238 3 239 3 240 3 241 3 242 3 243 3 244 3 245 3 246 3 247 3 248 3 249 3 250 3 251 3 252 3 253 3 254 3 255 4 0 4 1 4 2 4 3 4 4 4 5 4 6 4 7 4 8 4 9 4 10 4 11 4 12 4 13 4 14 4 15 4 16 4 17 4 18 4 19 4 20 4 21 4 22 4 23 4 24 4 25 4 26 4 27 4 28 4 29 4 30 4 31 4 32 4 33 4 34 4 35 4 36 4 37 4 38 4 39 4 40 4 41 4 42 4 43 4 44 4 45 4 46 4 47 4 48 4 49 4 50 4 51 4 52 4 53 4 54 4 55 4 56 4 57 4 58 4 59 4 60 4 61 4 62 4 63 4 64 4 65 4 66 4 67 4 68 4 69 4 70 4 71 4 72 4 73 4 74 4 75 4 76 4 77 4 78 4 79 4 80 4 81 4 82 4 83 4 84 4 85 4 86 4 87 4 88 4 89 4 90 4 91 4 92 4 93 4 94 4 95 4 96 4 97 4 98 4 99 4 100 4 101 4 102 4 103 4 104 4 78 85 76 76 2 67 82 7 65 109 97 99 114 111 110 6 65 98 114 101 118 101 7 117 110 105 48 49 67 68 7 117 110 105 49 69 65 48 7 117 110 105 49 69 65 50 7 117 110 105 49 69 65 52 7 117 110 105 49 69 65 54 7 117 110 105 49 69 65 56 7 117 110 105 49 69 65 65 7 117 110 105 49 69 65 67 7 117 110 105 49 69 65 69 7 117 110 105 49 69 66 48 7 117 110 105 49 69 66 50 7 117 110 105 49 69 66 52 7 117 110 105 49 69 66 54 7 65 111 103 111 110 101 107 11 67 99 105 114 99 117 109 102 108 101 120 10 67 100 111 116 97 99 99 101 110 116 6 68 99 97 114 111 110 7 117 110 105 49 69 48 67 7 117 110 105 49 69 48 69 6 68 99 114 111 97 116 6 69 99 97 114 111 110 7 69 109 97 99 114 111 110 6 69 98 114 101 118 101 10 69 100 111 116 97 99 99 101 110 116 7 117 110 105 49 69 66 56 7 117 110 105 49 69 66 65 7 117 110 105 49 69 66 67 7 117 110 105 49 69 66 69 7 117 110 105 49 69 67 48 7 117 110 105 49 69 67 50 7 117 110 105 49 69 67 52 7 117 110 105 49 69 67 54 7 69 111 103 111 110 101 107 11 71 99 105 114 99 117 109 102 108 101 120 10 71 100 111 116 97 99 99 101 110 116 7 117 110 105 48 49 50 50 6 71 99 97 114 111 110 7 117 110 105 49 69 50 48 11 117 110 105 48 48 52 55 48 51 48 51 11 72 99 105 114 99 117 109 102 108 101 120 7 117 110 105 49 69 50 52 7 117 110 105 49 69 50 65 4 72 98 97 114 6 73 116 105 108 100 101 7 73 109 97 99 114 111 110 7 117 110 105 48 49 67 70 7 117 110 105 49 69 67 56 7 117 110 105 49 69 67 65 7 73 111 103 111 110 101 107 11 74 99 105 114 99 117 109 102 108 101 120 7 117 110 105 48 49 51 54 6 76 97 99 117 116 101 6 76 99 97 114 111 110 7 117 110 105 48 49 51 66 4 76 100 111 116 7 117 110 105 49 69 51 54 7 117 110 105 49 69 51 56 7 117 110 105 49 69 51 65 7 117 110 105 49 69 52 50 6 78 97 99 117 116 101 6 78 99 97 114 111 110 7 117 110 105 48 49 52 53 7 117 110 105 49 69 52 52 7 117 110 105 49 69 52 54 7 117 110 105 49 69 52 56 7 79 109 97 99 114 111 110 13 79 104 117 110 103 97 114 117 109 108 97 117 116 7 117 110 105 48 49 68 49 7 117 110 105 49 69 67 67 7 117 110 105 49 69 67 69 7 117 110 105 49 69 68 48 7 117 110 105 49 69 68 50 7 117 110 105 49 69 68 52 7 117 110 105 49 69 68 54 7 117 110 105 49 69 68 56 5 79 104 111 114 110 7 117 110 105 49 69 68 65 7 117 110 105 49 69 68 67 7 117 110 105 49 69 68 69 7 117 110 105 49 69 69 48 7 117 110 105 49 69 69 50 7 117 110 105 48 49 69 65 6 82 97 99 117 116 101 6 82 99 97 114 111 110 7 117 110 105 48 49 53 54 7 117 110 105 49 69 53 65 7 117 110 105 49 69 53 67 7 117 110 105 49 69 53 69 6 83 97 99 117 116 101 11 83 99 105 114 99 117 109 102 108 101 120 7 117 110 105 48 49 53 69 7 117 110 105 48 50 49 56 7 117 110 105 49 69 54 48 7 117 110 105 49 69 54 50 7 117 110 105 49 69 57 69 6 84 99 97 114 111 110 7 117 110 105 48 49 54 50 7 117 110 105 48 50 49 65 7 117 110 105 49 69 54 67 7 117 110 105 49 69 54 69 6 85 116 105 108 100 101 7 85 109 97 99 114 111 110 6 85 98 114 101 118 101 5 85 114 105 110 103 13 85 104 117 110 103 97 114 117 109 108 97 117 116 7 117 110 105 48 49 68 51 7 117 110 105 48 49 68 53 7 117 110 105 48 49 68 55 7 117 110 105 48 49 68 57 7 117 110 105 48 49 68 66 7 117 110 105 49 69 69 52 7 117 110 105 49 69 69 54 7 85 111 103 111 110 101 107 5 85 104 111 114 110 7 117 110 105 49 69 69 56 7 117 110 105 49 69 69 65 7 117 110 105 49 69 69 67 7 117 110 105 49 69 69 69 7 117 110 105 49 69 70 48 6 87 103 114 97 118 101 6 87 97 99 117 116 101 11 87 99 105 114 99 117 109 102 108 101 120 9 87 100 105 101 114 101 115 105 115 6 89 103 114 97 118 101 11 89 99 105 114 99 117 109 102 108 101 120 7 117 110 105 49 69 56 69 7 117 110 105 49 69 70 52 7 117 110 105 49 69 70 54 7 117 110 105 49 69 70 56 6 90 97 99 117 116 101 10 90 100 111 116 97 99 99 101 110 116 7 117 110 105 49 69 57 50 7 117 110 105 48 49 56 70 7 97 109 97 99 114 111 110 6 97 98 114 101 118 101 7 117 110 105 48 49 67 69 7 117 110 105 49 69 65 49 7 117 110 105 49 69 65 51 7 117 110 105 49 69 65 53 7 117 110 105 49 69 65 55 7 117 110 105 49 69 65 57 7 117 110 105 49 69 65 66 7 117 110 105 49 69 65 68 7 117 110 105 49 69 65 70 7 117 110 105 49 69 66 49 7 117 110 105 49 69 66 51 7 117 110 105 49 69 66 53 7 117 110 105 49 69 66 55 7 97 111 103 111 110 101 107 11 99 99 105 114 99 117 109 102 108 101 120 10 99 100 111 116 97 99 99 101 110 116 6 100 99 97 114 111 110 7 117 110 105 49 69 48 68 7 117 110 105 49 69 48 70 6 101 99 97 114 111 110 7 101 109 97 99 114 111 110 6 101 98 114 101 118 101 10 101 100 111 116 97 99 99 101 110 116 7 117 110 105 49 69 66 57 7 117 110 105 49 69 66 66 7 117 110 105 49 69 66 68 7 117 110 105 49 69 66 70 7 117 110 105 49 69 67 49 7 117 110 105 49 69 67 51 7 117 110 105 49 69 67 53 7 117 110 105 49 69 67 55 7 101 111 103 111 110 101 107 11 103 99 105 114 99 117 109 102 108 101 120 10 103 100 111 116 97 99 99 101 110 116 7 117 110 105 48 49 50 51 6 103 99 97 114 111 110 7 117 110 105 49 69 50 49 11 117 110 105 48 48 54 55 48 51 48 51 11 104 99 105 114 99 117 109 102 108 101 120 7 117 110 105 49 69 50 53 7 117 110 105 49 69 50 66 4 104 98 97 114 6 105 116 105 108 100 101 7 105 109 97 99 114 111 110 7 117 110 105 48 49 68 48 7 117 110 105 49 69 67 57 7 117 110 105 49 69 67 66 7 105 111 103 111 110 101 107 9 105 111 103 111 110 101 107 46 100 11 106 99 105 114 99 117 109 102 108 101 120 7 117 110 105 48 49 51 55 12 107 103 114 101 101 110 108 97 110 100 105 99 6 108 97 99 117 116 101 6 108 99 97 114 111 110 4 108 100 111 116 7 117 110 105 48 49 51 67 7 117 110 105 49 69 51 55 7 117 110 105 49 69 51 57 7 117 110 105 49 69 51 66 7 117 110 105 49 69 52 51 6 110 97 99 117 116 101 6 110 99 97 114 111 110 7 117 110 105 48 49 52 54 7 117 110 105 49 69 52 53 7 117 110 105 49 69 52 55 7 117 110 105 49 69 52 57 11 110 97 112 111 115 116 114 111 112 104 101 7 111 109 97 99 114 111 110 13 111 104 117 110 103 97 114 117 109 108 97 117 116 7 117 110 105 48 49 68 50 7 117 110 105 49 69 67 68 7 117 110 105 49 69 67 70 7 117 110 105 49 69 68 49 7 117 110 105 49 69 68 51 7 117 110 105 49 69 68 53 7 117 110 105 49 69 68 55 7 117 110 105 49 69 68 57 5 111 104 111 114 110 7 117 110 105 49 69 68 66 7 117 110 105 49 69 68 68 7 117 110 105 49 69 68 70 7 117 110 105 49 69 69 49 7 117 110 105 49 69 69 51 7 117 110 105 48 49 69 66 6 114 97 99 117 116 101 7 117 110 105 48 49 53 55 6 114 99 97 114 111 110 7 117 110 105 49 69 53 66 7 117 110 105 49 69 53 68 7 117 110 105 49 69 53 70 6 115 97 99 117 116 101 11 115 99 105 114 99 117 109 102 108 101 120 7 117 110 105 48 49 53 70 7 117 110 105 48 50 49 57 7 117 110 105 49 69 54 49 7 117 110 105 49 69 54 51 6 116 99 97 114 111 110 7 117 110 105 48 49 54 51 7 117 110 105 48 50 49 66 7 117 110 105 49 69 54 68 7 117 110 105 49 69 54 70 7 117 110 105 49 69 57 55 6 117 116 105 108 100 101 7 117 109 97 99 114 111 110 6 117 98 114 101 118 101 5 117 114 105 110 103 13 117 104 117 110 103 97 114 117 109 108 97 117 116 7 117 110 105 48 49 68 52 7 117 110 105 48 49 68 54 7 117 110 105 48 49 68 56 7 117 110 105 48 49 68 65 7 117 110 105 48 49 68 67 7 117 110 105 49 69 69 53 7 117 110 105 49 69 69 55 7 117 111 103 111 110 101 107 5 117 104 111 114 110 7 117 110 105 49 69 69 57 7 117 110 105 49 69 69 66 7 117 110 105 49 69 69 68 7 117 110 105 49 69 69 70 7 117 110 105 49 69 70 49 6 119 103 114 97 118 101 6 119 97 99 117 116 101 11 119 99 105 114 99 117 109 102 108 101 120 9 119 100 105 101 114 101 115 105 115 6 121 103 114 97 118 101 11 121 99 105 114 99 117 109 102 108 101 120 7 117 110 105 49 69 56 70 7 117 110 105 49 69 70 53 7 117 110 105 49 69 70 55 7 117 110 105 49 69 70 57 6 122 97 99 117 116 101 10 122 100 111 116 97 99 99 101 110 116 7 117 110 105 49 69 57 51 7 117 110 105 48 50 51 55 7 117 110 105 48 50 53 49 7 117 110 105 48 50 53 57 7 117 110 105 48 50 54 49 3 102 95 102 3 102 95 116 3 73 46 97 8 73 103 114 97 118 101 46 97 8 73 97 99 117 116 101 46 97 13 73 99 105 114 99 117 109 102 108 101 120 46 97 8 73 116 105 108 100 101 46 97 11 73 100 105 101 114 101 115 105 115 46 97 9 73 109 97 99 114 111 110 46 97 12 73 100 111 116 97 99 99 101 110 116 46 97 9 117 110 105 48 49 67 70 46 97 9 117 110 105 49 69 67 56 46 97 9 117 110 105 49 69 67 65 46 97 9 73 111 103 111 110 101 107 46 97 3 97 46 97 8 97 103 114 97 118 101 46 97 8 97 97 99 117 116 101 46 97 13 97 99 105 114 99 117 109 102 108 101 120 46 97 8 97 116 105 108 100 101 46 97 11 97 100 105 101 114 101 115 105 115 46 97 9 97 109 97 99 114 111 110 46 97 8 97 98 114 101 118 101 46 97 7 97 114 105 110 103 46 97 9 117 110 105 48 49 67 69 46 97 9 117 110 105 49 69 65 49 46 97 9 117 110 105 49 69 65 51 46 97 9 117 110 105 49 69 65 53 46 97 9 117 110 105 49 69 65 55 46 97 9 117 110 105 49 69 65 57 46 97 9 117 110 105 49 69 65 66 46 97 9 117 110 105 49 69 65 68 46 97 9 117 110 105 49 69 65 70 46 97 9 117 110 105 49 69 66 49 46 97 9 117 110 105 49 69 66 51 46 97 9 117 110 105 49 69 66 53 46 97 9 117 110 105 49 69 66 55 46 97 9 97 111 103 111 110 101 107 46 97 3 103 46 97 13 103 99 105 114 99 117 109 102 108 101 120 46 97 8 103 98 114 101 118 101 46 97 12 103 100 111 116 97 99 99 101 110 116 46 97 9 117 110 105 48 49 50 51 46 97 8 103 99 97 114 111 110 46 97 9 117 110 105 49 69 50 49 46 97 13 117 110 105 48 48 54 55 48 51 48 51 46 97 3 108 46 97 8 108 97 99 117 116 101 46 97 8 108 99 97 114 111 110 46 97 6 108 100 111 116 46 97 9 117 110 105 48 49 51 67 46 97 9 117 110 105 49 69 51 55 46 97 9 117 110 105 49 69 51 57 46 97 9 117 110 105 49 69 51 66 46 97 8 108 115 108 97 115 104 46 97 4 102 108 46 97 9 122 101 114 111 46 112 110 117 109 8 111 110 101 46 112 110 117 109 8 116 119 111 46 112 110 117 109 10 116 104 114 101 101 46 112 110 117 109 9 102 111 117 114 46 112 110 117 109 9 102 105 118 101 46 112 110 117 109 8 115 105 120 46 112 110 117 109 10 115 101 118 101 110 46 112 110 117 109 10 101 105 103 104 116 46 112 110 117 109 9 110 105 110 101 46 112 110 117 109 9 122 101 114 111 46 116 110 117 109 8 111 110 101 46 116 110 117 109 8 116 119 111 46 116 110 117 109 10 116 104 114 101 101 46 116 110 117 109 9 102 111 117 114 46 116 110 117 109 9 102 105 118 101 46 116 110 117 109 8 115 105 120 46 116 110 117 109 10 115 101 118 101 110 46 116 110 117 109 10 101 105 103 104 116 46 116 110 117 109 9 110 105 110 101 46 116 110 117 109 9 122 101 114 111 46 111 110 117 109 8 111 110 101 46 111 110 117 109 8 116 119 111 46 111 110 117 109 10 116 104 114 101 101 46 111 110 117 109 9 102 111 117 114 46 111 110 117 109 9 102 105 118 101 46 111 110 117 109 8 115 105 120 46 111 110 117 109 10 115 101 118 101 110 46 111 110 117 109 10 101 105 103 104 116 46 111 110 117 109 9 110 105 110 101 46 111 110 117 109 7 117 110 105 48 48 65 68 10 102 105 103 117 114 101 100 97 115 104 7 117 110 105 50 48 49 53 7 117 110 105 50 49 49 55 7 117 110 105 50 49 50 48 7 97 116 46 99 97 115 101 9 122 101 114 111 46 115 117 112 115 8 111 110 101 46 115 117 112 115 8 116 119 111 46 115 117 112 115 10 116 104 114 101 101 46 115 117 112 115 9 102 111 117 114 46 115 117 112 115 9 102 105 118 101 46 115 117 112 115 8 115 105 120 46 115 117 112 115 10 115 101 118 101 110 46 115 117 112 115 10 101 105 103 104 116 46 115 117 112 115 9 110 105 110 101 46 115 117 112 115 14 112 97 114 101 110 108 101 102 116 46 115 117 112 115 15 112 97 114 101 110 114 105 103 104 116 46 115 117 112 115 11 112 101 114 105 111 100 46 115 117 112 115 10 99 111 109 109 97 46 115 117 112 115 9 122 101 114 111 46 115 117 98 115 8 111 110 101 46 115 117 98 115 8 116 119 111 46 115 117 98 115 10 116 104 114 101 101 46 115 117 98 115 9 102 111 117 114 46 115 117 98 115 9 102 105 118 101 46 115 117 98 115 8 115 105 120 46 115 117 98 115 10 115 101 118 101 110 46 115 117 98 115 10 101 105 103 104 116 46 115 117 98 115 9 110 105 110 101 46 115 117 98 115 14 112 97 114 101 110 108 101 102 116 46 115 117 98 115 15 112 97 114 101 110 114 105 103 104 116 46 115 117 98 115 11 112 101 114 105 111 100 46 115 117 98 115 10 99 111 109 109 97 46 115 117 98 115 9 122 101 114 111 46 100 110 111 109 8 111 110 101 46 100 110 111 109 8 116 119 111 46 100 110 111 109 10 116 104 114 101 101 46 100 110 111 109 9 102 111 117 114 46 100 110 111 109 9 102 105 118 101 46 100 110 111 109 8 115 105 120 46 100 110 111 109 10 115 101 118 101 110 46 100 110 111 109 10 101 105 103 104 116 46 100 110 111 109 9 110 105 110 101 46 100 110 111 109 14 112 97 114 101 110 108 101 102 116 46 100 110 111 109 15 112 97 114 101 110 114 105 103 104 116 46 100 110 111 109 11 112 101 114 105 111 100 46 100 110 111 109 10 99 111 109 109 97 46 100 110 111 109 9 122 101 114 111 46 110 117 109 114 8 111 110 101 46 110 117 109 114 8 116 119 111 46 110 117 109 114 10 116 104 114 101 101 46 110 117 109 114 9 102 111 117 114 46 110 117 109 114 9 102 105 118 101 46 110 117 109 114 8 115 105 120 46 110 117 109 114 10 115 101 118 101 110 46 110 117 109 114 10 101 105 103 104 116 46 110 117 109 114 9 110 105 110 101 46 110 117 109 114 14 112 97 114 101 110 108 101 102 116 46 110 117 109 114 15 112 97 114 101 110 114 105 103 104 116 46 110 117 109 114 11 112 101 114 105 111 100 46 110 117 109 114 10 99 111 109 109 97 46 110 117 109 114 13 111 114 100 102 101 109 105 110 105 110 101 46 97 6 97 46 115 117 112 115 6 98 46 115 117 112 115 6 99 46 115 117 112 115 6 100 46 115 117 112 115 6 101 46 115 117 112 115 6 102 46 115 117 112 115 6 103 46 115 117 112 115 6 104 46 115 117 112 115 6 105 46 115 117 112 115 6 106 46 115 117 112 115 6 107 46 115 117 112 115 6 108 46 115 117 112 115 6 109 46 115 117 112 115 6 110 46 115 117 112 115 6 111 46 115 117 112 115 6 112 46 115 117 112 115 6 113 46 115 117 112 115 6 114 46 115 117 112 115 6 115 46 115 117 112 115 6 116 46 115 117 112 115 6 117 46 115 117 112 115 6 118 46 115 117 112 115 6 119 46 115 117 112 115 6 120 46 115 117 112 115 6 121 46 115 117 112 115 6 122 46 115 117 112 115 11 101 103 114 97 118 101 46 115 117 112 115 11 101 97 99 117 116 101 46 115 117 112 115 12 117 110 105 48 50 53 57 46 115 117 112 115 6 97 46 115 117 112 97 6 103 46 115 117 112 97 6 108 46 115 117 112 97 4 69 117 114 111 7 117 110 105 48 49 57 50 13 99 111 108 111 110 109 111 110 101 116 97 114 121 4 108 105 114 97 7 117 110 105 50 48 65 54 6 112 101 115 101 116 97 4 100 111 110 103 7 117 110 105 50 48 66 49 7 117 110 105 50 48 66 50 7 117 110 105 50 48 66 53 7 117 110 105 50 48 66 57 7 117 110 105 50 48 66 65 7 117 110 105 50 50 49 53 10 115 108 97 115 104 46 102 114 97 99 8 111 110 101 116 104 105 114 100 9 116 119 111 116 104 105 114 100 115 9 111 110 101 101 105 103 104 116 104 12 116 104 114 101 101 101 105 103 104 116 104 115 11 102 105 118 101 101 105 103 104 116 104 115 12 115 101 118 101 110 101 105 103 104 116 104 115 7 117 110 105 50 50 49 57 7 117 110 105 48 48 66 53 7 117 110 105 50 50 48 54 7 117 110 105 50 49 50 54 7 117 110 105 50 49 49 51 9 101 115 116 105 109 97 116 101 100 7 117 110 105 50 49 57 48 7 97 114 114 111 119 117 112 7 117 110 105 50 49 57 50 9 97 114 114 111 119 100 111 119 110 7 117 110 105 50 53 65 48 7 117 110 105 50 53 67 54 7 117 110 105 50 53 67 57 7 117 110 105 50 55 53 50 7 116 114 105 97 103 117 112 7 117 110 105 50 53 66 51 7 117 110 105 50 53 66 54 7 117 110 105 50 53 66 55 7 116 114 105 97 103 100 110 7 117 110 105 50 53 66 68 7 117 110 105 50 53 67 48 7 117 110 105 50 53 67 49 7 117 110 105 50 54 49 48 7 117 110 105 50 54 49 49 7 117 110 105 50 55 49 51 7 117 110 105 50 54 54 65 7 117 110 105 50 48 51 50 7 117 110 105 50 48 51 51 7 117 110 105 48 50 66 66 7 117 110 105 48 50 66 67 7 117 110 105 48 50 66 69 7 117 110 105 48 50 66 70 7 117 110 105 48 50 67 56 7 117 110 105 48 50 67 57 7 117 110 105 48 50 67 65 7 117 110 105 48 50 67 66 7 117 110 105 48 50 67 67 7 117 110 105 48 51 48 48 11 117 110 105 48 51 48 48 46 99 97 112 7 117 110 105 48 51 48 49 11 117 110 105 48 51 48 49 46 99 97 112 7 117 110 105 48 51 48 50 11 117 110 105 48 51 48 50 46 99 97 112 7 117 110 105 48 51 48 51 11 117 110 105 48 51 48 51 46 99 97 112 7 117 110 105 48 51 48 52 11 117 110 105 48 51 48 52 46 99 97 112 7 117 110 105 48 51 48 54 11 117 110 105 48 51 48 54 46 99 97 112 7 117 110 105 48 51 48 55 11 117 110 105 48 51 48 55 46 99 97 112 7 117 110 105 48 51 48 56 11 117 110 105 48 51 48 56 46 99 97 112 7 117 110 105 48 51 48 57 11 117 110 105 48 51 48 57 46 99 97 112 7 117 110 105 48 51 48 65 11 117 110 105 48 51 48 65 46 99 97 112 7 117 110 105 48 51 48 66 11 117 110 105 48 51 48 66 46 99 97 112 7 117 110 105 48 51 48 67 11 117 110 105 48 51 48 67 46 99 97 112 7 117 110 105 48 51 48 70 11 117 110 105 48 51 48 70 46 99 97 112 7 117 110 105 48 51 49 50 7 117 110 105 48 51 49 51 7 117 110 105 48 51 49 66 7 117 110 105 48 51 50 51 7 117 110 105 48 51 50 52 7 117 110 105 48 51 50 54 7 117 110 105 48 51 50 55 11 117 110 105 48 51 50 55 46 99 97 112 7 117 110 105 48 51 50 56 11 117 110 105 48 51 50 56 46 99 97 112 7 117 110 105 48 51 50 69 7 117 110 105 48 51 51 49 11 117 110 105 48 51 48 56 48 51 48 52 15 117 110 105 48 51 48 56 48 51 48 52 46 99 97 112 11 117 110 105 48 51 48 56 48 51 48 49 15 117 110 105 48 51 48 56 48 51 48 49 46 99 97 112 11 117 110 105 48 51 48 56 48 51 48 67 15 117 110 105 48 51 48 56 48 51 48 67 46 99 97 112 11 117 110 105 48 51 48 56 48 51 48 48 15 117 110 105 48 51 48 56 48 51 48 48 46 99 97 112 11 117 110 105 48 51 48 50 48 51 48 49 15 117 110 105 48 51 48 50 48 51 48 49 46 99 97 112 11 117 110 105 48 51 48 50 48 51 48 48 15 117 110 105 48 51 48 50 48 51 48 48 46 99 97 112 11 117 110 105 48 51 48 50 48 51 48 57 15 117 110 105 48 51 48 50 48 51 48 57 46 99 97 112 11 117 110 105 48 51 48 50 48 51 48 51 15 117 110 105 48 51 48 50 48 51 48 51 46 99 97 112 11 117 110 105 48 51 48 54 48 51 48 49 15 117 110 105 48 51 48 54 48 51 48 49 46 99 97 112 11 117 110 105 48 51 48 54 48 51 48 48 15 117 110 105 48 51 48 54 48 51 48 48 46 99 97 112 11 117 110 105 48 51 48 54 48 51 48 57 15 117 110 105 48 51 48 54 48 51 48 57 46 99 97 112 11 117 110 105 48 51 48 54 48 51 48 51 15 117 110 105 48 51 48 54 48 51 48 51 46 99 97 112 9 117 110 105 48 51 48 67 46 97 9 117 110 105 48 51 50 54 46 97 7 117 110 105 48 48 65 48 7 117 110 105 50 48 48 55 10 115 112 97 99 101 46 102 114 97 99 12 110 98 115 112 97 99 101 46 102 114 97 99 7 117 110 105 48 50 52 51 7 117 110 105 48 49 50 67 7 117 110 105 48 49 52 69 7 117 110 105 48 49 56 48 7 117 110 105 48 49 50 68 7 117 110 105 48 49 52 70 11 117 110 105 48 51 48 50 48 51 48 54 15 117 110 105 48 51 48 50 48 51 48 54 46 99 97 112 7 117 110 105 49 69 48 54 7 117 110 105 49 69 48 55 7 117 110 105 49 69 51 52 7 117 110 105 49 69 51 53 7 117 110 105 49 69 49 54 7 117 110 105 49 69 49 55 7 117 110 105 49 69 53 50 7 117 110 105 49 69 53 51 7 117 110 105 50 48 49 54 7 117 110 105 50 48 51 68 7 117 110 105 50 51 49 67 7 117 110 105 50 51 49 68 7 117 110 105 50 51 49 69 7 117 110 105 50 51 49 70 7 117 110 105 50 55 69 54 7 117 110 105 50 55 69 55 7 117 110 105 50 69 50 50 7 117 110 105 50 69 50 51 7 117 110 105 50 69 50 52 7 117 110 105 50 69 50 53 6 122 101 114 111 46 48 7 122 101 114 111 46 48 115 7 122 101 114 111 46 48 112 8 122 101 114 111 46 48 112 115 5 105 46 116 114 107 4 65 46 115 99 4 66 46 115 99 4 67 46 115 99 4 68 46 115 99 4 69 46 115 99 4 70 46 115 99 4 71 46 115 99 4 72 46 115 99 4 73 46 115 99 4 74 46 115 99 4 75 46 115 99 4 76 46 115 99 4 77 46 115 99 4 78 46 115 99 4 79 46 115 99 4 80 46 115 99 4 81 46 115 99 4 82 46 115 99 4 83 46 115 99 4 84 46 115 99 4 85 46 115 99 4 86 46 115 99 4 87 46 115 99 4 88 46 115 99 4 89 46 115 99 4 90 46 115 99 9 65 103 114 97 118 101 46 115 99 9 65 97 99 117 116 101 46 115 99 14 65 99 105 114 99 117 109 102 108 101 120 46 115 99 9 65 116 105 108 100 101 46 115 99 12 65 100 105 101 114 101 115 105 115 46 115 99 10 65 109 97 99 114 111 110 46 115 99 9 65 98 114 101 118 101 46 115 99 8 65 114 105 110 103 46 115 99 10 117 110 105 48 49 67 68 46 115 99 10 117 110 105 49 69 65 48 46 115 99 10 117 110 105 49 69 65 50 46 115 99 10 117 110 105 49 69 65 52 46 115 99 10 117 110 105 49 69 65 54 46 115 99 10 117 110 105 49 69 65 56 46 115 99 10 117 110 105 49 69 65 65 46 115 99 10 117 110 105 49 69 65 67 46 115 99 10 117 110 105 49 69 65 69 46 115 99 10 117 110 105 49 69 66 48 46 115 99 10 117 110 105 49 69 66 50 46 115 99 10 117 110 105 49 69 66 52 46 115 99 10 117 110 105 49 69 66 54 46 115 99 10 65 111 103 111 110 101 107 46 115 99 5 65 69 46 115 99 10 117 110 105 48 50 52 51 46 115 99 10 117 110 105 49 69 48 54 46 115 99 11 67 99 101 100 105 108 108 97 46 115 99 9 67 97 99 117 116 101 46 115 99 14 67 99 105 114 99 117 109 102 108 101 120 46 115 99 9 67 99 97 114 111 110 46 115 99 13 67 100 111 116 97 99 99 101 110 116 46 115 99 9 68 99 97 114 111 110 46 115 99 10 117 110 105 49 69 48 67 46 115 99 10 117 110 105 49 69 48 69 46 115 99 9 68 99 114 111 97 116 46 115 99 9 69 103 114 97 118 101 46 115 99 9 69 97 99 117 116 101 46 115 99 14 69 99 105 114 99 117 109 102 108 101 120 46 115 99 9 69 99 97 114 111 110 46 115 99 12 69 100 105 101 114 101 115 105 115 46 115 99 10 69 109 97 99 114 111 110 46 115 99 9 69 98 114 101 118 101 46 115 99 13 69 100 111 116 97 99 99 101 110 116 46 115 99 10 117 110 105 49 69 66 56 46 115 99 10 117 110 105 49 69 66 65 46 115 99 10 117 110 105 49 69 66 67 46 115 99 10 117 110 105 49 69 66 69 46 115 99 10 117 110 105 49 69 67 48 46 115 99 10 117 110 105 49 69 67 50 46 115 99 10 117 110 105 49 69 67 52 46 115 99 10 117 110 105 49 69 67 54 46 115 99 10 69 111 103 111 110 101 107 46 115 99 10 117 110 105 49 69 49 54 46 115 99 14 71 99 105 114 99 117 109 102 108 101 120 46 115 99 9 71 98 114 101 118 101 46 115 99 13 71 100 111 116 97 99 99 101 110 116 46 115 99 10 117 110 105 48 49 50 50 46 115 99 9 71 99 97 114 111 110 46 115 99 10 117 110 105 49 69 50 48 46 115 99 14 117 110 105 48 48 52 55 48 51 48 51 46 115 99 14 72 99 105 114 99 117 109 102 108 101 120 46 115 99 10 117 110 105 49 69 50 52 46 115 99 10 117 110 105 49 69 50 65 46 115 99 7 72 98 97 114 46 115 99 9 73 103 114 97 118 101 46 115 99 9 73 97 99 117 116 101 46 115 99 14 73 99 105 114 99 117 109 102 108 101 120 46 115 99 9 73 116 105 108 100 101 46 115 99 12 73 100 105 101 114 101 115 105 115 46 115 99 10 73 109 97 99 114 111 110 46 115 99 13 73 100 111 116 97 99 99 101 110 116 46 115 99 10 117 110 105 48 49 67 70 46 115 99 10 117 110 105 49 69 67 56 46 115 99 10 117 110 105 49 69 67 65 46 115 99 10 73 111 103 111 110 101 107 46 115 99 10 117 110 105 48 49 50 67 46 115 99 14 74 99 105 114 99 117 109 102 108 101 120 46 115 99 10 117 110 105 48 49 51 54 46 115 99 10 117 110 105 49 69 51 52 46 115 99 9 76 97 99 117 116 101 46 115 99 9 76 99 97 114 111 110 46 115 99 10 117 110 105 48 49 51 66 46 115 99 7 76 100 111 116 46 115 99 10 117 110 105 49 69 51 54 46 115 99 10 117 110 105 49 69 51 56 46 115 99 10 117 110 105 49 69 51 65 46 115 99 9 76 115 108 97 115 104 46 115 99 10 117 110 105 49 69 52 50 46 115 99 9 78 97 99 117 116 101 46 115 99 9 78 99 97 114 111 110 46 115 99 9 78 116 105 108 100 101 46 115 99 10 117 110 105 48 49 52 53 46 115 99 10 117 110 105 49 69 52 52 46 115 99 10 117 110 105 49 69 52 54 46 115 99 10 117 110 105 49 69 52 56 46 115 99 9 79 103 114 97 118 101 46 115 99 9 79 97 99 117 116 101 46 115 99 14 79 99 105 114 99 117 109 102 108 101 120 46 115 99 9 79 116 105 108 100 101 46 115 99 12 79 100 105 101 114 101 115 105 115 46 115 99 10 79 109 97 99 114 111 110 46 115 99 16 79 104 117 110 103 97 114 117 109 108 97 117 116 46 115 99 10 117 110 105 48 49 68 49 46 115 99 10 117 110 105 49 69 67 67 46 115 99 10 117 110 105 49 69 67 69 46 115 99 10 117 110 105 49 69 68 48 46 115 99 10 117 110 105 49 69 68 50 46 115 99 10 117 110 105 49 69 68 52 46 115 99 10 117 110 105 49 69 68 54 46 115 99 10 117 110 105 49 69 68 56 46 115 99 9 79 115 108 97 115 104 46 115 99 5 79 69 46 115 99 8 79 104 111 114 110 46 115 99 10 117 110 105 49 69 68 65 46 115 99 10 117 110 105 49 69 68 67 46 115 99 10 117 110 105 49 69 68 69 46 115 99 10 117 110 105 49 69 69 48 46 115 99 10 117 110 105 49 69 69 50 46 115 99 10 117 110 105 48 49 69 65 46 115 99 10 117 110 105 48 49 52 69 46 115 99 10 117 110 105 49 69 53 50 46 115 99 9 82 97 99 117 116 101 46 115 99 9 82 99 97 114 111 110 46 115 99 10 117 110 105 48 49 53 54 46 115 99 10 117 110 105 49 69 53 65 46 115 99 10 117 110 105 49 69 53 67 46 115 99 10 117 110 105 49 69 53 69 46 115 99 9 83 97 99 117 116 101 46 115 99 14 83 99 105 114 99 117 109 102 108 101 120 46 115 99 9 83 99 97 114 111 110 46 115 99 10 117 110 105 48 49 53 69 46 115 99 10 117 110 105 48 50 49 56 46 115 99 10 117 110 105 49 69 54 48 46 115 99 10 117 110 105 49 69 54 50 46 115 99 13 103 101 114 109 97 110 100 98 108 115 46 115 99 10 117 110 105 49 69 57 69 46 115 99 9 84 99 97 114 111 110 46 115 99 10 117 110 105 48 49 54 50 46 115 99 10 117 110 105 48 50 49 65 46 115 99 10 117 110 105 49 69 54 67 46 115 99 10 117 110 105 49 69 54 69 46 115 99 9 85 103 114 97 118 101 46 115 99 9 85 97 99 117 116 101 46 115 99 14 85 99 105 114 99 117 109 102 108 101 120 46 115 99 9 85 116 105 108 100 101 46 115 99 12 85 100 105 101 114 101 115 105 115 46 115 99 10 85 109 97 99 114 111 110 46 115 99 9 85 98 114 101 118 101 46 115 99 8 85 114 105 110 103 46 115 99 16 85 104 117 110 103 97 114 117 109 108 97 117 116 46 115 99 10 117 110 105 48 49 68 51 46 115 99 10 117 110 105 48 49 68 53 46 115 99 10 117 110 105 48 49 68 55 46 115 99 10 117 110 105 48 49 68 57 46 115 99 10 117 110 105 48 49 68 66 46 115 99 10 117 110 105 49 69 69 52 46 115 99 10 117 110 105 49 69 69 54 46 115 99 10 85 111 103 111 110 101 107 46 115 99 8 85 104 111 114 110 46 115 99 10 117 110 105 49 69 69 56 46 115 99 10 117 110 105 49 69 69 65 46 115 99 10 117 110 105 49 69 69 67 46 115 99 10 117 110 105 49 69 69 69 46 115 99 10 117 110 105 49 69 70 48 46 115 99 9 87 103 114 97 118 101 46 115 99 9 87 97 99 117 116 101 46 115 99 14 87 99 105 114 99 117 109 102 108 101 120 46 115 99 12 87 100 105 101 114 101 115 105 115 46 115 99 9 89 103 114 97 118 101 46 115 99 9 89 97 99 117 116 101 46 115 99 14 89 99 105 114 99 117 109 102 108 101 120 46 115 99 12 89 100 105 101 114 101 115 105 115 46 115 99 10 117 110 105 49 69 56 69 46 115 99 10 117 110 105 49 69 70 52 46 115 99 10 117 110 105 49 69 70 54 46 115 99 10 117 110 105 49 69 70 56 46 115 99 9 90 97 99 117 116 101 46 115 99 9 90 99 97 114 111 110 46 115 99 13 90 100 111 116 97 99 99 101 110 116 46 115 99 10 117 110 105 49 69 57 50 46 115 99 6 69 116 104 46 115 99 8 84 104 111 114 110 46 115 99 10 117 110 105 48 49 56 70 46 115 99 12 97 109 112 101 114 115 97 110 100 46 115 99 7 122 101 114 111 46 115 99 6 111 110 101 46 115 99 6 116 119 111 46 115 99 8 116 104 114 101 101 46 115 99 7 102 111 117 114 46 115 99 7 102 105 118 101 46 115 99 6 115 105 120 46 115 99 8 115 101 118 101 110 46 115 99 8 101 105 103 104 116 46 115 99 7 110 105 110 101 46 115 99 9 104 121 112 104 101 110 46 115 99 9 101 110 100 97 115 104 46 115 99 9 101 109 100 97 115 104 46 115 99 7 117 110 105 48 50 66 57 6 65 46 115 117 112 115 6 66 46 115 117 112 115 6 67 46 115 117 112 115 6 68 46 115 117 112 115 6 69 46 115 117 112 115 6 70 46 115 117 112 115 6 71 46 115 117 112 115 6 72 46 115 117 112 115 6 73 46 115 117 112 115 6 74 46 115 117 112 115 6 75 46 115 117 112 115 6 76 46 115 117 112 115 6 77 46 115 117 112 115 6 78 46 115 117 112 115 6 79 46 115 117 112 115 6 80 46 115 117 112 115 6 81 46 115 117 112 115 6 82 46 115 117 112 115 6 83 46 115 117 112 115 6 84 46 115 117 112 115 6 85 46 115 117 112 115 6 86 46 115 117 112 115 6 87 46 115 117 112 115 6 88 46 115 117 112 115 6 89 46 115 117 112 115 6 90 46 115 117 112 115 10 99 111 108 111 110 46 115 117 112 115 11 104 121 112 104 101 110 46 115 117 112 115 11 101 110 100 97 115 104 46 115 117 112 115 11 101 109 100 97 115 104 46 115 117 112 115 11 117 110 105 48 51 48 52 48 51 48 49 15 117 110 105 48 51 48 52 48 51 48 49 46 99 97 112 7 117 110 105 70 69 70 70 0 0 0 0 0 1 255 255 0 2 0 1 0 0 0 12 0 0 0 0 1 12 0 2 0 42 0 4 0 55 0 1 0 77 0 78 0 1 0 104 0 104 0 1 0 111 0 111 0 2 0 126 0 126 0 1 0 160 0 162 0 1 0 168 0 168 0 1 0 204 0 205 0 1 0 229 0 229 0 1 0 251 0 251 0 1 1 2 1 2 0 2 1 22 1 22 0 1 1 26 1 26 0 2 1 29 1 29 0 2 1 43 1 43 0 2 1 44 1 45 0 1 1 50 1 50 0 2 1 81 1 83 0 1 1 89 1 89 0 1 1 104 1 104 0 2 1 126 1 127 0 1 1 150 1 154 0 1 1 155 1 155 0 2 1 158 1 158 0 2 1 159 1 159 0 1 1 170 1 171 0 1 1 183 1 183 0 1 1 193 1 194 0 1 1 198 1 198 0 2 1 202 1 202 0 1 2 230 2 230 0 1 2 240 2 240 0 1 2 246 3 51 0 3 3 53 3 53 0 3 3 64 3 65 0 3 3 91 3 116 0 1 3 138 3 138 0 1 3 167 3 167 0 1 3 190 3 190 0 1 3 228 3 228 0 1 3 234 3 234 0 1 4 17 4 18 0 1 0 2 0 4 2 246 3 17 0 1 3 28 3 51 0 1 3 53 3 53 0 1 3 64 3 65 0 1 0 1 0 0 0 10 0 120 1 136 0 2 68 70 76 84 0 14 108 97 116 110 0 32 0 4 0 0 0 0 255 255 0 4 0 0 0 5 0 10 0 15 0 22 0 3 65 90 69 32 0 36 67 82 84 32 0 50 84 82 75 32 0 64 0 0 255 255 0 4 0 1 0 6 0 11 0 16 0 0 255 255 0 4 0 2 0 7 0 12 0 17 0 0 255 255 0 4 0 3 0 8 0 13 0 18 0 0 255 255 0 4 0 4 0 9 0 14 0 19 0 20 107 101 114 110 0 122 107 101 114 110 0 128 107 101 114 110 0 134 107 101 114 110 0 140 107 101 114 110 0 146 109 97 114 107 0 152 109 97 114 107 0 166 109 97 114 107 0 180 109 97 114 107 0 194 109 97 114 107 0 208 109 107 109 107 0 222 109 107 109 107 0 228 109 107 109 107 0 234 109 107 109 107 0 240 109 107 109 107 0 246 115 105 122 101 0 252 115 105 122 101 1 0 115 105 122 101 1 4 115 105 122 101 1 8 115 105 122 101 1 12 0 0 0 1 0 6 0 0 0 1 0 6 0 0 0 1 0 6 0 0 0 1 0 6 0 0 0 1 0 6 0 0 0 5 0 0 0 1 0 2 0 3 0 4 0 0 0 5 0 0 0 1 0 2 0 3 0 4 0 0 0 5 0 0 0 1 0 2 0 3 0 4 0 0 0 5 0 0 0 1 0 2 0 3 0 4 0 0 0 5 0 0 0 1 0 2 0 3 0 4 0 0 0 1 0 5 0 0 0 1 0 5 0 0 0 1 0 5 0 0 0 1 0 5 0 0 0 1 0 5 0 94 0 0 0 90 0 0 0 86 0 0 0 82 0 0 0 78 0 0 0 7 0 16 0 24 0 32 0 40 0 48 0 56 0 64 0 4 0 0 0 1 0 68 0 4 0 0 0 1 4 76 0 4 0 0 0 1 4 170 0 4 0 0 0 1 7 30 0 4 0 0 0 1 7 96 0 6 1 0 0 1 8 10 0 2 0 0 0 2 9 12 14 238 0 100 0 0 0 0 0 0 0 0 0 1 62 228 63 0 0 1 0 12 0 234 0 55 0 0 1 208 0 0 1 214 0 0 1 208 0 0 1 214 0 0 1 208 0 0 1 214 0 0 1 208 0 0 1 214 0 0 1 208 0 0 1 214 0 0 1 208 0 0 1 214 0 0 1 208 0 0 1 214 0 0 1 208 0 0 1 214 0 0 1 208 0 0 1 214 0 0 1 208 0 0 1 214 0 0 1 208 0 0 1 214 0 0 1 208 0 0 1 214 0 0 1 208 0 0 1 214 0 0 1 208 0 0 1 208 0 0 1 208 0 0 1 214 0 0 1 208 0 0 1 214 0 0 1 208 0 0 1 214 0 0 1 208 0 0 1 214 0 0 1 208 0 0 1 214 0 0 1 208 0 0 1 214 0 0 1 208 0 0 1 214 0 0 1 208 0 0 1 214 0 0 1 208 0 0 1 214 0 0 1 208 0 0 1 214 0 0 1 208 0 0 1 214 0 0 1 208 0 0 1 214 0 0 1 208 0 0 1 208 0 0 1 214 0 120 0 254 1 4 1 10 1 16 1 22 1 28 1 34 1 40 1 46 1 52 1 58 1 64 1 70 1 76 1 82 1 88 1 82 1 94 1 100 1 106 1 112 1 118 1 124 1 118 1 130 1 136 1 142 1 148 1 154 1 160 1 166 1 172 1 178 1 184 1 190 1 196 1 148 1 202 1 208 1 214 1 220 1 214 1 226 1 232 1 238 1 244 1 250 2 0 2 6 2 12 2 18 2 24 2 30 2 36 1 22 1 46 2 42 2 48 2 42 2 54 1 112 2 60 2 66 1 142 1 166 2 72 2 72 1 220 2 78 1 220 1 220 2 84 1 220 1 148 2 90 2 96 2 102 2 108 2 114 2 114 2 96 2 120 2 96 2 126 1 184 2 132 2 138 2 144 2 150 2 156 2 162 2 168 2 174 2 180 2 186 2 192 2 198 2 204 2 210 2 216 2 222 2 228 2 234 2 240 2 246 2 252 2 144 3 2 3 8 3 14 3 20 3 26 3 32 2 144 2 168 2 192 2 240 2 228 3 2 3 2 0 1 0 0 1 252 0 1 0 0 2 166 0 1 1 14 2 166 0 1 1 31 2 166 0 1 1 73 2 166 0 1 1 52 2 166 0 1 1 29 2 166 0 1 1 30 2 166 0 1 1 97 2 166 0 1 1 69 2 166 0 1 0 131 2 166 0 1 1 92 2 166 0 1 1 55 2 166 0 1 0 133 2 166 0 1 1 107 2 166 0 1 1 71 2 166 0 1 1 76 2 166 0 1 1 47 2 166 0 1 1 39 2 166 0 1 1 22 2 166 0 1 1 11 2 166 0 1 1 66 2 166 0 1 1 1 2 166 0 1 1 137 2 166 0 1 0 238 2 166 0 1 1 24 2 166 0 1 1 13 1 252 0 1 0 126 2 218 0 1 1 20 1 252 0 1 1 137 2 218 0 1 1 8 1 252 0 1 0 219 2 228 0 1 1 2 1 252 0 1 0 123 2 218 0 1 0 123 2 182 0 1 0 125 2 182 0 1 0 122 2 218 0 1 1 163 1 252 0 1 1 35 1 252 0 1 1 15 1 252 0 1 1 22 1 252 0 1 0 216 1 252 0 1 0 219 1 252 0 1 0 143 2 131 0 1 1 16 1 252 0 1 0 235 1 252 0 1 1 104 1 252 0 1 0 223 1 252 0 1 0 243 1 252 0 1 0 229 1 252 0 1 1 16 2 166 0 1 2 52 2 182 0 1 1 79 2 166 0 1 2 20 2 166 0 1 1 75 2 166 0 1 1 67 2 166 0 1 1 96 2 166 0 1 0 124 1 252 0 1 1 184 1 252 0 1 1 13 1 246 0 1 0 125 1 252 0 1 1 26 1 252 0 1 0 242 1 252 0 1 1 30 1 252 0 1 0 171 2 166 0 1 1 12 1 244 0 1 1 31 1 252 0 1 1 15 2 207 0 1 1 15 2 194 0 1 0 234 2 51 0 1 1 20 2 51 0 1 1 39 2 63 0 1 1 27 2 51 0 1 1 9 2 51 0 1 1 10 2 51 0 1 1 52 2 51 0 1 1 41 2 51 0 1 0 131 2 51 0 1 1 47 2 51 0 1 1 32 2 51 0 1 0 137 2 51 0 1 1 67 2 51 0 1 1 45 2 51 0 1 1 39 2 51 0 1 1 30 2 51 0 1 1 38 2 51 0 1 1 26 2 51 0 1 0 254 2 51 0 1 1 36 2 51 0 1 0 226 2 51 0 1 1 86 2 51 0 1 0 229 2 51 0 1 0 208 2 51 0 1 0 250 2 51 0 1 59 162 59 170 0 1 0 12 0 22 0 2 0 0 0 30 0 0 0 30 0 9 0 26 0 32 0 38 0 44 0 50 0 56 0 62 0 68 0 74 0 1 0 0 0 0 0 1 1 87 0 0 0 1 1 17 0 0 0 1 1 12 0 0 0 1 1 14 0 0 0 1 0 223 0 0 0 1 0 217 0 0 0 1 1 38 0 0 0 1 0 244 0 0 0 1 0 229 0 0 0 1 59 90 59 104 0 1 0 12 0 34 0 5 0 0 0 210 0 0 0 210 0 0 0 210 0 0 0 210 0 0 0 210 0 93 0 194 0 200 0 206 0 212 0 218 0 224 0 230 0 236 0 242 0 248 0 254 1 4 1 10 1 16 1 22 1 28 1 34 1 40 1 46 1 52 1 58 1 64 1 70 1 76 1 82 1 70 1 88 0 194 1 94 1 100 1 28 1 106 1 112 1 118 1 124 1 130 1 136 1 142 1 148 1 130 1 154 1 160 1 118 1 166 1 172 1 178 1 184 1 190 1 166 1 196 1 202 1 208 1 52 1 214 1 118 1 130 1 4 1 88 1 220 1 76 1 226 1 232 1 220 1 46 1 238 1 118 1 244 1 112 1 250 2 0 2 6 0 224 0 212 2 12 0 242 2 18 2 24 2 30 2 36 2 24 2 42 1 28 2 48 2 54 1 244 2 60 2 66 2 72 2 78 2 84 0 248 2 42 2 60 0 1 0 0 255 234 0 1 1 14 255 234 0 1 1 46 255 234 0 1 1 87 255 234 0 1 1 49 255 234 0 1 1 42 255 234 0 1 0 135 255 234 0 1 1 92 255 234 0 1 1 69 255 234 0 1 0 131 255 234 0 1 0 253 255 234 0 1 1 72 255 234 0 1 1 33 255 234 0 1 1 109 255 234 0 1 1 71 255 234 0 1 1 76 255 234 0 1 0 137 255 234 0 1 1 54 255 234 0 1 1 17 255 234 0 1 1 12 255 234 0 1 1 66 255 234 0 1 1 2 255 234 0 1 1 140 255 234 0 1 0 252 255 234 0 1 0 240 255 234 0 1 1 26 255 234 0 1 1 28 255 234 0 1 1 45 255 234 0 1 1 6 255 234 0 1 0 250 255 26 0 1 1 30 255 234 0 1 0 123 255 234 0 1 0 59 255 25 0 1 1 15 255 234 0 1 0 122 255 234 0 1 1 169 255 234 0 1 1 22 255 234 0 1 0 117 255 38 0 1 1 170 255 38 0 1 0 223 255 234 0 1 0 212 255 234 0 1 1 34 255 234 0 1 0 235 255 234 0 1 1 104 255 234 0 1 0 200 255 14 0 1 0 228 255 234 0 1 1 75 255 234 0 1 1 99 255 234 0 1 1 27 255 234 0 1 1 18 255 35 0 1 0 173 255 234 0 1 1 184 255 38 0 1 0 234 255 234 0 1 1 38 255 234 0 1 1 25 255 234 0 1 1 11 255 234 0 1 1 41 255 234 0 1 0 209 255 234 0 1 1 43 255 234 0 1 1 4 255 234 0 1 1 67 255 234 0 1 1 39 255 234 0 1 1 29 255 234 0 1 1 3 255 234 0 1 1 36 255 234 0 1 0 225 255 234 0 1 1 86 255 234 0 1 0 237 255 234 0 1 0 207 255 234 0 1 57 98 57 104 0 1 0 12 0 18 0 1 0 0 0 20 0 6 0 20 0 26 0 32 0 38 0 44 0 50 0 1 0 0 1 230 0 1 1 213 2 134 0 1 2 13 2 154 0 1 1 108 1 230 0 1 1 155 1 240 0 1 1 167 1 243 0 1 1 207 2 17 0 1 57 46 57 54 0 1 0 12 0 22 0 2 0 0 0 52 0 0 0 52 0 20 0 48 0 54 0 60 0 66 0 72 0 78 0 84 0 90 0 96 0 102 0 90 0 108 0 114 0 120 0 126 0 132 0 60 0 138 0 144 0 150 0 1 0 0 0 0 0 1 1 210 0 0 0 1 1 132 0 0 0 1 0 108 0 0 0 1 1 76 0 0 0 1 1 66 0 0 0 1 1 158 0 0 0 1 1 133 0 0 0 1 0 152 0 0 0 1 1 64 0 0 0 1 1 172 0 0 0 1 0 240 0 0 0 1 0 148 0 0 0 1 1 137 0 0 0 1 1 123 0 0 0 1 1 72 0 0 0 1 1 39 0 0 0 1 1 36 0 0 0 1 1 38 0 0 0 1 54 246 56 176 0 1 0 12 0 234 0 55 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 230 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 236 0 0 0 230 0 0 0 230 0 0 0 236 0 3 0 20 0 26 0 26 0 1 0 0 1 252 0 1 0 0 2 166 0 1 0 0 2 220 0 1 0 0 2 183 0 1 55 176 0 4 0 0 0 54 0 118 0 168 0 194 0 248 1 26 1 48 1 74 1 88 1 98 1 116 1 134 1 152 1 158 1 200 1 230 2 0 2 30 2 60 2 106 2 128 2 146 2 168 2 182 2 220 2 250 3 24 3 54 3 80 3 126 3 152 3 174 3 180 3 190 3 204 3 226 3 240 4 34 4 108 4 138 4 208 4 214 4 224 4 230 4 236 4 246 5 28 5 58 5 76 5 82 5 104 5 118 5 160 5 182 5 208 0 12 0 25 0 4 0 27 255 232 0 51 255 236 0 53 255 230 1 36 0 18 1 37 0 36 1 38 0 36 1 39 0 29 2 24 255 242 2 33 255 187 2 44 0 20 2 45 0 38 0 6 0 27 255 232 0 53 255 242 2 24 255 248 2 33 255 181 2 44 0 30 3 112 0 6 0 13 0 51 255 247 0 53 255 241 1 34 0 10 1 36 0 40 1 37 0 51 1 38 0 51 1 39 0 40 1 40 0 29 2 24 255 245 2 33 255 209 2 44 0 53 2 45 0 54 3 112 0 16 0 8 0 51 255 240 0 53 255 246 2 24 255 216 2 37 255 246 2 44 0 8 2 45 0 21 3 112 0 6 3 114 0 6 0 5 0 25 255 252 2 33 255 236 2 37 255 248 2 44 0 45 2 45 0 13 0 6 0 25 255 249 0 27 255 246 2 24 255 236 2 37 255 241 2 44 0 38 2 45 0 13 0 3 2 33 255 243 2 44 0 19 2 45 0 6 0 2 2 37 255 184 2 45 255 232 0 4 2 33 255 198 2 35 255 216 2 37 255 194 2 45 255 232 0 4 0 51 255 240 0 53 0 6 2 35 255 230 2 44 255 221 0 4 1 224 255 246 1 225 255 249 1 226 255 240 1 230 255 232 0 1 1 224 255 249 0 10 1 223 255 246 1 224 255 230 1 225 255 240 1 226 255 246 1 227 255 216 1 228 255 246 1 229 255 240 1 230 255 222 1 232 255 236 2 147 255 222 0 7 1 224 255 246 1 225 255 246 1 226 255 252 1 228 255 246 1 230 255 242 1 232 255 252 2 147 255 249 0 6 1 224 255 236 1 225 255 246 1 226 255 246 1 228 255 248 1 230 255 236 1 232 255 242 0 7 1 224 255 229 1 225 255 246 1 226 255 242 1 228 255 246 1 230 255 232 1 232 255 242 2 147 255 249 0 7 1 224 255 239 1 225 255 242 1 226 255 249 1 228 255 252 1 230 255 230 1 232 255 240 2 147 255 249 0 11 1 223 255 232 1 224 255 243 1 225 255 236 1 226 255 236 1 227 255 162 1 228 255 230 1 229 255 226 1 230 255 240 1 231 255 226 1 232 255 236 2 147 255 209 0 5 1 224 255 232 1 226 255 252 1 230 255 232 1 232 255 232 2 147 255 252 0 4 1 224 255 236 1 225 255 246 1 226 255 242 1 230 255 232 0 5 1 244 255 243 1 245 255 246 1 246 255 242 1 248 255 252 1 250 255 230 0 3 1 244 255 249 1 246 255 252 1 250 255 236 0 9 1 243 255 246 1 244 255 226 1 245 255 246 1 246 255 238 1 247 255 248 1 248 255 238 1 250 255 205 1 252 255 246 2 147 255 235 0 7 1 244 255 240 1 245 255 246 1 246 255 242 1 248 255 242 1 250 255 230 1 252 255 248 2 147 255 242 0 7 1 244 255 232 1 245 255 246 1 246 255 238 1 248 255 238 1 250 255 226 1 252 255 238 2 147 255 242 0 7 1 244 255 226 1 245 255 246 1 246 255 242 1 248 255 242 1 250 255 222 1 252 255 242 2 147 255 240 0 6 1 244 255 232 1 245 255 246 1 246 255 242 1 248 255 242 1 250 255 222 1 252 255 252 0 11 1 243 255 232 1 244 255 236 1 245 255 240 1 246 255 240 1 247 255 198 1 248 255 232 1 249 255 246 1 250 255 236 1 251 255 244 1 252 255 246 2 147 255 230 0 6 1 244 255 232 1 245 255 252 1 246 255 246 1 248 255 246 1 250 255 232 1 252 255 252 0 5 1 244 255 236 1 245 255 246 1 246 255 246 1 248 255 246 1 250 255 226 0 1 0 25 255 224 0 2 0 25 255 198 0 27 255 214 0 3 0 25 255 230 0 27 255 230 0 53 255 236 0 5 0 229 255 242 1 38 0 7 1 42 0 25 1 43 0 25 3 90 0 25 0 3 0 25 255 203 0 51 255 236 0 115 255 242 0 12 1 224 255 229 1 225 255 246 1 226 255 252 1 228 255 249 1 230 255 232 1 232 255 235 1 244 255 220 1 245 255 239 1 246 255 235 1 248 255 235 1 250 255 198 1 252 255 239 0 18 1 216 255 250 1 218 255 250 1 223 255 246 1 224 255 240 1 225 255 245 1 226 255 245 1 227 255 179 1 228 255 245 1 229 255 233 1 230 255 236 1 231 255 243 1 232 255 246 1 243 255 238 1 244 255 226 1 249 255 232 1 250 255 228 1 251 255 242 1 252 255 246 0 7 1 225 255 252 1 226 255 252 1 232 255 252 1 245 255 246 1 246 255 238 1 248 255 246 1 250 255 238 0 17 1 224 0 12 1 225 0 30 1 226 0 30 1 227 255 236 1 228 0 30 1 229 255 252 1 230 0 7 1 231 0 4 1 243 255 252 1 244 255 246 1 245 0 26 1 246 0 14 1 247 0 20 1 248 0 14 1 249 255 252 1 251 0 10 1 252 255 246 0 1 3 112 0 13 0 2 3 114 255 245 4 54 255 243 0 1 4 54 255 233 0 1 4 54 255 245 0 2 4 45 255 250 4 51 255 243 0 9 4 44 255 250 4 45 255 249 4 46 255 246 4 47 255 249 4 48 255 235 4 50 255 239 4 51 255 245 4 52 255 247 4 53 255 239 0 7 4 45 255 239 4 47 255 252 4 48 255 227 4 49 255 250 4 50 255 249 4 51 255 240 4 52 255 243 0 4 4 45 255 247 4 47 255 252 4 50 255 252 4 51 255 240 0 1 4 45 255 252 0 5 4 45 255 245 4 46 255 252 4 49 255 252 4 50 255 252 4 51 255 243 0 3 4 45 255 250 4 51 255 250 4 53 255 250 0 10 4 44 255 242 4 45 255 250 4 46 255 250 4 47 255 250 4 48 255 213 4 49 255 233 4 50 255 240 4 52 255 240 4 53 255 252 4 54 255 239 0 5 4 45 255 238 4 46 255 246 4 47 255 253 4 51 255 243 4 53 255 252 0 6 4 45 255 239 4 46 255 246 4 47 255 252 4 50 255 252 4 51 255 241 4 53 255 252 0 4 3 112 255 233 3 114 255 245 4 46 255 250 4 51 255 239 0 2 50 62 0 4 0 0 51 80 55 212 0 89 0 69 0 0 255 231 255 171 255 227 255 231 255 183 0 33 0 73 255 250 0 13 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 224 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 240 255 211 0 0 0 33 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 240 255 210 255 246 255 222 255 250 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 240 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 250 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 192 0 0 0 0 255 198 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 232 255 232 255 218 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 169 255 216 255 216 255 167 0 0 0 59 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 194 255 221 0 0 255 212 255 221 255 194 255 235 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 186 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 186 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 205 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 246 0 25 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 216 0 0 0 0 0 0 255 232 0 0 255 225 255 176 0 25 0 9 255 236 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 216 255 241 0 0 255 242 0 0 0 0 255 252 255 242 255 201 0 0 0 0 0 15 0 13 0 24 0 0 0 0 0 0 255 248 255 246 0 0 255 246 0 0 0 0 0 0 255 242 255 250 255 162 255 216 255 232 255 176 255 204 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 20 0 20 0 14 255 242 0 16 0 4 0 20 255 230 255 204 255 198 255 242 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 232 0 0 255 252 255 242 0 0 0 0 255 246 255 242 0 0 255 253 0 0 0 16 0 6 0 0 0 0 0 0 255 242 255 252 0 0 0 0 0 0 0 0 255 240 0 0 255 246 0 0 255 226 0 0 255 236 0 0 255 236 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6 0 4 0 16 255 250 0 10 255 252 0 0 0 0 0 0 0 0 255 242 0 6 255 246 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 242 0 0 255 252 255 252 255 252 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 13 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 252 0 0 255 252 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 238 255 242 255 252 255 249 255 236 0 0 255 246 255 242 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 232 255 246 255 227 0 0 0 0 0 0 255 246 0 0 255 242 255 246 0 0 0 0 255 204 0 14 0 20 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 252 0 0 255 252 0 15 0 0 0 0 0 0 255 242 0 7 0 0 255 230 255 242 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 252 255 245 0 0 0 0 255 250 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 243 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 242 255 248 255 249 0 0 0 0 0 0 0 9 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 236 0 0 255 252 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 13 0 13 0 0 0 0 255 252 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 228 0 0 0 0 0 8 0 15 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 19 0 0 0 11 255 242 0 19 0 0 0 13 0 0 0 0 0 0 0 0 0 14 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 240 255 242 255 246 255 240 0 0 255 246 255 240 255 236 255 238 0 26 0 0 0 9 255 249 0 6 0 0 255 246 255 242 0 0 255 234 0 0 0 0 255 249 0 0 0 0 255 230 255 242 255 236 0 0 255 210 0 0 0 15 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 15 0 16 0 8 255 244 0 9 0 0 255 249 255 249 255 236 255 238 255 236 0 20 255 240 255 226 255 246 0 0 0 0 0 0 255 242 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4 255 251 0 0 0 0 0 0 0 25 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 252 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 249 0 0 255 250 0 0 255 249 0 0 255 252 0 0 0 0 0 0 0 0 0 7 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 136 255 227 255 200 255 180 255 252 0 0 255 222 255 220 255 178 0 0 255 212 255 242 255 202 0 0 0 0 0 3 255 234 0 0 255 230 0 0 255 242 255 244 0 0 0 0 255 236 255 246 255 104 255 176 255 164 255 164 255 158 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 180 255 229 0 0 0 0 255 224 255 167 255 178 255 220 0 16 0 0 255 202 255 222 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 176 255 219 255 196 0 0 0 19 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 243 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 239 255 246 255 226 0 0 255 196 0 0 0 0 0 0 0 0 0 0 0 0 0 16 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 236 0 0 255 250 255 236 0 0 0 0 0 0 0 0 0 0 255 232 0 6 0 16 0 13 0 4 0 0 255 246 0 0 255 236 0 0 0 0 0 0 0 0 255 216 0 0 0 0 0 0 255 222 0 0 0 0 0 6 255 230 0 0 255 242 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 15 0 9 0 16 255 246 0 11 255 239 0 6 0 0 0 0 0 0 0 0 0 3 0 0 0 0 0 0 255 242 0 0 0 0 255 249 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6 0 10 0 0 255 242 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 252 0 0 0 0 0 0 0 0 0 0 0 0 255 236 0 0 0 0 255 242 255 246 0 0 0 0 0 0 0 0 0 4 0 6 0 13 0 16 0 10 0 0 255 246 255 242 255 246 0 0 255 246 0 0 255 246 255 238 0 0 0 0 0 0 255 246 0 0 255 246 0 14 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6 0 0 0 6 255 242 0 13 255 246 0 6 0 0 0 0 0 0 0 0 0 14 255 242 255 218 255 226 0 0 0 0 0 0 255 242 255 242 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 240 255 243 0 0 255 246 255 250 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 250 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 250 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 236 0 0 0 0 255 249 0 0 0 0 0 0 0 0 0 0 255 252 0 6 0 19 0 13 0 6 0 0 0 0 255 242 0 0 0 0 0 0 0 0 0 0 255 242 0 0 0 0 0 0 255 238 0 0 255 248 0 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 28 0 0 0 19 0 0 0 13 0 0 0 13 0 0 0 0 0 0 0 0 0 19 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 250 255 236 0 0 0 0 255 250 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 246 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 242 255 183 0 0 255 222 255 223 0 0 255 136 255 238 255 237 255 237 255 218 255 150 255 216 255 217 255 202 255 232 255 183 255 238 255 190 255 130 0 0 255 238 255 210 0 0 0 0 255 192 0 20 0 34 0 0 255 167 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 196 255 197 255 218 0 0 255 237 255 236 255 237 0 0 0 0 0 0 255 223 255 193 255 217 255 176 255 209 0 0 255 210 255 197 255 181 255 216 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 143 0 0 0 0 0 0 255 227 255 169 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 210 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 230 255 223 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 220 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 242 255 246 0 0 0 0 0 0 0 0 255 223 0 10 0 10 0 19 0 0 255 240 255 238 255 246 0 0 0 0 255 252 0 0 0 0 255 209 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 225 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6 0 6 0 6 255 246 0 6 255 246 0 13 0 0 0 0 0 0 0 0 255 252 255 249 0 0 0 0 0 0 0 0 255 252 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 242 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 236 0 0 0 0 0 0 0 0 0 0 0 0 255 250 0 53 0 0 0 20 0 47 0 0 255 207 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 249 0 0 0 0 0 0 0 0 255 236 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 243 0 0 0 0 0 0 0 0 255 210 0 20 0 16 0 26 0 4 255 222 0 0 255 250 255 250 255 250 255 240 0 0 0 0 255 191 0 0 0 0 0 0 0 0 0 0 0 0 0 39 0 34 0 0 255 227 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4 0 0 0 10 0 0 0 16 0 0 0 16 0 0 0 0 0 0 0 0 0 6 0 0 255 252 255 246 0 0 0 0 0 0 255 246 255 240 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 197 0 0 0 0 0 0 255 243 255 213 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 246 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 250 255 250 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 250 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 242 255 246 0 0 0 0 255 196 0 0 255 232 255 242 0 9 255 156 0 10 0 6 0 14 255 241 255 165 255 242 255 240 255 230 255 242 255 189 0 0 255 215 255 156 0 0 255 242 255 222 0 0 0 0 255 210 0 33 0 46 0 0 255 189 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 229 255 221 255 250 0 0 0 13 0 0 0 0 255 249 0 0 0 0 255 242 255 229 255 222 255 190 255 201 0 0 255 216 255 215 255 209 255 211 255 250 255 231 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 163 0 0 0 0 0 0 255 236 255 175 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 222 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 239 255 242 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 226 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 246 255 250 255 242 255 242 0 0 255 240 255 240 0 0 0 0 0 0 0 0 0 7 0 0 0 0 255 250 255 226 255 246 255 236 255 240 255 236 255 235 255 223 0 0 255 242 255 233 0 0 0 0 255 196 0 20 0 20 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 252 0 0 0 0 255 250 255 250 0 0 0 7 0 0 0 0 0 0 255 240 0 7 0 0 255 222 255 222 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 237 0 0 255 250 0 0 255 243 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 237 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 236 255 230 0 0 0 0 255 250 0 0 0 0 0 0 0 0 0 0 0 0 255 253 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 232 0 0 255 252 255 232 0 0 0 0 0 0 0 0 255 240 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 202 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 240 0 0 0 0 0 0 255 244 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 236 0 0 0 0 255 232 255 246 0 0 0 6 0 6 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 246 0 0 255 235 0 0 0 0 0 0 0 0 0 0 0 0 255 242 0 20 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 242 0 0 0 0 0 0 0 0 0 0 0 0 0 6 0 0 0 8 255 236 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 230 0 0 0 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 207 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 150 255 236 255 222 255 164 0 0 0 26 255 234 255 236 255 152 0 0 255 209 255 207 255 186 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 248 0 0 0 0 255 228 0 0 255 118 0 0 0 0 0 0 0 0 0 0 0 0 255 250 255 249 255 226 255 226 255 229 255 220 255 220 255 246 0 0 0 0 0 0 255 230 0 0 255 249 255 184 255 206 0 0 0 0 0 0 255 160 255 172 255 221 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 232 0 0 255 246 255 230 255 246 0 0 0 5 0 5 255 246 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 236 0 0 0 0 255 242 0 0 0 0 255 236 0 0 255 242 0 0 255 222 255 236 255 252 0 0 255 239 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 240 0 0 0 0 0 0 255 249 0 0 0 0 0 5 0 0 255 249 0 6 0 0 0 0 0 0 0 0 0 4 0 0 0 0 0 0 0 0 0 0 0 0 0 46 0 0 0 46 0 46 255 242 255 246 0 0 0 0 0 34 0 0 0 0 0 0 0 0 0 0 255 206 0 0 0 0 0 0 0 0 255 236 0 0 255 246 0 0 0 0 0 0 255 241 0 0 0 62 255 236 0 75 0 76 0 0 255 242 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 14 0 0 0 0 0 0 0 0 0 0 0 54 0 0 0 33 0 0 0 26 0 40 0 34 0 13 0 0 255 252 255 242 0 0 0 0 0 0 255 252 255 242 0 0 0 0 0 0 0 49 0 0 0 0 255 230 0 0 0 0 255 242 0 0 0 37 255 252 255 252 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 240 0 0 255 242 0 0 0 0 0 0 0 0 255 222 0 0 255 248 0 14 0 0 0 0 0 48 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 220 0 0 0 0 255 252 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 242 0 0 0 0 0 0 0 14 0 0 0 0 255 234 0 0 0 0 255 245 255 246 255 246 0 0 0 0 255 230 0 0 0 0 0 0 0 0 0 0 0 14 0 0 0 0 0 0 0 0 255 246 0 0 255 238 0 0 0 0 255 242 255 242 255 242 0 0 255 230 255 249 255 236 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 244 0 0 0 0 0 0 0 0 255 252 255 212 255 230 0 0 0 0 0 0 255 249 255 249 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 241 0 0 0 0 0 0 0 0 255 247 255 244 0 0 0 53 0 0 0 0 0 0 0 0 255 242 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 242 0 0 0 0 0 0 0 0 0 0 0 0 255 232 0 0 0 0 255 240 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 222 0 0 0 0 0 0 255 236 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 246 0 0 0 0 0 0 255 249 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 199 0 0 0 0 255 210 0 0 0 0 255 252 255 252 255 230 0 0 0 0 0 0 0 0 0 0 255 246 0 0 0 0 0 0 0 0 255 242 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 230 0 0 255 249 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 237 0 0 255 252 0 0 255 244 0 0 255 242 255 252 0 0 255 239 0 6 0 0 0 0 0 0 0 0 255 250 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 20 0 0 0 26 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4 0 11 0 9 0 0 0 0 255 252 0 0 0 0 0 0 0 0 0 0 255 252 0 0 0 0 0 0 0 7 0 0 0 0 0 0 0 0 0 0 0 9 255 223 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 173 255 201 0 0 0 0 0 0 255 213 255 242 255 223 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 203 255 123 0 0 0 0 0 0 0 0 0 0 255 249 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 246 255 250 0 13 0 19 255 249 0 0 0 0 0 0 0 0 0 0 255 199 255 237 0 0 255 246 0 0 255 231 0 0 255 246 255 201 0 0 0 0 0 0 0 0 0 13 255 240 0 62 0 0 0 0 255 222 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 34 0 19 0 0 0 0 255 232 255 236 0 0 0 0 255 246 255 246 0 0 0 0 0 0 0 0 0 0 0 0 255 232 0 0 0 0 255 236 0 0 0 0 0 0 0 0 255 245 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 207 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 246 0 0 0 0 0 0 255 245 0 0 0 0 0 0 0 0 0 0 0 10 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 242 0 0 0 0 255 252 255 246 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 14 0 0 0 0 0 0 0 0 255 238 0 0 255 246 0 0 0 0 0 0 255 250 0 0 0 0 255 236 0 34 0 0 0 0 0 14 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 230 0 0 0 0 0 0 0 0 0 0 255 230 255 238 0 0 0 0 0 0 0 0 0 0 0 0 0 14 0 0 0 0 0 0 255 236 0 0 0 0 255 226 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 232 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 242 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 17 0 10 0 10 0 24 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 246 0 21 0 0 0 0 0 14 0 17 0 0 0 0 0 49 0 0 0 73 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 9 0 47 0 44 0 10 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 50 0 0 0 0 255 232 0 0 0 0 255 245 0 0 255 246 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 215 255 252 0 0 0 0 0 0 255 246 0 0 255 252 255 226 0 0 0 0 0 0 255 248 0 0 0 0 0 38 0 14 0 0 255 248 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 252 0 0 255 242 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 239 0 0 0 0 0 0 0 0 0 0 0 0 255 236 0 0 0 0 255 249 0 0 255 246 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 221 0 0 0 0 0 0 0 0 255 236 0 0 255 252 255 216 0 0 0 0 0 0 0 0 0 0 0 0 0 45 0 13 0 0 255 242 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 252 0 0 255 252 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 232 0 0 0 0 0 0 0 0 0 0 0 0 255 230 0 0 0 0 255 252 255 250 0 0 0 0 255 252 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 233 0 0 255 246 0 0 0 0 0 0 255 246 0 0 0 0 255 248 0 25 0 13 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 252 0 0 0 0 255 240 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 193 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 7 255 220 255 250 255 226 255 253 0 13 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 246 255 250 255 246 0 0 255 246 0 0 0 10 0 0 0 0 0 0 0 0 0 14 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 250 255 243 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 250 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 10 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4 0 0 255 232 0 0 255 240 255 240 0 0 255 156 0 0 0 0 0 0 255 242 255 184 255 219 255 236 255 226 255 246 255 222 0 0 255 242 255 118 0 0 255 246 255 240 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 245 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 216 0 0 0 0 255 236 255 249 255 236 255 236 255 226 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 167 0 6 0 6 0 13 255 246 255 182 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 249 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 233 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 253 0 0 255 252 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 253 0 0 0 0 0 0 0 0 0 6 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6 0 13 0 13 0 28 0 9 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 16 0 6 0 13 0 0 0 19 0 0 0 23 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6 0 13 0 13 0 28 0 9 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 16 0 6 0 13 0 0 0 19 0 0 0 23 0 0 0 0 0 0 0 0 0 16 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 246 0 0 255 239 255 239 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 242 0 0 255 236 255 246 0 0 0 0 255 239 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 239 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 250 0 13 0 10 0 13 0 6 255 232 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 217 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6 0 3 0 9 0 0 0 13 0 0 0 6 0 0 0 0 0 0 0 0 0 6 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 222 0 0 0 0 0 0 0 0 255 229 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 216 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 236 255 232 255 250 255 239 255 239 255 222 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 247 0 0 255 249 0 0 0 0 0 0 0 0 255 249 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 232 0 0 0 0 255 246 255 226 0 0 0 0 0 0 0 0 255 136 0 4 0 0 0 13 0 0 255 144 255 206 255 246 255 178 0 0 255 213 0 0 255 232 255 110 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 210 0 0 255 231 255 236 255 235 0 0 255 246 255 236 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 137 255 242 0 0 0 0 255 220 255 150 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 247 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 220 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 222 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 220 0 0 0 0 0 0 0 0 255 232 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 240 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 246 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 246 0 0 0 0 255 235 0 0 255 247 255 247 0 0 255 200 0 20 0 10 0 20 0 0 255 191 255 242 255 240 255 237 255 246 255 234 0 0 255 241 255 183 255 253 0 0 255 226 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 250 0 0 0 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 252 0 0 255 237 255 235 0 0 255 236 255 244 255 231 255 237 255 250 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 193 0 0 0 0 0 0 255 240 255 196 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 246 255 240 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 246 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 236 255 246 0 0 0 0 0 0 0 0 255 242 255 240 255 249 0 20 255 249 0 6 0 13 0 6 0 0 0 3 255 242 0 0 255 239 255 246 255 240 255 249 255 251 0 0 255 240 255 246 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6 0 6 0 6 0 0 0 0 0 0 0 0 0 0 255 252 255 249 0 0 0 16 0 0 255 229 255 242 0 0 0 0 0 0 255 242 255 249 0 6 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 249 255 246 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 10 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 80 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 236 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 231 0 0 255 252 255 190 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 236 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 230 0 0 255 230 0 0 0 0 0 0 0 0 255 252 0 0 255 242 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 242 255 240 255 200 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 252 0 0 0 0 0 0 255 240 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 240 255 189 255 208 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 216 0 0 255 239 255 211 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 239 0 0 255 249 0 0 0 0 0 0 0 0 0 0 0 0 255 236 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 210 0 0 255 246 255 201 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 226 255 238 0 0 0 0 0 0 0 0 255 226 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 235 0 0 255 242 0 0 0 0 0 0 0 0 0 0 0 0 255 232 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 235 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 141 255 201 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 252 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 236 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 223 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 124 255 198 0 0 0 0 0 0 255 222 255 240 255 223 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 249 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 207 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 236 0 0 0 0 255 249 0 0 255 246 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 221 255 245 0 0 255 252 0 0 255 236 0 0 255 252 255 216 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 249 0 0 0 0 0 0 0 0 255 232 0 0 0 0 0 0 0 0 0 0 0 0 255 223 0 0 0 0 255 241 0 0 0 0 0 0 255 242 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 252 0 0 255 246 255 246 0 0 255 239 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 242 255 232 0 0 0 0 0 0 0 0 255 236 0 0 0 0 0 0 0 2 0 4 2 246 3 17 0 0 3 28 3 51 0 28 3 53 3 53 0 52 3 64 3 65 0 53 0 2 0 29 0 4 0 55 0 0 0 77 0 78 0 52 0 104 0 104 0 54 0 126 0 126 0 55 0 160 0 162 0 56 0 168 0 168 0 59 0 204 0 205 0 60 0 229 0 229 0 62 0 251 0 251 0 63 1 22 1 22 0 64 1 44 1 45 0 65 1 81 1 83 0 67 1 89 1 89 0 70 1 126 1 127 0 71 1 150 1 154 0 73 1 159 1 159 0 78 1 170 1 171 0 79 1 183 1 183 0 81 1 193 1 194 0 82 1 202 1 202 0 84 2 230 2 230 0 85 2 240 2 240 0 86 3 91 3 116 0 87 3 138 3 138 0 113 3 167 3 167 0 114 3 190 3 190 0 115 3 228 3 228 0 116 3 234 3 234 0 117 4 17 4 18 0 118 0 1 0 2 3 22 3 23 0 1 0 9 0 6 0 22 0 23 0 32 0 48 0 49 3 93 3 109 3 110 0 1 0 5 3 19 3 20 3 21 3 26 3 27 0 2 0 19 0 4 0 19 0 0 0 21 0 55 0 16 0 162 0 162 0 51 0 205 0 205 0 52 0 229 0 229 0 53 1 45 1 45 0 54 1 83 1 83 0 55 1 127 1 127 0 56 1 150 1 150 0 57 1 152 1 154 0 58 1 159 1 159 0 61 1 171 1 171 0 62 1 183 1 183 0 63 1 194 1 194 0 64 1 202 1 202 0 65 3 91 3 106 0 66 3 108 3 116 0 82 3 228 3 228 0 91 4 18 4 18 0 92 0 1 0 1 3 18 0 1 0 6 0 18 0 24 0 44 0 50 3 105 3 111 0 1 0 2 3 24 3 25 0 1 0 20 0 4 0 8 0 12 0 18 0 24 0 30 0 34 0 38 0 44 0 50 1 45 1 153 1 159 1 171 3 91 3 95 3 99 3 105 3 111 3 228 0 1 0 3 2 250 3 2 3 4 0 1 0 54 0 9 0 19 0 25 0 27 0 51 0 53 0 115 0 182 0 228 1 103 1 223 1 224 1 225 1 226 1 227 1 228 1 229 1 230 1 231 1 232 1 243 1 244 1 245 1 246 1 247 1 248 1 249 1 250 1 251 1 252 2 3 2 5 2 24 2 33 2 35 2 143 2 144 2 145 2 146 3 96 3 106 3 112 3 114 4 44 4 45 4 46 4 47 4 48 4 49 4 50 4 51 4 52 4 53 4 54 0 2 0 45 0 4 0 32 0 0 0 34 0 37 0 29 0 40 0 40 0 33 0 42 0 114 0 34 0 116 0 181 0 107 0 183 1 2 0 173 1 6 1 33 0 249 1 45 1 45 1 21 1 47 1 48 1 22 1 50 1 50 1 24 1 57 1 148 1 25 1 150 1 150 1 117 1 152 1 155 1 118 1 158 1 201 1 122 1 204 1 204 1 166 1 230 1 230 1 167 1 250 1 250 1 168 1 253 2 11 1 169 2 14 2 24 1 184 2 27 2 27 1 195 2 29 2 29 1 196 2 31 2 31 1 197 2 33 2 33 1 198 2 35 2 35 1 199 2 224 2 225 1 200 3 58 3 61 1 202 3 63 3 63 1 206 3 66 3 73 1 207 3 75 3 75 1 215 3 91 3 94 1 216 3 96 3 97 1 220 3 100 3 102 1 222 3 105 3 138 1 225 3 140 3 150 2 3 3 169 3 175 2 14 3 192 3 195 2 21 3 197 3 202 2 25 3 211 3 226 2 31 3 234 3 250 2 47 3 252 4 17 2 64 4 24 4 40 2 86 4 42 4 42 2 103 4 45 4 45 2 104 4 51 4 51 2 105 4 53 4 54 2 106 0 2 0 192 0 4 0 4 0 12 0 5 0 5 0 13 0 6 0 6 0 15 0 7 0 7 0 22 0 8 0 8 0 60 0 9 0 9 0 61 0 10 0 10 0 17 0 11 0 11 0 64 0 12 0 12 0 65 0 13 0 13 0 67 0 14 0 14 0 18 0 15 0 15 0 20 0 16 0 17 0 64 0 18 0 18 0 22 0 19 0 19 0 71 0 20 0 20 0 22 0 21 0 21 0 24 0 22 0 22 0 26 0 23 0 23 0 28 0 24 0 24 0 30 0 25 0 25 0 75 0 26 0 26 0 32 0 27 0 27 0 77 0 28 0 28 0 34 0 29 0 29 0 36 0 30 0 30 0 38 0 31 0 31 0 48 0 32 0 32 0 39 0 34 0 34 0 42 0 35 0 35 0 43 0 36 0 36 0 44 0 37 0 37 0 47 0 40 0 40 0 45 0 42 0 43 0 47 0 44 0 45 0 48 0 46 0 46 0 54 0 47 0 47 0 51 0 48 0 48 0 52 0 49 0 49 0 53 0 50 0 50 0 54 0 51 0 51 0 87 0 52 0 52 0 56 0 53 0 53 0 88 0 54 0 54 0 57 0 55 0 55 0 58 0 56 0 77 0 12 0 78 0 78 0 60 0 79 0 83 0 15 0 84 0 87 0 22 0 88 0 104 0 60 0 105 0 111 0 17 0 112 0 114 0 64 0 116 0 126 0 65 0 127 0 127 0 67 0 128 0 128 0 18 0 129 0 129 0 20 0 130 0 130 0 69 0 131 0 136 0 20 0 137 0 144 0 64 0 145 0 160 0 22 0 161 0 161 0 60 0 162 0 167 0 23 0 168 0 168 0 22 0 169 0 174 0 24 0 175 0 181 0 26 0 183 0 187 0 28 0 188 0 204 0 30 0 205 0 210 0 31 0 211 0 214 0 32 0 215 0 222 0 34 0 223 0 226 0 36 0 227 0 227 0 22 0 228 0 228 0 73 0 229 0 229 0 22 0 230 0 251 0 38 0 252 0 252 0 42 0 253 1 1 0 39 1 2 1 2 0 46 1 6 1 22 0 42 1 23 1 29 0 44 1 30 1 33 0 47 1 45 1 45 0 54 1 47 1 48 0 45 1 50 1 50 0 46 1 57 1 65 0 47 1 66 1 81 0 48 1 82 1 82 0 42 1 83 1 88 0 49 1 89 1 89 0 48 1 90 1 95 0 51 1 96 1 102 0 52 1 103 1 103 0 81 1 104 1 109 0 53 1 110 1 126 0 54 1 127 1 132 0 55 1 133 1 136 0 56 1 137 1 144 0 57 1 145 1 148 0 58 1 150 1 150 0 48 1 152 1 152 0 54 1 153 1 153 0 48 1 154 1 154 0 54 1 155 1 155 0 43 1 158 1 158 0 53 1 159 1 170 0 66 1 171 1 201 0 54 1 204 1 204 0 46 1 230 1 230 0 9 1 250 1 250 0 8 1 253 1 254 0 41 1 255 2 0 0 40 2 1 2 1 0 41 2 2 2 2 0 1 2 3 2 3 0 2 2 4 2 4 0 84 2 5 2 5 0 7 2 6 2 7 0 85 2 8 2 8 0 50 2 9 2 9 0 86 2 10 2 10 0 50 2 11 2 11 0 86 2 14 2 14 0 82 2 15 2 15 0 83 2 16 2 16 0 82 2 17 2 17 0 83 2 18 2 23 0 80 2 24 2 24 0 6 2 27 2 27 0 79 2 29 2 29 0 79 2 31 2 31 0 79 2 33 2 33 0 11 2 224 2 224 0 50 2 225 2 225 0 86 3 58 3 58 0 13 3 59 3 59 0 65 3 60 3 60 0 22 3 61 3 61 0 48 3 63 3 63 0 48 3 66 3 66 0 13 3 67 3 67 0 48 3 68 3 68 0 18 3 69 3 69 0 45 3 70 3 70 0 60 3 71 3 71 0 42 3 72 3 72 0 22 3 73 3 73 0 48 3 75 3 75 0 84 3 91 3 91 0 59 3 92 3 92 0 14 3 93 3 93 0 16 3 94 3 94 0 70 3 96 3 96 0 62 3 97 3 97 0 63 3 100 3 100 0 68 3 101 3 101 0 19 3 102 3 102 0 21 3 105 3 105 0 70 3 106 3 106 0 72 3 107 3 107 0 70 3 108 3 108 0 25 3 109 3 109 0 27 3 110 3 110 0 29 3 111 3 111 0 74 3 112 3 112 0 76 3 113 3 113 0 33 3 114 3 114 0 78 3 115 3 115 0 35 3 116 3 116 0 37 3 117 3 138 0 59 3 140 3 141 0 14 3 142 3 146 0 16 3 147 3 150 0 70 3 169 3 175 0 63 3 192 3 192 0 68 3 193 3 194 0 19 3 195 3 195 0 21 3 197 3 202 0 21 3 211 3 226 0 70 3 234 3 236 0 70 3 237 3 242 0 25 3 243 3 250 0 27 3 252 4 0 0 29 4 1 4 17 0 74 4 24 4 27 0 33 4 28 4 35 0 35 4 36 4 39 0 37 4 40 4 40 0 70 4 42 4 42 0 70 4 45 4 45 0 5 4 51 4 51 0 10 4 53 4 53 0 4 4 54 4 54 0 3 0 2 0 154 0 4 0 4 0 17 0 6 0 6 0 20 0 10 0 10 0 20 0 13 0 13 0 24 0 18 0 18 0 20 0 20 0 20 0 20 0 22 0 22 0 18 0 23 0 23 0 2 0 24 0 24 0 3 0 25 0 25 0 49 0 26 0 26 0 4 0 27 0 27 0 51 0 28 0 28 0 5 0 29 0 29 0 19 0 30 0 30 0 21 0 32 0 34 0 23 0 35 0 35 0 22 0 36 0 36 0 6 0 38 0 38 0 25 0 39 0 39 0 7 0 42 0 43 0 62 0 44 0 44 0 23 0 45 0 45 0 62 0 46 0 46 0 23 0 47 0 47 0 62 0 48 0 48 0 63 0 49 0 49 0 26 0 50 0 50 0 27 0 51 0 51 0 56 0 52 0 52 0 8 0 53 0 53 0 58 0 54 0 54 0 9 0 55 0 55 0 64 0 56 0 77 0 17 0 79 0 83 0 20 0 87 0 87 0 1 0 105 0 111 0 20 0 127 0 127 0 24 0 145 0 168 0 20 0 175 0 181 0 18 0 183 0 187 0 2 0 188 0 210 0 3 0 211 0 214 0 4 0 215 0 222 0 5 0 223 0 226 0 19 0 227 0 227 0 1 0 230 0 252 0 21 0 253 1 22 0 23 1 23 1 29 0 6 1 34 1 44 0 25 1 45 1 45 0 62 1 46 1 46 0 7 1 48 1 48 0 62 1 57 1 64 0 62 1 66 1 89 0 23 1 90 1 95 0 62 1 96 1 102 0 63 1 104 1 109 0 26 1 110 1 132 0 27 1 133 1 136 0 8 1 137 1 144 0 9 1 145 1 148 0 64 1 151 1 151 0 7 1 152 1 152 0 23 1 154 1 154 0 23 1 155 1 158 0 22 1 159 1 170 0 61 1 171 1 201 0 23 1 211 1 211 0 22 1 224 1 224 0 38 1 230 1 230 0 41 1 244 1 244 0 37 1 250 1 250 0 40 1 252 1 252 0 36 1 253 1 254 0 16 1 255 2 0 0 67 2 1 2 1 0 16 2 2 2 2 0 43 2 3 2 3 0 44 2 4 2 4 0 53 2 5 2 5 0 45 2 6 2 7 0 54 2 8 2 8 0 55 2 9 2 9 0 10 2 10 2 10 0 55 2 11 2 11 0 10 2 14 2 14 0 60 2 15 2 15 0 65 2 16 2 16 0 60 2 17 2 17 0 65 2 18 2 23 0 59 2 24 2 24 0 30 2 28 2 28 0 68 2 30 2 30 0 68 2 32 2 32 0 68 2 33 2 33 0 34 2 35 2 35 0 29 2 37 2 37 0 28 2 44 2 44 0 31 2 45 2 45 0 32 2 224 2 224 0 55 2 225 2 225 0 10 3 58 3 58 0 1 3 60 3 60 0 20 3 62 3 62 0 25 3 63 3 63 0 23 3 71 3 71 0 23 3 72 3 72 0 20 3 73 3 73 0 23 3 75 3 75 0 53 3 90 3 90 0 25 3 91 3 91 0 57 3 92 3 92 0 66 3 93 3 93 0 46 3 94 3 96 0 66 3 97 3 97 0 46 3 98 3 98 0 66 3 100 3 100 0 11 3 101 3 104 0 66 3 105 3 105 0 46 3 106 3 106 0 66 3 107 3 107 0 46 3 108 3 108 0 66 3 109 3 109 0 47 3 110 3 110 0 12 3 111 3 111 0 48 3 112 3 112 0 50 3 113 3 113 0 13 3 114 3 114 0 52 3 115 3 115 0 14 3 116 3 116 0 15 3 117 3 138 0 57 3 141 3 141 0 66 3 142 3 146 0 46 3 147 3 149 0 66 3 151 3 168 0 66 3 169 3 175 0 46 3 176 3 178 0 66 3 192 3 192 0 11 3 193 3 201 0 66 3 203 3 210 0 66 3 211 3 236 0 46 3 237 3 242 0 66 3 243 3 250 0 47 3 252 4 0 0 12 4 1 4 23 0 48 4 24 4 27 0 13 4 28 4 35 0 14 4 36 4 39 0 15 4 41 4 41 0 66 4 45 4 45 0 39 4 48 4 48 0 35 4 50 4 50 0 42 4 54 4 54 0 33 0 0 0 1 0 0 0 10 1 50 7 22 0 2 68 70 76 84 0 14 108 97 116 110 0 68 0 4 0 0 0 0 255 255 0 22 0 0 0 5 0 10 0 15 0 20 0 25 0 30 0 38 0 43 0 48 0 53 0 58 0 63 0 68 0 73 0 78 0 83 0 88 0 93 0 98 0 103 0 108 0 22 0 3 65 90 69 32 0 72 67 82 84 32 0 124 84 82 75 32 0 176 0 0 255 255 0 22 0 1 0 6 0 11 0 16 0 21 0 26 0 31 0 39 0 44 0 49 0 54 0 59 0 64 0 69 0 74 0 79 0 84 0 89 0 94 0 99 0 104 0 109 0 0 255 255 0 23 0 2 0 7 0 12 0 17 0 22 0 27 0 32 0 35 0 40 0 45 0 50 0 55 0 60 0 65 0 70 0 75 0 80 0 85 0 90 0 95 0 100 0 105 0 110 0 0 255 255 0 23 0 3 0 8 0 13 0 18 0 23 0 28 0 33 0 36 0 41 0 46 0 51 0 56 0 61 0 66 0 71 0 76 0 81 0 86 0 91 0 96 0 101 0 106 0 111 0 0 255 255 0 23 0 4 0 9 0 14 0 19 0 24 0 29 0 34 0 37 0 42 0 47 0 52 0 57 0 62 0 67 0 72 0 77 0 82 0 87 0 92 0 97 0 102 0 107 0 112 0 113 97 97 108 116 2 168 97 97 108 116 2 176 97 97 108 116 2 184 97 97 108 116 2 192 97 97 108 116 2 200 99 50 115 99 2 208 99 50 115 99 2 216 99 50 115 99 2 224 99 50 115 99 2 232 99 50 115 99 2 240 99 97 115 101 2 248 99 97 115 101 2 254 99 97 115 101 3 4 99 97 115 101 3 10 99 97 115 101 3 16 99 99 109 112 3 22 99 99 109 112 3 36 99 99 109 112 3 50 99 99 109 112 3 64 99 99 109 112 3 78 100 110 111 109 3 92 100 110 111 109 3 98 100 110 111 109 3 104 100 110 111 109 3 110 100 110 111 109 3 116 102 114 97 99 3 122 102 114 97 99 3 132 102 114 97 99 3 142 102 114 97 99 3 152 102 114 97 99 3 162 108 105 103 97 3 172 108 105 103 97 3 178 108 105 103 97 3 184 108 105 103 97 3 190 108 105 103 97 3 196 108 111 99 108 3 202 108 111 99 108 3 208 108 111 99 108 3 214 110 117 109 114 3 220 110 117 109 114 3 226 110 117 109 114 3 232 110 117 109 114 3 238 110 117 109 114 3 244 111 110 117 109 3 250 111 110 117 109 4 0 111 110 117 109 4 6 111 110 117 109 4 12 111 110 117 109 4 18 111 114 100 110 4 24 111 114 100 110 4 30 111 114 100 110 4 36 111 114 100 110 4 42 111 114 100 110 4 48 112 110 117 109 4 54 112 110 117 109 4 60 112 110 117 109 4 66 112 110 117 109 4 72 112 110 117 109 4 78 115 97 108 116 4 84 115 97 108 116 4 96 115 97 108 116 4 108 115 97 108 116 4 120 115 97 108 116 4 132 115 105 110 102 4 144 115 105 110 102 4 150 115 105 110 102 4 156 115 105 110 102 4 162 115 105 110 102 4 168 115 109 99 112 4 174 115 109 99 112 4 182 115 109 99 112 4 190 115 109 99 112 4 198 115 109 99 112 4 206 115 115 48 49 4 214 115 115 48 49 4 220 115 115 48 49 4 226 115 115 48 49 4 232 115 115 48 49 4 238 115 115 48 50 4 244 115 115 48 50 4 250 115 115 48 50 5 0 115 115 48 50 5 6 115 115 48 50 5 12 115 115 48 51 5 18 115 115 48 51 5 24 115 115 48 51 5 30 115 115 48 51 5 36 115 115 48 51 5 42 115 115 48 52 5 48 115 115 48 52 5 54 115 115 48 52 5 60 115 115 48 52 5 66 115 115 48 52 5 72 115 115 48 53 5 78 115 115 48 53 5 84 115 115 48 53 5 90 115 115 48 53 5 96 115 115 48 53 5 102 115 117 98 115 5 108 115 117 98 115 5 114 115 117 98 115 5 120 115 117 98 115 5 126 115 117 98 115 5 132 115 117 112 115 5 138 115 117 112 115 5 150 115 117 112 115 5 162 115 117 112 115 5 174 115 117 112 115 5 186 122 101 114 111 5 198 122 101 114 111 5 204 122 101 114 111 5 210 122 101 114 111 5 216 122 101 114 111 5 222 0 0 0 2 0 0 0 1 0 0 0 2 0 0 0 1 0 0 0 2 0 0 0 1 0 0 0 2 0 0 0 1 0 0 0 2 0 0 0 1 0 0 0 2 0 9 0 10 0 0 0 2 0 9 0 10 0 0 0 2 0 9 0 10 0 0 0 2 0 9 0 10 0 0 0 2 0 9 0 10 0 0 0 1 0 25 0 0 0 1 0 25 0 0 0 1 0 25 0 0 0 1 0 25 0 0 0 1 0 25 0 0 0 5 0 4 0 5 0 6 0 7 0 8 0 0 0 5 0 4 0 5 0 6 0 7 0 8 0 0 0 5 0 4 0 5 0 6 0 7 0 8 0 0 0 5 0 4 0 5 0 6 0 7 0 8 0 0 0 5 0 4 0 5 0 6 0 7 0 8 0 0 0 1 0 13 0 0 0 1 0 13 0 0 0 1 0 13 0 0 0 1 0 13 0 0 0 1 0 13 0 0 0 3 0 12 0 14 0 15 0 0 0 3 0 12 0 14 0 15 0 0 0 3 0 12 0 14 0 15 0 0 0 3 0 12 0 14 0 15 0 0 0 3 0 12 0 14 0 15 0 0 0 1 0 30 0 0 0 1 0 30 0 0 0 1 0 30 0 0 0 1 0 30 0 0 0 1 0 30 0 0 0 1 0 2 0 0 0 1 0 2 0 0 0 1 0 2 0 0 0 1 0 12 0 0 0 1 0 12 0 0 0 1 0 12 0 0 0 1 0 12 0 0 0 1 0 12 0 0 0 1 0 22 0 0 0 1 0 22 0 0 0 1 0 22 0 0 0 1 0 22 0 0 0 1 0 22 0 0 0 1 0 16 0 0 0 1 0 16 0 0 0 1 0 16 0 0 0 1 0 16 0 0 0 1 0 16 0 0 0 1 0 21 0 0 0 1 0 21 0 0 0 1 0 21 0 0 0 1 0 21 0 0 0 1 0 21 0 0 0 4 0 26 0 27 0 28 0 29 0 0 0 4 0 26 0 27 0 28 0 29 0 0 0 4 0 26 0 27 0 28 0 29 0 0 0 4 0 26 0 27 0 28 0 29 0 0 0 4 0 26 0 27 0 28 0 29 0 0 0 1 0 20 0 0 0 1 0 20 0 0 0 1 0 20 0 0 0 1 0 20 0 0 0 1 0 20 0 0 0 2 0 10 0 11 0 0 0 2 0 10 0 11 0 0 0 2 0 10 0 11 0 0 0 2 0 10 0 11 0 0 0 2 0 10 0 11 9 2 0 1 0 26 8 252 0 1 0 26 8 246 0 1 0 26 8 240 0 1 0 26 8 234 0 1 0 26 9 2 0 1 0 27 8 252 0 1 0 27 8 246 0 1 0 27 8 240 0 1 0 27 8 234 0 1 0 27 9 32 0 1 0 28 9 26 0 1 0 28 9 20 0 1 0 28 9 14 0 1 0 28 9 8 0 1 0 28 9 30 0 1 0 29 9 24 0 1 0 29 9 18 0 1 0 29 9 12 0 1 0 29 9 6 0 1 0 29 8 108 0 1 0 23 8 102 0 1 0 23 8 96 0 1 0 23 8 90 0 1 0 23 8 84 0 1 0 23 0 0 0 1 0 20 0 0 0 1 0 20 0 0 0 1 0 20 0 0 0 1 0 20 0 0 0 1 0 20 0 0 0 4 0 16 0 17 0 18 0 19 0 0 0 4 0 16 0 17 0 18 0 19 0 0 0 4 0 16 0 17 0 18 0 19 0 0 0 4 0 16 0 17 0 18 0 19 0 0 0 4 0 16 0 17 0 18 0 19 0 0 0 1 0 24 0 0 0 1 0 24 0 0 0 1 0 24 0 0 0 1 0 24 0 0 0 1 0 24 0 33 0 68 0 76 0 84 0 92 0 100 0 110 0 120 0 128 0 136 0 144 0 152 0 160 0 168 0 176 0 184 0 192 0 204 0 212 0 220 0 228 0 236 0 244 0 252 1 4 1 12 1 20 1 28 1 36 1 44 1 52 1 60 1 68 1 76 0 1 0 0 0 1 8 98 0 3 0 0 0 1 11 62 0 1 0 0 0 1 1 0 0 2 0 0 0 1 0 254 0 6 0 0 0 2 1 60 1 78 0 6 0 0 0 2 1 86 1 106 0 4 0 0 0 1 1 114 0 4 0 0 0 1 1 228 0 6 0 0 0 1 2 170 0 1 0 0 0 1 2 180 0 1 0 0 0 1 4 80 0 1 0 0 0 1 4 106 0 1 0 0 0 1 6 8 0 1 0 0 0 1 6 34 0 1 0 0 0 1 6 60 0 6 0 0 0 3 6 58 6 76 6 94 0 1 0 0 0 1 6 102 0 1 0 0 0 1 6 158 0 1 0 0 0 1 6 156 0 1 0 0 0 1 6 182 0 1 0 0 0 1 6 188 0 1 0 0 0 1 6 214 0 1 0 0 0 1 6 212 0 1 0 0 0 1 6 214 0 1 0 0 0 1 6 216 0 1 0 0 0 1 6 218 0 1 0 0 0 1 6 220 0 1 0 0 0 1 6 242 0 1 0 0 0 1 7 38 0 1 0 0 0 1 7 58 0 4 0 0 0 1 7 80 0 4 0 0 0 1 14 138 0 1 0 0 0 1 14 148 0 1 14 236 3 52 0 1 14 236 0 8 0 22 0 28 0 34 0 40 0 46 0 52 0 58 0 64 0 2 0 8 2 250 0 2 0 8 2 254 0 2 0 18 2 250 0 2 0 18 2 254 0 2 0 34 2 250 0 2 0 34 2 254 0 2 0 44 2 250 0 2 0 44 2 254 0 3 0 0 0 1 14 186 0 1 14 198 0 1 0 0 0 3 0 3 0 0 0 1 14 186 0 1 14 198 0 1 0 0 0 3 0 3 0 0 0 2 14 124 14 186 0 1 14 180 0 1 0 0 0 31 0 3 0 0 0 1 14 172 0 1 14 160 0 1 0 0 0 32 0 1 14 160 0 3 0 12 0 54 0 88 0 5 0 12 0 18 0 24 0 30 0 36 3 38 0 2 2 246 3 36 0 2 2 248 3 42 0 2 2 252 3 64 0 2 3 0 3 40 0 2 3 6 0 4 0 10 0 16 0 22 0 28 3 46 0 2 2 246 3 44 0 2 2 248 3 50 0 2 2 252 3 48 0 2 3 6 0 4 0 10 0 16 0 22 0 28 3 34 0 2 2 246 3 30 0 2 2 248 3 28 0 2 2 254 3 32 0 2 3 12 0 1 14 48 0 16 0 38 0 48 0 58 0 68 0 78 0 88 0 98 0 108 0 118 0 128 0 146 0 156 0 166 0 176 0 186 0 196 0 1 0 4 0 77 0 2 3 24 0 1 0 4 0 104 0 2 3 24 0 1 0 4 0 111 0 2 2 252 0 1 0 4 0 126 0 2 3 24 0 1 0 4 0 168 0 2 3 24 0 1 0 4 0 204 0 2 3 24 0 1 0 4 0 251 0 2 3 24 0 1 0 4 1 2 0 2 3 12 0 1 0 4 1 22 0 2 3 24 0 2 0 6 0 12 1 29 0 2 2 252 1 26 0 2 3 22 0 1 0 4 1 43 0 2 3 24 0 1 0 4 1 50 0 2 3 12 0 1 0 4 1 89 0 2 3 24 0 1 0 4 1 104 0 2 3 12 0 1 0 4 1 126 0 2 3 24 0 1 0 4 1 198 0 2 3 22 0 3 0 1 13 134 0 1 13 180 0 0 0 1 0 0 0 32 0 2 13 116 0 207 3 91 3 92 3 93 3 94 3 95 3 96 3 97 3 98 3 99 3 100 3 101 3 102 3 103 3 104 3 105 3 106 3 107 3 108 3 109 3 110 3 111 3 112 3 113 3 114 3 115 3 116 3 117 3 118 3 119 3 120 3 121 3 122 3 123 3 124 3 125 3 126 3 127 3 128 3 129 3 130 3 131 3 132 3 133 3 134 3 135 3 136 3 137 3 138 3 139 3 142 3 143 3 144 3 145 3 146 3 147 3 148 3 149 3 150 3 151 3 152 3 153 3 154 3 155 3 156 3 157 3 158 3 159 3 160 3 161 3 162 3 163 3 164 3 165 3 166 3 167 3 169 3 170 3 171 3 172 3 173 3 174 3 175 3 176 3 177 3 178 3 179 3 180 3 181 3 182 3 183 3 184 3 185 3 186 3 187 3 188 3 189 3 190 3 192 3 193 3 195 3 196 3 197 3 198 3 199 3 200 3 201 3 202 3 203 3 204 3 205 3 206 3 207 3 208 3 209 3 210 3 211 3 212 3 213 3 214 3 215 3 216 3 217 3 218 3 219 3 220 3 221 3 222 3 223 3 224 3 225 3 226 3 227 3 228 3 229 3 230 3 231 3 232 3 233 3 234 3 237 3 238 3 239 3 240 3 241 3 242 3 243 3 244 3 245 3 246 3 247 3 248 3 249 3 251 3 252 3 253 3 254 3 255 4 0 4 1 4 2 4 3 4 4 4 5 4 6 4 7 4 8 4 9 4 10 4 11 4 12 4 13 4 14 4 15 4 16 4 17 4 18 4 19 4 20 4 21 4 22 4 23 4 24 4 25 4 26 4 27 4 28 4 29 4 30 4 31 4 32 4 33 4 34 4 35 4 36 4 37 4 38 4 39 4 40 4 41 4 42 3 140 3 191 3 235 3 141 3 194 3 168 3 236 0 2 12 58 0 14 4 43 4 44 4 45 4 46 4 47 4 48 4 49 4 50 4 51 4 52 4 53 4 54 4 55 4 56 0 2 12 46 0 208 3 91 3 92 3 93 3 94 3 95 3 96 3 97 3 98 3 99 3 100 3 101 3 102 3 103 3 104 3 105 3 106 3 107 3 108 3 109 3 110 3 111 3 112 3 113 3 114 3 115 3 116 3 117 3 118 3 119 3 120 3 121 3 122 3 123 3 124 3 125 3 126 3 127 3 128 3 129 3 130 3 131 3 132 3 133 3 134 3 135 3 136 3 137 3 138 3 139 3 142 3 143 3 144 3 145 3 146 3 147 3 148 3 149 3 150 3 151 3 152 3 153 3 154 3 155 3 156 3 157 3 158 3 159 3 160 3 161 3 162 3 163 3 164 3 165 3 166 3 167 3 169 3 170 3 171 3 172 3 173 3 174 3 175 3 176 3 177 3 178 3 179 3 180 3 181 3 182 3 183 3 184 3 185 3 187 3 188 3 189 3 190 3 190 3 192 3 193 3 195 3 196 3 198 3 197 3 199 3 200 3 201 3 202 3 203 3 204 3 205 3 206 3 207 3 208 3 209 3 210 3 211 3 212 3 213 3 214 3 215 3 216 3 217 3 218 3 219 3 220 3 221 3 222 3 223 3 224 3 225 3 226 3 227 3 228 3 229 3 230 3 231 3 232 3 233 3 234 3 237 3 239 3 238 3 240 3 241 3 242 3 243 3 244 3 245 3 246 3 247 3 248 3 249 3 251 3 252 3 253 3 254 3 255 4 0 4 1 4 2 4 3 4 4 4 5 4 6 4 7 4 8 4 9 4 10 4 11 4 12 4 13 4 14 4 15 4 16 4 17 4 18 4 19 4 20 4 21 4 22 4 23 4 24 4 25 4 26 4 27 4 28 4 29 4 30 4 31 4 32 4 33 4 34 4 35 4 36 4 37 4 38 4 39 4 40 4 41 4 42 3 140 3 191 3 235 3 141 3 194 3 168 3 236 3 186 0 2 10 218 0 14 2 92 2 93 2 94 2 95 2 96 2 97 2 98 2 99 2 100 2 101 2 104 2 105 2 102 2 103 0 2 10 184 0 14 2 78 2 79 2 80 2 81 2 82 2 83 2 84 2 85 2 86 2 87 2 90 2 91 2 88 2 89 0 1 10 172 0 128 0 3 0 1 10 172 0 1 10 182 0 0 0 1 0 0 0 32 0 3 0 1 10 172 0 1 10 188 0 0 0 1 0 0 0 32 0 3 0 2 10 190 10 180 0 1 10 170 0 0 0 1 0 0 0 32 0 2 10 178 0 29 2 109 2 110 2 111 2 112 2 113 2 114 2 115 2 116 2 117 2 118 2 119 2 120 2 121 2 122 2 123 2 124 2 125 2 126 2 127 2 128 2 129 2 130 2 131 2 132 2 133 2 134 2 135 2 136 2 137 0 1 10 136 4 54 0 2 10 18 0 14 2 50 2 51 2 52 2 53 2 54 2 55 2 56 2 57 2 58 2 59 2 62 2 63 2 60 2 61 0 2 10 106 0 4 4 84 4 85 4 86 4 87 0 2 9 226 0 14 2 64 2 65 2 66 2 67 2 68 2 69 2 70 2 71 2 72 2 73 2 76 2 77 2 74 2 75 0 1 10 70 0 10 0 1 10 80 0 20 0 0 1 0 0 2 10 80 0 2 3 87 3 89 0 2 10 70 0 2 3 86 3 88 0 1 10 68 0 1 0 0 1 1 0 2 10 120 0 10 1 202 1 203 1 204 1 205 1 206 1 207 1 208 1 209 1 210 2 140 0 0 1 2 0 2 10 112 0 25 1 171 1 172 1 173 1 174 1 175 1 176 1 177 1 178 1 179 1 180 1 181 1 182 1 183 1 184 1 185 1 186 1 187 1 188 1 189 1 190 1 191 1 192 1 193 2 107 2 138 0 0 1 3 0 2 10 80 0 9 1 194 1 195 1 196 1 197 1 198 1 199 1 200 1 201 2 139 0 0 1 4 0 2 10 74 0 12 1 159 1 160 1 161 1 162 1 163 1 164 1 165 1 166 1 167 1 168 1 169 1 170 0 1 10 60 0 1 0 8 0 2 0 6 0 12 1 155 0 2 0 35 1 158 0 2 0 49 0 2 10 40 1 111 3 117 3 118 3 119 3 120 3 121 3 122 3 123 3 124 3 125 3 126 3 127 3 128 3 129 3 130 3 131 3 132 3 133 3 134 3 135 3 136 3 137 3 138 3 139 3 142 3 143 3 144 3 145 3 146 3 147 3 148 3 149 3 150 3 151 3 152 3 153 3 154 3 155 3 156 3 157 3 158 3 159 3 160 3 161 3 162 3 163 3 164 3 165 3 166 3 167 3 169 3 170 3 171 3 172 3 173 3 174 3 175 3 176 3 177 3 178 3 179 3 192 3 193 3 195 3 196 3 197 3 198 3 199 3 200 3 201 3 202 3 203 3 204 3 205 3 206 3 207 3 208 3 209 3 210 3 211 3 212 3 213 3 214 3 215 3 216 3 217 3 218 3 219 3 220 3 221 3 222 3 223 3 224 3 225 3 226 3 227 3 228 3 229 3 230 3 231 3 232 3 233 3 234 3 237 3 238 3 239 3 240 3 241 3 242 3 243 3 244 3 245 3 246 3 247 3 248 3 249 3 251 3 252 3 253 3 254 3 255 4 0 4 1 4 2 4 3 4 4 4 5 4 6 4 7 4 8 4 9 4 10 4 11 4 12 4 13 4 14 4 15 4 16 4 17 4 18 4 19 4 20 4 21 4 22 4 23 4 24 4 25 4 26 4 27 4 28 4 29 4 30 4 31 4 32 4 33 4 34 4 35 4 36 4 37 4 38 4 39 4 40 4 41 4 42 3 139 3 142 3 143 3 144 3 145 3 146 3 147 3 148 3 149 3 150 3 153 3 154 3 155 3 156 3 157 3 158 3 159 3 160 3 161 3 162 3 163 3 164 3 165 3 166 3 167 3 176 3 177 3 178 3 179 3 180 3 181 3 182 3 183 3 184 3 185 3 187 3 188 3 189 3 190 3 190 3 192 3 193 3 203 3 204 3 205 3 206 3 207 3 208 3 209 3 210 3 211 3 212 3 213 3 214 3 215 3 216 3 217 3 218 3 219 3 220 3 221 3 222 3 223 3 224 3 225 3 226 3 227 3 228 3 229 3 230 3 231 3 232 3 233 3 234 3 237 3 239 3 238 3 240 3 241 3 242 3 243 3 244 3 245 3 246 3 247 3 248 3 249 3 251 3 252 3 253 3 254 3 255 4 0 4 1 4 2 4 3 4 4 4 5 4 6 4 7 4 8 4 9 4 10 4 11 4 12 4 13 4 14 4 15 4 16 4 17 4 18 4 19 4 20 4 21 4 22 4 23 4 24 4 25 4 26 4 27 4 28 4 29 4 30 4 31 4 32 4 33 4 34 4 35 4 36 4 37 4 38 4 39 4 40 4 41 4 43 1 243 1 244 1 245 1 246 1 247 1 248 1 249 1 250 1 251 1 252 1 243 1 244 1 245 1 246 1 247 1 248 1 249 1 250 1 251 1 252 4 84 2 48 2 107 2 138 2 139 2 140 2 247 2 249 2 251 2 253 2 255 3 1 3 3 3 5 3 7 3 9 3 11 3 13 3 15 3 23 3 25 3 29 3 31 3 33 3 35 3 37 3 39 3 41 3 43 3 45 3 47 3 49 3 51 3 140 3 191 3 235 3 140 3 191 3 235 3 65 3 141 3 141 3 194 3 194 3 168 3 168 3 236 3 236 3 186 0 1 8 98 0 120 0 246 0 252 1 2 1 8 1 14 1 20 1 26 1 32 1 38 1 46 1 52 1 58 1 64 1 70 1 76 1 82 1 88 1 94 1 100 1 106 1 112 1 118 1 124 1 130 1 136 1 142 1 148 1 156 1 162 1 168 1 174 1 180 1 186 1 194 1 200 1 208 1 214 1 220 1 228 1 234 1 240 1 246 1 252 2 2 2 8 2 14 2 20 2 26 2 32 2 38 2 44 2 50 2 56 2 62 2 68 2 74 2 80 2 86 2 92 2 98 2 104 2 110 2 116 2 122 2 128 2 134 2 140 2 146 2 152 2 158 2 164 2 170 2 176 2 182 2 188 2 194 2 200 2 206 2 212 2 218 2 224 2 230 2 236 2 242 2 248 2 254 3 4 3 10 3 16 3 22 3 28 3 34 3 40 3 46 3 52 3 58 3 64 3 70 3 76 3 82 3 88 3 94 3 100 3 106 3 122 3 138 3 154 3 170 3 186 3 202 3 218 3 234 3 250 4 10 4 20 4 30 4 36 4 42 4 48 4 58 0 2 3 91 4 58 0 2 3 92 4 59 0 2 3 93 4 60 0 2 3 94 4 61 0 2 3 95 4 62 0 2 3 96 4 63 0 2 3 97 4 64 0 2 3 98 4 65 0 3 3 99 4 66 1 159 0 2 3 100 4 67 0 2 3 101 4 68 0 2 3 102 4 69 0 2 3 103 4 70 0 2 3 104 4 71 0 2 3 105 4 72 0 2 3 106 4 73 0 2 3 107 4 74 0 2 3 108 4 75 0 2 3 109 4 76 0 2 3 110 4 77 0 2 3 111 4 78 0 2 3 112 4 79 0 2 3 113 4 80 0 2 3 114 4 81 0 2 3 115 4 82 0 2 3 116 4 83 0 3 3 91 2 109 1 171 0 2 3 92 2 110 0 2 3 93 2 111 0 2 3 94 2 112 0 2 3 95 2 113 0 2 3 96 2 114 0 3 3 97 2 115 1 194 0 2 3 98 2 116 0 3 3 90 3 99 2 117 0 2 3 100 2 118 0 2 3 101 2 119 0 3 3 102 2 120 1 202 0 2 3 103 2 121 0 2 3 104 2 122 0 2 3 105 2 123 0 2 3 106 2 124 0 2 3 107 2 125 0 2 3 108 2 126 0 2 3 109 2 127 0 2 3 110 2 128 0 2 3 111 2 129 0 2 3 112 2 130 0 2 3 113 2 131 0 2 3 114 2 132 0 2 3 115 2 133 0 2 3 116 2 134 0 2 3 180 1 160 0 2 3 181 1 161 0 2 3 182 1 162 0 2 3 183 1 163 0 2 3 184 1 164 0 2 3 185 1 165 0 2 3 186 1 166 0 2 3 187 1 167 0 2 3 188 1 168 0 2 3 189 1 169 0 2 3 190 1 170 0 2 3 117 1 172 0 2 3 118 1 173 0 2 3 119 1 174 0 2 3 120 1 175 0 2 3 121 1 176 0 2 3 122 1 177 0 2 3 123 1 178 0 2 3 124 1 179 0 2 3 125 1 180 0 2 3 126 1 181 0 2 3 127 1 182 0 2 3 128 1 183 0 2 3 129 1 184 0 2 3 130 1 185 0 2 3 131 1 186 0 2 3 132 1 187 0 2 3 133 1 188 0 2 3 134 1 189 0 2 3 135 1 190 0 2 3 136 1 191 0 2 3 137 1 192 0 2 3 138 1 193 0 2 3 151 2 135 0 2 3 152 2 136 0 2 3 169 1 195 0 2 3 170 1 196 0 2 3 171 1 197 0 2 3 172 1 198 0 2 3 173 1 199 0 2 3 174 1 200 0 2 3 175 1 201 0 2 3 195 1 203 0 2 3 196 1 204 0 2 3 198 1 205 0 2 3 197 1 206 0 2 3 199 1 207 0 2 3 200 1 208 0 2 3 201 1 209 0 2 3 202 1 210 0 2 4 42 2 137 0 7 4 44 2 92 2 78 2 50 2 64 1 223 1 233 0 7 4 45 2 93 2 79 2 51 2 65 1 224 1 234 0 7 4 46 2 94 2 80 2 52 2 66 1 225 1 235 0 7 4 47 2 95 2 81 2 53 2 67 1 226 1 236 0 7 4 48 2 96 2 82 2 54 2 68 1 227 1 237 0 7 4 49 2 97 2 83 2 55 2 69 1 228 1 238 0 7 4 50 2 98 2 84 2 56 2 70 1 229 1 239 0 7 4 51 2 99 2 85 2 57 2 71 1 230 1 240 0 7 4 52 2 100 2 86 2 58 2 72 1 231 1 241 0 7 4 53 2 101 2 87 2 59 2 73 1 232 1 242 0 4 2 104 2 90 2 62 2 76 0 4 2 105 2 91 2 63 2 77 0 2 4 54 4 85 0 2 4 55 4 86 0 2 4 56 4 87 0 4 2 102 2 88 2 60 2 74 0 4 2 103 2 89 2 61 2 75 0 1 0 114 0 1 0 8 0 1 0 4 1 44 0 2 3 24 0 2 4 88 0 45 3 56 1 44 2 78 2 79 2 80 2 81 2 82 2 83 2 84 2 85 2 86 2 87 2 88 2 89 2 90 2 91 2 247 2 249 2 251 2 253 2 255 3 1 3 3 3 5 3 7 3 9 3 11 3 13 3 15 3 23 3 25 3 29 3 31 3 33 3 35 3 37 3 39 3 41 3 43 3 45 3 47 3 49 3 51 3 57 3 65 0 1 0 1 0 38 0 1 0 8 0 90 0 93 0 147 0 150 1 8 1 11 1 68 1 71 0 1 0 4 0 90 0 147 1 8 1 68 0 1 0 1 3 0 0 1 0 4 0 93 0 150 1 11 1 71 0 1 0 1 2 248 0 1 0 1 3 24 0 1 0 1 1 43 0 1 0 3 2 250 3 0 3 4 0 1 0 16 0 4 0 8 0 10 0 12 0 18 0 24 0 30 0 33 0 34 0 36 0 38 0 41 0 44 0 49 0 50 1 194 0 2 0 7 0 4 0 29 0 0 0 56 0 229 0 26 3 58 3 60 0 200 3 66 3 66 0 203 3 68 3 68 0 204 3 70 3 70 0 205 3 72 3 72 0 206 0 1 0 28 2 246 2 248 2 250 2 252 2 254 3 0 3 2 3 4 3 6 3 8 3 10 3 12 3 14 3 22 3 24 3 28 3 30 3 32 3 34 3 36 3 38 3 40 3 42 3 44 3 46 3 48 3 50 3 64 0 2 0 3 1 212 1 222 0 0 2 18 2 18 0 11 2 20 2 21 0 12 0 2 0 13 0 30 0 55 0 0 0 230 1 44 0 26 1 46 1 47 0 97 1 49 1 64 0 99 1 66 1 108 0 115 1 110 1 150 0 158 1 153 1 153 0 199 3 61 3 63 0 200 3 67 3 67 0 203 3 69 3 69 0 204 3 71 3 71 0 205 3 73 3 73 0 206 3 90 3 90 0 207 0 2 0 3 1 213 1 222 0 0 1 253 1 254 0 10 2 27 2 28 0 12 0 1 0 1 2 33 0 2 0 1 2 92 2 101 0 0 0 1 0 2 0 3 3 54 0 2 0 2 2 78 2 91 0 0 2 159 2 161 0 14 0 2 0 1 2 92 2 105 0 0 0 2 0 1 2 78 2 87 0 0 0 1 0 2 3 56 3 57 0 2 0 3 0 30 0 55 0 0 1 6 1 7 0 26 1 153 1 153 0 28 0 2 0 1 0 4 0 29 0 0 0 1 0 4 1 255 2 18 2 20 2 21 0 2 0 2 1 213 1 222 0 0 1 233 1 242 0 10 0 2 0 1 1 213 1 232 0 0 0 1 0 2 1 213 1 223 0 1 0 29 2 47 2 246 2 248 2 250 2 252 2 254 3 0 3 2 3 4 3 6 3 8 3 10 3 12 3 14 3 22 3 24 3 28 3 30 3 32 3 34 3 36 3 38 3 40 3 42 3 44 3 46 3 48 3 50 3 64 0 2 0 3 0 41 0 41 0 0 1 49 1 56 0 1 2 120 2 120 0 9 0 2 0 4 0 30 0 30 0 0 0 230 0 251 0 1 2 106 2 106 0 23 2 109 2 109 0 24 0 2 0 3 0 36 0 36 0 0 1 23 1 29 0 1 2 115 2 115 0 8 0 2 0 2 0 12 0 12 0 0 0 116 0 126 0 1 0 1 0 1 0 35 0 2 0 47 0 56 0 115 0 0 0 127 0 229 0 60 0 252 1 5 0 163 1 8 1 22 0 173 1 30 1 44 0 188 1 46 1 47 0 203 1 57 1 64 0 205 1 66 1 108 0 213 1 110 1 150 1 0 1 212 1 212 1 41 1 223 1 242 1 42 1 255 1 255 1 62 2 47 2 47 1 63 2 106 2 106 1 64 2 109 2 109 1 65 2 115 2 115 1 66 2 120 2 120 1 67 2 246 2 246 1 68 2 248 2 248 1 69 2 250 2 250 1 70 2 252 2 252 1 71 2 254 2 254 1 72 3 0 3 0 1 73 3 2 3 2 1 74 3 4 3 4 1 75 3 6 3 6 1 76 3 8 3 8 1 77 3 10 3 10 1 78 3 12 3 12 1 79 3 14 3 14 1 80 3 22 3 22 1 81 3 24 3 24 1 82 3 28 3 28 1 83 3 30 3 30 1 84 3 32 3 32 1 85 3 34 3 34 1 86 3 36 3 36 1 87 3 38 3 38 1 88 3 40 3 40 1 89 3 42 3 42 1 90 3 44 3 44 1 91 3 46 3 46 1 92 3 48 3 48 1 93 3 50 3 50 1 94 3 58 3 64 1 95 3 66 3 73 1 102 3 90 3 90 1 110 0 2 0 12 0 4 0 55 0 0 0 116 0 126 0 52 0 230 0 251 0 63 1 6 1 7 0 85 1 23 1 29 0 87 1 49 1 56 0 94 1 153 1 153 0 102 1 213 1 222 0 103 1 253 1 254 0 113 2 18 2 18 0 115 2 20 2 21 0 116 2 27 2 28 0 118 0 1 0 45 0 3 1 43 2 92 2 93 2 94 2 95 2 96 2 97 2 98 2 99 2 100 2 101 2 102 2 103 2 104 2 105 2 246 2 248 2 250 2 252 2 254 3 0 3 2 3 4 3 6 3 8 3 10 3 12 3 14 3 22 3 24 3 28 3 30 3 32 3 34 3 36 3 38 3 40 3 42 3 44 3 46 3 48 3 50 3 54 3 64 0 1 0 0 0 8 0 0 0 4 0 14 0 2 105 100 101 111 114 111 109 110 0 2 68 70 76 84 0 14 108 97 116 110 0 14 0 6 0 0 0 0 0 1 0 2 0 8 0 12 0 1 255 86 0 1 0 0 0 0 0 0 0 1 0 1 0 1 0 0 0 1 0 0 32 68 0 0 0 20 0 0 0 0 0 0 32 60 48 130 32 56 6 9 42 134 72 134 247 13 1 7 2 160 130 32 41 48 130 32 37 2 1 1 49 11 48 9 6 5 43 14 3 2 26 5 0 48 97 6 10 43 6 1 4 1 130 55 2 1 4 160 83 48 81 48 44 6 10 43 6 1 4 1 130 55 2 1 28 162 30 128 28 0 60 0 60 0 60 0 79 0 98 0 115 0 111 0 108 0 101 0 116 0 101 0 62 0 62 0 62 48 33 48 9 6 5 43 14 3 2 26 5 0 4 20 158 55 249 51 142 154 35 0 162 188 220 156 11 52 184 200 198 27 98 39 160 130 27 15 48 130 2 60 48 130 1 165 2 16 112 186 228 29 16 217 41 52 182 56 202 123 3 204 186 191 48 13 6 9 42 134 72 134 247 13 1 1 2 5 0 48 95 49 11 48 9 6 3 85 4 6 19 2 85 83 49 23 48 21 6 3 85 4 10 19 14 86 101 114 105 83 105 103 110 44 32 73 110 99 46 49 55 48 53 6 3 85 4 11 19 46 67 108 97 115 115 32 51 32 80 117 98 108 105 99 32 80 114 105 109 97 114 121 32 67 101 114 116 105 102 105 99 97 116 105 111 110 32 65 117 116 104 111 114 105 116 121 48 30 23 13 57 54 48 49 50 57 48 48 48 48 48 48 90 23 13 50 56 48 56 48 49 50 51 53 57 53 57 90 48 95 49 11 48 9 6 3 85 4 6 19 2 85 83 49 23 48 21 6 3 85 4 10 19 14 86 101 114 105 83 105 103 110 44 32 73 110 99 46 49 55 48 53 6 3 85 4 11 19 46 67 108 97 115 115 32 51 32 80 117 98 108 105 99 32 80 114 105 109 97 114 121 32 67 101 114 116 105 102 105 99 97 116 105 111 110 32 65 117 116 104 111 114 105 116 121 48 129 159 48 13 6 9 42 134 72 134 247 13 1 1 1 5 0 3 129 141 0 48 129 137 2 129 129 0 201 92 89 158 242 27 138 1 20 180 16 223 4 64 219 227 87 175 106 69 64 143 132 12 11 209 51 217 217 17 207 238 2 88 31 37 247 42 168 68 5 170 236 3 31 120 127 158 147 185 154 0 170 35 125 214 172 133 162 99 69 199 114 39 204 244 76 198 117 113 210 57 239 79 66 240 117 223 10 144 198 142 32 111 152 15 248 172 35 95 112 41 54 164 201 134 231 177 154 32 203 83 165 133 231 61 190 125 154 254 36 69 51 220 118 21 237 15 162 113 100 76 101 46 129 104 69 167 2 3 1 0 1 48 13 6 9 42 134 72 134 247 13 1 1 2 5 0 3 129 129 0 187 76 18 43 207 44 38 0 79 20 19 221 166 251 252 10 17 132 140 243 40 28 103 146 47 124 182 197 250 223 240 232 149 188 29 143 108 44 168 81 204 115 216 164 192 83 240 78 214 38 192 118 1 87 129 146 94 33 241 209 177 255 231 208 33 88 205 105 23 227 68 28 156 25 68 57 137 92 220 156 0 15 86 141 2 153 237 162 144 69 76 228 187 16 164 61 240 50 3 14 241 206 248 232 201 81 140 230 98 159 230 159 192 125 183 114 156 201 54 58 107 159 78 168 255 100 13 100 48 130 3 238 48 130 3 87 160 3 2 1 2 2 16 126 147 235 251 124 198 78 89 234 75 154 119 212 6 252 59 48 13 6 9 42 134 72 134 247 13 1 1 5 5 0 48 129 139 49 11 48 9 6 3 85 4 6 19 2 90 65 49 21 48 19 6 3 85 4 8 19 12 87 101 115 116 101 114 110 32 67 97 112 101 49 20 48 18 6 3 85 4 7 19 11 68 117 114 98 97 110 118 105 108 108 101 49 15 48 13 6 3 85 4 10 19 6 84 104 97 119 116 101 49 29 48 27 6 3 85 4 11 19 20 84 104 97 119 116 101 32 67 101 114 116 105 102 105 99 97 116 105 111 110 49 31 48 29 6 3 85 4 3 19 22 84 104 97 119 116 101 32 84 105 109 101 115 116 97 109 112 105 110 103 32 67 65 48 30 23 13 49 50 49 50 50 49 48 48 48 48 48 48 90 23 13 50 48 49 50 51 48 50 51 53 57 53 57 90 48 94 49 11 48 9 6 3 85 4 6 19 2 85 83 49 29 48 27 6 3 85 4 10 19 20 83 121 109 97 110 116 101 99 32 67 111 114 112 111 114 97 116 105 111 110 49 48 48 46 6 3 85 4 3 19 39 83 121 109 97 110 116 101 99 32 84 105 109 101 32 83 116 97 109 112 105 110 103 32 83 101 114 118 105 99 101 115 32 67 65 32 45 32 71 50 48 130 1 34 48 13 6 9 42 134 72 134 247 13 1 1 1 5 0 3 130 1 15 0 48 130 1 10 2 130 1 1 0 177 172 179 73 84 75 151 28 18 10 216 37 121 145 34 87 42 111 220 184 38 196 67 115 107 194 191 46 80 90 251 20 194 118 142 67 1 37 67 180 161 226 69 244 232 183 123 195 116 204 34 215 180 148 0 2 247 77 237 191 180 183 68 36 107 205 95 69 59 209 68 206 67 18 115 23 130 139 105 180 43 203 153 30 172 114 27 38 77 113 31 177 49 221 251 81 97 2 83 166 170 245 73 44 5 120 69 165 47 137 206 231 153 231 254 140 226 87 63 61 198 146 220 74 248 123 51 228 121 10 251 240 117 136 65 156 255 197 3 81 153 170 215 108 159 147 105 135 101 41 131 133 194 96 20 196 200 201 59 20 218 192 129 240 31 13 116 222 146 34 171 202 247 251 116 124 39 230 247 74 27 127 167 195 158 45 174 138 234 166 230 170 39 22 125 97 247 152 113 17 188 226 80 161 75 229 93 250 229 14 167 44 159 170 101 32 211 216 150 232 200 124 165 78 72 68 255 25 226 68 7 146 11 215 104 132 128 93 106 120 100 69 205 96 70 126 84 193 19 124 197 121 241 201 193 113 2 3 1 0 1 163 129 250 48 129 247 48 29 6 3 85 29 14 4 22 4 20 95 154 245 110 92 204 204 116 154 212 221 125 239 63 219 236 76 128 46 221 48 50 6 8 43 6 1 5 5 7 1 1 4 38 48 36 48 34 6 8 43 6 1 5 5 7 48 1 134 22 104 116 116 112 58 47 47 111 99 115 112 46 116 104 97 119 116 101 46 99 111 109 48 18 6 3 85 29 19 1 1 255 4 8 48 6 1 1 255 2 1 0 48 63 6 3 85 29 31 4 56 48 54 48 52 160 50 160 48 134 46 104 116 116 112 58 47 47 99 114 108 46 116 104 97 119 116 101 46 99 111 109 47 84 104 97 119 116 101 84 105 109 101 115 116 97 109 112 105 110 103 67 65 46 99 114 108 48 19 6 3 85 29 37 4 12 48 10 6 8 43 6 1 5 5 7 3 8 48 14 6 3 85 29 15 1 1 255 4 4 3 2 1 6 48 40 6 3 85 29 17 4 33 48 31 164 29 48 27 49 25 48 23 6 3 85 4 3 19 16 84 105 109 101 83 116 97 109 112 45 50 48 52 56 45 49 48 13 6 9 42 134 72 134 247 13 1 1 5 5 0 3 129 129 0 3 9 155 143 121 239 127 89 48 170 239 104 181 250 227 9 29 187 79 130 6 93 55 95 166 82 159 22 141 234 28 146 9 68 110 245 109 235 88 124 48 232 249 105 141 35 115 11 18 111 71 169 174 57 17 248 42 177 155 176 26 195 142 235 89 150 0 173 206 12 77 178 208 49 166 8 92 42 122 252 226 122 29 87 76 168 101 24 233 121 64 98 37 150 110 199 199 55 106 131 33 8 142 65 234 221 217 87 63 29 119 73 135 42 22 6 94 166 56 106 34 18 163 81 25 131 126 182 48 130 4 144 48 130 3 249 160 3 2 1 2 2 16 27 9 59 120 96 150 218 55 187 164 81 148 70 200 150 120 48 13 6 9 42 134 72 134 247 13 1 1 5 5 0 48 95 49 11 48 9 6 3 85 4 6 19 2 85 83 49 23 48 21 6 3 85 4 10 19 14 86 101 114 105 83 105 103 110 44 32 73 110 99 46 49 55 48 53 6 3 85 4 11 19 46 67 108 97 115 115 32 51 32 80 117 98 108 105 99 32 80 114 105 109 97 114 121 32 67 101 114 116 105 102 105 99 97 116 105 111 110 32 65 117 116 104 111 114 105 116 121 48 30 23 13 48 54 49 49 48 56 48 48 48 48 48 48 90 23 13 50 49 49 49 48 55 50 51 53 57 53 57 90 48 129 202 49 11 48 9 6 3 85 4 6 19 2 85 83 49 23 48 21 6 3 85 4 10 19 14 86 101 114 105 83 105 103 110 44 32 73 110 99 46 49 31 48 29 6 3 85 4 11 19 22 86 101 114 105 83 105 103 110 32 84 114 117 115 116 32 78 101 116 119 111 114 107 49 58 48 56 6 3 85 4 11 19 49 40 99 41 32 50 48 48 54 32 86 101 114 105 83 105 103 110 44 32 73 110 99 46 32 45 32 70 111 114 32 97 117 116 104 111 114 105 122 101 100 32 117 115 101 32 111 110 108 121 49 69 48 67 6 3 85 4 3 19 60 86 101 114 105 83 105 103 110 32 67 108 97 115 115 32 51 32 80 117 98 108 105 99 32 80 114 105 109 97 114 121 32 67 101 114 116 105 102 105 99 97 116 105 111 110 32 65 117 116 104 111 114 105 116 121 32 45 32 71 53 48 130 1 34 48 13 6 9 42 134 72 134 247 13 1 1 1 5 0 3 130 1 15 0 48 130 1 10 2 130 1 1 0 175 36 8 8 41 122 53 158 96 12 170 231 75 59 78 220 124 188 60 69 28 187 43 224 254 41 2 249 87 8 163 100 133 21 39 245 241 173 200 49 137 93 34 232 42 170 166 66 179 143 248 185 85 183 177 183 75 179 254 143 126 7 87 236 239 67 219 102 98 21 97 207 96 13 164 216 222 248 224 195 98 8 61 84 19 235 73 202 89 84 133 38 229 43 143 27 159 235 245 161 145 194 51 73 216 67 99 106 82 75 210 143 232 112 81 77 209 137 105 123 199 112 246 179 220 18 116 219 123 93 75 86 211 150 191 21 119 161 176 244 162 37 242 175 28 146 103 24 229 244 6 4 239 144 185 228 0 228 221 58 181 25 255 2 186 244 60 238 224 139 235 55 139 236 244 215 172 242 246 240 61 175 221 117 145 51 25 29 28 64 203 116 36 25 33 147 217 20 254 172 42 82 199 143 213 4 73 228 141 99 71 136 60 105 131 203 254 71 189 43 126 79 197 149 174 14 157 212 209 67 192 103 115 227 20 8 126 229 63 159 115 184 51 10 207 93 63 52 135 150 138 238 83 232 37 21 2 3 1 0 1 163 130 1 91 48 130 1 87 48 15 6 3 85 29 19 1 1 255 4 5 48 3 1 1 255 48 49 6 3 85 29 31 4 42 48 40 48 38 160 36 160 34 134 32 104 116 116 112 58 47 47 99 114 108 46 118 101 114 105 115 105 103 110 46 99 111 109 47 112 99 97 51 46 99 114 108 48 14 6 3 85 29 15 1 1 255 4 4 3 2 1 6 48 61 6 3 85 29 32 4 54 48 52 48 50 6 4 85 29 32 0 48 42 48 40 6 8 43 6 1 5 5 7 2 1 22 28 104 116 116 112 115 58 47 47 119 119 119 46 118 101 114 105 115 105 103 110 46 99 111 109 47 99 112 115 48 29 6 3 85 29 14 4 22 4 20 127 211 101 167 194 221 236 187 240 48 9 243 67 57 250 2 175 51 49 51 48 109 6 8 43 6 1 5 5 7 1 12 4 97 48 95 161 93 160 91 48 89 48 87 48 85 22 9 105 109 97 103 101 47 103 105 102 48 33 48 31 48 7 6 5 43 14 3 2 26 4 20 143 229 211 26 134 172 141 142 107 195 207 128 106 212 72 24 44 123 25 46 48 37 22 35 104 116 116 112 58 47 47 108 111 103 111 46 118 101 114 105 115 105 103 110 46 99 111 109 47 118 115 108 111 103 111 46 103 105 102 48 52 6 8 43 6 1 5 5 7 1 1 4 40 48 38 48 36 6 8 43 6 1 5 5 7 48 1 134 24 104 116 116 112 58 47 47 111 99 115 112 46 118 101 114 105 115 105 103 110 46 99 111 109 48 13 6 9 42 134 72 134 247 13 1 1 5 5 0 3 129 129 0 163 205 125 30 247 199 117 141 72 231 86 52 76 0 144 117 169 81 165 86 193 109 188 254 245 83 34 233 152 162 172 154 126 112 30 179 142 59 69 227 134 149 49 218 109 76 251 52 80 128 150 205 36 242 64 223 4 63 226 101 206 52 34 97 21 234 102 112 100 210 241 110 243 202 24 89 106 65 70 126 130 222 25 176 112 49 86 105 13 12 230 29 157 113 88 220 204 222 98 245 225 122 16 2 216 122 220 59 250 87 189 201 233 143 70 33 57 159 81 101 76 142 58 190 40 65 112 29 48 130 4 163 48 130 3 139 160 3 2 1 2 2 16 14 207 244 56 200 254 191 53 110 4 216 106 152 27 26 80 48 13 6 9 42 134 72 134 247 13 1 1 5 5 0 48 94 49 11 48 9 6 3 85 4 6 19 2 85 83 49 29 48 27 6 3 85 4 10 19 20 83 121 109 97 110 116 101 99 32 67 111 114 112 111 114 97 116 105 111 110 49 48 48 46 6 3 85 4 3 19 39 83 121 109 97 110 116 101 99 32 84 105 109 101 32 83 116 97 109 112 105 110 103 32 83 101 114 118 105 99 101 115 32 67 65 32 45 32 71 50 48 30 23 13 49 50 49 48 49 56 48 48 48 48 48 48 90 23 13 50 48 49 50 50 57 50 51 53 57 53 57 90 48 98 49 11 48 9 6 3 85 4 6 19 2 85 83 49 29 48 27 6 3 85 4 10 19 20 83 121 109 97 110 116 101 99 32 67 111 114 112 111 114 97 116 105 111 110 49 52 48 50 6 3 85 4 3 19 43 83 121 109 97 110 116 101 99 32 84 105 109 101 32 83 116 97 109 112 105 110 103 32 83 101 114 118 105 99 101 115 32 83 105 103 110 101 114 32 45 32 71 52 48 130 1 34 48 13 6 9 42 134 72 134 247 13 1 1 1 5 0 3 130 1 15 0 48 130 1 10 2 130 1 1 0 162 99 11 57 68 184 187 35 167 68 73 187 14 255 161 240 97 10 83 147 176 152 219 173 44 15 74 197 110 255 134 60 83 85 15 21 206 4 63 43 253 169 150 150 217 190 97 121 11 91 201 76 134 118 229 224 67 75 34 149 238 194 43 67 193 159 216 104 180 142 64 79 238 133 56 185 17 197 35 242 100 88 240 21 50 111 78 87 161 174 136 164 2 215 42 30 205 75 225 221 99 213 23 137 50 91 176 94 153 90 168 157 40 80 14 23 238 150 219 97 59 69 81 29 207 18 86 11 146 71 252 171 174 246 102 61 71 172 112 114 231 146 231 95 205 16 185 196 131 100 148 25 189 37 128 225 232 210 34 165 208 186 2 122 161 119 147 91 101 195 238 23 116 188 65 134 42 220 8 76 140 146 140 145 45 158 119 68 31 104 214 168 116 119 219 14 91 50 139 86 139 51 189 217 99 200 73 157 58 197 197 234 51 11 210 241 163 27 244 139 190 217 179 87 139 59 222 4 167 122 34 178 36 174 46 199 112 197 190 78 131 38 8 251 11 189 169 79 153 8 225 16 40 114 170 205 2 3 1 0 1 163 130 1 87 48 130 1 83 48 12 6 3 85 29 19 1 1 255 4 2 48 0 48 22 6 3 85 29 37 1 1 255 4 12 48 10 6 8 43 6 1 5 5 7 3 8 48 14 6 3 85 29 15 1 1 255 4 4 3 2 7 128 48 115 6 8 43 6 1 5 5 7 1 1 4 103 48 101 48 42 6 8 43 6 1 5 5 7 48 1 134 30 104 116 116 112 58 47 47 116 115 45 111 99 115 112 46 119 115 46 115 121 109 97 110 116 101 99 46 99 111 109 48 55 6 8 43 6 1 5 5 7 48 2 134 43 104 116 116 112 58 47 47 116 115 45 97 105 97 46 119 115 46 115 121 109 97 110 116 101 99 46 99 111 109 47 116 115 115 45 99 97 45 103 50 46 99 101 114 48 60 6 3 85 29 31 4 53 48 51 48 49 160 47 160 45 134 43 104 116 116 112 58 47 47 116 115 45 99 114 108 46 119 115 46 115 121 109 97 110 116 101 99 46 99 111 109 47 116 115 115 45 99 97 45 103 50 46 99 114 108 48 40 6 3 85 29 17 4 33 48 31 164 29 48 27 49 25 48 23 6 3 85 4 3 19 16 84 105 109 101 83 116 97 109 112 45 50 48 52 56 45 50 48 29 6 3 85 29 14 4 22 4 20 70 198 105 163 14 74 20 30 213 76 218 82 99 23 63 94 54 188 13 230 48 31 6 3 85 29 35 4 24 48 22 128 20 95 154 245 110 92 204 204 116 154 212 221 125 239 63 219 236 76 128 46 221 48 13 6 9 42 134 72 134 247 13 1 1 5 5 0 3 130 1 1 0 120 59 180 145 42 0 76 240 143 98 48 55 120 163 132 39 7 111 24 178 222 37 220 160 212 148 3 170 134 78 37 159 154 64 3 28 221 206 227 121 203 33 104 6 218 182 50 180 109 191 244 44 38 99 51 228 73 100 109 13 230 195 103 14 247 5 164 53 108 124 137 22 198 233 178 223 178 233 221 32 198 113 15 205 149 116 220 182 92 222 189 55 31 67 120 230 120 181 205 40 4 32 163 170 241 75 196 136 41 145 14 128 209 17 252 221 92 118 110 79 94 14 69 70 65 110 13 176 234 56 154 177 58 218 9 113 16 252 28 121 180 128 123 172 105 244 253 156 182 12 22 43 241 127 91 9 61 155 91 226 22 202 19 129 109 0 46 56 13 168 41 143 44 225 178 244 90 169 1 175 21 156 44 47 73 27 219 34 187 195 254 120 148 81 195 134 177 130 136 93 240 61 180 81 161 121 51 43 46 123 185 220 32 9 19 113 235 106 25 91 207 232 165 48 87 44 137 73 63 185 207 127 201 191 62 34 104 99 83 154 189 105 116 172 197 29 60 127 146 224 195 188 28 216 4 117 48 130 5 144 48 130 4 120 160 3 2 1 2 2 16 116 37 83 173 7 228 175 209 21 4 175 152 77 73 237 104 48 13 6 9 42 134 72 134 247 13 1 1 5 5 0 48 129 180 49 11 48 9 6 3 85 4 6 19 2 85 83 49 23 48 21 6 3 85 4 10 19 14 86 101 114 105 83 105 103 110 44 32 73 110 99 46 49 31 48 29 6 3 85 4 11 19 22 86 101 114 105 83 105 103 110 32 84 114 117 115 116 32 78 101 116 119 111 114 107 49 59 48 57 6 3 85 4 11 19 50 84 101 114 109 115 32 111 102 32 117 115 101 32 97 116 32 104 116 116 112 115 58 47 47 119 119 119 46 118 101 114 105 115 105 103 110 46 99 111 109 47 114 112 97 32 40 99 41 49 48 49 46 48 44 6 3 85 4 3 19 37 86 101 114 105 83 105 103 110 32 67 108 97 115 115 32 51 32 67 111 100 101 32 83 105 103 110 105 110 103 32 50 48 49 48 32 67 65 48 30 23 13 49 50 48 57 49 56 48 48 48 48 48 48 90 23 13 49 51 48 57 49 56 50 51 53 57 53 57 90 48 129 211 49 11 48 9 6 3 85 4 6 19 2 85 83 49 19 48 17 6 3 85 4 8 19 10 67 97 108 105 102 111 114 110 105 97 49 17 48 15 6 3 85 4 7 19 8 83 97 110 32 74 111 115 101 49 35 48 33 6 3 85 4 10 20 26 65 100 111 98 101 32 83 121 115 116 101 109 115 32 73 110 99 111 114 112 111 114 97 116 101 100 49 18 48 16 6 3 85 4 11 20 9 84 121 112 101 32 70 111 110 116 49 62 48 60 6 3 85 4 11 19 53 68 105 103 105 116 97 108 32 73 68 32 67 108 97 115 115 32 51 32 45 32 77 105 99 114 111 115 111 102 116 32 83 111 102 116 119 97 114 101 32 86 97 108 105 100 97 116 105 111 110 32 118 50 49 35 48 33 6 3 85 4 3 20 26 65 100 111 98 101 32 83 121 115 116 101 109 115 32 73 110 99 111 114 112 111 114 97 116 101 100 48 130 1 34 48 13 6 9 42 134 72 134 247 13 1 1 1 5 0 3 130 1 15 0 48 130 1 10 2 130 1 1 0 183 194 17 83 93 40 162 97 211 4 212 113 190 60 57 62 90 192 30 28 186 237 226 148 195 199 56 131 193 235 45 107 15 74 184 138 39 255 23 21 5 202 222 234 75 161 119 146 100 14 79 246 242 211 246 6 190 153 149 179 99 26 198 178 173 225 166 11 112 231 214 53 82 194 33 138 150 50 44 13 98 138 214 31 215 147 231 18 113 245 12 209 174 113 96 85 116 82 208 174 226 85 149 15 224 15 92 233 55 166 8 75 92 145 255 212 146 186 21 228 98 140 106 115 221 80 171 168 86 158 74 94 114 191 19 205 233 192 211 146 155 140 185 107 10 185 39 79 184 81 155 94 22 105 29 211 238 103 213 40 247 228 12 143 235 124 216 90 200 120 107 245 118 234 50 67 223 114 63 154 114 105 141 0 84 210 9 251 158 218 233 194 224 169 67 212 146 116 74 183 196 1 143 227 48 75 173 177 64 88 87 96 214 143 131 243 139 235 192 189 213 67 79 101 17 63 114 21 23 94 173 218 255 113 5 178 41 158 156 13 120 136 231 237 75 156 146 164 205 161 26 253 143 8 158 173 2 3 1 0 1 163 130 1 123 48 130 1 119 48 9 6 3 85 29 19 4 2 48 0 48 14 6 3 85 29 15 1 1 255 4 4 3 2 7 128 48 64 6 3 85 29 31 4 57 48 55 48 53 160 51 160 49 134 47 104 116 116 112 58 47 47 99 115 99 51 45 50 48 49 48 45 99 114 108 46 118 101 114 105 115 105 103 110 46 99 111 109 47 67 83 67 51 45 50 48 49 48 46 99 114 108 48 68 6 3 85 29 32 4 61 48 59 48 57 6 11 96 134 72 1 134 248 69 1 7 23 3 48 42 48 40 6 8 43 6 1 5 5 7 2 1 22 28 104 116 116 112 115 58 47 47 119 119 119 46 118 101 114 105 115 105 103 110 46 99 111 109 47 99 112 115 48 19 6 3 85 29 37 4 12 48 10 6 8 43 6 1 5 5 7 3 3 48 113 6 8 43 6 1 5 5 7 1 1 4 101 48 99 48 36 6 8 43 6 1 5 5 7 48 1 134 24 104 116 116 112 58 47 47 111 99 115 112 46 118 101 114 105 115 105 103 110 46 99 111 109 48 59 6 8 43 6 1 5 5 7 48 2 134 47 104 116 116 112 58 47 47 99 115 99 51 45 50 48 49 48 45 97 105 97 46 118 101 114 105 115 105 103 110 46 99 111 109 47 67 83 67 51 45 50 48 49 48 46 99 101 114 48 31 6 3 85 29 35 4 24 48 22 128 20 207 153 169 234 123 38 244 75 201 142 143 215 240 5 38 239 227 210 167 157 48 17 6 9 96 134 72 1 134 248 66 1 1 4 4 3 2 4 16 48 22 6 10 43 6 1 4 1 130 55 2 1 27 4 8 48 6 1 1 0 1 1 255 48 13 6 9 42 134 72 134 247 13 1 1 5 5 0 3 130 1 1 0 170 104 97 189 175 221 82 2 196 142 65 165 125 111 136 158 190 254 185 203 183 107 237 194 56 101 27 98 49 68 219 155 173 57 51 191 133 148 255 108 0 249 186 148 148 160 155 91 231 79 31 45 3 89 224 227 162 221 99 214 188 229 43 116 1 123 45 164 0 116 54 219 94 146 153 155 248 123 23 185 191 221 56 76 230 44 132 250 78 42 218 16 153 213 244 141 149 129 51 237 100 15 155 72 68 34 52 95 7 99 113 219 104 204 209 81 255 56 223 218 232 14 179 193 234 37 175 8 179 12 157 202 48 147 202 12 126 221 59 128 216 35 162 10 213 22 37 220 12 218 219 221 50 3 181 155 31 250 209 82 249 217 154 42 16 62 140 177 151 27 65 46 169 31 1 47 111 73 9 220 108 183 43 206 127 216 47 220 204 125 246 105 30 223 148 29 201 197 118 165 226 247 52 43 118 211 244 46 62 20 226 234 106 65 242 223 237 127 14 47 220 238 174 246 5 108 10 64 64 241 79 33 138 131 131 164 182 142 7 103 21 115 212 6 96 220 196 218 25 139 75 40 53 182 193 225 48 130 6 10 48 130 4 242 160 3 2 1 2 2 16 82 0 229 170 37 86 252 26 134 237 150 201 212 75 51 199 48 13 6 9 42 134 72 134 247 13 1 1 5 5 0 48 129 202 49 11 48 9 6 3 85 4 6 19 2 85 83 49 23 48 21 6 3 85 4 10 19 14 86 101 114 105 83 105 103 110 44 32 73 110 99 46 49 31 48 29 6 3 85 4 11 19 22 86 101 114 105 83 105 103 110 32 84 114 117 115 116 32 78 101 116 119 111 114 107 49 58 48 56 6 3 85 4 11 19 49 40 99 41 32 50 48 48 54 32 86 101 114 105 83 105 103 110 44 32 73 110 99 46 32 45 32 70 111 114 32 97 117 116 104 111 114 105 122 101 100 32 117 115 101 32 111 110 108 121 49 69 48 67 6 3 85 4 3 19 60 86 101 114 105 83 105 103 110 32 67 108 97 115 115 32 51 32 80 117 98 108 105 99 32 80 114 105 109 97 114 121 32 67 101 114 116 105 102 105 99 97 116 105 111 110 32 65 117 116 104 111 114 105 116 121 32 45 32 71 53 48 30 23 13 49 48 48 50 48 56 48 48 48 48 48 48 90 23 13 50 48 48 50 48 55 50 51 53 57 53 57 90 48 129 180 49 11 48 9 6 3 85 4 6 19 2 85 83 49 23 48 21 6 3 85 4 10 19 14 86 101 114 105 83 105 103 110 44 32 73 110 99 46 49 31 48 29 6 3 85 4 11 19 22 86 101 114 105 83 105 103 110 32 84 114 117 115 116 32 78 101 116 119 111 114 107 49 59 48 57 6 3 85 4 11 19 50 84 101 114 109 115 32 111 102 32 117 115 101 32 97 116 32 104 116 116 112 115 58 47 47 119 119 119 46 118 101 114 105 115 105 103 110 46 99 111 109 47 114 112 97 32 40 99 41 49 48 49 46 48 44 6 3 85 4 3 19 37 86 101 114 105 83 105 103 110 32 67 108 97 115 115 32 51 32 67 111 100 101 32 83 105 103 110 105 110 103 32 50 48 49 48 32 67 65 48 130 1 34 48 13 6 9 42 134 72 134 247 13 1 1 1 5 0 3 130 1 15 0 48 130 1 10 2 130 1 1 0 245 35 75 94 165 215 138 187 50 233 212 87 247 239 228 199 38 126 173 25 152 254 168 157 125 148 246 54 107 16 215 117 129 48 127 4 104 127 203 43 117 30 205 29 8 140 223 105 148 167 55 163 156 123 128 224 153 225 238 55 77 95 206 59 20 238 134 212 208 245 39 53 188 37 11 56 167 140 99 157 23 163 8 165 171 176 251 205 106 98 130 76 213 33 218 27 217 241 227 132 59 138 42 79 133 91 144 1 79 201 167 118 16 127 39 3 124 190 174 126 125 193 221 249 5 188 27 72 156 105 231 192 164 60 60 65 0 62 223 150 229 197 228 148 113 214 85 1 199 0 38 74 64 60 181 161 38 169 12 167 109 128 142 144 37 123 207 191 63 28 235 47 150 250 229 135 119 198 181 86 178 122 59 84 48 83 27 223 98 52 255 30 209 244 90 147 40 133 229 76 23 78 126 91 253 164 147 153 127 223 205 239 164 117 239 239 21 246 71 231 248 25 114 216 46 52 26 166 180 167 76 126 189 187 79 12 61 87 241 48 214 166 54 142 214 128 118 215 25 46 165 205 126 52 45 137 2 3 1 0 1 163 130 1 254 48 130 1 250 48 18 6 3 85 29 19 1 1 255 4 8 48 6 1 1 255 2 1 0 48 112 6 3 85 29 32 4 105 48 103 48 101 6 11 96 134 72 1 134 248 69 1 7 23 3 48 86 48 40 6 8 43 6 1 5 5 7 2 1 22 28 104 116 116 112 115 58 47 47 119 119 119 46 118 101 114 105 115 105 103 110 46 99 111 109 47 99 112 115 48 42 6 8 43 6 1 5 5 7 2 2 48 30 26 28 104 116 116 112 115 58 47 47 119 119 119 46 118 101 114 105 115 105 103 110 46 99 111 109 47 114 112 97 48 14 6 3 85 29 15 1 1 255 4 4 3 2 1 6 48 109 6 8 43 6 1 5 5 7 1 12 4 97 48 95 161 93 160 91 48 89 48 87 48 85 22 9 105 109 97 103 101 47 103 105 102 48 33 48 31 48 7 6 5 43 14 3 2 26 4 20 143 229 211 26 134 172 141 142 107 195 207 128 106 212 72 24 44 123 25 46 48 37 22 35 104 116 116 112 58 47 47 108 111 103 111 46 118 101 114 105 115 105 103 110 46 99 111 109 47 118 115 108 111 103 111 46 103 105 102 48 52 6 3 85 29 31 4 45 48 43 48 41 160 39 160 37 134 35 104 116 116 112 58 47 47 99 114 108 46 118 101 114 105 115 105 103 110 46 99 111 109 47 112 99 97 51 45 103 53 46 99 114 108 48 52 6 8 43 6 1 5 5 7 1 1 4 40 48 38 48 36 6 8 43 6 1 5 5 7 48 1 134 24 104 116 116 112 58 47 47 111 99 115 112 46 118 101 114 105 115 105 103 110 46 99 111 109 48 29 6 3 85 29 37 4 22 48 20 6 8 43 6 1 5 5 7 3 2 6 8 43 6 1 5 5 7 3 3 48 40 6 3 85 29 17 4 33 48 31 164 29 48 27 49 25 48 23 6 3 85 4 3 19 16 86 101 114 105 83 105 103 110 77 80 75 73 45 50 45 56 48 29 6 3 85 29 14 4 22 4 20 207 153 169 234 123 38 244 75 201 142 143 215 240 5 38 239 227 210 167 157 48 31 6 3 85 29 35 4 24 48 22 128 20 127 211 101 167 194 221 236 187 240 48 9 243 67 57 250 2 175 51 49 51 48 13 6 9 42 134 72 134 247 13 1 1 5 5 0 3 130 1 1 0 86 34 230 52 164 196 97 203 72 185 1 173 86 168 100 15 217 140 145 196 187 204 12 229 173 122 160 34 127 223 71 56 74 45 108 209 127 113 26 124 236 112 169 177 240 79 228 15 12 83 250 21 94 254 116 152 73 36 133 129 38 28 145 20 71 176 76 99 140 187 161 52 212 198 69 232 13 133 38 115 3 208 169 140 100 109 220 113 146 230 69 5 96 21 89 81 57 252 88 20 107 254 212 164 237 121 107 8 12 65 114 231 55 34 6 9 190 35 233 63 68 154 30 233 97 157 204 177 144 92 252 61 210 141 172 66 61 101 54 212 180 61 64 40 143 155 16 207 35 38 204 75 32 203 144 31 93 140 76 52 202 60 216 229 55 214 111 165 32 189 52 235 38 217 174 13 231 197 154 247 161 180 33 145 51 111 134 232 88 187 37 124 116 14 88 254 117 27 99 63 206 49 124 155 143 27 150 158 197 83 118 132 91 156 173 145 250 172 237 147 186 93 200 33 83 194 130 83 99 175 18 13 80 135 17 27 61 84 82 150 138 44 156 61 146 26 8 154 5 46 199 147 165 72 145 211 49 130 4 155 48 130 4 151 2 1 1 48 129 201 48 129 180 49 11 48 9 6 3 85 4 6 19 2 85 83 49 23 48 21 6 3 85 4 10 19 14 86 101 114 105 83 105 103 110 44 32 73 110 99 46 49 31 48 29 6 3 85 4 11 19 22 86 101 114 105 83 105 103 110 32 84 114 117 115 116 32 78 101 116 119 111 114 107 49 59 48 57 6 3 85 4 11 19 50 84 101 114 109 115 32 111 102 32 117 115 101 32 97 116 32 104 116 116 112 115 58 47 47 119 119 119 46 118 101 114 105 115 105 103 110 46 99 111 109 47 114 112 97 32 40 99 41 49 48 49 46 48 44 6 3 85 4 3 19 37 86 101 114 105 83 105 103 110 32 67 108 97 115 115 32 51 32 67 111 100 101 32 83 105 103 110 105 110 103 32 50 48 49 48 32 67 65 2 16 116 37 83 173 7 228 175 209 21 4 175 152 77 73 237 104 48 9 6 5 43 14 3 2 26 5 0 160 129 152 48 20 6 9 43 6 1 4 1 130 55 40 1 49 7 3 5 0 3 0 0 0 48 25 6 9 42 134 72 134 247 13 1 9 3 49 12 6 10 43 6 1 4 1 130 55 2 1 4 48 28 6 10 43 6 1 4 1 130 55 2 1 11 49 14 48 12 6 10 43 6 1 4 1 130 55 2 1 21 48 34 6 10 43 6 1 4 1 130 55 2 1 12 49 20 48 18 161 16 128 14 119 119 119 46 97 100 111 98 101 46 99 111 109 32 48 35 6 9 42 134 72 134 247 13 1 9 4 49 22 4 20 239 26 40 54 240 19 227 167 63 249 12 204 40 229 31 250 65 101 168 31 48 13 6 9 42 134 72 134 247 13 1 1 1 5 0 4 130 1 0 92 148 252 160 237 142 226 134 113 166 227 177 238 184 113 95 129 229 2 8 22 28 87 211 142 196 151 218 150 40 0 244 116 209 96 127 12 46 111 123 215 43 78 17 76 210 247 127 22 7 24 13 231 173 207 67 122 24 0 219 135 201 54 65 167 47 201 124 235 128 8 120 137 133 103 62 49 209 118 164 110 224 60 87 43 40 9 89 157 24 54 40 224 73 237 99 12 250 159 199 121 5 119 123 117 246 244 21 41 42 229 54 15 118 142 88 122 140 32 219 100 64 250 110 157 28 75 72 97 231 141 120 182 161 66 7 44 227 124 143 130 229 83 62 59 228 168 64 245 128 248 92 63 202 138 84 106 192 58 105 193 128 173 18 167 8 1 80 123 92 17 46 148 238 197 233 230 62 158 125 51 8 201 146 40 44 115 63 69 107 187 9 137 129 163 200 164 134 200 215 28 62 153 117 104 123 201 140 13 28 90 250 86 201 134 57 57 19 217 27 7 210 248 19 19 230 49 84 208 35 99 106 67 204 51 2 226 228 140 203 255 124 197 62 95 95 37 151 225 54 81 196 79 66 82 198 161 130 2 11 48 130 2 7 6 9 42 134 72 134 247 13 1 9 6 49 130 1 248 48 130 1 244 2 1 1 48 114 48 94 49 11 48 9 6 3 85 4 6 19 2 85 83 49 29 48 27 6 3 85 4 10 19 20 83 121 109 97 110 116 101 99 32 67 111 114 112 111 114 97 116 105 111 110 49 48 48 46 6 3 85 4 3 19 39 83 121 109 97 110 116 101 99 32 84 105 109 101 32 83 116 97 109 112 105 110 103 32 83 101 114 118 105 99 101 115 32 67 65 32 45 32 71 50 2 16 14 207 244 56 200 254 191 53 110 4 216 106 152 27 26 80 48 9 6 5 43 14 3 2 26 5 0 160 93 48 24 6 9 42 134 72 134 247 13 1 9 3 49 11 6 9 42 134 72 134 247 13 1 7 1 48 28 6 9 42 134 72 134 247 13 1 9 5 49 15 23 13 49 51 48 52 50 48 50 51 49 50 51 53 90 48 35 6 9 42 134 72 134 247 13 1 9 4 49 22 4 20 188 31 20 21 192 69 123 177 179 125 96 116 11 8 33 137 251 148 9 13 48 13 6 9 42 134 72 134 247 13 1 1 1 5 0 4 130 1 0 27 240 36 109 63 110 145 42 205 70 189 53 239 88 52 19 113 85 236 254 140 63 114 22 188 92 182 153 63 167 99 111 215 13 173 108 51 5 20 254 126 46 168 58 107 252 43 178 113 2 243 71 226 170 175 4 199 167 188 117 195 238 111 192 145 53 23 199 26 124 245 161 224 16 79 233 192 39 79 207 78 242 63 48 79 2 125 115 134 208 115 40 28 72 148 166 33 224 234 62 191 170 227 25 100 16 191 215 92 125 108 68 201 74 152 178 78 222 245 134 129 246 177 213 149 21 177 211 231 94 154 153 126 231 114 66 91 242 211 31 1 119 65 47 223 109 71 117 98 38 196 0 142 245 75 170 167 115 73 205 65 69 228 154 176 154 10 129 54 21 167 56 168 93 146 46 252 81 206 181 239 234 145 10 190 45 249 148 54 28 168 47 151 42 65 101 249 102 161 108 200 135 247 86 4 134 104 46 222 58 125 89 152 68 142 98 8 95 232 185 34 190 121 230 47 206 184 232 39 218 180 232 135 20 57 102 108 202 94 59 153 223 36 19 103 230 123 119 89 188 252 204 4 41 74 135]! !

!SourceSansProRegular class methodsFor: 'class initialization' stamp: 'EstebanLorenzano 12/1/2014 14:54'!
initialize 
	EmbeddedFreeTypeFontInstaller registerFont: self! !

!SourceSansProRegular class methodsFor: 'accessing' stamp: 'EstebanLorenzano 12/1/2014 14:54'!
originalFileName
	^ 'SourceSansPro-Regular.ttf'! !

!SpaceTally commentStamp: 'sd 6/20/2003 22:31'!
I'm responsible to help getting information about system space usage. The information I compute is represented by a spaceTallyItem

try something like: 

((SpaceTally new spaceTally: (Array with: TextMorph with: Point)) 
	asSortedCollection: [:a :b | a spaceForInstances > b spaceForInstances]) 

SpaceTally new systemWideSpaceTally


This class has been created from a part of SystemDictionary. It still deserves a nice
clean, such as using object instead of array having 4 slots.

sd-20 June 2003!
!SpaceTally methodsFor: 'class analysis' stamp: 'MarianoMartinezPeck 10/1/2010 16:24'!
computeSpaceUsage

	| entry c instanceCount |
	1 to: results size do: [:i |
		entry := results at: i.
		c := self class environment at: entry analyzedClassName.
		instanceCount := c instanceCount.
		entry codeSize: c spaceUsed.
		entry instanceCount: instanceCount.
		entry spaceForInstances: (c instancesSizeInMemory).
		Smalltalk garbageCollectMost].
	
! !

!SpaceTally methodsFor: 'fileout' stamp: 'ChristopheDemarey 9/26/2014 13:21'!
printSpaceTallyItem: aSpaceTallyItem percent: percent on: aStream
	aStream
		nextPutAll: (aSpaceTallyItem analyzedClassName padRightTo: 45);
		nextPutAll: (aSpaceTallyItem codeSize printString padLeftTo: 12);
		nextPutAll: (aSpaceTallyItem instanceCount printString padLeftTo: 12);
		nextPutAll: (aSpaceTallyItem spaceForInstances printString padLeftTo: 14).
	aStream 
		nextPutAll: ((percent printShowingDecimalPlaces: 2) padLeftTo: 12);
		nextPutAll: (((aSpaceTallyItem spaceForInstances / (aSpaceTallyItem instanceCount max: 1)) asFloat printShowingDecimalPlaces: 2) padLeftTo: 20);
		cr! !

!SpaceTally methodsFor: 'fileout' stamp: 'MarcusDenker 6/30/2014 13:28'!
printSpaceAnalysis	
	| stream |
	stream := FileStream newFileNamed: 'STspace.text'.
	[ self printSpaceAnalysis: 1 on: stream ] ensure: [ stream close ]! !

!SpaceTally methodsFor: 'fileout' stamp: 'ChristopheDemarey 9/26/2014 13:32'!
computeSpaceForClass: cl
	| codeSpace totalInstSpace instSpace totalInstCount totalCodeSpace instCount |
	codeSpace := cl spaceUsed.
	Smalltalk garbageCollectMost.
	instCount := cl instanceCount.
	instSpace := cl instancesSizeInMemory.
	totalCodeSpace := totalCodeSpace + codeSpace.
	totalInstCount := totalInstCount + instCount.
	totalInstSpace := totalInstSpace + instSpace.
	^ results
		add:
			(SpaceTallyItem
				analyzedClassName: cl name
				codeSize: codeSpace
				instanceCount: instCount
				spaceForInstances: instSpace)! !

!SpaceTally methodsFor: 'fileout' stamp: 'ChristopheDemarey 9/26/2014 13:59'!
printSpaceDifferenceFrom: fileName1 to: fileName2
	"For differential results, run printSpaceAnalysis twice with different fileNames,
	then run this method...
		SpaceTally new printSpaceAnalysis: 0 on: 'STspace.text1' asFileReference writeStream.
			--- do something that uses space here ---
		SpaceTally new printSpaceAnalysis: 0 on: 'STspace.text2' asFileReference writeStream.
		SpaceTally new printSpaceDifferenceFrom: 'STspace.text1' to: 'STspace.text2'
"
	| f coll1 coll2 item |
	f := FileStream readOnlyFileNamed: fileName1.
	coll1 := OrderedCollection new.
	[f atEnd] whileFalse: [coll1 add: f nextLine].
	f close.
	f := FileStream readOnlyFileNamed: fileName2.
	coll2 := OrderedCollection new.
	[f atEnd] whileFalse:
		[item := f nextLine.
		((coll1 includes: item) and: [(item endsWith: 'percent') not])
			ifTrue: [coll1 remove: item]
			ifFalse: [coll2 add: item]].
	f close.
	StandardWindow new 
		withText: (String streamContents: 
			[:s | 
			s nextPutAll: fileName1; cr.
			coll1 do: [:x | s nextPutAll: x; cr].
			s cr; cr.
			s nextPutAll: fileName2; cr.
			coll2 do: [:x | s nextPutAll: x; cr]])
		 label: 'Differential Space Analysis';
		openInWorld! !

!SpaceTally methodsFor: 'fileout' stamp: 'CamilloBruni 5/26/2012 12:25'!
saveTo: aFileName
	"| st |
	st := SpaceTally new.
	st spaceTally: (Array with: TextMorph with: Point).
	st saveTo: 'spaceTally2'"
	| file |
	file := aFileName asFileReference.
	file exists ifTrue: [ file delete ].
	
	file writeStreamDo: [ :s|
		results do: [:each | s nextPutAll: each analyzedClassName asString ; 
						nextPutAll: ' '; nextPutAll: each codeSize printString; 
						nextPutAll: ' '; nextPutAll: each instanceCount printString; 
						nextPutAll: ' '; nextPutAll: each spaceForInstances printString; cr]].! !

!SpaceTally methodsFor: 'class analysis' stamp: 'ChristopheDemarey 9/26/2014 13:59'!
compareTallyIn: beforeFileName to: afterFileName
	"SpaceTally new compareTallyIn: 'tally' to: 'tally2'"

	| answer beforeDict a afterDict allKeys |
	beforeDict := Dictionary new.
	beforeFileName asFileReference readStreamDo: [ :s|
		[s atEnd] whileFalse: [
			a := Array readFrom: s nextLine.
			beforeDict at: a first put: a allButFirst ]].
	afterDict := Dictionary new.
	
	afterFileName asFileReference readStreamDo: [ :s|
		[s atEnd] whileFalse: [
			a := Array readFrom: s nextLine.
			afterDict at: a first put: a allButFirst ]].

	answer := String new writeStream.
	allKeys := (Set new addAll: beforeDict keys; addAll: afterDict keys; yourself) asSortedCollection.
	allKeys do: [ :each | | before diff after |
		before := beforeDict at: each ifAbsent: [#(0 0 0)].
		after := afterDict at: each ifAbsent: [#(0 0 0)].
		diff := before with: after collect: [ :vBefore :vAfter | vAfter - vBefore].
		diff = #(0 0 0) ifFalse: [
			answer nextPutAll: each,'  ',diff printString; cr.
		].
	].
	StandardWindow new
		withText: answer contents
		label: 'space diffs';
		openInWorld
	


! !

!SpaceTally methodsFor: 'class analysis' stamp: 'sd 6/20/2003 22:24'!
spaceTally: classes
	"Answer a collection of SpaceTallyItems representing the memory space (in bytes) consumed 	by the code and instances of each class in the system. Note that code sizes do not currently 	report memory consumed by class variables. "

	"((SpaceTally new spaceTally: (Array with: TextMorph with: Point)) asSortedCollection: [:a :b | a spaceForInstances > b spaceForInstances]) asArray"

	self preAllocateResultsFor: classes.
	Smalltalk garbageCollect.
	self computeSpaceUsage.
	^ results
! !

!SpaceTally methodsFor: 'class analysis' stamp: 'StephaneDucasse 3/20/2010 14:29'!
systemWideSpaceTally
	"Answer a collection of SpaceTallyItems representing the memory space (in bytes) consumed 	by the code and instances of each class in the system. Note that code sizes do not currently 	report memory consumed by class variables. "

	"(SpaceTally new systemWideSpaceTally asSortedCollection: [:a :b | a spaceForInstances > b spaceForInstances]) asArray"

	^self spaceTally: Smalltalk globals allClasses.

! !

!SpaceTally methodsFor: 'fileout' stamp: 'ChristopheDemarey 9/26/2014 13:04'!
printHeader: aStream
	aStream
		nextPutAll: ('Class' padRightTo: 45);
		nextPutAll: ('code space' padLeftTo: 12);
		nextPutAll: ('# instances' padLeftTo: 12);
		nextPutAll: ('inst space' padLeftTo: 12);
		nextPutAll: ('percent' padLeftTo: 12);
		nextPutAll: ('inst average size' padLeftTo: 20);
		cr! !

!SpaceTally methodsFor: 'accessing' stamp: 'sd 6/20/2003 22:31'!
results

	^ results! !

!SpaceTally methodsFor: 'fileout' stamp: 'ChristopheDemarey 9/26/2014 13:40'!
printSpaceAnalysis: threshold on: aStream
	"SpaceTally new printSpaceAnalysis: 1 on: (FileStream forceNewFileNamed: 'STspace.text')"

	"sd-This method should be rewrote to be more coherent within the rest of the class 
	ie using preAllocate and spaceForInstanceOf:"

	"If threshold > 0, then only those classes with more than that number
	of instances will be shown, and they will be sorted by total instance space.
	If threshold = 0, then all classes will appear, sorted by name."

	| totalCodeSpace totalInstCount totalInstSpace n totalPercent |
	Smalltalk garbageCollect.
	totalCodeSpace := totalInstCount := totalInstSpace := n := 0.
	results := OrderedCollection new: Smalltalk classNames size.
	'Taking statistics...'
		displayProgressFrom: 0
		to: Smalltalk classNames size
		during: [ :bar | 
			Smalltalk globals allClasses
				do: [ :cl | 
					| codeSpace  instSpace   instCount |
					bar current: (n := n + 1).
					codeSpace := cl spaceUsed.
					Smalltalk garbageCollectMost.
					instCount := cl instanceCount.
					instSpace := cl instancesSizeInMemory.
					totalCodeSpace := totalCodeSpace + codeSpace.
					totalInstCount := totalInstCount + instCount.
					totalInstSpace := totalInstSpace + instSpace.
					results
						add:
							(SpaceTallyItem
								analyzedClassName: cl name
								codeSize: codeSpace
								instanceCount: instCount
								spaceForInstances: instSpace) ] ].
	totalPercent := 0.0.
	self printHeader: aStream.
	threshold > 0
		ifTrue: [ 
			"If inst count threshold > 0, then sort by space"
			results := (results
				select: [ :s | s instanceCount >= threshold or: [ s spaceForInstances > (totalInstSpace // 500) ] ])
				asSortedCollection: [ :s :s2 | s spaceForInstances > s2 spaceForInstances ] ].
	results
		do: [ :s | 
			| percent |
			percent := s spaceForInstances * 100.0 / totalInstSpace roundTo: 0.1.
			totalPercent := totalPercent + percent.
			self printSpaceTallyItem: s percent: percent on: aStream ].
	aStream
		cr;
		nextPutAll: ('Total' padRightTo: 45);
		nextPutAll: (totalCodeSpace printString padLeftTo: 12);
		nextPutAll: (totalInstCount printString padLeftTo: 12);
		nextPutAll: (totalInstSpace printString padLeftTo: 14);
		nextPutAll: ((totalPercent roundTo: 0.1) printString padLeftTo: 12)! !

!SpaceTally methodsFor: 'class analysis' stamp: 'sd 6/20/2003 22:54'!
preAllocateResultsFor: classes

	results := OrderedCollection new: classes size.
	classes do: [:cl | results add: (SpaceTallyItem analyzedClassName: cl name)].
	results := results asArray.
! !

!SpaceTally class methodsFor: 'fileout' stamp: 'MarcusDenjer 6/30/2014 13:22'!
printSpaceAnalysis	
	"SpaceTally printSpaceAnalysis"
	self new printSpaceAnalysis! !

!SpaceTallyItem commentStamp: 'sd 6/20/2003 22:02'!
I'm represent an entry in the spaceTally.!
!SpaceTallyItem methodsFor: 'accessing' stamp: 'sd 6/20/2003 22:09'!
instanceCount

	^ instanceCount! !

!SpaceTallyItem methodsFor: 'accessing' stamp: 'sd 6/20/2003 22:09'!
instanceCount: aNumber

	instanceCount := aNumber! !

!SpaceTallyItem methodsFor: 'accessing' stamp: 'sd 6/20/2003 22:59'!
analyzedClassName

	^ analyzedClassName! !

!SpaceTallyItem methodsFor: 'accessing' stamp: 'sd 6/20/2003 22:10'!
spaceForInstances

	^ spaceForInstances! !

!SpaceTallyItem methodsFor: 'printing' stamp: 'sd 6/20/2003 22:52'!
printOn: aStream

	analyzedClassName isNil
		ifFalse: [aStream nextPutAll: analyzedClassName asString]. 
	aStream nextPutAll: ' ('.
	codeSize isNil
		ifFalse: [aStream nextPutAll: 'code size: ' ;  nextPutAll: codeSize asString]. 
	instanceCount isNil
		ifFalse: [aStream nextPutAll: ' instance count: ' ;  nextPutAll: instanceCount asString]. 
	spaceForInstances isNil
		ifFalse: [aStream nextPutAll: ' space for instances: ' ;  nextPutAll: spaceForInstances asString]. 
	aStream nextPut: $).
	! !

!SpaceTallyItem methodsFor: 'accessing' stamp: 'sd 6/20/2003 22:10'!
spaceForInstances: aNumber

	spaceForInstances := aNumber! !

!SpaceTallyItem methodsFor: 'accessing' stamp: 'sd 6/20/2003 22:09'!
codeSize: aNumber

	codeSize := aNumber! !

!SpaceTallyItem methodsFor: 'accessing' stamp: 'sd 6/20/2003 22:59'!
analyzedClassName: aClassName

	analyzedClassName := aClassName! !

!SpaceTallyItem methodsFor: 'accessing' stamp: 'sd 6/20/2003 22:08'!
codeSize

	^ codeSize! !

!SpaceTallyItem class methodsFor: 'instance creation' stamp: 'sd 6/20/2003 22:54'!
analyzedClassName: aClassName codeSize: codeSize instanceCount: instanceCount spaceForInstances: spaceForInstances

	^ self new
		analyzedClassName: aClassName ;
		codeSize: codeSize ;
		instanceCount: instanceCount ;
		spaceForInstances: spaceForInstances ; yourself! !

!SpaceTallyItem class methodsFor: 'instance creation' stamp: 'sd 6/20/2003 22:54'!
analyzedClassName: aClassName

	^ self new
		analyzedClassName: aClassName ; yourself
		! !

!SparseLargeArray commentStamp: 'JB 11/26/2010 16:35'!
A version of SparseLargeTable that does not populate its bins until a value other than the default is stored.!!!
!SparseLargeArray methodsFor: 'initialization' stamp: 'JB 11/26/2010 16:37'!
initChunkSize: aChunkSize size: aSize arrayClass: aClass base: b defaultValue: d
       chunkSize := aChunkSize.
       size := aSize.
       base := b.
       defaultValue := d.
       arrayClass := aClass! !

!SparseLargeArray methodsFor: 'accessing' stamp: 'JB 11/26/2010 16:38'!
noCheckAt: index
      ^(self basicAt: index - base // chunkSize + 1)
               ifNil: [defaultValue]
               ifNotNil: [:chunk| chunk at: index - base \\ chunkSize + 1]! !

!SparseLargeArray methodsFor: 'private' stamp: 'JB 11/26/2010 16:37'!
analyzeSpaceSaving

      | elems tablesTotal nonNilTables lastPage lastChunkSize |
      elems := 0.
       tablesTotal := self basicSize.
       nonNilTables := 0.
       lastPage := self basicAt: self basicSize.
       (lastChunkSize := size \\ chunkSize) = 0 ifTrue:
               [lastChunkSize := chunkSize].
       1 to: self basicSize do:
               [:i | | page |
               (page := self basicAt: i) ifNotNil:
                       [nonNilTables := nonNilTables + 1.
                        1 to: (page == lastPage ifTrue: [lastChunkSize] ifFalse: [chunkSize]) do:
                               [:j|
                               (page at: j) ~= defaultValue ifTrue:
                                       [elems := elems + 1]]]].

       ^String streamContents:
               [:strm |
               strm nextPutAll: 'total: '; print: size.
               strm nextPutAll: ' elements: '; print: elems.
               strm nextPutAll: ' tables: '; print: tablesTotal.
               strm nextPutAll: ' non-nil: '; print: nonNilTables]! !

!SparseLargeArray methodsFor: 'accessing' stamp: 'JB 11/26/2010 16:37'!
atAllPut: anObject
       "Put anObject at every one of the receiver's indices."

       1 to: self basicSize do:
               [:i|
               self basicAt: i put: nil].
       defaultValue := anObject! !

!SparseLargeArray methodsFor: 'accessing' stamp: 'JB 11/26/2010 16:38'!
noCheckAt: index put: value
       | chunkIndex chunk lastChunkSize |
       chunkIndex := index - base // chunkSize + 1.
       (chunk := self basicAt: chunkIndex) ifNil:
               [value = defaultValue ifTrue:
                       [^value].
               chunk := arrayClass
                                       new: ((chunkIndex == self basicSize
                                                  and: [(lastChunkSize := size \\ chunkSize) > 0])
                                                       ifTrue: [lastChunkSize]
                                                       ifFalse: [chunkSize])
                                       withAll: defaultValue.
               self basicAt: chunkIndex put: chunk].
       ^chunk at: index - base \\ chunkSize + 1 put: value! !

!SparseLargeTable commentStamp: '<historical>'!
Derivated from Stephan Pair's LargeArray, but to hold a sparse table, in which most of the entries are the same default value, it uses some tricks.!
!SparseLargeTable methodsFor: 'initialization' stamp: 'yo 12/1/2003 16:58'!
initChunkSize: aChunkSize size: aSize arrayClass: aClass base: b defaultValue: d

	| lastChunkSize |
	chunkSize := aChunkSize.
	size := aSize.
	base := b.
	defaultValue := d.
	1 to: (self basicSize - 1) do: [ :in | self basicAt: in put: (aClass new: chunkSize withAll: defaultValue) ].
	lastChunkSize := size \\ chunkSize.
	lastChunkSize = 0 ifTrue: [lastChunkSize := chunkSize].
	size = 0 
		ifTrue: [self basicAt: 1 put: (aClass new: 0)]
		ifFalse: [self basicAt: self basicSize put: (aClass new: lastChunkSize withAll: defaultValue)].
! !

!SparseLargeTable methodsFor: 'accessing' stamp: 'tak 12/21/2004 16:59'!
noCheckAt: index
	| chunkIndex t |

	chunkIndex := index - base // chunkSize + 1.
	(chunkIndex > self basicSize or: [chunkIndex < 1]) ifTrue: [^ defaultValue].
	t := self basicAt: chunkIndex.
	t ifNil: [^ defaultValue].
	^ t at: (index - base + 1 - (chunkIndex - 1 * chunkSize))
! !

!SparseLargeTable methodsFor: 'private' stamp: 'yo 12/1/2003 19:19'!
privateSize: s

	size := s.
! !

!SparseLargeTable methodsFor: 'private' stamp: 'yo 12/1/2003 17:34'!
pvtCheckIndex: index 

	index isInteger ifFalse: [self errorNonIntegerIndex].
	index < 1 ifTrue: [self errorSubscriptBounds: index].
	index > size ifTrue: [self errorSubscriptBounds: index].
! !

!SparseLargeTable methodsFor: 'private' stamp: 'yo 12/1/2003 16:00'!
similarSpeciesInstance: newSize

	^self similarInstance: newSize
! !

!SparseLargeTable methodsFor: 'private' stamp: 'yo 12/1/2003 16:00'!
speciesNew

	^self species
		new: self size 
		chunkSize: self chunkSize 
		arrayClass: self arrayClass
! !

!SparseLargeTable methodsFor: 'accessing' stamp: 'yo 12/1/2003 15:58'!
at: index

	self pvtCheckIndex: index.
	^self noCheckAt: index.
! !

!SparseLargeTable methodsFor: 'printing' stamp: 'yo 12/1/2003 15:58'!
printOn: aStream

	(#(String) includes: self arrayClass name) 
		ifTrue: [^self storeOn: aStream].
	^super printOn: aStream
! !

!SparseLargeTable methodsFor: 'private' stamp: 'yo 12/1/2003 17:10'!
analyzeSpaceSaving

	| total elems tablesTotal nonNilTables |
	total := size - base + 1.
	elems := 0.
	base to: size do: [:i | (self at: i) ~= defaultValue ifTrue: [elems := elems + 1]].
	tablesTotal := self basicSize.
	nonNilTables := 0.
	1 to: self basicSize do: [:i | (self basicAt: i) ifNotNil: [nonNilTables := nonNilTables + 1]].

	^ String streamContents: [:strm |
		strm nextPutAll: 'total: '.
		strm nextPutAll: total printString.
		strm nextPutAll: ' elements: '.
		strm nextPutAll: elems printString.
		strm nextPutAll: ' tables: '.
		strm nextPutAll: tablesTotal printString.
		strm nextPutAll: ' non-nil: '.
		strm nextPutAll: nonNilTables printString.
	].

! !

!SparseLargeTable methodsFor: 'printing' stamp: 'yo 12/1/2003 17:06'!
printElementsOn: aStream
	| element |
	aStream nextPut: $(.
	base to: size do: [:index | element := self at: index. aStream print: element; space].
	self isEmpty ifFalse: [aStream skip: -1].
	aStream nextPut: $)
! !

!SparseLargeTable methodsFor: 'accessing' stamp: 'yo 12/1/2003 15:58'!
chunkSize

	^chunkSize
! !

!SparseLargeTable methodsFor: 'private' stamp: 'yo 12/1/2003 18:58'!
allDefaultValueSubtableAt: index

	| t |
	t := self basicAt: index.
	t ifNil: [^ true].
	t do: [:e |
		e ~= defaultValue ifTrue: [^ false].
	].
	^ true.
! !

!SparseLargeTable methodsFor: 'accessing' stamp: 'yo 12/1/2003 15:58'!
size

	^size
! !

!SparseLargeTable methodsFor: 'printing' stamp: 'yo 12/1/2003 15:59'!
storeOn: aStream

	| x |
	(#(String) includes: self arrayClass name) ifTrue: 
		[aStream nextPut: $'.
		1 to: self size do:
			[:i |
			aStream nextPut: (x := self at: i).
			x == $' ifTrue: [aStream nextPut: x]].
		aStream nextPutAll: ''' asLargeArrayChunkSize: '.
		aStream nextPutAll: self chunkSize asString.
		^self].
	^super storeOn: aStream
! !

!SparseLargeTable methodsFor: 'accessing' stamp: 'StephaneDucasse 5/6/2010 08:50'!
noCheckAt: index put: value

	| chunkIndex t |
	chunkIndex := index - base // chunkSize + 1.
	chunkIndex > self basicSize ifTrue: [^ value].
	t :=  self basicAt: chunkIndex.
	t ifNil: [^ value].
	^ t at: (index - base + 1 - (chunkIndex - 1 * chunkSize)) put: value
! !

!SparseLargeTable methodsFor: 'accessing' stamp: 'yo 12/1/2003 15:58'!
arrayClass

	^(self basicAt: 1) class
! !

!SparseLargeTable methodsFor: 'private' stamp: 'yo 12/1/2003 15:59'!
similarInstance: newSize

	^self class
		new: newSize 
		chunkSize: self chunkSize 
		arrayClass: self arrayClass
! !

!SparseLargeTable methodsFor: 'private' stamp: 'nk 8/31/2004 08:34'!
copyEmpty
	"Answer a copy of the receiver that contains no elements."
	^self speciesNew: 0
! !

!SparseLargeTable methodsFor: 'private' stamp: 'yo 12/1/2003 22:34'!
findLastNonNilSubTable

	(self basicAt: self basicSize) ifNotNil: [^ self basicSize].

	self basicSize - 1 to: 1 by: -1 do: [:lastIndex |
		(self basicAt: lastIndex) ifNotNil: [^ lastIndex].
	].
	^ 0.
! !

!SparseLargeTable methodsFor: 'accessing' stamp: 'kwl 6/30/2006 03:02'!
zapDefaultOnlyEntries

	| lastIndex newInst |
	1 to: self basicSize do: [:i |
		(self allDefaultValueSubtableAt: i) ifTrue: [self basicAt: i put: nil].
	].

	lastIndex := self findLastNonNilSubTable.
	lastIndex = 0 ifTrue: [^ self].
	
	newInst := self class new: lastIndex*chunkSize chunkSize: chunkSize arrayClass: (self basicAt: lastIndex) class base: base defaultValue: defaultValue.
	newInst privateSize: self size.
	base to: newInst size do: [:i | newInst at: i put: (self at: i)].
	1 to: newInst basicSize do: [:i |
		(newInst allDefaultValueSubtableAt: i) ifTrue: [newInst basicAt: i put: nil].
	].

	" this is not allowed in production: self becomeForward: newInst. "
	^ newInst.
! !

!SparseLargeTable methodsFor: 'accessing' stamp: 'yo 12/1/2003 15:58'!
at: index put: value
	
	self pvtCheckIndex: index.
	^self noCheckAt: index put: value
! !

!SparseLargeTable methodsFor: 'accessing' stamp: 'yo 12/1/2003 17:56'!
base

	^ base.
! !

!SparseLargeTable methodsFor: 'copying' stamp: 'nice 10/5/2009 08:46'!
postCopy
	super postCopy.
	1 to: self basicSize do: [:i | self basicAt: i put: (self basicAt: i) copy]! !

!SparseLargeTable methodsFor: 'private' stamp: 'yo 12/1/2003 15:59'!
similarInstance

	^self class
		new: self size 
		chunkSize: self chunkSize 
		arrayClass: self arrayClass
! !

!SparseLargeTable methodsFor: 'private' stamp: 'yo 12/1/2003 15:59'!
similarSpeciesInstance

	^self similarInstance
! !

!SparseLargeTable methodsFor: 'private' stamp: 'yo 12/1/2003 16:00'!
speciesNew: newSize

	^self species
		new: newSize 
		chunkSize: self chunkSize 
		arrayClass: self arrayClass
! !

!SparseLargeTable class methodsFor: 'instance creation' stamp: 'yo 12/1/2003 16:06'!
new: size

	^self new: size chunkSize: self defaultChunkSize
! !

!SparseLargeTable class methodsFor: 'instance creation' stamp: 'yo 12/1/2003 16:07'!
new: size chunkSize: chunkSize

	^self new: size chunkSize: chunkSize arrayClass: Array
! !

!SparseLargeTable class methodsFor: 'accessing' stamp: 'yo 12/1/2003 15:54'!
defaultChunkSize

	^100! !

!SparseLargeTable class methodsFor: 'instance creation' stamp: 'yo 12/1/2003 16:37'!
new: size chunkSize: chunkSize arrayClass: aClass base: b

	^self new: size chunkSize: chunkSize arrayClass: Array base: 1 defaultValue: nil.
! !

!SparseLargeTable class methodsFor: 'instance creation' stamp: 'yo 12/1/2003 16:37'!
new: size chunkSize: chunkSize arrayClass: aClass base: b defaultValue: d

	| basicSize |
	(basicSize := ((size - 1) // chunkSize) + 1) = 0
		ifTrue: [basicSize := 1].
	^(self basicNew: basicSize)
		initChunkSize: chunkSize size: size arrayClass: aClass base: b defaultValue: d;
		yourself
! !

!SparseLargeTable class methodsFor: 'accessing' stamp: 'yo 12/1/2003 15:54'!
defaultChunkSizeForFiles

	^8000! !

!SparseLargeTable class methodsFor: 'instance creation' stamp: 'yo 12/1/2003 16:08'!
new: size chunkSize: chunkSize arrayClass: aClass

	^self new: size chunkSize: chunkSize arrayClass: Array base: 1.
! !

!SpecAdapterBindings commentStamp: '<historical>'!
I am an abstract class

I am used to link a spec-oriented adapter name to a framework specific adapter class name!
!SpecAdapterBindings methodsFor: 'initialize' stamp: 'StephaneDucasse 3/7/2014 11:12'!
initializeBindings
	"This implementation is stupid, but it exposes all the container which need to be bound"
	
	bindings
		at: #ButtonAdapter				put: #ButtonAdapter;
		at: #CheckBoxAdapter			put: #CheckBoxAdapter;
		at: #ContainerAdapter			put: #ContainerAdapter;
		at: #DiffAdapter				put: #MorphicDiffAdapter;
		at: #ImageAdapter				put: #ImageAdapter;
		at: #LabelAdapter				put: #LabelAdapter;
		at: #ListAdapter				put: #ListAdapter;
		at: #IconListAdapter			put: #IconListAdapter;
		at: #DropListAdapter			put: #DropListAdapter;
		at: #MultiColumnListAdapter	put: #MultiColumnListAdapter;
		at: #MenuAdapter				put: #MenuAdapter;
		at: #MenuGroupAdapter		put: #MenuGroupAdapter;
		at: #MenuItemAdapter			put: #MenuItemAdapter;	
		at: #NewListAdapter			put: #NewListAdapter;
		at: #RadioButtonAdapter		put: #RadioButtonAdapter;
		at: #SliderAdapter				put: #SliderAdapter;
		at: #TabManagerAdapter		put: #TabManagerAdapter;
		at: #TabAdapter				put: #TabAdapter;
		at: #TextAdapter				put: #TextAdapter;
		at: #TextInputFieldAdapter		put: #TextInputFieldAdapter;
		at: #TreeAdapter				put: #TreeAdapter;
		at: #TreeColumnAdapter		put: #TreeColumnAdapter;
		at: #TreeNodeAdapter			put: #TreeNodeAdapter;		
		at: #WindowAdapter			put: #WindowAdapter;
		at: #TickingWindowAdapter	put: #TickingWindowAdapter;
		at: #DialogWindowAdapter		put: #DialogWindowAdapter;
		yourself! !

!SpecAdapterBindings methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/1/2013 16:00'!
translateSymbol: aSymbol

	^ bindings 
		at: aSymbol
		ifAbsent: [ aSymbol ]! !

!SpecAdapterBindings methodsFor: 'initialize' stamp: 'BenjaminVanRyseghem 10/1/2013 12:14'!
initialize

	super initialize.

	bindings := Dictionary new.
	self initializeBindings! !

!SpecColumnLayout commentStamp: '<historical>'!
A SpecColumnLayout is the layout used to specify a new column!
!SpecColumnLayout methodsFor: 'converting' stamp: 'BenjaminVanRyseghem 12/21/2013 21:48'!
privateAsArray

	self resetArrayComputation.
	self countNumberOfProportionals.

	autoFractionComputation
		ifTrue: [ self autoFractionComputation ]
		ifFalse: [ self manualFractionComputation ].

	self shiftLastWidgets.

	result addAll: super privateAsArray.
	^ result asArray! !

!SpecColumnLayout methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/21/2013 21:34'!
manualFractionComputation
	
	self commands	doWithIndex: [ :e :idx | 
		e layoutFrame hasNoOffsets
			ifTrue: [  | delta |
				delta := e layoutFrame bottomFraction - e layoutFrame topFraction.
				self setWidgetLayoutWithNoOffset: e at: idx delta: delta ]
			ifFalse: [ self setWidgetLayoutWithOffset: e at: idx ] ]! !

!SpecColumnLayout methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/21/2013 21:34'!
autoFractionComputation
	| delta |
	
	numberOfProportionals isZero
		ifTrue: [ delta := 0 ]
		ifFalse: [ delta := 1 / numberOfProportionals ].
	
	self commands doWithIndex: [ :e :idx | 
		e layoutFrame hasNoOffsets
			ifTrue: [ self setWidgetLayoutWithNoOffset: e at: idx delta: delta ]
			ifFalse: [ self setWidgetLayoutWithOffset: e at: idx ] ]! !

!SpecColumnLayout methodsFor: 'commands' stamp: 'BenjaminVanRyseghem 6/18/2012 05:43'!
add: aSpec height: aNumber
	
	self add: aSpec origin: 0@0 corner: 1@1 offsetOrigin: 0@0 offsetCorner: 0@aNumber ! !

!SpecColumnLayout methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/21/2013 21:34'!
setWidgetLayoutWithNoOffset: widget at: index delta: delta

	widget layoutFrame:
		((0 @ currentProportional corner: 1 @ (currentProportional + delta)) asLayoutFrame 
			topOffset: currentOffset;
			yourself).
				
	currentOffset := 0.
	currentProportional := currentProportional + delta.
	
	lastFractionIndex := index! !

!SpecColumnLayout methodsFor: 'commands' stamp: 'BenjaminVanRyseghem 7/31/2012 15:10'!
addSplitter

	self commands add: (SpecSplitterHorizontal commands: self commands)! !

!SpecColumnLayout methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/21/2013 21:33'!
setWidgetLayoutWithOffset: widget at: index

	height := widget bottomOffset - widget topOffset.
	
	index = size
		ifTrue: [ 
			widget layoutFrame:
				((0 @ 1 corner: 1 @ 1) asLayoutFrame
					topLeftOffset: widget leftOffset @ height negated;
					bottomRightOffset: widget rightOffset @ 0) ]
		ifFalse: [ 
			widget layoutFrame:
				((0 @ currentProportional corner: 1 @ currentProportional) asLayoutFrame
					topLeftOffset: widget leftOffset @ currentOffset;
					bottomRightOffset: widget rightOffset @ (currentOffset + height)).
			currentOffset := currentOffset + height ]! !

!SpecColumnLayout methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/21/2013 21:39'!
countNumberOfProportionals

	self commands	do: [ :e | 
		e layoutFrame hasNoOffsets
			ifTrue: [ 
				(e layoutFrame topFraction == 0 and: [ e layoutFrame bottomFraction == 1 ])
					ifFalse: [ autoFractionComputation := false ].
				numberOfProportionals := numberOfProportionals + 1 ] ]! !

!SpecColumnLayout methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/21/2013 21:52'!
resetArrayComputation

	super resetArrayComputation.
	
	size := self commands size.
	numberOfProportionals := 0.
	lastFractionIndex := 0.
	autoFractionComputation := true.
	currentOffset := 0.
	currentProportional := 0! !

!SpecColumnLayout methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/21/2013 21:49'!
shiftLastWidgets
	| index ante |	
	
	(lastFractionIndex > 0 and: [ lastFractionIndex < size ]) ifFalse: [ ^ self ].
	
	index := size - 1.
	[ index > lastFractionIndex ] whileTrue: [ | myHeight |
			ante := self commands at: index.
			index := index - 1.
			myHeight := ante bottomOffset - ante topOffset.
			ante
				topOffset: (height + myHeight) negated;
				bottomOffset: height negated.
			height := height + myHeight ].
		
	self assert: index = lastFractionIndex.
	
	ante := self commands at: index.
	ante bottomOffset: height negated! !

!SpecDebugActionButton commentStamp: '<historical>'!
I am a button encapsulating a debug action. All my settings are set based on the corresponding debug action.!
!SpecDebugActionButton methodsFor: 'updating' stamp: 'AndreiChis 9/25/2013 17:09'!
update

	self debugAction ifNotNil:  [ :aDebugAction | 
		self label: aDebugAction label.
		self icon: aDebugAction icon.
		self enabled: aDebugAction enabled.
		self state: false.
		self action: [ aDebugAction execute ] ]! !

!SpecDebugActionButton methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
debugAction

	^ debugActionHolder value ! !

!SpecDebugActionButton methodsFor: 'initialization' stamp: 'DucasseStephane 9/10/2014 09:59'!
initialize

	super initialize.

	debugActionHolder := nil asValueHolder.
	debugActionHolder whenChangedDo: [ self update ]
	
	
	! !

!SpecDebugActionButton methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
debugAction: aDebugAction

	debugActionHolder value: aDebugAction! !

!SpecDebugger commentStamp: '<historical>'!
A SpecDebugger is a UI build in Spec that provides Smalltalk debugging functionality by using a DebugSession.

All the debugging logic is in DebugSession and the corresponding debugging actions. SpecDebugger only provides a graphical interface to access that functionality. The debugging actions are managed by the toolbar widget; the stack and all its related actions are managed by the stack widget.
!
!SpecDebugger methodsFor: 'initialization' stamp: 'AndreiChis 7/13/2013 17:49'!
process: aProcess controller: aController context: aContext
	self flag: 'Do not ignore the controller parameter'.
	self session: (self class spanNewSessionForContext: aContext fromProcess: aProcess)! !

!SpecDebugger methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
session: aSession

	sessionHolder value: aSession ! !

!SpecDebugger methodsFor: 'updating actions' stamp: 'AndreiChis 12/7/2012 17:27'!
updateRestart

	self updateStep 
	! !

!SpecDebugger methodsFor: 'accessing context' stamp: 'AndreiChis 7/17/2013 11:00'!
currentContext
	"I answer the context on which an action should be executed.
	This is either the selected context or if nothing is selected the interrupted context."
	
	^ self selectedContext isNil 
		ifTrue: [ self interruptedContext ]
		ifFalse: [ self selectedContext ]! !

!SpecDebugger methodsFor: 'as yet unclassified' stamp: 'MarkRizun 7/11/2014 16:16'!
selectedMethod
	^ self currentContext method! !

!SpecDebugger methodsFor: 'initialization' stamp: 'CamilloBruni 5/2/2013 00:15'!
setFocusOrder

	self focusOrder 
		removeAll;
		add: stack;
		add: toolbar;
		add: code;
		add: receiverInspector;
		add: contextInspector! !

!SpecDebugger methodsFor: 'actions code' stamp: 'AndreiChis 12/17/2013 14:29'!
codeContextMenu: menu shifted: shifted
	| donorMenu |
	
	"Now dynamically load any other actions."							
	menu addAllFromPragma: 'specDebuggerCodeContextMenu' target: self.
	
	"Directly load the standard actions here."
	donorMenu := shifted
		ifTrue: [SmalltalkEditor shiftedYellowButtonMenu]
		ifFalse: [SmalltalkEditor yellowButtonMenu].
	^ menu addAllFrom: donorMenu.! !

!SpecDebugger methodsFor: 'initialization' stamp: 'BernardoContreras 9/30/2014 23:18'!
initialize

	sessionHolder := nil asValueHolder.
	labelHolder := nil asValueHolder.
	super initialize.
	
	needRefresh := false.
	
	self announcer
		when: WidgetBuilt
		send: #onWidgetBuilt
		to: self.
		
	self whenWindowChanged: [ :w | 
		w whenClosedDo: [ self clear ] ].
	
	sessionHolder whenChangedDo: [:newSession :oldSession |
		self removeActionsForSession: oldSession.
		self registerActionsForSession: newSession.
		self updateToolbarFromSession: newSession.
		self updateStackFromSession: newSession ].
	
	labelHolder whenChangedDo: [ 
		self updateTitle ]! !

!SpecDebugger methodsFor: 'updating widgets' stamp: 'AndreiChis 7/18/2013 16:24'!
updateToolbar
	
	self toolbar update! !

!SpecDebugger methodsFor: 'accessing context' stamp: 'AndreiChis 7/17/2013 11:04'!
selectedContext	

	^ self stack selectedItem! !

!SpecDebugger methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
label: aString

	labelHolder value: aString! !

!SpecDebugger methodsFor: 'initialization' stamp: 'AndreiChis 6/4/2013 16:14'!
registerActionsForSession: aSession

	aSession ifNotNil: [
		aSession
			when: #restart send: #updateRestart to: self;
			when: #resume send: #updateResume to: self;
			when: #stepInto send: #updateStepInto to: self;
			when: #stepOver send: #updateStepOver to: self;
			when: #stepThrough send: #updateStepThrough to: self;
			when: #contextChanged send: #updateContextChanged to: self  ]! !

!SpecDebugger methodsFor: 'accessing context' stamp: 'AndreiChis 7/22/2013 14:13'!
interruptedContext

	^ self session interruptedContext! !

!SpecDebugger methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
session

	^ sessionHolder value! !

!SpecDebugger methodsFor: 'initialization' stamp: 'AndreiChis 12/17/2013 14:21'!
initializeWidgets
	self
		instantiateModels:
			{(#stack -> #SpecDebuggerStack).
			(#toolbar -> #SpecDebuggerDynamicToolbar).
			(#code -> #TextModel).
			(#receiverInspector -> #InspectorNavigator).
			(#contextInspector -> #EyeDebuggerContextInspector)}.
	
	self code acceptBlock: [ :text :notifyer |
		self 
			recompileMethodTo: text string 
			inContext: self stack selectedItem
			notifying: notifyer ].

	self code whenBuiltDo: [ :ann | ann widget font: self codeFont ].
	
	self code menuHolder: [ :menu :shifted |
		self codeContextMenu: menu shifted: shifted].

	self setFocusOrder! !

!SpecDebugger methodsFor: 'updating actions' stamp: 'AndreiChis 12/7/2012 17:26'!
updateResume

	! !

!SpecDebugger methodsFor: '*SmartSuggestions' stamp: 'MarcusDenker 7/26/2013 15:15'!
sugsContext
	^SugsDebuggerContext model: self! !

!SpecDebugger methodsFor: 'actions code' stamp: 'AndreiChis 12/17/2013 14:19'!
codeContextMenuDebuggingActions

	^ self session class 
		debuggingActionsForPragmas: #(contextMenuCodeDebuggingAction) 
		for: self! !

!SpecDebugger methodsFor: 'updating actions' stamp: 'AndreiChis 6/4/2013 16:18'!
updateContextChanged
	|selection|
	
	selection := self stack selectedItem.
	self updateStep.
	self stack setSelectedItem: selection! !

!SpecDebugger methodsFor: 'initialization' stamp: 'AndreiChis 6/4/2013 16:14'!
removeActionsForSession: aSession

	aSession ifNotNil: [ 
		aSession  
			removeActionsForEvent: #restart;
			removeActionsForEvent: #resume;
			removeActionsForEvent: #stepInto;
			removeActionsForEvent: #stepOver;
			removeActionsForEvent: #stepThrough;
			removeActionsForEvent:#contextChanged ]. ! !

!SpecDebugger methodsFor: 'private' stamp: 'EstebanLorenzano 10/11/2013 15:58'!
codeFont 
	^ StandardFonts codeFont! !

!SpecDebugger methodsFor: 'api' stamp: 'AndreiChis 4/2/2013 10:31'!
openOn: aSession

	self 
		session: aSession; 
		openWithSpec! !

!SpecDebugger methodsFor: 'updating actions' stamp: 'AndreiChis 12/6/2012 17:04'!
updateStepOver

	self updateStep 
	! !

!SpecDebugger methodsFor: 'updating widgets' stamp: 'EstebanLorenzano 1/9/2014 19:06'!
updateCodeFromContext: aContext 

	aContext 
		ifNil: [
			self code 
				aboutToStyle: false;
				text: '';
				behavior: nil;
				setSelection: (1 to: 0) ]
		ifNotNil: [ |selectionInterval|
			selectionInterval := self session selectedCodeRangeForContext: aContext.
			self code
				aboutToStyle: true;
				text: aContext sourceCode;
				doItReceiver: aContext home receiver;
				doItContext: aContext;
				behavior: aContext home receiver class;
				setSelection: selectionInterval ]! !

!SpecDebugger methodsFor: 'accessing widgets' stamp: 'AndreiChis 12/9/2012 21:05'!
stack

	^ stack! !

!SpecDebugger methodsFor: 'accessing context' stamp: 'AndreiChis 9/30/2013 19:04'!
context
 
	^ self interruptedContext! !

!SpecDebugger methodsFor: 'actions' stamp: 'AndreiChis 9/19/2013 17:12'!
close
	
	self window delete! !

!SpecDebugger methodsFor: 'private' stamp: 'AndreiChis 7/13/2013 18:27'!
lowSpaceChoices
	"Return a notifier message string to be presented when space is running low."

	^ 'Warning!! Pharo is almost out of memory!!

Low space detection is now disabled. It will be restored when you close or proceed from this error notifier. Don''t panic, but do proceed with caution.

Here are some suggestions:

 If you suspect an infinite recursion (the same methods calling each other again and again), then close this debugger, and fix the problem.

 If you want this computation to finish, then make more space available (read on) and choose "proceed" in this debugger. Here are some ways to make more space available...
   > Close any windows that are not needed.
   > Get rid of some large objects (e.g., images).
   > Leave this window on the screen, choose "save as..." from the screen menu, quit, restart the Pharo VM with a larger memory allocation, then restart the image you just saved, and choose "proceed" in this window.

 If you want to investigate further, choose "debug" in this window.  Do not use the debugger "fullStack" command unless you are certain that the stack is not very deep. (Trying to show the full stack will definitely use up all remaining memory if the low-space problem is caused by an infinite recursion!!).

'
! !

!SpecDebugger methodsFor: 'updating widgets' stamp: 'NicolaiHess 12/18/2013 10:04'!
updateCodeFromContext
self updateCodeFromContext:self currentContext! !

!SpecDebugger methodsFor: 'actions' stamp: 'AndreiChis 6/3/2013 15:56'!
recompileMethodTo: aString inContext: aContext notifying: aNotifyer

	^ aContext 
		ifNil: [ false ]
		ifNotNil: [
			self session recompileMethodTo: aString inContext: aContext notifying: aNotifyer ]! !

!SpecDebugger methodsFor: 'old - public' stamp: 'AndreiChis 9/26/2013 19:14'!
send
	
	self okToChange ifTrue: [  
		self session stepInto: self currentContext ]
! !

!SpecDebugger methodsFor: 'as yet unclassified' stamp: 'MarkRizun 7/15/2014 10:49'!
selectedMessage
	^ self selectedMethod! !

!SpecDebugger methodsFor: 'updating' stamp: 'BenComan 3/7/2014 01:48'!
updateReceiverInspectorFromContext: aContext
	| receiver oldSelection newSelectionIndex   |

	oldSelection := receiverInspector inspector ifNotNil: [ :inspector | inspector list selectedItem ].

	receiver := aContext ifNotNil: [ aContext home receiver ]. 
	receiverInspector inspect: receiver.	
		
	newSelectionIndex := 1.
	oldSelection ifNotNil: 
	[	receiverInspector inspector list getItems withIndexDo: 
			[ :item :index | item label = oldSelection label ifTrue: [ newSelectionIndex := index ] ].
	].
	receiverInspector inspector list setSelectedIndex: newSelectionIndex.
	
! !

!SpecDebugger methodsFor: 'as yet unclassified' stamp: 'MarkRizun 7/11/2014 16:20'!
selectedMethods
	^ self stack selectedItem asOrderedCollection ! !

!SpecDebugger methodsFor: 'private' stamp: 'StephaneDucasse 8/4/2013 18:23'!
onWidgetBuilt

	needRefresh := true! !

!SpecDebugger methodsFor: 'opening' stamp: 'CamilloBruni 2/19/2014 16:45'!
openFullNoSuspendLabel: aString 
	"Create and schedule a full debugger with the given label. Do not
	terminate the current active process."
	self 
		openWithSpec;
		updateToolbar;
		updateCodeFromContext;
		label: aString.
	
	self flag: 'Would ne better to move this into the session'.
	self session errorWasInUIProcess: (UIManager default spawnNewProcessIfThisIsUI: self interruptedProcess)
	"errorWasInUIProcess := UIManager default spawnNewProcessIfThisIsUI: interruptedProcess"! !

!SpecDebugger methodsFor: 'api' stamp: 'AndreiChis 7/16/2013 17:41'!
title

	^ ((self session isContextPostMortem: self interruptedContext)  
			ifTrue: [ 'PostMortem: ' ]
			ifFalse: [ '' ]), (self label ifNil: [ '' ])! !

!SpecDebugger methodsFor: 'accessing widgets' stamp: 'ClementBera 4/30/2013 14:10'!
contextInspector

	^ contextInspector! !

!SpecDebugger methodsFor: 'initialization' stamp: 'StephaneDucasse 4/3/2014 21:30'!
initializePresenter
	super initializePresenter.
	self flag: 'some of this logic could be moved to the stack widget'.
	self flag: 'The toolbar should not be updated when the list changes, but when an action is perormed.'.
	self stack whenListChanged: [ :aList |
		aList isEmpty ifFalse: [ self stack setSelectedItem: aList first ].
		"Updating the toolbar will result in changing the button widgets.
		If the widget hasn't been opened, there will be no spec, which leads to an error."
		self spec ifNotNil: [
			self updateToolbar ] ].

	self stack whenSelectedItemChanged: [:aContext |
		self updateCodeFromContext: aContext.
		self updateInspectorsFromContext: aContext.
		self stack updateForSelectionChanged ].! !

!SpecDebugger methodsFor: 'as yet unclassified' stamp: 'MarkRizun 7/11/2014 16:09'!
refactor
	^ NautilusRefactoring model: self! !

!SpecDebugger methodsFor: 'api' stamp: 'ClementBera 4/29/2013 10:13'!
initialExtent 
	"This code was taken from the old debugger to get the same behavior. Fell free to refactor"

	RealEstateAgent standardWindowExtent y < 400 "a tiny screen" 
		ifTrue: [^ 700@500].
	
	^ [ | w h |
		w := Display width.
		h := Display height.
		(w - (w // 3)) @ (h - (h // 5)) ]
		on: Error
		do: [ 850@600 ]! !

!SpecDebugger methodsFor: 'accessing widgets' stamp: 'AndreiChis 12/7/2012 17:31'!
code

	^ code! !

!SpecDebugger methodsFor: 'opening' stamp: 'AndreiChis 7/14/2013 19:59'!
openNotifierContents: msgString label: label
	"Create and schedule a notifier view with the given label and message.
	A notifier view shows just the message or the first several lines of the
	stack, with a menu that allows the user to open a full debugger if so
	desired. "

	"NOTE: When this method returns, a new process has been scheduled to
	run the windows, and thus this notifier, but the previous active porcess
	has not been suspended. The sender will do this."
	| msg |

	msg := (label beginsWith: 'Space is low')
		ifTrue: [ self lowSpaceChoices , (msgString ifNil: [ '' ]) ]
		ifFalse: [ msgString ].
		
	SpecPreDebugWindow new 
		setTitle: label;
		message: msg;
		openWithSpec;
		debugger: self.

	self session errorWasInUIProcess: (UIManager default spawnNewProcessIfThisIsUI: self interruptedProcess)! !

!SpecDebugger methodsFor: 'actions' stamp: 'AndreiChis 9/27/2013 18:45'!
clear
	
	self removeActionsForSession: self session.
	"No more code should follow after this, as the session might terminate this process."
	self session ifNotNil: [ :aSession | aSession terminate]! !

!SpecDebugger methodsFor: 'accessing widgets' stamp: 'AndreiChis 12/9/2012 21:05'!
toolbar

	^ toolbar! !

!SpecDebugger methodsFor: 'as yet unclassified' stamp: 'MarkRizun 7/11/2014 16:09'!
browsedEnvironment
	^ browsedEnvironment ifNil: [ browsedEnvironment := RBBrowserEnvironment new ]! !

!SpecDebugger methodsFor: 'updating actions' stamp: 'AndreiChis 12/6/2012 17:05'!
updateStepInto

	self updateStep ! !

!SpecDebugger methodsFor: 'as yet unclassified' stamp: 'MarkRizun 7/11/2014 16:08'!
selectedClass
	^ self currentContext class! !

!SpecDebugger methodsFor: 'updating actions' stamp: 'AndreiChis 1/28/2013 11:03'!
updateStep

	self updateStackFromSession: self session.
	
! !

!SpecDebugger methodsFor: 'updating' stamp: 'BenComan 3/7/2014 01:29'!
updateContextInspectorFromContext: aContext
	| oldSelection newSelectionIndex   |
	
	oldSelection := contextInspector list selectedItem.
	
	contextInspector inspect: aContext.
	
	newSelectionIndex := 1.
	oldSelection ifNotNil: 
	[	contextInspector list getItems withIndexDo: 
			[ :item :index | item label = oldSelection label ifTrue: [ newSelectionIndex := index ] ].
	].
	contextInspector list setSelectedIndex: newSelectionIndex.
! !

!SpecDebugger methodsFor: 'old - public' stamp: 'AndreiChis 9/26/2013 19:13'!
proceed: aTopView 
	
	self okToChange ifTrue: [  
		self session 
			resume;
			clear.
		self debugger close ]
! !

!SpecDebugger methodsFor: 'accessing' stamp: 'AndreiChis 7/22/2013 14:14'!
interruptedProcess

	^ self session interruptedProcess! !

!SpecDebugger methodsFor: 'updating widgets' stamp: 'AndreiChis 9/26/2013 16:32'!
updateStackFromSession: aSession
	
	self stack session: aSession.! !

!SpecDebugger methodsFor: 'updating widgets' stamp: 'AndreiChis 1/28/2013 11:04'!
updateToolbarFromSession: aSession

	self toolbar session: aSession.! !

!SpecDebugger methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
label

	^ labelHolder value! !

!SpecDebugger methodsFor: 'accessing widgets' stamp: 'ClementBera 4/29/2013 09:51'!
receiverInspector

	^ receiverInspector! !

!SpecDebugger methodsFor: 'updating actions' stamp: 'AndreiChis 12/7/2012 17:26'!
updateStepThrough

	self updateStep ! !

!SpecDebugger methodsFor: 'accessing context' stamp: 'CamilleTeruel 3/7/2014 12:04'!
selectTopContext
	stack setSelectedItem: stack list listItems first! !

!SpecDebugger methodsFor: 'old - public' stamp: 'AndreiChis 7/14/2013 20:24'!
errorWasInUIProcess: aBoolean
	"The debugger must have a session instaled for this method
	to work. Only added it to match the API of the old debugger."
	self session errorWasInUIProcess: aBoolean! !

!SpecDebugger methodsFor: 'updating' stamp: 'BenComan 3/7/2014 01:35'!
updateInspectorsFromContext: aContext
	self updateContextInspectorFromContext: aContext.
	self updateReceiverInspectorFromContext: aContext.! !

!SpecDebugger class methodsFor: 'settings' stamp: 'AndreiChis 7/20/2013 12:24'!
filterCommonMessageSends
	^ FilterCommonMessageSends ifNil: [FilterCommonMessageSends := false]! !

!SpecDebugger class methodsFor: 'instance creation' stamp: 'MarcusDenker 9/29/2013 09:04'!
debugError: anError
	"Handle an otherwise unhandled error"

	self
		openOn: Processor activeProcess
		context: anError signalerContext
		label: anError description
		contents: nil
		fullView: false! !

!SpecDebugger class methodsFor: 'instance creation' stamp: 'ClementBera 5/27/2014 13:49'!
informExistingDebugger: aContext label: aString
	"Walking the context chain, we try to find out if we're in a debugger stepping situation.
	If we find the relevant contexts, we must rearrange them so they look just like they would
	if the methods were excuted outside of the debugger."
	| ctx quickStepMethod oldSender baseContext |
	ctx := thisContext.
	quickStepMethod := Context compiledMethodAt: #quickSend:to:with:super:.
	[ctx sender == nil or: [ctx sender method == quickStepMethod]] whileFalse: [ctx := ctx sender].
	ctx sender == nil ifTrue: [^self].
	baseContext := ctx.
	"baseContext is now the context created by the #quickSend... method."
	oldSender := ctx := ctx sender home sender.
	"oldSender is the context which originally sent the #quickSend... method"
	[ctx isNil or: [ctx receiver isKindOf: self]] whileFalse: [ctx := ctx sender].
	ctx ifNil: [^self].
	"ctx is the context of the Debugger method #doStep" self flag: 'this is not true any more'.
	ctx receiver label: aString.
	baseContext swapSender: baseContext sender sender sender.	"remove intervening contexts"
	thisContext swapSender: oldSender.	"make myself return to debugger"
	ErrorRecursion := false.
	^aContext! !

!SpecDebugger class methodsFor: 'tools registry' stamp: 'AndreiChis 7/24/2013 11:32'!
register

	self registerToolsOn: Smalltalk tools! !

!SpecDebugger class methodsFor: 'menu code' stamp: 'AndreiChis 12/17/2013 14:19'!
dynamicCodeContextMenu: aBuilder
	<contextMenu>
	<specDebuggerCodeContextMenu>

	aBuilder model codeContextMenuDebuggingActions do: [ :anAction | 
		anAction asMenuRegistrationIn: aBuilder ]! !

!SpecDebugger class methodsFor: 'opening' stamp: 'AndreiChis 7/23/2013 16:21'!
openInterrupt: aString onProcess: interruptedProcess 
	"Open a notifier in response to an interrupt. An interrupt occurs when
	the user types the interrupt key (cmd-. on Macs, ctrl-c or alt-. on other
	systems) or when the low-space watcher detects that memory is low."
	| debugger |
	<primitive: 19>
	"Simulation guard"
	debugger := self new.
	debugger
		process: interruptedProcess
		controller: nil
		context: interruptedProcess suspendedContext.
	self logDebuggerStackToFile
		ifTrue: [(aString includesSubstring: 'Space')
					& (aString includesSubstring: 'low')
				ifTrue: [Smalltalk
						logError: aString
						inContext: debugger interruptedContext ]].
	^ debugger openNotifierContents: nil label: aString! !

!SpecDebugger class methodsFor: 'class initialization' stamp: 'AndreiChis 9/29/2013 13:29'!
initialize 
	
	ErrorRecursion := false.

	"Ungly check to make sure the debugger will work until everything is in the image"
	(Smalltalk tools respondsTo: #registerDebugger:withRank:) ifFalse: [ ^ self ].

	"Add ourselves to registry. See [Smalltalk tools]" 
	Smalltalk tools registerDebugger: self withRank: 2.! !

!SpecDebugger class methodsFor: 'opening' stamp: 'AndreiChis 7/22/2013 13:22'!
openContext: aContext label: aString contents: contentsStringOrNil
	"Open a notifier in response to an error, halt, or notify. A notifier view just shows a short view of the sender stack and provides a menu that lets the user open a full debugger."
	
	<primitive: 19> "Simulation guard"
	ErrorRecursion not & self logDebuggerStackToFile ifTrue:
		[Smalltalk logError: aString inContext: aContext].
	  ErrorRecursion ifTrue:[
               ErrorRecursion := false.
               self primitiveError: aString].
	ErrorRecursion := true.
	
	self informExistingDebugger: aContext label: aString.
	(self context: aContext)
		openNotifierContents: contentsStringOrNil
		label: aString.
	ErrorRecursion := false. 
	Processor activeProcess suspend.
! !

!SpecDebugger class methodsFor: 'instance creation' stamp: 'AndreiChis 1/28/2013 16:35'!
debugSession: aSession

	<primitive: 19> "simulation guard"

	"WorldState addDeferredUIMessage: ["
		^ self openOn: aSession 
	"	]"
! !

!SpecDebugger class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 2/7/2014 17:34'!
specOptimized
	<spec: #default>
	| toolbarHeight |
	
	toolbarHeight := self toolbarHeight.
	
	^ SpecLayout composed
		add: #stack origin: 0@0 corner: 1@0.25;
		add: #toolbar origin: 0@0.25 corner: 1@0.25 offsetOrigin: 0@0 offsetCorner: 0@toolbarHeight;
		addHSplitter;
		add: #code origin: 0@0.25 corner: 1@0.80 offsetOrigin: 0@toolbarHeight offsetCorner: 0@0;
		addHSplitter;
		newRow: [ :r |
			r 
				add: #receiverInspector;
				addSplitter;
				add: #contextInspector]
		top: 0.8;
		yourself ! !

!SpecDebugger class methodsFor: 'tools registry' stamp: 'AndreiChis 7/24/2013 11:31'!
registerToolsOn: registry

	"Add ourselves to registry. See [Smalltalk tools]" 
	registry register: self as: #debugger
! !

!SpecDebugger class methodsFor: 'accessing' stamp: 'AndreiChis 9/29/2013 14:08'!
stackWidgetClass

	^ SpecDebuggerStack ! !

!SpecDebugger class methodsFor: 'instance creation' stamp: 'AndreiChis 1/28/2013 16:22'!
debugContext: aContext fromProcess: aProcess

	^ self debugSession: (self spanNewSessionForContext: aContext fromProcess: aProcess)
! !

!SpecDebugger class methodsFor: 'settings' stamp: 'AndreiChis 7/13/2013 18:12'!
alwaysOpenFullDebugger
	^ AlwaysOpenFullDebugger ifNil: [AlwaysOpenFullDebugger := false]! !

!SpecDebugger class methodsFor: 'opening' stamp: 'PavelKrivanek 7/13/2014 13:46'!
openOn: process context: context label: title contents: contentsStringOrNil fullView: bool 
	"Open a notifier in response to an error, halt, or notify. A notifier view
	just shows a short view of the sender stack and provides a menu that
	lets the user open a full debugger."
	| fullView |
	fullView := (bool or: [self alwaysOpenFullDebugger]).
	
	UserManager default canDebug ifFalse: [ 
		UIManager default spawnNewProcessIfThisIsUI: process.
		process suspend.
		^ self ].
	
	^ UIManager default 
		openDebuggerOn: process 
		context: context 
		label: title 
		contents: contentsStringOrNil 
		fullView: fullView! !

!SpecDebugger class methodsFor: 'instance creation' stamp: 'AndreiChis 7/22/2013 11:27'!
context: aContext
	"Answer an instance of me for debugging the active process starting with the given context."

	^ self new
		process: Processor activeProcess
		controller: nil
		context: aContext
		! !

!SpecDebugger class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'AndreiChis 9/14/2013 11:01'!
taskbarIcon

	^ Smalltalk ui icons smallDebugIcon! !

!SpecDebugger class methodsFor: 'accessing' stamp: 'AndreiChis 4/1/2013 12:28'!
defaultTitle

	^ 'Spec Debugger'! !

!SpecDebugger class methodsFor: 'settings' stamp: 'AndreiChis 7/13/2013 18:12'!
alwaysOpenFullDebugger: aBoolean
	AlwaysOpenFullDebugger := aBoolean.! !

!SpecDebugger class methodsFor: 'instance creation' stamp: 'AndreiChis 1/28/2013 16:27'!
openOn: aSession

	^ self new openOn: aSession ! !

!SpecDebugger class methodsFor: 'settings' stamp: 'AndreiChis 7/20/2013 12:25'!
filterCommonMessageSends: aBoolean
	FilterCommonMessageSends := aBoolean! !

!SpecDebugger class methodsFor: 'settings' stamp: 'AndreiChis 7/20/2013 12:18'!
logDebuggerStackToFile: aBoolean
	 LogDebuggerStackToFile := aBoolean! !

!SpecDebugger class methodsFor: 'utilities' stamp: 'MarcusDenker 1/20/2014 16:59'!
closeAllDebuggers
	"SpecDebugger closeAllDebuggers"
	(MorphicWindowAdapter allInstances select: [:w | 
		(w model isKindOf: WindowModel) and: [ 
			w model model isKindOf: self ]  ])
			do: [:w | w delete ].
			
	SpecPreDebugWindow allInstances do: #delete.
			
		
			
	! !

!SpecDebugger class methodsFor: 'accessing' stamp: 'AndreiChis 1/7/2013 10:38'!
sessionClass

	^ DebugSession ! !

!SpecDebugger class methodsFor: 'private' stamp: 'AndreiChis 1/28/2013 11:29'!
spanNewSessionForContext: aContext fromProcess: aProcess

	^ self sessionClass process: aProcess context: aContext ! !

!SpecDebugger class methodsFor: 'specs' stamp: 'ClementBera 4/29/2013 09:55'!
spec
	<spec>
	
	^ SpecLayout composed
		newColumn: [ :column | 
			column
				add: #stack;
				add: #toolbar height: 25;
				addSplitter;
				add: #code;
				addSplitter;
				newRow: [ :row | 
					row
						add: #receiverInspector;
						add: #contextInspector ] ]! !

!SpecDebugger class methodsFor: 'settings' stamp: 'AndreiChis 7/20/2013 12:18'!
logDebuggerStackToFile
	^ LogDebuggerStackToFile ifNil: [LogDebuggerStackToFile := true]! !

!SpecDebuggerDynamicToolbar commentStamp: '<historical>'!
A toolbar that loads its actions dynamically based on pragmas. Only actions annotated with 'self debuggingActionsPragmas' that answer true to the message #appliesToDebugger: are taken into account. 

The toolbar updates itsetf every time a new value is put in the session (even if it is the same value).  If the session is set before opening the toolbar (before a spec is created) the message #update should be sent to the toolbar.

Each debugging actions is displayed by using a SpecDebugActionButton.

!
!SpecDebuggerDynamicToolbar methodsFor: 'updating' stamp: 'AndreiChis 9/18/2013 12:09'!
update

	self session 
		ifNil: [ self clearToolbar ] 
		ifNotNil: [ self rebuildToolbar ]
	! !

!SpecDebuggerDynamicToolbar methodsFor: 'actions lookup' stamp: 'AndreiChis 9/18/2013 18:20'!
debuggingActions

	^ self actionsForPragmas: self debuggingActionsPragmas! !

!SpecDebuggerDynamicToolbar methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
session: aSession
	
	sessionHolder value: aSession! !

!SpecDebuggerDynamicToolbar methodsFor: 'initialization' stamp: 'AndreiChis 9/25/2013 17:11'!
setFocusOrderForActions: aCollection

	self focusOrder removeAll.
	aCollection do: [ :action | 
		self focusOrder add: (self perform: action specId) ]! !

!SpecDebuggerDynamicToolbar methodsFor: 'building widgets' stamp: 'AndreiChis 9/25/2013 17:10'!
buildButtonWidgetsSpecForActions: aCollection
	
	^ aCollection
		inject: OrderedCollection new
		into: [ :specs :action |
			specs 
				add: action specId;
			 	add: action specModel;
				yourself ]

	! !

!SpecDebuggerDynamicToolbar methodsFor: 'accessing' stamp: 'AndreiChis 9/18/2013 12:09'!
currentContext
	
	^ self debugger currentContext! !

!SpecDebuggerDynamicToolbar methodsFor: 'actions lookup' stamp: 'AndreiChis 9/21/2013 18:02'!
actionsForPragmas: aSymbolsCollection

	^ (self session class debuggingActionsForPragmas: aSymbolsCollection for: self debugger)
				! !

!SpecDebuggerDynamicToolbar methodsFor: 'initialization widgets' stamp: 'AndreiChis 9/25/2013 17:10'!
initializeButtonWidget: aButtonModel forAction: aDebuggingAction

	aButtonModel 
		debugAction: aDebuggingAction! !

!SpecDebuggerDynamicToolbar methodsFor: 'building widgets' stamp: 'AndreiChis 9/25/2013 17:11'!
createWidgetsForActions: aCollection
	
	self instantiateModels: (self buildButtonWidgetsSpecForActions: aCollection).
	aCollection do: [ :action | 
		self initializeButtonWidget: (self widgets at: action specId) forAction: action ].
	self setFocusOrderForActions: aCollection! !

!SpecDebuggerDynamicToolbar methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
session
	
	^ sessionHolder value ! !

!SpecDebuggerDynamicToolbar methodsFor: 'initialization' stamp: 'DucasseStephane 9/10/2014 09:59'!
initialize

	sessionHolder := nil asValueHolder.
	super initialize! !

!SpecDebuggerDynamicToolbar methodsFor: 'building widgets' stamp: 'AndreiChis 9/18/2013 12:09'!
emptyLayout
	
	^ SpecLayout composed
! !

!SpecDebuggerDynamicToolbar methodsFor: 'building widgets' stamp: 'AndreiChis 9/25/2013 17:11'!
dynamicLayoutForActions: aCollection

	^ SpecLayout composed
		newRow: [ :r |
			aCollection do: [ :action | 
				r add: action specId ] ]! !

!SpecDebuggerDynamicToolbar methodsFor: 'initialization' stamp: 'AndreiChis 9/30/2013 13:38'!
initializePresenter
	super initializePresenter.
	
	sessionHolder whenChangedDo: [
		self spec ifNotNil: [ 
			self update	 ] ]
! !

!SpecDebuggerDynamicToolbar methodsFor: 'private' stamp: 'AndreiChis 9/18/2013 12:09'!
debugger
	"Return the instance of the debugger containing this toolbar"
	
	^  owner! !

!SpecDebuggerDynamicToolbar methodsFor: 'building widgets' stamp: 'AndreiChis 9/18/2013 12:09'!
clearToolbar

	self widgets removeAll.
	
	self needFullRebuild: true.
	self needRebuild: false.
	
 	self buildWithSpecLayout: self emptyLayout	
! !

!SpecDebuggerDynamicToolbar methodsFor: 'building widgets' stamp: 'AndreiChis 9/20/2013 17:20'!
rebuildToolbar
	| debuggingActions |

	debuggingActions := self debuggingActions.
	self widgets removeAll.
	self createWidgetsForActions: debuggingActions.
	
	self needFullRebuild: true.
	self needRebuild: false.
	
 	self buildWithSpecLayout: (self dynamicLayoutForActions: debuggingActions)! !

!SpecDebuggerDynamicToolbar methodsFor: 'actions lookup' stamp: 'AndreiChis 9/18/2013 17:28'!
debuggingActionsPragmas

	^ { #debuggingAction }! !

!SpecDebuggerDynamicToolbar class methodsFor: 'specs' stamp: 'AndreiChis 9/18/2013 12:09'!
spec
	<spec: #default>
		^ SpecLayout composed! !

!SpecDebuggerStack commentStamp: '<historical>'!
A SpecDebuggerStack is responsible for displaying and managing the stack. All actions from the context menu of the stack are loaded by using the pragmas 'self contextMenuDebuggingActions'.!
!SpecDebuggerStack methodsFor: 'actions lookup' stamp: 'AndreiChis 12/20/2013 12:43'!
generateContextMenuDebuggingActions

	actionsCache ifNotNil: [  ^ actionsCache ].
	"Cache the actions as this method is called multiple times: 
	two times when the menu is created and one time when the registering shortcuts."
	^ actionsCache := self session class 
		debuggingActionsForPragmas: self contextMenuDebuggingActionsPragmas 
		for: self debugger! !

!SpecDebuggerStack methodsFor: 'actions browsing' stamp: 'AndreiChis 9/26/2013 19:03'!
browseClassRefs

	self currentContext ifNotNil: [ :aContext || class|
		class := aContext methodClass theNonMetaClass.
		class isTrait 
			ifTrue: [ self systemNavigation browseAllUsersOfTrait: class ]
			ifFalse: [ self systemNavigation browseAllCallsOnClass: class ] ]
! !

!SpecDebuggerStack methodsFor: 'actions browsing' stamp: 'AndreiChis 9/26/2013 19:04'!
browseClassVarRefs
	"1/17/96 sw: devolve responsibility to the class, so that the code that does the real work can be shared"

	| cls |
	cls := self currentClass.
	(cls notNil and: [cls isTrait not])
		ifTrue: [self systemNavigation  browseClassVarRefs: cls]! !

!SpecDebuggerStack methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
session: aSession

	sessionHolder value: aSession! !

!SpecDebuggerStack methodsFor: 'actions browsing' stamp: 'MarcusDenker 6/28/2014 11:29'!
browseVersions
	"Create and schedule a message set browser on all versions of the 
	currently selected message selector."

	Smalltalk tools versionBrowser
		browseVersionsForClass:  self currentClassOrMetaClass 
		selector: self currentMessageName! !

!SpecDebuggerStack methodsFor: 'actions browsing' stamp: 'AndreiChis 9/26/2013 19:04'!
browseInstVarRefs
	"1/26/96 sw: real work moved to class, so it can be shared"
	| cls |
	cls := self currentClassOrMetaClass.
	(cls notNil and: [cls isTrait not])
		ifTrue: [self systemNavigation browseInstVarRefs: cls]! !

!SpecDebuggerStack methodsFor: 'actions browsing' stamp: 'AndreiChis 9/26/2013 19:05'!
currentContext
	
	^ self debugger currentContext! !

!SpecDebuggerStack methodsFor: 'actions browsing' stamp: 'MarcusDenker 10/13/2013 07:58'!
browseSendersOfMessages
	"Present a menu of the current message, as well as all messages sent by it.  Open a message set browser of all senders of the selector chosen."

	self currentMessageName ifNotNil: [   
		self systemNavigation browseAllSendersOf: self currentMessageName ]! !

!SpecDebuggerStack methodsFor: 'actions browsing' stamp: 'AndreiChis 9/26/2013 19:04'!
browseMessages
	"Present a menu of all messages sent by the current message. 
	Open a message set browser of all implementors of the message chosen."

	self currentMessageName ifNotNil: [   
		self systemNavigation browseAllImplementorsOf: self currentMessageName ]! !

!SpecDebuggerStack methodsFor: 'actions lookup' stamp: 'AndreiChis 9/26/2013 17:09'!
contextMenuDebuggingActionsPragmas

	^ { #contextMenuDebuggingAction }! !

!SpecDebuggerStack methodsFor: 'initialization' stamp: 'AndreiChis 12/20/2013 12:51'!
contextMenu: aMenu
	"Create the context menu dynamically."
	
	self flag: 'Spec ignores the shortcuts set in the menu. Use another mechanism to load them'.
	"This method of constructing the menu is used as it allow one to reuse the MenuRegistration class for creating the actual menu morphs."							
	^ aMenu addAllFromPragma: 'specDebuggerStackMenuNew' target: self debugger.! !

!SpecDebuggerStack methodsFor: 'actions browsing' stamp: 'AndreiChis 9/26/2013 19:04'!
currentClass

	^ self currentContext methodClass! !

!SpecDebuggerStack methodsFor: 'actions browsing' stamp: 'AndreiChis 9/26/2013 19:04'!
browseMethodFull
	"Create and schedule a full Browser and then select the current class and message."

	self currentClassOrMetaClass ifNotNil: [ 
		Smalltalk tools browser 
			fullOnClass: self currentClassOrMetaClass
			selector: self currentMessageName ]! !

!SpecDebuggerStack methodsFor: 'updating' stamp: 'AndreiChis 9/29/2013 14:58'!
updateContentFromSession: aSession
	
	self list items: (aSession 
		ifNil: [ OrderedCollection new ] 
		ifNotNil: [ self filteredStackOfSize: self class defaultStackSize ] )! !

!SpecDebuggerStack methodsFor: 'actions browsing' stamp: 'AndreiChis 9/26/2013 19:04'!
inspectInstances
	"Inspect all instances of the selected class."

	self currentClassOrMetaClass ifNotNil: [ :aClass |
		aClass theNonMetaClass inspectAllInstances ]! !

!SpecDebuggerStack methodsFor: 'initialization' stamp: 'DucasseStephane 9/10/2014 09:59'!
initialize

	sessionHolder := nil asValueHolder.
	actionsCache := nil.
	super initialize.
	
	"self setDefaultFilters."! !

!SpecDebuggerStack methodsFor: 'initialization' stamp: 'AndreiChis 9/26/2013 16:35'!
initializePresenter

	super initializePresenter.

	sessionHolder whenChangedDo: [ :aSession |
		self updateContentFromSession: aSession ] 
! !

!SpecDebuggerStack methodsFor: 'private' stamp: 'AndreiChis 9/26/2013 18:30'!
debugger
	"Return the instance of the debugger containing this toolbar"
	
	^  owner! !

!SpecDebuggerStack methodsFor: 'updating' stamp: 'AndreiChis 12/20/2013 13:07'!
updateForSelectionChanged

	self
		expand;
		takeKeyboardFocus; "This is needed, as otherwise, the inspectors will take the focus"
		updateDebuggingActions ! !

!SpecDebuggerStack methodsFor: 'api' stamp: 'AndreiChis 9/25/2013 18:45'!
whenListChanged: aBlock

	self list whenListChanged: aBlock! !

!SpecDebuggerStack methodsFor: 'api' stamp: 'AndreiChis 9/25/2013 19:00'!
selectedItem

	^ self list selectedItem! !

!SpecDebuggerStack methodsFor: 'api' stamp: 'AndreiChis 9/25/2013 18:46'!
whenSelectedItemChanged: aBlock

	self list whenSelectedItemChanged: aBlock! !

!SpecDebuggerStack methodsFor: 'accessing' stamp: 'AndreiChis 9/26/2013 10:40'!
list

	^ listWidget! !

!SpecDebuggerStack methodsFor: 'api' stamp: 'AndreiChis 9/26/2013 16:36'!
takeKeyboardFocus

	self list takeKeyboardFocus! !

!SpecDebuggerStack methodsFor: 'actions browsing' stamp: 'AndreiChis 9/26/2013 19:04'!
methodHierarchy
	"Create and schedule a method browser on the hierarchy of implementors."

	self systemNavigation 
			methodHierarchyBrowserForClass: self currentClassOrMetaClass 
			selector: self currentMessageName
! !

!SpecDebuggerStack methodsFor: 'actions browsing' stamp: 'MarcusDenker 7/19/2014 18:45'!
currentClassOrMetaClass

	^ self currentContext methodClass! !

!SpecDebuggerStack methodsFor: 'api' stamp: 'AndreiChis 10/4/2013 11:53'!
selectedIndex

	^ self list selectedIndex! !

!SpecDebuggerStack methodsFor: 'updating' stamp: 'AndreiChis 12/20/2013 12:49'!
updateDebuggingActions

	actionsCache ifNotNil: [ 
		actionsCache do: [ :each |
			each shortcutCommand ifNotNil: [ :aShortcut |
				self list removeKeyCombination: aShortcut ] ] ].
	actionsCache := nil.
	self generateContextMenuDebuggingActions.
	
	actionsCache do: [ :each |
		each shortcutCommand ifNotNil: [ 
			self list bindKeyCombination: each shortcutCommand toAction:  [ each execute ] ] ].! !

!SpecDebuggerStack methodsFor: 'filtering' stamp: 'AndreiChis 9/30/2013 13:44'!
enabledFilters

	^ self class enabledFilters! !

!SpecDebuggerStack methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
session

	^ sessionHolder value! !

!SpecDebuggerStack methodsFor: 'actions browsing' stamp: 'AndreiChis 9/26/2013 19:04'!
inspectSubInstances
	"Inspect all instances of the selected class and all its subclasses"

	self currentClassOrMetaClass ifNotNil: [ :aClass |
		aClass theNonMetaClass inspectSubInstances ]! !

!SpecDebuggerStack methodsFor: 'api' stamp: 'AndreiChis 9/26/2013 19:01'!
listItems

	^ self list listItems! !

!SpecDebuggerStack methodsFor: 'actions browsing' stamp: 'AndreiChis 9/26/2013 19:04'!
browseClassVariables
	"Browse the class variables of the selected class."
	| cls |
	cls := self currentClass.
	(cls notNil and: [cls isTrait not])
		ifTrue: [self systemNavigation  browseClassVariables: cls]
! !

!SpecDebuggerStack methodsFor: 'initialization' stamp: 'AndreiChis 9/26/2013 16:58'!
initializeWidgets

	self instantiateModels: {(#listWidget -> #MultiColumnListModel)}.
	
	self list displayBlock: [ :aContext | self columnsFor: aContext ].
	self list menu: [ :aMenu |
		self contextMenu: aMenu]! !

!SpecDebuggerStack methodsFor: 'actions browsing' stamp: 'AndreiChis 9/26/2013 19:04'!
currentMessageCategoryName
	"Answer the name of the message category of the message of the currently selected context."

	^ self currentClass organization categoryOfElement: self currentMessageName! !

!SpecDebuggerStack methodsFor: 'actions' stamp: 'AndreiChis 9/29/2013 16:25'!
expandBy: anInteger
	| selectionIndex |
	
	selectionIndex := self list selectedIndex.
	self list items: (self filteredStackOfSize: anInteger + self list listSize).
	self list setSelectedIndex: selectionIndex
	! !

!SpecDebuggerStack methodsFor: 'api' stamp: 'AndreiChis 9/25/2013 18:53'!
setSelectedItem: anItem

	self list setSelectedItem: anItem! !

!SpecDebuggerStack methodsFor: 'actions browsing' stamp: 'AndreiChis 9/26/2013 19:04'!
fileOutMessage
	"Put a description of the selected message on a file"

	self currentMessageName ifNotNil: [
		Cursor write showWhile:
			[ self currentClassOrMetaClass fileOutMethod: self currentMessageName ] ]! !

!SpecDebuggerStack methodsFor: 'printing' stamp: 'ClementBera 3/7/2014 11:54'!
"protocol: printing"
columnsFor: anEntry
	"Answer the array of contexts."
	| method classLocation receiverClass |
	 
	method := anEntry home method.
	classLocation := method methodClass.
	receiverClass := anEntry receiver class.
	
	"If the receiver is differen from the implementor, show the original method implementor"
	classLocation = receiverClass
		ifTrue: [ classLocation := classLocation name ]
		ifFalse: [ 
			classLocation := receiverClass name, '(', classLocation name, ')' ].
	
	anEntry isBlockContext
		ifTrue: [ classLocation := '[...] in ', classLocation ].
		
	^ {classLocation. method selector asString}! !

!SpecDebuggerStack methodsFor: 'filtering' stamp: 'AndreiChis 9/30/2013 13:43'!
filteredStackOfSize: anInteger

	^ self debugger class filterCommonMessageSends 
		ifTrue: [
			self session 
				stackOfSize: anInteger 
				usingFilters: self enabledFilters ]
		ifFalse: [ 
			self session stackOfSize: anInteger ]
		
	 ! !

!SpecDebuggerStack methodsFor: 'actions' stamp: 'AndreiChis 9/26/2013 16:41'!
expand
	"If the last element of the visible stack is selected, expand the stack,
	if more elements are available."
	
	self list selectedItem ifNil: [ ^ self ]. 
	
	self list listItems ifNotNil: [ :aList |
		(self list selectedIndex = self list listSize and: [
			self list selectedItem sender notNil ]) ifTrue: [ 
				self expandBy: self class defaultStackSize ] ]
	! !

!SpecDebuggerStack methodsFor: 'actions browsing' stamp: 'MarcusDenker 7/19/2014 18:44'!
currentMessageName

	^ self currentContext methodSelector! !

!SpecDebuggerStack class methodsFor: 'settings filters' stamp: 'AndreiChis 9/29/2013 14:22'!
filterKernelClasses: aBoolean
	KCFilterEnabled := aBoolean! !

!SpecDebuggerStack class methodsFor: 'menu' stamp: 'MarkRizun 7/11/2014 16:03'!
dynamicStackMenu: aBuilder
	<contextMenu>
	<specDebuggerStackMenuNew>
	
	| target |
	target := aBuilder model.
	target currentContext ifNil: [ ^ target ].
	target currentContext class refactoringMethod: aBuilder.
	target currentContext class methodRefactoring: aBuilder.
		
	aBuilder model stack generateContextMenuDebuggingActions do: [ :anAction | 
		anAction asMenuRegistrationIn: aBuilder ].
	aBuilder! !

!SpecDebuggerStack class methodsFor: 'accessing' stamp: 'AndreiChis 9/30/2013 13:47'!
enabledFilters
	| enabledFilters |
	
	enabledFilters := OrderedCollection new.
	self filterDoItSelectors ifTrue: [ 
		enabledFilters addLast: self doItFilter ].
	self filterKernelClasses ifTrue: [ 
		enabledFilters addLast: self kernelClassesFilter ].
	self filterNilSelectors ifTrue: [ 
		enabledFilters addLast: self nilMsgsFilter ].
	
	^ enabledFilters
 ! !

!SpecDebuggerStack class methodsFor: 'settings filters' stamp: 'AndreiChis 9/29/2013 14:22'!
filterNilSelectors: aBoolean
	NilSelectorsFilterEnabled := aBoolean! !

!SpecDebuggerStack class methodsFor: 'filters creation' stamp: 'AndreiChis 9/29/2013 14:35'!
doItFilter
	^ SelectorFilter forSelector: #doIt! !

!SpecDebuggerStack class methodsFor: 'accessing' stamp: 'AndreiChis 9/25/2013 18:49'!
defaultStackSize

	^ 20! !

!SpecDebuggerStack class methodsFor: 'settings filters' stamp: 'AndreiChis 9/29/2013 14:22'!
filterDoItSelectors: aBoolean
	DoItFilterEnabled := aBoolean! !

!SpecDebuggerStack class methodsFor: 'class initialization' stamp: 'AndreiChis 9/29/2013 13:30'!
initialize

	FilterDictionary := Dictionary new.! !

!SpecDebuggerStack class methodsFor: 'settings filters' stamp: 'AndreiChis 9/29/2013 14:29'!
filterDoItSelectors
	^ DoItFilterEnabled ifNil:[ DoItFilterEnabled := false ]! !

!SpecDebuggerStack class methodsFor: 'filters creation' stamp: 'AndreiChis 9/29/2013 14:35'!
kernelClassesFilter
	^ KernelClassesFilter new.
	! !

!SpecDebuggerStack class methodsFor: 'filters creation' stamp: 'AndreiChis 9/29/2013 14:36'!
nilMsgsFilter 
	^ SelectorFilter forSelectors: (OrderedCollection with: #isNil with: #ifNotNil: with: #ifNil)! !

!SpecDebuggerStack class methodsFor: 'settings filters' stamp: 'AndreiChis 9/29/2013 14:29'!
filterKernelClasses
	^ KCFilterEnabled ifNil:[ KCFilterEnabled := false ]! !

!SpecDebuggerStack class methodsFor: 'settings filters' stamp: 'AndreiChis 9/29/2013 14:29'!
filterNilSelectors
  	^ NilSelectorsFilterEnabled ifNil:[ NilSelectorsFilterEnabled := false ]! !

!SpecDebuggerStack class methodsFor: 'specs' stamp: 'AndreiChis 9/26/2013 18:32'!
spec
	<spec: #default>
	
	^ SpecLayout composed
		add: #list ! !

!SpecDialogWindow commentStamp: '<historical>'!
A SpecDialogWindow is a window made for embedding Spec models into dialog windows
!
!SpecDialogWindow methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/24/2013 15:07'!
toolbar
	"Lazy initialization because this method is called efore the initialize method"
	
	^ toolbar! !

!SpecDialogWindow methodsFor: 'actions' stamp: 'BenjaminVanRyseghem 12/6/2013 18:35'!
close

	super close.
	self toolbar cancel! !

!SpecDialogWindow methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/26/2012 02:09'!
cancelAction: aBlock

	self toolbar cancelAction: aBlock ! !

!SpecDialogWindow methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/12/2012 18:03'!
newContentMorph
	"Answer a new content morph."

	^ self specWidget 
			ifNil: [ nil ] 
			ifNotNil: [:w | 
				w
					hResizing: #spaceFill;
					vResizing: #spaceFill ]! !

!SpecDialogWindow methodsFor: 'actions' stamp: 'BenjaminVanRyseghem 11/27/2013 15:11'!
escapePressed

	self toolbar triggerCancelAction! !

!SpecDialogWindow methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 12/4/2013 13:17'!
setToolbarFrom: aBlock
	| newToolbar |
	
	newToolbar := aBlock value.
	
	toolbar := newToolbar.
	newToolbar owner: self! !

!SpecDialogWindow methodsFor: 'initialize' stamp: 'BenjaminVanRyseghem 11/27/2013 13:56'!
initialize

	super initialize.

	self beResizeable! !

!SpecDialogWindow methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 8/2/2012 17:05'!
cancelled

	^ self toolbar cancelled! !

!SpecDialogWindow methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 8/2/2012 17:04'!
specWidget: anObject

	specWidget := anObject.! !

!SpecDialogWindow methodsFor: 'focus' stamp: 'EstebanLorenzano 2/18/2013 15:28'!
giveFocusToPreviousFrom: aModel 

	^ self model giveFocusToPreviousFrom: aModel! !

!SpecDialogWindow methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/4/2013 13:19'!
toolbar: anObject

	toolbar := anObject.
	anObject owner: self.
	
	self removeMorph: self submorphs last.
	self addMainPanel! !

!SpecDialogWindow methodsFor: 'actions' stamp: 'BenjaminVanRyseghem 7/12/2012 18:04'!
newMainPanel
	"Answer a new main panel."
	| panel |
	panel := self newDialogPanel.
	self newContentMorph ifNotNil: [:m | panel 	addMorphBack: m ].
	self newButtonRow ifNotNil: [:m | panel 	addMorphBack: m ].
	^ panel! !

!SpecDialogWindow methodsFor: 'focus' stamp: 'EstebanLorenzano 2/18/2013 15:28'!
giveFocusToNextFrom: aModel 

	^ self model giveFocusToNextFrom: aModel ! !

!SpecDialogWindow methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 8/2/2012 17:01'!
specWidget

	^ specWidget! !

!SpecDialogWindow methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/26/2012 02:08'!
okAction: aBlock

	self toolbar okAction: aBlock ! !

!SpecDialogWindow methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/24/2013 15:11'!
newButtonRow

	^ self toolbar 
		ifNil: [ nil ]
		ifNotNil: [ : t | t buildWithSpec ]! !

!SpecDialogWindow methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 8/2/2012 17:05'!
model: aModel

	super model: aModel.

	aModel model focusOrder
		addLast: toolbar.! !

!SpecDialogWindow methodsFor: 'open/close' stamp: 'BenjaminVanRyseghem 7/10/2012 16:18'!
initialExtent 

	^ self model
		ifNil: [ super initialExtent ]
		ifNotNil: [:m | m initialExtent
						ifNil: [ super initialExtent ]]! !

!SpecDropListMorph commentStamp: '<historical>'!
I am a special DropList with icons!
!SpecDropListMorph methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/23/2013 12:56'!
getIconFor: anItem

	^ self model getIconFor: anItem! !

!SpecDropListMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/23/2013 13:23'!
listHeight
	"Answer the height for the list."

	^ super listHeight + 12! !

!SpecDropListMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/22/2013 23:20'!
wrapItem: anItem index: anIndex

	^ self model wrapItem: anItem index: anIndex! !

!SpecDropListMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/23/2013 23:44'!
updateListSelectionIndex

	currentIcon ifNotNil: [ self removeMorph: currentIcon ].
		
	super updateListSelectionIndex.
	
	self selectedItem ifNotNil: [ :item | 
		(self getIconFor: item) ifNotNil: [:icon | 
			currentIcon := icon asMorph.
			self addMorphFront: currentIcon ] ] ! !

!SpecDropListMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/23/2013 13:20'!
listMorphClass

	^ PluggableIconListMorph! !

!SpecDropListMorph methodsFor: 'drawing' stamp: 'StephaneDucasse 8/31/2014 09:38'!
newListMorph
	"Answer a new list morph"

	^ (self listMorphClass
		on: self
		list: #list
		selected: #listSelectionIndex
		changeSelected: #listSelectionIndex:
		menu: nil
		keystroke: nil)
			getIconSelector: #getIconFor:;
			autoDeselect: false;
			wrapSelector: #wrapItem:index:;
			roundedCorners: #(2 3);
			setProperty: #morphicLayerNumber toValue: 5;
			borderStyle: (self theme dropListNormalListBorderStyleFor: self);
			on: #mouseDown send: #listMouseDown: to: self;
			yourself! !

!SpecExamples commentStamp: 'IgnacioSniechowski 2/25/2015 08:32'!
A SpecExamples is the first sub-book of SpecHelpTopics. It contains examples of using Spec.
See class side for selectors.
!
!SpecExamples class methodsFor: 'pages' stamp: 'IgnacioSniechowski 2/17/2015 08:42'!
moreExamples
	^HelpTopic 
		title: 'More Examples'
		contents: 'If you browse the Spec-Examples package you will find a lot more examples that will help you understand Spec a little more.
		
ApplicationWithToolbar new openWithSpec

CheckBoxExample new openWithSpec

ClassMethodBrowser new openWithSpec

DropListExample new openWithSpec

DynamicWidgetChange new openWithSpec

ListSelectionModel new openWithSpec

MethodBrowser new openWithSpec

ModelList new openWithSpec

ProtocolBrowser new openWithSpec

ProtocolList new openWithSpec

ProtocolViewer new openWithSpec

RadioButtonGroupExample new openWithSpec

ScrollSyncExample new openWithSpec

TabsExample new openWithSpec

TextFieldExample new openWithSpec'! !

!SpecExamples class methodsFor: 'accessing' stamp: 'IgnacioSniechowski 2/16/2015 19:11'!
bookName
	^ 'Examples'! !

!SpecExamples class methodsFor: 'accessing' stamp: 'IgnacioSniechowski 2/16/2015 19:13'!
pages
	^#(firstExample secondExample moreExamples)! !

!SpecExamples class methodsFor: 'pages' stamp: 'IgnacioSniechowski 2/16/2015 19:10'!
firstExample
	^HelpTopic 
		title: 'A first example: ModelList'
		contents: 'Creating a specific UI always starts with the subclassing of Composable-Model. Each sub widget is stored into an instance variable of the newly created class. All the code presented here is already in the image so you can simply do: 
		
	ModelList browse

And follow the tutorial while browsing the code. So let''s subclass ComposableModel.


	ComposableModel subclass: #ModelList
	instanceVariableNames: ''list''
	classVariableNames: ''
	category: ''Spec-Examples''		
		
The first required step then is to instantiate and define the sub widgets. This step is done in the method initializeWidgets. It creates the list and populates it with the required classes, in alphabetical order.

	ModelList>>initializeWidgets
	list := self newList.
	list items: (AbstractWidgetModel allSubclasses
	sorted: [:a :b | a name < b name ]).
	self focusOrder add: list
	
The second required step is to define a layout, which is done on the class side. Since there is here only one sub widget, the layout is quite simple. It simply returns a layout that contains only the list:

	ModelList class>>#defaultSpec
	<spec: #default>
	^ SpecLayout composed
	add: #list;
	yourself
	
The three last methods to define on ModelList are a getter, a method to display the UI title and a method to register to list selection changes.

	"accessing"
	ModelList>>list
		^ list

	"protocol"
	ModelList>>title
		^ ''Widgets''

	"protocol-events"
	ModelList>>whenSelectedItemChanged: aBlock
		list whenSelectedItemChanged: aBlock

The first UI is now done. The result can be seen by executing the following snippet of code: 
	ModelList new openWithSpec.

'! !

!SpecExamples class methodsFor: 'pages' stamp: 'IgnacioSniechowski 2/16/2015 19:10'!
secondExample
	^HelpTopic 
		title: 'A second example: Protocol List'
		contents: 'The next user interface is the protocol list. This UI combines two sub widgets: 
		a list
		a label.

So again, we start by subclassing ComposableModel:

	ComposableModel subclass: #ProtocolList
	instanceVariableNames: ''label protocols''
	classVariableNames: ''
	category: ''Spec-Examples''
	
The initializeWidgets method for this UI is quite similar to the method in ModelList:

	ProtocolList>>initializeWidgets
		protocols := self newList.
		label := self newLabel.
		label text: ''Protocol''.
		protocols displayBlock: [ :m | m selector ].
		self focusOrder add: protocols
	
The layout method is quite different though. Now the sub widgets need to be placed more specifically than in the previous example, we have to build a layout that has a column with the label on top and the list taking all the space that is left.

	ProtocolList class>>defaultSpec
		<spec: #default>
		^ SpecLayout composed
		newColumn: [ :column |
			column
				add: #label
					height: self toolbarHeight;
					add: #protocols ];
		yourself
		
	
The remaining methods are getters, sub widget delegation methods, a method to display the title, and a method to register to list selection changes: 


	"accessing"
	ProtocolList>>label
		^ label

	"accessing"
	ProtocolList>>protocols
		^ protocols

	"protocol"
	ProtocolList>>items: aCollection
		protocols items: aCollection

	"protocol"
	ProtocolList>>label: aText
		label text: aText

	"protocol"
	ProtocolList>>resetSelection
		protocols resetSelection

	"protocol"
	ProtocolList>>title
		^ ''Protocol widget''

	"protocol-events"
	ProtocolList>>whenSelectedItemChanged: aBlock
		protocols whenSelectedItemChanged: aBlock

The ProtocolList UI can be seen by evaluating:

 ProtocolList new openWithSpec.
'! !

!SpecHelpTopics commentStamp: 'IgnacioSniechowski 2/25/2015 08:31'!
A SpecHelpTopics is the main class which holds the documentation of Spec. This documentation can be accessed from the Help Browser.
See class side for selectors.
!
!SpecHelpTopics class methodsFor: 'accessing' stamp: 'IgnacioSniechowski 2/16/2015 19:20'!
pages
	^#(introduction terminology SpecExamples TheHeartOfSpec SpecLayouts)! !

!SpecHelpTopics class methodsFor: 'accessing' stamp: 'IgnacioSniechowski 2/16/2015 12:45'!
key
	^'Spec'! !

!SpecHelpTopics class methodsFor: 'pages' stamp: 'IgnacioSniechowski 2/16/2015 12:56'!
terminology
	^HelpTopic
		title: 'Terminology'
		contents: 'To avoid possible misunderstandings due to confusion in terminology, we first define the following four terms, which will be used frequently:

UI Element: an interactive graphical element displayed as part of the graphical user interface.

UI Model: an object that contains the state and behavior of one or several UI elements.

Widget: the union of a UI Element and its UI model.

Basic Widgets: low level widgets like'
		! !

!SpecHelpTopics class methodsFor: 'accessing' stamp: 'IgnacioSniechowski 2/16/2015 12:44'!
bookName
	^ 'Spec'! !

!SpecHelpTopics class methodsFor: 'pages' stamp: 'IgnacioSniechowski 2/16/2015 12:53'!
introduction
	^HelpTopic 	
		title: 'About Spec'
		contents: 'Spec has been originally developed by B. Van Ryseghem based on an idea of S. Ducasse. It is now maintained by the community and the pharo core team.. 

Spec is attempt to support UI logic reuse. Spec is influenced by VisualWorks and Dolphin MVP in the sense that it recognizes the need for a Presenter or Application-Model class, in Spec called ComposableModel that manages the logic and the link between widgets and domain objects. Spec, following the tradition, uses value holders, simple object raising announcements when their values, often domain objects, change.'! !

!SpecInterpreter commentStamp: '<historical>'!
A SpecInterpreter is a interpreter for spec presenters!
!SpecInterpreter methodsFor: 'bindings' stamp: 'BenjaminVanRyseghem 10/1/2013 12:38'!
convertSymbolOfClassToInstance: aSymbol
	| translatedSymbol |
	
	translatedSymbol := self bindings translateSymbol: aSymbol.
	
	^ (Smalltalk 
		at: translatedSymbol
		ifAbsent: [ ^ translatedSymbol ]) new! !

!SpecInterpreter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/6/2012 18:23'!
model
	^ model! !

!SpecInterpreter methodsFor: 'interpreting-private' stamp: 'BenjaminVanRyseghem 11/21/2013 11:22'!
computeSpecFrom: aSymbol selector: aSelector
	| instance |

	instance := (aSymbol isSymbol and: [ aSymbol ~= #model ])
		ifTrue: [ | result |
			result := self convertSymbolOfClassToInstance: aSymbol.
			aSymbol == #ContainerModel
				ifTrue: [ 
					result := result buildAdapterWithSpec.
					model addDependent: result ].
			result ]
		ifFalse: [ self class private_interpretASpec: aSymbol model: model selector: aSelector ].
		
	^ SpecWrapper
		instance: instance
		selector: aSelector! !

!SpecInterpreter methodsFor: 'interpreting-private' stamp: 'BenjaminVanRyseghem 3/19/2013 13:09'!
extractArrayToInterpretFrom: aFragment

	arrayToInterpret := aFragment.
	
	aFragment isSpecLayout
		ifTrue: [ arrayToInterpret := aFragment asArray ].
	
	(arrayToInterpret isCollection and: [ arrayToInterpret isSequenceable ])
		ifFalse: [ ^ arrayToInterpret ].
	
	(aFragment isString or: [ aFragment isText ])
		ifTrue: [ 
			^ aFragment == #model
				ifTrue: [ model ]
				ifFalse: [ self convertSymbolOfClassToInstance: aFragment ] ].
	^ nil! !

!SpecInterpreter methodsFor: 'interpreting-private' stamp: 'BenjaminVanRyseghem 9/29/2013 14:38'!
returnInterpretationOf: newInstance
	| result |
	(model respondsTo: #spec:)
		ifTrue: [ model spec: spec ].
	result := self class private_interpretASpec: newInstance model: spec instance selector: spec selector.
	^ (result isKindOf: ComposableModel)
		ifTrue: [ 
			| return |
			return := result private_buildWithSpec.
			^ return ]
		ifFalse: [ ^ result ]! !

!SpecInterpreter methodsFor: 'bindings' stamp: 'BenjaminVanRyseghem 10/1/2013 12:37'!
bindings

	^ self class bindings! !

!SpecInterpreter methodsFor: 'interpreting-private' stamp: 'BenjaminVanRyseghem 9/29/2013 14:25'!
actionToPerformWithSelector: selector arguments: args

	^ spec instance perform: selector withArguments: args! !

!SpecInterpreter methodsFor: 'interpreting-private' stamp: 'BenjaminVanRyseghem 9/29/2013 14:38'!
performNextSelectorAndIncrementIndex
	| args numArgs selector |

	selector := (arrayToInterpret at: index).
	selector isArray not
		ifTrue: [ 
			selector := selector asSymbol.
			numArgs := selector numArgs.
			args := arrayToInterpret copyFrom: index + 1 to: index + numArgs ]
		ifFalse: [ 
			"Here I assume that if it's not a symbol, it's a collection"
			| array |
			array := selector.
			selector := array first.
			numArgs := 0.
			args := array allButFirst ].
	
	args := args collect: [ :each | self class private_interpretASpec: each model: model selector: spec selector ].

	index := index + numArgs + 1.
	^ self actionToPerformWithSelector: selector arguments: args! !

!SpecInterpreter methodsFor: 'interpreting-private' stamp: 'BenjaminVanRyseghem 11/26/2013 23:34'!
retrieveSpecFrom: aPresenter selector: aSelector

	((self model respondsTo: #needRebuild) and: [ self model needRebuild not and: [ self model spec notNil ] ])
		ifTrue: [
			spec := self model spec.
			self model needRebuild: true.
			((spec respondsTo: #isRedrawable) and: [ spec instance isSpecAdapter ])
				ifFalse: [ spec := self computeSpecFrom: arrayToInterpret first selector: aSelector ]
				ifTrue: [ 
					spec isRedrawable
						ifTrue: [ spec removeSubWidgets ]
						ifFalse: [ ^ spec instance ] ] ]
		ifFalse: [ spec := self computeSpecFrom: arrayToInterpret first selector: aSelector ].
	
	aSelector
		ifNil: [ aPresenter isSpecLayout ifTrue: [ spec selector: aPresenter selector ] ]
		ifNotNil: [ spec selector: aSelector ].
		
	^ nil! !

!SpecInterpreter methodsFor: 'interpreting' stamp: 'BenjaminVanRyseghem 9/29/2013 14:41'!
interpretASpec: aPresenter model: aModel  selector: aSelector
	
	self model: aModel.
	^ self interpretASpec: aPresenter selector: aSelector! !

!SpecInterpreter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/6/2012 18:23'!
model: anObject
	model := anObject! !

!SpecInterpreter methodsFor: 'interpreting' stamp: 'BenjaminVanRyseghem 9/29/2013 14:38'!
interpretASpec: aPresenter selector: aSelector
	aPresenter ifNil: [ ^ nil ].
	
	(self extractArrayToInterpretFrom: aPresenter) ifNotNil: [ :result | ^ result ].
	
	(self retrieveSpecFrom: aPresenter selector: aSelector)
		ifNotNil: [ :instance | ^ instance ].

	index := 2.
	[ index <= arrayToInterpret size ]
		whileTrue: [ 
			| newInstance |
			
			newInstance := self performNextSelectorAndIncrementIndex.
			
			index > arrayToInterpret size
				ifTrue: [ ^ self returnInterpretationOf: newInstance ].
			spec instance: newInstance ].	
			
	"If you get here, there is a problem. Must probably it comes from the Spec which is wrongly defined"
	self assert: arrayToInterpret size < 2.
	
	(model respondsTo: #spec:)
		ifTrue: [ model spec: spec ].
		
	^ spec instance! !

!SpecInterpreter class methodsFor: 'private' stamp: 'BenjaminVanRyseghem 5/19/2013 16:24'!
private_buildWidgetFor: aComposableModel withSpec: aSymbol
	
	^ self private_interpretASpec: (aComposableModel retrieveSpec: aSymbol) model: aComposableModel selector: aSymbol! !

!SpecInterpreter class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/18/2013 15:22'!
hardResetBindings

	bindings := nil! !

!SpecInterpreter class methodsFor: 'private' stamp: 'ClementBera 5/3/2013 12:35'!
private_interpretASpec: aPresenter model: aModel selector: aSelector
	
	^ self new
		interpretASpec: aPresenter
		model: aModel
		selector: aSelector! !

!SpecInterpreter class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/18/2012 14:45'!
bindings

	^ bindings ifNil: [ bindings := self defaultBindings ]! !

!SpecInterpreter class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/1/2013 12:27'!
bindings: anAdapterBinding

	bindings := anAdapterBinding! !

!SpecInterpreter class methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 9/29/2013 14:39'!
interpretASpec: aSpec model: aModel
	
	^ self
		interpretASpec: aSpec
		model: aModel
		selector: nil! !

!SpecInterpreter class methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/1/2013 12:26'!
interpretASpec: aPresenter model: aModel selector: aSelector
	| result |
	
	 [ result :=  self 
				private_interpretASpec: aPresenter
				model: aModel
				selector: aSelector ] ensure: [ self hardResetBindings ].
	^ result! !

!SpecInterpreter class methodsFor: 'private' stamp: 'BenjaminVanRyseghem 10/1/2013 12:26'!
defaultBindings
	
	^ MorphicAdapterBindings new! !

!SpecInterpreterTest commentStamp: '<historical>'!
A SpecInterpreterTest is a test class for testing the behavior of SpecInterpreter!
!SpecInterpreterTest methodsFor: 'tests' stamp: 'BenjaminVanRyseghem 4/2/2013 16:37'!
testDynamicBuild

	| model widget1 widget2 widget3 |
	model := TestingComposableModel new.
 	model openWithSpec close.
	widget1 := model list widget.
	
	model openWithSpec close.
	widget2 := model list widget.
	
	self deny: widget1 == widget2.
	
	model list needRebuild: false.
	model needRebuild: false.
	model openWithSpec close.
	widget3 := model list widget.
	
	self assert: widget2 == widget3.
	self assert: model needRebuild! !

!SpecInterpreterTest methodsFor: 'tests' stamp: 'BenjaminVanRyseghem 10/4/2013 14:45'!
testInterpretASpecModelMorphAssociation

	| spec model morph |
	model := AbstractWidgetModel new.
	spec := {#PluggableListMorph. #model:. #model}.
	morph := specInterpreterClass interpretASpec: spec model: model.
	
	self assert: (model widget == morph).! !

!SpecInterpreterTest methodsFor: 'tests' stamp: ''!
testConvertRandomSymbolOfClassToInstance
	
	| symbol instance |
	symbol := #PluggableListMorph.
	
	instance := specInterpreter convertSymbolOfClassToInstance: symbol.
	self assert: (instance class name = symbol)! !

!SpecInterpreterTest methodsFor: 'tests' stamp: 'BenjaminVanRyseghem 5/19/2013 16:25'!
testBuildWidgetForWithSpec

	| model morph |
	model := TestingComposableModel new.
	morph := model buildWithSpec: #testingSpec.
	
	self assert: (morph model == model).
	self assert: (model widget class = PluggableTextMorph).! !

!SpecInterpreterTest methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 9/29/2013 14:49'!
tearDown
	"Tearing down code for SpecInterpreterTest"

	specInterpreterClass := nil.
	specInterpreter := nil.! !

!SpecInterpreterTest methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 10/18/2012 15:27'!
setUp
	"Setting up code for SpecInterpreterTest"

	specInterpreterClass := SpecInterpreter.
	specInterpreter := specInterpreterClass new.
	specInterpreter model: TestingComposableModel new! !

!SpecLayout commentStamp: '<historical>'!
A SpecPresenter is a object used to describe a user interface!
!SpecLayout methodsFor: 'commands' stamp: 'StephaneDucasse 12/24/2012 17:27'!
add: aSpec origin: originPoint corner: cornerPoint offsetOrigin: ooPoint offsetCorner: ocPoint
	
	commands add: (SpecLayoutAdd 
							subwidget: aSpec
							layoutFrame: 
								((originPoint corner: cornerPoint) asLayoutFrame 
									topLeftOffset: ooPoint;
									bottomRightOffset: ocPoint ))! !

!SpecLayout methodsFor: 'commands-advanced' stamp: 'BenjaminVanRyseghem 5/18/2013 21:00'!
newColumn: aBlock left: aNumber
	
	self newColumn: aBlock left: aNumber right: nil! !

!SpecLayout methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/21/2013 22:00'!
setOffsetsFor: widget top: top left: left bottom: bottom right: right borderWidth: windowBorderWidth

	self setRightOffset: right for: windowBorderWidth borderWidth: widget.
	self setLeftOffset: left for: widget borderWidth: windowBorderWidth.
	self setBottomOffset: bottom for: widget borderWidth: windowBorderWidth.
	self setTopOffset: top for: widget borderWidth: windowBorderWidth! !

!SpecLayout methodsFor: 'commands' stamp: 'BenjaminVanRyseghem 6/18/2012 06:40'!
add: modelGetter withSpec: aSymbol 
	
	self add: modelGetter withSpec: aSymbol origin: 0@0 corner: 1@1! !

!SpecLayout methodsFor: 'commands-advanced' stamp: 'BenjaminVanRyseghem 5/18/2013 21:00'!
newRow: aBlock top: aNumber
	
	self newRow: aBlock top: aNumber bottom: nil! !

!SpecLayout methodsFor: 'commands-advanced' stamp: 'BenjaminVanRyseghem 5/18/2013 20:51'!
add: aBlock top: aNumber

	self add: aBlock top: aNumber bottom: nil left: nil right: nil! !

!SpecLayout methodsFor: 'commands' stamp: 'BenjaminVanRyseghem 6/18/2012 06:40'!
newColumn: aBlock origin: originPoint corner: cornerPoint 

	self newColumn: aBlock origin: originPoint corner: cornerPoint offsetOrigin: 0@0 offsetCorner: 0@0! !

!SpecLayout methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 9/27/2013 10:48'!
initialize 
	super initialize.
	
	type := #ContainerModel.
	self commands: OrderedCollection new.! !

!SpecLayout methodsFor: 'private' stamp: 'BenjaminVanRyseghem 5/18/2013 20:55'!
computeLayoutFromTop: top bottom: bottom left: left right: right
	| originY offsetCornerX cornerX offsetOriginY offsetCornerY cornerY originX offsetOriginX |
	
	originX := left isFloat
		ifTrue: [ left ]
		ifFalse: [ 0 ].
	originY := top isFloat
		ifTrue: [ top ]
		ifFalse: [ 0 ].
	cornerX := right isFloat
		ifTrue: [ 1 - right ]
		ifFalse: [ 1 ].
	cornerY := bottom isFloat
		ifTrue: [ 1 - bottom ]
		ifFalse: [ 1 ].
	offsetOriginX := left isInteger
		ifTrue: [ left ]
		ifFalse: [ 0 ].
	offsetOriginY := top isInteger
		ifTrue: [ top ]
		ifFalse: [ 0 ].
	offsetCornerX := right isInteger
		ifTrue: [ right negated ]
		ifFalse: [ 0 ].
	offsetCornerY := bottom isInteger
		ifTrue: [ bottom negated ]
		ifFalse: [ 0 ].
		
	^ { originX@originY. cornerX@cornerY. offsetOriginX@offsetOriginY. offsetCornerX@offsetCornerY }! !

!SpecLayout methodsFor: 'commands-advanced' stamp: 'BenjaminVanRyseghem 5/18/2013 21:00'!
newRow: aBlock bottom: aNumber
	
	self newRow: aBlock top: nil bottom: aNumber! !

!SpecLayout methodsFor: 'commands' stamp: 'BenjaminVanRyseghem 3/28/2013 17:26'!
newRow: aBlock height: aNumber
	
	self newRow: aBlock origin: 0@0 corner: 1@0 offsetOrigin: 0@0 offsetCorner: 0@aNumber ! !

!SpecLayout methodsFor: 'converting' stamp: 'BenjaminVanRyseghem 12/21/2013 21:52'!
resetArrayComputation
	result := OrderedCollection new.
	shouldCheckSplitters := false! !

!SpecLayout methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/21/2013 22:00'!
setBottomOffset: bottom for: widget borderWidth: windowBorderWidth

	widget bottomFraction = 1
		ifTrue: [ 
			bottom isZero
				ifTrue: [ widget bottomOffset: windowBorderWidth negated ]
				ifFalse: [ widget bottomOffset: bottom - ProportionalSplitterMorph splitterWidth ] ]! !

!SpecLayout methodsFor: 'commands' stamp: 'StephaneDucasse 12/27/2012 18:33'!
add: modelGetter withSpec: aSymbol origin: originPoint corner: cornerPoint offsetOrigin: ooPoint offsetCorner: ocPoint

	commands add: (SpecLayoutAddWithSpec 
							subwidget: modelGetter 
							spec: aSymbol 
							layoutFrame: ((originPoint corner: cornerPoint) asLayoutFrame 
												topLeftOffset: ooPoint;
												bottomRightOffset: ocPoint))! !

!SpecLayout methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/18/2012 06:40'!
type: anObject
	type := anObject! !

!SpecLayout methodsFor: 'commands' stamp: 'BenjaminVanRyseghem 4/21/2013 00:02'!
newRow: aBlock origin: originPoint corner: cornerPoint offsetOrigin: ooPoint offsetCorner: ocPoint
	| block |
	
	block := aBlock.
	block isBlock ifFalse: [ block := [:r | r add: aBlock ] ].
	
	commands add: (SpecLayoutAddRow
							block: block
							layoutFrame: ((originPoint corner: cornerPoint) asLayoutFrame 
										topLeftOffset: ooPoint;
										bottomRightOffset: ocPoint)).! !

!SpecLayout methodsFor: 'commands-advanced' stamp: 'BenjaminVanRyseghem 5/12/2013 13:11'!
add: aBlock withSpec: aSpec top: top bottom: bottom
	
	self add: aBlock withSpec: aSpec top: top bottom: bottom left: nil right: nil! !

!SpecLayout methodsFor: 'converting' stamp: 'MarcusDenker 9/12/2014 17:09'!
asArray
	^ (OrderedCollection new
		add: self type;
		addAll: self privateAsArray;
		yourself) asArray! !

!SpecLayout methodsFor: 'commands' stamp: 'BenjaminVanRyseghem 4/2/2013 09:42'!
newColumn: aBlock origin: originPoint corner: cornerPoint offsetOrigin: ooPoint offsetCorner: ocPoint
	| block |
	
	block := aBlock.
	block isBlock ifFalse: [ block := [:c | c add: aBlock ] ].
	
	commands add: (SpecLayoutAddColumn
							block: block
							layoutFrame: ((originPoint corner: cornerPoint) asLayoutFrame
										topLeftOffset: ooPoint;
										bottomRightOffset: ocPoint)).! !

!SpecLayout methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/19/2013 16:15'!
selector: anObject
	selector := anObject! !

!SpecLayout methodsFor: 'commands-advanced' stamp: 'BenjaminVanRyseghem 5/18/2013 20:57'!
add: aBlock top: top bottom: bottom left: left right: right
	| layout |
	
	layout := self computeLayoutFromTop: top bottom: bottom left: left right: right.
		
	self 
		add: aBlock
		origin: layout first
		corner: layout second
		offsetOrigin: layout third
		offsetCorner: layout fourth! !

!SpecLayout methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/21/2013 21:54'!
computeNotSplitterWidgets

	(self commands reject: [ :e | e isSplitter ]) 
		do: [ :e | self computeNotSplitterWidget: e ]! !

!SpecLayout methodsFor: 'commands-advanced' stamp: 'BenjaminVanRyseghem 5/12/2013 12:54'!
add: aBlock top: top bottom: bottom
	
	self add: aBlock top: top bottom: bottom left: nil right: nil! !

!SpecLayout methodsFor: 'commands-advanced' stamp: 'BenjaminVanRyseghem 5/12/2013 13:11'!
add: aBlock withSpec: aSpec bottom: aNumber
	
	self add: aBlock withSpec: aSpec top: nil bottom: aNumber left: nil right: nil! !

!SpecLayout methodsFor: 'converting' stamp: 'BenjaminVanRyseghem 3/28/2013 17:49'!
addVSplitter

	self commands add: (SpecSplitterVertical commands: self commands)! !

!SpecLayout methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/18/2012 06:40'!
commands
	^ commands! !

!SpecLayout methodsFor: 'commands' stamp: 'BenjaminVanRyseghem 7/9/2012 13:40'!
newColumn: aBlock  width: aNumber
	
	self newColumn: aBlock  origin: 0@0 corner: 0@1 offsetOrigin: 0@0 offsetCorner: aNumber @0! !

!SpecLayout methodsFor: 'commands-advanced' stamp: 'BenjaminVanRyseghem 5/12/2013 12:55'!
add: aBlock left: left right: right
	
	self add: aBlock top: nil bottom: nil left: left right: right! !

!SpecLayout methodsFor: 'commands' stamp: 'BenjaminVanRyseghem 6/18/2012 06:40'!
add: modelGetter withSpec: aSymbol origin: originPoint corner: cornerPoint 

	self add: modelGetter withSpec: aSymbol origin: originPoint corner: cornerPoint offsetOrigin: 0@0 offsetCorner: 0@0! !

!SpecLayout methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 6/18/2012 06:40'!
isSpecLayout

	^ true! !

!SpecLayout methodsFor: 'commands' stamp: 'BenjaminVanRyseghem 6/18/2012 06:40'!
newRow: aBlock 
	
	self newRow: aBlock origin: 0@0 corner: 1@1! !

!SpecLayout methodsFor: 'converting' stamp: 'BenjaminVanRyseghem 12/21/2013 21:53'!
privateAsArray

	self resetArrayComputation.
	
	self computeNotSplitterWidgets.
	self computeSplitters.
	
	^ result asArray! !

!SpecLayout methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/19/2013 16:15'!
selector
	^ selector! !

!SpecLayout methodsFor: 'commands-advanced' stamp: 'BenjaminVanRyseghem 5/12/2013 13:11'!
add: aBlock withSpec: aSpec left: aNumber
	
	self add: aBlock withSpec: aSpec top: nil bottom: nil left: aNumber right: nil! !

!SpecLayout methodsFor: 'commands' stamp: 'BenjaminVanRyseghem 6/18/2012 06:40'!
newColumn: aBlock 
	
	self newColumn: aBlock origin: 0@0 corner: 1@1! !

!SpecLayout methodsFor: 'commands-advanced' stamp: 'BenjaminVanRyseghem 5/12/2013 12:55'!
add: aBlock right: aNumber
	
	self add: aBlock top: nil bottom: nil left: nil right: aNumber! !

!SpecLayout methodsFor: 'converting' stamp: 'BenjaminVanRyseghem 3/28/2013 17:55'!
addHSplitter

	self commands add: (SpecSplitterHorizontal commands: self commands)! !

!SpecLayout methodsFor: 'commands' stamp: 'BenjaminVanRyseghem 6/18/2012 06:40'!
newRow: aBlock origin: originPoint corner: cornerPoint 

	self newRow: aBlock origin: originPoint corner: cornerPoint offsetOrigin: 0@0 offsetCorner: 0@0! !

!SpecLayout methodsFor: 'commands-advanced' stamp: 'BenjaminVanRyseghem 5/18/2013 20:59'!
newColumn: aBlock left: left right: right
	| layout |
	
	layout := self computeLayoutFromTop: nil bottom: nil left: left right: right.

	self 
		newColumn: aBlock
		origin: layout first
		corner: layout second
		offsetOrigin: layout third
		offsetCorner: layout fourth! !

!SpecLayout methodsFor: 'commands-advanced' stamp: 'BenjaminVanRyseghem 5/12/2013 13:11'!
add: aBlock withSpec: aSpec top: aNumber
	
	self add: aBlock withSpec: aSpec top: aNumber bottom: nil left: nil right: nil! !

!SpecLayout methodsFor: 'commands-advanced' stamp: 'BenjaminVanRyseghem 5/12/2013 13:09'!
add: aBlock bottom: aNumber
	
	self add: aBlock top: nil bottom: aNumber left: nil right: nil! !

!SpecLayout methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/21/2013 22:00'!
setLeftOffset: left for: widget borderWidth: windowBorderWidth

	widget leftFraction = 0
		ifTrue: [ 
			left isZero
				ifTrue: [ widget leftOffset: windowBorderWidth ]
				ifFalse: [ widget leftOffset: left + ProportionalSplitterMorph splitterWidth ] ]
		ifFalse: [ 
			widget leftFraction = 1
				ifFalse: [ widget leftOffset: left + ProportionalSplitterMorph splitterWidth ] ]! !

!SpecLayout methodsFor: 'commands' stamp: 'BenjaminVanRyseghem 6/18/2012 06:40'!
add: aSpec 
	
	self add: aSpec origin: 0@0 corner: 1@1! !

!SpecLayout methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/22/2013 00:45'!
setTopOffset: top for: widget borderWidth: windowBorderWidth

	widget topFraction = 0
		ifTrue: [
			top isZero
				ifTrue: [ widget topOffset: windowBorderWidth ]
				ifFalse: [ widget topOffset: top + ProportionalSplitterMorph splitterWidth ] ]
		ifFalse: [ 
			widget topFraction = 1
				ifFalse: [ widget topOffset: top + ProportionalSplitterMorph splitterWidth ] ]! !

!SpecLayout methodsFor: 'commands' stamp: 'BenjaminVanRyseghem 6/18/2012 06:40'!
add: aSpec origin: originPoint corner: cornerPoint 

	self add: aSpec origin: originPoint corner: cornerPoint offsetOrigin: 0@0 offsetCorner: 0@0! !

!SpecLayout methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/18/2012 06:40'!
type
	^ type! !

!SpecLayout methodsFor: 'commands-advanced' stamp: 'BenjaminVanRyseghem 5/18/2013 21:00'!
newColumn: aBlock right: aNumber
	
	self newColumn: aBlock left: nil right: aNumber! !

!SpecLayout methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/21/2013 21:59'!
computeNotSplitterWidget: widget
	
	self
		setOffsetsFor: widget
		top: widget topOffset
		left: widget leftOffset
		bottom: widget bottomOffset
		right: widget rightOffset
		borderWidth: self class windowBorderWidth.
	
	widget generateArguments.
	widget asSpecElements do: [ :el | result add: el ]! !

!SpecLayout methodsFor: 'commands-advanced' stamp: 'BenjaminVanRyseghem 5/12/2013 13:11'!
add: aBlock withSpec: aSpec right: aNumber
	
	self add: aBlock withSpec: aSpec top: nil bottom: nil left: nil right: aNumber! !

!SpecLayout methodsFor: 'commands-advanced' stamp: 'BenjaminVanRyseghem 5/12/2013 13:11'!
add: aBlock withSpec: aSpec left: left right: right
	
	self add: aBlock withSpec: aSpec top: nil bottom: nil left: left right: right! !

!SpecLayout methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/18/2012 06:40'!
commands: anObject
	commands := anObject! !

!SpecLayout methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/21/2013 22:00'!
setRightOffset: right for: windowBorderWidth borderWidth: widget

	widget rightFraction = 1
		ifTrue: [ 
			right isZero
				ifTrue: [ widget rightOffset: windowBorderWidth negated ]
				ifFalse: [ widget rightOffset: right - ProportionalSplitterMorph splitterWidth ] ]! !

!SpecLayout methodsFor: 'commands' stamp: 'BenjaminVanRyseghem 6/18/2012 06:40'!
send: aSelector withArguments: arguments


	self commands add: (SpecLayoutSend
							selector: aSelector
							arguments: arguments).! !

!SpecLayout methodsFor: 'commands-advanced' stamp: 'BenjaminVanRyseghem 5/12/2013 12:55'!
add: aBlock left: aNumber
	
	self add: aBlock top: nil bottom: nil left: aNumber right: nil! !

!SpecLayout methodsFor: 'commands-advanced' stamp: 'BenjaminVanRyseghem 5/18/2013 20:57'!
add: aBlock withSpec: aSpec top: top bottom: bottom left: left right: right
	| layout |
	
	layout := self computeLayoutFromTop: top bottom: bottom left: left right: right.
		
	self 
		add: aBlock
		withSpec: aSpec 
		origin: layout first
		corner: layout second
		offsetOrigin: layout third
		offsetCorner: layout fourth! !

!SpecLayout methodsFor: 'commands-advanced' stamp: 'BenjaminVanRyseghem 5/18/2013 20:59'!
newRow: aBlock top: top bottom: bottom
	| layout |
	
	layout := self computeLayoutFromTop: top bottom: bottom left: nil right: nil.
		
	self 
		newRow: aBlock
		origin: layout first
		corner: layout second
		offsetOrigin: layout third
		offsetCorner: layout fourth! !

!SpecLayout methodsFor: 'commands' stamp: 'BenjaminVanRyseghem 6/18/2012 06:40'!
send: aSelector
	
	self send: aSelector withArguments: #()! !

!SpecLayout methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/21/2013 22:00'!
computeSplitters

	(self commands select: [ :e | e isSplitter ])
		do: [ :e | 
			shouldCheckSplitters := true.
			e generateArguments.
			e asSpecElements do: [ :el | result add: el ] ].
	shouldCheckSplitters
		ifTrue: [ result add: #checkSplitters ]! !

!SpecLayout class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 9/28/2013 20:50'!
composed

	^self new
		type: #ContainerModel;
		yourself! !

!SpecLayout class methodsFor: 'constants' stamp: 'BenjaminVanRyseghem 7/18/2012 18:49'!
windowBorderWidth

	^ 0! !

!SpecLayoutAdd commentStamp: '<historical>'!
A SpecLayoutAdd represents the action to add a subwidget into a spec layout!
!SpecLayoutAdd methodsFor: 'protocol' stamp: 'StephaneDucasse 12/24/2012 17:21'!
bottomOffset

	^ layoutFrame bottomOffset ! !

!SpecLayoutAdd methodsFor: 'accessing' stamp: 'StephaneDucasse 12/27/2012 22:45'!
fractions
	^ layoutFrame fractionRectangle! !

!SpecLayoutAdd methodsFor: 'protocol' stamp: 'StephaneDucasse 12/24/2012 17:21'!
bottomFraction

	^ layoutFrame bottomFraction! !

!SpecLayoutAdd methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 1/15/2013 11:32'!
generateArguments
	
	self arguments: {{subwidget .#layout:. layoutFrame generateSpec}}.! !

!SpecLayoutAdd methodsFor: 'protocol' stamp: 'StephaneDucasse 12/24/2012 17:24'!
rightOffset

	^ layoutFrame rightOffset! !

!SpecLayoutAdd methodsFor: 'protocol' stamp: 'StephaneDucasse 12/24/2012 17:24'!
topFraction

	^ layoutFrame topFraction! !

!SpecLayoutAdd methodsFor: 'accessing' stamp: 'StephaneDucasse 12/24/2012 18:31'!
offsets
	"to deprecate 
	"
	self flag: #fix.
	^ layoutFrame leftOffset  @ layoutFrame topOffset corner:  layoutFrame rightOffset  @ layoutFrame bottomOffset ! !

!SpecLayoutAdd methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 23:07'!
initialize

	super initialize.
	self selector: #add:.
	layoutFrame := LayoutFrame identity.
	subwidget := nil.! !

!SpecLayoutAdd methodsFor: 'protocol' stamp: 'StephaneDucasse 12/24/2012 17:23'!
bottomOffset: aNumber

	layoutFrame bottomOffset: aNumber! !

!SpecLayoutAdd methodsFor: 'protocol' stamp: 'StephaneDucasse 12/24/2012 17:24'!
rightOffset: aNumber

	layoutFrame rightOffset: aNumber! !

!SpecLayoutAdd methodsFor: 'protocol' stamp: 'StephaneDucasse 12/24/2012 17:25'!
topOffset: aNumber

	layoutFrame topOffset: aNumber! !

!SpecLayoutAdd methodsFor: 'protocol' stamp: 'StephaneDucasse 12/24/2012 17:23'!
bottomFraction: aNumber

	layoutFrame bottomFraction: aNumber ! !

!SpecLayoutAdd methodsFor: 'protocol' stamp: 'StephaneDucasse 12/24/2012 17:23'!
leftOffset

	^ layoutFrame leftOffset! !

!SpecLayoutAdd methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/18/2012 04:31'!
subwidget
	^ subwidget! !

!SpecLayoutAdd methodsFor: 'protocol' stamp: 'StephaneDucasse 12/24/2012 17:24'!
leftOffset: aNumber

	^ layoutFrame leftOffset: aNumber! !

!SpecLayoutAdd methodsFor: 'accessing' stamp: 'StephaneDucasse 12/24/2012 18:40'!
layoutFrame

	^ layoutFrame! !

!SpecLayoutAdd methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 6/18/2012 05:36'!
subwidget: aSpec fractions: frac offsets: off

	subwidget := aSpec isSymbol
				ifTrue: [{#model. aSpec}]
				ifFalse: [
					aSpec isCollection
						ifTrue: [
							aSpec isEmpty 
								ifTrue: [ "should raise an error" ]
								ifFalse: [ aSpec first == #model 
											ifTrue: [ aSpec ]
											ifFalse: [ {#model}, aSpec ]]]
						ifFalse: [ 
							"Not a symbol or a collection. We assume it's an object to add directly (like a morph by example)"
							aSpec ]].
	self fractions: frac.
	self offsets: off.
	
	self generateArguments! !

!SpecLayoutAdd methodsFor: 'instance creation' stamp: 'StephaneDucasse 12/24/2012 17:19'!
subwidget: aSpec layoutFrame: aLayoutFrame
	
	subwidget := aSpec isSymbol
				ifTrue: [{#model. aSpec}]
				ifFalse: [
					aSpec isCollection
						ifTrue: [
							aSpec isEmpty 
								ifTrue: [ "should raise an error" ]
								ifFalse: [ aSpec first == #model 
											ifTrue: [ aSpec ]
											ifFalse: [ {#model}, aSpec ]]]
						ifFalse: [ 
							"Not a symbol or a collection. We assume it's an object to add directly (like a morph by example)"
							aSpec ]].
	
	layoutFrame := aLayoutFrame.
	self generateArguments! !

!SpecLayoutAdd methodsFor: 'accessing' stamp: 'StephaneDucasse 12/24/2012 18:52'!
layoutFrame: newFrame

	layoutFrame := newFrame asLayoutFrame! !

!SpecLayoutAdd methodsFor: 'protocol' stamp: 'StephaneDucasse 12/24/2012 17:25'!
topFraction: aNumber

	layoutFrame topFraction: aNumber! !

!SpecLayoutAdd methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/18/2012 04:31'!
subwidget: anObject
	subwidget := anObject! !

!SpecLayoutAdd methodsFor: 'protocol' stamp: 'StephaneDucasse 12/24/2012 17:24'!
rightFraction

	^ layoutFrame rightFraction! !

!SpecLayoutAdd methodsFor: 'protocol' stamp: 'StephaneDucasse 12/24/2012 17:23'!
leftFraction: aNumber

	layoutFrame leftFraction: aNumber
! !

!SpecLayoutAdd methodsFor: 'protocol' stamp: 'StephaneDucasse 12/24/2012 17:25'!
topOffset

	^ layoutFrame topOffset! !

!SpecLayoutAdd methodsFor: 'protocol' stamp: 'StephaneDucasse 12/24/2012 17:23'!
leftFraction

	^ layoutFrame leftFraction ! !

!SpecLayoutAdd methodsFor: 'protocol' stamp: 'StephaneDucasse 12/24/2012 17:24'!
rightFraction: aNumber

	^ layoutFrame rightFraction: aNumber! !

!SpecLayoutAdd class methodsFor: 'instance creation' stamp: 'StephaneDucasse 12/24/2012 17:17'!
subwidget: subwidget layoutFrame: aLayoutFrame

	^ self new
		subwidget: subwidget 
		layoutFrame: aLayoutFrame asLayoutFrame; 
		yourself! !

!SpecLayoutAddColumn commentStamp: '<historical>'!
A SpecLayoutAddColumn is an action representing the addition of a column to a layout!
!SpecLayoutAddColumn methodsFor: 'instance creation' stamp: 'StephaneDucasse 12/27/2012 17:51'!
block: aBlock layoutFrame: aLayoutFrame

	| row |
	row := SpecColumnLayout composed.
	aBlock value: row.
	subwidget := row asArray.
	self layoutFrame: aLayoutFrame.
	self generateArguments! !

!SpecLayoutAddColumn class methodsFor: 'instance creation' stamp: 'StephaneDucasse 12/27/2012 17:51'!
block: aBlock layoutFrame: aLayoutFrame

	^ self new
			block: aBlock 
			layoutFrame: aLayoutFrame;
			yourself! !

!SpecLayoutAddRow commentStamp: '<historical>'!
A SpecLayoutAddRow is an action representing the addition of a row to a layout
!
!SpecLayoutAddRow methodsFor: 'instance creation' stamp: 'StephaneDucasse 12/27/2012 17:48'!
block: aBlock layoutFrame: aLayoutFrame

	| row |
	row := SpecRowLayout composed.
	aBlock value: row.
	subwidget := row asArray.
	self layoutFrame: aLayoutFrame.
	self generateArguments! !

!SpecLayoutAddRow class methodsFor: 'instance creation' stamp: 'StephaneDucasse 12/27/2012 17:48'!
block: aBlock layoutFrame: aLayoutFrame

	^ self new
			block: aBlock 
			layoutFrame: aLayoutFrame;
			yourself! !

!SpecLayoutAddWithSpec commentStamp: '<historical>'!
A SpecLayoutAddWithSpec is an action representing an add in the spec layout with a spec selector precised!
!SpecLayoutAddWithSpec methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 3/19/2013 13:42'!
subwidget: sub spec: aSpecSelector layoutFrame: aFrameLayout

	self subwidget: (sub isArray 
						ifTrue: [ #(model), sub , {#retrieveSpec:. aSpecSelector} ]
						ifFalse: [ {#model. sub . #retrieveSpec: . aSpecSelector } ]).
						
	self layoutFrame: aFrameLayout.
	self generateArguments! !

!SpecLayoutAddWithSpec class methodsFor: 'instance creation' stamp: 'StephaneDucasse 12/27/2012 18:36'!
subwidget: subwidget spec: aSpecSelector layoutFrame: aLayoutFrame

	^ self new
		subwidget: subwidget 
		spec: aSpecSelector 
		layoutFrame:  aLayoutFrame;
		yourself! !

!SpecLayoutFrame commentStamp: '<historical>'!
I am a wrapper for the layout of widget.

Each framework can then adapt me as it wants in its adapters!
!SpecLayoutFrame methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/29/2013 15:12'!
bottomOffset
	
	^ bottomOffset! !

!SpecLayoutFrame methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/29/2013 15:12'!
leftOffset: anObject
	
	leftOffset := anObject! !

!SpecLayoutFrame methodsFor: '*Spec-MorphicAdapters' stamp: 'BenjaminVanRyseghem 9/29/2013 15:22'!
asMorphicLayout
	
	^ LayoutFrame identity
		topFraction: self topFraction;
		topOffset: self topOffset;
		bottomFraction: self bottomFraction;
		bottomOffset: self bottomOffset;
		rightFraction: self rightFraction;
		rightOffset: self rightOffset;
		leftFraction: self leftFraction;
		leftOffset: self leftOffset;
		yourself! !

!SpecLayoutFrame methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/29/2013 15:13'!
bottomFraction
	
	^ bottomFraction! !

!SpecLayoutFrame methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/29/2013 15:12'!
rightOffset
	
	^ rightOffset! !

!SpecLayoutFrame methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/29/2013 15:12'!
topFraction
	
	^ topFraction! !

!SpecLayoutFrame methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/29/2013 15:12'!
topFraction: anObject
	
	topFraction := anObject! !

!SpecLayoutFrame methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/29/2013 15:12'!
bottomOffset: anObject
	
	bottomOffset := anObject! !

!SpecLayoutFrame methodsFor: 'initialize' stamp: 'BenjaminVanRyseghem 9/29/2013 15:21'!
initialize

	super initialize.

	bottomFraction := 1.
	bottomOffset := 0.
	leftFraction := 0.
	leftOffset := 0.
	rightFraction := 1.
	rightOffset := 0.
	topFraction := 0.
	topOffset := 0.! !

!SpecLayoutFrame methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/29/2013 15:12'!
rightFraction
	
	^ rightFraction! !

!SpecLayoutFrame methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/29/2013 15:12'!
leftFraction: anObject
	
	leftFraction := anObject! !

!SpecLayoutFrame methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/29/2013 15:12'!
rightOffset: anObject
	
	rightOffset := anObject! !

!SpecLayoutFrame methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/29/2013 15:12'!
topOffset
	
	^ topOffset! !

!SpecLayoutFrame methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/29/2013 15:12'!
topOffset: anObject
	
	topOffset := anObject! !

!SpecLayoutFrame methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/29/2013 15:13'!
bottomFraction: anObject
	
	bottomFraction := anObject! !

!SpecLayoutFrame methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/29/2013 15:12'!
leftFraction
	
	^ leftFraction! !

!SpecLayoutFrame methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/29/2013 15:12'!
leftOffset
	
	^ leftOffset! !

!SpecLayoutFrame methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/29/2013 15:12'!
rightFraction: anObject
	
	rightFraction := anObject! !

!SpecLayoutSend commentStamp: '<historical>'!
A SpecLayoutSend is a spec layout action used when a selector is sent to the layout!
!SpecLayoutSend methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/18/2012 04:49'!
selector
	
	^ selector! !

!SpecLayoutSend methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/18/2012 05:07'!
asSpecElements

	^ {self selector.}, self arguments! !

!SpecLayoutSend methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/31/2012 14:09'!
bottomOffset

	^ 0! !

!SpecLayoutSend methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/31/2012 14:10'!
leftOffset: aNumber

	^ 0! !

!SpecLayoutSend methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/31/2012 14:09'!
bottomFraction

	^ 0! !

!SpecLayoutSend methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/31/2012 14:09'!
rightOffset

	^ 0! !

!SpecLayoutSend methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/18/2012 04:49'!
arguments: anObject
	
	arguments := anObject! !

!SpecLayoutSend methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/18/2012 04:49'!
selector: anObject
	
	selector := anObject! !

!SpecLayoutSend methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/31/2012 14:09'!
topFraction

	^ 0! !

!SpecLayoutSend methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 7/31/2012 15:52'!
isSplitter

	^ false! !

!SpecLayoutSend methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/31/2012 14:10'!
bottomOffset: aNumber

	^ 0! !

!SpecLayoutSend methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/31/2012 14:09'!
topFraction: aNumber

	^ 0! !

!SpecLayoutSend methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/31/2012 14:09'!
rightFraction

	^ 0! !

!SpecLayoutSend methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/31/2012 14:10'!
leftFraction: aNumber

	^ 0! !

!SpecLayoutSend methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/31/2012 14:09'!
rightOffset: aNumber

	^ 0! !

!SpecLayoutSend methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/31/2012 14:09'!
topOffset

	^ 0! !

!SpecLayoutSend methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/31/2012 14:10'!
topOffset: aNumber

	^ 0! !

!SpecLayoutSend methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/18/2012 04:49'!
arguments
	
	^ arguments! !

!SpecLayoutSend methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/31/2012 14:10'!
bottomFraction: aNumber

	^ 0! !

!SpecLayoutSend methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/31/2012 14:09'!
leftFraction

	^ 0! !

!SpecLayoutSend methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/31/2012 14:09'!
leftOffset

	^ 0! !

!SpecLayoutSend methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/31/2012 14:10'!
rightFraction: aNumber

	^ 0! !

!SpecLayoutSend class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 6/18/2012 04:49'!
selector: selector arguments: arguments

	^ self new
		arguments: arguments;
		selector: selector;
		yourself! !

!SpecLayouts commentStamp: 'IgnacioSniechowski 2/25/2015 08:33'!
A SpecExamples is the third sub-book of SpecHelpTopics. Here you will find more complex ways of laying out Spec.
See class side for selectors.
!
!SpecLayouts class methodsFor: 'pages' stamp: 'IgnacioSniechowski 2/16/2015 19:30'!
intro
	^HelpTopic 
		title: 'Layouts'
		contents: 'As layouts can become quite complex, this section provides a list of examples of the construction of layouts.  All the methods for adding sub widgets can be found in the ''commands'' and ''commands-advanced'' protocols of the SpecLayout class. You can explore them by doing:
			SpecLayout browse
		
		
Often the layout of user interfaces can be described in rows and columns, and Spec provides for an easy way to specify such layouts.'! !

!SpecLayouts class methodsFor: 'pages' stamp: 'IgnacioSniechowski 2/16/2015 19:32'!
rows
	^HelpTopic 
		title: 'Layouts in rows'
		contents: 'If you want to arrange your widgets in a row, that''s simple:
		
		
	^ SpecLayout composed
			newRow: [ :row |
				row
					add: #theList;
					add: #theButton
			];
			yourself'! !

!SpecLayouts class methodsFor: 'pages' stamp: 'IgnacioSniechowski 2/16/2015 19:40'!
columnsAndRows
	^HelpTopic 
		title: 'Combining Columns and Rows'
		contents: 'Rows and columns can be combined to build more complex layouts, and splitters between cells can be added. The example 1.24 shows how to create a 3 columns layout, containing three buttons in each column. This example also shows the addSplitter message, which adds a splitter between the element added before it and the element added after.


	^ SpecLayout composed
			newRow: [ :row |
				row
					newColumn: [ :column |
						column
							add: #button1;
							add: #button2;
							add: #button3
					];
					addSplitter;
					newColumn: [ :column |
						column
							add: #button4;
							add: #button5;
							add: #button6
					];
					addSplitter;
					newColumn: [ :column |
						column
							add: #button7;
							add: #button8;
							add: #button9
					];
			];
			yourself

The height of rows as well as the width of columns can be specified, to prevent them to take all the available space.  Here is an example of a row with a height of 30.

		^ SpecLayout composed
				newRow: [ :row |
					row
						add: #theList;
						add: #theButton
				] height: 30;
				yourself
				
				
And the same but for a column:

		^ SpecLayout composed
				newColumn: [ :column |
					column
						add: #theList;
						add: #theButton
				] width: 30;
			    yourself
			
			
Note that it is generally considered a bad habit to hardcode the size of the widgets. Methods are available on ComposableModel providing sensible default sizes, like the width of a button. When specifying custom widget sizes, care should be taken to take in account the current font size.'
			
		
! !

!SpecLayouts class methodsFor: 'accessing' stamp: 'IgnacioSniechowski 2/16/2015 19:20'!
bookName
	^'Spec Layouts'! !

!SpecLayouts class methodsFor: 'accessing' stamp: 'IgnacioSniechowski 2/16/2015 19:36'!
pages
	^#(intro columns rows columnsAndRows)! !

!SpecLayouts class methodsFor: 'pages' stamp: 'IgnacioSniechowski 2/16/2015 19:29'!
columns
	^HelpTopic 
		title: 'Layouts in columns'
		contents: 'Having the widgets rendered as a column is easy:

	^ SpecLayout composed
			newColumn: [ :column |
				column
					add: #theList;
					add: #theButton
			];
			yourself'! !

!SpecPragmaCollector commentStamp: '<historical>'!
A SpecPragmaCollector is a specialized PragmaCollector.

Sonce we just want specs defined on class side, we do not have to check the whole system, then to restrain.!
!SpecPragmaCollector methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/20/2012 19:09'!
behavior
	^ behavior! !

!SpecPragmaCollector methodsFor: 'initializing' stamp: 'BenjaminVanRyseghem 6/20/2012 19:10'!
reset
	"reinitialize current system settings"
	self
		noMoreAnnounceWhile: [self collected copy
				do: [:pragma | self removePragma: pragma].
			self allPragmas
				do: [:pragma | self addPragma: pragma]].
	self announce: (PragmaCollectorReset collector: self)! !

!SpecPragmaCollector methodsFor: 'private' stamp: 'BenjaminVanRyseghem 6/20/2012 19:10'!
allPragmasIn: aClass

	^ (Array
		streamContents: [:stream | Pragma
									withPragmasIn: aClass
									do: [:pragma | stream nextPut: pragma ]]) ! !

!SpecPragmaCollector methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/20/2012 19:09'!
behavior: anObject
	behavior := anObject! !

!SpecPragmaCollector methodsFor: 'system changes' stamp: 'EstebanLorenzano 9/27/2013 12:15'!
installSystemNotifications
	"We do not need to register anything for spec, and if we do it will make it really slow"! !

!SpecPragmaCollector methodsFor: 'private' stamp: 'BenjaminVanRyseghem 6/20/2012 19:10'!
allPragmas

	^ self allPragmasIn: (self behavior ifNil: [ ^ #() ])! !

!SpecPragmaCollector class methodsFor: 'instance creation' stamp: 'MarcusDenker 6/24/2013 11:16'!
behavior: aBehavior

	^ self new
		behavior: aBehavior;
		yourself! !

!SpecPreDebugWindow commentStamp: '<historical>'!
I am the window that shows up when the debugger is launched.  
I show you the first lines of the stack trace that caused my apparition (or a text editor with a message), and a set of buttons created by loading all debugging actions annotated with the pragmas 'self preDebuggingActionsPragmas' (e.g. resume the execution, abandon the execution).

To see me, evaluate:
2/0.

Some details about my implementation.

- I hold a reference to the debugger than created my;
- changing the debuger retriggers the construction of this window;
- before doing this users should set the attribute 'message' as my structure depens on it;
- changing the debugger should be done only after this window was open. E.g.:

SpecPreDebugWindow new 
		setTitle: aTitle;
		message: aMessage;
		openWithSpec;
		debugger: aDebugger.
		
- an example of manually opening this window:

[ | context process  debugger |

context := [ 20 factorial ] asContext.

process := Process 
	forContext: context
	priority: Processor userInterruptPriority.

debugger := SpecDebugger new
	process: process 
	controller:  nil
	context: context.
	
SpecPreDebugWindow new 
		setTitle: 'A simulated error';
		message: nil;
		openWithSpec;
		debugger: debugger
 ] fork.!
!SpecPreDebugWindow methodsFor: 'actions' stamp: 'AndreiChis 9/24/2013 17:40'!
close
	
	self window delete! !

!SpecPreDebugWindow methodsFor: 'building widgets' stamp: 'AndreiChis 9/24/2013 19:22'!
setFocusOrderForActions: aCollection

	self focusOrder removeAll.
	aCollection do: [ :action | 
		self focusOrder add: (self perform: action specId) ].	
	self focusOrder add: (self perform: self notifierPaneWidgetId)! !

!SpecPreDebugWindow methodsFor: 'building widgets' stamp: 'AndreiChis 9/25/2013 17:03'!
buildButtonWidgetsSpecForActions: aCollection

	^ aCollection
		inject: OrderedCollection new
		into: [ :specs :action |
			specs 
				add: action specId;
			 	add: action specModel;
				yourself ]
	! !

!SpecPreDebugWindow methodsFor: 'building widgets' stamp: 'AndreiChis 9/25/2013 17:41'!
notifierPaneWidgetId
	"Return the id of the notifier widget. Assume there is just one widget that is not a button,
	which represents the notifier."
	
	self buildNotifierPaneWidgetsSpec pairsDo: [ :key :value |
		(self widgets keys includes: key) ifTrue: [ ^ key ] ].
	^ nil! !

!SpecPreDebugWindow methodsFor: 'actions' stamp: 'StephaneDucasse 4/3/2014 21:33'!
openFullDebugger
	| currentDebugger |
	
	currentDebugger := self debugger.
	self debugger: nil.
	self close.
	currentDebugger 
		openWithSpec;
		updateToolbar;
		updateCodeFromContext;
		label: title! !

!SpecPreDebugWindow methodsFor: 'initialization' stamp: 'DucasseStephane 9/10/2014 09:59'!
initialize

	debugger := nil asValueHolder.
	super initialize.
	
	self whenWindowChanged: [:w | w whenClosedDo: [ self clear ] ].
	self bindKeyCombination: Character escape asKeyCombination toAction: [ self delete ]! !

!SpecPreDebugWindow methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
debugger: anOnject

	debugger value: anOnject! !

!SpecPreDebugWindow methodsFor: 'building widgets' stamp: 'AndreiChis 9/24/2013 18:38'!
createNotifierPaneWidgets

	self instantiateModels: self buildNotifierPaneWidgetsSpec.
	self widgets keysDo: [ :key | 
		(self perform: ('initialize', key asString capitalized) asSymbol) ]! !

!SpecPreDebugWindow methodsFor: 'api' stamp: 'AndreiChis 7/13/2013 18:47'!
title

	^ title ! !

!SpecPreDebugWindow methodsFor: 'initialization' stamp: 'AndreiChis 7/14/2013 15:44'!
initializePresenter

	super initializePresenter.
	
	debugger whenChangedDo: [ :aDebugger |
		aDebugger 
			ifNil: [ self clearWidget ] 
			ifNotNil:  [ self rebuildWidget ]	 ]
! !

!SpecPreDebugWindow methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
debugger

	^ debugger value! !

!SpecPreDebugWindow methodsFor: 'initialization widgets' stamp: 'AndreiChis 9/30/2013 17:24'!
initializeStackPane
	
	self stackPane
		displayBlock: [ :aContext | self columnsFor: aContext ];
		items: (self debugger stack filteredStackOfSize: self debugger stack class defaultStackSize) ;
		whenSelectedItemChanged: [ :aContext | 
			"Set the selection before, as debugAction removes the link with the debugger. "
			self debugger stack setSelectedItem: aContext.
			self openFullDebugger ]
		! !

!SpecPreDebugWindow methodsFor: 'accessing' stamp: 'AndreiChis 7/13/2013 19:02'!
message

	^ message! !

!SpecPreDebugWindow methodsFor: 'initialization widgets' stamp: 'AndreiChis 7/13/2013 22:44'!
initializeCodePane
		
	self codePane
		text: self message
		! !

!SpecPreDebugWindow methodsFor: 'api' stamp: 'DamienPollet 7/24/2013 15:05'!
initialExtent

	^ 700 @ 156! !

!SpecPreDebugWindow methodsFor: 'api' stamp: 'AndreiChis 7/13/2013 19:32'!
setTitle: aString

	title := aString.
	self updateTitle ! !

!SpecPreDebugWindow methodsFor: 'actions' stamp: 'AndreiChis 9/24/2013 17:37'!
clear

	self debugger ifNotNil: [ :aDebugger | aDebugger clear ]! !

!SpecPreDebugWindow methodsFor: 'accessing' stamp: 'AndreiChis 9/25/2013 17:41'!
message: aString
	"Set a message in the pre debug window. 
	If this is nil the notifier pane will display a text editor showing the message (Warning signal: 'Display this text'),
	otherwise the stack will be displayed."
	
	message := aString! !

!SpecPreDebugWindow methodsFor: 'accessing' stamp: 'AndreiChis 7/14/2013 15:28'!
session

	^ self debugger session! !

!SpecPreDebugWindow methodsFor: 'actions lookup' stamp: 'AndreiChis 9/24/2013 18:33'!
actionsForPragmas: aSymbolsCollection

	^ (self session class debuggingActionsForPragmas: aSymbolsCollection for: self debugger)
				! !

!SpecPreDebugWindow methodsFor: 'initialization widgets' stamp: 'AndreiChis 9/25/2013 17:04'!
initializeButtonWidget: aButtonModel forAction: aDebuggingAction

	aButtonModel 
		debugAction: aDebuggingAction! !

!SpecPreDebugWindow methodsFor: 'building widgets' stamp: 'AndreiChis 9/24/2013 18:40'!
createWidgetsForActions: aCollection

	self createNotifierPaneWidgets.
	self createButtonWidgetsForActions: aCollection.

	self setFocusOrderForActions: aCollection! !

!SpecPreDebugWindow methodsFor: 'building widgets' stamp: 'AndreiChis 9/24/2013 19:21'!
createButtonWidgetsForActions: aCollection

	self instantiateModels: (self buildButtonWidgetsSpecForActions: aCollection).
	aCollection do: [ :action | 
		self initializeButtonWidget: (self widgets at: action specId) forAction: action ]! !

!SpecPreDebugWindow methodsFor: 'actions lookup' stamp: 'AndreiChis 9/25/2013 10:46'!
preDebuggingActions
	"Return a collection of debug actions constructed based on the pragmas 'self preDebuggingActionsPragmas'. 
	These actions should understand the message #preDebugWindow:"
	
	^ (self actionsForPragmas: self preDebuggingActionsPragmas) 
		do: [ :each | 
			each preDebugWindow: self ]! !

!SpecPreDebugWindow methodsFor: 'building widgets' stamp: 'BenjaminVanRyseghem 11/28/2013 18:15'!
rebuildWidget
	| debuggingActions |
	
	debuggingActions := self preDebuggingActions.
	self widgets removeAll.
	self createWidgetsForActions: debuggingActions.
	 
	self needFullRebuild: true.
	self needRebuild: false.
	
 	self buildWithSpecLayout: (self dynamicLayoutForActions: debuggingActions).
	
	self takeKeyboardFocus. 
! !

!SpecPreDebugWindow methodsFor: 'building widgets' stamp: 'AndreiChis 9/25/2013 17:40'!
dynamicLayoutForActions: aCollection
	"Create a two column layout for the subwidgets."

	^ SpecLayout composed
		newColumn: [ :c | 
			c newRow: [ :row |
				aCollection do: [ :anAction | row add: anAction specId ] ] height: self class toolbarHeight.
	  		c newRow: [ :row | row add: self notifierPaneWidgetId] ]! !

!SpecPreDebugWindow methodsFor: 'building widgets' stamp: 'AndreiChis 7/14/2013 15:44'!
emptyLayout
	
	^ SpecLayout composed
! !

!SpecPreDebugWindow methodsFor: 'printing' stamp: 'AndreiChis 9/26/2013 18:54'!
columnsFor: anEntry
	
	^ self debugger stack columnsFor: anEntry! !

!SpecPreDebugWindow methodsFor: 'building widgets' stamp: 'AndreiChis 7/14/2013 15:44'!
clearWidget

	self widgets removeAll.
	
	self needFullRebuild: true.
	self needRebuild: false.
	
 	self buildWithSpecLayout: self emptyLayout	
! !

!SpecPreDebugWindow methodsFor: 'building widgets' stamp: 'AndreiChis 7/14/2013 19:58'!
buildNotifierPaneWidgetsSpec
	
	^ self message 
		ifNil: [ {#stackPane. #MultiColumnListModel} ] 
		ifNotNil: [ {#codePane. #TextModel} ]! !

!SpecPreDebugWindow methodsFor: 'actions lookup' stamp: 'AndreiChis 9/24/2013 18:33'!
preDebuggingActionsPragmas

	^ { #preDebuggingAction }! !

!SpecPreDebugWindow class methodsFor: 'specs' stamp: 'AndreiChis 7/13/2013 20:12'!
spec
	<spec: #default>
		^ SpecLayout composed
			yourself! !

!SpecPreDebugWindow class methodsFor: 'accessing' stamp: 'AndreiChis 7/14/2013 13:00'!
debuggerClass

	^ SpecDebugger! !

!SpecPreDebugWindow class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'AndreiChis 9/14/2013 11:03'!
taskbarIcon

	^ self debuggerClass taskbarIcon! !

!SpecRowLayout commentStamp: '<historical>'!
A SpecRowLayout isthe layout used to specify a new row!
!SpecRowLayout methodsFor: 'converting' stamp: 'BenjaminVanRyseghem 12/21/2013 21:47'!
privateAsArray

	self resetArrayComputation.
	self countNumberOfProportionals.
	
	autoFractionComputation
		ifTrue: [ self manualFractionComputation ]
		ifFalse: [ self autoFractionComputation ].
	
	self shiftLastWidgets.
	
	result addAll: super privateAsArray.
	^ result asArray! !

!SpecRowLayout methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/21/2013 21:46'!
manualFractionComputation
	| delta |
	
	numberOfProportionals isZero
		ifTrue: [ delta := 0 ]
		ifFalse: [ delta := 1 / numberOfProportionals ].
		
	self commands
		doWithIndex: [ :e :idx | 
			e layoutFrame hasNoOffsets
				ifTrue: [ self setWidgetLayoutWithNoOffset: e at: idx delta: delta ]
				ifFalse: [ self setWidgetLayoutWithOffset: e at: idx ] ]! !

!SpecRowLayout methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/21/2013 21:45'!
autoFractionComputation
	
	self commands
		doWithIndex: [ :e :idx | 
			e layoutFrame hasNoOffsets
				ifTrue: [ | delta |
					delta := e layoutFrame rightFraction - e layoutFrame leftFraction.
					self setWidgetLayoutWithNoOffset: e at: idx delta: delta ]
				ifFalse: [ self setWidgetLayoutWithOffset: e at: idx ] ]! !

!SpecRowLayout methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/21/2013 21:44'!
setWidgetLayoutWithNoOffset: widget at: index delta: delta

	widget layoutFrame: ((currentProportional @ 0 corner: (currentProportional + delta) @ 1) asLayoutFrame leftOffset: currentOffset).
	
	currentOffset := 0.
	currentProportional := currentProportional + delta.
	lastFractionIndex := index! !

!SpecRowLayout methodsFor: 'commands' stamp: 'BenjaminVanRyseghem 7/31/2012 16:09'!
addSplitter

	self commands add: (SpecSplitterVertical commands: self commands)! !

!SpecRowLayout methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/21/2013 21:47'!
setWidgetLayoutWithOffset: e at: idx
	| y0 y1 |
	
	width := e offsets width.
	y0 := e offsets top.
	y1 := e offsets bottom.
	
	idx = size
		ifTrue: [ 
			e layoutFrame:
				((1 @ 0 corner: 1 @ 1) asLayoutFrame
					topLeftOffset: width negated @ y0;
					bottomRightOffset: 0 @ y1) ]
		ifFalse: [ 
			e layoutFrame:
				((currentProportional @ 0 corner: currentProportional @ 1) asLayoutFrame
					topLeftOffset: currentOffset @ y0;
					bottomRightOffset: (currentOffset + width) @ y1).
			currentOffset := currentOffset + width ]! !

!SpecRowLayout methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/21/2013 21:42'!
countNumberOfProportionals

	self commands do: [ :e | 
		e layoutFrame hasNoOffsets
			ifTrue: [ 
				(e layoutFrame leftFraction == 0 and: [ e layoutFrame rightFraction == 1 ])
					ifFalse: [ autoFractionComputation := false ].
				numberOfProportionals := numberOfProportionals + 1 ] ]! !

!SpecRowLayout methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/21/2013 21:52'!
resetArrayComputation

	super resetArrayComputation.
	
	currentOffset := 0.
	currentProportional := 0.
	numberOfProportionals := 0.
	lastFractionIndex := 0.
	autoFractionComputation := true.
	size := self commands size! !

!SpecRowLayout methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/21/2013 21:49'!
shiftLastWidgets
	| index ante |
	
	(lastFractionIndex > 0 and: [ lastFractionIndex < size ]) ifFalse: [ ^ self ].
	
	index := size - 1.
	[ index > lastFractionIndex ] whileTrue: [ | myWidth |
		ante := self commands at: index.
		index := index - 1.
		myWidth := ante rightOffset - ante leftOffset.
		ante
			leftOffset: (width + myWidth) negated;
			rightOffset: width negated.
		width := width + myWidth ].
	
	self assert: index = lastFractionIndex.
	
	ante := self commands at: index.
	ante layoutFrame rightOffset: width negated! !

!SpecRowLayout methodsFor: 'commands' stamp: 'BenjaminVanRyseghem 6/18/2012 06:33'!
add: aSpec width: aNumber
	
	self add: aSpec origin: 0@0 corner: 1@1 offsetOrigin: 0@0 offsetCorner: aNumber @0! !

!SpecSplitterHorizontal commentStamp: '<historical>'!
A SpecSplitterHorizontal is a description of the addition of a horizontal splitter!
!SpecSplitterHorizontal methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 7/31/2012 15:38'!
isSplitter

	^ true! !

!SpecSplitterHorizontal methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 23:07'!
initialize

	super initialize.

	selector := #newHSplitterAt:.
	layoutFrame  := (0@0 corner: 0@0) asLayoutFrame 
							bottomOffset: 1.
	commands := nil.! !

!SpecSplitterHorizontal methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/31/2012 15:11'!
commands: anObject
	
	commands := anObject! !

!SpecSplitterHorizontal methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/31/2012 17:11'!
generateArguments
	| index |

	index := self commands identityIndexOf: self.

	self arguments: { index }! !

!SpecSplitterHorizontal methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/31/2012 15:11'!
commands
	
	^ commands! !

!SpecSplitterHorizontal class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 7/31/2012 15:11'!
commands: commands

	^ self new
		commands: commands;
		yourself! !

!SpecSplitterVertical commentStamp: '<historical>'!
A SpecSplitterVertical is the description of the addition of a vertical splitter!
!SpecSplitterVertical methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 7/31/2012 16:05'!
isSplitter

	^ true! !

!SpecSplitterVertical methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 23:07'!
initialize

	super initialize.

	selector := #newVSplitterAt:.
	layoutFrame := ((0@0 corner: 0@0) asLayoutFrame 
							rightOffset: 1).
	commands := nil.! !

!SpecSplitterVertical methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/31/2012 16:05'!
commands: anObject
	
	commands := anObject! !

!SpecSplitterVertical methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 7/31/2012 16:05'!
generateArguments
	| index |

	index := self commands identityIndexOf: self.

	self arguments: { index }! !

!SpecSplitterVertical methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/31/2012 16:05'!
commands
	
	^ commands! !

!SpecSplitterVertical class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 7/31/2012 16:05'!
commands: commands

	^ self new
		commands: commands;
		yourself! !

!SpecTreeColumn commentStamp: '<historical>'!
I am a Tree column made especially to be used by the Spec framework!
!SpecTreeColumn methodsFor: 'compatibility' stamp: 'BenjaminVanRyseghem 11/2/2013 19:03'!
bindKeyCombination: aKMCombination toAction: aBlock

	"Do nothing"
	! !

!SpecTreeColumn methodsFor: 'column drawing' stamp: 'BenjaminVanRyseghem 11/2/2013 19:05'!
rowMorphFor: aNode 
	| node rowMorph |
	
	node := aNode nodeModel.
	rowMorph := self rowMorphGetSelector
		ifNil: [node rowMorphForColumn: self]
		ifNotNil: [self rowMorphGetterBlock value: node value: self container].
	rowMorph := rowMorph asMorph.
	rowMorph
		ifNotNil: [rowMorph borderWidth: 0]
		ifNil: [rowMorph := self defaultRowMorph].
	^ rowMorph rowMorphForNode: node inColumn: self
! !

!SpecTreeColumn methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/2/2013 19:34'!
setHeaderButtonLabel: aLabel font: aFont icon: anIconForm target: aReceiver actionSelector: aSelector

	(aLabel isNil and: [ anIconForm isNil and: [ aReceiver isNil or: [ aSelector isNil ]]]) ifTrue: [ ^ self ].
	
	self headerButton.
	
	aLabel 
		ifNil: [ self header label: '' font: nil ]
		ifNotNil: [ self header label: aLabel font: aFont ].
	anIconForm ifNotNil: [ self header icon: (ImageMorph new form: anIconForm) ].
	(aSelector notNil and: [ aReceiver notNil ]) ifTrue: [
		self header actionSelector: aSelector.
		self header target: aReceiver ]! !

!SpecTreeModel commentStamp: '<historical>'!
I am tree model used by the Spec infrastructure to provide a "pluggable" api since we do not have multiple inheritance in Pharo!
!SpecTreeModel methodsFor: 'drag and drop - private' stamp: 'BenjaminVanRyseghem 7/16/2013 11:07'!
acceptDroppingMorph: draggedMorph event: event inMorph: source

	^ self model acceptDroppingMorph: draggedMorph event: event inMorph: source! !

!SpecTreeModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 4/18/2013 18:01'!
resetRootNodes

	rootNodes := nil! !

!SpecTreeModel methodsFor: 'drag and drop - private' stamp: 'BenjaminVanRyseghem 7/16/2013 11:07'!
wantsDroppedMorph: draggedMorph event: anEvent inMorph: source

	^ self model wantsDroppedMorph: draggedMorph event: anEvent inMorph: source! !

!SpecTreeModel methodsFor: 'drag and drop - private' stamp: 'BenjaminVanRyseghem 7/16/2013 11:07'!
dragPassengersFor: item inMorph: dragSource
	
	^ self model dragPassengersFor: item inMorph: dragSource! !

!SpecTreeModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/18/2013 18:01'!
rootNodes

	^ rootNodes ifNil: [ rootNodes := super rootNodes ]! !

!SpecTreeModel methodsFor: 'drag and drop - private' stamp: 'BenjaminVanRyseghem 7/16/2013 11:07'!
transferFor: passenger from:  source

	^ self model transferFor: passenger from: source! !

!SpecTreeModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/17/2013 19:32'!
rootNodeFromItem: item

	^ self model rootNodeFromItem: item! !

!SpecTreeModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/17/2013 18:48'!
model
	^ model! !

!SpecTreeModel methodsFor: 'drag and drop - private' stamp: 'BenjaminVanRyseghem 7/16/2013 11:07'!
dragPassengerFor: item inMorph: dragSource 
	
	^ self model dragPassengerFor: item inMorph: dragSource! !

!SpecTreeModel methodsFor: 'overrided' stamp: 'BenjaminVanRyseghem 4/20/2013 16:04'!
doubleClick

	self model doubleClick! !

!SpecTreeModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/17/2013 18:48'!
model: anObject
	model := anObject! !

!SpecTreeModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/17/2013 20:48'!
rootItems

	^ self model roots! !

!SpecTreeModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/7/2013 14:20'!
menu: menu shifted: b

	^ self model menu: menu shifted: b! !

!SpecTreeModel class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 4/17/2013 18:49'!
model: model

	^ self new
		model: model;
		yourself! !

!SpecTreeNodeModel commentStamp: '<historical>'!
I am a Tree node especially made for being used by the Spec framework.!
!SpecTreeNodeModel methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/22/2013 15:44'!
hasContentToShow

	^ self nodeModel hasContentToShow! !

!SpecTreeNodeModel methodsFor: 'compatibility' stamp: 'BenjaminVanRyseghem 11/2/2013 18:58'!
bindKeyCombination: aShortcut toAction: aBlock
	"Do nothing"! !

!SpecTreeNodeModel methodsFor: 'building' stamp: 'BenjaminVanRyseghem 3/4/2014 17:25:06'!
hasContents
	hasContents isBlock
		ifTrue: [ ^ hasContents value ].
	^ self childrenItems notEmpty! !

!SpecTreeNodeModel methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/22/2013 12:58'!
selected: aBoolean

	self nodeModel selected: aBoolean! !

!SpecTreeNodeModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/2/2013 19:05'!
nodeModel: anObject
	nodeModel := anObject! !

!SpecTreeNodeModel methodsFor: 'building' stamp: 'BenjaminVanRyseghem 11/22/2013 12:40'!
childNodeFromItem: anItem

	^ (anItem
		container: self model;
		buildWithSpec)
		parentNode: self;
		yourself! !

!SpecTreeNodeModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/2/2013 19:05'!
nodeModel
	^ nodeModel! !

!SpecTreeNodeModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/4/2014 17:25:06'!
setChildren: aBlock
	"Store a aBlock which will return the children when evaluated."
	
	self childrenItems: aBlock! !

!SpecTreeNodeModel methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/24/2013 13:39'!
isExpanded: aBoolean

	self nodeModel isExpanded: aBoolean! !

!SpecTreeNodeModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/2/2013 18:45'!
icon: anIcon

	icon := anIcon! !

!SpecTreeNodeModel methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/22/2013 12:55'!
selected

	^ self nodeModel selected! !

!SpecTreeNodeModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/4/2014 17:25:06'!
childrenItems
	childrenItems isBlock 
		ifTrue: [ childrenItems := childrenItems value ].
	^ childrenItems! !

!SpecTreeNodeModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/8/2013 18:15'!
helpText

	^ nodeModel help! !

!SpecTreeNodeModel methodsFor: 'events' stamp: 'BenjaminVanRyseghem 11/21/2013 23:00'!
mouseDown: event

	self nodeModel mouseDownAction cull: event! !

!SpecTreeNodeModel methodsFor: 'building' stamp: 'BenjaminVanRyseghem 3/4/2014 17:25:06'!
hasContents: aBlock

	hasContents := aBlock! !

!SpecTreeNodeModel methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 12/4/2013 14:29'!
lastClicked: aBoolean

	self nodeModel lastClicked: aBoolean.
	aBoolean
		ifTrue: [ self model highlightedItem: self nodeModel ]
		ifFalse: [ self model highlightedItem: nil ].! !

!SpecTreeNodeModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/2/2013 18:46'!
childrenItems: aCollection

	childrenItems := aCollection! !

!SpecTreeNodeModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/4/2014 17:25:06'!
contents
	^ contents ifNil: [ 
		contents := self childrenItems collect: [:ci | 
			self childNodeFromItem: ci ] ]! !

!SpecTreeNodeModel methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 11/24/2013 13:35'!
isExpanded

	^ self nodeModel isExpanded! !

!SpecTreeNodeModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/2/2013 18:44'!
icon

	^ icon! !

!SpecWindow commentStamp: '<historical>'!
I am a window used by WindowSpec.

I have been introduced since it's currently the best solution to prevent to add dozen of respondsTo: in StandardWindow or add dirty extensions to Object (because all models are not subclasses of Model)!
!SpecWindow methodsFor: 'controls' stamp: 'BenjaminVanRyseghem 5/19/2013 13:21'!
close

	self model askOkToClose
		ifTrue: [ self okToChange ifFalse: [ ^ self ] ].
		
	super close! !

!SpecWindow methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/14/2013 17:27'!
aboutText

	^ self model aboutText! !

!SpecWindow methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 5/19/2013 13:21'!
okToChange

	^ self model okToChange! !

!SpecWrapper commentStamp: '<historical>'!
I am a small wrapper used to encapsulate data created and used during spec interpretation!
!SpecWrapper methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/29/2013 14:22'!
selector: anObject
	
	selector := anObject! !

!SpecWrapper methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/29/2013 14:25'!
selector
	
	^ selector! !

!SpecWrapper methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/29/2013 14:25'!
instance
	
	^ instance! !

!SpecWrapper methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/29/2013 14:22'!
instance: anObject
	
	instance := anObject! !

!SpecWrapper methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/1/2013 13:33'!
removeSubWidgets
	
	^ self instance removeSubWidgets! !

!SpecWrapper methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 10/1/2013 13:33'!
isRedrawable
	
	^ self instance isRedrawable! !

!SpecWrapper class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 9/29/2013 14:22'!
instance: instance selector: selector

	^ self new
		instance: instance;
		selector: selector;
		yourself! !

!SplitJoinTest commentStamp: 'onierstrasz 4/12/2009 20:33'!
"Evaluate me to view the SplitJoin documentation:"

self showDocumentation

"CHANGES LOG:
- merged implementations by Keith Hodges (Join) and Damiena Pollet
  and Oscar Nierstrasz (RubyShards) into SplitJoin package
- moved all extension methods to *splitjoin method category
- merged all tests into SplitJoinTest
- fixed protocol in SequenceableCollection to splitOn: and joinUsing:
  and split: join: for splitters and joiners
- added Object>>joinTo: aStream and SequenceableCollection>>joinTo: aStream
  to support joining of either sequences or sequences of sequences
- prepared some documentation
- added systematic tests for all split/join cases
- added Object>>join:
- prepared split/join tests for all 16 cases
- prepares split+join tests for 4 standard cases
- reviewed/merged old tests
- changed splitjoin tests to use different joiner
- added separate test for split+join=id cases
- adapted documentation -- join result type is type of joiner or array or string
- fix split tests to check result asOrderedCollection
- added split tests for OrderedCollection and SortedCollection
- new join: method for OrderedCollection and SortedCollection
  (uses appendTo: in Object and SequenceableCollection)
- reviewed all split: implementations -- removed unnecessary helper methods
- check boundary conditions -- split on empty sequence ...
"!
!SplitJoinTest methodsFor: 'running' stamp: 'onierstrasz 4/12/2009 18:52'!
testSplitStringOnBlock
	self assert: ('foobar' splitOn: [:ch | 'aeiou' includes: ch])
		equals: #('f' '' 'b' 'r') asOrderedCollection! !

!SplitJoinTest methodsFor: 'running' stamp: 'onierstrasz 4/12/2009 20:07'!
testSplitJoinIdentity
	| array string |
	array := #(5 1 4 1 3 1 2 1).
	string := 'how now brown cow'.
	self assert: (1 join: (1 split: array)) equals: array.
	self assert: (#(1 3) join: (#(1 3) split: array)) equals: array.
	self assert: ($o join: ($o split: string)) equals: string.
	self assert: ('ow' join: ('ow' split: string)) equals: string.! !

!SplitJoinTest methodsFor: 'running' stamp: 'onierstrasz 4/12/2009 19:26'!
testSplitOrderedCollectionOnOrderedCollection
	self assert: (((1 to: 10) asOrderedCollection) splitOn: ((4 to: 5) asOrderedCollection))
		equals: {(1 to: 3) asOrderedCollection . (6 to: 10) asOrderedCollection} asOrderedCollection.
! !

!SplitJoinTest methodsFor: 'running' stamp: 'onierstrasz 4/12/2009 19:26'!
testSplitOrderedCollectionOnElement
	self assert: (((1 to: 10) asOrderedCollection) splitOn: 4)
		equals: {(1 to: 3) asOrderedCollection . (5 to: 10) asOrderedCollection} asOrderedCollection.
! !

!SplitJoinTest methodsFor: 'running' stamp: 'onierstrasz 4/12/2009 19:24'!
testSplitArrayOnBlock
	self assert: ((1 to: 10) asArray splitOn: [:n| n even])
		equals: #(#(1) #(3) #(5) #(7) #(9) #()) asOrderedCollection! !

!SplitJoinTest methodsFor: 'running' stamp: 'onierstrasz 4/12/2009 19:23'!
testJoinArrayUsingOrderedCollection
	self assert: ((1 to: 4) joinUsing: #(8 9) asOrderedCollection)
		equals: #(1 8 9 2 8 9 3 8 9 4) asOrderedCollection! !

!SplitJoinTest methodsFor: 'running' stamp: 'onierstrasz 4/12/2009 18:53'!
testSplitStringOnSubstring
	self assert: ('the banana man can can bananas' splitOn: 'an')
		equals: #('the b' '' 'a m' ' c' ' c' ' b' '' 'as') asOrderedCollection! !

!SplitJoinTest methodsFor: 'running' stamp: 'onierstrasz 4/12/2009 19:25'!
testSplitArrayOnSequence
	self assert: ((1 to: 10) asArray splitOn: (4 to: 5))
		equals: #(#(1 2 3) #(6 7 8 9 10)) asOrderedCollection
! !

!SplitJoinTest methodsFor: 'running' stamp: 'onierstrasz 4/12/2009 19:24'!
testSplitArrayOnElement
	self assert: ((1 to: 10) asArray splitOn: 4)
		equals: #(#(1 2 3) #(5 6 7 8 9 10)) asOrderedCollection
! !

!SplitJoinTest methodsFor: 'running' stamp: 'onierstrasz 4/12/2009 18:53'!
testSplitStringOnChar
	self assert: ('does eat oats and lambs eat oats' splitOn: Character space)
		equals: #('does' 'eat' 'oats' 'and' 'lambs' 'eat' 'oats') asOrderedCollection! !

!SplitJoinTest methodsFor: 'running' stamp: 'onierstrasz 4/12/2009 19:46'!
testJoinArrayUsingSortedCollection
	self assert: ((1 to: 4) joinUsing: #(8 9) asSortedCollection)
		equals: #(1 8 9 2 8 9 3 8 9 4) asSortedCollection! !

!SplitJoinTest methodsFor: 'running' stamp: 'onierstrasz 4/11/2009 10:36'!
testSplitJoinStringOnString
	self assert: ('oo' join: ('ow' split: 'how now brown cow?'))
		equals: 'hoo noo broon coo?'! !

!SplitJoinTest methodsFor: 'running' stamp: 'onierstrasz 4/12/2009 19:26'!
testSplitSortedCollectionOnSortedCollection
	self assert: (((1 to: 10) asSortedCollection) splitOn: ((4 to: 5) asSortedCollection))
		equals: {(1 to: 3) asSortedCollection . (6 to: 10) asSortedCollection} asOrderedCollection.

! !

!SplitJoinTest methodsFor: 'testing' stamp: 'onierstrasz 4/10/2009 21:09'!
assert: result equals: expected 
	result = expected
		ifFalse: [self signalFailure: 'Assertion failed: (' , result asString , ') ~= (' , expected asString , ')']! !

!SplitJoinTest methodsFor: 'running' stamp: 'onierstrasz 4/12/2009 19:22'!
testJoinArrayUsingArray
	self assert: ((1 to: 4) joinUsing: #(8 9))
		equals: #(1 8 9 2 8 9 3 8 9 4)! !

!SplitJoinTest methodsFor: 'running' stamp: 'onierstrasz 4/10/2009 23:14'!
testJoinArrayUsingString
	self assert: ((1 to: 4) joinUsing: '--')
		equals: '1--2--3--4'! !

!SplitJoinTest methodsFor: 'running' stamp: 'onierstrasz 4/11/2009 00:11'!
testJoinArrayUsingObject
	self assert: ((1 to: 4) joinUsing: 0)
		equals: #(1 0 2 0 3 0 4)! !

!SplitJoinTest methodsFor: 'running' stamp: 'onierstrasz 4/10/2009 23:14'!
testJoinArrayUsingChar
	self assert: ((1 to: 4) joinUsing: $:)
		equals:  '1:2:3:4'! !

!SplitJoinTest methodsFor: 'running' stamp: 'onierstrasz 4/12/2009 20:32'!
testSplitJoinBoundaryCases
	"Empty splitter, joiner or sequence."
	self assert: (#() join: (#() split: #())) equals: #().
	self assert: ('' join: ('' split: '')) equals: ''.
	self assert: ('' join: ('.' asRegex split: '')) equals: ''. "NB: Doesn't work with empty regex"

	"Overlapping splitters, or at end of sequence"
	self assert: ('an' join: ('an' split: 'banana')) equals: 'banana'.
	self assert: ('na' join: ('na' split: 'banana')) equals: 'banana'.
	self assert: ('ana' join: ('ana' split: 'banana')) equals: 'banana'.
! !

!SplitJoinTest methodsFor: 'running' stamp: 'onierstrasz 4/11/2009 10:33'!
testSplitJoinOnSequence
	self assert: (#(6 6 6) join: (#(3 4) split: #(1 2 3 4 5)))
		equals: #(1 2 6 6 6 5)! !

!SplitJoinTest methodsFor: 'running' stamp: 'VeronicaUquillas 6/11/2010 13:26'!
testJoinUsingLastOnArrayOfStrings
	self
		assert: (#('Pharo is modern' 'open source' 'highly portable' 'fast' 'full-featured' ) joinUsing: ', ' last: ' and ')
		equals: 'Pharo is modern, open source, highly portable, fast and full-featured'! !

!SplitJoinTest methodsFor: 'running' stamp: 'onierstrasz 4/11/2009 10:31'!
testSplitJoinOnElement
	self assert: (0 join: (3 split: #(1 2 3 4 5)))
		equals: #(1 2 0 4 5)! !

!SplitJoinTest methodsFor: 'running' stamp: 'BenComan 10/17/2013 15:13'!
testJoinUsingLastOnArray
	
	{	{  1. 2. 3 } 	-> '1, 2 and 3' .
		{  1. 2 } 	-> '1 and 2' .
		{  1 } 		-> '1' .
		{  }			-> ''.
	} 	asDictionary keysAndValuesDo: 
		[ 	:testCollection :resultString |
			self	 assert: ( testCollection joinUsing: ', ' last: ' and ') equals: resultString. 
		]
! !

!SplitJoinTest methodsFor: 'running' stamp: 'onierstrasz 4/12/2009 18:53'!
testSplitStringOnRegex
	self assert: ('foobar' splitOn: '[aeiou]+' asRegex)
		equals: #('f' 'b' 'r') asOrderedCollection! !

!SplitJoinTest methodsFor: 'running' stamp: 'onierstrasz 4/11/2009 10:32'!
testSplitJoinStringOnChar
	self assert: ($: join: (Character space split: 'how now brown cow?'))
		equals: 'how:now:brown:cow?'! !

!SplitJoinTest methodsFor: 'running' stamp: 'onierstrasz 4/12/2009 19:27'!
testSplitSortedCollectionOnElement
	self assert: (((1 to: 10) asSortedCollection) splitOn: 4)
		equals: {(1 to: 3) asSortedCollection . (5 to: 10) asSortedCollection} asOrderedCollection.
! !

!SplitJoinTest methodsFor: 'running' stamp: 'onierstrasz 4/10/2009 23:17'!
testJoinStringUsingString
	self assert: ('bda' joinUsing: 'an')
		equals: 'bandana'! !

!SplitJoinTest methodsFor: 'running' stamp: 'onierstrasz 4/10/2009 23:15'!
testJoinStringUsingChar
	self assert: ('splitjoin' joinUsing: $-)
		equals: 's-p-l-i-t-j-o-i-n'! !

!SplitJoinTest class methodsFor: 'sunitgui' stamp: 'onierstrasz 4/12/2009 18:50'!
packageNamesUnderTest
	<ignoreForCoverage>
	^ #('SplitJoin')! !

!SplitJoinTest class methodsFor: 'documentation' stamp: 'onierstrasz 4/11/2009 14:19'!
documentation
	<ignoreForCoverage>
	"self showDocumentation"
	
	^ '"This package provides functionality for splitting and joining strings similarly to that offered by Perl, Python and Ruby. In addition, split and join work for any kind of sequence, and offer the possibility to split strings using regular expressions.

Suppose object A is a SequenceableCollection of elements of type T (let''s call its type S[T]), and B is a splitter of type either T or S[T]. Then A splitOn: B yields an object C of type OC[S[T]] (OC=OrderedCollection). B can be either an element or a subsequence, so:"

	''abracadabra'' splitOn: $b.
	"-> an OrderedCollection(''a'' ''racada'' ''ra'')"

	''abracadabra'' splitOn: ''ca''.
	"-> an OrderedCollection(''abra'' ''dabra'')"

"A splitOn: B is the same as B split: A, so:"

	''ab'' split: ''abracadabra''.
	"-> an OrderedCollection('''' ''racad'' ''ra'')"

"joinUsing: and join: are the inverse of splitOn: and split:. You may use either of the forms:
	C joinUsing: B
or:
	B join: C
The result is normally the same type as the joiner. If the joiner (B) is of type S[T] and C is of type OC[S[T]] or Array[S[T]], the result is also of type S[T]. For example:"

	'' loves '' join: #(''john'' ''jane'' ''jack'').
	"-> ''john loves jane loves jack''"

"An object that is not a sequence can also be used as a joiner, in which case the final result is an array. Also the collection being joined may contain elements that are not sequences, in which case they are treated as singleton arrays."

	1 join: ''hello''.
	"-> #($h 1 $e 1 $l 1 $l 1 $o)"

"Note that in the case of characters and strings being used as joiners, the result is always a string."

"In general:
	((A splitOn: B) joinUsing: B) = A
or:
	(B join: (B split: A)) = A
so:"

	(''r'' join: (''r'' split: ''abracadabra'')) = ''abracadabra''.
	"->  true"

"Although the main application is for Strings, split and join will work for any kinds of SequenceableCollections, including Arrays and Intervals."

	[:n | n isPrime] split: (2 to: 20).
	"-> an OrderedCollection(#() #() #(4) #(6) #(8 9 10) #(12) #(14 15 16) #(18) #(20))"

"In addition, the following special cases are supported:

- split an S[T] using a block of type T->Boolean:"

	''abracadabra'' splitOn: [:x | ''bc'' includes: x].
	"-> an OrderedCollection(''a'' ''ra'' ''ada'' ''ra'')"

"- split a String using a regex:"

	''abracadabra'' splitOn: ''[bcdr]+'' asRegex.
	"-> an OrderedCollection(''a'' ''a'' ''a'' ''a'' ''a'')"

"- join all elements of an S[T] yielding another S[T]: '' ''- "

	''abracadabra'' joinUsing: '':''.
	" -> ''a:b:r:a:c:a:d:a:b:r:a''"

"Note that in these cases the rule that (B join: (B split: A)) = A does not hold, either because B maps to different elements, or because there is no A to start with."

	$: join: (1 to: 4).
	"-> ''1:2:3:4''"

"Finally, there is the convenient utility method joinUsing:last:, used as follows:"

	(1 to: 5) joinUsing: '', '' last: '' and ''.
	"-> ''1, 2, 3, 4 and 5''"

"This package merges and generalizes functionality from the Join package by Keith Hodges and the RubyShards package by Damien Pollet and Oscar Nierstrasz. "
'! !

!Stack commentStamp: 'dc 7/24/2005 15:41'!
I implement a simple Stack. #push: adds a new object of any kind on top of the stack. #pop returns the first element and remove it from the stack. #top answer the first element of the stack without removing it.!
!Stack methodsFor: 'removing' stamp: 'NikoSchwarz 10/21/2009 14:49'!
pop
	"Returns the first element and remove it from the stack."

	^self  removeFirst ! !

!Stack methodsFor: 'accessing' stamp: 'NikoSchwarz 10/21/2009 14:48'!
top
	"Answer the first element of the stack without removing it."
	^ self first! !

!Stack methodsFor: 'adding' stamp: 'NikoSchwarz 10/21/2009 14:48'!
push: anObject 
	"Adds a new object of any kind on top of the stack."
	self addFirst: anObject.
	^ anObject.! !

!StackFilter commentStamp: 'TorstenBergmann 1/31/2014 11:30'!
A filter on the current stack for debugging!
!StackFilter methodsFor: 'testing' stamp: 'ClaraAllende 8/14/2013 19:56'!
shouldDisplay: aContext
	^self subclassResponsibility ! !

!StackFilter methodsFor: 'operators' stamp: 'ClaraAllende 8/14/2013 20:39'!
or: aFilter
	  ^ BooleanFilter withFilters: (OrderedCollection with: self with: aFilter) operator: #or:! !

!StackFilter methodsFor: 'operators' stamp: 'ClaraAllende 8/14/2013 20:39'!
and: aFilter
	  ^ BooleanFilter withFilters: (OrderedCollection with: self with: aFilter) operator: #and:! !

!StackLayout methodsFor: 'as yet unclassified' stamp: 'GaryChambers 11/15/2011 12:43'!
minExtentOf: aMorph in: newBounds
	"Return the minimal size aMorph's children would require given the new bounds"
	
	|min extent|
	cachedMinExtent ifNotNil: [^cachedMinExtent].
	aMorph submorphs ifEmpty: [^0 @ 0].
	extent := 0@0.
	cachedMinExtents := aMorph submorphs collect: [:m |
		min := m minExtent.
		extent := extent max: min.
		min].
	^cachedMinExtent := extent! !

!StackLayout methodsFor: 'as yet unclassified' stamp: 'gvc 10/21/2009 14:23'!
flushLayoutCache
	"Flush any cached information associated with the receiver."
	
	cachedMinExtent := nil! !

!StackLayout methodsFor: 'as yet unclassified' stamp: 'gvc 10/21/2009 14:38'!
layout: aMorph in: layoutBounds
	"Compute the layout for the given morph based on the new bounds.
	Supports submorph hResizing, vResizing, cellInset, cellPositioning
	(top, *center, bottom*)."

	|props cell box pos vr newBounds minExt|
	aMorph submorphs ifEmpty: [^self].
	props := aMorph assureTableProperties.
	minExt := self minExtentOf: aMorph in: layoutBounds.
	newBounds := layoutBounds origin extent: (layoutBounds extent max: minExt).
	cell := newBounds.
	aMorph submorphs with: cachedMinExtents do: [:m :ext |
		((vr := m vResizing) == #shrinkWrap or: [m bounds ~= cell])
			ifTrue: [((vr == #shrinkWrap) not and: [m extent = cell extent])
						ifTrue: [m position: cell origin]
						ifFalse: [box := m bounds.
								m hResizing == #spaceFill 
									ifTrue: [box := cell origin extent: cell width @ box height].
								vr  == #spaceFill
									ifTrue: [box := box origin extent: box width @ cell height].
								vr  == #shrinkWrap
									ifTrue:[box := box origin extent: box width @ ext y].
								pos := props cellPositioning.
								box := box align: (box perform: pos) with: (cell perform: pos).
								m bounds: box]]]! !

!StackTest commentStamp: 'TorstenBergmann 2/20/2014 15:31'!
SUnit tests for stacks!
!StackTest methodsFor: 'tests - empty' stamp: ''!
testIsEmptyOrNil

	self assert: (self empty isEmptyOrNil).
	self deny: (self nonEmpty isEmptyOrNil).! !

!StackTest methodsFor: 'test' stamp: 'sd 3/21/2006 22:13'!
testPush
	
	| aStack |
	aStack := Stack new.
	aStack push: 'a'.
	self assert: aStack size = 1.	
	aStack push: 'b'.
	self assert: aStack size = 2.
	! !

!StackTest methodsFor: 'test' stamp: 'sd 3/21/2006 22:13'!
testPop

	| aStack res elem |
	elem := 'anElement'.	
	aStack := Stack new.
	self assert: aStack isEmpty.
	
	aStack push: 'a'.
	aStack push: elem.
	res := aStack pop.	
	self assert: res = elem.
	self assert: res == elem.
	
	self assert: aStack size = 1.
	aStack pop.
	self assert: aStack isEmpty.

! !

!StackTest methodsFor: 'tests - empty' stamp: ''!
testIfEmptyifNotEmpty

	self assert: (self empty ifEmpty: [true] ifNotEmpty: [false]).
	self assert: (self nonEmpty ifEmpty: [false] ifNotEmpty: [true]).
	! !

!StackTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCloneTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!StackTest methodsFor: 'tests - empty' stamp: ''!
testIsEmpty

	self assert: (self empty isEmpty).
	self deny: (self nonEmpty isEmpty).! !

!StackTest methodsFor: 'test' stamp: 'sd 3/21/2006 22:13'!
testSize
	
	| aStack |
	aStack := Stack new.
	self assert: aStack size = 0.
	aStack push: 'a'.
	self assert: aStack size = 1.
	aStack push: 'b'.
	self assert: aStack size = 2.
	aStack pop.
	self assert: aStack size = 1.
	aStack pop.
	self assert: aStack size = 0.

 
	


! !

!StackTest methodsFor: 'test' stamp: 'sd 3/21/2006 22:13'!
testTop

	| aStack |
	aStack := Stack new.
	self assert: aStack isEmpty.
	aStack push: 'a'.
	aStack push: 'b'.
	self assert: aStack top = 'b'.
	self assert: aStack top = 'b'.
	self assert: aStack size = 2.! !

!StackTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyEmpty
	"self debug: #testCopyEmpty"
	
	| copy | 
	copy := self empty copy.
	self assert: copy isEmpty.! !

!StackTest methodsFor: 'setup' stamp: 'stephane.ducasse 12/5/2008 17:42'!
setUp

	empty := Stack new.
	nonEmpty := Stack new.
	nonEmpty push: 1.
	nonEmpty push: -2.
	nonEmpty push: 3.
	nonEmpty push: 1.
	! !

!StackTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyCreatesNewObject
	"self debug: #testCopyCreatesNewObject"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: self nonEmpty == copy.
	! !

!StackTest methodsFor: 'tests - empty' stamp: 'stephane.ducasse 12/5/2008 17:45'!
empty
	
 	^ empty! !

!StackTest methodsFor: 'tests - empty' stamp: ''!
testIfNotEmpty

	self empty ifNotEmpty: [self assert: false].
	self nonEmpty ifNotEmpty: [self assert: true].
	self assert: (self nonEmpty ifNotEmpty: [:s | s ]) = self nonEmpty
	! !

!StackTest methodsFor: 'test' stamp: 'CamilloBruni 8/31/2013 20:23'!
testEmptyError
	| aStack |
	aStack := Stack new.
	self should: [ aStack top ] raise: Error.
	self should: [ aStack pop ] raise: Error.
	aStack push: 'element'.
	aStack top.
	aStack pop.	"The stack is empty again due to previous pop"
	self should: [ aStack top ] raise: Error.
	self should: [ aStack pop ] raise: Error! !

!StackTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureEmptyTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!StackTest methodsFor: 'tests - empty' stamp: 'stephane.ducasse 12/5/2008 17:45'!
nonEmpty
	
 	^ nonEmpty! !

!StandardFileStream commentStamp: 'ul 12/6/2009 05:13'!
Provides a simple, platform-independent, interface to a file system. The instance variable rwmode, inherited from class PositionableStream, here is used to hold a Boolean -- true means opened for read-write, false means opened for read-only.  2/12/96 sw

I implement a simple read buffering scheme with the variables defined in PositionableStream (which are unused in me otherwise) in the following way:
	collection	<ByteString> or <ByteArray>	This is the buffer.
	position	<Integer>	The relative position in the buffer. Greater or equal to zero.
	readLimit	<Integer>	The number of bytes buffered. Greater or equal to zero.
Read buffering is enabled with #enableReadBuffering, disabled with #disableReadBuffering and it is enabled by default. The buffer is filled when a read attempt of an unbuffered absolute position is requested, or when a negative repositioning is made (with #position: with an argument < than the current absolute position) to an absolute position which is not buffered. In the first case, the buffer is positioned to the given absolute position. In the latter case the repositioning is made to the requested absolute position minus fourth of the buffer size. This means that further small negative repositionings won't result in buffer flushing. This is really useful when filing in code.
The read buffer is flushed (#flushReadBuffer) whenever a write attempt is made.
The buffer state is valid if and only if collection is not nil and position < readLimit.!
!StandardFileStream methodsFor: 'access' stamp: 'CamilloBruni 8/1/2012 16:05'!
file
	"Answer the object representing the receiver's file.  Need for compatibility with some calls -- check senders. "

	^ self! !

!StandardFileStream methodsFor: 'open/close' stamp: 'StephaneDucasse 5/28/2011 11:43'!
openOnHandle: aFileID name: streamName forWrite: writeMode
	"Initialize the file with the given handle. If writeMode is true then
	 allow writing, otherwise put the file in read-only mode.
	 N.B. Do _not_ register the stream.  We do not want it to be
	 closed implicitly (e.g. on GC).  There may be multiple instances
	 accessing the same stream.  The stream is not a file."
	fileID := aFileID.
	name := streamName.
	rwmode := writeMode.
	buffer1 := String new: 1.
	self enableReadBuffering! !

!StandardFileStream methodsFor: 'read, write, position' stamp: 'HenrikSperreJohansen 3/15/2010 23:06'!
readInto: byteArray startingAt: startIndex count: count
	"Read up to n bytes into the given byteArray.
	Return the number of bytes actually read."
	
	| newN newStartIndex available|
	available := 0.
	collection 
		ifNil: [ 
			newN := count.
			newStartIndex := startIndex ]
		ifNotNil: [
			byteArray class isBytes 
				ifFalse: [ 
					position < readLimit ifTrue: [ self flushReadBuffer ].
					newN := count.
					newStartIndex := startIndex ]
				ifTrue: [
					(available := readLimit - position) > 0 
						ifTrue: [
							| bufferedCount |
							bufferedCount := count min: available.
							byteArray
								replaceFrom: startIndex
								to: startIndex + bufferedCount - 1
								with: collection
								startingAt: position + 1.
							position := position + bufferedCount.
							bufferedCount = count ifTrue: [ ^count ] ].
					newN := count - available.
					newStartIndex := startIndex + available ] ].
	^available + (self primRead: fileID into: byteArray
				startingAt: newStartIndex count: newN).
! !

!StandardFileStream methodsFor: 'properties-setting' stamp: 'ul 12/3/2009 02:18'!
binary
	buffer1 := ByteArray new: 1.
	collection ifNotNil: [ collection := collection asByteArray ]! !

!StandardFileStream methodsFor: 'properties-setting' stamp: ''!
isBinary
	^ buffer1 class == ByteArray! !

!StandardFileStream methodsFor: 'access' stamp: 'CamilloBruni 9/5/2012 11:26'!
peekFor: item 
	"Answer false and do not advance if the next element is not equal to item, or if this stream is at the end.  If the next element is equal to item, then advance over it and return true"
	| next |
	(next := self next) == nil ifTrue: [^ false].
	item = next ifTrue: [^ true].
	self skip: -1.
	^ false! !

!StandardFileStream methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSetPosition: id to: anInteger
	"Set this file to the given position."

	<primitive: 'primitiveFileSetPosition' module: 'FilePlugin'>
	self primitiveFailed
! !

!StandardFileStream methodsFor: 'read, write, position' stamp: 'CamilloBruni 8/1/2012 16:13'!
position: pos
	"Set the receiver's position as indicated."

	collection ifNotNil: [
		position < readLimit ifTrue: [
			| newPosition |
			newPosition := pos - (self primGetPosition: fileID) + readLimit.
			newPosition < 0 ifTrue: [
					| offsetPos |
					self primSetPosition: fileID to: (offsetPos := pos - (collection size // 4) max: 0).
					readLimit := self primRead: fileID into: collection startingAt: 1 count: collection size.
					position := pos - offsetPos.
					^self ].
			newPosition < readLimit 
				ifTrue: [
					position := newPosition.
					^self ]
				ifFalse: [
					readLimit := position := 0 ] ] ].
	^self primSetPosition: fileID to: pos! !

!StandardFileStream methodsFor: 'open/close' stamp: 'ul 12/6/2009 04:11'!
reopen
	"Close and reopen this file. The file position is reset to zero."
	"Details: Files that were open when a snapshot occurs are no longer valid when the snapshot is resumed. This operation re-opens the file if that has happened."

	fileID ifNotNil: [
		collection ifNotNil: [
			position < readLimit ifTrue: [
				self flushReadBuffer ] ].
		self primCloseNoError: fileID ].
	self open: name forWrite: rwmode.
! !

!StandardFileStream methodsFor: 'read, write, position' stamp: 'JMM 5/24/2001 22:47'!
truncate: pos
	"Truncate to this position"

	self position: pos.
	^self primTruncate: fileID to: pos! !

!StandardFileStream methodsFor: 'properties-setting' stamp: 'ul 12/3/2009 02:17'!
ascii
	"opposite of binary"
	buffer1 := String new: 1.
	collection ifNotNil: [ collection := collection asString ]! !

!StandardFileStream methodsFor: 'read, write, position' stamp: 'JMM 5/24/2001 22:00'!
truncate
	"Truncate to zero"

	^ self truncate: 0! !

!StandardFileStream methodsFor: 'dnd requests' stamp: 'CamilloBruni 9/7/2013 11:28'!
requestDropStream: dropIndex
	"Return a read-only stream for some file the user has just dropped onto the application."

	| rawName |
	rawName := self primDropRequestFileName: dropIndex.
	name := FilePathEncoder decode: rawName.
	fileID := self primDropRequestFileHandle: dropIndex.
	fileID == nil
		ifTrue: [ ^ nil ].
	self register.
	rwmode := false.
	buffer1 := String new: 1.
	self enableReadBuffering! !

!StandardFileStream methodsFor: 'read, write, position' stamp: 'stephaneducasse 2/4/2006 20:32'!
peek
	"Answer what would be returned if the message next were sent to the receiver. If the receiver is at the end, answer nil.  "
	| next |
	self atEnd ifTrue: [^ nil].
	next := self basicNext.
	self position: self position - 1.
	^ next! !

!StandardFileStream methodsFor: 'open/close' stamp: 'CamilloBruni 8/1/2012 16:12'!
open: fileName forWrite: writeMode 
	"Open the file with the given name. If writeMode is true, allow writing, otherwise open the file in read-only mode."
	| f |
	f := fileName asVmPathName.

	fileID := StandardFileStream retryWithGC:[self primOpen: f writable: writeMode] 
					until:[:id| id notNil] 
					forFileNamed: fileName.
	fileID ifNil: [^ nil].  "allows sender to detect failure"
	name := fileName.
	self register.
	rwmode := writeMode.
	buffer1 := String new: 1.
	self enableReadBuffering
	! !

!StandardFileStream methodsFor: 'read, write, position' stamp: 'yo 10/31/2002 22:33'!
readOnlyCopy

	^ self class readOnlyFileNamed: self name.
! !

!StandardFileStream methodsFor: 'open/close' stamp: 'CamilloBruni 8/1/2012 16:12'!
openReadOnly
	"Open the receiver as a read-only file."

	^ self open: name forWrite: false! !

!StandardFileStream methodsFor: 'finalization' stamp: 'ar 10/7/1998 15:44'!
finalize
	self primCloseNoError: fileID.! !

!StandardFileStream methodsFor: '*Fuel' stamp: 'MarianoMartinezPeck 10/10/2011 12:24'!
nextBytesPutAll: aCollection
	self nextPutAll: aCollection! !

!StandardFileStream methodsFor: 'access' stamp: 'jm 9/21/1998 14:19'!
fullName
	"Answer this file's full path name."

	^ name
! !

!StandardFileStream methodsFor: 'properties-setting' stamp: 'SeanDeNigris 7/12/2012 08:44'!
setFileTypeToObject
	"On the Macintosh, set the file type and creator of this file to be a Pharo object file. On other platforms, do nothing. Setting the file type allows Pharo object files to be sent as email attachments and launched by double-clicking. On other platforms, similar behavior is achieved by creating the file with the '.sqo' file name extension."

	self fullName asFileReference setMacType: 'SOBJ' creator: 'FAST'.
! !

!StandardFileStream methodsFor: 'access' stamp: 'ar 6/16/2002 18:58'!
reset
	self ensureOpen.
	self position: 0.! !

!StandardFileStream methodsFor: 'read, write, position' stamp: 'CamilloBruni 8/1/2012 16:12'!
next: n
	"Return a string with the next n characters of the filestream in it."
	^ self nextInto: (self collectionSpecies new: n)! !

!StandardFileStream methodsFor: 'access' stamp: 'SeanDeNigris 7/12/2012 08:45'!
directory
	"Return the directory containing this file."

	^ self fullName asFileReference parent
! !

!StandardFileStream methodsFor: 'read, write, position' stamp: 'ul 12/5/2009 07:21'!
padToEndWith: aChar
	"On the Mac, files do not truncate.  One can delete the old file and write a new one, but sometime deletion fails (file still open? file stale?).  This is a sad compromise.  Just let the file be the same length but pad it with a harmless character."

	| pad |
	self atEnd ifTrue: [^ self].
	pad := self isBinary 
		ifTrue: [aChar asCharacter asciiValue]	"ok for char or number"
		ifFalse: [aChar asCharacter].
	self nextPutAll: (self collectionSpecies new: ((self size - self position) min: 20000) 
							withAll: pad).! !

!StandardFileStream methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primClose: id
	"Close this file."

	<primitive: 'primitiveFileClose' module: 'FilePlugin'>
	self primitiveFailed
! !

!StandardFileStream methodsFor: 'read, write, position' stamp: 'tk 2/5/2000 21:58'!
nextWordsInto: aBitmap
	"Note: The file primitives automatically adjust for word based objects."

	self next: aBitmap basicSize into: aBitmap startingAt: 1.
	aBitmap restoreEndianness.
	^ aBitmap! !

!StandardFileStream methodsFor: 'read, write, position' stamp: 'ul 12/6/2009 04:10'!
basicNext
	"Answer the next byte from this file, or nil if at the end of the file."
	
	| count |
	<primitive: 65>
	collection ifNotNil: [
		position < readLimit 
			ifFalse: [ 
				readLimit := self primRead: fileID into: collection startingAt: 1 count: collection size.
				position := 0.
				readLimit = 0 ifTrue: [ ^nil ] ].
		^collection at: (position := position + 1) ].	
	count := self primRead: fileID into: buffer1 startingAt: 1 count: 1.
	count = 1
		ifTrue: [ ^buffer1 at: 1 ]
		ifFalse: [ ^nil ]! !

!StandardFileStream methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primCloseNoError: id
	"Close this file. Don't raise an error if the primitive fails."

	<primitive: 'primitiveFileClose' module: 'FilePlugin'>
! !

!StandardFileStream methodsFor: 'primitives' stamp: 'stephaneducasse 2/4/2006 20:32'!
primFlush: id
	"Flush pending changes to the disk"
	| p |
	<primitive: 'primitiveFileFlush' module: 'FilePlugin'>
	"In some OS's seeking to 0 and back will do a flush"
	p := self position.
	self position: 0; position: p! !

!StandardFileStream methodsFor: 'read, write, position' stamp: 'nice 12/8/2009 19:03'!
upToAnyOf: delimiters do: aBlock
	"Fast version to speed up nextChunk"
	| pos buffer count result |
	collection ifNotNil: [
		(position < readLimit and: [
			(count := collection indexOfAnyOf: delimiters startingAt: position + 1) <= readLimit and: [
				count > 0 ] ]) ifTrue: [
					result := collection copyFrom: position + 1 to: (position := count) - 1.
					aBlock value: (collection at: count).
					^result ] ].
	pos := self position.
	buffer := self next: 2000.
	(count := buffer indexOfAnyOf: delimiters) > 0 ifTrue: 
		["Found one of the delimiters part way into buffer"
		self position: pos + count.
		aBlock value: (buffer at: count).
		^ buffer copyFrom: 1 to: count - 1].
	self atEnd ifTrue:
		["Never found it, and hit end of file"
		^ buffer].
	"Never found it, but there's more..."
	^ buffer , (self upToAnyOf: delimiters do: aBlock)! !

!StandardFileStream methodsFor: 'read, write, position' stamp: 'CamilloBruni 8/1/2012 16:13'!
position
	"Return the receiver's current file position."

	collection ifNotNil: [
		position < readLimit ifTrue: [
			^(self primGetPosition: fileID) - readLimit + position ] ].
	^self primGetPosition: fileID! !

!StandardFileStream methodsFor: 'open/close' stamp: 'CamilloBruni 8/1/2012 16:12'!
open
	"For compatibility with a few existing things."

	^ self reopen! !

!StandardFileStream methodsFor: 'properties-setting' stamp: 'tk 11/4/1998 19:17'!
isReadOnly

	^ rwmode not
! !

!StandardFileStream methodsFor: 'primitives' stamp: 'JMM 5/24/2001 21:55'!
primTruncate: id to: anInteger
	"Truncate this file to the given position."

	<primitive: 'primitiveFileTruncate' module: 'FilePlugin'>
	self primitiveFailed
! !

!StandardFileStream methodsFor: 'read, write, position' stamp: 'ul 12/6/2009 04:11'!
next: anInteger putAll: aString startingAt: startIndex
	"Store the next anInteger elements from the given collection."
	rwmode ifFalse: [^ self error: 'Cannot write a read-only file'].
	collection ifNotNil: [
		position < readLimit ifTrue: [ self flushReadBuffer ] ].	
	self primWrite: fileID from: aString startingAt: startIndex count: anInteger.
	^aString! !

!StandardFileStream methodsFor: 'access' stamp: 'jm 9/21/1998 14:19'!
name
	"Answer this file's full path name."

	^ name
! !

!StandardFileStream methodsFor: 'open/close' stamp: 'jm 9/21/1998 16:20'!
ensureOpen
	"Make sure that this file really is open."

	self closed ifTrue: [^ self reopen].
	(self primSizeNoError: fileID) ifNotNil: [^ self].
	self reopen.
! !

!StandardFileStream methodsFor: 'read, write, position' stamp: 'CamilloBruni 8/1/2012 16:16'!
skip: n
	"Set the character position to n characters from the current position.
	Error if not enough characters left in the file."

	collection ifNotNil: [
		position < readLimit ifTrue: [
			| newPosition |
			((newPosition := position + n) >= 0 and: [ newPosition < readLimit ])
				ifTrue: [ 
					position := newPosition.
					^self ] ] ].
	self position: self position + n! !

!StandardFileStream methodsFor: 'registry' stamp: 'ar 3/21/98 17:23'!
unregister
	^self class unregister: self! !

!StandardFileStream methodsFor: 'dnd requests' stamp: 'VeronicaUquillas 6/11/2010 15:32'!
primDropRequestFileHandle: dropIndex
	"Primitive. Return the (read-only) file handle for some file that was just dropped onto the application.
	Fail if dropIndex is out of range or the primitive is not supported."
	<primitive: 'primitiveDropRequestFileHandle' module:'DropPlugin'>
	^nil! !

!StandardFileStream methodsFor: 'open/close' stamp: 'ul 12/4/2009 07:18'!
close
	"Close this file."

	fileID ifNotNil: [
		collection ifNotNil: [
			readLimit := position := 0 ].
		self primClose: fileID.
		self unregister.
		fileID := nil].
! !

!StandardFileStream methodsFor: 'read, write, position' stamp: 'mir 2/25/2000 12:37'!
next
	"Answer the next byte from this file, or nil if at the end of the file."

	^ self basicNext! !

!StandardFileStream methodsFor: 'registry' stamp: 'ar 3/21/98 17:23'!
register
	^self class register: self! !

!StandardFileStream methodsFor: 'private' stamp: 'nice 11/22/2009 18:03'!
collectionSpecies
	"Answer the species of collection into which the receiver can stream"
	
	^buffer1 species! !

!StandardFileStream methodsFor: 'access' stamp: 'CamilloBruni 8/1/2012 16:10'!
isDirectory
	"Answer whether the receiver represents a directory.  For the post-transition case, uncertain what to do."
	^ false! !

!StandardFileStream methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primGetPosition: id
	"Get this files current position."

	<primitive: 'primitiveFileGetPosition' module: 'FilePlugin'>
	self primitiveFailed
! !

!StandardFileStream methodsFor: 'read, write, position' stamp: 'tk 10/19/2001 11:29'!
peekLast
	"Return that item just put at the end of the stream"

	^ buffer1 size > 0 
		ifTrue: [buffer1 last]
		ifFalse: [nil]
! !

!StandardFileStream methodsFor: 'finalization' stamp: 'ar 3/21/98 18:16'!
actAsExecutor
	super actAsExecutor.
	name := nil.! !

!StandardFileStream methodsFor: 'printing' stamp: 'CamilloBruni 8/1/2012 16:13'!
printOn: aStream
	"Put a printed version of the receiver onto aStream."

	aStream nextPutAll: self class name; nextPutAll: ': '; print: name! !

!StandardFileStream methodsFor: 'private' stamp: 'ul 12/6/2009 04:11'!
flushReadBuffer

	collection ifNotNil: [
		position < readLimit ifTrue: [
			| currentPosition |
			currentPosition := self position.
			position := readLimit := 0.
			self primSetPosition: fileID to: currentPosition ] ]! !

!StandardFileStream methodsFor: 'read, write, position' stamp: 'MarianoMartinezPeck 10/26/2010 11:32'!
nextPutAll: stringOrByteArray
	"Write all the characters of the given string to this file."

	rwmode ifFalse: [^ self error: 'Cannot write a read-only file'].
	collection ifNotNil: [ 
		position < readLimit ifTrue: [ self flushReadBuffer ] ].
	self primWrite: fileID from: stringOrByteArray startingAt: 1 count: stringOrByteArray basicSize.
	^ stringOrByteArray
! !

!StandardFileStream methodsFor: 'read, write, position' stamp: 'stephaneducasse 2/4/2006 20:32'!
findStringFromEnd: string
	"Fast version to find a String in a file starting from the end.
	Returns the position and also sets the position there.
	If string is not found 0 is returned and position is unchanged."

	| pos buffer count oldPos |
	oldPos := self position.
	self setToEnd.
	pos := self position.
	[ pos := ((pos - 2000 + string size) max: 0).  "the [+ string size] allows for the case where the end of the search string is at the beginning of the current buffer"
	self position: pos.
	buffer := self next: 2000.
	(count := buffer findString: string) > 0
		ifTrue: ["Found the string part way into buffer"
			self position: pos.
			self next: count-1.  "use next instead of position:, so that CrLfFileStream can do its magic if it is being used"
			^self position].
	pos = 0] whileFalse.
	"Never found it, and hit beginning of file"
	self position: oldPos.
	^0! !

!StandardFileStream methodsFor: 'properties-setting' stamp: 'ul 12/3/2009 06:39'!
readWrite
	"Make this file writable."

	rwmode := true.
! !

!StandardFileStream methodsFor: 'read, write, position' stamp: 'CamilloBruni 8/1/2012 16:16'!
setToEnd
	"Set the position of the receiver to the end of file."

	self position: self size! !

!StandardFileStream methodsFor: '*compression' stamp: 'SeanDeNigris 6/21/2012 09:13'!
compressFile
	"Write a new file that has the data in me compressed in GZip format."
	| zipped buffer |

	self readOnly; binary.
	zipped := (self directory / self name, 'gz') writeStream.
	zipped binary; setFileTypeToObject.
		"Type and Creator not to be text, so can be enclosed in an email"
	zipped := GZipWriteStream on: zipped.
	buffer := ByteArray new: 50000.
	'Compressing ', self fullName displayProgressFrom: 0 to: self size
		during: [:bar |
			[self atEnd] whileFalse: [
				bar current: self position.
				zipped nextPutAll: (self nextInto: buffer)].
			zipped close.
			self close].
	^zipped! !

!StandardFileStream methodsFor: '*Fuel' stamp: 'MarianoMartinezPeck 9/6/2011 12:42'!
fuelNextWordsInto: aWordObject
	"This method is the same as nextWordsInto: but the restoreEndianness is only done if needed"
	self next: aWordObject basicSize into: aWordObject startingAt: 1.
	^ aWordObject! !

!StandardFileStream methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primAtEnd: id
	"Answer true if the file position is at the end of the file."

	<primitive: 'primitiveFileAtEnd' module: 'FilePlugin'>
	self primitiveFailed
! !

!StandardFileStream methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primOpen: fileName writable: writableFlag
	"Open a file of the given name, and return the file ID obtained.
	If writableFlag is true, then
		if there is none with this name, then create one
		else prepare to overwrite the existing from the beginning
	otherwise
		if the file exists, open it read-only
		else return nil"

	<primitive: 'primitiveFileOpen' module: 'FilePlugin'>
	^ nil
! !

!StandardFileStream methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSizeNoError: id
	"Answer the size of this file. Answer nil if the primitive fails; this indicates that the file handle has become stale."

	<primitive: 'primitiveFileSize' module: 'FilePlugin'>
	^ nil
! !

!StandardFileStream methodsFor: 'access' stamp: 'CamilloBruni 8/1/2012 16:16'!
size
	"Answer the size of the file in characters."

	^ self primSize: fileID! !

!StandardFileStream methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primRead: id into: byteArray startingAt: startIndex count: count
	"Read up to count bytes of data from this file into the given string or byte array starting at the given index. Answer the number of bytes actually read."

	<primitive: 'primitiveFileRead' module: 'FilePlugin'>
	self closed ifTrue: [^ self error: 'File is closed'].
	self error: 'File read failed'.
! !

!StandardFileStream methodsFor: 'read, write, position' stamp: 'ul 12/3/2009 06:44'!
atEnd
	"Answer whether the receiver is at its end.  "
	
	collection ifNotNil: [
		position < readLimit ifTrue: [ ^false ] ].
	^self primAtEnd: fileID! !

!StandardFileStream methodsFor: 'read, write, position' stamp: 'ul 12/6/2009 04:11'!
nextPut: char
	"Write the given character to this file."

	rwmode ifFalse: [^ self error: 'Cannot write a read-only file'].
	collection ifNotNil: [ 
		position < readLimit ifTrue: [ self flushReadBuffer ] ].
	buffer1 at: 1 put: char.
	self primWrite: fileID from: buffer1 startingAt: 1 count: 1.
	^ char
! !

!StandardFileStream methodsFor: 'access' stamp: 'CamilloBruni 5/26/2012 12:26'!
localName
	^ name ifNotNil: [
		(name findTokens: FileSystem disk delimiter asString) last]! !

!StandardFileStream methodsFor: 'primitives' stamp: 'MarianoMartinezPeck 10/26/2010 11:32'!
primWrite: id from: stringOrByteArray startingAt: startIndex count: count
	"Write count bytes onto this file from the given string or byte array starting at the given index. Answer the number of bytes written."

	<primitive: 'primitiveFileWrite' module: 'FilePlugin'>
	(FileWriteError fileName: name)
		signal: (self closed
			ifTrue: [ 'File ', name, ' is closed' ]
			ifFalse: [ 'File ', name, ' write failed' ])! !

!StandardFileStream methodsFor: 'read, write, position' stamp: 'stephaneducasse 2/4/2006 20:32'!
findString: string
	"Fast version of #upToAll: to find a String in a file starting from the beginning.
	Returns the position and also sets the position there.
	If string is not found 0 is returned and position is unchanged."

	| pos buffer count oldPos sz |
	oldPos := self position.
	self reset.
	sz := self size.
	pos := 0.
	buffer := String new: 2000.
	[ buffer := self nextInto: buffer.
	(count := buffer findString: string) > 0
		ifTrue: ["Found the string part way into buffer"
			self position: pos.
			self next: count - 1.
			^self position ].
	pos := ((pos + 2000 - string size) min: sz).
	self position: pos.
	pos = sz] whileFalse.
	"Never found it, and hit end of file"
	self position: oldPos.
	^0! !

!StandardFileStream methodsFor: 'private' stamp: 'ul 12/6/2009 02:49'!
enableReadBuffering

	collection ifNil: [
		buffer1 ifNotNil: [
			collection := self collectionSpecies new: 2048 ] ].
	readLimit := position := 0! !

!StandardFileStream methodsFor: 'dnd requests' stamp: 'VeronicaUquillas 6/11/2010 15:33'!
primDropRequestFileName: dropIndex
	"Primitive. Return the file name for some file that was just dropped onto the application.
	Fail if dropIndex is out of range or the primitive is not supported."
	<primitive: 'primitiveDropRequestFileName' module:'DropPlugin'>
	^nil! !

!StandardFileStream methodsFor: 'properties-setting' stamp: 'nice 11/22/2009 18:21'!
insertLineFeeds
	"(FileStream oldFileNamed: 'BBfix2.st') insertLineFeeds"
	| s crLf f |
	crLf := String crlf.
	s := self next: self size.
	self close.
	f := FileStream newFileNamed: self name.
	s linesDo: [:line | f nextPutAll: line; nextPutAll: crLf].
	f close! !

!StandardFileStream methodsFor: 'read, write, position' stamp: 'ar 2/6/2001 17:59'!
flush
	"Flush pending changes"
	^self primFlush: fileID! !

!StandardFileStream methodsFor: 'private' stamp: 'ul 12/6/2009 04:12'!
disableReadBuffering

	collection ifNotNil: [
		position < readLimit
			ifTrue: [
				| currentPosition |
				currentPosition := self position.
				collection := readLimit := position := nil.
				self position: currentPosition ]
			ifFalse: [
				collection := readLimit := position := nil ] ]
		! !

!StandardFileStream methodsFor: 'read, write, position' stamp: 'ul 1/15/2010 20:16'!
upTo: delim 
	"Fast version to speed up nextChunk"
	| pos buffer count |
	collection ifNotNil: [
		(position < readLimit and: [
			(pos := collection indexOf: delim startingAt: position + 1) <= readLimit and: [
				pos > 0 ] ]) ifTrue: [
					^collection copyFrom: position + 1 to: (position := pos) - 1 ] ].
	pos := self position.
	buffer := self next: 2000.
	(count := buffer indexOf: delim) > 0 ifTrue: 
		["Found the delimiter part way into buffer"
		self position: pos + count.
		^ buffer copyFrom: 1 to: count - 1].
	self atEnd ifTrue:
		["Never found it, and hit end of file"
		^ buffer].
	"Never found it, but there's more..."
	^ buffer , (self upTo: delim)! !

!StandardFileStream methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSize: id
	"Answer the size of this file."

	<primitive: 'primitiveFileSize' module: 'FilePlugin'>
	self primitiveFailed
! !

!StandardFileStream methodsFor: 'properties-setting' stamp: 'CamilloBruni 5/7/2012 11:36'!
getFileType
	"On the Macintosh, get the file type and creator of this file. On other platforms, do nothing."

	^ self fullName asFileReference macTypeAndCreator
! !

!StandardFileStream methodsFor: 'read, write, position' stamp: 'ul 12/3/2009 06:42'!
upToEnd
	"Answer a subcollection from the current access position through the last element of the receiver."

	^self collectionSpecies streamContents: [ :newStream |
		| next |
		[ (next := self next) == nil ] whileFalse: [
			newStream nextPut: next ] ]! !

!StandardFileStream methodsFor: 'read, write, position' stamp: 'HenrikSperreJohansen 3/15/2010 21:34'!
next: n into: aString startingAt: startIndex
	"Read n bytes into the given string.
	Return aString or a partial copy if less than
	n elements have been read."
	|read|
	read := (self readInto: aString startingAt: startIndex count: n).
	^read = n 
		ifTrue: [ aString ]
		ifFalse: [ aString copyFrom: 1 to: startIndex + read - 1 ]	
	! !

!StandardFileStream methodsFor: 'open/close' stamp: 'ul 12/6/2009 02:45'!
closed
	"Answer true if this file is closed."

	^ fileID == nil or: [ (self primSizeNoError: fileID) == nil ]
! !

!StandardFileStream methodsFor: 'properties-setting' stamp: 'ul 12/3/2009 06:39'!
readOnly
	"Make this file read-only."

	rwmode := false.
! !

!StandardFileStream class methodsFor: 'registry' stamp: 'HenrikSperreJohansen 5/20/2010 22:38'!
register: anObject
	^self registry add: anObject! !

!StandardFileStream class methodsFor: 'file creation' stamp: 'StephaneDucasse 8/30/2009 17:35'!
oldFileNamed: fileName
	"Open an existing file with the given name for reading and writing. If the name has no directory part, then the  default directory will be assumed. If the file does not exist, an exception is signaled. If the file exists, its prior contents may be modified or replaced, but the file will not be truncated on close."

	| fullName |
	fullName := self fullName: fileName.

	^(self isAFileNamed: fullName)
		ifTrue: [self new open: fullName forWrite: true]
		ifFalse: ["File does not exist..."
			(FileDoesNotExistException fileName: fullName) signal]! !

!StandardFileStream class methodsFor: 'registry' stamp: 'GuillermoPolito 3/20/2012 22:49'!
retryWithGC: execBlock until: testBlock forFileNamed: fullName
	"Re-implemented to only force GC if a file with the given name exists"
	| blockValue foundIt |
	blockValue := execBlock value.
	(testBlock value: blockValue) ifTrue:[^blockValue].
	"See if we have a file with the given name"
	foundIt := self registry keys "hold on strongly for now" 
		anySatisfy:[:file| file name sameAs: fullName].
	foundIt ifFalse:[^blockValue].
	Smalltalk garbageCollectMost.
	blockValue := execBlock value.
	(testBlock value: blockValue) ifTrue:[^blockValue].
	Smalltalk garbageCollect.
	^execBlock value.! !

!StandardFileStream class methodsFor: 'file creation' stamp: 'stephaneducasse 2/4/2006 20:32'!
isAFileNamed: fileName
	"Answer true if a file of the given name exists."

	| f |
	f := self new open: fileName forWrite: false.
	f ifNil: [^ false].
	f close.
	^ true
! !

!StandardFileStream class methodsFor: 'registry' stamp: 'HenrikSperreJohansen 5/20/2010 22:39'!
unregister: anObject
	^self registry remove: anObject ifAbsent:[]! !

!StandardFileStream class methodsFor: 'file creation' stamp: 'stephaneducasse 2/4/2006 20:32'!
newFileNamed: fileName
 	"Create a new file with the given name, and answer a stream opened for writing on that file. If the file already exists, ask the user what to do."

	| fullName |
	fullName := self fullName: fileName.

	^(self isAFileNamed: fullName)
		ifTrue: ["file already exists:"
			(FileExistsException fileName: fullName fileClass: self) signal]
		ifFalse: [self new open: fullName forWrite: true]

! !

!StandardFileStream class methodsFor: 'error handling' stamp: 'SeanDeNigris 7/12/2012 08:44'!
readOnlyFileDoesNotExistUserHandling: fullFileName

	| dir files choices selection newName fileName |
	
	dir := fullFileName asFileReference.
	files := dir parent fileNames.
	fileName := dir basename.
	
	choices := fileName correctAgainst: files.
	choices add: 'Choose another name'.
	choices add: 'Cancel'.
	
	selection := UIManager default chooseFrom: choices lines: (Array with: 5)
		title: (fullFileName asFileReference basename), ' does not exist.'.
		
	selection = choices size ifTrue:["cancel" ^ nil "should we raise another exception here?"].
	selection < (choices size - 1) ifTrue: [
		newName := dir parent / (choices at: selection)].
	selection = (choices size - 1) ifTrue: [
		newName := UIManager default 
							request: 'Enter a new file name' 
							initialAnswer: fileName].
	newName = '' ifFalse: [^ self readOnlyFileNamed: (self fullName: newName)].
	^ self error: 'Could not open a file'! !

!StandardFileStream class methodsFor: 'file creation' stamp: 'MarcusDenker 7/4/2014 11:01'!
forceNewFileNamed: fileName 
	"Create a new file with the given name, and answer a stream opened 
	for writing on that file. If the file already exists, delete it without 
	asking before creating the new file."
	| dir  fullName f |
	
	fullName := self fullName: fileName.
	(self isAFileNamed: fullName)
		ifFalse: [f := self new open: fullName forWrite: true.
			^ f ifNil: ["Failed to open the file"
					(FileDoesNotExistException fileName: fullName) signal]].
			
	dir := fullName asFileReference.
	dir delete.
	dir exists ifTrue: [(CannotDeleteFileException new
			messageText: 'Could not delete the old version of file ' , fullName) signal].
		
	f := self new open: fullName forWrite: true.
	^ f ifNil: ["Failed to open the file"
			(FileDoesNotExistException fileName: fullName) signal].! !

!StandardFileStream class methodsFor: 'file creation' stamp: 'TPR 8/13/1999 21:22'!
fileNamed: fileName
	"Open a file with the given name for reading and writing. If the name has no directory part, then the file will be created in the default directory. If the file already exists, its prior contents may be modified or replaced, but the file will not be truncated on close."

	^ self new open: (self fullName: fileName) forWrite: true
! !

!StandardFileStream class methodsFor: 'file creation' stamp: 'GuillermoPolito 9/1/2010 18:21'!
readOnlyFileNamed: fileName 
	"Open an existing file with the given name for reading."

	| fullName f |
	fullName := self fullName: fileName.
	f := self new open: fullName forWrite: false.
	^ f ifNil: ["File does not exist..."
			((FileDoesNotExistException fileName: fullName) readOnly: true) signal].

	"StandardFileStream readOnlyFileNamed: 'kjsd.txt' "! !

!StandardFileStream class methodsFor: 'error handling' stamp: 'MarcusDenker 7/4/2014 10:59'!
fileDoesNotExistUserHandling: fullFileName
	| selection newName |
	selection := UIManager default
		chooseFrom:
			{('create a new file' translated).
			('choose another name' translated).
			('cancel' translated)}
		title: fullFileName asFileReference basename , ' does not exist.'.
	selection = 1
		ifTrue: [ ^ self new open: fullFileName forWrite: true ].
	selection = 2
		ifFalse: [ ^ self ].
	newName := UIManager default request: 'Enter a new file name' initialAnswer: fullFileName.
	^ self oldFileNamed: (self fullName: newName)! !

!StandardFileStream class methodsFor: 'registry' stamp: 'HenrikSperreJohansen 5/20/2010 22:39'!
registry
	^Registry ifNil: [Registry := WeakRegistry new]
! !

!StandardFileStream class methodsFor: 'error handling' stamp: 'ClementBera 7/26/2013 16:33'!
fileExistsUserHandling: fullFileName
	| file localName choice newName newFullFileName |
	
	file := fullFileName asFileReference.
	localName := file basename.
	choice := UIManager default chooseFrom:{
		'overwrite that file'.
		'choose another name'.
		'cancel'
	} title: localName, ' already exists.'.
 
	choice = 1 ifTrue: [
		file delete.
		file exists ifTrue:  [self error: 'Could not delete the old version of that file'].
		^ self new open: fullFileName forWrite: true].

	choice = 2 ifTrue: [
		newName := UIManager default request: 'Enter a new file name' initialAnswer: fullFileName.
		newName ifNil: [Abort signal].
		newFullFileName := self fullName: newName.
		^ self newFileNamed: newFullFileName].

	Abort signal: 'Please close this to abort file opening'! !

!StandardFonts commentStamp: 'LaurentLaffont 2/10/2011 18:19'!
I am a facade and a global reference to actual fonts to be used system wide in a number of predefined categories.

I also provide methods to interactively choose these fonts, to reset all fonts to some default value, to set larger demo fonts, to construct a font menu and to manipulate the current settings as an external specification.

The font categories that I know of are: ButtonFont, CodeFont, HaloFont, ListFont, MenuFont and WindowTitleFont

Examples:
- I open a dialog to choose the font for buttons with:
StandardFonts chooseButtonFont.

- To change base size for all fonts (when you want big fonts for a screencast or a presentation):
StandardFonts setDemoFonts.

- Then restore default fonts with:
StandardFonts restoreDefaultFonts.!
!StandardFonts class methodsFor: 'menu' stamp: 'MarcusDenker 10/2/2013 20:20'!
setDefaultFonts: defaultFontsSpec
	"Since this is called from menus, we can take the opportunity to prompt for missing font styles."

	| fontNames map emphases |
	fontNames := defaultFontsSpec collect: [:array | array second].
	map := IdentityDictionary new.
	emphases := IdentityDictionary new.
	fontNames do: [:originalName | | decoded style |
		decoded := TextStyle decodeStyleName: originalName.
		style := map at: originalName put: (TextStyle named: decoded second).
		emphases at: originalName put: decoded first.
		style ifNil: [map at: originalName put: (TextStyle default) ]].
	defaultFontsSpec do: [:triplet | self
		perform: triplet first
		with: (((map at: triplet second) fontOfPointSize: triplet third) emphasized: (emphases at: triplet second))]! !

!StandardFonts class methodsFor: 'small font fixing' stamp: 'AlainPlantec 4/10/2012 22:41'!
fixSmallDejaVuPunctuationMarks
	"Just a small hack to make small font punctuation marks readable"
	| fb |
	StandardFonts setFontsToStyleNamed: #small. "To be sure we use the small font"
	fb :=StandardFonts defaultFont emphasized: 1. "copy the bold font"
	"For each punctuation mark, replace the corresponding glyph with the one found in the bold font" 
	#($. $: $; $' $` $, $")
		do: [:ch |
			StandardFonts defaultFont characterFormAt: ch put: (fb characterFormAt: ch) deepCopy].! !

!StandardFonts class methodsFor: 'font accessing' stamp: 'AlainPlantec 12/18/2009 13:49'!
systemFontAspects
	^ self systemFontAspectsAndLabels collect: [:assoc | assoc key]! !

!StandardFonts class methodsFor: 'font accessing' stamp: 'AlainPlantec 11/30/2009 17:21'!
windowTitleFont
	^ WindowTitleFont ifNil: [WindowTitleFont := StandardFonts defaultFont]! !

!StandardFonts class methodsFor: 'font accessing' stamp: 'AlainPlantec 9/13/2011 21:32'!
defaultFont: aFont
	"Establish the default text font and style"

	| aStyle newDefaultStyle |
	aFont ifNil: [^ StandardFonts setFontsFromSpec: {{#defaultFont:. StrikeFont defaultFontKey. StrikeFont defaultFontSize}}].
	aStyle := aFont textStyle ifNil: [^ self].
	newDefaultStyle := aStyle copy.
	newDefaultStyle defaultFontIndex: (aStyle fontIndexOf: aFont).
	TextSharedInformation at: #DefaultTextStyle put: newDefaultStyle.
! !

!StandardFonts class methodsFor: 'styles' stamp: 'AlainPlantec 9/18/2011 09:41'!
setFontsToLarge
	self setFontsToStyleNamed: #large! !

!StandardFonts class methodsFor: 'styles' stamp: 'AlainPlantec 9/18/2011 09:59'!
smallPointSizeForStyleNamed: aSymbol
	| all s idx |
	StrikeFont defaultFontKey.
	all := TextStyle pointSizesFor: StrikeFont defaultFontKey.
	s := self pointSizeForStyleNamed: aSymbol.
	idx := all indexOf: s ifAbsent: [^ s].
	^ idx > 1
			ifTrue: [all at: idx - 1]
			ifFalse: [all at: idx]! !

!StandardFonts class methodsFor: 'font accessing' stamp: 'StephaneDucasse 7/2/2010 19:01'!
menuFont: aFont
	aFont ~= MenuFont 
		ifTrue: [ MenuFont := aFont ].! !

!StandardFonts class methodsFor: 'font accessing' stamp: 'AlainPlantec 12/18/2009 13:53'!
systemFontAspectsAndLabels
	^ {#defaultFont -> 'Default font' translated. #listFont -> 'List font'  translated. #menuFont -> 'Menu font'  translated. #windowTitleFont -> 'Window title'  translated. #balloonFont -> 'Balloon help font'  translated. #codeFont -> 'Code font'  translated. #buttonFont -> 'Button font'  translated. #haloFont -> 'Halo font'  translated } ! !

!StandardFonts class methodsFor: 'font accessing' stamp: 'AlainPlantec 11/30/2009 09:36'!
balloonFont: aFont
	BalloonMorph balloonFont: aFont! !

!StandardFonts class methodsFor: 'font accessing' stamp: 'AlainPlantec 9/18/2011 09:29'!
getCurrentFontsSpec
	"self getCurrentFontsSpec "
	^ self systemFontAspects collect: [:aspect | | font |
		font := self perform: aspect.
		Array with: (aspect, ':') asSymbol with: font familyName with: font pointSize]! !

!StandardFonts class methodsFor: 'font accessing' stamp: 'AlainPlantec 11/30/2009 09:36'!
balloonFont
	^BalloonMorph balloonFont! !

!StandardFonts class methodsFor: 'font accessing' stamp: 'AlainPlantec 11/29/2009 11:55'!
menuFont
	^ MenuFont ifNil: [MenuFont := self defaultFont]! !

!StandardFonts class methodsFor: 'styles' stamp: 'MarcusDenker 10/2/2013 20:20'!
fontsSpecForStyleNamed: aSymbol
	| k small regular big |
	k := StrikeFont defaultFontKey.
	small := self smallPointSizeForStyleNamed: aSymbol.
	regular := self pointSizeForStyleNamed: aSymbol.
	big := self bigPointSizeForStyleNamed: aSymbol.
	^ {
			{#defaultFont:. k. regular }. 
			{#codeFont:. k. regular }.
			{#listFont:. k. regular }. 
			{#menuFont:. k. regular }. 
			{#windowTitleFont:. k. big }. 
			{#balloonFont:. k. small }. 
			{#haloFont:. k. small }.
			{#buttonFont:. k. regular } }
! !

!StandardFonts class methodsFor: 'choosing' stamp: 'AlainPlantec 9/17/2011 22:11'!
restoreDefaultFonts
	"Since this is called from menus, we can take the opportunity to prompt for missing font styles."
	"
	self restoreDefaultFonts
	"
	self setFontsToSmall! !

!StandardFonts class methodsFor: 'choosing' stamp: 'AlainPlantec 12/19/2009 17:51'!
chooseButtonFont
	self chooseStandardFont: #buttonFont! !

!StandardFonts class methodsFor: 'styles' stamp: 'AlainPlantec 9/18/2011 09:41'!
setFontsToVeryLarge
	self setFontsToStyleNamed: #verylarge! !

!StandardFonts class methodsFor: 'styles' stamp: 'AlainPlantec 9/18/2011 09:24'!
pointSizeForStyleNamed: aSymbol
	"
	self pointSizeForStyleNamed: #small.
	self pointSizeForStyleNamed: #Medium.
	self pointSizeForStyleNamed: #LARGE.
	self pointSizeForStyleNamed: #verylarge.
	self pointSizeForStyleNamed: #Huge.
	self pointSizeForStyleNamed: #xxxxx.
	"
	^ (#(#(#small 9) #(#medium 12) #(#large 14) #(veryLarge 18) #(huge 24)) 
		detect: [:info | info first asUppercase = aSymbol asUppercase] ifNone: []) 
			ifNotNil: [:info | info second]
	
		
! !

!StandardFonts class methodsFor: 'choosing' stamp: 'AlainPlantec 12/19/2009 17:52'!
setDemoFonts
	"StandardFonts setDemoFonts"
	|size font codeFont titleFont|

	size := UIManager default request: 'Base font size?' initialAnswer: '14'.
	size isEmptyOrNil ifTrue: [^ self].
	size := size asInteger.
	(size isNil or: [size <= 0]) ifTrue: [^ self].
	font := LogicalFont familyName: 'DejaVu Sans' pointSize: size.
	codeFont := LogicalFont familyName: 'DejaVu Sans Mono' pointSize: size.
	titleFont := LogicalFont familyName: 'DejaVu Serif' pointSize: size.

	StandardFonts
		listFont: font;
		menuFont: font;
		codeFont: codeFont;
		buttonFont: font;
		defaultFont: font;
		windowTitleFont: titleFont.! !

!StandardFonts class methodsFor: 'font accessing' stamp: 'AlainPlantec 11/30/2009 17:21'!
windowTitleFont: aFont
	WindowTitleFont := aFont! !

!StandardFonts class methodsFor: 'styles' stamp: 'AlainPlantec 9/18/2011 09:40'!
setFontsToStyleNamed: aSymbol
	self setFontsFromSpec: (self fontsSpecForStyleNamed: aSymbol)! !

!StandardFonts class methodsFor: 'font accessing' stamp: 'MarcusDenker 10/2/2013 20:20'!
setFontsFromSpec: fontsSpec
	"set some fonts by interpreting fontsSpec.
	fontsSpec is a collection.
	Each fontsSpec element is an array with 3 elements: 
	(1) the font accessor (i.e. #codeFont:)
	(2) the font family (i.e. 'Arial')
	(3) the font point size.
	To see an example of fontsSpec, inspect the result of 
	StandardFonts getCurrentFontsSpec.
	"
	| fontNames map emphases |
	fontNames := fontsSpec
				collect: [:array | array second].
	map := IdentityDictionary new.
	emphases := IdentityDictionary new.
	fontNames
		do: [:originalName | 
			| decoded style |
			decoded := TextStyle decodeStyleName: originalName.
			style := map
						at: originalName
						put: (TextStyle named: decoded second).
			emphases at: originalName put: decoded first.
			style
				ifNil: [map at: originalName put: TextStyle default]].
	fontsSpec
		do: [:triplet | self
				perform: triplet first
				with: (((map at: triplet second)
						fontOfPointSize: triplet third)
						emphasized: (emphases at: triplet second))]! !

!StandardFonts class methodsFor: 'choosing' stamp: 'AlainPlantec 12/19/2009 17:49'!
chooseListFont
	self chooseStandardFont: #listFont! !

!StandardFonts class methodsFor: 'choosing' stamp: 'AlainPlantec 12/19/2009 17:48'!
chooseDefaultFont
	self chooseStandardFont: #defaultFont! !

!StandardFonts class methodsFor: 'font accessing' stamp: 'AlainPlantec 11/29/2009 19:15'!
defaultFont
	^ TextStyle defaultFont! !

!StandardFonts class methodsFor: 'font accessing' stamp: 'AlainPlantec 11/28/2009 21:47'!
buttonFont
	^ ButtonFont ifNil: [ButtonFont := self defaultFont]! !

!StandardFonts class methodsFor: 'font accessing' stamp: 'MarcusDenker 7/23/2014 12:01'!
printStandardSystemFonts
	"self printStandardSystemFonts"

	| string |
	string := String streamContents: [ :s |

	StandardFonts systemFontAspects do: [:selector |
		| font |
		font := StandardFonts perform: selector.
		s
			nextPutAll: selector; space;
			nextPutAll: font familyName; space;
			nextPutAll: (AbstractFont emphasisStringFor: font emphasis);
			nextPutAll: ' points: ';
			print: font pointSize;
			nextPutAll: ' height: ';
			print: font height;
			cr
		]].
	UIManager default  
		longMessage: string
		title: 'Current system font settings' translated.
	! !

!StandardFonts class methodsFor: 'styles' stamp: 'AlainPlantec 9/18/2011 09:41'!
setFontsToHuge
	self setFontsToStyleNamed: #huge! !

!StandardFonts class methodsFor: 'styles' stamp: 'AlainPlantec 9/18/2011 09:59'!
bigPointSizeForStyleNamed: aSymbol
	| all s idx |
	StrikeFont defaultFontKey.
	all := TextStyle pointSizesFor: StrikeFont defaultFontKey.
	s := self pointSizeForStyleNamed: aSymbol.
	idx := all indexOf: s ifAbsent: [^ s].
	^ idx = all size
			ifTrue: [all at: idx]
			ifFalse: [all at: idx + 1]! !

!StandardFonts class methodsFor: 'font accessing' stamp: 'AlainPlantec 11/29/2009 10:07'!
buttonFont: aFont
	 ButtonFont := aFont! !

!StandardFonts class methodsFor: 'font accessing' stamp: 'GabrielOmarCotelli 12/4/2013 09:43'!
systemFontLabelOf: aSelector
	^ self systemFontAspectsAndLabels
		detect: [ :assoc | assoc key = aSelector ]
		ifFound: [ :assoc | assoc value ]
		ifNone: [ '' ]! !

!StandardFonts class methodsFor: 'choosing' stamp: 'AlainPlantec 12/19/2009 17:50'!
chooseWindowTitleFont
	self chooseStandardFont: #windowTitleFont! !

!StandardFonts class methodsFor: 'choosing' stamp: 'AlainPlantec 12/19/2009 17:50'!
chooseMenuFont
	self chooseStandardFont: #menuFont! !

!StandardFonts class methodsFor: 'choosing' stamp: 'AlainPlantec 12/19/2009 17:50'!
chooseBalloonFont
	self chooseStandardFont: #balloonFont! !

!StandardFonts class methodsFor: 'choosing' stamp: 'AlainPlantec 12/19/2009 17:49'!
chooseHaloFont
	self chooseStandardFont: #haloFont! !

!StandardFonts class methodsFor: 'font accessing' stamp: 'AlainPlantec 11/30/2009 17:19'!
haloFont
	^ HaloFont ifNil: [HaloFont := StandardFonts defaultFont]! !

!StandardFonts class methodsFor: 'font accessing' stamp: 'AlainPlantec 11/30/2009 17:20'!
haloFont: aFont
	HaloFont := aFont! !

!StandardFonts class methodsFor: 'choosing' stamp: 'AlainPlantec 12/19/2009 17:51'!
chooseCodeFont
	self chooseStandardFont: #codeFont! !

!StandardFonts class methodsFor: 'choosing' stamp: 'AlainPlantec 12/18/2009 13:59'!
chooseStandardFont: aSelector 
	self
		chooseFontWithTitle: (self systemFontLabelOf: aSelector)	, '...'
		for: self
		setSelector: (aSelector , ':') asSymbol
		getSelector: aSelector! !

!StandardFonts class methodsFor: 'styles' stamp: 'AlainPlantec 9/18/2011 09:41'!
setFontsToSmall
	self setFontsToStyleNamed: #small! !

!StandardFonts class methodsFor: 'font accessing' stamp: 'AlainPlantec 11/29/2009 10:22'!
codeFont
	^ CodeFont ifNil: [CodeFont := self defaultFont]! !

!StandardFonts class methodsFor: 'font accessing' stamp: 'AlainPlantec 11/29/2009 10:24'!
listFont: aFont
	 ListFont := aFont! !

!StandardFonts class methodsFor: 'font accessing' stamp: 'AlainPlantec 11/29/2009 10:24'!
listFont
	^ ListFont ifNil: [ListFont := self defaultFont]! !

!StandardFonts class methodsFor: 'font accessing' stamp: 'AlainPlantec 12/9/2009 08:46'!
setAllStandardFontsTo: aFont
	self systemFontAspects do: [:selector | StandardFonts perform: (selector, ':') asSymbol with: aFont].
	 
! !

!StandardFonts class methodsFor: 'font accessing' stamp: 'AlainPlantec 12/19/2009 18:10'!
systemFontLabels
	^ self systemFontAspectsAndLabels collect: [:assoc | assoc value]! !

!StandardFonts class methodsFor: 'styles' stamp: 'AlainPlantec 9/18/2011 09:41'!
setFontsToMedium
	self setFontsToStyleNamed: #medium! !

!StandardFonts class methodsFor: 'choosing' stamp: 'AlainPlantec 12/18/2009 13:58'!
chooseFontWithTitle: aTitle for: aReceiver setSelector: aSetSelector getSelector: aGetSelector
	FontChooser
		openWithWindowTitle: aTitle
		for: aReceiver
		setSelector: aSetSelector
		getSelector: aGetSelector! !

!StandardFonts class methodsFor: 'font accessing' stamp: 'AlainPlantec 11/29/2009 10:22'!
codeFont: aFont
	 CodeFont := aFont! !

!StandardSystemFontsTest methodsFor: 'utilities' stamp: 'AlainPlantec 12/20/2009 00:40'!
assert: selector familyName: aString pointSize: anInteger

	| font |
	font := StandardFonts perform: selector.
	self assert: font familyName = aString.
	self assert: font pointSize = anInteger
	! !

!StandardSystemFontsTest methodsFor: 'utilities' stamp: 'AlainPlantec 12/20/2009 00:47'!
saveStandardSystemFontsDuring: aBlock 
	| currentFontSpec |
	currentFontSpec := StandardFonts getCurrentFontsSpec.
	[aBlock value]
		ensure: [StandardFonts setFontsFromSpec: currentFontSpec] ! !

!StandardWindow commentStamp: 'AlainPlantec 10/17/2009 18:59'!
Themed SystemWindow that avoids being picked up except via the title bar. Supports opening in "fullscreen" mode, taking docking bars into account.
Prevents yellow button menu.
Uses TEasilyThemed for easy theme access to subclasses.!
!StandardWindow methodsFor: 'services' stamp: ''!
questionWithoutCancel: aStringOrText
	"Open a question dialog."

	^self questionWithoutCancel: aStringOrText title: 'Question' translated! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newWindowFor: aModel title: titleString
	"Answer a new window morph."
	
	^self theme
		newWindowIn: self
		for: aModel
		title: titleString! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newColorChooserFor: aModel getColor: getSel setColor: setSel help: helpText
	"Answer a color chooser with the given selectors."

	^self theme
		newColorChooserIn: self
		for: aModel
		getColor: getSel
		setColor: setSel
		getEnabled: nil
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newGroupbox
	"Answer a plain groupbox."

	^self theme
		newGroupboxIn: self! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newColorChooserFor: aModel getColor: getSel setColor: setSel getEnabled: enabledSel help: helpText
	"Answer a color chooser with the given selectors."

	^self theme
		newColorChooserIn: self
		for: aModel
		getColor: getSel
		setColor: setSel
		getEnabled: enabledSel
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newIncrementalSliderFor: aModel getValue: getSel setValue: setSel min: min max: max quantum: quantum getEnabled: enabledSel help: helpText
	"Answer an inremental slider with the given selectors."

	^self theme
		newIncrementalSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: min
		max: max
		quantum: quantum
		getEnabled: enabledSel
		help: helpText! !

!StandardWindow methodsFor: 'services' stamp: ''!
deny: aStringOrText
	"Open a denial dialog."

	^self deny: aStringOrText title: 'Access Denied' translated! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newLabelGroup: labelsAndControls font: aFont labelColor: aColor
	"Answer a morph laid out with a column of labels and a column of associated controls.
	Controls having a vResizing value of #spaceFill will
	cause their row to use #spaceFill also, otherwise #shrinkWrap."

	^self theme
		newLabelGroupIn: self
		for: labelsAndControls
		font: aFont
		labelColor: aColor
! !

!StandardWindow methodsFor: 'open/close' stamp: 'gvc 9/13/2006 09:55'!
openAsIsIn: aWorld
	"Sad fixup for dodgy layout."

	super openAsIsIn: aWorld.
	self allMorphs do: [:m | m layoutChanged]! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newCloseButton
	"Answer a new close button."

	^self newCloseButtonFor: self ! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newGroupbox: aString
	"Answer a groupbox with the given label."

	^self theme
		newGroupboxIn: self
		label: aString! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newSliderFor: aModel getValue: getSel setValue: setSel getEnabled: enabledSel help: helpText
	"Answer a slider with the given selectors."

	^self theme
		newSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: 0
		max: 1
		quantum: nil
		getEnabled: enabledSel
		help: helpText! !

!StandardWindow methodsFor: 'initialize' stamp: 'gvc 10/26/2006 10:37'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		setLabel: self defaultLabel;
		setWindowColor: self defaultColor! !

!StandardWindow methodsFor: 'services' stamp: ''!
fileOpen: title extensions: exts path: path
	"Answer the result of a file open dialog with the given title, extensions to show and path."

	^self 
		fileOpen: title
		extensions: exts
		path: path
		preview: nil! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newButtonFor: aModel getState: stateSel action: actionSel arguments: args getEnabled: enabledSel labelForm: aForm help: helpText
	"Answer a new button."

	^self theme
		newButtonIn: self for: aModel
		getState: stateSel
		action: actionSel
		arguments: args
		getEnabled: enabledSel 
		label: (AlphaImageMorph new image: aForm)
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: 'gvc 8/29/2006 16:53'!
title: aString
	"Set the window title."
	
	self setLabel: aString
	! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newPluggableDialogWindow: title
	"Answer a new pluggable dialog with the given content."

	^self
		newPluggableDialogWindow: title
		for: nil! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newPanel
	"Answer a new panel."

	^self theme
		newPanelIn: self! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newSVSelector: aColor help: helpText
	"Answer a saturation-volume selector with the given color."

	^self theme
		newSVSelectorIn: self
		color: aColor
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newListFor: aModel list: listSelector selected: getSelector changeSelected: setSelector help: helpText
	"Answer a list for the given model."

	^self
		newListFor: aModel
		list: listSelector
		selected: getSelector
		changeSelected: setSelector
		getEnabled: nil
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newMenu
	"Answer a new menu."

	^self theme
		newMenuIn: self
		for: self! !

!StandardWindow methodsFor: 'services' stamp: ''!
centeredAlert: aStringOrText title: aString configure: aBlock
	"Open an alert dialog.
	Configure the dialog with the 1 argument block
	before opening modally."

	^self theme
		centeredAlertIn: self
		text: aStringOrText
		title: aString
		configure: aBlock! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newMenuFor: aModel
	"Answer a new menu."

	^self theme
		newMenuIn: self
		for: aModel! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newBasicTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel menu: menuSelector
	"Answer a text editor for the given model."

	^self theme
		newBasicTextEditorIn: self
		for: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel
		menu: menuSelector! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newMorphDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel getEnabled: enabledSel useIndex: useIndex help: helpText
	"Answer a morph drop list for the given model."

	^self theme
		newMorphDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		useIndex: useIndex
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newRadioButtonFor: aModel getSelected: getSel setSelected: setSel getEnabled: enabledSel label: stringOrText help: helpText
	"Answer a checkbox (radio button appearance) with the given label."

	^self theme
		newRadioButtonIn: self
		for: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		label: stringOrText
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newStack: controls
	"Answer a morph laid out with a stack of controls."

	^self theme
		newStackIn: self
		for: controls! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newAlphaImage: aForm help: helpText
	"Answer an alpha image morph."

	^self theme
		newAlphaImageIn: self
		image: aForm
		help: helpText! !

!StandardWindow methodsFor: 'services' stamp: ''!
chooseFont
	"Answer the result of a font selector dialog."

	^self chooseFont: nil! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newButtonFor: aModel action: actionSel getEnabled: enabledSel label: stringOrText help: helpText
	"Answer a new button."

	^self
		newButtonFor: aModel
		getState: nil
		action: actionSel
		arguments: nil
		getEnabled: enabledSel 
		label: stringOrText
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newBalloonHelp: aTextStringOrMorph for: aMorph corner: cornerSymbol
	"Answer a new balloon help with the given contents for aMorph
	at a given corner."

	^self theme
		newBalloonHelpIn: self
		contents: aTextStringOrMorph
		for: aMorph
		corner: cornerSymbol! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newAlphaSelector: aModel getAlpha: getSel setAlpha: setSel help: helpText
	"Answer an alpha channel selector with the given selectors."

	^self theme
		newAlphaSelectorIn: self
		for: aModel
		getAlpha: getSel
		setAlpha: setSel
		help: helpText! !

!StandardWindow methodsFor: 'services' stamp: ''!
message: aStringOrText
	"Open a message dialog."

	^self message: aStringOrText title: 'Information' translated! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel menu: menuSelector
	"Answer a text editor for the given model."

	^self theme
		newTextEditorIn: self
		for: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel
		menu: menuSelector! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newBasicTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel
	"Answer a text editor for the given model."

	^self
		newBasicTextEditorFor: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel
		menu: nil! !

!StandardWindow methodsFor: 'services' stamp: ''!
chooseDirectory: title path: path
	"Answer the result of a file dialog with the given title, answer a directory."

	^self theme
		chooseDirectoryIn: self
		title: title
		path: path! !

!StandardWindow methodsFor: 'services' stamp: ''!
longMessage: aStringOrText title: aString
	"Open a (long) message dialog."

	^self theme
		longMessageIn: self
		text: aStringOrText
		title: aString! !

!StandardWindow methodsFor: 'open/close' stamp: 'BenjaminVanRyseghem 7/31/2013 14:16'!
delete
	"If fullscreen remove the owner too."
	
	self mustNotClose ifTrue: [^ self].
	self model ifNotNil: [ 
		self model okToChange ifFalse: [ ^ self ].
		self model okToClose ifFalse: [ ^ self ] ].
	self isFullscreen
		ifTrue: [self owner delete]
		ifFalse: [super delete]! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newCheckboxFor: aModel getSelected: getSel setSelected: setSel getEnabled: enabledSel label: stringOrText help: helpText
	"Answer a checkbox with the given label."

	^self theme
		newCheckboxIn: self
		for: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		label: stringOrText
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel font: aFont help: helpText
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel
		font: aFont
		help: helpText! !

!StandardWindow methodsFor: 'open/close' stamp: 'gvc 10/26/2006 12:07'!
open
	"Where else would you want to open it?."

	self openInWorld! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newDialogPanel
	"Answer a new main dialog panel."

	^self theme
		newDialogPanelIn: self! !

!StandardWindow methodsFor: 'services' stamp: ''!
chooseColor: aColor title: title
	"Answer the result of a color selector dialog with the given title and initial colour."

	^self theme
		chooseColorIn: self
		title: title
		color: aColor! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newCheckboxFor: aModel getSelected: getSel setSelected: setSel label: stringOrText help: helpText
	"Answer a checkbox with the given label."

	^self theme
		newCheckboxIn: self
		for: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: nil
		label: stringOrText
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newCancelButtonFor: aModel
	"Answer a new cancel button."

	^self theme
		newCancelButtonIn: self
		for: aModel! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newButtonFor: aModel getState: stateSel action: actionSel arguments: args getEnabled: enabledSel label: stringOrText help: helpText
	"Answer a new button."

	^self theme
		newButtonIn: self for: aModel
		getState: stateSel
		action: actionSel
		arguments: args
		getEnabled: enabledSel 
		label: stringOrText
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newPluggableDialogWindow: title for: contentMorph
	"Answer a new pluggable dialog with the given content."

	^self theme
		newPluggableDialogWindowIn: self
		title: title
		for: contentMorph! !

!StandardWindow methodsFor: 'layout' stamp: 'gvc 9/14/2006 16:49'!
layoutBounds
	"Bounds of pane area only."
	
	^self isFullscreen
		ifTrue: [self perform: #layoutBounds withArguments: #() inSuperclass: Morph]
		ifFalse: [super layoutBounds]! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newOKButton
	"Answer a new OK button."

	^self newOKButtonFor: self! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newGroupbox: aString for: control
	"Answer a groupbox with the given label and control."

	^self theme
		newGroupboxIn: self
		label: aString
		for: control! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newFuzzyLabelFor: aModel label: aString getEnabled: enabledSel
	"Answer a new fuzzy label."

	^self theme
		newFuzzyLabelIn: self
		for: aModel
		label: aString
		offset: 1
		alpha: 0.5
		getEnabled: enabledSel! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel help: helpText entryCompletion: anEntryCompletion
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel
		help: helpText
		entryCompletion: anEntryCompletion! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newYesButton
	"Answer a new Yes button."

	^self newYesButtonFor: self! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel 
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newEditableDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel addToList: addSel class: aClass default: defaultValue ghostText: ghostText getEnabled: enabledSel useIndex: useIndex help: helpText
	"Answer an editable drop list for the given model."

	^self theme
		newEditableDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		addToList: addSel
		class: aClass
		default: defaultValue
		ghostText: ghostText
		getEnabled: enabledSel
		useIndex: useIndex
		help: helpText! !

!StandardWindow methodsFor: 'services' stamp: ''!
chooseColor
	"Answer the result of a color selector dialog ."

	^self chooseColor: Color black! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newMorphDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel help: helpText
	"Answer a morph drop list for the given model."

	^self 
		newMorphDropListFor: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: nil
		useIndex: true
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newListFor: aModel list: listSelector selected: getSelector changeSelected: setSelector icon: iconSelector getEnabled: enabledSel help: helpText
	"Answer a list for the given model."

	^self theme
		newListIn: self
		for: aModel
		list: listSelector
		selected: getSelector
		changeSelected: setSelector
		icon: iconSelector
		getEnabled: enabledSel
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newString: aStringOrText font: aFont style: aStyle
	"Answer a new embossed string."

	^self theme
		newStringIn: self
		label: aStringOrText
		font: aFont
		style: aStyle! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newCheckboxFor: aModel getSelected: getSel setSelected: setSel getEnabled: enabledSel getLabel: labelSel help: helpText
	"Answer a checkbox with the given label."

	^self theme
		newCheckboxIn: self
		for: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		getLabel: labelSel
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newMorphDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel getEnabled: enabledSel help: helpText
	"Answer a morph drop list for the given model."

	^self 
		newMorphDropListFor: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		useIndex: true
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel getEnabled: enabledSel useIndex: useIndex help: helpText
	"Answer a drop list for the given model."

	^self theme
		newDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		useIndex: useIndex
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel 
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newToolbar
	"Answer a toolbar."

	^self theme
		newToolbarIn: self! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel help: helpText
	"Answer a drop list for the given model."

	^self
		newDropListFor: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: nil
		useIndex: true
		help: helpText! !

!StandardWindow methodsFor: 'services' stamp: ''!
chooseFont: aFont 
	"Answer the result of a font selector dialog with the given initial font."

	^self theme
		chooseFontIn: self
		title: 'Font Selector' translated
		font: aFont! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newCloseButtonFor: aModel
	"Answer a new close button."

	^self theme
		newCloseButtonIn: self
		for: aModel! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newVerticalSeparator
	"Answer a vertical separator."

	^self theme
		newVerticalSeparatorIn: self! !

!StandardWindow methodsFor: 'services' stamp: ''!
proceed: aStringOrText
	"Open a proceed dialog."

	^self proceed: aStringOrText title: 'Proceed' translated! !

!StandardWindow methodsFor: 'services' stamp: ''!
fileSave: title path: path
	"Answer the result of a file save open dialog with the given title."

	^self
		fileSave: title
		extensions: nil
		path: path! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newHSVASelector: aColor help: helpText
	"Answer a hue-saturation-volume selector with the given color."

	^self theme
		newHSVASelectorIn: self
		color: aColor
		help: helpText! !

!StandardWindow methodsFor: 'services' stamp: ''!
deny: aStringOrText title: aString
	"Open a denial dialog."

	^self theme
		denyIn: self
		text: aStringOrText
		title: aString! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newScrollPaneFor: aMorph
	"Answer a new scroll pane morph to scroll the given morph."
	
	^self theme
		newScrollPaneIn: self
		for: aMorph! !

!StandardWindow methodsFor: 'services' stamp: ''!
chooseColor: aColor 
	"Answer the result of a color selector dialog with the given color."

	^self theme
		chooseColorIn: self
		title: 'Colour Selector' translated
		color: aColor! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newPluggableDialogWindow
	"Answer a new pluggable dialog."

	^self
		newPluggableDialogWindow: 'Dialog'! !

!StandardWindow methodsFor: 'testing' stamp: 'gvc 9/14/2006 16:47'!
isFullscreen
	"Answer whether the window should be draw as fullscreen, i.e.
	no title bar or borders."

	^self owner isKindOf: FullscreenMorph! !

!StandardWindow methodsFor: 'services' stamp: ''!
alert: aStringOrText title: aString configure: aBlock
	"Open an alert dialog.
	Configure the dialog with the 1 argument block
	before opening modally."

	^self theme
		alertIn: self
		text: aStringOrText
		title: aString
		configure: aBlock! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newOKButtonFor: aModel
	"Answer a new OK button."

	^self
		newOKButtonFor: aModel
		getEnabled: nil! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newButtonLabelFor: aModel label: aString getEnabled: enabledSel
	"Answer a new button text label."

	^self theme
		newButtonLabelIn: self
		for: aModel
		label: aString
		getEnabled: enabledSel! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newCancelButton
	"Answer a new cancel button."

	^self newCancelButtonFor: self! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newString: aStringOrText style: aStyle
	"Answer a new embossed string."

	^self theme
		newStringIn: self
		label: aStringOrText
		font: self theme labelFont
		style: aStyle! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newHueSelector: aModel getHue: getSel setHue: setSel help: helpText
	"Answer a hue selector with the given selectors."

	^self theme
		newHueSelectorIn: self
		for: aModel
		getHue: getSel
		setHue: setSel
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newEditableDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel addToList: addSel ghostText: ghostText getEnabled: enabledSel help: helpText
	"Answer an editable drop list for the given model."

	^self theme
		newEditableDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		addToList: addSel
		class: String
		default: ''
		ghostText: ghostText
		getEnabled: enabledSel
		useIndex: false
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newGroupboxFor: control
	"Answer a plain groupbox with the given control."

	^self theme
		newGroupboxIn: self
		for: control! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newOverflowRowForAll: aCollectionOfMorphs
	"Answer a new overflow row morph that provides a drop down for
	the given contents that are unable to fit the bounds."
	
	^self theme
		newOverflowRowIn: self
		forAll: aCollectionOfMorphs! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newEmbeddedMenu
	"Answer a new menu."

	^self theme
		newEmbeddedMenuIn: self
		for: self! !

!StandardWindow methodsFor: 'initialize' stamp: 'gvc 10/26/2006 10:36'!
defaultColor
	"Answer the default color/fill style for the receiver"
	
	^self theme windowColor! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newSliderFor: aModel getValue: getSel setValue: setSel help: helpText
	"Answer a slider with the given selectors."

	^self theme
		newSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: 0
		max: 1
		quantum: nil
		getEnabled: nil
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newButtonFor: aModel getState: stateSel action: actionSel arguments: args getEnabled: enabledSel getLabel: labelSel help: helpText
	"Answer a new button."

	^self theme
		newButtonIn: self for: aModel
		getState: stateSel
		action: actionSel
		arguments: args
		getEnabled: enabledSel 
		getLabel: labelSel
		help: helpText! !

!StandardWindow methodsFor: 'services' stamp: ''!
fileOpen: title
	"Answer the result of a file open dialog with the given title."

	^self
		fileOpen: title
		extensions: nil! !

!StandardWindow methodsFor: 'services' stamp: ''!
message: aStringOrText title: aString
	"Open a message dialog."

	^self theme
		messageIn: self
		text: aStringOrText
		title: aString! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newTabGroup: labelsAndPages
	"Answer a tab group with the given tab labels associated with pages."

	^self theme
		newTabGroupIn: self
		for: labelsAndPages! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newMorphListFor: aModel list: listSelector getSelected: getSelector setSelected: setSelector getEnabled: enabledSel help: helpText
	"Answer a morph list for the given model."

	^self theme
		newMorphListIn: self
		for: aModel
		list: listSelector
		getSelected: getSelector
		setSelected: setSelector
		getEnabled: enabledSel
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newNoButtonFor: aModel
	"Answer a new No button."

	^self theme
		newNoButtonIn: self
		for: aModel! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel font: aFont help: helpText entryCompletion: anEntryCompletion
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel
		font: aFont
		help: helpText
		entryCompletion: anEntryCompletion
! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newBasicTextEditorFor: aModel getText: getSel setText: setSel
	"Answer a text editor for the given model."

	^self
		newBasicTextEditorFor: aModel
		getText: getSel
		setText: setSel
		getEnabled: nil! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newImage: aForm size: aPoint
	"Answer a new image."

	^self theme
		newImageIn: self
		form: aForm
		size: aPoint! !

!StandardWindow methodsFor: 'services' stamp: ''!
textEntry: aStringOrText title: aString entryText: defaultEntryText
	"Open a text entry dialog."

	^self theme
		textEntryIn: self
		text: aStringOrText
		title: aString
		entryText: defaultEntryText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newImage: aForm
	"Answer a new image."

	^self theme
		newImageIn: self
		form: aForm! !

!StandardWindow methodsFor: 'services' stamp: ''!
chooseDropList: aStringOrText list: aList
	"Open a drop list chooser dialog."

	^self
		chooseDropList: aStringOrText
		title: 'Choose' translated
		list: aList! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newImageFor: aModel get: getSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newImageIn: self
		for: aModel
		get: getSel
		help: helpText! !

!StandardWindow methodsFor: 'testing' stamp: 'GaryChambers 12/19/2011 15:52'!
isActive
	"Answer active if fullscreen too."
	
	^self isFullscreen or: [super isActive]! !

!StandardWindow methodsFor: 'services' stamp: ''!
alert: aStringOrText title: aString
	"Open an alert dialog."

	^self
		alert: aStringOrText
		title: aString
		configure: [:d | ]! !

!StandardWindow methodsFor: 'services' stamp: ''!
alert: aStringOrText
	"Open an alert dialog."

	^self alert: aStringOrText title: 'Alert' translated! !

!StandardWindow methodsFor: 'services' stamp: ''!
proceed: aStringOrText title: aString
	"Open a proceed dialog and answer true if not cancelled, false otherwise."

	^self theme
		proceedIn: self
		text: aStringOrText
		title: aString! !

!StandardWindow methodsFor: 'submorphs-accessing' stamp: 'gvc 5/7/2008 11:45'!
noteNewOwner: aMorph 
	"Go fullscreen if needed."

	super noteNewOwner: aMorph.
	(self isFullscreen and: [labelArea owner notNil]) ifTrue: [
		self
			beWithoutGrips;
			removeLabelArea;
			makeBorderless.
		(self submorphs size = 1 and: [self submorphs first isKindOf: PanelMorph])
			ifTrue: [self submorphs first roundedCorners: #()]]! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel
	"Answer a text editor for the given model."

	^self theme
		newAutoAcceptTextEditorIn: self
		for: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newBalloonHelp: aTextStringOrMorph for: aMorph
	"Answer a new balloon help with the given contents for aMorph
	at a given corner."

	^self theme
		newBalloonHelpIn: self
		contents: aTextStringOrMorph
		for: aMorph
		corner: #bottomLeft! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newTreeFor: aModel list: listSelector selected: getSelector changeSelected: setSelector
	"Answer a new tree morph."
	
	^self theme
		newTreeIn: self
		for: aModel
		list: listSelector
		selected: getSelector
		changeSelected: setSelector! !

!StandardWindow methodsFor: 'event handling' stamp: 'CamilloBruni 2/4/2012 14:44'!
yellowButtonActivity: shiftState 
	"Do nothing."
	^ false! !

!StandardWindow methodsFor: 'services' stamp: ''!
abort: aStringOrText
	"Open an error dialog."

	^self abort: aStringOrText title: 'Error' translated! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newColorPresenterFor: aModel getColor: getSel help: helpText
	"Answer a color presenter with the given selectors."

	^self theme
		newColorPresenterIn: self
		for: aModel
		getColor: getSel
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newBracketSliderFor: aModel getValue: getSel setValue: setSel min: minValue max: maxValue quantum: quantum getEnabled: enabledSel help: helpText
	"Answer a bracket slider with the given selectors."

	^self theme
		newBracketSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: minValue
		max: maxValue
		quantum: quantum
		getEnabled: enabledSel
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newButtonFor: aModel action: actionSel label: stringOrText help: helpText
	"Answer a new button."

	^self
		newButtonFor: aModel
		getState: nil
		action: actionSel
		arguments: nil
		getEnabled: nil 
		label: stringOrText
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newOKButtonFor: aModel getEnabled: enabledSel
	"Answer a new OK button."

	^self theme
		newOKButtonIn: self
		for: aModel
		getEnabled: enabledSel! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newMorphListFor: aModel list: listSelector getSelected: getSelector setSelected: setSelector help: helpText
	"Answer a morph list for the given model."

	^self
		newMorphListFor: aModel
		list: listSelector
		getSelected: getSelector
		setSelected: setSelector
		getEnabled: nil
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newText: aStringOrText
	"Answer a new text."

	^self theme
		newTextIn: self
		text: aStringOrText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel font: aFont help: helpText
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel
		font: aFont
		help: helpText
! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel help: helpText entryCompletion: anEntryCompletion

	"Answer a text entry for the given model."

	^self theme
		newTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel 
		help: helpText
		entryCompletion: anEntryCompletion! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel getEnabled: enabledSel help: helpText
	"Answer a drop list for the given model."

	^self theme
		newDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		useIndex: true
		help: helpText! !

!StandardWindow methodsFor: 'services' stamp: ''!
fileSave: title extensions: exts path: path
	"Answer the result of a file save dialog with the given title, extensions to show and path."

	^self theme
		fileSaveIn: self
		title: title
		extensions: exts
		path: path! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newLabelFor: aModel label: aString getEnabled: enabledSel
	"Answer a new text label."

	^self theme
		newLabelIn: self
		for: aModel
		label: aString
		getEnabled: enabledSel! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel help: helpText entryCompletion: anEntryCompletion
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel
		help: helpText
		entryCompletion: anEntryCompletion! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newNoButton
	"Answer a new No button."

	^self newNoButtonFor: self! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newLabel: aString
	"Answer a new text label."

	^self
		newLabelFor: nil
		label: aString
		getEnabled: nil! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newHSVSelector: aColor help: helpText
	"Answer a hue-saturation-volume selector with the given color."

	^self theme
		newHSVSelectorIn: self
		color: aColor
		help: helpText! !

!StandardWindow methodsFor: 'initialize' stamp: 'ChristopheDemarey 9/26/2014 14:01'!
withText: aStringOrText label: title 
	
	self title: title.
	self 
		addMorph: (PluggableTextMorph on: aStringOrText 
			text: #contents
			accept: nil
			readSelection: nil 
			menu: nil)
	fullFrame: LayoutFrame identity.						
	self themeChanged.
! !

!StandardWindow methodsFor: 'morphic ui' stamp: 'gvc 9/14/2006 19:20'!
wantsRoundedCorners
	"Check to see if the property is set first."
	
	^self isFullscreen
		ifTrue: [false]
		ifFalse: [^super wantsRoundedCorners]! !

!StandardWindow methodsFor: 'accessing' stamp: 'gvc 9/29/2006 12:12'!
model: anObject
	"Reset the minimum extent."

	super model: anObject.
	self title: self title! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newLabelGroup: labelsAndControls
	"Answer a morph laid out with a column of labels and a column of associated controls.
	Controls having a vResizing value of #spaceFill will
	cause their row to use #spaceFill also, otherwise #shrinkWrap."

	^self theme
		newLabelGroupIn: self
		for: labelsAndControls! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newRow: controls
	"Answer a morph laid out with a row of controls."

	^self theme
		newRowIn: self
		for: controls! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newTextEditorFor: aModel getText: getSel setText: setSel
	"Answer a text editor for the given model."

	^self
		newTextEditorFor: aModel
		getText: getSel
		setText: setSel
		getEnabled: nil! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newTitle: aString for: control
	"Answer a morph laid out with a column with a title."

	^self theme
		newTitleIn: self
		label: aString
		for: control! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newExpander: aString for: aControl
	"Answer an expander with the given label and control."

	^self theme
		newExpanderIn: self
		label: aString
		forAll: {aControl}! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newMultistateButton
	"Answer a new multistate button morph.
	To be usable it needs to have fill styles assigned to various states along
	with mouse-up/down actions."
	
	^self theme
		newMultistateButtonIn: self! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newColumn: controls
	"Answer a morph laid out with a column of controls."

	^self theme
		newColumnIn: self
		for: controls! !

!StandardWindow methodsFor: 'services' stamp: ''!
question: aStringOrText title: aString
	"Open a question dialog and answer true if yes,
	false if no and nil if cancelled."

	^self theme
		questionIn: self
		text: aStringOrText
		title: aString! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newGroupboxForAll: controls
	"Answer a plain groupbox with the given controls."

	^self theme
		newGroupboxIn: self
		forAll: controls! !

!StandardWindow methodsFor: 'services' stamp: ''!
fileOpen: title extensions: exts path: path preview: preview
	"Answer the result of a file open dialog with the given title, extensions to show, path and preview type."

	^self theme
		fileOpenIn: self
		title: title
		extensions: exts
		path: path
		preview: preview! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newBracketSliderFor: aModel getValue: getSel setValue: setSel min: minValue max: maxValue quantum: quantum help: helpText
	"Answer a bracket slider with the given selectors."

	^self
		newBracketSliderFor: aModel
		getValue: getSel
		setValue: setSel
		min: minValue
		max: maxValue
		quantum: quantum 
		getEnabled: nil
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newToolDockingBar
	"Answer a tool docking bar."

	^self theme
		newToolDockingBarIn: self! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newAutoAcceptTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel font: aFont help: helpText entryCompletion: anEntryCompletion
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel
		font: aFont
		help: helpText
		entryCompletion: anEntryCompletion! !

!StandardWindow methodsFor: 'services' stamp: ''!
textEntry: aStringOrText title: aString
	"Open a text entry dialog."

	^self
		textEntry: aStringOrText
		title: aString
		entryText: ''! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel 
	"Answer a text editor for the given model."

	^self 
		newTextEditorFor: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel
		menu: nil! !

!StandardWindow methodsFor: 'controls' stamp: 'gvc 8/2/2007 13:47'!
newTextEntryFor: aModel getText: getSel setText: setSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: nil 
		help: helpText! !

!StandardWindow methodsFor: 'services' stamp: ''!
chooseDirectory: title 
	"Answer the result of a file dialog with the given title, answer a directory."

	^self
		chooseDirectory: title
		path: nil! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newLabelFor: aModel getLabel: labelSel getEnabled: enabledSel
	"Answer a new text label."

	^self theme
		newLabelIn: self
		for: aModel
		getLabel: labelSel
		getEnabled: enabledSel! !

!StandardWindow methodsFor: 'services' stamp: ''!
fileSave: title extensions: exts
	"Answer the result of a file save dialog with the given title."

	^self
		fileSave: title
		extensions: exts
		path: nil! !

!StandardWindow methodsFor: 'operations' stamp: 'gvc 9/12/2006 16:26'!
flash
	"Flash the window."
	
	|fs c w d|
	fs := self fillStyle.
	c := self color alphaMixed: 0.5 with: Color white.
	w := self world.
	d := 0.
	2 timesRepeat: [
		(Delay forDuration: d milliSeconds) wait.
		d := 200.
		self color: c.
		w ifNotNil: [w displayWorldSafely].
		(Delay forDuration: d milliSeconds) wait.
		self fillStyle: fs.
		w ifNotNil: [w displayWorldSafely]]
! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newSeparator
	"Answer an horizontal separator."

	^self theme
		newSeparatorIn: self! !

!StandardWindow methodsFor: 'controls' stamp: 'gvc 9/29/2006 12:11'!
title
	"Answer tht window title."
	
	^self label! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newCloseControlFor: aModel action: aValuable help: helpText
	"Answer a new cancel button."

	^self theme
		newCloseControlIn: self
		for: aModel
		action: aValuable
		help: helpText! !

!StandardWindow methodsFor: 'services' stamp: ''!
chooseDropList: aStringOrText title: aString list: aList
	"Open a drop list chooser dialog."

	^self theme
		chooseDropListIn: self
		text: aStringOrText
		title: aString
		list: aList! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newExpander: aString
	"Answer an expander with the given label."

	^self theme
		newExpanderIn: self
		label: aString
		forAll: #()! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newSliderFor: aModel getValue: getSel setValue: setSel min: min max: max quantum: quantum getEnabled: enabledSel help: helpText
	"Answer a slider with the given selectors."

	^self theme
		newSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: min
		max: max
		quantum: quantum
		getEnabled: enabledSel
		help: helpText! !

!StandardWindow methodsFor: 'services' stamp: ''!
fileSave: title
	"Answer the result of a file save dialog with the given title."

	^self
		fileSave: title
		extensions: nil
		path: nil! !

!StandardWindow methodsFor: 'services' stamp: ''!
question: aStringOrText
	"Open a question dialog."

	^self question: aStringOrText title: 'Question' translated! !

!StandardWindow methodsFor: 'morphic ui' stamp: 'gvc 2/26/2010 12:56'!
mouseMove: evt
	"Handle a mouse-move event"

	self isFullscreen ifTrue: [^self]. "do nothing if fullscreen"
	^super mouseMove: evt! !

!StandardWindow methodsFor: 'services' stamp: ''!
textEntry: aStringOrText
	"Open a text entry dialog."

	^self textEntry: aStringOrText title: 'Entry' translated! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newListFor: aModel list: listSelector selected: getSelector changeSelected: setSelector getEnabled: enabledSel help: helpText
	"Answer a list for the given model."

	^self theme
		newListIn: self
		for: aModel
		list: listSelector
		selected: getSelector
		changeSelected: setSelector
		getEnabled: enabledSel
		help: helpText! !

!StandardWindow methodsFor: 'open/close' stamp: 'gvc 5/18/2007 12:01'!
openFullscreen
	"Open the receiver in a FullscreenMorph."

	^FullscreenMorph new
		setContentMorph: self;
		openInWorld! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newString: aStringOrText
	"Answer a new embossed string."

	^self theme
		newStringIn: self
		label: aStringOrText
		font: self theme labelFont
		style: #plain! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newExpander: aString forAll: controls
	"Answer an expander with the given label and controls."

	^self theme
		newExpanderIn: self
		label: aString
		forAll: controls! !

!StandardWindow methodsFor: 'services' stamp: ''!
questionWithoutCancel: aStringOrText title: aString
	"Open a question dialog and answer true if yes,
	false if no and nil if cancelled."

	^self theme
		questionWithoutCancelIn: self
		text: aStringOrText
		title: aString! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newButtonLabel: aString
	"Answer a new button text label."

	^self
		newButtonLabelFor: nil
		label: aString
		getEnabled: nil! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newToolbar: controls
	"Answer a toolbar with the given controls."

	^self theme
		newToolbarIn: self
		for: controls! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newGroupbox: aString forAll: controls
	"Answer a groupbox with the given label and controls."

	^self theme
		newGroupboxIn: self
		label: aString
		forAll: controls! !

!StandardWindow methodsFor: 'testing' stamp: 'gvc 9/19/2006 13:00'!
openedFullscreen
	"Should activate and update the layout."

	self allMorphs do: [:m | m layoutChanged].
	self activate! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newToolSpacer
	"Answer a tool spacer."

	^self theme
		newToolSpacerIn: self! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newFuzzyLabel: aString
	"Answer a new fuzzy label."

	^self theme
		newFuzzyLabelIn: self
		for: nil
		label: aString
		offset: 1
		alpha: 0.5
		getEnabled: nil! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newRow
	"Answer a morph laid out as a row."

	^self theme
		newRowIn: self
		for: #()! !

!StandardWindow methodsFor: 'services' stamp: ''!
fileOpen: title extensions: exts
	"Answer the result of a file open dialog with the given title and extensions to show."

	^self
		fileOpen: title
		extensions: exts
		path: nil! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newStack
	"Answer a morph laid out as a stack."

	^self theme
		newStackIn: self
		for: #()! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newFuzzyLabelFor: aModel label: aString offset: offset alpha: alpha getEnabled: enabledSel
	"Answer a new fuzzy label."

	^self theme
		newFuzzyLabelIn: self
		for: aModel
		label: aString
		offset: offset
		alpha: alpha
		getEnabled: enabledSel! !

!StandardWindow methodsFor: 'morphic ui' stamp: 'gvc 10/26/2006 10:33'!
defaultLabel
	"Answer the default label for the receiver."

	^'Window' translated! !

!StandardWindow methodsFor: 'services' stamp: ''!
chooseFileName: title extensions: exts path: path preview: preview
	"Answer the result of a file name chooser dialog with the given title, extensions
	to show, path and preview type."

	^self theme
		chooseFileNameIn: self
		title: title
		extensions: exts
		path: path
		preview: preview! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newRadioButtonFor: aModel getSelected: getSel setSelected: setSel label: stringOrText help: helpText
	"Answer a checkbox (radio button appearance) with the given label."

	^self
		newRadioButtonFor: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: nil
		label: stringOrText
		help: helpText! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newYesButtonFor: aModel
	"Answer a new yes button."

	^self theme
		newYesButtonIn: self
		for: aModel! !

!StandardWindow methodsFor: 'controls' stamp: ''!
newToolbarHandle
	"Answer a toolbar handle."

	^self theme
		newToolbarHandleIn: self! !

!StandardWindow methodsFor: 'services' stamp: ''!
abort: aStringOrText title: aString
	"Open an error dialog."

	^self theme
		abortIn: self
		text: aStringOrText
		title: aString! !

!StandardWindow class methodsFor: 'instance creation' stamp: 'EstebanLorenzano 5/15/2014 14:39'!
newWithTheme: aUITheme
	"Answer a new window with the given theme."

	^ self basicNew
		basicTheme: aUITheme;
		initialize! !

!StartupAction commentStamp: '<historical>'!
I am an atomic item used to execute a portion of code at image startup.!
!StartupAction methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/1/2011 10:06'!
code

	^ code! !

!StartupAction methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/1/2011 10:05'!
hasBeenExecuted: anObject
	
	hasBeenExecuted := anObject! !

!StartupAction methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/1/2011 10:05'!
code: anObject
	
	code := anObject! !

!StartupAction methodsFor: 'accessing' stamp: 'IgorStasenko 2/4/2012 19:07'!
= anObject

	anObject class = self class ifFalse: [ ^ false ].
	^ self code = anObject code and: [ self name = anObject name and: [ self runOnce = anObject runOnce ]]! !

!StartupAction methodsFor: 'printing' stamp: 'GuillermoPolito 9/24/2012 10:39'!
storeOn: aStream

	aStream << self class name << ' name: '<< self name printString <<' code: ' << code printString.
	self runOnce ifTrue: [ aStream << ' runOnce: true']! !

!StartupAction methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/1/2011 10:06'!
hasBeenExecuted

	^ hasBeenExecuted ifNil: [ hasBeenExecuted := false ]! !

!StartupAction methodsFor: 'accessing' stamp: 'IgorStasenko 2/4/2012 19:07'!
name: anObject
	
	name := anObject! !

!StartupAction methodsFor: 'printing' stamp: 'IgorStasenko 2/4/2012 19:07'!
printOn: aStream

	aStream <<'a ' << self class name << '(' << self name << ')'! !

!StartupAction methodsFor: 'execution' stamp: 'CamilloBruni 9/16/2013 01:18'!
execute

	| block correctlyExecuted |
	(self hasBeenExecuted and: [ self runOnce ]) ifTrue: [ ^ self ].
	block := self code isBlock
				ifTrue: [ self code ]
				ifFalse: [[ self class compiler evaluate: self code ]].
	correctlyExecuted := true. 
	block on: Halt, Error do: [ :ex | 
		StartupPreferencesLoader default errors add: {ex. self}.
		ex pass ].
	self hasBeenExecuted: correctlyExecuted.! !

!StartupAction methodsFor: 'accessing' stamp: 'IgorStasenko 2/4/2012 18:10'!
runOnce

	^ runOnce ifNil: [ runOnce := false ]! !

!StartupAction methodsFor: 'accessing' stamp: 'IgorStasenko 2/4/2012 19:07'!
name

	^ name! !

!StartupAction methodsFor: 'accessing' stamp: 'IgorStasenko 2/4/2012 18:11'!
runOnce: anObject
	
	runOnce := anObject! !

!StartupAction class methodsFor: 'instance creation' stamp: 'IgorStasenko 2/4/2012 19:09'!
name: nameOfItem code: code runOnce: aBoolean

	^ self new
		code: code;
		name: nameOfItem;
		runOnce: aBoolean;
		yourself! !

!StartupAction class methodsFor: 'instance creation' stamp: 'IgorStasenko 2/4/2012 19:09'!
name: nameOfItem code: code

	^ self new
		code: code;
		name: nameOfItem;
		yourself! !

!StartupLoader commentStamp: '<historical>'!
Deprecated => use StartupPreferenceLoader!
!StartupLoader class methodsFor: 'accessing' stamp: 'CamilloBruni 9/16/2013 01:31'!
default
	^ StartupPreferencesLoader default! !

!StartupPreferencesHandler commentStamp: '<historical>'!
I manage the links of the chain of responsibilites to retrieve the good preference file.!
!StartupPreferencesHandler methodsFor: 'initialization' stamp: 'SeanDeNigris 8/4/2012 10:48'!
initialize

	super initialize.
	actions := self buildActionList.! !

!StartupPreferencesHandler methodsFor: 'actions' stamp: 'EstebanLorenzano 1/24/2014 16:34'!
lookInGeneralPreferencesFolder

	^ StartupPreferencesLoader preferencesGeneralFolder 
		ifNotNil: [ :folder | self lookInFolder:  folder forFilesMatching: '*.st' ].! !

!StartupPreferencesHandler methodsFor: 'actions' stamp: 'CamilloBruni 9/16/2013 01:18'!
lookInImageFolder

	^ self 
		lookInFolder: FileSystem workingDirectory 
		forFilesMatching: StartupPreferencesLoader startupScriptName.! !

!StartupPreferencesHandler methodsFor: 'actions' stamp: 'SeanDeNigris 8/4/2012 10:48'!
buildActionList
	"All found files will be executed."
	
	| directories |
	directories := OrderedCollection new.
	directories add: [ self lookInGeneralPreferencesFolder ].
	directories add: [ self lookInPreferencesVersionFolder ].
	directories add: [ self lookInImageFolder ].
	^ directories! !

!StartupPreferencesHandler methodsFor: 'private' stamp: 'CamilloBruni 5/4/2013 23:14'!
lookInFolder: folder

	| result |

	self flag: 'I should be #lookInFolder:forFilesMatching:, so that #lookInImageFolder can delegate to me, like the other two lookup methods'.
	result := OrderedCollection new.
	folder isDirectory ifFalse: [ ^ nil ].
	
	"To filter resources files such as .DS_Store"
	folder fileNames do: [:name |
		name first = $.
			ifFalse: [ result add: (folder / name)]].

	^ result isEmpty
		ifTrue: [ nil ]
		ifFalse: [ result ]! !

!StartupPreferencesHandler methodsFor: 'actions' stamp: 'EstebanLorenzano 1/24/2014 16:34'!
lookInPreferencesVersionFolder

	^ StartupPreferencesLoader preferencesVersionFolder 
		ifNotNil: [ :folder | 
			self 
				lookInFolder: folder
				forFilesMatching: '*.st' ].! !

!StartupPreferencesHandler methodsFor: 'actions' stamp: 'SeanDeNigris 8/4/2012 10:53'!
perform

	| results |
	results := OrderedCollection new.
	actions do: [:each |
		each value ifNotNil: [ :res |  results addAll: res ]
	].
	^ results
! !

!StartupPreferencesHandler methodsFor: 'private' stamp: 'StephaneDucasse 6/23/2013 18:04'!
lookInFolder: folder forFilesMatching: pattern

	| result files |
	result := OrderedCollection new.
	folder isDirectory ifFalse: [ ^ nil ].
	
	files := folder filesMatching: pattern.
	files do: [ :e | result add: e ].

	^ result isEmpty
		ifTrue: [ nil ]
		ifFalse: [ result ]! !

!StartupPreferencesLoader commentStamp: 'MarcusDenker 1/16/2015 19:07'!
StartupPreferencesLoader searches for and executes .st files from certain locations such as Library/Preferences/pharo on Mac OS X.  

StartupPreferencesLoader looks within such locations for a 'pharo' folder. This contains the startup scripts common to all versions of Pharo, and also optionally a folder per Pharo version holding startup scripts suitable for that version only.  So a typical directory layout might be...

.../some/folders/pharo/Content/Resources/pharo.image.
.../some/folders/pharo/Content/Resources/startup.st
.../some/folders/.config/pharo/author.st
.../some/folders/.config/pharo/useSharedCache.st
.../some/folders/.config/pharo/1.4/mystartupFor14only.st
.../some/folders/.config/pharo/2.0/mystartupFor20only.st

(**Note however that '.config' is an invalid filename on Windows, so '..config' is used instead)

To know the real values for you...
Print the result of "StartupPreferencesLoader preferencesGeneralFolder" which holds the startup scripts common to all versions of Pharo.
Print the result of "StartupPreferencesLoader preferencesVersionFolder" which holds the startup scripts specific to the version of the current image.

-----------


StartupPreferencesLoader example

will define a script sample startup.st in your unix root on unix 

Its contents is 

StartupPreferencesLoader default executeAtomicItems: {
	StartupAtomicItem name: 'Open Help' code: 'Workspace openContents: ''Here is just an example of how to use the StartupPreferencesLoader.
I should only be displayed once.
	
You can also see StartupPreferencesLoader class>>#example'' label: ''Help''' isSingleton: true.
	StartupAtomicItem name: 'Open Workspace' code: 'Workspace openContents: ''I should be displayed each time'''.
}

For a more complete example, see StartupPreferencesLoader class>>#example2!
!StartupPreferencesLoader methodsFor: 'script generation' stamp: 'CamilloBruni 5/26/2012 12:32'!
addAtStartupInImageDirectory:  aCollection
	self 
		addAtStartup: aCollection 
		inDirectory: FileSystem workingDirectory 
		named: self class startupScriptName
! !

!StartupPreferencesLoader methodsFor: 'cleaning' stamp: 'CamilloBruni 5/26/2012 12:33'!
removeAllScriptsFromGeneralPreferencesDirectory
	self removeAllScriptsFromDirectory: self preferencesGeneralFolder.
	
	
! !

!StartupPreferencesLoader methodsFor: 'private' stamp: 'S 6/17/2013 13:26'!
addAtStartup: aCollection inDirectory: aFileReference named: fileName

	| scriptFile |
	aFileReference ensureCreateDirectory.
	scriptFile := aFileReference / fileName.
	FileStream forceNewFileNamed: scriptFile fullName do: [ :stream | stream nextPutAll: (self buildStreamFor: aCollection) ].
! !

!StartupPreferencesLoader methodsFor: 'script generation' stamp: 'CamilloBruni 5/26/2012 12:31'!
addAtStartupInGeneralPreferenceFolder: aCollection 
	self 
		addAtStartup: aCollection 
		inDirectory: self preferencesGeneralFolder 
		named: self class startupGeneralPreferencesFolderScriptName! !

!StartupPreferencesLoader methodsFor: 'utility' stamp: 'SeanDeNigris 7/8/2012 11:49'!
preferencesGeneralFolder

	^ self class preferencesGeneralFolder.! !

!StartupPreferencesLoader methodsFor: 'script generation' stamp: 'CamilloBruni 5/26/2012 12:33'!
addAtStartupInPreferenceVersionFolder: aCollection named: fileName
	self 
		addAtStartup: aCollection 
		inDirectory: self preferencesVersionFolder 
		named: fileName! !

!StartupPreferencesLoader methodsFor: 'script generation' stamp: 'CamilloBruni 5/26/2012 12:32'!
addAtStartupInPreferenceVersionFolder: aCollection 
	self 
		addAtStartup: aCollection 
		inDirectory: self preferencesVersionFolder 
		named: self class startupPreferencesVersionFolderScriptName! !

!StartupPreferencesLoader methodsFor: 'accessing' stamp: 'IgorStasenko 2/4/2012 19:06'!
actions

	^ actions! !

!StartupPreferencesLoader methodsFor: 'startup loading' stamp: 'BenjaminVanRyseghem 9/10/2013 16:12'!
loadFromDefaultLocations
	
	self class allowStartupScript
		ifTrue: [ self load: self retrieveFilesStream ]! !

!StartupPreferencesLoader methodsFor: 'code execution' stamp: 'SeanDeNigris 6/21/2012 09:13'!
executeAtomicItems: aCollection
	"No sender but send from the generated script"

	'Load Startup Preferences'
		displayProgressFrom: 0 to: aCollection size
		during: [:bar | 
			aCollection doWithIndex: [:item :index | 
				bar current: index.
				(self add: item) execute ]]! !

!StartupPreferencesLoader methodsFor: 'script generation' stamp: 'CamilloBruni 5/26/2012 12:31'!
addAtStartupInGeneralPreferenceFolder: aCollection named: fileName
	self 
		addAtStartup: aCollection 
		inDirectory: self preferencesGeneralFolder 
		named: fileName! !

!StartupPreferencesLoader methodsFor: 'private' stamp: 'PavelKrivanek 7/13/2014 13:47'!
load: aCollection

	UserManager default canRunStartupScript ifFalse: [ ^ self ].
	errors removeAll.
	aCollection do: [:file | file fileIn ].! !

!StartupPreferencesLoader methodsFor: 'cleaning' stamp: 'CamilloBruni 5/26/2012 12:33'!
removeAllScriptsFromPreferencesVersionDirectory
	self removeAllScriptsFromDirectory: self preferencesVersionFolder.

! !

!StartupPreferencesLoader methodsFor: 'cleaning' stamp: 'MarianoMartinezPeck 5/7/2012 18:15'!
removeAllScriptsAndCleanSavedActions
	self removeAllScriptsFromAllDirectories.
	self cleanSavedActionsAndErrors.
	! !

!StartupPreferencesLoader methodsFor: 'initialization' stamp: 'IgorStasenko 2/4/2012 19:11'!
initialize

	super initialize.
	actions := Dictionary new. 
	errors := OrderedCollection new. ! !

!StartupPreferencesLoader methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2011 17:45'!
errors

	^ errors! !

!StartupPreferencesLoader methodsFor: 'accessing' stamp: 'NicolaiHess 12/1/2014 00:58'!
add: anAction
	| action |
	action := actions at: anAction name ifAbsentPut: [ anAction ].
	"make sure the possible existing action ueses new code or
	changed runOnce-behavior"
	action code: anAction code.
	action runOnce: anAction runOnce.
	^ action! !

!StartupPreferencesLoader methodsFor: 'cleaning' stamp: 'MarianoMartinezPeck 5/9/2012 19:28'!
removeAllScriptsFromAllDirectories
	self removeScriptFromImageDirectory.
	self removeAllScriptsFromPreferencesVersionDirectory.
	self removeAllScriptsFromGeneralPreferencesDirectory.
! !

!StartupPreferencesLoader methodsFor: 'cleaning' stamp: 'MarianoMartinezPeck 5/7/2012 18:14'!
cleanSavedActionsAndErrors
	actions := Dictionary new. 
	errors := OrderedCollection new. ! !

!StartupPreferencesLoader methodsFor: 'startup loading' stamp: 'CamilloBruni 9/16/2013 01:19'!
retrieveFilesStream

	^ StartupPreferencesHandler new perform! !

!StartupPreferencesLoader methodsFor: 'cleaning' stamp: 'StephaneDucasse 6/17/2012 18:28'!
removeAllScriptsFromDirectory: aDirectory
	aDirectory deleteAllChildren! !

!StartupPreferencesLoader methodsFor: 'utility' stamp: 'SeanDeNigris 7/8/2012 11:50'!
preferencesVersionFolder

	^ self class preferencesVersionFolder.! !

!StartupPreferencesLoader methodsFor: 'cleaning' stamp: 'CamilloBruni 5/26/2012 12:33'!
removeScriptFromImageDirectory
	(FileSystem workingDirectory / self class startupScriptName) delete.
! !

!StartupPreferencesLoader methodsFor: 'private' stamp: 'BenjaminVanRyseghem 12/14/2011 13:42'!
buildStreamFor: aCollection
	| stream |
	
	stream := WriteStream on: ''.

	stream
		nextPutAll: 'StartupLoader default executeAtomicItems: {';
		nextPutAll: String crlf.
	aCollection do: [:item |
		stream 
			nextPut: Character tab;
			nextPutAll: item storeString;
			nextPut: $.;
			nextPutAll: String crlf ].
	stream
		nextPut: $};
		nextPut: $.;
		nextPutAll: String crlf;
		nextPutAll: String crlf.
	^ stream contents! !

!StartupPreferencesLoader class methodsFor: 'accessing' stamp: 'IgorStasenko 2/4/2012 19:17'!
allowStartupScript: aBoolean

	AllowStartupScript := aBoolean! !

!StartupPreferencesLoader class methodsFor: 'private' stamp: 'MarianoMartinezPeck 5/7/2012 18:59'!
startupScriptName

	^ 'startup.st'! !

!StartupPreferencesLoader class methodsFor: 'example' stamp: 'CamilloBruni 9/16/2013 01:18'!
example2
	" it's my personal script provided as example"
	"self example2"
	| items |
	items := OrderedCollection new.
	items add: (StartupAction name: 'Set the Author' code: [ Author fullName: Author fullName printString ]). "replace it by your name"
	
	StartupPreferencesLoader default addAtStartupInPreferenceVersionFolder: items named: 'author.st'.
	items removeAll.
	
	items add: (StartupAction name: 'Debugger option' code: [ Smalltalk tools debugger alwaysOpenFullDebugger: true ]).
	items add: (StartupAction name: 'Dragging Option' code: [ UITheme defaultSettings fastDragging: true ]).
	items add: (StartupAction name: 'Dialog Auto Accept' code: [ TextEditorDialogWindow autoAccept: true ]).
	StartupPreferencesLoader default addAtStartupInPreferenceVersionFolder: items named: 'settings.st'.
	items removeAll.
	
	items add: (StartupAction name: 'Fonts option' code: [ FreeTypeSystemSettings loadFt2Library: true.
FreeTypeFontProvider current updateFromSystem.
StandardFonts defaultFont: (LogicalFont familyName: 'Lucida Grande' pointSize: 10) forceNotBold.
GraphicFontSettings resetAllFontToDefault.
StandardFonts codeFont: (LogicalFont familyName: 'Consolas' pointSize: 10).] runOnce: true).
	
	StartupPreferencesLoader default addAtStartupInPreferenceVersionFolder: items named: 'fonts.st'.
	items removeAll.
	StartupPreferencesLoader default addAtStartupInImageDirectory: items.
	
	StartupPreferencesLoader default loadFromDefaultLocations.! !

!StartupPreferencesLoader class methodsFor: 'private' stamp: 'EstebanLorenzano 1/24/2014 16:35'!
preferencesGeneralFolder

	^ [ FileLocator preferences asFileReference / 'pharo' ]
	on: Error do: [ 
		"Non NB-VMs will fai with a generic error"		
		nil  ].! !

!StartupPreferencesLoader class methodsFor: 'menu' stamp: 'BenjaminVanRyseghem 9/10/2013 15:56'!
startupLoaderMenuOn: aBuilder 
	<worldMenu>
	
	(aBuilder item: #startupLoader)
		action: [ self default loadFromDefaultLocations ];
		label: 'Run startup scripts';
		parent: #System;
		order: 2;
		help: 'Run startup "scripts';
		icon: Smalltalk ui icons scriptManagerIcon ! !

!StartupPreferencesLoader class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 11/1/2011 09:14'!
reset

	UniqueInstance := nil! !

!StartupPreferencesLoader class methodsFor: 'private' stamp: 'StephaneDucasse 6/23/2013 17:25'!
startupPreferencesVersionFolderScriptName

	^ 'startupPharo', SystemVersion current dottedMajorMinor,'.st'! !

!StartupPreferencesLoader class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 11/1/2011 08:56'!
default

	^ UniqueInstance ifNil: [ UniqueInstance := super basicNew initialize ]! !

!StartupPreferencesLoader class methodsFor: 'example' stamp: 'CamilloBruni 9/16/2013 01:18'!
example
	" an example of script generation "
	| item1 item2 |
	item1 := StartupAction name: 'Open Help' code: 'Workspace openContents: ''Here is just an example of how to use the StartupLoader.
I should only be displayed once.
	
 You can also see StartupLoader class>>#example'' label: ''Help''' runOnce: true.
	item2 := StartupAction name: 'Open Workspace' code:  [ Workspace openContents: 'I should be displayed each time' ].
	StartupPreferencesLoader default addAtStartupInGeneralPreferenceFolder: {item1. item2}.
	
	StartupPreferencesLoader default loadFromDefaultLocations.
	StartupPreferencesLoader default loadFromDefaultLocations.! !

!StartupPreferencesLoader class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 11/1/2011 08:56'!
new

	^ self error: 'use #default instead'! !

!StartupPreferencesLoader class methodsFor: 'example' stamp: 'CamilloBruni 9/16/2013 01:18'!
example4
	"self example4"
	| items |
	items := OrderedCollection new.
	
	items add: (StartupAction name: 'General Preferences for all Pharo versions' code: [ 
		FileStream stdout lf; nextPutAll: 'Setting general preferences for all Pharo versions'; lf.
		FileStream stdout lf; nextPutAll: 'Finished'; lf.
		 ]).
	StartupPreferencesLoader default addAtStartupInGeneralPreferenceFolder: items named: 'generalSettings.st'.
	
	items removeAll.
	items add: (StartupAction name: 'Settings' code: [ 
		FileStream stdout lf; nextPutAll: 'Setting general preferences for Pharo 2.0'; lf.
		FileStream stdout lf; nextPutAll: 'Finished'; lf.
		 ]).
	StartupPreferencesLoader default addAtStartupInPreferenceVersionFolder: items named: 'settings.st'.
	
	items removeAll.
	items add: (StartupAction name: 'Image diretory' code: [ 
		FileStream stdout lf; nextPutAll: 'Setting preferences for image directory'; lf.
		FileStream stdout lf; nextPutAll: 'Finished'; lf.
		 ]).
	StartupPreferencesLoader default addAtStartupInImageDirectory: items ! !

!StartupPreferencesLoader class methodsFor: 'private' stamp: 'EstebanLorenzano 1/24/2014 16:35'!
preferencesVersionFolder

	^ self preferencesGeneralFolder 
		ifNotNil: [ :folder | folder / SystemVersion current dottedMajorMinor ]! !

!StartupPreferencesLoader class methodsFor: 'accessing' stamp: 'IgorStasenko 2/4/2012 19:17'!
allowStartupScript

	^ AllowStartupScript ifNil: [ AllowStartupScript := true ]! !

!StartupPreferencesLoader class methodsFor: 'example' stamp: 'CamilloBruni 9/16/2013 01:18'!
example3
	" it's my personal script provided as example"
	"self example3"
	| items |
	items := OrderedCollection new.
	items add: (StartupAction name: 'Self halt' code: [ self halt ]). "replace it by your name"
	items add: (StartupAction name: 'WS' code: [ Workspace open ]). "replace it by your name"
	StartupPreferencesLoader default addAtStartupInPreferenceVersionFolder: items named: 'author.st'.

	StartupPreferencesLoader default loadFromDefaultLocations.! !

!StartupPreferencesLoader class methodsFor: 'private' stamp: 'MarianoMartinezPeck 5/7/2012 18:59'!
startupGeneralPreferencesFolderScriptName

	^ 'startupPharo.st'! !

!StartupPreferencesLoader class methodsFor: 'setting' stamp: 'StephaneDucasse 11/11/2014 18:49'!
startupPreferencesSettingsOn: aBuilder
	<systemsettings>
	
	(aBuilder setting: #allowStartupScript)
		label: 'Allow the preferences to be loaded at startup';
		parent: #pharoSystem;
		target: self;
		description: 'If true, the preferences will be loaded' .! !

!StartupUIManager commentStamp: '<historical>'!
I am a non interactive UI manager that is used only during image startup, where parts of the system are not fully initialized yet.!
!StartupUIManager methodsFor: 'ui requests' stamp: 'StephaneDucasse 6/7/2011 15:52'!
inform: aString

	(ProvideAnswerNotification signal: aString) ifNotNil: [:answer | ^true].
	Smalltalk addDeferredStartupAction: [ UIManager default inform: aString ].! !

!StartupUIManager methodsFor: 'private' stamp: 'CamilloBruni 9/14/2013 10:53'!
activate
	"override to exclude the superclass' behavior"! !

!StartupUIManager methodsFor: 'private' stamp: 'CamilloBruni 9/14/2013 10:53'!
deactivate
	"override to exclude the superclass' behavior"! !

!StepIntoDebugAction commentStamp: '<historical>'!
A StepIntoDebugAction the current context.
!
!StepIntoDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/20/2013 15:31'!
id

	^ #stepInto! !

!StepIntoDebugAction methodsFor: 'actions' stamp: 'AndreiChis 9/20/2013 15:33'!
executeAction

	self session stepInto: self currentContext! !

!StepIntoDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/21/2013 21:26'!
defaultKeyText

	^ 'e'! !

!StepIntoDebugAction methodsFor: 'testing' stamp: 'AndreiChis 9/20/2013 17:16'!
appliesToDebugger: aDebugger

	^ aDebugger session isInterruptedContextPostMortem not! !

!StepIntoDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/20/2013 15:33'!
defaultLabel

	^ 'Into'! !

!StepIntoDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/20/2013 15:33'!
defaultOrder

	^ 15! !

!StepIntoDebugAction class methodsFor: 'registration' stamp: 'AndreiChis 9/21/2013 22:15'!
actionType
	<debuggingAction>
	<contextMenuDebuggingAction>! !

!StepMessage commentStamp: 'LaurentLaffont 3/15/2011 20:49'!
I'm a MorphicAlarm to be queued in WorldState list of stepping actions. I hold the stepTime (refresh period) of my receiver / Morph (if nil, the #stepTime value of my receiver is used).

See 
- WordState>>runLocalStepMethodsIn:   (where the stepping actions are sent).
- WorldState>>startStepping:at:selector:arguments:stepTime:  (to queue a new StepMessage)

Example:

MorphicUIManager currentWorld
        startStepping: (Morph new openInWorld)
        at: Time millisecondClockValue
        selector: #toggleVisible
        arguments: nil
        stepTime: 500.!
!StepMessage methodsFor: 'accessing' stamp: 'ar 10/22/2000 16:56'!
stepTime: aNumber
	"Set the step time for this message. If nil, the receiver of the message will be asked for its #stepTime."
	stepTime := aNumber! !

!StepMessage methodsFor: 'testing' stamp: 'ar 10/22/2000 16:56'!
stepTime
	"Return the step time for this message. If nil, the receiver of the message will be asked for its #stepTime."
	^stepTime! !

!StepMessage methodsFor: 'printing' stamp: 'ar 10/22/2000 15:59'!
printOn: aStream
	super printOn: aStream.
	aStream 
		nextPut: $(;
		print: receiver;
		space;
		print: selector;
		space;
		print: scheduledTime;
		nextPut: $).! !

!StepMessage class methodsFor: 'instance creation' stamp: 'ar 10/22/2000 15:48'!
scheduledAt: scheduledTime stepTime: stepTime receiver: aTarget selector: aSelector arguments: argArray
	^(self receiver: aTarget selector: aSelector arguments: argArray)
		scheduledTime: scheduledTime;
		stepTime: stepTime! !

!StepOverDebugAction commentStamp: '<historical>'!
A StepOverDebugAction the current context.
!
!StepOverDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/20/2013 15:36'!
id

	^ #stepOver! !

!StepOverDebugAction methodsFor: 'actions' stamp: 'AndreiChis 9/20/2013 15:38'!
executeAction

	self session stepOver: self currentContext! !

!StepOverDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/21/2013 21:33'!
defaultKeyText

	^ 't'! !

!StepOverDebugAction methodsFor: 'testing' stamp: 'AndreiChis 9/20/2013 17:16'!
appliesToDebugger: aDebugger

	^ aDebugger session isInterruptedContextPostMortem not! !

!StepOverDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/20/2013 15:36'!
defaultLabel

	^ 'Over'! !

!StepOverDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/20/2013 15:36'!
defaultOrder

	^ 20! !

!StepOverDebugAction class methodsFor: 'registration' stamp: 'AndreiChis 9/21/2013 22:15'!
actionType
	<debuggingAction>
	<contextMenuDebuggingAction>! !

!StepThroughDebugAction commentStamp: '<historical>'!
A StepThroughDebugAction through the execution until control returns to the current method.
!
!StepThroughDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/20/2013 15:38'!
id

	^ #stepThrough! !

!StepThroughDebugAction methodsFor: 'actions' stamp: 'AndreiChis 9/20/2013 15:38'!
executeAction

	self session stepThrough: self currentContext! !

!StepThroughDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/21/2013 21:34'!
defaultKeyText

	^ 'T'! !

!StepThroughDebugAction methodsFor: 'testing' stamp: 'AndreiChis 9/20/2013 17:16'!
appliesToDebugger: aDebugger

	^ aDebugger session isInterruptedContextPostMortem not! !

!StepThroughDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/20/2013 15:38'!
defaultLabel

	^ 'Through'! !

!StepThroughDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/20/2013 15:38'!
defaultOrder

	^ 25! !

!StepThroughDebugAction class methodsFor: 'registration' stamp: 'AndreiChis 9/21/2013 22:15'!
actionType
	<debuggingAction>
	<contextMenuDebuggingAction>! !

!StickynessBugsTest commentStamp: 'wiz 11/24/2006 00:24'!
A StickynessBugz is for mantis #5500 rectangles and ellipses don't act sticky when rotated even when they are..

Instance Variables
!
!StickynessBugsTest methodsFor: 'tests' stamp: 'MarcusDenker 10/28/2014 17:20'!
testForTiltedStickyness
	"self new testForTiltedStickyness"

	"self run: #testForTiltedStickyness"

	| m |
	m := Morph new openCenteredInWorld.
	cases := Array with: m.	"save for tear down."
	self assert: m topRendererOrSelf isSticky not.
	m beSticky.
	self assert: m topRendererOrSelf isSticky.
	m addFlexShell.
	cases := Array with: m topRendererOrSelf.
	m topRendererOrSelf rotationDegrees: 45.0.
	self assert: m topRendererOrSelf isSticky.
	m beUnsticky.
	self assert: m topRendererOrSelf isSticky not.
	m topRendererOrSelf delete.
	^ true! !

!Stopwatch commentStamp: '<historical>'!
A Stopwatch maintains a collection of timespans.!
!Stopwatch methodsFor: 'private' stamp: 'brp 9/24/2003 22:46'!
state: aSymbol

	state := aSymbol
! !

!Stopwatch methodsFor: 'actions' stamp: 'brp 9/25/2003 12:03'!
reActivate

	self 
		suspend;
		activate.
! !

!Stopwatch methodsFor: 'accessing' stamp: 'brp 9/25/2003 11:21'!
end

	^ self timespans last next

! !

!Stopwatch methodsFor: 'actions' stamp: 'brp 9/25/2003 11:54'!
reset

	self suspend.
	timespans := nil.

! !

!Stopwatch methodsFor: 'actions' stamp: 'brp 9/24/2003 23:13'!
suspend

	| ts |
	self isActive ifTrue:
		[ ts := self timespans last.
		ts duration: (DateAndTime now - ts start).
		self state: #suspended]
! !

!Stopwatch methodsFor: 'accessing' stamp: 'brp 9/24/2003 22:47'!
state

	^ state ifNil: [ state := #suspended ]
! !

!Stopwatch methodsFor: 'testing' stamp: 'brp 9/24/2003 22:48'!
isSuspended

	^ self state = #suspended

! !

!Stopwatch methodsFor: 'printing' stamp: 'brp 9/25/2003 13:25'!
printOn: aStream

	super printOn: aStream.
	aStream
		nextPut: $(;
		nextPutAll: self state;
		nextPut: $:;
		print: self duration;
		nextPut: $).

! !

!Stopwatch methodsFor: 'actions' stamp: 'brp 9/24/2003 23:18'!
start

	^ self timespans first start

! !

!Stopwatch methodsFor: 'accessing' stamp: 'brp 9/24/2003 22:44'!
timespans

	^ timespans ifNil: [ timespans := OrderedCollection new ]
! !

!Stopwatch methodsFor: 'testing' stamp: 'brp 9/24/2003 22:48'!
isActive

	^ self state = #active
! !

!Stopwatch methodsFor: 'accessing' stamp: 'brp 9/24/2003 23:45'!
duration

	| ts last |
	self isSuspended 
		ifTrue:
			[ (ts := self timespans) isEmpty ifTrue: 
				[ ts := { Timespan starting: DateAndTime now duration: Duration zero } ] ]
		ifFalse:
			[ last := self timespans last.
			ts := self timespans allButLast
				add: (last duration: (DateAndTime now - last start); yourself);
				yourself ].
		
	^ (ts collect: [ :t | t duration ]) sum
! !

!Stopwatch methodsFor: 'actions' stamp: 'brp 9/24/2003 23:12'!
activate

	self isSuspended ifTrue:
		[self timespans add: 
			(Timespan starting: DateAndTime now duration: Duration zero).
		self state: #active]
! !

!StopwatchTest commentStamp: 'TorstenBergmann 2/5/2014 08:45'!
SUnit tests for the stopwatch !
!StopwatchTest methodsFor: 'tests' stamp: 'damiencassou 5/30/2008 11:09'!
testPrintOn
	| cs rw |
	cs := 'a Stopwatch(suspended:0:00:00:00)' readStream.
	rw := ReadWriteStream on: ''.
	aStopwatch printOn: rw.
	self assert: rw contents = cs contents! !

!StopwatchTest methodsFor: 'running' stamp: 'brp 1/21/2004 18:49'!
setUp
	aStopwatch := Stopwatch new.
	aDelay := Delay forMilliseconds: 1.! !

!StopwatchTest methodsFor: 'coverage' stamp: 'brp 9/24/2003 23:01'!
selectorsToBeIgnored

	| private | 
	private := #( #printOn: #state: ).

	^ super selectorsToBeIgnored, private
! !

!StopwatchTest methodsFor: 'tests' stamp: 'brp 9/26/2004 19:32'!
testSingleTiming
	| timeBefore |
	timeBefore := DateAndTime now.
	aStopwatch activate.
	aDelay wait.
	aStopwatch suspend.
	self assert: aStopwatch timespans size = 1. 
	self assert: aStopwatch timespans first asDateAndTime >= timeBefore. 
	self assert: aStopwatch timespans first asDateAndTime <= aStopwatch end.
! !

!StopwatchTest methodsFor: 'tests' stamp: 'brp 9/25/2003 12:02'!
testReActivate

	| sw |
	sw := Stopwatch new.
	sw 
		activate;
		suspend;
		reActivate.
	
	self 
		assert: (sw isActive).
! !

!StopwatchTest methodsFor: 'coverage' stamp: 'brp 9/24/2003 22:49'!
classToBeTested

	^ Stopwatch

! !

!StopwatchTest methodsFor: 'tests' stamp: 'brp 9/26/2004 19:36'!
testStartStop

	| sw t1 t2 t3 t4 |
	sw := Stopwatch new.
	t1 := DateAndTime now.
	(Delay forMilliseconds: 10) wait.
	sw activate; activate.
	(Delay forMilliseconds: 10) wait.
	t2 := DateAndTime now.
	
	self 
		deny: (sw isSuspended);
		assert: (sw isActive);
		assert: (sw timespans size = 1);
		assert: (t1 <= sw start);
		assert: (sw start <= t2).

	(Delay forMilliseconds: 10) wait.
	t3 := DateAndTime now.
	(Delay forMilliseconds: 10) wait.
	sw suspend; suspend.
	(Delay forMilliseconds: 10) wait.
	t4 := DateAndTime now.

	self 
		assert: (sw isSuspended);
		deny: (sw isActive);
		assert: (sw timespans size = 1);
		assert: (sw end between: t3 and: t4);
		assert: (t3 <= sw end);
		assert: (sw end <= t4).
! !

!StopwatchTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:49'!
testChangingStatus
	aStopwatch activate.
	self assert: aStopwatch isActive.
	self assert: aStopwatch timespans size = 1.
	aStopwatch suspend.
	self assert: aStopwatch isSuspended.
	self assert: aStopwatch timespans size = 1.
	aStopwatch activate.
	aStopwatch reActivate.
	self assert: aStopwatch isActive.
	self assert: aStopwatch timespans size = 3.
	aStopwatch reset.
	self assert: aStopwatch isSuspended.
	self assert: aStopwatch timespans size = 0.! !

!StopwatchTest methodsFor: 'tests' stamp: 'brp 9/26/2004 19:32'!
testMultipleTimings
	aStopwatch activate.
	aDelay wait.
	aStopwatch suspend.
	aStopwatch activate.
	aDelay wait.
	aStopwatch suspend.
	self assert: aStopwatch timespans size = 2. 
	self assert: aStopwatch timespans first asDateAndTime <= 
					aStopwatch timespans last asDateAndTime.
! !

!StopwatchTest methodsFor: 'tests' stamp: 'brp 9/25/2003 11:56'!
testReset

	| sw |
	sw := Stopwatch new.
	sw activate.
	
	sw reset.
	self 
		assert: (sw isSuspended);
		assert: (sw timespans isEmpty)
! !

!StopwatchTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:49'!
testInitialStatus
	self assert: aStopwatch isSuspended.
	self deny: aStopwatch isActive.
	self assert: aStopwatch duration = 0 seconds! !

!StopwatchTest methodsFor: 'tests' stamp: 'brp 9/24/2003 22:56'!
testNew

	| sw |
	sw := Stopwatch new.
	
	self 
		assert: (sw isSuspended);
		assert: (sw state = #suspended);
		deny: (sw isActive);
		assert: (sw timespans isEmpty)

! !

!StopwatchTest class methodsFor: 'testing' stamp: 'JorgeRessia 3/16/2010 20:24'!
isUnitTest
	^false! !

!Stream commentStamp: '<historical>'!
I am an abstract class that represents an accessor for a sequence of objects. This sequence is referred to as my "contents".!
!Stream methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 8/17/2012 11:30'!
basicNext: anAmount putAll: aCollection startingAt: startIndex

	^ self next: anAmount putAll: aCollection startingAt: startIndex.
! !

!Stream methodsFor: 'accessing' stamp: ''!
next: anInteger put: anObject 
	"Make anObject be the next anInteger number of objects accessible by the 
	receiver. Answer anObject."

	anInteger timesRepeat: [self nextPut: anObject].
	^anObject! !

!Stream methodsFor: 'filter streaming' stamp: 'MPW 1/1/1901 00:48'!
write:encodedObject
	^encodedObject putOn:self.
! !

!Stream methodsFor: 'file open/close' stamp: 'MarianoMartinezPeck 8/24/2012 15:59'!
close
	"Presumably sets the status of the receiver to be closed. This message does 
	nothing at this level, but is included for FileStream compatibility."

	^self ! !

!Stream methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 8/24/2012 15:59'!
binary
	"do nothing"
	^self ! !

!Stream methodsFor: 'printing' stamp: 'sma 6/1/2000 09:56'!
print: anObject
	"Have anObject print itself on the receiver."

	anObject printOn: self! !

!Stream methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 8/24/2012 15:59'!
next
	"Answer the next object accessible by the receiver."

	self subclassResponsibility ! !

!Stream methodsFor: 'accessing' stamp: 'yo 8/30/2002 17:13'!
basicNextPut: anObject 

	^ self nextPut: anObject! !

!Stream methodsFor: 'testing' stamp: 'MarcusDenker 7/15/2012 15:43'!
isBinary
	^false! !

!Stream methodsFor: '*Deprecated40' stamp: 'TorstenBergmann 1/22/2015 08:48'!
isMessageStream
	self deprecated: 'There was no sender of this method in Pharo 4.0'.
	^ false! !

!Stream methodsFor: 'readability' stamp: 'kph 9/27/2007 21:53'!
<< items

 	items putOn: self.
	
	^ self! !

!Stream methodsFor: 'testing' stamp: 'ar 12/23/1999 15:43'!
isStream
	"Return true if the receiver responds to the stream protocol"
	^true! !

!Stream methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 8/24/2012 15:29'!
nextPutAll: aCollection 
	"Append the elements of aCollection to the sequence of objects accessible 
	by the receiver. Answer aCollection."
	
	aCollection do: [:v | self nextPut: v].
	^aCollection! !

!Stream methodsFor: 'accessing' stamp: 'yo 8/30/2002 17:13'!
basicNextPutAll: aCollection 

	^ self nextPutAll: aCollection.
! !

!Stream methodsFor: 'accessing' stamp: 'nk 4/29/2004 10:40'!
openReadOnly
	^self! !

!Stream methodsFor: 'accessing' stamp: ''!
nextMatchFor: anObject 
	"Gobble the next object and answer whether it is equal to the argument, 
	anObject."

	^anObject = self next! !

!Stream methodsFor: 'accessing' stamp: 'nk 4/29/2004 10:38'!
localName
	^'a stream'! !

!Stream methodsFor: 'testing' stamp: 'MarianoMartinezPeck 8/24/2012 15:59'!
atEnd
	"Answer whether the receiver can access any more objects."

	self subclassResponsibility ! !

!Stream methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 8/24/2012 15:59'!
nextPut: anObject 
	"Insert the argument, anObject, as the next object accessible by the 
	receiver. Answer anObject."
	
	self subclassResponsibility ! !

!Stream methodsFor: '*Fuel' stamp: 'MartinDias 8/13/2011 14:29'!
nextBytesPutAll: aCollection
	"Append the bytes of aCollection to the sequence of bytes accessible 
	by the receiver. Answer aCollection."

	^self nextPutAll: aCollection! !

!Stream methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 8/24/2012 15:30'!
next: anInteger 
	"Answer the next anInteger number of objects accessible by the receiver."
	
	| aCollection |
	aCollection := OrderedCollection new.
	anInteger timesRepeat: [aCollection addLast: self next].
	^aCollection! !

!Stream methodsFor: 'accessing' stamp: 'yo 8/30/2002 17:13'!
basicNext

	^ self next.
! !

!Stream methodsFor: 'accessing' stamp: ''!
nextMatchAll: aColl
    "Answer true if next N objects are the ones in aColl,
     else false.  Advance stream of true, leave as was if false."
    | save |
    save := self position.
    aColl do: [:each |
       (self next) = each ifFalse: [
            self position: save.
            ^ false]
        ].
    ^ true! !

!Stream methodsFor: 'testing' stamp: 'ClementBera 9/30/2013 10:56'!
nextWordsPutAll: aCollection
	"Write the argument a word-like object in big endian format on the receiver.
	May be used to write other than plain word-like objects (such as ColorArray)."
	
	(aCollection class isPointers or: [ aCollection class isWords not ])
		ifTrue: [ ^ self error: aCollection class name,' is not word-like'].
	1 to: aCollection basicSize do: [ :i |
		self nextNumber: 4 put: (aCollection basicAt: i) ].
	^ aCollection! !

!Stream methodsFor: 'enumerating' stamp: ''!
do: aBlock 
	"Evaluate aBlock for each of the objects accessible by receiver."

	[self atEnd]
		whileFalse: [aBlock value: self next]! !

!Stream methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 8/24/2012 15:59'!
flush
	"Do nothing by default" ! !

!Stream methodsFor: 'accessing' stamp: 'nk 4/29/2004 10:41'!
readOnly
	^self! !

!Stream methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 8/24/2012 15:30'!
upToEnd
	"answer the remaining elements in the string"
	| elements |
	elements := OrderedCollection new.
	[ self atEnd ] whileFalse: [ 
		elements add: self next ].
	^elements! !

!Stream methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 8/17/2012 11:30'!
next: anInteger putAll: aCollection startingAt: startIndex
	"Store the next anInteger elements from the given collection."
	(startIndex = 1 and:[anInteger = aCollection size])
		ifTrue:[^self nextPutAll: aCollection].
	^self nextPutAll: (aCollection copyFrom: startIndex to: startIndex+anInteger-1)! !

!Stream methodsFor: 'accessing' stamp: ''!
contents
	"Answer all of the contents of the receiver."

	self subclassResponsibility! !

!Stream methodsFor: 'testing' stamp: 'ab 8/28/2003 18:30'!
closed
	^ false! !

!Stream class methodsFor: 'instance creation' stamp: 'MarianoMartinezPeck 8/24/2012 15:59'!
new

	self error: 'Streams are created with on: and with:'! !

!StreamBugsTest methodsFor: 'accessing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testReadWriteStreamNextNBug
	| aStream |
	aStream := ReadWriteStream on: String new.
	aStream nextPutAll: 'Hello World'.
	aStream next: 5! !

!StrikeFont commentStamp: '<historical>'!
I represent a compact encoding of a set of Forms corresponding to characters in the ASCII character set. All the forms are placed side by side in a large form whose height is the font height, and whose width is the sum of all the character widths. The xTable variable gives the left-x coordinates of the subforms corresponding to the glyphs. Characters are mapped to glyphs by using the characterToGyphMap.

Subclasses can have non-trivial mapping rules as well as different representations for glyphs sizes (e.g., not using an xTable). If so, these classes should return nil when queried for xTable and/or the characterToGlyphMap. This will cause the CharacterScanner primitive to fail and query the font for the width of a character (so that a more programatical approach can be implemented).

For display, fonts need to implement two messages:
	#installOn: aDisplayContext foregroundColor: foregroundColor backgroundColor: backgroundColor
This method installs the receiver (a font) on the given DisplayContext (which may be an instance of BitBlt or Canvas (or any of it's subclasses). The font should take the appropriate action to initialize the display context so that further display operations can be optimized.
	#displayString: aString on: aDisplayContext from: startIndex to: stopIndex at: aPoint kern: kernDelta
This method is called for each subsequent run of characters in aString which is to be displayed with the (previously installed) settings.
!
!StrikeFont methodsFor: 'displaying' stamp: 'StephaneDucasse 10/25/2013 16:19'!
displayLine: aString at: aPoint 
	"Display the characters in aString, starting at position aPoint."

	self characters: (1 to: aString size)
		in: aString
		displayAt: aPoint
		clippedBy: Display boundingBox
		rule: Form over
		fillColor: nil
		kernDelta: 0
		on: (BitBlt toForm: Display).
! !

!StrikeFont methodsFor: 'accessing' stamp: 'ar 9/21/2000 11:53'!
fontNameWithPointSize
	^self name withoutTrailingDigits, ' ', self pointSize printString! !

!StrikeFont methodsFor: 'file in/out' stamp: 'HenrikSperreJohansen 6/12/2010 02:29'!
readFromBitFont: fileName 
	"This builds a StrikeFont instance by reading the data file format
	produced by BitFont, a widely available font conversion utility
	written by Peter DiCamillo at Brown University"
	"StrikeFont new readFromBitFont: 'Palatino10.BF' "
	| f lastAscii charLine width ascii charForm line missingForm tempGlyphs iRect p rectLine left tokens right |
	f := FileStream readOnlyFileNamed: fileName.
	self readBFHeaderFrom: f.

	"NOTE: if font has been scaled (and in any case),
	the REAL bitmap dimensions come after the header."
	self 
		restOfLine: 'Extent information for entire font'
		from: f.
	"Parse the following line (including mispelling!!)"
	"Image rectange: left = -2, right = 8, bottom = -2, top = 7"
	tokens := f nextLine findTokens: ' '.
	iRect := Rectangle 
		left: (tokens at: 5) asNumber
		right: (tokens at: 8) asNumber
		top: (tokens at: 14) asNumber
		bottom: (tokens at: 11) asNumber.
	ascent := iRect top.
	descent := iRect bottom negated.
	tempGlyphs := Form extent: (maxWidth * 257) @ self height.
	xTable := (Array new: 258) atAllPut: 0.
	xTable 
		at: 1
		put: 0.

	"Read character forms and blt into tempGlyphs"
	lastAscii := -1.
	
	[ charLine := self 
		restOfLine: 'Character: '
		from: f.
	charLine == nil ifFalse: 
		[ p := f position.
		rectLine := f nextLine.
		(rectLine beginsWith: 'Image rectange: left = ') 
			ifTrue: 
				[ tokens := rectLine findTokens: ' '.
				left := (tokens at: 5) asNumber.
				right := (tokens at: 8) asNumber ]
			ifFalse: 
				[ left := right := 0.
				f position: p ].
		width := (self 
			restOfLine: 'Width (final pen position) = '
			from: f) asNumber - left max: right - left + 1.
		(charLine beginsWith: 'Missing character') ifTrue: [ ascii := 256 ].
		('x''*' match: charLine) ifTrue: 
			[ ascii := Number 
				readFrom: (charLine 
					copyFrom: 3
					to: 4) asUppercase
				base: 16 ].
		charForm := Form extent: width @ self height.
		('*[all blank]' match: charLine) ifFalse: 
			[ self 
				restOfLine: '  +'
				from: f.
			1 
				to: self height
				do: 
					[ :y | 
					line := f nextLine.
					4 
						to: (width + 3 min: line size + iRect left - left)
						do: 
							[ :x | 
							(line at: x - iRect left + left) = $* ifTrue: 
								[ charForm 
									pixelValueAt: (x - 4) @ (y - 1)
									put: 1 ] ] ] ] ].
	charLine == nil ] whileFalse: 
		[ self 
			displayChar: ascii
			form: charForm.
		ascii = 256 
			ifTrue: [ missingForm := charForm deepCopy ]
			ifFalse: 
				[ minAscii := minAscii min: ascii.
				maxAscii := maxAscii max: ascii.
				lastAscii + 1 
					to: ascii - 1
					do: 
						[ :a | 
						xTable 
							at: a + 2
							put: (xTable at: a + 1) ].
				tempGlyphs 
					copy: ((xTable at: ascii + 1) @ 0 extent: charForm extent)
					from: 0 @ 0
					in: charForm
					rule: Form over.
				xTable 
					at: ascii + 2
					put: (xTable at: ascii + 1) + width.
				lastAscii := ascii ] ].
	f close.
	lastAscii + 1 
		to: maxAscii + 1
		do: 
			[ :a | 
			xTable 
				at: a + 2
				put: (xTable at: a + 1) ].
	missingForm == nil ifFalse: 
		[ tempGlyphs 
			copy: missingForm boundingBox
			from: missingForm
			to: (xTable at: maxAscii + 2) @ 0
			rule: Form over.
		xTable 
			at: maxAscii + 3
			put: (xTable at: maxAscii + 2) + missingForm width ].
	glyphs := Form extent: (xTable at: maxAscii + 3) @ self height.
	glyphs 
		copy: glyphs boundingBox
		from: 0 @ 0
		in: tempGlyphs
		rule: Form over.
	xTable := xTable 
		copyFrom: 1
		to: maxAscii + 3.
	characterToGlyphMap := nil! !

!StrikeFont methodsFor: 'accessing' stamp: 'yo 1/6/2005 04:19'!
heightOf: aCharacter

	(self hasGlyphOf: aCharacter) ifFalse: [
		fallbackFont ifNotNil: [
			^ fallbackFont heightOf: aCharacter.
		].
	].
	^ self height.
! !

!StrikeFont methodsFor: 'accessing' stamp: ''!
glyphs
	"Answer a Form containing the bits representing the characters of the 
	receiver."

	^glyphs! !

!StrikeFont methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
xTable: anObject 
	xTable := anObject! !

!StrikeFont methodsFor: 'character shapes' stamp: 'lr 7/4/2009 10:42'!
characterFormAtMulti: character 
	"Answer a Form copied out of the glyphs for the argument, character."
	| ascii leftX rightX |
	ascii := character charCode.
	(ascii 
		between: minAscii
		and: maxAscii) ifFalse: [ ascii := maxAscii + 1 ].
	leftX := xTable at: ascii + 1.
	rightX := xTable at: ascii + 2.
	^ glyphs copy: (leftX @ 0 corner: rightX @ self height)! !

!StrikeFont methodsFor: 'file in/out' stamp: 'lr 7/4/2009 10:42'!
buildfontNamed: nm fromForms: forms startingAtAscii: startAscii ascent: a descent: d maxWid: m 
	"This builds a StrikeFont instance from existing forms."
	| lastAscii width ascii charForm missingForm tempGlyphs |
	name := nm.
	ascent := 11.
	descent := 3.
	maxWidth := 16.
	pointSize := 8.
	name := (name copyWithout: Character space) , (pointSize < 10 
			ifTrue: [ '0' , pointSize printString ]
			ifFalse: [ pointSize printString ]).
	minAscii := 258.
	maxAscii := 0.
	superscript := (ascent - descent) // 3.
	subscript := (descent - ascent) // 3.
	emphasis := 0.
	type := 0.	"ignored for now"
	tempGlyphs := Form extent: (maxWidth * 257) @ self height.
	xTable := (Array new: 258) atAllPut: 0.
	xTable 
		at: 1
		put: 0.

	"Read character forms and blt into tempGlyphs"
	lastAscii := -1.
	1 
		to: forms size
		do: 
			[ :i | 
			charForm := forms at: i.
			width := charForm width.
			ascii := startAscii - 1 + i.
			self 
				displayChar: ascii
				form: charForm.
			ascii = 256 
				ifTrue: [ missingForm := charForm deepCopy ]
				ifFalse: 
					[ minAscii := minAscii min: ascii.
					maxAscii := maxAscii max: ascii.
					lastAscii + 1 
						to: ascii - 1
						do: 
							[ :as | 
							xTable 
								at: as + 2
								put: (xTable at: as + 1) ].
					tempGlyphs 
						copy: ((xTable at: ascii + 1) @ 0 extent: charForm extent)
						from: 0 @ 0
						in: charForm
						rule: Form over.
					xTable 
						at: ascii + 2
						put: (xTable at: ascii + 1) + width.
					lastAscii := ascii ] ].
	lastAscii + 1 
		to: maxAscii + 1
		do: 
			[ :as | 
			xTable 
				at: as + 2
				put: (xTable at: as + 1) ].
	missingForm == nil ifFalse: 
		[ tempGlyphs 
			copy: missingForm boundingBox
			from: missingForm
			to: (xTable at: maxAscii + 2) @ 0
			rule: Form over.
		xTable 
			at: maxAscii + 3
			put: (xTable at: maxAscii + 2) + missingForm width ].
	glyphs := Form extent: (xTable at: maxAscii + 3) @ self height.
	glyphs 
		copy: glyphs boundingBox
		from: 0 @ 0
		in: tempGlyphs
		rule: Form over.
	xTable := xTable 
		copyFrom: 1
		to: maxAscii + 3.
	characterToGlyphMap := nil! !

!StrikeFont methodsFor: 'emphasis' stamp: 'HenrikSperreJohansen 1/11/2010 23:03'!
isSyntheticItalic: aBoolean 
	aBoolean 
		ifTrue: [type :=  5]
		! !

!StrikeFont methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
pointSize: anInteger 
	pointSize := anInteger! !

!StrikeFont methodsFor: 'accessing' stamp: 'yo 1/6/2005 04:19'!
descentOf: aCharacter

	(self hasGlyphOf: aCharacter) ifFalse: [
		fallbackFont ifNotNil: [
			^ fallbackFont descentOf: aCharacter.
		].
	].
	^ self descent.
! !

!StrikeFont methodsFor: '*Athens-Text' stamp: 'NicolaiHess 7/2/2014 12:48'!
getPreciseAscent
	^ self ascent! !

!StrikeFont methodsFor: '*Athens-Text' stamp: 'NicolaiHess 6/30/2014 09:32'!
glyphRendererOn: anAthensSurface

	^ anAthensSurface getStrikeFontRendererFor: self
! !

!StrikeFont methodsFor: 'accessing' stamp: 'yo 1/6/2005 04:19'!
ascentOf: aCharacter

	(self hasGlyphOf: aCharacter) ifFalse: [
		fallbackFont ifNotNil: [
			^ fallbackFont ascentOf: aCharacter.
		].
	].
	^ self ascent.
! !

!StrikeFont methodsFor: 'displaying' stamp: 'nice 10/29/2013 03:06'!
displayMultiString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta baselineY: baselineY 
	| nextWide destX leftX rightX glyphInfo char destY gfont charIndex |
	destX := aPoint x.
	charIndex := startIndex.
	glyphInfo := Array new: 5.
	[ charIndex <= stopIndex ] whileTrue: 
		[ nextWide := aString indexOfWideCharacterFrom: charIndex to: stopIndex.
		nextWide = 0 ifTrue: [nextWide := stopIndex +1].
		nextWide > charIndex ifTrue: [ destX := (aBitBlt displayString: aString 
			from: charIndex 
			to: nextWide -1
			at: destX @ aPoint y
			strikeFont: self
			kern: kernDelta) x.
			charIndex := nextWide]. 
		nextWide > stopIndex ifFalse: [
		char := aString at: charIndex.
		(self hasGlyphOf: char)
			ifTrue: 
				[ self 
					glyphInfoOf: char
					into: glyphInfo.
				leftX := glyphInfo at: 2.
				rightX := glyphInfo at: 3.
				destY := glyphInfo at: 4.
				gfont := glyphInfo at: 5.
				(gfont == aBitBlt lastFont) ifFalse: [gfont installOn: aBitBlt].
				aBitBlt displayGlyph: (glyphInfo at: 1) at: (destX @ (baselineY - destY)) left: leftX right: rightX font: self.
				destX := destX + (rightX - leftX + kernDelta).
				 ] 
			ifFalse: 
				[fallbackFont displayString: aString on: aBitBlt from: charIndex to: charIndex at: destX@destY kern: kernDelta baselineY: baselineY.
				destX := destX + (fallbackFont widthOf: char) + kernDelta.
				charIndex := charIndex + 1]]].
	^ Array 
		with: charIndex
		with: aPoint + (destX @ 0)! !

!StrikeFont methodsFor: 'emphasis' stamp: 'lr 7/4/2009 10:42'!
emphasis: code 
	"Set the integer code for synthetic bold, itallic, underline, and strike-out, 
	where bold=1, italic=2, underlined=4, and struck out=8."
	emphasis := code! !

!StrikeFont methodsFor: 'emphasis' stamp: 'StephaneDucasse 10/17/2009 17:15'!
reset
	"Reset the cache of derivative emphasized fonts"
	fallbackFont class = FixedFaceFont ifTrue: [ fallbackFont := nil ].
	derivativeFonts notNil ifTrue: 
		[ derivativeFonts withIndexDo: 
			[ :f :i | 
			(f notNil and: [ f isSynthetic ]) ifTrue: 
				[ derivativeFonts 
					at: i
					put: nil ] ] ]
	"
	derivativeFonts := Array new: 32.
	#('B' 'I' 'BI') doWithIndex:
		[:tag :index | 
		(style := TextStyle named: self familyName) ifNotNil:
			[(font := style fontArray
				detect: [:each | each name = (self name , tag)]
				ifNone: [nil]) ifNotNil: [derivativeFonts at: index put: font]]]
	"! !

!StrikeFont methodsFor: 'emphasis' stamp: 'StephaneDucasse 10/25/2013 16:18'!
bonk: glyphForm with: bonkForm 
	"Bonking means to run through the glyphs clearing out black pixels
	between characters to prevent them from straying into an adjacent
	character as a result of, eg, bolding or italicizing"
	"Uses the bonkForm to erase at every character boundary in glyphs."
	| bb offset x |
	offset := bonkForm offset x.
	bb := BitBlt toForm: glyphForm.
	bb
		sourceForm: bonkForm;
		sourceRect: bonkForm boundingBox;
		combinationRule: Form erase;
		destY: 0.
	x := self xTable.
	(x isMemberOf: SparseLargeTable) 
		ifTrue: 
			[ x base 
				to: x size - 1
				do: 
					[ :i | 
					bb
						destX: (x at: i) + offset;
						copyBits ] ]
		ifFalse: 
			[ 1 
				to: x size - 1
				do: 
					[ :i | 
					bb
						destX: (x at: i) + offset;
						copyBits ] ]! !

!StrikeFont methodsFor: 'character shapes' stamp: 'StephaneDucasse 10/17/2009 17:15'!
ensureCleanBold
	"This ensures that all character glyphs have at least one pixel of white space on the right
	so as not to cause artifacts in neighboring characters in bold or italic."
	| wider glyph |
	emphasis = 0 ifFalse: [ ^ self ].
	minAscii 
		to: maxAscii
		do: 
			[ :i | 
			glyph := self characterFormAt: (Character value: i).
			(glyph copy: (glyph boundingBox topRight - (1 @ 0) corner: glyph boundingBox bottomRight)) isAllWhite ifFalse: 
				[ wider := Form 
					extent: (glyph width + 1) @ glyph height
					depth: glyph depth.
				glyph depth > 1 ifTrue: [ wider fillWhite ].
				glyph displayOn: wider.
				self 
					characterFormAt: (Character value: i)
					put: wider ] ]
	"
StrikeFont allInstancesDo: [:f | f ensureCleanBold].
(StrikeFont familyName: 'NewYork' size: 21) ensureCleanBold.
StrikeFont shutDown.  'Flush synthetic fonts'.
"! !

!StrikeFont methodsFor: 'character shapes' stamp: 'jmv 3/26/2009 14:40'!
makeLfInvisible
	self characterToGlyphMap.
	characterToGlyphMap at: 11 put: (11 < minAscii ifFalse: [11] ifTrue: [maxAscii+1])! !

!StrikeFont methodsFor: 'file in/out' stamp: 'lr 7/4/2009 10:42'!
writeAsStrike2named: fileName 
	"Write me onto a file in strike2 format.
	fileName should be of the form: <family name><pointSize>.sf2"
	| file |
	file := FileStream fileNamed: fileName.
	self writeAsStrike2On: file.
	file close! !

!StrikeFont methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
name: aString 
	"Set the receiver's name."
	name := aString! !

!StrikeFont methodsFor: 'emphasis' stamp: 'HenrikSperreJohansen 1/11/2010 23:03'!
isSynthetic
	^type > 0! !

!StrikeFont methodsFor: 'accessing' stamp: 'jmv 8/3/2009 10:01'!
widthOf: aCharacter 
	"Answer the width of the argument as a character in the receiver."
	| code |
	code := aCharacter charCode.
	self characterToGlyphMap size > code ifTrue: [
		code := characterToGlyphMap at: code + 1 ].
	((code < minAscii or: [maxAscii < code]) 
		or: [(xTable at: code + 1) < 0])
			ifTrue: [^ self fallbackFont widthOf: aCharacter].
	^ (xTable at: code + 2) - (xTable at: code + 1)! !

!StrikeFont methodsFor: 'private' stamp: 'yo 3/11/2005 07:38'!
createCharacterToGlyphMap
        "Private. Create the character to glyph mapping for a font that didn't have any before. This is basically equivalent to what the former setStopCondition did, only based on indexes."

        maxAscii < 256 ifTrue: [^ (1 to: 256) collect: [:i | i - 1]].
        ^ nil.
! !

!StrikeFont methodsFor: 'building' stamp: 'StephaneDucasse 10/17/2009 17:15'!
buildFromForm: allGlyphs data: data name: aString 
	| x |
	pointSize := data first.
	ascent := data second.
	descent := data third.
	minAscii := 32.
	maxAscii := 255.
	name := aString.
	type := 0.	"ignored for now"
	superscript := (ascent - descent) // 3.
	subscript := (descent - ascent) // 3.
	emphasis := 0.
	xTable := (Array new: 258) atAllPut: 0.
	maxWidth := 0.
	glyphs := allGlyphs.
	x := 0.
	minAscii 
		to: maxAscii + 1
		do: 
			[ :i | 
			x := data at: i - minAscii + 4.
			xTable 
				at: i + 1
				put: x ].
	xTable 
		at: 258
		put: x.
	self reset.
	derivativeFonts := Array new: 32! !

!StrikeFont methodsFor: 'emphasis' stamp: ''!
emphasis
	"Answer the integer code for synthetic bold, italic, underline, and 
	strike-out."

	^emphasis! !

!StrikeFont methodsFor: 'displaying' stamp: 'HenrikSperreJohansen 9/1/2009 00:41'!
displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta
	"Draw the given string from startIndex to stopIndex 
	at aPoint on the (already prepared) BitBlt."
	
		"Somewhat of a hack:
	The scanner seem to only pass in runs of either all ASCII or all non-ASCII characters. If all characters are ascii, then it's safe to use basic rendering-method."
	(aString hasWideCharacterFrom: startIndex to: stopIndex) ifTrue:  [^ self displayMultiString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta baselineY: aPoint y + self ascent.].

	^ aBitBlt displayString: aString 
			from: startIndex 
			to: stopIndex 
			at: aPoint 
			strikeFont: self
			kern: kernDelta.! !

!StrikeFont methodsFor: 'character shapes' stamp: 'lr 7/4/2009 10:42'!
extendMaxAsciiTo: newMax 
	"Extend the range of this font so that it can display glyphs up to newMax."
	newMax + 3 <= xTable size ifTrue: [ ^ self ].	"No need to extend."
	xTable size = (maxAscii + 3) ifFalse: [ ^ self error: 'This font is not well-formed.' ].

	"Insert a bunch of zero-width characters..."
	xTable := (xTable 
		copyFrom: 1
		to: maxAscii + 2) , ((maxAscii + 1 to: newMax) collect: [ :i | xTable at: maxAscii + 2 ]) , {  (xTable at: maxAscii + 3)  }.
	maxAscii := newMax.
	self fillZeroWidthSlots.
	characterToGlyphMap := nil! !

!StrikeFont methodsFor: 'multibyte character methods' stamp: 'lr 7/4/2009 10:42'!
setupDefaultFallbackFont
	| fonts f |
	fonts := TextStyle default fontArray.
	f := fonts first.
	1 
		to: fonts size
		do: [ :i | self height > (fonts at: i) height ifTrue: [ f := fonts at: i ] ].
	self fallbackFont: f.
	self reset! !

!StrikeFont methodsFor: 'displaying' stamp: 'ar 5/19/2000 15:08'!
installOn: aDisplayContext foregroundColor: foregroundColor backgroundColor: backgroundColor
	^aDisplayContext 
		installStrikeFont: self
		foregroundColor: foregroundColor 
		backgroundColor: backgroundColor! !

!StrikeFont methodsFor: 'multibyte character methods' stamp: 'MarcusDenker 9/24/2013 13:20'!
hasGlyphOf: aCharacter
	| code |
	code := aCharacter charCode.
	(code between: self minAscii and: self maxAscii)
		ifFalse: [ ^ false ].
	characterToGlyphMap ifNotNil: [ :map | code := map at: code + 1 ].
	(xTable at: code + 1) < 0
		ifTrue: [ ^ false ].
	^ true! !

!StrikeFont methodsFor: 'character shapes' stamp: 'StephaneDucasse 10/17/2009 17:15'!
makeLfVisible
	| glyph |
	self characterToGlyphMap.
	glyph := self characterFormAt: (Character value: 163).
	glyph 
		border: glyph boundingBox
		width: 1
		fillColor: Color blue.
	"	glyph := glyph reverse."
	self 
		characterFormAt: (Character value: 132)
		put: glyph.
	characterToGlyphMap 
		at: 11
		put: 132! !

!StrikeFont methodsFor: 'printing' stamp: 'sma 6/1/2000 09:32'!
printOn: aStream
	super printOn: aStream.
	aStream
		nextPut: $(;
		nextPutAll: self name;
		space;
		print: self height;
		nextPut: $)! !

!StrikeFont methodsFor: 'emphasis' stamp: 'StephaneDucasse 10/17/2009 17:15'!
isSynthetic: aBoolean 
	type := aBoolean 
		ifTrue: [ 3 ]
		ifFalse: [ 0 ]! !

!StrikeFont methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
fallbackFont: aFontSetOrNil 
	fallbackFont := aFontSetOrNil! !

!StrikeFont methodsFor: 'character shapes' stamp: 'lr 7/4/2009 10:42'!
makeCarriageReturnsWhite
	"Some larger fonts have a gray carriage return (from the zero wide fixup) make it white so it doesn't show"
	| crForm |
	crForm := self characterFormAt: 13 asCharacter.
	crForm fillWhite.
	self 
		characterFormAt: 13 asCharacter
		put: crForm! !

!StrikeFont methodsFor: 'accessing' stamp: 'nk 3/15/2004 18:57'!
derivativeFonts
	^derivativeFonts copyWithout: nil! !

!StrikeFont methodsFor: 'displaying' stamp: 'HenrikSperreJohansen 9/1/2009 00:40'!
displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta baselineY: baselineY
	"Draw the given string from startIndex to stopIndex 
	at aPoint on the (already prepared) BitBlt."
	
	"Somewhat of a hack:
	The scanner seem to only pass in runs of either all ASCII or all non-ASCII characters. If all characters are ascii, then it's safe to use basic rendering-method."
	(aString hasWideCharacterFrom: startIndex to: stopIndex) ifTrue: [^self displayMultiString: aString 
						on: aBitBlt 
						from: startIndex 
						to: stopIndex 
						at: aPoint 
						kern: kernDelta 
						baselineY: baselineY.].

	^ aBitBlt displayString: aString 
			from: startIndex 
			to: stopIndex
			at: aPoint 
			strikeFont: self
			kern: kernDelta.! !

!StrikeFont methodsFor: 'character shapes' stamp: 'jmv 3/26/2009 15:17'!
useLeftArrow
	self characterToGlyphMap.
	characterToGlyphMap at: 96 put: 95.
	characterToGlyphMap at: 95 put: 94! !

!StrikeFont methodsFor: 'character shapes' stamp: 'jmv 3/26/2009 14:40'!
makeTabInvisible
	self characterToGlyphMap.
	characterToGlyphMap at: 10 put: (10 < minAscii ifFalse: [10] ifTrue:[maxAscii+1])! !

!StrikeFont methodsFor: 'character shapes' stamp: 'jmv 8/6/2009 14:23'!
useUnderscoreIfOver1bpp

	glyphs depth = 1 ifTrue: [
		characterToGlyphMap ifNotNil: [	
			characterToGlyphMap at: 96 put: 95.
			characterToGlyphMap at: 95 put: 94 ].
		^self ].
	
	self characterToGlyphMap.
	characterToGlyphMap at: 96 put: 129.
	characterToGlyphMap at: 95 put: 128! !

!StrikeFont methodsFor: 'emphasis' stamp: 'StephaneDucasse 10/17/2009 17:15'!
makeCondensedGlyphs
	"Make a condensed set of glyphs with same widths.
	NOTE: this has been superceded by kerning -- should not get called"
	| g newXTable x x1 w |
	g := glyphs deepCopy.
	newXTable := Array new: xTable size.
	newXTable 
		at: 1
		put: (x := xTable at: 1).
	1 
		to: xTable size - 1
		do: 
			[ :i | 
			x1 := xTable at: i.
			w := (xTable at: i + 1) - x1.
			w > 1 ifTrue: [ w := w - 1 ].	"Shrink every character wider than 1"
			g 
				copy: (x @ 0 extent: w @ g height)
				from: x1 @ 0
				in: glyphs
				rule: Form over.
			newXTable 
				at: i + 1
				put: (x := x + w) ].
	xTable := newXTable.
	glyphs := g.
	self isSynthetic: true.
	fallbackFont ifNotNil: [ fallbackFont emphasized: 8 ]

	"
(TextStyle default fontAt: 1) copy makeCondensedGlyphs
	displayLine: 'The quick brown fox jumps over the lazy dog'
	at: Sensor cursorPoint
"! !

!StrikeFont methodsFor: 'file in/out' stamp: 'lr 7/4/2009 10:42'!
writeAsStrike2On: file 
	"Write me onto a file in strike2 format.
	fileName should be of the form: <family name><pointSize>.sf2"
	file binary.
	file nextInt32Put: 2.
	file nextInt32Put: minAscii.
	file nextInt32Put: maxAscii.
	file nextInt32Put: maxWidth.
	file nextInt32Put: ascent.
	file nextInt32Put: descent.
	file nextInt32Put: pointSize.
	superscript := (ascent - descent) // 3.
	subscript := (descent - ascent) // 3.
	file nextInt32Put: emphasis.
	(minAscii + 1 to: maxAscii + 3) do: [ :index | file nextInt32Put: (xTable at: index) ].
	glyphs writeOn: file.
	file close! !

!StrikeFont methodsFor: 'make arrows' stamp: 'lr 7/4/2009 10:42'!
makeAssignArrow
	"Replace the underline character with an arrow for this font"
	| arrowForm arrowCanvas arrowY arrowLeft arrowRight arrowHeadLength |
	arrowForm := (self characterFormAt: $_) copy.
	arrowCanvas := arrowForm getCanvas.
	arrowCanvas fillColor: Color white.
	arrowY := arrowForm height // 2.
	arrowLeft := 0.
	arrowRight := arrowForm width - 2.
	arrowHeadLength := (arrowRight - arrowLeft) * 2 // 5.
	"Draw the lines"
	arrowCanvas 
		line: arrowLeft @ arrowY
		to: arrowRight @ arrowY
		color: Color black.
	arrowCanvas 
		line: arrowLeft @ arrowY
		to: (arrowLeft + arrowHeadLength) @ (arrowY - arrowHeadLength)
		color: Color black.
	arrowCanvas 
		line: arrowLeft @ arrowY
		to: (arrowLeft + arrowHeadLength) @ (arrowY + arrowHeadLength)
		color: Color black.

	"Replace the glyph"
	self 
		characterFormAt: $_
		put: arrowForm! !

!StrikeFont methodsFor: 'accessing' stamp: ''!
superscript
	"Answer an integer that is the further vertical offset relative to the 
	baseline for positioning characters as superscripts."

	^superscript! !

!StrikeFont methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
characterToGlyphMap: anArray 
	characterToGlyphMap := anArray! !

!StrikeFont methodsFor: 'character shapes' stamp: 'lr 7/4/2009 10:42'!
characterForm: char pixelValueAt: pt put: val 
	| f |
	f := self characterFormAt: char.
	f 
		pixelAt: pt
		put: val.
	self 
		characterFormAt: char
		put: val! !

!StrikeFont methodsFor: 'displaying' stamp: 'yo 1/5/2005 13:59'!
installOn: aDisplayContext

	^aDisplayContext installStrikeFont: self.
! !

!StrikeFont methodsFor: 'multibyte character methods' stamp: 'lr 7/4/2009 10:42'!
fixAscent: a andDescent: d head: h 
	"(a + d) = (ascent + descent) ifTrue: ["
	| bb newGlyphs |
	ascent := a.
	descent := d.
	newGlyphs := Form extent: glyphs width @ (h + glyphs height).
	bb := BitBlt toForm: newGlyphs.
	bb 
		copy: (0 @ h extent: glyphs extent)
		from: 0 @ 0
		in: glyphs
		fillColor: nil
		rule: Form over.
	glyphs := newGlyphs
	"]."! !

!StrikeFont methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
characterToGlyphMap
	^ characterToGlyphMap ifNil: [ characterToGlyphMap := self createCharacterToGlyphMap ]! !

!StrikeFont methodsFor: 'character shapes' stamp: 'jmv 3/26/2009 14:49'!
useUnderscore
	self characterToGlyphMap.
	characterToGlyphMap at: 96 put: 129.
	characterToGlyphMap at: 95 put: 128! !

!StrikeFont methodsFor: 'character shapes' stamp: ''!
alter: char formBlock: formBlock
	self characterFormAt: char 
		put: (formBlock value: (self characterFormAt: char))! !

!StrikeFont methodsFor: 'character shapes' stamp: 'lr 7/4/2009 10:42'!
characterFormAt: character 
	"Answer a Form copied out of the glyphs for the argument, character."
	| ascii leftX rightX |
	ascii := character charCode.
	(ascii 
		between: minAscii
		and: maxAscii) ifFalse: [ ascii := maxAscii + 1 ].
	leftX := xTable at: ascii + 1.
	rightX := xTable at: ascii + 2.
	leftX < 0 ifTrue: [ ^ glyphs copy: (0 @ 0 corner: 0 @ self height) ].
	^ glyphs copy: (leftX @ 0 corner: rightX @ self height)! !

!StrikeFont methodsFor: 'file in/out' stamp: 'MarcusDenker 3/25/2013 16:09'!
newFromStrike: fileName 
	"Build an instance from the strike font file name. The '.strike' extension
	is optional."
	| strike startName raster16  |
	name := fileName copyUpTo: $..	"assumes extension (if any) is '.strike'"
	strike := FileStream readOnlyFileNamed: name , '.strike.'.
	strike binary.

	"strip off direcory name if any"
	startName := name size.
	
	[ startName > 0 and: [ (name at: startName) ~= $> & ((name at: startName) ~= $]) ] ] whileTrue: [ startName := startName - 1 ].
	name := name 
		copyFrom: startName + 1
		to: name size.
	type := strike nextWord.	"type is ignored now -- simplest
												assumed.  Kept here to make
												writing and consistency more
												straightforward."
	minAscii := strike nextWord.
	maxAscii := strike nextWord.
	maxWidth := strike nextWord.
	strike nextWord. "strikeLength"
	ascent := strike nextWord.
	descent := strike nextWord.
	strike nextWord. "xOffset"
	raster16 := strike nextWord.
	superscript := (ascent - descent) // 3.
	subscript := (descent - ascent) // 3.
	emphasis := 0.
	glyphs := Form 
		extent: (raster16 * 16) @ self height
		offset: 0 @ 0.
	glyphs bits fromByteStream: strike.
	xTable := (Array new: maxAscii + 3) atAllPut: 0.
	(minAscii + 1 to: maxAscii + 3) do: 
		[ :index | 
		xTable 
			at: index
			put: strike nextWord ].

	"Set up space character"
	((xTable at: Space asciiValue + 2) = 0 or: [ (xTable at: Space asciiValue + 2) = (xTable at: Space asciiValue + 1) ]) ifTrue: 
		[ Space asciiValue + 2 
			to: xTable size
			do: 
				[ :index | 
				xTable 
					at: index
					put: (xTable at: index) + DefaultSpace ] ].
	strike close.
	characterToGlyphMap := nil! !

!StrikeFont methodsFor: 'emphasis' stamp: 'jmv 3/20/2009 10:27'!
derivativeFont: aStrikeFont at: index

	| newDeriv |
	(aStrikeFont isNil and: [ index = 0 ]) 
		ifTrue: [derivativeFonts := nil. ^ self].
	derivativeFonts ifNil: [derivativeFonts := Array new: 32].
	derivativeFonts size < 32 ifTrue: [
		newDeriv := Array new: 32.
		newDeriv replaceFrom: 1 to: derivativeFonts size with: derivativeFonts.
		derivativeFonts := newDeriv.
	].
	derivativeFonts at: index put: aStrikeFont.! !

!StrikeFont methodsFor: 'accessing' stamp: 'sw 1/18/2000 20:54'!
pointSize
	^ pointSize! !

!StrikeFont methodsFor: 'accessing' stamp: ''!
maxWidth
	"Answer the integer that is the width of the receiver's widest character."

	^maxWidth! !

!StrikeFont methodsFor: 'multibyte character methods' stamp: 'lr 7/4/2009 10:42'!
fixXTable
	| newXTable val |
	xTable size >= 258 ifTrue: [ ^ self ].
	newXTable := Array new: 258.
	1 
		to: xTable size
		do: 
			[ :i | 
			newXTable 
				at: i
				put: (xTable at: i) ].
	val := xTable at: xTable size.
	xTable size + 1 
		to: 258
		do: 
			[ :i | 
			newXTable 
				at: i
				put: val ].
	minAscii := 0.
	maxAscii := 255.
	xTable := newXTable! !

!StrikeFont methodsFor: 'emphasis' stamp: 'StephaneDucasse 10/17/2009 17:15'!
makeStruckOutGlyphs
	"Make a struck-out set of glyphs with same widths"
	| g |
	g := glyphs deepCopy.
	g fillBlack: (0 @ (self ascent - (self ascent // 3)) extent: g width @ 1).
	glyphs := g.
	self isSynthetic: true.
	fallbackFont ifNotNil: [ fallbackFont := fallbackFont emphasized: 16 ]! !

!StrikeFont methodsFor: 'accessing' stamp: ''!
ascent
	"Answer the receiver's maximum extent of characters above the baseline."

	^ascent! !

!StrikeFont methodsFor: 'accessing' stamp: 'di 9/2/2000 13:06'!
ascentKern
	"Return the kern delta for ascenders."
	(emphasis noMask: 2) ifTrue: [^ 0].
	^ (self ascent-5+4)//4 max: 0  "See makeItalicGlyphs"

! !

!StrikeFont methodsFor: 'make arrows' stamp: 'lr 7/4/2009 10:42'!
makeReturnArrow
	"Replace the caret character with an arrow"
	| arrowForm arrowCanvas arrowHeadLength arrowX arrowTop arrowBottom |
	arrowForm := (self characterFormAt: $^) copy.
	arrowCanvas := arrowForm getCanvas.
	arrowCanvas fillColor: Color white.
	arrowHeadLength := (arrowForm width - 2) // 2.
	arrowX := arrowHeadLength max: arrowForm width // 2.
	arrowTop := arrowForm height // 4.
	arrowBottom := arrowTop + (arrowForm width * 4 // 5).
	arrowBottom := (arrowBottom min: arrowForm height) max: arrowForm height * 2 // 3.

	"Draw the lines"
	arrowCanvas 
		line: arrowX @ arrowTop
		to: arrowX @ arrowBottom
		color: Color black.
	arrowCanvas 
		line: arrowX @ arrowTop
		to: (arrowX - arrowHeadLength) @ (arrowTop + arrowHeadLength)
		color: Color black.
	arrowCanvas 
		line: arrowX @ arrowTop
		to: (arrowX + arrowHeadLength) @ (arrowTop + arrowHeadLength)
		color: Color black.

	"Replace the glyph"
	self 
		characterFormAt: $^
		put: arrowForm! !

!StrikeFont methodsFor: 'character shapes' stamp: 'StephaneDucasse 10/17/2009 17:15'!
characterFormAt: character put: characterForm 
	"Copy characterForm over the glyph for the argument, character."
	| ascii leftX rightX widthDif newGlyphs |
	ascii := character asciiValue.
	ascii < minAscii ifTrue: [ ^ self error: 'Cant store characters below min ascii' ].
	ascii > maxAscii ifTrue: 
		[ (self confirm: 'This font does not accomodate ascii values higher than ' , maxAscii printString , '.
Do you wish to extend it permanently to handle values up to ' , ascii printString) 
			ifTrue: [ self extendMaxAsciiTo: ascii ]
			ifFalse: [ ^ self error: 'No change made' ] ].
	leftX := xTable at: ascii + 1.
	rightX := xTable at: ascii + 2.
	widthDif := characterForm width - (rightX - leftX).
	widthDif ~= 0 ifTrue: 
		[ "Make new glyphs with more or less space for this char"
		newGlyphs := Form 
			extent: (glyphs width + widthDif) @ glyphs height
			depth: glyphs depth.
		newGlyphs 
			copy: (0 @ 0 corner: leftX @ glyphs height)
			from: 0 @ 0
			in: glyphs
			rule: Form over.
		newGlyphs 
			copy: ((rightX + widthDif) @ 0 corner: newGlyphs width @ glyphs height)
			from: rightX @ 0
			in: glyphs
			rule: Form over.
		glyphs := newGlyphs.
		"adjust further entries on xTable"
		xTable := xTable copy.
		ascii + 2 
			to: xTable size
			do: 
				[ :i | 
				xTable 
					at: i
					put: (xTable at: i) + widthDif ] ].
	glyphs 
		copy: (leftX @ 0 extent: characterForm extent)
		from: 0 @ 0
		in: characterForm
		rule: Form over
	"
| f |  f := TextStyle defaultFont.
f characterFormAt: $  put: (Form extent: (f widthOf: $ )+10@f height)
"! !

!StrikeFont methodsFor: 'file in/out' stamp: 'HenrikSperreJohansen 6/12/2010 02:30'!
restOfLine: leadString from: file 
	"Utility method to assist reading of BitFont data files"
	| line |
	
	[ line := file nextLine.
	line size < leadString size or: [ leadString ~= (line 
			copyFrom: 1
			to: leadString size) ] ] whileTrue: [ file atEnd ifTrue: [ ^ nil ] ].
	^ line 
		copyFrom: leadString size + 1
		to: line size! !

!StrikeFont methodsFor: 'accessing' stamp: ''!
height
	"Answer the height of the receiver, total of maximum extents of 
	characters above and below the baseline."

	^self ascent + self descent! !

!StrikeFont methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
setGlyphs: newGlyphs 
	"Replace the glyphs form.  Used to make a synthetic bold or italic font quickly."
	glyphs := newGlyphs! !

!StrikeFont methodsFor: 'file in/out' stamp: 'lr 7/4/2009 10:42'!
displayChar: ascii form: charForm 
	"Convenience utility used during conversion of BitFont files"
	| m bigForm |
	Display fillBlack: (0 @ 0 extent: 20 @ 14).
	ascii printString displayAt: 0 @ 2.
	charForm width > 0 ifTrue: 
		[ m := 5.
		bigForm := charForm 
			magnify: charForm boundingBox
			by: m @ m.
		Display 
			border: ((bigForm boundingBox expandBy: m) translateBy: 50 @ 2)
			width: m.
		bigForm displayAt: 50 @ 2.
		Display fillBlack: (50 @ 2 + ((m * charForm width) @ 0) extent: 1 @ (m * self height)) ]! !

!StrikeFont methodsFor: 'multibyte character methods' stamp: 'lr 7/4/2009 10:42'!
readCharacter: aBits from: aStream 
	| pos |
	pos := 0.
	12 timesRepeat: 
		[ 1 
			to: 2
			do: 
				[ :w | 
				aBits 
					byteAt: pos + w
					put: aStream next ].
		pos := pos + 4 ]! !

!StrikeFont methodsFor: 'emphasis' stamp: 'HenrikSperreJohansen 1/11/2010 23:04'!
makeItalicGlyphs
	"Make an italic set of glyphs with same widths by skewing left and right.
	In the process, characters would overlap, so we widen them all first.
	"
	| extraWidth newGlyphs newXTable x newX w extraOnLeft |
	extraOnLeft := (self height - 1 - self ascent + 4) // 4 max: 0.
	extraWidth := ((self ascent - 5 + 4) // 4 max: 0) + extraOnLeft.
	newGlyphs := Form 
		extent: (glyphs width + ((maxAscii + 1 - minAscii) * extraWidth)) @ glyphs height
		depth: glyphs depth.
	newGlyphs fillWhite.
	newXTable := xTable copy.

	"Copy glyphs into newGlyphs with room on left and right for overlap."
	minAscii 
		to: maxAscii + 1
		do: 
			[ :ascii | 
			x := xTable at: ascii + 1.
			w := (xTable at: ascii + 2) - x.
			newX := newXTable at: ascii + 1.
			newGlyphs 
				copy: ((newX + extraOnLeft) @ 0 extent: w @ glyphs height)
				from: x @ 0
				in: glyphs
				rule: Form over.
			newXTable 
				at: ascii + 2
				put: newX + w + extraWidth ].
	glyphs := newGlyphs.
	xTable := newXTable.
	"Slide the bitmaps left and right for synthetic italic effect."
	4 
		to: self ascent - 1
		by: 4
		do: 
			[ :y | 
			"Slide ascenders right..."
			glyphs 
				copy: (1 @ 0 extent: glyphs width @ (self ascent - y))
				from: 0 @ 0
				in: glyphs
				rule: Form over ].
	self ascent 
		to: self height - 1
		by: 4
		do: 
			[ :y | 
			"Slide descenders left..."
			glyphs 
				copy: (0 @ y extent: glyphs width @ glyphs height)
				from: 1 @ y
				in: glyphs
				rule: Form over ].
	self isSyntheticItalic: true.
	fallbackFont ifNotNil: [ fallbackFont := fallbackFont emphasized: 2 ]! !

!StrikeFont methodsFor: 'accessing' stamp: ''!
xTable
	"Answer an Array of the left x-coordinate of characters in glyphs."

	^xTable! !

!StrikeFont methodsFor: 'character shapes' stamp: 'lr 7/4/2009 10:42'!
fillZeroWidthSlots
	"Note: this is slow because it copies the font once for every replacement."
	| nullGlyph |
	nullGlyph := (Form extent: 1 @ glyphs height) fillGray.
	"Now fill the empty slots with narrow box characters."
	minAscii 
		to: maxAscii
		do: 
			[ :i | 
			(self widthOf: (Character value: i)) = 0 ifTrue: 
				[ self 
					characterFormAt: (Character value: i)
					put: nullGlyph ] ]! !

!StrikeFont methodsFor: 'testing' stamp: 'lr 7/4/2009 10:42'!
checkCharacter: character 
	"Answer a Character that is within the ascii range of the receiver--either 
	character or the last character in the receiver."
	| ascii |
	ascii := character asciiValue.
	(ascii < minAscii or: [ ascii > maxAscii ]) 
		ifTrue: [ ^ maxAscii asCharacter ]
		ifFalse: [ ^ character ]! !

!StrikeFont methodsFor: 'emphasis' stamp: 'StephaneDucasse 5/28/2011 13:50'!
isSyntheticItalic
	^type = 5! !

!StrikeFont methodsFor: 'file in/out' stamp: 'lr 7/4/2009 10:42'!
readFromStrike2Stream: file 
	"Build an instance from the supplied binary stream on data in strike2 format"
	type := file nextInt32.
	type = 2 ifFalse: 
		[ file close.
		self error: 'not strike2 format' ].
	minAscii := file nextInt32.
	maxAscii := file nextInt32.
	maxWidth := file nextInt32.
	ascent := file nextInt32.
	descent := file nextInt32.
	pointSize := file nextInt32.
	superscript := (ascent - descent) // 3.
	subscript := (descent - ascent) // 3.
	emphasis := file nextInt32.
	xTable := (Array new: maxAscii + 3) atAllPut: 0.
	(minAscii + 1 to: maxAscii + 3) do: 
		[ :index | 
		xTable 
			at: index
			put: file nextInt32 ].
	glyphs := Form new readFrom: file.

	"Set up space character"
	((xTable at: Space asciiValue + 2) = 0 or: [ (xTable at: Space asciiValue + 2) = (xTable at: Space asciiValue + 1) ]) ifTrue: 
		[ Space asciiValue + 2 
			to: xTable size
			do: 
				[ :index | 
				xTable 
					at: index
					put: (xTable at: index) + DefaultSpace ] ].
	characterToGlyphMap := nil! !

!StrikeFont methodsFor: '*system-settings-browser' stamp: 'AlainPlantec 1/30/2010 14:48'!
settingStoreOn: aStream 
	aStream nextPut: $(.
	aStream nextPutAll: self class name.
	aStream nextPut: Character space.
	aStream nextPutAll: 'familyName: ''', self familyName, ''' pointSize: ', self pointSize asString, ' emphasized: ', self emphasis asString.
	aStream nextPut: $)
! !

!StrikeFont methodsFor: 'emphasis' stamp: 'lr 7/4/2009 10:42'!
emphasized: code 
	"Answer a copy of the receiver with emphasis set to include code."
	| derivative addedEmphasis base safeCode |
	code = 0 ifTrue: [ ^ self ].
	(derivativeFonts == nil or: [ derivativeFonts size = 0 ]) ifTrue: [ ^ self ].
	derivative := derivativeFonts at: (safeCode := code min: derivativeFonts size).
	derivative == nil ifFalse: [ ^ derivative ].	"Already have this style"

	"Dont have it -- derive from another with one with less emphasis"
	addedEmphasis := 1 bitShift: safeCode highBit - 1.
	base := self emphasized: safeCode - addedEmphasis.	"Order is Bold, Ital, Under, Narrow"
	addedEmphasis = 1 ifTrue: 
		[ "Compute synthetic bold version of the font"
		derivative := (base copy ensureCleanBold name: base name , 'B') makeBoldGlyphs ].
	addedEmphasis = 2 ifTrue: 
		[ "Compute synthetic italic version of the font"
		derivative := (base copy name: base name , 'I') makeItalicGlyphs ].
	addedEmphasis = 4 ifTrue: 
		[ "Compute underlined version of the font"
		derivative := (base copy name: base name , 'U') makeUnderlinedGlyphs ].
	addedEmphasis = 8 ifTrue: 
		[ "Compute narrow version of the font"
		derivative := (base copy name: base name , 'N') makeCondensedGlyphs ].
	addedEmphasis = 16 ifTrue: 
		[ "Compute struck-out version of the font"
		derivative := (base copy name: base name , 'X') makeStruckOutGlyphs ].
	derivative emphasis: safeCode.
	derivativeFonts 
		at: safeCode
		put: derivative.
	^ derivative! !

!StrikeFont methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
fallbackFont
	^ fallbackFont ifNil: [ fallbackFont := FixedFaceFont new errorFont fontSize: self height ]! !

!StrikeFont methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/17/2013 10:42'!
familyName
	| nameString firstDigit |
	nameString := self name.
	firstDigit := nameString findFirst: [ :m | m isDigit ].
	^ firstDigit > 0
		ifTrue: [ (nameString copyFrom: 1 to: firstDigit - 1) trimRight ]
		ifFalse: [ nameString ]! !

!StrikeFont methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 1/11/2010 23:22'!
baseKern
	"Return the base kern value to be used for all characters."
	
	| italic |

	italic := emphasis allMask: 2.	
	"Are we a bitmapped font with alpha, whose italic property is not synthetic?"
	(self isSyntheticItalic not and: [ glyphs depth > 1 ]) ifTrue: [
		^(italic or: [ pointSize < 9 ])
			ifTrue: [ 1 ]
			ifFalse: [ 0] ].
	
	italic ifFalse: [^ 0].
	^ ((self height-1-self ascent+4)//4 max: 0)  "See makeItalicGlyphs"
		+ (((self ascent-5+4)//4 max: 0))! !

!StrikeFont methodsFor: 'building' stamp: 'StephaneDucasse 10/17/2009 17:15'!
stripHighGlyphs
	"Remove glyphs for characters above 128"
	| i |
	maxAscii := 127.
	xTable := xTable 
		copyFrom: 1
		to: maxAscii + 3.
	i := xTable at: maxAscii + 1.
	xTable 
		at: maxAscii + 2
		put: i.
	xTable 
		at: maxAscii + 3
		put: i.
	glyphs := glyphs copy: (0 @ 0 extent: i @ glyphs height).
	maxWidth := 0.
	2 
		to: xTable size
		do: [ :ii | maxWidth := maxWidth max: (xTable at: ii) - (xTable at: ii - 1) - 1 ].
	characterToGlyphMap := nil.
	self reset! !

!StrikeFont methodsFor: 'accessing' stamp: 'tk 6/26/1998 16:45'!
familySizeFace
	"Answer an array with familyName, a String, pointSize, an Integer, and
	faceCode, an Integer."

	^Array with: name
		with: self height
		with: emphasis

	"(1 to: 12) collect: [:x | (TextStyle default fontAt: x) familySizeFace]"! !

!StrikeFont methodsFor: 'copying' stamp: 'BG 12/9/2004 17:35'!
postCopy
 " the receiver is a just created shallow copy. This method gives it the final touch. " 
 
    glyphs := glyphs copy.
    xTable := xTable copy.
    characterToGlyphMap := characterToGlyphMap copy.
 
    self reset.  " takes care of the derivative fonts "! !

!StrikeFont methodsFor: 'displaying' stamp: 'nice 1/5/2010 15:59'!
characters: anInterval in: sourceString displayAt: aPoint clippedBy: clippingRectangle rule: ruleInteger fillColor: aForm kernDelta: kernDelta on: aBitBlt 
	"Simple, slow, primitive method for displaying a line of characters.
	No wrap-around is provided."
	| destPoint |
	destPoint := aPoint.
	anInterval do: 
		[ :i | | rightX sourceRect leftX ascii | 
		self flag: #yoDisplay.
		"if the char is not supported, fall back to the specified fontset."
		ascii := (sourceString at: i) charCode.
		(ascii < minAscii or: [ ascii > maxAscii ]) ifTrue: [ ascii := maxAscii ].
		leftX := xTable at: ascii + 1.
		rightX := xTable at: ascii + 2.
		sourceRect := leftX @ 0 extent: (rightX - leftX) @ self height.
		aBitBlt 
			copyFrom: sourceRect
			in: glyphs
			to: destPoint.
		destPoint := destPoint + ((rightX - leftX + kernDelta) @ 0)
		"destPoint printString displayAt: 0@(i*20)" ].
	^ destPoint! !

!StrikeFont methodsFor: 'accessing' stamp: 'jmv 3/19/2009 15:50'!
descent
	"Answer the receiver's maximum extent of characters below the baseline."

	^pointSize < 9
		ifTrue: [descent-1]
		ifFalse: [descent]! !

!StrikeFont methodsFor: 'character shapes' stamp: 'jmv 3/26/2009 14:41'!
makeTabVisible
	self characterToGlyphMap.
	characterToGlyphMap at: 10 put: 172! !

!StrikeFont methodsFor: 'building' stamp: 'StephaneDucasse 10/17/2009 17:15'!
setGlyphsDepthAtMost: aNumber 
	glyphs depth > aNumber ifTrue: [ glyphs := glyphs asFormOfDepth: aNumber ]! !

!StrikeFont methodsFor: 'accessing' stamp: 'ls 3/27/2000 19:54'!
name
	"Answer the receiver's name."

	^name ifNil: ['(unnamed)']! !

!StrikeFont methodsFor: 'accessing' stamp: ''!
maxAscii
	"Answer the integer that is the last Ascii character value of the receiver."

	^maxAscii! !

!StrikeFont methodsFor: 'accessing' stamp: ''!
subscript
	"Answer an integer that is the further vertical offset relative to the 
	baseline for positioning characters as subscripts."

	^subscript! !

!StrikeFont methodsFor: 'accessing' stamp: ''!
raster
	"Answer an integer that specifies the layout of the glyphs' form."

	^raster! !

!StrikeFont methodsFor: '*Athens-Text' stamp: 'NicolaiHess 7/2/2014 19:58'!
asAthensFontDescription
	^ AthensFontDescription new family: self familyName; fontSize: self pointSize.
! !

!StrikeFont methodsFor: 'emphasis' stamp: 'nk 3/15/2004 18:46'!
releaseCachedState

	self reset.! !

!StrikeFont methodsFor: 'emphasis' stamp: 'StephaneDucasse 10/17/2009 17:15'!
makeUnderlinedGlyphs
	"Make an underlined set of glyphs with same widths"
	| g |
	g := glyphs deepCopy.
	g fillBlack: (0 @ (self ascent + 1) extent: g width @ 1).
	glyphs := g.
	self isSynthetic: true.
	fallbackFont ifNotNil: [ fallbackFont := fallbackFont emphasized: 4 ]! !

!StrikeFont methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 8/31/2010 00:33'!
glyphInfoOf: aCharacter into: glyphInfoArray
	"Answer the width of the argument as a character in the receiver."

	| code |
	(self hasGlyphOf: aCharacter) ifFalse: [
		fallbackFont ifNotNil: [
			^ fallbackFont glyphInfoOf: aCharacter into: glyphInfoArray.
		].
		code := 0.
	] ifTrue: [
		code := characterToGlyphMap 
				ifNotNil: [:map | map at: aCharacter charCode +1] 
				ifNil: [aCharacter charCode].
	].
	glyphInfoArray at: 1 put: glyphs;
		at: 2 put: (xTable at: code + 1);
		at: 3 put: (xTable at: code + 2);
		at: 4 put: (self ascentOf: aCharacter);
		at: 5 put: self.
	^ glyphInfoArray.
! !

!StrikeFont methodsFor: 'character shapes' stamp: 'nice 1/5/2010 15:59'!
widen: char by: delta 
	
	^ self 
		alter: char
		formBlock: 
			[ :charForm | | newForm | 
			"Make a new form, wider or narrower..."
			newForm := Form extent: charForm extent + (delta @ 0).
			charForm displayOn: newForm.	"Copy this image into it"
			newForm	"and substitute it in the font" ]! !

!StrikeFont methodsFor: 'accessing' stamp: ''!
lineGrid
	^ ascent + descent! !

!StrikeFont methodsFor: 'copying' stamp: 'tk 8/19/1998 16:15'!
veryDeepCopyWith: deepCopier
	"Return self.  I am shared.  Do not record me."! !

!StrikeFont methodsFor: 'accessing' stamp: 'nk 6/17/2003 14:26'!
textStyle
	^ TextStyle actualTextStyles detect:
		[:aStyle | aStyle fontArray includes: self] ifNone: [nil]! !

!StrikeFont methodsFor: 'character shapes' stamp: 'lr 7/4/2009 10:42'!
fixOneWideChars
	"This fixes all 1-wide characters to be 2 wide with blank on the right
	so as not to cause artifacts in neighboring characters in bold or italic."
	| twoWide |
	minAscii 
		to: maxAscii
		do: 
			[ :i | 
			(self widthOf: (Character value: i)) = 1 ifTrue: 
				[ twoWide := Form extent: 2 @ glyphs height.
				(self characterFormAt: (Character value: i)) 
					displayOn: twoWide
					at: 0 @ 0.
				self 
					characterFormAt: (Character value: i)
					put: twoWide ] ]
	"
StrikeFont allInstancesDo: [:f | f fixOneWideChars].
StrikeFont shutDown.  'Flush synthetic fonts'.
"! !

!StrikeFont methodsFor: 'character shapes' stamp: 'MarcusDenker 10/2/2013 20:20'!
makeControlCharsVisible
	| glyph |
	self characterToGlyphMap.
	glyph := self characterFormAt: Character space.
	glyph 
		border: glyph boundingBox
		width: 1
		fillColor: Color blue.
	self 
		characterFormAt: (Character value: 133)
		put: glyph.

	"Keep tab(9), lf(10), cr(13) and space(32) transparent or whatever the user chose"
	#(
		0
		1
		2
		3
		4
		5
		6
		7
		8
		11
		12
		14
		15
		16
		17
		18
		19
		20
		21
		22
		23
		24
		25
		26
		27
		28
		29
		30
		31
	) do: 
		[ :ascii | 
		characterToGlyphMap 
			at: ascii + 1
			put: 133 ]! !

!StrikeFont methodsFor: 'accessing' stamp: 'di 9/2/2000 13:06'!
descentKern
	"Return the kern delta for descenders."
	(emphasis noMask: 2) ifTrue: [^ 0].
	^ (self height-1-self ascent+4)//4 max: 0  "See makeItalicGlyphs"

! !

!StrikeFont methodsFor: 'copying' stamp: 'BG 12/9/2004 17:27'!
deepCopy
 " there is a circular reference from the derivative fonts back to the receiver. It is therefore not possible to make a deep copy. We make a sahllow copy. The method postCopy can be used to modify the shallow copy. " 
  ^self copy! !

!StrikeFont methodsFor: 'emphasis' stamp: 'StephaneDucasse 10/17/2009 17:15'!
makeBoldGlyphs
	"Make a bold set of glyphs with same widths by ORing 1 bit to the right
		(requires at least 1 pixel of intercharacter space)"
	| g bonkForm |
	g := glyphs deepCopy.
	bonkForm := (Form extent: 1 @ 16) fillBlack offset: -1 @ 0.
	self 
		bonk: g
		with: bonkForm.
	glyphs depth = 1 
		ifTrue: 
			[ g 
				copyBits: g boundingBox
				from: g
				at: 1 @ 0
				clippingBox: g boundingBox
				rule: Form under
				fillColor: nil ]
		ifFalse: 
			[ 0 
				to: g width - 2
				do: 
					[ :x | 
					0 
						to: g height - 1
						do: 
							[ :y | 
							(glyphs colorAt: x @ y) = Color white ifFalse: 
								[ g 
									colorAt: (x + 1) @ y
									put: ((glyphs colorAt: (x + 1) @ y) = Color white 
											ifTrue: [ glyphs colorAt: x @ y ]
											ifFalse: [ Color black ]) ] ] ] ].
	glyphs := g.
	self isSynthetic: true.
	fallbackFont ifNotNil: [ fallbackFont := fallbackFont emphasized: 1 ]! !

!StrikeFont methodsFor: 'accessing' stamp: ''!
minAscii
	"Answer the integer that is the first Ascii character value of the receiver."

	^minAscii! !

!StrikeFont methodsFor: 'file in/out' stamp: 'MarcusDenker 9/12/2013 16:39'!
readFromStrike2: fileName 
	"StrikeFont new readFromStrike2: 'Palatino14.sf2'"
	"Build an instance from the strike font stored in strike2 format.
	fileName is of the form: <family name><pointSize>.sf2"
	| file |
	self assert:['*.sf2' match: fileName]. "likely incompatible"
	name := fileName copyUpTo: $..	"Drop filename extension"
	file := FileStream readOnlyFileNamed: fileName.
	file binary.
	[ self readFromStrike2Stream: file ] ensure: [ file close ]! !

!StrikeFont methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
glyphOf: aCharacter 
	"Answer the width of the argument as a character in the receiver."
	| code |
	(self hasGlyphOf: aCharacter) ifFalse: 
		[ fallbackFont ifNotNil: [ ^ fallbackFont glyphOf: aCharacter ].
		^ (Form extent: 1 @ self height) fillColor: Color white ].
	code := aCharacter charCode.
	^ glyphs copy: ((xTable at: code + 1) @ 0 corner: (xTable at: code + 2) @ self height)! !

!StrikeFont methodsFor: '*Athens-Text' stamp: 'IgorStasenko 11/20/2013 14:14'!
asFreetypeFont

		self error: 'not supported yet. and ever'! !

!StrikeFont methodsFor: 'file in/out' stamp: 'lr 7/4/2009 10:42'!
readBFHeaderFrom: f 
	name := self 
		restOfLine: 'Font name = '
		from: f.
	ascent := (self 
		restOfLine: 'Ascent = '
		from: f) asNumber.
	descent := (self 
		restOfLine: 'Descent = '
		from: f) asNumber.
	maxWidth := (self 
		restOfLine: 'Maximum width = '
		from: f) asNumber.
	pointSize := (self 
		restOfLine: 'Font size = '
		from: f) asNumber.
	name := (name copyWithout: Character space) , (pointSize < 10 
			ifTrue: [ '0' , pointSize printString ]
			ifFalse: [ pointSize printString ]).
	minAscii := 258.
	maxAscii := 0.
	superscript := (ascent - descent) // 3.
	subscript := (descent - ascent) // 3.
	emphasis := 0.
	type := 0	"ignored for now"! !

!StrikeFont class methodsFor: 'accessing' stamp: 'AlainPlantec 9/13/2011 21:32'!
defaultFontSize
	^ 9
! !

!StrikeFont class methodsFor: 'accessing' stamp: 'nk 9/1/2004 11:00'!
actualFamilyNames
	"Answer a sorted list of actual family names, without the Default aliases"

	^(self familyNames copyWithoutAll: TextStyle defaultFamilyNames) asOrderedCollection! !

!StrikeFont class methodsFor: 'derivative font caching' stamp: 'AlainPlantec 9/12/2011 18:58'!
shutDown
	"StrikeFont shutDown"
	"Deallocate synthetically derived copies of base fonts to save space"
	self allSubInstancesDo: [ :sf | sf reset ].
	StrikeFontSet allSubInstancesDo: [ :sf | sf reset ].
! !

!StrikeFont class methodsFor: 'removing' stamp: 'jmv 3/31/2009 08:19'!
saveSpace
	"Removes glyphs over 128, leaving only lower ascii.
	Also limit glyph depth to 4 bits (it is usually 16 or 32).
	This effectively turns off subpixel rendering, as glyphs will only have 16 shades of gray.
	
	StrikeFont saveSpace
	"
	StrikeFont allInstances do: [ :f | f
		stripHighGlyphs;
		setGlyphsDepthAtMost: 4 ].! !

!StrikeFont class methodsFor: 'font creation' stamp: ''!
fromStrike: fileName 
	"Read a font from disk in the old ST-80 'strike' format.
	Note: this is an old format; use strike2 format instead"

	^self new newFromStrike: fileName! !

!StrikeFont class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/1/2012 16:07'!
fromUser: priorFont allowKeyboard: aBoolean 
	"Present a menu of available fonts, and if one is chosen, return it. Otherwise return nil."
	"StrikeFont fromUser"
	| fontList fontMenu spec font style |
	fontList := StrikeFont actualFamilyNames.
	fontMenu := UIManager default newMenuIn: self for: self.
	fontList do: 
		[ :fontName | | label active ptMenu | 
		style := TextStyle named: fontName.
		active := priorFont familyName sameAs: fontName.
		ptMenu := UIManager default newMenuIn: self for: self.
		style pointSizes do: 
			[ :pt | 	
			ptMenu 
				add: (active and: [ pt = priorFont pointSize ]) ->  (pt printString , ' pt')
				target: fontMenu
				selector: #modalSelection:
				argument: {  fontName . pt  } ].
		style isTTCStyle ifTrue: 
			[ ptMenu 
				add: 'new size'
				target: style
				selector: #addNewFontSizeDialog:
				argument: {  fontName. fontMenu  } ].
		label := active -> fontName.
		fontMenu 
			add: label
			subMenu: ptMenu ].
	spec := fontMenu 
		invokeModalAt: ActiveHand position
		in: ActiveWorld
		allowKeyboard: aBoolean.
	spec ifNil: [ ^ nil ].
	style := TextStyle named: spec first.
	style ifNil: [ ^ self ].
	font := style fonts 
		detect: [ :any | any pointSize = spec last ]
		ifNone: [ nil ].
	^ font! !

!StrikeFont class methodsFor: 'instance creation' stamp: 'pavel.krivanek 11/21/2008 16:58'!
fromUser: priorFont
	
	^ UIManager default fontFromUser: priorFont.! !

!StrikeFont class methodsFor: 'font creation' stamp: 'ar 6/4/2000 21:14'!
primitiveFont: fontHandle glyphOfChar: charIndex into: glyphForm
	<primitive:'primitiveFontGlyphOfChar' module:'FontPlugin'>
	^self primitiveFailed! !

!StrikeFont class methodsFor: 'font creation' stamp: 'ar 6/4/2000 21:15'!
primitiveFont: fontHandle widthOfChar: charIndex
	<primitive:'primitiveFontWidthOfChar' module:'FontPlugin'>
	^self primitiveFailed! !

!StrikeFont class methodsFor: 'accessing' stamp: 'MarcusDenker 7/7/2012 22:18'!
setupDefaultFallbackFont
	"
	StrikeFont setupDefaultFallbackFont
	"
	(self defaultFallbackFontKeys
		collect: [:e | TextStyle named: e])
		do: [:style | style fontArray
				do: [:e | 
					e reset.
					(e respondsTo: #fontArray)
						ifTrue: [e fontArray 
								do: [:f | f setupDefaultFallbackFont]]]].
! !

!StrikeFont class methodsFor: 'instance creation' stamp: 'ar 1/5/2002 21:41'!
fromUser
	"StrikeFont fromUser"
	^self fromUser: TextStyle defaultFont! !

!StrikeFont class methodsFor: 'font creation' stamp: 'PeterHugossonMiller 9/3/2009 11:25'!
listFontNames
	"StrikeFont listFontNames"
	"List all the OS font names"
	| font fontNames index |
	fontNames := Array new writeStream.
	index := 0.
	
	[ font := self listFont: index.
	font == nil ] whileFalse: 
		[ fontNames nextPut: font.
		index := index + 1 ].
	^ fontNames contents! !

!StrikeFont class methodsFor: 'font creation' stamp: 'ar 6/4/2000 21:13'!
primitiveDestroyFont: fontHandle
	<primitive:'primitiveDestroyFont' module:'FontPlugin'>
	^self primitiveFailed! !

!StrikeFont class methodsFor: 'examples' stamp: 'CamilloBruni 5/9/2012 11:52'!
readStrikeFont2Family: familyName fromDirectory: aDirectory 
	"StrikeFont readStrikeFont2Family: 'Lucida' fromDirectory: FileDirectory default"
	"This utility reads all available .sf2 StrikeFont files for a given family from  
	the current directory. It returns an Array, sorted by size, suitable for handing 
	to TextStyle newFontArray: ."
	"For this utility to work as is, the .sf2 files must be named 'familyNN.sf2'."
	| files strikeFonts fontArray |
	files := aDirectory filesMatching: familyName , '##.sf2'.
	strikeFonts := files collect: [ :file | StrikeFont new readFromStrike2: file basename ].
	strikeFonts do: [ :font | font reset ].
	strikeFonts := strikeFonts asSortedCollection: [ :a :b | a height < b height ].
	fontArray := strikeFonts asArray.
	^ fontArray

	"TextConstants at: #Lucida put: (TextStyle fontArray: (StrikeFont 
	readStrikeFont2Family: 'Lucida'))."! !

!StrikeFont class methodsFor: 'character shapes' stamp: 'jmv 3/26/2009 14:51'!
makeLfVisible
	"
	Make line feed characters visible
	StrikeFont makeLfVisible
	"
	self allInstances do: [ :font | font makeLfVisible ]! !

!StrikeFont class methodsFor: 'cleanup' stamp: 'AlainPlantec 9/12/2011 18:38'!
cleanUp: aggressive
	"Flush synthesized strike fonts"

	self allInstancesDo: [:sf| sf reset].! !

!StrikeFont class methodsFor: 'accessing' stamp: 'AlainPlantec 9/13/2011 21:08'!
defaultFallbackFontKeys
	^ Array with: self defaultFontKey ! !

!StrikeFont class methodsFor: 'font creation' stamp: 'ar 6/4/2000 21:14'!
primitiveFontEncoding: fontHandle
	<primitive:'primitiveFontEncoding' module:'FontPlugin'>
	^self primitiveFailed! !

!StrikeFont class methodsFor: 'character shapes' stamp: 'jmv 3/26/2009 14:53'!
makeTabInvisible
	"
	Make tab characters invisible
	StrikeFont makeTabInvisible
	"
	self allInstances do: [ :font | font makeTabInvisible ]! !

!StrikeFont class methodsFor: 'character shapes' stamp: 'jmv 3/27/2009 09:28'!
makeControlCharsVisible
	"
	Make normally not visible characters, visible
	StrikeFont makeControlCharsVisible
	"
	self allInstances do: [ :font | font makeControlCharsVisible ]! !

!StrikeFont class methodsFor: 'accessing' stamp: 'AlainPlantec 12/5/2009 08:26'!
dejaVuKey
	^ 'Bitmap DejaVu Sans'
! !

!StrikeFont class methodsFor: 'removing' stamp: 'jmv 3/31/2009 08:20'!
limitTo16Bits
	"Limit glyph depth to 16 bits (it is usually 16 or 32).
	
	StrikeFont limitTo16Bits
	"
	StrikeFont allInstances do: [ :f | f
		setGlyphsDepthAtMost: 16 ].! !

!StrikeFont class methodsFor: 'examples' stamp: 'CamilloBruni 5/7/2012 01:18'!
readStrikeFont2Family: familyName 
	"StrikeFont readStrikeFont2Family: 'Lucida'"
	^self readStrikeFont2Family: familyName fromDirectory: FileSystem workingDirectory! !

!StrikeFont class methodsFor: 'character shapes' stamp: 'jmv 8/6/2009 14:24'!
useUnderscoreIfOver1bpp
	"Sets underscore and caret glyphs for chars 95 and 94. 
	Only for enhanced StrikeFonts, i.e. those with glyphs of more than 1bpp.
	ASCII standard glyphs"
	"
	StrikeFont useUnderscoreIfOver1bpp
	"
	self allInstances do: [ :font | font useUnderscoreIfOver1bpp ]! !

!StrikeFont class methodsFor: 'font creation' stamp: 'PeterHugossonMiller 9/3/2009 11:25'!
hostFontFromUser
	"StrikeFont hostFontFromUser"
	| fontNames index labels |
	fontNames := self listFontNames asSortedCollection.
	labels := (String new: 100) writeStream.
	fontNames 
		do: [ :fn | labels nextPutAll: fn ]
		separatedBy: [ labels cr ].
	index := UIManager default 
		chooseFrom: labels contents substrings
		title: 'Choose your font'.
	index = 0 ifTrue: [ ^ nil ].
	^ fontNames at: index! !

!StrikeFont class methodsFor: 'instance creation' stamp: 'tak 12/20/2004 10:23'!
passwordFontSize: aSize 
	^ FixedFaceFont new passwordFont fontSize: aSize! !

!StrikeFont class methodsFor: 'accessing' stamp: 'ar 2/3/2002 23:04'!
familyName: aName pointSize: aSize
	"Answer a font (or the default font if the name is unknown) in the specified size."

	^ ((TextStyle named: aName asSymbol) ifNil: [TextStyle default]) fontOfPointSize: aSize! !

!StrikeFont class methodsFor: 'font creation' stamp: 'ar 6/4/2000 22:25'!
primitiveFontAscent: fontHandle
	<primitive:'primitiveFontAscent' module:'FontPlugin'>
	^self primitiveFailed! !

!StrikeFont class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
familyNames
	^ (TextSharedInformation select: [:each | each isKindOf: TextStyle]) keys asSortedCollection! !

!StrikeFont class methodsFor: 'font creation' stamp: 'ar 6/4/2000 22:25'!
primitiveFontDescent: fontHandle
	<primitive:'primitiveFontDescent' module:'FontPlugin'>
	^self primitiveFailed! !

!StrikeFont class methodsFor: 'font creation' stamp: 'lr 7/4/2009 10:42'!
fromHostFont: fontName size: fontSize flags: fontFlags weight: fontWeight 
	"
		^StrikeFont fromHostFont: (StrikeFont hostFontFromUser)
					size: 12 flags: 0 weight: 4.
	"
	| fontHandle glyphs xTable xStart maxWidth w glyphForm ascent descent fontHeight |
	fontHandle := self 
		primitiveCreateFont: fontName
		size: fontSize
		flags: fontFlags
		weight: fontWeight.
	ascent := self primitiveFontAscent: fontHandle.
	descent := self primitiveFontDescent: fontHandle.
	fontHeight := ascent + descent.
	xTable := Array new: 258.
	xStart := maxWidth := 0.
	0 
		to: 255
		do: 
			[ :i | 
			xTable 
				at: i + 1
				put: xStart.
			w := self 
				primitiveFont: fontHandle
				widthOfChar: i.
			w > maxWidth ifTrue: [ maxWidth := w ].
			xStart := xStart + w ].
	xTable 
		at: 256
		put: xStart.
	xTable 
		at: 257
		put: xStart.
	xTable 
		at: 258
		put: xStart.
	glyphs := Form 
		extent: xTable last @ fontHeight
		depth: 1.
	glyphForm := Form 
		extent: maxWidth @ fontHeight
		depth: 1.
	0 
		to: 255
		do: 
			[ :i | 
			glyphForm fillWhite.
			self 
				primitiveFont: fontHandle
				glyphOfChar: i
				into: glyphForm.
			xStart := xTable at: i + 1.
			glyphForm 
				displayOn: glyphs
				at: xStart @ 0.
			glyphForm 
				displayOn: Display
				at: xStart @ 0 ].
	self primitiveDestroyFont: fontHandle.
	^ Array 
		with: glyphs
		with: xTable! !

!StrikeFont class methodsFor: 'instance creation' stamp: 'tk 1/28/1999 11:31'!
familyName: aName size: aSize emphasized: emphasisCode
	"Create the font with this emphasis"

	^ (self familyName: aName size: aSize) emphasized: emphasisCode! !

!StrikeFont class methodsFor: 'character shapes' stamp: 'jmv 3/26/2009 14:51'!
makeLfInvisible
	"
	Make line feed characters invisible
	StrikeFont makeLfInvisible
	"
	self allInstances do: [ :font | font makeLfInvisible ]! !

!StrikeFont class methodsFor: 'font creation' stamp: 'tak 8/3/2005 21:11'!
localeChanged
	self setupDefaultFallbackFont! !

!StrikeFont class methodsFor: 'accessing' stamp: 'JuanVuletich 10/11/2010 22:12'!
default
	^TextStyle default defaultFont! !

!StrikeFont class methodsFor: 'accessing' stamp: 'ar 11/25/2004 15:19'!
familyName: aName size: aSize
	"Answer a font (or the default font if the name is unknown) in the specified size."
	| style |
	style := TextStyle named: aName asSymbol.
	style ifNil: [^(FontSubstitutionDuringLoading forFamilyName: aName pixelSize: aSize)
			signal: 'missing font' ].
	^style fontOfSize: aSize! !

!StrikeFont class methodsFor: 'font creation' stamp: 'ar 6/4/2000 21:12'!
listFont: index
	<primitive:'primitiveListFont' module:'FontPlugin'>
	^nil! !

!StrikeFont class methodsFor: 'character shapes' stamp: 'jmv 3/26/2009 14:53'!
makeTabVisible
	"
	Make tab characters visible
	StrikeFont makeTabVisible
	"
	self allInstances do: [ :font | font makeTabVisible ]! !

!StrikeFont class methodsFor: 'accessing' stamp: 'AlainPlantec 9/13/2011 21:08'!
defaultFontKey
	^ self dejaVuKey 
! !

!StrikeFont class methodsFor: 'examples' stamp: 'CamilloBruni 5/9/2012 11:53'!
convertFontsNamed: familyName 
	" StrikeFont convertFontsNamed: 'NewYork' "
	"This utility is for use after you have used BitFont to produce data files 
	for the fonts you wish to use.  It will read the BitFont files and then 
	write them out in strike2 (*.sf2) format which is much more compact,
	and which can be read in again very quickly."
	"For this utility to work as is, the BitFont data files must be named
	'familyNN.BF', and must reside in the same directory as the image."
	
	(FileSystem workingDirectory filesMatching: familyName , '*.BF') do: 
		[ :file | | f | 
		self crTrace: file basename.
		f := StrikeFont new readFromBitFont: file basename.
		f writeAsStrike2named: f name , '.sf2' ]! !

!StrikeFont class methodsFor: 'font creation' stamp: 'ar 6/4/2000 21:13'!
primitiveCreateFont: fontName size: fontSize flags: fontFlags weight: fontWeight
	<primitive:'primitiveCreateFont' module:'FontPlugin'>
	^self primitiveFailed! !

!StrikeFont class methodsFor: 'instance creation' stamp: 'ar 2/3/2002 23:06'!
familyName: aName pointSize: aSize emphasized: emphasisCode
	"Create the font with this emphasis"

	^ (self familyName: aName pointSize: aSize) emphasized: emphasisCode! !

!StrikeFontSet commentStamp: 'LaurentLaffont 3/31/2011 21:07'!
I am something acts like a font out of collection of fonts. First font in me is used as representative font to answer many messages.

Examples:
- display a font: StrikeFontSet allInstances first fontDisplay 
- calculate pixels width of a string for a font: StrikeFontSet allInstances first widthOfString: 'Pharo'!
!StrikeFontSet methodsFor: 'as yet unclassified' stamp: 'JMM 11/4/2008 23:12'!
fontNameWithPointSize

	^ (fontArray at: 1) fontNameWithPointSize.
! !

!StrikeFontSet methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 10/25/2013 16:19'!
displayLine: aString at: aPoint 
	"Display the characters in aString, starting at position aPoint."

	self characters: (1 to: aString size)
		in: aString
		displayAt: aPoint
		clippedBy: Display boundingBox
		rule: Form over
		fillColor: nil
		kernDelta: 0
		on: (BitBlt toForm: Display).
! !

!StrikeFontSet methodsFor: 'accessing' stamp: 'JMM 11/4/2008 23:14'!
ascent

	^ (fontArray  at: 1) ascent.
! !

!StrikeFontSet methodsFor: 'as yet unclassified' stamp: 'JMM 11/4/2008 23:14'!
ascentKern

	^ (fontArray  at: 1) ascentKern.
! !

!StrikeFontSet methodsFor: 'emphasis' stamp: 'sd 2/4/2008 21:18'!
makeStruckOutGlyphs
	"Make a struck-out set of glyphs with same widths"

	| g font |
	1 to: fontArray size do: [:i |
		font := (fontArray at: i).
		font ifNotNil: [
			g := font glyphs deepCopy.
			g fillBlack: (0 @ (font ascent - (font ascent//3)) extent: g width @ 1).
			font setGlyphs: g
		].
	].
! !

!StrikeFontSet methodsFor: 'accessing' stamp: 'ar 4/12/2005 17:15'!
heightOf: aCharacter
	^(self fontOf: aCharacter) height! !

!StrikeFontSet methodsFor: 'as yet unclassified' stamp: 'JMM 11/4/2008 23:12'!
glyphs

	^ (fontArray  at: 1) glyphs
! !

!StrikeFontSet methodsFor: 'as yet unclassified' stamp: 'yo 9/17/2002 17:50'!
glyphsEncoding: anInteger

	^ (fontArray at: (anInteger+1)) glyphs.
! !

!StrikeFontSet methodsFor: 'measuring' stamp: 'JMM 11/4/2008 23:13'!
widthOfString: aString

	aString ifNil:[^0].
	"Optimizing"
	(aString isByteString) ifTrue: [
		^ (self fontArray  at: 1) widthOfString: aString from: 1 to: aString size].
	^ self widthOfString: aString from: 1 to: aString size.
"
	TextStyle default defaultFont widthOfString: 'zort' 21
"
! !

!StrikeFontSet methodsFor: 'character shapes' stamp: 'sd 2/4/2008 21:20'!
characterFormAt: character put: characterForm 

	| ascii leftX rightX widthDif newGlyphs encoding xTable glyphs |
	encoding := character leadingChar + 1.
	ascii := character charCode.
	ascii < (fontArray at: encoding) minAscii ifTrue: [
		^ self error: 'Cant store characters below min ascii'
	].
	ascii > (fontArray at: encoding) maxAscii ifTrue: [
		^ self error: 'No change made'
	].
	xTable := (fontArray at: encoding) xTable.
	leftX := xTable at: ascii + 1.
	rightX := xTable at: ascii + 2.
	glyphs := (fontArray at: encoding) glyphs.
	widthDif := characterForm width - (rightX - leftX).
	widthDif ~= 0 ifTrue: [
		newGlyphs := Form extent: glyphs width + widthDif @ glyphs height.
		newGlyphs copy: (0 @ 0 corner: leftX @ glyphs height) from: 0 @ 0
			in: glyphs rule: Form over.
		newGlyphs
				copy: (rightX + widthDif @ 0 corner: newGlyphs width @ glyphs height)
				from: rightX @ 0 in: glyphs rule: Form over.
		glyphs := newGlyphs.
		"adjust further entries on xTable"
		xTable := xTable copy.
		ascii + 2 to: xTable size do: [:i |
			xTable at: i put: (xTable at: i) + widthDif]].
	glyphs copy: (leftX @ 0 extent: characterForm extent) from: 0 @ 0 in: characterForm rule: Form over.
! !

!StrikeFontSet methodsFor: 'private' stamp: 'sd 2/4/2008 21:14'!
questionGlyphInfoInto: glyphInfoArray

	| f ascii |
	f := fontArray at: 1.
	ascii := $? asciiValue.
	glyphInfoArray at: 1 put: f glyphs;
		at: 2 put: (f xTable at: ascii + 1);
		at: 3 put: (f xTable at: ascii + 2);
		at: 4 put: (self ascentOf: $?);
		at: 5 put: self.
	^ glyphInfoArray.
! !

!StrikeFontSet methodsFor: 'accessing' stamp: 'ar 4/12/2005 17:14'!
fontOf: aCharacter
	"Answer the actual font to use for aCharacter"
	^self fontOf: aCharacter ifAbsent:[fontArray at: 1]! !

!StrikeFontSet methodsFor: 'accessing' stamp: 'JMM 11/4/2008 23:12'!
height

	^ (fontArray  at: 1) height.
! !

!StrikeFontSet methodsFor: 'emphasis' stamp: 'sd 2/4/2008 21:18'!
makeItalicGlyphs
	"Make an italic set of glyphs with same widths by skewing left and right
		(may require more intercharacter space)"

	| g bonkForm bc font |
	1 to: fontArray size do: [:j |
		font := (fontArray at: j).
		font ifNotNil: [
			g := font glyphs deepCopy.
			"BonkForm will have bits where slanted characters overlap their neighbors."
			bonkForm := Form extent: (self height//4+2) @ self height.
			bc := font descent//4 + 1.  "Bonker x-coord corresponding to char boundary."
			bonkForm fill: (0 @ 0 corner: (bc+1) @ font ascent) fillColor: Color black.
			4 to: font ascent-1 by: 4 do:
				[:y | 		"Slide ascenders right..."
				g copy: (1@0 extent: g width @ (font ascent - y))
					from: 0@0 in: g rule: Form over.
				bonkForm copy: (1@0 extent: bonkForm width @ (font ascent - y))
					from: 0@0 in: bonkForm rule: Form over].
			bonkForm fill: (0 @ 0 corner: (bc+1) @ font ascent) fillColor: Color white.
			bonkForm fill: (bc @ font ascent corner: bonkForm extent) fillColor: Color black.
			font ascent to: font height-1 by: 4 do:
				[:y | 		"Slide descenders left..."
				g copy: (0@y extent: g width @ g height)
					from: 1@y in: g rule: Form over.
				bonkForm copy: (0@0 extent: bonkForm width @ bonkForm height)
					from: 1@0 in: bonkForm rule: Form over].
			bonkForm fill: (bc @ font ascent corner: bonkForm extent) fillColor: Color white.
			"Now use bonkForm to erase at every character boundary in glyphs."
			bonkForm offset: (0-bc) @ 0.
			font bonk: g with: bonkForm.
			font setGlyphs: g
		].
	].
! !

!StrikeFontSet methodsFor: 'accessing' stamp: 'ar 4/12/2005 17:15'!
descentOf: aCharacter
	^(self fontOf: aCharacter) descent! !

!StrikeFontSet methodsFor: 'accessing' stamp: 'JMM 11/4/2008 23:14'!
xTable
	"Answer an Array of the left x-coordinate of characters in glyphs."

	^ (fontArray  at: 1) xTable.
! !

!StrikeFontSet methodsFor: 'accessing' stamp: 'ar 4/12/2005 17:14'!
ascentOf: aCharacter
	^(self fontOf: aCharacter) ascent! !

!StrikeFontSet methodsFor: '*system-settings-browser' stamp: 'AlainPlantec 1/31/2010 10:45'!
settingStoreOn: aStream 
	aStream nextPut: $(.
	aStream nextPutAll: self class name.
	aStream nextPut: Character space.
	aStream nextPutAll: 'familyName: ''', self familyName, ''' size: ', self pointSize asString, ' emphasized: ', self emphasis asString.
	aStream nextPut: $)
! !

!StrikeFontSet methodsFor: 'as yet unclassified' stamp: 'marcus.denker 9/14/2008 19:09'!
emphasized: code 

	"Answer a copy of the receiver with emphasis set to include code."
	| derivative addedEmphasis base safeCode |
	code = 0 ifTrue: [^ self].
	derivativeFonts isEmptyOrNil ifTrue: [^ self].
	derivative := derivativeFonts at: (safeCode := code min: derivativeFonts size).
	derivative ifNotNil: [^ derivative].  "Already have this style"

	"Dont have it -- derive from another with one with less emphasis"
	addedEmphasis := 1 bitShift: safeCode highBit - 1.
	base := self emphasized: safeCode - addedEmphasis.  "Order is Bold, Ital, Under, Narrow"
	addedEmphasis = 1 ifTrue:   "Compute synthetic bold version of the font"
		[derivative := (base copy name: base name , 'B') makeBoldGlyphs].
	addedEmphasis = 2 ifTrue:   "Compute synthetic italic version of the font"
		[ derivative := (base copy name: base name , 'I') makeItalicGlyphs].
	addedEmphasis = 4 ifTrue:   "Compute underlined version of the font"
		[derivative := (base copy name: base name , 'U') makeUnderlinedGlyphs].
	addedEmphasis = 8 ifTrue:   "Compute narrow version of the font"
		[derivative := (base copy name: base name , 'N') makeCondensedGlyphs].
	addedEmphasis = 16 ifTrue:   "Compute struck-out version of the font"
		[derivative := (base copy name: base name , 'X') makeStruckOutGlyphs].
	derivative emphasis: safeCode.
	derivativeFonts at: safeCode put: derivative.
	^ derivative
! !

!StrikeFontSet methodsFor: 'displaying' stamp: 'nice 1/10/2010 15:07'!
displayMultiString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta baselineY: baselineY

	| destPoint leftX rightX glyphInfo g destY |
	destPoint := aPoint.
	glyphInfo := Array new: 5.
	startIndex to: stopIndex do: [:charIndex |
		self glyphInfoOf: (aString at: charIndex) into: glyphInfo.
		g := glyphInfo at:1.
		leftX := glyphInfo at:2.
		rightX := glyphInfo at:3.
		((glyphInfo at:5) ~= aBitBlt lastFont) ifTrue: [
			(glyphInfo at:5) installOn: aBitBlt.
		].
		aBitBlt sourceForm: g.
		destY := baselineY - (glyphInfo at:4).
		aBitBlt destX: (destPoint x) destY: destY width: (rightX - leftX) height: (self height).
		aBitBlt sourceOrigin: leftX @ 0.
		aBitBlt copyBits.
		destPoint := destPoint x + (rightX - leftX + kernDelta) @ destPoint y.
	].
	^ destPoint.! !

!StrikeFontSet methodsFor: 'accessing' stamp: 'JMM 11/4/2008 23:11'!
familyName

	^ (fontArray at: 1) familyName.
! !

!StrikeFontSet methodsFor: 'as yet unclassified' stamp: 'sd 2/4/2008 21:20'!
emphasis: code 
	"Set the integer code for synthetic bold, itallic, underline, and strike-out, 
	where bold=1, italic=2, underlined=4, and struck out=8."

	emphasis := code.
! !

!StrikeFontSet methodsFor: 'as yet unclassified' stamp: 'sd 2/4/2008 21:20'!
reset
	"Reset the cache of derivative emphasized fonts"

	derivativeFonts := Array new: 32.
! !

!StrikeFontSet methodsFor: 'accessing' stamp: 'JMM 11/4/2008 23:14'!
baseKern

	^ (fontArray  at: 1) baseKern.
! !

!StrikeFontSet methodsFor: 'as yet unclassified' stamp: 'sd 2/4/2008 21:20'!
bonk: glyphForm with: bonkForm at: j
	"Bonking means to run through the glyphs clearing out black pixels
	between characters to prevent them from straying into an adjacent
	character as a result of, eg, bolding or italicizing"
	"Uses the bonkForm to erase at every character boundary in glyphs."

	| bb offset font x |
	font := (fontArray at: j).
	offset := bonkForm offset x.
	bb := BitBlt toForm: glyphForm.
	bb sourceForm: bonkForm; sourceRect: bonkForm boundingBox;
		combinationRule: Form erase; destY: 0.
	x := font xTable.
	(x isMemberOf: SparseLargeTable) ifTrue: [
		x base to: x size-1 do: [:i | bb destX: (x at: i) + offset; copyBits].
	] ifFalse: [
		1 to: x size-1 do: [:i | bb destX: (x at: i) + offset; copyBits].
	].
! !

!StrikeFontSet methodsFor: 'as yet unclassified' stamp: 'sd 2/4/2008 21:20'!
name: aString

	name := aString
! !

!StrikeFontSet methodsFor: 'as yet unclassified' stamp: 'JMM 11/4/2008 23:11'!
familySizeFace

	^ Array
		with: (fontArray  at: 1) name
		with: self height
		with: (fontArray  at: 1) emphasis
! !

!StrikeFontSet methodsFor: 'accessing' stamp: 'ar 4/12/2005 17:15'!
widthOf: aCharacter 
	"Answer the width of the argument as a character in the receiver."
	^(self fontOf: aCharacter) widthOf: aCharacter! !

!StrikeFontSet methodsFor: 'displaying' stamp: 'nice 1/10/2010 15:06'!
characters: anInterval in: sourceString displayAt: aPoint clippedBy: clippingRectangle rule: ruleInteger fillColor: aForm kernDelta: kernDelta on: aBitBlt
	"Simple, slow, primitive method for displaying a line of characters.
	No wrap-around is provided."

	^anInterval inject: aPoint into: 
		[:destPoint :i |
		| f xTable leftX noFont sourceRect encoding ascii rightX |
		encoding := (sourceString at: i) leadingChar + 1.
		noFont := false.
		f := [fontArray at: encoding]
			on: Exception do: [:ex | nil].
		f ifNil: [noFont := true. f := fontArray at: 1].
		ascii := (noFont ifTrue: [$?] ifFalse: [sourceString at: i]) charCode.
		(ascii < f minAscii
			or: [ascii > f maxAscii])
			ifTrue: [ascii := f maxAscii].
		xTable := f xTable.
		leftX := xTable at: ascii + 1.
		rightX := xTable at: ascii + 2.
		sourceRect := leftX @ 0 extent: (rightX - leftX) @ self height.
		aBitBlt copyFrom: sourceRect in: f glyphs to: destPoint.
		destPoint x + (rightX - leftX + kernDelta) @ destPoint y.
	].
! !

!StrikeFontSet methodsFor: 'accessing' stamp: 'JMM 11/4/2008 23:14'!
descent

	^ (fontArray  at: 1) descent.
! !

!StrikeFontSet methodsFor: 'accessing' stamp: 'ar 4/12/2005 17:14'!
fontOf: aCharacter ifAbsent: aBlock
	"Answer the actual font to use for aCharacter"
	| encoding font |
	encoding := aCharacter leadingChar + 1.
	encoding <= fontArray size 
		ifTrue:[font := fontArray at: encoding].
	font ifNil:[^aBlock value].
	^font
! !

!StrikeFontSet methodsFor: 'copying' stamp: 'StephaneDucasse 10/2/2010 16:57'!
postCopy
	super postCopy.
	self reset.
	fontArray := fontArray copy! !

!StrikeFontSet methodsFor: 'testing' stamp: 'PavelKrivanek 6/23/2011 21:55'!
isSynthetic

	^ fontArray first isSynthetic! !

!StrikeFontSet methodsFor: 'testing' stamp: 'yo 9/17/2002 17:52'!
name

	^ name
! !

!StrikeFontSet methodsFor: 'as yet unclassified' stamp: 'yo 9/17/2002 17:52'!
maxEncoding

	^ fontArray size.
! !

!StrikeFontSet methodsFor: 'as yet unclassified' stamp: 'yo 9/17/2002 17:06'!
emphasis
	"Answer the integer code for synthetic bold, italic, underline, and 
	strike-out."

	^ emphasis.
! !

!StrikeFontSet methodsFor: 'as yet unclassified' stamp: 'yo 9/17/2002 17:56'!
xTableEncoding: anInteger
	"Answer an Array of the left x-coordinate of characters in glyphs."

	^(fontArray at: anInteger + 1) xTable.
! !

!StrikeFontSet methodsFor: 'as yet unclassified' stamp: 'JMM 11/4/2008 23:13'!
subscript

	^ (fontArray  at: 1) subscript
! !

!StrikeFontSet methodsFor: 'displaying' stamp: 'yo 1/7/2005 12:04'!
displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta 

	^ self displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta baselineY: aPoint y + self ascent.
! !

!StrikeFontSet methodsFor: 'displaying' stamp: 'StephaneDucasse 10/2/2010 16:56'!
displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta from: fromFont baselineY: baselineY

	| destPoint leftX rightX glyphInfo g tag char destY rIndex| 
	destPoint := aPoint.
	rIndex := startIndex.
	tag := (aString at: rIndex) leadingChar.
	glyphInfo := Array new: 5.
	[rIndex <= stopIndex] whileTrue: [
		char := aString at: rIndex.
		((fromFont hasGlyphOf: char) or: [char leadingChar ~= tag]) ifTrue: [^ Array with: rIndex with: destPoint].
		self glyphInfoOf: char into: glyphInfo.
		g := glyphInfo at: 1.
		leftX := glyphInfo at: 2.
		rightX := glyphInfo at: 3.
		(glyphInfo fifth ~= aBitBlt lastFont) ifTrue: [
			glyphInfo fifth installOn: aBitBlt.
		].
		aBitBlt sourceForm: g.
		destY := baselineY - (glyphInfo at: 4). 
		aBitBlt destX: destPoint x.
		aBitBlt destY: destY.
		aBitBlt sourceOrigin: leftX @ 0.
		aBitBlt width: rightX - leftX.
		aBitBlt height: self height.
		aBitBlt copyBits.
		destPoint := destPoint + (rightX - leftX + kernDelta @ 0).
		rIndex := rIndex + 1.
	].
	^ Array with: rIndex with: destPoint.
! !

!StrikeFontSet methodsFor: 'emphasis' stamp: 'sd 2/4/2008 21:18'!
makeUnderlinedGlyphs
	"Make an underlined set of glyphs with same widths"

	| g font |
	1 to: fontArray size do: [:i |
		font := (fontArray at: i).
		font ifNotNil: [
			g := font glyphs deepCopy.
			g fillBlack: (0 @ (font ascent+1) extent: g width @ 1).
			font setGlyphs: g
		].
	].
! !

!StrikeFontSet methodsFor: 'accessing' stamp: 'yo 9/23/2002 20:08'!
fontArray

	^ fontArray
! !

!StrikeFontSet methodsFor: 'displaying' stamp: 'yo 9/17/2002 17:50'!
installOn: aDisplayContext foregroundColor: foregroundColor backgroundColor: backgroundColor 

	^ aDisplayContext
		installStrikeFont: self
		foregroundColor: foregroundColor
		backgroundColor: backgroundColor.
! !

!StrikeFontSet methodsFor: 'private' stamp: 'MarcusDenker 10/2/2013 20:19'!
glyphInfoOf: aCharacter into: glyphInfoArray
	| index f code leftX |
	index := aCharacter leadingChar + 1.
	fontArray size < index
		ifTrue: [ ^ self questionGlyphInfoInto: glyphInfoArray ].
	(f := fontArray at: index) ifNil: [ ^ self questionGlyphInfoInto: glyphInfoArray ].
	code := aCharacter charCode.
	(code between: f minAscii and: f maxAscii)
		ifFalse: [ ^ self questionGlyphInfoInto: glyphInfoArray ].
	leftX := f xTable at: code + 1.
	leftX < 0
		ifTrue: [ ^ self questionGlyphInfoInto: glyphInfoArray ].
	glyphInfoArray
		at: 1 put: f glyphs;
		at: 2 put: leftX;
		at: 3 put: (f xTable at: code + 2);
		at: 4 put: (f ascentOf: aCharacter);
		at: 5 put: self.
	^ glyphInfoArray! !

!StrikeFontSet methodsFor: 'printing' stamp: 'yo 9/17/2002 17:53'!
printOn: aStream

	super printOn: aStream.
	aStream nextPutAll: '(' , self name.
	aStream space.
	self height printOn: aStream.
	aStream nextPut: $).
! !

!StrikeFontSet methodsFor: 'accessing' stamp: 'JMM 11/4/2008 23:13'!
lineGrid

	| f |
	f := fontArray at: 1.
	^ f ascent + f descent.
! !

!StrikeFontSet methodsFor: 'accessing' stamp: 'nk 9/1/2004 12:06'!
derivativeFonts
	^derivativeFonts copyWithout: nil! !

!StrikeFontSet methodsFor: 'private' stamp: 'sd 2/4/2008 21:13'!
addNewFont: aFont at: encodingIndex

	| newArray |
	encodingIndex > fontArray size ifTrue: [
		newArray := Array new: encodingIndex.
		newArray replaceFrom: 1 to: fontArray size with: fontArray startingAt: 1.
	] ifFalse: [
		newArray := fontArray.
	].

	newArray at: encodingIndex put: aFont.

	self initializeWithFontArray: newArray.
! !

!StrikeFontSet methodsFor: 'displaying' stamp: 'HenrikSperreJohansen 9/1/2009 00:40'!
displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta baselineY: baselineY
	"Draw the given string from startIndex to stopIndex 
	at aPoint on the (already prepared) BitBlt."
	
	"Look for an excuse to use the fast primitive"
 	(aString hasWideCharacterFrom: startIndex to: stopIndex) ifTrue:[
		^ self displayMultiString: aString 
				on: aBitBlt 
				from: startIndex 
				to: stopIndex 
				at: aPoint 
				kern: kernDelta 
				baselineY: baselineY].

	^ aBitBlt displayString: aString 
			from: startIndex 
			to: stopIndex 
			at: aPoint 
			strikeFont: self
			kern: kernDelta! !

!StrikeFontSet methodsFor: 'accessing' stamp: 'yo 8/5/2003 15:31'!
textStyle

	^ TextStyle actualTextStyles detect: [:aStyle | (aStyle fontArray collect: [:s | s name]) includes: self name]
		ifNone: [].
! !

!StrikeFontSet methodsFor: 'as yet unclassified' stamp: 'JMM 11/4/2008 23:10'!
descentKern

	^ (fontArray at: 1) descentKern.
! !

!StrikeFontSet methodsFor: 'as yet unclassified' stamp: 'JMM 11/4/2008 23:12'!
initializeWithFontArray: anArray 
	"Initialize with given font array, the ascent of primary font is modified 
	if another font has higher size"
	| primaryFont maxHeight newFont |
	fontArray := anArray.
	primaryFont := anArray at: 1.
	emphasis := 0.
	name := primaryFont name.
	maxHeight := anArray
				inject: 0
				into: [:theHeight :font | (font notNil
							and: [theHeight < font height])
						ifTrue: [font height]
						ifFalse: [theHeight]].
	primaryFont height < maxHeight
		ifTrue: [newFont := primaryFont copy
						fixAscent: primaryFont ascent + (maxHeight - primaryFont height)
						andDescent: primaryFont descent
						head: 0.
			fontArray at: 1 put: newFont].
	self reset! !

!StrikeFontSet methodsFor: 'as yet unclassified' stamp: 'JMM 11/4/2008 23:13'!
superscript

	^ (fontArray  at: 1) superscript
! !

!StrikeFontSet methodsFor: 'emphasis' stamp: 'sd 2/4/2008 21:14'!
makeBoldGlyphs
	"Make a bold set of glyphs with same widths by ORing 1 bit to the right
		(requires at least 1 pixel of intercharacter space)"

	| g bonkForm font |
	1 to: fontArray size do: [:i |
		font := fontArray at: i.
		font ifNotNil: [
			g := font glyphs deepCopy.
			bonkForm := (Form extent: 1@16) fillBlack offset: -1@0.
			self bonk: g with: bonkForm at: i.
			g copyBits: g boundingBox from: g at: (1@0)
				clippingBox: g boundingBox rule: Form under fillColor: nil.
			(fontArray at: i) setGlyphs: g.
		].
	].
! !

!StrikeFontSet methodsFor: 'testing' stamp: 'yo 2/12/2007 19:34'!
isFontSet

	^ true.
! !

!StrikeFontSet methodsFor: 'as yet unclassified' stamp: 'yo 1/5/2005 13:59'!
installOn: aDisplayContext

	^ aDisplayContext installStrikeFont: self.
! !

!StrikeFontSet methodsFor: 'copying' stamp: 'sd 2/4/2008 21:20'!
copy

	| s a |
	s := self class new.
	s name: self name.
	s emphasis: self emphasis.
	s reset.
	a := Array new: fontArray size.
	1 to: a size do: [:i |
		a at: i put: (fontArray at: i) copy.
	].
	s fontArray: a.
	^ s.
! !

!StrikeFontSet methodsFor: 'as yet unclassified' stamp: 'sd 2/4/2008 21:20'!
fontArray: anArray

	fontArray := anArray.
! !

!StrikeFontSet methodsFor: 'accessing' stamp: 'IgorStasenko 4/19/2009 14:51'!
characterToGlyphMap
	"used in 
	primDisplayString: aString from: startIndex to: stopIndex
			map: font characterToGlyphMap xTable: font xTable
			kern: kernDelta.
	
	Since 'font xTable' using a first font xtable, we could use the same glyph mapping for it'
	
	This should allow a primitive to not fail, because of characterToGlyphMap == nil
	"
	^ (fontArray at: 1) characterToGlyphMap! !

!StrikeFontSet methodsFor: 'accessing' stamp: 'sd 2/4/2008 21:20'!
maxAsciiFor: encoding

	| f |
	f := (fontArray at: encoding+1).
	f ifNotNil: [^ f maxAscii].
	^ 0.
! !

!StrikeFontSet methodsFor: 'character shapes' stamp: 'sd 2/4/2008 21:20'!
characterFormAt: character 

	| encoding ascii xTable leftX rightX |
	encoding := character leadingChar + 1.
	ascii := character charCode.
	(ascii < (fontArray at: encoding) minAscii or: [ascii > (fontArray at: encoding) maxAscii])
		ifTrue: [ascii := (fontArray at: encoding) maxAscii].
	xTable := (fontArray at: encoding) xTable.
	leftX := xTable at: ascii + 1.
	rightX := xTable at: ascii + 2.
	^ (fontArray at: encoding) glyphs copy: (leftX @ 0 corner: rightX @ self height).
! !

!StrikeFontSet methodsFor: 'accessing' stamp: 'JMM 11/4/2008 23:13'!
pointSize

	^ (fontArray  at: 1) pointSize.
! !

!StrikeFontSet methodsFor: 'accessing' stamp: 'tak 12/21/2004 16:43'!
latin1
	"Answer primary font"
	^ fontArray at: 1! !

!StrikeFontSet methodsFor: 'as yet unclassified' stamp: 'yo 2/24/2005 15:45'!
maxWidth

	^ (fontArray at: 1) maxWidth.
! !

!StrikeFontSet class methodsFor: 'filein/out' stamp: 'nice 1/5/2010 15:59'!
installNewFontAtIndex: newIndex fromOld: oldIndex

	
	self allInstances do: [:set | | newArray fontArray |
		fontArray := set fontArray.
		newIndex + 1 > fontArray size ifTrue: [
			newArray := Array new: newIndex + 1.
			newArray replaceFrom: 1 to: fontArray size with: fontArray startingAt: 1.
			newArray at: newIndex + 1 put: (fontArray at: oldIndex + 1).
			set initializeWithFontArray: newArray.
		] ifFalse: [
			fontArray at: newIndex + 1 put: (fontArray at: oldIndex + 1).
		].
	].

"
StrikeFontSet installNewFontAtIndex: UnicodeSimplifiedChinese leadingChar fromOld: UnicodeJapanese leadingChar
StrikeFontSet installNewFontAtIndex: UnicodeKorean leadingChar fromOld: UnicodeJapanese leadingChar
"
! !

!StrikeFontSet class methodsFor: 'filein/out' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
removeFontsForEncoding: leadingChar encodingName: encodingSymbol

	| insts |
	leadingChar = 0 ifTrue: [^ self error: 'you cannot delete the intrinsic fonts'].
	insts := self allInstances.
	insts do: [:inst | | index fonts newFonts |
		fonts := inst fontArray.
		fonts size >= (leadingChar + 1) ifTrue: [
			leadingChar + 1 = fonts size ifTrue: [
				newFonts := fonts copyFrom: 1 to: fonts size - 1.
				index := newFonts indexOf: nil.
				index > 0 ifTrue: [newFonts := newFonts copyFrom: 1 to: index - 1].
				inst initializeWithFontArray: newFonts.
			] ifFalse: [
				fonts at: leadingChar + 1 put: nil.
			].
		].
	].

	TextSharedInformation removeKey: encodingSymbol asSymbol ifAbsent: [].
! !

!StrikeFontSet class methodsFor: 'as yet unclassified' stamp: 'yo 5/25/2004 14:32'!
findMaximumLessThan: f in: array

	array size to: 1 by: -1 do: [:i |
		f height >= (array at: i) height ifTrue: [^ array at: i].
	].
	^ array first.
! !

!StrikeFontSet class methodsFor: 'as yet unclassified' stamp: 'yo 9/23/2002 16:32'!
newFontArray: anArray
 
	^super new initializeWithFontArray: anArray
! !

!StrikeFontSet class methodsFor: 'as yet unclassified' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
familyName: aName size: aSize
	"Answer a font (or the default font if the name is unknown) in the specified size."

	| collection |
	collection :=  self allInstances select: [:inst | (inst name beginsWith: aName) and: [inst emphasis = 0]].
	collection isEmpty ifTrue: [
		(aName = 'DefaultMultiStyle') ifTrue: [
			collection := (TextSharedInformation at: #DefaultMultiStyle) fontArray.
		] ifFalse: [
			^ TextStyle defaultFont
		]
	].
	collection := collection asSortedCollection: [:a :b | a pointSize <= b pointSize].
	collection do: [:s | (s pointSize >= aSize) ifTrue: [^ s]].
	^ TextStyle defaultFont.
! !

!StrikeFontSet class methodsFor: 'as yet unclassified' stamp: 'yo 8/18/2003 21:03'!
familyName: aName size: aSize emphasized: emphasisCode
	"Create the font with this emphasis"

	^ (self familyName: aName size: aSize) emphasized: emphasisCode
! !

!String commentStamp: '<historical>'!
A String is an indexed collection of Characters. Class String provides the abstract super class for ByteString (that represents an array of 8-bit Characters) and WideString (that represents an array of  32-bit characters).  In the similar manner of LargeInteger and SmallInteger, those subclasses are chosen accordingly for a string; namely as long as the system can figure out so, the String is used to represent the given string.

Strings support a vast array of useful methods, which can best be learned by browsing and trying out examples as you find them in the code.

Here are a few useful methods to look at...
	String match:
	String contractTo:

String also inherits many useful methods from its hierarchy, such as
	SequenceableCollection ,
	SequenceableCollection copyReplaceAll:with:
!
!String methodsFor: '*metacello-core-scripting' stamp: 'dkh 7/16/2012 10:51'!
execute: projectSpecBlock against: aScriptExecutor
    aScriptExecutor executeString: self do: projectSpecBlock! !

!String methodsFor: '*System-Support' stamp: 'CamilloBruni 5/8/2013 11:23'!
asClassInEnvironment: anEnvironment ifAbsent: absentBlock
	^  anEnvironment 
			at: self asSymbol 
			ifPresent: [ :aClass| 
				self 
					assert: aClass isBehavior 
					description: [ self printString, ' is not a Class but an instance of a ', aClass class name ].
				aClass ]
			ifAbsent: absentBlock
	! !

!String methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setBlessingInMetacelloConfig: aMetacelloConfig

	aMetacelloConfig setBlessingWithString: self! !

!String methodsFor: 'converting' stamp: 'yo 8/28/2002 15:14'!
translateFrom: start  to: stop  table: table
	"translate the characters in the string by the given table, in place"
	self class translate: self from: start to: stop table: table! !

!String methodsFor: '*monticello' stamp: 'avi 2/4/2004 14:14'!
extractNumber
	^ ('0', self select: [:ea | ea isDigit]) asNumber! !

!String methodsFor: '*Zinc-Character-Encoding-Core' stamp: 'SvenVanCaekenberghe 9/15/2014 11:48'!
urlDecoded
	"URL Decode the receiver and return the resulting String.
	This is an encoding where characters that are illegal in a URL are escaped."

    ^ ZnPercentEncoder new decode: self! !

!String methodsFor: 'system primitives' stamp: 'CamilloBruni 9/5/2011 17:19'!
endsWithAColon 
	"Answer whether the final character of the receiver is a colon
	
	#fred: endsWithAColon
	'fred' endsWithAColon
	"

	^ self size > 0 and: [self last == $:]
! !

!String methodsFor: 'accessing' stamp: 'nice 10/5/2009 03:15'!
findLastOccurrenceOfString: subString startingAt: start 
	"Answer the index of the last occurrence of subString within the receiver, starting at start. If 
	the receiver does not contain subString, answer 0.  Case-sensitive match used."

	| last now |
	last := self findString: subString startingAt: start.
	last = 0 ifTrue: [^ 0].
	[last > 0] whileTrue:
		[now := last.
		last := self findString: subString startingAt: last + 1].

	^ now
! !

!String methodsFor: 'accessing' stamp: 'nice 11/16/2009 12:32'!
lineCorrespondingToIndex: anIndex
	"Answer a string containing the line at the given character position."

	self lineIndicesDo: [:start :endWithoutDelimiters :end |
		anIndex <= end ifTrue: [^self copyFrom: start to: endWithoutDelimiters]].
	^''! !

!String methodsFor: 'comparing' stamp: 'CamilloBruni 9/5/2011 17:52'!
match: text
	"Answer whether text matches the pattern in this string.
	Matching ignores upper/lower case differences.
	Where this string contains #, text may contain any character.
	Where this string contains *, text may contain any sequence of characters.
	'*'			match: 'zort' true
	'*baz'		match: 'mobaz' true
	'*baz'		match: 'mobazo' false
	'*baz*'		match: 'mobazo' true
	'*baz*'		match: 'mozo' false
	'foo*'		match: 'foozo' true
	'foo*'		match: 'bozo' false
	'foo*baz'	match: 'foo23baz' true
	'foo*baz'	match: 'foobaz' true
	'foo*baz'	match: 'foo23bazo' false
	'foo'		match: 'Foo' true
	'foo*baz*zort' match: 'foobazort' false
	'foo*baz*zort' match: 'foobazzort' false
	'*foo#zort'	match: 'afoo3zortthenfoo3zort' true
	'*foo*zort'	match: 'afoodezortorfoo3zort' true
"

	^ self startingAt: 1 match: text startingAt: 1! !

!String methodsFor: '*Collections-arithmetic' stamp: 'yo 11/3/2004 19:24'!
\\ arg

	^ arg adaptToString: self andSend: #\\! !

!String methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
asMetacelloVersionNumber

	^MetacelloVersionNumber fromString: self! !

!String methodsFor: 'accessing' stamp: 'CamilloBruni 9/5/2011 17:33'!
findDelimiters: delimiters startingAt: start 
	"Answer the index of the character within the receiver, starting at start, that matches one of the delimiters. If the receiver does not contain any of the delimiters, answer size + 1."

	start to: self size do: [:i |
		delimiters do: [:delim | 
			delim = (self at: i) 
				ifTrue: [^ i]]].
	^ self size + 1! !

!String methodsFor: '*Collections-arithmetic' stamp: 'yo 11/3/2004 19:24'!
// arg

	^ arg adaptToString: self andSend: #//! !

!String methodsFor: '*Deprecated40' stamp: 'DamienPollet 9/26/2014 16:38'!
do: aBlock toFieldNumber: aNumber
	"Considering the receiver as a holder of tab-delimited fields, evaluate aBlock on behalf of a field in this string"

	"
	1 to: 6 do:
		[:aNumber |
			'fred	charlie	elmo		wimpy	friml' do:
				[:aField | Transcript cr; show: aField] toFieldNumber: aNumber]
	"
	| start end index |
	
	self deprecated: 'Use NeoCSV instead'.
	
	start := 1.
	index := 1.
	[start <= self size] whileTrue: 
		[end := self indexOf: Character tab startingAt: start ifAbsent: [self size + 1].
		end := end - 1.
		aNumber = index ifTrue:
			[aBlock value: (self copyFrom: start  to: end).
			^ self].
		index := index + 1.
		start := end + 2]! !

!String methodsFor: 'testing' stamp: 'CamilloBruni 9/5/2011 17:31'!
isLiteralSymbol
	"Test whether a symbol can be stored as # followed by its characters.  
	Symbols created internally with asSymbol may not have this property, 
	e.g. '3' asSymbol."

	| i ascii type next last |
	self flag: 'reuse a parser for this'.
	
	i := self size.
	i = 0 ifTrue: [^ false].

	"TypeTable should have been origined at 0 rather than 1 ..."
	ascii := (self at: 1) asciiValue.
	type := self typeTable at: ascii ifAbsent: [^false].
	type == #xLetter ifTrue: [
		next := last := nil.
		[i > 1]
				whileTrue: 
					[ascii := (self at: i) asciiValue.
					type := self typeTable at: ascii ifAbsent: [^false].
					(type == #xLetter or: [type == #xDigit or: [type == #xColon
							and: [
								next == nil
									ifTrue: [last := #xColon. true] 
									ifFalse: [last == #xColon and: [next ~~ #xDigit and: [next ~~ #xColon]]]]]])
						ifFalse: [^ false].
					next := type.
					i := i - 1].
			^ true].	
	type == #xBinary ifTrue: [^i = 1]. "Here we could extend to
		^(2 to: i) allSatisfy: [:j |
			ascii := (self at: j) asciiValue.
			(self typeTable at: ascii ifAbsent: []) == #xBinary]"
	type == #verticalBar ifTrue: [^i = 1].
	^false! !

!String methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setProject: aString withInMetacelloConfig: aMetacelloConfig

	aMetacelloConfig setProject: aString withString: self! !

!String methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
loadRequiredForMetacelloMCVersion: aMetacelloMCVersion

	^aMetacelloMCVersion doLoadRequiredFromArray: (Array with: self).! !

!String methodsFor: '*metacello-core-version comparison' stamp: 'dkh 6/5/2012 19:01:24'!
metacelloIntegerLessThanSelf: anInteger
	"integer version components are always '>' string component"

	^false! !

!String methodsFor: 'copying' stamp: 'AdrienBarreau 6/17/2010 10:10'!
trimBoth
	"Trim separators from both sides of the receiving string."
	
	^ self trimBoth: [ :char | char isSeparator ]! !

!String methodsFor: 'accessing' stamp: 'yo 11/3/2004 19:24'!
includesSubstring: aString caseSensitive: caseSensitive
	
	^ (self findString: aString startingAt: 1 caseSensitive: caseSensitive) > 0! !

!String methodsFor: 'converting' stamp: 'BernardoContreras 3/15/2015 21:56'!
asLegalSelector
	"e.g. '234znak 43 ) 2' asLegalSelector = #v234znak432"
	
	| toUse |
 	toUse := self select: [:char | char isAlphaNumeric].
	(toUse isEmpty or: [ toUse first isLetter not ])
		ifTrue: [ toUse := 'v', toUse ].
	^ toUse uncapitalized asSymbol.
! !

!String methodsFor: 'comparing' stamp: 'ar 4/10/2005 16:42'!
compare: aString caseSensitive: aBool
	"Answer a comparison code telling how the receiver sorts relative to aString:
		1 - before
		2 - equal
		3 - after.
	"
	| map |
	map := aBool ifTrue:[CaseSensitiveOrder] ifFalse:[CaseInsensitiveOrder].
	^self compare: self with: aString collated: map! !

!String methodsFor: '*filesystem-core-converting' stamp: 'EstebanLorenzano 4/2/2012 11:43'!
asPath
	"convert myself to a path"
	"Examples:
		'.' asPath
		'~/Desktop' asPath
		'/home/foo' asPath
		'../../foo.bar' asPath"
	^ FileSystem disk resolve: self! !

!String methodsFor: 'converting' stamp: 'yo 11/3/2004 19:24'!
translateToUppercase
	"Translate all characters to lowercase, in place"

	self translateWith: UppercasingTable! !

!String methodsFor: 'accessing' stamp: 'nice 7/27/2007 23:13'!
findWordStart: key startingAt: start
	| ind |
	"HyperCard style searching.  Answer the index in self of the substring key, when that key is preceeded by a separator character.  Must occur at or beyond start.  The match is case-insensitive.  If no match is found, zero will be returned."

	ind := start.
	[ind := self findString: key startingAt: ind caseSensitive: false.
	ind = 0 ifTrue: [^ 0].	"not found"
	ind = 1 ifTrue: [^ 1].	"First char is the start of a word"
	(self at: ind-1) isSeparator] whileFalse: [ind := ind + 1].
	^ ind	"is a word start"! !

!String methodsFor: 'comparing' stamp: 'yo 11/3/2004 19:24'!
endsWithAnyOf: aCollection
	aCollection do:[:suffix|
		(self endsWith: suffix) ifTrue:[^true].
	].
	^false! !

!String methodsFor: '*regex-core' stamp: 'vb 4/11/09 21:56'!
asRegex
	"Compile the receiver as a regex matcher. May raise RxParser>>syntaxErrorSignal
	or RxParser>>compilationErrorSignal.
	This is a part of the Regular Expression Matcher package, (c) 1996, 1999 Vassili Bykov.
	Refer to `documentation' protocol of RxParser class for details."

	^RxParser preferredMatcherClass for: (RxParser new parse: self)! !

!String methodsFor: 'testing' stamp: 'StephaneDucasse 2/23/2012 14:23'!
occursInWithEmpty: prefix caseSensitive: aBoolean 
	"Answer whether the receiver begins with the given prefix string. 
	The comparison is case-sensitive." 
	| matchTable |
	prefix isEmpty ifTrue: [ ^ true ].
	self size < prefix size ifTrue: [ ^ false ].
	matchTable := aBoolean 
		ifTrue: [ CaseSensitiveOrder ]
		ifFalse: [ CaseInsensitiveOrder ].
	^ (self 
		findSubstring: prefix
		in: self
		startingAt: 1
		matchTable: matchTable) > 0! !

!String methodsFor: 'formatting' stamp: 'md 5/26/2005 13:34'!
expandMacrosWith: anObject with: anotherObject with: thirdObject 
	^self expandMacrosWithArguments: (Array 
				with: anObject
				with: anotherObject
				with: thirdObject)! !

!String methodsFor: 'converting' stamp: 'dew 9/13/2001 01:17'!
asPluralBasedOn: aNumberOrCollection
	"Append an 's' to this string based on whether aNumberOrCollection is 1 or of size 1."

	^ (aNumberOrCollection = 1 or:
		[aNumberOrCollection isCollection and: [aNumberOrCollection size = 1]])
			ifTrue: [self]
			ifFalse: [self, 's']
! !

!String methodsFor: '*regex-core' stamp: 'vb 4/11/09 21:56'!
regex: rxString matchesDo: aBlock

	^rxString asRegex matchesIn: self do: aBlock! !

!String methodsFor: '*Zinc-Character-Encoding-Core' stamp: 'SvenVanCaekenberghe 9/15/2014 13:36'!
utf8Encoded
	"Produce a ByteArray encoding the receiver using UTF-8,
	the recommended encoding for Strings, unless you know what you are doing."
	
	" 'Les élèves français' utf8Encoded "
	
	^ self encodeWith: #utf8! !

!String methodsFor: '*Text-Core' stamp: 'JuanVuletich 10/11/2010 20:14'!
endOfParagraphBefore: aNumber
	"Return the index of the last Character cr before position aNumber, or zero if this is the first paragraph.
	'ddd' endOfParagraphBefore: 3
	'dd
	d' endOfParagraphBefore: 4
	"
	^ self lastIndexOf: Character cr startingAt: aNumber - 1 ifAbsent: [ 0 ]! !

!String methodsFor: '*regex-core' stamp: 'vb 4/11/09 21:56'!
prefixMatchesRegex: regexString
	"Test if the receiver's prefix matches a regex.	
	May raise RxParser class>>regexErrorSignal or child signals.
	This is a part of the Regular Expression Matcher package, (c) 1996, 1999 Vassili Bykov.
	Refer to `documentation' protocol of RxParser class for details."

	^regexString asRegex matchesPrefix: self! !

!String methodsFor: 'accessing' stamp: 'CamilloBruni 2/8/2012 20:15'!
lineNumberCorrespondingToIndex: anIndex
	"Answer a lineNumber for the line at the given character position."
	|lineNumber|
	
	lineNumber := 0.
	
	self lineIndicesDo: [:start :endWithoutDelimiters :end |
		lineNumber := lineNumber + 1.
		anIndex <= end ifTrue: [^lineNumber]].
	^lineNumber! !

!String methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setRequiresInMetacelloPackage: aMetacelloPackageSpec

	aMetacelloPackageSpec setRequires: { self }.! !

!String methodsFor: 'converting' stamp: 'CamilloBruni 9/5/2011 16:05'!
adaptToNumber: receiver andSend: selector
	"If I am involved in arithmetic with a number, convert me to a number."

	^ receiver perform: selector with: self asNumber! !

!String methodsFor: 'accessing' stamp: 'yo 11/3/2004 19:24'!
findTokens: delimiters keep: keepers
	"Answer the collection of tokens that result from parsing self.  The tokens are seperated by delimiters, any of a string of characters.  If a delimiter is also in keepers, make a token for it.  (Very useful for carriage return.  A sole return ends a line, but is also saved as a token so you can see where the line breaks were.)"

	| tokens keyStart keyStop |
	tokens := OrderedCollection new.
	keyStop := 1.
	[keyStop <= self size] whileTrue:
		[keyStart := self skipDelimiters: delimiters startingAt: keyStop.
		keyStop to: keyStart-1 do: [:ii | 
			(keepers includes: (self at: ii)) ifTrue: [
				tokens add: (self copyFrom: ii to: ii)]].	"Make this keeper be a token"
		keyStop := self findDelimiters: delimiters startingAt: keyStart.
		keyStart < keyStop
			ifTrue: [tokens add: (self copyFrom: keyStart to: (keyStop - 1))]].
	^tokens! !

!String methodsFor: 'converting' stamp: 'BenComan 8/11/2014 10:04'!
findSelector
	"Dan's code for hunting down selectors with keyword parts; while this doesn't give a true parse, in most cases it does what we want, in where it doesn't, we're none the worse for it."
	| sel possibleParens |
	sel := self trimBoth.
	sel := sel copyReplaceAll: '#' with: ''.
	sel := sel copyReplaceAll: '[' with: ' [ '.
	(sel includes: $:) ifTrue:
		[sel := sel copyReplaceAll: ':' with: ': '.	"for the style (aa max:bb) with no space"
		possibleParens := sel findTokens: Character separators.
		sel := self class streamContents:
			[:s | | level | level := 0.
			possibleParens do:
				[:token | | n |
				(level = 0 and: [token endsWith: ':'])
					ifTrue: [s nextPutAll: token]
					ifFalse: [(n := token occurrencesOf: $( ) > 0 ifTrue: [level := level + n].
							(n := token occurrencesOf: $[ ) > 0 ifTrue: [level := level + n].
							(n := token occurrencesOf: $] ) > 0 ifTrue: [level := level - n].
							(n := token occurrencesOf: $) ) > 0 ifTrue: [level := level - n]]]]].

	sel isEmpty ifTrue: [^ nil].
	sel isOctetString ifTrue: [sel := sel asOctetString].
	Symbol hasInterned: sel ifTrue:
		[:aSymbol | ^ aSymbol].
	^ nil! !

!String methodsFor: '*Morphic-Base' stamp: 'ar 4/10/2005 17:07'!
asStringMorph 
	"Answer the receiver as a StringMorph"

	^ StringMorph contents: self

"'bugs black blood' asStringMorph openInHand"! !

!String methodsFor: 'copying' stamp: 'AdrienBarreau 6/17/2010 10:17'!
trimRight
	"Trim separators from the right side of the receiving string."
	
	^ self trimRight: [ :char | char isSeparator ]! !

!String methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setIncludesInMetacelloPackage: aMetacelloPackageSpec

	aMetacelloPackageSpec setIncludes: { self }.! !

!String methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
addToMetacelloRepositories: aMetacelloRepositoriesSpec

	| spec |
	spec := 
		(aMetacelloRepositoriesSpec project repositorySpec)
			description: self;
			yourself.
	aMetacelloRepositoriesSpec addMember: 
		(aMetacelloRepositoriesSpec addMember 
			name: spec name;
			spec: spec;
			yourself)! !

!String methodsFor: 'testing' stamp: 'ar 4/12/2005 19:52'!
isWideString
	"Answer whether the receiver is a WideString"
	^false! !

!String methodsFor: '*versionner-core-model' stamp: 'ChristopheDemarey 11/6/2012 15:24'!
configurationBaseName
	"Return the baseName for this configuration class name."
	
	^ (self indexOfSubCollection: 'ConfigurationOf') = 0
		ifTrue: [ self ]
		ifFalse: [ self copyFrom: ('ConfigurationOf' size + 1) to: self size]! !

!String methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 1/17/2013 09:39'!
withBlanksCondensed
	"Return a copy of the receiver with leading/trailing blanks (separators) removed
	 and consecutive white spaces (separators) condensed to the first one."

	| trimmed lastBlank |
	trimmed := self trimBoth.
	^ String streamContents: [ :stream | 
			lastBlank := false.
			trimmed
				do: [ :eachChar | 
					(eachChar isSeparator and: [ lastBlank ])
						ifFalse: [ stream nextPut: eachChar ].
					lastBlank := eachChar isSeparator ] ]

	" ' abc  d   ' withBlanksCondensed"! !

!String methodsFor: 'converting' stamp: 'CamilloBruni 9/5/2011 16:06'!
adaptToString: receiver andSend: selector
	"If I am involved in arithmetic with a string, convert us both to
	numbers, and return the printString of the result."

	^ (receiver asNumber perform: selector with: self asNumber) printString! !

!String methodsFor: '*Slot' stamp: 'BenjaminVanRyseghem 11/24/2010 14:41'!
inviolateInstanceVariableNames
	"Answer a list of instance variable names not to be used.  (Place holder for real list)"
	^ #('thisContext' 'self')! !

!String methodsFor: 'testing' stamp: 'StephaneDucasse 6/11/2010 12:37'!
isAllDigits
	"whether the receiver is composed entirely of digits and has at least one digit"

	self do: [:c | c isDigit ifFalse: [^ false]].
	self ifEmpty: [^false].
       ^ true! !

!String methodsFor: 'accessing' stamp: 'ar 4/12/2005 16:30'!
byteSize
	^self subclassResponsibility! !

!String methodsFor: 'accessing' stamp: 'MarcusDenker 8/26/2010 21:00'!
lines
    "Answer an array of lines composing this receiver without the line ending delimiters"
    ^Array new: (self size // 60 max: 16)
            streamContents: [:lines | self linesDo: [:aLine | lines nextPut: aLine]]! !

!String methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setBlessingInMetacelloVersion: aMetacelloVersionSpec

	aMetacelloVersionSpec setBlessing: 
		(aMetacelloVersionSpec project valueHolderSpec
			value: self;
			yourself)! !

!String methodsFor: '*RPackage-SystemIntegration' stamp: 'TudorGirba 2/17/2015 09:02'!
asPackage
	^ self asPackageIfAbsent: [ NotFound signalFor: self ]! !

!String methodsFor: 'converting' stamp: 'SeanDeNigris 1/24/2011 23:20'!
asWideString 

	^ WideString from: self! !

!String methodsFor: 'accessing' stamp: 'ar 4/10/2005 17:13'!
findTokens: delimiters
	"Answer the collection of tokens that result from parsing self.  Return strings between the delimiters.  Any character in the Collection delimiters marks a border.  Several delimiters in a row are considered as just one separation.  Also, allow delimiters to be a single character."

	| tokens keyStart keyStop separators |

	tokens := OrderedCollection new.
	separators := delimiters isCharacter 
		ifTrue: [Array with: delimiters]
		ifFalse: [delimiters].
	keyStop := 1.
	[keyStop <= self size] whileTrue:
		[keyStart := self skipDelimiters: separators startingAt: keyStop.
		keyStop := self findDelimiters: separators startingAt: keyStart.
		keyStart < keyStop
			ifTrue: [tokens add: (self copyFrom: keyStart to: (keyStop - 1))]].
	^tokens! !

!String methodsFor: '*Collections-arithmetic' stamp: 'yo 11/3/2004 19:24'!
+ arg

	^ arg adaptToString: self andSend: #+! !

!String methodsFor: '*Slot' stamp: 'BernardoContreras 3/7/2015 12:31'!
asSlotCollection
	"Parse as slots.
	Example: 
	  'a b' asSlotCollection --> {a => Slot. b => Slot}
	"
	^ (self substrings: ' ') collect: [ :x | x asSlot ]! !

!String methodsFor: 'converting' stamp: 'yo 11/3/2004 19:24'!
correctAgainst: wordList
	"Correct the receiver: assume it is a misspelled word and return the (maximum of five) nearest words in the wordList.  Depends on the scoring scheme of alike:"
	| results |
	results := self correctAgainst: wordList continuedFrom: nil.
	results := self correctAgainst: nil continuedFrom: results.
	^ results! !

!String methodsFor: '*compression' stamp: 'HenrikSperreJohansen 1/27/2010 18:07'!
convertToSystemString

	^LanguageEnvironment defaultSystemConverter convertToSystemString: self! !

!String methodsFor: 'converting' stamp: 'BernardoContreras 8/11/2014 19:12'!
uncapitalized
	"Return a copy with the first letter downShifted (in lower case)"
	
	| answer |
	self ifEmpty: [ ^ self copy ].
	answer := self copy.
	answer at: 1 put: answer first asLowercase.
	^ answer! !

!String methodsFor: 'converting' stamp: 'CamilloBruni 9/5/2011 16:05'!
adaptToPoint: receiver andSend: selector
	"If I am involved in arithmetic with a point, convert me to a number."

	^ receiver perform: selector with: self asNumber! !

!String methodsFor: 'copying' stamp: 'AdrienBarreau 6/17/2010 10:17'!
trimLeft
	"Trim separators from the left side of the receiving string."
	
	^ self trimLeft: [ :char | char isSeparator ] ! !

!String methodsFor: '*Multilingual-TextConversion' stamp: 'KR 1/30/2006 21:47'!
convertFromEncoding: encodingName
	^self convertFromWithConverter: (TextConverter newForEncoding: encodingName)! !

!String methodsFor: 'comparing' stamp: 'ar 4/10/2005 16:38'!
compare: aString 
	"Answer a comparison code telling how the receiver sorts relative to aString:
		1 - before
		2 - equal
		3 - after.
	The collation sequence is ascii with case differences ignored.
	To get the effect of a <= b, but ignoring case, use (a compare: b) <= 2."
	^self compare: aString caseSensitive: false! !

!String methodsFor: 'formatting' stamp: 'md 5/26/2005 13:34'!
expandMacrosWith: anObject with: anotherObject 
	^self 
		expandMacrosWithArguments: (Array with: anObject with: anotherObject)! !

!String methodsFor: 'accessing' stamp: 'AlainPlantec 11/12/2010 23:11'!
allRangesOfSubString: aSubString

	^ Array streamContents: [:s | | start subSize |
		start := 1.
		subSize := aSubString size.
		[start isZero]
			whileFalse: [ start := self findString: aSubString startingAt: start.
				start > 0 
					ifTrue: [s nextPut: (start to: start + subSize - 1).
						start := start + subSize]]]! !

!String methodsFor: 'copying' stamp: 'CamilloBruni 7/2/2012 13:19'!
padRightTo: length with: char
	^ self, (String new: (length - self size max: 0) withAll: char)! !

!String methodsFor: '*NativeBoost-Core' stamp: 'Igor.Stasenko 5/19/2010 13:19'!
asNBExternalString

	^ NBExternalAddress fromString: self! !

!String methodsFor: 'printing' stamp: 'yo 11/3/2004 19:24'!
isLiteral

	^true! !

!String methodsFor: '*GT-InspectorExtensions-Core' stamp: 'JurajKubelka 3/28/2015 18:03'!
gtDisplayOn: aStream
	self printOn: aStream.! !

!String methodsFor: 'comparing' stamp: 'yo 11/3/2004 19:24'!
alike: aString 
	"Answer some indication of how alike the receiver is to the argument,  0 is no match, twice aString size is best score.  Case is ignored."

	| i j k minSize bonus |
	minSize := (j := self size) min: (k := aString size).
	bonus := (j - k) abs < 2 ifTrue: [ 1 ] ifFalse: [ 0 ].
	i := 1.
	[(i <= minSize) and: [((super at: i) bitAnd: 16rDF)  = ((aString at: i) asciiValue bitAnd: 16rDF)]]
		whileTrue: [ i := i + 1 ].
	[(j > 0) and: [(k > 0) and:
		[((super at: j) bitAnd: 16rDF) = ((aString at: k) asciiValue bitAnd: 16rDF)]]]
			whileTrue: [ j := j - 1.  k := k - 1. ].
	^ i - 1 + self size - j + bonus. ! !

!String methodsFor: 'accessing' stamp: 'yo 11/3/2004 19:24'!
startsWithDigit
	"Answer whether the receiver's first character represents a digit"

	^ self size > 0 and: [self first isDigit]! !

!String methodsFor: 'formatting' stamp: 'SvenVanCaekenberghe 11/21/2012 09:31'!
format: collection 
	"Format the receiver by interpolating elements from collection, as in the following examples:  
	'Today is {1}.' format: {Date today}.
	'Today is {date}.' format: (Dictionary with: #date->Date today). 
	'In {1} you can escape \{ by prefixing it with \\' format: {'strings'}.  "
	
	^ self class new: self size streamContents: [ :result | | stream |
		stream := self readStream.
		[ stream atEnd ] whileFalse: [ | currentChar | 
			(currentChar := stream next) == ${
				ifTrue: [ | expression index | 
					expression := stream upTo: $}.
					index := Integer readFrom: expression ifFail: [ expression ].
					result nextPutAll: (collection at: index) asString ]
				ifFalse: [
					currentChar == $\
						ifTrue: [ stream atEnd ifFalse: [ result nextPut: stream next ] ]
						ifFalse: [ result nextPut: currentChar ] ] ] ]! !

!String methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 1/17/2013 09:48'!
withSeparatorsCompacted
	"Return a copy of the receiver with each sequence of whitespace (separator) 
	characters replaced by a single space character"

	self isEmpty ifTrue: [ ^ self ].
	^ self class new: self size streamContents: [:stream | 
		| lastBlank |
		lastBlank := false.
		self do: [ :eachChar | 
			lastBlank 
				ifTrue: [
					(lastBlank := eachChar isSeparator)
						ifFalse: [ stream nextPut: eachChar ] ] 
				ifFalse: [
					(lastBlank := eachChar isSeparator)
						ifTrue: [ stream nextPut: $  ]
						ifFalse: [ stream nextPut: eachChar ] ] ] ]

	"' test ' withSeparatorsCompacted"
	"' test test' withSeparatorsCompacted"
	"'test  test		 ' withSeparatorsCompacted"! !

!String methodsFor: 'copying' stamp: 'MarcusDenker 1/18/2014 14:11'!
copyReplaceAll: oldSubstring with: newSubstring asTokens: ifTokens
	"Answer a copy of the receiver in which all occurrences of
	oldSubstring have been replaced by newSubstring.
	ifTokens (valid for Strings only) specifies that the characters
	surrounding the recplacement must not be alphanumeric.
		Bruce Simth,  must be incremented by 1 and not 
	newSubstring if ifTokens is true.  See example below. "

	| aString startSearch currentIndex endIndex |

	aString := self.
	startSearch := 1.
	[(currentIndex := aString indexOfSubCollection: oldSubstring startingAt: startSearch)
			 > 0]
		whileTrue: 
		[endIndex := currentIndex + oldSubstring size - 1.
		(ifTokens not
			or: [(currentIndex = 1
					or: [(aString at: currentIndex-1) isAlphaNumeric not])
				and: [endIndex = aString size
					or: [(aString at: endIndex+1) isAlphaNumeric not]]])
			ifTrue: [aString := aString
					copyReplaceFrom: currentIndex
					to: endIndex
					with: newSubstring.
				startSearch := currentIndex + newSubstring size]
			ifFalse: [
				ifTokens 
					ifTrue: [startSearch := currentIndex + 1]
					ifFalse: [startSearch := currentIndex + newSubstring size]]].
	^ aString

"Test case:
	'test te string' copyReplaceAll: 'te' with: 'longone' asTokens: true   "
! !

!String methodsFor: '*zinc-resource-meta-core' stamp: 'SvenVanCaekenberghe 1/4/2011 19:47'!
asZnMimeType
	^ ZnMimeType fromString: self! !

!String methodsFor: '*System-Localization' stamp: 'HilaireFernandes 5/6/2010 21:54'!
translatedTo: localeID 
	"answer the receiver translated to the given locale id"
	^ NaturalLanguageTranslator translate: self toLocale: localeID! !

!String methodsFor: 'converting' stamp: 'yo 11/3/2004 19:24'!
contractTo: smallSize
	"return myself or a copy shortened by ellipsis to smallSize"
	| leftSize |
	self size <= smallSize
		ifTrue: [^ self].  "short enough"
	smallSize < 5
		ifTrue: [^ self copyFrom: 1 to: smallSize].    "First N characters"
	leftSize := smallSize-2//2.
	^ self copyReplaceFrom: leftSize+1		"First N/2 ... last N/2"
		to: self size - (smallSize - leftSize - 3)
		with: '...'
"
	'A clear but rather long-winded summary' contractTo: 18
"! !

!String methodsFor: 'converting' stamp: 'BenComan 9/21/2014 10:39'!
substrings: separators 
	"Answer an array containing the substrings in the receiver separated 
	by the elements of separators."
	| result sourceStream subStringStream |
	
	(separators isString or: [ separators allSatisfy: [ :element | element isCharacter ] ])
		ifFalse: [ ^ self error: 'separators must be Characters.' ].
	sourceStream := self readStream.
	result := OrderedCollection new.
	subStringStream := String new writeStream.
	[ sourceStream atEnd ] whileFalse: [
		| char |
		char := sourceStream next.
		(separators includes: char)
			ifTrue: [
				subStringStream isEmpty ifFalse: [
					result add: subStringStream contents.
					subStringStream := String new writeStream ] ]
			ifFalse: [
				subStringStream nextPut: char ] ].
	subStringStream isEmpty ifFalse: [
		result add: subStringStream contents ].
	^ result asArray! !

!String methodsFor: '*metacello-core-version comparison' stamp: 'dkh 6/21/2012 20:44'!
metacelloSemanticIntegerLessThanSelf: anInteger
    "integer version components are always '>' string component"

    ^ true! !

!String methodsFor: 'accessing' stamp: 'StephaneDucasse 2/23/2012 14:18'!
wordBefore: anIndex 
	| sep tok |
	tok := false.
	sep := anIndex.
	[ sep > 0 and: [ (self at: sep) tokenish ] ] whileTrue: 
		[ tok := true.
		sep := sep - 1 ]. 
	^ tok 
		ifTrue: 
			[ self 
				copyFrom: sep + 1
				to: anIndex ]
		ifFalse: [ String new ]! !

!String methodsFor: 'converting' stamp: 'CamilloBruni 9/5/2011 16:05'!
adaptToCollection: receiver andSend: selector
	"If I am involved in arithmetic with a collection, convert me to a number."

	^ receiver perform: selector with: self asNumber! !

!String methodsFor: 'platform conventions' stamp: 'EstebanLorenzano 5/22/2012 18:32'!
withoutQuoting
	"remove the initial and final quote marks, if present (and if matches nesting quotes)"
	"'''h''' withoutQuoting"
	| quote |
	self size < 2 ifTrue: [ ^self ].
	quote := self first.
	(quote = self last and: [ quote = $' or: [ quote = $" ] ])
		ifTrue: [ ^self copyFrom: 2 to: self size - 1 ]
		ifFalse: [ ^self ].! !

!String methodsFor: 'accessing' stamp: 'yo 11/3/2004 19:24'!
findBetweenSubStrs: delimiters
	"Answer the collection of String tokens that result from parsing self.  Tokens are separated by 'delimiters', which can be a collection of Strings, or a collection of Characters.  Several delimiters in a row are considered as just one separation."

	| tokens keyStart keyStop |
	tokens := OrderedCollection new.
	keyStop := 1.
	[keyStop <= self size] whileTrue:
		[keyStart := self skipAnySubStr: delimiters startingAt: keyStop.
		keyStop := self findAnySubStr: delimiters startingAt: keyStart.
		keyStart < keyStop
			ifTrue: [tokens add: (self copyFrom: keyStart to: (keyStop - 1))]].
	^tokens! !

!String methodsFor: 'converting' stamp: 'yo 11/3/2004 19:24'!
asUppercase
	"Answer a String made up from the receiver whose characters are all 
	uppercase."

	^self copy asString translateToUppercase! !

!String methodsFor: '*regex-core' stamp: 'vb 4/11/09 21:56'!
allRegexMatches: rxString

	^rxString asRegex matchesIn: self! !

!String methodsFor: 'converting' stamp: 'yo 11/3/2004 19:24'!
asDuration
 	"convert from [nnnd]hh:mm:ss[.nanos] format. [] implies optional elements"
 
 	^ Duration fromString: self
 ! !

!String methodsFor: 'accessing' stamp: 'nice 11/16/2009 13:23'!
lineNumber: anIndex
	"Answer a string containing the characters in the given line number."

	| lineCount |
	lineCount := 0.
	self lineIndicesDo: [:start :endWithoutDelimiters :end |
		(lineCount := lineCount + 1) = anIndex ifTrue: [^self copyFrom: start to: endWithoutDelimiters]].
	^nil! !

!String methodsFor: 'accessing' stamp: 'nice 1/19/2010 00:29'!
lineIndicesDo: aBlock
	"execute aBlock with 3 arguments for each line:
	- start index of line
	- end index of line without line delimiter
	- end index of line including line delimiter(s) CR, LF or CRLF"
	
	| cr lf start sz nextLF nextCR |
	start := 1.
	sz := self size.
	cr := Character cr.
	nextCR := self indexOf: cr startingAt: 1.
	lf := Character lf.
	nextLF := self indexOf: lf startingAt: 1.
	[ start <= sz ] whileTrue: [
		(nextLF = 0 and: [ nextCR = 0 ])
			ifTrue: [ "No more CR, nor LF, the string is over"
					aBlock value: start value: sz value: sz.
					^self ].
		(nextCR = 0 or: [ 0 < nextLF and: [ nextLF < nextCR ] ])
			ifTrue: [ "Found a LF"
					aBlock value: start value: nextLF - 1 value: nextLF.
					start := 1 + nextLF.
					nextLF := self indexOf: lf startingAt: start ]
			ifFalse: [ 1 + nextCR = nextLF
				ifTrue: [ "Found a CR-LF pair"
					aBlock value: start value: nextCR - 1 value: nextLF.
					start := 1 + nextLF.
					nextCR := self indexOf: cr startingAt: start.
					nextLF := self indexOf: lf startingAt: start ]
				ifFalse: [ "Found a CR"
					aBlock value: start value: nextCR - 1 value: nextCR.
					start := 1 + nextCR.
					nextCR := self indexOf: cr startingAt: start ]]]! !

!String methodsFor: 'copying' stamp: 'AdrienBarreau 6/17/2010 10:17'!
trimLeft: aBlock
	"Trim characters satisfying the condition given in aBlock from the left side of the receiving string."
	
	^ self trimLeft: aBlock right: [ :char | false ]! !

!String methodsFor: 'filter streaming' stamp: 'yo 8/26/2002 22:31'!
putOn:aStream

	^aStream nextPutAll: self.
! !

!String methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
removeFromMetacelloPackages: aMetacelloPackagesSpec

	aMetacelloPackagesSpec addMember: 
		(aMetacelloPackagesSpec removeMember 
			name: self;
			yourself)! !

!String methodsFor: 'accessing' stamp: 'nice 7/27/2007 23:34'!
findString: subString startingAt: start 
	"Answer the index of subString within the receiver, starting at start. If 
	the receiver does not contain subString, answer 0."

	^self findString: subString startingAt: start caseSensitive: true! !

!String methodsFor: 'converting' stamp: 'yo 11/3/2004 19:24'!
onlyLetters
	"answer the receiver with only letters"
	^ self select:[:each | each isLetter]! !

!String methodsFor: '*zinc-resource-meta-core' stamp: 'SvenVanCaekenberghe 1/4/2011 13:03'!
asZnUrl
	^ ZnUrl fromString: self! !

!String methodsFor: '*Morphic-Base' stamp: 'ar 4/10/2005 17:07'!
asMorph 
	"Answer the receiver as a StringMorph"

	^ StringMorph contents: self

"'bugs black blood' asMorph openInHand"! !

!String methodsFor: 'comparing' stamp: 'ar 4/10/2005 16:39'!
caseInsensitiveLessOrEqual: aString 
	"Answer whether the receiver sorts before or equal to aString.
	The collation order is case insensitive."
	^(self compare: aString caseSensitive: false) <= 2! !

!String methodsFor: '*compression' stamp: 'yo 11/3/2004 19:24'!
lastIndexOfPKSignature: aSignature
	"Answer the last index in me where aSignature (4 bytes long) occurs, or 0 if not found"
	| a b c d |
	a := aSignature first.
	b := aSignature second.
	c := aSignature third.
	d := aSignature fourth.
	(self size - 3) to: 1 by: -1 do: [ :i |
		(((self at: i) = a)
			and: [ ((self at: i + 1) = b)
				and: [ ((self at: i + 2) = c)
					and: [ ((self at: i + 3) = d) ]]])
						ifTrue: [ ^i ]
	].
	^0! !

!String methodsFor: 'platform conventions' stamp: 'ul 11/23/2010 08:20'!
withUnixLineEndings
	"Assume the string is textual, and that CR, LF, and CRLF are all valid line endings.
	Replace each occurence with a single LF."

	(self includes: Character cr) ifFalse: [ ^self ].
	(self includes: Character lf) ifFalse: [
		^self translateWith: String crLfExchangeTable ].
	^self withLineEndings: String lf! !

!String methodsFor: 'accessing' stamp: 'ar 4/12/2005 16:31'!
indexOf: aCharacter startingAt: start

	(aCharacter isCharacter) ifFalse: [^ 0].
	^ self class indexOfAscii: aCharacter asciiValue inString: self startingAt: start! !

!String methodsFor: '*UIManager-Support' stamp: 'CamilloBruni 8/30/2012 16:21'!
displayProgressFrom: minVal to: maxVal during: workBlock 
	"Display this string as a caption over a progress bar while workBlock is evaluated.

EXAMPLE (Select next 6 lines and Do It)
'Now here''s some Real Progress'
	displayProgressFrom: 0 to: 10
	during: [:bar |
	1 to: 10 do: [:x | bar value: x.
			(Delay forMilliseconds: 500) wait]].
"
	^ UIManager default 
		displayProgress: self 
		from: minVal 
		to: maxVal 
		during: workBlock! !

!String methodsFor: 'converting' stamp: 'CamilloBruni 9/5/2011 17:56'!
asHex
	^ self class new: self size * 4 streamContents: [ :stream |
		self do: [ :ch | stream nextPutAll: ch hex ]]! !

!String methodsFor: 'converting' stamp: 'CamilloBruni 9/5/2011 16:20'!
surroundedBySingleQuotes
	"Answer the receiver with leading and trailing quotes.  "

	^ self surroundedBy: ($' asString)! !

!String methodsFor: 'copying' stamp: 'AdrienBarreau 6/17/2010 10:11'!
trimBoth: aBlock
	"Trim characters satisfying the condition given in aBlock from both sides of the receiving string."

	^ self trimLeft: aBlock right: aBlock! !

!String methodsFor: '*System-Support' stamp: 'CamilloBruni 5/8/2013 11:16'!
asClassInEnvironment: anEnvironment
	"I return class named after myself from anEnvironment"
	^ self 
		asClassInEnvironment: anEnvironment 
		ifAbsent: [ NotFound signalFor: self in: anEnvironment  ]! !

!String methodsFor: '*compression' stamp: 'yo 11/3/2004 19:24'!
unzipped
	| magic1 magic2 |
	magic1 := (self at: 1) asInteger.
	magic2 := (self at: 2) asInteger.
	(magic1 = 16r1F and:[magic2 = 16r8B]) ifFalse:[^self].
	^(GZipReadStream on: self) upToEnd! !

!String methodsFor: 'accessing' stamp: 'ar 4/12/2005 16:31'!
indexOf: aCharacter  startingAt: start  ifAbsent: aBlock
	| ans |
	(aCharacter isCharacter) ifFalse: [ ^ aBlock value ].
	ans := self class indexOfAscii: aCharacter asciiValue inString: self  startingAt: start.
	ans = 0
		ifTrue: [ ^ aBlock value ]
		ifFalse: [ ^ ans ]! !

!String methodsFor: 'formatting' stamp: 'CamilloBruni 9/7/2011 11:49'!
expandMacrosWithArguments: anArray 
	| readStream char index |
	^ self class new: self size streamContents: [ :newStream|
		readStream := self readStream.
		[ readStream atEnd ] whileFalse: 
			[ char := readStream next.
			char == $< 
				ifTrue: 
					[ | nextChar |
					nextChar := readStream next asUppercase.
					nextChar == $N ifTrue: [ newStream cr ].
					nextChar == $T ifTrue: [ newStream tab ].
					nextChar isDigit ifTrue: 
						[ index := nextChar digitValue.
						
						[ readStream atEnd or: [ (nextChar := readStream next asUppercase) isDigit not ] ] whileFalse: [ index := index * 10 + nextChar digitValue ] ].
					nextChar == $? ifTrue: 
						[ | trueString falseString |
						trueString := readStream upTo: $:.
						falseString := readStream upTo: $>.
						readStream position: readStream position - 1.
						newStream nextPutAll: ((anArray at: index) 
								ifTrue: [ trueString ]
								ifFalse: [ falseString ]) ].
					nextChar == $P ifTrue: [ newStream nextPutAll: (anArray at: index) printString ].
					nextChar == $S ifTrue: [ newStream nextPutAll: (anArray at: index) ].
					readStream skipTo: $> ]
				ifFalse: 
					[ newStream nextPut: (char == $% 
							ifTrue: [ readStream next ]
							ifFalse: [ char ])]]].! !

!String methodsFor: 'converting' stamp: 'HenrikSperreJohansen 6/15/2010 15:20'!
asByteString
	"Convert the receiver into a ByteString, if possible"
	"Do not raise an error if it's not possible, since my use case is usually one in which WideStrings may or may not have been mutated to something representable in a ByteString, and we mostly do this to save space if possible. If the percentage of such cases are small, it may be better to use isOctetString check first to avoid creating String instances"	
	^self asOctetString! !

!String methodsFor: 'testing' stamp: 'PabloHerrero 2/16/2015 17:13'!
isPatternVariable

	 ^self keywords anySatisfy: [:each | each first = $`]! !

!String methodsFor: 'comparing' stamp: 'ar 4/10/2005 16:39'!
caseSensitiveLessOrEqual: aString 
	"Answer whether the receiver sorts before or equal to aString.
	The collation order is case sensitive."
	^(self compare: aString caseSensitive: true) <= 2! !

!String methodsFor: '*Network-MIME' stamp: 'ar 7/22/2009 22:00'!
base64Decoded
	"Decode the receiver from base 64"
	"'SGVsbG8gV29ybGQ=' base64Decoded"
	^(Base64MimeConverter mimeDecode: self as: self class)! !

!String methodsFor: '*files' stamp: 'CamilloBruni 9/7/2013 11:28'!
asFileName
	"Answer a String made up from the receiver that is an acceptable file 
	name."

	| string checkedString |
	string := FileSystem disk checkName: self fixErrors: true.
	checkedString := FilePathEncoder encode: string.
	^ FilePathEncoder decode: checkedString! !

!String methodsFor: 'converting' stamp: 'yo 11/3/2004 19:24'!
romanNumber
	| value v1 v2 |
	value := v1 := v2 := 0.
	self reverseDo:
		[:each |
		v1 := #(1 5 10 50 100 500 1000) at: ('IVXLCDM' indexOf: each).
		v1 >= v2
			ifTrue: [value := value + v1]
			ifFalse: [value := value - v1].
		v2 := v1].
	^ value! !

!String methodsFor: 'copying' stamp: 'CamilloBruni 8/30/2011 18:41'!
trimmed
	^ self trimBoth! !

!String methodsFor: 'formatting' stamp: 'md 5/26/2005 13:34'!
expandMacrosWith: anObject 
	^self expandMacrosWithArguments: (Array with: anObject)! !

!String methodsFor: 'platform conventions' stamp: 'CamilloBruni 10/20/2012 19:19'!
withLineEndings: lineEndingString

	| stream |
	
	stream := nil.
	self lineIndicesDo: [ :start :endWithoutDelimiters :end |
		(stream isNil and: [ endWithoutDelimiters ~= end ]) ifTrue: [
			(self copyFrom: endWithoutDelimiters + 1 to: end) = lineEndingString ifFalse: [
				stream := WriteStream with: self copy.
				stream position: start - 1 ]].
		stream ifNotNil: [
			stream next: endWithoutDelimiters - start + 1 putAll: self startingAt: start.
			endWithoutDelimiters = end ifFalse: [
				stream nextPutAll: lineEndingString ]]].
	^stream
		ifNil: [ self ]
		ifNotNil: [ 
			stream position = self size
				ifTrue: [ stream originalContents ]
				ifFalse: [ stream contents ]]! !

!String methodsFor: '*regex-core' stamp: 'vb 4/11/09 21:56'!
allRangesOfRegexMatches: rxString

	^rxString asRegex matchingRangesIn: self! !

!String methodsFor: '*OSWindow-Core' stamp: 'RonieSalgado 1/16/2014 16:18'!
asUTF8Bytes
	^ ZnUTF8Encoder new encodeString: self! !

!String methodsFor: 'converting' stamp: 'StephaneDucasse 4/23/2010 21:06'!
asDateAndTime
 	"Convert from UTC format" 	
	
	^ DateAndTime fromString: self! !

!String methodsFor: 'converting' stamp: 'HenrikSperreJohansen 6/15/2010 15:16'!
asOctetString
	"Convert the receiver into an octet string, if possible"
	"(IE, I am a WideString containing only character with codePoints < 255, so all of them fit in a latin1-string)."
	| string |
	string := String new: self size.
	1 to: self size do: [:i | string at: i put: (self at: i)].
	^string! !

!String methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
resolvePackageSpecsNamedForMetacelloMCVersion: aMetacelloMCVersion visited: visited ifAbsent: aBlock
    ^ aMetacelloMCVersion
        allPackagesForSpecs: {(aMetacelloMCVersion packageNamed: self ifAbsent: aBlock)}
        visited: visited! !

!String methodsFor: '*Deprecated40' stamp: 'MarcusDenker 7/18/2014 16:58'!
asTimeStamp
	"Convert from obsolete TimeStamp format"
	self deprecated: 'use #asDateAndTime' on: '18 July 2014'  in: 'Pharo4'.
 	^ TimeStamp fromString: self! !

!String methodsFor: '*regex-core' stamp: 'vb 4/11/09 21:56'!
copyWithRegex: rxString matchesTranslatedUsing: aBlock

	^rxString asRegex
		copy: self translatingMatchesUsing: aBlock! !

!String methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setAuthorInMetacelloConfig: aMetacelloConfig

	aMetacelloConfig setAuthorWithString: self! !

!String methodsFor: '*Collections-arithmetic' stamp: 'yo 11/3/2004 19:24'!
/ arg

	^ arg adaptToString: self andSend: #/! !

!String methodsFor: '*Polymorph-Widgets' stamp: 'BenjaminVanRyseghem 6/24/2012 22:42'!
widthToDisplayInTree: aTree

	^ aTree fontToUse widthOfStringOrText: self contents! !

!String methodsFor: 'converting' stamp: 'MarcusDenker 8/15/2010 11:06'!
asCamelCase
       "Convert to CamelCase. Can be conveinient in conjunction with #asLegalSelector
     	 'A man, a plan, a canal, panama' asCamelCase.
       'A man, a plan, a canal, panama' asCamelCase asLegalSelector.
       'Here 123should % be 6 the name6 of the method' asCamelCase.
       'Here 123should % be 6 the name6 of the method' asCamelCase asLegalSelector."

      ^ self class streamContents: [:stream |
               self substrings do: [:sub |
                       stream nextPutAll: sub capitalized]]! !

!String methodsFor: '*metacello-core-version comparison' stamp: 'dkh 6/5/2012 19:01:24'!
metacelloStringLessThanSelf: aString

	^aString < self! !

!String methodsFor: 'comparing' stamp: 'SeanDeNigris 1/24/2011 23:35'!
findIn: body startingAt: start matchTable: matchTable
	
	^ self findSubstringViaPrimitive: self in: body startingAt: start matchTable: matchTable! !

!String methodsFor: '*regex-core' stamp: 'vb 4/11/09 21:56'!
copyWithRegex: rxString matchesReplacedWith: aString

	^rxString asRegex
		copy: self replacingMatchesWith: aString! !

!String methodsFor: 'private' stamp: 'ClementBera 7/26/2013 16:59'!
correctAgainstEnumerator: wordBlock continuedFrom: oldCollection
	"The guts of correction, instead of a wordList, there is a block that should take another block and enumerate over some list with it."

	| choices results maxChoices scoreMin |
	scoreMin := self size // 2 min: 3.
	maxChoices := 10.
	oldCollection 
		ifNil: [ choices := SortedCollection sortBlock: [ :x :y | x value > y value ] ]
		ifNotNil: [ choices := oldCollection ].
	wordBlock isNil
		ifTrue:
			[ results := OrderedCollection new.
			1 to: (maxChoices min: choices size) do: [ :i | results add: (choices at: i) key ] ]
		ifFalse:
			[ wordBlock value: [ :word | | score |
				(score := self alike: word) >= scoreMin ifTrue:
					[ choices add: (Association key: word value: score).
						(choices size >= maxChoices) ifTrue: [ scoreMin := (choices at: maxChoices) value] ] ].
			results := choices ].
	^ results! !

!String methodsFor: 'accessing' stamp: 'CamilloBruni 8/1/2012 16:09'!
indexOfSubCollection: sub 
	^ self
		indexOfSubCollection: sub
		startingAt: 1
		ifAbsent: [0]! !

!String methodsFor: '*Deprecated40' stamp: 'DamienPollet 9/26/2014 16:35'!
tabDelimitedFieldsDo: aBlock
	"Considering the receiver as a holder of tab-delimited fields, evaluate execute aBlock with each field in this string.  The separatilng tabs are not included in what is passed to aBlock
	'fred	charlie	elmo		2' tabDelimitedFieldsDo: [:aField | Transcript cr; show: aField]
	"
	| start end |
	
	self deprecated: 'Use NeoCSV instead'.
	
	"No senders but was useful enough in earlier work that it's retained for the moment."
	start := 1.
	[start <= self size] whileTrue: 
		[end := self indexOf: Character tab startingAt: start ifAbsent: [self size + 1].
		end := end - 1.
		aBlock value: (self copyFrom: start  to: end).
		start := end + 2]! !

!String methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 2/12/2015 17:52'!
asBrick

	^ GLMLabelBrick new
		text: self asString;
		height: [ :b | b approximateHeight ]! !

!String methodsFor: '*Morphic-Base-Widgets' stamp: 'BenjaminVanRyseghem 2/21/2013 23:20'!
listRenderOn: aCanvas atRow: aRow bounds: bounds color: color backgroundColor: backgroundColor from: aMorph

	aCanvas
		drawString: self
		in: bounds
		font: aMorph font
		color: color! !

!String methodsFor: '*Collections-arithmetic' stamp: 'yo 11/3/2004 19:24'!
- arg

	^ arg adaptToString: self andSend: #-! !

!String methodsFor: 'encoding' stamp: 'ar 4/10/2005 17:18'!
writeLeadingCharRunsOn: stream

	| runLength runValues runStart leadingChar |
	self isEmpty ifTrue: [^ self].

	runLength := OrderedCollection new.
	runValues := OrderedCollection new.
	runStart := 1.
	leadingChar := (self at: runStart) leadingChar.
	2 to: self size do: [:index |
		(self at: index) leadingChar = leadingChar ifFalse: [
			runValues add: leadingChar.
			runLength add: (index - runStart).
			leadingChar := (self at: index) leadingChar.
			runStart := index.
		].
	].
	runValues add: (self last) leadingChar.
	runLength add: self size + 1 -  runStart.

	stream nextPut: $(.
	runLength do: [:rr | rr printOn: stream. stream space].
	stream skip: -1; nextPut: $).
	runValues do: [:vv | vv printOn: stream. stream nextPut: $,].
	stream skip: -1.
! !

!String methodsFor: 'converting' stamp: 'NikoSchwarz 10/24/2009 10:19'!
squeezeOutNumber
	"Try to find a number somewhere in this string, as explained in Number>readFrom:"
	^ Number squeezeNumberOutOfString: self! !

!String methodsFor: 'converting' stamp: 'yo 11/3/2004 19:24'!
truncateWithElipsisTo: maxLength
	"Return myself or a copy suitably shortened but with elipsis added"

	^ self size <= maxLength
		ifTrue:
			[self]
		ifFalse:
			[(self copyFrom: 1 to: (maxLength - 3)), '...']


	"'truncateWithElipsisTo:' truncateWithElipsisTo: 20"! !

!String methodsFor: 'converting' stamp: 'yo 11/3/2004 19:24'!
asDate
	"Many allowed forms, see Date>>#readFrom:"

	^ Date fromString: self! !

!String methodsFor: 'testing' stamp: 'StephaneDucasse 2/23/2012 14:22'!
beginsWithEmpty: prefix caseSensitive: aBoolean 
	"Answer whether the receiver begins with the given prefix string. 
	The comparison is case-sensitive." 
	| matchTable |
	prefix isEmpty ifTrue: [ ^ true ].
	self size < prefix size ifTrue: [ ^ false ].
	matchTable := aBoolean 
		ifTrue: [ CaseSensitiveOrder ]
		ifFalse: [ CaseInsensitiveOrder ].
	^ (self 
		findSubstring: prefix
		in: self
		startingAt: 1
		matchTable: matchTable) = 1! !

!String methodsFor: 'accessing' stamp: 'EstebanLorenzano 8/17/2012 16:41'!
findTokens: delimiters includes: subString
	"Divide self into pieces using delimiters.  Return the piece that includes subString anywhere in it.  Is case sensitive (say asLowercase to everything beforehand to make insensitive)."

^ (self findTokens: delimiters) 
	detect: [:str | (str includesSubstring: subString)] 
	ifNone: [nil]! !

!String methodsFor: 'converting' stamp: 'yo 11/3/2004 19:24'!
translateToLowercase
	"Translate all characters to lowercase, in place"

	self translateWith: LowercasingTable! !

!String methodsFor: 'converting' stamp: 'damiencassou 5/30/2008 11:45'!
asUnsignedInteger
	"Returns the first integer it can find or nil."
	| start stream |
	start := self findFirst: [ :char | char isDigit ].
	start isZero ifTrue: [ ^ nil ].
	stream := self readStream position: start - 1.
	^ Integer readFrom: stream! !

!String methodsFor: '*Morphic-Base' stamp: 'CamilloBruni 10/21/2012 23:37'!
asDraggableMorph

	^ self asStringMorph! !

!String methodsFor: 'testing' stamp: 'HenrikSperreJohansen 6/15/2010 17:36'!
hasWideCharacterFrom: start to: stop
	"Return true if one of my character in the range does not fit in a single byte"
	
	"Implementation note: inline #anySatisfy: here for efficiency reasons"
	^(self indexOfWideCharacterFrom: start to: stop) ~= 0! !

!String methodsFor: '*System-Support' stamp: 'CamilloBruni 5/8/2013 12:03'!
asClassIfPresent: presentBlock
	"returns a global class with my name"
	^ presentBlock cull: (self asClassIfAbsent: [ ^ nil ])! !

!String methodsFor: 'comparing' stamp: 'lr 7/7/2006 11:21'!
> aString 
	"Answer whether the receiver sorts after aString.
	The collation order is simple ascii (with case differences)."

	^ (self compare: self with: aString collated: AsciiOrder) = 3! !

!String methodsFor: '*Zinc-Character-Encoding-Core' stamp: 'SvenVanCaekenberghe 9/15/2014 13:35'!
asZnCharacterEncoder
	"Return a ZnCharacterEncoder instance using the receiver as identifier"
	
	" 'UTF-8' asZnCharacterEncoder "
	
	^ ZnCharacterEncoder newForEncoding: self! !

!String methodsFor: 'copying' stamp: 'yo 11/3/2004 19:24'!
deepCopy
	"DeepCopy would otherwise mean make a copy of the character;  since 
	characters are unique, just return a shallowCopy."

	^self shallowCopy! !

!String methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setAuthorInMetacelloVersion: aMetacelloVersionSpec

	aMetacelloVersionSpec setAuthor: 
		(aMetacelloVersionSpec project valueHolderSpec
			value: self;
			yourself)! !

!String methodsFor: '*Network-MIME' stamp: 'yo 11/3/2004 19:24'!
decodeQuotedPrintable
	"Assume receiver is in MIME 'quoted-printable' encoding, and decode it."
  
	^QuotedPrintableMimeConverter mimeDecode: self as: self class! !

!String methodsFor: 'formatting' stamp: 'md 5/26/2005 13:34'!
expandMacrosWith: anObject with: anotherObject with: thirdObject with: fourthObject 
	^self expandMacrosWithArguments: (Array 
				with: anObject
				with: anotherObject
				with: thirdObject
				with: fourthObject)! !

!String methodsFor: '*NativeBoost-Core' stamp: 'IgorStasenko 12/20/2011 14:53'!
asNBExternalType: gen
	"a string or symbol in argument description array defines a type i.e.
	
	#( long argument )  - whereas 'long'  is type name
	"
	^ gen resolveType: self! !

!String methodsFor: 'copying' stamp: 'CamilloBruni 5/25/2012 18:14'!
padLeftTo: length
	^ self padLeftTo: length with: Character space! !

!String methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setTimestampInMetacelloConfig: aMetacelloConfig

	aMetacelloConfig setTimestampWithString: self! !

!String methodsFor: '*Zinc-Character-Encoding-Core' stamp: 'SvenVanCaekenberghe 9/15/2014 11:48'!
urlEncoded
	"URL Encode the receiver and return the resulting String.
	This is an encoding where characters that are illegal in a URL are escaped."

    ^ ZnPercentEncoder new encode: self
! !

!String methodsFor: '*Text-Scanning' stamp: 'tpr 10/1/2013 17:44'!
encodedCharSetAt: index
	"return the character encoding in place at index; the actual EncodedCharSet, not just a number. A bad index is an Error"
	^EncodedCharSet charsetAt: (self at: index) leadingChar! !

!String methodsFor: 'converting' stamp: 'MarcusDenker 5/18/2013 15:44'!
parseLiterals
	^ self class compiler parseLiterals: self! !

!String methodsFor: '*Deprecated40' stamp: 'DamienPollet 9/26/2014 16:55'!
padded: leftOrRight to: length with: char
	self deprecated: 'Use #pad' , leftOrRight capitalized , 'To:with: instead'.

	leftOrRight = #left ifTrue:
		[^ (String new: (length - self size max: 0) withAll: char) , self].
	leftOrRight = #right ifTrue:
		[^ self , (String new: (length - self size max: 0) withAll: char)].! !

!String methodsFor: 'accessing' stamp: 'nice 11/16/2009 13:23'!
lineCount
	"Answer the number of lines represented by the receiver, where every line delimiter CR, LF or CRLF pair adds one line."

	| lineCount |
	lineCount := 0.
	self lineIndicesDo: [:start :endWithoutDelimiters :end |
		lineCount := lineCount + 1].
	^lineCount! !

!String methodsFor: '*Morphic-Base-Pluggable Widgets' stamp: 'BenjaminVanRyseghem 2/12/2012 15:17'!
beginsWith: aString fromList: aMorph

	^ self trimBoth asLowercase beginsWith: aString! !

!String methodsFor: 'system primitives' stamp: 'nice 11/1/2011 22:56'!
numArgs 
	"Answer either the number of arguments that the receiver would take if considered a selector.  Answer -1 if it couldn't be a selector. It is intended mostly for the assistance of spelling correction."

	| firstChar numColons start ix |
	self size = 0 ifTrue: [^ -1].
	firstChar := self at: 1.
	(firstChar isLetter or: [ firstChar = $_]) ifTrue:
		["Fast reject if any chars are non-alphanumeric
		NOTE: fast only for Byte things - Broken for Wide"
		self class isBytes
			ifTrue: [(self findSubstring: '~' in: self startingAt: 1 matchTable: Tokenish) > 0 ifTrue: [^ -1]]
			ifFalse: [2 to: self size do: [:i | (self at: i) tokenish ifFalse: [^ -1]]].
		"Fast colon count"
		numColons := 0.  start := 1.
		[(ix := self indexOf: $: startingAt: start) > 0]
			whileTrue:
				[(ix = start or: [(self at: start) isDigit]) ifTrue: [^-1].
				numColons := numColons + 1.
				start := ix + 1].
		numColons = 0 ifTrue: [^ 0].
		self last = $:
			ifTrue: [^ numColons]
			ifFalse: [^ -1]].
	"Test case of binary selector, if self allSatisfy: #isSpecial (inlined for speed)"
	1 to: self size do: [:i | (self at: i) isSpecial ifFalse: [^ -1]].
	^1! !

!String methodsFor: '*Morphic-Base-Widgets' stamp: 'BenjaminVanRyseghem 7/25/2012 11:43'!
heightToDisplayInList: aList

	^ aList font height! !

!String methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
mergeIntoMetacelloRepositories: aMetacelloRepositoriesSpec

	| spec |
	spec := 
		(aMetacelloRepositoriesSpec project repositorySpec)
			description: self;
			yourself.
	aMetacelloRepositoriesSpec addMember: 
		(aMetacelloRepositoriesSpec mergeMember 
			name: spec name;
			spec: spec;
			yourself)
! !

!String methodsFor: 'system primitives' stamp: 'ul 9/14/2009 02:59'!
findSubstring: key in: body startingAt: start matchTable: matchTable
	"Answer the index in the string body at which the substring key first occurs, at or beyond start.  The match is determined using matchTable, which can be used to effect, eg, case-insensitive matches.  If no match is found, zero will be returned."
	| index c1 c2 |
	matchTable == nil ifTrue: [
		key size = 0 ifTrue: [^ 0].
		start to: body size - key size + 1 do:
			[:startIndex |
			index := 1.
				[(body at: startIndex+index-1)
					= (key at: index)]
					whileTrue:
					[index = key size ifTrue: [^ startIndex].
					index := index+1]].
		^ 0
	].

	key size = 0 ifTrue: [^ 0].
	start to: body size - key size + 1 do:
		[:startIndex |
		index := 1.
		[c1 := body at: startIndex+index-1.
		c2 := key at: index.
		((c1 leadingChar = 0 and: [ c1 asciiValue < matchTable size ]) 
			ifTrue: [ matchTable at: c1 asciiValue + 1 ]
			ifFalse: [ c1 asciiValue + 1 ]) = 
			((c2 leadingChar = 0 and: [ c2 asciiValue < matchTable size ])
				ifTrue: [ matchTable at: c2 asciiValue + 1 ]
				ifFalse: [c2 asciiValue + 1 ]) ]
			whileTrue:
				[index = key size ifTrue: [^ startIndex].
				index := index+1]].
	^ 0! !

!String methodsFor: 'formatting' stamp: 'yo 11/3/2004 19:24'!
withCRs
	"Return a copy of the receiver in which backslash (\) characters have been replaced with carriage returns."

	^ self collect: [ :c | c = $\ ifTrue: [ Character cr ] ifFalse: [ c ]].! !

!String methodsFor: '*regex-core' stamp: 'vb 4/11/09 21:56'!
regex: rxString matchesCollect: aBlock

	^rxString asRegex matchesIn: self collect: aBlock! !

!String methodsFor: 'comparing' stamp: 'yo 8/27/2002 14:15'!
charactersExactlyMatching: aString
	"Do a character-by-character comparison between the receiver and aString.  Return the index of the final character that matched exactly."

	| count |
	count := self size min: aString size.
	1 to: count do: [:i | 
		(self at: i) = (aString at: i) ifFalse: [
			^ i - 1]].
	^ count! !

!String methodsFor: 'comparing' stamp: 'lr 7/7/2006 11:19'!
< aString 
	"Answer whether the receiver sorts before aString.
	The collation order is simple ascii (with case differences)."

	^ (self compare: self with: aString collated: AsciiOrder) = 1! !

!String methodsFor: 'copying' stamp: 'CamilloBruni 5/25/2012 18:14'!
padRightTo: length
	^ self padRightTo: length with: Character space! !

!String methodsFor: '*Text-Core' stamp: 'yo 11/3/2004 19:24'!
asText
	"Answer a Text whose string is the receiver."

	^Text fromString: self! !

!String methodsFor: '*Text-Core' stamp: 'JuanVuletich 10/13/2010 09:26'!
encompassLine: anInterval
	"Return an interval that includes anInterval, and that comprises one or several whole paragraphs in the receiver.
	Answer starts at the position following a cr (or eventually 1) and ends before a cr (or eventually at self size)
	See also encompassParagraph:"
	| left right |
	left := (self lastIndexOf: Character cr startingAt: anInterval first - 1 ifAbsent:[0]) + 1.
	right := (self indexOf: Character cr startingAt: (anInterval last max: anInterval first) ifAbsent: [self size+1])-1.
	^left to: right! !

!String methodsFor: '*metacello-core' stamp: 'dkh 6/21/2012 18:06'!
asMetacelloSemanticVersionNumber
    ^ MetacelloSemanticVersionNumber fromString: self! !

!String methodsFor: 'formatting' stamp: 'md 5/26/2005 13:34'!
expandMacros
	^self expandMacrosWithArguments: #()! !

!String methodsFor: 'copying' stamp: 'CamilloBruni 5/25/2012 18:14'!
padLeftTo: length with: char
	^ (String new: (length - self size max: 0) withAll: char) , self.! !

!String methodsFor: 'accessing' stamp: 'nice 11/16/2009 12:26'!
linesDo: aBlock
	"Execute aBlock with each line in this string. The terminating line delimiters CR, LF or CRLF pairs are not included in what is passed to aBlock"

	self lineIndicesDo: [:start :endWithoutDelimiters :end |
		aBlock value: (self copyFrom: start to: endWithoutDelimiters)]! !

!String methodsFor: 'comparing' stamp: 'CamilloBruni 9/5/2011 17:49'!
endsWith: suffix
	"Answer whether the tail end of the receiver is the same as suffix.
	The comparison is case-sensitive.
 
	'Elvis' endsWith: 'vis'
	"
	
	| extra |
	(extra := self size - suffix size) < 0 
		ifTrue: [^ false].
	^ (self findString: suffix startingAt: extra + 1) > 0! !

!String methodsFor: 'printing' stamp: 'CamilloBruni 9/5/2011 17:17'!
encodeDoublingQuoteOn: aStream 
	"Print inside string quotes, doubling inbedded quotes."
	| x |
	aStream print: $'.
	1 to: self size do: [:i |
		aStream print: (x := self at: i).
		x = $' ifTrue: [aStream print: x]].
	aStream print: $'! !

!String methodsFor: 'testing' stamp: 'CamilloBruni 9/5/2011 17:21'!
lastSpacePosition
	"Answer the character position of the final space or other separator character in the receiver, and 0 if none

	'fred the bear' lastSpacePosition
	'ziggie' lastSpacePosition
	'elvis ' lastSpacePosition
	'wimpy  ' lastSpacePosition
	'' lastSpacePosition
	"
	self size to: 1 by: -1 do:
		[:i | ((self at: i) isSeparator) ifTrue: [^ i]].
	^ 0
! !

!String methodsFor: '*Deprecated40' stamp: 'DamienPollet 9/26/2014 16:38'!
splitInteger
	"Answer an array that is a splitting of self into a string and an integer.
	'43Sam' ==> #(43 'Sam').  'Try90' ==> #('Try' 90)
	BUT NOTE: 'Sam' ==> #('Sam' 0), and '90' ==> #('' 90)  ie, (<string> <integer>)."

	| pos |
	
	self deprecated: 'No users'.
	
	(pos := self findFirst: [:d | d isDigit not]) = 0 
		ifTrue: [ ^ Array with: '' with: self asNumber ].
		
	self first isDigit ifTrue: [
		^ Array with: (self copyFrom: 1 to: pos - 1) asNumber 
				with: (self copyFrom: pos to: self size)].
			
	(pos := self findFirst: [:d | d isDigit]) = 0 
		ifTrue: [ ^ Array with: self with: 0 ].
		
	^ Array with: (self copyFrom: 1 to: pos - 1)
			with: (self copyFrom: pos to: self size) asNumber! !

!String methodsFor: '*Network-MIME' stamp: 'SvenVanCaekenberghe 10/22/2013 12:35'!
asMIMEType
	^ self asZnMimeType! !

!String methodsFor: 'converting' stamp: 'CamilloBruni 9/5/2011 16:20'!
surroundedBy: aString
	^ self class streamContents: [ :s|
		s nextPutAll: aString.
		s nextPutAll: self.
		s nextPutAll: aString ].! !

!String methodsFor: 'comparing' stamp: 'lr 7/7/2006 11:21'!
>= aString 
	"Answer whether the receiver sorts after or equal to aString.
	The collation order is simple ascii (with case differences)."

	^ (self compare: self with: aString collated: AsciiOrder) >= 2! !

!String methodsFor: 'copying' stamp: 'AdrienBarreau 6/17/2010 10:17'!
trimRight: aBlock
	"Trim characters satisfying the condition given in aBlock from the right side of the receiving string."

	^ self trimLeft: [ :char | false ] right: aBlock! !

!String methodsFor: '*network-url' stamp: 'SvenVanCaekenberghe 10/25/2013 14:21'!
asUrl
	^ self asZnUrl! !

!String methodsFor: '*Polymorph-Widgets' stamp: 'BenjaminVanRyseghem 6/24/2012 23:28'!
heightToDisplayInTree: aTree

	^ aTree fontToUse height! !

!String methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 1/17/2013 10:27'!
withoutLeadingDigits
	"Answer the portion of the receiver that follows any leading series of digits and separators.
	If the receiver consists entirely of digits and separators, return an empty string"

	^ self trimLeft: [ :char | char isDigit or: [ char isSeparator ] ]! !

!String methodsFor: '*metacello-core-version comparison' stamp: 'dkh 6/5/2012 19:01:24'!
metacelloVersionComponentLessThan: aMetacelloVersonComponent

	^aMetacelloVersonComponent metacelloStringLessThanSelf: self! !

!String methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setTimestampInMetacelloVersion: aMetacelloVersionSpec

	aMetacelloVersionSpec setTimestamp: 
		(aMetacelloVersionSpec project valueHolderSpec
			value: self;
			yourself)! !

!String methodsFor: 'converting' stamp: 'CamilloBruni 9/5/2011 16:15'!
initialIntegerOrNil
	"Answer the integer represented by the leading digits of the receiver, or nil if the receiver does not begin with a digit"
	"
	'234Whoopie' initialIntegerOrNil
	'wimpy' initialIntegerOrNil
	'234' initialIntegerOrNil
	'2N' initialIntegerOrNil
	'2' initialIntegerOrNil
	'  89Ten ' initialIntegerOrNil
	'78 92' initialIntegerOrNil
	"

	| firstNonDigit |
	(self size = 0 or: [ self first isDigit not ]) 
		ifTrue: [ ^ nil ].
	firstNonDigit := (self findFirst: [ :m | m isDigit not ]).
	firstNonDigit = 0 ifTrue: [ firstNonDigit := self size + 1 ].
	^ (self copyFrom: 1  to: (firstNonDigit - 1)) asNumber! !

!String methodsFor: 'accessing' stamp: 'yo 11/3/2004 19:24'!
skipDelimiters: delimiters startingAt: start 
	"Answer the index of the character within the receiver, starting at start, that does NOT match one of the delimiters. If the receiver does not contain any of the delimiters, answer size + 1.  Assumes the delimiters to be a non-empty string."

	start to: self size do: [:i |
		delimiters detect: [:delim | delim = (self at: i)]
				ifNone: [^ i]].
	^ self size + 1! !

!String methodsFor: '*Text-Core' stamp: 'JuanVuletich 10/12/2010 12:52'!
encompassParagraph: anInterval
	"Return an interval that includes anInterval, and that comprises one or several whole paragraphs in the receiver.
	Answer starts at the position following a cr (or eventually 1) and ends at a cr (or eventually at self size).
	See also #encompassLine:"
	| left right |
	left := (self lastIndexOf: Character cr startingAt: anInterval first - 1 ifAbsent:[0]) + 1.
	right := (self indexOf: Character cr startingAt: (anInterval last max: anInterval first) ifAbsent: [self size]).
	^left to: right! !

!String methodsFor: 'private' stamp: 'yo 8/26/2002 22:53'!
replaceFrom: start to: stop with: replacement startingAt: repStart 
	"Primitive. This destructively replaces elements from start to stop in the receiver starting at index, repStart, in the collection, replacement. Answer the receiver. Range checks are performed in the primitive only. Optional. See Object documentation whatIsAPrimitive."
	<primitive: 105>
	super replaceFrom: start to: stop with: replacement startingAt: repStart! !

!String methodsFor: '*Multilingual-TextConversion' stamp: 'KR 1/30/2006 21:49'!
convertToEncoding: encodingName
	^self convertToWithConverter: (TextConverter newForEncoding: encodingName).! !

!String methodsFor: 'testing' stamp: 'PatrickBarroca 6/7/2010 02:06'!
isAllAlphaNumerics
	"whether the receiver is composed entirely of alphanumerics"
	self do: [:c | c isAlphaNumeric ifFalse: [^ false]].
	^ true! !

!String methodsFor: 'converting' stamp: 'yo 11/3/2004 19:24'!
capitalized
	"Return a copy with the first letter capitalized"
	| cap |
	self isEmpty ifTrue: [ ^self copy ].
	cap := self copy.
	cap at: 1 put: (cap at: 1) asUppercase.
	^ cap! !

!String methodsFor: 'converting' stamp: 'CamilloBruni 9/5/2011 17:53'!
asByteArray
	"Convert to a ByteArray with the ascii values of the string."
	| b |
	b := ByteArray new: self byteSize.
	1 to: self size * 4 do: [:i |
		b at: i put: (self byteAt: i)].
	^ b.
! !

!String methodsFor: 'testing' stamp: 'ar 4/10/2005 16:23'!
isByteString
	"Answer whether the receiver is a ByteString"
	^false! !

!String methodsFor: 'testing' stamp: 'DamienPollet 3/25/2015 16:13'!
isAsciiString

	^ self allSatisfy: [ :each | each asciiValue <= 127 ]
! !

!String methodsFor: 'accessing' stamp: 'StephaneDucasse 2/27/2010 16:20'!
findAnySubStr: delimiters startingAt: start 
	"Answer the index of the character within the receiver, starting at start, that begins a substring matching one of the delimiters.  delimiters is an Array of Strings (Characters are permitted also).  If the receiver does not contain any of the delimiters, answer size + 1."

	^delimiters inject: 1 + self size into: [:min :delim |
		"delim may be a char, a string of length 1, or a substring"
		| ind |
		ind := delim isCharacter 
			ifTrue: [self indexOf: delim
						startingAt: start ifAbsent: [min]]
			ifFalse: [self indexOfSubCollection: delim 
						startingAt: start ifAbsent: [min]].
		min min: ind]! !

!String methodsFor: '*metacello-core-version comparison' stamp: 'dkh 6/21/2012 20:43'!
metacelloSemanticVersionComponentLessThan: aMetacelloVersonComponent
    ^ aMetacelloVersonComponent metacelloSemanticStringLessThanSelf: self! !

!String methodsFor: 'converting' stamp: 'ClementBera 7/26/2013 16:58'!
correctAgainst: wordList continuedFrom: oldCollection
	"Like correctAgainst:.  Use when you want to correct against several lists, give nil as the first oldCollection, and nil as the last wordList."

	^ wordList 
		ifNil: [ self correctAgainstEnumerator: nil
					continuedFrom: oldCollection ]
		ifNotNil: [ self correctAgainstEnumerator: [ :action | wordList do: action without: nil]
					continuedFrom: oldCollection ]! !

!String methodsFor: 'accessing' stamp: 'md 5/26/2005 13:35'!
string
	^self! !

!String methodsFor: '*filesystem-core-converting' stamp: 'cwp 11/21/2009 11:30'!
asPathWith: anObject 
	^ anObject pathFromString: self! !

!String methodsFor: '*Zinc-Character-Encoding-Core' stamp: 'SvenVanCaekenberghe 9/15/2014 13:35'!
encodeWith: encoding
	"Produce a ByteArray that encodes the receiver, using a specified encoding.
	Encoding is either a ZnCharacterEncoder instance or an identifier for one."
	
	" 'Les élèves français' encodeWith: #utf8 "
	
	^ encoding asZnCharacterEncoder encodeString: self! !

!String methodsFor: 'accessing' stamp: 'StephaneDucasse 2/23/2012 14:15'!
indexOfFirstUppercaseCharacter
	"Returns the index of the first Uppercase character.
	'uouFauhZ ' indexOfFirstUppercaseCharacter2 -> 4
	New implementation much faster than older one.
	"
	| size |
	size := self size.
	1 to: size do: [:i| 
		(self at: i) isUppercase 
			ifTrue: [^ i ]].
	^ 0! !

!String methodsFor: 'converting' stamp: 'laza 10/1/2004 09:55'!
asInteger 
	^self asSignedInteger
! !

!String methodsFor: '*Deprecated40' stamp: 'StephaneDucasse 9/14/2014 18:11'!
withFirstCharacterDownshifted
	
	self deprecated: 'use #uncapitalized' on: '18 September 2014'  in: 'Pharo4'.
 	^ self uncapitalized ! !

!String methodsFor: 'accessing' stamp: 'ClementBera 7/26/2013 17:00'!
findTokens: delimiters escapedBy: quoteDelimiters 
	"Answer a collection of Strings separated by the delimiters, where  
	delimiters is a Character or collection of characters. Two delimiters in a  
	row produce an empty string (compare this to #findTokens, which  
	treats sequential delimiters as one).  
	 
	The characters in quoteDelimiters are treated as quote characters, such  
	that any delimiter within a pair of matching quoteDelimiter characters  
	is treated literally, rather than as a delimiter.  
	 
	The quoteDelimiter characters may be escaped within a quoted string.  
	Two sequential quote characters within a quoted string are treated as  
	a single character.  
	 
	This method is useful for parsing comma separated variable strings for  
	spreadsheet import and export."
	| tokens rs activeEscapeCharacter ts char token delimiterChars quoteChars |
	delimiterChars := (delimiters 
		ifNil: [ '' ]
		ifNotNil: [ delimiters ]) asString.
	quoteChars := (quoteDelimiters 
		ifNil: [ '' ]
		ifNotNil: [ quoteDelimiters ]) asString.
	tokens := OrderedCollection new.
	rs := self readStream.
	activeEscapeCharacter := nil.
	ts := String new writeStream.
	[ rs atEnd ] whileFalse: 
		[ char := rs next.
		activeEscapeCharacter 
			ifNil: 
				[ (quoteChars includes: char) 
					ifTrue: [ activeEscapeCharacter := char ]
					ifFalse: 
						[ (delimiterChars includes: char) 
							ifTrue: 
								[ token := ts contents.
								tokens add: token.
								ts := String new writeStream ]
							ifFalse: [ ts nextPut: char ] ] ]
			ifNotNil: 
				[ char == activeEscapeCharacter 
					ifTrue: 
						[ rs peek == activeEscapeCharacter 
							ifTrue: [ ts nextPut: rs next ]
							ifFalse: [ activeEscapeCharacter := nil ] ]
					ifFalse: [ ts nextPut: char ] ] ].
	token := ts contents.
	(tokens isEmpty and: [ token isEmpty ]) ifFalse: [ tokens add: token ].
	^ tokens! !

!String methodsFor: 'printing' stamp: 'sd 7/8/2006 18:06'!
printOn: aStream 
	"Print inside string quotes, doubling inbedded quotes."
 
	self storeOn: aStream! !

!String methodsFor: 'accessing' stamp: 'yo 12/17/2002 16:56'!
leadingCharRunLengthAt: index

	| leadingChar |
	leadingChar := (self at: index) leadingChar.
	index to: self size do: [:i |
		(self at: i) leadingChar ~= leadingChar ifTrue: [^ i - index].
	].
	^ self size - index + 1.
! !

!String methodsFor: '*monticellofiletree-core' stamp: 'dkh 4/6/2012 15:56:14'!
writeCypressJsonOn: aStream forHtml: forHtml indent: startIndent
    "by default ignore <forHtml> ... <forHtml> is used for Dictionary and Array, i.e., container objects and String which actually encodes itself differently for HTML"

    aStream
        nextPutAll: '"';
        nextPutAll:
                (forHtml
                        ifTrue: [ self cypressEscape ]
                        ifFalse: [ self ]);
        nextPutAll: '"'! !

!String methodsFor: 'converting' stamp: 'DamienPollet 8/1/2014 15:22'!
asUncommentedCode
	"this string reprensent a commented code, let's uncomment it"
	
	^String streamContents:  [ :str |
		
		|doubleQuoteAlreadyFound|
		doubleQuoteAlreadyFound := false.
		
		self withoutQuoting do: [ :char |
			char = $"
				ifTrue: [ 
					doubleQuoteAlreadyFound 	ifTrue: [ 
							str nextPut: $" ].
					doubleQuoteAlreadyFound := doubleQuoteAlreadyFound not.
				]
				ifFalse: [ 
					str nextPut: char
				]
		 ]
	]

! !

!String methodsFor: 'platform conventions' stamp: 'ul 11/22/2010 13:20'!
withInternetLineEndings
	"change line endings from CR's and LF's to CRLF's.  This is probably in prepration for sending a string over the Internet"
	
	^self withLineEndings: String crlf! !

!String methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
packageFileSpecFor: aMetacelloPackagesSpec

	^(aMetacelloPackagesSpec project packageSpec)
			file: self;
			yourself
! !

!String methodsFor: 'accessing' stamp: 'BernardoContreras 3/19/2015 19:38'!
allRangesOfSubstring: aSubstring

	^ Array streamContents: [:s | | start subSize |
		start := 1.
		subSize := aSubstring size.
		[start isZero]
			whileFalse: [ start := self findString: aSubstring startingAt: start.
				start > 0 
					ifTrue: [s nextPut: (start to: start + subSize - 1).
						start := start + subSize]]]! !

!String methodsFor: 'testing' stamp: 'yo 11/3/2004 19:24'!
isAllSeparators
	"whether the receiver is composed entirely of separators"
	self do: [ :c | c isSeparator ifFalse: [ ^false ] ].
	^true! !

!String methodsFor: 'printing' stamp: 'yo 8/26/2002 22:58'!
storeOn: aStream 
	"Print inside string quotes, doubling inbedded quotes."
	| x |
	aStream nextPut: $'.
	1 to: self size do:
		[:i |
		aStream nextPut: (x := self at: i).
		x = $' ifTrue: [aStream nextPut: x]].
	aStream nextPut: $'! !

!String methodsFor: '*Morphic-Base-Widgets' stamp: 'BenjaminVanRyseghem 2/12/2012 00:21'!
widthToDisplayInList: aList

	^ aList font widthOfStringOrText: self contents! !

!String methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setDescriptionInMetacelloConfig: aMetacelloConfig

	aMetacelloConfig setDescriptionWithString: self! !

!String methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 4/9/2015 23:03'!
gtInspectorTextIn: composite
	<gtInspectorPresentationOrder: -10>  
	 composite rubricText
		title: 'String';
		display: [ self truncateWithElipsisTo: 10000 ]! !

!String methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setPackage: aString withInMetacelloConfig: aMetacelloConfig

	aMetacelloConfig setPackage: aString withString: self! !

!String methodsFor: 'accessing' stamp: 'yo 11/3/2004 19:24'!
findString: subString
	"Answer the index of subString within the receiver, starting at start. If 
	the receiver does not contain subString, answer 0."
	^self findString: subString startingAt: 1.! !

!String methodsFor: 'testing' stamp: 'CamilloBruni 9/5/2011 17:20'!
indexOfWideCharacterFrom: start to: end
	"Return the index of the first wide character following anIndex"
	"Implementation note: inline #anySatisfy: here for efficiency reasons"
	
	start to: end do: [:ix | 
		(self basicAt: ix) > 255 ifTrue: [ ^ix ]].
	^ 0! !

!String methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
recordRequiredForMetacelloMCVersion: aMetacelloMCVersion

	^aMetacelloMCVersion doRecordRequiredFromArray: (Array with: self).! !

!String methodsFor: '*filesystem-core-converting' stamp: 'StephaneDucasse 2/9/2011 13:41'!
asResolvedBy: aFileSystem
	^ aFileSystem resolveString: self! !

!String methodsFor: '*zinc-resource-meta-core' stamp: 'SvenVanCaekenberghe 3/16/2013 20:23'!
addedToZnUrl: url
	| segments |
	segments := self findTokens: '/'.
	^ url withPathSegments: segments! !

!String methodsFor: 'copying' stamp: 'yo 11/3/2004 19:24'!
copyReplaceTokens: oldSubstring with: newSubstring 
	"Replace all occurrences of oldSubstring that are surrounded
	by non-alphanumeric characters"
	^ self copyReplaceAll: oldSubstring with: newSubstring asTokens: true
	"'File asFile Files File''s File' copyReplaceTokens: 'File' with: 'Snick'"! !

!String methodsFor: 'comparing' stamp: 'MarcusDenker 5/27/2014 17:28'!
= aString 
	"Answer whether the receiver sorts equally as aString.
	The collation order is simple ascii (with case differences)."
	
	(aString isString and: [self size = aString size]) ifFalse: [^false].
	^ (self compare: self with: aString collated: AsciiOrder) = 2! !

!String methodsFor: '*monticellofiletree-core' stamp: 'SvenVanCaekenberghe 10/27/2013 12:18'!
cypressUnescape
    ^ self urlDecoded! !

!String methodsFor: '*Slot' stamp: 'BenjaminVanRyseghem 11/24/2010 14:41'!
isLegalInstVarName
	"Answer whether aString is a legal instance variable name."

	^ ((self isLiteralSymbol) and: [(self includes: $:) not]) and:
		[(self inviolateInstanceVariableNames includes:  self) not]! !

!String methodsFor: 'converting' stamp: 'DamienPollet 8/1/2014 15:21'!
asComment
	"return this string, munged so that it can be treated as a comment in Smalltalk code.  Quote marks are added to the beginning and end of the string, and whenever a solitary quote mark appears within the string, it is doubled"

	^String streamContents:  [ :str |
		| quoteCount first |

		str nextPut: $".
	
		quoteCount := 0.
		first := true.
		self do: [ :char |
			char = $"
				ifTrue: [
					first ifFalse: [
						str nextPut: char.
						quoteCount := quoteCount + 1 ] ]
				ifFalse: [
					quoteCount odd ifTrue: [
						"add a quote to even the number of quotes in a row"
						str nextPut: $" ].
					quoteCount := 0.
					str nextPut: char ].
			first := false ]. 

		quoteCount odd ifTrue: [
			"check at the end"
			str nextPut: $". ].

		str nextPut: $".
	].
	! !

!String methodsFor: 'accessing' stamp: 'CamilloBruni 8/1/2012 16:04'!
endsWithDigit
	"Answer whether the receiver's final character represents a digit."

	^ self size > 0 and: [self last isDigit]! !

!String methodsFor: '*Multilingual-TextConversion' stamp: 'CamilloBruni 9/7/2011 16:18'!
convertFromWithConverter: converter

	| readStream c |
	readStream := self readStream.
	^ self class new: self size streamContents: [ :writeStream|
		converter ifNil: [^ self].
		[readStream atEnd] whileFalse: [
			c := converter nextFromStream: readStream.
			c
				ifNotNil: [writeStream nextPut: c] 
				ifNil: [^ writeStream contents]]].
! !

!String methodsFor: '*Morphic-Base' stamp: 'ClementBera 9/30/2013 10:48'!
indentationIfBlank: aBlock 
	"Answer the number of leading tabs in the receiver.  If there are
	 no visible characters, pass the number of tabs to aBlock and return its value."
	| reader leadingTabs lastSeparator cr tab ch |
	cr := Character cr.
	tab := Character tab.
	reader := self readStream.
	leadingTabs := 0.
	[ reader atEnd not and: [ (ch := reader next) = tab ] ] whileTrue: [ leadingTabs := leadingTabs + 1 ].
	lastSeparator := leadingTabs + 1.
	[ reader atEnd not and: [ ch isSeparator and: [ ch ~= cr ] ] ] whileTrue: 
		[ lastSeparator := lastSeparator + 1.
		ch := reader next ].
	(lastSeparator = self size or: [ ch = cr ]) ifTrue: [ ^ aBlock value: leadingTabs ].
	^ leadingTabs! !

!String methodsFor: '*System-Support' stamp: 'CamilloBruni 5/8/2013 11:24'!
asClassIfAbsent: absentBlock
	"returns a global class with my name"
	^ self asClassInEnvironment: Smalltalk globals ifAbsent: absentBlock! !

!String methodsFor: '*Network-MIME' stamp: 'MarcusDenker 7/22/2014 13:19'!
decodeMimeHeader
	"See RFC 2047, MIME Part Three: Message Header Extension for Non-ASCII  
	Text. Text containing non-ASCII characters is encoded by the sequence  
	=?character-set?encoding?encoded-text?=  
	Encoding is Q (quoted printable) or B (Base64), handled by  
	Base64MimeConverter / RFC2047MimeConverter.

	Thanks to Yokokawa-san, it works in m17n package.  Try the following:

	'=?ISO-2022-JP?B?U1dJS0lQT1AvGyRCPUJDKyVpJXMlQRsoQi8=?= =?ISO-2022-JP?B?GyRCJVElRiUjJSobKEIoUGF0aW8p?=' decodeMimeHeader.
"
	| input |
	input := self readStream.
	^String streamContents: [ :output | | temp |
		[ output nextPutAll: (input upTo: $=).
		"ASCII Text"
		input atEnd ] whileFalse: 
		[ (temp := input next) = $? 
			ifTrue: 
				[ | pos charset mimeEncoding mimeDecoder charsetStream  |
				charset := input upTo: $?.
				(charset isNil or: [ charset isEmpty ]) ifTrue: [ charset := 'LATIN-1' ].
				mimeEncoding := (input upTo: $?) asUppercase.
				temp := input upTo: $?.
				"Skip final ="
				input next.
				pos := input position.
				input skipSeparators.
				"Delete spaces if followed by ="
				input peek = $= ifFalse: [ input position: pos ]. 
					
				charsetStream :=  String new writeStream.
				mimeDecoder := mimeEncoding = 'B' 
					ifTrue: [ Base64MimeConverter new ]
					ifFalse: [ RFC2047MimeConverter new ].
				mimeDecoder
					mimeStream: temp readStream;
					dataStream: charsetStream;
					mimeDecode.
				output nextPutAll: (charsetStream contents convertFromEncoding: charset).
				]
			ifFalse: 
				[ output
					nextPut: $=;
					nextPut: temp ] ] ]! !

!String methodsFor: 'comparing' stamp: 'lr 7/7/2006 11:20'!
<= aString 
	"Answer whether the receiver sorts before or equal to aString.
	The collation order is simple ascii (with case differences)."
	
	^ (self compare: self with: aString collated: AsciiOrder) <= 2! !

!String methodsFor: '*Collections-arithmetic' stamp: 'yo 11/3/2004 19:24'!
* arg

	^ arg adaptToString: self andSend: #*! !

!String methodsFor: '*Slot' stamp: 'MartinDias 6/24/2013 15:15'!
isLegalClassName
	"Answer whether aString is a legal  class name."

	^ [Smalltalk classBuilder validateClassName: self asSymbol] on: Error do: [^ false] ! !

!String methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setLoadsInMetacelloProject: aMetacelloPackageSpec

	aMetacelloPackageSpec setLoads: { self }.! !

!String methodsFor: '*regex-core' stamp: 'vb 4/11/09 21:56'!
prefixMatchesRegexIgnoringCase: regexString
	"Test if the receiver's prefix matches a regex.	
	May raise RxParser class>>regexErrorSignal or child signals.
	This is a part of the Regular Expression Matcher package, (c) 1996, 1999 Vassili Bykov.
	Refer to `documentation' protocol of RxParser class for details."

	^regexString asRegexIgnoringCase matchesPrefix: self! !

!String methodsFor: 'converting' stamp: 'CamilloBruni 8/1/2012 16:17'!
stemAndNumericSuffix
	"Parse the receiver into a string-valued stem and a numeric-valued suffix."
	"'Fred2305' stemAndNumericSuffix"

	| stem suffix position |

	stem := self.
	suffix := 0.
	position := 1.
	[stem endsWithDigit and: [stem size > 1]] whileTrue:
		[suffix :=  stem last digitValue * position + suffix.
		position := position * 10.
		stem := stem copyFrom: 1 to: stem size - 1].
	^ Array with: stem with: suffix
! !

!String methodsFor: '*Graphics-Display Objects' stamp: 'yo 11/3/2004 19:24'!
displayOn: aDisplayMedium at: aPoint 
	"Show a representation of the receiver as a DisplayText at location aPoint on aDisplayMedium, using black-colored text."

	self displayOn: aDisplayMedium at: aPoint textColor: Color black! !

!String methodsFor: '*monticellofiletree-core' stamp: 'SvenVanCaekenberghe 10/27/2013 11:46'!
cypressEscape
    ^ self urlEncoded! !

!String methodsFor: 'comparing' stamp: 'jeanbaptistearnaud 6/11/2014 17:16'!
findSubstringViaPrimitive: key in: body startingAt: start matchTable: matchTable
	"Answer the index in the string body at which the substring key first occurs, at or beyond start.  The match is determined using matchTable, which can be used to effect, eg, case-insensitive matches.  If no match is found, zero will be returned.

	The algorithm below is not optimum -- it is intended to be translated to C which will go so fast that it wont matter."
	| index |
	<primitive: 'primitiveFindSubstring' module: 'MiscPrimitivePlugin'>
	<var: #key declareC: 'unsigned char *key'>
	<var: #body  declareC: 'unsigned char *body'>
	<var: #matchTable declareC: 'unsigned char *matchTable'>
	
	key size = 0 ifTrue: [^ 0].
	start to: body size - key size + 1 do:
		[:startIndex |
		index := 1.
			[(matchTable at: (body at: startIndex+index-1) asciiValue + 1)
				= (matchTable at: (key at: index) asciiValue + 1)]
				whileTrue:
				[index = key size ifTrue: [^ startIndex].
				index := index+1]].
	^ 0
"
' ' findSubstring: 'abc' in: 'abcdefabcd' startingAt: 1 matchTable: CaseSensitiveOrder 1
' ' findSubstring: 'abc' in: 'abcdefabcd' startingAt: 2 matchTable: CaseSensitiveOrder 7
' ' findSubstring: 'abc' in: 'abcdefabcd' startingAt: 8 matchTable: CaseSensitiveOrder 0
' ' findSubstring: 'abc' in: 'abcdefABcd' startingAt: 2 matchTable: CaseSensitiveOrder 0
' ' findSubstring: 'abc' in: 'abcdefABcd' startingAt: 2 matchTable: CaseInsensitiveOrder 7
"! !

!String methodsFor: '*regex-core' stamp: 'vb 4/11/09 21:56'!
matchesRegex: regexString
	"Test if the receiver matches a regex.  May raise RxParser>>regexErrorSignal or
	child signals.
	This is a part of the Regular Expression Matcher package, (c) 1996, 1999 Vassili Bykov.
	Refer to `documentation' protocol of RxParser class for details."

	^regexString asRegex matches: self! !

!String methodsFor: 'comparing' stamp: 'ul 1/15/2011 13:54'!
startingAt: keyStart match: text startingAt: textStart
	"Answer whether text matches the pattern in this string.
	Matching ignores upper/lower case differences.
	Where this string contains #, text may contain any character.
	Where this string contains *, text may contain any sequence of characters."
	
	| anyMatch matchStart matchEnd i matchStr j ii jj |
	i := keyStart.
	j := textStart.
	
	"Process consecutive *s and #s at the beginning."
	anyMatch := false.
	[ i <= self size and: [
		(self at: i)
			caseOf: {
				[ $* ] -> [ 
					anyMatch := true.
					i := i + 1.
					true ].
				[ $# ] -> [
					i := i + 1.
					j := j + 1.
					true ] }
			otherwise: [ false ] ] ] whileTrue.
	i > self size ifTrue: [
		^j - 1 = text size or: [ "We reached the end by matching the character with a #."
			anyMatch and: [ j <= text size ] "Or there was a * before the end." ] ].
	matchStart := i.

	"Now determine the match string"
	matchEnd := self size.
	(ii := self indexOf: $* startingAt: matchStart) > 0 ifTrue: [ matchEnd := ii-1 ].
	(ii := self indexOf: $# startingAt: matchStart) > 0 ifTrue: [ matchEnd := matchEnd min: ii-1 ].
	matchStr := self copyFrom: matchStart to: matchEnd.

	"Now look for the match string"
	[jj := text findString: matchStr startingAt: j caseSensitive: false.
	anyMatch ifTrue: [jj > 0] ifFalse: [jj = j]]
		whileTrue:
		["Found matchStr at jj.  See if the rest matches..."
		(self startingAt: matchEnd+1 match: text startingAt: jj + matchStr size) ifTrue:
			[^ true "the rest matches -- success"].
		"The rest did not match."
		anyMatch ifFalse: [^ false].
		"Preceded by * -- try for a later match"
		j := j+1].
	^ false "Failed to find the match string"! !

!String methodsFor: 'testing' stamp: 'yo 11/3/2004 19:24'!
isString
	^ true! !

!String methodsFor: 'accessing' stamp: 'yo 8/28/2002 14:28'!
skipAnySubStr: delimiters startingAt: start 
	"Answer the index of the last character within the receiver, starting at start, that does NOT match one of the delimiters. delimiters is a Array of substrings (Characters also allowed).  If the receiver is all delimiters, answer size + 1."

	| any this ind ii |
	ii := start-1.
	[(ii := ii + 1) <= self size] whileTrue: [ "look for char that does not match"
		any := false.
		delimiters do: [:delim |
			delim isCharacter 
				ifTrue: [(self at: ii) == delim ifTrue: [any := true]]
				ifFalse: ["a substring"
					delim size > (self size - ii + 1) ifFalse: "Here's where the one-off error was."
						[ind := 0.
						this := true.
						delim do: [:dd | 
							dd == (self at: ii+ind) ifFalse: [this := false].
							ind := ind + 1].
						this ifTrue: [ii := ii + delim size - 1.  any := true]]
							ifTrue: [any := false] "if the delim is too big, it can't match"]].
		any ifFalse: [^ ii]].
	^ self size + 1! !

!String methodsFor: 'accessing' stamp: 'yo 11/3/2004 19:24'!
findCloseParenthesisFor: startIndex
	"assume (self at: startIndex) is $(.  Find the matching $), allowing parentheses to nest."
	" '(1+(2-3))-3.14159' findCloseParenthesisFor: 1 "
	" '(1+(2-3))-3.14159' findCloseParenthesisFor: 4 "
	| pos nestLevel |
	pos := startIndex+1.
	nestLevel := 1.
	[ pos <= self size ] whileTrue: [
		(self at: pos) = $( ifTrue: [ nestLevel := nestLevel + 1 ].
		(self at: pos) = $) ifTrue: [ nestLevel := nestLevel - 1 ].
		nestLevel = 0 ifTrue: [ ^pos ].
		pos := pos + 1.
	].
	^self size + 1! !

!String methodsFor: '*Network-MIME' stamp: 'StephaneDucasse 9/1/2009 15:50'!
base64Encoded
	"Encode the receiver as base64"
	"'Hello World' base64Encoded"
	^(Base64MimeConverter mimeEncode: self readStream) contents! !

!String methodsFor: '*regex-core' stamp: 'vb 4/11/09 21:56'!
matchesRegexIgnoringCase: regexString
	"Test if the receiver matches a regex.  May raise RxParser>>regexErrorSignal or
	child signals.
	This is a part of the Regular Expression Matcher package, (c) 1996, 1999 Vassili Bykov.
	Refer to `documentation' protocol of RxParser class for details."

	^regexString asRegexIgnoringCase matches: self! !

!String methodsFor: 'testing' stamp: 'ar 4/10/2005 23:25'!
isOctetString
	"Answer whether the receiver can be represented as a byte string. 
	This is different from asking whether the receiver *is* a ByteString 
	(i.e., #isByteString)"
	1 to: self size do: [:pos |
		(self at: pos) asInteger >= 256 ifTrue: [^ false].
	].
	^ true.
! !

!String methodsFor: 'comparing' stamp: 'CamilloBruni 9/5/2011 17:46'!
compare: string1 with: string2 collated: order
	"
	self assert: 'abc' = 'abc' asWideString.
	self assert: 'abc' asWideString = 'abc'.
	self assert: ((ByteArray with: 97 with: 0 with: 0 with: 0) asString ~= 'a000' asWideString).
	self assert: ('a000' asWideString ~= (ByteArray with: 97 with: 0 with: 0 with: 0) asString).

	self assert: ('abc' sameAs: 'aBc' asWideString).
	self assert: ('aBc' asWideString sameAs: 'abc').
	self assert: ((ByteArray with: 97 with: 0 with: 0 with: 0) asString sameAs: 'Abcd' asWideString) not.
	self assert: ('a000' asWideString sameAs: (ByteArray with: 97 with: 0 with: 0 with: 0) asString) not.

	"
	(string1 isByteString and: [string2 isByteString]) ifTrue: [
		^ ByteString compare: string1 with: string2 collated: order].
     "Primitive does not fail properly right now"
	^ String compare: string1 with: string2 collated: order! !

!String methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 1/17/2013 09:41'!
withoutTrailingNewlines
	"Return a copy of the receiver with any combination of cr/lf characters at the end removed"

	^ self trimRight: [ :char | char = Character cr or: [ char = Character lf ] ]! !

!String methodsFor: 'converting' stamp: 'ClementBera 7/26/2013 16:58'!
correctAgainstDictionary: wordDict continuedFrom: oldCollection
	"Like correctAgainst:continuedFrom:.  Use when you want to correct against a dictionary."

	^ wordDict 
		ifNil: [ self correctAgainstEnumerator: nil
					continuedFrom: oldCollection ]
		ifNotNil: [ self correctAgainstEnumerator: [ :action | wordDict keysDo: action ]
					continuedFrom: oldCollection ]! !

!String methodsFor: 'converting' stamp: 'yo 11/3/2004 19:24'!
asString
	"Answer this string."

	^ self
! !

!String methodsFor: 'accessing' stamp: 'ar 4/12/2005 16:30'!
byteAt: index
	^self subclassResponsibility! !

!String methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setDescriptionInMetacelloVersion: aMetacelloVersionSpec

	aMetacelloVersionSpec setDescription: 
		(aMetacelloVersionSpec project valueHolderSpec
			value: self;
			yourself)! !

!String methodsFor: '*Polymorph-Widgets' stamp: 'BenjaminVanRyseghem 6/24/2012 23:11'!
treeRenderOn: aCanvas bounds: drawBounds color: drawColor font: aFont from: aMorph

	aCanvas
		drawString: self
		in: drawBounds 
		font: aMorph font
		color: drawColor! !

!String methodsFor: '*System-Support' stamp: 'CamilloBruni 5/8/2013 11:13'!
asClass
	"returns a global class with my name"
	^ self asClassInEnvironment: Smalltalk globals! !

!String methodsFor: '*Graphics-Display Objects' stamp: 'yo 11/3/2004 19:24'!
displayAt: aPoint 
	"Display the receiver as a DisplayText at aPoint on the display screen."

	self displayOn: Display at: aPoint! !

!String methodsFor: '*Network-UUID' stamp: 'PeterHugossonMiller 9/3/2009 11:26'!
asAlphaNumeric: totalSize extraChars: additionallyAllowed mergeUID: minimalSizeOfRandomPart 
	"Generates a String with unique identifier ( UID ) qualities, the difference to a
	 UUID is that its beginning is derived from the receiver, so that it has a meaning
	 for a human reader.

	 Answers a String of totalSize, which consists of 3 parts
	 1.part: the beginning of the receiver only consisting of
		a-z, A-Z, 0-9 and extraChars in Collection additionallyAllowed ( which can be nil )
	 2.part: a single _
	 3.part: a ( random ) UID of size >= minimalSizeOfRandomPart consisting of
		a-z, A-Z, 0-9

	 Starting letters are capitalized. 
	 TotalSize must be at least 1.
	 Exactly 1 occurrence of $_ is guaranteed ( unless additionallyAllowed includes $_ ).
	 The random part has even for small sizes good UID qualitites for many practical purposes.
	 If only lower- or uppercase letters are demanded, simply convert the answer with
	 say #asLowercase. The probability of a duplicate will rise only moderately ( see below ).

	 Example: 
		size of random part = 10
		in n generated UIDs the chance p of having non-unique UIDs is
			n = 10000 ->  p < 1e-10		if answer is reduced to lowerCase: p < 1.4 e-8
			n = 100000 -> p < 1e-8
		at the bottom is a snippet for your own calculations  
		Note: the calculated propabilites are theoretical,
			for the actually used random generator they may be much worse"
	| stream out sizeOfFirstPart index ascii ch skip array random |
	totalSize > minimalSizeOfRandomPart ifFalse: [ self errorOutOfBounds ].
	stream := self readStream.
	out :=  (String new: totalSize) writeStream.
	index := 0.
	skip := true.
	sizeOfFirstPart := totalSize - minimalSizeOfRandomPart - 1.
	[ stream atEnd or: [ index >= sizeOfFirstPart ] ] whileFalse: 
		[ (((ascii := (ch := stream next) asciiValue) >= 65 and: [ ascii <= 90 ]) or: 
			[ (ascii >= 97 and: [ ascii <= 122 ]) or: 
				[ ch isDigit or: [ additionallyAllowed notNil and: [ additionallyAllowed includes: ch ] ] ] ]) 
			ifTrue: 
				[ skip 
					ifTrue: [ out nextPut: ch asUppercase ]
					ifFalse: [ out nextPut: ch ].
				index := index + 1.
				skip := false ]
			ifFalse: [ skip := true ] ].
	out nextPut: $_.
	array := Array new: 62.
	1 
		to: 26
		do: 
			[ :i | 
			array 
				at: i
				put: (i + 64) asCharacter.
			array 
				at: i + 26
				put: (i + 96) asCharacter ].
	53 
		to: 62
		do: 
			[ :i | 
			array 
				at: i
				put: (i - 5) asCharacter ].
	random := UUIDGenerator default randomGenerator.
	totalSize - index - 1 timesRepeat: [ out nextPut: (array atRandom: random) ].
	^ out contents

	"	calculation of probability p for failure of uniqueness in n UIDs
		Note: if answer will be converted to upper or lower case replace 62 with 36
	| n i p all |
	all := 62 raisedTo: sizeOfRandomPart.
	i := 1.
	p := 0.0 .
	n := 10000.
	[ i <= n ]
	whileTrue: [
		p := p + (( i - 1 ) / all ).
		i := i + 1 ].
	p   

	approximation formula: n squared / ( 62.0 raisedTo: sizeOfRandomPart ) / 2 
	"

	"'Crop SketchMorphs and Grab Screen Rect to JPG' 
			asAlphaNumeric: 31 extraChars: nil mergeUID: 10  
	 			'CropSketchMorphsAndG_iOw94jquN6'
	 'Monticello' 
			asAlphaNumeric: 31 extraChars: nil mergeUID: 10    
				'Monticello_kp6aV2l0IZK9uBULGOeG' 
	 'version-', ( '1.1.2' replaceAll: $. with: $- )
			asAlphaNumeric: 31 extraChars: #( $- ) mergeUID: 10    
				'Version-1-1-2_kuz2tMg2xX9iRLDVR'"! !

!String methodsFor: 'copying' stamp: 'CamilloBruni 9/5/2011 17:15'!
trimLeft: aLeftBlock right: aRightBlock
	"Trim characters satisfying the condition given in aLeftBlock from the left side and aRightBlock from the right sides of the receiving string."

	| left right |
	left := 1.
	right := self size.
	
	[ left <= right and: [ aLeftBlock value: (self at: left) ] ]
		whileTrue: [ left := left + 1 ].
		
	[ left <= right and: [ aRightBlock value: (self at: right) ] ]
		whileTrue: [ right := right - 1 ].
		
	^ self copyFrom: left to: right! !

!String methodsFor: '*RPackage-SystemIntegration' stamp: 'TudorGirba 2/17/2015 09:01'!
asPackageIfAbsent: aBlock
	^ RPackageOrganizer default packageNamed: self ifAbsent: aBlock! !

!String methodsFor: 'converting' stamp: 'ar 4/10/2005 19:24'!
asSymbol
	"Answer the unique Symbol whose characters are the characters of the 
	string."
	^Symbol intern: self! !

!String methodsFor: '*TxText-Model' stamp: 'IgorStasenko 2/12/2014 14:01'!
asTxModel
	^ TxModel fromString: self! !

!String methodsFor: '*System-Localization' stamp: 'HilaireFernandes 5/14/2010 17:50'!
translated
"answer the receiver translated to the default language"
	^ NaturalLanguageTranslator translate: self
! !

!String methodsFor: 'converting' stamp: 'CamilloBruni 9/23/2012 23:18'!
asHTMLString
	"substitute the < & > into HTML compliant elements"
	"'<a>' asHTMLString"
	^ self class new: self size streamContents: [ :s| 
		self do: [:c | s nextPutAll: c asHTMLString ]]
! !

!String methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
removeFromMetacelloRepositories: aMetacelloRepositoriesSpec

	aMetacelloRepositoriesSpec addMember: 
		(aMetacelloRepositoriesSpec removeMember 
			name: self;
			yourself)! !

!String methodsFor: 'converting' stamp: 'marcus.denker 2/18/2009 16:15'!
asSignedInteger 
	"Returns the first signed integer it can find or nil."

	| start stream |
	start := self findFirst: [:char | char isDigit].
	start isZero ifTrue: [^ nil].
	stream := self readStream position: start - 1.
	((stream position ~= 0) and: [stream peekBack = $-])
		ifTrue: [stream back].
	^ Integer readFrom: stream! !

!String methodsFor: '*Multilingual-TextConversion' stamp: 'CamilloBruni 9/7/2011 16:36'!
convertToWithConverter: converter 
	converter
		ifNil: [^ self].
	^ String new: self size streamContents: [:writeStream | 
		converter 
			nextPutAll: self toStream: writeStream;
			emitSequenceToResetStateIfNeededOn: writeStream]! !

!String methodsFor: 'platform conventions' stamp: 'ul 11/23/2010 08:19'!
withSqueakLineEndings
	"Assume the string is textual, and that CR, LF, and CRLF are all valid line endings.
	Replace each occurence with a single CR."

	(self includes: Character lf) ifFalse: [ ^self ].
	(self includes: Character cr) ifFalse: [
		^self translateWith: String crLfExchangeTable ].
	^self withLineEndings: String cr! !

!String methodsFor: 'copying' stamp: 'CamilloBruni 9/7/2011 16:59'!
trim
	^ self trimBoth! !

!String methodsFor: '*metacello-core-version comparison' stamp: 'dkh 6/21/2012 20:43'!
metacelloSemanticStringLessThanSelf: aString
    ^ aString < self! !

!String methodsFor: '*regex-core' stamp: 'vb 4/11/09 21:56'!
asRegexIgnoringCase
	"Compile the receiver as a regex matcher. May raise RxParser>>syntaxErrorSignal
	or RxParser>>compilationErrorSignal.
	This is a part of the Regular Expression Matcher package, (c) 1996, 1999 Vassili Bykov.
	Refer to `documentation' protocol of RxParser class for details."

	^RxParser preferredMatcherClass
		for: (RxParser new parse: self)
		ignoreCase: true! !

!String methodsFor: 'accessing' stamp: 'yo 8/28/2002 16:45'!
indexOf: aCharacter

	aCharacter isCharacter ifFalse: [^ 0].
	^ self class
		indexOfAscii: aCharacter asciiValue
		inString: self
		startingAt: 1.
! !

!String methodsFor: '*metacello-mc' stamp: 'dkh 6/8/2012 14:04:22'!
fetchRequiredForMetacelloMCVersion: aMetacelloMCVersion

	^aMetacelloMCVersion doFetchRequiredFromArray: (Array with: self).! !

!String methodsFor: '*NautilusCommon' stamp: 'vincentBlondeau 12/12/2014 14:16'!
transformSelectorForComparison
	^ String
		streamContents: [ :stream | 
			self
				doWithIndex: [ :c :i | 
					(c isUppercase and: [ i > 1 ])
						ifTrue: [ stream << $: ].
					stream << c ] ]! !

!String methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
addToMetacelloPackages: aMetacelloPackagesSpec

	| spec |
	spec := 
		(aMetacelloPackagesSpec project packageSpec)
			file: self;
			yourself.
	aMetacelloPackagesSpec addMember: 
		(aMetacelloPackagesSpec addMember 
			name: spec name;
			spec: spec;
			yourself)! !

!String methodsFor: '*Graphics-Display Objects' stamp: 'CamilloBruni 8/1/2012 16:03'!
displayOn: aDisplayMedium
	"Display the receiver on the given DisplayMedium."

	self displayOn: aDisplayMedium at: 0 @ 0! !

!String methodsFor: 'comparing' stamp: 'CamilloBruni 9/5/2011 17:51'!
howManyMatch: string 
	"Count the number of characters that match up in self and aString."
	| count shorterLength |
	
	count := 0.
	shorterLength := self size min: string size.
	1 to: shorterLength do: [:index |
		(self at: index) = (string at: index )
			ifTrue: [ count := count + 1 ]].
	^  count 
	
	! !

!String methodsFor: 'accessing' stamp: 'EstebanLorenzano 8/17/2012 16:40'!
includesSubstring: subString
	^ (self findString: subString startingAt: 1) > 0! !

!String methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setPostLoadDoItInMetacelloSpec: aMetacelloSpec
    self asSymbol setPostLoadDoItInMetacelloSpec: aMetacelloSpec! !

!String methodsFor: 'converting' stamp: 'PeterHugossonMiller 9/3/2009 11:29'!
substrings
	"Answer an array of the substrings that compose the receiver."
	| result end beginning |

	result := (Array new: 10) writeStream.



	end := 0.
	"find one substring each time through this loop"
	[ 
		"find the beginning of the next substring"
		beginning := self indexOfAnyOf: CSNonSeparators startingAt: end+1 ifAbsent: [ nil ].
		beginning ~~ nil ] 
	whileTrue: [
		"find the end"
		end := self indexOfAnyOf: CSSeparators startingAt: beginning ifAbsent: [ self size + 1 ].
		end := end - 1.

		result nextPut: (self copyFrom: beginning to: end).

	].


	^result contents! !

!String methodsFor: 'accessing' stamp: 'nice 7/27/2007 22:58'!
indexOfSubCollection: sub startingAt: start ifAbsent: exceptionBlock
	| index |
	index := self findString: sub startingAt: start.
	index = 0 ifTrue: [^ exceptionBlock value].
	^ index! !

!String methodsFor: 'converting' stamp: 'yo 11/3/2004 19:24'!
asStringOrText
	"Answer this string."

	^ self
! !

!String methodsFor: 'converting' stamp: 'CamilloBruni 9/5/2011 16:16'!
numericSuffix
	"
	'abc98' numericSuffix
	'98abc' numericSuffix
	"
	^ self stemAndNumericSuffix last! !

!String methodsFor: '*compression' stamp: 'dgd 11/26/2005 21:19'!
zipped
	| stream gzstream |

	stream := RWBinaryOrTextStream on: String new.

	gzstream := GZipWriteStream on: stream.
	gzstream nextPutAll: self.
	gzstream close.
	stream reset.

	^ stream contents.
! !

!String methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/24/2010 14:31'!
typeTable
	^ self class typeTable! !

!String methodsFor: 'converting' stamp: 'yo 8/28/2002 15:13'!
translateWith: table
	"translate the characters in the string by the given table, in place"
	^ self translateFrom: 1 to: self size table: table! !

!String methodsFor: 'accessing' stamp: 'nice 7/27/2007 23:33'!
findString: key startingAt: start caseSensitive: caseSensitive 
	"Answer the index in this String at which the substring key first occurs,
	at or beyond start. The match can be case-sensitive or not. If no match
	is found, zero will be returned."
	
	"IMPLEMENTATION NOTE: do not use CaseSensitiveOrder because it is broken for WideString
	This is a temporary work around until Wide CaseSensitiveOrder search is fixed
	Code should revert to:
	caseSensitive
		ifTrue: [^ self findSubstring: key in: self startingAt: start matchTable: CaseSensitiveOrder]
		ifFalse: [^ self findSubstring: key in: self startingAt: start matchTable: CaseInsensitiveOrder]"
		
	^caseSensitive
		ifTrue: [
			(self class isBytes and: [key class isBytes])
				ifTrue: [self
						findSubstring: key
						in: self
						startingAt: start
						matchTable: CaseSensitiveOrder]
				ifFalse: [WideString new
						findSubstring: key
						in: self
						startingAt: start
						matchTable: nil]]
		ifFalse: [
			(self class isBytes and: [key class isBytes])
				ifTrue: [self
						findSubstring: key
						in: self
						startingAt: start
						matchTable: CaseInsensitiveOrder]
				ifFalse: [WideString new
						findSubstring: key
						in: self
						startingAt: start
						matchTable: CaseInsensitiveOrder]]! !

!String methodsFor: 'converting' stamp: 'CamilloBruni 8/1/2012 16:18'!
truncateTo: smallSize
	"return myself or a copy shortened to smallSize."

	^ self size <= smallSize
		ifTrue:
			[self]
		ifFalse:
			[self copyFrom: 1 to: smallSize]! !

!String methodsFor: 'converting' stamp: 'yo 11/3/2004 19:24'!
asLowercase
	"Answer a String made up from the receiver whose characters are all 
	lowercase."

	^ self copy asString translateToLowercase! !

!String methodsFor: '*AST-Core-Parser' stamp: 'yo 11/3/2004 19:24'!
asNumber 
	"Answer the Number created by interpreting the receiver as the string 
	representation of a number."

	^Number readFromString: self! !

!String methodsFor: 'converting' stamp: 'yo 11/3/2004 19:24'!
asTime
	"Many allowed forms, see Time>>readFrom:"

	^ Time fromString: self.! !

!String methodsFor: 'comparing' stamp: 'md 5/11/2008 12:08'!
hash
	"#hash is implemented, because #= is implemented"
	"ar 4/10/2005: I had to change this to use ByteString hash as initial 
	hash in order to avoid having to rehash everything and yet compute
	the same hash for ByteString and WideString."
	^ self class stringHash: self initialHash: ByteString hash! !

!String methodsFor: '*files' stamp: 'CamilloBruni 9/7/2013 11:28'!
asVmPathName
	^ FilePathEncoder encode: self! !

!String methodsFor: 'converting' stamp: 'CamilloBruni 9/5/2011 17:53'!
asFourCode

	| result |
	self size = 4 
		ifFalse: [^self error: 'must be exactly four characters'].
		
	result := self inject: 0 into: [:val :each | 256 * val + each asciiValue ].
	(result bitAnd: 16r80000000) = 0 
		ifFalse: [ Error signal: 'cannot resolve fourcode' ].
		
	(result bitAnd: 16r40000000) = 0 
		ifFalse: [ ^ result - 16r80000000 ].
	^ result
! !

!String methodsFor: 'accessing' stamp: 'ar 4/12/2005 16:30'!
byteAt: index put: value
	^self subclassResponsibility! !

!String methodsFor: '*UIManager-Support' stamp: 'MartinDias 12/19/2012 17:53'!
displayProgressAt: aPoint from: minVal to: maxVal during: workBlock 
	"Deprecated!! - Display this string as a caption over a progress bar while workBlock is evaluated.

EXAMPLE (Select next 6 lines and Do It)
'Now here''s some Real Progress'
	displayProgressAt: Sensor cursorPoint
	from: 0 to: 10
	during: [:bar |
	1 to: 10 do: [:x | bar value: x.
			(Delay forMilliseconds: 500) wait]].

HOW IT WORKS (Try this in any other language :-)
Since your code (the last 2 lines in the above example) is in a block,
this method gets control to display its heading before, and clean up 
the screen after, its execution.
The key, though, is that the block is supplied with an argument,
named 'bar' in the example, which will update the bar image every 
it is sent the message value: x, where x is in the from:to: range.
"
	"deprecated use displayProgressFrom: minVal to: maxVal during: workBlock "

	^UIManager default 
		displayProgress: self
		from: minVal 
		to: maxVal 
		during: workBlock! !

!String methodsFor: 'converting' stamp: 'ClementBera 9/30/2013 10:48'!
withNoLineLongerThan: aNumber
	"Answer a string with the same content as receiver, but rewrapped so that no line has more characters than the given number"
	(aNumber isNumber not or: [ aNumber < 1 ]) ifTrue: [self error: 'too narrow'].
	^self class
		new: self size * (aNumber + 1) // aNumber "provision for supplementary line breaks"
		streamContents: [ :stream |
			self lineIndicesDo: [ :start :endWithoutDelimiters :end |
				| pastEnd lineStart |
				pastEnd := endWithoutDelimiters + 1.
				"eliminate spaces at beginning of line"
				lineStart := (self indexOfAnyOf: CSNonSeparators startingAt: start ifAbsent: [pastEnd]) min: pastEnd.
				[| lineStop lineEnd spacePosition |
				lineEnd := lineStop  := lineStart + aNumber min: pastEnd..
				spacePosition := lineStart.
				[spacePosition < lineStop] whileTrue: [
					spacePosition := self indexOfAnyOf: CSSeparators startingAt: spacePosition + 1 ifAbsent: [pastEnd].
					spacePosition <= lineStop ifTrue: [lineEnd := spacePosition].
				].
				"split before space or before lineStop if no space"
				stream nextPutAll: (self copyFrom: lineStart to: lineEnd - 1).
				"eliminate spaces at beginning of next line"
				lineStart := self indexOfAnyOf: CSNonSeparators startingAt: lineEnd ifAbsent: [pastEnd].
				lineStart <= endWithoutDelimiters ]
					whileTrue: [stream cr].
				stream nextPutAll: (self copyFrom: pastEnd to: end) ] ]! !

!String methodsFor: '*filesystem-core-converting' stamp: 'SeanDeNigris 7/12/2012 08:45'!
asFileReference

	^ FileSystem disk referenceTo: self! !

!String methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 1/17/2013 10:28'!
withoutTrailingDigits
	"Answer the portion of the receiver that precedes any leading series of digits and separators.
	If the receiver consists entirely of digits and separators, return an empty string"

	^ self trimRight: [ :char | char isDigit or: [ char isSeparator ] ]! !

!String methodsFor: 'private' stamp: 'yo 8/28/2002 15:22'!
stringhash

	^ self hash.
! !

!String methodsFor: 'converting' stamp: 'nice 1/5/2010 15:59'!
keywords
	"Answer an array of the keywords that compose the receiver."
	| keywords |
	keywords := Array streamContents:
		[:kwds | | char kwd | kwd := (String new: 16) writeStream.
		1 to: self size do:
			[:i |
			kwd nextPut: (char := self at: i).
			char = $: ifTrue: 
					[kwds nextPut: kwd contents.
					kwd reset]].
		(kwd position = 0) ifFalse: [kwds nextPut: kwd contents]].
	(keywords size >= 1 and: [(keywords at: 1) = ':']) ifTrue:
		["Has an initial keyword, as in #:if:then:else:"
		keywords := keywords allButFirst].
	(keywords size >= 2 and: [(keywords at: keywords size - 1) = ':']) ifTrue:
		["Has a final keyword, as in #nextPut::andCR"
		keywords := keywords copyReplaceFrom: keywords size - 1
								to: keywords size with: {':' , keywords last}].
	^ keywords! !

!String methodsFor: 'converting' stamp: 'BenComan 9/21/2014 10:42'!
subStrings: separators 
	"This method is planned for future deprecation in favour of #substrings: (Issue 7592),
	but we do it gently, first via Critic Browser > Design Flaws > Future Deprecation Warning"
	^ self substrings: separators ! !

!String methodsFor: 'converting' stamp: 'CamilloBruni 9/5/2011 18:02'!
withoutPeriodSuffix
	"Return a copy of the receiver up to, but not including, the first period.  If the receiver's *first* character is a period, then just return the entire receiver. "

	| likely |
	likely := self copyUpTo: $..
	^ likely size = 0
		ifTrue: [ self ]
		ifFalse: [ likely ]! !

!String methodsFor: '*Graphics-Display Objects' stamp: 'FernandoOlivero 3/30/2011 14:48'!
displayOn: aDisplayMedium at: aPoint textColor: aColor
	"Show a representation of the receiver as a DisplayText at location aPoint on aDisplayMedium, rendering the text in the designated color"
	aDisplayMedium getCanvas drawString: self from: 1 to: self size at: aPoint font: nil color: aColor
! !

!String methodsFor: 'comparing' stamp: 'ar 4/10/2005 17:35'!
sameAs: aString 
	"Answer whether the receiver sorts equal to aString. The 
	collation sequence is ascii with case differences ignored."
	^(self compare: aString caseSensitive: false) = 2! !

!String methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setPreLoadDoItInMetacelloSpec: aMetacelloSpec
    self asSymbol setPreLoadDoItInMetacelloSpec: aMetacelloSpec! !

!String methodsFor: '*Collections-Abstract-splitjoin' stamp: 'CamilloBruni 9/23/2012 23:21'!
join: aCollection 
	"'*' join: #('WWWWW' 'W  EW' 'zzzz')
		->  'WWWWW*W  EW*zzzz' "
	^ self class new: (aCollection size * self size) streamContents: [:stream | 
			aCollection
				do: [:each | stream nextPutAll: each asString] 
				separatedBy: [stream nextPutAll: self]]! !

!String methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
mergeIntoMetacelloPackages: aMetacelloPackagesSpec

	| spec |
	spec := 
		(aMetacelloPackagesSpec project packageSpec)
			file: self;
			yourself.
	aMetacelloPackagesSpec addMember: 
		(aMetacelloPackagesSpec mergeMember 
			name: spec name;
			spec: spec;
			yourself)
! !

!String methodsFor: '*regex-core' stamp: 'EstebanLorenzano 8/17/2012 16:40'!
search: aString
	"compatibility method to make regexp and strings work polymorphicly"
	^ aString includesSubstring: self! !

!String methodsFor: 'testing' stamp: 'ar 4/10/2005 16:49'!
includesUnifiedCharacter
	^false! !

!String class methodsFor: 'instance creation' stamp: 'SheridanMahoney 11/17/2009 13:27'!
new: sizeRequested 
	"Answer an instance of this class with the number of indexable
	variables specified by the argument, sizeRequested."
	
	self == String 
		ifTrue:[^ByteString new: sizeRequested]
		ifFalse:[^self basicNew: sizeRequested].! !

!String class methodsFor: 'primitives' stamp: 'MarianoMartinezPeck 10/29/2011 19:49'!
findFirstInString: aString inSet: inclusionMap startingAt: start
	"Trivial, non-primitive version"
	
	| i stringSize ascii more |
	inclusionMap size ~= 256 ifTrue: [^ 0].
	stringSize := aString size.
	more := true.
	i := start - 1.
	[more and: [(i := i + 1) <= stringSize]] whileTrue: [
		ascii := (aString basicAt: i).
		more := ascii < 256 ifTrue: [(inclusionMap at: ascii + 1) = 0] ifFalse: [true].
	].

	i > stringSize ifTrue: [^ 0].
	^ i! !

!String class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 6/14/2013 13:42'!
readFrom: inStream
	"Answer an instance of me that is determined by reading the stream, 
	inStream. Embedded double quotes become the quote Character."

	| char done |
	^ self streamContents: [ :outStream | 
		"go to first quote"
		inStream skipTo: $'.
		done := false.
		[ done or: [ inStream atEnd ] ]
			whileFalse: [ 
				char := inStream next.
				char = $'
					ifTrue: [ 
						char := inStream next.
						char = $'
							ifTrue: [ outStream nextPut: char ]
							ifFalse: [ done := true ] ]
					ifFalse: [ outStream nextPut: char ] ] ]! !

!String class methodsFor: 'instance creation' stamp: 'yo 11/3/2004 19:24'!
crlf
	"Answer a string containing a carriage return and a linefeed."

	^ self with: Character cr with: Character lf
! !

!String class methodsFor: 'formatting' stamp: 'md 6/5/2005 07:49'!
expandMacro: macroType argument: argument withExpansions: expansions 
	macroType = $s ifTrue: [^expansions at: argument].
	macroType = $p ifTrue: [^(expansions at: argument) printString].
	macroType = $n ifTrue: [^String cr].
	macroType = $t ifTrue: [^String tab].
	self error: 'unknown expansion type'! !

!String class methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 11/24/2010 14:34'!
initializeTypeTable

	| newTable |
	newTable := Array new: 256 withAll: #xBinary. "default"
	newTable atAll: #(9 10 12 13 32 ) put: #xDelimiter. "tab lf ff cr space"
	newTable atAll: ($0 asciiValue to: $9 asciiValue) put: #xDigit.

	1 to: 255
		do: [:index |
			(Character value: index) isLetter
				ifTrue: [newTable at: index put: #xLetter]].

	newTable at: 30 put: #doIt.
	newTable at: $" asciiValue put: #xDoubleQuote.
	newTable at: $# asciiValue put: #xLitQuote.
	newTable at: $$ asciiValue put: #xDollar.
	newTable at: $' asciiValue put: #xSingleQuote.
	newTable at: $: asciiValue put: #xColon.
	newTable at: $( asciiValue put: #leftParenthesis.
	newTable at: $) asciiValue put: #rightParenthesis.
	newTable at: $. asciiValue put: #period.
	newTable at: $; asciiValue put: #semicolon.
	newTable at: $[ asciiValue put: #leftBracket.
	newTable at: $] asciiValue put: #rightBracket.
	newTable at: ${ asciiValue put: #leftBrace.
	newTable at: $} asciiValue put: #rightBrace.
	newTable at: $^ asciiValue put: #upArrow.
	newTable at: $_ asciiValue put: #xLetter. "by default, do not accept _ as assignement"
	newTable at: $| asciiValue put: #verticalBar.
	TypeTable := newTable "bon voyage!!"
! !

!String class methodsFor: 'primitives' stamp: 'nice 3/15/2007 20:59'!
findFirstInString: aString inCharacterSet: aCharacterSet startingAt: start 
	"Trivial, non-primitive version"
	
	start
		to: aString size
		do: [:i | (aCharacterSet
					includes: (aString at: i))
				ifTrue: [^ i]].
	^ 0! !

!String class methodsFor: 'primitives' stamp: 'MarianoMartinezPeck 10/29/2011 20:01'!
translate: aString from: start  to: stop  table: table
	"Trivial, non-primitive version"
	| char |
	start to: stop do: [:i |
		(char := aString basicAt: i) < 256 ifTrue: [
			aString at: i put: (table at: char+1)].
	].
! !

!String class methodsFor: 'initialization' stamp: 'CamilloBruni 10/20/2012 19:16'!
initialize   "self initialize"

	| order |
	
	self initializeTypeTable.
	
	AsciiOrder := (0 to: 255) as: ByteArray.

	CaseInsensitiveOrder := AsciiOrder copy.
	($a to: $z) do:
		[:c | CaseInsensitiveOrder at: c asciiValue + 1
				put: (CaseInsensitiveOrder at: c asUppercase asciiValue +1)].

	"Case-sensitive compare sorts space, digits, letters, all the rest..."
	CaseSensitiveOrder := ByteArray new: 256 withAll: 255.
	order := -1.
	' 0123456789' do:  "0..10"
		[:c | CaseSensitiveOrder at: c asciiValue + 1 put: (order := order+1)].
	($a to: $z) do:     "11-64"
		[:c | CaseSensitiveOrder at: c asUppercase asciiValue + 1 put: (order := order+1).
		CaseSensitiveOrder at: c asciiValue + 1 put: (order := order+1)].
	1 to: CaseSensitiveOrder size do:
		[:i | (CaseSensitiveOrder at: i) = 255 ifTrue:
			[CaseSensitiveOrder at: i put: (order := order+1)]].
	order = 255 ifFalse: [self error: 'order problem'].

	"a table for translating to lower case"
	LowercasingTable := String withAll: (Character allByteCharacters collect: [:c | c asLowercase]).

	"a table for translating to upper case"
	UppercasingTable := String withAll: (Character allByteCharacters collect: [:c | c asUppercase]).

	"a table for testing tokenish (for fast numArgs)"
	Tokenish := String withAll: (Character allByteCharacters 
		collect: [:c | c tokenish ifTrue: [ c ] ifFalse: [ $~ ]]).

	"CR and LF--characters that terminate a line"
	CSLineEnders := CharacterSet crlf.

 	"separators and non-separators"
	CSSeparators := CharacterSet separators.
	CSNonSeparators := CSSeparators complement.
	
	"a table for exchanging cr with lf and vica versa"
	CrLfExchangeTable := Character allByteCharacters collect: [ :each |
		each = Character cr 
			ifTrue: [ Character lf ]
			ifFalse: [ 
				each = Character lf
					ifTrue: [ Character cr ]
					ifFalse:[ each ]]]! !

!String class methodsFor: 'instance creation' stamp: 'yo 8/28/2002 13:29'!
value: anInteger

	^ self with: (Character value: anInteger).
! !

!String class methodsFor: 'instance creation' stamp: 'StephaneDucasse 2/13/2010 12:19'!
empty
	"A canonicalized empty String instance."
	^ ''! !

!String class methodsFor: 'primitives' stamp: 'MarianoMartinezPeck 10/29/2011 19:53'!
indexOfAscii: anInteger inString: aString startingAt: start	
	start to: aString size do: [ :index |
		(aString basicAt: index) = anInteger ifTrue: [ ^index ] ].
	^0

! !

!String class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/24/2010 14:39'!
typeTable
	TypeTable ifNil: [self initializeTypeTable].
	^ TypeTable! !

!String class methodsFor: '*Polymorph-Widgets-Themes' stamp: 'YuriyTymchuk 12/20/2013 11:20'!
systemIcon

	^ Smalltalk ui icons iconNamed: #stringIcon! !

!String class methodsFor: 'instance creation' stamp: 'yo 11/3/2004 19:24'!
crlfcrlf
	^self crlf , self crlf.
! !

!String class methodsFor: 'primitives' stamp: 'MarianoMartinezPeck 10/29/2011 19:48'!
compare: string1 with: string2 collated: order
	"Return 1, 2 or 3, if string1 is <, =, or > string2, with the collating order of characters given by the order array."

	| len1 len2 c1 c2 |
	order == nil ifTrue: [
		len1 := string1 size.
		len2 := string2 size.
		1 to: (len1 min: len2) do:[:i |
			c1 := (string1 basicAt: i).
			c2 := (string2 basicAt: i).
			c1 = c2 ifFalse: [c1 < c2 ifTrue: [^ 1] ifFalse: [^ 3]].
		].
		len1 = len2 ifTrue: [^ 2].
		len1 < len2 ifTrue: [^ 1] ifFalse: [^ 3].
	].
	len1 := string1 size.
	len2 := string2 size.
	1 to: (len1 min: len2) do:[:i |
		c1 := (string1 basicAt: i).
		c2 := (string2 basicAt: i).
		c1 < 256 ifTrue: [c1 := order at: c1 + 1].
		c2 < 256 ifTrue: [c2 := order at: c2 + 1].
		c1 = c2 ifFalse:[c1 < c2 ifTrue: [^ 1] ifFalse: [^ 3]].
	].
	len1 = len2 ifTrue: [^ 2].
	len1 < len2 ifTrue: [^ 1] ifFalse: [^ 3].
! !

!String class methodsFor: '*system-settings-browser' stamp: 'alain.plantec 3/18/2009 15:02'!
settingInputWidgetForNode: aSettingNode
	^ aSettingNode inputWidgetForString! !

!String class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 12/4/2014 17:10'!
loremIpsum
	"Return a constant string with one paragraph of text, the famous Lorem ipsum filler text.
	The result is pure ASCII (Latin words) and contains no newlines."
	
	^ 'Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.'! !

!String class methodsFor: 'instance creation' stamp: 'yo 11/3/2004 19:24'!
cr
	"Answer a string containing a single carriage return character."

	^ self with: Character cr
! !

!String class methodsFor: 'instance creation' stamp: 'ar 4/10/2005 16:24'!
fromByteArray: aByteArray

	^ aByteArray asString
! !

!String class methodsFor: 'instance creation' stamp: 'yo 11/3/2004 19:24'!
tab
	"Answer a string containing a single tab character."

	^ self with: Character tab
! !

!String class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 3/26/2015 00:04'!
gtInspectorFourtyTwo
	<gtExample>
	^ '42'! !

!String class methodsFor: 'instance creation' stamp: 'yo 11/3/2004 19:24'!
lf
	"Answer a string containing a single carriage return character."

	^ self with: Character lf! !

!String class methodsFor: 'instance creation' stamp: 'ar 4/12/2005 17:34'!
with: aCharacter
	| newCollection |
	aCharacter asInteger < 256
		ifTrue:[newCollection := ByteString new: 1]
		ifFalse:[newCollection := WideString new: 1].
	newCollection at: 1 put: aCharacter.
	^newCollection! !

!String class methodsFor: '*Tools' stamp: 'SeanDeNigris 5/28/2013 17:43'!
canonicalArgumentName

	^ 'aString'.! !

!String class methodsFor: '*Spec-Inspector' stamp: 'SvenVanCaekenberghe 3/14/2014 10:34'!
inspectorClass
	^ EyeStringInspector! !

!String class methodsFor: '*NativeBoost-Core' stamp: 'Igor.Stasenko 4/28/2010 16:56'!
asNBExternalType: gen

	^ gen resolveType: #NBExternalString! !

!String class methodsFor: 'instance creation' stamp: 'dc 2/12/2007 10:47'!
space
	"Answer a string containing a single space character."

	^ self with: Character space
! !

!String class methodsFor: 'primitives' stamp: 'MarianoMartinezPeck 10/29/2011 19:59'!
stringHash: aString initialHash: speciesHash
	| stringSize hash low |
	stringSize := aString size.
	hash := speciesHash bitAnd: 16rFFFFFFF.
	1 to: stringSize do: [:pos |
		hash := hash + (aString basicAt: pos).
		"Begin hashMultiply"
		low := hash bitAnd: 16383.
		hash := (16r260D * low + ((16r260D * (hash // 16384) + (16r0065 * low) bitAnd: 16383) * 16384)) bitAnd: 16r0FFFFFFF.
	].
	^ hash.
! !

!String class methodsFor: 'instance creation' stamp: 'yo 11/3/2004 19:24'!
fromString: aString 
	"Answer an instance of me that is a copy of the argument, aString."
	
	^ aString copyFrom: 1 to: aString size! !

!String class methodsFor: 'accessing' stamp: 'ul 11/23/2010 08:17'!
crLfExchangeTable

	^CrLfExchangeTable! !

!String class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 12/4/2014 23:49'!
loremIpsum: size
	"Return a mostly random multi-paragraph filler string of the specified size.
	The result is pure ASCII, uses CR for newlines and ends with a dot and newline."
	
	"self loremIpsum: 2048"
	
	| words out |
	words := (self loremIpsum findTokens: ' ,.') collect: #asLowercase.
	(out := LimitedWriteStream on: (self new: size))
		setLimit: size - 2 
		limitBlock: [ 
			^ out originalContents 
				at: size - 1 put: $.; 
				at: size put: Character cr; 
				yourself ].
	[ 
		out << self loremIpsum; cr; cr.
		5 atRandom timesRepeat: [
			15 atRandom timesRepeat: [
	 			out << words atRandom capitalized.
				20 atRandom timesRepeat: [ out space; << words atRandom ].
				out nextPut: $.; space ].
			out cr; cr ] ] repeat! !

!StringHolder commentStamp: '<historical>'!
I am a kind of Model that includes a piece of text.  In some cases, the text can be edited, and in some the text is a method.

Categories 'code pane menu' and 'message list menu' are messages that may be called by my menus when the text is a method, and when some pane is a list of methods.  Other of my subclasses may ignore these two catagories altogether.!
!StringHolder methodsFor: 'evaluation' stamp: ''!
doItContext
	"Answer the context in which a text selection can be evaluated."

	^nil! !

!StringHolder methodsFor: 'as yet unclassified' stamp: 'al 12/6/2005 22:23'!
browseClassVarRefs
	"1/17/96 sw: devolve responsibility to the class, so that the code that does the real work can be shared"

	| cls |
	cls := self selectedClass.
	(cls notNil and: [cls isTrait not])
		ifTrue: [self systemNavigation  browseClassVarRefs: cls]! !

!StringHolder methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 7/30/2014 17:10'!
selectMessageAndEvaluate: aBlock
	"Allow the user to choose one selector, chosen from the currently selected message's selector, as well as those of all messages sent by it, and evaluate aBlock on behalf of chosen selector.  If there is only one possible choice, simply make it; if there are multiple choices, put up a menu, and evaluate aBlock on behalf of the the chosen selector, doing nothing if the user declines to choose any"

	| selector method messages |
	(selector := self selectedMessageName) ifNil: [^ self].
	method := (self selectedClassOrMetaClass ifNil: [^ self])
		compiledMethodAt: selector
		ifAbsent: [].
	(method isNil or: [(messages := method messages) size = 0])
		 ifTrue: [^ aBlock value: selector].
	(messages size = 1 and: [messages includes: selector])
		ifTrue:
			[^ aBlock value: selector].  "If only one item, there is no choice"

	self
		showMenuOf: messages
		withFirstItem: selector
		ifChosenDo: [:sel | aBlock value: sel]! !

!StringHolder methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 6/27/2014 15:48'!
browseVersions
	"Create and schedule a Versions Browser, showing all versions of the 
	currently selected message. Answer the browser or nil."
	self classCommentIndicated ifTrue: [ ^nil ].

	 self selectedMessageName
		ifNil:[ self inform: 'Sorry, only actual methods have retrievable versions.'. ^nil ]
		ifNotNil: [:sel | ^Smalltalk tools versionBrowser browseVersionsForClass: self selectedClassOrMetaClass selector: sel]
			
			! !

!StringHolder methodsFor: 'as yet unclassified' stamp: 'al 12/6/2005 22:24'!
browseInstVarRefs
	"1/26/96 sw: real work moved to class, so it can be shared"
	| cls |
	cls := self selectedClassOrMetaClass.
	(cls notNil and: [cls isTrait not])
		ifTrue: [self systemNavigation browseInstVarRefs: cls]! !

!StringHolder methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 5/29/2011 15:21'!
offerMenuFrom: menuRetriever shifted: aBoolean 
	"Pop up a menu whose target is
	the receiver and whose contents are provided by sending the
	menuRetriever to the receiver. The menuRetriever takes two arguments:
	a menu, and a boolean representing the shift state."
	| aMenu |
	aMenu := UIManager default newMenuIn: self for: self.
	self
		perform: menuRetriever
		with: aMenu
		with: aBoolean.
	aMenu popUpInWorld! !

!StringHolder methodsFor: 'initialize-release' stamp: 'StephaneDucasse 2/14/2011 12:38'!
embeddedInMorphicWindowLabeled: labelString wrap: aBoolean
	| window |
	window :=  (SystemWindow labelled: labelString) model: self.
	window 
		addMorph: (self buildTextMorph wrapFlag: aBoolean)
		frame: (0@0 corner: 1@1).
	^ window! !

!StringHolder methodsFor: 'initialize-release' stamp: 'MarcusDenker 11/13/2012 15:07'!
openLabel: labelString 
	"Create a standard system view of the model, me, a StringHolder and open it.  If in mvc, terminate the active controller so that the new window will immediately be activated."
	^(self embeddedInMorphicWindowLabeled: labelString) openInWorld! !

!StringHolder methodsFor: 'as yet unclassified' stamp: 'BenjaminVanRyseghem 2/8/2012 17:09'!
browseClass
	"Open an class browser on this class and method"

	^ self selectedClassOrMetaClass 
				ifNotNil: [:class |
					Smalltalk tools browser 
						newOnClass: class 
						selector: self selectedMessageName ]! !

!StringHolder methodsFor: 'as yet unclassified' stamp: 'RAA 12/10/1999 09:36'!
packageListKey: aChar from: view
	"Respond to a Command key in the package pane in the PackageBrowser"
	aChar == $f ifTrue: [^ self findClass].
	^ self classListKey: aChar from: view
! !

!StringHolder methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 11:07'!
initialize
	"Initialize the state of the receiver with its default contents."

	super initialize.
	contents := self defaultContents.
! !

!StringHolder methodsFor: 'accessing' stamp: 'tk 4/18/1998 15:01'!
selectedClassOrMetaClass

	^ self selectedClass	"I don't know any better"! !

!StringHolder methodsFor: 'initialize-release' stamp: 'jmv 5/10/2009 09:32'!
embeddedInMorphicWindowLabeled: labelString

	^self embeddedInMorphicWindowLabeled: labelString wrap: true! !

!StringHolder methodsFor: 'initialization' stamp: ''!
defaultContents

	^''! !

!StringHolder methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 5/28/2011 13:36'!
messageListSelectorTitle
	| selector aString aStamp aSize |

	(selector := self selectedMessageName) ifNil: [
			aSize := self messageList size.
			^ (aSize = 0 ifTrue: ['no'] ifFalse: [aSize printString]), ' message', (aSize = 1 ifTrue: [''] ifFalse: ['s'])] ifNotNil: [
			aString := selector truncateWithElipsisTo: 28.
			^ (aStamp := self timeStamp) size > 0
				ifTrue: [aString, String cr, aStamp]
				ifFalse: [aString]]! !

!StringHolder methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 2/20/2010 03:16'!
timeStamp
	"Answer the time stamp for the chosen class and method, if any, else an empty string"

	|  selector  aMethod |
	(selector := self selectedMessageName) ifNotNil:
		[self selectedClassOrMetaClass 
			ifNil:
				[^ String new]
			ifNotNil:
				[aMethod := self selectedClassOrMetaClass compiledMethodAt: selector ifAbsent: [nil].
				aMethod ifNotNil: [^ aMethod timeStamp]]].
	^ String new! !

!StringHolder methodsFor: '*necompletion-extensions' stamp: ''!
receiverClass
	^nil! !

!StringHolder methodsFor: 'as yet unclassified' stamp: 'sd 1/16/2004 21:10'!
methodHierarchy
	"Create and schedule a method browser on the hierarchy of implementors."

	self systemNavigation 
			methodHierarchyBrowserForClass: self selectedClassOrMetaClass 
			selector: self selectedMessageName
! !

!StringHolder methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/29/2011 13:20'!
codeTextMorph
	^ self dependents
		detect: [:dep | (dep isKindOf: PluggableTextMorph)
				and: [dep getTextSelector == #contents]]
		ifNone: []! !

!StringHolder methodsFor: '*Shout-Styling' stamp: 'AlainPlantec 8/27/2011 01:16'!
shoutAboutToStyle: aPluggableShoutMorphOrView 
	^ false! !

!StringHolder methodsFor: 'accessing' stamp: 'tk 4/3/98 22:50'!
contentsSelection
	"Return the interval of text in the code pane to select when I set the pane's contents"

	^ 1 to: 0  "null selection"! !

!StringHolder methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 2/16/2010 16:31'!
classHierarchy
	"Create and schedule a class list browser on the receiver's hierarchy."

	self systemNavigation
		browseHierarchy: self selectedClassOrMetaClass "OK if nil"
		selector: self selectedMessageName
! !

!StringHolder methodsFor: 'as yet unclassified' stamp: 'sd 11/20/2005 21:26'!
inspectSubInstances
	"Inspect all instances of the selected class and all its subclasses"

	| aClass |
	(aClass := self selectedClassOrMetaClass) ifNotNil: [
		aClass theNonMetaClass inspectSubInstances].
! !

!StringHolder methodsFor: 'accessing' stamp: 'AlexandreBergel 1/16/2009 10:24'!
textContents: aStringOrText 
	"Set aStringOrText to be the contents of the receiver."

	contents := aStringOrText! !

!StringHolder methodsFor: 'initialize-release' stamp: 'AlainPlantec 8/26/2011 18:07'!
buildTextMorph

	^PluggableTextMorph 
			on: self 
			text: #contents 
			accept: #acceptContents:
			readSelection: nil 
			menu: #codePaneMenu:shifted:
			! !

!StringHolder methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 8/1/2012 16:01'!
browseClassVariables
	"Browse the class variables of the selected class."
	| cls |
	cls := self selectedClass.
	(cls notNil and: [cls isTrait not])
		ifTrue: [self systemNavigation  browseClassVariables: cls]
! !

!StringHolder methodsFor: 'user edits' stamp: 'di 4/21/1998 11:30'!
clearUserEditFlag
	"Clear the hasUnacceptedEdits flag in all my dependent views."

	self changed: #clearUserEdits! !

!StringHolder methodsFor: 'accessing' stamp: 'tk 4/18/1998 15:22'!
selectedMessageName

	^ nil! !

!StringHolder methodsFor: 'as yet unclassified' stamp: 'sw 7/1/2001 08:24'!
fileOutMessage
	"Put a description of the selected message on a file"

	self selectedMessageName ifNotNil:
		[Cursor write showWhile:
			[self selectedClassOrMetaClass fileOutMethod: self selectedMessageName]]! !

!StringHolder methodsFor: 'accessing' stamp: 'nk 4/29/2004 12:32'!
classCommentIndicated
	"Answer true iff we're viewing the class comment."
	^false! !

!StringHolder methodsFor: 'as yet unclassified' stamp: 'nk 11/15/2002 12:23'!
systemCatListKey: aChar from: view
	"Respond to a Command key.  I am a model with a code pane, and I also have a listView that has a list of methods.  The view knows how to get the list and selection."

	aChar == $f ifTrue: [^ self findClass].
	aChar == $x ifTrue: [^ self removeSystemCategory].
	^ self classListKey: aChar from: view! !

!StringHolder methodsFor: 'evaluation' stamp: ''!
doItReceiver
	"Answer the object that should be informed of the result of evaluating a 
	text selection."

	^nil! !

!StringHolder methodsFor: 'as yet unclassified' stamp: 'sd 11/20/2005 21:26'!
copySelector
	"Copy the selected selector to the clipboard"

	| selector |
	(selector := self selectedMessageName) ifNotNil:
		[Clipboard clipboardText: selector asString]! !

!StringHolder methodsFor: 'as yet unclassified' stamp: 'sd 4/16/2003 20:41'!
browseLocalSendersOfMessages
	"Present a menu of the currently selected message, as well as all
	messages sent by it.  Open a message set browser of all implementors
	of the message chosen in or below the selected class"

	self getSelectorAndSendQuery: #browseAllCallsOn:localTo:
		to: self systemNavigation
		with: { self selectedClass }! !

!StringHolder methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 2/16/2010 16:15'!
browseClassRefs

	| class |
	class := self selectedClass theNonMetaClass ifNil: [^self].
	class isTrait 
		ifTrue: [self systemNavigation browseAllUsersOfTrait: class]
		ifFalse: [self systemNavigation browseAllCallsOnClass: class]
! !

!StringHolder methodsFor: 'as yet unclassified' stamp: 'al 12/6/2005 22:24'!
browseInstVarDefs 

	| cls |
	cls := self selectedClassOrMetaClass.
	(cls notNil and: [cls isTrait not])
		ifTrue: [self systemNavigation browseInstVarDefs: cls]! !

!StringHolder methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 10/13/2013 07:58'!
browseSendersOfMessages
	"Present a menu of the currently selected message, as well as all messages sent by it.  Open a message set browser of all senders of the selector chosen."

	self getSelectorAndSendQuery: #browseAllSendersOf: to: self systemNavigation! !

!StringHolder methodsFor: 'as yet unclassified' stamp: 'sd 4/16/2003 08:45'!
browseMessages
	"Present a menu of all messages sent by the currently selected message. 
	Open a message set browser of all implementors of the message chosen."

	self getSelectorAndSendQuery: #browseAllImplementorsOf: to: self systemNavigation! !

!StringHolder methodsFor: 'as yet unclassified' stamp: 'sd 11/20/2005 21:26'!
copyName
	"Copy the current selector to the clipboard"
	| selector |
	(selector := self selectedMessageName) ifNotNil:
		[Clipboard clipboardText: selector asString asText]! !

!StringHolder methodsFor: 'accessing' stamp: 'sw 12/1/2000 11:04'!
reformulateList
	"If the receiver has a way of reformulating its message list, here is a chance for it to do so"! !

!StringHolder methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 7/30/2014 17:10'!
showMenuOf: selectorCollection withFirstItem: firstItem ifChosenDo: choiceBlock
	"Show a sorted menu of the given selectors, preceded by firstItem, and all
	abbreviated to 40 characters.  Evaluate choiceBlock if a message is chosen."

	| index menuLabels sortedList |
	sortedList := selectorCollection asSortedCollection.
	menuLabels := Array streamContents: 
		[:strm | strm nextPut: (firstItem contractTo: 40).
			sortedList do: [:sel | strm nextPut: (sel contractTo: 40)]].
	index := UIManager default chooseFrom: menuLabels lines: #(1).	
	index = 1 ifTrue: [choiceBlock value: firstItem].
	index > 1 ifTrue: [choiceBlock value: (sortedList at: index - 1)]! !

!StringHolder methodsFor: 'accessing' stamp: 'tk 4/18/1998 14:59'!
selectedClassName
	"I may know what class is currently selected"

	self selectedClass ifNotNil: [^ self selectedClass name].
	^ nil! !

!StringHolder methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 4/26/2011 16:13'!
browseMethodFull
	"Create and schedule a full Browser and then select the current class and message."

	| myClass |
	(myClass := self selectedClassOrMetaClass) ifNotNil:
		[Smalltalk tools browser fullOnClass: myClass selector: self selectedMessageName]! !

!StringHolder methodsFor: 'as yet unclassified' stamp: 'sd 11/20/2005 21:26'!
inspectInstances
	"Inspect all instances of the selected class."

	| myClass |
	(myClass := self selectedClassOrMetaClass) ifNotNil:
		[myClass theNonMetaClass inspectAllInstances]. 
! !

!StringHolder methodsFor: '*necompletion-extensions' stamp: 'EstebanLorenzano 4/11/2012 15:33'!
isCodeCompletionAllowed
	^true! !

!StringHolder methodsFor: '*necompletion-extensions' stamp: 'lr 3/26/2010 13:44'!
guessTypeForName: aString
	^ nil! !

!StringHolder methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 10/13/2013 07:58'!
messageListKey: aChar from: view
	"Respond to a Command key.  I am a model with a code pane, and I also
	have a listView that has a list of methods.  The view knows how to get
	the list and selection."

	| sel class |
	aChar == $D ifTrue: [^ self toggleDiffing].

	sel := self selectedMessageName.
	aChar == $m ifTrue:  "These next two put up a type in if no message selected"
		[^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllImplementorsOf: to: self systemNavigation].
	aChar == $n ifTrue: 
		[^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllSendersOf: to: self systemNavigation].

	"The following require a class selection"
	(class := self selectedClassOrMetaClass) ifNil: [^ self arrowKey: aChar from: view].
	aChar == $b ifTrue: [^ Smalltalk tools browser fullOnClass: class selector: sel].
	aChar == $N ifTrue: [^ self browseClassRefs].
	aChar == $i ifTrue: [^ self methodHierarchy].
	aChar == $h ifTrue: [^ self classHierarchy].

	"The following require a method selection"
	sel ifNotNil: 
		[aChar == $o ifTrue: [^ self fileOutMessage].
		aChar == $c ifTrue: [^ self copySelector].
		aChar == $v ifTrue: [^ self browseVersions].
		aChar == $x ifTrue: [^ self removeMessage]].

	^ self arrowKey: aChar from: view! !

!StringHolder methodsFor: 'code pane menu' stamp: 'EstebanLorenzano 1/31/2013 19:24'!
codePaneMenu: aMenu shifted: shifted 
	"Note that unless we override perform:orSendTo:, 
	PluggableTextController will respond to all menu items in a 
	text pane"
	| donorMenu |
	donorMenu := shifted
		ifTrue: [SmalltalkEditor shiftedYellowButtonMenu]
		ifFalse: [SmalltalkEditor yellowButtonMenu].
	^ aMenu addAllFrom: donorMenu! !

!StringHolder methodsFor: 'as yet unclassified' stamp: 'sw 5/8/2000 02:16'!
classListKey: aChar from: view 
	"Respond to a Command key.  I am a model with a list of classes and a 
	code pane, and I also have a listView that has a list of methods.  The 
	view knows how to get the list and selection."

	aChar == $f ifTrue: [^ self findMethod].
	aChar == $r ifTrue: [^ self recent].
	aChar == $h ifTrue: [^ self spawnHierarchy].
	aChar == $x ifTrue: [^ self removeClass].
	^ self messageListKey: aChar from: view! !

!StringHolder methodsFor: 'accessing' stamp: 'di 5/19/1998 15:34'!
acceptContents: aString 
	"Set aString to be the contents of the receiver.  Return true cuz happy"

	self contents: aString.
	^ true! !

!StringHolder methodsFor: 'as yet unclassified' stamp: 'stephane.ducasse 10/12/2008 21:02'!
browseUnusedMethods
	| classes unsent messageList cls |
	(cls := self selectedClass)
		ifNil: [^ self].
	classes := Array with: cls with: cls class.
	unsent := Set new.
	classes
		do: [:c | unsent addAll: c selectors].
	unsent := self systemNavigation allUnsentMessagesIn: unsent.
	messageList := OrderedCollection new.
	classes
		do: [:c | (c selectors
				select: [:s | unsent includes: s]) asSortedCollection
				do: [:sel | messageList add: c name , ' ' , sel]].
	self systemNavigation browseMessageList: messageList name: 'Unsent Methods in ' , cls name! !

!StringHolder methodsFor: 'initialize-release' stamp: 'jmv 5/10/2009 09:37'!
openLabel: aString wrap: aBoolean

	"Create a standard system view of the model, me, a StringHolder and open it."
	(self embeddedInMorphicWindowLabeled: aString wrap: aBoolean) openInWorld! !

!StringHolder methodsFor: 'user edits' stamp: 'tk 4/13/1998 23:07'!
okToChange

	self canDiscardEdits ifTrue: [^ true].
	self changed: #wantToChange.  "Solicit cancel from view"
	^ self canDiscardEdits
! !

!StringHolder methodsFor: 'accessing' stamp: 'AlexandreBergel 1/16/2009 10:25'!
contents: textOrString 
	"Set textOrString to be the contents of the receiver."

	contents := textOrString "asString"! !

!StringHolder methodsFor: 'accessing' stamp: ''!
contents
	"Answer the contents that the receiver is holding--presumably a string."

	^contents! !

!StringHolder class methodsFor: 'instance creation' stamp: 'MarcusDenker 10/30/2010 17:15'!
open
	^self new openLabel: 'Edit'! !

!StringHolder class methodsFor: 'instance creation' stamp: 'wiz 1/3/2007 14:23'!
openLabel: aString

	^self new openLabel: aString! !

!StringHolder class methodsFor: 'themes' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
theme
	"Answer the ui theme that provides controls."

	^ Smalltalk ui theme! !

!StringMorph commentStamp: 'efc 3/7/2003 17:34'!
StringMorph is a "lightweight" Morph to display a String. It supports only a single font, color, and emphasis combination. For multiple text styles, use TextMorph.

Structure:
instance var    	Type              Description 
font 			StrikeFont 		(normally nil; then the accessor #font gives back TextStyle 
				or nil			defaultFont) 
emphasis 		SmallInteger	bitmask determining character attributes (underline, bold, 								italics, narrow, struckout) 
contents 		String 			The text that will be displayed. 
hasFocus 		Boolean 		Do I have the keyboard focus or not? 

If you shift-click on a StringMorph you can edit its string. This is accomplished the following way: StringMorph can launch a StringMorphEditor if it receives a #mouseDown event.

A StringMorph may also be used like a SimpleButtonMorph to do an action when clicked. Use the menu 'extras' / 'add mouseUpAction'.

The following propery will be defined:
aStringMorph valueOfProperty: #mouseUpCodeToRun!
!StringMorph methodsFor: 'accessing' stamp: 'dgd 2/21/2003 23:07'!
fontToUse
	| fontToUse |
	fontToUse := font isNil ifTrue: [TextStyle defaultFont] ifFalse: [font].
	(emphasis isNil or: [emphasis = 0]) 
		ifTrue: [^fontToUse]
		ifFalse: [^fontToUse emphasized: emphasis]! !

!StringMorph methodsFor: 'initialization' stamp: 'EstebanLorenzano 4/29/2014 15:59'!
defaultColor
	"answer the default color/fill style for the receiver"
	^ self theme textColor! !

!StringMorph methodsFor: 'event handling' stamp: 'AlainPlantec 1/7/2010 22:42'!
handlesMouseDown: evt
	"If the shift key is pressed then yes.
	As normal if StringMorph class>> editableStringMorph  returns false."
	
	^ (self isEditable: evt)
		ifTrue: [true]
		ifFalse: [super handlesMouseDown: evt]! !

!StringMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 10/13/2013 21:53'!
isTranslucentButNotTransparent
	"Answer true if this any of this morph is translucent but not transparent."
	^ true! !

!StringMorph methodsFor: 'drawing' stamp: 'jmv 9/7/2009 00:36'!
imageForm: depth forRectangle: rect
	| canvas |
	canvas := Display defaultCanvasClass extent: rect extent depth: depth.
	canvas form fillColor: Color white. 
	canvas translateBy: rect topLeft negated
		during:[:tempCanvas| tempCanvas fullDrawMorph: self].
	^ canvas form offset: rect topLeft! !

!StringMorph methodsFor: 't-rotating' stamp: ''!
forwardDirection
	"Return the receiver's forward direction (in eToy terms)"
	^self valueOfProperty: #forwardDirection ifAbsent:[0.0]! !

!StringMorph methodsFor: 'printing' stamp: 'efc 2/22/2003 21:35'!
font: aFont 
	"Set the font my text will use. The emphasis remains unchanged."

	font := aFont.
	^ self font: font emphasis: emphasis! !

!StringMorph methodsFor: 'initialization' stamp: 'MarcusDenker 12/12/2009 00:02'!
initialize
	"initialize the state of the receiver"
	super initialize.

	font := nil.
	emphasis := 0.
	hasFocus := false! !

!StringMorph methodsFor: 'editing' stamp: 'sw 7/21/1999 14:59'!
wantsKeyboardFocusOnShiftClick
	^ owner topRendererOrSelf wantsKeyboardFocusFor: self
! !

!StringMorph methodsFor: 'accessing' stamp: 'tk 12/16/1998 11:55'!
userString
	"Do I have a text string to be searched on?"

	^ contents! !

!StringMorph methodsFor: 'accessing' stamp: ''!
contentsClipped: aString
	"Change my text, but do not change my size as a result"
	contents = aString ifTrue: [^ self].  "No substantive change"
	contents := aString.
	self changed! !

!StringMorph methodsFor: 'accessing' stamp: 'di 4/2/1999 16:11'!
font: aFont emphasis: emphasisCode
	font := aFont.
	emphasis := emphasisCode.
	self fitContents.
"
in inspector say,
	 self font: (TextStyle default fontAt: 2) emphasis: 1
"! !

!StringMorph methodsFor: '*FreeType-override' stamp: 'SeanDeNigris 1/23/2014 00:30'!
changeFont
	| newFont chooser |
	chooser := FontChooser 
		windowTitle: 'Choose a Font' 
		for: self 
		setSelector: #font: 
		getSelector: self fontToUse.
	self openModal: chooser.
	newFont := chooser result.
	newFont ifNotNil: [self font: newFont].! !

!StringMorph methodsFor: 'halos and balloon help' stamp: 'sw 6/15/1998 15:34'!
addOptionalHandlesTo: aHalo box: box
	self flag: #deferred.

	"Eventually...
	self addFontHandlesTo: aHalo box: box"! !

!StringMorph methodsFor: 't-rotating' stamp: ''!
rotationDegrees: degrees	
	"redefined in all morphs which are using myself"! !

!StringMorph methodsFor: 't-rotating' stamp: ''!
prepareForRotating
	"If I require a flex shell to rotate,
	then wrap it in one and return it.
	Polygons, eg, may override to do nothing."

	^ self addFlexShell! !

!StringMorph methodsFor: 'initialization' stamp: 'dgd 2/14/2003 21:57'!
initWithContents: aString font: aFont emphasis: emphasisCode 
	super initialize.
	
	font := aFont.
	emphasis := emphasisCode.
	hasFocus := false.
	self contents: aString! !

!StringMorph methodsFor: 'drawing' stamp: 'AlainPlantec 9/30/2011 16:45'!
drawOn: aCanvas
	| bnd gap |
	bnd := self bounds.
	gap := self layoutInset.
	bnd := (bnd topLeft + gap) corner: (bnd bottomRight + gap).
	aCanvas drawString: contents in: bnd font: self fontToUse color: color.! !

!StringMorph methodsFor: '*Athens-Morphic' stamp: 'IgorStasenko 10/3/2012 17:27'!
drawOnAthensCanvas: canvas
	| pt bnd gap |
"	bnd := self bounds.
	gap := self layoutInset.
"	bnd := self bounds topLeft + self layoutInset.
	 
	font := self fontToUse.
	
	canvas pathTransform restoreAfter: [
		canvas pathTransform translateBy: bnd.
		canvas pathTransform translateX: 0 Y: font getPreciseAscent.
		
		canvas 
			setPaint: color;
			setFont: self fontToUse;
			drawString: contents.
	]! !

!StringMorph methodsFor: 'font' stamp: 'efc 2/22/2003 21:35'!
emphasis: aNumber
	"Set the receiver's emphasis as indicated. aNumber is a bitmask with the following format:

	bit	attribute
	1	bold
	2	italic
	4	underlined
	8	narrow
	16	struckOut"

	"examples: 0 -> plain.  
	1 -> bold.  2 -> italic.  3 -> bold italic.  4 -> underlined  
	5 -> bold underlined.  6 -> italic underlined.   7 -> bold italic underlined   
	etc..."

	emphasis := aNumber.
	^ self font: font emphasis: emphasis! !

!StringMorph methodsFor: 'accessing' stamp: 'AlainPlantec 9/30/2011 16:46'!
measureContents
	"Round up in case fractional."
	
	| f |
	f := self fontToUse.
	^((((f widthOfString: contents) max: self minimumWidth)  @ f height) + (self layoutInset * 2)) ceiling! !

!StringMorph methodsFor: 'drawing' stamp: 'StephaneDucasse 8/27/2009 17:06'!
areasRemainingToFill: aRectangle

	^ Array with: aRectangle! !

!StringMorph methodsFor: '*Morphic-Base-MorphTreeWidget' stamp: 'AlainPlantec 9/30/2011 16:42'!
rowMorphForNode: aNode inColumn: aColumn
	| hasIcon |
	hasIcon := (aColumn container iconBlock value: aNode) notNil.
	(aColumn isFirstColumn and: [hasIcon]) 
		ifTrue: [^ super rowMorphForNode: aNode inColumn: aColumn].
	self layoutInset: aColumn container columnInset @ aColumn container rowInset.
	self fitContents.
	^ self ! !

!StringMorph methodsFor: 'halos and balloon help' stamp: 'IgorStasenko 12/22/2012 03:00'!
boundsForBalloon
	"Some morphs have bounds that are way too big.  This is a contorted way of making things work okay in PluggableListMorphs, whose list elements historically have huge widths"

	| ownerOwner |
	^ ((owner notNil and: [(ownerOwner := owner owner) notNil]) and:
			[ownerOwner isKindOf: PluggableListMorph])
		ifTrue:
			[self boundsInWorld intersect: ownerOwner boundsInWorld ifNone: [self boundsInWorld] ]
		ifFalse:
			[super boundsForBalloon]! !

!StringMorph methodsFor: 'event handling' stamp: 'sw 9/8/1999 11:26'!
hasFocus
	^ hasFocus! !

!StringMorph methodsFor: 'accessing' stamp: 'ar 1/31/2001 19:33'!
font
	"who came up with #fontToUse rather than font?!!"
	^self fontToUse! !

!StringMorph methodsFor: 'layout' stamp: 'nk 5/11/2001 09:33'!
fullBounds
	self contents ifNil: [ self contents: 'String Morph' ].
	^super fullBounds! !

!StringMorph methodsFor: 'accessing' stamp: 'ar 12/12/2001 02:44'!
fitContents

	| newBounds boundsChanged |
	newBounds := self measureContents.
	boundsChanged := bounds extent ~= newBounds.
	self extent: newBounds.		"default short-circuits if bounds not changed"
	boundsChanged ifFalse: [self changed]! !

!StringMorph methodsFor: 'editing' stamp: 'sw 9/17/1999 13:27'!
cancelEdits

	self doneWithEdits! !

!StringMorph methodsFor: 'accessing' stamp: 'sw 9/8/1999 11:10'!
interimContents: aString
	"The receiver is under edit and aString represents the string the user sees as she edits, which typically will not have been accepted and indeed may be abandoned"

	self contents: aString! !

!StringMorph methodsFor: 't-rotating' stamp: ''!
forwardDirection: newDirection
	"Set the receiver's forward direction (in eToy terms)"
	self setProperty: #forwardDirection toValue: newDirection.! !

!StringMorph methodsFor: 'editing' stamp: 'nk 2/24/2005 20:11'!
launchMiniEditor: evt

	| textMorph |
	hasFocus := true.  "Really only means edit in progress for this morph"
	textMorph := StringMorphEditor new contentsAsIs: contents.
	textMorph beAllFont: self fontToUse.
	textMorph bounds: (self bounds expandBy: 0@2).
	self addMorphFront: textMorph.
	evt hand newKeyboardFocus: textMorph.
	textMorph editor selectFrom: 1 to: textMorph paragraph text string size! !

!StringMorph methodsFor: 'editing' stamp: 'di 9/6/1999 22:44'!
doneWithEdits

	hasFocus := false! !

!StringMorph methodsFor: 'accessing' stamp: 'sw 9/8/1999 13:44'!
minimumWidth
	"Answer the minimum width that the receiver can have.  A nonzero value here keeps the receiver from degenerating into something that cannot ever be seen or touched again!!  Obeyed by fitContents."

	^ 3! !

!StringMorph methodsFor: 'testing' stamp: 'AlainPlantec 1/7/2010 22:43'!
isEditable: evt
	"If the shift key is pressed then yes.
	As normal if StringMorph class>> editableStringMorph  returns false."
	
	^(self class editableStringMorph and: [evt shiftPressed and: [self wantsKeyboardFocusOnShiftClick]])
! !

!StringMorph methodsFor: 'private' stamp: ''!
privateSetContents: newContents 
	| scanner |
	contents := newContents isText
				ifTrue: [scanner := StringMorphAttributeScanner new initializeFromStringMorph: self.
					(newContents attributesAt: 1 forStyle: self font textStyle)
						do: [:attr | attr emphasizeScanner: scanner].
					emphasis := scanner emphasis.
					font := scanner font emphasis: emphasis.
					color := scanner textColor.
					newContents string]
				ifFalse: [contents = newContents
						ifTrue: [^ self].
					"no substantive change"
					newContents].! !

!StringMorph methodsFor: 'printing' stamp: 'jm 11/3/97 16:52'!
printOn: aStream

	super printOn: aStream.
	aStream print: contents.
! !

!StringMorph methodsFor: 't-rotating' stamp: ''!
setDirectionFrom: aPoint
	| delta degrees |
	delta := (self transformFromWorld globalPointToLocal: aPoint) - self referencePosition.
	degrees := delta degrees + 90.0.
	self forwardDirection: (degrees \\ 360) rounded.
! !

!StringMorph methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/1/2014 01:08'!
enabled: aBoolean

	aBoolean 
		ifTrue: [ self color: self defaultColor ]
		ifFalse: [ self color: self theme disabledTextColor ]! !

!StringMorph methodsFor: 'accessing' stamp: 'tk 8/28/2000 13:59'!
fontName: fontName size: fontSize

	^ self font: (StrikeFont familyName: fontName size: fontSize) 
			emphasis: 0! !

!StringMorph methodsFor: 'event handling' stamp: 'sw 5/6/1998 15:45'!
wouldAcceptKeyboardFocus
	^ self isLocked not! !

!StringMorph methodsFor: '*Morphic-Base-Widgets' stamp: 'BenjaminVanRyseghem 7/25/2012 11:54'!
widthToDisplayInList: aList

	^ self contents widthToDisplayInList: aList ! !

!StringMorph methodsFor: 'editing' stamp: ''!
acceptContents
	"The message is sent when the user hits enter or Cmd-S. Accept the current contents and end editing. This default implementation does nothing."
! !

!StringMorph methodsFor: 'menu' stamp: 'StephaneDucasse 10/27/2014 09:34'!
addCustomMenuItems: aCustomMenu hand: aHandMorph

	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
	aCustomMenu add: 'change font' selector: #changeFont.
	aCustomMenu add: 'change emphasis' selector: #changeEmphasis.
! !

!StringMorph methodsFor: 'menu' stamp: 'StephaneDucasse 5/25/2011 17:47'!
emphasisChoices
	"Returns the emphasis selectors that are sent to a TextEmphasis."
	
	^ #(normal bold italic narrow underlined struckOut)! !

!StringMorph methodsFor: 'accessing' stamp: 'gvc 8/9/2007 12:29'!
paneColor
	"Answer the window's pane color or our owner's color otherwise."

	^self paneColorOrNil ifNil: [self owner ifNil: [Color transparent] ifNotNil: [self owner color]]! !

!StringMorph methodsFor: 't-rotating' stamp: ''!
heading
	"Return the receiver's heading"
	^ self owner 
		ifNil: [self forwardDirection]
		ifNotNil: [self forwardDirection + self owner degreesOfFlex]! !

!StringMorph methodsFor: 'drawing' stamp: 'IgorStasenko 2/22/2012 15:13'!
drawDropShadowOn: aCanvas

	| bnd gap |
	bnd := self bounds translateBy: self shadowOffset.
	gap := self layoutInset.
	bnd := (bnd topLeft + gap) corner: (bnd bottomRight + gap).
	aCanvas drawString: contents in: bnd font: self fontToUse color: self shadowColor.! !

!StringMorph methodsFor: 'accessing' stamp: 'sw 9/16/1999 22:57'!
valueFromContents
	"Return a new value from the current contents string."
	^ contents! !

!StringMorph methodsFor: '*Morphic-Base-Widgets' stamp: 'BenjaminVanRyseghem 7/25/2012 11:42'!
heightToDisplayInList: aList

	^ self contents heightToDisplayInList: aList ! !

!StringMorph methodsFor: 'accessing' stamp: 'gvc 6/15/2007 13:18'!
minHeight
	"Answer the minimum height of the receiver."
	
	^self fontToUse height max: super minHeight! !

!StringMorph methodsFor: 'event handling' stamp: 'AlainPlantec 1/7/2010 22:43'!
mouseDown: evt
	"If the shift key is pressed, make this string the keyboard input focus.
	Process as normal if StringMorph class>> editableStringMorph  returns false."

	(self isEditable: evt)
		ifTrue: [self launchMiniEditor: evt]
		ifFalse: [super mouseDown: evt].
! !

!StringMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 3/13/2012 05:34'!
contents: newContents 
	self privateSetContents: newContents.
	self fitContents! !

!StringMorph methodsFor: 'accessing' stamp: 'gvc 6/4/2007 12:24'!
setWidth: width
	"Round up in case fractional."
	
	self extent: (width @ (font ifNil: [TextStyle defaultFont]) height) ceiling! !

!StringMorph methodsFor: 'menu' stamp: 'StephaneDucasse 4/23/2012 08:57'!
changeEmphasis

	| reply |
	reply := UIManager default 
				chooseFrom: (self emphasisChoices collect: [:t | t translated]) 
				values: self emphasisChoices.
	reply ifNotNil: [ self emphasis: (TextEmphasis perform: reply) emphasisCode ].
! !

!StringMorph methodsFor: 'editing' stamp: 'sw 9/8/1999 17:04'!
acceptValue: aValue
	| val |
	self contents: (val := aValue asString).
	^ val! !

!StringMorph methodsFor: 'accessing' stamp: ''!
contents

	^ contents! !

!StringMorph methodsFor: 't-rotating' stamp: ''!
rotationDegrees
	"Default implementation."

	^ 0.0
! !

!StringMorph methodsFor: 'editing' stamp: 'sw 9/8/1999 10:42'!
lostFocusWithoutAccepting
	"The message is sent when the user, having been in an editing episode on the receiver, changes the keyboard focus -- typically by clicking on some editable text somewhere else -- without having accepted the current edits."

	self acceptContents! !

!StringMorph class methodsFor: 'setting' stamp: 'AlainPlantec 12/10/2009 11:46'!
editableStringMorph
	^ EditableStringMorph ifNil: [EditableStringMorph := false]! !

!StringMorph class methodsFor: 'instance creation' stamp: 'sw 8/22/97 22:19'!
contents: aString
	" 'StringMorph contents: str' is faster than 'StringMorph new contents: str' "
	^ self contents: aString font: nil! !

!StringMorph class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 3/13/2012 05:00'!
contents: aString font: aFont emphasis: emphasisCode
	^ self new initWithContents: aString font: aFont emphasis: emphasisCode! !

!StringMorph class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 3/13/2012 05:00'!
contents: aString font: aFont
	^ self contents: aString font: aFont emphasis: 0! !

!StringMorph class methodsFor: 'setting' stamp: 'AlainPlantec 12/10/2009 11:46'!
editableStringMorph: aBoolean
	EditableStringMorph := aBoolean! !

!StringMorph class methodsFor: 'examples' stamp: 'StephaneDucasse 10/5/2014 14:33'!
exampleManyStringMorphs
	"Return a morph with lots of strings for testing display speed."
	<exampleWidget>
	"self test openInWorld"
	
	| c |
	c := AlignmentMorph newColumn.
	self class environment organization categories do:
		[:cat | c addMorph: (StringMorph new contents: cat)].
	^ c! !

!StringMorphAttributeScanner commentStamp: '<historical>'!
A StringMorphAttributeScanner provides the interface of a CharacterScanner so that text attributes may be collected from a Text and used elsewhere, like in setting the attributes of a StringMorph.
!
!StringMorphAttributeScanner methodsFor: 'accessing' stamp: 'nk 2/26/2004 12:34'!
emphasis
	"Answer the value of emphasis"

	^ emphasis! !

!StringMorphAttributeScanner methodsFor: 'accessing' stamp: 'nk 2/26/2004 12:34'!
kern
	"Answer the value of kern"

	^ kern! !

!StringMorphAttributeScanner methodsFor: 'accessing' stamp: 'nk 2/26/2004 12:34'!
indent
	"Answer the value of indent"

	^ indent! !

!StringMorphAttributeScanner methodsFor: 'accessing' stamp: 'nk 2/26/2004 12:34'!
textColor
	"Answer the value of textColor"

	^ textColor! !

!StringMorphAttributeScanner methodsFor: 'string morph' stamp: 'BenjaminVanRyseghem 5/13/2012 00:45'!
initializeFromStringMorph: aStringMorph

	fontNumber := 1.
	self setActualFont: (aStringMorph font ifNil: [ TextStyle defaultFont ]).
	
	emphasis := actualFont emphasis.
	textColor := aStringMorph color.
! !

!StringMorphAttributeScanner methodsFor: 'scanning' stamp: 'nk 2/26/2004 13:10'!
setFont: fontNum
	"Set the value of font"

	fontNumber := fontNum! !

!StringMorphAttributeScanner methodsFor: 'accessing' stamp: 'nk 2/26/2004 12:34'!
alignment
	"Answer the value of alignment"

	^ alignment! !

!StringMorphAttributeScanner methodsFor: 'accessing' stamp: 'nk 2/26/2004 13:12'!
actualFont
	"Answer the value of actualFont"

	^ actualFont ifNil: [ TextStyle defaultFont ]! !

!StringMorphAttributeScanner methodsFor: 'accessing' stamp: 'nk 2/26/2004 13:11'!
fontNumber
	"Answer the value of font"

	^ fontNumber! !

!StringMorphAttributeScanner methodsFor: 'scanning' stamp: 'nk 2/26/2004 12:40'!
addEmphasis: anInteger
	"Set the value of emphasis"

	emphasis := emphasis bitOr: anInteger! !

!StringMorphAttributeScanner methodsFor: 'scanning' stamp: 'marcus.denker 11/10/2008 10:04'!
setActualFont: aFont
	"Set the value of actualFont, from a TextFontReference"

	actualFont := aFont.
	aFont textStyle ifNotNil: [ :ts | fontNumber := ts fontIndexOf: aFont ]! !

!StringMorphAttributeScanner methodsFor: 'scanning' stamp: 'nk 2/26/2004 12:34'!
textColor: anObject
	"Set the value of textColor"

	textColor := anObject! !

!StringMorphAttributeScanner methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 11:07'!
initialize
	super initialize.
	emphasis := 0.
	indent := 0.
	kern := 0.
	fontNumber := 1.
	actualFont := TextStyle defaultFont! !

!StringMorphAttributeScanner methodsFor: 'scanning' stamp: 'nk 2/26/2004 12:39'!
setAlignment: aSymbol
	"Set the value of alignment"

	alignment := aSymbol! !

!StringMorphAttributeScanner methodsFor: 'accessing' stamp: 'EstebanLorenzano 1/15/2013 16:21'!
font
	"Answer the value of font"

	^(self textStyle fontAt: self fontNumber) copy! !

!StringMorphAttributeScanner methodsFor: 'scanning' stamp: 'nk 2/26/2004 12:37'!
indentationLevel: anInteger
	"Set the value of indent"

	indent := anInteger! !

!StringMorphAttributeScanner methodsFor: 'accessing' stamp: 'nk 2/26/2004 13:12'!
textStyle
	^self actualFont textStyle ifNil: [ TextStyle default ]! !

!StringMorphAttributeScanner methodsFor: 'scanning' stamp: 'nk 2/26/2004 12:41'!
addKern: kernDelta
	"Set the current kern amount."
	kern := kern + kernDelta! !

!StringMorphEditor commentStamp: '<historical>'!
I am a textMorph used as a pop-up editor for StringMorphs.  I present a yellow background and I go away when a CR is typed or when the user clicks elsewhere.!
!StringMorphEditor methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 11:08'!
initialize
	"Initialize the receiver.  Give it a white background"

	super initialize.
	self backgroundColor: Color white.
	self color: Color red! !

!StringMorphEditor methodsFor: 'drawing' stamp: 'sw 9/7/1999 16:22'!
drawOn: aCanvas

	aCanvas fillRectangle: self bounds color: Color yellow muchLighter.
	^ super drawOn: aCanvas! !

!StringMorphEditor methodsFor: 'event handling' stamp: 'AlainPlantec 1/9/2011 18:47'!
keyStroke: evt
	"This is hugely inefficient, but it seems to work, and it's unlikely it will ever need
	to be any more efficient -- it's only intended to edit single-line strings."

	| char priorEditor newSel |
	(((char := evt keyCharacter) = Character enter) or: [(char = Character cr)
			or: [char = $s and: [evt commandKeyPressed]]])
				ifTrue: [owner doneWithEdits; acceptContents.
	self flag: #arNote. "Probably unnecessary"
						evt hand releaseKeyboardFocus.
						^ self delete].
	
	(char = $l and: [evt commandKeyPressed]) ifTrue:   "cancel"
		[owner cancelEdits.
		evt hand releaseKeyboardFocus.
		^ self delete].

	super keyStroke: evt.
	owner interimContents: self contents asString.
	newSel := self editor selectionInterval.

	priorEditor := self editor.  "Save editor state"
	self releaseParagraph.  "Release paragraph so it will grow with selection."
	self paragraph.      "Re-instantiate to set new bounds"
	self installEditorToReplace: priorEditor.  "restore editor state"
	self editor selectFrom: newSel first to: newSel last.
! !

!StringMorphEditor methodsFor: 'testing' stamp: 'FernandoOlivero 3/25/2011 11:27'!
canChangeText
	^ true! !

!StringMorphEditor methodsFor: 'event handling' stamp: 'nk 1/23/2004 13:18'!
keyboardFocusChange: aBoolean
	| hadFocus |
	owner ifNil: [ ^self ].
	hadFocus := owner hasFocus.
	super keyboardFocusChange: aBoolean.
	aBoolean ifFalse:
		[hadFocus ifTrue:
			[owner lostFocusWithoutAccepting; doneWithEdits].
		^ self delete]! !

!StringTest commentStamp: '<historical>'!
This is the unit test for the class String. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see: 
	- http://www.c2.com/cgi/wiki?UnitTest
	- there is a chapter in the PharoByExample book (http://pharobyexample.org/)
	- the sunit class category!
!StringTest methodsFor: 'tests - converting' stamp: 'DamienPollet 8/1/2014 15:21'!
testAsSmalltalkComment

	| exampleStrings  |
	exampleStrings := #(
		''
		' '
		'"'
		'""'
		'"""'
		'abc"abc'
		'abc""abc'
		'abc"hello"abc'
		'abc"'
		'"abc' ).

	"check that the result of scanning the comment is empty"
	exampleStrings do: [ :s |
		| tokens  |
		tokens := s asComment parseLiterals.
		self assert: (tokens isEmpty) ].

	"check that the result has the same non-quote characters as the original"
	exampleStrings do: [ :s |
		self assert: ( (s copyWithout: $") = (s asComment copyWithout: $"))].

	"finnaly, test for some common kinds of inputs"
	self assert: ( 'abc' asComment = '"abc"').
	self assert: ( 'abc"abc' asComment = '"abc""abc"').
	self assert: ('abc""abc' asComment = '"abc""abc"' ).
		! !

!StringTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButLast
	"self debug: #testAllButLast"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButLast.
	self deny: abf last = col last.
	self assert: abf size + 1 = col size! !

!StringTest methodsFor: 'tests - begins ends with' stamp: ''!
testsEndsWith
	
	self assert: (self nonEmpty endsWith: self nonEmpty copyWithoutFirst).
	self assert: (self nonEmpty endsWith: self nonEmpty).
	self deny: (self nonEmpty endsWith: (self nonEmpty copyWith: self nonEmpty first)).! !

!StringTest methodsFor: 'tests - copying with replacement' stamp: ''!
testCopyReplaceAllWith1Occurence
	| result  firstIndexesOfOccurrence index endPartIndexResult endPartIndexCollection |
	
	result := self collectionWith1TimeSubcollection  copyReplaceAll: self oldSubCollection with: self replacementCollection .
	
	"detecting indexes of olSubCollection"
	firstIndexesOfOccurrence  := self firstIndexesOf: self oldSubCollection in: self collectionWith1TimeSubcollection .
	index:= firstIndexesOfOccurrence at: 1.
	
	"verify content of 'result' : "
	"first part of 'result'' : '"

	1 to: (index -1) do: 
		[
		:i |  
		self assert: (self collectionWith1TimeSubcollection  at:i)=(result at: i)
		].

	" middle part containing replacementCollection : "
	
	index to: (index + self replacementCollection size-1) do: 
		[
		:i |
		self assert: ( result at: i )=(self replacementCollection at: ( i - index + 1 ))
		].
	
	" end part :"
	
	endPartIndexResult :=  index + self replacementCollection  size .
	endPartIndexCollection :=   index + self oldSubCollection size  .
	
	1 to: (result size - endPartIndexResult - 1 ) do:
		[ 
		:i |
		self assert: (result at: ( endPartIndexResult + i - 1 ) ) = (self collectionWith1TimeSubcollection  at: ( endPartIndexCollection + i - 1 ) ).
		].
	
	
	! !

!StringTest methodsFor: 'tests - equality' stamp: ''!
testHasEqualElementsOfIdenticalCollectionObjects
	"self debug: #testHasEqualElementsOfIdenticalCollectionObjects"
	
	self assert: (self empty hasEqualElements: self empty). 
	self assert: (self nonEmpty hasEqualElements: self nonEmpty). 
	! !

!StringTest methodsFor: 'testing - lines' stamp: 'nice 11/16/2009 22:26'!
testWthNoLineLongerThan
	| phrases |
	phrases := {
		'Fred the bear went down to the brook to read his book in silence'.
		'Fred the bear went down' , String cr , ' to the brook to ' , String cr , 'read his book in silence'.
		'Fred the bear went down' , String lf , '  to the brook to ' , String lf , 'read his book in silence'.
		'Fred the bear went down' , String crlf , '  to the brook to ' , String crlf , 'read his book in silence'.
		}.
	#(5 7 9) do: [:length |
		phrases do: [:phrase |
			| split |
			split := phrase withNoLineLongerThan: length.
			self
				assert: (split copyWithoutAll: CharacterSet separators) = (phrase copyWithoutAll: CharacterSet separators)
				description: 'no information should be lost'.
			split linesDo: [:line |
				self assert: line size <= length description: 'lines should not be longer than prescribed'].
			phrase lineCount = 1 ifTrue: [| lastLineSize |
				lastLineSize := length.
				split linesDo: [:line |
					line isEmpty ifFalse: [| firstWordSize |
						firstWordSize := line indexOfAnyOf: CharacterSet separators startingAt: 1 ifAbsent: [line size + 1].
						self assert: (lastLineSize + firstWordSize) > length description: 'split was too short'.
						lastLineSize := line size]]]]]! !

!StringTest methodsFor: 'tests - index access' stamp: ''!
testLastIndexOf
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection lastIndexOf: element) = 1.
	self assert: (collection lastIndexOf: self elementNotInForIndexAccessing) = 0! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyWithReplacementTest
	self replacementCollection.
	self oldSubCollection.
	self collectionWith1TimeSubcollection.
	self assert: (self howMany: self oldSubCollection in: self collectionWith1TimeSubcollection) = 1! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 16:52'!
moreThan4Elements
	" return a collection including at leat 4 elements"
	^ nonEmpty5ElementsSorted! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 13:25'!
secondIndex
" return an index between 'nonEmpty' bounds that is > to 'second index' "
	^ self firstIndex ! !

!StringTest methodsFor: 'tests - subcollections access' stamp: ''!
testFirstNElements
	"self debug: #testFirstNElements"
	| result |
	result := self moreThan3Elements first: self moreThan3Elements size - 1.
	1 
		to: result size
		do: [ :i | self assert: (result at: i) = (self moreThan3Elements at: i) ].
	self assert: result size = (self moreThan3Elements size - 1).
	self 
		should: [ self moreThan3Elements first: self moreThan3Elements size + 1 ]
		raise: Error! !

!StringTest methodsFor: 'testing - internet' stamp: 'nice 1/18/2010 23:33'!
testWithSqueakLineEndings

	{
		'abc' -> 'abc'.
		'abc', String cr -> ('abc', String cr).
		'abc', String lf -> ('abc', String cr).
		'abc', String crlf -> ('abc', String cr).
		String cr, 'abc' -> (String cr, 'abc').
		String lf, 'abc' -> (String cr, 'abc').
		String crlf, 'abc' -> (String cr, 'abc').
		'abc', String cr, String cr, 'abc' -> ('abc', String cr, String cr, 'abc').
		'abc', String lf, String lf, 'abc' -> ('abc', String cr, String cr, 'abc').
		'abc', String crlf, String crlf, 'abc' -> ('abc', String cr, String cr, 'abc').
		String cr, 'abc', String cr, String crlf, 'abc', String lf -> (String cr, 'abc', String cr, String cr, 'abc', String cr).
		String lf, 'abc', String lf, String crlf, 'abc', String cr -> (String cr, 'abc', String cr, String cr, 'abc', String cr).
	} do: [ :each |
		self assert: each key withSqueakLineEndings = each value ]! !

!StringTest methodsFor: 'tests - as class' stamp: 'CamilloBruni 5/8/2013 11:36'!
testAsClassIfAbsent

	self 
		assert: ('String' asClassIfAbsent: [ self fail ])
		equals: String.
	
	'+' asClassIfAbsent: [ ^ self "success" ].
	self fail.! !

!StringTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 12/18/2009 13:43'!
collectionWith2TimeSubcollection
	" return a collection including 'oldSubCollection'  two or many time "
	^ nonEmpty5ElementsSorted , subcollection3ElementsSorted ! !

!StringTest methodsFor: 'tests - puting with indexes' stamp: ''!
testFromToPut
	
	| collection index |
	index := self indexArray anyOne.
	collection := self nonEmpty copy.
	collection from: 1 to: index  put: self aValue..
	1 to: index do:
		[:i | self assert: (collection at: i)= self aValue].
	(index +1) to: collection size do:
		[:i | self assert: (collection at:i)= (self nonEmpty at:i)].! !

!StringTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithoutFirst

	| result |
	result := self nonEmpty copyWithoutFirst.
	
	self assert: result size = (self nonEmpty size - 1).
	
	1 to: result size do:
		[:i |
		self assert: (result at: i)= (self nonEmpty at: (i + 1))].! !

!StringTest methodsFor: 'testing - tokenizing' stamp: 'fbs 2/13/2006 22:19'!
testFindTokensEscapedBy15

	| tokens |
	string := 'one, "two# three"; &four. five&'.
	tokens := string findTokens: nil escapedBy: '"&'.
	self assert: tokens size = 1.
	self assert: tokens first = 'one, two# three; four. five'! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
test0TStructuralEqualityTest
	self empty.
	self nonEmpty.
	self assert: self empty isEmpty.
	self deny: self nonEmpty isEmpty! !

!StringTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionTwoSimilarElementsInIntersection
	"self debug: #testIntersectionBasic"
	| inter |
	inter := self collection intersection: (self collectionClass with: self anotherElementOrAssociationIn).
	self assert: (self collection occurrencesOf: self anotherElementOrAssociationIn) = self numberOfSimilarElementsInIntersection.
	self assert: (inter includes: self anotherElementOrAssociationIn value)! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 16:54'!
unsortedCollection
	^ unsortedCollection ! !

!StringTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testLastIndexOfDuplicate
	"self debug: #testLastIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection first.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'lastIndexOf: should return the position of the last occurrence :'"
	self assert: (collection lastIndexOf: element) = collection size! !

!StringTest methodsFor: 'tests - element accessing' stamp: ''!
testBefore
	"self debug: #testBefore"
	self assert: (self moreThan4Elements before: (self moreThan4Elements at: 2)) = (self moreThan4Elements at: 1).
	self 
		should: [ self moreThan4Elements before: (self moreThan4Elements at: 1) ]
		raise: Error.
	self 
		should: [ self moreThan4Elements before: 66 ]
		raise: Error! !

!StringTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedArray
	| result collection |
	collection := self collectionWithSortableElements .
	result := collection  asArray sort.
	self assert: (result class includesBehavior: Array).
	self assert: result isSorted.
	self assert: result size = collection size! !

!StringTest methodsFor: 'requirements' stamp: 'CamilloBruni 9/9/2011 12:12'!
collectionWithoutEqualElements

" return a collection not including equal elements "
	^ withoutEqualElements ! !

!StringTest methodsFor: 'tests - converting' stamp: ''!
testAsArray
	"self debug: #testAsArray3"
	self 
		assertSameContents: self collectionWithoutEqualElements
		whenConvertedTo: Array! !

!StringTest methodsFor: 'test - creation' stamp: ''!
testWith
	"self debug: #testWith"
	
	| aCol anElement |
	anElement := self collectionMoreThan5Elements anyOne.
	aCol := self collectionClass with: anElement.
	self assert: (aCol includes: anElement).! !

!StringTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAnyNoneThere
	"self debug: #testIncludesAnyOfNoneThere'"
	
	self deny: (self nonEmpty includesAny: self empty).
	self deny: (self nonEmpty includesAny: { self elementNotIn. self anotherElementNotIn })! !

!StringTest methodsFor: '*Multilingual-Tests-OtherLanguages' stamp: 'SvenVanCaekenberghe 10/27/2013 13:52'!
testUnescapePercents
	self assert: '' urlDecoded = ''.
	self assert: 'x' urlDecoded = 'x'.

	self assert: '+' urlDecoded = ' '.
	self assert: 'x+' urlDecoded = 'x '.
	self assert: '+x' urlDecoded = ' x'.
	self assert: 'x+x' urlDecoded = 'x x'.

	self should: [ '%' urlDecoded ] raise: Error.
	self should: [ '%3' urlDecoded ] raise: Error.
	self assert: '%3C' urlDecoded = '<'.
	
	self assert: '%3Cx%3E4%3C%2Fx%3E' urlDecoded = '<x>4</x>'.
	
	self assert: '!!@#$%25%5E&*()%7B%7D%5B%5D=:/;?+''%22' urlDecoded  = '!!@#$%^&*(){}[]=:/;? ''"'.
	self assert: '!!%40%23%24%25%5E%26*()%7B%7D%5B%5D%3D%3A%2F%3B%3F%2B''%22' urlDecoded  = '!!@#$%^&*(){}[]=:/;?+''"'.
	self assert: '%21@%23%24%25%5E%26*%28%29%7B%7D%5B%5D%3D%3A/%3B%3F+%27%22' urlDecoded = '!!@#$%^&*(){}[]=:/;? ''"'! !

!StringTest methodsFor: 'tests - set arithmetic' stamp: ''!
testUnionOfEmpties
	"self debug: #testUnionOfEmpties"
	
	self assert:  (self empty union: self empty) isEmpty.
	
	! !

!StringTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindFirst

	| element result |
	element := self nonEmptyMoreThan1Element   at:1.
	 result:=self nonEmptyMoreThan1Element  findFirst: [:each | each =element].
	
	self assert: result=1. ! !

!StringTest methodsFor: 'tests - copying part of sequenceable for multipliness' stamp: ''!
testCopyUpToWithDuplicate
	| result element  collection |
	collection := self collectionWithSameAtEndAndBegining .
	element := collection  last.
	
	" collectionWithSameAtEndAndBegining first and last elements are equals.
	'copyUpTo:' should copy until the first occurence :"
	result := collection   copyUpTo: (element ).
	
	"verifying content: "
	self assert: result isEmpty.

! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
testOFixtureReplacementSequencedTest

	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	
	self elementInForReplacement.
	self assert: (self nonEmpty includes: self elementInForReplacement ) .
	
	self newElement.
	
	self firstIndex.
	self assert: (self firstIndex >= 1 & self firstIndex <= self nonEmpty size).
	
	self secondIndex.
	self assert: (self secondIndex >= 1 & self secondIndex <= self nonEmpty size).
	
	self assert: self firstIndex <=self secondIndex .
	
	self replacementCollection.
	
	self replacementCollectionSameSize.
	self assert: (self secondIndex  - self firstIndex +1)= self replacementCollectionSameSize size
	! !

!StringTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithIndexCollect
	
	| result index collection |
	index := 0.
	collection := self nonEmptyMoreThan1Element .
	result := collection  withIndexCollect: [:each :i | 
		self assert: i = (index := index + 1).	
		self assert: i = (collection  indexOf: each) .
		each] . 
	
	1 to: result size do:[: i | self assert: (result at:i)= (collection at: i)].
	self assert: result size = collection size.! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 13:24'!
firstIndex
" return an index between 'nonEmpty' bounds that is < to 'second index' "
	^3! !

!StringTest methodsFor: 'tests - copy' stamp: ''!
testCopyNotSame
	"self debug: #testCopySameClass"
	"A copy of a collection should always be of the same class as the instance it copies"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: copy  == self nonEmpty.! !

!StringTest methodsFor: 'testing - internet' stamp: 'nice 1/18/2010 23:35'!
testWithUnixLineEndings

	{
		'abc' -> 'abc'.
		'abc', String cr -> ('abc', String lf).
		'abc', String lf -> ('abc', String lf).
		'abc', String crlf -> ('abc', String lf).
		String cr, 'abc' -> (String lf, 'abc').
		String lf, 'abc' -> (String lf, 'abc').
		String crlf, 'abc' -> (String lf, 'abc').
		'abc', String cr, String cr, 'abc' -> ('abc', String lf, String lf, 'abc').
		'abc', String lf, String lf, 'abc' -> ('abc', String lf, String lf, 'abc').
		'abc', String crlf, String crlf, 'abc' -> ('abc', String lf, String lf, 'abc').
		String cr, 'abc', String cr, String crlf, 'abc', String lf -> (String lf, 'abc', String lf, String lf, 'abc', String lf).
		String lf, 'abc', String lf, String crlf, 'abc', String cr -> (String lf, 'abc', String lf, String lf, 'abc', String lf).
	} do: [ :each |
		self assert: each key withUnixLineEndings = each value ]! !

!StringTest methodsFor: 'tests - printing' stamp: ''!
testPrintElementsOn

	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printElementsOn: aStream .
	allElementsAsString:=(result findBetweenSubStrs: ' ' ).
	1 to: allElementsAsString size do:
		[:i | 
		self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString).
			].! !

!StringTest methodsFor: 'testing' stamp: 'StephaneDucasse 10/1/2014 08:05'!
testCharactersExactlyMatching
	self assert: 5 equals: ('voiture' charactersExactlyMatching: 'voituze').
	self assert: 0 equals: ('voiture' charactersExactlyMatching: '').
	self assert: 1 equals: ('voiture' charactersExactlyMatching: 'v').
	self assert: 0 equals: ('voiture' charactersExactlyMatching: 'abcdef').! !

!StringTest methodsFor: 'tests - begins ends with' stamp: ''!
testsEndsWithEmpty
	
	self deny: (self nonEmpty endsWith: self empty).
	self deny: (self empty endsWith: self nonEmpty).
	! !

!StringTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithSequenceable

	| result index element |
	index := self indexInNonEmpty .
	element := self nonEmpty at: index.
	result := self nonEmpty copyWith: (element ).
	
	self assert: result size = (self nonEmpty size + 1).
	self assert: result last = element .
	
	1 to: (result size - 1) do:
	[ :i |
	self assert: (result at: i) = ( self nonEmpty at: ( i  ))].! !

!StringTest methodsFor: 'tests - concatenation' stamp: ''!
testConcatenationWithEmpty
	| result |
	result:= self empty,self secondCollection .
	
	1 to: self secondCollection size do:
		[:i | 
		self assert: (self secondCollection at:i)= (result at:i).
		].
	"size : "
	self assert: result size = ( self secondCollection size).! !

!StringTest methodsFor: 'tests - includes' stamp: 'stephane.ducasse 11/21/2008 15:09'!
anotherElementNotIn
	^ $k! !

!StringTest methodsFor: 'tests - copying part of sequenceable for multipliness' stamp: ''!
testCopyUpToLastWithDuplicate
	| result element  collection |
	collection := self collectionWithSameAtEndAndBegining .
	element := collection  first.
	
	" collectionWithSameAtEndAndBegining first and last elements are equals.
	'copyUpToLast:' should copy until the last occurence :"
	result := collection   copyUpToLast: (element ).
	
	"verifying content: "
	1 to: result size do:
		[:i |
		self assert: (result at: i ) = ( collection at: i )  
		].
	
	self assert: result size = (collection size - 1).

! !

!StringTest methodsFor: 'tests - puting with indexes' stamp: ''!
testSwapWith
	"self debug: #testSwapWith"
	| result index |
	index := self indexArray anyOne.
	result:= self nonEmpty copy .
	result swap: index with: 1.
	self assert: (result at: index) = (self nonEmpty at:1).
	self assert: (result at: 1) = (self nonEmpty at: index).
	! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIterateSequencedReadableTest

	| res |
	
	self nonEmptyMoreThan1Element.
	self assert: self nonEmptyMoreThan1Element  size > 1.
	
	
	self empty.
	self assert: self empty isEmpty .
	
	res := true.
	self nonEmptyMoreThan1Element    
	detect: [ :each | (self nonEmptyMoreThan1Element    occurrencesOf: each) > 1 ]
	ifNone: [ res := false ].
	self assert: res = false.! !

!StringTest methodsFor: 'tests - puting with indexes' stamp: ''!
testAtAllIndexesPut
	
	self nonEmpty atAllPut: self aValue.
	self nonEmpty do:[ :each| self assert: each = self aValue].
	! !

!StringTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterLastEmpty

	| delim emptyStream |
	delim := ', '.
	emptyStream := ReadWriteStream on: ''.
	self empty asStringOn: emptyStream delimiter: delim last:'and'.
	self assert: emptyStream contents = ''.
! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 16:52'!
collectionWith1TimeSubcollection
	" return a collection including 'oldSubCollection'  only one time "
	^ nonEmpty5ElementsSorted! !

!StringTest methodsFor: 'tests - puting with indexes' stamp: ''!
testAtAllPut
	| |
	self nonEmpty atAll: self indexArray put: self aValue..
	
	self indexArray do:
		[:i | self assert: (self nonEmpty at: i)=self aValue ].
	! !

!StringTest methodsFor: 'testing - tokenizing' stamp: 'fbs 2/13/2006 22:19'!
testFindTokensEscapedBy22

	| tokens |
	string := ''.
	tokens := string findTokens: $, escapedBy: $".
	self assert: tokens size = 0! !

!StringTest methodsFor: 'testing - tokenizing' stamp: 'fbs 2/13/2006 22:19'!
testFindTokensEscapedBy16

	| tokens |
	string := 'one, "two# three"; &four. five&'.
	tokens := string findTokens: nil escapedBy: nil.
	self assert: tokens size = 1.
	self assert: tokens first = string! !

!StringTest methodsFor: 'testing - formatting' stamp: 'SvenVanCaekenberghe 11/21/2012 09:11'!
testFormatFailures

	self
		should: [ 'This is {foo} !!' format: Dictionary new ]
		raise: KeyNotFound.
		
	self
		should: [ 'This is {1} !!' format: Array new ]
		raise: SubscriptOutOfBounds.
! !

!StringTest methodsFor: 'tests - element accessing' stamp: ''!
testAtOutOfBounds
	"self debug: #testAtOutOfBounds"
	self 
		should: [ self moreThan4Elements at: self moreThan4Elements size + 1 ]
		raise: Error.
	self 
		should: [ self moreThan4Elements at: -1 ]
		raise: Error! !

!StringTest methodsFor: 'test - creation' stamp: ''!
testOfSize
	"self debug: #testOfSize"
	
	| aCol |
	aCol := self collectionClass ofSize: 3.
	self assert: (aCol size = 3).
! !

!StringTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOfEmpty
	| result |
	result := self empty occurrencesOf: (self collectionWithoutEqualElements anyOne).
	self assert: result = 0! !

!StringTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyEmpty
	"self debug: #testCopyEmpty"
	
	| copy | 
	copy := self empty copy.
	self assert: copy isEmpty.! !

!StringTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithCollect
	
	| result firstCollection secondCollection index  |

	firstCollection := self nonEmptyMoreThan1Element.
	secondCollection := firstCollection copy.
	index := 0.
	
	result := firstCollection  with: secondCollection collect:
		[:a :b |
		( index := index + 1).
		self assert: (firstCollection at: index) equals:  a. 
		self assert: (secondCollection at: index) equals:  b.
		b].
	
	1 to: result size do:[: i | self assert: (result at:i)= (secondCollection  at: i)].
	self assert: result size = secondCollection  size.! !

!StringTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterLastOne

	| delim oneItemStream result |
	
	delim := ', '.
	result:=''.
	oneItemStream := ReadWriteStream on: result.
	self nonEmpty1Element  asStringOn: oneItemStream delimiter: delim last: 'and'.
	oneItemStream do:[:each | self assert: each = (self nonEmpty1Element first asString)].
	

	! !

!StringTest methodsFor: 'testing - converting' stamp: 'SvenVanCaekenberghe 1/8/2012 14:31'!
testTrimRight
	self assert: '' trimRight = ''.
	self assert: ' ' trimRight = ''.
	self assert: '	' trimRight = ''.
	self assert: 'foo' trimRight = 'foo'.
	self assert: ' foo ' trimRight = ' foo'.
	self assert: '  foo  ' trimRight = '  foo'.
	
	self assert: ('aabbaa' trimRight: [ :each | each = $a ]) = 'aabb'.
	self assert: ('bbaabb' trimRight: [ :each | each = $a ]) = 'bbaabb'! !

!StringTest methodsFor: 'testing - tokenizing' stamp: 'StephaneDucasse 5/28/2011 13:49'!
testFindTokensEscapedBy23

	| tokens |
	string := 'this, is, a, test'.
	tokens := string findTokens: $, escapedBy: $".
	self assert: tokens size = 4! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSetAritmeticTest
	self collection.
	self deny: self collection isEmpty.
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self anotherElementOrAssociationNotIn.
	self collection isDictionary
		ifTrue: [ self deny: (self collection associations includes: self anotherElementOrAssociationNotIn key) ]
		ifFalse: [ self deny: (self collection includes: self anotherElementOrAssociationNotIn) ].
	self collectionClass! !

!StringTest methodsFor: 'tests - printing' stamp: ''!
testPrintOnDelimiter
	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printOn: aStream delimiter: ', ' .
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString).
			].! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 16:52'!
collectionWithoutNilElements
	" return a collection that doesn't includes a nil element  and that doesn't includes equal elements'"
	^ nonEmpty5ElementsSorted! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
test0FixturePutTest
	self aValue.
	self anotherValue.
	
	self anIndex.
	self nonEmpty isDictionary 
		ifFalse:[self assert: (self anIndex >=1 & self anIndex <= self nonEmpty size).].
	
	self empty.
	self assert: self empty isEmpty .
	
	self nonEmpty.
	self deny: self nonEmpty  isEmpty.! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureTConvertTest
	"a collection of number without equal elements:"

	| res |
	self collectionWithoutEqualElements.
	res := true.
	self collectionWithoutEqualElements
		detect: [ :each | (self collectionWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false! !

!StringTest methodsFor: 'testing' stamp: 'StephaneDucasse 2/3/2010 22:21'!
testEquality
	"self run: #testEquality"
	
	self assert: 'abc' = 'abc' asWideString.
	self assert: 'abc' asWideString = 'abc'.
	self assert: ( #[97 0 0 0] asString ~= 'a000' asWideString).
	self assert: ('a000' asWideString ~=  #[97 0 0 0] asString).

	self assert: ('abc' sameAs: 'aBc' asWideString).
	self assert: ('aBc' asWideString sameAs: 'abc').
	self assert: ( #[97 0 0 0] asString 
						sameAs: 'Abcd' asWideString) not.
	self assert: ('a000' asWideString sameAs: #[97 0 0 0] asString) not.! !

!StringTest methodsFor: 'requirements' stamp: ''!
valueArray
" return a collection (with the same size than 'indexArray' )of values to be put in 'nonEmpty'  at indexes in 'indexArray' "
	| result |
	result := Array new: self indexArray size.
	1 to: result size do:
		[:i |
		result at:i put: (self aValue ).
		].
	^ result.! !

!StringTest methodsFor: '*Multilingual-Tests-OtherLanguages' stamp: 'SvenVanCaekenberghe 10/27/2013 12:15'!
testUnescapePercentsWithTextEncoding
	| leading kataTe kataSu kataTo |
	leading := JapaneseEnvironment leadingChar.
	"Katakana letter Te"
	kataTe := (Character leadingChar: leading code: 12486) asString.
	"Katakana letter Su"
	kataSu := (Character leadingChar: leading code: 12473) asString.
	"Katakana letter To"
	kataTo := (Character leadingChar: leading code: 12488) asString.
	"This could be reactivated when/if Zinc-Character-Encoding supports shift_jis"
	"self assert: ('%83e%83X%83g' unescapePercentsWithTextEncoding: 'shift_jis')
			= (kataTe , kataSu , kataTo).
	self assert: ('%83e%83X%83g%20and%20%83e%83X%83g' unescapePercentsWithTextEncoding: 'shift_jis')
			= (kataTe , kataSu , kataTo , ' and ' , kataTe , kataSu , kataTo)"! !

!StringTest methodsFor: 'tests - replacing' stamp: ''!
testReplaceFromToWithStartingAt
	| result  repStart collection replacementCollec firstInd secondInd |
	collection := self nonEmpty .
	result := collection copy.
	replacementCollec := self replacementCollectionSameSize .
	firstInd := self firstIndex .
	secondInd := self secondIndex .
	repStart := replacementCollec  size - ( secondInd  - firstInd   + 1 ) + 1.
	result replaceFrom: firstInd  to: secondInd with: replacementCollec  startingAt: repStart   .
	
	"verify content of 'result' : "
	"first part of 'result'' : '" 
	
	1 to: ( firstInd  - 1 ) do: [ :i | self assert: ( collection  at:i ) = ( result at: i ) ].
	
	" middle part containing replacementCollection : "
	
	( firstInd ) to: ( replacementCollec   size - repStart +1 ) do: 
		[:i|
		self assert: (result at: i)=( replacementCollec   at: ( repStart  + ( i  - firstInd  ) ) ) ].
	
	" end part :"
	( firstInd  + replacementCollec   size ) to: ( result size ) do:
		[ :i |
		self assert: ( result at: i ) = ( collection  at: ( secondInd  + 1 - ( firstInd  + replacementCollec   size ) + i ) ) ].! !

!StringTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterMore

	| delim multiItemStream result index |
	"delim := ', '.
	multiItemStream := '' readWrite.
	self oneTwoThreeItemCol asStringOn: multiItemStream delimiter: ', '.
	self assert: multiItemStream contents = '1, 2, 3'."
	
	delim := ', '.
	result:=''.
	multiItemStream := ReadWriteStream on:result.
	self nonEmpty  asStringOn: multiItemStream delimiter: ', '.
	
	index:=1.
	(result findBetweenSubStrs: ', ' )do:
		[:each |
		self assert: each= ((self nonEmpty at:index)asString).
		index:=index+1
		].! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 10:58'!
anIndex
" return an index in nonEmpty bounds"
	^ 2! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 14:52'!
collectionMoreThan5Elements
" return a collection including at least 5 elements"
	
	^ nonEmpty5ElementsSorted ! !

!StringTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testDetectSequenced
" testing that detect keep the first element returning true for sequenceable collections "

	| element result |
	element := self nonEmptyMoreThan1Element   at:1.
	result:=self nonEmptyMoreThan1Element  detect: [:each | each notNil ].
	self assert: result = element. ! !

!StringTest methodsFor: 'tests - includes' stamp: ''!
testIdentityIncludesNonSpecificComportement
	" test the same comportement than 'includes: '  "
	| collection |	
	collection := self nonEmpty  .
	
	self deny: (collection identityIncludes: self elementNotIn ).
	self assert:(collection identityIncludes: collection anyOne)
! !

!StringTest methodsFor: 'testing' stamp: 'nice 11/1/2011 22:58'!
testNumArgs
	"This is about http://code.google.com/p/pharo/issues/detail?id=237"
	
	| binary |
	binary := '*+-/\~=<>&@%,|'.
	self assert: (binary allSatisfy: [:char1 |
			(String with: char1) numArgs = 1 and: [binary allSatisfy: [:char2 |
				(String with: char1 with: char2) numArgs = 1 and: [binary allSatisfy: [:char3 |
					(String with: char1 with: char2 with: char3) numArgs = 1]]]]])
		description: 'binary selectors have 1 argument'.
		
	self assert: 'x' numArgs = 0
		description: 'unary selectors have 0 arguments'.
	self assert: 'x0' numArgs = 0
		description: 'unary selectors have 0 arguments'.
	self assert: 'yourself' numArgs = 0
		description: 'unary selectors have 0 arguments'.
		
	self assert: 'x:' numArgs = 1
		description: 'keyword selectors have as many elements as colons characters'.
	self assert: 'x:y:' numArgs = 2
		description: 'keyword selectors have as many elements as colons characters'.
	self assert: 'at:put:' numArgs = 2
		description: 'keyword selectors have as many elements as colons characters'.
			
	self assert: 'x_y_z' numArgs = 0
		description: 'selectors can contain underscores'.
	self assert: '_x' numArgs = 0
		description: 'selectors can begin with an underscore'.
	self assert: '_:_:' numArgs = 2
		description: 'keyword selectors can contain underscores'.
		
	self assert: 'at:withoutTrailingColon' numArgs = -1
		description: 'keyword selectors should have a trailing colon character'.
		
	self assert: ':x' numArgs = -1
		description: 'keyword selectors cannot begin with a colon character'.
		
	self assert: 'x::y:' numArgs = -1
		description: 'keyword selectors cannot have two consecutive colon characters'.
		
	self assert: '0x' numArgs = -1
		description: 'selectors cannot begin with a digit'.
		
	self assert: 'x::0y:' numArgs = -1
		description: 'keyword selectors cannot have any key beginning with a digit'.
	
	! !

!StringTest methodsFor: 'testing - converting' stamp: 'SvenVanCaekenberghe 1/17/2013 09:31'!
testWithBlanksCondensed
	#( 
		'foo' 'foo'
		'foo bar' 'foo bar'
		'' ''
		' ' ''
		'foo  bar  !!' 'foo bar !!'
		' foo  bar  !! ' 'foo bar !!'
		'  foo  bar  !!  ' 'foo bar !!'
		'		tabs		tabs	!!		' 'tabs	tabs	!!'
		'space followed by tab 	!!' 'space followed by tab !!'
	) pairsDo: [ :input :output |
		self assert: input withBlanksCondensed equals: output ]
	! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureAsStringCommaAndDelimiterTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty.
	self nonEmpty1Element.
	self assert: self nonEmpty1Element size = 1! !

!StringTest methodsFor: 'testing - converting' stamp: 'SvenVanCaekenberghe 1/17/2013 09:34'!
testWithSeparatorsCompacted
	#( 
		'foo' 'foo'
		'foo bar' 'foo bar'
		'' ''
		' ' ' '
		'foo  bar  !!' 'foo bar !!'
		' foo  bar  !! ' ' foo bar !! '
		'  foo  bar  !!  ' ' foo bar !! '
		'		tabs		tabs	!!		' ' tabs tabs !! '
		'space followed by tab 	!!' 'space followed by tab !!'
	) pairsDo: [ :input :output |
		self assert: input withSeparatorsCompacted equals: output ]
	! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 10:32'!
collectionMoreThan1NoDuplicates
	" return a collection of size > 1 without equal elements"
	^ withoutEqualElements ! !

!StringTest methodsFor: 'tests - sorting' stamp: ''!
testSorted
	| result tmp unsorted |
	unsorted := self unsortedCollection.
	result := unsorted sorted.
	self deny: unsorted == result.
	tmp := result at: 1.
	result
		do: [ :each | 
			self assert: each >= tmp.
			tmp := each ]! !

!StringTest methodsFor: 'testing - tokenizing' stamp: 'StephaneDucasse 5/28/2011 13:47'!
testFindTokensEscapedBy09

	| tokens |
	string := 'this, is, ###a, test#'.
	tokens := string findTokens: ',' escapedBy: '#'.
	self assert: tokens size = 3.
	self assert: tokens third = ' #a, test'! !

!StringTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAnyAllThere
	"self debug: #testIncludesAnyOfAllThere'"
	self deny: (self nonEmpty includesAny: self empty).
	self assert: (self nonEmpty includesAny: { self nonEmpty anyOne }).
	self assert: (self nonEmpty includesAny: self nonEmpty).! !

!StringTest methodsFor: 'testing - lines' stamp: 'nice 11/16/2009 13:14'!
testLineNumber
	| sampleCRString sampleLFString sampleCRLFString |
	sampleCRString := 'Fred', String cr , 'the' , String cr , 'Bear'.
	sampleLFString := 'Fred', String lf , 'the' , String lf , 'Bear'.
	sampleCRLFString := 'Fred', String crlf , 'the' , String crlf , 'Bear'.
	
	self assert: (sampleCRString lineNumber: 2) = 'the'.
	self assert: (sampleLFString lineNumber: 2) = 'the'.
	self assert: (sampleCRLFString lineNumber: 2) = 'the'.! !

!StringTest methodsFor: 'test - copy' stamp: 'delaunay 4/17/2009 15:26'!
elementToAdd
	^ $u! !

!StringTest methodsFor: 'testing - converting' stamp: 'SvenVanCaekenberghe 1/8/2012 14:31'!
testTrimLeft
	self assert: '' trimLeft = ''.
	self assert: ' ' trimLeft = ''.
	self assert: '	' trimLeft = ''.
	self assert: 'foo' trimLeft = 'foo'.
	self assert: ' foo ' trimLeft = 'foo '.
	self assert: '  foo  ' trimLeft = 'foo  '.
	
	self assert: ('aabbaa' trimLeft: [ :each | each = $a ]) = 'bbaa'.
	self assert: ('bbaabb' trimLeft: [ :each | each = $a ]) = 'bbaabb'! !

!StringTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testPairsDo
	| index |
	index:=1.
	
	self nonEmptyMoreThan1Element  pairsDo: 
		[:each1 :each2 | 
		self assert:(self nonEmptyMoreThan1Element at:index)=each1.
		self assert:(self nonEmptyMoreThan1Element at:(index+1))=each2.
		index:=index+2].
	
	self nonEmptyMoreThan1Element size odd
		ifTrue:[self assert: index=self nonEmptyMoreThan1Element size]
		ifFalse:[self assert: index=(self nonEmptyMoreThan1Element size+1)].! !

!StringTest methodsFor: 'tests - subcollections access' stamp: ''!
testLastNElements
	"self debug: #testLastNElements"
	| result |
	result := self moreThan3Elements last: self moreThan3Elements size - 1.
	1 
		to: result size
		do: [ :i | self assert: (result at: i) = (self moreThan3Elements at: i + 1) ].
	self assert: result size = (self moreThan3Elements size - 1).
	self 
		should: [ self moreThan3Elements last: self moreThan3Elements size + 1 ]
		raise: Error! !

!StringTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testCollectFromTo
	
	| result |
	result:=self nonEmptyMoreThan1Element 
		collect: [ :each | each ]
		from: 1
		to: (self nonEmptyMoreThan1Element size - 1).
		
	1 to: result size
		do: [ :i | self assert: (self nonEmptyMoreThan1Element at: i) = (result at: i) ].
	self assert: result size = (self nonEmptyMoreThan1Element size - 1)! !

!StringTest methodsFor: 'tests - printing' stamp: ''!
testPrintNameOn

	| aStream result |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printNameOn: aStream .
	Transcript show: result asString.
	self nonEmpty class name first isVowel
		ifTrue:[ self assert: aStream contents =('an ',self nonEmpty class name ) ]
		ifFalse:[self assert: aStream contents =('a ',self nonEmpty class name)].! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
test0SortingArrayedTest
	| tmp sorted |
	" an unsorted collection of number "
	self unsortedCollection.
	self unsortedCollection do: [ :each | each isNumber ].
	sorted := true.
	self unsortedCollection
		pairsDo: [ :each1 :each2 | 
			each2 < each1
				ifTrue: [ sorted := false ] ].
	self assert: sorted = false.	" a collection of number sorted in an ascending order"
	self sortedInAscendingOrderCollection.
	self sortedInAscendingOrderCollection do: [ :each | each isNumber ].
	tmp := self sortedInAscendingOrderCollection at: 1.
	self sortedInAscendingOrderCollection
		do: [ :each | 
			self assert: each >= tmp.
			tmp := each ]! !

!StringTest methodsFor: 'tests - copying with replacement' stamp: ''!
testCopyReplaceAllWithManyOccurence
	| result firstIndexesOfOccurrence resultBetweenPartIndex collectionBetweenPartIndex diff |
	" testing fixture here as this method may be not used for collection that can't contain equals element :"
	self collectionWith2TimeSubcollection.
	self assert: (self howMany: self oldSubCollection in: self collectionWith2TimeSubcollection) = 2.	" test :"
	diff := self replacementCollection size - self oldSubCollection size.
	result := self collectionWith2TimeSubcollection copyReplaceAll: self oldSubCollection with: self replacementCollection.	"detecting indexes of olSubCollection"
	firstIndexesOfOccurrence := self firstIndexesOf: self oldSubCollection in: self collectionWith2TimeSubcollection.	" verifying that replacementCollection has been put in places of oldSubCollections "
	firstIndexesOfOccurrence
		do: [ :each | 
			(firstIndexesOfOccurrence indexOf: each) = 1
				ifTrue: [ each to: self replacementCollection size do: [ :i | self assert: (result at: i) = (self replacementCollection at: i - each + 1) ] ]
				ifFalse: [ each + diff to: self replacementCollection size do: [ :i | self assert: (result at: i) = (self replacementCollection at: i - each + 1) ] ] ].	" verifying that the 'between' parts correspond to the initial collection : "
	1 to: firstIndexesOfOccurrence size do: [ :i | 
		i = 1
			ifTrue: [ 1 to: (firstIndexesOfOccurrence at: i) - 1 do: [ :j | self assert: (result at: i) = (self collectionWith2TimeSubcollection at: i) ] ]
			ifFalse: [ 
				resultBetweenPartIndex := (firstIndexesOfOccurrence at: i - 1) + self replacementCollection size.
				collectionBetweenPartIndex := (firstIndexesOfOccurrence at: i - 1) + self oldSubCollection size.
				1 to: (firstIndexesOfOccurrence at: i) - collectionBetweenPartIndex - 1 do: [ :j | 
					self
						assert:
							(result at: resultBetweenPartIndex + i - 1)
								= (self collectionWith2TimeSubcollection at: collectionBetweenPartIndex + i - 1) ] ]	" specific comportement for the begining of the collection :"	" between parts till the end : " ].	"final part :"
	1 to: self collectionWith2TimeSubcollection size - (firstIndexesOfOccurrence last + self oldSubCollection size) do: [ :i | 
		self
			assert:
				(result at: firstIndexesOfOccurrence last + self replacementCollection size - 1 + i)
					= (self collectionWith2TimeSubcollection at: firstIndexesOfOccurrence last + self oldSubCollection size - 1 + i) ]! !

!StringTest methodsFor: 'test - equality' stamp: ''!
testEqualSignIsTrueForNonIdenticalButEqualCollections
	"self debug: #testEqualSignIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty = self empty copy). 
	self assert: (self empty copy = self empty).
	self assert: (self empty copy = self empty copy).
		
	self assert: (self nonEmpty = self nonEmpty copy). 
	self assert: (self nonEmpty copy = self nonEmpty).
	self assert: (self nonEmpty copy = self nonEmpty copy).! !

!StringTest methodsFor: 'tests - indexof' stamp: 'on 5/14/2008 13:27'!
testFindFirstInString
	
	"These tests are more specific than thsoe in testIndexOf."
	
	"more boundary tests"
	self assert: (self findFirstInString: '' fromString: '') = 0.
	self assert: (self findFirstInString: 'x' fromString: '') = 0.
	self assert: (self findFirstInString: '' fromString: 'x') = 0.
	
	self assert: (self findFirstInString: 'x' fromString: 'x') = 1. "<- FIXED"
	
	self assert: (self findFirstInString: 'hello' fromString: 'hello') = 1.
	self assert: (self findFirstInString: 'hello' fromString: 'ello') = 2.
	self assert: (self findFirstInString: 'hello' fromString: 'llo') = 3.
	self assert: (self findFirstInString: 'hello' fromString: 'o') = 5. "<- FIXED"
	self assert: (self findFirstInString: 'hello' fromString: 'x') = 0.
! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 10:40'!
elementInForElementAccessing
" return an element inculded in 'moreThan4Elements'"
	^ self moreThan4Elements anyOne! !

!StringTest methodsFor: 'testing - tokenizing' stamp: 'StephaneDucasse 5/28/2011 13:49'!
testFindTokensEscapedBy07

	| tokens |
	string := 'a:b::c'.
	tokens := string findTokens: ':' escapedBy: '"'.
	self assert: tokens size = 4.
	self assert: tokens first = 'a'.
	self assert: tokens second = 'b'.
	self assert: tokens third = ''.
	self assert: tokens fourth = 'c'! !

!StringTest methodsFor: 'tests - copying with replacement' stamp: ''!
testCopyReplaceFromToWithInsertion
	| result  indexOfSubcollection |
	
	indexOfSubcollection := (self firstIndexesOf: self oldSubCollection  in:  self collectionWith1TimeSubcollection) at: 1. 
	
	result := self collectionWith1TimeSubcollection  copyReplaceFrom: indexOfSubcollection  to: ( indexOfSubcollection - 1 ) with: self replacementCollection .
	
	"verify content of 'result' : "
	"first part of 'result'' : '"
	
	1 to: (indexOfSubcollection -1) do: 
		[
		:i | 
		self assert: (self collectionWith1TimeSubcollection  at:i)=(result at: i)
		].
	
	" middle part containing replacementCollection : "
	indexOfSubcollection  to: (indexOfSubcollection  + self replacementCollection size-1) do: 
		[
		:i |
		self assert: ( result at: i )=(self replacementCollection at: ( i - indexOfSubcollection +1 ))
		].
	
	" end part :"
	(indexOfSubcollection  + self replacementCollection size) to: (result size) do:
		[:i|
		self assert: (result at: i)=(self collectionWith1TimeSubcollection  at: (i-self replacementCollection size))].
	
	" verify size: "	
	self assert: result size=(self collectionWith1TimeSubcollection  size + self replacementCollection size).
	

	

	
	! !

!StringTest methodsFor: 'testing - tokenizing' stamp: 'fbs 2/13/2006 22:20'!
testFindTokensEscapedBy02

	| tokens |
	string := ''.
	tokens := string findTokens: ',' escapedBy: '"'.
	self assert: tokens isEmpty! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 13:24'!
newElement
"return an element that will be put in the collection in place of another"
	^ elementInNonEmpty ! !

!StringTest methodsFor: 'testing - tokenizing' stamp: 'StephaneDucasse 5/28/2011 13:47'!
testFindTokensEscapedBy10

	| tokens |
	string := 'this, is, ###a, test'.
	tokens := string findTokens: ',' escapedBy: '#'.
	self assert: tokens size = 3.
	self assert: tokens third = ' #a, test'! !

!StringTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsCommaStringMore

	"self assert: self oneTwoThreeItemCol asCommaString = '1, 2, 3'.
	self assert: self oneTwoThreeItemCol asCommaStringAnd = '1, 2 and 3'
"

	| result resultAnd index allElementsAsString |
	result:= self nonEmpty asCommaString .
	resultAnd:= self nonEmpty asCommaStringAnd .
 
	index := 1.
	(result findBetweenSubStrs: ',' )do:
		[:each |
		index = 1
			ifTrue: [self assert: each= ((self nonEmpty at:index)asString)]
			ifFalse: [self assert: each= (' ',(self nonEmpty at:index) asString)].
		index:=index+1
		].
	
	"verifying esultAnd :"
	allElementsAsString:=(resultAnd findBetweenSubStrs: ',' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size )
			ifTrue: [
			i = 1
				ifTrue:[self assert: (allElementsAsString at:i)=((self nonEmpty at:i) asString)]
				ifFalse:[self assert: (allElementsAsString at:i)=(' ',(self nonEmpty at:i) asString)]
				].
		i=(allElementsAsString size)
			ifTrue:[ 
			i = 1
				ifTrue:[self assert: (allElementsAsString at:i)=( (self nonEmpty at:i ) asString ,' and ', (self nonEmpty at: ( i + 1) ) asString )]
				ifFalse:[self assert: (allElementsAsString at:i)=( ' ' , (self nonEmpty at:i ) asString ,' and ', (self nonEmpty at: ( i + 1) ) asString )]
				].
		
		
			].! !

!StringTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testIndexOfStartingAtDuplicate
	"self debug: #testLastIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection last.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'indexOf:ifAbsent:startingAt: should return the position of the first occurrence :'"
	self assert: (collection 
			indexOf: element
			startingAt: 1
			ifAbsent: [ 55 ]) = 1.
	self assert: (collection 
			indexOf: element
			startingAt: 2
			ifAbsent: [ 55 ]) = collection size! !

!StringTest methodsFor: 'tests - replacing' stamp: ''!
testReplaceFromToWith
	| result  collection replacementCollec firstInd secondInd |
	collection := self nonEmpty .
	replacementCollec := self replacementCollectionSameSize .
	firstInd := self firstIndex .
	secondInd := self secondIndex .
	result := collection  copy.
	result replaceFrom: firstInd  to: secondInd  with: replacementCollec .
	
	"verify content of 'result' : "
	"first part of 'result'' : '"
	
	1 to: ( firstInd - 1 ) do: [ :i | self assert: (collection  at:i ) = ( result at: i ) ].
	
	" middle part containing replacementCollection : "
	
	( firstInd ) to: ( firstInd  + replacementCollec size - 1 ) do: 
		[ :i |
		self assert: ( result at: i ) = ( replacementCollec  at: ( i - firstInd  +1 ) ) 
		].
	
	" end part :"
	( firstInd  + replacementCollec   size) to: (result size) do:
		[:i|
		self assert: ( result at: i ) = ( collection at: ( secondInd  + 1 - ( firstInd + replacementCollec size ) + i ) ) ].
	
	! !

!StringTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWith
	"self debug: #testCopyNonEmptyWith"
	| res anElement |
	anElement := self elementToAdd .
	res := self nonEmpty copyWith: anElement.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self assert: (res includes: (anElement value)).
	self nonEmpty do: [ :each | res includes: each ]! !

!StringTest methodsFor: 'tests - converting' stamp: 'MarcusDenker 6/26/2013 14:06'!
testWriteStreamConvertsToWideString
	| oldWideString newString ws |
	"test that a write stream on a ByteString is autoconverted into a WideString if a Wide character is inserted into it"
	oldWideString := (WideString new: 1) wordAt: 1 
										put: 20984060; 
										yourself.
	newString := (String new: oldWideString size).
	ws := newString writeStream.
	oldWideString do: [:each | ws nextPut: each].
	self assert: (newString = oldWideString).! !

!StringTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfterLastEmpty
	| result |
	result := self empty copyAfterLast: self collectionWithoutEqualElements first.
	self assert: result isEmpty.! !

!StringTest methodsFor: 'tests - copy' stamp: 'delaunay 3/30/2009 10:33'!
testCopyNonEmptyWithoutAllNotIncluded
	! !

!StringTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyEmptyMethod
	| result |
	result := self collectionWithoutEqualElements  copyEmpty .
	self assert: result isEmpty .
	self assert: result class= self nonEmpty class.! !

!StringTest methodsFor: 'tests - index access' stamp: ''!
testIdentityIndexOfIAbsent
	| collection element |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			identityIndexOf: element
			ifAbsent: [ 0 ]) = 1.
	self assert: (collection 
			identityIndexOf: self elementNotInForIndexAccessing
			ifAbsent: [ 55 ]) = 55! !

!StringTest methodsFor: 'tests - puting with indexes' stamp: ''!
testAtAllPutAll

	| aValueArray |
	aValueArray := self valueArray .
	self nonEmpty atAll: self indexArray putAll: aValueArray  .
	
	1 to: self indexArray size do:
		[:i |
		self assert: (self nonEmpty at:(self indexArray at: i))= (aValueArray  at:i) ]! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 5/13/2009 15:59'!
collectionWithEqualElements
" return a collecition including atLeast two elements equal"

^ sameAtEndAndBegining ! !

!StringTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfSubCollectionStartingAt
	"self debug: #testIndexOfIfAbsent"
	| subcollection index collection |
	collection := self collectionMoreThan1NoDuplicates.
	subcollection := self collectionMoreThan1NoDuplicates.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 1.
	self assert: index = 1.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 2.
	self assert: index = 0! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 16:52'!
collectionWithSortableElements
	" return a collection only including elements that can be sorted (understanding '<' )"
	^ nonEmpty5ElementsSorted! !

!StringTest methodsFor: 'tests - copying part of sequenceable for multipliness' stamp: ''!
testCopyAfterWithDuplicate
	| result element  collection |
	collection := self collectionWithSameAtEndAndBegining .
	element := collection  last.
	
	" collectionWithSameAtEndAndBegining first and last elements are equals.
	'copyAfter:' should copy after the first occurence :"
	result := collection   copyAfter: (element ).
	
	"verifying content: "
	1 to: result size do: 
		[:i |
		self assert: (collection  at:(i + 1 )) = (result at: (i))
		].

	"verify size: "
	self assert: result size = (collection size - 1).! !

!StringTest methodsFor: 'testing - tokenizing' stamp: 'StephaneDucasse 5/28/2011 13:50'!
testFindTokensEscapedBy13

	| tokens |
	string := 'one, two# three; four. five'.
	tokens := string findTokens: ',#;.' escapedBy: nil.
	self assert: tokens size = 5.
	self assert: tokens third = ' three'! !

!StringTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedCollectionWithSortBlock
	| result tmp |
	result := self collectionWithSortableElements  asSortedCollection: [:a :b | a > b].
	self assert: (result class includesBehavior: SortedCollection).
	result do: 
		[ :each | 
		self assert: (self collectionWithSortableElements   occurrencesOf: each) = (result occurrencesOf: each) ].
	self assert: result size = self collectionWithSortableElements  size.
	tmp:=result at: 1.
	result do: [:each| self assert: tmp>=each. tmp:=each].
	! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureTConvertAsSetForMultiplinessTest
	"a collection  with equal elements:"

	| res |
	self withEqualElements.
	res := true.
	self withEqualElements detect: [ :each | (self withEqualElements occurrencesOf: each) > 1 ] ifNone: [ res := false ].
	self assert: res = true! !

!StringTest methodsFor: 'tests - sorting' stamp: ''!
testSortedUsingBlock
	| result tmp |
	result := self unsortedCollection sorted:  [:a :b | a>b]..
	tmp := result at: 1.
	result do:
		[:each | self assert: each<=tmp. tmp:= each. ].! !

!StringTest methodsFor: 'tests - index access' stamp: ''!
testIdentityIndexOf
	"self debug: #testIdentityIndexOf"
	| collection element |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection identityIndexOf: element) = (collection indexOf: element)! !

!StringTest methodsFor: 'test - creation' stamp: ''!
testWithAll
	"self debug: #testWithAll"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection .
	aCol := self collectionClass withAll: collection  .
	
	collection do: [ :each | self assert: (aCol occurrencesOf: each ) = ( collection occurrencesOf: each ) ].
	
	self assert: (aCol size = collection size ).! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIndexAccessTest
	| res collection element |
	self collectionMoreThan1NoDuplicates.
	self assert: self collectionMoreThan1NoDuplicates size > 1.
	res := true.
	self collectionMoreThan1NoDuplicates
		detect: [ :each | (self collectionMoreThan1NoDuplicates occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false.
	self elementInForIndexAccessing.
	self
		assert: ((collection := self collectionMoreThan1NoDuplicates) includes: (element := self elementInForIndexAccessing)).
	self elementNotInForIndexAccessing.
	self deny: (self collectionMoreThan1NoDuplicates includes: self elementNotInForIndexAccessing)! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureOccurrencesTest
	| tmp |
	self empty.
	self assert: self empty isEmpty.
	self collectionWithoutEqualElements.
	self deny: self collectionWithoutEqualElements isEmpty.
	tmp := OrderedCollection new.
	self collectionWithoutEqualElements
		do: [ :each | 
			self deny: (tmp includes: each).
			tmp add: each ].
	self elementNotInForOccurrences.
	self deny: (self collectionWithoutEqualElements includes: self elementNotInForOccurrences)! !

!StringTest methodsFor: 'testing - tokenizing' stamp: 'fbs 2/13/2006 22:19'!
testFindTokensEscapedBy25

	| tokens |
	string := 'this, /is, a"," test/'.
	tokens := string findTokens: $, escapedBy: $/.
	self assert: tokens size = 2.
	self assert: tokens first = 'this'.
	self assert: tokens second = ' is, a"," test'.! !

!StringTest methodsFor: 'testing - converting' stamp: 'SvenVanCaekenberghe 1/17/2013 10:00'!
testWithoutPeriodSuffix
	#( 
		'foo' 'foo'
		'foo.' 'foo'
		'foo.bar' 'foo'
		'foo.bar.txt' 'foo'
		'' ''
		'.' '.'
	) pairsDo: [ :input :output |
		self assert: input withoutPeriodSuffix equals: output ]
	! !

!StringTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyCreatesNewObject
	"self debug: #testCopyCreatesNewObject"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: self nonEmpty == copy.
	! !

!StringTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithDo
	
	| firstCollection secondCollection index |

	firstCollection := self nonEmptyMoreThan1Element.
	secondCollection := firstCollection copy.
	index := 0.
	
	firstCollection  with: secondCollection do:
		[:a :b |
		( index := index + 1).
		self assert: (firstCollection at: index) equals:  a. 
		self assert: (secondCollection at: index) equals:  b.]
	
	! !

!StringTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testAllButFirstDo
	
	| result |
	result:= OrderedCollection  new.
	
	self nonEmptyMoreThan1Element  allButFirstDo: [:each | result add: each].
	
	1 to: (result size) do:
		[:i|
		self assert: (self nonEmptyMoreThan1Element  at:(i +1))=(result at:i)].
	
	self assert: result size=(self nonEmptyMoreThan1Element  size-1).! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 14:33'!
secondCollection
" return a collection that will be the second part of the concatenation"
	^ nonEmpty1element ! !

!StringTest methodsFor: 'testing - tokenizing' stamp: 'StephaneDucasse 5/28/2011 13:49'!
testFindTokensEscapedBy08

	| tokens |
	string := 'this, is, ##a, test'.
	tokens := string findTokens: ',' escapedBy: '#'.
	self assert: tokens size = 4.
	self assert: tokens third = ' a'.
	self assert: tokens fourth = ' test'! !

!StringTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithDoError
	
	self should: [self nonEmptyMoreThan1Element with: self empty do:[:a :b | ]] raise: Error.! !

!StringTest methodsFor: 'tests - element accessing' stamp: ''!
testAtWrap
	"self debug: #testAt"
	"
	self assert: (self accessCollection at: 1) = 1.
	self assert: (self accessCollection at: 2) = 2.
	"
	| index |
	index := self moreThan4Elements indexOf: self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: index) = self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: index + self moreThan4Elements size) = self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: index - self moreThan4Elements size) = self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: 1 + self moreThan4Elements size) = (self moreThan4Elements at: 1)! !

!StringTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithout
	"self debug: #testCopyNonEmptyWithout"
	
	| res anElementOfTheCollection |
	anElementOfTheCollection :=  self nonEmpty anyOne.
	res := (self nonEmpty copyWithout: anElementOfTheCollection).
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self deny: (res includes: anElementOfTheCollection).
	self nonEmpty do:
		[:each | (each = anElementOfTheCollection) 
					ifFalse: [self assert: (res includes: each)]].
	
! !

!StringTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutNotIncluded
	"self debug: #testCopyNonEmptyWithoutNotIncluded"
	| res |
	res := self nonEmpty copyWithout: self elementToAdd.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self nonEmpty do: [ :each | self assert: (res includes: each) ]! !

!StringTest methodsFor: 'tests - concatenation' stamp: ''!
testConcatenation
	| result index |
	result:= self firstCollection,self secondCollection .
	"first part : "
	index := 1.
	self firstCollection do: 
		[:each | 
		self assert: (self firstCollection at: index)=each.
		index := index+1.].
	"second part : "
	1 to: self secondCollection size do:
		[:i | 
		self assert: (self secondCollection at:i)= (result at:index).
		index:=index+1].
	"size : "
	self assert: result size = (self firstCollection size + self secondCollection size).! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 16:54'!
sortedInAscendingOrderCollection
" return a collection sorted in an acsending order"
	^nonEmpty5ElementsSorted 
	! !

!StringTest methodsFor: 'tests - line breaking' stamp: 'MarcusDenker 6/24/2013 11:09'!
testLinesDoWithCr

	| myString  |
	myString := 'This is a test of line breaking', String cr.
	myString linesDo: [ :line |
		self assert: ((line size + 1) = myString size)]! !

!StringTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionItself
	"self debug: #testIntersectionItself"
	
	| result |
	result :=  (self collectionWithoutEqualElements intersection: self collectionWithoutEqualElements).
	self assert: result size  = self collectionWithoutEqualElements size.
	self collectionWithoutEqualElements do: [ :each|
		self assert: (result includes: each) ].
	! !

!StringTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testKeysAndValuesDo
	"| result |
	result:= OrderedCollection new.
	
	self nonEmptyMoreThan1Element  keysAndValuesDo: 
		[:i :value|
		result add: (value+i)].
	
	1 to: result size do:
		[:i|
		self assert: (result at:i)=((self nonEmptyMoreThan1Element at:i)+i)]"
	|  indexes elements |
	indexes:= OrderedCollection new.
	elements := OrderedCollection new.
	
	self nonEmptyMoreThan1Element  keysAndValuesDo: 
		[:i :value|
		indexes  add: (i).
		elements add: value].
	
	(1 to: self nonEmptyMoreThan1Element size )do:
		[ :i |
		self assert: (indexes at: i) = i.
		self assert: (elements at: i) = (self nonEmptyMoreThan1Element at: i).	
		].
	
	self assert: indexes size = elements size. 
	self assert: indexes size = self nonEmptyMoreThan1Element size . 
	
	! !

!StringTest methodsFor: 'tests - converting' stamp: ''!
testAsOrderedCollection
	
	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: OrderedCollection! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 5/13/2009 15:59'!
elementTwiceInForOccurrences
" return an element included exactly two time in # collectionWithEqualElements"
^ sameAtEndAndBegining first .! !

!StringTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOf
	| collection |
	collection := self collectionWithoutEqualElements .
	
	collection do: [ :each | self assert: (collection occurrencesOf: each) = 1 ].! !

!StringTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:53'!
test0CopyTest
	self empty.
	self assert: self empty size = 0.
	self nonEmpty.
	self assert: (self nonEmpty size = 0) not.
	self collectionWithElementsToRemove.
	self assert: (self collectionWithElementsToRemove size = 0) not.
	self elementToAdd! !

!StringTest methodsFor: 'tests - streaming' stamp: ''!
testStreamContentsProtocol
	| result index |
	result:= self collectionClass << [ :s|
		s 
			nextPutAll: self firstCollection;
			nextPutAll: self secondCollection ].
	self assert: result equals: self firstCollection, self secondCollection.! !

!StringTest methodsFor: 'tests - as class' stamp: 'CamilloBruni 5/8/2013 11:34'!
testAsClass
	self 
		assert: 'String' asClass
		equals: String! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 11:31'!
indexInNonEmpty
" return an index between bounds of 'nonEmpty' "

	^ 2.! !

!StringTest methodsFor: 'tests - converting' stamp: 'sd 6/5/2005 09:27'!
testCapitalized

	| uc lc empty |		
	uc := 'MElViN'.
	lc := 'mElViN'.
	empty := ' '.
	self assert:  lc capitalized = uc.
	self assert: uc capitalized = uc.
	"the string gets copied"
	self deny: uc capitalized == uc.
	self deny: empty capitalized == empty.! !

!StringTest methodsFor: 'tests - begins ends with' stamp: ''!
testsBeginsWithEmpty
	
	self deny: (self nonEmpty beginsWith:(self empty)).
	self deny: (self empty beginsWith:(self nonEmpty )).
! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSequencedConcatenationTest
	self empty.
	self assert: self empty isEmpty.
	self firstCollection.
	self secondCollection! !

!StringTest methodsFor: 'tests - begins ends with' stamp: ''!
testsBeginsWith
	
	self assert: (self nonEmpty beginsWith:(self nonEmpty copyUpTo: self nonEmpty last)).
	self assert: (self nonEmpty beginsWith:(self nonEmpty )).
	self deny: (self nonEmpty beginsWith:(self nonEmpty copyWith:self nonEmpty first)).! !

!StringTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedCollection

	| aCollection result |
	aCollection := self collectionWithSortableElements .
	result := aCollection asSortedCollection.
	
	self assert: (result class includesBehavior: SortedCollection).
	result do: 
		[ :each | 
		self assert: (aCollection occurrencesOf: each) = (result occurrencesOf: each) ].
	
	self assert: result size = aCollection size.! !

!StringTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWithout
	"self debug: #testCopyEmptyWithout"
	| res |
	res := self empty copyWithout: self elementToAdd.
	self assert: res size = self empty size.
	self deny: (res includes: self elementToAdd)! !

!StringTest methodsFor: 'tests - equality' stamp: ''!
testHasEqualElements
	"self debug: #testHasEqualElements"

	self deny: (self empty hasEqualElements: self nonEmpty).
	self deny: (self nonEmpty hasEqualElements: self nonEmpty asSet). 
	self deny: (self nonEmpty reversed hasEqualElements: self nonEmpty).
	self deny: (self nonEmpty hasEqualElements: self nonEmpty reversed).! !

!StringTest methodsFor: 'tests - equality' stamp: ''!
testHasEqualElementsIsTrueForNonIdenticalButEqualCollections
	"self debug: #testHasEqualElementsIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty hasEqualElements: self empty copy). 
	self assert: (self empty copy hasEqualElements: self empty).
	self assert: (self empty copy hasEqualElements: self empty copy).
		
	self assert: (self nonEmpty hasEqualElements: self nonEmpty copy). 
	self assert: (self nonEmpty copy hasEqualElements: self nonEmpty).
	self assert: (self nonEmpty copy hasEqualElements: self nonEmpty copy).! !

!StringTest methodsFor: 'test - set arithmetic' stamp: 'stephane.ducasse 12/20/2008 21:57'!
collectionClass

	^ String! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 10:26'!
nonEmpty1Element
" return a collection of size 1 including one element"
	^ nonEmpty1element ! !

!StringTest methodsFor: 'test - equality' stamp: ''!
testEqualSign
	"self debug: #testEqualSign"

	self deny: (self empty = self nonEmpty).! !

!StringTest methodsFor: 'tests - set arithmetic' stamp: ''!
testUnion
	"self debug: #testUnionOfEmpties"
	
	| union |
	union := self empty union: self nonEmpty.
	self containsAll: union of: self empty andOf: self nonEmpty.
	union := self nonEmpty union: self empty.
	self containsAll: union of: self empty andOf: self nonEmpty.
	union := self collection union: self nonEmpty.
	self containsAll: union of: self collection andOf: self nonEmpty.! !

!StringTest methodsFor: 'tests - copying with replacement' stamp: ''!
testCopyReplaceFromToWith
	| result  indexOfSubcollection lastIndexOfOldSubcollection lastIndexOfReplacementCollection |
	
	indexOfSubcollection := (self firstIndexesOf: self oldSubCollection  in:  self collectionWith1TimeSubcollection) at: 1. 
	lastIndexOfOldSubcollection := indexOfSubcollection + self oldSubCollection size -1.
	lastIndexOfReplacementCollection := indexOfSubcollection + self replacementCollection  size -1.
	
	result := self collectionWith1TimeSubcollection  copyReplaceFrom: indexOfSubcollection  to: lastIndexOfOldSubcollection   with: self replacementCollection .
	
	"verify content of 'result' : "
	"first part of 'result'  "
	
	1 to: (indexOfSubcollection  - 1) do: 
		[ 
		:i | 
		self assert: (self collectionWith1TimeSubcollection  at:i) = (result at: i)
		].
	
	" middle part containing replacementCollection : "
	
	(indexOfSubcollection ) to: ( lastIndexOfReplacementCollection  ) do: 
		[
		:i |
		self assert: (result at: i)=(self replacementCollection at: (i - indexOfSubcollection +1))
		].
	
	" end part :"
	1 to: (result size - lastIndexOfReplacementCollection   ) do:
		[ 
		:i |
		self assert: (result at: ( lastIndexOfReplacementCollection  + i  ) ) = (self collectionWith1TimeSubcollection  at: ( lastIndexOfOldSubcollection  + i  ) ).
		].
	
	
	

	
	! !

!StringTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testDo! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
test0TSequencedStructuralEqualityTest
	self nonEmpty at: 1	"Ensures #nonEmpty is sequenceable"! !

!StringTest methodsFor: 'testing - tokenizing' stamp: 'StephaneDucasse 5/28/2011 13:50'!
testFindTokensEscapedBy12

	| tokens |
	string := 'one, two# three; four. five'.
	tokens := string findTokens: ',#;.' escapedBy: '"'.
	self assert: tokens size = 5.
	self assert: tokens third = ' three'! !

!StringTest methodsFor: 'tests - copying' stamp: 'CamilloBruni 9/5/2011 10:55'!
testTrimmed
	self assert: '  a  ' trimmed = 'a'.! !

!StringTest methodsFor: 'tests - copying same contents' stamp: ''!
testShuffled
	| result |
	result := self nonEmpty shuffled .
	
	"verify content of 'result: '"
	result do: [:each | self assert: (self nonEmpty occurrencesOf: each)=(result occurrencesOf: each)].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!StringTest methodsFor: 'tests - copy' stamp: ''!
testCopySameClass
	"self debug: #testCopySameClass"
	"A copy of a collection should always be of the same class as the instance it copies"
	
	| copy | 
	copy := self empty copy.
	self assert: copy class == self empty class.! !

!StringTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/14/2013 13:44'!
testReadFrom
	self 
		assert: (String readFrom: ($' asString, 'foo', $' asString) readStream)
		equals: 'foo'.
	self 
		assert: (String readFrom: ($' asString, 'this ', $' asString, $' asString, ' is embedded', $' asString) readStream)
		equals: 'this '' is embedded'.
	self 
		assert: (String readFrom: ('<whitespace>', $' asString, 'foo', $' asString, '<whitespace>') readStream)
		equals: 'foo'.
	self
		assert: (String readFrom: 'this '' is embedded' printString readStream)
		equals: 'this '' is embedded'! !

!StringTest methodsFor: 'tests - converting' stamp: 'BernardoContreras 8/11/2014 19:13'!
testUncapitalized

	| uc lc empty |		
	uc := 'MElViN'.
	lc := 'mElViN'.
	empty := ' '.
	self assert:  uc uncapitalized = lc.
	self assert: lc uncapitalized = lc.
	"the string gets copied"
	self deny: lc uncapitalized == lc.
	self deny: empty uncapitalized == empty.! !

!StringTest methodsFor: 'tests - element accessing' stamp: ''!
testAfter
	"self debug: #testAfter"
	self assert: (self moreThan4Elements after: (self moreThan4Elements at: 1)) = (self moreThan4Elements at: 2).
	self 
		should: 
			[ self moreThan4Elements after: (self moreThan4Elements at: self moreThan4Elements size) ]
		raise: Error.
	self 
		should: [ self moreThan4Elements after: self elementNotInForElementAccessing ]
		raise: Error! !

!StringTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfter
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyAfter: (collection  at:index ).
	
	"verifying content: "
	(1) to: result size do: 
		[:i |
		self assert: (collection   at:(i + index ))=(result at: (i))].

	"verify size: "
	self assert: result size = (collection   size - index).! !

!StringTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButFirstNElements
	"self debug: #testAllButFirst"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButFirst: 2.
	1 
		to: abf size
		do: [ :i | self assert: (abf at: i) = (col at: i + 2) ].
	self assert: abf size + 2 = col size! !

!StringTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 12/18/2009 13:43'!
oldSubCollection
" return a subCollection included in collectionWith1TimeSubcollection .
ex :   subCollection := #( 2 3 4) and collectionWith1TimeSubcollection := #(1 2 3 4 5)"
	^ subcollection3ElementsSorted  ! !

!StringTest methodsFor: 'tests - sorting' stamp: ''!
testIsSortedBy
	self assert: (self sortedInAscendingOrderCollection isSortedBy: [:a :b | a<b]).
	self deny: (self sortedInAscendingOrderCollection isSortedBy: [:a :b | a>b]).
! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
test0FixturePrintTest
	self nonEmpty! !

!StringTest methodsFor: 'testing - lines' stamp: 'nice 11/16/2009 13:22'!
testLineCorrespondingToIndex
	| sampleCRString sampleLFString sampleCRLFString anIndex |
	sampleCRString := 'Fred', String cr , 'the' , String cr , 'Bear'.
	sampleLFString := 'Fred', String lf , 'the' , String lf , 'Bear'.
	sampleCRLFString := 'Fred', String crlf , 'the' , String crlf , 'Bear'.
	
	anIndex := sampleCRString indexOf: $h.
	self assert: (sampleCRString lineCorrespondingToIndex: anIndex) = 'the'.
	anIndex := sampleLFString indexOf: $h.
	self assert: (sampleLFString lineCorrespondingToIndex: anIndex) = 'the'.
	anIndex := sampleCRLFString indexOf: $h.
	self assert: (sampleCRLFString lineCorrespondingToIndex: anIndex) = 'the'.
	
	anIndex := sampleCRString indexOf: $B.
	self assert: (sampleCRString lineCorrespondingToIndex: anIndex) = 'Bear'.
	anIndex := sampleLFString indexOf: $B.
	self assert: (sampleLFString lineCorrespondingToIndex: anIndex) = 'Bear'.
	anIndex := sampleCRLFString indexOf: $B.
	self assert: (sampleCRLFString lineCorrespondingToIndex: anIndex) = 'Bear'.
	
	anIndex := sampleCRString indexOf: $d.
	self assert: (sampleCRString lineCorrespondingToIndex: anIndex) = 'Fred'.
	anIndex := sampleLFString indexOf: $d.
	self assert: (sampleLFString lineCorrespondingToIndex: anIndex) = 'Fred'.
	anIndex := sampleCRLFString indexOf: $d.
	self assert: (sampleCRLFString lineCorrespondingToIndex: anIndex) = 'Fred'.! !

!StringTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testReverseWithDo
	
	| firstCollection secondCollection index |

	firstCollection := self nonEmptyMoreThan1Element.
	secondCollection := firstCollection copy.
	index := firstCollection size.
	
	firstCollection  reverseWith: secondCollection do:
		[:a :b |
	
		self assert: (firstCollection at: index) equals:  a. 
		self assert: (secondCollection at: index) equals:  b.
			( index := index - 1).]
	
	
	! !

!StringTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyFromTo
	| result  index collection |
	collection := self collectionWithoutEqualElements .
	index :=self indexInForCollectionWithoutDuplicates .
	result := collection   copyFrom: index  to: collection  size .
	
	"verify content of 'result' : "
	1 to: result size do:
		[:i | 
		self assert: (result at:i)=(collection  at: (i + index - 1))].
	
	"verify size of 'result' : "
	self assert: result size = (collection  size - index + 1).! !

!StringTest methodsFor: 'testing - tokenizing' stamp: 'StephaneDucasse 5/28/2011 13:47'!
testFindTokensEscapedBy21

	| tokens |
	string := 'this, is, "a, test"'.
	tokens := string findTokens: $, escapedBy: $".
	self assert: tokens size = 3! !

!StringTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAllNoneThere
	"self debug: #testIncludesAllOfNoneThere'"
	self deny: (self empty includesAll: self nonEmpty ).
	self deny: (self nonEmpty includesAll: { self elementNotIn. self anotherElementNotIn })! !

!StringTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfStartingAt
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			indexOf: element
			startingAt: 2
			ifAbsent: [ 99 ]) = 99.
	self assert: (collection 
			indexOf: element
			startingAt: 1
			ifAbsent: [ 99 ]) = 1.
	self assert: (collection 
			indexOf: self elementNotInForIndexAccessing
			startingAt: 1
			ifAbsent: [ 99 ]) = 99! !

!StringTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testKeysAndValuesDoEmpty
	| result |
	result:= OrderedCollection new.
	
	self empty  keysAndValuesDo: 
		[:i :value|
		result add: (value+i)].
	
	self assert: result isEmpty .! !

!StringTest methodsFor: 'testing' stamp: 'StephaneDucasse 6/11/2010 12:35'!
testIsAllDigits
	"self run: #testIsAllDigits"
	self assert: '' isAllDigits = false.
	self assert: '1.23' isAllDigits = false.
	self assert: '12 3' isAllDigits = false.
	self assert: '-123' isAllDigits = false.
	self assert: '0123456789' isAllDigits = true.! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 10:41'!
elementNotInForElementAccessing
" return an element not included in 'moreThan4Elements' "
	^ notIn ! !

!StringTest methodsFor: 'tests - as set tests' stamp: ''!
testAsSetWithEqualsElements
	| result |
	result := self withEqualElements asSet.
	self withEqualElements do: [ :each | self assert: (result occurrencesOf: each) = 1 ].
	self assert: result class = Set! !

!StringTest methodsFor: 'tests - printing' stamp: ''!
testPrintOnDelimiterLast

	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printOn: aStream delimiter: ', ' last: 'and'.
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 )
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString)].
		i=(allElementsAsString size-1)
			ifTrue:[ self deny: (allElementsAsString at:i)=('and')asString].
		i=(allElementsAsString size)
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:(i-1))asString)].
			].! !

!StringTest methodsFor: 'tests - converting' stamp: ''!
testAsBag

	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: Bag! !

!StringTest methodsFor: 'testing' stamp: 'PabloHerrero 2/16/2015 17:42'!
testIsPatternVariable

	self assert: '`pattern' isPatternVariable.
	self assert: '`pattern:' isPatternVariable.
	self assert: '`pattern:`varible:' isPatternVariable.
	self assert: 'pattern:`varible:' isPatternVariable.
	
	self deny: 'notAPattern:varible:' isPatternVariable.
	self deny: 'notAPattern' isPatternVariable.
		
! !

!StringTest methodsFor: 'tests - copying part of sequenceable for multipliness' stamp: ''!
testCopyAfterLastWithDuplicate
	| result element  collection |
	collection := self collectionWithSameAtEndAndBegining .
	element := collection  first.
	
	" collectionWithSameAtEndAndBegining first and last elements are equals.
	'copyAfter:' should copy after the last occurence of element :"
	result := collection   copyAfterLast: (element ).
	
	"verifying content: "
	self assert: result isEmpty.

! !

!StringTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWith
	"self debug: #testCopyWith"
	| res anElement |
	anElement := self elementToAdd.
	res := self empty copyWith: anElement.
	self assert: res size = (self empty size + 1).
	self assert: (res includes: (anElement value))! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 11:28'!
indexInForCollectionWithoutDuplicates
" return an index between 'collectionWithoutEqualsElements'  bounds"
	^ 2! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
howMany: aSubCollection in: collection
" return an integer representing how many time 'subCollection'  appears in 'collection'  "
	| tmp nTime |
	tmp := collection.
	nTime:= 0.
	
	[tmp isEmpty ]whileFalse:
		[
		(tmp beginsWith: aSubCollection)
			ifTrue: [ 	
				nTime := nTime + 1.
				1 to: aSubCollection size do: [:i | tmp := tmp copyWithoutFirst.]
				]
			ifFalse: [tmp := tmp copyWithoutFirst.]
		 ].
	
	^ nTime.
	! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureConverAsSortedTest
	self collectionWithSortableElements.
	self deny: self collectionWithSortableElements isEmpty! !

!StringTest methodsFor: 'testing - tokenizing' stamp: 'StephaneDucasse 5/28/2011 13:47'!
testFindTokensEscapedBy11

	| tokens |
	string := 'this, is, """a, test"'.
	tokens := string findTokens: ',' escapedBy: '"'.
	self assert: tokens size = 3.
	self assert: tokens third = ' "a, test'! !

!StringTest methodsFor: 'testing - converting' stamp: 'StephaneDucasse 10/1/2014 08:06'!
testWithFirstCharacterDownshifted

	| uc lc empty |		
	uc := 'MElViN'.
	lc := 'mElViN'.
	empty := ' '.
	self assert:  uc uncapitalized  = lc.
	self assert: lc uncapitalized = lc.
	"the string gets copied"
	self deny: lc uncapitalized == lc.
	self deny: empty uncapitalized == empty.! !

!StringTest methodsFor: 'tests - printing' stamp: ''!
testStoreOn
" for the moment work only for collection that include simple elements such that Integer"

"| string str result cuttedResult index elementsAsStringExpected elementsAsStringObtained tmp |
string := ''.
str := ReadWriteStream  on: string.
elementsAsStringExpected := OrderedCollection new.
elementsAsStringObtained := OrderedCollection new.
self nonEmpty do: [ :each | elementsAsStringExpected  add: each asString].

self nonEmpty storeOn: str.
result := str contents .
cuttedResult := ( result findBetweenSubStrs: ';' ).

index := 1.

cuttedResult do:
	[ :each |
	index = 1 
		ifTrue: [ self assert: (each beginsWith: ( tmp := '((' , self nonEmpty class asString , ' new) add: '           )).
				tmp := each copyFrom: ( tmp size + 1) to: ( each size ).
				elementsAsStringObtained add: tmp.
				index := index + 1. ]
		ifFalse:  [ 
		 index < cuttedResult size
			ifTrue:[self assert: (each beginsWith: ( tmp:=  ' add: '   )).
				tmp := each copyFrom: ( tmp size + 1) to: ( each size ).
				elementsAsStringObtained add: tmp.
					index := index + 1.]
			ifFalse: [self assert: ( each = ' yourself)' ) ].
			]
	
	].


	elementsAsStringExpected do: [ :each | self assert: (elementsAsStringExpected occurrencesOf: each ) = ( elementsAsStringObtained occurrencesOf: each) ]"

! !

!StringTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfStartingAtIfAbsent
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			indexOf: element
			startingAt: 2
			ifAbsent: [ 99 ]) = 99.
	self assert: (collection 
			indexOf: element
			startingAt: 1
			ifAbsent: [ 99 ]) = 1.
	self assert: (collection 
			indexOf: self elementNotInForIndexAccessing
			startingAt: 1
			ifAbsent: [ 99 ]) = 99! !

!StringTest methodsFor: 'tests - replacing' stamp: ''!
testReplaceAllWith
	| result  collection oldElement newElement oldOccurrences |
	collection := self nonEmpty .
	result := collection  copy.
	oldElement := self elementInForReplacement .
	newElement := self newElement .
	oldOccurrences := (result occurrencesOf: oldElement) + (result occurrencesOf: newElement).
	result replaceAll: oldElement  with: newElement  .
	
	self assert: oldOccurrences = (result occurrencesOf: newElement)! !

!StringTest methodsFor: 'tests - line breaking' stamp: 'MarcusDenker 6/24/2013 11:10'!
testLinesDoWithCrLfBetween

	| aString |
	aString := '-This is a test-', String crlf,'of line breaking'.
	aString linesDo: [ :line |
		self assert: ((line size) = 16)]! !

!StringTest methodsFor: 'tests - set arithmetic' stamp: ''!
numberOfSimilarElementsInIntersection
	^ self collection occurrencesOf: self anotherElementOrAssociationIn! !

!StringTest methodsFor: 'tests - occurrencesOf for multipliness' stamp: ''!
testOccurrencesOfForMultipliness

| collection elem |
collection := self collectionWithEqualElements .
elem := self elementTwiceInForOccurrences .

self assert: (collection occurrencesOf: elem ) = 2.  ! !

!StringTest methodsFor: 'tests - element accessing' stamp: ''!
testAtAll
	"self debug: #testAtAll"
	"	self flag: #theCollectionshouldbe102030intheFixture.
	
	self assert: (self accessCollection atAll: #(2 1)) first = self accessCollection second.
	self assert: (self accessCollection atAll: #(2)) first = self accessCollection second."
	| result |
	result := self moreThan4Elements atAll: #(2 1 2 ).
	self assert: (result at: 1) = (self moreThan4Elements at: 2).
	self assert: (result at: 2) = (self moreThan4Elements at: 1).
	self assert: (result at: 3) = (self moreThan4Elements at: 2).
	self assert: (self moreThan4Elements atAll: #()) = self moreThan4Elements species new! !

!StringTest methodsFor: 'tests - line breaking' stamp: 'MarcusDenker 6/24/2013 11:09'!
testLinesDoWithCrBetween

	| aString |
	aString := ' This is a test ', String cr,'of line breaking'.
	aString linesDo: [ :line |
		self assert: ((line size) = 16)]! !

!StringTest methodsFor: 'tests - converting' stamp: ''!
assertNonDuplicatedContents: aCollection whenConvertedTo: aClass 
	| result |
	result := aCollection perform: ('as' , aClass name) asSymbol.
	self assert: (result class includesBehavior: aClass).
	result do: 
		[ :each | 
		self assert: (aCollection occurrencesOf: each) = (result occurrencesOf: each) ].
	^ result! !

!StringTest methodsFor: 'tests - copying same contents' stamp: ''!
testShallowCopy
	| result |
	result := self nonEmpty shallowCopy .
	
	"verify content of 'result: '"
	1 to: self nonEmpty size do:
		[:i | self assert: ((result at:i)=(self nonEmpty at:i))].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!StringTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfIfAbsent
	"self debug: #testIndexOfIfAbsent"
	| collection |
	collection := self collectionMoreThan1NoDuplicates.
	self assert: (collection 
			indexOf: collection first
			ifAbsent: [ 33 ]) = 1.
	self assert: (collection 
			indexOf: self elementNotInForIndexAccessing
			ifAbsent: [ 33 ]) = 33! !

!StringTest methodsFor: 'testing' stamp: 'nice 10/5/2009 03:44'!
testFindLastOccurenceOfStringStartingAt

	self assert: ('Smalltalk' findLastOccurrenceOfString: 'al' startingAt: 2) = 7.
	self assert: ('aaa' findLastOccurrenceOfString: 'aa' startingAt: 1) = 2.
	self assert: ('Smalltalk' asWideString findLastOccurrenceOfString: 'al' startingAt: 2) = 7.
	self assert: ('Smalltalk' asWideString findLastOccurrenceOfString: 'al' asWideString startingAt: 2) = 7.
	self assert: (('Smalltalk' copyWith: 835 asCharacter) findLastOccurrenceOfString: 'al' asWideString startingAt: 2) = 7.! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyPartOfSequenceableTest
	self collectionWithoutEqualElements.
	self collectionWithoutEqualElements
		do: [ :each | self assert: (self collectionWithoutEqualElements occurrencesOf: each) = 1 ].
	self indexInForCollectionWithoutDuplicates.
	self
		assert:
			(self indexInForCollectionWithoutDuplicates > 0 & self indexInForCollectionWithoutDuplicates)
				< self collectionWithoutEqualElements size.
	self empty.
	self assert: self empty isEmpty! !

!StringTest methodsFor: 'tests - converting' stamp: ''!
testAsIdentitySet
	"test with a collection without equal elements :"
	self 
		assertSameContents: self collectionWithoutEqualElements
		whenConvertedTo: IdentitySet.
! !

!StringTest methodsFor: 'test-comparing' stamp: 'lr 7/7/2006 11:32'!
testComparing
	self assert: 'foo' < 'foo:'.
	self assert: 'foo' < 'fooBar'.
	self assert: 'foo' <= 'foo:'.
	self assert: 'foo' <= 'fooBar'.
	self assert: 'foo:' > 'foo'.
	self assert: 'fooBar' > 'foo'.
	self assert: 'foo:' >= 'foo'.
	self assert: 'fooBar' >= 'foo'! !

!StringTest methodsFor: 'tests - converting' stamp: ''!
testAsSet
	| |
	"test with a collection without equal elements :"
	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: Set.
	! !

!StringTest methodsFor: 'test - creation' stamp: ''!
testWithWithWith
	"self debug: #testWithWithWith"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom:1 to: 3 .
	aCol := self collectionClass with: (collection at:1) with: ( collection at:2 ) with: ( collection at: 3).

	1 to: 3 do: [ :i | self assert: ( aCol occurrencesOf: ( collection at: i ) ) = ( collection occurrencesOf: ( collection at: i ) ) ].! !

!StringTest methodsFor: 'testing - internet' stamp: 'ul 11/23/2009 14:39'!
testWithInternetLineEndings

	{
		'abc' -> 'abc'.
		'abc', String cr -> ('abc', String crlf).
		'abc', String lf -> ('abc', String crlf).
		'abc', String crlf -> ('abc', String crlf).
		String cr, 'abc' -> (String crlf, 'abc').
		String lf, 'abc' -> (String crlf, 'abc').
		String crlf, 'abc' -> (String crlf, 'abc').
		'abc', String cr, String cr, 'abc' -> ('abc', String crlf, String crlf, 'abc').
		'abc', String lf, String lf, 'abc' -> ('abc', String crlf, String crlf, 'abc').
		'abc', String crlf, String crlf, 'abc' -> ('abc', String crlf, String crlf, 'abc').
		String cr, 'abc', String cr, String crlf, 'abc', String lf -> (String crlf, 'abc', String crlf, String crlf, 'abc', String crlf).
		String lf, 'abc', String lf, String crlf, 'abc', String cr -> (String crlf, 'abc', String crlf, String crlf, 'abc', String crlf).
	} do: [ :each |
		self assert: each key withInternetLineEndings = each value ]! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyWithOrWithoutSpecificElementsTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self indexInNonEmpty.
	self assert: self indexInNonEmpty > 0.
	self assert: self indexInNonEmpty <= self nonEmpty size! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 10:32'!
elementNotInForIndexAccessing
" return an element not included in 'accessCollection' "
	^ notIn ! !

!StringTest methodsFor: 'test-comparing' stamp: 'ul 1/15/2011 13:30'!
testMatch

	#('**' 'f**'  'f**o' 'f*' '*f*' 'f#*' 'f##' '*oo' '#oo' '*o*' '#o#' '#o*' '*o#' 'fo*' 'fo#' '*foo*' '###' '*#'  'f*#' 'f*#o')
		do: [ :each | self assert: (each match: 'foo') ].
	#('bar' 'foo#' '#foo' '*foo#' '#foo*' '*bar*') do: [ :each |
		self deny: (each match: 'foo') ]! !

!StringTest methodsFor: 'tests - converting' stamp: 'dc 4/10/2007 09:35'!
testUpTo
	"self debug: #testUpTo"
	self assert: #up:to: keywords = #(up: to:).
	self assert: #copy:from:to: keywords = #(copy: from: to:).
	self assert: #up keywords = #(up).
	self assert: #at: keywords = #(at:).
	! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 16:52'!
firstCollection
	" return a collection that will be the first part of the concatenation"
	^ nonEmpty5ElementsSorted! !

!StringTest methodsFor: 'tests - streaming' stamp: ''!
testStreamContentsSized
	| result |
	result:= self collectionClass new: 1 streamContents: [ :s|
		s 
			nextPutAll: self firstCollection;
			nextPutAll: self secondCollection ].
	self assert: result equals: self firstCollection, self secondCollection.
	
	result:= self collectionClass new: 1000 streamContents: [ :s|
		s 
			nextPutAll: self firstCollection;
			nextPutAll: self secondCollection ].
	self assert: result equals: self firstCollection, self secondCollection.! !

!StringTest methodsFor: 'testing - converting' stamp: 'SvenVanCaekenberghe 1/17/2013 10:20'!
testWithoutLeadingDigits
	#( 
		'foo' 'foo'
		'123foo' 'foo'
		'123 bar7' 'bar7'
		' 123 	bar7' 'bar7'
		'foo.123.txt' 'foo.123.txt'
		'' ''
		'1' ''
		'1 2 3 ' ''
	) pairsDo: [ :input :output |
		self assert: input withoutLeadingDigits equals: output ]
	! !

!StringTest methodsFor: 'testing - lines' stamp: 'nice 11/16/2009 13:19'!
testLinesDo
	| sampleCRString sampleLFString sampleCRLFString lines |
	sampleCRString := 'Fred', String cr , 'the' , String cr , 'Bear'.
	sampleLFString := 'Fred', String lf , 'the' , String lf , 'Bear'.
	sampleCRLFString := 'Fred', String crlf , 'the' , String crlf , 'Bear'.
	
	lines := OrderedCollection new.
	sampleCRString linesDo: [:aLine |
		self deny: (aLine includes: Character cr).
		self deny: (aLine includes: Character lf).
		lines add: aLine].
	self assert: lines asArray = #('Fred' 'the' 'Bear').
	
	lines := OrderedCollection new.
	sampleLFString linesDo: [:aLine |
		self deny: (aLine includes: Character cr).
		self deny: (aLine includes: Character lf).
		lines add: aLine].
	self assert: lines asArray = #('Fred' 'the' 'Bear').

	lines := OrderedCollection new.
	sampleCRLFString linesDo: [:aLine |
		self deny: (aLine includes: Character cr).
		self deny: (aLine includes: Character lf).
		lines add: aLine].
	self assert: lines asArray = #('Fred' 'the' 'Bear').

! !

!StringTest methodsFor: 'testing - tokenizing' stamp: 'fbs 2/13/2006 22:19'!
testFindTokensEscapedBy05

	| tokens |
	string := 'this, /is, a"," test/'.
	tokens := string findTokens: ',#' escapedBy: '"/'.
	self assert: tokens size = 2.
	self assert: tokens first = 'this'.
	self assert: tokens second = ' is, a"," test'.! !

!StringTest methodsFor: 'tests - includes' stamp: ''!
testIncludesElementIsThere
	"self debug: #testIncludesElementIsThere"
	
	self assert: (self nonEmpty includes: self nonEmpty anyOne).! !

!StringTest methodsFor: 'testing - tokenizing' stamp: 'StephaneDucasse 5/28/2011 13:47'!
testFindTokensEscapedBy26

	| tokens |
	string := 'this, is, "a, test'.
	tokens := string findTokens: $, escapedBy: $".
	self assert: tokens size = 3.
	self assert: tokens third = ' a, test'! !

!StringTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifferenceWithSeparateCollection
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifferenceWithSeparateCollection"
	| res separateCol |
	
	separateCol := self collectionClass with: self anotherElementOrAssociationNotIn.
	res := self collectionWithoutEqualElements difference: separateCol.
	
	self deny: (res includes: self anotherElementOrAssociationNotIn).
	self assert: res size equals: self collectionWithoutEqualElements size.
	
	self collectionWithoutEqualElements do: [ :each|
		self assert: (res includes: each)].
	
	res := separateCol difference: self collection.
	self deny: (res includes: self collection anyOne).
	self assert: res equals: separateCol! !

!StringTest methodsFor: 'tests - sorting' stamp: ''!
testSortUsingSortBlock
	| result tmp |
	result := self unsortedCollection sort: [:a :b | a>b].
	tmp := result at: 1.
	result do:
		[:each | self assert: each<=tmp. tmp:= each. ].! !

!StringTest methodsFor: 'testing - formatting' stamp: 'SvenVanCaekenberghe 11/21/2012 09:13'!
testFormat

	self
		assert: ('This is {1} !!' format: #('a test'))
		equals: 'This is a test !!'.

 	{ 
 		[ '\{ \} \\ foo {1} bar {2}' format: { 12. 'string' } ] -> '{ } \ foo 12 bar string'. 
 		[ '\{ \} \\ foo {2} bar {1}' format: { 'string'. 12 } ] -> '{ } \ foo 12 bar string'. 
 		[ '\{1}' format: {} ] -> '{1}'. 
 		[ '\{1}{1}' format: { $a } ] -> '{1}a'. 
 	} do: [ :each | 
		self assert: each key value equals: each value ]! !

!StringTest methodsFor: 'testing - converting' stamp: 'SvenVanCaekenberghe 1/8/2012 14:30'!
testTrimBoth
	self assert: '' trimBoth = ''.
	self assert: ' ' trimBoth = ''.
	self assert: '	' trimBoth = ''.
	self assert: 'foo' trimBoth = 'foo'.
	self assert: ' foo ' trimBoth = 'foo'.
	self assert: '  foo  ' trimBoth = 'foo'.
	self assert: ((String with: Character cr), '   foo  ') trimBoth = 'foo'.
	
	self assert: ('aabbaa' trimBoth: [ :each | each = $a ]) = 'bb'.
	self assert: ('bbaabb' trimBoth: [ :each | each = $a ]) = 'bbaabb'! !

!StringTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfSubCollectionStartingAtIfAbsent
	"self debug: #testIndexOfIfAbsent"
	| index absent subcollection collection |
	collection := self collectionMoreThan1NoDuplicates.
	subcollection := self collectionMoreThan1NoDuplicates.
	absent := false.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 1
		ifAbsent: [ absent := true ].
	self assert: absent = false.
	absent := false.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 2
		ifAbsent: [ absent := true ].
	self assert: absent = true! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 16:52'!
collectionWithElement
	"Returns a collection that already includes what is returned by #element."
	^ nonEmpty5ElementsSorted! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 14:30'!
withEqualElements
	" return a collection  including equal elements (classic equality)"
	^ sameAtEndAndBegining 	! !

!StringTest methodsFor: 'tests - element accessing' stamp: ''!
testAtLastError
	"self debug: #testAtLast"
	self 
		should: [ self moreThan4Elements atLast: self moreThan4Elements size + 1 ]
		raise: Error! !

!StringTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpToLastEmpty
	| result |
	result := self empty copyUpToLast: self collectionWithoutEqualElements first.
	self assert: result isEmpty.! !

!StringTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpToLast
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyUpToLast: (collection  at:index).
	
	"verify content of 'result' :"
	1 to: result size do: [:i| self assert: (collection   at:i)=(result at:i)].
	
	"verify size of 'result' :"
	self assert: result size = (index-1).! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCloneTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!StringTest methodsFor: 'tests - as class' stamp: 'CamilloBruni 5/8/2013 11:56'!
testAsClassIfPresent
	
	'String' asClassIfPresent: [ :class | 
		self assert: class equals: String ].
	
	'+' asClassIfPresent: [ ^ self fail ].! !

!StringTest methodsFor: 'tests - printing' stamp: ''!
testPrintOn
	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printOn: aStream .
	allElementsAsString:=(result findBetweenSubStrs: ' ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i=1
			ifTrue:[
			self accessCollection class name first isVowel 
				ifTrue:[self assert: (allElementsAsString at:i)='an' ]
				ifFalse:[self assert: (allElementsAsString at:i)='a'].].
		i=2
			ifTrue:[self assert: (allElementsAsString at:i)=self accessCollection class name].
		i>2
			ifTrue:[self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString).].	
			].! !

!StringTest methodsFor: 'tests - at put' stamp: ''!
testAtPutTwoValues
	"self debug: #testAtPutTwoValues"
	
	self nonEmpty at: self anIndex put: self aValue.
	self nonEmpty at: self anIndex put: self anotherValue.
	self assert: (self nonEmpty at: self anIndex) = self anotherValue.! !

!StringTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpTo
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyUpTo: (collection  at:index).
	
	"verify content of 'result' :"
	1 to: result size do: [:i| self assert: (collection   at:i)=(result at:i)].
	
	"verify size of 'result' :"
	self assert: result size = (index-1).
	! !

!StringTest methodsFor: 'testing - converting' stamp: 'MarcusDenker 8/15/2010 11:07'!
testAsCamelCase

       self assert: 'A man, a plan, a canal, panama' asCamelCase = 'AMan,APlan,ACanal,Panama'.
       self assert: 'Here 123should % be 6 the name6 of the method' asCamelCase = 'Here123should%Be6TheName6OfTheMethod'.
 ! !

!StringTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 12/18/2009 13:41'!
collectionWithElementsToRemove
" return a collection of elements included in 'nonEmpty'  "
	^ subcollection3ElementsSorted ! !

!StringTest methodsFor: 'tests - copying same contents' stamp: ''!
testReversed
	| result |
	result := self nonEmpty reversed .
	
	"verify content of 'result: '"
	1 to:  result size do:
		[:i | self assert: ((result at:i)=(self nonEmpty at:(self nonEmpty size-i+1)))].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!StringTest methodsFor: 'tests - element accessing' stamp: ''!
testLast
	"self debug: #testLast"
	self assert: self moreThan4Elements last = (self moreThan4Elements at: self moreThan4Elements size)! !

!StringTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterLastMore

	| delim multiItemStream result last allElementsAsString |
	
	delim := ', '.
	last := 'and'.
	result:=''.
	multiItemStream := ReadWriteStream on:result.
	self nonEmpty  asStringOn: multiItemStream delimiter: ', ' last: last.
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 )
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString)].
		i=(allElementsAsString size-1)
			ifTrue:[ self deny: (allElementsAsString at:i)=(last)asString].
		i=(allElementsAsString size)
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:(i-1))asString)].
			].
	
! !

!StringTest methodsFor: 'testing - instance creation' stamp: 'SvenVanCaekenberghe 12/4/2014 17:06'!
testLoremIpsum2048
	| fillerText |
	fillerText := String loremIpsum: 2048.
	self assert: fillerText size equals: 2048.
	self assert: (fillerText beginsWith: 'Lorem ipsum').
	self assert: (fillerText includesSubstring: 'laborum.').
	self assert: (fillerText endsWith: ('.', String cr)).
	self assert: fillerText lines size > 2.
	self assert: fillerText isAsciiString.
	self assert: (Character space split: fillerText) size > 75! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIncludeTest
	| anElementIn |
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self elementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self elementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self anotherElementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self anotherElementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self empty.
	self assert: self empty isEmpty! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIndexAccessFotMultipliness
	self collectionWithSameAtEndAndBegining.
	self assert: self collectionWithSameAtEndAndBegining first = self collectionWithSameAtEndAndBegining last.
	self assert: self collectionWithSameAtEndAndBegining size > 1.
	1 to: self collectionWithSameAtEndAndBegining size do: [ :i | 
		i > 1 & (i < self collectionWithSameAtEndAndBegining size)
			ifTrue: [ self deny: (self collectionWithSameAtEndAndBegining at: i) = self collectionWithSameAtEndAndBegining first ] ]! !

!StringTest methodsFor: 'tests - includes' stamp: 'delaunay 4/2/2009 11:53'!
testIncludesElementIsNotThere
	"self debug: #testIncludesElementIsNotThere"
	self deny: (self nonEmpty includes: self elementNotInForOccurrences).
	self assert: (self nonEmpty includes: self nonEmpty anyOne).
	self deny: (self empty includes: self elementNotInForOccurrences)! !

!StringTest methodsFor: 'testing - instance creation' stamp: 'dc 3/21/2007 11:22'!
testSpace
	"self debug: #testSpace"
	
	string := String new.
	self assert: string size = 0. "instead of #isEmpty to be consistent with the following test"
	
	string := String space.
	self assert: string size = 1.
	self assert: string = ' '! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 11:35'!
replacementCollection
" return a collection that will be used to replace 'oldSubcollection' in ' collectionWith1TimeSubcollection'  " 
	^ string! !

!StringTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithoutIndex
	| result index |
	index := self indexInNonEmpty .
	result := self nonEmpty copyWithoutIndex: index .
	
	"verify content of 'result:'"
	1 to: result size do:
		[:i | 
		i<( index ) ifTrue: [self assert: ((result at:i )= (self nonEmpty at:i))].
		i>=( index ) ifTrue: [self assert: (result at:i )= (self nonEmpty at:(i+1))]].
	
	"verify size of result : "
	self assert: result size=(self nonEmpty size -1).! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 11:30'!
collectionWithSameAtEndAndBegining
" return a collection with elements at end and begining equals .
(others elements of the collection are not equal to those elements)"
	^ sameAtEndAndBegining ! !

!StringTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testLastIndexOfStartingAtDuplicate
	"self debug: #testLastIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection last.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'lastIndexOf:ifAbsent:startingAt: should return the position of the last occurrence :'"
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size
			ifAbsent: [ 55 ]) = collection size.
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size - 1
			ifAbsent: [ 55 ]) = 1! !

!StringTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfterEmpty
	| result |
	result := self empty copyAfter: self collectionWithoutEqualElements first.
	self assert: result isEmpty.
	! !

!StringTest methodsFor: 'tests - puting with indexes' stamp: ''!
testAtWrapPut
	"self debug: #testAtWrapPut"
	| index |
	index := self indexArray anyOne.
	
	self nonEmpty atWrap: 0 put: self aValue.
	self assert: (self nonEmpty at:(self nonEmpty size))=self aValue.
	
	self nonEmpty atWrap: (self nonEmpty size+1) put: self aValue.
	self assert: (self nonEmpty at:(1))=self aValue.
	
	self nonEmpty atWrap: (index  ) put: self aValue.
	self assert: (self nonEmpty at: index ) = self aValue.
	
	self nonEmpty atWrap: (self nonEmpty size+index  ) put: self aValue .
	self assert: (self nonEmpty at:(index ))=self aValue .! !

!StringTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testReverseDo
	| result |
	result:= OrderedCollection new.
	self nonEmpty reverseDo: [: each | result add: each].
	
	1 to: result size do:
		[:i|
		self assert: (result at: i)=(self nonEmpty at:(self nonEmpty size-i+1))].! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 16:52'!
integerCollectionWithoutEqualElements
	" return a collection of integer without equal elements"
	^ nonEmpty5ElementsSorted! !

!StringTest methodsFor: 'tests - copy' stamp: ''!
testCopyEquals
	"self debug: #testCopySameClass"
	"A copy should be equivalent to the things it's a copy of"
	
	| copy | 
	copy := self nonEmpty copy.
	self assert: copy  = self nonEmpty.! !

!StringTest methodsFor: 'tests - converting' stamp: 'CamilloBruni 8/31/2013 20:23'!
testWithNoLineLongerThan
	"self run: #testWithNoLineLongerThan"

	self assert: ('Hello World' withNoLineLongerThan: 5) = ('Hello' , String cr , 'World').
	String crlf withNoLineLongerThan: 5.
	'Hello' , String cr , String cr , 'World' withNoLineLongerThan: 5.
	self
		assert:
			('Sample text to line break at some point' withNoLineLongerThan: 28)
				= ('Sample text to line break at' , String cr , 'some point').
	self
		assert:
			('Sample text' , String cr , 'to line break' , String cr , 'at some point' withNoLineLongerThan: 28)
				= ('Sample text' , String cr , 'to line break' , String cr , 'at some point')! !

!StringTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testIndexOfDuplicate
	"self debug: #testIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection last.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'indexOf: should return the position of the first occurrence :'"
	self assert: (collection indexOf: element) = 1! !

!StringTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWithoutAll
	"self debug: #testCopyEmptyWithoutAll"
	| res |
	res := self empty copyWithoutAll: self collectionWithElementsToRemove.
	self assert: res size = self empty size.
	self collectionWithElementsToRemove do: [ :each | self deny: (res includes: each) ]! !

!StringTest methodsFor: 'tests - element accessing' stamp: ''!
testAtPin
	"self debug: #testAtPin"
	self assert: (self moreThan4Elements atPin: 2) = self moreThan4Elements second.
	self assert: (self moreThan4Elements atPin: 99) = self moreThan4Elements last.
	self assert: (self moreThan4Elements atPin: -99) = self moreThan4Elements first! !

!StringTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutAll
	"self debug: #testCopyNonEmptyWithoutAll"
	| res |
	res := self nonEmpty copyWithoutAll: self collectionWithElementsToRemove.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self collectionWithElementsToRemove do: [ :each | self deny: (res includes: (each)) ].
	self nonEmpty do: 
		[ :each | 
		(self collectionWithElementsToRemove includes: each) ifFalse: [ self assert: (res includes: each) ] ]! !

!StringTest methodsFor: 'tests - element accessing' stamp: ''!
testAtLastIfAbsent
	"self debug: #testAtLastIfAbsent"
	self assert: (self moreThan4Elements 
			atLast: 1
			ifAbsent: [ nil ]) = self moreThan4Elements last.
	self assert: (self moreThan4Elements 
			atLast: self moreThan4Elements size + 1
			ifAbsent: [ 222 ]) = 222! !

!StringTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfterLast
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyAfterLast: (collection  at:index ).
	
	"verifying content: "
	(1) to: result size do: 
		[:i |
		self assert: (collection   at:(i + index ))=(result at: (i))].

	"verify size: "
	self assert: result size = (collection   size - index).! !

!StringTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButLastNElements
	"self debug: #testAllButFirst"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButLast: 2.
	1 
		to: abf size
		do: [ :i | self assert: (abf at: i) = (col at: i) ].
	self assert: abf size + 2 = col size! !

!StringTest methodsFor: 'testing - converting' stamp: 'BernardoContreras 3/8/2015 17:52'!
testSubstrings
	self assert: ('aba' substrings: 'bc') isArray.
	self assert: ('aba' substrings: 'bc') = #('a' 'a').
	self assert: ('abba' substrings: 'bc') = #('a' 'a').
	self assert: ('babbab' substrings: 'bc') = #('a' 'a').
	self assert: ('bbabbabb' substrings: 'bc') = #('a' 'a').! !

!StringTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindFirstNotIn

	| result |
	
	 result:=self empty findFirst: [:each | true].
	
	self assert: result=0. ! !

!StringTest methodsFor: 'tests - element accessing' stamp: ''!
testAfterIfAbsent
	"self debug: #testAfterIfAbsent"
	self assert: (self moreThan4Elements 
			after: (self moreThan4Elements at: 1)
			ifAbsent: [ 33 ]) = (self moreThan4Elements at: 2).
	self assert: (self moreThan4Elements 
			after: (self moreThan4Elements at: self moreThan4Elements size)
			ifAbsent: [ 33 ]) = 33.
	self assert: (self moreThan4Elements 
			after: self elementNotInForElementAccessing
			ifAbsent: [ 33 ]) = 33! !

!StringTest methodsFor: 'tests - converting' stamp: ''!
assertNoDuplicates: aCollection whenConvertedTo: aClass 
	| result |
	result := self collectionWithEqualElements asIdentitySet.
	self assert: (result class includesBehavior: IdentitySet).
	self collectionWithEqualElements do: [ :initial | self assert: (result occurrencesOf: initial) = 1 ]! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureOccurrencesForMultiplinessTest
	| cpt anElement collection |
	self collectionWithEqualElements.
	self collectionWithEqualElements.
	self elementTwiceInForOccurrences.
	anElement := self elementTwiceInForOccurrences.
	collection := self collectionWithEqualElements.
	cpt := 0.	" testing with identity check ( == ) so that identy collections can use this trait : "
	self collectionWithEqualElements
		do: [ :each | 
			each == self elementTwiceInForOccurrences
				ifTrue: [ cpt := cpt + 1 ] ].
	self assert: cpt = 2! !

!StringTest methodsFor: 'tests - copying with or without' stamp: ''!
testForceToPaddingWith

	| result element |
	element := self nonEmpty at: self indexInNonEmpty .
	result := self nonEmpty forceTo: (self nonEmpty size+2) paddingWith: ( element ).
	
	"verify content of 'result' : "
	1 to: self nonEmpty  size do:
		[:i | self assert: ( self nonEmpty at: i ) = ( result at:(i) ). ].
	
	(result size - 1) to: result size do:
		[:i | self assert: ( result at:i ) = ( element ) ].

	"verify size of 'result' :"
	self assert: result size = (self nonEmpty size + 2).! !

!StringTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsCommaStringEmpty

	self assert: self empty asCommaString = ''.
	self assert: self empty asCommaStringAnd = ''.
	
! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 16:52'!
nonEmpty
	^ nonEmpty5ElementsSorted! !

!StringTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindLast

	| element result |
	element := self nonEmptyMoreThan1Element  at:self nonEmptyMoreThan1Element  size.
	 result:=self nonEmptyMoreThan1Element  findLast: [:each | each =element].
	
	self assert: result=self nonEmptyMoreThan1Element  size. ! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCreationWithTest
	self collectionMoreThan5Elements.
	self assert: self collectionMoreThan5Elements size >= 5! !

!StringTest methodsFor: 'test - equality' stamp: ''!
testEqualSignIsTrueForEmptyButNonIdenticalCollections
	"self debug: #testEqualSignIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty = self empty copy). 
	self assert: (self empty copy = self empty).
	self assert: (self empty copy = self empty copy).
		
! !

!StringTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: 'GuillermoPolito 5/23/2010 21:13'!
testFindSelector
	self assert: #isSymbol equals: 'isSymbol' findSelector.
	self assert: #between:and: equals: 'between:and:' findSelector .
	self assert: #+ equals: '+' findSelector .
	self assert: #isSymbol equals: '#isSymbol' findSelector.
	self assert: #between:and: equals: '#between:and:' findSelector .
	self assert:#+ equals: '#+' findSelector
! !

!StringTest methodsFor: 'testing' stamp: 'CamilloBruni 7/2/2012 13:24'!
testPadLeftToWith
	self assert: ('a' padLeftTo: 3 with: $#) equals: '##a'. 
	self assert: ('a' padLeftTo: 1 with: $#) equals: 'a'. 
	self assert: ('a' padLeftTo: 0 with: $#) equals: 'a'.! !

!StringTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyNonEmpty
	"self debug: #testCopyNonEmpty"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: copy isEmpty.
	self assert: copy size = self nonEmpty size.
	self nonEmpty do: 
		[:each | copy includes: each]! !

!StringTest methodsFor: 'tests - indexof' stamp: 'on 5/13/2008 16:34'!
findFirstInString: aString fromString: searchString

	^ String findFirstInString: aString inSet: (CharacterSet newFrom: searchString) byteArrayMap startingAt: 1! !

!StringTest methodsFor: 'tests - at put' stamp: ''!
testAtPut
	"self debug: #testAtPut"
	
	self nonEmpty at: self anIndex put: self aValue.
	self assert: (self nonEmpty at: self anIndex) = self aValue.
	! !

!StringTest methodsFor: 'tests - copying' stamp: 'CamilloBruni 9/5/2011 10:07'!
testWithoutTrailingNewlines
	self assert: ('123',String cr) withoutTrailingNewlines = '123'.
	self assert: ('123',String lf) withoutTrailingNewlines = '123'.
	self assert: ('123',String cr, String lf) withoutTrailingNewlines = '123'.! !

!StringTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testReverseDoEmpty
	| result |
	result:= OrderedCollection new.
	self empty reverseDo: [: each | result add: each].
	
	self assert: result isEmpty .! !

!StringTest methodsFor: 'tests - streaming' stamp: ''!
testNewStreamContentsReturnsCollectionOfCorrectSize
	| result item originalSize |
	originalSize := 10.
	item := self firstCollection first.
	result := self collectionClass
		new: originalSize
		streamContents: [ :stream | 
			1 to: originalSize + 1 do: [ :each | stream nextPut: item ].
			stream position: originalSize ].
	self assert: result size equals: originalSize! !

!StringTest methodsFor: 'test - creation' stamp: ''!
testWithWith
	"self debug: #testWithWith"
	
	| aCol collection element1 element2 |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom: 1 to: 2  .
	element1 := collection at: 1.
	element2 := collection at:2.
	
	aCol := self collectionClass with: element1  with: element2 .
	self assert: (aCol occurrencesOf: element1 ) = ( collection occurrencesOf: element1).
	self assert: (aCol occurrencesOf: element2 ) = ( collection occurrencesOf: element2).
	
	! !

!StringTest methodsFor: 'tests - element accessing' stamp: ''!
testFirstSecondThird
	"self debug: #testFirstSecondThird"
	self assert: self moreThan4Elements first = (self moreThan4Elements at: 1).
	self assert: self moreThan4Elements second = (self moreThan4Elements at: 2).
	self assert: self moreThan4Elements third = (self moreThan4Elements at: 3).
	self assert: self moreThan4Elements fourth = (self moreThan4Elements at: 4)! !

!StringTest methodsFor: 'testing - tokenizing' stamp: 'StephaneDucasse 5/28/2011 13:49'!
testFindTokensEscapedBy03

	| tokens |
	string := 'this, is, a, test'.
	tokens := string findTokens: ',' escapedBy: '"'.
	self assert: tokens size = 4! !

!StringTest methodsFor: 'tests - copying with or without' stamp: ''!
testForceToPaddingStartWith

	| result element |
	element := self nonEmpty at: self indexInNonEmpty .
	result := self nonEmpty forceTo: (self nonEmpty size+2) paddingStartWith: ( element ).
	
	"verify content of 'result' : "
	1 to: 2   do:
		[:i | self assert: ( element ) = ( result at:(i) ) ].
	
	3 to: result size do:
		[:i | self assert: ( result at:i ) = ( self nonEmpty at:(i-2) ) ].

	"verify size of 'result' :"
	self assert: result size = (self nonEmpty size + 2).! !

!StringTest methodsFor: 'testing' stamp: 'StephaneDucasse 3/12/2011 16:30'!
testIsLiteralSymbol

	self assert: ('*+-/\~=<>&@%,|' allSatisfy: [:char | (Symbol with: char) isLiteralSymbol])
		description: 'single letter binary symbols can be printed without string quotes'.
		
	self assert: (#('x' 'x:' 'x:y:' 'from:to:by:' 'yourself') allSatisfy: [:str | str asSymbol isLiteralSymbol])
		description: 'valid ascii selector symbols can be printed without string quotes'.! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/24/2009 15:19'!
sizeCollection
	"Answers a collection whose #size is 4"
	^ 'abcd'! !

!StringTest methodsFor: 'testing' stamp: 'CamilloBruni 7/2/2012 13:24'!
testPadRightToWith
	self assert: ('a' padRightTo: 3 with: $#) equals: 'a##'. 
	self assert: ('a' padRightTo: 1 with: $#) equals: 'a'. 
	self assert: ('a' padRightTo: 0 with: $#) equals: 'a'.! !

!StringTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithFirst

	| index element result |
	index:= self indexInNonEmpty .
	element:= self nonEmpty at: index.
	
	result := self nonEmpty copyWithFirst: element.	
	
	self assert: result size = (self nonEmpty size + 1).
	self assert: result first = element .
	
	2 to: result size do:
	[ :i |
	self assert: (result at: i) = ( self nonEmpty at: ( i - 1 ))].! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 10:57'!
aValue
" return a value to put into nonEmpty"
	^ elementInNonEmpty ! !

!StringTest methodsFor: 'requirements' stamp: 'stephane.ducasse 11/21/2008 15:08'!
empty
	^ emptyString! !

!StringTest methodsFor: 'tests - element accessing' stamp: ''!
testAtLast
	"self debug: #testAtLast"
	| index |
	self assert: (self moreThan4Elements atLast: 1) = self moreThan4Elements last.
	"tmp:=1.
	self do:
		[:each | 
		each =self elementInForIndexAccessing 
			ifTrue:[index:=tmp].
		tmp:=tmp+1]."
	index := self moreThan4Elements indexOf: self elementInForElementAccessing.
	self assert: (self moreThan4Elements atLast: index) = (self moreThan4Elements at: self moreThan4Elements size - index + 1)! !

!StringTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterEmpty

	| delim emptyStream |
	delim := ', '.
	emptyStream := ReadWriteStream on: ''.
	self empty asStringOn: emptyStream delimiter: delim.
	self assert: emptyStream contents = ''.
! !

!StringTest methodsFor: 'tests - converting' stamp: 'md 2/5/2007 15:21'!
testZipped
	| compressed |
	
	compressed := 'hello' zipped.
	self assert: (compressed unzipped = 'hello').! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 11:03'!
indexArray
" return a Collection including indexes between bounds of 'nonEmpty' "

	^ indexInNonEmptyArray ! !

!StringTest methodsFor: 'tests - includes' stamp: 'stephane.ducasse 11/21/2008 15:09'!
collection
	^ 'ghj'! !

!StringTest methodsFor: 'tests - puting with indexes' stamp: ''!
testAtLastPut
	| result index |
	index := self indexArray anyOne.
	result := self nonEmpty atLast: index  put: self aValue.
	
	self assert: (self nonEmpty at: (self nonEmpty size +1 - index)) = self aValue .! !

!StringTest methodsFor: 'tests - sorting' stamp: ''!
testSort
	| result tmp |
	result := self unsortedCollection sort.
	tmp := result at: 1.
	result do:
		[:each | self assert: each>=tmp. tmp:= each. ].! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 12:02'!
anotherElementOrAssociationIn
	" return an element (or an association for Dictionary ) present  in 'collection' "
	^ self collection  anyOne! !

!StringTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionEmpty
	"self debug: #testIntersectionEmpty"
	
	| inter |
	inter := self empty intersection: self empty.
	self assert: inter isEmpty. 
	inter := self empty intersection: self collection .
	self assert: inter =  self empty.
	! !

!StringTest methodsFor: 'testing - converting' stamp: 'SvenVanCaekenberghe 1/17/2013 10:24'!
testWithoutTrailingDigits
	#( 
		'foo' 'foo'
		'foo123' 'foo'
		'bar 123 ' 'bar'
		'foo.123.txt' 'foo.123.txt'
		'' ''
		'1' ''
		'1 2 3 ' ''
	) pairsDo: [ :input :output |
		self assert: input withoutTrailingDigits equals: output ]
	! !

!StringTest methodsFor: 'testing' stamp: 'DamienPollet 3/25/2015 16:34'!
testIsAsciiString
	"Non-regression for https://pharo.fogbugz.com/f/cases/15232 "
	self assert: '' isAsciiString = true.
	self assert: 'abcdefGHIJKL 98765,./@#%$' isAsciiString = true.

	self assert: 'éÀ' isAsciiString = false.! !

!StringTest methodsFor: 'tests - sorting' stamp: ''!
testIsSorted
	self assert: self sortedInAscendingOrderCollection isSorted.
	self deny: self unsortedCollection isSorted! !

!StringTest methodsFor: 'tests - element accessing' stamp: ''!
testAtRandom
	| result |
	result := self nonEmpty atRandom .
	self assert: (self nonEmpty includes: result).! !

!StringTest methodsFor: 'tests - converting' stamp: ''!
assertSameContents: aCollection whenConvertedTo: aClass 
	| result |
	result := self assertNonDuplicatedContents: aCollection whenConvertedTo: aClass.
	self assert: result size = aCollection size! !

!StringTest methodsFor: 'tests - equality' stamp: ''!
testEqualSignForSequenceableCollections
	"self debug: #testEqualSign"

	self deny: (self nonEmpty = self nonEmpty asSet). 
	self deny: (self nonEmpty reversed = self nonEmpty).
	self deny: (self nonEmpty = self nonEmpty reversed).! !

!StringTest methodsFor: 'tests - streaming' stamp: ''!
testStreamContents
	| result index |
	result:= self collectionClass streamContents: [ :s|
		s 
			nextPutAll: self firstCollection;
			nextPutAll: self secondCollection ].
	self assert: result equals: self firstCollection, self secondCollection.! !

!StringTest methodsFor: 'testing - tokenizing' stamp: 'StephaneDucasse 5/28/2011 13:47'!
testFindTokensEscapedBy14

	| tokens |
	string := 'one, "two# three"; &four. five&'.
	tokens := string findTokens: ',#;.' escapedBy: '"&'.
	self assert: tokens size = 3.
	self assert: tokens second = ' two# three'.
	self assert: tokens third = ' four. five'! !

!StringTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOfNotIn
	| result |
	result := self collectionWithoutEqualElements occurrencesOf: self elementNotInForOccurrences.
	self assert: result = 0! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureBeginsEndsWithTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self assert: self nonEmpty size > 1.
	self empty.
	self assert: self empty isEmpty! !

!StringTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifferenceWithNonNullIntersection
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifferenceWithNonNullIntersection"
	"	#(1 2 3) difference: #(2 4) 
	->  #(1 3)"
	| res overlapping |
	overlapping := self collectionClass 
		with: self anotherElementOrAssociationNotIn
		with: self anotherElementOrAssociationIn.
	res := self collection difference: overlapping.
	self deny: (res includes: self anotherElementOrAssociationIn).
	overlapping do: [ :each | self deny: (res includes: each) ]! !

!StringTest methodsFor: 'tests - element accessing' stamp: ''!
testAtIfAbsent
	"self debug: #testAt"
	| absent |
	absent := false.
	self moreThan4Elements 
		at: self moreThan4Elements size + 1
		ifAbsent: [ absent := true ].
	self assert: absent = true.
	absent := false.
	self moreThan4Elements 
		at: self moreThan4Elements size
		ifAbsent: [ absent := true ].
	self assert: absent = false! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/24/2009 14:03'!
collectionNotIncluded
" return a collection for wich each element is not included in 'nonEmpty' "
	^ notIn ! !

!StringTest methodsFor: 'tests - includes' stamp: 'delaunay 4/2/2009 11:53'!
elementNotInForOccurrences
	^ $z! !

!StringTest methodsFor: 'test - equality' stamp: ''!
testEqualSignOfIdenticalCollectionObjects
	"self debug: #testEqualSignOfIdenticalCollectionObjects"
	
	self assert: (self empty = self empty). 
	self assert: (self nonEmpty = self nonEmpty). 
	! !

!StringTest methodsFor: 'tests - indexof' stamp: 'nice 3/15/2007 21:11'!
testIndexOf
	
	"test for http://bugs.impara.de/view.php?id=3574"
	self assert: ('abc-' asWideString indexOfAnyOf: (CharacterSet newFrom: ' -0123456789')) = 4.
	self assert: ('ab7' asWideString indexOfAnyOf: (CharacterSet newFrom: ' -0123456789')) = 3.
	self assert: ('a2c' asWideString indexOfAnyOf: (CharacterSet newFrom: ' -0123456789')) = 2.
	self assert: ('3bc' asWideString indexOfAnyOf: (CharacterSet newFrom: ' -0123456789')) = 1.
	self assert: ('abc' asWideString indexOfAnyOf: (CharacterSet newFrom: ' -0123456789')) = 0.
	
	"extension to wide characters"
	self assert: ((String with: 803 asCharacter with: 811 asCharacter) indexOfAnyOf: (CharacterSet newFrom: (String with: 811 asCharacter with: 812 asCharacter))) = 2.
	
	self assert: ('abc' indexOfAnyOf: (CharacterSet newFrom: (String with: 811 asCharacter with: 812 asCharacter))) = 0.
	
	self assert: ('abc' indexOfAnyOf: (CharacterSet newFrom: (String with: 811 asCharacter with: $c))) = 3.
	
	"make sure start index is used in wide string algorithm"
	self assert: ('ab bcd abc' copyWith: 811 asCharacter) substrings = {'ab'. 'bcd'. 'abc' copyWith: 811 asCharacter}.! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSubcollectionAccessTest
	self moreThan3Elements.
	self assert: self moreThan3Elements size > 2! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 12:02'!
anotherElementOrAssociationNotIn
	" return an element (or an association for Dictionary )not present  in 'collection' "
	^ notIn ! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 10:32'!
elementInForIndexAccessing
" return an element included in 'accessCollection' "
	^ withoutEqualElements anyOne! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSequencedElementAccessTest
	self moreThan4Elements.
	self assert: self moreThan4Elements size >= 4.
	self subCollectionNotIn.
	self subCollectionNotIn detect: [ :each | (self moreThan4Elements includes: each) not ] ifNone: [ self assert: false ].
	self elementNotInForElementAccessing.
	self deny: (self moreThan4Elements includes: self elementNotInForElementAccessing).
	self elementInForElementAccessing.
	self assert: (self moreThan4Elements includes: self elementInForElementAccessing)! !

!StringTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testLastIndexOfIfAbsentDuplicate
	"self debug: #testIndexOfIfAbsent"
	"self debug: #testLastIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection first.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'lastIndexOf: should return the position of the last occurrence :'"
	self assert: (collection 
			lastIndexOf: element
			ifAbsent: [ 55 ]) = collection size! !

!StringTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionBasic
	"self debug: #testIntersectionBasic"
	| inter |
	inter := self collection intersection: (self collectionClass with: self anotherElementOrAssociationIn).
	self deny: inter isEmpty.
	self assert: (inter includes: self anotherElementOrAssociationIn value)! !

!StringTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifference
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifference"
	
	| difference |
	self assert: (self collectionWithoutEqualElements difference: self collectionWithoutEqualElements) isEmpty.
	self assert: (self empty difference: self collectionWithoutEqualElements) isEmpty.
	difference := (self collectionWithoutEqualElements difference: self empty).
	self assert: difference size = self collectionWithoutEqualElements	 size.
	self collectionWithoutEqualElements do: [ :each |
		self assert: (difference includes: each)].
! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 10:57'!
anotherValue
" return a value ( not eual to 'aValue' ) to put into nonEmpty "
	^ self nonEmpty anyOne.! !

!StringTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButFirst
	"self debug: #testAllButFirst"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButFirst.
	self deny: abf first = col first.
	self assert: abf size + 1 = col size! !

!StringTest methodsFor: 'tests - as set tests' stamp: ''!
testAsIdentitySetWithEqualsElements
	| result collection |
	collection := self withEqualElements .
	result := collection asIdentitySet.
	collection do: [ :each | self assert: (result occurrencesOf: each) = 1 ].
	self assert: result class = IdentitySet.! !

!StringTest methodsFor: 'testing - lines' stamp: 'nice 11/16/2009 13:13'!
testLineCount
	| sampleCRString sampleLFString sampleCRLFString |
	sampleCRString := 'Fred', String cr , 'the' , String cr , 'Bear'.
	sampleLFString := 'Fred', String lf , 'the' , String lf , 'Bear'.
	sampleCRLFString := 'Fred', String crlf , 'the' , String crlf , 'Bear'.
	
	self assert: sampleCRString lineCount = 3.
	self assert: sampleLFString lineCount = 3.
	self assert: sampleCRLFString lineCount = 3.! !

!StringTest methodsFor: 'testing - lines' stamp: 'MarcusDenker 4/7/2011 12:53'!
testLines
	| sampleCRString sampleLFString sampleCRLFString sampleMixedString sampleMixedString2 |
	sampleCRString := 'Fred', String cr , 'the' , String cr , 'Bear'.
	sampleLFString := 'Fred', String lf , 'the' , String lf , 'Bear'.
	sampleCRLFString := 'Fred', String crlf , 'the' , String crlf , 'Bear'.
	sampleMixedString := 'Fred', String lf , 'the' , String cr , 'Bear'.
	sampleMixedString2 := 'Fred', String crlf , 'the' , String cr , 'Bear'.
	
	self assert: sampleCRString lines = #('Fred' 'the'  'Bear').
	self assert: sampleLFString lines = #('Fred' 'the'  'Bear').
	self assert: sampleCRLFString lines = #('Fred' 'the'  'Bear').
	self assert: sampleMixedString lines = #('Fred' 'the'  'Bear').
	self assert: sampleMixedString2 lines = #('Fred' 'the'  'Bear').! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 13:12'!
element
	"Returns an object that can be added to the collection returned by #collection."
	^ elementInNonEmpty ! !

!StringTest methodsFor: 'testing - internet' stamp: 'EstebanLorenzano 5/22/2012 18:30'!
testWithoutQuoting
 	#(
               '"foo"' 'foo'
               '''foo''' 'foo'
               '"foo''' '"foo'''
               '''foo"' '''foo"'
               '"foo' '"foo'
               'foo"' 'foo"'
               'foo' 'foo') 
	pairsDo: [ :before :after |
		self assert: before withoutQuoting = after ]! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 13:12'!
otherCollection
	"Returns a collection that does not include what is returned by #element."
	^ collectionNotIncluded ! !

!StringTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testAllButLastDo
	
	| result |
	result:= OrderedCollection  new.
	
	self nonEmptyMoreThan1Element  allButLastDo: [:each | result add: each].
	
	1 to: (result size) do:
		[:i|
		self assert: (self nonEmptyMoreThan1Element  at:(i ))=(result at:i)].
	
	self assert: result size=(self nonEmptyMoreThan1Element  size-1).! !

!StringTest methodsFor: 'tests - line breaking' stamp: 'MarcusDenker 6/24/2013 11:10'!
testLinesDoWithCrLf

	| aString |
	aString := 'This is a test of line breaking', String crlf.
	aString linesDo: [ :line |
		self assert: ((line size + 2) = aString size)]! !

!StringTest methodsFor: 'tests - converting' stamp: 'sd 6/5/2005 09:26'!
testAsInteger

	self assert: '1796exportFixes-tkMX' asInteger = 1796.
	self assert: 'donald' asInteger isNil.
	self assert: 'abc234def567' asInteger = 234.
	self assert: '-94' asInteger = -94.
	self assert: 'foo-bar-92' asInteger = -92! !

!StringTest methodsFor: 'testing - tokenizing' stamp: 'StephaneDucasse 5/28/2011 13:47'!
testFindTokensEscapedBy06

	| tokens |
	string := 'this, is, "a, test'.
	tokens := string findTokens: ',' escapedBy: '"'.
	self assert: tokens size = 3.
	self assert: tokens third = ' a, test'! !

!StringTest methodsFor: 'testing - formatting' stamp: 'SvenVanCaekenberghe 11/21/2012 09:08'!
testFormatExtended

	self
		assert: ('This is {foo} !!' format: (Dictionary with: #foo->'a test'))
		equals: 'This is a test !!'.

 	{ 
 		[ '\{ \} \\ foo {foo} bar {bar}' format: { #foo->12. #bar->'string' } asDictionary ] -> '{ } \ foo 12 bar string'. 
 		[ '\{ \} \\ foo {bar} bar {foo}' format: { 'bar'->12. 'foo'->'string' } asDictionary ] -> '{ } \ foo 12 bar string'. 
 		[ '\{x}' format: {} ] -> '{x}'. 
 		[ '\{x}{x}' format: { #x->$a } asDictionary ] -> '{x}a'. 
 	} do: [ :each | 
		self assert: each key value equals: each value ]! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyPartOfForMultipliness
	self collectionWithSameAtEndAndBegining.
	self assert: self collectionWithSameAtEndAndBegining first = self collectionWithSameAtEndAndBegining last.
	self assert: self collectionWithSameAtEndAndBegining size > 1.
	1 to: self collectionWithSameAtEndAndBegining size do: [ :i | 
		i > 1 & (i < self collectionWithSameAtEndAndBegining size)
			ifTrue: [ self deny: (self collectionWithSameAtEndAndBegining at: i) = self collectionWithSameAtEndAndBegining first ] ]! !

!StringTest methodsFor: 'testing - tokenizing' stamp: 'StephaneDucasse 5/28/2011 13:47'!
testFindTokensEscapedBy01

	| tokens |
	string := 'this, is, "a, test"'.
	tokens := string findTokens: ',' escapedBy: '"'.
	self assert: tokens size = 3! !

!StringTest methodsFor: 'testing' stamp: 'CamilloBruni 7/2/2012 13:23'!
testPadRightTo
	self assert: ('a' padRightTo: 3) equals: 'a  '. 
	self assert: ('a' padRightTo: 1) equals: 'a'. 
	self assert: ('a' padRightTo: 0) equals: 'a'.! !

!StringTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testPairsCollect
	
	| index result |
	index:=0.
	
	result:=self nonEmptyMoreThan1Element  pairsCollect: 
		[:each1 :each2 | 
		self assert: ( self nonEmptyMoreThan1Element indexOf: each2 ) = (index := index + 2).
		(self nonEmptyMoreThan1Element indexOf: each2) = ((self nonEmptyMoreThan1Element indexOf: each1) + 1).
		].
	
	result do: 
		[:each | self assert: each = true].
	
! !

!StringTest methodsFor: 'tests - copying same contents' stamp: ''!
testShallowCopyEmpty
	| result |
	result := self empty shallowCopy .
	self assert: result isEmpty .! !

!StringTest methodsFor: 'testing - converting' stamp: 'StephaneDucasse 9/18/2010 21:22'!
testindexOfstartingAt

	self assert: ('aa aa éé aa aa' indexOf: $a startingAt: 8) = 10.
	self assert: ('aa aa éé aa aa' indexOf: $z startingAt: 8) = 0.! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 10:45'!
subCollectionNotIn
" return a collection for which at least one element is not included in 'moreThan4Elements' "
	^ collectionNotIncluded ! !

!StringTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithIndexDo
	
	"| result |
	result:=Array new: self nonEmptyMoreThan1Element size.
	self nonEmptyMoreThan1Element  withIndexDo: [:each :i | result at:i put:(each+i)].
	
	1 to: result size do:[: i | self assert: (result at:i)= ((self nonEmptyMoreThan1Element at: i) + i)]"
	|  indexes elements |
	indexes:= OrderedCollection new.
	elements := OrderedCollection new.
	
	self nonEmptyMoreThan1Element  withIndexDo: 
		[:value :i  |
		indexes  add: (i).
		elements add: value].
	
	(1 to: self nonEmptyMoreThan1Element size )do:
		[ :i |
		self assert: (indexes at: i) = i.
		self assert: (elements at: i) = (self nonEmptyMoreThan1Element at: i).	
		].
	
	self assert: indexes size = elements size. 
	self assert: indexes size = self nonEmptyMoreThan1Element size . 
	! !

!StringTest methodsFor: 'tests - copying same contents' stamp: ''!
testReverse

	| result |
	result := self nonEmpty reversed.	
	"verify content of 'result: '"
	1 to: result size do:
		[:i | self assert: ((result at: i) 
			= (self nonEmpty at: (self nonEmpty size - i + 1)))].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!StringTest methodsFor: 'tests - element accessing' stamp: ''!
testBeforeIfAbsent
	"self debug: #testBefore"
	self assert: (self moreThan4Elements 
			before: (self moreThan4Elements at: 1)
			ifAbsent: [ 99 ]) = 99.
	self assert: (self moreThan4Elements 
			before: (self moreThan4Elements at: 2)
			ifAbsent: [ 99 ]) = (self moreThan4Elements at: 1)! !

!StringTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpToEmpty
	| result |
	result := self empty copyUpTo: self collectionWithoutEqualElements first.
	self assert: result isEmpty.
	! !

!StringTest methodsFor: 'test - creation' stamp: ''!
testWithWithWithWith
	"self debug: #testWithWithWithWith"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom: 1 to: 4.
	aCol := self collectionClass with: (collection at:1) with: ( collection at:2 ) with: ( collection at: 3) with: ( collection at: 4).

	1 to: 3 do: [ :i | self assert: ( aCol occurrencesOf: ( collection at: i ) ) = ( collection occurrencesOf: ( collection at: i ) ) ].! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
test0FixturePutOneOrMoreElementsTest
	self aValue.

	
	self indexArray.
	self indexArray do: [
		:each| 
		self assert: each class = SmallInteger. 
		self assert: (each>=1 & each<= self nonEmpty size).
		].
	
	self assert: self indexArray size = self valueArray size.
	
	self empty.
	self assert: self empty isEmpty .
	
	self nonEmpty.
	self deny: self nonEmpty  isEmpty.! !

!StringTest methodsFor: 'testing' stamp: 'CamilloBruni 7/2/2012 13:23'!
testPadLeftTo
	self assert: ('a' padLeftTo: 3) equals: '  a'. 
	self assert: ('a' padLeftTo: 1) equals: 'a'. 
	self assert: ('a' padLeftTo: 0) equals: 'a'.! !

!StringTest methodsFor: 'tests - set arithmetic' stamp: ''!
containsAll: union of: one andOf: another
			
	self assert: (one allSatisfy: [:each | union includes: each]).
	self assert: (another allSatisfy: [:each | union includes: each])! !

!StringTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindLastNotIn

	| result |
	
	 result:=self empty findFirst: [:each | true].
	
	self assert: result=0. ! !

!StringTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsCommaStringOne
	
	"self assert: self oneItemCol asCommaString = '1'.
	self assert: self oneItemCol asCommaStringAnd = '1'."

	self assert: self nonEmpty1Element  asCommaString = (self nonEmpty1Element first asString).
	self assert: self nonEmpty1Element  asCommaStringAnd = (self nonEmpty1Element first asString).
	! !

!StringTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFromToDo
	
	| result |
	result:= OrderedCollection  new.
	
	self nonEmptyMoreThan1Element  from: 1 to: (self nonEmptyMoreThan1Element  size -1) do: [:each | result add: each].
	
	1 to: (self nonEmptyMoreThan1Element  size -1) do:
		[:i|
		self assert: (self nonEmptyMoreThan1Element  at:i )=(result at:i)].
	self assert: result size=(self nonEmptyMoreThan1Element  size-1).! !

!StringTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopySameContentsTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!StringTest methodsFor: 'testing - tokenizing' stamp: 'StephaneDucasse 5/28/2011 13:47'!
testFindTokensEscapedBy24

	| tokens |
	string := 'this, is, a"," test'.
	tokens := string findTokens: $, escapedBy: $".
	self assert: tokens size = 3.
	self assert: tokens third = ' a, test'! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 13:23'!
replacementCollectionSameSize
" return a collection of size (secondIndex - firstIndex + 1)"
	^nonEmpty1element ! !

!StringTest methodsFor: 'requirements' stamp: ''!
elementInForReplacement
" return an element included in 'nonEmpty' "
^ self nonEmpty anyOne.! !

!StringTest methodsFor: 'tests - accessing' stamp: 'MarcusDenker 6/26/2013 14:10'!
testAt
	self assert: (string at: 1) = $H.! !

!StringTest methodsFor: 'initialization' stamp: 'MarcusDenker 6/26/2013 14:10'!
setUp
	string := 'Hi, I am a String'.
	emptyString := ''.
	subcollection3ElementsSorted := 'bcd'.
	nonEmpty5ElementsSorted := 'a' , subcollection3ElementsSorted , 'e'.
	unsortedCollection := 'azsbe'.
	indexInNonEmptyArray := #(1 3 2 ).
	arrayWithCharacters := #($a $b $c ).
	nonEmpty1element := 'a'.
	withoutEqualElements := 'abcde'.
	
	sameAtEndAndBegining := 'abca'.
	elementInNonEmpty := $c.
	collectionNotIncluded := notIn asString , notIn asString.
	notIn := $z! !

!StringTest methodsFor: 'testing - tokenizing' stamp: 'StephaneDucasse 5/28/2011 13:47'!
testFindTokensEscapedBy04

	| tokens |
	string := 'this, is, a"," test'.
	tokens := string findTokens: ',' escapedBy: '"'.
	self assert: tokens size = 3.
	self assert: tokens third = ' a, test'! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/24/2009 14:06'!
elementNotIn
"return an element not included in 'nonEmpty' "

	^notIn ! !

!StringTest methodsFor: 'testing - instance creation' stamp: 'SvenVanCaekenberghe 12/4/2014 16:59'!
testLoremIpsum
	| fillerText |
	fillerText := String loremIpsum.
	self deny: fillerText isEmpty.
	self assert: (fillerText beginsWith: 'Lorem ipsum').
	self assert: (fillerText endsWith: 'laborum.').
	self assert: fillerText lines first equals: fillerText.
	self assert: fillerText isAsciiString.
	self assert: (Character space split: fillerText) size > 10! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 16:52'!
moreThan3Elements
	" return a collection including atLeast 3 elements"
	^ nonEmpty5ElementsSorted! !

!StringTest methodsFor: 'tests - element accessing' stamp: ''!
testMiddle
	"self debug: #testMiddle"
	self assert: self moreThan4Elements middle = (self moreThan4Elements at: self moreThan4Elements size // 2 + 1)! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 16:52'!
nonEmptyMoreThan1Element
	" return a collection that don't includes equl elements'"
	^ nonEmpty5ElementsSorted! !

!StringTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterOne

	| delim oneItemStream result |
	"delim := ', '.
	oneItemStream := '' readWrite.
	self oneItemCol asStringOn: oneItemStream delimiter: delim.
	self assert: oneItemStream contents = '1'."
	
	delim := ', '.
	result:=''.
	oneItemStream := ReadWriteStream on: result.
	self nonEmpty1Element  asStringOn: oneItemStream delimiter: delim.
	oneItemStream do:[:each | self assert: each = (self nonEmpty1Element first asString)].
	

	! !

!StringTest methodsFor: 'testing - converting' stamp: 'Pmm 12/5/2010 14:18'!
testSubStrings
	self assert: ('aba' subStrings: 'bc') isArray.
	self assert: ('aba' subStrings: 'bc') = #('a' 'a').
	self assert: ('abba' subStrings: 'bc') = #('a' 'a').
	self assert: ('babbab' subStrings: 'bc') = #('a' 'a').
	self assert: ('bbabbabb' subStrings: 'bc') = #('a' 'a').! !

!StringTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testIndexOfIfAbsentDuplicate
	"self debug: #testIndexOfIfAbsent"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection last.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'indexOf:ifAbsent: should return the position of the first occurrence :'"
	self assert: (collection 
			indexOf: element
			ifAbsent: [ 55 ]) = 1! !

!StringTest methodsFor: 'test - creation' stamp: ''!
testWithWithWithWithWith
	"self debug: #testWithWithWithWithWith"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom: 1 to: 5 .
	aCol := self collectionClass with: (collection at:1) with: ( collection at:2 ) with: ( collection at: 3) with: (collection at: 4 ) with: ( collection at: 5 ).

	1 to: 3 do: [ :i | self assert: ( aCol occurrencesOf: ( collection at: i ) ) = ( collection occurrencesOf: ( collection at: i ) ) ].! !

!StringTest methodsFor: 'tests - at put' stamp: ''!
testAtPutOutOfBounds
	"self debug: #testAtPutOutOfBounds"
	
	self should: [self empty at: self anIndex put: self aValue] raise: Error
	! !

!StringTest methodsFor: 'requirements' stamp: 'delaunay 4/24/2009 14:06'!
elementInForIncludesTest
" return an element included in nonEmpty "
	^ elementInNonEmpty ! !

!StringTest methodsFor: 'tests - index access' stamp: ''!
testLastIndexOfIfAbsent
	"self debug: #testIndexOfIfAbsent"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			lastIndexOf: element
			ifAbsent: [ 99 ]) = 1.
	self assert: (collection 
			lastIndexOf: self elementNotInForIndexAccessing
			ifAbsent: [ 99 ]) = 99! !

!StringTest methodsFor: 'tests - copying with replacement' stamp: ''!
firstIndexesOf: aSubCollection in: collection
" return an OrderedCollection with the first indexes of the occurrences of subCollection in  collection "
	| tmp result currentIndex |
	tmp:= collection.
	result:= OrderedCollection new.
	currentIndex := 1.
	
	[tmp isEmpty ]whileFalse:
		[
		(tmp beginsWith: aSubCollection)
			ifTrue: [ 	
				result add: currentIndex.
				1 to: aSubCollection size do: 
					[:i | 
					tmp := tmp copyWithoutFirst.
					currentIndex := currentIndex + 1]
				]
			ifFalse: [
				tmp := tmp copyWithoutFirst.
				currentIndex := currentIndex +1.
				]
		 ].
	
	^ result.
	! !

!StringTest methodsFor: 'tests - index access' stamp: ''!
testLastIndexOfStartingAt
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection last.
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size
			ifAbsent: [ 99 ]) = collection size.
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size - 1
			ifAbsent: [ 99 ]) = 99.
	self assert: (collection 
			lastIndexOf: self elementNotInForIndexAccessing
			startingAt: collection size
			ifAbsent: [ 99 ]) = 99! !

!StringTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithCollectError
	self should: [self nonEmptyMoreThan1Element with: self empty collect:[:a :b | ]] raise: Error.! !

!StyleDeclaration commentStamp: '<historical>'!
I'm the declaration of a style stuff into a file.  I'm not really used, but I'm here to make parsing an homogeneous process and backwards compatibility.

Sending me the #import message does nothing :).!
!StyleDeclaration methodsFor: 'importing' stamp: 'GuillermoPolito 5/5/2012 16:40'!
import
	"Nothing to do with style declarations"
	^''! !

!SubclassPoolUser commentStamp: 'StephaneDucasse 12/13/2011 15:58'!
I should be able to access the pool variables defined in my superclass.!
!SubclassResponsabilityDebugAction commentStamp: '<historical>'!
A SubclassResponsabilityDebugAction is a debugging action that can create a method if the debugger was opened as a result of a #subclassResponsibility mesage send.

!
!SubclassResponsabilityDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/20/2013 18:05'!
id

	^ #subclassResponsability! !

!SubclassResponsabilityDebugAction methodsFor: 'actions' stamp: 'AndreiChis 10/4/2013 14:11'!
executeAction
	| senderContext msg msgCategory chosenClass |
	
	senderContext := self interruptedContext sender.
	msg := Message 
		selector: senderContext selector
		arguments: senderContext arguments.
	msgCategory := senderContext methodClass organization categoryOfElement: msg selector.
	
	chosenClass := self 
		askForSuperclassOf: senderContext receiver class 
		to: senderContext methodClass 
		toImplement: senderContext selector 
		ifCancel: [ ^ self ].

	self session 
		implement: msg 
		classified: msgCategory 
		inClass: chosenClass 
		forContext: senderContext.! !

!SubclassResponsabilityDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/20/2013 19:17'!
defaultLabel

	^  'Create'! !

!SubclassResponsabilityDebugAction methodsFor: 'testing' stamp: 'AndreiChis 10/4/2013 14:18'!
appliesToDebugger: aDebugger
	| interruptedContext |
	
	interruptedContext := aDebugger session interruptedContext.
	^ (interruptedContext selector == #subclassResponsibility) and: [ 
		"If we work with an instance of the abstract class (shouldn't normally happen) do not add this action, 
		as the abstract class alredy contains the the method."
		interruptedContext sender receiver class ~~ interruptedContext sender methodClass  ]

! !

!SubclassResponsabilityDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/20/2013 18:05'!
defaultOrder

	^ 45! !

!SubclassResponsabilityDebugAction methodsFor: 'private' stamp: 'AndreiChis 10/4/2013 14:10'!
askForSuperclassOf: aClass to: aSuperclass toImplement: aSelector ifCancel: cancelBlock
	| classes currentSuperclass chosenClassIndex |
	
	classes := OrderedCollection new.
	classes add: aClass.
	currentSuperclass := aClass superclass.
	[ currentSuperclass == nil or: [ currentSuperclass == aSuperclass ] ]
		whileFalse: [
			classes add: currentSuperclass.
			currentSuperclass := currentSuperclass superclass ].
	classes := classes addAll: (aClass traits sort: [ :t1 :t2 | t1 asString < t2 asString ]); yourself.
	
	classes size = 1 ifTrue: [ ^ classes at: 1 ].
	chosenClassIndex := UIManager default 
		chooseFrom: (classes collect: [:c | c name])
		title: 'Define #', aSelector, ' in which class?'.
	chosenClassIndex = 0 ifTrue: [^ cancelBlock value].
	^ classes at: chosenClassIndex! !

!SubclassResponsabilityDebugAction class methodsFor: 'registration' stamp: 'AndreiChis 9/20/2013 18:10'!
actionType
	<debuggingAction>! !

!SubclassResponsibility commentStamp: 'SvenVanCaekenberghe 4/21/2011 12:35'!
I am SubclassResponsibility, an exception signaled when an inherited method should have been implemented in a subclass but was not.!
!SubclassResponsibility methodsFor: 'printing' stamp: 'nice 12/2/2011 23:36'!
standardMessageText
	"Generate a standard textual description"
	
	^ String streamContents: [ :stream |
		stream print: self signaler class.
		stream << ' had the subclass responsibility to implement '.
		stream print: self selector ]! !

!SubscriptOutOfBounds commentStamp: 'SvenVanCaekenberghe 4/21/2011 13:00'!
I am SubscriptOutOfBounds, an exception indicating that some operation attempted to use a subscript outside allowed bounds.

Normally, I hold the offending subscript and/or the allowed lowerBound and upperBound (inclusive).

SubscriptOutOfBounds 
	signalFor: 10 
	lowerBound: 1 
	upperBound: 5 
	in: (Array new: 5)!
!SubscriptOutOfBounds methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/21/2011 12:45'!
upperBound
	^ upperBound! !

!SubscriptOutOfBounds methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 4/21/2011 12:54'!
standardMessageText
	"Generate a standard textual description"
	
	^ String streamContents: [ :stream |
		self subscript 
			ifNil: [
				stream << 'subscript' ]
			ifNotNil: [ 
				stream print: self subscript ].
		(self lowerBound notNil and: [ self upperBound notNil])
			ifTrue: [
				stream << ' is not between '.
				stream print: self lowerBound.
				stream << ' and '.
				stream print: self upperBound ] ]! !

!SubscriptOutOfBounds methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/21/2011 12:45'!
subscript
	^ subscript! !

!SubscriptOutOfBounds methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/21/2011 12:46'!
messageText
	"Overwritten to initialiaze the message text to a standard text if it has not yet been set"
	
	^ messageText ifNil: [ messageText := self standardMessageText ]! !

!SubscriptOutOfBounds methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/21/2011 12:45'!
lowerBound
	^ lowerBound! !

!SubscriptOutOfBounds methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/21/2011 12:46'!
lowerBound: anObject
	lowerBound := anObject! !

!SubscriptOutOfBounds methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/21/2011 12:46'!
upperBound: anObject
	upperBound := anObject! !

!SubscriptOutOfBounds methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/21/2011 12:45'!
subscript: anObject
	subscript := anObject! !

!SubscriptOutOfBounds class methodsFor: 'signaling' stamp: 'SvenVanCaekenberghe 4/21/2011 12:56'!
signalFor: subscript lowerBound: lowerBound upperBound: upperBound in: object
	^ self new
		signaler: object;
		subscript: subscript;
		lowerBound: lowerBound;
		upperBound: upperBound;
		signal		 ! !

!SubscriptOutOfBounds class methodsFor: 'signaling' stamp: 'SvenVanCaekenberghe 4/21/2011 12:57'!
signalFor: subscript
	^ self 
		signalFor: subscript 
		lowerBound: nil 
		upperBound: nil! !

!SubscriptOutOfBounds class methodsFor: 'signaling' stamp: 'SvenVanCaekenberghe 4/21/2011 12:57'!
signalFor: subscript lowerBound: lowerBound upperBound: upperBound
	^ self 
		signalFor: subscript 
		lowerBound: lowerBound 
		upperBound: upperBound 
		in: nil
! !

!SubscriptionRegistry commentStamp: 'IgorStasenko 3/12/2011 18:43'!
The subscription registry is a threadsafe storage for the subscriptions to an Announcer.

In Pharo, subscriptionsFor: protocol is not implemented.
This is because Announcer does not provide public access to its registery for encapsulation reasons.
(We do not want access to the announcer from action blocks to break encapsulation to other subscribers)!
!SubscriptionRegistry methodsFor: 'accessing' stamp: 'StephaneDucasse 2/22/2013 18:08'!
subscriptionsHandling: anAnnouncement
	^ Array streamContents: [ :s|
			subscriptions do: [:each| 
				(each handlesAnnouncement: anAnnouncement)
					ifTrue: [ s nextPut: each ]]]! !

!SubscriptionRegistry methodsFor: 'private' stamp: 'IgorStasenko 1/2/2012 15:14'!
protected: aBlock
	^ monitor critical: [ aBlock value ]! !

!SubscriptionRegistry methodsFor: 'initialize-release' stamp: 'IgorStasenko 3/12/2011 21:29'!
reset
	"subscriber -> subscriptions"
	
	subscriptions := IdentitySet new
	


! !

!SubscriptionRegistry methodsFor: '*glamour-tests-core' stamp: 'TudorGirba 5/18/2011 13:14'!
glmSubscriptions
	^ subscriptions! !

!SubscriptionRegistry methodsFor: 'accessing' stamp: 'IgorStasenko 3/12/2011 21:03'!
numberOfSubscriptions
	^ subscriptions size! !

!SubscriptionRegistry methodsFor: 'iterating' stamp: 'IgorStasenko 3/12/2011 17:30'!
subscriptionsOf: aSubscriber do: aBlock
	| copy |
	
	self protected: [ copy := subscriptions copy ].
	
	copy do: 
		[:subscription | 
			subscription subscriber == aSubscriber 
				ifTrue: [ aBlock value: subscription ]	]
! !

!SubscriptionRegistry methodsFor: 'add/remove' stamp: 'IgorStasenko 3/12/2011 17:29'!
removeSubscriber: subscriber
	
	^ self protected: [
		subscriptions removeAllSuchThat: [:subscription | subscription subscriber == subscriber ]]

! !

!SubscriptionRegistry methodsFor: 'initialization' stamp: 'IgorStasenko 1/2/2012 15:13'!
initialize
	monitor := Semaphore forMutualExclusion.
	self reset
! !

!SubscriptionRegistry methodsFor: 'add/remove' stamp: 'IgorStasenko 3/22/2011 15:42'!
replace: subscription with: newOne

	" Note that it will signal an error if subscription is not there "
	self protected: [
		subscriptions remove: subscription.
		subscriptions add: newOne 
	].
	^ newOne! !

!SubscriptionRegistry methodsFor: 'private' stamp: 'CamilloBruni 7/12/2012 10:05'!
deliver: anAnnouncement to: subs
	^ self deliver: anAnnouncement to: subs startingAt: 1! !

!SubscriptionRegistry methodsFor: 'add/remove' stamp: 'IgorStasenko 3/12/2011 17:28'!
add: subscription
	^ self protected: [
		subscriptions add: subscription  ]
! !

!SubscriptionRegistry methodsFor: 'add/remove' stamp: 'IgorStasenko 3/12/2011 17:29'!
remove: subscription
	^ self protected: [
		subscriptions remove: subscription ifAbsent: nil ]

! !

!SubscriptionRegistry methodsFor: 'announcing' stamp: 'CamilloBruni 7/12/2012 10:07'!
deliver: anAnnouncement
	|  interestedSubscriptions |
	
	"using a copy, so subscribers can unsubscribe from announcer "
	
	subscriptions isEmpty ifTrue: [ ^ self ].
	self protected: [ 
		interestedSubscriptions := self subscriptionsHandling: anAnnouncement ].
	self deliver: anAnnouncement to: interestedSubscriptions! !

!SubscriptionRegistry methodsFor: 'private' stamp: 'CamilloBruni 7/12/2012 10:08'!
deliver: anAnnouncement to: subs startingAt: startIndex
	
	startIndex to: subs size do: [ :index| | subscription |
		subscription := subs at: index.
		[ subscription deliver: anAnnouncement ] 
			"Ensure delivery to remaining announcements"
			ifCurtailed: [
				self deliver: anAnnouncement to: subs startingAt: index + 1 ]]! !

!SugsAbstractContext commentStamp: '<historical>'!
I'm the API used by smart suggestions with facilities to know the selected text, and having all the needed information for execute the commands.!
!SugsAbstractContext methodsFor: 'tools' stamp: 'GiselaDecuzzi 5/2/2013 16:13'!
tools
	^Smalltalk tools systemNavigation! !

!SugsAbstractContext methodsFor: 'refactoring' stamp: 'GiselaDecuzzi 5/2/2013 16:45'!
window
	^ self sourceTextArea ownerThatIsA: SystemWindow! !

!SugsAbstractContext methodsFor: 'testing' stamp: 'GiselaDecuzzi 5/15/2013 16:52'!
hasMoreSentences
	^ selectedNode parent isNotNil and: [ selectedNode parent isMethod not ]! !

!SugsAbstractContext methodsFor: 'refactoring' stamp: 'GiselaDecuzzi 5/2/2013 13:29'!
formatSourceCode
	| formatted |

	formatted := selectedNode formattedCode.
	formatted = self code ifTrue: [ ^ self ].
	self sourceTextArea
		editString: formatted;
		hasUnacceptedEdits: true! !

!SugsAbstractContext methodsFor: 'selection' stamp: 'GiselaDecuzzi 10/14/2013 18:25'!
selectedStatementsAsSequence
	| statements temporaries  |
	
	temporaries :=  self selectedTemporaryVariables.
	statements:= self selectedStatements.
	^RBSequenceNode temporaries: temporaries statements: statements
	! !

!SugsAbstractContext methodsFor: 'selection' stamp: 'GiselaDecuzzi 11/7/2013 13:06'!
selectedMethod
	self subclassResponsibility ! !

!SugsAbstractContext methodsFor: 'selection' stamp: 'GiselaDecuzzi 5/2/2013 17:12'!
selectedVariableName
	^selectedNode name! !

!SugsAbstractContext methodsFor: 'private' stamp: 'GiselaDecuzzi 10/14/2013 19:02'!
selectedTemporaryVariables
	selectedNode isSequence ifFalse: [ ^#() ].
	selectedNode temporaries ifEmpty: [^OrderedCollection new].
	^ ((selectedNode temporaries at: 1) containedBy: selectionPreviousHighligth )
		ifTrue: [ selectedNode temporaries ]
		ifFalse: [#()].
	! !

!SugsAbstractContext methodsFor: 'accessing' stamp: 'GiselaDecuzzi 4/18/2013 13:30'!
nodeStart
	^selectedNode start.! !

!SugsAbstractContext methodsFor: 'testing' stamp: 'GiselaDecuzzi 4/23/2013 14:12'!
hasClassUnImplementedAccessors
	| hasGetter hasSetter name |

	name := self selectedVariableName asString copy.
	name at: 1 put: name first asLowercase .
	
	hasGetter := RBCondition canUnderstand: name asSymbol in: self selectedClass class.
	hasSetter := RBCondition canUnderstand: (name,':' ) asSymbol in: self selectedClass class.
	^ (hasGetter not | hasSetter not) check! !

!SugsAbstractContext methodsFor: 'accessing' stamp: 'GiselaDecuzzi 4/18/2013 13:30'!
nodeStop
	^selectedNode stop.! !

!SugsAbstractContext methodsFor: 'testing' stamp: 'GiselaDecuzzi 4/23/2013 15:19'!
hasInstanceVariable
	
	^(RBCondition hasInstanceVariable: self selectedClass) check.
! !

!SugsAbstractContext methodsFor: 'testing' stamp: 'GiselaDecuzzi 5/15/2013 15:02'!
hasOneStatement
	^ (self selectedMessageName isNotNil or: [ selectedNode isLiteralNode ] ) or: [ selectedNode statements size = 1]! !

!SugsAbstractContext methodsFor: 'private' stamp: 'GiselaDecuzzi 10/14/2013 18:59'!
selectedStatements
	selectedNode isMessage ifTrue: [ ^{selectedNode} ].
	^(selectedNode statements select: [ :stat | stat containedBy: selectionPreviousHighligth ]).! !

!SugsAbstractContext methodsFor: 'testing' stamp: 'GiselaDecuzzi 5/15/2013 13:41'!
hasParameters
	
	^self selectedMessageName isNil or:[ self selectedMessageName numArgs > 0].
! !

!SugsAbstractContext methodsFor: 'accessing' stamp: 'GiselaDecuzzi 4/19/2013 17:45'!
code
	^self sourceTextArea text! !

!SugsAbstractContext methodsFor: 'refactoring' stamp: 'GiselaDecuzzi 5/2/2013 15:36'!
browsedEnvironment
	^RBBrowserEnvironment new! !

!SugsAbstractContext methodsFor: 'selection' stamp: 'GiselaDecuzzi 11/7/2013 13:07'!
selectedClass
	self subclassResponsibility ! !

!SugsAbstractContext methodsFor: 'selection' stamp: 'GiselaDecuzzi 4/19/2013 17:03'!
selectedInterval

	^ self sourceTextArea selectionInterval! !

!SugsAbstractContext methodsFor: 'selection' stamp: 'GiselaDecuzzi 9/11/2013 11:15'!
selectTheTextForTheNode
	selectionPreviousHighligth := self selectedInterval .
	selectedNode ifNotNil: [ self sourceTextArea selectFrom: self nodeStart to: self nodeStop]! !

!SugsAbstractContext methodsFor: 'selection' stamp: 'GiselaDecuzzi 10/14/2013 19:46'!
selectedStatementsAsText
	| sequenceNode|
	sequenceNode := self selectedStatementsAsSequence.
	^ sequenceNode formattedCode 
	! !

!SugsAbstractContext methodsFor: 'testing' stamp: 'GiselaDecuzzi 4/23/2013 10:57'!
hasUnImplementedAccessors
	| hasGetter hasSetter |
	
	hasGetter := RBCondition canUnderstand: self selectedVariableName asSymbol in: self selectedClass.
	hasSetter := RBCondition canUnderstand: (self selectedVariableName,':' ) asSymbol in: self selectedClass.
	^ (hasGetter not | hasSetter not) check! !

!SugsAbstractContext methodsFor: 'testing' stamp: 'GiselaDecuzzi 4/23/2013 16:25'!
hasSubclasses
	
	^(RBCondition hasSubclasses: self selectedClass) check.
! !

!SugsAbstractContext methodsFor: 'selection' stamp: 'GiselaDecuzzi 5/15/2013 13:32'!
selectedMessageName
	^[selectedNode selector] on: MessageNotUnderstood do: [ nil ]! !

!SugsAbstractContext methodsFor: 'initialize' stamp: 'GiselaDecuzzi 4/18/2013 13:29'!
selectedNode: theSelectedNode
	selectedNode := theSelectedNode .! !

!SugsAbstractContext methodsFor: 'refactoring' stamp: 'GiselaDecuzzi 11/7/2013 12:49'!
sourceTextArea
	self subclassResponsibility ! !

!SugsAbstractContext methodsFor: 'accesing' stamp: 'GiselaDecuzzi 10/14/2013 19:09'!
isMethodSelected
	^selectedNode isMethod ! !

!SugsAbstractContext methodsFor: 'accessing' stamp: 'GiselaDecuzzi 5/2/2013 17:35'!
selectedNodeText
	selectedNode ifNil: [ ^ '' ].
	(selectedNode respondsTo: #selector)ifTrue: [ ^self selectedMessageName  ].
	^selectedNode name copyFrom: 1 to: (35 min: selectedNode name size).
	! !

!SugsAbstractContext methodsFor: 'selection' stamp: 'GiselaDecuzzi 4/18/2013 13:44'!
bindedSelectedClass
	^selectedNode binding value.! !

!SugsAbstractContext methodsFor: 'initialize' stamp: 'GiselaDecuzzi 5/2/2013 15:15'!
model: aModel 
	model := aModel! !

!SugsAbstractContext class methodsFor: 'build' stamp: 'GiselaDecuzzi 5/2/2013 15:23'!
model: theModel
	^ self new 
		model: theModel;
		yourself.! !

!SugsAbstractContext class methodsFor: 'instance creation' stamp: 'GiselaDecuzzi 11/7/2013 13:02'!
contextFor: aModel
	(aModel respondsTo: #sugsContext)
		ifTrue: [ ^ aModel sugsContext ].
	(aModel model respondsTo: #sugsContext)
		ifTrue: [ ^ aModel model sugsContext ].
	self error: 'Not defined context for ' , aModel asString! !

!SugsAccessesToInstVar commentStamp: '<historical>'!
I know how to find accesses to an instance var!
!SugsAccessesToInstVar methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 15:05'!
label
	^'Accesses to...' translated! !

!SugsAccessesToInstVar methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 15:05'!
isValidForContext
	^ context hasClassUnImplementedAccessors! !

!SugsAccessesToInstVar methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 15:04'!
execute
	^context tools browseAllAccessesTo: context selectedVariableName from: context selectedClass! !

!SugsAddParameter commentStamp: '<historical>'!
I know how to add a parameter to a method!
!SugsAddParameter methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 15:26'!
label
	^'Add a parameter' translated! !

!SugsAddParameter methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 15:26'!
execute
	(NautilusRefactoring model: context) addAParameterFor: context selectedMethod! !

!SugsBrowseClassReferences commentStamp: '<historical>'!
I know how to browse references from a class!
!SugsBrowseClassReferences methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 14:21'!
label
	^ 'Browse references' translated
! !

!SugsBrowseClassReferences methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 14:21'!
execute
	context tools browseClassRefsOf: context bindedSelectedClass.
! !

!SugsContextTest commentStamp: 'TorstenBergmann 2/3/2014 23:43'!
SUnit tests for the Smart suggestions context!
!SugsContextTest methodsFor: 'valid-context' stamp: 'MarcusDenker 7/26/2013 15:13'!
testDebuggerIsAValidContext
	| debugger |
	
	debugger := Smalltalk tools debugger new.
	self assert: (SugsAbstractContext contextFor: debugger) class equals: SugsDebuggerContext .! !

!SugsContextTest methodsFor: 'valid-context' stamp: 'GiselaDecuzzi 5/2/2013 14:21'!
testContextForNautilusItsANautilusContext
	| nautilus |
	
	nautilus := NautilusUI new.
	self assert: (SugsAbstractContext contextFor: nautilus) class equals: SugsNautilusContext.! !

!SugsContextTest methodsFor: 'valid-context' stamp: 'GiselaDecuzzi 5/15/2013 10:57'!
testTetModelIsAValidContext
	| textModel |
	
	textModel := TextModel new.
	self assert: (SugsAbstractContext contextFor: textModel) class equals: SugsMessageBrowserContext.! !

!SugsContextTest methodsFor: 'valid-context' stamp: 'GiselaDecuzzi 5/2/2013 14:58'!
testSmalltalkEditorIsANotValidContext
	| stEditor |
	
	stEditor := SmalltalkEditor new.
	self should: [SugsAbstractContext contextFor: stEditor] raise: Error description:  'Not defined context for ', stEditor asString.! !

!SugsContextTest methodsFor: 'valid-context' stamp: 'GiselaDecuzzi 5/2/2013 14:21'!
testWorkspaceIsNotAValidContext
	| st |
	
	st := Workspace new.
	self should: [SugsAbstractContext contextFor: st] raise: Error description:  'Not defined context for ', st asString! !

!SugsCreateClassVarAccessors commentStamp: '<historical>'!
I know how to create accessors for a class var!
!SugsCreateClassVarAccessors methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 14:29'!
label
	^'Create accessors' translated! !

!SugsCreateClassVarAccessors methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 14:30'!
isValidForContext
	^context hasClassUnImplementedAccessors ! !

!SugsCreateClassVarAccessors methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 14:29'!
execute
	(NautilusRefactoring model: context) accessorsClassVarNamed: context selectedVariableName from: context selectedClass! !

!SugsCreateInstanceVarAccessors commentStamp: '<historical>'!
I know how to create accessors for an instance var!
!SugsCreateInstanceVarAccessors methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 14:57'!
label
	^ 'Create Accesors' translated! !

!SugsCreateInstanceVarAccessors methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 14:57'!
isValidForContext
	^ context hasUnImplementedAccessors! !

!SugsCreateInstanceVarAccessors methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 14:57'!
execute
	(NautilusRefactoring model: context) accessorsInstVarNamed: context selectedVariableName from: context selectedClass! !

!SugsDebuggerContext commentStamp: '<historical>'!
I know how to talk with a debugger and extract the information needed for the suggestions :)!
!SugsDebuggerContext methodsFor: 'refactoring' stamp: 'GiselaDecuzzi 5/2/2013 16:11'!
selectedMethod

	^model selectedContext method
	! !

!SugsDebuggerContext methodsFor: 'refactoring' stamp: 'GiselaDecuzzi 5/2/2013 15:40'!
sourceTextArea
	^ (model dependents at: 3).! !

!SugsDebuggerContext methodsFor: 'refactoring' stamp: 'GiselaDecuzzi 5/2/2013 15:38'!
selectedClass
	^model selectedClass .! !

!SugsDelegateMethod commentStamp: '<historical>'!
I know how to delegate the selected method in an instance variable and move the code to a class!
!SugsDelegateMethod methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 15:27'!
label
	^'Delegate selected method' translated! !

!SugsDelegateMethod methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 15:28'!
isValidForContext
	^ context hasInstanceVariable! !

!SugsDelegateMethod methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 15:28'!
execute
	 (NautilusRefactoring model: context) moveMethodFor: context selectedMethod! !

!SugsDeprecateMethod commentStamp: 'MarkRizun 7/22/2014 14:33'!
I know how to deprecate method.
!
!SugsDeprecateMethod methodsFor: 'accessing' stamp: 'MarkRizun 7/20/2014 20:57'!
label
	^ 'Deprecate' translated! !

!SugsDeprecateMethod methodsFor: 'execution' stamp: 'MarkRizun 7/20/2014 20:56'!
execute
	(NautilusRefactoring model: context) deprecateMethodFor: context selectedMethod! !

!SugsExtractMethod commentStamp: '<historical>'!
If you want to extract code in a new method I'm your guy!
!SugsExtractMethod methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 17:12'!
label
	^'Extract method' translated! !

!SugsExtractMethod methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 5/15/2013 16:50'!
isValidForContext
	^ context hasMoreSentences! !

!SugsExtractMethod methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 5/15/2013 16:12'!
execute
	(NautilusRefactoring model: context) extractToMethodTextSelection! !

!SugsExtractStatements commentStamp: '<historical>'!
A SugsSelectedValidCodeAsMethod the action needed to extract the selection to another method in the same class.
THe difference between SugsExtracMethod is that this actually uses the user selection.
In fact we should replace the SugsExtracMethod  with this one.
!
!SugsExtractStatements methodsFor: 'accessing' stamp: 'GiselaDecuzzi 11/1/2013 09:46'!
label
	^'Extract method' translated.
	
! !

!SugsExtractStatements methodsFor: 'private' stamp: 'GiselaDecuzzi 11/1/2013 09:52'!
privateCalculateInterval
	| selectedValidCodeInterval selectedValidCodeStatements |
	selectedValidCodeStatements := context selectedStatementsAsSequence.
	selectedValidCodeInterval := selectedValidCodeStatements start to: selectedValidCodeStatements stop.
	^ selectedValidCodeInterval! !

!SugsExtractStatements methodsFor: 'execution' stamp: 'GiselaDecuzzi 11/1/2013 09:52'!
execute
	| selectedValidCodeInterval |
	selectedValidCodeInterval := self privateCalculateInterval.
	(NautilusRefactoring model: context) extractBetween: selectedValidCodeInterval from: context selectedMethod! !

!SugsExtractToLocalVariable commentStamp: '<historical>'!
The classic option to extract a line of code in a local variable!
!SugsExtractToLocalVariable methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 16:59'!
label
	^ 'Extract local' translated! !

!SugsExtractToLocalVariable methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 5/15/2013 13:32'!
isValidForContext
	^context hasOneStatement.! !

!SugsExtractToLocalVariable methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 16:59'!
execute
	(NautilusRefactoring model: context) extractToTempTextSelection! !

!SugsFindImplementors commentStamp: '<historical>'!
I know how to find implementors for a message!
!SugsFindImplementors methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 15:20'!
label
	^  'Implementors' translated! !

!SugsFindImplementors methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 6/28/2014 11:50'!
execute
	context tools browseAllImplementorsOf: context selectedMessageName
				! !

!SugsFindSenders commentStamp: '<historical>'!
I know how to find senders from a message!
!SugsFindSenders methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 15:22'!
label
	^ 'Senders' translated! !

!SugsFindSenders methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 15:22'!
execute
	context tools
				browseSendersOf: context selectedMessageName
				name: 'Senders of ' translated , context selectedMessageName
				autoSelect: nil! !

!SugsFormatCode commentStamp: '<historical>'!
I know how to format the code!
!SugsFormatCode methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 17:52'!
label
	^'Format method' translated! !

!SugsFormatCode methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 17:40'!
execute
	context formatSourceCode! !

!SugsInline commentStamp: '<historical>'!
I know how to inline the method from a message!
!SugsInline methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 15:23'!
label
	 ^'Inline method' translated! !

!SugsInline methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 15:23'!
execute
	 (NautilusRefactoring model: context) inlineMethodBetween: context selectedInterval from: context selectedMethod! !

!SugsInlineTemporary commentStamp: '<historical>'!
This inline a variable in an assignment sentence!
!SugsInlineTemporary methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 6/12/2013 11:50'!
label
	 ^'Inline temporary' translated! !

!SugsInlineTemporary methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 6/12/2013 11:50'!
execute
	 (NautilusRefactoring model: context) inlineTemporaryBetween: context selectedInterval from: context selectedMethod! !

!SugsMenuBuilder commentStamp: '<historical>'!
I'm the one who finds the best suggestion for your selection or poition in text.
I also add the options to the displayed menus.!
!SugsMenuBuilder class methodsFor: 'show' stamp: 'StephaneDucasse 10/22/2014 22:12'!
showMenuFor: model
	| suggs menu context |

	context := [ SugsAbstractContext contextFor: model ]
		ifError: [ 
			"If we aren't in the right context we will fail in populate the suggestions so... better not"
			^ self ].
	suggs := SugsMenuBuilder findSuggestionsFor: context.
	menu := UIManager default newMenuIn: model model for: model.
	menu addTitle: 'Suggestions > ' , context selectedNodeText.
	suggs do: [ :aSugg | (menu add: aSugg label target: aSugg selector: #execute) icon: aSugg icon ].
	context selectTheTextForTheNode.
	menu setInvokingView: self.
	menu invokeModal! !

!SugsMenuBuilder class methodsFor: 'private' stamp: 'GiselaDecuzzi 6/18/2013 14:32'!
findBestNodeFor: context
	| root node|

	root := OpalCompiler new
				source: context code;
				useFaultyForParsing: true;
				parse.
	context selectedClass ifNotNil: [:theClass| root methodNode methodClass: theClass].
	root doSemanticAnalysis.
	node := root bestNodeFor: context selectedInterval.
	context selectedNode: node.
	^node.! !

!SugsMenuBuilder class methodsFor: 'suggestions' stamp: 'GiselaDecuzzi 6/12/2013 10:19'!
findSuggestionsFor: context	
	"Finds the best suggestions for the context passed as a parameter"
	| node suggestions |

	node := self findBestNodeFor: context .
	node ifNil: [ ^OrderedCollection new ].
	suggestions := node ifNotNil: [ node suggestions ].
	suggestions do:[:sugg| sugg context: context].
	^suggestions select: [:sugg | sugg isValidForContext ]
	
	! !

!SugsMenuBuilder class methodsFor: 'builder' stamp: 'GiselaDecuzzi 6/28/2013 10:40'!
buildSmartActionsShortcuts: aBuilder
	<keymap>

	(aBuilder shortcut: #smartSuggestions)
		category: #SmalltalkEditor
		default: $t command mac| $t ctrl unix | $t ctrl
		do: [ :morph | morph smartSuggestions ]
		description: 'Browse suggestions based on selections'.


! !

!SugsMenuBuilderTest commentStamp: 'TorstenBergmann 2/3/2014 23:43'!
SUnit tests for the Smart suggestions menu builder!
!SugsMenuBuilderTest methodsFor: 'nodes' stamp: 'GiselaDecuzzi 6/18/2013 14:31'!
testFindBestNodeForTemporaryVariableItsRBVariable
	| node |

	node :=SugsMenuBuilder findBestNodeFor:  SugsMockContext tempVarContext .
	self assert: node isTemp.! !

!SugsMenuBuilderTest methodsFor: 'suggstions-by-selection' stamp: 'GiselaDecuzzi 5/15/2013 14:22'!
testSuggestionForSourceNodeIncludesAllValid
	| suggestions expected context |
	context := SugsMockContext sourceContext.
	suggestions :=SugsMenuBuilder findSuggestionsFor: context.
	expected := (SugsSuggestionFactory commandsForSource do: [:aSugg | aSugg context: context] )select: #isValidForContext.
		
	self assert: (expected allSatisfy:[:expect | suggestions includes: expect]).! !

!SugsMenuBuilderTest methodsFor: 'nodes' stamp: 'GiselaDecuzzi 4/22/2013 14:29'!
testFindBestNodeForSelfNodeItsRBSelf
	| node |

	node :=SugsMenuBuilder findBestNodeFor:  SugsMockContext selfContext.
	self assert: node class equals: RBSelfNode.! !

!SugsMenuBuilderTest methodsFor: 'suggstions-by-selection' stamp: 'GiselaDecuzzi 4/19/2013 18:00'!
testNoSuggestionForSuperNode
	| suggestions |

	suggestions :=SugsMenuBuilder findSuggestionsFor: SugsMockContext superContext.
	self assert: suggestions isEmpty.! !

!SugsMenuBuilderTest methodsFor: 'nodes' stamp: 'GiselaDecuzzi 4/22/2013 15:29'!
testFindBestNodeForMessageNodeItsRBMessageSend
	| node |

	node :=SugsMenuBuilder findBestNodeFor:  SugsMockContext mesageContext  .
	self assert: node class equals: RBMessageNode .! !

!SugsMenuBuilderTest methodsFor: 'nodes' stamp: 'MarcusDenker 9/20/2013 15:02'!
testFindBestNodeForClassItsRBVariable
	| node |

	node :=SugsMenuBuilder findBestNodeFor:  SugsMockContext classContext.
	self assert: node class equals: RBVariableNode.
	"Es una forma un tanto molesta de preguntar... es de clase?" 
	self assert:( node binding isLiteralVariable and: [Smalltalk globals  includesAssociation: node binding assoc ]).! !

!SugsMenuBuilderTest methodsFor: 'suggstions-by-selection' stamp: 'GiselaDecuzzi 5/15/2013 15:07'!
testSuggestionForLiteralNodeIncludesAllExpected
	| suggestions expected |

	suggestions :=SugsMenuBuilder findSuggestionsFor: SugsMockContext literalContext.
	expected := SugsSuggestionFactory commandsFoLiteralNode .
	self assert:(expected allSatisfy:[:expect | suggestions includes: expect]).! !

!SugsMenuBuilderTest methodsFor: 'suggstions-by-selection' stamp: 'GiselaDecuzzi 6/12/2013 13:52'!
testSuggestionForAAssigmentNodeIncludesAllDeclared
	| suggestions expected|

	suggestions :=SugsMenuBuilder findSuggestionsFor: SugsMockContext assigmentContext.

	expected := SugsSuggestionFactory commandsForAssignment.	
	self assert: (expected allSatisfy:[:expect | suggestions includes: expect]).! !

!SugsMenuBuilderTest methodsFor: 'nodes' stamp: 'GiselaDecuzzi 4/22/2013 15:18'!
testFindBestNodeForSelfNodeItsRBSuper
	| node |

	node :=SugsMenuBuilder findBestNodeFor:  SugsMockContext superContext.
	self assert: node class equals: RBSuperNode ! !

!SugsMenuBuilderTest methodsFor: 'suggstions-by-selection' stamp: 'GiselaDecuzzi 4/22/2013 14:07'!
testSuggestionForAMessageNodeIncludesAllDeclared
	| suggestions expected|

	suggestions :=SugsMenuBuilder findSuggestionsFor: SugsMockContext mesageContext.

	expected := SugsSuggestionFactory commandsForMessage .	
	self assert: (expected allSatisfy:[:expect | suggestions includes: expect]).! !

!SugsMenuBuilderTest methodsFor: 'suggstions-by-selection' stamp: 'GiselaDecuzzi 4/22/2013 13:58'!
testSuggestionForATemporaryVariableNodeIncludesAllDeclared
	| suggestions expected|

	suggestions :=SugsMenuBuilder findSuggestionsFor: SugsMockContext tempVarContext.

	expected := SugsSuggestionFactory commandsForTemporaryVariable .	
	self assert: (expected allSatisfy:[:expect | suggestions includes: expect]).! !

!SugsMenuBuilderTest methodsFor: 'nodes' stamp: 'MarcusDenker 9/20/2013 15:02'!
testFindBestNodeForClassVarItsRBVariable
	| node |

	node :=SugsMenuBuilder findBestNodeFor:  SugsMockContext classVariableContext .
	self assert: node class equals: RBVariableNode.
	"Es una forma un tanto molesta de preguntar... es una var de clase?" 
	self assert:( node binding isLiteralVariable and: [(Smalltalk globals  includesAssociation: node binding assoc ) not]).! !

!SugsMenuBuilderTest methodsFor: 'suggstions-by-selection' stamp: 'GiselaDecuzzi 4/22/2013 13:57'!
testSuggestionForAClassVariableNodeIncludesAllDeclared
	| suggestions expected|

	suggestions :=SugsMenuBuilder findSuggestionsFor: SugsMockContext classVariableContext.

	expected := SugsSuggestionFactory commandsForClassVariable .	
	self assert: (expected allSatisfy:[:expect | suggestions includes: expect]).! !

!SugsMenuBuilderTest methodsFor: 'nodes' stamp: 'GiselaDecuzzi 4/22/2013 15:25'!
testFindBestNodeForMultilineItsRBSequence
	| node |

	node :=SugsMenuBuilder findBestNodeFor:  SugsMockContext sourceContext .
	self assert: node class equals: RBSequenceNode .
! !

!SugsMenuBuilderTest methodsFor: 'nodes' stamp: 'GiselaDecuzzi 5/22/2013 15:11'!
testFindBestNodeForInstanceVariableItsRBVariable
	| node |

	node :=SugsMenuBuilder findBestNodeFor:  SugsMockContext instVarContext .
	self assert: node class equals: RBVariableNode.
	self assert:( node binding isInstance).! !

!SugsMenuBuilderTest methodsFor: 'suggstions-by-selection' stamp: 'GiselaDecuzzi 4/22/2013 13:46'!
testSuggestionForAClassNodeIncludesAllDeclared
	| suggestions expected|

	suggestions :=SugsMenuBuilder findSuggestionsFor: SugsMockContext classContext.

	expected := SugsSuggestionFactory commandsForClass.	
	self assert: (expected allSatisfy:[:expect | suggestions includes: expect]).! !

!SugsMenuBuilderTest methodsFor: 'suggstions-by-selection' stamp: 'GiselaDecuzzi 4/22/2013 13:59'!
testSuggestionForAnInstanceVariableNodeIncludesAllDeclared
	| suggestions expected|

	suggestions :=SugsMenuBuilder findSuggestionsFor: SugsMockContext instVarContext.

	expected := SugsSuggestionFactory commandsForInstanceVariable .	
	self assert: (expected allSatisfy:[:expect | suggestions includes: expect]).! !

!SugsMenuBuilderTest methodsFor: 'suggstions-by-selection' stamp: 'GiselaDecuzzi 4/19/2013 17:36'!
testNoSuggestionForSelfNode
	| suggestions |

	suggestions :=SugsMenuBuilder findSuggestionsFor: SugsMockContext selfContext.
	self assert: suggestions isEmpty.! !

!SugsMenuBuilderTest methodsFor: 'nodes' stamp: 'GiselaDecuzzi 4/22/2013 14:27'!
testFindBestNodeForLiteralItsRBLiteral
	| node |

	node :=SugsMenuBuilder findBestNodeFor:  SugsMockContext literalContext.
	self assert: node class equals: RBLiteralValueNode .! !

!SugsMenuBuilderTest methodsFor: 'nodes' stamp: 'GiselaDecuzzi 4/22/2013 15:28'!
testFindBestNodeForMethodNodeItsRBMehod
	| node |

	node :=SugsMenuBuilder findBestNodeFor:  SugsMockContext methodContext .
	self assert: node class equals: RBMethodNode.! !

!SugsMenuBuilderTest methodsFor: 'suggstions-by-selection' stamp: 'GiselaDecuzzi 5/15/2013 13:36'!
testSuggestionForAMehodNodeIncludesAllValid
	| suggestions expected context |

	context := SugsMockContext methodContext.
	suggestions := SugsMenuBuilder findSuggestionsFor: context.
	expected := (SugsSuggestionFactory commandsForMethod do: [:aSugg | aSugg context: context] )select: #isValidForContext.
	self assert: (expected allSatisfy: [ :expect | suggestions includes: expect ])! !

!SugsMessageBrowserContext commentStamp: '<historical>'!
I know how to use a Text model that came from a SmalltalkEditor and extract the information needed for the suggestions :)!
!SugsMessageBrowserContext methodsFor: 'selection' stamp: 'GiselaDecuzzi 5/2/2013 13:58'!
selectedMethod
	^model owner selectedMessage.! !

!SugsMessageBrowserContext methodsFor: 'tools' stamp: 'GiselaDecuzzi 5/2/2013 13:57'!
tools
	^ model systemNavigation! !

!SugsMessageBrowserContext methodsFor: 'selection' stamp: 'GiselaDecuzzi 11/7/2013 13:09'!
selectedClass
	^model selectedBehavior! !

!SugsMessageBrowserContext methodsFor: 'refactoring' stamp: 'GiselaDecuzzi 5/22/2013 10:40'!
sourceTextArea
	^ model widget.! !

!SugsMockContext commentStamp: '<historical>'!
I'm a mock context with lot of stuff hardcoded.
I'm used in the tests to make easier the configuration for detecting diferents context.!
!SugsMockContext methodsFor: 'accessing' stamp: 'GiselaDecuzzi 4/19/2013 17:38'!
selectorToUse
	^ selectorToUse! !

!SugsMockContext methodsFor: 'api-context' stamp: 'GiselaDecuzzi 4/23/2013 10:43'!
selectedVariable: aVariableName.
	selectedVariable := aVariableName.! !

!SugsMockContext methodsFor: 'testing' stamp: 'GiselaDecuzzi 4/22/2013 14:06'!
withMesage
	self withClassVariable ! !

!SugsMockContext methodsFor: 'api-context' stamp: 'MarcusDenker 12/2/2013 14:45'!
selectedMethod
	^selectorToUse 
		ifNotNil: [self selectedClass 
					compiledMethodAt: selectorToUse 
					ifAbsent: [self selectedClass class methodDict at: selectorToUse]]
 		ifNil:[nil].! !

!SugsMockContext methodsFor: 'api-context' stamp: 'GiselaDecuzzi 4/23/2013 10:44'!
selectedVariableName
	^selectedVariable ifNil: [ super selectedVariableName ] ifNotNil:   [selectedVariable]! !

!SugsMockContext methodsFor: 'testing' stamp: 'GiselaDecuzzi 4/19/2013 16:49'!
withLiteral
	'hola' with: 19.! !

!SugsMockContext methodsFor: 'testing' stamp: 'GiselaDecuzzi 4/22/2013 14:00'!
withClassVariable
	ClassVariable! !

!SugsMockContext methodsFor: 'api-context' stamp: 'GiselaDecuzzi 4/23/2013 15:45'!
selectedInterval: interval
	selectedInterval := interval.! !

!SugsMockContext methodsFor: 'testing' stamp: 'GiselaDecuzzi 4/22/2013 14:05'!
withMethod
! !

!SugsMockContext methodsFor: 'testing' stamp: 'GiselaDecuzzi 4/22/2013 10:59'!
withClass
	SugsMockContext .! !

!SugsMockContext methodsFor: 'api-context' stamp: 'GiselaDecuzzi 4/23/2013 10:41'!
selectedClass: aClass
	selectedClass := aClass.! !

!SugsMockContext methodsFor: 'instance creation' stamp: 'GiselaDecuzzi 5/22/2013 15:24'!
withInstanceVar
	anInstanceVar.! !

!SugsMockContext methodsFor: 'testing' stamp: 'GiselaDecuzzi 4/19/2013 17:39'!
withSelf
	self with: 19.! !

!SugsMockContext methodsFor: 'accessing' stamp: 'GiselaDecuzzi 4/19/2013 17:38'!
selectorToUse: anObject
	selectorToUse := anObject! !

!SugsMockContext methodsFor: 'testing' stamp: 'GiselaDecuzzi 4/22/2013 14:17'!
withSourceContext
	SugsMockContext .
	20+10.
	OrderedCollection new.! !

!SugsMockContext methodsFor: 'testing' stamp: 'GiselaDecuzzi 6/12/2013 13:56'!
interval: selector 
	selector = #withLiteral ifTrue:[^ 18 to: 17].
	selector = #withSelf ifTrue:[^ 13 to: 13].
	selector = #withSuper ifTrue:[^ 13 to: 13].
	selector = #withClass ifTrue:[^ 15 to: 16].
	selector = #withClassVariable ifTrue:[^ (27 to: 26)].
	selector = #withMethod ifTrue:[^ 6 to: 5].
	selector = #withMesage ifTrue:[^ 21 to: 23].
	selector = #withClassVariable ifTrue:[^ 15 to: 16].
	selector = #withTemporaryVar ifTrue:[^ 63 to: 62].
	selector = #withInstanceVar ifTrue:[^ 18 to: 30].
	selector = #withSourceContext ifTrue:[^ 39 to: 68].
	selector = #withAssigment ifTrue:[^ 26 to: 35].
	^selectedInterval 
	
	! !

!SugsMockContext methodsFor: 'api-context' stamp: 'GiselaDecuzzi 4/19/2013 17:45'!
code
	^ self selectedMethod sourceCode! !

!SugsMockContext methodsFor: 'api-context' stamp: 'GiselaDecuzzi 4/23/2013 10:42'!
selectedClass
	^selectedClass ifNil: [self class] ifNotNil:[selectedClass].! !

!SugsMockContext methodsFor: 'api-context' stamp: 'GiselaDecuzzi 4/19/2013 17:56'!
selectedInterval
	^self interval: self selectorToUse ! !

!SugsMockContext methodsFor: 'refactoring' stamp: 'GiselaDecuzzi 5/2/2013 15:36'!
browsedEnvironment
	self subclassResponsibility .! !

!SugsMockContext methodsFor: 'testing' stamp: 'GiselaDecuzzi 6/12/2013 13:53'!
withAssigment
	|temp|
	
	temp := 10.
	^temp! !

!SugsMockContext methodsFor: 'api-context' stamp: 'GiselaDecuzzi 4/23/2013 18:00'!
message: theName
	^ message:= theName.! !

!SugsMockContext methodsFor: 'testing' stamp: 'GiselaDecuzzi 4/22/2013 14:08'!
withTemporaryVar
	|aLocalVar|
	
	aLocalVar := 'bonjour'.
	aLocalVar asString.! !

!SugsMockContext methodsFor: 'api-context' stamp: 'GiselaDecuzzi 5/15/2013 14:37'!
selectedMessageName

	^message ifNil:[super selectedMessageName] ifNotNil: [ message ]! !

!SugsMockContext methodsFor: 'api-context' stamp: 'GiselaDecuzzi 4/26/2013 16:28'!
sourceTextArea
	^ PluggableTextMorph new.! !

!SugsMockContext methodsFor: 'testing' stamp: 'GiselaDecuzzi 4/19/2013 18:00'!
withSuper
	super! !

!SugsMockContext class methodsFor: 'instance creation' stamp: 'GiselaDecuzzi 4/22/2013 10:59'!
classContext
	^ self new selectorToUse: #withClass; yourself.! !

!SugsMockContext class methodsFor: 'instance creation' stamp: 'GiselaDecuzzi 4/22/2013 14:17'!
sourceContext
	^ self new selectorToUse: #withSourceContext; yourself.! !

!SugsMockContext class methodsFor: 'instance creation' stamp: 'GiselaDecuzzi 6/12/2013 13:53'!
assigmentContext
	^ self new selectorToUse: #withAssigment; yourself.! !

!SugsMockContext class methodsFor: 'instance creation' stamp: 'GiselaDecuzzi 4/22/2013 14:04'!
methodContext
	^ self new selectorToUse: #withMethod; yourself.! !

!SugsMockContext class methodsFor: 'initialization' stamp: 'GiselaDecuzzi 5/15/2013 14:44'!
withNode: aNode 
	^self new selectedNode: aNode.! !

!SugsMockContext class methodsFor: 'instance creation' stamp: 'GiselaDecuzzi 4/19/2013 17:39'!
literalContext
	^ self new selectorToUse: #withLiteral; yourself.! !

!SugsMockContext class methodsFor: 'instance creation' stamp: 'GiselaDecuzzi 4/22/2013 14:07'!
tempVarContext
	^ self new selectorToUse: #withTemporaryVar; yourself.! !

!SugsMockContext class methodsFor: 'instance creation' stamp: 'GiselaDecuzzi 4/24/2013 14:38'!
methodClassContext
	^self new 
		selectedClass: self;
		selectorToUse: #methodClassContext
! !

!SugsMockContext class methodsFor: 'instance creation' stamp: 'GiselaDecuzzi 4/23/2013 18:00'!
withMessageName: theName 
	^ self new message: theName; yourself.! !

!SugsMockContext class methodsFor: 'instance creation' stamp: 'GiselaDecuzzi 4/23/2013 15:47'!
for: aClass
	^self new 
		selectedClass: aClass! !

!SugsMockContext class methodsFor: 'instance creation' stamp: 'GiselaDecuzzi 4/23/2013 10:47'!
for: aClass selectedVariable: aVariableName
	^self new 
		selectedClass: aClass;
		selectedVariable: aVariableName.! !

!SugsMockContext class methodsFor: 'instance creation' stamp: 'GiselaDecuzzi 4/22/2013 14:07'!
mesageContext
	^ self new selectorToUse: #withMesage; yourself.! !

!SugsMockContext class methodsFor: 'instance creation' stamp: 'GiselaDecuzzi 4/22/2013 13:59'!
classVariableContext
		^ self new selectorToUse: #withClassVariable; yourself.! !

!SugsMockContext class methodsFor: 'instance creation' stamp: 'GiselaDecuzzi 4/19/2013 18:01'!
superContext
	^ self new selectorToUse: #withSuper; yourself.! !

!SugsMockContext class methodsFor: 'instance creation' stamp: 'GiselaDecuzzi 4/22/2013 14:09'!
instVarContext
	^ self new selectorToUse: #withInstanceVar; yourself.! !

!SugsMockContext class methodsFor: 'instance creation' stamp: 'GiselaDecuzzi 4/19/2013 17:39'!
selfContext
	^ self new selectorToUse: #withSelf; yourself.! !

!SugsMorphicTextAdapterContext commentStamp: '<historical>'!
A SugsMorphicTextAdapterContext is a context that know how to work with the MorphicTextAdapter.
!
!SugsMorphicTextAdapterContext methodsFor: 'accessing' stamp: 'GiselaDecuzzi 11/7/2013 12:36'!
code
	^ model getText .! !

!SugsMorphicTextAdapterContext methodsFor: 'selection' stamp: 'GiselaDecuzzi 11/7/2013 13:06'!
selectedMethod
	^model model owner selectedMessage! !

!SugsMorphicTextAdapterContext methodsFor: 'refactoring' stamp: 'GiselaDecuzzi 11/7/2013 13:08'!
selectedClass
	^model behavior! !

!SugsMorphicTextAdapterContext methodsFor: 'refactoring' stamp: 'GiselaDecuzzi 11/7/2013 12:53'!
sourceTextArea
	^model widget  ! !

!SugsNautilusContext commentStamp: '<historical>'!
The implementation who asumes that my model it's a nautilus object.!
!SugsNautilusContext methodsFor: 'refactoring' stamp: 'GiselaDecuzzi 4/24/2013 13:16'!
selectedMethod
	^ model selectedMethod .! !

!SugsNautilusContext methodsFor: 'refactoring' stamp: 'GiselaDecuzzi 4/17/2013 10:52'!
window
	^ model window ! !

!SugsNautilusContext methodsFor: 'refactoring' stamp: 'GiselaDecuzzi 4/16/2013 17:47'!
browsedEnvironment
	^model browsedEnvironment .! !

!SugsNautilusContext methodsFor: 'accessing' stamp: 'GiselaDecuzzi 4/18/2013 11:38'!
selectedClass
	^ model selectedClass! !

!SugsNautilusContext methodsFor: 'refactoring' stamp: 'GiselaDecuzzi 4/17/2013 14:15'!
sourceTextArea
	^ model sourceTextArea .! !

!SugsPullUpMethod commentStamp: '<historical>'!
I know how to pull up the method to my superclass!
!SugsPullUpMethod methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 15:30'!
label
	^ 'Pull Up' translated! !

!SugsPullUpMethod methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 15:29'!
execute
	(NautilusRefactoring model: context) pullUpMethodsFor: (OrderedCollection with: context selectedMethod)! !

!SugsPushDownMethod commentStamp: '<historical>'!
I know how to push down the method to my subclass!
!SugsPushDownMethod methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 15:31'!
label
	^'Push Down' translated! !

!SugsPushDownMethod methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 15:32'!
isValidForContext
	^  context hasSubclasses! !

!SugsPushDownMethod methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 15:31'!
execute
	(NautilusRefactoring model: context) pushDownMethodsFor: (OrderedCollection with: context selectedMethod)! !

!SugsRemoveMethod commentStamp: '<historical>'!
I know how to remove a mehod!
!SugsRemoveMethod methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 15:51'!
label
	^'Remove method' translated! !

!SugsRemoveMethod methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 15:51'!
execute
	(NautilusRefactoring model: context) removeMethodsFor: (OrderedCollection with: context selectedMethod)! !

!SugsRemoveParameter commentStamp: '<historical>'!
I know how to remove a parameter from a method!
!SugsRemoveParameter methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 15:52'!
label
	^'Remove parameter' translated! !

!SugsRemoveParameter methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 15:52'!
isValidForContext
	^ context hasParameters! !

!SugsRemoveParameter methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 15:51'!
execute
	(NautilusRefactoring model: context) removeParameterFor: context selectedMethod ! !

!SugsRenameClass commentStamp: '<historical>'!
I know how to rename a class!
!SugsRenameClass methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 14:26'!
label
	^'Rename class' translated! !

!SugsRenameClass methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 17:20'!
execute
	(NautilusRefactoring model: context) renameClass: context bindedSelectedClass.! !

!SugsRenameClassVar commentStamp: '<historical>'!
I know how to rename a class variable!
!SugsRenameClassVar methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 14:31'!
label
	^ 'Rename' translated! !

!SugsRenameClassVar methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 14:31'!
execute
	(NautilusRefactoring model: context) renameClassVarNamed: context selectedVariableName from: context selectedClass! !

!SugsRenameInstanceVar commentStamp: '<historical>'!
I know how to rename an instance variable!
!SugsRenameInstanceVar methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 15:17'!
label
	^'Rename' translated! !

!SugsRenameInstanceVar methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 15:16'!
execute
	(NautilusRefactoring model: context) renameInstVarNamed: context selectedVariableName from: context selectedClass! !

!SugsRenameMethod commentStamp: '<historical>'!
I know how to rename methods!
!SugsRenameMethod methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 16:48'!
label
	^ 'Rename' translated! !

!SugsRenameMethod methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 16:48'!
execute
	 (NautilusRefactoring model: context) renameMethodFor: context selectedMethod ! !

!SugsRenameTemporaryVar commentStamp: '<historical>'!
I know how to rename a local variable.!
!SugsRenameTemporaryVar methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 17:18'!
label
	^  'Rename' translated! !

!SugsRenameTemporaryVar methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 17:18'!
execute
	(NautilusRefactoring model: context)
				renameTemporaryNamed: context selectedVariableName
				Between: (context nodeStart to: context nodeStop)
				from: context selectedMethod! !

!SugsStoresIntoInstVar commentStamp: '<historical>'!
I know how to find stores into for an instance var!
!SugsStoresIntoInstVar methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 15:18'!
label
	^'Stores Into...' translated! !

!SugsStoresIntoInstVar methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 15:18'!
execute
	context tools browseAllStoresInto: context selectedVariableName from: context selectedClass! !

!SugsSuggestion commentStamp: '<historical>'!
I'm the representation from a suggestion that can be executed.
I have some information related to the suggestion.!
!SugsSuggestion methodsFor: 'private' stamp: 'GiselaDecuzzi 4/5/2013 13:53'!
blockCommand: aBlock 
	blockCommand := aBlock.! !

!SugsSuggestion methodsFor: 'display' stamp: 'GiselaDecuzzi 4/19/2013 10:10'!
keyText: key
	keyText := key.! !

!SugsSuggestion methodsFor: 'private' stamp: 'GiselaDecuzzi 4/5/2013 14:05'!
context: theContext 
	context := theContext .
	! !

!SugsSuggestion methodsFor: 'private' stamp: 'GiselaDecuzzi 4/18/2013 15:47'!
position: aPosition
	position := aPosition .! !

!SugsSuggestion methodsFor: 'private' stamp: 'GiselaDecuzzi 4/11/2013 17:44'!
icon: anIcon
	icon := anIcon ! !

!SugsSuggestion methodsFor: 'private' stamp: 'GiselaDecuzzi 4/24/2013 14:35'!
= otherSuggestion
	otherSuggestion class = self class ifFalse: [  ^false ].
	^  self label = otherSuggestion label.! !

!SugsSuggestion methodsFor: 'display' stamp: 'GiselaDecuzzi 4/5/2013 13:56'!
label
	^label! !

!SugsSuggestion methodsFor: 'printing' stamp: 'GiselaDecuzzi 4/24/2013 14:34'!
printOn: aStream
	aStream
		nextPutAll: 'aSugsSuggestion (';
		nextPutAll: self label;
		nextPutAll: ')'.! !

!SugsSuggestion methodsFor: 'display' stamp: 'GiselaDecuzzi 4/18/2013 15:50'!
position
	^ position ifNil:[10000] ifNotNil: [ position ].! !

!SugsSuggestion methodsFor: 'execution' stamp: 'GiselaDecuzzi 4/5/2013 13:50'!
execute
	blockCommand value: context.! !

!SugsSuggestion methodsFor: 'private' stamp: 'GiselaDecuzzi 4/22/2013 16:22'!
isValidBlock: aBlock 
	isValidBlock := aBlock.! !

!SugsSuggestion methodsFor: 'display' stamp: 'GiselaDecuzzi 4/19/2013 10:09'!
keyText
	^ keyText! !

!SugsSuggestion methodsFor: 'execution' stamp: 'GiselaDecuzzi 4/22/2013 16:04'!
isValidForContext
	^ isValidBlock ifNil:[true] ifNotNil:[isValidBlock value: context].! !

!SugsSuggestion methodsFor: 'private' stamp: 'GiselaDecuzzi 4/5/2013 14:17'!
label: aLabel
	label := aLabel.! !

!SugsSuggestion methodsFor: 'display' stamp: 'GiselaDecuzzi 4/11/2013 14:43'!
icon
	^icon.! !

!SugsSuggestion class methodsFor: 'instance creation' stamp: 'GiselaDecuzzi 4/22/2013 16:23'!
for: blockCommand named: label icon: icon 
	^ self new 
		blockCommand: blockCommand;
		label: label;
		icon: icon;
		yourself.! !

!SugsSuggestion class methodsFor: 'instance creation' stamp: 'GiselaDecuzzi 4/22/2013 16:25'!
for: blockCommand named: label icon: icon position: position keyText: key  isValidBlock: validBlock
	^ (self for: blockCommand named: label icon: icon position: position)
		  keyText: key;
		 isValidBlock: validBlock;
		  yourself.! !

!SugsSuggestion class methodsFor: 'instance creation' stamp: 'GiselaDecuzzi 4/30/2013 14:27'!
icon: icon position: position keyText: key
	^ self new
	 	icon: icon;	 
		position: position;
		keyText: key;
		yourself.! !

!SugsSuggestion class methodsFor: 'instance creation' stamp: 'GiselaDecuzzi 4/19/2013 15:52'!
for: blockCommand named: label icon: icon position: position keyText: key
	^ (self for: blockCommand named: label icon: icon position: position)
		  keyText: key;
		  yourself.! !

!SugsSuggestion class methodsFor: 'instance creation' stamp: 'GiselaDecuzzi 4/30/2013 14:24'!
icon: icon position: position
	^ self new
	 	icon: icon;	 
		position: position;
		yourself.! !

!SugsSuggestion class methodsFor: 'instance creation' stamp: 'GiselaDecuzzi 4/19/2013 10:46'!
for: blockCommand named: label icon: icon position: position
	^ (self for: blockCommand named: label icon: icon)
	 	  position: position;
		  yourself.! !

!SugsSuggestion class methodsFor: 'instance creation' stamp: 'GiselaDecuzzi 4/22/2013 16:24'!
for: blockCommand named: label icon: icon position: position isValidBlock: validBlock
	^ (self for: blockCommand named: label icon: icon position: position)
   		  isValidBlock: validBlock;
		  yourself.! !

!SugsSuggestionCreateAccessorsTest commentStamp: 'TorstenBergmann 2/3/2014 23:43'!
SUnit tests for accessor creation!
!SugsSuggestionCreateAccessorsTest methodsFor: 'class-var' stamp: 'GiselaDecuzzi 4/23/2013 14:11'!
testCreateClassAccessorsIsValidIfMuttatorMissed
	| suggestion context |
	
	self addVariable: 'Test' to: self emptyClass .
	self createGetter: 'Test' in: self emptyClass .
	
	context := self createContext: 'Test'.
	suggestion := self createSuggestionAccesorsInstVar: context.

	self assert: suggestion isValidForContext.
	
! !

!SugsSuggestionCreateAccessorsTest methodsFor: 'inst-var' stamp: 'GiselaDecuzzi 4/23/2013 11:25'!
testCreateAccessorsIsValidIfAccessIsMissed
	| suggestion context |
	
	self addVariable: 'test' to: self emptyClass.
	self createSetter: 'test' in: self emptyClass.
	context := self createContext: 'test'.
	suggestion := self createSuggestionAccesorsInstVar: context.
	
	self assert: suggestion isValidForContext.
! !

!SugsSuggestionCreateAccessorsTest methodsFor: 'inst-var' stamp: 'GiselaDecuzzi 4/23/2013 11:25'!
testCreateAccessorsIsValidIfMuttatorMissed
	| suggestion context |
	
	self addVariable: 'test' to: self emptyClass .
	self createGetter: 'test' in: self emptyClass .
	
	context := self createContext: 'test'.
	suggestion := self createSuggestionAccesorsInstVar: context.

	self assert: suggestion isValidForContext.
	
! !

!SugsSuggestionCreateAccessorsTest methodsFor: 'class-var' stamp: 'GiselaDecuzzi 4/23/2013 11:28'!
testCreateClassAccessorsIsNotValidIfAccessorsAreAlreadyCreated
	| suggestion context |
	
	self addVariable: 'Test' to: self emptyClass.
	self createAccessorsFor: 'Test' in: self emptyClass.
	context := self createContext: 'Test'.
	suggestion := self createSuggestionAccesorsClassVar: context.
	
	self deny: suggestion isValidForContext! !

!SugsSuggestionCreateAccessorsTest methodsFor: 'private' stamp: 'GiselaDecuzzi 4/23/2013 11:19'!
createSuggestionAccesorsInstVar: context
	| suggestion |

	suggestion  := SugsSuggestionFactory createAccesorsFor.
	suggestion context: context.
	^suggestion.! !

!SugsSuggestionCreateAccessorsTest methodsFor: 'class-var' stamp: 'GiselaDecuzzi 4/23/2013 14:10'!
testCreateClassAccessorsIsValidIfAccessIsMissed
	| suggestion context |
	
	self addVariable: 'Test' to: self emptyClass.
	self createSetter: 'Test' in: self emptyClass.
	context := self createContext: 'Test'.
	suggestion := self createSuggestionAccesorsInstVar: context.
	
	self assert: suggestion isValidForContext.
! !

!SugsSuggestionCreateAccessorsTest methodsFor: 'private' stamp: 'GiselaDecuzzi 4/23/2013 13:57'!
createSuggestionAccesorsClassVar: context
	| suggestion |

	suggestion  := SugsSuggestionFactory createAccessors.
	suggestion context: context.
	^suggestion.! !

!SugsSuggestionCreateAccessorsTest methodsFor: 'private' stamp: 'GiselaDecuzzi 4/23/2013 13:56'!
targetFor: varName in: aClass
	^ varName first isUppercase 
		ifTrue: [ aClass class ] ifFalse: [aClass].
! !

!SugsSuggestionCreateAccessorsTest methodsFor: 'inst-var' stamp: 'GiselaDecuzzi 4/23/2013 11:19'!
testCreateAccessorsIsNotValidIfAccessorsAreAlreadyCreated
	| suggestion context |
	
	self addVariable: 'test' to: self emptyClass.
	self createAccessorsFor: 'test' in: self emptyClass.
	context := self createContext: 'test'.
	suggestion := self createSuggestionAccesorsInstVar: context.
	
	self deny: suggestion isValidForContext! !

!SugsSuggestionCreateAccessorsTest methodsFor: 'class-var' stamp: 'GiselaDecuzzi 4/23/2013 14:10'!
testCreateClassAccessorsIsValidIfAccessorsAreMissed
	| suggestion context |
	
	self addVariable: 'Test' to: self emptyClass.
	context := self createContext: 'Test'.
	suggestion := self createSuggestionAccesorsInstVar: context.
	
	self assert: suggestion isValidForContext.
	! !

!SugsSuggestionCreateAccessorsTest methodsFor: 'inst-var' stamp: 'GiselaDecuzzi 4/23/2013 11:23'!
testCreateAccessorsIsValidIfAccessorsAreMissed
	| suggestion context |
	
	self addVariable: 'test' to: self emptyClass.
	context := self createContext: 'test'.
	suggestion := self createSuggestionAccesorsInstVar: context.
	
	self assert: suggestion isValidForContext.
	! !

!SugsSuggestionDelegateTest commentStamp: 'TorstenBergmann 2/3/2014 23:43'!
SUnit tests for smart suggestions delegates!
!SugsSuggestionDelegateTest methodsFor: 'source' stamp: 'GiselaDecuzzi 4/23/2013 15:12'!
testDelegateSelectionWithoutInstaceVariablesItsNotValid
	| suggestion |
	
	self addMethodToDelegate.
	suggestion := self createSuggestionDelegate: self createContexForDelegate.
	
	self deny: suggestion isValidForContext! !

!SugsSuggestionDelegateTest methodsFor: 'private' stamp: 'GiselaDecuzzi 4/23/2013 14:50'!
createSuggestionDelegate: context
	| suggestion |

	suggestion  := SugsSuggestionFactory createMoveMethod .
	suggestion context: context.
	^suggestion.
	
! !

!SugsSuggestionDelegateTest methodsFor: 'private' stamp: 'GiselaDecuzzi 4/23/2013 15:47'!
createContexForDelegate
	^ SugsMockContext for: self emptyClass! !

!SugsSuggestionDelegateTest methodsFor: 'source' stamp: 'GiselaDecuzzi 4/23/2013 15:11'!
testDelegateSelectionWithInstaceVariablesItsValid
	| suggestion |

	self addVariable: 'test' to: self emptyClass.
	self addMethodToDelegate.
	suggestion := self createSuggestionDelegate: self createContexForDelegate .
	
	self assert: suggestion isValidForContext! !

!SugsSuggestionExtractLocalTest commentStamp: 'TorstenBergmann 2/3/2014 23:44'!
SUnit tests for extract locale suggestion!
!SugsSuggestionExtractLocalTest methodsFor: 'valid' stamp: 'GiselaDecuzzi 5/15/2013 14:42'!
testExtractLocalInASequenceNodeWithMoreSentencesIsNotValid
	| multipleLines context suggestion |
	
	multipleLines := RBSequenceNode new.
	multipleLines addNode: (RBVariableNode named: 'varName').
	multipleLines addNode: (RBVariableNode named: 'otherName').
	context := SugsMockContext withNode: multipleLines.
	
	suggestion := SugsSuggestionFactory createExtractToLocalVariable context: context.
	
	self deny: suggestion isValidForContext .
	! !

!SugsSuggestionExtractLocalTest methodsFor: 'valid' stamp: 'GiselaDecuzzi 5/15/2013 14:36'!
testExtractLocalInAMessageNodeIsValid
	| context suggestion |
	context := SugsMockContext withMessageName: 'justAName'.
	suggestion := SugsSuggestionFactory createExtractToLocalVariable context: context.
	self assert: suggestion isValidForContext
! !

!SugsSuggestionExtractLocalTest methodsFor: 'valid' stamp: 'GiselaDecuzzi 5/15/2013 14:45'!
testExtractLocalInASequenceNodeWithOneSentenceIsValid
	| oneLine context suggestion |
	
	oneLine := RBSequenceNode new.
	oneLine addNode: (RBVariableNode named: 'varName').
	context := SugsMockContext withNode: oneLine.
	
	suggestion := SugsSuggestionFactory createExtractToLocalVariable context: context.
	
	self assert: suggestion isValidForContext .! !

!SugsSuggestionExtractLocalTest methodsFor: 'valid' stamp: 'GiselaDecuzzi 5/15/2013 15:04'!
testExtractLocalInALiteralNodeIsValid
	| literal context suggestion |

	literal := RBLiteralValueNode  new.
	context := SugsMockContext withNode: literal.
	suggestion := SugsSuggestionFactory createExtractToLocalVariable context: context.	
	self assert: suggestion isValidForContext .! !

!SugsSuggestionFactory commentStamp: '<historical>'!
I'm the guy who knows how to create the suggestions. 
I also categorize them.!
!SugsSuggestionFactory class methodsFor: 'methods' stamp: 'GiselaDecuzzi 5/15/2013 11:05'!
createAddParameter
	<methodCommand>
	^ SugsAddParameter 
		icon: Smalltalk ui icons smallPushpinIcon
		position: 200! !

!SugsSuggestionFactory class methodsFor: 'private' stamp: 'GiselaDecuzzi 4/18/2013 10:55'!
collectorForSourceCode 
	^ collectorForSourceCode ifNil: [collectorForSourceCode := self createCollector: #sourceCodeCommand].
! !

!SugsSuggestionFactory class methodsFor: 'unknown-var' stamp: 'GiselaDecuzzi 5/15/2013 11:07'!
createVariableCorrection
"	<undeclaredVarCommand>"
	
"Unable because it's not fully implemented"	
	
	| variables index |
	^ SugsSuggestion 
		for: [:context | 
				variables := context selectedClass allInstVarNames asArray sort.
				index := UIManager default chooseFrom: variables.
				UIManager default inform:(variables at: index)
			] 
		named: 'Correct variable to...' translated
		icon: Smalltalk ui icons smallFindIcon.


	! !

!SugsSuggestionFactory class methodsFor: 'private' stamp: 'GiselaDecuzzi 4/18/2013 10:49'!
collectorForTemporaryVariable 
	^ collectorForTemporaryVariable  ifNil: [collectorForTemporaryVariable := self createCollector: #tempVarCommand].
	! !

!SugsSuggestionFactory class methodsFor: 'private' stamp: 'GiselaDecuzzi 6/12/2013 13:31'!
collectorForAssignment
	^ collectorForAssignment ifNil: [collectorForAssignment := self createCollector: #assignmentCommand].
! !

!SugsSuggestionFactory class methodsFor: 'inst-var' stamp: 'GiselaDecuzzi 5/15/2013 11:07'!
createVariableStoresInto
	<instVarCommand>
	^ SugsStoresIntoInstVar 
		icon: Smalltalk ui icons smallInspectItIcon
		position: 60! !

!SugsSuggestionFactory class methodsFor: 'private' stamp: 'GiselaDecuzzi 4/18/2013 11:11'!
collectorForClass 
	^ collectorForClass ifNil: [collectorForClass := self createCollector: #classCommand].
! !

!SugsSuggestionFactory class methodsFor: 'assignment' stamp: 'GiselaDecuzzi 6/12/2013 13:48'!
commandsForAssignment
	^self collectCommandsFrom: self collectorForAssignment.! !

!SugsSuggestionFactory class methodsFor: 'methods' stamp: 'GiselaDecuzzi 5/15/2013 11:07'!
createRemoveParameter
	<methodCommand>
	^ SugsRemoveParameter 
		icon: Smalltalk ui icons smallCancelIcon
		position: 210! !

!SugsSuggestionFactory class methodsFor: 'private' stamp: 'GiselaDecuzzi 4/18/2013 18:03'!
collectorForClassVariable 
	^ collectorForClassVariable ifNil: [collectorForClassVariable := self createCollector: #classVarCommand].
! !

!SugsSuggestionFactory class methodsFor: 'literal' stamp: 'GiselaDecuzzi 5/15/2013 14:57'!
commandsFoLiteralNode
	^self collectCommandsFrom: self collectorForLiteral .! !

!SugsSuggestionFactory class methodsFor: 'private' stamp: 'GiselaDecuzzi 4/18/2013 11:03'!
collectorForMethod 
	^ collectorForMethod ifNil: [collectorForMethod := self createCollector: #methodCommand].
! !

!SugsSuggestionFactory class methodsFor: 'source' stamp: 'MarcusDenker 10/24/2014 17:16'!
createExtractToLocalVariable
	<sourceCodeCommand>
	<messageCommand>
	<literalCommand>
	<blockCommand>
	^ SugsExtractToLocalVariable 
		icon: Smalltalk ui icons smallJumpIcon
		position: 20! !

!SugsSuggestionFactory class methodsFor: 'source' stamp: 'GiselaDecuzzi 4/18/2013 10:55'!
commandsForSource

	^self collectCommandsFrom: self collectorForSourceCode .
! !

!SugsSuggestionFactory class methodsFor: 'methods' stamp: 'GiselaDecuzzi 4/18/2013 11:07'!
commandsForMethod
	^self collectCommandsFrom: self collectorForMethod.! !

!SugsSuggestionFactory class methodsFor: 'class' stamp: 'GiselaDecuzzi 5/15/2013 11:07'!
createRenameClass
	<classCommand>
	^ SugsRenameClass
		icon: Smalltalk ui icons smallLanguageIcon
		position: 20
		keyText: 'r'! !

!SugsSuggestionFactory class methodsFor: 'private' stamp: 'GiselaDecuzzi 4/18/2013 10:38'!
createCollector: key 
	| collector |
	collector :=  PragmaCollector filter: [:pragma | pragma keyword=key].
	collector reset.
	collector whenChangedSend: #reset to: collector.
	^collector.
! !

!SugsSuggestionFactory class methodsFor: 'inst-var' stamp: 'GiselaDecuzzi 5/15/2013 11:05'!
createAccessesToVariable
	<instVarCommand>
	^ SugsAccessesToInstVar
		icon: Smalltalk ui icons smallInspectItIcon
		position: 50! !

!SugsSuggestionFactory class methodsFor: 'unknown-var' stamp: 'GiselaDecuzzi 5/15/2013 14:56'!
commandsForUndeclaredVariable
	^self collectCommandsFrom: self collectorForUndeclaredVariable  .! !

!SugsSuggestionFactory class methodsFor: 'source' stamp: 'MarcusDenker 10/24/2014 17:14'!
createExtractMethod
	<messageCommand>
	<literalCommand>
	<blockCommand>
	^ SugsExtractMethod 
		icon: Smalltalk ui icons smallUpdateIcon
		position: 50! !

!SugsSuggestionFactory class methodsFor: 'class-var' stamp: 'GiselaDecuzzi 4/18/2013 17:58'!
commandsForClassVariable
	^self collectCommandsFrom: self collectorForClassVariable.! !

!SugsSuggestionFactory class methodsFor: 'messages' stamp: 'GiselaDecuzzi 5/15/2013 11:06'!
createFindSenders
	<methodCommand>
	<messageCommand>
	^ SugsFindSenders 
		icon: Smalltalk ui icons smallFindIcon
		position: 10
		keyText: 'n'! !

!SugsSuggestionFactory class methodsFor: 'private' stamp: 'GiselaDecuzzi 4/18/2013 10:51'!
collectorForUndeclaredVariable 
	^ collectorForUndeclaredVariable ifNil: [collectorForUndeclaredVariable := self createCollector: #undeclaredVarCommand].
! !

!SugsSuggestionFactory class methodsFor: 'assignment' stamp: 'GiselaDecuzzi 6/12/2013 12:50'!
createInlineTemporary
	<assignmentCommand>
	^ SugsInlineTemporary
		icon: Smalltalk ui icons smallLanguageIcon
		position: 10
! !

!SugsSuggestionFactory class methodsFor: 'global' stamp: 'GiselaDecuzzi 6/12/2013 10:18'!
globalCommands
	^self collectCommandsFrom: self globalCollector.! !

!SugsSuggestionFactory class methodsFor: 'inst-var' stamp: 'GiselaDecuzzi 5/15/2013 11:04'!
createAccesorsFor
	<instVarCommand>
	^ SugsCreateInstanceVarAccessors 
		icon: Smalltalk ui icons smallLanguageIcon
		position: 100! !

!SugsSuggestionFactory class methodsFor: 'methods' stamp: 'GiselaDecuzzi 5/15/2013 11:07'!
createRenameMethod
	<methodCommand>
	^ SugsRenameMethod 
		icon: Smalltalk ui icons smallLanguageIcon
		position: 10
		keyText: 'r,m'! !

!SugsSuggestionFactory class methodsFor: 'methods' stamp: 'GiselaDecuzzi 5/15/2013 11:06'!
createPushDown
	<methodCommand>
	^ SugsPushDownMethod 
		icon: Smalltalk ui icons smallUndoIcon
		position: 101
! !

!SugsSuggestionFactory class methodsFor: 'source' stamp: 'GiselaDecuzzi 11/1/2013 09:56'!
createExtractSentences
	<sourceCodeCommand>
	^ SugsExtractStatements 
		icon: Smalltalk ui icons smallUpdateIcon 
		position: 10! !

!SugsSuggestionFactory class methodsFor: 'temp-var' stamp: 'GiselaDecuzzi 4/18/2013 10:50'!
commandsForTemporaryVariable
	^self collectCommandsFrom: self collectorForTemporaryVariable .! !

!SugsSuggestionFactory class methodsFor: 'methods' stamp: 'GiselaDecuzzi 5/15/2013 11:07'!
createRemoveMethod
	<methodCommand>
	^ SugsRemoveMethod 
		icon: Smalltalk ui icons smallCancelIcon
		position: 20! !

!SugsSuggestionFactory class methodsFor: 'methods' stamp: 'GiselaDecuzzi 5/15/2013 11:06'!
createPullUp
	<methodCommand>
	^ SugsPullUpMethod 
		icon: Smalltalk ui icons smallRedoIcon
		position: 100! !

!SugsSuggestionFactory class methodsFor: 'private' stamp: 'GiselaDecuzzi 5/15/2013 14:54'!
collectorForLiteral
	^ collectorForLiteral ifNil: [collectorForLiteral := self createCollector: #literalCommand].
! !

!SugsSuggestionFactory class methodsFor: 'inst-var' stamp: 'GiselaDecuzzi 4/18/2013 10:23'!
commandsForInstanceVariable
	^self collectCommandsFrom: self collectorForInstancesVariable .
	
! !

!SugsSuggestionFactory class methodsFor: 'messages' stamp: 'GiselaDecuzzi 4/18/2013 11:09'!
commandsForMessage
	^self collectCommandsFrom: self collectorForMessage.
! !

!SugsSuggestionFactory class methodsFor: 'class' stamp: 'GiselaDecuzzi 5/15/2013 11:05'!
createBrowseReferences
	<classCommand>
	^ SugsBrowseClassReferences 
		icon: Smalltalk ui icons smallInspectItIcon
		position: 10! !

!SugsSuggestionFactory class methodsFor: 'private' stamp: 'GiselaDecuzzi 4/18/2013 10:46'!
collectorForInstancesVariable 
	^ collectorForInstancesVariable ifNil: [collectorForInstancesVariable := self createCollector: #instVarCommand].
! !

!SugsSuggestionFactory class methodsFor: 'private' stamp: 'GiselaDecuzzi 4/18/2013 11:10'!
collectorForMessage
	^ collectorForMessage ifNil: [collectorForMessage := self createCollector: #messageCommand].
! !

!SugsSuggestionFactory class methodsFor: 'messages' stamp: 'GiselaDecuzzi 5/15/2013 11:06'!
createInline
	<messageCommand>
	^ SugsInline
		icon: Smalltalk ui icons smallRightFlushIcon
		position: 100! !

!SugsSuggestionFactory class methodsFor: 'private' stamp: 'MarcusDenker 10/24/2014 17:12'!
collectorForBlock
	^ collectorForBlock ifNil: [collectorForBlock:= self createCollector: #blockCommand].
! !

!SugsSuggestionFactory class methodsFor: 'private' stamp: 'GiselaDecuzzi 6/12/2013 10:18'!
globalCollector
	^ collectorForAll ifNil: [collectorForAll  := self createCollector: #globalCommand].
! !

!SugsSuggestionFactory class methodsFor: 'private' stamp: 'GiselaDecuzzi 4/18/2013 15:50'!
collectCommandsFrom: aPragmaCollector
	| commands |
	commands := SortedCollection sortBlock: [ :st :nd | st position <= nd position ].
	aPragmaCollector  do: [:prg | commands add: ( prg methodClass theNonMetaClass perform: prg selector)].
	^commands.
	
! !

!SugsSuggestionFactory class methodsFor: 'class' stamp: 'GiselaDecuzzi 4/18/2013 11:11'!
commandsForClass
	^self collectCommandsFrom: self collectorForClass.! !

!SugsSuggestionFactory class methodsFor: 'class-var' stamp: 'GiselaDecuzzi 5/15/2013 11:05'!
createAccessors
	<classVarCommand>
	^ SugsCreateClassVarAccessors 
		icon: Smalltalk ui icons smallLanguageIcon
		position: 30
! !

!SugsSuggestionFactory class methodsFor: 'block' stamp: 'MarcusDenker 10/24/2014 17:11'!
commandsForBlock
	^self collectCommandsFrom: self collectorForBlock.! !

!SugsSuggestionFactory class methodsFor: 'class-var' stamp: 'GiselaDecuzzi 5/15/2013 11:07'!
createRenameClassVariable
	<classVarCommand>
	^ SugsRenameClassVar 
		icon: Smalltalk ui icons smallLanguageIcon
		position: 10
		keyText: 'r'! !

!SugsSuggestionFactory class methodsFor: 'temp-var' stamp: 'GiselaDecuzzi 5/15/2013 11:07'!
createRenameTemporaryVariable
	<tempVarCommand>
	^ SugsRenameTemporaryVar 
		icon: Smalltalk ui icons smallLanguageIcon
		position: 10
		keyText: 'r'! !

!SugsSuggestionFactory class methodsFor: 'inst-var' stamp: 'GiselaDecuzzi 5/15/2013 11:07'!
createRenameVariable
	<instVarCommand>
	^ SugsRenameInstanceVar 
		icon: Smalltalk ui icons smallLanguageIcon
		position: 10
		keyText: 'r'! !

!SugsSuggestionFactory class methodsFor: 'source' stamp: 'GiselaDecuzzi 5/15/2013 11:06'!
createFormatSourceCode
	<methodCommand>
	<sourceCodeCommand>
	^ SugsFormatCode 
		icon: Smalltalk ui icons smallJustifiedIcon
		position: 0
		keyText: 'u'! !

!SugsSuggestionFactory class methodsFor: 'messages' stamp: 'GiselaDecuzzi 5/15/2013 11:06'!
createFindImplementors
	<messageCommand>
	^ SugsFindImplementors 
		icon: Smalltalk ui icons smallFindIcon
		position: 20
		keyText: 'm'! !

!SugsSuggestionFactory class methodsFor: 'class-var' stamp: 'GiselaDecuzzi 5/15/2013 11:07'!
createUseAccessorToVar
	<classVarCommand>
	^ SugsUseAccessorsForClassVar 
		icon: Smalltalk ui icons smallLanguageIcon
		position: 10! !

!SugsSuggestionFactory class methodsFor: 'methods' stamp: 'GiselaDecuzzi 5/15/2013 11:07'!
createSwapMethod
	<methodCommand>
	^ SugsSwapMethod new
		icon: Smalltalk ui icons smallRedoIcon;
		position: 50! !

!SugsSuggestionFactory class methodsFor: 'methods' stamp: 'GiselaDecuzzi 5/15/2013 11:06'!
createMoveMethod
	<methodCommand>
	^ SugsDelegateMethod 
		icon: Smalltalk ui icons smallRedoIcon
		position: 210! !

!SugsSuggestionFactory class methodsFor: 'methods' stamp: 'MarkRizun 7/22/2014 14:36'!
createDeprecateMethod
	<methodCommand>
	^ SugsDeprecateMethod 
		icon: Smalltalk ui icons smallLanguageIcon
		position: 125! !

!SugsSuggestionPushDownTest commentStamp: 'TorstenBergmann 2/3/2014 23:44'!
SUnit test for the push down suggestions!
!SugsSuggestionPushDownTest methodsFor: 'private' stamp: 'GiselaDecuzzi 4/23/2013 16:19'!
createSubclassFrom: superClass named: symbol
	| newClass |
	
	newClass := superClass 
					subclass: symbol
					instanceVariableNames: ''
					classVariableNames: ''
					poolDictionaries: ''
					category: 'SmartSuggestions-Test'.
	^newClass.! !

!SugsSuggestionPushDownTest methodsFor: 'private' stamp: 'GiselaDecuzzi 4/23/2013 16:24'!
createSuggestionPushDown: context
	
	^ SugsSuggestionFactory createPushDown 
		context:context;
		yourself.! !

!SugsSuggestionPushDownTest methodsFor: 'private' stamp: 'GiselaDecuzzi 4/23/2013 16:23'!
createContext: subclass
	
	^SugsMockContext for: subclass .! !

!SugsSuggestionPushDownTest methodsFor: 'method' stamp: 'GiselaDecuzzi 4/24/2013 00:47'!
testPushDownWithSubclassIsValid
	| suggestion subclass |

	subclass := self createSubclassFrom: self emptyClass named: #TestSuggestionsSubclass.
	self addMethodToDelegate.
	suggestion := self createSuggestionPushDown: (self createContext: self emptyClass ).
	
	self assert: suggestion isValidForContext.
	self removeClass: subclass.! !

!SugsSuggestionPushDownTest methodsFor: 'method' stamp: 'GiselaDecuzzi 4/23/2013 16:28'!
testPushDownWithoutSubclassIsNotValid
	| suggestion |

	self addMethodToDelegate.
	suggestion := self createSuggestionPushDown: (self createContext: self emptyClass ).
	
	self deny: suggestion isValidForContext! !

!SugsSuggestionRemoveArgTest commentStamp: 'TorstenBergmann 2/3/2014 23:44'!
SUnit tests for the remove argument suggestion!
!SugsSuggestionRemoveArgTest methodsFor: 'methods' stamp: 'GiselaDecuzzi 4/23/2013 17:58'!
testRemoveArgsWithArgsItsValid
	| suggestion |

	suggestion := SugsSuggestionFactory createRemoveParameter context: (SugsMockContext withMessageName: 'methodNoParamas:'  ); yourself.
	
	self assert: suggestion isValidForContext
	! !

!SugsSuggestionRemoveArgTest methodsFor: 'methods' stamp: 'GiselaDecuzzi 4/23/2013 17:57'!
testRemoveArgsWithoutArgsItsNotValid
	| suggestion |

	suggestion := SugsSuggestionFactory createRemoveParameter context: (SugsMockContext withMessageName: 'methodNoParamas' ); yourself.
		
	self deny: suggestion isValidForContext! !

!SugsSuggestionSwapMethodTest commentStamp: 'TorstenBergmann 2/3/2014 23:44'!
SUnit tests for the swap method suggestion!
!SugsSuggestionSwapMethodTest methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/24/2013 13:37'!
testLabelForSwapClassMethodRefersToInstance

	| sugg |
	sugg := SugsSuggestionFactory createSwapMethod.
	sugg context: SugsMockContext methodClassContext.
	
	self assert: sugg label equals: 'Move to instance side' translated.! !

!SugsSuggestionSwapMethodTest methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/24/2013 13:36'!
testLabelForSwapInstanceMethodRefersToClass
	| sugg |
	sugg := SugsSuggestionFactory createSwapMethod.
	sugg context: SugsMockContext methodContext.
	
	self assert: sugg label equals: 'Move to class side' translated.! !

!SugsSuggestionSwapMethodTest methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/24/2013 13:35'!
testLabelForSwapWithoutSelectedMethodIsGeneric
	| sugg |
	sugg := SugsSuggestionFactory createSwapMethod.
	sugg context: SugsMockContext new.
	
	self assert: sugg label equals: 'Swap method' translated.! !

!SugsSuggestionTest commentStamp: 'TorstenBergmann 2/3/2014 23:42'!
Superclass for SUnit tests for smart suggestions!
!SugsSuggestionTest methodsFor: 'private' stamp: 'GiselaDecuzzi 4/23/2013 14:31'!
addVariable: name to: aClass
	name first isUppercase ifTrue: [ aClass addClassVarNamed: name] ifFalse: [aClass addInstVarNamed: name].! !

!SugsSuggestionTest methodsFor: 'initialize-release' stamp: 'GiselaDecuzzi 4/23/2013 14:39'!
setUp
	super setUp.
	emptyClass  := self createClass: #TestWithAccessors.! !

!SugsSuggestionTest methodsFor: 'private' stamp: 'GiselaDecuzzi 4/23/2013 14:31'!
createSetter: varName in: aClass 
	| target name |
	
	target := self targetFor: varName in: aClass.
	name := self nameFor: varName.	
	target
		compile: ('<1s> anObject<n><t><2s> := anObject' expandMacrosWith: (name,':') with: varName)
		classified: #accessing.
	
	! !

!SugsSuggestionTest methodsFor: 'private' stamp: 'GiselaDecuzzi 4/23/2013 14:31'!
nameFor: varName
	| name |
	
	name:= varName copy.
	name at: 1 put: name first asLowercase.
	^name.! !

!SugsSuggestionTest methodsFor: 'private' stamp: 'GiselaDecuzzi 4/23/2013 16:22'!
addMethodToDelegate
	self emptyClass compile: 'methodToDelegate<n><t>2+5. <n><t>OrderedCollection new.' expandMacros classified: #testing! !

!SugsSuggestionTest methodsFor: 'private' stamp: 'GiselaDecuzzi 4/23/2013 14:31'!
createContext: selectedVariableName
	^ SugsMockContext for: self emptyClass selectedVariable: selectedVariableName ! !

!SugsSuggestionTest methodsFor: 'initialize-release' stamp: 'GiselaDecuzzi 4/23/2013 14:39'!
tearDown
	super tearDown.
	self removeClass: emptyClass .! !

!SugsSuggestionTest methodsFor: 'private' stamp: 'GiselaDecuzzi 4/23/2013 14:31'!
createGetter: varName in: aClass
	| target name |

	target := self targetFor: varName in: aClass.
	name := self nameFor: varName.	
	target
		compile: ('<1s><n><t>^ <2s>' expandMacrosWith: name with: varName)
		classified: #accessing.
	
	! !

!SugsSuggestionTest methodsFor: 'private' stamp: 'GiselaDecuzzi 4/23/2013 14:31'!
createClass: symbol
	| newClass |
	
	newClass := Object 
					subclass: symbol
					instanceVariableNames: ''
					classVariableNames: ''
					poolDictionaries: ''
					category: 'SmartSuggestions-Test'.
	^newClass.! !

!SugsSuggestionTest methodsFor: 'private' stamp: 'GiselaDecuzzi 4/23/2013 14:31'!
createAccessorsFor: varName in: aClass

	self createGetter: varName in: aClass.	
	self createSetter: varName in: aClass .
	
	! !

!SugsSuggestionTest methodsFor: 'private' stamp: 'GiselaDecuzzi 4/23/2013 14:39'!
emptyClass
	^ emptyClass! !

!SugsSuggestionTest methodsFor: 'private' stamp: 'GiselaDecuzzi 4/23/2013 14:31'!
removeClass: aClass
	aClass removeFromSystem.! !

!SugsSwapMethod commentStamp: '<historical>'!
I know how to move a method from instance side to class side and the oposit, depending the method.!
!SugsSwapMethod methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/24/2013 13:29'!
label
	
	^ context selectedMethod 
		ifNil: ['Swap method' translated] 
		ifNotNil: [context selectedMethod methodClass isMeta ifTrue: ['Move to instance side' translated] ifFalse:['Move to class side' translated]]
! !

!SugsSwapMethod methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/24/2013 13:24'!
execute
	^(NautilusRefactoring model: context) 
		swapMethodFor: (OrderedCollection with: context selectedMethod).! !

!SugsUseAccessorsForClassVar commentStamp: '<historical>'!
I know how to replace the call of a class variable for the use of an accessor and create accessors if it's necessary.!
!SugsUseAccessorsForClassVar methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 14:54'!
label
	^'Use accessor' translated! !

!SugsUseAccessorsForClassVar methodsFor: 'as yet unclassified' stamp: 'GiselaDecuzzi 4/30/2013 14:54'!
execute
	(NautilusRefactoring model: context) abstractClassVarFrom: context selectedClass! !

!SupplyAnswerTests commentStamp: 'TorstenBergmann 9/5/2014 17:00'!
A test for supplying answer !
!SupplyAnswerTests methodsFor: 'tests' stamp: 'SeanDeNigris 11/23/2011 10:48'!
testInform

	| answer |
	[ MorphicUIManager new inform: 'blah' ] on: Exception do: [:ex | answer := ex messageText ].
	self assert: answer  = 'blah'.! !

!SupplyAnswerTests methodsFor: 'tests' stamp: 'CamilloBruni 5/4/2012 19:47'!
testChooseDirectory

	| tmpDirectory answer |
	tmpDirectory :=FileSystem / 'tmp'.
	
	answer := ([ MorphicUIManager new chooseDirectory ] valueSupplyingAnswer: { 'Choose Directory'. tmpDirectory }).
	
	self assert: answer = tmpDirectory.! !

!SupplyAnswerTests methodsFor: 'tests' stamp: 'SeanDeNigris 11/23/2011 10:47'!
testFillInTheBlank

	| answer |
	answer := [ MorphicUIManager new request: 'Your favorite color?' ] valueSupplyingAnswer: #('Your favorite color?' 'blue').
	
	self assert: answer = 'blue'.! !

!Symbol commentStamp: '<historical>'!
I represent Strings that are created uniquely. Thus, someString asSymbol == someString asSymbol.!
!Symbol methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 12/19/2013 06:01'!
gtInspectorImplementorsIn: composite
	<gtInspectorPresentationOrder: 30>
	composite list 
		title: 'Implementors';
		display: [ self systemNavigation allImplementorsOf: self ];
		when: [ (self systemNavigation allImplementorsOf: self) notEmpty ];
		showOnly: 30! !

!Symbol methodsFor: 'testing' stamp: 'StephaneDucasse 5/28/2011 13:47'!
isKeyword
	"Answer whether the receiver is a message keyword."

	^ self precedence = 3! !

!Symbol methodsFor: 'testing' stamp: 'StephaneDucasse 5/28/2011 13:45'!
isBinary
	"Answer whether the receiver is a binary message selector."

	^ self precedence = 2! !

!Symbol methodsFor: '*metacello-core' stamp: 'dkh 9/5/2012 06:26:03.064'!
setForDo: aBlock withInMetacelloConfig: aMetacelloConstructore
    aMetacelloConstructore setFor: {self} do: aBlock! !

!Symbol methodsFor: 'evaluating' stamp: 'md 3/24/2006 12:09'!
value: anObject 
	^anObject perform: self.! !

!Symbol methodsFor: '*Glamour-Helpers' stamp: 'tg 10/25/2010 02:09'!
asGlamourOriginIdentifier
	^ GLMPortIdentifier defaultOriginOf: self! !

!Symbol methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 1/23/2015 21:44'!
phlowValue: anObject withEnoughArguments: aCollection

	^ anObject perform: self withEnoughArguments: aCollection! !

!Symbol methodsFor: '*Glamour-Helpers' stamp: 'tg 10/25/2010 02:08'!
asGlamourTargetIdentifier
	^ GLMPortIdentifier defaultTargetOf: self! !

!Symbol methodsFor: 'converting' stamp: 'MarcusDenker 10/11/2013 10:07'!
separateKeywords
	"#'foo:zork:'  separateKeywords -> 'foo:  zork:'"

	self isKeyword
		ifFalse: [ ^ self ].
	^ String streamContents: [ :stream | 
			(self findTokens: $:) 
				do: [ :each | 
					stream
						nextPutAll: each;
						nextPut: $: ]
				separatedBy: [ stream nextPutAll: '  ' ] ]! !

!Symbol methodsFor: '*Slot' stamp: 'MarcusDenker 6/26/2014 13:37'!
asSlot
	^ InstanceVariableSlot named: self.! !

!Symbol methodsFor: 'testing' stamp: 'md 1/20/2006 16:16'!
includesKey: sym
	^self == sym.! !

!Symbol methodsFor: 'converting' stamp: 'ar 4/10/2005 22:42'!
asString 
	"Refer to the comment in String|asString."
	| newString |
	newString := self species new: self size.
	newString replaceFrom: 1 to: newString size with: self startingAt: 1.
	^newString! !

!Symbol methodsFor: 'sorting' stamp: 'DamienCassou 8/27/2013 21:06'!
sorted: aSortBlockOrNil
	"Return a new sequenceable collection which contains the same elements as self but its elements are sorted by aSortBlockOrNil. The block should take two arguments and return true if the first element should preceed the second one. If aSortBlock is nil then <= is used for comparison. We convert the symbol to an array because symbols can't be changed."
	
	^self asArray sort: aSortBlockOrNil! !

!Symbol methodsFor: '*Glamour-Helpers' stamp: ' 4/5/09 22:18'!
glamourValueWithArgs: anArray 
	 
	anArray size < 1 ifTrue: [^nil]. 
	^anArray first perform: self! !

!Symbol methodsFor: 'private' stamp: ''!
string: aString

	1 to: aString size do: [:j | super at: j put: (aString at: j)].
	^self  ! !

!Symbol methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 1/23/2015 21:43'!
phlowValue: anObject value: otherObject

	^ anObject perform: self withEnoughArguments: { otherObject }! !

!Symbol methodsFor: 'testing' stamp: 'StephaneDucasse 5/28/2011 13:45'!
isInfix
	"Answer whether the receiver is an infix message selector."

	^ self precedence = 2! !

!Symbol methodsFor: 'evaluating' stamp: 'HenrikSperreJohansen 2/18/2010 14:58'!
cull: anObject 
	^anObject perform: self.! !

!Symbol methodsFor: 'accessing' stamp: 'CamilleTeruel 10/20/2014 15:18'!
precedence
	"Answer the receiver's precedence, assuming it is a valid Smalltalk
	message selector or 0 otherwise.  The numbers are 1 for unary,
	2 for binary and 3 for keyword selectors."

	self size = 0 ifTrue: [^ 0].
	(self first isLetter or: [ self first = $_ ]) ifFalse: [^ 2].
	self last = $: ifTrue: [^ 3].
	^ 1! !

!Symbol methodsFor: 'converting' stamp: ''!
asSymbol 
	"Refer to the comment in String|asSymbol."! !

!Symbol methodsFor: 'testing' stamp: 'md 8/27/2005 16:33'!
isDoIt

	^ (self == #DoIt) or: [self == #DoItIn:].! !

!Symbol methodsFor: '*opalcompiler-core' stamp: 'MarcusDenker 6/21/2012 11:18'!
asOneArgSelector
	^ String streamContents: [:str|
		| parts |
		parts := (self findTokens: ':)').
			str nextPutAll: parts first.
			parts allButFirst do: [:each | str nextPutAll: each capitalized]	.
			str nextPutAll: ':']! !

!Symbol methodsFor: 'printing' stamp: 'sw 8/19/1999 11:30'!
isOrientedFill
	"Needs to be implemented here because symbols can occupy 'color' slots of morphs."

	^ false! !

!Symbol methodsFor: 'accessing' stamp: ''!
at: anInteger put: anObject 
	"You cannot modify the receiver."

	self errorNoModification! !

!Symbol methodsFor: 'system primitives' stamp: 'MarcusDenker 2/29/2012 11:18'!
flushCache
	"Tell the interpreter to remove all entries with this symbol as a selector from its method lookup cache, if it has one.  This primitive must be called whenever a method is redefined or removed.
	NOTE:  Only one of the two selective flush methods (Symbol or CompiledMethod) needs to be used."

	<primitive: 119>
! !

!Symbol methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 2/17/2015 12:34'!
brickValue: anObject withEnoughArguments: aCollection

	^ anObject perform: self withEnoughArguments: aCollection! !

!Symbol methodsFor: 'accessing' stamp: ''!
replaceFrom: start to: stop with: replacement startingAt: repStart

	self errorNoModification! !

!Symbol methodsFor: '*Slot' stamp: 'MartinDias 8/7/2012 01:31'!
isPseudovariableName
	"Answer true if I am a pseudo-variable name.
	#self isPseudovariableName -> true
	"
	^ self class pseudovariablesNames includes: self! !

!Symbol methodsFor: 'testing' stamp: 'StephaneDucasse 5/28/2011 13:42'!
isUnary
	"Answer whether the receiver is an unary message selector."

	^ self precedence = 1! !

!Symbol methodsFor: 'converting' stamp: 'sw 1/28/98 18:18'!
capitalized
	^ self asString capitalized asSymbol! !

!Symbol methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 1/22/2015 22:32'!
phlowValue: anObject

	^ self cull: anObject! !

!Symbol methodsFor: '*System-Support' stamp: 'MarcusDenker 7/17/2014 19:11'!
senders
	^SystemNavigation new allSendersOf: self! !

!Symbol methodsFor: '*metacello-core' stamp: 'DaleHenrichs 12/21/2010 13:54'!
setPostLoadDoItInMetacelloSpec: aMetacelloSpec
    self precedence == 0
        ifTrue: [ self error: 'Invalid selector' ].
    aMetacelloSpec
        setPostLoadDoIt:
            (aMetacelloSpec project valueHolderSpec
                value: self;
                yourself)! !

!Symbol methodsFor: '*Slot' stamp: 'MarcusDenker 7/13/2014 11:56'!
=> aVariable
	aVariable isBehavior
		ifTrue: [ ^ aVariable named: self].
	^ aVariable name: self;
		yourself! !

!Symbol methodsFor: '*Slot' stamp: 'MarcusDenker 1/16/2015 12:12'!
asClassVariable
	^ ClassVariable named: self.! !

!Symbol methodsFor: 'converting' stamp: 'StephaneDucasse 2/22/2013 18:18'!
asAnnouncement

	^ self! !

!Symbol methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 11/17/2014 23:10'!
gtInspectorSendersIn: composite
	<gtInspectorPresentationOrder: 30>
	composite list 
		title: 'Senders';
		display: [ self systemNavigation allSendersOf: self ];
		when: [ (self systemNavigation allSendersOf: self) notEmpty ];
		showOnly: 30;
		withSmalltalkSearch ! !

!Symbol methodsFor: 'copying' stamp: 'tk 8/19/1998 16:05'!
veryDeepCopyWith: deepCopier
	"Return self.  I am immutable in the Morphic world.  Do not record me."! !

!Symbol methodsFor: 'converting' stamp: 'BernardoContreras 8/11/2014 19:23'!
uncapitalized
	"Answer an object like the receiver but with first character downshifted if necessary"

	^ self asString uncapitalized asSymbol! !

!Symbol methodsFor: '*metacello-core' stamp: 'dkh 9/5/2012 06:26:03.064'!
setForVersion: aString withInMetacelloConfig: aMetacelloConstructore
    aMetacelloConstructore setFor: {self} version: aString! !

!Symbol methodsFor: 'printing' stamp: 'BenjaminVanRyseghem 11/24/2010 14:43'!
storeOn: aStream 

	aStream nextPut: $#.
	(self isLiteralSymbol)
		ifTrue: [aStream nextPutAll: self]
		ifFalse: [super storeOn: aStream]! !

!Symbol methodsFor: 'copying' stamp: ''!
copy
	"Answer with the receiver, because Symbols are unique."! !

!Symbol methodsFor: 'copying' stamp: ''!
shallowCopy
	"Answer with the receiver, because Symbols are unique."! !

!Symbol methodsFor: 'system primitives' stamp: 'CamilloBruni 9/7/2011 16:21'!
numArgs: n
	"Answer a string that can be used as a selector with n arguments.
	 TODO: need to be extended to support shrinking and for selectors like #+ " 

	| selector numArgs offs |
	
	selector := self.
	(numArgs := selector numArgs) >= n 
		ifTrue: [ ^ self ].
	
	^ self class new: 16 streamContents: [ :stream|
		stream nextPutAll: self.
		(numArgs = 0) 
			ifTrue: [ stream nextPut: $:. offs := 0] 
			ifFalse: [ offs := 1 ].
		2 to: n - numArgs + offs do: [:i | 
			stream nextPutAll: 'with:' ]].
	
! !

!Symbol methodsFor: '*opalcompiler-core' stamp: 'md 8/13/2014 10:29'!
asMethodPreamble
	self numArgs = 0
		ifTrue: [ ^ self asString ].
	^ String
		streamContents: [ :str | 
			self keywords
				doWithIndex: [ :each :index | 
					str
						nextPutAll: each;
						nextPutAll: ' var';
						nextPutAll: index asString ] ]! !

!Symbol methodsFor: 'comparing' stamp: 'ar 4/10/2005 23:45'!
= aSymbol
	"Compare the receiver and aSymbol." 
	self == aSymbol ifTrue: [^ true].
	self class == aSymbol class ifTrue: [^ false].
	"Use String comparison otherwise"
	^ super = aSymbol! !

!Symbol methodsFor: '*metacello-core' stamp: 'dkh 9/7/2012 13:11'!
asMetacelloAttributeList
    ^ {self}! !

!Symbol methodsFor: '*metacello-core' stamp: 'dkh 9/7/2012 13:44'!
asMetacelloAttributePath
    ^ MetacelloMethodSectionPath with: {self}! !

!Symbol methodsFor: 'testing' stamp: 'md 4/30/2003 15:31'!
isSymbol
	^ true ! !

!Symbol methodsFor: '*metacello-core' stamp: 'DaleHenrichs 12/21/2010 13:55'!
setPreLoadDoItInMetacelloSpec: aMetacelloSpec
    self precedence == 0
        ifTrue: [ self error: 'Invalid selector' ].
    aMetacelloSpec
        setPreLoadDoIt:
            (aMetacelloSpec project valueHolderSpec
                value: self;
                yourself)! !

!Symbol methodsFor: 'converting' stamp: 'NicolaiHess 3/9/2015 14:58'!
asMutator
	"Return a setter message from a getter message. For example,
	#name asMutator returns #name:
	return self if it is already a setter"
	self endsWithAColon ifTrue:[ ^ self ].
	^ (self copyWith: $:) asSymbol! !

!Symbol methodsFor: 'announcements' stamp: 'StephaneDucasse 2/22/2013 18:21'!
handlesAnnouncement: anAnnouncement 
	"Anything else than the announcement identifier (in the case of symbol i.e. #foo for ... on: #foo send: #bar to: nil) will not 
	be handled."
	
	"Announcer new 
		on: #FOO send: #bar to: nil;
		announce: #FOO should raise DNU bar"
	
	^ anAnnouncement == self! !

!Symbol methodsFor: '*System-Support' stamp: 'MarcusDenker 7/17/2014 19:07'!
implementors
	^SystemNavigation new allImplementorsOf: self! !

!Symbol methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 1/20/2015 17:26'!
brickValue: aBrick

	^ self cull: aBrick! !

!Symbol methodsFor: 'private' stamp: ''!
errorNoModification

	self error: 'symbols can not be modified.'! !

!Symbol class methodsFor: 'private' stamp: 'MarcusDenker 10/9/2013 10:42'!
hasInterned: aString ifTrue: symBlock
	"Answer with false if aString hasnt been interned (into a Symbol),  
	otherwise supply the symbol to symBlock and return true."

	^ (self lookup: aString)
		ifNil: [ false ]
		ifNotNil: [ :symbol | 
			symBlock value: symbol.
			true ]! !

!Symbol class methodsFor: 'instance creation' stamp: 'SheridanMahoney 11/12/2009 22:04'!
new: aSize

	self shouldNotImplement .! !

!Symbol class methodsFor: 'stream creation' stamp: 'CamilloBruni 9/5/2011 15:35'!
new: size streamContents: aBlock
	^ (super new: size streamContents: aBlock) asSymbol! !

!Symbol class methodsFor: 'instance creation' stamp: 'MarcusDenker 5/18/2013 15:44'!
readFrom: strm  
	"Symbol readFromString: '#abc'"

	strm peek = $# ifFalse: [self error: 'Symbols must be introduced by #'].
    	^ strm contents parseLiterals first.
 ! !

!Symbol class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:03'!
gtExampleFourtyTwo
	<gtExample>
	^ #fourtyTwo! !

!Symbol class methodsFor: 'access' stamp: 'RAA 5/29/2001 14:35'!
thatStarts: leadingCharacters skipping: skipSym
	"Answer a selector symbol that starts with leadingCharacters.
	Symbols beginning with a lower-case letter handled directly here.
	Ignore case after first char.
	If skipSym is not nil, it is a previous answer; start searching after it.
	If no symbols are found, answer nil.
	Used by Alt-q (Command-q) routines"

	| size firstMatch key |

	size := leadingCharacters size.
	size = 0 ifTrue: [^skipSym ifNil: [#''] ifNotNil: [nil]].

	firstMatch := leadingCharacters at: 1.
	size > 1 ifTrue: [key := leadingCharacters copyFrom: 2 to: size].

	self allSymbolTablesDo: [:each |
			each size >= size ifTrue:
				[
					((each at: 1) == firstMatch and:
						[key == nil or:
							[(each findString: key startingAt: 2 caseSensitive: false) = 2]])
								ifTrue: [^each]
				]
		] after: skipSym.

	^nil

"Symbol thatStarts: 'sf' skipping: nil"
"Symbol thatStarts: 'sf' skipping: #sfpGetFile:with:with:with:with:with:with:with:with:"
"Symbol thatStarts: 'candidate' skipping: nil"
! !

!Symbol class methodsFor: 'access' stamp: 'ar 4/10/2005 22:49'!
allSymbols
	"Answer all interned symbols"
	^Array streamContents:[:s|
		s nextPutAll: NewSymbols.
		s nextPutAll: OneCharacterSymbols.
		s nextPutAll: SymbolTable.
	].
! !

!Symbol class methodsFor: 'initialization' stamp: 'RAA 5/29/2001 09:04'!
initialize

	"Symbol initialize"

	Symbol rehash.
	OneCharacterSymbols := nil.
	OneCharacterSymbols := (1 to: 256) collect: [ :i | (i - 1) asCharacter asSymbol].
	Smalltalk addToShutDownList: self.
! !

!Symbol class methodsFor: 'initialization' stamp: 'RAA 5/29/2001 14:35'!
allSymbolTablesDo: aBlock after: aSymbol

	NewSymbols do: aBlock after: aSymbol.
	SymbolTable do: aBlock after: aSymbol.! !

!Symbol class methodsFor: 'instance creation' stamp: ''!
newFrom: aCollection 
	"Answer an instance of me containing the same elements as aCollection."

	^ (aCollection as: String) asSymbol

"	Symbol newFrom: {$P. $e. $n}
	{$P. $e. $n} as: Symbol
"! !

!Symbol class methodsFor: 'access' stamp: 'BernardoContreras 8/11/2014 19:12'!
selectorsContaining: aString
	"Answer a list of selectors that contain aString within them. Case-insensitive.  Does return symbols that begin with a capital letter."

	| size selectorList ascii |

	selectorList := OrderedCollection new.
	(size := aString size) = 0 ifTrue: [^selectorList].

	aString size = 1 ifTrue:
		[
			ascii := aString first asciiValue.
			ascii < 128 ifTrue: [selectorList add: (OneCharacterSymbols at: ascii+1)]
		].

	(aString first isAlphaNumeric) ifFalse:
		[
			aString size = 2 ifTrue: 
				[Symbol hasInterned: aString ifTrue:
					[:s | selectorList add: s]].
			^selectorList
		].

	selectorList := selectorList copyFrom: 2 to: selectorList size.

	self allSymbolTablesDo: [:each |
		each size >= size ifTrue:
			[(each findSubstring: aString in: each startingAt: 1 
				matchTable: CaseInsensitiveOrder) > 0
						ifTrue: [selectorList add: each]]].

	^selectorList reject: [:each | "reject non-selectors, but keep ones that begin with an uppercase"
		each numArgs < 0 and: [each asString uncapitalized numArgs < 0]].

"Symbol selectorsContaining: 'scon'"! !

!Symbol class methodsFor: 'instance creation' stamp: 'RAA 5/29/2001 08:09'!
lookup: aStringOrSymbol

	^(SymbolTable like: aStringOrSymbol) ifNil: [
		NewSymbols like: aStringOrSymbol
	]! !

!Symbol class methodsFor: 'private' stamp: 'ar 9/27/2005 20:01'!
rehash		"Symbol rehash"
	"Rebuild the hash table, reclaiming unreferenced Symbols."

	SymbolTable := WeakSet withAll: self allSubInstances.
	NewSymbols := WeakSet new.! !

!Symbol class methodsFor: 'initialization' stamp: 'RAA 5/29/2001 08:21'!
allSymbolTablesDo: aBlock

	NewSymbols do: aBlock.
	SymbolTable do: aBlock.! !

!Symbol class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 11/24/2010 14:44'!
with: aCharacter
	^self newFrom: aCharacter asOrderedCollection! !

!Symbol class methodsFor: 'access' stamp: 'tween 9/13/2004 10:09'!
thatStartsCaseSensitive: leadingCharacters skipping: skipSym
	"Same as thatStarts:skipping: but caseSensitive"
	| size firstMatch key |

	size := leadingCharacters size.
	size = 0 ifTrue: [^skipSym ifNil: [#''] ifNotNil: [nil]].
	firstMatch := leadingCharacters at: 1.
	size > 1 ifTrue: [key := leadingCharacters copyFrom: 2 to: size].
	self allSymbolTablesDo: [:each |
			each size >= size ifTrue:
				[
					((each at: 1) == firstMatch and:
						[key == nil or:
							[(each findString: key startingAt: 2 caseSensitive: true) = 2]])
								ifTrue: [^each]
				]
		] after: skipSym.

	^nil
! !

!Symbol class methodsFor: 'initialization' stamp: 'RAA 12/17/2000 18:05'!
compactSymbolTable
	"Reduce the size of the symbol table so that it holds all existing symbols + 25% (changed from 1000 since sets like to have 25% free and the extra space would grow back in a hurry)"

	| oldSize |

	Smalltalk garbageCollect.
	oldSize := SymbolTable array size.
	SymbolTable growTo: SymbolTable size * 4 // 3 + 100.
	^oldSize printString,'  ',(oldSize - SymbolTable array size) printString, ' slot(s) reclaimed'! !

!Symbol class methodsFor: '*Slot' stamp: 'MartinDias 8/7/2012 01:18'!
pseudovariablesNames
	^#('self' 'true' 'false' 'nil' 'thisContext' 'super')! !

!Symbol class methodsFor: 'cleanup' stamp: 'StephaneDucasse 3/9/2010 22:17'!
cleanUp
	"Flush caches"

	self compactSymbolTable.! !

!Symbol class methodsFor: 'accessing' stamp: 'CamilloBruni 9/5/2011 15:22'!
streamSpecies
	^ String! !

!Symbol class methodsFor: 'private' stamp: 'RAA 5/29/2001 09:04'!
shutDown: aboutToQuit

	SymbolTable addAll: NewSymbols.
	NewSymbols := WeakSet new.! !

!Symbol class methodsFor: 'instance creation' stamp: 'MarcusDenker 7/23/2014 13:17'!
findInterned: aString

	self hasInterned:aString ifTrue:[:symbol| ^symbol].
	^nil.! !

!Symbol class methodsFor: 'instance creation' stamp: 'ar 4/10/2005 23:04'!
internCharacter: aCharacter
	aCharacter asciiValue > 256 ifTrue:[^self intern: aCharacter asString].
	OneCharacterSymbols ifNil: [^self intern: aCharacter asString].
	^OneCharacterSymbols at: aCharacter asciiValue + 1
! !

!Symbol class methodsFor: 'instance creation' stamp: 'CamilloBruni 9/9/2011 12:57'!
withAll: aCollection
	^ self newFrom: aCollection! !

!Symbol class methodsFor: 'private' stamp: 'nice 1/5/2010 15:59'!
possibleSelectorsFor: misspelled 
	"Answer an ordered collection of possible corrections
	for the misspelled selector in order of likelyhood"

	| numArgs candidates lookupString best binary short long first |
	lookupString := misspelled asLowercase. "correct uppercase selectors to lowercase"
	numArgs := lookupString numArgs.
	(numArgs < 0 or: [lookupString size < 2]) ifTrue: [^ OrderedCollection new: 0].
	first := lookupString first.
	short := lookupString size - (lookupString size // 4 max: 3) max: 2.
	long := lookupString size + (lookupString size // 4 max: 3).

	"First assemble candidates for detailed scoring"
	candidates := OrderedCollection new.
	self allSymbolTablesDo: [:s | | ss | (((ss := s size) >= short	"not too short"
			and: [ss <= long			"not too long"
					or: [(s at: 1) = first]])	"well, any length OK if starts w/same letter"
			and: [s numArgs = numArgs])	"and numArgs is the same"
			ifTrue: [candidates add: s]].

	"Then further prune these by correctAgainst:"
	best := lookupString correctAgainst: candidates.
	((misspelled last ~~ $:) and: [misspelled size > 1]) ifTrue: [
		binary := misspelled, ':'.		"try for missing colon"
		Symbol hasInterned: binary ifTrue: [:him | best addFirst: him]].
	^ best! !

!Symbol class methodsFor: 'instance creation' stamp: 'SheridanMahoney 11/17/2009 13:23'!
intern: aStringOrSymbol 

	^(self lookup: aStringOrSymbol) ifNil:[
		| aClass aSymbol |
		aStringOrSymbol isSymbol ifTrue:[
			aSymbol := aStringOrSymbol.
		] ifFalse:[
			aClass := aStringOrSymbol isOctetString ifTrue:[ByteSymbol] ifFalse:[WideSymbol].
			aSymbol := aClass basicNew: aStringOrSymbol size.
			aSymbol string: aStringOrSymbol.
		].
		NewSymbols add: aSymbol.
		aSymbol].! !

!SymbolTest commentStamp: '<historical>'!
This is the unit test for the class Symbol. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see: 
	- http://www.c2.com/cgi/wiki?UnitTest
	- there is a chapter in the PharoByExample book (http://pharobyexample.org/)
	- the sunit class category!
!SymbolTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButLast
	"self debug: #testAllButLast"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButLast.
	self deny: abf last = col last.
	self assert: abf size + 1 = col size! !

!SymbolTest methodsFor: 'tests - begins ends with' stamp: ''!
testsEndsWith
	
	self assert: (self nonEmpty endsWith: self nonEmpty copyWithoutFirst).
	self assert: (self nonEmpty endsWith: self nonEmpty).
	self deny: (self nonEmpty endsWith: (self nonEmpty copyWith: self nonEmpty first)).! !

!SymbolTest methodsFor: 'tests - equality' stamp: ''!
testHasEqualElementsOfIdenticalCollectionObjects
	"self debug: #testHasEqualElementsOfIdenticalCollectionObjects"
	
	self assert: (self empty hasEqualElements: self empty). 
	self assert: (self nonEmpty hasEqualElements: self nonEmpty). 
	! !

!SymbolTest methodsFor: 'tests - copying with replacement' stamp: ''!
testCopyReplaceAllWith1Occurence
	| result  firstIndexesOfOccurrence index endPartIndexResult endPartIndexCollection |
	
	result := self collectionWith1TimeSubcollection  copyReplaceAll: self oldSubCollection with: self replacementCollection .
	
	"detecting indexes of olSubCollection"
	firstIndexesOfOccurrence  := self firstIndexesOf: self oldSubCollection in: self collectionWith1TimeSubcollection .
	index:= firstIndexesOfOccurrence at: 1.
	
	"verify content of 'result' : "
	"first part of 'result'' : '"

	1 to: (index -1) do: 
		[
		:i |  
		self assert: (self collectionWith1TimeSubcollection  at:i)=(result at: i)
		].

	" middle part containing replacementCollection : "
	
	index to: (index + self replacementCollection size-1) do: 
		[
		:i |
		self assert: ( result at: i )=(self replacementCollection at: ( i - index + 1 ))
		].
	
	" end part :"
	
	endPartIndexResult :=  index + self replacementCollection  size .
	endPartIndexCollection :=   index + self oldSubCollection size  .
	
	1 to: (result size - endPartIndexResult - 1 ) do:
		[ 
		:i |
		self assert: (result at: ( endPartIndexResult + i - 1 ) ) = (self collectionWith1TimeSubcollection  at: ( endPartIndexCollection + i - 1 ) ).
		].
	
	
	! !

!SymbolTest methodsFor: 'tests - index access' stamp: ''!
testLastIndexOf
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection lastIndexOf: element) = 1.
	self assert: (collection lastIndexOf: self elementNotInForIndexAccessing) = 0! !

!SymbolTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyWithReplacementTest
	self replacementCollection.
	self oldSubCollection.
	self collectionWith1TimeSubcollection.
	self assert: (self howMany: self oldSubCollection in: self collectionWith1TimeSubcollection) = 1! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 15:15'!
moreThan4Elements

" return a collection including at leat 4 elements"
	^ nonEmptySymbol5ElementsNoDuplicates ! !

!SymbolTest methodsFor: 'tests - subcollections access' stamp: ''!
testFirstNElements
	"self debug: #testFirstNElements"
	| result |
	result := self moreThan3Elements first: self moreThan3Elements size - 1.
	1 
		to: result size
		do: [ :i | self assert: (result at: i) = (self moreThan3Elements at: i) ].
	self assert: result size = (self moreThan3Elements size - 1).
	self 
		should: [ self moreThan3Elements first: self moreThan3Elements size + 1 ]
		raise: Error! !

!SymbolTest methodsFor: 'tests - as class' stamp: 'CamilloBruni 5/8/2013 11:56'!
testAsClassIfAbsent

	self 
		assert: (#Symbol asClassIfAbsent: [ self fail ])
		equals: Symbol.
		
	#+ asClassIfAbsent: [ ^ self "success" ].
	self fail.! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 15:41'!
collectionWith2TimeSubcollection
" return a collection including 'oldSubCollection'  two or many time "
	^ with2timeSubcollection ! !

!SymbolTest methodsFor: 'tests - fixture' stamp: ''!
test0TStructuralEqualityTest
	self empty.
	self nonEmpty.
	self assert: self empty isEmpty.
	self deny: self nonEmpty isEmpty! !

!SymbolTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithoutFirst

	| result |
	result := self nonEmpty copyWithoutFirst.
	
	self assert: result size = (self nonEmpty size - 1).
	
	1 to: result size do:
		[:i |
		self assert: (result at: i)= (self nonEmpty at: (i + 1))].! !

!SymbolTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionTwoSimilarElementsInIntersection
	"self debug: #testIntersectionBasic"
	| inter |
	inter := self collection intersection: (self collectionClass with: self anotherElementOrAssociationIn).
	self assert: (self collection occurrencesOf: self anotherElementOrAssociationIn) = self numberOfSimilarElementsInIntersection.
	self assert: (inter includes: self anotherElementOrAssociationIn value)! !

!SymbolTest methodsFor: 'tests - element accessing' stamp: ''!
testBefore
	"self debug: #testBefore"
	self assert: (self moreThan4Elements before: (self moreThan4Elements at: 2)) = (self moreThan4Elements at: 1).
	self 
		should: [ self moreThan4Elements before: (self moreThan4Elements at: 1) ]
		raise: Error.
	self 
		should: [ self moreThan4Elements before: 66 ]
		raise: Error! !

!SymbolTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testLastIndexOfDuplicate
	"self debug: #testLastIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection first.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'lastIndexOf: should return the position of the last occurrence :'"
	self assert: (collection lastIndexOf: element) = collection size! !

!SymbolTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAnyNoneThere
	"self debug: #testIncludesAnyOfNoneThere'"
	
	self deny: (self nonEmpty includesAny: self empty).
	self deny: (self nonEmpty includesAny: { self elementNotIn. self anotherElementNotIn })! !

!SymbolTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedArray
	| result collection |
	collection := self collectionWithSortableElements .
	result := collection  asArray sort.
	self assert: (result class includesBehavior: Array).
	self assert: result isSorted.
	self assert: result size = collection size! !

!SymbolTest methodsFor: 'requirements' stamp: 'CamilloBruni 9/9/2011 12:12'!
collectionWithoutEqualElements

" return a collection not including equal elements "
	^ nonEmptySymbol5ElementsNoDuplicates ! !

!SymbolTest methodsFor: 'tests - converting' stamp: ''!
testAsArray
	"self debug: #testAsArray3"
	self 
		assertSameContents: self collectionWithoutEqualElements
		whenConvertedTo: Array! !

!SymbolTest methodsFor: 'requirements' stamp: 'DamienCassou 8/27/2013 21:05'!
unsortedCollection
" retur a collection that is not yat sorted"
	^ with2timeSubcollection! !

!SymbolTest methodsFor: 'tests - copy' stamp: 'MarcusDenker 8/20/2011 13:46'!
testCopyNotSame
	"There is only one symbol, the copy is the same"
	
	| copy | 
	copy := self nonEmpty copy.
	self assert: copy  == self nonEmpty.! !

!SymbolTest methodsFor: 'tests - set arithmetic' stamp: ''!
testUnionOfEmpties
	"self debug: #testUnionOfEmpties"
	
	self assert:  (self empty union: self empty) isEmpty.
	
	! !

!SymbolTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindFirst

	| element result |
	element := self nonEmptyMoreThan1Element   at:1.
	 result:=self nonEmptyMoreThan1Element  findFirst: [:each | each =element].
	
	self assert: result=1. ! !

!SymbolTest methodsFor: 'tests - copying part of sequenceable for multipliness' stamp: ''!
testCopyUpToWithDuplicate
	| result element  collection |
	collection := self collectionWithSameAtEndAndBegining .
	element := collection  last.
	
	" collectionWithSameAtEndAndBegining first and last elements are equals.
	'copyUpTo:' should copy until the first occurence :"
	result := collection   copyUpTo: (element ).
	
	"verifying content: "
	self assert: result isEmpty.

! !

!SymbolTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithIndexCollect
	
	| result index collection |
	index := 0.
	collection := self nonEmptyMoreThan1Element .
	result := collection  withIndexCollect: [:each :i | 
		self assert: i = (index := index + 1).	
		self assert: i = (collection  indexOf: each) .
		each] . 
	
	1 to: result size do:[: i | self assert: (result at:i)= (collection at: i)].
	self assert: result size = collection size.! !

!SymbolTest methodsFor: 'testing' stamp: 'StephaneDucasse 3/12/2011 16:30'!
expectedBehavior
	| result |
	
	^result := { 
		[Symbol readFromString: '#''abc'''] -> #abc.
		[Symbol readFromString: '#ab-C'] -> #ab.
	 	[Symbol readFromString: '#abC'] -> #abC. 
		[Symbol readFromString: '#ab@c'] -> #ab}.! !

!SymbolTest methodsFor: 'tests - printing' stamp: ''!
testPrintElementsOn

	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printElementsOn: aStream .
	allElementsAsString:=(result findBetweenSubStrs: ' ' ).
	1 to: allElementsAsString size do:
		[:i | 
		self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString).
			].! !

!SymbolTest methodsFor: 'tests - begins ends with' stamp: ''!
testsEndsWithEmpty
	
	self deny: (self nonEmpty endsWith: self empty).
	self deny: (self empty endsWith: self nonEmpty).
	! !

!SymbolTest methodsFor: 'tests - concatenation' stamp: ''!
testConcatenationWithEmpty
	| result |
	result:= self empty,self secondCollection .
	
	1 to: self secondCollection size do:
		[:i | 
		self assert: (self secondCollection at:i)= (result at:i).
		].
	"size : "
	self assert: result size = ( self secondCollection size).! !

!SymbolTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIterateSequencedReadableTest

	| res |
	
	self nonEmptyMoreThan1Element.
	self assert: self nonEmptyMoreThan1Element  size > 1.
	
	
	self empty.
	self assert: self empty isEmpty .
	
	res := true.
	self nonEmptyMoreThan1Element    
	detect: [ :each | (self nonEmptyMoreThan1Element    occurrencesOf: each) > 1 ]
	ifNone: [ res := false ].
	self assert: res = false.! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 14:49'!
anotherElementNotIn
	^ notIn ! !

!SymbolTest methodsFor: 'tests - copying part of sequenceable for multipliness' stamp: ''!
testCopyUpToLastWithDuplicate
	| result element  collection |
	collection := self collectionWithSameAtEndAndBegining .
	element := collection  first.
	
	" collectionWithSameAtEndAndBegining first and last elements are equals.
	'copyUpToLast:' should copy until the last occurence :"
	result := collection   copyUpToLast: (element ).
	
	"verifying content: "
	1 to: result size do:
		[:i |
		self assert: (result at: i ) = ( collection at: i )  
		].
	
	self assert: result size = (collection size - 1).

! !

!SymbolTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithSequenceable

	| result index element |
	index := self indexInNonEmpty .
	element := self nonEmpty at: index.
	result := self nonEmpty copyWith: (element ).
	
	self assert: result size = (self nonEmpty size + 1).
	self assert: result last = element .
	
	1 to: (result size - 1) do:
	[ :i |
	self assert: (result at: i) = ( self nonEmpty at: ( i  ))].! !

!SymbolTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterLastEmpty

	| delim emptyStream |
	delim := ', '.
	emptyStream := ReadWriteStream on: ''.
	self empty asStringOn: emptyStream delimiter: delim last:'and'.
	self assert: emptyStream contents = ''.
! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 15:39'!
collectionWith1TimeSubcollection
" return a collection including 'oldSubCollection'  only one time "
	^ nonEmptySymbol5ElementsNoDuplicates ! !

!SymbolTest methodsFor: 'tests' stamp: 'LukasRenggli 8/22/2010 17:38'!
testNumArgsKeyword1
	self assert: ('name:' numArgs = 1).

	self assert: ('name_:' numArgs = 1).
	self assert: ('_name:' numArgs = 1).
	self assert: ('na_me:' numArgs = 1).

	self assert: ('name: ' numArgs = -1).
	self assert: (' name:' numArgs = -1).
	self assert: ('na me:' numArgs = -1).
	
	self assert: ('name+:' numArgs = -1).
	self assert: ('+name:' numArgs = -1).
	self assert: ('na+me:' numArgs = -1).
	
	self assert: ('name123:' numArgs = 1).
	self assert: ('na123me:' numArgs = 1).
	self assert: ('123name:' numArgs = -1)! !

!SymbolTest methodsFor: 'tests - element accessing' stamp: ''!
testAtOutOfBounds
	"self debug: #testAtOutOfBounds"
	self 
		should: [ self moreThan4Elements at: self moreThan4Elements size + 1 ]
		raise: Error.
	self 
		should: [ self moreThan4Elements at: -1 ]
		raise: Error! !

!SymbolTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOfEmpty
	| result |
	result := self empty occurrencesOf: (self collectionWithoutEqualElements anyOne).
	self assert: result = 0! !

!SymbolTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyEmpty
	"self debug: #testCopyEmpty"
	
	| copy | 
	copy := self empty copy.
	self assert: copy isEmpty.! !

!SymbolTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithCollect
	
	| result firstCollection secondCollection index  |

	firstCollection := self nonEmptyMoreThan1Element.
	secondCollection := firstCollection copy.
	index := 0.
	
	result := firstCollection  with: secondCollection collect:
		[:a :b |
		( index := index + 1).
		self assert: (firstCollection at: index) equals:  a. 
		self assert: (secondCollection at: index) equals:  b.
		b].
	
	1 to: result size do:[: i | self assert: (result at:i)= (secondCollection  at: i)].
	self assert: result size = secondCollection  size.! !

!SymbolTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterLastOne

	| delim oneItemStream result |
	
	delim := ', '.
	result:=''.
	oneItemStream := ReadWriteStream on: result.
	self nonEmpty1Element  asStringOn: oneItemStream delimiter: delim last: 'and'.
	oneItemStream do:[:each | self assert: each = (self nonEmpty1Element first asString)].
	

	! !

!SymbolTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSetAritmeticTest
	self collection.
	self deny: self collection isEmpty.
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self anotherElementOrAssociationNotIn.
	self collection isDictionary
		ifTrue: [ self deny: (self collection associations includes: self anotherElementOrAssociationNotIn key) ]
		ifFalse: [ self deny: (self collection includes: self anotherElementOrAssociationNotIn) ].
	self collectionClass! !

!SymbolTest methodsFor: 'tests - printing' stamp: ''!
testPrintOnDelimiter
	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printOn: aStream delimiter: ', ' .
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString).
			].! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 14:56'!
collectionWithoutNilElements
" return a collection that doesn't includes a nil element  and that doesn't includes equal elements'"
	^nonEmptySymbol5ElementsNoDuplicates ! !

!SymbolTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureTConvertTest
	"a collection of number without equal elements:"

	| res |
	self collectionWithoutEqualElements.
	res := true.
	self collectionWithoutEqualElements
		detect: [ :each | (self collectionWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false! !

!SymbolTest methodsFor: 'tests - copy' stamp: ''!
testCopyReturnsIdentity
	"self debug: #testCopyReturnsIdentity"
	
	| copy | 
	copy := self nonEmpty copy.
	self assert: self nonEmpty == copy.
	! !

!SymbolTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterMore

	| delim multiItemStream result index |
	"delim := ', '.
	multiItemStream := '' readWrite.
	self oneTwoThreeItemCol asStringOn: multiItemStream delimiter: ', '.
	self assert: multiItemStream contents = '1, 2, 3'."
	
	delim := ', '.
	result:=''.
	multiItemStream := ReadWriteStream on:result.
	self nonEmpty  asStringOn: multiItemStream delimiter: ', '.
	
	index:=1.
	(result findBetweenSubStrs: ', ' )do:
		[:each |
		self assert: each= ((self nonEmpty at:index)asString).
		index:=index+1
		].! !

!SymbolTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testDetectSequenced
" testing that detect keep the first element returning true for sequenceable collections "

	| element result |
	element := self nonEmptyMoreThan1Element   at:1.
	result:=self nonEmptyMoreThan1Element  detect: [:each | each notNil ].
	self assert: result = element. ! !

!SymbolTest methodsFor: 'tests - includes' stamp: ''!
testIdentityIncludesNonSpecificComportement
	" test the same comportement than 'includes: '  "
	| collection |	
	collection := self nonEmpty  .
	
	self deny: (collection identityIncludes: self elementNotIn ).
	self assert:(collection identityIncludes: collection anyOne)
! !

!SymbolTest methodsFor: 'requirements' stamp: 'StephaneDucasse 6/9/2012 22:54'!
testNew
	"self debug: #testNew"

	
	self should: [Symbol new: 5 ] raise: self defaultTestError. ! !

!SymbolTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureAsStringCommaAndDelimiterTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty.
	self nonEmpty1Element.
	self assert: self nonEmpty1Element size = 1! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 15:10'!
collectionMoreThan1NoDuplicates
	" return a collection of size > 1 without equal elements"
	^ nonEmptySymbol5ElementsNoDuplicates ! !

!SymbolTest methodsFor: 'as yet unclassified' stamp: ''!
testSorted
	| result tmp unsorted |
	unsorted := self unsortedCollection.
	result := unsorted sorted.
	self deny: unsorted == result.
	tmp := result at: 1.
	result
		do: [ :each | 
			self assert: each >= tmp.
			tmp := each ]! !

!SymbolTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAnyAllThere
	"self debug: #testIncludesAnyOfAllThere'"
	self deny: (self nonEmpty includesAny: self empty).
	self assert: (self nonEmpty includesAny: { self nonEmpty anyOne }).
	self assert: (self nonEmpty includesAny: self nonEmpty).! !

!SymbolTest methodsFor: 'test - copy' stamp: 'delaunay 4/17/2009 15:26'!
elementToAdd
	^ $u! !

!SymbolTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testPairsDo
	| index |
	index:=1.
	
	self nonEmptyMoreThan1Element  pairsDo: 
		[:each1 :each2 | 
		self assert:(self nonEmptyMoreThan1Element at:index)=each1.
		self assert:(self nonEmptyMoreThan1Element at:(index+1))=each2.
		index:=index+2].
	
	self nonEmptyMoreThan1Element size odd
		ifTrue:[self assert: index=self nonEmptyMoreThan1Element size]
		ifFalse:[self assert: index=(self nonEmptyMoreThan1Element size+1)].! !

!SymbolTest methodsFor: 'tests - subcollections access' stamp: ''!
testLastNElements
	"self debug: #testLastNElements"
	| result |
	result := self moreThan3Elements last: self moreThan3Elements size - 1.
	1 
		to: result size
		do: [ :i | self assert: (result at: i) = (self moreThan3Elements at: i + 1) ].
	self assert: result size = (self moreThan3Elements size - 1).
	self 
		should: [ self moreThan3Elements last: self moreThan3Elements size + 1 ]
		raise: Error! !

!SymbolTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testCollectFromTo
	
	| result |
	result:=self nonEmptyMoreThan1Element 
		collect: [ :each | each ]
		from: 1
		to: (self nonEmptyMoreThan1Element size - 1).
		
	1 to: result size
		do: [ :i | self assert: (self nonEmptyMoreThan1Element at: i) = (result at: i) ].
	self assert: result size = (self nonEmptyMoreThan1Element size - 1)! !

!SymbolTest methodsFor: 'tests - printing' stamp: ''!
testPrintNameOn

	| aStream result |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printNameOn: aStream .
	Transcript show: result asString.
	self nonEmpty class name first isVowel
		ifTrue:[ self assert: aStream contents =('an ',self nonEmpty class name ) ]
		ifFalse:[self assert: aStream contents =('a ',self nonEmpty class name)].! !

!SymbolTest methodsFor: 'tests - fixture' stamp: ''!
test0SortingArrayedTest
	| tmp sorted |
	" an unsorted collection of number "
	self unsortedCollection.
	self unsortedCollection do: [ :each | each isNumber ].
	sorted := true.
	self unsortedCollection
		pairsDo: [ :each1 :each2 | 
			each2 < each1
				ifTrue: [ sorted := false ] ].
	self assert: sorted = false.	" a collection of number sorted in an ascending order"
	self sortedInAscendingOrderCollection.
	self sortedInAscendingOrderCollection do: [ :each | each isNumber ].
	tmp := self sortedInAscendingOrderCollection at: 1.
	self sortedInAscendingOrderCollection
		do: [ :each | 
			self assert: each >= tmp.
			tmp := each ]! !

!SymbolTest methodsFor: 'test - equality' stamp: ''!
testEqualSignIsTrueForNonIdenticalButEqualCollections
	"self debug: #testEqualSignIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty = self empty copy). 
	self assert: (self empty copy = self empty).
	self assert: (self empty copy = self empty copy).
		
	self assert: (self nonEmpty = self nonEmpty copy). 
	self assert: (self nonEmpty copy = self nonEmpty).
	self assert: (self nonEmpty copy = self nonEmpty copy).! !

!SymbolTest methodsFor: 'tests - copying with replacement' stamp: ''!
testCopyReplaceAllWithManyOccurence
	| result firstIndexesOfOccurrence resultBetweenPartIndex collectionBetweenPartIndex diff |
	" testing fixture here as this method may be not used for collection that can't contain equals element :"
	self collectionWith2TimeSubcollection.
	self assert: (self howMany: self oldSubCollection in: self collectionWith2TimeSubcollection) = 2.	" test :"
	diff := self replacementCollection size - self oldSubCollection size.
	result := self collectionWith2TimeSubcollection copyReplaceAll: self oldSubCollection with: self replacementCollection.	"detecting indexes of olSubCollection"
	firstIndexesOfOccurrence := self firstIndexesOf: self oldSubCollection in: self collectionWith2TimeSubcollection.	" verifying that replacementCollection has been put in places of oldSubCollections "
	firstIndexesOfOccurrence
		do: [ :each | 
			(firstIndexesOfOccurrence indexOf: each) = 1
				ifTrue: [ each to: self replacementCollection size do: [ :i | self assert: (result at: i) = (self replacementCollection at: i - each + 1) ] ]
				ifFalse: [ each + diff to: self replacementCollection size do: [ :i | self assert: (result at: i) = (self replacementCollection at: i - each + 1) ] ] ].	" verifying that the 'between' parts correspond to the initial collection : "
	1 to: firstIndexesOfOccurrence size do: [ :i | 
		i = 1
			ifTrue: [ 1 to: (firstIndexesOfOccurrence at: i) - 1 do: [ :j | self assert: (result at: i) = (self collectionWith2TimeSubcollection at: i) ] ]
			ifFalse: [ 
				resultBetweenPartIndex := (firstIndexesOfOccurrence at: i - 1) + self replacementCollection size.
				collectionBetweenPartIndex := (firstIndexesOfOccurrence at: i - 1) + self oldSubCollection size.
				1 to: (firstIndexesOfOccurrence at: i) - collectionBetweenPartIndex - 1 do: [ :j | 
					self
						assert:
							(result at: resultBetweenPartIndex + i - 1)
								= (self collectionWith2TimeSubcollection at: collectionBetweenPartIndex + i - 1) ] ]	" specific comportement for the begining of the collection :"	" between parts till the end : " ].	"final part :"
	1 to: self collectionWith2TimeSubcollection size - (firstIndexesOfOccurrence last + self oldSubCollection size) do: [ :i | 
		self
			assert:
				(result at: firstIndexesOfOccurrence last + self replacementCollection size - 1 + i)
					= (self collectionWith2TimeSubcollection at: firstIndexesOfOccurrence last + self oldSubCollection size - 1 + i) ]! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 15:15'!
elementInForElementAccessing
" return an element inculded in 'moreThan4Elements'"
	^ self moreThan4Elements anyOne! !

!SymbolTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testIndexOfStartingAtDuplicate
	"self debug: #testLastIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection last.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'indexOf:ifAbsent:startingAt: should return the position of the first occurrence :'"
	self assert: (collection 
			indexOf: element
			startingAt: 1
			ifAbsent: [ 55 ]) = 1.
	self assert: (collection 
			indexOf: element
			startingAt: 2
			ifAbsent: [ 55 ]) = collection size! !

!SymbolTest methodsFor: 'tests - copying with replacement' stamp: ''!
testCopyReplaceFromToWithInsertion
	| result  indexOfSubcollection |
	
	indexOfSubcollection := (self firstIndexesOf: self oldSubCollection  in:  self collectionWith1TimeSubcollection) at: 1. 
	
	result := self collectionWith1TimeSubcollection  copyReplaceFrom: indexOfSubcollection  to: ( indexOfSubcollection - 1 ) with: self replacementCollection .
	
	"verify content of 'result' : "
	"first part of 'result'' : '"
	
	1 to: (indexOfSubcollection -1) do: 
		[
		:i | 
		self assert: (self collectionWith1TimeSubcollection  at:i)=(result at: i)
		].
	
	" middle part containing replacementCollection : "
	indexOfSubcollection  to: (indexOfSubcollection  + self replacementCollection size-1) do: 
		[
		:i |
		self assert: ( result at: i )=(self replacementCollection at: ( i - indexOfSubcollection +1 ))
		].
	
	" end part :"
	(indexOfSubcollection  + self replacementCollection size) to: (result size) do:
		[:i|
		self assert: (result at: i)=(self collectionWith1TimeSubcollection  at: (i-self replacementCollection size))].
	
	" verify size: "	
	self assert: result size=(self collectionWith1TimeSubcollection  size + self replacementCollection size).
	

	

	
	! !

!SymbolTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsCommaStringMore

	"self assert: self oneTwoThreeItemCol asCommaString = '1, 2, 3'.
	self assert: self oneTwoThreeItemCol asCommaStringAnd = '1, 2 and 3'
"

	| result resultAnd index allElementsAsString |
	result:= self nonEmpty asCommaString .
	resultAnd:= self nonEmpty asCommaStringAnd .
 
	index := 1.
	(result findBetweenSubStrs: ',' )do:
		[:each |
		index = 1
			ifTrue: [self assert: each= ((self nonEmpty at:index)asString)]
			ifFalse: [self assert: each= (' ',(self nonEmpty at:index) asString)].
		index:=index+1
		].
	
	"verifying esultAnd :"
	allElementsAsString:=(resultAnd findBetweenSubStrs: ',' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size )
			ifTrue: [
			i = 1
				ifTrue:[self assert: (allElementsAsString at:i)=((self nonEmpty at:i) asString)]
				ifFalse:[self assert: (allElementsAsString at:i)=(' ',(self nonEmpty at:i) asString)]
				].
		i=(allElementsAsString size)
			ifTrue:[ 
			i = 1
				ifTrue:[self assert: (allElementsAsString at:i)=( (self nonEmpty at:i ) asString ,' and ', (self nonEmpty at: ( i + 1) ) asString )]
				ifFalse:[self assert: (allElementsAsString at:i)=( ' ' , (self nonEmpty at:i ) asString ,' and ', (self nonEmpty at: ( i + 1) ) asString )]
				].
		
		
			].! !

!SymbolTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWith
	"self debug: #testCopyNonEmptyWith"
	| res anElement |
	anElement := self elementToAdd .
	res := self nonEmpty copyWith: anElement.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self assert: (res includes: (anElement value)).
	self nonEmpty do: [ :each | res includes: each ]! !

!SymbolTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfterLastEmpty
	| result |
	result := self empty copyAfterLast: self collectionWithoutEqualElements first.
	self assert: result isEmpty.! !

!SymbolTest methodsFor: 'tests - copy' stamp: 'delaunay 3/30/2009 10:33'!
testCopyNonEmptyWithoutAllNotIncluded
	! !

!SymbolTest methodsFor: 'tests - index access' stamp: ''!
testIdentityIndexOfIAbsent
	| collection element |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			identityIndexOf: element
			ifAbsent: [ 0 ]) = 1.
	self assert: (collection 
			identityIndexOf: self elementNotInForIndexAccessing
			ifAbsent: [ 55 ]) = 55! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 5/13/2009 16:00'!
collectionWithEqualElements
" return a collecition including atLeast two elements equal"

^ sameAtEndAndBegining .! !

!SymbolTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfSubCollectionStartingAt
	"self debug: #testIndexOfIfAbsent"
	| subcollection index collection |
	collection := self collectionMoreThan1NoDuplicates.
	subcollection := self collectionMoreThan1NoDuplicates.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 1.
	self assert: index = 1.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 2.
	self assert: index = 0! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 15:20'!
collectionWithSortableElements
	" return a collection only including elements that can be sorted (understanding '<' )"
	^ nonEmptySymbol5ElementsNoDuplicates .! !

!SymbolTest methodsFor: 'tests - copying part of sequenceable for multipliness' stamp: ''!
testCopyAfterWithDuplicate
	| result element  collection |
	collection := self collectionWithSameAtEndAndBegining .
	element := collection  last.
	
	" collectionWithSameAtEndAndBegining first and last elements are equals.
	'copyAfter:' should copy after the first occurence :"
	result := collection   copyAfter: (element ).
	
	"verifying content: "
	1 to: result size do: 
		[:i |
		self assert: (collection  at:(i + 1 )) = (result at: (i))
		].

	"verify size: "
	self assert: result size = (collection size - 1).! !

!SymbolTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedCollectionWithSortBlock
	| result tmp |
	result := self collectionWithSortableElements  asSortedCollection: [:a :b | a > b].
	self assert: (result class includesBehavior: SortedCollection).
	result do: 
		[ :each | 
		self assert: (self collectionWithSortableElements   occurrencesOf: each) = (result occurrencesOf: each) ].
	self assert: result size = self collectionWithSortableElements  size.
	tmp:=result at: 1.
	result do: [:each| self assert: tmp>=each. tmp:=each].
	! !

!SymbolTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureTConvertAsSetForMultiplinessTest
	"a collection  with equal elements:"

	| res |
	self withEqualElements.
	res := true.
	self withEqualElements detect: [ :each | (self withEqualElements occurrencesOf: each) > 1 ] ifNone: [ res := false ].
	self assert: res = true! !

!SymbolTest methodsFor: 'tests - sorting' stamp: ''!
testSortedUsingBlock
	| result tmp |
	result := self unsortedCollection sorted:  [:a :b | a>b]..
	tmp := result at: 1.
	result do:
		[:each | self assert: each<=tmp. tmp:= each. ].! !

!SymbolTest methodsFor: 'tests - index access' stamp: ''!
testIdentityIndexOf
	"self debug: #testIdentityIndexOf"
	| collection element |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection identityIndexOf: element) = (collection indexOf: element)! !

!SymbolTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureOccurrencesTest
	| tmp |
	self empty.
	self assert: self empty isEmpty.
	self collectionWithoutEqualElements.
	self deny: self collectionWithoutEqualElements isEmpty.
	tmp := OrderedCollection new.
	self collectionWithoutEqualElements
		do: [ :each | 
			self deny: (tmp includes: each).
			tmp add: each ].
	self elementNotInForOccurrences.
	self deny: (self collectionWithoutEqualElements includes: self elementNotInForOccurrences)! !

!SymbolTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIndexAccessTest
	| res collection element |
	self collectionMoreThan1NoDuplicates.
	self assert: self collectionMoreThan1NoDuplicates size > 1.
	res := true.
	self collectionMoreThan1NoDuplicates
		detect: [ :each | (self collectionMoreThan1NoDuplicates occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false.
	self elementInForIndexAccessing.
	self
		assert: ((collection := self collectionMoreThan1NoDuplicates) includes: (element := self elementInForIndexAccessing)).
	self elementNotInForIndexAccessing.
	self deny: (self collectionMoreThan1NoDuplicates includes: self elementNotInForIndexAccessing)! !

!SymbolTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithDo
	
	| firstCollection secondCollection index |

	firstCollection := self nonEmptyMoreThan1Element.
	secondCollection := firstCollection copy.
	index := 0.
	
	firstCollection  with: secondCollection do:
		[:a :b |
		( index := index + 1).
		self assert: (firstCollection at: index) equals:  a. 
		self assert: (secondCollection at: index) equals:  b.]
	
	! !

!SymbolTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testAllButFirstDo
	
	| result |
	result:= OrderedCollection  new.
	
	self nonEmptyMoreThan1Element  allButFirstDo: [:each | result add: each].
	
	1 to: (result size) do:
		[:i|
		self assert: (self nonEmptyMoreThan1Element  at:(i +1))=(result at:i)].
	
	self assert: result size=(self nonEmptyMoreThan1Element  size-1).! !

!SymbolTest methodsFor: 'requirements' stamp: 'DamienCassou 8/27/2013 21:05'!
sortedInAscendingOrderCollection
" return a collection sorted in an acsending order"
	^ collectionSize4
	! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 15:00'!
secondCollection
" return a collection that will be the second part of the concatenation"
	^ collectionSize4 ! !

!SymbolTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithDoError
	
	self should: [self nonEmptyMoreThan1Element with: self empty do:[:a :b | ]] raise: Error.! !

!SymbolTest methodsFor: 'tests - element accessing' stamp: ''!
testAtWrap
	"self debug: #testAt"
	"
	self assert: (self accessCollection at: 1) = 1.
	self assert: (self accessCollection at: 2) = 2.
	"
	| index |
	index := self moreThan4Elements indexOf: self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: index) = self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: index + self moreThan4Elements size) = self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: index - self moreThan4Elements size) = self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: 1 + self moreThan4Elements size) = (self moreThan4Elements at: 1)! !

!SymbolTest methodsFor: 'tests - concatenation' stamp: ''!
testConcatenation
	| result index |
	result:= self firstCollection,self secondCollection .
	"first part : "
	index := 1.
	self firstCollection do: 
		[:each | 
		self assert: (self firstCollection at: index)=each.
		index := index+1.].
	"second part : "
	1 to: self secondCollection size do:
		[:i | 
		self assert: (self secondCollection at:i)= (result at:index).
		index:=index+1].
	"size : "
	self assert: result size = (self firstCollection size + self secondCollection size).! !

!SymbolTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutNotIncluded
	"self debug: #testCopyNonEmptyWithoutNotIncluded"
	| res |
	res := self nonEmpty copyWithout: self elementToAdd.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self nonEmpty do: [ :each | self assert: (res includes: each) ]! !

!SymbolTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithout
	"self debug: #testCopyNonEmptyWithout"
	
	| res anElementOfTheCollection |
	anElementOfTheCollection :=  self nonEmpty anyOne.
	res := (self nonEmpty copyWithout: anElementOfTheCollection).
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self deny: (res includes: anElementOfTheCollection).
	self nonEmpty do:
		[:each | (each = anElementOfTheCollection) 
					ifFalse: [self assert: (res includes: each)]].
	
! !

!SymbolTest methodsFor: 'tests - converting' stamp: ''!
testAsOrderedCollection
	
	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: OrderedCollection! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 5/13/2009 16:00'!
elementTwiceInForOccurrences
" return an element included exactly two time in # collectionWithEqualElements"
^ sameAtEndAndBegining first! !

!SymbolTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionItself
	"self debug: #testIntersectionItself"
	
	| result |
	result :=  (self collectionWithoutEqualElements intersection: self collectionWithoutEqualElements).
	self assert: result size  = self collectionWithoutEqualElements size.
	self collectionWithoutEqualElements do: [ :each|
		self assert: (result includes: each) ].
	! !

!SymbolTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOf
	| collection |
	collection := self collectionWithoutEqualElements .
	
	collection do: [ :each | self assert: (collection occurrencesOf: each) = 1 ].! !

!SymbolTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testKeysAndValuesDo
	"| result |
	result:= OrderedCollection new.
	
	self nonEmptyMoreThan1Element  keysAndValuesDo: 
		[:i :value|
		result add: (value+i)].
	
	1 to: result size do:
		[:i|
		self assert: (result at:i)=((self nonEmptyMoreThan1Element at:i)+i)]"
	|  indexes elements |
	indexes:= OrderedCollection new.
	elements := OrderedCollection new.
	
	self nonEmptyMoreThan1Element  keysAndValuesDo: 
		[:i :value|
		indexes  add: (i).
		elements add: value].
	
	(1 to: self nonEmptyMoreThan1Element size )do:
		[ :i |
		self assert: (indexes at: i) = i.
		self assert: (elements at: i) = (self nonEmptyMoreThan1Element at: i).	
		].
	
	self assert: indexes size = elements size. 
	self assert: indexes size = self nonEmptyMoreThan1Element size . 
	
	! !

!SymbolTest methodsFor: 'tests - fixture' stamp: ''!
test0CopyTest
	self empty.
	self assert: self empty size = 0.
	self nonEmpty.
	self assert: (self nonEmpty size = 0) not.
	self collectionWithElementsToRemove.
	self assert: (self collectionWithElementsToRemove size = 0) not.
	self collectionWithElementsToRemove do: [ :each | self assert: (self nonEmpty includes: each) ].
	self elementToAdd.
	self deny: (self nonEmpty includes: self elementToAdd).
	self collectionNotIncluded.
	self collectionNotIncluded do: [ :each | self deny: (self nonEmpty includes: each) ]! !

!SymbolTest methodsFor: 'tests - streaming' stamp: ''!
testStreamContentsProtocol
	| result index |
	result:= self collectionClass << [ :s|
		s 
			nextPutAll: self firstCollection;
			nextPutAll: self secondCollection ].
	self assert: result equals: self firstCollection, self secondCollection.! !

!SymbolTest methodsFor: 'tests - as class' stamp: 'CamilloBruni 5/8/2013 11:34'!
testAsClass
	self 
		assert: #Symbol asClass
		equals: Symbol! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 16:17'!
indexInNonEmpty
" return an index between bounds of 'nonEmpty' "

	^ 2! !

!SymbolTest methodsFor: 'tests' stamp: 'sd 6/5/2005 09:29'!
testCapitalized

	| uc lc |		
	uc := #MElViN.
	lc := #mElViN.
	self assert:  lc capitalized = uc.
	self assert: uc capitalized = uc.
! !

!SymbolTest methodsFor: 'tests - begins ends with' stamp: ''!
testsBeginsWithEmpty
	
	self deny: (self nonEmpty beginsWith:(self empty)).
	self deny: (self empty beginsWith:(self nonEmpty )).
! !

!SymbolTest methodsFor: 'tests - equality' stamp: ''!
testHasEqualElements
	"self debug: #testHasEqualElements"

	self deny: (self empty hasEqualElements: self nonEmpty).
	self deny: (self nonEmpty hasEqualElements: self nonEmpty asSet). 
	self deny: (self nonEmpty reversed hasEqualElements: self nonEmpty).
	self deny: (self nonEmpty hasEqualElements: self nonEmpty reversed).! !

!SymbolTest methodsFor: 'testing' stamp: 'StephaneDucasse 3/12/2011 16:31'!
testReadFrom

	self expectedBehavior do: [:association |
		self assert: (association key value == association value)]! !

!SymbolTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSequencedConcatenationTest
	self empty.
	self assert: self empty isEmpty.
	self firstCollection.
	self secondCollection! !

!SymbolTest methodsFor: 'test - equality' stamp: ''!
testEqualSign
	"self debug: #testEqualSign"

	self deny: (self empty = self nonEmpty).! !

!SymbolTest methodsFor: 'tests - as sorted collection' stamp: ''!
testAsSortedCollection

	| aCollection result |
	aCollection := self collectionWithSortableElements .
	result := aCollection asSortedCollection.
	
	self assert: (result class includesBehavior: SortedCollection).
	result do: 
		[ :each | 
		self assert: (aCollection occurrencesOf: each) = (result occurrencesOf: each) ].
	
	self assert: result size = aCollection size.! !

!SymbolTest methodsFor: 'tests - fixture' stamp: ''!
test0TSequencedStructuralEqualityTest
	self nonEmpty at: 1	"Ensures #nonEmpty is sequenceable"! !

!SymbolTest methodsFor: 'test - set arithmetic' stamp: 'stephane.ducasse 12/20/2008 21:57'!
collectionClass

	^ Symbol! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 15:02'!
nonEmpty1Element
" return a collection of size 1 including one element"
	^collection1Element ! !

!SymbolTest methodsFor: 'tests - begins ends with' stamp: ''!
testsBeginsWith
	
	self assert: (self nonEmpty beginsWith:(self nonEmpty copyUpTo: self nonEmpty last)).
	self assert: (self nonEmpty beginsWith:(self nonEmpty )).
	self deny: (self nonEmpty beginsWith:(self nonEmpty copyWith:self nonEmpty first)).! !

!SymbolTest methodsFor: 'tests - set arithmetic' stamp: ''!
testUnion
	"self debug: #testUnionOfEmpties"
	
	| union |
	union := self empty union: self nonEmpty.
	self containsAll: union of: self empty andOf: self nonEmpty.
	union := self nonEmpty union: self empty.
	self containsAll: union of: self empty andOf: self nonEmpty.
	union := self collection union: self nonEmpty.
	self containsAll: union of: self collection andOf: self nonEmpty.! !

!SymbolTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWithout
	"self debug: #testCopyEmptyWithout"
	| res |
	res := self empty copyWithout: self elementToAdd.
	self assert: res size = self empty size.
	self deny: (res includes: self elementToAdd)! !

!SymbolTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testDo! !

!SymbolTest methodsFor: 'tests - equality' stamp: ''!
testHasEqualElementsIsTrueForNonIdenticalButEqualCollections
	"self debug: #testHasEqualElementsIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty hasEqualElements: self empty copy). 
	self assert: (self empty copy hasEqualElements: self empty).
	self assert: (self empty copy hasEqualElements: self empty copy).
		
	self assert: (self nonEmpty hasEqualElements: self nonEmpty copy). 
	self assert: (self nonEmpty copy hasEqualElements: self nonEmpty).
	self assert: (self nonEmpty copy hasEqualElements: self nonEmpty copy).! !

!SymbolTest methodsFor: 'tests - copying with replacement' stamp: ''!
testCopyReplaceFromToWith
	| result  indexOfSubcollection lastIndexOfOldSubcollection lastIndexOfReplacementCollection |
	
	indexOfSubcollection := (self firstIndexesOf: self oldSubCollection  in:  self collectionWith1TimeSubcollection) at: 1. 
	lastIndexOfOldSubcollection := indexOfSubcollection + self oldSubCollection size -1.
	lastIndexOfReplacementCollection := indexOfSubcollection + self replacementCollection  size -1.
	
	result := self collectionWith1TimeSubcollection  copyReplaceFrom: indexOfSubcollection  to: lastIndexOfOldSubcollection   with: self replacementCollection .
	
	"verify content of 'result' : "
	"first part of 'result'  "
	
	1 to: (indexOfSubcollection  - 1) do: 
		[ 
		:i | 
		self assert: (self collectionWith1TimeSubcollection  at:i) = (result at: i)
		].
	
	" middle part containing replacementCollection : "
	
	(indexOfSubcollection ) to: ( lastIndexOfReplacementCollection  ) do: 
		[
		:i |
		self assert: (result at: i)=(self replacementCollection at: (i - indexOfSubcollection +1))
		].
	
	" end part :"
	1 to: (result size - lastIndexOfReplacementCollection   ) do:
		[ 
		:i |
		self assert: (result at: ( lastIndexOfReplacementCollection  + i  ) ) = (self collectionWith1TimeSubcollection  at: ( lastIndexOfOldSubcollection  + i  ) ).
		].
	
	
	

	
	! !

!SymbolTest methodsFor: 'tests' stamp: 'BernardoContreras 8/11/2014 19:13'!
testUncapitalized

	| uc lc empty |		
	uc := #MElViN.
	lc := #mElViN.
	empty := #' '.
	self assert:  uc uncapitalized = lc.
	self assert: lc uncapitalized = lc.
	
! !

!SymbolTest methodsFor: 'tests - copy' stamp: ''!
testCopySameClass
	"self debug: #testCopySameClass"
	"A copy of a collection should always be of the same class as the instance it copies"
	
	| copy | 
	copy := self empty copy.
	self assert: copy class == self empty class.! !

!SymbolTest methodsFor: 'tests - element accessing' stamp: ''!
testAfter
	"self debug: #testAfter"
	self assert: (self moreThan4Elements after: (self moreThan4Elements at: 1)) = (self moreThan4Elements at: 2).
	self 
		should: 
			[ self moreThan4Elements after: (self moreThan4Elements at: self moreThan4Elements size) ]
		raise: Error.
	self 
		should: [ self moreThan4Elements after: self elementNotInForElementAccessing ]
		raise: Error! !

!SymbolTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButFirstNElements
	"self debug: #testAllButFirst"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButFirst: 2.
	1 
		to: abf size
		do: [ :i | self assert: (abf at: i) = (col at: i + 2) ].
	self assert: abf size + 2 = col size! !

!SymbolTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfter
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyAfter: (collection  at:index ).
	
	"verifying content: "
	(1) to: result size do: 
		[:i |
		self assert: (collection   at:(i + index ))=(result at: (i))].

	"verify size: "
	self assert: result size = (collection   size - index).! !

!SymbolTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 12/18/2009 13:45'!
oldSubCollection
" return a subCollection included in collectionWith1TimeSubcollection .
ex :   subCollection := #( 2 3 4) and collectionWith1TimeSubcollection := #(1 2 3 4 5)"
	^ subcollection3ElementsSorted  ! !

!SymbolTest methodsFor: 'tests - sorting' stamp: ''!
testIsSortedBy
	self assert: (self sortedInAscendingOrderCollection isSortedBy: [:a :b | a<b]).
	self deny: (self sortedInAscendingOrderCollection isSortedBy: [:a :b | a>b]).
! !

!SymbolTest methodsFor: 'tests - fixture' stamp: ''!
test0FixturePrintTest
	self nonEmpty! !

!SymbolTest methodsFor: 'tests' stamp: 'LukasRenggli 8/22/2010 17:32'!
testNumArgsUnary
	self assert: ('name' numArgs = 0).

	self assert: ('name_' numArgs = 0).
	self assert: ('_name' numArgs = 0).
	self assert: ('na_me' numArgs = 0).

	self assert: ('name ' numArgs = -1).
	self assert: (' name' numArgs = -1).
	self assert: ('na me' numArgs = -1).
	
	self assert: ('name+' numArgs = -1).
	self assert: ('+name' numArgs = -1).
	self assert: ('na+me' numArgs = -1).
	
	self assert: ('name123' numArgs = 0).
	self assert: ('na123me' numArgs = 0).
	self assert: ('123name' numArgs = -1)! !

!SymbolTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testReverseWithDo
	
	| firstCollection secondCollection index |

	firstCollection := self nonEmptyMoreThan1Element.
	secondCollection := firstCollection copy.
	index := firstCollection size.
	
	firstCollection  reverseWith: secondCollection do:
		[:a :b |
	
		self assert: (firstCollection at: index) equals:  a. 
		self assert: (secondCollection at: index) equals:  b.
			( index := index - 1).]
	
	
	! !

!SymbolTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyFromTo
	| result  index collection |
	collection := self collectionWithoutEqualElements .
	index :=self indexInForCollectionWithoutDuplicates .
	result := collection   copyFrom: index  to: collection  size .
	
	"verify content of 'result' : "
	1 to: result size do:
		[:i | 
		self assert: (result at:i)=(collection  at: (i + index - 1))].
	
	"verify size of 'result' : "
	self assert: result size = (collection  size - index + 1).! !

!SymbolTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAllNoneThere
	"self debug: #testIncludesAllOfNoneThere'"
	self deny: (self empty includesAll: self nonEmpty ).
	self deny: (self nonEmpty includesAll: { self elementNotIn. self anotherElementNotIn })! !

!SymbolTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testKeysAndValuesDoEmpty
	| result |
	result:= OrderedCollection new.
	
	self empty  keysAndValuesDo: 
		[:i :value|
		result add: (value+i)].
	
	self assert: result isEmpty .! !

!SymbolTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfStartingAt
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			indexOf: element
			startingAt: 2
			ifAbsent: [ 99 ]) = 99.
	self assert: (collection 
			indexOf: element
			startingAt: 1
			ifAbsent: [ 99 ]) = 1.
	self assert: (collection 
			indexOf: self elementNotInForIndexAccessing
			startingAt: 1
			ifAbsent: [ 99 ]) = 99! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 15:15'!
elementNotInForElementAccessing
" return an element not included in 'moreThan4Elements' "
	^ notIn ! !

!SymbolTest methodsFor: 'tests - as set tests' stamp: ''!
testAsSetWithEqualsElements
	| result |
	result := self withEqualElements asSet.
	self withEqualElements do: [ :each | self assert: (result occurrencesOf: each) = 1 ].
	self assert: result class = Set! !

!SymbolTest methodsFor: 'tests - printing' stamp: ''!
testPrintOnDelimiterLast

	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printOn: aStream delimiter: ', ' last: 'and'.
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 )
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString)].
		i=(allElementsAsString size-1)
			ifTrue:[ self deny: (allElementsAsString at:i)=('and')asString].
		i=(allElementsAsString size)
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:(i-1))asString)].
			].! !

!SymbolTest methodsFor: 'tests - converting' stamp: ''!
testAsBag

	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: Bag! !

!SymbolTest methodsFor: 'tests - copying part of sequenceable for multipliness' stamp: ''!
testCopyAfterLastWithDuplicate
	| result element  collection |
	collection := self collectionWithSameAtEndAndBegining .
	element := collection  first.
	
	" collectionWithSameAtEndAndBegining first and last elements are equals.
	'copyAfter:' should copy after the last occurence of element :"
	result := collection   copyAfterLast: (element ).
	
	"verifying content: "
	self assert: result isEmpty.

! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 15:37'!
indexInForCollectionWithoutDuplicates
" return an index between 'collectionWithoutEqualsElements'  bounds"
	^ 2! !

!SymbolTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWith
	"self debug: #testCopyWith"
	| res anElement |
	anElement := self elementToAdd.
	res := self empty copyWith: anElement.
	self assert: res size = (self empty size + 1).
	self assert: (res includes: (anElement value))! !

!SymbolTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureConverAsSortedTest
	self collectionWithSortableElements.
	self deny: self collectionWithSortableElements isEmpty! !

!SymbolTest methodsFor: 'tests - fixture' stamp: ''!
howMany: aSubCollection in: collection
" return an integer representing how many time 'subCollection'  appears in 'collection'  "
	| tmp nTime |
	tmp := collection.
	nTime:= 0.
	
	[tmp isEmpty ]whileFalse:
		[
		(tmp beginsWith: aSubCollection)
			ifTrue: [ 	
				nTime := nTime + 1.
				1 to: aSubCollection size do: [:i | tmp := tmp copyWithoutFirst.]
				]
			ifFalse: [tmp := tmp copyWithoutFirst.]
		 ].
	
	^ nTime.
	! !

!SymbolTest methodsFor: 'tests - printing' stamp: ''!
testStoreOn
" for the moment work only for collection that include simple elements such that Integer"

"| string str result cuttedResult index elementsAsStringExpected elementsAsStringObtained tmp |
string := ''.
str := ReadWriteStream  on: string.
elementsAsStringExpected := OrderedCollection new.
elementsAsStringObtained := OrderedCollection new.
self nonEmpty do: [ :each | elementsAsStringExpected  add: each asString].

self nonEmpty storeOn: str.
result := str contents .
cuttedResult := ( result findBetweenSubStrs: ';' ).

index := 1.

cuttedResult do:
	[ :each |
	index = 1 
		ifTrue: [ self assert: (each beginsWith: ( tmp := '((' , self nonEmpty class asString , ' new) add: '           )).
				tmp := each copyFrom: ( tmp size + 1) to: ( each size ).
				elementsAsStringObtained add: tmp.
				index := index + 1. ]
		ifFalse:  [ 
		 index < cuttedResult size
			ifTrue:[self assert: (each beginsWith: ( tmp:=  ' add: '   )).
				tmp := each copyFrom: ( tmp size + 1) to: ( each size ).
				elementsAsStringObtained add: tmp.
					index := index + 1.]
			ifFalse: [self assert: ( each = ' yourself)' ) ].
			]
	
	].


	elementsAsStringExpected do: [ :each | self assert: (elementsAsStringExpected occurrencesOf: each ) = ( elementsAsStringObtained occurrencesOf: each) ]"

! !

!SymbolTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfStartingAtIfAbsent
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			indexOf: element
			startingAt: 2
			ifAbsent: [ 99 ]) = 99.
	self assert: (collection 
			indexOf: element
			startingAt: 1
			ifAbsent: [ 99 ]) = 1.
	self assert: (collection 
			indexOf: self elementNotInForIndexAccessing
			startingAt: 1
			ifAbsent: [ 99 ]) = 99! !

!SymbolTest methodsFor: 'tests - set arithmetic' stamp: ''!
numberOfSimilarElementsInIntersection
	^ self collection occurrencesOf: self anotherElementOrAssociationIn! !

!SymbolTest methodsFor: 'tests - occurrencesOf for multipliness' stamp: ''!
testOccurrencesOfForMultipliness

| collection elem |
collection := self collectionWithEqualElements .
elem := self elementTwiceInForOccurrences .

self assert: (collection occurrencesOf: elem ) = 2.  ! !

!SymbolTest methodsFor: 'tests - element accessing' stamp: ''!
testAtAll
	"self debug: #testAtAll"
	"	self flag: #theCollectionshouldbe102030intheFixture.
	
	self assert: (self accessCollection atAll: #(2 1)) first = self accessCollection second.
	self assert: (self accessCollection atAll: #(2)) first = self accessCollection second."
	| result |
	result := self moreThan4Elements atAll: #(2 1 2 ).
	self assert: (result at: 1) = (self moreThan4Elements at: 2).
	self assert: (result at: 2) = (self moreThan4Elements at: 1).
	self assert: (result at: 3) = (self moreThan4Elements at: 2).
	self assert: (self moreThan4Elements atAll: #()) = self moreThan4Elements species new! !

!SymbolTest methodsFor: 'tests' stamp: 'NicolaiHess 3/9/2015 14:56'!
testAsMutator

	self assert: #x asMutator = #x:.
	"return receiver if it is already a mutator"
	self assert: #x: asMutator = #x:.
	self assert: #x asMutator isSymbol
	! !

!SymbolTest methodsFor: 'tests - converting' stamp: ''!
assertNonDuplicatedContents: aCollection whenConvertedTo: aClass 
	| result |
	result := aCollection perform: ('as' , aClass name) asSymbol.
	self assert: (result class includesBehavior: aClass).
	result do: 
		[ :each | 
		self assert: (aCollection occurrencesOf: each) = (result occurrencesOf: each) ].
	^ result! !

!SymbolTest methodsFor: 'tests - copying same contents' stamp: ''!
testShallowCopy
	| result |
	result := self nonEmpty shallowCopy .
	
	"verify content of 'result: '"
	1 to: self nonEmpty size do:
		[:i | self assert: ((result at:i)=(self nonEmpty at:i))].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!SymbolTest methodsFor: 'tests - streaming' stamp: ''!
testStreamContentsSized
	| result |
	result:= self collectionClass new: 1 streamContents: [ :s|
		s 
			nextPutAll: self firstCollection;
			nextPutAll: self secondCollection ].
	self assert: result equals: self firstCollection, self secondCollection.
	
	result:= self collectionClass new: 1000 streamContents: [ :s|
		s 
			nextPutAll: self firstCollection;
			nextPutAll: self secondCollection ].
	self assert: result equals: self firstCollection, self secondCollection.! !

!SymbolTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfIfAbsent
	"self debug: #testIndexOfIfAbsent"
	| collection |
	collection := self collectionMoreThan1NoDuplicates.
	self assert: (collection 
			indexOf: collection first
			ifAbsent: [ 33 ]) = 1.
	self assert: (collection 
			indexOf: self elementNotInForIndexAccessing
			ifAbsent: [ 33 ]) = 33! !

!SymbolTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyPartOfSequenceableTest
	self collectionWithoutEqualElements.
	self collectionWithoutEqualElements
		do: [ :each | self assert: (self collectionWithoutEqualElements occurrencesOf: each) = 1 ].
	self indexInForCollectionWithoutDuplicates.
	self
		assert:
			(self indexInForCollectionWithoutDuplicates > 0 & self indexInForCollectionWithoutDuplicates)
				< self collectionWithoutEqualElements size.
	self empty.
	self assert: self empty isEmpty! !

!SymbolTest methodsFor: 'tests - converting' stamp: ''!
testAsIdentitySet
	"test with a collection without equal elements :"
	self 
		assertSameContents: self collectionWithoutEqualElements
		whenConvertedTo: IdentitySet.
! !

!SymbolTest methodsFor: 'tests - converting' stamp: ''!
testAsSet
	| |
	"test with a collection without equal elements :"
	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: Set.
	! !

!SymbolTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyWithOrWithoutSpecificElementsTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self indexInNonEmpty.
	self assert: self indexInNonEmpty > 0.
	self assert: self indexInNonEmpty <= self nonEmpty size! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 15:11'!
elementNotInForIndexAccessing
" return an element not included in 'collectionMoreThan1NoDuplicates' "
	^ notIn ! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 15:00'!
firstCollection
" return a collection that will be the first part of the concatenation"
	^ nonEmptySymbol5ElementsNoDuplicates ! !

!SymbolTest methodsFor: 'tests - includes' stamp: ''!
testIncludesElementIsThere
	"self debug: #testIncludesElementIsThere"
	
	self assert: (self nonEmpty includes: self nonEmpty anyOne).! !

!SymbolTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifferenceWithSeparateCollection
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifferenceWithSeparateCollection"
	| res separateCol |
	
	separateCol := self collectionClass with: self anotherElementOrAssociationNotIn.
	res := self collectionWithoutEqualElements difference: separateCol.
	
	self deny: (res includes: self anotherElementOrAssociationNotIn).
	self assert: res size equals: self collectionWithoutEqualElements size.
	
	self collectionWithoutEqualElements do: [ :each|
		self assert: (res includes: each)].
	
	res := separateCol difference: self collection.
	self deny: (res includes: self collection anyOne).
	self assert: res equals: separateCol! !

!SymbolTest methodsFor: 'tests - as class' stamp: 'CamilloBruni 5/8/2013 11:57'!
testAsClassIfPresent
	
	#Symbol asClassIfPresent: [ :class | 
		self assert: class equals: Symbol ].
	
	#'+' asClassIfPresent: [ ^ self fail ].! !

!SymbolTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCloneTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 14:30'!
withEqualElements
	" return a collection  including equal elements (classic equality)"
	^ sameAtEndAndBegining ! !

!SymbolTest methodsFor: 'tests - element accessing' stamp: ''!
testAtLastError
	"self debug: #testAtLast"
	self 
		should: [ self moreThan4Elements atLast: self moreThan4Elements size + 1 ]
		raise: Error! !

!SymbolTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpToLastEmpty
	| result |
	result := self empty copyUpToLast: self collectionWithoutEqualElements first.
	self assert: result isEmpty.! !

!SymbolTest methodsFor: 'tests - index access' stamp: ''!
testIndexOfSubCollectionStartingAtIfAbsent
	"self debug: #testIndexOfIfAbsent"
	| index absent subcollection collection |
	collection := self collectionMoreThan1NoDuplicates.
	subcollection := self collectionMoreThan1NoDuplicates.
	absent := false.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 1
		ifAbsent: [ absent := true ].
	self assert: absent = false.
	absent := false.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 2
		ifAbsent: [ absent := true ].
	self assert: absent = true! !

!SymbolTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpToLast
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyUpToLast: (collection  at:index).
	
	"verify content of 'result' :"
	1 to: result size do: [:i| self assert: (collection   at:i)=(result at:i)].
	
	"verify size of 'result' :"
	self assert: result size = (index-1).! !

!SymbolTest methodsFor: 'tests - printing' stamp: ''!
testPrintOn
	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printOn: aStream .
	allElementsAsString:=(result findBetweenSubStrs: ' ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i=1
			ifTrue:[
			self accessCollection class name first isVowel 
				ifTrue:[self assert: (allElementsAsString at:i)='an' ]
				ifFalse:[self assert: (allElementsAsString at:i)='a'].].
		i=2
			ifTrue:[self assert: (allElementsAsString at:i)=self accessCollection class name].
		i>2
			ifTrue:[self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString).].	
			].! !

!SymbolTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpTo
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyUpTo: (collection  at:index).
	
	"verify content of 'result' :"
	1 to: result size do: [:i| self assert: (collection   at:i)=(result at:i)].
	
	"verify size of 'result' :"
	self assert: result size = (index-1).
	! !

!SymbolTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 12/18/2009 13:45'!
collectionWithElementsToRemove
" return a collection of elements included in 'nonEmpty'  "
	^ subcollection3ElementsSorted  ! !

!SymbolTest methodsFor: 'tests - element accessing' stamp: ''!
testLast
	"self debug: #testLast"
	self assert: self moreThan4Elements last = (self moreThan4Elements at: self moreThan4Elements size)! !

!SymbolTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterLastMore

	| delim multiItemStream result last allElementsAsString |
	
	delim := ', '.
	last := 'and'.
	result:=''.
	multiItemStream := ReadWriteStream on:result.
	self nonEmpty  asStringOn: multiItemStream delimiter: ', ' last: last.
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 )
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString)].
		i=(allElementsAsString size-1)
			ifTrue:[ self deny: (allElementsAsString at:i)=(last)asString].
		i=(allElementsAsString size)
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:(i-1))asString)].
			].
	
! !

!SymbolTest methodsFor: 'tests - copying same contents' stamp: ''!
testReversed
	| result |
	result := self nonEmpty reversed .
	
	"verify content of 'result: '"
	1 to:  result size do:
		[:i | self assert: ((result at:i)=(self nonEmpty at:(self nonEmpty size-i+1)))].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!SymbolTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIncludeTest
	| anElementIn |
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self elementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self elementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self anotherElementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self anotherElementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self empty.
	self assert: self empty isEmpty! !

!SymbolTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIndexAccessFotMultipliness
	self collectionWithSameAtEndAndBegining.
	self assert: self collectionWithSameAtEndAndBegining first = self collectionWithSameAtEndAndBegining last.
	self assert: self collectionWithSameAtEndAndBegining size > 1.
	1 to: self collectionWithSameAtEndAndBegining size do: [ :i | 
		i > 1 & (i < self collectionWithSameAtEndAndBegining size)
			ifTrue: [ self deny: (self collectionWithSameAtEndAndBegining at: i) = self collectionWithSameAtEndAndBegining first ] ]! !

!SymbolTest methodsFor: 'tests - includes' stamp: ''!
testIncludesElementIsNotThere
	"self debug: #testIncludesElementIsNotThere"
	
	self deny: (self nonEmpty includes: self elementNotIn).
	self assert: (self nonEmpty includes: self nonEmpty anyOne).
	self deny: (self empty includes: self elementNotIn)! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 15:39'!
replacementCollection
" return a collection that will be used to replace 'oldSubcollection' in ' collectionWith1TimeSubcollection'  " 
	^ collection1Element ! !

!SymbolTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfterEmpty
	| result |
	result := self empty copyAfter: self collectionWithoutEqualElements first.
	self assert: result isEmpty.
	! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 15:13'!
collectionWithSameAtEndAndBegining
	" return a collection with elements at end and begining equals .
(others elements of the collection are not equal to those elements)"
	^ sameAtEndAndBegining ! !

!SymbolTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testLastIndexOfStartingAtDuplicate
	"self debug: #testLastIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection last.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'lastIndexOf:ifAbsent:startingAt: should return the position of the last occurrence :'"
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size
			ifAbsent: [ 55 ]) = collection size.
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size - 1
			ifAbsent: [ 55 ]) = 1! !

!SymbolTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithoutIndex
	| result index |
	index := self indexInNonEmpty .
	result := self nonEmpty copyWithoutIndex: index .
	
	"verify content of 'result:'"
	1 to: result size do:
		[:i | 
		i<( index ) ifTrue: [self assert: ((result at:i )= (self nonEmpty at:i))].
		i>=( index ) ifTrue: [self assert: (result at:i )= (self nonEmpty at:(i+1))]].
	
	"verify size of result : "
	self assert: result size=(self nonEmpty size -1).! !

!SymbolTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testReverseDo
	| result |
	result:= OrderedCollection new.
	self nonEmpty reverseDo: [: each | result add: each].
	
	1 to: result size do:
		[:i|
		self assert: (result at: i)=(self nonEmpty at:(self nonEmpty size-i+1))].! !

!SymbolTest methodsFor: 'tests - copy' stamp: ''!
testCopyEquals
	"self debug: #testCopySameClass"
	"A copy should be equivalent to the things it's a copy of"
	
	| copy | 
	copy := self nonEmpty copy.
	self assert: copy  = self nonEmpty.! !

!SymbolTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testIndexOfDuplicate
	"self debug: #testIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection last.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'indexOf: should return the position of the first occurrence :'"
	self assert: (collection indexOf: element) = 1! !

!SymbolTest methodsFor: 'tests - copy' stamp: ''!
testCopyEmptyWithoutAll
	"self debug: #testCopyEmptyWithoutAll"
	| res |
	res := self empty copyWithoutAll: self collectionWithElementsToRemove.
	self assert: res size = self empty size.
	self collectionWithElementsToRemove do: [ :each | self deny: (res includes: each) ]! !

!SymbolTest methodsFor: 'tests - element accessing' stamp: ''!
testAtPin
	"self debug: #testAtPin"
	self assert: (self moreThan4Elements atPin: 2) = self moreThan4Elements second.
	self assert: (self moreThan4Elements atPin: 99) = self moreThan4Elements last.
	self assert: (self moreThan4Elements atPin: -99) = self moreThan4Elements first! !

!SymbolTest methodsFor: 'tests - copy' stamp: ''!
testCopyNonEmptyWithoutAll
	"self debug: #testCopyNonEmptyWithoutAll"
	| res |
	res := self nonEmpty copyWithoutAll: self collectionWithElementsToRemove.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self collectionWithElementsToRemove do: [ :each | self deny: (res includes: (each)) ].
	self nonEmpty do: 
		[ :each | 
		(self collectionWithElementsToRemove includes: each) ifFalse: [ self assert: (res includes: each) ] ]! !

!SymbolTest methodsFor: 'tests - element accessing' stamp: ''!
testAtLastIfAbsent
	"self debug: #testAtLastIfAbsent"
	self assert: (self moreThan4Elements 
			atLast: 1
			ifAbsent: [ nil ]) = self moreThan4Elements last.
	self assert: (self moreThan4Elements 
			atLast: self moreThan4Elements size + 1
			ifAbsent: [ 222 ]) = 222! !

!SymbolTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyAfterLast
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyAfterLast: (collection  at:index ).
	
	"verifying content: "
	(1) to: result size do: 
		[:i |
		self assert: (collection   at:(i + index ))=(result at: (i))].

	"verify size: "
	self assert: result size = (collection   size - index).! !

!SymbolTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButLastNElements
	"self debug: #testAllButFirst"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButLast: 2.
	1 
		to: abf size
		do: [ :i | self assert: (abf at: i) = (col at: i) ].
	self assert: abf size + 2 = col size! !

!SymbolTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindFirstNotIn

	| result |
	
	 result:=self empty findFirst: [:each | true].
	
	self assert: result=0. ! !

!SymbolTest methodsFor: 'test - equality' stamp: ''!
testEqualSignIsTrueForEmptyButNonIdenticalCollections
	"self debug: #testEqualSignIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty = self empty copy). 
	self assert: (self empty copy = self empty).
	self assert: (self empty copy = self empty copy).
		
! !

!SymbolTest methodsFor: 'tests - converting' stamp: ''!
assertNoDuplicates: aCollection whenConvertedTo: aClass 
	| result |
	result := self collectionWithEqualElements asIdentitySet.
	self assert: (result class includesBehavior: IdentitySet).
	self collectionWithEqualElements do: [ :initial | self assert: (result occurrencesOf: initial) = 1 ]! !

!SymbolTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureOccurrencesForMultiplinessTest
	| cpt anElement collection |
	self collectionWithEqualElements.
	self collectionWithEqualElements.
	self elementTwiceInForOccurrences.
	anElement := self elementTwiceInForOccurrences.
	collection := self collectionWithEqualElements.
	cpt := 0.	" testing with identity check ( == ) so that identy collections can use this trait : "
	self collectionWithEqualElements
		do: [ :each | 
			each == self elementTwiceInForOccurrences
				ifTrue: [ cpt := cpt + 1 ] ].
	self assert: cpt = 2! !

!SymbolTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsCommaStringEmpty

	self assert: self empty asCommaString = ''.
	self assert: self empty asCommaStringAnd = ''.
	
! !

!SymbolTest methodsFor: 'tests - copying with or without' stamp: ''!
testForceToPaddingWith

	| result element |
	element := self nonEmpty at: self indexInNonEmpty .
	result := self nonEmpty forceTo: (self nonEmpty size+2) paddingWith: ( element ).
	
	"verify content of 'result' : "
	1 to: self nonEmpty  size do:
		[:i | self assert: ( self nonEmpty at: i ) = ( result at:(i) ). ].
	
	(result size - 1) to: result size do:
		[:i | self assert: ( result at:i ) = ( element ) ].

	"verify size of 'result' :"
	self assert: result size = (self nonEmpty size + 2).! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 14:49'!
nonEmpty
	^ nonEmptySymbol5ElementsNoDuplicates ! !

!SymbolTest methodsFor: 'tests - element accessing' stamp: ''!
testAfterIfAbsent
	"self debug: #testAfterIfAbsent"
	self assert: (self moreThan4Elements 
			after: (self moreThan4Elements at: 1)
			ifAbsent: [ 33 ]) = (self moreThan4Elements at: 2).
	self assert: (self moreThan4Elements 
			after: (self moreThan4Elements at: self moreThan4Elements size)
			ifAbsent: [ 33 ]) = 33.
	self assert: (self moreThan4Elements 
			after: self elementNotInForElementAccessing
			ifAbsent: [ 33 ]) = 33! !

!SymbolTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindLast

	| element result |
	element := self nonEmptyMoreThan1Element  at:self nonEmptyMoreThan1Element  size.
	 result:=self nonEmptyMoreThan1Element  findLast: [:each | each =element].
	
	self assert: result=self nonEmptyMoreThan1Element  size. ! !

!SymbolTest methodsFor: 'tests - streaming' stamp: ''!
testNewStreamContentsReturnsCollectionOfCorrectSize
	| result item originalSize |
	originalSize := 10.
	item := self firstCollection first.
	result := self collectionClass
		new: originalSize
		streamContents: [ :stream | 
			1 to: originalSize + 1 do: [ :each | stream nextPut: item ].
			stream position: originalSize ].
	self assert: result size equals: originalSize! !

!SymbolTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyNonEmpty
	"self debug: #testCopyNonEmpty"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: copy isEmpty.
	self assert: copy size = self nonEmpty size.
	self nonEmpty do: 
		[:each | copy includes: each]! !

!SymbolTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testReverseDoEmpty
	| result |
	result:= OrderedCollection new.
	self empty reverseDo: [: each | result add: each].
	
	self assert: result isEmpty .! !

!SymbolTest methodsFor: 'tests - element accessing' stamp: ''!
testFirstSecondThird
	"self debug: #testFirstSecondThird"
	self assert: self moreThan4Elements first = (self moreThan4Elements at: 1).
	self assert: self moreThan4Elements second = (self moreThan4Elements at: 2).
	self assert: self moreThan4Elements third = (self moreThan4Elements at: 3).
	self assert: self moreThan4Elements fourth = (self moreThan4Elements at: 4)! !

!SymbolTest methodsFor: 'testing' stamp: 'StephaneDucasse 3/12/2011 16:30'!
testIsLiteralSymbol

	self assert: ('*+-/\~=<>&@%,|' allSatisfy: [:char | (Symbol with: char) isLiteralSymbol])
		description: 'single letter binary symbols can be printed without string quotes'.
		
	self assert: (#('x' 'x:' 'x:y:' 'from:to:by:' 'yourself') allSatisfy: [:str | str asSymbol isLiteralSymbol])
		description: 'valid ascii selector symbols can be printed without string quotes'.! !

!SymbolTest methodsFor: 'tests - copying with or without' stamp: ''!
testForceToPaddingStartWith

	| result element |
	element := self nonEmpty at: self indexInNonEmpty .
	result := self nonEmpty forceTo: (self nonEmpty size+2) paddingStartWith: ( element ).
	
	"verify content of 'result' : "
	1 to: 2   do:
		[:i | self assert: ( element ) = ( result at:(i) ) ].
	
	3 to: result size do:
		[:i | self assert: ( result at:i ) = ( self nonEmpty at:(i-2) ) ].

	"verify size of 'result' :"
	self assert: result size = (self nonEmpty size + 2).! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 14:58'!
sizeCollection
	"Answers a collection whose #size is 4"
	^ collectionSize4 ! !

!SymbolTest methodsFor: 'tests - copying with or without' stamp: ''!
testCopyWithFirst

	| index element result |
	index:= self indexInNonEmpty .
	element:= self nonEmpty at: index.
	
	result := self nonEmpty copyWithFirst: element.	
	
	self assert: result size = (self nonEmpty size + 1).
	self assert: result first = element .
	
	2 to: result size do:
	[ :i |
	self assert: (result at: i) = ( self nonEmpty at: ( i - 1 ))].! !

!SymbolTest methodsFor: 'tests' stamp: 'LukasRenggli 8/22/2010 17:33'!
testNumArgsBinary
	self assert: ('-' numArgs = 1).
	self assert: ('++' numArgs = 1).
	self assert: ('*&@' numArgs = 1).
	
	self assert: (' ++' numArgs = -1).
	self assert: ('+ +' numArgs = -1).
	self assert: ('++ ' numArgs = -1).

	self assert: ('_++' numArgs = -1).
	self assert: ('+_+' numArgs = -1).
	self assert: ('++_' numArgs = -1).
	
	self assert: ('1' numArgs = -1).
	self assert: ('*a' numArgs = -1)! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 14:49'!
empty
	^ emptySymbol ! !

!SymbolTest methodsFor: 'tests - element accessing' stamp: ''!
testAtLast
	"self debug: #testAtLast"
	| index |
	self assert: (self moreThan4Elements atLast: 1) = self moreThan4Elements last.
	"tmp:=1.
	self do:
		[:each | 
		each =self elementInForIndexAccessing 
			ifTrue:[index:=tmp].
		tmp:=tmp+1]."
	index := self moreThan4Elements indexOf: self elementInForElementAccessing.
	self assert: (self moreThan4Elements atLast: index) = (self moreThan4Elements at: self moreThan4Elements size - index + 1)! !

!SymbolTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterEmpty

	| delim emptyStream |
	delim := ', '.
	emptyStream := ReadWriteStream on: ''.
	self empty asStringOn: emptyStream delimiter: delim.
	self assert: emptyStream contents = ''.
! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 14:49'!
collection

	^ nonEmptySymbol5ElementsNoDuplicates ! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 12:02'!
anotherElementOrAssociationIn
	" return an element (or an association for Dictionary ) present  in 'collection' "
	^ self collection anyOne! !

!SymbolTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionEmpty
	"self debug: #testIntersectionEmpty"
	
	| inter |
	inter := self empty intersection: self empty.
	self assert: inter isEmpty. 
	inter := self empty intersection: self collection .
	self assert: inter =  self empty.
	! !

!SymbolTest methodsFor: 'tests - sorting' stamp: ''!
testIsSorted
	self assert: self sortedInAscendingOrderCollection isSorted.
	self deny: self unsortedCollection isSorted! !

!SymbolTest methodsFor: 'tests - element accessing' stamp: ''!
testAtRandom
	| result |
	result := self nonEmpty atRandom .
	self assert: (self nonEmpty includes: result).! !

!SymbolTest methodsFor: 'tests - converting' stamp: ''!
assertSameContents: aCollection whenConvertedTo: aClass 
	| result |
	result := self assertNonDuplicatedContents: aCollection whenConvertedTo: aClass.
	self assert: result size = aCollection size! !

!SymbolTest methodsFor: 'tests - equality' stamp: ''!
testEqualSignForSequenceableCollections
	"self debug: #testEqualSign"

	self deny: (self nonEmpty = self nonEmpty asSet). 
	self deny: (self nonEmpty reversed = self nonEmpty).
	self deny: (self nonEmpty = self nonEmpty reversed).! !

!SymbolTest methodsFor: 'tests - streaming' stamp: ''!
testStreamContents
	| result index |
	result:= self collectionClass streamContents: [ :s|
		s 
			nextPutAll: self firstCollection;
			nextPutAll: self secondCollection ].
	self assert: result equals: self firstCollection, self secondCollection.! !

!SymbolTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOfNotIn
	| result |
	result := self collectionWithoutEqualElements occurrencesOf: self elementNotInForOccurrences.
	self assert: result = 0! !

!SymbolTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureBeginsEndsWithTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self assert: self nonEmpty size > 1.
	self empty.
	self assert: self empty isEmpty! !

!SymbolTest methodsFor: 'tests - element accessing' stamp: ''!
testAtIfAbsent
	"self debug: #testAt"
	| absent |
	absent := false.
	self moreThan4Elements 
		at: self moreThan4Elements size + 1
		ifAbsent: [ absent := true ].
	self assert: absent = true.
	absent := false.
	self moreThan4Elements 
		at: self moreThan4Elements size
		ifAbsent: [ absent := true ].
	self assert: absent = false! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 14:45'!
collectionNotIncluded
" return a collection for wich each element is not included in 'nonEmpty' "
	^ collectionNotIncluded ! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 14:56'!
elementNotInForOccurrences
	^ notIn ! !

!SymbolTest methodsFor: 'test - equality' stamp: ''!
testEqualSignOfIdenticalCollectionObjects
	"self debug: #testEqualSignOfIdenticalCollectionObjects"
	
	self assert: (self empty = self empty). 
	self assert: (self nonEmpty = self nonEmpty). 
	! !

!SymbolTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSubcollectionAccessTest
	self moreThan3Elements.
	self assert: self moreThan3Elements size > 2! !

!SymbolTest methodsFor: 'tests - index access' stamp: ''!
testIndexOf
	"self debug: #testIndexOf"
	| tmp index collection |
	collection := self collectionMoreThan1NoDuplicates.
	tmp := collection size.
	collection reverseDo: 
		[ :each | 
		each = self elementInForIndexAccessing ifTrue: [ index := tmp ].
		tmp := tmp - 1 ].
	self assert: (collection indexOf: self elementInForIndexAccessing) = index! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 12:03'!
anotherElementOrAssociationNotIn
	" return an element (or an association for Dictionary )not present  in 'collection' "
	^ notIn ! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 15:11'!
elementInForIndexAccessing
" return an element included in 'collectionMoreThan1NoDuplicates' "
	^ self collectionMoreThan1NoDuplicates anyOne.! !

!SymbolTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testLastIndexOfIfAbsentDuplicate
	"self debug: #testIndexOfIfAbsent"
	"self debug: #testLastIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection first.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'lastIndexOf: should return the position of the last occurrence :'"
	self assert: (collection 
			lastIndexOf: element
			ifAbsent: [ 55 ]) = collection size! !

!SymbolTest methodsFor: 'tests - as set tests' stamp: ''!
testAsIdentitySetWithEqualsElements
	| result collection |
	collection := self withEqualElements .
	result := collection asIdentitySet.
	collection do: [ :each | self assert: (result occurrencesOf: each) = 1 ].
	self assert: result class = IdentitySet.! !

!SymbolTest methodsFor: 'tests - set arithmetic' stamp: ''!
testIntersectionBasic
	"self debug: #testIntersectionBasic"
	| inter |
	inter := self collection intersection: (self collectionClass with: self anotherElementOrAssociationIn).
	self deny: inter isEmpty.
	self assert: (inter includes: self anotherElementOrAssociationIn value)! !

!SymbolTest methodsFor: 'tests - set arithmetic' stamp: ''!
testDifference
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifference"
	
	| difference |
	self assert: (self collectionWithoutEqualElements difference: self collectionWithoutEqualElements) isEmpty.
	self assert: (self empty difference: self collectionWithoutEqualElements) isEmpty.
	difference := (self collectionWithoutEqualElements difference: self empty).
	self assert: difference size = self collectionWithoutEqualElements	 size.
	self collectionWithoutEqualElements do: [ :each |
		self assert: (difference includes: each)].
! !

!SymbolTest methodsFor: 'tests - subcollections access' stamp: ''!
testAllButFirst
	"self debug: #testAllButFirst"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButFirst.
	self deny: abf first = col first.
	self assert: abf size + 1 = col size! !

!SymbolTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureSequencedElementAccessTest
	self moreThan4Elements.
	self assert: self moreThan4Elements size >= 4.
	self subCollectionNotIn.
	self subCollectionNotIn detect: [ :each | (self moreThan4Elements includes: each) not ] ifNone: [ self assert: false ].
	self elementNotInForElementAccessing.
	self deny: (self moreThan4Elements includes: self elementNotInForElementAccessing).
	self elementInForElementAccessing.
	self assert: (self moreThan4Elements includes: self elementInForElementAccessing)! !

!SymbolTest methodsFor: 'tests' stamp: 'CamilloBruni 1/16/2012 18:45'!
testNumArgsKeyword2
	self assert: ('name:with:' numArgs = 2).

	self assert: ('_name:with:' numArgs = 2).
	self assert: ('na_me:with:' numArgs = 2).
	self assert: ('name_:with:' numArgs = 2).
	
	self assert: ('name:_with:' numArgs = 2).
	self assert: ('name:wi_th:' numArgs = 2).
	self assert: ('name:with_:' numArgs = 2).
	
	self assert: ('name:with: ' numArgs = -1).
	self assert: ('name: with:' numArgs = -1).
	self assert: (' name:with:' numArgs = -1).
	
	self assert: ('name+:with:' numArgs = -1).
	self assert: ('+name:with:' numArgs = -1).
	self assert: ('na+me:with:' numArgs = -1).
	
	self assert: ('123name:with:' numArgs = -1).
	self assert: ('name123:with:' numArgs = 2).
	self assert: ('name:123with:' numArgs = -1).
	self assert: ('name:with123:' numArgs = 2)! !

!SymbolTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testAllButLastDo
	
	| result |
	result:= OrderedCollection  new.
	
	self nonEmptyMoreThan1Element  allButLastDo: [:each | result add: each].
	
	1 to: (result size) do:
		[:i|
		self assert: (self nonEmptyMoreThan1Element  at:(i ))=(result at:i)].
	
	self assert: result size=(self nonEmptyMoreThan1Element  size-1).! !

!SymbolTest methodsFor: 'tests' stamp: 'md 2/16/2006 17:17'!
testNumArgs2
    "TODO: need to be extended to support shrinking and for selectors like #+ " 
	
	self assert: (#test numArgs: 0) = #test.
	self assert: (#test numArgs: 1) = #test:.
	self assert: (#test numArgs: 2) = #test:with:.
	self assert: (#test numArgs: 3) = #test:with:with:.
	

	self assert: (#test: numArgs: 0) = #test:.
	self assert: (#test: numArgs: 1) = #test:.
	self assert: (#test: numArgs: 2) = #test:with:.
	self assert: (#test: numArgs: 3) = #test:with:with:.
	
	self assert: (#test:with: numArgs: 0) = #test:with:.
	self assert: (#test:with: numArgs: 1) = #test:with:.
	self assert: (#test:with: numArgs: 2) = #test:with:.
	self assert: (#test:with: numArgs: 3) = #test:with:with:.
	self assert: (#test:with: numArgs: 4) = #test:with:with:with:.
	
	self assert: (#test:with:with: numArgs: 0) = #test:with:with:.
	self assert: (#test:with:with: numArgs: 1) = #test:with:with:.
	self assert: (#test:with:with: numArgs: 2) = #test:with:with:.
	self assert: (#test:with:with: numArgs: 3) = #test:with:with:.
	self assert: (#test:with:with: numArgs: 4) = #test:with:with:with:.! !

!SymbolTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopyPartOfForMultipliness
	self collectionWithSameAtEndAndBegining.
	self assert: self collectionWithSameAtEndAndBegining first = self collectionWithSameAtEndAndBegining last.
	self assert: self collectionWithSameAtEndAndBegining size > 1.
	1 to: self collectionWithSameAtEndAndBegining size do: [ :i | 
		i > 1 & (i < self collectionWithSameAtEndAndBegining size)
			ifTrue: [ self deny: (self collectionWithSameAtEndAndBegining at: i) = self collectionWithSameAtEndAndBegining first ] ]! !

!SymbolTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testPairsCollect
	
	| index result |
	index:=0.
	
	result:=self nonEmptyMoreThan1Element  pairsCollect: 
		[:each1 :each2 | 
		self assert: ( self nonEmptyMoreThan1Element indexOf: each2 ) = (index := index + 2).
		(self nonEmptyMoreThan1Element indexOf: each2) = ((self nonEmptyMoreThan1Element indexOf: each1) + 1).
		].
	
	result do: 
		[:each | self assert: each = true].
	
! !

!SymbolTest methodsFor: 'tests - copying same contents' stamp: ''!
testShallowCopyEmpty
	| result |
	result := self empty shallowCopy .
	self assert: result isEmpty .! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 15:16'!
subCollectionNotIn
" return a collection for which at least one element is not included in 'moreThan4Elements' "
	^ collectionNotIncluded ! !

!SymbolTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithIndexDo
	
	"| result |
	result:=Array new: self nonEmptyMoreThan1Element size.
	self nonEmptyMoreThan1Element  withIndexDo: [:each :i | result at:i put:(each+i)].
	
	1 to: result size do:[: i | self assert: (result at:i)= ((self nonEmptyMoreThan1Element at: i) + i)]"
	|  indexes elements |
	indexes:= OrderedCollection new.
	elements := OrderedCollection new.
	
	self nonEmptyMoreThan1Element  withIndexDo: 
		[:value :i  |
		indexes  add: (i).
		elements add: value].
	
	(1 to: self nonEmptyMoreThan1Element size )do:
		[ :i |
		self assert: (indexes at: i) = i.
		self assert: (elements at: i) = (self nonEmptyMoreThan1Element at: i).	
		].
	
	self assert: indexes size = elements size. 
	self assert: indexes size = self nonEmptyMoreThan1Element size . 
	! !

!SymbolTest methodsFor: 'tests - copying same contents' stamp: ''!
testReverse

	| result |
	result := self nonEmpty reversed.	
	"verify content of 'result: '"
	1 to: result size do:
		[:i | self assert: ((result at: i) 
			= (self nonEmpty at: (self nonEmpty size - i + 1)))].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!SymbolTest methodsFor: 'tests - element accessing' stamp: ''!
testBeforeIfAbsent
	"self debug: #testBefore"
	self assert: (self moreThan4Elements 
			before: (self moreThan4Elements at: 1)
			ifAbsent: [ 99 ]) = 99.
	self assert: (self moreThan4Elements 
			before: (self moreThan4Elements at: 2)
			ifAbsent: [ 99 ]) = (self moreThan4Elements at: 1)! !

!SymbolTest methodsFor: 'tests - copying part of sequenceable' stamp: ''!
testCopyUpToEmpty
	| result |
	result := self empty copyUpTo: self collectionWithoutEqualElements first.
	self assert: result isEmpty.
	! !

!SymbolTest methodsFor: 'tests - set arithmetic' stamp: ''!
containsAll: union of: one andOf: another
			
	self assert: (one allSatisfy: [:each | union includes: each]).
	self assert: (another allSatisfy: [:each | union includes: each])! !

!SymbolTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFindLastNotIn

	| result |
	
	 result:=self empty findFirst: [:each | true].
	
	self assert: result=0. ! !

!SymbolTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsCommaStringOne
	
	"self assert: self oneItemCol asCommaString = '1'.
	self assert: self oneItemCol asCommaStringAnd = '1'."

	self assert: self nonEmpty1Element  asCommaString = (self nonEmpty1Element first asString).
	self assert: self nonEmpty1Element  asCommaStringAnd = (self nonEmpty1Element first asString).
	! !

!SymbolTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testFromToDo
	
	| result |
	result:= OrderedCollection  new.
	
	self nonEmptyMoreThan1Element  from: 1 to: (self nonEmptyMoreThan1Element  size -1) do: [:each | result add: each].
	
	1 to: (self nonEmptyMoreThan1Element  size -1) do:
		[:i|
		self assert: (self nonEmptyMoreThan1Element  at:i )=(result at:i)].
	self assert: result size=(self nonEmptyMoreThan1Element  size-1).! !

!SymbolTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCopySameContentsTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 14:45'!
elementNotIn
"return an element not included in 'nonEmpty' "

	^ notIn ! !

!SymbolTest methodsFor: 'setup' stamp: 'cyrille.delaunay 12/18/2009 13:44'!
setUp
	emptySymbol := #''.
	collectionSize4 := #abcd.
	collection1Element := #a.
	subcollection3ElementsSorted := #bcd.
	with2timeSubcollection := #abcdebcda.
	nonEmptySymbol5ElementsNoDuplicates := #abcde.
	sameAtEndAndBegining := #abcda.
	notIn := $z.
	collectionNotIncluded := #zz.! !

!SymbolTest methodsFor: 'tests - element accessing' stamp: ''!
testAt
	"self debug: #testAt"
	"
	self assert: (self accessCollection at: 1) = 1.
	self assert: (self accessCollection at: 2) = 2.
	"
	| index |
	index := self moreThan4Elements indexOf: self elementInForElementAccessing.
	self assert: (self moreThan4Elements at: index) = self elementInForElementAccessing! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 15:17'!
moreThan3Elements
	" return a collection including atLeast 3 elements"
	^ nonEmptySymbol5ElementsNoDuplicates ! !

!SymbolTest methodsFor: 'tests - element accessing' stamp: ''!
testMiddle
	"self debug: #testMiddle"
	self assert: self moreThan4Elements middle = (self moreThan4Elements at: self moreThan4Elements size // 2 + 1)! !

!SymbolTest methodsFor: 'tests - index accessing for multipliness' stamp: ''!
testIndexOfIfAbsentDuplicate
	"self debug: #testIndexOfIfAbsent"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection last.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'indexOf:ifAbsent: should return the position of the first occurrence :'"
	self assert: (collection 
			indexOf: element
			ifAbsent: [ 55 ]) = 1! !

!SymbolTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 14:59'!
nonEmptyMoreThan1Element
" return a collection that don't includes equal elements'" 
	^nonEmptySymbol5ElementsNoDuplicates ! !

!SymbolTest methodsFor: 'tests - comma and delimiter' stamp: ''!
testAsStringOnDelimiterOne

	| delim oneItemStream result |
	"delim := ', '.
	oneItemStream := '' readWrite.
	self oneItemCol asStringOn: oneItemStream delimiter: delim.
	self assert: oneItemStream contents = '1'."
	
	delim := ', '.
	result:=''.
	oneItemStream := ReadWriteStream on: result.
	self nonEmpty1Element  asStringOn: oneItemStream delimiter: delim.
	oneItemStream do:[:each | self assert: each = (self nonEmpty1Element first asString)].
	

	! !

!SymbolTest methodsFor: 'tests - index access' stamp: ''!
testLastIndexOfIfAbsent
	"self debug: #testIndexOfIfAbsent"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			lastIndexOf: element
			ifAbsent: [ 99 ]) = 1.
	self assert: (collection 
			lastIndexOf: self elementNotInForIndexAccessing
			ifAbsent: [ 99 ]) = 99! !

!SymbolTest methodsFor: 'tests - index access' stamp: ''!
testLastIndexOfStartingAt
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection last.
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size
			ifAbsent: [ 99 ]) = collection size.
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size - 1
			ifAbsent: [ 99 ]) = 99.
	self assert: (collection 
			lastIndexOf: self elementNotInForIndexAccessing
			startingAt: collection size
			ifAbsent: [ 99 ]) = 99! !

!SymbolTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: ''!
testWithCollectError
	self should: [self nonEmptyMoreThan1Element with: self empty collect:[:a :b | ]] raise: Error.! !

!SymbolTest methodsFor: 'tests - copying with replacement' stamp: ''!
firstIndexesOf: aSubCollection in: collection
" return an OrderedCollection with the first indexes of the occurrences of subCollection in  collection "
	| tmp result currentIndex |
	tmp:= collection.
	result:= OrderedCollection new.
	currentIndex := 1.
	
	[tmp isEmpty ]whileFalse:
		[
		(tmp beginsWith: aSubCollection)
			ifTrue: [ 	
				result add: currentIndex.
				1 to: aSubCollection size do: 
					[:i | 
					tmp := tmp copyWithoutFirst.
					currentIndex := currentIndex + 1]
				]
			ifFalse: [
				tmp := tmp copyWithoutFirst.
				currentIndex := currentIndex +1.
				]
		 ].
	
	^ result.
	! !

!SymbolicBytecode commentStamp: 'MarcusDenker 10/13/2014 15:54'!
I model a single bytecode. I know my value and my offset in the compiledMethod and know the compiledMethod I come from

I am a relatively heavyweight object, I am created on demand for inspecting bytecodes.

See #symbolicBytecode.!
!SymbolicBytecode methodsFor: 'accessing' stamp: 'MarcusDenker 10/12/2014 13:00'!
method: anObject
	method := anObject! !

!SymbolicBytecode methodsFor: 'accessing' stamp: 'MarcusDenker 10/13/2014 13:37'!
description
	^ description! !

!SymbolicBytecode methodsFor: 'accessing' stamp: 'MarcusDenker 10/12/2014 13:00'!
offset
	^ offset! !

!SymbolicBytecode methodsFor: 'accessing' stamp: 'MarcusDenker 10/13/2014 14:27'!
bytes: anObject
	bytes := anObject! !

!SymbolicBytecode methodsFor: 'accessing' stamp: 'MarcusDenker 10/12/2014 13:00'!
method
	^ method! !

!SymbolicBytecode methodsFor: '*OpalTools' stamp: 'MarcusDenker 10/14/2014 16:32'!
gtInspectorSourceCodeIn: composite
	<gtInspectorPresentationOrder: 30> 

	^ composite smalltalkCode 
		title: 'Source';
		display: [ self method sourceCode ];
		smalltalkClass: [ self method methodClass ]; 
		initialize: [ :presentation | 
			presentation selectionInterval: self sourceInterval ];
		act: [ self method compiledMethod browse ] icon: GLMUIThemeExtraIcons glamorousBrowse entitled: 'Browse'! !

!SymbolicBytecode methodsFor: 'accessing' stamp: 'MarcusDenker 10/13/2014 13:37'!
description: anObject
	description := anObject! !

!SymbolicBytecode methodsFor: 'accessing' stamp: 'MarcusDenker 10/12/2014 13:00'!
offset: anObject
	offset := anObject! !

!SymbolicBytecode methodsFor: 'printing' stamp: 'MarcusDenker 10/13/2014 15:46'!
printOn: aStream
	aStream print: offset; space.
	aStream nextPut: $<.
	bytes do: [:each | | code |
		code := each radix: 16.
			aStream nextPut: (code size < 2
				ifTrue: [$0]
				ifFalse: [code at: 1]).
			aStream nextPut: code last] separatedBy: [ aStream space].
	aStream nextPut: $>;space.
	aStream nextPutAll: description! !

!SymbolicBytecode methodsFor: 'accessing' stamp: 'MarcusDenker 10/13/2014 14:27'!
bytes
	^ bytes! !

!SymbolicBytecode methodsFor: 'mapping' stamp: 'MarcusDenker 10/14/2014 13:33'!
sourceNode
	^self method sourceNode sourceNodeForPC: self offset! !

!SymbolicBytecode methodsFor: 'mapping' stamp: 'MarcusDenker 10/14/2014 16:13'!
sourceInterval
	^self sourceNode sourceInterval! !

!SymbolicBytecode methodsFor: '*OpalTools' stamp: 'MarcusDenker 10/22/2014 10:29'!
gtInspectorTreeIn: composite
	<gtInspectorPresentationOrder: 30> 
	^composite tree
		rootsExpanded;
		title: 'SourceNode';
		display: [ :anObject | {anObject sourceNode} ];
		children: [ :each | each children ];
		selectionPopulate: #selectedNode
			on: $o
			entitled: 'Open'
			with: [ :tree | tree selection ];
		format: [ :each | each printString ]! !

!SymbolicBytecode class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 18:20'!
gtExampleSymbolicBytecode
	<gtExample: 'Symbolic Bytecode'>
	^ (SymbolicBytecode class >> #gtExampleSymbolicBytecode) symbolicBytecodes anyOne! !

!SymbolicBytecodeBuilder commentStamp: 'MarcusDenker 10/13/2014 14:42'!
I parse a method and create a collection of SymbolicBytecode objects for introspection.

!
!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'ClementBera 12/28/2014 17:34'!
trap 
	"send the class trap message to the current context."
	self addBytecode: 'trap'
! !

!SymbolicBytecodeBuilder methodsFor: 'accessing' stamp: 'MarcusDenker 10/13/2014 15:30'!
method: aMethod
	method :=  aMethod.! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'MarcusDenker 10/14/2014 16:52'!
blockReturnTop
	"Print the Return Top Of Stack bytecode."

	self addBytecode: 'blockReturn'! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'ClementBera 12/28/2014 17:52'!
pushActiveProcess
	self addBytecode: 'pushThisProcess'! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'MarcusDenker 10/14/2014 16:52'!
doDup
	"Print the Duplicate Top Of Stack bytecode."

	self addBytecode: 'dup'! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'ClementBera 12/28/2014 17:58'!
pushClosureTemps: numTemps
	"push on stack nil numTemps times for the closure temps"
	self addBytecode: 'pushClosureTemps:' , numTemps! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'MarcusDenker 10/14/2014 16:52'!
methodReturnReceiver
	"Print the Return Self bytecode."

	self addBytecode: 'returnSelf'! !

!SymbolicBytecodeBuilder methodsFor: 'private' stamp: 'MarcusDenker 10/14/2014 16:51'!
addBytecode: description 
	"Append to the receiver a description of the bytecode, instruction." 

	| bytes symbolic |
	
	bytes := ByteArray new: (scanner pc - oldPC).
	
	(oldPC to: scanner pc - 1) doWithIndex: [:each :index | 
		bytes at: index put: (method at: each)].
	
	 symbolic := SymbolicBytecode new 
		method: method;
		bytes: bytes;
	 	description: description;
		offset: oldPC.
	symbolicBytecodes add: symbolic.
	oldPC := scanner pc.
! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'MarcusDenker 10/14/2014 16:53'!
storeIntoTemporaryVariable: offset 
	"Print the Store Top Of Stack Into Temporary Variable Of Method 
	bytecode."

	self addBytecode: 'storeIntoTemp: ' , offset printString! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'MarcusDenker 10/14/2014 16:52'!
popIntoTemporaryVariable: offset 
	"Print the Remove Top Of Stack And Store Into Temporary Variable 
	bytecode."

	self addBytecode: 'popIntoTemp: ' , offset printString! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'MarcusDenker 10/14/2014 16:52'!
popIntoLiteralVariable: anAssociation 
	"Print the Remove Top Of Stack And Store Into Literal Variable bytecode."

	self addBytecode: 'popIntoLit: ' , anAssociation key! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'MarcusDenker 10/14/2014 16:53'!
send: selector super: supered numArgs: numberArguments
	"Print the Send Message With Selector, selector, bytecode. The argument, 
	supered, indicates whether the receiver of the message is specified with 
	'super' in the source method. The arguments of the message are found in 
	the top numArguments locations on the stack and the receiver just 
	below them."

	self addBytecode: (supered ifTrue: ['superSend: '] ifFalse: ['send: ']) , selector.! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'MarcusDenker 10/14/2014 16:52'!
jump: offset if: condition 
	"Print the Conditional Jump bytecode."

	self addBytecode: 
		(condition
			ifTrue: ['jumpTrue: ']
			ifFalse: ['jumpFalse: '])
			, (scanner pc + offset) printString! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'MarcusDenker 10/14/2014 16:52'!
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
	self addBytecode: 'closureNumCopied: ', numCopied printString
			, ' numArgs: ', numArgs printString
			, ' bytes ', scanner pc printString
			, ' to ', (scanner pc + blockSize - 1) printString.! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'ClementBera 12/28/2014 17:34'!
trapIfNotInstanceOf: behaviorOrArrayOfBehavior 
	"If the top of stack is not an instance of either the argument, or, if the
	argument is an Array,
	any of the elements of the argument, send the class trap message
	to the current context."
	self addBytecode: 'trapIfNotInstanceOf: ' , behaviorOrArrayOfBehavior printString
! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'MarcusDenker 10/14/2014 16:53'!
storeIntoLiteralVariable: anAssociation 
	"Print the Store Top Of Stack Into Literal Variable Of Method bytecode."

	self addBytecode: 'storeIntoLit: ' , anAssociation key! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'MarcusDenker 10/14/2014 16:53'!
pushNewArrayOfSize: numElements 
	self addBytecode: 'push: (Array new: ', numElements printString, ')'! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'MarcusDenker 10/14/2014 16:52'!
doPop
	"Print the Remove Top Of Stack bytecode."

	self addBytecode: 'pop'! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'MarcusDenker 10/14/2014 16:53'!
pushTemporaryVariable: offset
	"Print the Push Contents Of Temporary Variable Whose Index Is the 
	argument, offset, On Top Of Stack bytecode."

	self addBytecode: 'pushTemp: ' , offset printString! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'ClementBera 12/28/2014 17:34'!
blockReturnConstant: cst

	self addBytecode: 'blockReturn: ' , cst printString! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'MarcusDenker 10/14/2014 16:52'!
methodReturnTop
	"Print the Return Top Of Stack bytecode."

	self addBytecode: 'returnTop'! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'MarcusDenker 10/14/2014 16:52'!
popIntoReceiverVariable: offset 
	"Print the Remove Top Of Stack And Store Into Instance Variable 
	bytecode."

	self addBytecode: 'popIntoRcvr: ' , offset printString! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'MarcusDenker 10/14/2014 16:52'!
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
	self addBytecode: 'popIntoTemp: ', remoteTempIndex printString, ' inVectorAt: ', tempVectorIndex printString! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'MarcusDenker 10/14/2014 16:52'!
jump: offset
	"Print the Unconditional Jump bytecode."

	self addBytecode: 'jumpTo: ' , (scanner pc + offset) printString.! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'MarcusDenker 10/14/2014 16:52'!
pushConsArrayWithElements: numElements 
	self addBytecode: 'pop ', numElements printString, ' into (Array new: ', numElements printString, ')'! !

!SymbolicBytecodeBuilder methodsFor: 'accessing' stamp: 'MarcusDenker 10/13/2014 13:39'!
method
	^method.! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'MarcusDenker 10/14/2014 16:52'!
methodReturnConstant: value 
	"Print the Return Constant bytecode."

	self addBytecode: 'return: ' , value printString! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'ClementBera 12/28/2014 17:52'!
pushActiveContext
	"Print the Push Active Context On Top Of Its Own Stack bytecode."

	self addBytecode: 'pushThisContext'! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'MarcusDenker 10/14/2014 16:53'!
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex 
	self addBytecode: 'storeIntoTemp: ', remoteTempIndex printString, ' inVectorAt: ', tempVectorIndex printString! !

!SymbolicBytecodeBuilder methodsFor: 'api' stamp: 'MarcusDenker 10/13/2014 14:39'!
decode
	
	| end |
	symbolicBytecodes := OrderedCollection new.
	scanner := InstructionStream on: method.
	end := method endPC.
	oldPC := scanner pc.
	[scanner pc <= end] whileTrue:
		[scanner interpretNextInstructionFor: self].
	^symbolicBytecodes! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'MarcusDenker 10/14/2014 16:53'!
pushReceiverVariable: offset
	"Print the Push Contents Of the Receiver's Instance Variable Whose Index 
	is the argument, offset, On Top Of Stack bytecode."

	self addBytecode: 'pushRcvr: ' , offset printString! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'MarcusDenker 10/14/2014 16:52'!
pushLiteralVariable: anAssociation
	"Print the Push Contents Of anAssociation On Top Of Stack bytecode."

	self addBytecode: 'pushLit: ' , anAssociation key! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'MarcusDenker 10/14/2014 16:53'!
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex 
	self addBytecode: 'pushTemp: ', remoteTempIndex printString, ' inVectorAt: ', tempVectorIndex printString! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'MarcusDenker 10/14/2014 16:53'!
pushReceiver
	"Print the Push Active Context's Receiver on Top Of Stack bytecode."

	self addBytecode: 'self'! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'MarcusDenker 10/14/2014 16:53'!
storeIntoReceiverVariable: offset 
	"Print the Store Top Of Stack Into Instance Variable Of Method bytecode."

	self addBytecode: 'storeIntoRcvr: ' , offset printString! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'ClementBera 10/23/2014 10:00'!
callPrimitive: primNumber
	"Print the callPrimitive bytecode."
	| isInlined |
	isInlined := primNumber >= (1 << 15) ifTrue: [ 'Inlined' ] ifFalse: [ '' ].
	self addBytecode: 'call' , isInlined , 'Primitive: ' , primNumber printString! !

!SymbolicBytecodeBuilder methodsFor: 'instruction decoding' stamp: 'MarcusDenker 10/14/2014 16:52'!
pushConstant: obj
	"Print the Push Constant, obj, on Top Of Stack bytecode."

	self addBytecode: (String streamContents:
				[:s |
				s nextPutAll: 'pushConstant: '.
				(obj isKindOf: LookupKey)
					ifFalse: [obj printOn: s]
					ifTrue: [obj key
						ifNotNil: [s nextPutAll: '##'; nextPutAll: obj key]
						ifNil: [s nextPutAll: '###'; nextPutAll: obj value soleInstance name]]]).
! !

!SymbolicBytecodeBuilder class methodsFor: 'api' stamp: 'MarcusDenker 10/13/2014 15:48'!
decode: aMethod
	^(self new method: aMethod) decode
	! !

!SyntaxErrorDebugger commentStamp: '<historical>'!
I am a special Debugger for syntax errors encountered when filing in class descriptions from a non-interactive source such as an external file. As a StringHolder, the string to be viewed is the method code or expression containing the error.

The user may fix the error and accept the method to continue the fileIn.
!
!SyntaxErrorDebugger methodsFor: 'dependents access' stamp: 'GuillermoPolito 8/13/2010 01:10'!
addDependant: aDependant
	dependents add: aDependant! !

!SyntaxErrorDebugger methodsFor: 'accessing' stamp: 'MarcusDenker 4/21/2013 08:45'!
shiftedYellowButtonMenu
	"Answer the menu to be presented when the yellow button is pressed while the shift key is down"

	^  (PragmaMenuBuilder 
			pragmaKeyword: SmalltalkEditor smalltalkEditorShiftedMenuKeyword
			model: self) menu.! !

!SyntaxErrorDebugger methodsFor: 'initialization' stamp: 'EstebanLorenzano 5/28/2013 13:48'!
setClass: aClass code: aString error: errorMessage location: anErrorPosition debugger: aDebugger doitFlag: flag

	class := aClass.
	error := errorMessage.
	location := anErrorPosition.
	debugger := aDebugger.
	selector := aClass compiler parseSelector: aString.
	contents := self checkForUnprintableCharacters: aString.
	self highlightError.
		
	category ifNil: [ category := aClass organization categoryOfElement: selector ].
	category ifNil: [ category := Protocol unclassified ].
	doitFlag := flag! !

!SyntaxErrorDebugger methodsFor: 'menu' stamp: 'StephaneDucasse 10/27/2014 08:44'!
listMenu: aMenu
	^aMenu addList: {
		{'Proceed' . #proceed}.
		{'Debug calling process' . #debug}.
		{'Browse full translated' . #browseMethodFull}}.! !

!SyntaxErrorDebugger methodsFor: 'accessing' stamp: 'MarcusDenker 4/21/2013 08:53'!
yellowButtonMenu
	^  (PragmaMenuBuilder 
		pragmaKeyword: SmalltalkEditor smalltalkEditorMenuKeyword
		model: self) menu 
! !

!SyntaxErrorDebugger methodsFor: 'menu' stamp: 'StephaneDucasse 10/15/2011 20:58'!
browseMethodFull
	"Create and schedule a full Browser and then select the current class and message."

	| myClass |
	(myClass := self selectedClassOrMetaClass) ifNotNil:
		[Smalltalk tools browser
			fullOnClass: myClass selector: self selectedMessageName]! !

!SyntaxErrorDebugger methodsFor: 'initialization' stamp: 'GabrielOmarCotelli 12/4/2013 09:49'!
checkForUnprintableCharacters: aString
	| types printables |
	types := String typeTable.
	printables := '!!@#$%&*-_=+<>{}?/\,·£¢§¶ªº–—“‘”’…Úæگ׿«»`~`' asSet.
	^ aString
		detect: [ :aChar | (types at: aChar asciiValue ifAbsent: [ #xLetter ]) == #xBinary and: [ (printables includes: aChar) not ] ]
		ifFound: [ :badChar | 
			'<<<This string contains a character (ascii value ' , badChar asciiValue printString
				, ') that is not normally used in code>>> ' , aString ]
		ifNone: [ aString ]! !

!SyntaxErrorDebugger methodsFor: 'initialization' stamp: 'GuillermoPolito 8/13/2010 01:10'!
initialize
	dependents := Set new.! !

!SyntaxErrorDebugger methodsFor: 'text menu support' stamp: 'jm 5/3/1998 14:33'!
selectedClassOrMetaClass
	"Answer the class of the method being compiled."

	^ class
! !

!SyntaxErrorDebugger methodsFor: 'initialization' stamp: 'CamilloBruni 2/9/2012 12:34'!
syntaxError: aSyntaxError
	"extract the instance properties from a SyntaxErrorNotification"
	
	self 
		setClass: aSyntaxError errorClass
		code: aSyntaxError errorCode
		error: aSyntaxError errorMessage
		location: aSyntaxError location
		debugger: (Smalltalk tools debugger context: aSyntaxError signalerContext)
		doitFlag: aSyntaxError doitFlag.
		
	self category: aSyntaxError category.! !

!SyntaxErrorDebugger methodsFor: 'message list' stamp: 'CamilloBruni 2/8/2012 23:44'!
listDoubleClick
	self debug! !

!SyntaxErrorDebugger methodsFor: 'message list' stamp: 'CamilloBruni 2/8/2012 23:45'!
list
	"Answer an array of one element made up of the class name, message category, and message selector in which the syntax error was found. This is the single item in the message list of a view/browser on the receiver."

	selector ifNil: [^ Array with: (class name, '  ', (category ifNil: ['']), '  ', '<none>')].
	category ifNil: [^ Array with: (class name, '    ', '<none>')].
	^ Array with: (class name, '  ', category, '  ', selector)
! !

!SyntaxErrorDebugger methodsFor: 'other' stamp: 'MarcusDenker 5/2/2013 11:37'!
contents: aString notifying: aController
	"Compile the code in aString and proceed. Do not notify anybody of errors, because nobody would have been notified of errors if this syntax error had not arisen"

	doitFlag
		ifTrue: [self class compiler evaluate: aString]
		ifFalse: [class compile: aString classified: category].
	aController hasUnacceptedEdits: false.
	self proceed! !

!SyntaxErrorDebugger methodsFor: 'other' stamp: 'CamilloBruni 2/8/2012 23:56'!
shoutAboutToStyle: aPluggableShoutMorphOrView
	^ true! !

!SyntaxErrorDebugger methodsFor: 'other' stamp: 'AndreiChis 7/24/2013 09:56'!
notify: anError at: aLocation in: source
	"Open a syntax error view, inserting the given error message into the given source at the given location. This message is sent to the 'requestor' when the parser or compiler finds a syntax error."

	| aClass  |
	aClass := thisContext sender receiver encoder classEncoding.
	self setClass: aClass
		code: source
		error: anError
		location: aLocation
		debugger: (Smalltalk tools debugger context: thisContext)
		doitFlag: false.
	self class open: self.
! !

!SyntaxErrorDebugger methodsFor: 'initialization' stamp: 'StephaneDucasse 2/6/2011 21:53'!
release
	"Prevent that syntaxError window lets a suspended compiler process running, when the window is closed."
	| p |
	(debugger isNil or: [	(p := debugger interruptedProcess) isNil 
							or: [p isTerminated]]) ifTrue: [^self].
       p terminate! !

!SyntaxErrorDebugger methodsFor: 'text menu support' stamp: 'jm 5/3/1998 14:15'!
selectedClass
	"Answer the class in which the syntax error occurred."

	^ class
! !

!SyntaxErrorDebugger methodsFor: 'other' stamp: 'CamilloBruni 2/9/2012 12:41'!
contentsSelection
	"Return the interval of text in the code pane to select when I set the pane's contents"

	^ location 
		ifNil: [1 to: 0]  "null selection"
		ifNotNil: [ location to: location + self sourceErrorString size - 1 ] ! !

!SyntaxErrorDebugger methodsFor: 'accessing' stamp: 'EstebanLorenzano 1/31/2013 19:24'!
codePaneMenu: aMenu shifted: shifted 
	"Note that unless we override perform:orSendTo:, 
	PluggableTextController will respond to all menu items in a 
	text pane"
	
	| donorMenu |
	donorMenu := shifted
				ifTrue: [self shiftedYellowButtonMenu]
				ifFalse: [self yellowButtonMenu].
	^ aMenu addAllFrom: donorMenu! !

!SyntaxErrorDebugger methodsFor: 'accessing' stamp: 'GuillermoPolito 8/13/2010 01:10'!
topView
	"Find the first top view on me. Is there any danger of their being two
	with the same model? Any danger from ungarbage collected old views?
	Ask if schedulled?"
	dependents
		ifNil: [^ nil].
	dependents
		do: [:v | (v isSystemWindow
					and: [v isInWorld])
				ifTrue: [^ v]].
	^ nil! !

!SyntaxErrorDebugger methodsFor: 'message list' stamp: 'jm 5/3/1998 13:48'!
listIndex
	"There is always exactly one element in my list and it is always selected."

	^ 1
! !

!SyntaxErrorDebugger methodsFor: 'accessing' stamp: 'CamilloBruni 2/9/2012 12:42'!
sourceErrorString
	^ error , ' -> '! !

!SyntaxErrorDebugger methodsFor: 'text menu support' stamp: 'jm 5/3/1998 14:17'!
selectedMessageName
	"Answer the selector of the method being compiled."

	^ selector
! !

!SyntaxErrorDebugger methodsFor: 'initialization' stamp: 'nice 2/24/2012 00:07'!
highlightError.
	"copy in the error message"
	contents := contents
					copyReplaceFrom: location
					to: location - 1
					with: self sourceErrorString.
	"convert to Text that we can add Attributes"
	contents := contents asText.
	"use the ST80Styler"
	location ifNil: [ ^ self ].	
	contents addAttribute: TextColor red from: location to: location + self sourceErrorString size - 1.
	contents addAttribute: TextEmphasis bold from: location to: location + self sourceErrorString size - 1.! !

!SyntaxErrorDebugger methodsFor: 'menu' stamp: 'di 5/5/1998 00:06'!
proceed
	"The user has has edited and presumably fixed the syntax error and the filein can now proceed."

	debugger proceed: self topView.
! !

!SyntaxErrorDebugger methodsFor: 'accessing' stamp: 'GuillermoPolito 8/13/2010 00:57'!
contents: stringOrText
	contents := stringOrText! !

!SyntaxErrorDebugger methodsFor: 'menu' stamp: 'CamilloBruni 9/21/2012 13:52'!
debug
	"Show the stack of the process leading to this syntax editor, typically showing the stack of the compiler as called from fileIn."

	^ debugger openFullNoSuspendLabel: 'Stack of the Syntax Error'.
! !

!SyntaxErrorDebugger methodsFor: 'accessing' stamp: 'CamilloBruni 2/8/2012 23:47'!
contents
	^contents ! !

!SyntaxErrorDebugger methodsFor: 'accessing' stamp: 'CamilloBruni 2/9/2012 12:33'!
error
	^ error! !

!SyntaxErrorDebugger methodsFor: 'accessing' stamp: 'sd 11/20/2005 21:27'!
category: aSymbol
	"Record the message category of method being compiled. This is used when the user corrects the error and accepts."

	category := aSymbol.
! !

!SyntaxErrorDebugger class methodsFor: 'instance creation' stamp: 'CamilloBruni 2/9/2012 12:33'!
buildMorphicViewOn: aSyntaxError
	"Answer an Morphic view on the given SyntaxError."
	| window |
	window := (SystemWindow labelled: 'Syntax Error: ', aSyntaxError error) model: aSyntaxError.

	window addMorph: (
			(PluggableListMorph 
				on: aSyntaxError 
				list: #list
				selected: #listIndex 
				changeSelected: nil 
				menu: #listMenu:)
				doubleClickSelector: #listDoubleClick)
		frame: (0@0 corner: 1@0.15).

	window addMorph: 
			(PluggableTextMorph 
				on: aSyntaxError 
				text: #contents
				accept: #contents:notifying: 
				readSelection: #contentsSelection
				menu: #codePaneMenu:shifted:)
		frame: (0@0.15 corner: 1@1).

	aSyntaxError addDependant: window.
	^ window openInWorldExtent: 380@220! !

!SyntaxErrorDebugger class methodsFor: 'instance creation' stamp: 'CamilloBruni 2/9/2012 12:29'!
syntaxError: aSyntaxError
	^ self new
		syntaxError: aSyntaxError;
		yourself
		! !

!SyntaxErrorDebugger class methodsFor: 'tools registry' stamp: 'MarcusDenker 9/29/2013 15:52'!
registerToolsOn: registry
	"Add ourselves to registry. See [Smalltalk tools]" 
	registry register: self as: #syntaxErrorDebugger
! !

!SyntaxErrorDebugger class methodsFor: 'instance creation' stamp: 'JuanVuletich 11/1/2010 10:09'!
open: aSyntaxError 
	"Answer a standard system view whose model is an instance of me."
	<primitive: 19>
	"Simulation guard"
	self buildMorphicViewOn: aSyntaxError.
	UIManager default spawnNewProcessIfThisIsUI: Processor activeProcess.
	^ Processor activeProcess suspend! !

!SyntaxErrorNotification commentStamp: 'MarcusDenker 8/11/2014 10:12'!
I am raised on Syntax Error. When in interative mode, I open a SyntaxErrorDebugger!
!SyntaxErrorNotification methodsFor: 'accessing' stamp: 'ar 9/27/2005 19:10'!
errorCode
	^code! !

!SyntaxErrorNotification methodsFor: 'accessing' stamp: 'MarcusDenker 6/20/2014 09:51'!
setClass: aClass category: aCategory code: codeString doitFlag: aBoolean errorMessage: errorString location: anInteger
	inClass := aClass.
	category := aCategory.
	code := codeString.
	doitFlag := aBoolean.
	messageText := errorString.
	location := anInteger! !

!SyntaxErrorNotification methodsFor: 'exceptiondescription' stamp: 'pavel.krivanek 6/17/2010 10:00'!
defaultAction

	^ UIManager default syntaxErrorNotificationDefaultAction: self! !

!SyntaxErrorNotification methodsFor: 'accessing' stamp: 'MarcusDenker 6/20/2014 09:51'!
errorMessage
	^messageText! !

!SyntaxErrorNotification methodsFor: 'accessing' stamp: 'ar 9/27/2005 19:17'!
category
	^category! !

!SyntaxErrorNotification methodsFor: 'accessing' stamp: 'ar 9/27/2005 19:11'!
doitFlag
	^doitFlag! !

!SyntaxErrorNotification methodsFor: 'accessing' stamp: 'eem 9/23/2008 14:23'!
location
	^location! !

!SyntaxErrorNotification methodsFor: 'accessing' stamp: 'ar 9/27/2005 19:14'!
messageText
	^ super messageText
		ifNil: [messageText := code]! !

!SyntaxErrorNotification methodsFor: 'accessing' stamp: 'ar 9/27/2005 19:10'!
errorClass
	^inClass! !

!SyntaxErrorNotification class methodsFor: 'exceptionInstantiator' stamp: 'eem 9/23/2008 14:19'!
inClass: aClass category: aCategory withCode: codeString doitFlag: doitFlag errorMessage: errorString location: location
	^ (self new
		setClass: aClass
		category: aCategory 
		code: codeString
		doitFlag: doitFlag
		errorMessage: errorString
		location: location) signal! !

!SystemAnnouncement commentStamp: '<historical>'!
The root announcement for the events coming from the Pharo system.

Currently, it wraps the event that comes from the SystemChangeNotifier.!
!SystemAnnouncement methodsFor: 'accessing' stamp: 'StephaneDucasse 8/9/2011 23:04'!
timeStamp: aTimeStamp

	timeStamp := aTimeStamp! !

!SystemAnnouncement methodsFor: 'initialization' stamp: 'GuillermoPolito 8/3/2012 13:20'!
initialize
	super initialize.
	self setTimeStamp.! !

!SystemAnnouncement methodsFor: 'accessing' stamp: 'StephaneDucasse 8/9/2011 23:04'!
timeStamp

	^ timeStamp! !

!SystemAnnouncement methodsFor: 'private' stamp: 'SvenVanCaekenberghe 1/9/2014 20:35'!
setTimeStamp

	timeStamp := DateAndTime current! !

!SystemAnnouncement class methodsFor: '*Deprecated40' stamp: 'TorstenBergmann 9/19/2014 20:58'!
fromInternal: anInternalAnnouncement
	"create a new announcement from an internal announcement. Copy the variables"
	
	| instance |
	self deprecated: 'This method is not sent in the image and deprecated for Pharo 4'.
	
	self flag: #ben. "why copy does not work?"
	instance := self new.
	1 to: self allInstVarNames size do:[:i | instance instVarAt: i put: ( anInternalAnnouncement instVarAt: i )].
	^ instance! !

!SystemAnnouncer commentStamp: '<historical>'!
This class plays the role of the announcer for events raised by the Pharo system.

BEWARE: You should not need to subclass me. Think about just using me to send your announces (if you need system behavior) or using your own announcers as instance or class  variables.!
!SystemAnnouncer methodsFor: 'triggering' stamp: 'GuillermoPolito 8/1/2012 17:55'!
classAdded: aClass inCategory: aCategoryName 
	self announce: (ClassAdded class: aClass category: aCategoryName)! !

!SystemAnnouncer methodsFor: 'triggering' stamp: 'GuillermoPolito 8/2/2012 00:34'!
classRenamed: aClass from: oldClassName to: newClassName inCategory: aCategoryName 
	self announce: (ClassRenamed 
				class: aClass
				category: aCategoryName
				oldName: oldClassName
				newName: newClassName)! !

!SystemAnnouncer methodsFor: 'triggering' stamp: 'GuillermoPolito 8/3/2012 13:54'!
traitDefinitionChangedFrom: oldTrait to: newTrait
	self announce: (ClassModifiedClassDefinition classDefinitionChangedFrom: oldTrait to: newTrait)! !

!SystemAnnouncer methodsFor: 'triggering' stamp: 'GuillermoPolito 8/2/2012 00:30'!
classRemoved: aClass fromCategory: aCategoryName 
	self announce: (ClassRemoved class: aClass category: aCategoryName)! !

!SystemAnnouncer methodsFor: 'triggering' stamp: 'GuillermoPolito 8/2/2012 10:14'!
class: aClass recategorizedFrom: oldCategory to: newCategory 
	self announce: (ClassRecategorized 
						class: aClass
						recategorizedFrom: oldCategory
						to: newCategory)! !

!SystemAnnouncer methodsFor: 'triggering' stamp: 'GuillermoPolito 8/2/2012 00:43'!
evaluated: expression context: aContext
	self announce: (ExpressionEvaluated 
				expression: expression
				context: aContext)! !

!SystemAnnouncer methodsFor: 'triggering' stamp: 'CamilleTeruel 9/4/2014 16:42'!
methodChangedFrom: oldMethod to: newMethod oldProtocol: oldProtocol

	self announce: (MethodModified methodChangedFrom: oldMethod to: newMethod oldProtocol: oldProtocol)! !

!SystemAnnouncer methodsFor: 'announce' stamp: 'EstebanLorenzano 8/8/2012 11:01'!
suspendAllWhile: aBlock
	| oldSuspended |
	oldSuspended := self isSuspended.
	suspended := true.
	^aBlock ensure: [ suspended := oldSuspended ]! !

!SystemAnnouncer methodsFor: '*RPackage-SystemIntegration' stamp: 'GuillermoPolito 8/17/2012 17:38'!
methodRepackaged: aMethod from: aPackage to: anotherPackage
	self announce: (MethodRepackaged
						methodRepackaged: aMethod
						oldPackage: aPackage 
						newPackage: anotherPackage)! !

!SystemAnnouncer methodsFor: 'triggering' stamp: 'GuillermoPolito 8/2/2012 00:16'!
classDefinitionChangedFrom: oldClass to: newClass
	self announce: (ClassModifiedClassDefinition classDefinitionChangedFrom: oldClass to: newClass)! !

!SystemAnnouncer methodsFor: 'announce' stamp: 'EstebanLorenzano 8/3/2012 13:56'!
announce: anAnnouncement
	self isSuspended 
		ifFalse: [ 
			self private announce: anAnnouncement.
			super announce: anAnnouncement ]! !

!SystemAnnouncer methodsFor: 'triggering' stamp: 'GuillermoPolito 8/2/2012 00:06'!
classCategoryRenamedFrom: anOldClassCategoryName to: aNewClassCategoryName

	self announce: (CategoryRenamed
					classCategoryRenamedFrom: anOldClassCategoryName 
					to: aNewClassCategoryName)! !

!SystemAnnouncer methodsFor: 'triggering' stamp: 'EstebanLorenzano 7/27/2012 15:39'!
evaluated: textOrStream
	^ self evaluated: textOrStream context: nil.! !

!SystemAnnouncer methodsFor: 'triggering' stamp: 'GuillermoPolito 8/2/2012 00:37'!
classReorganized: aClass
	self announce: (ClassReorganized class: aClass)! !

!SystemAnnouncer methodsFor: 'testing' stamp: 'EstebanLorenzano 7/27/2012 11:04'!
isSuspended
	^suspended ifNil: [ suspended := false ]! !

!SystemAnnouncer methodsFor: 'triggering' stamp: 'EstebanLorenzano 5/3/2013 12:02'!
protocolRemoved: aString inClass: aClass
	self announce: (ProtocolRemoved new 
		classReorganized: aClass;
		protocol: aString;
		yourself)! !

!SystemAnnouncer methodsFor: 'triggering' stamp: 'GuillermoPolito 8/2/2012 10:09'!
classCategoryRemoved: aClassCategoryName

	self announce: (CategoryRemoved categoryName: aClassCategoryName)! !

!SystemAnnouncer methodsFor: 'triggering' stamp: 'CamilleTeruel 9/4/2014 16:40'!
methodAdded: aMethod 
	"A method with the given selector was added to aClass, but not put in a protocol."

	self announce: (MethodAdded method: aMethod)! !

!SystemAnnouncer methodsFor: 'subscription' stamp: 'EstebanLorenzano 8/3/2012 15:12'!
unsubscribe: anObject
	self private unsubscribe: anObject.	
	super unsubscribe: anObject.
! !

!SystemAnnouncer methodsFor: 'triggering' stamp: 'CamilleTeruel 9/4/2014 17:35'!
methodRecategorized: method oldProtocol: oldProtocol

	self announce: (MethodRecategorized method: method oldProtocol: oldProtocol)! !

!SystemAnnouncer methodsFor: 'triggering' stamp: 'PabloEstefo 1/29/2013 17:40'!
snapshotDone: isNewImage

	self announce: (SnapshotDone isNewImage: isNewImage)! !

!SystemAnnouncer methodsFor: 'accessing' stamp: 'EstebanLorenzano 8/3/2012 13:54'!
private
	^private ifNil: [ private := Announcer new ]! !

!SystemAnnouncer methodsFor: 'triggering' stamp: 'GuillermoPolito 8/1/2012 23:56'!
class: aClass oldComment: oldComment newComment: newComment oldStamp: oldStamp newStamp: newStamp
	"A class was commented in the system."

	self announce: (ClassCommented class: aClass oldComment: oldComment newComment: newComment oldStamp: oldStamp newStamp: newStamp)! !

!SystemAnnouncer methodsFor: 'triggering' stamp: 'EstebanLorenzano 5/3/2013 12:02'!
protocolAdded: aString inClass: aClass
	self announce: (ProtocolAdded new 
		classReorganized: aClass;
		protocol: aString;
		yourself)! !

!SystemAnnouncer methodsFor: 'triggering' stamp: 'CamilleTeruel 9/5/2014 12:10'!
methodRemoved: aMethod protocol: protocol origin: aBehavior
	"A method with the given selector was removed from the class."

	self announce: (MethodRemoved methodRemoved: aMethod protocol: protocol origin: aBehavior)! !

!SystemAnnouncer methodsFor: 'triggering' stamp: 'GuillermoPolito 8/1/2012 23:56'!
classCommented: aClass
	"A class with the given name was commented in the system."

	self announce: (ClassCommented classCommented: aClass)! !

!SystemAnnouncer methodsFor: '*RPackage-SystemIntegration' stamp: 'GuillermoPolito 8/17/2012 17:24'!
classRepackaged: aClass from: aPackage to: anotherPackage
	self announce: (ClassRepackaged
						classRepackaged: aClass
						oldPackage: aPackage 
						newPackage: anotherPackage)! !

!SystemAnnouncer methodsFor: 'triggering' stamp: 'GuillermoPolito 8/2/2012 00:23'!
classCategoryAdded: aClassCategoryName

	self announce: (CategoryAdded categoryName: aClassCategoryName)! !

!SystemAnnouncer class methodsFor: 'initialization' stamp: 'EstebanLorenzano 8/3/2012 13:58'!
reset
	announcer := nil.! !

!SystemAnnouncer class methodsFor: 'initialization' stamp: 'EstebanLorenzano 8/3/2012 13:58'!
unload
	self uniqueInstance unsubscribe: self! !

!SystemAnnouncer class methodsFor: 'accessing' stamp: 'GuillermoPolito 4/27/2012 13:25'!
announcer: anAnnouncer
	announcer := anAnnouncer! !

!SystemAnnouncer class methodsFor: 'instance creation' stamp: 'EstebanLorenzano 7/27/2012 12:15'!
uniqueInstance
	"Answer a system annoncer."
	
	^ announcer ifNil: [ announcer := self new ]! !

!SystemAnnouncer class methodsFor: 'initialization' stamp: 'EstebanLorenzano 8/3/2012 14:32'!
restoreAllNotifications
	"self restoreAllNotifications"
	
	| collector |
	self reset.
	collector := PragmaCollector filter: [ :pragma | pragma keyword = #systemEventRegistration ].
	collector reset.
	collector do: [ :pragma |
		pragma methodClass theNonMetaClass perform: pragma selector ]! !

!SystemAnnouncerTest methodsFor: 'tests' stamp: 'BernardoContreras 11/3/2014 21:16'!
testProtocolRemoved
	| pass class classRemoved protocolRemoved |
	
	pass := false.
	
	SystemAnnouncer uniqueInstance 
		when: ProtocolRemoved do: [ :ann | 
			pass := true.
			classRemoved := ann classReorganized.			
			protocolRemoved := ann protocol ].
		
	class := factory newClass.
	class organization addCategory: 'shiny-new-category'.
	
	class organization removeCategory: 'shiny-new-category'.
		
	self assert: pass.
	self assert: classRemoved equals: class.
	self assert: protocolRemoved equals: 'shiny-new-category'! !

!SystemAnnouncerTest methodsFor: 'tests' stamp: 'BernardoContreras 11/3/2014 21:16'!
testProtocolAdded
	| pass class classReorganized protocolAdded |
	
	pass := false.
	
	SystemAnnouncer uniqueInstance 
		when: ProtocolAdded do: [ :ann | 
			pass := true.
			classReorganized := ann classReorganized.
			protocolAdded := ann protocol ].
		
	class := factory newClass.
	class organization addCategory: 'shiny-new-category'.
		
	self assert: pass.
	self assert: classReorganized equals: class.
	self assert: protocolAdded equals: 'shiny-new-category'! !

!SystemAnnouncerTest methodsFor: 'tests' stamp: 'BernardoContreras 11/3/2014 21:15'!
testSuspendAllWhile
	| value |
	
	value := 42.	
	
	SystemAnnouncer uniqueInstance suspendAllWhile: [ 
		SystemAnnouncer uniqueInstance 
			when: ClassAdded do: [ value := value + 1 ];
			announce: ClassAdded ].
		
	self assert: value = 42. "The answer is always 42 :)"
	
	SystemAnnouncer uniqueInstance announce: ClassAdded.
	
	self assert: value = 43.! !

!SystemAnnouncerTest methodsFor: 'running' stamp: 'EstebanLorenzano 5/3/2013 11:03'!
tearDown
	super tearDown.

	SystemAnnouncer announcer: oldSystemAnnouncer.
	
	factory cleanUp.! !

!SystemAnnouncerTest methodsFor: 'running' stamp: 'EstebanLorenzano 5/3/2013 11:10'!
setUp 
	super setUp. 
	
	oldSystemAnnouncer := SystemAnnouncer uniqueInstance.
	SystemAnnouncer announcer: nil.
	
	factory := ClassFactoryForTestCase new.! !

!SystemDictionary commentStamp: 'nice 3/6/2010 21:56'!
I represent a special dictionary used as global namespace for class names :

	Smalltalk globals classNames.

and for traits too:

	Smalltalk globals traitNames.
	
and a few other globals:

	(Smalltalk globals keys reject: [:k | (Smalltalk globals at: k) isBehavior])
			collect: [:k | k -> (Smalltalk globals at: k) class].

As the above example let you guess, the global namespace of Smalltalk system is accessed through:

	Smalltalk globals.!
!SystemDictionary methodsFor: 'renaming' stamp: ''!
renameClass: aClass as: newName 
	"Rename the class, aClass, to have the title newName."

	^self renameClass: aClass from: aClass name to: newName! !

!SystemDictionary methodsFor: 'classes and traits' stamp: 'MarcusDenker 10/16/2013 18:22'!
allBehaviors
	"Return all the classes and traits defined in the Smalltalk SystemDictionary"

	^ self allClassesAndTraits flatCollect: [:each | {each . each classSide} ]! !

!SystemDictionary methodsFor: 'classes and traits' stamp: 'MarcusDenker 4/30/2011 07:47'!
allClassesAndTraitsDo: aBlock
	"Evaluate the argument, aBlock, for each class and trait in the system."
	
	^self classAndTraitNames do: [:each | aBlock value: (self at: each)]
	
	
! !

!SystemDictionary methodsFor: 'class and trait names' stamp: 'MarcusDenker 10/8/2013 11:16'!
classAndTraitNames
	"Answer a sorted collection of all class and trait (not including class-traits) names. Do not bother to sort"

	
	^self classNames, self traitNames
	! !

!SystemDictionary methodsFor: 'class and trait names' stamp: 'ul 10/8/2010 21:23'!
flushClassNameCache
	"Smalltalk flushClassNameCache"
	"Force recomputation of the cached list of class names and non-class names."

	cachedClassNames := cachedNonClassNames := nil! !

!SystemDictionary methodsFor: '*Fuel' stamp: 'MartinDias 2/21/2013 12:53'!
fuelAccept: aGeneralMapper
	"serialize all instances except for <Smalltalk globals>"
	^ self == Smalltalk globals 
		ifFalse: [ super fuelAccept: aGeneralMapper ]
		ifTrue: [ aGeneralMapper visitHookPrimitive: self ]! !

!SystemDictionary methodsFor: 'classes and traits' stamp: ''!
classNamed: className 
	^self classOrTraitNamed: className.! !

!SystemDictionary methodsFor: 'accessing' stamp: ''!
environment
	"for conversion from SmalltalkImage to SystemDictionary"
	
	^ self ! !

!SystemDictionary methodsFor: '*TxText-Styler' stamp: 'IgorStasenko 11/11/2014 11:59'!
findVariable: lookupBlock ifNone: notFoundBlock
 
	self associationsDo: [ :assoc | | var |
		var := OCLiteralVariable new 
			assoc: assoc; 
			scope: self; 
			yourself.
		(lookupBlock value: var) ifTrue: [ ^ var ].
		 ].
	^ notFoundBlock value! !

!SystemDictionary methodsFor: 'classes and traits' stamp: 'MarcusDenker 10/17/2013 12:10'!
hasClassNamed: aString
	"Answer whether there is a class of the given name, but don't intern aString if it's not alrady interned."

	Symbol 
		hasInterned: aString 
		ifTrue:  [:aSymbol | ^ (self at: aSymbol ifAbsent: [nil]) isClass].
	^ false! !

!SystemDictionary methodsFor: 'dictionary access' stamp: ''!
removeKey: key ifAbsent: aBlock
	"Remove key (and its associated value) from the receiver. If key is not in
	the receiver, answer the result of evaluating aBlock. Otherwise, answer
	the value externally named by key."
	
	self flushClassNameCache.
	^super removeKey: key ifAbsent: aBlock! !

!SystemDictionary methodsFor: 'classes and traits' stamp: 'MarcusDenker 4/30/2011 10:51'!
allClassesDo: aBlock
	"Evaluate the argument, aBlock, for each class in the system."

	^self classNames do: [:name | aBlock value: (self at: name)]! !

!SystemDictionary methodsFor: 'classes and traits' stamp: 'MarcusDenker 4/21/2011 13:51'!
allClassesAndTraits
	"Return all the classes and traits defined in the Smalltalk SystemDictionary"

	^ self classAndTraitNames collect: [:each | self at: each]! !

!SystemDictionary methodsFor: 'copying' stamp: ''!
veryDeepCopyWith: deepCopier
	"Return self.  I can't be copied.  Do not record me."! !

!SystemDictionary methodsFor: 'class and trait names' stamp: 'ul 10/8/2010 21:22'!
classNames
	"Answer a sorted collection of all class names. Use the return value of #fillCaches to avoid concurrency issues."
	
	^cachedClassNames ifNil: [ self fillCaches at: 1 ]! !

!SystemDictionary methodsFor: 'accessing' stamp: ''!
bindingOf: varName
	"SystemDictionaries includes symbols only"
	
	^ super bindingOf: varName asSymbol! !

!SystemDictionary methodsFor: 'printing' stamp: ''!
printElementsOn: aStream
	aStream nextPutAll:'(lots of globals)'! !

!SystemDictionary methodsFor: 'accessing' stamp: ''!
organization
	"Return the organizer for the receiver"
	
	^ self at: #SystemOrganization! !

!SystemDictionary methodsFor: 'classes and traits' stamp: 'EstebanLorenzano 7/27/2012 16:30'!
forgetClass: aClass logged: aBool 
	"Delete the class, aClass, from the system.
	Note that this doesn't do everything required to dispose of a class - to do that use Class>>removeFromSystem."

	aBool ifTrue: [SystemAnnouncer uniqueInstance classRemoved: aClass fromCategory: aClass category].		
	self organization removeElement: aClass name.
	Smalltalk removeFromStartUpList: aClass.
	Smalltalk removeFromShutDownList: aClass.
	self removeKey: aClass name ifAbsent: [].
	self flushClassNameCache! !

!SystemDictionary methodsFor: 'classes and traits' stamp: 'MarcusDenker 4/30/2011 10:51'!
allTraitsDo: aBlock
	"Evaluate the argument, aBlock, for each trait in the system."

	^self traitNames do: [:name | aBlock value: (self at: name)]! !

!SystemDictionary methodsFor: 'renaming' stamp: 'EstebanLorenzano 7/27/2012 16:30'!
renameClass: aClass from: oldName to: newName
	"Rename the class, aClass, to have the title newName."

	| oldref category |
	category := self organization categoryOfElement: oldName.
	self organization classify: newName under: category.
	self organization removeElement: oldName.
	oldref := self associationAt: oldName.
	self removeKey: oldName.
	oldref key: newName.
	self add: oldref.  "Old association preserves old refs"
	Smalltalk renamedClass: aClass from: oldName to: newName.
	self flushClassNameCache.
	SystemAnnouncer uniqueInstance classRenamed: aClass from: oldName to: newName inCategory: category! !

!SystemDictionary methodsFor: 'classes and traits' stamp: 'MarcusDenker 4/21/2011 14:54'!
allClasses  
	"Return all the class defines in the Smalltalk SystemDictionary"

	^ self classNames collect: [:name | self at: name]! !

!SystemDictionary methodsFor: 'testing' stamp: 'MarcusDenker 11/30/2010 11:10'!
hasBindingThatBeginsWith: aString
	"Use the cached class and non-class names for better performance."

	| name searchBlock |
	searchBlock := [ :element |
		(element beginsWith: aString)
			ifTrue: [ 0 ]
			ifFalse: [
				aString < element
					ifTrue: [ -1 ]
					ifFalse: [ 1 ] ] ].
	name := self classNames 
		findBinary: searchBlock
		ifNone: [nil].
	name ifNotNil: [ ^true ].
	name := self nonClassNames 
		findBinary: searchBlock
		ifNone: [nil].
	^name notNil! !

!SystemDictionary methodsFor: 'class and trait names' stamp: 'ul 10/8/2010 21:22'!
nonClassNames
	"Answer a sorted collection of all non-class names. Use the return value of #fillCaches to avoid concurrency issues."
	
	^cachedNonClassNames ifNil: [ self fillCaches at: 2 ]! !

!SystemDictionary methodsFor: 'accessing' stamp: ''!
organization: anOrganization
	"Return the organizer for the receiver"
	
	anOrganization environment: self.
	^self at: #SystemOrganization put: anOrganization! !

!SystemDictionary methodsFor: 'classes and traits' stamp: 'MarcusDenker 10/9/2013 10:39'!
removeClassNamed: aName
	"Invoked from fileouts:  if there is currently a class in the system named aName, then remove it"

	self at: aName asSymbol ifPresent: [:oldClass | oldClass removeFromSystem]! !

!SystemDictionary methodsFor: 'renaming' stamp: 'ClementBera 7/26/2013 17:07'!
renameClassNamed: oldName as: newName
	"Invoked from fileouts:  if there is currently a class in the system named oldName, then rename it to newName.  If anything untoward happens, report it in the Transcript.  "

	| oldClass |
	(oldClass := self at: oldName asSymbol ifAbsent: [ nil ]) 
		ifNil: [ 
			self crTrace: 'Class-rename for ' , oldName , ' ignored because ' , oldName , ' does not exist.'.
			^ self ].
	oldClass rename: newName! !

!SystemDictionary methodsFor: '*Fuel' stamp: 'MartinDias 2/21/2013 12:54'!
serializeOn: anEncoder
	"Do nothing"! !

!SystemDictionary methodsFor: 'classes and traits' stamp: ''!
allTraits
	"Return all traits defined in the Smalltalk SystemDictionary"

	^ self traitNames collect: [:each | self at: each]! !

!SystemDictionary methodsFor: 'renaming' stamp: ''!
renameClass: aClass from: oldName 
	"Rename the class, aClass, to have the title newName."

	^self renameClass: aClass from: oldName to: aClass name! !

!SystemDictionary methodsFor: 'dictionary access' stamp: 'ClementBera 4/11/2013 14:02'!
at: aKey put: anObject 
	"Override from Dictionary to check Undeclared and fix up
	references to undeclared variables."
	
	(self includesKey: aKey) ifFalse: 
		[self declare: aKey from: Undeclared.
		self flushClassNameCache].
	super at: aKey put: anObject.
	^ anObject! !

!SystemDictionary methodsFor: 'accessing' stamp: 'MarcusDenker 7/11/2014 18:56'!
poolUsers
	"Answer a dictionary of pool name -> classes that refer to it.
	Also includes any globally know dictionaries (such as
	Smalltalk, Undeclared etc) which although not strictly
	accurate is potentially useful information"

	"Smalltalk globals poolUsers"

	| poolUsers |
	poolUsers := Dictionary new.
	self
		keysDo: [ :k | 
			| pool refs |
			"yes, using isKindOf: is tacky but for reflective code like
			this it is very useful. If you really object you can:-
			a) go boil your head.
			b) provide a better answer.
			your choice."
			(((pool := self at: k) isKindOf: Dictionary) or: [ pool isKindOf: SharedPool class ])
				ifTrue: [ 
					refs := self systemNavigation allClasses
						select: [ :c | c sharedPools identityIncludes: pool ]
						thenCollect: [ :c | c name ].
					refs add: (self systemNavigation allReferencesTo: (self associationAt: k)).
					poolUsers at: k put: refs ] ].
	^ poolUsers! !

!SystemDictionary methodsFor: 'class and trait names' stamp: 'CamilloBruni 8/1/2012 16:27'!
fillCaches
	"Fill cachedClassNames and cachedNonClassNames. Return an array with the calculated values."

	| classNames nonClassNames |
	classNames := OrderedCollection new: self size.
	nonClassNames := OrderedCollection new.
	self keysAndValuesDo: [ :key :value |
		"The key == value name test below addresses two separate issues:
			1) Obsolete classes, where key = #Foo and value name = 'AnObsoleteFoo'
			2) Aliases, i.e., Smalltalk at: #OtherName put: aClass"
		((value isKindOf: (self class environment at: #Class)) and: [ key == value name ])
			ifTrue: [ classNames add: key ]
			ifFalse: [ nonClassNames add: key ] ].
		"The expression (self class environment at: #Class) deserves some explanation.
		For bootstrapping we need to have a different Class when executing value isKindOf: Class :
		In such expression Class represents a kind of fixed point: the class of the class of the system. 
		When bootstrapping we want the class Class of the current kernel defined in the current namespace.
		Since the current namespace should contains the class that describes itself as well as a new Class class.
		we are done :)."
		
	classNames sort.
	cachedNonClassNames := nonClassNames sort.
	cachedClassNames := classNames.
	^{ classNames. nonClassNames }! !

!SystemDictionary methodsFor: 'class and trait names' stamp: 'MarcusDenker 4/30/2011 08:25'!
traitNames
	"Answer a SortedCollection of all traits (not including class-traits) names."
	
	^self nonClassNames select: [ :name |
			self
				at: name
				ifPresent: [ :global | (global isTrait) and: [global isObsolete not]]
				ifAbsent: [ false ] ]! !

!SystemDictionary methodsFor: 'classes and traits' stamp: 'md 3/12/2011 15:28'!
classOrTraitNamed: aString
	"aString is either a class or trait name or a class or trait name followed by ' class' or 'classTrait' respectively.
	Answer the class or metaclass it names."

	| meta baseName |
	(aString endsWith: ' class')
		ifTrue: [ 
			meta := true.
			baseName := aString copyFrom: 1 to: aString size - 6 ]
		ifFalse: [ 
			(aString endsWith: ' classTrait')
				ifTrue: [ 
					meta := true.
					baseName := aString copyFrom: 1 to: aString size - 11 ]
				ifFalse: [ 
					meta := false.
					baseName := aString ] ].
	^self at: baseName asSymbol ifPresent:
            [ :global |
               (global isBehavior or: [global isTrait])ifTrue:
                       [ meta
                               ifFalse: [ global ]
                               ifTrue: [ global classSide ]]]! !

!SystemDictionary methodsFor: '*Slot' stamp: 'MarcusDenker 7/29/2014 15:57'!
declare: key from: aDictionary 
	"Add key to the receiver. If key already exists, do nothing. If aDictionary 
	includes key, then remove it from aDictionary and use its association as 
	the element of the receiver."
	"overridden here to add a Global, not just an association"

	(self includesKey: key) ifTrue: [^ self].
	(aDictionary includesKey: key)
		ifTrue: 
			[self add: ((aDictionary associationAt: key) primitiveChangeClassTo: GlobalVariable new).
			aDictionary removeKey: key]
		ifFalse: 
			[self add: (GlobalVariable key: key)]! !

!SystemDictionary class methodsFor: 'instance creation' stamp: ''!
withOrganizer: anOrganizer
	| dictionary |
	dictionary := self new.
	dictionary organization: anOrganizer. "update too the back pointer"
	^dictionary.
	! !

!SystemDictionary class methodsFor: '*Fuel' stamp: 'MartinDias 2/21/2013 12:55'!
materializeFrom: aDecoder
	"Answer my well-known instance"

	^ Smalltalk globals! !

!SystemDictionaryTest methodsFor: 'tests' stamp: 'sd 7/21/2009 10:37'!
testSmalltalkAsString
	self assert: Smalltalk asString = 'Smalltalk'! !

!SystemDictionaryTest methodsFor: 'tests' stamp: 'sd 7/21/2009 10:36'!
testSmalltalkSelfEvaluating
	self assert: Smalltalk isSelfEvaluating! !

!SystemDictionaryTest methodsFor: 'tests' stamp: 'sd 7/21/2009 10:37'!
testOtherInstancesOfSystemDictionarySelfEvaluating
	self deny: SystemDictionary new isSelfEvaluating! !

!SystemDictionaryTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 6/29/2009 13:27'!
classToBeTested

^ SystemDictionary! !

!SystemDictionaryTest methodsFor: 'tests' stamp: 'StephaneDucasse 2/6/2011 21:01'!
testClassOrTraitNamedReturnsNilForGlobals
	"self debug: #testClassOrTraitNamedReturnsNilForGlobals"
	self assert: nil = (Smalltalk globals classOrTraitNamed: 'Undeclared').
	self assert: nil = (Smalltalk globals classOrTraitNamed: #Undeclared).! !

!SystemDictionaryTest methodsFor: 'tests' stamp: 'sd 7/21/2009 10:37'!
testOtherInstancesOfSystemDictionaryAsString
	self deny: SystemDictionary new asString = 'Smalltalk'! !

!SystemDictionaryTest methodsFor: 'problems' stamp: 'cyrille.delaunay 7/17/2009 11:25'!
testUnCategorizedMethods
	| categories slips  |	categories := self categoriesForClass: self targetClass.
	slips := categories select: [:each | each = #'as yet unclassified'].
	self should: [slips isEmpty].	! !

!SystemDictionaryTest methodsFor: 'tests' stamp: 'sd 7/21/2009 10:36'!
testSmalltalkPrintString
	self assert: Smalltalk printString = 'Smalltalk'! !

!SystemDictionaryTest methodsFor: 'problems' stamp: 'marcus.denker 7/29/2009 15:27'!
testClassComment
	self should: [self targetClass organization hasComment].! !

!SystemDictionaryTest methodsFor: 'tests' stamp: 'StephaneDucasse 10/3/2010 15:05'!
testSetOrganizationSetBackPointer
	"self debug: #testSetOrganizationSetBackPointer"
	
	| sd so |
	sd := SystemDictionary new.
	so := SystemOrganizer new.
	sd organization: so.
	self assert: so environment == sd.
	self assert: sd organization == so
	! !

!SystemDictionaryTest methodsFor: 'tests' stamp: 'LucFabresse 10/24/2010 17:25'!
testOrganizationPerInstance
	"self debug: #testOrganizationPerInstance"
	
	| aDictionary otherDictionary |	
	aDictionary := SystemDictionary withOrganizer: SystemOrganizer new.
	otherDictionary := SystemDictionary withOrganizer: SystemOrganizer new.
	self deny: aDictionary organization = otherDictionary organization.
	! !

!SystemDictionaryTest methodsFor: 'tests' stamp: 'VincentBlondeau 3/6/2015 17:45'!
testEnvironmentOfOrganization
	"self debug: #testEnvironmentOfOrganization"
	
	| aDictionary |	
	aDictionary := SystemDictionary withOrganizer: SystemOrganizer new.
	self assert: aDictionary organization environment equals: aDictionary
	! !

!SystemDictionaryTest methodsFor: 'tests' stamp: 'StephaneDucasse 2/6/2011 21:01'!
testClassOrTraitNamedReturnsClassForClasses
	"self debug: #testClassOrTraitNamedReturnsClassForClasses"
	self assert: Object ==  (Smalltalk globals classOrTraitNamed: 'Object').
	self assert: Object ==  (Smalltalk globals classOrTraitNamed: #Object).! !

!SystemDictionaryTest methodsFor: 'tests' stamp: 'sd 7/21/2009 10:37'!
testOtherInstancesOfSystemDictionaryPrintString
	self deny: SystemDictionary new printString = 'Smalltalk'! !

!SystemDictionaryTest class methodsFor: 'building suites' stamp: 'cyrille.delaunay 6/29/2009 13:28'!
shouldInheritSelectors

^true! !

!SystemHelp commentStamp: 'tbn 4/30/2010 15:33'!
This class defines Help for the system in front of you.
It defines the default contents when you open a help browser.

So "HelpBrowser open" is the same as "HelpBrowser openOn: SystemHelp".


!
!SystemHelp class methodsFor: 'conversion' stamp: 'tbn 1/19/2011 21:33'!
asHelpTopic 
	|topic helpOnHelp sortedTopics |
	topic := HelpTopic named: 'Help'.
	self allSystemHelpPragmas do: [:each | 
		topic subtopics addAll: each method methodClass theNonMetaClass asHelpTopic subtopics
	].
	topic sortSubtopicsByTitle.
	helpOnHelp := topic subtopics detect: [:t | t key = 'HelpOnHelp'] ifNone: [self error: 'Help for the help system is removed'].
	sortedTopics := topic subtopics.
	sortedTopics remove: helpOnHelp.
	sortedTopics addLast: helpOnHelp.
	topic subtopics: sortedTopics.
	^topic.
! !

!SystemHelp class methodsFor: 'private accessing' stamp: 'tbn 1/7/2011 13:06'!
allSystemHelpPragmas
	^(PragmaCollector filter: [:prag | prag keyword = self pragmaKeyword ]) reset collected
! !

!SystemHelp class methodsFor: 'private accessing' stamp: 'tbn 1/7/2011 13:04'!
pragmaKeyword

	^#systemHelp
! !

!SystemNavigation commentStamp: 'LucFabresse 10/10/2010 19:54'!
I support the navigation of the system. 
I act as a facade but as I could require some state or different way of navigating the system all my behavior are on the instance side.
I should (it is not complety done yet) be parametrized by an environment (aSystemDictionary) that scopes my queries.!
!SystemNavigation methodsFor: 'query' stamp: 'AlexandreBergel 12/29/2010 11:39'!
allBehaviorsDo: aBlock 
	"Execute a block on each class, metaclass, trait and trait class"
	
	self environment allClassesDo: [ :aClass | 
		aBlock value: aClass ; 
			value: aClass class
	].
	
	self environment allTraitsDo: [ :aTrait |
		aBlock value:  aTrait ;
			value: aTrait classTrait
	]
! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'BernardoContreras 3/7/2015 14:13'!
chooseInstVarFrom: aClass thenDo: aBlock 
	"Put up a menu of all the instance variables in the receiver, and when
the user chooses one, evaluate aBlock with the chosen variable as its
parameter.  If the list is 6 or larger, then offer an alphabetical
formulation as an alternative. triggered by a 'show alphabetically' item
at the top of the list."

	| lines labelStream allVars index count offerAlpha |
	(count := aClass allInstVarNames size) = 0 ifTrue: 
		[^ self inform: 'There are no 
instance variables.'].

	allVars := OrderedCollection new.
	lines := OrderedCollection new.
	labelStream := (String new: 200) writeStream.
	(offerAlpha := count > 5)
		ifTrue:
			[lines add: 1.
			allVars add: 'show alphabetically'.
			labelStream nextPutAll: allVars first; cr].
	aClass withAllSuperclasses reverseDo:
		[:class | | vars |
		vars := class instVarNames.
		vars do:
			[:var |
			labelStream nextPutAll: var; cr.
			allVars add: var].
		vars isEmpty ifFalse: [lines add: allVars size]].
	labelStream skip: -1 "cut last CR".
	(lines notEmpty and: [lines last = allVars size]) ifTrue:
		[lines removeLast].  "dispense with inelegant line beneath last item"
	index := (UIManager default chooseFrom: (labelStream contents substrings: {Character cr}) lines: lines
title: 'Instance variables in ', aClass name).
	index = 0 ifTrue: [^ self].
	(index = 1 and: [offerAlpha]) ifTrue: [^ self
chooseInstVarAlphabeticallyFrom: aClass thenDo: aBlock].
	aBlock value: (allVars at: index)! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'StephaneDucasse 8/9/2011 17:57'!
confirmRemovalOf: aSelector on: aClass 
	"Determine if it is okay to remove the given selector. Answer 1 if it  
	should be removed, 2 if it should be removed followed by a senders  
	browse, and 3 if it should not be removed."
	| count answer caption allCalls |
	allCalls := self allCallsOn: aSelector.
	(count := allCalls size) = 0
		ifTrue: [^ 1].
	"no senders -- let the removal happen without warning"
	count = 1
		ifTrue: [(allCalls first actualClass == aClass
					and: [allCalls first selector == aSelector])
				ifTrue: [^ 1]].
	"only sender is itself"
	caption := 'The message ', aSelector printString ,' has ' , count printString , ' sender'.
	count > 1
		ifTrue: [caption := caption copyWith: $s].
	answer := UIManager default 
		chooseFrom: #('Remove it'
				'Remove, then browse senders'
				'Don''t remove, but show me those senders'
				'Forget it -- do nothing -- sorry I asked') title: caption.
	answer = 3
		ifTrue: [self
				browseMessageList: allCalls
				name: 'Senders of ' , aSelector
				autoSelect: aSelector keywords first].
	answer = 0
		ifTrue: [answer := 3].
	"If user didn't answer, treat it as cancel"
	^ answer min: 3! !

!SystemNavigation methodsFor: 'query' stamp: 'NicolaiHess 2/25/2014 12:55'!
allMethodsWithSourceString: aString matchCase: caseSensitive
	"Answer a SortedCollection of all the methods that contain, in source code, aString as a substring.  Search the class comments also"

	| list addMethod addComment |
	list := Set new.
	
	addMethod := [ :mrClass :mrSel | list add: (self createMethodNamed: mrSel realParent:  mrClass)].									
	addComment := [ :mrClass | list add: (RGCommentDefinition realClass: mrClass)].
										
	'Searching all source code...'
		displayProgressFrom: 0 to: (2*Smalltalk globals classAndTraitNames size)
		during: [:bar | | count |
			count := 0.
			self allBehaviorsDo: [:each |
				bar current: (count := count + 1).
					each selectorsDo: [:sel | 
						((each sourceCodeAt: sel) includesSubstring: aString caseSensitive: caseSensitive) ifTrue: [
								 addMethod value: each value: sel]].
					(each organization classComment asString includesSubstring: aString caseSensitive: caseSensitive) ifTrue: [
								addComment value: each]	]].
			^ list asSortedCollection! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'MarcusDenker 7/29/2014 07:35'!
browseAllReferencesTo: aLiteral 
	"Create and schedule a message browser on each method that refers to 
	aLiteral. For example, SystemNavigation new browseAllSendersOf: #printOn:."

	^ self openBrowserFor: aLiteral withMethods: (self allCallsOn: aLiteral) ! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'MarcusDenker 10/13/2013 07:59'!
confirmRemovalOfSelectors: aCollection on: aClass 
	"Determine if it is okay to remove the given selector. Answer 1 if it  
	should be removed, 2 if it should be removed followed by a senders  
	browse, and 3 if it should not be removed."
	| collection count answer caption allCalls selectors oneCalls |
	collection := aCollection asOrderedCollection.
	oneCalls := OrderedCollection new.
	aCollection do: [:sel | 
		allCalls := self allCallsOn: sel.
		(count := allCalls size) = 0 "no senders -- let the removal happen without warning"
			ifTrue: [ collection remove: sel ].
		count = 1 "only sender is itself"
			ifTrue: [ (allCalls first actualClass == aClass and: [ allCalls first selector == sel ])
						ifTrue: [ 
							oneCalls add: sel.
							collection remove: sel.]]].
				
	"collection removeAll: (self buildSelfContainedCallsFrom: aCollection in: aClass)."
	collection ifEmpty: [ ^ 1 ].
	count := collection inject: 0 into: [:sum :sel | sum + (self allCallsOn: sel) size].
	selectors := collection joinUsing: ', #' last: ' and #'.
	caption := 'The messages #', selectors,' have ' , count printString , ' sender'.
	"ugly but faster"
	caption := (count = 1
					ifTrue: [ 'The messages #', selectors,' have ' , count printString , ' sender' ]
					ifFalse: [ 'The messages #', selectors,' have ' , count printString , ' senders' ]).
	answer := UIManager default 
		chooseFrom: #('Remove them'
				'Remove, then browse senders (if still existing)'
				'Don''t remove, but show me those senders'
				'Forget it -- do nothing -- sorry I asked') title: caption.
	answer = 3
		ifTrue: [
			collection do: [:aSelector | self browseAllSendersOf: aSelector ]].
	answer = 0
		ifTrue: [answer := 3].
	"If user didn't answer, treat it as cancel"
	^ answer min: 3! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'NicolaiHess 1/23/2014 12:03'!
openBrowserFor: aLiteral withMethods: aCollection
	"Create and schedule a message sender browser for aCollection which normally should come from a query based on aLiteral (senders, implementors...). This method is usefull to avoid to call twice allCallsOn: in certain occasion.
	For example, 
		| sys |
		sys := SystemNavigation new.
		sys 
			openBrowserFor: #printOn: 
			withMethods: (sys allCallsOn: #printOn:) asSortedCollection"

	^ self headingAndAutoselectForLiteral: aLiteral do:
		[:label :autoSelect|
		self
			browseMessageList: aCollection
			name: label
			autoSelect: autoSelect
			refreshingBlockSelector:#setRefreshingBlockForSendersOf:]! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'BenjaminVanRyseghem 2/8/2012 17:15'!
browseHierarchy: aBehavior

	^ self browseHierarchy: aBehavior selector: nil! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'MarcusDenker 7/29/2014 07:35'!
browseAllSendersOf: aLiteral 
	"Create and schedule a message browser on each method that refers to 
	aLiteral. For example, SystemNavigation new browseAllSendersOf: #printOn:."

	^ self openBrowserFor: aLiteral withMethods: (self allCallsOn: aLiteral) ! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'MarcusDenker 10/17/2013 12:09'!
classFromPattern: pattern withCaption: aCaption
	"If there is a class whose name exactly given by pattern, return it.
	If there is only one class in the system whose name matches pattern, return it.
	Otherwise, put up a menu offering the names of all classes that match pattern, and return the class chosen, else nil if nothing chosen.
	This method ignores tab, space, & cr characters in the pattern"

	| toMatch potentialClassNames classNames exactMatch index |
	(toMatch := pattern
		copyWithoutAll:
			{(Character space).
			(Character cr).
			(Character tab)}) isEmpty
		ifTrue: [ ^ nil ].
	Symbol
		hasInterned: toMatch
		ifTrue: [ :patternSymbol | 
			self environment
				at: patternSymbol
				ifPresent: [ :maybeClass | 
					maybeClass isClassOrTrait
						ifTrue: [ ^ maybeClass ] ] ].
	toMatch := (toMatch copyWithout: $.) asLowercase.
	potentialClassNames := (self environment classNames , self environment traitNames) asOrderedCollection.
	classNames := pattern last = $.
		ifTrue: [ potentialClassNames select: [ :nm | nm asLowercase = toMatch ] ]
		ifFalse: [ potentialClassNames select: [ :n | n includesSubstring: toMatch caseSensitive: false ] ].
	classNames isEmpty
		ifTrue: [ ^ nil ].
	exactMatch := classNames detect: [ :each | each asLowercase = toMatch ] ifNone: [ nil ].
	index := classNames size = 1
		ifTrue: [ 1 ]
		ifFalse: [ 
			exactMatch
				ifNil: [ UIManager default chooseFrom: classNames lines: #() title: aCaption ]
				ifNotNil: [ 
					classNames addFirst: exactMatch.
					UIManager default chooseFrom: classNames lines: #(1) title: aCaption ] ].
	index = 0
		ifTrue: [ ^ nil ].
	^ self environment at: (classNames at: index) asSymbol	"
	self default classFromPattern: 'znak' withCaption: ''
	self default classFromPattern: 'orph' withCaption: ''
	self default classFromPattern: 'TCompil' withCaption: ''
"! !

!SystemNavigation methodsFor: 'initialization' stamp: 'StephaneDucasse 10/23/2010 15:14'!
initialize

	super initialize.
	self environment: Smalltalk globals! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'BenjaminVanRyseghem 2/8/2012 17:17'!
browseInstVarRefs: aClass
	
	^ self chooseInstVarFrom: aClass thenDo: 
		[:aVar | self browseAllAccessesTo: aVar from: aClass]! !

!SystemNavigation methodsFor: 'query' stamp: 'AlexandreBergel 12/29/2010 11:38'!
allClassesAndTraits
	"Answer all the classes and traits present in the image"
	"Note that metaclasses are not part of the answer"
	
	^ Smalltalk globals allClassesAndTraits

	! !

!SystemNavigation methodsFor: 'accessing' stamp: 'LucFabresse 10/11/2010 19:08'!
environment: aSystemDictionary
	^environment :=  aSystemDictionary! !

!SystemNavigation methodsFor: 'query' stamp: 'StephaneDucasse 7/29/2012 21:33'!
allReferencesTo: aLiteral 
	"Answer a Collection of all the methods that refer to aLiteral even deeply embedded in literal array."

	"SystemNavigation new allReferencesTo: #+"
	"SystemNavigation new allReferencesTo: Point binding"
	
	| result special byte symbol |
	result := OrderedCollection new.
	special := Smalltalk
		hasSpecialSelector: aLiteral
		ifTrueSetByte: [ :value | byte := value ].
	symbol := aLiteral isSymbol.
	self allBehaviorsDo: [ :class |
		| selectors |
		selectors := symbol
			ifFalse: [ class whichSelectorsReferTo: aLiteral special: special byte: byte ]
			ifTrue: [ class thoroughWhichSelectorsReferTo: aLiteral special: special byte: byte ].
		selectors do: [ :selector |
			result addLast: (self createMethodNamed: selector realParent: class) ] ].
	^ result! !

!SystemNavigation methodsFor: 'query' stamp: ''!
allUnimplementedCalls
	"Answer an Array of each message that is sent by an expression in a  
	method but is not implemented by any object in the system."
	| aStream all |
	all := self allImplementedMessages.
	aStream := (Array new: 50) writeStream.
	self
		allBehaviorsDo: [:cl | cl
				selectorsAndMethodsDo: [:sel :meth |
					| secondStream | 
					secondStream := (String new: 5) writeStream.
					meth messages
						do: [:m | (all includes: m)
								ifFalse: [secondStream nextPutAll: m;
										 space]].
					secondStream position = 0
						ifFalse: [aStream nextPut: cl name , ' ' , sel , ' calls: ' , secondStream contents]]].
	^ aStream contents! !

!SystemNavigation methodsFor: 'query' stamp: 'NicolaiHess 11/17/2014 23:43'!
methodsWithUnboundGlobals
	"This says that for any global, it should match either the class's notion of what bindingOf: the key is, or bindingOf: should be nil and the binding should be in Undeclared. If the class answers a different binding through bindingOf: or answers no binding and the binding is not in Undeclared then the variable in the method is wrong.
	For a clean image the result should be empty. If it is not empty, evaluating Compiler recompileAll probably solves the problem. However, we should investigate why the method gets an incorrect state."

	"SystemNavigation new methodsWithUnboundGlobals"

	^self allMethodsSelect:
		[:m|
		m literals anySatisfy:
			[:l|
			l isVariableBinding
			and: [l key isSymbol "avoid class-side methodClass literals"
			and: [(m methodClass classBindingOf: l key)
					ifNil: [(Undeclared associationAt: l key ifAbsent: []) ~~ l]
					ifNotNil: [:b| b ~~ l]]]]]! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'MarcusDenker 1/2/2015 11:35'!
browseMessageList: messageList name: labelString autoSelect: autoSelectString refreshingBlockSelector:aRefreshingBlockSelector
	"Create and schedule a MessageSet browser on the message list."
	| methods |
	
	"Do not show trait methods"
	methods := messageList reject: [ :each| each isFromTrait ].
	
	methods isEmpty ifTrue: 
		[^ self inform: 'There are no ', String cr, labelString].
	
	^ Smalltalk tools messageList
		openMessageList: methods 
		name: labelString 
		autoSelect: autoSelectString
		refreshingBlockSelector:aRefreshingBlockSelector ! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'CamilloBruni 9/21/2012 14:19'!
browseAllSendersOf: aLiteral localTo: aClass
	"Create and schedule a message browser on each method in or below the given class that refers to
	aLiteral.
	Example: 
		SystemNavigation new browseAllSendersOf: #open:label: localTo: CodeHolder."

	aClass ifNil: [ ^self inform: 'no selected class' ].
	^ self headingAndAutoselectForLiteral: aLiteral do:
		[:label :autoSelect|
		self browseMessageList: (aClass allLocalCallsOn: aLiteral) asSortedCollection
			name: label, ' local to ', aClass name
			autoSelect: autoSelect]! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'StephaneDucasse 5/13/2012 21:31'!
browseClassCommentsWithString: aString matchCase: caseSensitive
	"Smalltalk browseClassCommentsWithString: 'my instances' "
	"Launch a message list browser on all class comments containing aString as a substring."

	|  suffix list |
	suffix := caseSensitive 
		ifTrue: [' (case-sensitive)']
		ifFalse: [' (case-insensitive)'].
	list := Set new.
	Cursor wait showWhile: [
		Smalltalk allClassesDo: [:class | 
			(class organization classComment asString 
							includesSubstring: aString caseSensitive: caseSensitive) ifTrue: [
								list add: (RGCommentDefinition realClass: class)
							]
		]
	].
	^ self 
		browseMessageList: list asSortedCollection
		name: 'Class comments containing ' , aString printString , suffix
		autoSelect: aString! !

!SystemNavigation methodsFor: 'query' stamp: 'MarcusDenker 7/12/2012 18:05'!
obsoleteBehaviors
	"SystemNavigation new obsoleteBehaviors inspect"
	"Find all obsolete behaviors including meta classes"

	| obs |
	obs := OrderedCollection new.
	Smalltalk garbageCollect.
	self 
		allObjectsDo: [:cl | (cl isBehavior
					and: [cl isObsolete])
				ifTrue: [obs add: cl]].
	^ obs asArray! !

!SystemNavigation methodsFor: 'query' stamp: 'LucFabresse 10/11/2010 19:57'!
allClasses
	"currently returns all the classes in the current environment"

	^ self environment allClasses

	! !

!SystemNavigation methodsFor: 'query' stamp: 'MarcusDenker 10/9/2013 11:26'!
installedMethodsWithIncorrectTrailerKind

	^self allMethodsSelect:
		[:each | (#(#SourcePointer #VarLengthSourcePointer #NativeCodeTrailer) includes: each trailer kind) not and: [ each isInstalled ]  ]! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'MarcusDenker 2/19/2010 11:06'!
browseAllSelect: aBlock name: aName autoSelect: autoSelectString 
	"Create and schedule a message browser on each method that, when used 
	as the block argument to aBlock gives a true result."
	"self new browseAllSelect: [:method | method numLiterals > 10] name:  
	'Methods with more than 10 literals' autoSelect: 'isDigit'"
	
	^ self
		browseMessageList: (self allMethodsSelect: aBlock)
		name: aName
		autoSelect: autoSelectString! !

!SystemNavigation methodsFor: 'query' stamp: ''!
allCallsOn: aSymbol 
	"Answer a Collection of all the methods that call on the provided symbol even deeply embedded in literal array."
	"self new allCallsOn: #allCallsOn:"
	
	^ self allReferencesTo: aSymbol! !

!SystemNavigation methodsFor: 'private' stamp: 'BenjaminVanRyseghem 5/16/2011 14:15'!
headingAndAutoselectForLiteral: aLiteral do: binaryBlock
	"Evaluate aBlock with either Users of ... or Senders of ... plus the auto-select string
	 for the given literal.  aLiteral can be a Symbol, a VariableBinding or an arbitrary object."

	| autoSelect |
	^aLiteral isSymbol
		ifTrue: [binaryBlock value: 'Senders of ', aLiteral value: aLiteral ]
		ifFalse:
			[autoSelect := aLiteral isVariableBinding
							ifTrue: [aLiteral key]
							ifFalse: [aLiteral printString].
			binaryBlock value: 'Users of ', autoSelect value: autoSelect]! !

!SystemNavigation methodsFor: 'query' stamp: ''!
allClassesImplementing: aSelector  
	"Answer an Array of all classes that implement the message aSelector."

	| aCollection |
	aCollection := ReadWriteStream on: Array new.
	self allBehaviorsDo: [:class | (class includesSelector: aSelector) ifTrue: [aCollection nextPut: class]].
	^ aCollection contents! !

!SystemNavigation methodsFor: 'query' stamp: 'MarcusDenker 10/9/2013 09:00'!
allSentMessages
	"Answer the set of selectors which are sent somewhere in the system."
	| sent |
	sent := IdentitySet new.
	self allBehaviorsDo: [:each | 
				each selectors
					do: [:sel | "Include all sels, but not if sent by self"
						(each compiledMethodAt: sel) literalsDo: [:m | 
								(m isSymbol) ifTrue: ["might be sent"
										m == sel ifFalse: [sent add: m]].
								(m isMemberOf: Array) ifTrue: ["might be performed"
										m do: [:x | (x isSymbol) ifTrue: [x == sel ifFalse: [sent add: x]]]]]]].
		"The following may be sent without being in any literal frame"
		1
			to: Smalltalk specialSelectorSize
			do: [:index | sent
					add: (Smalltalk specialSelectorAt: index)].
	^ sent! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'BenjaminVanRyseghem 2/8/2012 17:17'!
browseInstVarDefs: aClass

	^ self chooseInstVarFrom: aClass thenDo: 
		[:aVar | self browseAllStoresInto: aVar from: aClass]! !

!SystemNavigation methodsFor: 'query' stamp: 'MarcusDenker 10/9/2013 11:26'!
instanceSideMethodsWithNilKeyInLastLiteral
	"This answers all the instance side methods that has NIL as the key in their last literal. There should be none (only class side methods have this)"

	^ self
		allMethodsSelect: [ :each | 
			(((each literalAt: each numLiterals) key isNil and: [ (each literalAt: each numLiterals) value isMeta not ])
				and: [ each methodClass ~= UndefinedObject ]) and: [ each isInstalled ] ]! !

!SystemNavigation methodsFor: 'query' stamp: 'ClementBera 4/11/2013 14:06'!
obsoleteClasses
	"SystemNavigation new obsoleteClasses inspect"

	"NOTE:  Also try inspecting comments below"

	| obs |
	obs := OrderedCollection new.
	Smalltalk garbageCollect.
	Metaclass
		allInstancesDo: [ :m | 
			| c |
			c := m soleInstance.
			(c notNil and: [ 'AnOb*' match: c name asString ])
				ifTrue: [ obs add: c ] ].
	^ obs asArray	"Likely in a ClassDict or Pool...
(Association allInstances select: [:a | (a value isKindOf: Class) and: ['AnOb*' match: a value name]]) asArray
"	"Obsolete class refs or super pointer in last lit of a method...
| n l found |
Smalltalk browseAllSelect:
	[:m | found := false.
	1 to: m numLiterals do:
		[:i | (((l := m literalAt: i) isMemberOf: Association)
				and: [(l value isKindOf: Behavior)
				and: ['AnOb*' match: l value name]])
			ifTrue: [found := true]].
	found]
"! !

!SystemNavigation methodsFor: 'message sends' stamp: 'MarcusDenker 10/7/2013 14:14'!
allSendersOf: selector 
	|  senders special byte |
	senders := OrderedCollection new.
	special := Smalltalk 
				hasSpecialSelector: selector
				ifTrueSetByte: [ :b | byte := b ].
	self allBehaviorsDo: [ :behavior | 
		(behavior
			thoroughWhichSelectorsReferTo: selector
			special: special
			byte: byte) do: [ :sel| senders add: (self createMethodNamed: sel realParent: behavior) ] ].
	^ senders! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'MarcusDenker 5/30/2012 15:00'!
browseMethodsWhoseNamesContain: aString
	"Launch a tool which shows all methods whose names contain the given 	string; case-insensitive."

	^ self browseAllSelect: [ :e | e selector includesSubstring: aString caseSensitive: false ].! !

!SystemNavigation methodsFor: 'query' stamp: 'MarcusDenker 10/7/2013 14:13'!
allImplementorsOf: aSelector 
	"Answer all the methods that implement the message aSelector."
	
	| aCollection |
	aCollection := OrderedCollection  new.
	self allBehaviorsDo: [:class | 
		(class includesSelector: aSelector)
			ifTrue: [aCollection add: (self createMethodNamed: aSelector realParent: class)]].
	^ aCollection! !

!SystemNavigation methodsFor: 'query' stamp: 'MarcusDenker 10/12/2013 10:52'!
allStoresInto: instVarName of: aClass
    | coll |
    coll := OrderedCollection new.
    aClass
        withAllSubAndSuperclassesDo: [ :class | (class whichSelectorsStoreInto: instVarName) do: [ :sel | coll add: (self createMethodNamed: sel realParent: class) ] ].
    ^ coll! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'BenjaminVanRyseghem 2/8/2012 17:14'!
browseAllSelect: aBlock 
	"Create and schedule a message browser on each method that, when used 
	as the block argument to aBlock gives a true result. For example,  
	SystemNavigation new browseAllSelect: [:method | method numLiterals >  
	10]."

	^ self
		browseMessageList: (self allMethodsSelect: aBlock)
		name: 'selected messages'! !

!SystemNavigation methodsFor: 'query' stamp: 'MarcusDenker 10/16/2013 18:26'!
allBehaviors
	^self environment allBehaviors! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'CamilloBruni 6/29/2012 11:37'!
chooseInstVarAlphabeticallyFrom: aClass thenDo: aBlock
	| allVars index |
	"Put up a menu of all the instance variables in the receiver, presented in alphabetical order, and when the user chooses one, evaluate aBlock with the chosen variable as its parameter."

	allVars := aClass allInstVarNames sort.
	allVars isEmpty ifTrue: [^ self inform: 'There are no instance variables'].

	index := (UIManager default chooseFrom: allVars lines: #() title: 'Instance variables in ', aClass name).
	index = 0 ifTrue: [^ aClass].
	aBlock value: (allVars at: index)! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'MarcusDenker 10/12/2013 10:54'!
browseAllStoresInto: instVarName from: aClass
    "Create and schedule a Message Set browser for all the receiver's methods 
    or any methods of a subclass/superclass that refer to the instance variable name."

    "self new browseAllStoresInto: 'youpi' from: BalloonEdgeData class."

    ^ self browseMessageList: (self allStoresInto: instVarName of: aClass)
                name: 'Stores into ' , instVarName 
                autoSelect: instVarName
! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'LeoGassman 11/7/2013 15:07'!
browseSendersOf: aSelector name: labelString autoSelect: autoSelectString
	
	^ self
		browseMessageList: (self allCallsOn: aSelector)
		name: labelString
		autoSelect: autoSelectString
		refreshingBlockSelector: #setRefreshingBlockForSendersOf: 		! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'FernandoOlivero 9/11/2013 13:33'!
browseUndeclaredReferences
	"
	SystemNavigation new browseUndeclaredReferences
	"
	
	Undeclared removeUnreferencedKeys.
	Undeclared associations do: [:binding |
		self
			browseMessageList: (self allReferencesTo: binding )
			name: 'References to Undeclared: ', binding key printString ]! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'VincentBlondeau 3/6/2015 16:39'!
browseAllUsersOfTrait: aTrait
	"Create and openenvironment  a browser on each class or trait that imports aTrait"

	^Smalltalk tools browser fullOnEnvironment: (RBBrowserEnvironment new forClasses: aTrait traitUsers)
	! !

!SystemNavigation methodsFor: 'query' stamp: ''!
allObjectsDo: aBlock 
	"Evaluate the argument, aBlock, for each object in the system 
	excluding SmallIntegers."
	| object endMarker |
	object := self someObject.
	endMarker := Object new.
	[endMarker == object]
		whileFalse: [aBlock value: object.
			object := object nextObject]! !

!SystemNavigation methodsFor: 'query' stamp: 'MarcusDenker 10/7/2013 14:15'!
allMethodsSelect: aBlock 
	"Answer a SortedCollection of each method that, when used as the block  
	argument to aBlock, gives a true result."
	| aCollection |
	aCollection := OrderedCollection new.
	self allBehaviorsDo: [:class | class
						selectorsAndMethodsDo: [:sel :m | (aBlock value: m)
								ifTrue: [aCollection
										add: (self createMethodNamed: sel realParent: class)]]].
	^ aCollection! !

!SystemNavigation methodsFor: 'query' stamp: 'ClementBera 10/25/2013 13:16'!
obsoleteMethodReferences
	"SystemNavigation new obsoleteMethodReferences"

	"Open a browser on all referenced behaviors that are obsolete"

	| obsClasses references |
	references := Array new writeStream.
	obsClasses := self obsoleteBehaviors.
	'Scanning for methods referencing obsolete classes' 
		displayProgressFrom: 0 to: obsClasses size
		during: 
			[ :bar | 
			obsClasses keysAndValuesDo: 
					[ :index :each | | obsRefs | 
					bar current: index.
					obsRefs := each pointersToExcept: obsClasses.
					obsRefs do: 
							[ :ref | 
							"Figure out if it may be a global"
							(ref isVariableBinding and: [ref key isString	"or Symbol"]) 
								ifTrue: 
									[(ref pointersTo) do: 
											[:meth | 
											meth isCompiledMethod
												ifTrue: [meth methodReference ifNotNil: [:mref | references nextPut: mref]]]]]]].
	^ references contents! !

!SystemNavigation methodsFor: 'query' stamp: 'GuillermoPolito 3/4/2015 17:09'!
createMethodNamed: aSelector realParent: class

	"This method has some problems."
	"1 - It should use the object that comes from the browsed environment"
	"2 - It does not create a method but a representation of it so be careful"
	^ (RGMethodDefinition realClass: class selector: aSelector) package:  (class>>aSelector) package asRingDefinition; yourself .! !

!SystemNavigation methodsFor: 'accessing' stamp: 'LucFabresse 10/11/2010 19:09'!
environment
	^environment ! !

!SystemNavigation methodsFor: 'query' stamp: 'StephaneDucasse 11/9/2010 14:48'!
allClassesUsingSharedPool: aString  
	"Answer an Array of all classes that uses the shared pool named aString."

	| aCollection |
	aCollection := ReadWriteStream on: Array new.
	self allClassesDo: [:class | (class includesSharedPoolNamed: aString) ifTrue: [aCollection nextPut: class]].
	^ aCollection contents! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'BenjaminVanRyseghem 2/8/2012 17:17'!
browseMessageList: messageList name: label 
	"Create and schedule a MessageSet browser on messageList."

	^ self   
		browseMessageList: messageList 
		name: label 
		autoSelect: nil! !

!SystemNavigation methodsFor: 'packages' stamp: 'EstebanLorenzano 11/29/2013 16:09'!
removeAllButPackages: packagesList
  "Remove all classes and methods that do not belong to some of listed packages. Skip #unload. Do not use this method if you can use Monticello!! This method is used by some low-level shrinking process. Do not use it. This is quite hackish"

  | keep remove oldRemove extensionCategories |
  keep := Set new.      
  packagesList do: [:pkg | keep addAll: (self allClassesInPackageNamed: pkg)].
  oldRemove := Set new.
  [ 
    remove := Smalltalk globals allClassesAndTraits reject: [:c | keep includes: c].
    remove := remove collect: [:c | c name].
    (remove asSortedCollection: [:a :b | a  <= b ]) do: [:className |
      | class |
      class := (Smalltalk globals classOrTraitNamed: className).
      class allSubclasses ifEmpty: [
        SystemAnnouncer uniqueInstance unsubscribe: class.
        class isTrait ifFalse: [ 
          (class class includesSelector: #unload) ifTrue: [ class removeSelector: #unload ] ].
        class removeFromSystem. 
        ] ].

    
    oldRemove ifNotEmpty: [
      oldRemove = remove ifTrue: [          
         self error: 'Some classes still have subclasses: ', (remove collect: [:c | c -> (Smalltalk classOrTraitNamed: c) allSubclasses]) asString ] ].
    oldRemove := remove.
    remove notEmpty] whileTrue.

  keep do: [: class | 
    extensionCategories := (class organization ownCategories select: [:category | 
      category first = $*]) asOrderedCollection.
    extensionCategories removeAllSuchThat: [:category |
      packagesList anySatisfy: [:package |
        ((category asLowercase allButFirst = package asLowercase) or: [package asLowercase, '-*' match: category asLowercase allButFirst])]].
    extensionCategories do: [:category | 
      | protocol |
      protocol := class organization  protocolOrganizer protocolNamed: category.
      (protocol methods intersection: class localSelectors) do: [:sel | class removeSelector: sel ].
      "class removeProtocol: category" ]. 
    class isTrait ifFalse: [
      extensionCategories := (class class organization ownCategories select: [:category | 
        category first = $*]) asOrderedCollection.
      extensionCategories removeAllSuchThat: [:category |
        packagesList anySatisfy: [:package |
          ((category asLowercase allButFirst = package asLowercase) or: [package asLowercase, '-*' match: category asLowercase allButFirst])]].
      extensionCategories do: [:category | 
        | protocol |
        protocol := class class organization  protocolOrganizer protocolNamed: category.
        (protocol methods intersection: class class localSelectors) do: [:sel | class class removeSelector: sel ].
        "class class removeProtocol: category" ]]].
      
! !

!SystemNavigation methodsFor: 'query' stamp: 'MarcusDenker 8/7/2014 16:54'!
allUnsentMessagesIn: selectorSet 
	"Answer the subset of selectorSet which are not sent anywhere in the 
	system. As allSentMessages does not recurse into nested Arrays, filter
	with #allCallsOn, which does"
	
	^ (selectorSet copyWithoutAll: self allSentMessages) select: [:each | (self allCallsOn: each) isEmpty]   ! !

!SystemNavigation methodsFor: 'query' stamp: 'GuillermoPolito 4/26/2012 11:21'!
allPrimitiveMethods
	"Answer an OrderedCollection of all the methods that are implemented by primitives."
	| aColl |
	aColl := OrderedCollection new: 200.
	self allBehaviorsDo: [:class | class
		selectorsAndMethodsDo: [:sel :method | 
			method isPrimitive
				ifTrue: [aColl addLast: class name , ' ' , sel , ' ' , method primitive printString]]].
	^ aColl! !

!SystemNavigation methodsFor: 'query' stamp: 'MarcusDenker 4/18/2011 10:07'!
allClassesDo: aBlock

	^ self environment allClassesDo: aBlock

	! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'BenjaminVanRyseghem 2/8/2012 17:13'!
browseAllCallsOnClass: aClass
	"Create and schedule a message browser on each method that refers to 
	aClass. For example, SystemNavigation new browseAllCallsOnClass: Object."

	^ self
		browseMessageList: ((aClass allCallsOnIn: self) asSortedCollection)
		name: 'Users of class ' , aClass theNonMetaClass name
		autoSelect: aClass theNonMetaClass name! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'onierstrasz 11/11/2013 12:38'!
browseClassVarRefs: aClass
	"Put up a menu offering all class variable names; if the user chooses one, open up a message-list browser on all methods 
	that refer to the selected class variable"
	| lines labelStream allVars index owningClasses |
	
	"This method should be split into two -- one part that can be tested, and a wrapper that does the UI stuff."
	lines := OrderedCollection new.
	allVars := OrderedCollection new.
	owningClasses := OrderedCollection new.
	labelStream := (String new: 200) writeStream. "Why the heck is a writeStream needed?"
	aClass withAllSuperclasses reverseDo:
		[:class | | vars |
		vars := class classVarNames.
		vars do:
			[:var |
			labelStream nextPutAll: var; cr.
			allVars add: var.
			owningClasses add: class].
		vars isEmpty ifFalse: [lines add: allVars size]].
	labelStream contents isEmpty ifTrue: [^self inform: 'No class variables found']. "handle nil superclass better"
	labelStream skip: -1 "cut last CR".
	index := (UIManager default chooseFrom: (labelStream contents substrings) lines: lines).
	index = 0 ifTrue: [^ self].
	^ self browseAllReferencesTo:
		((owningClasses at: index) classPool associationAt: (allVars at: index))! !

!SystemNavigation methodsFor: 'packages' stamp: 'LucFabresse 10/11/2010 21:31'!
categoriesInPackageNamed: packageName
	^(self environment organization categoriesMatching: packageName), (self environment organization categoriesMatching: (packageName, '-*'))! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'NicolaiHess 10/13/2014 11:58'!
browseAllImplementorsOf: selector
	"Create and schedule a message browser on each method that implements 
	the message whose selector is the argument, selector. For example,  
	Smalltalk browseAllImplementorsOf: #at:put:."

	"Create and schedule a senders browser for aSelector."	

	^ self
		browseMessageList: (self allImplementorsOf: selector)
		name: 'Implementors of ' , selector
		autoSelect: nil
		refreshingBlockSelector: #setRefreshingBlockForImplementorsOf:! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'BenjaminVanRyseghem 2/8/2012 17:14'!
browseClassVariables: aClass

	^ aClass classPool inspectWithLabel: 'Class Variables in ' , aClass name! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'MarcusDenker 7/12/2012 18:04'!
browseObsoleteMethodReferences
	"Open a browser on all referenced behaviors that are obsolete"

	"SystemNavigation new browseObsoleteMethodReferences"

	| list |
	list := self obsoleteMethodReferences.
	^ self 
		browseMessageList: list
		name: 'Method referencing obsoletes'
		autoSelect: nil! !

!SystemNavigation methodsFor: '*NautilusCommon' stamp: 'BenjaminVanRyseghem 8/23/2011 22:31'!
browsedEnvironment: aBrowserEnvironment

	environment := aBrowserEnvironment asSystemNavigationEnvironment! !

!SystemNavigation methodsFor: '*Refactoring-Critics' stamp: 'YuriyTymchuk 9/5/2014 11:29'!
implementorsExistOf: aSelector 
	"Answers if there are methods which implement given selector"
	
	self allBehaviorsDo: [:class | 
		(class includesSelector: aSelector)
			ifTrue: [ ^ true ] ].
	^ false! !

!SystemNavigation methodsFor: 'query' stamp: 'StephaneDucasse 8/12/2011 14:58'!
allLocalCallsOn: aSymbol ofClass: aClass
	"Answer a SortedCollection of all the methods that call on aSymbol, anywhere in my class hierarchy."
	
	| aSet special byte cls |
	aSet := Set new.
	cls := aClass theNonMetaClass.
	special := Smalltalk hasSpecialSelector: aSymbol
					ifTrueSetByte: [:b | byte := b ].
	cls withAllSuperAndSubclassesDo: [ :class |
		(class whichSelectorsReferTo: aSymbol special: special byte: byte)
			do: [:sel |
				aSet add: (self createMethodNamed: sel realParent: class) ]].
		
	cls class withAllSuperAndSubclassesDo: [ :class |
		(class whichSelectorsReferTo: aSymbol special: special byte: byte)
			do: [:sel |
				aSet add: (self createMethodNamed: sel realParent: class) ]].
	^aSet! !

!SystemNavigation methodsFor: 'query' stamp: ''!
allUnreferencedClassVariablesOf: aClass
	"Answer a list of the names of all the receiver's unreferenced class  
	vars, including those defined in superclasses"
	| aList |
	aList := OrderedCollection new.
	aClass withAllSuperclasses
		reverseDo: [:aSuperClass | aSuperClass classVarNames
				do: [:var | (self allReferencesTo: (aSuperClass classPool associationAt: var)) isEmpty
						ifTrue: [aList add: var]]].
	^ aList! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'LeoGassman 11/7/2013 14:43'!
browseMessageList: messageList name: labelString autoSelect: autoSelectString
	^self browseMessageList: messageList name: labelString autoSelect: autoSelectString refreshingBlockSelector:nil	! !

!SystemNavigation methodsFor: 'query' stamp: 'GabrielOmarCotelli 12/4/2013 09:50'!
allReferencesToPool: aPool
	"Answer all the references to variable aPool"

	| list |
	list := OrderedCollection new.
	self
		allClassesDo: [ :cls | 
			cls
				selectorsAndMethodsDo: [ :sel :meth | 
					meth literals
						detect: [ :lit | (lit isVariableBinding and: [ lit key notNil ]) and: [ (aPool bindingOf: lit key) notNil ] ]
						ifFound: [ list add: (self createMethodNamed: sel realParent: cls) ] ] ].
	^ list! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'BenjaminVanRyseghem 6/20/2013 23:52'!
browseAllAccessesTo: instVarName from: aClass
	"Create and schedule a Message Set browser for all the receiver's methods 
	or any methods of a subclass/superclass that refer to the instance variable name."

	"self new browseAllAccessesTo: 'contents' from: Collection."

	| coll |
	coll := self allAccessesTo: instVarName from: aClass.
	^ self browseMessageList: coll name: 'Accesses to ' , instVarName autoSelect: instVarName! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'CamilloBruni 9/21/2012 14:18'!
browseAllCallsOn: aLiteral localTo: aClass
	"Create and schedule a message browser on each method in or below the given class that refers to
	aLiteral. For example, SystemNavigation new browseAllCallsOn: #open:label: localTo: CodeHolder."


	^ self browseAllSendersOf: aLiteral localTo: aClass! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'MarcusDenker 8/13/2014 15:12'!
browseMethodsWithString: aString matchCase: caseSensitive
	"Launch a browser on all methods that contain string literals with aString as a substring. Make the search case-sensitive or insensitive as dictated by the caseSensitive boolean parameter"

	^ self browseAllSelect:
			[:method |
				method  hasLiteralSuchThat: [:lit |
					lit isString and: [lit isSymbol not and: [  
					lit includesSubstring: aString caseSensitive: caseSensitive]]]]
		name:  'Methods with string ', aString printString, (caseSensitive ifTrue: [' (case-sensitive)'] ifFalse: [' (case-insensitive)'])
		autoSelect: aString.
! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'ClementBera 10/25/2013 13:15'!
browseObsoleteReferences  
	"self new browseObsoleteReferences"

	| references |
	references := OrderedCollection new.
	(LookupKey allSubInstances select:
		[:x | (x value isBehavior and: ['AnOb*' match: x value name]) or:
		['AnOb*' match: x value class name]]) 
		do: [:x | references addAll: (self allReferencesTo: x)].

	^ self  
		browseMessageList: references 
		name: 'References to Obsolete Classes'! !

!SystemNavigation methodsFor: 'packages' stamp: ''!
allClassesInPackageNamed: packageName
	"Returns the list of classes that belongs to a Monticello package."
	
	"It would be probably better to delegate that query to the package itself"
	| classes organization |
	organization := Smalltalk globals organization.
	classes := (organization classesInCategory: packageName) asSet.
	(organization categoriesMatching: packageName, '-*') do: [:category| 
		classes addAll: (organization classesInCategory: category)].
	^classes asArray! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'NicolaiHess 12/26/2013 21:27'!
methodHierarchyBrowserForClass: aClass selector: sel
	"Create and schedule a message set browser on all implementors of the 
	currently selected message selector. Do nothing if no message is selected."
	
	| list |
	aClass ifNil: [^ self].
	aClass isTrait ifTrue: [^ self].
	sel ifNil: [^ self].
	list := OrderedCollection new.

	aClass allSuperclasses reverseDo: [:cl |
		(cl includesSelector: sel) ifTrue: [
			list addLast: (self createMethodNamed: sel realParent: cl)]].
	aClass allSubclassesDo: [:cl | 
		(cl includesSelector: sel) ifTrue: [
			list addLast: ( self createMethodNamed: sel realParent: cl)]].

	list addLast: (self createMethodNamed: sel realParent: aClass).
	^ self browseMessageList: list name: 'Inheritance of ' , sel

! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'MarcusDenker 10/26/2012 13:02'!
browseClassesWithNamesContaining: aString caseSensitive: caseSensitive 
	"Launch a class-list list browser on all classes whose names containg aString as a substring."
	"SystemNavigation default browseClassesWithNamesContaining: 'Morph' caseSensitive: true "
	
	|  classes |
	classes :=  self environment allClasses select: [:class | (class name includesSubstring: aString caseSensitive: caseSensitive)].				
	^Smalltalk tools browser fullOnEnvironment: (RBBrowserEnvironment new forClasses: classes).
									! !

!SystemNavigation methodsFor: 'query' stamp: 'MarcusDenker 10/9/2013 08:51'!
allImplementedMessages
	"Answer a Collection of all the messages that are implemented in the system."
	| messages |
	messages := IdentitySet new.
	self allBehaviorsDo: [:each | messages addAll: each selectors].
	^ messages! !

!SystemNavigation methodsFor: 'query' stamp: 'BenjaminVanRyseghem 6/20/2013 23:52'!
allAccessesTo: instVarName from: aClass
	| coll |
	coll := OrderedCollection new.
	aClass
		withAllSubAndSuperclassesDo: [ :class | (class whichSelectorsAccess: instVarName) do: [ :sel | coll add: (self createMethodNamed: sel realParent: class) ] ].
	^ coll! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'MarcusDenker 6/14/2014 12:23'!
browseHierarchy: aClass selector: aSelector
	"Open a browser"

	aClass isNil
		ifTrue: [ ^ self ].
	^ Smalltalk tools browser new
		spawnHierarchyForClass: aClass selector: aSelector;
		yourself! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'ClementBera 7/26/2013 17:08'!
browseSharedPoolUsersOf: aClass

	| pattern list | 
	self okToChange ifFalse: [^ self ].
	list := self allClassesUsingSharedPool: aClass name.
	list isEmpty
		ifTrue: [ ^ self ]
		ifFalse: [pattern := UIManager default 
				enterOrRequestFrom: list 
				lines: #() 
				title: 'Class name or fragment?'].

	pattern ifNil: [^ self ].
	pattern browse! !

!SystemNavigation methodsFor: 'message sends' stamp: ''!
isUnsentMessage: selector

	| special byte |
	special := Smalltalk 
				hasSpecialSelector: selector
				ifTrueSetByte: [ :b | byte := b ].
	self allBehaviorsDo: 
		[ :behavior | 
			(behavior 
				thoroughHasSelectorReferringTo: selector
				special: special
				byte: byte) ifTrue: [^false] ].
	^true! !

!SystemNavigation methodsFor: '*Tool-Base' stamp: 'BenjaminVanRyseghem 2/8/2012 17:18'!
browseMethodsWithSourceString: aString matchCase: caseSensitive
	"SystemNavigation new browseMethodsWithSourceString: 'SourceString'"
	"Launch a browser on all methods whose source code, inluding string literals and comments, contains aString as a substring."
	| suffix |

	suffix := caseSensitive
				ifTrue: [' (case-sensitive)']
				ifFalse: [' (case-insensitive)'].
	^ self
		browseMessageList: (self allMethodsWithSourceString: aString matchCase: caseSensitive)
		name: 'Methods containing ' , aString printString , suffix
		autoSelect: aString! !

!SystemNavigation methodsFor: 'query' stamp: 'MarcusDenker 10/7/2013 14:15'!
allCallsOn: aSymbol from: aClass
	"Answer a SortedCollection of all the methods that call on aSymbol."

	| collection special byte |
	collection := OrderedCollection  new.
	special := Smalltalk hasSpecialSelector: aSymbol ifTrueSetByte: [:b | byte := b ].
	aClass withAllSubclassesDo: [ :class |
		(class whichSelectorsReferTo: aSymbol special: special byte: byte) do: [:sel |
				collection add: (self createMethodNamed: sel realParent: class)]].
	^collection! !

!SystemNavigation methodsFor: 'query' stamp: 'MarcusDenker 10/16/2013 18:26'!
allMethods
	^self allBehaviors flatCollect: [ :behavior | behavior methods]
! !

!SystemNavigation methodsFor: 'query' stamp: 'GabrielOmarCotelli 12/4/2013 09:51'!
allReferencesToPool: aPool from: aClass
	"Answer all the references to variables from aPool"

	| list |
	list := OrderedCollection new.
	aClass
		withAllSubclassesDo: [ :cls | 
			cls
				selectorsAndMethodsDo: [ :sel :meth | 
					meth literals
						detect: [ :lit | lit isVariableBinding and: [ (aPool bindingOf: lit key) notNil ] ]
						ifFound: [ list add: (self createMethodNamed: sel realParent: aClass) ] ] ].
	^ list! !

!SystemNavigation class methodsFor: 'accessing' stamp: 'StephaneDucasse 10/23/2010 15:40'!
default
	^ self new! !

!SystemNavigationOnNewlyCreatedEnvironmentTest methodsFor: 'setUp-tearDown' stamp: 'LucFabresse 10/24/2010 18:23'!
createSystemNavigationToTest
	
	| environment nav |
	environment := SystemDictionary withOrganizer: SystemOrganizer new.
	nav := SystemNavigation new.
	nav environment: environment.
	^nav! !

!SystemNavigationOnNewlyCreatedEnvironmentTest methodsFor: 'testing' stamp: 'MarcusDenker 4/18/2011 12:38'!
testAllReferencesToPool
	| result |
	
	result := self systemNavigationToTest allReferencesToPool: FooSharedPool.
	self assert: result isEmpty. "FooSharedPool is not in this environment"! !

!SystemNavigationOnNewlyCreatedEnvironmentTest methodsFor: 'testing' stamp: 'MarcusDenker 3/14/2015 08:39'!
testEnsureDefaultEnvironmentNotUsed
	
	| allClasses originalProtoObjectClass originalObjectClass anotherObjectClass |
	allClasses := self systemNavigationToTest allClasses.
	self assert: allClasses isEmpty.
	originalProtoObjectClass := Smalltalk globals at: #ProtoObject.		
	originalObjectClass := Smalltalk globals at: #Object.
	
	DangerousClassNotifier disableDuring: [
		anotherObjectClass := self classFactory newClassNamed: #Object subclassOf: originalProtoObjectClass instanceVariableNames: '' classVariableNames:  'DependentsFields'].
	
	self assert: ((self environmentToTest at: #Object) = anotherObjectClass).
	self assert: ((Smalltalk globals at: #Object) = originalObjectClass).
	! !

!SystemNavigationOnNewlyCreatedEnvironmentTest class methodsFor: 'building suites' stamp: 'LucFabresse 10/24/2010 22:06'!
shouldInheritSelectors

^true! !

!SystemNavigationTest commentStamp: 'LucFabresse 10/24/2010 20:26'!
I am an sunit test for SystemNavigation with the default value for its environment (Smalltalk globals).

!
!SystemNavigationTest methodsFor: 'accessing' stamp: 'LucFabresse 10/24/2010 20:58'!
classFactory
	^classFactory! !

!SystemNavigationTest methodsFor: 'testing' stamp: 'LucFabresse 11/9/2010 21:10'!
testIsUnsentMessage
	| class |
	class := self classFactory newClass.
	class compileSilently: 'messageNeverSentInTheSystemXXXXThisIsForTest ^self'.
	self assert: (self systemNavigationToTest isUnsentMessage: class selectors anyOne)! !

!SystemNavigationTest methodsFor: 'accessing' stamp: 'LucFabresse 10/24/2010 21:11'!
systemNavigationToTest
	^navigator
	! !

!SystemNavigationTest methodsFor: 'setUp-tearDown' stamp: 'EstebanLorenzano 8/3/2012 14:25'!
tearDown
	super tearDown.
	self classFactory cleanUp. 
	SystemAnnouncer announcer: oldSystemAnnouncer.
	! !

!SystemNavigationTest methodsFor: 'setUp-tearDown' stamp: 'LucFabresse 10/24/2010 18:21'!
createSystemNavigationToTest
	^SystemNavigation new! !

!SystemNavigationTest methodsFor: 'testing' stamp: 'StephaneDucasse 7/26/2011 15:28'!
testIsMessageSentInSystemAnswersMethodReference
	| classesSendingMessage sentMessageSelector anyOne |
	sentMessageSelector := 'MessageSentOnlyByTestClassesXXXShouldNotBeRealyDefined' asSymbol.
	5 timesRepeat: [self classFactory newClassInCategory: #One].
	5 timesRepeat: [self classFactory newClassInCategory: #Two].
	classesSendingMessage := (self classFactory createdClasses asArray first: 2), (self classFactory createdClasses asArray last: 3).
	classesSendingMessage do: [:class|	
		class compileSilently: 'meth self ', sentMessageSelector].
	anyOne :=(self systemNavigationToTest allSendersOf: sentMessageSelector) anyOne.

	self assert: (anyOne isKindOf: RGMethodDefinition) ! !

!SystemNavigationTest methodsFor: 'testing' stamp: 'LucFabresse 10/24/2010 21:12'!
testAllReferencesToPool
	| result |
	
	result := self systemNavigationToTest allReferencesToPool: FooSharedPool.
	self assert: result size = 1.! !

!SystemNavigationTest methodsFor: 'testing' stamp: 'LucFabresse 11/9/2010 21:10'!
testIsMessageSentInSystemWithTheSelectorInsideAnArray
	| classesSendingMessage sentMessageSelector |
	sentMessageSelector := 'MessageSentOnlyByTestClassesXXXShouldNotBeRealyDefined' asSymbol.
	5 timesRepeat: [self classFactory newClassInCategory: #One].
	5 timesRepeat: [self classFactory newClassInCategory: #Two].
	classesSendingMessage := (self classFactory createdClasses asArray first: 2), (self classFactory createdClasses asArray last: 3).
	classesSendingMessage do: [:class|	
		class compileSilently: 'meth ^#(a b ', sentMessageSelector, ' c)'].
	self assert: (self systemNavigationToTest allSendersOf: sentMessageSelector) size = 5! !

!SystemNavigationTest methodsFor: 'testing' stamp: 'LucFabresse 10/24/2010 21:11'!
testAllReferencesToPoolWhenNoRefences
	| result |
	
	result := self systemNavigationToTest allReferencesToPool: UnreferencedSharedPool.
	self assert: result size = 0.! !

!SystemNavigationTest methodsFor: 'utils' stamp: 'VeronicaUquillas 9/1/2011 09:30'!
createMethodNamed: selector realParent: class

	^ RGMethodDefinition realClass: class selector: selector! !

!SystemNavigationTest methodsFor: 'testing' stamp: 'LucFabresse 10/24/2010 21:33'!
testRetrievingCategoriesInAPackage
	| retrievedCategories |
	
	#(#CategoryForTest #'CategoryForTest-Core' #'CategoryForTest-Tests' #CategoryForTest #ForTestCategory #'ForTestCategory-Core') do: [ :catName | 
		self classFactory newClassInCategory: catName].
	
	retrievedCategories := self systemNavigationToTest categoriesInPackageNamed: 'CategoryForTest'.
	self
		assert: (retrievedCategories includesAllOf: #(#CategoryForTest #'CategoryForTest-Core' #'CategoryForTest-Tests' )).
	retrievedCategories := self systemNavigationToTest categoriesInPackageNamed: 'CategoryForTest-Core'.
	self
		assert: (retrievedCategories includesAllOf: #(#'CategoryForTest-Core')). 
	retrievedCategories := self systemNavigationToTest categoriesInPackageNamed: 'CategoryFor'.
	self assert: retrievedCategories isEmpty.! !

!SystemNavigationTest methodsFor: 'accessing' stamp: 'LucFabresse 10/24/2010 21:16'!
organizationToTest
	^self environmentToTest organization
	! !

!SystemNavigationTest methodsFor: 'setUp-tearDown' stamp: 'EstebanLorenzano 8/3/2012 14:25'!
setUp
	super setUp. 
	
	oldSystemAnnouncer := SystemAnnouncer uniqueInstance.
	SystemAnnouncer announcer: nil.
	
	navigator := self createSystemNavigationToTest.
	classFactory := self createClassFactory.! !

!SystemNavigationTest methodsFor: 'setUp-tearDown' stamp: 'LucFabresse 12/19/2010 12:42'!
createClassFactory
	^ ClassFactoryWithOrganization newWithOrganization: self organizationToTest! !

!SystemNavigationTest methodsFor: 'testing' stamp: 'LucFabresse 11/9/2010 21:09'!
testAllSendersOfASelector
	| senders selector class otherClass callers |
	selector := ('aMethod', 'WithSenders') asSymbol.
	
	class := self classFactory newClass.
	class compileSilently: selector asString, ' ^ self'.
	class compileSilently: 'anotherMethod ^self ', selector asString.
	otherClass := self classFactory newClass.
	otherClass compileSilently: 'yetAnotherMethod ^self ', selector asString.
	senders := self systemNavigationToTest allSendersOf: selector.
	self assert: senders size = 2.
	callers := senders collect: [ :methodRef | methodRef selector].
	self assert: (callers includesAllOf: #(#anotherMethod #yetAnotherMethod))
! !

!SystemNavigationTest methodsFor: 'accessing' stamp: 'LucFabresse 10/24/2010 21:15'!
environmentToTest
	^self systemNavigationToTest environment
	! !

!SystemNavigationTest methodsFor: 'testing' stamp: 'LucFabresse 11/9/2010 21:10'!
testIsMessageSentInSystemWithClassesActuallySendngTheMessage
	| classesSendingMessage sentMessageSelector|
	sentMessageSelector := 'MessageSentOnlyByTestClassesXXXShouldNotBeRealyDefined' asSymbol.
	5 timesRepeat: [self classFactory newClassInCategory: #One].
	5 timesRepeat: [self classFactory newClassInCategory: #Two].
	classesSendingMessage := (self classFactory createdClasses asArray first: 2), (self classFactory createdClasses asArray last: 3).
	classesSendingMessage do: [:class|	
		class compileSilently: 'meth self ', sentMessageSelector].
	self assert: (self systemNavigationToTest allSendersOf: sentMessageSelector) size = 5! !

!SystemNavigationTest methodsFor: 'testing' stamp: 'LucFabresse 10/24/2010 21:13'!
testAllSendersOfReturnsExistingMethods
	"Non-regression test for
	http://code.google.com/p/pharo/issues/detail?id=2593 "
	| senders |
	senders := self systemNavigationToTest allSendersOf: #methodsFor:.
	senders
		do: [:aReference | self
				assert: (aReference actualClass canUnderstand: aReference selector)]! !

!SystemNavigationTest methodsFor: 'testing' stamp: 'StephaneDucasse 11/9/2010 14:50'!
testAllClassesUsingSharedPool
	"self debug: #testAllClassesUsingSharedPool"

	| res |
	res := SystemNavigation new allClassesUsingSharedPool: 'ChronologyConstants'.
	self assert: ({Date. DateAndTime. Duration. Month. Time. TimeZone. Week} difference: res) isEmpty! !

!SystemNavigationTest class methodsFor: 'testing' stamp: 'JorgeRessia 3/16/2010 20:24'!
isUnitTest
	^false! !

!SystemOrganizer commentStamp: '<historical>'!
My instances provide an organization for the classes in the system, just as a ClassOrganizer organizes the messages within a class. The only difference is the methods for fileIn/Out.!
!SystemOrganizer methodsFor: 'queries' stamp: ''!
classesInCategory: category
	^ (self listAtCategoryNamed: category) collect: [ :className | self environment at: className ] ! !

!SystemOrganizer methodsFor: 'accessing' stamp: 'GuillermoPolito 8/2/2012 00:23'!
removeCategory: category
	| r |
	r := super removeCategory: category.
	
	"If the category we try to remove is the default one, due to cleansing, we don't have to announce it since it is not a valid category for a Class"
	category = Default ifFalse: [
		SystemAnnouncer uniqueInstance classCategoryRemoved: category.
	].

	^ r! !

!SystemOrganizer methodsFor: 'filein/out' stamp: 'SeanDeNigris 6/13/2013 10:25'!
fileOutCategory: category 
	"Store on the file named category (a string) concatenated with '.st' all the 
	classes associated with the category."
	
	| internalStream |
	internalStream := (String new: 1000) writeStream.
	self fileOutCategory: category on: internalStream.
	^ FileStream writeSourceCodeFrom: internalStream baseName: category isSt: true ! !

!SystemOrganizer methodsFor: 'queries' stamp: ''!
orderedTraitsIn: category
	"Answer an OrderedCollection containing references to the traits in the 
	category whose name is the argument, category (a string). The traits 
	are ordered so they can be filed in." 

	| behaviors traits |
	behaviors := (self listAtCategoryNamed: category asSymbol) collect: [ :title | self environment at: title ].
	traits := behaviors reject: [ :each | each isBehavior ].
	traits := traits
		asSortedCollection: [ :t1 :t2 | (t2 traitComposition allTraits includes: t1) or: [ (t1 traitComposition allTraits includes: t2) not ] ].
	^ traits asArray! !

!SystemOrganizer methodsFor: 'queries' stamp: ''!
commentInventory: categoryName
	"SystemOrganization commentInventory: 'Morphic*'"

	| classes commentedClasses |
	classes := OrderedCollection new.
	self categories
		withIndexCollect: [ :cat :idx | 
			(categoryName match: cat)
				ifTrue: [ classes addAll: (self listAtCategoryNumber: idx) ]
				ifFalse: [ nil ] ].
	commentedClasses := classes select: [ :catCls | (self environment at: catCls) hasComment ].
	^ 'There are ' , classes size asString , ' classes in ' , categoryName , ' of which ' , commentedClasses size asString
		, ' have comments and ' , (classes size - commentedClasses size) asString , ' do not yet have comments.'! !

!SystemOrganizer methodsFor: 'testing' stamp: 'MartinDias 2/5/2014 18:44'!
includesCategory: aString
	"Tests if a category is already included."
	
	^ self categories 
		ifNil: [ false ]
		ifNotNil: [ :categories | categories includes: aString ]! !

!SystemOrganizer methodsFor: 'queries' stamp: ''!
uncommentedClassesIn: categoryName
	"SystemOrganization uncommentedClassesIn: 'Morphic*'"

	| classes |
	classes := OrderedCollection new.
	self categories
		withIndexCollect: [ :cat :idx | 
			(categoryName match: cat)
				ifTrue: [ classes addAll: (self listAtCategoryNumber: idx) ]
				ifFalse: [ nil ] ].
	^ (classes collect: [ :clsName | self environment at: clsName ] thenSelect: [ :cls | cls hasComment not ]) asArray! !

!SystemOrganizer methodsFor: 'accessing' stamp: ''!
environment
	 ^ environment ifNil: [ environment := Smalltalk globals]! !

!SystemOrganizer methodsFor: 'remove' stamp: ''!
removeCategoriesMatching: matchString
	"Remove all matching categories with their classes"
	(self categoriesMatching: matchString) do:
		[:c | self removeSystemCategory: c]! !

!SystemOrganizer methodsFor: 'queries' stamp: ''!
removeMissingClasses
	"Remove any class names that are no longer in the Smalltalk dictionary. Used for cleaning up after garbage collecting user-generated classes."

	"SystemOrganization removeMissingClasses"
 
	elementArray copy
		do: [ :el | 
			(self environment includesKey: el)
				ifFalse: [ self removeElement: el ] ]! !

!SystemOrganizer methodsFor: 'filein/out' stamp: 'MarcusDenker 10/9/2013 17:06'!
fileOutCategory: category on: aFileStream initializing: aBool
	"Store on the file associated with aFileStream, all the traits and classes associated 
	with the category and any requested shared pools in the right order."

	| poolSet tempClass classes traits |
	traits := self orderedTraitsIn: category.
	classes := self superclassOrder: category.
	poolSet := Set new.
	classes do:  [:class | class sharedPools do: [:eachPool | poolSet add: eachPool]].
	poolSet notEmpty ifTrue: [
		tempClass := Class new.
		tempClass shouldFileOutPools ifTrue: [
			poolSet := poolSet select: [:aPool |
				tempClass shouldFileOutPool: (Smalltalk globals keyAtIdentityValue: aPool)].
			poolSet do: [:aPool | tempClass fileOutPool: aPool onFileStream: aFileStream]]].
	traits, classes
		do: [:each | 
			each
				fileOutOn: aFileStream
				moveSource: false
				toFile: 0
				initializing: false]
		separatedBy: [ aFileStream cr; nextPut: Character newPage; cr ].
	aBool ifTrue: [classes do: [:cls | cls fileOutInitializerOn: aFileStream]].! !

!SystemOrganizer methodsFor: 'initialization' stamp: 'LucFabresse 10/24/2010 19:57'!
initialize
	super initialize.
	categoryArray := Array new.
	categoryStops := Array new.
	elementArray := Array new! !

!SystemOrganizer methodsFor: 'filein/out' stamp: ''!
fileOutCategory: category on: aFileStream 
	"Store on the file associated with aFileStream, all the classes associated 
	with the category and any requested shared pools."
	^self fileOutCategory: category on: aFileStream initializing: true! !

!SystemOrganizer methodsFor: 'accessing' stamp: 'EstebanLorenzano 7/27/2012 16:30'!
renameCategory: oldCatString toBe: newCatString
	| r |
	r := super renameCategory: oldCatString toBe: newCatString.
	SystemAnnouncer uniqueInstance 
		classCategoryRenamedFrom: oldCatString to: newCatString.
	^ r! !

!SystemOrganizer methodsFor: 'queries' stamp: 'GuillermoPolito 6/26/2012 15:58'!
superclassOrder: category
	"Answer an OrderedCollection containing references to the classes in the 
	category whose name is the argument, category (a string). The classes 
	are ordered with superclasses first so they can be filed in."

	| behaviors classes |
	behaviors := (self listAtCategoryNamed: category asSymbol) collect: [ :title | self environment at: title ].
	classes := behaviors select: [ :each | each isBehavior ].
	^ Class superclassOrder: classes ! !

!SystemOrganizer methodsFor: 'remove' stamp: ''!
removeSystemCategory: category
	"remove all the classes and traits associated with the category"

	 (self orderedTraitsIn: category) , (self superclassOrder: category)
		reverseDo: [:each | each removeFromSystem].

	self removeCategory: category.
! !

!SystemOrganizer methodsFor: 'accessing' stamp: ''!
environment: aSystemDictionary
	 environment := aSystemDictionary.
! !

!SystemOrganizer methodsFor: 'filein/out' stamp: 'CamilloBruni 2/24/2013 23:42'!
fileOut  
	"SystemOrganization fileOut"

	| internalStream |
	internalStream := (String new: 30000) writeStream.
	internalStream nextPutAll: 'SystemOrganization changeFromCategorySpecs: #('; cr;
		print: SystemOrganization;  "ends with a cr"
		nextPutAll: ')!!'; cr.

	FileStream 
		writeSourceCodeFrom: internalStream 
		baseName: 'SystemOrganization.st' asFileReference nextVersion basenameWithoutExtension 
		isSt: true
! !

!SystemOrganizer methodsFor: 'queries' stamp: 'LucFabresse 10/24/2010 17:42'!
categoriesMatching: matchString
	"Return all matching categories"
	
	self categories ifNil: [ ^#() ].
	^ self categories select: [:c | matchString match: c]! !

!SystemOrganizer methodsFor: 'accessing' stamp: 'MartinDias 2/5/2014 18:38'!
addCategory: newCategory
	(self includesCategory: newCategory) ifTrue: [ ^ self ].

	super addCategory: newCategory.

	SystemAnnouncer uniqueInstance classCategoryAdded: newCategory.! !

!SystemOrganizer class methodsFor: 'cleanup' stamp: ''!
cleanUp: agressive
	"Remove empty categories when cleaning aggressively"

	agressive ifTrue: [SystemOrganization removeEmptyCategories].
! !

!SystemOrganizer class methodsFor: 'instance creation' stamp: 'SeanDeNigris 12/2/2011 08:57'!
default
	"look in the environment that the receiver organizes for the associated organization" 
	
	^ self environment organization.! !

!SystemOrganizerTest methodsFor: 'tests' stamp: 'SeanDeNigris 12/2/2011 09:31'!
testDefault
	
	self assert: (SystemOrganizer default == self class environment organization).! !

!SystemOrganizerTest methodsFor: 'tests' stamp: 'StephaneDucasse 10/6/2010 20:00'!
testThatExistingPackagenamesDoesNotContainIllegalCharacters
	| illegalCharacters | 
	
	illegalCharacters := #(  $\ $/ $: $* $? $" $< $> $|  ).
	
	self class environment organization categories do: [ :aPackageName |
		self deny: (aPackageName includesAnyOf: illegalCharacters)
	]! !

!SystemOrganizerTest methodsFor: 'tests' stamp: 'StephaneDucasse 10/3/2010 14:53'!
testDefaultEnvironment
	"self debug: #testDefaultEnvironment"
	
	"When no environment is specified, point to the default one"
	
	self assert: (SystemOrganizer new  environment == Smalltalk globals)! !

!SystemProgressItemMorph commentStamp: '<historical>'!
A SystemProgressItemMorph is 'bar' in a SystemProgressMorph. 
!
!SystemProgressItemMorph methodsFor: 'API' stamp: 'SeanDeNigris 5/14/2012 19:49'!
decrement

	bar decrement.! !

!SystemProgressItemMorph methodsFor: 'private' stamp: 'SeanDeNigris 5/23/2012 01:08'!
close

	SystemProgressMorph uniqueInstance close: self.! !

!SystemProgressItemMorph methodsFor: 'API' stamp: 'SeanDeNigris 6/20/2012 23:24'!
current: aNumber

	bar value: aNumber.
	self changed.! !

!SystemProgressItemMorph methodsFor: 'private' stamp: 'SeanDeNigris 5/22/2012 22:57'!
initializeLabel: aString start: startNumber end: endNumber
	
	lock := Semaphore forMutualExclusion.
	hasResult := false.
	lastRefresh := 0.
	
	self
		color: Color transparent;
		layoutPolicy: TableLayout new;
		listDirection: #topToBottom;
		cellPositioning: #center;
		cellInset: 5;
		listCentering: #center;
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap.
		
	labelMorph := StringMorph contents: aString font: StandardFonts windowTitleFont.
	self addMorphBack: labelMorph.

	bar := ProgressBarMorph from: startNumber to: endNumber.
	self addMorphBack: bar.! !

!SystemProgressItemMorph methodsFor: 'private' stamp: 'SeanDeNigris 5/23/2012 00:22'!
forceRefreshOnNextChange

	lastRefresh := 0.! !

!SystemProgressItemMorph methodsFor: 'private' stamp: 'StephaneDucasse 5/20/2012 19:39'!
max: aNumber
 
	endValue := aNumber.! !

!SystemProgressItemMorph methodsFor: 'private' stamp: 'StephaneDucasse 5/20/2012 19:39'!
startAt: aNumber
 
	startValue := aNumber.! !

!SystemProgressItemMorph methodsFor: 'private' stamp: 'SeanDeNigris 5/14/2012 22:47'!
result

	^ result.! !

!SystemProgressItemMorph methodsFor: 'API' stamp: 'SeanDeNigris 5/23/2012 00:28'!
changed

	| msRefreshRate isTimeForRefresh |
	msRefreshRate := 25.
	isTimeForRefresh := Time millisecondClockValue - lastRefresh >= msRefreshRate.
	super changed.
	(self isInWorld and: [ isTimeForRefresh ]) ifTrue: [ self refresh ].! !

!SystemProgressItemMorph methodsFor: 'API' stamp: 'SeanDeNigris 5/14/2012 19:49'!
increment

	bar increment.! !

!SystemProgressItemMorph methodsFor: 'private' stamp: 'Sd 11/30/2012 19:58'!
refresh

	lastRefresh := Time millisecondClockValue.
	self currentWorld displayWorld.! !

!SystemProgressItemMorph methodsFor: 'private' stamp: 'SeanDeNigris 5/14/2012 15:23'!
labelMorph

	^ labelMorph.! !

!SystemProgressItemMorph methodsFor: 'API' stamp: 'SeanDeNigris 5/22/2012 20:18'!
label
	
	^ self labelMorph contents.! !

!SystemProgressItemMorph methodsFor: 'private' stamp: 'SeanDeNigris 5/23/2012 00:40'!
do: aBlock

	self changed. "We may be in the UI thread, so this will give us a change to dsiplay ourselves before the block starts"
	^ [ aBlock value: self ] ensure: [ self close ].! !

!SystemProgressItemMorph methodsFor: 'private' stamp: 'SeanDeNigris 5/14/2012 15:09'!
start: aNumber

	startValue := aNumber.! !

!SystemProgressItemMorph methodsFor: 'API' stamp: 'SeanDeNigris 5/24/2012 18:18'!
label: aString

	self label isEmpty ifTrue: [ self forceRefreshOnNextChange ].
	self labelMorph contents: aString.
	self changed.! !

!SystemProgressItemMorph methodsFor: 'API' stamp: 'SeanDeNigris 5/14/2012 19:48'!
current

	^ bar value.! !

!SystemProgressItemMorph methodsFor: 'API' stamp: 'SeanDeNigris 5/23/2012 00:25'!
beComplete

	self close.! !

!SystemProgressItemMorph methodsFor: 'private' stamp: 'SeanDeNigris 5/14/2012 22:49'!
result: anObject

	lock critical: [ 
		hasResult := true.
		result := anObject ].! !

!SystemProgressItemMorph class methodsFor: 'instance creation' stamp: 'SeanDeNigris 5/14/2012 15:26'!
labeled: aString from: startValue to: endValue

	^ self new initializeLabel: aString start: startValue end: endValue.! !

!SystemProgressMorph commentStamp: '<historical>'!
I display a set of progress indicator in a list.
Special care is taken to update the view while the rest of the UI process is blocked.

Reset.
SystemProgressMorph reset.

Examples.
self show: 'Doing...' from: 500 to: 600 during: [ :bar |
	500 to: 600 do: [ :x | 
		bar current: x.
		(Delay forMilliseconds: 20) wait 
		"Just to slow it down so we can see what's going on" ] ].

self show: 'Doing...' from: 0 to: 50 during: [ :bar |
	0 to: 50 do: [ :x | 
		bar increment.
		bar label: x asString.
		(Delay forMilliseconds: 20) wait "Just to slow it down so we can see what's going on" ] ].!
!SystemProgressMorph methodsFor: 't-rotating' stamp: ''!
forwardDirection: newDirection
	"Set the receiver's forward direction (in eToy terms)"
	self setProperty: #forwardDirection toValue: newDirection.! !

!SystemProgressMorph methodsFor: 'private' stamp: 'CamilloBruni 9/1/2012 20:08'!
addItemShowing: aJob
	
	lock critical: [ | item items |
		item := JobProgressMorph job: aJob.
		items := self bars size.
		items < 10 ifTrue: [ 
			self addMorphBack: item.
			self resize ].
		^ item ].! !

!SystemProgressMorph methodsFor: 'private' stamp: 'Sd 11/30/2012 20:09'!
addItemShowing: aString from: startNumber to: endNumber
	
	lock critical: [ | item items |
		item := SystemProgressItemMorph labeled: aString from: startNumber to: endNumber.
		items := self bars size.
		items < 10 ifTrue: [ 
			self addMorphBack: item.
			self recenter ].
		^ item ].! !

!SystemProgressMorph methodsFor: 't-rotating' stamp: ''!
forwardDirection
	"Return the receiver's forward direction (in eToy terms)"
	^self valueOfProperty: #forwardDirection ifAbsent:[0.0]! !

!SystemProgressMorph methodsFor: 'private' stamp: 'SeanDeNigris 5/14/2012 18:53'!
bars
	
	^ self submorphs.! !

!SystemProgressMorph methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 2/19/2013 15:59'!
initialize

	super initialize.
	lock := Semaphore forMutualExclusion.
	lastRefresh := 0.
	self
		setDefaultParameters;
		setProperty: #morphicLayerNumber toValue: self morphicLayerNumber;
		layoutPolicy: TableLayout new;
		listDirection: #topToBottom;
		cellPositioning: #topCenter;
		cellInset: 5;
		listCentering: #center;
		hResizing: #rigid;
		vResizing: #shrinkWrap;
		layoutInset: 10@6;
		minWidth: 150! !

!SystemProgressMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/19/2013 15:59'!
lastRefresh

        ^ lastRefresh ifNil: [ lastRefresh := 0 ]! !

!SystemProgressMorph methodsFor: 'private' stamp: 'SeanDeNigris 8/30/2012 09:11'!
maxBarWidth

	^ self bars inject: 0 into: [ :max :next | next minExtent x max: max ].! !

!SystemProgressMorph methodsFor: 'initialization' stamp: 'SeanDeNigris 5/14/2012 16:08'!
setDefaultParameters

	self theme setSystemProgressMorphDefaultParameters: self! !

!SystemProgressMorph methodsFor: 't-rotating' stamp: ''!
prepareForRotating
	"If I require a flex shell to rotate,
	then wrap it in one and return it.
	Polygons, eg, may override to do nothing."

	^ self addFlexShell! !

!SystemProgressMorph methodsFor: 't-rotating' stamp: ''!
setDirectionFrom: aPoint
	| delta degrees |
	delta := (self transformFromWorld globalPointToLocal: aPoint) - self referencePosition.
	degrees := delta degrees + 90.0.
	self forwardDirection: (degrees \\ 360) rounded.
! !

!SystemProgressMorph methodsFor: 't-rotating' stamp: ''!
rotationDegrees: degrees	
	"redefined in all morphs which are using myself"! !

!SystemProgressMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 3/1/2013 17:41'!
show: aJob

	| progressMorph |

	self flag: 'When we go from Exceptions to announcements, delete this and use show:from:to:during:'.
	
	progressMorph := self addItemShowing: aJob.
	
	self openInWorld.
	self updateWidth.
	
	^ progressMorph.! !

!SystemProgressMorph methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 2/19/2013 16:01'!
resize

	| newWidth |
	newWidth := self maxBarWidth + 50 max: self width.
	self width: newWidth.! !

!SystemProgressMorph methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 3/1/2013 17:46'!
updateProgressValue

! !

!SystemProgressMorph methodsFor: 'updating' stamp: 'SeanDeNigris 5/22/2012 12:36'!
updateColor
	"Callback from theme"
	
	self theme preferGradientFill ifFalse: [^ self].
	self fillStyle: (self theme progressFillStyleFor: self)! !

!SystemProgressMorph methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 3/1/2013 17:51'!
update: aSymbol
	
	| msRefreshRate isTimeForRefresh |
	
	aSymbol == #width
		ifTrue: [ self updateWidth ].
		
	
	msRefreshRate := 60 "roughly 16 times per second".
	isTimeForRefresh := Time millisecondClockValue - self lastRefresh >= msRefreshRate.
	(self isInWorld and: [ isTimeForRefresh ]) ifFalse: [ ^ self ].
	
	self refresh! !

!SystemProgressMorph methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 3/1/2013 17:46'!
updateWidth

	self resize! !

!SystemProgressMorph methodsFor: 'private' stamp: 'SeanDeNigris 8/30/2012 09:10'!
close: aSystemProgressItemMorph

	self bars isEmpty ifTrue: [ ^ self ].
	
	lock critical: [
		aSystemProgressItemMorph delete.
		self bars size = 0 ifTrue: [ 
			self width: 0.
			self delete ] ].

	self refresh.! !

!SystemProgressMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 3/1/2013 17:35'!
show: aString from: startNumber to: endNumber

	| progressMorph |
	self flag: 'When we go from Exceptions to announcements, delete this and use show:from:to:during:'.

	self openInWorld.
	progressMorph := self addItemShowing: aString from: startNumber to: endNumber.

	self 
		refresh;
		reposition.
	
	^ progressMorph.! !

!SystemProgressMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 3/1/2013 17:40'!
show: aString from: startNumber to: endNumber during: aBlock

	| progressMorph result |

	self openInWorld.
	progressMorph := self addItemShowing: aString from: startNumber to: endNumber.
		
	self 
		refresh;
		reposition.

	[ result := progressMorph do: aBlock ] ensure: [ self close: progressMorph ].
	^ result.! !

!SystemProgressMorph methodsFor: 'as yet unclassified' stamp: 'BenjaminVanRyseghem 3/1/2013 17:43'!
openInWorld

	super openInWorld.
	self width: 200.
	self resize.
	! !

!SystemProgressMorph methodsFor: 't-rotating' stamp: ''!
heading
	"Return the receiver's heading"
	^ self owner 
		ifNil: [self forwardDirection]
		ifNotNil: [self forwardDirection + self owner degreesOfFlex]! !

!SystemProgressMorph methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 2/19/2013 16:05'!
refresh
	"We may be blocking the UI thread, and thus have to draw the world ourselves when necessary"
	lastRefresh := Time millisecondClockValue.
	self currentWorld displayWorld.! !

!SystemProgressMorph methodsFor: 'updating' stamp: 'CamilloBruni 10/20/2012 20:13'!
recenter
	self reposition! !

!SystemProgressMorph methodsFor: 'initialization' stamp: 'Sd 11/30/2012 19:30'!
morphicLayerNumber
	"progress morphs are behind menus and balloons, but in front of most other stuff"
	^self valueOfProperty: #morphicLayerNumber ifAbsent: [ 12 ].
! !

!SystemProgressMorph methodsFor: 'submorphs-add/remove' stamp: 'SeanDeNigris 5/14/2012 18:50'!
dismissViaHalo

	self class reset.! !

!SystemProgressMorph methodsFor: 't-rotating' stamp: ''!
rotationDegrees
	"Default implementation."

	^ 0.0
! !

!SystemProgressMorph methodsFor: 'private' stamp: 'Sd 11/30/2012 22:04'!
reposition
	"Calculate the proper position"
	
	| xPos yPos margin |
	margin := 20.
	
	xPos := Display boundingBox width - self fullBounds width - (2*margin).
	xPos := xPos * self class horizontalPosition + margin.
	
	yPos := Display boundingBox height - self fullBounds height - (2*margin).
	yPos := yPos * self class verticalPosition + margin.
	
	self align: self fullBounds topLeft with: Display boundingBox topLeft + (xPos @ yPos).
	
	self refresh.! !

!SystemProgressMorph class methodsFor: 'examples' stamp: 'SeanDeNigris 6/20/2012 23:27'!
exampleLabelOnly
	"SystemProgressMorph exampleLabelOnly"
	| words |
	words := #(zero one two three four five six seven eight nine ten) reversed.
	UIManager default informUserDuring: [:bar |
		words do: [:each|
			bar label: 'Countdown: ', each.
			(Delay forSeconds: 1) wait]].! !

!SystemProgressMorph class methodsFor: 'job subscription' stamp: 'BenjaminVanRyseghem 2/19/2013 15:17'!
updateJob: aJobChange
	| bars |
	bars := self uniqueInstance bars.
	bars isEmpty 
		ifFalse: [ 
			bars last 
				label: aJobChange title;
				progress: aJobChange progress ]! !

!SystemProgressMorph class methodsFor: 'job subscription' stamp: 'CamilloBruni 8/30/2012 19:47'!
startJob: aJobStart

	self show: aJobStart job! !

!SystemProgressMorph class methodsFor: 'accessing' stamp: 'CamilloBruni 10/20/2012 20:23'!
verticalPosition: fraction
	"0.0: top ... 1.0: bottom"
	verticalPosition := fraction.
	self uniqueInstance reposition.! !

!SystemProgressMorph class methodsFor: 'enabling/disabling' stamp: 'StephanEggermont 9/3/2013 16:01'!
disable

	Job jobAnnouncer unsubscribe: self.! !

!SystemProgressMorph class methodsFor: 'instance creation' stamp: 'SeanDeNigris 5/22/2012 20:39'!
show: aString from: startNumber to: endNumber
	self flag: 'When we go from Exceptions to announcements, delete this and use show:from:to:during:'.

	^ self uniqueInstance show: aString from: startNumber to: endNumber.! !

!SystemProgressMorph class methodsFor: 'instance creation' stamp: 'SeanDeNigris 5/22/2012 20:39'!
show: aString from: startNumber to: endNumber during: aBlock
	self flag: 'When we go from Exceptions to announcements, this will be the primary entry point'.

	^ self uniqueInstance show: aString from: startNumber to: endNumber during: aBlock.! !

!SystemProgressMorph class methodsFor: 'instance creation' stamp: 'CamilloBruni 10/20/2012 20:11'!
reset
	"SystemProgressMorph reset"
	UniqueInstance ifNotNil: [ UniqueInstance delete ].
	UniqueInstance := nil.! !

!SystemProgressMorph class methodsFor: 'instance creation' stamp: 'SeanDeNigris 8/29/2012 14:03'!
uniqueInstance

	^ UniqueInstance ifNil: [ UniqueInstance := self new ].! !

!SystemProgressMorph class methodsFor: 'accessing' stamp: 'CamilloBruni 10/20/2012 20:24'!
horizontalPosition: aFloat
	"0.0: left ... 1.0: right"
	horizontalPosition := aFloat.
	self uniqueInstance reposition.! !

!SystemProgressMorph class methodsFor: 'cleanup' stamp: 'MarcusDenker 10/12/2013 11:32'!
cleanUp
	self reset! !

!SystemProgressMorph class methodsFor: 'initialization' stamp: 'SeanDeNigris 8/30/2012 11:27'!
initialize
	"SystemProgressMorph initialize"

	self reset.! !

!SystemProgressMorph class methodsFor: 'examples' stamp: 'SeanDeNigris 6/21/2012 08:47'!
example
	"SystemProgressMorph example"
	'Progress' 
		displayProgressFrom: 0 to: 1000
		during: [:bar | 0 to: 1000 do: [:i | bar current: i. (Delay forMilliseconds: 2) wait]]
! !

!SystemProgressMorph class methodsFor: 'enabling/disabling' stamp: 'BernardoContreras 10/3/2014 12:28'!
enable

	Job jobAnnouncer when: JobStart send: #startJob: to: self.
	Job jobAnnouncer when: JobEnd send: #endJob: to: self.
	Job jobAnnouncer when: JobChange send: #updateJob: to: self.
! !

!SystemProgressMorph class methodsFor: 'job subscription' stamp: 'StephaneDucasse 12/30/2012 12:57'!
endJob: aJobEnd 
	| bars |
	self flag: #toFix. "camillo I need help"
	bars := self uniqueInstance bars.
	bars isEmpty
		ifFalse: [ self uniqueInstance close:  bars last ] ! !

!SystemProgressMorph class methodsFor: 'settings' stamp: 'StephaneDucasse 11/11/2014 18:32'!
settingOn: aBuilder
	<systemsettings>
	(aBuilder group: #progress)
		label: 'Progress';
		parent: #morphic;
		with: [
			(aBuilder pickOne: #horizontalPosition)
				target: self;
				getSelector: #horizontalPosition;
				setSelector: #horizontalPosition:;
				label: 'Horizontal progress indicator position';
				domainValues: {'left'->0. 'middle'->0.5. 'right'->1}.
							
			(aBuilder pickOne: #verticalPosition)
				target: self;
				getSelector: #verticalPosition;
				setSelector: #verticalPosition:;
				label: 'Vertical progress indicator position';
				domainValues: {'bottom'->1. 'middle'->0.5. 'top'->0}]! !

!SystemProgressMorph class methodsFor: 'accessing' stamp: 'CamilloBruni 10/20/2012 22:15'!
horizontalPosition
	^ horizontalPosition ifNil: [ horizontalPosition := 0 ]! !

!SystemProgressMorph class methodsFor: 'accessing' stamp: 'CamilloBruni 10/20/2012 22:15'!
verticalPosition
	^ verticalPosition ifNil: [ verticalPosition := 0 ]! !

!SystemProgressMorph class methodsFor: 'examples' stamp: 'SeanDeNigris 6/21/2012 08:48'!
exampleChangeLabel
	"SystemProgressMorph exampleChangeLabel"
	| classes |
	classes := Smalltalk globals allClasses copyFrom: 1 to: 100.
	'InitialLabel' 
		displayProgressFrom: 0 to: classes size
		during: [:bar | 1 to: classes size do: [:i |
				bar current: i.
				bar label: i printString, '/', classes size printString, ' ', (classes at: i) printString.
				(Delay forMilliseconds: 100) wait]]
! !

!SystemProgressMorph class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/30/2012 19:33'!
show: aJob

	^ self uniqueInstance show: aJob.! !

!SystemReference commentStamp: 'tbn 4/30/2010 15:35'!
This class defines the full reference help for the system.
(contents for the full API Help).

Just run "HelpBrowser openOn: SystemReference".



!
!SystemReference class methodsFor: 'help topic creation' stamp: 'tbn 3/8/2010 17:23'!
hierarchyWithMethodsFor: aClass
	 
	|root topic |
	root := HelpTopic named: 'System reference for ', aClass name.
	topic := (ClassAPIHelpBuilder new)
					rootToBuildFrom: aClass;
					addSubclasses: true;
					addMethods: true;
					subclassesAsSeparateTopic: true;
					build;
					topicToBuild.
	root addSubtopic: topic.
	^root				
	 
		 ! !

!SystemReference class methodsFor: 'help topic creation' stamp: 'tbn 3/8/2010 17:04'!
asHelpTopic 
	"HelpBrowser openOn: SystemReference"
	
	^self hierarchyFor: ProtoObject 
	 
		 ! !

!SystemReference class methodsFor: 'help topic creation' stamp: 'tbn 3/8/2010 17:21'!
hierarchyFor: aClass
	 
	|root topic |
	root := HelpTopic named: 'System reference for ', aClass name.
	topic := (ClassAPIHelpBuilder new)
					rootToBuildFrom: aClass;
					addSubclasses: true;
					addMethods: false;
					subclassesAsSeparateTopic: false;
					build;
					topicToBuild.
	root addSubtopic: topic.
	^root				
	 
		 ! !

!SystemReference class methodsFor: 'help topic creation' stamp: 'tbn 3/8/2010 17:01'!
all
	"HelpBrowser openOn: self all "
	
	^(ClassAPIHelpBuilder new)
		rootToBuildFrom: ProtoObject;
		addSubclasses: true;
		addMethods: true;
		subclassesAsSeparateTopic: false;
		build;
		topicToBuild 
	 
		 ! !

!SystemReference class methodsFor: 'help topic creation' stamp: 'tbn 3/11/2010 23:41'!
forClass: aClass
	|root topic |
	root := HelpTopic named: 'System reference for ', aClass name.
	topic := ClassAPIHelpBuilder buildHelpTopicFrom: aClass.
	root addSubtopic: topic.
	^root! !

!SystemReporter commentStamp: 'laza 1/18/2011 12:04'!
SystemReporter offers a window where information about the system is gathered. This can be easily copied to the clipboard and be attached to a bug report for better identification of the context the bug occured in.

To extend the SystemReporter:
	- add a method
		reportXYZ: aStream
	  to the reporting category
	- insert a line
		add: #XYZ method: #reportXYZ
	  to the initialize method
!
!SystemReporter methodsFor: 'accessing-categories' stamp: 'laza 1/18/2011 11:19'!
categories
	^ categories ifNil: [categories := IdentityDictionary new]! !

!SystemReporter methodsFor: 'accessing-categories' stamp: 'BenjaminVanRyseghem 9/30/2011 10:43'!
categorySelected: anInteger

	self changed: #categorySelected.! !

!SystemReporter methodsFor: 'display' stamp: 'IgorStasenko 12/20/2012 14:12'!
categoriesFrame
	^ LayoutFrame new rightFraction: 0.25
		! !

!SystemReporter methodsFor: 'display' stamp: 'BenjaminVanRyseghem 9/30/2011 10:41'!
addAll: aWindow

	aWindow
		addMorph: self buildInformationList
		fullFrame: self categoriesFrame.
		
	aWindow
		addMorph: self buildInformationText
		fullFrame: self reportFrame.! !

!SystemReporter methodsFor: 'reporting' stamp: 'laza 1/28/2011 12:08'!
reportWorkingCopies: aStream
	| list |
	self header: 'Monticello Working Copies' on: aStream.
	list := MCWorkingCopy allManagers asSortedCollection: [:a :b | a name <= b name]  .
	list do: [:each | aStream nextPutAll: each description; cr]! !

!SystemReporter methodsFor: 'accessing-report' stamp: 'laza 1/18/2011 11:50'!
copyReportToClipboard
	Clipboard clipboardText: self reportText.
	UIManager default inform: 'Copied Report to Clipboard'! !

!SystemReporter methodsFor: 'accessing-categories' stamp: 'laza 1/18/2011 11:40'!
selectAllCategories
	categoriesSelected addAll: categoryList.
	self changed: #categorySelected.
	self updateReport! !

!SystemReporter methodsFor: 'reporting' stamp: 'laza 1/28/2011 09:51'!
reportImageParameters: aStream
	self header: 'Image Commandline Parameters' on: aStream.
	self enumerate: [:idx | Smalltalk image argumentAt: idx] on: aStream.! !

!SystemReporter methodsFor: 'reporting' stamp: 'MarcusDenker 8/1/2014 13:14'!
reportVM: aStream
	self header: 'Virtual Machine' on: aStream.
	aStream
		nextPutAll: Smalltalk vm vmFileName;
		cr;
		nextPutAll: Smalltalk vm version;
		cr.
	Smalltalk vm buildDate
		ifNotNil: [ :string | 
			aStream
				nextPutAll: string;
				cr ].
	[ 
	Smalltalk vm platformSourceVersion
		ifNotNil: [ :v | 
			aStream
				nextPutAll: 'platform sources revision ';
				nextPutAll: v;
				cr ] ]
		on: Warning
		do: [ 
			"unsupported primitive"
			 ].
	[ 
	Smalltalk vm interpreterSourceVersion
		ifNotNil: [ :v | 
			aStream
				nextPutAll: 'VMMaker versionString ';
				nextPutAll: v;
				cr ] ]
		on: Warning
		do: [ 
			"unsupported primitive"
			 ].
	[ 
	Smalltalk vm interpreterClass
		ifNotNil: [ :string | 
			aStream
				nextPutAll: string;
				cr ].
	Smalltalk vm cogitClass
		ifNotNil: [ :string | 
			aStream
				nextPutAll: string;
				cr ] ]
		on: Error
		do: [ 
			"unsupported primitives"
			 ]! !

!SystemReporter methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 9/30/2011 10:57'!
updateReport
	report := Text streamContents: [:stream | 
						self categoryList do: [:each |
							(categoriesSelected includes: each) ifTrue: [
								self perform: ((categories at: each), ':') asSymbol with: stream.
								stream cr]]].
			
	self changed: #reportText! !

!SystemReporter methodsFor: 'accessing-categories' stamp: 'laza 1/17/2011 12:22'!
categoryAt: anIndex
	^ categoriesSelected includes: (self categoryList at: anIndex ifAbsent: [ ^ false ]).! !

!SystemReporter methodsFor: 'reporting' stamp: 'BenjaminVanRyseghem 9/30/2011 11:21'!
reportVMStats: aStream
	self header: 'Virtual Machine Statistics' on: aStream.
	aStream
		nextPutAll: Smalltalk vm statisticsReport! !

!SystemReporter methodsFor: 'reporting' stamp: 'MarcusDenker 7/10/2012 10:39'!
reportWin32HardwareDetails: aStream
	self header: 'Hardware Details' on: aStream.
	aStream nextPutAll: (Smalltalk vm getSystemAttribute: 10001)! !

!SystemReporter methodsFor: 'initialization' stamp: 'MarcusDenker 2/14/2013 09:34'!
initialize
	self
		add: #Image method: #reportImage;
		add: #'Image Parameters' method: #reportImageParameters;
		add: #'Image Sources' method: #reportSources;
		add: #'MC Repositories' method: #reportRepositories;
		add: #'MC Working Copies' method: #reportWorkingCopies;
		add: #'VM General' method: #reportVM;
		add: #'VM Options' method: #reportVMOptions;
		add: #'VM Modules' method: #reportModules;
		add: #'VM Parameters' method: #reportVMParameters;
		add: #'VM Stats' method: #reportVMStats.
	Smalltalk os platformName = 'Win32' ifTrue: [
		self
			add: #'VM Configuration' method: #reportWin32VMConfig.
		].
	self
		add: #'OS General' method: #reportOS.
	Smalltalk os platformName = 'Win32' ifTrue: [
		self
			add: #'OS Details' method: #reportWin32OSDetails;
			add: #'Hardware Details' method: #reportWin32HardwareDetails;
			add: #'GFX Hardware Details' method: #reportWin32GFXDetails.
		].
	Smalltalk os version = 'linux' ifTrue: [
		self
			add: #'OS Details' method: #reportLinuxOSDetails
	].
	self add: #'OS Environment' method: #reportOSEnvironment.
	categoriesSelected := Set with: #Image with: #'VM General'.
	self updateReport
! !

!SystemReporter methodsFor: 'accessing-report' stamp: 'BenjaminVanRyseghem 9/30/2011 10:43'!
reportText

	^ (report isNil or: [categoriesSelected isEmpty])
		ifTrue: ['-- Choose any category on the left --']
		ifFalse: [report]! !

!SystemReporter methodsFor: 'private' stamp: 'laza 2/21/2011 23:57'!
writeContentsSafelyFromFile: osPath on: aStream
	aStream nextPutAll:
		([
			(FileStream readOnlyFileNamed: osPath) upToEnd
		 ] on: Error do: [:ex| ex return: ex printString])! !

!SystemReporter methodsFor: 'reporting' stamp: 'MarcusDenker 7/10/2012 10:39'!
reportWin32OSDetails: aStream
	self header: 'Operating System Details' on: aStream.
	aStream nextPutAll: (Smalltalk vm getSystemAttribute: 10002)! !

!SystemReporter methodsFor: 'accessing-categories' stamp: 'laza 1/17/2011 12:37'!
categoryAt: anInteger put: aBoolean
	categoriesSelected := categoriesSelected
		perform: (aBoolean ifTrue: [ #copyWith: ] ifFalse: [ #copyWithout: ])
		with: (self categoryList at: anInteger ifAbsent: [ ^ self ]).
	self updateReport! !

!SystemReporter methodsFor: 'reporting' stamp: 'CamilloBruni 5/13/2012 19:27'!
reportImage: aStream
	self header: 'Image' on: aStream.
	aStream 
		nextPutAll: Smalltalk image imagePath; cr;
		nextPutAll: SystemVersion current version; cr;
		nextPutAll: Smalltalk image lastUpdateString; cr;
		nextPutAll: ChangeSet current name; cr
! !

!SystemReporter methodsFor: 'accessing-categories' stamp: 'laza 1/18/2011 11:16'!
categoryList
	^ categoryList ifNil: [categoryList := OrderedCollection new]! !

!SystemReporter methodsFor: 'display' stamp: 'IgorStasenko 12/20/2012 14:11'!
reportFrame
	^ LayoutFrame new leftFraction: 0.25

! !

!SystemReporter methodsFor: 'reporting' stamp: 'MarcusDenker 9/12/2013 11:13'!
reportOS: aStream
	self header: 'Operating System/Hardware' on: aStream.
	aStream
		nextPutAll: Smalltalk os platformName; space;
		nextPutAll: Smalltalk os version; space;
		nextPutAll: Smalltalk os subtype; cr
! !

!SystemReporter methodsFor: 'private' stamp: 'laza 1/28/2011 09:57'!
enumerate: aBlock on: aStream
	self enumerate: aBlock startAt: 0 on: aStream! !

!SystemReporter methodsFor: 'printing-report' stamp: 'laza 1/18/2011 08:58'!
header: aString on: aStream
	aStream withAttribute: TextEmphasis bold do: [	
		aStream nextPutAll: aString; cr.
		aString size timesRepeat: [aStream nextPut: $-].
		aStream cr]! !

!SystemReporter methodsFor: 'accessing-report' stamp: 'StephaneDucasse 10/27/2014 09:34'!
reportMenu: aMenu
	^ aMenu
		addTitle: 'Report' ;
		add: 'Copy to Clipboard' selector: #copyReportToClipboard;
		yourself! !

!SystemReporter methodsFor: 'accessing-ui' stamp: 'BenjaminVanRyseghem 9/30/2011 10:40'!
initialExtent
	^ 640 @ 480! !

!SystemReporter methodsFor: 'items creation' stamp: 'BenjaminVanRyseghem 9/30/2011 10:32'!
buildInformationList

	^ PluggableListMorph
		on: self
		list: #categoryList
		primarySelection: #categorySelected
		changePrimarySelection: #categorySelected:
		listSelection: #categoryAt:
		changeListSelection: #categoryAt:put:
		menu: nil
		keystroke: nil! !

!SystemReporter methodsFor: 'reporting' stamp: 'laza 1/18/2011 11:55'!
reportSources: aStream
	self header: 'Image Sources' on: aStream.
	aStream nextPutAll: SourceFiles class printString; cr.
	SourceFiles do: [:each |
		each ifNotNil: [aStream nextPutAll: each printString; cr]]! !

!SystemReporter methodsFor: 'reporting' stamp: 'BenjaminVanRyseghem 9/30/2011 11:01'!
reportVMParameters: aStream
	| vmParameters |
	self header: 'Virtual Machine Parameters' on: aStream.
	vmParameters := Smalltalk vm getParameters.
	#(
		1	'end of old-space (0-based, read-only)'
		2	'end of young-space (read-only)'
		3	'end of memory (read-only)'
		4	'allocationCount (read-only)'
		5	'allocations between GCs (read-write)'
		6	'survivor count tenuring threshold (read-write)'
		7	'full GCs since startup (read-only)'
		8	'total milliseconds in full GCs since startup (read-only)'
		9	'incremental GCs since startup (read-only)'
		10	'total milliseconds in incremental GCs since startup (read-only)'
		11	'tenures of surving objects since startup (read-only)'
		12	'specific to the translating VM'
		13  'specific to the translating VM'
		14  'specific to the translating VM'
		15  'specific to the translating VM'
		16  'specific to the translating VM'
		17  'specific to the translating VM'
		18  'specific to the translating VM'
		19  'specific to the translating VM'
		20  'specific to the translating VM'
		21	'root table size (read-only)'
		22	'root table overflows since startup (read-only)'
		23	'bytes of extra memory to reserve for VM buffers, plugins, etc.'
		24	'memory threshold above which shrinking object memory (rw)'
		25	'memory headroom when growing object memory (rw)'
		26  'interruptChecksEveryNms - force an ioProcessEvents every N milliseconds, in case the image  is not calling getNextEvent often (rw)'
		27	'number of times mark loop iterated for current IGC/FGC (read-only) includes ALL marking'
		28	'number of times sweep loop iterated  for current IGC/FGC (read-only)'
		29	'number of times make forward loop iterated for current IGC/FGC (read-only)'
		30	'number of times compact move loop iterated for current IGC/FGC (read-only)'
		31	'number of grow memory requests (read-only)'
		32	'number of shrink memory requests (read-only)'
		33	'number of root table entries used for current IGC/FGC (read-only)'
		34	'number of allocations done before current IGC/FGC (read-only)'
		35	'number of survivor objects after current IGC/FGC (read-only)'
		36  'millisecond clock when current IGC/FGC completed (read-only)'
		37  'number of marked objects for Roots of the world, not including Root Table entries for current IGC/FGC (read-only)'
		38  'milliseconds taken by current IGC  (read-only)'
		39  'Number of finalization signals for Weak Objects pending when current IGC/FGC completed (read-only)'
		40  'VM word size - 4 or 8 (read-only)'
	) pairsDo: [:idx :desc |
		aStream
			nextPut: $#;
			nextPutAll: idx printString;
			tab;
			nextPutAll: (vmParameters at: idx) printString;
			tab;
			nextPutAll: desc;
			cr]! !

!SystemReporter methodsFor: 'items creation' stamp: 'BenjaminVanRyseghem 9/30/2011 10:34'!
buildInformationText

	^ PluggableTextMorph
		on: self
		text: #reportText
		accept: nil
		readSelection: nil
		menu: nil! !

!SystemReporter methodsFor: 'reporting' stamp: 'cami 7/22/2013 18:37'!
reportOSEnvironment: aStream
	| env |
	self header: 'Operating System Environment' on: aStream.
	env := [Smalltalk os environment] on: Error do: [^self].
	env keys asSortedCollection do: [:name |
		aStream nextPutAll: name; nextPut: $=; nextPutAll: (env at: name); cr]
	! !

!SystemReporter methodsFor: 'accessing-categories' stamp: 'StephaneDucasse 10/27/2014 09:34'!
categoryMenu: aMenu
	^ aMenu
		addTitle: 'Categories';
		add: 'Select all' selector: #selectAllCategories;
		add: 'Select none' selector: #selectNoCategories;
		addLine;
		add: 'Refresh' selector: #refresh;
		yourself! !

!SystemReporter methodsFor: 'reporting' stamp: 'laza 2/21/2011 23:57'!
reportLinuxOSDetails: aStream
	self header: 'Operating System Details' on: aStream.
	#(
		'/etc/issue'
		'/etc/lsb-release'
		'/proc/version'
	) do: [:path|
		self writeContentsSafelyFromFile: path on: aStream]! !

!SystemReporter methodsFor: 'accessing-categories' stamp: 'MarcusDenker 9/24/2013 14:11'!
refresh
	self updateReport! !

!SystemReporter methodsFor: 'accessing-ui' stamp: 'lr 10/8/2005 18:39'!
extent
	^ 640 @ 480! !

!SystemReporter methodsFor: 'reporting' stamp: 'MarcusDenker 7/10/2012 10:39'!
reportWin32GFXDetails: aStream
	self header: 'Graphics Hardware Details' on: aStream.
	aStream nextPutAll: (Smalltalk vm getSystemAttribute: 10003)! !

!SystemReporter methodsFor: 'reporting' stamp: 'laza 1/28/2011 09:58'!
reportVMOptions: aStream
	self header: 'Virtual Machine Commandline Options' on: aStream.
	self enumerate: [:idx | Smalltalk vm optionAt: idx] startAt: 1 on: aStream! !

!SystemReporter methodsFor: 'private' stamp: 'MarcusDenker 8/1/2014 13:14'!
enumerate: aBlock startAt: first on: aStream
	"Utilitymethod to enumerate Options or Parameters from first to 1000"

	| idx value |
	idx := first.
	[ 
	value := aBlock value: idx.
	value isNil or: [ idx > 1000 ] ]
		whileFalse: [ 
			aStream
				nextPut: $#;
				nextPutAll: idx printString;
				tab;
				nextPutAll: value;
				cr.
			idx := idx + 1 ].
	idx = first
		ifTrue: [ 
			aStream
				nextPutAll: 'none';
				cr ]! !

!SystemReporter methodsFor: 'accessing-ui' stamp: 'laza 1/17/2011 11:47'!
label
	^ 'System Reporter' ! !

!SystemReporter methodsFor: 'reporting' stamp: 'MarcusDenker 5/3/2013 11:40'!
reportModules: aStream
	self header: 'Loaded VM Modules' on: aStream.
	Smalltalk vm listLoadedModules asSortedCollection do: [:each | aStream nextPutAll: each; cr].
	aStream cr.
	self header: 'VM Built-in Modules' on: aStream.
	Smalltalk vm listBuiltinModules asSortedCollection do: [:each | aStream nextPutAll: each; cr].

! !

!SystemReporter methodsFor: 'accessing-categories' stamp: 'laza 1/18/2011 11:40'!
selectNoCategories
	categoriesSelected removeAll.
	self changed: #categorySelected.
	self updateReport! !

!SystemReporter methodsFor: 'display' stamp: 'IgorStasenko 12/20/2012 14:12'!
open
	"self new open"
	
	| window |
	window := StandardWindow new model: self.		
	self addAll: window.
	window openInWorld.
	window title: self label.
	^ window			! !

!SystemReporter methodsFor: 'accessing-categories' stamp: 'laza 1/18/2011 11:22'!
add: category method: aSymbol
	^self categoryList add: (self categories add: category -> aSymbol) key! !

!SystemReporter methodsFor: 'accessing-categories' stamp: 'lr 10/31/2005 15:11'!
categorySelected
	^ 0! !

!SystemReporter methodsFor: 'reporting' stamp: 'laza 2/15/2011 10:21'!
reportWin32VMConfig: aStream
	| exePath iniPath |
	self header: 'VM Configuration' on: aStream.
	exePath := Smalltalk vm vmFileName.
	iniPath := (exePath copyUpToLast: $.), '.ini'.
	aStream nextPutAll: iniPath; cr.
	self writeContentsSafelyFromFile: iniPath on: aStream.
! !

!SystemReporter methodsFor: 'reporting' stamp: 'laza 1/28/2011 12:14'!
reportRepositories: aStream
	self header: 'Monticello Repositories' on: aStream.
	MCRepositoryGroup default repositories do: [:each | aStream nextPutAll: each description; cr]! !

!SystemReporter class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 11/1/2011 07:44'!
open

	^ self new open! !

!SystemReporter class methodsFor: 'system menu' stamp: 'BenjaminVanRyseghem 9/30/2011 11:23'!
systemReporterMenuOn: aBuilder 
	"I build a menu"
	<worldMenu>
	(aBuilder item: #'System Reporter')
		parent: #System;
		action: [ self open ];
		help: 'If you have a bug, use this tool to provide information about your system'.! !

!SystemResolver commentStamp: 'cwp 11/18/2009 11:58'!
I resolve origins that are related to the currently running Smalltalk system, using primitives provided by the VM. !
!SystemResolver methodsFor: 'origins' stamp: 'MarcusDenker 7/13/2012 14:34'!
vmBinary
	^ self resolveString: (Smalltalk vm fullPath)! !

!SystemResolver methodsFor: 'origins' stamp: 'CamilloBruni 7/10/2012 21:50'!
changes
	^ self image withExtension: Smalltalk changesSuffix! !

!SystemResolver methodsFor: 'origins' stamp: 'lr 7/13/2010 13:33'!
vmDirectory
	^ self resolveString: self primVmDirectoryPath! !

!SystemResolver methodsFor: 'origins' stamp: 'cwp 10/26/2009 20:04'!
image
	^ self resolveString: self primImagePath! !

!SystemResolver methodsFor: 'origins' stamp: 'lr 7/13/2010 13:34'!
imageDirectory
	^ self image parent! !

!SystemResolver methodsFor: 'primitives' stamp: 'lr 7/13/2010 13:27'!
primVmDirectoryPath
	"Answer the full path name for the current virtual machine."

	<primitive: 142>
	self primitiveFailed! !

!SystemResolver methodsFor: 'primitives' stamp: 'cwp 10/26/2009 20:05'!
primImagePath
	"Answer the full path name for the current image."

	<primitive: 121>
	self primitiveFailed! !

!SystemResolver methodsFor: 'resolving' stamp: 'CamilloBruni 7/10/2012 21:34'!
supportedOrigins
	^ #(image imageDirectory changes vmBinary vmDirectory workingDirectory)! !

!SystemResolverTest commentStamp: 'TorstenBergmann 1/31/2014 11:36'!
SUnit tests for SystemResolver!
!SystemResolverTest methodsFor: 'running' stamp: 'EstebanLorenzano 4/2/2012 11:39'!
createResolver
	^ SystemResolver new! !

!SystemResolverTest methodsFor: 'testing' stamp: 'cwp 10/26/2009 13:21'!
testVmDirectory
	self assertOriginResolves: #vmDirectory! !

!SystemResolverTest methodsFor: 'testing' stamp: 'cwp 10/26/2009 13:21'!
testVmBinary
	self assertOriginResolves: #vmBinary! !

!SystemResolverTest methodsFor: 'testing' stamp: 'cwp 10/26/2009 13:21'!
testImage
	self assertOriginResolves: #image! !

!SystemResolverTest methodsFor: 'testing' stamp: 'lr 7/13/2010 13:32'!
testChanges
	self assertOriginResolves: #changes! !

!SystemResolverTest methodsFor: 'testing' stamp: 'lr 7/13/2010 13:35'!
testImageDirectory
	self assertOriginResolves: #imageDirectory! !

!SystemSettingLauncher commentStamp: 'TorstenBergmann 1/31/2014 10:34'!
Used to launch a setting!
!SystemSettingLauncher methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
inputWidget
	^ (self theme  
				newButtonIn: World 
				for: self
				getState: nil
				action: #launch
				arguments: {}
				getEnabled: nil
				getLabel: nil
				help: self description)
		 		label: ( self theme newRowIn: World for: {AlphaImageMorph new image: Smalltalk ui icons smallRedoIcon. 
				self theme buttonLabelForText: 'Launch' translated});
		 		yourself.! !

!SystemSettingLauncher methodsFor: 'accessing' stamp: 'AlainPlantec 12/5/2009 13:22'!
script
	^ script ifNil: [script := []]! !

!SystemSettingLauncher methodsFor: 'accessing' stamp: 'AlainPlantec 12/5/2009 14:19'!
script: aValuableOrSymbol
	script := aValuableOrSymbol! !

!SystemSettingLauncher methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
defaultIcon
	^ Smalltalk ui icons smallDoItIcon! !

!SystemSettingLauncher methodsFor: 'accessing' stamp: 'AlainPlantec 1/29/2010 10:51'!
launch
	self script 
			ifNotNil: [:s | s isSymbol 
				ifTrue: [s numArgs = 0 
					ifTrue: [self settingReceiver perform: s]
					ifFalse: [self settingReceiver perform: s with: self]]
				ifFalse: [s numArgs = 0 
					ifTrue: [s value]
					ifFalse: [s value: self]]]! !

!SystemSystemSettings commentStamp: 'TorstenBergmann 2/12/2014 23:29'!
Settings for the system itself!
!SystemSystemSettings class methodsFor: 'settings' stamp: 'StephaneDucasse 11/11/2014 18:50'!
systemSettingOn: aBuilder
	<systemsettings>
	(aBuilder group: #pharoSystem) 
		label: 'System';
		description: 'General system settings' ;
		with: [
			(aBuilder setting: #serverMode)
				label: 'Server mode';
				target: WorldState;
				description: 'If enabled, then each main rendering loop will always wait a complete delay of 50ms' .
			(aBuilder setting: #shouldDownloadSourcesFile)
				label: 'Download sources file';
				target: SmalltalkImage;
				description: 'If true, when no sources file can be found, the file will be downloaded.'.
			(aBuilder setting: #useLocale)
				label: 'Use locale';
				target: Locale;
				selector: #activated;
				description: 'Use the system locale to set the system language at startup.']
! !

!SystemVersion commentStamp: '<historical>'!
I am responsible for maintaining what version of Pharo and the VM is running.  I also track all of the update items that have been included in the image.

I'm invoked at auto start to get the latest plugins, etc.

Some queries are
	SystemVersion current major
	SystemVersion current minor
	SystemVersion current suffix
	SystemVersion current	highestUpdate!
!SystemVersion methodsFor: 'accessing' stamp: ''!
highestUpdate: anInteger
	highestUpdate := anInteger! !

!SystemVersion methodsFor: 'printing' stamp: ''!
shortVersionString
	"Print a short version string.  Compatibile with senders that concatenate this with 
	#lastUpdateString or #highestUpdate. Essentially the old version format. Guard 
	against no state being set."
	
	self type ifNil: [^'No version set'].
	^String streamContents: [:str |
		str 
			nextPutAll: self type;
			nextPutAll: self major printString;
			nextPut: $.;
			nextPutAll: self minor printString;
			nextPutAll: self suffix]! !

!SystemVersion methodsFor: 'accessing' stamp: ''!
date: newDate
	date := newDate! !

!SystemVersion methodsFor: 'initialization' stamp: ''!
initialize
	super initialize.
	date := Date today.
	updates := Set new.
! !

!SystemVersion methodsFor: 'printing' stamp: 'MarcusDenker 10/9/2013 17:07'!
printOn: stream
	stream
		nextPutAll: self datedVersion;
		nextPutAll: ' update ';
		nextPutAll: self highestUpdate printString! !

!SystemVersion methodsFor: 'accessing' stamp: ''!
major: anObject
	"Set the value of major"

	major := anObject! !

!SystemVersion methodsFor: 'accessing' stamp: 'StephaneDucasse 12/8/2010 13:50'!
highestUpdate
	"Returns the highest number of available updates"

	| sortedUpdates |
	highestUpdate ifNil: [
		sortedUpdates := self updates asSortedCollection.
		highestUpdate := (sortedUpdates isEmpty
			ifTrue: [0]
			ifFalse: [sortedUpdates last])].
	^highestUpdate! !

!SystemVersion methodsFor: 'accessing' stamp: 'SeanDeNigris 8/12/2012 22:02'!
dottedMajorMinor
	
	^ self majorMinor: '.'.! !

!SystemVersion methodsFor: 'accessing' stamp: ''!
type
	"Answer the value of type"

	^ type! !

!SystemVersion methodsFor: 'accessing' stamp: ''!
updates
	^updates! !

!SystemVersion methodsFor: 'accessing' stamp: 'SeanDeNigris 8/12/2012 21:59'!
majorMinorVersion
	
	^ self type, self dottedMajorMinor.! !

!SystemVersion methodsFor: 'accessing' stamp: ''!
type: anObject
	"Set the value of type"

	type := anObject! !

!SystemVersion methodsFor: 'accessing' stamp: 'StephaneDucasse 12/8/2010 13:50'!
minor
	"Answer the minor number of a version. 2 in '1.2'"

	^ minor! !

!SystemVersion methodsFor: 'accessing' stamp: ''!
minor: anObject
	"Set the value of minor"

	minor := anObject! !

!SystemVersion methodsFor: 'accessing' stamp: ''!
includesUpdate: anUpdate
	^self updates includes: anUpdate! !

!SystemVersion methodsFor: 'printing' stamp: ''!
imageVersionString
	"Print the version compatibile with naming the image."
	
	^String streamContents: [:str |
		str nextPutAll: self type;
			nextPut: $-;
			nextPutAll: self major printString;
			nextPut: $.;
			nextPutAll: self minor printString;
			nextPut: $-;
			nextPutAll: self highestUpdate printString;
			nextPut: $-;
			nextPutAll: self suffix]! !

!SystemVersion methodsFor: 'accessing' stamp: 'MarcusDenker 4/14/2011 14:09'!
version
	"Answer the short version string. If the receiver needs upgrading, do it."
	
	^self shortVersionString! !

!SystemVersion methodsFor: 'accessing' stamp: ''!
unregisterUpdate: update
	self updates remove: update ifAbsent: []! !

!SystemVersion methodsFor: 'accessing' stamp: 'StephaneDucasse 12/8/2010 13:49'!
major
	"Answer the major number of a version. 1 in '1.2'"

	^ major! !

!SystemVersion methodsFor: 'accessing' stamp: ''!
registerUpdate: update
	self updates add: update.
	self resetHighestUpdate! !

!SystemVersion methodsFor: 'accessing-version strings' stamp: 'SeanDeNigris 8/12/2012 22:07'!
datedVersion
	" E.g. 'Pharo2.0a of ''18 April 2012''' "

	^ self version asString , ' of ' , self date printString.! !

!SystemVersion methodsFor: 'upgrading' stamp: ''!
upgrade

	| parts |
	version ifNil: [^self].
	parts := self class parseShortVersionString: version.
	self type: parts first.
	self major: parts second.
	self minor: parts third.
	self suffix: parts fourth.
	version := nil.! !

!SystemVersion methodsFor: 'accessing' stamp: 'StephaneDucasse 2/1/2011 07:15'!
majorMinor: aSeparatingString
	"Return the major/minor version number of the form XaSeparatingStringY, without any 'alpha' or 'beta' or other suffix. If the receiver needs upgrading, do it. Remove the guard in 1.3."
	"SystemVersion current majorMinor: '-'"
	"SystemVersion current majorMinor: ''"
	
	self upgrade.
	^String streamContents: [:str |
		str 
			nextPutAll: self major printString; 
			nextPutAll: aSeparatingString;
			nextPutAll: self minor printString]! !

!SystemVersion methodsFor: 'accessing' stamp: ''!
date
	^date! !

!SystemVersion methodsFor: 'accessing' stamp: 'StephaneDucasse 12/8/2010 13:50'!
suffix
	"Answer the suffix (alpha, beta, rc  of a version. beta in '1.2beta'"

	^ suffix! !

!SystemVersion methodsFor: 'accessing' stamp: ''!
resetHighestUpdate
	highestUpdate := nil! !

!SystemVersion methodsFor: 'accessing' stamp: ''!
suffix: anObject
	"Set the value of suffix"

	suffix := anObject! !

!SystemVersion class methodsFor: 'accessing' stamp: ''!
parseShortVersionString: aString 
	"Answer the parts of aString, expected in short format <type><major>.<minor><suffix>."

	| stream length type major minor suffix |

	stream := aString readStream.
	[stream peek isDigit] whileFalse: [stream next].
	length := stream position.
	stream reset.
	type := (stream next: length).
	major := (stream upTo: $.) asInteger.
	stream := stream upToEnd readStream.
	[stream peek notNil and: [stream peek isDigit]] whileTrue: [stream next].
	length := stream position.
	stream reset.
	minor := (stream next: length) asInteger.
	suffix := stream upToEnd.
	^{type. major. minor. suffix}! !

!SystemVersion class methodsFor: 'instance creation' stamp: ''!
fromShortVersionString: aString
	"Create a new SystemVersion from the given short version string. Useful for testing."

	| parts |
	parts := self parseShortVersionString: aString.
	^self new
		type: parts first;
		major: parts second;
		minor: parts third;
		suffix: parts fourth;
		yourself! !

!SystemVersion class methodsFor: 'instance creation' stamp: ''!
newVersion: versionName
	"Install a new SystemVersion as the current version. Only preserve the higest update recorded.
	This method is a candidate for being removed, I am not sure it ever makes sense to do this."
	
	| newVersion |
	newVersion := self fromShortVersionString: versionName.
	newVersion
		highestUpdate: self current highestUpdate.
	Current := newVersion
! !

!SystemVersion class methodsFor: 'accessing' stamp: ''!
current
	Current ifNil: [Current := SystemVersion new].
	^Current! !

!SystemVersion class methodsFor: 'accessing' stamp: ''!
parseVersionString: versionString 
	"Answer the version of this release as version, date, update."
	"SystemVersion parseVersionString: 'Squeak3.1alpha of 28 February 2001 [latest update: #3966]' "
	| version date update |
	
	[ | stream | stream := versionString readStream.
	version := stream upToAll: ' of '.
	date := Date readFrom: stream.
	stream upToAll: ' #'.
	update := Number readFrom: stream ] 
		on: Error
		do: [ ^ nil ].
	^ {  version. date. update  }! !

!SystemVersionTest commentStamp: 'tlk 11/14/2004 10:47'!
I am an sunit test for SystemVersion.  Originally created to test SqueakMapSystemVersionFix change set.
I have no test fixtures.!
!SystemVersionTest methodsFor: 'as yet unclassified' stamp: 'MikeRoberts 9/28/2010 22:47'!
testUpgrade
	
	| sv |
	sv := SystemVersion fromShortVersionString: 'Pharo1.1ALPHA'.
	self assert: sv version = 'Pharo1.1ALPHA'.
	sv upgrade.
	self assert: sv version = 'Pharo1.1ALPHA'
! !

!SystemVersionTest methodsFor: 'as yet unclassified' stamp: 'MikeRoberts 11/19/2009 21:48'!
testParseShortVersionString
	

	self assert: (SystemVersion parseShortVersionString: 'Squeak3.7alpha') = {'Squeak'. 3. 7. 'alpha'}.
	self assert: (SystemVersion parseShortVersionString: 'Pharo1.0ALPHA') = {'Pharo'. 1. 0. 'ALPHA'}.
	self assert: (SystemVersion parseShortVersionString: 'Pharo1.1') = {'Pharo'. 1. 1. ''}! !

!SystemVersionTest methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 2/1/2011 07:22'!
testMajorMinorWithSeparatingString
	"SystemVersionTest debug: #testMajorMinorWithSeparatingString"
	
	self assert: ((SystemVersion fromShortVersionString: 'Squeak3.7alpha') majorMinor: '-') = '3-7'.
	self assert: ((SystemVersion fromShortVersionString: 'Pharo1.0ALPHA') majorMinor: '')  = '10'.
	self assert: ((SystemVersion fromShortVersionString: 'Pharo1.1') majorMinor: '.') = '1.1'.! !

!SystemVersionTest methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 2/1/2011 07:17'!
testMajorMinorVersion
	"SystemVersionTest run: #testMajorMinorVersion"
	
	self assert: (SystemVersion fromShortVersionString: 'Squeak3.7alpha') majorMinorVersion = 'Squeak3.7'.
	self assert: (SystemVersion fromShortVersionString: 'Pharo1.0ALPHA') majorMinorVersion = 'Pharo1.0'.
	self assert: (SystemVersion fromShortVersionString: 'Pharo1.1') majorMinorVersion = 'Pharo1.1'.! !

!SystemVersionTest methodsFor: 'tests' stamp: 'SeanDeNigris 8/12/2012 22:16'!
testDottedMajorMinor
	"
	SystemVersionTest run: #testMajorMinor
	"
	self assert: (SystemVersion fromShortVersionString: 'Squeak3.7alpha') dottedMajorMinor = '3.7'.
	self assert: (SystemVersion fromShortVersionString: 'Pharo1.0ALPHA') dottedMajorMinor = '1.0'.
	self assert: (SystemVersion fromShortVersionString: 'Pharo1.1') dottedMajorMinor = '1.1'.! !

!SystemVersionTest methodsFor: 'as yet unclassified' stamp: 'MikeRoberts 9/28/2010 22:47'!
testUpgradeState
	
	| sv |
	sv := (SystemVersion fromShortVersionString: 'Pharo1.1ALPHA') upgrade.
	self assert: sv type = 'Pharo'.
	self assert: sv major = 1.
	self assert: sv minor = 1.
	self assert: sv suffix = 'ALPHA'.! !

!SystemWindow commentStamp: '<historical>'!
SystemWindow is the Morphic equivalent of StandardSystemView -- a labelled container for rectangular views, with iconic facilities for close, collapse/expand, and resizing.

The attribute onlyActiveOnTop, if set to true (and any call to activate will set this), determines that only the top member of a collection of such windows on the screen shall be active.  To be not active means that a mouse click in any region will only result in bringing the window to the top and then making it active.!
!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'MarcusDenker 10/10/2013 23:26'!
aboutText
	"Answer the text to use for the About dialog."

	^self model
		ifNil: ['This is a system window without a model' translated]
		ifNotNil: [self model class instanceSide organization classComment
					ifEmpty: ['The model of this window has no class comment']
					ifNotEmpty: [:comment | comment]]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'AlainPlantec 12/7/2009 09:11'!
taskbarButtonEntered: aButton event: evt in: aMorph
	"The mouse has entered out taskbar button.
	Show a thumbnail."

	aButton owner ifNotNil: [:buttonBar | |thumb|
		buttonBar showWindowPreview ifFalse: [^self].
		thumb := self valueOfProperty: #taskbarThumbnail.
		thumb
			ifNil: [thumb := self theme newTaskbarThumbnailIn: self for: self]
			ifNotNil: [^self].
		self setProperty: #taskbarThumbnail toValue: thumb.
		thumb bottomLeft: ((aButton left min: aButton owner right - thumb width)@ (aButton owner top - 4)).
		thumb openInWorld]! !

!SystemWindow methodsFor: 'open/close' stamp: 'GuillermoPolito 5/1/2012 20:02'!
openAsIsIn: aWorld
	"This msg and its callees result in the window being activeOnlyOnTop.
	Play the open sound if the preference is enabled."
	
	self playOpenSound.
	aWorld addMorph: self.
	self activate.
	aWorld startSteppingSubmorphsOf: self.
	
	self announceOpened.
	
	World announcer 
		announce: (WindowOpened new
						window: self;
						yourself).
! !

!SystemWindow methodsFor: 'testing' stamp: 'ar 12/2/2001 21:43'!
shouldDropOnMouseUp
	"Return true for consistency with fastdrag"
	^true! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 6/11/2007 15:13'!
labelString
	"Answer the actual label string."

	^label isNil
		ifTrue: [labelString]
		ifFalse: [label contents asString]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'MarcusDenker 12/11/2009 07:42'!
theme
	"Answer the ui theme that provides controls.
	Don't call super since that implementation may delegate here."

	(self valueOfProperty: #theme) ifNotNil: [:t | ^ t].
	^self class theme! !

!SystemWindow methodsFor: 'announcement' stamp: 'Alexandre.Bergel 8/8/2009 13:52'!
announce: anAnnouncement
	"announcer is lazy initialized. If announcer is not set, this means that there is no listener, no need to propagate the announcement therefore"
	announcer ifNil: [ ^ self ].
	
	anAnnouncement window: self.
	^ self announcer announce: anAnnouncement! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'EstebanLorenzano 5/15/2014 14:29'!
initialize
	"Initialize a system window. Add label, stripes, etc., if desired"
	
	super initialize.
	labelString ifNil: [labelString := 'Untitled Window'].
	isCollapsed := false.
	activeOnlyOnTop := true.
	paneMorphs := Array new.
	self layoutPolicy: ProportionalLayout new.
	self clipSubmorphs: true.
	self theme
		configureWindowBorderFor: self;
		configureWindowDropShadowFor: self.	
	self initializeLabelArea.

	self cellPositioning: #topLeft. "make the offsets easy to calculate!!"
	self addGripsIfWanted.
	
	self extent: 300 @ 200.
	mustNotClose := false.
	updatablePanes := Array new! !

!SystemWindow methodsFor: 'stepping' stamp: 'sw 10/19/1999 09:30'!
amendSteppingStatus
	"Circumstances having changed, find out whether stepping is wanted and assure that the new policy is carried out"

	self wantsSteps
		ifTrue:
			[self arrangeToStartStepping]
		ifFalse:
			[self stopStepping]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 5/7/2008 11:37'!
removeLabelArea
	"Remove the entire label area."

	self removeGrips.
	labelArea delete.
	label := nil.	
	(self isCollapsed not or: [self isTaskbarPresent]) ifTrue: [
		self addGripsIfWanted]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 7/30/2007 15:58'!
activeFillStyle
	"Return the active fillStyle for the receiver."
	
	^self theme windowActiveFillStyleFor: self! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'IgorStasenko 12/20/2012 14:46'!
addExpandBox
	"If I have a labelArea, add a close box to it"
	labelArea
		ifNil: [^ self].
	expandBox := self createExpandBox.
	self setExpandBoxBalloonText.
	expandBox layoutFrame: (LayoutFrame new leftFraction: 1; leftOffset: (self boxExtent x * 2 + 3) negated).
	labelArea addMorphBack: expandBox! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'AlainPlantec 12/16/2009 12:18'!
defaultBackgroundColor
	"Answer the color to be used as the base window color."
	^self theme windowColorFor: self! !

!SystemWindow methodsFor: 'open/close' stamp: 'ar 5/11/2001 23:46'!
openAsIs
	^self openAsIsIn: self currentWorld
! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'Alexandre.Bergel 8/8/2009 13:13'!
collapse
	self isCollapsed ifFalse:[self collapseOrExpand].
! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'GaryChambers 6/9/2011 13:27'!
activate
	"Activate the owner too."

	|mo mc|
	mo := self modalOwner.
	mc := self modalChild.
	mc isNil
		ifFalse: [mc owner notNil ifTrue: [
				mc activate.
				^mc modalChild isNil ifTrue: [mc indicateModalChild]]].
	(isCollapsed not 
		and: [ self paneMorphs size > 1 and: [self splitters isEmpty]])
			ifTrue: [self addPaneSplitters].
	TopWindow isNil ifFalse: [
		TopWindow rememberKeyboardFocus: ActiveHand keyboardFocus].
	super activate.
	self isEmbedded ifFalse: [
		self basicActivate].	
	self rememberedKeyboardFocus
		ifNil: [(self respondsTo: #navigateFocusForward)
				ifTrue: [self navigateFocusForward]]
		ifNotNil: [|m|
				m := self rememberedKeyboardFocus.
				m world
						ifNil: [self rememberKeyboardFocus: nil] "deleted"
						ifNotNil: [
							m wantsKeyboardFocus
								ifTrue: [m takeKeyboardFocus]
								ifFalse: [(self respondsTo: #navigateFocusForward)
											ifTrue: [self navigateFocusForward]]]].
	(mo notNil and: [mo isKindOf: SystemWindow])
		ifTrue: [mo bringBehind: self]! !

!SystemWindow methodsFor: 'top window' stamp: 'sw 5/20/2001 22:32'!
adjustBorderUponDeactivationWhenLabeless
	"Adjust the border upon deactivation when, labelless"

	| aWidth |
	(aWidth := self valueOfProperty: #borderWidthWhenInactive) ifNotNil:
		[self acquireBorderWidth: aWidth]! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'sw 5/30/2001 10:56'!
wantsExpandBox
	"Answer whether I'd like an expand box"

	^ true! !

!SystemWindow methodsFor: 'geometry' stamp: 'sw 9/28/1999 11:02'!
removeMenuBox
	menuBox ifNotNil:
		[menuBox delete.
		menuBox := nil].
! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/16/2007 11:02'!
maximize
	"Maximise the receiver. If collapsed the uncollapse first."

	self isMinimized ifTrue: [self collapseOrExpand].
	self isMaximized ifFalse: [self expandBoxHit]! !

!SystemWindow methodsFor: 'panes' stamp: 'md 2/24/2006 15:47'!
existingPaneColor
	"Answer the existing pane color for the window, obtaining it from the first paneMorph if any, and fall back on using the second stripe color if necessary."

	| aColor |
	aColor := self valueOfProperty: #paneColor.
	aColor ifNil: [self setProperty: #paneColor toValue: (aColor := self paneColor)].
	^aColor.! !

!SystemWindow methodsFor: 'menu actions' stamp: 'GabrielOmarCotelli 11/30/2013 16:57'!
makeSecondTopmost
	| aWorld |
	aWorld := self world.
	aWorld submorphs
		detect: [ :m | m isSystemWindow and: [ m ~~ self ] ]
		ifFound: [ :nextWindow | 
			nextWindow activate.
			aWorld addMorph: self behind: nextWindow ]! !

!SystemWindow methodsFor: 'events' stamp: 'jmv 2/19/2006 14:47'!
paneTransition: event
	"Mouse has entered or left a pane"! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/28/2009 13:51'!
navigateFocusForward
	"Change the keyboard focus to the next morph or the receiver
	in none are interested."

	self nextMorphWantingFocus
		ifNil: [self takeKeyboardFocus]
		ifNotNil: [super navigateFocusForward]
	! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 10/26/2007 21:13'!
setLabelWidgetAllowance
	"Set the extra space required, in general, apart from the label.
	Should make theme based (for centered titles), leave enough room
	for the moment."
	
	^labelWidgetAllowance :=  (self boxExtent x * 7) 
	"allow for three on one side and centering plus a bit"! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/11/2007 12:06'!
previousMorphInWindow
	"Answer the previous morph in the window. This will be the
	last submorph recursively of the first pane morph."

	^self hasSubmorphs
		ifTrue: [self lastSubmorphRecursive]! !

!SystemWindow methodsFor: 'panes' stamp: 'md 2/24/2006 15:46'!
replacePane: oldPane with: newPane
	"Make newPane exactly occupy the position and extent of oldPane"

	| aLayoutFrame hadDep |
	hadDep := model dependents includes: oldPane.
	oldPane owner replaceSubmorph: oldPane by: newPane.
	newPane
		position: oldPane position;
		extent: oldPane extent.
	aLayoutFrame := oldPane layoutFrame.
	paneMorphs := paneMorphs collect:
		[:each |
		each == oldPane ifTrue: [newPane] ifFalse: [each]].
	aLayoutFrame ifNotNil: [newPane layoutFrame: aLayoutFrame].
	newPane color: Color transparent.
	hadDep ifTrue: [model removeDependent: oldPane. model addDependent: newPane].

	self changed

! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'GaryChambers 6/9/2011 12:18'!
makeBordered
	"Add the border and border width offsets."

	|b|
	self borderWidth = 0 ifFalse: [^self].
	b  := self class borderWidth.
	self submorphsDo: [:m | | l |
		l := m layoutFrame.
		l ifNotNil: [
			l rightFraction = 1 ifTrue: [l rightOffset: l rightOffset - b].
			l leftFraction = 0 ifTrue: [l leftOffset: l leftOffset + b].
			l bottomFraction = 1 ifTrue: [l bottomOffset: l bottomOffset - b]]].
	self theme configureWindowBorderFor: self! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 2/15/2009 15:21'!
shadowOffsetRectangle
	"Answer a rectangle describing the offsets to the
	receiver's bounds for a drop shadow."

	^self isActive
		ifTrue: [self theme windowActiveDropShadowOffsetRectangleFor: self]
		ifFalse: [self theme windowInactiveDropShadowOffsetRectangleFor: self]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/23/2007 14:50'!
restoreAndActivate
	"Restore the window if minimised then activate."

	self isMinimized
		ifTrue: [self restore].
	self isActive
		ifFalse: [self activate]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 6/11/2007 15:06'!
taskbarThumbnailExtent
	"Answer the size of a taskbar thumbnail for the receiver."

	^self isMinimized
		ifTrue: [self fullFrame extent min: self defaultTaskbarThumbnailExtent]
		ifFalse: [super taskbarThumbnailExtent]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 6/1/2009 12:06'!
setFramesForLabelArea
	"Set the layout for the label area."
	
	self theme configureWindowLabelAreaFrameFor: self! !

!SystemWindow methodsFor: 'geometry' stamp: 'di 6/16/1998 07:56'!
labelRect
	^ self innerBounds withHeight: self labelHeight.
! !

!SystemWindow methodsFor: 'open/close' stamp: 'BenjaminVanRyseghem 7/31/2013 14:18'!
delete
	"Should activate window before asking model if okToChange
	since likely that a confirmation dialog will be requested.
	Don't if not owned by the world though."
	
	| thisWorld animateClose announcement |
	self mustNotClose ifTrue: [^ self].
	(self owner notNil and: [self owner isWorldMorph])
		ifTrue: [self activate].
	model ifNotNil: [ model okToChange ifFalse: [ ^ self ] ].
	animateClose := (self visible and: [self world notNil and: [
		self theme settings animationSettings useAnimation and: [
		self theme settings animationSettings animateClosing]]]).
	self removePaneSplitters. "in case we add some panes and reopen!!"
	thisWorld := self world.
	self isFlexed
		ifTrue: [owner delete]
		ifFalse: [super delete].
	model ifNotNil: [ 
		model 
			windowIsClosing; 
			release ].
	model := nil.
	animateClose ifTrue: [self animateClose].	
	SystemWindow noteTopWindowIn: thisWorld.
	announcement := (WindowClosed new 
						window: self; 
						yourself).
	self announce: announcement.
	World announcer announce: announcement
! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'GaryChambers 6/9/2011 14:10'!
lockInactivePortions
	"Make me unable to respond to mouse and keyboard.  Control boxes remain active."

	self isEmbedded ifTrue: [^self].
	self submorphsDo: [:m | m == labelArea ifFalse: [m lock]]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'GaryChambers 6/9/2011 13:38'!
configureForEmbedding
	"Set up the window so it can be embedded into another morph."

	labelArea owner notNil ifTrue: [
		self
			hasDropShadow: false;
			beWithoutGrips;
			removeLabelArea;
			makeBorderless.
		self submorphsDo: [:m | m unlock]]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 5/23/2007 15:43'!
fillStyleToUse
	"Answer the basic fill style for the receiver."

	^self isActive 
		ifTrue: [self activeFillStyle] 
		ifFalse: [self inactiveFillStyle]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'GaryChambers 12/2/2011 12:21'!
taskbarButtonFor: aTaskbar
	"Answer a new task bar button for the receiver.
	Answer nil if not required."

	^aTaskbar theme
		newTaskbarButtonIn: aTaskbar
		for: self! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'AlainPlantec 12/15/2009 10:47'!
animateClose
	"Animate closing."
	
	| smallRect restoredRect rects steps|
	self isMinimized ifTrue: [^self].
	restoredRect := self bounds.
	smallRect := restoredRect scaledAndCenteredIn: (0@0 extent: 20@20).
	smallRect := smallRect align: smallRect center with: restoredRect center.
	steps := self theme settings animationSettings numberOfSteps.
	rects := ((steps - 1)/steps to: 0 by: -1/steps) collect: [:x |
		smallRect interpolateTo: restoredRect at: (20 raisedTo: x) - 1 / 19].
	World displayWorldSafely.
	self fastAnimateRectangles: rects! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 7/30/2009 18:11'!
collapseBoxHit
	"The user has clicked on the collapse box.
	Collapse or expand the receiver as appropriate."
	
	self isCollapsed
		ifTrue: [self playRestoreUpSound]
		ifFalse: [self playMinimizeSound].
	self collapseOrExpand! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 7/30/2009 13:57'!
resetCollapsedFrame
	"Reset the collapsed frame."

	collapsedFrame := nil! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/24/2007 13:43'!
restoreBeforeGeneratingThumbnail
	"Restore the window without activating unlocking or stepping."
	
	self isMinimized ifFalse: [^self].
	isCollapsed := false.
	self show.
	self setBoundsWithFlex: fullFrame.
	paneMorphs reverseDo: [:m | 
		self addMorph: m].
	self layoutChanged! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'AlainPlantec 12/7/2009 09:13'!
taskbarButtonLeft: aButton event: evt in: aMorph
	"The mouse has left our taskbar button.
	Remove our thumbnail."

	self
		valueOfProperty: #taskbarThumbnail
		ifPresentDo: [:thumb |
			thumb delete.
			self removeProperty: #taskbarThumbnail]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 3/2/2010 15:01'!
rememberKeyboardFocus: aMorph
	"Record the current keyboard focus for the receiver."
	
	(aMorph isNil or: [(aMorph hasOwner: self) not]) ifFalse: [
		self setProperty: #rememberedFocus toValue: aMorph]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 7/30/2007 15:58'!
inactiveFillStyle
	"Return the active fillStyle for the receiver."
	
	^self theme windowInactiveFillStyleFor: self! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'MarcusDenker 6/17/2013 13:44'!
passivate
	"Make me unable to respond to mouse and keyboard"

	super passivate.
	self setStripeColorsFrom: self paneColorToUse.
	self isEmbedded ifTrue: [^self].
	"Control boxes remain active, except in novice mode"
	self lockInactivePortions.
	labelArea ifNil: "i.e. label area is nil, so we're titleless"
		[self adjustBorderUponDeactivationWhenLabeless]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'SeanDeNigris 11/30/2011 14:28'!
expandBoxHit
	"The fullscreen expand box has been hit"

	self isCollapsed
		ifTrue: [self playRestoreUpSound.
				self
					hide;
					collapseOrExpand.
				self unexpandedFrame ifNil: [self unexpandedFrame: fullFrame].
				self
					fullscreen;
					setExpandBoxBalloonText.
				^self show].
	self unexpandedFrame
		ifNil: [self playMaximizeSound.
				self theme settings animationSettings useAnimation ifTrue: [self animateMaximize].
				self
					unexpandedFrame: fullFrame;
					fullscreen]
		ifNotNil: [self playRestoreDownSound.
				self theme settings animationSettings useAnimation ifTrue: [self animateRestore].
				self
					bounds: self unexpandedFrame;
					unexpandedFrame: nil].
	self setExpandBoxBalloonText! !

!SystemWindow methodsFor: 'drawing' stamp: 'ar 8/16/2001 12:47'!
raisedColor
	^self paneColor raisedColor! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 10/1/2007 14:41'!
removeEdgeGrips
	"Remove the window edge grips."
	
	|edges|
	edges := self submorphsSatisfying: [:each | each isKindOf: WindowEdgeGripMorph].
	edges do: [:each | each delete]! !

!SystemWindow methodsFor: 'events' stamp: 'MarcusDenker 9/8/2011 15:48'!
mouseUp: evt
	| cp |
	cp := evt cursorPoint.
	submorphs do: [:m | (m containsPoint: cp) ifTrue: [m mouseUp: evt]]! !

!SystemWindow methodsFor: 'open/close' stamp: 'alain.plantec 6/1/2008 23:07'!
openInWorldExtent: extent
	"This msg and its callees result in the window being activeOnlyOnTop"

	self openInWorld: self currentWorld extent: extent! !

!SystemWindow methodsFor: 'layout' stamp: 'JW 1/30/2001 22:45'!
layoutBounds
	"Bounds of pane area only."
	| box |

	box := super layoutBounds.
	^box withTop: box top + self labelHeight! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'GaryChambers 6/10/2011 12:11'!
isEmbedded
	"Answer whether the receiver is embedded, i.e.
	has an owner that is not the world or the hand."

	^self owner isNil or: [self owner ~= self world and: [self owner ~= self activeHand]]! !

!SystemWindow methodsFor: 'drawing' stamp: 'RAA 6/12/2000 18:16'!
makeMeVisible 

	self world extent > (0@0) ifFalse: [^ self].

	((self world bounds insetBy: (0@0 corner: self labelHeight asPoint))
		containsPoint: self position) ifTrue: [^ self "OK -- at least my top left is visible"].

	"window not on screen (probably due to reframe) -- move it now"
	self isCollapsed
		ifTrue: [self position: (RealEstateAgent assignCollapsePointFor: self)]
		ifFalse: [self position: (RealEstateAgent initialFrameFor: self initialExtent: self extent world: self world) topLeft].

! !

!SystemWindow methodsFor: 'testing' stamp: 'StephaneDucasse 10/13/2013 21:53'!
wantsToBeCachedByHand
	"Return true if the receiver wants to be cached by the hand when it is dragged around."

	self isTranslucentButNotTransparent
		ifTrue: [ ^ false ].
	self clipSubmorphs
		ifTrue: [ ^ true ].
	self bounds = self fullBounds
		ifTrue: [ ^ true ].
	self
		submorphsDo: [ :m | 
			(self bounds containsRect: m fullBounds)
				ifFalse: [ 
					m wantsToBeCachedByHand
						ifFalse: [ ^ false ] ] ].
	^ true! !

!SystemWindow methodsFor: 'events' stamp: 'ar 1/31/2001 21:09'!
mouseEnterDragging: evt
	"unlock children for drop operations"
	(self ~~ TopWindow and:[evt hand hasSubmorphs]) ifTrue:[
		self submorphsDo:[:m| m unlock].
		evt hand addMouseListener: self. "for drop completion on submorph"
	].! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 8/29/2006 16:21'!
paneColorOrNil
	"Answer the window's pane color or nil otherwise."

	^self paneColor! !

!SystemWindow methodsFor: 'label' stamp: 'AlainPlantec 11/29/2009 22:13'!
widthOfFullLabelText
	^StandardFonts windowTitleFont widthOfString: labelString! !

!SystemWindow methodsFor: 'menu actions' stamp: 'PavelKrivaenk 4/19/2012 10:39'!
createWindowGroup

  | group pos ext |
  
  pos := self position.
  ext := self extent.
  group := GroupWindowMorph new.
  group addWindow: self.
  (group openInWindowLabeled: 'Group: ' translated, self label) 
    extent: ext;
    position: pos.
  ! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/11/2007 12:11'!
nextMorphAcrossInWindow
	"Answer the next morph in the window. Traverse
	from the receiver to its next sibling or owner's next sibling etc."

	^self! !

!SystemWindow methodsFor: 'events' stamp: 'RAA 2/7/2001 07:12'!
mouseLeaveDragging: evt
	"lock children after drop operations"
	(self ~~ TopWindow and:[evt hand hasSubmorphs]) ifTrue:[
		self lockInactivePortions.
		evt hand removeMouseListener: self.
	].! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'MarcusDenker 6/17/2013 13:44'!
minimizeOrRestore
	"Collapse or expand the window, depending on existing state"
	
	|mc windowEvent |
	isCollapsed
		ifTrue: ["Expand -- restore panes to morphics structure"
			self theme settings animationSettings useAnimation 
				ifTrue: [self animateRestoreFromMinimized].
			isCollapsed := false.
			"Bring to front first"
			self
				setBoundsWithFlex: fullFrame;
				comeToFront;
				show.
			mc := self modalChild.
			paneMorphs reverseDo: [:m | 
				mc ifNil: [m unlock].
				self addMorph: m.
				self world startSteppingSubmorphsOf: m].
			self activate]
		ifFalse: ["Collapse -- remove panes from morphics structure"
			isCollapsed := true.
			fullFrame := self getBoundsWithFlex.
			"First save latest fullFrame"
			paneMorphs
				do: [:m | m delete; releaseCachedState].
			self
				setBoundsWithFlex: (-100 @ -100 extent: 2 @ 2); "place offscreen"
				hide.
			self theme settings animationSettings useAnimation  
				ifTrue: [self animateMinimize].
			self isActive ifTrue: [
				self world navigateVisibleWindowForward]].
	self layoutChanged.
	
	"This gets invoked only if the taskbar is present, see sender of minimizeOrRestore"
	windowEvent := 
		self isMinimized 
			ifTrue: [ WindowCollapsed new ]
			ifFalse: [ WindowExpanded new ].

	windowEvent window: self.
	self announce: windowEvent.! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 10/1/2007 14:42'!
removeGrips
	"Remove the edge and corner grips."
	
	self
		removeCornerGrips;
		removeEdgeGrips! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 5/15/2007 17:16'!
hasMenuBox
	"Answer whether the receiver currently has a menu box."

	^menuBox notNil! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/16/2007 11:01'!
isNotMinimized
	"Answer whether we are not minimised."

	^self isCollapsed not! !

!SystemWindow methodsFor: '*Polymorph-TaskbarIcons' stamp: 'MarcusDenker 12/11/2009 07:42'!
taskbarIcon
	"Answer the icon for the receiver in a task bar."

	self model ifNotNil: [self model taskbarIcon ifNotNil: [:ico | ^ico]].
	^super taskbarIcon! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 7/30/2007 15:58'!
activeLabelFillStyle
	"Return the active label fillStyle for the receiver."
	
	^self theme windowActiveLabelFillStyleFor: self! !

!SystemWindow methodsFor: 'menu actions' stamp: 'StephaneDucasse 10/27/2014 09:34'!
addCustomMenuItems: aCustomMenu hand: aHandMorph
	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
"template..."
	aCustomMenu addLine.
	aCustomMenu add: 'Edit label...' selector: #relabel.
! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 6/27/2007 11:01'!
playCloseSound
	"Play the themed sound for closing."
	
	self theme windowCloseSound play! !

!SystemWindow methodsFor: 'controls' stamp: 'BenjaminVanRyseghem 12/11/2013 10:49'!
isResizeable
	"Answer whether we are not we can be resized."

	^ isResizeable ifNil: [ isResizeable := self defaultIsResizeable ]! !

!SystemWindow methodsFor: 'menu actions' stamp: 'sw 8/7/2000 17:35'!
deleteCloseBox
	closeBox ifNotNil:
		[closeBox delete.
		closeBox := nil]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'CamilloBruni 8/1/2012 16:00'!
basicActivate
	"Bring me to the front and make me able to respond to mouse and keyboard."

	| oldTop outerMorph |
	outerMorph := self topRendererOrSelf.
	outerMorph owner ifNil: [^ self "avoid spurious activate when drop in trash"].
	oldTop := TopWindow.
	oldTop = self ifTrue: [^self].
	oldTop
		ifNil: [self world ifNotNil: [:w | w layoutChanged]] "force taskbar update"
		ifNotNil: [oldTop changed]. "invalidate with old drop shadow bounds"
	TopWindow := self.
	oldTop ifNotNil: [oldTop isInWorld ifTrue: [oldTop passivate]].
	outerMorph owner firstSubmorph == outerMorph
		ifFalse: ["Bring me (with any flex) to the top if not already"
				outerMorph owner addMorphFront: outerMorph].
	self submorphsDo: [:m | m unlock].
	labelArea ifNotNil:
		[labelArea submorphsDo: [:m | m unlock].
		self setStripeColorsFrom: self paneColorToUse].
	self isCollapsed ifFalse:
		[model modelWakeUpIn: self.
		self positionSubmorphs.
		labelArea ifNil: [self adjustBorderUponActivationWhenLabeless]].

	self privateFullBounds: nil; changed "ensure fullBounds computed for active drop shadow"
! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/18/2007 13:08'!
taskbarState
	"Answer one of #minimized, #restored, #maximized or #active."

	^self isMinimized
		ifTrue: [#minimized]
		ifFalse: [self isMaximized
			ifTrue: [#maximized]
			ifFalse: [self isActive
						ifTrue: [#active]
						ifFalse: [#restored]]]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 5/7/2008 11:41'!
beWithoutGrips
	"Remove the grips and set a property to
	indicate that grips are not wanted."

	self setProperty: #noGrips toValue: true.
	self removeGrips! !

!SystemWindow methodsFor: 'menu actions' stamp: 'MarcusDenker 10/1/2013 11:23'!
fullscreenBounds
	"Answer the bounds that the receiver would take if expanded to fullscreen."
	
	^ (RealEstateAgent maximumUsableAreaInWorld: self world) insetBy: self fullscreenMargin 
! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'jlb 5/29/2001 23:07'!
unexpandedFrame: aRectangle
	"Set the frame size of an unexpanded window"

	^ self setProperty: #unexpandedFrame toValue: aRectangle! !

!SystemWindow methodsFor: 'top window' stamp: 'di 5/14/1998 12:38'!
activeOnlyOnTop: trueOrFalse
	activeOnlyOnTop := trueOrFalse! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/24/2008 14:57'!
aboutTitle
	"Answer the title to use for the About dialog."

	|title|
	title := self model
		ifNil: ['SystemWindow']
		ifNotNil: [(self model respondsTo: #aboutTitle)
					ifTrue: [self model aboutTitle]
					ifFalse: [self model class name]].
	^'About {1}' translated format: {title}! !

!SystemWindow methodsFor: 'label' stamp: 'di 5/4/1998 23:42'!
label
	^ labelString! !

!SystemWindow methodsFor: 'label' stamp: 'yo 6/30/2004 00:21'!
setLabelFont: aFont

	label ifNil: [^ self].
	label font: aFont.
! !

!SystemWindow methodsFor: 'panes' stamp: 'GabrielOmarCotelli 11/30/2013 17:00'!
setUpdatablePanesFrom: getSelectors
	| aList possibles |
	"Set my updatablePanes inst var to the list of panes which are list panes with the given get-list selectors.  Order is important here!!  Note that the method is robust in the face of panes not found, but a warning is printed in the transcript in each such case"
	aList := OrderedCollection new.
	possibles := OrderedCollection new.
	self
		allMorphsDo: [ :pane | 
			(pane isKindOf: PluggableListMorph)
				ifTrue: [ possibles add: pane ] ].
	getSelectors
		do: [ :sel | possibles detect: [ :pane | pane getListSelector == sel ] ifFound: [ :aPane | aList add: aPane ] ].
	updatablePanes := aList asArray! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 6/27/2007 10:06'!
playMaximizeSound
	"Play the themed sound for maximizing."
	
	self theme windowMaximizeSound play! !

!SystemWindow methodsFor: 'controls' stamp: 'BenjaminVanRyseghem 12/10/2013 22:23'!
beResizeable

	isResizeable := true.
	
	"If isResizable is overriden to always return false, then it would break the invariant"
	self isResizeable ifTrue: [ self addGripsIfWanted ]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'GaryChambers 6/9/2011 13:26'!
configureForUnembedding
	"Set up the window so it can be unembedded and placed in the world."

	labelArea owner isNil ifTrue: [
		self
			removeProperty: #processingMouseDown;
			makeBordered;
			initializeLabelArea;
			themeChanged;
			addGrips;
			hasDropShadow: true]! !

!SystemWindow methodsFor: 'controls' stamp: 'BenjaminVanRyseghem 12/10/2013 22:21'!
defaultIsResizeable

	^ true! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 6/2/2009 10:26'!
preferredCornerStyle
	"Answer the preferred corner style."

	^self theme windowPreferredCornerStyleFor: self! !

!SystemWindow methodsFor: 'initialization' stamp: 'EstebanLorenzano 5/15/2014 14:24'!
defaultColor
	"answer the default color/fill style for the receiver"
	^ self theme backgroundColor! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'AlainPlantec 12/14/2009 21:36'!
fastFramingOn

	^self theme settings fastDragging and: [self isFlexed not]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'FernandoOlivero 6/18/2011 17:33'!
keyStroke: evt
	"Check for close window."
	super keyStroke: evt.
	(self navigationKey: evt) ifTrue: [^true].
	(evt commandKeyPressed and: [
			evt keyCharacter = Character delete or: [
				evt keyCharacter = $w]])  ifTrue: [
		self delete.
		^true].
	^false! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/16/2007 11:00'!
isNotRestored
	"Answer whether we are maximised or minimised."

	^self isMinimized or: [self isMaximized]! !

!SystemWindow methodsFor: 'open/close' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
openModal

	self openInWorld.
	Smalltalk ui theme runModal: self.! !

!SystemWindow methodsFor: 'open/close' stamp: 'ar 5/11/2001 23:47'!
openInWorld: aWorld extent: extent
	"This msg and its callees result in the window being activeOnlyOnTop"
	self position: (RealEstateAgent initialFrameFor: self world: aWorld) topLeft; extent: extent.
	^self openAsIsIn: aWorld! !

!SystemWindow methodsFor: 'initialization' stamp: 'jrp 7/23/2005 12:07'!
createBox
	"create a button with default to be used in the label area"
	"Transcript show: self paneColor asString;  
	cr."
	| box |
	box := IconicButton new.
	box color: Color transparent;
		 target: self;
		 useSquareCorners;
		 borderWidth: 0.

	^ box! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 5/15/2007 11:41'!
basicLabel
	"Answer the actual label morph."

	^label! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'MarcusDenker 12/11/2009 07:42'!
taskbarLabel
	"Answer the label to use for a taskbar button for the receiver."

	self model ifNotNil: [self model taskbarLabel ifNotNil: [:str | ^str]].
	^self labelString! !

!SystemWindow methodsFor: 'panes' stamp: 'GabrielOmarCotelli 12/3/2013 17:56'!
paneMorphSatisfying: aBlock
	^ paneMorphs detect: aBlock ifNone: [ nil ]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 10/22/2008 12:20'!
createCollapseBox
	"Answer a button for minimising the window."
	
	^self theme createCollapseBoxFor: self! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'BenjaminVanRyseghem 6/9/2013 23:49'!
initializeLabelArea
	"Initialize the label area (titlebar) for the window."
	
	label := self theme windowLabelFor: self.
	"Add default inital boxes"
	collapseBox := self createCollapseBox. "Add collapse box so #labelHeight will work"
	closeBox := self createCloseBox.
	self wantsExpandBox ifTrue: [
		expandBox := self createExpandBox.
		self setExpandBoxBalloonText].
	menuBox := self createMenuBox.
	stripes := Array
						with: (Morph newBounds: bounds)
						with: (Morph newBounds: bounds).
	self addLabelArea.
	labelArea
		goBehind.
	self replaceBoxes.
	labelArea fillStyle: self activeTitleFillStyle.! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 10/19/2007 21:48'!
doubleClickTimeout: event
	"Forget the #inactiveDoubleClick property.
	The property is set if an inactive window was double-clicked."
	
 	self removeProperty: #inactiveDoubleClick! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 10/9/2007 11:47'!
worldTaskbar
	"Answer the world taskbar or nil if none."

	^self world submorphThat: [:m | m isTaskbar] ifNone: [] ! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'BenjaminVanRyseghem 9/26/2011 03:48'!
handlesKeyboard: evt
	"Return true if the receiver wishes to handle the given keyboard event"

	(super handlesKeyboard: evt) ifTrue: [^true].
	^evt anyModifierKeyPressed and: [
		evt keyCharacter = Character arrowLeft or: [
		evt keyCharacter = Character arrowRight or: [
		evt keyCharacter = Character delete or: [
		evt keyCharacter = $w or: [
		evt keyCharacter = Character tab ]]]]]! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'di 5/20/1998 08:25'!
fullFrame
	^ fullFrame! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'BenjaminVanRyseghem 12/10/2013 22:18'!
wantsGrips
	"Answer whether the window wants edge and corner grips."
	
	^self isResizeable! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 9/12/2007 17:48'!
playOpenSound
	"Play the themed sound for opening."
	
	self theme windowOpenSound play! !

!SystemWindow methodsFor: '*Keymapping-Core' stamp: 'EstebanLorenzano 1/24/2013 16:42'!
initializeShortcuts: aKMDispatcher 
	"Where we may attach keymaps or even on:do: local shortcuts if needed."

	super initializeShortcuts: aKMDispatcher.
	aKMDispatcher attachCategory: #WindowShortcuts	! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'MarcusDenker 6/17/2013 13:44'!
collapseOrExpand
	"Collapse or expand the window, depending on existing state.
	Use the taskbar if present, otherwise do as normal."
	
	| cf |
	self isTaskbarPresent ifTrue: [^self minimizeOrRestore].
	isCollapsed
		ifTrue: 
			["Expand -- restore panes to morphics structure"
			isCollapsed := false.
			self activate.  "Bring to frint first"
			collapsedFrame := self getBoundsWithFlex.
			collapseBox ifNotNil: [collapseBox setBalloonText: 'Collapse this window'].
			self setBoundsWithFlex: fullFrame.
			paneMorphs reverseDo: 
					[:m |  self addMorph: m unlock.
					self world startSteppingSubmorphsOf: m].
			self
				addPaneSplitters;
				addGripsIfWanted]
		ifFalse: 
			["Collapse -- remove panes from morphics structure"
			isCollapsed := true.
			fullFrame := self getBoundsWithFlex.
			"First save latest fullFrame"
			paneMorphs do: [:m | m delete; releaseCachedState].
			self removePaneSplitters.
			self removeGrips.
			cf := self getCollapsedFrame.
			collapsedFrame ifNil: [collapsedFrame := cf].
			self setBoundsWithFlex: cf.
			collapseBox ifNotNil: [collapseBox setBalloonText: 'expand this window'].
			expandBox ifNotNil: [expandBox setBalloonText: 'expand to full screen']].
	self layoutChanged.
	
	"This gets invoked only if the taskbar is not present, if it is, then minimizeOrRestore is invoked (cf beginning of this method)"
	self announce: 
		(WindowCollapsed new
			window: self;
			yourself).! !

!SystemWindow methodsFor: 'stepping' stamp: 'di 4/9/2001 17:04'!
stepAt: millisecondClockValue
	"If the receiver is not collapsed, step it, after first stepping the model."

	(isCollapsed not or: [self wantsStepsWhenCollapsed]) ifTrue:
		[model ifNotNil: [model stepAt: millisecondClockValue in: self].
		super stepAt: millisecondClockValue "let player, if any, step"]

"Since this method ends up calling step, the model-stepping logic should not be duplicated there."! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/21/2009 16:51'!
allowedToClose
	"Answer whether the window is currently allowed to close."

	^self mustNotClose not and: [
		self modalChild isNil]! !

!SystemWindow methodsFor: 'geometry' stamp: 'nice 1/5/2010 15:59'!
setPaneRectsFromBounds
	"Reset proportional specs from actual bounds, eg, after reframing panes"
	| layoutBounds |
	layoutBounds := self layoutBounds.
	paneMorphs do:[:m| | frame right top box bottom left |
		frame := m layoutFrame.
		box := m bounds.
		frame ifNotNil:[
			left := box left - layoutBounds left - (frame leftOffset ifNil:[0]).
			right := box right - layoutBounds left - (frame rightOffset ifNil:[0]).
			top := box top - layoutBounds top - (frame topOffset ifNil:[0]).
			bottom := box bottom - layoutBounds top - (frame bottomOffset ifNil:[0]).
			frame leftFraction: (left / layoutBounds width asFloat).
			frame rightFraction: (right / layoutBounds width asFloat).
			frame topFraction: (top / layoutBounds height asFloat).
			frame bottomFraction: (bottom / layoutBounds height asFloat).
		].
	].! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 5/15/2007 17:16'!
hasCollapseBox
	"Answer whether the receiver currently has a collapse box."

	^collapseBox notNil! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'AlainPlantec 12/15/2009 10:48'!
animateMinimize
	"Animate minimizing."
	
	|tb buttonRect restoredRect rects steps|
	tb := self worldTaskbar ifNil: [^self].
	buttonRect := ((tb taskButtonOf: self) ifNil: [^self]) bounds.
	restoredRect := self isFlexed
		ifTrue: [(owner transform
					globalPointToLocal: fullFrame topLeft)
					extent: fullFrame extent]
		ifFalse: [fullFrame].
	steps := self theme settings animationSettings numberOfSteps.
	rects := ((steps - 1)/steps to: 0 by: -1/steps) collect: [:x |
		buttonRect interpolateTo: restoredRect at: (20 raisedTo: x) - 1 / 19].
	self fastAnimateRectangles: rects! !

!SystemWindow methodsFor: 'open/close' stamp: 'sw 9/28/1999 13:32'!
mustNotClose
	^ mustNotClose == true! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 10/22/2008 12:20'!
createExpandBox
	"Answer a button for maximising/restoring the window."
	
	^self theme createExpandBoxFor: self! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 6/27/2007 10:06'!
playMinimizeSound
	"Play the themed sound for maximizing."
	
	self theme windowMinimizeSound play! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'jlb 5/29/2001 23:06'!
unexpandedFrame
	"Return the frame size of an unexpanded window"

	^ self valueOfProperty: #unexpandedFrame! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 9/10/2008 16:49'!
openModal: aSystemWindow
	"Open the given window locking the receiver until it is dismissed.
	Set the pane color to match the receiver.
	Answer the system window."
	
	aSystemWindow
		theme: self theme;
		setWindowColor: self paneColor.
	^super openModal: aSystemWindow! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'GaryChambers 2/15/2011 15:45'!
model: anObject
	"Set the model."
	
	super model: anObject.
	self paneColorTracksModel ifTrue: [
		self
			setProperty: #paneColor toValue: self defaultBackgroundColor;
			fillStyle: self fillStyleToUse;
			setStripeColorsFrom: self paneColorToUse.
		self theme settings fadedBackgroundWindows ifFalse: [ "since not done in stripes"
			self adoptPaneColor: self paneColor]].
	self minimumExtent: (
		(anObject respondsTo: #minimumExtent)
			ifTrue: [anObject minimumExtent]).
	menuBox ifNotNil: [
		menuBox
			labelGraphic: (self theme windowMenuIconFor: self);
			height: self boxExtent y]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'BenjaminVanRyseghem 3/22/2013 16:07'!
labelHeight
	"Answer the height for the window label.  The standard behavior is at bottom; a hook is provided so that models can stipulate other heights, in support of various less-window-looking demos.
	If no label answer the class border width instead."

	label ifNil: [^self isEmbedded ifTrue: [0] ifFalse: [self class borderWidth]].
		
	(model notNil and: [model respondsTo: #desiredWindowLabelHeightIn:]) ifTrue: [
		(model desiredWindowLabelHeightIn: self) ifNotNil: [:h | ^h]].

	^(label height + (self class borderWidth * 2)) max:
		(collapseBox ifNotNil: [collapseBox height] ifNil: [10])! !

!SystemWindow methodsFor: 'controls' stamp: 'BenjaminVanRyseghem 12/10/2013 22:20'!
isResizeable: aBoolean

	aBoolean = isResizeable ifTrue: [ ^ self ].
	aBoolean
		ifTrue: [ self beResizeable ]
		ifFalse: [ self beUnresizeable ]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 2/18/2008 10:55'!
makeClosable
	"Reinstate the close box. Go via theme to maintain box order."
	
	mustNotClose := false.
	closeBox
		ifNil: [closeBox := self createCloseBox.
				self replaceBoxes]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 6/27/2007 10:36'!
restore
	"Restore the receiver's normal size."

	self isMinimized
		ifTrue: [self collapseBoxHit]
		ifFalse: [self isMaximized ifTrue: [self expandBoxHit]]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'BenComan 12/15/2014 21:15'!
taskbarButtonMenu: aMenu
	"Answer the menu for the task bar button."

	| menu theme submenu  |
	theme :=  self theme.	
	menu := theme newMenuIn: self for: self.
	
	menu
		addToggle: 'Restore' translated
		target: self
		selector: #restore
		getStateSelector: nil
		enablementSelector: #isNotRestored.
	menu lastItem
		icon: self theme windowMaximizeForm;
		font: theme menuFont.
		
	menu
		addToggle: 'Minimize' translated
		target: self
		selector: #minimize
		getStateSelector: nil
		enablementSelector: #isNotMinimized.
	menu lastItem
		icon: self theme windowMinimizeForm;
		font: theme menuFont.
		
	menu
		addToggle: 'Maximize' translated
		target: self
		selector: #maximize
		getStateSelector: nil
		enablementSelector: #canBeMaximized.
	menu lastItem
		icon: self theme windowMaximizeForm;
		font: theme menuFont.
		
	menu addLine.

	submenu := theme newMenuIn: self for: self.
	menu
		add: 'Close all'
		icon: self theme windowCloseForm
		subMenu: submenu.
	submenu
		addToggle: 'windows to right' translated
		target: self
		selector: #taskbarCloseAllToRight
		getStateSelector: nil
		enablementSelector: true.
	submenu
		addToggle: 'unchanged windows' translated
		target: World
		selector: #closeAllUnchangedWindows
		getStateSelector: nil
		enablementSelector: true.

	menu
		addToggle: 'Close' translated
		target: self
		selector: #closeBoxHit
		getStateSelector: nil
		enablementSelector: #allowedToClose.
	menu lastItem
		icon: self theme windowCloseForm;
		font: theme menuFont.

	^menu! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 7/30/2007 15:59'!
inactiveLabelFillStyle
	"Return the inactive label fillStyle for the receiver."
	
	^self theme windowInactiveLabelFillStyleFor: self! !

!SystemWindow methodsFor: 'label' stamp: 'GaryChambers 6/10/2011 13:10'!
setLabel: aString
	| frame announcement |
	labelString := aString.
	announcement := (WindowLabelled new 
						window: self;
						label: aString;
						yourself).
	self announce: announcement.
	World announcer announce: announcement.
	label ifNil: [^ self].
	label contents: aString.
	self labelWidgetAllowance.  "Sets it if not already"
	self isCollapsed
		ifTrue: [self extent: (label width + labelWidgetAllowance) @ (self labelHeight + 2)]
		ifFalse: [label fitContents; setWidth: (label width min: bounds width - labelWidgetAllowance).
				label align: label bounds topCenter with: bounds topCenter + (0@borderWidth).
				collapsedFrame ifNotNil:
					[collapsedFrame := collapsedFrame withWidth: label width + labelWidgetAllowance]].
	frame := LayoutFrame new.
	frame leftFraction: 0.5;
		 topFraction: 0.5;
		 leftOffset: label width negated // 2;
		 topOffset: label height negated // 2.
	label layoutFrame: frame.
! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'BenjaminVanRyseghem 5/19/2013 13:08'!
closeBoxHit
	"The user clicked on the close-box control in the window title.
	For Mac users only, the Mac convention of option-click-on-close-box is obeyed if the mac option key is down.
	If we have a modal child then don't delete.
	Play the close sound now since this is the only time we know that the close is user-initiated."

	self allowedToClose ifFalse: [^self].
	self playCloseSound.
	self close
! !

!SystemWindow methodsFor: 'geometry' stamp: 'sw 2/16/1999 15:23'!
paneMorphs
	"Nominally private but a need for obtaining this from the outside arose"
	^ paneMorphs copy! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/26/2007 14:16'!
addCornerGrips
	"Should add these to the front!!"
	
	|tl tr lh|
	lh := self labelHeight.
	tl  := TopLeftGripMorph new target: self; position: self position.
	tl layoutFrame topOffset: lh negated.
	tr  := TopRightGripMorph new target: self; position: self position.
	tr layoutFrame topOffset: lh negated.
	self
		addMorph: tl;
		addMorph: tr;
		addMorph: (BottomLeftGripMorph new target: self;position: self position);
		addMorph: (BottomRightGripMorph new target: self;position: self position)! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'marcus.denker 11/30/2008 20:43'!
getCollapsedFrame

	^RealEstateAgent assignCollapseFrameFor: self.! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 5/15/2007 12:26'!
menuBox
	"Answer the receiver's menu box."

	^menuBox! !

!SystemWindow methodsFor: 'top window' stamp: 'nk 8/6/2003 10:53'!
updatePanesFromSubmorphs
	"Having removed some submorphs, make sure this is reflected in my paneMorphs."
	paneMorphs := paneMorphs select: [ :pane | submorphs includes: pane ].! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 6/14/2007 17:05'!
addPaneVSplitters
	"Add the vertical pane splitters."

	|remaining targetRight sameRight sameLeft |
	remaining := paneMorphs reject: [:each |
			each layoutFrame rightFraction = 1 or: [
				each layoutFrame rightFraction = 0]].
	[remaining notEmpty] whileTrue: [
		targetRight := remaining first layoutFrame rightFraction.
		sameRight := remaining select: [:each |
			each layoutFrame rightFraction = targetRight].
		sameLeft := paneMorphs select: [:each |
			each layoutFrame leftFraction = targetRight and: [
				each layoutFrame rightFraction ~= targetRight]].
		remaining := remaining
			copyWithoutAll: (self addPaneVSplitterBetween: sameRight and: sameLeft)]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'SeanDeNigris 6/16/2013 14:11'!
buildWindowMenu
  
	^ self menuBuilder menu.! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 9/6/2007 12:58'!
removeCollapseBox
	"Remove the collapse box."

	collapseBox ifNotNil: [collapseBox delete. collapseBox := nil]! !

!SystemWindow methodsFor: 'panes' stamp: 'md 2/24/2006 15:36'!
updatePaneColors
	"Useful when changing from monochrome to color display"

	self setStripeColorsFrom: self paneColorToUse.! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 7/30/2007 15:58'!
activeTitleFillStyle
	"Return the active title fillStyle for the receiver."
	
	^self theme windowActiveTitleFillStyleFor: self! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 10/22/2008 12:19'!
createCloseBox
	"Answer a button for closing the window."
	
	^self theme createCloseBoxFor: self! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'di 10/28/1999 14:14'!
getBoundsWithFlex
	"Return the lastest bounds rectangle with origin forced to global coordinates"

	self isFlexed
		ifTrue: [^ ((owner transform localPointToGlobal: bounds topLeft)
										extent: bounds extent)]
		ifFalse: [^ self bounds].
! !

!SystemWindow methodsFor: 'top window' stamp: 'AlainPlantec 1/7/2010 19:41'!
topWindow
	^ self class topWindow! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'Alexandre Bergel 1/13/2010 10:20'!
extent: aPoint 
	"Set the receiver's extent to value provided. Respect my minimumExtent."

	| newExtent w oldExtent|
	newExtent := self isCollapsed
		ifTrue: [aPoint max: (self labelWidgetAllowance @ 0)]
		ifFalse: [aPoint max: self minimumExtent].
	newExtent = self extent ifTrue: [^ self].

	oldExtent := self extent.	
	isCollapsed
		ifTrue: [super extent: newExtent x @ self labelHeight]
		ifFalse: [super extent: newExtent].
	isCollapsed
		ifTrue: [collapsedFrame := self bounds]
		ifFalse: [fullFrame := self bounds].
	(self isCollapsed or: [label isNil]) "shrink the label if insufficient space"
		ifFalse: [label minWidth: nil.
				label fitContents.
				w := (label width min: bounds width - labelWidgetAllowance).
				label setWidth: w; minWidth: w.
				label align: label bounds topCenter with: bounds topCenter + (0@borderWidth).
				collapsedFrame ifNotNil:
					[collapsedFrame := collapsedFrame withWidth: label width + labelWidgetAllowance]].
	self theme windowExtentChangedFor: self.

	self announce: (WindowResizing new 
						oldSize: oldExtent; 
						newSize: newExtent; 
						window: self; 
						yourself).
! !

!SystemWindow methodsFor: 'settings' stamp: 'SeanDeNigris 11/28/2011 21:53'!
fullscreenMargin
	^ self class fullscreenMargin! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'BenComan 12/15/2014 21:11'!
taskbarCloseAllToRight
	| wasFound |
	wasFound := false.
	self worldTaskbar ifNotNil: [ :worldTaskbar |
		worldTaskbar orderedTasks copy do: [ :task | 
			wasFound 
				ifTrue:  [ task morph delete ] 
				ifFalse: [ wasFound := task morph == self ].
			]. 
		].! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'IgorStasenko 12/20/2012 15:05'!
addPaneVSplitterBetween: leftMorphs and: rightMorphs
	"Add a vertical splitter for the given morphs that share a common right fraction.
	If there is a vertical discontinuity apply the splitter to the first contiguous group.
	Answer the morphs to which the splitter was applied."
	
	|targetX fixed bottomFraction topFrame bottomFrame sorted morph leftGroup rightGroup splitter offset|
	leftMorphs ifEmpty: [^self].
	targetX := leftMorphs first layoutFrame rightFraction.
	fixed := leftMorphs select: [:m | m layoutFrame leftFraction = m layoutFrame rightFraction].
		"fixed morphs appear in both top and bottom"
	sorted := ((leftMorphs reject: [:m | m layoutFrame leftFraction = m layoutFrame rightFraction])
		asSortedCollection: [:a :b | a layoutFrame bottomFraction = b layoutFrame bottomFraction
			ifTrue: [a layoutFrame topFraction <= b layoutFrame topFraction]
			ifFalse: [a layoutFrame bottomFraction <= b layoutFrame bottomFraction]]) readStream.
	sorted contents ifEmpty: [^fixed].
	leftGroup := OrderedCollection new.
	bottomFraction := sorted contents first layoutFrame topFraction.
	[sorted atEnd or: [morph := sorted next.
			morph layoutFrame topFraction ~= bottomFraction and: [
				morph layoutFrame bottomFraction ~= bottomFraction]]] whileFalse: [
		leftGroup add: morph.
		bottomFraction := morph layoutFrame bottomFraction].
	topFrame := leftGroup first layoutFrame.
	bottomFrame := leftGroup last layoutFrame.
	rightGroup := (rightMorphs
			reject: [:m | m layoutFrame leftFraction = m layoutFrame rightFraction])
			select: [:m |
		m layoutFrame topFraction
			between: topFrame topFraction
			and: bottomFrame bottomFraction].
	offset := (leftGroup collect: [:m | m layoutFrame rightOffset]) max.
	splitter := ProportionalSplitterMorph new.
	splitter layoutFrame: ((targetX @ topFrame topFraction corner: targetX @ bottomFrame bottomFraction) asLayoutFrame
								leftOffset: offset ;
								topOffset: topFrame topOffset ; 
								rightOffset: 4 + offset; 
								bottomOffset: bottomFrame bottomOffset).
	leftGroup := leftGroup, fixed.
	leftGroup do: [:m | splitter addLeftOrTop: m].
	rightGroup do: [:m | splitter addRightOrBottom: m].
	self addMorphBack: splitter.
	^leftGroup! !

!SystemWindow methodsFor: 'accessing' stamp: 'PavelKrivanek 7/24/2014 10:58'!
embeddedWindowOrNil

	"answer nil for common morphs, yourself from system windows and first submorph for transformation morphs"
	
	^ self ! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'MarcusDenker 12/11/2009 07:42'!
indicateModalChild
	"Make the user aware that this is the topmost modal child
	by flashing."

	(self isMinimized and: [self isTaskbarPresent])
		ifTrue: [self worldTaskbar ifNotNil: [:tb |
					tb indicateModalChildForMorph: self]]
		ifFalse: [self flash]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'AlainPlantec 12/15/2009 10:48'!
animateRestore
	"Animate restoring from maximised."
	
	|expandedRect restoredRect rects steps|
	expandedRect := self bounds.
	restoredRect := self unexpandedFrame.
	steps := self theme settings animationSettings numberOfSteps.
	rects := ((steps - 1)/steps to: 0 by: -1/steps) collect: [:x |
		restoredRect interpolateTo: expandedRect at: (20 raisedTo: x) - 1 / 19].
	self fastAnimateRectangles: rects! !

!SystemWindow methodsFor: 'initialization' stamp: 'md 2/24/2006 15:57'!
defaultBorderColor
	"answer the default border color/fill style for the receiver"
	^ #raised.! !

!SystemWindow methodsFor: 'menu actions' stamp: 'sw 8/7/2000 17:35'!
makeUnclosable
	mustNotClose := true.
	self deleteCloseBox! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'FernandoOlivero 9/10/2013 09:51'!
doFastWindowReframe: aSideOrCornerName
	"Do fast frame resizing  from the given corner or side"

	(FastDraggingFrameMorph forResizing: self fromLocation: aSideOrCornerName) openInWorld! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'BenjaminVanRyseghem 12/10/2013 22:17'!
doubleClick: event
	"Handle a double click. Maximize/restore the window.
	Works in title bar area."

	self isResizeable ifFalse: [ ^ self ].
	
	(labelArea containsPoint: event position)
		ifTrue: [self expandBoxHit]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/16/2007 12:24'!
modalChild
	"Answer the modal child of the receiver, if any."

	^self valueOfProperty: #modalChild! !

!SystemWindow methodsFor: 'initialization' stamp: 'bvs 3/16/2004 13:20'!
gradientWithColor: aColor

	| ramp |
	ramp := {0.0 -> Color white. 1.0 -> aColor}.

	^ (GradientFillStyle ramp: ramp)
		radial: true;
		origin: self bounds origin;
		direction: 0 @ 223;
		normal: 223 @ 0.! !

!SystemWindow methodsFor: 'panes' stamp: 'md 2/24/2006 15:46'!
restoreDefaultPaneColor
	"Useful when changing from monochrome to color display"

	self setStripeColorsFrom: self paneColor.! !

!SystemWindow methodsFor: 'menu actions' stamp: 'HenrikSperreJohansen 5/21/2010 13:46'!
setWindowColor
	"Allow the user to select a new basic color for the window"

	(UIManager default chooseColor: self paneColor)
		ifNotNil: [:nc | self setWindowColor: nc].
! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/10/2007 10:08'!
window
	"Answer the receiver's window."

	^self! !

!SystemWindow methodsFor: 'menu building' stamp: 'SeanDeNigris 6/16/2013 12:22'!
fallbackMenuOn: menu
	"Build the menu that is put up if something is going wrong with the menubuilder"
	
	menu
		addToggle: 'Close' translated
		target: self
		selector: #closeBoxHit
		getStateSelector: nil
		enablementSelector: #allowedToClose.
	menu lastItem icon: self theme windowCloseForm.! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'EstebanLorenzano 10/15/2013 23:35'!
addMorph: aMorph fullFrame: aLayoutFrame
	"Add a morph to the receiver with the given layout frame."
	
	| left right bottom top windowBorderWidth frame |
	frame := aLayoutFrame asLayoutFrame.
	windowBorderWidth := self class borderWidth.

	left := frame leftOffset.
	right := frame rightOffset.

	bottom := frame bottomOffset.
	top := frame topOffset.
	
	frame rightFraction = 1 ifTrue: [frame rightOffset: right - windowBorderWidth - self theme windowRightOffset].
	frame leftFraction = 0
		ifTrue: [frame leftOffset: left + windowBorderWidth + self theme windowLeftOffset]
		ifFalse: [frame leftFraction = 1 ifFalse: [
					frame leftOffset: left + ProportionalSplitterMorph splitterWidth]].

	frame bottomFraction = 1 ifTrue: [frame bottomOffset: bottom - windowBorderWidth - self theme windowBottomOffset].
	frame topFraction = 0
		ifTrue: [frame topOffset: top+ self theme windowTopOffset]
		ifFalse: [frame topFraction = 1 ifFalse: [
					frame topOffset: top + ProportionalSplitterMorph splitterWidth]].
	
	super addMorph: aMorph fullFrame: frame.

	paneMorphs := paneMorphs copyReplaceFrom: 1 to: 0 with: (Array with: aMorph).
	"aMorph adoptPaneColor: self paneColor."
	aMorph
		borderStyle: (self theme windowPaneBorderStyleFor: aMorph in: self)";
		color: (aMorph initialColorInSystemWindow: self)".
	self addMorphBack: aMorph. "reorder panes so flop-out right-side scrollbar is visible"
		
	self owner ifNotNil: [self addPaneSplitters] "do when opened for performance"! !

!SystemWindow methodsFor: 'initialization' stamp: 'GaryChambers 6/9/2011 14:38'!
boxExtent
	"answer the extent to use in all the buttons.  
	The label height is used to be proportional to the standard window label font"
	
	label ifNil: [^14 @ 14].
	^ (14 @ 14) max: label height @ label height ! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 9/25/2006 13:44'!
paneColorTracksModel
	"Answer true if the colour of the window should be taken from the model."
	
	^true! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'BenjaminVanRyseghem 3/22/2013 17:21'!
addCollapseBox
	"If I have a labelArea, add a collapse box to it."
	
	labelArea
		ifNil: [^ self].
	collapseBox := self createCollapseBox.
	collapseBox layoutFrame: (self theme windowCollapseBoxLayoutFor: self).
	labelArea addMorphBack: collapseBox! !

!SystemWindow methodsFor: 'label' stamp: 'sw 11/7/2000 10:24'!
externalName
	"Answer the name by which the receiver is known in the UI"

	^ labelString! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 8/10/2009 11:40'!
replaceBoxes
	"Rebuild the various boxes."
	
	labelArea removeAllMorphs.
	self setLabelWidgetAllowance.
	self theme configureWindowLabelAreaFor: self.
	self setFramesForLabelArea.
	self isActive ifFalse: [labelArea passivate]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'tbn 7/29/2010 21:29'!
setExpandBoxBalloonText
	"Set the expand box balloon help text as appropriate."

	expandBox ifNil: [^self].
	self unexpandedFrame
		ifNil: [expandBox setBalloonText: 'Expand to full screen' translated]
		ifNotNil: [expandBox setBalloonText: 'Contract to original size' translated]! !

!SystemWindow methodsFor: 'stepping' stamp: 'di 4/9/2001 16:45'!
wantsStepsWhenCollapsed
	"Default is not to bother updating collapsed windows"

	^ false! !

!SystemWindow methodsFor: 'label' stamp: 'sw 9/29/1999 07:22'!
labelWidgetAllowance
	^ labelWidgetAllowance ifNil: [self setLabelWidgetAllowance]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 2/23/2009 13:30'!
handlesDropShadowInHand
	"Answer whether the receiver will handle drop shadow drawing when picked up in the hand."

	^self theme handlesWindowDropShadowInHandFor: self! !

!SystemWindow methodsFor: 'stepping' stamp: 'MarcusDenker 10/3/2013 23:49'!
stepTime
	^ model
		ifNotNil: [model stepTimeIn: self]
		ifNil: [200] "milliseconds"! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'MarcusDenker 12/11/2009 07:42'!
bringBehind: aMorph
	"Make the receiver be directly behind the given morph.
	Take into account any modal owner and propagate."

	|outerMorph|
	outerMorph := self topRendererOrSelf.
	outerMorph owner ifNil: [^ self "avoid spurious activate when drop in trash"].
	outerMorph owner addMorph: outerMorph after: aMorph topRendererOrSelf.
	self modalOwner ifNotNil: [:mo | mo bringBehind: self]! !

!SystemWindow methodsFor: 'label' stamp: 'SvenVanCaekenberghe 12/4/2012 19:09'!
relabel
	| newLabel |
	newLabel := UIManager default 
		request: 'New title for this window' translated
		initialAnswer: labelString.
	newLabel isEmptyOrNil ifTrue: [^self].
	self setLabel: newLabel! !

!SystemWindow methodsFor: 'controls' stamp: 'BenjaminVanRyseghem 12/10/2013 22:22'!
beUnresizeable

	isResizeable := false.
	
	"If isResizable is overriden to always return true, then it would break the invariant"
	self isResizeable ifFalse: [ self removeGrips ]! !

!SystemWindow methodsFor: 'events' stamp: 'FernandoOlivero 9/10/2013 09:51'!
doFastFrameDrag: grabPoint
	"Do fast frame dragging from the given point"

	(FastDraggingFrameMorph forDragging: self clickedAt: grabPoint) openInWorld
! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'GaryChambers 6/9/2011 12:13'!
makeBorderless
	"Remove the border and border width offsets.."

	|b|
	b  := self class borderWidth.
	self submorphsDo: [:m | | l |
		l := m layoutFrame.
		l ifNotNil: [
			l rightFraction = 1 ifTrue: [l rightOffset: l rightOffset + b].
			l leftFraction = 0 ifTrue: [l leftOffset: l leftOffset - b].
			l bottomFraction = 1 ifTrue: [l bottomOffset: l bottomOffset + b]]].
	self borderWidth: 0! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'CamilloBruni 2/4/2012 14:50'!
navigationKey: event
	"Check for tab key activity and change focus as appropriate.
	Check for menu key to do popup.
	Check for active window naviagation."

	(self world navigationKey: event) ifTrue: [^true].
	(self tabKey: event) ifTrue: [^true].
	(event keyCharacter = Character escape and: [
			event anyModifierKeyPressed]) ifTrue: [
		^ self yellowButtonActivity: false].
	^false! !

!SystemWindow methodsFor: 'dropping/grabbing' stamp: 'CamilloBruni 10/21/2012 16:41'!
aboutToBeGrabbedBy: aHand	
	super aboutToBeGrabbedBy: aHand.	
	self valueOfProperty: #clickPoint ifPresentDo: [:firstClick | 
		self position: aHand position + (self position - firstClick).
		self removeProperty: #clickPoint]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 6/14/2007 14:39'!
addPaneSplitters
	"Add the vertical and horizontal pane splitters."
	
	self removePaneSplitters.
	self addPaneVSplitters.
	self addPaneHSplitters.
	self linkSplittersToSplitters! !

!SystemWindow methodsFor: 'menu building' stamp: 'SeanDeNigris 6/14/2013 02:38'!
discoveredMenuPragmaKeyword

	^ 'windowMenu'.! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'di 5/20/1998 08:25'!
collapsedFrame
	^ collapsedFrame! !

!SystemWindow methodsFor: 'open/close' stamp: 'CamilloBruni 9/21/2012 13:55'!
close
	^ self delete! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/29/2009 11:53'!
setStripeColorsFrom: paneColor 
	"Set the stripe color based on the given paneColor.
	Removed box color update for Pharo compatability."

	stripes ifNil: [^self].
	self fillStyle: self fillStyleToUse.
	self isActive 
		ifTrue: [label ifNotNil: [label color: self activeLabelFillStyle].
				labelArea fillStyle: self activeTitleFillStyle] 
		ifFalse: [label ifNotNil: [label color: self inactiveLabelFillStyle].
				labelArea fillStyle: self inactiveTitleFillStyle].
	self adoptPaneColor: self paneColor! !

!SystemWindow methodsFor: 'events' stamp: 'jmv 2/19/2006 14:54'!
secondaryPaneTransition: event divider: aMorph
	"Mouse has entered or left a pane"! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'di 5/19/1998 09:34'!
isCollapsed
	^ isCollapsed! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/16/2007 12:24'!
modalOwner
	"Answer the modal owner of the receiver, if any."

	^self valueOfProperty: #modalOwner! !

!SystemWindow methodsFor: 'testing' stamp: 'CamilleTeruel 3/6/2013 14:57'!
isDisplayed
	" Answer true if I am currently displayed in the World"
	
	^ self world notNil! !

!SystemWindow methodsFor: 'panes' stamp: 'StephaneDucasse 12/21/2012 18:23'!
addMorph: aMorph frame: rectangle
	
	^ self addMorph: aMorph fullFrame: rectangle 

! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'MarcusDenker 12/11/2009 07:42'!
layoutChanged
	"No need to propagate to the world.
	Fixed to always flush layout cache."

	(self owner isNil or: [self owner isWorldMorph not])
		ifTrue: [^super layoutChanged].
	fullBounds := nil.
	self layoutPolicy ifNotNil: [:layout | layout flushLayoutCache]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'AlainPlantec 1/7/2010 22:46'!
getRawLabel
	"Answer a shallowCopy of the label with the contents fitted."
	
	|contentsFit|
	contentsFit := label shallowCopy fitContents.
	contentsFit extent: (label extent x min: contentsFit extent x) @ contentsFit extent y.
	^contentsFit! !

!SystemWindow methodsFor: 'top window' stamp: 'sw 5/10/1999 15:42'!
activateAndForceLabelToShow
	self activate.
	bounds top < 0 ifTrue:
		[self position: (self position x @ 0)]! !

!SystemWindow methodsFor: 'menu actions' stamp: 'AlainPlantec 4/14/2010 15:01'!
changeColor
	"Change the color of the receiver -- triggered, e.g. from a menu.  This variant allows the recolor triggered from the window's halo recolor handle to have the same result as choosing change-window-color from the window-title menu"
	self setWindowColor ! !

!SystemWindow methodsFor: 'menu actions' stamp: 'RAA 6/12/2000 09:01'!
offerWindowMenu
	| aMenu |
	aMenu := self buildWindowMenu.
	model ifNotNil:
		[model addModelItemsToWindowMenu: aMenu].
	aMenu popUpEvent: self currentEvent in: self world! !

!SystemWindow methodsFor: 'menu actions' stamp: 'BenComan 3/1/2014 20:33'!
sendToBack
    "Relies on #submorphs array being ordered top to bottom."
	| otherSystemWindows |
	otherSystemWindows := self world submorphs select: [ :morph | morph isSystemWindow and: morph ~~ self ].
	otherSystemWindows ifNotEmpty: 
	[	otherSystemWindows first activate.
		self world addMorph: self behind: otherSystemWindows last. 
	].! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 6/27/2007 10:38'!
minimize
	"Minimise the receiver."

	self isMinimized ifFalse: [self collapseBoxHit]! !

!SystemWindow methodsFor: 'open/close' stamp: 'MarianoMartinezPeck 8/24/2012 15:30'!
initialExtent
	^ (self model respondsTo: #initialExtent)
		ifTrue: [self model initialExtent]
		ifFalse: [RealEstateAgent standardWindowExtent]! !

!SystemWindow methodsFor: 'top window' stamp: 'sw 5/20/2001 22:32'!
adjustBorderUponActivationWhenLabeless
	"Adjust the border upon, um, activation when, um, labelless"

	| aWidth |
	(aWidth := self valueOfProperty: #borderWidthWhenActive) ifNotNil:
		[self acquireBorderWidth: aWidth]! !

!SystemWindow methodsFor: 'announcement' stamp: 'Alexandre.Bergel 5/11/2009 18:13'!
announcer
	^ announcer ifNil: [ announcer := Announcer new ]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/16/2007 12:30'!
taskbarButtonClicked
	"The taskbar button for the receiver has been clicked.
	If minimised then restore.
	If active then minimize.
	Otherwise make active."

	self isMinimized
		ifTrue: [self restore]
		ifFalse: [self isActive
					ifTrue: [self minimize]
					ifFalse: [self activate]]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 3/14/2007 12:57'!
labelArea
	"Answer the label area."

	^labelArea! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'nice 3/5/2010 22:41'!
minimizeAfterGeneratingThumbnail
	"Minimize the window after thumbnail generation."
	
	self isMinimized ifTrue: [^self].
	isCollapsed := true.
	paneMorphs
		do: [:m | m delete; releaseCachedState].
	self setBoundsWithFlex: (-10 @ -10 extent: 2 @ 2).
	self hide.
	self layoutChanged
	! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'nice 1/5/2010 15:59'!
paneWithLongestSide: sideBlock near: aPoint 
	| thePane theSide theLen |
	theLen := 0.
	paneMorphs do:
		[:pane | | box | box := pane bounds.
		box forPoint: aPoint closestSideDistLen:
			[:side :dist :len |
			(dist <= 5 and: [len > theLen]) ifTrue:
				[thePane := pane.
				theSide := side.
				theLen := len]]].
	sideBlock value: theSide.
	^ thePane! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 9/4/2007 13:42'!
rememberedKeyboardFocus
	"Answer the remembered keyboard focus for the receiver."
	
	^self valueOfProperty: #rememberedFocus! !

!SystemWindow methodsFor: 'accessing' stamp: 'AlainPlantec 12/14/2009 21:05'!
embeddable: aBoolean
	embeddable := aBoolean! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'AlainPlantec 4/14/2010 15:00'!
setWindowColor: incomingColor
	"Removed existing color check - looked useless!!"
	
	| aColor |
	incomingColor ifNil: [^ self].  "it happens"
	aColor := incomingColor.
	self setProperty: #paneColor toValue: aColor.
	self setStripeColorsFrom: aColor.
	self theme settings fadedBackgroundWindows 
		ifFalse: [self adoptPaneColor: aColor]. "reverse optimisation"
	self changed.! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/11/2007 12:05'!
nextMorphInWindow
	"Answer the next morph in the window. Traverse
	from the receiver to its first pane."

	^self hasSubmorphs
		ifTrue: [self submorphs first]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'AlainPlantec 12/15/2009 10:48'!
animateRestoreFromMinimized
	"Animate restoring from minimised."
	
	|tb buttonRect restoredRect rects steps|
	tb := self worldTaskbar ifNil: [^self].
	buttonRect := ((tb taskButtonOf: self) ifNil: [^self]) bounds.
	restoredRect := self isFlexed
		ifTrue: [(owner transform
					globalPointToLocal: fullFrame topLeft)
					extent: fullFrame extent]
		ifFalse: [fullFrame].
	steps := self theme settings animationSettings numberOfSteps.
	rects := (1/steps to: 1 by: 1/steps) collect: [:x |
		buttonRect interpolateTo: restoredRect at: (20 raisedTo: x) - 1 / 19].
	self fastAnimateRectangles: rects! !

!SystemWindow methodsFor: 'events' stamp: 'MarcusDenker 9/8/2011 15:48'!
mouseDown: evt
	"Changed to properly process the mouse down event if passing to
	submorphs."
	
	(self valueOfProperty: #processingMouseDown) == true
		ifTrue: [^self]. "recursive handling"
	self isEmbedded ifTrue: [^self].
	evt hand waitForClicksOrDrag: self event: evt. "allow double-click response"
	self setProperty: #clickPoint toValue: evt cursorPoint.
	TopWindow == self
		ifTrue: [self comeToFront] "rise above non-window morphs"
		ifFalse:[
			TopWindow ifNotNil: [:w |
			w rememberKeyboardFocus: evt hand keyboardFocus].
		evt hand releaseKeyboardFocus.
		self activate.
		self announce: (WindowActivated new 
							event: evt;
							window: self; 
							yourself).
].
	self setProperty: #processingMouseDown toValue: true.
		[evt wasHandled: false.
		self processEvent: evt]
			ensure: [self setProperty: #processingMouseDown toValue: false]! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'Alexandre.Bergel 8/8/2009 13:18'!
expand
	self isCollapsed ifTrue:[self collapseOrExpand].
! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 10/1/2007 14:43'!
addGrips
	"Add the edge and corner grips."
	
	self
		addCornerGrips;
		addEdgeGrips! !

!SystemWindow methodsFor: 'initialization' stamp: 'IgorStasenko 12/19/2012 18:15'!
addCloseBox
	"If I have a labelArea, add a close box to it"
	| frame |
	labelArea
		ifNil: [^ self].
	closeBox := self createCloseBox.
	frame := LayoutFrame identity leftOffset: 2.
	closeBox layoutFrame: frame.
	labelArea addMorphBack: closeBox! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 2/9/2009 17:09'!
themeChanged
	"Update the window colour and control boxes."

	self labelArea delete.
	self removeGrips.
	self theme
		configureWindowBorderFor: self;
		configureWindowDropShadowFor: self.
	self paneColor: self defaultBackgroundColor.
	label ifNotNil: [ "don't if label area removed"
		self initializeLabelArea].
	self setStripeColorsFrom: self paneColor.
	(self isCollapsed not or: [self isTaskbarPresent]) ifTrue: [
		self addGripsIfWanted].
	super themeChanged! !

!SystemWindow methodsFor: 'testing' stamp: 'jam 3/9/2003 15:13'!
isSystemWindow
"answer whatever the receiver is a SystemWindow"
	^ true! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'IgorStasenko 12/20/2012 15:09'!
addPaneHSplitterBetween: topMorphs and: bottomMorphs
	"Add a horizontal splitter for the given morphs that share a common bottom fraction.
	If there is a horizontal discontinuity apply the splitter to the first contiguous group.
	Answer the morphs to which the splitter was applied."
	
	|targetY fixed rightFraction leftFrame rightFrame sorted morph topGroup bottomGroup splitter offset|
	topMorphs ifEmpty: [^self].
	targetY := topMorphs first layoutFrame bottomFraction.
	fixed := topMorphs select: [:m | m layoutFrame topFraction = m layoutFrame bottomFraction].
		"fixed morphs appear in both top and bottom"
	sorted := ((topMorphs reject: [:m | m layoutFrame topFraction = m layoutFrame bottomFraction])
		asSortedCollection: [:a :b | a layoutFrame rightFraction = b layoutFrame rightFraction
			ifTrue: [a layoutFrame leftFraction <= b layoutFrame leftFraction]
			ifFalse: [a layoutFrame rightFraction <= b layoutFrame rightFraction]]) readStream.
	sorted contents ifEmpty: [^fixed].
	topGroup := OrderedCollection new.
	rightFraction := sorted contents first layoutFrame leftFraction.
	[sorted atEnd or: [morph := sorted next.
			(morph layoutFrame leftFraction ~= rightFraction and: [
				morph layoutFrame rightFraction ~= rightFraction])]] whileFalse: [
		topGroup add: morph.
		rightFraction := morph layoutFrame rightFraction].
	leftFrame := topGroup first layoutFrame.
	rightFrame := topGroup last layoutFrame.
	bottomGroup := (bottomMorphs 
			reject: [:m | m layoutFrame topFraction = m layoutFrame bottomFraction])
			select: [:m |
		(m layoutFrame leftFraction
			between: leftFrame leftFraction
			and: rightFrame rightFraction) or: [
		m layoutFrame rightFraction
			between: leftFrame leftFraction
			and: rightFrame rightFraction]].
	offset := (topGroup collect: [:m | m layoutFrame bottomOffset ]) max.
	splitter := ProportionalSplitterMorph new beSplitsTopAndBottom.
	splitter layoutFrame: ((leftFrame leftFraction @ targetY corner: rightFrame rightFraction @ targetY) asLayoutFrame 
									leftOffset: leftFrame leftOffset ;
									topOffset: offset;
									rightOffset: rightFrame rightOffset;
									bottomOffset: 4 + offset).
	topGroup := topGroup, fixed.
	topGroup do: [:m | splitter addLeftOrTop: m].
	bottomGroup do: [:m | splitter addRightOrBottom: m].
	self addMorphBack: splitter.
	^topGroup! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/31/2009 15:54'!
taskbarTask
	"Answer a new taskbar task for the receiver.
	Answer nil if not required."

	(self valueOfProperty: #noTaskbarTask ifAbsent: [false]) ifTrue: [^nil].
	^TaskbarTask
		morph: self
		state: self taskbarState
		icon: self taskbarIcon
		label: self taskbarLabel! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 10/1/2007 14:51'!
addEdgeGrips
	"Should add these to the front!!"
	
	|t l r lh|
	lh := self labelHeight.
	t  := WindowEdgeGripMorph new target: self; position: self position; edgeName: #top.
	t layoutFrame
		topOffset: lh negated;
		bottomOffset: lh negated + self class borderWidth.
	l  := WindowEdgeGripMorph new target: self; position: self position; edgeName: #left.
	l layoutFrame topOffset: lh negated + 22.
	r  := WindowEdgeGripMorph new target: self; position: self position; edgeName: #right.
	r layoutFrame topOffset: lh negated + 22.
	self
		addMorph: t;
		addMorph: l;
		addMorph: r;
		addMorph: (WindowEdgeGripMorph new target: self;position: self position; edgeName: #bottom)! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/24/2007 13:58'!
basicTaskThumbnailOfSize: thumbExtent
	"Answer a new task thumbnail for the receiver."
	
	^super taskThumbnailOfSize: thumbExtent! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 7/30/2009 13:56'!
addMenuControl
	"If I have a label area, add a menu control to it."

	labelArea ifNil: [^ self]. "No menu if no label area"
	menuBox
		ifNotNil: [menuBox delete].
	labelArea addMorphBack: (menuBox := self createMenuBox)! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 7/30/2007 15:59'!
inactiveTitleFillStyle
	"Return the inactive title fillStyle for the receiver."
	
	^self theme windowInactiveTitleFillStyleFor: self! !

!SystemWindow methodsFor: 'menu building' stamp: 'SeanDeNigris 6/14/2013 03:09'!
menuBuilder

	^ menuBuilder ifNil: [ menuBuilder := PragmaMenuBuilder pragmaKeyword: self discoveredMenuPragmaKeyword model: self ].! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'BenjaminVanRyseghem 12/10/2013 22:17'!
canBeMaximized
	"Answer whether we are not we can be maximised."

	^ self isResizeable and: [ self isNotMaximized ]! !

!SystemWindow methodsFor: 'events' stamp: 'GaryChambers 6/9/2011 13:35'!
handlesMouseDown: evt 
	"If I am not the topWindow, then I will only respond to dragging by the title bar.
	Any other click will only bring me to the top"

	self isEmbedded ifTrue: [^false].
	(self labelRect containsPoint: evt cursorPoint)
		ifTrue: [^ true].
	^ self activeOnlyOnTop and: [self ~~ TopWindow]! !

!SystemWindow methodsFor: 'geometry' stamp: 'Alexandre Bergel 1/13/2010 10:36'!
position: newPos
	| oldPos |
	isCollapsed
		ifTrue: [ oldPos := collapsedFrame origin ]
		ifFalse: [ oldPos := fullFrame origin ].

	super position: newPos.
	isCollapsed
		ifTrue: [collapsedFrame := self bounds]
		ifFalse: [fullFrame := self bounds].

	(oldPos ~= newPos)
		ifTrue: [ self announce: 
					(WindowMoved new 
						oldPosition: oldPos;
						newPosition: newPos;
						window: self)]
! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'SeanDeNigris 11/30/2011 14:23'!
fullscreen
	"Zoom Window to Full World size with possible DeskMargins"
	"SystemWindow fullscreen"

	self bounds: self fullscreenBounds! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 6/27/2007 10:05'!
playRestoreUpSound
	"Play the themed sound for restoring from minimized."
	
	self theme windowRestoreUpSound play! !

!SystemWindow methodsFor: 'drawing' stamp: 'ar 12/18/2001 02:09'!
scrollBarColor
	^self paneColor! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/16/2007 11:01'!
isMinimized
	"Answer whether we are minimised."

	^self isCollapsed! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/24/2007 13:58'!
taskThumbnailOfSize: thumbExtent
	"Answer a new task thumbnail for the receiver."
	
	|min thumb|
	min := self isMinimized
		ifTrue: [self restoreBeforeGeneratingThumbnail.
				true]
		ifFalse: [false].
	thumb := self basicTaskThumbnailOfSize: thumbExtent.
	min ifTrue: [self minimizeAfterGeneratingThumbnail].
	^thumb! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 9/6/2007 12:59'!
removeExpandBox
	"Remove the expand box."

	expandBox ifNotNil: [expandBox delete. expandBox := nil]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'GaryChambers 6/10/2011 12:02'!
isActive
	"Answer active if no owner too to avoid color flickering."
	
	self owner ifNil: [^true].
	self activeOnlyOnTop ifTrue: [^self owner isWindowActive: self].
	^ true! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 2/6/2009 12:26'!
toggleVisibleAndRaise
	"Toggle the visibility of the receiver, bringing to
	the front if becoming visible. Activate or passivate here."

	self isActive ifTrue: [self world navigateVisibleWindowForward].
	super toggleVisibleAndRaise.
	self visible ifTrue: [self activate]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 5/7/2008 11:42'!
beWithGrips
	"Add the grips and set a property to
	indicate that grips are wanted."

	self removeProperty: #noGrips.
	(self isCollapsed not or: [self isTaskbarPresent]) ifTrue: [
		self addGripsIfWanted]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 2/26/2010 12:54'!
basicIsSticky
	"Answer the super isSticky."

	^super isSticky! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 6/14/2007 13:44'!
addPaneHSplitters
	"Add the horizontal pane splitters."

	|remaining targetBottom sameBottom sameTop|
	remaining := paneMorphs reject: [:each |
			each layoutFrame bottomFraction = 1 or: [
				each layoutFrame bottomFraction = 0]].
	[remaining notEmpty] whileTrue: [
		targetBottom := remaining first layoutFrame bottomFraction.
		sameBottom := remaining select: [:each |
			each layoutFrame bottomFraction = targetBottom].
		sameTop := paneMorphs select: [:each |
			each layoutFrame topFraction = targetBottom].
		remaining := remaining
			copyWithoutAll: (self addPaneHSplitterBetween: sameBottom and: sameTop)]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'MarcusDenker 12/2/2013 14:11'!
modalUnlockFrom: aSystemWindow
	"Unlock the receiver as a modal owner of the given window."

	aSystemWindow removeProperty: #modalOwner.
	self removeProperty: #modalChild.
	closeBox ifNotNil: [:cl | cl enabled: (self valueOfProperty: #preModalCloseEnabled ifAbsent: [true])].
	self removeProperty: #preModalCloseEnabled.
	self activate! !

!SystemWindow methodsFor: 'initialization' stamp: 'jlb 5/29/2001 23:24'!
maximumExtent: aPoint
	"This returns the maximum extent that the morph may be expanded to.
	Return nil if this property has not been set."

	^ self setProperty: #maximumExtent toValue: aPoint! !

!SystemWindow methodsFor: 'drawing' stamp: 'ar 8/15/2001 21:55'!
colorForInsets
	^self paneColor colorForInsets! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 5/15/2007 17:16'!
hasExpandBox
	"Answer whether the receiver currently has an expand box."

	^expandBox notNil! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'MarcusDenker 7/23/2014 11:57'!
showAbout

	self theme  
		longMessageIn: self
		text: self aboutText
		title: self aboutTitle! !

!SystemWindow methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 3/22/2013 16:02'!
addLabelArea

	labelArea :=self theme newWindowHeaderFor: self.
	self addMorph: labelArea.! !

!SystemWindow methodsFor: 'initialization' stamp: 'jlb 5/29/2001 23:24'!
maximumExtent
	"This returns the maximum extent that the morph may be expanded to.
	Return nil if this property has not been set."

	^ self valueOfProperty: #maximumExtent! !

!SystemWindow methodsFor: 'events' stamp: 'sw 12/22/1999 18:31'!
wantsHalo
	^ false! !

!SystemWindow methodsFor: 'open/close' stamp: 'sw 10/15/1998 11:13'!
positionSubmorphs
	"Feels like overkill, but effect needed"
	super positionSubmorphs.
	self submorphsDo:
		[:aMorph | aMorph positionSubmorphs]! !

!SystemWindow methodsFor: 'initialization' stamp: 'MarcusDenker 2/21/2010 09:33'!
applyModelExtent
	self extent: model initialExtent ! !

!SystemWindow methodsFor: 'compatibility' stamp: 'BenjaminVanRyseghem 8/2/2012 16:12'!
hasUnacceptedEdits 

	^ (self submorphs select: [:e | e respondsTo: #hasUnacceptedEdits ]) anySatisfy: [:e | e hasUnacceptedEdits ]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 6/2/2009 10:35'!
wantsRoundedCorners
	"Answer whether rounded corners are wanted."
	
	^(self theme windowPreferredCornerStyleFor: self) == #rounded! !

!SystemWindow methodsFor: 'thumbnail' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
icon
	"Answer a form with an icon to represent the receiver"
	^ Smalltalk ui icons windowIcon! !

!SystemWindow methodsFor: 'menu actions' stamp: 'dgd 9/18/2004 18:27'!
wantsYellowButtonMenu
	"Answer true if the receiver wants a yellow button menu"
	^ false! !

!SystemWindow methodsFor: 'top window' stamp: 'di 5/14/1998 11:49'!
activeOnlyOnTop
	^ activeOnlyOnTop ifNil: [false]! !

!SystemWindow methodsFor: 'panes' stamp: 'sw 10/19/1999 09:53'!
updatablePanes
	"Answer the list of panes, in order, which should be sent the #verifyContents message"
	^ updatablePanes ifNil: [updatablePanes := #()]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 6/27/2007 10:06'!
playRestoreDownSound
	"Play the themed sound for restoring from maximized."
	
	self theme windowRestoreDownSound play! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'di 10/28/1999 14:15'!
setBoundsWithFlex: newFrame
	"Set bounds from newFrame with origin preserved from global coordinates"

	self isFlexed
		ifTrue: [super bounds: ((owner transform globalPointToLocal: newFrame topLeft)
										extent: newFrame extent)]
		ifFalse: [super bounds: newFrame].! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 10/22/2008 12:20'!
createMenuBox
	"Answer a button for the window menu."
	
	^self theme createMenuBoxFor: self! !

!SystemWindow methodsFor: 'geometry' stamp: 'sma 2/5/2000 14:09'!
panelRect
	"Answer the area below the title bar which is devoted to panes."

	^ self innerBounds insetBy: (0 @ self labelHeight corner: 0 @ 0)! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/21/2009 16:27'!
modalLockTo: aSystemWindow
	"Lock the receiver as a modal owner of the given window."

	aSystemWindow
		setProperty: #modalOwner toValue: self.
	self setProperty: #modalChild toValue: aSystemWindow.
	(closeBox respondsTo: #enabled) ifTrue: [
		self setProperty: #preModalCloseEnabled toValue: closeBox enabled].
	(closeBox respondsTo: #enabled:) ifTrue: [
		closeBox enabled: false]! !

!SystemWindow methodsFor: 'open/close' stamp: 'janniLaval 6/11/2010 23:44'!
openInWorld: aWorld
	"This msg and its callees result in the window being activeOnlyOnTop"
	self bounds: (RealEstateAgent initialFrameFor: self world: aWorld).
	^self openAsIsIn: aWorld.
! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'di 10/22/1998 22:55'!
reframePanesAdjoining: growingPane along: side to: aDisplayBox 
	| delta newRect minDim theMin horiz |
	growingPane ifNil: [^ self].  "As from click outside"
	newRect := aDisplayBox.
	horiz := #(left right) includes: side.
	theMin := horiz ifTrue: [40] ifFalse: [20].

	"First check that this won't make any pane smaller than theMin screen dots"
	minDim := (((paneMorphs select: [:pane | pane bounds bordersOn: growingPane bounds along: side])
		collect: [:pane | pane bounds adjustTo: newRect along: side]) copyWith: aDisplayBox)
			inject: 999 into:
				[:was :rect | was min: (horiz ifTrue: [rect width] ifFalse: [rect height])].
	"If so, amend newRect as required"
	minDim > theMin ifFalse:
		[delta := minDim - theMin.
		newRect := newRect withSide: side setTo: 
				((newRect perform: side) > (growingPane bounds perform: side)
					ifTrue: [(newRect perform: side) + delta]
					ifFalse: [(newRect perform: side) - delta])].

	"Now adjust all adjoining panes for real"
	paneMorphs do:
		[:pane | (pane bounds bordersOn: growingPane bounds along: side) ifTrue:
			[pane bounds: (pane bounds adjustTo: newRect along: side)]].
	"And adjust the growing pane itself"
	growingPane bounds: newRect.

	"Finally force a recomposition of the whole window"
	self setPaneRectsFromBounds.
	self extent: self extent! !

!SystemWindow methodsFor: 'panes' stamp: 'bvs 3/17/2004 09:15'!
paneColor: aColor
	self setProperty: #paneColor toValue: aColor.

	self adoptPaneColor: aColor.! !

!SystemWindow methodsFor: 'panes' stamp: 'ar 8/15/2001 22:14'!
paneColorToUse
	^ Display depth <= 2
		ifTrue:
			[Color white]
		ifFalse:
			[self paneColor]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'MarcusDenker 9/8/2011 15:48'!
mouseMove: evt
	"Handle a mouse-move event"

	| cp |
	cp := evt cursorPoint.
	self valueOfProperty: #clickPoint ifPresentDo: 
		[:firstClick |
		((self labelRect containsPoint: firstClick) and: [(cp dist: firstClick) > 3]) ifTrue:
		["If this is a drag that started in the title bar, then pick me up"
		^self basicIsSticky ifFalse:
			[self fastFramingOn 
				ifTrue: [self doFastFrameDrag: firstClick]
				ifFalse: [evt hand grabMorph: self topRendererOrSelf]]]].
	submorphs do: [:m | (m containsPoint: cp) ifTrue: [m mouseMove: evt]]! !

!SystemWindow methodsFor: 'events' stamp: 'ar 1/31/2001 21:02'!
handlesMouseOverDragging: evt
	^true! !

!SystemWindow methodsFor: 'events' stamp: 'RAA 2/7/2001 07:11'!
handleListenEvent: evt
	"Make sure we lock our contents after DnD has finished"
	evt isMouse ifFalse:[^self].
	evt hand hasSubmorphs ifTrue:[^self]. "still dragging"
	self == TopWindow ifFalse:[self lockInactivePortions].
	evt hand removeMouseListener: self.! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 5/25/2007 16:33'!
removeBoxes
	"Remove all label area boxes."

	closeBox ifNotNil: [closeBox delete. closeBox := nil].
	menuBox ifNotNil: [menuBox delete. menuBox := nil].
	expandBox ifNotNil: [expandBox delete. expandBox := nil].
	collapseBox ifNotNil: [collapseBox delete. collapseBox := nil]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 5/7/2008 11:35'!
addGripsIfWanted
	"Add the edge and corner grips if the window wants them."
	
	self wantsGrips ifTrue: [self addGrips]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/16/2007 11:01'!
isNotMaximized
	"Answer whether we are not maximised."

	^self unexpandedFrame isNil! !

!SystemWindow methodsFor: 'label' stamp: 'MarianoMartinezPeck 8/24/2012 15:31'!
update: aSymbol
	aSymbol = #relabel
		ifTrue: [^ model ifNotNil: [ self setLabel: model labelString ] ].
	aSymbol = #close
		ifTrue: [self delete]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 5/15/2007 17:16'!
hasCloseBox
	"Answer whether the receiver currently has a close box."

	^closeBox notNil! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 9/6/2007 12:58'!
removeCloseBox
	"Remove the close box."

	closeBox ifNotNil: [closeBox delete. closeBox := nil]! !

!SystemWindow methodsFor: 'layout' stamp: 'sw 5/18/2001 16:09'!
putLabelItemsInLabelArea
	"Put label items into the label area, if there is one"

	labelArea ifNotNil:
		[stripes ifNotNil: [stripes do: [:stripe | labelArea addMorph: stripe]].
		closeBox ifNotNil: [labelArea addMorph: closeBox].
		menuBox ifNotNil: [labelArea addMorph: menuBox].
		collapseBox ifNotNil: [labelArea addMorph: collapseBox].
		label ifNotNil: [labelArea addMorph: label]]

! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'AlainPlantec 12/15/2009 10:46'!
fastAnimateRectangles: rects
	"Animate the given rectangles using the fast method."
	
	|delay col merged|
	rects ifEmpty: [^self].
	delay := Delay forMilliseconds: (self theme settings animationSettings delay).
	col := Color gray alpha: 0.5.
	merged := rects first.
	rects withIndexDo: [:r :i |
		Display
			border: r rounded
			width: 1
			rule: Form blend
			fillColor: col.
		merged := merged merge: r.
		delay wait].
	merged := merged expandBy: 1.
	World invalidRect: merged from: self! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'GaryChambers 2/15/2011 12:40'!
paneColor

	"Answer the basic pane color that should be used."
	
	^self theme paneColorFor: self! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/16/2007 11:03'!
isRestored
	"Answer whether we are neither expanded or collapsed."

	^(self isMinimized or: [self isMaximized]) not! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 6/14/2007 14:45'!
linkSplittersToSplitters
	"The pane morphs are already linked. Cross link the splitters as appropriate."
	
	self splitters do: [:each |
		each splitsTopAndBottom
			ifTrue: [self splitters do: [:eachMorph |
					eachMorph splitsTopAndBottom ~= each splitsTopAndBottom ifTrue: [
						eachMorph layoutFrame bottomFraction = each layoutFrame topFraction
							ifTrue: [each addLeftOrTop: eachMorph].
						eachMorph layoutFrame topFraction = each layoutFrame bottomFraction
							ifTrue: [each addRightOrBottom: eachMorph]]]]
			ifFalse: [self splitters do: [:eachMorph |
					eachMorph splitsTopAndBottom ~= each splitsTopAndBottom ifTrue: [
						eachMorph layoutFrame rightFraction = each layoutFrame leftFraction
							ifTrue: [each addLeftOrTop: eachMorph].
						eachMorph layoutFrame leftFraction = each layoutFrame rightFraction
							ifTrue: [each addRightOrBottom: eachMorph]]]]]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/20/2009 17:44'!
drawDropShadowOn: aCanvas
	"Get the theme to draw the drop shawdow for the receiver."
	
	|dropAreas|
	dropAreas := self areasRemainingToFill: (self bounds expandBy: self shadowOffsetRectangle).
	(dropAreas anySatisfy: [:rect | aCanvas isVisible: rect])
		ifFalse: [^self]. "no need to draw since no intersection"
	self isActive
		ifTrue: [self theme
					drawWindowActiveDropShadowFor: self
					on: aCanvas]
		ifFalse: [self theme
					drawWindowInactiveDropShadowFor: self
					on: aCanvas]! !

!SystemWindow methodsFor: 'panes' stamp: 'sw 12/21/1998 23:24'!
titleAndPaneText
	"If the receiver represents a workspace, return an Association between the title and that text, else return nil"
	(paneMorphs size ~~ 1 or: [(paneMorphs first isKindOf: PluggableTextMorph) not])
		ifTrue: [^ nil].
	^ labelString -> paneMorphs first text

! !

!SystemWindow methodsFor: 'stepping' stamp: 'StephaneDucasse 7/18/2010 16:32'!
wantsSteps
	"Return true if the model wants its view to be stepped.  For an open system window, we give the model to offer an opinion"

	^ isCollapsed not and: [model wantsStepsIn: self]! !

!SystemWindow methodsFor: 'events' stamp: 'AlainPlantec 12/14/2009 21:06'!
wantsToBeDroppedInto: aMorph
	"Return true if it's okay to drop the receiver into aMorph"
	^ aMorph isWorldMorph or: [self embeddable]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 4/16/2007 10:59'!
isMaximized
	"Answer whether we are maximised."

	^self unexpandedFrame notNil! !

!SystemWindow methodsFor: 'accessing' stamp: 'HilaireFernandes 6/13/2010 16:49'!
embeddable
	^ embeddable ifNil: [embeddable := false]! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 9/7/2007 20:01'!
isTaskbarPresent
	"Answer whether there is a taskbar in the world."

	^self worldTaskbar notNil! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'gvc 10/17/2006 10:26'!
justDroppedInto: aMorph event: anEvent
	"Release the mouse focus as well."
	
	isCollapsed
		ifTrue: [self position: ((self position max: 0@0) grid: 8@8).
				collapsedFrame := self bounds]
		ifFalse: [fullFrame := self bounds.
				TopWindow ~~ self ifTrue: [self activate]].
	anEvent hand releaseMouseFocus.
	^super justDroppedInto: aMorph event: anEvent! !

!SystemWindow methodsFor: '*Polymorph-Widgets' stamp: 'SeanDeNigris 11/28/2011 21:53'!
animateMaximize
	"Animate maximizing from restored."
	
	|expandedRect restoredRect rects steps|
	expandedRect := self fullscreenBounds.
	restoredRect := self bounds.
	steps := self theme settings animationSettings numberOfSteps.
	rects := (1/steps to: 1 by: 1/steps) collect: [:x |
		restoredRect interpolateTo: expandedRect at: (20 raisedTo: x) - 1 / 19].
	self fastAnimateRectangles: rects! !

!SystemWindow class methodsFor: 'instance creation' stamp: 'MarcusDenker 2/18/2010 15:58'!
labelled: labelString
	^self new setLabel: labelString! !

!SystemWindow class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
taskbarIcon
	"Answer the icon for the receiver in a task bar."

	^ Smalltalk ui icons smallWindowIcon! !

!SystemWindow class methodsFor: 'top window' stamp: 'sw 1/4/2000 15:22'!
wakeUpTopWindowUponStartup
	TopWindow ifNotNil:
		[TopWindow isCollapsed ifFalse:
			[TopWindow model ifNotNil:
				[TopWindow model modelWakeUpIn: TopWindow]]]! !

!SystemWindow class methodsFor: 'initializing' stamp: 'jrp 7/31/2005 12:30'!
expandBoxImage

	^ (Form
	extent: 10@10
	depth: 32
	fromArray: #( 3875602689 3875602689 3875602689 3875602689 3875602689 3875602689 0 0 0 0 3875602689 0 0 0 0 4127260929 3877181721 3877181721 3875602689 0 3875602689 0 0 0 0 3875602689 3212869760 0 3875602689 3212869760 3875602689 0 0 0 0 3875602689 3212869760 0 3875602689 3212869760 3875602689 0 0 0 0 3875602689 3212869760 0 3875602689 3212869760 3875602689 4127260929 3875602689 3875602689 3875602689 3875602689 3212869760 0 3875602689 3212869760 0 3877181721 3212869760 3212869760 3212869760 3212869760 3212869760 0 3875602689 3212869760 0 3877181721 0 0 0 0 0 0 3875602689 3212869760 0 3875602689 3875602689 3875602689 3875602689 3875602689 3875602689 3875602689 3875602689 3212869760 0 0 3212869760 3212869760 3212869760 3212869760 3212869760 3212869760 3212869760 3212869760)
	offset: 0@0)! !

!SystemWindow class methodsFor: 'top window' stamp: 'rr 3/10/2006 14:19'!
topWindow
	^ TopWindow! !

!SystemWindow class methodsFor: 'top window' stamp: 'MarianoMartinezPeck 12/27/2009 18:16'!
closeTopWindow
	"Try to close the top window.  It may of course decline"
	TopWindow ifNotNil:
		[TopWindow delete]! !

!SystemWindow class methodsFor: '*Polymorph-Widgets' stamp: 'gvc 3/2/2010 15:16'!
passivateTopWindow
	"Make no window the top window."

	|oldTop|
	oldTop := TopWindow.
	TopWindow := nil.
	oldTop ifNotNil: [
		oldTop
			rememberKeyboardFocus: ActiveHand keyboardFocus;
			passivate]! !

!SystemWindow class methodsFor: 'initializing' stamp: 'jrp 7/31/2005 13:21'!
collapseBoxImage
	"Supplied here because we don't necessarily have ComicBold"

	^ CollapseBoxImage ifNil: [ CollapseBoxImage := (Form
	extent: 10@10
	depth: 32
	fromArray: #( 0 0 4127260929 4127260929 4127260929 4127260929 4127260929 0 0 0 0 3875602689 3212869760 3212869760 3212869760 3212869760 3212869760 4227924225 0 0 4127260929 3212869760 3212869760 0 0 0 0 3212869760 4127260929 0 4127260929 3212869760 0 0 0 0 0 0 4127260929 3212869760 4127260929 3212869760 0 0 0 0 0 0 4127260929 3212869760 4127260929 3212869760 0 0 0 0 0 0 4127260929 3212869760 4128708375 3212869760 0 0 0 0 0 0 4127260929 3212869760 0 4127260929 3212869760 0 0 0 0 4127260929 3208659008 3212869760 0 3208659008 4127260929 4127260929 4127260929 4127260929 4127260929 3208659008 3212869760 0 0 0 3212869760 3212869760 3212869760 3212869760 3212869760 3212869760 0 0)
	offset: 0@0)]! !

!SystemWindow class methodsFor: 'settings' stamp: 'SeanDeNigris 11/30/2011 14:27'!
fullscreenMargin
	^ FullscreenMargin ifNil: [FullscreenMargin := 25]! !

!SystemWindow class methodsFor: 'private-menu building' stamp: 'SeanDeNigris 6/14/2013 00:41'!
icons

	^ Smalltalk ui icons.! !

!SystemWindow class methodsFor: 'settings' stamp: 'SeanDeNigris 11/30/2011 14:27'!
fullscreenMargin: anInteger
	FullscreenMargin := anInteger! !

!SystemWindow class methodsFor: 'initializing' stamp: 'jrp 7/31/2005 13:28'!
menuBoxImage

	^ (Form
	extent: 10@10
	depth: 32
	fromArray: #( 4227858432 4127195136 4127195136 4127195136 4127195136 4127195136 4127195136 4127195136 4227858432 0 4127195136 3212869760 3212869760 3212869760 3212869760 3212869760 3212869760 3212869760 4127195136 3212869760 4127195136 3212869760 0 0 0 0 0 0 4127195136 3212869760 4127195136 4127195136 4127195136 4127195136 4127195136 4127195136 4127195136 4127195136 4127195136 3212869760 4127195136 3212869760 0 0 0 0 0 0 4127195136 3212869760 4127195136 3212869760 0 0 0 0 0 0 4127195136 3212869760 4227858432 4127195136 4127195136 4127195136 4127195136 4127195136 4127195136 4127195136 4127195136 3212869760 4127195136 3212869760 0 0 0 0 0 0 4127195136 3212869760 4227858432 4127195136 4127195136 4127195136 4127195136 4127195136 4127195136 4127195136 4227858432 3212869760 0 3212869760 3212869760 3212869760 3212869760 3212869760 3212869760 3212869760 3212869760 3212869760)
	offset: 0@0)! !

!SystemWindow class methodsFor: 'top window' stamp: 'GaryChambers 11/25/2010 16:17'!
noteTopWindowIn: aWorld
	"Activate the expected top window"
	
	aWorld ifNil: [^ self].
	aWorld submorphsDo: [:m |
		(m isSystemWindow and: [m isCollapsed not]) ifTrue: [
			^m activate]]! !

!SystemWindow class methodsFor: 'initializing' stamp: 'AlainPlantec 10/19/2009 18:13'!
initialize

	CollapseBoxImage := nil.
	CloseBoxImage := nil.
! !

!SystemWindow class methodsFor: 'top window' stamp: 'BenComan 2/28/2014 01:05'!
sendTopWindowToBack
 	"Send the top window of the world to the back. Relies on #submorphs array being ordered top to bottom. "
	ActiveWorld submorphs 
		detect: [ :morph | morph isSystemWindow ] 
		ifFound: [ :morph | morph sendToBack ].! !

!SystemWindow class methodsFor: '*Keymapping-Core' stamp: 'GuillermoPolito 8/10/2014 14:03'!
buildShortcutsOn: aBuilder
	<keymap>

	(aBuilder shortcut: #close)
		category: #WindowShortcuts
		default: PharoShortcuts current closeWindowShortcut
		do: [ :target | target close ]
		description: 'Close this window'.! !

!SystemWindow class methodsFor: 'initializing' stamp: 'jrp 7/30/2005 22:51'!
closeBoxImage
	"Supplied here because we don't necessarily have ComicBold"

	^ CloseBoxImage ifNil: [CloseBoxImage := (Form
	extent: 10@10
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 3326099520 3330310272 0 0 0 0 0 0 0 0 4144038145 3326099520 3330310272 0 0 0 4144038145 3326099520 0 0 0 4227924225 3326099520 3330310272 0 4144038145 3326099520 3330310272 0 0 0 0 4144038145 3326099520 4144038145 3326099520 3330310272 3336494814 0 0 0 0 0 4227924225 3326099520 3330310272 3336494814 0 0 0 0 0 4144038145 3326099520 4144038145 3326099520 3330310272 3336494814 0 0 0 4144038145 3326099520 3330310272 3336494814 4144038145 3326099520 3330310272 0 0 4144038145 3326099520 3330310272 3336494814 0 0 4144038145 3326099520 0 0 0 3330310272 3336494814 0 0 0 0 0 0)
	offset: 0@0)]! !

!SystemWindow class methodsFor: 'menu items' stamp: 'BernardoContreras 8/11/2014 19:12'!
windowMenuOn: aBuilder
	<windowMenu>

	| closableLabel draggableLabel maximizeLabel |
	(aBuilder item: #'Close')
		action: [ aBuilder model closeBoxHit ];
		icon: self icons windowCloseForm;
		enabledBlock: [ aBuilder model allowedToClose ];
		withSeparatorAfter.
	(aBuilder item: #'About')
		action: [ aBuilder model showAbout ];
		icon: Smalltalk ui icons smallHelpIcon;
		withSeparatorAfter.
	(aBuilder item: #'Change title...')
		action: [ aBuilder model relabel ];
		withSeparatorAfter.
	(aBuilder item: #'Send to back')
		action: [ aBuilder model sendToBack ].
	(aBuilder item: #'Make next-to-topmost')
		action: [ aBuilder model makeSecondTopmost ];
		withSeparatorAfter.
	(aBuilder item: #'Create window group')
		action: [ aBuilder model createWindowGroup ];
		withSeparatorAfter.
	aBuilder model mustNotClose
	    ifFalse: [ closableLabel := #'Make unclosable' ]
	    ifTrue: [ closableLabel := #'Make closable' ].
	(aBuilder item: closableLabel)
		action: [ aBuilder model perform: closableLabel asCamelCase uncapitalized ].
	draggableLabel := aBuilder model isSticky ifTrue: [#'Make draggable'] ifFalse: [#'Make undraggable'].
	(aBuilder item: draggableLabel)
		action: [ aBuilder model toggleStickiness ];
		withSeparatorAfter.
	maximizeLabel := aBuilder model isMaximized
	    ifTrue: [ #'Restore' ]
    	ifFalse: [ #'Maximize' ].
	(aBuilder item: maximizeLabel)
		action: [ aBuilder model expandBoxHit ];
		icon: self icons windowMaximizeForm.
	aBuilder model isCollapsed ifFalse: [
		(aBuilder item: #'Window color...')
			action: [ aBuilder model setWindowColor ] ].! !

!SystemWindow class methodsFor: 'initializing' stamp: 'BenjaminVanRyseghem 3/22/2013 16:16'!
borderWidth

	"Making changes to this for some reason requires repositioning of CornerGripMorphs.
	Edit BorderedMorph#addCornerGrip and play with offsets to get them right if you increase
	border width. For instance, going from 4 to 6 here and you should updated offsets to
	(-23@-23 corner: 0@0) for the right placement of corner grips."

	^ self theme windowBorderWidthFor: self! !

!SystemWindow class methodsFor: '*Polymorph-Widgets' stamp: 'gvc 5/15/2007 10:24'!
resetForms
	"Set the box forms to nil so that they will be taken from the current theme.
	Don't touch the expand or menu ones, delegated to theme anyway."

	CloseBoxImage := nil.
	CollapseBoxImage := nil! !

!SystemWindow class methodsFor: 'top window' stamp: 'nice 1/5/2010 15:59'!
windowsIn: aWorld satisfying: windowBlock
	| windows |

	windows := OrderedCollection new.
	aWorld ifNil: [^windows].	"opening MVC in Morphic - WOW!!"
	aWorld submorphs do:
		[:m | | s |
		((m isSystemWindow) and: [windowBlock value: m])
			ifTrue: [windows addLast: m]
			ifFalse: [((m isKindOf: TransformationMorph) and: [m submorphs size = 1])
					ifTrue: [s := m firstSubmorph.
							((s isSystemWindow) and: [windowBlock value: s])
								ifTrue: [windows addLast: s]]]].
	^ windows! !

!TCPSocketEchoTest commentStamp: 'SvenVanCaekenberghe 3/3/2015 14:03'!
TCPSocketEchoTest is both a unit test and an example.
It implements and tests a TCP echo service.
Input is read and send back in response.

You can also run the example manually,
by inspecting each expression separately.

  TCPSocketEchoTest new runServer.
  TCPSocketEchoTest new clientSend: 'Hello @ ', Time now asString.
  TCPSocketEchoTest new clientSend: #quit.

Each TCP client connection creates a worker process on the server handling the connection until it is closed. Each worker process reads input one time and sends it back.

The server runs until it receives quit as input. If necessary, use the Process Browser to terminate a running server.

Note: this example deliberately does not use SocketStream to show how to use Socket directly. In practice however, you should use SocketStream.!
!TCPSocketEchoTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/3/2015 14:03'!
clientSend: message
	"Send message to the local TCP echo service and return the result"
	
	| socket |
	socket := Socket newTCP.
	^ [ 
		socket connectTo: self localhost port: self port.
		socket sendData: message.
		socket receiveData ] 
			ensure: [ socket closeAndDestroy ]! !

!TCPSocketEchoTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/3/2015 14:05'!
testEcho
	| socket message result |
	socket := Socket newTCP.
	[ 
		self withTCPEchoServer: [ :process |
			message := 'Testing ', 99 atRandom asString. 
			socket connectTo: self localhost port: self port.
			socket sendData: message.
			result := socket receiveData.
			self assert: result equals: message ]  
	] ensure: [ socket closeAndDestroy ].
	"At this point the server is still running, ask it to kill itself"
	self clientSend: #quit! !

!TCPSocketEchoTest methodsFor: 'private' stamp: 'SvenVanCaekenberghe 3/3/2015 14:09'!
withTCPEchoServer: block
	"Run a local TCP echo server on localhost:port and execute block.
	Optionally pass the new process to block. When quit is received, stop the server"
	
	| serverSocket serverLoop process |
	serverSocket := Socket newTCP.
	serverSocket listenOn: self port backlogSize: 10.
	serverLoop := true.
	process := [ 
		[ [ serverLoop ] whileTrue: [ 
			(serverSocket waitForAcceptFor: 60) 
				ifNotNil: [ :clientSocket | | result |
					[ [ 
						result := clientSocket receiveData.
						result asLowercase = #quit
							ifTrue: [ clientSocket sendData: 'Quiting'. serverLoop := false ]
							ifFalse: [ clientSocket sendData: result ] ]
						ensure: [ clientSocket closeAndDestroy ] ] 
							forkAt: Processor lowIOPriority named: 'TCP echo connection' ] ] ]
				ensure: [ serverSocket closeAndDestroy ] ] 
					forkAt: Processor highIOPriority named: 'TCP echo server'.
	^ block cull: process! !

!TCPSocketEchoTest methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 3/3/2015 11:21'!
port
	"Return the port where the TCP echo service runs"

	^ 6666! !

!TCPSocketEchoTest methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 3/3/2015 11:21'!
localhost
	"Return the host address where the TCP echo service runs, the local host address"
	
	^ NetNameResolver localHostAddress! !

!TCPSocketEchoTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/3/2015 11:39'!
runServer
	"Run and return a local TCP echo server"
	
	^ self withTCPEchoServer: [ :process | process ]! !

!TTLAssociation commentStamp: 'SvenVanCaekenberghe 2/9/2015 15:23'!
I am TTLAssociation. 
I am an Assiciation.

I maintain a timestamp that gets updated each time my value changes.

I decide myself when I am stale, using a cache defined default time to live.!
!TTLAssociation methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/5/2013 21:14'!
value: anObject
	super value: anObject.
	timestamp := self now! !

!TTLAssociation methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/9/2015 15:07'!
isStale: timeToLive
	^ self now - timestamp >= timeToLive! !

!TTLAssociation methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/9/2015 15:06'!
now
	^ Time totalSeconds! !

!TTLAssociation methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/5/2013 21:12'!
timestamp
	^ timestamp! !

!TTLAssociation methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/5/2013 21:14'!
key: aKey value: anObject 
	super key: aKey value: anObject.
	timestamp := self now! !

!TTLCache commentStamp: '<historical>'!
I am TTLCache. 
I am an LRUCache.

I record a timestamp when I store a value for a key.

Upon a cache hit, I check if the timestamp of the stored value does not exceed the allowed time to live duration - if so, the value has become stale and I will retrieve the value again.

The default timeToLive is 1 hour.

Note that eviction, making room in a full cache, still happens according to the LRU algorithm from my superclass - stale entries to not get evicted automatically.

I can remove all my stale values in O(n), see #removeStaleValues.

Implementation Notes

I extend my superclass by storing TTLAssociations (which also hold a timestamp) instead of Associations in the DoubleLinkedList, lruList, ordered from least to most recently used.

In case of a hit, there is now an additional check to see if the value has become stale (exceeded its time to live). If so, the value is computed again.

Timestamps are implemented using Integer seconds (Time totalSeconds) for performance reasons.!
!TTLCache methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/9/2015 14:58'!
at: key ifAbsentPut: block
	"Overwritten - see the comment of the method that I overwrite.
	In case of a hit, the cached value's timestamp is checked to see if its age
	does not exceed the allowed timeToLive. If so, the stale value is recomputed."
	
	self critical: [ | association |
		association := keyIndex 
			associationAt: key 
			ifAbsent: [ | value |
				value := block cull: key.
				"Sadly we have to check the presence of key again 
				in case of the block execution already added the entry"
				keyIndex 
					associationAt: key 
					ifAbsent: [ | newAssociation | 
						newAssociation := self newAssociationKey: key value: value.
						^ self handleMiss: newAssociation ] ].
		^ self handleHit: association ifStale: block ]! !

!TTLCache methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 12/6/2013 15:17'!
initialize
	super initialize.
	self timeToLive: 1 hour! !

!TTLCache methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/6/2013 15:16'!
now
	^ Time totalSeconds! !

!TTLCache methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 12/9/2013 14:54'!
timeToLive: duration
	"Set how old computed values can be before they become stale.
	When stale, a value will be computed again based on the block passed in.
	Specify either an Integer or a Duration, both will be converted to seconds."
	
	timeToLive := duration asDuration asSeconds! !

!TTLCache methodsFor: 'private ' stamp: 'SvenVanCaekenberghe 2/9/2015 15:09'!
handleHit: association ifStale: block
	"In case of a hit, the cached value's timestamp is check to see if its age
	does not exceed the allowed timeToLive. If so, the stale value is recomputed."

	| link newValue |
	statistics addHit.
	link := association value.
	self promote: link.
	(self isStale: link value)
		ifTrue: [
			newValue := block cull: association key.
			link value value: newValue ].
	^ link value value! !

!TTLCache methodsFor: 'private ' stamp: 'SvenVanCaekenberghe 2/9/2015 15:23'!
isStale: association
	"Delegate the decision to the association itself 
	with our time to live as default"
	
	^ association isStale: timeToLive! !

!TTLCache methodsFor: 'removing' stamp: 'SvenVanCaekenberghe 12/9/2013 22:55'!
removeStaleValues
	"Go over all cached values and remove those that are stale.
	Remove a collection of the keys that were removed."

	^ self critical: [
		| keysToRemove now |
		keysToRemove := OrderedCollection new.
		now := self now.
		lruList do: [ :value |
			 now - value timestamp < timeToLive 
				ifFalse: [ keysToRemove add: value key ] ].
		keysToRemove do: [ :each | self removeKey: each ].
		keysToRemove ]! !

!TTLCache methodsFor: 'private ' stamp: 'SvenVanCaekenberghe 2/9/2015 15:22'!
newAssociationKey: key value: value
	"Override this method in a subclass to customise expiration behavior"
	
	^ TTLAssociation key: key value: value! !

!TTLCache methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 12/9/2013 15:06'!
printElementsOn: stream
	super printElementsOn: stream.
	stream space; print: timeToLive asDuration! !

!TTLCacheTests methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/16/2013 20:11'!
newCache
	^ TTLCache new! !

!TTLCacheTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/6/2013 11:28'!
testExpiring
	| cache didComputeValue |
	cache := self newCache.
	cache timeToLive: 1 second.
	didComputeValue := false.
	cache at: #foo ifAbsentPut: [ didComputeValue := true. 100 ].
	self assert: didComputeValue.
	self assert: (cache includesKey: #foo).
	self assert: (cache at: #foo ifAbsentPut: [ self fail ]) equals: 100.
	1 second asDelay wait.
	didComputeValue := false.
	cache at: #foo ifAbsentPut: [ didComputeValue := true. 101 ].
	self assert: didComputeValue.
	self assert: (cache includesKey: #foo).
	self assert: (cache at: #foo ifAbsentPut: [ self fail ]) equals: 101.
	cache validateInvariantWith: self 
	! !

!TTLCacheTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/9/2013 22:42'!
testRemoveStaleValues
	| cache keys |
	cache := self newCache.
	cache timeToLive: 1 second.
	cache at: #foo ifAbsentPut: [ 100 ].
	cache at: #bar ifAbsentPut: [ 200 ].
	self deny: cache isEmpty.
	1 second asDelay wait.
	keys := cache removeStaleValues.
	self assert: cache isEmpty.
	self assert: keys asArray sorted equals: #(bar foo).
	cache validateInvariantWith: self 
	! !

!TTLCacheTests class methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/2/2015 10:40'!
shouldInheritSelectors
	^ true! !

!Tab commentStamp: '<historical>'!
I represent a simple tab
I have a IconicListItem which wrap my label and my icon.
I also have a morph to display when selected.
This morph can in fact be anything responding to #asMorph. Moreover it could be a block for lazy initialization.

I also have a state representing if I am selecting or not, enabled or not, etc!
!Tab methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/9/2013 00:56'!
closeable: anObject

	closeable := anObject.
	anObject 
		ifTrue: [ self showCloseIcon ]
		ifFalse: [ self hideCloseIcon ]! !

!Tab methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/30/2013 14:16'!
enabled
	
	^ state enabled! !

!Tab methodsFor: 'private-icons' stamp: 'BenjaminVanRyseghem 6/4/2013 14:54'!
menuIcon
	
	^ self class menuIcon! !

!Tab methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/4/2013 15:54'!
showCloseIcon

	closeable
		ifTrue: [ closeIcon show ]! !

!Tab methodsFor: 'icons-actions' stamp: 'BenjaminVanRyseghem 6/2/2013 19:49'!
addActionsToIcon

	closeIcon 
		on: #mouseEnter send: #mouseEnterIcon to: self;
		on: #click send: #close to: self;
		on: #mouseLeave send: #mouseLeaveIcon to: self! !

!Tab methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/30/2013 12:24'!
closeable
	^ closeable! !

!Tab methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 5/30/2013 14:14'!
handlesMouseDown: event

	^ true! !

!Tab methodsFor: 'initialize' stamp: 'BenjaminVanRyseghem 6/2/2013 16:11'!
defaultBounds

	^ 0@0 corner: 100@26! !

!Tab methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/9/2013 03:06'!
morph

	^ morph! !

!Tab methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 23:07'!
initialize

	super initialize.
	
	self changeProportionalLayout.
	
	state := TabEnabled tab: self.
	closeable := true.
	label := self buildLabel: 'tab' withIcon: self defaultIcon.
	closeIcon := AlphaImageMorph withForm: self class closeIcon.
	morph := nil.
	actions := OrderedCollection new.
	retrievingSemaphore := Semaphore new.
	
	self addLabel.
	self addIcon.
	self addActionsToIcon.! !

!Tab methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/8/2013 16:08'!
actions: aCollection

	actions := aCollection.
	self triggerEvent: #actionsChanged with: self! !

!Tab methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/18/2013 19:02'!
retrievingBlock: anObject

	retrievingBlock := anObject.
	retrievingBlock ifNotNil: [ self softRetrieveMorph ].! !

!Tab methodsFor: 'private' stamp: 'BenjaminVanRyseghem 5/30/2013 13:08'!
addLabel

	self
		addMorph: label 
		fullFrame: (LayoutFrame identity
			topFraction: 1;
			leftOffset: self labelRightOffset;
			topOffset: (label height negated - self labelBottomOffset);
			yourself)
			! !

!Tab methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/30/2013 15:14'!
label: aString

	label morph: aString asMorph! !

!Tab methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/9/2013 20:49'!
retrieveMorph: aBlock
	"This is a hard request. The result is blocking contrary to softRetrieveMorph.
	Late binding so the morph may be built only on demand"

	morph ifNotNil: [ 
		aBlock value: morph.
		^ nil ].
	retrievingSemaphore isSignaled
		ifFalse: [ self softRetrieveMorph ].

	^ [ retrievingSemaphore wait.
	aBlock value: morph ] fork! !

!Tab methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/8/2013 15:25'!
hasMenu

	^ menu notNil or: [ retrievingBlock notNil ]! !

!Tab methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 5/30/2013 14:56'!
drawOn: aCanvas
	| borderVertices vertices |
	
	borderVertices := self buildBorderVertices.
	vertices := self buildVerticesFrom: borderVertices.
	
	aCanvas
		drawPolygon: vertices
		color: self backgroundColor
		borderWidth: 0
		borderColor: Color transparent.
		
	borderVertices overlappingPairsDo: [ :start :end | 
			aCanvas
				line: start
				to: end
				width: 1
				color: self borderColor. ]! !

!Tab methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/9/2013 14:13'!
selected: aBoolean

	(state isSelectedMatchingTheState: aBoolean) 
		ifTrue: [ ^ self triggerEvent: #tabResetSelection with: self ].
	
	state := state newStateForSelected: aBoolean.
	aBoolean
		ifTrue: [ 
			self triggerEvent: #tabSelected with: self.
			self showCloseIcon ].
	
	"No need to change here since the toolbar Ibelong to will do it"! !

!Tab methodsFor: 'private-icons' stamp: 'BenjaminVanRyseghem 6/2/2013 18:29'!
addIcon

	self
		addMorph: closeIcon 
		fullFrame: (LayoutFrame identity
			bottomFraction: 0;
			leftFraction: 1;
			topOffset: 8; "tab height : 26px, icon height: 12 px -> (26 - 12 / 4) + 1"
			leftOffset: self iconRightOffset negated - 12;
			rightOffset: self iconRightOffset negated;
			bottomOffset: 20; "8 + 12"
			yourself)! !

!Tab methodsFor: 'private-constants' stamp: 'BenjaminVanRyseghem 5/30/2013 15:03'!
labelRightOffset

	^ 12! !

!Tab methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/2/2013 19:53'!
updateShowIcon

	(self selected not and: [ self width < 100 ])
		ifTrue: [ self hideCloseIcon ]
		ifFalse: [ self showCloseIcon ]! !

!Tab methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/7/2015 21:39'!
drawOnAthensCanvas: anAthensCanvas
	| borderVertices vertices path |
	borderVertices := self buildBorderVertices.
	vertices := self buildVerticesFrom: borderVertices.
	path := self createClosedPolygonPathFrom: vertices on: anAthensCanvas.
	anAthensCanvas setPaint: self backgroundColor.
	anAthensCanvas drawShape: path.
	path := self createLinesPathFrom: borderVertices on: anAthensCanvas.
	(anAthensCanvas setStrokePaint: self borderColor) width:1.
	anAthensCanvas drawShape: path.
! !

!Tab methodsFor: 'icons-actions' stamp: 'BenjaminVanRyseghem 6/2/2013 19:49'!
mouseLeaveIcon

	closeable ifFalse: [ ^ self ].
	fadeOut ifNotNil: [ fadeOut terminate ].
	fadeOut := [ 
		closeIcon image: self class closeHalfOverIcon.
		50 milliSeconds asDelay wait.
		closeIcon image: self class closeIcon ] fork! !

!Tab methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/10/2013 17:26'!
silentlySelected: aBoolean

	(state isSelectedMatchingTheState: aBoolean) 
		ifTrue: [ ^ self ].
	
	state := state newStateForSelected: aBoolean.
	aBoolean
		ifTrue: [ self showCloseIcon ].
	
	"No need to change here since the toolbar Ibelong to will do it"! !

!Tab methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/30/2013 15:17'!
icon: anIcon

	anIcon 
		ifNil: [ label icon: nil ]
		ifNotNil: [ label icon: (AlphaImageMorph new image: anIcon) ]! !

!Tab methodsFor: 'protocol' stamp: 'DamienCassou 9/26/2014 15:00'!
delete

	super delete.
	morph delete.
	retrievingProcess ifNotNil: [ retrievingProcess terminate ].
	self triggerEvent: #tabDeleted with: self! !

!Tab methodsFor: 'private' stamp: 'BenjaminVanRyseghem 6/10/2013 17:07'!
toggleSelection

	self selected
		ifTrue: [ self removeFromSelection ]
		ifFalse: [ self addToSelection ]! !

!Tab methodsFor: 'private' stamp: 'BenjaminVanRyseghem 6/9/2013 21:06'!
refreshContent
	
	morph := nil.
	self triggerEvent: #tabEmptyContents with: self.
	
	"Trigger the update"
	self softRetrieveMorph.! !

!Tab methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/1/2013 14:29'!
model: aModel

	model := aModel! !

!Tab methodsFor: 'private' stamp: 'BenjaminVanRyseghem 6/2/2013 18:38'!
buildLabel: text withIcon: icon
	
	^ (TabLabelItem tab: self)
		morph:	text asMorph;
		icon: (AlphaImageMorph new image: icon);
		yourself! !

!Tab methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/9/2013 02:03'!
icon

	^ label icon! !

!Tab methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/7/2015 21:38'!
createLinesPathFrom: borderVertices on: anAthensCanvas
	^ anAthensCanvas
		createPath: [ :builder | 
			builder absolute.
			borderVertices
				overlappingPairsDo: [ :start :end | 
					builder moveTo: start.
					builder lineTo: end ] ]! !

!Tab methodsFor: 'private' stamp: 'BenjaminVanRyseghem 6/10/2013 17:27'!
addToSelection

	self triggerEvent: #tabAddedToSelection with: self.
	
	"No need to change here since the toolbar I belong to will do it"! !

!Tab methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/2/2013 19:18'!
close

	closeable ifFalse: [ ^ self ].
	self delete! !

!Tab methodsFor: 'private-tab label' stamp: 'BenjaminVanRyseghem 6/2/2013 19:09'!
showIconTreshold

	^ closeIcon visible
		ifTrue: [ 54 ]
		ifFalse: [ 40 ]! !

!Tab methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 6/10/2013 17:31'!
mouseUp: event

	(event commandKeyPressed or: [ event controlKeyPressed ])
		ifTrue: [ self toggleSelection ]
		ifFalse: [ 
			event shiftPressed
				ifTrue: [ self selectToMe ]
				ifFalse: [ self selected: true ] ]! !

!Tab methodsFor: 'drawing-private' stamp: 'BenjaminVanRyseghem 5/30/2013 13:31'!
buildBorderVertices
	
	^ state buildBorderVertices! !

!Tab methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/4/2013 16:20'!
extraSpaceForActions
	| space offsets |
	
	space := 0.
	offsets := 1.
	
	self hasMenu ifTrue: [ 
		offsets := offsets +1.
		space := space + self menuIcon width ].
	
	self actions do: [ :each | 
		space := space + each icon width.
		offsets := offsets +1 ].
	
	^ space + (offsets * self actionOffset)! !

!Tab methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/4/2013 14:40'!
actions

	^ actions! !

!Tab methodsFor: 'drawing-private' stamp: 'BenjaminVanRyseghem 5/30/2013 13:37'!
buildVerticesFrom: borderVertices
	
	^ state buildVerticesFrom: borderVertices! !

!Tab methodsFor: 'private' stamp: 'BenjaminVanRyseghem 6/10/2013 17:29'!
removeFromSelection

	self triggerEvent: #tabRemovedFromSelection with: self.
	
	"No need to change here since the toolbar I belong to will do it"! !

!Tab methodsFor: 'private-icons' stamp: 'BenjaminVanRyseghem 5/30/2013 12:25'!
defaultIcon

	^ Smalltalk ui icons blankIcon! !

!Tab methodsFor: 'drawing-private' stamp: 'BenjaminVanRyseghem 6/2/2013 18:19'!
backgroundColor

	^ state backgroundColor! !

!Tab methodsFor: 'protocol' stamp: 'TorstenBergmann 7/3/2013 08:43'!
softRetrieveMorph
	| rotating oldIcon |
	"Like retrieveMorph but done in a separated process"
	
	morph ifNotNil: [ ^ self ].
	
	retrievingProcess 
		ifNotNil: [ 
			"The retrieving process is already running, let's wait for its result"
			retrievingProcess isTerminated 
				ifFalse: [ ^ self ] ].
	
	oldIcon := self icon ifNotNil: [ :i | i form ].
	retrievingProcess := [ [ 
		"set rotating icon"
		self icon: self class refreshIcon1.
		rotating := [ | i |
			i := 1.
			[ true ] whileTrue:[ 
				i := (i \\ 10)+1.
				100 milliSeconds asDelay wait.
				self icon: (self class perform: ('refreshIcon', i asString) asSymbol) ] ] fork.
		"compute time consuming data"
		self morph: retrievingBlock value ]
	ensure: [
		rotating terminate.
		self icon: oldIcon.
		retrievingSemaphore signal ] ] fork.! !

!Tab methodsFor: 'private' stamp: 'BenjaminVanRyseghem 6/10/2013 17:32'!
selectToMe

	self triggerEvent: #tabSelectTo with: self.
	
	"No need to change here since the toolbar I belong to will do it"! !

!Tab methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/4/2013 15:54'!
menu: aMenu
	
	menu := aMenu! !

!Tab methodsFor: 'drawing-private' stamp: 'BenjaminVanRyseghem 5/30/2013 13:14'!
borderColor

	^ Color gray! !

!Tab methodsFor: 'private' stamp: 'StephaneDucasse 10/22/2014 22:06'!
addRefreshMenuItemOn: aMenu
	"I have a block for retrieving my contents, so I install a menu action for this"
	
	retrievingBlock ifNil: [ ^ self ].
	aMenu addLine.
	aMenu
		add: 'Refresh content'
		target: self
		selector: #refreshContent! !

!Tab methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/4/2013 15:54'!
hideCloseIcon

	closeIcon hide! !

!Tab methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/30/2013 13:23'!
enabled: aBoolean

	(state isEnabledMatchingTheState: aBoolean) ifTrue: [ ^ self ].
	
	state := state newStateForEnabled: aBoolean.
	label enabled: aBoolean.
	self changed! !

!Tab methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/9/2013 01:47'!
morph: anObject

	morph := anObject.
	self triggerEvent: #tabRefreshed with: self! !

!Tab methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/8/2013 15:28'!
menu
	| newMenu |
	
	newMenu := MenuMorph new defaultTarget: self.
	menu ifNotNil: [ menu cull: newMenu ].
	
	self addRefreshMenuItemOn: newMenu.
	
	^ newMenu! !

!Tab methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/4/2013 14:42'!
hasActions

	^ actions notEmpty! !

!Tab methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/4/2013 16:17'!
addAction: anAction

	actions add: anAction! !

!Tab methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 5/30/2013 14:15'!
handlesMouseUp: event

	^ true! !

!Tab methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/4/2013 16:17'!
addActions: aCollection

	actions addAll: aCollection! !

!Tab methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/1/2013 14:29'!
model

	^ model! !

!Tab methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/30/2013 14:16'!
selected
	
	^ state selected! !

!Tab methodsFor: 'private-constants' stamp: 'BenjaminVanRyseghem 6/2/2013 16:22'!
labelBottomOffset

	^ 5! !

!Tab methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/30/2013 12:24'!
label
	^ label! !

!Tab methodsFor: 'icons-actions' stamp: 'BenjaminVanRyseghem 6/2/2013 19:49'!
mouseEnterIcon

	closeable ifFalse: [ ^ self ].
	fadeOut ifNotNil: [ fadeOut terminate ].
	closeIcon image: self class closeOverIcon! !

!Tab methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 5/30/2013 14:15'!
mouseDown: event

	self flag: 'ToDo: Add drag'! !

!Tab methodsFor: 'private-constants' stamp: 'BenjaminVanRyseghem 6/4/2013 15:12'!
actionOffset

	^ 4! !

!Tab methodsFor: 'private-tab label' stamp: 'NicolaiHess 12/16/2014 00:06'!
modifyClippingBounds: clippingBounds
	| rightOffset |

	rightOffset := -10.
	closeIcon visible ifTrue: [ rightOffset := rightOffset - 14 ].

	^ clippingBounds withRight:clippingBounds right + rightOffset! !

!Tab methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/8/2013 16:04'!
setActionsFrom: aBlock

	self actions: aBlock value! !

!Tab methodsFor: 'private-constants' stamp: 'BenjaminVanRyseghem 6/2/2013 16:17'!
iconRightOffset

	^ 10! !

!Tab methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/7/2015 21:40'!
createClosedPolygonPathFrom: aPointsArray on: anAthensCanvas
	^ anAthensCanvas
		createPath: [ :builder | 
			aPointsArray ifEmpty: [ builder ].
			builder absolute.
			builder moveTo: aPointsArray first.
			aPointsArray allButFirstDo: [ :p | builder lineTo: p ].
			builder close.
			builder ]! !

!Tab class methodsFor: 'icons-contents' stamp: 'BenjaminVanRyseghem 6/2/2013 16:35'!
closeHalfOverIconContents

	^ Form
		extent: 12@12
		depth: 32
		fromArray: #(16777215 16777215 16777216 869400576 1523908608 1943339008 1943339008 1523908608 869400576 16777216 16777215 16777215 16777215 232259584 1624571904 2161311744 2161311744 2161311744 2161311744 2161311744 2161311744 1624571904 232259584 16777215 16777216 1624571904 3262657845 3429841466 2161311744 2161311744 2161311744 2161311744 3429841466 3262657845 1624571904 16777216 869400576 2161311744 3429841466 4283256141 3413129529 2161311744 2161311744 3413129529 4283256141 3429841466 2161311744 869400576 1523908608 2161311744 2161311744 3413129529 4283256141 3396352313 3396352313 4283256141 3413129529 2161311744 2161311744 1523908608 1943339008 2161311744 2161311744 2161311744 3396352313 4283256141 4283256141 3396352313 2161311744 2161311744 2161311744 1943339008 1943339008 2161311744 2161311744 2161311744 3396352313 4283256141 4283256141 3396352313 2161311744 2161311744 2161311744 1943339008 1523908608 2161311744 2161311744 3413129529 4283256141 3396352313 3396352313 4283256141 3413129529 2161311744 2161311744 1523908608 869400576 2161311744 3429841466 4283256141 3413129529 2161311744 2161311744 3413129529 4283256141 3429841466 2161311744 869400576 16777216 1624571904 3262657845 3429841466 2161311744 2161311744 2161311744 2161311744 3429841466 3262657845 1624571904 16777216 16777215 232259584 1624571904 2161311744 2161311744 2161311744 2161311744 2161311744 2161311744 1624571904 232259584 16777215 16777215 16777215 16777216 869400576 1523908608 1943339008 1943339008 1523908608 869400576 16777216 16777215 16777215)
		offset: 0@0! !

!Tab class methodsFor: 'icons-contents' stamp: 'BenjaminVanRyseghem 6/9/2013 02:45'!
refreshIcon4Contents

	^ Form
		extent: 16@16
		depth: 32
		fromArray: #(0 0 0 0 0 0 0 0 0 0 89234760 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 759994436 1381278284 592619592 122466366 0 0 0 0 0 0 0 156416323 308789596 71948342 0 239308347 1850513220 4166492751 2959716960 913029984 0 0 0 0 0 0 507481656 1651357027 2473835625 1819328102 73397069 405169955 2739310143 4285378406 3951806595 2943663465 744930394 0 0 0 255295281 1547469878 2790825554 3816405361 4153330309 2928135037 829539942 1009348388 3091565374 4285969518 4288401554 3968518528 1618198888 206683720 0 0 0 1362854965 3243744080 4237017988 4288730007 4035693441 2088223852 859472692 2151843643 3933384810 4288532628 4187279243 2340144241 342870883 0 0 0 471756567 3025968724 4287349636 4254847122 3866475882 2305933925 795787617 1093103904 3311313239 4270638468 4287876234 2910174828 476495964 0 0 0 1194818610 3663502934 4270704262 4118067052 1784983641 410110307 0 522613025 3126303569 4187080841 4220504454 2507061348 0 0 0 119556892 1765572406 4000230505 4287284611 3446386787 558536770 0 83886080 808153381 3344867159 4287021181 4235836015 1532996438 34968584 0 0 286872086 2537587002 4284983136 4253664897 3462571866 860724292 369376770 1528848670 2822405174 4067273319 4287350659 3161437031 1045141827 0 0 0 269962772 2453569336 4134316901 4287284610 3866473837 1784062797 557548084 2284546856 4031417157 4286298740 4286824827 3512574805 507745595 38385723 0 0 251741185 1949858354 3965558103 4287219074 4185898359 3327171655 1230283593 1110800432 3478097994 4285706860 4252349295 3529220179 2237178446 459255892 0 0 67120128 924803868 3058601800 4236032373 4285575529 3025904467 1045997903 151009792 2201384753 3410792008 2790758737 1817023558 793680965 59043444 0 0 0 17958931 1697739821 3360591688 4065235527 2906753337 425306448 0 471950109 1261136934 490241073 0 0 0 0 0 0 0 167787008 1028098369 2637922356 1430292537 223716686 0 33564416 16777216 0 0 0 0 0 0 0 0 0 0 288849456 156607054 0 0 0 0 0 0 0 0)
		offset: 0@0! !

!Tab class methodsFor: 'icons' stamp: 'BenjaminVanRyseghem 6/4/2013 14:58'!
menuIcon

	^ Smalltalk ui theme windowMenuForm! !

!Tab class methodsFor: 'icons-contents' stamp: 'BenjaminVanRyseghem 6/9/2013 02:48'!
refreshIcon7Contents

	^ Form
		extent: 16@16
		depth: 32
		fromArray: #(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 33561088 0 0 0 0 0 0 0 0 0 0 0 0 0 287730978 607287342 1127051304 1227977773 841903913 471818779 16784128 0 0 0 0 0 0 0 71471676 441357130 1899658805 2773915472 3260388943 3377829199 3008204359 1967556672 909079337 169762073 0 20350256 37198896 0 0 0 507217460 2168489272 3528890448 4252020586 4269915770 4286232434 4168463470 3865421151 2774178900 1279363642 993625395 1026916656 305694770 0 0 0 591366456 2453702200 3947926857 4218598250 4269981818 4119184253 4236427386 4286955903 4101617522 3446582374 2975571539 2253230918 592090181 0 0 0 173649746 1011257918 2169806412 3076236626 3043470686 2657397595 2993336162 3799365485 4253861508 4220569481 4135697786 3010244196 844735824 0 0 0 0 0 559722066 1313775684 1128502074 608473147 726309440 1953149792 3900555123 4288401810 4237676173 3279863925 1114750054 0 0 0 101932045 404578841 825390638 1446411058 1294494245 553926148 0 845659738 2960572779 3784166787 3566063236 2658977139 829342052 0 0 0 505307416 2067562296 2974650184 3478032457 2973136947 1142906909 0 361228663 1618200167 1702545518 1467861875 779997810 291816536 0 0 0 758808116 2857341514 4100894312 4285509481 3781140057 1967425087 472348961 456952884 976980274 1077379889 506032931 0 0 0 0 0 575377989 2757665112 4168266348 4286890620 4219320693 3563825508 2572786771 2286719559 2387382596 2638777921 1832879928 843091001 41418599 0 0 0 508336195 2253560650 3412306011 3664621926 4169318265 4270572674 4118854777 3900750969 4001216885 4084314217 3915227733 2404556106 776970055 58061673 0 0 274049353 1532667215 1263508550 1499112786 3044128103 3934569082 4271098763 4288336018 4288467347 4287481989 4051155312 3310921040 894608202 89699664 0 0 0 208323932 0 221942066 928623697 2256125807 3330459000 3616263042 3683634821 3481585273 2490809965 1315025240 257142088 0 0 0 0 0 0 0 72724301 392215381 1198703463 1517732971 1584973421 1198768743 661439073 33604352 0 0)
		offset: 0@0! !

!Tab class methodsFor: 'icons-contents' stamp: 'BenjaminVanRyseghem 6/9/2013 02:42'!
refreshIcon2Contents

	^ Form
		extent: 16@16
		depth: 32
		fromArray: #(0 0 0 0 0 0 0 74831464 0 0 0 0 0 0 0 0 0 0 0 0 375502935 1013430619 1500298594 1433124192 963493219 0 0 0 0 0 0 0 0 0 0 1112975436 2574170212 3950690160 4102539134 3951675263 3849829998 2540221279 357737288 0 0 157067857 0 0 0 0 475439950 3998720847 4286364532 4288796057 4288992411 4288598677 4288598421 4286627702 3630279257 810851916 843749186 1884923215 0 0 0 0 894211396 2504890181 4132411207 4285575016 4236032116 4202346354 4286363765 4288532885 4287219329 4284392278 3982402390 2521535555 34755853 22126153 0 0 0 624854583 1799325241 3191768375 2420673856 2302576183 2588906569 4284193876 4286823804 4287810954 4285969519 2992151121 0 0 0 0 0 0 167784448 1060139819 438988836 0 420501771 1396342324 3998520654 4286167154 4269324659 3209070400 405170464 0 0 0 71615025 610843741 981191535 1651622758 2372779873 578474350 0 740056601 3928977196 3846801732 3376645183 2452911407 369510403 0 0 0 627686494 3413359977 3951741568 4136159614 3178347878 87208481 0 1075533848 1395222820 1093430566 285753864 185486606 34230791 0 0 0 811576660 3564813425 4288598421 4288795544 4252022374 1885251669 33576192 157861469 493140058 1532996693 409120856 0 0 0 0 0 390698305 3295128415 4270178429 4288006542 4288467605 4285378917 3143476053 3142884940 3277562707 3612055363 2051708226 777034312 71930178 0 0 0 28374419 3058011455 3042154572 3831209556 4286034800 4288270738 4286890364 4253467006 4287021439 4286692985 4266102080 3024127545 440831295 0 0 0 154367789 1295613747 354842143 1043692590 3058404934 4284193622 4286232690 4286627448 4287153537 4286363765 3948320592 2553970227 0 0 0 0 0 0 0 101601033 605445393 2017230134 3460597054 3629158730 3645541188 3108275775 1814916904 23188057 0 0 0 0 0 0 0 0 0 167781888 589785122 1075731994 907960090 337535772 136076824 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
		offset: 0@0! !

!Tab class methodsFor: 'icons' stamp: 'BenjaminVanRyseghem 6/9/2013 02:50'!
refreshIcon5

	^ Icons 
		at: #refreshIcon5
		ifAbsentPut: [ self refreshIcon5Contents ]! !

!Tab class methodsFor: 'icons-contents' stamp: 'BenjaminVanRyseghem 6/9/2013 02:48'!
refreshIcon8Contents

	^ Form
		extent: 16@16
		depth: 32
		fromArray: #(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 121476406 490769208 424580170 640578858 236610840 102324245 0 0 0 0 0 0 0 0 0 39634005 658475576 2168357685 2739703622 2639105864 1951174214 1093431335 337733150 0 0 0 0 0 0 0 0 44105625 960663098 3074854207 4149976404 4235309163 3731334752 2974781513 1429896245 303520019 0 0 0 0 0 0 17466368 0 491954761 2287312717 3865685345 4286627448 4286824315 4016876132 2941095495 1060469040 33563904 0 0 0 0 101208064 438462237 337009682 323590977 1381344843 2875041620 3614881901 4119250046 4286495862 3781600864 1850182209 303059978 0 0 0 54894397 708345138 2034205242 2135065918 1312455989 1178043441 1145476668 1851565651 3161371238 4169318523 4152014708 2740624468 640777003 0 0 0 273126975 1817549135 3462307928 3831669597 3394080840 1949266476 739727124 355040032 1734453848 3799365485 4286824572 3446582630 1531613506 556563239 70550575 89504327 978295622 2774311253 4134711916 4286167154 3999244121 2503309106 621233415 0 1113764439 3396975727 4287744393 4018388348 3042811733 1698859836 473269295 174242644 1549444431 2623316819 3899502950 4253336188 3933253225 2000979519 252401416 83886046 1450164835 3615343475 4271624594 4287613064 3446780265 1683200332 289969988 46202788 358395728 994876227 2590486111 4152541049 4068259700 2589695317 641239090 358266957 1567868519 2844118139 3918647175 3868117893 2843196014 828090450 56409427 0 0 205297460 1885777756 3833577077 4287349890 3581063532 2320339784 1346078003 1061261625 1315946596 2022035324 2558313843 1366737515 292405089 0 0 0 54508600 1013298780 3145777782 4254256010 4220372613 3715741297 2891422287 1916568886 539389728 327343990 561368681 308988255 0 0 0 0 0 342016086 2239546481 3784034945 4238070419 4287875722 4118000235 3042154571 1060865588 16777216 56081483 0 0 0 0 0 0 107733085 997245796 2340538487 3650080389 4136684679 4269850489 3781141847 1699715911 106808146 0 0 0 0 0 0 0 0 110034812 863028837 1736230768 2743059572 2977348718 3344607058 1414635593 257406030 0 0 0 0)
		offset: 0@0! !

!Tab class methodsFor: 'initialize' stamp: 'CamilloBruni 7/17/2013 23:07'!
initialize

	Icons := Dictionary new.! !

!Tab class methodsFor: 'icons-contents' stamp: 'BenjaminVanRyseghem 6/9/2013 02:42'!
refreshIcon1Contents

	^ Form
		extent: 16@16
		depth: 32
		fromArray: #(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1918411854 0 0 0 0 0 0 0 0 0 74170463 224573016 358395218 425108812 424581958 424120639 3796998729 2219545155 0 0 0 0 0 0 0 258785377 1483455585 3077815657 4033919079 4285248097 4284787292 4284326485 4285837932 4150568029 1949990196 84164352 0 0 0 0 141673060 2036971870 3984639095 4288007307 4288598421 4288992667 4288664983 4288336274 4287679624 4286298997 3846341437 924803099 0 0 0 0 1248311133 4017798768 4288729751 4288664215 4287152768 4284917343 4284193876 4283733070 4285048929 4216887635 2368696107 269899029 0 0 0 0 2774576726 4287613062 4288664471 4235966323 3528233285 1480558136 1026585898 1042836516 3929042988 2536270631 0 0 0 0 0 0 3948323406 4283800909 4283405639 3510995518 1044021042 0 0 0 2216779550 408331084 1465887829 1347788876 1330550598 1413909823 0 0 1632474693 1631948094 1631487032 1698134833 556164899 1685243238 225625702 0 0 475571792 3075645002 4148991300 4165241661 4114448694 0 0 0 0 0 0 1769128807 3815685475 761508440 424779592 642816840 3126041931 4151225958 4288139152 4286626937 3208346934 0 0 0 0 73578836 1567670373 4001810556 4287613573 4285576806 4284919134 4284655450 4286364020 4287678856 4287219330 4267285075 1798336811 0 0 0 0 560380762 3530866026 4288270224 4289255071 4289058461 4288664728 4288270738 4287350659 4285970287 4200373590 2637131819 371089436 0 0 0 0 157332566 1919332444 4084906610 4286824059 4284917599 4284325462 4283864913 4216295241 3494151486 2133749289 538729239 0 0 0 0 0 0 35359503 2102697036 3947729734 1312786232 1043626541 1026322727 891709472 572415514 169367061 0 0 0 0 0 0 0 0 39363658 1950056501 188581687 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
		offset: 0@0! !

!Tab class methodsFor: 'icons' stamp: 'BenjaminVanRyseghem 6/9/2013 02:50'!
refreshIcon2

	^ Icons 
		at: #refreshIcon2
		ifAbsentPut: [ self refreshIcon2Contents ]! !

!Tab class methodsFor: 'icons' stamp: 'BenjaminVanRyseghem 6/9/2013 02:51'!
refreshIcon6

	^ Icons 
		at: #refreshIcon6
		ifAbsentPut: [ self refreshIcon6Contents ]! !

!Tab class methodsFor: 'icons-contents' stamp: 'BenjaminVanRyseghem 6/9/2013 02:46'!
refreshIcon5Contents

	^ Form
		extent: 16@16
		depth: 32
		fromArray: #(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 36733993 288717871 0 33571840 0 0 0 0 0 0 0 0 0 0 0 0 54034738 1413055027 1900909896 1298312025 1064024160 258591069 0 0 0 0 0 0 0 0 0 0 218126080 2135395904 3479414108 3782916722 3179135348 1718533476 124705120 0 40555870 273719368 0 0 0 0 0 371617057 1228900153 3059588949 4186357631 4288269969 3885026951 1954531957 16842496 170619686 1112250179 1615961673 626173001 0 0 0 472672807 1715240758 3428621911 4118723191 4287941260 4288467603 3968584577 1551747698 589788450 1547206706 3075578186 4250510417 1751034965 0 0 219368721 2084141620 3613039444 4286298230 4270441858 4101355629 3396713578 3061105000 1449769310 1194161192 3158871617 4201557863 4118855801 2389949546 0 50331648 1210871335 3125842250 4285575017 4253664897 3715019110 1784851033 811446096 880135016 762299490 1446280237 3496322653 4287349890 4153855885 2926886249 0 184566016 1714780208 3932003671 4286955902 4135500918 2573116757 372344104 0 0 167789824 1816299835 3782258537 4288532628 4254256777 2306721138 0 0 2084470841 3983584873 4287219330 3917002864 1817683022 405171231 789663504 538465812 977044534 3143146578 4119380608 4287941772 3616328578 1618396011 0 151341316 2000321845 4016284509 4285706859 3663570261 1917688899 976056617 2469162281 2839182390 3311312216 4017796722 4287744392 4019112325 2843000427 712033637 0 0 994609987 3527904064 3763180358 2337710158 978691915 1043626031 3561392194 4217808480 4286495351 4236887424 4185438574 2490349414 862500446 34530304 0 0 456884788 2100985907 1899988791 542417739 39843158 1345483566 3696793938 4286298740 4286824827 3614290278 1952557400 659333188 0 0 0 0 0 189832265 290100547 33554431 16777216 1160671530 3309997126 3865684324 4016679522 2656476750 254117662 0 0 0 0 0 0 0 0 0 16790528 505241111 1194883634 1901172043 2270337354 2287510094 458926927 0 0 0 0 0 0 0 0 0 0 0 33570304 0 440964160 391621196 141676900 0 0 0)
		offset: 0@0! !

!Tab class methodsFor: 'icons' stamp: 'BenjaminVanRyseghem 6/9/2013 02:51'!
refreshIcon9

	^ Icons 
		at: #refreshIcon9
		ifAbsentPut: [ self refreshIcon9Contents ]! !

!Tab class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 6/2/2013 17:16'!
label: label icon: icon retrievingBlock: morph

	^ self new
		label: label;
		icon: icon;
		retrievingBlock: morph;
		yourself! !

!Tab class methodsFor: 'icons-contents' stamp: 'BenjaminVanRyseghem 6/9/2013 02:44'!
refreshIcon3Contents

	^ Form
		extent: 16@16
		depth: 32
		fromArray: #(0 0 0 0 0 0 0 592553543 660648789 341949526 190297161 0 0 0 0 0 0 0 0 0 0 290297413 1414569032 4032406865 3128146282 3010706536 1701887589 727891288 44105614 0 0 0 0 0 0 0 0 56474195 1665897795 4048919885 4287350148 4288139406 4035496062 2424030065 778682206 22654542 0 0 0 0 0 0 0 0 893157942 3242823746 4285772395 4288335249 4288664470 4186359421 2473507429 0 0 0 0 0 0 140494417 375898459 124311385 218511878 2301917998 3142686026 3983913837 4287349891 4288532628 3530930795 610053202 0 0 0 0 155625272 1231862114 3279142249 1837288311 1013365595 876381237 909014055 2336196408 3698043748 4288138639 4286167663 1868014415 16843010 0 0 0 373856064 2977085033 4170173062 4287614085 3112159092 2305671009 162594719 505703967 2857144646 4286166129 4287087999 2505810515 389779508 324709455 0 0 1867223877 3782061926 4288138383 4288795544 3916807530 1131265889 114294716 100663296 1413185333 4050496103 4287547783 4284852573 2941820751 1901700431 0 490175793 2218690104 3142949454 4219451768 4288467349 3681465444 625909317 0 588337167 2939055915 4284062291 4287088000 4269192303 3059063374 709267774 0 54033970 185162499 1144948535 3764297815 4287415685 4268667494 1398382929 0 991977244 2351655720 3746072643 4133856864 3797654870 1733201991 0 0 0 0 471951643 2991361863 4286692475 4237019011 3445729113 1968217415 510114652 994282554 858483239 2369288499 2352313904 371287323 0 0 0 0 83886080 1799126838 4150173272 4286824827 4270244222 3849302375 3259996998 1616356942 40819295 100674560 370694932 33554432 0 0 0 0 0 892169000 3376710974 4151159910 4287219330 4287284611 4100763492 2202703170 341683540 0 0 0 0 0 0 0 0 83891200 1311731754 3192424770 4032929882 4252809589 4284128339 3544221497 877171009 0 0 0 0 0 0 0 0 0 268451840 874274328 2067365173 2789311036 3058338884 2587524915 491163199 23776609 0 0 0 0 0 0 0 0 0 33569792 16777216 488464665 0 221411115 0 0 0 0 0)
		offset: 0@0! !

!Tab class methodsFor: 'icons' stamp: 'BenjaminVanRyseghem 6/9/2013 02:51'!
refreshIcon8

	^ Icons 
		at: #refreshIcon8
		ifAbsentPut: [ self refreshIcon8Contents ]! !

!Tab class methodsFor: 'icons' stamp: 'BenjaminVanRyseghem 6/9/2013 02:50'!
refreshIcon3

	^ Icons 
		at: #refreshIcon3
		ifAbsentPut: [ self refreshIcon3Contents ]! !

!Tab class methodsFor: 'icons' stamp: 'BenjaminVanRyseghem 6/4/2013 15:48'!
closeOverIcon

	^ Icons
		at: #closeOverIcon
		ifAbsentPut: [ self closeOverIconContents ]! !

!Tab class methodsFor: 'icons-contents' stamp: 'BenjaminVanRyseghem 6/9/2013 02:50'!
refreshIcon10Contents

	^ Form
		extent: 16@16
		depth: 32
		fromArray: #(0 0 0 0 0 24965223 0 0 0 0 0 0 0 0 0 0 0 0 0 0 142401386 508995915 575841097 172795971 171609395 0 0 0 0 0 0 0 0 0 0 0 509259086 1935320144 2153357393 1918409809 1296271422 539520547 50431232 0 0 21606215 0 0 0 0 0 0 776641344 2573182807 3714821476 3664292451 2907804748 1144486963 67118080 106278475 356683834 323196477 88120119 0 0 0 87740209 861909334 2037101154 3497244267 4269653366 4285706860 3428424532 1463714105 289443895 676569674 1799588924 1799193396 574721081 0 0 191092052 980796521 2390409071 3766402420 4186226811 4252743795 4033259104 3209531208 1329168179 1028563268 2237310290 3495073867 3175911493 1162711879 119633438 91416929 846777708 2558576501 3800943236 4270507393 3917265012 3194398047 2722333759 2033218350 1143632933 1817354569 3362172510 4285312612 3814826587 1934002754 304509477 275369308 1652410738 3415199366 4287876234 4052206207 2925897567 1296534849 740581665 621232135 573074978 1885251668 3732651122 4286692985 3832458600 1984859975 186083605 477416806 2223361402 3969175947 4288204688 3614880623 1917818442 287276055 0 0 675714877 2439622753 3967926649 4286758521 3663962716 1749124155 287139352 594857318 2659305334 4069510022 4287021437 3295258721 1614710839 727693651 896978024 1164688223 2003481184 3463689836 4236427643 4168200297 2941621838 1261861682 100683264 493996646 2339881070 4001152372 4084248680 2790364488 1278640687 1416346977 2591869041 3246179186 3749494131 4219649914 4168660594 3361841499 1950516540 455238686 34165767 291223121 1751429979 3663570773 2958597968 1581287480 792431412 1719717238 3633303685 4237741966 4287613063 4001217398 3160844128 1766296129 623998507 83905280 0 90095955 810788938 1565762379 1196399687 304839716 243131760 1921372028 3650146183 4271164556 4085628798 2993334626 1431147334 472870955 16777216 0 0 0 89504329 274249039 40821860 0 210300795 1501153391 2843920249 3531390068 3228084576 2102301767 522614559 0 0 0 0 0 0 0 0 0 39777866 443994473 1165278825 1533521502 1700109134 1144751925 187403302 0 0 0 0 0 0 0 0 0 0 41145701 75955315 206613319 240495952 272141619 52661788 0 0 0 0)
		offset: 0@0! !

!Tab class methodsFor: 'icons-contents' stamp: 'BenjaminVanRyseghem 6/2/2013 16:06'!
closeOverIconContents

	^ Form
		extent: 12@12
		depth: 32
		fromArray: #(16777215 16777215 33488896 1708392448 3017015296 3872653312 3872653312 3017015296 1708392448 33488896 16777215 16777215 16777215 450363392 3218341888 4292083712 4292083712 4292083712 4292083712 4292083712 4292083712 3218341888 450363392 16777215 33488896 3218341888 4289940556 4290339683 4292018176 4292083712 4292083712 4292018176 4290339683 4289940556 3218341888 33488896 1708392448 4292083712 4290339683 4294704123 4290339683 4292018176 4292018176 4290339683 4294704123 4290339683 4292083712 1708392448 3017015296 4292083712 4292018176 4290339683 4294704123 4290338912 4290338912 4294704123 4290339683 4292018176 4292083712 3017015296 3872653312 4292083712 4292083712 4292018176 4290338912 4294704123 4294704123 4290338912 4292018176 4292083712 4292083712 3872653312 3872653312 4292083712 4292083712 4292018176 4290338912 4294704123 4294704123 4290338912 4292018176 4292083712 4292083712 3872653312 3017015296 4292083712 4292018176 4290339683 4294704123 4290338912 4290338912 4294704123 4290339683 4292018176 4292083712 3017015296 1708392448 4292083712 4290339683 4294704123 4290339683 4292018176 4292018176 4290339683 4294704123 4290339683 4292083712 1708392448 33488896 3218341888 4289940556 4290339683 4292018176 4292083712 4292083712 4292018176 4290339683 4289940556 3218341888 33488896 16777215 450363392 3218341888 4292083712 4292083712 4292083712 4292083712 4292083712 4292083712 3218341888 450363392 16777215 16777215 16777215 33488896 1708392448 3017015296 3872653312 3872653312 3017015296 1708392448 33488896 16777215 16777215)
		offset: 0@0! !

!Tab class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 5/30/2013 15:05'!
label: label icon: icon morph: morph

	^ self new
		label: label;
		icon: icon;
		morph: morph;
		yourself! !

!Tab class methodsFor: 'icons' stamp: 'BenjaminVanRyseghem 6/9/2013 02:50'!
refreshIcon1

	^ Icons 
		at: #refreshIcon1
		ifAbsentPut: [ self refreshIcon1Contents ]! !

!Tab class methodsFor: 'icons-contents' stamp: 'BenjaminVanRyseghem 6/9/2013 02:47'!
refreshIcon6Contents

	^ Form
		extent: 16@16
		depth: 32
		fromArray: #(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 238519345 35020813 0 0 0 0 0 0 0 0 0 0 34619404 67128832 50331648 455899943 1446741045 608670018 0 0 0 0 0 0 0 34147080 286544913 1009544488 1144354607 1329299253 1245743161 2219479363 2908133967 2052891221 593275729 0 0 0 0 0 0 908289567 2084536634 3041758791 3545930580 3680740446 3664620903 3782718319 4135631737 3766205299 2004204651 308921436 0 0 0 0 640775725 2336589632 3898383446 4235440492 4286561656 4286955903 4287218817 4288007053 4288532885 4069707401 2759640179 862633824 0 0 0 220753701 1983478836 3697846113 4286692986 4287087487 4035035257 3715084903 3463624298 3917266546 4153593480 3565997443 1820314741 209575792 0 0 0 458068297 2722860613 4251428705 4286496118 3950623089 2640554586 1364566092 911779661 1701558879 3010773352 1786431343 693545037 83886080 154961973 90425688 18831128 876249651 2990572856 3847197768 3579683925 2740560976 1145608255 167783680 0 343463274 947572844 1112316484 1244427559 1698399028 1850381635 1347394887 0 256546115 1429963572 1598657345 1532602192 1263377987 959345706 1260215579 385890048 0 457018420 1479900462 3058734408 3814695512 4099843414 3260457806 0 0 123843675 91934319 33554407 825259563 2335931703 2989914163 1999992625 993953592 1950649150 3009323352 4001085299 4287087231 4085498492 2473243746 0 0 0 0 488727837 2118288445 3898120530 4217742687 3798377568 3547048292 3815944299 4136092031 4271821205 4288205199 3531851128 1567669606 0 0 0 101733130 908815654 3192425284 4151291753 4286759035 4286955901 4287153023 4270967176 4287875979 4069707145 3448491137 2071446124 392807517 0 0 0 0 489253666 1968017479 3664226402 4134711914 3647844710 3530864234 3497507437 3263349881 2843328879 1551352940 527156831 53856803 0 0 0 0 0 625709637 2186451274 2891489360 1431412041 978493513 979086675 778614622 594199136 225431905 0 0 0 0 0 0 0 53183778 693214791 1515889999 222733371 0 0 0 0 0 0 0)
		offset: 0@0! !

!Tab class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 6/4/2013 16:17'!
label: label icon: icon morph: morph actions: aCollection

	^ self new
		label: label;
		icon: icon;
		morph: morph;
		addActions: aCollection;
		yourself! !

!Tab class methodsFor: 'icons' stamp: 'BenjaminVanRyseghem 6/4/2013 15:48'!
closeHalfOverIcon

	^ Icons
		at: #closeHalfOverIcon
		ifAbsentPut: [ self closeHalfOverIconContents ]! !

!Tab class methodsFor: 'icons' stamp: 'BenjaminVanRyseghem 6/4/2013 15:48'!
closeIcon

	^ Icons
		at: #closeIcon
		ifAbsentPut: [ self closeIconContents ]! !

!Tab class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 6/4/2013 16:18'!
label: label icon: icon retrievingBlock: morph actions: aCollection

	^ self new
		label: label;
		icon: icon;
		retrievingBlock: morph;
		addActions: aCollection;
		yourself! !

!Tab class methodsFor: 'icons' stamp: 'BenjaminVanRyseghem 6/9/2013 02:51'!
refreshIcon7

	^ Icons 
		at: #refreshIcon7
		ifAbsentPut: [ self refreshIcon7Contents ]! !

!Tab class methodsFor: 'icons-contents' stamp: 'BenjaminVanRyseghem 6/2/2013 16:07'!
closeIconContents

	^ Form
		extent: 12@12
		depth: 32
		fromArray: #(16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2219658573 2555202893 16777216 16777215 16777215 16777216 2555202893 2219658573 16777215 16777215 16777215 16777215 2555202893 4283256141 2538359884 16777216 16777216 2538359884 4283256141 2555202893 16777215 16777215 16777215 16777215 16777216 2538359884 4283256141 2488159822 2488159822 4283256141 2538359884 16777216 16777215 16777215 16777215 16777215 16777215 16777216 2488159822 4283256141 4283256141 2488159822 16777216 16777215 16777215 16777215 16777215 16777215 16777215 16777216 2488159822 4283256141 4283256141 2488159822 16777216 16777215 16777215 16777215 16777215 16777215 16777216 2538359884 4283256141 2488159822 2488159822 4283256141 2538359884 16777216 16777215 16777215 16777215 16777215 2555202893 4283256141 2538359884 16777216 16777216 2538359884 4283256141 2555202893 16777215 16777215 16777215 16777215 2219658573 2555202893 16777216 16777215 16777215 16777216 2555202893 2219658573 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
		offset: 0@0! !

!Tab class methodsFor: 'icons' stamp: 'BenjaminVanRyseghem 6/9/2013 02:50'!
refreshIcon4

	^ Icons 
		at: #refreshIcon4
		ifAbsentPut: [ self refreshIcon4Contents ]! !

!Tab class methodsFor: 'icons' stamp: 'BenjaminVanRyseghem 6/9/2013 02:51'!
refreshIcon10

	^ Icons 
		at: #refreshIcon10
		ifAbsentPut: [ self refreshIcon10Contents ]! !

!Tab class methodsFor: 'icons-contents' stamp: 'BenjaminVanRyseghem 6/9/2013 02:49'!
refreshIcon9Contents

	^ Form
		extent: 16@16
		depth: 32
		fromArray: #(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 289575996 440372534 155686977 0 0 0 0 0 0 0 0 36936489 67128576 67528960 0 323524927 1396738360 2218755126 1196134469 371815206 33575424 0 0 0 0 89638474 223059779 809798206 1211595570 573009187 67124992 575906634 2672398658 3746731595 3109262669 1665304126 219965722 0 0 0 157664086 928161864 1817615695 2656870230 3008533837 2017493820 540507697 1029089356 2925504599 4285246819 4201820524 2824510035 1077048877 118840593 0 0 409253207 1901699919 3126961753 4117868907 4083919974 3243414605 1396277044 1296669248 2925504854 4068260979 4286758522 3697517148 1950384955 321021983 0 0 139703111 1078893636 3261574496 4269653366 4269060973 3612447564 1898934828 909147433 1868342866 3632053619 4287021950 3983256163 2303100992 488924704 0 0 0 1214032211 3144988267 4270112891 3933253225 2722333759 1293901597 335556864 1062379337 3178148454 4236427643 4016876389 2336852803 488991521 0 0 223787853 1684780641 3800022645 4236492411 3177752417 1262124853 167776000 0 1046063183 3228677481 4286692986 3765415529 1816627777 253648920 0 0 291422802 2323432049 3985426563 4186489472 2909054558 658082099 46332305 678544995 2003876453 3766205554 4270113149 3362302305 1246005823 83890432 0 0 661702499 2625685109 4170304648 4203661190 3160909921 1379567156 744470611 1853409644 3565012083 4204055948 4186555010 2942937441 892896305 35016724 0 0 511103337 2273429879 3952529805 4288138895 3681923693 2152238657 1061130039 1971178099 3700412293 4288270481 4152935041 3109986390 1346341177 153255454 0 0 308922717 1652476530 3633237636 4287810441 4151751789 2723058502 1043496236 1182123370 2827669377 3817786501 3548101491 2455741272 1212123705 254903339 0 0 0 846645864 2692793717 3867460732 4151226471 2639304264 640317220 277145719 1568393586 2172372081 1802680424 844275274 273588554 54040627 0 0 0 208264538 1131594088 2708322149 3579553363 1867619657 289311798 31260606 275698785 494127719 276287082 73979227 0 0 0 0 0 0 224640601 844869458 1431610443 760259400 0 0 0 0 0 0 0 0 0)
		offset: 0@0! !

!TabAction commentStamp: '<historical>'!
I am a data object representing an action associated to a tab.

I contains
	- an action to be performed when clicked
	- an icon to be rendered
	- a label to add indication about what I am supposed to do!
!TabAction methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/4/2013 16:33'!
icon: aForm

	icon image: aForm.
	label 
		ifNotNil: [ icon setBalloonText: label maxLineLength: 100 ].
	action ifNotNil: [ icon on: #click send: #value to: action ]! !

!TabAction methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 23:08'!
initialize

	super initialize.

	icon := ImageMorph new! !

!TabAction methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/4/2013 16:10'!
label
	^ label! !

!TabAction methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/4/2013 16:10'!
action
	^ action! !

!TabAction methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/4/2013 16:34'!
action: anObject

	action := anObject.
	icon on: #click send: #value to: action! !

!TabAction methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/4/2013 16:34'!
label: aLabel

	label := aLabel.
	icon setBalloonText: label maxLineLength: 100! !

!TabAction methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/4/2013 16:10'!
icon
	^ icon! !

!TabAction class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 6/4/2013 16:10'!
action: action icon: icon label: label

	^ self new
		action: action;
		icon: icon;
		label: label;
		yourself! !

!TabActionButton commentStamp: '<historical>'!
I am a multi state button supporting icon.

I am used to render tab actions!
!TabActionButton methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/9/2013 03:43'!
icon: anObject
	
	icon := anObject! !

!TabActionButton methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 6/9/2013 03:45'!
forAction: anAction
	| baseColor |
	
	baseColor := Smalltalk ui theme class baseColor.
	self extent: anAction icon extent.
	
	self activeEnabledNotOverUpFillStyle: baseColor.
	
	self activeDisabledNotOverUpFillStyle: (self theme buttonDisabledFillStyleFor: self).
	self passiveEnabledNotOverUpFillStyle: baseColor.
	self passiveDisabledNotOverUpFillStyle: baseColor.
	
	self
		activeEnabledOverUpFillStyle: (self theme buttonMouseOverFillStyleFor: self);
		passiveEnabledOverUpFillStyle: (self theme buttonMouseOverFillStyleFor: self).
	
	self
		activeEnabledOverDownFillStyle: (self theme buttonPressedFillStyleFor: self);
		passiveEnabledOverDownFillStyle: (self theme buttonPressedFillStyleFor: self);
		addUpAction: [ anAction action value ];
		setBalloonText: anAction label;
		extent: 16@16.
		
	icon := anAction icon.
		
	^ self! !

!TabActionButton methodsFor: 'drawing' stamp: 'TorstenBergmann 7/3/2013 08:44'!
drawOn: aCanvas

	super drawOn: aCanvas.
	icon ifNil: [ ^ self ].
	icon form ifNil: [ ^ self ].
	aCanvas
		translucentImage: icon form
		at: self topLeft! !

!TabActionButton methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/7/2015 22:15'!
drawOnAthensCanvas: anAthensCanvas
	super drawOnAthensCanvas: anAthensCanvas.
	icon ifNil: [ ^ self ].
	icon form ifNil: [ ^ self ].
	anAthensCanvas setPaint: icon form.
	anAthensCanvas pathTransform
		restoreAfter: [ 
			anAthensCanvas pathTransform translateBy: self topLeft.
			anAthensCanvas drawShape: (0@0 extent: icon form extent) ]! !

!TabActionButton class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 6/9/2013 03:44'!
forAction: anAction

	^ self new
		forAction: anAction;
		yourself! !

!TabBar commentStamp: '<historical>'!
I am a bar gathering tabs. I am the one managing the selected tab and related bahavior (unselecting the last one, updating the layout to make the selected tab on top of the other)!
!TabBar methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/9/2013 15:28'!
orderedSelectedTabs
	
	^ tabs select: [ :e | e selected ]! !

!TabBar methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/9/2013 14:53'!
reversedSelectedTabs

	^ selectionHistory last: numberOfSelectedTabs! !

!TabBar methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/7/2015 22:18'!
drawLinesWithSelection: anAthensCanvas
	| path |
	path := anAthensCanvas
		createPath: [ :builder | 
			builder absolute.
			builder moveTo: self bottomLeft + (0 @ -1).
			builder lineTo: self selectedTab bottomLeft.
			builder moveTo:  self selectedTab  bottomRight.
			builder lineTo: self bottomRight + (0 @ -1)].
	(anAthensCanvas setStrokePaint: self borderColor) width: 1.
	anAthensCanvas drawShape: path.

	path := anAthensCanvas
		createPath: [ :builder | 
			builder absolute.			
			builder moveTo: self selectedTab bottomLeft.
			builder lineTo: self selectedTab  bottomRight].
	(anAthensCanvas setStrokePaint: self selectedColor) width:1.
	anAthensCanvas drawShape: path.
	! !

!TabBar methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 23:07'!
initialize

	super initialize.

	tabs := OrderedCollection new.
	selectionHistory := OrderedCollection new.
	menuButton := self createMenuButton.
	numberOfSelectedTabs := 1.
	
	self changeProportionalLayout.
	self addMenuButton.
	! !

!TabBar methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/2/2013 19:21'!
canBeClosed

	^ tabs allSatisfy: [ :tab | tab closeable ]! !

!TabBar methodsFor: 'private-actions' stamp: 'BenjaminVanRyseghem 6/2/2013 18:22'!
selectPrevious
	| index nextSelection |
	
	index := tabs indexOf: self selectedTab.
	nextSelection := tabs at: index - 1 ifAbsent: [ ^ self ].

	nextSelection selected: true.! !

!TabBar methodsFor: 'private-history' stamp: 'BenjaminVanRyseghem 6/2/2013 17:38'!
removeFromHistory: aTab

	selectionHistory remove: aTab ifAbsent: [  ].! !

!TabBar methodsFor: 'private' stamp: 'BenjaminVanRyseghem 6/20/2013 17:08'!
computeLength
	| width size length |

	size := tabs size.
	size isZero ifTrue: [ ^ 0 ].
	width := self width - self extraSpace + ((size-1) * self overlap).
	
	length := width / size.
	length := length min: 150.
	length := length max: 33.

	^ length
	! !

!TabBar methodsFor: 'private-actions' stamp: 'BenjaminVanRyseghem 6/21/2013 00:35'!
tabResetSelection: aTab
	"Clicked on an already clicked tab, since it can happened after a multi selection, I have to clear the selection except for this tab"
	
	selectionHistory ifNotEmpty: [
		(selectionHistory last: numberOfSelectedTabs) do: [ :each | each == aTab ifFalse: [ each silentlySelected: false ] ] ].
	
	numberOfSelectedTabs := 1.
	
	self addInHistory: aTab.
	self adjustLayout.
	
	self triggerEvent: #tabResetSelection with: aTab! !

!TabBar methodsFor: 'private-actions' stamp: 'BenjaminVanRyseghem 6/11/2013 02:00'!
tabSelectTo: aTab
	| index selectedIndex |
	
	index := tabs indexOf: aTab. "If absent, then the system must be in a curious shape"
	selectedIndex := tabs indexOf: self selectedTab ifAbsent: [ ^ self ]. "No currently selected tab"
	
	index compareWith: selectedIndex
		ifLesser: [ 
			selectedIndex to: index by: -1 do: [ :i | 
				(tabs at: i) addToSelection	] ]
		ifEqual: [  ]
		ifGreater: [ 
			selectedIndex to: index do: [ :i | 
				(tabs at: i) addToSelection	] ].
			
	self addInHistory: aTab.
	self adjustLayout.! !

!TabBar methodsFor: 'private-actions' stamp: 'BenjaminVanRyseghem 6/9/2013 00:43'!
tabDeleted: aTab

	self removeTab: aTab! !

!TabBar methodsFor: 'private' stamp: 'BenjaminVanRyseghem 6/9/2013 03:30'!
createMenuButton
	"Answer a button for the window menu."
	| form msb |
	
	form := Smalltalk ui theme windowMenuForm.
	msb := MultistateButtonMorph new extent: form extent.
	msb activeEnabledNotOverUpFillStyle: (ImageFillStyle form: form).
	
	form := Smalltalk ui theme windowMenuPassiveForm.
	msb extent: form extent.
	msb activeDisabledNotOverUpFillStyle: (ImageFillStyle form: form).
	msb passiveEnabledNotOverUpFillStyle: (ImageFillStyle form: form).
	msb passiveDisabledNotOverUpFillStyle: (ImageFillStyle form: form).
	
	form := Smalltalk ui theme windowMenuForm.
	msb extent: form extent.
	msb
		activeEnabledOverUpFillStyle: (ImageFillStyle form: form);
		passiveEnabledOverUpFillStyle: (ImageFillStyle form: form).
	
	form := Smalltalk ui theme windowMenuPassiveForm.
	msb
		extent: form extent;
		activeEnabledOverDownFillStyle: (ImageFillStyle form: form);
		passiveEnabledOverDownFillStyle: (ImageFillStyle form: form);
		addUpAction: [ self popUpMenu ];
		setBalloonText: 'tab menu' translated;
		extent: 16@16.
		
	^ msb! !

!TabBar methodsFor: 'private' stamp: 'BenjaminVanRyseghem 6/4/2013 16:47'!
extraSpace

	^ tabs max: [ :each | each extraSpaceForActions ]! !

!TabBar methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/9/2013 15:12'!
isMultiSelection

	^ numberOfSelectedTabs > 1! !

!TabBar methodsFor: 'private-actions' stamp: 'BenjaminVanRyseghem 6/2/2013 18:22'!
selectNext
	| index nextSelection |
	
	index := tabs indexOf: self selectedTab.
	nextSelection := tabs at: index + 1 ifAbsent: [ ^ self ].

	nextSelection selected: true.! !

!TabBar methodsFor: 'private-actions' stamp: 'DamienCassou 9/26/2014 15:02'!
removeTab: aTab
	| nextSelection |

	(aTab selected and: [selectionHistory size > 1])
		ifTrue: [ 
			nextSelection := selectionHistory at: selectionHistory size - 1.
			nextSelection selected: true ].
		
	self removeFromHistory: aTab.
	tabs remove: aTab.

	self adjustLayout! !

!TabBar methodsFor: 'private-actions' stamp: 'BenjaminVanRyseghem 6/9/2013 21:10'!
tabEmptyContents: aTab

	self selectedTab = aTab ifFalse: [ ^ self ].

	(selectionHistory last: numberOfSelectedTabs) do: [ :each | each == aTab ifFalse: [ each silentlySelected: false ] ].	
	numberOfSelectedTabs := 1.
	self adjustLayout.
	
	self triggerEvent: #tabEmptyContents with: aTab! !

!TabBar methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/30/2013 14:07'!
tabs
	^ tabs! !

!TabBar methodsFor: 'private' stamp: 'BenjaminVanRyseghem 6/8/2013 16:09'!
actionsChanged: aTab

	self selectedTab = aTab ifFalse: [ ^ self ].
	self adjustLayout.
	! !

!TabBar methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/2/2013 17:54'!
delete

	super delete.
	self triggerEvent: #barDeleted with: self! !

!TabBar methodsFor: 'menu' stamp: 'BenjaminVanRyseghem 6/4/2013 16:03'!
popUpMenu
	| menu |
	
	menu := self selectedTab menu.
	menu popUpAt: menuButton bottomRight forHand: ActiveHand in: World! !

!TabBar methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/9/2013 01:45'!
addTab: aTab
	
	(tabs includes: aTab) ifTrue: [ ^ self ].

	tabs add: aTab.

	self registerActionsFor: aTab.
	self selectedTab ifNil: [ aTab selected: true ].
	self addFirstInHistory: aTab.
	self adjustLayout.
	self changed.
	self triggerEvent: #tabAdded with: aTab! !

!TabBar methodsFor: 'private-actions' stamp: 'BenjaminVanRyseghem 6/11/2013 01:55'!
tabAddedToSelection: aTab

	aTab selected ifTrue: [ ^ self ].
	numberOfSelectedTabs := numberOfSelectedTabs + 1.
	self addInHistory: aTab.
	aTab silentlySelected: true.
	self adjustLayout.
	
	self triggerEvent: #tabAddedToSelection with: aTab! !

!TabBar methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 6/2/2013 17:28'!
drawLinesOn: aCanvas

	self selectedTab 
		ifNil: [
			aCanvas
				line: self bottomLeft + (0 @ -1)
				to: self bottomRight + (0 @ -1)
				width: 1
				color: self borderColor ]
		ifNotNil: [
			aCanvas
				line: self bottomLeft + (0 @ -1)
				to: self selectedTab bottomLeft
				width: 1
				color: self borderColor.
				
			aCanvas
				line: self selectedTab bottomLeft
				to: self selectedTab  bottomRight
				width: 1
				color: self selectedColor.
				
			aCanvas
				line: self selectedTab  bottomRight
				to: self bottomRight + (0 @ -1)
				width: 1
				color: self borderColor ]! !

!TabBar methodsFor: 'private-history' stamp: 'BenjaminVanRyseghem 6/2/2013 17:38'!
addFirstInHistory: aTab

	self removeFromHistory: aTab.
	selectionHistory addFirst: aTab! !

!TabBar methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 5/30/2013 14:52'!
drawSubmorphsOn: aCanvas

	super drawSubmorphsOn: aCanvas.
	self drawLinesOn: aCanvas! !

!TabBar methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/30/2013 15:25'!
bounds: b

	super bounds: b.
	self adjustLayout! !

!TabBar methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/7/2015 22:06'!
drawSubmorphsOnAthensCanvas: anAthensCanvas
	super drawSubmorphsOnAthensCanvas: anAthensCanvas.
	self selectedTab
		ifNil: [ self drawLinesOnAthensCanvas: anAthensCanvas ]
		ifNotNil: [ self drawLinesWithSelection: anAthensCanvas ]! !

!TabBar methodsFor: 'accessing' stamp: 'MarcusDenker 6/23/2013 17:29'!
selectedTab

	  ^selectionHistory ifEmpty: [ nil ] ifNotEmpty: [ selectionHistory last ]! !

!TabBar methodsFor: 'private' stamp: 'BenjaminVanRyseghem 6/9/2013 03:18'!
addActionsFor: aTab
	| rightOffset |
	
	rightOffset := self actionOffset.
	
	aTab hasMenu
		ifTrue: [ 
			rightOffset := 2 * rightOffset + self menuButtonWidth.
			self addMenuButton ].
		
	aTab actions reverseDo: [ :each || topOffset |
		topOffset := self height - each icon height // 2.
		self 
			addMorph: (self createActionButtonFor: each)
			fullFrame: (LayoutFrame identity
				bottomFraction: 0;
				leftFraction: 1;
				topOffset: topOffset;
				bottomOffset: topOffset + each icon height;
				rightOffset: rightOffset negated ;
				leftOffset: rightOffset negated - each icon width ).
				
		rightOffset := rightOffset + each icon width + self actionOffset]! !

!TabBar methodsFor: 'change reporting' stamp: 'BenjaminVanRyseghem 6/2/2013 19:37'!
ownerChanged

	super ownerChanged.
	self adjustLayout! !

!TabBar methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/20/2013 01:44'!
tabs: aCollection

	tabs do: [ :e | e silentlySelected: false ].
	tabs := aCollection.
	selectionHistory removeAll.
	
	aCollection do: [ :aTab |
		self registerActionsFor: aTab.
		self selectedTab ifNil: [ aTab selected: true ].
		self addFirstInHistory: aTab ].
	
	self adjustLayout.
	self changed.
	self triggerEvent: #tabsChanged! !

!TabBar methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 6/8/2013 16:17'!
adjustLayout
	| length overlap |
	
	length := self computeLength.
	self removeAllMorphs.
	length isZero ifTrue: [ ^ self ].
	overlap := self overlap.	
	
	selectionHistory do: [ :tab || index |
		index := (tabs indexOf: tab) - 1.
		self 
			addMorph: tab
			fullFrame: (LayoutFrame identity
				rightFraction: 0;
				leftOffset: (index*(length-overlap));
				rightOffset: (index*(length-overlap)) + length;
				bottomOffset: -1;
				yourself ).
		tab updateShowIcon ].
	
	self addActionsFor: self selectedTab.! !

!TabBar methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 5/30/2013 14:54'!
selectedColor

	^ Smalltalk ui theme class lightBaseColor! !

!TabBar methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 5/30/2013 14:48'!
borderColor

	^ Color gray! !

!TabBar methodsFor: 'private' stamp: 'BenjaminVanRyseghem 6/10/2013 17:32'!
registerActionsFor: aTab

	aTab 
		when: #tabSelected send: #tabSelected: to: self;
		when: #tabDeleted send: #tabDeleted: to: self;
		when: #rightKeyPressed send: #rightKeyPressed: to: self;
		when: #leftKeyPressed send: #leftKeyPressed: to: self;
		when: #tabRefreshed send: #tabRefreshed: to: self;
		when: #actionsChanged send: #actionsChanged: to: self;
		when: #tabResetSelection send: #tabResetSelection: to: self;
		when: #tabAddedToSelection send: #tabAddedToSelection: to: self;
		when: #tabRemovedFromSelection send: #tabRemovedFromSelection: to: self;
		when: #tabSelectTo send: #tabSelectTo: to: self;
		when: #tabEmptyContents send: #tabEmptyContents: to: self! !

!TabBar methodsFor: 'private' stamp: 'BenjaminVanRyseghem 5/30/2013 14:12'!
overlap

	^ 8! !

!TabBar methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/9/2013 21:21'!
selectLastTab
	| tab |
	
	tab := tabs lastIfAbsent: [ ^ self ].
	tab selected: true! !

!TabBar methodsFor: 'private-actions' stamp: 'BenjaminVanRyseghem 6/11/2013 02:02'!
deleteSelectedTabs
	
	self selectedTabs do: [:e | e close ].! !

!TabBar methodsFor: 'private-constants' stamp: 'BenjaminVanRyseghem 6/4/2013 16:24'!
menuButtonWidth
	^ 16! !

!TabBar methodsFor: 'private' stamp: 'BenjaminVanRyseghem 6/9/2013 03:45'!
createActionButtonFor: anAction

	^ TabActionButton forAction: anAction! !

!TabBar methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/7/2015 22:18'!
drawLinesOnAthensCanvas: anAthensCanvas
	| path |
	path := anAthensCanvas
		createPath: [ :builder | 
			builder moveTo: self bottomLeft + (0 @ -1).
			builder lineTo: self bottomRight + (0 @ -1) ].
	(anAthensCanvas setStrokePaint: self borderColor) width: 5.
	anAthensCanvas drawShape: path! !

!TabBar methodsFor: 'initialize' stamp: 'BenjaminVanRyseghem 6/9/2013 21:06'!
addMenuButton
	| topOffset rightOffset |
	
	rightOffset := self actionOffset.
	topOffset := (self height - 16) // 2.
	self
		addMorph: menuButton
		fullFrame:
			(LayoutFrame identity
				bottomFraction: 0;
				leftFraction: 1;
				rightOffset: rightOffset negated;
				leftOffset: rightOffset negated - self menuButtonWidth;
				topOffset: topOffset;
				bottomOffset: topOffset + self menuButtonHeight)! !

!TabBar methodsFor: 'private' stamp: 'BenjaminVanRyseghem 6/4/2013 14:49'!
needSpaceForActions 
	| tab |
	
	tab := self selectedTab.
	tab ifNil: [ ^ false ].

	^ self selectedTab hasMenu or: [ self selectedTab hasActions ]! !

!TabBar methodsFor: 'private-actions' stamp: 'BenjaminVanRyseghem 6/8/2013 15:37'!
tabRefreshed: aTab

	self selectedTab = aTab ifFalse: [ ^ self ].

	self triggerEvent: #tabRefreshed with: aTab! !

!TabBar methodsFor: 'private-actions' stamp: 'BenjaminVanRyseghem 6/10/2013 17:29'!
tabRemovedFromSelection: aTab

	numberOfSelectedTabs == 1 ifTrue: [ ^ self ].
	numberOfSelectedTabs := numberOfSelectedTabs - 1.

	"Insert the remove tab just before the selected ones to preserve order"
	selectionHistory remove: aTab.
	selectionHistory add: aTab afterIndex: (selectionHistory size - numberOfSelectedTabs).
	
	aTab silentlySelected: false.
	self adjustLayout.
	
	self triggerEvent: #tabRemovedFromSelection with: aTab! !

!TabBar methodsFor: 'private-actions' stamp: 'BenjaminVanRyseghem 6/11/2013 01:55'!
tabSelected: aTab

	self isMultiSelection
		ifTrue: [ self tabResetSelection: aTab ]
		ifFalse: [ 
			self selectedTab ifNotNil: [ self selectedTab selected: false ].
			self addInHistory: aTab.	
			self adjustLayout.
			self triggerEvent: #tabSelected with: aTab ]! !

!TabBar methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/9/2013 14:53'!
selectedTabs

	^ (selectionHistory last: numberOfSelectedTabs) reversed! !

!TabBar methodsFor: 'private-history' stamp: 'BenjaminVanRyseghem 6/2/2013 17:38'!
addInHistory: aTab

	self removeFromHistory: aTab.
	selectionHistory addLast: aTab! !

!TabBar methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/2/2013 19:26'!
closeAllTabs

	tabs copy do: [ :tab | tab close ]! !

!TabBar methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/9/2013 21:19'!
selectTabAt: index ifAbsent: aBlock
	| tab |
	
	tab := tabs at: index ifAbsent: [ ^ aBlock value ].
	tab selected: true! !

!TabBar methodsFor: 'private-constants' stamp: 'BenjaminVanRyseghem 6/4/2013 16:23'!
actionOffset

	^ 4! !

!TabBar methodsFor: 'private-constants' stamp: 'BenjaminVanRyseghem 6/4/2013 16:25'!
menuButtonHeight
	^ 16! !

!TabContainerMorph commentStamp: '<historical>'!
A TabContainerMorph is a morph (which should be pluggable soon) which handle a first bar for tabs button and a container which is used to display the morph corresponding to the selected tab!
!TabContainerMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/7/2012 06:08'!
container

	^ container! !

!TabContainerMorph methodsFor: 'initialization' stamp: 'CamilloBruni 9/22/2013 21:34'!
initialize

	super initialize.
	
	self changeProportionalLayout.
	container := PanelMorph new
		changeTableLayout;
		listDirection: #bottomToTop;
		color: Color white;
		yourself.
	
	tab := PluggableTabBarMorph on: self.
	tab width: 150.
	tab color: Color white darker darker.
	
	self addAll.! !

!TabContainerMorph methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 1/7/2012 06:02'!
addTabs: associations

	associations do: [:each |
		self tab 
			addTab: (Text fromString: each key) 
			withAction: [ self setContent: each value ].
		container submorphs isEmpty ifTrue: [ container addMorph: each value ]]! !

!TabContainerMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 1/9/2012 18:43'!
setContent: aMorph

	container removeAllMorphs.
	container addMorph: aMorph.
	aMorph color: Color white.
	aMorph takeKeyboardFocus.! !

!TabContainerMorph methodsFor: 'private' stamp: 'IgorStasenko 12/19/2012 18:07'!
addAll
	
	self
		addMorph: tab
		fullFrame: ((0 @ 0 corner: 1 @ 0) asLayoutFrame bottomOffset: 35).
				
	self
		addMorph: container
		fullFrame: (LayoutFrame identity topOffset: 35)! !

!TabContainerMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 1/7/2012 06:08'!
tab

	^ tab! !

!TabContainerMorph class methodsFor: 'example' stamp: 'bvr 6/4/2012 17:26'!
example

	| tc testMorph model model2 model3 anotherMorph anotherMorph2 associations classes |
	
	model := ClassMethodBrowser new.
	model2 := ClassMethodBrowser new.
	model3 := ClassMethodBrowser new.
	
	testMorph := model buildWithSpec.
	anotherMorph := model2 buildWithSpec.
	anotherMorph2 := model3 buildWithSpec.
	
	associations := {'Test' -> testMorph. 'Another'-> anotherMorph. 'Again' -> anotherMorph2}.
	tc := self withTabs: associations.
	classes := Smalltalk allClasses.
	model classes: classes .
	model2 classes: classes.
	model3 classes: classes.
	
	( tc embeddedInMorphicWindowLabeled: 'test') openInWorld.
	^ tc! !

!TabContainerMorph class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 1/7/2012 06:04'!
withTabs: associations

	^ self new
		addTabs: associations;
		yourself.! !

!TabDisabled commentStamp: '<historical>'!
I am the state corresponding to a tab being disabled.!
!TabDisabled methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/30/2013 13:35'!
isSelectedMatchingTheState: aBoolean

	^ aBoolean not! !

!TabDisabled methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/30/2013 13:35'!
isEnabledMatchingTheState: aBoolean

	^ aBoolean not! !

!TabDisabled methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/30/2013 13:35'!
newStateForSelected: aBoolean
	"An disabled tab can not be selected"
	
	^ self! !

!TabDisabled methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/30/2013 13:35'!
newStateForEnabled: aBoolean

	^ TabEnabled tab: self tab! !

!TabDisabled methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/30/2013 13:30'!
backgroundColor
	
	^ Color gray darker! !

!TabEnabled commentStamp: '<historical>'!
I am the state of a tab enabled but not yet selected!
!TabEnabled methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/30/2013 13:24'!
isSelectedMatchingTheState: aBoolean

	^ aBoolean not! !

!TabEnabled methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/30/2013 13:24'!
isEnabledMatchingTheState: aBoolean

	^ aBoolean! !

!TabEnabled methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/30/2013 14:17'!
enabled

	^ true! !

!TabEnabled methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/30/2013 13:33'!
newStateForSelected: aBoolean
	self assert: aBoolean.
	
	^ TabSelected tab: self tab! !

!TabEnabled methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/30/2013 13:32'!
newStateForEnabled: aBoolean
	"aBoolean here must be false"
	self deny: aBoolean.
	
	^ TabDisabled tab: self tab! !

!TabEnabled methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/9/2013 15:09'!
backgroundColor
	
	^ Color fromHexString: 'aaaaaa'! !

!TabExample commentStamp: '<historical>'!
I am an example of how to:
	- instanciate tabs (#tabs)
	- use a tab manager
	
Nothing really complicated here.

self open!
!TabExample methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/9/2013 02:58'!
window

	^ window! !

!TabExample methodsFor: 'private' stamp: 'BenjaminVanRyseghem 5/30/2013 15:10'!
addTabs

	self tabs do: [ :tab | manager addTab: tab ]! !

!TabExample methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 9/25/2013 18:24'!
initialize

	super initialize.

	manager := TabManager new.
	manager
		when: #tabManagerDeleted send: #delete to: self.
	listModel := ListModel new.
	listModel items: ((1 to: 1000) asOrderedCollection)! !

!TabExample methodsFor: 'tabs creation' stamp: 'BenjaminVanRyseghem 6/4/2013 16:14'!
redMorphTab
	
	^ (LockableTab
		label: 'Red Morph'
		icon: Smalltalk ui icons smallBackIcon
		morph:
			(Morph new
				color: Color red;
				yourself))
		closeable: false;
		yourself! !

!TabExample methodsFor: 'private' stamp: 'BenjaminVanRyseghem 6/2/2013 18:13'!
delete

	window ifNotNil: [ window delete ]! !

!TabExample methodsFor: 'tabs creation' stamp: 'BenjaminVanRyseghem 6/9/2013 03:05'!
blueMorphTab
	| tab |
	tab := Tab 
		label: 'Blue Morph' 
		icon: Smalltalk ui icons smallBackIcon 
		morph: Morph new.
	tab	
		actions: { (TabAction
			action: [ tab morph color: Color random ]
			icon: Smalltalk ui icons smallConfigurationIcon
			label: 'Randomize color') }.
	tab
		closeable: false;
		menu: [ :menu |
				menu
					add: 'Fubu' 
					target: self 
					selector: #halt ].
				
	 ^ tab! !

!TabExample methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 6/9/2013 01:50'!
open
	
	window := manager openInWindow.
	window extent: 400@300.
	
	self addTabs.
"	listModel openWithSpec"! !

!TabExample methodsFor: 'tabs creation' stamp: 'BenjaminVanRyseghem 6/4/2013 16:14'!
storedListTab
	
	^ Tab label: 'Stored List Model' icon: Smalltalk ui icons smallHelpIcon retrievingBlock: [ listModel buildWithSpec ]! !

!TabExample methodsFor: 'tabs creation' stamp: 'BenjaminVanRyseghem 9/25/2013 18:24'!
freshListTab
	
	^ (Tab
		label: 'Fresh List'
		icon: nil
		retrievingBlock: [ 
			1 second asDelay wait.
			ListModel new
				items: (1 to: 50) asOrderedCollection;
				buildWithSpec ]
		actions: { (TabAction
			action: [ self halt ]
			icon: Smalltalk ui icons smallConfigurationIcon
			label: 'Halt!!') })
		menu: [ :menu |
			menu
				add: 'Fubu' 
				target: self 
				selector: #halt ];
		yourself! !

!TabExample methodsFor: 'private' stamp: 'BenjaminVanRyseghem 6/4/2013 16:14'!
tabs
	
	^ OrderedCollection new
		add: self storedListTab;
		add: self freshListTab;
		add: self blueMorphTab;
		add: self redMorphTab;
		yourself! !

!TabExample class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 5/30/2013 15:09'!
open

	^ self new open! !

!TabGroupMorph commentStamp: 'gvc 5/18/2007 11:54'!
Organises a set of pages sharing the same space and selected through the use of tabs along the top.!
!TabGroupMorph methodsFor: 'accessing' stamp: 'GaryChambers 6/10/2011 13:37'!
page: aMorph
	"Select the give page."

	self selectedPageIndex: (self pages indexOf: aMorph)! !

!TabGroupMorph methodsFor: 'updating' stamp: 'gvc 1/17/2008 11:36'!
themeChanged
	"Update the corner style."

	self cornerStyle: (self theme tabGroupCornerStyleIn: self window).
	super themeChanged! !

!TabGroupMorph methodsFor: 'accessing' stamp: 'gvc 9/15/2006 13:58'!
pageMorph
	"Answer the current page morph if any."

	^self contentMorph hasSubmorphs
		ifTrue: [self contentMorph submorphs first]! !

!TabGroupMorph methodsFor: 'drawing' stamp: 'AttilaMagyar 10/19/2013 00:38'!
minExtent
	"Calculate the min extent of the receiver based on all pages."

	|extra|
	self page ifNil: [^super minExtent max: self tabSelectorMorph minExtent].
	extra := 0@(self tabSelectorMorph minExtent y) + (self contentMorph borderWidth * 2).
	extra := extra + (self contentMorph layoutInset * 2).
	^super minExtent max: (((self pages inject: 0 @ 0 into: [:mw :pm | mw max: pm minExtent]) + extra)
		max: self tabSelectorMorph minExtent)! !

!TabGroupMorph methodsFor: 'page' stamp: 'GaryChambers 6/10/2011 10:57'!
updatePageIndex: index
	"Change to the given page index."

	self pageMorph ifNotNil: [:p | self contentMorph removeMorph: p].
	index > 0 ifTrue: [self contentMorph addMorph: (self pages at: index)].
	self pageMorph ifNotNil: [:pm | pm layoutChanged].
	self adoptPaneColor: self paneColor! !

!TabGroupMorph methodsFor: 'building' stamp: 'StephaneDucasse 9/7/2013 12:40'!
newContentMorph
	"Answer a new content morph"

	|p|
	p := PanelMorph new
		roundedCorners: #(2 3 4);
		changeTableLayout; 
		layoutInset: 4;
		cellInset: 8;
		vResizing: #spaceFill;
		hResizing: #spaceFill.
	p borderStyle: (self theme tabPanelBorderStyleFor: self).
	^p! !

!TabGroupMorph methodsFor: 'accessing' stamp: 'gvc 9/15/2006 13:28'!
contentMorph: anObject
	"Set the value of contentMorph"

	contentMorph := anObject! !

!TabGroupMorph methodsFor: 'page' stamp: 'GaryChambers 6/10/2011 13:26'!
relabelPage: aMorph with: aStringOrMorph
	"Relabel the tab associated with the given page and
	update tabs."

	self tabSelectorMorph
		relabelTab: (self tabOfPage: aMorph) with: aStringOrMorph! !

!TabGroupMorph methodsFor: 'accessing' stamp: 'gvc 9/15/2006 13:53'!
pageMorphs
	"Answer the value of pageMorphs"

	^ pageMorphs! !

!TabGroupMorph methodsFor: 'accessing' stamp: 'gvc 9/15/2006 11:51'!
tabSelectorMorph: anObject
	"Set the value of tabSelectorMorph"

	tabSelectorMorph := anObject! !

!TabGroupMorph methodsFor: 'accessing' stamp: 'GaryChambers 6/8/2011 12:31'!
selectedTab
	"Answer the tab of the selected page."
	
 	^self tabSelectorMorph selectedTab! !

!TabGroupMorph methodsFor: 'building' stamp: 'gvc 9/15/2006 13:30'!
newTabSelectorMorph
	"Answer a new tab selector morph"

	^TabSelectorMorph new
		vResizing: #shrinkWrap;
		hResizing: #spaceFill! !

!TabGroupMorph methodsFor: 'accessing' stamp: 'gvc 1/16/2008 13:37'!
adoptPaneColor: paneColor
	"Pass on to the content morph a little lighter."
	
	paneColor ifNil: [^super adoptPaneColor: paneColor].
	super adoptPaneColor: (self theme subgroupColorFrom: paneColor).
	self contentMorph borderStyle: (self theme tabPanelBorderStyleFor: self)! !

!TabGroupMorph methodsFor: 'adding' stamp: 'GaryChambers 8/10/2010 14:38'!
removePage: aMorph
	"Remove the given page and its tab."

	|index|
	index := self pages indexOf: aMorph.
	self pages remove: aMorph.
	self tabSelectorMorph removeTabIndex: index! !

!TabGroupMorph methodsFor: 'accessing' stamp: 'gvc 9/16/2006 08:46'!
font: aFont
	"Set the label font"

	self tabSelectorMorph font: aFont! !

!TabGroupMorph methodsFor: 'initialization' stamp: 'gvc 3/19/2010 16:21'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		borderWidth: 0;
		changeTableLayout;
		cellPositioning: #topLeft;
		cellInset: 0 @ -1;
		reverseTableCells: true;
		pageMorphs: OrderedCollection new;
		tabSelectorMorph: self newTabSelectorMorph;
		contentMorph: self newContentMorph;
		addMorph: self tabSelectorMorph;
		addMorph: self contentMorph.
	self tabSelectorMorph addDependent: self! !

!TabGroupMorph methodsFor: 'page' stamp: 'GaryChambers 6/10/2011 13:22'!
tabOfPage: aMorph
	"Answer the tab associated with the given page."

	^self tabSelectorMorph tabs at: (self pages indexOf: aMorph)! !

!TabGroupMorph methodsFor: 'accessing' stamp: 'MarcusDenker 12/11/2009 07:42'!
paneColorOrNil
	"Answer the window's pane color or nil otherwise."

	^super paneColorOrNil ifNotNil: [:c | self theme subgroupColorFrom: c]! !

!TabGroupMorph methodsFor: 'adding' stamp: 'GaryChambers 11/23/2011 17:20'!
addPage: aMorph label: aStringOrMorph selected: selectedStringOrMorph
	"Add a page and its tab with alternate label when selected."

	aMorph
		hResizing: #spaceFill;
		vResizing: #spaceFill.
	self pages add: aMorph.
	self tabSelectorMorph addTab: aStringOrMorph selected: selectedStringOrMorph! !

!TabGroupMorph methodsFor: 'page' stamp: 'gvc 9/15/2006 13:55'!
selectedPageIndex: index
	"Set the selected page index."

	self tabSelectorMorph selectedIndex: index! !

!TabGroupMorph methodsFor: 'adding' stamp: 'gvc 9/15/2006 14:13'!
addPage: aMorph label: aStringOrMorph
	"Add a page and its tab."

	aMorph
		hResizing: #spaceFill;
		vResizing: #spaceFill.
	self pages add: aMorph.
	self tabSelectorMorph addTab: aStringOrMorph! !

!TabGroupMorph methodsFor: 'accessing' stamp: 'gvc 9/15/2006 13:53'!
pageMorphs: anObject
	"Set the value of pageMorphs"

	pageMorphs := anObject! !

!TabGroupMorph methodsFor: 'updating' stamp: 'gvc 9/15/2006 13:59'!
update: aSymbol
	"Handle tab changes."

	super update: aSymbol.
	aSymbol == #selectedIndex
		ifTrue: [self updatePageIndex: self selectedPageIndex]! !

!TabGroupMorph methodsFor: 'accessing' stamp: 'gvc 9/15/2006 13:28'!
contentMorph
	"Answer the value of contentMorph"

	^ contentMorph! !

!TabGroupMorph methodsFor: 'rounding' stamp: 'gvc 9/15/2006 13:44'!
cornerStyle: aSymbol
	"Pass on to selector and content too."

	super cornerStyle: aSymbol.
	self tabSelectorMorph cornerStyle: aSymbol.
	self contentMorph cornerStyle: aSymbol! !

!TabGroupMorph methodsFor: 'accessing' stamp: 'gvc 9/15/2006 11:51'!
tabSelectorMorph
	"Answer the value of tabSelectorMorph"

	^ tabSelectorMorph! !

!TabGroupMorph methodsFor: 'accessing' stamp: 'gvc 9/15/2006 14:00'!
pages
	"Answer the pages."

	^self pageMorphs! !

!TabGroupMorph methodsFor: 'page' stamp: 'gvc 9/15/2006 11:51'!
selectedPageIndex
	"Answer the selected page index."

	^self tabSelectorMorph selectedIndex! !

!TabGroupMorph methodsFor: 'page' stamp: 'gvc 9/16/2006 08:44'!
labelsAndPages: assocs
	"Replace the tabs and the associated pages."

	self contentMorph removeAllMorphs.
	self tabSelectorMorph removeAllMorphs.
	assocs do: [:a | self addPage: a value label: a key]! !

!TabGroupMorph methodsFor: 'accessing' stamp: 'gvc 9/15/2006 14:00'!
page
	"Answer the current page morph if any."

	^self pageMorph! !

!TabGroupMorph methodsFor: 'drawing' stamp: 'gvc 6/2/2009 10:59'!
fullDrawOn: aCanvas
	"Patch up the selected tab visuals if required."
	
	super fullDrawOn: aCanvas.
	self theme drawTabGroupFinishingFor: self on: aCanvas! !

!TabGroupMorph methodsFor: 'page' stamp: 'GaryChambers 8/10/2010 14:23'!
removePageIndex: anInteger
	"Remove the page at index anInteger page and its tab."

	self pages removeAt: anInteger.
	self tabSelectorMorph removeTabIndex: anInteger! !

!TabGroupMorph methodsFor: 'accessing' stamp: 'gvc 9/16/2006 08:47'!
font
	"Answer the label font"

	^self tabSelectorMorph font! !

!TabGroupMorph class methodsFor: 'example' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
example

	| builder window page1 page2 label1 label2 tabs content okButton cancelButton |
	builder := self theme builder.
	okButton := builder newOKButton.
	cancelButton := builder newCancelButton.
	page1 := ( builder newStack: {
		( builder
			newAlphaImage: Smalltalk ui icons warningIcon
			help: nil)
			alpha: 0.5.
		CircleMorph new
			hResizing: #spaceFill;
			vResizing: #spaceFill})
		fillStyle: Color red;
		hResizing: #spaceFill;
		vResizing: #spaceFill.
	page2 :=  builder newPanel
		fillStyle: Color green;
		hResizing: #spaceFill;
		vResizing: #spaceFill.
	label1 :=  builder newRow: {
		 builder newButtonLabel: 'First page'.
		 builder
			newCloseControlFor: nil
			action: [tabs removePage: page1]
			help: 'Close this tab'}.
	label2 :=  builder newRow: {
		 builder newButtonLabel: 'Second page'.
		 builder
			newCloseControlFor: nil
			action: [tabs removePage: page2]
			help: 'Close this tab'}.
	label1 cellInset: 0.
	label2 cellInset: 0.
	tabs :=  builder newTabGroup: {
		label1 -> page1.
		label2-> page2}.
	content :=  builder 
			newColumn: {
				tabs.
				( builder newRow: {okButton. cancelButton})
					listCentering: #bottomRight}.
	window := content
		extent: 250@300;
		openInWindow.
	okButton model: window; action: #delete.
	cancelButton model: window; action: #delete! !

!TabLabelItem commentStamp: '<historical>'!
I am a special label morph for tabs.

This way I can control which of my submorphs to show according to the tab size!
!TabLabelItem methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 5/30/2013 20:06'!
clipSubmorphs 

	^ true! !

!TabLabelItem methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/30/2013 20:00'!
icon: anObject

	icon ifNotNil: [ self removeMorph: icon ].
	
	icon := anObject.
	icon ifNotNil: [ 	self addMorphFront: icon ]! !

!TabLabelItem methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 5/30/2013 20:12'!
drawSubmorphsOn: aCanvas
	"Display submorphs back to front"

	| drawBlock submorphsToDraw |
	submorphs isEmpty
		ifTrue: [ ^ self ].
	
	submorphsToDraw := self computeSubmorphsToDraw.
	
	drawBlock := [ :canvas | submorphsToDraw do: [ :m | canvas fullDrawMorph: m ] ].
	
	self clipSubmorphs
		ifTrue: [ aCanvas clipBy: (aCanvas clipRect intersect: self clippingBounds ifNone: [ ^ self ]) during: drawBlock ]
		ifFalse: [ drawBlock value: aCanvas ]! !

!TabLabelItem methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 6/2/2013 18:41'!
clippingBounds
	"Return the bounds to which any submorphs should be clipped if the property is set"
	^ tab modifyClippingBounds: super clippingBounds! !

!TabLabelItem methodsFor: 'drawing-private' stamp: 'BenjaminVanRyseghem 6/2/2013 19:15'!
computeSubmorphsToDraw

	owner width < tab showIconTreshold 
		ifTrue: [ 
			(storedIcon isNil and: [ icon notNil ]) ifTrue: [
				storedIcon := icon.
				self removeMorph: icon ].
			^ { morph } ].
		
	storedIcon 
		ifNotNil: [ 
			self addMorphFront: storedIcon.
			storedIcon := nil ].
		
	^ self submorphs! !

!TabLabelItem methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/2/2013 18:37'!
tab: anObject
	
	tab := anObject! !

!TabLabelItem class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 6/2/2013 18:37'!
tab: tab

	^ self new
		tab: tab;
		yourself! !

!TabLabelMorph commentStamp: 'gvc 9/23/2008 11:49'!
Specially themed label used for tab selector items. !
!TabLabelMorph methodsFor: 'style' stamp: 'gvc 1/7/2008 11:11'!
selectedFillStyle
	"Return the selected fillStyle of the receiver."
	
	^self theme tabLabelSelectedFillStyleFor: self! !

!TabLabelMorph methodsFor: 'accessing' stamp: 'GaryChambers 11/23/2011 17:19'!
selected: aBoolean
	"Use the appropriate label."

	self removeAllMorphs.
	self isSelected
		ifTrue: [self addMorph: self selectedLabel]
		ifFalse: [self addMorph: self normalLabel]! !

!TabLabelMorph methodsFor: 'geometry' stamp: 'GaryChambers 6/7/2011 17:49'!
extent: aPoint
	"Set the extent of the receiver.
	Update the pane color for size dependent fill/border styles."

	super extent: aPoint.
	self adoptPaneColor! !

!TabLabelMorph methodsFor: 'testing' stamp: 'GaryChambers 6/10/2011 13:47'!
isSelected
	"Answer whether the tab is selected."

	^self tabSelector
		ifNil: [false]
		ifNotNil: [:selector | selector selectedTab == self]! !

!TabLabelMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 5/22/2007 16:26'!
focusBounds
	"Answer the bounds for drawing the focus indication."

	^(self bounds width < 6 or: [self bounds height < 6])
		ifTrue: [super focusBounds]
		ifFalse: [super focusBounds insetBy: (2@2 corner: 2@0)]! !

!TabLabelMorph methodsFor: 'accessing' stamp: 'GaryChambers 11/23/2011 17:08'!
selectedLabel

	^ selectedLabel! !

!TabLabelMorph methodsFor: 'accessing' stamp: 'GaryChambers 6/10/2011 13:44'!
tabSelector: anObject

	tabSelector := anObject! !

!TabLabelMorph methodsFor: 'accessing' stamp: 'GaryChambers 6/10/2011 13:44'!
tabSelector

	^ tabSelector! !

!TabLabelMorph methodsFor: 'accessing' stamp: 'GaryChambers 11/23/2011 17:08'!
normalLabel

	^ normalLabel! !

!TabLabelMorph methodsFor: 'accessing' stamp: 'gvc 1/7/2008 12:01'!
adoptPaneColor: paneColor
	"Use the theme for fillStyle and border."
	
	super adoptPaneColor: paneColor.
	paneColor ifNil: [^self].
	self fillStyle: self fillStyleToUse.
	self borderStyle: self borderStyleToUse! !

!TabLabelMorph methodsFor: 'style' stamp: 'gvc 1/7/2008 11:11'!
normalFillStyle
	"Return the normal fillStyle of the receiver."
	
	^self theme tabLabelNormalFillStyleFor: self! !

!TabLabelMorph methodsFor: 'accessing' stamp: 'GaryChambers 11/23/2011 17:10'!
font: aFont
	"Set the label font"

	self normalLabel allMorphsDo: [:m |
		(m respondsTo: #font:) ifTrue: [m font: aFont]].
	self selectedLabel allMorphsDo: [:m |
		(m respondsTo: #font:) ifTrue: [m font: aFont]]! !

!TabLabelMorph methodsFor: 'initialization' stamp: 'gvc 1/7/2008 11:16'!
initialize
	"Initialize the receiver."
	
	super initialize.
	self fillStyle: self fillStyleToUse.
	self borderStyle: self borderStyleToUse! !

!TabLabelMorph methodsFor: 'accessing' stamp: 'GaryChambers 11/23/2011 17:08'!
selectedLabel: anObject

	selectedLabel := anObject! !

!TabLabelMorph methodsFor: 'accessing' stamp: 'GaryChambers 11/23/2011 17:11'!
label
	"Answer the label contents."

	^self isSelected
		ifTrue: [self selectedLabel userString ifNil: [self firstSubmorph]]
		ifFalse: [self normalLabel userString ifNil: [self firstSubmorph]]! !

!TabLabelMorph methodsFor: 'accessing' stamp: 'GaryChambers 11/23/2011 17:29'!
label: aStringOrMorph selected: selectedStringOrMorph
	"Change the label contents"

	|l s|
	l := aStringOrMorph isMorph
		ifTrue: [aStringOrMorph]
		ifFalse: [(self theme buttonLabelForText: aStringOrMorph)
					vResizing: #shrinkWrap;
					hResizing: #shrinkWrap].
	s:= selectedStringOrMorph isMorph
		ifTrue: [selectedStringOrMorph]
		ifFalse: [(self theme buttonLabelForText: selectedStringOrMorph)
					vResizing: #shrinkWrap;
					hResizing: #shrinkWrap].
	self
		normalLabel: l;
		selectedLabel: s;
		selected: self isSelected! !

!TabLabelMorph methodsFor: 'accessing' stamp: 'gvc 1/7/2008 11:10'!
fillStyleToUse
	"Answer the basic fill style for the receiver."

	^self isSelected
		ifTrue: [self selectedFillStyle] 
		ifFalse: [self normalFillStyle]! !

!TabLabelMorph methodsFor: 'layout' stamp: 'gvc 1/14/2009 15:25'!
minWidth
	"Consult the theme also."

	^super minWidth max: self theme buttonMinWidth! !

!TabLabelMorph methodsFor: 'testing' stamp: 'GaryChambers 6/10/2011 13:50'!
isVisible
	"Answer whether the tab is currently visible."

	^self tabSelector
		ifNil: [false]
		ifNotNil: [:selector | selector visibleTabs includes: self]! !

!TabLabelMorph methodsFor: 'accessing' stamp: 'GaryChambers 11/23/2011 17:19'!
label: aStringOrMorph
	"Change the label contents"

	|l|
	l := aStringOrMorph isMorph
		ifTrue: [aStringOrMorph]
		ifFalse: [(self theme buttonLabelForText: aStringOrMorph)
					vResizing: #shrinkWrap;
					hResizing: #shrinkWrap].
	self
		normalLabel: l;
		selectedLabel: l;
		selected: self isSelected! !

!TabLabelMorph methodsFor: 'accessing' stamp: 'GaryChambers 11/23/2011 17:08'!
normalLabel: anObject

	normalLabel := anObject! !

!TabLabelMorph methodsFor: 'accessing' stamp: 'gvc 1/7/2008 11:29'!
borderStyleToUse
	"Answer the borderStyle that should be used for the receiver."
	
	^self isSelected
		ifTrue: [self theme tabLabelSelectedBorderStyleFor: self]
		ifFalse: [self theme tabLabelNormalBorderStyleFor: self]! !

!TabManager commentStamp: '<historical>'!
I am the entry point for tabs.

I am composed of a TabBar and a Morph used as a canvas to render the morph represented by the selected tab.

I am very stupid (as you can see only four methods). I just listen to selected tab, and render it!
!TabManager methodsFor: 'private' stamp: 'BenjaminVanRyseghem 6/9/2013 14:41'!
addMorphs

	self 
		addMorph: toolbar
		fullFrame: (LayoutFrame identity
			bottomFraction: 0;
			bottomOffset: 27;
			yourself).
			
	self 
		addMorph: container
		fullFrame: (LayoutFrame identity
			topOffset: 27;
			yourself).
			
	container
		addMorph: contentsWrapper
		fullFrame:
			(LayoutFrame identity
				topOffset: 10;
				rightOffset: -1;
				bottomOffset: -1;
				leftOffset: 2;
				yourself).! !

!TabManager methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/2/2013 19:20'!
close

	self canBeClosed ifFalse: [ ^ self ].
	self delete.! !

!TabManager methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 5/30/2013 20:01'!
drawSubmorphsOn: aCanvas
	super drawSubmorphsOn: aCanvas.
	self drawLinesOn: aCanvas! !

!TabManager methodsFor: 'private-contents' stamp: 'BenjaminVanRyseghem 6/9/2013 20:52'!
addLastTabContents: aTab among: size delta: delta
	| process |
	
	process := aTab retrieveMorph: [ :contents | 
		contents ifNil: [ TabWithNoContents signalTab: aTab ].
		contentsWrapper
			addMorph: contents
			fullFrame:
				(LayoutFrame identity
					leftFraction: (size - 1) * delta;
					leftOffset: 2;
					rightFraction: 1).
		contents takeKeyboardFocus ].
	
	process ifNotNil: [ processes add: process ]! !

!TabManager methodsFor: 'private-actions' stamp: 'BenjaminVanRyseghem 6/9/2013 21:18'!
selectTabAt: index

	toolbar selectTabAt: index ifAbsent: [].! !

!TabManager methodsFor: 'initialize' stamp: 'BenjaminVanRyseghem 6/18/2013 18:55'!
minExtent

	^ 100@50! !

!TabManager methodsFor: 'initialize' stamp: 'BenjaminVanRyseghem 6/10/2013 17:10'!
registerBarActions
	
	toolbar 
		when: #tabSelected send: #tabSelected: to: self;
		when: #barDeleted send: #barDeleted: to: self;
		when: #tabsChanged send: #tabsChanged to: self;
		when: #tabRefreshed send: #tabRefreshed: to: self;
		when: #tabAddedToSelection send: #tabAddedToSelection: to: self;
		when: #tabRemovedFromSelection send: #tabRemovedFromSelection: to: self;
		when: #tabResetSelection send: #tabResetSelection: to: self;
		when: #tabEmptyContents send: #tabEmptyContents: to: self! !

!TabManager methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/19/2013 16:52'!
selectedTab

	^ toolbar selectedTab! !

!TabManager methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/18/2013 19:51'!
adoptPaneColor: aColor
	"Prevent submorphs to be polluted by window color"
	
	self color: aColor! !

!TabManager methodsFor: 'private' stamp: 'BenjaminVanRyseghem 6/9/2013 20:54'!
cleanProcesses
	
	processes do: [ :each | each terminate ].
	processes removeAll.! !

!TabManager methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/8/2013 16:24'!
tabs: aCollection

	toolbar tabs: aCollection! !

!TabManager methodsFor: 'private-actions' stamp: 'BenjaminVanRyseghem 6/2/2013 18:24'!
selectPrevious

	toolbar selectPrevious! !

!TabManager methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/9/2013 00:46'!
setTabs: aBlock

	self tabs: aBlock value! !

!TabManager methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 23:08'!
initialize

	super initialize.

	toolbar := TabBar new.
	processes := OrderedCollection new.
	self registerBarActions.
	self registerShortcuts.
	
	container := Morph new
		color: Smalltalk ui theme class lightBaseColor;
		changeProportionalLayout;
		yourself.
		
	contentsWrapper := Morph new
		color: Smalltalk ui theme class lightBaseColor;
		changeProportionalLayout;
		yourself.
		
	self changeProportionalLayout.
	self addMorphs! !

!TabManager methodsFor: 'drawing-private' stamp: 'BenjaminVanRyseghem 5/30/2013 19:55'!
borderColor

	^ Color gray! !

!TabManager methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/2/2013 19:20'!
canBeClosed

	^ toolbar canBeClosed! !

!TabManager methodsFor: 'private-actions' stamp: 'BenjaminVanRyseghem 6/9/2013 21:20'!
selectLastTab

	toolbar selectLastTab! !

!TabManager methodsFor: 'private-actions' stamp: 'BenjaminVanRyseghem 6/2/2013 18:40'!
barDeleted: aBar

	self close! !

!TabManager methodsFor: 'private-actions' stamp: 'BenjaminVanRyseghem 6/11/2013 02:01'!
deleteSelectedTabs

	toolbar deleteSelectedTabs! !

!TabManager methodsFor: 'private-contents' stamp: 'BenjaminVanRyseghem 6/9/2013 20:53'!
addTabContents: tab at: index delta: delta
	| process |
	process := tab retrieveMorph: [ :contents || leftOffset |
		contents ifNil: [ TabWithNoContents signalTab: tab ].
		
		index = 1
			ifTrue: [ leftOffset := 0 ]
			ifFalse: [ leftOffset := 2 ].
		
		contentsWrapper
			addMorph: contents
			fullFrame:
				(LayoutFrame identity
					leftFraction: (index - 1) * delta;
					leftOffset: leftOffset;
					rightOffset: -2;
					rightFraction: index * delta) ].
				
	process ifNotNil: [ processes add: process ]! !

!TabManager methodsFor: 'private-actions' stamp: 'BenjaminVanRyseghem 6/9/2013 14:46'!
tabResetSelection: aTab

	self setTabContentFrom: aTab! !

!TabManager methodsFor: 'private-actions' stamp: 'BenjaminVanRyseghem 6/8/2013 16:15'!
tabsChanged
	"Nothing to do"! !

!TabManager methodsFor: 'private-actions' stamp: 'BenjaminVanRyseghem 6/9/2013 14:44'!
tabRefreshed: aTab
	"Here we know that aTab is the selected tab"

	self setTabContentFrom: aTab! !

!TabManager methodsFor: 'private-actions' stamp: 'BenjaminVanRyseghem 6/2/2013 18:24'!
selectNext

	toolbar selectNext! !

!TabManager methodsFor: 'private-actions' stamp: 'BenjaminVanRyseghem 6/10/2013 17:11'!
tabRemovedFromSelection: aTab

	self setMultipleContents! !

!TabManager methodsFor: 'private-actions' stamp: 'BenjaminVanRyseghem 6/9/2013 21:08'!
tabEmptyContents: aTab
	"My bar already filtered the tab, so here I am sure the tab is the selected tab"
	
	contentsWrapper removeAllMorphs
	! !

!TabManager methodsFor: 'private-actions' stamp: 'BenjaminVanRyseghem 6/20/2013 00:14'!
tabSelected: aTab

	self setTabContentFrom: aTab.
	self triggerEvent: #tabSelected with: aTab! !

!TabManager methodsFor: 'initialize' stamp: 'GuillermoPolito 8/5/2013 10:21'!
registerShortcuts

	self 
		bindKeyCombination: $] command shift | $] control shift toAction: [ self selectNext ];
		bindKeyCombination: $[ command shift | $[ control shift toAction: [ self selectPrevious ];
		bindKeyCombination: $w command | $w control toAction: [ self deleteSelectedTabs ];
		bindKeyCombination: $w command shift | $w control shift toAction: [ self closeAllTabs ].
		
	1 to: 9 do: [ :index |
		self bindKeyCombination: index asString first command | index asString first control toAction: [ self selectTabAt: index ] ].
	
	self bindKeyCombination: $0 command | $0 control toAction: [ self selectLastTab ]! !

!TabManager methodsFor: 'private-contents' stamp: 'BenjaminVanRyseghem 6/9/2013 20:53'!
addSplitterOn: tabs delta: delta
	| leftProcess rightProcess |
	tabs overlappingPairsWithIndexDo: [ :left :right :index | 
		leftProcess := left retrieveMorph: [ :leftContents | 
			leftContents ifNil: [ TabWithNoContents signalTab: left ].
			rightProcess := right retrieveMorph: [ :rightContents || splitter |
				rightContents ifNil: [ TabWithNoContents signalTab: right ].
				
				splitter := ProportionalSplitterMorph new
					addLeftOrTop: leftContents;
					addRightOrBottom: rightContents;
					yourself.

				contentsWrapper
					addMorph: splitter
					fullFrame:
						(LayoutFrame identity
							leftFraction: index * delta;
							rightFraction: index * delta;
							leftOffset: -2;
							rightOffset: 2) ] ] ].
				
	leftProcess ifNotNil: [ processes add: leftProcess ].
	rightProcess ifNotNil: [ processes add: rightProcess ].! !

!TabManager methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/1/2013 14:29'!
model

	^ model! !

!TabManager methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/2/2013 17:52'!
addTab: aTab

	toolbar addTab: aTab.
	! !

!TabManager methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/2/2013 18:39'!
delete
	
	super delete.
	self triggerEvent: #tabManagerDeleted with: self! !

!TabManager methodsFor: 'private' stamp: 'BenjaminVanRyseghem 6/9/2013 20:59'!
setTabContentFrom: aTab
	| process |
	
	contentsWrapper removeAllMorphs.
	self cleanProcesses.

	process := aTab retrieveMorph: [ :contents |
		contents ifNil: [ TabWithNoContents signalTab: aTab ].
		contentsWrapper 
			addMorph: contents
			fullFrame: LayoutFrame identity.
		contents takeKeyboardFocus ].
	process ifNotNil: [ processes add: process ].! !

!TabManager methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 6/2/2013 19:23'!
closeAllTabs

	toolbar closeAllTabs! !

!TabManager methodsFor: 'private-actions' stamp: 'BenjaminVanRyseghem 6/10/2013 17:11'!
tabAddedToSelection: aTab

	self setMultipleContents! !

!TabManager methodsFor: 'private' stamp: 'BenjaminVanRyseghem 6/10/2013 17:11'!
setMultipleContents
	| tabs size delta |

	contentsWrapper removeAllMorphs.
	self cleanProcesses.
	
	tabs := toolbar orderedSelectedTabs.
	size := tabs size.
	delta := 1 / size.
	
	tabs allButLast keysAndValuesDo: [ :index :tab | self addTabContents: tab at: index delta: delta ].
	self addLastTabContents: tabs last among: size delta: delta.
	self addSplitterOn: tabs delta: delta! !

!TabManager methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/1/2013 14:29'!
model: aModel

	model := aModel! !

!TabManager methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 5/30/2013 20:01'!
drawLinesOn: aCanvas
	aCanvas
		line: self topLeft + (0 @ 25)
		to: self bottomLeft
		width: 1
		color: self borderColor.
	aCanvas
		line: self bottomLeft
		to: self bottomRight
		width: 1
		color: self borderColor.
	aCanvas
		line: self topRight + (0 @ 26)
		to: self bottomRight
		width: 1
		color: self borderColor! !

!TabManagerModel commentStamp: '<historical>'!
I am a spec model representing a tab manager. My role is to gather multiple tabs, and make them work together!
!TabManagerModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
tabSelectedAction

	^ tabSelectedAction value! !

!TabManagerModel methodsFor: 'dependents' stamp: 'BenjaminVanRyseghem 7/18/2013 14:50'!
addDependent: aMorph

	self myDependents add: aMorph! !

!TabManagerModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
selectedTab

	^ selectedTab value! !

!TabManagerModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
removeTab: aTab

	"BEWARE: this code is an exception. One should never access directly a value holder contents"
	"I do this here for optimisation. No need to trigger the whole collection changed. Only the added element is interesting "
	tabs value remove: aTab ifAbsent: [ ].
	
	self widget ifNotNil: [ :w | w removeTab: aTab ]! !

!TabManagerModel methodsFor: 'private' stamp: 'PeterUhnak 3/16/2015 23:46'!
tabModelFor: tab

	^ tabs detect: [ :e | e = tab model ]! !

!TabManagerModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
tabs

	^ tabs value! !

!TabManagerModel methodsFor: 'api-events' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
whenTabSelected: aBlock

	tabSelectedAction value: aBlock! !

!TabManagerModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 6/9/2013 00:44'!
removeTabNumber: anIndex

	self removeTab: (tabs at: anIndex)! !

!TabManagerModel methodsFor: 'initialization' stamp: 'StephaneDucasse 2/26/2015 16:37'!
initialize
	"Initialization code for TabManagerModel"
	super initialize.
	tabs := OrderedCollection new asValueHolder.
	tabSelectedAction := [] asValueHolder.
	selectedTab := nil asValueHolder.
	self myDependents: WeakSet new.
	
	tabs whenChangedDo: [ :new | self widget ifNotNil: [ :w | w tabs: self getTabs value ] ].
	selectedTab whenChangedDo: [:newTab | tabSelectedAction value cull: newTab cull: self ]! !

!TabManagerModel methodsFor: 'api' stamp: 'PeterUhnak 3/21/2015 17:23'!
addTab: aTab

	"BEWARE: this code is an exception. One should never access directly a value holder contents"
	"I do this here for optimisation. No need to trigger the whole collection changed. Only the added element is interesting "
	tabs value add: aTab.
	self selectedTab ifNil: [ selectedTab value: aTab ].
	self changed: #addTab: with: { aTab }! !

!TabManagerModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
tabs: aCollection

	tabs value: aCollection! !

!TabManagerModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
selectedTab: aTab

	selectedTab value: (self tabModelFor: aTab).! !

!TabManagerModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
selectTabModel: tabModel

	tabSelectedAction value cull: tabModel cull: self! !

!TabManagerModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/1/2013 13:39'!
defaultSpec
	<spec: #default>
	
	^ #(TabManagerAdapter
		adapt: #(model))! !

!TabManagerModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/13/2014 15:25'!
adapterName

	^ #TabManagerAdapter! !

!TabModel commentStamp: '<historical>'!
I am a spec model representing a single tab.

Ishould not be used without being contained into a TabManagerModel!
!TabModel methodsFor: 'api-valueHolder' stamp: 'PeterUhnak 3/16/2015 23:05'!
morphHolder

	^ morphHolder! !

!TabModel methodsFor: 'api' stamp: 'PeterUhnak 3/16/2015 22:33'!
closeable: aBoolean

	closeableHolder value: aBoolean! !

!TabModel methodsFor: 'api-valueHolder' stamp: 'PeterUhnak 3/16/2015 23:06'!
actionsHolder

	^ actionsHolder! !

!TabModel methodsFor: 'api-valueHolder' stamp: 'PeterUhnak 3/16/2015 23:05'!
closeableHolder

	^ closeableHolder! !

!TabModel methodsFor: 'api-valueHolder' stamp: 'PeterUhnak 3/16/2015 23:05'!
labelHolder

	^ labelHolder! !

!TabModel methodsFor: 'api' stamp: 'PeterUhnak 3/16/2015 22:33'!
closeable

	^ closeableHolder value! !

!TabModel methodsFor: 'api' stamp: 'PeterUhnak 3/16/2015 22:33'!
actions

	^ actionsHolder value! !

!TabModel methodsFor: 'api-events' stamp: 'PeterUhnak 3/16/2015 22:34'!
whenTabSelected: aBlock

	tabSelectedActionHolder value: aBlock! !

!TabModel methodsFor: 'api-valueHolder' stamp: 'PeterUhnak 3/16/2015 23:05'!
retrievingBlockHolder

	^ retrievingBlockHolder! !

!TabModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 6/8/2013 16:00'!
defaultIcon

	^ Smalltalk ui icons blankIcon! !

!TabModel methodsFor: 'initialization' stamp: 'PeterUhnak 3/16/2015 23:04'!
initialize
	"Initialization code for TabModel"

	super initialize.

	labelHolder := '' asValueHolder.
	iconHolder := self defaultIcon asValueHolder.
	morphHolder := nil asValueHolder.
	retrievingBlockHolder := nil asValueHolder.
	menuHolder := nil asValueHolder.
	actionsHolder := OrderedCollection new asValueHolder.
	closeableHolder := true asValueHolder.
	tabSelectedActionHolder := [  ] asValueHolder.
	selectedHolder := false asValueHolder! !

!TabModel methodsFor: 'api' stamp: 'PeterUhnak 3/16/2015 22:33'!
menu: aBlock

	menuHolder value: aBlock! !

!TabModel methodsFor: 'api' stamp: 'PeterUhnak 3/16/2015 22:33'!
actions: aCollection

	actionsHolder value: aCollection! !

!TabModel methodsFor: 'api-valueHolder' stamp: 'PeterUhnak 3/16/2015 23:05'!
tabSelectedActionHolder

	^ tabSelectedActionHolder! !

!TabModel methodsFor: 'api' stamp: 'PeterUhnak 3/16/2015 22:33'!
retrievingBlock: aBlock

	retrievingBlockHolder value: aBlock! !

!TabModel methodsFor: 'api-valueHolder' stamp: 'PeterUhnak 3/16/2015 23:05'!
menuHolder

	^ menuHolder! !

!TabModel methodsFor: 'api' stamp: 'PeterUhnak 3/16/2015 22:31'!
label: aString

	labelHolder value: aString! !

!TabModel methodsFor: 'api-valueHolder' stamp: 'PeterUhnak 3/16/2015 23:05'!
selectedHolder

	^ selectedHolder! !

!TabModel methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 6/8/2013 15:52'!
initialExtent

	^ 200@25! !

!TabModel methodsFor: 'api' stamp: 'PeterUhnak 3/16/2015 22:34'!
tabSelectedAction

	^ tabSelectedActionHolder value! !

!TabModel methodsFor: 'api' stamp: 'PeterUhnak 3/16/2015 23:05'!
selected: aBoolean

	selectedHolder value: aBoolean! !

!TabModel methodsFor: 'api' stamp: 'PeterUhnak 3/16/2015 22:33'!
menu

	^ menuHolder value! !

!TabModel methodsFor: 'api-valueHolder' stamp: 'PeterUhnak 3/16/2015 23:05'!
iconHolder

	^ iconHolder! !

!TabModel methodsFor: 'api' stamp: 'PeterUhnak 3/16/2015 22:34'!
tabSelected 

	tabSelectedActionHolder value cull: self! !

!TabModel methodsFor: 'api' stamp: 'PeterUhnak 3/16/2015 22:32'!
icon: aForm

	iconHolder value: aForm! !

!TabModel methodsFor: 'api' stamp: 'PeterUhnak 3/16/2015 22:31'!
label

	^ labelHolder value! !

!TabModel methodsFor: 'api' stamp: 'PeterUhnak 3/16/2015 22:33'!
retrievingBlock

	^ retrievingBlockHolder value! !

!TabModel methodsFor: 'api' stamp: 'PeterUhnak 3/16/2015 22:32'!
contents: aMorph

	morphHolder value: aMorph! !

!TabModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/1/2013 14:19'!
model: aComposableModel

	self retrievingBlock: [ aComposableModel buildWithSpec asWidget ]! !

!TabModel methodsFor: 'api' stamp: 'PeterUhnak 3/16/2015 22:32'!
contents

	^ morphHolder value! !

!TabModel methodsFor: 'api' stamp: 'PeterUhnak 3/16/2015 22:32'!
icon

	^ iconHolder value! !

!TabModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/1/2013 13:39'!
defaultSpec
	<spec: #default>
	
	^ #(TabAdapter
		adapt: #(model))! !

!TabModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/13/2014 15:26'!
adapterName

	^ #TabAdapter! !

!TabModelTest methodsFor: 'tests' stamp: 'PeterUhnak 3/21/2015 17:26'!
testInitialSelectedTab
	"issue 15145"

	| manager tabModel |
	manager := TabManagerModel new.
	tabModel := self redMorphTab.
	self assert: manager selectedTab equals: nil.
	manager addTab: tabModel.
	self assert: manager selectedTab equals: tabModel.
	manager addTab: self redMorphTab.
	self assert: manager selectedTab equals: tabModel! !

!TabModelTest methodsFor: 'utility' stamp: 'PeterUhnak 3/17/2015 00:05'!
redMorphTab
	^ TabModel new
		label: 'Red Morph';
		icon: Smalltalk ui icons smallBackIcon;
		contents:
				(Morph new
						color: Color red;
						yourself);
		yourself! !

!TabModelTest methodsFor: 'tests' stamp: 'PeterUhnak 3/21/2015 17:10'!
testChangeLabel
	"issue 14885"

	| manager tabModel window |
	manager := TabManagerModel new.
	tabModel := self redMorphTab.
	manager addTab: tabModel.

	self assert: tabModel label = 'Red Morph'.
	tabModel label: 'Change Before Opening'.
	self assert: tabModel label = 'Change Before Opening'.

	window := manager openWithSpec.
	tabModel label: 'Change After Opening'.
	self assert: tabModel label = 'Change After Opening'.
	window delete! !

!TabPanelBorder commentStamp: 'gvc 9/23/2008 11:48'!
Specialist border for a TabGroup panel. Does not draw border beneath selected tab.!
!TabPanelBorder methodsFor: 'accessing' stamp: 'gvc 1/7/2008 14:02'!
tabSelector: anObject
	"Set the value of tabSelector"

	tabSelector := anObject! !

!TabPanelBorder methodsFor: 'drawing' stamp: 'GaryChambers 6/8/2011 12:02'!
frameRectangle: aRectangle on: aCanvas
	"Draw the border taking the currently selected tab into account.
	Only works for top-positioned tabs for the moment."
	
	|w h r tab|
	w := self width.
	w isPoint ifTrue: [h := w y. w := w x] ifFalse:[h := w].
	r := aRectangle topLeft extent: w@aRectangle height.
	aCanvas fillRectangle: r color: self color. "left"
	r := aRectangle topRight - (w@0) extent: w@aRectangle height.
	aCanvas fillRectangle: r color: self color. "right"
	r := aRectangle bottomLeft + (w@h negated) extent: aRectangle width - w - w@h.
	aCanvas fillRectangle: r color: self color. "bottom"
	tab := self selectedTab.
	(tab isNil or: [tab owner isNil]) ifTrue: [	
		r := aRectangle topLeft + (w@0) corner: aRectangle topRight - (w@h negated).
		aCanvas fillRectangle: r color: self color.
		^self]. "top"
	r := aRectangle topLeft + (w@0) corner: tab bounds left + w@(aRectangle top + h).
	aCanvas fillRectangle: r color: self color. "top 1"
	r := tab bounds left + w@ aRectangle top corner: tab bounds right - w@(aRectangle top + h).
	aCanvas fillRectangle: r color: tab paneColor. "top 2"
	r :=  tab bounds right - w@ aRectangle top corner: aRectangle topRight - (w@h negated).
	aCanvas fillRectangle: r color: self color. "top 3"! !

!TabPanelBorder methodsFor: 'accessing' stamp: 'gvc 1/7/2008 14:27'!
selectedTab
	"Answer the currently selected tab."
	
	^(self tabSelector ifNil: [^nil]) selectedTab! !

!TabPanelBorder methodsFor: 'accessing' stamp: 'gvc 1/7/2008 14:02'!
tabSelector
	"Answer the value of tabSelector"

	^ tabSelector! !

!TabPanelBorder methodsFor: 'accessing' stamp: 'gvc 1/7/2008 14:16'!
style
	"Answer #tabbed."
	
	^#tabbed! !

!TabSelected commentStamp: '<historical>'!
I am the state of a selected tab!
!TabSelected methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/30/2013 13:26'!
isSelectedMatchingTheState: aBoolean

	^ aBoolean! !

!TabSelected methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/30/2013 14:17'!
selected

	^ true! !

!TabSelected methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/30/2013 13:33'!
newStateForSelected: aBoolean

	^ TabEnabled tab: self tab! !

!TabSelected methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/30/2013 13:29'!
backgroundColor
	
	^ Smalltalk ui theme class lightBaseColor! !

!TabSelectorMorph commentStamp: 'gvc 5/18/2007 11:54'!
Row of tabs for a TabGroupMorph.!
!TabSelectorMorph methodsFor: 'operations' stamp: 'GaryChambers 11/23/2011 17:14'!
newLabelMorph: aStringOrMorph selected: selectedStringOrMorph
	"Answer a new label morph with the given label text or morph and
	alternate when selected."

	^TabLabelMorph new
		roundedCorners: #(1 4);
		cornerStyle: self cornerStyle;
		changeTableLayout;
		listDirection: #leftToRight;
		listCentering: #center;
		layoutInset: (self theme tabLabelInsetFor: self);
		hResizing: #shrinkWrap;
		vResizing: #spaceFill;
		label: aStringOrMorph selected: selectedStringOrMorph;
		font: self font;
		on: #mouseDown send: #tabClicked:with: to: self;
		tabSelector: self! !

!TabSelectorMorph methodsFor: 'operations' stamp: 'GaryChambers 6/7/2011 17:08'!
updateFont
	"Update the label font."

	self tabs do: [:t | t font: self font].
	self updateTabs! !

!TabSelectorMorph methodsFor: 'geometry' stamp: 'gvc 6/2/2009 11:10'!
minExtent
	"Add a bit for the round corner of the group."

	^self theme tabSelectorMorphMinExtentFor: self! !

!TabSelectorMorph methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 1/9/2012 18:23'!
keyStroke: event 
	"Process keys navigation and space to toggle."

	(self navigationKey: event) ifTrue: [^self].
	event keyCharacter = Character arrowLeft
		ifTrue: [self selectPreviousTab].
	event keyCharacter = Character arrowRight
		ifTrue: [self selectNextTab]! !

!TabSelectorMorph methodsFor: 'operations' stamp: 'GaryChambers 6/7/2011 15:32'!
removeTabIndex: anInteger
	"Remove the tab at the given index and
	adjust any selected (next or first if was last)."
	
	self tabs removeAt: anInteger.
	self selectedIndex: 0.
	self tabs ifNotEmpty: [
		self selectedIndex: self selectedIndex - 1 \\ self tabs size + 1]
		! !

!TabSelectorMorph methodsFor: 'operations' stamp: 'GaryChambers 6/7/2011 13:44'!
newControls
	"Answer the scrolling controls."
	
	^{self newLeftButton. self newRightButton}! !

!TabSelectorMorph methodsFor: 'accessing' stamp: 'gvc 7/30/2009 13:47'!
font: aFont
	"Set the label font"

	font == aFont ifTrue: [^self].
	font := aFont.
	self updateFont! !

!TabSelectorMorph methodsFor: 'initialization' stamp: 'GaryChambers 6/8/2011 14:49'!
initialize
	"Initialize the receiver."

	super initialize.
	selectedIndex := 0.
	self
		tabs: OrderedCollection new;
		wrapScrolling: false;
		visibleTabRange: (1 to: 0);
		controls: self newControls;
		roundedCorners: #(1 4);
		borderWidth: 0;
		changeTableLayout;
		listDirection: #leftToRight;
		cellInset: (self theme tabSelectorCellInsetFor: self)! !

!TabSelectorMorph methodsFor: 'operations' stamp: 'GaryChambers 11/23/2011 15:19'!
newLabelMorph: aStringOrMorph
	"Answer a new label morph with the given label text."

	^TabLabelMorph new
		roundedCorners: #(1 4);
		cornerStyle: self cornerStyle;
		changeTableLayout;
		listDirection: #leftToRight;
		listCentering: #center;
		layoutInset: (self theme tabLabelInsetFor: self);
		hResizing: #shrinkWrap;
		vResizing: #spaceFill;
		label: aStringOrMorph;
		font: self font;
		on: #mouseDown send: #tabClicked:with: to: self;
		tabSelector: self! !

!TabSelectorMorph methodsFor: 'accessing' stamp: 'GaryChambers 6/8/2011 11:02'!
visibleTabRange

	^ visibleTabRange! !

!TabSelectorMorph methodsFor: 'tabs' stamp: 'GaryChambers 6/8/2011 11:14'!
tabsAndControls
	"Answer the tabs and scrolling controls that should be visible given the space."

	|visibleTabs firstIndex|
	self tabs ifEmpty: [
		self visibleTabRange: (1 to: 0).
		^#()].
	visibleTabs := self calculateVisibleTabs.
	visibleTabs ifEmpty: [
		self visibleTabRange: (1 to: 0).
		^#()].
	firstIndex := self tabs indexOf: visibleTabs first.
	self visibleTabRange: (firstIndex to: firstIndex + visibleTabs size - 1).
	visibleTabs size = self tabs size ifFalse: [
		visibleTabs
			add: self newSpacer;
			addAll: self controls.
		self cornerStyle = #rounded
			ifTrue: [visibleTabs add: self newEndSpacer]].
	^visibleTabs! !

!TabSelectorMorph methodsFor: 'accessing' stamp: 'GaryChambers 6/10/2011 15:14'!
selectedIndex: index
	"Set the value of selectedIndex"

	|oldIndex|
	selectedIndex == index ifTrue: [^self].
	oldIndex := selectedIndex.
	selectedIndex := (index min: self tabs size).
	self visibleTabRange first > index
		ifTrue: [self visibleTabRange: ((index max: 1) to: 0)]
		ifFalse: [self visibleTabRange last < index
				ifTrue: [self visibleTabRange: (0 to: index)]].
	self updateTabs.
	self changed: #selectedIndex with: oldIndex! !

!TabSelectorMorph methodsFor: 'tabs' stamp: 'GaryChambers 6/10/2011 13:51'!
relabelTab: aTab with: aStringOrMorph
	"Relabel the tab update tab layout."

	aTab label: aStringOrMorph.
	aTab owner ifNotNil: [
		self updateTabs.
		(aTab isSelected and: [aTab isVisible not])
			ifTrue: [self ensureSelectedTabIsVisible]]! !

!TabSelectorMorph methodsFor: 'operations' stamp: 'GaryChambers 6/8/2011 11:15'!
scrollTabsRight
	"Scroll right through the tabs."
	
	self visibleTabRange: (self visibleTabRange last \\ self tabs size + 1 to: 0).
	self updateTabs! !

!TabSelectorMorph methodsFor: 'tabs' stamp: 'GaryChambers 6/10/2011 11:17'!
nonVisibleTabs
	"Answer the tabs that are not currently visible."

	^self tabs select: [:t | t owner isNil]! !

!TabSelectorMorph methodsFor: 'operations' stamp: 'GaryChambers 6/10/2011 11:16'!
activate
	"Update the non visible tabs too."

	super activate.
	self nonVisibleTabs do: [:t | t activate]! !

!TabSelectorMorph methodsFor: 'accessing' stamp: 'GaryChambers 6/8/2011 13:18'!
wrapScrolling: aBoolean
	"Set whether tab scrolling wraps around at each end."

	wrapScrolling := aBoolean.
	self
		changed: #leftButtonEnabled;
		changed: #rightButtonEnabled! !

!TabSelectorMorph methodsFor: 'accessing' stamp: 'gvc 9/15/2006 11:37'!
selectedIndex
	"Answer the value of selectedIndex"

	^ selectedIndex! !

!TabSelectorMorph methodsFor: 'operations' stamp: 'GaryChambers 6/8/2011 12:00'!
ensureSelectedTabIsVisible
	"Update the tabs if the seleted tab is not in the visible range."

	(self selectedIndex > 0 and: [(self visibleTabRange includes: self selectedIndex) not])
		ifTrue: [self visibleTabRange: (self selectedIndex to: 0).
				self updateTabs]! !

!TabSelectorMorph methodsFor: 'event handling' stamp: 'gvc 5/22/2007 16:09'!
handlesKeyboard: evt
	"Yes, we do it here."
	
	^true! !

!TabSelectorMorph methodsFor: 'operations' stamp: 'GaryChambers 6/8/2011 13:13'!
newRightButton
	"Answer a new button for scrolling right."

	^(ControlButtonMorph
			on: self
			getState: nil
			action: #scrollTabsRight
			label: #rightButtonLabel)
		getEnabledSelector: #rightButtonEnabled;
		hResizing: #rigid;
		vResizing: #spaceFill;
		cornerStyle: #square;
		extent: self controlButtonWidth asPoint! !

!TabSelectorMorph methodsFor: '*Keymapping-Core' stamp: 'GuillermoPolito 3/15/2013 16:31'!
initializeShortcuts: aKMDispatcher
	super initializeShortcuts: aKMDispatcher.
	aKMDispatcher attachCategory: #MorphFocusNavigation.
	aKMDispatcher attachCategory: #TabMorphsNavigation.! !

!TabSelectorMorph methodsFor: 'operations' stamp: 'GaryChambers 6/8/2011 12:34'!
newSpacer
	"Answer a spacer to place the controls to the right."

	^Morph new
		borderWidth: 0;
		color: Color transparent;
		extent: 0@0;
		minWidth: 0;
		hResizing: #spaceFill! !

!TabSelectorMorph methodsFor: 'operations' stamp: 'gvc 5/22/2007 16:00'!
takesKeyboardFocus
	"Answer whether the receiver can normally take keyboard focus."

	^true! !

!TabSelectorMorph methodsFor: 'accessing' stamp: 'MarcusDenker 12/11/2009 09:35'!
focusBounds
	"Answer the bounds for drawing the focus indication."

	^self selectedTab
		ifNil: [super focusBounds]
		ifNotNil: [:tab | tab focusBounds]! !

!TabSelectorMorph methodsFor: 'accessing' stamp: 'GaryChambers 6/7/2011 13:00'!
tabs

	^ tabs! !

!TabSelectorMorph methodsFor: 'tabs' stamp: 'GaryChambers 11/23/2011 17:17'!
updateTabs
	"Update the submorphs based on visible tabs."

	|tabsAndControls selectedTab|
	tabsAndControls := self tabsAndControls.
	self removeAllMorphs.
	tabsAndControls ifEmpty: [^self].
	selectedTab := self selectedTab.
	self tabs do: [:t |
		t selected: (t == selectedTab)].
	self
		addAllMorphs: self tabsAndControls;
		adoptPaneColor! !

!TabSelectorMorph methodsFor: 'adding' stamp: 'GaryChambers 6/7/2011 17:48'!
addTab: aStringOrMorph
	"Add a new tab with the given text."
	
	self tabs add: (self newLabelMorph: aStringOrMorph).
	self updateTabs! !

!TabSelectorMorph methodsFor: 'event handling' stamp: 'GuillermoPolito 5/23/2012 11:40'!
keyboardFocusChange: aBoolean
	"The message is sent to a morph when its keyboard focus changes.
	Update for focus feedback."
	super keyboardFocusChange: aBoolean.
	self focusChanged! !

!TabSelectorMorph methodsFor: 'operations' stamp: 'GaryChambers 6/7/2011 13:46'!
leftButtonLabel
	"Answer the label for a button for scrolling left."

	^AlphaImageMorph new image: (
		ScrollBar
			arrowOfDirection: #left
			size: self controlButtonWidth - 3
			color: self paneColor darker)! !

!TabSelectorMorph methodsFor: 'accessing' stamp: 'gvc 9/16/2006 08:54'!
font
	"Answer the label font"

	^font! !

!TabSelectorMorph methodsFor: 'operations' stamp: 'gvc 5/22/2007 16:14'!
selectNextTab
	"Select the next tab, or the first if none selected."
	
	self selectedIndex: self selectedIndex \\ self tabs size + 1! !

!TabSelectorMorph methodsFor: 'operations' stamp: 'GaryChambers 6/10/2011 11:17'!
passivate
	"Update the non visible tabs too."

	super passivate.
	self nonVisibleTabs do: [:t | t passivate]! !

!TabSelectorMorph methodsFor: 'operations' stamp: 'GaryChambers 6/7/2011 13:45'!
controlButtonWidth
	"Answer the width for a scroll button."

	^self theme scrollbarThickness + 3! !

!TabSelectorMorph methodsFor: 'drawing' stamp: 'IgorStasenko 12/22/2012 02:53'!
drawSubmorphsOn: aCanvas 
	"Display submorphs back to front.
	Draw the focus here since we are using inset bounds
	for the focus rectangle."

	|tab|
	super drawSubmorphsOn: aCanvas.
	(self hasKeyboardFocus and: [(tab := self selectedTab) notNil
			and: [tab owner notNil]])
		ifTrue: [self clipSubmorphs 
				ifTrue: [aCanvas
							clipBy: (aCanvas clipRect intersect: self clippingBounds ifNone:["done here" ^ self ])
							during: [:c | tab drawKeyboardFocusOn: c]]
				ifFalse: [tab drawKeyboardFocusOn: aCanvas]]! !

!TabSelectorMorph methodsFor: 'operations' stamp: 'GaryChambers 6/8/2011 11:41'!
scrollTabsLeft
	"Scroll left through the tabs."
	
	self visibleTabRange: (self visibleTabRange first < 2
		ifTrue: [0 to: self tabs size]
		ifFalse: [0 to: self visibleTabRange first - 1]).
	self updateTabs! !

!TabSelectorMorph methodsFor: 'operations' stamp: 'GaryChambers 6/8/2011 13:19'!
rightButtonEnabled
	"Answer whether the button for scrolling right should be enabled."

	^self wrapScrolling or: [self visibleTabRange last < self tabs size]! !

!TabSelectorMorph methodsFor: 'tabs' stamp: 'GaryChambers 8/10/2010 14:16'!
selectedTab
	"Answer the selected tab."
	
	^self selectedIndex = 0
		ifFalse: [self tabs at: self selectedIndex ifAbsent: [nil]]! !

!TabSelectorMorph methodsFor: 'accessing' stamp: 'GaryChambers 6/7/2011 13:42'!
controls

	^ controls! !

!TabSelectorMorph methodsFor: 'adding' stamp: 'GaryChambers 11/23/2011 17:13'!
addTab: aStringOrMorph selected: selectedStringOrMorph
	"Add a new tab with the given text or morph and alternate for when selected."
	
	self tabs add: (self newLabelMorph: aStringOrMorph selected: selectedStringOrMorph).
	self updateTabs! !

!TabSelectorMorph methodsFor: 'operations' stamp: 'GaryChambers 6/7/2011 14:27'!
newEndSpacer
	"Answer a spacer to pad when rounded."

	^Morph new
		borderWidth: 0;
		color: Color transparent;
		extent: 6@0! !

!TabSelectorMorph methodsFor: 'tabs' stamp: 'gvc 5/22/2007 16:18'!
selectPreviousTab
	"Select the previous tab, or the last if none selected."
	
	self selectedIndex: (self selectedIndex < 2
		ifTrue: [self tabs size]
		ifFalse: [self selectedIndex - 1])! !

!TabSelectorMorph methodsFor: 'accessing' stamp: 'GaryChambers 6/7/2011 12:58'!
tabs: anObject

	tabs := anObject! !

!TabSelectorMorph methodsFor: 'geometry' stamp: 'GaryChambers 6/7/2011 17:18'!
basicMinExtent
	"Answer the unadjusted min extent."

	|minTabExtent controlExtent controlsExtent|
	controlsExtent := 0@0.
	self controls do: [:control |
		controlExtent := control minExtent.
		controlsExtent := controlsExtent x + controlExtent x @ (controlsExtent y max: controlExtent y)].
	self tabs ifEmpty: [^controlsExtent].
	minTabExtent := 0@0.
	self tabs do: [:tab | minTabExtent := minTabExtent max: tab minExtent].
	^minTabExtent x + controlsExtent x @ (minTabExtent y max: controlsExtent y)! !

!TabSelectorMorph methodsFor: 'operations' stamp: 'gvc 9/15/2006 13:46'!
tabClicked: evt with: aMorph 
	"A tab has been clicked."
	
	self selectedIndex: (self tabs indexOf: aMorph)! !

!TabSelectorMorph methodsFor: 'operations' stamp: 'GaryChambers 6/8/2011 13:13'!
newLeftButton
	"Answer a new button for scrolling left."

	^(ControlButtonMorph
			on: self
			getState: nil
			action: #scrollTabsLeft
			label: #leftButtonLabel)
		getEnabledSelector: #leftButtonEnabled;
		hResizing: #rigid;
		vResizing: #spaceFill;
		cornerStyle: #square;
		extent: self controlButtonWidth asPoint! !

!TabSelectorMorph methodsFor: 'geometry' stamp: 'GaryChambers 6/8/2011 11:59'!
extent: aPoint
	"Set the extent of the receiver.
	Update the tabs."

	self extent = aPoint ifTrue: [^self].
	super extent: aPoint.
	self
		updateTabs;
		ensureSelectedTabIsVisible! !

!TabSelectorMorph methodsFor: 'tabs' stamp: 'GaryChambers 6/8/2011 11:55'!
calculateVisibleTabs
	"Answer the tabs that should be visible given the space."

	|widths answer availableWidth accumulatedWidth tabStr widthStr width|
	widths := self tabs collect: [:t | t minExtent x].
	availableWidth := self layoutBounds width.
	self cornerStyle = #rounded
		ifTrue: [availableWidth := availableWidth - 6].
	widths sum <= availableWidth ifTrue: [^self tabs].
	availableWidth := availableWidth - self controlsExtent x.
	answer := OrderedCollection new.
	accumulatedWidth := 0.
	self visibleTabRange last = 0
		ifTrue: [tabStr := (self tabs copyFrom: self visibleTabRange first to: self tabs size) readStream.
				widthStr := (widths copyFrom: self visibleTabRange first to: widths size) readStream.
				[accumulatedWidth <= availableWidth and: [tabStr atEnd not]] whileTrue: [
					answer add: tabStr next.
					accumulatedWidth := accumulatedWidth + widthStr next].
				accumulatedWidth > availableWidth ifTrue: [
					answer removeLast].
				^answer]
		ifFalse: [tabStr := (self tabs copyFrom: 1 to: self visibleTabRange last) reversed readStream.
				widthStr := (widths copyFrom: 1 to: self visibleTabRange last) reversed readStream.
				[accumulatedWidth <= availableWidth and: [tabStr atEnd not]] whileTrue: [
					answer addFirst: tabStr next.
					accumulatedWidth := accumulatedWidth + (width := widthStr next)].
				accumulatedWidth > availableWidth ifTrue: [
					answer removeFirst.
					accumulatedWidth := accumulatedWidth - width].
				tabStr := (self tabs copyFrom: self visibleTabRange last + 1 to: self tabs size) readStream.
				widthStr := (widths copyFrom: self visibleTabRange last + 1 to: widths size) readStream.
				[accumulatedWidth <= availableWidth and: [tabStr atEnd not]] whileTrue: [
					answer add: tabStr next.
					accumulatedWidth := accumulatedWidth + widthStr next].
				accumulatedWidth > availableWidth
					ifTrue: [answer removeLast].
				^answer]
	
		
	! !

!TabSelectorMorph methodsFor: 'tabs' stamp: 'GaryChambers 6/10/2011 11:19'!
visibleTabs
	"Answer the tabs that are currently visible."

	^self tabs select: [:t | t owner notNil]! !

!TabSelectorMorph methodsFor: 'rounding' stamp: 'gvc 1/17/2008 11:35'!
cornerStyle: aSymbol
	"Pass to tabs also."

	super cornerStyle: aSymbol.
	self tabs do: [:t | t cornerStyle: aSymbol]! !

!TabSelectorMorph methodsFor: 'accessing' stamp: 'GaryChambers 6/8/2011 13:16'!
visibleTabRange: anInterval
	"Record the range of tabs that are visible.
	Also used when scrolling to determine starting index."
	
	visibleTabRange := anInterval.
	self
		changed: #leftButtonEnabled;
		changed: #rightButtonEnabled! !

!TabSelectorMorph methodsFor: 'accessing' stamp: 'GaryChambers 6/7/2011 13:42'!
controls: anObject

	controls := anObject! !

!TabSelectorMorph methodsFor: 'accessing' stamp: 'GaryChambers 6/8/2011 13:17'!
wrapScrolling

	^ wrapScrolling! !

!TabSelectorMorph methodsFor: 'operations' stamp: 'GaryChambers 6/7/2011 13:53'!
controlsExtent
	"Answer the min extent of the controls."

	^self controls first minExtent + (self controls last minExtent x @ 0)! !

!TabSelectorMorph methodsFor: 'operations' stamp: 'GaryChambers 6/8/2011 13:19'!
leftButtonEnabled
	"Answer whether the button for scrolling left should be enabled."

	^self wrapScrolling or: [self visibleTabRange first > 1]! !

!TabSelectorMorph methodsFor: 'operations' stamp: 'GaryChambers 6/7/2011 13:47'!
rightButtonLabel
	"Answer the label for a button for scrolling right."

	^AlphaImageMorph new image: (
		ScrollBar
			arrowOfDirection: #right
			size: self controlButtonWidth - 3
			color: self paneColor darker)! !

!TabState commentStamp: '<historical>'!
I represent the current state of a tab.

This class is abstract so have a look at my subclasses to have a better overview.

I have tree responsibilities:
	- influence the rendering (color, border)
	- point out if the state changement asked on my tab is relevant (trying to enable an enabled tab by example)
	- provide the next state for each change (disable, enable, selected)!
!TabState methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/30/2013 13:28'!
backgroundColor
	
	^ self subclassResponsibility! !

!TabState methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/30/2013 14:16'!
selected

	^ false! !

!TabState methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/30/2013 14:16'!
enabled

	^ false! !

!TabState methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/30/2013 13:55'!
buildBorderVertices
	| borderVertices |
	
	borderVertices := OrderedCollection new.
	borderVertices
		add: tab bottomLeft;
		add: tab topLeft + (7 @ 0);
		add: tab topRight + (-8 @ 0);
		add: tab bottomRight + (-1@0).

	^ borderVertices! !

!TabState methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/30/2013 13:22'!
isSelectedMatchingTheState: aBoolean

	^ self subclassResponsibility! !

!TabState methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/30/2013 13:32'!
tab: anObject
	
	tab := anObject! !

!TabState methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/30/2013 13:23'!
isEnabledMatchingTheState: aBoolean

	^ self subclassResponsibility! !

!TabState methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/30/2013 13:54'!
buildVerticesFrom: borderVertices

	^ borderVertices! !

!TabState methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/30/2013 13:22'!
newStateForSelected: aBoolean

	^ self subclassResponsibility! !

!TabState methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/30/2013 13:23'!
newStateForEnabled: aBoolean

	^ self subclassResponsibility! !

!TabState methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/30/2013 13:32'!
tab
	^ tab! !

!TabState class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 5/30/2013 13:32'!
tab: tab

	^ self new
		tab: tab;
		yourself! !

!TabWithNoContents commentStamp: '<historical>'!
Error raised when a tab is asked its contents but have no morph and no retrieving block, or the retrieving block is returning nil.!
!TabWithNoContents methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/9/2013 00:50'!
tab: aTab 

	tab := aTab! !

!TabWithNoContents class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 6/9/2013 00:50'!
signalTab: aTab 
	
	^ self new
		tab: aTab;
		signal! !

!TableLayout commentStamp: '<historical>'!
The layout process:
For computing the new layout for the children of any morph, we start with an initial rectangle which is provided as a reference.

Step 1: The first step of layout computation is to compute the minimum extent each of our children can have. The minimum extent is mapped through both the local layout frame of the morph (for relative positioning) and the global layout frame (for insets, such as cursor indication) to obtain the minimal size required for each cell.

Step 2: Based on the cell sizes, the number of cells we can put into each row and column is computed. For equal spacing, the maximum size of the cells is taken into account here.

Step 3: Based on the row/column sizes, we compute the extra space which should be added to each row/column. For 
	#leftFlush/#topFlush - we add all extra space add the end
	#rightFlush/#bottomFlush - we add all extra space at the start
	#centering - we add 1/2 of the extra space at start and end
	#justified - we distribute the space evenly between the morphs
[NOTE: If any #spaceFill morphs are encountered during this step, #justified is implied and the space is exclusively and equally distributed between those #spaceFill morphs. This is for backward compatibility and should *never* be necessary in the new regime].

Step 4: The morphs are placed in the computed cells and the extra space is distributed as necessary. Placing the submorphs is done by mapping through the global and the local layout frame as requested.

Start point:
=> bounds: new rectangle for the morph.

Compute basic arrangement of morphs:
=> For each submorph compute minExtent
	- if global layout frame inset in global layout frame
	- if local layout frame inset in local layout frame
=> Compute number of morphs per, width and height of row/column
	- if equal spacing based on max size
=> Compute extra space per row/column
	- if centering = #justified; distribute space equally
	- if centering #leftFlush/#topFlush (-1) add start extra
	- if centering #rightFlush/#bottomFlush (1) add end extra
	- if centering #centered add 1/2 extra to start/end
	<extra space must be float and rounded accordingly!!>
=> Place morphs in appropriate cells
	- if global layout frame inset in global layout frame
	- if local layout frame inset in local layout frame
	<will likely cause #layoutChanged by submorphs>

Distribute morphs in row/column:

=> Compute the max length of each row/column
!
!TableLayout methodsFor: 'nil' stamp: 'PeterHugossonMiller 9/3/2009 11:36'!
computeCellArrangement: cellHolder in: newBounds horizontal: aBool target: aMorph
	"Compute number of cells we can put in each row/column. The returned array contains a list of all the cells we can put into the row/column at each level.
	Note: The arrangement is so that the 'x' value of each cell advances along the list direction and the 'y' value along the wrap direction. The returned arrangement has an extra cell at the start describing the width and height of the row."
	| cells wrap spacing output maxExtent n sum index max cell first last w cellMax maxCell hFill vFill inset |
	maxCell := cellHolder key.
	cells := cellHolder value.
	properties wrapDirection == #none 
		ifTrue:[wrap := SmallInteger maxVal]
		ifFalse:[wrap := aBool ifTrue:[newBounds width] ifFalse:[newBounds height].
				wrap < maxCell x ifTrue:[wrap := maxCell x]].
	spacing := properties cellSpacing.
	(spacing == #globalRect or:[spacing = #globalSquare]) ifTrue:[
		"Globally equal spacing is a very special case here, so get out fast and easy"
		^self computeGlobalCellArrangement: cells 
			in: newBounds horizontal: aBool 
			wrap: wrap spacing: spacing].

	output := Array new writeStream.
	inset := properties cellInset asPoint.
	aBool ifFalse:[inset := inset transposed].
	first := last := nil.
	maxExtent := 0@0.
	sum := 0.
	index := 1.
	n := 0.
	hFill := vFill := false.
	[index <= cells size] whileTrue:[
		w := sum.
		cell := cells at: index.
		cellMax := maxExtent max: cell cellSize. "e.g., minSize"
		(spacing == #localRect or:[spacing == #localSquare]) ifTrue:[
			"Recompute entire size of current row"
			spacing == #localSquare 
				ifTrue:[max := cellMax x max: cellMax y]
				ifFalse:[max := cellMax x].
			sum := (n + 1) * max.
		] ifFalse:[
			sum := sum + (cell cellSize x).
		].
		((sum + (n * inset x)) > wrap and:[first notNil]) ifTrue:[
			"It doesn't fit and we're not starting a new line"
			(spacing == #localSquare or:[spacing == #localRect]) ifTrue:[
				spacing == #localSquare 
					ifTrue:[maxExtent := (maxExtent x max: maxExtent y) asPoint].
				first do:[:c| c cellSize: maxExtent]].
			w := w + ((n - 1) * inset x).
			"redistribute extra space"
			first nextCell ifNotNil:[first nextCell do:[:c| c addExtraSpace: inset x@0]].
			last := LayoutCell new.
			last cellSize: w @ (maxExtent y).
			last hSpaceFill: hFill.
			last vSpaceFill: vFill.
			last nextCell: first.
			output position = 0 ifFalse:[last addExtraSpace: 0@inset y].
			output nextPut: last.
			first := nil.
			maxExtent := 0@0.
			sum := 0.
			n := 0.
			hFill := vFill := false.
		] ifFalse:[
			"It did fit; use next item from input"
			first ifNil:[first := last := cell] ifNotNil:[last nextCell: cell. last := cell].
			index := index+1.
			n := n + 1.
			maxExtent := cellMax.
			hFill := hFill or:[cell hSpaceFill].
			vFill := vFill or:[cell vSpaceFill].
		].
	].
	first ifNotNil:[
		last := LayoutCell new.
		sum := sum + ((n - 1) * inset x).
		first nextCell ifNotNil:[first nextCell do:[:c| c addExtraSpace: inset x@0]].
		last cellSize: sum @ maxExtent y.
		last hSpaceFill: hFill.
		last vSpaceFill: vFill.
		last nextCell: first.
		output position = 0 ifFalse:[last addExtraSpace: 0@inset y].
		output nextPut: last].
	output := output contents.
	properties listSpacing == #equal ifTrue:[
		"Make all the heights equal"
		max := output inject: 0 into:[:size :c| size max: c cellSize y].
		output do:[:c| c cellSize: c cellSize x @ max].
	].
	^output! !

!TableLayout methodsFor: 'layout' stamp: 'gm 2/28/2003 01:43'!
minExtentOf: aMorph in: box 
	"Return the minimal size aMorph's children would require given the new bounds"

	| cells arrangement horizontal newBounds minX minY dir |
	minExtentCache isNil ifFalse: [^minExtentCache].
	aMorph hasSubmorphs ifFalse: [^0 @ 0].
	properties := aMorph assureTableProperties.
	(properties wrapDirection == #none and: [properties cellSpacing == #none]) 
		ifTrue: 
			["Get into the fast lane"

			dir := properties listDirection.
			(dir == #leftToRight or: [dir == #rightToLeft]) 
				ifTrue: [^self minExtentHorizontal: aMorph].
			(dir == #topToBottom or: [dir == #bottomToTop]) 
				ifTrue: [^self minExtentVertical: aMorph]].
	newBounds := box origin asIntegerPoint corner: box corner asIntegerPoint.
	horizontal := (properties listDirection == #topToBottom 
				or: [properties listDirection == #bottomToTop]) not.
	"Step 1: Compute the minimum extent for all the children of aMorph"
	cells := self 
				computeCellSizes: aMorph
				in: (0 @ 0 corner: newBounds extent)
				horizontal: horizontal.
	"Step 2: Compute the arrangement of the cells for each row and column"
	arrangement := self 
				computeCellArrangement: cells
				in: newBounds
				horizontal: horizontal
				target: aMorph.
	"Step 3: Extract the minimum size out of the arrangement"
	minX := minY := 0.
	arrangement do: 
			[:cell | 
			minX := minX max: cell cellSize x + cell extraSpace x.
			minY := minY + cell cellSize y + cell extraSpace y].
	minExtentCache := horizontal ifTrue: [minX @ minY] ifFalse: [minY @ minX].
	^minExtentCache! !

!TableLayout methodsFor: 'layout' stamp: 'aoy 2/15/2003 20:49'!
computeExtraSpacing: arrangement in: newBounds horizontal: aBool target: aMorph 
	"Compute the required extra spacing for laying out the cells"

	"match newBounds extent with arrangement's orientation"

	| extent extra centering n extraPerCell cell last hFill vFill max amount allow |
	extent := newBounds extent.
	aBool ifFalse: [extent := extent transposed].

	"figure out if we have any horizontal or vertical space fillers"
	hFill := vFill := false.
	max := 0 @ 0.
	arrangement do: 
			[:c | 
			max := (max x max: c cellSize x) @ (max y + c cellSize y).
			max := max max: c cellSize.
			hFill := hFill or: [c hSpaceFill].
			vFill := vFill or: [c vSpaceFill]].

	"Take client's shrink wrap constraints into account.
	Note: these are only honored when there are no #spaceFill children,
	or when #rubberBandCells is set."
	allow := properties rubberBandCells not.
	aMorph hResizing == #shrinkWrap 
		ifTrue: 
			[aBool 
				ifTrue: [allow & hFill ifFalse: [extent := max x @ (max y max: extent y)]]
				ifFalse: [allow & vFill ifFalse: [extent := (max x max: extent x) @ max y]]].
	aMorph vResizing == #shrinkWrap 
		ifTrue: 
			[aBool 
				ifFalse: [allow & hFill ifFalse: [extent := max x @ (max y max: extent y)]]
				ifTrue: [allow & vFill ifFalse: [extent := (max x max: extent x) @ max y]]].

	"Now compute the extra v space"
	extra := extent y 
				- (arrangement inject: 0 into: [:sum :c | sum + c cellSize y]).
	extra > 0 
		ifTrue: 
			["Check if we have any #spaceFillers"

			vFill 
				ifTrue: 
					["use only #spaceFillers"

					n := arrangement inject: 0
								into: [:sum :c | c vSpaceFill ifTrue: [sum + 1] ifFalse: [sum]].
					n isZero ifFalse: [extraPerCell := extra asFloat / n asFloat].
					extra := last := 0.
					arrangement do: 
							[:c | 
							c vSpaceFill 
								ifTrue: 
									[extra := (last := extra) + extraPerCell.
									amount := 0 @ (extra truncated - last truncated).
									c do: [:cc | cc cellSize: cc cellSize + amount]]]]
				ifFalse: 
					["no #spaceFillers; distribute regularly"

					centering := properties wrapCentering.
					"centering == #topLeft ifTrue:[]."	"add all extra space to the last cell; e.g., do nothing"
					centering == #bottomRight 
						ifTrue: 
							["add all extra space to the first cell"

							arrangement first addExtraSpace: 0 @ extra].
					centering == #center 
						ifTrue: 
							["add 1/2 extra space to the first and last cell"

							arrangement first addExtraSpace: 0 @ (extra // 2)].
					centering == #justified 
						ifTrue: 
							["add extra space equally distributed to each cell"

							n := arrangement size - 1 max: 1.
							extraPerCell := extra asFloat / n asFloat.
							extra := last := 0.
							arrangement do: 
									[:c | 
									c addExtraSpace: 0 @ (extra truncated - last truncated).
									extra := (last := extra) + extraPerCell]]]].

	"Now compute the extra space for the primary direction"
	centering := properties listCentering.
	1 to: arrangement size
		do: 
			[:i | 
			cell := arrangement at: i.
			extra := extent x - cell cellSize x.
			extra > 0 
				ifTrue: 
					["Check if we have any #spaceFillers"
					cell := cell nextCell.
					cell hSpaceFill 
						ifTrue: 
							["use only #spaceFillers"

							
							n := cell inject: 0
										into: [:sum :c | c hSpaceFill ifTrue: [sum + c target spaceFillWeight] ifFalse: [sum]].
							n isZero ifFalse: [extraPerCell := extra asFloat / n asFloat].
							extra := last := 0.
							cell do: 
									[:c | 
									c hSpaceFill 
										ifTrue: 
											[extra := (last := extra) + (extraPerCell * c target spaceFillWeight).
											amount := extra truncated - last truncated.
											c cellSize: c cellSize + (amount @ 0)]]]
						ifFalse: 
							["no #spaceFiller; distribute regularly"

						
							"centering == #topLeft ifTrue:[]"	"add all extra space to the last cell; e.g., do nothing"
							centering == #bottomRight 
								ifTrue: 
									["add all extra space to the first cell"

									cell addExtraSpace: extra @ 0].
							centering == #center 
								ifTrue: 
									["add 1/2 extra space to the first and last cell"

									cell addExtraSpace: (extra // 2) @ 0].
							centering == #justified 
								ifTrue: 
									["add extra space equally distributed to each cell"

									n := cell size - 1 max: 1.
									extraPerCell := extra asFloat / n asFloat.
									extra := last := 0.
									cell do: 
											[:c | 
											c addExtraSpace: (extra truncated - last truncated) @ 0.
											extra := (last := extra) + extraPerCell]]]]]! !

!TableLayout methodsFor: 'nil' stamp: 'nice 1/5/2010 15:59'!
minExtentVertical: aMorph
	"Return the minimal size aMorph's children would require given the new bounds"
	| inset minX minY maxX maxY n size width height |
	size := properties minCellSize asPoint. minX := size x. minY := size y.
	size := properties maxCellSize asPoint. maxX := size x. maxY := size y.
	inset := properties cellInset asPoint.
	n := 0.
	width := height := 0.
	aMorph submorphsDo:[:m| | sizeX sizeY |
		m disableTableLayout ifFalse:[
			n := n + 1.
			size := m minExtent. sizeX := size x. sizeY := size y.
			sizeX < minX
				ifTrue:[sizeX := minX]
				ifFalse:[sizeX > maxX ifTrue:[sizeX := maxX]].
			sizeY < minY
				ifTrue:[sizeY := minY]
				ifFalse:[sizeY > maxY ifTrue:[sizeY := maxY]].
			height := height + sizeY.
			sizeX > width ifTrue:[width := sizeX].
		].
	].
	n > 1 ifTrue:[height := height + (n-1 * inset y)].
	^minExtentCache := width @ height! !

!TableLayout methodsFor: 'nil' stamp: 'nice 1/5/2010 15:59'!
layoutTopToBottom: aMorph in: newBounds
	"An optimized top-to-bottom list layout"
	| inset extent block posX posY centering extraPerCell amount minX minY maxX maxY n height extra last cell size width sum vFill first |
	size := properties minCellSize asPoint. minX := size x. minY := size y.
	size := properties maxCellSize asPoint. maxX := size x. maxY := size y.
	inset := properties cellInset asPoint y.
	extent := newBounds extent.
	n := 0. vFill := false. sum := 0.
	width := height := 0.
	first := last := nil.
	block := [:m| | sizeX props sizeY |
		props := m layoutProperties ifNil:[m].
		props disableTableLayout ifFalse:[
			n := n + 1.
			cell := LayoutCell new target: m.
			(props vResizing == #spaceFill) ifTrue:[
				cell vSpaceFill: true.
				extra := m spaceFillWeight.
				cell extraSpace: extra.
				sum := sum + extra.
			] ifFalse:[cell vSpaceFill: false].
			(props hResizing == #spaceFill) ifTrue:[vFill := true].
			size := m minExtent. sizeX := size x. sizeY := size y.
			sizeX < minX
				ifTrue:[sizeX := minX]
				ifFalse:[sizeX > maxX ifTrue:[sizeX := maxX]].
			sizeY < minY
				ifTrue:[sizeY := minY]
				ifFalse:[sizeY > maxY ifTrue:[sizeY := maxY]].
			cell cellSize: sizeY.
			first ifNil:[first := cell] ifNotNil:[last nextCell: cell].
			last := cell.
			height := height + sizeY.
			sizeX > width ifTrue:[width := sizeX].
		].
	].
	properties reverseTableCells
		ifTrue:[aMorph submorphsReverseDo: block]
		ifFalse:[aMorph submorphsDo: block].

	n > 1 ifTrue:[height := height + (n-1 * inset)].

	(properties vResizing == #shrinkWrap and:[properties rubberBandCells or:[sum isZero]])
		ifTrue:[extent := (extent x max: width) @ height].
	(properties hResizing == #shrinkWrap and:[properties rubberBandCells or:[vFill not]])
		ifTrue:[extent := width @ (extent y max: height)].

	posX := newBounds left.
	posY := newBounds top.

	"Compute extra horizontal space"
	extra := extent x - width.
	extra < 0 ifTrue:[extra := 0].
	extra > 0 ifTrue:[
		vFill ifTrue:[
			width := extent x.
		] ifFalse:[
			centering := properties wrapCentering.
			centering == #bottomRight ifTrue:[posX := posX + extra].
			centering == #center ifTrue:[posX := posX + (extra // 2)]
		].
	].


	"Compute extra vertical space"
	extra := extent y - height.
	extra < 0 ifTrue:[extra := 0].
	extraPerCell := 0.
	extra > 0 ifTrue:[
		sum isZero ifTrue:["extra space but no #spaceFillers"
			centering := properties listCentering.
			centering == #bottomRight ifTrue:[posY := posY + extra].
			centering == #center ifTrue:[posY := posY + (extra // 2)].
		] ifFalse:[extraPerCell := extra asFloat / sum asFloat].
	].

	n := 0.
	extra := last := 0.
	cell := first.
	[cell == nil] whileFalse:[
		n := n + 1.
		height := cell cellSize.
		(extraPerCell > 0 and:[cell vSpaceFill]) ifTrue:[
			extra := (last := extra) + (extraPerCell * cell extraSpace).
			amount := extra truncated - last truncated.
			height := height + amount.
		].
		cell target layoutInBounds: (posX @ posY extent: width @ height).
		posY := posY + height + inset.
		cell := cell nextCell.
	].! !

!TableLayout methodsFor: 'utilities' stamp: 'aoy 2/17/2003 01:22'!
indexForInserting: aMorph at: aPoint in: owner 
	"Return the insertion index based on the layout strategy defined for some morph. Used for drop insertion."

	| horizontal morphList index |
	owner hasSubmorphs ifFalse: [^1].
	aMorph disableTableLayout ifTrue: [^1].
	horizontal := (owner listDirection == #topToBottom 
				or: [owner listDirection == #bottomToTop]) not .
	morphList := owner submorphs.
	owner reverseTableCells ifTrue: [morphList := morphList reversed].
	index := self 
				indexForInserting: aPoint
				inList: morphList
				horizontal: horizontal
				target: owner.
	owner reverseTableCells ifTrue: [index := morphList size - index + 2].
	^index ifNil: [1]! !

!TableLayout methodsFor: 'layout' stamp: 'nice 1/5/2010 15:59'!
computeCellSizes: aMorph in: newBounds horizontal: aBool
	"Step 1: Compute the minimum extent for all the children of aMorph"
	| cells block minSize maxSize maxCell |
	cells := (Array new: aMorph submorphCount) writeStream.
	minSize := properties minCellSize asPoint.
	maxSize := properties maxCellSize asPoint.
	aBool ifTrue:[
		minSize := minSize transposed.
		maxSize := maxSize transposed].
	maxCell := 0@0.
	block := [:m| | cell size |
		m disableTableLayout ifFalse:[
			size := m minExtent asIntegerPoint.
			cell := LayoutCell new target: m.
			aBool ifTrue:[
				cell hSpaceFill: m hResizing == #spaceFill.
				cell vSpaceFill: m vResizing == #spaceFill.
			] ifFalse:[
				cell hSpaceFill: m vResizing == #spaceFill.
				cell vSpaceFill: m hResizing == #spaceFill.
				size := size transposed.
			].
			size := (size min: maxSize) max: minSize.
			cell cellSize: size.
			maxCell := maxCell max: size.
			cells nextPut: cell]].
	properties reverseTableCells
		ifTrue:[aMorph submorphsReverseDo: block]
		ifFalse:[aMorph submorphsDo: block].
	^maxCell -> cells contents! !

!TableLayout methodsFor: 'layout' stamp: 'dgd 2/22/2003 14:42'!
placeCells: arrangement in: newBounds horizontal: aBool target: aMorph 
	"Place the morphs within the cells accordingly"

	| xDir yDir anchor yDist place cell xDist cellRect corner inset |
	inset := properties cellInset.
	(inset isNumber and: [inset isZero]) ifTrue: [inset := nil].
	aBool 
		ifTrue: 
			["horizontal layout"

			properties listDirection == #rightToLeft 
				ifTrue: 
					[xDir := -1 @ 0.
					properties wrapDirection == #bottomToTop 
						ifTrue: 
							[yDir := 0 @ -1.
							anchor := newBounds bottomRight]
						ifFalse: 
							[yDir := 0 @ 1.
							anchor := newBounds topRight]]
				ifFalse: 
					[xDir := 1 @ 0.
					properties wrapDirection == #bottomToTop 
						ifTrue: 
							[yDir := 0 @ -1.
							anchor := newBounds bottomLeft]
						ifFalse: 
							[yDir := 0 @ 1.
							anchor := newBounds topLeft]]]
		ifFalse: 
			["vertical layout"

			properties listDirection == #bottomToTop 
				ifTrue: 
					[xDir := 0 @ -1.
					properties wrapDirection == #rightToLeft 
						ifTrue: 
							[yDir := -1 @ 0.
							anchor := newBounds bottomRight]
						ifFalse: 
							[yDir := 1 @ 0.
							anchor := newBounds bottomLeft]]
				ifFalse: 
					[xDir := 0 @ 1.
					anchor := properties wrapDirection == #rightToLeft 
								ifTrue: 
									[yDir := -1 @ 0.
									newBounds topRight]
								ifFalse: 
									[yDir := 1 @ 0.
									newBounds topLeft]]].
	1 to: arrangement size
		do: 
			[:i | 
			cell := arrangement at: i.
			cell extraSpace ifNotNil: [anchor := anchor + (cell extraSpace y * yDir)].
			yDist := cell cellSize y * yDir.	"secondary advance direction"
			place := anchor.
			cell := cell nextCell.
			[cell isNil] whileFalse: 
					[cell extraSpace ifNotNil: [place := place + (cell extraSpace x * xDir)].
					xDist := cell cellSize x * xDir.	"primary advance direction"
					corner := place + xDist + yDist.
					cellRect := Rectangle origin: (place min: corner)
								corner: (place max: corner).
					inset ifNotNil: [cellRect := cellRect insetBy: inset].
					cell target layoutInBounds: cellRect.
					place := place + xDist.
					cell := cell nextCell].
			anchor := anchor + yDist]! !

!TableLayout methodsFor: 'utilities' stamp: 'nice 1/5/2010 15:59'!
indexForInserting: aPoint inList: morphList horizontal: aBool target: aMorph 
	| cmp1 cmp2 cmp3 noWrap |
	properties := aMorph layoutProperties.
	noWrap := properties wrapDirection == #none.
	aBool 
		ifTrue: 
			["horizontal"

			properties listDirection == #rightToLeft 
				ifTrue: [cmp1 := [:rect | aPoint x > rect left]]
				ifFalse: [cmp1 := [:rect | aPoint x < rect right]].
			properties wrapDirection == #bottomToTop 
				ifTrue: 
					[cmp2 := [:rect | aPoint y > rect top].
					cmp3 := [:rect | aPoint y > rect bottom]]
				ifFalse: 
					[cmp2 := [:rect | aPoint y < rect bottom].
					cmp3 := [:rect | aPoint y < rect top]]]
		ifFalse: 
			["vertical"

			properties listDirection == #bottomToTop 
				ifTrue: [cmp1 := [:rect | aPoint y > rect top]]
				ifFalse: [cmp1 := [:rect | aPoint y < rect bottom]].
			properties wrapDirection == #rightToLeft 
				ifTrue: 
					[cmp2 := [:rect | aPoint x > rect left].
					cmp3 := [:rect | aPoint x > rect right]]
				ifFalse: 
					[cmp2 := [:rect | aPoint x < rect right].
					cmp3 := [:rect | aPoint x < rect left]]]. 
	morphList keysAndValuesDo: 
			[:index :m | | box | 
			self flag: #arNote.	"it is not quite clear if we can really use #fullBounds here..."
			box := m fullBounds.
			noWrap 
				ifTrue: 
					["Only in one direction"

					(cmp1 value: box) ifTrue: [^index]]
				ifFalse: 
					["Check for inserting before current row"

					(cmp3 value: box) ifTrue: [^index].
					"Check for inserting before current cell"
					((cmp1 value: box) and: [cmp2 value: box]) ifTrue: [^index]]].
	^morphList size + 1! !

!TableLayout methodsFor: 'layout' stamp: 'gvc 2/25/2010 19:44'!
layoutLeftToRight: aMorph in: newBounds
	"An optimized left-to-right list layout"
	| inset extent block posX posY centering extraPerCell amount minX minY maxX maxY n width extra last cell size height sum vFill first |
	size := properties minCellSize asPoint. minX := size x. minY := size y.
	size := properties maxCellSize asPoint. maxX := size x. maxY := size y.
	inset := properties cellInset asPoint x.
	extent := newBounds extent.
	n := 0. vFill := false. sum := 0.
	width := height := 0.
	first := last := nil.
	block := [:m| | sizeY sizeX props |
		props := m layoutProperties ifNil:[m].
		props disableTableLayout ifFalse:[
			n := n + 1.
			cell := LayoutCell new target: m.
			(props hResizing == #spaceFill) ifTrue:[
				cell hSpaceFill: true.
				extra := m spaceFillWeight.
				cell extraSpace: extra.
				sum := sum + extra.
			] ifFalse:[cell hSpaceFill: false].
			(props vResizing == #spaceFill) ifTrue:[vFill := true].
			size := m minExtent. sizeX := size x. sizeY := size y.
			sizeX < minX
				ifTrue:[sizeX := minX]
				ifFalse:[sizeX > maxX ifTrue:[sizeX := maxX]].
			sizeY < minY
				ifTrue:[sizeY := minY]
				ifFalse:[sizeY > maxY ifTrue:[sizeY := maxY]].
			cell cellSize: sizeX.
			last ifNil:[first := cell] ifNotNil:[last nextCell: cell].
			last := cell.
			width := width + sizeX.
			sizeY > height ifTrue:[height := sizeY].
		].
	].
	properties reverseTableCells
		ifTrue:[aMorph submorphsReverseDo: block]
		ifFalse:[aMorph submorphsDo: block].

	n > 1 ifTrue:[width := width + (n-1 * inset)].

	(properties hResizing == #shrinkWrap and:[properties rubberBandCells or:[sum isZero]])
		ifTrue:[extent := width @ (extent y max: height)].
	(properties vResizing == #shrinkWrap and:[properties rubberBandCells or:[vFill not]])
		ifTrue:[extent := (extent x max: width) @ height].

	posX := newBounds left.
	posY := newBounds top.

	"Compute extra vertical space"
	extra := extent y - height.
	extra < 0 ifTrue:[extra := 0].
	extra > 0 ifTrue:[
		vFill ifTrue:[
			height := extent y.
		] ifFalse:[
			centering := properties wrapCentering.
			centering == #bottomRight ifTrue:[posY := posY + extra].
			centering == #center ifTrue:[posY := posY + (extra // 2)]
		].
	].


	"Compute extra horizontal space"
	extra := extent x - width.
	extra < 0 ifTrue:[extra := 0].
	extraPerCell := 0.
	extra > 0 ifTrue:[
		sum isZero ifTrue:["extra space but no #spaceFillers"
			centering := properties listCentering.
			centering == #bottomRight ifTrue:[posX := posX + extra].
			centering == #center ifTrue:[posX := posX + (extra // 2)].
		] ifFalse:[extraPerCell := extra asFloat / sum asFloat].
	].

	n := 0.
	extra := last := 0.
	cell := first.
	[cell == nil] whileFalse:[
		n := n + 1.
		width := cell cellSize.
		(extraPerCell > 0 and:[cell hSpaceFill]) ifTrue:[
			extra := (last := extra) + (extraPerCell * cell extraSpace).
			amount := extra truncated - last truncated.
			width := width + amount.
		].
		cell target layoutInBounds: (posX @ posY extent: width @ height).
		posX := posX + width + inset.
		cell := cell nextCell.
	].
! !

!TableLayout methodsFor: 'layout' stamp: 'aoy 2/17/2003 01:23'!
layout: aMorph in: box 
	"Compute the layout for the given morph based on the new bounds"

	| cells arrangement horizontal newBounds |
	aMorph hasSubmorphs ifFalse: [^self].
	properties := aMorph assureTableProperties.
	newBounds := box origin asIntegerPoint corner: box corner asIntegerPoint.
	(properties wrapDirection == #none and: [properties cellSpacing == #none]) 
		ifTrue: 
			["get into the fast lane"

			properties listCentering == #justified 
				ifFalse: 
					["can't deal with that"

					properties listDirection == #leftToRight 
						ifTrue: [^self layoutLeftToRight: aMorph in: newBounds].
					properties listDirection == #topToBottom 
						ifTrue: [^self layoutTopToBottom: aMorph in: newBounds]]].
	horizontal := (properties listDirection == #topToBottom 
				or: [properties listDirection == #bottomToTop]) not. 
	"Step 1: Compute the minimum extent for all the children of aMorph"
	cells := self 
				computeCellSizes: aMorph
				in: (0 @ 0 corner: newBounds extent)
				horizontal: horizontal.
	"Step 2: Compute the arrangement of the cells for each row and column"
	arrangement := self 
				computeCellArrangement: cells
				in: newBounds
				horizontal: horizontal
				target: aMorph.
	"Step 3: Compute the extra spacing for each cell"
	self 
		computeExtraSpacing: arrangement
		in: newBounds
		horizontal: horizontal
		target: aMorph.
	"Step 4: Place the children within the cells accordingly"
	self 
		placeCells: arrangement
		in: newBounds
		horizontal: horizontal
		target: aMorph! !

!TableLayout methodsFor: 'testing' stamp: 'ar 10/29/2000 01:29'!
isTableLayout
	^true! !

!TableLayout methodsFor: 'layout' stamp: 'PeterHugossonMiller 9/3/2009 11:37'!
computeGlobalCellArrangement: cells in: newBounds horizontal: aBool wrap: wrap spacing: spacing
	"Compute number of cells we can put in each row/column. The returned array contains a list of all the cells we can put into the row/column at each level.
	Note: The arrangement is so that the 'x' value of each cell advances along the list direction and the 'y' value along the wrap direction. The returned arrangement has an extra cell at the start describing the width and height of the row."
	| output maxExtent n cell first last hFill vFill |
	output := Array new writeStream.
	first := last := nil.
	maxExtent := cells inject: 0@0 into:[:size :c| size max: c cellSize "e.g., minSize"].
	spacing == #globalSquare ifTrue:[maxExtent := (maxExtent x max: maxExtent y) asPoint].
	n := (wrap // maxExtent x) max: 1.
	hFill := vFill := false.
	1 to: cells size do:[:i|
		cell := cells at: i.
		hFill := hFill or:[cell hSpaceFill].
		vFill := vFill or:[cell vSpaceFill].
		cell cellSize: maxExtent.
		first ifNil:[first := last := cell] ifNotNil:[last nextCell: cell. last := cell].
		(i \\ n) = 0 ifTrue:[
			last := LayoutCell new.
			last cellSize: (maxExtent x * n) @ (maxExtent y).
			last hSpaceFill: hFill.
			last vSpaceFill: vFill.
			hFill := vFill := false.
			last nextCell: first.
			output nextPut: last.
			first := nil]].
	first ifNotNil:[
		last := LayoutCell new.
		last cellSize: (maxExtent x * n) @ (maxExtent y). self flag: #arNote."@@@: n is not correct!!"
		last nextCell: first.
		output nextPut: last].
	^output contents
! !

!TableLayout methodsFor: 'nil' stamp: 'nice 1/5/2010 15:59'!
minExtentHorizontal: aMorph
	"Return the minimal size aMorph's children would require given the new bounds"
	| inset minX minY maxX maxY n size width height |
	size := properties minCellSize asPoint. minX := size x. minY := size y.
	size := properties maxCellSize asPoint. maxX := size x. maxY := size y.
	inset := properties cellInset asPoint.
	n := 0.
	width := height := 0.
	aMorph submorphsDo:[:m| | sizeY sizeX |
		m disableTableLayout ifFalse:[
			n := n + 1.
			size := m minExtent. sizeX := size x. sizeY := size y.
			sizeX < minX
				ifTrue:[sizeX := minX]
				ifFalse:[sizeX > maxX ifTrue:[sizeX := maxX]].
			sizeY < minY
				ifTrue:[sizeY := minY]
				ifFalse:[sizeY > maxY ifTrue:[sizeY := maxY]].
			width := width + sizeX.
			sizeY > height ifTrue:[height := sizeY].
		].
	].
	n > 1 ifTrue:[width := width + (n-1 * inset x)].
	^minExtentCache := width @ height! !

!TableLayout methodsFor: 'layout' stamp: 'ar 1/27/2001 14:40'!
flushLayoutCache
	"Flush any cached information associated with the receiver"
	minExtentCache := nil.! !

!TableLayoutProperties methodsFor: 'table defaults' stamp: 'ar 11/14/2000 17:47'!
maxCellSize
	^maxCellSize! !

!TableLayoutProperties methodsFor: 'accessing' stamp: 'ar 11/14/2000 17:48'!
wrapCentering: aSymbol
	wrapCentering := aSymbol! !

!TableLayoutProperties methodsFor: 'table defaults' stamp: 'ar 11/14/2000 17:46'!
listDirection
	^listDirection! !

!TableLayoutProperties methodsFor: 'accessing' stamp: 'ar 11/14/2000 17:46'!
cellSpacing: aSymbol
	cellSpacing := aSymbol.! !

!TableLayoutProperties methodsFor: 'testing' stamp: 'ar 11/13/2000 18:34'!
includesTableProperties
	^true! !

!TableLayoutProperties methodsFor: 'accessing' stamp: 'ar 11/14/2000 17:47'!
reverseTableCells: aBool
	reverseTableCells := aBool! !

!TableLayoutProperties methodsFor: 'accessing' stamp: 'ar 11/13/2000 17:57'!
cellInset: aNumber
	cellInset := aNumber! !

!TableLayoutProperties methodsFor: 'table defaults' stamp: 'ar 11/14/2000 17:46'!
listCentering
	^listCentering! !

!TableLayoutProperties methodsFor: 'accessing' stamp: 'ar 11/13/2000 17:57'!
minCellSize: aNumber
	minCellSize := aNumber.! !

!TableLayoutProperties methodsFor: 'initialization' stamp: 'ar 11/14/2000 17:45'!
initialize
	super initialize.
	cellSpacing := listSpacing := wrapDirection := #none.
	cellPositioning := #center.
	listCentering := wrapCentering := #topLeft.
	listDirection := #topToBottom.
	reverseTableCells := rubberBandCells := false.
	layoutInset := cellInset := minCellSize := 0.
	maxCellSize := 1073741823. "SmallInteger maxVal"
! !

!TableLayoutProperties methodsFor: 'accessing' stamp: 'ar 11/14/2000 17:46'!
listCentering: aSymbol
	listCentering := aSymbol! !

!TableLayoutProperties methodsFor: 'table defaults' stamp: 'ar 11/14/2000 17:46'!
cellSpacing
	^cellSpacing! !

!TableLayoutProperties methodsFor: 'table defaults' stamp: 'ar 11/14/2000 17:48'!
wrapCentering
	^wrapCentering! !

!TableLayoutProperties methodsFor: 'table defaults' stamp: 'ar 11/14/2000 17:45'!
cellInset
	^cellInset! !

!TableLayoutProperties methodsFor: 'accessing' stamp: 'ar 11/13/2000 17:58'!
maxCellSize: aNumber
	maxCellSize := aNumber.! !

!TableLayoutProperties methodsFor: 'table defaults' stamp: 'ar 11/14/2000 17:47'!
rubberBandCells
	^rubberBandCells! !

!TableLayoutProperties methodsFor: 'accessing' stamp: 'ar 11/14/2000 17:48'!
rubberBandCells: aBool
	rubberBandCells := aBool.! !

!TableLayoutProperties methodsFor: 'accessing' stamp: 'ar 11/14/2000 16:37'!
layoutInset: aNumber
	layoutInset := aNumber! !

!TableLayoutProperties methodsFor: 'table defaults' stamp: 'ar 11/14/2000 17:47'!
reverseTableCells
	^reverseTableCells! !

!TableLayoutProperties methodsFor: 'table defaults' stamp: 'ar 11/14/2000 16:37'!
layoutInset
	^layoutInset! !

!TableLayoutProperties methodsFor: 'accessing' stamp: 'ar 11/14/2000 17:47'!
listSpacing: aSymbol
	listSpacing := aSymbol! !

!TableLayoutProperties methodsFor: 'accessing' stamp: 'ar 11/14/2000 17:49'!
cellPositioning: aSymbol
	cellPositioning := aSymbol! !

!TableLayoutProperties methodsFor: 'table defaults' stamp: 'ar 11/14/2000 17:47'!
listSpacing
	^listSpacing! !

!TableLayoutProperties methodsFor: 'table defaults' stamp: 'ar 11/14/2000 17:48'!
wrapDirection
	^wrapDirection! !

!TableLayoutProperties methodsFor: 'accessing' stamp: 'ar 11/14/2000 17:48'!
wrapDirection: aSymbol
	wrapDirection := aSymbol! !

!TableLayoutProperties methodsFor: 'table defaults' stamp: 'ar 11/14/2000 17:49'!
cellPositioning
	^cellPositioning! !

!TableLayoutProperties methodsFor: 'table defaults' stamp: 'ar 11/14/2000 17:47'!
minCellSize
	^minCellSize! !

!TableLayoutProperties methodsFor: 'accessing' stamp: 'ar 11/14/2000 17:46'!
listDirection: aSymbol
	listDirection := aSymbol.! !

!TabsExample commentStamp: 'MarcusDenker 7/26/2014 13:55'!
I am an example of how to use tabs

TabsExample open!
!TabsExample methodsFor: 'private' stamp: 'MarcusDenker 7/26/2014 13:55'!
objectInspectorTab

	^ self newTab
		label: 'Object inspector';
		icon: Smalltalk ui icons nautilusIcon;
		retrievingBlock: [ (EyeInspector new
				inspect: Object;
				buildWithSpec: #inspectorSpec) asWidget ];
		yourself.
	! !

!TabsExample methodsFor: 'private' stamp: 'MarcusDenker 7/26/2014 13:56'!
browserTab

	^ self newTab
		label: 'Browser';
		icon: Smalltalk ui icons nautilusIcon;
		model: (ClassMethodBrowser new
			classes: Smalltalk allClasses;
			yourself);
		yourself! !

!TabsExample methodsFor: 'private' stamp: 'MarcusDenker 7/29/2014 07:08'!
objectClassTab
	
	^self newTab
		label: 'Object class';
		icon: Smalltalk ui icons nautilusIcon;
		model: (MessageBrowser new messages: Object methods);
		yourself
	! !

!TabsExample methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 10/1/2013 14:33'!
populateManager

	manager
		addTab: self objectClassTab;
		addTab: self objectInspectorTab;
		addTab: self browserTab! !

!TabsExample methodsFor: 'as yet unclassified' stamp: 'BenjaminVanRyseghem 10/1/2013 14:48'!
title

	^ self manager selectedTab
		ifNil: [ 'Tabs Example' ]
		ifNotNil: [:tab | tab label ]! !

!TabsExample methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/1/2013 14:13'!
manager

	^ manager! !

!TabsExample methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 10/1/2013 14:46'!
initializeWidgets

	manager := self newTabManager.
	manager whenTabSelected: [ self updateTitle ].
	self populateManager! !

!TabsExample class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/1/2013 14:12'!
defaultSpec
	<spec>
	
	^ SpecLayout composed
		add: #manager;
		yourself! !

!TabsExample class methodsFor: 'instance creation' stamp: 'MarcusDenker 7/26/2014 13:55'!
open
	^self new openWithSpec! !

!TagMorphFactory commentStamp: '<historical>'!
A TagMorph is a morph used to define some tags.
It uses a rounded rectancle with a text inside.

self example!
!TagMorphFactory methodsFor: 'protocol' stamp: 'ChristopheDemarey 10/16/2013 18:12'!
morph
	| textMorph width |
	textMorph := self textMorph.
	width := textMorph width + 10.
	^ BorderedMorph new
		extent: width @ self height;
		borderWidth: 1;
		color: self color;
		useRoundedCorners;
		addMorphCentered: textMorph;
		yourself! !

!TagMorphFactory methodsFor: 'accessing' stamp: 'ChristopheDemarey 10/16/2013 17:48'!
color
	^ color ifNil: [ Color green ]! !

!TagMorphFactory methodsFor: 'private' stamp: 'ChristopheDemarey 10/16/2013 17:59'!
textMorph
	^ text asMorph
		font:  self font;
		yourself.! !

!TagMorphFactory methodsFor: 'accessing' stamp: 'ChristopheDemarey 10/16/2013 18:13'!
font
	^ (LogicalFont 
		familyName: TextStyle defaultFont familyName 
		pointSize: 8)
		emphasis: 1.! !

!TagMorphFactory methodsFor: 'accessing' stamp: 'ChristopheDemarey 10/16/2013 17:47'!
text: aString
	text := aString! !

!TagMorphFactory methodsFor: 'accessing' stamp: 'ChristopheDemarey 10/16/2013 17:47'!
color: aColor
	color := aColor! !

!TagMorphFactory methodsFor: 'accessing' stamp: 'ChristopheDemarey 10/16/2013 18:12'!
height
	^ 12! !

!TagMorphFactory methodsFor: 'accessing' stamp: 'ChristopheDemarey 10/16/2013 17:46'!
text
	^ text! !

!TagMorphFactory class methodsFor: 'instance creation' stamp: 'ChristopheDemarey 10/22/2013 16:32'!
newTag: aText
	^ self new
		text: aText;
		yourself.! !

!TagMorphFactory class methodsFor: 'example' stamp: 'ChristopheDemarey 10/22/2013 16:32'!
example
	(TagMorphFactory newTag: 'development') 
		morph openInHand ! !

!TarArchive commentStamp: '<historical>'!
This is a kind of archive that uses the TAR format (popular in Unix). It is here as a placeholder.!
!TarArchive methodsFor: 'private' stamp: 'nk 2/21/2001 18:27'!
memberClass
	^TarArchiveMember! !

!TarArchiveMember commentStamp: 'TorstenBergmann 2/3/2014 23:04'!
A member of a TAR archive!
!TaskListMorph commentStamp: 'gvc 5/18/2007 11:19'!
Themed task list/switcher to select the topmost window. Use cmd + left or right arrows (not ideal but the os typically handles cmd + tab/shift-tab).
On Linux, release of the command key is not detected (vm issue), so press and release cmd again or move the mouse!!!
!TaskListMorph methodsFor: 'instance creation' stamp: 'SeanDeNigris 1/23/2014 12:50'!
newTasksMorph
	"Answer a new task list."

	^Morph new
		changeTableLayout;
		listDirection: #leftToRight;
		wrapDirection: #topToBottom;
		cellInset: 1;
		color: Color transparent;
		hResizing: #spaceFill;
		vResizing: #shrinkWrap;
		yourself.! !

!TaskListMorph methodsFor: 'private' stamp: 'SeanDeNigris 1/23/2014 12:49'!
addMorphs
	"Add our morphs."

	| mainColumn |
	self preview: self newPreviewMorph.
	self taskList: self newTasksMorph.
	mainColumn := self theme newColumnIn: self for: {
		self preview.
		self taskList }.
	mainColumn
		vResizing: #shrinkWrap;
		cellInset: 8;
		cellPositioning: #center.
	self addMorph: mainColumn.
	self layoutChanged! !

!TaskListMorph methodsFor: 'event handling' stamp: 'MarcusDenker 3/22/2013 13:59'!
keyStroke: event 
	"Process keys to switch task."
	
	event keyCharacter = Character escape ifTrue: [^self delete].
	event anyModifierKeyPressed ifFalse: [^self done].
	event keyString =  '<Opt-Shift-tab>' ifTrue: [^self selectPreviousTask].
	event keyString =  '<Opt-tab>'	ifTrue: [^self selectNextTask]! !

!TaskListMorph methodsFor: 'open/close' stamp: 'GuillermoPolito 5/1/2012 20:06'!
openAsIsIn: aWorld
	"Update the layout after opening."

	aWorld addMorphCentered: self.
	self allMorphs do: [:m | m layoutChanged].
	aWorld startSteppingSubmorphsOf: self.
	
	self announceOpened.
	
	self wantsKeyboardFocus
		ifTrue: [self takeKeyboardFocus]! !

!TaskListMorph methodsFor: 'private' stamp: 'GastonDallOglio 5/23/2011 21:58'!
selectTask: aTask
	"Make the given task active and update the buttons."
	
	self tasks do: [:t | t state: #restored].
	aTask ifNotNil: [ aTask state: #active ].
	self updateButtonsAndPreview! !

!TaskListMorph methodsFor: 'settings' stamp: 'AlainPlantec 12/14/2009 19:11'!
keepOpen
	^ self class keepOpen! !

!TaskListMorph methodsFor: 'accessing' stamp: 'gvc 4/20/2007 10:16'!
tasks
	"Answer the value of tasks"

	^ tasks! !

!TaskListMorph methodsFor: 'cycling' stamp: 'gvc 4/20/2007 11:35'!
selectPreviousTask
	"Make the previous task active."
	
	self selectTask: (self tasks
		before: self activeTask
		ifAbsent: [self tasks isEmpty
					ifFalse: [self tasks last]])! !

!TaskListMorph methodsFor: 'initialization' stamp: 'gvc 4/20/2007 11:12'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		initializeTasks;
		initializeLayout;
		initializeAppearance;
		addMorphs;
		updateButtonsAndPreview;
		adoptPaneColor: self color! !

!TaskListMorph methodsFor: 'accessing' stamp: 'gvc 4/20/2007 10:58'!
taskList
	"Answer the value of taskList"

	^ taskList! !

!TaskListMorph methodsFor: 'accessing' stamp: 'gvc 4/20/2007 11:11'!
preview: anObject
	"Set the value of preview"

	preview := anObject! !

!TaskListMorph methodsFor: 'private' stamp: 'gvc 4/20/2007 10:40'!
defaultPreviewExtent
	"Answer the default extent of the preview holder."

	^320@320! !

!TaskListMorph methodsFor: 'open/close' stamp: 'gvc 4/20/2007 11:21'!
openAsIs
	"Open in the world."
	
	self openAsIsIn: self currentWorld! !

!TaskListMorph methodsFor: 'private' stamp: 'GastonDallOglio 5/23/2011 21:32'!
updatePreview
	"Update the preview.."
	
	self preview removeAllMorphs.
	self preview addMorphCentered: ( 
		self activeTask 
				ifNil: [ 'No tasks...' asMorph	]
				ifNotNil: [:t | t morph taskThumbnailOfSize: self preview extent])! !

!TaskListMorph methodsFor: 'cycling' stamp: 'gvc 4/20/2007 11:35'!
selectNextTask
	"Make the next task active."
	
	self selectTask: (self tasks
		after: self activeTask
		ifAbsent: [self tasks isEmpty
					ifFalse: [self tasks first]])! !

!TaskListMorph methodsFor: 'stepping' stamp: 'gvc 4/20/2007 14:59'!
stepTime
	"Check quickly."

	^100! !

!TaskListMorph methodsFor: 'initialization' stamp: 'gvc 4/20/2007 10:27'!
initializeTasks
	"Set up the current tasks."
	
	self tasks: ((World submorphs
		collect: [:m | m taskbarTask])
		select: [:m | m notNil]) asOrderedCollection! !

!TaskListMorph methodsFor: 'private' stamp: 'gvc 3/2/2009 12:22'!
taskClicked: aTask
	"A button for a task has been pressed.
	Close after selecting."
	
	self selectTask: aTask.
	self done! !

!TaskListMorph methodsFor: 'event handling' stamp: 'gvc 4/20/2007 14:51'!
handlesKeyboard: evt
	"Yes, we do it here."
	
	^true! !

!TaskListMorph methodsFor: 'running' stamp: 'GastonDallOglio 5/23/2011 21:59'!
done
	"Close the tasklist and make the active task current."
	
	self delete.
	self activeTask ifNotNil: [ :t | t activate ]! !

!TaskListMorph methodsFor: 'accessing' stamp: 'gvc 4/20/2007 10:16'!
tasks: anObject
	"Set the value of tasks"

	tasks := anObject! !

!TaskListMorph methodsFor: 'open/close' stamp: 'gvc 9/7/2007 21:44'!
takesKeyboardFocus
	"Answer whether the receiver can normally take keyboard focus."

	^true! !

!TaskListMorph methodsFor: 'private' stamp: 'SeanDeNigris 1/23/2014 12:00'!
updateTaskButtons
	"Make buttons for the ordered tasks."
	
	
	self taskList removeAllMorphs.
	self tasks do: [:t | | button |
		button := t taskListButtonFor: self.
		button ifNotNil: [self taskList addMorphBack: button]]! !

!TaskListMorph methodsFor: 'private' stamp: 'gvc 4/20/2007 11:02'!
activeTask
	"Answer the active task"
	
	^self tasks detect: [:t | t isActive] ifNone: []! !

!TaskListMorph methodsFor: 'initialization' stamp: 'SeanDeNigris 1/23/2014 12:03'!
initializeAppearance
	"Initialize the appearance."

	self
		color: (Color black alpha: 0.15);
		fillStyle: (self theme taskListFillStyleFor: self);
		borderStyle: (self theme taskbarThumbnailNormalBorderStyleFor: self);
		cornerStyle: (self theme taskbarThumbnailCornerStyleFor: self)! !

!TaskListMorph methodsFor: 'accessing' stamp: 'gvc 4/20/2007 11:11'!
preview
	"Answer the value of preview"

	^ preview! !

!TaskListMorph methodsFor: 'stepping' stamp: 'IgorStasenko 1/22/2012 18:25'!
step
	"Check the sensor for the command key to see if we're done."

	(self keepOpen not and: [self activeHand anyModifierKeyPressed not])
		ifTrue: [self done]! !

!TaskListMorph methodsFor: 'geometry' stamp: 'gvc 4/20/2007 11:14'!
minimumExtent
	"Answer the minimum extent."

	^self defaultPreviewExtent + 64! !

!TaskListMorph methodsFor: 'initialization' stamp: 'AlainPlantec 9/22/2011 00:25'!
initializeLayout
	"Initialize the layout."

	self
		changeTableLayout;
		layoutInset: 16;
		vResizing: #shrinkWrap;
		hResizing: #shrinkWrap;
		extent: self minimumExtent! !

!TaskListMorph methodsFor: 'accessing' stamp: 'gvc 4/20/2007 10:58'!
taskList: anObject
	"Set the value of taskList"

	taskList := anObject! !

!TaskListMorph methodsFor: 'instance creation' stamp: 'StephaneDucasse 7/20/2014 13:55'!
newPreviewMorph
	"Answer a new preview holder."
	self halt.
	^ Morph new
		color: Color transparent;
		extent: self defaultPreviewExtent;
		yourself.! !

!TaskListMorph methodsFor: 'private' stamp: 'AlainPlantec 9/22/2011 00:21'!
updateButtonsAndPreview
	"Update the buttons and the preview.."
	
	self
		updateTaskButtons;
		updatePreview.
	self world ifNotNil: 
		[self center: self world center]! !

!TaskListMorph class methodsFor: 'settings' stamp: 'StephaneDucasse 11/11/2014 18:50'!
taskListSettingOn: aBuilder
	<systemsettings> 
	(aBuilder setting: #keepTaskListOpen)
		label: 'Keep task list open';
		description: 'Whether the tasklist is closed (and the selected window activated) when the command key is released';
		parent: #morphic;
		selector: #keepOpen;
		target: self.! !

!TaskListMorph class methodsFor: 'instance creation' stamp: 'SeanDeNigris 1/22/2014 20:07'!
from: aKeyboardEvent 

	| instance |
	instance := self new.
	aKeyboardEvent shiftPressed
		ifTrue: [ instance selectNextTask ]
		ifFalse: [ instance selectPreviousTask ].
	^ instance.! !

!TaskListMorph class methodsFor: 'settings' stamp: 'AlainPlantec 12/14/2009 19:10'!
keepOpen: aBoolean
	KeepOpen := aBoolean! !

!TaskListMorph class methodsFor: 'testing' stamp: 'SeanDeNigris 1/22/2014 20:17'!
isNavigationEvent: aKeyboardEvent

	^ aKeyboardEvent asKeyCombination = Character tab alt or: [ aKeyboardEvent asKeyCombination = Character tab alt shift ].! !

!TaskListMorph class methodsFor: 'settings' stamp: 'AlainPlantec 12/14/2009 19:10'!
keepOpen
	^ KeepOpen ifNil: [KeepOpen := false]! !

!TaskbarMorph commentStamp: 'AlainPlantec 1/7/2010 22:47'!
Themed synchronous taskbar (not using #step to poll windows). The buttons provide visual feedback as to whether a window is active or minimised (collapsed) plus a popup menu with options to restore, minimise, maximise and close the associated window. Optional (via settings) preview of the window while mouse is over a taskbar button.
!
!TaskbarMorph methodsFor: 'taskbar' stamp: 'AlainPlantec 12/15/2009 10:31'!
removeFromWorld
	"Delete the receiver from its world after restoring minimized tasks.
	Collapse those that were minimized after removal.
	Turn window animation off for the duration."

	|mins animation|
	mins := self tasks select: [:t | t isMinimized].
	animation := self theme settings animationSettings useAnimation.
	animation ifTrue: [self theme settings animationSettings useAnimation: false].
	[mins do: [:t | t morph restore; resetCollapsedFrame].
	self delete.
	mins do: [:t | t morph minimize]]
		ensure: [animation ifTrue: [self theme settings animationSettings useAnimation: true]]! !

!TaskbarMorph methodsFor: 'initialization' stamp: 'gvc 4/13/2007 13:28'!
intoWorld: aWorld
	"Stick to the bottom left now."
	
	self
		setToAdhereToEdge: #bottomLeft;
		updateBounds.
	super intoWorld: aWorld! !

!TaskbarMorph methodsFor: 'theme' stamp: 'gvc 10/9/2007 11:28'!
themeChanged
	"The theme has changed. Update our appearance."

	self initializeAppearance.
	self removeAllMorphs.
	super themeChanged.
	self updateTaskButtons! !

!TaskbarMorph methodsFor: 'taskbar' stamp: 'MarcusDenker 12/11/2009 07:42'!
indicateModalChildForMorph: aMorph
	"Flash the button corresonding to the given morph ."
	
	(self buttonForMorph: aMorph) ifNotNil: [:b |
		b indicateModalChild]! !

!TaskbarMorph methodsFor: 'taskbar' stamp: 'gvc 4/24/2007 12:59'!
taskButtonOf: aMorph
	"Answer the task button of the given morph or nil if none."

	^self submorphs detect: [:t | t model = aMorph] ifNone: []! !

!TaskbarMorph methodsFor: 'taskbar' stamp: 'gvc 5/20/2009 15:03'!
buttonForMorph: aMorph
	"Answer the button corresonding to the given
	morph or nil if none."
	
	|index|
	index := (self orderedTasks collect: [:t | t morph]) indexOf: aMorph.
	^index = 0 ifTrue: [nil] ifFalse: [self submorphs at: index ifAbsent: []]! !

!TaskbarMorph methodsFor: 'testing' stamp: 'gvc 4/13/2007 13:17'!
isAdheringToLeft
	"Must implement. Answer false."
	
	^false! !

!TaskbarMorph methodsFor: 'accessing' stamp: 'gvc 4/13/2007 13:30'!
wantsToBeTopmost
	"Answer if the receiver want to be one of the topmost
	objects in its owner."
	
	^ true! !

!TaskbarMorph methodsFor: 'event handling' stamp: 'gvc 4/16/2007 16:21'!
handlesMouseDown: evt
	"Best to say we will to avoid being grabbed."
	
	^true! !

!TaskbarMorph methodsFor: 'accessing' stamp: 'gvc 4/13/2007 13:52'!
tasks
	"Answer the value of tasks"

	^ tasks! !

!TaskbarMorph methodsFor: 'setting' stamp: 'AlainPlantec 12/7/2009 09:05'!
showWindowPreview
	^ self class showWindowPreview! !

!TaskbarMorph methodsFor: 'private - layout' stamp: 'GaryChambers 6/20/2011 12:18'!
updateBounds
	"Update the receiver's bounds to fill the world."

	self
		width: self owner width;
		snapToEdgeIfAppropriate! !

!TaskbarMorph methodsFor: 'theme' stamp: 'gvc 1/27/2009 13:48'!
preferredButtonCornerStyle
	"Answer the preferred button corner style
	for submorphs."

	^#square! !

!TaskbarMorph methodsFor: 'initialization' stamp: 'gvc 4/13/2007 14:51'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		initializeLayout;
		initializeAppearance;
		tasks: #();
		orderedTasks: OrderedCollection new! !

!TaskbarMorph methodsFor: 'change reporting' stamp: 'gvc 10/9/2007 10:58'!
ownerChanged
	"The receiver's owner has changed its layout.
	Since this method is called synchronously in the
	ui, delete the receiver if there are any excpetions."
	
	self owner ifNil: [^self].
	[self updateBounds.
	self updateTasks]
		on: Exception
		do: [:ex | self delete. ex pass].
	super ownerChanged! !

!TaskbarMorph methodsFor: 'taskbar' stamp: 'gvc 4/18/2007 12:39'!
worldMorphs
	"Answer the world's submorphs plus those in hand.
	Nasty case since hand removes the morph before dropping"
	
	^self world submorphs, 
		((self tasks
			select: [:t | t morph owner = self world activeHand])
			collect: [:t | t morph])! !

!TaskbarMorph methodsFor: 'accessing' stamp: 'gvc 4/13/2007 13:52'!
orderedTasks
	"Answer the value of orderedTasks"

	^ orderedTasks! !

!TaskbarMorph methodsFor: 'taskbar' stamp: 'GabrielOmarCotelli 11/30/2013 17:05'!
updateTasks
	"Check for changes in the world's submorphs.
	Note that if the task attributes change then a
	task will be considered dead along with a new replacement."
	
	|wm deadTasks newTasks|
	wm := self worldMorphs.
	self tasks: ((wm collect: [:m | m taskbarTask]) select: [:m | m notNil]) asOrderedCollection.
	deadTasks := self orderedTasks difference: self tasks.
	newTasks := self tasks difference: self orderedTasks.
	(newTasks isEmpty and: [deadTasks isEmpty])
		ifTrue: [^self]. "no changes"
	newTasks copy do: [:t |
		self orderedTasks detect: [:ot | ot morph = t morph] ifFound: [:ot |
			self orderedTasks replaceAll: ot with: t.
			deadTasks remove: ot.
			newTasks remove: t]]. "replace in order any changed tasks."
	self orderedTasks
		removeAll: deadTasks;
		addAll: newTasks reversed.
	self updateTaskButtons.
	self defer: [self layoutChanged] "may have a different number of rows"! !

!TaskbarMorph methodsFor: 'accessing' stamp: 'gvc 4/13/2007 13:52'!
orderedTasks: anObject
	"Set the value of orderedTasks"

	orderedTasks := anObject! !

!TaskbarMorph methodsFor: 'testing' stamp: 'gvc 4/13/2007 13:17'!
isAdheringToTop
	"Must implement. Answer false."
	
	^false! !

!TaskbarMorph methodsFor: 'accessing' stamp: 'gvc 4/13/2007 13:52'!
tasks: anObject
	"Set the value of tasks"

	tasks := anObject! !

!TaskbarMorph methodsFor: 'testing' stamp: 'gvc 4/13/2007 13:19'!
isAdheringToBottom
	"Must implement. Answer true."
	
	^true! !

!TaskbarMorph methodsFor: 'private' stamp: 'BenComan 7/24/2014 19:16'!
updateTaskButtons
	"Make buttons for the ordered tasks."
	
	| oldButtons size |
	oldButtons := self submorphs copy.
	self removeAllMorphs.
	self defer: [oldButtons do: [:b | b model: nil]]. "release dependency after event handling"
	
	size := self orderedTasks size.
	(self orderedTasks copyFrom: ( size - self class maximumButtons + 1 max: 1 ) to: size) do: [:t | | button |
		button := t taskbarButtonFor: self.
		button ifNotNil: [self addMorphBack: button]]! !

!TaskbarMorph methodsFor: 'initialization' stamp: 'EstebanLorenzano 5/1/2014 10:51'!
initializeAppearance
	"Initialize the appearance."

	self
		color: (self theme textColor alpha: 0.3);
		fillStyle: (self theme taskbarFillStyleFor: self)! !

!TaskbarMorph methodsFor: 'testing' stamp: 'gvc 4/13/2007 13:13'!
isDockingBar
	"Answer yes so we get updated when the Display is resized."

	^true! !

!TaskbarMorph methodsFor: 'testing' stamp: 'gvc 10/9/2007 10:35'!
isTaskbar
	"Answer true."

	^true! !

!TaskbarMorph methodsFor: 'geometry' stamp: 'gvc 4/16/2007 12:09'!
minimumExtent
	"Answer the minimum extent."

	^40@25! !

!TaskbarMorph methodsFor: 'private - accessing' stamp: 'gvc 4/16/2007 14:44'!
edgeToAdhereTo
	"Must implement. Answer #bottom."
	
	^#bottom! !

!TaskbarMorph methodsFor: 'initialization' stamp: 'gvc 4/13/2007 15:27'!
initializeLayout
	"Initialize the layout."

	self
		changeTableLayout;
		layoutInset: 2;
		cellInset: 2;
		listDirection: #leftToRight;
		wrapDirection: #topToBottom;
		hResizing: #spaceFill;
		vResizing: #shrinkWrap;
		extent: self minimumExtent! !

!TaskbarMorph methodsFor: 'wiw support' stamp: 'gvc 4/13/2007 13:34'!
morphicLayerNumber
	"Helpful for ensuring some morphs always appear in front of or 
	behind others. Smaller numbers are in front"
	
	^11! !

!TaskbarMorph methodsFor: 'taskbar' stamp: 'gvc 4/24/2007 12:58'!
taskOf: aMorph
	"Answer the task of the given morph or nil if none."

	^self orderedTasks detect: [:t | t morph = aMorph] ifNone: []! !

!TaskbarMorph methodsFor: 'testing' stamp: 'gvc 4/13/2007 13:17'!
isAdheringToRight
	"Must implement. Answer false."
	
	^false! !

!TaskbarMorph class methodsFor: 'setting' stamp: 'MarcusDenker 3/23/2011 15:32'!
showTaskbarPreferenceChanged
	"Add or remove the taskbar as appropriate.
	Delegate to the current World."
	
	World showWorldTaskbar:  self showTaskbar! !

!TaskbarMorph class methodsFor: 'setting' stamp: 'AlainPlantec 12/7/2009 08:48'!
showTaskbar: aBoolean
	ShowTaskbar ~= aBoolean
		ifTrue: [ShowTaskbar := aBoolean.
			self showTaskbarPreferenceChanged]! !

!TaskbarMorph class methodsFor: 'initializing' stamp: 'AlainPlantec 12/7/2009 09:28'!
initialize
	"Initialize the receiver."
	self showTaskbarPreferenceChanged! !

!TaskbarMorph class methodsFor: 'setting' stamp: 'StephaneDucasse 11/11/2014 18:50'!
taskbarSettingOn: aBuilder
	<systemsettings>
	(aBuilder setting: #showTaskbar)
		target: self;
		parent: #morphic;
		label: 'Taskbar';
		description: 'Whether the world''s taskbar should be shown or not.';
		with: [
			(aBuilder setting: #showWindowPreview)
				label: 'Window preview' ;
				description: 'Whether the world''s taskbar buttons should show previews of the associated window while the mouse is over them.'.
			(aBuilder setting: #maximumButtons)
				label: 'Maximum number of tasks to show';
				description: ('By default, the value is ', self maximumButtonsDefault printString).

		]! !

!TaskbarMorph class methodsFor: 'setting' stamp: 'AlainPlantec 12/7/2009 08:45'!
showTaskbar
	^ ShowTaskbar ifNil: [ShowTaskbar := true]! !

!TaskbarMorph class methodsFor: 'setting' stamp: 'BenComan 7/24/2014 19:21'!
maximumButtonsDefault
	^100! !

!TaskbarMorph class methodsFor: 'setting' stamp: 'BenComan 7/24/2014 19:04'!
maximumButtons
	^ MaximumButtons ifNil: [MaximumButtons := self maximumButtonsDefault]! !

!TaskbarMorph class methodsFor: 'setting' stamp: 'BenComan 7/24/2014 18:58'!
maximumButtons: anInteger
	(anInteger isKindOf: Integer) ifFalse: [ ^ self ].
	anInteger > 0 ifFalse: [ ^ self ].
	MaximumButtons := anInteger.! !

!TaskbarMorph class methodsFor: 'initializing' stamp: 'MarcusDenker 3/23/2011 15:31'!
reset
	"Remove the taskbar and add a new one." 
	
	(World submorphs select: [:m | m isKindOf: self])
		do: [:tb | tb delete].
	World createTaskbarIfNecessary! !

!TaskbarMorph class methodsFor: 'setting' stamp: 'AlainPlantec 12/7/2009 09:06'!
showWindowPreview: aBoolean
	ShowWindowPreview := aBoolean! !

!TaskbarMorph class methodsFor: 'setting' stamp: 'AlainPlantec 12/7/2009 09:06'!
showWindowPreview
	^ ShowWindowPreview ifNil: [ShowWindowPreview := true]! !

!TaskbarTask commentStamp: 'gvc 5/18/2007 11:20'!
Holds the state of a taskbar/tasklist entry.!
!TaskbarTask methodsFor: 'accessing' stamp: 'gvc 4/18/2007 12:24'!
morph: anObject
	"Set the value of morph"

	morph := anObject! !

!TaskbarTask methodsFor: 'comparing' stamp: 'gvc 12/12/2007 12:01'!
hash
	"Hash is implemented because #= is implemented."
	
	^self morph hash
		bitXor: (self state hash
		bitXor: (self icon hash
		bitXor: self label hash))! !

!TaskbarTask methodsFor: 'accessing' stamp: 'gvc 4/18/2007 12:20'!
state: anObject
	"Set the value of state"

	state := anObject! !

!TaskbarTask methodsFor: 'user-interface' stamp: 'SeanDeNigris 1/23/2014 12:00'!
taskListButtonFor: aTasklist
	"Answer a button for the task."
	
	^self theme
		newTaskListButtonIn: aTasklist
		for: self! !

!TaskbarTask methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
theme
	^ Smalltalk ui theme! !

!TaskbarTask methodsFor: 'accessing' stamp: 'gvc 4/18/2007 12:20'!
icon: anObject
	"Set the value of icon"

	icon := anObject! !

!TaskbarTask methodsFor: 'accessing' stamp: 'gvc 4/18/2007 12:24'!
morph
	"Answer the value of morph"

	^ morph! !

!TaskbarTask methodsFor: 'accessing' stamp: 'gvc 4/18/2007 12:20'!
state
	"Answer the value of state"

	^ state! !

!TaskbarTask methodsFor: 'comparing' stamp: 'gvc 7/24/2007 12:18'!
= aTaskbarTask
	"Answer whether equal."

	^self species = aTaskbarTask species
		and: [self morph == aTaskbarTask morph
		and: [self state == aTaskbarTask state
		and: [self icon = aTaskbarTask icon
		and: [self label = aTaskbarTask label]]]]! !

!TaskbarTask methodsFor: 'testing' stamp: 'gvc 4/20/2007 10:25'!
isMinimized
	"Answer whether the task is minimized."

	^self state == #minimized! !

!TaskbarTask methodsFor: 'accessing' stamp: 'gvc 4/18/2007 12:20'!
label
	"Answer the value of label"

	^ label! !

!TaskbarTask methodsFor: 'user-interface' stamp: 'gvc 4/20/2007 10:21'!
taskbarButtonFor: aTaskBar
	"Answer a button for the task."
	
	^self morph taskbarButtonFor: aTaskBar! !

!TaskbarTask methodsFor: 'user-interface' stamp: 'SeanDeNigris 1/23/2014 11:59'!
buttonClickedForTaskList: aTasklist
	"Notify the tasklist."
	
	aTasklist taskClicked: self! !

!TaskbarTask methodsFor: 'testing' stamp: 'gvc 4/20/2007 10:49'!
isActive
	"Answer whether the task is active."

	^self state == #active! !

!TaskbarTask methodsFor: 'accessing' stamp: 'gvc 4/18/2007 12:20'!
label: anObject
	"Set the value of label"

	label := anObject! !

!TaskbarTask methodsFor: 'activation' stamp: 'gvc 4/23/2007 14:51'!
activate
	"Activate the task."
	
	(self morph respondsTo: #restoreAndActivate)
		ifTrue: [self morph restoreAndActivate]! !

!TaskbarTask methodsFor: 'accessing' stamp: 'gvc 4/18/2007 12:20'!
icon
	"Answer the value of icon"

	^ icon! !

!TaskbarTask class methodsFor: 'as yet unclassified' stamp: 'gvc 4/18/2007 12:26'!
morph: aMorph state: aSymbol icon: aForm label: aString
	"Answer a new instance of the receiver with the given parameters."

	^self new
		morph: aMorph;
		state: aSymbol;
		icon: aForm;
		label: aString! !

!TelnetProtocolClient commentStamp: 'mir 5/12/2003 18:06'!
Abstract super class for protocol clients based on the generic telnet protocol "<response code> <response>"

Structure:
	responseCode	the numerical (integer) value of the last response code
!
!TelnetProtocolClient methodsFor: 'private testing' stamp: 'mir 2/22/2002 17:35'!
responseIsWarning
	^self responseCode between: 400 and: 499! !

!TelnetProtocolClient methodsFor: 'private testing' stamp: 'mir 2/22/2002 17:35'!
responseIsError
	^self responseCode between: 500 and: 599! !

!TelnetProtocolClient methodsFor: 'private protocol' stamp: 'mir 4/7/2003 15:46'!
lookForCode: code
	"We are expecting a certain code next."

	self
		lookForCode: code
		ifDifferent: [:response | (TelnetProtocolError protocolInstance: self) signal: response]
! !

!TelnetProtocolClient methodsFor: 'private testing' stamp: 'mir 11/14/2002 16:18'!
responseIsContinuation: response
	^(response size > 3
		and: [(response at: 4) == $-])! !

!TelnetProtocolClient methodsFor: 'private protocol' stamp: 'nk 2/24/2005 18:21'!
fetchNextResponse
	"The FTP and similar protocols allow multi-line responses.
	If the response is multi-line, the fourth character of the first line is a  
	$- and the last line repeats the numeric code but the code is followed by 
	a space."

	| response result firstLine |
	result := '' writeStream.
	firstLine := self stream nextLine.
	result nextPutAll: firstLine.
	(self responseIsContinuation: firstLine) 
		ifTrue: 
			["continued over multiple lines. Discard continuation lines."

			
			[response := self stream nextLine.
			response ifNil: [^nil].
			response size > 3 and: 
					[(response copyFrom: 1 to: 3) = (firstLine copyFrom: 1 to: 3) 
						and: [(response at: 4) = Character space]]] 
					whileFalse: 
						[result
							cr;
							nextPutAll: response]].
	self lastResponse: result contents! !

!TelnetProtocolClient methodsFor: 'accessing' stamp: 'mir 2/22/2002 17:33'!
responseCode
	^responseCode! !

!TelnetProtocolClient methodsFor: 'private' stamp: 'mir 11/14/2002 18:27'!
lastResponse: aString
	super lastResponse: aString.
	responseCode := self determineResponseCode! !

!TelnetProtocolClient methodsFor: 'private protocol' stamp: 'mir 11/14/2002 16:21'!
lookForCode: code ifDifferent: handleBlock
	"We are expecting a certain code next."

	self fetchNextResponse.

	self responseCode == code
		ifFalse: [handleBlock value: self lastResponse]
! !

!TelnetProtocolClient methodsFor: 'private' stamp: 'mir 2/22/2002 17:34'!
determineResponseCode
	self lastResponse size >= 3
		ifFalse: [^0].
	^[SmallInteger readFromString: (self lastResponse copyFrom: 1 to: 3)]
		on: Error
		do: [:ex | ex return: 0]! !

!TelnetProtocolClient methodsFor: 'private testing' stamp: 'mir 2/22/2002 17:35'!
responseIsContinuation
	^(self lastResponse size > 3
		and: [(self lastResponse at: 4) == $-])! !

!TelnetProtocolClient class methodsFor: 'accessing' stamp: 'mir 2/21/2002 17:21'!
rawResponseCodes
	self subclassResponsibility! !

!TelnetProtocolError commentStamp: 'mir 5/12/2003 18:07'!
Abstract super class for exceptions signalled by clients based on the telnet protocol.
!
!TelnetProtocolError methodsFor: 'accessing' stamp: 'mir 4/7/2003 16:47'!
code
	^self protocolInstance responseCode! !

!TelnetProtocolError methodsFor: 'private' stamp: 'len 12/14/2002 14:15'!
isCommandUnrecognized
	^ self code = 500! !

!TempVariableNode commentStamp: '<historical>'!
I am a parse tree leaf representing a temporary variable!
!TempVariableNode methodsFor: 'testing' stamp: 'eem 9/8/2008 18:22'!
beBlockArg
	argType := #block! !

!TempVariableNode methodsFor: 'code generation' stamp: 'eem 5/20/2008 14:52'!
sizeCodeForStorePop: encoder
	remoteNode ~~ nil ifTrue:
		[^remoteNode sizeCodeForStorePopInto: self encoder: encoder].
	self reserve: encoder.
	^encoder sizeStorePopTemp: index! !

!TempVariableNode methodsFor: 'code generation (closures)' stamp: 'eem 7/20/2009 14:27'!
isDefinedWithinBlockExtent: anInterval
	^anInterval rangeIncludes: definingScope actualScope blockExtent first! !

!TempVariableNode methodsFor: 'code generation (closures)' stamp: 'eem 8/3/2009 18:55'!
addWriteWithin: scopeBlock "<BlockNode>" at: location "<Integer>"
	writingScopes ifNil: [writingScopes := Dictionary new].
	(writingScopes at: scopeBlock ifAbsentPut: [Set new]) add: location.
	remoteNode ifNotNil:
		[remoteNode addReadWithin: scopeBlock at: location]! !

!TempVariableNode methodsFor: 'code generation (closures)' stamp: 'eem 5/20/2008 10:56'!
analyseTempsWithin: scopeBlock "<BlockNode>" rootNode: rootNode "<MethodNode>" assignmentPools: assignmentPools "<Dictionary>"
	self addReadWithin: scopeBlock at: rootNode locationCounter! !

!TempVariableNode methodsFor: 'testing' stamp: ''!
isUnusedTemp
	^ hasRefs not! !

!TempVariableNode methodsFor: 'code generation' stamp: 'eem 5/20/2008 14:51'!
sizeCodeForValue: encoder
	remoteNode ~~ nil ifTrue:
		[^remoteNode sizeCodeForValueOf: self encoder: encoder].
	self reserve: encoder.
	^encoder sizePushTemp: index! !

!TempVariableNode methodsFor: 'code generation' stamp: 'jmv 3/2/2010 16:39'!
sizeCodeForLoad: encoder
	^remoteNode
		ifNil: [0]
		ifNotNil: [remoteNode sizeCodeForLoadFor: self encoder: encoder]! !

!TempVariableNode methodsFor: 'code generation' stamp: 'eem 5/20/2008 16:22'!
emitCodeForLoad: stack encoder: encoder
	remoteNode ~~ nil ifTrue:
		[remoteNode emitCodeForLoadFor: self stack: stack encoder: encoder]! !

!TempVariableNode methodsFor: 'code generation (closures)' stamp: 'eem 5/20/2008 18:07'!
isReferencedWithinBlockExtent: anInterval 
	readingScopes ~~ nil ifTrue:
		[readingScopes do:
			[:set "<Set of <Integer>>"|
			set do:
				[:location|
				 (anInterval rangeIncludes: location) ifTrue:
					[^true]]]].
	writingScopes ~~ nil ifTrue:
		[writingScopes do:
			[:set "<Set of <Integer>>"|
			set do:
				[:location|
				 (anInterval rangeIncludes: location) ifTrue:
					[^true]]]].
	^false! !

!TempVariableNode methodsFor: 'testing' stamp: 'eem 5/29/2008 15:51'!
remoteNode
	^remoteNode! !

!TempVariableNode methodsFor: 'code generation (closures)' stamp: 'eem 7/24/2009 15:07'!
analyseClosure: rootNode "<MethodNode>"
	"Analyse whether the temporary needs to be made remote
	 or not, and answer whether it was made remote.
	 A temp cannot be local if it is written to remotely,
	 or if it is written to after it is closed-over.  An exception
	 is an inlined block argument that appears to be written
	 remotely but is actually local to a block."
	| latestWrite |
	self isBlockArg ifTrue: [^false].
	remoteNode ifNotNil: [^false]. "If already remote, don't remote a second time"
	latestWrite := 0.
	((writingScopes notNil
	 and: [writingScopes associations anySatisfy: [:assoc|
			[:blockScope :refs|
			refs do: [:write| latestWrite := write max: latestWrite].
			"A temp cannot be local if it is written to remotely."
			blockScope actualScope ~~ definingScope actualScope]
				value: assoc key value: assoc value]])
	or: [readingScopes notNil
		and: [readingScopes associations anySatisfy: [:assoc|
				[:blockScope :refs|
				 "A temp cannot be local if it is written to after it is closed-over."
				 blockScope actualScope ~~ definingScope actualScope
				 and: [refs anySatisfy: [:read| read < latestWrite]]]
					value: assoc key value: assoc value]]]) ifTrue:
		[remoteNode := definingScope addRemoteTemp: self rootNode: rootNode.
		 ^true].
	^false! !

!TempVariableNode methodsFor: 'visiting' stamp: 'eem 9/6/2009 12:34'!
accept: aVisitor
	^aVisitor visitTempVariableNode: self! !

!TempVariableNode methodsFor: 'testing' stamp: ''!
isTemp
	^ true! !

!TempVariableNode methodsFor: 'code generation' stamp: 'eem 5/20/2008 14:52'!
sizeCodeForStore: encoder
	remoteNode ~~ nil ifTrue:
		[^remoteNode sizeCodeForStoreInto: self encoder: encoder].
	self reserve: encoder.
	^encoder sizeStoreTemp: index! !

!TempVariableNode methodsFor: 'code generation (closures)' stamp: 'StephaneDucasse 8/20/2011 08:45'!
definingScope: scopeBlock 
	"<BlockNode>"
	definingScope ifNotNil: [self error: 'temp has more than one defining scope.  This is probably a parser error'].
	definingScope := scopeBlock! !

!TempVariableNode methodsFor: 'testing' stamp: 'MarcusDenker 4/23/2013 10:03'!
assignmentCheck: encoder at: location
	^(self isBlockArg or: [self isMethodArg])
			ifTrue: [location]
			ifFalse: [-1]! !

!TempVariableNode methodsFor: 'code generation (closures)' stamp: 'eem 6/2/2008 16:50'!
isIndirectTempVector
	^false! !

!TempVariableNode methodsFor: 'testing' stamp: 'eem 5/30/2008 12:31'!
scope
	"Answer scope of temporary variables.
	 Currently only the following distinctions are made:
		 0	outer level: args and user-declared temps
		 1	block args and doLimiT temps
		-1	a block temp that is no longer active
		-2	a block temp that held limit of to:do:"
	^scope! !

!TempVariableNode methodsFor: 'testing' stamp: ''!
isUndefTemp
	^ hasDefs not! !

!TempVariableNode methodsFor: 'decompiler' stamp: 'eem 9/25/2008 09:45'!
remoteNode: aRemoteTempVectorNode
	remoteNode := aRemoteTempVectorNode! !

!TempVariableNode methodsFor: 'code generation (closures)' stamp: 'eem 8/3/2009 18:54'!
addReadWithin: scopeBlock "<BlockNode>" at: location "<Integer>"
	readingScopes ifNil: [readingScopes := Dictionary new].
	(readingScopes at: scopeBlock ifAbsentPut: [Set new]) add: location.
	remoteNode ifNotNil:
		[remoteNode addReadWithin: scopeBlock at: location]! !

!TempVariableNode methodsFor: 'code generation' stamp: 'eem 5/20/2008 14:53'!
emitCodeForStore: stack encoder: encoder
	remoteNode ~~ nil ifTrue:
		[^remoteNode emitCodeForStoreInto: self stack: stack encoder: encoder].
	encoder genStoreTemp: index! !

!TempVariableNode methodsFor: 'testing' stamp: 'eem 9/8/2008 18:20'!
isMethodArg
	^#method == argType! !

!TempVariableNode methodsFor: 'code generation (closures)' stamp: 'eem 7/20/2009 16:33'!
definingScope
	^definingScope! !

!TempVariableNode methodsFor: 'initialize-release' stamp: 'eem 9/8/2008 18:27'!
name: varName index: i type: type scope: level
	"Only used for initting temporary variables"
	hasDefs := hasRefs := false.
	scope := level.
	^super name: varName key: varName index: i type: type! !

!TempVariableNode methodsFor: 'testing' stamp: 'eem 9/8/2008 18:24'!
isArg
	^argType notNil! !

!TempVariableNode methodsFor: 'code generation' stamp: 'eem 5/20/2008 14:54'!
emitCodeForStorePop: stack encoder: encoder
	remoteNode ~~ nil ifTrue:
		[^remoteNode emitCodeForStorePopInto: self stack: stack encoder: encoder].
	encoder genStorePopTemp: index.
	stack pop: 1! !

!TempVariableNode methodsFor: 'initialize-release' stamp: ''!
nowHasDef
	hasDefs := true! !

!TempVariableNode methodsFor: 'code generation' stamp: 'eem 5/20/2008 14:53'!
emitCodeForValue: stack encoder: encoder
	remoteNode ~~ nil ifTrue:
		[^remoteNode emitCodeForValueOf: self stack: stack encoder: encoder].
	encoder genPushTemp: index.
	stack push: 1! !

!TempVariableNode methodsFor: 'testing' stamp: 'eem 9/8/2008 18:21'!
beMethodArg
	argType := #method! !

!TempVariableNode methodsFor: 'initialize-release' stamp: ''!
scope: level
	"Note scope of temporary variables.
	Currently only the following distinctions are made:
		0	outer level: args and user-declared temps
		1	block args and doLimiT temps
		-1	a block temp that is no longer active
		-2	a block temp that held limit of to:do:"
	scope := level! !

!TempVariableNode methodsFor: 'initialize-release' stamp: ''!
nowHasRef
	hasRefs := true! !

!TempVariableNode methodsFor: 'testing' stamp: 'eem 5/29/2008 15:51'!
isRemote
	^remoteNode notNil! !

!TempVariableNode methodsFor: 'code generation (closures)' stamp: 'eem 8/4/2009 13:26'!
index: anInteger
	"For renumbering temps in the closure compiler."
	index := anInteger.
	code := self code: index type: LdTempType! !

!TempVariableNode methodsFor: 'testing' stamp: 'eem 8/14/2010 11:02'!
isDeclaredAtMethodLevel
	"For the explainer."
	^scope = 0! !

!TempVariableNode methodsFor: 'testing' stamp: 'eem 9/8/2008 18:20'!
isBlockArg
	^#block == argType! !

!TempVariableNode methodsFor: 'code generation (closures)' stamp: 'eem 5/20/2008 18:01'!
referenceScopesAndIndicesDo: aBinaryBlock
	"Evaluate aBinaryBlock with all read or write scopes and locations.
	 This is used to copy the reference information into RemoteTempVectorNodes"
	readingScopes ~~ nil ifTrue:
		[readingScopes keysAndValuesDo:
			[:scopeBlock "<BlockNode>" :set "<Set of <Integer>>"|
			set do: [:location| aBinaryBlock value: scopeBlock value: location]]].
	writingScopes ~~ nil ifTrue:
		[writingScopes keysAndValuesDo:
			[:scopeBlock "<BlockNode>" :set "<Set of <Integer>>"|
			set do: [:location| aBinaryBlock value: scopeBlock value: location]]]! !

!TempVariableNode methodsFor: 'code generation (closures)' stamp: 'eem 7/24/2009 11:46'!
beingAssignedToAnalyseTempsWithin: scopeBlock "<BlockNode>" rootNode: rootNode "<MethodNode>" assignmentPools: assignmentPools "<Dictionary>"
	self addWriteWithin: scopeBlock at: rootNode locationCounter.
	"For analysis of optimized blocks also record the set of temporaries written to
	 within optimized blocks so that additional writes can be added at locations that
	 represent subsequent iterations of the loop. e.g. testInlineBlockCollectionSD1"
	assignmentPools keysAndValuesDo:
		[:outerScopeBlock :set|
		"definingScope can be nil in expr in expr ifNil: [:arg|...] expressions because
		 arg gets its definingScope set when [:arg|...] is analysed."
		outerScopeBlock actualScope
			= (definingScope
				ifNil: [scopeBlock]
				ifNotNil: [definingScope actualScope]) ifTrue:
			[set add: self]]! !

!Termcap commentStamp: '<historical>'!
I provide a simple mapping from high-level commands to low-level terminal character sequences.
!
!Termcap methodsFor: 'initialization' stamp: 'CamilloBruni 10/19/2012 14:45'!
initialize
	cache := Dictionary new.
	self initializeDefaultSequences.! !

!Termcap methodsFor: 'initialize-release' stamp: 'dfgs 7/8/2012 14:01'!
flush
	cache removeAll! !

!Termcap methodsFor: 'accessing' stamp: 'CamilloBruni 10/19/2012 12:42'!
getnum: aString
	"^ (PipeableOSProcess command: 'tput ', aString) output asInteger"
	^ Error signal: 'Cannot interact with the terminal yet'.! !

!Termcap methodsFor: 'initialize-release' stamp: 'CamilloBruni 10/19/2012 14:50'!
initializeDefaultSequences
	"Until we have decent OSProcess support we precache the most common sequences"
	| esc |
	esc := (Character escape asString), '['.
	cache at: #up put: (esc, 'A').
	cache at: #le put: (esc, 'D').
	cache at: #nd put: (esc, 'C').
	cache at: #im put: ''.
	cache at: #ei put: ''.
	cache at: #mr put: (esc, '7m').
	cache at: #me put: (esc, '0m').
	cache at: #ce put: (esc, 'K').
	cache at: #al put: (esc, 'L').
	cache at: #dl put: (esc, 'M').
	cache at: #cr put: (esc, String cr).! !

!Termcap methodsFor: 'initialize-release' stamp: 'CamilloBruni 10/19/2012 12:45'!
reset
	self flag: 'TODO implement once we have OSProcess'.
	"self getent: (OSProcess thisOSProcess environmentAt: #TERM)"! !

!Termcap methodsFor: 'accessing' stamp: 'CamilloBruni 10/19/2012 12:43'!
getflag: aString
	"^ (PipeableOSProcess command: 'tput ', aString) output"
	Error signal: 'Cannot interact with tput yet'! !

!Termcap methodsFor: 'accessing' stamp: 'CamilloBruni 10/19/2012 12:42'!
getstr: aString
	^ cache
		at: aString 
		ifAbsentPut: [ 
			"(PipeableOSProcess command: 'tput ', aString) output"
			^ Error signal: 'Terminal capability ', aString, ' not found' ]! !

!Termcap methodsFor: 'accessing' stamp: 'MarcusDenker 9/30/2013 22:50'!
getent: aString
	"The tgetent routine loads the entry for name. 
	It returns 1 on success, 
	0 if there is no such entry,
	 and -1 if the terminfo database could not be found."
	
	"result := (PipeableOSProcess command: 'tput ', aString) output asInteger.
	result = 1 ifTrue: [ ^ self ].
	result = 0 ifTrue: [ Error signal: 'No such tget entry: ', aString aString ].
	result = -1 ifTrue: [ Error signal: 'Could not find terminfo database' ]."
	
	Error signal: 'Cannot interact with tput yet'.
	! !

!TestAnnouncement commentStamp: 'TorstenBergmann 2/12/2014 23:12'!
Notify about testing a test!
!TestAnnouncement methodsFor: 'accessing' stamp: ''!
test
	^test! !

!TestAnnouncement methodsFor: 'accessing' stamp: 'SantiagoBragagnolo 4/30/2012 14:27'!
test: aTest
	test := aTest! !

!TestAnnouncement class methodsFor: 'instance creation' stamp: 'GuillermoPolito 4/30/2012 20:46'!
with: aTestCase
	^self new
		test: aTestCase;
		yourself! !

!TestAsserter commentStamp: '<historical>'!
I understand methods beginning #assert:... and #deny:... (and my class-side understands #assert:description:).  I am the superclass of TestCase and TestResource and can also be the superclass of any test helper classes you create to factor out test behaviour.  I exist so that test code can be refactored between my subclasses without difficulty.

Send #assert:description: when you want to check for an expected value. For example, you might say
	self assert: socket isOpen description: 'We requested a socket but now it is not open'.
to test whether or not a socket is open at a point in a test.  Use description strings both to give more information about where a test failed in debugger notifiers and logs, and to document the intent of a test.  Other methods include #assert:, #assert:description:resumable:, #deny:, #deny:description:, #deny:description:resumable:, #should:raise:, #should:raise:description:, #shouldnt:raise:, #shouldnt:raise:description:.  All these methods are defined on the superclass, TestAsserter.  (Any convenience assertion methods you create for general use should also be defined in my 'convenience' protocol.)

Override my class-side #isLogging in subclasses to have failed assertion descriptions shown on the Transcript.  To have them appear elsewhere, also override my class-side #failureLog.
!
!TestAsserter methodsFor: 'asserting' stamp: ''!
shouldnt: aBlock
	self deny: aBlock value
			! !

!TestAsserter methodsFor: 'factory' stamp: 'StephaneDucasse 6/9/2012 23:04'!
classForTestSuite
	"Returns the class of the test suite"
	
	"note that we did not name this method testSuiteClass because it is considered by tools as a test method. it could be suiteClass"
	^ self class classForTestSuite! !

!TestAsserter methodsFor: 'asserting' stamp: ''!
shouldnt: aBlock raise: anExceptionalEvent description: aString  
 
	^self
		assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) not
		description: aString
			! !

!TestAsserter methodsFor: 'factory' stamp: 'StephaneDucasse 6/9/2012 22:53'!
defaultTestError

	^ self classForTestResult error! !

!TestAsserter methodsFor: 'asserting' stamp: ''!
deny: aBooleanOrBlock

	self assert: aBooleanOrBlock value not
			! !

!TestAsserter methodsFor: 'asserting' stamp: 'CamilloBruni 8/24/2012 17:07'!
assert: aBooleanOrBlock description: aStringOrBlock resumable: resumableBoolean 
	| exception |
	aBooleanOrBlock value
		ifFalse: 
			[|aString|
			aString := aStringOrBlock value.
			self logFailure: aString.
			exception := resumableBoolean
						ifTrue: [self classForTestResult resumableFailure]
						ifFalse: [self classForTestResult failure].
			exception signal: aString]
			! !

!TestAsserter methodsFor: 'asserting' stamp: ''!
deny: aBooleanOrBlock description: aString
	self assert: aBooleanOrBlock value not description: aString
			! !

!TestAsserter methodsFor: 'extensions' stamp: ''!
skip: aComment
	"Don't run this test, and don't mark it as failure"
	TestSkip signal: aComment! !

!TestAsserter methodsFor: 'factory' stamp: 'StephaneDucasse 6/9/2012 22:53'!
defaultTestFailure

	^ self classForTestResult failure! !

!TestAsserter methodsFor: 'private' stamp: ''!
comparingStringBetween: actual and: expected

	^ String streamContents: [:stream |
			stream
				nextPutAll: 'Got ';
				nextPutAll: actual fullPrintString;
				nextPutAll: ' instead of ';
				nextPutAll: expected fullPrintString;
				nextPutAll: '.']! !

!TestAsserter methodsFor: 'asserting' stamp: ''!
executeShould: aBlock inScopeOf: anExceptionalEvent 
	^[aBlock value.
 	false] on: anExceptionalEvent
		do: [:ex | ex return: true]
			! !

!TestAsserter methodsFor: 'asserting' stamp: 'CamilloBruni 8/24/2012 17:08'!
assert: aBooleanOrBlock description: aStringOrBlock
	aBooleanOrBlock value ifFalse: [
		| aString |
		aString := aStringOrBlock value.
		self logFailure: aString.
		self classForTestResult failure signal: aString]
			! !

!TestAsserter methodsFor: 'asserting' stamp: ''!
should: aBlock raise: anExceptionalEvent whoseDescriptionDoesNotInclude: subString description: aString 
	^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionNotContaining: subString)
		description: aString
! !

!TestAsserter methodsFor: 'asserting' stamp: ''!
should: aBlock raise: anException withExceptionDo: anotherBlock 

	^self assert: (self executeShould: aBlock inScopeOf: anException withExceptionDo: anotherBlock)! !

!TestAsserter methodsFor: 'asserting' stamp: ''!
should: aBlock
	self assert: aBlock value
			! !

!TestAsserter methodsFor: 'asserting' stamp: ''!
should: aBlock raise: anExceptionalEvent 
	^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent)
			! !

!TestAsserter methodsFor: 'asserting' stamp: ''!
shouldnt: aBlock raise: anExceptionalEvent whoseDescriptionDoesNotInclude: subString description: aString 
	 
	^self
		assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionNotContaining: subString) not
		description: aString
! !

!TestAsserter methodsFor: 'asserting' stamp: ''!
shouldnt: aBlock raise: anExceptionalEvent whoseDescriptionIncludes: subString description: aString  
	 
	^self 
		assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionContaining: subString) not
		description: aString
! !

!TestAsserter methodsFor: 'asserting' stamp: ''!
signalFailure: aString
	self classForTestResult failure signal: aString! !

!TestAsserter methodsFor: 'asserting' stamp: ''!
should: aBlock raise: anExceptionalEvent description: aString 
	^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent)
		description: aString
			! !

!TestAsserter methodsFor: 'asserting' stamp: ''!
shouldnt: aBlock description: aString
	self deny: aBlock value description: aString
			! !

!TestAsserter methodsFor: 'asserting' stamp: 'StephaneDucasse 6/9/2012 22:59'!
assert: aBoolean
	aBoolean ifFalse:
		[self logFailure: 'Assertion failed'.
		self defaultTestFailure signal: 'Assertion failed'].! !

!TestAsserter methodsFor: 'asserting' stamp: ''!
should: aBlock description: aString
	self assert: aBlock value description: aString
			! !

!TestAsserter methodsFor: 'asserting' stamp: ''!
assert: actual equals: expected
	^ self
		assert: expected = actual
		description: [self comparingStringBetween: actual and: expected]! !

!TestAsserter methodsFor: 'asserting' stamp: ''!
executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionNotContaining: aString
	^[aBlock value.
 	false] on: anExceptionalEvent
		do: [:ex | ex return: (ex description includesSubstring: aString) not ]
			! !

!TestAsserter methodsFor: 'asserting' stamp: ''!
shouldFix: aBlock 
	"Run the block expecting an Exception. Throw an assertion failure if the block does NOT throw an exception."
	^self should: aBlock raise: Exception! !

!TestAsserter methodsFor: 'asserting' stamp: ''!
executeShould: aBlock inScopeOf: anException withExceptionDo: anotherBlock

	^[aBlock value.
 	false] 
		on: anException
		do: [:exception | 
			anotherBlock value: exception.
			exception return: true]! !

!TestAsserter methodsFor: 'asserting' stamp: ''!
shouldnt: aBlock raise: anExceptionalEvent  
	 
	^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) not
			! !

!TestAsserter methodsFor: 'asserting' stamp: ''!
skip
	"Don't run this test, and don't mark it as failure"
	TestSkip signal! !

!TestAsserter methodsFor: 'private' stamp: 'ChristopheDemarey 3/27/2015 13:31'!
comparingCollectionBetween: left and: right
	| additionalLeft additionalRight sortBlock|
	
	"use a very slow sort block"
	sortBlock := [ :a :b | a asString <= b asString ].
	additionalLeft := (left difference: right) sorted: sortBlock.
	additionalRight := (right difference: left) sorted: sortBlock. 
	
	^ String streamContents: [:stream |
		stream
			nextPutAll: 'Given Collections do not match. Got '; lf;
			tab; nextPutAll: 'left := '; print: left; nextPut: $.; lf;
			nextPutAll: ' instead of ';
			tab; nextPutAll: ' right :='; print: right; nextPut: $.; lf.
		left size = right size
			ifFalse: [ 
				stream 
					nextPutAll: 'Collection size does not match: left='; 
					print: left size;
					nextPutAll: ' vs. right=';
					print: right size; lf ].
		additionalLeft isEmpty
			ifFalse: [ 
				stream 
					nextPutAll: 'Got ';
					print: additionalLeft size;
					nextPutAll: ' additional element(s) in the left collection: ';
					tab; print: additionalLeft  ].
		additionalRight isEmpty
			ifFalse: [ 
				stream 
					nextPutAll: 'Got ';
					print: additionalRight size;
					nextPutAll: ' additional element(s) in the right collection: ';
					tab; print: additionalRight  ]]! !

!TestAsserter methodsFor: 'logging' stamp: 'BaseSystem 8/30/2009 09:35'!
logFailure: aString
	self class logFailure: aString.! !

!TestAsserter methodsFor: 'factory' stamp: 'StephaneDucasse 6/9/2012 23:12'!
classForTestResource
	^ TestResource! !

!TestAsserter methodsFor: 'factory' stamp: 'StephaneDucasse 6/9/2012 22:42'!
classForTestResult
	"Returns the class of the test result"
	
	"note that we did not name this method testResultClass because it is considered by tools as a test method."
	^ self class classForTestResult! !

!TestAsserter methodsFor: 'asserting' stamp: ''!
should: aBlock notTakeMoreThan: aDuration
    "Evaluate aBlock and if it takes more than given duration
    to run we report a test failure. "

	^ aBlock valueWithin: aDuration onTimeout: [
		self 
			assert: false 
			description: ['Block evaluation took more than the expected <1p>' expandMacrosWith: aDuration]
	]
	
! !

!TestAsserter methodsFor: 'asserting' stamp: ''!
deny: aBooleanOrBlock description: aString resumable: resumableBoolean 
	self
		assert: aBooleanOrBlock value not
		description: aString
		resumable: resumableBoolean
			! !

!TestAsserter methodsFor: 'asserting' stamp: ''!
assertCollection: actual hasSameElements: expected
	"Assert that a collection contains the same elements as the given collection. Order is not checked, only the presence/absence of elements."
	| missingElements additionalElements |
	
	additionalElements := actual difference: expected.
	missingElements := expected difference: (actual intersection: expected).
	self 
		assert: (additionalElements isEmpty and: [ missingElements isEmpty ])
		description: (String streamContents: 
			[:stream |
			stream
				nextPutAll: 'Given Collections do not match!!'; lf;
				tab; nextPutAll: 'additions : '; print: additionalElements asArray; lf;
				tab; nextPutAll: 'missing: '; print: missingElements asArray; lf ])! !

!TestAsserter methodsFor: 'asserting' stamp: ''!
assertCollection: actual equals: expected
	"Specialized test method that generates a proper error message for collection"
	^ self
		assert: expected = actual
		description: [ self comparingCollectionBetween: actual and: expected ]! !

!TestAsserter methodsFor: 'asserting' stamp: ''!
should: aBlock raise: anExceptionalEvent whoseDescriptionIncludes: subString description: aString 
	^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionContaining: subString)
		description: aString
! !

!TestAsserter methodsFor: 'asserting' stamp: ''!
fail

	^self assert: false! !

!TestAsserter methodsFor: 'asserting' stamp: ''!
should: aBlock notTakeMoreThanMilliseconds: anInteger
    "For compatibility with other Smalltalks"

   self should: aBlock notTakeMoreThan: (Duration milliSeconds: anInteger).! !

!TestAsserter methodsFor: 'asserting' stamp: ''!
fail: aDescriptionString

	^self assert: false description: aDescriptionString! !

!TestAsserter class methodsFor: 'factory' stamp: 'StephaneDucasse 6/9/2012 22:37'!
methodPassed: aSelector

	^ false! !

!TestAsserter class methodsFor: 'logging' stamp: 'NiallRoss 7/18/2010 11:48'!
failureLog
	^Transcript! !

!TestAsserter class methodsFor: 'asserting' stamp: 'StephaneDucasse 6/9/2012 22:43'!
assert: aBoolean description: aString
	"Minimal clone of the instance-side assert protocol so that class-side methods can use it."

	aBoolean ifFalse:
		[self logFailure: aString.
		self classForTestResult failure signal: aString].! !

!TestAsserter class methodsFor: 'factory' stamp: 'StephaneDucasse 6/9/2012 23:03'!
classForTestSuite
	^ TestSuite! !

!TestAsserter class methodsFor: 'logging' stamp: 'BaseSystem 8/30/2009 09:35'!
logFailure: aString
	self isLogging ifTrue:
		[self failureLog cr; nextPutAll: aString; flush].! !

!TestAsserter class methodsFor: 'asserting' stamp: 'StephaneDucasse 6/9/2012 22:41'!
classForTestResult
	"Returns the class of the test result"
	^ TestResult! !

!TestAsserter class methodsFor: 'factory' stamp: 'StephaneDucasse 6/9/2012 23:07'!
suiteClass
	^TestSuite! !

!TestAsserter class methodsFor: 'logging' stamp: 'BaseSystem 8/30/2009 09:35'!
isLogging
	"By default, we're not logging failures. Override in subclasses as desired."

	^false! !

!TestAutoFractionComputation commentStamp: '<historical>'!
I am a widget used to verify that the mechanism used to compute rows and columns are still working.!
!TestAutoFractionComputation methodsFor: 'as yet unclassified' stamp: 'BenjaminVanRyseghem 9/25/2013 18:24'!
initializeWidgets

	self instantiateModels: #(
		button ButtonModel
		list #ListModel 
		text TextModel ).! !

!TestAutoFractionComputation methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/16/2013 13:27'!
list
	^ list! !

!TestAutoFractionComputation methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/16/2013 13:27'!
button
	^ button! !

!TestAutoFractionComputation methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/16/2013 13:27'!
text
	^ text! !

!TestAutoFractionComputation class methodsFor: 'as yet unclassified' stamp: 'BenjaminVanRyseghem 7/16/2013 14:04'!
defaultSpec
	<spec>
	
	^ SpecLayout composed
		newRow: [ :r |
			r 
				add: #list left: 0.8;
				newColumn: [ :c |
					c 
						add: #button bottom: 0.7;
						add: #text top: 0.3 ] right: 0.2 ];
		yourself! !

!TestCase commentStamp: 'nfr 1/3/2010 17:56'!
A TestCase is an implementation of the Command pattern to run a test.  TestCase instances are created with the class method #selector:, passing the symbol that names the method to be executed when the test case runs.  Various UIs exist to run these instances and they can also be created and run programmatically.

When you discover a new fixture, subclass TestCase and create a #test... method for the first test.  As that method develops and more #test... methods are added, you will find yourself refactoring temps into instance variables for the objects in the fixture and overriding #setUp to initialize these variables.  As required, override #tearDown to nil references, release objects and deallocate.

See my superclass' comment for assertion and logging information.!
!TestCase methodsFor: 'running' stamp: 'HernanWilkinson 9/30/2010 14:00'!
prepareToRunAgain 	

	"Used by the debugger when a test is restarted
	I'm not 'hidding'' possible exceptions because I think it is best to popup a new debugger
	if some one occurs and let the programmer decide what to do - Hernan"
	self 
		tearDown;
		setUp! !

!TestCase methodsFor: 'accessing' stamp: 'BaseSystem 8/30/2009 09:35'!
selector
	^testSelector! !

!TestCase methodsFor: 'running' stamp: 'BaseSystem 8/30/2009 09:35'!
openDebuggerOnFailingTestMethod
	"SUnit has halted one step in front of the failing test method. Step over the 'self halt' and 
	 send into 'self perform: testSelector' to see the failure from the beginning"

	self
		halt;
		performTest! !

!TestCase methodsFor: 'running' stamp: 'jannik.laval 10/1/2010 12:39'!
runCase
	self resources do: [:each | each availableFor: self].
	[self setUp.
	self performTest] ensure: [
		self tearDown.
		self cleanUpInstanceVariables]! !

!TestCase methodsFor: 'testing' stamp: 'MarcusDenker 8/1/2011 10:57'!
expectedFailures
	| pragmas |
	^ expectedFails ifNil: [
		
		pragmas := Pragma allNamed: #expectedFailure from: self class to: TestCase.
		expectedFails := pragmas collect: [:each | each method selector  ].
	]	
! !

!TestCase methodsFor: 'running' stamp: ''!
isLogging
	"By default, we're not logging failures. If you override this in 
	a subclass, make sure that you override #failureLog"
	^false
			! !

!TestCase methodsFor: 'events' stamp: 'Alexandre Bergel 8/2/2010 11:57'!
announce: anAnnouncementClass
	^ self announce: anAnnouncementClass with: nil! !

!TestCase methodsFor: 'running' stamp: 'BaseSystem 8/30/2009 09:35'!
run: aResult
	aResult runCase: self! !

!TestCase methodsFor: 'printing' stamp: 'NicolaiHess 11/30/2014 14:27'!
printTestSelectorDefiningClass: aClass on: aStream
	aStream << '('.
	aClass printOn: aStream.
	aStream << ')'! !

!TestCase methodsFor: 'private' stamp: 'BaseSystem 8/30/2009 09:35'!
setTestSelector: aSymbol
	testSelector := aSymbol! !

!TestCase methodsFor: 'printing' stamp: 'NicolaiHess 11/30/2014 14:27'!
printOn: aStream
	aStream nextPutAll: self class printString.
	self printTestSelectorOn: aStream! !

!TestCase methodsFor: 'printing' stamp: 'NicolaiHess 11/30/2014 14:28'!
printTestSelectorOn: aStream
	testSelector
		ifNotNil: [ 
			| class |
			class := self class whichClassIncludesSelector: testSelector.
			class ~= self class
				ifTrue: [ self printTestSelectorDefiningClass: class on: aStream ].
			aStream
				nextPutAll: '>>#';
				nextPutAll: testSelector ]! !

!TestCase methodsFor: '*SUnit-UITesting' stamp: 'SeanDeNigris 11/22/2011 18:58'!
simulateKeyStroke: aCharacterOrShortcut

	ActiveHand simulateKeyStroke: aCharacterOrShortcut.! !

!TestCase methodsFor: 'running' stamp: 'NiallRoss 7/18/2010 11:53'!
runCaseAsFailure: aSemaphore
	[self resources do: [:each | each availableFor: self].
	[self setUp.
	self openDebuggerOnFailingTestMethod] ensure: [self tearDown]]
		ensure: [aSemaphore signal]! !

!TestCase methodsFor: 'running' stamp: 'md 2/22/2006 14:17'!
failureLog	
	^Transcript

			! !

!TestCase methodsFor: 'events' stamp: 'Alexandre Bergel 7/29/2010 14:48'!
announcer
	^ self class announcer! !

!TestCase methodsFor: 'private' stamp: 'NiallRoss 7/18/2010 12:59'!
performTest
	self perform: testSelector asSymbol! !

!TestCase methodsFor: 'accessing' stamp: 'BaseSystem 8/30/2009 09:35'!
resources
	"We give TestCase this instance-side method so that methods polymorphic with TestSuite can be code-identical.  Having this instance-side method also helps when writing tests of resource behaviour. Except for such tests, it is rare to override this method and should not be done without thought.  If there were a good reason why a single test case needed to share tests requiring different resources, it might be legitimate."

	^self class resources! !

!TestCase methodsFor: 'dependencies' stamp: 'BaseSystem 8/30/2009 09:35'!
addDependentToHierachy: anObject 
	"an empty method. for Composite compability with TestSuite"! !

!TestCase methodsFor: 'running' stamp: 'jannik.laval 10/1/2010 12:39'!
tearDown

	! !

!TestCase methodsFor: 'running' stamp: ''!
logFailure: aString
	self isLogging ifTrue: [
		self failureLog 
			cr; 
			nextPutAll: aString; 
			flush]
			! !

!TestCase methodsFor: 'events' stamp: 'tbn 4/26/2011 09:58'!
announce: anAnnouncementClass withResult: result
	| event |
	self shouldAnnounce ifFalse: [ ^ self ].
	
	event := anAnnouncementClass asAnnouncement.
	event testCase: self.
	event testSelector: testSelector.
	event testResult: result.
	self announcer announce: event.! !

!TestCase methodsFor: 'running' stamp: 'StephaneDucasse 6/9/2012 23:11'!
run
	| result |
	result := self classForTestResult new.
	[ self run: result ]
		ensure: [ self classForTestResource resetResources: self resources ].
	^ result! !

!TestCase methodsFor: 'private' stamp: 'EstebanLorenzano 8/17/2012 16:40'!
executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionContaining: aString
	^[aBlock value.
 	false] on: anExceptionalEvent
		do: [:ex | ex return: (ex description includesSubstring: aString) ]
			! !

!TestCase methodsFor: 'running' stamp: 'DavidRoethlisberger 11/10/2008 09:54'!
setUp! !

!TestCase methodsFor: 'dependencies' stamp: 'BaseSystem 8/30/2009 09:35'!
removeDependentFromHierachy: anObject 
	"an empty method. for Composite compability with TestSuite"! !

!TestCase methodsFor: '*SUnit-UITesting' stamp: 'SeanDeNigris 11/22/2011 18:19'!
simulateKeyStrokes: aString 

	ActiveHand simulateKeyStrokes: aString.! !

!TestCase methodsFor: 'testing' stamp: 'MarcusDenker 2/15/2013 16:28'!
shouldPass
	^self isExpectedFailure not! !

!TestCase methodsFor: 'running' stamp: 'StephaneDucasse 6/9/2012 23:11'!
debug
	[ (self class selector: testSelector) runCase ]
		ensure: [ self classForTestResource resetResources: self resources ]! !

!TestCase methodsFor: 'testing' stamp: 'MarcusDenker 2/15/2013 16:28'!
isExpectedFailure
	^self expectedFailures includes: testSelector! !

!TestCase methodsFor: 'running' stamp: 'StephaneDucasse 6/9/2012 23:11'!
debugAsFailure
	| semaphore |
	semaphore := Semaphore new.
	[ 
	semaphore wait.
	self classForTestResource resetResources: self resources ] fork.
	(self class selector: testSelector) runCaseAsFailure: semaphore! !

!TestCase methodsFor: 'private' stamp: 'AdrianLienhard 10/19/2009 12:07'!
cleanUpInstanceVariables
	self class allInstVarNames do: [ :name |
		name = 'testSelector' ifFalse: [
			self instVarNamed: name put: nil ] ]! !

!TestCase methodsFor: 'events' stamp: 'Alexandre Bergel 7/29/2010 14:47'!
shouldAnnounce
	^ self class shouldAnnounce! !

!TestCase class methodsFor: 'accessing' stamp: 'NiallRoss 7/18/2010 11:38'!
testSelectors
	^(self selectors select: [ :each | (each beginsWith: 'test') and: [each numArgs isZero]])! !

!TestCase class methodsFor: 'events' stamp: 'Alexandre Bergel 7/29/2010 14:36'!
resetAnnouncer
	self announcers removeKey: self ifAbsent: []! !

!TestCase class methodsFor: 'testing' stamp: 'AlexandreBergel 10/21/2008 16:00'!
methodRaisedError: aSelector
	^ (self lastRun at: #errors) includes: aSelector! !

!TestCase class methodsFor: 'building suites' stamp: ''!
buildSuiteFromAllSelectors

	^self buildSuiteFromMethods: self allTestSelectors
			! !

!TestCase class methodsFor: 'accessing' stamp: ' 17/7/10 17:28'!
lookupHierarchyRoot
	^TestCase! !

!TestCase class methodsFor: 'building suites' stamp: 'BaseSystem 8/30/2009 09:35'!
buildSuiteFromMethods: testMethods

	^testMethods
		inject: (self suiteClass named: self name asString)
		into: [:suite :selector |
			suite
				addTest: (self selector: selector);
				yourself]! !

!TestCase class methodsFor: 'history' stamp: 'simon.denier 11/13/2008 19:22'!
generateLastStoredRunMethod

	self shouldGenerateLastStoredRunMethod ifTrue: [
		self class
			compile: (self lastRunMethodNamed: #lastStoredRun)
			classified: 'history' ]! !

!TestCase class methodsFor: 'testing' stamp: 'JorgeRessia 3/16/2010 20:06'!
isUnitTest
	^true! !

!TestCase class methodsFor: 'testing' stamp: 'vincentBlondeau 12/12/2014 13:57'!
isTestCase
	^ true! !

!TestCase class methodsFor: 'testing' stamp: 'AlexandreBergel 10/21/2008 15:59'!
storedMethodRaisedError: aSelector
	^ (self lastStoredRun at: #errors) includes: aSelector! !

!TestCase class methodsFor: 'building suites' stamp: ''!
buildSuiteFromLocalSelectors

	^self buildSuiteFromMethods: self testSelectors
			! !

!TestCase class methodsFor: 'testing' stamp: 'Alexandre.Bergel 4/3/2009 15:06'!
hasMethodBeenRun: aSelector
	^ ((self lastRun at: #errors),
		(self lastRun at: #failures),
		(self lastRun at: #passed))
			includes: aSelector! !

!TestCase class methodsFor: 'history' stamp: 'StephaneDucasse 6/9/2012 22:43'!
lastRun
	^ self classForTestResult historyFor: self! !

!TestCase class methodsFor: 'initialize - event' stamp: 'EstebanLorenzano 10/29/2014 11:38'!
initialize
	super initialize.
	SystemAnnouncer uniqueInstance unsubscribe: self.
	SystemAnnouncer uniqueInstance weak
		when: MethodAdded, MethodModified, MethodRemoved 
		send: #methodChanged: 
		to: self.! !

!TestCase class methodsFor: 'coverage' stamp: 'sd 1/28/2009 14:57'!
coverageForClass: cls
	"returns the test coverage of all the methods included inherited ones"
	^ self coverageForClass: cls until: ProtoObject! !

!TestCase class methodsFor: 'building suites' stamp: 'BaseSystem 8/30/2009 09:35'!
buildSuite
	| suite |
	^self isAbstract
		ifTrue: 
			[suite := self suiteClass named: self name asString.
			self allSubclasses 
				do: [:each | each isAbstract ifFalse: [suite addTest: each buildSuiteFromSelectors]].
			suite]
		ifFalse: [self buildSuiteFromSelectors]! !

!TestCase class methodsFor: 'coverage' stamp: 'lr 3/14/2010 21:13'!
localCoverage
	"returns the coverage determined by a simple static analysis of test coverage 
	made by the receiver on a class that is identified by the name of the receiver.
	We assume that SetTest test Set. The computation of the coverage takes only into
	account the methods defined locally in the tested class. See coverage for a more global 
	coverage"

	| cls className |
	(self name endsWith: 'Test')
		ifFalse: [ self error: 'Please, use #localCoverageForClass: instead' ].
	className := self name copyFrom: 1 to: self name size - 'Test' size.
	cls := Smalltalk globals at: className asSymbol ifAbsent: [ self error: 'Please, use #localCoverageForClass: instead' ].
	cls isBehavior
		ifFalse: [ cls := cls class ].
	^ self localCoverageForClass: cls! !

!TestCase class methodsFor: 'instance creation' stamp: 'BaseSystem 8/30/2009 09:35'!
debug: aSymbol

	^(self selector: aSymbol) debug! !

!TestCase class methodsFor: 'accessing' stamp: 'NicolaiHess 9/30/2014 21:46'!
historyAnnouncer
	^ HistoryAnnouncer ifNil: [  HistoryAnnouncer := Announcer new ]! !

!TestCase class methodsFor: 'accessing' stamp: 'BaseSystem 8/30/2009 09:35'!
resources

	^#()! !

!TestCase class methodsFor: 'history' stamp: 'AlexandreBergel 10/22/2008 10:33'!
lastStoredRun
	^ ((Dictionary new) add: (#failures->#()); add: (#passed->#()); add: (#errors->#()); yourself)! !

!TestCase class methodsFor: 'coverage' stamp: 'sd 1/28/2009 15:04'!
localCoverageAsString
	| cov className |
	cov := self localCoverage first asInteger. 
	"coverage already checks that the name is ends with 'Test' and if the class tested exists"
	
	className := self name copyFrom: 1 to: (self name size - 'Test' size).
	^ self name asString, ' covers ', cov asString, '% of ', className.! !

!TestCase class methodsFor: 'coverage' stamp: 'MarcusDenker 5/10/2013 00:26'!
coverageForClass: cls until: aRootClass
	"returns the test coverage of all the methods included inherited ones but stopping at aRootClass included"
	
	| definedMethods testedMethods untestedMethods |
	definedMethods := cls allSelectorsAboveUntil: aRootClass.
	definedMethods size = 0
		ifTrue: [^ {0. Set new}].
	testedMethods := 
		self methods inject: Set new into: 
							[:sums :cm | sums union: cm messages].
	testedMethods := testedMethods reject: [:sel | (definedMethods includes: sel) not].
	untestedMethods := definedMethods select: [:selector | (testedMethods includes: selector) not].
	^ { (testedMethods size * 100 / definedMethods size) asFloat . untestedMethods}
! !

!TestCase class methodsFor: 'instance creation' stamp: 'BaseSystem 8/30/2009 09:35'!
selector: aSymbol

	^self new setTestSelector: aSymbol! !

!TestCase class methodsFor: 'history' stamp: 'NicolaiHess 9/30/2014 21:47'!
history: aDictionary

	history := aDictionary.
	self historyAnnouncer announce: (TestSuiteEnded result: self)! !

!TestCase class methodsFor: 'building suites' stamp: 'nk 4/21/2002 16:37'!
addToSuiteFromSelectors: suite
	^self addToSuite: suite fromMethods: (self shouldInheritSelectors
		ifTrue: [ self allTestSelectors ]
		ifFalse: [self testSelectors ])! !

!TestCase class methodsFor: 'testing' stamp: 'AlexandreBergel 10/21/2008 16:00'!
methodProgressed: aSelector
	^ ((self storedMethodRaisedError: aSelector) or: [self storedMethodFailed: aSelector])
		and: [self methodPassed: aSelector]
		! !

!TestCase class methodsFor: '*NautilusCommon' stamp: 'MarcusDenker 10/19/2012 09:55'!
correspondingClass

	(self name endsWith: 'Test' ) ifFalse: [^nil].
	^Smalltalk globals 
		at: (self name allButLast: 4) asSymbol
		ifAbsent: [nil]! !

!TestCase class methodsFor: 'events' stamp: 'Alexandre Bergel 7/29/2010 14:48'!
shouldAnnounce
	^ self announcers includesKey: self! !

!TestCase class methodsFor: 'accessing' stamp: ' 17/7/10 17:28'!
sunitVersion
	^'4.0'! !

!TestCase class methodsFor: 'history' stamp: 'simon.denier 11/13/2008 19:21'!
lastRunMethodNamed: aSelector
	
	^ String streamContents: [:str |
		str nextPutAll: aSelector asString ;cr.
		str tab; nextPutAll: '^ ', (self lastRun) storeString]
! !

!TestCase class methodsFor: 'accessing' stamp: ' 17/7/10 17:28'!
allTestSelectors
	| answer pivotClass lookupRoot |
	answer := Set withAll: self testSelectors.
	self shouldInheritSelectors
		ifTrue:
			[pivotClass := self.
			lookupRoot := self lookupHierarchyRoot.
			[pivotClass == lookupRoot]
				whileFalse:
					[pivotClass := pivotClass superclass.
					answer addAll: pivotClass testSelectors]].
	^answer asSortedCollection asOrderedCollection! !

!TestCase class methodsFor: 'coverage' stamp: 'MarcusDenker 5/10/2013 00:26'!
localCoverageForClass: cls
	
	| definedMethods testedMethods untestedMethods |
	definedMethods := cls selectors.
	"It happens for IdentityBag / IdentityBagTest"
	definedMethods size = 0
		ifTrue: [^ {0. Set new}].

	testedMethods := 
		self methods inject: Set new into: 
							[:sums :cm | sums union: cm messages].
					
	"testedMethods contains all the methods send in test methods, which probably contains methods that have nothign to do with collection"
	testedMethods := testedMethods reject: [:sel | (definedMethods includes: sel) not].

	untestedMethods := definedMethods select: [:selector | (testedMethods includes: selector) not].

	^ { (testedMethods size * 100 / definedMethods size) asFloat . untestedMethods}
! !

!TestCase class methodsFor: 'testing' stamp: ' 17/7/10 17:28'!
shouldInheritSelectors
	"I should inherit from an Abstract superclass but not from a concrete one by default, unless I have no testSelectors in which case I must be expecting to inherit them from my superclass.  If a test case with selectors wants to inherit selectors from a concrete superclass, override this to true in that subclass."
	
	^self ~~ self lookupHierarchyRoot
		and: [self superclass isAbstract or: [self testSelectors isEmpty]]! !

!TestCase class methodsFor: 'testing' stamp: 'AlexandreBergel 10/21/2008 15:58'!
methodFailed: aSelector
	^ (self lastRun at: #failures) includes: aSelector! !

!TestCase class methodsFor: 'instance creation' stamp: 'BaseSystem 8/30/2009 09:35'!
run: aSymbol

	^(self selector: aSymbol) run! !

!TestCase class methodsFor: 'history' stamp: 'Alexandre.Bergel 4/3/2009 14:57'!
history
	^ history ifNil: [ history := self newTestDictionary ]! !

!TestCase class methodsFor: 'events' stamp: 'jannik.laval 10/1/2010 17:20'!
announcers
	^ Announcers ifNil: [ Announcers := Dictionary new ] ! !

!TestCase class methodsFor: 'testing' stamp: 'AlexandreBergel 10/21/2008 16:00'!
storedMethodPassed: aSelector
	^ (self lastStoredRun at: #passed) includes: aSelector! !

!TestCase class methodsFor: 'history' stamp: 'StephaneDucasse 7/7/2010 18:41'!
newTestDictionary

	^ Dictionary new at: #timeStamp put: DateAndTime now;
		at: #passed put: Set new;
		at: #failures put: Set new;
		at: #errors put: Set new;
		yourself
		! !

!TestCase class methodsFor: 'coverage' stamp: 'ab 12/25/2008 17:15'!
coveragePercentage
	^ self coverage first! !

!TestCase class methodsFor: '*NautilusCommon' stamp: 'BenjaminVanRyseghem 8/21/2011 11:25'!
hasErrorTest

	^ (self history at: #errors) isEmpty not ! !

!TestCase class methodsFor: 'testing' stamp: 'AlexandreBergel 10/21/2008 16:00'!
methodPassed: aSelector
	^ (self lastRun at: #passed) includes: aSelector! !

!TestCase class methodsFor: 'events' stamp: 'Alexandre Bergel 7/29/2010 14:37'!
announcer 
	^ self announcers at: self ifAbsentPut: [ Announcer new ]! !

!TestCase class methodsFor: 'coverage' stamp: 'lr 3/14/2010 21:13'!
coverage
	"returns the coverage determined by a simple static analysis of test coverage 
	made by the receiver on a class that is identified by the name of the receiver.
	We assume that SetTest test Set."

	| cls className |
	(self name endsWith: 'Test')
		ifFalse: [ self error: 'Please, use #coverageForClass: instead' ].
	className := self name copyFrom: 1 to: self name size - 'Test' size.
	cls := Smalltalk globals at: className asSymbol ifAbsent: [ self error: 'Please, use #coverageForClass: instead' ].	"May happen with Transcript"
	cls isBehavior
		ifFalse: [ cls := cls class ].
	^ self coverageForClass: cls! !

!TestCase class methodsFor: 'testing' stamp: 'md 2/22/2006 14:21'!
isAbstract
	"Override to true if a TestCase subclass is Abstract and should not have
	TestCase instances built from it"

	^self name = #TestCase
			! !

!TestCase class methodsFor: 'instance creation' stamp: 'BaseSystem 8/30/2009 09:35'!
suite

	^self buildSuite! !

!TestCase class methodsFor: 'history' stamp: 'MarcusDenker 5/10/2013 00:26'!
shouldGenerateLastStoredRunMethod
	| sameRun |
	
	(self class includesSelector: #lastStoredRun)
		ifFalse: [^ true].
	sameRun := #(#passed #failures #errors) inject: true into: 
		[ :ok :set | ok and: [(self lastRun at: set) = (self lastStoredRun at: set) ]].
	^ sameRun not
! !

!TestCase class methodsFor: 'testing' stamp: 'AlexandreBergel 10/21/2008 16:00'!
methodRegressed: aSelector
	^ (self storedMethodPassed: aSelector) and: [(self methodFailed: aSelector) or: [self methodRaisedError: aSelector]]! !

!TestCase class methodsFor: 'building suites' stamp: 'nk 4/21/2002 10:51'!
addToSuite: suite fromMethods: testMethods 
	testMethods do:  [ :selector | 
			suite addTest: (self selector: selector) ].
	^suite! !

!TestCase class methodsFor: '*NautilusCommon' stamp: 'BenjaminVanRyseghem 8/21/2011 11:24'!
hasFailedTest

	^ (self history at: #failures) isEmpty not ! !

!TestCase class methodsFor: 'history' stamp: 'Alexandre.Bergel 4/3/2009 14:47'!
resetHistory
	history := nil! !

!TestCase class methodsFor: 'coverage' stamp: 'sd 1/28/2009 14:55'!
localCoveragePercentage
	^ self localCoverage first! !

!TestCase class methodsFor: 'building suites' stamp: 'lr 3/14/2010 21:13'!
addTestsFor: classNameString toSuite: suite
	| cls |
	cls := Smalltalk globals at: classNameString ifAbsent: [ ^ suite ].
	^ cls isAbstract
		ifTrue: [ 
			cls allSubclasses
				do: [ :each | 
					each isAbstract
						ifFalse: [ each addToSuiteFromSelectors: suite ] ].
			suite ]
		ifFalse: [ cls addToSuiteFromSelectors: suite ]! !

!TestCase class methodsFor: 'testing' stamp: 'AlexandreBergel 10/21/2008 15:59'!
storedMethodFailed: aSelector
	^ (self lastStoredRun at: #failures) includes: aSelector! !

!TestCase class methodsFor: 'initialize - event' stamp: 'MarianoMartinezPeck 8/24/2012 18:21'!
methodChanged: anEvent
	"Remove the changed method from the known test results."
	
	| cls sel |
	cls := anEvent methodClass.
	(cls inheritsFrom: TestCase)
		ifFalse: [^ self].
	sel := anEvent selector.
	(sel beginsWith: 'test')
		ifFalse: [^ self].
	self classForTestResult removeFromTestHistory: sel in: cls.
! !

!TestCase class methodsFor: 'building suites' stamp: ' 17/7/10 17:28'!
buildSuiteFromSelectors
	^self buildSuiteFromMethods: self allTestSelectors! !

!TestCase class methodsFor: 'coverage' stamp: 'ab 12/25/2008 17:20'!
coverageAsString
	| cov className |
	cov := self coverage first asInteger. 
	"coverage already checks that the name is ends with 'Test' and if the class tested exists"
	
	className := self name copyFrom: 1 to: (self name size - 'Test' size).
	^ self name asString, ' covers ', cov asString, '% of ', className.! !

!TestCase class methodsFor: '*NautilusCommon' stamp: 'BenjaminVanRyseghem 8/21/2011 11:24'!
hasPassedTest

	^ (self history at: #passed) isEmpty not ! !

!TestCaseAnnouncement commentStamp: 'tbn 4/26/2011 09:54'!
This is a common superclass for announcements related to SUnit test cases.

Instance Variables
        testCase:                       <TestCase>
        testResult:                     <TestResult>
        testSelector:           	   <Symbol>

testCase
        - The test case

testResult
        - The result of the test case

testSelector
        - The selector of the test method!
!TestCaseAnnouncement methodsFor: 'accessing' stamp: 'tbn 4/26/2011 09:56'!
testResult: aTestResult
        "Sets the test result to the given test result."
        
        testResult := aTestResult! !

!TestCaseAnnouncement methodsFor: 'accessing' stamp: 'tbn 4/26/2011 09:56'!
testSelector
        "Returns the test selector."
        
        ^testSelector! !

!TestCaseAnnouncement methodsFor: 'accessing' stamp: 'tbn 4/26/2011 09:57'!
testSelector: aSymbol
        "Sets the test selector to the given symbol."
        
        testSelector := aSymbol! !

!TestCaseAnnouncement methodsFor: 'accessing' stamp: 'tbn 4/26/2011 09:56'!
testResult
        "Returns the test result."
        
        ^testResult! !

!TestCaseAnnouncement methodsFor: 'testing' stamp: 'tbn 4/26/2011 09:58'!
hasPassed
        "Return true if the test has passed."
        
        ^testResult hasPassed! !

!TestCaseAnnouncement methodsFor: 'testing' stamp: 'tbn 4/26/2011 09:57'!
hasErrors
        "Return true if the test result has errors."
        
        ^testResult hasErrors! !

!TestCaseAnnouncement methodsFor: 'testing' stamp: 'tbn 4/26/2011 09:57'!
hasFailures
        "Return true if the test result has failures."
        
        ^testResult hasFailures! !

!TestCaseAnnouncement methodsFor: 'accessing' stamp: 'tbn 4/26/2011 09:56'!
testCase
        "Returns the test case."
        
        ^testCase! !

!TestCaseAnnouncement methodsFor: 'accessing' stamp: 'tbn 4/26/2011 09:56'!
testCase: aTestCase
        "Sets the test case to the given test case."
        
        testCase := aTestCase! !

!TestCaseEnded commentStamp: 'tbn 4/26/2011 09:55'!
This event is announced when testing a test case ends.!
!TestCaseStarted commentStamp: 'tbn 4/26/2011 09:55'!
This event is announced when testing a test case starts.!
!TestCaseTest commentStamp: 'TorstenBergmann 2/12/2014 23:14'!
SUnit test for TestCase class!
!TestCaseTest methodsFor: 'events' stamp: 'BernardoContreras 11/5/2014 17:23'!
testAnnouncement
	| collection oldCollection suite unitTest |
	unitTest := ClassFactoryForTestCaseTest.
	collection := OrderedCollection new.
	unitTest resetAnnouncer.
	
	self deny: (unitTest shouldAnnounce).
	self deny: (unitTest new shouldAnnounce).
		
	unitTest announcer when: TestCaseAnnouncement do: [:ann | collection add: ann ].

	self assert: (unitTest shouldAnnounce).
	self assert: (unitTest new shouldAnnounce).

	"We run SUnitTest"
	suite := unitTest buildSuite.
	suite run.

	self assert: (collection size = (suite tests size * 2)).
	self assert: (collection select: [:c | c isKindOf: TestCaseStarted]) size = (collection size / 2).
	self assert: (collection select: [:c | c isKindOf: TestCaseEnded]) size =( collection size / 2).
	self assert: (collection allSatisfy: #hasPassed).
	self deny: (collection anySatisfy: #hasFailures).
	
	oldCollection := collection copy.
	unitTest resetAnnouncer.
	unitTest debug: #testClassCreationInDifferentCategories.
	self assert: (collection = oldCollection)! !

!TestCaseTest methodsFor: 'testing' stamp: 'MarcusDenker 9/30/2012 09:54'!
testAssertEqualsActualAndExpectedOrder
	self 
		should: [
			self assert: 'actual' equals: 'expected with fairly long print string'
		]
		raise: TestFailure 
		whoseDescriptionIncludes: 'Got ''actual'' instead of ''expected with fairly long print string''.' 
		description: 'In #assert:equals: the first argument is the actual value and the second one is the expected.'.! !

!TestCaseTest methodsFor: 'testing' stamp: 'JorgeRessia 3/16/2010 20:57'!
testIsUnitTest

	self assert: TestCase isUnitTest! !

!TestCommandLineHandler commentStamp: '<historical>'!
Usage: test [--junit-xml-output] [<package> ...]
	--junit-xml-output    output the test results in a junit compatible format
	<package>             a String matching a package name
	
Examples:
	#Run all the tests in the Tests-Exceptions package
	pharo Pharo.image test Tests-Exceptions
	
	#Run all the tests in packages matching Test-.* and KernelTests
	pharo Pharo.image test "Tests-.*" "KernelTests-.*"
	
	# Run test on a Hudson/Jenkins server
	pharo Pharo.image test --junit-xml-output "Tests-.*" "KernelTests-.*"
	!
!TestCommandLineHandler methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 10/18/2012 13:16'!
addPackagesMatchingRegex: aRegex to: aSet
	RPackage organizer packageNames do: [ :packageName|
		(aRegex matches: packageName)
			ifTrue: [ aSet add: packageName ]]! !

!TestCommandLineHandler methodsFor: 'as yet unclassified' stamp: 'EstebanLorenzano 1/24/2013 17:35'!
addPackagesMatching: aString to: aSet
	| regex |
	
	[ regex := aString asRegex ] 
		on: Error do: [ ].
	regex ifNotNil: [ ^ self addPackagesMatchingRegex: regex to: aSet ].
	
	(aString includes: $*)
		ifTrue: [ ^ self addPackagesMatchingGlob: aString to: aSet ].
	
	"exact match, and just those who actually have classes inside (to avoid 
	 super-package duplications)"
	((RPackage organizer includesPackageNamed: aString) 
		and: [ (RPackage organizer packageNamed: aString) definedClasses notEmpty ])
		ifTrue: [ aSet add: aString ]! !

!TestCommandLineHandler methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 10/22/2012 23:29'!
testRunner
	^ (self hasOption: 'junit-xml-output')
		ifTrue: [ HDTestReport ]
		ifFalse: [ CommandLineTestRunner ]! !

!TestCommandLineHandler methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 1/18/2013 15:46'!
runPackages
	| packages |
	packages := self packages.
	self inform: 'Running tests in ', packages size asString, ' Packages'.
	self testRunner runPackages: self packages.
	(self hasOption: 'save') ifTrue: [Smalltalk saveSession].
	self exitSuccess.! !

!TestCommandLineHandler methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 10/18/2012 13:18'!
addPackagesMatchingGlob: aGlobString to: aSet
	RPackage organizer packageNames do: [ :packageName|
		(aGlobString match: packageName)
			ifTrue: [ aSet add: packageName ]]! !

!TestCommandLineHandler methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 10/18/2012 13:10'!
packages
	| packages |
	packages := Set new.
	self arguments 
		reject: [ :arg| arg beginsWith: '-']
		thenDo: [ :arg| self addPackagesMatching: arg to: packages ].
	^ packages! !

!TestCommandLineHandler methodsFor: 'activation' stamp: 'CamilloBruni 3/22/2013 21:44'!
activate
	self activateHelp
		ifTrue: [  ^ self ].
	self runPackages.! !

!TestCommandLineHandler class methodsFor: 'accessing' stamp: 'CamilloBruni 10/18/2012 12:52'!
description
	^ 'A command line test runner'! !

!TestCommandLineHandler class methodsFor: 'accessing' stamp: 'CamilloBruni 10/18/2012 12:52'!
commandName
	^ 'test'! !

!TestCoverage commentStamp: 'LaurentLaffont 4/15/2011 20:19'!
I wrap a method in order to detect whether it has been called or not. Then I can be used to calculate test coverage for SUnit.!
!TestCoverage methodsFor: 'testing' stamp: 'lr 3/30/2009 15:09'!
hasRun
	^ hasRun! !

!TestCoverage methodsFor: 'private' stamp: 'lr 3/30/2009 20:26'!
doesNotUnderstand: aMessage
	^ method perform: aMessage selector withArguments: aMessage arguments! !

!TestCoverage methodsFor: 'actions' stamp: 'MarcusDenker 5/10/2013 00:27'!
install
	reference actualClass methodDict
		at: reference selector
		put: self! !

!TestCoverage methodsFor: 'private' stamp: 'lr 3/30/2009 15:27'!
reference
	^ reference! !

!TestCoverage methodsFor: 'private' stamp: 'StephaneDucasse 8/9/2011 17:51'!
flushCache
	self reference selector flushCache! !

!TestCoverage methodsFor: 'evaluation' stamp: 'lr 3/30/2009 15:32'!
run: aSelector with: anArray in: aReceiver
	self mark; uninstall.
	^ aReceiver withArgs: anArray executeMethod: method! !

!TestCoverage methodsFor: 'private' stamp: 'lr 3/30/2009 15:21'!
mark
	hasRun := true! !

!TestCoverage methodsFor: 'initialization' stamp: 'lr 3/30/2009 15:19'!
initializeOn: aMethodReference
	hasRun := false.
	reference := aMethodReference.
	method := reference compiledMethod! !

!TestCoverage methodsFor: 'actions' stamp: 'MarcusDenker 5/10/2013 00:27'!
uninstall
	reference actualClass methodDict
		at: reference selector
		put: method! !

!TestCoverage class methodsFor: 'instance creation' stamp: 'lr 3/30/2009 15:23'!
on: aMethodReference
	^ self new initializeOn: aMethodReference! !

!TestDynamicVariable commentStamp: 'mvl 3/13/2007 13:51'!
TestDynamicVariable is a test class using in ProcessSpecificTest.

!
!TestFailure commentStamp: '<historical>'!
The test framework distinguishes between failures and errors.  A failure is an event whose possibiity is explicitly anticipated and checked for in an assertion, whereas an error is an unanticipated problem like a division by 0 or an index out of bounds.  TestFailure is raised when the boolean parameter of an assert: ... or deny: ... call is the opposite of what the assertion claims.!
!TestFailure methodsFor: 'camp smalltalk' stamp: 'ajh 2/1/2003 00:58'!
isResumable
	
	^ false! !

!TestFailure methodsFor: 'camp smalltalk' stamp: ' 17/7/10 17:28'!
sunitAnnounce: aTestCase toResult: aTestResult
	aTestResult addFailure: aTestCase.
	self sunitExitWith: false! !

!TestFailure methodsFor: 'camp smalltalk' stamp: 'ajh 1/24/2003 19:23'!
defaultAction

	Processor activeProcess
		debug: self signalerContext
		title: self description! !

!TestInWorldMorph commentStamp: 'sd 6/5/2005 10:25'!
Helper class for MorphTest!
!TestInWorldMorph methodsFor: 'accessing' stamp: 'ar 8/4/2003 00:03'!
intoWorld: aWorld
	aWorld ifNil:[^self].
	super intoWorld: aWorld.
	intoWorldCount := intoWorldCount + 1.
! !

!TestInWorldMorph methodsFor: 'accessing' stamp: 'ar 8/4/2003 00:06'!
outOfWorldCount
	^outOfWorldCount! !

!TestInWorldMorph methodsFor: 'initialization' stamp: 'ar 8/4/2003 00:06'!
initialize
	super initialize.
	outOfWorldCount := intoWorldCount := 0.! !

!TestInWorldMorph methodsFor: 'accessing' stamp: 'ar 8/4/2003 00:06'!
intoWorldCount
	^intoWorldCount! !

!TestInWorldMorph methodsFor: 'accessing' stamp: 'ar 8/4/2003 00:03'!
outOfWorld: aWorld
	aWorld ifNil:[^self].
	super outOfWorld: aWorld.
	outOfWorldCount := outOfWorldCount + 1.
! !

!TestLocalVariable commentStamp: 'mvl 3/13/2007 13:52'!
TestLocalVariable is a test class using in ProcessSpecificTest.!
!TestLocalVariable methodsFor: 'defaults' stamp: 'IgorStasenko 11/2/2011 19:04'!
default
	"My default value for a new process is 0."
	
	^0! !

!TestObjectsAsMethods methodsFor: 'testing' stamp: 'MarcusDenker 5/11/2011 13:42'!
testAnswer42 

	self assert: self answer42 = 42! !

!TestObjectsAsMethods methodsFor: 'testing' stamp: 'MarcusDenker 5/11/2011 13:42'!
testDNU 

	self should: [self foo] raise: MessageNotUnderstood! !

!TestObjectsAsMethods methodsFor: 'testing' stamp: 'MarcusDenker 5/11/2011 13:42'!
testAddNumbers

	self assert: (self add: 3 with: 4) = 7.
	self assert: (self perform: #add:with: withArguments: #(3 4)) = 7.! !

!TestObjectsAsMethods methodsFor: 'running' stamp: 'EstebanLorenzano 8/3/2012 15:29'!
tearDown
	SystemAnnouncer uniqueInstance suspendAllWhile: [
		self class removeSelector: #add:with:.
		self class removeSelector: #answer42.
		self class removeSelector: #foo ]! !

!TestObjectsAsMethods methodsFor: 'running' stamp: 'EstebanLorenzano 8/3/2012 15:29'!
setUp
	SystemAnnouncer uniqueInstance suspendAllWhile: [
		self class addSelector: #add:with: withMethod: ObjectsAsMethodsExample new.
		self class addSelector: #answer42 withMethod: ObjectsAsMethodsExample new.
		self class addSelector: #foo withMethod: AbstractObjectsAsMethod new ]! !

!TestRPackagePrequisites commentStamp: 'TorstenBergmann 2/12/2014 23:01'!
SUnit tests for RPackage prerequisites!
!TestRPackagePrequisites methodsFor: 'tests' stamp: 'StephanEggermont 12/9/2013 19:58'!
testNoPackagesOverride
"Class side packages should not be overridden"
	self assert: (Object allSubclasses select: [: each | (each class compiledMethodAt: #packages ifAbsent: [nil]) isNotNil]) isEmpty.
! !

!TestResource commentStamp: '<historical>'!
Normally a test will set up all the objects it needs and tear them down again after it has run.  This self-containedness makes a test more robust.  Use TestResources only for objects that are needed by several tests and that are too 'expensive' (in time or otherwise) to recreate and destroy for each test.  A viable approach is to develop the code in MyTestCase's #setUp and #tearDown methods, then at some point refactor the code into the #setUp and #tearDown of a TestResource whose class is added to MyTestCase class>>resource method.

TestResource uses the singleton pattern.  A TestResource class will set up a single instance of itself when first requested and tear it down again at the end of TestSuite>>run (or TestCase>>run, >>debug and >>debugAsFailure).  Normally, a TestResource, once setUp, remains active during the running of all remaining tests and is #reset after all tests have run.  For an exception, see subclass CompetingResource in SUnitResourcePatterns.  Users can choose to #reset a resource in the #tearDown of a test that alters it, sacrificing the performance gain of having a single #setUp of the resource for the certainty that other tests using it will not see the alterations.  Generally however, this should be the exception:  if you need to reset the resource for every test that uses it, its code should just be part of your test's #setUp and #tearDown code.

To use, create a subclass of TestResource and override the following:
	- TestCase class>>resources, to return a collection including the TestResource class, for all test case classes that need it
		* a TestCase' resources are set up in the order returned and torn down in the reverse order
	- TestResource class>>resources, if the resource itself always needs some other resource to be present before it can set up
		* a TestResource's resource are set up before it and torn down after it, and are set up in the order returned and torn down in the reverse order
	- TestResource>>setUp and tearDown, to define initial and final behaviour (just like a test)
	- TestResource>>isAvailable, to return true if it is and false if it isn't (the framework calls this after setUp);  ideally, this call should not change the resource' state - that should be done in setUp

TestResource implements the singleton pattern in its class-side #isAvailable and #reset methods.  Do not override these when creating specific resources;  unless you are developing a whole new pattern of use, it will always be correct to override instance-side #setUp, #tearDown and #isAvailable, and dangerous to override class>>isAvailable, class>>isAlreadyAvailable and class>>reset.

Generally, users do not code interactions with a test's resources during the running of a test.  Code that reads a resource' values while leaving its state strictly alone is safe enough.  A test must leave a resource in a clean state:  always use #reset if a test must protect later-running tests from unsafe changes (and review whether in such a case a resource is the right thing to use in the first place).

See my superclass' comment for assertion and logging information.
!
!TestResource methodsFor: 'testing' stamp: 'StephaneDucasse 12/28/2014 12:11'!
isUnavailable
	"override to provide information on the readiness of the resource"
	
	^self isAvailable not
			! !

!TestResource methodsFor: 'accessing' stamp: 'StephaneDucasse 12/28/2014 12:10'!
description
	description isNil
		ifTrue: [ ^ '' ].
	^ description! !

!TestResource methodsFor: 'accessing' stamp: 'BaseSystem 8/30/2009 09:35'!
resources
	^self class resources! !

!TestResource methodsFor: 'accessing' stamp: 'StephaneDucasse 12/28/2014 12:11'!
name: aString
	name := aString! !

!TestResource methodsFor: 'running' stamp: 'BaseSystem 8/30/2009 09:35'!
tearDown
	"Does nothing. Subclasses should override this to tear down their resource"! !

!TestResource methodsFor: 'testing' stamp: 'BaseSystem 8/30/2009 09:35'!
isAvailable
	"Override to provide information on the readiness of the resource.  Put state-changing behaviour in setUp and keep this a state-preserving check as far as possible.  Where setUp is guaranteed to provide a valid resource if it completes, there is no need to override this."
	
	^true! !

!TestResource methodsFor: 'accessing' stamp: 'BaseSystem 8/30/2009 09:35'!
description: aString

	description := aString! !

!TestResource methodsFor: 'printing' stamp: 'BaseSystem 8/30/2009 09:35'!
printOn: aStream

	aStream nextPutAll: self class printString! !

!TestResource methodsFor: 'accessing' stamp: 'StephaneDucasse 12/28/2014 12:10'!
name
	name ifNil: [ ^ self printString ].
	^ name! !

!TestResource methodsFor: 'running' stamp: 'BaseSystem 8/30/2009 09:35'!
setUp
	"Does nothing. Subclasses should override this to initialize their resource"! !

!TestResource class methodsFor: 'running' stamp: 'StefanMarr 3/16/2012 01:38'!
availableFor: aTestAsserter
	aTestAsserter
		assert: self isAvailable
		description:
			['Unavailable resource ' , self name , ' requested by '
				, aTestAsserter printString]! !

!TestResource class methodsFor: 'running' stamp: 'StephaneDucasse 6/9/2012 22:49'!
signalInitializationError
	^ self classForTestResult signalFailureWith:  'Resource ' , self name , ' could not be initialized'! !

!TestResource class methodsFor: 'testing' stamp: ''!
isUnavailable

	^self isAvailable not
			! !

!TestResource class methodsFor: 'accessing' stamp: 'BaseSystem 8/30/2009 09:35'!
resources
	^#()! !

!TestResource class methodsFor: 'accessing' stamp: ''!
current: aTestResource

	current := aTestResource
			! !

!TestResource class methodsFor: 'testing' stamp: 'md 2/22/2006 14:21'!
isAbstract
	"Override to true if a TestResource subclass is Abstract and should not have
	TestCase instances built from it"

	^self name = #TestResource
			! !

!TestResource class methodsFor: 'private' stamp: 'GuillermoPolito 4/10/2011 21:30'!
makeAvailable
	"This method must be the _only_ way to set a notNil value for the unique instance (current).  First, obtain a candidate instance and set current to a notNil placeholder (any notNil object not an instance of me would do;  this version uses false).  Next, check any subordinate resources needed by this resource.  Lastly, setUp the candidate and put it in current if it is available, ensuring that it is torn down otherwise."
	
	| candidate |
	current := nil.
	candidate := self new.
	self resources do: [:each | each availableFor: candidate].
	[candidate setUp.
	candidate isAvailable ifTrue: [current := candidate]]
		ensure: [current == candidate ifFalse: [candidate tearDown]]! !

!TestResource class methodsFor: 'instance creation' stamp: 'NiallRoss 7/18/2010 11:53'!
reset
	[self isAlreadyAvailable ifTrue: [current tearDown]]
		ensure: [current := nil]! !

!TestResource class methodsFor: 'running' stamp: 'nfr 1/3/2010 18:01'!
resetResources: topLevelResources
	"Reset all imperfectly-set-up resources while gathering the rest for ordered resetting."

	| availableResources |
	availableResources := OrderedCollection new: topLevelResources size.
	topLevelResources
		do: [:each | each resetOrAddResourcesTo: availableResources].
	availableResources reverseDo: [:each | each reset]! !

!TestResource class methodsFor: 'testing' stamp: 'BaseSystem 8/30/2009 09:35'!
isAlreadyAvailable
	^current class == self! !

!TestResource class methodsFor: 'instance creation' stamp: 'nfr 1/3/2010 18:01'!
new
	"Use #current to get the valid current instance.  Use of #new to get an instance (that should never be the current one) could be done in bizarre circumstances, so is not blocked, but will usually be inappropriate."
	
	^super new initialize.! !

!TestResource class methodsFor: 'testing' stamp: 'ClementBera 7/26/2013 16:33'!
isAvailable
	"This is (and must be) a lazy method.  If my current has a value, an attempt to make me available has already been made:  trust its result.  If not, try to make me available."

	current ifNil: [self makeAvailable].
	^self isAlreadyAvailable! !

!TestResource class methodsFor: 'accessing' stamp: ' 17/7/10 17:28'!
current
	"This is a lazy accessor:  the assert of self isAvailable does no work unless current isNil.  However this method should normally be sent only to a resource that should already have been made available, e.g. in a test whose test case class has the resource class in its #resources, so should never be able to fail the assert.
	If the intent is indeed to access a possibly-unprepared or reset-in-earlier-test resource lazily, then preface the call of 'MyResource current' with 'MyResource availableFor: self'."
	
	self
		assert: self isAvailable
		description:
			'Sent #current to unavailable resource ' , self name ,
					'.  Add it to test case'' class-side #resources (recommended) or send #availableFor: beforehand'.
	^current! !

!TestResource class methodsFor: 'private' stamp: 'ClementBera 7/26/2013 16:33'!
resetOrAddResourcesTo: aCollection
	"Add correctly set-up resources to the collection unless already there. Reset any imperfectly-set-up resources, so current isNil will return true if they are re-encountered via an indirectly self-prerequing resource;  circular references cannot be set up so will never reply true to isAlreadyAvailable, but may have correctly-set-up prereqs to add and/or imperfectly-set-up ones to reset, so do not abort the loop first time round."

	current ifNil: [^self].
	self isAlreadyAvailable
		ifFalse:
			[self reset.
			self resources do: [:each | each resetOrAddResourcesTo: aCollection]]
		ifTrue:
			[(aCollection includes: self)
				ifFalse:
					[self resources do: [:each | each resetOrAddResourcesTo: aCollection].
					aCollection add: self]]

"The cloned 'self resources do: ...' line in both blocks is, I think, the best way to write this method so that its logic is clear.  The first loop resets this resource immediately, before traversing its resources;  the second traverses before adding"! !

!TestResult commentStamp: '<historical>'!
This implements the Collecting Parameter pattern for running a bunch of tests.  It holds tests that have run, sorted into the result categories of passed, failures and errors.

TestResult is an interesting object to subclass or substitute. #runCase: is the external protocol you need to reproduce. TestResult subclasses can  handle multi-threaded tests (see SUnitXProcPatterns) and might record coverage information or send emails when the run completes.
!
!TestResult methodsFor: 'history' stamp: 'simon.denier 11/13/2008 20:51'!
selectResultsForTestCase: aTestCaseClass
	| passedSelectors errorsSelectors failuresSelectors |
	passedSelectors := self passed
						select: [:testCase | testCase class == aTestCaseClass ] thenCollect: [:testCase | testCase selector].
	errorsSelectors := self errors 
						select: [:testCase | testCase class == aTestCaseClass ] thenCollect:  [:testCase | testCase selector].
	failuresSelectors := self failures 
						select: [:testCase | testCase class == aTestCaseClass ] thenCollect:  [:testCase | testCase selector].
	
	^ self class newTestDictionary 
		at: #passed put: passedSelectors asSet;
		at: #failures put: failuresSelectors asSet;
		at: #errors put: errorsSelectors asSet;
		yourself
		! !

!TestResult methodsFor: 'testing' stamp: 'BaseSystem 8/30/2009 09:35'!
hasPassed

	^self hasErrors not and: [self hasFailures not]! !

!TestResult methodsFor: 'querying' stamp: 'GwenaelCasaccio 10/1/2008 22:36'!
isPassedFor: class selector: selector
	^ self passed anySatisfy: [:testCase | testCase class == class and: [testCase selector == selector]]! !

!TestResult methodsFor: 'diff' stamp: 'AlexandreBergel 10/1/2008 16:26'!
diff: aTestResult
	"Return a collection that contains differences"
	| passed1Selectors failed1Selectors errors1Selectors passed2Selectors failed2Selectors errors2Selectors |
	passed1Selectors := self passed collect: [:testCase | testCase selector].
	failed1Selectors := self failures collect: [:testCase | testCase selector].
	errors1Selectors := self errors collect: [:testCase | testCase selector].

	passed2Selectors := aTestResult passed collect: [:testCase | testCase selector].
	failed2Selectors := aTestResult failures collect: [:testCase | testCase selector].
	errors2Selectors := aTestResult errors collect: [:testCase | testCase selector].
	
	^ {passed1Selectors copyWithoutAll: passed2Selectors .
		failed1Selectors copyWithoutAll: failed2Selectors .
		errors1Selectors copyWithoutAll: errors2Selectors}! !

!TestResult methodsFor: 'accessing' stamp: 'BaseSystem 8/30/2009 09:35'!
errorCount

	^self errors size! !

!TestResult methodsFor: 'initialization' stamp: 'CamilloBruni 8/24/2012 16:17'!
initialize
	super initialize.
	passed := OrderedCollection new.
	failures := Set new.
	errors := OrderedCollection new.
	skipped := OrderedCollection new.
	timeStamp := DateAndTime now! !

!TestResult methodsFor: 'filein/out' stamp: 'LaurentLaffont 5/23/2010 09:54'!
fileOutOn: aFileStream
	"Write in aFileStream like:
	3 run, 2 passes, 0 expected failures, 1 failures, 0 errors, 0 unexpected passes
	Failures:
	SHParserST80Test>>#testNumbers
	
	Errors:"	
	| printer |
	printer := [:title :testCases | 
				aFileStream cr; nextPutAll: title; cr.
				testCases do: [:aTestCase| 
								aTestCase printOn: aFileStream.
								aFileStream cr]].
				
	self printOn: aFileStream.	
	printer value: 'Failures:' value: self failures.
	printer value: 'Errors:' value: self errors.! !

!TestResult methodsFor: 'compatibility' stamp: 'JF 7/30/2003 16:09'!
errors
	^ self unexpectedErrors! !

!TestResult methodsFor: 'compatibility' stamp: 'JF 7/30/2003 16:08'!
passed
	^ self expectedPasses, self expectedDefects! !

!TestResult methodsFor: 'accessing' stamp: 'AlexandreBergel 10/1/2008 11:52'!
timeStamp: anObject
	timeStamp := anObject! !

!TestResult methodsFor: 'printing' stamp: 'CamilloBruni 8/24/2012 17:48'!
printOn: aStream
	aStream
		nextPutAll: self runCount printString;
		nextPutAll: ' run, ';
		nextPutAll: self expectedPassCount printString;
		nextPutAll: ' passes, ';
		nextPutAll: self skippedCount printString;
		nextPutAll: ' skipped, ';
		nextPutAll: self expectedDefectCount printString;
		nextPutAll:' expected failures, ';
		nextPutAll: self unexpectedFailureCount printString;
		nextPutAll: ' failures, ';
		nextPutAll: self unexpectedErrorCount printString;
		nextPutAll:' errors, ';
		nextPutAll: self unexpectedPassCount printString;
		nextPutAll:' unexpected passes'.! !

!TestResult methodsFor: 'accessing' stamp: 'BaseSystem 8/30/2009 09:35'!
failureCount

	^self failures size! !

!TestResult methodsFor: 'history' stamp: 'simon.denier 11/13/2008 20:33'!
dispatchResultsIntoHistory 

	self classesTested do: 
		[ :testClass | 
		self class
			historyAt: testClass
			put: (self selectResultsForTestCase: testClass) ].
! !

!TestResult methodsFor: 'running' stamp: 'MasashiUmezawa 5/4/2014 23:27'!
runCase: aTestCase
	[
	aTestCase announce: TestCaseStarted withResult: self.
	aTestCase runCase.
	aTestCase announce: TestCaseEnded  withResult: self.
	self addPass: aTestCase]
		on: self class failure , self class skip, self class warning, self class error
		do: [:ex | ex sunitAnnounce: aTestCase toResult: self]! !

!TestResult methodsFor: 'adding' stamp: 'NiallRoss 7/18/2010 12:21'!
addFailure: aTestCase
	"We cannot use self failures as that incorporates test expectations and so does not return the stored collection."

	^failures add: aTestCase! !

!TestResult methodsFor: 'accessing' stamp: 'JF 7/30/2003 16:14'!
unexpectedErrors
	^ errors select: [:each | each shouldPass] ! !

!TestResult methodsFor: 'accessing' stamp: 'AlexandreBergel 10/1/2008 11:52'!
timeStamp
	^ timeStamp! !

!TestResult methodsFor: 'querying' stamp: 'GwenaelCasaccio 10/1/2008 22:37'!
isFailureFor: class selector: selector
	^ self failures anySatisfy: [:testCase | testCase class == class and: [testCase selector == selector]]! !

!TestResult methodsFor: 'accessing' stamp: 'JF 7/30/2003 13:54'!
unexpectedErrorCount
	^ self unexpectedErrors size! !

!TestResult methodsFor: 'testing' stamp: 'BaseSystem 8/30/2009 09:35'!
isFailure: aTestCase
	^self failures includes: aTestCase! !

!TestResult methodsFor: 'deprecated' stamp: 'nfr 1/3/2010 17:58'!
correctCount
	"deprecated - use #passedCount"
	
	^self passedCount! !

!TestResult methodsFor: 'accessing' stamp: 'BaseSystem 8/30/2009 09:35'!
passedCount

	^self passed size! !

!TestResult methodsFor: 'compatibility' stamp: 'md 11/25/2004 16:23'!
failures
	^ self unexpectedFailures, self unexpectedPasses ! !

!TestResult methodsFor: 'accessing' stamp: 'simon.denier 11/13/2008 20:27'!
classesTested
	^ (self tests collect: [ :testCase | testCase class ]) asSet! !

!TestResult methodsFor: 'testing' stamp: 'BaseSystem 8/30/2009 09:35'!
isPassed: aTestCase

	^self passed includes: aTestCase! !

!TestResult methodsFor: 'accessing' stamp: 'CamilloBruni 8/24/2012 16:16'!
skippedCount

	^ self skipped size! !

!TestResult methodsFor: 'accessing' stamp: 'JF 7/30/2003 13:54'!
expectedPassCount
	^ self expectedPasses size! !

!TestResult methodsFor: 'accessing' stamp: 'BaseSystem 8/30/2009 09:35'!
defects
	^OrderedCollection new
		addAll: self errors;
		addAll: self failures; yourself! !

!TestResult methodsFor: 'accessing' stamp: 'JF 7/30/2003 13:54'!
expectedDefectCount
	^ self expectedDefects size! !

!TestResult methodsFor: 'testing' stamp: 'BaseSystem 8/30/2009 09:35'!
hasErrors

	^self errors size > 0! !

!TestResult methodsFor: 'accessing' stamp: 'md 11/25/2004 16:36'!
expectedDefects
	^ (errors, failures asOrderedCollection) select: [:each | each shouldPass not] ! !

!TestResult methodsFor: 'accessing' stamp: 'JF 7/30/2003 16:14'!
expectedPasses
	^ passed select: [:each | each shouldPass] ! !

!TestResult methodsFor: 'accessing' stamp: 'JF 7/30/2003 13:54'!
unexpectedFailureCount
	^ self unexpectedFailures size! !

!TestResult methodsFor: 'querying' stamp: 'GwenaelCasaccio 10/1/2008 22:37'!
isErrorFor: class selector: selector
	^ self errors anySatisfy: [:testCase | testCase class == class and: [testCase selector == selector]]! !

!TestResult methodsFor: 'adding' stamp: 'NiallRoss 7/18/2010 12:22'!
addPass: aTestCase
	"We cannot use self passed as that incorporates test expectations and so does not return the stored collection."

	^passed add: aTestCase! !

!TestResult methodsFor: 'accessing' stamp: 'JF 7/30/2003 16:14'!
unexpectedPasses
	^ passed select: [:each | each shouldPass not] ! !

!TestResult methodsFor: 'adding' stamp: 'NiallRoss 7/18/2010 12:21'!
addError: aTestCase
	"We cannot use self errors as that incorporates test expectations and so does not return the stored collection."

	^errors add: aTestCase! !

!TestResult methodsFor: 'accessing' stamp: 'CamilloBruni 8/24/2012 16:15'!
skipped
	^ skipped! !

!TestResult methodsFor: 'adding' stamp: 'CamilloBruni 8/24/2012 16:18'!
addSkip: aTestCase

	^skipped add: aTestCase! !

!TestResult methodsFor: 'testing' stamp: 'BaseSystem 8/30/2009 09:35'!
isError: aTestCase

	^self errors includes: aTestCase! !

!TestResult methodsFor: 'accessing' stamp: 'BaseSystem 8/30/2009 09:35'!
runCount

	^self passedCount + self failureCount + self errorCount! !

!TestResult methodsFor: 'accessing' stamp: 'JF 7/30/2003 13:54'!
unexpectedPassCount
	^ self unexpectedPasses size! !

!TestResult methodsFor: 'history' stamp: 'NicolaiHess 9/30/2014 21:48'!
updateResultsInHistory
	|classesToNotify|
	classesToNotify:= Set new.
	#(#passed #failures #errors) do: [ :status | 
		(self perform: status) do: [ :testCase | 
			classesToNotify add:testCase class.
			self class updateTestHistoryFor: testCase status: status ] ].
	classesToNotify do:[:cl | 
		cl historyAnnouncer announce: (TestSuiteEnded result: cl)]! !

!TestResult methodsFor: 'accessing' stamp: 'CamilloBruni 8/24/2012 16:17'!
tests
	^(OrderedCollection new: self runCount)
		addAll: passed;
		addAll: failures;
		addAll: errors;
		addAll: skipped;
		yourself! !

!TestResult methodsFor: 'testing' stamp: 'BaseSystem 8/30/2009 09:35'!
hasFailures

	^self failures size > 0! !

!TestResult methodsFor: 'accessing' stamp: 'JF 7/30/2003 16:14'!
unexpectedFailures
	^ failures select: [:each | each shouldPass] ! !

!TestResult class methodsFor: 'history' stamp: 'Alexandre.Bergel 4/3/2009 14:44'!
historyAt: aTestCaseClass
"I will return the last test dictionary for aTestCaseClass. If none found, I will create a new empty one and link it in the history."

	^ aTestCaseClass history ! !

!TestResult class methodsFor: 'exceptions' stamp: 'BaseSystem 8/30/2009 09:35'!
resumableFailure
	^ResumableTestFailure! !

!TestResult class methodsFor: 'exceptions' stamp: 'MasashiUmezawa 5/4/2014 23:30'!
warning
	"Warning that should be treated as test failure"
	^Deprecation 
			! !

!TestResult class methodsFor: 'exceptions' stamp: 'CamilloBruni 8/24/2012 17:52'!
skip
	^ TestSkip! !

!TestResult class methodsFor: 'exceptions' stamp: 'BaseSystem 8/30/2009 09:35'!
failure
	^TestFailure! !

!TestResult class methodsFor: 'history' stamp: 'NicolaiHess 12/29/2013 23:38'!
updateTestHistoryFor: aTestCase status: aSymbol
	| cls sel |
	
	cls := aTestCase class.
	sel := aTestCase selector.
	self removeFromTestHistory: sel in: cls.
	((self historyAt: cls) at: aSymbol ) add: sel.! !

!TestResult class methodsFor: 'history' stamp: 'Alexandre.Bergel 4/3/2009 14:46'!
historyFor: aTestCaseClass
	"I return the last test dictionary for aTestCaseClass. 
	If none found, I return an empty dictionary but will not link it to the class in the history."
	
	| history |
	history := aTestCaseClass history.
	history ifNil: [ ^ self newTestDictionary ].
	^ history
	
"	^ self history at: aTestCaseClass ifAbsent: [ self newTestDictionary ]"! !

!TestResult class methodsFor: 'history' stamp: 'StephaneDucasse 7/7/2010 18:41'!
newTestDictionary

	^ Dictionary new at: #timeStamp put: DateAndTime now;
		at: #passed put: Set new;
		at: #failures put: Set new;
		at: #errors put: Set new;
		yourself
		! !

!TestResult class methodsFor: 'exceptions' stamp: 'md 2/22/2006 14:26'!
signalFailureWith: aString 
	self failure signal: aString
			! !

!TestResult class methodsFor: 'history' stamp: 'simon.denier 11/22/2008 20:56'!
removeFromTestHistory: aSelector in: aTestCaseClass
	| lastRun |
	
	lastRun := self historyFor: aTestCaseClass.
	#(#passed #failures #errors) do:
		[ :set | (lastRun at: set) remove: aSelector ifAbsent: []].
! !

!TestResult class methodsFor: 'exceptions' stamp: 'md 2/22/2006 14:26'!
signalErrorWith: aString 
	self error signal: aString
			! !

!TestResult class methodsFor: 'exceptions' stamp: 'md 2/22/2006 14:17'!
exError
	^Error
			! !

!TestResult class methodsFor: 'history' stamp: 'Alexandre.Bergel 4/3/2009 14:45'!
historyAt: aTestCaseClass put: aDictionary
	aTestCaseClass history: aDictionary
	"^ self history at: aTestCaseClass put: aDictionary "! !

!TestResult class methodsFor: 'exceptions' stamp: 'BaseSystem 8/30/2009 09:35'!
error
	^self exError! !

!TestReviver commentStamp: '<historical>'!
I am a UI for test failures which have been serialized as fuel files. You can:
* materialize the failed test process to debug
* browse the test method.

self open. !
!TestReviver methodsFor: 'private' stamp: 'SeanDeNigris 7/25/2012 10:46'!
initialExtent

	^ 700@500.! !

!TestReviver methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 8/27/2012 14:56'!
imageVersion
	^ imageVersion! !

!TestReviver methodsFor: 'accessing' stamp: 'SeanDeNigris 8/27/2012 14:00'!
vmVersion

	^ vmVersion.! !

!TestReviver methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 8/28/2012 14:00'!
selectTestFailures	
	| files results tokens method | 
	results := OrderedCollection new.
	files := FileLocator imageDirectory filesMatching: '*.fuel'.
	files do: [:aFile |
		tokens := aFile resolve base findTokens: '-'.	
		method := (Smalltalk globals at: tokens first asSymbol ) lookupSelector:  tokens second asSymbol.
		method pragmas isEmpty
			ifTrue: [ results add: aFile ]
			ifFalse:  [
				(method pragmas first keyword = #expectedFailure) 
					ifFalse: [ results add: aFile ].
				 ]
	].
	^ results! !

!TestReviver methodsFor: 'private' stamp: 'TorstenBergmann 3/4/2015 22:15'!
browse: anAbstractFileReference

	| tokens testClass |
	anAbstractFileReference ifNil: [ ^self ].
	tokens := anAbstractFileReference base findTokens: '-'.
	testClass := Smalltalk at: tokens first asSymbol.
	Smalltalk tools browser fullOnClass: testClass selector: tokens second asSymbol.! !

!TestReviver methodsFor: 'private' stamp: 'SeanDeNigris 7/25/2012 10:29'!
browseButton

	^ browseButton.! !

!TestReviver methodsFor: 'private' stamp: 'SeanDeNigris 7/25/2012 09:41'!
debugButton

	^ debugButton.! !

!TestReviver methodsFor: 'initialization' stamp: 'TorstenBergmann 3/4/2015 22:08'!
initializeWidgets

	| serializedErrors |
	self instantiateModels: #(
		errorListModel #ListModel
		debugButton ButtonModel
		browseButton ButtonModel
		vmVersionLabel LabelModel
		vmVersion TextModel
		timeStampLabel LabelModel
		timeStamp TextModel
		imageVersionLabel LabelModel
		imageVersion TextModel).
		
	serializedErrors := self selectTestFailures.
	
	errorListModel
		items: serializedErrors;
		displayBlock: [ :e | e base copyReplaceAll: '-' with: '>>#' ].
	serializedErrors isEmpty ifFalse: [ errorListModel setSelectedIndex: 1 ].
	
	vmVersionLabel label: 'VM Version'.
	vmVersion text: ''; enabled: false.
	timeStampLabel label: 'Timestamp'.
	timeStamp text: ''; enabled: false.	
	imageVersionLabel label: 'Image Version'.
	imageVersion text: ''; enabled: false.	
		
	debugButton
		label: 'Debug';
		action: [ self materialize: errorListModel selectedItem ].

	browseButton
		label: 'Browse';
		action: [ self browse: errorListModel selectedItem ].
		
	self focusOrder
		add: debugButton;
		add: browseButton;
		add: errorListModel.! !

!TestReviver methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 8/27/2012 14:56'!
imageVersionLabel
	^ imageVersionLabel! !

!TestReviver methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 8/27/2012 14:56'!
timeStampLabel
	^ timeStampLabel! !

!TestReviver methodsFor: 'initialization' stamp: 'MarianoMartinezPeck 8/28/2012 14:10'!
initializePresenter

	errorListModel whenSelectedItemChanged: [ :item | | header |
		item 
			ifNil: [ 
				vmVersion text: ''.
				imageVersion text: ''.
				timeStamp text: ''.
				]	
			ifNotNil: [
				header := FLMaterializer materializeHeaderFromFileNamed: item.
				vmVersion text: (header additionalObjectAt: #VM).
				imageVersion text: (header additionalObjectAt: #Image).
				timeStamp text: (header additionalObjectAt: #Timestamp)
				] 
	]! !

!TestReviver methodsFor: 'private' stamp: 'SeanDeNigris 7/25/2012 09:44'!
errorListModel

	^ errorListModel.! !

!TestReviver methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 8/27/2012 14:56'!
timeStamp
	^ timeStamp! !

!TestReviver methodsFor: 'accessing' stamp: 'SeanDeNigris 8/27/2012 13:59'!
vmVersionLabel

	^ vmVersionLabel.! !

!TestReviver methodsFor: 'private' stamp: 'TorstenBergmann 3/4/2015 22:16'!
materialize: fuelFileReference
	fuelFileReference ifNil: [ ^self ].
	FLMaterializer materializeFromFileNamed: fuelFileReference fullName! !

!TestReviver class methodsFor: 'accessing' stamp: 'SeanDeNigris 7/25/2012 09:39'!
title

	^ 'Test Error Browser'.! !

!TestReviver class methodsFor: 'opening' stamp: 'TorstenBergmann 3/4/2015 22:13'!
open
	<script>
	
	|model|
	model := self new.
	model openWithSpec model: model.
	^model! !

!TestReviver class methodsFor: 'specs' stamp: 'SeanDeNigris 8/27/2012 16:09'!
spec
	<spec: #default>

	^ SpecLayout composed
		newColumn: [:c |
			c 
				newRow: [ :spec | spec
					add: #debugButton;
					add: #browseButton ] height: 30;
				newRow: [ :spec | spec add:  #errorListModel ];
				newRow: [ :spec | spec
						add: #timeStampLabel width: 100;
						add: #timeStamp ] height: 30;
				newRow: [ :spec | spec
						add: #imageVersionLabel width: 100;
						add: #imageVersion ] height: 30;
				newRow: [ :spec | spec
						add: #vmVersionLabel width: 100;
						add: #vmVersion ] height: 75];
		yourself.! !

!TestRunner commentStamp: '<historical>'!
<lint: #ignore rule: #classNotReferenced rational: 'this view is only accessed from menus'>

Although tests can be most easily be run from a browser, I provide the ability to: 
* select sets of test suites to run. I am designed to make it easy to execute groups of tests
* obtain a more detailed log of the results 


UI Description 
___________ 

My left-most pane lists all of the categories that contain test classes (i.e., subclasses of TestCase); when some of these categories are selected, the test classes that they contain appear in the pane to the right. Abstract classes are italicized, and the test class hierarchy is shown by indentation, so subclasses of ClassTestCase are indented more than subclasses of TestCase. 

The tests that did not pass (if any) are listed in the right-hand panes of the Test Runner; if you want to debug one, to see why it failed, just click on the name.
!
!TestRunner methodsFor: 'testing' stamp: 'lr 11/21/2005 13:19'!
hasRunnable
	^ classesSelected notEmpty.! !

!TestRunner methodsFor: 'factory' stamp: 'StephaneDucasse 6/9/2012 23:05'!
classForTestSuite
	^ TestSuite! !

!TestRunner methodsFor: 'building' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
categorySearchFrame
	^LayoutFrame new
		rightFraction: 0.25;
		bottomFraction: 0 offset: (Smalltalk ui theme textFont height + 10)! !

!TestRunner methodsFor: 'actions' stamp: 'CarloTeixeira 10/24/2011 22:26'!
runFailures
	self result instVarNamed: 'failures' put: Set new.
	self runTestSuites: self failureTestSuites.! !

!TestRunner methodsFor: 'building' stamp: 'StephaneDucasse 9/5/2011 18:23'!
buildCategories

	^ PluggableListMorph new
		on: self
		list: #categoryList 
		primarySelection: #categorySelected 
		changePrimarySelection: #categorySelected: 
		listSelection: #categoryAt: 
		changeListSelection: #categoryAt:put: 
		menu: #categoryMenu:  
		keystroke: nil;
		yourself! !

!TestRunner methodsFor: 'accessing-classes' stamp: 'BenjaminVanRyseghem 2/8/2012 17:09'!
browseClass

	^ (classes at: classIndex ifAbsent: [ ^ self ]) browse! !

!TestRunner methodsFor: 'history saving' stamp: 'simon.denier 11/13/2008 19:36'!
saveResultInHistory
	result dispatchResultsIntoHistory! !

!TestRunner methodsFor: 'initialization' stamp: 'BernardoContreras 10/29/2014 18:12'!
initialize
	super initialize.
	failedList := errorList := Array new.
	SystemAnnouncer uniqueInstance weak
		when: ClassAdded, CategoryAdded, ClassRemoved, CategoryRemoved, ClassRenamed, CategoryRenamed, ClassRecategorized 
			send: #update 
			to: self.
	self update; resetResult! !

!TestRunner methodsFor: 'accessing-testing' stamp: 'lr 10/27/2005 10:37'!
errorSelected: anInteger
	errorSelected := errorList at: anInteger ifAbsent: nil.
	self changed: #errorSelected.
	errorSelected ifNotNil: [ self debug: errorSelected ].! !

!TestRunner methodsFor: 'history saving' stamp: 'MarcusDenker 5/10/2013 00:27'!
hasProgress

	result classesTested do: [:cls |
		(cls class includesSelector: #lastStoredRun)
			ifTrue: [^ true]].
	^ false! !

!TestRunner methodsFor: 'accessing-menu' stamp: 'StephaneDucasse 10/27/2014 09:34'!
statusMenu: aMenu
	^ aMenu
		add: 'History' selector: #showHistoryMenu;
		add: 'Store result as progress reference' selector: #storeResultIntoTestCases;
		add: 'Show progress' selector: #showProgress; 
		yourself! !

!TestRunner methodsFor: 'newbuilding' stamp: 'EstebanLorenzano 5/1/2014 11:37'!
buildStatus

	^ (PluggableTextFieldMorph
		on: self 
		text: #statusText 
		accept: nil 
		readSelection: nil 
		menu: #statusMenu:)
			textColor: self theme textColorForNonStandardBackground;
			getColorSelector: #statusColor ; 
			yourself.
	! !

!TestRunner methodsFor: 'actions' stamp: 'MarcusDenker 7/28/2014 21:26'!
collectCoverageFor: methods
	| wrappers suite |
	wrappers := methods collect: [ :each | TestCoverage on: each ].
	suite := self
		resetResult;
		suiteForAllSelected.
	
	[ wrappers do: [ :each | each install ].
	[ self runSuite: suite ] ensure: [ wrappers do: [ :each | each uninstall ] ] ] valueUnpreemptively.
	wrappers := wrappers reject: #hasRun.
	wrappers := wrappers collect: #reference.
	wrappers isEmpty 
		ifTrue:  [ UIManager default inform: 'Congratulations. Your tests cover all code under analysis.' ]
		ifFalse: [ 
			Smalltalk tools messageList 
				browse: wrappers
				title: 'Not Covered Code (' , (100 - (100 * wrappers size // methods size)) printString , '% Code Coverage)'].
	self saveResultInHistory! !

!TestRunner methodsFor: 'updating' stamp: 'lr 3/22/2006 19:35'!
update
	self updateCategories; updateClasses! !

!TestRunner methodsFor: 'actions' stamp: 'lr 11/3/2005 09:15'!
runTest: aTestCase
	aTestCase run: result.
	self updateStatus: true.! !

!TestRunner methodsFor: 'actions' stamp: 'SantiagoBragagnolo 4/29/2012 20:25'!
runSuite: aTestSuite
	self executeSuite: aTestSuite as: [ :aSuite :aResult | aSuite run: aResult ].
	self updateResults

! !

!TestRunner methodsFor: 'building' stamp: 'StephaneDucasse 9/5/2011 18:23'!
buildClasses

	^ PluggableListMorph new
		on: self
		list: #classList 
		primarySelection: #classSelected 
		changePrimarySelection: #classSelected: 
		listSelection: #classAt: 
		changeListSelection: #classAt:put: 
		menu: #classMenu:  
		keystroke: nil;
		yourself! !

!TestRunner methodsFor: 'accessing-ui' stamp: 'lr 10/8/2005 18:39'!
extent
	^ 640 @ 480! !

!TestRunner methodsFor: 'actions' stamp: 'StephaneDucasse 6/9/2012 22:49'!
resetResult

	self result: TestAsserter classForTestResult new ; updateResults.! !

!TestRunner methodsFor: 'building' stamp: 'IgorStasenko 12/20/2012 14:23'!
failureListFrame
	^LayoutFrame new
		leftFraction: 0.5;
		bottomFraction: 0.5;
		topOffset: self statusHeight! !

!TestRunner methodsFor: 'building' stamp: 'zork 6/5/2011 12:31'!
open

	^ self build openInWorld
	
! !

!TestRunner methodsFor: 'private' stamp: 'lr 10/27/2005 10:32'!
label: aString forSuite: aTestSuite
	^ String streamContents: [ :stream |
		stream nextPutAll: 'Running '; print: aTestSuite tests size; space; nextPutAll: aString.
		aTestSuite tests size > 1 ifTrue: [ stream nextPut: $s ] ]. ! !

!TestRunner methodsFor: 'accessing-testing' stamp: 'lr 3/16/2010 19:37'!
statusColor
	result hasErrors 
		ifTrue: [ ^ Color red ].
	result hasFailures 
		ifTrue: [ ^ Color yellow ].
	^ Color green! !

!TestRunner methodsFor: 'accessing-classes' stamp: 'gvc 7/24/2007 12:01'!
selectInverseClasses
	"Fixed to update all selections now that the
	selection invalidation has been optimised."
	
	classesSelected := classes asSet 
		removeAll: classesSelected;
		yourself.
	self
		changed: #allSelections;
		changed: #classSelected;
		changed: #hasRunnable! !

!TestRunner methodsFor: 'history saving' stamp: 'AlexandreBergel 10/1/2008 12:00'!
historyMenuList
	^ {'** save current result **'}, (self previousRun collect: [:ts | ts printString])! !

!TestRunner methodsFor: 'actions' stamp: 'SeanDeNigris 2/8/2013 08:38'!
generateDefaultFileOutResultsName
	
	| filename |
	filename := String
		streamContents: [ :st | 
			| printedDate |
			st nextPutAll: 'tests_'.
			st nextPutAll: SystemVersion current version.
			st nextPutAll: '_'.
			result timeStamp printYMDOn: st.
			st nextPutAll: '_'.
			result timeStamp printHMSOn: st.
			st nextPutAll: '.txt' ].
	^ filename copyReplaceAll: ':' with: '-'.! !

!TestRunner methodsFor: 'history saving' stamp: 'AlexandreBergel 10/1/2008 11:46'!
previousRun

	^ previousRun ifNil: [ previousRun := OrderedCollection new ]! !

!TestRunner methodsFor: 'accessing-categories' stamp: 'lr 10/31/2005 15:09'!
categoryAt: anIndex
	^ categoriesSelected includes: (categories at: anIndex ifAbsent: [ ^ false ]).! !

!TestRunner methodsFor: 'actions' stamp: 'onierstrasz 5/14/2009 14:15'!
runCoverage
	| packages methods |
	packages := Set new.
	self addDeclaredPackagesUnderTestTo: packages.
	packages isEmpty ifTrue: 
		[ packages := self promptForPackages ].
	methods := OrderedCollection new.
	self 
		addMethodsUnderTestIn: packages
		to: methods.
	self excludeClassesNotUnderTestFrom: methods.
	methods isEmpty ifTrue: 
		[ ^ UIManager default inform: 'No methods found for coverage analysis.' ].
	self collectCoverageFor: methods
! !

!TestRunner methodsFor: 'history saving' stamp: 'GwenaelCasaccio 10/1/2008 22:00'!
hasResults

	^ result notNil! !

!TestRunner methodsFor: 'private' stamp: 'lr 3/14/2010 21:13'!
browserEnvironment
	^ Smalltalk globals classNamed: #BrowserEnvironment! !

!TestRunner methodsFor: 'building' stamp: 'ChristopheDemarey 9/26/2014 16:56'!
buildButtons
	^ PanelMorph new
		changeTableLayout;
		listDirection: #leftToRight;
		layoutInset: 0;
		color: Color transparent;
		addAllMorphs: (self buttons collect: [ :each |
			PluggableButtonMorph new
				on: self
				getState: nil
				action: each second
				label: nil
				menu: nil;
				label: each first;
				setBalloonText: each third;
				getEnabledSelector: (each at: 4);
				hResizing: #spaceFill;
				yourself ]);
		yourself.! !

!TestRunner methodsFor: 'accessing-menu' stamp: 'StephaneDucasse 10/27/2014 09:34'!
errorMenu: aMenu
	"Add the browse item only if an item is selected"

	self statusMenu: aMenu.
	errorSelected ifNotNil: [aMenu add: 'Browse test' selector: #browseSelectedErrorTest].
	^aMenu! !

!TestRunner methodsFor: 'building' stamp: 'IgorStasenko 12/20/2012 14:19'!
buttonsFrame
	^LayoutFrame new topFraction: 1 offset: self buttonHeight negated
		! !

!TestRunner methodsFor: 'accessing-classes' stamp: 'lr 7/4/2009 15:10'!
filterClasses
	| pattern |
	pattern := UIManager default 
		request: 'Pattern to select tests:' 
		initialAnswer: '*'.
	pattern isNil ifTrue: [ ^ self ].
	classesSelected := (classes select: [ :each | 
		pattern match: each name ]) asSet.
	self
		changed: #allSelections;
		changed: #classSelected;
		changed: #hasRunnable! !

!TestRunner methodsFor: 'updating' stamp: 'BenComan 12/3/2014 21:46'!
updateCategories
	categories := self findCategories.
	categoryIndex := 0.
	categoriesSelected := categoriesSelected isNil
		ifTrue: [ Set new ]
		ifFalse: [
			categoriesSelected
				select: [ :each | categories includes: each ] ].
	self changed: #categoryList; changed: #categorySelected.! !

!TestRunner methodsFor: 'accessing' stamp: 'StephaneDucasse 6/9/2012 23:05'!
failureTestSuites
	^ failedList
		collect: [ :each | 
			self classForTestSuite new
				in: [ :suite | 
							suite
								addTest: each;
								name: (self label: 'Failure' forSuite: suite) ];
				yourself ]! !

!TestRunner methodsFor: 'history saving' stamp: 'MarcusDenker 10/8/2014 15:11'!
showDiffWith: aTestResult
	| string diff |

	diff := result diff: aTestResult.
	string := String streamContents: [:str|
		str nextPutAll: '----------------'; cr.
		str nextPutAll: 'Diff between current result with: ', aTestResult asString; cr.
		str nextPutAll: 'New passed: '.
		diff first do: [:s| str nextPutAll: s printString, ' '].
		str cr.
		str nextPutAll: 'New failures: '.
		diff second do: [:s| str nextPutAll: s printString, ' '].
		str cr.
		
		str nextPutAll: 'New errors: '.
		diff third do: [:s| str nextPutAll: s printString, ' '].
		str cr].
	
	UIManager default edit: string label: 'SUnit Progress'. 
	! !

!TestRunner methodsFor: 'accessing-classes' stamp: 'StephaneDucasse 10/27/2014 09:34'!
classMenu: aMenu
	^ aMenu
		addTitle: 'Classes';
		add: 'Browse' selector: #browseClass;
		addLine;
		add: 'Select all' selector: #selectAllClasses;
		add: 'Select unit tests' selector: #selectAllUnitTests;
		add: 'Select subclasses' selector: #selectSubclasses;
		add: 'Select inversion' selector: #selectInverseClasses;
		add: 'Select none' selector: #selectNoClasses;
		add: 'Refresh' selector: #updateClasses;
		addLine;
		add: 'Filter...' selector: #filterClasses;
		addLine;
		add: 'Run selected' selector: #runAll;
		yourself.! !

!TestRunner methodsFor: 'actions' stamp: 'GuillaumeLarcheveque 2/8/2013 13:31'!
fileOutResults
	"Save current test results into text file."
	"Generate a filename like 'tests_Version_23_May_2010_9-19-20_am.txt' "

	| fileName defaultFilename stream printer |
	defaultFilename := self generateDefaultFileOutResultsName.
						
						
	fileName := UIManager default 
		request: 'Enter the file name' 
		initialAnswer: defaultFilename.
	fileName ifNil: [^ self].
	stream := MultiByteFileStream newFileNamed: fileName.	
	[result fileOutOn: stream] 
		ensure: [stream close].! !

!TestRunner methodsFor: 'updating' stamp: 'LaurentLaffont 2/27/2011 17:20'!
updateResults
	"<lint: #expect rule: #guardingClause>"
	"<lint: #expect rule: #longMethods>"

	self updateStatus: false.
	failedList size = result failures size ifFalse: [
		failedList := result failures asArray
			sort: [ :a :b | a printString <= b printString ].
		failedSelected := nil.
		self 
			changed: #failedList; 
			changed: #failedSelected;
			changed: #hasFailures;
			changed: #hasProgress;
			changed: #hasFailuresOrErrors  ].
	errorList size = result errors size ifFalse: [
		errorList := result errors asArray
			sort: [ :a :b | a printString <= b printString ].
		errorSelected := nil.
		self 
			changed: #errorList; 
			changed: #errorSelected;
			changed: #hasErrors;
			changed: #hasProgress;
			changed: #hasFailuresOrErrors  ].! !

!TestRunner methodsFor: 'accessing-categories' stamp: 'lr 7/4/2009 15:08'!
filterCategories
	| pattern |
	pattern := UIManager default 
		request: 'Pattern to select categories:' 
		initialAnswer: '*'.
	pattern isNil ifTrue: [ ^ self ].
	categoriesSelected := (categories 
		select: [ :each | pattern match: each ]) asSet.
	self changed: #allSelections; changed: #categorySelected; updateClasses! !

!TestRunner methodsFor: 'accessing-ui' stamp: 'lr 1/20/2006 13:36'!
label
	^ 'Test Runner' ! !

!TestRunner methodsFor: 'building' stamp: 'MarianoMartinezPeck 12/16/2011 11:04'!
classSearchUpdate: aPattern
	classPattern := (aPattern isNil or: [ aPattern trimBoth isEmpty ])
		ifTrue: [ nil ]
		ifFalse: [ aPattern asRegexIgnoringCase ].
	self updateClasses.! !

!TestRunner methodsFor: 'accessing-classes' stamp: 'gvc 7/24/2007 12:01'!
selectAllClasses
	"Fixed to update all selections now that the
	selection invalidation has been optimised."
	
	classesSelected := classes asSet.
	self
		changed: #allSelections;
		changed: #classSelected;
		changed: #hasRunnable! !

!TestRunner methodsFor: 'accessing-categories' stamp: 'BenComan 12/2/2014 22:33'!
categorySelected
	^ categoryIndex ! !

!TestRunner methodsFor: 'actions' stamp: 'CarloTeixeira 10/24/2011 22:26'!
runErrors
	self result instVarNamed: 'errors' put: OrderedCollection new.
	self runTestSuites: self errorTestSuites.! !

!TestRunner methodsFor: 'accessing-categories' stamp: 'BenComan 12/2/2014 22:42'!
categorySelected: anInteger
	categoryIndex := anInteger.
	self changed: #categorySelected.! !

!TestRunner methodsFor: 'history saving' stamp: 'MarcusDenker 10/8/2014 15:11'!
showProgress
	| testCaseClasses d string |
	testCaseClasses := (self suiteForAllSelected tests collect: [:testCase | testCase class]) asSet.
	
	"At the end of the algorithm, d will contains all the diff between what was saved and the current result"
	d := Dictionary new.
	d at: #passed put: OrderedCollection new.
	d at: #failures put: OrderedCollection new.
	d at: #errors put: OrderedCollection new.

	testCaseClasses do: [ :cls | | t |
		(cls class includesSelector: #lastStoredRun)
			ifTrue: [t := cls lastStoredRun.
					(t at: #passed) do: [:s | 	
											(result isErrorFor: cls selector: s)
												ifTrue: [(d at: #errors) add: {cls . s}].
											(result isFailureFor: cls selector: s)
												ifTrue: [(d at: #failures) add: {cls . s}]  ].
											
					(t at: #failures) do: [:s | (result isPassedFor: cls selector: s)
												ifTrue: [(d at: #passed) add: {cls . s}].
											(result isErrorFor: cls selector: s)
												ifTrue: [(d at: #errors) add: {cls . s}]].
											
					(t at: #errors) do: [:s | 	(result isPassedFor: cls selector: s)
												ifTrue: [(d at: #passed) add: {cls . s}].
											(result isFailureFor: cls selector: s)
												ifTrue: [(d at: #failures) add: {cls . s}]]]].
		
			
	string := String streamContents: [:str|
		str nextPutAll: '----------------'; cr.
		str nextPutAll: 'Diff between current result and saved result'; cr.
		str nextPutAll: 'New passed: '.
		(d at: #passed) do: [:s| str nextPutAll: s printString, ' '].
		str cr.
		str nextPutAll: 'New failures: '.
		(d at: #failures) do: [:s| str nextPutAll: s printString, ' '].
		str cr.
		
		str nextPutAll: 'New errors: '.
		(d at: #errors) do: [:s| str nextPutAll: s printString, ' '].
		str cr].
	
	UIManager default edit: string label: 'SUnit Progress'. 

	! !

!TestRunner methodsFor: 'private' stamp: 'CamilleTeruel 7/29/2012 18:49'!
windowIsClosing
	SystemAnnouncer uniqueInstance unsubscribe: self! !

!TestRunner methodsFor: 'accessing' stamp: 'CarloTeixeira 10/24/2011 22:26'!
allSelectedTestSuites
	"Return the suite for all the selected test case classes"
	
	^ classesSelected select: [ :each | each isAbstract not] thenCollect: [:each | each suite].! !

!TestRunner methodsFor: 'accessing-categories' stamp: 'lr 7/4/2009 15:08'!
selectInverseCategories
	categoriesSelected := categories asSet 
		removeAll: categoriesSelected;
		yourself.
	self changed: #allSelections; changed: #categorySelected; updateClasses! !

!TestRunner methodsFor: 'accessing-classes' stamp: 'lr 11/21/2005 13:19'!
classAt: anInteger put: aBoolean
	classesSelected := classesSelected
		perform: (aBoolean ifTrue: [ #copyWith: ] ifFalse: [ #copyWithout: ])
		with: (classes at: anInteger ifAbsent: [ ^ self ]).
	self changed: #classSelected; changed: #hasRunnable.! !

!TestRunner methodsFor: 'actions' stamp: 'SantiagoBragagnolo 4/29/2012 20:25'!
debugSuite: aTestSuite
	self executeSuite: aTestSuite as: [ :aSuite | aSuite debug ].! !

!TestRunner methodsFor: 'utilities' stamp: 'CamilloBruni 8/16/2011 02:05'!
findCategories
	| visible |
	visible := Set new.
	self baseClass withAllSubclassesDo: [ :each |
		each category ifNotNil: [ :category |
			visible add: category ] ].
	^ Array streamContents: [ :stream |
		Smalltalk organization categories do: [ :each |
			((visible includes: each) 
					and: [ categoryPattern isNil or: [ (categoryPattern matchesIn: each) isEmpty not]])
				ifTrue: [ stream nextPut: each ] ] ].! !

!TestRunner methodsFor: 'actions' stamp: 'lr 10/31/2005 17:13'!
runProfiled
	MessageTally spyOn: [ self runAll ].! !

!TestRunner methodsFor: 'processing' stamp: 'SantiagoBragagnolo 4/30/2012 14:25'!
executeSuite: aTestSuite as: aBlock
" The block defines how to interact with the suite. run with a result or debug "
	aTestSuite subscribe:TestAnnouncement do: self updateUIBlock.
	[ aBlock cull: aTestSuite cull: result  ] ensure: [
		aTestSuite unsubscribe:TestAnnouncement.
	].


! !

!TestRunner methodsFor: 'accessing-categories' stamp: 'lr 10/31/2005 15:51'!
categoryAt: anInteger put: aBoolean
	categoriesSelected := categoriesSelected
		perform: (aBoolean ifTrue: [ #copyWith: ] ifFalse: [ #copyWithout: ])
		with: (categories at: anInteger ifAbsent: [ ^ self ]).
	self changed: #categorySelected; updateClasses.! !

!TestRunner methodsFor: 'accessing-categories' stamp: 'CamilloBruni 8/16/2011 02:03'!
categoryList
	^ categories! !

!TestRunner methodsFor: 'accessing-classes' stamp: 'nice 1/5/2010 15:59'!
classList
	| offset |
	classes isEmpty ifTrue: [ ^ classes ].
	offset := classes first allSuperclasses size.
	^ classes collect: [ :each | | ident |
		ident := String 
			new: 2 * (0 max: each allSuperclasses size - offset) 
			withAll: $ .
		each isAbstract
			ifFalse: [ ident , each name ]
			ifTrue: [ 
				ident asText , each name asText 
					addAttribute: TextEmphasis italic;
					yourself ] ].! !

!TestRunner methodsFor: 'browsing' stamp: 'NicolaiHess 11/30/2014 16:33'!
browseSelectedTest: aTest
	(aTest class lookupSelector: aTest selector) browse
! !

!TestRunner methodsFor: 'accessing-testing' stamp: 'lr 10/6/2005 19:46'!
errorSelected
	^ errorList indexOf: errorSelected.! !

!TestRunner methodsFor: 'accessing-ui' stamp: 'BernardoContreras 9/25/2014 09:01'!
buttons
	^ #(( 'Run Selected' #runAll 'Run all selected tests' #hasRunnable )
		( 'Run Profiled' #runProfiled 'Run tests and profile' #hasRunnable )
		"( 'Run Coverage' #runCoverage 'Run test and check code coverage' #hasRunnable )"
		( 'Run Failures' #runFailures 'Run all failures' #hasFailures )
		( 'Run Errors' #runErrors 'Run all errors' #hasErrors )
		( 'File out results' #fileOutResults 'File out test results' #hasFailuresOrErrors))! !

!TestRunner methodsFor: 'building' stamp: 'MarcusDenker 6/10/2011 14:11'!
buildFailures
	^ PluggableListMorph new
			on: self 
			list: #failedList
			selected: #failedSelected
			changeSelected: #failedSelected:
			menu: #failureMenu: 
			keystroke: nil.
	
		" do not know how to express
		name: 'Failure List'"! !

!TestRunner methodsFor: 'actions' stamp: 'StephaneDucasse 6/9/2012 23:10'!
debug: aTestCase
	self
		debugSuite:
			(self classForTestSuite new
				addTest: aTestCase;
				yourself)! !

!TestRunner methodsFor: 'building' stamp: 'StephaneDucasse 6/6/2011 20:38'!
buildErrors
	^ PluggableListMorph new
			on: self 
			list: #errorList
			selected: #errorSelected
			changeSelected: #errorSelected:
			menu: #errorMenu: 
			keystroke: nil.
	! !

!TestRunner methodsFor: 'actions' stamp: 'CarloTeixeira 10/24/2011 22:26'!
runAll

	self resetResult.
	self runTestSuites: self allSelectedTestSuites.
	self saveResultInHistory! !

!TestRunner methodsFor: 'building' stamp: 'IgorStasenko 12/20/2012 14:22'!
errorListFrame
	^LayoutFrame new
		leftFraction: 0.5;
		topFraction: 0.5;
		bottomOffset: self buttonHeight negated! !

!TestRunner methodsFor: 'building' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
classesFrame
	^LayoutFrame new
		leftFraction: 0.25;
		topOffset: (Smalltalk ui theme textFont height + 13);
		rightFraction: 0.5;
		bottomOffset: self buttonHeight negated! !

!TestRunner methodsFor: 'accessing-classes' stamp: 'gvc 7/24/2007 11:59'!
selectNoClasses
	"Fixed to update all selections now that the
	selection invalidation has been optimised."
	
	classesSelected := Set new.
	self
		changed: #allSelections;
		changed: #classSelected;
		changed: #hasRunnable! !

!TestRunner methodsFor: 'updating' stamp: 'lr 11/3/2005 09:28'!
updateStatus: aBoolean
	"Update the status display, at most once a second if aBoolean is true."

	(aBoolean and: [ lastUpdate = Time totalSeconds ])
		ifTrue: [ ^ self ].
	self changed: #statusText; changed: #statusColor.
	lastUpdate := Time totalSeconds.! !

!TestRunner methodsFor: 'accessing-classes' stamp: 'lr 1/20/2009 14:46'!
classSelected
	^ classIndex! !

!TestRunner methodsFor: 'history saving' stamp: 'simon.denier 11/13/2008 20:28'!
storeResultIntoTestCases

	result classesTested do: [:testCaseCls | testCaseCls generateLastStoredRunMethod ]
! !

!TestRunner methodsFor: 'factory' stamp: 'lr 10/31/2005 15:31'!
baseClass
	^ TestCase! !

!TestRunner methodsFor: 'building' stamp: 'IgorStasenko 12/20/2012 14:26'!
statusFrame
	^ LayoutFrame new
		leftFraction: 0.5;
		bottomFraction: 0 offset: self statusHeight! !

!TestRunner methodsFor: 'accessing-classes' stamp: 'lr 1/20/2009 14:48'!
classSelected: anInteger
	classIndex := anInteger.
	self changed: #classSelected! !

!TestRunner methodsFor: 'building' stamp: 'MarcusDenker 9/24/2014 15:29'!
categorySearchUpdate: aPattern
	categoryPattern := (aPattern isNil or: [ aPattern trimBoth isEmpty ])
		ifTrue: [ nil ]
		ifFalse: [ [aPattern asRegexIgnoringCase] on: RegexSyntaxError do: [ nil ] ].
	self updateCategories.! !

!TestRunner methodsFor: 'utilities' stamp: 'CamilloBruni 8/16/2011 02:11'!
findClassesForCategories: aCollection
	| items |
	aCollection isEmpty
		ifTrue: [ ^ self baseClass withAllSubclasses asSet ].
	items := aCollection
		gather: [ :category | 
			((Smalltalk organization listAtCategoryNamed: category) 
				collect: [ :each | Smalltalk globals at: each ])
				select: [ :each | each includesBehavior: self baseClass ] ].

	^ items asSet! !

!TestRunner methodsFor: 'accessing-classes' stamp: 'JorgeRessia 3/16/2010 20:24'!
selectAllUnitTests
	classesSelected := classes asSet select: [ :eachClass | eachClass isUnitTest ].
	self
		changed: #allSelections;
		changed: #classSelected;
		changed: #hasRunnable! !

!TestRunner methodsFor: 'accessing-testing' stamp: 'lr 10/8/2005 22:45'!
statusText
	^ result printString.! !

!TestRunner methodsFor: 'actions' stamp: 'lr 3/14/2010 21:13'!
excludeClassesNotUnderTestFrom: methods
	classesSelected
		do: [ :class | 
			(class class includesSelector: #classNamesNotUnderTest)
				ifTrue: [ 
					class classNamesNotUnderTest
						do: [ :className | 
							| theClass |
							theClass := Smalltalk globals classNamed: className.
							theClass
								ifNotNil: [ 
									theClass methods do: [ :each | methods remove: each methodReference ifAbsent: [  ] ].
									theClass class methods do: [ :each | methods remove: each methodReference ifAbsent: [  ] ] ] ] ] ]! !

!TestRunner methodsFor: 'browsing' stamp: 'BenjaminVanRyseghem 1/13/2011 11:31'!
browseSelectedErrorTest

	errorSelected ifNil: [^self].
	self browseSelectedTest: errorSelected! !

!TestRunner methodsFor: 'actions' stamp: 'DamienCassou 1/15/2014 16:51'!
addDeclaredPackagesUnderTestTo: packages 
	classesSelected do: 
		[ :class | 
		(class class includesSelector: #packageNamesUnderTest) ifTrue: 
			[ class packageNamesUnderTest do: [ :name | packages add: (RPackage organizer packageNamed: name) ] ] ]! !

!TestRunner methodsFor: 'history saving' stamp: 'stephane.ducasse 10/12/2008 19:24'!
showHistoryMenu
	| selectionIndex selectedPreviousResult actionIndex |
	selectionIndex := UIManager default chooseFrom: self historyMenuList title: 'History:'.

	"We pressed outside the menu"
	selectionIndex isZero ifTrue: [ ^ self ]. 				

	"save current result is selected"
	selectionIndex = 1 ifTrue: [ self previousRun addFirst: result. ^ self ]. 			

	selectedPreviousResult := self previousRun at: (selectionIndex - 1).
 	actionIndex := (UIManager default chooseFrom: #('delete' 'show diff')  title:  'Action:').
	actionIndex = 1 ifTrue: [ self previousRun remove: selectedPreviousResult. ^ self ].
	actionIndex = 2 ifTrue: [ self showDiffWith: selectedPreviousResult].	! !

!TestRunner methodsFor: 'building' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
categoriesFrame
	^LayoutFrame new
		rightFraction: 0.25;
		topOffset: (Smalltalk ui theme textFont height + 13);
		bottomOffset: self buttonHeight negated! !

!TestRunner methodsFor: 'building' stamp: 'lr 7/27/2011 23:05'!
buttonHeight
	^ self theme buttonMinHeight + 4! !

!TestRunner methodsFor: 'accessing-categories' stamp: 'lr 7/4/2009 15:08'!
selectAllCategories
	categoriesSelected := categories asSet.
	self changed: #allSelections; changed: #categorySelected; updateClasses! !

!TestRunner methodsFor: 'utilities' stamp: 'lr 10/10/2005 08:43'!
sortClass: aFirstClass before: aSecondClass
	| first second |
	first := aFirstClass withAllSuperclasses reversed.
	second := aSecondClass withAllSuperclasses reversed.
	1 to: (first size min: second size) do: [ :index | 
		(first at: index) == (second at: index)
			ifFalse: [ ^ (first at: index) name <= (second at: index) name ] ].
	^ second includes: aFirstClass.! !

!TestRunner methodsFor: 'building' stamp: 'CamilloBruni 8/16/2011 02:06'!
buildClassesSearch
	
	^ SearchMorph new
		model: self;
		updateSelector: #classSearchUpdate:;
		yourself! !

!TestRunner methodsFor: 'accessing-classes' stamp: 'lr 10/8/2005 19:58'!
classAt: anInteger
	^ classesSelected includes: (classes at: anInteger ifAbsent: [ ^ false ]).! !

!TestRunner methodsFor: 'accessing-testing' stamp: 'lr 10/6/2005 15:47'!
result
	^ result! !

!TestRunner methodsFor: 'actions' stamp: 'PabloHerrero 1/4/2014 11:11'!
promptForPackages
	| packages |
	packages := (RPackageOrganizer default packages
				reject: [:package | (package packageName beginsWith: 'Kernel')
						or: [(package packageName beginsWith: 'Collections')
								or: [(package packageName beginsWith: 'Exceptions')
										or: [(package packageName beginsWith: 'SUnit')
												or: [(package packageName beginsWith: 'System')
														or: [package packageName includesSubstring: 'Test' caseSensitive: false]]]]]])
				sort: [:a :b | a packageName < b packageName].
	packages := Array
				with: (UIManager default
						chooseFrom: (packages
								collect: [:package | package packageName])
						values: packages
						title: 'Select Package').
	^ packages! !

!TestRunner methodsFor: 'building' stamp: 'CamilloBruni 8/16/2011 02:07'!
build
	"self new build openInWorld"
	
	| window |
	window := (SystemWindow labelled: self label) model: self; extent: self extent.
	
	window addMorph: self buildCategorySearch fullFrame: self categorySearchFrame.
	window addMorph: self buildCategories fullFrame: self categoriesFrame.
	
	window addMorph: self buildClassesSearch fullFrame: self classesSearchFrame.
	window addMorph: self buildClasses fullFrame: self classesFrame.
	
	window	addMorph: self buildStatus fullFrame: self statusFrame. 
	window	addMorph: self buildFailures fullFrame: self failureListFrame. 
	window	addMorph: self buildErrors fullFrame: self errorListFrame. 
	window	addMorph: self buildButtons fullFrame: self buttonsFrame. 
	^ window
	
	
	! !

!TestRunner methodsFor: 'accessing-testing' stamp: 'lr 10/6/2005 19:47'!
failedSelected
	^ failedList indexOf: failedSelected.! !

!TestRunner methodsFor: 'accessing-menu' stamp: 'StephaneDucasse 10/27/2014 09:34'!
failureMenu: aMenu
	"Add the browse item only if an item is selected"
	
	failedSelected ifNotNil: [aMenu add: 'Browse test' selector: #browseSelectedFailedTest].
	^ aMenu! !

!TestRunner methodsFor: 'building' stamp: 'CamilloBruni 8/16/2011 02:06'!
buildCategorySearch

	^ SearchMorph new
		model: self;
		updateSelector: #categorySearchUpdate:;
		yourself! !

!TestRunner methodsFor: 'actions' stamp: 'CarloTeixeira 10/24/2011 22:30'!
runTestSuites: testSuites 
	testSuites
		do: [:testSuite | self runSuite: testSuite]
		displayingProgress: 'Running Tests'! !

!TestRunner methodsFor: 'accessing' stamp: 'StephaneDucasse 6/9/2012 23:05'!
suiteForAllSelected
	"Return the suite for all the selected test case classes"

	^ self classForTestSuite new
		in: [ :suite | 
			classesSelected
				do: [ :each | 
					each isAbstract
						ifFalse: [ each addToSuiteFromSelectors: suite ] ].
			suite name: (self label: 'Test' forSuite: suite) ]! !

!TestRunner methodsFor: 'browsing' stamp: 'BenjaminVanRyseghem 1/13/2011 11:28'!
browseSelectedFailedTest

	failedSelected ifNil: [^self].
	self browseSelectedTest: failedSelected! !

!TestRunner methodsFor: 'updating' stamp: 'SeanDeNigris 6/21/2012 12:33'!
updateUIBlock
	^ testAnnouncementBlock ifNil: [
		testAnnouncementBlock :=  [ :announcement | self updateStatus: true ] ].! !

!TestRunner methodsFor: 'accessing-testing' stamp: 'lr 10/8/2005 22:37'!
errorList
	^ errorList collect: [ :each | each printString ].! !

!TestRunner methodsFor: 'accessing-testing' stamp: 'lr 10/8/2005 22:37'!
failedList
	^ failedList collect: [ :each | each printString ].! !

!TestRunner methodsFor: 'testing' stamp: 'lr 11/21/2005 13:19'!
hasErrors
	^ result hasErrors.! !

!TestRunner methodsFor: 'accessing-categories' stamp: 'StephaneDucasse 10/27/2014 09:34'!
categoryMenu: aMenu
	^ aMenu
		addTitle: 'Categories';
		add: 'Select all' selector: #selectAllCategories;
		add: 'Select inversion' selector: #selectInverseCategories;
		add: 'Select none' selector: #selectNoCategories;
		addLine;
		add: 'Filter...' selector: #filterCategories;
		addLine;
		add: 'Refresh' selector: #updateCategories;
		yourself.! !

!TestRunner methodsFor: 'building' stamp: 'IgorStasenko 12/20/2012 15:15'!
classesSearchFrame
	^LayoutFrame new
		leftFraction: 0.25;
		rightFraction: 0.5;
		bottomFraction: 0 ;
		bottomOffset: (StandardFonts defaultFont height + 10)! !

!TestRunner methodsFor: 'actions' stamp: 'PabloHerrero 1/4/2014 14:08'!
addMethodsUnderTestIn: packages to: methods 
	packages
		do: [:package | package isNil
				ifFalse: [package methodReferences
						do: [:method | ((#(#packageNamesUnderTest #classNamesNotUnderTest ) includes: method selector)
									or: [method compiledMethod isAbstract
											or: [method compiledMethod refersToLiteral: #ignoreForCoverage]])
								ifFalse: [methods add: method]]]]! !

!TestRunner methodsFor: 'updating' stamp: 'CamilloBruni 8/16/2011 02:11'!
updateClasses
	| classesForCategories |
	classesForCategories := self findClassesForCategories: categoriesSelected.
	
	classPattern ifNotNil: [
		classesForCategories := classesForCategories reject: [:cls| (classPattern matchesIn: cls name) isEmpty ]].
	
	classes := classesForCategories asArray
		sort: [ :a :b | self sortClass: a before: b ].
	classIndex := 0.
	classesSelected := classesSelected isNil
		ifTrue: [ classesForCategories ]
		ifFalse: [ 
			classesSelected
				select: [ :each | classesForCategories includes: each ] ].
	self changed: #classList; 
		changed: #classSelected; 
		changed: #hasRunnable.! !

!TestRunner methodsFor: 'accessing-categories' stamp: 'lr 7/4/2009 15:08'!
selectNoCategories
	categoriesSelected := Set new.
	self changed: #allSelections; changed: #categorySelected; updateClasses! !

!TestRunner methodsFor: 'accessing-classes' stamp: 'gvc 7/24/2007 12:01'!
selectSubclasses
	"Fixed to update all selections now that the
	selection invalidation has been optimised."
	
	| classesForPackages |
	classesForPackages := self findClassesForCategories: categoriesSelected.	
	classesSelected := (classesSelected gather: [ :class |
		class withAllSubclasses select: [ :each |
			classesForPackages includes: each ] ])
		asSet.
	self
		changed: #allSelections;
		changed: #classSelected;
		changed: #hasRunnable! !

!TestRunner methodsFor: 'accessing' stamp: 'StephaneDucasse 6/9/2012 23:05'!
errorTestSuites
	^ errorList
		collect: [ :each | 
			self classForTestSuite new
				in: [ :suite | 
							suite
								addTest: each;
								name: (self label: 'Error' forSuite: suite) ];
				yourself ]! !

!TestRunner methodsFor: 'testing' stamp: 'LaurentLaffont 5/23/2010 08:19'!
hasFailuresOrErrors
	^ result hasFailures | result hasErrors.! !

!TestRunner methodsFor: 'accessing-testing' stamp: 'lr 10/6/2005 20:14'!
failedSelected: anInteger
	failedSelected := failedList at: anInteger ifAbsent: nil.
	self changed: #failedSelected.
	failedSelected ifNotNil: [ self debug: failedSelected ].! !

!TestRunner methodsFor: 'testing' stamp: 'lr 11/21/2005 13:19'!
hasFailures
	^ result hasFailures.! !

!TestRunner methodsFor: 'building' stamp: 'lr 7/27/2011 23:01'!
statusHeight
	^ self theme textFont height * 4! !

!TestRunner methodsFor: 'accessing-testing' stamp: 'lr 10/8/2005 22:47'!
result: aResult
	result := aResult! !

!TestRunner class methodsFor: 'instance-creation' stamp: 'zork 6/5/2011 12:31'!
open
	^ self new open! !

!TestRunner class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
taskbarIcon
	"Answer the icon for the receiver in a task bar."

	^ Smalltalk ui icons iconNamed: #testRunnerIcon! !

!TestRunner class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
theme
	^ Smalltalk ui theme! !

!TestRunner class methodsFor: 'initialization' stamp: 'MarcusDenker 12/3/2012 18:18'!
registerToolsOn: registry

	"Add ourselves to registry. See [Smalltalk tools]" 
	registry register: self as: #testRunner! !

!TestSharedPool commentStamp: 'MartinDias 1/31/2014 15:50'!
I am a shared pool used for testing.!
!TestSharedPool class methodsFor: 'class initialization' stamp: 'MartinDias 8/7/2012 02:06'!
initialize
	One := 1! !

!TestSkip commentStamp: '<historical>'!
I mark a test as being skipped.!
!TestSkip methodsFor: 'exception handling' stamp: 'CamilloBruni 8/24/2012 16:38'!
sunitAnnounce: aTestCase toResult: aTestResult
	aTestResult addSkip: aTestCase.! !

!TestSkip methodsFor: 'exception handling' stamp: 'CamilloBruni 10/20/2012 22:22'!
defaultAction
	"nothing to do.
	If I am not handled I might trigger an Assertion failure later on."! !

!TestSuite commentStamp: '<historical>'!
This is a Composite of Tests, either TestCases or other TestSuites. The top-level protocol is #run.  This creates aTestResult and sends
	self run: aTestResult.
then ensures that any TestResources made available during the run are reset.  These, and the dependencies protocol, are common between this and TestCase.!
!TestSuite methodsFor: 'running' stamp: 'StephaneDucasse 12/28/2014 11:33'!
resourceClass

	^ TestResource! !

!TestSuite methodsFor: 'running' stamp: 'StephaneDucasse 6/9/2012 22:49'!
resultClass

	^ TestAsserter classForTestResult! !

!TestSuite methodsFor: 'accessing' stamp: 'BaseSystem 8/30/2009 09:35'!
resources
	resources isNil ifTrue: [resources := self defaultResources].
	^resources! !

!TestSuite methodsFor: 'accessing' stamp: 'BaseSystem 8/30/2009 09:35'!
defaultResources
	^self tests
		inject: OrderedCollection new
		into:
			[:coll :testCase |
			testCase resources do:
				[:each |
				(coll includes: each) ifFalse: [coll add: each]].
			coll]! !

!TestSuite methodsFor: 'announcements' stamp: 'SantiagoBragagnolo 4/30/2012 14:43'!
unsubscribe: anAnnouncementClass 
	self testSuiteAnnouncer unsubscribe: anAnnouncementClass.! !

!TestSuite methodsFor: 'dependencies' stamp: 'md 2/22/2006 14:24'!
addDependentToHierachy: anObject
	self addDependent: anObject.
	self tests do: [ :each | each addDependentToHierachy: anObject]
			! !

!TestSuite methodsFor: 'running' stamp: 'SantiagoBragagnolo 4/29/2012 20:54'!
tearDown
	self resourceClass resetResources: self resources.! !

!TestSuite methodsFor: 'running' stamp: 'SantiagoBragagnolo 4/29/2012 20:58'!
run
	| result |
	result := self resultClass new.
	self run: result.
	^result! !

!TestSuite methodsFor: 'accessing' stamp: 'BaseSystem 8/30/2009 09:35'!
addTest: aTest
	self tests add: aTest! !

!TestSuite methodsFor: 'accessing' stamp: 'BaseSystem 8/30/2009 09:35'!
resources: someOrderedTestResourceClasses
	"The parameter should understand reverseDo: and should not contain duplicates."

	resources := someOrderedTestResourceClasses! !

!TestSuite methodsFor: 'announcements' stamp: 'SantiagoBragagnolo 4/30/2012 14:25'!
announceTest: aTest
	^ self testSuiteAnnouncer announce: (TestAnnouncement with: aTest).! !

!TestSuite methodsFor: 'running' stamp: ''!
setUp
	self resources  do: [ :each |
			each isAvailable ifFalse: [ each signalInitializationError ]
		].! !

!TestSuite methodsFor: 'accessing' stamp: 'BaseSystem 8/30/2009 09:35'!
addTests: aCollection 
	aCollection do: [:eachTest | self addTest: eachTest]! !

!TestSuite methodsFor: 'dependencies' stamp: 'md 2/22/2006 14:24'!
removeDependentFromHierachy: anObject
	self removeDependent: anObject.
	self tests do: [ :each | each removeDependentFromHierachy: anObject]
			! !

!TestSuite methodsFor: 'running' stamp: 'StephaneDucasse 12/28/2014 12:07'!
run: aResult
	self setUp.
	[ self tests
		do: [ :each | 
			each run: aResult.
			self announceTest: each.
			self changed: each ] ]
		ensure: [ self tearDown ]! !

!TestSuite methodsFor: 'accessing' stamp: 'BaseSystem 8/30/2009 09:35'!
name: aString

	name := aString! !

!TestSuite methodsFor: 'running' stamp: 'SantiagoBragagnolo 4/30/2012 14:22'!
debug
	self setUp.
	[
		self tests do: [:each | 
					each debug.
					self announceTest: each.
					self changed: each.
		]
	] ensure:[ 
		self tearDown. 
	].

! !

!TestSuite methodsFor: 'accessing' stamp: 'BaseSystem 8/30/2009 09:35'!
tests
	tests isNil ifTrue: [tests := OrderedCollection new].
	^tests! !

!TestSuite methodsFor: 'announcements' stamp: 'SantiagoBragagnolo 4/30/2012 14:21'!
subscribe: aAnnouncement do: aBlock
	self testSuiteAnnouncer subscribe: aAnnouncement do: aBlock! !

!TestSuite methodsFor: 'accessing' stamp: 'BaseSystem 8/30/2009 09:35'!
name

	^name! !

!TestSuite methodsFor: 'announcements' stamp: 'GuillermoPolito 4/30/2012 20:31'!
testSuiteAnnouncer
	announcer ifNil:[ announcer := Announcer new.].
	^ announcer.! !

!TestSuite class methodsFor: 'instance creation' stamp: 'BaseSystem 8/30/2009 09:35'!
named: aString

	^self new
		name: aString;
		yourself! !

!TestSuiteEnded commentStamp: '<historical>'!
This announcment is thrown when a test suite just finished (more precisly when hisoties are updated)!
!TestSuiteEnded class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 10/2/2011 17:02'!
result: aResult

	^ self new
		testResult: aResult;
		yourself! !

!TestValueWithinFix methodsFor: 'tests' stamp: 'ar 12/4/2012 20:35'!
testValueWithinTimingNestedOuter
	"Test nested timing of valueWithin:onTimeout:"
	| time |
	time := [
		[
			3 timesRepeat: [
				[5 seconds asDelay wait]
					valueWithin: 100 milliSeconds onTimeout: []]
		] valueWithin: 150 milliSeconds onTimeout: []
	] durationToRun.
	self assert: time > 100 milliSeconds.
	self assert: time < 200 milliSeconds.
	! !

!TestValueWithinFix methodsFor: 'tests' stamp: 'MarcusDenker 3/5/2013 10:45'!
testValueWithinTimingRepeat
	"Test timing of valueWithin:onTimeout:"
	| time |
	time := [
		3 timesRepeat: [
			[500 milliSeconds asDelay wait]
				valueWithin: 100 milliSeconds onTimeout: []]
	] durationToRun.
	self assert: time < 450 milliSeconds.
! !

!TestValueWithinFix methodsFor: 'tests' stamp: 'ar 8/17/2007 13:37'!
valueWithinNonLocalReturn
	"Do a non-local return from a valueWithin: block"
	[^self] valueWithin: 20 milliSeconds onTimeout:[].
! !

!TestValueWithinFix methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:23'!
testValueWithinNonLocalReturnFixSimply
	"self run: #testValueWithinNonLocalReturnFixSimply"

	"The simple version to test the fix"

	self valueWithinNonLocalReturn.
	(Delay forMilliseconds: 50) wait! !

!TestValueWithinFix methodsFor: 'tests' stamp: 'nice 1/5/2010 15:59'!
testValueWithinNonLocalReturnFixReal
	"self run: #testValueWithinNonLocalReturnFixReal"
	"The real test for the fix is just as obscure as the original problem"
	| startTime |
	self valueWithinNonLocalReturn.
	startTime := Time millisecondClockValue.
	[[] repeat] valueWithin: 100 milliSeconds onTimeout:[ | deltaTime |
		"This *should* timeout after 100 msecs but the pending process from
		the previous invokation will signal timeout after 20 msecs already
		which will in turn cut this invokation short."
		deltaTime := Time millisecondClockValue - startTime.
		self deny: deltaTime < 90.
	].
! !

!TestValueWithinFix methodsFor: 'tests' stamp: 'ar 12/4/2012 20:35'!
testValueWithinTimingBasic
	"Test timing of valueWithin:onTimeout:"
	| time |
	time := [
		[1000 milliSeconds asDelay wait]
			valueWithin: 100 milliSeconds onTimeout: []
	] durationToRun.
	self assert: time < 150 milliSeconds.! !

!TestValueWithinFix methodsFor: 'tests' stamp: 'ar 12/4/2012 20:35'!
testValueWithinTimingNestedInner
	"Test nested timing of valueWithin:onTimeout:"
	| time |
	time := [
		[
			[5 seconds asDelay wait]
				valueWithin: 100 milliSeconds onTimeout: []
		] valueWithin: 500 milliSeconds onTimeout: []
	] durationToRun.
	self assert: time < 150 milliSeconds.
! !

!TestingComposableModel commentStamp: '<historical>'!
A TestingComposableModel is a stupid composable model used to test SpecInterpreter!
!TestingComposableModel methodsFor: 'as yet unclassified' stamp: 'BenjaminVanRyseghem 12/12/2012 14:29'!
list

	^ list! !

!TestingComposableModel methodsFor: 'as yet unclassified' stamp: 'BenjaminVanRyseghem 9/25/2013 18:24'!
initializeWidgets 

	self instantiateModels: #(list #ListModel)! !

!TestingComposableModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 12/12/2012 14:28'!
defaultSpec
	<spec>

	^ SpecLayout composed
		add: #list;
		yourself! !

!TestingComposableModel class methodsFor: 'specs' stamp: ''!
title

	^ 'You should not see me !!'! !

!TestingComposableModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/4/2013 14:46'!
testingSpec

	^ {#PluggableTextMorph.
		#model:.	#model}.! !

!Text commentStamp: '<historical>'!
I represent a character string that has been marked with abstract changes in character appearance. Actual display is performed in the presence of a TextStyle which indicates, for each abstract code, an actual font to be used.  A Text associates a set of TextAttributes with each character in its character string.  These attributes may be font numbers, emphases such as bold or italic, or hyperling actions.  Font numbers are interpreted relative to whatever textStyle appears, along with the text, in a Paragraph.  Since most characters have the same attributes as their neighbors, the attributes are stored in a RunArray for efficiency.  Each of my instances has
	string		a String
	runs		a RunArray!
!Text methodsFor: 'copying' stamp: 'marcus.denker 7/24/2009 16:48'!
copyFrom: start to: stop 
	"Answer a copied subrange of the receiver."

	| realStart realStop |
	stop > self size
		ifTrue: [realStop := self size]		"handle selection at end of string"
		ifFalse: [realStop := stop].
	start < 1
		ifTrue: [realStart := 1]			"handle selection before start of string"
		ifFalse: [realStart := start].
	^self class 
		string: (string copyFrom: realStart to: realStop)
		runs: (runs copyFrom: realStart to: realStop)! !

!Text methodsFor: '*Morphic-Base' stamp: 'gm 2/15/2003 14:59'!
embeddedMorphs
	"return the list of morphs embedded in me"

	| morphs |
	morphs := IdentitySet new.
	runs withStartStopAndValueDo: 
			[:start :stop :attribs | 
			attribs 
				do: [:attrib | attrib anchoredMorph ifNotNil: [morphs add: attrib anchoredMorph]]].
	^morphs select: [:m | m isMorph]! !

!Text methodsFor: 'emphasis' stamp: 'di 11/10/97 13:36'!
find: attribute
	"Return the first interval over which this attribute applies"
	| begin end |
	begin := 0.
	runs withStartStopAndValueDo:
		[:start :stop :attributes |
		(attributes includes: attribute)
			ifTrue: [begin = 0 ifTrue: [begin := start].
					end := stop]
			ifFalse: [begin > 0 ifTrue: [^ begin to: end]]].
	begin > 0 ifTrue: [^ begin to: end].
	^ nil! !

!Text methodsFor: 'emphasis' stamp: 'ar 12/17/2001 01:17'!
attributesAt: characterIndex do: aBlock
	"Answer the code for characters in the run beginning at characterIndex."
	"NB: no senders any more (supplanted by #attributesAt:forStyle: but retained for the moment in order not to break user code that may exist somewhere that still calls this"
	self size = 0 ifTrue:[^self].
	(runs at: characterIndex) do: aBlock! !

!Text methodsFor: 'converting' stamp: ''!
asText	
	"Answer the receiver itself."

	^self! !

!Text methodsFor: 'emphasis' stamp: ''!
fontNumberAt: characterIndex 
	"Answer the fontNumber for characters in the run beginning at characterIndex."
	| attributes fontNumber |
	self size = 0 ifTrue: [^1].	"null text tolerates access"
	attributes := runs at: characterIndex.
	fontNumber := 1.
	attributes do: [:att | (att isMemberOf: TextFontChange) ifTrue: [fontNumber := att fontNumber]].
	^ fontNumber
	! !

!Text methodsFor: 'accessing' stamp: ''!
findString: aString startingAt: start 
	"Answer the index of subString within the receiver, starting at index 
	start. If the receiver does not contain subString, answer 0."

	^string findString: aString asString startingAt: start! !

!Text methodsFor: 'paragraph support' stamp: 'JuanVuletich 10/13/2010 09:27'!
encompassLine: anInterval
	^string encompassLine: anInterval! !

!Text methodsFor: '*Morphic-Base-Converting' stamp: 'nk 2/26/2004 13:32'!
asMorph
	^ self asTextMorph! !

!Text methodsFor: 'emphasis' stamp: 'JuanVuletich 10/19/2010 17:48'!
attributesAt: characterIndex 
	"Answer the code for characters in the run beginning at characterIndex."
	"NB: no senders any more (supplanted by #attributesAt:forStyle: but retained for the moment in order not to break user code that may exist somewhere that still calls this"
	| attributes |
"	self size = 0
		ifTrue: [^ Array with: (TextFontChange new fontNumber: 1)]."
	self size = 0 ifTrue: [ ^#()].
	attributes := runs at: characterIndex.
	^ attributes! !

!Text methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/23/2015 09:23'!
spotterPreviewCodeIn: aComposite
	<spotterPreview: 10>
	^ aComposite text
		title: 'Contents';
		display: [ :item | item asString contractTo: 100 ];
		entity: self! !

!Text methodsFor: 'accessing' stamp: 'BG 6/8/2003 16:18'!
rangeOf: attribute startingAt: index
"Answer an interval that gives the range of attribute at index position  index. An empty interval with start value index is returned when the attribute is not present at position index.  "
   ^string size = 0
      ifTrue: [index to: index - 1]
	 ifFalse: [runs rangeOf: attribute startingAt: index]! !

!Text methodsFor: 'converting' stamp: ''!
asString
	"Answer a String representation of the textual receiver."

	^string! !

!Text methodsFor: 'emphasis' stamp: 'BenjaminVanRyseghem 11/24/2012 16:54'!
makeAllColor: color
	| attribute |
	attribute := TextColor color: color.

	^ self addAttribute: attribute from: 1 to: self size! !

!Text methodsFor: 'emphasis' stamp: ''!
addAttribute: att 
	^ self addAttribute: att from: 1 to: self size! !

!Text methodsFor: '*Polymorph-Widgets' stamp: 'MarcusDenker 7/17/2014 09:34'!
treeRenderOn: aCanvas bounds: drawBounds color: drawColor font: aFont from: aMorph

	"Method extracted from LazyListMorph"
	| attrs useDefaultFont f itemBounds |
	
	attrs := self attributesAt: 1.
	useDefaultFont := true.
	attrs
		do: [:att | att
				forFontInStyle: TextStyle default
				do: [:fon | useDefaultFont := false]].
	f := useDefaultFont
				ifTrue: [ aMorph font ]
				ifFalse: [ self fontAt: 1 withStyle: TextStyle default ].
	itemBounds := drawBounds  withHeight: f height.
	itemBounds := itemBounds align: itemBounds leftCenter with: drawBounds  leftCenter.
	"center the item if the font height is different to that of our font"
	aCanvas
		drawString: self
		in: itemBounds
		font: (f emphasized: (self emphasisAt: 1))
		color: drawColor 
		underline: ((self emphasisAt: 1)
				bitAnd: 4)
				> 0
		underlineColor: drawColor 
		strikethrough: ((self emphasisAt: 1)
				bitAnd: 16)
				> 0
		strikethroughColor: drawColor ! !

!Text methodsFor: 'accessing' stamp: 'nice 2/24/2012 01:00'!
runs: anArray
	anArray size = string size
		ifFalse:
			[^self error: 'Some code is setting text attributes length not matching the string size'].
	runs := anArray! !

!Text methodsFor: 'copying' stamp: 'BG 6/12/2003 13:11'!
copyReplaceFrom: start to: stop with: aTextOrString

	| txt |
	txt := aTextOrString asText.	"might be a string"
	^self class 
             string: (string copyReplaceFrom: start to: stop with: txt string)
             runs: (runs copyReplaceFrom: start to: stop with: txt runs)
! !

!Text methodsFor: '*Polymorph-Widgets' stamp: 'BenjaminVanRyseghem 6/24/2012 23:28'!
heightToDisplayInTree: aTree

	^ aTree fontToUse height! !

!Text methodsFor: '*Network-Url' stamp: 'ls 7/14/1998 03:17'!
asUrl
	^self asString asUrl! !

!Text methodsFor: 'emphasis' stamp: 'sw 12/7/1999 10:58'!
fontAt: characterIndex withStyle: aTextStyle
	"Answer the fontfor characters in the run beginning at characterIndex."
	| attributes font |
	self size = 0 ifTrue: [^ aTextStyle defaultFont].	"null text tolerates access"
	attributes := runs at: characterIndex.
	font := aTextStyle defaultFont.  "default"
	attributes do: 
		[:att | att forFontInStyle: aTextStyle do: [:f | font := f]].
	^ font! !

!Text methodsFor: '*Morphic-Base' stamp: 'gm 2/15/2003 14:59'!
embeddedMorphsFrom: start to: stop 
	"return the list of morphs embedded in me"

	| morphs |
	morphs := IdentitySet new.
	runs 
		runsFrom: start
		to: stop
		do: 
			[:attribs | 
			attribs 
				do: [:attr | attr anchoredMorph ifNotNil: [morphs add: attr anchoredMorph]]].
	^morphs select: [:m | m isMorph]! !

!Text methodsFor: 'private' stamp: ''!
setString: aString setRuns: anArray

	string := aString.
	runs := anArray! !

!Text methodsFor: 'emphasis' stamp: ''!
allBold 
	"Force this whole text to be bold."
	string size = 0 ifTrue: [^self].
	self makeBoldFrom: 1 to: string size! !

!Text methodsFor: 'accessing' stamp: ''!
at: index put: character

	^string at: index put: character! !

!Text methodsFor: 'copying' stamp: 'nice 10/5/2009 08:53'!
postCopy
	super postCopy.
	string := string copy.
	runs := runs copy! !

!Text methodsFor: 'emphasis' stamp: 'JuanVuletich 10/13/2010 09:37'!
fontAt: characterIndex
	^self fontAt: characterIndex withStyle: TextStyle default! !

!Text methodsFor: 'accessing' stamp: 'ar 12/27/2001 00:03'!
prepend: stringOrText

	self replaceFrom: 1 to: 0 with: stringOrText! !

!Text methodsFor: 'emphasis' stamp: 'BenjaminVanRyseghem 11/24/2012 16:54'!
makeColor: color from: start to: stop
	| attribute |
	attribute := TextColor color: color.

	^ self addAttribute: attribute from: start to: stop! !

!Text methodsFor: 'paragraph support' stamp: 'JuanVuletich 10/13/2010 09:14'!
encompassParagraph: anInterval

	^string encompassParagraph: anInterval! !

!Text methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 12/21/2013 22:45'!
gtInspectorItemsIn: composite
	"No items presentation for a Text"! !

!Text methodsFor: 'converting' stamp: 'dvf 10/1/2003 02:58'!
replaceFrom: start to: stop with: replacement startingAt: repStart 
 	"This destructively replaces elements from start to stop in the receiver starting at index, repStart, in replacementCollection. Do it to both the string and the runs."
 
 	| rep newRepRuns |
 	rep := replacement asText.	"might be a string"
 	string replaceFrom: start to: stop with: rep string startingAt: repStart.
 	newRepRuns := rep runs copyFrom: repStart to: repStart + stop - start.
	runs := runs copyReplaceFrom: start to: stop with: newRepRuns! !

!Text methodsFor: '*Morphic-Base-Converting' stamp: 'nk 2/26/2004 13:31'!
asStringMorph
	^ StringMorph
		contents: self string
		font: (self fontAt: 1 withStyle: TextStyle default)
		emphasis: (self emphasisAt: 1)! !

!Text methodsFor: 'converting' stamp: 'MarcusDenker 1/18/2014 13:52'!
withSqueakLineEndings
	"Answer a copy of myself in which all sequences of <CR><LF> or <LF> have been changed to <CR>"
	| newText |
	(string includes: Character lf) ifFalse: [ ^self copy ].
	newText := self copyReplaceAll: String crlf with: String cr.
	(newText asString includes: Character lf) ifFalse: [ ^newText ].
	^newText copyReplaceAll: String lf with: String cr.! !

!Text methodsFor: 'emphasis' stamp: ''!
runLengthFor: characterIndex 
	"Answer the count of characters remaining in run beginning with 
	characterIndex."

	^runs runLengthAt: characterIndex! !

!Text methodsFor: '*Polymorph-Widgets' stamp: 'BenjaminVanRyseghem 6/24/2012 22:42'!
widthToDisplayInTree: aTree

	^ aTree fontToUse widthOfStringOrText: self contents! !

!Text methodsFor: 'accessing' stamp: 'JuanVuletich 10/13/2010 10:07'!
initialStyle
	^TextStyle default! !

!Text methodsFor: 'converting' stamp: 'nice 1/5/2010 15:59'!
removeAttributesThat: removalBlock replaceAttributesThat: replaceBlock by: convertBlock
	"Enumerate all attributes in the receiver. Remove those passing removalBlock and replace those passing replaceBlock after converting it through convertBlock"
	| added removed |
	"Deliberately optimized for the no-op default."
	added := removed := nil.
	runs withStartStopAndValueDo: [ :start :stop :attribs | 
		attribs do: [ :attrib | | new |
			(removalBlock value: attrib) ifTrue:[
				removed ifNil:[removed := Array new writeStream].
				removed nextPut: {start. stop. attrib}.
			] ifFalse:[
				(replaceBlock value: attrib) ifTrue:[
					removed ifNil:[removed := Array new writeStream].
					removed nextPut: {start. stop. attrib}.
					new := convertBlock value: attrib.
					added ifNil:[added := Array new writeStream].
					added nextPut: {start. stop. new}.
				].
			].
		].
	].
	(added isNil and:[removed isNil]) ifTrue:[^self].
	"otherwise do the real work"
	removed ifNotNil:[removed contents do:[:spec|
		self removeAttribute: spec last from: spec first to: spec second]].
	added ifNotNil:[added contents do:[:spec|
		self addAttribute: spec last from: spec first to: spec second]].! !

!Text methodsFor: 'comparing' stamp: 'tk 9/6/2000 11:59'!
howManyMatch: aString

	^ self string howManyMatch: aString! !

!Text methodsFor: 'accessing' stamp: ''!
string
	"Answer the string representation of the receiver."

	^string! !

!Text methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 2/12/2015 17:53'!
asBrick

	^ self asString asBrick! !

!Text methodsFor: '*Morphic-Base-Widgets' stamp: 'MarcusDenker 9/13/2013 16:22'!
listRenderOn: aCanvas atRow: aRow bounds: bounds color: color backgroundColor: backgroundColor from: aMorph
	"Method extracted from LazyListMorph"
	| attrs useDefaultFont f itemBounds |
	
	attrs := self attributesAt: 1.
	useDefaultFont := true.
	attrs
		do: [:att | att
				forFontInStyle: aMorph font textStyle
				do: [:fon | useDefaultFont := false]].
	f := useDefaultFont
				ifTrue: [ aMorph font]
				ifFalse: [ self fontAt: 1 withStyle: aMorph font textStyle ].
	itemBounds := bounds withHeight: f height.
	itemBounds := itemBounds align: itemBounds leftCenter with: bounds leftCenter.
	"center the item if the font height is different to that of our font"
	aCanvas
		drawString: self
		in: itemBounds
		font: (f emphasized: (self emphasisAt: 1))
		color: color
		underline: ((self emphasisAt: 1)
				bitAnd: 4)
				> 0
		underlineColor: color
		strikethrough: ((self emphasisAt: 1)
				bitAnd: 16)
				> 0
		strikethroughColor: color! !

!Text methodsFor: 'converting' stamp: 'RAA 5/28/2001 06:19'!
asStringOrText	
	"Answer the receiver itself."

	^self! !

!Text methodsFor: 'converting' stamp: 'BG 6/8/2003 16:38'!
reversed
 
 	"Answer a copy of the receiver with element order reversed."
 
 	^ self class string: string reversed runs: runs reversed.
 
   "  It is assumed that  self size = runs size  holds. "! !

!Text methodsFor: 'accessing' stamp: ''!
at: index

	^string at: index! !

!Text methodsFor: 'printing' stamp: 'sma 6/1/2000 09:49'!
printOn: aStream
	self printNameOn: aStream.
	aStream nextPutAll: ' for '; print: string! !

!Text methodsFor: 'emphasis' stamp: 'nice 2/24/2012 01:09'!
removeAttribute: att from: start to: stop 
	"Remove the attribute over the interval start to stop."
	self runs: (runs copyReplaceFrom: start to: stop
			with: ((runs copyFrom: start to: stop)
				mapValues:
				[:attributes | attributes copyWithout: att]))
! !

!Text methodsFor: 'emphasis' stamp: 'jannik.laval 2/4/2010 15:23'!
emphasisAt: characterIndex
	"Answer the fontfor characters in the run beginning at characterIndex."
	| attributes |
	self size = 0 ifTrue: [^ 0].	"null text tolerates access"
	attributes := runs at: characterIndex.
	^attributes inject: 0 into:
		[:emph :att | emph bitOr: att emphasisCode].! !

!Text methodsFor: 'accessing' stamp: 'di 11/23/1998 11:53'!
findString: aString startingAt: start caseSensitive: caseSensitive
	"Answer the index of subString within the receiver, starting at index 
	start. If the receiver does not contain subString, answer 0."

	^string findString: aString asString startingAt: start caseSensitive: caseSensitive! !

!Text methodsFor: '*Morphic-Base-Converting' stamp: 'nk 2/26/2004 13:32'!
asTextMorph
	^ TextMorph new contentsAsIs: self! !

!Text methodsFor: 'emphasis' stamp: 'JuanVuletich 10/13/2010 09:47'!
removeAttribute: att 
	^ self removeAttribute: att from: 1 to: self size! !

!Text methodsFor: 'private' stamp: ''!
runs

	^runs! !

!Text methodsFor: 'testing' stamp: 'HenrikSperreJohansen 9/1/2009 00:38'!
hasWideCharacterFrom: start to: stop
	^string hasWideCharacterFrom: start to: stop! !

!Text methodsFor: 'converting' stamp: ''!
asNumber
	"Answer the number created by interpreting the receiver as the textual 
	representation of a number."

	^string asNumber! !

!Text methodsFor: 'accessing' stamp: ''!
size

	^string size! !

!Text methodsFor: 'accessing' stamp: 'tk 12/30/97 07:17'!
replaceFrom: start to: stop with: aText

	| txt |
	txt := aText asText.	"might be a string"
	string := string copyReplaceFrom: start to: stop with: txt string.
	runs := runs copyReplaceFrom: start to: stop with: txt runs! !

!Text methodsFor: 'printing' stamp: ''!
storeOn: aStream

	aStream nextPutAll: '(Text string: ';
		store: string;
		nextPutAll: ' runs: ';
		store: runs;
		nextPut: $)! !

!Text methodsFor: 'copying' stamp: 'di 11/9/97 17:13'!
deepCopy

	^ self copy "Both string and runs are assumed to be read-only"! !

!Text methodsFor: 'comparing' stamp: 'tk 10/17/2001 14:12'!
hash
	"#hash is implemented, because #= is implemented.  We are now equal to a string with the same characters.  Hash must reflect that."

	^ string hash! !

!Text methodsFor: '*Morphic-Base-Widgets' stamp: 'BenjaminVanRyseghem 2/12/2012 00:21'!
widthToDisplayInList: aList

	^ aList font widthOfStringOrText: self contents! !

!Text methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 8/13/2014 23:30'!
gtInspectorTextIn: composite
	<gtInspectorPresentationOrder: -10>  
	 composite text
		title: 'Text';
		format: self! !

!Text methodsFor: 'attributes' stamp: 'AlainPlantec 1/7/2010 22:47'!
unembellished 
	"Return true if the only emphases are the default font and bold"
	| font1 bold |
	font1 := TextFontChange defaultFontChange.
	bold := TextEmphasis bold.
	runs withStartStopAndValueDo:
		[:start :stop :emphArray |
		emphArray do:
			[:emph | (font1 = emph or: [bold = emph]) ifFalse: [^ false]]].
	^ true! !

!Text methodsFor: 'copying' stamp: 'MarcusDenker 1/18/2014 14:12'!
copyReplaceTokens: oldSubstring with: newSubstring 
	"Replace all occurrences of oldSubstring that are surrounded
	by non-alphanumeric characters"
	^ (self string copyReplaceAll: oldSubstring with: newSubstring asTokens: true) asText
	"'File asFile Files File''s File' copyReplaceTokens: 'File' with: 'Snick'"! !

!Text methodsFor: 'comparing' stamp: 'tk 10/19/2001 17:48'!
= other
	"Am I equal to the other Text or String?  
	***** Warning ***** Two Texts are considered equal if they have the same characters in them.  They might have completely different emphasis, fonts, sizes, text actions, or embedded morphs.  If you need to find out if one is a true copy of the other, you must do (text1 = text2 and: [text1 runs = text2 runs])."

	other isText ifTrue:	["This is designed to run fast even for megabytes"
				^ string == other string or: [string = other string]].
	other isString ifTrue: [^ string == other or: [string = other]].
	^ false! !

!Text methodsFor: 'accessing' stamp: 'tk 9/6/2000 12:33'!
lineCount

	^ string lineCount! !

!Text methodsFor: 'private' stamp: 'MarcusDenker 10/24/2010 17:02'!
setString: aString setRunsChecking: aRunArray
	"Check runs and do the best you can to make them fit..."

	string := aString.
	"check the runs"
	aRunArray ifNil: [^ aString asText].
	(aRunArray isKindOf: RunArray) ifFalse: [^ aString asText].
	aRunArray runs size = aRunArray values size ifFalse: [^ aString asText].
	aRunArray size = aString size ifFalse: [^ aString asText].
	
	runs := aRunArray.! !

!Text methodsFor: 'emphasis' stamp: 'StephaneDucasse 9/4/2010 13:34'!
alignmentAt: characterIndex ifAbsent: aBlock
	| attributes emph |
	self size = 0 ifTrue: [^aBlock value].
	emph := nil.
	attributes := runs at: characterIndex.
	attributes do:[:att | (att isKindOf: TextAlignment) ifTrue: [emph := att]].
	^ emph ifNil: aBlock ifNotNil: [emph alignment]! !

!Text methodsFor: 'converting' stamp: 'ar 4/12/2005 17:32'!
asOctetStringText

	string class == WideString ifTrue: [
		^ self class string: string asOctetString runs: self runs copy.
	].
	^self.
! !

!Text methodsFor: 'emphasis' stamp: ''!
makeBoldFrom: start to: stop

	^ self addAttribute: TextEmphasis bold from: start to: stop! !

!Text methodsFor: '*Morphic-Base-Pluggable Widgets' stamp: 'BenjaminVanRyseghem 2/12/2012 17:09'!
beginsWith: aString fromList: aMorph

	^ self asString beginsWith: aString fromList: aMorph! !

!Text methodsFor: 'comparing' stamp: ''!
isText
	^ true! !

!Text methodsFor: 'emphasis' stamp: 'nice 2/24/2012 01:09'!
addAttribute: att from: start to: stop 
	"Set the attribute for characters in the interval start to stop."
	self runs: (runs copyReplaceFrom: start to: stop
			with: ((runs copyFrom: start to: stop)
				mapValues:
				[:attributes | Text addAttribute: att toArray: attributes]))
! !

!Text methodsFor: 'emphasis' stamp: 'sw 12/7/1999 11:32'!
attributesAt: characterIndex forStyle: aTextStyle
	"Answer the code for characters in the run beginning at characterIndex."
	| attributes |
	self size = 0
		ifTrue: [^ Array with: (TextFontChange new fontNumber: aTextStyle defaultFontIndex)].  "null text tolerates access"
	attributes := runs at: characterIndex.
	^ attributes! !

!Text methodsFor: '*Morphic-Base-Widgets' stamp: 'BenjaminVanRyseghem 7/25/2012 11:43'!
heightToDisplayInList: aList

	^ aList font height! !

!Text methodsFor: 'accessing' stamp: 'tk 9/4/2000 16:04'!
append: stringOrText

	self replaceFrom: string size + 1
				to: string size with: stringOrText! !

!Text class methodsFor: 'instance creation' stamp: ''!
new: stringSize

	^self fromString: (String new: stringSize)! !

!Text class methodsFor: 'initialization' stamp: 'MarcusDenker 9/30/2012 10:52'!
initialize	"Text initialize"
	"Initialize constants shared by classes associated with text display."

	TextSharedInformation at: #CaretForm put:
				(Form extent: 16@5
					fromArray: #(2r001100e26 2r001100e26 2r011110e26 2r111111e26 2r110011e26)
					offset: -3@0).! !

!Text class methodsFor: 'instance creation' stamp: 'rbb 3/1/2005 11:18'!
fromUser
	"Answer an instance of me obtained by requesting the user to type a string."
	"Text fromUser"

	^ self fromString:
		(UIManager default request: 'Enter text followed by carriage return')
! !

!Text class methodsFor: 'instance creation' stamp: ''!
string: aString attribute: att
	"Answer an instance of me whose characters are aString.
	att is a TextAttribute."

	^self string: aString attributes: (Array with: att)! !

!Text class methodsFor: 'instance creation' stamp: ''!
string: aString attributes: atts
	"Answer an instance of me whose characters are those of aString.
	atts is an array of TextAttributes."

	^self string: aString runs: (RunArray new: aString size withAll: atts)! !

!Text class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:07'!
gtExampleSimple
	<gtExample: 'Simple'>
	^ 'fourtytwo' asText! !

!Text class methodsFor: 'private' stamp: 'di 10/31/97 11:22'!
addAttribute: att toArray: others 
	"Add a new text attribute to an existing set"
	"NOTE: The use of reset and set in this code is a specific
	hack for merging TextKerns."
	att reset.
	^ Array streamContents:
		[:strm | others do:
			[:other | (att dominates: other) ifFalse: [strm nextPut: other]].
		att set ifTrue: [strm nextPut: att]]! !

!Text class methodsFor: 'instance creation' stamp: ''!
streamContents: blockWithArg 
	| stream |
	stream := TextStream on: (self new: 400).
	blockWithArg value: stream.
	^ stream contents! !

!Text class methodsFor: 'instance creation' stamp: 'EstebanLorenzano 10/16/2013 00:21'!
fromString: aString 
  "Answer an instance of me whose characters are those of the argument, aString."

  | defaultFontStyle fontNumber |

  defaultFontStyle := TextStyle default.
  fontNumber := defaultFontStyle ifNil: 1 ifNotNil: [defaultFontStyle defaultFontIndex].

  ^ self
    string: aString
    attributes:{ "No default attributes" }
! !

!Text class methodsFor: 'private' stamp: ''!
string: aString runs: anArray
 
	^self basicNew setString: aString setRuns: anArray! !

!Text class methodsFor: 'instance creation' stamp: 'JuanVuletich 10/13/2010 09:11'!
initialFont: aStrikeFont stringOrText: aStringOrText
	"Answer an instance of me whose characters are aString."
	
	^Text string: aStringOrText asString attribute: (TextFontReference toFont: aStrikeFont)! !

!TextAction commentStamp: 'TorstenBergmann 1/31/2014 12:15'!
A sepcific text attribute to run actions on a text!
!TextAction methodsFor: 'testing' stamp: 'CamilloBruni 2/6/2012 22:54'!
mayActOnEvent: anEvent

	^ true! !

!TextAction methodsFor: 'testing' stamp: 'tk 12/16/97 16:48'!
validate: aString
	"any format is OK with me"
	^ aString! !

!TextAction methodsFor: 'styling' stamp: 'FernandoOlivero 8/24/2013 22:31'!
emphasizeScanner: scanner
	"Set the emphasis for text display"
	scanner textColor: Color purple! !

!TextAction methodsFor: 'accessing' stamp: 'DSM 3/30/1999 13:15'!
info
	^ 'no hidden info'! !

!TextAction methodsFor: 'evaluating' stamp: 'SeanDeNigris 11/5/2013 14:18'!
actOnClick: anEvent for: anObject in: paragraph editor: editor
	"sent when a user clicks on a piece of text to which I am applied in an editor"

	^ self subclassResponsibility.! !

!TextAction methodsFor: '*Shout-styling' stamp: ''!
shoutShouldPreserve
	^ true! !

!TextAction methodsFor: 'testing' stamp: 'di 10/31/97 13:11'!
dominatedByCmd0
	"Cmd-0 should turn off active text"
	^ true! !

!TextAction methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/8/2012 14:49'!
analyze: aString
	"Analyze the selected text to find both the parameter to store and the text to emphesize (may be different from original selection).  Does not return self!!.  May be of the form:
3+4
<3+4>
Click Here<3+4>
<3+4>Click Here
"
	"Obtain the showing text and the instructions"
	| b1 b2 trim param show |
	b1 := aString indexOf: $<.
	b2 := aString indexOf: $>.
	(b1 < b2) & (b1 > 0) ifFalse: ["only one part"
		param := self validate: aString.
		param ifNil: [ ^{ nil. nil } ].
		^ Array with: param with: (param size = 0 ifTrue: [nil] ifFalse: [param])].
	"Two parts"
	trim := aString trimBoth.
	(trim at: 1) == $< 
		ifTrue: [(trim last) == $>
			ifTrue: ["only instructions" 
				param := self validate: (aString copyFrom: b1+1 to: b2-1).
				show := param size = 0 ifTrue: [nil] ifFalse: [param]]
			ifFalse: ["at the front"
				param := self validate: (aString copyFrom: b1+1 to: b2-1).
				show := param size = 0 ifTrue: [nil] 
						ifFalse: [aString copyFrom: b2+1 to: aString size]]]
		ifFalse: [(trim last) == $>
			ifTrue: ["at the end"
				param := self validate: (aString copyFrom: b1+1 to: b2-1).
				show := param size = 0 ifTrue: [nil] 
						ifFalse: [aString copyFrom: 1 to: b1-1]]
			ifFalse: ["Illegal -- <> has text on both sides"
				show := nil]].
	^ Array with: param with: show
! !

!TextAlignment commentStamp: '<historical>'!
I'm a Text attribute that tells how content should be aligned.

TextMorph new 
  newContents: (Text streamContents: [:aStream| 
										aStream
 											nextPutAll: 'Left flush' asText; 
											cr;
											nextPutAll: ('Centered' asText addAttribute: TextAlignment centered); 
 											cr;
											nextPutAll: ('Right flush' asText addAttribute: TextAlignment rightFlush); 
 											cr ]);
  openInWindowLabeled: 'TextAlignment demo'!
!TextAlignment methodsFor: 'testing' stamp: 'ar 9/9/2003 22:03'!
hash
	"#hash is re-implemented because #= is re-implemented"
	^ alignment hash! !

!TextAlignment methodsFor: 'testing' stamp: 'ar 12/16/2001 00:20'!
dominates: other
	"There can be only one..."
	^self class == other class! !

!TextAlignment methodsFor: 'testing' stamp: 'ar 12/15/2001 23:33'!
= other 
	^ (other class == self class) 
		and: [other alignment = alignment]! !

!TextAlignment methodsFor: 'utils' stamp: 'ar 12/15/2001 23:34'!
emphasizeScanner: scanner
	"Set the emphasist for text scanning"
	scanner setAlignment: alignment.! !

!TextAlignment methodsFor: 'accessing' stamp: 'ar 12/15/2001 23:33'!
alignment
	^alignment! !

!TextAlignment methodsFor: 'utils' stamp: 'ar 12/16/2001 01:55'!
writeScanOn: strm

	strm nextPut: $a.
	alignment printOn: strm.! !

!TextAlignment methodsFor: 'accessing' stamp: 'ar 12/15/2001 23:33'!
alignment: aNumber
	alignment := aNumber.! !

!TextAlignment class methodsFor: 'instance creation' stamp: 'nice 3/6/2008 22:33'!
rightFlush
	^self new alignment: RightFlush! !

!TextAlignment class methodsFor: 'instance creation' stamp: 'nice 3/6/2008 22:33'!
leftFlush
	^self new alignment: LeftFlush! !

!TextAlignment class methodsFor: 'instance creation' stamp: 'nice 3/6/2008 22:33'!
centered
	^self new alignment: Centered! !

!TextAlignment class methodsFor: 'instance creation' stamp: 'nice 3/6/2008 22:33'!
justified
	^self new alignment: Justified! !

!TextAlignment class methodsFor: 'utils' stamp: 'KR 12/5/2005 00:53'!
alignmentSymbol: alignmentCode
	^#(leftFlush rightFlush centered justified) at: (alignmentCode + 1)! !

!TextAlignmentTest commentStamp: 'TorstenBergmann 1/31/2014 12:23'!
SUnit tests for class TextAlignment!
!TextAlignmentTest methodsFor: 'initialization' stamp: 'mjr 8/20/2003 18:55'!
setUp
	super setUp.
	prototypes add: TextAlignment centered;
		 add: TextAlignment justified;
		 add: TextAlignment leftFlush;
		 add: TextAlignment rightFlush ! !

!TextAnchor commentStamp: 'SeanDeNigris 2/4/2015 13:42'!
TextAnchors support anchoring of images in text.  A TextAnchor exists as an attribute of a special text placeholder - "(Character value: 1) asText".  Depending on whether its anchoredMorph is a Morph or a Form, it repositions the morph, or displays the form respectively.  The coordination between composition, display and selection can best be understood by browsing the various implementations of placeEmbeddedObject:.

In the morphic world, simply embed any form or morph in text.

	| textWithForm |
	textWithForm := (Text withAll: 'Text with -->'), (Text string: (String value: 1) attribute: (TextAnchor new anchoredMorph: ThemeIcons current homeIcon)), (Text withAll: '<-- embedded Form').
	textWithForm asMorph openInHand.

	| textWithMorph |
	textWithMorph := (Text withAll: 'Text with -->'), (Text string: (String value: 1) attribute: (TextAnchor new anchoredMorph: EllipseMorph new)), (Text withAll: '<-- embedded Morph').
	textWithMorph asMorph openInHand.!
!TextAnchor methodsFor: 'accessing' stamp: 'di 11/10/97 13:21'!
anchoredMorph
	^ anchoredMorph! !

!TextAnchor methodsFor: 'accessing' stamp: 'di 11/10/97 10:47'!
anchoredMorph: aMorph 
	anchoredMorph := aMorph! !

!TextAnchor methodsFor: 'comparing' stamp: 'di 7/1/1998 14:35'!
= other 
	^ (other class == self class) 
		and: [other anchoredMorph == anchoredMorph]! !

!TextAnchor methodsFor: 'comparing' stamp: 'ar 9/9/2003 22:03'!
hash
	"#hash is re-implemented because #= is re-implemented"
	^anchoredMorph identityHash! !

!TextAnchor methodsFor: 'accessing' stamp: 'di 11/10/97 14:08'!
mayBeExtended
	"A textAnchor is designed to modify only a single character, and therefore must not be extended by the ParagraphEditor's emphasisHere facility"
	^ false! !

!TextAnchor methodsFor: 'visiting' stamp: 'ar 12/17/2001 01:19'!
emphasizeScanner: scanner
	"Do nothing for emphasizing the scanner - if the anchor is valid a #embeddedObject will be encountered by the scanner and do the real thing"! !

!TextAnchorTest methodsFor: 'running' stamp: 'MarcusDenker 10/26/2011 15:18'!
setUp
	super setUp.
	prototypes
		add: (TextAnchor new anchoredMorph: Morph new initialize);
		
		add: (TextAnchor new anchoredMorph: EllipseMorph new initialize) ! !

!TextAndTextStreamTest commentStamp: '<historical>'!
At May 09, 2003 Tim Olson sent a bug report to the Squeak developers list that inspired me to examine the protocol of TextStream in greater detail.  (The bug that Tim reported was present in Squeak 3.4, it is shown in testExample1.) In a discussion that followed,  Daniel Vainsencher proposed that we should have tests for Text and TextStreams. This class is an attempt to implement that proposal. For Squeak 3.4, some of the test examples fail.!
!TextAndTextStreamTest methodsFor: 'tests' stamp: 'sd 6/5/2005 09:40'!
testExampleText1
	"self run: #testExampleText1"
	"inspired by a bug report from Tim Olson.
	Text attributes are lost when the stream collection is expanded.
	Documented BUG!!!!!!"

    | text1 text2 atts1 atts2 |
	text1 := self example1: 10. " here we will loose the attribute bold "
	text2 := self example1: 50. " here we have a larger buffer and will not loose text attributes "
	atts1 := text1 runs copyFrom: 6 to: 10. 
	atts2 := text2 runs copyFrom: 6 to: 10. 

	self assert: atts1 = atts2.
      ! !

!TextAndTextStreamTest methodsFor: 'tests' stamp: 'sd 6/5/2005 09:45'!
testAddStringToTextStream

	"It is possible to add a string into a TextStream.
	This test verifies that the created text has text attributes for all its characters. "

	| ts text |
	ts := TextStream on: (Text new: 50).
	ts nextPutAll: 'abc' asText.
	ts nextPutAll: 'def' asText allBold.
	ts nextPutAll: 'ghijk'.
	text := ts contents.
     " now, check the fundamental invariant of a text: "
	self assert: text string size = text runs size.
! !

!TextAndTextStreamTest methodsFor: 'tests' stamp: 'sd 6/5/2005 09:51'!
testTextEmphasisRangeDetection2

	"this tests the detection of the range of a text attribute.
	Here the searched attribute spans three runs. The objective of the test is whether the entire range is always found."
	| text startPos searchedStyle |
	text := 'This is a text with attriute bold for some characters' asText.
	startPos := text findString: 'bold' startingAt: 1.
	text addAttribute: TextEmphasis bold from: startPos to: startPos + 3.
	text addAttribute: TextEmphasis italic from: startPos - 2 to: startPos + 5.
	searchedStyle := TextEmphasis italic.

  " uncomment the following statement for examine failures: " 
  " -----------------------
       (1 to: text size) do:
           [:idx | | range | 
              range := text rangeOf: searchedStyle startingAt: idx.
             Transcript show: startPos; show: ' -- '; show: idx printString; show: '  '; show: range printString; show: range size printString; show: ((idx between: startPos - 2 and: startPos -2 + 7)
                  ifTrue:
                    [range first = (startPos - 2) & (range size = 8)]
                  ifFalse:
                    [range first = idx & (range size = 0)]) printString; cr.
           ].
   ----------------------- "
	self assert: 
			((1 to: text size) allSatisfy:
				[:idx | | range |
					range := text rangeOf: searchedStyle startingAt: idx.
					(idx between: startPos - 2 and: startPos -2 + 7)
						ifTrue: [range first = (startPos - 2) & (range size = 8)]
						ifFalse: [range first = idx & (range size = 0)]])! !

!TextAndTextStreamTest methodsFor: 'test-errors' stamp: 'nice 2/24/2012 00:57'!
testRemovingAttributesBeforeBeg
	| aText |
	aText := Text string: 'foo' attribute: TextColor red .
	self should: [aText removeAttribute: TextColor red from: 0 to: aText size] raise: Error.! !

!TextAndTextStreamTest methodsFor: 'examples' stamp: 'BG 6/11/2003 13:05'!
replacementExample3

  " for a Text  t,
     the following assertion should always hold:
     t string size = t run size 
    This test examines the preservation of this assertion for in-place replacement 
 Here, the replacement text is shorteer than the text that is shall replace. "


   | text1 string replacement startPos length startPosInRep string2 |

   text1 := (string := 'This is again simple text' copy) asText.
     " without the copy, we would modify a constant that the compiler attached at the compiled method. "
   startPos := string findString: 'simple'. 
   length  := 'simple' size.
   replacement := (string2 := 'both simple and short') asText.
   startPosInRep :=  string2 findString: 'short'.
   text1 replaceFrom: startPos 
        to: startPos + length - 1
        with: replacement
        startingAt: startPosInRep.
   
! !

!TextAndTextStreamTest methodsFor: 'tests' stamp: 'PavelKrivanek 11/24/2011 11:10'!
testRunArrayReversal

  	"this tests the reversal of a  RunArray "
	| runArray |
	runArray := RunArray new.
	runArray 
		add: TextEmphasis normal withOccurrences: 5;
		add: TextEmphasis bold withOccurrences: 5;
		add: TextEmphasis normal withOccurrences: 5.
	self assert: (runArray reversed runs size = 3). ! !

!TextAndTextStreamTest methodsFor: 'examples' stamp: 'BG 6/10/2003 20:17'!
example1: size

   | ts text |

  ts := TextStream on: (Text new: size).
  ts  nextPutAll: 'xxxxx' asText.
  ts nextPutAll: ('yyyyy' asText allBold, 'zzzzzzz' asText).
  text := ts contents.
  ^text
  ! !

!TextAndTextStreamTest methodsFor: 'tests' stamp: 'sd 6/5/2005 09:57'!
testTextReplacement2


  	"for a Text  t,
     the following assertion should always hold:
     t string size = t run size 
    	This test examines the preservation of this assertion for in-place replacement.
    	Here, the replacement text has trailing characters. "

	| text1 string replacement startPos length startPosInRep string2 |
	text1 := (string := 'This is simple text' copy) asText.
	"without the copy, we would modify a constant that the compiler attached at the compiled method. "
	startPos := string findString: 'simple'. 
	length := 'simple' size.
	replacement := (string2 := 'both simple and short*************') asText.
	startPosInRep :=  string2 findString: 'short'.
	text1 replaceFrom: startPos 
        to: startPos + length - 1
        with: replacement
        startingAt: startPosInRep.
	self assert: text1 string size = text1 runs size.
! !

!TextAndTextStreamTest methodsFor: 'tests' stamp: 'sd 6/5/2005 09:59'!
testTextReplacementAtStartPos1

	"for a Text  t,
     the following assertion should always hold:
     t string size = t run size 
	This test examines the preservation of this assertion for in-place replacement "

	| text1  replacement  length  |
	text1 := 'This is a simple text' copy asText.
	"without the copy, we would modify a constant that the compiler attached at the compiled method. "
	length  := 'This' size.
	replacement := 'That' asText.
	text1 replaceFrom: 1 
        to:   length
        with: replacement
        startingAt: 1.
	self assert: text1 string size = text1 runs size.
! !

!TextAndTextStreamTest methodsFor: 'tests' stamp: 'sd 6/5/2005 09:55'!
testTextEmphasisRangeDetection4

	"this tests the detection of the range of a text attribute.
	Here the searched attribute spans three runs. The the range to be detected extends to the end of the text . The objective of the test is whether the 
	entire range is always found."

	| text startPos searchedStyle |
	text := 'This is a text with attriute bold for some characters' asText.
	startPos := text findString: 'bold' startingAt: 1.
	text addAttribute: TextEmphasis bold from: startPos to: startPos + 3.	
	text addAttribute: TextEmphasis italic from: startPos - 2 to: text size.
	searchedStyle := TextEmphasis italic.

	" uncomment the following statement to examine failures: "
 
 	" -----------------------------------------
       (1 to: text size) do:
           [:idx | | range | 
              range := text rangeOf: searchedStyle startingAt: idx.
             Transcript show: startPos;
					show: ' -- ';
					show: idx printString;
					show: '  ';
					show: range printString;
					show: range size printString;
                        show: ' ';
					 show: ((idx between: startPos - 2 and: text size)
                  			ifTrue:
   			                 [range first = (startPos - 2) & (range size = (text size - (startPos - 2) + 1))]
                  			ifFalse:
 			                 [range first = idx & (range size = 0)]) printString;
					cr.
           ].
   -------------------------------"

	self assert: 
       ((1 to: text size) allSatisfy:
           [:idx | | range |
              range := text rangeOf: searchedStyle startingAt: idx.
              (idx between: startPos - 2 and: text size)
                  ifTrue: [range first = (startPos - 2) & (range size = (text size - (startPos - 2) + 1))]
                  ifFalse: [range first = idx & (range size = 0)]])! !

!TextAndTextStreamTest methodsFor: 'tests' stamp: 'PavelKrivanek 11/24/2011 11:10'!
testRunArrayRunsAreNotMerged

	" this demonstrates that different runs are not merged "
	| runArray |
	runArray := RunArray new.
	runArray 
		add: TextEmphasis normal withOccurrences: 5;
		add: TextEmphasis bold withOccurrences: 5;
		add: TextEmphasis normal withOccurrences: 5.
	self assert: (runArray runs size = 3). ! !

!TextAndTextStreamTest methodsFor: 'tests' stamp: 'sd 6/5/2005 10:00'!
testTextReplacementAtStartPos2

  	"for a Text  t,
     the following assertion should always hold:
     t string size = t run size 
	This test examines the preservation of this assertion for in-place replacement "

	| text1  replacement  length  |
	text1 := 'This is a simple text' copy asText.
	"without the copy, we would modify a constant that the compiler attached at the compiled method. "
	length  := 'This' size.
	replacement := 'That********' asText.
	text1 replaceFrom: 1 
        to:   length
        with: replacement
        startingAt: 1.
	self assert: text1 string size = text1 runs size.
! !

!TextAndTextStreamTest methodsFor: 'examples' stamp: 'BG 6/10/2003 20:26'!
example2

      | ts text |

  ts := TextStream on: (Text new: 50).
  ts  nextPutAll: 'abc' asText.
  ts nextPutAll: 'def' asText allBold.
  ts nextPutAll: 'ghijk' asText.
  text := ts contents.
  ^text
  ! !

!TextAndTextStreamTest methodsFor: 'tests' stamp: 'sd 6/5/2005 09:56'!
testTextReplacement1

	"for a Text  t,
     the following assertion should always hold:
     t string size = t run size 
	This test examines the preservation of this assertion for in-place replacement "

   | text1 string replacement startPos length startPosInRep string2 |
   text1 := (string := 'This is a simple text' copy) asText.
   "without the copy, we would modify a constant that the compiler attached at the compiled method. "
   startPos := string findString: 'simple'. 
   length  := 'simple' size.
   replacement := (string2 := 'both simple and short*') asText.
   startPosInRep :=  string2 findString: 'short'.
   text1 replaceFrom: startPos 
        to: startPos + length - 1
        with: replacement
        startingAt: startPosInRep.
   self assert: text1 string size = text1 runs size.
! !

!TextAndTextStreamTest methodsFor: 'tests' stamp: 'sd 6/5/2005 10:00'!
testTextReplacementAtStartPos3

	"for a Text  t,
	the following assertion should always hold:
	t string size = t run size 
	This test examines the preservation of this assertion for in-place replacement 
	Here, the replacement text is shorteer than the text that is shall replace. "

	self should: [self replacementAtStartExample3] raise: Error! !

!TextAndTextStreamTest methodsFor: 'tests' stamp: 'sd 6/5/2005 09:40'!
testExampleText2
	"a Text looses its attributes when it is reversed "
	
	| text1 text2 |
	text1 := self example2.
	text2 := text1 reversed reversed.
	self assert: text1 runs = text2 runs.
 
! !

!TextAndTextStreamTest methodsFor: 'tests' stamp: 'PavelKrivanek 11/24/2011 11:10'!
testRunArrayRunsSize

 	"this demonstrates that the size of a run array is the sum of the sizes of its runs. "
	| runArray |
	runArray := RunArray new.
  	runArray 
		add: TextEmphasis normal withOccurrences: 5;
		add: TextEmphasis bold withOccurrences: 5;
		add: TextEmphasis normal withOccurrences: 5.
	self assert: (runArray size = 15). ! !

!TextAndTextStreamTest methodsFor: 'examples' stamp: 'BG 6/11/2003 13:09'!
replacementAtStartExample3

   | text1  replacement  length  |

   text1 := 'This is a simple text' copy asText.
    " without the copy, we would modify a constant that the compiler attached at the compiled method. "
   length  := 'This' size.
   replacement := 'Tht' asText.
   text1 replaceFrom: 1 
        to:   length
        with: replacement
        startingAt: 1.
! !

!TextAndTextStreamTest methodsFor: 'tests' stamp: 'PavelKrivanek 11/24/2011 11:09'!
testRunArrayAdjacentMerge

	"this demonstrates that adjancent runs with equal attributes are merged. "
	| runArray |
	runArray := RunArray new.
	runArray 
		add: TextEmphasis normal withOccurrences: 5;
		add: TextEmphasis bold withOccurrences: 5;
		add: TextEmphasis bold withOccurrences: 5.
	self assert: (runArray runs size = 2). ! !

!TextAndTextStreamTest methodsFor: 'test-errors' stamp: 'nice 2/24/2012 01:00'!
testSettingRunsOfWrongSize
	| aText newRuns |
	aText := 'foo' asText.
	newRuns := aText runs copyReplaceFrom: 2 to: 1 with: (Array with: TextColor red).
	self should: [aText runs: newRuns] raise: Error.! !

!TextAndTextStreamTest methodsFor: 'test-errors' stamp: 'nice 2/24/2012 00:52'!
testAddingAttributesPastTheEnd
	| aText |
	aText := 'foo' asText.
	self should: [aText addAttribute: TextColor red from: 2 to: aText size + 1] raise: Error.! !

!TextAndTextStreamTest methodsFor: 'tests' stamp: 'PavelKrivanek 11/24/2011 11:09'!
testRunArrayInvariant

	"this verifies that the fundamental invariant of a RunArray is always satisfied. "
	"see comment below"
	| runArray |
	runArray := RunArray new.
	runArray 
		add: TextEmphasis normal withOccurrences: 5;
		add: TextEmphasis bold withOccurrences: 5;
		add: TextEmphasis normal withOccurrences: 5.
	self assert:
       ((1 to: runArray size) allSatisfy:
           [:idx |  | lastIndex lastOffset lastRun lengthOfPreviousRuns |
               runArray at: idx.  " updates the cached values "
               lastIndex := runArray instVarNamed: 'lastIndex'.
               lastRun := runArray instVarNamed: 'lastRun'.
               lastOffset := runArray instVarNamed: 'lastOffset'.
               lengthOfPreviousRuns 
                   := (1 to: lastRun - 1)
                      inject: 0
                       into: [:sum :idx2 | sum + (runArray runs at: idx2)].
               lastIndex = (lastOffset + lengthOfPreviousRuns + 1) 
           ]
       ). 

" This method is a bit tricky. First, it uses Object>>instVarNamed: to access instance variables for which no accessors are defined. The same method is used by the debuggers and by various inspectors.
The assertion itself explains the meaning of the cached values."! !

!TextAndTextStreamTest methodsFor: 'tests' stamp: 'sd 6/5/2005 09:49'!
testTextEmphasisRangeDetection1

	"this tests the detection of the range of a text attribute. "
	| text startPos boldStyle |
	text := 'This is a text with attriute bold for some characters' asText.
	startPos := text findString: 'bold' startingAt: 1.
	text addAttribute: TextEmphasis bold from: startPos to: startPos + 3.
	boldStyle := TextEmphasis bold.

  " uncomment the following statement for examine failures: "
  " -----------------
       (1 to: text size) do:
           [:idx | | range |
              range := text rangeOf: boldStyle startingAt: idx.
             Transcript show: startPos; show: ' -- '; show: idx printString; show: '  '; show: range printString; show: range size printString; show: ((idx between: startPos and: startPos + 3)
                  ifTrue:
                    [range first = startPos & (range size = 4)]
                  ifFalse:
                    [range first = idx & (range size = 0)]) printString; cr.
           ].
    ------------- "

	self assert: 
		((1 to: text size) allSatisfy:
			[:idx | | range |
				range := text rangeOf: boldStyle startingAt: idx.
				(idx between: startPos and: startPos + 3)
					ifTrue: [range first = startPos & (range size = 4)]
					ifFalse: [range first = idx & (range size = 0)]])! !

!TextAndTextStreamTest methodsFor: 'tests' stamp: 'sd 6/5/2005 09:53'!
testTextEmphasisRangeDetection3

	"this tests the detection of the range of a text attribute.
    Here the searched attribute spans three runs. The the range to be detected begins at text position 1. The objective of the test is whether the entire range is always found."

	| text startPos searchedStyle |
	text := 'This is a text with attriute bold for some characters' asText.
	startPos := text findString: 'bold' startingAt: 1.
	text addAttribute: TextEmphasis bold from: startPos to: startPos + 3.
	text addAttribute: TextEmphasis italic from: 1 to: startPos + 5.
	searchedStyle := TextEmphasis italic.

	" uncomment the following statement to examine failures: "
 	" -----------------------
       (1 to: text size) do:
           [:idx | | range | 
              range := text rangeOf: searchedStyle startingAt: idx.
             Transcript show: startPos;
					show: ' -- ';
					show: idx printString;
					show: '  ';
					show: range printString;
					show: range size printString;
                        show: ' ';
					 show: ((idx between: 1 and: startPos + 5)
                  					ifTrue:
                  					  [range first = 1 & (range size = (startPos + 5))]
                					ifFalse:
                   					 [range first = idx & (range size = 0)]) printString; cr.
           ].
   ----------------------- "
	self assert: 
       ((1 to: text size) allSatisfy:
           [:idx | | range |
              range := text rangeOf: searchedStyle startingAt: idx.
              (idx between: 1 and: startPos + 5)
                  ifTrue:
                    [range first = 1 & (range size = (startPos + 5))]
                  ifFalse:
                    [range first = idx & (range size = 0)]])! !

!TextAndTextStreamTest methodsFor: 'tests' stamp: 'sd 6/5/2005 09:44'!
testTextStreamAdjacentRunsWithIdentitcalAttributes

	"This test verifies that adjacent runs with identical attributes are coalesced."

	| ts text rangeOfBold |
	ts := TextStream on: (Text new: 50).
	ts nextPutAll: 'abc' asText.
	ts nextPutAll: 'def' asText allBold.
	ts nextPutAll: 'ghijk'.
	text := ts contents.
	rangeOfBold := text find:  TextEmphasis bold.
	text removeAttribute: TextEmphasis bold from: rangeOfBold first to: rangeOfBold last. 
     "now, check that only one run is left and that it has the correct size "
	self assert: text runs runs size = 1 & (text runs size = text string size).
! !

!TextAndTextStreamTest methodsFor: 'test-errors' stamp: 'nice 2/24/2012 00:57'!
testAddingAttributesBeforeBeg
	| aText |
	aText := 'foo' asText.
	self should: [aText addAttribute: TextColor red from: 0 to: aText size] raise: Error.! !

!TextAndTextStreamTest methodsFor: 'test-errors' stamp: 'nice 2/24/2012 00:54'!
testRemovingAttributesPastTheEnd
	| aText |
	aText := Text string: 'foo' attribute: TextColor red .
	self should: [aText addAttribute: TextColor red from: 2 to: aText size + 1] raise: Error.! !

!TextAndTextStreamTest methodsFor: 'tests' stamp: 'sd 6/5/2005 09:58'!
testTextReplacement3

	"for a Text  t,
	the following assertion should always hold:
	t string size = t run size 
	This test examines the preservation of this assertion for in-place replacement 
	Here, the replacement text is shorteer than the text that is shall replace. "

	self should: [self replacementExample3]  raise: Error! !

!TextAttribute commentStamp: 'tk 7/22/2002 18:33'!
Tells a piece of text to be a certain way.

Select text, press Command-6, choose a attribute.  If selected text is of the form 
	Hi There<Smalltalk beep>
the part in angle brackets is saved for action, and the Hi There appears in the paragraph.  If selection has no angle brackets, use the whole thing as both the text and the action.

TextDoIt  --  eval as a Smalltalk expression (the part in angle brackets)

TextLink -- Show a method, class comment, class hierarchy, or class defintion.
	<Point extent:>, <Point Comment>, <Point Hierarchy>, or <Point Defintion> are what you type.

TextURL -- Show the web page. <www.disney.com>

These attributes of text need to be stored on the disk in a regular file-out.  It is done in this form: 	Hi There   
	in the text, and a Run containing   dSmalltalk beep;;
	Click here to see the extent:   
	in the text, and a Run containing   method LPoint extent:;
See RunArray class scanFrom: where decoding is done.
!
!TextAttribute methodsFor: 'styling' stamp: ''!
oldEmphasisCode: default
	"Allows running thorugh possibly multiple attributes
	and getting the emphasis out of any that has an emphasis (font number)"
	^ default! !

!TextAttribute methodsFor: 'testing' stamp: 'ar 9/21/2000 14:16'!
isKern
	^false! !

!TextAttribute methodsFor: 'styling' stamp: ''!
emphasizeScanner: scanner
	"Subclasses may override to set, eg, font, color, etc"! !

!TextAttribute methodsFor: 'accessing' stamp: 'di 10/31/97 11:03'!
reset
	"Allow subclasses to prepare themselves for merging attributes"! !

!TextAttribute methodsFor: 'styling' stamp: 'di 4/1/1999 15:16'!
emphasisCode
	"Subclasses may override to add bold, italic, etc"
	^ 0! !

!TextAttribute methodsFor: 'testing' stamp: 'di 10/31/97 13:09'!
dominatedByCmd0
	"Subclasses may override if cmd-0 should turn them off"
	^ false! !

!TextAttribute methodsFor: 'accessing' stamp: 'ar 12/16/2001 23:18'!
anchoredMorph
	"If one hides here, return it"
	^nil! !

!TextAttribute methodsFor: 'accessing' stamp: ''!
dominates: another
	"Subclasses may override condense multiple attributes"
	^ false! !

!TextAttribute methodsFor: 'testing' stamp: 'CamilloBruni 2/6/2012 22:55'!
mayActOnEvent: anEvent
	"Subclasses may override to provide, eg, hot-spot actions"
	^ false! !

!TextAttribute methodsFor: 'styling' stamp: 'di 11/9/97 17:46'!
forFontInStyle: aTextStyle do: aBlock
	"No action is the default.  Overridden by font specs"! !

!TextAttribute methodsFor: 'accessing' stamp: ''!
set
	"Respond true to include this attribute (as opposed to, eg, a bold
	emphasizer that is clearing the property"
	^ true! !

!TextAttribute methodsFor: '*Shout-styling' stamp: ''!
shoutShouldPreserve
	^ false! !

!TextAttribute methodsFor: 'testing' stamp: 'di 11/10/97 14:05'!
mayBeExtended
	"A quality that may be overridden by subclasses, such as TextAnchors, that really only apply to a single character"
	^ true! !

!TextClassLink commentStamp: 'TorstenBergmann 1/31/2014 12:18'!
An active link in a text linking to a class!
!TextClassLink methodsFor: 'accessing' stamp: 'CamilloBruni 2/1/2012 19:26'!
className: aStringOrSymbol
	className := aStringOrSymbol asSymbol! !

!TextClassLink methodsFor: 'system primitives' stamp: 'CamilloBruni 2/1/2012 19:24'!
className	
	^ className! !

!TextClassLink methodsFor: 'evaluating' stamp: 'CamilloBruni 3/9/2012 16:31'!
actOnClick: anEvent for: target in: aParagraph editor: anEditor
	anEvent shiftPressed
		ifFalse: [ anEditor browseClassFrom: self className ]
		ifTrue: [ anEditor referencesTo: self className ].
	^ true! !

!TextClassLink class methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 2/2/2012 02:26'!
class: aClass
	^ self className: aClass name! !

!TextClassLink class methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 2/1/2012 19:23'!
className: aSymbol
	^ self new
		className: aSymbol;
		yourself! !

!TextColor commentStamp: '<historical>'!
A TextColor encodes a text color change applicable over a given range of text.!
!TextColor methodsFor: 'comparing' stamp: 'sma 3/24/2000 10:51'!
hash
	^ color hash! !

!TextColor methodsFor: 'scanning' stamp: 'di 10/31/97 11:20'!
dominates: other
	^ other class == self class! !

!TextColor methodsFor: 'comparing' stamp: 'di 10/31/97 11:19'!
= other 
	^ (other class == self class) 
		and: [other color = color]! !

!TextColor methodsFor: 'printing' stamp: 'sma 3/24/2000 10:51'!
printOn: aStream
	super printOn: aStream.
	aStream nextPutAll: ' code: '; print: color! !

!TextColor methodsFor: 'accessing' stamp: ''!
color
	^ color! !

!TextColor methodsFor: 'scanning' stamp: ''!
emphasizeScanner: scanner
	"Set the emphasis for text display"
	scanner textColor: color! !

!TextColor methodsFor: 'scanning' stamp: 'nice 1/5/2010 15:59'!
writeScanOn: strm
	"Two formats.  c125000255 or cblue;"

	| nn |
	strm nextPut: $c.
	(nn := color name) ifNotNil: [
		(self class respondsTo: nn) ifTrue: [
			^ strm nextPutAll: nn; nextPut: $;]].
	(Array with: color red with: color green with: color blue) do: [:float | | str |
		str := '000', (float * 255) asInteger printString.
		strm nextPutAll: (str copyFrom: str size-2 to: str size)]! !

!TextColor methodsFor: 'accessing' stamp: ''!
color: aColor
	color := aColor! !

!TextColor class methodsFor: 'constants' stamp: ''!
black
	^ self new color: Color black! !

!TextColor class methodsFor: 'constants' stamp: ''!
magenta
	^ self new color: Color magenta! !

!TextColor class methodsFor: 'constants' stamp: ''!
blue
	^ self new color: Color blue! !

!TextColor class methodsFor: 'constants' stamp: 'ajh 9/10/2002 02:26'!
gray
	^ self new color: Color gray! !

!TextColor class methodsFor: 'constants' stamp: ''!
yellow
	^ self new color: Color yellow! !

!TextColor class methodsFor: 'constants' stamp: 'sma 3/24/2000 10:50'!
white 
	^ self new color: Color white! !

!TextColor class methodsFor: 'instance creation' stamp: 'sma 3/24/2000 10:49'!
scanFrom: strm
	"read a color in the funny format used by Text styles on files. c125000255 or cblue;"

	| r g b |
	strm peek isDigit
		ifTrue:
			[r := (strm next: 3) asNumber.
			g := (strm next: 3) asNumber.
			b := (strm next: 3) asNumber.
			^ self color: (Color r: r g: g b: b range: 255)].
	"A name of a color"
	^ self color: (Color perform: (strm upTo: $;) asSymbol)! !

!TextColor class methodsFor: 'constants' stamp: ''!
red
	^ self new color: Color red! !

!TextColor class methodsFor: 'constants' stamp: ''!
cyan
	^ self new color: Color cyan! !

!TextColor class methodsFor: 'instance creation' stamp: ''!
color: aColor
	^ self new color: aColor! !

!TextColor class methodsFor: 'constants' stamp: ''!
green
	^ self new color: Color green! !

!TextComposer methodsFor: 'composition' stamp: 'AlexandreBergel 9/30/2011 12:18'!
composeEachRectangleIn: rectangles

	| myLine lastChar |

	1 to: rectangles size do: [:i | 
		currCharIndex <= theText size ifFalse: [ ^ false ].
		myLine := scanner 
			composeFrom: currCharIndex 
			inRectangle: (rectangles at: i)				
			firstLine: isFirstLine 
			leftSide: i=1 
			rightSide: i=rectangles size.
		lines addLast: myLine.
		actualHeight := actualHeight max: myLine lineHeight.  "includes font changes"
		currCharIndex := myLine last + 1.
		
		"This happens if the text is just one line long"
		(myLine last = 0) ifTrue: [ ^ false ].
		
		lastChar := theText at: myLine last.
		(CharacterSet crlf includes: lastChar) ifTrue: [^#cr].
		wantsColumnBreaks ifTrue: [
			lastChar = self class characterForColumnBreak ifTrue: [^#columnBreak].
		].
	].
	^false! !

!TextComposer methodsFor: 'private' stamp: 'RAA 5/6/2001 15:15'!
slideOneLineDown

	| priorLine |

	"Having detected the end of rippling recoposition, we are only sliding old lines"
	prevIndex < prevLines size ifFalse: [
		"There are no more prevLines to slide."
		^nowSliding := possibleSlide := false
	].

	"Adjust and re-use previously composed line"
	prevIndex := prevIndex + 1.
	priorLine := (prevLines at: prevIndex)
				slideIndexBy: deltaCharIndex andMoveTopTo: currentY.
	lines addLast: priorLine.
	currentY := priorLine bottom.
	currCharIndex := priorLine last + 1.
	wantsColumnBreaks ifTrue: [
		priorLine first to: priorLine last do: [ :i |
			(theText at: i) = TextComposer characterForColumnBreak ifTrue: [
				nowSliding := possibleSlide := false.
				^nil
			].
		].
	].
! !

!TextComposer methodsFor: 'composition' stamp: 'nice 10/29/2013 03:35'!
composeLinesFrom: argStart to: argStop delta: argDelta into: argLinesCollection priorLines: argPriorLines atY: argStartY textStyle: argTextStyle text: argText container: argContainer wantsColumnBreaks: argWantsColumnBreaks 
	wantsColumnBreaks := argWantsColumnBreaks.
	lines := argLinesCollection.
	theTextStyle := argTextStyle.
	theText := argText.
	theContainer := argContainer.
	deltaCharIndex := argDelta.
	currCharIndex := startCharIndex := argStart.
	stopCharIndex := argStop.
	prevLines := argPriorLines.
	currentY := argStartY.
	defaultLineHeight := theTextStyle lineGrid.
	maxRightX := theContainer left.
	possibleSlide := stopCharIndex < theText size
				and: [theContainer isMemberOf: Rectangle].
	nowSliding := false.
	prevIndex := 1.
	scanner := CompositionScanner new text: theText textStyle: theTextStyle.
	scanner wantsColumnBreaks: wantsColumnBreaks.
	isFirstLine := true.
	self composeAllLines.
	isFirstLine
		ifTrue: ["No space in container or empty text"
			self
				addNullLineWithIndex: startCharIndex
				andRectangle: (theContainer left @ theContainer top extent: 0 @ defaultLineHeight)]
		ifFalse: [self fixupLastLineIfCR].
	^ {lines asArray. maxRightX}! !

!TextComposer methodsFor: 'testing' stamp: 'RAA 5/4/2001 11:33'!
checkIfReadyToSlide

	"Check whether we are now in sync with previously composed lines"

	(possibleSlide and: [currCharIndex > stopCharIndex]) ifFalse: [^self].

	[prevIndex < prevLines size
		and: [(prevLines at: prevIndex) first < (currCharIndex - deltaCharIndex)]]
			whileTrue: [prevIndex := prevIndex + 1].

	(prevLines at: prevIndex) first = (currCharIndex - deltaCharIndex) ifTrue: [
		"Yes -- next line will have same start as prior line."
		prevIndex := prevIndex - 1.
		possibleSlide := false.
		nowSliding := true
	] ifFalse: [
		prevIndex = prevLines size ifTrue: [
			"Weve reached the end of prevLines, so no use to keep looking for lines to slide."
			possibleSlide := false
		]
	]! !

!TextComposer methodsFor: 'adding' stamp: 'RAA 5/5/2001 11:05'!
addNullLineWithIndex: index andRectangle: r

	lines addLast: (
		(
			TextLine 
				start: index 
				stop: index - 1
				internalSpaces: 0 
				paddingWidth: 0
		)
			rectangle: r;
			lineHeight: defaultLineHeight baseline: theTextStyle baseline
	)
! !

!TextComposer methodsFor: 'adding' stamp: 'RAA 5/4/2001 18:09'!
addNullLineForIndex: index
"This awful bit is to ensure that if we have scanned all the text and the last character is a CR that there is a null line at the end of lines. Sometimes this was not happening which caused anomalous selections when selecting all the text. This is implemented as a post-composition fixup because I couldn't figure out where to put it in the main logic."

	| oldLastLine r |

	oldLastLine := lines last.
	oldLastLine last - oldLastLine first >= 0 ifFalse: [^self].
	oldLastLine last = (index - 1) ifFalse: [^self].

	r := oldLastLine left @ oldLastLine bottom 
				extent: 0@(oldLastLine bottom - oldLastLine top).
	"Even though we may be below the bottom of the container,
	it is still necessary to compose the last line for consistency..."

	self addNullLineWithIndex: index andRectangle: r.
! !

!TextComposer methodsFor: 'composition' stamp: 'th 11/18/2002 19:13'!
composeAllRectangles: rectangles

	| charIndexBeforeLine numberOfLinesBefore reasonForStopping |

	actualHeight := defaultLineHeight.
	charIndexBeforeLine := currCharIndex.
	numberOfLinesBefore := lines size.
	reasonForStopping := self composeEachRectangleIn: rectangles.

	currentY := currentY + actualHeight.
	currentY > theContainer bottom ifTrue: [
		"Oops -- the line is really too high to fit -- back out"
		currCharIndex := charIndexBeforeLine.
		lines size - numberOfLinesBefore timesRepeat: [lines removeLast].
		^self
	].
	
	"It's OK -- the line still fits."
	maxRightX := maxRightX max: scanner rightX.
	1 to: rectangles size - 1 do: [ :i |
		"Adjust heights across rectangles if necessary"
		(lines at: lines size - rectangles size + i)
			lineHeight: lines last lineHeight
			baseline: lines last baseline
	].
	isFirstLine := false.
	reasonForStopping == #columnBreak ifTrue: [^nil].
	currCharIndex > theText size ifTrue: [
		^nil		"we are finished composing"
	].
	! !

!TextComposer methodsFor: 'private' stamp: 'BenjaminVanRyseghem 2/19/2013 17:21'!
fixupLastLineIfCR
"This awful bit is to ensure that if we have scanned all the text and the last character is a CR that there is a null line at the end of lines. Sometimes this was not happening which caused anomalous selections when selecting all the text. This is implemented as a post-composition fixup because I couldn't figure out where to put it in the main logic."

	(theText size > 0 and: [ CharacterSet crlf includes: theText last ]) ifFalse: [ ^ self ].
	
	self addNullLineForIndex: theText size + 1.
! !

!TextComposer methodsFor: 'protocol' stamp: 'nice 10/29/2013 02:33'!
multiComposeLinesFrom: argStart to: argStop delta: argDelta into: argLinesCollection priorLines: argPriorLines atY: argStartY textStyle: argTextStyle text: argText container: argContainer wantsColumnBreaks: argWantsColumnBreaks 
	wantsColumnBreaks := argWantsColumnBreaks.
	lines := argLinesCollection.
	theTextStyle := argTextStyle.
	theText := argText.
	theContainer := argContainer.
	deltaCharIndex := argDelta.
	currCharIndex := startCharIndex := argStart.
	stopCharIndex := argStop.
	prevLines := argPriorLines.
	currentY := argStartY.
	defaultLineHeight := theTextStyle lineGrid.
	maxRightX := theContainer left.
	possibleSlide := stopCharIndex < theText size
				and: [theContainer isMemberOf: Rectangle].
	nowSliding := false.
	prevIndex := 1.
	scanner := CompositionScanner new text: theText textStyle: theTextStyle.
	scanner wantsColumnBreaks: wantsColumnBreaks.
	isFirstLine := true.
	self composeAllLines.
	isFirstLine
		ifTrue: ["No space in container or empty text"
			self
				addNullLineWithIndex: startCharIndex
				andRectangle: (theContainer topLeft extent: 0 @ defaultLineHeight)]
		ifFalse: [self fixupLastLineIfCR].
	^ {lines asArray. maxRightX}! !

!TextComposer methodsFor: 'composition' stamp: 'BenjaminVanRyseghem 2/19/2013 17:23'!
composeAllLines

	[ currCharIndex <= theText size and: [ (currentY + defaultLineHeight) <= theContainer bottom ]] 
		whileTrue: [
			(nowSliding 
				ifTrue: [ self slideOneLineDown ] 
				ifFalse: [ self composeOneLine]) 
					ifNil: [ ^ nil ]].! !

!TextComposer methodsFor: 'composition' stamp: 'BenjaminVanRyseghem 2/19/2013 17:24'!
composeOneLine
	| rectangles |
	
	rectangles := theContainer 
					rectanglesAt: currentY 
					height: defaultLineHeight.
					
	rectangles notEmpty 
		ifTrue: [ (self composeAllRectangles: rectangles) 
					ifNil: [ ^ nil ]]
		ifFalse: [ currentY := currentY + defaultLineHeight ].
		
	self checkIfReadyToSlide! !

!TextComposer class methodsFor: 'as yet unclassified' stamp: 'RAA 5/7/2001 09:31'!
characterForColumnBreak

	^Character value: 12! !

!TextConstants commentStamp: 'TorstenBergmann 1/31/2014 12:19'!
A pool for Text constants for space, tab, espace, ...!
!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Ctrll
	^Ctrll! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Ctrly
	^Ctrly! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
DefaultMarginTabsArray
	^DefaultMarginTabsArray! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Italic
	^Italic! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
EndOfRun
	^EndOfRun! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CtrlG
	^CtrlG! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CR
	^CR! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CtrlU
	^CtrlU! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Basal
	^Basal! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
LeftMarginTab
	^LeftMarginTab! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CtrlX
	^CtrlX! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Justified
	^Justified! !

!TextConstants class methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
initialize

	TextSharedInformation ifNil: [ TextSharedInformation := Dictionary new].
	Ctrll := Character value: 153.
	Ctrld := Character value: 132.
	ESC := Character value: 160.
	Ctrlh := Character value: 179.
	Enter := Character value: 3.
	DefaultSpace := 4.
	LeftFlush := 0.
	DefaultRule := 3.
	CtrlX := Character value: 215.
	CtrlT := Character value: 240.
	RightFlush := 1.
	Basal := 0.
	CtrlP := Character value: 202.
	DefaultFontFamilySize := 3.
	CtrlL := Character value: 217.
	CtrlH := Character value: 243.
	Ctrlw := Character value: 145.
	CtrlD := Character value: 196.
	DefaultTab := 24.
	Ctrls := Character value: 19.
	Ctrlo := Character value: 15.
	DefaultLineGrid := 16.
	Ctrlk := Character value: 136.
	Ctrlc := Character value: 228.
	Space := Character value: 32.
	Ctrlg := Character value: 232.
	Tab := Character value: 9.
	CtrlW := Character value: 209.
	EndOfRun := 257.
	CtrlS := Character value: 211.
	Italic := 2.
	Centered := 2.
	CrossedX := 258.
	CtrlO := Character value: 216.
	DefaultMarginTabsArray := #(#(24 24) #(48 48) #(72 72) #(96 96) #(120 120) #(144 144) #(168 168) #(192 192) #(216 216) #(240 240) #(264 264) #(288 288) #(312 312) #(336 336) #(360 360) #(384 384) #(408 408) #(432 432) #(456 456) #(480 480)).
	CtrlOpenBrackets := #(201 7 218 249 219 15).
	CtrlK := Character value: 200.
	Ctrlz := Character value: 167.
	CtrlG := Character value: 241.
	LeftMarginTab := 1.
	CtrlC := Character value: 228.
	Ctrlv := Character value: 134.
	Justified := 3.
	Ctrlr := Character value: 18.
	DefaultTabsArray := #(24 48 72 96 120 144 168 192 216 240 264 288 312 336 360 384 408 432 456 480 504 528 552 576 600 624 648 672 696 720 744 768 792 816 840 864 888 912 936 960).
	Ctrln := Character value: 14.
	RightMarginTab := 2.
	Ctrlf := Character value: 12.
	Ctrlj := Character value: 165.
	Ctrlb := Character value: 166.
	CtrlZ := Character value: 231.
	CtrlV := Character value: 198.
	CtrlR := Character value: 239.
	Clear := Character value: 173.
	CtrlN := Character value: 245.
	BS := Character value: 8.
	CtrlJ := Character value: 229.
	Ctrly := Character value: 178.
	CtrlF := Character value: 226.
	BS2 := Character value: 158.
	Ctrlu := Character value: 21.
	CtrlB := Character value: 230.
	Ctrlq := Character value: 17.
	Ctrlm := Character value: 182.
	Ctrle := Character value: 130.
	CtrlDigits := #(159 144 143 128 127 129 131 180 149 135).
	Ctrli := Character value: 150.
	Ctrla := Character value: 1.
	Bold := 1.
	CtrlY := Character value: 242.
	CtrlU := Character value: 197.
	CR := Character value: 13.
	CtrlQ := Character value: 210.
	DefaultMask := Color black.
	CtrlM := Character value: 246.
	CtrlI := Character value: 214.
	Ctrlx := Character value: 151.
	CtrlE := Character value: 194.
	Ctrlt := Character value: 11.
	CtrlA := Character value: 212.
	Ctrlp := Character value: 138.
	DefaultBaseline := 12.! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Ctrlt
	^Ctrlt! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Ctrlk
	^Ctrlk! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CtrlM
	^CtrlM! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Ctrlz
	^Ctrlz! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Ctrlp
	^Ctrlp! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Ctrlc
	^Ctrlc! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CtrlR
	^CtrlR! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
BS2
	^BS2! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Ctrlm
	^Ctrlm! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CtrlZ
	^CtrlZ! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
DefaultLineGrid
	^DefaultLineGrid! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
DefaultSpace
	^DefaultSpace! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Ctrls
	^Ctrls! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CtrlO
	^CtrlO! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
DefaultTabsArray
	^DefaultTabsArray! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CtrlV
	^CtrlV! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CtrlY
	^CtrlY! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CtrlE
	^CtrlE! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Ctrlu
	^Ctrlu! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Ctrln
	^Ctrln! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CrossedX
	^CrossedX! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
BS
	^BS! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CtrlJ
	^CtrlJ! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Ctrlf
	^Ctrlf! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CtrlK
	^CtrlK! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Ctrlq
	^Ctrlq! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Ctrle
	^Ctrle! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Tab
	^Tab! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CtrlN
	^CtrlN! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
DefaultTab
	^DefaultTab! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CtrlD
	^CtrlD! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Ctrlr
	^Ctrlr! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Ctrlh
	^Ctrlh! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
RightMarginTab
	^RightMarginTab! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CtrlF
	^CtrlF! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Ctrlv
	^Ctrlv! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Bold
	^Bold! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CtrlQ
	^CtrlQ! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Enter
	^Enter! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Ctrld
	^Ctrld! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
LeftFlush
	^LeftFlush! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
RightFlush
	^RightFlush! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CtrlI
	^CtrlI! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
TextSharedInformation
	^TextSharedInformation! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
DefaultMask
	^DefaultMask! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CtrlL
	^CtrlL! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CtrlH
	^CtrlH! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Ctrlw
	^Ctrlw! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Space
	^Space! !

!TextConstants class methodsFor: 'backward compatibility' stamp: 'BenjaminVanRyseghem 3/18/2011 11:20'!
at: aSymbol
	
	^ self classPool at: aSymbol ifAbsent: [self TextSharedInformation at: aSymbol]! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Centered
	^Centered! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CtrlOpenBrackets
	^CtrlOpenBrackets! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CtrlA
	^CtrlA! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Clear
	^Clear! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CtrlB
	^CtrlB! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Ctrlx
	^Ctrlx! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Ctrlg
	^Ctrlg! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CtrlP
	^CtrlP! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Ctrlo
	^Ctrlo! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Ctrlj
	^Ctrlj! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CtrlT
	^CtrlT! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Ctrlb
	^Ctrlb! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CtrlC
	^CtrlC! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
DefaultBaseline
	^DefaultBaseline! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
DefaultRule
	^DefaultRule! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CtrlW
	^CtrlW! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CtrlS
	^CtrlS! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
CtrlDigits
	^CtrlDigits! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
ESC
	^ESC! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Ctrla
	^Ctrla! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
Ctrli
	^Ctrli! !

!TextConstants class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
DefaultFontFamilySize
	^DefaultFontFamilySize! !

!TextContainer commentStamp: '<historical>'!
A TextContainer models the shape of an ownerMorph, possibly occluded by one or more occludingMorphs, and scans this shape to provide a list of rectangles suitable for layout of text.  It does this by displaying the shadow of the ownerMorph in black, and any occludingMorphs in white, on its shadowForm.  It then scans horizontal strips of appropriate height to find unbroken intervals of black, greater than minWidth in extent.  Conputation of the rectangles is done on demand, and results are cached so that text can be redisplayed without having to recompute the rectangles.!
!TextContainer methodsFor: 'access' stamp: 'di 11/13/97 14:45'!
fillsOwner: aBoolean
	fillsOwner := aBoolean.
	self releaseCachedState! !

!TextContainer methodsFor: 'private' stamp: 'ar 10/26/2000 20:04'!
bounds
	| bounds theText |
	self fillsOwner ifFalse: [^ textMorph textBounds].
	theText := textMorph.
	bounds := theText owner innerBounds.
	bounds := bounds insetBy: (textMorph valueOfProperty: #margins ifAbsent: [1@1]).
	theText owner submorphsBehind: theText do:
		[:m | bounds := bounds merge: m fullBounds].
	^ bounds! !

!TextContainer methodsFor: 'container protocol' stamp: 'di 10/28/97 18:32'!
width  "for compatibility"
	^ textMorph owner width! !

!TextContainer methodsFor: 'access' stamp: 'di 11/4/97 14:05'!
avoidsOcclusions
	^ avoidsOcclusions ifNil: [false]! !

!TextContainer methodsFor: 'access' stamp: 'di 11/4/97 14:05'!
fillsOwner
	^ fillsOwner ifNil: [true]! !

!TextContainer methodsFor: 'container protocol' stamp: 'dgd 2/22/2003 19:06'!
rectanglesAt: lineY height: lineHeight 
	"Return a list of rectangles that are at least minWidth wide
	in the specified horizontal strip of the shadowForm.
	Cache the results for later retrieval if the owner does not change."

	| hProfile rects thisWidth thisX count pair outerWidth lineRect lineForm |
	pair := Array with: lineY with: lineHeight.
	rects := rectangleCache at: pair ifAbsent: [nil].
	rects ifNotNil: [^rects].
	outerWidth := minWidth + (2 * OuterMargin).
	self shadowForm.	"Compute the shape"
	lineRect := 0 @ (lineY - shadowForm offset y) 
				extent: shadowForm width @ lineHeight.
	lineForm := shadowForm copy: lineRect.

	"Check for a full line -- frequent case"
	(lineForm tallyPixelValues second) = lineRect area 
		ifTrue: 
			[rects := Array with: (shadowForm offset x @ lineY extent: lineRect extent)]
		ifFalse: 
			["No such luck -- scan the horizontal profile for segments of minWidth"

			hProfile := lineForm xTallyPixelValue: 1 orNot: false.
			rects := OrderedCollection new.
			thisWidth := 0.
			thisX := 0.
			1 to: hProfile size
				do: 
					[:i | 
					count := hProfile at: i.
					count >= lineHeight 
						ifTrue: [thisWidth := thisWidth + 1]
						ifFalse: 
							[thisWidth >= outerWidth 
								ifTrue: 
									[rects addLast: ((thisX + shadowForm offset x) @ lineY 
												extent: thisWidth @ lineHeight)].
							thisWidth := 0.
							thisX := i]].
			thisWidth >= outerWidth 
				ifTrue: 
					[rects addLast: ((thisX + shadowForm offset x) @ lineY 
								extent: thisWidth @ lineHeight)]].
	rects := rects collect: [:r | r insetBy: OuterMargin @ 0].
	rectangleCache at: pair put: rects.
	^rects! !

!TextContainer methodsFor: 'container protocol' stamp: 'di 10/28/97 18:33'!
left 
	^ textMorph owner left! !

!TextContainer methodsFor: 'container protocol' stamp: 'di 11/16/97 09:33'!
top
	"Note we should really check for contiguous pixels here"
	| outerWidth |
	outerWidth := minWidth + (2*OuterMargin).
	^ (self vertProfile findFirst: [:count | count >= outerWidth]) - 1
		+ shadowForm offset y! !

!TextContainer methodsFor: 'container protocol' stamp: 'di 10/28/97 18:33'!
topLeft  "for compatibility"
	^ textMorph owner topLeft! !

!TextContainer methodsFor: 'access' stamp: 'di 11/16/97 09:39'!
releaseCachedState

	shadowForm := nil.
	vertProfile := nil.
	rectangleCache := Dictionary new.
! !

!TextContainer methodsFor: 'container protocol' stamp: 'di 11/7/97 12:01'!
translateBy: delta
	self releaseCachedState! !

!TextContainer methodsFor: 'container protocol' stamp: 'di 10/27/97 23:09'!
bottom
	"Note we should really check for contiguous pixels here"
	^ (self vertProfile findLast: [:count | count >= minWidth])
		+ shadowForm offset y! !

!TextContainer methodsFor: 'private' stamp: 'di 11/4/97 14:06'!
for: aTextMorph minWidth: wid
	textMorph := aTextMorph.
	minWidth := wid.
	fillsOwner := true.
	avoidsOcclusions := false.! !

!TextContainer methodsFor: 'private' stamp: 'di 10/27/97 23:09'!
shadowForm
	shadowForm ifNil: [self computeShadow].
	^ shadowForm! !

!TextContainer methodsFor: 'access' stamp: 'di 11/13/97 14:45'!
avoidsOcclusions: aBoolean
	avoidsOcclusions := aBoolean.
	self releaseCachedState! !

!TextContainer methodsFor: 'access' stamp: 'tk 8/31/2000 14:50'!
textMorph
	^ textMorph! !

!TextContainer methodsFor: 'private' stamp: 'IgorStasenko 7/18/2011 18:46'!
computeShadow
	| canvas bounds theText |
	bounds := self bounds.
	theText := textMorph.
	canvas := (Display defaultCanvasClass extent: bounds extent depth: 1)
		asShadowDrawingCanvas: Color black.
	canvas translateBy: bounds topLeft negated during:[:tempCanvas| | back |
		self fillsOwner
			ifTrue: [tempCanvas fullDrawMorph: (theText owner copyWithoutSubmorph: theText)]
			ifFalse: [tempCanvas fillRectangle: textMorph bounds color: Color black].
		self avoidsOcclusions ifTrue:
			[back := tempCanvas form deepCopy.
			tempCanvas form fillWhite.
			theText owner submorphsInFrontOf: theText do:
				[:m | (textMorph isLinkedTo: m)
					ifTrue: []
					ifFalse: [tempCanvas fullDrawMorph: m]].
			back displayOn: tempCanvas form at: 0@0 rule: Form reverse].
	].
	shadowForm := canvas form offset: bounds topLeft.
	vertProfile := shadowForm  yTallyPixelValue: 1 orNot: false.
	rectangleCache := Dictionary new.
	^ shadowForm! !

!TextContainer methodsFor: 'private' stamp: 'di 10/27/97 23:08'!
vertProfile
	vertProfile ifNil: [self computeShadow].
	^ vertProfile! !

!TextContainer class methodsFor: 'initialization' stamp: 'di 11/16/97 09:25'!
initialize    "TextContainer initialize"
	OuterMargin := 2! !

!TextConverter commentStamp: '<historical>'!
The abstract class for all different type of text converters.  nextFromStream: and nextPut:toStream: are the public accessible methods.  If you are going to make a subclass for a stateful text conversion, you should override restoreStateOf:with: and saveStateOf: along the line of CompoundTextConverter.
!
!TextConverter methodsFor: 'conversion' stamp: 'HenrikSperreJohansen 1/27/2010 18:07'!
convertToSystemString: aString

	| writeStream |
	writeStream := String new writeStream.
	self nextPutAll: aString toStream: writeStream.
	self emitSequenceToResetStateIfNeededOn: writeStream.
	^writeStream contents! !

!TextConverter methodsFor: 'private' stamp: 'HenrikSperreJohansen 8/17/2012 11:36'!
nextPutByteString: aString toStream: aStream

	"This is a reasonable default which speeds up conversion of encodings which have a partial match with latin1 encoding (for instance ascii supersets)"
	| lastIndex nextIndex |
	lastIndex := 1.
	[nextIndex := ByteString findFirstInString: aString inSet: latin1Map startingAt: lastIndex.
	nextIndex = 0] whileFalse:
		[aStream next: nextIndex-lastIndex putAll: aString startingAt: lastIndex.
		aStream basicNextPutAll: (latin1Encodings at: (aString byteAt: nextIndex)+1).
		lastIndex := nextIndex + 1].
	aStream basicNext: aString size-lastIndex+1 putAll: aString startingAt: lastIndex.! !

!TextConverter methodsFor: 'friend' stamp: 'yo 2/21/2004 03:26'!
restoreStateOf: aStream with: aConverterState

	aStream position: aConverterState.
! !

!TextConverter methodsFor: 'friend' stamp: 'yo 2/21/2004 03:59'!
saveStateOf: aStream

	^ aStream position.
! !

!TextConverter methodsFor: 'conversion' stamp: 'yo 8/19/2002 15:27'!
nextFromStream: aStream

	self subclassResponsibility.
! !

!TextConverter methodsFor: 'initialization' stamp: 'HenrikSperreJohansen 2/5/2010 20:24'!
initialize
	latin1Map := self class latin1Map.
	latin1Encodings := self class latin1Encodings.! !

!TextConverter methodsFor: 'conversion' stamp: 'HenrikSperreJohansen 8/17/2012 11:31'!
next: anInteger putAll: aString startingAt: startIndex toStream: aStream
        "Handle fast conversion if ByteString"
        
        | lastIndex nextIndex |
        aString class == ByteString ifFalse: [
                startIndex to: startIndex + anInteger - 1 do: [ :index |
                        self nextPut: (aString at: index) toStream: aStream ].
                ^aString ].
        aStream isBinary ifTrue: [
                aStream basicNext: anInteger putAll: aString startingAt: startIndex.
                ^aString ].
        
        ^self next: anInteger putByteString: aString startingAt: startIndex toStream: aStream! !

!TextConverter methodsFor: 'private' stamp: 'HenrikSperreJohansen 8/17/2012 11:31'!
next: anAmount putByteString: aString startingAt: startIndex toStream: aStream

	"This is a reasonable default which speeds up conversion of encodings which have a partial match with latin1 encoding (for instance ascii supersets)"
	| lastIndex nextIndex |
	lastIndex := startIndex.
	[nextIndex := ByteString findFirstInString: aString inSet: latin1Map startingAt: lastIndex.
	nextIndex = 0 or: [nextIndex >= (startIndex + anAmount) ]] whileFalse:
		[aStream next: nextIndex-lastIndex putAll: aString startingAt: lastIndex.
		aStream basicNextPutAll: (latin1Encodings at: (aString byteAt: nextIndex)+1).
		lastIndex := nextIndex + 1].
	aStream basicNext: anAmount - lastIndex + startIndex putAll: aString startingAt: lastIndex.! !

!TextConverter methodsFor: 'conversion' stamp: 'HenrikSperreJohansen 8/10/2010 15:55'!
nextPutAll: aString toStream: aStream
	"Handle fast conversion if ByteString"
	
	| lastIndex nextIndex |
	aString class == ByteString ifFalse: [
		aString do: [:char | self nextPut: char toStream: aStream].
		^self].
	
	aStream isBinary ifTrue: [
		aStream basicNextPutAll: aString.
		^self].
	self nextPutByteString: aString toStream: aStream.
	^self
! !

!TextConverter methodsFor: 'conversion' stamp: 'michael.rueger 1/27/2009 18:12'!
convertFromSystemString: aString

	| readStream writeStream |
	readStream := aString readStream.
	writeStream := String new writeStream.

	[readStream atEnd] whileFalse: [
		writeStream nextPut: (self nextFromStream: readStream)].
	^writeStream contents
! !

!TextConverter methodsFor: 'initialize-release' stamp: 'HenrikSperreJohansen 1/27/2010 18:03'!
installLineEndConvention: lineEndStringOrNil

	
	lineEndStringOrNil ifNotNil:
		[latin1Encodings := latin1Encodings copy.
		latin1Encodings at: Character cr asciiValue + 1 put: (self convertFromSystemString: lineEndStringOrNil).
		latin1Map := ByteString nonAsciiMap copy.
		latin1Map at: Character cr asciiValue + 1 put: 1]! !

!TextConverter methodsFor: 'friend' stamp: 'yo 7/29/2003 15:51'!
emitSequenceToResetStateIfNeededOn: aStream
! !

!TextConverter methodsFor: 'conversion' stamp: 'yo 8/19/2002 15:27'!
nextPut: aCharacter toStream: aStream

	self subclassResponsibility.
! !

!TextConverter class methodsFor: 'instance creation' stamp: 'yo 7/25/2003 14:08'!
defaultConverterClassForEncoding: encodingName
	"TextConverter defaultConverterClassForEncoding: 'shift-jis'"

	^ self allSubclasses
		detect: [:class | class encodingNames includes: encodingName]
		ifNone: []
! !

!TextConverter class methodsFor: 'instance creation' stamp: 'yo 12/28/2003 00:54'!
default

	^ UTF8TextConverter new.
! !

!TextConverter class methodsFor: 'utilities' stamp: 'yo 7/5/2004 19:41'!
allEncodingNames
	"TextConverter allEncodingNames"
	| encodingNames |
	encodingNames := Set new.
	self allSubclasses
		do: [:each | 
			| names | 
			names := each encodingNames.
			names notEmpty
				ifTrue: [encodingNames add: names first asSymbol]].
	^encodingNames! !

!TextConverter class methodsFor: 'accessing' stamp: 'nice 5/9/2009 23:35'!
latin1Encodings
	"Answer an Array mapping latin1 characters to conversion string"

	^latin1Encodings ifNil:
		[self initializeLatin1MapAndEncodings.
		latin1Encodings]! !

!TextConverter class methodsFor: 'instance creation' stamp: 'mir 7/20/2004 15:51'!
defaultSystemConverter

	^LanguageEnvironment defaultSystemConverter! !

!TextConverter class methodsFor: 'utilities' stamp: 'yo 8/19/2002 15:28'!
encodingNames 

	^ #() copy.
! !

!TextConverter class methodsFor: 'accessing' stamp: 'nice 5/9/2009 23:34'!
latin1Map
	"Answer a ByteArray map telling if latin1 characters needs conversion or not"

	^latin1Map ifNil:
		[self initializeLatin1MapAndEncodings.
		latin1Map]! !

!TextConverter class methodsFor: 'accessing' stamp: 'nice 5/10/2009 00:45'!
initializeLatin1MapAndEncodings
	"Initialize the latin1Map and latin1Encodings.
	These variables ensure that conversions from latin1 ByteString is reasonably fast"
	
	| latin1 utf8 |
	latin1Map := ByteArray new: 256.
	latin1Encodings := Array new: 256.
	0 to: 255 do:[:i|
		utf8 := (String new: 8) writeStream.
		latin1 := String with: (Character value: i).
		self new nextPut: latin1 first toStream: utf8.
		utf8 := utf8 contents.
		latin1 = utf8 ifTrue:[
			latin1Map at: i+1 put: 0. "no translation needed"
		] ifFalse:[
			latin1Map at: i+1 put: 1. "translation needed"
			latin1Encodings at: i+1 put: utf8.
		].
	].! !

!TextConverter class methodsFor: 'instance creation' stamp: 'GabrielOmarCotelli 12/4/2013 09:57'!
newForEncoding: aString
	| encoding |
	aString ifNil: [ ^ Latin1TextConverter new ].
	encoding := aString asLowercase.
	^ self allSubclasses
		detect: [ :each | each encodingNames includes: encoding ]
		ifFound: [ :class | class new ]
		ifNone: [ nil ]! !

!TextDiffBuilder commentStamp: 'HenrikSperreJohansen 5/21/2010 02:00'!
I implement the diff algorithm. I can show the differences between two texts. See my method comments for further information.

Instance Variables
	xLines:		<Array>
	yLines:		<Array>

xLines
	- an Array of DiffElement which is created from the first input text

yLines
	- an Array of DiffElement which is created from the second input text!
!TextDiffBuilder methodsFor: 'creating patches' stamp: 'HenrikSperreJohansen 5/21/2010 01:54'!
buildPatchSequence
	"This method is only implemented for backwards compatibility and testing."

	^Array streamContents: [ :stream |
		self 
			patchSequenceDoIfMatch: [ :string |
				stream nextPut: #match -> (string copyWithout: Character cr) ]
			ifInsert: [ :string | 
				stream nextPut: #insert -> (string copyWithout: Character cr) ]
			ifRemove: [ :string | 
				stream nextPut: #remove -> (string copyWithout: Character cr) ] ]! !

!TextDiffBuilder methodsFor: 'initialize' stamp: 'HenrikSperreJohansen 5/21/2010 01:46'!
from: xString to: yString

	xLines := (self split: xString asString) replace: [ :each | DiffElement string: each ].
	yLines := (self split: yString asString) replace: [ :each | DiffElement string: each ].
	self findMatches! !

!TextDiffBuilder methodsFor: 'creating patches' stamp: 'MarcusDenker 9/30/2013 22:54'!
patchSequenceDoIfMatch: matchBlock ifInsert: insertBlock ifRemove: removeBlock
	"I'm the general purpose method to iterate through the patch sequence. See my senders to learn how to use me."

	| xLine xLineStream |
	xLineStream := xLines readStream.
	yLines
		do: [ :yLine | 
			yLine hasMatch
				ifFalse: [ insertBlock value: yLine string ]
				ifTrue: [ 
					[ (xLine := xLineStream next) isNil or: [ xLine == yLine match ] ] whileFalse: [ removeBlock value: xLine string ].
					matchBlock value: yLine string ] ].
	[ (xLine := xLineStream next) isNil ] whileFalse: [ removeBlock value: xLine string ]! !

!TextDiffBuilder methodsFor: 'creating patches' stamp: 'HenrikSperreJohansen 5/21/2010 01:54'!
buildDisplayPatch

	^Text streamContents: [ :stream |
		self 
			patchSequenceDoIfMatch: [ :string |
				self print: string withAttributes: NormalTextAttributes on: stream ]
			ifInsert: [ :string |
				self print: string withAttributes: InsertTextAttributes on: stream ]
			ifRemove: [ :string |
				self print: string withAttributes: RemoveTextAttributes on: stream ] ]! !

!TextDiffBuilder methodsFor: 'private' stamp: 'HenrikSperreJohansen 5/21/2010 01:45'!
print: aString withAttributes: attributes on: stream

	stream
		withAttributes: attributes 
		do: [ 
			stream nextPutAll: aString.
			(aString notEmpty and: [ 
				aString last = Character cr or: [
					aString endsWith: String crlf ] ]) 
						ifFalse: [ stream cr ] ]! !

!TextDiffBuilder methodsFor: 'private' stamp: 'ul 1/10/2011 19:23'!
lcsFor: xFilteredLines and: yFilteredLines
	"I find one of the longest common subsequences of my the arguments. I assume that none of my arguments are empty. I return nil or an Array which represents a list. The first two elements are the matching line numbers, the last is the next node in the list or nil if there are no more elements. The list containts the longest common subsequence. I'm a modified version of the greedy lcs algorithm from the 6th page of 'An O(ND) Difference Algorithm and Its Variations (1986)' by Eugene W. Myers"

	| n m v lcss max |
	n := xFilteredLines size.
	m := yFilteredLines size.
	max := m + n.
	v := Array new: 2 * max + 1.
	v at: max + 2 put: 0.
	lcss := Array new: 2 * max + 1.
	0 to: max do: [ :d |
		d negated to: d by: 2 do: [ :k |
			| index lcs x y |
			index := max + k.
			(k + d = 0 or: [ k ~= d and: [ (v at: index) < (v at: index + 2) ] ])
				ifTrue: [ x := v at: (index := index + 2) ]
				ifFalse: [ x := (v at: index) + 1 ].
			y := x - k.
			lcs := lcss at: index.
			[ x < n and: [ y < m and: [ (xFilteredLines at: x + 1) = (yFilteredLines at: y + 1) ] ] ]
				whileTrue: [
					lcs := { x := x + 1. y := y + 1. lcs } ].
			(x >= n and: [ y >= m ]) ifTrue: [ ^lcs ].
			v at: max + k + 1 put: x.
			lcss at: max + k + 1 put: lcs ] ].
	self error! !

!TextDiffBuilder methodsFor: 'private' stamp: 'HenrikSperreJohansen 5/21/2010 01:44'!
split: aString
	"I return an Array of strings which are the lines extracted from aString. All lines contain the line separator characters, or not depending on preference."

	^Array streamContents: [ :stream |
		self class ignoreLineEndings
			ifTrue: [aString lineIndicesDo: [ :start :endWithoutSeparators :end |
				stream nextPut: (aString copyFrom: start to: endWithoutSeparators) ] ]
			ifFalse: [aString lineIndicesDo: [ :start :endWithoutSeparators :end |
				stream nextPut: (aString copyFrom: start to: end) ] ] ]! !

!TextDiffBuilder methodsFor: 'private' stamp: 'MarcusDenker 9/30/2013 22:54'!
findMatches
	"I find the matching pairs of xLines and yLines. First I filter out all lines that can't have a pair, then I find the longest common subsequence of the remaining elements. Finally I mark the matching pairs."

	| temp lcs xFilteredLines yFilteredLines xNumbers yNumbers |
	"Filter out all lines that can't have a pair."
	temp := yLines asSet.
	xFilteredLines := xLines select: [ :each | temp includes: each ].
	xFilteredLines size = 0
		ifTrue: [ ^ self ].
	temp := xLines asSet.
	yFilteredLines := yLines select: [ :each | temp includes: each ].
	yFilteredLines size = 0
		ifTrue: [ ^ self ].	"Map all lines to SmallIntegers, because they can be compared faster."
	temp := Dictionary new.
	xNumbers := xFilteredLines collect: [ :each | temp at: each ifAbsentPut: [ temp size ] ].
	yNumbers := yFilteredLines collect: [ :each | temp at: each ifAbsentPut: [ temp size ] ].
	temp := nil.	"Find the longest common subsequence."
	lcs := self lcsFor: xNumbers and: yNumbers.	"Mark the matching pairs."
	[ lcs isNil ]
		whileFalse: [ 
			(xFilteredLines at: (lcs at: 1)) matches: (yFilteredLines at: (lcs at: 2)).
			lcs := lcs at: 3 ]! !

!TextDiffBuilder class methodsFor: 'settings' stamp: 'HenrikSperreJohansen 5/21/2010 01:21'!
ignoreLineEndings: aBoolean
	"Setting for  if line ending differences should be ignored or emphasized"
	
	IgnoreLineEndings := aBoolean! !

!TextDiffBuilder class methodsFor: 'class initialization' stamp: 'HenrikSperreJohansen 5/21/2010 01:20'!
initialize

	self initializeTextAttributes! !

!TextDiffBuilder class methodsFor: 'instance creation' stamp: 'HenrikSperreJohansen 5/21/2010 01:39'!
buildDisplayPatchFrom: srcString to: dstString inClass: srcClass prettyDiffs: prettyDiffs 
	"Build a display patch for mapping via diffs from srcString to dstString
	in the given class. If prettyDiffs is true, do the diffing for pretty-printed forms"

	| differ |
	differ := prettyDiffs
				ifTrue: [PrettyTextDiffBuilder]
				ifFalse: [self].
	^ (differ
		from: srcString
		to: dstString
		inClass: srcClass) buildDisplayPatch! !

!TextDiffBuilder class methodsFor: 'settings' stamp: 'StephaneDucasse 11/11/2014 18:50'!
differatorSettingsOn: aBuilder 
	<systemsettings>
	(aBuilder group: #differator) 
		label: 'Differator';
		parent: #codeBrowsing; 
		description: 'All settings concerned with the differator' ;
		with: [	
			(aBuilder setting: #ignoreLineEndings) 
				label: 'Ignore line endings';
				target: self;
		 		description: 'When selected, line ending differences will be ignored ' ];
		with: [  
		(aBuilder setting: #diffsWithPrettyPrint)
				target: self;	
				label: 'Pretty print differences' ;
				description: 'If true, displays of source code differences will be pretty-printed first' 
		]! !

!TextDiffBuilder class methodsFor: 'settings' stamp: 'MarcusDenker 7/23/2014 17:40'!
diffsWithPrettyPrint
	^ DiffsWithPrettyPrint ifNil: [DiffsWithPrettyPrint := false]! !

!TextDiffBuilder class methodsFor: 'instance creation' stamp: 'HenrikSperreJohansen 5/21/2010 01:39'!
from: srcString to: dstString inClass: srcClass
	"srcClass not used when not pretty printing, but have it for polymorphism with PrettyTextDiffBuilder"

	^self new from: srcString to: dstString! !

!TextDiffBuilder class methodsFor: 'instance creation' stamp: 'HenrikSperreJohansen 5/21/2010 01:39'!
from: srcString to: dstString

	^self new from: srcString to: dstString! !

!TextDiffBuilder class methodsFor: 'settings' stamp: 'HenrikSperreJohansen 5/21/2010 01:21'!
ignoreLineEndings
	"Answer a boolean telling if line endings differences should be ignored or emphasized"
	
	^IgnoreLineEndings ifNil: [ true ]! !

!TextDiffBuilder class methodsFor: 'instance creation' stamp: 'MarcusDenker 7/23/2014 17:43'!
buildDisplayPatchFrom: sourceText to: destinationText inClass: sourceClass 

	^self 
		buildDisplayPatchFrom: sourceText 
		to: destinationText
		inClass: sourceClass
		prettyDiffs: self diffsWithPrettyPrint
		! !

!TextDiffBuilder class methodsFor: 'class initialization' stamp: 'HenrikSperreJohansen 5/21/2010 01:20'!
initializeTextAttributes

	InsertTextAttributes :=  {TextEmphasis bold. TextColor color: Color green muchDarker}.
	RemoveTextAttributes := {TextEmphasis bold. TextColor color: Color red darker} .
	NormalTextAttributes :={ TextEmphasis normal }! !

!TextDiffBuilder class methodsFor: 'instance creation' stamp: 'HenrikSperreJohansen 5/21/2010 01:38'!
buildDisplayPatchFrom: sourceText to: destinationText

	^(self from: sourceText to: destinationText) buildDisplayPatch! !

!TextDiffBuilder class methodsFor: 'settings' stamp: 'MarcusDenker 7/23/2014 17:40'!
diffsWithPrettyPrint: aBoolean
	DiffsWithPrettyPrint := aBoolean! !

!TextDiffBuilderTest commentStamp: 'StephaneDucasse 1/3/2010 22:34'!
Tests for the new algorithm that is diffing changes.
Tests from L. Uzonyi (from squeak trunk System.ul207and 208)!
!TextDiffBuilderTest methodsFor: 'tests' stamp: 'ul 12/27/2009 21:23'!
testSameSequence

	| patch |
	patch := self patchSequenceFor: #(a b c) and: #(a b c).
	self assert: patch size = 3.	
	self assert: (patch allSatisfy: [ :each | each key = #match ])! !

!TextDiffBuilderTest methodsFor: 'private' stamp: 'klub 12/28/2009 00:04'!
convertToString: array

	^String streamContents: [ :stream |
		array do: [ :each |
			stream nextPutAll: each asString; cr ] ]! !

!TextDiffBuilderTest methodsFor: 'tests' stamp: 'klub 12/28/2009 00:02'!
testEmptyLcs3

	| patch |
	patch := self patchSequenceFor: #(a b c) and: #(d e f g).
	self assert: patch size = 7.	
	patch do: [ :each |
		each key = #remove ifTrue: [ self assert: ('abc' includes: each value first) ].
		each key = #insert ifTrue: [ self assert: ('defg' includes: each value first) ] ]! !

!TextDiffBuilderTest methodsFor: 'tests' stamp: 'ul 12/28/2009 06:12'!
testIfPatchIsMinimal

	| patch |
	patch := self patchSequenceFor: #(a a a b) and: #(a b a a).
	self assert: patch size = 5.	"lcs is aaa"
	self assert: (patch count: [ :each | each key = #match ]) = 3.
	self assert: (patch count: [ :each | each key = #insert ]) = 1.
	self assert: (patch count: [ :each | each key = #remove ]) = 1.
	patch do: [ :each | 
		each key = #match 
			ifTrue: [ self assert: each value first = $a ]
			ifFalse: [ self assert: each value first = $b ] ]! !

!TextDiffBuilderTest methodsFor: 'tests' stamp: 'ul 12/28/2009 06:00'!
testIfSequence4

	| patch |
	patch := self patchSequenceFor: #(a b c d) and: #(d b c a).
	self assert: patch size = 6.	"lcs is bc"
	self assert: (patch count: [ :each | each key = #match ]) = 2.
	self assert: (patch count: [ :each | each key = #insert ]) = 2.
	self assert: (patch count: [ :each | each key = #remove ]) = 2.
	patch do: [ :each | 
		each key = #match 
			ifTrue: [ self assert: ('bc' includes: each value first) ]
			ifFalse: [ self assert: ('ad' includes: each value first) ] ]! !

!TextDiffBuilderTest methodsFor: 'tests' stamp: 'ul 12/27/2009 21:23'!
testEmptyLcs2

	| patch |
	patch := self patchSequenceFor: #() and: #(a b c).
	self assert: patch size = 3.	
	self assert: (patch allSatisfy: [ :each | each key = #insert ])! !

!TextDiffBuilderTest methodsFor: 'tests' stamp: 'ul 12/28/2009 05:59'!
testIfSequence3

	| patch |
	patch := self patchSequenceFor: #(a b c d) and: #(b d c a).
	self assert: patch size = 6.	"lcs is bd"
	self assert: (patch count: [ :each | each key = #match ]) = 2.
	self assert: (patch count: [ :each | each key = #insert ]) = 2.
	self assert: (patch count: [ :each | each key = #remove ]) = 2.
	patch do: [ :each | 
		each key = #match 
			ifTrue: [ self assert: ('bd' includes: each value first) ]
			ifFalse: [ self assert: ('ac' includes: each value first) ] ]! !

!TextDiffBuilderTest methodsFor: 'tests' stamp: 'ul 12/28/2009 06:10'!
testIfSequence6

	| patch |
	patch := self patchSequenceFor: #(a b c d) and: #(d a b c).
	self assert: patch size = 5.	"lcs is abc"
	self assert: (patch count: [ :each | each key = #match ]) = 3.
	self assert: (patch count: [ :each | each key = #insert ]) = 1.
	self assert: (patch count: [ :each | each key = #remove ]) = 1.
	patch do: [ :each | 
		each key = #match 
			ifTrue: [ self assert: ('abc' includes: each value first) ]
			ifFalse: [ self assert: each value first = $d ] ]! !

!TextDiffBuilderTest methodsFor: 'tests' stamp: 'ul 12/28/2009 06:12'!
testIfSequence1

	| patch |
	patch := self patchSequenceFor: #(a b c d) and: #(d c b a).
	self assert: patch size = 7.	"lcs is any one letter sequence"
	self assert: (patch count: [ :each | each key = #match ]) = 1.
	self assert: (patch count: [ :each | each key = #insert ]) = 3.
	self assert: (patch count: [ :each | each key = #remove ]) = 3.
	patch do: [ :each | 
		each key = #match 
			ifTrue: [ self assert: each value first = $d ]
			ifFalse: [ self assert: ('abc' includes: each value first) ] ]! !

!TextDiffBuilderTest methodsFor: 'tests' stamp: 'ul 12/27/2009 21:23'!
testEmptyLcs1

	| patch |
	patch := self patchSequenceFor: #(a b c) and: #().
	self assert: patch size = 3.
	self assert: (patch allSatisfy: [ :each | each key = #remove ])! !

!TextDiffBuilderTest methodsFor: 'tests' stamp: 'ul 12/28/2009 05:58'!
testIfSequence2

	| patch |
	patch := self patchSequenceFor: #(a b c d) and: #(c d b a).
	self assert: patch size = 6.	"lcs is cd"
	self assert: (patch count: [ :each | each key = #match ]) = 2.
	self assert: (patch count: [ :each | each key = #insert ]) = 2.
	self assert: (patch count: [ :each | each key = #remove ]) = 2.
	patch do: [ :each | 
		each key = #match 
			ifTrue: [ self assert: ('cd' includes: each value first) ]
			ifFalse: [ self assert: ('ab' includes: each value first) ] ]! !

!TextDiffBuilderTest methodsFor: 'tests' stamp: 'ul 12/27/2009 21:24'!
testSameSequenceWithRepetitions

	| patch |
	patch := self patchSequenceFor: #(a a b a) and: #(a a b a).
	self assert: patch size = 4.	
	self assert: (patch allSatisfy: [ :each | each key = #match ])! !

!TextDiffBuilderTest methodsFor: 'private' stamp: 'ul 12/27/2009 21:03'!
patchSequenceFor: x and: y

	^(TextDiffBuilder
		from: (self convertToString: x)
		to:  (self convertToString: y)) buildPatchSequence! !

!TextDiffBuilderTest methodsFor: 'tests' stamp: 'ul 12/27/2009 21:09'!
testEmptySequences

	| patch |
	patch := self patchSequenceFor: #() and: #().
	self assert: patch isEmpty! !

!TextDiffBuilderTest methodsFor: 'tests' stamp: 'ul 12/28/2009 06:09'!
testIfSequence5

	| patch matches nonMatches |
	patch := self patchSequenceFor: #(a b c d) and: #(c d a b).
	self assert: patch size = 6.	"lcs is ab or cd"
	matches := (patch select: [ :each | each key = #match ])
		collect: [ :each | each value first ] as: String.
	self assert: (#('ab' 'cd') includes: matches).
	self assert: (patch count: [ :each | each key = #insert ]) = 2.
	self assert: (patch count: [ :each | each key = #remove ]) = 2.
	nonMatches := #('ab' 'cd') detect: [ :each | each ~= matches ].
	patch do: [ :each | 
		each key = #match 
			ifTrue: [ self assert: (matches includes: each value first) ]
			ifFalse: [ self assert: (nonMatches includes: each value first) ] ]! !

!TextDoIt commentStamp: 'TorstenBergmann 1/31/2014 12:16'!
A doIt action on a text. When the text is clicked the text is seen as source code and evaluated!
!TextDoIt methodsFor: 'styling' stamp: 'tk 12/16/97 13:46'!
writeScanOn: strm

	strm nextPut: $d; nextPutAll: evalString; nextPutAll: ';;'! !

!TextDoIt methodsFor: 'evaluating' stamp: 'MarcusDenker 12/7/2013 23:51'!
actOnClick: anEvent for: anObject in: paragraph editor: editor

	"Note: evalString gets evaluated IN THE CONTEXT OF anObject
	 -- meaning that self and all instVars are accessible"
	Smalltalk compiler evaluate: evalString for: anObject logged: false.
	^ true ! !

!TextDoIt methodsFor: 'testing' stamp: 'tk 12/16/97 16:46'!
analyze: aString

	| list |
	list := super analyze: aString.
	evalString := list at: 1.
	^ list at: 2! !

!TextDoIt methodsFor: 'accessing' stamp: 'tk 12/5/97 17:01'!
evalString: str
	evalString := str ! !

!TextDoIt methodsFor: 'accessing' stamp: 'tk 12/30/97 10:33'!
info
	^ evalString! !

!TextDoIt class methodsFor: 'as yet unclassified' stamp: 'tk 12/16/97 09:06'!
scanFrom: strm
	"read a doit in the funny format used by Text styles on files. d10 factorial;;  end with two semicolons"

	| pos end doit |
	pos := strm position.
	[strm skipTo: $;. strm peek == $;] whileFalse.
	end := strm position - 1.
	strm position: pos.
	doit := strm next: end-pos.
	strm skip: 2.  ";;"
	^ self evalString: doit! !

!TextDoIt class methodsFor: 'as yet unclassified' stamp: 'tk 12/6/97 20:28'!
evalString: str
	^ self new evalString: str! !

!TextEditor commentStamp: '<historical>'!
See comment in Editor.

My instances edit Text, this is, they support multiple lines and TextAttributes.
They have no specific facilities for editing Smalltalk code. Those are found in SmalltalkEditor.!
!TextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 11/8/2010 22:09'!
stopBlock
	^ self editingState pointBlock max: self editingState markBlock! !

!TextEditor methodsFor: 'nonediting/nontyping keys' stamp: 'AlainPlantec 11/8/2010 22:09'!
cursorEnd: aKeyboardEvent 

	"Private - Move cursor end of current line."
	| string |
	self closeTypeIn.
	string := self string.
	self
		moveCursor:
			[:position | self walkAlongDisplayedLine
				ifTrue:[| targetLine |
					targetLine := self paragraph lines at: (self paragraph lineIndexOfCharacterIndex: position).
					targetLine = self paragraph lines  last 
						ifTrue:[targetLine last + 1]
						ifFalse:[targetLine last]]
				ifFalse:[
					string
						indexOf: Character cr
						startingAt: position
						ifAbsent:[string size + 1]]]
		forward: true
		specialBlock:[:dummy | string size + 1]
		event: aKeyboardEvent.
	^true! !

!TextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 9/15/2011 17:26'!
blankParagraph
	| blankParagraph |
	blankParagraph  := Paragraph new.
	blankParagraph 
		compose:  '' asText 
		style:  TextStyle default copy    
		from: 1
		in:  (0@0 extent: 10@10) .
	^ blankParagraph	! !

!TextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 11/8/2010 22:09'!
replaceSelectionWith: aText
	self replace: self selectionInterval with: aText and: []
! !

!TextEditor methodsFor: 'typing support' stamp: 'AlainPlantec 11/8/2010 22:09'!
startOfTyping
	^ self editingState startOfTyping  ! !

!TextEditor methodsFor: 'initialize-release' stamp: 'AlainPlantec 11/8/2010 22:09'!
stateArray
	^ Array with: self editingState! !

!TextEditor methodsFor: 'typing support' stamp: 'CamilloBruni 2/26/2011 16:40'!
performCmdActionsWith: aKeyboardEvent shifted: aBoolean return: return
	| asciiValue actions action|
	asciiValue := aKeyboardEvent keyValue + 1.
	actions := aBoolean
				ifTrue: [self class shiftCmdActions]
				ifFalse: [self class cmdActions].
	action := (actions at: asciiValue).
	action == #noop: ifTrue: [ ^ false ].
	return value: ( self perform: action with: aKeyboardEvent).! !

!TextEditor methodsFor: 'new selection' stamp: 'AlainPlantec 11/8/2010 22:09'!
afterSelectionInsertAndSelect: aString

	self insertAndSelect: aString at: self stopIndex ! !

!TextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 11/8/2010 22:09'!
compareToClipboard: aKeyboardEvent
	"Compare the receiver to the text on the clipboard."

	self compareToClipboard.
	^ true! !

!TextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 11/8/2010 22:09'!
cancel: aKeyboardEvent
	"Cancel unsubmitted changes."

	self cancel.
	^ true! !

!TextEditor methodsFor: 'private' stamp: 'AlainPlantec 11/8/2010 22:09'!
nullText

	^Text string: '' attributes: self emphasisHere! !

!TextEditor methodsFor: 'private' stamp: 'AlainPlantec 11/8/2010 22:09'!
moveCursor: directionBlock forward: forward specialBlock: specialBlock event: aKeyboardEvent

	super moveCursor: directionBlock forward: forward specialBlock: specialBlock event: aKeyboardEvent.
	self setEmphasisHereFromTextForward: forward! !

!TextEditor methodsFor: 'typing support' stamp: 'AlainPlantec 11/8/2010 22:09'!
startOfTyping: anIntegerIndex
	self editingState startOfTyping:  anIntegerIndex! !

!TextEditor methodsFor: 'typing support' stamp: 'AlainPlantec 11/8/2010 22:09'!
closeTypeIn
	"See comment in openTypeIn. It is important to call
	closeTypeIn before executing any non-typing key, making a new selection, etc. It is
	called automatically for menu commands."
	self startOfTyping 
		ifNotNil: [self addTypeInUndoRecord.
			self doneTyping]! !

!TextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 11/8/2010 22:09'!
yellowButtonActivity
	"This normally opens a popup menu. Determine the selected
	item and, if one is selected, then send the corresponding message
	to either the model or the receiver."

	^ self pluggableYellowButtonActivity: false! !

!TextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 11/16/2010 10:07'!
markBlock
	^ self editingState markBlock! !

!TextEditor methodsFor: 'typing support' stamp: 'GuillermoPolito 4/20/2011 18:44'!
handleKeystrokeAction: aBlock
	(aBlock value)
			ifTrue: [self doneTyping.
			self storeSelectionInParagraph.
			^self].
	self openTypeIn.
	self hasSelection 
		ifTrue: [ "save highlighted characters"
			self editingState previousInterval: self selectionInterval selection: self selection].
	self editingState unselect.
	self storeSelectionInParagraph! !

!TextEditor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 11/8/2010 22:09'!
changeStyle: aKeyboardEvent 
	"Put up the style-change menu"

	self closeTypeIn.
	self changeStyle.
	^ true! !

!TextEditor methodsFor: 'typing support' stamp: 'GuillermoPolito 4/20/2011 19:35'!
processKeyStroke: aKeyboardEvent
	"Key struck on the keyboard. Find out which one and, if special, carry 
	out the associated special action. Otherwise, add the character to the 
	stream of characters.  Undoer & Redoer: see closeTypeIn."
	
	^self handleKeystrokeAction: [self dispatchOn: aKeyboardEvent].! !

!TextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 11/27/2010 16:27'!
setSearch: aString
	"Make the current selection, if any, be the current search string."
	self findText: aString isRegex: false.
	^ true! !

!TextEditor methodsFor: 'menu messages' stamp: 'SvenVanCaekenberghe 1/8/2012 14:49'!
setSelectorSearch: aStringOrText 
	"Make the current selection as a selector search in current FindReplaceService."
	| regex |
	regex := aStringOrText asString trimBoth.
	regex := regex copyReplaceAll: '#' with: ''.
	regex := regex copyReplaceAll: ' ' with: ''.
	self findText: regex isRegex: false caseSensitive: true entireWordsOnly: false.
	^ true! !

!TextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 11/8/2010 22:09'!
chooseAlignment
	self changeAlignment! !

!TextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 11/8/2010 22:09'!
markIndex
	^ self editingState markBlock stringIndex! !

!TextEditor methodsFor: 'find-select' stamp: 'AlainPlantec 11/19/2010 17:26'!
findNext: aRegex startingAt: searchIdx 
	| strm match range |
	strm := (self string copyFrom: searchIdx to: self string size) readStream.
	aRegex searchStream: strm.
	match := aRegex subexpression: 1.
	match ifNotNil: [range := (aRegex position + searchIdx - match size) to: (aRegex position + searchIdx - 1)].
	^ range! !

!TextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 12/14/2010 14:46'!
replace: xoldInterval with: newText and: selectingBlock 
	"Replace the text in oldInterval with newText and
	execute selectingBlock to establish the new selection.
	Create an UndoRecord to allow perfect undoing."
	| prevSel currInterval undoRec |
	self selectInterval: xoldInterval.
	prevSel := self selection.
	currInterval := self selectionInterval.
	self editingState previousInterval: currInterval selection: self selection.
	self zapSelectionWith: newText.
	selectingBlock value.
	((prevSel isEmpty and: [newText isEmpty]) and: [currInterval size < 1]) 
		ifFalse: [self editingState
			redoArray: {morph. #redoTypeIn:interval:. {newText. currInterval}} 
			undoArray: {morph. #undoTypeIn:interval:. {prevSel. currInterval first to: currInterval first + newText size - 1}}]! !

!TextEditor methodsFor: 'events' stamp: 'CamilloBruni 2/6/2012 23:02'!
mouseUp: evt
	"An attempt to break up the old processRedButton 
	code into three phases"
	| mouseDownInterval clickPoint b|
	
	(mouseDownInterval := self editingState mouseDownInterval)
		ifNil: [^ self]. 
		
	(self paragraph click: evt for: model controller: self ) 
		ifTrue: [
			self updateSelectionFromEvent: evt.
			evt hand releaseKeyboardFocus: self.
			^ self ].

	(evt yellowButtonChanged or: [ evt commandKeyPressed]) 
		ifTrue: [
			(self morph editView yellowButtonActivity: evt shiftPressed) 
				ifTrue: [ ^ self ]].
		
	(self hasCaret and: [mouseDownInterval = self selectionInterval])
		ifTrue: [self selectWord].
		
	self setEmphasisHereFromText.
	self storeSelectionInParagraph! !

!TextEditor methodsFor: 'initialize-release' stamp: 'IgorStasenko 12/12/2010 04:06'!
initWithMorph: aMorph
	
	super initialize.
	morph := aMorph.
	self resetState.! !

!TextEditor methodsFor: 'private' stamp: 'AlainPlantec 11/8/2010 22:09'!
setEmphasisHere
	self editingState emphasisHere: ((self text attributesAt: (self pointIndex - 1 max: 1) forStyle: self textStyle)
					select: [:att | att mayBeExtended])! !

!TextEditor methodsFor: 'nonediting/nontyping keys' stamp: 'CamilloBruni 2/4/2012 14:50'!
raiseContextMenu: aKeyboardEvent

	(morph respondsTo: #editView)
		ifTrue: [ ^ morph editView yellowButtonActivity: ActiveEvent shiftPressed].
	^ true! !

!TextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 11/8/2010 22:09'!
totalTextHeight

	^self paragraph lines last bottom! !

!TextEditor methodsFor: 'events' stamp: 'BenjaminVanRyseghem 5/16/2013 14:18'!
mouseDownOnUnselectedText: event
	self editingState mouseDown: event from: morph.
	self closeTypeIn.	"no matter what, if shift is pressed extend the selection"
	event shiftPressed
		ifTrue: [ ^ self mouseMove: event ].
	event yellowButtonPressed
		ifTrue: [ self yellowButtonDown: event ]
		ifFalse: [ 
			"no right/yellowbutton click just reposoition the cursor"
			self updateSelectionFromEvent: event ]! !

!TextEditor methodsFor: 'private' stamp: 'AlainPlantec 10/20/2011 00:28'!
codeCompletionAround:  aBlock textMorph:  aTextMorph keyStroke: anEvent
	" No code completion for simple text editor, so nothing special to do here around the block execution"
	aBlock value! !

!TextEditor methodsFor: 'current selection' stamp: 'AlainPlantec 11/8/2010 22:09'!
reverseSelection
	"Reverse the valence of the current selection highlighting."
	selectionShowing := selectionShowing not.
	self paragraph reverseFrom: self editingState pointBlock to: self editingState markBlock! !

!TextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 11/8/2010 22:09'!
changeEmphasis: aKeyboardEvent
	"Change the emphasis of the current selection or prepare to accept characters with the change in emphasis. Emphasis change amounts to a font change.  Keeps typeahead."

	"control 0..9 -> 0..9"

	| keyCode attribute oldAttributes index thisSel colors |
	keyCode := ('0123456789-=' indexOf: aKeyboardEvent keyCharacter ifAbsent: [1]) - 1.
	oldAttributes := self text attributesAt: self pointIndex.
	thisSel := self selection.

	"Decipher keyCodes for Command 0-9..."
	"
	(keyCode between: 1 and: 5) 
		ifTrue: [attribute := TextFontChange fontNumber: keyCode].
	"
	keyCode = 6 
		ifTrue: [
			colors := #(#black #magenta #red #yellow #green #blue #cyan #white).
			index := UIManager default chooseFrom:  colors title: 'choose color...'.
			index = 0 ifTrue: [^true].
			index <= colors size 
				ifTrue: [attribute := TextColor color: (Color perform: (colors at: index))]
				ifFalse: [
					index := index - colors size - 1.	"Re-number!!!!!!"
					index = 0 ifTrue: [attribute := self chooseColor].
					thisSel ifNil: [^true]	"Could not figure out what to link to"]].
	(keyCode between: 7 and: 11) 
		ifTrue: [
			aKeyboardEvent shiftPressed 
				ifTrue: [
					keyCode = 10 ifTrue: [attribute := TextKern kern: -1].
					keyCode = 11 ifTrue: [attribute := TextKern kern: 1]]
				ifFalse: [
					attribute := TextEmphasis 
								perform: (#(#bold #italic #narrow #underlined #struckOut) at: keyCode - 6).
					oldAttributes 
						do: [:att | (att dominates: attribute) ifTrue: [attribute turnOff]]]].
	keyCode = 0 ifTrue: [ attribute := TextEmphasis normal ].
	attribute ifNotNil: [
		self applyAttribute: attribute].
	^true! !

!TextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 11/24/2010 16:12'!
startBlock
	^ self editingState pointBlock min: self editingState markBlock! !

!TextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 11/8/2010 22:09'!
pasteRecent
	"Paste an item chose from RecentClippings."

	| clipping |
	(clipping := Clipboard chooseRecentClipping) ifNil: [^ self].
	Clipboard clipboardText: clipping.
	^ self paste! !

!TextEditor methodsFor: 'private' stamp: 'ClementBera 9/30/2013 10:58'!
exchangeWith: prior
	"If the prior selection is non-overlapping and legal, exchange the text of
	 it with the current selection and leave the currently selected text selected
	 in the location of the prior selection (or leave a caret after a non-caret if it was
	 exchanged with a caret).  If both selections are carets, flash & do nothing.
	 Don't affect the paste buffer.  Undoer: itself; Redoer: Undoer."

	| start stop before currSelection priorSelection delta redoArgs altInterval undoArgs |
	start := self startIndex.
	stop := self stopIndex - 1.
	(((prior first <= prior last) or: [ start <= stop]) "Something to exchange" and:
			[self isDisjointFrom: prior])
		ifTrue:
			[before := prior last < start.
			currSelection := self selection.
			priorSelection := self text copyFrom: prior first to: prior last.
			delta := before ifTrue: [0] ifFalse: [priorSelection size - currSelection size].
			self zapSelectionWith: priorSelection.
			redoArgs := { prior. start to: stop}.
						
			self selectFrom: prior first + delta to: prior last + delta.
			delta := before ifTrue: [stop - prior last] ifFalse: [start - prior first].
			self zapSelectionWith: currSelection.
			
			altInterval := prior first + delta to: prior last + delta.
			undoArgs := {altInterval. self startIndex to: self stopIndex - 1}.
			"self undoer: #exchangeWith: with: altInterval."
			prior first > prior last ifTrue: [self selectAt: self editingState previousInterval last + 1].
			self editingState
				redoArray: { morph. #undoRedoExchange:with:. redoArgs} 
				undoArray: {morph. #undoRedoExchange:with:. undoArgs}]
		ifFalse:
			[morph flash]! !

!TextEditor methodsFor: 'editing keys' stamp: 'CamilloBruni 8/1/2012 16:12'!
offerFontMenu: aKeyboardEvent 
	"The user typed the command key that requests a font change; Offer the font menu."

	self closeTypeIn.
	self offerFontMenu.
	^ true! !

!TextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 11/17/2010 18:47'!
lastFont	
	"Answer the Font for to be used if positioned at the end of the text"
	| t |	
	t := self text.	
	^ t fontAt: t size + 1! !

!TextEditor methodsFor: 'scrolling' stamp: 'AlainPlantec 11/11/2010 11:05'!
scrollBy: ignore 
	"Ignore scroll requests."
! !

!TextEditor methodsFor: 'find-select' stamp: 'AlainPlantec 11/9/2010 19:40'!
findPrevious: aRegex startingAt: searchIdx 
	| allRanges |
	allRanges := self findAll: aRegex endingAt: searchIdx.
	^ allRanges notEmpty
		ifTrue: [allRanges last].
! !

!TextEditor methodsFor: 'accessing' stamp: 'SeanDeNigris 7/11/2012 20:47'!
findText: aString isRegex: aBoolean
	self findReplaceService findText: aString isRegex: aBoolean.
	self findReplaceService changed: #newFinding
! !

!TextEditor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 12/14/2010 22:49'!
backspace: aKeyboardEvent
	| result |
	self closeTypeIn.
	result := super backspace: aKeyboardEvent.
	self editingState keystroke: aKeyboardEvent from: morph.
	^ result! !

!TextEditor methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/28/2012 17:46'!
selectionPosition: aString

	| startIndex |
	startIndex := self startIndex.
	^[
		| bottomLeft topLeft index |
		index := startIndex - aString size.
		self selectInvisiblyFrom: index to: index - 1.
		bottomLeft := self paragraph selectionRects first bottomLeft.
		topLeft := self morph owner submorphBounds topLeft.
		topLeft + bottomLeft ]
			ensure: [ self selectInvisiblyFrom: startIndex to: startIndex - 1 ]! !

!TextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 11/8/2010 22:09'!
offerFontMenu
	"Present a menu of available fonts, and if one is chosen, apply it to the current selection.  
	Use only names of Fonts of this paragraph  "
	
	^self changeTextFont! !

!TextEditor methodsFor: 'parenblinking' stamp: 'AlainPlantec 11/16/2010 10:15'!
blinkParen
	| lastParenLocation |
	(lastParenLocation := self editingState lastParenLocation) ifNotNil: [
		self text string size >= lastParenLocation ifTrue: [
			self text
				addAttribute: TextEmphasis bold
				from: lastParenLocation
				to: lastParenLocation]]! !

!TextEditor methodsFor: 'typing support' stamp: 'CamilloBruni 2/26/2011 14:15'!
dispatchEnterOn: aKeyboardEvent return: aBlock
	aKeyboardEvent keyValue = 13
		 ifFalse: [ ^ false ].
	aKeyboardEvent controlKeyPressed 
		ifTrue: [ aBlock value: (self normalCharacter: aKeyboardEvent) ].
	aKeyboardEvent shiftPressed 
		ifTrue: [  aBlock value:  (self lf: aKeyboardEvent) ].
	aKeyboardEvent commandKeyPressed 
		ifTrue: [  aBlock value:  (self crlf: aKeyboardEvent) ].
	 aBlock value:  (self crWithIndent: aKeyboardEvent)! !

!TextEditor methodsFor: 'parenblinking' stamp: 'AlainPlantec 11/8/2010 22:09'!
clearParens
	| lastLocation |
	(lastLocation := self editingState lastParenLocation) 
		ifNil: [^ self].
	self text size >= lastLocation 
		ifTrue: [ self text
			removeAttribute: TextEmphasis bold
			from: lastLocation
			to: lastLocation].
	self editingState lastParenLocation: nil! !

!TextEditor methodsFor: 'typing support' stamp: 'GuillermoPolito 4/20/2011 19:36'!
handleEditionAction: anAction fromKeyboardEvent: aKeyboardEvent
	(self editingState handlesKeyboard: aKeyboardEvent from: morph)
		ifFalse: [self handleKeystrokeAction: anAction ].
	self editingState keystroke: aKeyboardEvent from: morph.! !

!TextEditor methodsFor: 'menu messages' stamp: 'StephaneDucasse 4/23/2012 10:14'!
changeEmphasis

	|  reply code align menuList startIndex attribute choices |
	choices := self emphasisChoices.
	startIndex := self startIndex.
	align := self text alignmentAt: startIndex ifAbsent: [ 0 ].
	code := self text emphasisAt: startIndex.
	menuList := WriteStream on: Array new.
	menuList nextPut: (code isZero ->  'normal' translated).
	menuList nextPutAll: (choices  collect: [:emph|
							(code anyMask: (TextEmphasis perform: emph) emphasisCode)
								-> emph asString translated ]).
						
	menuList nextPut: ((self text attributesAt: startIndex)
							anySatisfy: [ :attr | attr isKern and: [attr kern < 0 ]]) -> 'narrow' translated.
	reply := UIManager default chooseFrom:  choices values: choices.
	reply notNil 
		ifTrue: [ attribute := TextEmphasis perform: reply.
				self applyAttribute:  attribute].
	^ true! !

!TextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 11/8/2010 22:09'!
changeLfToCr: aKeyboardEvent
	"Replace all LFs by CRs.
	Triggered by Cmd-U -- useful when getting code from FTP sites
	jmv- Modified to als change crlf by cr"
	
	| fixed |
	fixed := self selection string.
	fixed := fixed copyReplaceAll: String crlf with: String cr.
	fixed := fixed copyReplaceAll: String lf with: String cr. 
	self replaceSelectionWith: (Text fromString: fixed).
	^ true! !

!TextEditor methodsFor: 'typing support' stamp: 'CamilloBruni 2/26/2011 16:07'!
dispatchCommandOn: aKeyboardEvent return: return
	|asciiValue honorCommandKeys char|

	asciiValue := aKeyboardEvent keyValue.
	honorCommandKeys := self cmdKeysInText.
	"Special keys overwrite crtl+key combinations - at least on Windows. To resolve this
	conflict, assume that keys other than cursor keys aren't used together with Crtl." 
	((self class specialShiftCmdKeys includes: asciiValue) and: [ asciiValue < 27])
		ifTrue: [
			^ self performCmdActionsWith: aKeyboardEvent 
				shifted: aKeyboardEvent controlKeyPressed
				return: return].

	"backspace, and escape keys (ascii 8 and 27) are command keys"
	((honorCommandKeys and: [aKeyboardEvent commandKeyPressed]) or: [self class specialShiftCmdKeys includes: asciiValue]) 
		ifTrue: [
			^ self performCmdActionsWith: aKeyboardEvent 
				shifted: aKeyboardEvent shiftPressed
				return: return].

	"the control key can be used to invoke shift-cmd shortcuts"
	(honorCommandKeys and: [aKeyboardEvent controlKeyPressed])
		ifTrue: [
			^ self performCmdActionsWith: aKeyboardEvent shifted: true return: return].
			
	^ false
! !

!TextEditor methodsFor: 'shortcuts' stamp: 'ThierryGoubier 9/15/2012 20:55'!
installKeymappingsOn: aMorph
 	aMorph attachKeymapCategory: #TextEditor.
	aMorph attachKeymapCategory: #TextMorph targetting: aMorph textMorph.
	aMorph attachKeymapCategory: #TextMorphTab! !

!TextEditor methodsFor: 'find-select' stamp: 'AlainPlantec 11/9/2010 18:40'!
findAndSelect: aRegex startingAt: anIndex searchBackwards: searchBackwards
	| oldSelectionInterval where |
	self closeTypeIn.
	oldSelectionInterval := self selectionInterval.
	self selectInvisiblyFrom: anIndex to: anIndex - 1.
	where :=  searchBackwards
		ifTrue: [self findAndSelectPreviousOccurenceOf: aRegex]
		ifFalse: [self findAndSelectNextOccurenceOf: aRegex].
	where ifNil: [self selectInterval: oldSelectionInterval].
	^ where! !

!TextEditor methodsFor: 'current selection' stamp: 'AlainPlantec 11/8/2010 22:09'!
recomputeSelection
	"Redetermine the selection according to the start and stop block indices; 
	do not highlight."

	self recomputeInterval! !

!TextEditor methodsFor: 'typing support' stamp: 'AlainPlantec 11/8/2010 22:09'!
setEmphasisHereFromTextForward: f

	| i t forward delta prevIsSeparator nextIsSeparator |
	i := self pointIndex.
	t := self text.
	"Try to set emphasisHere correctly after whitespace.
	Most important after a cr, i.e. at the start of a new line"
	prevIsSeparator :=  i > 1 and: [ (t at: i-1) isSeparator ].
	nextIsSeparator := i <= t size and: [ (t at: i) isSeparator ].
	forward := prevIsSeparator = nextIsSeparator
		ifTrue: [ f ]
		ifFalse: [ nextIsSeparator ].
	delta := forward ifTrue: [ 1 ] ifFalse: [ 0 ].
	self editingState emphasisHere: ((t attributesAt: (i - delta max: 1)) select: [:att | att mayBeExtended]).
	! !

!TextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 11/8/2010 22:09'!
selection
	"Answer the text in the paragraph that is currently selected."

	^self text copyFrom: self startIndex to: self stopIndex - 1 ! !

!TextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 11/8/2010 22:09'!
hasCaret
	^self editingState markBlock = self editingState pointBlock! !

!TextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 11/17/2010 16:00'!
findAgain
	"Find the text-to-find again."
	| where |
	where := self findReplaceService findNextSubString: self findReplaceService findString inTextMorph: self morph.
	where isNil
		ifTrue: [self flash]
		ifFalse: [ self selectInterval: where].
	^ where
! !

!TextEditor methodsFor: 'mvc compatibility' stamp: 'FernandoOlivero 4/12/2011 10:41'!
storeSelectionInParagraph
	self theme currentSettings haveSelectionTextColor 
		ifTrue: [
			self text removeAttribute: TextSelectionColor primarySelection.
			self text addAttribute: TextSelectionColor primarySelection from: self startIndex to: self stopIndex - 1].
	self paragraph selectionStart: self startBlock selectionStop: self stopBlock! !

!TextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 12/30/2010 09:26'!
accept: aKeyboardEvent 
	"Save the current text of the text being edited as the current acceptable version for purposes of canceling.  Allow my morph to take appropriate action"
	self accept.
	^ true! !

!TextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 11/9/2010 15:05'!
editingStateClass
	^ EditingState! !

!TextEditor methodsFor: 'find-select' stamp: 'AlainPlantec 11/9/2010 19:40'!
findAll: aRegex endingAt: searchIdx 
	| ranges |
	ranges := aRegex matchingRangesIn: (self string copyFrom: 1 to: searchIdx).
	^ ranges 
			! !

!TextEditor methodsFor: 'deprecated' stamp: 'AlainPlantec 11/8/2010 22:09'!
offerMenuFromEsc: aKeyboardEvent
	"The escape key was hit while the receiver has the keyboard focus; take action"
 	ActiveEvent shiftPressed 
		ifFalse: [ self raiseContextMenu: aKeyboardEvent].
	^ false 	! !

!TextEditor methodsFor: 'initialize-release' stamp: 'AlainPlantec 11/11/2010 19:01'!
resetState 
	"Establish the initial conditions for editing the paragraph: place caret 
	before first character, set the emphasis to that of the first character,
	and save the paragraph for purposes of canceling."
 
	self editingState markBlock: self paragraph defaultCharacterBlock.
	self editingState pointBlock: self editingState markBlock copy.
	self startOfTyping: nil.
	self editingState previousInterval: (1 to: 0) selection: self nullText.
	self setEmphasisHereFromText.
	selectionShowing := true! !

!TextEditor methodsFor: 'new selection' stamp: 'FernandoOlivero 6/16/2010 12:53'!
selectLine
	"Make the receiver's selection, if it currently consists of an insertion point only, encompass the current line."
	self hasSelection ifTrue:[^self].
	self selectInterval: (self encompassParagraph: self selectionInterval)! !

!TextEditor methodsFor: 'typing support' stamp: 'CamilloBruni 2/26/2011 16:40'!
dispatchOn: aKeyboardEvent
	"Carry out the action associated with this character, if any.
	Type-ahead is passed so some routines can flush or use it."
	"TODO rename to dispatch: "
	
	| char return keyEvents|
 	return := [:val| ^ val].

	self acceptCR: aKeyboardEvent return: return.
	self clearParens.
	self dispatchEnterOn: aKeyboardEvent return: return.
	self dispatchCommandOn: aKeyboardEvent return: return.
			
	char := aKeyboardEvent keyCharacter.
      ( ')]}'  includes: char) 
		ifTrue: [ self blinkPrevParen: char ].
		
       ^ self normalCharacter: aKeyboardEvent.
! !

!TextEditor methodsFor: 'new selection' stamp: 'MarcusDenker 2/27/2012 13:18'!
correctFrom: start to: stop with: aString
	"Make a correction in the model that the user has authorised from somewhere else in the system (such as from the compilier).  
	The user's selection is not changed, only corrected."
	| wasShowing userSelection delta loc |
	
	userSelection := self selectionInterval.
	self selectInvisiblyFrom: start to: stop.
	self replaceSelectionWith: aString asText.
	delta := aString size - (stop - start + 1).
	self selectInvisiblyFrom:
		userSelection first + (userSelection first > start ifFalse: [ 0 ] ifTrue: [ delta ])
		to: userSelection last + (userSelection last > start ifFalse: [ 0 ] ifTrue: [ delta ]).
! !

!TextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 11/8/2010 22:09'!
lastParagraphStyle
	"Answer the TextStyle for to be used if positioned at the end of the text"
	
	| t |
	t := self text.
	^self startIndex > t size
		ifTrue: [ self text styleIfApplying: self emphasisHere ]
		ifFalse: [ self text textStyleAt: t size +1 ]! !

!TextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 11/8/2010 22:09'!
markIndex: anIndex
	self editingState markBlock: (self paragraph characterBlockForIndex: anIndex)
! !

!TextEditor methodsFor: 'initialize-release' stamp: 'AlainPlantec 11/8/2010 22:09'!
stateArrayPut: stateArray
	editingState := stateArray at: 1.
! !

!TextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 11/8/2010 22:09'!
exchange
	"See comment in exchangeWith:"

	self exchangeWith: self editingState previousInterval! !

!TextEditor methodsFor: 'typing support' stamp: 'AlainPlantec 11/8/2010 22:09'!
addString: aString
	"Think of a better name"
	self zapSelectionWith: (Text string: aString attributes: self emphasisHere)! !

!TextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 2/14/2011 21:20'!
again
	"Text substitution. If the left shift key is down, the substitution is
	made throughout the entire Paragraph. Otherwise, only the next 
	possible substitution is made"
	true.
	! !

!TextEditor methodsFor: 'typing/selecting keys' stamp: 'CamilloBruni 2/6/2012 11:38'!
doAgainMany: aKeyboardEvent 
	"Do the previous thing again repeatedly."

	self closeTypeIn.
	^ true! !

!TextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 11/8/2010 22:09'!
align
	"Align text according to the next greater alignment value,
	cycling among leftFlush, rightFlush, center, and justified."
	self changeAlignment.
	self recomputeInterval! !

!TextEditor methodsFor: 'typing/selecting keys' stamp: 'CamilloBruni 8/1/2012 16:06'!
findAgain: aKeyboardEvent 
	"Find the desired text again."
	self closeTypeIn.
	self findAgain.
	^ true! !

!TextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 11/10/2010 19:55'!
setSearchString
	"Make the current selection, if any, be the current search string."
	self closeTypeIn.
	self setSearch: self selection string.
	^ true! !

!TextEditor methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 6/28/2012 17:47'!
isCaretBehindChar
	"Return true if the cursor position is after an alphanumeric character, otherwise false."

	| cursorPosition |
	^(cursorPosition := self startIndex) >= 2 and: [
		(self text at: cursorPosition - 1) isAlphaNumeric ]! !

!TextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 11/8/2010 22:09'!
undo
	"Undo  previous edit."
	self closeTypeIn.
	self editingState undo ifFalse: [morph flash]. 
! !

!TextEditor methodsFor: 'undo-redo private' stamp: 'AlainPlantec 12/14/2010 14:43'!
addDeleteSelectionUndoRecord
	| undoText redoText undoRec |
	undoText := self selection.
	redoText := self nullText.
	self editingState
		redoArray: { morph. #undoTypeIn:interval:.  {redoText. self selectionInterval} } 
		undoArray: {morph. #redoTypeIn:interval:.  {undoText. self selectionInterval first to: self selectionInterval first - 1} }.
! !

!TextEditor methodsFor: 'private' stamp: 'AlainPlantec 11/8/2010 22:09'!
pageHeight
	| howManyLines visibleHeight totalHeight ratio |
	howManyLines := self paragraph numberOfLines.
	visibleHeight := self visibleHeight.
	totalHeight := self totalTextHeight.
	ratio := visibleHeight / totalHeight.
	^(ratio * howManyLines) rounded - 2! !

!TextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 11/8/2010 22:09'!
unselect
	self markBlock: self pointBlock copy! !

!TextEditor methodsFor: 'typing support' stamp: 'GuillermoPolito 4/20/2011 19:42'!
keystroke: aKeyboardEvent
	self handleEditionAction: [ self dispatchOn: aKeyboardEvent ] 
		fromKeyboardEvent: aKeyboardEvent.! !

!TextEditor methodsFor: 'events' stamp: 'BenjaminVanRyseghem 5/16/2013 14:24'!
mouseDownOnSelectedText: event
	| selectors |
	selectors := Array
		with: #mouseDownOnUnselectedText:
		with: nil
		with: nil
		with:
			(self morph dragEnabled
				ifTrue: [ #startDrag: ]
				ifFalse: [ nil ]).
	event hand
		waitForClicksOrDrag: self
		event: event
		selectors: selectors
		threshold: 10! !

!TextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 11/8/2010 22:09'!
model: aModel 
	"Controller|model: and Controller|view: are sent by View|controller: in 
	order to coordinate the links between the model, view, and controller. In 
	ordinary usage, the receiver is created and passed as the parameter to 
	View|controller: so that the receiver's model and view links can be set 
	up by the view."

	model := aModel! !

!TextEditor methodsFor: 'parenblinking' stamp: 'AlainPlantec 11/17/2010 18:51'!
unapplyAttribute: aTextAttribute
	"The user selected aTextAttribute to be removed.
	If there is a selection, unapply the attribute to the selection.
	In any case do not use the attribute for the user input (emphasisHere)"

	| thisSel interval |

	self editingState emphasisHere: (self emphasisHere copyWithout: aTextAttribute).
	self selection
		ifEmpty: [ self paragraph composeAll ]				
		ifNotEmpty: [:sel | self replaceSelectionWith: (sel removeAttribute: TextAttribute).
			self paragraph composeAll.
			self recomputeSelection]! !

!TextEditor methodsFor: 'editing keys' stamp: 'CamilloBruni 8/1/2012 16:12'!
outdent: aKeyboardEvent
	"Remove a tab from the front of every line occupied by the selection."

	^ self inOutdent: aKeyboardEvent delta: -1! !

!TextEditor methodsFor: 'private' stamp: 'AlainPlantec 11/8/2010 22:09'!
sameColumn: start newLine: lineBlock forward: isForward
	"Private - Compute the index in my text
	with the line number derived from lineBlock,"
	" a one argument block accepting the old line number.
	The position inside the line will be preserved as good as possible"
	"The boolean isForward is used in the border case to determine if
	we should move to the beginning or the end of the line."
	| column currentLine offsetAtTargetLine targetEOL lines numberOfLines currentLineNumber targetLineNumber |
	self walkAlongDisplayedLine
		ifTrue: [lines := self paragraph lines.
			numberOfLines := self paragraph numberOfLines.
			currentLineNumber := self paragraph lineIndexOfCharacterIndex: start.
			currentLine := lines at: currentLineNumber]
		ifFalse: [lines := self lines.
			numberOfLines := lines size.
			currentLine := lines
				detect:[:lineInterval | lineInterval last >= start]
				ifNone:[lines last].
			currentLineNumber := currentLine second].
	column := start - currentLine first.
	targetLineNumber := ((lineBlock value: currentLineNumber) max: 1) min: numberOfLines.
	offsetAtTargetLine := (lines at: targetLineNumber) first.
	targetEOL := (lines at: targetLineNumber) last + (targetLineNumber = numberOfLines ifTrue:[1]ifFalse:[0]).
	targetLineNumber = currentLineNumber
	"No movement or movement failed. Move to beginning or end of line."
		ifTrue:[^isForward
			ifTrue:[targetEOL]
			ifFalse:[offsetAtTargetLine]].
	^offsetAtTargetLine + column min: targetEOL.! !

!TextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 11/8/2010 22:09'!
exchange: aKeyboardEvent
	"Exchange the current and prior selections."

	self closeTypeIn.
	self exchange.
	^true! !

!TextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 11/12/2010 08:27'!
findRegex
	^ self findReplaceService findRegex! !

!TextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 11/8/2010 22:09'!
text
	"Answer the text of the paragraph being edited."

	^self paragraph text! !

!TextEditor methodsFor: 'new selection' stamp: 'AlainPlantec 11/8/2010 22:09'!
selectFrom: start to: stop
	"Select the specified characters inclusive."
	self selectInvisiblyFrom: start to: stop.
	self closeTypeIn.
	self storeSelectionInParagraph.
	"Preserve current emphasis if selection is empty"
	stop > start 
		ifTrue: [self setEmphasisHereFromTextForward: true ]! !

!TextEditor methodsFor: 'displaying' stamp: 'AlainPlantec 11/8/2010 22:09'!
flash
	^ morph flash! !

!TextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 11/8/2010 22:09'!
saveContentsInFile
	"Save the receiver's contents string to a file, prompting the user for a file-name.  Suggest a reasonable file-name."

	| fileName stringToSave parentWindow labelToUse suggestedName lastIndex |
	stringToSave := self string. 
	stringToSave size = 0 ifTrue: [^self inform: 'nothing to save.'].
	parentWindow := model dependents 
				detect: [:dep | dep isKindOf: SystemWindow]
				ifNone: [nil].
	labelToUse := parentWindow ifNil: ['Untitled']
				ifNotNil: [parentWindow label].
	suggestedName := nil.
	#(#('Decompressed contents of: ' '.gz')) do: 
			[:leaderTrailer | 
			"can add more here..."

			(labelToUse beginsWith: leaderTrailer first) 
				ifTrue: 
					[suggestedName := labelToUse copyFrom: leaderTrailer first size + 1
								to: labelToUse size.
					(labelToUse endsWith: leaderTrailer last) 
						ifTrue: 
							[suggestedName := suggestedName copyFrom: 1
										to: suggestedName size - leaderTrailer last size]
						ifFalse: 
							[lastIndex := suggestedName lastIndexOf: $. ifAbsent: [0].
							(lastIndex = 0 or: [lastIndex = 1]) 
								ifFalse: [suggestedName := suggestedName copyFrom: 1 to: lastIndex - 1]]]].
	suggestedName ifNil: [suggestedName := labelToUse , '.text'].
	fileName := UIManager default request: 'File name?'
				initialAnswer: suggestedName.
	fileName isEmptyOrNil 
		ifFalse: 
			[(FileStream newFileNamed: fileName)
				nextPutAll: stringToSave;
				close]! !

!TextEditor methodsFor: 'events' stamp: 'AlainPlantec 11/19/2010 10:46'!
focused: aBoolean
	self editingState focused: aBoolean from: morph.
! !

!TextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 11/8/2010 22:09'!
textStyle
	^ self paragraph textStyle! !

!TextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 11/8/2010 22:09'!
editingState
	^ editingState ifNil: [editingState := self editingStateClass new]! !

!TextEditor methodsFor: 'constants' stamp: 'StephaneDucasse 5/25/2011 18:22'!
emphasisChoices
	"Return the list of emphasis that are possible to apply on the currently edited text morph"
	
	^  #(normal bold italic narrow underlined struckOut).	
	! !

!TextEditor methodsFor: 'private' stamp: 'CamilloBruni 2/6/2012 23:07'!
updateSelectionFromEvent: event

	| clickPoint b | 

	clickPoint := event cursorPoint.
	b := self paragraph characterBlockAtPoint: clickPoint.
	
	self editingState markBlock: b.
	self editingState pointBlock: b.
	
	self storeSelectionInParagraph! !

!TextEditor methodsFor: 'editing keys' stamp: 'CamilloBruni 8/1/2012 16:09'!
inOutdent: aKeyboardEvent delta: delta
	"Add/remove a tab at the front of every line occupied by the selection. 
	Derived from work by Larry Tesler back in December 1985."

	| cr realStart realStop lines startLine stopLine start stop adjustStart indentation size numLines inStream newString outStream |
	cr := Character cr.

	"Operate on entire lines, but remember the real selection for re-highlighting later"
	realStart := self startIndex.
	realStop := self stopIndex - 1.

	"Special case a caret on a line of its own, including weird case at end of paragraph"
	(realStart > realStop and: [
				realStart < 2 or: [(self string at: realStart - 1) == cr]])
		ifTrue:
			[delta < 0
				ifTrue: [
					morph flash]
				ifFalse: [
					self replaceSelectionWith: Character tab asSymbol asText.
					self selectAt: realStart + 1].
			^true].

	lines := self paragraph lines.
	startLine := self paragraph lineIndexOfCharacterIndex: realStart.
	stopLine := self paragraph lineIndexOfCharacterIndex: (realStart max: realStop).
	start := (lines at: startLine) first.
	stop := (lines at: stopLine) last.
	
	"Pin the start of highlighting unless the selection starts a line"
	adjustStart := realStart > start.

	"Find the indentation of the least-indented non-blank line; never outdent more"
	indentation := (startLine to: stopLine) inject: 1000 into: [ :previousValue :each |
		previousValue min: (self paragraph indentationOfLineIndex: each ifBlank: [ :tabs | 1000 ])].			

	size :=  stop + 1 - start.
	numLines := stopLine + 1 - startLine.
	inStream := ReadStream on: self string from: start to: stop.

	newString := String new: size + ((numLines * delta) max: 0).
	outStream := ReadWriteStream on: newString.

	"This subroutine does the actual work"
	self indent: delta fromStream: inStream toStream: outStream.

	"Adjust the range that will be highlighted later"
	adjustStart ifTrue: [realStart := (realStart + delta) max: start].
	realStop := realStop + outStream position - size.

	"Prepare for another iteration"
	indentation := indentation + delta.
	size := outStream position.
	inStream := outStream setFrom: 1 to: size.

	outStream == nil
		ifTrue: 	"tried to outdent but some line(s) were already left flush"
			[morph flash]
		ifFalse:
			[self selectInvisiblyFrom: start to: stop.
			size = newString size ifFalse: [newString := outStream contents].
			self replaceSelectionWith: newString asText].
	self selectFrom: realStart to: realStop. 	"highlight only the original range"
	^ true! !

!TextEditor methodsFor: 'new selection' stamp: 'BenjaminVanRyseghem 5/16/2013 14:16'!
deselect

	self selectFrom: 1 to: 0! !

!TextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 11/8/2010 22:09'!
enclose: aKeyboardEvent
	"Insert or remove bracket characters around the current selection."

	| left right startIndex stopIndex oldSelection which text |
	self closeTypeIn.
	startIndex := self startIndex.
	stopIndex := self stopIndex.
	oldSelection := self selection.
	which := '([<{"''' indexOf: aKeyboardEvent keyCharacter ifAbsent: [ ^true ].
	left := '([<{"''' at: which.
	right := ')]>}"''' at: which.
	text := self text.
	((startIndex > 1 and: [stopIndex <= text size])
			and: [ (text at: startIndex-1) = left and: [(text at: stopIndex) = right]])
		ifTrue: [
			"already enclosed; strip off brackets"
			self selectFrom: startIndex-1 to: stopIndex.
			self replaceSelectionWith: oldSelection]
		ifFalse: [
			"not enclosed; enclose by matching brackets"
			self replaceSelectionWith:
				(Text string: (String with: left), oldSelection string, (String with: right) attributes: self emphasisHere).
			self selectFrom: startIndex+1 to: stopIndex].
	^true! !

!TextEditor methodsFor: 'events' stamp: 'JuanVuletich 10/26/2010 14:23'!
doubleClick: evt

	self selectWord! !

!TextEditor methodsFor: 'mvc compatibility' stamp: 'FernandoOlivero 3/25/2011 11:27'!
zapSelectionWith: aText
	| start stop |
	morph canChangeText ifFalse: [^ self].
	start := self startIndex.
	stop := self stopIndex.
	(aText isEmpty and: [stop > start]) ifTrue: [
		"If deleting, then set emphasisHere from 1st character of the deletion"
		self editingState emphasisHere: ((self text attributesAt: start) select: [:att | att mayBeExtended])].
	(start = stop and: [ aText size = 0 ]) ifFalse: [
		self paragraph replaceFrom: start to: stop - 1 with: aText.
		self markIndex: start; pointIndex: start + aText size.
		self editingState previousInterval: self selectionInterval selection: self selection.
		self userHasEdited  " -- note text now dirty" ].
! !

!TextEditor methodsFor: 'editing keys' stamp: 'CamilloBruni 8/1/2012 16:09'!
indent: aKeyboardEvent
	"Add a tab at the front of every line occupied by the selection."

	^ self inOutdent: aKeyboardEvent delta: 1! !

!TextEditor methodsFor: 'typing/selecting keys' stamp: 'CamilloBruni 8/1/2012 16:05'!
find: aKeyboardEvent
	"Prompt the user for what to find, then find it, searching from the current selection onward."

	self closeTypeIn.
	self find.
	^ true! !

!TextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 11/8/2010 22:09'!
makeLowercase: aKeyboardEvent
	"Force the current selection to lowercase.  Triggered by Cmd-X."

	self closeTypeIn.
	self replaceSelectionWith: (Text fromString: (self selection string asLowercase)).
	^ true! !

!TextEditor methodsFor: 'accessing' stamp: 'StephaneDucasse 11/5/2012 21:54'!
previousCharacterIfAbsent: aBlock

	^ self text at: self startIndex - 1 ifAbsent: aBlock! !

!TextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 11/8/2010 22:09'!
undo: aKeyboardEvent 
	"Undo the last edit."

	self undo.
	^true! !

!TextEditor methodsFor: 'undoers-redoers' stamp: 'AlainPlantec 11/8/2010 22:09'!
redoTypeIn: aText interval: anInterval
	self selectInterval: anInterval.
	self replace: self selectionInterval with: aText and:
		[self selectInterval: (anInterval first to: anInterval first + aText size - 1)].
! !

!TextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 11/8/2010 22:09'!
makeCapitalized: aKeyboardEvent
	"Force the current selection to uppercase.  Triggered by Cmd-z."

	| prev |
	self closeTypeIn.
	prev := $-.  "not a letter"
	self replaceSelectionWith: (Text fromString:
		(self selection string collect:
			[:c | prev := prev isLetter ifTrue: [c asLowercase] ifFalse: [c asUppercase]])).
	^ true! !

!TextEditor methodsFor: 'undo-redo private' stamp: 'AlainPlantec 11/24/2010 16:31'!
clearUndoManager: aKeyboardEvent
	^ self editingState clearUndoManager: aKeyboardEvent.
! !

!TextEditor methodsFor: 'settings' stamp: 'AlainPlantec 11/8/2010 22:09'!
caseSensitiveFinds
	^ self class caseSensitiveFinds! !

!TextEditor methodsFor: 'private' stamp: 'AlainPlantec 11/8/2010 22:09'!
cut
	"Cut out the current selection and redisplay the paragraph if necessary.  Undoer & Redoer: undoCutCopy:"

	self lineSelectAndEmptyCheck: [^ self].
	self clipboardTextPut: self selection.
	self replaceSelectionWith: self nullText.
! !

!TextEditor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 12/14/2010 22:49'!
forwardDelete: aKeyboardEvent
	"Delete forward over the next character"
	self closeTypeIn.
	self hasSelection 
		ifFalse: [	| idx1 idx2 |
				idx1 := self startIndex min: self stopIndex.
				idx2 := self stopIndex max: self startIndex.
				aKeyboardEvent shiftPressed
					ifTrue: [idx2 := (self nextWord: idx1)]
					ifFalse: [idx2 := idx2 + 1].
				self selectInvisiblyFrom: idx1 to: idx2 - 1].
	self addDeleteSelectionUndoRecord.
	self zapSelectionWith: self nullText.
	^ false
! !

!TextEditor methodsFor: 'settings' stamp: 'AlainPlantec 11/8/2010 22:09'!
walkAlongDisplayedLine
	^ self class walkAlongDisplayedLine! !

!TextEditor methodsFor: 'private' stamp: 'AlainPlantec 11/12/2010 12:09'!
findText: aString isRegex: isRegex caseSensitive: caseSensitive entireWordsOnly: entireWordsOnly
	self findReplaceService findText: aString isRegex: isRegex caseSensitive: caseSensitive entireWordsOnly: entireWordsOnly
! !

!TextEditor methodsFor: 'find-select' stamp: 'AlainPlantec 11/9/2010 19:35'!
findAndSelectPreviousOccurenceOf: aRegex
	| where |
	where := self findPrevious: aRegex startingAt: self startIndex.
	where isNil ifFalse: [self selectInterval: where].
	(morph respondsTo: #editView) ifTrue: [morph editView selectionInterval: self selectionInterval].
	^ where! !

!TextEditor methodsFor: 'find-select' stamp: 'AlainPlantec 11/11/2010 23:40'!
replaceAll: aRegex with: aText
	| selec ranges |
	self editingState undoManager openRecordGroup.
	selec := self selectionInterval.
	ranges := self findAll: aRegex startingAt: selec first. 
	ranges reverseDo: [:r | self selectInvisiblyFrom: r first to: r last.
		self replaceSelectionWith: aText].
	self selectInterval: selec.
	self editingState undoManager closeRecordGroup.
! !

!TextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 11/8/2010 22:09'!
currentParagraphStyle
	"Answer the TextStyle for the current selection or cursor location if any"
	
	| i t |
	i := self startIndex.
	t := self text.
	^i > t size
		ifTrue: [ self text styleIfApplying: self emphasisHere ]
		ifFalse: [ self text textStyleAt: i ]! !

!TextEditor methodsFor: 'current selection' stamp: 'AlainPlantec 11/8/2010 22:09'!
recomputeInterval
	"The same characters are selected but their coordinates may have changed."

	self markIndex: self markIndex; pointIndex: self pointIndex! !

!TextEditor methodsFor: 'private' stamp: 'AlainPlantec 2/21/2011 19:28'!
encompassParagraph: anInterval
	"Return an interval that includes anInterval, and that comprises one or several whole paragraphs in the receiver.
	Answer starts at the position following a cr (or eventually 1) and ends at a cr (or eventually at self size)"
	^ self string encompassParagraph: anInterval
! !

!TextEditor methodsFor: 'events' stamp: 'CamilloBruni 2/6/2012 23:31'!
yellowButtonDown: anEvent
	"special case for right/yellobutton click.
	if clicking outside the current selection select the word."
	(self paragraph selectionContainsPoint: anEvent cursorPoint)
		ifFalse: [
			self mouseMove: anEvent.
			self selectWord ].! !

!TextEditor methodsFor: 'typing support' stamp: 'AlainPlantec 11/8/2010 22:09'!
openTypeIn
	"Set up startOfTyping to keep track of the leftmost backspace.
	 You can't undo typing until after closeTypeIn."

	self startOfTyping 
		ifNil: [self editingState previousInterval: (1 to: 0) selection: self nullText.
			self startOfTyping: self startIndex]! !

!TextEditor methodsFor: 'menu messages' stamp: 'StephaneDucasse 5/25/2011 17:38'!
changeAlignment
	"Interactively change the alignment of the text currently being edited."
	| reply  |
	reply := UIManager default 
				chooseFrom:  self alignmentChoices 
				values:  self alignmentChoices.	
	reply ifNil: [^self].
	self applyAttribute: (TextAlignment perform: reply).
	^ true! !

!TextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 11/8/2010 22:09'!
selectionAsStream
	"Answer a ReadStream on the text in the paragraph that is currently 
	selected."

	^ReadStream
		on: (self string copyFrom: self startIndex to: self stopIndex - 1)! !

!TextEditor methodsFor: 'find-select' stamp: 'AlainPlantec 11/20/2010 08:45'!
findNextString: aSubString startingAt: searchIdx 
	| idx |
	idx := self string findString: aSubString startingAt: searchIdx.
	^ idx isZero ifFalse: [idx to: idx + aSubString size - 1]
			! !

!TextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 11/8/2010 22:09'!
duplicate: aKeyboardEvent
	"Paste the current selection over the prior selection, if it is non-overlapping and
	 legal.  Undoer & Redoer: undoAndReselect."

	self closeTypeIn.
	(self hasSelection and: [self isDisjointFrom: self editingState previousInterval])
		ifTrue: "Something to duplicate"
			[self replace: self editingState previousInterval with: self selection and:
				[self selectAt: self pointIndex]]
		ifFalse:
			[morph flash].
	^true! !

!TextEditor methodsFor: 'menu messages' stamp: 'GuillermoPolito 3/4/2015 16:28'!
changeStyle
	"Let user change styles for the current text pane."

	| names reply style current menuList |
	current := TextStyle default copy.
	names := TextStyle actualTextStyles keys.
	menuList := names collect: [ :styleName |
		(styleName = current name) -> styleName ].
	reply := UIManager default chooseFrom:  menuList values: names.	
	reply ifNotNil: [
		(style := TextStyle named: reply) ifNil: [ ^ true].
		self text style: style.
		self paragraph textStyle: style.
		self paragraph composeAll.
		self recomputeSelection].
	^ true! !

!TextEditor methodsFor: 'find-select' stamp: 'AlainPlantec 11/12/2010 21:07'!
findReplaceService
	^ FindReplaceService default! !

!TextEditor methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/28/2012 17:46'!
caret
	"Return the index position of the caret"
	^ self startBlock stringIndex! !

!TextEditor methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/28/2012 17:46'!
wordAtCaret

	^self paragraph text asString wordBefore: self startIndex - 1
! !

!TextEditor methodsFor: '*NECompletion' stamp: 'MarcusDenker 10/5/2013 19:28'!
atCompletionPosition
	"Return true if the cursor is at a possible completion position"
	| cursorPosition  |
	cursorPosition := self startIndex.
	cursorPosition < 2 ifTrue: [ ^ false ].
	^ (self text at: cursorPosition - 1) isCompletionCharacter! !

!TextEditor methodsFor: 'menu messages' stamp: 'MarcusDenker 7/23/2014 12:00'!
compareToClipboard
	"Check to see if whether the receiver's text is the same as the text currently on the clipboard, and inform the user."
	| s1 s2 |
	s1 := self clipboardText string.
	s2 := self string.
	s1 = s2 ifTrue: [^ self inform: 'Exact match'].
	UIManager default  
		longMessage: (TextDiffBuilder buildDisplayPatchFrom: s1 to: s2)
		title: 'Comparison to Clipboard Text'
		! !

!TextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 11/8/2010 22:09'!
copySelection
	"Copy the current selection and store it in the paste buffer, unless a caret.  Undoer & Redoer: undoCutCopy"

	self lineSelectAndEmptyCheck: [^ self].
	self clipboardTextPut: self selection.
	self editingState previousInterval: self selectionInterval selection: self selection.
! !

!TextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 11/8/2010 22:09'!
copyHiddenInfo
	"In TextLinks, TextDoits, TextColor, and TextURLs, there is hidden
info.  Copy that to the clipboard.  You can paste it and see what it is.
Usually enclosed in <>."

	^ self clipboardTextPut: self hiddenInfo asText! !

!TextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 11/8/2010 22:09'!
string

	^self text string! !

!TextEditor methodsFor: 'new selection' stamp: 'AlainPlantec 11/8/2010 22:09'!
insertAndSelect: aString at: anInteger

	self replace: (anInteger to: anInteger - 1)
		with: (Text string: (' ' , aString)
					attributes: self emphasisHere)
		and: [self ]! !

!TextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 11/8/2010 22:09'!
chooseColor
	"Make a new Text Color Attribute, let the user pick a color, and return the attribute"

	| attribute |	
	attribute := TextColor color: Color black "default".
	UIManager default chooseColor
		ifNotNil: [:nc | attribute color: nc].
	^ attribute
! !

!TextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 11/8/2010 22:09'!
redo: aKeyboardEvent 
	"Redo the last edit."

	self redo.
	^true! !

!TextEditor methodsFor: 'pluggable menus' stamp: 'jmv 11/4/2008 11:51'!
shiftedTextPaneMenuRequest
	"The user chose the more... branch from the text-pane menu."

	^ self pluggableYellowButtonActivity: true! !

!TextEditor methodsFor: 'accessing' stamp: 'StephaneDucasse 11/5/2012 21:54'!
nextCharacterIfAbsent: aBlock

	^ self text at: self startIndex ifAbsent: aBlock! !

!TextEditor methodsFor: 'events' stamp: 'BenjaminVanRyseghem 5/16/2013 14:29'!
startDrag: event
	
	self morph startDrag: (event translatedBy: self morph editView topLeft)! !

!TextEditor methodsFor: 'private' stamp: 'AlainPlantec 11/12/2010 10:47'!
findText: aString isRegex: isRegex entireWordsOnly: entireWordsOnly
	self findReplaceService findText: aString isRegex: isRegex entireWordsOnly: entireWordsOnly
! !

!TextEditor methodsFor: 'private' stamp: 'AlainPlantec 11/8/2010 22:09'!
indent: delta fromStream: inStream toStream: outStream
	"Append the contents of inStream to outStream, adding or deleting delta or -delta
	 tabs at the beginning, and after every CR except a final CR.  Do not add tabs
	 to totally empty lines, and be sure nothing but tabs are removed from lines."

	| ch skip cr tab prev atEnd |
	cr := Character cr.
	tab := Character tab.
	delta > 0
		ifTrue: "shift right"
			[prev := cr.
			 [ch := (atEnd := inStream atEnd) ifTrue: [cr] ifFalse: [inStream next].
			  (prev == cr and: [ch ~~ cr]) ifTrue:
				[delta timesRepeat: [outStream nextPut: tab]].
			  atEnd]
				whileFalse:
					[outStream nextPut: ch.
					prev := ch]]
		ifFalse: "shift left"
			[skip := delta. "a negative number"
			 [inStream atEnd] whileFalse:
				[((ch := inStream next) == tab and: [skip < 0]) ifFalse:
					[outStream nextPut: ch].
				skip := ch == cr ifTrue: [delta] ifFalse: [skip + 1]]]! !

!TextEditor methodsFor: 'typing support' stamp: 'AlainPlantec 11/8/2010 22:09'!
setEmphasisHereFromText

	self setEmphasisHereFromTextForward: true! !

!TextEditor methodsFor: 'nonediting/nontyping keys' stamp: 'NicolaiHess 11/20/2014 21:50'!
cursorHome: aKeyboardEvent

	"Private - Move cursor from position in current line to beginning of
	current line. If control key is pressed put cursor at beginning of text"

	| string |
	self closeTypeIn.
	string := self string.
	self
		moveCursor: [ :position | self walkAlongDisplayedLine
				ifTrue: [ (self paragraph lines at:(self paragraph lineIndexOfCharacterIndex: position)) first]
				ifFalse: [(string
						lastIndexOf: Character cr
						startingAt: position - 1
						ifAbsent:[0]) + 1]]
		forward: false
		specialBlock: [:dummy | 1]
		event: aKeyboardEvent.
	^true! !

!TextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 11/16/2010 13:19'!
findAgainAndReplace
	"Find the text-to-find again and eventually replace it with the current replace text."
	| where |
	where := self findAgain.
	where isNil
		ifFalse: [self findReplaceService replaceText 
				ifNotEmpty: [:rt | self replaceSelectionWith: rt]]
! !

!TextEditor methodsFor: 'parenblinking' stamp: 'AlainPlantec 11/8/2010 22:09'!
blinkPrevParen: aCharacter
	| openDelimiter closeDelimiter level string here hereChar |
	string := self string.
	here := self editingState pointBlock stringIndex.
	openDelimiter := "aKeyboardEvent keyValue." aCharacter.
	closeDelimiter := '([{' at: (')]}' indexOf: openDelimiter).
	level := 1.
	[level > 0 and: [here > 2]]
		whileTrue: [hereChar := string at: (here := here - 1).
			hereChar = closeDelimiter
				ifTrue: [level := level - 1.
					level = 0
						ifTrue: [^ self blinkParenAt: here]]
				ifFalse: [hereChar = openDelimiter
						ifTrue: [level := level + 1]]]! !

!TextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 11/8/2010 22:09'!
pointIndex
	^ self editingState pointBlock stringIndex! !

!TextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 11/8/2010 22:09'!
swapChars: aKeyboardEvent
	"Triggered byCmd-Y;.  Swap two characters, either those straddling the insertion point, or the two that comprise the selection.  Suggested by Ted Kaehler.  "

	| currentSelection aString chars |
	(chars := self selection) size = 0
		ifTrue:
			[currentSelection := self pointIndex.
			self selectMark: currentSelection - 1 point: currentSelection]
		ifFalse:
			[chars size = 2
				ifFalse:
					[morph flash. ^ true]
				ifTrue:
					[currentSelection := self pointIndex - 1]].
	aString := self selection string.
	self replaceSelectionWith: (Text string: aString reversed attributes: self emphasisHere).
	self selectAt: currentSelection + 1.
	^ true! !

!TextEditor methodsFor: 'accessing' stamp: 'MarcusDenker 12/9/2010 14:51'!
model
	^model! !

!TextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 11/16/2010 10:07'!
pointBlock
	^ self editingState pointBlock! !

!TextEditor methodsFor: 'events' stamp: 'BenjaminVanRyseghem 5/16/2013 14:18'!
mouseDown: event
	"An attempt to break up the old processRedButton code into three phases"

	"no matter what, if shift is pressed extend the selection"
	"no right/yellowbutton click just reposoition the cursor"
	(self paragraph selectionContainsPoint: event cursorPoint)
		ifTrue: [ self mouseDownOnSelectedText: event ]
		ifFalse: [ self mouseDownOnUnselectedText: event ]! !

!TextEditor methodsFor: 'typing support' stamp: 'CamilloBruni 2/26/2011 14:02'!
performCmdActionsWith: aKeyboardEvent shifted: aBoolean 
	| asciiValue actions|
	asciiValue := aKeyboardEvent keyValue + 1.
	actions := aBoolean
				ifTrue: [self class shiftCmdActions]
				ifFalse: [self class cmdActions].
	^ self perform: (actions at: asciiValue) with: aKeyboardEvent! !

!TextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 11/8/2010 22:09'!
cancel
	"Cancel the changes made so far to this text"
	morph cancelEdits! !

!TextEditor methodsFor: 'private' stamp: 'AlainPlantec 11/16/2010 10:18'!
unapplyAttributesThat: removalBlock fromWholeParagraph: wholeParagraph
	"The user selected aTextAttribute to be removed.
	If there is a selection, unapply the attribute to the selection.
	In any case do not use the attribute for the user input (emphasisHere)
	It really looks like the 2 branches in this method should be closer!! (handling of Undo is different, and likely wrong)"

	| interval newText secondPass |

	self editingState emphasisHere: (self editingState emphasisHere reject: removalBlock).
	wholeParagraph
		ifTrue: [
			interval := self paragraph text encompassParagraph: self selectionInterval.
			newText := self paragraph text copyFrom: interval first to: interval last.
			newText
				removeAttributesThat: removalBlock
				replaceAttributesThat: [ :attr | false ]
				by: [ :attr | false ]
				signalIfWholeParagraphAttribute: false.
			self paragraph 
				replaceFrom: interval first 
				to: interval last 
				with: newText.
			self paragraph composeAll.
			self recomputeSelection ]
		
		ifFalse: [
			newText := self selection.
			newText notEmpty
				ifTrue: [
					"Do a first pass that will remove only regular attributes (i.e. isParagraphAttribute not)"
					secondPass := false.
					[
						newText
							removeAttributesThat: removalBlock
							replaceAttributesThat: [ :attr | false ]
							by: [ :attr | false ]
							signalIfWholeParagraphAttribute: true
					] on: Abort do: [ :ex |
						secondPass := true ].
					self replaceSelectionWith: newText.
					self paragraph composeAll.
					self recomputeSelection.
					"Do a second pass, calling this method again, that will remove self paragraph attributes from whole paragraphs"
					secondPass ifTrue: [
						self unapplyAttributesThat: [ :attr | attr isParagraphAttribute and: [removalBlock value: attr ]] fromWholeParagraph: true ] ] ].
	! !

!TextEditor methodsFor: 'undoers-redoers' stamp: 'AlainPlantec 11/8/2010 22:09'!
undoRedoExchange: aninterval with: anotherInterval
	self selectInvisiblyFrom: aninterval first to: aninterval last.
	self exchangeWith: anotherInterval
! !

!TextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 11/8/2010 22:09'!
visibleHeight

	^morph owner bounds height
! !

!TextEditor methodsFor: 'undoers-redoers' stamp: 'AlainPlantec 11/8/2010 22:09'!
undoTypeIn: aText interval: anInterval
	self selectInterval: anInterval.
	self replace: anInterval with: aText and:
		[self selectInterval: (anInterval first to: anInterval first - 1)].
! !

!TextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 11/8/2010 22:09'!
pointIndex: anIndex
	self editingState pointBlock: (self paragraph characterBlockForIndex: anIndex)
! !

!TextEditor methodsFor: 'parenblinking' stamp: 'AlainPlantec 11/8/2010 22:09'!
blinkParenAt: parenLocation 
	self text
		addAttribute: TextEmphasis bold
		from: parenLocation
		to: parenLocation.
	self editingState lastParenLocation: parenLocation.! !

!TextEditor methodsFor: 'testing' stamp: 'AlainPlantec 11/8/2010 22:09'!
isTextEditor
	^ true ! !

!TextEditor methodsFor: 'find-select' stamp: 'AlainPlantec 11/12/2010 08:27'!
findText
	^ self findReplaceService findText! !

!TextEditor methodsFor: 'find-select' stamp: 'AlainPlantec 11/19/2010 17:49'!
findAndSelectNextOccurenceOf: aRegex
	| where |
	where := self findNext: aRegex startingAt: self stopIndex.
	where ifNotNil: [self selectInterval: where].
	"(morph respondsTo: #editView) ifTrue: [morph editView selectionInterval: self selectionInterval]."
	^ where! !

!TextEditor methodsFor: 'binding' stamp: 'AlainPlantec 11/8/2010 22:09'!
bindingOf: aString
	^model bindingOf: aString! !

!TextEditor methodsFor: 'do-its' stamp: 'MarcusDenker 9/5/2013 13:19'!
evaluateSelectionAndDo: aBlock
	"Treat the current selection as an expression; evaluate it and invoke aBlock with the result."
	| result rcvr ctxt |
	self lineSelectAndEmptyCheck: [^ nil].

	(model respondsTo: #doItReceiver) 
		ifTrue: [ rcvr := model doItReceiver.
				ctxt := model doItContext]
		ifFalse: [rcvr := ctxt := nil].
	result := rcvr class compiler
			source: self selectionAsStream;
			context: ctxt;
			receiver: rcvr;
			requestor: self;
			failBlock:  [morph flash. ^ nil];
			evaluate.		
	^aBlock value: result! !

!TextEditor methodsFor: 'nonediting/nontyping keys' stamp: 'AlainPlantec 11/8/2010 22:09'!
setSearchString: aKeyboardEvent
	"Establish the current selection as the current search string."
	^ self setSearchString! !

!TextEditor methodsFor: 'find-select' stamp: 'AlainPlantec 11/9/2010 17:32'!
findAll: aRegex startingAt: searchIdx 
	| ranges |
	ranges := aRegex matchingRangesIn: (self string copyFrom: searchIdx to: self string size).
	^ ranges collect: [:i | i + searchIdx - 1]
			! !

!TextEditor methodsFor: 'undo-redo private' stamp: 'AlainPlantec 12/14/2010 14:44'!
addTypeInUndoRecord
	| begin stop undoText redoText undoRec |
	begin := self startOfTyping min: self stopIndex. 
	stop := self stopIndex max: self startOfTyping.
	self editingState 
		previousInterval: (begin to: stop - 1) 
		selection: (self text copyFrom: begin to: stop - 1). 
	undoText := self nullText.
	redoText := stop > begin
			ifTrue: [self text copyFrom: begin to: stop - 1]
			ifFalse: [self nullText].
	((undoText isEmpty and: [redoText isEmpty]) and: [self editingState previousInterval size < 1])
			ifFalse: [self editingState
				redoArray: { morph. #redoTypeIn:interval:.  {redoText. begin to: begin + self selection size - 1} } 
				undoArray: {morph. #undoTypeIn:interval:.  {undoText. begin to: stop - 1} }].
	
! !

!TextEditor methodsFor: 'private' stamp: 'IgorStasenko 12/12/2010 03:30'!
paragraph
	^ morph 
		ifNotNil: [morph paragraph]
		ifNil: [self error: 'paragraph is not available']! !

!TextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 11/8/2010 22:09'!
hiddenInfo
	"In TextLinks, TextDoits, TextColor, and TextURLs, there is hidden info.  Return the entire string that was used by Cmd-6 to create this text attribute.  Usually enclosed in < >."

	| attrList |
	attrList := self text attributesAt: (self pointIndex + self markIndex)//2.
	attrList do: [:attr |
		attr forTextActionInfoDo: [ :info |
			^ self selection asString, '<', info, '>']].
	"If none of the above"
	attrList do: [:attr |
		attr forTextColorDo: [ :color |
			^ self selection asString, '<', color printString, '>']].
	^ self selection asString, '[No hidden info]'! !

!TextEditor methodsFor: 'menu messages' stamp: 'StephaneDucasse 4/23/2012 08:55'!
changeEmphasisOrAlignment
	| aList reply  code align menuList startIndex attribute |
	startIndex := self startIndex.
	align := self text alignmentAt: startIndex ifAbsent: [ 0 ].
	code := self text emphasisAt: startIndex.
	menuList := WriteStream on: Array new.
	menuList nextPut: (code isZero -> 'normal' translated).
	menuList nextPutAll: (#(bold italic underlined struckOut) collect: [:emph|
		(code anyMask: (TextEmphasis perform: emph) emphasisCode) -> emph asString translated]).
	
	menuList nextPut: ((self text attributesAt: startIndex)
		anySatisfy: [ :attr | attr isKern and: [attr kern < 0 ]]) -> 'narrow' translated.
		
	self alignmentChoices collectWithIndex: [ :type :i |
		menuList nextPut: (align = (i-1)) -> type asString translated ].
	
	aList := #(normal bold italic underlined struckOut narrow leftFlush centered rightFlush justified).
	reply := UIManager default chooseFrom:  aList values: aList.
	reply notNil ifTrue: [
		(self alignmentChoices includes: reply)
			ifTrue: [ attribute :=TextAlignment perform: reply]
			ifFalse: [ attribute := TextEmphasis perform: reply].
		self applyAttribute:  attribute].
	^ true! !

!TextEditor methodsFor: 'menu messages' stamp: 'FernandoOlivero 3/25/2011 11:27'!
accept
	"Save the current text of the text being edited as the current acceptable version for purposes of canceling.  Allow my morph to take appropriate action"
	morph canChangeText 
		ifTrue: [morph acceptContents]! !

!TextEditor methodsFor: 'undo-redo private' stamp: 'AlainPlantec 11/8/2010 22:09'!
exploreUndoManager: aKeyboardEvent
	^ self editingState exploreUndoManager: aKeyboardEvent! !

!TextEditor methodsFor: 'private' stamp: 'AlainPlantec 11/8/2010 22:09'!
getPluggableYellowButtonMenu: shiftKeyState
	| customMenu |
	^ (morph notNil and: [(customMenu := morph getMenu: shiftKeyState) notNil])
		ifTrue: [customMenu]
		ifFalse:
			[shiftKeyState
				ifTrue: [self class shiftedYellowButtonMenu]
				ifFalse: [self class yellowButtonMenu]]! !

!TextEditor methodsFor: 'find-select' stamp: 'AlainPlantec 11/17/2010 16:05'!
findText: aStringOrText
	self findReplaceService findText: aStringOrText ! !

!TextEditor methodsFor: 'typing support' stamp: 'AlainPlantec 11/8/2010 22:09'!
doneTyping
	self startOfTyping: nil! !

!TextEditor methodsFor: 'editing keys' stamp: 'AlainPlantec 11/8/2010 22:09'!
makeUppercase: aKeyboardEvent
	"Force the current selection to uppercase.  Triggered by Cmd-Y."

	self closeTypeIn.
	self replaceSelectionWith: (Text fromString: (self selection string asUppercase)).
	^ true! !

!TextEditor methodsFor: 'editing keys' stamp: 'CamilloBruni 8/1/2012 15:58'!
align: aKeyboardEvent
	"Triggered by Cmd-u;  cycle through alignment alternatives."

	self align.
	^ true! !

!TextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 11/8/2010 22:09'!
transformFrom: owner
	^morph transformFrom: owner! !

!TextEditor methodsFor: 'pluggable menus' stamp: 'CamilloBruni 2/6/2012 11:25'!
pluggableYellowButtonActivity: shiftKeyState
	"Invoke the model's popup menu."

	| menu |
	(menu := self getPluggableYellowButtonMenu: shiftKeyState)
		ifNil: [
			^ false]
		ifNotNil: [
			menu invokeOn: model orSendTo: self.
			^ true]! !

!TextEditor methodsFor: 'constants' stamp: 'StephaneDucasse 5/25/2011 17:36'!
alignmentChoices
	"Return the symbols representing the TextAlignment operations to get a text aligned."
	
	^ #(leftFlush centered justified rightFlush)! !

!TextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 11/8/2010 22:09'!
emphasisHere
	^ self editingState emphasisHere! !

!TextEditor methodsFor: 'accessing' stamp: 'AlainPlantec 11/8/2010 22:09'!
currentCharacterStyleOrNil
	"Answer the CharacterStyle for the current selection or cursor location if any"

	^self hasSelection
		ifTrue: [ self text characterStyleOrNilAt: self startIndex ]
		ifFalse: [ self text characterStyleOrNilIfApplying: self emphasisHere ]! !

!TextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 11/8/2010 22:09'!
redo
	"redo previous edit"

	self editingState redo ifFalse: [morph flash]. 
! !

!TextEditor methodsFor: 'events' stamp: 'BenjaminVanRyseghem 5/16/2013 14:19'!
transformedFrom: uberMorph

	^ self morph transformedFrom: uberMorph! !

!TextEditor methodsFor: 'nonediting/nontyping keys' stamp: 'AlainPlantec 11/8/2010 22:09'!
selectCurrentTypeIn: aKeyboardEvent 
	"Select what would be replaced by an undo (e.g., the last typeIn)."

	self closeTypeIn.
	self selectInterval: self editingState previousInterval.
	^ true! !

!TextEditor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 11/12/2010 21:38'!
normalCharacter: aKeyboardEvent 
	"A nonspecial character is to be added to the stream of characters."

	self hasSelection 
		ifTrue: [self addDeleteSelectionUndoRecord].
	^ super normalCharacter: aKeyboardEvent.
! !

!TextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 11/8/2010 22:09'!
stopIndex
	^ self stopBlock stringIndex! !

!TextEditor methodsFor: 'private' stamp: 'Sd 1/28/2011 14:42'!
applyAttribute: aTextAttribute
	"The user selected aTextAttribute via shortcut, menu or other means.
	If there is a selection, apply the attribute to the selection.
	In any case use the attribute for the user input (emphasisHere)"

	self editingState emphasisHere: (Text addAttribute: aTextAttribute toArray: self emphasisHere).
	self selection
		ifEmpty: [ self paragraph composeAll ]
		ifNotEmpty: [:sel | self replaceSelectionWith: (sel addAttribute: aTextAttribute).
			self paragraph composeAll.
			self recomputeSelection]! !

!TextEditor methodsFor: 'events' stamp: 'BenjaminVanRyseghem 5/16/2013 13:33'!
mouseMove: evt
	"Change the selection in response to mouse-down drag"
	| characterBlock |
	
	characterBlock := self paragraph characterBlockAtPoint: evt cursorPoint.

	self editingState pointBlock: characterBlock.
	self paragraph move: evt for: model controller: self.
	self storeSelectionInParagraph! !

!TextEditor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 11/8/2010 22:09'!
crWithIndent: aKeyboardEvent
	"Replace the current text selection with CR followed by as many tabs
	as on the current line (+/- bracket count) -- initiated by Shift-Return."
	| char s i tabCount  b |
	self closeTypeIn.
	b := self paragraph characterBlockAtPoint: aKeyboardEvent cursorPoint.
	s := self string.
	i := self stopIndex.
	tabCount := 0.
	[(i := i-1) > 0 and: [(char := s at: i) ~= Character cr]]
		whileTrue:  "Count tabs and brackets (but not a leading bracket)"
		[(char = Character tab and: [i < s size and: [(s at: i+1) ~= $[ ]]) ifTrue: [tabCount := tabCount + 1].
		char = $[ ifTrue: [tabCount := tabCount + 1].
		char = $] ifTrue: [tabCount := tabCount - 1]].
	 "Now inject CR with tabCount tabs"
	self addString: (String streamContents: [ :strm | strm crtab: tabCount ]).
	^ false! !

!TextEditor methodsFor: 'typing support' stamp: 'AlainPlantec 12/14/2010 22:49'!
backTo: startIndex
	"Backspace typing"
	self stopIndex > startIndex ifTrue: [
		self selectFrom: startIndex to: self stopIndex - 1.
		self addDeleteSelectionUndoRecord.
		self zapSelectionWith: self nullText].
	^ false


	! !

!TextEditor methodsFor: 'typing support' stamp: 'CamilloBruni 2/26/2011 14:23'!
acceptCR: aKeyboardEvent return: return
	((aKeyboardEvent keyValue = Character cr asciiValue) and: [morph acceptOnCR])
		ifTrue: [
			self closeTypeIn.
			return value: true].! !

!TextEditor methodsFor: 'find-select' stamp: 'AlainPlantec 11/11/2010 23:42'!
replaceAll: aRegex with: aText startingAt: startIdx
	| selec ranges |
	self editingState undoManager openRecordGroup.
	selec := self selectionInterval.
	ranges := self findAll: aRegex startingAt: startIdx. 
	ranges reverseDo: [:r | self selectInvisiblyFrom: r first to: r last.
		self replaceSelectionWith: aText].
	self selectInterval: selec.
	self editingState undoManager closeRecordGroup.
! !

!TextEditor methodsFor: 'accessing-selection' stamp: 'AlainPlantec 11/8/2010 22:09'!
startIndex
	^ self startBlock stringIndex! !

!TextEditor methodsFor: 'menu messages' stamp: 'AlainPlantec 11/11/2010 21:47'!
find
	"Prompt the user for a string to search for, and search the receiver from the current selection onward for it."
	morph openFindDialog! !

!TextEditor methodsFor: 'typing/selecting keys' stamp: 'AlainPlantec 11/13/2010 08:23'!
search: aKeyboardEvent
	"Invoked by Ctrl-S.  Same as 'again', but always uses the existing findText
	 from current FindReplaceService"

	self closeTypeIn.
	self findAgain.
	^true! !

!TextEditor methodsFor: 'private' stamp: 'AlainPlantec 11/8/2010 22:09'!
isDisjointFrom: anInterval
	"Answer true if anInterval is a caret not touching or within the current
	 interval, or if anInterval is a non-caret that does not overlap the current
	 selection."

	| fudge |
	fudge := anInterval size = 0 ifTrue: [1] ifFalse: [0].
	^(anInterval last + fudge < self startIndex or:
			[anInterval first - fudge >= self stopIndex])
! !

!TextEditor methodsFor: 'menu messages' stamp: 'StephaneDucasse 5/25/2011 18:01'!
changeTextFont
	"Present a menu of available fonts, and if one is chosen, apply it to the current selection."
	
	| curFont newFont attr startIndex |
	startIndex := self startIndex.
	curFont := self text fontAt: startIndex.
	newFont := StrikeFont fromUser: curFont.
	newFont ifNil: [ ^self ].
	attr := TextFontReference toFont: newFont.
	self applyAttribute: attr! !

!TextEditor class methodsFor: 'keyboard shortcut tables' stamp: 'AlainPlantec 11/16/2010 22:00'!
initializeShiftCmdKeyShortcuts 
	"Initialize the shift-command-key (or control-key) shortcut table."
	"wod 11/3/1998: Fix setting of cmdMap for shifted keys to actually use the 
	capitalized versions of the letters.
	TPR 2/18/99: add the plain ascii values back in for those VMs that don't return the shifted values."

	"TextEditor initialize"
	
	| cmds |

	self initializeBasicShiftCmdKeyShortcuts.
	self shiftCmdActions at: (45 + 1) put: #changeEmphasis:.		"cmd-sh-minus"
	self shiftCmdActions at: (61 + 1) put: #changeEmphasis:.		"cmd-sh-plus"

	cmds := #(
		$k	changeStyle:
		"$u #clearUndoManager:	"
	).
	1 to: cmds size by: 2 do: [ :i |
		self shiftCmdActions at: ((cmds at: i) asciiValue + 1) put: (cmds at: i + 1).			"plain keys"
		self shiftCmdActions at: ((cmds at: i) asciiValue - 32 + 1) put: (cmds at: i + 1).		"shifted keys"
		self shiftCmdActions at: ((cmds at: i) asciiValue - 96 + 1) put: (cmds at: i + 1).		"ctrl keys"
	].! !

!TextEditor class methodsFor: 'accessing' stamp: 'CamilloBruni 2/26/2011 15:28'!
cmdActions
	^cmdActions! !

!TextEditor class methodsFor: 'keyboard shortcut tables' stamp: 'AlainPlantec 11/8/2010 22:09'!
initializeCmdKeyShortcuts
	"Initialize the (unshifted) command-key (or alt-key) shortcut table."



	"
	TextEditor initialize
	"

	| cmds |
	self initializeBasicCmdKeyShortcuts.
			
	'0123456789-=' 
		do: [:char | cmdActions at: char asciiValue + 1 put: #changeEmphasis:].
	
	cmds := #($k #offerFontMenu: $u #align: ).
	1 to: cmds size
		by: 2
		do: [:i | self cmdActions at: (cmds at: i) asciiValue + 1 put: (cmds at: i + 1)]! !

!TextEditor class methodsFor: 'menu declaration' stamp: 'AlainPlantec 11/16/2010 22:15'!
shiftedYellowButtonMenu
	"Answer the menu to be presented when the yellow button is pressed while the shift key is down"

	^ (PragmaMenuBuilder pragmaKeyword: 'textEditorShiftedMenu' model: nil) menu! !

!TextEditor class methodsFor: 'shortcuts' stamp: 'StephaneDucasse 2/11/2014 10:54'!
buildTextEditorShortcutsOn: aBuilder
	<keymap>
	
	(aBuilder shortcut: #toggleCommentOnSelectionOrLine)
		category: #TextEditor
		shortcut: $/ ctrl win | $/ ctrl unix | $/ command mac
		do: [ :target  | target handleEdit: [ target toggleCommentOnSelectionOrLine ] ].
		
	(aBuilder shortcut: #selectAll) 
		category: #TextEditor
		shortcut: $a ctrl win | $a ctrl unix | $a command mac
		do: [ :target | target handleEdit: [ target selectAll ] ].

	(aBuilder shortcut: #copySelection) 
		category: #TextEditor
		default: $c ctrl win | $c ctrl unix | $c command mac
		do: [ :target | target copySelection ].
		
	(aBuilder shortcut: #find) 
		category: #TextEditor
		default: $f ctrl win | $f ctrl unix | $f command mac
		do: [ :target | target find ].
		
	(aBuilder shortcut: #findAgain) 
		category: #TextEditor
		default: $g ctrl win | $g ctrl unix | $g command mac
		do: [ :target | target findAgain ].
		
	(aBuilder shortcut: #setSearchString)
		category: #TextEditor
		default: $h ctrl win | $h ctrl unix | $h command mac
		do: [ :target | target setSearchString ].
		
	(aBuilder shortcut: #cancel) 
		category: #TextEditor
		default: $l ctrl win | $l ctrl unix | $l command mac
		do: [ :target | target cancelWithoutConfirmation ].
		
	(aBuilder shortcut: #paste) 
		category: #TextEditor
		default: $v ctrl win | $v ctrl unix | $v command mac
		do: [ :target | target paste ].
		
	(aBuilder shortcut: #cut) 
		category: #TextEditor
		default: $x ctrl win | $x ctrl unix | $x command mac
		do: [ :target | target cut ].
				
	(aBuilder shortcut: #undo) 
		category: #TextEditor
		default: $z ctrl win | $z ctrl unix | $z command mac
		do: [ :target | target undo ].
		
	(aBuilder shortcut: #redo) 
		category: #TextEditor
		default: $z ctrl shift win | $z ctrl shift unix | $z command shift mac
		do: [ :target | target redo ].
	
	(aBuilder shortcut: #cursorHome)
		category: #TextEditor
		default: Character home ctrl win | Character home ctrl unix | Character home command mac
		do: [ :target :morph :event | target cursorHome: event ].
	
	(aBuilder shortcut: #cursorEnd)
		category: #TextEditor
		default: Character end ctrl win | Character end ctrl unix | Character end command mac
		do: [ :target :morph :event | target cursorEnd: event ].! !

!TextEditor class methodsFor: 'keyboard shortcut tables' stamp: 'HenrikSperreJohansen 8/28/2014 11:22'!
initializeBasicShiftCmdKeyShortcuts 
	"Initialize the shift-command-key (or control-key) shortcut table."

	"TextEditor initialize"
	
	| cmdMap |

	"shift-command and control shortcuts"
	cmdMap := Array new: 256 withAll: #noop:.  		"use temp in case of a crash"
	cmdMap at: ( 1 + 1) put: #cursorHome:.			"home key"
	cmdMap at: ( 4 + 1) put: #cursorEnd:.				"end key"
	cmdMap at: ( 8 + 1) put: #forwardDelete:.			"ctrl-H or delete key"
	cmdMap at: (11 + 1) put: #cursorPageUp:.			"page up key"
	cmdMap at: (12 + 1) put: #cursorPageDown:.		"page down key"
	cmdMap at: (13 + 1) put: #crWithIndent:.			"ctrl-Return"
	cmdMap at: (27 + 1) put: #offerMenuFromEsc:.	"escape key"
	cmdMap at: (28 + 1) put: #cursorLeft:.			"left arrow key"
	cmdMap at: (29 + 1) put: #cursorRight:.			"right arrow key"
	cmdMap at: (30 + 1) put: #cursorUp:.				"up arrow key"
	cmdMap at: (31 + 1) put: #cursorDown:.			"down arrow key"
	cmdMap at: (32 + 1) put: #selectWord:.			"space bar key"
	cmdMap at: (45 + 1) put: #changeEmphasis:.		"cmd-sh-minus"
	cmdMap at: (61 + 1) put: #changeEmphasis:.		"cmd-sh-plus"
	cmdMap at: (127 + 1) put: #forwardDelete:.		"del key"

	#(
		$c	compareToClipboard:
		$d	duplicate:
		$h	cursorTopHome:
		$j	doAgainMany:
		$k	changeStyle:
		$l	outdent:
		$m selectCurrentTypeIn:
		$r	indent:
		$s	search:
		$u	changeLfToCr:
		$x	makeLowercase:
		$y	makeUppercase:
		$z	makeCapitalized:
		$g #findAgain:
	) pairsDo: [ :char :symbol|
		cmdMap at: char asciiValue + 1 put: symbol.			"plain keys"
		cmdMap at: char asciiValue - 32 + 1 put: symbol.		"shifted keys"
		cmdMap at: char asciiValue - 96 + 1 put: symbol.		"ctrl keys"
	].
	shiftCmdActions := cmdMap! !

!TextEditor class methodsFor: 'settings' stamp: 'AlainPlantec 11/8/2010 22:09'!
walkAlongDisplayedLine
	^ WalkAlongDisplayedLine ifNil: [WalkAlongDisplayedLine := true]! !

!TextEditor class methodsFor: 'shortcuts' stamp: 'GuillermoPolito 3/19/2013 19:12'!
buildTextEditorTabKeymapOn: aBuilder
	"This is to mask the tab or shift tab character at the system window level."
	<keymap>
	
	(aBuilder shortcut: #doTab) 
		category: #TextEditorTab
		default: Character tab asKeyCombination
		do: [ :target | target handleEdit: [ target
				handleEdit: [ 
					target replaceSelectionWith: '	'.
					target selectInvisiblyFrom: target selectionInterval last + 1 to: target selectionInterval last ] ] ]! !

!TextEditor class methodsFor: 'settings' stamp: 'AlainPlantec 11/13/2010 00:12'!
useFindReplaceSelection: aBoolean
	UseFindReplaceSelection := aBoolean! !

!TextEditor class methodsFor: 'settings' stamp: 'AlainPlantec 11/8/2010 22:09'!
walkAlongDisplayedLine: aBoolean
	WalkAlongDisplayedLine := aBoolean! !

!TextEditor class methodsFor: 'settings' stamp: 'AlainPlantec 11/12/2010 22:35'!
useFindReplaceSelection
	^ UseFindReplaceSelection ifNil: [UseFindReplaceSelection := true]! !

!TextEditor class methodsFor: 'menu declaration' stamp: 'AlainPlantec 11/16/2010 22:21'!
yellowButtonMenu
	^ (PragmaMenuBuilder pragmaKeyword: 'textEditorMenu' model: nil) menu! !

!TextEditor class methodsFor: 'menu declaration' stamp: 'EstebanLorenzano 1/31/2013 18:35'!
textEditorShiftedMenuOn: aBuilder 
	"Specify the menu used when writing text. Try it with:
	(PragmaMenuBuilder 
		pragmaKeyword: 'textEditorShiftedMenu'
		model: nil) menu popUpInWorld"

	<contextMenu>
	<textEditorShiftedMenu>
	(aBuilder item: #'Set font...' translated) 
		keyText: 'k';
		selector: #offerFontMenu.
	(aBuilder item: #'Set style... (K)' translated) 
		keyText: 'K';
		selector: #changeStyle.
	(aBuilder item: #'Set alignment...' translated) 
		selector: #chooseAlignment.
	(aBuilder item: #'More...' translated) 
		selector: #yellowButtonActivity.
! !

!TextEditor class methodsFor: 'class initialization' stamp: 'MarcusDenker 10/11/2013 12:34'!
initialize 
	"Initialize the keyboard shortcut maps and the shared buffers
	for copying text across views and managing again and undo." 
 
	"
	TextEditor initialize
	" 

	self initializeCmdKeyShortcuts.
	self initializeShiftCmdKeyShortcuts.
! !

!TextEditor class methodsFor: 'instance creation' stamp: 'IgorStasenko 12/12/2010 03:36'!
forMorph: aMorph

	^ self basicNew initWithMorph: aMorph! !

!TextEditor class methodsFor: 'settings' stamp: 'AlainPlantec 11/17/2010 15:25'!
useSelectionBar: aBoolean
	UseSelectionBar := aBoolean! !

!TextEditor class methodsFor: 'settings' stamp: 'AlainPlantec 11/8/2010 22:09'!
caseSensitiveFinds: aBoolean
	CaseSensitiveFinds := aBoolean! !

!TextEditor class methodsFor: 'settings' stamp: 'AlainPlantec 11/12/2010 11:53'!
useSecondarySelection: aBoolean
	UseSecondarySelection := aBoolean! !

!TextEditor class methodsFor: 'settings' stamp: 'AlainPlantec 11/17/2010 15:25'!
useSelectionBar
	^ UseSelectionBar ifNil: [UseSelectionBar := true]! !

!TextEditor class methodsFor: 'settings' stamp: 'AlainPlantec 11/12/2010 11:50'!
useSecondarySelection
	^ UseSecondarySelection ifNil: [UseSecondarySelection := true]! !

!TextEditor class methodsFor: 'menu declaration' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
textEditorMenuOn: aBuilder 
	"Specify the menu used when writing text. Try it with:
	(PragmaMenuBuilder 
		pragmaKeyword: 'textEditorMenu'
		model: nil) menu popUpInWorld"

	<contextMenu>
	<textEditorMenu>

	(aBuilder item: #'Find...' translated) 
		keyText: 'f';
		selector: #find; 
		icon: Smalltalk ui icons smallFindIcon.
	(aBuilder item: #'Find again' translated) 
		keyText: 'g';
		selector: #findAgain; 
		icon: Smalltalk ui icons smallFindIcon.
	(aBuilder item: #'Set search string' translated) 
		keyText: 'h';
		selector: #setSearchString.
	(aBuilder item: #'Do again' translated) 
		keyText: 'j';
		selector: #again; 
		icon: Smalltalk ui icons smallRedoIcon.
	(aBuilder item: #'Undo' translated) 
		keyText: 'z';
		selector: #undo; 
		icon: Smalltalk ui icons smallUndoIcon; 
		withSeparatorAfter.
	
	(aBuilder item: #'Copy' translated) 
		keyText: 'c';
		selector: #copySelection; 
		icon: Smalltalk ui icons smallCopyIcon.
	(aBuilder item: #'Cut' translated) 
		keyText: 'x';
		selector: #cut; 
		icon: Smalltalk ui icons smallCutIcon.
	(aBuilder item: #'Paste' translated) 
		keyText: 'v';
		selector: #paste; 
		icon: Smalltalk ui icons smallPasteIcon.
	(aBuilder item: #'Paste...' translated) 
		selector: #pasteRecent; 
		icon: Smalltalk ui icons smallCopyIcon; 
		withSeparatorAfter.

	(aBuilder item: #'Set font...' translated) 
		keyText: 'k';
		selector: #offerFontMenu.
	(aBuilder item: #'Set style...' translated) 
		keyText: 'K';
		selector: #changeStyle.
	(aBuilder item: #'Set alignment...' translated) 
		selector: #chooseAlignment; 
		withSeparatorAfter.

	(aBuilder item: #'Accept' translated) 
		keyText: 's';
		selector: #accept; 
		icon: Smalltalk ui icons smallOkIcon.
	(aBuilder item: #'Cancel' translated) 
		keyText: 'l';
		selector: #cancel; 
		icon: Smalltalk ui icons smallCancelIcon.! !

!TextEditor class methodsFor: 'accessing' stamp: 'AlainPlantec 11/8/2010 22:09'!
shiftCmdActions
	^shiftCmdActions! !

!TextEditor class methodsFor: 'keyboard shortcut tables' stamp: 'HenrikSperreJohansen 8/28/2014 11:14'!
initializeBasicCmdKeyShortcuts
	"Initialize the (unshifted) command-key (or alt-key) shortcut table.
	
	TextEditor initialize
	"
	| cmdMap |
	
	cmdMap := Array new: 256 withAll: #noop:.		"use temp in case of a crash"
	cmdMap at: 1 + 1 put: #cursorHome:.				"home key"
	cmdMap at: 4 + 1 put: #cursorEnd:.				"end key"
	cmdMap at: 8 + 1 put: #backspace:.				"ctrl-H or delete key"
	cmdMap at: 11 + 1 put: #cursorPageUp:.			"page up key"
	cmdMap at: 12 + 1 put: #cursorPageDown:.		"page down key"
	cmdMap at: 13 + 1 put: #crWithIndent:.			"cmd-Return"
	cmdMap at: 27 + 1 put: #escape:.		"escape key"
	cmdMap at: 28 + 1 put: #cursorLeft:.				"left arrow key"
	cmdMap at: 29 + 1 put: #cursorRight:.			"right arrow key"
	cmdMap at: 30 + 1 put: #cursorUp:.				"up arrow key"
	cmdMap at: 31 + 1 put: #cursorDown:.			"down arrow key"
	cmdMap at: 32 + 1 put: #selectWord:.			"space bar key"
	cmdMap at: 127 + 1 put: #forwardDelete:.		"del key"
	cmdMap at: 115 + 1 put:#accept:.	
	'([{''"<' do: [:char | cmdMap at: char asciiValue + 1 put: #enclose:].
		
	#(
		$a #selectAll: 
		$c #copySelection: 
		$e #exchange: 
		$f #find: 
		$g #findAgain: 
		$h #setSearchString: 
		$v #paste: 
		$w #backWord: 
		$x #cut: 
		$y #swapChars: 
		$z #undo: 
		$j #redo: 
		"$u #exploreUndoManager: ")
	pairsDo: [ :char :symbol|
		cmdMap at: char asciiValue + 1 put: symbol].
		
	cmdActions := cmdMap! !

!TextEditor class methodsFor: 'settings' stamp: 'AlainPlantec 11/8/2010 22:09'!
caseSensitiveFinds
	^ CaseSensitiveFinds ifNil: [CaseSensitiveFinds := false]! !

!TextEditorDialogWindow commentStamp: 'gvc 5/18/2007 11:16'!
Multi-line text entry dialog.!
!TextEditorDialogWindow methodsFor: 'accessing' stamp: 'gvc 5/1/2007 11:21'!
textEditorMorph: anObject
	"Set the value of textEditorMorph"

	textEditorMorph := anObject! !

!TextEditorDialogWindow methodsFor: 'private' stamp: 'CamilloBruni 10/21/2012 16:34'!
textLines

	^ super textLines, entryText asString lines.! !

!TextEditorDialogWindow methodsFor: 'accessing' stamp: 'gvc 5/1/2007 11:23'!
cancel
	"Cancel and close."

	self entryText: nil.
	^super cancel! !

!TextEditorDialogWindow methodsFor: 'private' stamp: 'CamilloBruni 10/9/2012 20:03'!
entryHeight: aNumber
	"Set the height of the text editor morph.
	Set the width to be 2 times this also."

	self textEditorMorph
		minHeight: aNumber;
		minWidth: 500! !

!TextEditorDialogWindow methodsFor: 'actions' stamp: 'CamilloBruni 10/7/2012 22:19'!
newContentMorph
	"Answer a new content morph."

	self iconMorph: self newIconMorph.
	self textMorph: self newTextMorph.
	self textMorph wrapFlag: false.
	self textEditorMorph: self newTextEditorMorph.
	^self newGroupboxForAll: {
		self newRow: {self iconMorph. self textMorph}.
		self textEditorMorph}! !

!TextEditorDialogWindow methodsFor: 'creation' stamp: 'CamilloBruni 10/7/2012 22:27'!
newTextEditorMorph
	"Answer a new text entry morph."
	^(self
		newTextEditorFor: self
		getText: #entryText
		setText: #entryText:
		getEnabled: nil) 
		selectAll! !

!TextEditorDialogWindow methodsFor: 'accessing' stamp: 'gvc 5/1/2007 11:21'!
textEditorMorph
	"Answer the value of textEditorMorph"

	^ textEditorMorph! !

!TextEditorDialogWindow methodsFor: 'initialization' stamp: 'CamilloBruni 10/7/2012 22:17'!
initialize
	"Initialize the receiver."

	super initialize.
	self beResizeable.
	entryText := ''.
	self changed: #entryText.
	self textEditorMorph selectAll.! !

!TextEditorDialogWindow methodsFor: 'accessing' stamp: 'gvc 5/1/2007 11:21'!
entryText
	"Answer the value of entryText"

	^ entryText! !

!TextEditorDialogWindow methodsFor: 'accessing' stamp: 'MarcusDenker 9/10/2014 17:22'!
entryText: anObject
	"Set the value of entryText"

	entryText := anObject.
	self changed: #entryText.
	self textEditorMorph selectAll.
	self ok.
	self textEditorMorph hasUnacceptedEdits: true.! !

!TextEditorDialogWindow methodsFor: 'focus handling' stamp: 'gvc 5/1/2007 11:24'!
defaultFocusMorph
	"Answer the morph that should have the keyboard
	focus by default when the dialog is opened."
	
	^self textEditorMorph textMorph! !

!TextEditorDialogWindow methodsFor: 'actions' stamp: 'gvc 5/1/2007 11:23'!
newButtons
	"Answer new buttons as appropriate."

	^{self newOKButton. self newCancelButton}! !

!TextEditorDialogWindow methodsFor: 'visual properties' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
icon
	"Answer an icon for the receiver."
	
	^ Smalltalk ui icons questionIcon! !

!TextEditorDialogWindow class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
taskbarIcon
	"Answer the icon for the receiver in a task bar."

	^ Smalltalk ui icons smallQuestionIcon! !

!TextEditorTest methodsFor: 'accessing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testCursorEnd
	| editor |
	"
	self debug: #testCursorEnd.
	"
	editor := TextMorph new editor.
	editor cursorEnd: self keyboardEvent! !

!TextEditorTest methodsFor: 'accessing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testSetSearchString
	| editor |
	"
	self debug: #testSetSearchString.
	"
	editor := TextMorph new editor.
	editor setSearchString! !

!TextEditorTest methodsFor: 'as yet unclassified' stamp: 'FernandoOlivero 5/17/2010 15:05'!
keyboardEvent 
	| event |
	event := KeyboardEvent new.
	event 
		setType: #keystroke
		buttons: 0
		position:  0@0
		keyValue: 0
		charCode: 0
		hand: nil 
		stamp: Time now.
	^ event 	! !

!TextEmphasis commentStamp: '<historical>'!
A TextEmphasis, encodes a characteristic applicable to all fonts.  The encoding is as follows:
	1	bold
	2	itallic
	4	underlined
	8	narrow
	16	struck out!
!TextEmphasis methodsFor: 'comparing' stamp: 'ar 9/9/2003 22:03'!
hash
	"#hash is re-implemented because #= is re-implemented"
	^emphasisCode hash
! !

!TextEmphasis methodsFor: 'accessing' stamp: 'di 10/31/97 13:13'!
dominates: other
	(emphasisCode = 0 and: [other dominatedByCmd0]) ifTrue: [^ true].
	^ (other class == self class)
		and: [emphasisCode = other emphasisCode]! !

!TextEmphasis methodsFor: 'accessing' stamp: ''!
turnOff
	setMode := false! !

!TextEmphasis methodsFor: 'comparing' stamp: 'di 10/31/97 11:15'!
= other 
	^ (other class == self class) 
		and: [other emphasisCode = emphasisCode]! !

!TextEmphasis methodsFor: 'printing' stamp: ''!
printOn: strm
	super printOn: strm.
	strm nextPutAll: ' code: '; print: emphasisCode! !

!TextEmphasis methodsFor: 'styling' stamp: 'di 10/29/97 11:57'!
emphasizeScanner: scanner
	"Set the emphasist for text scanning"
	scanner addEmphasis: emphasisCode! !

!TextEmphasis methodsFor: 'accessing' stamp: ''!
emphasisCode: int
	emphasisCode := int.
	setMode := true! !

!TextEmphasis methodsFor: 'styling' stamp: ''!
emphasisCode
	^ emphasisCode! !

!TextEmphasis methodsFor: 'accessing' stamp: ''!
set
	^ setMode and: [emphasisCode ~= 0]! !

!TextEmphasis methodsFor: 'testing' stamp: 'di 10/31/97 13:11'!
dominatedByCmd0
	"Cmd-0 should turn off emphasis"
	^ true! !

!TextEmphasis methodsFor: 'styling' stamp: 'tk 12/16/97 09:28'!
writeScanOn: strm

	emphasisCode = 1 ifTrue: [strm nextPut: $b].
	emphasisCode = 2 ifTrue: [strm nextPut: $i].
	emphasisCode = 0 ifTrue: [strm nextPut: $n].
	emphasisCode = 16 ifTrue: [strm nextPut: $=].
	emphasisCode = 4 ifTrue: [strm nextPut: $u].! !

!TextEmphasis class methodsFor: 'as yet unclassified' stamp: 'di 10/31/97 13:05'!
narrow
	^ TextKern kern: -1! !

!TextEmphasis class methodsFor: 'as yet unclassified' stamp: ''!
bold
	^ self new emphasisCode: 1! !

!TextEmphasis class methodsFor: 'as yet unclassified' stamp: ''!
struckOut
	^ self new emphasisCode: 16! !

!TextEmphasis class methodsFor: 'as yet unclassified' stamp: ''!
normal
	^ self new emphasisCode: 0! !

!TextEmphasis class methodsFor: 'as yet unclassified' stamp: ''!
underlined
	^ self new emphasisCode: 4! !

!TextEmphasis class methodsFor: 'as yet unclassified' stamp: ''!
italic
	^ self new emphasisCode: 2! !

!TextEmphasisTest commentStamp: 'TorstenBergmann 1/31/2014 12:23'!
SUnit tests for TextEmphasis!
!TextEmphasisTest methodsFor: 'tests' stamp: 'sd 6/5/2005 10:04'!
testAppendText
	"tests the Text>>prepend: method when appending a Text " 
	| receiver argument result expectedResult |

	receiver := 'xxx' asText  
		addAttribute: TextEmphasis bold from: 1 to: 3.
	argument := 'yyy' asText
		addAttribute: TextEmphasis italic from: 1 to: 3.		.
	expectedResult := 'xxxyyy' asText 
		addAttribute: TextEmphasis bold from: 1 to: 3;
		addAttribute: TextEmphasis italic from: 4 to: 6.
	result := receiver append: argument.
	self assert: (result == receiver). 
	self assert: (result string = expectedResult string).
	self assert: (result runs = expectedResult runs)

	
	! !

!TextEmphasisTest methodsFor: 'tests' stamp: 'sd 6/5/2005 10:03'!
testAppendString
	"tests the Text>>prepend: method when appending a String " 
	"self run: # testAppendString"

	| receiver argument result expectedResult |

	receiver := 'xxx' asText  
		addAttribute: TextEmphasis bold from: 1 to: 3.
	argument := 'yyy'.
	expectedResult := 'xxxyyy' asText 
		addAttribute: TextEmphasis bold from: 1 to: 3.
	result := receiver append: argument.
	self assert: (result == receiver). 
	self assert: (result string = expectedResult string).
	self assert: (result runs = expectedResult runs)! !

!TextEmphasisTest methodsFor: 'tests' stamp: 'sd 6/5/2005 10:04'!
testPrependString
	"tests the Text>>prepend: method when prepending a String " 
	| receiver argument result expectedResult |

	receiver := 'xxx' asText  
		addAttribute: TextEmphasis bold from: 1 to: 3.
	argument := 'yyy'.
	expectedResult := 'yyyxxx' asText 
		addAttribute: TextEmphasis bold from: 4 to: 6.
	result := receiver prepend: argument.
	self assert: (result == receiver). 
	self assert: (result string = expectedResult string).
	self assert: (result runs = expectedResult runs)

	! !

!TextEmphasisTest methodsFor: 'tests' stamp: 'sd 6/5/2005 10:04'!
testPrependText
	"tests the Text>>prepend: method when prepending Text " 
	| receiver argument result expectedResult |

	receiver := 'xxx' asText  
		addAttribute: TextEmphasis bold from: 1 to: 3.
	argument := 'yyy' asText 
		addAttribute: TextEmphasis italic from: 1 to: 3.
	expectedResult := 'yyyxxx' asText 
		addAttribute: TextEmphasis italic from: 1 to: 3;
		addAttribute: TextEmphasis bold from: 4 to: 6.
	result := receiver prepend: argument.
	self assert: (result == receiver). 
	self assert: (result string = expectedResult string).
	self assert: (result runs = expectedResult runs)! !

!TextEmphasisTest methodsFor: 'initialization' stamp: 'mjr 8/20/2003 18:55'!
setUp
	super setUp.
	prototypes add: TextEmphasis bold;
		 add: TextEmphasis italic;
		 add: TextEmphasis narrow;
		 add: TextEmphasis normal;
		 add: TextEmphasis struckOut;
		 add: TextEmphasis underlined ! !

!TextEntryDialogWindow commentStamp: 'gvc 5/18/2007 11:16'!
Single-line text entry dialog.!
!TextEntryDialogWindow methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 11/25/2010 18:04'!
newTextEditorMorph
	"Answer a new text entry morph."

	^(self
		newTextEntryFor: self
		getText: #entryText
		setText: #entryText:
		getEnabled: nil
		help: nil)
		acceptOnCR: false;
		selectAll! !

!TextEntryDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 11/28/2010 09:14'!
withDropListButton
	self textEditorMorph withDropListButton! !

!TextEntryDialogWindow methodsFor: 'accessing' stamp: 'gvc 1/10/2007 13:52'!
newButtons
	"Answer new buttons as appropriate."

	^{self newOKButton isDefault: true. self newCancelButton}! !

!TextEntryDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 10/25/2010 10:36'!
minimumWidth
	^ (super minimumWidth max: self class minimumWidth) min: (Display width)! !

!TextEntryDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 11/25/2010 19:04'!
entryCompletion: anEntryCompletion
	anEntryCompletion chooseBlock: [:t | self ok].
	self textEditorMorph entryCompletion: anEntryCompletion

! !

!TextEntryDialogWindow methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 10/25/2010 11:29'!
initialExtent
	^ self minimumWidth @ (super initialExtent y)
! !

!TextEntryDialogWindow class methodsFor: 'settings' stamp: 'AlainPlantec 4/11/2010 10:10'!
minimumWidth
	^ MinimumWidth ifNil: [MinimumWidth := 450]! !

!TextEntryDialogWindow class methodsFor: 'settings' stamp: 'AlainPlantec 4/11/2010 10:10'!
minimumWidth: anInteger
	MinimumWidth := anInteger! !

!TextFieldExample commentStamp: '<historical>'!
A TextFieldExample is a simple example of how to use TextFields.!
!TextFieldExample methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 10/1/2013 14:58'!
initializeWidgets

	methodBrowser := self instantiate: MessageBrowser.
	textField := self newTextInput.
	
	textField 
		ghostText: 'Enter a class name';
		autoAccept: true;
		removeEntryCompletion.
	methodBrowser 
		sortingBlock: [:a :b | a selector < b selector ];
		displayBlock: [:m | { m selector } ]! !

!TextFieldExample methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/4/2012 14:41'!
textField

	^ textField! !

!TextFieldExample methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 10/1/2013 14:57'!
initializePresenter
	
	textField acceptBlock: [:text | Smalltalk globals at: text asSymbol
								ifPresent: [:class | methodBrowser messages: class methods ]
								ifAbsent: [ methodBrowser messages: #() ]]! !

!TextFieldExample methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/4/2012 14:41'!
methodBrowser

	^ methodBrowser! !

!TextFieldExample class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 6/13/2012 16:22'!
defaultSpec
	| textFieldHeight |
	
	textFieldHeight := StandardFonts defaultFont height + 15.
	^ SpecLayout composed
	 	add: #textField origin: 0@0 corner: 1@0 offsetOrigin: 0@0 offsetCorner: 0@textFieldHeight;
	 	add: #methodBrowser origin: 0@0 corner: 1@1 offsetOrigin: 0@textFieldHeight offsetCorner: 0@textFieldHeight;
		yourself ! !

!TextFieldExample class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 2/4/2012 14:41'!
title

	^ 'Text Field Example'! !

!TextFontChange commentStamp: '<historical>'!
A TextFontChange encodes a font change applicable over a given range of text.  The font number is interpreted relative to the textStyle governing display of this text.!
!TextFontChange methodsFor: 'as yet unclassified' stamp: ''!
fontNumber: int
	fontNumber := int! !

!TextFontChange methodsFor: 'as yet unclassified' stamp: 'ar 9/9/2003 22:03'!
hash
	"#hash is re-implemented because #= is re-implemented"
	^fontNumber hash! !

!TextFontChange methodsFor: 'as yet unclassified' stamp: 'nk 9/3/2004 15:48'!
dominates: other
	^ other isKindOf: TextFontChange! !

!TextFontChange methodsFor: 'as yet unclassified' stamp: 'di 10/31/97 11:15'!
= other 
	^ (other class == self class) 
		and: [other fontNumber = fontNumber]! !

!TextFontChange methodsFor: 'as yet unclassified' stamp: 'di 11/9/97 17:46'!
forFontInStyle: aTextStyle do: aBlock
	aBlock value: (aTextStyle fontAt: fontNumber)! !

!TextFontChange methodsFor: 'printing' stamp: ''!
printOn: strm
	super printOn: strm.
	strm nextPutAll: ' font: '; print: fontNumber! !

!TextFontChange methodsFor: 'as yet unclassified' stamp: ''!
emphasizeScanner: scanner
	"Set the font for text display"
	scanner setFont: fontNumber! !

!TextFontChange methodsFor: 'as yet unclassified' stamp: 'tk 12/16/97 09:22'!
writeScanOn: strm

	strm nextPut: $f.
	fontNumber printOn: strm.! !

!TextFontChange methodsFor: 'as yet unclassified' stamp: ''!
fontNumber
	^ fontNumber! !

!TextFontChange class methodsFor: 'as yet unclassified' stamp: ''!
font2
	^ self new fontNumber: 2! !

!TextFontChange class methodsFor: 'as yet unclassified' stamp: ''!
fontNumber: n
	^ self new fontNumber: n! !

!TextFontChange class methodsFor: 'as yet unclassified' stamp: ''!
font1
	^ self new fontNumber: 1! !

!TextFontChange class methodsFor: 'as yet unclassified' stamp: 'PavelKrivanek 10/25/2007 17:48'!
defaultFontChange
  "Answer a TextFontChange that represents the default font"

  | defaultFontStyle fontIndex |

  defaultFontStyle := TextStyle default.
  fontIndex := defaultFontStyle ifNil: 1 ifNotNil: [defaultFontStyle defaultFontIndex].

  ^ self new fontNumber: fontIndex.
! !

!TextFontChange class methodsFor: 'as yet unclassified' stamp: ''!
font3
	^ self new fontNumber: 3! !

!TextFontChange class methodsFor: 'as yet unclassified' stamp: ''!
font4
	^ self new fontNumber: 4! !

!TextFontChangeTest commentStamp: 'TorstenBergmann 1/31/2014 12:23'!
SUnit tests for class TextFontChange!
!TextFontChangeTest methodsFor: 'tests' stamp: 'mjr 8/17/2003 20:29'!
testEquality
	"Check that different instances of the same TextFontChange are equal"
	self assert: TextFontChange defaultFontChange = TextFontChange defaultFontChange.
	self assert: TextFontChange font1 = TextFontChange font1.
	self assert: TextFontChange font2 = TextFontChange font2.
	self assert: TextFontChange font3 = TextFontChange font3.
	self assert: TextFontChange font4 = TextFontChange font4.
	self assert: (TextFontChange fontNumber: 6)
			= (TextFontChange fontNumber: 6)! !

!TextFontChangeTest methodsFor: 'tests' stamp: 'stephaneducasse 2/4/2006 20:10'!
testHash
	"test that different instances of the same TextFontChange hash to the 
	same value"
	| hashes hash |
	hashes := OrderedCollection new.
	1
		to: 100
		do: [:i | hashes add: TextFontChange defaultFontChange hash].
	hash := hashes at: 1.
	2
		to: 100
		do: [:i | self assert: (hashes at: i)
					= hash]! !

!TextFontChangeTest methodsFor: 'initialization' stamp: 'mjr 8/20/2003 18:55'!
setUp
	"create the prototypes for testing"
	super setUp.
	prototypes add: TextFontChange defaultFontChange.
	prototypes add: TextFontChange font1.
	prototypes add: TextFontChange font2.
	prototypes add: TextFontChange font3.
	prototypes add: TextFontChange font4.
	prototypes
		add: (TextFontChange fontNumber: 6) ! !

!TextFontReference commentStamp: '<historical>'!
A TextFontReference encodes a font change applicable over a given range of text.  The font reference is absolute:  unlike a TextFontChange, it is independent of the textStyle governing display of this text.!
!TextFontReference methodsFor: 'comparing' stamp: 'ar 9/9/2003 22:03'!
hash
	"#hash is re-implemented because #= is re-implemented"
	^font hash! !

!TextFontReference methodsFor: 'comparing' stamp: 'nk 9/3/2004 15:43'!
= other 
	^ (other class == self class) 
		and: [other font = font]! !

!TextFontReference methodsFor: 'as yet unclassified' stamp: 'di 11/9/97 17:47'!
forFontInStyle: aTextStyle do: aBlock
	aBlock value: font! !

!TextFontReference methodsFor: 'as yet unclassified' stamp: ''!
toFont: aFont

	font := aFont! !

!TextFontReference methodsFor: 'printing' stamp: 'nk 9/3/2004 15:24'!
printOn: aStream
	aStream nextPutAll: 'a TextFontReference(';
		print: font;
		nextPut: $)! !

!TextFontReference methodsFor: 'as yet unclassified' stamp: ''!
emphasizeScanner: scanner
	"Set the actual font for text display"
	scanner setActualFont: font! !

!TextFontReference methodsFor: 'as yet unclassified' stamp: 'di 5/10/1999 23:47'!
font

	^ font! !

!TextFontReference methodsFor: 'as yet unclassified' stamp: 'tk 7/22/2002 18:39'!
writeScanOn: strm

	strm nextPut: $F.
	strm nextPutAll: font familyName; nextPut: $#.
	font height printOn: strm.! !

!TextFontReference class methodsFor: 'as yet unclassified' stamp: ''!
toFont: aFont
	^ self new toFont: aFont! !

!TextFontReferenceTest commentStamp: 'TorstenBergmann 1/31/2014 12:24'!
SUnit tests for TextFontReference!
!TextFontReferenceTest methodsFor: 'tests' stamp: 'mjr 8/20/2003 18:55'!
setUp
	super setUp.
	prototypes
		add: (TextFontReference
				toFont: (StrikeFont familyName: 'NewYork' size: 15)) ! !

!TextHighlight commentStamp: 'gvc 5/18/2007 11:15'!
Definition of a clickable highlighted range of text with optional borders.!
!TextHighlight methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/22/2012 15:20'!
fillWidth
	"Answer the value of fillWidth"

	^ fillWidth! !

!TextHighlight methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 11/22/2012 16:36'!
containsPoint: aPoint in: rect
	"Answer whther the bounds contain the given (local coordinate) point."

	^ lineHighligths anySatisfy: [:e | e containsPoint: aPoint in: rect ]! !

!TextHighlight methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/22/2012 15:20'!
lineRange
	"Answer the value of lineRange"

	^ lineRange! !

!TextHighlight methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/22/2012 15:58'!
borderSides: anObject
	"Set the value of borderSides"

	borderSides := anObject.
	lineHighligths do: [:e | e borderSides: anObject ]! !

!TextHighlight methodsFor: 'event' stamp: 'BenjaminVanRyseghem 11/22/2012 15:20'!
clicked: evt
	"The receiver has had a mouse down."

	self triggerEvent: #clicked! !

!TextHighlight methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/22/2012 16:17'!
textMorph: aMorph

	textMorph := aMorph! !

!TextHighlight methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/22/2012 15:58'!
fillWidth: anObject
	"Set the value of fillWidth"

	fillWidth := anObject.
	lineHighligths do: [:e | e fillWidth: anObject ]! !

!TextHighlight methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/22/2012 15:58'!
color: anObject
	"Set the value of color"

	color := anObject.
	lineHighligths do: [:e | e color: anObject ]! !

!TextHighlight methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/22/2012 16:37'!
lineRange: anObject
	"Set the value of lineRange"

	lineRange := anObject.
	lineHighligths := Set new.
	
	self setLineHighLights.! !

!TextHighlight methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 11/22/2012 15:57'!
initialize
	"Initialize the receiver."

	super initialize.
	lineHighligths := #().
	self
		color: Color yellow;
		lineRange: (1 to: 0);
		borderWidth: 0;
		borderColor: Color transparent;
		borderSides: #(top right bottom left);
		fillWidth: false! !

!TextHighlight methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/22/2012 15:20'!
borderSides
	"Answer the value of borderSides"

	^ borderSides! !

!TextHighlight methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/22/2012 15:20'!
borderColor
	"Answer the value of borderColor"

	^ borderColor! !

!TextHighlight methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/22/2012 15:58'!
borderWidth: anObject
	"Set the value of borderWidth"

	borderWidth := anObject.
	lineHighligths do: [:e | e borderWidth: anObject ]! !

!TextHighlight methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/22/2012 15:20'!
color
	"Answer the value of color"

	^ color! !

!TextHighlight methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/22/2012 15:57'!
borderColor: anObject
	"Set the value of borderColor"

	borderColor := anObject.
	lineHighligths do: [:e | e borderColor: anObject ]! !

!TextHighlight methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/22/2012 15:20'!
borderWidth
	"Answer the value of borderWidth"

	^ borderWidth! !

!TextHighlight methodsFor: 'draw' stamp: 'BenjaminVanRyseghem 11/22/2012 16:37'!
drawOn: aCanvas in: rect offset: o
	"Draw the highlight on the given canvas for the given rectangle."

	self setLineHighLights.
	lineHighligths do: [:e | e drawOn: aCanvas in: rect offset: o ]! !

!TextHighlight methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/22/2012 18:06'!
lineNumber

	^ self textMorph textMorph paragraph lineIndexOfCharacterIndex: self lineRange first! !

!TextHighlight methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/22/2012 18:00'!
setLineHighLights

	"yes, i know ..."
	| anInterval paragraph firstLineIndex lastLineIndex |
	
	lineHighligths removeAll.
	anInterval := self lineRange.
	paragraph := self textMorph textMorph paragraph.
	firstLineIndex := paragraph lineIndexOfCharacterIndex: anInterval first.
	lastLineIndex := paragraph lineIndexOfCharacterIndex: anInterval last.
	
	firstLineIndex to: lastLineIndex do: [:i || line bounds offset1 offset2 right text subtext tabs |
		line := paragraph lines at: i.
		text := self textMorph text.
		subtext := text copyFrom: line first to: line last.
		tabs := subtext occurrencesOf: Character tab.
		right := (self textMorph font widthOfString: subtext) + (tabs * ((8*(self textMorph font widthOf:Character space))-6)).
		offset1 := 0.
		offset2 := 0.
		(i = firstLineIndex) ifTrue: [ offset1 := self textMorph font widthOfString: (text copyFrom: line first to: ((anInterval first -1)max: 1)) ].
		(i = lastLineIndex) ifTrue: [ offset2 := self textMorph font widthOfString: (text copyFrom: (anInterval last min: text size) to: line last) ].
		
		bounds := (line left+offset1)@line top corner: (right - offset2)@line bottom.		
		lineHighligths add: (self newLineHighlight
								bounds: bounds) ]! !

!TextHighlight methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/22/2012 15:27'!
textMorph

	^ textMorph! !

!TextHighlight methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/22/2012 17:57'!
newLineHighlight

	^ TextHighlightByBounds new
		borderWidth: self borderWidth;
		borderColor: self borderColor;
		color: self color;
		fillWidth: self fillWidth! !

!TextHighlight class methodsFor: 'as yet unclassified' stamp: 'BenjaminVanRyseghem 11/22/2012 16:25'!
on: aMorph

	^ self basicNew
		textMorph: aMorph;
		initialize;
		yourself! !

!TextHighlightByBounds commentStamp: 'gvc 5/18/2007 11:15'!
Definition of a clickable highlighted range of text with optional borders.!
!TextHighlightByBounds methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 11/22/2012 15:19'!
containsPoint: aPoint in: rect
	"Answer whther the bounds contain the given (local coordinate) point."

	|r|
	r := self bounds ifNil: [^ false ].
	r := self fillWidth
		ifTrue: [rect left @ r top corner: (rect right @ r bottom)]
		ifFalse: [r]. 
	^r containsPoint: aPoint! !

!TextHighlightByBounds methodsFor: 'accessing' stamp: 'gvc 10/25/2006 13:18'!
bounds
	"Answer the value of bounds"

	^ bounds! !

!TextHighlightByBounds methodsFor: 'accessing' stamp: 'gvc 10/25/2006 13:02'!
lineRange
	"Answer the value of lineRange"

	^ lineRange! !

!TextHighlightByBounds methodsFor: 'accessing' stamp: 'gvc 10/25/2006 13:18'!
bounds: anObject
	"Set the value of bounds"

	bounds := anObject! !

!TextHighlightByBounds methodsFor: 'accessing' stamp: 'gvc 10/23/2006 10:57'!
borderSides: anObject
	"Set the value of borderSides"

	borderSides := anObject! !

!TextHighlightByBounds methodsFor: 'drawing' stamp: 'gvc 10/30/2006 16:19'!
clicked: evt
	"The receiver has had a mouse down."

	self triggerEvent: #clicked! !

!TextHighlightByBounds methodsFor: 'accessing' stamp: 'gvc 10/25/2006 13:38'!
fillWidth: anObject
	"Set the value of fillWidth"

	fillWidth := anObject! !

!TextHighlightByBounds methodsFor: 'accessing' stamp: 'gvc 10/23/2006 10:41'!
color: anObject
	"Set the value of color"

	color := anObject! !

!TextHighlightByBounds methodsFor: 'accessing' stamp: 'gvc 10/25/2006 13:02'!
lineRange: anObject
	"Set the value of lineRange"

	lineRange := anObject! !

!TextHighlightByBounds methodsFor: 'accessing' stamp: 'gvc 10/25/2006 13:19'!
position: aPoint
	"Set the bounds top left."
	
	self bounds: (aPoint extent: self bounds extent)! !

!TextHighlightByBounds methodsFor: 'initialization' stamp: 'gvc 10/31/2006 11:16'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		color: Color yellow;
		lineRange: (1 to: 0);
		borderWidth: 0;
		borderColor: Color transparent;
		borderSides: #(top right bottom left);
		fillWidth: false! !

!TextHighlightByBounds methodsFor: 'accessing' stamp: 'gvc 10/23/2006 10:57'!
borderSides
	"Answer the value of borderSides"

	^ borderSides! !

!TextHighlightByBounds methodsFor: 'accessing' stamp: 'gvc 10/23/2006 10:41'!
borderColor
	"Answer the value of borderColor"

	^ borderColor! !

!TextHighlightByBounds methodsFor: 'accessing' stamp: 'gvc 10/23/2006 10:41'!
borderWidth: anObject
	"Set the value of borderWidth"

	borderWidth := anObject! !

!TextHighlightByBounds methodsFor: 'accessing' stamp: 'gvc 10/23/2006 10:41'!
color
	"Answer the value of color"

	^ color! !

!TextHighlightByBounds methodsFor: 'accessing' stamp: 'gvc 10/23/2006 10:41'!
borderColor: anObject
	"Set the value of borderColor"

	borderColor := anObject! !

!TextHighlightByBounds methodsFor: 'accessing' stamp: 'gvc 10/23/2006 10:41'!
borderWidth
	"Answer the value of borderWidth"

	^ borderWidth! !

!TextHighlightByBounds methodsFor: 'drawing' stamp: 'MarcusDenker 10/26/2014 09:14'!
drawOn: aCanvas in: rect offset: o
	"Draw the highlight on the given canvas for the given rectangle."

	| r |
	r := self fillWidth
		ifTrue: [ rect left @ (self bounds top + rect top) corner: rect right @ (self bounds bottom + rect top) ]
		ifFalse: [ self bounds translateBy: rect topLeft ].
	r := r
		translateBy:
			(self fillWidth
				ifTrue: [ 0 @ o y negated ]
				ifFalse: [ o negated ]).
	self color isTransparent
		ifFalse: [ aCanvas fillRectangle: r color: self color ].
	(self borderWidth > 0 and: [ self borderColor isTransparent not ])
		ifTrue: [ 
			(self borderSides includes: #top)
				ifTrue: [ aCanvas fillRectangle: (r withHeight: self borderWidth) color: self borderColor ].
			(self borderSides includes: #right)
				ifTrue: [ aCanvas fillRectangle: (r withLeft: r right - self borderWidth) color: self borderColor ].
			(self borderSides includes: #bottom)
				ifTrue: [ aCanvas fillRectangle: (r withTop: r bottom - self borderWidth) color: self borderColor ].
			(self borderSides includes: #left)
				ifTrue: [ aCanvas fillRectangle: (r withWidth: self borderWidth) color: self borderColor ] ]! !

!TextHighlightByBounds methodsFor: 'accessing' stamp: 'gvc 10/25/2006 13:03'!
lineNumber
	"Answer the first in the line range."

	^self lineRange first! !

!TextHighlightByBounds methodsFor: 'accessing' stamp: 'gvc 10/25/2006 13:20'!
position
	"Answer the bounds top left."
	
	^self bounds topLeft! !

!TextHighlightByBounds methodsFor: 'accessing' stamp: 'gvc 10/25/2006 13:38'!
fillWidth
	"Answer the value of fillWidth"

	^ fillWidth! !

!TextIndent commentStamp: '<historical>'!
create a hanging indent. !
!TextIndent methodsFor: 'access' stamp: 'ls 6/22/1998 17:51'!
amount
	"number of tab spaces to indent by"
	^amount! !

!TextIndent methodsFor: 'condensing' stamp: 'ls 6/22/1998 19:27'!
dominates: anAttribute
	^(self class == anAttribute class)! !

!TextIndent methodsFor: 'access' stamp: 'ls 6/22/1998 17:51'!
amount: anInteger
	"change the number of tabs to indent by"
	amount := anInteger! !

!TextIndent methodsFor: 'printing' stamp: 'ls 6/22/1998 18:03'!
printOn: aStream
	super printOn: aStream.
	aStream nextPutAll: ' amount: '.
	amount printOn: aStream! !

!TextIndent methodsFor: 'setting indentation' stamp: 'ls 6/22/1998 18:56'!
emphasizeScanner: scanner
	scanner indentationLevel: amount! !

!TextIndent class methodsFor: 'instance creation' stamp: 'ls 6/27/1998 15:55'!
amount: amount
	"create a TextIndent which will indent by the given amount.  Currently this is a number of tabs, but may change in the futur"
	^super new amount: amount! !

!TextIndent class methodsFor: 'instance creation' stamp: 'ls 6/27/1998 15:54'!
tabs: numTabs
	"create an indentation by the given number of tabs"
	^self amount: numTabs! !

!TextInputFieldModel commentStamp: '<historical>'!
I handle one line of text.

I handle non source code text, that's why editing shortcuts are not supported (cmd+p just print a p by example)!
!TextInputFieldModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:23'!
ghostText: aText
	"<api: #string getter: #ghostText registration: #whenGhostTextChanged:>"
	"Set the ghost text of the text zone"

	ghostText value: aText translated.! !

!TextInputFieldModel methodsFor: 'focus' stamp: 'BenjaminVanRyseghem 5/4/2013 22:42'!
eventKeyStrokesForPreviousFocus
	"String describing the keystroke to perform to jump to the previous widget"
	
	^ { Character tab shift asKeyCombination }! !

!TextInputFieldModel methodsFor: 'private' stamp: 'PeterUhnak 3/21/2015 18:25'!
globalsEntryCompletion

	| applicants |
	applicants := (Array
				streamContents: [:strm | Symbol
						allSymbolTablesDo: [:each | (each notEmpty
									and: [each first canBeGlobalVarInitial
											and: [Smalltalk globals includesKey: each]])
								ifTrue: [strm nextPut: each]]]) sort.

	^ EntryCompletion new
				dataSourceBlock: [:currText | applicants];
				filterBlock: [:currApplicant :currText | currText size > 3
						and: [currApplicant asUppercase includesSubstring: currText asString asUppercase]].! !

!TextInputFieldModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:05'!
beEncrypted
"	<api: #do>"
	"Encrypt the entered text"
	
	self encrypted: true! !

!TextInputFieldModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:38'!
whenAcceptOnCRChanged: aBlock
	"aBlock will be performed when acceptOnCR changed"
	
	acceptOnCR whenChangedDo: aBlock! !

!TextInputFieldModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:05'!
removeEntryCompletion
	"< api:#do>"
	"Remove the entry completion"
	
	self entryCompletion: nil! !

!TextInputFieldModel methodsFor: 'accessing' stamp: ''!
textHolder

	^ textHolder! !

!TextInputFieldModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:04'!
acceptOnCR
	"<api: #inspect>"
	"Return true if the text is accepted when the Enter key is stroked"

	^ acceptOnCR value! !

!TextInputFieldModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
encrypted

	^ isEncrypted value! !

!TextInputFieldModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
encrypted: aBoolean

	isEncrypted value: aBoolean ! !

!TextInputFieldModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:18'!
beDecrypted
	"<api: #do>"
	"Decrypt the entered text"
	
	self encrypted: false! !

!TextInputFieldModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:21'!
entryCompletion
	"<api: #st getter: #entryCompletion registration: #whenEntryCompletionChanged:>"
	"Return an entry completion used to suggest text while typing"

	^ entryCompletion value! !

!TextInputFieldModel methodsFor: 'initialization' stamp: 'PeterUhnak 3/21/2015 18:24'!
initialize

	super initialize.
	
	ghostText := '' asValueHolder.
	acceptOnCR := true asValueHolder.
	entryCompletion := nil asValueHolder.
	isEncrypted := false asValueHolder.
	
	ghostText  whenChangedDo: [ :txt | self changed: #ghostText: with: { txt } ].
	acceptOnCR whenChangedDo: [ :bool | self changed: #acceptOnCR: with: { bool } ].
	isEncrypted whenChangedDo: [ :bool | self changed: #encrypted: with: { bool } ].! !

!TextInputFieldModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:06'!
ghostText
	"<api: #inspect>"
	"Return the ghost text of the text zone"

	^ ghostText value! !

!TextInputFieldModel methodsFor: 'NOCompletion' stamp: 'BenjaminVanRyseghem 6/25/2012 23:46'!
isCodeCompletionAllowed
	
	^ false! !

!TextInputFieldModel methodsFor: 'api' stamp: 'PeterUhnak 3/21/2015 18:30'!
enableGlobalsCompletion
	self entryCompletion: self globalsEntryCompletion! !

!TextInputFieldModel methodsFor: 'morphic' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
accept: aText

	textHolder value: aText.
	actionToPerformHolder value cull: aText.
	
	"Dummy changed to raise an announcement"
	actionPerformedHolder value: aText.
	self changed: #clearUserEdits.! !

!TextInputFieldModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:49'!
entryCompletion: anEntryCompletion
	"<api: #st getter: #entryCompletion registration: #whenEntryCompletionChanged:>"
	"Set an entry completion used to suggest text while typing"

	entryCompletion value: anEntryCompletion.! !

!TextInputFieldModel methodsFor: 'accessing' stamp: ''!
actionToPerformHolder

	^ actionToPerformHolder! !

!TextInputFieldModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:38'!
whenGhostTextChanged: aBlock
	"aBlock will be performed when ghostText changed"
	
	ghostText whenChangedDo: aBlock! !

!TextInputFieldModel methodsFor: 'focus' stamp: 'BenjaminVanRyseghem 5/4/2013 22:45'!
eventKeyStrokesForNextFocus
	"String describing the keystroke to perform to jump to the next widget"	
		
	^ { Character tab asKeyCombination }! !

!TextInputFieldModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:21'!
acceptOnCR: aBoolean
	"<api: #boolean getter: #acceptOnCR registration: #whenAcceptOnCRChanged:>"
	"Set if the text is accepted when the Enter key is stroked or not"

	acceptOnCR value: aBoolean! !

!TextInputFieldModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:38'!
whenEntryCompletionChanged: aBlock
	"aBlock will be performed when entryCompletion changed"
	
	entryCompletion whenChangedDo: aBlock! !

!TextInputFieldModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/1/2013 13:39'!
defaultSpec
	<spec: #default>
	
	^ #(TextInputFieldAdapter
		adapt: #(model))! !

!TextInputFieldModel class methodsFor: 'example' stamp: 'BenjaminVanRyseghem 5/14/2013 17:06'!
example
	| instance |
	
	instance := self new.
	instance extent: 300@25.
	instance openWithSpec.
	instance ghostText: 'This is a ghost'.
	instance text: 'This is a text'.
	! !

!TextInputFieldModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/13/2014 15:26'!
adapterName

	^ #TextInputFieldAdapter! !

!TextKern commentStamp: '<historical>'!
A TextKern encodes a kerning change applicable over a given range of text.  Positive values of kern spread letters out, negative kern will cause them to overlap more.  Note that kerns other than 0 will display somewhat slower, as kerning is not yet supported in the text scanning primitive. !
!TextKern methodsFor: 'as yet unclassified' stamp: 'di 10/31/97 11:12'!
kern
	^ kern! !

!TextKern methodsFor: 'as yet unclassified' stamp: 'tk 12/30/97 09:59'!
kern: kernValue
	kern := kernValue.
	self reset.! !

!TextKern methodsFor: 'as yet unclassified' stamp: 'ar 9/9/2003 22:03'!
hash
	"#hash is re-implemented because #= is re-implemented"
	^kern hash! !

!TextKern methodsFor: 'testing' stamp: 'ar 9/21/2000 14:16'!
isKern
	^true! !

!TextKern methodsFor: 'as yet unclassified' stamp: 'di 10/31/97 11:10'!
dominates: other
	"NOTE: The use of active in this code is specific to its use in the method
		Text class addAttribute: att toArray: others"
	(active and: [other class == self class and: [other kern + kern = 0]])
		ifTrue: [active := false.  ^ true].  "can only dominate once"
	^ false! !

!TextKern methodsFor: 'as yet unclassified' stamp: 'di 10/31/97 11:15'!
= other 
	^ (other class == self class) 
		and: [other kern = kern]! !

!TextKern methodsFor: 'as yet unclassified' stamp: 'di 10/29/97 11:50'!
emphasizeScanner: scanner
	"Augment (or diminish) the kerning offset for text display"
	scanner addKern: kern! !

!TextKern methodsFor: 'as yet unclassified' stamp: 'di 10/31/97 11:11'!
set
	^ active! !

!TextKern methodsFor: 'as yet unclassified' stamp: 'di 10/31/97 11:04'!
reset
	active := true! !

!TextKern methodsFor: 'as yet unclassified' stamp: 'tk 9/21/1999 15:57'!
writeScanOn: strm

	kern > 0 ifTrue: [
		1 to: kern do: [:kk | strm nextPut: $+]].
	kern < 0 ifTrue: [
		1 to: 0-kern do: [:kk | strm nextPut: $-]].! !

!TextKern methodsFor: 'as yet unclassified' stamp: 'di 10/31/97 13:10'!
dominatedByCmd0
	"Cmd-0 should turn off kerning"
	^ true! !

!TextKern class methodsFor: 'as yet unclassified' stamp: 'di 10/29/97 11:49'!
kern: kernValue
	^ self new kern: kernValue! !

!TextKernTest commentStamp: 'TorstenBergmann 1/31/2014 12:25'!
SUnit tests for class TextKern!
!TextKernTest methodsFor: 'tests' stamp: 'mjr 8/20/2003 18:55'!
setUp
	super setUp.
	prototypes
		add: (TextKern kern: 1) ! !

!TextLine commentStamp: '<historical>'!
A TextLine embodies the layout of a line of composed text.
	left right top bottom		The full line rectangle
	firstIndex lastIndex		Starting and stopping indices in the full text
	internalSpaces		Number of spaces to share paddingWidth
	paddingWidth		Number of pixels of extra space in full line
	baseline				Distance of baseline below the top of the line
	leftMargin			Left margin due to paragraph indentation
TextLine's rather verbose message protocol is required for compatibility with the old CharacterScanners.!
!TextLine methodsFor: 'accessing' stamp: 'di 10/21/97 20:14'!
last
	^ lastIndex! !

!TextLine methodsFor: 'scanning' stamp: ''!
justifiedTabDeltaFor: spaceIndex 
	"Compute the delta for a tab in a line of justified text, so tab falls 
	somewhere plausible when line is justified."

	| pad extraPad |
	internalSpaces = 0 ifTrue: [^0].
	pad := paddingWidth // internalSpaces.
	extraPad := paddingWidth \\ internalSpaces.
	spaceIndex <= extraPad
		ifTrue: [^spaceIndex * (pad + 1)]
		ifFalse: [^extraPad * (pad + 1) + (spaceIndex - extraPad * pad)]! !

!TextLine methodsFor: 'scanning' stamp: ''!
justifiedPadFor: spaceIndex 
	"Compute the width of pad for a given space in a line of justified text."

	| pad |
	internalSpaces = 0 ifTrue: [^0].
	pad := paddingWidth // internalSpaces.
	spaceIndex <= (paddingWidth \\ internalSpaces)
		ifTrue: [^pad + 1]
		ifFalse: [^pad]! !

!TextLine methodsFor: 'accessing' stamp: 'di 10/21/97 20:12'!
first
	^ firstIndex! !

!TextLine methodsFor: 'private' stamp: ''!
internalSpaces: spacesInteger paddingWidth: padWidthInteger

	internalSpaces := spacesInteger.
	paddingWidth := padWidthInteger! !

!TextLine methodsFor: 'accessing' stamp: 'di 10/23/97 19:58'!
left
	^ left! !

!TextLine methodsFor: 'accessing' stamp: 'di 10/20/97 23:27'!
stop: stopInteger 
	"Set the stopping point in the string of the line to be stopInteger."

	lastIndex := stopInteger! !

!TextLine methodsFor: 'accessing' stamp: 'di 10/23/97 19:58'!
lineHeight
	^ bottom - top! !

!TextLine methodsFor: '*FreeType-addition' stamp: 'tween 4/6/2007 12:48'!
justifiedPadFor: spaceIndex font: aFont
	"Compute the width of pad for a given space in a line of justified text."

	| pad |
	internalSpaces = 0 ifTrue: [^0].
	^(aFont notNil and:[aFont isSubPixelPositioned])
		ifTrue:[paddingWidth * 1.0 / internalSpaces]
		ifFalse:[
			pad := paddingWidth // internalSpaces.
			spaceIndex <= (paddingWidth \\ internalSpaces)
				ifTrue: [pad + 1]
				ifFalse: [pad]]
		! !

!TextLine methodsFor: 'accessing' stamp: ''!
internalSpaces: spacesInteger 
	"Set the number of spaces in the line to be spacesInteger."

	internalSpaces := spacesInteger! !

!TextLine methodsFor: 'accessing' stamp: 'di 10/23/97 19:58'!
right
	^ right! !

!TextLine methodsFor: 'accessing' stamp: ''!
baseline
	^ baseline! !

!TextLine methodsFor: 'accessing' stamp: 'di 11/26/97 16:18'!
setRight: x
	right := x! !

!TextLine methodsFor: 'accessing' stamp: 'hmm 2/9/2001 11:58'!
rectangle: lineRectangle
	left := lineRectangle left.
	right := lineRectangle right.
	top := lineRectangle top.
	bottom := lineRectangle bottom! !

!TextLine methodsFor: 'private' stamp: 'di 10/20/97 23:08'!
firstIndex: firstInteger lastIndex: lastInteger
	firstIndex := firstInteger.
	lastIndex := lastInteger! !

!TextLine methodsFor: 'printing' stamp: 'di 10/23/97 23:19'!
printOn: aStream
	super printOn: aStream.
	aStream space; print: firstIndex; nextPutAll: ' to: '; print: lastIndex! !

!TextLine methodsFor: 'accessing' stamp: ''!
paddingWidth: padWidthInteger 
	"Set the amount of space to be added to the font to be padWidthInteger."

	paddingWidth := padWidthInteger! !

!TextLine methodsFor: 'accessing' stamp: 'di 10/21/97 20:42'!
leftMargin
	"This has to get fixed -- store during composition"
	^ self left! !

!TextLine methodsFor: 'accessing' stamp: 'nice 3/6/2008 22:44'!
leftMarginForAlignment: alignmentCode
	alignmentCode = RightFlush ifTrue: [^ self left + paddingWidth].
	alignmentCode = Centered ifTrue: [^ self left + (paddingWidth//2)].
	^ self left  "leftFlush and justified"! !

!TextLine methodsFor: 'accessing' stamp: 'di 10/21/97 20:42'!
rightMargin
	"This has to get fixed -- store during composition"
	^ self right! !

!TextLine methodsFor: 'accessing' stamp: 'di 10/23/97 19:58'!
bottomRight
	^ right@bottom! !

!TextLine methodsFor: 'comparing' stamp: 'ar 9/9/2003 22:03'!
hash
	"#hash is re-implemented because #= is re-implemented"
	^firstIndex hash bitXor: lastIndex hash! !

!TextLine methodsFor: 'accessing' stamp: 'di 10/23/97 20:00'!
rectangle
	^ self topLeft corner: self bottomRight! !

!TextLine methodsFor: 'accessing' stamp: 'di 11/26/97 16:58'!
width
	^ right - left! !

!TextLine methodsFor: 'updating' stamp: 'di 11/7/97 08:32'!
moveBy: delta 
	"Move my rectangle by the given delta"
	left := left + delta x.
	right := right + delta x.
	top := top + delta y.
	bottom := bottom + delta y.
! !

!TextLine methodsFor: 'accessing' stamp: 'di 10/23/97 19:58'!
top
	^ top! !

!TextLine methodsFor: 'accessing' stamp: 'di 10/23/97 19:58'!
topLeft
	^ left @ top! !

!TextLine methodsFor: 'accessing' stamp: 'di 10/23/97 19:58'!
bottom
	^ bottom! !

!TextLine methodsFor: 'accessing' stamp: ''!
paddingWidth
	"Answer the amount of space to be added to the font."

	^paddingWidth! !

!TextLine methodsFor: 'accessing' stamp: ''!
internalSpaces
	"Answer the number of spaces in the line."

	^internalSpaces! !

!TextLine methodsFor: 'comparing' stamp: 'di 10/20/97 23:24'!
= line

	self species = line species
		ifTrue: [^((firstIndex = line first and: [lastIndex = line last])
				and: [internalSpaces = line internalSpaces])
				and: [paddingWidth = line paddingWidth]]
		ifFalse: [^false]! !

!TextLine methodsFor: 'updating' stamp: 'di 4/28/1999 11:12'!
slideIndexBy: delta andMoveTopTo: newTop
	"Relocate my character indices and y-values.
	Used to slide constant text up or down in the wake of a text replacement."

	firstIndex := firstIndex + delta.
	lastIndex := lastIndex + delta.
	bottom := bottom + (newTop - top).
	top := newTop.
! !

!TextLine methodsFor: 'accessing' stamp: 'hmm 2/9/2001 11:58'!
leftMargin: lm
	left := lm! !

!TextLine methodsFor: 'private' stamp: 'di 10/23/97 19:57'!
lineHeight: height baseline: ascent
	bottom := top + height.
	baseline := ascent! !

!TextLine methodsFor: 'updating' stamp: 'di 10/20/97 23:25'!
slide: delta 
	"Change the starting and stopping points of the line by delta."

	firstIndex := firstIndex + delta.
	lastIndex := lastIndex + delta! !

!TextLine class methodsFor: 'instance creation' stamp: 'di 10/20/97 23:08'!
start: startInteger stop: stopInteger internalSpaces: spacesInteger paddingWidth: padWidthInteger
	"Answer an instance of me with the arguments as the start, stop points, 
	number of spaces in the line, and width of the padding."
	| line |
	line := self new firstIndex: startInteger lastIndex: stopInteger.
	^ line internalSpaces: spacesInteger paddingWidth: padWidthInteger! !

!TextLineEndingsTest commentStamp: 'nk 11/1/2003 07:55'!
This is a test case for Text>>withSqueakLineEndings and String>>withSqueakLineEndings.

The main problem we've seen with the Text version is that it doesn't preserve formatting correctly.!
!TextLineEndingsTest methodsFor: 'tests' stamp: 'sd 6/5/2005 10:07'!
testSimpleTextConversionCrLF

	| string newText |
	string := 'This is a test', String crlf, 'of the conversion'.
	newText := string asText withSqueakLineEndings.
	self assert: ((string size - 1) = newText size).
	self assert: (newText size = newText runs size).! !

!TextLineEndingsTest methodsFor: 'tests' stamp: 'sd 6/5/2005 10:07'!
testStringConversionNoLF

	| string newString |
	string := 'This is a test', String cr, 'of the conversion'.
	newString := string withSqueakLineEndings.
	self assert: (string = newString).! !

!TextLineEndingsTest methodsFor: 'tests' stamp: 'sd 6/5/2005 10:07'!
testStringConversionJustLF

	| string newString |
	string := 'This is a test', String lf, 'of the conversion'.
	newString := string withSqueakLineEndings.
	self assert: (string size = newString size).! !

!TextLineEndingsTest methodsFor: 'tests' stamp: 'sd 6/5/2005 10:07'!
testSimpleTextConversionJustLF

	| string newText |
	string := 'This is a test', String lf, 'of the conversion'.
	newText := string asText withSqueakLineEndings.
	self assert: ((string size) = newText size).
	self assert: (newText size = newText runs size).! !

!TextLineEndingsTest methodsFor: 'tests' stamp: 'sd 6/5/2005 10:06'!
testDecoratedTextConversionCrLF

	| text newText |
	text := ('123456', String crlf, '901234') asText.
	text addAttribute: TextColor blue from: 4 to: 10.
	text addAttribute: TextColor red from: 6 to: 9.
	text addAttribute: TextEmphasis bold.
	newText := text withSqueakLineEndings.
	self assert: ((text size - 1) = newText size).
	self assert: (newText size = newText runs size).
	self assert: (newText attributesAt: 6) = (text attributesAt: 6).
	self assert: (newText attributesAt: 8) = (text attributesAt: 9).! !

!TextLineEndingsTest methodsFor: 'tests' stamp: 'sd 6/5/2005 10:07'!
testDecoratedTextConversionNoLF

	| text newText |
	text := ('123456', String cr, '901234') asText.
	text addAttribute: TextColor blue from: 4 to: 10.
	text addAttribute: TextColor red from: 6 to: 9.
	text addAttribute: TextEmphasis bold.
	newText := text withSqueakLineEndings.
	self assert: ((text size) = newText size).
	self assert: (newText size = newText runs size).
	self assert: (newText attributesAt: 6) = (text attributesAt: 6).
	self assert: (newText attributesAt: 8) = (text attributesAt: 8).! !

!TextLineEndingsTest methodsFor: 'tests' stamp: 'sd 6/5/2005 10:06'!
testDecoratedTextConversionJustLF

	| text newText |
	text := ('123456', String lf, '901234') asText.
	text addAttribute: TextColor blue from: 4 to: 10.
	text addAttribute: TextColor red from: 6 to: 9.
	text addAttribute: TextEmphasis bold.
	newText := text withSqueakLineEndings.
	self assert: ((text size) = newText size).
	self assert: (newText size = newText runs size).
	self assert: (newText attributesAt: 6) = (text attributesAt: 6).
	self assert: (newText attributesAt: 8) = (text attributesAt: 8).! !

!TextLineEndingsTest methodsFor: 'tests' stamp: 'sd 6/5/2005 10:07'!
testSimpleTextConversionJustCR

	| string newText |
	string := 'This is a test', String cr, 'of the conversion'.
	newText := string asText withSqueakLineEndings.
	self assert: ((string size) = newText size).
	self assert: (newText size = newText runs size).! !

!TextLineEndingsTest methodsFor: 'tests' stamp: 'sd 6/5/2005 10:07'!
testStringConversionCrLF

	| string newString |
	string := 'This is a test', String crlf, 'of the conversion'.
	newString := string withSqueakLineEndings.
	self assert: ((string size - 1) = newString size).! !

!TextLineTest methodsFor: 'running' stamp: 'mjr 8/20/2003 18:56'!
setUp
	super setUp.
	prototypes
		add: (TextLine
				start: 1
				stop: 50
				internalSpaces: 2
				paddingWidth: 1) ! !

!TextLink commentStamp: 'TorstenBergmann 1/31/2014 12:18'!
A link in text referring to class and methods. !
!TextLink methodsFor: 'testing' stamp: 'CamilloBruni 2/6/2012 23:01'!
mayActOnEvent: anEvent
	^ anEvent isMouseUp and: [ anEvent commandKeyPressed ]! !

!TextLink methodsFor: 'testing' stamp: 'lr 3/14/2010 21:13'!
validate: specString
	"Can this string be decoded to be Class space Method (or Comment, Definition, Hierarchy)? If so, return it in valid format, else nil"

	| list first mid last |
	list := specString findTokens: ' 	.|'.
	list isEmpty
		ifTrue: [ ^ nil ].
	last := list last.
	last first isUppercase
		ifTrue: [ 
			(#('Comment' 'Definition' 'Hierarchy') includes: last)
				ifFalse: [ ^ nil ].	"Check for 'Rectangle Comment Comment' and remove last one"
			(list at: list size - 1 ifAbsent: [ ^ nil ]) = last
				ifTrue: [ list := list allButLast ] ].
	list size > 3
		ifTrue: [ ^ nil ].
	list size < 2
		ifTrue: [ ^ nil ].
	Symbol hasInterned: list first ifTrue: [ :sym | first := sym ].
	first ifNil: [ ^ nil ].
	Smalltalk globals at: first ifAbsent: [ ^ nil ].
	mid := list size = 3
		ifTrue: [ 
			(list at: 2) = 'class'
				ifTrue: [ 'class ' ]
				ifFalse: [ ^ nil ] ]
		ifFalse: [ '' ].	"OK if method name is not interned -- may not be defined yet"
	^ first , ' ' , mid , last! !

!TextLink methodsFor: 'accessing' stamp: 'tk 12/30/97 10:33'!
info
	^ classAndMethod! !

!TextLink methodsFor: 'styling' stamp: 'CamilloBruni 2/1/2012 19:57'!
emphasizeScanner: scanner
	! !

!TextLink methodsFor: 'styling' stamp: 'tk 12/16/97 13:44'!
writeScanOn: strm

	strm nextPut: $L; nextPutAll: classAndMethod; nextPut: $;! !

!TextLink methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/8/2012 14:49'!
analyze: aString with: nonMethod
	"Initalize this attribute holder with a piece text the user typed into a paragraph.  Returns the text to emphesize (may be different from selection)  Does not return self!!.  nonMethod is what to show when clicked, i.e. the last part of specifier (Comment, Definition, or Hierarchy).  May be of the form:
Point
<Point>
Click Here<Point>
<Point>Click Here
"
	"Obtain the showing text and the instructions"
	| b1 b2 trim |
	b1 := aString indexOf: $<.
	b2 := aString indexOf: $>.
	(b1 < b2) & (b1 > 0) ifFalse: ["only one part"
		classAndMethod := self validate: aString, ' ', nonMethod.
		^ classAndMethod ifNotNil: [aString]].
	"Two parts"
	trim := aString trimBoth.
	(trim at: 1) == $< 
		ifTrue: [(trim last) == $>
			ifTrue: ["only instructions" 
				classAndMethod := self validate: (aString copyFrom: b1+1 to: b2-1), ' ', nonMethod.
				^ classAndMethod ifNotNil: [classAndMethod]]
			ifFalse: ["at the front"
				classAndMethod := self validate: (aString copyFrom: b1+1 to: b2-1), ' ', nonMethod.
				^ classAndMethod ifNotNil: [aString copyFrom: b2+1 to: aString size]]]
		ifFalse: [(trim last) == $>
			ifTrue: ["at the end"
				classAndMethod := self validate: (aString copyFrom: b1+1 to: b2-1), ' ', nonMethod.
				^ classAndMethod ifNotNil: [aString copyFrom: 1 to: b1-1]]
			ifFalse: ["Illegal -- <> has text on both sides"
				^ nil]]
! !

!TextLink methodsFor: 'event handling' stamp: 'CamilloBruni 2/2/2012 02:18'!
actOnMove: anEvent for: target in: aParagraph editor: anEditor
	"override in subclasses"
	^ false! !

!TextLink methodsFor: 'testing' stamp: 'tk 12/16/97 16:49'!
analyze: aString

	| list |
	list := super analyze: aString.
	classAndMethod := list at: 1.
	^ list at: 2! !

!TextLink methodsFor: 'accessing' stamp: 'tk 12/5/97 17:09'!
classAndMethod: aString
	classAndMethod := aString! !

!TextLink class methodsFor: 'as yet unclassified' stamp: 'tk 12/16/97 08:53'!
scanFrom: strm
	"read a link in the funny format used by Text styles on files. LPoint +;LPoint Comment;"

	^ self new classAndMethod: (strm upTo: $;)! !

!TextMessageLink commentStamp: '<historical>'!
A link to a hidden mail message.  Clicking on it allows the message to be viewed or saved to disk.!
!TextMessageLink methodsFor: 'accessing' stamp: 'MarcusDenker 7/22/2014 13:09'!
message
	^message! !

!TextMessageLink methodsFor: 'appearance' stamp: 'ls 4/30/2000 20:34'!
emphasizeScanner: scanner
	scanner textColor: Color brown! !

!TextMessageLink methodsFor: 'initialization' stamp: 'ls 4/30/2000 18:54'!
initialize: message0
	message := message0! !

!TextMessageLink class methodsFor: 'instance creation' stamp: 'MarcusDenker 10/9/2013 16:35'!
message: aMessage
	^self new initialize: aMessage! !

!TextMethodLink commentStamp: 'TorstenBergmann 1/31/2014 12:18'!
An active link in a text linking to a method!
!TextMethodLink methodsFor: 'accessing' stamp: 'CamilloBruni 2/2/2012 02:14'!
selector
	^ selector! !

!TextMethodLink methodsFor: 'initialization' stamp: 'CamilloBruni 3/9/2012 16:24'!
initialize 
	super initialize.
	browseSenders := false.! !

!TextMethodLink methodsFor: 'event handling' stamp: 'CamilloBruni 3/9/2012 16:32'!
actOnClick: anEvent for: target in: aParagraph editor: anEditor
	self flag: 'TODO: complete implementation with class'.
	
	browseSenders == anEvent shiftPressed
		ifTrue: [ anEditor implementorsOf: self selector ]
		ifFalse: [ anEditor sendersOf: self selector ].
		
	^ true! !

!TextMethodLink methodsFor: 'accessing' stamp: 'CamilloBruni 3/9/2012 16:34'!
senders: aBoolean
	browseSenders := aBoolean! !

!TextMethodLink methodsFor: 'accessing' stamp: 'CamilloBruni 2/2/2012 02:14'!
selector: aStringOrSymbol
	selector := aStringOrSymbol asSymbol.! !

!TextMethodLink class methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 2/2/2012 02:13'!
selector: aStringOrSymbol
	^ self new
		selector: aStringOrSymbol;
		yourself! !

!TextMethodLink class methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 3/9/2012 16:24'!
selector: aString senders: browseSenders
	^ (self selector: aString)
		senders: browseSenders;
		yourself! !

!TextModel commentStamp: '<historical>'!
I handle basic multi-line text. Try:
	"self example".
	
My main purpose is to handle source code (I have editing shortcuts support)!
!TextModel methodsFor: 'api-shout' stamp: 'StephaneDucasse 2/26/2015 17:16'!
behavior
	"<api: #inspect>"
	"Return the class corresponding to the method class of the source code you are editing"
	
	^ behaviorHolder value! !

!TextModel methodsFor: 'api-doIt' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
doItContext

	^ doItContext value! !

!TextModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/27/2013 15:01'!
askBeforeDiscardingEdits: aBoolean

	askBeforeDiscardingEdits value: aBoolean! !

!TextModel methodsFor: 'focus' stamp: 'BenjaminVanRyseghem 5/4/2013 22:42'!
eventKeyStrokesForPreviousFocus
	"String describing the keystroke to perform to jump to the previous widget"

	^ { Character arrowLeft command ctrl asKeyCombination }! !

!TextModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:23'!
isCodeCompletionAllowed: aBoolean
	"<api: #boolean getter: #isCodeCompletionAllowed registration: #whenCodeCompletionAllowedChanged:>"
	"Set if code completion is allowed"
	
	isCodeCompletionAllowedHolder value: aBoolean! !

!TextModel methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 1/10/2014 12:16'!
registerEvents

	textHolder whenChangedDo: [ self changed: #getText ].
	readSelectionHolder whenChangedDo: [ self changed: #readSelection ].
	enabledHolder whenChangedDo: [ :bool | self changed: #enabled: with: { bool } ].
	hasUnacceptedEdits whenChangedDo: [ :bool | self changed: #setHasUnacceptedEdits: with: { bool } ].
	selection whenChangedDo: [:block | self changed: #setSelectionFromModel: with: { block value } ].
	scrollValue whenChangedDo: [ :newPosition | self changed: #setScrollValue: with: { newPosition } ].
	autoAccept whenChangedDo: [:bool | self changed: #autoAccept: with: { bool } ].
	wantsVisualFeedback whenChangedDo: [ :bool | self changed: #changed with: #() ].
	askBeforeDiscardingEdits whenChangedDo: [ :bool | self changed: #askBeforeDiscardingEdits: with: { bool } ].! !

!TextModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:44'!
setSelection: anInterval
	"Set the text selection without changing the readSelectionBlock"
	"<api: #st getter: #getSelection>"

	selection ifNotNil: [: holder | holder value: anInterval ]! !

!TextModel methodsFor: 'initialization' stamp: 'DucasseStephane 9/10/2014 09:59'!
initialize

	super initialize.
	
	textHolder := '' asValueHolder.
	behaviorHolder := nil asValueHolder.
	aboutToStyleHolder := [ false ] asValueHolder.
	actionToPerformHolder := [ :text |  ] asValueHolder.
	readSelectionHolder := [ selection value ] asValueHolder.
	enabledHolder := true asValueHolder.
	actionPerformedHolder := '' asValueHolder.
	isCodeCompletionAllowedHolder := true asValueHolder.
	doItContext := nil asValueHolder.
	doItReceiver := nil asValueHolder.
	hasUnacceptedEdits := false asValueHolder.
	selection := (1 to: 0) asValueHolder.
	scrollValue := (0@0) asValueHolder.
	menuHolder := [ :menu :shifted | shifted
			ifTrue: [ SmalltalkEditor shiftedYellowButtonMenu ]
			ifFalse: [ SmalltalkEditor yellowButtonMenu ] ] asValueHolder.
	autoAccept := false asValueHolder.
	wantsVisualFeedback := true asValueHolder.
	askBeforeDiscardingEdits := true asValueHolder.
	
	self registerEvents.
	self registerEventsForShout! !

!TextModel methodsFor: 'NOCompletion' stamp: 'NicolaiHess 7/24/2014 18:10'!
selectedClassOrMetaClass

	^ self behavior! !

!TextModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:38'!
whenCodeCompletionAllowedChanged: aBlock
	"Set a block to perform when the code completion value changed"
	
	actionPerformedHolder whenChangedDo: aBlock! !

!TextModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:56'!
autoAccept 
	"Return true if the text is accepted after ech keystroke"
	"<api:#inspect>"
	^ autoAccept value! !

!TextModel methodsFor: 'api-errors' stamp: 'BenjaminVanRyseghem 1/5/2014 14:05'!
notify: errorMessage at: position in: sourceCode

	self changed: #notify:at:in: with: { errorMessage . position . sourceCode }! !

!TextModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:38'!
whenTextIsAccepted: aBlock
	"Set a block to perform when the text is accepted"
	
	actionPerformedHolder whenChangedDo: aBlock! !

!TextModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:38'!
whenBehaviorChanged: aBlock
	"Set a block to perform when the behavior class changed"
	
	behaviorHolder whenChangedDo: aBlock! !

!TextModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:18'!
scrollValue
	"<api: #inspect>"
	"Return the current scroll position"

	^ scrollValue value! !

!TextModel methodsFor: 'api-doIt' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
doItReceiver: anObject

	doItReceiver value: anObject! !

!TextModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:21'!
text: aText
	"<api: #string getter: #getText registration: #whenTextChanged:>"
	"Set the text of the text zone"
	
	textHolder value: aText! !

!TextModel methodsFor: '*SmartSuggestions' stamp: 'GiselaDecuzzi 5/15/2013 10:57'!
sugsContext
	^ SugsMessageBrowserContext model: self.! !

!TextModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:38'!
whenReadSelectionIsChanged: aBlock
	"Set a block to perform when the read selection block changed"
	
	readSelectionHolder whenChangedDo: aBlock! !

!TextModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:00'!
accept
	"<api: #do>"
	"Accep the current pendingtext"
	
	self changed: #accept with: #().
	
	"Dummy changed to raise an announcement"
	actionPerformedHolder value: self text.! !

!TextModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:38'!
whenMenuHolderChanged: aBlock
	"Set a block to perform when the block use to build menu changed"
	
	menuHolder whenChangedDo: aBlock! !

!TextModel methodsFor: 'api-shout' stamp: 'StephaneDucasse 2/26/2015 16:56'!
aboutToStyleBlock
	"Return the block used to know if the text must be styled"	
	"<api:#inspect>"
	^ aboutToStyleHolder value! !

!TextModel methodsFor: 'api-doIt' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
doItContext: anObject

	doItContext value: anObject! !

!TextModel methodsFor: 'api-doIt' stamp: 'md 11/14/2013 17:29'!
doItReceiver
	| receiver |
	
	receiver := doItReceiver value.
	receiver isBehavior ifTrue: [receiver  := receiver theNonMetaClass].
	^receiver! !

!TextModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/24/2013 15:56'!
selectAll
	
	self changed: #selectAll with: #()! !

!TextModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:01'!
hasUnacceptedEdits
	"<api:#inspect>"
	"Return if the text zone has unaccepted edits (orange corner)"

	hasUnacceptedEdits ifNil: [ ^ false ].
	^ hasUnacceptedEdits value! !

!TextModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:42'!
hasUnacceptedEdits: aBoolean
	"Return if the text zone has unaccepted edits (orange corner)"
	"<api:#boolean getter: #hasUnacceptedEdits>"
	hasUnacceptedEdits value: aBoolean! !

!TextModel methodsFor: '*NodeNavigation' stamp: 'GiselaDecuzzi 5/13/2013 13:36'!
isWorkspace
	^false! !

!TextModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
selectedBehavior

	^ behaviorHolder value! !

!TextModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:05'!
clearSelection
"	<api: #do>"
   "Remove selection from the text model"

	self setSelection: (0 to: 0)! !

!TextModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:37'!
whenAboutToStyleBlockChanged: aBlock
	"Set a block to perform when the about to style block changed"
	
	aboutToStyleHolder whenChangedDo: aBlock! !

!TextModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:20'!
readSelectionBlock: aBlock
	"<api: #block getter: #readSelectionBlock registration: #whenReadSelectionIsChanged:>"
	"Set the block used to calculate the text selection"

	^ readSelectionHolder value: aBlock! !

!TextModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:12'!
readSelectionBlock
	"<api: #inspect>"
	"Return the block used to calculate the text selection"

	^ readSelectionHolder value! !

!TextModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:54'!
scrollValue: aPoint
	"<api: #point getter: #scrollValue registration: #whenScrollValuehanged:>"
	"Set the scroll position"

	^ scrollValue value: aPoint! !

!TextModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 2/7/2013 14:18'!
text

	^ self getText! !

!TextModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:19'!
acceptBlock
	"<api: #inspect>"
	"Return the block to perform when the text is accepted.
	The block must have one argument, which will be the accepted text"

	^ actionToPerformHolder value! !

!TextModel methodsFor: 'NOCompletion' stamp: 'StephaneDucasse 2/26/2015 16:59'!
isCodeCompletionAllowed
	"<api:#inspect>"
	"Return if code completion is allowed"
	
	^ isCodeCompletionAllowedHolder value! !

!TextModel methodsFor: '*Spec-MorphicAdapters' stamp: 'StephaneDucasse 2/26/2015 16:44'!
pendingText: aText
	"<api: #string getter: #pendingText>"
	"Set the pending text. Do no accept it"

	self 
		detectMorphicAdapterDo: [ :w | w pendingText: aText ]
		ifNone: [ self text: aText ]! !

!TextModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:42'!
hasEditingConflicts: aBoolean
	"Set if the text zone has editing conflicts"
	"<api:#boolean getter: #hasEditingConflicts>"
	
	^ self changed: #hasEditingConflicts: with: { aBoolean }! !

!TextModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:22'!
acceptBlock: aBlockWithOneArgument
	"<api: #block getter: #acceptBlock registration: #whenAcceptBlockChanged:>"
	"Set the block to perform when the text is accepted.
	The block must have one argument, which will be the accepted text.
	The block can return false if the candidate text is to be rejected"

	actionToPerformHolder value: aBlockWithOneArgument! !

!TextModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:00'!
readSelection
	"<api: #inspect>"
	^ readSelectionHolder value cull: self text cull: self! !

!TextModel methodsFor: '*Spec-MorphicAdapters' stamp: 'StephaneDucasse 2/26/2015 17:01'!
pendingText
	"<api: #inspect>"
	"Return the current pending text"

	^ self 
		detectMorphicAdapterDo: [ :w | w pendingText ]
		ifNone: [ self getText ]! !

!TextModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:37'!
whenAutoAcceptChanged: aBlock
	"aBlock will be performed when autoAccept changed"
	
	autoAccept whenChangedDo: aBlock! !

!TextModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 17:12'!
whenAboutToStyleChanged: aBlock
	"<api: #event>"
	"Set a block to perform when the about to style block changed"
	
	self whenAboutToStyleBlockChanged: [:block :old :announcement :anAnnouncer | 
		aBlock cull: (block value) cull: old cull: announcement cull: anAnnouncer ]! !

!TextModel methodsFor: 'focus' stamp: 'BenjaminVanRyseghem 5/4/2013 22:42'!
eventKeyStrokesForNextFocus
	"String describing the keystroke to perform to jump to the next widget"
	^ { Character arrowRight command ctrl asKeyCombination }! !

!TextModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:56'!
menuHolder
	"<api: #inspect>"
	"Return the block used to calculate the text selection"

	^ menuHolder value! !

!TextModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:38'!
whenTextChanged: aBlock
	"Set a block to perform when the text changed"
	
	textHolder whenChangedDo: aBlock! !

!TextModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:37'!
whenAcceptBlockChanged: aBlock
	"Set a block to perform when the accept block changed"
	
	actionToPerformHolder whenChangedDo: aBlock! !

!TextModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:45'!
autoAccept: aBoolean
	"<api: #boolean getter: #autoAccept registration: #whenAutoAcceptChanged:>"
	"Set if the text is accepted after each keystroke or not"

	autoAccept value: aBoolean! !

!TextModel methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 9/28/2013 21:29'!
registerEventsForShout

	aboutToStyleHolder whenChangedDo: [ self changed: #getText ].
	behaviorHolder
		whenChangedDo: [ :class | 
			self changed: #classOrMetaClass: with: { class }.
			self changed: #getText ]! !

!TextModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/12/2013 22:39'!
codePaneMenu: aMenu shifted: shifted 
	"Note that unless we override perform:orSendTo:, 
	PluggableTextController will respond to all menu items in a 
	text pane"
	
	^ menuHolder value cull: aMenu cull: shifted! !

!TextModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/27/2013 14:52'!
wantsVisualFeedback

	^ wantsVisualFeedback value! !

!TextModel methodsFor: 'api-shout' stamp: 'StephaneDucasse 2/26/2015 17:12'!
isAboutToStyle
	"<api: #inspect>"
	"Return if the text zone is shouted or not"

	^ self aboutToStyleBlock value! !

!TextModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:04'!
getText
	"<api: #inspect>"
	^ textHolder value! !

!TextModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/27/2013 14:52'!
wantsVisualFeedback: aBoolean

	wantsVisualFeedback value: aBoolean! !

!TextModel methodsFor: 'api-shout' stamp: 'StephaneDucasse 2/26/2015 17:20'!
aboutToStyle: aBoolean	
	"<api: #boolean getter: #isAboutToStyle registration: #whenAboutToStyleChanged:>"
	"Set if the text zone must be styled"
	
	aboutToStyleHolder value: [ aBoolean ]! !

!TextModel methodsFor: 'api-shout' stamp: 'StephaneDucasse 2/26/2015 16:47'!
aboutToStyleBlock: aBlockReturningABoolean
	"<api: #block getter: #aboutToStyleBlock registration: #whenAboutToStyleBlockChanged:>"
	"Set the block used to know if the text must be styled.
	The block must return a boolean"

	aboutToStyleHolder value: aBlockReturningABoolean! !

!TextModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:01'!
getSelection
	"<api:#inspect>"
	"Get the text selection"

	selection ifNil: [ ^(1 to: 0) ].
	^ selection value! !

!TextModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 1/5/2014 02:24'!
accept: aText notifying: aNotifyier
	| accept |
	
	accept := actionToPerformHolder value cull: aText cull: aNotifyier.
	accept == false ifTrue: [ ^ false ].
	
	textHolder value: aText.
	
	"Dummy changed to raise an announcement"
	actionPerformedHolder value: aText.
	
	self changed: #clearUserEdits.
	^ true! !

!TextModel methodsFor: 'api' stamp: 'NicolaiHess 2/18/2014 23:33'!
setSelectionInterval: anInterval
	selection rawValue: anInterval! !

!TextModel methodsFor: '*NodeNavigation' stamp: 'GiselaDecuzzi 5/22/2013 10:39'!
sourceTextArea
	^ self widget! !

!TextModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:54'!
menuHolder: aBlock
	"<api: #block getter: #menuHolder registration: #whenMenuHolderChanged:>"
	"Set the block used to compute the menu"

	^ menuHolder value:  aBlock! !

!TextModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:56'!
hasEditingConflicts
	"<api:#inspect>"
	"Return if the text zone has editing conflicts"

	^ self widget 
		ifNil: [ false ]
		ifNotNil: [:w | w hasEditingConflicts ]! !

!TextModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/27/2013 15:00'!
askBeforeDiscardingEdits

	^ askBeforeDiscardingEdits value! !

!TextModel methodsFor: 'api-shout' stamp: 'StephaneDucasse 2/26/2015 16:55'!
behavior: aClass
	"< api: #st getter: #behavior registration: #whenBehaviorChanged:>"
	"Set the class corresponding to the method class of the source code you are editing"

	behaviorHolder value: aClass! !

!TextModel methodsFor: 'api-events' stamp: 'StephaneDucasse 2/26/2015 16:38'!
whenScrollValueChanged: aBlock
	"Set a block to perform when the scroll value changed"
	
	scrollValue whenChangedDo: aBlock! !

!TextModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/1/2013 13:39'!
defaultSpec
	<spec: #default>
	
	^ #(TextAdapter
		adapt: #(model))! !

!TextModel class methodsFor: 'example' stamp: 'SeanDeNigris 4/19/2013 22:50'!
example

	| instance |	
	instance := self new.
	instance openWithSpec.
	instance text: 'This is a test.
If this had been an actual emergency...'.! !

!TextModel class methodsFor: 'specs' stamp: ''!
title

	^ 'Text'! !

!TextModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/13/2014 15:26'!
adapterName

	^ #TextAdapter! !

!TextMorph commentStamp: 'MarcusDenker 2/14/2010 22:24'!
TextMorphs support display of text with emphasis.  They also support reasonable text-editing capabilities, as well as embedded hot links, and the ability to embed submorphs in the text.

Late in life, TextMorph was made a subclass of BorderedMorph to provide border and background color if desired.  In order to keep things compatible, protocols have been redirected so that color (preferably textColor) relates to the text, and backgroundColor relates to the inner fill color.

Text display is clipped to the innerBounds of the rectangle, and text composition is normally performed within a rectangle which is innerBounds inset by the margins parameter.

If text has been embedded in another object, one can elect to fill the owner's shape, in which case the text will be laid out in the shape of the owner's shadow image (including any submorphs other than the text).  One can also elect to have the text avoid occlusions, in which case it will avoid the bounds of any sibling morphs that appear in front of it.  It may be necessary to update bounds in order for the text runaround to notice the presence of a new occluding shape.

The optional autoFitContents property enables the following feature:  if the text contents changes, then the bounds of the morph will be adjusted to fit the minimum rectangle that encloses the text (plus any margins specified).  Similarly, any attempt to change the size of the morph will be resisted if this parameter is set.  Except...

If the wrapFlag parameter is true, then text will be wrapped at word boundaries based on the composition width (innerBounds insetBy: margins) width.  Thus an attempt to resize the morph in autofit mode, if it changes the width, will cause the text to be recomposed with the new width, and then the bounds will be reset to the minimum enclosing rectangle.  Similarly, if the text contents are changed with the wrapFlag set to true, word wrap will be performed based on the current compostion width, after which the bounds will be set (or not), based on the autoFitcontents property.

Note that fonts can only be applied to the TextMorph as a whole.  While you can change the size, color, and emphasis of a subsection of the text and have it apply to only that subsection, changing the font changes the font for the entire contents of the TextMorph. 

Still a TextMorph can be composed of several texts of different fonts
| font1 font2 t1 t2 tMorph|
tMorph := TextMorph new.
font1 := (TextFontReference toFont: (StrikeFont familyName: 'Atlanta' size: 22)).
font2 := (TextFontReference toFont: (StrikeFont familyName: 'Atlanta' size: 11)).
t1 := 'this is font1' asText addAttribute: font1.
t2 := ' and this is font2' asText addAttribute: font2.
tMorph contents: (t1,t2).
tMorph openInHand.


Yet to do:
Make a comprehensive control for the eyedropper, with border width and color, inner color and text color, and margin widths.!
!TextMorph methodsFor: 'private' stamp: 'di 8/4/2000 16:06'!
composeToBounds
	"Compose my text to fit my bounds.
	If any text lies outside my bounds, it will be clipped, or
	if I have successors, it will be shown in the successors."
	| |
	self releaseParagraph; paragraph.
	container ifNotNil:
		[self privateBounds: container bounds truncated].
	self paragraph positionWhenComposed: self position.
	successor ifNotNil:
		[successor predecessorChanged].

! !

!TextMorph methodsFor: '*glamour-morphic-widgets' stamp: 'cyrilledelaunay 6/6/2011 16:01'!
setOptimalResizing
	self hResizing: #rigid.
	self vResizing: #rigid! !

!TextMorph methodsFor: 'editing' stamp: 'dgd 2/21/2003 22:29'!
passKeyboardFocusTo: otherMorph 
	| w |
	self flag: #arNote.	"Do we need this?!!"
	(w := self world) isNil 
		ifFalse: 
			[w 
				handsDo: [:h | h keyboardFocus == self ifTrue: [h newKeyboardFocus: otherMorph]]]! !

!TextMorph methodsFor: 'accessing' stamp: 'nk 8/30/2004 05:43'!
fontName: fontName pointSize: fontSize
	| newTextStyle |
	newTextStyle := ((TextStyle named: fontName asSymbol) ifNil: [ TextStyle default ]) copy.
	newTextStyle ifNil: [self error: 'font ', fontName, ' not found.'].

	textStyle := newTextStyle.
	text addAttribute: (TextFontChange fontNumber: (newTextStyle fontIndexOfPointSize: fontSize)).
	paragraph ifNotNil: [paragraph textStyle: newTextStyle]! !

!TextMorph methodsFor: 'event handling' stamp: 'FernandoOlivero 10/4/2010 16:34'!
escapePressed
	! !

!TextMorph methodsFor: 'linked frames' stamp: 'di 7/28/2001 10:35'!
addSuccessor: evt
	| newMorph |
	newMorph := self copy predecessor: self successor: successor.
	newMorph extent: self width @ 100.
	successor ifNotNil: [successor setPredecessor: newMorph].
	self setSuccessor: newMorph.
	successor recomposeChain.
	evt hand attachMorph: newMorph! !

!TextMorph methodsFor: 'menu' stamp: 'di 7/27/2001 13:20'!
wrapOnOff
	self wrapFlag: wrapFlag not! !

!TextMorph methodsFor: 'initialization' stamp: 'GuillermoPolito 5/3/2013 15:45'!
initialize
	super initialize.
	borderWidth := 0.
	textStyle := TextStyle default copy.
	wrapFlag := true.
	margins := (0@0 corner: 0@0).
	
	self attachKeymapCategory: #TextMorph.! !

!TextMorph methodsFor: 't-rotating' stamp: ''!
prepareForRotating
	"If I require a flex shell to rotate,
	then wrap it in one and return it.
	Polygons, eg, may override to do nothing."

	^ self addFlexShell! !

!TextMorph methodsFor: 'initialization' stamp: 'mir 8/2/1999 10:35'!
string: aString fontName: aName size: aSize wrap: shouldWrap

	shouldWrap
		ifTrue: [self contentsWrapped: aString]
		ifFalse: [self contents: aString].
	self fontName: aName size: aSize! !

!TextMorph methodsFor: 'linked frames' stamp: 'jm 10/28/97 18:31'!
predecessor
	^ predecessor! !

!TextMorph methodsFor: 'event handling' stamp: 'CamilloBruni 2/4/2012 14:50'!
yellowButtonActivity
	"Supply the normal 'code pane' menu to use its text editing 
	commands from a menu."
	^ self yellowButtonActivity:false! !

!TextMorph methodsFor: 'editing' stamp: 'ar 12/17/2001 13:09'!
chooseFont
	self editor changeTextFont.
	self updateFromParagraph.! !

!TextMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/15/2015 12:40'!
drawOnAthensCanvas: anAthensCanvas
	"Draw the receiver on a canvas.
	Draw keyboard focus if appropriate."

	| fauxBounds  |
	self setDefaultContentsIfNil.
	super drawOnAthensCanvas: anAthensCanvas.	"Border and background if any"	"nothing to draw?"
	self startingIndex > text size
		ifTrue: [ ^ self ].	"Hack here:  The canvas expects bounds to carry the location of the text, but we also need to communicate clipping."

	fauxBounds := self bounds topLeft corner: self innerBounds bottomRight.	"self paragraph drawOnAthensCanvas: aCanvas bounds: fauxBounds."
	self paragraph drawOnAthensCanvas: anAthensCanvas bounds: fauxBounds color: color
! !

!TextMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 9/5/2007 16:12'!
takesKeyboardFocus
	"Answer whether the receiver can normally take keyboard focus."

	^true! !

!TextMorph methodsFor: 'editing' stamp: 'sw 8/12/2002 01:10'!
acceptOnCR
	"Answer whether the receiver wants to accept when the Return key is hit.  Generic TextMorph has no such feature, but subclasses may."

	^ false! !

!TextMorph methodsFor: 'geometry' stamp: 'GuillermoPolito 9/1/2010 18:48'!
privateMoveBy: delta 
	super privateMoveBy: delta.
	editor ifNil: [paragraph ifNotNil: [paragraph moveBy: delta]]
		ifNotNil: 
			["When moving text with an active editor, save and restore all state."

			paragraph moveBy: delta.
			self installEditorToReplace: editor]! !

!TextMorph methodsFor: 'linked frames' stamp: 'jm 10/28/97 18:31'!
lastCharacterIndex
	^ self paragraph lastCharacterIndex! !

!TextMorph methodsFor: 'menu' stamp: 'dgd 8/30/2003 22:18'!
wrapString
	"Answer the string to put in a menu that will invite the user to 
	switch autoFit mode"
	^ (wrapFlag
		ifTrue: ['<yes>']
		ifFalse: ['<no>'])
		, 'text wrap to bounds' translated! !

!TextMorph methodsFor: 'private' stamp: 'Tsutomu Hiroshima 11/17/2003 08:50'!
updateFromParagraph
	"A change has taken place in my paragraph, as a result of editing and I must be updated.  If a line break causes recomposition of the current paragraph, or it the selection has entered a different paragraph, then the current editor will be released, and must be reinstalled with the resulting new paragraph, while retaining any editor state, such as selection, undo state, and current typing emphasis."

	| newStyle sel oldLast oldEditor back |
	paragraph ifNil: [^self].
	wrapFlag ifNil: [wrapFlag := true].
	editor ifNotNil: 
			[oldEditor := editor.
			sel := editor selectionInterval.
			editor storeSelectionInParagraph].
	text := paragraph text.
	paragraph textStyle = textStyle 
		ifTrue: [self fit]
		ifFalse: 
			["Broadcast style changes to all morphs"

			newStyle := paragraph textStyle.
			(self firstInChain text: text textStyle: newStyle) recomposeChain.
			editor ifNotNil: [self installEditorToReplace: editor]].
	super layoutChanged.
	sel ifNil: [^self].

	"If selection is in top line, then recompose predecessor for possible ripple-back"
	predecessor ifNotNil: 
			[sel first <= (self paragraph lines first last + 1) 
				ifTrue: 
					[oldLast := predecessor lastCharacterIndex.
					predecessor paragraph 
						recomposeFrom: oldLast
						to: text size
						delta: 0.
					oldLast = predecessor lastCharacterIndex 
						ifFalse: 
							[predecessor changed.	"really only last line"
							self predecessorChanged]]].
	((back := predecessor notNil 
				and: [sel first <= self paragraph firstCharacterIndex]) or: 
				[successor notNil 
					and: [sel first > (self paragraph lastCharacterIndex + 1)]]) 
		ifTrue: 
			["The selection is no longer inside this paragraph.
		Pass focus to the paragraph that should be in control."

			back ifTrue: [predecessor recomposeChain] ifFalse: [self recomposeChain].
			self firstInChain withSuccessorsDo: 
					[:m | 
					(sel first between: m firstCharacterIndex and: m lastCharacterIndex + 1) 
						ifTrue: 
							[m installEditorToReplace: oldEditor.
							^self passKeyboardFocusTo: m]].
			self error: 'Inconsistency in text editor'	"Must be somewhere in the successor chain"].
	editor ifNil: 
			["Reinstate selection after, eg, style change"

			self installEditorToReplace: oldEditor].
	"self setCompositionWindow."
! !

!TextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 12/22/2010 18:28'!
mouseEnter: evt
	"Handle a mouseEnter event, meaning the mouse just entered my bounds with no button pressed."
	super mouseEnter: evt.
	self showOverEditableTextCursor
	! !

!TextMorph methodsFor: 'menu' stamp: 'di 7/27/2001 13:19'!
autoFitOnOff
	self setProperty: #autoFitContents toValue: self isAutoFit not.
	self isAutoFit ifTrue: [self fit]! !

!TextMorph methodsFor: 'submorphs-add/remove' stamp: 'di 11/7/97 10:00'!
delete
	predecessor ifNotNil: [predecessor setSuccessor: successor].
	successor ifNotNil: [successor setPredecessor: predecessor.
						successor recomposeChain].
	super delete! !

!TextMorph methodsFor: 'event handling' stamp: 'dgd 2/22/2003 19:04'!
hasFocus
	^editor notNil! !

!TextMorph methodsFor: 'editing' stamp: 'StephaneDucasse 5/25/2011 17:48'!
chooseAlignment
	"Interactively change alignment."
	
	self editor changeAlignment.
	self updateFromParagraph! !

!TextMorph methodsFor: 'submorphs-add/remove' stamp: 'ar 12/17/2001 13:21'!
addMorphFront: aMorph fromWorldPosition: wp 
	"Overridden for more specific re-layout and positioning"
	aMorph textAnchorType == #document 
		ifFalse:[^self anchorMorph: aMorph at: wp type: aMorph textAnchorType].
	self addMorphFront: aMorph.
! !

!TextMorph methodsFor: 'blinking' stamp: 'tbn 8/5/2009 09:48'!
stopBlinking
	self stopSteppingSelector: #onBlinkCursor.
! !

!TextMorph methodsFor: 't-rotating' stamp: ''!
forwardDirection: newDirection
	"Set the receiver's forward direction (in eToy terms)"
	self setProperty: #forwardDirection toValue: newDirection.! !

!TextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 1/12/2011 23:03'!
mouseUp: evt
	self handleInteraction: [editor mouseUp: evt].
	(self boundsInWorld containsPoint: self currentHand position)
		ifFalse: [self hideOverEditableTextCursor]! !

!TextMorph methodsFor: 'linked frames' stamp: 'dgd 2/21/2003 22:32'!
startingIndex
	predecessor isNil
		ifTrue: [^ 1].
	^ predecessor lastCharacterIndex + 1 ! !

!TextMorph methodsFor: 'private' stamp: 'RAA 5/6/2001 15:12'!
setSuccessor: newSuccessor

	successor := newSuccessor.
	paragraph ifNotNil: [paragraph wantsColumnBreaks: successor notNil].
! !

!TextMorph methodsFor: 'copying' stamp: 'tk 2/20/2001 18:55'!
veryDeepFixupWith: deepCopier 
	"If target and arguments fields were weakly copied, fix them here.  If 
	they were in the tree being copied, fix them up, otherwise point to the 
	originals!!"

	super veryDeepFixupWith: deepCopier.
	"It makes no sense to share pointers to an existing predecessor and successor"
	predecessor := deepCopier references at: predecessor ifAbsent: [nil].
	successor := deepCopier references at: successor ifAbsent: [nil]! !

!TextMorph methodsFor: 'menu' stamp: 'tk 7/14/2000 12:20'!
shiftedYellowButtonActivity
	"Supply the normal 'code pane' menu to use its text editing commands from a menu."

	self editor pluggableYellowButtonActivity: true.
	self changed.
! !

!TextMorph methodsFor: 'blinking' stamp: 'tbn 8/5/2009 09:53'!
blinkStart: msecs
	"Reset time for blink cursor after which blinking should actually start"
	^self setProperty: #blinkStart toValue: msecs
! !

!TextMorph methodsFor: 'accessing' stamp: 'di 7/23/2001 15:30'!
backgroundColor: newColor
	backgroundColor := newColor.
	self changed! !

!TextMorph methodsFor: 'layout' stamp: 'tk 6/30/1998 17:06'!
acceptDroppingMorph: aMorph event: evt
	"This message is sent when a morph is dropped onto me."

	self addMorphFront: aMorph fromWorldPosition: aMorph position.
		"Make a TextAnchor and install it in a run."! !

!TextMorph methodsFor: 'accessing' stamp: 'di 7/12/2001 14:01'!
isAutoFit
	^ self valueOfProperty: #autoFitContents ifAbsent: [true]
! !

!TextMorph methodsFor: 'editing helpers' stamp: 'CamilloBruni 8/1/2012 16:26'!
changeEmphasis: aSymbol
	"Change the alignment of the receiver. Alignment can be #normal, #bold,  #italic, #narrow, #underlined, or #struckOut"
	
	"| t |
t := 'khkjhjkhjkhjkh
kjhj
kjhkjhkjh
kjh
kjhkjh kjh jh jh jh jh kjh kjh ' asTextMorph.
t openInWorld.
t selectAll; changeEmphasis: #bold.
t inspect"
	
	self editor applyAttribute: (TextEmphasis perform: aSymbol).
	"this code should be moved to TextEditor but changeEmphasis: is defined there for something else
	so it should be renamed first there."
	self updateFromParagraph! !

!TextMorph methodsFor: 'linked frames' stamp: 'dgd 2/21/2003 22:32'!
withSuccessorsDo: aBlock 
	"Evaluate aBlock for each morph in my successor chain"

	| each |
	each := self.
	[each isNil] whileFalse: 
			[aBlock value: each.
			each := each successor]! !

!TextMorph methodsFor: 'containment' stamp: 'nk 8/18/2004 11:23'!
avoidsOcclusions
	^container notNil and: [ container avoidsOcclusions ]
! !

!TextMorph methodsFor: 'accessing' stamp: 'nk 7/3/2003 18:33'!
textAlignment
	"Answer 1..4, representing #leftFlush, #rightFlush, #centered, or #justified"
	^self editor textAlignment! !

!TextMorph methodsFor: 'submorphs-add/remove' stamp: 'di 11/16/97 16:52'!
goBehind
	"We need to save the container, as it knows about fill and run-around"
	| cont |
	container ifNil: [^ super goBehind].
	self releaseParagraph.  "Cause recomposition"
	cont := container.  "Save the container"
	super goBehind.  "This will change owner, nilling the container"
	container := cont.  "Restore the container"
	self changed! !

!TextMorph methodsFor: 'containment' stamp: 'di 11/12/97 09:06'!
setContainer: newContainer
	"Adopt (or abandon) container shape"
	self changed.
	container := newContainer.
	self releaseParagraph! !

!TextMorph methodsFor: 'drawing' stamp: 'MarcusDenker 4/12/2011 17:43'!
drawNullTextOn: aCanvas
	"Make null text frame visible.
	Nicer if not shaded!!"

	aCanvas fillRectangle: bounds color: (self backgroundColor ifNil: [Color transparent])! !

!TextMorph methodsFor: 'menu' stamp: 'StephaneDucasse 10/27/2014 09:34'!
addCustomMenuItems: aCustomMenu hand: aHandMorph
	| outer |
	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
	aCustomMenu addUpdating: #autoFitString target: self selector: #autoFitOnOff.
	aCustomMenu addUpdating: #wrapString target: self selector: #wrapOnOff.
	aCustomMenu add: 'text margins...' selector: #changeMargins:.
	aCustomMenu add: 'add predecessor' selector: #addPredecessor:.
	aCustomMenu add: 'add successor' selector: #addSuccessor:.
	aCustomMenu add: 'code pane menu...' selector: #yellowButtonActivity.
	aCustomMenu add: 'code pane shift menu...' selector: #shiftedYellowButtonActivity.

	outer := self owner.
	outer ifNotNil: [
	outer isLineMorph ifTrue:
		[container isNil
			ifFalse: [aCustomMenu add: 'reverse direction' selector: #reverseCurveDirection.
					aCustomMenu add: 'set baseline' selector: #setCurveBaseline:]]
		ifFalse:
		[self fillsOwner
			ifFalse: [aCustomMenu add: 'fill owner''s shape' selector: #fillingOnOff]
			ifTrue: [aCustomMenu add: 'rectangular bounds' selector: #fillingOnOff].
		self avoidsOcclusions
			ifFalse: [aCustomMenu add: 'avoid occlusions' selector: #occlusionsOnOff]
			ifTrue: [aCustomMenu add: 'ignore occlusions' selector: #occlusionsOnOff]]].
	! !

!TextMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 10/23/2006 14:48'!
overrideExtent: newExtent
	"If autoFit is on then override to false for the duration of the extent call."
	
	self isAutoFit
		ifTrue: [self
				setProperty: #autoFitContents toValue: false;
				extent: newExtent;
				setProperty: #autoFitContents toValue: true]! !

!TextMorph methodsFor: 'accessing' stamp: 'BJP 12/1/2003 00:19'!
newContents: stringOrText 
	"Accept new text contents."
	| newText embeddedMorphs |
	"If my text is all the same font, use the font for my new contents"
	newText := stringOrText isString ifTrue: [ | textSize |
		(text notNil
		  and: [ (textSize := text size) > 0
		    and: [ (text runLengthFor: 1) = textSize ]]) ifTrue: [ | attribs |
			attribs := text attributesAt: 1 forStyle: textStyle.
			Text string: stringOrText copy attributes: attribs.
		]
		ifFalse: [ Text fromString: stringOrText copy ]
	]
	ifFalse: [ stringOrText copy asText.	"should be veryDeepCopy?" ].

	(text = newText and: [text runs = newText runs]) ifTrue: [^ self].	"No substantive change"
	text ifNotNil: [(embeddedMorphs := text embeddedMorphs)
			ifNotNil: 
				[self removeAllMorphsIn: embeddedMorphs.
				embeddedMorphs do: [:m | m delete]]].

	text := newText.

	"add all morphs off the visible region; they'll be moved into the right 
	place when they become visible. (this can make the scrollable area too 
	large, though)"
	newText embeddedMorphs do: 
		[:m | 
		self addMorph: m.
		m position: -1000 @ 0].
	self releaseParagraph.
	"update the paragraph cache"
	self paragraph.
	"re-instantiate to set bounds"
	self world ifNotNil: [self world startSteppingSubmorphsOf: self]! !

!TextMorph methodsFor: 'linked frames' stamp: 'jm 10/28/97 18:31'!
successor
	^ successor! !

!TextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 12/21/2010 23:36'!
select
	editor ifNotNil: [ editor select ]! !

!TextMorph methodsFor: 'private' stamp: 'ar 8/10/2003 18:12'!
removedMorph: aMorph
	| range |
	range := text find: (TextAnchor new anchoredMorph: aMorph).
	range ifNotNil:
		[self paragraph replaceFrom: range first to: range last
				with: Text new displaying: false.
		self fit].
	aMorph textAnchorType: nil.
	aMorph relativeTextAnchorPosition: nil.
	super removedMorph: aMorph.! !

!TextMorph methodsFor: 'initialization' stamp: 'EstebanLorenzano 4/29/2014 15:48'!
defaultColor

	^ defaultColor ifNil: [ self theme textColor ]! !

!TextMorph methodsFor: 'anchors' stamp: 'ar 8/10/2003 18:19'!
anchorMorph: aMorph at: aPoint type: anchorType
	| relPt index newText block |
	aMorph owner == self ifTrue:[self removeMorph: aMorph].
	aMorph textAnchorType: nil.
	aMorph relativeTextAnchorPosition: nil.
	self addMorphFront: aMorph.
	aMorph textAnchorType: anchorType.
	aMorph relativeTextAnchorPosition: nil.
	anchorType == #document ifTrue:[^self].
	relPt := self transformFromWorld globalPointToLocal: aPoint.
	index := (self paragraph characterBlockAtPoint: relPt) stringIndex.
	newText := Text string: (String value: 1) attribute: (TextAnchor new anchoredMorph: aMorph).
	anchorType == #inline ifTrue:[
		self paragraph replaceFrom: index to: index-1 with: newText displaying: false.
	] ifFalse:[
		index := index min: paragraph text size.
		index := paragraph text string lastIndexOf: Character cr startingAt: index ifAbsent:[0].
		block := paragraph characterBlockForIndex: index+1.
		aMorph relativeTextAnchorPosition: (relPt x - bounds left) @ (relPt y - block top ).
		self paragraph replaceFrom: index+1 to: index with: newText displaying: false.
	].
	self fit.! !

!TextMorph methodsFor: 'containment' stamp: 'nk 8/18/2004 11:38'!
fillsOwner: aBoolean 
	self fillsOwner == aBoolean
		ifTrue: [^ self].
	self
		setContainer: (aBoolean
				ifTrue: [wrapFlag := true.
					container
						ifNil: [TextContainer new for: self minWidth: textStyle lineGrid * 2]
						ifNotNil: [container fillsOwner: true]]
				ifFalse: [self avoidsOcclusions
						ifFalse: [ nil ]
						ifTrue: [container fillsOwner: false]])! !

!TextMorph methodsFor: 'event handling' stamp: 'EstebanLorenzano 4/11/2012 10:54'!
keyStroke: evt 
	"Handle a keystroke event."

	Smalltalk tools 
		codeCompletionAround: [ self basicKeyStroke: evt ] 
		textMorph: self 
		keyStroke: evt.! !

!TextMorph methodsFor: 'editing helpers' stamp: 'StephaneDucasse 5/25/2011 18:34'!
italic
	
	self changeEmphasis: #italic! !

!TextMorph methodsFor: 'alignment' stamp: 'StephaneDucasse 5/25/2011 20:09'!
rightFlush 
	
	self changeAlignment: #rightFlush
! !

!TextMorph methodsFor: 't-rotating' stamp: ''!
forwardDirection
	"Return the receiver's forward direction (in eToy terms)"
	^self valueOfProperty: #forwardDirection ifAbsent:[0.0]! !

!TextMorph methodsFor: 'editing helpers' stamp: 'StephaneDucasse 5/25/2011 18:34'!
bold
	
	self changeEmphasis: #bold! !

!TextMorph methodsFor: 'accessing' stamp: 'nk 2/26/2001 12:42'!
selection
	^editor ifNotNil: [ editor selection ]! !

!TextMorph methodsFor: 'accessing' stamp: 'SeanDeNigris 1/29/2011 22:41'!
autoFit: trueOrFalse
	"Should I automatically adjust my size to fit text as it changes?"

	self isAutoFit = trueOrFalse ifTrue: [^ self].
	self autoFitOnOff! !

!TextMorph methodsFor: 'linked frames' stamp: 'di 11/16/97 15:15'!
isLinkedTo: aMorph
	self firstInChain withSuccessorsDo:
		[:m | m == aMorph ifTrue: [^ true]].
	^ false! !

!TextMorph methodsFor: 'accessing' stamp: 'tk 8/31/2000 14:59'!
contentsAsIs: stringOrText
	"Accept new text contents with line breaks only as in the text.
	Fit my width and height to the result."
	wrapFlag := false.
	container ifNotNil: [container fillsOwner ifTrue: [wrapFlag := true]].
	self newContents: stringOrText! !

!TextMorph methodsFor: 'accessing' stamp: 'tk 12/16/1998 11:58'!
userString
	"Do I have a text string to be searched on?"

	^ text string! !

!TextMorph methodsFor: 'menu' stamp: 'di 12/3/97 10:25'!
setCurveBaseline: evt
	| handle origin |
	origin := evt cursorPoint.
	handle := HandleMorph new forEachPointDo:
		[:newPoint | handle removeAllMorphs.
		handle addMorph:
			(PolygonMorph vertices: (Array with: origin with: newPoint)
				color: Color black borderWidth: 1 borderColor: Color black).
		container baseline: (newPoint - origin) y negated asInteger // 5.
		self paragraph composeAll].
	evt hand attachMorph: handle.
	handle startStepping	! !

!TextMorph methodsFor: 'accessing' stamp: 'MarianoMartinezPeck 9/5/2012 14:08'!
wrapFlag
	^ wrapFlag 
	! !

!TextMorph methodsFor: 't-rotating' stamp: ''!
rotationDegrees: degrees	
	"redefined in all morphs which are using myself"! !

!TextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 12/22/2010 18:28'!
hideOverEditableTextCursor  
	self currentHand showTemporaryCursor: nil
	! !

!TextMorph methodsFor: 'containment' stamp: 'nk 8/18/2004 11:37'!
fillingOnOff
	"Establish a container for this text, with opposite filling status"
	self fillsOwner: (self fillsOwner not)! !

!TextMorph methodsFor: 'interactive error protocol' stamp: 'AlainPlantec 1/2/2011 10:33'!
correctFrom: start to: stop with: aString
	editor ifNotNil: [ editor correctFrom: start to: stop with: aString ]! !

!TextMorph methodsFor: 'private' stamp: 'ClementBera 9/30/2013 11:05'!
fit
	"Adjust my bounds to fit the text.  Should be a no-op if autoFit is not specified.
	Required after the text changes,
	or if wrapFlag is true and the user attempts to change the extent."

	| newExtent para cBounds lastOfLines heightOfLast |
	self isAutoFit 
		ifTrue: 
			[newExtent := (self paragraph extent max: 9 @ textStyle lineGrid) + (0 @ 2).
			newExtent := newExtent + (2 * borderWidth).
			newExtent := ((0 @ 0 extent: newExtent) expandBy: margins) extent.
			newExtent ~= bounds extent 
				ifTrue: 
					[(container isNil and: [successor isNil]) 
						ifTrue: 
							[para := paragraph.	"Save para (layoutChanged smashes it)"
							super extent: newExtent.
							paragraph := para]].
			(container notNil and: [successor isNil])
				ifTrue: 
					[cBounds := container bounds truncated.
					"23 sept 2000 - try to allow vertical growth"
					lastOfLines := self paragraph lines last.
					heightOfLast := lastOfLines bottom - lastOfLines top.
					(lastOfLines last < text size 
						and: [lastOfLines bottom + heightOfLast >= self bottom]) 
							ifTrue: 
								[container releaseCachedState.
								cBounds := cBounds origin corner: cBounds corner + (0 @ heightOfLast)].
					self privateBounds: cBounds]].

	"These statements should be pushed back into senders"
	self paragraph positionWhenComposed: self position.
	successor ifNotNil: [successor predecessorChanged].
	self changed	"Too conservative: only paragraph composition
					should cause invalidation."! !

!TextMorph methodsFor: 'event handling' stamp: 'ar 10/4/2000 19:09'!
handlesKeyboard: evt
	^true! !

!TextMorph methodsFor: 'accessing' stamp: 'sw 9/1/2000 10:43'!
setCharacters: chars
	"obtain a string value from the receiver"

	(self getCharacters = chars) ifFalse:
		[self newContents: chars]! !

!TextMorph methodsFor: 'events-processing' stamp: 'ar 9/26/2001 22:21'!
handleMouseMove: anEvent
	"Re-implemented to allow for mouse-up move events"
	anEvent wasHandled ifTrue:[^self]. "not interested"
	(anEvent hand hasSubmorphs) ifTrue:[^self].
	anEvent wasHandled: true.
	self mouseMove: anEvent.
	(anEvent anyButtonPressed and:[anEvent hand mouseFocus == self]) ifFalse:[^self].
	(self handlesMouseStillDown: anEvent) ifTrue:[
		"Step at the new location"
		self startStepping: #handleMouseStillDown: 
			at: Time millisecondClockValue
			arguments: {anEvent copy resetHandlerFields}
			stepTime: 1].
! !

!TextMorph methodsFor: 'editing' stamp: 'vj 9/14/2003 20:53'!
chooseStyle
	self editor changeStyle.
	self updateFromParagraph.! !

!TextMorph methodsFor: 'accessing' stamp: 'MarcusDenker 10/24/2012 08:09'!
font
	"Answer the probable font"

	self textStyle fonts ifEmpty: [^TextStyle defaultFont].
	^self textStyle defaultFont.
		! !

!TextMorph methodsFor: 'accessing' stamp: 'kfr 9/21/2003 21:47'!
getFirstCharacter
	"obtain the first character from the receiver if it is empty, return a  
	black dot"
	| aString |
	^ (aString := text string) isEmpty
		ifTrue: ['·']
		ifFalse: [aString first asString] ! !

!TextMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 7/2/2013 14:11'!
setDefaultContentsIfNil
	"Set the default contents"

	| toUse |
	text ifNil:
		[toUse := self valueOfProperty: #defaultContents.
		toUse ifNil: [toUse :='' asText "allBold"].	"try it plain for a while"
		text := toUse]! !

!TextMorph methodsFor: 'linked frames' stamp: 'di 7/28/2001 10:34'!
addPredecessor: evt
	| newMorph |
	newMorph := self copy predecessor: predecessor successor: self.
	newMorph extent: self width @ 100.
	predecessor ifNotNil: [predecessor setSuccessor: newMorph].
	self setPredecessor: newMorph.
	predecessor recomposeChain.
	evt hand attachMorph: newMorph! !

!TextMorph methodsFor: 'editing' stamp: 'BenjaminVanRyseghem 5/16/2013 13:22'!
enterClickableRegion: evt
	| |
	
	evt hand hasSubmorphs ifTrue:[^self].
	evt hand temporaryCursor ifNotNil:[^self].
	"paragraph ifNotNil:[
		(paragraph characterBlockAtPoint: evt position) stringIndex ].
"! !

!TextMorph methodsFor: 'accessing' stamp: 'RAA 8/21/2001 11:41'!
margins

	^margins! !

!TextMorph methodsFor: 'linked frames' stamp: 'di 11/8/97 15:51'!
firstCharacterIndex
	^ self paragraph firstCharacterIndex! !

!TextMorph methodsFor: 'editing' stamp: 'StephaneDucasse 5/25/2011 18:11'!
chooseEmphasis
	"Interactively change emphasis."
	
	self editor changeEmphasis.
	self updateFromParagraph! !

!TextMorph methodsFor: 'accessing' stamp: 'sw 5/22/2003 02:39'!
cursor
	"Answer the receiver's logical cursor position"

	| loc |
	loc := self valueOfProperty: #textCursorLocation  ifAbsentPut: [1].
	loc := loc min: text string size.
	^ loc rounded
	! !

!TextMorph methodsFor: 'initialization' stamp: 'di 11/17/2001 15:34'!
setTextStyle: aTextStyle

	textStyle := aTextStyle.
	self releaseCachedState; changed! !

!TextMorph methodsFor: 'find-replace' stamp: 'AlainPlantec 1/9/2011 18:42'!
sharesFindReplace
	^ false! !

!TextMorph methodsFor: 'accessing' stamp: 'nk 2/26/2001 12:45'!
selectAll
	self editor selectFrom: 1 to: text size! !

!TextMorph methodsFor: 'private' stamp: 'GuillermoPolito 9/4/2010 17:45'!
editorClass
	"Answer the class used to create the receiver's editor"
	
	^SmalltalkEditor! !

!TextMorph methodsFor: 'accessing' stamp: 'dgd 2/21/2003 22:32'!
setFirstCharacter: source 
	"Set the first character of the receiver as indicated"
	| aChar chars |
	aChar := source asCharacter.
	(chars := self getCharacters) isEmpty
		ifTrue: [self
				newContents: (String with: aChar)]
		ifFalse: [chars first = aChar
				ifFalse: [self
						newContents: (String
								streamContents: [:aStream | 
									aStream nextPut: aChar.
									aStream
										nextPutAll: (chars copyFrom: 2 to: chars size)])]] ! !

!TextMorph methodsFor: 'caching' stamp: 'hfm 1/11/2011 01:25'!
releaseCachedState
 
	super releaseCachedState.
	self releaseParagraph
! !

!TextMorph methodsFor: 'change reporting' stamp: 'di 10/18/2004 13:50'!
ownerChanged
	| priorEditor |
	super ownerChanged.
	container ifNotNil: 
			[editor isNil 
				ifTrue:
					[self releaseParagraph.
					(container isKindOf: TextContainer) ifTrue:
						["May need to recompose due to changes in owner"
						self installEditorToReplace: nil.
						self releaseParagraph]]
				ifFalse: 
					[priorEditor := editor.
					self releaseParagraph.
					self installEditorToReplace: priorEditor]]! !

!TextMorph methodsFor: 'accessing' stamp: 'di 9/30/97 09:51'!
contentsWrapped: stringOrText
	"Accept new text contents.  Lay it out, wrapping within my current width.
	Then fit my height to the result."
	wrapFlag := true.
	self newContents: stringOrText! !

!TextMorph methodsFor: 'accessing' stamp: 'di 6/22/2001 09:33'!
backgroundColor
	^ backgroundColor! !

!TextMorph methodsFor: 'accessing' stamp: 'nk 2/26/2001 12:45'!
selectFrom: a to: b
	self editor selectFrom: a to: b! !

!TextMorph methodsFor: 'accessing' stamp: 'tk 1/10/2001 13:52'!
text
	^ text! !

!TextMorph methodsFor: 'private' stamp: 'di 10/25/97 17:11'!
setPredecessor: newPredecessor
	predecessor := newPredecessor! !

!TextMorph methodsFor: 'editing' stamp: 'fbs 1/7/2005 15:42'!
preferredKeyboardPosition

	| default rects |
	default  := (self bounds: self bounds in: World) topLeft.
	paragraph ifNil: [^ default].
	rects := paragraph selectionRects.
	rects size = 0 ifTrue: [^ default].
	^ rects first topLeft.

	"^ (self bounds: self bounds in: World) topLeft."
! !

!TextMorph methodsFor: 'accessing' stamp: 'sw 2/18/2003 02:58'!
elementCount
	"Answer how many sub-objects are within me"

	^ self text string size ! !

!TextMorph methodsFor: 't-rotating' stamp: ''!
setDirectionFrom: aPoint
	| delta degrees |
	delta := (self transformFromWorld globalPointToLocal: aPoint) - self referencePosition.
	degrees := delta degrees + 90.0.
	self forwardDirection: (degrees \\ 360) rounded.
! !

!TextMorph methodsFor: 'accessing' stamp: 'nk 7/12/2003 08:39'!
fontName: fontName size: fontSize
	| newTextStyle |
	newTextStyle := ((TextStyle named: fontName asSymbol) ifNil: [ TextStyle default ]) copy.
	textStyle := newTextStyle.
	text addAttribute: (TextFontChange fontNumber: (newTextStyle fontIndexOfSize: fontSize)).
	paragraph ifNotNil: [paragraph textStyle: newTextStyle]! !

!TextMorph methodsFor: 'accessing' stamp: 'tk 9/1/2000 13:50'!
textStyle
	^textStyle! !

!TextMorph methodsFor: 'geometry testing' stamp: 'di 7/12/2001 22:15'!
containsPoint: aPoint
	(super containsPoint: aPoint) ifFalse: [^ false].  "Not in my bounds"
	container ifNil: [^ true].  "In bounds of simple text"
	self startingIndex > text size ifTrue:
		["make null text frame visible"
		^ super containsPoint: aPoint].
	"In complex text (non-rect container), test by line bounds"
	^ self paragraph containsPoint: aPoint
! !

!TextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 2/1/2011 09:28'!
showOverEditableTextCursor
	| o |
	owner isNil
		ifTrue: [^ self].
	o := owner isWorldMorph 
		ifTrue: [self] 
		ifFalse: [owner].
	(o boundsInWorld containsPoint: self currentHand position)
		ifTrue: [self currentHand showTemporaryCursor: (self theme overTextCursorFor: self)]
! !

!TextMorph methodsFor: '*Polymorph-Widgets' stamp: 'gvc 9/5/2007 16:14'!
wantsKeyboardFocusNavigation
	"Answer whether the receiver wants to be navigated to.
	Answer false here (use PluggableTextMorph instead)."

	^false! !

!TextMorph methodsFor: 'blinking' stamp: 'MarcusDenker 12/11/2009 07:43'!
resetBlinkCursor
	"Reset the blinking cursor"
	| para |
	self blinkStart: Time millisecondClockValue + 500.
	para := self paragraph ifNil:[^self].
	para showCaret = para focused ifFalse:[
		para caretRect ifNotNil:[:r| self invalidRect: r].
		para showCaret: para focused.
	].
! !

!TextMorph methodsFor: 'alignment' stamp: 'StephaneDucasse 5/25/2011 20:09'!
centered 
	self changeAlignment: #centered! !

!TextMorph methodsFor: 'geometry' stamp: 'nk 7/11/2004 20:07'!
extent: aPoint 
	| newExtent priorEditor |
	bounds extent = aPoint ifTrue: [^ self].
	priorEditor := editor.
	self isAutoFit
		ifTrue: [wrapFlag ifFalse: [^ self].  "full autofit can't change"
				newExtent := aPoint truncated max: self minimumExtent.
				newExtent x = self extent x ifTrue: [^ self].  "No change of wrap width"
				self releaseParagraphReally.  "invalidate the paragraph cache"
				super extent: newExtent.
				priorEditor
					ifNil: [self fit]  "since the width has changed..."
					ifNotNil: [self installEditorToReplace: priorEditor]]
		ifFalse: [super extent: (aPoint truncated max: self minimumExtent).
				wrapFlag ifFalse: [^ self].  "no effect on composition"
				self composeToBounds]
! !

!TextMorph methodsFor: '*glamour-morphic-widgets' stamp: 'TudorGirba 1/16/2014 11:45'!
asReadOnlyMorph
	^ StringMorph contents: self text! !

!TextMorph methodsFor: 'scripting access' stamp: 'sw 10/13/2004 19:57'!
insertCharacters: aSource
	"Insert the characters from the given source at my current cursor position"

	| aLoc |
	aLoc := self cursor max: 1.
	paragraph replaceFrom: aLoc to: (aLoc - 1) with: aSource asText displaying: true.
	self updateFromParagraph  ! !

!TextMorph methodsFor: 'interactive error protocol' stamp: 'AlainPlantec 1/2/2011 10:34'!
deselect
	editor ifNotNil: [ editor deselect ]! !

!TextMorph methodsFor: 'private' stamp: 'IgorStasenko 12/22/2012 02:49'!
selectionChanged
	"Invalidate all the selection rectangles. 
	Make sure that any drop shadow is accounted for too."
	self paragraph selectionRects
		do: [:r | | intr |
			intr := r intersect: self fullBounds ifNone: [ nil ].
			intr ifNotNil: [ self invalidRect: (self expandFullBoundsForDropShadow: intr)] ]! !

!TextMorph methodsFor: 'accessing' stamp: ''!
contents

	^ text! !

!TextMorph methodsFor: 'find-replace' stamp: 'AlainPlantec 1/9/2011 18:42'!
openFindDialog
	self flash! !

!TextMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 10/13/2013 21:54'!
isTranslucentButNotTransparent
	"Overridden from BorderedMorph to test backgroundColor instead of (text) color."

	backgroundColor ifNil: [ ^ true ].
	(backgroundColor isColor and: [ backgroundColor isTranslucentButNotTransparent ])
		ifTrue: [ ^ true ].
	(borderColor isColor and: [ borderColor isTranslucentButNotTransparent ])
		ifTrue: [ ^ true ].
	^ false! !

!TextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 12/22/2010 18:28'!
handlesMouseOver: evt 
	"Do I want to receive mouseEnter: and mouseLeave: when the button is up and the hand is empty?"
	^ self enabled! !

!TextMorph methodsFor: 'accessing' stamp: 'sw 1/12/98 23:40'!
asText
	^ text! !

!TextMorph methodsFor: 'accessing' stamp: 'nk 10/16/2003 16:42'!
font: aFont
	| newTextStyle |
	newTextStyle := aFont textStyle copy ifNil: [ TextStyle fontArray: { aFont } ].
	textStyle := newTextStyle.
	text addAttribute: (TextFontChange fontNumber: (newTextStyle fontIndexOf: aFont)).
	paragraph ifNotNil: [paragraph textStyle: newTextStyle]! !

!TextMorph methodsFor: 'accessing' stamp: 'sw 8/10/2004 00:56'!
setLastCharacter: source
	"Set the last character of the receiver as indicated"

	| aChar chars |
	aChar := source asCharacter.
	(chars := self getCharacters) size > 0 
		ifFalse:
			[self newContents: (String with: aChar)]
		ifTrue:
			[(chars last = aChar) ifFalse:
				[self newContents: (String streamContents:
					[:aStream |
						aStream nextPutAll: (chars copyFrom: 1 to: (chars size - 1)).
						aStream nextPut: aChar])]]! !

!TextMorph methodsFor: 'accessing' stamp: 'di 10/5/1998 13:56'!
editor
	"Return my current editor, or install a new one."
	editor ifNotNil: [^ editor].
	^ self installEditorToReplace: nil! !

!TextMorph methodsFor: '*Polymorph-Widgets' stamp: 'AlainPlantec 9/15/2011 17:27'!
optimalExtent
	"Create a new paragraph and answer its extent."
	
	^(Paragraph new
		compose: text
		style: textStyle copy
		from: 1
		in: (0@0 extent: 9999999@9999999);
		adjustRightX;
		extent) + (self borderWidth * 2) + (2@0) "FreeType kerning allowance"! !

!TextMorph methodsFor: 'interactive error protocol' stamp: 'AlainPlantec 1/2/2011 10:32'!
nextTokenFrom: start direction: dir
	^ self editor nextTokenFrom: start direction: dir! !

!TextMorph methodsFor: 'geometry' stamp: 'di 8/14/1998 15:50'!
defaultLineHeight
	^ textStyle lineGrid! !

!TextMorph methodsFor: 'interactive error protocol' stamp: 'AlainPlantec 1/2/2011 10:31'!
notify: aString at: anInteger in: aStream
	^ self editor notify: aString at: anInteger in: aStream! !

!TextMorph methodsFor: 'private' stamp: 'di 10/5/1998 16:39'!
releaseEditor 
	"Release the editor for my paragraph.  This morph no longer 'hasFocus'."
	editor ifNotNil:
		[self selectionChanged.
		self paragraph selectionStart: nil selectionStop: nil.
		editor := nil].! !

!TextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 11/16/2010 22:10'!
getMenu: shiftKeyState 
	^ shiftKeyState not
		ifTrue: [TextEditor yellowButtonMenu]
		ifFalse: [TextEditor shiftedYellowButtonMenu]! !

!TextMorph methodsFor: 'drawing' stamp: 'AlainPlantec 10/25/2010 17:09'!
drawOn: aCanvas
	"Draw the receiver on a canvas.
	Draw keyboard focus if appropriate."

	| fauxBounds |
	self setDefaultContentsIfNil.
	super drawOn: aCanvas.  "Border and background if any"
	false ifTrue: [self debugDrawLineRectsOn: aCanvas].  "show line rects for debugging"
	(self startingIndex > text size)
		ifTrue: [self drawNullTextOn: aCanvas].
	"Hack here:  The canvas expects bounds to carry the location of the text, but we also need to communicate clipping."
	fauxBounds := self bounds topLeft corner: self innerBounds bottomRight.
	aCanvas paragraph: self paragraph bounds: fauxBounds color: color.! !

!TextMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 1/10/2014 14:26'!
text: t textStyle: s wrap: wrap color: c
	predecessor: pred successor: succ
	"Private -- for use only in morphic duplication"
	text := t.
	defaultColor := (t attributesAt: 1) detect: [ :e | e isKindOf: TextColor ].
	textStyle := s.
	wrapFlag := wrap.
	color := c.
	paragraph := editor := container := nil.
	self predecessor: pred successor: succ! !

!TextMorph methodsFor: 'menu' stamp: 'MarcusDenker 9/13/2013 15:56'!
changeMargins: evt
	| handle origin aHand newMargin |
	aHand := evt ifNil: [self primaryHand] ifNotNil: [evt hand].
	origin := aHand position.
	handle := HandleMorph new
		forEachPointDo:
			[:newPoint | handle removeAllMorphs.
			handle addMorph:
				(LineMorph from: origin to: newPoint color: Color black width: 1).
			newMargin := (newPoint - origin max: 0@0) // 5.
			self margins: newMargin]
		lastPointDo:
			[:newPoint | handle deleteBalloon.
			self halo ifNotNil: [:halo | halo addHandles]].
	aHand attachMorph: handle.
	handle setProperty: #helpAtCenter toValue: true.
	handle showBalloon:
'Move cursor down and to the right
to increase margin inset.
Click when done.' hand: evt hand.
	handle startStepping! !

!TextMorph methodsFor: 'drawing' stamp: 'IgorStasenko 12/22/2012 02:52'!
areasRemainingToFill: aRectangle
	"Overridden from BorderedMorph to test backgroundColor instead of (text) color."
	(backgroundColor isNil or: [backgroundColor isTranslucent])
		ifTrue: [^ Array with: aRectangle].
	self wantsRoundedCorners
	ifTrue: [(borderWidth > 0 and: [borderColor isColor and: [borderColor isTranslucent]])
				ifTrue: [^ aRectangle areasOutside: (self innerBounds intersect: self boundsWithinCorners ifNone: [self error: 'cannot happen' ])]
				ifFalse: [^ aRectangle areasOutside: self boundsWithinCorners]]
	ifFalse: [(borderWidth > 0 and: [borderColor isColor and: [borderColor isTranslucent]])
				ifTrue: [^ aRectangle areasOutside: self innerBounds]
				ifFalse: [^ aRectangle areasOutside: self bounds]]! !

!TextMorph methodsFor: 'event handling' stamp: 'MarcusDenker 9/13/2013 16:22'!
keyboardFocusChange: aBoolean 	
	super keyboardFocusChange: aBoolean.
	paragraph isNil ifFalse:[paragraph focused: aBoolean].	
	aBoolean 
		ifTrue:["A hand is wanting to send us characters..."
			self hasFocus ifFalse: [self editor	"Forces install"].
			self showOverEditableTextCursor]
		ifFalse:["A hand has clicked elsewhere..."		
			self world 
				ifNotNil:[:w | w handsDo: [:h | h keyboardFocus == self ifTrue: [^self]].
					"Release control unless some hand is still holding on"			
					self releaseEditor].
			self hideOverEditableTextCursor].
	self manageCursor.
	self focusChanged! !

!TextMorph methodsFor: 'private' stamp: 'tk 9/28/1999 16:50'!
privateOwner: newOwner
	"Nil the container when text gets extracted"
	super privateOwner: newOwner.
	container ifNotNil: [
		newOwner ifNotNil: [
			newOwner isWorldOrHandMorph ifTrue: [self setContainer: nil]]]! !

!TextMorph methodsFor: 'menu' stamp: 'di 12/3/97 09:40'!
reverseCurveDirection
	container textDirection: container textDirection negated.
	self paragraph composeAll! !

!TextMorph methodsFor: 'editing' stamp: 'di 4/21/1998 13:22'!
hasUnacceptedEdits: aBoolean
	"Ignored here, but noted in TextMorphForEditView"
! !

!TextMorph methodsFor: 'initialization' stamp: 'mir 8/2/1999 10:34'!
string: aString fontName: aName size: aSize

	self string: aString fontName: aName size: aSize wrap: true! !

!TextMorph methodsFor: 'scripting access' stamp: 'sw 9/15/2000 06:14'!
getAllButFirstCharacter
	"Obtain all but the first character from the receiver; if that would be empty, return a black dot"

	| aString |
	^ (aString := text string) size > 1 ifTrue: [aString copyFrom: 2 to: aString size] ifFalse: ['·']! !

!TextMorph methodsFor: 'editing' stamp: 'CamilloBruni 8/1/2012 16:09'!
handleInteraction: interactionBlock
	"Perform the changes in interactionBlock, noting any change in selection
	and possibly a change in the size of the paragraph.
	Couple ParagraphEditor to Morphic keyboard events"
	| oldEditor oldParagraph oldText |
	oldEditor := self editor.
	oldParagraph := paragraph.
	oldText := oldParagraph text copy.

	self selectionChanged.  "Note old selection"

	interactionBlock value.

	(oldParagraph == paragraph) ifTrue:[
		"this will not work if the paragraph changed"
		editor := oldEditor.     "since it may have been changed while in block"
	].
	self selectionChanged.  "Note new selection"
	(oldText = paragraph text and: [ oldText runs = paragraph text runs ])
		ifFalse:[ self updateFromParagraph ].! !

!TextMorph methodsFor: 'editing' stamp: 'di 4/12/98 11:36'!
handleEdit: editBlock
	"Ensure that changed areas get suitably redrawn"
	self selectionChanged.  "Note old selection"
		editBlock value.
	self selectionChanged.  "Note new selection"
	self updateFromParagraph  "Propagate changes as necessary"! !

!TextMorph methodsFor: 'editing helpers' stamp: 'StephaneDucasse 5/25/2011 18:34'!
narrow
	
	self changeEmphasis: #narrow! !

!TextMorph methodsFor: 'accessing' stamp: 'ar 8/23/2001 21:23'!
crAction: aMessageSend
	"Return the action to perform when encountering a CR in the input"
	^self setProperty: #crAction toValue: aMessageSend! !

!TextMorph methodsFor: 'private' stamp: 'di 7/28/2001 10:33'!
predecessor: pred successor: succ
	"Private -- for use only in morphic duplication"
	predecessor := pred.
	successor := succ.
! !

!TextMorph methodsFor: 'blinking' stamp: 'MarcusDenker 12/11/2009 07:43'!
onBlinkCursor
	"Blink the cursor"
	| para |
	para := self paragraph ifNil:[^nil].
	Time millisecondClockValue < self blinkStart ifTrue:[
		"don't blink yet"
		^para showCaret: para focused.
	].
	para showCaret: para showCaret not.
	para caretRect ifNotNil:[:r| self invalidRect: r].! !

!TextMorph methodsFor: 'accessing' stamp: 'di 7/19/2001 11:08'!
borderWidth: newWidth
	super borderWidth: newWidth.
	paragraph ifNotNil: [self composeToBounds].! !

!TextMorph methodsFor: 'editing' stamp: 'sw 9/27/1999 12:13'!
chooseEmphasisOrAlignment
	self editor changeEmphasisOrAlignment.
	self updateFromParagraph! !

!TextMorph methodsFor: 'blinking' stamp: 'tbn 8/5/2009 09:49'!
startBlinking
	self startStepping: #onBlinkCursor 
		at: Time millisecondClockValue 
		arguments: nil stepTime: 500.
	self resetBlinkCursor.
! !

!TextMorph methodsFor: 'editing' stamp: 'di 4/22/1998 10:57'!
acceptContents
	"The message is sent when the user hits enter or Cmd-S.
	Accept the current contents and end editing.
	This default implementation does nothing."
	self updateFromParagraph! !

!TextMorph methodsFor: 'linked frames' stamp: 'di 11/12/97 09:10'!
recomposeChain
	"Recompose this textMorph and all that follow it."
	self withSuccessorsDo:
		[:m |  m text: text textStyle: textStyle;  "Propagate new style if any"
				releaseParagraph;  "Force recomposition"
				fit  "and propagate the change"]! !

!TextMorph methodsFor: 'accessing' stamp: 'RAA 8/21/2001 11:18'!
isWrapped
	
	^wrapFlag! !

!TextMorph methodsFor: 't-rotating' stamp: ''!
heading
	"Return the receiver's heading"
	^ self owner 
		ifNil: [self forwardDirection]
		ifNotNil: [self forwardDirection + self owner degreesOfFlex]! !

!TextMorph methodsFor: 'initialization' stamp: 'di 12/29/97 14:42'!
beAllFont: aFont

	textStyle := TextStyle fontArray: (Array with: aFont).
	self releaseCachedState; changed! !

!TextMorph methodsFor: 'event handling' stamp: 'EstebanLorenzano 4/11/2012 10:54'!
basicKeyStroke: evt 
	"Handle a keystroke event."
	| action |

	evt keyValue = 13
		ifTrue: [
			action := self crAction.
			action
				ifNotNil: ["Note: Code below assumes that this was some 
					input field reacting on CR. Break the keyboard 
					focus so that the receiver can be safely deleted."
					evt hand newKeyboardFocus: nil.
					^ action value]].
	self handleInteraction: [ editor keystroke: evt ].
	self updateFromParagraph.
	super keyStroke: evt.! !

!TextMorph methodsFor: 'blinking' stamp: 'tbn 8/5/2009 09:53'!
blinkStart
	"Reset time for blink cursor after which blinking should actually start"
	^self valueOfProperty: #blinkStart ifAbsent:[Time millisecondClockValue]
! !

!TextMorph methodsFor: 'alignment' stamp: 'StephaneDucasse 5/25/2011 20:09'!
justified 
	self changeAlignment: #justified! !

!TextMorph methodsFor: 'editing helpers' stamp: 'StephaneDucasse 5/25/2011 18:35'!
struckOut
	
	self changeEmphasis: #struckOut! !

!TextMorph methodsFor: 'private' stamp: 'RAA 12/5/2001 11:20'!
releaseParagraph

	"a slight kludge so subclasses can have a bit more control over whether the paragraph really 
	gets released. important for GeeMail since the selection needs to be accessible even if the 
	hand is outside me"

	self releaseParagraphReally.
! !

!TextMorph methodsFor: 'accessing' stamp: 'di 9/30/97 15:48'!
contents: stringOrText
	^ self contentsAsIs: stringOrText! !

!TextMorph methodsFor: 'event handling' stamp: 'GaryChambers 4/24/2012 16:03'!
mouseDown: evt 
	"Make this TextMorph be the keyboard input focus, if it isn't  
	already, and repond to the text selection gesture.
	Changed to not take keyboard focus if an owner is a
	PluggableTextMorph that doesn't want focus."
	
	evt yellowButtonPressed
		ifTrue: ["First check for option (menu) click"
			(self yellowButtonActivity: evt shiftPressed) 
				ifTrue: [ ^ self ]].
	self handleInteraction: [editor mouseDown: evt].
	self hasKeyboardFocus
		ifFalse: [(self ownerThatIsA: PluggableTextMorph)
					ifNil: [self takeKeyboardFocus]
					ifNotNil: [:ptm | ptm wantsKeyboardFocus ifTrue: [
							self takeKeyboardFocus]]].
	super mouseDown: evt! !

!TextMorph methodsFor: 'private' stamp: 'RAA 12/5/2001 11:20'!
releaseParagraphReally

	"a slight kludge so subclasses can have a bit more control over whether the paragraph really 
	gets released. important for GeeMail since the selection needs to be accessible even if the 
	hand is outside me"

	"Paragraph instantiation is lazy -- it will be created only when needed"
	self releaseEditor.
	paragraph ifNotNil:
		[paragraph := nil].
	container ifNotNil:
		[container releaseCachedState]! !

!TextMorph methodsFor: 'drawing' stamp: 'di 7/12/2001 10:45'!
debugDrawLineRectsOn: aCanvas
	"Shows where text line rectangles are"
	self paragraph lines do:
		[:line | aCanvas frameRectangle: line rectangle color: Color brown]
! !

!TextMorph methodsFor: 'editing helpers' stamp: 'StephaneDucasse 5/25/2011 18:34'!
underlined
	
	self changeEmphasis: #underlined! !

!TextMorph methodsFor: 'testing' stamp: 'MartinDias 3/22/2013 16:15'!
enabled

	^super enabled and: [ self isLocked not ]! !

!TextMorph methodsFor: 'geometry' stamp: 'di 10/8/1998 23:46'!
bounds
	container ifNil: [^ bounds].
	^ container bounds ifNil: [bounds]! !

!TextMorph methodsFor: 'testing' stamp: 'FernandoOlivero 3/25/2011 11:27'!
canChangeText
	^ self enabled ! !

!TextMorph methodsFor: 'editing helpers' stamp: 'StephaneDucasse 5/25/2011 17:52'!
changeAlignment: aSymbol
	"Change the alignment of the receiver. Alignment can be #leftFlush #centered #rightFlush #justified "
	
	"| t |
t := 'khkjhjkhjkhjkh
kjhj
kjhkjhkjh
kjh
kjhkjh kjh jh jh jh jh kjh kjh ' asTextMorph.
t openInWorld.
t selectAll; changeFormatting: #rightFlush.
t inspect"
	
	self editor applyAttribute: (TextAlignment perform: aSymbol).
	self updateFromParagraph! !

!TextMorph methodsFor: 'visual properties' stamp: 'gvc 9/11/2009 16:36'!
fillStyle
	"Return the current fillStyle of the receiver."
	
	self assureExtension.
	^extension fillStyle ifNil: [
		backgroundColor
			ifNil: [Color transparent]]! !

!TextMorph methodsFor: 'editing helpers' stamp: 'StephaneDucasse 5/25/2011 18:33'!
normal
	
	self changeEmphasis: #normal! !

!TextMorph methodsFor: 'event handling' stamp: 'StephaneDucasse 7/18/2010 16:36'!
handlesMouseDown: evt
	^ self innerBounds containsPoint: evt cursorPoint! !

!TextMorph methodsFor: 'accessing' stamp: 'di 7/20/2001 22:44'!
margins: newMargins
	"newMargins can be a number, point or rectangle, as allowed by, eg, insetBy:."

	margins := newMargins.
	self composeToBounds! !

!TextMorph methodsFor: 'accessing' stamp: 'sw 2/17/2003 18:20'!
cursorWrapped: aNumber
	"Set the cursor as indicated"

	self setProperty: #textCursorLocation toValue: (((aNumber rounded - 1) \\  text string size) + 1)

	! !

!TextMorph methodsFor: 'accessing' stamp: 'sw 6/27/2001 13:45'!
getCharacters
	"obtain a string value from the receiver"

	^ self text string copy! !

!TextMorph methodsFor: 'linked frames' stamp: 'dgd 2/21/2003 22:26'!
firstInChain
	"Return the first morph in a chain of textMorphs"

	| first |
	first := self.
	[first predecessor isNil] whileFalse: [first := first predecessor].
	^first! !

!TextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 12/21/2010 23:37'!
selectInvisiblyFrom: start to: stop
	editor ifNotNil: [ editor selectInvisiblyFrom: start to: stop ]! !

!TextMorph methodsFor: 'accessing' stamp: 'di 4/14/98 08:33'!
contents: stringOrText wrappedTo: width
	"Accept new text contents.  Lay it out, wrapping to width.
	Then fit my height to the result."
	self newContents: ''.
	wrapFlag := true.
	super extent: width truncated@self height.
	self newContents: stringOrText! !

!TextMorph methodsFor: 'copying' stamp: 'AlainPlantec 12/1/2010 10:15'!
veryDeepInner: deepCopier 
	"Copy all of my instance variables. Some need to be not copied at all, but shared.
	Warning!!!! Every instance variable defined in this class must be handled.
	We must also implement veryDeepFixupWith:.  See DeepCopier class comment."

	super veryDeepInner: deepCopier.
	textStyle := textStyle veryDeepCopyWith: deepCopier.
	text := text veryDeepCopyWith: deepCopier.
	wrapFlag := wrapFlag veryDeepCopyWith: deepCopier.
	paragraph := paragraph veryDeepCopyWith: deepCopier.
	editor := editor veryDeepCopyWith: deepCopier.
	container := container veryDeepCopyWith: deepCopier.
	predecessor := predecessor.
	successor := successor.
	backgroundColor := backgroundColor veryDeepCopyWith: deepCopier.
	margins := margins veryDeepCopyWith: deepCopier.
! !

!TextMorph methodsFor: 'accessing' stamp: 'nk 6/18/2003 14:28'!
textAlignmentSymbol
	"Answer one of #leftFlush, #rightFlush, #centered, or #justified"
	^self editor textAlignmentSymbol! !

!TextMorph methodsFor: 'event handling' stamp: 'StephaneDucasse 7/18/2010 16:37'!
wouldAcceptKeyboardFocusUponTab
	"Answer whether the receiver might accept keyboard focus if 
	tab were hit in some container playfield"
	^ true! !

!TextMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 2/4/2012 12:33'!
compositionRectangle
	| compRect |
	compRect := self innerBounds.
	compRect := compRect insetBy: margins.
	compRect width < 9 ifTrue: [compRect := compRect withWidth: 9].
	compRect height < 16 ifTrue: [compRect := compRect withHeight: 16].
	^ compRect! !

!TextMorph methodsFor: 'accessing' stamp: 'sw 8/10/2004 00:53'!
getLastCharacter
	"obtain the last character from the receiver if it is empty, return a black dot"

	| aString |
	^ (aString := text string) size > 0 ifTrue: [aString last asString] ifFalse: ['·']! !

!TextMorph methodsFor: 'private' stamp: 'AlainPlantec 9/15/2011 17:27'!
paragraph
	"Paragraph instantiation is lazy -- create it only when needed"
	|newParagraph|
	paragraph ifNotNil: [^ paragraph].

	self setProperty: #CreatingParagraph toValue: true.
	self setDefaultContentsIfNil.

	"...Code here to recreate the paragraph..."
	newParagraph  := (Paragraph new textOwner: self owner).
	
	newParagraph wantsColumnBreaks: successor notNil.
	newParagraph
		compose: text
		style: textStyle copy
		from: self startingIndex
		in: self container.
	wrapFlag ifFalse:
		["Was given huge container at first... now adjust"
		newParagraph adjustRightX].
	newParagraph focused: (self currentHand keyboardFocus == self).
	paragraph := newParagraph.
	self fit.
	self removeProperty: #CreatingParagraph.


	^ paragraph! !

!TextMorph methodsFor: 'event handling' stamp: 'MarcusDenker 12/2/2013 14:12'!
yellowButtonActivity: shiftKeyState 
	"Invoke the text-editing menu.
	Check if required first!!"
	
	self wantsYellowButtonMenu
		ifFalse: [ ^ false ].
		
	(self getMenu: shiftKeyState)
		ifNotNil: [ :menu|
			menu setInvokingView: self editor.
			menu invokeModal. self changed.
			^ true].
		
	^ true! !

!TextMorph methodsFor: 'geometry' stamp: 'BenjaminVanRyseghem 2/4/2012 12:34'!
minimumExtent


	| minExt |
	textStyle ifNil: [^ 9@16].
	borderWidth ifNil: [^ 9@16].
	minExt := (9@(textStyle lineGrid+2)) + (borderWidth*2).
	^ ((0@0 extent: minExt) expandBy: margins) extent! !

!TextMorph methodsFor: 'blinking' stamp: 'AlainPlantec 4/15/2012 12:44'!
ensureCursor
	paragraph ifNotNil: [ :p | p showCaret: true ]! !

!TextMorph methodsFor: 'private' stamp: 'di 11/8/97 16:02'!
adjustLineIndicesBy: delta
	paragraph ifNotNil: [paragraph adjustLineIndicesBy: delta]! !

!TextMorph methodsFor: 'blinking' stamp: 'AlainPlantec 4/15/2012 12:45'!
manageCursor
	(paragraph isNil or: [paragraph focused not])
		ifTrue: [^ self
				resetBlinkCursor;
				stopBlinking].
	Editor blinkingCursor 
		ifTrue: [self startBlinking]
		ifFalse: [self ensureCursor]! !

!TextMorph methodsFor: 'private' stamp: 'dgd 2/21/2003 22:29'!
predecessorChanged
	| newStart oldStart |
	(self hasProperty: #CreatingParagraph) ifTrue: [^self].
	newStart := predecessor isNil 
				ifTrue: [1]
				ifFalse: [predecessor lastCharacterIndex + 1].
	(self paragraph adjustedFirstCharacterIndex ~= newStart 
		or: [newStart >= text size]) 
			ifTrue: 
				[paragraph composeAllStartingAt: newStart.
				self fit]
			ifFalse: 
				["If the offset to end of text has not changed, just slide"

				oldStart := self firstCharacterIndex.
				self withSuccessorsDo: [:m | m adjustLineIndicesBy: newStart - oldStart]]! !

!TextMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 1/10/2014 14:33'!
text: t textStyle: s
	"Private -- for use only in morphic duplication"
	text := t.
	defaultColor := (t attributesAt: 1) detect: [ :e | e isKindOf: TextColor ] ifNone: [ self color ].
	textStyle := s.
	paragraph ifNotNil: [paragraph textStyle: s]! !

!TextMorph methodsFor: 'geometry' stamp: 'di 7/19/2001 10:57'!
container
	"Return the container for composing this text.  There are four cases:
	1.  container is specified as, eg, an arbitrary shape,
	2.  container is specified as the bound rectangle, because
		this morph is linked to others,
	3.  container is nil, and wrap is true -- grow downward as necessary,
	4.  container is nil, and wrap is false -- grow in 2D as nexessary."

	container ifNil:
		[successor ifNotNil: [^ self compositionRectangle].
		wrapFlag ifTrue: [^ self compositionRectangle withHeight: 9999999].
		^ self compositionRectangle topLeft extent: 9999999@9999999].
	^ container! !

!TextMorph methodsFor: 'accessing' stamp: 'di 7/21/2001 10:37'!
textColor

	^ color! !

!TextMorph methodsFor: 'menu' stamp: 'dgd 8/30/2003 22:06'!
autoFitString
	"Answer the string to put in a menu that will invite the user to 
	switch autoFit mode"
	^ (self isAutoFit
		ifTrue: ['<yes>']
		ifFalse: ['<no>'])
		, 'text auto fit' translated! !

!TextMorph methodsFor: 'editing' stamp: 'di 4/22/1998 11:00'!
cancelEdits
	"The message is sent when the user hits enter or Cmd-L.
	Cancel the current contents and end editing.
	This default implementation does nothing."
	self releaseParagraph! !

!TextMorph methodsFor: 'containment' stamp: 'nk 8/18/2004 11:21'!
fillsOwner
	"Answer true if I fill my owner's shape."
	^container notNil and: [container fillsOwner]! !

!TextMorph methodsFor: 'accessing' stamp: 'GaryChambers 8/17/2010 15:32'!
textColor: aColor

	color = aColor ifTrue: [^ self].
	color := aColor.
	text addAttribute: (TextColor color: aColor).
	self changed.
! !

!TextMorph methodsFor: 'alignment' stamp: 'StephaneDucasse 5/25/2011 18:43'!
leftFlush 

	self changeAlignment: #leftFlush
! !

!TextMorph methodsFor: 'private' stamp: 'IgorStasenko 12/12/2010 03:55'!
installEditorToReplace: priorEditor
	"Install an editor for my paragraph.  This constitutes 'hasFocus'.
	If priorEditor is not nil, then initialize the new editor from its state.
	We may want to rework this so it actually uses the prior editor."

	| stateArray |
	priorEditor ifNotNil: [stateArray := priorEditor stateArray].
	editor := self editorClass forMorph: self.
	priorEditor ifNotNil: [editor stateArrayPut: stateArray].
	self selectionChanged.
	^ editor! !

!TextMorph methodsFor: 'private' stamp: 'di 6/22/2001 09:10'!
clippingRectangle
	^ self innerBounds! !

!TextMorph methodsFor: 'visual properties' stamp: 'gvc 9/11/2009 16:40'!
fillStyle: aFillStyle
	"Set the current fillStyle of the receiver."
	
	backgroundColor := aFillStyle asColor.
	super fillStyle: aFillStyle! !

!TextMorph methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/1/2014 01:08'!
enabled: aBoolean

	aBoolean 
		ifTrue: [ text makeAllColor: self defaultColor ]
		ifFalse: [ text makeAllColor: self theme disabledTextColor ].
		
	self changed! !

!TextMorph methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 5/16/2013 13:23'!
mouseMove: event

	event redButtonPressed ifFalse: [ ^ self ].
	self handleInteraction: [ editor mouseMove: event ]! !

!TextMorph methodsFor: 'classification' stamp: 'ar 12/17/2001 12:46'!
isTextMorph
	^true! !

!TextMorph methodsFor: 'accessing' stamp: 'SeanDeNigris 1/29/2011 22:51'!
wrapFlag: aBoolean
	"Should contained text stay wrapped at my width?"

	aBoolean == wrapFlag ifTrue: [^ self].
	wrapFlag := aBoolean.
	self composeToBounds! !

!TextMorph methodsFor: 'containment' stamp: 'di 11/4/97 15:37'!
occlusionsOnOff
	"Establish a container for this text, with opposite occlusion avoidance status"
	self setContainer:
	(container
	ifNil: [(TextContainer new for: self minWidth: textStyle lineGrid*2)
							fillsOwner: false; avoidsOcclusions: true]
	ifNotNil: [(container avoidsOcclusions and: [container fillsOwner not])
			ifTrue: [nil  "Return to simple rectangular bounds"]
			ifFalse: [container avoidsOcclusions: container avoidsOcclusions not]])! !

!TextMorph methodsFor: 'copying' stamp: 'di 11/12/97 09:31'!
copy
	^ super copy text: text copy textStyle: textStyle copy 
		wrap: wrapFlag color: color
		predecessor: nil successor: nil! !

!TextMorph methodsFor: 'accessing' stamp: 'ar 8/23/2001 21:23'!
crAction
	"Return the action to perform when encountering a CR in the input"
	^self valueOfProperty: #crAction! !

!TextMorph methodsFor: 'accessing' stamp: 'AlainPlantec 12/21/2010 22:03'!
selectionInterval
	^editor ifNotNil: [ editor selectionInterval ]! !

!TextMorph methodsFor: '*Keymapping-Core-override' stamp: 'EstebanLorenzano 2/1/2013 16:12'!
handleKeystroke: anEvent 
	"System level event handling."
	| pasteUp |

	anEvent wasHandled
		ifTrue: [^ self].
	self allowsKeymapping
		ifTrue: [ self dispatchKeystrokeForEvent: anEvent ] .
	anEvent wasHandled
		ifTrue: [
			"We need to check for completion here because otherwise it will try to handle the keystroke, 
			even if it was already processed."
			(Smalltalk tools hasToolNamed: #codeCompletion) 
				ifTrue: [ Smalltalk tools codeCompletion uniqueInstance closeMenu ].
			^ self].
	(self handlesKeyStroke: anEvent)
		ifFalse: [^ self].
	self keyStroke: anEvent.
	anEvent wasHandled: true.! !

!TextMorph methodsFor: 'event handling' stamp: 'AlainPlantec 12/22/2010 18:28'!
mouseLeave: evt
	"Handle a mouseLeave event, meaning the mouse just left my bounds with no button pressed."
	super mouseLeave: evt.
	self hideOverEditableTextCursor
	! !

!TextMorph methodsFor: 'geometry' stamp: 'di 3/1/98 11:40'!
textBounds
	^ bounds! !

!TextMorph methodsFor: 't-rotating' stamp: ''!
rotationDegrees
	"Default implementation."

	^ 0.0
! !

!TextMorph class methodsFor: 'shortcuts' stamp: 'GuillermoPolito 8/10/2014 13:57'!
buildTextEditorKeymapsOn: aBuilder
	<keymap>
	
	(aBuilder shortcut: #accept)
		category: #TextMorph
		default: PharoShortcuts current acceptShortcut
		do: [ :morph | morph acceptContents ].! !

!TextMorphForEditView commentStamp: 'AlainPlantec 2/21/2011 17:43'!
I'm a TextMorph that must be embedded in a PluggableTextMorph.
Multi-line text editor with support for accepting on both each change and/or when keyboard focus changes. Also supports custom selection colour and clickable highlights From PluggableTextEditorMorph.

Instance Variables
	acceptOnCR:		<Object>
	acceptOnFocusChange:		<Object>
	autoAccept:		<Object>
	editView:		<Object>
	selectionColor:		<Object>

acceptOnCR
	- xxxxx

acceptOnFocusChange
	- xxxxx

autoAccept
	- xxxxx

editView
	- xxxxx

selectionColor
	- xxxxx
!
!TextMorphForEditView methodsFor: 'find-replace' stamp: 'AlainPlantec 11/20/2010 11:49'!
findAndSelect: aRegex startingAt: anIndex searchBackwards: searchBackwards
	| where |
	self
		handleEdit: [
			where := self editor
				findAndSelect: aRegex
				startingAt: anIndex
				searchBackwards: searchBackwards].
	editView scrollSelectionIntoView.
	^ where! !

!TextMorphForEditView methodsFor: 'editing' stamp: 'FernandoOlivero 3/25/2011 11:27'!
canChangeText
	^ self editView enabled! !

!TextMorphForEditView methodsFor: 'event handling' stamp: 'GaryChambers 3/2/2012 14:41'!
keyStroke: evt
	"Handle a keystroke. Deal with navigation keys also."
	
	| view |  
	
	editView keyStroke: evt.
	(editView scrollByKeyboard: evt) ifTrue: [^self].
	(acceptOnCR and: [evt keyCharacter = Character cr])
		ifFalse: [(editView navigationKey: evt) ifTrue: [^self]].
	self editor model: editView model.  "For evaluateSelection"
	view := editView.  "Copy into temp for case of a self-mutating doit"
	(acceptOnCR and: [evt keyCharacter = Character cr])
		ifTrue: [^ self editor accept].
	super keyStroke: evt.
	view textChanged.
	view scrollSelectionIntoView.
	self doAutoAccept: evt.
	view scrollSelectionIntoView! !

!TextMorphForEditView methodsFor: 'find-replace' stamp: 'AlainPlantec 11/10/2010 23:52'!
replaceSelectionWith: aReplacementText
	self handleEdit: [self editor replaceSelectionWith: aReplacementText]! !

!TextMorphForEditView methodsFor: 'multi level undo' stamp: 'AlainPlantec 11/8/2010 22:14'!
undoRedoExchange: aninterval with: anotherInterval
	self handleEdit: [self editor undoRedoExchange: aninterval with: anotherInterval]! !

!TextMorphForEditView methodsFor: 'multi level undo' stamp: 'AlainPlantec 11/8/2010 22:14'!
undoTypeIn: aText interval: anInterval 
	self handleEdit: [self editor undoTypeIn: aText interval: anInterval]! !

!TextMorphForEditView methodsFor: 'event handling' stamp: 'CamilloBruni 2/4/2012 14:50'!
escapePressed
	^ self editView yellowButtonActivity: false. ! !

!TextMorphForEditView methodsFor: 'initialization' stamp: 'AlainPlantec 2/21/2011 17:12'!
initialize
	super initialize.
	acceptOnCR := false.
	autoAccept := false.
	acceptOnFocusChange := false! !

!TextMorphForEditView methodsFor: 'private' stamp: 'AlainPlantec 11/11/2010 22:08'!
findText
	^ self editor findText! !

!TextMorphForEditView methodsFor: 'multi level undo' stamp: 'AlainPlantec 11/8/2010 22:14'!
redoTypeIn: aText interval: anInterval 
	self handleEdit: [self editor redoTypeIn: aText interval: anInterval]! !

!TextMorphForEditView methodsFor: 'private' stamp: 'AlainPlantec 11/12/2010 11:51'!
useSecondarySelection
	^ TextEditor useSecondarySelection! !

!TextMorphForEditView methodsFor: 'binding' stamp: 'AlainPlantec 2/2/2011 14:17'!
bindingOf: varName
	^ self editor bindingOf: varName! !

!TextMorphForEditView methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 2/21/2011 17:25'!
autoAccept
	"Answer the value of autoAccept"

	^ autoAccept! !

!TextMorphForEditView methodsFor: 'event handling' stamp: 'AlainPlantec 11/8/2010 22:14'!
wouldAcceptKeyboardFocusUponTab
	"Answer whether the receiver would be a happy inheritor of keyboard focus if tab were hit in an enclosing playfield under propitious circumstances.  Does not make sense for this kind of morph, which is encased in a window"

	^ false! !

!TextMorphForEditView methodsFor: 'drawing' stamp: 'AlainPlantec 11/17/2010 15:27'!
drawOn: aCanvas
	self useSelectionBar
		ifTrue: [self paragraph displaySelectionBarOn: aCanvas].
	self useExtraSelection 
		ifTrue: [self paragraph displayExtraSelectionOn: aCanvas].
	super drawOn: aCanvas.
! !

!TextMorphForEditView methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/15/2015 12:08'!
drawOnAthensCanvas: anAthensCanvas
	self useSelectionBar
		ifTrue: [self paragraph displaySelectionBarOnAthensCanvas: anAthensCanvas].
	self useExtraSelection 
		ifTrue: [self paragraph displayExtraSelectionOnAthensCanvas: anAthensCanvas].
	super drawOnAthensCanvas: anAthensCanvas.
! !

!TextMorphForEditView methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 2/21/2011 17:25'!
acceptOnFocusChange: anObject
	"Set the value of acceptOnFocusChange"

	acceptOnFocusChange := anObject! !

!TextMorphForEditView methodsFor: 'event handling' stamp: 'AlainPlantec 11/8/2010 22:14'!
autoScrollView: evt
	"This is kind of a hack because the PluggableTextMorph expects me to first expand the selection before auto scrolling will work."
	| localEvt |
	localEvt := evt transformedBy: (self transformedFrom: editView).
	super mouseMove: localEvt.
	editView scrollSelectionIntoView: localEvt.! !

!TextMorphForEditView methodsFor: 'find-replace' stamp: 'AlainPlantec 11/10/2010 21:30'!
replaceAll: aRegex with: aText
	self
		handleEdit: [self editor replaceAll: aRegex with: aText].
! !

!TextMorphForEditView methodsFor: 'accessing' stamp: 'AlainPlantec 2/21/2011 17:23'!
paragraph
	"Answer the paragraph."

	^ super paragraph selectionColor: self selectionColor; yourself
! !

!TextMorphForEditView methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 5/16/2013 13:04'!
handlesDoubleClick

	^ self editView handlesDoubleClick! !

!TextMorphForEditView methodsFor: 'accessing' stamp: 'AlainPlantec 2/21/2011 17:23'!
selectionColor: aColor
	selectionColor := aColor.
	paragraph ifNotNil: [:p | p selectionColor: aColor]! !

!TextMorphForEditView methodsFor: 'editing' stamp: 'AlainPlantec 11/8/2010 22:14'!
acceptOnCR
	"Answer whether the receiver wants to accept when the Return key is hit"
	"This test is to make sure that existing instances that may be changed and get their acceptOnCR 
	do not blow up on our face. Now this test could be removed"

	^ acceptOnCR == true! !

!TextMorphForEditView methodsFor: 'private' stamp: 'AlainPlantec 11/12/2010 22:34'!
useFindReplaceSelection
	^ TextEditor useFindReplaceSelection! !

!TextMorphForEditView methodsFor: 'private' stamp: 'AlainPlantec 11/8/2010 22:14'!
updateFromParagraph  
	super updateFromParagraph.
	editView setScrollDeltas.! !

!TextMorphForEditView methodsFor: 'find-replace' stamp: 'AlainPlantec 1/9/2011 18:53'!
findReplaceDialog
	^ EditorFindReplaceDialogWindow singleton! !

!TextMorphForEditView methodsFor: 'changed' stamp: 'CamilloBruni 10/10/2012 13:37'!
keyboardFocusChange: gotFocus 
	self announceKeyboardFocusChange: gotFocus.
 	paragraph 
		ifNotNil: [paragraph focused: gotFocus].
 	gotFocus 
 		ifTrue: [
			"A hand is wanting to send us characters..."
 			self hasFocus 
				ifFalse: [self editor "Forces editor install"].
			self editor focused: true.
			self showOverEditableTextCursor.
			self useFindReplaceSelection
				ifTrue: [self selectionChanged]] 
		ifFalse:[editor ifNotNil: [editor focused: false].
			self hideOverEditableTextCursor].
	self manageCursor.		
 	self editView
		ifNil: [self focusChanged]
		ifNotNil: [self editView focusChanged].
	self acceptOnFocusChange == true
		ifTrue: [self editView hasUnacceptedEdits ifTrue: [self editor accept]]! !

!TextMorphForEditView methodsFor: 'miscellaneous' stamp: 'AlainPlantec 11/8/2010 22:14'!
selectAll
	"Tell my editor to select all the text"

	self editor selectAll! !

!TextMorphForEditView methodsFor: 'editing' stamp: 'AlainPlantec 11/8/2010 22:14'!
hasUnacceptedEdits: aBoolean
	"Set the hasUnacceptedEdits flag in my view."

	editView hasUnacceptedEdits: aBoolean! !

!TextMorphForEditView methodsFor: 'find-replace' stamp: 'AlainPlantec 11/13/2010 14:10'!
findNextString: aSubString startingAt: searchIdx
	| where |
	self
		handleEdit: [where := self editor findNextString: aSubString startingAt: searchIdx].
	^ where
! !

!TextMorphForEditView methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 2/21/2011 17:25'!
acceptOnFocusChange
	"Answer the value of acceptOnFocusChange"

	^ acceptOnFocusChange! !

!TextMorphForEditView methodsFor: 'find-replace' stamp: 'AlainPlantec 1/9/2011 18:53'!
sharesFindReplace
	^ true! !

!TextMorphForEditView methodsFor: 'editing' stamp: 'AlainPlantec 11/8/2010 22:14'!
handleInteraction: interActionBlock
	"Overridden to pass along a model to the editor for, eg, link resolution, doits, etc"

	self editor model: editView model.  "For evaluateSelection, etc"
	^ super handleInteraction: interActionBlock! !

!TextMorphForEditView methodsFor: 'event handling' stamp: 'GuillermoPolito 6/25/2012 20:38'!
mouseUp: event
	super mouseUp: event.
	
	self stopSteppingSelector: #autoScrollView:.
	"editView scrollSelectionIntoView: evt."
	editView selectionInterval: editor selectionInterval.! !

!TextMorphForEditView methodsFor: 'editing' stamp: 'AlainPlantec 11/8/2010 22:14'!
cancelEdits
	"The message is sent when the user hits enter or Cmd-L.
	Cancel the current contents and end editing."
	self releaseParagraph.
	editView cancel! !

!TextMorphForEditView methodsFor: 'private' stamp: 'AlainPlantec 11/11/2010 22:09'!
findRegex
	^ self editor findRegex! !

!TextMorphForEditView methodsFor: 'private' stamp: 'ThierryGoubier 12/20/2012 22:27'!
refreshExtraSelection
	| fullRefreshNeeded |
	fullRefreshNeeded := self useSelectionBar.
	self useFindReplaceSelection
		ifTrue: [ 
			fullRefreshNeeded := true.
			self findText isEmpty
				ifTrue: [ self paragraph findReplaceSelectionRegex: nil ]
				ifFalse: [ self paragraph findReplaceSelectionRegex: self findRegex ] ].
	self useSecondarySelection
		ifTrue: [ 
			fullRefreshNeeded := true.
			(self paragraph secondarySelection isNil and: [ self selection isEmptyOrNil not ])
				ifTrue: [ self paragraph secondarySelection: (self text asString allRangesOfSubString: self selection asString) ] ].
	fullRefreshNeeded
		ifTrue: [ 
			self paragraph extraSelectionChanged.
			"> Alain: should be that : 
			 > self paragraph extraSelectionRects do: [:r | self invalidRect: r]
			 > but it doesn't work"
			self invalidRect: self bounds ]! !

!TextMorphForEditView methodsFor: 'accessing' stamp: 'AlainPlantec 2/21/2011 17:18'!
selectionColor
	^ selectionColor! !

!TextMorphForEditView methodsFor: 'macpal' stamp: 'AlainPlantec 11/8/2010 22:14'!
flash
	^ editView flash! !

!TextMorphForEditView methodsFor: 'edit view' stamp: 'AlainPlantec 11/8/2010 22:14'!
setEditView: editPane
	editView := editPane! !

!TextMorphForEditView methodsFor: 'event handling' stamp: 'AlainPlantec 11/8/2010 22:14'!
preferredKeyboardPosition

	| pos |
	pos := super preferredKeyboardPosition.
	^ pos + (self bounds: self bounds in: World) topLeft.
! !

!TextMorphForEditView methodsFor: 'accept/cancel' stamp: 'AlainPlantec 11/8/2010 22:14'!
acceptOnCR: trueOrFalse
	acceptOnCR := trueOrFalse! !

!TextMorphForEditView methodsFor: 'event handling' stamp: 'AlainPlantec 11/8/2010 22:14'!
mouseMove: evt
	| editEvt |
	super mouseMove: evt.
	evt redButtonPressed ifFalse: [^ self].
	editEvt := evt transformedBy: (self transformedFrom: editView) inverseTransformation.
	(editEvt position y between: editView top and: editView bottom) ifFalse:[
		"Start auto-scrolling"
		self startStepping: #autoScrollView:
			at: Time millisecondClockValue
			arguments: (Array with: editEvt)
			stepTime: 100. "fast enough"
	] ifTrue:[
		self stopSteppingSelector: #autoScrollView:.
	].! !

!TextMorphForEditView methodsFor: 'dragging' stamp: 'BenjaminVanRyseghem 5/16/2013 14:23'!
startDrag: event

	self editView startDrag: event! !

!TextMorphForEditView methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 4/27/2011 14:29'!
doAutoAccept: evt
	"Do the key stroke and check to see if it should be accepted."

	self autoAccept == true 
		ifTrue: [self editView hasUnacceptedEdits 
			ifTrue: [self editor accept]]! !

!TextMorphForEditView methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 2/21/2011 17:25'!
autoAccept: anObject
	"Set the value of autoAccept"

	autoAccept := anObject! !

!TextMorphForEditView methodsFor: 'edit view' stamp: 'AlainPlantec 11/8/2010 22:14'!
editView
	^ editView! !

!TextMorphForEditView methodsFor: 'editing' stamp: 'AlainPlantec 11/8/2010 22:14'!
acceptContents
	"The message is sent when the user hits enter or Cmd-S.
	Accept the current contents and end editing."
	self updateFromParagraph.
	editView accept.! !

!TextMorphForEditView methodsFor: 'blinking' stamp: 'FernandoOlivero 3/25/2011 11:27'!
startBlinking
	self canChangeText 
		ifTrue: [super startBlinking]
		ifFalse: [self paragraph showCaret: true]! !

!TextMorphForEditView methodsFor: 'drawing' stamp: 'AlainPlantec 11/8/2010 22:14'!
drawNullTextOn: aCanvas
	"Just run the normal code to show selection in a window"
	aCanvas paragraph: self paragraph bounds: bounds color: color
! !

!TextMorphForEditView methodsFor: 'find-replace' stamp: 'AlainPlantec 11/11/2010 23:44'!
replaceAll: aRegex with: aText startingAt: startIdx
	self
		handleEdit: [self editor replaceAll: aRegex with: aText startingAt: startIdx].
! !

!TextMorphForEditView methodsFor: 'private' stamp: 'AlainPlantec 11/17/2010 15:26'!
useSelectionBar
	^ TextEditor useSelectionBar! !

!TextMorphForEditView methodsFor: 'event handling' stamp: 'GabrielOmarCotelli 11/30/2013 17:06'!
mouseDown: event
	self editView ifNotNil: [ self editView mouseDownFromTextMorph: event ].
	super mouseDown: event.
	self flag: #hack.
	(self editView respondsTo: #highlights)
		ifTrue: [ 
			self editView highlights
				detect: [ :h | h containsPoint: event position in: (self bounds: self editView innerBounds from: self) ]
				ifFound: [ :hl | hl clicked: event ] ]! !

!TextMorphForEditView methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 5/16/2013 14:16'!
doubleClickOnSelectedText: event
	"Unselect everything. This message is sent by the editor"
	
	self deselect! !

!TextMorphForEditView methodsFor: 'event handling' stamp: 'BenjaminVanRyseghem 5/16/2013 13:04'!
dragEnabled

	^ self editView dragEnabled! !

!TextMorphForEditView methodsFor: 'private' stamp: 'BenjaminVanRyseghem 7/22/2013 14:19'!
selectionChanged
	self sharesFindReplace 
		ifTrue: [self editor findReplaceService changed: #findReplaceSelection].
	self useExtraSelection
		ifTrue: [self refreshExtraSelection].
	super selectionChanged! !

!TextMorphForEditView methodsFor: 'find-replace' stamp: 'AlainPlantec 1/9/2011 18:53'!
openFindDialog
	self sharesFindReplace 
		ifTrue: [ (self findReplaceDialog on: self) open]
		ifFalse: [self flash]! !

!TextMorphForEditView methodsFor: 'private' stamp: 'AlainPlantec 11/16/2010 12:03'!
useExtraSelection
	^ self useFindReplaceSelection or: [self useSecondarySelection]
! !

!TextMorphForEditorView commentStamp: 'GaryChambers 4/24/2012 14:20'!
Used by PluggableTextEditorMorph to specify a plain TextEditor for the editor
!
!TextMorphForEditorView methodsFor: 'private' stamp: 'GaryChambers 12/21/2011 11:18'!
editorClass
	^ TextEditor! !

!TextMorphForFieldView commentStamp: 'gvc 5/18/2007 12:28'!
Single-line text field editor with DialogWindow key integration (return for default, escape for cancel) and keyboard focus navigation (tab/shift-tab).!
!TextMorphForFieldView methodsFor: 'accessing' stamp: 'gvc 10/17/2008 12:35'!
minExtent
	"Overridden to allow text to shrink to minimum extent rather than being (incorrectly)
	treated as rigid. Should be the same for other morphs too. Bah!!"

	| layout minExtent extra hFit vFit |
	hFit := self hResizing.
	vFit := self vResizing.
	(hFit == #spaceFill or: [vFit == #spaceFill]) 
		ifFalse: 
			["The receiver will not adjust to parents layout by growing or shrinking,
		which means that an accurate layout defines the minimum size."

			^self fullBounds extent].
	layout := self layoutPolicy.
	minExtent := layout isNil 
		ifTrue: [0 @ 0]
		ifFalse: [layout minExtentOf: self in: self layoutBounds].
	minExtent := hFit == #rigid 
		ifTrue: [self fullBounds extent x @ minExtent y]
		ifFalse: 
			[extra := self bounds width - self layoutBounds width.
			(minExtent x + extra) @ minExtent y].
	minExtent := vFit == #rigid 
				ifTrue: [minExtent x @ self fullBounds extent y]
				ifFalse: 
					[extra := self bounds height - self layoutBounds height.
					minExtent x @ (minExtent y + extra)].
	minExtent := minExtent max: self minWidth @ self minHeight.
	^minExtent! !

!TextMorphForFieldView methodsFor: 'find-replace' stamp: 'AlainPlantec 11/11/2010 21:44'!
sharesFindReplace
	^ false! !

!TextMorphForFieldView methodsFor: 'event handling' stamp: 'AlainPlantec 4/27/2011 15:35'!
keyStroke: evt
	"Don't allow editing keys if the edit view is disabled.
	Do the key if max length has not been reached.
	Don't allow tabs." 
	(self localHandleKeystroke: evt) ifTrue: [^self].
	(self maxLength isNil or: [self text size < self maxLength or: [
			self editor selectionInterval size > 0 or: [self isEditEvent: evt]]])
		ifTrue: [self doAutoAccept: evt].
	super keyStroke: evt! !

!TextMorphForFieldView methodsFor: 'private' stamp: 'AlainPlantec 9/15/2011 17:27'!
paragraph
	"Paragraph instantiation is lazy -- create it only when needed.
	Don't adjust rightX (as in TexMorph>>paragraph)
	since wrapFlag must be false for layout to work."
	
	paragraph ifNotNil: [^ paragraph].

self setProperty: #CreatingParagraph toValue: true.

	self setDefaultContentsIfNil.

	"...Code here to recreate the paragraph..."
	paragraph := (Paragraph new textOwner: self owner).
	paragraph wantsColumnBreaks: successor notNil.
	paragraph
		compose: text
		style: textStyle copy
		from: self startingIndex
		in: self container.
	"don't adjust the right, let it scroll!!"
	paragraph focused: (self currentHand keyboardFocus == self).
	self fit.
self removeProperty: #CreatingParagraph.

	self selectionColor: self selectionColor.
	^ paragraph! !

!TextMorphForFieldView methodsFor: 'private' stamp: 'AlainPlantec 11/22/2010 12:03'!
editorClass
	^ TextEditor! !

!TextMorphForFieldView methodsFor: 'accessing' stamp: 'gvc 9/18/2006 14:58'!
maxLength
	"Answer the value of maxLength"

	^ maxLength! !

!TextMorphForFieldView methodsFor: 'private' stamp: 'AlainPlantec 11/12/2010 22:36'!
useFindReplaceSelection
	^ false! !

!TextMorphForFieldView methodsFor: 'geometry' stamp: 'BenjaminVanRyseghem 2/4/2012 12:34'!
minimumExtent
	"Use the actual paragraph line to take font changes into account."
	
	| minExt |
	textStyle ifNil: [^ 9@16].
	borderWidth ifNil: [^ 9@16].
	minExt := (9@(self paragraph lines first lineHeight ceiling)) + (borderWidth*2).
	^ ((0@0 extent: minExt) expandBy: margins) extent! !

!TextMorphForFieldView methodsFor: 'changed' stamp: 'CamilloBruni 10/10/2012 13:38'!
keyboardFocusChange: aBoolean 
	"If we are losing focus and have acceptOnFocusChange then accept."
	aBoolean
		ifTrue: [self editView selectAll]
		ifFalse: [self editView selectFrom: 1 to: 0].
	super keyboardFocusChange: aBoolean! !

!TextMorphForFieldView methodsFor: 'testing' stamp: 'GaryChambers 8/17/2010 16:38'!
isEditEvent: anEvent
	"Answer whether the given event is a key stroke that
	should be allowed despite the max length."

	|key|
	key := anEvent keyValue asCharacter.
	^key == Character cr or: [
		key == Character escape or: [
		key == Character backspace or: [
		key == Character delete or: [
		key == Character arrowLeft or: [
		key == Character arrowRight or: [
		key == Character home or: [
		key == Character end or: [
			anEvent commandKeyPressed and: [key = $a]]]]]]]]]! !

!TextMorphForFieldView methodsFor: 'layout' stamp: 'gvc 6/4/2007 11:22'!
minHeight
	"Answer the height of one line."

	^self minimumExtent y max: super minHeight! !

!TextMorphForFieldView methodsFor: 'private' stamp: 'AlainPlantec 11/12/2010 21:12'!
useSecondarySelection
	^ false! !

!TextMorphForFieldView methodsFor: 'private' stamp: 'AlainPlantec 11/17/2010 15:26'!
useSelectionBar
	^ false! !

!TextMorphForFieldView methodsFor: 'accessing' stamp: 'gvc 9/18/2006 14:58'!
maxLength: anObject
	"Set the value of maxLength"

	maxLength := anObject! !

!TextMorphForFieldView methodsFor: 'layout' stamp: 'gvc 6/4/2007 11:22'!
minWidth
	"Answer the minimum width."

	^self minimumExtent x max: super minWidth! !

!TextMorphForFieldView methodsFor: 'event handling' stamp: 'gvc 1/4/2007 16:05'!
mouseMove: evt
	"Allow auto scroll in any direction.
	Something else is preventing the left/right case."
	
	| editEvt |
	self perform: #mouseMove: withArguments: {evt} inSuperclass: TextMorph.
	evt redButtonPressed ifFalse: [^ self].
	editEvt := evt transformedBy: (self transformedFrom: editView) inverseTransformation.
	(editView bounds containsPoint: editEvt position) ifFalse:[
		"Start auto-scrolling"
		self startStepping: #autoScrollView:
			at: Time millisecondClockValue
			arguments: (Array with: editEvt)
			stepTime: 100. "fast enough"
	] ifTrue:[
		self stopSteppingSelector: #autoScrollView:.
	].! !

!TextMorphForFieldView methodsFor: 'events' stamp: 'AlainPlantec 11/28/2010 22:50'!
localHandleKeystroke: evt
	"Answer whether we locally handle the keyStroke event.
	Disregard tabs for now."
	
	(self editView keystrokeFromTextMorph: evt)
		ifTrue: [^ true].
	(self autoAccept and: [evt keyCharacter = Character cr and: [self crAction notNil]])
		 ifTrue: [(self crAction isKindOf: MessageSend)
				ifTrue: [ self crAction value]
				ifFalse: [self crAction value: self text]..
			^ true].
	evt keyCharacter = Character tab ifTrue: [
		evt shiftPressed
			ifTrue: [(self editView respondsTo: #navigateFocusBackward)
						ifTrue: [self editView navigateFocusBackward]]
			ifFalse: [(self editView respondsTo: #navigateFocusForward)
						ifTrue: [self editView navigateFocusForward]].
		^true].
	^false! !

!TextMorphTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testInitialize
	"For now, just make sure initialization doesn't throw exception"

	TextMorph initialize! !

!TextPrintIt commentStamp: 'TorstenBergmann 1/31/2014 12:16'!
A "Print It" action on a text. When the text is clicked the text is seen as source code and evaluated. After that the result is printed!
!TextPrintIt methodsFor: 'styling' stamp: 'ar 9/22/2001 16:28'!
writeScanOn: strm

	strm nextPut: $P; nextPutAll: evalString; nextPutAll: ';;'! !

!TextPrintIt methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 12/7/2013 23:51'!
actOnClick: anEvent for: anObject in: paragraph editor: editor

	| result |
	result := Smalltalk compiler evaluate: evalString for: anObject logged: false.
	UIManager inform: result printString.
	^ true ! !

!TextSelectionColor commentStamp: 'AlainPlantec 2/15/2011 21:42'!
I represent a text selection attribute that can be added to a text for a text emphazing (text color). I have a color block (colorBlock) which is evaluated in order to get the text color. 
I have three instances, one for the primary selection and the two others for the secondary selection and the find replace selection. 
PrimarySelection is used in TextEditor>>#storeSelectionInParagraph in order to emphasize the selection text if the selection text color setting is not nil.
SecondarySelection and FindReplaceSelection are manage by MultiNewParagraph if secondary selection text and find replace selection text colors are not nil.

Instance Variables
	colorBlock:		<Block>

colorBlock
	- The block which is evaluated in order to get the text color
!
!TextSelectionColor methodsFor: 'accessing' stamp: 'AlainPlantec 2/11/2011 21:24'!
textColor
	^ self colorBlock value! !

!TextSelectionColor methodsFor: 'accessing' stamp: 'AlainPlantec 2/11/2011 21:22'!
colorBlock: aBlock
	"aBlock value gives the text color"
	colorBlock := aBlock! !

!TextSelectionColor methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 2/10/2011 10:34'!
dominates: other
	"There can be only one..."
	^self class == other class! !

!TextSelectionColor methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
theme
	^ Smalltalk ui theme! !

!TextSelectionColor methodsFor: 'accessing' stamp: 'FernandoOlivero 4/12/2011 10:46'!
colorBlock

	^ colorBlock ifNil: [colorBlock := [self theme currentSettings selectionTextColor]]! !

!TextSelectionColor methodsFor: 'as yet unclassified' stamp: 'AlainPlantec 2/11/2011 13:34'!
emphasizeScanner: scanner 
	"Set the emphasis for text display"
	scanner textColor: self textColor! !

!TextSelectionColor class methodsFor: 'default accessing' stamp: 'FernandoOlivero 4/12/2011 10:47'!
primarySelection
	^ PrimarySelection
		ifNil: [PrimarySelection := self new colorBlock: [ self theme currentSettings selectionTextColor]]! !

!TextSelectionColor class methodsFor: 'default accessing' stamp: 'FernandoOlivero 4/12/2011 10:46'!
findReplaceSelection
	^ FindReplaceSelection
		ifNil: [FindReplaceSelection := self new
						colorBlock: [self theme currentSettings findReplaceSelectionTextColor]]! !

!TextSelectionColor class methodsFor: 'default accessing' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
theme
	^ Smalltalk ui theme! !

!TextSelectionColor class methodsFor: 'default accessing' stamp: 'FernandoOlivero 4/12/2011 10:47'!
secondarySelection
	^ SecondarySelection
		ifNil: [SecondarySelection := self new
						colorBlock: [self theme currentSettings secondarySelectionTextColor]] ! !

!TextSelectionColor class methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 10/11/2013 11:04'!
cleanUp
	PrimarySelection := nil.! !

!TextStream commentStamp: '<historical>'!
I'm a Stream of Text objects. 

ex:

	|ts|
	ts := TextStream on: (Text new: 50).
 	ts nextPutAll: 'I ' asText.
	ts nextPutAll: 'love' asText allBold.
 	ts nextPutAll: ' Pharo'.
	TextMorph new 
		newContents: ts contents;
 		openInWindowLabeled: 'TextStream test'!
!TextStream methodsFor: 'private' stamp: 'djp 11/6/1999 20:30'!
withAttributes: attributes do: streamBlock 
	| pos1 val |
	pos1 := self position.
	val := streamBlock value.
	attributes do: [:attribute |
		collection
			addAttribute: attribute
			from: pos1 + 1
			to: self position].
	^ val! !

!TextStream methodsFor: 'as yet unclassified' stamp: ''!
applyAttribute: att beginningAt: startPos
	collection addAttribute: att from: startPos to: self position! !

!TextStream methodsFor: 'private' stamp: ''!
withAttribute: att do: strmBlock
	| pos1 val |
	pos1 := self position.
	val := strmBlock value.
	collection addAttribute: att from: pos1+1 to: self position.
	^ val! !

!TextStream methodsFor: 'accessing' stamp: 'LukasRenggli 5/8/2010 18:44'!
nextPutAll: aCollection 
 	"Optimized access to get around Text at:Put: overhead"
 	| n |
 	n := aCollection size.
      position + n > writeLimit
        ifTrue:
         [self growTo: position + n + 10].
 	collection 
 		replaceFrom: position+1
 		to: position + n
 		with: aCollection
 		startingAt: 1.
 	position := position + n.
	^ aCollection! !

!TextStyle commentStamp: '<historical>'!
A textStyle comprises the formatting information for composing and displaying a unit (usually a paragraph) of text.  Typically one makes a copy of a master textStyle (such as TextStyle default), and then that copy may get altered in the process of editing.  Bad things can happen if you do not copy first.

Each of my instances consists of...
	fontArray		An array of StrikeFonts
	fontFamilySize	unused
	lineGrid			An integer; default line spacing for paragraphs
	baseline			An integer; default baseline (dist from line top to bottom of an 'a')
	alignment		An integer; text alignment, see TextStyle alignment:
	firstIndent		An integer; indent of first line in pixels
	restIndent		An integer; indent of remaining lines in pixels
	rightIndent		An integer; indent of right margin rel to section
	tabsArray		An array of integers giving tab offsets in pixels
	marginTabsArray	An array of margin tabs
	leading			An integer giving default vertical line separation

For a concrete example, look at TextStyle default copy inspect!
!TextStyle methodsFor: 'private' stamp: 'lr 7/4/2009 10:42'!
consolidate
	"If this style includes any fonts that are also in the default style,
	then replace them with references to the default ones."
	"
	TextStyle allInstancesDo: [:s | s == TextStyle default ifFalse: [s consolidate]]
"
	| defFonts font |
	defFonts := TextStyle default fontArray.
	1 
		to: fontArray size
		do: 
			[ :i | 
			font := fontArray at: i.
			1 
				to: defFonts size
				do: 
					[ :j | 
					(font name asUppercase copyWithout: $ ) = ((defFonts at: j) name asUppercase copyWithout: $ ) ifTrue: 
						[ fontArray 
							at: i
							put: (defFonts at: j) ] ] ]! !

!TextStyle methodsFor: '*rubric' stamp: 'AlainPlantec 5/18/2013 23:04'!
rubTabWidth
	 ^ tabsArray first! !

!TextStyle methodsFor: 'accessing' stamp: 'ar 9/21/2000 11:53'!
fontNamesWithPointSizes
	^ fontArray collect:
		[:x | x fontNameWithPointSize]

  "TextStyle default fontNamesWithPointSizes"! !

!TextStyle methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
rightFlush
	alignment := 1! !

!TextStyle methodsFor: 'tabs and margins' stamp: ''!
clearIndents
	"Reset all the margin (index) settings to be 0."

	self firstIndent: 0.
	self restIndent: 0.
	self rightIndent: 0! !

!TextStyle methodsFor: 'fonts and font indexes' stamp: 'di 10/11/97 09:33'!
fontOfSize: aHeight
	"See fontIndexOfSize.
	Returns the actual font.  Leading not considered."

	^ fontArray at: (self fontIndexOfSize: aHeight)! !

!TextStyle methodsFor: 'fonts and font indexes' stamp: 'nk 6/12/2004 16:33'!
fontOfPointSize: aPointSize
	^ fontArray at: (self fontIndexOfPointSize: aPointSize)! !

!TextStyle methodsFor: 'accessing' stamp: ''!
baseline
	"Answer the distance from the top of the line to the bottom of most of the 
	characters (by convention, bottom of the letter 'A')."

	^baseline! !

!TextStyle methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
firstIndent: anInteger 
	"Set the horizontal indenting of the first line of a paragraph in the style 
	of the receiver to be the argument, anInteger."
	firstIndent := anInteger! !

!TextStyle methodsFor: 'default font' stamp: 'lr 7/4/2009 10:42'!
defaultFontIndex: anIndex 
	defaultFontIndex := anIndex! !

!TextStyle methodsFor: 'accessing' stamp: 'ar 9/21/2000 15:16'!
alignmentSymbol
	"Answer the symbol for the current setting of the alignment."
	alignment = LeftFlush ifTrue:[^#leftFlush].
	alignment = Centered ifTrue:[^#centered].
	alignment = RightFlush ifTrue:[^#rightFlush].
	alignment = Justified ifTrue:[^#justified].
	^#leftFlush! !

!TextStyle methodsFor: 'fonts and font indexes' stamp: 'sw 12/6/1999 13:54'!
fontIndexOf: aFont
	^ fontArray indexOf: aFont ifAbsent: [nil]! !

!TextStyle methodsFor: 'fonts and font indexes' stamp: 'MarcusDenker 7/7/2012 22:16'!
addNewFontSize: pointSize
	"Add a font in specified size to the array of fonts."
	| f d newArray t  |
	fontArray first emphasis ~= 0 ifTrue: [
		t := TextSharedInformation at: self fontArray first familyName asSymbol.
		t fonts first emphasis = 0 ifTrue: [
			^ t addNewFontSize: pointSize.
		].
	].

	pointSize <= 0 ifTrue: [^ nil].
	fontArray do: [:s |
		s pointSize = pointSize ifTrue: [^ s].
	].
	f := fontArray first class new initialize: fontArray first.
	f pointSize: pointSize.
	fontArray first derivativeFonts do: [:proto |
			proto ifNotNil: [
				d := proto class new initialize: proto.
				d pointSize: f pointSize.
				f derivativeFont: d mainFont: proto.
			].
	].
	newArray := ((fontArray copyWith: f) asSortedCollection: [:a :b | a pointSize <= b pointSize]) asArray.
	self newFontArray: newArray.
	^ self fontOfPointSize: pointSize
! !

!TextStyle methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
baseline: anInteger 
	"Set the distance from the top of the line to the bottom of most of the 
	characters."
	baseline := anInteger! !

!TextStyle methodsFor: 'accessing' stamp: 'sw 12/6/1999 12:31'!
defaultFont
	^ fontArray at: self defaultFontIndex! !

!TextStyle methodsFor: 'fonts and font indexes' stamp: 'lr 7/4/2009 10:42'!
fontIndexOfSize: desiredHeight 
	"Returns an index in fontArray of the font with height <= desiredHeight"
	"Leading is not inluded in the comparison"
	| bestMatch bestIndex d |
	bestMatch := 9999.
	bestIndex := 1.
	1 
		to: fontArray size
		do: 
			[ :i | 
			d := desiredHeight - (fontArray at: i) height.
			d = 0 ifTrue: [ ^ i ].
			(d > 0 and: [ d < bestMatch ]) ifTrue: 
				[ bestIndex := i.
				bestMatch := d ] ].
	^ bestIndex! !

!TextStyle methodsFor: 'private' stamp: 'CamilloBruni 8/1/2012 16:06'!
fontAt: index put: font 
	"Automatically grow the array."
	index > fontArray size ifTrue: [ fontArray := fontArray , (Array new: index - fontArray size) ].
	fontArray 
		at: index
		put: font! !

!TextStyle methodsFor: 'accessing' stamp: ''!
restIndent
	"Answer the indent for all but the first line of a paragraph in the style 
	of the receiver."

	^restIndent! !

!TextStyle methodsFor: 'private' stamp: 'lr 7/4/2009 10:42'!
newFontArray: anArray 
	"Currently there is no supporting protocol for changing these arrays. If an editor wishes to implement margin setting, then a copy of the default should be stored with these instance variables.  
	, Make size depend on first font."
	fontArray := anArray.
	lineGrid := (fontArray at: 1) height + leading.	"For whole family"
	baseline := (fontArray at: 1) ascent + leading.
	alignment := 0.
	firstIndent := 0.
	restIndent := 0.
	rightIndent := 0.
	tabsArray := DefaultTabsArray.
	marginTabsArray := DefaultMarginTabsArray
	"
TextStyle allInstancesDo: [:ts | ts newFontArray: TextStyle default fontArray].
"! !

!TextStyle methodsFor: 'accessing' stamp: ''!
fontNamed: fontName  "TextStyle default fontNamed: 'TimesRoman10'"
	^ fontArray detect: [:x | x name sameAs: fontName]! !

!TextStyle methodsFor: 'accessing' stamp: ''!
alignment
	"Answer the code for the current setting of the alignment."

	^alignment! !

!TextStyle methodsFor: 'accessing' stamp: ''!
leading
	"Leading (from typographers historical use of extra lead (type metal))
	is the extra spacing above and beyond that needed just to accomodate
	the various font heights in the set."
	^ leading! !

!TextStyle methodsFor: 'accessing' stamp: 'tk 6/26/1998 15:03'!
fontNamesAndSizes  "TextStyle default fontNames"
	^ fontArray collect: [:x | x name, ' ', x height printString]! !

!TextStyle methodsFor: 'private' stamp: 'di 3/20/1999 22:31'!
fontAt: index 
	"This is private because no object outside TextStyle should depend on the 
	representation of the font family in fontArray."

	^ fontArray atPin: index! !

!TextStyle methodsFor: '*rubric' stamp: 'AlainPlantec 5/18/2013 23:03'!
privateTabsArray: anArray
	"DefaultTab := anArray first.
	DefaultTabsArray := anArray."
	tabsArray := anArray.
	marginTabsArray := tabsArray collect: [ :t | Array with: t with: t ]
! !

!TextStyle methodsFor: 'tabs and margins' stamp: 'lr 7/4/2009 10:42'!
nextTabXFrom: anX leftMargin: leftMargin rightMargin: rightMargin 
	"Tab stops are distances from the left margin. Set the distance into the 
	argument, anX, normalized for the paragraph's left margin."
	| normalizedX tabX |
	normalizedX := anX - leftMargin.
	1 
		to: tabsArray size
		do: 
			[ :i | 
			(tabX := tabsArray at: i) > normalizedX ifTrue: [ ^ leftMargin + tabX min: rightMargin ] ].
	^ rightMargin! !

!TextStyle methodsFor: 'tabs and margins' stamp: ''!
rightMarginTabAt: marginIndex 
	"Set the 'nesting' level of right margin indents of the paragraph in the 
	style of the receiver to be marginIndex."

	(marginIndex > 0 and: [marginIndex < marginTabsArray size])
		ifTrue: [^(marginTabsArray at: marginIndex) at: 2]
		ifFalse: [^0]
	"The marginTabsArray is an Array of tuples.  The Array is indexed according 
	to the marginIndex, the 'nesting' level of the requestor."
! !

!TextStyle methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
alignment: anInteger 
	"Set the current setting of the alignment to be anInteger:
	0=left flush, 1=right flush, 2=centered, 3=justified."
	alignment := anInteger \\ (Justified + 1)! !

!TextStyle methodsFor: 'private' stamp: ''!
marginTabAt: marginIndex side: sideIndex 
	"The marginTabsArray is an Array of tuples.  The Array is indexed
	according to the marginIndex, the 'nesting' level of the requestor.
	sideIndex is 1 for left, 2 for right."

	(marginIndex > 0 and: [marginIndex < marginTabsArray size])
		ifTrue: [^(marginTabsArray at: marginIndex) at: sideIndex]
		ifFalse: [^0]! !

!TextStyle methodsFor: 'default font' stamp: 'lr 7/4/2009 10:42'!
defaultFontIndex
	^ defaultFontIndex ifNil: [ defaultFontIndex := 1 ]! !

!TextStyle methodsFor: 'private' stamp: 'lr 7/4/2009 10:42'!
gridForFont: fontIndex withLead: leadInteger 
	"Force whole style to suit one of its fonts. Assumes only one font referred
	to by runs."
	| font |
	font := self fontAt: fontIndex.
	self lineGrid: font height + leadInteger.
	self baseline: font ascent.
	self leading: leadInteger! !

!TextStyle methodsFor: 'accessing' stamp: ''!
rightIndent
	"Answer the right margin indent for the lines of a paragraph in the style 
	of the receiver."

	^rightIndent! !

!TextStyle methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
leading: yDelta 
	leading := yDelta! !

!TextStyle methodsFor: 'fonts and font indexes' stamp: 'lr 7/4/2009 10:42'!
consistOnlyOf: aFont 
	fontArray := Array with: aFont.
	defaultFontIndex := 1! !

!TextStyle methodsFor: 'accessing' stamp: 'ar 12/16/2001 16:43'!
pointSizes
	^ fontArray collect:
		[:x | x pointSize]

  "TextStyle default fontNamesWithPointSizes"! !

!TextStyle methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
rightIndent: anInteger 
	"Answer the right margin indent for the lines of a paragraph in the style 
	of the receiver to be the argument, anInteger."
	rightIndent := anInteger! !

!TextStyle methodsFor: 'private' stamp: 'CamilloBruni 8/1/2012 16:06'!
fontArray
	"Only for writing out fonts, etc."
	^ fontArray! !

!TextStyle methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
leftFlush
	alignment := 0! !

!TextStyle methodsFor: 'fonts and font indexes' stamp: 'lr 7/4/2009 10:42'!
fontIndexOfPointSize: desiredPointSize 
	"Returns an index in fontArray of the font with pointSize <= desiredPointSize"
	"Leading is not inluded in the comparison"
	| bestMatch bestIndex d |
	bestMatch := 9999.
	bestIndex := 1.
	1 
		to: fontArray size
		do: 
			[ :i | 
			d := desiredPointSize - (fontArray at: i) pointSize.
			d = 0 ifTrue: [ ^ i ].
			(d > 0 and: [ d < bestMatch ]) ifTrue: 
				[ bestIndex := i.
				bestMatch := d ] ].
	^ bestIndex! !

!TextStyle methodsFor: 'tabs and margins' stamp: ''!
tabWidth
	"Answer the width of a tab."

	^DefaultTab! !

!TextStyle methodsFor: 'printing' stamp: 'MarcusDenker 7/9/2012 21:44'!
printOn: aStream

	super printOn: aStream.
	fontArray first isFontSet ifTrue: [
		aStream space; nextPutAll: self defaultFont familySizeFace first; nextPutAll: '(FontSet)'
	] ifFalse: [
		aStream space; nextPutAll: self defaultFont familySizeFace first
	]
! !

!TextStyle methodsFor: 'accessing' stamp: ''!
lineGrid
	"Answer the relative space between lines of a paragraph in the style of 
	the receiver."

	^lineGrid! !

!TextStyle methodsFor: 'copying' stamp: 'pmm 3/13/2010 11:33'!
veryDeepCopyWith: deepCopier 
	"All inst vars are meant to be shared"

	self == #veryDeepCopyWith:.	"to satisfy checkVariables"
	^deepCopier references at: self ifAbsentPut: [self shallowCopy]	"remember"! !

!TextStyle methodsFor: 'fonts and font indexes' stamp: 'DamienCassou 9/29/2009 13:14'!
addNewFontSizeDialog: args
	"This is called from a modal menu and call back the menu with entered argument."
	| f n r |
	f := UIManager default request: 'Enter the point size' initialAnswer: '12'.
	f ifNil: [f := String new].
	n := f asNumber.
	r := self addNewFontSize: n.
	r ifNotNil: [
		args second ifNotNil: [args second modalSelection: {args first. n}].
	].
! !

!TextStyle methodsFor: 'fonts and font indexes' stamp: ''!
flushFonts
	"Clean out the fonts, an aid when snapshotting claims too many are 
	holding onto Display."

	(self confirm: 
'flushFonts is very dangerous.
Are you foolish or clever enough to proceed?')
		ifTrue: [1 to: fontArray size do: [:index | fontArray at: index put: nil]]
		ifFalse: [Transcript cr; show: 'flushFonts cancelled']

	"TextStyle default flushFonts"! !

!TextStyle methodsFor: 'comparing' stamp: 'ar 9/9/2003 22:04'!
hash
	"#hash is re-implemented because #= is re-implemented"
	^fontArray hash
! !

!TextStyle methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
centered
	alignment := 2! !

!TextStyle methodsFor: 'accessing' stamp: ''!
fontNames  "TextStyle default fontNames"
	^ fontArray collect: [:x | x name]! !

!TextStyle methodsFor: 'accessing' stamp: 'ar 12/16/2001 16:58'!
fonts
	"Return a collection of fonts contained in this text style"
	^fontArray! !

!TextStyle methodsFor: 'accessing' stamp: 'nk 6/25/2003 12:54'!
isTTCStyle

	^ fontArray first isTTCFont.
! !

!TextStyle methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
restIndent: anInteger 
	"Set the indent for all but the first line of a paragraph in the style of the 
	receiver to be the argument, anInteger."
	restIndent := anInteger! !

!TextStyle methodsFor: 'tabs and margins' stamp: ''!
leftMarginTabAt: marginIndex 
	"Set the 'nesting' level of left margin indents of the paragraph in the 
	style of the receiver to be the argument, marginIndex."

	(marginIndex > 0 and: [marginIndex < marginTabsArray size])
		ifTrue: [^(marginTabsArray at: marginIndex) at: 1]
		ifFalse: [^0]	
	"The marginTabsArray is an Array of tuples.  The Array is indexed according 
	to the marginIndex, the 'nesting' level of the requestor."
! !

!TextStyle methodsFor: 'accessing' stamp: ''!
firstIndent
	"Answer the horizontal indenting of the first line of a paragraph in the 
	style of the receiver."

	^firstIndent! !

!TextStyle methodsFor: 'comparing' stamp: 'tk 7/5/2001 22:18'!
= other

	self species == other species ifFalse: [^ false].
	1 to: self class instSize do:
		[:i | (self instVarAt: i) == (other instVarAt: i) ifFalse: [^ false]].
	^ true! !

!TextStyle methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
lineGrid: anInteger 
	"Set the relative space between lines of a paragraph in the style of the 
	receiver to be the argument, anInteger."
	lineGrid := anInteger! !

!TextStyle methodsFor: 'accessing' stamp: 'lr 7/4/2009 10:42'!
justified
	alignment := 3! !

!TextStyle class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/31/2013 14:15'!
removeDependent: anObject

	self notifier removeDependent: anObject! !

!TextStyle class methodsFor: 'textconstants access' stamp: 'nk 7/3/2003 19:06'!
fontArrayForStyle: aName
	"Answer the fonts in the style named aName,
	or an empty Array if no such named style."

	"TextStyle fontArrayForStyle: #Atlanta"
	"TextStyle fontPointSizesFor: 'NewYork'"

	^ ((self named: aName) ifNil: [ ^#() ]) fontArray
! !

!TextStyle class methodsFor: '*FreeType-override' stamp: 'StephaneDucasse 10/22/2014 22:14'!
emphasisMenuForFont: font target: target selector: selector highlight: currentEmphasis
	"Offer a font emphasis menu for the given style. If one is selected, pass that font to target with a call to selector. The fonts will be displayed in that font. Answer nil if no derivatives exist"

 	| aMenu derivs |
	derivs := font derivativeFonts.
	derivs isEmpty ifTrue: [ ^nil ].
	aMenu := UIManager default newMenuIn: self for: self.
	aMenu addTitle: 'emphasis'.
	derivs := derivs asOrderedCollection.
	derivs addFirst: font.
	derivs do: [ :df | 
			aMenu 
				add: df emphasisString
				target: target 
				selector: selector
				argument: df.
                aMenu lastItem font: df.
                df emphasis == currentEmphasis ifTrue: [aMenu lastItem color: Color blue darker]].
        ^ aMenu! !

!TextStyle class methodsFor: 'constants' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
named: familyName 
	"Answer the TextStyle with the given name, or nil."
	"TextStyle named: 'NewYork'"
	| textStyle |
	textStyle := TextSharedInformation 
		at: familyName
		ifAbsent: [ ^ nil ].
	(textStyle isKindOf: self) ifFalse: [ ^ nil ].
	^ textStyle! !

!TextStyle class methodsFor: 'textconstants access' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
knownTextStyles
	"Answer the names of the known text styles, sorted in alphabetical order"

	"TextStyle knownTextStyles"
	^ (TextSharedInformation select: [:thang | thang isKindOf: TextStyle]) keys sort

! !

!TextStyle class methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
styleDecoder
	TextSharedInformation at: #StyleDecoder ifPresent: [ :dict | dict ifNotNil: [ ^dict ]].
	^TextSharedInformation at: #StyleDecoder put: (
		Dictionary new at: 'Regular' put: 0;
				 at: 'Roman' put: 0;
				 at: 'Medium' put: 0;
				 at: 'Light' put: 0;
				 at: 'Normal' put: 0;
				 at: 'Plain' put: 0;
				 at: 'Book' put: 0;
				 at: 'Demi' put: 0;
				 at: 'Demibold' put: 0;
				 at: 'Semibold' put: 0;
				 at: 'SemiBold' put: 0;
				 at: 'ExtraBold' put: 1;
				 at: 'SuperBold' put: 1;
				 at: 'B' put: 1;
				 at: 'I' put: 2;
				 at: 'U' put: 4;
				 at: 'X' put: 16;
				 at: 'N' put: 8;
				 at: 'Bold' put: 1;
				 at: 'Italic' put: 2;
				 at: 'Oblique' put: 2;
				 at: 'Narrow' put: 8;
				 at: 'Condensed' put: 8;
				 at: 'Underlined' put: 4;
				 yourself )! !

!TextStyle class methodsFor: 'constants' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
setDefault: aTextStyle
	"Answer the system default text style."

	TextSharedInformation at: #DefaultTextStyle put: aTextStyle.! !

!TextStyle class methodsFor: 'textconstants access' stamp: 'nk 9/1/2004 11:08'!
knownTextStylesWithoutDefault
	"Answer the names of the known text styles, sorted in alphabetical order without default"

	"TextStyle knownTextStylesWithoutDefault"
	| result |
	result := self knownTextStyles asOrderedCollection.
	^ result copyWithoutAll: self defaultFamilyNames

! !

!TextStyle class methodsFor: 'initialization' stamp: 'nk 3/25/2004 17:51'!
initialize
	self initializeStyleDecoder.! !

!TextStyle class methodsFor: 'utilities' stamp: 'nk 4/2/2004 11:23'!
pixelsToPoints: pixels
	^pixels * 72.0 / self pixelsPerInch! !

!TextStyle class methodsFor: 'utilities' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
pixelsPerInch
	"Answer the nominal resolution of the screen."

	^TextSharedInformation at: #pixelsPerInch ifAbsentPut: [ 96.0 ].! !

!TextStyle class methodsFor: 'textconstants access' stamp: 'nk 7/3/2003 18:56'!
fontPointSizesFor: aName
	"Answer the point sizes for all the fonts in the given text style"

	"TextStyle fontPointSizesFor: 'Arial'"
	"TextStyle fontPointSizesFor: 'NewYork'"

	^ (self fontArrayForStyle: aName) collect: [:f | f pointSize]
! !

!TextStyle class methodsFor: 'constants' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
defaultFont
	"Answer the default system font"

	^ self default defaultFont! !

!TextStyle class methodsFor: 'textconstants access' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
defaultFamilyNames
	| DefaultTextStyle DefaultFixedTextStyle DefaultMultiStyle |

	DefaultTextStyle := TextSharedInformation at: #DefaultTextStyle.
	DefaultFixedTextStyle := TextSharedInformation at: #DefaultFixedTextStyle.
	DefaultMultiStyle := TextSharedInformation at: #DefaultMultiStyle.
	
	^#(DefaultTextStyle DefaultFixedTextStyle DefaultMultiStyle)! !

!TextStyle class methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
initializeStyleDecoder
	TextSharedInformation at: #StyleDecoder put: nil.
	self styleDecoder.! !

!TextStyle class methodsFor: 'textconstants access' stamp: 'nk 7/3/2003 18:58'!
fontWidthsFor: aName
	"Answer the widths for all the fonts in the given text style"

	"TextStyle fontWidthsFor: 'ComicPlain'"
	^ (self fontArrayForStyle: aName) collect: [:f | f maxWidth]
! !

!TextStyle class methodsFor: 'textconstants access' stamp: 'nk 7/3/2003 19:11'!
pointSizesFor: aName
	"Answer all the point sizes for the given text style name"

	"TextStyle pointSizesFor: 'NewYork'"
	^ (self fontArrayForStyle: aName) collect: [:f | f pointSize]
! !

!TextStyle class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/22/2013 14:43'!
addDependent: anObject

	self notifier addDependent: anObject! !

!TextStyle class methodsFor: 'instance creation' stamp: ''!
fontArray: anArray 
	"Answer an instance of me with fonts those in the argument, anArray."

	^self new newFontArray: anArray! !

!TextStyle class methodsFor: 'utilities' stamp: 'VeronicaUquillas 6/11/2010 13:45'!
decodeStyleName: styleName 
	"Given a string styleName, return a collection with: 
	 
	* [1] the probable Pharo emphasis code, which is a bit combination of: 
	1	bold 
	2	italic 
	4	underlined 
	8	narrow 
	16	strikeout 
	 
	* [2] the base style name without the modifiers (can be empty)
	* [3] the modifiers in the order they were found 
	* [4] the codes for those modifiers, in the same order
	"
	| decoder keys modifiers modifierCodes baseName styleCode matchedKey |

	decoder := self styleDecoder.

	modifiers := OrderedCollection new.
	modifierCodes := OrderedCollection new.
	keys := decoder keys asArray
				sort: [:a :b | a size > b size].
	styleCode := 0.
	baseName := styleName asString.
	[matchedKey := keys
				detect: [:k | baseName endsWith: k]
				ifNone: [].
	matchedKey notNil]
		whileTrue: [| last code | 
			last := baseName size - matchedKey size.
			last > 0
				ifTrue: [('- ' includes: (baseName at: last))
						ifTrue: [last := last - 1]].
			baseName := baseName copyFrom: 1 to: last.
			code := decoder at: matchedKey.
			styleCode := styleCode + code.
			modifiers addFirst: matchedKey.
			modifierCodes addFirst: code.
	].
	^ {styleCode. baseName. modifiers. modifierCodes }! !

!TextStyle class methodsFor: '*Graphics-Fonts' stamp: 'PavelKrivanek 6/1/2011 12:52'!
pixelsPerInch: aNumber
  "Set the nominal number of pixels per inch to aNumber."
  TextSharedInformation at: #pixelsPerInch put: aNumber asFloat.
  self changed: #textDPIChanged.
! !

!TextStyle class methodsFor: 'constants' stamp: 'PavelKrivanek 6/14/2011 12:46'!
default
  "Answer the system default text style."

  ^TextSharedInformation at: #DefaultTextStyle ifAbsent: nil! !

!TextStyle class methodsFor: 'instance creation' stamp: ''!
new
	^ super new leading: 2! !

!TextStyle class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/22/2013 14:43'!
changed: anAspect

	self notifier changed: anAspect! !

!TextStyle class methodsFor: 'textconstants access' stamp: 'nk 7/3/2003 18:58'!
fontSizesFor: aName
	"Answer the pixel sizes for all the fonts in the given text style"

	"TextStyle fontSizesFor: 'Arial'"
	"TextStyle fontSizesFor: 'NewYork'"

	^ (self fontArrayForStyle: aName) collect: [:f | f height ]
! !

!TextStyle class methodsFor: 'textconstants access' stamp: 'BenjaminVanRyseghem 11/28/2010 19:02'!
actualTextStyles
	"TextStyle actualTextStyles"
	"Answer dictionary whose keys are the names of styles in the system and whose values are the actual styles"
	| aDict |
	aDict := TextSharedInformation select: [ :thang | thang isKindOf: self ].
	self defaultFamilyNames do: [ :sym | aDict removeKey: sym ].
	^ aDict! !

!TextStyle class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/22/2013 14:42'!
notifier

	^ notifier ifNil: [ notifier := Model new ]! !

!TextStyle class methodsFor: 'utilities' stamp: 'nk 4/2/2004 11:22'!
pointsToPixels: points
	^points * self pixelsPerInch / 72.0! !

!TextStyleAsFontFamily commentStamp: 'TorstenBergmann 2/4/2014 22:07'!
Text style as font family!
!TextStyleAsFontFamily methodsFor: 'accessing' stamp: 'tween 8/25/2007 14:25'!
members
	^members ifNil:[
		members := #('Regular' 'Italic' 'Bold' 'Bold Italic')
		  collect:[:each | 
			TextStyleAsFontFamilyMember new 
				family: self;
				styleName: each;
				yourself]]! !

!TextStyleAsFontFamily methodsFor: 'accessing' stamp: 'tween 8/16/2007 22:09'!
textStyle: anObject
	"Set the value of textStyle"

	textStyle := anObject! !

!TextStyleAsFontFamily methodsFor: 'accessing' stamp: 'tween 8/16/2007 22:09'!
textStyle
	"Answer the value of textStyle"

	^ textStyle! !

!TextStyleAsFontFamilyMember commentStamp: 'TorstenBergmann 2/4/2014 22:08'!
TextStyleAsFont Family members!
!TextStyleAsFontFamilyMember methodsFor: 'LogicalFont emphasis' stamp: 'EstebanLorenzano 8/17/2012 16:40'!
stretchValue
	^(styleName includesSubstring: 'Condensed') 
		ifTrue:[LogicalFont stretchCompressed]
		ifFalse:[LogicalFont stretchRegular]! !

!TextStyleAsFontFamilyMember methodsFor: 'squeak emphasis' stamp: 'EstebanLorenzano 8/17/2012 16:40'!
emphasisCode
	" Answer the squeak emphasis code (1=bold, 2=italic, 3=boldItalic etc"
	| answer |
	answer := 0.
	(styleName includesSubstring: 'Italic') 
		ifTrue:[answer := answer bitOr: LogicalFont squeakSlantItalic].
	(styleName includesSubstring: 'Condensed')
		ifTrue:[answer := answer bitOr: LogicalFont squeakStretchCondensed].
	(styleName includesSubstring: 'Bold')
		ifTrue:[answer := answer bitOr: LogicalFont squeakWeightBold].
	^answer! !

!TextStyleAsFontFamilyMember methodsFor: 'LogicalFont emphasis' stamp: 'EstebanLorenzano 8/17/2012 16:40'!
weightValue
	^(styleName includesSubstring: 'Bold')
		ifTrue:[LogicalFont weightBold] 
		ifFalse:[LogicalFont weightRegular]! !

!TextStyleAsFontFamilyMember methodsFor: 'LogicalFont emphasis' stamp: 'EstebanLorenzano 8/17/2012 16:40'!
slantValue
	^(styleName includesSubstring: 'Italic') 
		ifTrue:[LogicalFont slantItalic] 
		ifFalse:[LogicalFont slantRegular]! !

!TextStyleAsFontFamilyMember methodsFor: 'testing' stamp: 'tween 8/17/2007 00:16'!
simulated 
	^false! !

!TextStyleAsFontFamilyMember methodsFor: 'comparing' stamp: 'tween 8/16/2007 23:30'!
<=  aTextStyleAsFontFamilyMember
	| orderedItems |
	orderedItems := #('Condensed' 'Condensed Italic' 'Condensed Bold'  'Condensed Bold Italic' 'Regular' 'Italic' 'Bold' 'Bold Italic').
	^(orderedItems indexOf: self styleName) <= (orderedItems indexOf: aTextStyleAsFontFamilyMember styleName)! !

!TextURL commentStamp: '<historical>'!
I'm a text attribute used to encode an URL.!
!TextURL methodsFor: 'styling' stamp: 'tk 12/16/97 13:45'!
writeScanOn: strm

	strm nextPut: $R; nextPutAll: url; nextPut: $;! !

!TextURL methodsFor: 'accessing' stamp: 'tk 12/16/97 08:55'!
url: aString
	url := aString! !

!TextURL methodsFor: 'as yet unclassified' stamp: 'SeanDeNigris 11/5/2013 14:56'!
actOnClick: anEvent for: anObject in: paragraph editor: editor

	Smalltalk tools webBrowser openOnUrl: url.! !

!TextURL methodsFor: 'testing' stamp: 'tk 12/16/97 16:47'!
analyze: aString

	| list |
	list := super analyze: aString.
	url := list at: 1.
	^ list at: 2! !

!TextURL methodsFor: 'accessing' stamp: 'tk 12/30/97 10:33'!
info
	^ url! !

!TextURL class methodsFor: 'as yet unclassified' stamp: 'tk 12/16/97 09:24'!
scanFrom: strm
	"read a link in the funny format used by Text styles on files. Rhttp://www.disney.com;"

	^ self new url: (strm upTo: $;)! !

!TextVariableLink commentStamp: 'TorstenBergmann 1/31/2014 12:19'!
An active link in a text linking to a variable!
!TextVariableLink methodsFor: 'accessing' stamp: 'CamilloBruni 2/1/2012 19:17'!
variableName: aString
	variableName := aString! !

!TextVariableLink methodsFor: 'evaluating' stamp: 'CamilloBruni 2/1/2012 20:18'!
actOnClick: anEvent for: aNautilusUI in: aParagraph editor: anEditor
	anEditor referencesTo: self variableName.
	^ true! !

!TextVariableLink methodsFor: 'accessing' stamp: 'CamilloBruni 2/1/2012 19:17'!
variableName
	^ variableName! !

!TextVariableLink class methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 2/1/2012 19:17'!
variableName: aSymbol
	^ self new
		variableName: aSymbol;
		yourself! !

!TheHeartOfSpec commentStamp: 'IgnacioSniechowski 2/25/2015 08:32'!
A SpecExamples is the second sub-book of SpecHelpTopics. It contains the core of Spec briefly explained.
See class side for selectors.
!
!TheHeartOfSpec class methodsFor: 'pages' stamp: 'IgnacioSniechowski 2/16/2015 19:17'!
layouts
	^HelpTopic
		title: 'The layout method'
		contents: 'This method specifies the layout of the different widgets in the UI. It also specifies how a widget reacts when the window is resized. For the same UI multiple layouts can be described, and when the UI is built a specific layout to use can be specified. If no such specific layout is given, the following lookup mechanism will be used to obtain the layout method:

1. Search on class side, throughout the whole class hierarchy, for a method with the pragma <spec: #default>.
2. If multiple such methods exist, the first one found is used.
3. If none such methods exist and if there is exactly one method with the pragma <spec>, this method is used.
4. No layout method is found, an error is raised.

This method is on class side because it returns a value that usually is the same for all the instances. Put differently, usually all the instances of the same user interface have the same layout and hence this can be considered as being a class-side accessor for a class variable. Note that the lookup for the spec method to use starts on instance side, which allows a UI to have a more specific layout depending on the state of the instance.

In its simplest form, this method could be:

	^ SpecLayout composed
			add: #theList;
			yourself


The symbol theList refers to an instance side method returning a widget. This is because instance variables are private, so the layout class needs to use an accessor to obtain it when building the UI. Note that by default, a widget will take all the space available in its container.
This method is not restricted to laying out sub widgets. It can also refer to sub widgets contained in sub widgets, i.e. when reusing an existing UI, specify a new layout for the sub widgets that comprise this UI. To do this, instead of giving a symbol, an array with 2 symbols must be given. 
The first symbol identifies the UI being reused and the second the sub widget within this UI whose new layout position is being specified. 
As said above, multiple layouts can be described for the same user interface. In order to retrieve the correct method to apply, these methods need to be flagged with a pragma. The pragma can be either <spec: default> for the layout to use by default, or <spec> for the other layouts.

Specifying this method is mandatory, as without it the UI would show no widgets to the user.'
! !

!TheHeartOfSpec class methodsFor: 'pages' stamp: 'IgnacioSniechowski 2/16/2015 18:50'!
intro
	^HelpTopic 
		title: 'The Heart of Spec'
		contents: 'All user interfaces in Spec are constructed through the composition of existing user interfaces. To define a user interface, it is sufficient to define the model of the user interface. The UI elements that correspond to this model are instantiated by Spec, depending on the underlying UI framework. 
		
It is the composition of this model and these UI elements that makes up the resulting widget that is shown to the user, i.e. the resulting user interface. Hence, since all UIs are constructed through composition of other UIs, and it is sufficient to define the model to define the UI, the root class of all UIs is named ComposableModel. So, to define a new user interface, a subclass of ComposableModel needs to be created.

Spec is inspired by the MVP pattern. It is built around three axes that materialize themselves as the following three methods: 

ComposableModel>>#initializeWidgets
ComposableModel>>#initializePresenter
ComposableModel class>>#defaultSpec. 
	
These methods are hence typically found in the model for each user interface. In the following topics we describe the responsibility for each method, i.e. how these three work together to build the overall UI.'! !

!TheHeartOfSpec class methodsFor: 'accessing' stamp: 'IgnacioSniechowski 2/16/2015 18:48'!
bookName
	^'The Heart of Spec'! !

!TheHeartOfSpec class methodsFor: 'pages' stamp: 'IgnacioSniechowski 2/16/2015 19:04'!
initializePresenter
	^HelpTopic
		title: 'The initializePresenter method'
		contents: 'This method takes care of the interactions between the different widgets. By linking the behavior of the different widgets it specifies the overall presentation, i.e. how the overall UI responds to interactions by the user. Usually this method consists of specifications of actions to perform when a certain event is received by a widget. From the propagation of those events the whole interaction flow of the UI emerges. In Spec, the different UI models are contained in value holders, and the event mechanism relies on the announcements of these value holders to manage the interactions between widgets. 
Value holders provide a single method whenChangedDo: that is used to register a block to perform on change. In addition to this primitive whenChangedDo: method, the basic widgets provide more specific hooks, e.g. when an item in a list is selected or deselected.'! !

!TheHeartOfSpec class methodsFor: 'accessing' stamp: 'IgnacioSniechowski 2/16/2015 19:08'!
pages
	^#(intro initializeWidgets widgetInstantiation initializePresenter layouts)! !

!TheHeartOfSpec class methodsFor: 'pages' stamp: 'IgnacioSniechowski 2/16/2015 19:01'!
widgetInstantiation
	^HelpTopic
		title: 'Widget Instantiation'
		contents: 'The instantiation of the model for a widget (and hence the widget) can be done in two ways: 
Through the use of an creation method or through the use of the instantiate: method. Considering the first option, the framework provides unary messages for the creation of all basic widgets. The format of these messages is:   
	new[Widget]

for example newButton creates a button widget, and newList creates a list widget. 
The complete list of available widget creation methods can be found in the class Composable-Model in the protocol widgets. 

Considering the second option, to reuse any composite widgets, i.e. a subclass of ComposableModel, the widget needs to be initialized using the instantiate: method. For example, to reuse a Message-Browser widget, the code is:

	self instantiate: MessageBrowser.'! !

!TheHeartOfSpec class methodsFor: 'pages' stamp: 'IgnacioSniechowski 2/16/2015 18:57'!
initializeWidgets
	^HelpTopic
		title: 'The initializeWidgets method'
		contents: 'This method is used to instantiate the models for the different widgets that will be part of the UI and store them in their respective instance variables. Instantiation of the models will in turn result in the instantiation and initialization of the different widgets that make up the UI. Consequently, configuration and default values of each widget are specified here as well, which is why this method is called initializeWidgets. This focus in this method is to specify what the widgets will look like and what their self-contained behavior is. 
The behavior to update model state, e.g. when pressing a Save button, is described in this method as well. It is explicitly not the responsibility of this method to define the interactions between the widgets.

In general the initializeWidgets method should follow the pattern:
• widgets instantiation
• widgets configuration specification
• specification of order of focus

The last step is not mandatory but highly recommended. Indeed, without this final step keyboard navigation will not work at all.

An example of the initializeWidgets method could be:

	initializeWidgets
		theButton := self newButton.
		theList := self newList.
		theButton label: ''I am a button''.
		self focusOrder
		add: theButton;
		add: theList.

Specifying this method is mandatory, as without it the UI would have no widgets.'! !

!TheManifestBuilder commentStamp: 'StephaneDucasse 1/6/2014 20:52'!
I'm a tool to build manifest that handles small lint false positive and other information.

My name is strange but this is to avoid to match with a Manifest class which is recognized because it starts with Manifest*.
!
!TheManifestBuilder methodsFor: 'adding/removing' stamp: 'ChristopheDemarey 11/21/2014 15:32'!
removeRejectClass: aClass

	|  classes |
	classes :=  self manifest rejectClasses asOrderedCollection.
	classes := classes reject: [ :each | 
			((Smalltalk globals at: each first first) manifestReadOn:  (each first at: 2)) =  aClass asRingDefinition ].	
	self compileSelector: (self class rejectClassesTag) returnValue:  (self buildArrayString: classes)
	! !

!TheManifestBuilder methodsFor: 'manifest' stamp: 'StephaneDucasse 3/21/2013 10:29'!
containsRejectedClass: aClass
	
	^ self rejectClasses anySatisfy: [ :cl | cl = aClass ]! !

!TheManifestBuilder methodsFor: 'manifest' stamp: 'ChristopheDemarey 11/21/2014 15:30'!
rejectRules
	^ self manifest rejectRules
	
! !

!TheManifestBuilder methodsFor: 'manifest' stamp: 'ChristopheDemarey 11/21/2014 15:24'!
falsePositiveOf: ruleId version: versionId 

	^ self unwrap: (self manifest perform: (self selectorFalsePositiveOf: ruleId version: versionId))! !

!TheManifestBuilder methodsFor: 'private' stamp: 'SimonAllier 3/22/2013 13:43'!
unwrap: aCollection

	| unwrapCollection rgobject |
	
	unwrapCollection := OrderedCollection new.
	aCollection
		do: [ :each | 
			rgobject := (Smalltalk globals at: each first first) manifestReadOn:  (each first at: 2).
			(rgobject isClass and: [ rgobject  realClass notNil ])
				ifTrue: [ unwrapCollection add: rgobject realClass ].
			(rgobject isMethod and: [ rgobject method notNil ])
				ifTrue: [ unwrapCollection add: rgobject method ] ].
	^ unwrapCollection! !

!TheManifestBuilder methodsFor: 'manifest' stamp: 'SimonAllier 3/22/2013 13:23'!
dateOfTruePositive: aItem onRule: ruleId version: versionId

	(self hasTruePositiveOf: ruleId version: versionId)
		ifFalse: [^ self].
	^ self dateOf: ( aItem asRingDefinition) forSelector:  (self selectorTruePositiveOf: ruleId version: versionId)
		
		! !

!TheManifestBuilder methodsFor: 'manifest' stamp: 'ChristopheDemarey 11/21/2014 15:29'!
hasTruePositiveOf: ruleId version: versionId
	^ self manifest respondsTo: (self selectorTruePositiveOf: ruleId version: versionId)  
	! !

!TheManifestBuilder methodsFor: 'adding/removing' stamp: 'ChristopheDemarey 11/21/2014 15:20'!
addRejectClass: aClass

	|  falsePositives |
	falsePositives := self manifest rejectClasses asOrderedCollection .
	((self unwrap: falsePositives) anySatisfy: [:each | each = aClass])
		ifTrue: [ ^ self ].
	falsePositives add: {aClass asRingDefinition arrayStringForManifest. DateAndTime current asString}.
	self compileSelector:  (self class rejectClassesTag) returnValue: (self buildArrayString: falsePositives)
	
	! !

!TheManifestBuilder methodsFor: 'adding/removing' stamp: 'StephaneDucasse 3/21/2013 09:59'!
addFalsePositive: fp of: ruleId version: versionId

	| selector |
	selector := self selectorFalsePositiveOf: ruleId version: versionId. 
	self addItem: fp selector: selector.	
	(self containsToDo: fp onRule: ruleId version: versionId)
		ifTrue: [self removeToDo: fp of:  ruleId version: versionId]. ! !

!TheManifestBuilder methodsFor: 'manifest' stamp: 'ChristopheDemarey 11/21/2014 15:29'!
hasToDoOf: ruleId version: versionId
	^ self manifest respondsTo: (self selectorToDoOf: ruleId version: versionId)  
	! !

!TheManifestBuilder methodsFor: 'manifest' stamp: 'SimonAllier 1/30/2013 16:47'!
createManifestOf: elem

	self createManifestNamed: (self packageNameOf: elem).! !

!TheManifestBuilder methodsFor: 'adding/removing' stamp: 'StephaneDucasse 3/21/2013 09:47'!
addAllToDo: aSet of: ruleId version: versionId

	| selector |
	selector := self selectorToDoOf: ruleId version: versionId. 
	self addAllItem: aSet selector: selector. ! !

!TheManifestBuilder methodsFor: 'manifest' stamp: 'ChristopheDemarey 11/21/2014 15:32'!
truePositiveOf: ruleId version: versionId 

	^ self unwrap: (self manifest perform: (self selectorTruePositiveOf: ruleId version: versionId))! !

!TheManifestBuilder methodsFor: 'adding/removing' stamp: 'SimonAllier 4/13/2012 17:13'!
removeAllManifest
 
	self removeClasses: (self class allManifestClasses)! !

!TheManifestBuilder methodsFor: 'adding/removing' stamp: 'StephaneDucasse 3/21/2013 10:24'!
removeToDo: fp of: ruleId version: versionId
	
	| selector |
	selector := self selectorToDoOf:ruleId version: versionId. 
	self removeItem: fp selector: selector.
	! !

!TheManifestBuilder methodsFor: 'adding/removing' stamp: 'ChristopheDemarey 11/21/2014 15:32'!
removeRejectRule: ruleId 

	|  nfp |	
	nfp := self manifest rejectRules asOrderedCollection.
	nfp remove: ruleId ifAbsent: [^ self].
	nfp := nfp asArray.
	self compileSelector: (self class rejectRulesTag) returnValue:   nfp asString

	! !

!TheManifestBuilder methodsFor: 'adding/removing' stamp: 'SimonAllier 5/29/2012 11:21'!
resetToDoOf: ruleId version: versionId
 	
	self installToDoOf: ruleId version: versionId. ! !

!TheManifestBuilder methodsFor: 'manifest' stamp: 'ChristopheDemarey 11/21/2014 15:27'!
hasFalsePositiveOf: ruleId version: versionId
	^ self manifest respondsTo: (self selectorFalsePositiveOf: ruleId version: versionId)! !

!TheManifestBuilder methodsFor: 'manifest' stamp: 'ChristopheDemarey 11/21/2014 15:32'!
toDoOf: ruleId version: versionId 

	^ self unwrap: (self manifest perform: (self selectorToDoOf: ruleId version: versionId))! !

!TheManifestBuilder methodsFor: 'manifest' stamp: 'SimonAllier 3/22/2013 13:12'!
installFalsePositiveOf: ruleId version: versionId

	self compileSelector: (self selectorFalsePositiveOf: ruleId version: versionId) returnValue: '#()'
! !

!TheManifestBuilder methodsFor: 'private' stamp: 'SimonAllier 8/1/2012 15:17'!
removeItem: fp selector: selector
	self removeAllItem: {fp} selector: selector! !

!TheManifestBuilder methodsFor: 'adding/removing' stamp: 'StephaneDucasse 3/21/2013 10:03'!
removeFalsePositive: fp of: ruleId version: versionId
	
	| selector |
	selector := self selectorFalsePositiveOf: ruleId version: versionId. 
	self removeItem: fp selector: selector.
	
	! !

!TheManifestBuilder methodsFor: 'adding/removing' stamp: 'ChristopheDemarey 11/21/2014 15:34'!
cleanUp

	| tagfp |
	tagfp := self class falsePositiveBeginningTag.
	self manifest class methodsDo: [ :method |
		(method selector asString beginsWith: tagfp)
				ifTrue: [self removeObsoleteFalsePositiveOf: method] ]
	
	


! !

!TheManifestBuilder methodsFor: 'private' stamp: 'SimonAllier 3/22/2013 11:22'!
buildArrayString: aCollection
	
	^ String streamContents: [:stream | 
		stream << '#('.
		aCollection do: [:each |  
			stream  nextPutAll: '#('.
			stream nextPutAll: each first printString.
			stream  nextPutAll: ' '.
			stream nextPutAll: (each at: 2) asSymbol  printString.
			stream  nextPutAll: ') '.].
		stream << ')']! !

!TheManifestBuilder methodsFor: 'adding/removing' stamp: 'StephaneDucasse 3/21/2013 10:02'!
removeAllFalsePositive: aSet of: ruleId version: versionId

	| selector |
	selector := self selectorFalsePositiveOf:ruleId version: versionId. 
	self removeAllItem: aSet selector: selector.
	! !

!TheManifestBuilder methodsFor: 'private' stamp: 'ChristopheDemarey 11/21/2014 15:31'!
removeObsoleteFalsePositiveOf: aMethod

	| set arrayString  |
	set := (self manifest perform: aMethod selector) asOrderedCollection.
	set := set select: [ :each | ((Smalltalk globals at: each first first) manifestReadOn:  (each first at: 2)) isDefined ].
	arrayString := self buildArrayString: set.
	self compileSelector: aMethod selector returnValue: arrayString
	! !

!TheManifestBuilder methodsFor: 'adding/removing' stamp: 'StephaneDucasse 3/21/2013 10:02'!
removeAllToDo: fp of: ruleId version: versionId
	
	| selector |
	selector := self selectorToDoOf: ruleId version: versionId. 
	self removeAllItem: fp selector: selector.
	! !

!TheManifestBuilder methodsFor: 'manifest' stamp: 'StephaneDucasse 3/21/2013 10:28'!
containsFalsePositive: aItem onRule: ruleId version: versionId

	^  (self hasFalsePositiveOf: ruleId version: versionId) 
			and: [ (self falsePositiveOf: ruleId version: versionId) anySatisfy: [ :fp | fp = aItem ]] ! !

!TheManifestBuilder methodsFor: 'accessing' stamp: 'StephaneDucasse 3/21/2013 09:47'!
manifestOf: elem

	| packageName |
	packageName := self packageNameOf: elem.
	manifestClass := self class allManifestClasses 
		detect: [ :each | each category = packageName  ]
		ifNone: [ nil ].
	^ manifestClass
		
! !

!TheManifestBuilder methodsFor: 'manifest' stamp: 'StephaneDucasse 3/21/2013 10:29'!
containsRejectedRule: aRuleId
	
	^ self rejectRules anySatisfy: [ :fp | fp = aRuleId ]! !

!TheManifestBuilder methodsFor: 'adding/removing' stamp: 'SimonAllier 5/29/2012 11:19'!
resetFalsePositiveOf: ruleId version: versionId
 
	self  installFalsePositiveOf: ruleId version: versionId. ! !

!TheManifestBuilder methodsFor: 'adding/removing' stamp: 'StephaneDucasse 3/21/2013 10:02'!
addTruePositive: fp of: ruleId version: versionId

	| selector  |	
	selector := self selectorTruePositiveOf: ruleId version: versionId. 
	self addItem: fp selector: selector.
	(self containsToDo: fp onRule: ruleId version: versionId)
		ifTrue: [ self removeToDo: fp of:  ruleId version: versionId ]. 
	(self containsFalsePositive: fp onRule: ruleId version: versionId)
		ifTrue: [ self removeFalsePositive: fp of:  ruleId version: versionId ]

	
	! !

!TheManifestBuilder methodsFor: 'manifest' stamp: 'SimonAllier 3/22/2013 13:22'!
dateOfFalsePositive: aItem onRule: ruleId version: versionId

	(self hasFalsePositiveOf: ruleId version: versionId)
		ifFalse: [^ self].
		
	^ self dateOf: ( aItem asRingDefinition) forSelector:  (self selectorFalsePositiveOf: ruleId version: versionId)
		
		! !

!TheManifestBuilder methodsFor: 'private' stamp: 'SimonAllier 3/21/2013 15:20'!
packageNameOf: elem
	^ elem mcWorkingCopy packageName
	"elem isCompiledMethod 
		ifTrue: [MCWorkingCopy managersForClass: (elem methodClass) selector: (elem selector) do: [: package | ^ package packageName ]]	
			
		ifFalse: [MCWorkingCopy managersForClass: elem  do: [: package | ^ package packageName ]]	
				"! !

!TheManifestBuilder methodsFor: 'manifest' stamp: 'StephaneDucasse 3/21/2013 10:29'!
containsTruePositive: aItem onRule: ruleId version: versionId

	^  (self hasTruePositiveOf: ruleId version: versionId) 
		and: [(self truePositiveOf: ruleId version: versionId) anySatisfy: [ :fp| fp = aItem ]] ! !

!TheManifestBuilder methodsFor: 'accessing' stamp: 'StephaneDucasse 3/21/2013 09:47'!
manifestClass: aClass
	 manifestClass := aClass
		
! !

!TheManifestBuilder methodsFor: 'printing' stamp: 'StephaneDucasse 3/21/2013 10:34'!
printOn: aStream

	aStream
		nextPutAll: 'ManifestBuilder of ';
		nextPutAll: manifestClass name! !

!TheManifestBuilder methodsFor: 'manifest' stamp: 'SimonAllier 3/22/2013 13:13'!
installToDoOf: ruleId version: versionId

	self compileSelector: (self selectorToDoOf: ruleId version: versionId) returnValue: '#()'
! !

!TheManifestBuilder methodsFor: 'private' stamp: 'ChristopheDemarey 11/21/2014 15:19'!
addAllItem: aSet selector: selector
	| set newSet arrayString |
	set := (self manifest perform: selector) asOrderedCollection.
	newSet := aSet \ (self unwrap: set).
	newSet isEmpty
		ifTrue: [ ^ self ].
	set addAll:
			(newSet
				collect: [ :fp | 
					{(fp asRingDefinition arrayStringForManifest).
					(DateAndTime current asString)} ]).
	arrayString := self buildArrayString: set.
	self compileSelector: selector returnValue: arrayString! !

!TheManifestBuilder methodsFor: 'private' stamp: 'SimonAllier 8/1/2012 15:14'!
addItem: fp selector: selector
	self addAllItem: {fp} selector: selector! !

!TheManifestBuilder methodsFor: 'manifest' stamp: 'SimonAllier 3/22/2013 13:23'!
dateOfToDo: aItem onRule: ruleId version: versionId
	
	 (self hasToDoOf: ruleId version: versionId)
		ifFalse: [^ self].
	^ self dateOf: ( aItem asRingDefinition) forSelector:  (self selectorToDoOf: ruleId version: versionId)
		
		! !

!TheManifestBuilder methodsFor: 'manifest' stamp: 'StephaneDucasse 3/21/2013 12:41'!
isFalsePositive: aItem onRule: ruleId version: versionId
	
	^ ((self containsFalsePositive: aItem onRule:  ruleId version: versionId) or:
			[(self containsRejectedRule: ruleId) or:
				[self containsRejectedClass: aItem criticClass]])! !

!TheManifestBuilder methodsFor: 'comparing' stamp: 'SimonAllier 3/21/2013 14:07'!
hash
	^ manifestClass hash bitXor: self class hash! !

!TheManifestBuilder methodsFor: 'manifest' stamp: 'StephaneDucasse 3/21/2013 10:29'!
containsToDo: aItem onRule: ruleId version: versionId

	^  (self hasToDoOf: ruleId version: versionId) 
		and: [(self toDoOf: ruleId version: versionId) 
			anySatisfy: [ :fp| fp = aItem ]] ! !

!TheManifestBuilder methodsFor: 'manifest' stamp: 'ChristopheDemarey 11/21/2014 15:30'!
rejectClasses
	^ self unwrap: (self manifest rejectClasses)
! !

!TheManifestBuilder methodsFor: 'adding/removing' stamp: 'SimonAllier 3/21/2013 14:41'!
addAllFalsePositive: fp of: ruleId version: versionId

	| selector  |	
	selector := self selectorFalsePositiveOf: ruleId version: versionId. 
	self addAllItem: fp selector: selector.
	fp do: [:each |
		 (self containsToDo: each onRule: ruleId version: versionId)
		ifTrue: [ self removeToDo: each of:  ruleId version: versionId ]]
	! !

!TheManifestBuilder methodsFor: 'adding/removing' stamp: 'MarcusDenker 2/20/2015 16:04'!
removeManifestOf: aItem
	
	(self manifestOf: aItem) ifNotNil: [ :myManifest | 
			self removeClass: myManifest  ]! !

!TheManifestBuilder methodsFor: 'manifest' stamp: 'SimonAllier 3/22/2013 13:13'!
installTruePositiveOf: ruleId version: versionId
	
	self compileSelector: (self selectorTruePositiveOf: ruleId version: versionId) returnValue: '#()'
! !

!TheManifestBuilder methodsFor: 'private' stamp: 'ChristopheDemarey 11/21/2014 15:31'!
removeAllItem: aSet selector: selector
	| set arrayString |
	set := (self manifest perform: selector) asOrderedCollection.
	set := set
		reject: [ :each | 
			| tmp |
			tmp := (Smalltalk globals at: each first first) manifestReadOn: (each first at: 2).
			aSet anySatisfy: [ :fp | tmp = fp asRingDefinition ] ].
	arrayString := self buildArrayString: set.
	self compileSelector: selector returnValue: arrayString! !

!TheManifestBuilder methodsFor: 'private' stamp: 'ChristopheDemarey 1/26/2015 09:46'!
compileSelector: selector returnValue: arrayString
	manifestClass
		compile: selector asString , Character cr asString , '^ ' , arrayString 
		classified: 'code-critics'! !

!TheManifestBuilder methodsFor: 'private' stamp: 'StephaneDucasse 3/21/2013 10:41'!
selectorTruePositiveOf: ruleId version: versionId

	^ (self class falsePositiveBeginningTag, ruleId ,
		self class falsePositiveMiddleTag, versionId asString,
		self class truePositiveEndTag) 
		asSymbol.! !

!TheManifestBuilder methodsFor: 'accessing' stamp: 'ChristopheDemarey 11/21/2014 16:05'!
manifest
	^ manifest ifNil: [ manifest := manifestClass new ]! !

!TheManifestBuilder methodsFor: 'comparing' stamp: 'ChristopheDemarey 11/21/2014 15:18'!
= aObject

	^ aObject class = self class and: [ self manifest = aObject manifest ]! !

!TheManifestBuilder methodsFor: 'manifest' stamp: 'ChristopheDemarey 11/20/2014 11:37'!
createManifestNamed: packageName

	 manifestClass := PackageManifest subclass: (self class manifestTag, packageName onlyLetters) asSymbol
			instanceVariableNames: ''
			classVariableNames: ''
			poolDictionaries: ''
			category: packageName.
	manifestClass comment: self class manifestClassComment.
	^ manifestClass! !

!TheManifestBuilder methodsFor: 'private' stamp: 'StephaneDucasse 3/21/2013 10:40'!
selectorFalsePositiveOf: ruleId version: versionId

	^ (self class falsePositiveBeginningTag, ruleId,
		self class falsePositiveMiddleTag, versionId asString,
		self class falsePositiveEndTag) 
			asSymbol.! !

!TheManifestBuilder methodsFor: 'adding/removing' stamp: 'ChristopheDemarey 11/21/2014 15:20'!
addRejectRule: ruleId 

	|  nfp |	
	nfp := self manifest rejectRules asSet.
	nfp add: ruleId.
	nfp := nfp asArray.
	self compileSelector: (self class rejectRulesTag) returnValue: nfp asString
! !

!TheManifestBuilder methodsFor: 'private' stamp: 'StephaneDucasse 3/21/2013 10:40'!
selectorToDoOf: ruleId version: versionId

	^ (self class toDoBeginningTag, ruleId ,
		self class toDoMiddleTag, versionId asString,
		self class toDoEndTag) asSymbol.! !

!TheManifestBuilder methodsFor: 'adding/removing' stamp: 'StephaneDucasse 3/21/2013 10:01'!
addToDo: fp of: ruleId version: versionId

	| selector |	
	selector := self selectorToDoOf: ruleId version: versionId. 
	self addItem: fp selector: selector.
	(self containsFalsePositive: fp onRule: ruleId version: versionId)
		ifTrue: [ self removeFalsePositive: fp of:  ruleId version: versionId ]! !

!TheManifestBuilder methodsFor: 'private' stamp: 'ChristopheDemarey 11/21/2014 15:24'!
dateOf: ringobject forSelector: aSelector

	| critics |

	critics := self manifest perform: aSelector.
	^ ((critics detect: [:each | ((Smalltalk globals at: each first first) manifestReadOn: (each first at: 2)) = ringobject ]) at: 2) asDateAndTime
		
		! !

!TheManifestBuilder class methodsFor: 'instance creation' stamp: 'ChristopheDemarey 1/20/2015 12:44'!
of: aItem
	| mb  |

	mb := self new. 
	(mb manifestOf: aItem) 
			ifNil: [mb createManifestOf: aItem].	
	^ mb	
! !

!TheManifestBuilder class methodsFor: 'utils' stamp: ''!
toDoBeginningTag
	"the string that identifies uniquely the beginning of a selector who give  the set of TODO for a rule"
	
	^ 'rule'! !

!TheManifestBuilder class methodsFor: 'utils' stamp: ''!
toDoEndTag
	"the string that identifies uniquely the end of a selector who give  the set of TODO for a rule"
	
	^ 'TODO'! !

!TheManifestBuilder class methodsFor: 'utils' stamp: 'ChristopheDemarey 11/28/2014 17:49'!
allManifestClasses

	^ PackageManifest subclasses! !

!TheManifestBuilder class methodsFor: 'utils' stamp: ''!
toDoMiddleTag
	"the string that identifies uniquely the middle of a selector who give  the set of TODO for a rule"
	
	^ 'V'! !

!TheManifestBuilder class methodsFor: 'utils' stamp: ''!
falsePositiveMiddleTag
	"the string that identifies uniquely the middle of a selector who give  the set of false positive for a rule"
	
	^ 'V'! !

!TheManifestBuilder class methodsFor: 'instance creation' stamp: 'SimonAllier 2/1/2013 11:34'!
hasPackageNamed: aPackageName

	^ self allManifestClasses 
		anySatisfy: [:each | each category = aPackageName  ]
	! !

!TheManifestBuilder class methodsFor: 'utils' stamp: ''!
rejectRulesTag
	"the string that identifies uniquely the beginning of a selector who give  the set of rejected rules"
	
	^ 'rejectRules'! !

!TheManifestBuilder class methodsFor: 'utils' stamp: ''!
truePositiveEndTag
	"the string that identifies uniquely the end of a selector who give  the set of false positive for a rule"
	
	^ 'TruePositive'! !

!TheManifestBuilder class methodsFor: 'utils' stamp: ''!
rejectClassesTag
	"the string that identifies uniquely the beginning of a selector who give  the set of rejected classes"
	
	^ 'rejectClasses'! !

!TheManifestBuilder class methodsFor: 'utils' stamp: ''!
manifestTag
	"the string that identifies uniquely the beginning of a Manifest class name"
	
	^ 'Manifest'! !

!TheManifestBuilder class methodsFor: 'utils' stamp: ''!
falsePositiveEndTag
	"the string that identifies uniquely the end of a selector who give  the set of false positive for a rule"
	
	^ 'FalsePositive'! !

!TheManifestBuilder class methodsFor: 'utils' stamp: 'ChristopheDemarey 11/24/2014 15:45'!
manifestClassComment
	
	^ 'I store metadata for this package. These meta data are used by other tools such as the SmalllintManifestChecker and the critics Browser'! !

!TheManifestBuilder class methodsFor: 'utils' stamp: ''!
falsePositiveBeginningTag
	"the string that identifies uniquely the beginning of a selector who give  the set of false positive for a rule"
	
	^ 'rule'! !

!TheManifestBuilder class methodsFor: 'instance creation' stamp: 'SimonAllier 2/1/2013 11:38'!
hasManifestFor: aItem

	^  (self new manifestOf: aItem) isNil not
		! !

!TheManifestBuilder class methodsFor: 'instance creation' stamp: 'GabrielOmarCotelli 11/30/2013 16:05'!
ofPackageNamed: aPackageName
	| builder |
	builder := self new.
	self allManifestClasses
		detect: [ :each | each category = aPackageName ]
		ifFound: [ :manifestClass | builder manifestClass: manifestClass ]
		ifNone: [ builder createManifestNamed: aPackageName ].
	^ builder! !

!ThemeIcons commentStamp: 'gvc 5/18/2007 10:25'!
Some extra icons in the vein of MenuIcons.!
!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:30'!
smallSaveAsIcon
	"Private - Generated method"
	^ icons
			at: #'smallSaveAs'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallSaveAsIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousInto
^ self icons
		at: #glamorousInto ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1258291200 4278190080 4278190080 4278190080 4278190080 4278190080 1258291200 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 251658240 4009754624 4278190080 4278190080 4278190080 4009754624 251658240 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1442840576 4076863488 4278190080 4076863488 1459617792 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3238002688 4177526784 3254779904 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4261412864 4278190080 4261412864 16777215 536870912 3992977408 536870912 16777215 4261412864 4278190080 4261412864 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 4261412864 4278190080 4261412864 16777215 16777215 16777215 16777215 16777215 4261412864 4278190080 4261412864 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
openIcon
	"Private - Generated method"
	^ icons
			at: #'open'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self openIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloRotIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/haloRot.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQAQMAAAAlPW0iAAAABlBMVEX///8AAABVwtN+AAAA
I0lEQVR4XmOAAMYGBiYwg/0BA4sGg4oKCIkogLgg4ABSAAYAW2gEA7XBkhoAAAAASUVORK5C
YII='! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
imageIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAALqSURBVDjLjVPbS9NRHN9T/0BW
FBQUVIQKXigCpVIyygcDJUrnZdNEc5hlmZc0TdSF0bxszs3LvM3pXE6Xa3NL0TJTl7pcTY1E
c5rX/WxqCrHhp7NBPaRGD5+Xw/lczud8vzQAtJ0wWhLp+4kbUThSFGrQFwTrB59dE+ryA/3+
vreNOMaPOmLkMeUT4mTMaoph1klh7pPApOLAUH4LPTn+X7qzLwXsKDDGj0wy8hibM+oCrI9p
YTWGA0ZnWEd8sWZQYvXDC5g0XAzyo6BJP5f/R2C89OYeErlquiUPP9vogNgF1iYfbH10B0zx
RMQFC4oszMsz8F3XBOqdBKqUs7a2B6fdHAIkMnu6le1w3WrwBLrjHSKWrhhYh72w2kVHjTII
ae3eKFJexkp/I0YlKWhJdKsgZIanoTjMtlHPxSY9BD/YgbA2eGPteRjmWzOJazrmZKl4rL4A
QT8TD4nIfPMjzKgKIUtwNtJIyxXftISclICN3GxYfHyw3FEEy1ALLIPNsOhkWGzLw5umCHCU
flBLr2O29i4WXgnQwDpB0YY5NyapASmoxlxQrGAsFrAIWQ6D6Da0GecxXBaLFfLmuHI+Tgrk
CBCIYKqIwVKHEHWxxzZp758GbTrc9AqYu4WYb8kkRcnsLcPejzL5DKi3dfAQSEFX9RKRZkzx
QklKIaqjD4PW9+QqVy+IxmdpOkwvOaB6xVjpa8QQOSMtY4DHAPW6GuLSVFwprUJxSQYWlRyM
S9JQGXlw3PELZDB8OzN9c0hkdXua1/pYfTKonloHkeoWYVachCkuHZNFwZhrTMeCmov2rIso
Y+wL2TaJJLKr4r6HzUyIpso4R9yp4mB8LWFgScPHtJyNjhx/CCOcCnccZTua77jKRkiJy51l
mKlJxJK2lJBLoOMxiet+myDcKWXXXbBDGn/KTcI6brO7TUgzMcBl4Pk9d3tkhSB8r+s/l+k3
6mKOJpKW10VRh/TlzAOFJLLnTvd2Ffhf/AKfTM1hskDhXAAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousExample
^ self icons
		at: #glamorousExample ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1291845632 1593835520 16777215 16777215 16777215 1593835520 3439329280 2667577344 2566914048 83886080 16777215 83886080 2365587456 3221225472 3087007744 3422552064 2449473536 2785017856 16777215 16777215 1090519040 4278190080 1409286144 16777215 3305111552 2214592512 16777215 1677721600 4278190080 1275068416 150994944 4160749568 2550136832 16777215 16777215 16777215 2634022912 4278190080 1795162112 1375731712 3456106496 3321888768 16777215 1879048192 4278190080 1124073472 100663296 4110417920 2969567232 16777215 16777215 16777215 2835349504 4278190080 1543503872 989855744 989855744 889192448 16777215 218103808 3422552064 3472883712 2801795072 3405774848 654311424 16777215 16777215 16777215 1694498816 4278190080 1728053248 16777215 33554432 1795162112 16777215 1207959552 2298478592 419430400 251658240 33554432 16777215 16777215 16777215 16777215 33554432 2415919104 3992977408 2483027968 2483027968 704643072 16777215 1073741824 4127195136 4244635648 4278190080 4227858432 3238002688 83886080 16777215 16777215 16777215 16777215 100663296 318767104 16777215 16777215 16777215 1291845632 2785017856 1795162112 1526726656 1711276032 3690987520 1006632960 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1962934272 2701131776 939524096 889192448 1577058304 2885681152 33554432 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 687865856 1291845632 1308622848 838860800 16777216 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
helpIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAKkSURBVDjLpZPdT5JhGMb9W+BP
aK3matVqndXWOOigA6fmJ9DUcrUMlrN0mNMsKTUznQpq6pyKAm8CIogmypcg8GIiX8rHRHjh
VbPt6o01nMvZWge/k3vP9duuZ/edAyDnf/hjoCMP2Vr3gUDj3CdV6zT1xZ6iFDaKnLEkBFOm
PfaZArWT5sw60iFP+BAbOzTcQSqDZzsNRyCNkcVoaGghzDlVQKylOHJrMrUZ2Yf52y6kc36I
xpyoH1lHF7EBgyMKV4jCJ5U/1UVscU4IZOYEa3I1HtwI01hwxlDLhDoJD/wxGr5YGmOLAdRI
rVCuhmD3JdA6SQabx12srGB0KSpc86ew4olDOGjH4x4z0gdHDD9+c4TaQQtq+k2Yt0egXYug
TmoVZgV9cyHSxXTtJjZR3WNCVfcK/NE0ppYDUNu2QTMCtS0IbrsOrVMOWL27eNJtJLOCDoWX
dgeTEEosqPxoBK/TwDzWY9rowy51gJ1dGr2zLpS2aVH5QQ+Hbw88sZ7OClrGXbQrkMTTAQu4
HXqUv9eh7J0OSfo7tiIU+GItilpUuM/AF2tg98eR36Q+FryQ2kjbVhximQu8dgPKxPMoeTuH
4tfqDIWvCBQ2KlDQKEe9dBlGTwR36+THFZg+QoUxAL0jgsoOQzYYS+wjskcjTzSToVAkA7Hq
g4Spc6tm4vgT+eIFVvmb+eCSMwLlih/cNg0KmpRoGzdl+BXOb5jAsMYNjSWAm9VjwesPR1kn
FilPNMu510CkdPZtqK1BvJQsoaRZjqLGaTzv1UNp9EJl9uNqxefU5QdDnFNX+Y5Qxrn9bDLU
R6zjqzsMizeWYdG5gy6ZDbk8aehiuYRz5jHdeDTKvlY1IrhSMUxe4g9SuVwpdaFsgDxf2i84
V9zH/us1/is/AdevBaK9Tb3EAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloDebugIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/haloDebug.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQAQMAAAAlPW0iAAAABlBMVEX///8AAABVwtN+AAAA
KklEQVR4XmOAA2YGBsYGBoYDDAIHGCQOMPAfYGB/wMBQwMBgwcAgAVcFAILSBWOb9kW7AAAA
AElFTkSuQmCC'! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallOpenIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAGrSURBVDjLxZO7ihRBFIa/6u0Z
W7GHBUV0UQQTZzd3QdhMQxOfwMRXEANBMNQX0MzAzFAwEzHwARbNFDdwEd31Mj3X7a6uOr9B
tzNjYjKBJ6nicP7v3KqcJFaxhBVtZUAK8OHlld2st7Xl3DJPVONP+zEUV4HqL5UDYHr5xvuQ
Ajgl/Qs7TzvOOVAjxjlC+ePSwe6DfbVegLVuT4r14eTr6zvA8xSAoBLzx6pvj4l+DZIezuVk
G9fY2H7YRQIMZIBwycmzH1/s3F8AapfIPNF3kQk7+kw9PWBy+IZOdg5Ug3mkAATy/t0usovz
GeCUWTjCz0B+Sj0ekfdvkZ3abBv+U4GaCtJ1iEm6ANQJ6fEzrG/engcKw/wXQvEKxSEKQxRG
KE7Izt+DSiwBJMUSm71rguMYhQKrBygOIRStf4TiFFRBvbRGKiQLWP29yRSHKBTtfdBmHs0B
UpgvtgF4yRFR+NUKi0XZcYjCeCG2smkzLAHkbRBmP0/Uk26O5YnUActBp1GsAI+S5nRJJJal
5K1aAMrq0d6Tm9uI6zjyf75dAe6tx/SsWeD//o2/Ab6IH3/h25pOAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'BenjaminVanRyseghem 3/28/2014 17:38'!
instVarsUnselectedIconContents

	^ (Form
		extent: 24@24
		depth: 32
		fromArray: #(16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 257250645 1095650894 1951223117 2806795340 2806795340 1951223117 1095650894 257250645 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 106255701 2253278798 4216147277 4283256141 4283256141 4283256141 4283256141 4283256141 4283256141 4216147277 2253278798 106255701 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 810175050 3528347214 4283256141 4266807890 4284900966 4285822068 4286611584 4286611584 4285822068 4284900966 4266807890 4283256141 3528347214 810175050 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 810175050 4182592845 4283256141 4284637794 4287006342 4287335307 4287335307 4287335307 4287335307 4287335307 4287335307 4287006342 4284637794 4283256141 4182592845 810175050 16777215 16777215 16777215 16777215 16777215 16777215 16777215 106255701 3528347214 4283256141 4285624689 4287335307 4287335307 4288980132 4288980132 4288980132 4288980132 4288980132 4288980132 4287335307 4287335307 4285624689 4283256141 3528347214 106255701 16777215 16777215 16777215 16777215 16777215 16777215 2253278798 4283256141 4284506208 4287006342 4287006342 4287006342 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4288059030 4287006342 4287006342 4284506208 4283256141 2253278798 16777215 16777215 16777215 16777215 16777215 257250645 4216147277 4266742097 4286216826 4286414205 4286414205 4286414205 4290361785 4293059298 4294967295 4294967295 4293388263 4290822336 4287137928 4286414205 4286414205 4286216826 4266742097 4216147277 257250645 16777215 16777215 16777215 16777215 1095650894 4283256141 4284374622 4285953654 4285953654 4285953654 4285953654 4285953654 4290953922 4294967295 4294967295 4292203989 4285953654 4285953654 4285953654 4285953654 4285953654 4284374622 4283256141 1095650894 16777215 16777215 16777215 16777215 1951223117 4283256141 4284572001 4285361517 4285361517 4285361517 4285361517 4285361517 4290690750 4294967295 4294967295 4292072403 4285361517 4285361517 4285361517 4285361517 4285361517 4284572001 4283256141 1951223117 16777215 16777215 16777215 16777215 2806795340 4283256141 4284637794 4284900966 4284900966 4284900966 4284900966 4284900966 4290493371 4294967295 4294967295 4291940817 4284900966 4284900966 4284900966 4284900966 4284900966 4284637794 4283256141 2806795340 16777215 16777215 16777215 16777215 2806795340 4283256141 4284111450 4284308829 4284308829 4284308829 4284308829 4284308829 4290230199 4294967295 4294967295 4291743438 4284308829 4284308829 4284308829 4284308829 4284308829 4284111450 4283256141 2806795340 16777215 16777215 16777215 16777215 1951223117 4283256141 4283585106 4283782485 4283782485 4283782485 4283782485 4283782485 4290032820 4294967295 4294967295 4291546059 4283782485 4283782485 4283782485 4283782485 4283782485 4283585106 4283256141 1951223117 16777215 16777215 16777215 16777215 1095650894 4283256141 4283585106 4283979864 4283979864 4283979864 4283979864 4283979864 4290098613 4294967295 4294967295 4291677645 4283979864 4283979864 4283979864 4283979864 4283979864 4283585106 4283256141 1095650894 16777215 16777215 16777215 16777215 257250645 4216147277 4266544718 4284111450 4284177243 4284177243 4284177243 4286545791 4291217094 4294967295 4294967295 4292467161 4286545791 4284177243 4284177243 4284177243 4284111450 4266544718 4216147277 257250645 16777215 16777215 16777215 16777215 16777215 2253278798 4283256141 4283650899 4284440415 4284440415 4284440415 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4285822068 4284440415 4284440415 4283650899 4283256141 2253278798 16777215 16777215 16777215 16777215 16777215 16777215 106255701 3528281421 4283256141 4284111450 4284703587 4284703587 4289440683 4290032820 4290032820 4290032820 4290032820 4290032820 4285558896 4284703587 4284111450 4283256141 3528281421 106255701 16777215 16777215 16777215 16777215 16777215 16777215 16777215 810175050 4182592845 4283256141 4283782485 4284835173 4284966759 4284966759 4284966759 4284966759 4284966759 4284966759 4284835173 4283782485 4283256141 4182592845 810175050 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 810175050 3528281421 4283256141 4266610511 4284045657 4284440415 4284835173 4284835173 4284440415 4284045657 4266610511 4283256141 3528281421 810175050 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 106255701 2253278798 4216147277 4283256141 4283256141 4283256141 4283256141 4283256141 4283256141 4216147277 2253278798 106255701 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 257250645 1095650894 1951223117 2806795340 2806795340 1951223117 1095650894 257250645 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
		offset: 0@0)! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:34'!
windowIcon
	"Private - Generated method"
	^ icons
			at: #'window'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self windowIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/7/2014 09:41'!
glamorousClose
	^ self glamorousCancel! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallPaintIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAG2SURBVDjLY/j//z8DJZgsTUdm
CkodmSV7eO8EkQayNN8+WPry3YOV/3d2ib0nVbMsUPPrT8/3/n9+Nun/1hbxP6Rolr99sOTt
Z6DmD7cLwZrXVUt5kKb5xb7/P17U/b+4xu4/UHMRUYEI1KwK1PwOpvnSOgeQ5vlExQJQs8at
A8UfPr+EaL662QWk+diSPDlWnAZsWjufedOaORyHZ0lrgzR/ebkfrPnWbm+Q5odAzYJY0wFQ
I+OmtXN5N62ZVbJpzYzrB2bIfX5zaxJY86NjYSDN34CaVbEmpN4lK5hWrJonBtS8ddOaeT82
rZn9b8vSmn87u6X+393n///gdKP/QM3OOFNi95Jlks0Ll6+bOG/l//OXzv7/8+ny/09PD/zf
PD/vHtTmVJxJuXfxErbW+UuyG6Yu+T9t15X/rQt2/k/t2vK/ctKa/0Utk7YuyFeXxpsX6qcv
Xdswe/3/tpXH/neuv/a/cu7J/9E9V//7Fi57n1w+QY1gZsppnfMvqWb6/8iSyf8Dcyb8907r
+R+QO2tbbNHEIKJz46bF5SybFhVZbVqY17BpfqbEpnmpfJvmJfESYwAA/ZPGvT+K5AYAAAAA
SUVORK5CYII='! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:24'!
separatorIconContents

	^ (Form
		extent: 24@5
		depth: 32
		fromArray: #(16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1329216058 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1329216058 3869089181 4291019715 4291019715 4291019715 4291019715 4291019715 4291019715 4291019715 4291019715 4291019715 4291019715 4291019715 4291019715 4291019715 4291019715 4291019715 4291019715 4291019715 4291019715 4291019715 4291019715 4291019715 4291019715 3869089181 1329216058 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1463828544 1329216058 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
		offset: 0@0)! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloDupIcon
	"Private - Generated method"
	^ icons
			at: #'haloDup'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self haloDupIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloScaleIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/haloScale.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQAQMAAAAlPW0iAAAABlBMVEX///8AAABVwtN+AAAA
GklEQVR4XmNABvwXGDgCEAjIZRBg4P+ArAQAYQsELjspgUgAAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousUp
^ self icons
		at: #glamorousUp ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1627389952 1627389952 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 771751936 4127195136 4127195136 771751936 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 218103808 3640655872 4278190080 4278190080 3640655872 218103808 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2852126720 4278190080 4278190080 4278190080 4278190080 2852126720 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1828716544 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 1828716544 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 956301312 1073741824 1073741824 4278190080 4278190080 1073741824 1073741824 956301312 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloMenuIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/haloMenu.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQAQMAAAAlPW0iAAAABlBMVEX///8AAABVwtN+AAAA
E0lEQVR4XmOAA/4PUMQhgE4iAQClMwZDP3yc0QAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallJumpIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAC5SURBVDjLY/j//z8DJZhh1ADs
BjjsspIC4gb77ZZX7TdbXLVda9Zgs8xEihQDGmZfm/7/0KOD/3ff3/V/6plJ/y3mGjYQbYD9
NsurBx4e+D/10tT/nWc6/i+5sui/+RS9q0QbYLfB/OrWO1v+d5/p+t96qvn/3Auz/pt0aRNv
gPVyk4appyf+X3xl4f/ZF2b+n3Co579+mSrxXrCcZyhlMV2/wbRP56pRq+ZV3SLlBq1EOanR
lEgjAwAXIuIDq5qm/AAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallStrikeOutIconContents
	"Private - Method generated with the content of the file smallStrikeOut.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABl0
RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAAE9SURBVDiNldO/K/5RFMDxF49f
iUHf/JhkkUkpPwaD7BaTkk3Z/AUGizIp5S+wyGy0UQaFRd9MFrFQnkgIcQ2f8+jj6fOQW6d7
u+ec9zn33HOklFQE3VjHHsq4wz42MJa3/fLJOY/gEgkPOMP/OCd8YKkQgBJuwnAZzTlwAxbw
FvqhIsBEKE9RV5gqq2Gzkr9vkK3+2C9SWBesbQzi5dtt2PcG/R0zRRnUkjp0YACLmAvuNQ5D
jvBYkNFJSukNpiP6X6WnUoNyfFcpR29BO9riXFlPuMIzXr9q8JPgH+bjWQkHVXolTGH2F1BX
RH5HZ3Uf3Ad98BfIXthNVgN2QrGJ+hrOrbK2fpDv1FCORlESdjGMptA1YlzWpQlbtYZpLqpc
+aYXnOfACcfoKAQEpA9rEa0sG6Bb2UgvoFT9tE9NmYDjaYSwiQAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: 'private - utilities' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
exportIcon: image asPNGNamed: aString
	"self exportIcon: self newIcon asPNGNamed: 'newIcon'"

	| writer |
	writer := PNGReadWriter on: (FileStream newFileNamed: aString, '.png').
	[ writer nextPutImage: image]	
		ensure: [writer close]! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
blankIconOfWidth: aNumber 
	^ icons
		at: ('blankIcon-' , aNumber asString) asSymbol
		ifAbsentPut: [Form extent: aNumber @ 1 depth: 8]! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:43'!
classVarsUnselectedIcon 
	^ icons
			at: #'classVarsUnselectedIcon'
			ifAbsentPut:[ self classVarsUnselectedIconContents ].! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousDropDown
^ self icons
		at: #glamorousDropDown ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1267896978 4287795858 4287795858 4287795858 4287795858 4287795858 1267896978 0 0 0 0 0 0 0 0 0 261724569 4019360402 4287795858 4287795858 4287795858 4019360402 261724569 0 0 0 0 0 0 0 0 0 0 1452577940 4086469266 4287795858 4086535059 1469289363 0 0 0 0 0 0 0 0 0 0 0 0 3247674259 4187132562 3264385682 0 0 0 0 0 0 0 0 0 0 0 0 0 546805655 4002648979 546805655 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: (0@0))]! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:51'!
stringIcon 
	^ icons
			at: #'stringIcon'
			ifAbsentPut:[ self stringIconContents ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
paintTabIcon
	"Private - Generated method"
	^ icons
			at: #'paintTab'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self paintTabIconContents readStream) ].! !

!ThemeIcons methodsFor: 'initialization' stamp: 'MarcusDenker 10/31/2014 10:42'!
initializeIcons
	icons :=  LRUCache new 
		maximumWeight: 64;
		factory: [ :key | self perform: key];
		yourself
! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallDeleteIcon
	"Private - Generated method"
	^ icons
			at: #'smallDelete'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallDeleteIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:28'!
smallLeftFlushIcon
	"Private - Generated method"
	^ icons
			at: #'smallLeftFlush'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallLeftFlushIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:21'!
collectionIconContents
	^ ((ColorForm
	extent: 12@12
	depth: 8
	fromArray: #( 168952850 171324982 909522486 255008812 271977989 285543990 706029348 70649368 724044854 254681884 271986469 689508662 135534100 137758237 890965046 909522486 909513472 436212534 909508866 151126326 909522486 909511457 807338806 909522486 909521969 841353526 909522486 909511458 504824630 909522486 909511943 755436854 909522486 909522486 909522486 909522486)
	offset: 0@0)
	colorsFromArray: #(#(0.565 0.764 0.538) #(0.992 0.98 0.934) #(0.957 0.879 0.549) #(0.953 0.867 0.514) #(1.0 0.569 0.286) #(0.577 0.772 0.553) #(0.557 0.761 0.53) #(0.957 0.875 0.538) #(1.0 0.949 0.914) #(0.937 0.827 0.369) #(1.0 0.953 0.922) #(0.953 0.871 0.53) #(0.542 0.753 0.518) #(0.992 0.98 0.926) #(0.937 0.965 0.934) #(1.0 0.678 0.466) #(1.0 0.667 0.451) #(0.408 0.678 0.372) #(1.0 0.694 0.494) #(0.93 0.961 0.926) #(1.0 0.682 0.478) #(0.918 0.631 0.447) #(1.0 0.557 0.271) #(0.848 0.757 0.384) #(0.545 0.745 0.506) #(0.561 0.686 0.522) #(0.392 0.671 0.357) #(0.466 0.659 0.423) #(0.887 0.53 0.298) #(0.514 0.71 0.474) #(0.807 0.737 0.458) #(0.887 0.796 0.423) #(0.91 0.628 0.443) #(0.93 0.84 0.466) #(0.894 0.804 0.435) #(0.831 0.553 0.372) #(0.823 0.542 0.357) #(0.643 0.772 0.604) #(0.804 0.733 0.443) #(0.871 0.588 0.408) #(0.498 0.698 0.462) #(0.612 0.733 0.573) #(1.0 0.577 0.306) #(0.639 0.764 0.6) #(0.926 0.569 0.337) #(0.937 0.823 0.353) #(0.937 0.581 0.349) #(0.419 0.686 0.388) #(0.883 0.811 0.53) #(0.894 0.823 0.534) #(0.848 0.776 0.494) #(0.973 0.612 0.38) #(0.941 0.831 0.384) #(0.573 0.694 0.534) #( ) ))! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'CamilloBruni 9/14/2013 16:10'!
smallAddIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAJvSURBVDjLpZPrS5NhGIf9W7Yv
BYOkhlkoqCklWChv2WyKik7blnNris72bi6dus0DLZ0TDxW1odtopDs4D8MDZuLU0kXq61Ci
jSIIasOvv94VTUfLiB74fXngup7nvrnvJABJ/5PfLnTTdcwOj4RsdYmo5glBWP6iOtzwvIKS
WstI0Wgx80SBblpKtE9KQs/We7EaWoT/8wbWP61gMmCH0lMDvokT4j25TiQU/ITFkek9Ow6+
7WH2gwsmahCPdwyw75uw9HEO2gUZSkfyI9zBPCJOoJ2SMmg46N61YO/rNoa39Xi41oFuXysM
fh36/Fp0b7bAfWAH6RGi0HglWNCbzYgJaFjRv6zGuy+b9It96N3SQvNKiV9HvSaDfFEIxXIt
nPs23BzJQd6DDEVM0OKsoVwBG/1VMzpXVWhbkUM2K4oJBDYuGmbKIJ0qxsAbHfRLzbjcnUbF
BIpx/qH3vQv9b3U03IQ/HfFkERTzfFj8w8jSpR7GBE123uFEYAzaDRIqX/2JAtJbDat/COkd
7CNBva2cMvq0MGxp0PRSCPF8BXjWG3FgNHc9XPT71Ojy3sMFdfJRCeKxEsVtKwFHwALZfCUk
3tIfNR8XiJwc1LmL4dg141JPKtj3WUdNFJqLGFVPC4OkR4BxajTWsChY64wmCnMxsWPCHcut
KBxMVp5mxA1S+aMComToaqTRUQknLTH62kHOVEE+VQnjahscNCy0cMBWsSI0TCQcZc5ALkEY
ckL5A5noWSBhfm2AecMAjbcRWV0pUTh0HE64TNf0mczcnnQyu/MilaFJCae1nw2fbz1DnVOx
yGTlKeZft/Ff8x1BRssfACjTwQAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloDupIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/haloDup.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQAQMAAAAlPW0iAAAABlBMVEX///8AAABVwtN+AAAA
IUlEQVR4XmNABvINDAJA9INBoINBkINBnoOBEYh+ICsBAGU3BBJiY6CZAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
checkBoxOnIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/checkBoxOn.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAAAwAAAAMAQMAAABsu86kAAAABlBMVEUAAAAAAAClZ7nPAAAA
AnRSTlMA/1uRIrUAAAAfSURBVHheY/j/gaFBnqFBgmH+DIb5M1FQgyRI/P8PAPXgDZ601IAT
AAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallUnderlineIconContents
	"Private - Method generated with the content of the file smallUnderline.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABl0
RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAADaSURBVDiN7dMxSkNBEAbgb8UY
wUrwADZ2QsAbWIl4AcGzeI9gZSmpbFJ7Am1jE4hYCAoWWoiCGYs3Jk94SYRYOjDMzuw//+6w
/0ILl+mtiDDLcZa47VrNOiK9vYBglLjOd23FkvZP8EcEH6qngc0F+I2M7xOCiBjjJfOdWZ2l
lDVsZfpcvwHcZNybc/p+xvuIeJxUU2EnqjHecNigwF3cJub0x14N1DWV9AP6Kt1f4zPrPaw2
EiTJAc4xwFPOOsAFjpr+R0FBZ87sTTaMiFfZ3MZdrn9rxxFxBV+mVKeTcAXyQwAAAABJRU5E
rkJggg=='! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallNewIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAGSSURBVDjLlZO7S8NQGMVb/weR
goI4iIuCVuoiuBfBwUFwaosPqJODk5OLBVutSlMsuDg4OVWkYO3o4Cha/BNS+qLP9K3HnEtT
07f94HATcs8v33eSawBgUGtSlVmVZYimVY3Ro8nQBJgrlUq2Xq9/NxoN9JL6HD6f76oTogEs
NBeLRSiK0lIul0Mmk0E8HheQWCwGSZLaICwjAdxQLpdRrVbFShUKBWSzWSQSCQEolUrgSwKB
gIB0AWjWRAAN+XweyWSya6RmJsY2gDpGawOvObc2SiqVEp3Istwf0Ck9hJ0wj3Q6/X+AHsJx
mAlBIwGoWq0mciGEGhnALkJvDzgK2LB3sQH7mRWrjtmbgQCaNAVf73HyYMdTVMK7HIb3xYkt
7zxWDkyeoQC273BbEfy8RPDrGixPZBfeyD4B5aFfgVo/XkQoegt9PX5IBEAP+OmXwdrhDNxh
B1xhmzC7nm1/HTR/x2U1ZUXd3PMw+YOn2PTM4Ty8I97MlfcigyZgipBBR3lhe/zO4jQpbJvr
kn3CT+8vh7avwsYhJlIAAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:18'!
abstractIconContents
    ^(Form
	extent: 12@12
	depth: 32
	fromArray: #(16777215 16777215 369098752 1912602624 2717908992 3019898880 3640655872 3841982464 3674210304 3405774848 385875968 16777215 16777215 1811939328 1845493760 352321536 16777215 16777215 134217728 2432696320 3539992576 3590324224 16777215 16777215 1442840576 2264924160 16777215 16777215 16777215 50331648 2667577344 1241513984 3053453312 2952790016 16777215 16777215 3154116608 1543503872 16777215 16777215 16777215 1509949440 2617245696 16777215 3422552064 2650800128 16777215 16777215 4060086272 2399141888 16777215 16777215 16777216 3523215360 671088640 16777215 3607101440 2399141888 16777215 16777215 3439329280 1325400064 16777215 16777215 1342177280 3019898880 16777215 16777215 3472883712 2533359616 16777215 16777215 436207616 16777215 16777215 16777215 3087007744 1426063360 16777215 16777215 3238002688 2952790016 16777215 16777215 16777215 16777215 16777215 520093696 4244635648 4060086272 4026531840 3825205248 3690987520 3472883712 16777215 16777215 16777215 16777215 16777215 2231369728 1996488704 16777215 16777215 16777215 2483027968 3992977408 16777215 16777215 16777215 16777215 201326592 3321888768 134217728 16777215 16777215 16777215 1962934272 4278190080 318767104 16777215 16777215 771751936 2583691264 922746880 83886080 16777215 16777215 16777215 1090519040 4278190080 2617245696 1811939328 1929379840 3707764736 3875536896 3254779904 201326592 16777215 16777215 16777215 134217728 3791650816 2214592512 419430400)
	offset: 0@0)! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'TudorGirba 2/20/2015 07:35'!
glamorousDiveRightIcon
	"Private - Generated method"
	^icons 
			at: #glamorousDiveRightIcon
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousDiveRightIconContents readStream) ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallErrorIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QAAAAAAAD5Q7t/AAAA
CXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1QsKCTIOk1O0sAAAAhpJREFUOMudk71Pk1EU
xn/3bQvlo76gxBpNoGibArYLxJREh466MmnSgRH+IjsydGYjspBAWEQHMJIWmmhj+LAkpC1N
Wyj2PcfhfUsQiRpPcnOTm/P8nuQ59xhuVA5SwDyQBsa95xKwDixlYOt6v7khfjscCi1MJpME
w2F8AwOoKp2zM87LZYqFAtVmM5uBxd8AOXg3nUy+HJmZ4XJ7G+f0FBwHVUUMWEN38U9NUt3d
5VOxuJqBVwC+rvN0Mvn6XixGe3MTbTRABFVBRUEEabboHHyjPxbDtqzoi2r1wTKsmBykhkOh
98/m5rhYW0OdDqqKKqh6YgXFhakxBFMpPm9sUGu1Zi1gfjKR4HJnB3UcEFABFXEP6oEUVMFx
uMjneTwWAZj3A+lg+D4/PnxERRkrf+dPtW/fQao1Ag8fAaT9wLjVP4iKG9jfSkRR7WB6AgDj
FnCV9r8A8PpUBQA/UOrUzyYUg6rDl5ERt0HEvVE3PDdVRN0gtdkCKFnA+vnJCcYeuiL/Iu46
iidWwRocpF2rAaxbwNL+3h6BeNwly3WRNzrtTkNQY/BHIpQODwGWrAxs1VqtbKWQp2fqqQu5
5op3qygYQ080RuPggHq7nc3Alg9gGVaeVyqzts8XHUgkcBoN5KJ99RMVMHaI3vgEjXKZwvHx
agbe3LpMdl/fwpPRUQK2jentRUVwmk069Tpfj466zou3buP/rPNPwkdmHrlYdncAAAAASUVO
RK5CYII='! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'BenjaminVanRyseghem 3/28/2014 17:47'!
classVarsSelectedIconContents

	^ (Form
		extent: 24@24
		depth: 32
		fromArray: #(16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 252802884 1091859003 1947497019 2803135292 2803135292 1947497019 1091859003 252802884 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 100696107 2249552445 4212421692 4279530300 4279530300 4279530300 4279530300 4279530300 4279530300 4212421692 2249552445 100696107 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 806712634 3524621117 4279530300 4263606851 4283405660 4285441644 4287412092 4287412092 4285441644 4283405660 4263606851 4279530300 3524621117 806712634 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 806712634 4178867004 4279530300 4282748758 4288331652 4288988553 4288988553 4288988553 4288988553 4288988553 4288988553 4288331652 4282748758 4279530300 4178867004 806712634 16777215 16777215 16777215 16777215 16777215 16777215 16777215 100696107 3524621117 4279530300 4285113450 4288988553 4288988553 4289251214 4290631081 4291485115 4292142279 4291616445 4290499751 4289054090 4288988553 4285113450 4279530300 3524621117 100696107 16777215 16777215 16777215 16777215 16777215 16777215 2249552445 4279530300 4282551637 4288397444 4288397444 4290696879 4294244593 4294967295 4294967295 4294967295 4294967295 4294967295 4293981933 4288397444 4288397444 4282551637 4279530300 2249552445 16777215 16777215 16777215 16777215 16777215 252802884 4212421436 4263475522 4286886519 4287412091 4290434224 4294967295 4294967295 4294901502 4292536533 4291091131 4291616709 4293324771 4294507511 4287412091 4287412091 4286886519 4263475522 4212421436 252802884 16777215 16777215 16777215 16777215 1091859003 4279530300 4282420050 4286492274 4287608964 4294638841 4294967295 4294835965 4288594581 4286492274 4286492274 4286492274 4286492274 4288397458 4286492274 4286492274 4286492274 4282420050 4279530300 1091859003 16777215 16777215 16777215 16777215 1947497019 4279530300 4283273816 4285506921 4289185956 4294967295 4294967295 4291354054 4285506921 4285506921 4285506921 4285506921 4285506921 4285506921 4285506921 4285506921 4285506921 4283273816 4279530300 1947497019 16777215 16777215 16777215 16777215 2803135292 4279530300 4283668058 4284521824 4290434490 4294967295 4294967295 4288857762 4284521824 4284521824 4284521824 4284521824 4284521824 4284521824 4284521824 4284521824 4284521824 4283668058 4279530300 2803135292 16777215 16777215 16777215 16777215 2803135292 4279530300 4282879827 4283536471 4290040247 4294967295 4294967295 4288332189 4283536471 4283536471 4283536471 4283536471 4283536471 4283536471 4283536471 4283536471 4283536471 4282879827 4279530300 2803135292 16777215 16777215 16777215 16777215 1947497019 4279530300 4281434695 4282551118 4287346835 4294967295 4294967295 4290368702 4282551118 4282551118 4282551118 4282551118 4282551118 4282551118 4282551118 4282551118 4282551118 4281434695 4279530300 1947497019 16777215 16777215 16777215 16777215 1091859003 4279530300 4280778307 4282617166 4284128100 4294376183 4294967295 4294901502 4286033279 4282617166 4282617166 4282617166 4282617166 4285441911 4282617166 4282617166 4282617166 4280778307 4279530300 1091859003 16777215 16777215 16777215 16777215 252802884 4212421436 4263015742 4282551886 4282749007 4287412882 4294967295 4294967295 4294901758 4291420108 4289055146 4289974967 4292668126 4294244597 4282749007 4282749007 4282551886 4263015742 4212421436 252802884 16777215 16777215 16777215 16777215 16777215 2249552445 4279530300 4280647235 4282880848 4282880848 4286756488 4293390824 4294967295 4294967295 4294967295 4294967295 4294967295 4292865249 4282880848 4282880848 4280647235 4279530300 2249552445 16777215 16777215 16777215 16777215 16777215 16777215 100696107 3524490044 4279530300 4281567305 4283012690 4283012690 4283341143 4285902715 4287676309 4288989864 4287873433 4285705593 4283078227 4283012690 4281567305 4279530300 3524490044 100696107 16777215 16777215 16777215 16777215 16777215 16777215 16777215 806712634 4178867004 4279530300 4280778820 4282881617 4283144531 4283144531 4283144531 4283144531 4283144531 4283144531 4282881617 4280778820 4279530300 4178867004 806712634 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 806712634 3524490044 4279530300 4263081534 4281041990 4281896267 4282684752 4282684752 4281896267 4281041990 4263081534 4279530300 3524490044 806712634 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 100696107 2249552445 4212421436 4279530300 4279530300 4279530300 4279530300 4279530300 4279530300 4212421436 2249552445 100696107 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 252802884 1091859003 1947497019 2803135292 2803135292 1947497019 1091859003 252802884 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
		offset: 0@0)! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'BenjaminVanRyseghem 12/5/2013 12:33'!
uncheckedBoxIcon
	"Private - Generated method"
	
	^ icons
			at: #uncheckedBox
			ifAbsentPut: [ Form
				extent: 12@12
				depth: 32
				fromArray: self uncheckedBoxIconContents 
				offset: 0@0 ]! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:30'!
smallRedoIcon
	"Private - Generated method"
	^ icons
			at: #'smallRedo'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallRedoIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:49'!
magnitudeIcon 
	^ icons
			at: #'magnitudeIcon'
			ifAbsentPut:[ self magnitudeIconContents ].! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
upArrowIconContents
	"Private - Method generated with the content of the file graphics\icons\upArrow.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAABGdBTUEAALGPC/xhBQAAABh0
RVh0U29mdHdhcmUAUGFpbnQuTkVUIHYzLjM2qefiJQAAAH1JREFUSEtj/A8EDLQEIAtIAUC3
kKL8P2mqIb6lnQUgw2GYWFtIcg5NLWhoaIC7HmQRiE8MINoHyK4nJZiIsgCb4cRaMvAWODg4
oIQ9um9A8vgAUT6AGUDTVAQtUoZwPhj1ATG5HiW5EqUBVPoSq3A0DogKqdGcTFQwkaoIAGEN
sTct/gBTAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:27'!
smallInspectItIcon
	"Private - Generated method"
	^ icons
			at: #'smallInspectIt'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallInspectItIconContents readStream) ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
publishIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAGdSURBVDjLlZNLSwJhFIa1Rb8i
IWhRQUlluuoftDEtC5TKSgINily1CmoT0kJBqwlSaBGBLVxItGgZQQQVFe3bKN7wOjqO2tuc
wRGvqAMPMzDf+8w5ZzgyADLhGhJQCWi6MCwwQBkJWVWg4jguVSqVKuVyGe0Q3sPtdruaJZJA
Q+FcLgeWZWuk02kkk0lEIhFREg6H4fF4GiR0yUlABwqFAorFongnstksUqkUotGoKMjn86CP
MAwjSloEFJYgAQUymQxisVhLS9WZyBsEQhu1A/RMfUutxONxsZJQKNRZ0Ey9hCqheSQSid4F
9RJqh2ZCor4EBM/z4lxIQvQtoCp2HtexfW+CObAM062uu4BCElSBJWjEzc8Vrr8Y6L3zvQso
TKz6F+H7PAPz7oLRp8eodmSjp7/geDqG2b8Me9CK8zcnXK8O7AWsmDtUF9UHUw/1gr+2O8Bz
sPm3YLvbhPPlBI7nI6xc6jC9P/Gr3B0flHZhVpgyKwQ6LpPFtwaTdwmGCy0MpwsVWsD6ZVKQ
pNs6z9iV35PWsY/q6iso+w9crJoc0rRwaAAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousOpen
^ self icons
		at: #glamorousOpen ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 620756992 3204448256 436207616 0 0 0 0 0 0 0 0 0 0 0 0 620756992 3841982464 4278190080 3657433088 436207616 0 0 0 0 0 0 0 0 0 0 620756992 3841982464 4278190080 4278190080 4278190080 3657433088 436207616 0 0 0 0 0 0 0 0 620756992 3841982464 4278190080 4278190080 4278190080 4278190080 4278190080 3657433088 436207616 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 0 0 4278190080 0 4144103938 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4244635648 268435456 0 4278190080 0 2265187332 4049033047 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4253188738 3054769172 0 4278190080 0 218103808 4026992391 4291940817 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294375158 4145222419 905969664 4278190080 0 0 1778384896 4013504825 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4288519581 3507622418 4278190080 0 0 67108864 3792242953 4290361785 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294835709 4129563684 4278190080 0 0 0 671088640 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4261741829)
	offset: (0@0))]! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:23'!
magnitudeIconContents
	^ ((ColorForm
	extent: 12@12
	depth: 8
	fromArray: #( 874447653 738461995 85013556 875824136 573444634 471217204 875826957 607204404 875115572 875836464 489816628 875836468 875836468 50409268 875836468 875836468 268902708 875836468 875836418 101004340 875836468 875836448 167851060 873804852 875825163 204747815 874722356 875763995 321259818 335557684 875042605 102243847 930868 875836468 875836468 875836468)
	offset: 0@0)
	colorsFromArray: #(#(0.372 0.372 0.372) #(0.608 0.608 0.608) #(0.961 0.961 0.961) #(0.506 0.506 0.506) #(0.588 0.588 0.588) #(0.415 0.415 0.415) #(0.419 0.419 0.419) #(0.384 0.384 0.384) #(0.745 0.745 0.745) #(0.561 0.561 0.561) #(0.447 0.447 0.447) #(0.435 0.435 0.435) #(0.427 0.427 0.427) #(0.545 0.545 0.545) #(0.522 0.522 0.522) #(0.902 0.902 0.902) #(0.761 0.761 0.761) #(0.53 0.53 0.53) #(0.686 0.686 0.686) #(0.628 0.628 0.628) #(0.181 0.181 0.181) #(0.204 0.204 0.204) #(0.604 0.604 0.604) #(0.455 0.455 0.455) #(0.408 0.408 0.408) #(0.341 0.341 0.341) #(0.659 0.659 0.659) #(0.333 0.333 0.333) #(0.663 0.663 0.663) #(0.624 0.624 0.624) #(0.396 0.396 0.396) #(0.875 0.875 0.875) #(0.542 0.542 0.542) #(0.592 0.592 0.592) #(0.569 0.569 0.569) #(0.236 0.236 0.236) #(0.565 0.565 0.565) #(0.494 0.494 0.494) #(0.62 0.62 0.62) #(0.953 0.953 0.953) #(0.733 0.733 0.733) #(0.502 0.502 0.502) #(0.298 0.298 0.298) #(0.451 0.451 0.451) #(0.585 0.585 0.585) #(0.439 0.439 0.439) #(0.698 0.698 0.698) #(0.714 0.714 0.714) #(0.721 0.721 0.721) #(0.855 0.855 0.855) #(0.474 0.474 0.474) #(0.871 0.871 0.871) #( ) ))! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloFontStyleIcon
	"Private - Generated method"
	^ icons
			at: #'haloFontStyle'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self haloFontStyleIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:28'!
smallNewIcon
	"Private - Generated method"
	^ icons
			at: #'smallNew'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallNewIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloRecolorIcon
	"Private - Generated method"
	^ icons
			at: #'haloRecolor'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self haloRecolorIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
volumeIconContents
	"Private - Method generated with the content of the file /home/dgd/volume.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAQAAABKfvVzAAAABGdBTUEAALGOfPtRkwAAACBj
SFJNAAB6JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAAAmJLR0QA/4ePzL8A
AAAJcEhZcwAACxMAAAsTAQCanBgAAAHrSURBVDjLldTLahRBFMbx/xu02hEvm1mZIC4qovaA
LhoE142+QIMvILoRgjASdKEilSBxO5CFIhKbmUAQNWmD6KCQxCAMEi+JGGKISuETfC665uIM
DqRqd6hfn9Nd5zRidxsBV/jOH5rc5QhjJBDwnyUQ43xmix9ssMo8GRiygaBBg0dMM887FsCE
jvyfUwEZaRdY5CrDnOUyt8GE7pbaIKEEgEGYNnjpowmYIXdfeQfErJMAUCliArFMAJwEM+Sm
9V5r6iopIC+eXdDiK1lycux+90Qb2tavAlQxFxgBwwoAl8haIH+sTKN6oZ/6rW1ttjJYzEMO
QZUEKPnTgnxHmzqjHW3pm77ooxApEFC9QwoxVV+U8eCTmirrq9bU1KqWVNZBEewDe55JwGfM
iT1Y0hud0gct661ea1HndEzEQOUiUxzoBwt6quNq6JVyPdOcTuuwCE6AtUywpx/Mqq5RPdec
ZlVTTTjSBxBgp7gGCRYA136HG7qpYU2qrppqqou8VtxAcI8RyDBACddzD6GzbTAOFYIxjkLs
C6pQbYHWMqGbUF11kcNeH2OdEhDgiHsBmNBZzXRaI2XFN4YtWr4LREREYEJ3vQNKfpRSXNGh
PaBMBIb+ebA+Tz/wZPDE0ZMjgiAaBHb919jd/gvLk2YJrn7DBgAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallOkIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAGrSURBVDjLvZPZLkNhFIV75zjv
Ym7VGFNCqoZUJ+roKUUpjRuqp61Wq0NKDMelGGqOxBSUIBKXWtWGZxAvobr8lWjChRgSF//d
v9be+9trCwAI/vIE/26gXmviW5bqnb8yUK028qZjPfoPWEj4Ku5HBspgAz941IXZeze8N1bo
ttSo8BTZviVWrEh546EO03EXpuJOdG63otJbjBKHkEp/Ml6yNYYzpuezWL4s5VMtT8acCMQc
b5XL3eJE8VgBlR7BeMGW9Z4yT9y1CeyucuhdTGDxfftaBO7G4L+zg91UocxVmCiy51NpiP3n
2treUPujL8xhOjYOzZYsQWANyRYlU4Y9Br6oHd5bDh0bCpSOixJiWx71YY09J5pM/WEbzFcD
mHvwwBu2wnikg+lEj4mwBe5bC5h1OUqcwpdC60dxegRmR06TyjCF9G9z+qM2uCJmuMJmaNZa
UrCSIi6X+jJIBBYtW5Cge7cd7sgoHDfDaAvKQGAlRZYc6ltJlMxX03UzlaRlBdQrzSCwksLR
bOpHUSb7pcsnxCCwngvM2Rm/ugUCi84fycr4l2t8Bb6iqTxSCgNIAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:34'!
versionControlIcon
	"Private - Generated method"
	^ icons
			at: #'versionControlIcon'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self versionControlIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
radioButtonOffIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/radioButtonOff.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAAAwAAAAMAQMAAABsu86kAAAABlBMVEUAAAAAAAClZ7nPAAAA
AnRSTlMA/1uRIrUAAAAgSURBVHheY5BvYFBwZHBQYmgQYWiQQEEOGgwKLgzyTQBytAZcv+h0
jwAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:46'!
haltIcon 
	^ icons
			at: #'haltIcon'
			ifAbsentPut:[ self haltIconContents ].! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/14/2013 13:02'!
protocolExtensionIcon
	^ self protocolNoneIcon ! !

!ThemeIcons methodsFor: '*Versionner-Spec-Browser' stamp: 'TorstenBergmann 2/12/2014 17:42'!
configIconDirtyContents

	^'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAADE0lEQVR42nWTa0hTYRjH/++2
46ZpU9OZZV7wnqTigqw009SsLCztoliK+UnpQlFU9CkSgqIv0YcytQtZdKEwg9A+WHTVaRmV
YjPnreW2cjvucrazs/U6sCLzgZfn5Zzn/zvP8/A/BHNEbIRf0sHy+NM+UrHf2at9Rz5/Zd/9
r478+2CBv1Sxe0vU/rINEbWRydv9BZsBY/1t5jttY5eutQ6f1/20f/svgJGImK15Syqrt0Uf
TVpeFBOSWAKRS4BZqwIjFUOn7kBf76vha60j5x48m2jgHILtNyBDqciv2Rl3clVGTmZIQjFk
AbGA2wHn5BcMddRhydLVEPlEwG7RY0LdjdedXW+vPBqre947+YicOZzWtDVncUVQzC4iC1wG
bsoAk74PgsMM3qKFlNixMDwe4CYh9g2HSOYHVjvgAT1sf3+LfGop5BPzL0p4KjRrX8LlYOGY
0sPKavFjdBxpuy6A8Z4HWDRwW9Qg1hFAngwnN4Su1rtO0nV7vTGtqF4u4lnwJjVs+s+Q0K8C
dkwOf4RCWQ2G8aIdjFPAIGzaNzBzAmSRxVC11JtIZ3OeUVnUIBe5ODo3Twu/g9Op4DJrYNaP
IjAuGxKRG47vTzHFGuH09gecUsiCM6F63GAib2+sMyqLm+RilwVw0cUKDlrAwmnsh/XbC8gI
Cxs/BafMFwLnokeg7xnIQrPR/aTRRN5cXWtcvuO6XCywVGz56zjgpt4x/VSh6tCnufwG8u5m
tj1lR7MX4a107DFKp1kw02yHm0J/jLdgz74PmMcoPILm540oW1PluVucOpDLx1Pac3ILchcl
FMA7IIzugBrNRkEu2gEdy6Bpwfba92jveeIRzgCmc25aAQh1oNfmDEVFxfrQoykrC2PCkjdC
LGEAqxpuzoCJgfsorOlFVFC4RzQT0xCNYfiPlQPnM4rSnJADJRkLauLSi/0XpW4EeA7s6Guk
bzqF3sFnszpIjc6a/TNFh3onVeYFn8hLnV8anbWX2HQaZFXWQxkVN2sHPUMDswEzsSLeN798
beAxhsCr7t7E6rnqfgGXH2ZIRnFzTgAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallBoldIconContents
	"Private - Method generated with the content of the file smallBold.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABl0
RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAAELSURBVDiNndOxLkRREAbgb5Bg
RaJQqZREISERrYYH2JYQiUIlwWOotCqFROEFtpGIUsMb2BCRaESlWEaxe5Objb2b3UkmmTPz
n3PmP/+ZwA5OVFsLTTzhPDM/y8Vj5AD+geXMlJlG+tz8n83iqliM9QBd4BbjWMM+Jkr1pYiY
y8y3Xgc8ZOZ1J76MiBr2ujA19KcQEaNY7Eq/4LmKwlFE1Dttr2C6VHvHbma2isQgKnxhs1Bg
GBWm0YiIm4iYpPcbnGGj44faipStjtMqCgflNjGD7y7M4yAU5rX/RNmm6K3CdkSsduIFrP+D
ua+i0M9/sDXsLPxiPzMbBYVX3FVsSHziTXucG5nZLIp/7M1/esa2s1kAAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 13:56'!
smallFullscreenIcon
	"Private - Generated method"
	^ icons
			at: #'smallFullscreen'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallFullscreenIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:23'!
groupIconContents

	^ (Form
		extent: 15@16
		depth: 32
		fromArray:  #(16777215 16777215 16777215 16777215 16777215 16777215 741343023 3275816768 3075604305 610139997 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 206881045 2468937512 4198039352 4282777413 4283629394 4133486431 2422472547 160417763 16777215 16777215 16777215 16777215 16777215 16777215 1593774888 3892256563 3483734080 3963682109 4282777413 4283563857 3915905900 3816339156 3866464511 1668517887 16777215 16777215 16777215 704196930 3271492893 4294906665 4294909748 4294913088 4143399757 3482178394 3546861469 4234117372 4285237503 4286026495 4286881023 3448151551 544905471 16777215 2212050759 3705883738 3892062268 4294909748 4261359168 3506413903 4043306825 3959223899 3718624710 4285237503 4286026495 3933375999 3813831421 1295737599 16777215 2261264440 4291180100 4225057616 3505218398 3640584759 4294965305 4294965317 4294965585 4294965598 3673156994 3613359861 4248921854 4282673663 1329686527 16777215 2327257906 4289868607 4290721090 3821495878 4041136203 3623152977 4294965316 4261411153 3623876694 4110415943 4015421164 4283133695 4283988479 1397584383 16777215 2255301983 4187107390 4289344061 3887095105 4291281462 4292070714 4007252563 3942249295 4294965308 4294965575 4050224622 4284448511 4068575729 1386704574 16777215 2467771800 4146608763 3898423902 3969339963 4289900083 4290820917 4274767168 4294965068 4294965582 4294965594 4051670252 3704655548 4194271886 1526686578 16777215 2567710594 4279970659 4280431990 4180689000 4269180974 4289439538 4290491968 4294965343 4294965602 4173456753 4058746767 4294936466 4294939806 1593798010 67108864 2919241572 4278982722 4279641432 4280168537 4280713254 4282219052 4288322877 4292864882 4286898294 4286775170 4276918936 4294941604 4294944944 1694069631 83886080 1879052875 4177530951 4278653495 4279377983 4279984923 4280448802 4282093368 4287035781 4287299466 4288151447 4277119914 4294946743 3824456348 669148016 16777216 150994944 587202568 3288339543 4227928107 4279059213 4279654422 4281433136 4288216727 4288610206 4289462187 4109085865 2195417203 150994944 16777216 16777215 16777215 33554432 234881024 1207970826 3858781696 4278664199 4280771878 4289396393 4255841706 3111708280 407587627 33554432 16777215 16777215 16777215 16777215 16777215 16777215 67108864 352321536 2046839040 4028261914 3734040464 1028699728 67108864 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777216 117440512 251658240 117440512 16777216 16777215 16777215 16777215 16777215 16777215)
		offset: 0@0)! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'BenjaminVanRyseghem 12/5/2013 12:33'!
checkedBoxIconContents

	^ #(4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4292211711 4292211711 4292211711 4292211711 4292211711 4292211711 4292211711 4292211711 4292211711 4292211711 4287338155 4287338155 4292211711 4293655295 4293589503 4293589503 4293655039 4293589503 4293589503 4293655039 4289311430 4293655039 4287338155 4287338155 4292211711 4293720831 4293720831 4293786367 4293786111 4293786367 4293720831 4289311430 4283261051 4293720831 4287338155 4287338155 4292211711 4293851903 4293851903 4293917695 4293852159 4293917439 4289311430 4283261051 4289311430 4293852159 4287338155 4287338155 4292211711 4288061880 4294048767 4294049023 4294049023 4288061880 4282866552 4289311430 4294048767 4294048767 4287338155 4287338155 4288061880 4282144116 4286681256 4294180095 4286681256 4282209651 4289311430 4294245631 4294245631 4294180095 4287338155 4287338155 4292211711 4288061880 4281486958 4285300119 4281552495 4288061880 4294376703 4294376959 4294376959 4294376959 4287338155 4287338155 4292211711 4294573567 4286681256 4280895595 4286681256 4294573567 4294508031 4294573567 4294573567 4294573567 4287338155 4287338155 4292211711 4294704895 4294704895 4285300119 4294704895 4294704895 4294704895 4294639359 4294639359 4294639615 4287338155 4287338155 4292211711 4294836223 4294770431 4294770431 4294836223 4294835967 4294835967 4294770431 4294835967 4294770687 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155)! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallCenteredIcon
	"Private - Generated method"
	^ icons
			at: #'smallCentered'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallCenteredIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:34'!
arrowDoubleUpIcon 
	^ icons
			at: #'arrowDoubleUpIcon'
			ifAbsentPut:[ self arrowDoubleUpIconContents ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
lockIcon
	"Private - Generated method"
	^icons
			at: #lockIcon
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self lockIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:33'!
topIcon 
	^ icons
			at: #'topIcon'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self topIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:49'!
monticelloPackageIcon 
	^ icons
			at: #'monticelloPackageIcon'
			ifAbsentPut:[ self monticelloPackageIconContents ].! !

!ThemeIcons methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 6/7/2013 16:11'!
addIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAJvSURBVDjLpZPrS5NhGIf9W7Yv
BYOkhlkoqCklWChv2WyKik7blnNris72bi6dus0DLZ0TDxW1odtopDs4D8MDZuLU0kXq61Ci
jSIIasOvv94VTUfLiB74fXngup7nvrnvJABJ/5PfLnTTdcwOj4RsdYmo5glBWP6iOtzwvIKS
WstI0Wgx80SBblpKtE9KQs/We7EaWoT/8wbWP61gMmCH0lMDvokT4j25TiQU/ITFkek9Ow6+
7WH2gwsmahCPdwyw75uw9HEO2gUZSkfyI9zBPCJOoJ2SMmg46N61YO/rNoa39Xi41oFuXysM
fh36/Fp0b7bAfWAH6RGi0HglWNCbzYgJaFjRv6zGuy+b9It96N3SQvNKiV9HvSaDfFEIxXIt
nPs23BzJQd6DDEVM0OKsoVwBG/1VMzpXVWhbkUM2K4oJBDYuGmbKIJ0qxsAbHfRLzbjcnUbF
BIpx/qH3vQv9b3U03IQ/HfFkERTzfFj8w8jSpR7GBE123uFEYAzaDRIqX/2JAtJbDat/COkd
7CNBva2cMvq0MGxp0PRSCPF8BXjWG3FgNHc9XPT71Ojy3sMFdfJRCeKxEsVtKwFHwALZfCUk
3tIfNR8XiJwc1LmL4dg141JPKtj3WUdNFJqLGFVPC4OkR4BxajTWsChY64wmCnMxsWPCHcut
KBxMVp5mxA1S+aMComToaqTRUQknLTH62kHOVEE+VQnjahscNCy0cMBWsSI0TCQcZc5ALkEY
ckL5A5noWSBhfm2AecMAjbcRWV0pUTh0HE64TNf0mczcnnQyu/MilaFJCae1nw2fbz1DnVOx
yGTlKeZft/Ff8x1BRssfACjTwQAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 13:56'!
changeSorterIcon
	^ icons
			at: #'changeSorterIcon'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self changeSorterIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallBarcodeIcon
	"Private - Generated method"
	^icons
			at: #smallBarcodeIcon
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallBarcodeIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 13:55'!
calendarIcon
	^ icons
			at: #'calendarIcon'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self calendarIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 9/19/2013 13:01'!
changeAddIcon 
	^ self smallAddIcon
! !

!ThemeIcons methodsFor: '*Komitter-UI' stamp: 'EstebanLorenzano 12/13/2013 14:42'!
komitterIcon
	^ self blankIcon.! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallExportIcon
	"Private - Generated method"
	^ icons
			at: #'smallExport'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallExportIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousRemove
^ self icons
		at: #glamorousRemove ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2130706432 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 2130706432 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2130706432 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 2130706432 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
recentMessagesIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAMESURBVDjLpZNrSNNRGMb/ViR9
qw9FUSQFQX0IMshI9EMXJIIuZGFZGWZpqSHmxM25dNq8pk7LzTSdc1u6malo3vI6bHmZrmmp
0+mclrfNuTmvk3r6zw8rKfzSgQfec16e33vew3kJAMT/aN2msTDxjKzoaX1nOXXmczXd0lkR
bmkRB0/W5ASXlr4KP7UhQCqJ5XTXUlfGVK2YnhiCyWSA0ajHt5FudLcUovq137w4NZDxT0BT
IStNLefCoNNCpTXgbYMGnOKvSJd8gaBKja6BSWhUMlRmPwSPdT90HaBGEO8iL6dY9FMaSBXj
eNeogXrMBL3JDJ1pHqpREwS1apQ0D6NfUQVhzI2F7Fh/Rxugjh9WOUgm+kZmIKkfhnUZjEYM
fJ/AEhlbZf4JZFao0aLU4oMwBJkRNwU2QEP+44lxbQ+ENYPoJSsvrP6EeWEBGbk8TJGgueVl
FNc0QDpgRFKBEj3tYmTT3TU2QD0/cMmg/4ZEkRJTixYYln9ghczQopgQvitDWCQTtbI2hIjd
8IDniFFNG3Lp1xZtgOosvyX99BCYPAVGzRYS8gNjxjk8e568ZpYquqFbBQJEp8Es94RH5mHk
0Nx/A4pTvIaHeqrAlijRPGjEONn02JwFQSJXBAmd8SjfCT65xxFRch2SjjRQii7DLXU3XJN2
2K0B8lhevCYxFTLlAOIlKujIBzNYyIqCkyjt4qC48+WasbCDDXYdBfxPiXgocsOJOPvVozF2
dkROXMCx/GiPxX55PkRVnUiQ9EOhmYUP2a/VnFIbhITqALAqfRFV7o3o937IlMbgdp4LDkUS
K2t9ZDG9qW/ir6O3lYPGdjliea24lX0E4nY2RK3J4MsSkfsxnoT4gyuNhq/oPA4wiL69NGKb
7UdlRNxhZFGvmMu4nuiqZ+Eq9yAupO/DudRdcEnaDi+eMzjNUbgncIMDg1DuoRH2fw1TBsPb
KS3UveDFk0taLuXiolXWmE25Kj4as2n2Lv8sHOiEnDRv/ec0biTyyrr99M3YSSO2/Hn+CweZ
2kRiltpxAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallHelpIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAKkSURBVDjLpZPdT5JhGMb9W+BP
aK3matVqndXWOOigA6fmJ9DUcrUMlrN0mNMsKTUznQpq6pyKAm8CIogmypcg8GIiX8rHRHjh
VbPt6o01nMvZWge/k3vP9duuZ/edAyDnf/hjoCMP2Vr3gUDj3CdV6zT1xZ6iFDaKnLEkBFOm
PfaZArWT5sw60iFP+BAbOzTcQSqDZzsNRyCNkcVoaGghzDlVQKylOHJrMrUZ2Yf52y6kc36I
xpyoH1lHF7EBgyMKV4jCJ5U/1UVscU4IZOYEa3I1HtwI01hwxlDLhDoJD/wxGr5YGmOLAdRI
rVCuhmD3JdA6SQabx12srGB0KSpc86ew4olDOGjH4x4z0gdHDD9+c4TaQQtq+k2Yt0egXYug
TmoVZgV9cyHSxXTtJjZR3WNCVfcK/NE0ppYDUNu2QTMCtS0IbrsOrVMOWL27eNJtJLOCDoWX
dgeTEEosqPxoBK/TwDzWY9rowy51gJ1dGr2zLpS2aVH5QQ+Hbw88sZ7OClrGXbQrkMTTAQu4
HXqUv9eh7J0OSfo7tiIU+GItilpUuM/AF2tg98eR36Q+FryQ2kjbVhximQu8dgPKxPMoeTuH
4tfqDIWvCBQ2KlDQKEe9dBlGTwR36+THFZg+QoUxAL0jgsoOQzYYS+wjskcjTzSToVAkA7Hq
g4Spc6tm4vgT+eIFVvmb+eCSMwLlih/cNg0KmpRoGzdl+BXOb5jAsMYNjSWAm9VjwesPR1kn
FilPNMu510CkdPZtqK1BvJQsoaRZjqLGaTzv1UNp9EJl9uNqxefU5QdDnFNX+Y5Qxrn9bDLU
R6zjqzsMizeWYdG5gy6ZDbk8aehiuYRz5jHdeDTKvlY1IrhSMUxe4g9SuVwpdaFsgDxf2i84
V9zH/us1/is/AdevBaK9Tb3EAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloFontEmphIcon
	"Private - Generated method"
	^ icons
			at: #'haloFontEmph'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self haloFontEmphIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:29'!
smallPaintIcon
	"Private - Generated method"
	^ icons
			at: #'smallPaint'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallPaintIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
errorIcon
	"Private - Generated method"
	^icons
			at: #errorIcon
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self errorIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 6/20/2013 16:12'!
packageColoredIcon
	^ icons
		at: #packageColoredIcon
		ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self packageColoredIconContents readStream) ]! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:27'!
smallJumpIcon
	"Private - Generated method"
	^ icons
			at: #'smallJump'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallJumpIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:46'!
groupIcon 
	^ icons
			at: #'groupIcon'
			ifAbsentPut:[ self groupIconContents ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallFindIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAIlSURBVDjLY/j//z8DJZiB6gY0
9895tGTDnv+tE+f+B/EnL1gHZofGpt4iyoCK5r5H63YcBmkAG5BRVPO/b/aK/0CDn+A1ICm7
5H/X9CX/azun/m+bNP+/iaUd2AAHN5//WSV1/wuqWsFiVvauyxWUVHkEhUWZwAYsWLOTo6i2
3aOpbzbYqYXVbf89/MP+u3gF/M8pa/gfm5b3PyKn6X/txGX/S1qmgOW4uXmq2NjZGcEGTJi7
mmXKwvUPF63b9T+3vAmMqyeu+j9l+a7/fUu2/2qcvuF/be/8/9G5zf/DkwvBLmRmYXnAwMDA
DDYA6FxWkM3TFm/8n11a/x/k55Tc8v/RyTn/1bT0wDaCXAITj0svAOpi+AfErGAD0goqWf1C
Y35a2Dr99wqM+G9sYftfW9/4v6yC8lMRMXEDSRm5rWISUv+B/v4vKi75n5eP/z8jI+M7oAFM
8ED0CYo6DAq4XYfP/F+15cD/7hnLQAG2AiSnqqmzorJlwv+1Ow6B5UAxwscveBglFtx8gv/k
VzSDDQC66H98RuF/PWPzqyA5oM1XQTEAMiA1v+J/emH1fw5Orj8oBji6+/6HGQBTpKGt/1NR
RZ1RQlr2HSjgYAaAwoKVle0/igHWjm7geAYlIJACUGDqGpn9B/qfX0lV4wrIAFAsweSAYYBq
ACiBGJhYggMP6Of/QJv/S8sq/AcGohTQv7c5ubj/A+MdFH2gGABj2mUmUjEAnjJojQ5aPHUA
AAAASUVORK5CYII='! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousRefresh
^ self icons
		at: #glamorousRefresh ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 50331648 0 0 0 0 0 0 0 0 0 0 0 0 872415232 2952790016 3909091328 4160749568 3640655872 2348810240 285212672 0 0 0 0 0 0 0 0 1610612736 4278190080 1845493760 335544320 50331648 889192448 2667577344 4278190080 553648128 2181038080 1795162112 0 0 0 0 1241513984 3992977408 536870912 0 0 0 0 0 3003121664 4194304000 4143972352 2835349504 0 0 0 0 0 0 0 0 0 0 0 3808428032 4110417920 4278190080 4227858432 2063597568 0 0 0 0 0 0 100663296 0 0 0 0 3019898880 4127195136 4093640704 4160749568 1560281088 0 0 0 0 0 570425344 4278190080 2382364672 503316480 0 0 0 218103808 1862270976 4143972352 419430400 0 0 0 0 0 1610612736 4127195136 4160749568 4160749568 3640655872 0 0 0 0 0 0 0 0 0 0 0 2147483648 4244635648 4261412864 4127195136 3221225472 0 0 0 0 0 50331648 184549376 0 0 0 0 2969567232 4160749568 4143972352 2600468480 0 0 0 0 0 822083584 4278190080 1023410176 0 0 0 0 1409286144 1644167168 268435456 4278190080 3137339392 1342177280 452984832 788529152 2298478592 4278190080 1174405120 0 0 0 0 0 0 0 0 134217728 1929379840 3187671040 3774873600 3456106496 2516582400 503316480 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: (0@0))]! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
rotateIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/rotate.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABgAAAAWCAYAAADafVyIAAAAnUlEQVR4XuXUuxWAIAwF0FdY
pLBwHWdyJWdyJo0U8ieGYCPnxELBKyQRbtDAuC6EDQsO8/gOmLDeiFVEQDwo+RJeVJhcXS8G
KpN1QC4nbhcmAO6c5HbB900AfjBjVyIkPVYqlp9DqBcoHxUH79DrVh3QQtIypvdAKye5clYA
T8e3IEEny6CBQAj5/6COHNSh8EXmAPrK9P/AEMCvqhOITpH11Gjo0gAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousLeftSide
^ self icons
		at: #glamorousLeftSide ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 16777215 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864)
	offset: (0@0))]! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloDragIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/haloDrag.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQAQMAAAAlPW0iAAAABlBMVEX///8AAABVwtN+AAAA
HklEQVR4XmOAAxkLBgEOBvEXDCwKCATkAgWBUjAAAFCjA2d9sn1WAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:41'!
bookIcon 
	^ icons
			at: #'bookIcon'
			ifAbsentPut:[ self bookIconContents ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
pharoIcon
	"Private - Generated method"
	^icons
			at: #pharoIcon
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self pharoIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'TudorGirba 2/27/2015 23:56'!
glamorousPreferences
	"Private - Generated method"
	^icons 
			at: #glamorousPreferencesIcon
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousPreferencesIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:18'!
alertIconContents
    ^(Form
	extent: 16@16
	depth: 32
	fromArray: #(16777215 16777215 16777215 16777215 16777215 16777215 16777215 2919235584 2919235584 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1207959552 4278190080 4278190080 1207959552 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3338665984 4278255616 4278255616 3338665984 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1207959552 4278190080 4283633923 4283633923 4278190080 1207959552 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3338665984 4278255616 4291897863 4291897863 4278255616 3338665984 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1207959552 4278190080 4283633923 4294914824 4294914824 4283633923 4278190080 1207959552 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3338665984 4278255616 4291897863 4294914824 4294914824 4291897863 4278255616 3338665984 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1207959552 4278190080 4283568131 4294914824 4294914824 4294914824 4294914824 4283568131 4278190080 1207959552 16777215 16777215 16777215 16777215 16777215 16777215 3338665984 4278255616 4291832327 4294914824 4294914824 4294914824 4294914824 4291832327 4278255616 3338665984 16777215 16777215 16777215 16777215 16777215 1207959552 4278190080 4283502595 4294914824 4294914824 4294914824 4294914824 4294914824 4294914824 4283502595 4278190080 1207959552 16777215 16777215 16777215 16777215 3338665984 4278255616 4291832327 4294914824 4294914824 4294914824 4294914824 4294914824 4294914824 4291832327 4278255616 3338665984 16777215 16777215 16777215 1207959552 4278190080 4283437059 4294914824 4294914824 4294914824 4294914824 4294914824 4294914824 4294914824 4294914824 4283437059 4278190080 1207959552 16777215 16777215 3338665984 4278255616 4291766534 4294914824 4294914824 4294914824 4294914824 4294914824 4294914824 4294914824 4294914824 4291766534 4278255616 3338665984 16777215 1207959552 4278190080 4283437059 4294914824 4294914824 4294914824 4294914824 4294914824 4294914824 4294914824 4294914824 4294914824 4294914824 4283437059 4278190080 1207959552 3288334336 4278190080 4280813569 4282322178 4282322178 4282322178 4282322178 4282322178 4282322178 4282322178 4282322178 4282322178 4282322178 4280813569 4278190080 3321888768 3238068224 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 3254845440)
	offset: 0@0)! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'TudorGirba 3/5/2015 10:46'!
glamorousCloudPausedIconContents
	"Private - Method generated with the content of the file /Users/girba/Work/Code/moose/icons/glamorousCloudPaused.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAAXNSR0IArs4c6QAAAAlwSFlz
AAALEwAACxMBAJqcGAAAAdVpVFh0WE1MOmNvbS5hZG9iZS54bXAAAAAAADx4OnhtcG1ldGEg
eG1sbnM6eD0iYWRvYmU6bnM6bWV0YS8iIHg6eG1wdGs9IlhNUCBDb3JlIDUuNC4wIj4KICAg
PHJkZjpSREYgeG1sbnM6cmRmPSJodHRwOi8vd3d3LnczLm9yZy8xOTk5LzAyLzIyLXJkZi1z
eW50YXgtbnMjIj4KICAgICAgPHJkZjpEZXNjcmlwdGlvbiByZGY6YWJvdXQ9IiIKICAgICAg
ICAgICAgeG1sbnM6dGlmZj0iaHR0cDovL25zLmFkb2JlLmNvbS90aWZmLzEuMC8iPgogICAg
ICAgICA8dGlmZjpDb21wcmVzc2lvbj41PC90aWZmOkNvbXByZXNzaW9uPgogICAgICAgICA8
dGlmZjpQaG90b21ldHJpY0ludGVycHJldGF0aW9uPjI8L3RpZmY6UGhvdG9tZXRyaWNJbnRl
cnByZXRhdGlvbj4KICAgICAgICAgPHRpZmY6T3JpZW50YXRpb24+MTwvdGlmZjpPcmllbnRh
dGlvbj4KICAgICAgPC9yZGY6RGVzY3JpcHRpb24+CiAgIDwvcmRmOlJERj4KPC94OnhtcG1l
dGE+CrDjMt0AAADPSURBVDgR1ZA9DgFRFIXHT6LRKEQhkVErlRqFREIoZgUSG7ADswE7UGAX
SougplBSUJLwHZkrk4mRmXJO8r135v689+44TuZVSDBBlZoh9OAFZ/irOdkDbMCDK6jRWOHz
8FN9olb4b59Zt43gEpjCBJqwgzXk4BTyLl6qwPLjWDpwh/CNPt+SH2Deap4EdEC5yLKQgTTS
y/Xikn5GK01npHaskwbQiCQ0uwvdYA97Ql8d5dpwAZsv6f6gx9NNUg1GUAeLYWN1I7OFfWxF
dhJvrKo2yrDm7AgAAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
errorIconContents
	"Private - Method generated with the content of the file icons\base\error.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAADAAAAAwCAYAAABXAvmHAAAABHNCSVQICAgIfAhkiAAAAAlw
SFlzAAAN1wAADdcBQiibeAAAABl0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoA
AArUSURBVGiBxZltcFTVGcd/597NbpZsdskLYEhCcORFUqwgKjp+kCkzteqgtZUMU2sraqdV
B3zDTsdROtMPTrVWodDWsRZHK6MzpVPEqcWpUqliQytVQwhWEkiCFbJJNiG7d1/uyzn9cO9N
NmHJO+2dOXP32Xt37+//nOc85znnCqUUUzn6hLhYW7r0biKRBaK0tIRIJEI4HEHTNJnJpFQq
ZchkMqUM45TV2vqiNIyD1VN9aN4hJvNfA5WVK8X8+RtEXV190erV84INDRWisnL4TUqBEENm
KkV2z55k5vXXT9odHcfsL77YMbezc8//VECypKReLFu2tei221YEv/vdMlFSgh2Pk21uxmxv
x04ksHt7sXt7UZaFVlKCiEbRo1GCtbWUXHklxQsWoEyTzJ49meT27c32iROPVnd2vn1eBSSF
mK1dfvmvAmvWXBP84Q8vUJZF+sABsocPY546hbJtlG0jvXMh2/+sz5xJZOVKym+9lVBtLckd
O/qSO3YcyjU1bbwwlTo67QJS1dVXaStWvBR+6aVFlJSQPnAAY/9+ZDpdEHA0+EFbStA0ytas
Yc5dd6FHIvQ88EBH6q23Nl/Y1vbytAkwliz5nn799ZuLn366JvfZZyTfeAOnrw/lOEjLGhf8
WWKkRCk12AiFmHvvvcxqaKD/17/u7tm2befCo0cfVkrJKQkwli//aXDjxu8VrV9fnv7b30jt
24cyzbPgx/T2KPBKSqT3ufzGG5n/6KNkGhsz/9mw4S83NDWtbQVLjREiBQUY9fV3BzdtejLw
ne+Up15/nUxT0xDEeYD37Rlf+hKLnn0Wq7U1d2z9+leWffrpBiA3Wm9oI79IVVev1K+77sdF
d955NrwP5Diu7Z2nA14qRfLwYY7edx/Fy5aFqh9++Jt76+ruB0qEEPq4BCSFqNRWrHi5+Oc/
r0m/997Z8JblwluWC+/ZMk/UZOF9O9XSwrHHH6fy7rtnXrxmzYNPxmJfBSJCiMCYArSVK7eF
X3xxkXnsGKl33ins+ZHweaIGxUwS3rfjb77JyRdeoOaZZ2avXrLkJ8AF5+qJQQHJ0tJFgRtu
uJZolIE9e1ygQqHhe7oQfP74yAebALxvn9i6lVRnJ1UbNlz0zOzZ64HZQFgIoRUUoC1b9ovg
I49UpT/4AKe/f1zpUY0Ukwc/0vsTgVdSIk2T9i1bKLnxxtDVCxfeFoY6oAIICjFUo2gAyWh0
WdG6dVcoKTH27594bs8XVAh+gmL8e3r27mXgk0+Yu2nT3Ceqqu4AqoAoEBgmQCxceH/Rt79d
nm5sRBrGxOH9UJJybPh8exR43/7it78lcOWVWv2cOVcB1cCs/FByBcyd+2URi5E9fPi8wqsJ
wiulONPYiGUYlC5YUFEJNd6AHuwFrV+IxfqqVbVOXx/myZOTC5txwo+EGwteKoXM5Tjz978T
+8Y3ordHo1d7PVABFAshREBbvHh9cN26WZnm5uEDVNcRmgaaBrru2roOug6BAJp/nwev+Q+H
4XYekPCFeGI0TyjefUg52KRhDP524L33qHjgAW1lVdWlDAzsB8qBLiAdENHoQq26GnPfPpRt
I4JBZj30EKGLLio0b0z6cBwHy7IGm2maw+yRzezsJLd9O6qzk3RLCzEpKY5GZwAlQBlQCpzR
iEZLAXcRYtuEr7hi2uFt28Y0zWHtLOCR1ysqkKtWIZXC6u3Ftm0CxcUhIIQ7BmJAMEBpaQTA
7ulB2jaiqGja4cfj8UL3OJrmhtmZMzjZLIFQKAgU4fZCKRDSmDGjFMDq6UHZthuD03QU8uxo
baQg2xtjSily8TiislKfCxEgCISBYAAhBEq5tb73g6keSqkJe7tQU7ZNwBvglmki3WJIw02h
ISAYUOl0EiHQSktxDAPlONMCP5mQGdmEZQ2mU2Ix7K4u53PI4IooAoo0mUqlAPRYzM3tpjlp
eCnllEJm5HUnl0MqhSguxtF1coZhKRCeAB3QNTUwkATQYjGUbTPw7rvYfX0ThnccZ0JwY4pL
pQh++KEb0rEYtm2Ty2SsvEcKQARkMnlSJhIE581D2TZWVxfH1q4lWFMDmjZ85oThs6hny7zJ
SToOjjc5yfxr52hKSjQpCUiJLiUh/7vubndcKoWorcVxHDKGkc3vcEAGrJaWl7K7d99esnp1
WfcLLwyWCNm2tnEVX+OtLM9loxR4s7KSEuFfz3uutnw5qrVVfRKPt4M72QM2YGkXKPWv3J//
3BGqq0OfNWswE/0v4M9p5z9X02DpUnJvvZX6fTJ51BPgABZgaQB2R8enyjSJXHXV/x9+RBML
FuAUF5Nqa0uedjOQ8ryfA0xXQHv785ldu5Llt9wCuj6pBci0wef9n1QKcd11qPZ29Vl3d6cX
Oo4HbwwKqIrH/2o891xTcM4cZt5006hl8bR6epT1glQKsXgxaulSzJdf7tuSSPzDgzeBFHAG
yA2uic1//3tT8pe/7J1z552IcLgw/MgHTqOnz7KVQlu7Fo4ccQ4eP37EcL3uAFkPfmCwBwCq
u7oajdde+6deVETVPfec5Z0xt0imE15KxKpVODU1mK++mtg+MPBh3sBNAQnvbA/bojA/+uje
3vvua5+1di3lN988apyPOi6mCr9oETQ0IHbtSv+hs/MD2x20NpAGeoFuwFBKyWEC5mWzJ7IH
Dz7Y/7Ofddf96EdELrtsUhlovDFeyKaiAnHPPfDRR1bTvn3Nf8xmW/OyTj/uSizhjYWz90Zr
jh7dndy587nM22+nFz79NCWXXjpl+HPBFoS//37o71c9r7zS8URf3/sevAkkPfhTQEop5RQU
AFD78cebezdv3m0eOpSt/81vmLVmzXmHF4sXoz32GMK2VXrr1lOPdHW9mQef8uBPeiGU81lH
fcHRcdllT0XvuOOuso0byz/fsYPjW7YgTXN64ZVC/8pXoKEBDh2y4zt3tj9y+vSfst5E5cGf
Bo4BbUBCKTVY1I35iun4JZd8K3zNNU9dsG1bda6ri+PPPsvpN94YykpTgNfq69FuvRVZU4PY
tSvz8TvvND2RSOSHjQHEgeMefLdSKpfPN66XfM21tZeG6+qeK//BDy6JrltX0t/cTMfzz9O3
fz+2YYxZzwyzdR2tvp7A176GuvhiVFOTk3nttd5dnZ0HdqfT/oD1PR8H2r3WDWTVCOBxv2YV
Qmjv19U1lM+f/1jFQw8tDF17bTCXTtPf2Eji3XdJHzmC2dWFmUi4sB4wkQiirAy9rg59+XLE
0qXYgQCqrU1lfve7xIHjx5u29/d/qNw872ebAdyY78CN+0Qh+AkJ8EVUQPiVefO+X1ZVtTZ0
4YXzSm+5Zba+YkXAwV3EW9ksuXgcO5tFzZyJo2nYto1tWciWFpXZuzeZPHFioKW7+8TWROJg
2p2c/BIhjZsqTwOf42acM4BZCH7CAjwRAndXILIAqr8fiXx9SXX19YFYrFwrLg7r4XCxFo2G
lK6LXE+PlTUMK5dOm5mBgdzH8Xjrq4bREnerSr8wM3G9nsTNMKe91os7Wdmj8kxUQJ4Qf2eg
FHerrwKYCcTKoCwEM067IaHjLv/8QzK0IMkyVJglgB6GygRTjeNV66QFeCIEQ1scYU9M1DuH
ve+L8kT4tbwf6wZDhZmBG0KmP0mNi2EqAkYIGdzqyAP3my/A97yNG/t++FiAPR6PnxcBw/7Q
FeML0vI+g9sD/ppW+va5Buh4jv8CDd/IyOYopYAAAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallUpdateIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABl0
RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAAMiSURBVDiNbVJNbFRlFD33e++V
+a0zbQdbqLYKhhKmoaIzjX/RmEY3xGBYqLxEjJCB8LNhBxsMTQwRdGGi4AOjMUwlmDQBN/wE
IZLUwqtx0dCS1NLGAUY7tB3ozLTz3vu+66LzkllwkpvcxT0nJ+dcYmb4SGWyzzTo2hEQ3vSk
atWEmCfCuOPKEwAu2Jbp1t0eBHCCfIF0JrtF08RAT9cqfV1ns9HWFAGYUShWMDJ2v3xn+qEn
Fe+2LfNselc2w4zvAMSImZHKZNcbuhjZ2tcdiseC0InQHA0gHNARDRkIGgIzxUUczw5XCsWK
HQ019D4uVw1mNBEz49U9Z0/1rGv7NBgwxK3RHKquB0PX5JrVscW+9PPh3vWtpAmCEIRfrk2o
t15sFwe+vuo4rmzRAYCZP7wzXRCup1gxLzLjM8eVZ8anZ5MT9+aPXu9o7tq3dVMoEQvh43e7
RC0GAqAEAEipwlXH85IvPPuDlOoRgEHbMvO2ZV7549uPXhqdLOzdfewS7j8sYXqmDKkYAAMA
CyyvqumpSH9jJPBVZ/vKbgBTdWnruiZ2bnsn6XY+HUWicQU0Qb4D1mt38V8/37yAJ+O0J9Vr
F4cnq1ftqSXfvOOqAAD2W6gCMGoErpvfAOwE4D5BWLct854v4J0/+r4GEJgZF+1/1Knzf+Wk
VD22ZRbrWYezY6tK5aWO30fGbwCI6QBABBAR7v5XhiEYJwf/JABf1JNTmWyYiO72blx7Jj8z
lwKgAagKABBEBAAdiRBWt4Tx5f63qa0lcuyVPT/fSmWy6ZrG9hWGrufyswfyheLrmkaubZmu
WHZAeFxxcWFoij2P0b4yisM73gh90Jd8ubU5ci29a8A1dPGNVDI+92gBTY1B0oQYBAD/kaj/
x6Glidzc5KXhyc7Mlk3hRCyI7rUJeq49HiqWXfw7W4LjeBQJGjh3ebTiSXUEAJYfSTFN5OZO
3zy5LfmgsPBJ//c35o8P3CwN384jP1tG1ZUQRCjMl+S5y6OLUqmMbZljAOC38BOA7bZlci0w
A8B7DYa2VzFvkFLFDV2bIcJQ1ZGHbMv82w/3fy5VdmoTZczGAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:33'!
announcementIcon 
	^ icons
			at: #'announcementIcon'
			ifAbsentPut:[ self announcementIconContents ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'CamilloBruni 9/14/2013 16:03'!
smallAddIcon
	"Private - Generated method"
	^ icons
			at: #'smallAdd'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallAddIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallHierarchyBrowserIcon
	"Private - Generated method"
	^icons
			at: #smallHierarchyBrowserIcon
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallHierarchyBrowserIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:22'!
exceptionIconContents
	^ ((ColorForm
	extent: 12@12
	depth: 8
	fromArray: #( 1583238196 1191577949 759500554 1583225870 390089009 36066088 1578711384 857557019 906518110 1581393173 991970905 1549688414 722677332 570761514 1583242846 1327383559 1091971346 5322527 792346372 337270359 1297099812 1011548469 286015067 654532190 1583242842 941838926 1432247902 1583242763 221384798 1583242846 1583224899 1029594718 1583242846 1583231050 1583242846 1583242846)
	offset: 0@0)
	colorsFromArray: #(#(0.906 0.764 0.392) #(0.945 0.867 0.6) #(0.918 0.776 0.306) #(0.969 0.922 0.815) #(0.945 0.831 0.443) #(0.953 0.84 0.443) #(0.934 0.823 0.388) #(0.953 0.819 0.286) #(0.98 0.949 0.855) #(0.93 0.815 0.376) #(0.992 0.98 0.941) #(0.894 0.733 0.302) #(0.945 0.792 0.4) #(0.898 0.725 0.286) #(0.949 0.863 0.423) #(0.965 0.91 0.737) #(0.984 0.961 0.906) #(0.914 0.772 0.365) #(0.91 0.768 0.384) #(0.941 0.844 0.415) #(0.953 0.844 0.498) #(0.965 0.871 0.4) #(0.953 0.836 0.474) #(0.945 0.859 0.439) #(0.949 0.867 0.651) #(0.988 0.965 0.867) #(0.949 0.815 0.455) #(0.957 0.855 0.542) #(0.953 0.875 0.514) #(0.957 0.836 0.341) #(0.953 0.867 0.474) #(0.914 0.78 0.474) #(0.945 0.8 0.263) #(0.934 0.811 0.431) #(0.941 0.792 0.216) #(0.93 0.788 0.443) #(0.965 0.914 0.796) #(0.965 0.891 0.51) #(0.898 0.733 0.22) #(0.906 0.764 0.435) #(0.992 0.984 0.953) #(0.898 0.737 0.275) #(0.957 0.894 0.71) #(0.992 0.977 0.914) #(0.926 0.815 0.569) #(0.918 0.788 0.333) #(0.973 0.902 0.561) #(0.918 0.788 0.286) #(0.957 0.891 0.725) #(0.937 0.815 0.396) #(0.902 0.757 0.396) #(0.965 0.867 0.369) #(0.937 0.84 0.384) #(0.934 0.836 0.526) #(0.91 0.764 0.306) #(0.887 0.721 0.333) #(0.914 0.764 0.357) #(0.941 0.855 0.412) #(0.949 0.855 0.462) #(0.949 0.811 0.232) #(0.957 0.891 0.635) #(0.945 0.863 0.659) #(0.941 0.776 0.408) #(0.953 0.855 0.474) #(0.945 0.844 0.427) #(0.941 0.78 0.236) #(0.957 0.891 0.608) #(0.875 0.69 0.216) #(0.969 0.883 0.451) #(0.906 0.761 0.286) #(0.957 0.848 0.498) #(0.934 0.836 0.396) #(0.961 0.84 0.415) #(0.941 0.831 0.408) #(0.977 0.941 0.855) #(0.949 0.875 0.604) #(0.965 0.91 0.655) #(0.922 0.757 0.404) #(0.941 0.851 0.635) #(0.965 0.914 0.698) #(0.879 0.69 0.247) #(0.898 0.741 0.353) #(0.891 0.717 0.302) #(0.973 0.934 0.804) #(0.953 0.831 0.279) #(1.0 0.996 0.992) #(0.941 0.796 0.443) #(0.941 0.804 0.486) #(0.98 0.922 0.573) #(0.914 0.772 0.345) #(0.98 0.945 0.859) #(0.902 0.725 0.322) #(0.969 0.918 0.772) #(0.926 0.8 0.357) #( ) ))! !

!ThemeIcons methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 6/7/2013 16:20'!
packageDeleteIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAMNSURBVDjLdZNLaFx1GMV/d+bO
3DtJxkwSSWNq05YkrTVa04qIiOiiRIxgE2ohhUIKRQQFBcGiIiJiFaGIYEFERFy5dCE1pQ8J
IbSEJhG66GM6idOk6Uwyec7zztz7/z4XlSw0nvXhx4FzjqWqbKXb517rQeRzFY2ryPv7Bkf+
3Mpn/RuQHDncqqLvqMjbLZ2DCVNZZjV9uaii36uRr58Yunx/S8Cd8wMRVT2hIqfi2/u6tu17
nZAYiplJIk6YpdQo6/em7qrIGRX5sXd4vLIJSJ4f6EP0Y6ep94Vtjx3BbeoGrRGs3eGv0dPs
ePx5QnU7qZZyLKamKORuTqgxpw++MfGbdXvk8E+IDD/cNWS5zU/iFZbZyN3E1Ir4pQyOVaWt
Yy94a4QbOgi5cfKZJIupKcprd3+x1cjxPYfOWn5hmWJmFKnlcco5yvkM+fkFDg59SyRWD6U0
Wkph5ZO0tO+nsRmmf589aqtISbEao65DvLmDSu4GdU0JEk0xYpTBmwMTBW8BKvOUsxMU01dw
dx1BjZRsFQEBrCiRxm4iThxvaRIpLhEJg1WegZBSy16ikF8niCUg6qB+gIpgqxEe9GBAq2DX
47YeIIjGcL0VJHuRDb9A4DZgnDhSrkGgSC1AjcFWYx4UqgbEBymDVrEbthNv28PG6iR+yGVl
IsfKtTm8xXVCD0VpfY5/EojEQpEIEINgBaQK4oGpgttOoLA6sUIt6/L08Q9xdvdQuX6BG+OX
8IP1+pAaGZsd+4bK2hw47RCuA1MD9QFBfSFzJUn3S0dxZ0axfj5G3eyv7Opopja3HthizKuF
+fHhW+mxU82dh7oe3d9POL4XyinwSpiqj1mr4bbthv73Nidsf/oIIU+czSlP//Bsq4q8q0be
an9qINHe2w++R37+KtOffckzrwxSP3eOaiVLGSjkw9yaYeE/Z7p29kCPGvlIRY51vnjSqiyl
mb/4B3be0x0tgWWH7lHIBaQXw8b39BPr/+589UxPn4p8gEhURb7ierWntHr/zbCxdpqwLih8
9/KF4Iu/AXSvuZLBEiNYAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'BenjaminVanRyseghem 12/5/2013 12:33'!
uncheckedBoxIconContents

	^ #(4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4292211711 4292211711 4292211711 4292211711 4292211711 4292211711 4292211711 4292211711 4292211711 4292211711 4287338155 4287338155 4292211711 4293655039 4293655039 4293655039 4293655039 4293655039 4293655039 4293655039 4293655039 4293655039 4287338155 4287338155 4292211711 4293720831 4293720831 4293720831 4293720831 4293720831 4293720831 4293720831 4293720831 4293720831 4287338155 4287338155 4292211711 4293852159 4293852159 4293852159 4293852159 4293852159 4293852159 4293852159 4293852159 4293852159 4287338155 4287338155 4292211711 4294048767 4294048767 4294048767 4294048767 4294048767 4294048767 4294048767 4294048767 4294048767 4287338155 4287338155 4292211711 4294180095 4294180095 4294180095 4294180095 4294180095 4294180095 4294180095 4294180095 4294180095 4287338155 4287338155 4292211711 4294376959 4294376959 4294376959 4294376959 4294376959 4294376959 4294376959 4294376959 4294376959 4287338155 4287338155 4292211711 4294573567 4294573567 4294573567 4294573567 4294573567 4294573567 4294573567 4294573567 4294573567 4287338155 4287338155 4292211711 4294639615 4294639615 4294639615 4294639615 4294639615 4294639615 4294639615 4294639615 4294639615 4287338155 4287338155 4292211711 4294770687 4294770687 4294770687 4294770687 4294770687 4294770687 4294770687 4294770687 4294770687 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155)! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallCancelIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAIhSURBVDjLlZPrThNRFIWJicmJ
z6BWiYbIkYDEG0JbBiitDQgm0PuFXqSAtKXtpE2hNuoPTXwSnwtExd6w0pl2OtPlrphKLSXh
x07OZM769qy19wwAGLhM1ddC184+d18QMzoq3lfsD3LZ7Y3XbE5DL6Atzuyilc5Ciyd7IHVf
gNcDYTQ2tvDr5crn6uLSvX+Av2Lk36FFpSVENDe3OxDZu8apO5rROJDLo30+Nlvj5RnTlVNA
Ks1aCVFr7b4BPn6Cls21AWgEQlz2+Dl1h7IdA+i97A/geP65WhbmrnZZ0GIJpr6OqZqYAd5/
gJpKox4Mg7pD2YoC2b0/54rJQuJZdm6Izcgma4TW1WZ0h+y8BfbyJMwBmSxkjw+VObNanp5h
/adwGhaTXF4NWbLj9gEONyCmUZmd10pGgf1/vwcgOT3tUQE0DdicwIod2EmSbwsKE1P8QoDk
cHPJ5YESjgBJkYQpIEZ2KEB51Y6y3ojvY+P8XEDN7uKS0w0ltA7QGCWHCxSWWpwyaCeLy0Bk
A7UXyyg8fIzDoWHeBaDN4tQdSvAVdU1Aok+nsNTipIEVnkywo/FHatVkBoIhnFisOBoZxcGt
Qd4B0GYJNZsDSiAEadUBCkstPtN3Avs2Msa+Dt9XfxoFSNYF/Bh9gP0bOqHLAm2WUF1YQskw
rVFYPWkf3h1iXwbvqGfFPSGW9Eah8HSS9fuZDnS32f71m8KFY7xs/QZyu6TH2+2+FAAAAABJ
RU5ErkJggg=='! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallHierarchyBrowserIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAQAAAC1+jfqAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAACoSURBVCjPY/jPAIMMCgxmYKiA
EAOKwhmMDGZ//v/5/+M/qhI0BW/+gxQBlTDiUPDl/3v8Cn7//4VfwR/cVkB8kfI27S0WR+7r
m/ui70X7i9YX88O7whtflANh7ouUPqgCBsbZLyBGAq1hRLBiX4BZiODBxgIpgAWPOYM/Bguk
GCl4En9jsswYkIIHKIzBgiiABg9QGINlxoAUPEBhDJYZwhdmDDZYWAoAtTEEdnXdy7IAAAAA
SUVORK5CYII='! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
fullscreenIcon
	"Private - Generated method"
	^ icons
			at: #fullscreen
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self fullscreenIconContents readStream) ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallDeleteIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QAAAAAAAD5Q7t/AAAA
CXBIWXMAAA3XAAAN1wFCKJt4AAAAB3RJTUUH1QQWDyovwTM/8wAAAhxJREFUOMulks9LlGEQ
xz/P+9syNUWyXBQzAunQrYQI+wPqYiLh2im6dokILwndqpvdskMXCUPtFmFE5yQNMrNwxS3L
FQQxZd3d932eeTqYW2EESwPDwDDz4TtfBv4zFEDv5bZuEWe8slW5OTaydNfrSbf3dnScGe3v
G6hofXxi6A5MznjAaH/fAMPDj1hZ/oLjuLiu88/ade4sF7uv8WZ68oWzS5x9N0cQBARBSBju
ZkQURURR1c8aEYYhuZVcWYkHsLDwlqH79yo6YWb65Y6JPen2B8DVrq5T5FYziLWIWIy2aG0x
WohjIUkMOrGIgDYGYwzW2mEF0JNut9dvpFnfmN3xVyybGyWUqsZza1nfWGZrs8B2XlMsGQ7W
HWXq9RRjI4vK+5s8a6GhPkVL8xUA8vkPzH16Tn7fFoWCRbRbni2b6KhfzSONF3DciEz2Idvb
8ziOiwV8r4ooCmlsqN0LULi4TkAY1BGFLaSa0iS6yOLnSTLZVzQ1nkCsYIwhiMK9gMA/gO/X
oJSDBXJr4ygUranzKFyaD3ci1hKXNO5vasseKOVgrcFay+raBPU1nQTeMar3H6Lj+CXez4+h
dYJYQyJmL0CLwVqDiBDH38l+e0YSG5Ty+bjwlLhkEKMRMYjWfwBCgGxmPWltO+kba5FE0CJo
LRQLq6SaTmOMYIwljg3Zpa8J4AOBB8RxSd96/GTkdgWP6BcLySCgfwCHx/uHvBXx4AAAAABJ
RU5ErkJggg=='! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:35'!
arrowUpIcon 
	^ icons
			at: #'arrowUpIcon'
			ifAbsentPut:[ self arrowUpIconContents ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallPasteIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAH+SURBVDjLdZI7aFRREIa/k3u5
cclGwiXEF9GInSCIoF0qa1/BynJdyBYhtaRJSrsFK4XtBCGFQRALm4BYKQg2ti5JQEh2hay6
6ObMmbG49+4jSwYOc4rzfzP/nHFmBsCL6uWrwDfGo7PcaM5wQrjnjxduABvAnXJ6hkdr63Tb
nwGYmr3Fy/Un/O3+AngFbC03mq+HATGwdfv+g4ul8jT++1fMjNDrAmBmLF6bZ+LcFczs4fs3
b+8CY4BLpfJpjn4fICo0N+tgBhht+4Ka4ff3ODV7ITFInHPOCt85ADRgIkzMnEWDYKb8aHf5
2fmHAbp/iNsTdlo9gJvOuQNg18w0BjBVVAT1PdT3wIxW65B7a++I4qTf7hKwIfKp0Wg8W1lZ
qTvndnOAoMFjprn37ERxgvceEUFE8N6TpimVSmU1jmNqtVp9IgMEVDwmHg0BDYppBnPOEUUR
URThnAMgSRKq1eoqMBcXAMRjQTFRVA2VDBBFUT9PTk7S6XQIIZCm6WCIpllVFUUlYGpYCCMd
FHfnHCIy8o3ZEH3ARDEJqIKKDbYthxQWitwHZNUzgOYWig6GIcdBgz0IhnrNZ1BY0PG9z4WF
pQLw0R8dLU6dn8+EqphCybf6j4YWb6R6AXj6YXt7GrjeFwA7rR5LJ4gAQgh/gOCG6cfaXQDm
ODkCcPAfs2Qwc59hLO4AAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:32'!
smallUpdateIcon
	"Private - Generated method"
	^ icons
			at: #'smallUpdate'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallUpdateIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousBrowse
^ self icons
		at: #glamorousBrowse ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2248146944 2113929216 2130706432 2113929216 2113929216 2130706432 2113929216 2130706432 2130706432 2113929216 3305111552 3388997632 788529152 16777215 16777215 16777215 2130706432 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3271557120 2281701376 553648128 16777215 16777215 2130706432 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1996488704 687865856 2986344448 721420288 16777215 2130706432 16777215 16777215 16777215 1056964608 2130706432 2130706432 2130706432 2130706432 2130706432 1056964608 2113929216 1996488704 2952790016 3976200192 16777215 2130706432 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3355443200 16777215 2130706432 16777215 16777215 16777215 1056964608 2130706432 2130706432 2130706432 2130706432 2130706432 1056964608 16777215 16777215 16777215 2130706432 16777215 2130706432 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2130706432 16777215 2130706432 16777215 16777215 16777215 1056964608 1073741824 2130706432 2130706432 2130706432 2130706432 1073741824 16777215 16777215 16777215 2130706432 16777215 2130706432 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2130706432 16777215 2130706432 16777215 16777215 16777215 1056964608 1073741824 2130706432 2130706432 2130706432 2130706432 1073741824 16777215 16777215 16777215 2130706432 16777215 2130706432 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2130706432 16777215 2130706432 16777215 16777215 16777215 1056964608 1073741824 2130706432 2130706432 2130706432 2130706432 1073741824 16777215 16777215 16777215 2130706432 16777215 2130706432 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2130706432 16777215 2130706432 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2130706432 16777215 2113929216 2130706432 2130706432 2130706432 2130706432 2130706432 2130706432 2130706432 2130706432 2130706432 2130706432 2130706432 2130706432 2130706432 2113929216)
	offset: (0@0))]! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:52'!
testNotRunIcon 
	^ icons
			at: #'testNotRunIcon'
			ifAbsentPut:[ self testNotRunIconContents ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallLeftFlushIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAQAAAC1+jfqAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAABjSURBVCjPY/zPgB8wMVCqgAVE
lP//x/AHDH+D4S8w/sWwl5GBgfE/MSYU/Ifphej8xbCLEaaAOBNS/yPbjIC3iHZD5P9faHqv
k+gGbzQTYD76TLQbbP//hOqE6f5AvBsIRhYAysRMHy5Vf6kAAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:26'!
smallHomeIcon
	"Private - Generated method"
	^ icons
			at: #'smallHome'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallHomeIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:29'!
smallOpenIcon
	"Private - Generated method"
	^ icons
			at: #'smallOpen'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallOpenIconContents readStream) ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallRedoIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAA
CXBIWXMAAA3XAAAN1wFCKJt4AAAAB3RJTUUH1gcaCicVP7jtIQAAAdxJREFUOMudk01rE1EY
hZ87X02MpEJMY4MfbTbVdtPSKn5UYw1CqThuRCuCuBpwrTvBv+B+Vt11KUQKhYrFUrpqpKgb
wU11ISliTCZNmslkxs0YJ51Bgmf5Xp7Duee+F/qQbmqebmrTUWcS/WtbN7XCfxs8fmAAvNFN
bS44FxFxB4A8sAhMAZMBA5aWTYAbRcNeDxnopnYBeD4ntFS2cHVYTY3mEAJVjmHZPyl9W+HK
6L0eExGAF4AXj/L58/JQTqrZZbzap550H5s1gK7JuT17VvjwBPDy4bXrN2OZM1iVdSxPI+7a
AAw6DTbbzt/ihMSlkbssLZso/uzpnbPjk7F0lvqvdyRaDRI0GG5VeEUCR+rtOj14snsNBWBA
1WaPj02n49Z7svtVdqQEmiKoHYkz7kMXFTDrFpljp9lc/dDtQAHouG5GyIJUw2KrVPfWWpXQ
60xcPhGCu3vgdJzk0cZXtnd2WWu1LeAZMFU0bFE0bAHwNjkUgoFuB+w3q+5KXUjA/aJhrx5O
4MMzRcMuRW6iqsgHgBcF+wrBwQQbzb2yWpC9GKY2f9jkzzWiJAOM3ZbdLwft+q2Z3I/UbvmU
0NWtz687dj9/JLiJI8ACUAU2niTd7wK8+UWn8y+D39dLugVezzXeAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
expandBoxIcon
	"Private - Generated method"
	^ icons
			at: #'expandBox'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self expandBoxIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
questionIconContents
	"Private - Method generated with the content of the file icons\base\question.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAADAAAAAwCAYAAABXAvmHAAAABHNCSVQICAgIfAhkiAAAAAlw
SFlzAAAN1wAADdcBQiibeAAAABl0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoA
AAyGSURBVGiBtZp7cFzVfcc/9+5qtatdvWXJetgyjiUZY8BvbEMCjSk4PAKh2CFtCjU2MwEK
blLcaZkJk5AZSkoaA3HqDKUmBgx04rTGQOMhgtQ2fr9AtmzLlm29bL21q33vfZzTP/auvCut
pJXt3pkz9/7u7Fx9vr/zvb9z7jlSpJRczaGs9s6cXamu8TiZkZutuD3ZeFwOPCqoEV0Eg1EZ
CkRFMBSVnc09+luhmDggf1t5dX80+e9fiYCStf5bppUoz1QXKbOWzcqaunKho7jEo6T8RgLJ
d4JRyfZj0cCHRyPtrf3G2UteY1Pb+ortV4c/QQHupwKz5kxRXvurxVnzH1vqKHRnK/T4DU60
R2np1RgIGvQHDfoDBrohcWer5LkU8lw2phQ7WDTDzYxyJ5oh2X40Etnwx0DjhV7jn9peraz/
fxWgPBEoXVCt/tv9N9tv/Yfljsm6KdnTFOZ4W5ROn4ZhSgwhMUwRvx5qIvVaSApybNxS4+Hh
xUVMKclm086Ad9NO/9GvWsPPhjbVnLzmAirXBRfPn6pu3rzaVet2wJ4zYXaeChGOicuAGcIn
YiEEqgL3Lyhk9bIyPE4bf/duX+uOo96fXPhV3dtSSnFNBFz/QuiJb91ge+EXK51VZ7pifHQk
gDdkYpoSPQVqDPhh4oQQSCmHWrYdnlpewcpbJ7Gx3tf3+h+63zv9y5nPAYbMwB6jCpj7Yujl
Z5c5nlh1a1bRrtNhPj8RRDNlGvg02c4QXkiJtO7dO7+I5x+exv7mSOSZTe31DRu+8QiRnpiU
0pywgFkvhNY8d5fj548usRd9eCRIQ1tkCCIdvCkkNZOzKS/IotBtozjXTqHHhj9scmlA4+KA
xvG2ME0Xw2nhE/ENVTmsX11Lc7ceW/X66fdPb5i/FoiM1RsjBFSuC96ycoF96/rvOqt+fzCQ
Am8IgT7UC5LSXBuLa90srfVQ5LGN19vsbfLzxqddnLoYHgGfiOsqc9i8djbv7h7w/WzzwVfa
3rl3IxAC9HQi1BQ1TwRK5k9V3/7Xlc6q3U3hMeFNU/D08kncNy8/I3iApXV5/PaZWu6bVzhq
T5xsD/LjLWdZs6yk4Nu337A2746X7gTyAIeiKMrwZ6YIuOU69VdvrXLVnu3S+Ox48LKPRdzH
yfC6KTlwNpQR+PDjh/dNpmayI62NpBD8z+Ee3vy0nV8+VlU6a+FdPwFKAQ+QNVzEkIDcpwO1
99xovz3PBduP+NFHKY+meVnM3qbghOGllCB0nrmrYFQbSSl57aMLtPUEefbeiumly9c/CkwC
3IA9rYA5U9TX193tKN97JowvZI5f24XkXHeULp8OQJ/fYNepAFt29/FGfQ8fH/YSjo0s57qu
o+s6lQUK2XZGfaE1XfDqhy3cMyfHWXvTkr/E7qoEigCnoihDnrUD5P1tYM4/P5S9UEjJzpOh
jOAT8e/2DRCKmnx2wo+mC4S8XC43fd7F28/W4nHahrKvaRqapmEaOtOKFRovpbGRJWjH0T5W
LCniuQcqKs81vvxY5ydrNwJRQFcURUgppQpQU6qs/f6SrKL9Z8OENDE6vBhpq4+PePm0YXAE
vJSSSwMx9jX5h7KvadpQD2iahoIYFT4R/0f9JRZOs6mTq69fApQBxUAOYBuyUEWhclO+S+F4
e3Rs+DSDVqIyDYeXVpyc/QR4QsQlrzEmvJSS/U2DhKI6X6vwlOCaVAGUkFSVVGWNr+6OWtsU
b8ikvV+bELwxDnyey8b8r+UOZT8Br2kajR1R+oJjw0shiOmCfacHeWhRfl7ezY8utXqgAHAC
NrWuTF31yCLHpBPt0QnDG2PAg+TF703DYVeGsp/cA9uOxsaFT8S7T/u5qVJRy2sWzQPyLQFu
wK7muZSaykKVll7tmsFLKVlzZzlLZ+aPyL6u63zRFOGrDjMj+PjgFkaYBrnubLcFno81Lqh5
TnIB+gPGNYNfUpfHmj+vSPF+IvutvTHe3B3JGF4KQX9AxzAMXNn2bMs6uZaAbHuuEw9AX8C4
OnjrXJafxc++dx2qwojs9/tjvPSxn1Asc3gpJYNhQVQzcTrsDsBhVSE34FBzHPEe6PPrVwdv
3fv7B6aQ77aPyH4spvHKJ166B80RA1e6RAwX0+OLUexWbLgrPJYIJ+BQFQVFAto1gK+tcPFn
Nxam1P1E9v/r0CDHO/T0858xBCWapusoCAXFbrcGYAfgUMMxGVCAXKeaBl5mDC+lTIFPzn5r
T5h3vgiMCz9WnO+C7kHDJNQRsQYxO2BXg1ERBMjPsaUfxETSg8aAF1JyU7U7bfYPNYeIGeOP
uqPFziwFGyahSExHCsUagG2ATfVHZCAuQE0PL1IrzGjwUghK8x0ACCFSKs+ZrlhGPk8XCynJ
d4FhGESiMZ3LhwIoaiAq2gdCgqkljqTJ2sThpZQkZurDpwwXerSMK85weCklU4oUTNMkFI5E
kwRIQNhPXtI3bzsa/etlM92Fb9b3Dn28TBReSsmPtzTjygLTFJimgabrCNOkY0C/YngpJXOr
VJp7pey58FVLAhwwAMMu35p8dMWvva2Pf72wcFK+jfY+84rghZQcbfZdkU3GglcVyewKeHd/
LBho/N0pC94EdMCwA7T2Gac1Q85ZXOOhtaf/iuClENhUeGBRCTNK7cRiUU62hdjREEITExOT
3GaUKjhtJuc6gwHCXWFLgA5ogGYHaOk13th6KHLvdxYV5W7d14+mD3vQePBS4nHa+PenZ1JV
AKFQiHBYsqDKYOk0nRc/jhCMTrBnrHt3X2+npV/K3o4zbUnWiQFhQFMBejaU/+k3fwo1lOU7
+PaCgtSKMTwro5TCHz04jemljhGzzpIcgwdnj/MODH+e9Zu6MoXZ5ZK392negX2vHrSsoxFf
ZgkBsaFv4qZL2nO/rg/0P/7NMlwOJS38CDFJMLfNzBsx60xc15Xo42Z6eCyRrJin0tiJef7k
gUb0UMyyTgTwA4GhHgDo3lC5/4P9oUNZdhtP3l0+MjtjjMIgcWWJEeCJazupn4/jwQspuaNG
oSrf5P2D2oD/4IbDlnU0IAgMWj2gp6wLHWvVnnp6c3/LiqWTeGBhUfquTfMemELS1O4fAZ6I
L3rjC8KZwteWKqycC1u/VMJth3+/F2EYVvZDgBcYsK6NFAHRTVMvHGiO/vCVT3y9//hQNfOm
ezKuQBt3XByR/USrb3ZkDF/shie/rnCsA/3zvQ0nok3/3ZxknUGgD/ABMSmlSBEAcOpfqrZt
2RP4TX1jJPyLv6nh5mp3RuV0z2k/P93aSZ9fG8r+YMjgP7+009DpyBh+7R0Kvgjy3V19rd7d
L31hwUct3/cAvZaNdBhjeX3RC+3vvfzd4u/cVud0/vT9c2w70J1RT4CkMAekMOkLgTDTww6P
68oUfnCbgjeMfL0+3Nm+7amtmNGIBe8DOoDzQDvgk1KOLQBg3vMtrzz2jfzH1y4vLNr0xw5e
3X5+aP1nNDGZwA6vNt+ss7FyLhxpx9iyq6el6w/rPsGMRpMy3wW0AG1APxCVFvi4W0w3rjvz
/aV1np9vWFVe0e2Nsf7D83x0sAthiquGn1Wu8vA8lap8wdZjSuSzvV82DOxKsU3Ask2b1fqA
sEzaghpXgKIoSuXq/XOmVRZv/MGdxbMfWZLnPtHi440drexs9BKKGuPOZ5JjmyKZVa6y/AY7
M8skDRel+cGBSH/boa17wk3bkl/YAHG/d1it14JP2bHJbJcyvqRtr1712cppU8qf/9E9xTNu
n5ntCEdi7D/j43+PD9DYHqbbpzEQ0BBJH0EeBxS6FaqLbcydamN2uYJdMTjXK+U7eyMD50/s
afAd3HAYKROlMlFteoGLQKdlm4iM/yaVLRMBySJw5LqnrHhvTfnkSX8xvSx76oMLcictqLZl
IU10XSeq6fT4YkRjBgUuiYqJYRjohsHJS0LuOB4JXOgM+HvbTl4Y2PfafoywboEn5jc+4rbp
ss4+4p5Pu1c2oY1uS4QNyAZyyZte7pn/5P2V1836Vn6OvcDpUHJc2TZXnsvmsClC6RuMGaFI
TAtHopo/GI31XDjWHDrxQSOR7gjxeU1idI0QL41e4j7vta4DgCbH2Ha9on81UBRFBbIAF/FF
pgKrxVfMsgsLsTldhDsNS3DyeJM8n48RH1EDxDPttc5B4i/xuFutVyTAEpH4uM4ivkaTQ3y1
zG2dncSXPuyWCIX415TByMwHLSFhS5QxmmWumYA0QuyWGEdSy0oSgCUgYZ3ER0nMOieEyfGy
fk0FDBOSaCqXlz4SceIQ6dpEoJOP/wO5FlMEYbMDfQAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloPaintIcon
	"Private - Generated method"
	^ icons
			at: #'haloPaint'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self haloPaintIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloScaleIcon
	"Private - Generated method"
	^ icons
			at: #'haloScale'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self haloScaleIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloDebugIcon
	"Private - Generated method"
	^ icons
			at: #'haloDebug'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self haloDebugIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
helpIcon
	"Private - Generated method"
	^ icons
			at: #'help'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self helpIconContents readStream) ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'CamilloBruni 9/14/2013 16:40'!
stopIconContents
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAJOSURBVDjLpZI9T1RBFIaf3buA
oBgJ8rl6QVBJVNDCShMLOhBj6T+wNUaDjY0WmpBIgYpAjL/AShJ+gVYYYRPIony5IETkQxZ2
770zc2fGYpflQy2MJzk5J5M5z/vO5ESstfxPxA4erL4Zuh4pLnoaiUZdq7XAGKzRJVbIBZ3J
PLJaD9c/eCj/CFgZfNl5qK5q8EhTXdxxLKgQjAFr0NK0ppOpt9n51D2gd2cmsvOElVcvOopr
KvuPtriNzsY8rH+H0ECoQEg4WklY1czP8akZby51p6G3b6QAWBl43llSVTlUfuZE3NmYh9Vl
0HkHSuVq4ENFNWFdC+uJ5JI/9/V2Y//rkShA1HF6yk/VxJ0f07CcgkCB7+fSC8Dzcy7mp4l9
/khlUzwecaI9hT+wRrsOISylcsphCFLl1RXIvBMpYDZJrKYRjHELACNEgC/KCQQofWBQ5nuV
64UAP8AEfrDrQEiLlJD18+p7BguwfAoBUmKEsLsAGZSiFWxtgWWP4gGAkuB5YDRWylKAKIDJ
ZBa1H8Kx47C1Cdls7qLnQTZffQ+20lB7EiU1ent7sQBQ6+vdq2PJ5dC9ABW1sJnOQbL5Qc/H
pNOYehf/4lW+jY4vh2tr3fsWafrWzRtlDW5f9aVzjUVj72FmCqzBypBQCKzbjLp8jZUPo7OZ
yYm7bYkvw/sAAFMd7V3lp5sGqs+fjRcZhVYKY0xupwysfpogk0jcb5ucffbbKu9Esv1Kl1N2
+Ekk5rg2DIXRmog1Jdr3F/Tm5mO0edc6MSP/CvjX+AV0DoH1Z+D54gAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallItalicIconContents
	"Private - Method generated with the content of the file smallItalic.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABl0
RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAACmSURBVDiNpZIxDsIwEASHFKlo
qCPRRqmo4Al8g5fkT3yBFlLkFYgGCdFBwVLE7nJny7FkXbO78uwZSVgXOAEj0FuaCv8cgR3w
tASpgEOYV1PhPH8DCPgAdQnCPsxR0rcEIQbcHM3yAK+DO1MHnbtqw9wE8xuovAALIa5vkPQr
6SCP3wlIf6B4ZvhXwIupg63HP1si0AbzI2W2SszmtzpYAxfgnBPwB0Q6/v9KP2ylAAAAAElF
TkSuQmCC'! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
objectsIcon
	"Private - Generated method"
	^ icons
			at: #'objects'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self objectsIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'NicolaiHess 11/18/2014 11:52'!
smallJumpIconGray
	^ icons
			at: #'smallJumpGray'
			ifAbsentPut: [ self smallJumpIcon asGrayScaleWithAlpha ].! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:49'!
morphIcon 
	^ icons
			at: #'morphIcon'
			ifAbsentPut:[ self morphIconContents ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallDebugItIcon
	"Private - Generated method"
	^ icons
			at: #'smallDebugItIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallDebugItIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:30'!
smallQuitIcon
	"Private - Generated method"
	^ icons
			at: #'smallQuit'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallQuitIconContents readStream) ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
confirmIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAKcSURBVDjLpZPLa9RXHMU/d0ys
ZEwmMQqZiTaP0agoaKGJUiwIxU0hUjtUQaIuXHSVbRVc+R8ICj5WvrCldJquhVqalIbOohuZ
xjDVxDSP0RgzyST9zdzvvffrQkh8tBs9yy9fPhw45xhV5X1U8+Yhc3U0LcEdVxdOVq20OA0o
oQjhpnfhzuDZTx6++m9edfDFlZGMtXKxI6HJnrZGGtauAWAhcgwVnnB/enkGo/25859l3wIc
vpzP2EhuHNpWF9/dWs/UnKW4EOGDkqhbQyqxjsKzMgM/P1ymhlO5C4ezK4DeS/c7RdzQoa3x
1PaWenJjJZwT9rQ1gSp/js1jYoZdyfX8M1/mp7uFaTR8mrt29FEMQILr62jQ1I5kA8OF59jI
ItVA78dJertTiBNs1ZKfLNG+MUHX1oaURtIHEAOw3p/Y197MWHEJEUGCxwfHj8MTZIcnsGKx
zrIURYzPLnJgbxvG2hMrKdjItjbV11CYKeG8R7ygIdB3sBMFhkem0RAAQ3Fuka7UZtRHrasO
qhYNilOwrkrwnhCU/ON5/q04vHV48ThxOCuoAbxnBQB+am65QnO8FqMxNCjBe14mpHhxBBGC
WBLxD3iyWMaYMLUKsO7WYH6Stk1xCAGccmR/Ozs/bKJuXS39R/YgIjgROloSDA39Deit1SZW
otsjD8pfp5ONqZ6uTfyWn+T7X0f59t5fqDhUA4ry0fYtjJcWeZQvTBu4/VqRuk9/l9Fy5cbn
X+6Od26s58HjWWaflwkusKGxjm1bmhkvLXHvh1+WMbWncgPfZN+qcvex6xnUXkzvSiYP7EvT
vH4toDxdqDD4+ygT+cKMMbH+3MCZ7H9uAaDnqytpVX8cDScJlRY0YIwpAjcNcuePgXP/P6Z3
0QuoP4J7WbYhuQAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 13:56'!
smallForwardIconGray
	"Private - Generated method"
	^ icons
			at: #'smallForwardGray'
			ifAbsentPut: [ self smallForwardIcon asGrayScaleWithAlpha ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallErrorIcon
	"Private - Generated method"
	^icons
			at: #smallErrorIcon
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallErrorIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 20:17'!
blankIcon
	^ self blankIconOfWidth: 16.
! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloDismissIcon
	"Private - Generated method"
	^ icons
			at: #'haloDismiss'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self haloDismissIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Komitter-UI' stamp: 'VincentBlondeau 12/16/2014 14:26'!
overlayAddIconContents
	"Private - Method generated"
	^ 'R0lGODlhCwAKAKIAAD8/X////19fXwAAAP///wAAAAAAAAAAACH5BAEAAAQALAAAAAALAAoA
AAMkSLHMpALIGV4AQoQ8qsIa511N0FngJpxfprLXIMvAWDpPrj8JADs='! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
infoIcon
	"Private - Generated method"
	^icons
			at: #infoIcon
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self infoIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:29'!
smallPrintItIcon
	"Private - Generated method"
	^ icons
			at: #'smallPrintItIcon'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallPrintItIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:48'!
instVarsSelectedIcon 
	^ icons
			at: #'instVarsSelectedIcon'
			ifAbsentPut:[ self instVarsSelectedIconContents ].! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousSearch
^ self icons
		at: #glamorousSearch ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 989855744 3019898880 3875536896 3875536896 3019898880 989855744 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2046820352 4244635648 4278190080 4278190080 4278190080 4278190080 4244635648 2046820352 16777215 16777215 16777215 16777215 16777215 16777215 16777215 989855744 4244635648 4177526784 2013265920 402653184 402653184 2013265920 4177526784 4244635648 989855744 16777215 16777215 16777215 16777215 16777215 16777215 3019898880 4278190080 2013265920 16777215 16777215 16777215 16777215 2013265920 4278190080 3019898880 16777215 16777215 16777215 16777215 16777215 16777215 3875536896 4278190080 402653184 16777215 16777215 16777215 16777215 402653184 4278190080 3875536896 16777215 16777215 16777215 16777215 16777215 16777215 3875536896 4278190080 402653184 16777215 16777215 16777215 16777215 402653184 4278190080 3875536896 16777215 16777215 16777215 16777215 16777215 16777215 3019898880 4278190080 2013265920 16777215 16777215 16777215 16777215 2013265920 4278190080 3019898880 16777215 16777215 16777215 16777215 16777215 16777215 989855744 4244635648 4177526784 2013265920 402653184 402653184 2080374784 4211081216 4278190080 1644167168 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2046820352 4244635648 4278190080 4278190080 4278190080 4278190080 4261412864 4278190080 4060086272 822083584 16777215 16777215 16777215 16777215 16777215 16777215 16777215 989855744 3019898880 3875536896 3875536896 3036676096 4110417920 4278190080 4278190080 4060086272 83886080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 805306368 4060086272 4278190080 3992977408 2281701376 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 989855744 4278190080 1476395008 150994944 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 553648128 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
forwardIcon
	"Private - Generated method"
	^ icons
			at: #'forward'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self forwardIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:49'!
packageIcon 
	^ icons
			at: #'packageIcon'
			ifAbsentPut:[ self packageIconContents ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/10/2013 13:19'!
blankIconContents
	^ Form extent: 12 @ 12 depth: 8! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:14'!
bookIconContents
	^(Form
	extent: 12@12
	depth: 32
	fromArray: #( 0 0 0 0 0 284817913 552924404 0 0 0 0 0 0 0 0 0 817149108 3747766882 4287730065 2679749049 549766340 0 0 0 0 0 0 1086110908 4016202338 4287137928 4288914339 4288914339 4289111718 3216290996 1086505666 0 0 0 816754350 4014952271 4287137928 4289309097 4289769648 4289111718 4288453788 4288453788 4288453788 2947658161 0 814846353 4283782485 4287072135 4288059030 4288059030 4288387995 4289243304 4289309097 4287927444 4287598479 2411050421 1081900156 4283585106 4286611584 4287532686 4287532686 4287466893 4287466893 4287401100 4287401100 4287401100 4288716960 2946868645 3211290728 4288651167 4287269514 4287006342 4287006342 4287006342 4286940549 4286940549 4287203721 4289177511 3483213213 281725642 2677183122 4293190884 4292861919 4289177511 4286874756 4286611584 4286611584 4287006342 4289638062 4020084125 549042617 0 282054607 2677643673 4289572269 4293256677 4292796126 4288980132 4287137928 4290164406 4020215711 816754350 0 0 0 0 551082200 2677643673 4289572269 4293256677 4292401368 4289177511 1085584564 0 0 0 0 0 0 0 551213786 2677643673 4288651167 1623244992 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: 0@0)! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:52'!
testYellowIcon 
	^ icons
			at: #'testYellowIcon'
			ifAbsentPut:[ self testYellowIconContents ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallLanguageIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAG/SURBVDjLjZK9T8JQFMVZTUyc
3IyJg4mDi87+GyYu6qB/gcZdFxkkJM66qJMGSNRBxDzigJMRQ1jQ4EcQ+SgVKB+FtuL13EdJ
xNDq8Ev7Xu85797T51nwhqeAH5w6cAxWwDgReX7jwYfdaCIraroptB7NLlVQrOoiGEsL1G06
GZyxuILicsMUH3VTlOqGKNUMUdTacj+j1Nng0NGAT2WxYosK1bbIVVoiW27J9V8G57WWKVSc
zMV5iK+Tudv1vVh5yXdlLQN+os4AFZss2Ob82CCgQmhYHSnmkzf2b6rIhTAaaT2aXZALIRdC
LgRtkA1WfYG4iKcVYX52JIs7EYvFmJ8wGiEXQi6EXAhdyn2MxQaPcg68zIETTvzyLsPzWnwq
ixVbhFwI3RFykes+A9vkIBKX4jCoIxdCLrI4/0OcUXXK4/1dbbDBS088xGGCCzAJCsiF2lan
T8xdKNhHXvRarLFBqmcwCrbAhL32+kP3lHguETKRsNlbqUFPeY2OoikW62DNM+jf2ibzQNN0
g5ALC75AGiT59oIReQ+cDGyTB+TC4jaYGXiRXMTD3AFogVmnOjeDMRAC025duo7wH74BwZ8J
lHrTPLcAAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 6/7/2013 16:40'!
addIcon 
	^ icons
			at: #'addIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self addIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
checkBoxPressedIcon
	"Private - Generated method"
	^ icons
			at: #'checkBoxPressed'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self checkBoxPressedIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:28'!
smallLoadProjectIcon
	"Private - Generated method"
	^ icons
			at: #'smallLoadProject'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallLoadProjectIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousBug
^ self icons
		at: #glamorousBug ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1224736768 503316480 16777215 1224736768 503316480 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 268435456 4278190080 4278190080 2181038080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2734686208 4278190080 4177526784 4278190080 2365587456 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 150994944 4278190080 4278190080 4278190080 4278190080 4043309056 150994944 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2634746635 4278190080 4283190348 4286216826 4283190348 4278190080 1478895142 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2450065673 4278190080 4293454056 4294967295 4294967295 4294967295 4293454056 4179171609 2450065673 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3976923915 4292532954 4294967295 4294967295 4294967295 4294967295 4294967295 4292532954 3976923915 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3976923915 4292532954 4294967295 4294967295 4294967295 4294967295 4294967295 4292532954 3976923915 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2450065673 4179237402 4293388263 4294967295 4294967295 4294967295 4293388263 4278190080 2450065673 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2685078283 4278190080 4065349712 4202462332 4065349712 4278190080 2282819857 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 469762048 1543503872 2147483648 1543503872 469762048 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
radioButtonOnIcon
	"Private - Generated method"
	^ icons
			at: #'radioButtonOn'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self radioButtonOnIconContents readStream) ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
windowIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAFiSURBVBgZpcEhbpRRGIXh99x7
IU0asGBJWEIdCLaAqcFiCArFCkjA0KRJF0EF26kkFbVVdEj6/985zJ0wBjfp8ygJD6G3n358
fP3m5NvtJscJYBObchEHx6QKJ6SKsnn6eLm7urr5/PP76cU4eXVy/ujouD074hDHd5s6By7G
Zknb3P7mUH+WNLZGKnx595JDvf96zTQSM92vRYA4lMEEO5RNraHWUDH3FV48f0K5mAYJk5pQ
QpqIgixaE1JDKtRDd2OsYfJaTKNcTA2IBIIesMAOPdDUGYJSqGYml5lGHHYkSGhAJBBIkAoW
REAT3Z3JLqZhF3uS2EloQCQ8xLBxoAEWO7aZxros7EgISIIkwlZCY6s1OlAJTWFal5VppMzU
gbAlQcIkiT0DXSI2U2ymYZs9AWJL4n+df3pncsI0bn5dX344W05dhctUFbapZcE2ToiLVHBM
bGymS7aUhIdoPNBf7Jjw/gQ77u4AAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'TudorGirba 3/28/2015 21:23'!
glamorousTable
^ self icons
		at: #glamorousTable ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 0 0 0 4278190080 0 0 0 0 0 4278190080 0 0 0 0 0 4278190080 0 0 0 4278190080 0 0 0 0 0 4278190080 0 0 0 0 0 4278190080 0 0 0 4278190080 0 0 0 0 0 4278190080 0 0 0 0 0 4278190080 0 0 0 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 0 0 0 4278190080 0 0 0 0 0 4278190080 0 0 0 0 0 4278190080 0 0 0 4278190080 0 0 0 0 0 4278190080 0 0 0 0 0 4278190080 0 0 0 4278190080 0 0 0 0 0 4278190080 0 0 0 0 0 4278190080 0 0 0 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 0 0 0 4278190080 0 0 0 0 0 4278190080 0 0 0 0 0 4278190080 0 0 0 4278190080 0 0 0 0 0 4278190080 0 0 0 0 0 4278190080 0 0 0 4278190080 0 0 0 0 0 4278190080 0 0 0 0 0 4278190080 0 0 0 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: (0@0))]! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousBookmark
^ self icons
		at: #glamorousBookmark ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3321888768 4009754624 4194304000 3909091328 3254779904 2130706432 251658240 2147483648 3254779904 3909091328 4194304000 4009754624 3321888768 16777215 16777215 16777215 4278190080 285212672 33554432 335544320 1157627904 3456106496 4278190080 3422552064 1157627904 335544320 33554432 285212672 4278190080 16777215 16777215 16777215 4261412864 16777215 16777215 16777215 16777215 16777215 4278190080 16777215 16777215 16777215 16777215 16777215 4261412864 16777215 16777215 16777215 4278190080 16777215 16777215 16777215 16777215 16777215 4278190080 16777215 16777215 16777215 16777215 16777215 4278190080 16777215 16777215 16777215 4278190080 16777215 16777215 16777215 16777215 16777215 4278190080 16777215 16777215 16777215 16777215 16777215 4278190080 16777215 16777215 16777215 4278190080 16777215 16777215 16777215 16777215 16777215 4278190080 16777215 16777215 16777215 16777215 16777215 4278190080 16777215 16777215 16777215 4278190080 16777215 16777215 16777215 16777215 16777215 4278190080 16777215 16777215 16777215 16777215 16777215 4278190080 16777215 16777215 16777215 4278190080 1946157056 2181038080 1862270976 1191182336 268435456 4278190080 268435456 1191182336 1862270976 2181038080 1946157056 4278190080 16777215 16777215 16777215 1862270976 2348810240 2063597568 2399141888 3221225472 4278190080 4278190080 4278190080 3221225472 2399141888 2063597568 2348810240 1862270976 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 637534208 4278190080 654311424 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallVolumeIconContents
	"Private - Method generated with the content of the file /home/dgd/smallVolume.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAQAAAC1+jfqAAAAAmJLR0QA/4ePzL8AAAE3SURB
VHjajdE/SJRxHMfxF/f8Hp/n7vLhlAKhyKRCOpccA6EbFEW0BsciyKWphiBoCRuiQXEJnIyG
ampyEppydy8wBOFEyPzHA0X1wNGggV0Ivbbv8h3eH44rKWkT/XUNqdhxgrjz5kBTA90SiVlD
h0+PdI6PvZhKwDmPVL13G4KaOqcuTL+6k3z8iis+Sd0175pxy0H91ss066g+SKo+Q68uq4Zd
9M5DyyUdE6dHzg7XIrmdM7XHPriq8NoNaxJdgRypA7/Ezo8e9NjDpgzfhMC+kp92FXZb++u+
KKPbd5S1Ak2xVJ+WH3nzqQE5Jq3IpPJgY2GOrDe+NxhCYUvZkkGXvHHfkuJPhkr/4pNiZlsD
dbPq+ryVHS9Zqc1c39JAJhF5Zqw9dsXzw7yIXBb/u0fUNt7/+A0ZzEdfNHX2/wAAAABJRU5E
rkJggg=='! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 9/19/2013 13:00'!
changeEmptyIcon 
	^ self emptyIcon
! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'BenjaminVanRyseghem 12/5/2013 12:33'!
checkedBoxIcon
	"Private - Generated method"
	
	^ icons
			at: #checkedBox
			ifAbsentPut: [ Form
				extent: 12@12
				depth: 32
				fromArray: self checkedBoxIconContents 
				offset: 0@0 ]! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'ChristopheDemarey 7/26/2013 13:17'!
bottomIconContents
	"Private - Method generated"
	"Icon from http://tango.freedesktop.org/Tango_Icon_Library, public domain"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABl0
RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAAIpSURBVDiNlVI7aFNhGD3/fSQ3
UixETTokRamvRbB2Mq0IHQQlHYqIi0MdRbCI1sFdEHpHB6FLpg5SUQlthEw+roVQSzQ0QotC
h5SkNVoxTe+9/+NziMTUpGIP/Mvh43z/Od9hRIRWDE6YZRCi6ASGijPJe1opo22IELVvPoFQ
AkL5kIpDKA4uPTxM3W4TbhcAwJiG3GoantiGK7bg8S2cPTLa8VNaRxYMjP1+YABjkIrvRaCR
CxGBQADRrgLG0D3TIYVEc7cOl4gspSSIFIgUfLkNrnwwHe7gXbOZOtPwziCFVCzS13/r8oOQ
oQdApCxJAopJQBcABMqby2D6Jdy4et8CAZz7mMmm6t9/fE0xIsLQhDlz7vTF5PDAaLBYeQPJ
fEj4+OaWsFb7BK58gAhEGs73XsNiYcErLufTbyf5Fa3hFWOv85nKl/ISxcLHQRrHureCkvsR
LCgQCGkwQzr6Y8OoblapuJKvEOF6M0TH5jUQktMvH7sGs2CaJjb8zzAtHQFLQyCkIx4+hkio
D9lXsy4pJB2b13ZcwbF5QQhvfDrzqH5wXxxdoW6Ywcbm/V3dOBW5gHT2aZ1zf9yxeaHjGR2b
T5U2VjO5D44/0DMCzWAwAhrOREeQez/vr1fX5hybT+04Y1sDFMYWCvNLvbHD8aPhBNMNDdXS
T8otOmUlG77/WSTH5jWSSM5mX7iHcBIH1Ak8n3vmKvnHdytY4o5Bf5N7wS5V/n/8AqomDSpi
zBsRAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 13:55'!
bottomIcon 
	^ icons
			at: #'bottomIcon'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self bottomIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:35'!
workspaceIcon
	"Private - Generated method"
	^ icons
			at: #'workspaceIcon'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self workspaceIconContents readStream) ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'CamilloBruni 9/14/2013 16:24'!
removeIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAJdSURBVDjLpZP7S1NhGMf9W7Yf
ogSJboSEUVCY8zJ31trcps6zTI9bLGJpjp1hmkGNxVz4Q6ildtXKXzJNbJRaRmrXoeWx8tJO
TWptnrNryre5YCYuI3rh+8vL+/m8PA/PkwIg5X+y5mJWrxfOUBXm91QZM6UluUmthntHqplx
Uml2lciF6wrmdHriI0Wx3xw2hAediLwZRWRkCPzdDswaSvGqkGCfq8VEUsEyPF1O8Qu3O7A0
9RbRvjuIttsRbT6HHzebsDjcB4/JgFFlNv9MnkmsEszodIIY7Oaut2OJcSF68Qx8dgv8tmqE
L1gQaaARtp5A+N4NzB0lMXxon/uxbI8gIYjB9HytGYuusfiPIQcN71kjgnW6VeFOkgh3XcHL
vAwMSDPohOADdYQJdF1FtLMZPmslvhZJk2ahkgRvq4HHUoWHRDqTEDDl2mDkfheiDgt8pw34
0/EocuClCuFvboQzb0cwIZgki4KhzlaE6w0InipbVzBfqoK/qRH94i0rgokSFeO11iBkp8Ed
V8cfJo0yD75aE2ZNRvSJ0lZKcBXLaUYmQrCzDT6tDN5SyRqYlWeDLZAg0H4JQ+Jt6M3atNLE
10VSwQsN4Z6r0CBwqzXesHmV+BeoyAUri8EyMfi2FowXS5dhd7doo2DVII0V5BAjigP89GEV
Atda8b2ehodU4rNaAW+dGfzlFkyo89GTlcrHYCLpKD+V7yeeHNzLjkp24Uu1Ed6G8/F8qjqG
Rzlbl2H2dzjpMg1KdwsHxOlmJ7GTeZC/nesXbeZ6c9OYnuxUc3fmBuFft/Ff8xMd0s65SXIb
/gAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloFontSizeIcon
	"Private - Generated method"
	^ icons
			at: #'haloFontSize'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self haloFontSizeIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:43'!
classVarsSelectedIcon 
	^ icons
			at: #'classVarsSelectedIcon'
			ifAbsentPut:[ self classVarsSelectedIconContents ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallQuitIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAJHSURBVDjLlZPNi81hFMc/z713
7p1mTCFvNZfGSzLIWNjZKRvFRoqNhRCSYm8xS3+AxRRZ2JAFJWJHSQqTQkbEzYwIM+6Yid/z
nJfH4prLXShOnb6r8/nWOd8Tcs78bz0/f+KMu50y05nK/wy+uHDylbutqS5extvGcxaWqtoG
DA8PZ3dnrs2srQc2Zko41UXLmLdyDW5OfvsUkUgbYGbU63UAQggdmvMzFmzZCgTi7CQmkZwd
EaX0JwDgTnGbTCaE0G4zw80omhPI92lcEtkNkdgJCCHwJX7mZvNaB0A14SaYJlwTrpHsTkoF
lV1nt2c3x5YYo1/vM9A/gKpxdfwyu/v3teCayKq4JEwT5EB2R6WgYmrs2bYbcUNNUVfEhIfF
Yy69uci+1fuRX84mkawFSxd/4nVWUopUVIykwlQxRTJBTIDA4Pp1jBZPuNW4wUAPmCqWIn29
X1k4f5Ku8g9mpKCkakRLVEs1auVuauVuyqHMo8ejNCe+sWPVTkQKXCMmkeZUmUZjETF1tc6o
oly+fgUVw9So1/tRN6YnZji46QghBFKKuAouERNhMlbAHZFE6e7pB+He8MMw+GGI4xtOMf1+
lsl3TQ4NHf19BSlaO1DB9BfMHdX0O0iqSgiBbJkjm491hClJbA1LxCURgpPzXwAHhg63necA
Ii3XngXLcRU0fof8ETMljIyM5LGxMcbHxzvy/6fuXdWgt6+PWncv1e4euqo1ZmabvHs5+jn8
yzufO7hiiZmuNpNBM13rbvVSpbrXJE7/BMkHtU9jFIC/AAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallBarcodeIconContents
	"Private - Method generated with the content of the file smallBarcode.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAAXNSR0IArs4c6QAAAARnQU1B
AACxjwv8YQUAAAAgY0hSTQAAeiYAAICEAAD6AAAAgOgAAHUwAADqYAAAOpgAABdwnLpRPAAA
ABh0RVh0U29mdHdhcmUAUGFpbnQuTkVUIHYyLjcyclqEXQAAAIRJREFUOE/tUkkOgCAMLBef
qSZePPMIn+MLMbWjbWgaT8BRksmwDNNCm5g5EREL2oYYUA8QFdF7gATahj39uY2FsZ/Hsw9t
vfgbDPpEX1CrRixyqNiAPujqRC7HxCWTsAAcscseYBroKvRgU5EJwXPA8mqus0KM1MCieIbp
6qJbZj6DTDcgu0pIJUVp4QAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:19'!
arrowDoubleUpIconContents
	^ Form
		extent: 12@6
		depth: 32
		fromArray:  #(16777215 16777215 16777215 16777215 16777215 2315466752 2315466752 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1308764928 3959984384 3959984384 1308764928 16777215 16777215 16777215 16777215 16777215 16777215 16777215 402722560 3590744064 4278962688 4278962688 3590744064 402722560 16777215 16777215 16777215 16777215 16777215 33554432 3120842496 4278962176 4278962688 4278962688 4278962176 3120842496 33554432 16777215 16777215 16777215 16777215 1644306688 3540342528 3590744064 4278961664 4278961664 3590744064 3540342528 1644306688 16777215 16777215 16777215 16777215 16777215 16777215 1711418368 4278893824 4278893824 1711418368 16777215 16777215 16777215 16777215)
		offset: 0@0! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallCenteredIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAQAAAC1+jfqAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAB8SURBVCjPY/zPgB8wMVCqgAVE
lP//x/AHDH+D4S8w/sWwl5GBgfE/MSYwMORk/54C0w2FOcemgmSIMyH1P7LNCHiLBDcEZ/+a
gqwXaFbOIxLc4P0f1e7fUPiZGDcw/AdD02z9/5r/Vf7L/Zf8L/Kf/z/3f/ZsiAwjxbEJAKUI
VgAswNGVAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 7/25/2013 11:12'!
databaseAddIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAIkSURBVDjLpVNNiFJRFP7eU1E0
KSLTMpAwYSxyaidDtChm0WYQ3NSutv2s2kwwm2igNgMtooUQEQhhA9GqhSDTQsZZFDbNDBgV
g5bSw9J8rzFF33udc+HGg0ladOHj3nPe+b7zc99VbNvG/yy30yiVSl4SnCNcsixrivYEgY7W
Ju0faX9EKGUyGVNyFFkBkY/T+WkoFEpFIhEEAgH4/X7w916vB8Mw0Gg00G63y+S7mM1mm4LI
AYxisbhSr9c5nT1pjUYju1qt2oVC4YnkqbIUMk6Ew+F/9hyNRkFJLuyaATmFoqZp8Pl88Hq9
8Hg8wtfv99HpdNBsNhGPx0XsRAG3241ut4vBYCDs8XgMXdcxHA7FN/b9VUD25HK5RAUczKC+
hYgcNpNN05xcAQdLkqIoIlj6VFWdXIEUkAQGV8M2k2vaG3z6sYGfVR39XzsHlm/dX3h5d31x
lwAHM5goBd5+LuO75z3OnU3jyP4EVrZeKGub2p309cP7VKcAQ2Znoiz3deMVTk1Nw1RNTB+a
hamMkD45w7RrfwSYwFdFf6K4Quf6pmvwKHswl7wh7Jvnc4gfTPHR52zhcqVSeZZMJgOxWEyI
8BC5CmOnh63WKtZbZczPPsa94hX4XCLJQHG+xnw+f5SEFghZmvhefgvcTqn2HN3gBmZSZ5CI
nMaHr1Wsvivjy3ZvSZn0nHO5XJDIxwgWDbW2vL10m9xXCUGCQXi49qA1/xvyq6BCh7yZeQAA
AABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
userIconContents
	"Private - Method generated with the content of the file /Users/MAC/Desktop/Dev/Resources/extras/famfamfam_silk_icons_v013/icons/user.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAJ3SURBVDjLpZNtSNNRFIcNKunF
1rZWBMJqKaSiX9RP1dClsjldA42slW0q5oxZiuHrlqllLayoaJa2jbm1Lc3QUZpKFmmaTMsa
Rp+kMgjBheSmTL2//kqMBJlFHx44XM7vOfdyuH4A/P6HFQ9zo7cpa/mM6RvCrVDzaVDy6C5J
JKv6rwSnIhlFd0R0Up/GwF2KWyl01CTSkM/dQoQRzAurCjRCGnRUUE2FaoSL0HExiYVzsQwc
j6RNrSqo4W5Gh6Yc4+1qDDTkIy+GhYK4nTgdz0H2PrrHUJzs71NQn86enPn+CVN9GnzruoYR
63mMPbkC59gQzDl7pt7rc9f7FNyUhPY6Bx9gwt4E9zszhWWpdg6ZcS8j3O7zCTuEpnXB+3MN
ZkUUZu0NmHE8XsL91oSWwiiEc3MeseLrN6woYCWa/Zl8ozyQ3w3Hl2lYy0SwlCUvsVi/Gv2J
wITnYPDun2Hy6jYuEzAF1jUBCVYpO6kXo+NuGMeBAgcgfwNkvgBOPgUqXgKvP7rBFvRhE1cr
p8Vq1noFYSlacVyqGk0D86gbART9BDk9BFnPCNJbCY5aCFL1Cyhtp0RWAp74MsKSrkq9guHy
vfMTtmLc1togpZoyqYmyNoITzVTYRJCiXYBIQ3CwFqi83o3JDhX6C0M8XsGIMoQ4OyuRlq1D
dZcLkmbgGDX1iIEKNxAcbgTEOqC4ZRaJ6Ub86K7CYFEo8Qo+GBQlQyXBczLZpbloaQ9k1NUz
/kD2myBBKxRZpa5hVcQslalatoUxizxAVVrN3CW21bFj9F858Q9dnIRmDyeuybM71uxmH9BN
BB1q6zybV7H9s1Ue4PM3/gu/AEbfqfWy2twsAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:30'!
smallPublishIcon
	"Private - Generated method"
	^ icons
			at: #'smallPublish'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallPublishIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:45'!
exceptionIcon 
	^ icons
			at: #'exceptionIcon'
			ifAbsentPut:[ self exceptionIconContents ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallCopyIcon
	"Private - Generated method"
	^ icons
			at: #'smallCopy'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallCopyIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallFontsIcon
	"Private - Generated method"
	^ icons
			at: #'smallFonts'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallFontsIconContents readStream) ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
versionControlIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QAAAAAAAD5Q7t/AAAA
CXBIWXMAAA3XAAAN1wFCKJt4AAAAB3RJTUUH1QYQEhgJtRvS4AAAAalJREFUOMutkjFoVEEQ
hr/Z2913d8k9YgxBrhARBJEgSSOKTcTGUgkoh41YKJYRCzuvSCkepBGUFLEJaBUsBEUPtRT0
mohibIyYIipRouFd3tuxeDkVI3hRp5nZgf+b2ZmBfzQBaNTMMPBsk9qR8ZnQkkbNNIHRs1cX
9P38YxVbNqAAGCO5F0g+L2JKAxlpIi+e3jNzD6cB6hbg9OVWliy/MbOTp8Q7B8DaWhsfRQiC
cw5TcPi4Wjh28Q5Lb5+z+8AYr1v3Ry2wQ4yYkKViCp405P1FvQMAVPqrIAaA6q59tFfeEShQ
2bINDdmwBfqSlQ+8fHKbkxemQLMNn1UFUAht0o+vSFY/4YoxABYoPro5IYePnoP0C2SroAHV
DEKKash9WAdrYM/e/TyYvQ5o0QJ+cPuQYozgK0Dlx3pQJK+9/qYzX4ZGDrIw14ykUTOXgPpf
nkG9cwd65MR5luebXaninYe4e+sK4zNBbCfpozI98dauAM5H3+OfACWI+7sCmKi4EeBKPdgu
Aan7XQdxleB7/yDN9xGC/AKw5WvTE8fPbGb8XxO9wf+wb+DSh8wTKaW0AAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/13/2013 16:02'!
processBrowserIcon
	^ icons
			at: #'processBrowserIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self processBrowserIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:44'!
dirtyMonticelloPackageIcon 
	^ icons
			at: #'dirtyMonticelloPackageIcon'
			ifAbsentPut:[ self dirtyMonticelloPackageIconContents ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:28'!
smallJustifiedIcon
	"Private - Generated method"
	^ icons
			at: #'smallJustified'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallJustifiedIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:46'!
flagIcon 
	^ icons
			at: #'flagIcon'
			ifAbsentPut:[ self flagIconContents ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallExpertIcon
	"Private - Generated method"
	^ icons
			at: #'smallExpert'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallExpertIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:21'!
dirtyMonticelloPackageIconContents

	^ (Form
		extent: 16@16
		depth: 32
		fromArray: #(16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 722731779 2235369994 3106932744 3394768655 301989888 16777215 16777215 100663296 2707033871 2689666317 3240297990 16777215 16777215 16777215 1985285646 3527478027 3207858441 3040217353 3577022729 4241039649 1496975882 16777215 673974023 3692692484 4156563488 3157854473 3023636745 16777215 16777215 16777215 1817054477 2200963080 16777215 2725122578 2859602707 3583055896 2674987795 959645704 3609199877 2486634761 4021558814 3257271814 924976646 16777215 16777215 16777215 16777215 33554432 16777215 3381204759 2169310477 2792296978 3464303893 3642819845 268435456 2943750931 3279885589 3408004614 16777215 16777215 16777215 16777215 16777215 16777215 706675973 3967620373 606012677 2186087693 4105248029 857801989 50331648 3667007512 2487290635 3207399175 16777215 16777215 16777215 16777215 16777215 16777215 2438729487 3094811668 16777215 3375040263 4088405277 503316480 975635974 4171504411 2350777605 2285767178 16777215 16777215 16777215 16777215 16777215 150994944 3715371795 1564477962 1598294795 3324184070 4189134109 1278085128 1984236299 3750762520 2721778186 1092551941 16777215 16777215 16777215 16777215 16777215 2270104845 3278114832 16777216 3593209607 1124598017 4120516889 637927681 2355040272 3246396693 3240625927 167772160 16777215 16777216 16777215 16777215 959908105 3747549200 858916872 1093601288 3023702538 1782516234 3598915094 33554432 2590839314 2910327828 3357607173 16777215 16777215 2065368068 16777215 1278806281 3612675598 1682771213 16777215 2605059084 1664682249 3026587921 2371227150 16777215 2506625297 2472874257 3324052741 33554432 16777215 2721253384 3694200840 3444116492 1296042506 16777215 16777215 1950485259 3693544966 3376548619 100663296 83886080 3259763981 3727624200 3927376900 3726115844 689570820 16777215 67108864 16777215 16777215 16777215 16777215 16777215 637534208 33554432 16777215 639042564 3056273159 67108864 538248196 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
		offset: 0@0)! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'TudorGirba 2/27/2015 23:53'!
glamorousPreferencesIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAAXNSR0IArs4c6QAAAAlwSFlz
AAALEwAACxMBAJqcGAAAAdVpVFh0WE1MOmNvbS5hZG9iZS54bXAAAAAAADx4OnhtcG1ldGEg
eG1sbnM6eD0iYWRvYmU6bnM6bWV0YS8iIHg6eG1wdGs9IlhNUCBDb3JlIDUuNC4wIj4KICAg
PHJkZjpSREYgeG1sbnM6cmRmPSJodHRwOi8vd3d3LnczLm9yZy8xOTk5LzAyLzIyLXJkZi1z
eW50YXgtbnMjIj4KICAgICAgPHJkZjpEZXNjcmlwdGlvbiByZGY6YWJvdXQ9IiIKICAgICAg
ICAgICAgeG1sbnM6dGlmZj0iaHR0cDovL25zLmFkb2JlLmNvbS90aWZmLzEuMC8iPgogICAg
ICAgICA8dGlmZjpDb21wcmVzc2lvbj41PC90aWZmOkNvbXByZXNzaW9uPgogICAgICAgICA8
dGlmZjpQaG90b21ldHJpY0ludGVycHJldGF0aW9uPjI8L3RpZmY6UGhvdG9tZXRyaWNJbnRl
cnByZXRhdGlvbj4KICAgICAgICAgPHRpZmY6T3JpZW50YXRpb24+MTwvdGlmZjpPcmllbnRh
dGlvbj4KICAgICAgPC9yZGY6RGVzY3JpcHRpb24+CiAgIDwvcmRmOlJERj4KPC94OnhtcG1l
dGE+CrDjMt0AAAC6SURBVDgRY2AY9uAh0Iez8PmSCYtkA1CsCIh5gVgSiFWAWBSIjwNxPRAT
BCCF/4H4G5QGsX9B2YVAmiDQAaoAaQLhI0B8D8q+C6QJApB/zwAxSPM6qGoOIP0GKvYTSIPC
BQ5Y4CwIwx1IgfyNC+wFSjzBJQkTBxkA8zOyF74AxYVgivDRoBiAhQGMfgYVAwUwCmBG4UE4
IG+wA7EtEJsCsQQQiwDxRyB+DMQHgZhoAApUlEAjWufQUQgA5nMrmIOiLkYAAAAASUVORK5C
YII='! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:23'!
morphIconContents
	^ ((ColorForm
	extent: 12@12
	depth: 8
	fromArray: #( 1578631802 292362797 539127618 1895825665 2117994270 1445606482 202325275 1997372285 33573212 859313989 1763509875 1213866361 1064308758 192424752 1645101626 793665883 476466020 85208644 1751792704 621947215 1414349622 527711064 676669009 1346794755 1617375851 1095982919 656635516 1819423020 354700362 1695037706 154613091 420699479 75263577 2139062143 2139062143 2139062143)
	offset: 0@0)
	colorsFromArray: #(#(0.557 0.714 0.898) #(0.526 0.686 0.887) #(0.557 0.706 0.887) #(0.494 0.604 0.796) #(0.494 0.6 0.792) #(0.585 0.811 1.0) #(0.879 0.93 0.883) #(0.514 0.671 0.867) #(0.84 0.867 0.902) #(0.581 0.667 0.804) #(0.474 0.577 0.753) #(0.729 0.851 0.674) #(0.51 0.678 0.883) #(0.565 0.71 0.918) #(0.733 0.894 1.0) #(0.538 0.694 0.883) #(0.455 0.741 1.0) #(0.553 0.69 0.871) #(0.969 0.867 0.78) #(0.506 0.635 0.815) #(0.757 0.906 1.0) #(0.851 0.879 0.922) #(0.655 0.844 1.0) #(0.836 0.918 0.992) #(0.604 0.741 0.902) #(0.518 0.631 0.804) #(0.542 0.678 0.855) #(0.549 0.698 0.883) #(0.753 0.875 0.725) #(0.815 0.894 0.823) #(0.51 0.667 0.863) #(0.639 0.733 0.91) #(0.522 0.659 0.84) #(0.686 0.757 0.867) #(0.542 0.671 0.836) #(1.0 0.949 0.612) #(0.848 0.859 0.894) #(0.988 0.949 0.918) #(1.0 0.682 0.514) #(0.984 0.871 0.415) #(1.0 0.796 0.674) #(0.977 0.914 0.867) #(0.518 0.671 0.859) #(0.585 0.776 0.518) #(0.836 0.879 0.922) #(0.534 0.671 0.851) #(0.706 0.757 0.855) #(0.643 0.745 0.879) #(0.819 0.918 1.0) #(0.827 0.871 0.906) #(0.458 0.721 0.404) #(0.62 0.737 0.891) #(0.51 0.631 0.8) #(0.577 0.663 0.848) #(0.506 0.612 0.776) #(0.565 0.671 0.84) #(0.926 0.961 0.992) #(0.581 0.659 0.792) #(0.545 0.639 0.792) #(0.4 0.686 0.353) #(0.811 0.898 0.827) #(0.561 0.706 0.883) #(0.518 0.674 0.871) #(0.659 0.757 0.891) #(0.887 0.945 0.902) #(1.0 0.84 0.717) #(0.717 0.776 0.863) #(0.678 0.745 0.859) #(0.538 0.628 0.776) #(0.898 0.945 0.992) #(1.0 0.918 0.549) #(0.996 0.961 0.757) #(0.863 0.93 0.992) #(0.474 0.628 0.827) #(0.844 0.871 0.914) #(0.62 0.807 0.581) #(0.848 0.867 0.91) #(0.988 0.977 0.898) #(0.804 0.914 1.0) #(0.98 0.977 0.934) #(0.957 0.84 0.365) #(0.961 0.93 0.714) #(0.596 0.678 0.815) #(1.0 0.6 0.314) #(0.953 0.937 0.823) #(1.0 0.538 0.243) #(0.502 0.659 0.855) #(0.498 0.596 0.768) #(0.549 0.792 0.577) #(0.612 0.682 0.807) #(0.914 0.957 0.992) #(0.706 0.863 1.0) #(0.482 0.616 0.8) #(0.498 0.624 0.792) #(0.694 0.757 0.863) #(1.0 0.737 0.569) #(0.631 0.721 0.902) #(0.522 0.772 1.0) #(0.549 0.792 1.0) #(0.553 0.647 0.823) #(0.836 0.926 1.0) #(0.84 0.863 0.891) #(0.423 0.717 0.423) #(0.788 0.898 0.733) #(0.612 0.729 0.887) #(0.918 0.953 0.922) #(0.934 0.965 0.934) #(0.616 0.831 0.628) #(0.53 0.643 0.807) #(0.545 0.686 0.863) #(0.502 0.596 0.753) #(0.616 0.702 0.823) #(0.772 0.898 1.0) #(0.581 0.686 0.844) #(0.851 0.891 0.934) #(0.937 0.965 0.992) #(0.729 0.859 0.686) #(0.671 0.745 0.879) #(0.682 0.749 0.879) #(0.545 0.698 0.898) #(0.388 0.682 0.341) #(0.534 0.639 0.8) #(0.561 0.702 0.883) #(0.553 0.706 0.91) #(0.486 0.588 0.776) #(0.542 0.698 0.887) #(0.522 0.678 0.875) #( ) ))! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:29'!
smallDebugIcon
	"Private - Generated method"
	^ icons
			at: #'smallDebug'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallDebugIconContents readStream) ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
processBrowserIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAA
CXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1QoTETo0n8IkZwAAAfBJREFUOMulkz1oFEEY
hp/dmZ3dvcIUIhLRS2EMQtBIAgEhYGFzYBEkarQRUliJwUYRDy6FpLCyMYKVVoaTSIhYnEIq
G0FEPUm0CYIH8c40CoJ3O38WMTEhJ0p84WW6Z57h+yYolYoPgHNsI977aUqlom+1mr7Zavq/
xTnnM52tt1QqerlGm7g7T7lS/aebRwuHuXCiBwAJEEWKcqWK6gAlY4gUZ44uQxAy+6YLnAc8
GIs2hnKlyvjpPgDCjWQVp0RpytmhOheHBxFKkiYJaS5FJSkil5AkCQDWmN8GaxEqRiQx/T17
CHMF+rsbqOgTjxcOILwDI8lCDYCxdqtBlChGBmvs29XBy6UGXflTiEiSJDFRohBxhIrVnw1O
DtQIA4nIFeDbLEEwgpCCq8efs1DfjbMO6yxTbwOMbQO4PHqdgICPtRneL38lvxcO5XdypNMw
2DeO9wCeqfu32gNuz9xEKIGUEUIKPjfm6N0/ysPXNcz3O1hjscb+eoLdCnjyrpsoVahYEcUK
IT9wsPMZvlkjDAKeLvXS/JEBi+0NYHXeFkfoHc45Lj3qwPkdaG3QVmNxqwYbAVpnjA0PcG/u
1Sbc4jzAi7abuPJlZbPBlfNDXBs7htYZWStDG43Wa+eGGk2jUV+HSWB6cvLG9n/j/+YncEMA
U9mo9IEAAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
expandBoxIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/expandBox.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAAAoAAAAKCAYAAACNMs+9AAAAS0lEQVR4XmNgZGR8zogFM6AD
bIJAsW+SkpLPQRguj0Ph84aGhv0obNooBLkJ3TMYCkEA5GgQBx1jVciAA6AoZMQRlujOAANs
ViNjAKn5Ws2+WwvGAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/26/2015 17:38'!
spotterForIconsFor: aStep
	<spotterOrder: 10>
	self flag: #maybeRewriteForDirectStreaming.
	aStep listProcessor
		title: 'Icons';
		allCandidates: [ 
			self iconSelectors asSortedCollection 
				collect: [ :each | each -> (self perform: each) ] ];
		itemIcon: #value;
		itemName: #key;
		actLogic: [ :association | (self class lookupSelector: association key) browse ];
		filter: GTFilterSubstring! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallCopyIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QAAAAAAAD5Q7t/AAAA
CXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1QoaFAgvgxQ0mwAAAX9JREFUOMuVk0tLAlEY
ht8jM2PagP0KzwjdFv2PCFq2iKB1F/BCtrBFkXbbREREG7E2Bf4EMbM2gWUwo7+gmjAFN83t
tGl0Rkexb/Wdw3kf3vfjO+ToJDOv6/osRijBz71trsXvnHecYRjT8ejWKHqkD/YmAbgBdtNq
NcEY6xMRQgAAodCEJ5RzHmq1Gl6rlYXGd2NmkIv9zG7K7nmev3UBJElCsVSY+kekRRdAUZRO
jFarOVRsR3IBKKUolgqdsyzLnuJIJNI/A8YYZFl2DdL5cFC5AJRSlMrFoQ56oZwttiwGRRnN
QTA4jna73QXoug7GGMJhivJTaagDSiWYpoHKS6UL0LQfBAJjsCw21O7l1QUeHu/dEQSer56d
n7oWhzHL07YoilhZXoVlmVC/VOSus+A21qN5AHnHcmwbhuHrFTtLVVXkbrIA8OzzGpKm6fD7
/RAEAaIoghCCer0OgODj890WpxKx5BzpFR8ep7OmaS55fay/KgAoJGLJHQD4BUJZpgMViPfY
AAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
openIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAGrSURBVDjLxZO7ihRBFIa/6u0Z
W7GHBUV0UQQTZzd3QdhMQxOfwMRXEANBMNQX0MzAzFAwEzHwARbNFDdwEd31Mj3X7a6uOr9B
tzNjYjKBJ6nicP7v3KqcJFaxhBVtZUAK8OHlld2st7Xl3DJPVONP+zEUV4HqL5UDYHr5xvuQ
Ajgl/Qs7TzvOOVAjxjlC+ePSwe6DfbVegLVuT4r14eTr6zvA8xSAoBLzx6pvj4l+DZIezuVk
G9fY2H7YRQIMZIBwycmzH1/s3F8AapfIPNF3kQk7+kw9PWBy+IZOdg5Ug3mkAATy/t0usovz
GeCUWTjCz0B+Sj0ekfdvkZ3abBv+U4GaCtJ1iEm6ANQJ6fEzrG/engcKw/wXQvEKxSEKQxRG
KE7Izt+DSiwBJMUSm71rguMYhQKrBygOIRStf4TiFFRBvbRGKiQLWP29yRSHKBTtfdBmHs0B
UpgvtgF4yRFR+NUKi0XZcYjCeCG2smkzLAHkbRBmP0/Uk26O5YnUActBp1GsAI+S5nRJJJal
5K1aAMrq0d6Tm9uI6zjyf75dAe6tx/SsWeD//o2/Ab6IH3/h25pOAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallSaveIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QAAAAAAAD5Q7t/AAAA
CXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1QsKDTcPnirYvwAAAIx0RVh0Q29tbWVudABN
ZW51LXNpemVkIGljb24KPT09PT09PT09PQoKKGMpIDIwMDMgSmFrdWIgJ2ppbW1hYycgU3Rl
aW5lciwgCmh0dHA6Ly9qaW1tYWMubXVzaWNoYWxsLmN6CgpjcmVhdGVkIHdpdGggdGhlIEdJ
TVAsCmh0dHA6Ly93d3cuZ2ltcC5vcmdnisdHAAAChElEQVQ4y52STUhUYRSGn7nd8ebP5Ezg
tTHNkbJRbFFRNCYUuMgWRRQuQigsgoqpwVYtKspFEVQQBlK0KAoisCgoalvQIolEiqZFmVRq
hqTo3JvO/flOC2Fssja9m/PB4Tyc9z1f4MjZ4yc/WxXa2LgzCVQBW4GGoCbZ0MKfPxYZzs27
58+d4B8KNHd07Y2trI9Vl5uDq2vKOqojhWttzyf9LcPr3ufqw9dR4pE3y7o77wz/FZA8fb7b
nRo77InGqB9m2ihjgR6krWUjyysWc/n+C/yhPmIF43+b7yR5LCVfRgZERGTgc1p60wOSuvZE
EgcvSM+rL9L19K20nrou7waH5XdZliWpjqTohu6ztDzGxMQE4ZJytMAkheIA0PdxFLNE5/t4
hvcDn1iyqBACAEJBQQEAuueCKMFXiu0nbszbsXdwAtfzudjzkos9LwF4fHYfyGxfA1CiUL6i
61AjAO27d9KYWMfMjE00pNGUWM/e1u0A7GlegfIVIjIHEBEikTAVZTEuHVjHzbsPiMeq0Aig
ESBRX82te49o21zDjqb1FBUX5QMALMvCNE2qo7U5SOOq5dTGKrl8+yFtm2vYtSmBaZo4jpOz
qAMopbBtGwDTNDFNk+6jhRy72kPW9dnfUk/7ti1omsbU1BS2bRMKheYAhmFQWVmZF96ahg08
u7IBANu2cRyH6enpeSHrAP39/bium9fwPA9d13PvPxWJRPIz8DyPdDrNyMgImUwGEUFEMAyD
oaEhQqFQrlqWhWVZ+VdQSlFcXEQwGMx9EgDXdRE1CxM1ez7l+/kWwuEwpaWlRKNRALLZLEAu
7XhdHKUU8bo6lFIsiUZzlgOpjuQZ4DT/p85fkzszTNUiYm0AAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: 'private - utilities' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
createIconMethodsFromDirectory: directory 
	"Create the methods for the icons.
	(self createIconMethodsFromDirectory: '')."
	| normalSize smallSize |
	normalSize := self normalSizeNames.
	smallSize := self smallSizeNames.
	normalSize , smallSize
		do: [:each | self createIconMethodsFromFile: each directory: directory]..
	self initializeIcons! !

!ThemeIcons methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 7/11/2013 10:57'!
databaseIcon 
	^ icons
			at: #'databaseIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self databaseIconContents  readStream) ].! !

!ThemeIcons methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 6/7/2013 16:20'!
packageAddIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAMVSURBVDjLdZNLaFx1GEfPnZk7
cyfNkElS0jTVKKRpE2PSpAhKHyqo2QhtShUiCPWBLhTdFKUUlxYUqggGxYqIbsSNFKQmVqMh
TVujSQuhtnmMaR5NJs0kncz7ztz5f5+LgguNv/WPszkcS1XZbFPnDrUh8q6KRlTkrdYj/Vc3
+1n/Bkz3H65T0TdV5PXapiNRU1jjztxgVkU/UyMfPtg7uLwpYGagx1bVF1Tk7ciO7p3bWp/B
J4ZsfAw75Gc1NsTGrfF5FTmtIl90Hhsp/AOYHujpRvSdUHXnwW0tR3Gqm0FLlJMz3Bw6xb0P
7MdXcR/FXILbsXEyiRujasypva+Mfm9N9R/+EpFjW3f2Wk5NO25mjVTiBqaUxcvFCVlF6ht3
g5vEX9mIz4mQjk9zOzZOPjn/TUCNPL/ryT7Ly6yRjQ8hpTShfIJ8Ok56cYm9vR9jh7dAbg7N
xbDS09Q2dFBVA1d+mH02oCI5xaoKOiEiNY0UEtepqI4SrQ4TJg/uApgguEtQWCS/Mkp27hLO
/UdRI7mAioAAVhC7qhk7FMFdHUOyq9h+sPJ/gU8prfxMJr1BORyFYAj1yqgIATXCXQ8GtAiB
LTh1XZSDYRx3HVn5iZSXoexUYkIRJF+CsiKlMmoMATXmrlA1IB5IHrRIoHIHkfpdpO6M4fkc
LiyFuLwWJu26lNwUB5MTtBghoCJhn20DYSivgxRBXDBFcBooK/yyEGTKruXxRx/inppmfv3z
LOevXWByw630qZHh2eGPKCQXINQA/gowJVAPENQTflzw6GzZg/EZ9mx/CmN5PNK+j4s5z/KJ
MU9nFkdenRw4GZv//WsMQYjsBjsMCqbokcisY1uVHGp9A4DjT5yhqa4Do/j8n343b+o7X7oS
HzvzbT4x48UnzrVj+Z1I48NY9lZEwnw1OkT1dpvh2bMcaOrhvfMvkimsc21yyv1PTH/0dbWp
kZMq8lzTYy9bhdU5Pr84yPVomX0dB2iu72Jm5SqXJka4dTP1gfV/OV8+3datIicQCarI+8eX
c/uB14AIkAE++a1v+cTfDyOvKVPjhy0AAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousLeft
^ self icons
		at: #glamorousLeft ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1828716544 956301312 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 218103808 2852126720 4278190080 1073741824 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 771751936 3640655872 4278190080 4278190080 1073741824 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1627389952 4127195136 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 1627389952 4127195136 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 771751936 3640655872 4278190080 4278190080 1073741824 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 218103808 2852126720 4278190080 1073741824 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1828716544 956301312 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloPaintIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/haloPaint.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQAQMAAAAlPW0iAAAABlBMVEX///8AAABVwtN+AAAA
KUlEQVR4XmOAAwkGBjkGBu4GBp4DDCwJDGwGDMwSDIwdDAw3GBgK4KoAV3UEFJk+w6QAAAAA
SUVORK5CYII='! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:51'!
testGreenIcon 
	^ icons
			at: #'testGreenIcon'
			ifAbsentPut:[ self testGreenIconContents ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallLoadProjectIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAIRSURBVDjLhZM7a5RBFIafme9b
v2TjxkS8IN5SWGgKu8QmhYWFbf6DtT8kVoGAKQRBC8HextrGQhDBxoioSJSV7Gbdze53OTOv
xV6yaogHXoY5HJ55z5kZJ4mjwjl3BTgPuHEKGBc3ga+SIpKOFLBSlmVhZppWnufa2traBJYA
fxxg1cw0GAzU7XbVbrfVbDZlZur3+9re3t4EltwxLaya2WszI8aImVEUBYuLi5OaNE1vef4T
SZLgvSdJErIso9Pp0Gq1DiEfXqy8nZlfXnZumiWePbjZHDkhSZKxK5xzmNkhwMlfv7z2uOac
G81Y4BxXeXlxqh2SJME5N9lPAJhyYpkVPx4SygT8PM418MnC3zP5BzQEVM7HUGBFDUVRtd/T
//6Rxm6TLztzSAFZCUR8fQEUSE6d5tLdpyOA04xCTjVwqDyg6omzaxsspheoz51k+pbGJ39+
vj7twJPOnmPhxj0ggoSIFDv36ac1UPhjuLPXHiGJEEIPCCmVpJAT++9Q6KDQRbZPYXWqQY7H
hmACMQbK1i69vW/Ksuw20EwpkKIRq5/IOkOI7VOfdZC5oSMZqEKxot6oMZN5k/Rm2EIpOQKy
FrL9oUIH4mAE66LwC4UDFHNQDjb5VKQqY9v6e/Wqd6JBbHipBrEBOoNCAZTID1fnA6HoSWUs
DgF5sfFpe30VcQdH49h3LcC9Kol6Mk79BmoIbLI/IOsSAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallQuestionIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAKkSURBVDjLpZPdT5JhGMb9W+BP
aK3matVqndXWOOigA6fmJ9DUcrUMlrN0mNMsKTUznQpq6pyKAm8CIogmypcg8GIiX8rHRHjh
VbPt6o01nMvZWge/k3vP9duuZ/edAyDnf/hjoCMP2Vr3gUDj3CdV6zT1xZ6iFDaKnLEkBFOm
PfaZArWT5sw60iFP+BAbOzTcQSqDZzsNRyCNkcVoaGghzDlVQKylOHJrMrUZ2Yf52y6kc36I
xpyoH1lHF7EBgyMKV4jCJ5U/1UVscU4IZOYEa3I1HtwI01hwxlDLhDoJD/wxGr5YGmOLAdRI
rVCuhmD3JdA6SQabx12srGB0KSpc86ew4olDOGjH4x4z0gdHDD9+c4TaQQtq+k2Yt0egXYug
TmoVZgV9cyHSxXTtJjZR3WNCVfcK/NE0ppYDUNu2QTMCtS0IbrsOrVMOWL27eNJtJLOCDoWX
dgeTEEosqPxoBK/TwDzWY9rowy51gJ1dGr2zLpS2aVH5QQ+Hbw88sZ7OClrGXbQrkMTTAQu4
HXqUv9eh7J0OSfo7tiIU+GItilpUuM/AF2tg98eR36Q+FryQ2kjbVhximQu8dgPKxPMoeTuH
4tfqDIWvCBQ2KlDQKEe9dBlGTwR36+THFZg+QoUxAL0jgsoOQzYYS+wjskcjTzSToVAkA7Hq
g4Spc6tm4vgT+eIFVvmb+eCSMwLlih/cNg0KmpRoGzdl+BXOb5jAsMYNjSWAm9VjwesPR1kn
FilPNMu510CkdPZtqK1BvJQsoaRZjqLGaTzv1UNp9EJl9uNqxefU5QdDnFNX+Y5Qxrn9bDLU
R6zjqzsMizeWYdG5gy6ZDbk8aehiuYRz5jHdeDTKvlY1IrhSMUxe4g9SuVwpdaFsgDxf2i84
V9zH/us1/is/AdevBaK9Tb3EAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:33'!
tinyMenuIcon
	"Private - Generated method"
	^ icons
			at: #'tinyMenu'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self tinyMenuIconContents readStream) ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
warningIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAA
CXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1gIQDictt+6SdwAAAehJREFUOMuVk8FKG2EU
hb87mc40iTODEJlK7UZDxCCGQUqaMASCSGODdBe6ECJddOcwG/EJXBt0ZcBCwEVJVgWtr1AI
PoBQXAQKhRZc1EBJMX831hLItPbAvYvL4Ttnc4UIhfDIgLcAA3jdgC/jfHoUwISjeXgOcAFH
QHWcT4tI91KwWlhY0J6kUloKVkPw7g0wYS8NemJ3l0yzSRp0E/buBQihOAXFbLksej6Pns+T
LZdlCoohFPmXdqB7AsNep6M8z1Oe56lep6NOYLgD3b82CGHFhaWM74vh+ziOg+M4GL5PxvfF
haUQViIBJuxnwUgEAaJpWJaFZVmIppEIArJgmLA/FhDC+jSk5woFjFIJEcG2bWzbRkQwSiXm
CgWmIR3C+gggBDGgsXibruk6IvKngQiarpMIAhbBMKARgsDtCuHVLLReLC8bk2dnEIuhlKLf
7wOQTCYREbi54WptjQ/n54NLqDfgnYQQewxXT8GaPz7mYbWKUgqlFLVaDYB2u42IICL8OD3l
YmODLnz/DJOawGYczJlcjnilcmcUEVzXxXXdkVu8UmEmlyMOpsCmbMPXl5CaPThgol6/S/89
wAhARLhutbjc2uI9fJNDGD4DecD/6SfwEZT+CQ4H8GYi4i+idA3DHjR/AZfefQgctOETAAAA
AElFTkSuQmCC'! !

!ThemeIcons methodsFor: 'private - utilities' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
exportAllIconsAsPNG
	"self exportAllIconsAsPNG"

	| sels | 
	sels := self class selectors select: [:each |  '*Icon' match: each asString].
	sels do: [:each | self exportIcon: (self perform: each) asPNGNamed: each asString].
! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousAlarm
^ self icons
		at: #glamorousAlarm ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777216 436207616 16777215 16777215 16777215 402653184 16777216 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 100663296 3003121664 2399141888 16777215 16777215 16777215 2315255808 2969567232 100663296 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1442840576 2097152000 1644496133 3122733345 3625852446 3122733345 1644496133 2113929216 1526726656 16777215 16777215 16777215 16777215 16777215 16777215 16777215 553648128 3171749133 4030939971 4289440683 4291282887 4289440683 4030939971 2133469738 587202560 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1594361864 4129761063 4291546059 4291546059 4291546059 4291546059 4291546059 4030939971 1594361864 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3122733345 4289440683 4291546059 4291546059 4291546059 4291546059 4291546059 4289440683 3122733345 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3625852446 4291282887 4291546059 4291546059 4291546059 4291546059 4291546059 4291282887 3625852446 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3122733345 4289440683 4291546059 4291546059 4291546059 4291546059 4291546059 4289440683 3122733345 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1594361864 4081205826 4291546059 4291546059 4291546059 4291546059 4291546059 4163315495 1594361864 16777215 16777215 16777215 16777215 16777215 16777215 16777215 536870912 4194961930 4129761063 4289440683 4291282887 4289440683 4030939971 4194961930 520093696 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1979711488 1056964608 1594361864 3122733345 3625852446 3122733345 1594361864 1073741824 1979711488 16777215 16777215 16777215 16777215 16777215 16777215 16777215 520093696 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 6/20/2013 16:11'!
packageColoredIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAALnSURBVDjLfZNLaFx1HIW/e2fu
zJ00w0ymkpQpiUKfMT7SblzU4kayELEptRChUEFEqKALUaRUV2YhlCLYjYq4FBeuiqZgC6FI
QzBpEGpDkzHNs5PMTJtmHnfu6//7uSh2IYNnffg23zmWqtIpd395YwiRL1Q0qyIfD56cmOvU
s/4LWJg40auiH6jI+7v3ncybdo2Hy9ebKvqNGrn03Nj1+x0Bi1dHHVV9W0U+ye4d2d83+Ca2
GJrlGZx0gkppkkfrsysqclFFvh8++3v7CWDh6ugIohfSPcPH+w6fwu05ABoSby9yb3Kc/meP
YXc9TdCqslWapVGdn1Zjxo++O33Fujtx4gdEzj61f8xyC8/jN2rsVOcxYZOoVSZtBewZOAT+
NonuAWw3S728wFZpFm975cekGjlz8NXLVtSo0SxPImGdtFfFq5epr21wdOxrnMwuaC2jrRJW
fYHdxRfIFeDWr0unkyrSUqxcyk2TLQzQrt6hqydPvidDBg/8VTAp8DegvYa3OU1z+SbuM6dQ
I62kioAAVgondwAnncWvzCDNCk4CLO9vsJVw8xqN+iPiTB5SaTSKURGSaoTHHgxoAMlduL1H
iFMZXP8BsvkbO1GD2O3GpLOIF0KsSBijxmCrMY+FqgGJQDzQgGT3XrJ7DuI5EKZd4iDG+CHG
84m8AIki1Ai2imRsx4FEBtQHCUB8MG1wi8QKGhjEC4mbAVHTx8kNYSuoiGurkRtLN76ivb0K
6SIkusCEoBEgaCQYPyT2QhKpAXKHTiMmQ2lmChWZTrw32v9TsLOyVlu8Nhi2G4Vs32HsTC9I
A2KPRuU2Erp097+O5RRYvz3H1r3JldivfY7IR0+mfOu7l3pV5EM1cq744mi+OPwaRD71tSk0
Vsp3/uLB6s2minyrIpeOf7a00fFMf1w+MqRGzqvIW/teecdqV5a5P/8ncXv9ZxUdf/lCae5/
3/hvpi4OjajIp4ikVOTLY+cXr3Tq/QPcssKNXib9yAAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/14/2013 18:34'!
recoverLostChangesIcon
	^ self blankIconOfWidth: 16.
! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallPrintIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAA
CXBIWXMAAAsRAAALEQF/ZF+RAAAAB3RJTUUH1QgSDzULeviv6gAAAW5JREFUOMulk81OIlEQ
hb9bsOAheuvMihAiszHyGOP4MNr+PIGa0WcQeAJ6x5olO3GnJiTNX2gSu2nuLVcgPfxN9CaV
m7pJnTpV51z45jGrSb1RuwL8/6i7Pvn952Lttd6oaZIkOyOOY603arqoyW+Cb7fbW1tXKpVM
vhGgWCx+zmhM5lbV3QDOOTqdDgAisgZULpf3M/A8DxHBGLMWexmoKq1Wa9lRRKhWq7tlPPfP
rgC/UCjw4+AnzrkM/dXxjDF0n5+I4xjgesHAv/AvsdaSpuleE0wmx4gI9w9/fVldUrfbJUkS
giBAVQnDkNFoxGAwYDgc0u/36fV6NJtN3l5fsjuIooj4/Z3xeEypVCIMQwDSNF1SB7DWMuiH
xMksCyAiTKKIIGgynU4BmM/niDE4Z5lbi0iOfC7H0XF1swrWWg4rv/4xjOKcYq1FRJbyLpa8
BJjNZniet9VxCxVEBFXFOZcBeLy9uzn9wm9+/AC6aMvlGUG8HQAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousGreenCircle
^ self icons
		at: #glamorousGreenCircle ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 100696064 2264962304 3875575296 3875575296 2264962304 100696064 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2264962304 4278228736 4278228736 4278228736 4278228736 2264962304 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3875575296 4278228736 4278228736 4278228736 4278228736 3875575296 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3875575296 4278228736 4278228736 4278228736 4278228736 3875575296 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2264962304 4278228736 4278228736 4278228736 4278228736 2264962304 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 100696064 2264962304 3875575296 3875575296 2264962304 100696064 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 9/19/2013 13:02'!
changeRemoveIcon 
	^ self removeIcon
! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'CamilloBruni 9/19/2013 19:44'!
changeBlockIcon 
	^ self smallBackIconGray
! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:30'!
smallQuestionIcon
	"Private - Generated method"
	^icons
			at: #smallQuestionIcon
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallQuestionIconContents readStream) ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallRightFlushIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAQAAAC1+jfqAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAABjSURBVCjPY/zPgB8wMVCqgAVE
lP//x/AHDH+D4S8w/sWwl5GBgfE/MSZAQNL/31CdMHiGaBNS/yPbjIC3SHSD+3+EXoh5z4k2
wfs/qt2/ofAziW7Q+v8brhsSrn+IMYFgZAEAE0hMH/VkcbsAAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
configurationIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAACXBIWXMAAAsTAAALEwEAmpwY
AAAAB3RJTUUH1QkIDSkTjqMgxAAAADV0RVh0Q29tbWVudAAoYykgMjAwNCBKYWt1YiBTdGVp
bmVyCgpDcmVhdGVkIHdpdGggVGhlIEdJTVCQ2YtvAAACU0lEQVQ4y22QzUtUYRjFf+/73k9n
HGdGnfFj0BQjA3WnaAa1aCG5atFCMoL+ioKKKMhVbdq16AP7CyqCdm0k2vVF4pBmpmai+JXO
OPe+920Rluk9y8PD7znnCA5o8MKdmYU10Ua8ns6+vHpxv2EdvFhYE23DpzpNQ65W6DCgEkbs
VDSf5zYpTk6PAvGAgZGx90sbpsdgKLS0iPt37xFoAwjAcG5klOIkHDk7ZroLYuL5gysnAeQe
YL1kekbOnyGd8Jha3KSvvw8nWY9TnaOju5cVnaS1vZXLl4b5OG8GDyWocqA66eO5FutbZQpd
AwwND6GkZGGtzOsPS9i2YjcwxFbIVEHKt2jKp1ES5pc3+Dbxlppgm5XCMVzXQyhJeaf8H+Bv
hXzK4JgKRzsK/PxapLA6Q3Z5FvfHdxpW55ibmqIhl6FUKsUnaErD8UI1tgjIZ3qZfvYCW5QQ
nkSuLtJ/4jRBpUwgLATmMCDlQ2PGJaq4pD2Y8UO8WhsRSXYDgys1QkY4UmCpmARSgK0g5Qsc
ZePWWKgkEAooCZpzVWyXQxzXJ+HGACIDQoAUgipX4XoSz09gwohoK6SzOcn2rsZPpHiThncH
AaUKVMIIg0EKgbAkjmOhrQgnMjRmPUIdUZNJ014fs8FWGXYrGq0NQgmkkFi2hdAaS2l8R2GM
pD7tUZuIqVAKQCPJ5fP4rvPH3HskoK4ui+O4KKWw40Y0hk+Px8e7fBuUBCVt0jVZwjBg69cy
j548ZN9er/jHjpW8dfO2Ln6Z2XE9125rabav3bhuAfrg4W/hgM0HfAZ+XAAAAABJRU5ErkJg
gg=='! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallExportIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAGdSURBVDjLlZNLSwJhFIa1Rb8i
IWhRQUlluuoftDEtC5TKSgINily1CmoT0kJBqwlSaBGBLVxItGgZQQQVFe3bKN7wOjqO2tuc
wRGvqAMPMzDf+8w5ZzgyADLhGhJQCWi6MCwwQBkJWVWg4jguVSqVKuVyGe0Q3sPtdruaJZJA
Q+FcLgeWZWuk02kkk0lEIhFREg6H4fF4GiR0yUlABwqFAorFongnstksUqkUotGoKMjn86CP
MAwjSloEFJYgAQUymQxisVhLS9WZyBsEQhu1A/RMfUutxONxsZJQKNRZ0Ey9hCqheSQSid4F
9RJqh2ZCor4EBM/z4lxIQvQtoCp2HtexfW+CObAM062uu4BCElSBJWjEzc8Vrr8Y6L3zvQso
TKz6F+H7PAPz7oLRp8eodmSjp7/geDqG2b8Me9CK8zcnXK8O7AWsmDtUF9UHUw/1gr+2O8Bz
sPm3YLvbhPPlBI7nI6xc6jC9P/Gr3B0flHZhVpgyKwQ6LpPFtwaTdwmGCy0MpwsVWsD6ZVKQ
pNs6z9iV35PWsY/q6iso+w9crJoc0rRwaAAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallExpertIconContents
	"Private - Method generated with the content of the file /home/dgd/smallExpert.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABF0
RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAACS0lEQVR4nJWRu09TcRTHP+1tL33QVkjB0lqN
QABRiiE6SDCEElJcYWbV4GRSw9zBP8BFSRwk6mCiI4Mp0dCQaHwwgQllACqlPEIfVOhte3vb
n4M0ImICZzq/c36f73lJnMHehJDfRiiLGW44nGRGfMj6swjU1qObfoSHNWJ2lcZ7z1B0p4W/
PsEraTR61yg7BWHFwsRKM3On5X0+Jx/uXiM3NYRYGuPTx4c0AvyvAxm4CnQDWeAxsNpgZrLX
w/eZH9ieB1GlFRZOgseQSNY214pWf6twd7oFIID3wOXDP9dDIfQCdMc7eMo5xj13PPR099Du
biefyBOdjyLbZcIvw0qlXLkFfyobjsCjyIxzG1wXXTTVNdFyvoWOng7Mo2ZiuzEKhYJl9vXs
K+AmoAIcPeMEV8BoNVJjrMEsm7Fb7HjqPbS526iz1jEwMoCl3uIDAlWoKmAAfDRAqVyiWCqS
V/NklSzxVJxoIkrqIIWiKji8DoDe4yNYARPy70fyZ5LN9CY2k428mscoGUntp4in4miSBuA8
LpAFVsjQghXWU+uYZBOlcomtvS0kvcR+fp+N9AaZRAbg80lLnGaVB1wAIQTLm8vs5fZwWBzo
9XqUosJ2bBttV8sB4Sp09IxmYJ4uOungXysAc0CW+8BkNSxVnVAopDcYDEs7iztdpa1SE4bD
7AEQB90XnXrJeWkqGAy+6+/vVyORSO4vgUAgYHe5XA19fX0LxXRxmzjFynJFsiVtCa/R+214
aPjF4ODgohBC1jRN8fv96UgkIn4BMVjYCuwVUJAAAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:34'!
volumeIcon
	"Private - Generated method"
	^ icons
			at: #'volume'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self volumeIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousPlay
^ self icons
		at: #glamorousPlay ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4110417920 1879048192 16777216 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4076863488 3456106496 603979776 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4227858432 4110417920 1895825408 16777216 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 4278190080 4076863488 3456106496 603979776 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4194304000 4009754624 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 4278190080 4076863488 3456106496 570425344 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4227858432 4110417920 1895825408 16777216 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4076863488 3472883712 587202560 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4110417920 1895825408 16777216 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 3/6/2015 10:41'!
gtInspectorIconsIn: composite
	<gtInspectorPresentationOrder: 40>
	composite list 
		title: 'Icons';
		display: [ 
			self iconSelectors asSortedCollection 
				collect: [ :each | each -> (self perform: each) ] ];
		icon: [ :each | each value ];
		format: [ :each | each key ]! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:44'!
dirtyPackageIcon 
	^ icons
			at: #'dirtyPackageIcon'
			ifAbsentPut:[ self dirtyPackageIconContents ].! !

!ThemeIcons methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 6/20/2013 22:35'!
deleteIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAJdSURBVDjLpZP7S1NhGMf9W7Yf
ogSJboSEUVCY8zJ31trcps6zTI9bLGJpjp1hmkGNxVz4Q6ildtXKXzJNbJRaRmrXoeWx8tJO
TWptnrNryre5YCYuI3rh+8vL+/m8PA/PkwIg5X+y5mJWrxfOUBXm91QZM6UluUmthntHqplx
Uml2lciF6wrmdHriI0Wx3xw2hAediLwZRWRkCPzdDswaSvGqkGCfq8VEUsEyPF1O8Qu3O7A0
9RbRvjuIttsRbT6HHzebsDjcB4/JgFFlNv9MnkmsEszodIIY7Oaut2OJcSF68Qx8dgv8tmqE
L1gQaaARtp5A+N4NzB0lMXxon/uxbI8gIYjB9HytGYuusfiPIQcN71kjgnW6VeFOkgh3XcHL
vAwMSDPohOADdYQJdF1FtLMZPmslvhZJk2ahkgRvq4HHUoWHRDqTEDDl2mDkfheiDgt8pw34
0/EocuClCuFvboQzb0cwIZgki4KhzlaE6w0InipbVzBfqoK/qRH94i0rgokSFeO11iBkp8Ed
V8cfJo0yD75aE2ZNRvSJ0lZKcBXLaUYmQrCzDT6tDN5SyRqYlWeDLZAg0H4JQ+Jt6M3atNLE
10VSwQsN4Z6r0CBwqzXesHmV+BeoyAUri8EyMfi2FowXS5dhd7doo2DVII0V5BAjigP89GEV
Atda8b2ehodU4rNaAW+dGfzlFkyo89GTlcrHYCLpKD+V7yeeHNzLjkp24Uu1Ed6G8/F8qjqG
Rzlbl2H2dzjpMg1KdwsHxOlmJ7GTeZC/nesXbeZ6c9OYnuxUc3fmBuFft/Ff8xMd0s65SXIb
/gAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousGrayCircle
^ self icons
		at: #glamorousGrayCircle ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 109084800 2274464145 3885142674 3885142674 2274464145 109084800 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2274464145 4287795858 4287795858 4287795858 4287795858 2274464145 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3885142674 4287795858 4287795858 4287795858 4287795858 3885142674 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3885142674 4287795858 4287795858 4287795858 4287795858 3885142674 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2274464145 4287795858 4287795858 4287795858 4287795858 2274464145 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 109084800 2274464145 3885142674 3885142674 2274464145 109084800 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: 'private - utilities' stamp: 'EstebanLorenzano 5/9/2013 10:57'!
base64ContentsOfFileNamed: aString 
	"Private - convenient method"
	
	| file base64Contents |
	file := FileStream readOnlyFileNamed: aString.
	base64Contents := (Base64MimeConverter mimeEncode: file binary) contents.
	file close.
	^ base64Contents! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:32'!
smallVolumeIcon
	"Private - Generated method"
	^ icons
			at: #'smallVolume'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallVolumeIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:57'!
smallConfigurationIcon
	"Private - Generated method"
	^ icons
			at: #'smallConfiguration'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallConfigurationIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:26'!
uncommentedClassIconContents
  ^(Form
	extent: 12@12
	depth: 32
	fromArray: #(16777215 16777215 16777215 16777215 16777215 1361772544 2905276416 1865089024 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2976382976 4292214784 2402025472 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2727280640 4294901760 2201354240 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2055667712 4294574080 1797980160 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1634795520 4293787648 1445658624 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1903165440 4292804608 908787712 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2256076800 4291231744 254476288 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2625503232 4088987648 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1350893568 566165504 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 596443136 132186112 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1664483328 4242014208 3669098496 120258560 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1227554816 3985440768 1986789376 16777215 16777215 16777215 16777215 16777215)
	offset: 0@0)! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:32'!
stopIcon 
	^ icons
			at: #'stopIcon'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self stopIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Komitter-UI' stamp: 'EstebanLorenzano 12/13/2013 14:43'!
historyIcon
	^ self blankIcon.! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:31'!
smallStrikeOutIcon
	"Private - Generated method"
	^icons
			at: #smallStrikeOutIcon
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallStrikeOutIconContents readStream) ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'CamilloBruni 9/20/2013 14:37'!
windowCloseFormContents
	^#( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 167772160 0 0 0 0 0 0 0 0 167772160 3875536896 4076863488 234881024 0 234881024 2919235584 3858759680 0 0 0 0 0 0 0 0 402653184 3674210304 4261412864 3758096384 671088640 3758096384 4261412864 4278190080 335544320 0 0 0 0 0 0 0 0 352321536 3758096384 4143972352 4211081216 4143972352 3758096384 352321536 0 0 0 0 0 0 0 0 0 0 671088640 4211081216 4261412864 4211081216 671088640 0 0 0 0 0 0 0 0 0 0 352321536 3758096384 4143972352 4211081216 4143972352 3758096384 352321536 0 0 0 0 0 0 0 0 335544320 4278190080 4244635648 3758096384 671088640 3758096384 4143972352 3724541952 402653184 0 0 0 0 0 0 0 0 3892314112 2919235584 234881024 0 234881024 4278190080 1761607680 167772160 0 0 0 0 0 0 0 0 167772160 67108864 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:57'!
smallHomeIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QAAAAAAAD5Q7t/AAAA
CXBIWXMAAA3XAAAN1wFCKJt4AAAAB3RJTUUH1QoOFCUTUyrSOwAAAetJREFUOMuVk79rU1EU
gL97+95L00DyJKBVh2RRexNoVawRXByMQhOnh9RKJ5GioxhcOrRuwan+GOrUJYv1x2AT8A/w
PxB5W1zEWtvwYlGJIXnXIfbZl1AhZ7pczvfdcw7nwgHhKVWsgK6A9pR6yDCxB3tKaU+pPUlx
aHixOKPLN2/8VyL64ZrrbhSUYv3cWbYnTnHk8DgnvCZTa2vUXJeCUtcOuW51QLAfflOcYff4
MZTKMhaN0mq1GNv8SrZcHpCIfrh6+xadZJJ0Kk0qlQJAa2i32+zW65wslUISsR9+96BExzDJ
5S5g23bQmtYaAN/3+bm1RXJuLpCICuiCUrx/VMZrNjk/nSMejyOECAl83w/OhhCM5vPUXBcD
uAOsTp0+w/3SPTaqbwPwycozVh4/RYsRdKeFMEbR3d8sLy3R7qXMynl4vjCZIRFPAKDUBJmM
IpvN9F4UkpH0ld7EU3mQFlprFiYzzMO67O/TsixM08QwjOD+S+MHAB/qO3S7fpALMCCQUiKl
xJKfAehg8fFTA4Bv3i86IhJaJGNgs/4Oz+coAJcuTnM1GkPqcS5Lk+1NQhUY/RX8m37vpe/e
DqLZOHD1A0EkEsG2bRKJBAKJEBCLxXAcZwCyLCv8F67POq8Ah+Fi9eWL13f/AFb41aOFu4Aa
AAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:34'!
arrowDoubleDownIcon 
	^ icons
			at: #'arrowDoubleDownIcon'
			ifAbsentPut:[ self arrowDoubleDownIconContents ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 9/19/2013 13:02'!
changeUpdateIcon 
	^ self smallForwardIconGray
! !

!ThemeIcons methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 7/25/2013 11:13'!
databaseAddIcon 
	^ icons
			at: #'databaseAddIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self databaseAddIconContents  readStream) ].! !

!ThemeIcons methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/9/2013 10:57'!
iconNamed: aSymbol ifNone: aBlock
	^ (self respondsTo: aSymbol) ifFalse: [aBlock value] ifTrue: [self perform: aSymbol]! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:57'!
smallForwardIcon
	"Private - Generated method"
	^ icons
			at: #'smallForward'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallForwardIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:22'!
flagIconContents
	^ ((ColorForm
	extent: 12@12
	depth: 8
	fromArray: #( 437918234 437918234 437918234 436470535 101584139 387389210 436404481 17105924 303634202 436666638 218827016 35198490 437126412 185075720 1644314 437060363 168298504 1644570 436930320 269422351 370743322 437326099 320082453 387520538 437918234 437918234 387520538 454761243 454761242 387520538 454761243 454761242 387520282 454761243 454761242 387389210)
	offset: 0@0)
	colorsFromArray: #(#(0.22 0.396 0.585) #(0.898 0.945 0.996) #(0.228 0.498 0.761) #(0.608 0.796 0.98) #(0.635 0.804 0.98) #(0.655 0.819 0.98) #(0.47 0.729 0.973) #(0.542 0.768 0.977) #(0.251 0.631 0.961) #(0.267 0.639 0.961) #(0.275 0.643 0.961) #(0.286 0.647 0.961) #(0.302 0.659 0.965) #(0.326 0.667 0.965) #(0.353 0.678 0.965) #(0.396 0.714 0.965) #(0.419 0.729 0.969) #(0.239 0.686 0.93) #(0.243 0.624 0.772) #(0.236 0.682 0.851) #(0.228 0.667 0.788) #(0.224 0.616 0.671) #(0.384 0.228 0.082) #(0.349 0.212 0.098) #(0.329 0.2 0.094) #(0.694 0.462 0.271) #(1.0 1.0 1.0) #( )))! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:57'!
smallBackIcon
	"Private - Generated method"
	^ icons
			at: #'smallBack'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallBackIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Versionner-Spec-Browser' stamp: 'TorstenBergmann 2/12/2014 17:42'!
configIconNewContents

	^'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAC8ElEQVR42nWTa0iTYRTH/69u
81ZuXpqZGSVG4dTSlrfmhpqzsA9CEgSREfTBDEMqiehjfgjKPvTJQvwiZHSBUHMqKpq3SlPx
fsWZm7rpejenuzhnR98lXdYLh+d9z3vO73+e55yHwX+e3Jx0SW5m+CNvvufeKpX6XtX7pj53
cczfjqxMuViZElqYkRhSIIxQiGAzwTT31dzSoy+r71oqrWto07oFyM6k8FOl4mvZ8gPFYcdk
kfBL5n5sTVOUB6Drx/zUsFrVtfSkfeBHeeunDssu4EbeeWVO2sGHUTHxqQiUk8fXhTVhc7IS
noejAX4IYGfh1ExgeHTsc22XvqSssrGaqXh2tUIWF5zHC0tnwIugJCPAquF0WOCwGsCHHUzI
IUpeBXzEgAfBjd9hI1B7z9QrZqy5aMPrSCEPoADLELCxRqsRzrUVmHTLECUVEtSbbJFMA9h0
gBcJORdg6G51MAN1haz/8SIhYKUAOp+1WdrYBr2TLc4AERfonfhYpiro/8oIrZvAfgUWOmuM
TH/tLVYYdYcA5ISDzEAq41QFKbKkFh5HwC1yfwPWzaS+h0L5gCgG2q6PRqavuoAVRd8V7ijC
5oLQNpxzJDpIyevkIhP4kLKTs02qKCgO2i/bgA/5rCi22LWF342Ajkk6mglKcHBcG1Vpc3AV
iOOh6VUZmaGafJufpFhADacIvauK7RbbyUjZ0EkuO5ds3QYQOEBCnQ7EUp/Kxrx9fqUx7lTC
WY/QBErYxx3WDsjBgXQEsNBqpdJ5NAsBR2k8jDBq1RidmWpjaAIFKbEBeVmnA4sjJMmRECdR
oifXEbDUuTZSpe8g6U4l6+ppzGvG1c1D5qfdE+vlu6OszJCJM+IDbiuihTdDouQiBCdy27BQ
2za3sDE7C7120Nw+Yn7RMmQuVTV1aNxepovZCsk5qeiBNNL3suhENgN2kQZzGr3jc+/q+1dL
3tS0/XEr/wH8eq5fSlNmnvS/z2MgaOg3PX75uqXaXdxPRfBBOgbrUTMAAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:57'!
paintTabIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/paintTab.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABgAAAAdCAYAAACwuqxLAAAABHNCSVQFBQUBSsjp7wAAATJJ
REFUeF7FliEUgjAQhheJRiKRuHjRSCQSjUTiopFoJBqNRqLRaDQajUbbucnDMZw6ufO59/43
Bsf/bTc2Jj6Vei7QJ0Epr0xZID6jTSpwlwhstWogQHzmW216iaz2MWEkPkA7AhxmE9PVB5YA
mIHCHEpcQoSN7EyN+UlrLQmABWQYyetDIBtrAoQJ74MyqRxAIvfI8kX1QQpijOXxASigoAPG
gSbvZh4qSHnWwjC40poXnSquxTY0F8oqqsIgwYA8dwFGi4wRoLSS0pqbaxWYprewcZDpdUjP
g0HjhyudqqbsahaIs2vWejs4W60VA2R4Y7d1AabNCmgbF2DaFMAd8jQHepFtVFeH9PDrUVC+
++DJpvyD/wcIzucXgElHlsm9p6Zq0h+ObT/iBv3sOOl77wZmYEC6UBNb4AAAAABJRU5ErkJg
gg=='! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:57'!
forwardIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAADvSURBVDjLY/z//z8DJYCJgUIw
xAwImOWx22uSExvZBvz68cvm5/dfV5HFGEGxUHoiExwVf//8Zfjz+w/D719/GH79/A3UAMK/
GH4CMYiWFJJk+PXrN8PN27cunWq/oA/SwwIzyUrYluHvP6AB//7A8e+/f4H4N8Pvf0D8Fyb2
h+HLl696WllqJ69Nu2XOArMZpBCuGajoN1jxbwT9FyH36/dvkCt/w10Acvb+h3uxOhvoZzCb
i4OLQVJSiuH1q9cMt2/cvXB7zj0beBgQAwwKtS2AFuwH2vwIqFmd5Fi40H/1BFDzQaBrdTFi
YYTnBQAI58A33Wys0AAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'ChristopheDemarey 7/26/2013 13:18'!
downIconContents
	"Private - Method generated"
	"Icon from http://tango.freedesktop.org/Tango_Icon_Library, public domain"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABl0
RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAAI9SURBVDiNhZNNaBNBGIbfmezm
D2vAYNJD/MGq9SIaj0m04MGL8SIULx4q4kEU6qFV8SoI0hU8qVCEnBQholJTW3Kx1lUItS0U
e6hVtFTNmq79C+kms7Ofh9Yamxjf4zffPPO+880wIkK14t1qHoQw6onB0HtEc3VJqWkihG9d
SMN2BGxHYMkqYMkyAQB3H92oAdcCADDGkJt5jrJdQqE4g49zY2g/eLWuKV6vWB3Ko/jrbmwI
ABGIHBARFO5uCFASl1WdHMTW7btgOSS9kmxIsrFcNlG9Fu9S1w0yjjcKOUhFQi3Riyev+xSX
CiLHK0mCmAS4RFEWoHo5uMJw/tQ1LwgQooJ0NlWaX5xLMSJColtNt0WPJ49Ek573+VeQXECi
jBV7EdPzORBoLRZH2/bTGJ0YKU9Ojfe97hHtfC1yx8uxjPHFmKJIcC+IVwCXjUJlGqqPwe3j
UH0uRCNHYS6YNPlh3CDCmfVL1DVRBCH5cPCe5eVNCPiDKNFPlF2LcHs53D4Xtm3Zg5CvBdmh
jEUOkromin9NQdfEREWsdD4YvFPaETgAm5WgelZP3rwpgP2hY+jLPi4JUenUNTFRd4y6Jnpn
jU8vhscGRGswAa4wKG6OQ+ETyL17W/lhfuvXNdHb8B2Qg46hkYHvprFAu5ti2OWPwfy6TLlR
Pe/I1dwNAbomiiSRzGSfWVuxD0GnFU/7n1iO/JO7Wmzjb/yteJd6LtK88zYAzOY/X9po/b8A
ADh8Rb0PAMM3xdl/9fwCc0oSKoZoHMsAAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:32'!
testRunnerIcon
	"Private - Generated method"
	^ icons
			at: #'testRunnerIcon'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self testRunnerIconContents readStream) ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:57'!
toolsIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAA
CXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1QkaDBM5i2PCSAAAAfBJREFUOMulkktoE2EU
hb+Z+EyKTRQKgkqwzMaFtt1FrC40FGJm60JwIVSkqLUtElICFQNDQqBrQXRlQIriwomN0GJX
gtI2iUkXFYJVadOXhiBERDozbmaGMR3rwrP7ueece++5P/wnBOcjnVGigArI8Vgi9xdNNJ1R
bI7YUlT7r/YDqKaZq/j6tQHNbLQd6YxiNBp1I51RDPdaw6pFAcR0RolaZKur19vmZhwFePDw
PvFYQgZyACKgDt4cMp4+mzAA9fatETbX15A6Jer1r/das4ndGRUsMYBgFW8MDBqatiXoum7o
ukZhfk4ovC8CyDsFK7R0sBHpu0i5UmG59gUgGY8l7v7zjE68yr80SpUS3Sd7KJYLmBNMArqr
QTCSOgzUrPeVkE7XCYmjR47RbDZ5N/cWtzU8TvH4cJi+UCcdAS/ZmU2Ot39LLn1eOtd9qoeA
P8BKbfnyhfD5+emp11XAABCDkVQXUHs0JjNbXmS2vEjHQR8A5t5yLv8CSZI4e7rX+mR2HiJQ
HB8OM/WmxJamI+7zs1Fv2iOaI8vZJ4850O7nTKgXYMxpAMDuXR72+A7x88cvsvkFgHCrSS6v
Uv1Y/SNsEWBl4zv7fQHa9np4PvMBIPxpcnTaSTRNkmvrqwtA0r5CMJK6BEw4uNvEO+E3N+LV
9uq8VLwAAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:57'!
smallUndoIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAA
CXBIWXMAAA3XAAAN1wFCKJt4AAAAB3RJTUUH1gcaCg4AFiOWIQAAAhdJREFUOMuVk09okmEc
x7/P877P1OX+6MYa0ojWwfIQFIRBgxUEQrBDeAiCYkRQXTuMPHgox4wdIrp0qVhBEDTpUCwW
wVKMWnaKlLRoDXITXL4654bv6/M8HcKlm5Z9b88Xvp/neX7P9wGaKDoFiRakbjXm7qGXKcii
RdHahd/HbExB1u0NtZr/cwK/j9k8TiPn9oaAwtXNa+ikJ8MFzYC2xcPJ7MXxCb1UCyBbw0Zu
HCrVAIsXkBVwLgGI8pvZx18ZBXmVKHgCQeNHFaD4fazd4zRW3d4QjJ/XQShFuQyAL0JfT0Fb
iUHKkjroOtFntii9NuRPD+yrvI5ExTIAKBMXhF4NU6r8pqoMUkoIwSGEgOBrKK+nYLKYyI6u
XZ2dYu3Q7v36o0hUGPRlktnnQ16wjpMAAM51LHz7iMXvcaTTX+oGVtTisPe7YG5nB4ad3eHt
MxgZw0LiJva4rkDwYl1YFO8ik2Uo6xw9jkv49Ha6dPxs2qoCQCBoaPAxOzCZc4+MAQBiM3fq
38tC4DpyGYXMA5jMOgiRal0PAkFDm00y+/yzyc3M0CjI0CgIgIOlvDyVmLv9vm/gHLjoAJHS
hL/VuFGVw/fheDdN5eryDRF5aJPbmli7cyN/+DyWFGGVG8U4hGrPNwU0g0SnMNjtOCy07BIA
3Gr4mf6ho1079858jj2pHDujXftvgGzrt6Y+PH9Bde1p1fsFBRbiJSu+JBQAAAAASUVORK5C
YII='! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'BenjaminVanRyseghem 3/28/2014 17:38'!
instVarsPressedIconContents

	^ (Form
		extent: 24@24
		depth: 32
		fromArray: #(16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 257246361 1096172449 1951810206 2807448223 2807448223 1951810206 1096172449 257246361 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 106255786 2253800352 4216668832 4283777695 4283777695 4283777695 4283777695 4283777695 4283777695 4216668832 2253800352 106255786 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 810893471 3528803231 4283777695 4267329699 4285423022 4286278581 4287133885 4287133885 4286278581 4285423022 4267329699 4283777695 3528803231 810893471 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 810893471 4183114655 4283777695 4285159595 4287528640 4287792067 4287792067 4287792067 4287792067 4287792067 4287792067 4287528640 4285159595 4283777695 4183114655 810893471 16777215 16777215 16777215 16777215 16777215 16777215 16777215 106255786 3528803231 4283777695 4286146740 4287792067 4287792067 4289371856 4289371856 4289371856 4289371856 4289371856 4289371856 4287792067 4287792067 4286146740 4283777695 3528803231 106255786 16777215 16777215 16777215 16777215 16777215 16777215 2253800352 4283777695 4285028010 4287463104 4287463104 4287463104 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4288450504 4287463104 4287463104 4285028010 4283777695 2253800352 16777215 16777215 16777215 16777215 16777215 257246361 4216668832 4267263650 4286738873 4286936507 4286936507 4286936507 4290622682 4293124336 4294967295 4294967295 4293453555 4291083486 4287594689 4286936507 4286936507 4286738873 4267263650 4216668832 257246361 16777215 16777215 16777215 16777215 1096172449 4283777695 4284830888 4286410166 4286410166 4286410166 4286410166 4286410166 4291149535 4294967295 4294967295 4292334569 4286410166 4286410166 4286410166 4286410166 4286410166 4284830888 4283777695 1096172449 16777215 16777215 16777215 16777215 1951810206 4283777695 4285159338 4285949105 4285949105 4285949105 4285949105 4285949105 4290951900 4294967295 4294967295 4292268263 4285949105 4285949105 4285949105 4285949105 4285949105 4285159338 4283777695 1951810206 16777215 16777215 16777215 16777215 2807448223 4283777695 4285159594 4285422764 4285422764 4285422764 4285422764 4285422764 4290754523 4294967295 4294967295 4292071142 4285422764 4285422764 4285422764 4285422764 4285422764 4285159594 4283777695 2807448223 16777215 16777215 16777215 16777215 2807448223 4283777695 4284698790 4284896167 4284896167 4284896167 4284896167 4284896167 4290491096 4294967295 4294967295 4291939300 4284896167 4284896167 4284896167 4284896167 4284896167 4284698790 4283777695 2807448223 16777215 16777215 16777215 16777215 1951810206 4283777695 4284172448 4284369825 4284369825 4284369825 4284369825 4284369825 4290293717 4294967295 4294967295 4291741922 4284369825 4284369825 4284369825 4284369825 4284369825 4284172448 4283777695 1951810206 16777215 16777215 16777215 16777215 1096172449 4283777695 4284106657 4284501667 4284501667 4284501667 4284501667 4284501667 4290359766 4294967295 4294967295 4291807971 4284501667 4284501667 4284501667 4284501667 4284501667 4284106657 4283777695 1096172449 16777215 16777215 16777215 16777215 257246361 4216668832 4267066272 4284698790 4284764582 4284764582 4284764582 4287002554 4291478240 4294967295 4294967295 4292597482 4287002554 4284764582 4284764582 4284764582 4284698790 4267066272 4216668832 257246361 16777215 16777215 16777215 16777215 16777215 2253800352 4283777695 4284172450 4284962216 4284962216 4284962216 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4286278836 4284962216 4284962216 4284172450 4283777695 2253800352 16777215 16777215 16777215 16777215 16777215 16777215 106255786 3528802975 4283777695 4284633254 4285225386 4285225386 4289701586 4290228182 4290228182 4290228182 4290228182 4290228182 4286015409 4285225386 4284633254 4283777695 3528802975 106255786 16777215 16777215 16777215 16777215 16777215 16777215 16777215 810893471 4183114399 4283777695 4284369828 4285356972 4285488557 4285488557 4285488557 4285488557 4285488557 4285488557 4285356972 4284369828 4283777695 4183114399 810893471 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 810893471 3528802975 4283777695 4267132321 4284567462 4284962217 4285357228 4285357228 4284962217 4284567462 4267132321 4283777695 3528802975 810893471 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 106255786 2253800352 4216668832 4283777695 4283777695 4283777695 4283777695 4283777695 4283777695 4216668832 2253800352 106255786 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 257246361 1096172449 1951810206 2807448223 2807448223 1951810206 1096172449 257246361 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
		offset: 0@0)! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:57'!
haloFontEmphIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/haloFontEmph.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQAQMAAAAlPW0iAAAABlBMVEX///8AAABVwtN+AAAA
IklEQVR4XmNABvJ7GOQXMEgoMEg4MMhVMMg5MEg0QBEMAABvFwTnHxf6BAAAAABJRU5ErkJg
gg=='! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:57'!
jumpIcon
	"Private - Generated method"
	^ icons
			at: #'jump'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self jumpIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:57'!
checkBoxOffIcon
	"Private - Generated method"
	^ icons
			at: #'checkBoxOff'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self checkBoxOffIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:23'!
haltIconContents
	^ ((ColorForm
	extent: 12@12
	depth: 8
	fromArray: #( 437918234 437918234 437918234 437654804 319885069 26 437590295 404100630 100859930 437524241 269290764 100860442 437327375 235736076 67305498 437261581 218893324 67305754 437130258 303174162 84082970 436931081 134678279 196890 437918234 437918234 196890 454761243 454761242 196890 454761243 454761242 196634 454761243 454761242 26)
	offset: 0@0)
	colorsFromArray: #(#(0.349 0.212 0.098) #(0.329 0.2 0.094) #(0.376 0.232 0.109) #(0.694 0.462 0.271) #(0.608 0.271 0.204) #(0.545 0.185 0.113) #(0.784 0.322 0.294) #(0.721 0.023 0.023) #(0.788 0.055 0.055) #(0.848 0.106 0.106) #(0.875 0.137 0.137) #(0.914 0.208 0.208) #(0.953 0.298 0.298) #(0.953 0.318 0.318) #(0.953 0.333 0.333) #(0.953 0.349 0.349) #(0.953 0.365 0.365) #(0.953 0.388 0.388) #(0.922 0.427 0.427) #(0.953 0.482 0.482) #(0.949 0.542 0.538) #(0.957 0.592 0.592) #(0.953 0.624 0.62) #(0.984 0.879 0.879) #(0.988 0.898 0.898) #(0.992 0.918 0.918) #(1.0 1.0 1.0) #( )))! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:34'!
warningIcon
	"Private - Generated method"
	^icons
			at: #warningIcon
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self warningIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:28'!
smallObjectsIcon
	"Private - Generated method"
	^ icons
			at: #'smallObjects'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallObjectsIconContents readStream) ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'ChristopheDemarey 7/26/2013 13:18'!
upIconContents
	"Private - Method generated"
	"Icon from http://tango.freedesktop.org/Tango_Icon_Library, public domain"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABl0
RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAAIeSURBVDiNlZNPaBNBFMa/N7sz
2Y2FemhM/9GCBO3BQCqo0NWKaERiRS0UcmtKyUmQYhbBq8dSkaAXD0VPHqVC8eJNKl5EUNBD
KbQqlZQ0iaaaJtnZGQ9RrCGp9h3f++bHfN+bIa012tXJm3weAJZmvel2GtZu4Lg83d8VSfZ1
HUw6Lk/vCeC4PBoQ+7JXzkwGx0aTwYAIZh2XR/8L4Li8A4TFiXPT1paXx5a3ifjIJQuERcfl
Hf8EEOHR6HCipzc0SJ9LH/Cx9B6dnZ0UGzrRDcLDXQGOy9P9ByKJs0fH+Ur+DQzGYTKOV2sL
iA0dF6H9PYnmPNiOw1HB7Wwq4drr5WVo8iCEiTp9xzYV8S7/HBdOXw2apvgrD7bT99RYxlLk
oSJLEAEBHuAoy3UI20BBrqKoVnH+1EWL2J882G/f8WPj3Yf6YpSvrMHkBjg3UFEFVI2vEDaD
sBmWv71AuDdERw4Ph4k18qCRjJke6I5kb0zcsQUPQEHCh4fXuQW8LTyDZBUQIyQGMtBaQymg
Xq/h8dP5SrG0OWMSQ+pTbsWeuXe54Ymjevf6E6ssc/CNbXDBwEyCwQlzD25XZU1bv+wHiSFl
Ls16TtMmtNYKpfoXMINgcAYeaEBkTVsv5zza9R0AgNI+ftSLjSv7GrKuoFXrP2O2avpKolrb
hjI1oBV8SfC9PQCkLxEfvAZiADECEfYAIGzcuj8ZbiUmwkZz7ycw98XbttCaIgAAAABJRU5E
rkJggg=='! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousOpenFromUrl
^ self icons
		at: #glamorousOpenFromUrl ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 620756992 3204448256 436207616 0 0 0 0 0 0 0 0 0 0 0 0 620756992 3841982464 4278190080 3657433088 436207616 0 0 0 0 0 0 0 0 0 0 620756992 3841982464 4278190080 4278190080 4278190080 3657433088 436207616 0 0 0 0 0 0 0 0 620756992 3841982464 4278190080 4278190080 4278190080 4278190080 4278190080 3657433088 436207616 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1308622848 1996488704 620756992 2919235584 4026531840 3489660928 1107296256 0 0 0 0 0 0 0 0 838860800 4278190080 4278190080 4261412864 4278190080 4278190080 4278190080 4093640704 469762048 0 0 0 0 0 369098752 2583691264 3640655872 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 1895825408 0 0 0 0 0 3087007744 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 2147483648 0 0 0 0 4076863488 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4060086272 0 0 0 0 2986344448 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 3338665984 0 0 0 0 285212672 2399141888 3187671040 3221225472 3221225472 3221225472 3221225472 3221225472 3221225472 3204448256 2684354560 520093696 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: (0@0))]! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
radioButtonOnIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/radioButtonOn.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAAAwAAAAMAQMAAABsu86kAAAABlBMVEUAAAAAAAClZ7nPAAAA
AnRSTlMA/1uRIrUAAAAnSURBVHheY5BvYFBwZHBQYugXYZg/g2H+TCjql2Rw0GBQcGGQbwIA
oQ8I+ivd3nEAAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:19'!
announcementIconContents
	^ ((ColorForm
	extent: 12@12
	depth: 8
	fromArray: #( 168300858 976894522 976888885 34288443 993737531 993722369 959979575 673982238 103889690 87761712 705236742 120273668 87758851 152641799 789920516 959985427 204284436 488586007 34289723 993723152 926613505 168311098 976632635 473311541 1010580540 1007826230 840318012 1010580540 456396046 1010580540 1010580526 623262780 1010580540 1010580540 1010580540 1010580540)
	offset: 0@0)
	colorsFromArray: #(#(0.706 0.788 0.875) #(0.439 0.596 0.761) #(0.545 0.674 0.807) #(0.887 0.934 0.996) #(0.538 0.667 0.804) #(0.423 0.585 0.753) #(0.859 0.918 0.992) #(0.844 0.91 0.992) #(0.577 0.694 0.819) #(0.879 0.93 0.996) #(0.953 0.969 0.98) #(0.663 0.757 0.855) #(0.863 0.922 0.992) #(0.372 0.549 0.733) #(0.71 0.792 0.879) #(0.867 0.926 0.996) #(0.815 0.891 0.992) #(0.361 0.542 0.729) #(0.435 0.592 0.761) #(0.875 0.926 0.996) #(0.827 0.902 0.992) #(0.819 0.894 0.992) #(0.678 0.768 0.863) #(0.49 0.635 0.784) #(0.898 0.941 0.996) #(0.867 0.922 0.996) #(0.482 0.628 0.78) #(0.639 0.741 0.848) #(0.937 0.953 0.973) #(0.815 0.894 0.992) #(0.871 0.926 0.996) #(0.819 0.894 0.988) #(0.941 0.965 0.996) #(0.855 0.914 0.992) #(0.84 0.906 0.992) #(0.91 0.945 0.996) #(0.522 0.655 0.796) #(0.431 0.592 0.757) #(0.745 0.815 0.891) #(0.883 0.934 0.996) #(0.902 0.945 0.996) #(0.458 0.612 0.768) #(0.891 0.937 0.996) #(0.836 0.902 0.992) #(0.894 0.937 0.996) #(0.851 0.914 0.992) #(0.914 0.937 0.965) #(0.831 0.902 0.992) #(0.902 0.941 0.996) #(0.863 0.918 0.992) #(0.365 0.545 0.729) #(0.984 0.988 0.992) #(0.6 0.714 0.831) #(0.906 0.934 0.961) #(0.616 0.721 0.836) #(0.914 0.949 0.996) #(0.992 0.996 0.996) #(0.353 0.534 0.725) #(0.345 0.53 0.721) #(1.0 1.0 1.0)))! !

!ThemeIcons methodsFor: '*MonticelloGUI' stamp: 'TorstenBergmann 12/2/2014 21:04'!
newerPackagesAvailableIcon 
	^ icons
			at: #'newerPackagesAvailableIcon'
			ifAbsentPut:[ self newerPackagesAvailableIconContents ].! !

!ThemeIcons methodsFor: '*Komitter-UI' stamp: 'VincentBlondeau 12/16/2014 14:26'!
overlayModificationIconContents
	"Private - Method generated"
	^ 'R0lGODlhCwAKAKIAAD8/X////7+/v5+fn4CAgF9fXwAAAP///yH5BAEAAAcALAAAAAALAAoA
AAMpeLHMpwXIGV4A8RZTFR7BsHUXEXAEZwHCYAyC6jUnCRg4DpC08/zARwIAOw=='! !

!ThemeIcons methodsFor: 'initialization' stamp: 'EstebanLorenzano 5/9/2013 11:05'!
initialize
	super initialize.
	self initializeIcons! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
eyedropperIcon
	"Private - Generated method"
	^ icons
			at: #'eyedropper'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self eyedropperIconContents readStream) ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
jumpIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAC5SURBVDjLY/j//z8DJZhh1ADs
BjjsspIC4gb77ZZX7TdbXLVda9Zgs8xEihQDGmZfm/7/0KOD/3ff3/V/6plJ/y3mGjYQbYD9
NsurBx4e+D/10tT/nWc6/i+5sui/+RS9q0QbYLfB/OrWO1v+d5/p+t96qvn/3Auz/pt0aRNv
gPVyk4appyf+X3xl4f/ZF2b+n3Co579+mSrxXrCcZyhlMV2/wbRP56pRq+ZV3SLlBq1EOanR
lEgjAwAXIuIDq5qm/AAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousRedo
^ self icons
		at: #glamorousRedo ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 956301312 1828716544 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1073741824 4278190080 2852126720 218103808 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1073741824 4278190080 4278190080 3640655872 771751936 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4127195136 1627389952 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4127195136 1627389952 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 16777215 16777215 1073741824 4278190080 4278190080 3640655872 771751936 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 16777215 16777215 1073741824 4278190080 2852126720 218103808 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 16777215 16777215 956301312 1828716544 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallCancelIcon
	"Private - Generated method"
	^ icons
			at: #'smallCancel'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallCancelIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousSpawn
^ self icons
		at: #glamorousSpawn ifAbsentPut: [(Form
	extent: (16@18)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 587202560 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 1979711488 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 503316480 4278190080 3992977408 2919235584 184549376 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 754974720 2852126720 3909091328 4278190080 4278190080 4278190080 4060086272 3674210304 620756992 16777215 16777215 16777215 16777215 16777215 16777215 1711276032 4143972352 4278190080 4278190080 3825205248 4278190080 4278190080 4278190080 4127195136 1912602624 16777215 16777215 16777215 16777215 16777215 973078528 4244635648 4261412864 2399141888 452984832 16777215 4278190080 4278190080 4026531840 2751463424 268435456 16777215 16777215 16777215 16777215 16777215 3556769792 4278190080 2046820352 16777215 16777215 16777215 4278190080 4060086272 1778384896 16777215 16777215 16777215 16777215 16777215 16777215 469762048 4278190080 3858759680 67108864 16777215 16777215 16777215 3590324224 1006632960 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1308622848 4278190080 2969567232 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1426063360 3758096384 2315255808 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'TudorGirba 3/5/2015 10:46'!
glamorousCloudIconContents
	"Private - Method generated with the content of the file /Users/girba/Work/Code/moose/icons/glamorousCloud.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAAXNSR0IArs4c6QAAAAlwSFlz
AAALEwAACxMBAJqcGAAAAdVpVFh0WE1MOmNvbS5hZG9iZS54bXAAAAAAADx4OnhtcG1ldGEg
eG1sbnM6eD0iYWRvYmU6bnM6bWV0YS8iIHg6eG1wdGs9IlhNUCBDb3JlIDUuNC4wIj4KICAg
PHJkZjpSREYgeG1sbnM6cmRmPSJodHRwOi8vd3d3LnczLm9yZy8xOTk5LzAyLzIyLXJkZi1z
eW50YXgtbnMjIj4KICAgICAgPHJkZjpEZXNjcmlwdGlvbiByZGY6YWJvdXQ9IiIKICAgICAg
ICAgICAgeG1sbnM6dGlmZj0iaHR0cDovL25zLmFkb2JlLmNvbS90aWZmLzEuMC8iPgogICAg
ICAgICA8dGlmZjpDb21wcmVzc2lvbj41PC90aWZmOkNvbXByZXNzaW9uPgogICAgICAgICA8
dGlmZjpQaG90b21ldHJpY0ludGVycHJldGF0aW9uPjI8L3RpZmY6UGhvdG9tZXRyaWNJbnRl
cnByZXRhdGlvbj4KICAgICAgICAgPHRpZmY6T3JpZW50YXRpb24+MTwvdGlmZjpPcmllbnRh
dGlvbj4KICAgICAgPC9yZGY6RGVzY3JpcHRpb24+CiAgIDwvcmRmOlJERj4KPC94OnhtcG1l
dGE+CrDjMt0AAACsSURBVDgRY2AY8oCZCB+IAtV4A7ELEP8H4qdAjBfUA2WvAfEiIA4C4ndA
DNIIwwuAbCYgxgrcgaIwhfjoAnTdCkCBYiDeC8T4NMLkTgDVwYE1kPUZiGGSxNB/gOrnADEP
EDOATCNGEzY1ixmBmkG2g00C0qSCT6DQvECqLiT1z0FsYyB+C8TYnIhP7DdQTxDICyAgDsS+
QCwNxDAxIBMn+ASU2QnEV3GqGDoSAEtMUFDuPX1rAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 12:40'!
nautilusIcon 
	^ icons
			at: #'nautilusIcon'
			ifAbsentPut:[ self nautilusIconContents ].! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:35'!
arrowUpAndDownIcon 
	^ icons
			at: #'arrowUpAndDownIcon'
			ifAbsentPut:[ self arrowUpAndDownIconContents ].! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:14'!
breakpointIconContents
	^ (Form
	extent: 12@12
	depth: 32
	fromArray: #(65793 263172 723723 1118481 1118481 986895 2105376 2763306 2763306 67103462 268432883 2763306 592137 4292120661 4294091872 4294091873 4294157409 4293761359 4293692217 4292966190 4291188009 4290667050 3788336426 2697513 1842204 4293896029 4294950266 4294951566 4294952079 4294946163 4294679882 4293560119 4291455268 4290408752 3781443373 2236962 2434341 4293634672 4294947176 4293104482 4293298523 4293889090 4294283834 4292508724 4289353754 4288703298 3779669784 460551 2763306 4294090583 4294944865 4294414649 4294412365 4294740308 4294347083 4292442425 4290340132 4289030722 3781115940 0 2763306 4293628243 4294416447 4293757242 4293558847 4293558846 4293428282 4292576052 4291195169 4289356842 3784068364 0 100637231 4293560659 4294345772 4293425455 4293292847 4292965164 4293096750 4292770607 4291784990 4289290532 3781376536 0 268414300 4290343737 4288897835 4289357356 4289357355 4289357356 4289621035 4288765476 4287250199 4288964671 3780194070 0 1447446 2500134 2697513 2763306 2763306 2697513 2500134 1447446 4284691226 4288243004 3780655396 0 263172 1118481 1973790 2368548 2368548 1973790 1118481 263172 4283972646 4288182882 3780721959 0 0 0 263172 526344 526344 263172 0 0 4283777067 4286604879 3780524581 0 0 0 0 0 0 0 0 0 3997841701 3999418930 3528274204 0)
	offset: 0@0)! !

!ThemeIcons methodsFor: 'private - utilities' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
readIconMethodsFromDirectory:  dir
	(dir entries 
		select: [ :each | each isFile and: [ (each extension = 'gif') or: [ each extension = 'png' ] ] ] )
		do: [ :each | self storeIconMethodFor: each ].
		
	! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:31'!
smallScreenshotIcon
	"Private - Generated method"
	^icons 
			at: #smallScreenshotIcon
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallScreenshotIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
radioButtonPressedIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/radioButtonPressed.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAAAwAAAAMAQMAAABsu86kAAAABlBMVEUAAAAAAAClZ7nPAAAA
AnRSTlMA/1uRIrUAAAAnSURBVHheY5BvYFBwZHBQYugXYZgwg2HCTCjql2Rw0GBQcGGQbwIA
nLkIvsby5GsAAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:47'!
instVarsPressedIcon 
	^ icons
			at: #'instVarsPressedIcon'
			ifAbsentPut:[ self instVarsPressedIconContents ].! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousUndo
^ self icons
		at: #glamorousUndo ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1828716544 956301312 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 218103808 2852126720 4278190080 1073741824 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 771751936 3640655872 4278190080 4278190080 1073741824 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1627389952 4127195136 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 1627389952 4127195136 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 771751936 3640655872 4278190080 4278190080 1073741824 16777215 16777215 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 218103808 2852126720 4278190080 1073741824 16777215 16777215 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1828716544 956301312 16777215 16777215 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:48'!
instVarsUnselectedIcon 
	^ icons
			at: #'instVarsUnselectedIcon'
			ifAbsentPut:[ self instVarsUnselectedIconContents ].! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
infoIconContents
	"Private - Method generated with the content of the file icons\base\info.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAADAAAAAwCAYAAABXAvmHAAAABHNCSVQICAgIfAhkiAAAAAlw
SFlzAAAN1wAADdcBQiibeAAAABl0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoA
AAuwSURBVGiBtZl7cFTXfcc/5660D1YP9ECykIRMgoQtwOZlHqaeOKYTSDxOGtcwnqStTcDj
Gsdx3IS0k6Z0JjN1GscOdqGtmweOXXucmZIGQ2yTGMcFBwyYhw3ijUAPjJ4rCe3z3nvuOf1j
70oraSWtRLIzZ/aeK83ez/d3fq9zrtBacyMfsb73lrmVxoY8P7PyfSKY5yMv4CXPACNuq0gk
oaPhhIpEE7rtUqf9UtRUh/UvKm/soenPn4yA0if7l95cKp6oKRb1K+tzZ6y9w1tSmieG/I8G
0u9EEppdJxLhN47HW5tD8uK1Xrm9Zcv0XTeGP0EBwY3h+vnV4oWvLstd9NCd3qKgT9DZL2lo
TdDUZdETkYQiklBYYktN0GdQEBAUBDxUl3hZMivIrAo/ltTsOh6Pb3sn3HClS3635fnKvX9S
AeKRcNniGuM/7rs9Z8V3Vntvsh3NgfMxTrUkaOuzkI5GKo10VPJ6YKih10ozdYqHpbV5PLCs
mOpSH9v3hXu37wsfO9lqfiPys5ln/+gCKjdFli2aYbz88vpAXdALBy7E2Hc2SsxUg4BZwqfm
SikMAfctLmL9ynLy/B6++Wp3828/jmxu3DLzlT+agFs3Rx/5/BzP5mfX+qsutJvsPhamN+rg
OBp7CNQY8MPEKaXQWg8MXw5sXD2dtSum8Z97+7q27ul+7exztd/SWqtsBOSM9ocF34/+63dW
eR9ZtyK3eP+5GL9viGA5OgP80FE4xeDmUj9CQGOHyZXOxKjwSmtipuJHO1s40xrhuw/cPG1O
lffRJ4wLnxJTa9dw/ZKtx3GRjCtQvzm64duf8/7wb5bnFL9xLMLJlvgAxEj4Qes+eGcR9y4s
xGMM5p/3TvfzL7/6hITljIDXaYKU1sypmsKW9XVc6rDNdVsvvnpu6/wnAHOs1TCG36jcFFm6
ao7nn7/2Z7kj4KVKwjvu3EmDv7s+jy8unjoEHuCzcwrYuKp8XHitFKeawzz+X2eZX+P3fetL
lX9Z89CeJ4GgEMKTlQDxSLh00QzjlefW+qvePx8bAW8PuFASPjWXjmJ5Xd6oy7xyXsG48Kn5
mdYI//TaRTasLJ163123PFV4zw8/B+QJITK6+xABS2caW19aF6i72G7x7qnIYBAq5Vp8JLzt
KByl8eWKTL8PgC/XQDA+fGr+1tFOfva7Vn78UFXZrYtWfh+4abSVGBCQ/3i47gvzcj5TEIBd
x/qxR0mPKbdJh7cdzcdNsVEFnLgcRars4FPzF3ZfoaUzwhP3Vny6bPWP1wFlQEAIMcToA5P5
1ca/bVrlrTh4IUZf1Bk/tyuNo/SAmFf2d3P2k/gI+I7rNs/sbJ0QvNIay1Y8/0YT984P+mpv
W/5VcgI1QAngFUIMLLfQWlPw9fD8H9zve/fhFTnFz/2mm6ilxoUfXqhsR6OV5p55Bcye7ifX
I2hsT/DmsRDRhBwaxOOJSbv388fr6IlqtfHp/3297a2ntgGXgV6ttQ1uHagtE0/+1fLc4kMX
o2PDq9HhHSf58D0nenn7eGbYicIrrfn53mv84CvVRnlN/bI2+DUQBhJCCEdrrQyA6UXitsKA
4FRrYmz4DC1COvxYsEMAs4TXWnPo/HWiCZtZlfklBEqr3IAuSBk/R2zom/3sGn91b9ShNWRN
CF6mwc+tDvDZuQUk62Ly4WjQaM60RvnN0e4RcOPBa6UwHc0H565z/5LCgt/d9tfL+w9v6QC6
gX4hhJ0zu9xY9+AS77SG1viE4WWa5WsrfKy9szRjFtr9YRe7j3SOCzva/P1z/XxzdYlRUbf0
9v7D7AOKgQ4gZhQERG1lkUFTlzVp+KQlM6dQpRTSticNnyxuMZQjKQj6pwBBoAjIB3KNAj/5
AKGwvAF4TXIPNhLeNE2ktAddZoLwWilCYRspJX5fjg/wuTFQCHhz8v3kAXSH5aThM62A1hrL
srAsC9uWI4J2ImKuxxQJy8HnzfECue4q5AM+Y4o3uQLd/fak4VMPTIc3TRPTNLEsCynlmIUr
m4Du7DMpDQoPwel5gBcIAF5DCIQGrBuBd++lPinLW5aFaZrYtj0q/HDg0YZl2wiUQHgMN4X6
AK8RM3VYAPl+IwO8ngB8UkDK8ulDSjmh3J9pXhiAjuvSIXo1TrIFygVyjUhCRQAKp3gyFzE1
Mm9ndoOhlh8ybOuG4P25Ag8O0bhpo7VwBXgAj9Ef1+GkACMzvMquBZBSZrS+ZVlIW44UnyW8
0prCAEgpiSdMOy1PCEAY4YRq7YkqZpR605q1icFrpVCOk9H6pmlipwXxROG11lQXCxzHIRqL
J9KzNKCMM9fsl3ceT/Qu+XRwEN6ZGLzWGuk4Ga1vmuakClm62y6oMrjUpXXnlY+b3GBTgARs
Q7900/G3T5rNNdN8TCv0TApeuy6UyfrJNGpPGt4QmrnT4benzEj49P+cdQU4gA3YBkBztzxn
Sc2y2rxJwQ+PgRR86tpOxUCWbpQ+Zk0T+D0OjW2RMLH2uCtAAiZgGQBNXfInOz6Mh7+8pBiP
wcgqm0UPr5QzwvJD6sBEY8C9t+pWQVNI666rF1pc13Fc+OiAgM5tFe+9+F70ZHmhly8unjo0
Y4wnxr0n5RgxkF4HRoPNAD+7XDC3QvPKB1ZvzwfPH3HhLSACXAfMgT3x+WvWt/99bzj0tXvK
CXhFRviR/U9aEI8RA7Y9Rgxk8HutFBrNmoUGp9twLp85fBo7aroCEi58/8AKAHRsqzz0y0PR
D3NzPDy2qmKkdcaowsOz0IgYSHWjWcIrrbm7VlBV6PD6Eaun/8i2o2mBGwF63G855IjiRLO1
8fGXQ01r7pzGl+4ozry0o8SBcuSoMSDtDHVgDPi6MsHaBbDjIxFrOfqrgygp3cCNASGgC4jq
1J449Ulsn3Hl8KXEUz96s6/rH+6vYeGn8rI+jBorBuzhMTAGfEkQHrtLcOIq9u8PnmxInP/1
pbSs00dyJ9bjxsLIs9Gzz1TtfO1A+MW9p+OxZx+u5faaYFbp1BkrBiwra/gn7xb0xdGv7u9u
7n3/6T+48BbJ04gOoA2IaK2djAIAPnq6evPmHaGdx5qsxE+/Xs99d0wbdyVCUcW5NofzHZpL
3QaNIYPGkIemPi/d8dxx4WeXC7632kAqoV94J9bWsWfTW2nwERe+1XUhM8U65guOhf/Y/MzD
dxWs/8bqouLt71zl+V2XsWw1pphsLD0829wz28PaBXCsFfna/s6m9rc3vYmTMNPg24GLQCPQ
o91DrXEFAMz7+8tfWVEXeGbrwzdVdvSabHnjMruPtKMcdcPw9RUGDyw0qCpU7Dgh4u8e/Ohk
z/4hbhMFOkmexjUCXVprM50vq5d81Y813F5TFnjxb/+8eN6DywuCDU19/GRPM/tO9yaPDcfp
Z9LnHqGprzBYPSeHW8o1Jz/Rzi8Px0MtH+44EDu/MxWwKct3Ak3u6AISehhw1q9ZhRBGzYY/
rL15evH3/u4LJbWfucXnjcVNDl3o4/9O9XC6NUZHn0VP2EKlbYLyvFAUFNSUeFgww8PcCkGO
kDR2af3fB+M9lxsOnOw7su0oyaBMZZt+kj7fTNLvezLBT0hASgT+ksCMNa8+WlFWtGZmuW/G
lxfnly2q8eSgHWzbJmHZdPaZJEzJ1IDGwEFKiS0lZ64pvedUPHylLdzf1XLmSs8HLxxGxmwG
W4QYyVTZDlwlmXGuA1Ym+AkLcEUIkqcCeRTOqsxb+OhfVM689fOFU3KK/V4jEPB6/AUBw+cR
WnT3m3Y0nrBjMdPqj8bNzisfXYo2vH6GeGecwcbMImn1MMkM0+6OEMliJcfkmaiANCGpk4F8
kkd9JcBUoBBfUREe3xRi7ZLk3jX99Y1icEOSYLAx6yF55plqEyydxavWSQtwRQgGjzgCrpgC
9zvg3s9NE5Hq5VO+HmWwMYuSdCErVaSyYrgRAcOEDBx1pIGnRkpAyvKSZGOWch8bkNlY/E8i
YMgPJsWkBBlp15BcgdSeVqXmowVoNp//B5V52MnTW/VPAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
publishIcon
	"Private - Generated method"
	^ icons
			at: #'publish'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self publishIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:35'!
arrowDownIcon 
	^ icons
			at: #'arrowDownIcon'
			ifAbsentPut:[ self arrowDownIconContents ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallJustifiedIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAQAAAC1+jfqAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAABjSURBVCjPY/zPgB8wMVCqgAVE
lP//x/AHDH+D4S8w/sWwl5GBgfE/MSYU/IfpheiEwTNEm5D6H9lmBLxFtAmR/3+h6YWY95xo
E7z/o+uHwM9Em2D7/yeSzSAICdc/xJhAMLIA+V1VH3Z4v2kAAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:34'!
windowMaximizeForm
	^ icons
			at: #'calendarIcon'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self windowMaximizeFormContents readStream) ].! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:25'!
testGreenIconContents
    ^(Form
	extent: 12@12
	depth: 32
	fromArray:   #(16777215 16777215 16777216 1694498816 3003121664 3858759680 3858759680 3003121664 1694498816 16777216 16777215 16777215 16777215 436207616 3204448256 4278323202 4280376350 4283209800 4283603789 4281625137 4278454788 3204448256 436207616 16777215 16777216 3204448256 4279053323 4284135253 4285913199 4286964095 4287686539 4287686539 4286173300 4279974425 3204448256 16777216 1694498816 4278390018 4281819188 4281322278 4281584939 4283421512 4286701692 4287686539 4287686539 4286502265 4278718727 1694498816 3003121664 4278532866 4279526927 4278962688 4278962688 4278962688 4280077330 4285521256 4287686539 4287686539 4282680896 3003121664 3858759680 4278596868 4279588369 4278962688 4278962688 4278962688 4278962688 4279880718 4286505081 4287686539 4284724574 3858759680 3858759680 4278596100 4279775511 4279091970 4278962688 4278962688 4278962688 4278962688 4282700348 4286964095 4284330585 3858759680 3003121664 4278531331 4279838232 4280186137 4278962688 4278962688 4278962688 4278962688 4280863775 4285913199 4281432365 3003121664 1694498816 4278258432 4279710997 4280959017 4280909604 4279288326 4278962688 4278962688 4280928544 4284924000 4278718727 1694498816 16777216 3204448256 4278592773 4280634914 4281948471 4282806595 4282814529 4282884930 4284523356 4279448081 3204448256 16777216 16777215 436207616 3204448256 4278257409 4279649811 4280902950 4281167401 4279980312 4278388995 3204448256 436207616 16777215 16777215 16777215 16777216 1694498816 3003121664 3858759680 3858759680 3003121664 1694498816 16777216 16777215 16777215)
	offset: 0@0)! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:52'!
testRedIcon 
	^ icons
			at: #'testRedIcon'
			ifAbsentPut:[ self testRedIconContents ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloGrabIcon
	"Private - Generated method"
	^ icons
			at: #'haloGrab'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self haloGrabIconContents readStream) ].! !

!ThemeIcons methodsFor: 'initialization' stamp: 'EstebanLorenzano 5/10/2013 09:50'!
iconSelectors
	^ self class allSelectors 
		select: [ :each | '*Icon' match: each asString ].! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousZoomOut
^ self icons
		at: #glamorousZoomOut ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1644167168 3036676096 3640655872 3640655872 3036676096 1644167168 0 0 0 0 0 0 0 0 419430400 3120562176 2600468480 637534208 16777216 16777216 637534208 2600468480 3120562176 419430400 0 0 0 0 0 0 3120562176 1409286144 0 0 0 0 0 0 1409286144 3120562176 0 0 0 0 0 1644167168 2600468480 0 0 0 0 0 0 0 0 2600468480 1644167168 0 0 0 0 3036676096 637534208 0 0 0 0 0 0 0 0 637534208 3036676096 0 0 0 0 3640655872 16777216 0 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 0 16777216 3640655872 0 0 0 0 3640655872 16777216 0 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 0 16777216 3640655872 0 0 0 0 3036676096 637534208 0 0 0 0 0 0 0 0 637534208 3036676096 0 0 0 0 1644167168 2600468480 0 0 0 0 0 0 0 0 2600468480 1644167168 0 0 0 0 0 3120562176 1409286144 0 0 0 0 0 0 1409286144 3120562176 0 0 0 0 0 0 419430400 3120562176 2600468480 637534208 16777216 16777216 637534208 2600468480 3120562176 419430400 0 0 0 0 0 0 0 0 1644167168 3036676096 3640655872 3640655872 3036676096 1644167168 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: (0@0))]! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/14/2013 14:50'!
referencesIcon
	^ self smallWindowIcon! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'BenjaminVanRyseghem 12/5/2013 12:33'!
partialCheckedBoxIcon
	"Private - Generated method"
	
	^ icons
			at: #partialCheckedBox
			ifAbsentPut: [ Form
				extent: 12@12
				depth: 32
				fromArray: self partialCheckedBoxIconContents 
				offset: 0@0 ]! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:24'!
refreshIconContents
	^(Form
		extent: 16@16
		depth: 32
		fromArray: #( 0 0 0 0 0 0 0 895969127 526080859 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1884706390 4168710521 2288675434 271330348 0 0 0 0 0 0 0 0 0 828465505 2609087363 3615917702 4269439610 4285887861 4285624689 3899156584 1766607948 67569415 0 0 0 0 0 50529027 2306242166 4237069452 4286940549 4286611584 4286282619 4285887861 4285558896 4285229931 4268189543 2235514687 0 0 0 0 0 2590862701 4287598479 4287269514 4270097540 3329652342 3312217196 4285887861 4285558896 3345179491 1011567435 0 0 0 0 0 1263423054 4287532686 4287532686 3867378563 1096835168 0 1885166941 3681579120 1549227863 50923785 0 0 0 0 0 0 3061545851 4287795858 4236937866 811951461 0 0 641547581 137441585 0 0 0 0 0 0 0 34936085 4102720138 4287795858 3011016824 0 0 0 0 0 0 0 0 0 0 0 0 272317243 4287861651 4287795858 2489607268 0 0 0 0 0 0 0 0 68095759 0 0 0 204682035 4287730065 4287795858 2658432116 0 0 0 0 0 0 0 34014983 3965146967 4283979864 3125694030 0 0 3767044232 4287795858 3884287365 137244206 0 0 0 0 0 0 1129863256 4284769380 4284506208 2739423304 0 0 2189459584 4287795858 4287532686 2541123190 16843009 0 0 0 0 305805882 3597166696 4284703587 4250885983 910114623 0 0 273698896 3834218889 4287532686 4287335307 3094442353 1094532413 101255433 286199567 1582124365 3731318631 4284966759 4284703587 2689946965 0 0 0 0 879126118 3985082247 4287269514 4286940549 4286611584 4285624689 4285558896 4285624689 4285229931 4284966759 3227212635 220998700 0 0 0 0 0 509698401 2977659771 4286743170 4286545791 4286282619 4285887861 4285558896 4100417383 2170116441 103295016 0 0 0 0 0 0 0 0 575820370 1734895720 2121298032 2037017194 1448564567 255013683 0 0 0 0 0)
	offset: 0@0)! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloViewIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/haloView.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQAQMAAAAlPW0iAAAABlBMVEX///8AAABVwtN+AAAA
IElEQVR4XmNABuwPGGR+MOh+YfD/xKD+hEH6BkgEFQAAt5IHQ9vmDjIAAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
checkBoxPressedIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/checkBoxPressed.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAAAwAAAAMAQMAAABsu86kAAAABlBMVEUAAAAAAAClZ7nPAAAA
AnRSTlMA/1uRIrUAAAAiSURBVHheY/j/gaFBnqFBgmH+DIYJMxFo/kyGBkmQ+P8fAPGKDWJR
SBPAAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:32'!
abstractIcon 
	^ icons
			at: #'abstractIcon'
			ifAbsentPut:[ self abstractIconContents ].! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
fullscreenIconContents
	"Private - Method generated with the content of the file /home/dgd/fullScreen.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABwAAAAcCAYAAAByDd+UAAAABHNCSVQICAgIfAhkiAAAABF0
RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAAHT0lEQVR4nL2WW2xc1RWGv7X3OWcutmfGYzuO
7TjBSYAAgaSQEGhRQVwU2pAgFQFC6iuKhBAvCEWVKtWPBCpVquhTq6pUBURFaVrUBmQuBRWh
FJELhIRQGi42SUx8HY9n5lz2Xn3whAZIipCq/tJ6Odr7/Gv9/1rrHPg/QwAeffTRjjiOK2EY
DotIRURKqpoXEauqAnhVTY0xdWDBWnu6VqtNDwwMzO3cubPxjQl37959jYgMqepaEbFAoKoB
gIio9x5jjPPeZyLi2nc90BSRaRE5HgTBJ0NDQ5/ddddd7jxcS4SqKo888siNwJWLycJlx04e
Gwisdb1dy+qD5aHaOe54EUmApqo2gWb7WR2Ycs69H4bh+IMPPjgtIvoVwtHR0c5CoXCtiNzw
i5d+dm881Ojr7a8yO1UjPpGkF5cueXfHxjve+i9Je2BBROZVNRYRFZF559wnxpj3G43Gx6Oj
o9mZw0GxWOxUVUSkM+5Y7Or+XoH+rirbe2/jqZeeCGtvLHSpqpwr2zYMUFbVsoi0VLWmqlZE
Kt77Ffl8/pOHH374aKvVmhgdHfV269atPara49VveKPx2tW5FYEsmjrHakeodvTw8ZsnuoYr
K5NKoWKNMREQyBL8OcgDoAOoiogXESMi/UC/MaZz27ZtdeO9j1Q1yLIs1EwlmcmIT6YkpzOG
+4e5+d7vhs8cfHLTqfmTZVUtAmWgV1UHgG4RyZ2n6hFVXd2uvt8YU0qSZMCISM5amw+D0LmT
mrp5pX4gxtU9B47up2ugg0t/uDb688Fn13/B/CUUgV6gH+g821fv/SKwQlU3GGM6RMSGYRgY
wKhqBPCt5VcfKr7ZM71Fr383edU2XcPzyqEXef/Nf1LMdcTn6xoRCUSkDPS1ZeWM5+1ZVmOM
zbIsDEQkExHnnOOWy249JiKzgLtk4NLTT4z9dlO9Wu8sz/fMb99y+wdf0zyISNSWcPosUmlX
bAETiEjmvY/PyOS9t8YY19PVl+y84f53Do0fWL6sUk7+Mbb34oWFhTBpNUwaxzZzqc3li3Gx
q9LsKlUa1d7l9eGRi2a7q1WstYalcfFtBTMRSVQ1DpxzznufGGMUEGst7S3TlQ/zZsvqa6de
fO6pVdtv/0Hf+g1XUSqXKZe76SpXSOJW/sg7B8uH336LI+8c5KU//cZJWJwdXHXhB+vWX3m8
r6/PAUZEUlVNRaQVGGMyVfUiknrvRUQCIC8ickaq2uxMfscd97BqZO1XZBwcWsH1N99ClrZo
LNbs88/t6X3290/27vndYxuGRi45ccWm644PDg6qiGTW2iVC5xze+xRw3vvIGCNnv7RWm8n3
9Q9w9MPj7NULmM1gLhGqkbImDyM5ZV2UYa1h623f56Zbb+bQ/v2Fpx5/fM3zz/xqsG/4osb6
jVuOr1y5shUkSVJvF7MgIqW21h1nBjtLU2NEomKxgw/mG7yRNVAEr8J4Aw4AXkNypsymYsh1
+ZTVEVy+cSOfjo9z9z33FH6068cXnTq1qjIyMtIyu3btqgGZiEyqqvPeN9udBUCzUbd9y5YD
ME9AybQoSYuyaVK2TUrSomSaRMQcXLT8fHoZT8/3YIzBWkso4FwWJEkSdnd3N4yIaBAEc977
yXanTra7C4B8scOlSQJAqhkV02J1IeXb3cKNvYZ1nY6KbS0lYmLKJuZwK2QqCwijCO8VkCRN
08WdO3emAYCqzojIbHv5ApwClouIhmHkp6dOKyCha7CuXGKgaFCWPnvdXYLxGXNJhkeWQoXx
1BJFEUmWoiIzaZqehqWdRxRFp9pj8VG7sEkR+UhVW6qKima1+TlK1jFUAPExxrcQHyMas6YI
ZRt/HhUbY8URBJZms4W10Wwcx5OfEz7wwAOxc+6kiBwTkRpLq2FeVY+r6qedpe7Fo4cP0dmc
J/ANAhpYbbajQZdNWNMB3bZJ5Yy3JiOwAfX6AibM1SYmJv5DCLBr164jwIfe+1eNMVPttZQB
05Vq3/hf9jzNhYOriHydnG8Q0SDSBpFvEmqTauC4oGDpC5d8rlrFinDi0xNokD8+MTEx9QVC
EdGHHnrosLX2befcq8BhVa0DfsXKtSde+Oseunv6qMYtCtKgSJMiDQrSIM8ieRbpNC0GcsoF
BaFkhcZinddff33OefMeEAPYL2+OsbGxuR07dow75+aBmjGmWe1bPntg32vrioV85zVbvkNO
Hfg6VhIio0TiyIknMo7IOMoIeQIO79/P3hdePjgxOffrNE0nz0kIsHfvXjc2NvbZnXfe+a8s
y8aByeUrVr33xC8f2/jZqROl9euvoJwrk8cQkpLDEZKRQ8mrUJQ8Rw6+zcz0FH/7+74/TM0u
7gUWOXvAvw6qKvfdd19l38t/vDdNWvevv+Ly4as2b+bKzZsZWbuWIAi+cH7fKy+ze/dPpw4c
PXl3Bq8A+o0Iv4w1VYadsk1FthuRS8uVSndPb09XoVg0C7V5NzMzMz0xWfvJbIMngXP9bv5v
0N9PB+exCuDf3d6HA+fU4WgAAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:43'!
classVarsPressedIcon 
	^ icons
			at: #'classVarsPressedIcon'
			ifAbsentPut:[ self classVarsPressedIconContents ].! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousHelp
^ self icons
		at: #glamorousHelp ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 167772160 117440512 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777216 3489660928 3003121664 4278190080 3003121664 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 452984832 4278190080 352321536 1778384896 4278190080 536870912 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 452984832 4278190080 1442840576 1442840576 4278190080 637534208 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 285212672 16777215 3741319168 4278190080 33554432 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 637534208 4278190080 167772160 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2348810240 452984832 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 872415232 16777216 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 285212672 4278190080 3489660928 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 285212672 4278190080 3489660928 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 33554432 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
checkBoxOnIcon
	"Private - Generated method"
	^ icons
			at: #'checkBoxOn'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self checkBoxOnIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousDown
^ self icons
		at: #glamorousDown ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 956301312 1073741824 1073741824 4278190080 4278190080 1073741824 1073741824 956301312 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1828716544 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 1828716544 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2852126720 4278190080 4278190080 4278190080 4278190080 2852126720 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 218103808 3640655872 4278190080 4278190080 3640655872 218103808 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 771751936 4127195136 4127195136 771751936 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1627389952 1627389952 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousGo
^ self icons
		at: #glamorousGo ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4261412864 4278190080 0 0 0 0 0 0 0 0 0 4278190080 4261412864 0 0 0 4278190080 0 0 0 0 0 0 0 0 0 0 0 4278190080 0 0 0 4278190080 0 0 0 1258291200 251658240 0 0 0 0 0 0 4278190080 0 0 0 4278190080 0 0 0 4278190080 4009754624 1459617792 0 0 0 0 0 4278190080 0 0 0 4278190080 0 0 0 4278190080 4278190080 4076863488 3254779904 536870912 0 0 0 4278190080 0 0 0 4278190080 0 0 0 4278190080 4278190080 4278190080 4177526784 3992977408 0 0 0 4278190080 0 0 0 4278190080 0 0 0 4278190080 4278190080 4076863488 3238002688 536870912 0 0 0 4278190080 0 0 0 4278190080 0 0 0 4278190080 4009754624 1442840576 0 0 0 0 0 4278190080 0 0 0 4278190080 0 0 0 1258291200 251658240 0 0 0 0 0 0 4278190080 0 0 0 4278190080 0 0 0 0 0 0 0 0 0 0 0 4278190080 0 0 0 4261412864 4278190080 0 0 0 0 0 0 0 0 0 4278190080 4261412864 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: (0@0))]! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:31'!
smallSystemBrowserIcon
	"Private - Generated method"
	^icons
			at: #smallSystemBrowserIcon
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallSystemBrowserIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:23'!
monticelloPackageIconContents
    ^(Form
	extent: 16@16
	depth: 32
	fromArray: #(16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 722736128 2235383040 3106942976 3394787328 301989888 16777215 16777215 100663296 2707053056 2689683712 3240305408 16777215 16777215 16777215 1985303808 3527491840 3207869440 3040228864 3577033984 4241082624 1496988160 16777215 673983488 3692698112 4156604416 3157866752 3023649024 16777215 16777215 16777215 1817071104 2200973312 16777215 2725146112 2859627008 3583086848 2675011840 959656704 3609206784 2486646528 4021597184 3257280000 924983808 16777215 16777215 16777215 16777215 33554432 16777215 3381233920 2169326848 2792320768 3464330496 3642827008 268435456 2943776256 3279912704 3408011776 16777215 16777215 16777215 16777215 16777215 16777215 706682624 3967646976 606019328 2186104064 4105285888 857809152 50331648 3667038720 2487304448 3207408896 16777215 16777215 16777215 16777215 16777215 16777215 2438749184 3094836992 16777215 3375049472 4088442880 503316480 975644416 4171539456 2350784000 2285780480 16777215 16777215 16777215 16777215 16777215 150994944 3715396608 1564491776 1598309376 3324191488 4189171968 1278094848 1984251136 3750793216 2721790720 1092558592 16777215 16777215 16777215 16777215 16777215 2270121728 3278136320 16777216 3593219072 1124599808 4120549888 637928960 2355060480 3246424064 3240634368 167772160 16777215 16777216 16777215 16777215 959919872 3747569408 858927616 1093611264 3023714816 1782529792 3598942976 33554432 2590862592 2910353408 3357614336 16777215 16777215 2065373952 16777215 1278818560 3612693760 1682787584 16777215 2605073920 1664694528 3026609664 2371245568 16777215 2506647552 2472895744 3324059904 33554432 16777215 2721264384 3694211328 3444132096 1296056320 16777215 16777215 1950499328 3693553408 3376562688 100663296 83886080 3259780096 3727634176 3927381760 3726120960 689576448 16777215 67108864 16777215 16777215 16777215 16777215 16777215 637534208 33554432 16777215 639047424 3056282368 67108864 538252544 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: 0@0)! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloDragIcon
	"Private - Generated method"
	^ icons
			at: #'haloDrag'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self haloDragIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloFontStyleIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/haloFontStyle.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQAQMAAAAlPW0iAAAABlBMVEX///8AAABVwtN+AAAA
IElEQVR4XmNABvIVDJwODBwODFwODHwFIJIDjGQc4EoASL8DJ688wKQAAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamourousNextFailure
^ self icons
		at: #glamourousNextFailure ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1224736768 1392508928 1392508928 1392508928 1023410176 33554432 16777215 16777215 16777215 318767104 1677721600 117440512 16777215 16777215 16777215 16777215 3808428032 3640655872 3254779904 3254779904 3707764736 3841982464 1224736768 16777215 251658240 4160749568 2936012800 150994944 16777215 16777215 16777215 16777215 3808428032 1593835520 16777215 16777215 16777215 2852126720 3204448256 16777215 872415232 4110417920 16777215 16777215 16777215 16777215 16777215 16777215 3808428032 1593835520 16777215 16777215 16777215 1375731712 4110417920 536870912 3506438144 4227858432 3305111552 201326592 16777215 16777215 16777215 16777215 3808428032 1627389952 50331648 50331648 738197504 3170893824 2835349504 83886080 1342177280 3992977408 553648128 33554432 16777215 16777215 16777215 16777215 3808428032 4278190080 4278190080 4278190080 4244635648 3422552064 687865856 16777215 889192448 3942645760 16777215 16777215 16777215 16777215 16777215 16777215 3808428032 1744830464 234881024 234881024 100663296 16777215 16777215 16777215 889192448 3942645760 16777215 16777215 16777215 16777215 16777215 16777215 3808428032 1593835520 16777215 16777215 16777215 16777215 16777215 16777215 889192448 3942645760 16777215 16777215 16777215 16777215 16777215 16777215 3808428032 1593835520 16777215 16777215 16777215 16777215 16777215 16777215 889192448 3942645760 16777215 16777215 16777215 16777215 16777215 16777215 3808428032 1593835520 16777215 16777215 16777215 16777215 16777215 16777215 889192448 3942645760 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
homeIcon
	"Private - Generated method"
	^ icons
			at: #'home'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self homeIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Tool-ConfigurationBrowser' stamp: 'tbn 6/19/2013 22:33'!
configIconLoadedContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAM9SURBVDjLdZPrS1NhHMcPREH/
QC96nxURWS+iktC8bEt3skHoi95EbYk5KStqdtPGLKcuczSELnYhK0bzhpfK5nSZed1MPZtz
zpq3pnN5tOY2p+fbsxMEUj3wgx9fvr8Pz+X7UACof9VwPb1juC6l2l6T/N5WJdr9P99fgqPx
yCYyrLLXpczPMg/xrbcQzOukH0P6xJLBl/Gb/wsYaUpdT4Zlw/Vi55RVi5XgNLilCSy6qhGY
rIO79Tw+P4/92v/soNz6JGbjGoCjKVXgaDhi/tpxA4Hvn4m0BHAswr4ejBiOImAvRsitx6JN
B2fdSVge7e/su7+X5gFk+LGjgeZ8jkr4vQPwjbVgrIsYP6hhe3MOrreZ8Nvvwm/NQ9D5CMsT
esx1q8C8kKBHt+dF5LLCXNCNkLcPvgEtvL0qTJnOwlmbhs57MVieswB+BzD7FtwXHcBcBiYr
ER5VoUu7K0yRy2JXg+PAjyEsT9ZgwXoL/v48UgpM1op5DTONgPsBOJsCfmMcZhoOYoG5i87S
nSxlqznMri4RwM8RAmEArxEBRg1/VyZm6sUIj2iA0RKE2kWYa9wHj0kET3Mq2P4SfNLsYCnG
IGRXeIAdWCTbne8kkHcIO7VYaEtDyCwCa4zB3EchZoxJmG6Ix3StEN+7C9FRtI2lyPv+BpAj
gO1CYOoNmqu10JQUoqKiAkUFl2AlRxltFKJIdZHXim/no+aBAibV1gVq8FV8iAt/Iy/nwrK3
BRW66ygrK4PH44HL5UJbWxvuqHOhU8vhGGZ4rb29nfcoTx9YoQYq45pHjZexNGVC67uXuHpF
AcvgIArz5aBpMWQyGbRaLXJzc/meFouRf/4ED7l08VyYIsnaQJIlI+FwKi8cw60CFQ8IjldC
JEyA0WiExWKB2WyGwWCAICEOLcot7ghAqVQG/kSZJGtTzvHopuwzUi4CuHnjApISEyEQCCCR
SPiK9Anxh1bTjh1tjQAyMjLm13yM7WRJUsVjpRp16PWrp6iqqkJ5eTlycnKgUCj4PqLp9Xqf
RqOZp2navgYQFRW1LjY2Njo5OfmLTHoqkC3PXM2Wn+GuZQhK09PTE7KyshZJBaRS6c+IJ+L9
BchY24ysm0a5AAAAAElFTkSuQmCC' ! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:41'!
breakpointIcon 
	^ icons
			at: #'breakpointIcon'
			ifAbsentPut:[ self breakpointIconContents ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'ChristopheDemarey 7/26/2013 13:18'!
topIconContents
	"Private - Method generated"
	"Icon from http://tango.freedesktop.org/Tango_Icon_Library, public domain"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABl0
RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAAIOSURBVDiNpZNPSFRRFId/5/55
vWeCbmzUKCoM3AyYUIIPclGGORTIROsBG2hRkPhqEW3a1kAIQbQI27QKksBNtIsMXAUJBWIY
SY0yTDOMwzjvvfvecTFKZIMWXribw7kfv+/ce2lwUjH2scR+DgMAMf8dwPV08oB1cP56+q7j
mxqmXz/a8IPawFwuXNgzgevpVhBmr56/Zq8HBVTDIoYHL9sgzLqebt0TQITnQ/2prsOHjtFK
+QtWSp/R3tZGfb0DnSBM7wpwPZ09kjg5eq4/rb8WPkKSgiCJD99m0Nd7xupo7xp1PZ1tCnA9
nbS0M5W5eNv5WVmE4QBSKdTjCjb4Fz4V3mJkaKxFKWvK9XTyD8C29/ilO3ZMIdb9IpSS0JZE
OfoB7QgUzTJKvIwLZ1M2id/zENvew6fTnT3dScpXliAkQWpCNSrAF2VYjoTlCCxW3iHR3UHJ
3lMJEo150OCkyh7t7JmauPLQUdJCDIMYBvP5V1govoERNUhJSB33AADMjCAI8GLmWa1YKtxS
JJD5vrrkTDweazgp1HM3XtqVYBVG1KAtAakbiXJP79eNz/aWfgtJZNT7B6G74yaYOUY5yEMI
2tJpQIzP9lwupF3fAQDEbFD1i2Dmxo4ZcdT8y6hmRRMZ+KEPZoYRDOYYUfgfgCg2GDlxEyQA
IQAShMj8K4Cwdu/JeKJZMwms7axtAsq9zOyrhI9uAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:50'!
refreshIcon 
	^ icons
			at: #'refreshIcon'
			ifAbsentPut:[ self refreshIconContents ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:33'!
upIcon 
	^ icons
			at: #'upIcon'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self upIconContents readStream) ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallAuthoringToolsIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QAAAAAAAD5Q7t/AAAA
CXBIWXMAAA3XAAAN1wFCKJt4AAAAB3RJTUUH1QsSDykasZ+olQAAAopJREFUOMutk01sFnUQ
xn/z/+9uqVBepNXa1hDKRwwRSfCDeGiMRIPRS40JCeFgSuKBg8ajB8MFEhLOEj1gTOPBk+HI
QcPBWA4i6s1GAyUaJQYp6Xbb3ffd3Znx8La14NU5zWGeZ+aZeUZ4KOZmmRAJF5BwzN2GAURk
0d0u435uaoY/N9fLQ+B3QD45cmIxCTEDWwKgu3Kbn68eb+ryLwPenZrh03VM2AQ+DVyafP5s
jIlA+ys030NzjSz+wsieI+nE028H4FK/0SaCuVkmQC5OvnCGx/a8IXiD610gwz3BDEJMGNv3
evrkM6cU+LiPWZ9A5OzAtrEwvOs1tPcbbiXmKao9tK2ou8tIDEg6Tufx7TEdHHbg/Q2CEJLp
3c9+IPXqT2hboM0i2uS0TUHbLKNtgWlNU92i7d1ldN/RFOQEQAJgpjuzR4Zp6pvE2EWbb0HA
vcGtwrRgqLOLMr9GXf5OTFKBvoRk7RjiVtF079BKxKzAdQVBcAzVAquXcK8wa3BrAA//ErjS
rRZYWbyKWcHQyDTuPVSXsTanbZa4f/9vOtsjboq7bZw+WU9ispNqdQEJkXLpBt1yHlmziePU
PaXuOW7KwVeMewvyoA+27niJJ/ZfwK2lbXNMu6hWqFaYdtf2oYzuPf+Ac9d3oCGOxyQbY/fh
r6jy66jmVPl1quIGWx89yuj+abZ1DoFAb/UP3EXB+zPOzfI18Opzb92izK8gYQCRDAkZEtK1
PgEwsi2H+OHyXoAvp2Y4vvELc59nP2L14ZHJk4wfeI/BzgFiOgSANgVVPs+d+Y+4d/sLWo/f
vXxKX/zPM33zGW/WKmcGB3c8hZVbsDr2FQ6oklV1Xd50bT88dpor/F/xD94hPsMoW0q7AAAA
AElFTkSuQmCC'! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallRemoteOpenIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAIRSURBVDjLhZM7a5RBFIafme9b
v2TjxkS8IN5SWGgKu8QmhYWFbf6DtT8kVoGAKQRBC8HextrGQhDBxoioSJSV7Gbdze53OTOv
xV6yaogHXoY5HJ55z5kZJ4mjwjl3BTgPuHEKGBc3ga+SIpKOFLBSlmVhZppWnufa2traBJYA
fxxg1cw0GAzU7XbVbrfVbDZlZur3+9re3t4EltwxLaya2WszI8aImVEUBYuLi5OaNE1vef4T
SZLgvSdJErIso9Pp0Gq1DiEfXqy8nZlfXnZumiWePbjZHDkhSZKxK5xzmNkhwMlfv7z2uOac
G81Y4BxXeXlxqh2SJME5N9lPAJhyYpkVPx4SygT8PM418MnC3zP5BzQEVM7HUGBFDUVRtd/T
//6Rxm6TLztzSAFZCUR8fQEUSE6d5tLdpyOA04xCTjVwqDyg6omzaxsspheoz51k+pbGJ39+
vj7twJPOnmPhxj0ggoSIFDv36ac1UPhjuLPXHiGJEEIPCCmVpJAT++9Q6KDQRbZPYXWqQY7H
hmACMQbK1i69vW/Ksuw20EwpkKIRq5/IOkOI7VOfdZC5oSMZqEKxot6oMZN5k/Rm2EIpOQKy
FrL9oUIH4mAE66LwC4UDFHNQDjb5VKQqY9v6e/Wqd6JBbHipBrEBOoNCAZTID1fnA6HoSWUs
DgF5sfFpe30VcQdH49h3LcC9Kol6Mk79BmoIbLI/IOsSAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: '*Versionner-Spec-Browser' stamp: 'TorstenBergmann 2/12/2014 17:42'!
configIconDirty 
	^ icons
			at: #'configIconDirty'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self configIconDirtyContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:29'!
smallPasteIcon
	"Private - Generated method"
	^ icons
			at: #'smallPaste'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallPasteIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:30'!
smallRemoteOpenIcon
	"Private - Generated method"
	^ icons
			at: #'smallRemoteOpen'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallRemoteOpenIconContents readStream) ].! !

!ThemeIcons methodsFor: 'private - utilities' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
createIconMethodsFromFile: aFileNamePrefix directory: directory 
	"Create the methods for the icon.
	aFileNamePrefix is the png file name prefix (without the .png suffix)
	directory is where the png file is"
	| iconContentsSourceTemplate iconSourceTemplate png base64 contentsSelector selector |
	iconContentsSourceTemplate := '{1}IconContents
	"Private - Method generated with the content of the file {2}"
	^ ''{3}'''.
	iconSourceTemplate := '{1}
	"Private - Generated method"
	^icons 
			at: #{1}
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self {1}Contents readStream) ].'.
	png :=( directory asFileReference / aFileNamePrefix , 'png') fullName.
	[base64 := self base64ContentsOfFileNamed: png ]
		on: Error
		do: [base64 := nil].
	base64
		ifNotNil: [contentsSelector := (aFileNamePrefix , 'IconContents') asSymbol.
			((self respondsTo: contentsSelector)
					and: [(self perform: contentsSelector)
							= base64])
				ifFalse: [| contentsSource |
					contentsSource := iconContentsSourceTemplate format: {aFileNamePrefix. png. base64}.
					self class compile: contentsSource classified: '*Graphics-Resources-Theme-Icons'].
			selector := (aFileNamePrefix , 'Icon') asSymbol.
			(self respondsTo: selector)
				ifFalse: [| source |
					source := iconSourceTemplate format: {selector}.
					self class compile: source classified: 'private - icons']]! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:32'!
smallWindowIcon
	"Private - Generated method"
	^ icons
			at: #'smallWindow'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallWindowIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamourousNextParser
^ self icons
		at: #glamourousNextParser ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1224736768 1392508928 1392508928 1392508928 1023410176 33554432 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3808428032 3640655872 3254779904 3254779904 3707764736 3841982464 1224736768 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3808428032 1593835520 16777215 16777215 16777215 2852126720 3204448256 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3808428032 1593835520 16777215 16777215 16777215 1375731712 4110417920 50331648 1929379840 1962934272 2667577344 3841982464 3271557120 771751936 16777215 16777215 3808428032 1627389952 50331648 50331648 738197504 3170893824 2835349504 16777215 2499805184 4211081216 1593835520 469762048 2365587456 3791650816 150994944 16777215 3808428032 4278190080 4278190080 4278190080 4244635648 3422552064 687865856 16777215 2499805184 3087007744 16777215 16777215 33554432 4043309056 1157627904 16777215 3808428032 1744830464 234881024 234881024 100663296 16777215 16777215 16777215 2499805184 2432696320 16777215 16777215 16777215 3506438144 1560281088 16777215 3808428032 1593835520 16777215 16777215 16777215 16777215 16777215 16777215 2499805184 2701131776 16777215 16777215 167772160 4177526784 1023410176 16777215 3808428032 1593835520 16777215 16777215 16777215 16777215 16777215 16777215 2499805184 3909091328 436207616 16777216 1879048192 3942645760 234881024 16777215 3808428032 1593835520 16777215 16777215 16777215 16777215 16777215 16777215 2499805184 3238002688 3825205248 3758096384 3774873600 1258291200 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2499805184 2382364672 67108864 654311424 16777216 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2499805184 2382364672 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1778384896 1694498816 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
homeIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QAAAAAAAD5Q7t/AAAA
CXBIWXMAAA3XAAAN1wFCKJt4AAAAB3RJTUUH1QoOFCUTUyrSOwAAAetJREFUOMuVk79rU1EU
gL97+95L00DyJKBVh2RRexNoVawRXByMQhOnh9RKJ5GioxhcOrRuwan+GOrUJYv1x2AT8A/w
PxB5W1zEWtvwYlGJIXnXIfbZl1AhZ7pczvfdcw7nwgHhKVWsgK6A9pR6yDCxB3tKaU+pPUlx
aHixOKPLN2/8VyL64ZrrbhSUYv3cWbYnTnHk8DgnvCZTa2vUXJeCUtcOuW51QLAfflOcYff4
MZTKMhaN0mq1GNv8SrZcHpCIfrh6+xadZJJ0Kk0qlQJAa2i32+zW65wslUISsR9+96BExzDJ
5S5g23bQmtYaAN/3+bm1RXJuLpCICuiCUrx/VMZrNjk/nSMejyOECAl83w/OhhCM5vPUXBcD
uAOsTp0+w/3SPTaqbwPwycozVh4/RYsRdKeFMEbR3d8sLy3R7qXMynl4vjCZIRFPAKDUBJmM
IpvN9F4UkpH0ld7EU3mQFlprFiYzzMO67O/TsixM08QwjOD+S+MHAB/qO3S7fpALMCCQUiKl
xJKfAehg8fFTA4Bv3i86IhJaJGNgs/4Oz+coAJcuTnM1GkPqcS5Lk+1NQhUY/RX8m37vpe/e
DqLZOHD1A0EkEsG2bRKJBAKJEBCLxXAcZwCyLCv8F67POq8Ah+Fi9eWL13f/AFb41aOFu4Aa
AAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:45'!
emptyPackageIcon 
	^ icons
			at: #'emptyPackageIcon'
			ifAbsentPut:[ self emptyPackageIconContents ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallAuthoringToolsIcon
	"Private - Generated method"
	^ icons
			at: #'smallAuthoringTools'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallAuthoringToolsIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallSizeNames
	"Answer the names of the small icons"
	
	^#('smallError' 'smallInfo' 'smallLock' 'smallQuestion' 'smallWarning' 'smallPushpin'
		'smallBold' 'smallItalic' 'smallUnderline' 'smallStrikeOut' 'smallBarcode'
		'smallHierarchyBrowser' 'smallSystemBrowser' 'smallScreenshot')! !

!ThemeIcons methodsFor: '*Tool-ConfigurationBrowser' stamp: 'tbn 6/19/2013 22:30'!
configIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAALnSURBVDjLfZNLaFx1HIW/e2fu
zJ00w0ymkpQpiUKfMT7SblzU4kayELEptRChUEFEqKALUaRUV2YhlCLYjYq4FBeuiqZgC6FI
QzBpEGpDkzHNs5PMTJtmHnfu6//7uSh2IYNnffg23zmWqtIpd395YwiRL1Q0qyIfD56cmOvU
s/4LWJg40auiH6jI+7v3ncybdo2Hy9ebKvqNGrn03Nj1+x0Bi1dHHVV9W0U+ye4d2d83+Ca2
GJrlGZx0gkppkkfrsysqclFFvh8++3v7CWDh6ugIohfSPcPH+w6fwu05ABoSby9yb3Kc/meP
YXc9TdCqslWapVGdn1Zjxo++O33Fujtx4gdEzj61f8xyC8/jN2rsVOcxYZOoVSZtBewZOAT+
NonuAWw3S728wFZpFm975cekGjlz8NXLVtSo0SxPImGdtFfFq5epr21wdOxrnMwuaC2jrRJW
fYHdxRfIFeDWr0unkyrSUqxcyk2TLQzQrt6hqydPvidDBg/8VTAp8DegvYa3OU1z+SbuM6dQ
I62kioAAVgondwAnncWvzCDNCk4CLO9vsJVw8xqN+iPiTB5SaTSKURGSaoTHHgxoAMlduL1H
iFMZXP8BsvkbO1GD2O3GpLOIF0KsSBijxmCrMY+FqgGJQDzQgGT3XrJ7DuI5EKZd4iDG+CHG
84m8AIki1Ai2imRsx4FEBtQHCUB8MG1wi8QKGhjEC4mbAVHTx8kNYSuoiGurkRtLN76ivb0K
6SIkusCEoBEgaCQYPyT2QhKpAXKHTiMmQ2lmChWZTrw32v9TsLOyVlu8Nhi2G4Vs32HsTC9I
A2KPRuU2Erp097+O5RRYvz3H1r3JldivfY7IR0+mfOu7l3pV5EM1cq744mi+OPwaRD71tSk0
Vsp3/uLB6s2minyrIpeOf7a00fFMf1w+MqRGzqvIW/teecdqV5a5P/8ncXv9ZxUdf/lCae5/
3/hvpi4OjajIp4ikVOTLY+cXr3Tq/QPcssKNXib9yAAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'ChristopheDemarey 7/26/2013 12:58'!
downIcon 
	^ icons
			at: #'downIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self downIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'NicolaiHess 11/18/2014 11:52'!
smallBackIconGray
	^ icons
			at: #'smallBackGray'
			ifAbsentPut:[ self smallBackIcon asGrayScaleWithAlpha ].! !

!ThemeIcons methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 7/11/2013 10:56'!
databaseIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAQAAAC1+jfqAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAEYSURBVBgZBcHPio5hGAfg6/2+
R980k6wmJgsJ5U/ZOAqbSc2GnXOwUg7BESgLUeIQ1GSjLFnMwsKGGg1qxJRmPM97/1zXFAAA
AEADdlfZzr26miup2svnelq7d2aYgt3rebl585wN6+K3I1/9fJe7O/uIePP2SypJkiRJ0vMh
r55FLCA3zgIAOK9uQ4MS361ZOSX+OrTvkgINSjS/HIvhjxNNFGgQsbSmabohKDNoUGLohsls
6BaiQIMSs2FYmnXdUsygQYmumy3Nhi6igwalDEOJEjPKP7CA2aFNK8Bkyy3fdNCg7r9/fW3j
gpVJbDmy5+PB2IYp4MXFelQ7izPrhkPHB+P5/PjhD5gCgCenx+VR/dODEwD+A3T7nqbxwf1H
AAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousFolder
^ self icons
		at: #glamorousFolder ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 0 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 0 4278190080 0 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 0 4278190080 0 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 0 4278190080 0 0 0 4143972352 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 1208880654 0 4278190080 0 0 0 2600929031 4181934915 4287795858 4287795858 4287795858 4287795858 4287795858 4287795858 4287795858 4286479998 4093903876 201326592 4278190080 0 0 0 520093696 4144301317 4287203721 4287795858 4287795858 4287795858 4287795858 4287795858 4287795858 4287795858 4096732975 1996620290 4278190080 0 0 0 0 2869364487 4283124555 4287795858 4287795858 4287795858 4287795858 4287795858 4287795858 4287795858 4286085240 4026860805 4278190080 0 0 0 0 704643072 4278650631 4287466893 4287795858 4287795858 4287795858 4287795858 4287795858 4287795858 4287795858 4079363622 4278190080 0 0 0 0 0 4262005001 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4261610243 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: (0@0))]! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:27'!
smallItalicIcon
	"Private - Generated method"
	^icons
			at: #smallItalicIcon
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallItalicIconContents readStream) ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
calendarIconContents

	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAHOSURBVDjLpZOxa1RBEIe/d/e8
FKeFEA2IGBWCICZYBSESBCFglUDSCJZaRBBbK1HQ0s4/QQlCgoKdoBA9sVBshCBETCNRiUUg
5PDt7MxY7HuXdxgEycKwyzJ88/vN7Gbuzl5WDvDozeZtd66p21EzQw2iGaqGmhPVaqFodNTs
/f0rI+M5gLnfmB0/MPg/le88+TLWU6BmgwDtpevgDhrBFETSORQgAQoBEbZvvUJEB2qAqg8O
Rw6BxRQeS0gBUkAMsPIdAIm60wNVKwEZrG+AW1JilpRotQNDQwCEOiCWgIXhe1w+f/if3hff
rXMhxH4Fooa5kzdT0rNPi3TWlrl6bp7PP1d4ufqCiyNTzIzOUYiz1RWCJECjsuBA3swAmBmd
oxu6APza3uDB9EM6a8sAFFEJYsRoOwBRww3yxt+Su6FLq9nqAQuxst11QDTcnX2lhc7XVO3j
tw8cOzjMzafzTJ26RJUL0B7Ia020dNlsJAsTJyaZODlZziVj+swsWZb1AarJJUCMeCnn8esf
aWruiIKoEtQIkry3mlUx+qfg7owd389prd6+9/7CbsvMrfaQ/O3dhdWzQa0tUZGoaDREjahx
V8Dm1u/nANlev/MfAjw0JrMu09AAAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:52'!
traitIcon 
	^ icons
			at: #'traitIcon'
			ifAbsentPut:[ self traitIconContents ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
rotateIcon
	"Private - Generated method"
	^ icons
			at: #'rotate'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self rotateIconContents readStream) ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallWarningIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAA
CXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1gIQDictt+6SdwAAAehJREFUOMuVk8FKG2EU
hb87mc40iTODEJlK7UZDxCCGQUqaMASCSGODdBe6ECJddOcwG/EJXBt0ZcBCwEVJVgWtr1AI
PoBQXAQKhRZc1EBJMX831hLItPbAvYvL4Ttnc4UIhfDIgLcAA3jdgC/jfHoUwISjeXgOcAFH
QHWcT4tI91KwWlhY0J6kUloKVkPw7g0wYS8NemJ3l0yzSRp0E/buBQihOAXFbLksej6Pns+T
LZdlCoohFPmXdqB7AsNep6M8z1Oe56lep6NOYLgD3b82CGHFhaWM74vh+ziOg+M4GL5PxvfF
haUQViIBJuxnwUgEAaJpWJaFZVmIppEIArJgmLA/FhDC+jSk5woFjFIJEcG2bWzbRkQwSiXm
CgWmIR3C+gggBDGgsXibruk6IvKngQiarpMIAhbBMKARgsDtCuHVLLReLC8bk2dnEIuhlKLf
7wOQTCYREbi54WptjQ/n54NLqDfgnYQQewxXT8GaPz7mYbWKUgqlFLVaDYB2u42IICL8OD3l
YmODLnz/DJOawGYczJlcjnilcmcUEVzXxXXdkVu8UmEmlyMOpsCmbMPXl5CaPThgol6/S/89
wAhARLhutbjc2uI9fJNDGD4DecD/6SfwEZT+CQ4H8GYi4i+idA3DHjR/AZfefQgctOETAAAA
AElFTkSuQmCC'! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:22'!
emptyPackageIconContents

	^ (Form
		extent: 14@16
		depth: 32
		fromArray:  #(16777215 16777215 16777215 16777215 16777215 33554432 61516458 61516458 16777216 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777216 87241523 1012027986 3211488107 2927262330 613125003 61516458 16777216 16777215 16777215 16777215 16777215 16777216 50331648 541344836 2539346779 4201672816 3530321004 3782637174 4135353468 2407102841 379099288 93952409 16777215 16777215 16777216 252710928 2085704017 3966002276 3344982112 1582519123 109084800 290147147 2070637419 3783097725 3968502410 2323677312 243302528 16777215 67108864 3277478490 4284900966 3797769565 1330071367 138428480 55924053 55924053 208300650 1919576682 4170421139 4272795053 3348008590 164021958 16777215 4134366573 3848824679 3781979244 3681644913 2992857955 1280463442 1365139038 3128325750 3868036493 3851916950 3970081185 3937382319 234881023 16777215 4150749031 3966528620 4268715887 3698224750 4017452405 4252728187 4252991359 3951396229 3599140229 4287203721 4137722016 3903498922 218103807 16777215 4099562074 1684300900 1802004584 3899617135 4184829807 3648550775 3598745471 4202330746 3598548349 1754567828 2492896918 3700790677 150994943 16777215 4047980359 1599625304 16777215 158429553 3261885548 4151604340 4286019190 2557768820 264027324 117440511 2055570821 3531768450 83886079 16777215 4197725236 1750028111 16777215 16777215 2741265508 4167921005 4285756018 1466986608 33554431 50331647 2172419196 3715857275 83886079 16777215 4212989213 3627431478 826820680 16777215 2673235542 3982516063 3698356079 1248422249 16777215 510553710 3178460019 3698816887 67108863 16777215 2586586156 4195751446 4247004196 3091218496 3209185352 4166078544 4235095405 1432774246 2003331176 4134234987 3849351280 1601993852 33554431 16777215 16777215 473183284 3274123047 4263123482 4280953386 4215094589 4285427053 4167394661 3831981927 2188077931 244486802 33554431 16777215 16777215 16777215 16777215 16777215 1093874483 3760267553 4213581093 4268649837 2758108517 492921185 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1832598331 1014528120 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
		offset: 0@0)! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousSave
^ self icons
		at: #glamorousSave ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 620756992 3841982464 4278190080 4278190080 4278190080 4278190080 4278190080 3657433088 436207616 0 0 0 0 0 0 0 0 620756992 3841982464 4278190080 4278190080 4278190080 3657433088 436207616 0 0 0 0 0 0 0 0 0 0 620756992 3841982464 4278190080 3657433088 436207616 0 0 0 0 0 0 0 0 0 0 0 0 620756992 3204448256 436207616 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 0 0 0 0 4278190080 0 0 0 0 0 0 0 0 0 0 4278190080 0 4144103938 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4244635648 268435456 0 4278190080 0 2265187332 4049033047 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4253188738 3054769172 0 4278190080 0 218103808 4026992391 4291940817 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294375158 4145222419 905969664 4278190080 0 0 1778384896 4013504825 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4288519581 3507622418 4278190080 0 0 67108864 3792242953 4290361785 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294835709 4129563684 4278190080 0 0 0 671088640 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4261741829)
	offset: (0@0))]! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'AndreiChis 2/1/2015 14:23'!
glamorousSaveToUrl
 ^ self icons
		at: #glamorousSaveToUrl ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 100663296 1577058304 1358954496 201326592 2566914048 3841982464 3791650816 2264924160 117440512 0 0 0 0 0 0 0 2667577344 4278190080 4278190080 3992977408 4278190080 4278190080 4278190080 4278190080 2566914048 0 0 0 0 0 570425344 1610612736 3942645760 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4227858432 184549376 0 0 0 1308622848 4160749568 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 3036676096 436207616 0 0 3623878656 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 3170893824 0 0 4009754624 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4076863488 0 0 2617245696 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 3070230528 0 0 167772160 2365587456 3573547008 3758096384 3758096384 3758096384 3758096384 3758096384 3758096384 3758096384 3758096384 3690987520 2768240640 402653184 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2147483648 2147483648 0 0 0 0 0 0 0 0 0 0 0 0 0 2147483648 4278190080 4278190080 2147483648 0 0 0 0 0 0 0 0 0 0 0 2147483648 4278190080 4278190080 4278190080 4278190080 2147483648 0 0 0 0 0 0 0 0 0 2147483648 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 2147483648 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: (0@0))]! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:33'!
upArrowIcon
	"Private - Generated method"
	^icons
			at: #upArrowIcon
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self upArrowIconContents readStream) ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallInspectItIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAA
CXBIWXMAAA3XAAAN1wFCKJt4AAAAB3RJTUUH1QYdERIIyN9seAAAAzRJREFUOMulk1toVHcQ
xmf+57LnnM3e4m42qRs0iBqLlzYbW7NUraQ+GHxQNBQUopJCqautDzVNNVRaNETBEqRUaGsV
pIUmL32qtMYQL0isaECjwVvEZJPN3rebze6ePTnz9yUbWvGtHwwzzMOPbxg+hFfU1n74N72Q
34qIKnFCzvmMzWa/2Hm86xN4jcTS8EX74Q25fP6v5p3NssNRjkXD5CYHkAW0TmdSH2cy03vt
dltj5/Gum/8GIADAsa871qbT6VvB/Z9h393J4khSLCiapprEpVw2m/G/AUrj2z65+8xpqvBU
1HccPTb0HweJRHLg0wOH8PfbUWNKt0u7NvmyCxdo/5hErqHn6cSNkdii6b/DxYPBQ3L3mW+v
AYCtBBA6vjrS5q+r3zyaFM3RGU36qHFJpMqloiIziQhk1SKmcvrsw+dJqrFQzvC6FFy9ZlX2
6sC1WwAALJGIn/TX+aXBF4YcWO42BAZu3TCdeX1WM4kE0zTdkZTuQcDwcATkd9a+q0Sjke75
EyRJ4gQMrXYHKLJ4L5M3mGJyXRSwSMSX9twInTSIyoCDK22In6uqBpIk8XkAEc1aJFGSGOdP
JqanGNqYqwxMvWiGx2K5kE4UFzgSMK7MGoap67pARMY8wOv13pmYmKh3yDI+Ho+Xj8dzNzmD
KCKLIHG3ADADyK3JWHR97aJyTCYTemVl1WAJwERR/LF/4Ep4q98rqFY1YHKyAUcGnIscyEEI
cqFQqHB5PO9vecvDfr5wLpNOp/rnv3Clr39oxZu1bVaLqK9cVqONxov1sXDIo6rqM+JUGxl/
sd3ldu/esUqEwet/clXRMBaLNdQsWXzh4YORrAAAsGPn9svDD+7v57nU1K6mgN0AsXKmyD/g
KKypW1pRtc3vhnNnT1NgXYBNTk1KRKbEGGtpaFjXhyUrXadOrB4bG//D4/YUnM5y2V/nd1ZX
V9t6ensePXn6SNXzxjdOl/2npi1NcG/4Pmx4byP98utFhq+Go+vUiX0A0BwKhTYCgObz+S4B
QG9729HzwWCwExn/ck/LXrBay+D7s98BviZgbK6wlJW5zgEAWltbW1TN8sPc7kP4v3oJO6lm
k2hPogUAAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
normalSizeNames
	"Answer the names of the normal icons"
	
	^#('error' 'info' 'lock' 'question' 'warning' 'upArrow' 'downArrow' 'backspaceArrow')! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
recentMessagesIcon
	"Private - Generated method"
	^ icons
			at: #'recentMessagesIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self recentMessagesIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:19'!
arrowUpIconContents
	^ Form
		extent: 12@12
		depth: 32
		fromArray:  #(16777215 16777215 16777215 16777215 16777215 2315532032 2315532032 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1275276288 3959984384 3959984384 1275276288 16777215 16777215 16777215 16777215 16777215 16777215 16777215 369104640 3573967104 4278962688 4278962688 3573967104 369104640 16777215 16777215 16777215 16777215 16777215 16777216 3087288576 4278962176 4278962688 4278962688 4278962176 3087288576 16777216 16777215 16777215 16777215 16777215 1610818304 3540342528 3590744320 4278961664 4278961664 3590744064 3540342528 1610818304 16777215 16777215 16777215 16777215 16777215 16777215 1711483648 4278893824 4278893824 1711483648 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1157900544 3154467840 3154467840 1157900544 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
		offset: 0@0! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:19'!
arrowUpAndDownIconContents
	^ Form
		extent: 12@12
		depth: 32
		fromArray:  #(16777215 16777215 16777215 16777215 16777215 2315532032 2315532032 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1308830464 3959984128 3959984128 1308830464 16777215 16777215 16777215 16777215 16777215 16777215 16777215 402658560 3590744064 4278962688 4278962688 3590744064 402658560 16777215 16777215 16777215 16777215 16777215 33554432 3120842496 4278962176 4278962688 4278962688 4278962176 3120842496 33554432 16777215 16777215 16777215 16777215 1644372480 3540342528 3590744064 4278961664 4278961664 3590744064 3540342528 1644372480 16777215 16777215 16777215 16777215 16777215 16777215 1711483648 4278893824 4278893824 1711483648 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1711483648 4278893824 4278893824 1711483648 16777215 16777215 16777215 16777215 16777215 16777215 1644372480 3540342528 3590744064 4278961664 4278961664 3590744064 3540342528 1644372480 16777215 16777215 16777215 16777215 33554432 3120842496 4278962176 4278962688 4278962688 4278962176 3120842496 33554432 16777215 16777215 16777215 16777215 16777215 402658560 3590744064 4278962688 4278962688 3590744064 402658560 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1308830464 3959984128 3959984128 1308830464 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2315532032 2315532032 16777215 16777215 16777215 16777215 16777215)
		offset: 0@0! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallPublishIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAGdSURBVDjLlZNLSwJhFIa1Rb8i
IWhRQUlluuoftDEtC5TKSgINily1CmoT0kJBqwlSaBGBLVxItGgZQQQVFe3bKN7wOjqO2tuc
wRGvqAMPMzDf+8w5ZzgyADLhGhJQCWi6MCwwQBkJWVWg4jguVSqVKuVyGe0Q3sPtdruaJZJA
Q+FcLgeWZWuk02kkk0lEIhFREg6H4fF4GiR0yUlABwqFAorFongnstksUqkUotGoKMjn86CP
MAwjSloEFJYgAQUymQxisVhLS9WZyBsEQhu1A/RMfUutxONxsZJQKNRZ0Ey9hCqheSQSid4F
9RJqh2ZCor4EBM/z4lxIQvQtoCp2HtexfW+CObAM062uu4BCElSBJWjEzc8Vrr8Y6L3zvQso
TKz6F+H7PAPz7oLRp8eodmSjp7/geDqG2b8Me9CK8zcnXK8O7AWsmDtUF9UHUw/1gr+2O8Bz
sPm3YLvbhPPlBI7nI6xc6jC9P/Gr3B0flHZhVpgyKwQ6LpPFtwaTdwmGCy0MpwsVWsD6ZVKQ
pNs6z9iV35PWsY/q6iso+w9crJoc0rRwaAAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/14/2013 13:02'!
protocolNoneIcon
	^ self blankIconOfWidth: 16! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallSelectIconContents
	"Private - Method generated with the content of the file /home/dgd/smallSelect.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABF0
RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAABK0lEQVR4nKXOO0oEQRAG4L+6q2cfjojgBmJi
YmroEQwNBBPxFF7AzBt4DMHcyFwUE2MRPIDruuxMd9VvsKCbrOJOQVNNPT5KcHK7gTjdA2UH
MQzgnoCQIJ6AEAE3QFqQBSFk0DMcBaot1uxOobPjm/ODy/WhxrqvWvei1r35v1+FUIzM5mwz
PZt7a2Qx98eX9/Hp1cOFJpV0uD8aYUmkKJJixLBCXKxv1qmCSz/0VKtly79FEJlnjdBVgG+o
CljpgoVLJP499guQVFInIDtKJ6DJ3nQCPps86wTkgoYAVwYAycXYARAW8/8DKQZBgCgczdPr
x3h3azBwEtmc5qQZWZx0gsXJUpzFOe85+fw2mQCIgrPrbVg6AtFAQgHpAOznyTzTHRCDLNRt
ev8FfDedurn+q90AAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallPushpinIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAQAAAC1+jfqAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAEZSURBVCjPY/jPgB9iEVoqPefl
lFPdNk2GWBUsVpz9ctL1rkcNW/v+59VhKFgkPfP+xI0dF+uC/jPkWCR/Q1MwX2TGvf7Nretr
/UG8BO2I5ygK5olP/dCzpWV+dVAhd+bB+JawrT7ICubIT3nbvaFpVkVqgVDa0diO4CneN91E
4Qpmq0560jW/YXp5XB5nyq2YrqCFno9cJeG+mKk48UHHjLruMu8czuSbkfUBizxeucrDw2GG
ev/71uW1jMVrsq4nPIto8F/g8caFDymgetxbHlVLgDjxnWExPjPdb7sIoYRkk17FywJRECdY
1Xux201nMbSgLufO25qyJUY1yNrzsus9JxkscZHMG+kVcN7jqWueowARkUWiAgBEUvolGfpI
TwAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallObjectsIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAInSURBVDjLhZPda9NQHIbzVwlW
ryzthpWuIpWOieKYZXO2q1vC0KFr9aZM3Yr40QunspU2TVYmYhVRvNErwQtR3E0JTq3G2o80
mc0Ql9dzTr/SYdnFA8k5yft78nLCjcxJNwKzsuoOiZoj2GKsi3NS1I7y4hIA7n9wgQvyz4Ki
WLphwNgyoRMq+jZ+MUyo1ToOR6Ra3wA6ua4b8F/2gL830WF8YRGB2VX4hBwOBEWrnxl3kGzQ
yXzyLJbfLuL+uwQevr+Jk7EsiBn2MmMBdbJ58UEEKx9vYfVDE89MBtTsTVjA53iiy/XbeD4X
RaluwhWSNRZQIYmeay6cSsYxfCmFwfMpEGW4wjk4gxm4J7IECd6IhOW7z/AlkYRaawXQbyuT
tCOJAQzPp/bU9gtrLOBHrUECJI3bP5bWypoJx7l9cE+tMO0TsTuIpl90uCq+xJnoEtP2hUV8
Cp7G90orwMECGthQd5gynRxLPUWuoOOR8huPN//gyde/iMuvmLZvKgtlfBTFdsBgSNwslavQ
iOIACaCF0ofzRQv5bzsd6BrV9obSyI8EUCw34JwkAcd4aWFoWn5N00ihFi30+HwaM5LCmM4U
GH5SLtX28uvMtlg2mwH2U9UuNHBlDUKu2ANdo9pDwjqqpNQSOwdyrSegXeih0Rh7wQ5da2lb
dDI5RBqxT/Qa2ArdUK1ddLV7/gX7jb1QzdhGjVAl10262n0D7IXSSbtpa9vf+QeB6/JTIb6V
uwAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloViewIcon
	"Private - Generated method"
	^ icons
			at: #'haloView'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self haloViewIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:28'!
smallLockIcon
	"Private - Generated method"
	^icons
			at: #smallLockIcon
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallLockIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 17:06'!
classIcon 
	^ self blankIcon! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
checkBoxOffIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/checkBoxOff.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAAAwAAAAMAQMAAABsu86kAAAABlBMVEUAAAAAAAClZ7nPAAAA
AnRSTlMA/1uRIrUAAAAVSURBVHheY/j/gaFBnqFBAif6/wMAs5gJ3stUs1kAAAAASUVORK5C
YII='! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:23'!
greenArrowUpAndDownIconContents
	^ Form
		extent: 9@15
		depth: 32
		fromArray:  #(16777215 16777215 16777215 906042112 3791859456 906042112 16777215 16777215 16777215 16777215 16777215 268435456 3557049600 4278962432 3557049600 268435456 16777215 16777215 16777215 16777216 3137548288 4278894336 4278962688 4278894336 3137548288 16777216 16777215 16777215 2348951296 4161381376 4278962688 4278962688 4278962688 4161381376 2348951296 16777215 1342316032 3926358272 4278962688 4278962688 4278962688 4278962688 4278962688 3926358272 1342316032 3858831104 3842402048 3842402048 4262115584 4278962688 4262115584 3842402048 3842402048 3858831104 251658240 268435456 1140850688 4194866688 4278962688 4194866688 1140850688 268435456 251658240 16777215 16777215 939524096 4194866688 4278962688 4194866688 939524096 16777215 16777215 251658240 268435456 1140850688 4194866688 4278962688 4194866688 1140850688 268435456 251658240 3858831104 3842402048 3842402048 4262115584 4278962688 4262115584 3842402048 3842402048 3858831104 1342316032 3926358272 4278962688 4278962688 4278962688 4278962688 4278962688 3926358272 1342316032 16777215 2348951296 4161381376 4278962688 4278962688 4278962688 4161381376 2348951296 16777215 16777215 16777216 3137548288 4278894336 4278962688 4278894336 3137548288 16777216 16777215 16777215 16777215 268435456 3557049600 4278962432 3557049600 268435456 16777215 16777215 16777215 16777215 16777215 906042112 3791859456 906042112 16777215 16777215 16777215)
		offset: 0@0! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
radioButtonOffIcon
	"Private - Generated method"
	^ icons
			at: #'radioButtonOff'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self radioButtonOffIconContents readStream) ].! !

!ThemeIcons methodsFor: 'private - utilities' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
exportIcon: image asGifNamed: aString
	"self exportIcon: self newIcon asGifNamed: 'newIcon'"

	| writer |
	writer := GIFReadWriter on: (FileStream newFileNamed: aString, '.gif').
	[ writer nextPutImage: image]	
		ensure: [writer close]! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:26'!
smallHelpIcon
	"Private - Generated method"
	^ icons
			at: #'smallHelp'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallHelpIconContents readStream) ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallInfoIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAKcSURBVDjLpZPLa9RXHMU/d0ys
ZEwmMQqZiTaP0agoaKGJUiwIxU0hUjtUQaIuXHSVbRVc+R8ICj5WvrCldJquhVqalIbOohuZ
xjDVxDSP0RgzyST9zdzvvffrQkh8tBs9yy9fPhw45xhV5X1U8+Yhc3U0LcEdVxdOVq20OA0o
oQjhpnfhzuDZTx6++m9edfDFlZGMtXKxI6HJnrZGGtauAWAhcgwVnnB/enkGo/25859l3wIc
vpzP2EhuHNpWF9/dWs/UnKW4EOGDkqhbQyqxjsKzMgM/P1ymhlO5C4ezK4DeS/c7RdzQoa3x
1PaWenJjJZwT9rQ1gSp/js1jYoZdyfX8M1/mp7uFaTR8mrt29FEMQILr62jQ1I5kA8OF59jI
ItVA78dJertTiBNs1ZKfLNG+MUHX1oaURtIHEAOw3p/Y197MWHEJEUGCxwfHj8MTZIcnsGKx
zrIURYzPLnJgbxvG2hMrKdjItjbV11CYKeG8R7ygIdB3sBMFhkem0RAAQ3Fuka7UZtRHrasO
qhYNilOwrkrwnhCU/ON5/q04vHV48ThxOCuoAbxnBQB+am65QnO8FqMxNCjBe14mpHhxBBGC
WBLxD3iyWMaYMLUKsO7WYH6Stk1xCAGccmR/Ozs/bKJuXS39R/YgIjgROloSDA39Deit1SZW
otsjD8pfp5ONqZ6uTfyWn+T7X0f59t5fqDhUA4ry0fYtjJcWeZQvTBu4/VqRuk9/l9Fy5cbn
X+6Od26s58HjWWaflwkusKGxjm1bmhkvLXHvh1+WMbWncgPfZN+qcvex6xnUXkzvSiYP7EvT
vH4toDxdqDD4+ygT+cKMMbH+3MCZ7H9uAaDnqytpVX8cDScJlRY0YIwpAjcNcuePgXP/P6Z3
0QuoP4J7WbYhuQAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:33'!
toolsIcon
	"Private - Generated method"
	^ icons
			at: #'toolsIcon'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self toolsIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:32'!
solidMenuIcon
	"Private - Generated method"
	^ icons
			at: #'solidMenu'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self solidMenuIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallCutIcon
	"Private - Generated method"
	^ icons
			at: #'smallCut'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallCutIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousTrash
^ self icons
		at: #glamorousTrash ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 301989888 3472883712 3472883712 285212672 0 0 0 0 0 0 0 0 0 0 0 0 1778384896 4278190080 4278190080 1778384896 0 0 0 0 0 0 0 0 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4194304000 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4194304000 0 0 0 0 0 3472883712 905969664 0 0 0 0 0 0 0 905969664 3472883712 0 0 0 0 0 2600468480 1778384896 0 0 0 0 0 0 0 1761607680 2617245696 0 0 0 0 0 1744830464 2634022912 0 0 0 0 0 0 0 2617245696 1761607680 0 0 0 0 0 889192448 3489660928 0 0 0 0 0 0 0 3472883712 905969664 0 0 0 0 0 117440512 4143972352 117440512 0 0 0 0 0 117440512 4143972352 117440512 0 0 0 0 0 0 3472883712 905969664 0 0 0 0 0 905969664 3472883712 0 0 0 0 0 0 0 2617245696 1761607680 0 0 0 0 0 1761607680 2617245696 0 0 0 0 0 0 0 1761607680 2617245696 0 0 0 0 0 2617245696 1761607680 0 0 0 0 0 0 0 905969664 3472883712 0 0 0 0 0 3472883712 905969664 0 0 0 0 0 0 0 50331648 4194304000 4278190080 4278190080 4278190080 4278190080 4278190080 4194304000 50331648 0 0 0)
	offset: (0@0))]! !

!ThemeIcons methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 6/7/2013 16:27'!
packageDeleteIcon 
	^ icons
			at: #'packageDeleteIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self packageDeleteIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:31'!
smallSelectIcon
	"Private - Generated method"
	^ icons
			at: #'smallSelect'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallSelectIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:34'!
windowCloseForm
	^ icons
			at: #'calendarIcon'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self windowCloseFormContents readStream) ].! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'AndreiChis 1/23/2015 15:14'!
glamorousZoomToFit
^ self icons
		at: #glamorousZoomToFit ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1644167168 3036676096 3640655872 3640655872 3036676096 1644167168 0 0 0 0 0 0 0 0 419430400 3120562176 2600468480 637534208 16777216 16777216 637534208 2600468480 3120562176 419430400 0 0 0 0 0 0 3120562176 1409286144 0 0 0 0 0 0 1409286144 3120562176 0 0 0 0 0 1644167168 2600468480 0 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 0 2600468480 1644167168 0 0 0 0 3036676096 637534208 0 4278190080 0 0 0 0 4278190080 0 637534208 3036676096 0 0 0 0 3640655872 16777216 0 4278190080 0 0 0 0 4278190080 0 16777216 3640655872 0 0 0 0 3640655872 16777216 0 4278190080 0 0 0 0 4278190080 0 16777216 3640655872 0 0 0 0 3036676096 637534208 0 4278190080 0 0 0 0 4278190080 0 637534208 3036676096 0 0 0 0 1644167168 2600468480 0 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 0 2600468480 1644167168 0 0 0 0 0 3120562176 1409286144 0 0 0 0 0 0 1409286144 3120562176 0 0 0 0 0 0 419430400 3120562176 2600468480 637534208 16777216 16777216 637534208 2600468480 3120562176 419430400 0 0 0 0 0 0 0 0 1644167168 3036676096 3640655872 3640655872 3036676096 1644167168 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: (0@0))]! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallDebugIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAKYSURBVDjLnZPJT1NRFMb5G1wD
HV5boNiqdHrvFYolCAtsGSSWKpMFKhYqlDI6oAEKaVJwCIgSphaKtLYWCgSNBgRjMNHoxsSF
S3cmJmA0NMTw+R6JKKZl4eJL7sm953fOd3JPHIC4WMpcppG5SGnZc8ZjVVF6QLn975sDgfaZ
mvg71oRJZIRUYcuAnq/2KWroGfm3QwEn2YpLVPPvOD2oiqj9yq/mGznegl56mx6T7ZbY1M6Y
AM0CuZkxT0b2Wg6QW/SsApRXDsotR+d6E9Y/h9DuqoCuJq0lKoDxqU1/pITGR27mBU4h+GEc
Tz5OY+ClA5JbyahYzof/9TBO9B/FcWcqpA4xU3We3GJ87ntnfO5meinMvruNnqcmXA2XoDVc
Cc0wCYkzBaZpA7ILRJ/2O2B87jA+QT9UeDRe8svZYAG8b/txc6kc9mA+yqayYPQXwvdmBEOr
A5B2p0BtFIYOWKCm5RukWwZyXIbA+0F0LpaiKaBHmVsLw4we99ccsM8a8GClF5JOMcQdou8p
rULrgRmQo7KI0VcE13MrGv06lE5kodhzGvdWu2GdKkTVWC4DcELcJkKyXbCb1EhAVM//M0DV
UNqP2qAJd1baUDaZjTMTeXAttsPi0cM0mgvHvA0NkxYk2QRIrieOsDmEmXttH0DfVfSluSTo
WmpD8bgOroUOWNw6VI7koGfOBuq6EqLLTNU6ojrmP5D1HVsjmrkYezGIrlA9LjKgnrlGXJlp
gbCOD0EtD0QNN8I3cZqjAlhJr4rXpB1iNLhrYffUQWoT7yUKzbxqJlHLq0jc5JYmgHMunogK
YJVqF7mTrPyfgktMRTMX/CrOq1gLF3fYNrLiX+Bs8MoTwT2fQPwXgBXHGL+TaIjfinb3C7cs
cRMIcYL6AAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallPrintItIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAJ1SURBVDjLpVLdS9NhFH724WbT
WcpKiTUxWyJKRTdGURaSUt5URDcW3XYZ9AER1UXhTQT9CREE3URi1EUkaGhq5ZSgDzc1tWma
Gzrd5m/v+55zurBy6u468MD54Dzn0yYi+B9xZhvxwWOPheWCiECYARYIrejCvKoTT/qbQuUb
CISlZXNFC4QFIIYQrcIQ0rEPsBKR5N/kNQSxgaN3Xd6gHQzo+HOINmCtIUojz3cG1sJXWIkI
+ZtC3uyi9tXqfD1/y15Q+hvEEESvIM93CioZxfJCBExctX4HdgCYe3/kbJ4n4ILNBUp9hhgC
k4GjcD9Yp2AthEGZxebAyaHRnATC/MjlDUJMCmLMn5kN7O4AlueHoZLRa4HmoVe5rmCb7T1U
53D5+rz+E1CxdrDSEK3BlgVX6WnEI09EiNXDxQJ3yihc8aQzDmIIcSJ4fqTUKSTtLu9uCGk4
i5ogZCCGAAHEMIrLz9nEaHfm00v4fdW4MxVy3y7gtEPTQQBwCrM7Od2VyboxhBkP5ovcwgqK
DZQhbC8JorqsDktWCpejffmWUbNvAdhyfeLEiz2d9xOe+uM1F0HCICYwBDOJKIoLtqF37A0G
JrvYMqrEmWsxQlxvGQUSxkQ8As0GhjU0aSxmlrBvx2Ekddre/707voFgvK12MN+7C1YsDEMG
pUUBGCaQMH4mJlFSWIbQjx70jHbPKYPGNSOMt9UWQuxLQoyrsTSWlRLFCpZRqPTV2A7sbMTH
yXfoCL+eUQYN063yxbmu9X4m80uIK59dGktmx2rv2VM2+yZPZ7hjSjEapltleCVJ5B9GnlbV
ZdvZqLiFVOCmQ7beQEW2/zeRQcHUmJPKOgAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:25'!
stringIconContents
	^ ((ColorForm
	extent: 12@12
	depth: 8
	fromArray: #( 673716502 100672805 623061032 673717016 118757928 587409448 673710082 33825576 354166824 673717518 268698408 19277864 673714447 504037672 638134312 673720360 302655016 606152744 673720360 673588264 555886632 673720360 673456424 572991528 673720360 671621672 656418856 673720360 673654568 538912808 673720360 671948840 84682792 673720360 673128232 320284712)
	offset: 0@0)
	colorsFromArray: #(#(0.439 0.721 0.937) #(0.447 0.674 0.93) #(0.573 0.784 0.953) #(0.451 0.682 0.937) #(0.534 0.761 0.949) #(0.435 0.631 0.926) #(0.439 0.729 0.945) #(0.573 0.788 0.953) #(0.443 0.651 0.926) #(0.443 0.663 0.93) #(0.427 0.671 0.93) #(0.494 0.733 0.945) #(0.431 0.631 0.926) #(0.435 0.643 0.926) #(0.498 0.745 0.945) #(0.478 0.694 0.934) #(0.569 0.78 0.953) #(0.941 0.965 0.992) #(0.941 0.961 0.992) #(0.431 0.628 0.926) #(0.538 0.764 0.949) #(0.447 0.682 0.937) #(0.435 0.706 0.937) #(0.431 0.628 0.918) #(0.522 0.768 0.949) #(0.827 0.898 0.977) #(0.455 0.694 0.937) #(0.419 0.71 0.937) #(0.447 0.682 0.93) #(0.455 0.698 0.937) #(0.443 0.71 0.937) #(0.435 0.635 0.926) #(0.435 0.639 0.926) #(0.443 0.659 0.926) #(0.439 0.651 0.926) #(0.451 0.686 0.937) #(0.443 0.659 0.93) #(0.439 0.717 0.937) #(0.443 0.671 0.93) #(0.435 0.647 0.926) #( ) ))! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloCollapseIcon
	"Private - Generated method"
	^ icons
			at: #'haloCollapse'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self haloCollapseIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:22'!
dirtyPackageIconContents

	^ (Form
		extent: 15@16
		depth: 32
		fromArray:    #(16777215 16777215 16777215 16777215 16777215 16777215 55924053 417994005 50331647 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 33554432 465965843 3031638305 3903537987 3402577205 1055007009 55924053 16777215 16777215 16777215 16777215 16777215 16777215 33554432 211096853 2898203925 3903533104 4286542707 4286545791 4286874242 4037368410 3520342827 602025004 75530368 16777215 16777215 16777215 67108864 1907822094 3651740708 4254094677 4107417399 4122498132 4286807935 4189741923 4141438293 4238769019 3970982755 2898412355 399008868 41975936 50331648 3569165862 4155256623 4285098345 4285690482 4286019447 4239415384 4242881853 4191310675 4287269514 4287730065 4288848546 4290879648 4140590437 212511402 16777215 3417454134 4220740451 4173088326 4254618194 4106502465 4123936326 4287004286 4189741923 4141438550 4239162492 4191255676 4207711637 4057304204 284159983 16777215 3433903670 4285164138 4285754990 4240068945 4190259015 4287196782 4286545791 4286939521 4173685089 4258814040 4288185990 4288585374 3989996162 234881023 16777215 3618122282 4284571744 4285032552 4154738503 4286280049 4189085535 4190129742 4173682262 4220874350 4123479116 4286743170 4287269514 3990118753 150994943 16777215 3751747873 4218959157 4235610184 4170400322 4285229931 4285558896 4257240919 4285493103 4285822068 4123411524 4288113515 4107945542 4091689787 83886079 16777215 3548454687 4282203453 4233968957 4270077237 4285551186 4284966759 4290072142 4285229931 4286277479 4242418475 4123019079 4286609271 3854453836 83886079 16777216 3664647188 4280756007 4281742902 4284427822 4285086523 4286790202 4289611848 4290390056 4290652200 4291308588 4285690482 4285953654 3870967366 67108863 117440512 3313569037 4263906830 4280163613 4282654238 4282203453 4283319878 4289282112 4286729806 4284900966 4290194476 4285361517 4253703003 3486721317 41975936 16777216 134217728 1603340296 4016639245 4281337864 4280690214 4281611316 4287577405 4284835173 4284835173 4239861543 3820561958 2127435286 75513920 16777215 16777215 16777215 33554432 218103808 2543520266 4149480717 4280424986 4286460980 4285292640 4004129836 2832208402 296026112 16777215 16777215 16777215 16777215 16777215 16777215 16777215 50331648 372899840 3012103437 4187497251 3083409432 565772288 16777216 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 83886080 134217728 33554432 16777215 16777215 16777215 16777215 16777215 16777215)
		offset: 0@0)! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloGrabIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/haloGrab.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQAQMAAAAlPW0iAAAABlBMVEX///8AAABVwtN+AAAA
KklEQVR4XmMAAsYGEGJyYGBRYOAQYBDgYFB/wiCiwcBjABIBIvYHDDAAAG8cBEtTRUljAAAA
AElFTkSuQmCC'! !

!ThemeIcons methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
iconNamed: aSymbol
	^ self iconNamed: aSymbol ifNone: [self blankIcon]! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousLargeGrayCircleEmphasized
^ self icons
		at: #glamorousLargeGrayCircleEmphasized ifAbsentPut: [(Form
	extent: (19@19)
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 33554431 919325643 1741409227 2043464908 1741409227 919325643 33554431 0 0 0 0 0 0 0 0 0 0 33554431 1691143372 3805006795 4292072403 4292861919 4293125091 4292861919 4292072403 3788295372 1691143372 33554431 0 0 0 0 0 0 0 198300113 2949434572 4292269782 4294243572 4294572537 4293914607 4293388263 4293914607 4294572537 4294243572 4292269782 2949434572 198300113 0 0 0 0 0 33554431 2949434572 4292796126 4294704123 4292993505 4291546059 4291546059 4291546059 4291546059 4291546059 4292993505 4294704123 4292796126 2949434572 33554431 0 0 0 0 1691143372 4292269782 4294704123 4292072403 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4292072403 4294704123 4292269782 1691143372 0 0 0 33554431 3805006795 4294243572 4292993505 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4292993505 4294243572 3788295372 33554431 0 0 919325643 4292138196 4294572537 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4294572537 4292072403 919325643 0 0 1741409227 4292861919 4293914607 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4293914607 4292861919 1741409227 0 0 2043464908 4293125091 4293388263 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4293388263 4293125091 2043464908 0 0 1741409227 4292861919 4293914607 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4293914607 4292861919 1741409227 0 0 919325643 4292138196 4294572537 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4294572537 4292072403 919325643 0 0 33554431 3805006795 4294243572 4292993505 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4292993505 4294243572 3788295372 33554431 0 0 0 1691143372 4292269782 4294704123 4292072403 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4291546059 4292072403 4294704123 4292269782 1691143372 0 0 0 0 33554431 2949434572 4292796126 4294704123 4292993505 4291546059 4291546059 4291546059 4291546059 4291546059 4292993505 4294704123 4292796126 2949434572 33554431 0 0 0 0 0 198300113 2949434572 4292269782 4294243572 4294572537 4293914607 4293388263 4293914607 4294572537 4294243572 4292269782 2949434572 198300113 0 0 0 0 0 0 0 33554431 1691143372 3805006795 4292072403 4292861919 4293125091 4292861919 4292072403 3788295372 1691143372 33554431 0 0 0 0 0 0 0 0 0 0 33554431 919325643 1741409227 2043464908 1741409227 919325643 33554431 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: (0@0))]! !

!ThemeIcons methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 6/7/2013 16:27'!
packageAddIcon 
	^ icons
			at: #'packageAddIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self packageAddIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
tinyMenuIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/tinyMenu.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAAAoAAAAKCAYAAACNMs+9AAAANklEQVR4XmMAgj9A/A0PBsmD
wbeGhob9uDBMngGZgQMgFBLCpJtIrMI/VLeaYDjCDcIXjjAMANORazeIMUQRAAAAAElFTkSu
QmCC'! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousRestart
^ self icons
		at: #glamorousRestart ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 721420288 1073741824 855638016 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2717908992 4278190080 3724541952 16777215 16777215 16777215 16777215 16777215 654311424 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2835349504 4278190080 3640655872 16777215 16777215 16777215 822083584 3623878656 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2936012800 4278190080 3523215360 16777215 402653184 2952790016 4177526784 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3053453312 4278190080 3388997632 16777215 4278190080 4227858432 4278190080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3154116608 4278190080 3271557120 16777215 3053453312 4160749568 4278190080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3271557120 4278190080 3154116608 16777215 16777215 704643072 3422552064 4194304000 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3388997632 4278190080 3053453312 16777215 16777215 16777215 16777215 1291845632 2885681152 16777215 16777215 16777215 16777215 16777215 16777215 16777215 771751936 1073741824 805306368 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:32'!
alertIcon 
	^ icons
			at: #'alertIcon'
			ifAbsentPut:[ self alertIconContents ].! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousRedCircle
^ self icons
		at: #glamorousRedCircle ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 114622464 2279547942 3890160678 3890160678 2279547942 114622464 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2279547942 4292879654 4292879654 4292879654 4292879654 2279547942 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3890160678 4292879654 4292879654 4292879654 4292879654 3890160678 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3890160678 4292879654 4292879654 4292879654 4292879654 3890160678 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2279547942 4292879654 4292879654 4292879654 4292879654 2279547942 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 114622464 2279547942 3890160678 3890160678 2279547942 114622464 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloDismissIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/haloDismiss.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQAQMAAAAlPW0iAAAABlBMVEX///8AAABVwtN+AAAA
HklEQVR4XmNABjwGDHwFDOwPGJgPgBCQAeQCBZEAAHDUBMlabZn2AAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'TudorGirba 3/5/2015 10:46'!
glamorousCloudPausedIcon
	"Private - Generated method"
	^icons 
			at: #glamorousCloudPausedIcon
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousCloudPausedIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
paintingIcon
	"Private - Generated method"
	^ icons
			at: #'painting'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self paintingIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 12:39'!
nautilusIconContents
	| bitmap |
	
	bitmap :=  (Bitmap new: 256) copyFromByteArray:   #[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 255 249 235 15 254 248 233 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 183 102 33 13 162 147 126 14 199 176 153 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 143 187 142 101 94 197 140 89 0 0 0 0 208 181 135 93 108 190 134 85 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 144 159 121 84 174 168 127 90 119 181 140 104 194 182 128 81 24 207 148 99 4 252 255 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 159 170 119 70 255 200 124 58 253 189 122 63 60 148 118 91 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 199 157 91 59 255 222 129 64 255 201 118 48 178 152 100 49 73 138 112 54 106 168 135 62 167 206 169 100 193 191 158 105 115 172 143 97 0 0 0 0 5 155 136 98 55 204 190 157 10 236 223 187 0 0 0 0 21 105 87 68 91 162 123 78 240 187 126 60 255 212 131 43 253 227 148 48 255 218 157 63 255 233 175 78 255 235 176 64 255 224 167 68 255 232 171 81 255 216 168 74 109 181 145 85 21 154 136 98 245 194 174 137 33 211 209 190 81 172 145 107 241 194 152 81 255 207 158 80 255 243 176 64 254 246 176 67 254 208 141 49 255 221 156 81 255 200 123 54 255 209 137 56 255 187 124 56 254 204 128 48 255 248 183 62 230 171 125 65 0 0 0 0 198 196 161 122 135 198 161 130 238 191 139 90 255 227 158 63 254 234 165 51 254 244 172 65 255 227 160 65 254 170 105 26 255 209 144 65 254 185 117 40 253 213 143 55 252 221 143 58 248 238 144 58 255 223 134 39 250 163 97 51 20 231 255 255 185 186 137 106 255 181 122 80 255 162 85 36 255 221 124 53 255 234 154 50 255 234 170 61 255 232 168 69 255 220 149 53 255 238 159 56 255 241 163 59 255 231 158 59 255 226 151 64 255 198 120 54 215 166 91 43 57 133 68 38 13 210 220 210 83 199 158 129 209 203 160 125 129 184 139 102 235 161 83 47 255 190 102 41 255 203 112 40 255 208 117 47 253 213 121 50 251 208 122 55 222 185 106 44 175 159 100 50 139 141 103 65 53 156 105 65 9 99 69 79 0 0 0 0 0 0 0 0 0 0 0 0 143 155 129 114 0 0 0 0 10 138 135 170 65 108 49 22 87 138 77 48 93 129 70 41 45 93 34 6 26 68 32 26 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 197 179 174 0 0 0 0 93 197 180 176 4 202 182 170 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 180 88 18 2 146 92 49 1 128 100 73 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0].
	
	^ Form 
		extent: 16@16 
		depth: 32 
		bits: bitmap! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousCancel
^ self icons
		at: #glamorousCancel ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 587202560 2348810240 234881024 16777215 318767104 939524096 369098752 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3925868544 4127195136 2801795072 201326592 3472883712 4093640704 2466250752 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 436207616 4127195136 4143972352 3992977408 4143972352 3959422976 570425344 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1157627904 4244635648 4261412864 4160749568 587202560 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 184549376 3472883712 4160749568 4261412864 4160749568 2801795072 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3472883712 4244635648 3959422976 1442840576 4110417920 4227858432 1493172224 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1895825408 3976200192 520093696 16777215 1157627904 4160749568 1258291200 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 520093696 16777216 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
scaleIcon
	"Private - Generated method"
	^ icons
			at: #'scale'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self scaleIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
eyedropperIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/eyedropper.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAACYAAAAkCAMAAADSK7iXAAADAFBMVEX///8AAAD///9/f3//
AAAA/wAAAP8A/////wAAAAAfHx8/Pz9fX1+enp6+vr7e3t4HBwcPDw8XFxcnJycvLy83NzdH
R0dPT09XV1dnZ2dvb293d3eGhoaOjo6Wlpampqaurq62trbGxsbOzs7W1tbm5ubu7u729vYA
AAAAMgAAZQAAmAAAywAA/wAAADIAMjIAZTIAmDIAyzIA/zIAAGUAMmUAZWUAmGUAy2UA/2UA
AJgAMpgAZZgAmJgAy5gA/5gAAMsAMssAZcsAmMsAy8sA/8sAAP8AMv8AZf8AmP8Ay/8A//8y
AAAyMgAyZQAymAAyywAy/wAyADIyMjIyZTIymDIyyzIy/zIyAGUyMmUyZWUymGUyy2Uy/2Uy
AJgyMpgyZZgymJgyy5gy/5gyAMsyMssyZcsymMsyy8sy/8syAP8yMv8yZf8ymP8yy/8y//9l
AABlMgBlZQBlmABlywBl/wBlADJlMjJlZTJlmDJlyzJl/zJlAGVlMmVlZWVlmGVly2Vl/2Vl
AJhlMphlZZhlmJhly5hl/5hlAMtlMstlZctlmMtly8tl/8tlAP9lMv9lZf9lmP9ly/9l//+Y
AACYMgCYZQCYmACYywCY/wCYADKYMjKYZTKYmDKYyzKY/zKYAGWYMmWYZWWYmGWYy2WY/2WY
AJiYMpiYZZiYmJiYy5iY/5iYAMuYMsuYZcuYmMuYy8uY/8uYAP+YMv+YZf+YmP+Yy/+Y///L
AADLMgDLZQDLmADLywDL/wDLADLLMjLLZTLLmDLLyzLL/zLLAGXLMmXLZWXLmGXLy2XL/2XL
AJjLMpjLZZjLmJjLy5jL/5jLAMvLMsvLZcvLmMvLy8vL/8vLAP/LMv/LZf/LmP/Ly//L////
AAD/MgD/ZQD/mAD/ywD//wD/ADL/MjL/ZTL/mDL/yzL//zL/AGX/MmX/ZWX/mGX/y2X//2X/
AJj/Mpj/ZZj/mJj/y5j//5j/AMv/Msv/Zcv/mMv/y8v//8sAAAD/Mv//Zf//mP//y//////e
TOgfAAABAHRSTlP///////////8A////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////AP//////OE00
OwAAAR5JREFUeF6t1DGygjAQBmCHVkYroplhFBjzwmHouAidF8ALZOzSeYF4g1Smeu8CtlRJ
R5vqJejTV0CWwq2/2QnL/ruwdk4t7CfYj5IXmKnOaMkhdjO+5DHMlDF93xvZ4BD71oNyrAmx
7ql4VQbYSzXlFFNK6f9qgslOaq/0U02wi2tjetPJYzWoqbdxZaQcWpWBn7Vfcfeqtxpn2Toq
uB/Enxpl2VdED7g5Vy81xpwi91Od1m81wnLqVJtYe64DLKeUXFsErKXvdcU1sL2riBKxXQJL
nrtPFNsYyELhFUJAZJy6CxQDySr8uBAGAph7lcRATjM/riQF4rxfExEvUyD1rCACbcDjwA4t
2sE3hKUYPDXsUTMuEpt3uD7LoPoFh1uzvVTXHQoAAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
backIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAADrSURBVDjLY/z//z8DJYCJgUIw
yAwoPZHJBsS7STGABY1/9e+fvzKkGMAIiwWgzRfF2ST0/vz5w/Dw/UOGXz9/M/z6AcK/GH4C
MZj+jmCD5C70X2VkgWo+KcYqrqfArcTw598fBhluOTD9++9fIP7N8PsfEP/9AxUD0b8ZVq9c
i/AC0Nm//zD+Yfj19xdY0R+got9gxb8RNNQAkNyf/0CxX39QvZC5M+68MJuIAQczJ8PDlw8Z
Xr9/g9XZIK+BNP/5/Yfh/sJHjIzIKTF2VchNoEI5oAbHDWk7TpAcjUDNukDNB4nVjOKFEZwX
AOOhu7x6WtPJAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:31'!
smallUnderlineIcon
	"Private - Generated method"
	^icons
			at: #smallUnderlineIcon
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallUnderlineIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:30'!
smallPushpinIcon
	"Private - Generated method"
	^icons
			at: #smallPushpinIcon
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallPushpinIconContents readStream) ].! !

!ThemeIcons methodsFor: '*MonticelloGUI' stamp: 'TorstenBergmann 12/2/2014 21:04'!
newerPackagesAvailableIconContents

	^((ColorForm
	extent: (16@16)
	depth: 8
	fromArray: #( 976894522 976894522 976894522 976894522 976894522 976894522 976894522 976894522 976894522 976894522 3815994 976894522 976894475 168430090 34212362 168507962 976894473 1027489596 119152930 352926266 976894470 1061109560 119221550 386284090 976894470 1061109567 118696492 369506874 976894469 1027554105 17305880 201669178 976879618 117901057 16844551 117571642 976894468 220868880 17771303 235158074 976894468 590361874 119089455 537147962 976894467 523712052 119812648 486750778 976894467 640889893 119938588 620968506 976894484 50529027 33751811 51657274 976894522 976894522 3815994 976894522 976894522 976894522 976894522 976894522)
	offset: (0@0))
	colorsFromArray: #(#(0.447 0.219 0.059000000000000004 1.0) #(0.47800000000000004 0.28500000000000003 0.254 1.0) #(0.5760000000000001 0.317 0.09 1.0) #(0.642 0.34900000000000003 0.125 1.0) #(0.674 0.384 0.125 1.0) #(0.706 0.41500000000000004 0.156 1.0) #(0.737 0.447 0.156 1.0) #(0.607 0.447 0.34900000000000003 1.0) #(0.646 0.494 0.4 1.0) #(0.772 0.447 0.156 1.0) #(0.772 0.47800000000000004 0.156 1.0) #(0.737 0.513 0.188 1.0) #(0.721 0.537 0.357 1.0) #(0.745 0.5640000000000001 0.392 1.0) #(0.745 0.5760000000000001 0.40800000000000003 1.0) #(0.71 0.5680000000000001 0.462 1.0) #(0.717 0.58 0.466 1.0) #(0.733 0.603 0.47800000000000004 1.0) #(0.745 0.611 0.49 1.0) #(0.745 0.615 0.49 1.0) #(0.772 0.513 0.188 1.0) #(0.796 0.5720000000000001 0.325 1.0) #(0.796 0.615 0.40800000000000003 1.0) #(0.811 0.623 0.41200000000000003 1.0) #(0.753 0.615 0.47400000000000003 1.0) #(0.753 0.623 0.498 1.0) #(0.788 0.623 0.439 1.0) #(0.776 0.646 0.498 1.0) #(0.792 0.634 0.458 1.0) #(0.796 0.634 0.458 1.0) #(0.8 0.642 0.466 1.0) #(0.807 0.642 0.455 1.0) #(0.807 0.65 0.466 1.0) #(0.8190000000000001 0.63 0.404 1.0) #(0.8230000000000001 0.638 0.41200000000000003 1.0) #(0.8190000000000001 0.654 0.462 1.0) #(0.772 0.646 0.505 1.0) #(0.772 0.642 0.513 1.0) #(0.804 0.674 0.544 1.0) #(0.811 0.6940000000000001 0.544 1.0) #(0.8310000000000001 0.7020000000000001 0.529 1.0) #(0.8190000000000001 0.706 0.552 1.0) #(0.8190000000000001 0.706 0.556 1.0) #(0.8190000000000001 0.706 0.56 1.0) #(0.835 0.71 0.537 1.0) #(0.843 0.721 0.548 1.0) #(0.858 0.729 0.544 1.0) #(0.847 0.729 0.56 1.0) #(0.858 0.733 0.556 1.0) #(0.8270000000000001 0.714 0.5640000000000001 1.0) #(0.843 0.729 0.5640000000000001 1.0) #(0.835 0.737 0.5760000000000001 1.0) #(0.835 0.737 0.607 1.0) #(0.847 0.733 0.5760000000000001 1.0) #(0.854 0.749 0.595 1.0) #(0.89 0.788 0.615 1.0) #(0.995 0.995 0.733 1.0) #(0.995 0.995 0.776 1.0) #( ) #(0.995 0.995 0.917 1.0) #(0.9480000000000001 0.96 0.995 1.0) #(0.983 0.995 0.995 1.0) #(0.987 0.995 0.995 1.0) #(0.995 0.995 0.995 1.0) #(0.223 0.419 0.188 1.0) #(0.223 0.423 0.192 1.0) #(0.031 0.08600000000000001 0.20700000000000002 1.0) #(0.0 0.0 0.016 1.0) #(0.016 0.964 0.627 1.0) #(0.016 0.964 0.548 1.0) #(0.223 0.525 0.266 1.0) #(0.031 0.08600000000000001 0.20700000000000002 1.0) #(0.223 0.419 0.188 1.0) #(0.223 0.423 0.192 1.0) #(0.031 0.08600000000000001 0.20700000000000002 1.0) #(0.0 0.0 0.016 1.0) #(0.016 0.964 0.753 1.0) #(0.016 0.964 0.674 1.0) #(0.223 0.525 0.266 1.0) #(0.031 0.08600000000000001 0.20700000000000002 1.0) #(0.0 0.0 0.016 1.0) #(0.016 0.964 0.753 1.0) #(0.0 0.0 0.0 1.0) #(0.223 0.525 0.313 1.0) #(0.016 0.964 0.047 1.0) #(0.745 0.65 0.117 1.0) #(0.0 0.909 0.125 1.0) #(1.0 1.0 0.995 1.0) #(0.721 0.427 0.317 1.0) #(0.725 0.051000000000000004 0.152 1.0) #(0.0 0.0 0.0 1.0) #(0.25 0.498 0.17200000000000001 1.0) #(0.004 0.027 0.533 1.0) #(0.0 0.0 0.027 1.0) #(0.027 0.02 0.792 1.0) #(0.0 0.0 0.0 1.0) #(0.0 0.0 0.0 1.0) #(0.0 0.0 0.0 1.0) #(0.0 0.0 0.027 1.0) #(0.357 0.106 0.25 1.0) #(0.0 0.0 0.027 1.0) #(0.0 0.0 0.0 1.0) #(0.25 0.498 0.17200000000000001 1.0) #(0.0 0.0 0.0 1.0) #(0.25 0.498 0.17200000000000001 1.0) #(0.004 0.027 0.533 1.0) #(0.0 0.0 0.027 1.0) #(0.027 0.02 0.792 1.0) #(0.0 0.0 0.0 1.0) #(0.0 0.0 0.004 1.0) #(0.0 0.0 0.0 1.0) #(0.203 0.513 0.125 1.0) #(0.016 0.964 0.23500000000000001 1.0) #(0.357 0.925 0.337 1.0) #(0.357 0.925 0.369 1.0) #(0.0 0.0 0.0 1.0) #(0.357 0.106 0.25 1.0) #(0.016 0.96 0.768 1.0) #(0.361 0.10200000000000001 0.125 1.0) #(0.0 0.0 0.0 1.0) #(0.357 0.106 0.25 1.0) #(0.357 0.917 0.9480000000000001 1.0) #(0.357 0.106 0.25 1.0) #(0.357 0.623 0.227 1.0) #(0.0 0.0 0.0 1.0) #(0.509 0.008 0.886 1.0) #(0.004 0.027 0.533 1.0) #(0.016 0.9560000000000001 0.8 1.0) #(0.721 0.811 0.936 1.0) #(0.419 0.9560000000000001 0.063 1.0) #(0.0 0.0 0.0 1.0) #(0.0 0.6900000000000001 0.16 1.0) #(0.0 0.0 0.0 1.0) #(0.0 0.0 0.0 1.0) #(0.016 0.9560000000000001 0.847 1.0) #(0.721 0.384 0.063 1.0) #(0.749 0.008 0.188 1.0) #(0.0 0.6900000000000001 0.16 1.0) #(0.016 0.96 0.078 1.0) #(0.721 0.8150000000000001 0.58 1.0) #(0.721 0.8150000000000001 0.372 1.0) #(0.737 0.439 0.423 1.0) #(0.0 0.0 0.0 1.0) #(0.0 0.0 0.0 1.0) #(0.016 0.96 0.094 1.0) #(0.223 0.341 0.34500000000000003 1.0) #(0.223 0.34900000000000003 0.41500000000000004 1.0) #(0.004 0.08600000000000001 0.20700000000000002 1.0) #(0.521 0.0 0.059000000000000004 1.0) #(0.0 0.0 0.0 1.0) #(0.004 0.08600000000000001 0.20700000000000002 1.0) #(0.0 0.0 0.0 1.0) #(0.0 0.0 0.004 1.0) #(0.0 0.0 0.0 1.0) #(0.223 0.47400000000000003 0.5760000000000001 1.0) #(0.223 0.47400000000000003 0.458 1.0) #(0.016 0.96 0.203 1.0) #(0.0 0.004 0.0 1.0) #(0.199 0.419 0.188 1.0) #(0.258 0.987 0.533 1.0) #(0.016 0.96 0.203 1.0) #(0.0 0.012 0.0 1.0) #(0.059000000000000004 0.219 0.447 1.0) #(0.254 0.28500000000000003 0.47800000000000004 1.0) #(0.09 0.317 0.5760000000000001 1.0) #(0.125 0.34900000000000003 0.642 1.0) #(0.125 0.384 0.674 1.0) #(0.156 0.41500000000000004 0.706 1.0) #(0.156 0.447 0.737 1.0) #(0.34900000000000003 0.447 0.607 1.0) #(0.4 0.494 0.646 1.0) #(0.156 0.447 0.772 1.0) #(0.156 0.47800000000000004 0.772 1.0) #(0.188 0.513 0.737 1.0) #(0.357 0.537 0.721 1.0) #(0.392 0.5640000000000001 0.745 1.0) #(0.40800000000000003 0.5760000000000001 0.745 1.0) #(0.462 0.5680000000000001 0.71 1.0) #(0.466 0.58 0.717 1.0) #(0.47800000000000004 0.603 0.733 1.0) #(0.49 0.611 0.745 1.0) #(0.49 0.615 0.745 1.0) #(0.188 0.513 0.772 1.0) #(0.325 0.5720000000000001 0.796 1.0) #(0.40800000000000003 0.615 0.796 1.0) #(0.41200000000000003 0.623 0.811 1.0) #(0.47400000000000003 0.615 0.753 1.0) #(0.498 0.623 0.753 1.0) #(0.439 0.623 0.788 1.0) #(0.498 0.646 0.776 1.0) #(0.458 0.634 0.792 1.0) #(0.458 0.634 0.796 1.0) #(0.466 0.642 0.8 1.0) #(0.455 0.642 0.807 1.0) #(0.466 0.65 0.807 1.0) #(0.404 0.63 0.8190000000000001 1.0) #(0.41200000000000003 0.638 0.8230000000000001 1.0) #(0.462 0.654 0.8190000000000001 1.0) #(0.505 0.646 0.772 1.0) #(0.513 0.642 0.772 1.0) #(0.544 0.674 0.804 1.0) #(0.544 0.6940000000000001 0.811 1.0) #(0.529 0.7020000000000001 0.8310000000000001 1.0) #(0.552 0.706 0.8190000000000001 1.0) #(0.556 0.706 0.8190000000000001 1.0) #(0.56 0.706 0.8190000000000001 1.0) #(0.537 0.71 0.835 1.0) #(0.548 0.721 0.843 1.0) #(0.544 0.729 0.858 1.0) #(0.56 0.729 0.847 1.0) #(0.556 0.733 0.858 1.0) #(0.5640000000000001 0.714 0.8270000000000001 1.0) #(0.5640000000000001 0.729 0.843 1.0) #(0.5760000000000001 0.737 0.835 1.0) #(0.607 0.737 0.835 1.0) #(0.5760000000000001 0.733 0.847 1.0) #(0.595 0.749 0.854 1.0) #(0.615 0.788 0.89 1.0) #(0.733 0.995 0.995 1.0) #(0.776 0.995 0.995 1.0) #(0.917 0.995 0.995 1.0) #(0.995 0.96 0.9480000000000001 1.0) #(0.995 0.995 0.983 1.0) #(0.995 0.995 0.987 1.0) #(0.995 0.995 0.995 1.0) #(1.0 1.0 1.0 1.0) #(0.317 0.427 0.721 1.0) #(0.40800000000000003 0.443 0.737 1.0) #(0.027 0.0 0.0 1.0) #(0.17200000000000001 0.498 0.25 1.0) #(0.23500000000000001 0.964 0.016 1.0) #(0.14100000000000001 0.0 0.0 1.0) #(0.004 0.0 0.0 1.0) #(0.0 0.0 0.0 1.0) #(0.0 0.0 0.0 1.0) #(0.439 0.0 0.0 1.0) #(1.0 1.0 1.0 1.0) #(1.0 1.0 1.0 1.0) #(0.223 0.451 0.658 1.0) #(0.223 0.807 0.85 1.0) #(0.031 0.08600000000000001 0.20700000000000002 1.0) #(0.0 0.0 0.0 1.0) #(0.0 0.004 0.0 1.0) #(0.016 0.964 0.658 1.0) #(0.0 0.0 0.008 1.0) #(0.223 0.47400000000000003 0.5760000000000001 1.0) #(0.223 0.451 0.658 1.0) #(0.223 0.807 0.85 1.0) #(0.031 0.08600000000000001 0.20700000000000002 1.0) #(0.0 0.0 0.0 1.0) #(0.0 0.004 0.0 1.0) #(0.016 0.964 0.784 1.0) #(0.0 0.0 0.008 1.0) #(0.223 0.47400000000000003 0.5760000000000001 1.0) #(0.223 0.47400000000000003 0.458 1.0) #(0.016 0.964 0.768 1.0)  ))! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallDoItIcon
	"Private - Generated method"
	^ icons
			at: #'smallDoIt'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallDoItIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Komitter-UI' stamp: 'VincentBlondeau 12/16/2014 14:26'!
overlayRemoveIconContents
	"Private - Method generated"
	^ 'R0lGODlhCwAKAKIAAD8/X////19fXwAAAP///wAAAAAAAAAAACH5BAEAAAQALAAAAAALAAoA
AAMjSLHMpALIGV4AIudRFdYCZwFNIHpg2F3peQ0wTFql89z4kwAAOw=='! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallBackIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAADrSURBVDjLY/z//z8DJYCJgUIw
yAwoPZHJBsS7STGABY1/9e+fvzKkGMAIiwWgzRfF2ST0/vz5w/Dw/UOGXz9/M/z6AcK/GH4C
MZj+jmCD5C70X2VkgWo+KcYqrqfArcTw598fBhluOTD9++9fIP7N8PsfEP/9AxUD0b8ZVq9c
i/AC0Nm//zD+Yfj19xdY0R+got9gxb8RNNQAkNyf/0CxX39QvZC5M+68MJuIAQczJ8PDlw8Z
Xr9/g9XZIK+BNP/5/Yfh/sJHjIzIKTF2VchNoEI5oAbHDWk7TpAcjUDNukDNB4nVjOKFEZwX
AOOhu7x6WtPJAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:28'!
smallLanguageIcon
	"Private - Generated method"
	^ icons
			at: #'smallLanguage'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallLanguageIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 6/7/2013 16:50'!
editIcon 
	^ icons
			at: #'editIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self editIconContents readStream) ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
changeSorterIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAFCSURBVDjLpVOxSgNBFJxcrkmC
+AV+gP5BwEKwtLESW0mZD7CyEyViJVhbG7DURvEXBAsDKgpGxIjIecnF29t9byyyAZu9wkz1
2HnMm3m7WyGJWRC3Dq7aq83FTpKzMcwyqFNYVczHNrvpDc5XmktrXz9siAJpksCKYK5qs9u7
t+3T/fXjysn1q9TrtWhqhCSUAAkMR2PUGzWoAkqCBJST+qF3r4ft5Wo8toyy77En/zQpoSRS
k/kaEH+mCoxyiQAARxcvDGHv7DnIbe1ekiQiUQ0uyIkEucJaAEAkUiLgwpzNvUDhyqa4sLiZ
cFHplBJxN41QNsWWOXDegTFFsMnkJixujI9QlOUMR1DxDopC/hVhentx//Gp2+rkG2IdksEH
nDioE4goqOxv7uQLUjiIE6Sf76AI/NPpAkBl1t8YYUb8Ao9lHyy2IyRjAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'BenjaminVanRyseghem 3/28/2014 17:48'!
classVarsUnselectedIconContents

	^ (Form
		extent: 24@24
		depth: 32
		fromArray: #(16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 258369126 1096440410 1952078426 2807716442 2807716442 1952078426 1096440410 258369126 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 106255701 2254134107 4217068379 4284177243 4284177243 4284177243 4284177243 4284177243 4284177243 4217068379 2254134107 106255701 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 811227738 3529202523 4284177243 4267926371 4286743170 4288059030 4289374890 4289374890 4288059030 4286743170 4267926371 4284177243 3529202523 811227738 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 811227738 4183513947 4284177243 4286282619 4289967027 4290427578 4290427578 4290427578 4290427578 4290427578 4290427578 4289967027 4286282619 4284177243 4183513947 811227738 16777215 16777215 16777215 16777215 16777215 16777215 16777215 106255701 3529202523 4284177243 4287861651 4290427578 4290427578 4290559164 4291677645 4292335575 4292861919 4292401368 4291546059 4290427578 4290427578 4287861651 4284177243 3529202523 106255701 16777215 16777215 16777215 16777215 16777215 16777215 2254134107 4284177243 4286151033 4290032820 4290032820 4291743438 4294440951 4294967295 4294967295 4294967295 4294967295 4294967295 4294243572 4290032820 4290032820 4286151033 4284177243 2254134107 16777215 16777215 16777215 16777215 16777215 258369126 4217002586 4267860578 4288980132 4289374890 4291611852 4294967295 4294967295 4294901502 4293190884 4292072403 4292467161 4293717228 4294638330 4289374890 4289374890 4288980132 4267860578 4217002586 258369126 16777215 16777215 16777215 16777215 1096440410 4284177243 4286019447 4288651167 4289506476 4294704123 4294967295 4294901502 4290230199 4288651167 4288651167 4288651167 4288651167 4290098613 4288651167 4288651167 4288651167 4286019447 4284177243 1096440410 16777215 16777215 16777215 16777215 1952078426 4284177243 4286545791 4287993237 4290690750 4294967295 4294967295 4292335575 4287993237 4287993237 4287993237 4287993237 4287993237 4287993237 4287993237 4287993237 4287993237 4286545791 4284177243 1952078426 16777215 16777215 16777215 16777215 2807716442 4284177243 4286808963 4287401100 4291677645 4294967295 4294967295 4290559164 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 4287401100 4286808963 4284177243 2807716442 16777215 16777215 16777215 16777215 2807716442 4284177243 4286282619 4286677377 4291414473 4294967295 4294967295 4290164406 4286677377 4286677377 4286677377 4286677377 4286677377 4286677377 4286677377 4286677377 4286677377 4286282619 4284177243 2807716442 16777215 16777215 16777215 16777215 1952078426 4284177243 4285295724 4286019447 4289506476 4294967295 4294967295 4291677645 4286019447 4286019447 4286019447 4286019447 4286019447 4286019447 4286019447 4286019447 4286019447 4285295724 4284177243 1952078426 16777215 16777215 16777215 16777215 1096440410 4284177243 4284966759 4286151033 4287203721 4294572537 4294967295 4294901502 4288585374 4286151033 4286151033 4286151033 4286151033 4288124823 4286151033 4286151033 4286151033 4284966759 4284177243 1096440410 16777215 16777215 16777215 16777215 258369126 4217002586 4267531613 4286151033 4286282619 4289572269 4294967295 4294967295 4294967295 4292467161 4290756543 4291414473 4293322470 4294440951 4286282619 4286282619 4286151033 4267531613 4217002586 258369126 16777215 16777215 16777215 16777215 16777215 2254134107 4284177243 4284966759 4286479998 4286479998 4289243304 4293848814 4294967295 4294967295 4294967295 4294967295 4294967295 4293454056 4286479998 4286479998 4284966759 4284177243 2254134107 16777215 16777215 16777215 16777215 16777215 16777215 106255701 3529202523 4284177243 4285624689 4286677377 4286677377 4286874756 4288651167 4289901234 4290756543 4290032820 4288519581 4286677377 4286677377 4285624689 4284177243 3529202523 106255701 16777215 16777215 16777215 16777215 16777215 16777215 16777215 811227738 4183513947 4284177243 4285098345 4286611584 4286808963 4286808963 4286808963 4286808963 4286808963 4286808963 4286611584 4285098345 4284177243 4183513947 811227738 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 811227738 3529202523 4284177243 4267597406 4285361517 4285953654 4286545791 4286545791 4285953654 4285361517 4267597406 4284177243 3529202523 811227738 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 106255701 2254134107 4217002586 4284177243 4284177243 4284177243 4284177243 4284177243 4284177243 4217002586 2254134107 106255701 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 258369126 1096440410 1952078426 2807716442 2807716442 1952078426 1096440410 258369126 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
		offset: 0@0)! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
paintIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAG2SURBVDjLY/j//z8DJZgsTUdm
CkodmSV7eO8EkQayNN8+WPry3YOV/3d2ib0nVbMsUPPrT8/3/n9+Nun/1hbxP6Rolr99sOTt
Z6DmD7cLwZrXVUt5kKb5xb7/P17U/b+4xu4/UHMRUYEI1KwK1PwOpvnSOgeQ5vlExQJQs8at
A8UfPr+EaL662QWk+diSPDlWnAZsWjufedOaORyHZ0lrgzR/ebkfrPnWbm+Q5odAzYJY0wFQ
I+OmtXN5N62ZVbJpzYzrB2bIfX5zaxJY86NjYSDN34CaVbEmpN4lK5hWrJonBtS8ddOaeT82
rZn9b8vSmn87u6X+393n///gdKP/QM3OOFNi95Jlks0Ll6+bOG/l//OXzv7/8+ny/09PD/zf
PD/vHtTmVJxJuXfxErbW+UuyG6Yu+T9t15X/rQt2/k/t2vK/ctKa/0Utk7YuyFeXxpsX6qcv
Xdswe/3/tpXH/neuv/a/cu7J/9E9V//7Fi57n1w+QY1gZsppnfMvqWb6/8iSyf8Dcyb8907r
+R+QO2tbbNHEIKJz46bF5SybFhVZbVqY17BpfqbEpnmpfJvmJfESYwAA/ZPGvT+K5AYAAAAA
SUVORK5CYII='! !

!ThemeIcons methodsFor: '*Tool-ConfigurationBrowser' stamp: 'tbn 6/19/2013 22:31'!
configIconLoaded 
	^ icons
			at: #'configIconLoaded'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self configIconLoadedContents readStream)   ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:31'!
smallUndoIcon
	"Private - Generated method"
	^ icons
			at: #'smallUndo'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallUndoIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:30'!
smallRightFlushIcon
	"Private - Generated method"
	^ icons
			at: #'smallRightFlush'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallRightFlushIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallBoldIcon
	"Private - Generated method"
	^icons
			at: #smallBoldIcon
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallBoldIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:33'!
traitRequiredMethodIcon
	^ icons
			at: #'traitRequiredMethodIcon'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self traitRequiredMethodIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
paintingIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/painting.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABUAAAAUCAMAAABVlYYBAAADAFBMVEX///+XAJYymJiXlgAQ
EBAhISEAAFPK/8oAMZcAMmUAMssAMfwAMTFlMQBlZAAAZJcAl5cAy5gA/JcxlwBklwDLAJf8
AJdkl5eYmJjLmAD8lwCXADGXAGSXAMuXAPwxl8oymP+YlzKXl2SXMQCXZACYMpeXZJcxypcy
/5eYywCX/AAyZZhkZJfKl5f/mJgxMAAyZQAxADAxAGUxAJcyMphkAJdkMpgAZTEAlzEAZWUA
l2QAyzIA/DEAy2QA/GTKypfL/5j/ypj//ZgxAMsxAPxkAMtkAPzLADHLAGT8ADH8AGQymDIy
mGRlmDJkl2TLAMrKAPz8AMr8APxlmMtkl/+Xl8qYmP/KlzHLl2X/lzL/l2QyMjIxZDExMWQx
ZGRlADFkMTFlAGRkMWTLMQDLZAD8MQD8ZAAAZcsAmMsAZPwAl/wAy8sA/MoAyvwA/PwyywAx
/ABlywBk/ADKMZfLZZf/Mpf/ZJdly5dk/5eXypeY/5jLygDK/AD8ygD8/ACYMjKYZDKYMmSX
ZGSXMcqXZcuXMv+XZP8xysoy/8syy/8y//+XyjGY/zKYy2WX/2TKl8rLy8vKmP/Kyv//mMr/
ysr/mP3/yv0xMcoxZMoyMv8yZf9kMcplZctkMv9kZP/KMTHKZDHKMWTLZWX/MjL/ZDL/MmT/
ZGQxyjEy/zIxymQy/2VkyjFl/zJly2Vk/2TKMcrLZcrKMv/KZP//Msr/ZMr/Mv3/ZP1ly8tk
/8pkyv9k//+XysqY/8qYy/+Y///KyjHL/zLLymXK/2T/yzL//TL/ymT//WRDQ0NkZDHc3NzK
/////crt7e0PAACXAAAADwBlAAAAAJcAAGV2dnaHh4eqqqq6urpVVVVlZWUAAA8AACFDAABT
AAAAAMsAANsAAO0AAPwAADEAAEMAhwAAlwAAqgAAuQAAywAA2wAA7QAA/ADLAADbAADtAAD8
AAAAQwAAUwAAZQAAdQAhAAAxAACqAAC5AAAAIQAAMQB1AACHAAAAAKoAALkAAHUAAIcAAAA+
ZgN8AAABAHRSTlP/////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////fvXo
qAAAAEFJREFUeF6t0LsNADAIQ0HYf1GPkZ8UKeDXxRW6BnBkmsSdNNNUTuVUTgserbi14VL1
fFG/DS6DL+BjaAeahNafDE0vk9OGbfiMAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloRecolorIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/haloRecolor.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQAQMAAAAlPW0iAAAABlBMVEX///8AAABVwtN+AAAA
KElEQVR4XmNAAAEGhgoG5g8MjB8YmBIYWBIYOBYwCDIwCDEwyCAUAQBsPgQaQ/Ai2wAAAABJ
RU5ErkJggg=='! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/14/2013 13:02'!
protocolPublicIcon
	^ self protocolNoneIcon ! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloCollapseIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/haloCollapse.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAAAoAAAAQAQMAAAAVsXwDAAAABlBMVEX///8AAABVwtN+AAAA
HklEQVR4XmNABnIMDPUMDIkNDAcboegxI0jEBqEEAJsXBuQ1QnVfAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:29'!
smallPrintIcon
	"Private - Generated method"
	^ icons
			at: #'smallPrint'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallPrintIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousMore
^ self icons
		at: #glamorousMore ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2130706432 4278190080 2130706432 0 4278190080 4278190080 0 2130706432 4278190080 2130706432 0 0 0 0 0 0 2130706432 4278190080 2130706432 0 4278190080 4278190080 0 2130706432 4278190080 2130706432 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: (0@0))]! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:34'!
userIcon
	"Private - Generated method"
	^icons 
		at: #userIcon
		ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self userIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallFontsIconContents
	"Private - Method generated with the content of the file /home/dgd/smallFonts.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABF0
RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAABw0lEQVR4nNWRP0xTURTGv3vP+8Pro9CqQ1Pw
34tplIGYgIZASZogFWpinEy0mGCJiX+Cg4uM3R1MHNwMMwMrcRAGFhwaEjVRQTSS1DQMbaWN
0tf77r0OakUWWDnJGb58J79zvhzg0BftFuPj03an5/XHI6erpdK6OAiA7xYVXZ8KtXW+Vu3W
44Ne8B+AOM8BgON2TOz10ulbbipzP7YX0IqQzNxJCOEnORlHiYx4JBpb3Sp+WgOAgbHJR4Lo
2U6j1nPy3MUnXV7vZScRn69sbMjWFqnFvWr52wspmrMA4IQjd/96vt94U1xfzRaW5nIqCOYs
27kSqltT/yLk85wxlmqPHiuRZS0C0Kbjjnh9yRMAEA5HKt2J/pnBzO1lTubV33HJawGGCsUx
KcR3JnFzp1YdFU3/LQOzouHYNABIKWY58esfVhYegOnnAKC15gBgAIBSavLr58LDrS8f3wHA
hdHsiAn7le123AAwo5TcNsgwvd7hs8ToGgAwzttSqbxBA+mJrNbqkuse6S5tvl8AgONnzueC
ps8CIcqxUz3Jxo/6U61UFyPq+1krvwyk8Bnnoer22iYAMADmn97v5fY+M4exfgFP/5Zri/7V
SwAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:25'!
testRedIconContents
    ^(Form
	extent: 12@12
	depth: 32
	fromArray:   #(16777215 16777215 16777216 1694498816 3003121664 3858759680 3858759680 3003121664 1694498816 16777216 16777215 16777215 16777215 436207616 3204448256 4278714882 4284227102 4288170056 4288367949 4285149489 4278846468 3204448256 436207616 16777215 16777216 3204448256 4281076491 4290205013 4292374383 4292968319 4293364619 4293364619 4291851380 4281997593 3204448256 16777216 1694498816 4279042562 4284494900 4291503654 4291636011 4292036680 4292902012 4293364619 4293364619 4292180345 4279305991 1694498816 3003121664 4282057218 4284878607 4291428352 4291428352 4291428352 4291564050 4292700264 4293364619 4293364619 4286988352 3003121664 3858759680 4281664516 4283830545 4291428352 4291428352 4291428352 4291428352 4291563022 4292901241 4293364619 4290076254 3858759680 3858759680 4281467908 4281407255 4290970114 4291428352 4291428352 4291428352 4291428352 4291968060 4292968319 4289878361 3858759680 3003121664 4281664259 4280686616 4285864217 4291428352 4291428352 4291428352 4291428352 4291567391 4292374383 4286131501 3003121664 1694498816 4278910976 4281668885 4282394921 4286522404 4290905606 4291428352 4291428352 4291371040 4290797664 4279305991 1694498816 16777216 3204448256 4280616197 4283310626 4284036919 4285612867 4287643969 4288889410 4288896092 4281471249 3204448256 16777216 16777215 436207616 3204448256 4278649089 4282782483 4284818982 4285409577 4283504664 4278780675 3204448256 436207616 16777215 16777215 16777215 16777216 1694498816 3003121664 3858759680 3858759680 3003121664 1694498816 16777216 16777215 16777215)
	offset: 0@0)! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:25'!
testNotRunIconContents
    ^(Form
	extent: 12@12
	depth: 32
	fromArray:  #(16777215 16777215 16777216 1694498816 3003121664 3858759680 3858759680 3003121664 1694498816 16777216 16777215 16777215 16777215 436207616 3204448256 4278584838 4282795590 4286348412 4286611584 4283848278 4278716424 3204448256 436207616 16777215 16777216 3204448256 4280295456 4287927444 4289967027 4290690750 4291217094 4291217094 4289703855 4281216558 3204448256 16777216 1694498816 4278782217 4283453520 4287664272 4287861651 4288848546 4290559164 4291217094 4291217094 4290032820 4279111182 1694498816 3003121664 4280756007 4282861383 4286743170 4286743170 4286743170 4287269514 4289967027 4291217094 4291217094 4285361517 3003121664 3858759680 4280492835 4282203453 4286743170 4286743170 4286743170 4286743170 4287137928 4290493371 4291217094 4288059030 3858759680 3858759680 4280361249 4280821800 4286479998 4286743170 4286743170 4286743170 4286743170 4288453788 4290690750 4287795858 3858759680 3003121664 4280492835 4280361249 4283716692 4286743170 4286743170 4286743170 4286743170 4287598479 4289967027 4284374622 3003121664 1694498816 4278650631 4280953386 4281874488 4284440415 4286545791 4286743170 4286743170 4287466893 4288585374 4279111182 1694498816 16777216 3204448256 4279834905 4282269246 4283256141 4284572001 4285822068 4286611584 4287203721 4280756007 3204448256 16777216 16777215 436207616 3204448256 4278519045 4281611316 4283387727 4283782485 4282203453 4278650631 3204448256 436207616 16777215 16777215 16777215 16777216 1694498816 3003121664 3858759680 3858759680 3003121664 1694498816 16777216 16777215 16777215)
	offset: 0@0)! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
objectsIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAInSURBVDjLhZPda9NQHIbzVwlW
ryzthpWuIpWOieKYZXO2q1vC0KFr9aZM3Yr40QunspU2TVYmYhVRvNErwQtR3E0JTq3G2o80
mc0Ql9dzTr/SYdnFA8k5yft78nLCjcxJNwKzsuoOiZoj2GKsi3NS1I7y4hIA7n9wgQvyz4Ki
WLphwNgyoRMq+jZ+MUyo1ToOR6Ra3wA6ua4b8F/2gL830WF8YRGB2VX4hBwOBEWrnxl3kGzQ
yXzyLJbfLuL+uwQevr+Jk7EsiBn2MmMBdbJ58UEEKx9vYfVDE89MBtTsTVjA53iiy/XbeD4X
RaluwhWSNRZQIYmeay6cSsYxfCmFwfMpEGW4wjk4gxm4J7IECd6IhOW7z/AlkYRaawXQbyuT
tCOJAQzPp/bU9gtrLOBHrUECJI3bP5bWypoJx7l9cE+tMO0TsTuIpl90uCq+xJnoEtP2hUV8
Cp7G90orwMECGthQd5gynRxLPUWuoOOR8huPN//gyde/iMuvmLZvKgtlfBTFdsBgSNwslavQ
iOIACaCF0ofzRQv5bzsd6BrV9obSyI8EUCw34JwkAcd4aWFoWn5N00ihFi30+HwaM5LCmM4U
GH5SLtX28uvMtlg2mwH2U9UuNHBlDUKu2ANdo9pDwjqqpNQSOwdyrSegXeih0Rh7wQ5da2lb
dDI5RBqxT/Qa2ArdUK1ddLV7/gX7jb1QzdhGjVAl10262n0D7IXSSbtpa9vf+QeB6/JTIb6V
uwAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
solidMenuIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/solidMenu.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAAA4AAAAQCAYAAAAmlE46AAAABHNCSVQFBQUBSsjp7wAAAE5J
REFUeF5jgACO/wykA5AmGCZGHVaNxGISNO648AO7RpAEIYxXI8lOJaSRIqeiaSbeRrwaSXAu
lZxKQsiSEh0oSY+cJEdissORGUjLWgBvFzCDqCcU6AAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:50'!
separatorIcon 
	^ icons
			at: #'separatorIcon'
			ifAbsentPut:[ self separatorIconContents ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:32'!
smallWarningIcon
	"Private - Generated method"
	^icons
			at: #smallWarningIcon
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallWarningIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloRotIcon
	"Private - Generated method"
	^ icons
			at: #'haloRot'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self haloRotIconContents readStream) ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallLockIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAJ/SURBVDjLbVJBaxNBGH2bpEkT
mxi1NTRKTZtoQUHEWz0Igj2I4kG9eVNQhEBO7bEHc+yv8JAiHnr2B4gFqVrQRhObljQolBST
JqZJdnZmfbNr2rU68DEz33zfm/fejGHbNrxjaWlpRCk1J6WcYZxkgPGTsWJZ1mIul/vlrTe8
AIVC4Qqbl5PJ5GQsFoPP5wP36PV6qNfr2OIg0L35+fm1fwDYPMLDj+l0OmOaJmq1Gjqdjr4d
gUAAiUTCqSsWixvMXV5YWOjqvW+AxOSz8fHxjBAC5XJ5s91up7gO6tDrUqn0QwOTXYZSsoO+
wGDB5EwkEkGlUgGb7mSz2apHajWfz9+sVqvFVCrl1P4PYExr5m16vYUjQ+c0O11DtmN/ebD9
5pG9UpnGzl7Y0Xz30ir8toAtLdiWG0JIvFi76piaGG7g9plVTD/5YLgMCPLg/g0YtMTwhznf
ApRBfsP6kAYJSKuN57Md5oXTsvHy7aEEfZMutHZfIRAahWGMsHAICMeZVsD+HmTrG8zudyhr
H+HJLGyz7wEgRSh9k4nm+nvqPIb4xWuovV5k/2lMXJ9F8+s6ARqIpk6QsIQtTC+AcGTYpBqf
vgBfcJTuKMi+xKfdMCZgIp6eRK8TYu2+w2oA4PwDm+5qVK218XmNLN7xxILqKfS7pGqTWekL
muVtV65STs8hA73RqJQQP5+CP3KKACamHj7FlGBDawfH00kEW0MuA8o9AmA6qMrSHqwTIAoM
08hAkHkN0ES3UYfotBGdiNFu5cr2AmgJobOPET7nhxEMuU/o40soSjO7iHbbVNgnUen6pY0/
AOCTbC7PuV44H0f8Cetg5g9zP5aU7loDcfwGcrKyzYdvwUUAAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousZoomIn
^ self icons
		at: #glamorousZoomIn ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1644167168 3036676096 3640655872 3640655872 3036676096 1644167168 0 0 0 0 0 0 0 0 419430400 3120562176 2600468480 637534208 16777216 16777216 637534208 2600468480 3120562176 419430400 0 0 0 0 0 0 3120562176 1409286144 0 0 0 0 0 0 1409286144 3120562176 0 0 0 0 0 1644167168 2600468480 0 0 0 4278190080 4278190080 0 0 0 2600468480 1644167168 0 0 0 0 3036676096 637534208 0 0 0 4278190080 4278190080 0 0 0 637534208 3036676096 0 0 0 0 3640655872 16777216 0 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 0 16777216 3640655872 0 0 0 0 3640655872 16777216 0 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 0 16777216 3640655872 0 0 0 0 3036676096 637534208 0 0 0 4278190080 4278190080 0 0 0 637534208 3036676096 0 0 0 0 1644167168 2600468480 0 0 0 4278190080 4278190080 0 0 0 2600468480 1644167168 0 0 0 0 0 3120562176 1409286144 0 0 0 0 0 0 1409286144 3120562176 0 0 0 0 0 0 419430400 3120562176 2600468480 637534208 16777216 16777216 637534208 2600468480 3120562176 419430400 0 0 0 0 0 0 0 0 1644167168 3036676096 3640655872 3640655872 3036676096 1644167168 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: (0@0))]! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'TudorGirba 2/20/2015 07:33'!
glamorousDiveAllRightIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAAXNSR0IArs4c6QAAAAlwSFlz
AAALEwAACxMBAJqcGAAAAdVpVFh0WE1MOmNvbS5hZG9iZS54bXAAAAAAADx4OnhtcG1ldGEg
eG1sbnM6eD0iYWRvYmU6bnM6bWV0YS8iIHg6eG1wdGs9IlhNUCBDb3JlIDUuNC4wIj4KICAg
PHJkZjpSREYgeG1sbnM6cmRmPSJodHRwOi8vd3d3LnczLm9yZy8xOTk5LzAyLzIyLXJkZi1z
eW50YXgtbnMjIj4KICAgICAgPHJkZjpEZXNjcmlwdGlvbiByZGY6YWJvdXQ9IiIKICAgICAg
ICAgICAgeG1sbnM6dGlmZj0iaHR0cDovL25zLmFkb2JlLmNvbS90aWZmLzEuMC8iPgogICAg
ICAgICA8dGlmZjpDb21wcmVzc2lvbj41PC90aWZmOkNvbXByZXNzaW9uPgogICAgICAgICA8
dGlmZjpQaG90b21ldHJpY0ludGVycHJldGF0aW9uPjI8L3RpZmY6UGhvdG9tZXRyaWNJbnRl
cnByZXRhdGlvbj4KICAgICAgICAgPHRpZmY6T3JpZW50YXRpb24+MTwvdGlmZjpPcmllbnRh
dGlvbj4KICAgICAgPC9yZGY6RGVzY3JpcHRpb24+CiAgIDwvcmRmOlJERj4KPC94OnhtcG1l
dGE+CrDjMt0AAADQSURBVDgRY2AYBQRDYPLkyV+BOByXQiZcEjDx////cwHZM6dOndq9atUq
Zpg4jCZoAEgh0BD+f//+pbx8+XLfnDlzhGCaQTQjMgfo1H9AxShijIyMQCGIGJD9Daj+IzMz
s0dWVtYlkF4UF8AUIhuKLAZkg7wj9ufPn/0wNSgGgGyDScBoZDGoC16xsLA4wuVhDFz0pEmT
YIZ+ABpwmZOTMyAlJeUdTD0LjIGPBmr8yMTENAfo73Ig+x+yWhQvIEvA2FBnp2dnZ5eia4ap
GeI0AGHLRub8J5JuAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:25'!
traitIconContents
    ^(Form
	extent: 12@12
	depth: 32
	fromArray:  #(16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 201326592 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 50331648 2734686208 16777215 16777215 855638016 1224736768 1023410176 838860800 1174405120 1207959552 1191182336 1895825408 2181038080 704643072 33554432 2399141888 1409286144 201326592 16777215 83886080 3640655872 922746880 16777215 16777215 16777215 16777215 1426063360 503316480 16777215 16777215 16777215 1862270976 2483027968 16777215 16777215 16777215 16777215 16777215 1258291200 16777215 16777215 16777215 318767104 3556769792 234881024 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2516582400 1476395008 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 788529152 3254779904 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777216 3238002688 905969664 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1610612736 2801795072 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 67108864 3892314112 1258291200 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2147483648 1862270976 788529152 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: 0@0)! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallForwardIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAADvSURBVDjLY/z//z8DJYCJgUIw
xAwImOWx22uSExvZBvz68cvm5/dfV5HFGEGxUHoiExwVf//8Zfjz+w/D719/GH79/A3UAMK/
GH4CMYiWFJJk+PXrN8PN27cunWq/oA/SwwIzyUrYluHvP6AB//7A8e+/f4H4N8Pvf0D8Fyb2
h+HLl696WllqJ69Nu2XOArMZpBCuGajoN1jxbwT9FyH36/dvkCt/w10Acvb+h3uxOhvoZzCb
i4OLQVJSiuH1q9cMt2/cvXB7zj0beBgQAwwKtS2AFuwH2vwIqFmd5Fi40H/1BFDzQaBrdTFi
YYTnBQAI58A33Wys0AAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallSaveAsIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAA
CXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1QsKDTgPGbLEcAAAAIx0RVh0Q29tbWVudABN
ZW51LXNpemVkIGljb24KPT09PT09PT09PQoKKGMpIDIwMDMgSmFrdWIgJ2ppbW1hYycgU3Rl
aW5lciwgCmh0dHA6Ly9qaW1tYWMubXVzaWNoYWxsLmN6CgpjcmVhdGVkIHdpdGggdGhlIEdJ
TVAsCmh0dHA6Ly93d3cuZ2ltcC5vcmdnisdHAAACV0lEQVQ4y52ST0iTYRzHP+/b/DNz8s7h
a1q2iZpIHSI0tgQND2mQROEhhMQiqFiNeepgYR4MIQPxIEWHpCCEFQVF3SKhg2Z5KLKDmmhZ
huRwbqXb3vfXYbYSLcjP6XmeL8+H7/PjUc51XLg4Fc5X5+ajC0ABUAfsTFFl2Zb+/VtWWrSv
v/NKK39BqfH3NLl2lLmcufrk7sIcv9Nu3ROJG4x+WeT10IA59nGWUvub7b3td2fWFXjbOntj
obmzcVGZNTR+pOWwyZJCY+0+ivKz6b7/AuPTCK7U+fXut+Nt8cn05wkREZmYGpWh0Qnx3Xgi
7tNXJTA8LT1P30rDpZvybnJG/iQcDovP7xVLmsVga66LYDCIlpmLqixglSgAI+Oz6JkWvs4v
8n7iA1uyrKAACKmpqQBY4jEQUzBMk/rWW2s6Dk0GicUNugKDdAUGAXjccQIkkasAppiYhknP
GQ8AzceO4HGXs7QUIc+mUumuoKmhHoDjNcWYhomI/BaICHa7Rn6Oi2unyunrf0CpqwAVBRUF
d5mT2/ce0VhdyOHKCjI2Z6wWAITDYXRdx5lXkpR4dhVR4tpG952HNFYXcrTKja7rRKPR5BMt
AKZpEolEANB1HV3X6T1vpeV6gOWYwcnaMpoPHUBVVUKhEJFIBJvNlvgHPr9XKsr3IqwM+D8Y
fvUy0cDjrgSRFYOSmLAiIMrKNqEvKS5mfHwMQUH5U+BwOHg+8CwZCLKmzf6qGgCyHQ4QJZlb
ADRNIz3d+s+6ml0DwK7ZV51bfi3qag+yERSf33sZaGNjtP8Elb70qz97tp0AAAAASUVORK5C
YII='! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallSystemBrowserIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAQAAAC1+jfqAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAACoSURBVCjPY/jPAIMMCgxmYKiA
EAOKwhmMDGZ//v/5/+M/qhI0BW/+gxQBlTDiUPDl/3v8Cn7//4VfwR/cVkB8kfI27S0WR+7r
m/ui70X7i9YX88O7whtflANh7ouUPqgCBsbZLyBGAq1hRLBiX4BZiODBxgIpgAWPOYM/Bguk
GCl4En9jsswYkIIHKIzBgiiABg9QGINlxoAUPEBhDJYZwhdmDDZYWAoAtTEEdnXdy7IAAAAA
SUVORK5CYII='! !

!ThemeIcons methodsFor: 'private - utilities' stamp: 'EstebanLorenzano 5/10/2013 14:38'!
storeIconMethodFor: each
	| base64 selector source |
	
	base64 := self base64ContentsOfFileNamed: each fullName.
	selector := (each asFileReference base, 'IconContents') asSymbol.
	source := '{1}
	"Private - Method generated"
	^ ''{2}''' format: {selector. base64}.
	
	self class 
		compile: source 
		classified: 'private - contents'! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
confirmIcon
	"Private - Generated method"
	^ icons
			at: #'confirm'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self confirmIconContents readStream) ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'SebastianTleye 8/22/2013 13:48'!
traitRequiredMethodIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAAAwAAAAMCAYAAABWdVznAAAEJGlDQ1BJQ0MgUHJvZmlsZQAA
OBGFVd9v21QUPolvUqQWPyBYR4eKxa9VU1u5GxqtxgZJk6XtShal6dgqJOQ6N4mpGwfb6baq
T3uBNwb8AUDZAw9IPCENBmJ72fbAtElThyqqSUh76MQPISbtBVXhu3ZiJ1PEXPX6yznfOec7
517bRD1fabWaGVWIlquunc8klZOnFpSeTYrSs9RLA9Sr6U4tkcvNEi7BFffO6+EdigjL7ZHu
/k72I796i9zRiSJPwG4VHX0Z+AxRzNRrtksUvwf7+Gm3BtzzHPDTNgQCqwKXfZwSeNHHJz1O
IT8JjtAq6xWtCLwGPLzYZi+3YV8DGMiT4VVuG7oiZpGzrZJhcs/hL49xtzH/Dy6bdfTsXYNY
+5yluWO4D4neK/ZUvok/17X0HPBLsF+vuUlhfwX4j/rSfAJ4H1H0qZJ9dN7nR19frRTeBt4F
e9FwpwtN+2p1MXscGLHR9SXrmMgjONd1ZxKzpBeA71b4tNhj6JGoyFNp4GHgwUp9qplfmnFW
5oTdy7NamcwCI49kv6fN5IAHgD+0rbyoBc3SOjczohbyS1drbq6pQdqumllRC/0ymTtej8gp
bbuVwpQfyw66dqEZyxZKxtHpJn+tZnpnEdrYBbueF9qQn93S7HQGGHnYP7w6L+YGHNtd1FJi
tqPAR+hERCNOFi1i1alKO6RQnjKUxL1GNjwlMsiEhcPLYTEiT9ISbN15OY/jx4SMshe9LaJR
pTvHr3C/ybFYP1PZAfwfYrPsMBtnE6SwN9ib7AhLwTrBDgUKcm06FSrTfSj187xPdVQWOk5Q
8vxAfSiIUc7Z7xr6zY/+hpqwSyv0I0/QMTRb7RMgBxNodTfSPqdraz/sDjzKBrv4zu2+a2t0
/HHzjd2Lbcc2sG7GtsL42K+xLfxtUgI7YHqKlqHK8HbCCXgjHT1cAdMlDetv4FnQ2lLasaOl
6vmB0CMmwT/IPszSueHQqv6i/qluqF+oF9TfO2qEGTumJH0qfSv9KH0nfS/9TIp0Wboi/SRd
lb6RLgU5u++9nyXYe69fYRPdil1o1WufNSdTTsp75BfllPy8/LI8G7AUuV8ek6fkvfDsCfbN
DP0dvRh0CrNqTbV7LfEEGDQPJQadBtfGVMWEq3QWWdufk6ZSNsjG2PQjp3ZcnOWWing6noon
SInvi0/Ex+IzAreevPhe+CawpgP1/pMTMDo64G0sTCXIM+KdOnFWRfQKdJvQzV1+Bt8Ookmr
dtY2yhVX2a+qrykJfMq4Ml3VR4cVzTQVz+UoNne4vcKLoyS+gyKO6EHe+75Fdt0Mbe5bRIf/
wjvrVmhbqBN97RD1vxrahvBOfOYzoosH9bq94uejSOQGkVM6sN/7HelL4t10t9F4gPdVzydE
Ox83Gv+uNxo7XyL/FtFl8z9ZAHF4bBsrEwAAAHhJREFUKBWVkYsNwCAIREvThWQPh3IlB2Gl
tme8BLSalMTw8R4YlPu144dJSikAZrbFxU9Q1SbeQadvRyFBf8c4ACgSomD011hgvpqyBEop
ZIOfAN855xzELcGWaFgxTq2VpclP/4CnfHbuswTd/NydGLrwcR5cxQ/k/k4ULuy+OgAAAABJ
RU5ErkJggg=='! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 13:55'!
emptyIcon 
	^ icons
			at: #'emptyIcon'
			ifAbsentPut: [ self blankIconContents ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
scriptManagerIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAJ+SURBVBgZBcExbFRlAADg7//f
u7teC3elQEoMgeDkYDQ6oMQQTYyGxMHZuDA6Ypw0cWI20cHJUdl0cJLIiomR6OACGhUCpqGW
tlzbu/b97/3v9/tCKQVc/e7RRXz+7OrSpUXbW7S9tu8ddv0M+3iCjF1s42v8WAP0XffKi2eO
Xfro9dMAYJ766SL1092jfDa17DfZgycHfvh7/hau1QB9161PhgE8epoNQlAHqprRIDo3iqoY
DSpeOjv2zHRl7atfNj6LALltJys1Xc9+CmYtTxtmR8yO2D7kv4MMPr7x0KULK54/NThdA+S2
XTs+jOYN86MsxqBGVRErKkEV6BHynp//2fXbw9lGDZBTWp+OK7PDzqIpYiyqSMxBFakUVYVS
2dxrfHHrrz1crQG6lM6vTwZmR0UHhSoHsSBTKeoS9YU8yLrUXfj+w9d2IkBOzfkz05F5KkKk
CkFERACEQil0TSOnJkMNV67fHNdVHI4GUcpZVFAUZAEExEibs4P5osMeROiadHoUiIEeCgFR
EAoRBOMB2weNrkmbNz+9UiBCTs1yrVdHqhgIkRL0EOj7QGG5jrZ2D+XUbADEy9dunOpSun7x
uXMe7xUPNrOd/WyeyKUIoRgOGS8xWWZ7b6FLaROgzim9iXd+vXvf7mHtoCnaXDRtkLpel3t9
KdamUx+8fcbj7YWc0hZAndv25XffeGH8yfuvAoBcaHOROhS+vLlhecD+wUJu222AOrft/cdP
Zr65ddfqsbHVyZLVlZHpysjx5aHRMBrV0XuX141qtnb25bb9F6Duu+7b23funb195955nMRJ
nMAJTJeGg8HS0sBkZWx1suz3Px79iZ8A/gd7ijssEaZF9QAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousInspect
^ self icons
		at: #glamorousInspect ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777216 4009754624 2566914048 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 167772160 4278190080 4009754624 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 117440512 33554432 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2147483648 2785017856 2348810240 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 67108864 4278190080 3741319168 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3489660928 3741319168 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3489660928 3741319168 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3489660928 3741319168 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2566914048 4278190080 4278190080 2785017856 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
transcriptIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAQAAAC1+jfqAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAADPSURBVCjPdZFNCsIwEEZHPYdS
z1DaHsMzuPM6RRcewSO4caPQ3sBDKCK02p+08DmZtGkKlQ+GhHm8MBmiFQUU2ng0B7khClTd
QqdBiX1Ma1qMgbDlxh0XnJHiit2JNq5HgAo3KEx7BFAM/PMI0CDB2KNvh1gjHZBi8OR448Gn
AkeNDEDvKZDh2Xl4cBcwtcKXkZdYLJBYwCCFPDRpMEjNyKcDPC4RbXuPiWKkNABPOuNhIteg
z0pGFkD+y3p0s48DDB43dU7+eLWes3gdn5Y/LD9Y6skuWXcAAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousOver
^ self icons
		at: #glamorousOver ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1258291200 251658240 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4043309056 1509949440 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4093640704 3355443200 587202560 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 4194304000 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4093640704 3355443200 570425344 16777215 16777215 16777215 16777215 4261412864 4278190080 4278190080 4278190080 4278190080 4261412864 16777215 4278190080 4026531840 1509949440 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 1258291200 251658240 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4261412864 4278190080 4278190080 4278190080 4278190080 4261412864 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
lockIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAJ/SURBVDjLbVJBaxNBGH2bpEkT
mxi1NTRKTZtoQUHEWz0Igj2I4kG9eVNQhEBO7bEHc+yv8JAiHnr2B4gFqVrQRhObljQolBST
JqZJdnZmfbNr2rU68DEz33zfm/fejGHbNrxjaWlpRCk1J6WcYZxkgPGTsWJZ1mIul/vlrTe8
AIVC4Qqbl5PJ5GQsFoPP5wP36PV6qNfr2OIg0L35+fm1fwDYPMLDj+l0OmOaJmq1Gjqdjr4d
gUAAiUTCqSsWixvMXV5YWOjqvW+AxOSz8fHxjBAC5XJ5s91up7gO6tDrUqn0QwOTXYZSsoO+
wGDB5EwkEkGlUgGb7mSz2apHajWfz9+sVqvFVCrl1P4PYExr5m16vYUjQ+c0O11DtmN/ebD9
5pG9UpnGzl7Y0Xz30ir8toAtLdiWG0JIvFi76piaGG7g9plVTD/5YLgMCPLg/g0YtMTwhznf
ApRBfsP6kAYJSKuN57Md5oXTsvHy7aEEfZMutHZfIRAahWGMsHAICMeZVsD+HmTrG8zudyhr
H+HJLGyz7wEgRSh9k4nm+nvqPIb4xWuovV5k/2lMXJ9F8+s6ARqIpk6QsIQtTC+AcGTYpBqf
vgBfcJTuKMi+xKfdMCZgIp6eRK8TYu2+w2oA4PwDm+5qVK218XmNLN7xxILqKfS7pGqTWekL
muVtV65STs8hA73RqJQQP5+CP3KKACamHj7FlGBDawfH00kEW0MuA8o9AmA6qMrSHqwTIAoM
08hAkHkN0ES3UYfotBGdiNFu5cr2AmgJobOPET7nhxEMuU/o40soSjO7iHbbVNgnUen6pY0/
AOCTbC7PuV44H0f8Cetg5g9zP5aU7loDcfwGcrKyzYdvwUUAAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:53'!
uncommentedClassIcon 
	^ icons
			at: #'uncommentedClassIcon'
			ifAbsentPut:[ self uncommentedClassIconContents ].! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:25'!
testYellowIconContents
    ^(Form
	extent: 12@12
	depth: 32
	fromArray:  #(16777215 16777215 16777216 1694498816 3003121664 3858759680 3858759680 3003121664 1694498816 16777216 16777215 16777215 16777215 436207616 3204448256 4278782211 4285164839 4289375827 4289572953 4286020153 4278913797 3204448256 436207616 16777215 16777216 3204448256 4281545744 4291612771 4293915774 4294376077 4294705048 4294705048 4293191809 4282467102 3204448256 16777216 1694498816 4279176964 4285164603 4293850685 4294047809 4294113371 4294376074 4294705048 4294705048 4293521030 4279505928 1694498816 3003121664 4282862090 4286151963 4294377244 4294377244 4294377244 4294311212 4294376312 4294705048 4294705048 4288059722 3003121664 3858759680 4282335499 4284835867 4294377244 4294377244 4294377244 4294377244 4294311465 4294376327 4294705048 4291349354 3858759680 3858759680 4282072330 4281808922 4293785117 4294377244 4294377244 4294377244 4294377244 4294113616 4294376077 4291218021 3858759680 3003121664 4282467082 4280887578 4287204646 4294377244 4294377244 4294377244 4294377244 4294113847 4293915774 4287270200 3003121664 1694498816 4279111170 4282137882 4282795820 4287862577 4293653536 4294377244 4294377244 4293784887 4292139373 4279505928 1694498816 16777216 3204448256 4281019657 4283914536 4284506684 4286283082 4288783436 4290362703 4289836389 4282006550 3204448256 16777216 16777215 436207616 3204448256 4278716418 4283519770 4285756975 4286415155 4284375328 4278848004 3204448256 436207616 16777215 16777215 16777215 16777216 1694498816 3003121664 3858759680 3858759680 3003121664 1694498816 16777216 16777215 16777215)
	offset: 0@0)! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamourousNextProduction
^ self icons
		at: #glamourousNextProduction ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1224736768 1392508928 1392508928 1392508928 1023410176 33554432 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3808428032 3640655872 3254779904 3254779904 3707764736 3841982464 1224736768 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3808428032 1593835520 16777215 16777215 16777215 2852126720 3204448256 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3808428032 1593835520 16777215 16777215 16777215 1375731712 4110417920 50331648 1593835520 2164260864 2231369728 3238002688 16777215 16777215 16777215 16777215 3808428032 1627389952 50331648 50331648 738197504 3170893824 2835349504 16777215 1979711488 4060086272 2885681152 1124073472 16777215 16777215 16777215 16777215 3808428032 4278190080 4278190080 4278190080 4244635648 3422552064 687865856 16777215 1979711488 3791650816 16777216 16777215 16777215 16777215 16777215 16777215 3808428032 1744830464 234881024 234881024 100663296 16777215 16777215 16777215 1979711488 2919235584 16777215 16777215 16777215 16777215 16777215 16777215 3808428032 1593835520 16777215 16777215 16777215 16777215 16777215 16777215 1979711488 2902458368 16777215 16777215 16777215 16777215 16777215 16777215 3808428032 1593835520 16777215 16777215 16777215 16777215 16777215 16777215 1979711488 2902458368 16777215 16777215 16777215 16777215 16777215 16777215 3808428032 1593835520 16777215 16777215 16777215 16777215 16777215 16777215 1979711488 2902458368 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:15'!
icons
	^ icons! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloFontSizeIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/haloFontSize.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQAQMAAAAlPW0iAAAABlBMVEX///8AAABVwtN+AAAA
IElEQVR4XmNAgA8MDA1QxNfAwPGAgaOBgacBRAIRDAAAkngGC2jZE2AAAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 13:55'!
backIcon
	"Private - Generated method"
	^ icons
			at: #'back'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self backIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Tool-ConfigurationBrowser' stamp: 'tbn 6/19/2013 22:30'!
configIcon 
	^ icons
			at: #'configIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self configIconContents readStream)   ].! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:46'!
greenArrowUpAndDownIcon 
	^ icons
			at: #'greenArrowUpAndDownIcon'
			ifAbsentPut:[ self greenArrowUpAndDownIconContents ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallDebugItIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAALRSURBVDjLfVNbSJNhGP6li24C
6UIiDHWah83UdJv7d7R5oiiPWGp5yIUHNNF0acNjrmWe5gx1Ujmd+pubW8upaSWZRilZdhN0
0WVBEAgalSK5p18hczm7eOF7eb/neZ/n/d6PAEDsFWETAoSN8aWbZ/EDXqLIFLr67x27RPpU
6LUzl1hJiC08a7461lNo4GYLBjnf/ktwYrPjOF/+JxeZeWtCY+hSTk00FX9TsCroZttSrggb
9iSQjJLL4hFybUuyiVwRDHHBpzjg6zmoni3B7CcLrjVnIiY75KpDAtqnVDQcComBXD5tioL5
vQ6THwagfqFCQKsfMifiYJzXIrjlGI43+CNQxaK7jpArtM9t77RPWxjFx9CiBjcey1BhTUGZ
9SIkWhIBDUzIBpIRGe/zcVsB7XOd9gnBfW6fhCK/njPHg3rTgtrxDJSa45DeH45UYwIMC3fQ
Ma1GoJIJYaq3xc4Cf4AzR+rZIHVsmN61o3osDSWmWKTrpUgejEXXjAoF/SSye4IRVMMCS+Hz
nVnmXWg3A/Ieey3VkIjmqUIUG2OQ1hOOpL4z6JxWorA/AZd6QnB99DySu/zAlB+1+RZ7weey
598B8jpCfuSZZWh7Vo703kgUUWIaSCKXVpbVHYRKy1kYF9ogH45DVOuhDXHTwQNeOR6V2wSC
29z6kOYA1I2XI0kXQ0vm4eFiJ8xv27eAQwsaaKbk0M81Io+KBrd+/0aA0snZ7hnZ9UEzXnIP
dD9vpyUHb4HVT4rQMFkA1aMc1I5m0Q1y0TWrRFqvCN41xK9d+x9YwZoJVLBw4S4ThtcaUPMt
0L9qhO7lLZokH9rZOuRQJ8GoIpZcFcRxh5/Iv9RHn6Bl4FSbKyJaXSBsckZGjwCdM7WQ9UfD
vYr4clhBsHZtoqPwzHKfY2S4wV/p9DNTHwH3CuIzDfZ1uMp7hXvqkXVGpZPNrWIfXBQEY2ft
N8xTb5GsXWfEAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
scriptManagerIcon
	"Private - Generated method"
	^ icons
			at: #'scriptManagerIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self scriptManagerIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:31'!
smallSaveIcon
	"Private - Generated method"
	^ icons
			at: #'smallSave'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallSaveIconContents readStream) ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'BenjaminVanRyseghem 12/5/2013 12:33'!
partialCheckedBoxIconContents

	^ #(4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4292211711 4292211711 4292211711 4292211711 4292211711 4292211711 4292211711 4292211711 4292211711 4292211711 4287338155 4287338155 4292211711 4293655039 4293655039 4293655039 4293655039 4293655039 4293655039 4293655039 4293655039 4293655039 4287338155 4287338155 4292211711 4293720831 4293720831 4293720831 4293720831 4293720831 4293720831 4293720831 4293720831 4293720831 4287338155 4287338155 4292211711 4293852159 4293852159 4293852159 4293852159 4293852159 4293852159 4293852159 4293852159 4293852159 4287338155 4287338155 4292211711 4286945709 4284051852 4284051852 4284051852 4284051852 4284051852 4284051852 4286945709 4294048767 4287338155 4287338155 4292211711 4287011245 4284051852 4284051852 4284051852 4284051852 4284051852 4284051852 4287077037 4294180095 4287338155 4287338155 4292211711 4294376959 4294376959 4294376959 4294376959 4294376959 4294376959 4294376959 4294376959 4294376959 4287338155 4287338155 4292211711 4294573567 4294573567 4294573567 4294573567 4294573567 4294573567 4294573567 4294573567 4294573567 4287338155 4287338155 4292211711 4294639615 4294639615 4294639615 4294639615 4294639615 4294639615 4294639615 4294639615 4294639615 4287338155 4287338155 4292211711 4294770687 4294770687 4294770687 4294770687 4294770687 4294770687 4294770687 4294770687 4294770687 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155 4287338155)! !

!ThemeIcons methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 6/25/2013 17:56'!
deleteIcon 
	^ icons
			at: #'deleteIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self deleteIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousThrough
^ self icons
		at: #glamorousThrough ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4261412864 4278190080 4261412864 16777215 16777215 16777215 16777215 16777215 16777215 1258291200 251658240 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4009754624 1459617792 16777215 16777215 16777215 16777215 4261412864 4278190080 4261412864 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4076863488 3254779904 536870912 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 4177526784 3992977408 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4076863488 3238002688 536870912 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4009754624 1442840576 16777215 16777215 16777215 16777215 4261412864 4278190080 4261412864 16777215 16777215 16777215 16777215 16777215 16777215 1258291200 251658240 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4261412864 4278190080 4261412864 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
imageIcon
	"Private - Generated method"
	^ icons
			at: #'image'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self imageIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'BenjaminVanRyseghem 3/28/2014 17:47'!
classVarsPressedIconContents

	^ (Form
		extent: 24@24
		depth: 32
		fromArray: #(16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 252802884 1091859003 1947497019 2803135292 2803135292 1947497019 1091859003 252802884 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 100696107 2249552445 4212421692 4279530300 4279530300 4279530300 4279530300 4279530300 4279530300 4212421692 2249552445 100696107 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 806712634 3524621117 4279530300 4263606851 4283405660 4285441644 4287412092 4287412092 4285441644 4283405660 4263606851 4279530300 3524621117 806712634 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 806712634 4178867004 4279530300 4282748758 4288331652 4288988553 4288988553 4288988553 4288988553 4288988553 4288988553 4288331652 4282748758 4279530300 4178867004 806712634 16777215 16777215 16777215 16777215 16777215 16777215 16777215 100696107 3524621117 4279530300 4285113450 4288988553 4288988553 4289251214 4290631081 4291485115 4292142279 4291616445 4290499751 4289054090 4288988553 4285113450 4279530300 3524621117 100696107 16777215 16777215 16777215 16777215 16777215 16777215 2249552445 4279530300 4282551637 4288397444 4288397444 4290696879 4294244593 4294967295 4294967295 4294967295 4294967295 4294967295 4293981933 4288397444 4288397444 4282551637 4279530300 2249552445 16777215 16777215 16777215 16777215 16777215 252802884 4212421436 4263475522 4286886519 4287412091 4290434224 4294967295 4294967295 4294901502 4292536533 4291091131 4291616709 4293324771 4294507511 4287412091 4287412091 4286886519 4263475522 4212421436 252802884 16777215 16777215 16777215 16777215 1091859003 4279530300 4282420050 4286492274 4287608964 4294638841 4294967295 4294835965 4288594581 4286492274 4286492274 4286492274 4286492274 4288397458 4286492274 4286492274 4286492274 4282420050 4279530300 1091859003 16777215 16777215 16777215 16777215 1947497019 4279530300 4283273816 4285506921 4289185956 4294967295 4294967295 4291354054 4285506921 4285506921 4285506921 4285506921 4285506921 4285506921 4285506921 4285506921 4285506921 4283273816 4279530300 1947497019 16777215 16777215 16777215 16777215 2803135292 4279530300 4283668058 4284521824 4290434490 4294967295 4294967295 4288857762 4284521824 4284521824 4284521824 4284521824 4284521824 4284521824 4284521824 4284521824 4284521824 4283668058 4279530300 2803135292 16777215 16777215 16777215 16777215 2803135292 4279530300 4282879827 4283536471 4290040247 4294967295 4294967295 4288332189 4283536471 4283536471 4283536471 4283536471 4283536471 4283536471 4283536471 4283536471 4283536471 4282879827 4279530300 2803135292 16777215 16777215 16777215 16777215 1947497019 4279530300 4281434695 4282551118 4287346835 4294967295 4294967295 4290368702 4282551118 4282551118 4282551118 4282551118 4282551118 4282551118 4282551118 4282551118 4282551118 4281434695 4279530300 1947497019 16777215 16777215 16777215 16777215 1091859003 4279530300 4280778307 4282617166 4284128100 4294376183 4294967295 4294901502 4286033279 4282617166 4282617166 4282617166 4282617166 4285441911 4282617166 4282617166 4282617166 4280778307 4279530300 1091859003 16777215 16777215 16777215 16777215 252802884 4212421436 4263015742 4282551886 4282749007 4287412882 4294967295 4294967295 4294901758 4291420108 4289055146 4289974967 4292668126 4294244597 4282749007 4282749007 4282551886 4263015742 4212421436 252802884 16777215 16777215 16777215 16777215 16777215 2249552445 4279530300 4280647235 4282880848 4282880848 4286756488 4293390824 4294967295 4294967295 4294967295 4294967295 4294967295 4292865249 4282880848 4282880848 4280647235 4279530300 2249552445 16777215 16777215 16777215 16777215 16777215 16777215 100696107 3524490044 4279530300 4281567305 4283012690 4283012690 4283341143 4285902715 4287676309 4288989864 4287873433 4285705593 4283078227 4283012690 4281567305 4279530300 3524490044 100696107 16777215 16777215 16777215 16777215 16777215 16777215 16777215 806712634 4178867004 4279530300 4280778820 4282881617 4283144531 4283144531 4283144531 4283144531 4283144531 4283144531 4282881617 4280778820 4279530300 4178867004 806712634 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 806712634 3524490044 4279530300 4263081534 4281041990 4281896267 4282684752 4282684752 4281896267 4281041990 4263081534 4279530300 3524490044 806712634 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 100696107 2249552445 4212421436 4279530300 4279530300 4279530300 4279530300 4279530300 4279530300 4212421436 2249552445 100696107 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 252802884 1091859003 1947497019 2803135292 2803135292 1947497019 1091859003 252802884 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
		offset: 0@0)! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallDoItIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAIMSURBVDjLpVNLaxNRFP6STmaK
dFqrgYKWlGLSgoiKCwsKVnFRtBsVUSTNyj/gxv4Bl678AyKCoCulgmtd+W7romgzKT4QMW1G
+5hMpnPnnuuZm6ZNawoVBw7n3pn5vvP4zkkopfA/j9F8cafO3FekCjGpIgKIvayftTXOkr71
jkz2/UXA4HxXfz72gIx/lBsWSfiVtwiWHK8B3kRQeX/6lmnnkuDAwn0MJSKQEFChQCp9CcHi
xxgsGWw3B01uRKfx9t1HIP1POpoSdUulLyD0vqO26IAkDW7tgSZYeHPqcmpXxkTChKzOaAKS
Edo6jnEWVY5ehFxdHs2cn55rScDR73H6DKyyRWs1R0haGdR+z8YZ3MyMTj9rpUKi/PLkUJuZ
fmX3nkNYmQBxzYprpyCA2XMRrvNAcdfDhgKkm6ttKTdW6jH4w4RpD/ALAaNzhH2kSwALoSJC
d9+VhIqEVVeD4C1MclaOT0Ke0Cowq+X9eLHapLH23f1XreDzI27LfqT2HIfvzsRAyLB2N1co
XV8vodUkfn16+HnnvrPDhrmXsxBY+fmOwcVlJh/IFebK207iuqSShg0rjer8B9TcWY7q38nm
nRstm7g1gy9PDk2129mjinjy3OIvJjvI4PJ2u7CJgMEdUMmVuA9ShLez14rj/7RMDHzNAzTP
/gCDvR2to968NSs9HBxqvu/E/gBCSoxk53STJQAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
haloHelpIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/haloHelp.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQAQMAAAAlPW0iAAAABlBMVEX///8AAABVwtN+AAAA
JElEQVR4XmOAAOYDDOwPGHgMQIgBiBIYGA4wMDaAEBDAGQwMAIjBBXexsDsxAAAAAElFTkSu
QmCC'! !

!ThemeIcons methodsFor: '*Versionner-Spec-Browser' stamp: 'TorstenBergmann 2/12/2014 17:42'!
configIconNew
	^ icons
			at: #'configIconNew'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self configIconNewContents readStream) ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallWindowIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAFiSURBVBgZpcEhbpRRGIXh99x7
IU0asGBJWEIdCLaAqcFiCArFCkjA0KRJF0EF26kkFbVVdEj6/985zJ0wBjfp8ygJD6G3n358
fP3m5NvtJscJYBObchEHx6QKJ6SKsnn6eLm7urr5/PP76cU4eXVy/ujouD074hDHd5s6By7G
Zknb3P7mUH+WNLZGKnx595JDvf96zTQSM92vRYA4lMEEO5RNraHWUDH3FV48f0K5mAYJk5pQ
QpqIgixaE1JDKtRDd2OsYfJaTKNcTA2IBIIesMAOPdDUGYJSqGYml5lGHHYkSGhAJBBIkAoW
REAT3Z3JLqZhF3uS2EloQCQ8xLBxoAEWO7aZxros7EgISIIkwlZCY6s1OlAJTWFal5VppMzU
gbAlQcIkiT0DXSI2U2ymYZs9AWJL4n+df3pncsI0bn5dX344W05dhctUFbapZcE2ToiLVHBM
bGymS7aUhIdoPNBf7Jjw/gQ77u4AAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/14/2013 12:11'!
smallProfileIcon
	^ self smallDebugIcon! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'TudorGirba 2/20/2015 08:45'!
glamorousDiveRightIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAAXNSR0IArs4c6QAAAAlwSFlz
AAALEwAACxMBAJqcGAAAAdVpVFh0WE1MOmNvbS5hZG9iZS54bXAAAAAAADx4OnhtcG1ldGEg
eG1sbnM6eD0iYWRvYmU6bnM6bWV0YS8iIHg6eG1wdGs9IlhNUCBDb3JlIDUuNC4wIj4KICAg
PHJkZjpSREYgeG1sbnM6cmRmPSJodHRwOi8vd3d3LnczLm9yZy8xOTk5LzAyLzIyLXJkZi1z
eW50YXgtbnMjIj4KICAgICAgPHJkZjpEZXNjcmlwdGlvbiByZGY6YWJvdXQ9IiIKICAgICAg
ICAgICAgeG1sbnM6dGlmZj0iaHR0cDovL25zLmFkb2JlLmNvbS90aWZmLzEuMC8iPgogICAg
ICAgICA8dGlmZjpDb21wcmVzc2lvbj41PC90aWZmOkNvbXByZXNzaW9uPgogICAgICAgICA8
dGlmZjpQaG90b21ldHJpY0ludGVycHJldGF0aW9uPjI8L3RpZmY6UGhvdG9tZXRyaWNJbnRl
cnByZXRhdGlvbj4KICAgICAgICAgPHRpZmY6T3JpZW50YXRpb24+MTwvdGlmZjpPcmllbnRh
dGlvbj4KICAgICAgPC9yZGY6RGVzY3JpcHRpb24+CiAgIDwvcmRmOlJERj4KPC94OnhtcG1l
dGE+CrDjMt0AAAB3SURBVDgRY2AYBcxEBMFXoJq7QHyVCLVYlfwHin4A4m4gJsZCDENABoDw
eyA+CMRCQIwT/APKwDTAaGQxkHeeAbEeLhNgmvDRf4Ca3+IyANk2mCHIYgRdgM1gmEGgMDgE
xHjDAJcBsFhgwqaAkBjI2eGEFA1heQC76y9PDq6TVQAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'BenjaminVanRyseghem 3/28/2014 17:36'!
instVarsSelectedIconContents

	^ (Form
		extent: 24@24
		depth: 32
		fromArray: #(16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 257246361 1096172449 1951810206 2807448223 2807448223 1951810206 1096172449 257246361 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 106255786 2253800352 4216668832 4283777695 4283777695 4283777695 4283777695 4283777695 4283777695 4216668832 2253800352 106255786 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 810893471 3528803231 4283777695 4267329699 4285423022 4286278581 4287133885 4287133885 4286278581 4285423022 4267329699 4283777695 3528803231 810893471 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 810893471 4183114655 4283777695 4285159595 4287528640 4287792067 4287792067 4287792067 4287792067 4287792067 4287792067 4287528640 4285159595 4283777695 4183114655 810893471 16777215 16777215 16777215 16777215 16777215 16777215 16777215 106255786 3528803231 4283777695 4286146740 4287792067 4287792067 4289371856 4289371856 4289371856 4289371856 4289371856 4289371856 4287792067 4287792067 4286146740 4283777695 3528803231 106255786 16777215 16777215 16777215 16777215 16777215 16777215 2253800352 4283777695 4285028010 4287463104 4287463104 4287463104 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4288450504 4287463104 4287463104 4285028010 4283777695 2253800352 16777215 16777215 16777215 16777215 16777215 257246361 4216668832 4267263650 4286738873 4286936507 4286936507 4286936507 4290622682 4293124336 4294967295 4294967295 4293453555 4291083486 4287594689 4286936507 4286936507 4286738873 4267263650 4216668832 257246361 16777215 16777215 16777215 16777215 1096172449 4283777695 4284830888 4286410166 4286410166 4286410166 4286410166 4286410166 4291149535 4294967295 4294967295 4292334569 4286410166 4286410166 4286410166 4286410166 4286410166 4284830888 4283777695 1096172449 16777215 16777215 16777215 16777215 1951810206 4283777695 4285159338 4285949105 4285949105 4285949105 4285949105 4285949105 4290951900 4294967295 4294967295 4292268263 4285949105 4285949105 4285949105 4285949105 4285949105 4285159338 4283777695 1951810206 16777215 16777215 16777215 16777215 2807448223 4283777695 4285159594 4285422764 4285422764 4285422764 4285422764 4285422764 4290754523 4294967295 4294967295 4292071142 4285422764 4285422764 4285422764 4285422764 4285422764 4285159594 4283777695 2807448223 16777215 16777215 16777215 16777215 2807448223 4283777695 4284698790 4284896167 4284896167 4284896167 4284896167 4284896167 4290491096 4294967295 4294967295 4291939300 4284896167 4284896167 4284896167 4284896167 4284896167 4284698790 4283777695 2807448223 16777215 16777215 16777215 16777215 1951810206 4283777695 4284172448 4284369825 4284369825 4284369825 4284369825 4284369825 4290293717 4294967295 4294967295 4291741922 4284369825 4284369825 4284369825 4284369825 4284369825 4284172448 4283777695 1951810206 16777215 16777215 16777215 16777215 1096172449 4283777695 4284106657 4284501667 4284501667 4284501667 4284501667 4284501667 4290359766 4294967295 4294967295 4291807971 4284501667 4284501667 4284501667 4284501667 4284501667 4284106657 4283777695 1096172449 16777215 16777215 16777215 16777215 257246361 4216668832 4267066272 4284698790 4284764582 4284764582 4284764582 4287002554 4291478240 4294967295 4294967295 4292597482 4287002554 4284764582 4284764582 4284764582 4284698790 4267066272 4216668832 257246361 16777215 16777215 16777215 16777215 16777215 2253800352 4283777695 4284172450 4284962216 4284962216 4284962216 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4286278836 4284962216 4284962216 4284172450 4283777695 2253800352 16777215 16777215 16777215 16777215 16777215 16777215 106255786 3528802975 4283777695 4284633254 4285225386 4285225386 4289701586 4290228182 4290228182 4290228182 4290228182 4290228182 4286015409 4285225386 4284633254 4283777695 3528802975 106255786 16777215 16777215 16777215 16777215 16777215 16777215 16777215 810893471 4183114399 4283777695 4284369828 4285356972 4285488557 4285488557 4285488557 4285488557 4285488557 4285488557 4285356972 4284369828 4283777695 4183114399 810893471 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 810893471 3528802975 4283777695 4267132321 4284567462 4284962217 4285357228 4285357228 4284962217 4284567462 4267132321 4283777695 3528802975 810893471 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 106255786 2253800352 4216668832 4283777695 4283777695 4283777695 4283777695 4283777695 4283777695 4216668832 2253800352 106255786 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 257246361 1096172449 1951810206 2807448223 2807448223 1951810206 1096172449 257246361 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
		offset: 0@0)! !

!ThemeIcons methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 6/7/2013 16:51'!
editIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAFUSURBVDjLrZM/SAJxGIZdWwuD
lnCplkAEm1zkaIiGFFpyMIwGK5KGoK2lphDKkMDg3LLUSIJsSKhIi+684CokOtTiMizCGuzE
U5K3vOEgKvtBDe/2Pc8H3x8NAM1fQlx4H9M3pcOWp6TXWmM8A7j0629v1nraiAVC0IrrwATK
Igs5xyG5QiE+Z4iQdoeU2oAsnqCSO1NSTu+D9VhqRLD8nIB8F0Q2MgmJDyipCzjvYJkIfpN2
UBLG8MpP4dxvQ3ZzGuyyBQ2H+AnOOCBd9aL6soh81A5hyYSGWyCFvxUcerqI4S+CvYVOFPMH
xLAq8I3qdHVY5LbBhJzEsCrwutpRFBlUHy6wO2tEYtWAzLELPN2P03kjfj3luqDycV2F8Age
fWbEnVqEHa2IznSD6BdsVDNStB0lfh0FPoQjdx8RrAqGzC0YprSgxzsUMOY2bf37N/6Ud1Vc
9yYcH50CAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:33'!
transcriptIcon
	"Private - Generated method"
	^ icons
			at: #'transcriptIcon'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self transcriptIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallFullscreenIconContents
	"Private - Method generated with the content of the file /home/dgd/smallFullScreen.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABF0
RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAADIklEQVR4nH2TTWhcVRzFz//e++7Me+1MxkxS
0jR0nJZSbI0am07c2OomI7HrilB0GVy5kJDtZJNVEHQTcONKF2otlGmUEhoQSUtClTAWalJp
Pmtik/l47828efM+/m6yiFA8cDaHw1n84BAAMDNNTU2ZWutjWmsrCALDNE3HNM3q+Ph4gP8R
TU9P90oprwHIARBHHBJRi5nrQog9rfVap9N5OjEx0fzPwMzMTG6nuvVp+dmPH/fnTiad9ebO
Bxc++uVIJwbgMbMNYJ+INpj5t8nJyS0iYjk6OnpybXf12vbQ6mU+7xvVf+rd/UFuP22mIyIC
AAagiShFRD1E1EtEpxcXF7PFYrEq4ji2rIRFkR3B3nBx7t08/dS4ddULvB4AJwD0AegCoABI
Zu6N4/jNOI4vM/NZRURGvuesnX80uOqppvXEezLgd1hpqWMAICIJ4DgzHwNgA3CJKH2YaUVE
YcJIBO+9+v5TIQQeri+5sd9OLMz9MAgiYZkWeW2/menudc9deH03ne5yD9n4YRiGKgzDkIg6
RGQws3Xp5YKz8uDeqTvz91PKMAAAraaLysoy5m5/f/Hu7Tsbr7w2sjmQO+MqpTxFRB0hhB/H
sRRCSAAwrWRi6VkVXzeycCKB00kTQ6cK+OSzM+LDG5v57779Jr8wd9MYLFwtKwCNKIr2AdSZ
uYuIglS6S246LsJAISUktpvAhkO4K9O4nu7D8PAw7IbTr5RqKc/zqpZl7QA4OKSuojDg4ypE
MRWhS0vUgwjL+y10AFTaBoa0xt+7e3YGmQNRKpXazLzGzAfM/JiZ9xzb9nuojazyICMbL8kW
BlM+BgwbGdmElBLr61vPZ2dn6woAMpnMSq1WSwohiswc1WqNR1lCIYyqiEmCmZBLCJyQIZIc
od1qot5w/wDAEgDK5XI8Pz+/OTY29lgI4Wid6Cz9eq9QvPK2UtyAZBeafJjko08aqCwt88KD
Sqlet/+iFz2sVCqpPysPz9vV7a9G3iqMvDF8SXZnMxBSI/Da+PLzL36/+fP9dwDYLxw4qouA
drK4EofIsYBBgPLauHXgYQcA/gWOnHIlydMKjQAAAABJRU5ErkJggg=='! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallScreenshotIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAIrSURBVDjLxVPLjhJBFD3V3dCY
SZjwDipDRjCOCcTgLGalJmxYufAD0E/QHV9g3LjSsGDhik/QjTEaTdgaEsQQINEFJjwEecmr
6Yf3lkJmPwsruXWrq+85dc+9VcJxHFxkKLjg0HgqlUpP1+t1drvdXrIsS2w2G9dqtXKzt21b
6Lpu+P3+N4VC4QnH5/P5U3Lfy+XyL1EsFg9VVZ1kMhmwHAJIa1Tf4eH96zC+vcKLDyfwRm6i
1Wo/Go/HLwnsJWPtZ2oikainUil/JBJBp9NBr9fDcDjE5aMTfPz8E835bdw6vQMhBLrd7gNF
UXSPxwNN08RsNrur0alJr9eLer2OcDiMdDoNkgKSglAohEajgUqlgkAggGw2i36/j8lkImOa
zeYNjQMHgwGCwSC2B0d4/n6FhSlgU366cOHe1Wvwz+eUfgucJQPb7Tai0aiUqvC0WCwQi8Xw
+ouBjaPA4yJzK7AUFz79OJDA0WgkwYZhgAq8z1JjAqq2tN+Wm4AqNGouXw9Bk+G4QR2SxmCO
4zV7mQGz7Fh5OI79F0wkCpmqCCyXSxlzPoM9wS4DqijcjgHTJv22Q+k5ksiNFabTqQSapilJ
OJ79noAZa7UaMoc9qOYSG9oziUSxlriy+YpqtbrXvSPZEWjMxidwewLjMc6Oj2VxOGBO1Wdi
vhvJZFLusf54PC5lMYHI5XKPqa/P6EP3+XyCry4T8E/2BHDoEIdv6fmH92/9Vvz31/gHd9iU
VZFEDKoAAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:24'!
packageIconContents

	^ (Form
		extent: 15@16
		depth: 32
		fromArray:  #(16777215 16777215 16777215 16777215 16777215 16777215 55924053 75530368 50331647 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 33554432 138428480 1750488662 3547295599 2256173690 261724569 55924053 16777215 16777215 16777215 16777215 16777215 16777215 33554432 103492395 1178944837 3361890914 4286085240 4286545791 4286808963 3900275065 1819834488 162179754 75530368 16777215 16777215 16777215 67108864 741618740 2874693720 4235029869 3514399097 3783229311 4286677377 4119234182 3499200913 4203580813 3683026566 1736672131 245671076 41975936 50331648 1902206815 3948896095 4285098345 4285690482 4286019447 4185685116 3213527690 3817441673 4287269514 4287730065 4288848546 4289638062 3180762774 212511402 16777215 2523490665 4084692598 3631641716 4235161455 3497621881 3783229311 4286677377 4119299975 3482555283 4203778192 3919684001 4004358826 3786387375 284159983 16777215 2556847718 4285164138 4285558896 3665656699 3732371319 4286151033 4286545791 4286808963 3968502410 3515912079 4287532686 4288585374 3701974951 234881023 16777215 2639878489 4284506208 4285032552 3715067759 4285822068 3850272125 3883761021 3632563075 4202527868 3582034305 4286743170 4287269514 3583218579 150994943 16777215 2672643405 3863957327 4200291163 3814941539 4285229931 4285558896 4185421687 4285493103 4285822068 3564928124 4286414205 3498542983 3196421509 83886079 16777215 2822651454 4282203453 4182395466 4081929549 4284374622 4284966759 4268715630 4285229931 4285493103 3698027371 3698948473 4286282619 3480976251 83886079 16777216 3039636781 4280756007 4281742902 4265360444 4283058762 4283519313 4284966502 4284243036 4266939476 4233977181 4285690482 4285953654 3480647286 67108863 117440512 2518687776 4246148887 4280098077 4280821800 4282203453 4282992969 4284374365 4284637794 4284900966 4267071062 4285361517 4235095662 2305452650 41975936 16777216 134217728 873731092 3659670050 4245885715 4280690214 4281611316 4283913814 4284835173 4284835173 4065744470 3294255706 844255826 55924053 16777215 16777215 16777215 33554432 218103808 1461131031 3978305568 4280098077 4249635659 4284835173 3730463322 1246514252 100663296 16777215 16777215 16777215 16777215 16777215 16777215 16777215 50331648 285212672 2115903006 3645129539 1833979984 150994944 16777216 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 83886080 134217728 33554432 16777215 16777215 16777215 16777215 16777215 16777215)
		offset: 0@0)! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
workspaceIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAA
CXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1QoSFSUbRvzYGQAAAilJREFUOMt9k89LVFEU
xz93fDMqZEGG0cLAEgpXrly1qEXLNu2C0mqRuggXQWCtgja1DkqwRWKC/gG1LSUIwqI0UCOd
sRgrHX2Ome/dX6fFG2dGLQ8c7r3ccz/3ew7nqKHngweNsf3W2u44jhuMMVTcYmz1OXFn3XoU
x4+11g8CpdT9o03Hek62tKYztXWAgPBP896xXiySX8o3jk+8vp1bzKYD4PqJltb0la5Opj9N
s5+JJOTTbafo7enN5BazPYGI1CmV4svcHKMvH+HFISJ4cXjvEUnceUHE4b2j80I/qZRCRA4F
FXnC1MdZwOG9lEDJ422QF8F5C4B1yVoF8DQ2NSTB3uOxeO/wJUBstgjXlwk3CwA453YCRISp
DzP09d7l2cgTlgt5BME5SyH8SRRtJoFKJR/uAXihviHDqzcvuNHVR2FtmcGRh6wVfkGNpf5A
bQlAKYVdAC+e2el5Vn/8oaP9HJmglveTnxHvy49Qle2eFBAgcNzsvsXw2ABvJycI0gqoKSlX
OxS43UUE+Dr7jUtXL4IIKHg3PlO+0zrmzPn28tk5v6sGgPMuqZFKAdBxtq1KukKlUvsoECiu
bv2/Davy31EDpZQGqW8+3szCwkK5XfezxiOHieIIpdTvANRwNjd/bWxsNNjYKBKGIWG4RhRF
GGuw1mK3J9FarDVoo1lZKWjgaSDi7+SXvpPNzV82xmS01pVRNqYM2R5lrTVGm9hYOyQi9/4C
16KCF5hN9R0AAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: 'private - utilities' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
exportAllIconsAsGif
	"self exportAllIconsAsGif"

	| sels | 
	sels := self class selectors select: [:each |  '*Icon' match: each asString].
	sels do: [:each | self exportIcon: (self perform: each) asGifNamed: each asString].
! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
scaleIconContents
	"Private - Method generated with the content of the file /home/plantec/dvpt/Pharo/Sprint-10-09/Icons/scale.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABYAAAAVCAYAAABCIB6VAAAApklEQVR4XmNgYGAkAxMFGBmK
sxkYnl8jjEHqyDK4OJuFAGYYhC62NGWD0wwMHHD+2gVMg9DFuA0iK+XgjjxLUyaG+moGhv/f
ScMYBmNzMc0NBkUkNmxvywZUwwLG+3cyoRqMDxNyMcgwHAbjj1gKgoI0g0Euo6rBIANhYYoe
xjAxEE21oACFKyxsKQoKmoUxtnCmyMWwMMYVzlQLCnRXDpYwJr90AwC7NHgnaJUzaQAAAABJ
RU5ErkJggg=='! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:19'!
arrowDoubleDownIconContents
	^ Form
		extent: 12@6
		depth: 32
		fromArray:  #(16777215 16777215 16777215 16777215 1711418368 4278893824 4278893824 1711418368 16777215 16777215 16777215 16777215 16777215 16777215 1644306688 3540342528 3590744064 4278961664 4278961664 3590744064 3540342528 1644306688 16777215 16777215 16777215 16777215 33554432 3120842496 4278962176 4278962688 4278962688 4278962176 3120842496 33554432 16777215 16777215 16777215 16777215 16777215 402722560 3590744064 4278962688 4278962688 3590744064 402722560 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1308764928 3959984384 3959984384 1308764928 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2315466752 2315466752 16777215 16777215 16777215 16777215 16777215)
		offset: 0@0! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallCutIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QAAAAAAAD5Q7t/AAAA
CXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1QocFh0xaEFkXgAAArRJREFUOMuFk11Ik1EY
x59z3nevr9vUfaXbbPgVaHjRVRB0YZRJV0XeZCIRaGmWWKhpgZAElaV9gYgQlBjoEPRKkCS6
DAK1MG0zNvJj7zZ1m+51X+92zttNzmFa5+78/w8//s/znIMg5TzrfXIOAN7zPO9tunm7dI/X
z7LspTvNrbpUHadeGIYZu9XYrI1Go8t9/a87Uz0Fq7hw5nS55sWrnk8HAggh/E+HHdfV1lcQ
Qo7t6E97HpeZc82m7ZCIKKUnDgRgjENLS7+AT0tDsVisdCcFy7JThYWF4HF7KKXU8a8EFTab
DVZdK6iutr44kUic6nnePVBSUqJAgMHhdAAAWA8E3G299xljvLy4aAc+jUeSJB3X6/TXZAqw
vrFGAWCiraXj4YEAAABKaeXCjwV5bc0DjTeaVPFEHIliEObm5iQA6Npb/xegraVjGmM8ZF+0
0WBwC2s0GhDcgizL8ru2lo7p/wL+pJianZnGTqcD0jkeMt8ORhBCb/arRXuFMaOxl1B6Pb65
qSblZTIz+REVGHNAIHQLITRQ6fG07wsYM5k6437/g6MmEyQoRd6tTdkX3h5mZVRVkJ3D8BxH
JVkG5/o6KLKyrla63UPJFsbN5hrJ5+sqNhrpwsrKVDASlgJBEdfEaU2UIzqWwTQQEhOO1dUP
R/R6EvP5BsfN5t2XOmowCPNFRWSEYe4DAMxYLCGrUpnY8UcYhnzJNQcBAIYxbv+Wn09GDQZh
d4ixmF6SJFJFyKMJleqlgmV5hLE9OWmOm1Hz6arJjIy+y5R2gyxTIMSwC+A4Qa1UMl/z8mIm
na5pXhC8iszMK8mPpNU2fHe5Ng4fOtQwa7HECKUYMA4AADAAANVarc/l95/0SxIbAJA5tfrs
RUFI7twqiu7q7GyPNxDI8YfDGl8k4lOoVOetouj+DaDzOgfcNME8AAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
configurationIcon
	"Private - Generated method"
	^ icons
			at: #'configuration'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self configurationIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
pharoIconContents
	"Private - Method generated with the content of the file icons\base\pharo.png"
	^ 'iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAFP0lEQVR42sWXe0xTVxzHz729
LaUF+rKUotBLJYBaFDcjKoONgUhmRMFlcwbZxhL3MGZzPjIXdUZmlrkZdZPF6VyiqTgnU5tl
wajI3NQJMpkacQXkUSgptPbF7eM+2rtz2fhnibO32Oz7173n3PM7n/N7nHMuAniooKBAMDw8
zPb19YW593Xr1s2sr6/vrK2tTb5x4wbV2dnpLisrU6Iomnj+/PlB+En4cTYRPgCc8vPzpQkJ
CcLm5mb3Z3v2zP7gozrL1s3vG3bX7boOgababDZBY2OjJZLJowL4xxOKxUvKs093WHeyUlVZ
1jS1j7T++Ymn967x+rVr3MrZSG1FBYAgKLJ0acnOHS/mbtcpUYSkQuDneza64Rb1/Ax9uqO/
v38MwzCio6MjCMNBd3V1PdIbjwXAcRzLyMgQp6WliUOhkEShUIhlMplgrr+7ulzq3oo9XY6A
AAEC99vJZ039BrPZPEBRFMONZaF4ecBgMCB+vx+laRqNi4tDw+GwIDk5GXG73WGLxULDvjBc
ERCxrODgVOXHReVLNvucbiQ+NRX4erroo/LUZQ1NTRfdHk9E8Y86BKuFwjUvzZ59bKy3F0nA
cUB7vQCTSMDo0NBIW1XVYr/PR5hMpv5AIMDPA5Gqurh4TmF7e4uICSnk2VnA090NEvV6cKar
68AJktyk0WjQwsJCLUEQAVgtdujRR4LwBijJm6uVDFgWPYeg9TKRSBOvUgH/8PC4IbMs8XiH
zdbwGxm87GNZWi6XY7m5uTIYNurKlStjkwZIwURJW7S4RQBAEkwxJF4uA4zPD0LBIDTEAhQT
sIAJscecI6tbg/5TE+PgvoHq9XoxFNPW1kZNygOzpLLSSo1ufxKGzZKqlMA3agcoZwUmPEx6
+jv74NpbY+6T0Ofkv8dCEARWFEwXCdva2spEBcDJIFc/U56aadSoVLqgxwuQ8Wpj2dtOm/G0
tacWvjD/NV4qlSI+n4+NGiAtaUp6Vda8a8qkxGm0P8COEO7blwY6t/eNOS/AboqPLd4ACFRN
/rJPVZLETTRgrJfvtdZ1jgwYYQACKTK1yuaxO2IKwKmmtOasxdbvfODq3TloHbLCpnCyIkVT
mlfy/Q9XGytImvTEFCBvZsG75r5bh9VqNeNwuESGrPlrs3HDh2IsTnW2+fgch8t2N6YAGCaM
1+EZqEqd8zaebtgkEsZpkHFjbPic6cs879jD2ALoshfMe6qgskEgEGYiXFrAKmDooOeP6+e2
9nbfPAIeUwWTAlBopysXrNhgFgpFU7hTP0QHvQN3Wo52d1w8QAaIIfhJiI893gB4fsWK7KJV
Z9gwQ1ram77ubftxLxUghicmTp9TkmO5c9kMIjiKowKYUblxo0Spffn+uX1v+h9auVj/vaOh
KJKWv7xCPX3u+t+NO8pATK5k8CaUvvj1V4ZajE1hmnRNNEtSpmv1L7y1S4Hn1pJeu6Vtb00m
9EBEoeDtAVQkFoapIM3BSPFcnba4eoM8a/4bKCqQcldBlqaIm9tK1RAgGBMATtKchXjK8ve2
SablrIEGRNxJyB1GXDUQ3e0tPQfXloMIt2TeAKnVde/IF1Z+jqCCeFiA421cvrEM5XM2Hzs0
+tNXu1k66IrUHi+AhFlFOt36Iw/glIKJNoZw2V2/nvrW2WI8xHgd3JU8dmUoX7SyZGrN7kvc
M2Uf7HFc+OYLd6vpBEsFPXwnjgpAU7X5VUXRqgOjpv11zl9OHgYhhgA8fkImD7Byy2uuq6dv
UyN9d6Jd8aQAsCSVmPE6yfGUf0KKqgyfpP53gL8ACERIP0OXTQ4AAAAASUVORK5CYII='! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/10/2013 13:44'!
collectionIcon 
	^ icons
			at: #'collectionIcon'
			ifAbsentPut:[ self collectionIconContents ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
testRunnerIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/INwWK6QAAABl0
RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAGrSURBVDjLvZPZLkNhFIV75zjv
Ym7VGFNCqoZUJ+roKUUpjRuqp61Wq0NKDMelGGqOxBSUIBKXWtWGZxAvobr8lWjChRgSF//d
v9be+9trCwAI/vIE/26gXmviW5bqnb8yUK028qZjPfoPWEj4Ku5HBspgAz941IXZeze8N1bo
ttSo8BTZviVWrEh546EO03EXpuJOdG63otJbjBKHkEp/Ml6yNYYzpuezWL4s5VMtT8acCMQc
b5XL3eJE8VgBlR7BeMGW9Z4yT9y1CeyucuhdTGDxfftaBO7G4L+zg91UocxVmCiy51NpiP3n
2treUPujL8xhOjYOzZYsQWANyRYlU4Y9Br6oHd5bDh0bCpSOixJiWx71YY09J5pM/WEbzFcD
mHvwwBu2wnikg+lEj4mwBe5bC5h1OUqcwpdC60dxegRmR06TyjCF9G9z+qM2uCJmuMJmaNZa
UrCSIi6X+jJIBBYtW5Cge7cd7sgoHDfDaAvKQGAlRZYc6ltJlMxX03UzlaRlBdQrzSCwksLR
bOpHUSb7pcsnxCCwngvM2Rm/ugUCi84fycr4l2t8Bb6iqTxSCgNIAAAAAElFTkSuQmCC'! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'TudorGirba 2/20/2015 07:36'!
glamorousDiveAllRightIcon
	"Private - Generated method"
	^icons 
			at: #glamorousDiveAllRightIcon
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousDiveAllRightIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:27'!
smallInfoIcon
	"Private - Generated method"
	^icons
			at: #smallInfoIcon
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallInfoIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousAdd
^ self icons
		at: #glamorousAdd ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2130706432 2130706432 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2130706432 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 2130706432 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2130706432 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 2130706432 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2130706432 2130706432 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'EstebanLorenzano 5/9/2013 10:56'!
smallConfigurationIconContents
	"Private - Method generated"
	^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAACXBIWXMAAAsTAAALEwEAmpwY
AAAAB3RJTUUH1QkIDSkTjqMgxAAAADV0RVh0Q29tbWVudAAoYykgMjAwNCBKYWt1YiBTdGVp
bmVyCgpDcmVhdGVkIHdpdGggVGhlIEdJTVCQ2YtvAAACU0lEQVQ4y22QzUtUYRjFf+/73k9n
HGdGnfFj0BQjA3WnaAa1aCG5atFCMoL+ioKKKMhVbdq16AP7CyqCdm0k2vVF4pBmpmai+JXO
OPe+920Rluk9y8PD7znnCA5o8MKdmYU10Ua8ns6+vHpxv2EdvFhYE23DpzpNQ65W6DCgEkbs
VDSf5zYpTk6PAvGAgZGx90sbpsdgKLS0iPt37xFoAwjAcG5klOIkHDk7ZroLYuL5gysnAeQe
YL1kekbOnyGd8Jha3KSvvw8nWY9TnaOju5cVnaS1vZXLl4b5OG8GDyWocqA66eO5FutbZQpd
AwwND6GkZGGtzOsPS9i2YjcwxFbIVEHKt2jKp1ES5pc3+Dbxlppgm5XCMVzXQyhJeaf8H+Bv
hXzK4JgKRzsK/PxapLA6Q3Z5FvfHdxpW55ibmqIhl6FUKsUnaErD8UI1tgjIZ3qZfvYCW5QQ
nkSuLtJ/4jRBpUwgLATmMCDlQ2PGJaq4pD2Y8UO8WhsRSXYDgys1QkY4UmCpmARSgK0g5Qsc
ZePWWKgkEAooCZpzVWyXQxzXJ+HGACIDQoAUgipX4XoSz09gwohoK6SzOcn2rsZPpHiThncH
AaUKVMIIg0EKgbAkjmOhrQgnMjRmPUIdUZNJ014fs8FWGXYrGq0NQgmkkFi2hdAaS2l8R2GM
pD7tUZuIqVAKQCPJ5fP4rvPH3HskoK4ui+O4KKWw40Y0hk+Px8e7fBuUBCVt0jVZwjBg69cy
j548ZN9er/jHjpW8dfO2Ln6Z2XE9125rabav3bhuAfrg4W/hgM0HfAZ+XAAAAABJRU5ErkJg
gg=='! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousGrayCircleEmpty
^ self icons
		at: #glamorousGrayCircleEmpty ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 966038676 2694026131 3096679315 2694026131 597268889 0 0 0 0 0 0 0 0 0 0 832018327 3214119827 748132247 79675327 731157652 3432157842 597268889 0 0 0 0 0 0 0 0 0 2895352723 714643608 0 0 0 731157652 2694026131 0 0 0 0 0 0 0 0 0 3096679315 79675327 0 0 0 79675327 3096679315 0 0 0 0 0 0 0 0 0 2694026131 731157652 0 0 0 714643608 2895352723 0 0 0 0 0 0 0 0 0 966038676 3214119827 714643608 79675327 731157652 3214119827 832018327 0 0 0 0 0 0 0 0 0 0 832018327 2895352723 3096679315 2694026131 966038676 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: (0@0))]! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousEdit
^ self icons
		at: #glamorousEdit ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2248146944 4278190080 570425344 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2315255808 3456106496 1593835520 3875536896 687865856 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2315255808 3456106496 301989888 16777215 1509949440 3875536896 687865856 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2315255808 3456106496 301989888 16777215 16777215 218103808 3003121664 2634022912 16777215 16777215 16777215 16777215 16777215 16777215 16777215 989855744 3070230528 50331648 16777215 16777215 301989888 3489660928 2281701376 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1862270976 2600468480 16777215 16777215 301989888 3489660928 2281701376 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3103784960 1358954496 67108864 1140850688 3640655872 2281701376 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 150994944 4278190080 2952790016 4194304000 4278190080 1627389952 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 218103808 2449473536 1560281088 352321536 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:57'!
haloHelpIcon
	"Private - Generated method"
	^ icons
			at: #'haloHelp'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self haloHelpIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:57'!
questionIcon
	"Private - Generated method"
	^icons
			at: #questionIcon
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self questionIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousRightSide
^ self icons
		at: #glamorousRightSide ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 16777215 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 4278190080 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 16777215 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4261412864)
	offset: (0@0))]! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:57'!
smallFindIcon
	"Private - Generated method"
	^ icons
			at: #'smallFind'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallFindIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:57'!
paintIcon
	"Private - Generated method"
	^ icons
			at: #'paint'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self paintIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Nautilus-contents' stamp: 'EstebanLorenzano 5/10/2013 13:19'!
arrowDownIconContents
	^ Form
		extent: 12@12
		depth: 32
		fromArray:  #(16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1157900544 3154467840 3154467840 1157900544 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1711483648 4278893824 4278893824 1711483648 16777215 16777215 16777215 16777215 16777215 16777215 1661149440 3624228608 3657853952 4278961664 4278961664 3657853952 3624228608 1661149440 16777215 16777215 16777215 16777215 16777216 3070510592 4278962176 4278962688 4278962688 4278962176 3070510592 16777216 16777215 16777215 16777215 16777215 16777215 352324608 3573966336 4278962688 4278962688 3573966336 352324608 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1258499072 3959984128 3959984128 1258499072 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2315532032 2315532032 16777215 16777215 16777215 16777215 16777215)
		offset: 0@0! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousRight
^ self icons
		at: #glamorousRight ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 956301312 1828716544 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1073741824 4278190080 2852126720 218103808 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1073741824 4278190080 4278190080 3640655872 771751936 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4127195136 1627389952 16777215 16777215 16777215 16777215 16777215 16777215 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4127195136 1627389952 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1073741824 4278190080 4278190080 3640655872 771751936 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1073741824 4278190080 2852126720 218103808 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 956301312 1828716544 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/14/2013 13:02'!
protocolProtectedIcon
	^ self protocolNoneIcon ! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:57'!
radioButtonPressedIcon
	"Private - Generated method"
	^ icons
			at: #'radioButtonPressed'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self radioButtonPressedIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 10:57'!
haloMenuIcon
	"Private - Generated method"
	^ icons
			at: #'haloMenu'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self haloMenuIconContents readStream) ].! !

!ThemeIcons methodsFor: 'private - contents' stamp: 'CamilloBruni 9/20/2013 14:38'!
windowMaximizeFormContents
	^ #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 0 0 0 0 0 0 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'CamilloBruni 9/14/2013 16:24'!
removeIcon 
	^ icons
			at: #'removeIcon'
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self removeIconContents readStream) ].! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'EstebanLorenzano 12/5/2014 18:18'!
glamorousAccept
^ self icons
		at: #glamorousAccept ifAbsentPut: [(Form
	extent: (16@16)
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 33554432 2969567232 4278190080 587202560 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 50331648 2969567232 4143972352 4043309056 973078528 16777215 16777215 16777215 16777215 16777215 16777215 16777215 536870912 16777215 16777215 50331648 2969567232 4143972352 4110417920 922746880 16777215 16777215 16777215 16777215 16777215 16777215 184549376 3758096384 4278190080 603979776 50331648 2969567232 4143972352 4110417920 922746880 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2365587456 4261412864 3976200192 3137339392 4143972352 4110417920 922746880 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 100663296 3405774848 4227858432 4261412864 4143972352 922746880 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 167772160 4177526784 4278190080 1375731712 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 167772160 671088640 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: (0@0))]! !

!ThemeIcons methodsFor: '*Nautilus-icons' stamp: 'EstebanLorenzano 5/14/2013 13:02'!
protocolPrivateIcon
	^ self protocolNoneIcon ! !

!ThemeIcons methodsFor: '*Glamour-Morphic-Theme' stamp: 'TudorGirba 3/5/2015 10:46'!
glamorousCloudIcon
	"Private - Generated method"
	^icons 
			at: #glamorousCloudIcon
			ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self glamorousCloudIconContents readStream) ].! !

!ThemeIcons methodsFor: 'accessing - icons' stamp: 'StephaneDucasse 12/22/2013 15:28'!
smallOkIcon
	"Private - Generated method"
	^ icons
			at: #'smallOk'
			ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallOkIconContents readStream) ].! !

!ThemeIcons class methodsFor: 'testing' stamp: 'EstebanLorenzano 10/17/2013 13:29'!
isAbstract 
	^ true! !

!ThemeIcons class methodsFor: 'instance creation' stamp: 'MarcusDenker 10/31/2014 12:19'!
current: aThemeIcons
	Current := aThemeIcons.
	"Polymorph depends on Morphic, so coupling with WorldState is ok, the problem is with 
	 other tools (like Nautilus), that may need to refresh its icon caches"
	World resetWorldMenu.
	SystemAnnouncer uniqueInstance announce: IconSetChanged! !

!ThemeIcons class methodsFor: 'accessing - icons' stamp: 'EstebanLorenzano 5/9/2013 19:33'!
haloScaleIconContents
	^ self current haloScaleIconContents.! !

!ThemeIcons class methodsFor: 'settings' stamp: 'EstebanLorenzano 10/17/2013 13:36'!
uiIconClass: aClass
	self current: aClass new.! !

!ThemeIcons class methodsFor: 'settings' stamp: 'EstebanLorenzano 10/17/2013 13:35'!
uiIconSetChoises
	^ ThemeIcons allIconSetClasses collect: [:c | c iconSetName -> c]! !

!ThemeIcons class methodsFor: 'cleanup' stamp: 'MarcusDenker 10/31/2014 11:54'!
cleanUp
	self current initializeIcons! !

!ThemeIcons class methodsFor: 'accessing' stamp: 'gvc 7/23/2008 13:01'!
normalSizeNames
	"Answer the names of the normal icons"
	
	^#('error' 'info' 'lock' 'question' 'warning' 'upArrow' 'downArrow' 'backspaceArrow')! !

!ThemeIcons class methodsFor: '*Graphics-Resources-Theme-Icons' stamp: 'EstebanLorenzano 5/9/2013 11:04'!
blankIconOfWidth: aNumber 
	^ self current blankIconOfWidth: aNumber! !

!ThemeIcons class methodsFor: 'settings' stamp: 'EstebanLorenzano 10/17/2013 13:36'!
uiIconClass
	^ self current class! !

!ThemeIcons class methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/17/2013 13:28'!
allIconSetClasses
	"Answer the subclasses of the receiver that are considered to be
	concrete (useable as a theme)."

	^(self allSubclasses reject: #isAbstract) 
		asSortedCollection: [:a :b | a iconSetName <= b iconSetName]! !

!ThemeIcons class methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/9/2013 11:07'!
iconNamed: aSymbol ifNone: aBlock
	^ self current 
		iconNamed: aSymbol 
		ifNone: aBlock! !

!ThemeIcons class methodsFor: 'settings' stamp: 'StephaneDucasse 11/11/2014 18:33'!
settingsOn: aBuilder 
	<systemsettings>

	(aBuilder pickOne: #uiIconClass)
		parent: #appearance;
		label: 'Icon Set';
		target: self;
		order: 2;
		domainValues: self uiIconSetChoises! !

!ThemeIcons class methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/26/2015 17:51'!
gtExampleThemeIcons
	<gtExample: 'Icon Theme'>
	^ Smalltalk ui icons! !

!ThemeIcons class methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/9/2013 11:07'!
iconNamed: aSymbol
	^ self current iconNamed: aSymbol 
		! !

!ThemeIcons class methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/17/2013 16:27'!
iconSetName
	^ nil! !

!ThemeIcons class methodsFor: 'accessing' stamp: 'AlainPlantec 10/24/2010 20:24'!
smallSizeNames
	"Answer the names of the small icons"
	
	^#('smallError' 'smallInfo' 'smallLock' 'smallQuestion' 'smallWarning' 'smallPushpin'
		'smallBold' 'smallItalic' 'smallUnderline' 'smallStrikeOut' 'smallBarcode'
		'smallHierarchyBrowser' 'smallSystemBrowser' 'smallScreenshot')! !

!ThemeIcons class methodsFor: 'instance creation' stamp: 'MarcusDenker 10/31/2014 12:18'!
current 
	"WARNING: Direct access to this method is ill-adviced, use Smalltalk ui icons instead."
	^ Current ifNil: [ Current := self new ]! !

!ThemeSettings commentStamp: 'gvc 5/18/2007 10:23'!
Configurable basic settings for themes.!
!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/13/2009 17:23'!
menuColor
	"Answer the value of menuColor"

	^ menuColor ifNil: [self fallbackMenuColor]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'gvc 4/16/2007 13:40'!
scrollbarColor
	"Answer the value of scrollbarColor"

	^scrollbarColor ifNil: [self windowColor]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/13/2009 17:19'!
preferRoundCorner
	"Answer the value of preferRoundCorner"

	^preferRoundCorner  ifNil: [preferRoundCorner := self preferRoundCornerByDefault]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'gvc 10/12/2006 14:39'!
derivedSelectionColor
	"Answer a selection colour based on the window color."

	^self windowColor whiter lighter! !

!ThemeSettings methodsFor: 'accessing' stamp: 'gvc 4/23/2007 17:20'!
progressBarColor: anObject
	"Set the value of progressBarColor"

	progressBarColor := anObject! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 2/11/2011 22:14'!
secondarySelectionTextColor
	"Answer the value of selectionTextColor"

	^ secondarySelectionTextColor 
		ifNil: [ self secondarySelectionColor contrastingColor ]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/19/2009 23:24'!
tabAmongFields
	^ tabAmongFields ifNil: [tabAmongFields := true]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/19/2009 23:31'!
maxBalloonHelpLineLength
	^ maxBalloonHelpLineLength ifNil: [maxBalloonHelpLineLength := 40]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/13/2009 18:29'!
fallbackMenuColor
	"Answer the value of menuColor"

	^ self preferGradientFill ifTrue: [Color lightGray] ifFalse: [Color lightGray muchLighter]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 2/11/2011 21:14'!
selectionTextColor: aColor
	selectionTextColor := aColor! !

!ThemeSettings methodsFor: 'initialization' stamp: 'AlainPlantec 12/20/2009 21:54'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		autoSelectionColor: true;
		windowColor: self defaultWindowColor;
		selectionColor: self defaultSelectionColor;
		buttonColor: self defaultButtonColor;
		scrollbarColor: self defaultScrollbarColor;
		standardColorsOnly: false! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 2/11/2011 21:50'!
haveFindReplaceSelectionTextColor

	^ findReplaceSelectionTextColor notNil! !

!ThemeSettings methodsFor: 'accessing' stamp: 'gvc 10/16/2008 16:12'!
menuColor: anObject
	"Set the value of menuColor"

	menuColor := anObject! !

!ThemeSettings methodsFor: 'accessing' stamp: 'gvc 4/13/2007 17:06'!
defaultButtonColor
	"Answer the default button colour."

	^Color gray! !

!ThemeSettings methodsFor: 'accessing' stamp: 'gvc 4/13/2007 17:05'!
buttonColor: anObject
	"Set the value of buttonColor"

	buttonColor := anObject! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/19/2009 23:22'!
menuKeyboardControl
	^ true! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 2/11/2011 21:03'!
menuSelectionTextColor
	"Answer the value of menuSelectionTextColor"

	^menuSelectionTextColor ifNil: [menuSelectionTextColor := Color black]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/13/2009 22:48'!
autoMenuColor
	"Answer the value of autoMenuColor"

	^autoMenuColor ifNil: [^false]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'gvc 4/16/2007 13:39'!
buttonColor
	"Answer the value of buttonColor"

	^buttonColor ifNil: [self windowColor]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 11/8/2010 14:50'!
secondarySelectionColor: anColor
	secondarySelectionColor := anColor! !

!ThemeSettings methodsFor: 'accessing' stamp: 'gvc 3/9/2010 15:14'!
desktopImageLayout
	"Answer the layout symbol for any desktop image.
	See AlphaImageMorph>>layoutSymbols."

	^desktopImageLayout ifNil: [desktopImageLayout := #scaled]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 11/17/2010 19:34'!
unfocusedSelectionColor: aColor
	"Answer the value of selectionColor when the window have not the focus"

	unfocusedSelectionColor := aColor! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/13/2009 18:11'!
autoMenuColor: aBoolean
	"Answer the value of autoMenuColor"

	autoMenuColor := aBoolean! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/19/2009 23:30'!
balloonHelpDelayTime: anInteger
	balloonHelpDelayTime := anInteger! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/14/2009 14:27'!
fadedBackgroundWindows: aBoolean
	fadedBackgroundWindows := aBoolean! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 9/11/2011 05:31'!
selectionTextColor
	"Answer the value of selectionTextColor"
	
	^selectionTextColor ifNil: [Color black ]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 2/11/2011 21:49'!
haveSecondarySelectionTextColor
	"Answer the value of selectionTextColor"

	^ secondarySelectionTextColor notNil! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 10/20/2010 19:47'!
defaultWindowColor
	"Answer the default window colour."

	^ Color lightGray! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 1/4/2010 08:48'!
menuKeyboardFocusColor
	^ (Color r: 0.6 g: 1.0 b: 1.0)! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/14/2009 21:35'!
fastDragging: aBoolean
		fastDragging := aBoolean! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/19/2009 23:25'!
tabAmongFields: aBoolean
	tabAmongFields := aBoolean! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/20/2009 21:53'!
selectionColor: anObject
	"Set the value of selectionColor"
	selectionColor := anObject! !

!ThemeSettings methodsFor: 'as yet unclassified' stamp: 'MarcusDenker 12/11/2009 07:43'!
fromConfiguration: tree
	"Update the settings from the given tree."
	
	(tree at: #windowColor ifAbsent: []) ifNotNil: [:v | self windowColor: v].
	(tree at: #autoSelectionColor ifAbsent: []) ifNotNil: [:v | self autoSelectionColor: v].
	(tree at: #selectionColor ifAbsent: []) ifNotNil: [:v | self selectionColor: v]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/19/2009 23:31'!
maxBalloonHelpLineLength: anInteger
	maxBalloonHelpLineLength := anInteger! !

!ThemeSettings methodsFor: 'accessing' stamp: 'gvc 10/12/2006 13:41'!
manualSelectionColor
	"Answer the inverse of autoSelectionColor."

	^self autoSelectionColor not! !

!ThemeSettings methodsFor: 'accessing' stamp: 'gvc 4/24/2007 11:45'!
progressBarProgressColor: anObject
	"Set the value of progressBarProgressColor"

	progressBarProgressColor := anObject! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/14/2009 10:50'!
menuBorderColor
	"Answer the value of menuColor"

	^ self flatMenu  
		ifFalse: [#raised]
		ifTrue: [self derivedMenuColor twiceDarker]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'gvc 9/22/2006 17:48'!
defaultSelectionColor
	"Answer the default selection colour."

	^self defaultWindowColor! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/19/2009 23:15'!
balloonHelpEnabled: aBoolean
	balloonHelpEnabled := aBoolean! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/19/2009 23:15'!
balloonHelpEnabled
	^ balloonHelpEnabled ifNil: [balloonHelpEnabled := true]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'gvc 10/16/2008 16:12'!
menuTitleColor: anObject
	"Set the value of menuTitleColor"

	menuTitleColor := anObject! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 11/17/2010 16:36'!
selectionBarColor
	^ selectionBarColor ifNil: [selectionBarColor := self selectionColor alpha: 0.06]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/17/2009 14:36'!
scrollBarThickness
	^ scrollBarThickness ifNil: [scrollBarThickness := 14]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'MarcusDenker 9/27/2010 15:31'!
menuSelectionColor: aColor
	"Set the base value of menuSelectionColor.
	If nil, actual color used will be based on derived menu color."

	menuSelectionColor := aColor! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/13/2009 11:34'!
preferGradientFillByDefault
	^ true! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/13/2009 15:38'!
preferRoundCornerByDefault
	^ true! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/13/2009 20:23'!
standardColorsOnly
	"Answer the value of standardColorsOnly"
 
	^standardColorsOnly ifNil: [^false]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'gvc 4/16/2007 13:00'!
scrollbarColor: anObject
	"Set the value of scrollbarColor"

	scrollbarColor := anObject! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/19/2009 23:29'!
balloonHelpDelayTime
	^ balloonHelpDelayTime ifNil: [balloonHelpDelayTime := 800]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'gvc 3/9/2010 15:14'!
desktopImageLayout: aSymbol
	"Set the layout symbol for any desktop image.
	See AlphaImageMorph>>layoutSymbols."

	desktopImageLayout := aSymbol! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/14/2009 14:27'!
fadedBackgroundWindows
	^ fadedBackgroundWindows ifNil: [fadedBackgroundWindows := true]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/13/2009 17:53'!
menuBorderWidth
	"Answer the value of menuColor"

	^ 2! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 2/11/2011 22:15'!
findReplaceSelectionTextColor
	"Answer the value of the selectionTextColor for find/replace"

	^ findReplaceSelectionTextColor 
		ifNil: [ self findReplaceSelectionColor contrastingColor ]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/13/2009 18:01'!
progressBarColor
	"Answer the value of progressBarColor"

	^progressBarColor ifNil: [progressBarColor := self derivedMenuColor muchLighter]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/14/2009 21:34'!
fastDragging 
		^ fastDragging ifNil: [fastDragging := false] ! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/20/2009 00:25'!
progressBarProgressColor
	"Answer the value of progressBarProgressColor"

	^progressBarProgressColor ifNil: [self menuTitleColor]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 11/17/2010 16:33'!
findReplaceSelectionColor
	"Answer the value of the selectionColor for find/replace"

	^ findReplaceSelectionColor ifNil: [findReplaceSelectionColor := Color orange alpha: 0.4]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'StephaneDucasse 4/27/2010 11:56'!
derivedMenuColor
	"Answer a selection colour based on the window color."

	| autoColor worldColor |
	autoColor := self autoMenuColor 
				and: [Display depth > 4
						and: [(worldColor := self currentWorld color) isColor]].

	^ autoColor
				ifTrue: [worldColor luminance > 0.7
						ifTrue: [worldColor mixed: 0.85 with: Color black]
						ifFalse: [worldColor mixed: 0.4 with: Color white]]
				ifFalse: [self menuColor].
! !

!ThemeSettings methodsFor: 'accessing' stamp: 'gvc 10/12/2006 14:06'!
windowColor: anObject
	"Set the value of windowColor"

	windowColor := anObject.
	self changed: #windowColor.
	self autoSelectionColor ifTrue: [self changed: #selectionColor]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/13/2009 19:19'!
flatMenu: aBoolean
		flatMenu := aBoolean! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/13/2009 19:52'!
menuTitleBorderColor
	^ self flatMenu
		ifFalse: [#inset]
		ifTrue: [self derivedMenuColor muchDarker]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 2/11/2011 18:19'!
windowColor
	"Answer the value of windowColor"

	^ windowColor ifNil: [Color lightGray]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'gvc 10/12/2006 14:04'!
autoSelectionColor: anObject
	"Set the value of autoSelectionColor"

	autoSelectionColor := anObject.
	self
		changed: #autoSelectionColor;
		changed: #manualSelectionColor;
		changed: #selectionColor! !

!ThemeSettings methodsFor: 'accessing' stamp: 'FernandoOlivero 9/18/2013 11:15'!
selectionColor
	"Answer the value of selectionColor"
	
	Display depth = 1 ifTrue: [^ Color veryLightGray].
	Display depth = 2 ifTrue: [^ Color gray].
	^self autoSelectionColor
		ifTrue: [self derivedSelectionColor]
		ifFalse: [selectionColor ifNil: [selectionColor := Color r: 0.0 g: 0.0 b: 0.8 alpha: 0.25]]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/13/2009 15:41'!
preferRoundCorner: aBoolean
	"Set the value of preferRoundCorner"

	preferRoundCorner := aBoolean! !

!ThemeSettings methodsFor: 'accessing' stamp: 'FernandoOlivero 9/18/2013 11:15'!
secondarySelectionColor
	"Answer the value of selectionColor"

	^ secondarySelectionColor ifNil: [secondarySelectionColor :=   (Color r: 0.351 g: 0.939 b: 0.46 alpha: 0.35)]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/21/2009 11:39'!
menuTitleColor
	"Answer the value of menuTitleColor"

	Display depth = 1 ifTrue: [^ Color white].
	Display depth = 2 ifTrue: [^ Color gray].
	^menuTitleColor 
		ifNil: [self menuColor 
				ifNil: [Color gray] 
				ifNotNil: [:mc | self preferGradientFill 
					ifTrue: [mc]
					ifFalse: [mc twiceDarker]]]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'gvc 4/16/2007 13:01'!
defaultScrollbarColor
	"Answer the default scrollbar colour."

	^Color gray! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/13/2009 11:28'!
preferGradientFill: aBoolean
	"Set the value of preferGradientFill "

	preferGradientFill  := aBoolean! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/13/2009 19:18'!
flatMenu 
		^ flatMenu ifNil: [flatMenu := false]! !

!ThemeSettings methodsFor: 'as yet unclassified' stamp: 'gvc 9/17/2007 14:14'!
toConfiguration: tree
	"Update the tree from the receiver."
	
	tree at: #windowColor put: self windowColor.
	tree at: #autoSelectionColor put: self autoSelectionColor.
	tree at: #selectionColor put: self basicSelectionColor! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 2/11/2011 21:36'!
findReplaceSelectionTextColor: aColor
	"Answer the value of the selectionTextColor for find/replace"

	findReplaceSelectionTextColor := aColor! !

!ThemeSettings methodsFor: 'accessing' stamp: 'gvc 9/17/2007 14:14'!
basicSelectionColor
	"Answer the recorded selection color rather than derived."

	^selectionColor! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 11/17/2010 14:54'!
selectionBarColor: aColor
	selectionBarColor := aColor! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/15/2009 10:25'!
animationSettings
	^ animationSettings ifNil: [animationSettings := AnimationSettings new]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 2/11/2011 21:10'!
menuSelectionTextColor: aColor
	"Answer the value of menuSelectionTextColor"

	menuSelectionTextColor := aColor! !

!ThemeSettings methodsFor: 'accessing' stamp: 'FernandoOlivero 9/18/2013 11:15'!
menuShadowColor
	^ Color r: 0.0 g: 0.0 b: 0.0 alpha: 0.666! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 2/11/2011 21:49'!
haveSelectionTextColor
	
	^ selectionTextColor notNil! !

!ThemeSettings methodsFor: 'accessing' stamp: 'gvc 3/24/2010 11:03'!
menuSelectionColor
	"Answer the value of menuSelectionColor"

	^menuSelectionColor ifNil: [self derivedMenuColor darker]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'gvc 4/13/2007 17:01'!
standardColorsOnly: anObject
	"Set the value of standardColorsOnly"

	standardColorsOnly := anObject! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 2/11/2011 21:35'!
secondarySelectionTextColor: aColor
	"set the value of selectionTextColor"

	secondarySelectionTextColor := aColor! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 11/12/2010 22:28'!
findReplaceSelectionColor: anColor
	findReplaceSelectionColor := anColor! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 12/13/2009 11:34'!
preferGradientFill 
	"Answer the value of preferGradientFill "

	^preferGradientFill  ifNil: [preferGradientFill := self preferGradientFillByDefault]! !

!ThemeSettings methodsFor: 'as yet unclassified' stamp: 'gvc 10/18/2006 12:11'!
applySettingsFrom: aThemeSettings
	"Change the settings to be those of aThemeSettings."
	
	self
		windowColor: aThemeSettings windowColor;
		selectionColor: aThemeSettings selectionColor;
		autoSelectionColor: aThemeSettings autoSelectionColor! !

!ThemeSettings methodsFor: 'accessing' stamp: 'AlainPlantec 2/9/2011 08:34'!
unfocusedSelectionColor
	"Answer the value of selectionColor when the window have not the focus"

	^ unfocusedSelectionColor ifNil: [unfocusedSelectionColor := self selectionColor alphaMixed: 0.7 with: Color veryLightGray lighter]! !

!ThemeSettings methodsFor: 'accessing' stamp: 'gvc 4/18/2007 11:45'!
autoSelectionColor
	"Answer the value of autoSelectionColor"

	^autoSelectionColor ifNil: [^true]! !

!ThirtyTwoBitRegister commentStamp: '<historical>'!
I represent a 32-bit register. An instance of me can hold any non-negative integer in the range [0..(2^32 - 1)]. Operations are performed on my contents in place, like a hardware register, and results are always modulo 2^32.

This class is primarily meant for use by the SecureHashAlgorithm class.
!
!ThirtyTwoBitRegister methodsFor: 'accumulator ops' stamp: 'jm 12/7/1999 15:36'!
+= aThirtTwoBitRegister
	"Replace my contents with the sum of the given register and my current contents."

	| lowSum |
	lowSum := low + aThirtTwoBitRegister low.
	hi := (hi + aThirtTwoBitRegister hi + (lowSum bitShift: -16)) bitAnd: 16rFFFF.
	low := lowSum bitAnd: 16rFFFF.
! !

!ThirtyTwoBitRegister methodsFor: 'accumulator ops' stamp: 'jm 12/7/1999 15:41'!
bitAnd: aThirtTwoBitRegister
	"Replace my contents with the bitwise AND of the given register and my current contents."

	hi := hi bitAnd: aThirtTwoBitRegister hi.
	low := low bitAnd: aThirtTwoBitRegister low.
! !

!ThirtyTwoBitRegister methodsFor: 'converting' stamp: 'DSM 1/20/2000 17:17'!
asReverseInteger
	"Answer the byte-swapped integer value of my current contents."

	^ ((low bitAnd: 16rFF) bitShift: 24) +
       ((low bitAnd: 16rFF00) bitShift: 8) +
	  ((hi bitAnd: 16rFF) bitShift: 8) +
       (hi bitShift: -8)
! !

!ThirtyTwoBitRegister methodsFor: 'accumulator ops' stamp: 'jm 12/7/1999 23:09'!
leftRotateBy: bits
	"Rotate my contents left by the given number of bits, retaining exactly 32 bits."
	"Details: Perform this operation with as little LargeInteger arithmetic as possible."

	| bitCount s1 s2 newHi |
	"ensure bitCount is in range [0..32]"
	bitCount := bits \\ 32.
	bitCount < 0 ifTrue: [bitCount := bitCount + 32].

	bitCount > 16
		ifTrue: [
			s1 := bitCount - 16.
			s2 := s1 - 16.
			newHi := ((low bitShift: s1) bitAnd: 16rFFFF) bitOr: (hi bitShift: s2).
			low := ((hi bitShift: s1) bitAnd: 16rFFFF) bitOr: (low bitShift: s2).
			hi := newHi]
		ifFalse: [
			s1 := bitCount.
			s2 := s1 - 16.
			newHi := ((hi bitShift: s1) bitAnd: 16rFFFF) bitOr: (low bitShift: s2).
			low := ((low bitShift: s1) bitAnd: 16rFFFF) bitOr: (hi bitShift: s2).
			hi := newHi]
! !

!ThirtyTwoBitRegister methodsFor: 'accessing' stamp: 'len 8/15/2002 01:34'!
byteAt: anInteger
	anInteger = 1 ifTrue: [^ hi bitShift: -8].
	anInteger = 2 ifTrue: [^ hi bitAnd: 16rFF].
	anInteger = 3 ifTrue: [^ low bitShift: -8].
	anInteger = 4 ifTrue: [^ low bitAnd: 16rFF]! !

!ThirtyTwoBitRegister methodsFor: 'accumulator ops' stamp: 'jm 12/7/1999 15:40'!
bitOr: aThirtTwoBitRegister
	"Replace my contents with the bitwise OR of the given register and my current contents."

	hi := hi bitOr: aThirtTwoBitRegister hi.
	low := low bitOr: aThirtTwoBitRegister low.
! !

!ThirtyTwoBitRegister methodsFor: 'accumulator ops' stamp: 'RJT 10/28/2005 15:42'!
bitShift: anInteger
	"Replace my contents with the bitShift of anInteger."
	self load: (self asInteger bitShift: anInteger). ! !

!ThirtyTwoBitRegister methodsFor: 'accumulator ops' stamp: 'jm 12/7/1999 15:38'!
bitXor: aThirtTwoBitRegister
	"Replace my contents with the bitwise exclusive OR of the given register and my current contents."

	hi := hi bitXor: aThirtTwoBitRegister hi.
	low := low bitXor: aThirtTwoBitRegister low.
! !

!ThirtyTwoBitRegister methodsFor: 'accessing' stamp: 'jm 12/14/1999 16:07'!
loadFrom: aByteArray at: index
	"Load my 32-bit value from the four bytes of the given ByteArray starting at the given index. Consider the first byte to contain the most significant bits of the word (i.e., use big-endian byte ordering)."

	hi := ((aByteArray at: index) bitShift: 8) + ( aByteArray at: index + 1).
	low := ((aByteArray at: index + 2) bitShift: 8) + ( aByteArray at: index + 3).
! !

!ThirtyTwoBitRegister methodsFor: 'copying' stamp: 'jm 12/7/1999 15:26'!
copy
	"Use the clone primitive for speed."

	<primitive: 148>
	^ super copy
! !

!ThirtyTwoBitRegister methodsFor: 'accessing' stamp: 'jm 12/7/1999 15:26'!
low

	^ low! !

!ThirtyTwoBitRegister methodsFor: 'accessing' stamp: 'adrian_lienhard 7/21/2009 19:49'!
byte1: hi1 byte2: hi2 byte3: low1 byte4: low2
	hi := (hi1 bitShift: 8) + hi2.
	low := (low1 bitShift: 8) + low2.! !

!ThirtyTwoBitRegister methodsFor: 'accessing' stamp: 'jm 12/14/1999 16:07'!
load: anInteger
	"Set my contents to the value of given integer."

	low := anInteger bitAnd: 16rFFFF.
	hi := (anInteger bitShift: -16) bitAnd: 16rFFFF.
	self asInteger = anInteger
		ifFalse: [self error: 'out of range: ', anInteger printString].
! !

!ThirtyTwoBitRegister methodsFor: 'accessing' stamp: 'len 8/15/2002 01:29'!
storeInto: aByteArray at: index
	"Store my 32-bit value into the four bytes of the given ByteArray starting at the given index. Consider the first byte to contain the most significant bits of the word (i.e., use big-endian byte ordering)."

	aByteArray at: index put: (hi bitShift: -8).
	aByteArray at: index + 1 put: (hi bitAnd: 16rFF).
	aByteArray at: index + 2 put: (low bitShift: -8).
	aByteArray at: index + 3 put: (low bitAnd: 16rFF)! !

!ThirtyTwoBitRegister methodsFor: 'accessing' stamp: 'jm 12/14/1999 16:03'!
asInteger
	"Answer the integer value of my current contents."

	^ (hi bitShift: 16) + low
! !

!ThirtyTwoBitRegister methodsFor: 'accumulator ops' stamp: 'jm 12/7/1999 15:40'!
bitInvert
	"Replace my contents with the bitwise inverse my current contents."

	hi := hi bitXor: 16rFFFF.
	low := low bitXor: 16rFFFF.
! !

!ThirtyTwoBitRegister methodsFor: 'accessing' stamp: 'jm 12/7/1999 15:26'!
hi

	^ hi
! !

!ThirtyTwoBitRegister methodsFor: 'printing' stamp: 'laza 3/29/2004 12:22'!
printOn: aStream
	"Print my contents in hex with a leading 'R' to show that it is a register object being printed."

	aStream nextPutAll: 'R:'.
	self asInteger storeOn: aStream base: 16.
! !

!ThirtyTwoBitRegister methodsFor: 'accessing' stamp: 'adrian_lienhard 7/21/2009 19:49'!
reverseLoadFrom: aByteArray at: index
	"Load my 32-bit value from the four bytes of the given ByteArray
starting at the given index. Consider the first byte to contain the most
significant bits of the word (i.e., use big-endian byte ordering)."

	hi := ((aByteArray at: index + 3) bitShift: 8) + ( aByteArray at: index + 2).
	low := ((aByteArray at: index + 1) bitShift: 8) + ( aByteArray at: index).
! !

!ThirtyTwoBitRegister methodsFor: 'converting' stamp: 'len 8/7/2002 17:37'!
asByteArray
	^ ByteArray with: (low bitAnd: 16rFF) with: (low bitShift: -8) with: (hi bitAnd: 16rFF) with: (hi bitShift: -8)! !

!ThirtyTwoBitRegister class methodsFor: 'instance creation' stamp: 'jm 12/14/1999 16:05'!
new
	"Answer a new instance whose initial contents is zero."

	^ super new load: 0
! !

!ThisContextEyeElement commentStamp: '<historical>'!
This eye element is used in the right panel of the debugger to show thiscontext instead of self as a label!
!ThisContextEyeElement methodsFor: 'accessing' stamp: 'ClementBera 9/11/2013 08:44'!
label
	^ 'thisContext'! !

!ThisContextEyeElement methodsFor: 'accessing' stamp: 'ClementBera 9/11/2013 08:45'!
accessorCode
	^ super label! !

!ThreadSafeTranscript commentStamp: 'BenComan 8/11/2014 22:03'!
I'm an output device.
    Transcript show: 'hello'.

While ThreadSafeTranscript is threadsafe wrt stream access, the morphic code invoked by #changed: is not. So #changed: should not be sent from multiple threads (at random times) since this causes a morph's #update: method to conflict with the UI-thread running the morph's #drawOn: method in parallel. Whereas Morphic seems to assume that #update: and #drawOn: are run sequentially from the same thread.

The #step method is assumed to be invoked only from the main UI thread, so from here it is safe to send #changed: and consequently #update:. Methods #clear and #endEntry are invoked from multiple threads, so these signal to #step to call #changed: with the required parameter (#clearText and #appendEntry respectively.)

Method #contents should not directly return ==stream contents==, since even with a mutex around that, multiple calls from Morphic may unexpectedly get different results and fail.  #contents needs to return a value that is static between each #step (which is ==stepContents== that is only udpated in #step).

The ==stream reset== is left to occur from #clear being invoked from multiple threads. 

The ==stream resetContents== is moved to #step so this occurs directly after ==stepContents== is set from ==stream contents==.



!
!ThreadSafeTranscript methodsFor: 'streaming' stamp: 'IgorStasenko 8/8/2011 15:02'!
ensureCr
	"do nothing, its here only for compatibility"! !

!ThreadSafeTranscript methodsFor: 'streaming' stamp: 'lr 4/1/2009 10:25'!
close
	self flush.
	accessSemaphore critical: [ stream close ]
	! !

!ThreadSafeTranscript methodsFor: 'streaming' stamp: 'NouryBouraqadi 10/2/2009 15:59'!
print: anObject

	self nextPutAll: anObject asString! !

!ThreadSafeTranscript methodsFor: 'color' stamp: 'sd 5/18/2007 22:33'!
white
	"copied from Transcripter"

	Display depth = 1 ifTrue: [^ Bitmap with: 0 "Works without color support"].
	^ Color white! !

!ThreadSafeTranscript methodsFor: '*Tool-Transcript' stamp: 'BenComan 8/11/2014 23:38'!
openLabel: aString 
	| window |
	window := (SystemWindow labelled: aString) model: self.
	window addMorph: (PluggableTextMorph on: self text: nil accept: nil
			readSelection: nil menu: #codePaneMenu:shifted:)
		frame: (0@0 corner: 1@1).
	^ window openInWorld! !

!ThreadSafeTranscript methodsFor: 'streaming' stamp: 'sd 5/19/2007 10:33'!
characterLimit

	^ 20000! !

!ThreadSafeTranscript methodsFor: 'streaming' stamp: 'NouryBouraqadi 10/18/2009 18:15'!
<< aString

	self show: aString! !

!ThreadSafeTranscript methodsFor: 'initialization' stamp: 'BenComan 8/11/2014 22:36'!
initialize
 
	super initialize.
	accessSemaphore := Mutex new.
	stream := String new writeStream.
	deferredClear := false.
	deferredEndEntry := false.
	stepContents := ''.

	! !

!ThreadSafeTranscript methodsFor: 'ui building' stamp: 'lr 9/22/2009 11:40'!
title

	^ 'Transcript'! !

!ThreadSafeTranscript methodsFor: 'printing' stamp: 'stephane.ducasse 3/31/2009 19:33'!
printOn: aStream

	self == Transcript ifFalse: [^super printOn: aStream].
	aStream nextPutAll: 'Transcript'! !

!ThreadSafeTranscript methodsFor: 'streaming' stamp: 'sd 5/18/2007 22:31'!
nextPutAll: value
	
	accessSemaphore
		critical: [stream nextPutAll: value].
	^value! !

!ThreadSafeTranscript methodsFor: 'streaming' stamp: 'NouryBouraqadi 10/2/2009 15:59'!
show: anObject

	self print: anObject ; endEntry! !

!ThreadSafeTranscript methodsFor: '*Shout-Styling' stamp: 'AlainPlantec 8/27/2011 00:20'!
shoutAboutToStyle: aPluggableShoutMorphOrView 
	^ false! !

!ThreadSafeTranscript methodsFor: 'streaming' stamp: 'sd 5/18/2007 15:05'!
cr 
	
	accessSemaphore
		critical: [stream cr].
! !

!ThreadSafeTranscript methodsFor: 'protected low level' stamp: 'sd 5/19/2007 10:36'!
tab
	
	accessSemaphore
		critical: [stream tab].
! !

!ThreadSafeTranscript methodsFor: 'color' stamp: 'sd 5/18/2007 22:33'!
black
	"copied from Transcripter"

	Display depth = 1 ifTrue: [^ Bitmap with: 16rFFFFFFFF "Works without color support"].
	^ Color black! !

!ThreadSafeTranscript methodsFor: 'ui building' stamp: 'NouryBouraqadi 10/18/2009 17:47'!
initialExtent
	
	^447@300! !

!ThreadSafeTranscript methodsFor: 'streaming' stamp: 'BenComan 8/11/2014 22:42'!
clear 
"	Clear all characters by resetting the stream and voiding any previously flagged deferredEndEntry.
	Redisplays the view by signalling for #step to send #changed: .
"	
	accessSemaphore 
		critical: [ 
			deferredClear := true.
			deferredEndEntry := false.
			stream reset ]! !

!ThreadSafeTranscript methodsFor: '*Tool-Transcript' stamp: 'JFLefevre 9/13/2013 16:36'!
codePaneMenu: aMenu shifted: shifted 
	"Note that unless we override perform:orSendTo:, 
	PluggableTextController will respond to all menu items in a 
	text pane"
	
	^ shifted
			ifTrue: [SmalltalkEditor shiftedYellowButtonMenu]
			ifFalse: [SmalltalkEditor yellowButtonMenu].! !

!ThreadSafeTranscript methodsFor: 'streaming' stamp: 'sd 5/18/2007 15:04'!
nextPut: value
	
	accessSemaphore
		critical: [stream nextPut: value].
	^value! !

!ThreadSafeTranscript methodsFor: 'streaming' stamp: 'lr 4/1/2009 10:24'!
with: aBlock
	^ accessSemaphore critical: [ aBlock value: stream ]! !

!ThreadSafeTranscript methodsFor: 'streaming' stamp: 'BenComan 8/11/2014 22:49'!
endEntry
"	Signal to #step to display all the characters since the last #step. 
	Stream is reset there.
"  
  	accessSemaphore critical: [ deferredEndEntry := true ].! !

!ThreadSafeTranscript methodsFor: 'streaming' stamp: 'stephane.ducasse 3/28/2009 21:32'!
reset
	! !

!ThreadSafeTranscript methodsFor: 'protected low level' stamp: 'stephane.ducasse 3/28/2009 21:21'!
space

	accessSemaphore
		critical: [stream space].
! !

!ThreadSafeTranscript methodsFor: 'updating' stamp: 'BenComan 8/12/2014 01:35'!
stepGlobal
"	The superclass method Model>>step indicates a convention that might be used to interoperate 
	synchronously with the UI-thread.  However when multiple Transcript windows are open, their 
	PluggableTextMorphs share a single instance, from the global Transcript.  To avoid potential trouble, 
	this method should not be named #step.  
	
	As well, we need this method to execute even when no Transcript windows are open, so the stream 
	continues to be reset periodically, otherwise it would grow indefinitely. So this method is invoked 
	from WorldState>>runStepMethodsIn:. 
"

	"Next three lines required temporarily to initialize instance variables added to existing instance"
	deferredClear ifNil: [ deferredClear := false ].
	deferredEndEntry ifNil: [ deferredEndEntry := false ].
	stepContents ifNil: [ stepContents := '' ].
	
	deferredClear ifTrue: 
	[ 	deferredClear := false.  
		stepContents := ''.
		self changed: #clearText.
	].
	deferredEndEntry ifTrue: 
	[	deferredEndEntry := false.  	
		accessSemaphore critical: 
		[	stepContents := stream contents.
			stream resetContents.	
		].
		self changed: #appendEntry.	
	].
	! !

!ThreadSafeTranscript methodsFor: 'streaming' stamp: 'NouryBouraqadi 10/18/2009 18:12'!
crShow: anObject

	self cr; show: anObject! !

!ThreadSafeTranscript methodsFor: 'streaming' stamp: 'sd 5/18/2007 22:58'!
flush
	self endEntry
! !

!ThreadSafeTranscript methodsFor: '*Tool-Transcript' stamp: 'MarcusDenker 11/13/2012 15:07'!
open
	"self new open"
	^ self openLabel: self title
! !

!ThreadSafeTranscript methodsFor: 'printing' stamp: 'stephane.ducasse 3/31/2009 19:29'!
isSelfEvaluating

	self == Transcript ifTrue: [^true].
	^super isSelfEvaluating! !

!ThreadSafeTranscript methodsFor: 'protected low level' stamp: 'BenComan 8/11/2014 22:46'!
contents 
"	Cannot directly return == stream contents == since Morphic assumes multiple calls will return 
	the same value within the one cycle.  WorldState>>runStepMethodsIn:  sends #step to 
	do == stepContents := stream contents ==.
"
	^ stepContents! !

!ThreadSafeTranscript methodsFor: 'streaming' stamp: 'sd 3/27/2009 08:43'!
pastEndPut: anObject
	"If the stream reaches its limit, just output the contents and reset."
	
	self endEntry.
	^ self nextPut: anObject! !

!ThreadSafeTranscript class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/15/2013 13:51'!
taskbarIcon
	"Answer the icon for the receiver in a task bar."

	^ Smalltalk ui icons iconNamed: #transcriptIcon! !

!ThreadSafeTranscript class methodsFor: '*Tool-Transcript' stamp: 'TorstenBergmann 2/12/2014 09:24'!
menuCommandOn: aBuilder 
	<worldMenu> 
	(aBuilder item: #'Transcript')
		action: [Smalltalk tools transcript open];
		order: 0.30;
		parent: #Tools;
		help: 'Transcript';
		icon: self taskbarIcon.
	aBuilder withSeparatorAfter.	! !

!ThreadSafeTranscript class methodsFor: 'declare' stamp: 'sd 3/27/2009 08:47'!
install

	self installThreadSafeAsTranscript! !

!ThreadSafeTranscript class methodsFor: '*Tool-Transcript-examples' stamp: 'lr 3/14/2010 21:13'!
examples
	"self examples"

	| tt |
	Smalltalk globals at: #STranscript ifAbsent: [ self installThreadSafeAsSTranscript ].
	tt := Smalltalk globals at: #STranscript.
	tt open.
	tt
		nextPutAll: 'Pharo';
		flush;
		cr;
		tab.
	tt
		show: ' is cool';
		cr.
	tt reset.
	tt clear.
	tt
		nextPutAll: 'Pharo';
		flush;
		cr;
		tab.
	tt
		show: ' is really cool';
		cr! !

!ThreadSafeTranscript class methodsFor: 'declare' stamp: 'MarcusDenker 3/26/2010 16:56'!
installThreadSafeAsTranscript

	Smalltalk globals at: #Transcript put: (self new)

	"ThreadSafeTranscript open"! !

!ThreadSafeTranscript class methodsFor: '*Tool-Transcript' stamp: 'stephane.ducasse 3/28/2009 21:33'!
open 
	"self open"
	
	^ self new open ! !

!ThreadSafeTranscript class methodsFor: 'declare' stamp: 'MarcusDenker 3/26/2010 16:57'!
installThreadSafeAsSTranscript

	Smalltalk globals at: #STranscript put: (self new)
	
	"ThreadSafeTranscript open"! !

!ThreadSafeTranscript class methodsFor: '*Tool-Transcript-examples' stamp: 'lr 3/14/2010 21:13'!
examplesConcurrent
	"self examplesConcurrent"

	| tt |
	Smalltalk globals at: #STranscript ifAbsent: [ self installThreadSafeAsSTranscript ].
	tt := Smalltalk globals at: #STranscript.
	tt open.
	[ 
	1 to: 10 do: [ :i | 
		tt
			nextPutAll: i printString;
			nextPutAll: '*'.
		Processor yield ].
	tt flush ] fork.
	[ 
	100 to: 110 do: [ :i | 
		tt
			nextPutAll: i printString;
			nextPutAll: '-'.
		Processor yield ].
	tt flush ] fork! !

!ThreadSafeTranscript class methodsFor: '*Tool-Transcript-examples' stamp: 'lr 3/14/2010 21:13'!
examplesForegroundUpdate
	"self examplesForegroundUpdate"

	| tt length |
	Smalltalk globals at: #STranscript ifAbsent: [ self installThreadSafeAsSTranscript ].
	tt := Smalltalk globals at: #STranscript.
	tt open.
	length := 20.
	tt
		cr;
		show: 'STARTING----->'.	"Foreground updates"
	1000 to: 1000 + length do: [ :i | 
		tt show: '---' , i printString , '---'.
		(Delay forSeconds: 1) wait ]! !

!ThreePhaseButtonMorph commentStamp: '<historical>'!
A button morph with separate images for on, off, and pressed with the mouse. 

When the event actWhen occurs, send actionSelector with 'arguments' to target.  For other events, default to my eventHandler.  The current event is not supplied in the arguments to the actionSelector.  

image (a.k.a. onImage) may not be nil.  offImage and pressedImage may be nil.  nil there means be transparent and show the underlying object.  

Tools for debugging:
Display the images momentarily under program control (for positioning) (self is an instance).
	self state: #on.  self state: #off.
	self state: #pressed.  self state: #off.
Display a rectangle where the button is.
	Display fillWithColor: bounds + (self world viewBox origin).
	self invalidRect: bounds.!
!ThreePhaseButtonMorph methodsFor: 'accessing' stamp: 'tk 10/19/97 15:02'!
pressedImage
	^ pressedImage! !

!ThreePhaseButtonMorph methodsFor: 'submorphs-add/remove' stamp: 'tk 6/30/97 10:49'!
actWhen: condition
	"Accepts symbols:  #buttonDown, #buttonUp, and #whilePressed"
	actWhen := condition! !

!ThreePhaseButtonMorph methodsFor: 'event handling' stamp: 'SvenVanCaekenberghe 12/4/2012 19:07'!
mouseUp: evt
	"Allow on:send:to: to set the response to events other than actWhen"
	actWhen == #buttonUp ifFalse: [^super mouseUp: evt].

	(self containsPoint: evt cursorPoint) ifTrue: [
		self state: #on.
		self doButtonAction: evt
	] ifFalse: [
		self state: #off.
	].
	"Allow owner to keep it selected for radio buttons"
! !

!ThreePhaseButtonMorph methodsFor: 'accessing' stamp: 'tk 10/19/97 15:02'!
offImage
	^ offImage! !

!ThreePhaseButtonMorph methodsFor: 'copying' stamp: 'tk 1/8/1999 09:02'!
veryDeepFixupWith: deepCopier
	"If target and arguments fields were weakly copied, fix them here.  If they were in the tree being copied, fix them up, otherwise point to the originals!!!!"

super veryDeepFixupWith: deepCopier.
target := deepCopier references at: target ifAbsent: [target].
arguments := arguments collect: [:each |
	deepCopier references at: each ifAbsent: [each]].
! !

!ThreePhaseButtonMorph methodsFor: 'event handling' stamp: 'tk 6/30/97 10:52'!
handlesMouseDown: evt

	^ true
! !

!ThreePhaseButtonMorph methodsFor: 'event handling' stamp: 'ar 10/25/2000 18:17'!
mouseStillDown: evt
	actWhen == #whilePressed ifFalse:[^self].
	(self containsPoint: evt cursorPoint) ifTrue:[self doButtonAction].! !

!ThreePhaseButtonMorph methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 11:13'!
initialize

	super initialize.
	state := #off.
	target := nil.
	actionSelector := #flash.
	arguments := EmptyArray.
	actWhen := #buttonUp.

	"self on: #mouseStillDown send: #dragIfAuthoring: to: self."
		"real move should include a call on dragIfAuthoring: "! !

!ThreePhaseButtonMorph methodsFor: 'printing' stamp: 'dgd 2/22/2003 18:45'!
printOn: aStream 
	| string |
	aStream nextPutAll: '3PButton'.
	arguments notEmpty 
		ifTrue: [string := arguments at: (2 min: arguments size)].
	aStream nextPutAll: '('.
	(string notNil and: [string ~~ self]) 
		ifTrue: 
			[aStream
				print: string;
				space]
		ifFalse: 
			[aStream
				print: actionSelector;
				space].
	aStream
		print: self identityHash;
		nextPutAll: ')'! !

!ThreePhaseButtonMorph methodsFor: 'button' stamp: 'dgd 2/22/2003 18:45'!
doButtonAction
	"Perform the action of this button. Subclasses may override this method. The default behavior is to send the button's actionSelector to its target object with its arguments."

	(target notNil and: [actionSelector notNil]) 
		ifTrue: 
			[Cursor normal 
				showWhile: [target perform: actionSelector withArguments: arguments].
			target isMorph ifTrue: [target changed]]! !

!ThreePhaseButtonMorph methodsFor: 'testing' stamp: 'ar 10/11/2000 14:05'!
stepTime
	(self hasProperty: #doesButtonAction) ifTrue:[^1].
	^super stepTime! !

!ThreePhaseButtonMorph methodsFor: 'accessing' stamp: 'tk 10/19/97 15:02'!
onImage
	^ image! !

!ThreePhaseButtonMorph methodsFor: 'event handling' stamp: 'ar 10/25/2000 18:18'!
mouseMove: evt
	(self containsPoint: evt cursorPoint)
		ifTrue: [self state: #pressed.
				super mouseMove: evt]
				"Allow on:send:to: to set the response to events other than actWhen"
		ifFalse: [self state: #off].
! !

!ThreePhaseButtonMorph methodsFor: 'copying' stamp: 'tk 1/8/1999 09:01'!
veryDeepInner: deepCopier
	"Copy all of my instance variables.  Some need to be not copied at all, but shared.  	Warning!!!!  Every instance variable defined in this class must be handled.  We must also implement veryDeepFixupWith:.  See DeepCopier class comment."

super veryDeepInner: deepCopier.
offImage := offImage veryDeepCopyWith: deepCopier.
pressedImage := pressedImage veryDeepCopyWith: deepCopier.
state := state veryDeepCopyWith: deepCopier.
"target := target.		Weakly copied"
"actionSelector := actionSelector.		Symbol"
"arguments := arguments.		Weakly copied"
actWhen := actWhen.		"Symbol"! !

!ThreePhaseButtonMorph methodsFor: 'testing' stamp: 'sw 3/8/1999 13:56'!
isOn
	^ state == #on! !

!ThreePhaseButtonMorph methodsFor: 'accessing' stamp: 'tk 6/30/97 10:50'!
target: anObject

	target := anObject
! !

!ThreePhaseButtonMorph methodsFor: 'accessing' stamp: 'tk 6/30/97 11:01'!
state: newState
	"Change the image and invalidate the rect."

	newState == state ifTrue: [^ self].
	state := newState.
	self invalidRect: bounds.	"All three images must be the same size"! !

!ThreePhaseButtonMorph methodsFor: 'accessing' stamp: 'tk 6/30/97 10:49'!
actionSelector: aSymbolOrString

	(nil = aSymbolOrString or:
	 ['nil' = aSymbolOrString or:
	 [aSymbolOrString isEmpty]])
		ifTrue: [^ actionSelector := nil].

	actionSelector := aSymbolOrString asSymbol.
! !

!ThreePhaseButtonMorph methodsFor: 'geometry' stamp: 'tk 7/1/97 09:14'!
extent: aPoint
	"Do it normally"
	
	self changed.
	bounds := bounds topLeft extent: aPoint.
	self layoutChanged.
	self changed.
! !

!ThreePhaseButtonMorph methodsFor: 'drawing' stamp: 'tk 10/9/2002 10:20'!
drawOn: aCanvas

	state == #off ifTrue: [
		offImage ifNotNil: [aCanvas translucentImage: offImage at: bounds origin]].
	state == #pressed ifTrue: [
		pressedImage ifNotNil: [aCanvas translucentImage: pressedImage at: bounds origin]].
	state == #on ifTrue: [
		image ifNotNil: [aCanvas translucentImage: image at: bounds origin]].! !

!ThreePhaseButtonMorph methodsFor: 'accessing' stamp: 'tk 6/30/97 10:09'!
pressedImage: aForm
	pressedImage := aForm.
	self invalidRect: self bounds.! !

!ThreePhaseButtonMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/10/2015 18:01'!
drawOnAthensCanvas: anAthensCanvas
	| paint |
	paint := offImage.
	
	state == #pressed
		ifTrue: [ paint := pressedImage ].
	state == #on
		ifTrue: [ paint := image ].
	paint ifNil: [ ^ self ].
	
	anAthensCanvas setPaint: paint.
	anAthensCanvas paintTransform
		restoreAfter: [ 
			anAthensCanvas paintTransform translateBy: self innerBounds origin.	
			anAthensCanvas drawShape: self innerBounds ]! !

!ThreePhaseButtonMorph methodsFor: 'button' stamp: 'gvc 8/27/2009 16:08'!
onImage: aForm
	"The main image is used when on.
	Go through ImageMorph method to set extent."
	
	self image: aForm! !

!ThreePhaseButtonMorph methodsFor: 'event handling' stamp: 'nice 1/5/2010 15:59'!
doButtonAction: evt
	
	"Perform the action of this button. Subclasses may override this method. The default behavior is to send the button's actionSelector to its target object with its arguments."

	target ifNil: [^self].
	actionSelector ifNil: [^self].
	Cursor normal showWhile: [ | moreArgs |
		moreArgs := actionSelector numArgs > arguments size ifTrue: [
			arguments copyWith: evt
		] ifFalse: [
			arguments
		].
		target perform: actionSelector withArguments: moreArgs
	]! !

!ThreePhaseButtonMorph methodsFor: 'accessing' stamp: 'tk 7/1/97 08:39'!
arguments: aCollection

	arguments := aCollection asArray copy.
! !

!ThreePhaseButtonMorph methodsFor: 'stepping and presenter' stamp: 'ar 10/11/2000 14:05'!
step
	(self hasProperty: #doesButtonAction) ifTrue:[
		self doButtonAction.
		self setProperty: #didButtonAction toValue: true.
	].! !

!ThreePhaseButtonMorph methodsFor: 'testing' stamp: 'ar 10/11/2000 14:06'!
wantsSteps
	^(self hasProperty: #doesButtonAction) or:[super wantsSteps]! !

!ThreePhaseButtonMorph methodsFor: 'accessing' stamp: 'tk 6/30/97 10:49'!
actionSelector

	^ actionSelector
! !

!ThreePhaseButtonMorph methodsFor: 'accessing' stamp: 'tk 6/30/97 10:08'!
offImage: aForm
	offImage := aForm.
	self invalidRect: self bounds.! !

!ThreePhaseButtonMorph methodsFor: 'event handling' stamp: 'ar 10/25/2000 18:16'!
mouseDown: evt
	| now dt |
	self state: #pressed.
	actWhen == #buttonDown
		ifTrue:
			[self doButtonAction]
		ifFalse:
			[now := Time millisecondClockValue.
			super mouseDown: evt.
			"Allow on:send:to: to set the response to events other than actWhen"
			dt := Time millisecondClockValue - now max: 0.  "Time it took to do"
			dt < 200 ifTrue: [(Delay forMilliseconds: 200-dt) wait]].
	self mouseStillDown: evt.! !

!ThreePhaseButtonMorph methodsFor: 'accessing' stamp: 'tk 7/1/97 12:39'!
arguments
	^ arguments! !

!ThreePhaseButtonMorph methodsFor: 'accessing' stamp: 'tk 6/30/97 10:50'!
target

	^ target
! !

!ThreePhaseButtonMorph methodsFor: 'event handling' stamp: 'ar 10/25/2000 18:18'!
handlesMouseStillDown: evt
	^actWhen == #whilePressed! !

!ThreePhaseButtonMorph class methodsFor: 'instance creation' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
radioButton
	"Answer a button pre-initialized with radiobutton images."
	| f |
	^self new
		onImage: (f := Smalltalk ui icons radioButtonOnIcon);
		pressedImage: (Smalltalk ui icons radioButtonPressedIcon);
		offImage: (Smalltalk ui icons radioButtonOffIcon);
		extent: f extent + (2@0);
		yourself
! !

!ThreePhaseButtonMorph class methodsFor: 'instance creation' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
checkBox
	"Answer a button pre-initialized with checkbox images."
	| f |
	^self new
		onImage: (f := Smalltalk ui icons checkBoxOnIcon);
		pressedImage: (Smalltalk ui icons checkBoxPressedIcon);
		offImage: (Smalltalk ui icons checkBoxOffIcon);
		extent: f extent + (2@0);
		yourself
! !

!ThumbnailMorph commentStamp: 'sw 1/6/2005 03:47'!
A Morph that views another morph, its objectToView.!
!ThumbnailMorph methodsFor: 'initialization' stamp: 'dgd 3/7/2003 14:56'!
defaultColor
"answer the default color/fill style for the receiver"
	^ Color
		r: 0.781
		g: 0.781
		b: 0.781! !

!ThumbnailMorph methodsFor: 't-rotating' stamp: ''!
forwardDirection: newDirection
	"Set the receiver's forward direction (in eToy terms)"
	self setProperty: #forwardDirection toValue: newDirection.! !

!ThumbnailMorph methodsFor: 'copying' stamp: 'tk 1/7/1999 14:57'!
veryDeepFixupWith: deepCopier
	"If target and arguments fields were weakly copied, fix them here.  If they were in the tree being copied, fix them up, otherwise point to the originals!!!!"

super veryDeepFixupWith: deepCopier.
objectToView := deepCopier references at: objectToView ifAbsent: [objectToView].! !

!ThumbnailMorph methodsFor: 'caching' stamp: 'ar 3/3/2001 19:37'!
releaseCachedState
	super releaseCachedState.
	lastSketchForm := lastFormShown := nil.! !

!ThumbnailMorph methodsFor: 'accessing' stamp: 'sw 1/6/2005 17:03'!
getSelector: aSelector
	"Set the selector used to obtain my value"

	self objectToView: objectToView viewSelector: aSelector! !

!ThumbnailMorph methodsFor: 't-rotating' stamp: ''!
forwardDirection
	"Return the receiver's forward direction (in eToy terms)"
	^self valueOfProperty: #forwardDirection ifAbsent:[0.0]! !

!ThumbnailMorph methodsFor: 'initialization' stamp: 'sw 6/9/2000 18:35'!
objectToView: objectOrNil
	(objectOrNil isMorph and: [objectOrNil allMorphs includes: self]) ifTrue:
		["cannot view a morph containing myself or drawOn: goes into infinite recursion"
		objectToView := nil.
		^ self].
	objectToView := objectOrNil! !

!ThumbnailMorph methodsFor: 'initialization' stamp: 'MarcusDenker 12/12/2009 00:01'!
initialize
	"Initialize the receiver, obeying a #nominalExtent property if I have one"
	| anExtent |
	
	super initialize.
	anExtent := self valueOfProperty: #nominalExtent ifAbsent: [25@25].
	self extent: anExtent! !

!ThumbnailMorph methodsFor: 'initialization' stamp: 'sw 6/9/2000 18:35'!
objectToView: objectOrNil viewSelector: aSelector
	self objectToView: objectOrNil.
	viewSelector := aSelector! !

!ThumbnailMorph methodsFor: 't-rotating' stamp: ''!
prepareForRotating
	"If I require a flex shell to rotate,
	then wrap it in one and return it.
	Polygons, eg, may override to do nothing."

	^ self addFlexShell! !

!ThumbnailMorph methodsFor: 't-rotating' stamp: ''!
setDirectionFrom: aPoint
	| delta degrees |
	delta := (self transformFromWorld globalPointToLocal: aPoint) - self referencePosition.
	degrees := delta degrees + 90.0.
	self forwardDirection: (degrees \\ 360) rounded.
! !

!ThumbnailMorph methodsFor: 'display' stamp: 'wiz 8/6/2005 22:01'!
drawForForm: aForm on: aCanvas
	"Draw a small view of the given form on the canvas"

	| scale shrunkForm viewedObjectBox interimCanvas |
	viewedObjectBox := aForm boundingBox.
	scale :=  self scaleFor: viewedObjectBox in: self innerBounds.
	interimCanvas := Display defaultCanvasClass extent: viewedObjectBox extent depth: aCanvas depth.
	interimCanvas translateBy: viewedObjectBox topLeft negated 
				during: [:tempCanvas | tempCanvas drawImage: aForm at: 0@0].
	shrunkForm := interimCanvas form magnify: interimCanvas form boundingBox by: scale smoothing: 1.
	lastFormShown := shrunkForm.

	aCanvas paintImage: shrunkForm at: self center - shrunkForm boundingBox center! !

!ThumbnailMorph methodsFor: 'copying' stamp: 'ar 10/26/2000 23:55'!
veryDeepInner: deepCopier
	"Copy all of my instance variables.  Some need to be not copied at all, but shared.  	Warning!!!!  Every instance variable defined in this class must be handled.  We must also implement veryDeepFixupWith:.  See DeepCopier class comment."

super veryDeepInner: deepCopier.
"objectToView := objectToView.		Weakly copied"
viewSelector := viewSelector veryDeepCopyWith: deepCopier.
lastSketchForm := lastSketchForm veryDeepCopyWith: deepCopier.
lastFormShown := lastFormShown veryDeepCopyWith: deepCopier.
drawTime := drawTime veryDeepCopyWith: deepCopier.
! !

!ThumbnailMorph methodsFor: 'what to view' stamp: 'StephaneDucasse 5/28/2011 13:37'!
formOrMorphToView
	"Answer the form to be viewed, or the morph to be viewed, or nil"

	| actualViewee |
	(objectToView isForm) ifTrue: [^objectToView].
	actualViewee := viewSelector ifNil: [objectToView]
				ifNotNil: [objectToView perform: viewSelector].
	^actualViewee = 0 
		ifTrue: [nil]
		ifFalse: [actualViewee]! !

!ThumbnailMorph methodsFor: 'accessing' stamp: 'sw 1/6/2005 17:06'!
putSelector
	"Answer the selector used  for the receiver to send a fresh value back to its target"

	^ nil! !

!ThumbnailMorph methodsFor: 'stepping and presenter' stamp: 'marcus.denker 2/23/2009 11:20'!
stepTime 
	"Adjust my step time to the time it takes drawing my referent"
	drawTime ifNil:[^ 250].
	^(20 * drawTime) max: 250.! !

!ThumbnailMorph methodsFor: 'initialization' stamp: 'dgd 3/7/2003 14:57'!
defaultBorderWidth
"answer the default border width for the receiver"
	^ 1! !

!ThumbnailMorph methodsFor: 't-rotating' stamp: ''!
rotationDegrees: degrees	
	"redefined in all morphs which are using myself"! !

!ThumbnailMorph methodsFor: 'drawing' stamp: 'ar 10/26/2000 23:45'!
drawOn: aCanvas
	"Draw a small view of a morph in another place. Guard against infinite recursion if that morph has a thumbnail of itself inside."
	| time |
	time := Time millisecondClockValue.
	self drawMeOn: aCanvas.
	drawTime := Time millisecondClockValue - time.
	drawTime < 0 ifTrue:[drawTime := nil].
! !

!ThumbnailMorph methodsFor: 'accessing' stamp: 'sw 1/6/2005 01:46'!
getSelector
	"Answer the selector I send to my target to retrieve my value"

	^ viewSelector! !

!ThumbnailMorph methodsFor: 't-rotating' stamp: ''!
heading
	"Return the receiver's heading"
	^ self owner 
		ifNil: [self forwardDirection]
		ifNotNil: [self forwardDirection + self owner degreesOfFlex]! !

!ThumbnailMorph methodsFor: 'what to view' stamp: 'StephaneDucasse 5/28/2011 13:37'!
actualViewee
	"Return the actual morph to be viewed, or nil if there isn't an appropriate morph to view."

	| aMorph actualViewee |
	aMorph := self morphToView ifNil: [^ nil]. 
	aMorph isInWorld ifFalse: [^ nil].
	actualViewee := viewSelector ifNil: [aMorph] ifNotNil: [objectToView perform: viewSelector].
	actualViewee = 0 ifTrue: [^ nil].  
	actualViewee ifNil: [actualViewee := objectToView].
	(actualViewee isMorph and: 
		[actualViewee isFlexMorph and: [actualViewee submorphs size = 1]])
			ifTrue: [actualViewee := actualViewee firstSubmorph].
	^ actualViewee! !

!ThumbnailMorph methodsFor: 'stepping and presenter' stamp: 'MarcusDenker 10/28/2010 14:04'!
step
	"Optimization: Don't redraw if we're viewing some kind of SketchMorph and its rotated Form hasn't changed."

	| viewee |
	viewee := self actualViewee.
	viewee ifNil: [ self stopStepping. ^self ].
	self changed.
! !

!ThumbnailMorph methodsFor: 'display' stamp: 'wiz 8/6/2005 21:58'!
scaleFor:  viewedMorphBox in: myBox
	"Compute the proper scale for the thumbnail."

	|   scale  scaleX scaleY ratio factor  |
scaleX := myBox width asFloat / viewedMorphBox width.
				scaleY := myBox height asFloat / viewedMorphBox height.
				ratio := scaleX / scaleY.
				factor := 1.0 / EccentricityThreshhold.
				ratio < factor
					ifTrue:
						[scale := (scaleX) @ (factor * scaleY)]
					ifFalse:
						[ratio > EccentricityThreshhold
							ifTrue:
								[scale := (factor * scaleX) @ scaleY]
							ifFalse:
								[scale := scaleX min: scaleY]].
^ scale
! !

!ThumbnailMorph methodsFor: 'display' stamp: 'wiz 8/6/2005 22:11'!
drawMeOn: aCanvas 
	"Draw a small view of a morph in another place.  Guard against infinite recursion if that morph has a thumbnail of itself inside.  Now also works if the thing to draw is a plain Form rather than a morph."

	| viewedMorphBox scale c shrunkForm aWorld aFormOrMorph  |
	super drawOn: aCanvas.
	((aFormOrMorph := self formOrMorphToView) isForm) 
		ifTrue: [^self drawForForm: aFormOrMorph on: aCanvas].
	(((aFormOrMorph notNil and: [(aWorld := aFormOrMorph world) notNil]) 
		and: [aWorld ~~ aFormOrMorph or: [lastFormShown isNil]]) 
			and: [RecursionDepth + 1 < RecursionMax]) 
			ifTrue: 
				[RecursionDepth := RecursionDepth + 1.
				viewedMorphBox := aFormOrMorph fullBounds.
			scale :=  self scaleFor: viewedMorphBox in: self innerBounds.
				c := Display defaultCanvasClass extent: viewedMorphBox extent
							depth: aCanvas depth.
				c translateBy: viewedMorphBox topLeft negated
					during: 
						[:tempCanvas | 
						"recursion happens here"
						tempCanvas fullDrawMorph: aFormOrMorph].
				shrunkForm := c form 
							magnify: c form boundingBox
							by: scale
							smoothing: 1.
				lastFormShown := shrunkForm.
				RecursionDepth := RecursionDepth - 1]
			ifFalse: 
				["This branch used if we've recurred, or if the thumbnail views a World that's already been rendered once, or if the referent is not in a world at the moment"
				lastFormShown ifNotNil: [shrunkForm := lastFormShown]].
	shrunkForm ifNotNil: 
			[aCanvas paintImage: shrunkForm
				at: self center - shrunkForm boundingBox center]! !

!ThumbnailMorph methodsFor: 'what to view' stamp: 'MarcusDenker 10/26/2011 15:18'!
morphToView
	"If the receiver is viewing some object, answer a morph can be thought of as being viewed;  A gesture is made toward generalizing this beyond the morph/player regime, in that a plain blue rectangle is returned rather than simply failing if the referent is not itself displayable."

	objectToView ifNil: [^ nil].
	^ objectToView isMorph
		ifTrue:
			[objectToView]
		ifFalse:
			[Morph new color: Color blue]
! !

!ThumbnailMorph methodsFor: 'accessing' stamp: 'sw 1/6/2005 01:39'!
target
	"Answer the object on which I act"

	^ objectToView! !

!ThumbnailMorph methodsFor: 't-rotating' stamp: ''!
rotationDegrees
	"Default implementation."

	^ 0.0
! !

!ThumbnailMorph class methodsFor: 'example' stamp: 'MarcusDenker 10/26/2011 15:18'!
example1
	"Create a thumbnail representing another Morph. The thumbnail is continously updated."
	"self example1"
	| t r |
	r := Morph new.
	r position: 100@200.
	t := ThumbnailMorph new objectToView: r viewSelector: #openInWorld.
	t openInWorld! !

!ThumbnailMorph class methodsFor: 'initialization' stamp: 'sw 12/30/2004 00:47'!
initialize
	"Initialize the class variables of ThumbnailMorph"

	RecursionMax := 2.
	RecursionDepth := 0.
	EccentricityThreshhold :=  Float pi

"ThumbnailMorph initialize"! !

!ThumbnailMorph class methodsFor: 'as yet unclassified' stamp: 'sw 5/3/1998 19:12'!
recursionReset
	"ThumbnailMorph recursionReset"
	"Reset the RecursionDepth counter in case the user interrupted
during a thumbnail being drawn.  Do this just once in a while when no
drawOn: is being called.  tk 9/8/97"

	RecursionDepth := 0.! !

!TickDialogWindow commentStamp: 'StephaneDucasse 4/3/2015 15:00'!
A TickDialogWindow is a modal dialog window which contains a TickList where user can pick a list of items.

See self example!
!TickDialogWindow methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2011 06:16'!
resultStorage

	^ resultStorage! !

!TickDialogWindow methodsFor: 'display' stamp: 'BenjaminVanRyseghem 1/24/2013 13:52'!
newContentMorph

	self listModel: ((self tickListClass 
						itemsList: self itemsList 
						itemsHeaderName: self itemsHeaderName 
						wrapBlockOrSelector: self wrapBlockOrSelector)
						autoMultiSelection: true;
						beCheckList;
						yourself).
	
	self listMorph: (self listModel defaultTreeMorph
								buildContents;
								vResizing: #spaceFill;
								hResizing: #spaceFill).
								
	self defaultValue ifTrue: [ self listMorph selectAll ].							
	^ self listMorph! !

!TickDialogWindow methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2011 05:35'!
itemsList: anObject
	
	itemsList := anObject! !

!TickDialogWindow methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2011 14:31'!
listModel

	^ listModel! !

!TickDialogWindow methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2011 06:16'!
resultStorage: anObject
	
	resultStorage := anObject! !

!TickDialogWindow methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2011 06:18'!
wrapBlockOrSelector: anObject
	
	wrapBlockOrSelector := anObject! !

!TickDialogWindow methodsFor: 'display' stamp: 'StephaneDucasse 9/17/2011 18:23'!
choose

	^ self chooseFromOwner: World! !

!TickDialogWindow methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2011 05:35'!
itemsList

	^ itemsList! !

!TickDialogWindow methodsFor: 'private' stamp: 'BenjaminVanRyseghem 1/24/2013 13:45'!
tickListClass

	^ MorphTreeModel! !

!TickDialogWindow methodsFor: 'display' stamp: 'BenjaminVanRyseghem 9/17/2011 14:34'!
chooseFromOwner: aMorph

	aMorph openModal: self.
	^ resultStorage! !

!TickDialogWindow methodsFor: 'accessing' stamp: 'AlainPlantec 9/29/2011 00:37'!
defaultValue

	^ defaultValue ifNil: [defaultValue := false]! !

!TickDialogWindow methodsFor: 'display' stamp: 'BenjaminVanRyseghem 9/26/2011 16:10'!
initialExtent
	
	| width |
	width := (self listMorph allNodeMorphs detectMax: [:e | e width]) width.
	width := width+ 50.
	
	^width@400! !

!TickDialogWindow methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2011 14:32'!
listModel: aModel

	listModel := aModel! !

!TickDialogWindow methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/24/2014 12:03'!
selectItems: aCollection 
	self listModel selectItems: aCollection! !

!TickDialogWindow methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2011 05:35'!
itemsHeaderName

	^ itemsHeaderName! !

!TickDialogWindow methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2011 05:35'!
itemsHeaderName: anObject
	
	itemsHeaderName := anObject! !

!TickDialogWindow methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2011 15:36'!
defaultValue: aBoolean

	defaultValue := aBoolean! !

!TickDialogWindow methodsFor: 'display' stamp: 'StephaneDucasse 4/3/2015 14:48'!
openInWorld

	self choose 
	"since it is modal"
	! !

!TickDialogWindow methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2011 06:18'!
wrapBlockOrSelector

	^ wrapBlockOrSelector! !

!TickDialogWindow methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/17/2011 06:24'!
isResizeable

	^ true! !

!TickDialogWindow methodsFor: 'accessing' stamp: 'EstebanLorenzano 10/24/2014 11:59'!
selectedItems 
	^ self listModel selectedItems! !

!TickDialogWindow methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2011 05:51'!
listMorph

	^ listMorph! !

!TickDialogWindow methodsFor: 'actions' stamp: 'BenjaminVanRyseghem 9/17/2011 14:30'!
accept

	self resultStorage: self listModel selectedItems.! !

!TickDialogWindow methodsFor: 'focus handling' stamp: 'BenjaminVanRyseghem 9/17/2011 14:35'!
defaultFocusMorph

	^ self listMorph 
		ifNil: [ super defaultFocusMorph ]
		ifNotNil: [:morph | morph ]! !

!TickDialogWindow methodsFor: 'compatibility' stamp: 'BenjaminVanRyseghem 9/17/2011 06:05'!
hasUnacceptedEdits

	^ true! !

!TickDialogWindow methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2011 05:51'!
listMorph: anObject
	
	listMorph := anObject! !

!TickDialogWindow class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 9/17/2011 15:43'!
itemsList: itemsList itemsHeaderName: aName title: aTitle defaultValue: aBoolean
	^ self basicNew
		itemsList: itemsList;
		itemsHeaderName: aName;
		defaultValue: aBoolean;
		initialize;
		title: aTitle;
		yourself! !

!TickDialogWindow class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 9/17/2011 15:05'!
itemsList: itemsList itemsHeaderName: aName wrapBlockOrSelector: aBlockOrSelector title: aTitle
	^ self basicNew
		itemsList: itemsList;
		itemsHeaderName: aName;
		wrapBlockOrSelector: aBlockOrSelector;
		initialize;
		title: aTitle;
		yourself! !

!TickDialogWindow class methodsFor: 'example' stamp: 'MarcusDenker 5/6/2013 17:11'!
example
	
	(self itemsList: Morph methods itemsHeaderName: 'Plop' wrapBlockOrSelector: #selector title: 'Example') choose! !

!TickDialogWindow class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 9/17/2011 15:42'!
itemsList: itemsList itemsHeaderName: aName wrapBlockOrSelector: aBlockOrSelector title: aTitle defaultValue: aBoolean
	^ self basicNew
		itemsList: itemsList;
		itemsHeaderName: aName;
		wrapBlockOrSelector: aBlockOrSelector;
		defaultValue: aBoolean;
		initialize;
		title: aTitle;
		yourself! !

!TickDialogWindow class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 9/17/2011 15:06'!
itemsList: itemsList itemsHeaderName: aName title: aTitle

	^ self basicNew
		itemsList: itemsList;
		itemsHeaderName: aName;
		initialize;
		title: aTitle;
		yourself! !

!TickSelectionCheckboxButtonMorph commentStamp: '<historical>'!
A TickSelectionCheckboxButtonMorph is the button hidden into the TickSelectionCheckboxMorph!
!TickSelectionCheckboxButtonMorph methodsFor: 'event' stamp: 'BenjaminVanRyseghem 9/19/2011 16:56'!
mouseUp: evt
	"Handle the transitions."
	| result |
	result := super mouseUp: evt.
	self pressed: index.
	^ result ! !

!TickSelectionCheckboxButtonMorph methodsFor: 'event' stamp: 'BenjaminVanRyseghem 9/17/2011 05:05'!
pressed: anIndex

	self owner pressed: anIndex! !

!TickSelectionCheckboxButtonMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2011 05:30'!
index: anIndex

	index := anIndex! !

!TickSelectionCheckboxMorph commentStamp: '<historical>'!
A TickSelectionCheckboxMorph is a checkbox which propagate a bit more the events!
!TickSelectionCheckboxMorph methodsFor: 'event' stamp: 'BenjaminVanRyseghem 9/17/2011 05:08'!
pressed: anIndex

	self owner owner pressed: anIndex! !

!TickSelectionCheckboxMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2011 05:30'!
index: anIndex

	index := anIndex! !

!TickSelectionCheckboxMorph methodsFor: 'morph' stamp: 'BenjaminVanRyseghem 9/17/2011 05:10'!
newButtonMorph
	"Answer a new button morph"

	| instance |
	instance := TickSelectionCheckboxButtonMorph new
		target: self;
		actionSelector: #toggleSelected;
		vResizing: #shrinkWrap;
		hResizing: #shrinkWrap.
		
	instance index: index.
	^ instance! !

!TickSelectionListMorph commentStamp: '<historical>'!
A TickSelectionListMorph is used to render the tick list

storeValue
	- xxxxx
!
!TickSelectionListMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2011 03:25'!
storeValue

	^ storeValue! !

!TickSelectionListMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2011 03:25'!
mouseUp: event 

	self storeValue: nil.
	super mouseUp: event ! !

!TickSelectionListMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2011 03:08'!
indentingItemClass
	
	^ TickSelectionListNodeMorph! !

!TickSelectionListMorph methodsFor: 'event' stamp: 'BenjaminVanRyseghem 9/29/2011 02:52'!
basicKeyPressed: aCharacter

	aCharacter == Character space
		ifTrue: [ ^ self model toogleSelectionValue ].
	
	^ super basicKeyPressed: aCharacter! !

!TickSelectionListMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2011 03:25'!
storeValue: anObject
	
	storeValue := anObject! !

!TickSelectionListNode commentStamp: '<historical>'!
A TickSelectionListNode is node for the tree used to render the tick list

selected
	- xxxxx
!
!TickSelectionListNode methodsFor: 'morph' stamp: 'BenjaminVanRyseghem 9/17/2011 02:15'!
nameMorph

	^ LabelMorph new contents: self name; enabled: false; hResizing: #spaceFill;yourself! !

!TickSelectionListNode methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2011 15:58'!
selected

	^ self item selected! !

!TickSelectionListNode methodsFor: 'event' stamp: 'BenjaminVanRyseghem 9/17/2011 05:05'!
pressed: anIndex

	self model pressed: anIndex! !

!TickSelectionListNode methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2011 15:58'!
selected: aBoolean

	self item selected: aBoolean! !

!TickSelectionListNode methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/29/2011 02:55'!
toogleSelectionValue
	
	self item toogleSelectionValue! !

!TickSelectionListNode methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/17/2011 05:41'!
name

	^ self item itemName asString! !

!TickSelectionListNode methodsFor: 'morph' stamp: 'BenjaminVanRyseghem 9/17/2011 05:16'!
selectedMorph
	^ (TickSelectionCheckboxMorph basicNew index: (self model rootItems indexOf: self item);
		initialize;	
		model: self item;
		getStateSelector: #selected;
		setStateSelector: #selected:;
		updateSelection;
		getEnabledSelector: nil;
		font: StandardFonts defaultFont;
		label: '';
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap;
		setBalloonText: nil) color: Color transparent; yourself! !

!TickSelectionListNodeMorph commentStamp: '<historical>'!
A TickSelectionListNodeMorph is the morph used to render the tree used to render te tick list!
!TickSelectionListNodeMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2011 03:24'!
storeValue

	^ self owner owner storeValue! !

!TickSelectionListNodeMorph methodsFor: 'event' stamp: 'BenjaminVanRyseghem 9/17/2011 05:09'!
pressed: anIndex 

	self complexContents pressed: anIndex! !

!TickSelectionListNodeMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/17/2011 03:24'!
storeValue: aValue

	^ self owner owner storeValue: aValue! !

!TickSelectionListNodeMorph methodsFor: 'drawing' stamp: 'BenjaminVanRyseghem 9/17/2011 03:25'!
drawMouseDownHighlightOn: aCanvas
	"Draw with a dotted border."

	self highlightedForMouseDown 
		ifTrue: [
			container ifNil: [^super drawMouseDownHighlightOn: aCanvas].
			self storeValue ifNil: [ self storeValue: self complexContents selected not ].
			self complexContents selected: self storeValue.
			aCanvas 
				frameRectangle: self selectionFrame
				width: 1
				colors: {container mouseDownHighlightColor. Color transparent}
				dashes: #(1 1)]! !

!TickingSpecWindow commentStamp: 'StephaneDucasse 3/7/2014 10:41'!
TickingSpecWindow new openInWorld!
!TickingSpecWindow methodsFor: 'stepping and presenter' stamp: 'StephaneDucasse 4/4/2014 08:36'!
step
	self model step.! !

!TickingSpecWindow methodsFor: 'stepping' stamp: 'StephaneDucasse 3/7/2014 10:40'!
wantsSteps
	^ true! !

!TickingSpecWindow methodsFor: 'stepping' stamp: 'StephaneDucasse 3/7/2014 10:49'!
stepTime

	^ self model stepTime! !

!TickingWindowModel commentStamp: 'StephaneDucasse 3/7/2014 10:45'!
In addition to my superclass, I provide an API to execute the #step method every #stepTime.!
!TickingWindowModel methodsFor: 'initialization' stamp: 'StephaneDucasse 3/7/2014 10:46'!
step
	self model step.! !

!TickingWindowModel methodsFor: 'stepping' stamp: 'StephaneDucasse 3/7/2014 10:47'!
stepTime
	^ self model stepTime! !

!TickingWindowModel class methodsFor: 'specs' stamp: 'StephaneDucasse 3/7/2014 11:10'!
defaultSpec
	<spec>
	
	^ #(TickingWindowAdapter
		adapt: #(model))! !

!TickingWindowModel class methodsFor: 'specs' stamp: 'StephaneDucasse 3/7/2014 11:09'!
adapterName

	^ #TickingWindowAdapter! !

!Time commentStamp: 'dew 10/23/2004 17:58'!
This represents a particular point in time during any given day.  For example, '5:19:45 pm'.

If you need a point in time on a particular day, use DateAndTime.  If you need a duration of time, use Duration.
!
!Time methodsFor: 'accessing' stamp: 'brp 8/23/2003 22:07'!
minutes

	^ self asDuration minutes! !

!Time methodsFor: 'converting' stamp: 'brp 8/23/2003 15:55'!
asSeconds
 	"Answer the number of seconds since midnight of the receiver."
 
 	^ seconds! !

!Time methodsFor: 'accessing' stamp: 'brp 7/27/2003 18:18'!
seconds

	^ self second! !

!Time methodsFor: 'accessing' stamp: 'brp 8/23/2003 19:10'!
hour

	^ self hour24 ! !

!Time methodsFor: 'converting' stamp: 'brp 8/23/2003 19:29'!
asMonth

	^ self asDateAndTime asMonth! !

!Time methodsFor: 'accessing' stamp: 'brp 8/23/2003 19:33'!
nanoSecond 

	^ nanos ! !

!Time methodsFor: 'accessing' stamp: 'brp 8/23/2003 19:41'!
meridianAbbreviation

	^ self hour < 12 ifTrue: ['AM'] ifFalse: ['PM']. ! !

!Time methodsFor: 'converting' stamp: 'brp 8/23/2003 19:01'!
asDuration 
	"Answer the duration since midnight"

	^ Duration seconds: seconds nanoSeconds: nanos ! !

!Time methodsFor: 'comparing' stamp: 'brp 8/23/2003 15:54'!
< aTime

	^ self asDuration < aTime asDuration! !

!Time methodsFor: '*Fuel' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper

	^ aGeneralMapper visitHookPrimitive: self
! !

!Time methodsFor: 'converting' stamp: 'brp 8/23/2003 19:28'!
asWeek

	^ self asDateAndTime asWeek! !

!Time methodsFor: 'printing' stamp: 'StephanEggermont 10/8/2014 15:16'!
print24: hr24 on: aStream 
 	"Format is 'hh:mm:ss' or 'h:mm:ss am' "
 
 	| h m s |
	h := self hour. m := self minute. s := self second.
	hr24
		ifTrue: [ 
			h < 10 ifTrue: [ aStream nextPut: $0 ].
			h printOn: aStream ]
		ifFalse: [ 
			h > 12
				ifTrue: [ h - 12 printOn: aStream ]
				ifFalse: [
					h < 1
						ifTrue: [ 12 printOn: aStream ]
						ifFalse: [ h printOn: aStream ] ] ].
	aStream nextPutAll: (m < 10 ifTrue: [ ':0' ] ifFalse: [ ':' ]).
	m printOn: aStream.
	aStream nextPutAll: (s < 10 ifTrue: [ ':0' ] ifFalse: [ ':' ]).
	s printOn: aStream.
	hr24 ifFalse: [ aStream nextPutAll: (h < 12 ifTrue: [ ' am' ] ifFalse: [ ' pm' ]) ]! !

!Time methodsFor: 'adding' stamp: 'brp 8/23/2003 19:03'!
subtractTime: timeAmount 
	"Answer a Time that is timeInterval before the receiver. timeInterval is  
	an instance of Date or Time."

	^ self class seconds: self asSeconds - timeAmount asSeconds! !

!Time methodsFor: 'adding' stamp: 'brp 8/23/2003 19:02'!
addTime: timeAmount
 	"Answer a Time that is timeInterval after the receiver. timeInterval is an 
 	instance of Date or Time."
 
 	^ self class seconds: self asSeconds + timeAmount asSeconds! !

!Time methodsFor: 'converting' stamp: 'brp 8/23/2003 23:58'!
asDate

	^ Date today! !

!Time methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 12/20/2011 21:19'!
printOn: aStream 

	self 
		print24: false
		showSeconds: (self seconds ~= 0 or: [ self nanoSecond ~= 0 ])
		on: aStream! !

!Time methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/20/2011 21:52'!
second 
	"Answer a number that represents the number of complete seconds in the receiver, 
	after the number of complete minutes has been removed."
 
 	^ (seconds rem: SecondsInMinute)! !

!Time methodsFor: 'accessing' stamp: 'brp 7/1/2003 13:29'!
hours

	^ self hour! !

!Time methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/20/2011 21:51'!
hour24 
	"Answer a number that represents the number of complete hours in the receiver, 
	after the number of complete days has been removed."
 
 	^ (seconds rem: SecondsInDay) quo: SecondsInHour! !

!Time methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/20/2011 21:52'!
minute
	"Answer a number that represents the number of complete minutes in the receiver,
	after the number of complete hours has been removed."
 
	^ (seconds rem: SecondsInHour) quo: SecondsInMinute ! !

!Time methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 12/20/2011 21:06'!
hhmm24
 	"Return a string of the form 1123 (for 11:23 am), 2154 (for 9:54 pm), of exactly 4 digits"
 
 	^ String new: 4 streamContents: [ :aStream | 
		self hour printOn: aStream base: 10 length: 2 padded: true.
		self minute printOn: aStream base: 10 length: 2 padded: true ]! !

!Time methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 12/20/2011 21:18'!
printMinutes
 	"Return as string 'hh:mm pm'  "
 
 	^ String new: 8 streamContents: [ :aStream | 
		self print24: false showSeconds: false on: aStream ]
 ! !

!Time methodsFor: 'private' stamp: 'adrian_lienhard 1/7/2009 18:20'!
ticks: anArray
	"ticks is an Array: { days. seconds. nanoSeconds }"

	seconds := anArray at: 2.
	nanos := anArray at: 3! !

!Time methodsFor: 'hash' stamp: 'brp 8/23/2003 19:11'!
hash

	^ self ticks hash ! !

!Time methodsFor: 'converting' stamp: 'brp 8/23/2003 19:08'!
asTime

	^ self! !

!Time methodsFor: 'accessing' stamp: 'brp 8/23/2003 19:35'!
to: anEnd
	"Answer a Timespan. anEnd must respond to #asDateAndTime"

	^ self asDateAndTime to: anEnd! !

!Time methodsFor: 'printing' stamp: 'BP 3/30/2001 15:25'!
storeOn: aStream
 
 	aStream print: self printString; nextPutAll: ' asTime'! !

!Time methodsFor: 'printing' stamp: 'brp 8/23/2003 19:24'!
intervalString
	"Treat the time as a difference.  Give it in hours and minutes with two digits of accuracy."

	| d |
	d := self asDuration.
	^ String streamContents: [ :s |
		d hours > 0 ifTrue: [s print: d hours; nextPutAll: ' hours'].
		d minutes > 0 ifTrue: [s space; print: d minutes; nextPutAll: ' minutes'].
		d seconds > 0 ifTrue: [s space; print: d seconds; nextPutAll: ' seconds'] ].

! !

!Time methodsFor: 'converting' stamp: 'MarcusDenker 12/2/2009 12:58'!
asMilliSeconds
	"Answer the number of milliseconds since midnight"

	^ self asDuration asMilliSeconds ! !

!Time methodsFor: 'printing' stamp: 'StephanEggermont 10/8/2014 15:17'!
print24: hr24 showSeconds: showSeconds on: aStream 
	"Format is 'hh:mm:ss.nnnnnnnnn' or 'h:mm:ss.nnnnnnnnn am'  or, if showSeconds is false, 'hh:mm' or 'h:mm am'"

	| h m s |
	h := self hour. m := self minute. s := self second.
	hr24
		ifTrue: [ 
			h < 10 ifTrue: [ aStream nextPut: $0 ].
			h printOn: aStream ]
		ifFalse: [ 
			h > 12
				ifTrue: [ h - 12 printOn: aStream ]
				ifFalse: [
					h < 1
						ifTrue: [ 12 printOn: aStream ]
						ifFalse: [ h printOn: aStream ] ] ].
	aStream nextPutAll: (m < 10 ifTrue: [ ':0' ] ifFalse: [ ':' ]).
	m printOn: aStream.
	showSeconds 
		ifTrue: [
			aStream nextPutAll: (s < 10 ifTrue: [ ':0' ] ifFalse: [ ':' ]).
			s printOn: aStream.
			nanos = 0
				ifFalse: [ | n len |
					n := nanos. len := 9.
					[ n \\ 10 = 0 ] whileTrue: [ n := n / 10. len := len - 1 ].
					aStream nextPut: $..
					n printOn: aStream base: 10 length: len padded: true ] ].
	hr24 ifFalse: [ aStream nextPutAll: (h < 12 ifTrue: [ ' am' ] ifFalse: [ ' pm' ]) ]! !

!Time methodsFor: 'adding' stamp: 'brp 8/23/2003 19:02'!
addSeconds: nSeconds 
	"Answer a Time that is nSeconds after the receiver."

	^ self class seconds: self asSeconds + nSeconds! !

!Time methodsFor: 'private' stamp: 'adrian_lienhard 1/7/2009 18:19'!
seconds: secondCount nanoSeconds: nanoCount 
	"Private - only used by Time class."

	seconds := secondCount.
	nanos := nanoCount! !

!Time methodsFor: 'converting' stamp: 'brp 8/23/2003 19:43'!
asYear

	^ self asDateAndTime asYear! !

!Time methodsFor: '*Fuel' stamp: 'MarianoMartinezPeck 6/9/2012 14:27'!
serializeOn: anEncoder

	anEncoder 
		encodeUint24: self asSeconds;
		encodeUint32: self nanoSecond.
		! !

!Time methodsFor: 'private' stamp: 'adrian_lienhard 1/7/2009 18:18'!
seconds: secondCount
	"Private - only used by Time class."

	seconds := secondCount.
	nanos := 0! !

!Time methodsFor: 'comparing' stamp: 'brp 8/23/2003 19:11'!
= aTime

	^ [ self ticks = aTime ticks ]
		on: MessageNotUnderstood do: [false]! !

!Time methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 12/20/2011 21:07'!
print24
 	"Return as 8-digit string 'hh:mm:ss', with leading zeros if needed"
 
 	^ String new: 8 streamContents: [ :aStream | 
		self print24: true on: aStream ]
 
 ! !

!Time methodsFor: '*GT-InspectorExtensions-Core' stamp: 'SvenVanCaekenberghe 10/4/2014 20:12'!
gtInspectorDetailsIn: composite
	<gtInspectorPresentationOrder: 30>
	^ composite table
		title: [ 'Details' ];
		display: [ 
					{'hours' -> self hours.
					'minutes' -> self minutes.
					'seconds' -> self seconds.
					'nanoseconds' -> self nanoSecond.
					'meridian' -> self meridianAbbreviation.
					'iso' -> self print24 } ];
		column: 'Key' evaluated: #key;
		column: 'Value' evaluated: #value;
		send: #value! !

!Time methodsFor: 'converting' stamp: 'brp 8/23/2003 19:26'!
asDateAndTime

	^ DateAndTime today + self! !

!Time methodsFor: 'accessing' stamp: 'avi 2/21/2004 18:45'!
hour12
 	"Answer an <integer> between 1 and 12, inclusive, representing the hour 
 	of the day in the 12-hour clock of the local time of the receiver."
	^ self hour24 - 1 \\ 12 + 1! !

!Time methodsFor: 'converting' stamp: 'brp 8/23/2003 19:29'!
asNanoSeconds
	"Answer the number of nanoseconds since midnight"

	^ self asDuration asNanoSeconds ! !

!Time methodsFor: 'accessing' stamp: 'brp 8/23/2003 22:38'!
ticks
	"Answer an Array: { seconds. nanoSeconds }"

	^ Array with: 0 with: seconds with: nanos.! !

!Time methodsFor: 'converting' stamp: 'brp 8/23/2003 19:27'!
asTimeStamp

	^ self asDateAndTime asTimeStamp! !

!Time methodsFor: 'accessing' stamp: 'brp 8/23/2003 19:32'!
duration

	^ Duration zero ! !

!Time class methodsFor: 'primitives' stamp: 'nice 4/28/2013 01:19'!
microsecondClockValue
	"Answer the number of microseconds since Squeak Epoch"

	^self primUTCMicrosecondsClock ! !

!Time class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 3/4/2013 23:43'!
readFrom: aStream
	"Read a Time from the stream in the form:
		<hour>:<minute>:<second>.<nseconds> <am/pm>
	<minute>, <second> or <am/pm> may be omitted.  e.g. 1:59:30 pm; 8AM; 15:30"

	| hour minute second ampm nanos power |
	hour := Integer readFrom: aStream.
	minute := second := nanos := 0.
	(aStream peekFor: $:) 
		ifTrue: [
			minute := Integer readFrom: aStream.
			(aStream peekFor: $:) 
				ifTrue: [
					second := Integer readFrom: aStream.
					(aStream peekFor: $.)
						ifTrue: [ 
							power := 1.
							[ aStream atEnd not and: [ aStream peek isDigit ] ]
								whileTrue: [  
									nanos := nanos * 10 + aStream next digitValue.
									power := power * 10 ].
							nanos := nanos / power * 1000000000 ] ] ].
	aStream skipSeparators.
	(aStream atEnd not and: [ 'APap' includes: aStream peek ]) 
		ifTrue: [
			ampm := aStream next asLowercase.
			(ampm = $p and: [ hour < 12 ]) ifTrue: [ hour := hour + 12 ].
			(ampm = $a and: [ hour = 12 ]) ifTrue: [ hour := 0 ].
			(aStream peekFor: $m) ifFalse: [ aStream peekFor: $M ] ].
	^ self 
		hour: hour 
		minute: minute 
		second: second 
		nanoSecond: nanos! !

!Time class methodsFor: 'primitives' stamp: 'nk 3/8/2004 12:05'!
millisecondClockValue
	"Answer the number of milliseconds since the millisecond clock was last reset or rolled over.
	Answer 0 if the primitive fails."

	<primitive: 135>
	^ 0! !

!Time class methodsFor: 'primitives' stamp: 'nice 4/28/2013 01:22'!
primUTCMicrosecondsClock
	"Answer the number of micro-seconds ellapsed since Squeak epoch.
	That is since 00:00 on the morning of January 1, 1901 UTC.
	At least a 60-bit unsigned integer is used internally which is enough for dates up to year 38435.
	Essential. See Object documentation whatIsAPrimitive. "

	<primitive: 240>
	self primitiveFailed! !

!Time class methodsFor: 'benchmarks' stamp: 'SvenVanCaekenberghe 11/2/2012 11:08'!
benchmarkPrimitiveResponseDelay	"Time benchmarkPrimitiveResponseDelay"
	"Benchmark the overhead for primitive dispatches with an active Delay.
	On the VM level, this tests the efficiency of ioLowResMSecs."

	"PII/400 Windows98: 0.128 microseconds per prim"

	"ar 9/6/1999: This value is *extremely* important for stuff like sockets etc.
	I had a bad surprise when Michael pointed this particular problem out:
	Using the hardcoded clock() call for ioLowResMSecs on Win32 resulted in an overhead
	of 157.4 microseconds per primitive call - meaning you can't get no more than
	approx. 6000 primitives per second on my 400Mhz PII system with an active delay!!
	BTW, it finally explains why Squeak seemed soooo slow when running PWS or 
	other socket stuff. The new version (not using clock() but some Windows function) 
	looks a lot better (see above; approx. 8,000,000 prims per sec with an active delay)."

	| nLoops bb index baseTime actualTime delayTime |
	delayTime := 5000. "Time to run this test is approx. 3*delayTime"

	Delay anyActive ifTrue:[
		^self notify:'Some delay is currently active.
Running this benchmark will not give any useful result.'].

	bb := Array new: 1. "The object we send the prim message to"

	"Compute the # of loops we'll run in a decent amount of time"
	[(Delay forMilliseconds: delayTime) wait] 
		forkAt: Processor userInterruptPriority.

	nLoops := 0.
	[Delay anyActive] whileTrue:[
		bb basicSize; basicSize; basicSize; basicSize; basicSize; 
			basicSize; basicSize; basicSize; basicSize; basicSize.
		nLoops := nLoops + 1.
	].

	"Flush the cache and make sure #basicSize is in there"
	Object flushCache.
	bb basicSize.

	"Now run the loop without any active delay
	for getting an idea about its actual speed."
	baseTime := self millisecondClockValue.
	index := nLoops.
	[index > 0] whileTrue:[
		bb basicSize; basicSize; basicSize; basicSize; basicSize; 
			basicSize; basicSize; basicSize; basicSize; basicSize.
		index := index - 1.
	].
	baseTime := self millisecondsSince: baseTime.

	"Setup the active delay but try to never make it active"
	[(Delay forMilliseconds: delayTime + delayTime) wait] 
		forkAt: Processor userInterruptPriority.

	"And run the loop"
	actualTime := self millisecondClockValue.
	index := nLoops.
	[index > 0] whileTrue:[
		bb basicSize; basicSize; basicSize; basicSize; basicSize; 
			basicSize; basicSize; basicSize; basicSize; basicSize.
		index := index - 1.
	].
	actualTime := self millisecondsSince: actualTime.

	"And get us some result"
	^((actualTime - baseTime) * 1000 asFloat / (nLoops * 10) truncateTo: 0.001) printString,
		' microseconds overhead per primitive call'! !

!Time class methodsFor: '*Fuel' stamp: 'MarianoMartinezPeck 6/9/2012 14:38'!
materializeFrom: aDecoder
	
	^ self 
		seconds: aDecoder nextEncodedUint24
		nanoSeconds: aDecoder nextEncodedUint32! !

!Time class methodsFor: 'instance creation' stamp: 'brp` 8/24/2003 19:26'!
hour: hour minute: minute second: second  nanoSecond: nanoCount
	"Answer a Time - only second precision for now"
 
 	^ self 
		seconds: (hour * SecondsInHour) + (minute * SecondsInMinute) + second 
		nanoSeconds: nanoCount! !

!Time class methodsFor: 'primitives' stamp: 'CamilloBruni 8/22/2013 18:01'!
primUTCSecondsClock
	"Answer the number of whole seconds ellapsed since Squeak epoch.
	That is since 00:00 on the morning of January 1, 1901 UTC"

	^self primUTCMicrosecondsClock // 1e6! !

!Time class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 5/3/2013 14:44'!
now
	"Answer a Time representing the time right now - this is a 24 hour clock."
	
	^ self nowLocal! !

!Time class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 4/9/2015 12:06'!
gtExampleNow
	<gtExample: 'Now'>
	^ self now! !

!Time class methodsFor: 'accessing' stamp: 'nice 4/28/2013 00:44'!
dateAndTimeFromSeconds: secondCountSinceEpoch
 
	| dateAndTime |
	dateAndTime := DateAndTime fromSeconds: secondCountSinceEpoch.
 	^ Array
 		with: dateAndTime asDate
 		with: dateAndTime asTime! !

!Time class methodsFor: 'instance creation' stamp: 'nice 5/4/2013 00:42'!
nowLocal
	"Answer the time since midnight in local timezone"

	| microSecondsToday |
	microSecondsToday := self primUTCMicrosecondsClock.
	^ self
		seconds: microSecondsToday // 1000000 + DateAndTime localTimeZone offset asSeconds \\ SecondsInDay
		nanoSeconds: microSecondsToday \\ 1000000 * 1000! !

!Time class methodsFor: 'general inquiries' stamp: 'nice 4/27/2013 22:59'!
millisecondsToRun: timedBlock 
	"Answer the number of milliseconds timedBlock takes to return its value."

	^(self microsecondsToRun: timedBlock) // 1e3! !

!Time class methodsFor: 'accessing' stamp: 'BP 3/30/2001 15:25'!
millisecondsSince: lastTime
 	"Answer the elapsed time since last recorded in milliseconds.
 	Compensate for rollover."
 
 	^self milliseconds: self millisecondClockValue since: lastTime! !

!Time class methodsFor: 'accessing' stamp: 'brp 8/23/2003 18:58'!
milliseconds: currentTime since: lastTime
	"Answer the elapsed time since last recorded in milliseconds.
	Compensate for rollover."

	| delta |
	delta := currentTime - lastTime.
	^ delta < 0
		ifTrue: [SmallInteger maxVal + delta]
		ifFalse: [delta]
! !

!Time class methodsFor: 'clock' stamp: 'CamilloBruni 8/22/2013 18:03'!
secondsWhenClockTicks

	"waits for the moment when a new second begins"

	| lastSecond |

	lastSecond := self primUTCSecondsClock.
	[ lastSecond = self primUTCSecondsClock ] whileTrue: [ (Delay forMilliseconds: 1) wait ].
 
	^ lastSecond + 1 ! !

!Time class methodsFor: 'primitives' stamp: 'CamilloBruni 8/22/2013 18:10'!
primMillisecondClock
	"Primitive. Answer the number of milliseconds since the millisecond clock
	 was last reset or rolled over. Answer zero if the primitive fails.
	As an alternative you can use #primUTCMillisecondsClock which does not overflow."

	<primitive: 135>
	^ 0! !

!Time class methodsFor: 'instance creation' stamp: 'adrian_lienhard 1/7/2009 18:19'!
seconds: seconds nanoSeconds: nanoCount
	"Answer a Time from midnight."

	^ self basicNew
		ticks: (Duration seconds: seconds nanoSeconds: nanoCount) ticks! !

!Time class methodsFor: 'instance creation' stamp: 'brp` 8/24/2003 19:26'!
noon

	^ self seconds: (SecondsInDay / 2)
! !

!Time class methodsFor: 'instance creation' stamp: 'brp 8/23/2003 20:05'!
hour: hour minute: minute second: second
	"Answer a Time"
 
 	^ self hour: hour minute: minute second: second nanoSecond: 0! !

!Time class methodsFor: 'benchmarks' stamp: 'SvenVanCaekenberghe 11/2/2012 11:06'!
benchmarkMillisecondClock		"Time benchmarkMillisecondClock"
	"Benchmark the time spent in a call to Time>>millisecondClockValue.
	On the VM level this tests the efficiency of calls to ioMSecs()."
	"PII/400 Windows 98: 0.725 microseconds per call"
	| temp1 temp2 temp3 delayTime nLoops time |
	delayTime := 5000. "Time to run benchmark is approx. 2*delayTime"

	"Don't run the benchmark if we have an active delay since
	we will measure the additional penalty in the primitive dispatch
	mechanism (see #benchmarkPrimitiveResponseDelay)."
	Delay anyActive ifTrue:[
		^self notify:'Some delay is currently active.
Running this benchmark will not give any useful result.'].

	"Flush the cache for this benchmark so we will have
	a clear cache hit for each send to #millisecondClockValue below"
	Object flushCache.
	temp1 := 0.
	temp2 := self. "e.g., temp1 == Time"
	temp3 := self millisecondClockValue + delayTime.

	"Now check how often we can run the following loop in the given time"
	[temp2 millisecondClockValue < temp3]
		whileTrue:[temp1 := temp1 + 1].

	nLoops := temp1. "Remember the loops we have run during delayTime"

	"Setup the second loop"
	temp1 := 0.
	temp3 := nLoops.

	"Now measure how much time we spend without sending #millisecondClockValue"
	time := Time millisecondClockValue.
	[temp1 < temp3]
		whileTrue:[temp1 := temp1 + 1].
	time := Time millisecondsSince: time.

	"And compute the number of microseconds spent per call to #millisecondClockValue"
	^((delayTime - time * 1000.0 / nLoops) truncateTo: 0.001) printString,
		' microseconds per call to Time>>millisecondClockValue'! !

!Time class methodsFor: 'instance creation' stamp: 'brp 8/23/2003 20:01'!
new
	"Answer a Time representing midnight"

	^ self midnight! !

!Time class methodsFor: 'instance creation' stamp: 'gk 8/31/2006 00:39'!
seconds: seconds
	"Answer a Time from midnight."

	^ self basicNew ticks: (Duration seconds: seconds) ticks! !

!Time class methodsFor: 'instance creation' stamp: 'MarcusDenker 7/23/2014 22:32'!
fromSeconds: secondCount
	"Answer an instance of me that is secondCount number of seconds since midnight."

	| integerSeconds nanos |
	integerSeconds := secondCount truncated.
	nanos := integerSeconds = secondCount
		ifTrue: [ 0 ]
		ifFalse: [ ((secondCount - integerSeconds) * NanosInSecond) asInteger ].
	^ self seconds: integerSeconds nanoSeconds: nanos! !

!Time class methodsFor: 'accessing' stamp: 'nice 4/27/2013 23:13'!
microsecondsSince: lastTimeInMicroSeconds
 	"Answer the elapsed time since last recorded in microseconds"
 
 	^self microsecondClockValue - lastTimeInMicroSeconds! !

!Time class methodsFor: 'accessing' stamp: 'CamilloBruni 8/22/2013 18:01'!
totalSeconds
	"Answer the total seconds ellapsed since the Squeak epoch: 1 January 1901 00:00 UTC"

	^ self primUTCSecondsClock! !

!Time class methodsFor: 'instance creation' stamp: 'brp 8/23/2003 20:01'!
midnight

	^ self seconds: 0
! !

!Time class methodsFor: 'general inquiries' stamp: 'nice 4/27/2013 22:57'!
microsecondsToRun: timedBlock 
	"Answer the number of milliseconds timedBlock takes to return its value."

	| initialMicroseconds |
	initialMicroseconds := self microsecondClockValue.
	timedBlock value.
	^self microsecondClockValue - initialMicroseconds! !

!Time class methodsFor: 'instance creation' stamp: 'PeterHugossonMiller 9/2/2009 16:01'!
fromString: aString
	^ self readFrom: aString readStream.
! !

!Time class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 5/3/2013 15:36'!
nowUTC
	"Answer the time since midnight in UTC timezone"

	| microSecondsToday |
	microSecondsToday := self primUTCMicrosecondsClock \\ MicrosecondsInDay.
	^ self 
		seconds: microSecondsToday // 1000000 
		nanoSeconds: microSecondsToday \\ 1000000 * 1000! !

!Time class methodsFor: 'instance creation' stamp: 'brp 8/23/2003 19:46'!
current 

	^ self now! !

!Time class methodsFor: 'primitives' stamp: 'CamilloBruni 8/22/2013 18:07'!
primUTCMillisecondsClock
	"Answer the number of whole milliseconds ellapsed since Squeak epoch.
	That is since 00:00 on the morning of January 1, 1901 UTC"

	^self primUTCMicrosecondsClock // 1e3! !

!TimeMeasuringTest methodsFor: 'as yet unclassified' stamp: 'dvf 8/31/2005 15:13'!
setToDebug
	shouldProfile := true
! !

!TimeMeasuringTest methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 11:13'!
initialize
	super initialize.
	shouldProfile := false.! !

!TimeMeasuringTest methodsFor: 'as yet unclassified' stamp: 'dvf 8/31/2005 15:09'!
openDebuggerOnFailingTestMethod
	shouldProfile := true! !

!TimeMeasuringTest methodsFor: 'as yet unclassified' stamp: 'pmm 7/4/2009 11:58'!
reportPerformance
	| str |
	str := (MultiByteFileStream fileNamed: 'performanceReports.txt') ascii; wantsLineEndConversion: true; yourself.
	str setToEnd;
		nextPutAll: ' test: ', testSelector;
		nextPutAll: ' time: ', realTime asString; 
		nextPutAll: ' version: ', self versionInformation;
		cr; 
		close! !

!TimeMeasuringTest methodsFor: 'as yet unclassified' stamp: 'dvf 8/31/2005 14:58'!
runCase
	[super runCase] ensure: [self reportPerformance]! !

!TimeMeasuringTest methodsFor: 'as yet unclassified' stamp: 'BernardoContreras 8/23/2011 21:00'!
measure: measuredBlock 
	shouldProfile 
		ifTrue: [Smalltalk tools timeProfiler onBlock: [10 timesRepeat: measuredBlock]].
	realTime := measuredBlock timeToRun! !

!TimeMeasuringTest methodsFor: 'as yet unclassified' stamp: 'md 2/22/2006 14:27'!
debug
	self resources do: [:res | 
		res isAvailable ifFalse: [^res signalInitializationError]].
	[(self class selector: testSelector) setToDebug; runCase] 
		ensure: [self resources do: [:each | each reset]]
			! !

!TimeMeasuringTest methodsFor: 'as yet unclassified' stamp: 'dvf 8/31/2005 14:48'!
workingCopyPredicate
	^[:e | '*Traits*' match: e package name]! !

!TimeMeasuringTest methodsFor: 'as yet unclassified' stamp: 'dvf 8/31/2005 14:48'!
versionInformation
	| wcPredicate |
	wcPredicate := self workingCopyPredicate.
	^self versionInfoForWorkingCopiesThat: wcPredicate! !

!TimeMeasuringTest methodsFor: 'as yet unclassified' stamp: 'dvf 8/31/2005 14:59'!
versionInfoForWorkingCopiesThat: wcPredicate 
	^(MCWorkingCopy allManagers select: wcPredicate) inject: ''
		into: [:s :e | s , e description]! !

!TimeProfiler commentStamp: '<historical>'!
TimeProfiler is a graphical front end of MessageTally. It gives nice facilities to navigate and browse a profile.

Use examples:
TimeProfiler new open
TimeProfiler new openOnBlock: [SimpleGridExample new open]
TimeProfiler new openOnBlock: [ClassTreeExample new openOn: Object]
 MessageTally spyAllOn: [ClassTreeExample new openOn: Object]!
!TimeProfiler methodsFor: 'UI specific' stamp: 'AlainPlantec 2/18/2010 02:20'!
startState
	treeMorph expandAllSuchThat: [:node | node percentage > self startMinPercentageToExpand]
	! !

!TimeProfiler methodsFor: 'actions' stamp: 'AlainPlantec 2/17/2010 22:42'!
doItContext
	"Answer the context in which a text selection can be evaluated."

	^nil! !

!TimeProfiler methodsFor: 'UI specific' stamp: 'AlainPlantec 2/19/2010 16:21'!
whatToShow
	^ self showLeavesOnly ifTrue: [#'Leaves'] ifFalse: [#'Full tree']! !

!TimeProfiler methodsFor: 'actions' stamp: 'AlainPlantec 10/9/2011 01:54'!
spyAllOn: aBlock 
	block := aBlock.
	rootMessageTally := MessageTally new.
	rootMessageTally
		reportOtherProcesses: true;
		maxClassNameSize: 1000;
		maxClassPlusSelectorSize: 1000;
		maxTabs: 100.
	result := rootMessageTally spyAllEvery: MessageTally defaultPollPeriod on: aBlock.
	self result: result.
	^ result
! !

!TimeProfiler methodsFor: 'compiling' stamp: 'MarcusDenker 9/5/2013 13:25'!
compile: codeString for: anObject in: evalContext

	| methodNode |
	methodNode := Smalltalk compiler
		source: ('self runBlock: [', codeString, ']');
		class: anObject class;
		context: evalContext;
		requestor: self;
		noPattern: true;
		failBlock: [^nil];
		translate.
		
	^ methodNode generateWithSource.! !

!TimeProfiler methodsFor: 'UI specific' stamp: 'AlainPlantec 2/19/2010 16:11'!
showLeavesOnly 
	^ showLeavesOnly ifNil: [showLeavesOnly := false]! !

!TimeProfiler methodsFor: 'actions' stamp: 'BernardoContreras 9/12/2011 22:16'!
runProcess: aProcess forMilliseconds: msecDuration pollingEvery: pollPeriod 
	block := MessageSend 
				receiver: self
				selector: #runProcess:forMilliseconds:pollingEvery: 
				arguments: { 
						aProcess.
						msecDuration.
						pollPeriod}.	"so we can re-run it"
	rootMessageTally := MessageTally new.
	rootMessageTally
		reportOtherProcesses: false;
		maxClassNameSize: 1000;
		maxClassPlusSelectorSize: 1000;
		maxTabs: 100.
	result := rootMessageTally 
				spyEvery: pollPeriod
				onProcess: aProcess
				forMilliseconds: msecDuration.
	^result! !

!TimeProfiler methodsFor: 'public opening' stamp: 'AlainPlantec 7/22/2011 20:29'!
openOnBlock: aBlock 
	self runBlock: aBlock pollingEvery: MessageTally defaultPollPeriod.
	self open.
	^ self! !

!TimeProfiler methodsFor: 'compiling' stamp: 'MarcusDenker 6/14/2014 12:23'!
selectedMethodCode: aString notifying: aController
	"Compile the code in aString. Notify aController of any syntax errors. 
	Answer false if the compilation fails. Otherwise answer true."

	self selectedNode
		ifNil: [ ^ false ]
		ifNotNil: [ :currNode | 
			| class oldSelector category newSelector |
			class := currNode methodClass.
			oldSelector := currNode selector.
			class ifNil: [ ^ false ].	"Normal method accept"
			category := class organization categoryOfElement: oldSelector.
			newSelector := class compile: aString classified: category notifying: aController.
			newSelector isNil
				ifTrue: [ ^ false ].
			self changed: #selectedMethodCode.
			^ true ]! !

!TimeProfiler methodsFor: 'UI specific' stamp: 'AlainPlantec 2/18/2010 01:43'!
selectInvisiblyFrom:  first to:  last
	blockCodePane selectInvisiblyFrom: first to: last.! !

!TimeProfiler methodsFor: 'accessing' stamp: 'AlainPlantec 2/2/2010 17:12'!
time
	^ rootMessageTally time! !

!TimeProfiler methodsFor: 'accessing-computed' stamp: 'AlexandreBergel 1/29/2013 12:16'!
fullReport
	"Return the full report of the tally "
	^ String streamContents: [:strm |
		rootMessageTally 
			ifNotNil: [ rootMessageTally report: strm ] ]! !

!TimeProfiler methodsFor: '*Shout-Styling' stamp: 'AlainPlantec 8/26/2011 22:45'!
shoutAboutToStyle: aPluggableShoutMorphOrView 
	self selectedNode
		ifNotNil: [ :currNode | 
			aPluggableShoutMorphOrView getTextSelector = #selectedMethodCode
				ifTrue: [aPluggableShoutMorphOrView classOrMetaClass: currNode methodClass.
					^ true]].
	aPluggableShoutMorphOrView getTextSelector = #summaryText
			ifTrue: [^ false].
	aPluggableShoutMorphOrView getTextSelector = #blockCode
			ifTrue: [^ true].
	 ^ false
! !

!TimeProfiler methodsFor: 'UI specific' stamp: 'AlainPlantec 2/18/2010 02:04'!
notify: aString at: anInteger in: aStream
	blockCodePane notify: aString at: anInteger - 'self runBlock: [' size in: aStream ! !

!TimeProfiler methodsFor: 'UI specific' stamp: 'AlainPlantec 2/18/2010 01:47'!
correctFrom: start to: stop with: aString
	^ blockCodePane correctFrom: start to: stop with: aString! !

!TimeProfiler methodsFor: 'UI specific' stamp: 'AlainPlantec 2/17/2010 22:21'!
contentsSelection
	"Return the interval of text in the code pane to select when I set the pane's contents"

	^ 1 to: 0		"null selection"! !

!TimeProfiler methodsFor: 'UI specific' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
toolBarOn: aWindow
	| uiTheme toolBar |
	uiTheme := Smalltalk ui theme.
	toolBar := toolBar := aWindow newToolbar: {
		( uiTheme
			newButtonIn: World 
			for: self
			getState: nil
			action: #profileIt
			arguments: {}
			getEnabled: nil
			getLabel: nil
			help: nil)		 		
				label: ( uiTheme
					newRowIn: World 
					for: {AlphaImageMorph new image: Smalltalk ui icons smallDoItIcon. uiTheme buttonLabelForText: 'Profile it' translated});		 			yourself.
		aWindow newToolSpacer.
		aWindow newToolSpacer.
		aWindow newLabel: 'Min time % ' translated.
		 (uiTheme
				newTextEntryIn: aWindow
				for: self 
				get: #minPercentageToExpand
				set: #minPercentageToExpand: 
				class: Float
				getEnabled: nil
				help: nil).
		aWindow newToolSpacer.
		aWindow newToolSpacer.
		aWindow newLabel: 'Threshold: ' translated.
		 (uiTheme
				newTextEntryIn: aWindow
				for: self 
				get: #threshold
				set: #threshold: 
				class: Integer
				getEnabled: nil
				help: nil).
		aWindow newToolSpacer.
		aWindow newToolSpacer.
		aWindow newDropListFor: self 
			list: #whatToShowList
			getSelected: #whatToShow 
			setSelected: #whatToShow:
			getEnabled: nil 
			useIndex: false 
			help: 'Which kind of result'.
		aWindow newToolSpacer.
		aWindow newToolSpacer.
		uiTheme
			newCheckboxIn: World
			for: self
			getSelected: #reportOtherProcesses
			setSelected: #reportOtherProcesses:
			getEnabled: nil
			label: 'All processes' 
			help: nil.
		aWindow newToolSpacer}.
	^ toolBar! !

!TimeProfiler methodsFor: 'UI specific' stamp: 'MarcusDenker 6/24/2013 11:08'!
fullReportMenu: aMenuMorph shift: aBoolean
	^ (PragmaMenuBuilder 
		pragmaKeyword: 'TimeProfilerFullReportMenu'
		model: self) menu ! !

!TimeProfiler methodsFor: 'UI specific' stamp: 'AlainPlantec 2/19/2010 16:22'!
whatToShow: aSymbol
	self showLeavesOnly: aSymbol = #'Leaves'! !

!TimeProfiler methodsFor: 'actions' stamp: 'AlainPlantec 10/18/2013 09:11'!
blockCode: aString notifying: aRequestor
	"Treat the current selection as an expression; evaluate and tally it."
	|  compiledMethod |
	aString ifNil: [^ self].

	blockSource := aString.
	compiledMethod := self compile: aString for: nil in: self doItContext.
	compiledMethod ifNil: [^ self].
	self showResult: ( compiledMethod valueWithReceiver: self arguments: #()).
	self changed: #blockCode.
	self changed: #summaryText.
	self changed: #fullReport.
	self selection: nil.
	self updateList.
	self startState.
	

	! !

!TimeProfiler methodsFor: 'accessing-computed' stamp: 'MarcusDenker 4/26/2013 10:08'!
selectedMethodCode
	^ self selectedNode 
		ifNil: [ self helpMessage ]
		ifNotNil: [ :currNode | 
			| class selector |
			class := currNode methodClass.
			selector := currNode selector.
			(class ultimateSourceCodeAt: selector ifAbsent: [ 'error' ])]! !

!TimeProfiler methodsFor: 'UI specific' stamp: 'MarcusDenker 6/14/2014 12:23'!
showLeavesOnly: aBoolean
	self showLeavesOnly ~= aBoolean
		ifFalse: [ ^ self ].
	treeMorph
		treeLineWidth:
			(aBoolean
				ifTrue: [ 0 ]
				ifFalse: [ 1 ]).
	showLeavesOnly := aBoolean.
	self changed: #showLeavesOnly.
	self updateList! !

!TimeProfiler methodsFor: 'configuration' stamp: 'AlainPlantec 2/18/2010 01:36'!
helpMessage

^'You can edit some code in the top editor and accept to profile it.
The result consists in a tree of method calls shown in the middle panel.
Select a method call to see or change its implementation in the bottom editor.

Tallies building:
The tallies are built according to the time threshold value that you can change at the top right (Treshold input field).

Tree expanding:
A tree node is expanded only if its duration percentage is greater that the minimum value that you can change at the top left (Min duration percentage input field). 
'! !

!TimeProfiler methodsFor: 'UI specific' stamp: 'AlainPlantec 2/15/2011 09:38'!
withBlockCodePane
	^ withBlockCodePane ifNil: [withBlockCodePane := true]! !

!TimeProfiler methodsFor: 'accessing' stamp: 'AlainPlantec 2/20/2010 08:44'!
rootNodeClassFromItem: anItem
	^ TimeProfilerNode ! !

!TimeProfiler methodsFor: 'UI specific' stamp: 'EstebanLorenzano 5/15/2014 14:09'!
treeMorph
	^ (self treeMorphClass on: self)
		rowInset: 2;
		columnInset: 4;
		autoDeselection: true;
		getMenuSelector:#menu:shifted:;
		keystrokeActionSelector: #keyStroke:from:;
		treeLineWidth: 1;
		treeLineDashes: {5. 1};
		lineColorBlock: [:node | {Color gray. Color orange. Color brown. Color magenta. Color blue} at: ((node level \\ 5) + 1)];
		doubleClickSelector: #browseItem;
		rowColorForEven: Smalltalk ui theme lightBackgroundColor;
		yourself
! !

!TimeProfiler methodsFor: 'UI specific' stamp: 'AlainPlantec 2/19/2010 16:05'!
reportOtherProcesses
	^ reportOtherProcesses ifNil: [reportOtherProcesses := true]
! !

!TimeProfiler methodsFor: 'public opening' stamp: 'AlexandreBergel 1/29/2013 12:14'!
open
	"Public method. This method simply open a time profiler"

	| toolBar codePane vgap summaryPane blkPaneGap treeTopFraction treeTabPane fullReportPane |
	win := StandardWindow new model: self.
	win setLabel: self toolName.
	toolBar := self toolBarOn: win.
	treeMorph := self treeMorph
		buildContents;
		yourself.
	summaryPane := win
		newTextEditorFor: self
		getText: #summaryText
		setText: nil
		getEnabled: nil.
	fullReportPane := win
		newTextEditorFor: self
		getText: #fullReport
		setText: nil
		getEnabled: nil.
	fullReportPane getMenuSelector: #fullReportMenu:shift:.
	codePane := win
		newTextEditorFor: self
		getText: #selectedMethodCode
		setText: #selectedMethodCode:notifying:
		getEnabled: nil.
	codePane getMenuSelector: #codePaneMenu:shifted:.
	codePane font: StandardFonts codeFont.
	self withToolBar
		ifTrue: [ 
			vgap := toolBar minExtent y.
			win addMorph: toolBar fullFrame: ((0 @ 0 corner: 1 @ 0) asLayoutFrame bottomOffset: vgap) ]
		ifFalse: [ vgap := 0 ].
	blkPaneGap := 0.
	treeTopFraction := 0.0.
	self withBlockCodePane
		ifTrue: [ 
			blkPaneGap := 10.
			treeTopFraction := 0.15.
			blockCodePane := win
				newTextEditorFor: self
				getText: #blockCode
				setText: #blockCode:notifying:
				getEnabled: nil.
			blockCodePane getMenuSelector: #codePaneMenu:shifted:.
			blockCodePane font: StandardFonts codeFont.
			blockCodePane alwaysAccept: true.
			win
				addMorph: blockCodePane
				fullFrame:
					((0 @ 0 corner: 1 @ treeTopFraction) asLayoutFrame
						topOffset: vgap;
						bottomOffset: vgap + blkPaneGap) ].
	treeTabPane := win
		newTabGroup:
			{('Tallies Tree' -> treeMorph).
			('Full report' -> fullReportPane)}.
	win addMorph: treeTabPane fullFrame: ((0 @ treeTopFraction corner: 1 @ 0.6) asLayoutFrame topOffset: vgap + blkPaneGap).
	win
		addMorph:
			(codeTabPane := win
				newTabGroup:
					{('Code' -> codePane).
					('Statistics' -> summaryPane)})
		fullFrame: (0 @ 0.6 corner: 1 @ 1) asLayoutFrame.
	win openInWorld.
	self startState! !

!TimeProfiler methodsFor: 'UI specific' stamp: 'AlainPlantec 2/25/2011 17:10'!
keyStroke: anEvent from: aTreeMorph 
	self selectedNode ifNotNil: [:current | current keyStroke: anEvent from: aTreeMorph ].
! !

!TimeProfiler methodsFor: 'actions' stamp: 'nice 3/31/2011 22:45'!
doItReceiver
	"This class's classPool has been jimmied to be the classPool of the class 
	being browsed. A doIt in the code pane will let the user see the value of 
	the class variables."

	^ self selectedClass! !

!TimeProfiler methodsFor: 'actions' stamp: 'AlainPlantec 2/19/2010 22:36'!
profileIt
	blockCodePane accept.
	! !

!TimeProfiler methodsFor: 'actions' stamp: 'AlainPlantec 2/17/2010 20:29'!
expandAll
	treeMorph expandAllSuchThat: [:node | node percentage > self minPercentageToExpand]! !

!TimeProfiler methodsFor: 'accessing' stamp: 'AlainPlantec 2/2/2010 17:12'!
tally
	^ rootMessageTally tally! !

!TimeProfiler methodsFor: 'configuration' stamp: 'AlainPlantec 2/18/2010 02:19'!
startMinPercentageToExpand
	^ 20! !

!TimeProfiler methodsFor: 'accessing' stamp: 'AlainPlantec 10/17/2013 12:20'!
threshold: aTreshold
	(aTreshold ~= threshold and: [aTreshold between: 0 and: 1000])
		ifTrue: [
			threshold := aTreshold.
			self updateList].
	self changed: #threshold! !

!TimeProfiler methodsFor: 'UI specific' stamp: 'AlainPlantec 2/15/2011 09:38'!
withBlockCodePane: aBoolean
	withBlockCodePane := aBoolean! !

!TimeProfiler methodsFor: 'UI specific' stamp: 'AlainPlantec 2/17/2010 22:04'!
minPercentageToExpand
	^ minPercentageToExpand ifNil: [minPercentageToExpand := 3]! !

!TimeProfiler methodsFor: 'accessing' stamp: 'AlainPlantec 2/18/2010 01:46'!
text
	^ blockSource! !

!TimeProfiler methodsFor: 'UI specific' stamp: 'AlainPlantec 2/18/2010 01:39'!
selectFrom: start to: stop
	blockCodePane  selectFrom: start to: stop! !

!TimeProfiler methodsFor: 'accessing-computed' stamp: 'MarcusDenker 6/30/2014 13:26'!
leaveItems
	| res  |
	res := OrderedCollection new.
	rootMessageTally
		ifNotNil: [ 
			| dict |
			dict := IdentityDictionary new: 100.
			rootMessageTally leavesInto: dict fromSender: nil.
			res addAll: (dict asOrderedCollection select: [ :node | node tally > self threshold ]) ].
	^ res! !

!TimeProfiler methodsFor: 'accessing' stamp: 'AlainPlantec 2/17/2010 22:02'!
selection: aSelection
	super selection: aSelection.
	self changed: #selectedMethodCode
! !

!TimeProfiler methodsFor: 'public opening' stamp: 'AlainPlantec 10/17/2013 10:02'!
openPathFrom: aNode
	self expandNodePath: aNode path! !

!TimeProfiler methodsFor: 'accessing-computed' stamp: 'AlainPlantec 7/22/2011 20:39'!
resultText
	^ result printString
! !

!TimeProfiler methodsFor: 'accessing-computed' stamp: 'AlainPlantec 7/22/2011 21:31'!
rootItems
	^ rootMessageTally
		ifNil: [#()]
		ifNotNil: [
			self showLeavesOnly 
				ifTrue: [ self leaveItems ]
				ifFalse: [ self rootTallyItems]]! !

!TimeProfiler methodsFor: 'UI specific' stamp: 'StephaneDucasse 10/26/2014 11:18'!
menu: menu shifted: b 
	"Set up the menu to apply to the receiver's, honoring the #shifted boolean"
	
	self selectedNode 
		ifNotNil: [ :current | 
			current menu: menu shifted: b.
			menu addLine.
			menu
				add: 'Expand all from here'
				target: self
				selector: #expandAllFromNode:
				argument: current ].
	^ menu! !

!TimeProfiler methodsFor: 'actions' stamp: 'AlainPlantec 7/22/2011 21:47'!
runBlock: aBlock 
	^ self runBlock: aBlock pollingEvery: MessageTally defaultPollPeriod! !

!TimeProfiler methodsFor: 'configuration' stamp: 'AlainPlantec 2/19/2010 16:20'!
whatToShowList
	^ #(#'Full tree' #'Leaves')! !

!TimeProfiler methodsFor: 'accessing' stamp: 'AlexandreBergel 1/29/2013 12:12'!
selectedClass
	^ self selectedNode 
		ifNotNil: [ :currNode | currNode methodClass ]! !

!TimeProfiler methodsFor: 'actions' stamp: 'AlexandreBergel 1/29/2013 12:15'!
browseItem
	self selectedNode ifNotNil: [:current | current browseItem ].
! !

!TimeProfiler methodsFor: 'UI specific' stamp: 'EstebanLorenzano 1/31/2013 19:24'!
codePaneMenu: aMenu shifted: shifted 
	"Note that unless we override perform:orSendTo:, 
	PluggableTextController will respond to all menu items in a 
	text pane"
	| donorMenu |
	donorMenu := shifted
				ifTrue: [SmalltalkEditor shiftedYellowButtonMenu]
				ifFalse: [SmalltalkEditor yellowButtonMenu].
	^ aMenu addAllFrom: donorMenu! !

!TimeProfiler methodsFor: 'actions' stamp: 'AlainPlantec 7/22/2011 22:41'!
runBlock: aBlock pollingEvery: pollPeriod 
	block := aBlock.
	rootMessageTally := MessageTally new.
	rootMessageTally
		reportOtherProcesses: true;
		maxClassNameSize: 1000;
		maxClassPlusSelectorSize: 1000;
		maxTabs: 100.
	result := rootMessageTally spyEvery: pollPeriod on: aBlock.
	self result: result.
	^ result
! !

!TimeProfiler methodsFor: 'configuration' stamp: 'AlainPlantec 2/15/2011 10:09'!
initialExtent
	^ 750 @ 700! !

!TimeProfiler methodsFor: 'UI specific' stamp: 'AlainPlantec 7/22/2011 21:16'!
withToolBar
	^ withToolBar ifNil: [withToolBar := true]! !

!TimeProfiler methodsFor: 'actions' stamp: 'CamilloBruni 6/16/2013 19:58'!
blockCode
	^ block
		ifNil: ['']
		ifNotNil: [ blockSource ifNil: [ blockSource := block asString ]]! !

!TimeProfiler methodsFor: 'actions' stamp: 'AlexandreBergel 1/29/2013 12:06'!
deselect
	blockCodePane deselect! !

!TimeProfiler methodsFor: 'UI specific' stamp: 'AlainPlantec 2/17/2010 20:14'!
minPercentageToExpand: aPercentage
	minPercentageToExpand := aPercentage.
	self changed: #minPercentageToExpand.
! !

!TimeProfiler methodsFor: 'UI specific' stamp: 'AlainPlantec 2/18/2010 00:00'!
selectionInterval
	^ 1 to: 0! !

!TimeProfiler methodsFor: 'accessing' stamp: 'AlainPlantec 2/17/2010 20:12'!
threshold
	^ threshold ifNil: [threshold := 0]! !

!TimeProfiler methodsFor: 'UI specific' stamp: 'AlainPlantec 7/22/2011 20:38'!
showResult: anObject
	self result: anObject.
	resultPane
		ifNil: [resultPane := win
			newTextEditorFor: self
			getText: #resultText
			setText: nil
			getEnabled: nil.
			codeTabPane addPage: resultPane label: 'Result']
		ifNotNil: [self changed: #resultText]

	! !

!TimeProfiler methodsFor: 'UI specific' stamp: 'AlainPlantec 7/22/2011 21:15'!
withToolBar: aBoolean
	withToolBar := aBoolean! !

!TimeProfiler methodsFor: 'configuration' stamp: 'AlexandreBergel 1/29/2013 12:14'!
toolName
	^ 'Time profiler'! !

!TimeProfiler methodsFor: 'accessing-computed' stamp: 'MarcusDenker 9/28/2013 13:46'!
rootTallyItems
	| res sons groups |
	res := OrderedCollection new.
	rootMessageTally
		ifNotNil: [ 
			sons := rootMessageTally sonsOver: self threshold.
			groups := sons groupBy: [ :aTally | aTally process ] having: [ :g | true ].
			groups
				do: [ :g | 
					self reportOtherProcesses
						ifTrue: [ res addAll: g ]
						ifFalse: [ res addAll: (g asSortedCollection reject: [ :gg | gg process isNil ]) ] ] ].
	^ res! !

!TimeProfiler methodsFor: 'UI specific' stamp: 'MarcusDenker 6/14/2014 12:23'!
reportOtherProcesses: aBoolean
	self reportOtherProcesses ~= aBoolean
		ifFalse: [ ^ self ].
	reportOtherProcesses := aBoolean.
	self changed: #reportOtherProcesses.
	self updateList! !

!TimeProfiler methodsFor: 'accessing-computed' stamp: 'AlainPlantec 2/19/2010 22:52'!
summaryText
	^ String streamContents: [:strm | rootMessageTally 
		ifNotNil: [rootMessageTally time > 0 
			ifTrue: [strm nextPutAll: ' - '; print: rootMessageTally tally; nextPutAll: ' tallies, ', rootMessageTally time printString, ' msec.'; cr.
				rootMessageTally reportGCStatsOn: strm]]]
! !

!TimeProfiler methodsFor: 'UI specific' stamp: 'AlexandreBergel 1/29/2013 12:17'!
select
	blockCodePane select! !

!TimeProfiler methodsFor: 'accessing' stamp: 'AlainPlantec 7/22/2011 20:39'!
result: anObject
	result := anObject
! !

!TimeProfiler class methodsFor: 'opening' stamp: 'AlainPlantec 7/22/2011 21:17'!
spyOn: aBlock 
	^ (self new withBlockCodePane: false; withToolBar: false; yourself)
		openOnBlock: aBlock ! !

!TimeProfiler class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/15/2013 13:51'!
taskbarIcon 
	^ Smalltalk ui icons smallProfileIcon! !

!TimeProfiler class methodsFor: 'opening' stamp: 'AlainPlantec 7/22/2011 22:44'!
onBlock: block
	"Open a profile browser on the given block, thereby running the block and 
	 collecting the message tally."
	"TimeProfiler onBlock: [ 20 timesRepeat: [Transcript show: 100 factorial printString]]"

	| inst result |
	inst := self new.
	result := inst runBlock: block.
	inst open.
	inst showResult: result.
	^ result! !

!TimeProfiler class methodsFor: 'world menu' stamp: 'TorstenBergmann 2/12/2014 09:24'!
menuCommandOn: aBuilder 
	<worldMenu>
	(aBuilder item: #'Time Profiler')
		parent: #Tools;  
		order: 0.40;
		icon: self taskbarIcon;
		action: [TimeProfiler new open]! !

!TimeProfiler class methodsFor: 'opening' stamp: 'AlainPlantec 10/9/2011 01:56'!
spyAllOn: aBlock
	"Spy on all the processes in the system
	
	[1000 timesRepeat: [3.14159 printString. Processor yield]] fork.
	[1000 timesRepeat: [20 factorial. Processor yield]] fork.
	[1000 timesRepeat: [20 factorial. Processor yield]] fork.
	self spyAllOn: [ (Delay forMilliseconds: 100) wait]
	
	"
	| inst result |
	inst := self new.
	result := inst spyAllOn: aBlock.
	inst open.
	inst showResult: result.
	^ result! !

!TimeProfiler class methodsFor: 'opening' stamp: 'MarcusDenker 10/22/2014 16:39'!
spyFor: seconds
	"Run the system profiler for the specified number of seconds"
	"self spyFor: 2"
	^self spyOn: [ (Delay forSeconds: seconds) wait ].! !

!TimeProfiler class methodsFor: 'tools-registry' stamp: 'BernardoContreras 8/15/2011 20:17'!
registerToolsOn: registry
	"Add ourselves to registry. See [Smalltalk tools]" 
	registry register: self as: #timeProfiler! !

!TimeProfiler class methodsFor: 'opening' stamp: 'MarcusDenker 10/15/2013 18:17'!
spyOnProcess: aProcess forMilliseconds: msecDuration 
	"Run aProcess for msecDuration milliseconds, then open a TimeProfiler on the results."

	| inst |
	inst := self new.
	inst withBlockCodePane: false.
	inst runProcess: aProcess forMilliseconds: msecDuration pollingEvery: MessageTally defaultPollPeriod.
	inst open.
	^ inst! !

!TimeProfiler class methodsFor: 'opening' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
fullReportMenuOn: aBuilder 
	"Specify the menu with a specific pragma. Try it with:
	(PragmaMenuBuilder 
		pragmaKeyword: 'TimeProfilerFullReportMenu'
		model: nil) menu popUpInWorld"

	<contextMenu>
	<TimeProfilerFullReportMenu>

	(aBuilder item: #'Find...' translated) 
		keyText: 'f';
		selector: #find; 
		icon: Smalltalk ui icons smallFindIcon.
	(aBuilder item: #'Find again' translated) 
		keyText: 'g';
		selector: #findAgain; 
		icon: Smalltalk ui icons smallFindIcon.
	(aBuilder item: #'Set search string' translated) 
		keyText: 'h';
		selector: #setSearchString.
	(aBuilder item: #'Copy' translated) 
		keyText: 'c';
		selector: #copySelection; 
		icon: Smalltalk ui icons smallCopyIcon.
! !

!TimeProfilerNode commentStamp: '<historical>'!
A TimeProfilerNode represents a node in the tally tree!
!TimeProfilerNode methodsFor: 'accessing-computed' stamp: 'AlainPlantec 2/2/2010 22:30'!
percentage 
	^ self item tally asFloat / model time * 100.0 roundTo: 0.1.
! !

!TimeProfilerNode methodsFor: 'accessing-computed' stamp: 'AlainPlantec 2/3/2010 06:44'!
selector
	^self item method selector 
	! !

!TimeProfilerNode methodsFor: 'printing' stamp: 'AlainPlantec 2/2/2010 21:54'!
asString
	^ String streamContents: [:s | self item printOn: s total: model tally totalTime: model time tallyExact: false] ! !

!TimeProfilerNode methodsFor: 'actions' stamp: 'StephaneDucasse 10/15/2011 20:58'!
browseItem
	Smalltalk tools browser
		fullOnClass: self methodClass  selector: self selector! !

!TimeProfilerNode methodsFor: 'accessing-computed' stamp: 'AlainPlantec 2/2/2010 14:33'!
childrenItems
	^ (self item sonsOver: model threshold) asSortedCollection! !

!TimeProfilerNode methodsFor: 'actions' stamp: 'AlainPlantec 2/2/2010 21:37'!
inspectItem
	self item inspect! !

!TimeProfilerNode methodsFor: 'UI specific' stamp: 'AlainPlantec 2/25/2011 17:10'!
keyStroke: anEvent from: aTreeMorph
	| c |
	c := anEvent keyCharacter.
	c = $b
		ifTrue: [self browseItem. ^ true].
	c = $i
		ifTrue: [self inspectItem. ^ true].
	c = $I
		ifTrue: [self exploreItem. ^ true].
	^ false
! !

!TimeProfilerNode methodsFor: 'actions' stamp: 'AlainPlantec 2/2/2010 21:37'!
exploreItem
	self item explore! !

!TimeProfilerNode methodsFor: 'accessing-computed' stamp: 'AlainPlantec 2/3/2010 06:44'!
methodClass
	^self item method methodClass 
	! !

!TimeProfilerNode methodsFor: 'UI specific' stamp: 'StephaneDucasse 10/22/2014 22:08'!
menu: menu shifted: b 
	menu
		add: 'Browse (b)'
		target: self
		selector: #browseItem.
	menu
		add: 'Inspect (i)'
		target: self
		selector: #inspectItem.
	menu
		add: 'Explore (I)'
		target: self
		selector: #exploreItem.
! !

!TimeStamp commentStamp: '<historical>'!
I am TimeStamp.
I am a DateAndTime.

I differ from my superclass in just the following aspects:
 - I have a different #printOn: (see #printSeparateDateAndTimeOn:)
 - I have a different #readFrom: (see #readSeparateDateAndTimeFrom:)
 - when instanciated, I am rounded to the nearest second 

I only exist to support method timestamps, but my superclass would be just as suited. 

TimeStamp is on its way of being removed from the system as it does not differ enough from its superclass to earn its right to exist.!
!TimeStamp methodsFor: 'squeak protocol' stamp: ''!
species

	^ DateAndTime! !

!TimeStamp methodsFor: '*Fuel' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper

	^ aGeneralMapper visitFixedObject: self
! !

!TimeStamp methodsFor: 'squeak protocol' stamp: 'brp 7/27/2003 17:13'!
asTimeStamp
	"Answer the receiver as an instance of TimeStamp."

	^ self! !

!TimeStamp methodsFor: 'squeak protocol' stamp: 'CamilloBruni 7/13/2012 19:30'!
storeOn: aStream 

	aStream 
		nextPut: $';
		print: self;
		nextPut: $';
		nextPutAll: ' asTimeStamp'! !

!TimeStamp methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 11/18/2013 15:49'!
printOn: stream 
	^ self printSeparateDateAndTimeOn: stream! !

!TimeStamp class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 11/18/2013 15:49'!
readFrom: stream
	^ self readSeparateDateAndTimeFrom: stream! !

!TimeStamp class methodsFor: 'instance creation' stamp: 'MarcusDenker 7/18/2014 16:58'!
now
	"Answer the date and time now, rounded to the nearest whole second, as a TimeStamp."
	self deprecated: 'use DateAndTime' on: '18 July 2014'  in: 'Pharo4'.
	^ super now rounded asTimeStamp! !

!TimeStampMethodConverter commentStamp: '<historical>'!
A TimeStampMessageConverter is a wrapper wich display the timestamp of the provided message!
!TimeStampMethodConverter methodsFor: 'private' stamp: 'NicolaiHess 12/11/2013 10:21'!
formattedModificationTextFor:aUser atStamp:aTimeStampString
|stamp|
stamp:= DateAndTime fromString:aTimeStampString.
^ String streamContents:[ :s |
			s << 'Last Modification :' << Character cr.
			s << Character tab << 'date:' << Character tab << stamp asDate asString << Character space << stamp asTime asString << Character cr.
 			s << Character tab << 'by:' << Character tab << Character tab << aUser ]! !

!TimeStampMethodConverter methodsFor: 'private' stamp: 'NicolaiHess 12/11/2013 10:20'!
internalGetText
	| list |
	list := method stamp substrings.
	list ifEmpty: [ ^ 'No information available' ].
	^ self formattedModificationTextFor:(list first) atStamp:(list allButFirst joinUsing:' ')
! !

!TimeTest commentStamp: '<historical>'!
This is the unit test for the class Time.

!
!TimeTest methodsFor: 'tests' stamp: 'damiencassou 5/30/2008 11:09'!
testStoreOn
	| cs rw |
	cs := '''12:34:56 pm'' asTime' readStream.
	rw := ReadWriteStream on: ''.
	aTime storeOn: rw.
	self assert: rw contents = cs contents! !

!TimeTest methodsFor: 'tests' stamp: 'CamilloBruni 11/5/2013 16:59'!
testGeneralInquiries
	| date aDateAndTime |

	self should: [ self timeClass timeWords ] raise: MessageNotUnderstood.

	date := '2 June 1973' asDate.
	time := '4:02:47 am' asTime.
	aDateAndTime := self timeClass dateAndTimeFromSeconds: (2285280000 + 14567).
	self
		assert: aDateAndTime equals: {date. time}.
! !

!TimeTest methodsFor: 'tests input' stamp: 'StephaneDucasse 4/24/2010 12:48'!
testReadFromWithNanos
	"self debug: #testReadFromWithNanos"
	
	#('4:02:47.5 am'
	'4:02:55.521 pm'
		"there is a bug with 520 instead of 521"
	
	) do: [:each |
			|  t |
			t := self timeClass readFrom: each readStream.
			self assert: t printString = each]
! !

!TimeTest methodsFor: 'tests' stamp: 'damiencassou 5/30/2008 11:09'!
testSubtractTime
	self assert: (aTime subtractTime: aTime) = (Time readFrom: '00:00:00' readStream)! !

!TimeTest methodsFor: 'tests printing' stamp: 'brp 1/21/2004 18:52'!
testPrintMinutes
	self assert: aTime printMinutes = '12:34 pm'! !

!TimeTest methodsFor: 'coverage' stamp: 'brp 7/27/2003 13:31'!
classToBeTested

	^ self timeClass! !

!TimeTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:52'!
testMinute
	self assert: aTime minute =  34.
	self assert: aTime minutes =  34
! !

!TimeTest methodsFor: 'tests' stamp: 'damiencassou 5/30/2008 11:09'!
testAddSeconds
	self assert: (aTime addSeconds: 1) = (Time readFrom: '12:34:57' readStream).
	self assert: (aTime addSeconds: 60) = (Time readFrom: '12:35:56' readStream).
	self assert: (aTime addSeconds: 3600) = (Time readFrom: '13:34:56' readStream).
	self assert: (aTime addSeconds: 24 * 60 * 60) = (Time readFrom: '12:34:56' readStream)! !

!TimeTest methodsFor: 'tests' stamp: 'StephaneDucasse 4/24/2010 12:24'!
testEqual
	"self debug: #testEqual"
	
	self assert: aTime = (Time readFrom: '12:34:56' readStream).
	self assert: aTime = (Time readFrom: '12:34:56.00' readStream).
	self assert: aTime = (Time readFrom: '12:34:56.0000' readStream)! !

!TimeTest methodsFor: 'tests input' stamp: 'StephaneDucasse 4/24/2010 12:33'!
testReadFrom
	"self debug: #testReadFrom"
	
	| string t |
	string := '4:02:47 am'.
	t := self timeClass readFrom: string readStream.
	self assert: time printString = t printString.
! !

!TimeTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:52'!
testTicks
	self assert: aTime ticks = #(0 45296 0).
	self assert: aTime  = (Time new ticks: #(0 45296 0))! !

!TimeTest methodsFor: 'tests' stamp: 'brp 7/27/2003 13:36'!
testComparing
	| t1 t2 t3 |
	t1 := self timeClass fromSeconds: 14567.		"4:02:47 am"
	t2 := self timeClass fromSeconds: 5000.		"1:23:20 am"
	t3 := self timeClass fromSeconds: 80000.		"10:13:20 pm"

	self
		assert: time = t1;
		assert: time hash = t1 hash;
		assert: time = time copy.
	self
		deny: t1 < t2;
		assert: t1 < t3.! !

!TimeTest methodsFor: 'tests' stamp: 'brp 7/27/2003 13:38'!
testFromSeconds
	| t |
	t := self timeClass fromSeconds: 14567.
	self
		assert: t = time
! !

!TimeTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:52'!
testAsDateAndTime
	self assert: (aTime asDateAndTime) = (DateAndTime current midnight + aTime)
! !

!TimeTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:52'!
testAsSeconds
	self assert: (aTime asSeconds) = 45296
! !

!TimeTest methodsFor: 'tests' stamp: 'brp 7/27/2003 13:33'!
testAccessing

	self
		assert: time hours = 4;
		assert: time minutes = 2;
		assert: time seconds = 47;
		assert: time asSeconds = 14567.
! !

!TimeTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:52'!
testAsYear
	self assert: aTime asYear = (DateAndTime current midnight + aTime) asYear
! !

!TimeTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:52'!
testHhmm24
	self assert: aTime hhmm24 = '1234'! !

!TimeTest methodsFor: 'tests printing' stamp: 'damiencassou 5/30/2008 11:09'!
testPrint24On
	| cs rw |
	cs := '12:34:56' readStream.
	rw := ReadWriteStream on: ''.
	aTime 
		print24: true
		on: rw.
	self assert: rw contents = cs contents! !

!TimeTest methodsFor: 'tests' stamp: 'brp 7/27/2003 13:47'!
testStoring

	self	
		assert: time storeString = '''4:02:47 am'' asTime';
		assert: time = ('4:02:47 am' asTime).
! !

!TimeTest methodsFor: 'tests printing' stamp: 'damiencassou 5/30/2008 11:09'!
testPrint24OnWithPM
	| cs rw |
	cs := '12:34:56 pm' readStream.
	rw := ReadWriteStream on: ''.
	aTime 
		print24: false
		on: rw.
	^ self assert: rw contents = cs contents! !

!TimeTest methodsFor: 'tests' stamp: 'nk 3/30/2004 09:42'!
testHour
	self assert: aTime hour =  12.
	self assert: aTime hour12 =  12.
	self assert: aTime hour24 =  12.
	self assert: aTime hours =  12.! !

!TimeTest methodsFor: 'tests printing' stamp: 'brp 8/23/2003 22:27'!
testPrinting

	self	
		assert: time printString = '4:02:47 am';
		assert: time intervalString =  '4 hours 2 minutes 47 seconds';
		assert: time print24 = '04:02:47';
		assert: time printMinutes = '4:02 am';
		assert: time hhmm24 = '0402'.
! !

!TimeTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:52'!
testDuration
	self assert: aTime duration = 0 seconds! !

!TimeTest methodsFor: 'tests' stamp: 'StephaneDucasse 4/24/2010 19:39'!
testSeconds
	
	self assert: (Time readFrom: '20:33:14.321-05:00' readStream) asDuration seconds = 14! !

!TimeTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:52'!
testSecond
	self assert: aTime second =  56.
	self assert: aTime seconds =  56
! !

!TimeTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:52'!
testAsNanoSeconds
	self assert: (aTime asNanoSeconds) = 45296000000000

! !

!TimeTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:52'!
testAsDate
	self assert: (aTime asDate) = (Date current)
! !

!TimeTest methodsFor: 'coverage' stamp: 'CamilloBruni 8/22/2013 18:08'!
selectorsToBeIgnored

	 | deprecated private special primitives timing benchmarks |

	deprecated := #().
	private := #( #print24:on: #print24:showSeconds:on: ).
	special := #( #< #= #new #printOn: #storeOn: ).
	primitives := #( #primMillisecondClock #primSecondsClock #primUTCSecondsClock #primUTCMicrosecondsClock #primUTCMillisecondsClock).
	timing := #( #millisecondClockValue #milliseconds:since: #millisecondsSince: ).
	benchmarks := #( #benchmarkMillisecondClock #benchmarkPrimitiveResponseDelay ). 

	^ super selectorsToBeIgnored, deprecated, private, special, primitives, timing, benchmarks.! !

!TimeTest methodsFor: 'setup' stamp: 'brp 7/27/2003 13:32'!
timeClass

	^ Time! !

!TimeTest methodsFor: 'setup' stamp: 'nk 3/30/2004 09:40'!
tearDown
	DateAndTime localTimeZone: localTimeZoneToRestore.
! !

!TimeTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:52'!
testAsWeek
	self assert: aTime asWeek = (DateAndTime current midnight + aTime) asWeek
! !

!TimeTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:52'!
testAsDuration
	self assert: (aTime asDuration) = (Duration days: 0 hours: 12 minutes: 34 seconds: 56)
! !

!TimeTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:52'!
testAsTime
	self assert: (aTime asTime) = aTime

! !

!TimeTest methodsFor: 'tests' stamp: 'brp 7/27/2003 13:44'!
testNew
	
	self assert: self timeClass new asSeconds = 0! !

!TimeTest methodsFor: 'tests printing' stamp: 'brp 1/21/2004 18:52'!
testPrint24
	self assert: aTime print24 = '12:34:56'! !

!TimeTest methodsFor: 'tests printing' stamp: 'damiencassou 5/30/2008 11:09'!
testPrintOn
	| cs rw |
	cs := '12:34:56 pm' readStream.
	rw := ReadWriteStream on: ''.
	aTime printOn: rw.
	self assert: rw contents = cs contents! !

!TimeTest methodsFor: 'setup' stamp: 'nk 3/30/2004 09:40'!
setUp

	localTimeZoneToRestore := DateAndTime localTimeZone.
	DateAndTime localTimeZone: TimeZone default.
	time := self timeClass fromSeconds: 14567.		"4:02:47 am"
	aTime := Time readFrom: '12:34:56 pm' readStream
! !

!TimeTest methodsFor: 'tests' stamp: 'damiencassou 5/30/2008 11:09'!
testAddTime
	self assert: (aTime addTime: aTime) = (Time readFrom: '01:09:52' readStream)! !

!TimeTest methodsFor: 'tests' stamp: 'GabrielCalero 11/21/2009 12:20'!
testPrintStringNanos
	self assert: (Time hour: 15 minute: 15 second: 15  nanoSecond: (150 *
1000000)) printString = '3:15:15.15 pm'! !

!TimeTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:52'!
testNanoSecond
	self assert: aTime nanoSecond = 0
	"Right now all times all seconds"
! !

!TimeTest methodsFor: 'tests printing' stamp: 'StephanEggermont 10/8/2014 15:20'!
testPrint24withNanos
	self assert: '12:34:56.1' asTime print24 = '12:34:56'! !

!TimeTest methodsFor: 'tests' stamp: 'damiencassou 5/30/2008 11:09'!
testLessThan
	self assert: aTime < (Time readFrom: '12:34:57' readStream)! !

!TimeTest methodsFor: 'tests' stamp: 'brp 7/27/2003 13:35'!
testArithmetic
	| t1 t2 t3 |
	t1 := time addSeconds: 70.		"4:03:57 am"
	self
		assert: t1 hours = 4;
		assert: t1 minutes = 3;
		assert: t1 seconds = 57.

	t2 := t1 addTime: (self timeClass fromSeconds: (60*60*5)).
	self
		assert: t2 hours = 9;
		assert: t2 minutes = 3;
		assert: t2 seconds = 57.

	t3 := t2 subtractTime: (self timeClass fromSeconds: (60*60*5) + 70).
	self
		assert: t3 = time.
! !

!TimeTest methodsFor: 'tests printing' stamp: 'damiencassou 5/30/2008 11:09'!
testPrint24OnWithoutSeconds
	| cs rw |
	cs := '12:34:56' readStream.
	rw := ReadWriteStream on: ''.
	aTime 
		print24: true
		showSeconds: true
		on: rw.
	self assert: rw contents = cs contents! !

!TimeTest methodsFor: 'tests' stamp: 'brp 7/27/2003 13:37'!
testConverting

	self
		assert: time asSeconds = 14567.! !

!TimeTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:52'!
testMeridianAbbreviation
	self assert: aTime meridianAbbreviation =  'PM'.
! !

!TimeTest methodsFor: 'tests input' stamp: 'JohanBrichau 8/26/2010 14:16'!
testReadFromWithError
	"self debug: #testReadFromWithError"
	
	| string |
	string := 'invalid'.
	self should: [self timeClass readFrom: string readStream] raise: Error.
	string := '0:invalid'.
	self should: [self timeClass readFrom: string readStream] raise: Error
! !

!TimeZone commentStamp: 'brp 9/4/2003 06:32'!
TimeZone is a simple class to colect the information identifying a UTC time zone.

offset			-	Duration	- the time zone's offset from UTC
abbreviation	-	String		- the abbreviated name for the time zone.
name			-	String		- the name of the time zone.

TimeZone class >> #timeZones returns an array of the known time zones
TimeZone class >> #default returns the default time zone (Grenwich Mean Time)!
!TimeZone methodsFor: 'accessing' stamp: 'brp 9/4/2003 06:28'!
offset: aDuration

	offset := aDuration! !

!TimeZone methodsFor: 'accessing' stamp: 'brp 9/4/2003 06:28'!
name: aString

	name := aString
! !

!TimeZone methodsFor: 'accessing' stamp: 'brp 9/4/2003 06:28'!
abbreviation
 
 	^ abbreviation
 ! !

!TimeZone methodsFor: 'accessing' stamp: 'brp 9/4/2003 06:29'!
name
 
 	^ name
 ! !

!TimeZone methodsFor: 'accessing' stamp: 'brp 9/4/2003 06:28'!
offset
 
 	^ offset! !

!TimeZone methodsFor: 'accessing' stamp: 'brp 9/4/2003 06:28'!
abbreviation: aString

	abbreviation := aString
! !

!TimeZone class methodsFor: 'instance creation' stamp: 'brp 9/4/2003 06:33'!
offset: aDuration name: aName abbreviation: anAbbreviation
 
 	^ self new
 		offset: aDuration;
 		name: aName;
 		abbreviation: anAbbreviation;
 		yourself! !

!TimeZone class methodsFor: 'accessing' stamp: 'CamilloBruni 7/17/2012 16:05'!
local
	^ Locale localTimeZone! !

!TimeZone class methodsFor: 'accessing' stamp: 'CamilloBruni 8/23/2013 23:50'!
default
 	"Answer the default time zone - GMT"
 
 	^ self timeZones detect: [ :timeZone |
		timeZone offset = Duration zero ]
 ! !

!TimeZone class methodsFor: 'accessing' stamp: 'CamilloBruni 8/23/2013 23:52'!
timeZones

	^ {
		self offset:  0 hours name: 'Universal Time'              abbreviation: 'UTC'.
		self offset:  0 hours name: 'Greenwich Mean Time'         abbreviation: 'GMT'.
		self offset:  1 hours name: 'British Summer Time'         abbreviation: 'BST'.
		self offset:  2 hours name: 'South African Standard Time' abbreviation: 'SAST'.
		self offset: -8 hours name: 'Pacific Standard Time'       abbreviation: 'PST'.
		self offset: -7 hours name: 'Pacific Daylight Time'       abbreviation: 'PDT'.
		self offset: -7 hours name: 'Mountain Standard Time'      abbreviation: 'MST'.
		self offset: -6 hours name: 'Mountain Daylight Time'      abbreviation: 'MDT'.
		self offset: -6 hours name: 'Central Standard Time'       abbreviation: 'CST'.
		self offset: -5 hours name: 'Central Daylight Time'       abbreviation: 'CDT'.
		self offset: -5 hours name: 'Eastern Standard Time'       abbreviation: 'EST'.
		self offset: -4 hours name: 'Eastern Daylight Time'       abbreviation: 'EDT'.
	}

! !

!TimeZone class methodsFor: 'accessing' stamp: 'CamilloBruni 8/23/2013 23:51'!
offset: anOffset
 	"Return the timezone with the given offset"
 	^ self timeZones 
		detect: [ :timeZone | timeZone offset = anOffset ]
		ifNone: [ self new offset: anOffset ]! !

!TimeZone class methodsFor: 'accessing' stamp: 'CamilloBruni 8/23/2013 23:50'!
abbreviated: aString
 	"Return the timezone whose abbreviation is aString."
 	^ self timeZones detect: [ :timeZone | 
		timeZone abbreviation = aString ].! !

!TimedOut commentStamp: 'brp 10/21/2004 17:47'!
I am signalled by #duration:timeoutDo: if the receiving block takes too long to execute.

I am signalled by a watchdog process spawned by #duration:timeoutDo: and caught in the same method. 

I am not intended to be used elsewhere.!
!Timespan commentStamp: 'brp 5/13/2003 08:07'!
I represent a duration starting on a specific DateAndTime.
!
!Timespan methodsFor: 'conversion' stamp: 'abc 5/11/2012 23:34'!
asSeconds
 	"Answer the seconds since the Squeak epoch: 1 January 1901"
 
 	^ start asSeconds! !

!Timespan methodsFor: 'private' stamp: 'brp 5/13/2003 08:58'!
do: aBlock with: aFirstElement

 	self do: aBlock with: aFirstElement when: [ :t | true ]. ! !

!Timespan methodsFor: 'conversion' stamp: 'brp 5/30/2003 00:10'!
asDuration

	^ self duration! !

!Timespan methodsFor: 'accessing' stamp: 'brp 5/13/2003 08:47'!
julianDayNumber 

	^ start julianDayNumber ! !

!Timespan methodsFor: 'arithmetic' stamp: 'brp 5/13/2003 08:43'!
< comparand

	^ self start < comparand	 ! !

!Timespan methodsFor: 'enumerating' stamp: 'brp 5/13/2003 08:58'!
yearsDo: aBlock

	self do: aBlock with: start asYear.! !

!Timespan methodsFor: 'accessing' stamp: 'brp 7/1/2003 17:50'!
daysLeftInYear
	^ start daysLeftInYear! !

!Timespan methodsFor: 'accessing' stamp: 'brp 8/6/2003 18:42'!
dayOfWeek
	"Answer the day of the week represented by the receiver."

	^ start dayOfWeek! !

!Timespan methodsFor: 'enumerating' stamp: 'brp 5/13/2003 08:49'!
datesDo: aBlock 

	self do: aBlock with: start asDate. ! !

!Timespan methodsFor: 'testing' stamp: 'ClementBera 12/2/2013 12:42'!
includesAll: aCollection 
	"Answer whether all the elements of aCollection are in the receiver."

	aCollection do: [:elem | (self includes: elem) ifFalse: [^ false]].
	^ true
! !

!Timespan methodsFor: 'accessing' stamp: 'brp 5/13/2003 08:44'!
month

	^ start month ! !

!Timespan methodsFor: 'conversion' stamp: 'CamilloBruni 8/22/2013 18:40'!
to: anEnd
	"Answer an Timespan. anEnd must be aDateAndTime or a Timespan" 
	| end |
	end := (anEnd isKindOf: Timespan)
		ifTrue: [ anEnd end ]
		ifFalse: [ anEnd asDateAndTime ].
	^ Timespan starting: (self start) ending: end. ! !

!Timespan methodsFor: 'testing' stamp: 'ClementBera 12/2/2013 12:46'!
includesAnyOf: aCollection 
	
	self flag: 'use includesAny: instead'.
	
	^ self includesAny: aCollection! !

!Timespan methodsFor: 'enumerating' stamp: 'brp 5/13/2003 08:51'!
workDatesDo: aBlock
 	"Exclude Saturday and Sunday"

	self do: aBlock with: start asDate when: [ :d | d dayOfWeek < 6 ]. ! !

!Timespan methodsFor: 'accessing' stamp: 'brp 5/13/2003 08:45'!
daysInYear
 	"Answer the number of days in the month represented by the receiver."

	^ start daysInYear ! !

!Timespan methodsFor: 'accessing' stamp: 'brp 9/23/2004 09:53'!
end 

	^ self duration asNanoSeconds = 0
		ifTrue: [ self start ]
		ifFalse: [ self next start - DateAndTime clockPrecision ]! !

!Timespan methodsFor: 'conversion' stamp: 'brp 7/27/2003 17:45'!
asYear 

	^ start asYear! !

!Timespan methodsFor: 'accessing' stamp: 'brp 7/1/2003 17:55'!
firstDayOfMonth

	^ start firstDayOfMonth! !

!Timespan methodsFor: 'accessing' stamp: 'MarcusDenker 8/16/2012 15:22'!
julianDayNumberUTC
	^ start julianDayNumberUTC! !

!Timespan methodsFor: 'accessing' stamp: 'brp 7/1/2003 14:09'!
day
	"Answer the day of the year represented by the receiver."
	^ self dayOfYear! !

!Timespan methodsFor: 'private' stamp: 'brp 5/13/2003 08:59'!
duration: aDuration
	"Set the Duration of this timespan"

	duration := aDuration
! !

!Timespan methodsFor: 'accessing' stamp: 'brp 5/13/2003 08:44'!
asDateAndTime

	^ start ! !

!Timespan methodsFor: 'accessing' stamp: 'brp 5/13/2003 08:48'!
previous 

	^ self class starting: (start - duration) duration: duration ! !

!Timespan methodsFor: 'conversion' stamp: 'brp 7/27/2003 17:25'!
asTimeStamp

	^ start asTimeStamp! !

!Timespan methodsFor: 'enumerating' stamp: 'brp 5/13/2003 08:50'!
every: aDuration do: aBlock

	| element end |
	element := self start.
	end := self end.
	[ element <= end ] whileTrue:
	
	[ aBlock value: element.
		element := element + aDuration. ]
! !

!Timespan methodsFor: 'conversion' stamp: 'brp 5/13/2003 08:45'!
asMonth 

	^ start asMonth ! !

!Timespan methodsFor: 'enumerating' stamp: 'brp 5/13/2003 08:50'!
months

	| months |
	months := OrderedCollection new: 12.
	self monthsDo: [ :m | months add: m ].
	^ months asArray.! !

!Timespan methodsFor: 'enumerating' stamp: 'brp 5/13/2003 08:51'!
weeksDo: aBlock

	self do: aBlock with: self asWeek.! !

!Timespan methodsFor: 'enumerating' stamp: 'brp 5/13/2003 08:50'!
monthsDo: aBlock

 	self do: aBlock with: start asMonth.! !

!Timespan methodsFor: 'conversion' stamp: 'CamilloBruni 11/4/2013 08:21'!
translateTo: aTimeZone
	"Keep myself's representation and move it to another timezone offset.
	Note that unlike #offset: this WILL change the absolute time in UTC"
	
	^ self class
		starting: (start translateTo: aTimeZone)! !

!Timespan methodsFor: 'accessing' stamp: 'brp 5/13/2003 08:47'!
next

	^ self class starting: (start + duration) duration: duration ! !

!Timespan methodsFor: 'private' stamp: 'brp 5/13/2003 08:59'!
do: aBlock with: aFirstElement when: aConditionBlock

	| element end |
	element := aFirstElement.
	end := self end.
	[ element start <= end ] whileTrue:
	
	[(aConditionBlock value: element)
			ifTrue: [ aBlock value: element ].
		element := element next. ]! !

!Timespan methodsFor: 'accessing' stamp: 'MarcusDenker 8/16/2012 15:22'!
offset
	^ start offset! !

!Timespan methodsFor: 'conversion' stamp: 'CamilloBruni 6/1/2012 13:28'!
asDosTimestamp 

	^ start asDosTimestamp ! !

!Timespan methodsFor: 'accessing' stamp: 'brp 7/27/2003 17:49'!
dayOfMonth
	"Answer the day of the month represented by the receiver."

	^ start dayOfMonth! !

!Timespan methodsFor: 'accessing' stamp: 'brp 1/7/2004 16:25'!
monthAbbreviation 

	^ start monthAbbreviation ! !

!Timespan methodsFor: 'conversion' stamp: 'brp 5/13/2003 08:45'!
asWeek

	^ start asWeek ! !

!Timespan methodsFor: 'arithmetic' stamp: 'brp 9/15/2003 14:05'!
+ operand
	"operand conforms to protocol Duration" 	

	^ self class starting: (self start + operand) duration: self duration
! !

!Timespan methodsFor: 'arithmetic' stamp: 'brp 9/15/2003 14:07'!
- operand
	"operand conforms to protocol DateAndTime or protocol Duration"

	^ (operand respondsTo: #asDateAndTime) 
	 	ifTrue: [ self start - operand ]
	 	ifFalse: [ self + (operand negated) ]. ! !

!Timespan methodsFor: 'accessing' stamp: 'brp 5/13/2003 08:44'!
monthName 

	^ start monthName ! !

!Timespan methodsFor: 'accessing' stamp: 'brp 8/24/2003 11:50'!
dayOfYear
	"Answer the day of the year represented by the receiver."

	^ start dayOfYear! !

!Timespan methodsFor: 'enumerating' stamp: 'brp 1/9/2004 16:46'!
union: aTimespan
	 "Return the Timespan spanned by both"

	| aBegin anEnd |

	aBegin := self start min: aTimespan start.
	anEnd := self end max: aTimespan end.
	^ Timespan starting: aBegin ending: (anEnd + DateAndTime clockPrecision).
! !

!Timespan methodsFor: 'accessing' stamp: 'brp 5/13/2003 08:44'!
asDate 

	^ start asDate ! !

!Timespan methodsFor: 'printing' stamp: 'brp 9/25/2003 09:17'!
printOn: aStream 

	super printOn: aStream.
	aStream 
		nextPut: $(;
		print: start;
		nextPut: $D;
		print: duration;
		nextPut: $).
! !

!Timespan methodsFor: 'accessing' stamp: 'brp 5/13/2003 08:48'!
start
 	"Answer the start DateAndTime of this timespan"

	^ start ! !

!Timespan methodsFor: 'accessing' stamp: 'brp 5/13/2003 08:44'!
isLeapYear

	^ start isLeapYear ! !

!Timespan methodsFor: 'accessing' stamp: 'brp 5/13/2003 08:48'!
start: aDateAndTime
	"Store the start DateAndTime of this timespan"

	start := aDateAndTime asDateAndTime
! !

!Timespan methodsFor: 'accessing' stamp: 'brp 5/13/2003 08:45'!
daysInMonth 

	^ start daysInMonth ! !

!Timespan methodsFor: 'conversion' stamp: 'CamilloBruni 11/4/2013 08:21'!
translateToUTC 
	" Move this represenation to UTC"
	^ self translateTo: 0! !

!Timespan methodsFor: 'accessing' stamp: 'brp 5/13/2003 08:44'!
hash

	^ start hash + duration hash ! !

!Timespan methodsFor: 'conversion' stamp: 'brp 7/27/2003 17:45'!
asTime

	^ start asTime! !

!Timespan methodsFor: 'enumerating' stamp: 'brp 5/13/2003 08:51'!
years


	| years |
	years := OrderedCollection new.
	self yearsDo: [ :m | years add: m ].
	^ years asArray.! !

!Timespan methodsFor: 'enumerating' stamp: 'brp 5/13/2003 08:49'!
dates


	| dates |

	dates := OrderedCollection new.
	self datesDo: [ :m | dates add: m ].
	^ dates asArray.! !

!Timespan methodsFor: 'enumerating' stamp: 'brp 5/13/2003 08:51'!
weeks


	| weeks |
	weeks := OrderedCollection new.
	self weeksDo: [ :m | weeks add: m ].
	^ weeks asArray.! !

!Timespan methodsFor: 'accessing' stamp: 'brp 8/6/2003 18:42'!
dayOfWeekName
	"Answer the day of the week represented by the receiver."

	^ start dayOfWeekName! !

!Timespan methodsFor: 'testing' stamp: 'CamilloBruni 8/22/2013 18:24'!
includes: aDateAndTime 

	^ (aDateAndTime isKindOf: Timespan)
			ifTrue: [ 
				(self includes: aDateAndTime start)
					and: [ self includes: aDateAndTime end ] ]
			ifFalse: [ aDateAndTime asDateAndTime between: start and: self end ]
! !

!Timespan methodsFor: 'enumerating' stamp: 'brp 7/27/2003 17:47'!
intersection: aTimespan

	 "Return the Timespan both have in common, or nil"

	 | aBegin anEnd |
	 aBegin := self start max: aTimespan start.
	 anEnd := self end min: aTimespan end.
	 anEnd < aBegin ifTrue: [^nil].

	 ^ self class starting: aBegin ending: anEnd.
! !

!Timespan methodsFor: 'accessing' stamp: 'brp 5/13/2003 08:47'!
monthIndex

	^ self month ! !

!Timespan methodsFor: 'arithmetic' stamp: 'CamilloBruni 7/13/2012 20:45'!
= comparand
	^ self species = comparand species 
		and: [ self start = comparand start 
				and: [ self duration = comparand duration ]]
! !

!Timespan methodsFor: 'testing' stamp: 'ClementBera 12/2/2013 12:42'!
includesAllOf: aCollection 

	self flag: 'use includesAll: instead'.
	
	^ self includesAll: aCollection
! !

!Timespan methodsFor: 'accessing' stamp: 'CamilloBruni 11/4/2013 08:20'!
offset: anOffset
	"Answer a <Timespan> equivalent to the receiver but with its local time 
	being offset from UTC by offset.
	Unlike #translateTo: this will NOT change the absolute in UTC "

	^ self class 
		starting: (self start offset: anOffset) 
		duration: self duration! !

!Timespan methodsFor: 'testing' stamp: 'ClementBera 12/2/2013 12:46'!
includesAny: aCollection 
	"Answer whether any element of aCollection is included in the receiver"

	aCollection do: [ :elem | (self includes: elem) ifTrue: [^ true]].
	^false
! !

!Timespan methodsFor: 'accessing' stamp: 'brp 5/13/2003 08:44'!
year 

	^ start year ! !

!Timespan methodsFor: 'accessing' stamp: 'brp 5/13/2003 08:45'!
duration
 	"Answer the Duration of this timespan"

	^ duration ! !

!Timespan class methodsFor: 'instance creation' stamp: 'brp 7/27/2003 16:16'!
starting: startDateAndTime ending: endDateAndTime

	^ self 
		starting: startDateAndTime 
		duration: (endDateAndTime asDateAndTime - startDateAndTime). ! !

!Timespan class methodsFor: 'instance creation' stamp: 'brp 7/27/2003 18:48'!
starting: aDateAndTime duration: aDuration

	^ self basicNew
  		start: aDateAndTime asDateAndTime;
 		duration: aDuration;
		yourself.! !

!Timespan class methodsFor: 'instance creation' stamp: 'brp 7/27/2003 18:49'!
new
	"Answer a Timespan starting on the Squeak epoch: 1 January 1901"

	^ self starting: DateAndTime new
! !

!Timespan class methodsFor: 'instance creation' stamp: 'brp 5/21/2003 08:35'!
current 

	^ self starting: DateAndTime now ! !

!Timespan class methodsFor: 'instance creation' stamp: 'brp 5/13/2003 08:42'!
starting: aDateAndTime 

	^ self starting: aDateAndTime duration: Duration zero ! !

!TimespanDoSpanAYearTest commentStamp: 'tlk 1/6/2004 17:55'!
I am one of several Sunit test Cases intentended to provide complete coverage for the Chronology set of classes as part of the external testing. See DateAndTimeEpochTestCase for a complete list. tlk.
My fixtures include a Timespan that crosses over a year boundary:
aDate = December 25, 2004, midnight
aDuration = 91 days
aTimeSpan= 91 days, starting December 25, 2004, midnight!
!TimespanDoSpanAYearTest methodsFor: 'tests' stamp: 'brp 9/26/2004 19:06'!
testWeeksDo
	| weeks weekArray |
	weeks := aTimespan weeks.
	self assert: weeks size = ((aDuration days / 7.0) ceiling + 1).

	weekArray := OrderedCollection new.
	weekArray
		addLast: (Week starting: (DateAndTime year: 2004 month: 12 day: 19) duration: 7 days);
		addLast: (Week starting: (DateAndTime year: 2004 month: 12 day: 26) duration: 7 days).

	2 to: 79 by: 7 do:
		[ :i | weekArray
				addLast: (Week starting: (DateAndTime year: 2005 day: i) duration: 7 days) ].

	weekArray := weekArray asArray.
	self assert: aTimespan weeks = weekArray
! !

!TimespanDoSpanAYearTest methodsFor: 'tests' stamp: 'CamilloBruni 8/22/2013 20:04'!
testYearsDo
	| yearArray |
	yearArray := Array
				with: (Year year: 2004)
				with: (Year year: 2005).
	self assert: aTimespan years equals: yearArray
! !

!TimespanDoSpanAYearTest methodsFor: 'tests' stamp: 'brp 1/16/2004 13:55'!
testNext

	self assert: aTimespan next
			= (Timespan
					starting: (DateAndTime
							year: 2005
							month: 3
							day: 26
							hour: 0
							minute: 0
							second: 0)
					duration: aDuration)! !

!TimespanDoSpanAYearTest methodsFor: 'tests' stamp: 'brp 1/16/2004 13:55'!
testMonthsDo

	| monthArray |

	monthArray := Array
				with: (Month starting: (DateAndTime year: 2004 day: 355) duration: 31 days)
				with: (Month starting: (DateAndTime year: 2005 day: 1) duration: 31 days)
				with: (Month starting: (DateAndTime year: 2005 day: 32) duration: 29 days)
				with: (Month starting: (DateAndTime year: 2005 day: 61) duration: 31 days).
				
	self assert: aTimespan months = monthArray! !

!TimespanDoSpanAYearTest methodsFor: 'running' stamp: 'brp 9/26/2004 18:59'!
setUp
	aDate := DateAndTime year: 2004 month: 12 day: 25 hour: 0 minute: 0 second: 0.
	aDuration := Duration days: 91 hours: 0 minutes: 0 seconds: 0 nanoSeconds: 0.

	aTimespan := Timespan starting: aDate duration: aDuration! !

!TimespanDoTest commentStamp: 'tlk 1/6/2004 17:55'!
I am one of several Sunit test Cases intentended to provide complete coverage for the Chronology set of classes as part of the external testing. See DateAndTimeEpochTestCase for a complete list.  tlk.
My fixtures are:
aDate = January 8, 2003, midnight
aDuration = 91 days
aTimeSpan= 91 days, starting January 8, 2003, midnight
!
!TimespanDoTest methodsFor: 'tests' stamp: 'tlk 1/5/2004 18:00'!
testDatesDo
	| dateArray |
	dateArray := OrderedCollection new.
	7
		to: 97
		do: [:each | dateArray
				addLast: (Date year: 2003 day: each)].
	dateArray := dateArray asArray.
	self assert: aTimespan dates = dateArray! !

!TimespanDoTest methodsFor: 'tests' stamp: 'tlk 1/5/2004 16:36'!
testDoWith
	| count |
	count := 0.
	aTimespan
		do: [:each | count := count + 1]
		with: (Timespan
				starting: aDate
				duration: 7 days).
	self assert: count = 13! !

!TimespanDoTest methodsFor: 'tests' stamp: 'tlk 1/5/2004 13:09'!
testYearsDo
	| yearArray |
	yearArray := Array
				with: (Year
						starting: (DateAndTime year: 2003 day: 7)
						duration: 365 days).
	self assert: aTimespan years contents = yearArray contents! !

!TimespanDoTest methodsFor: 'tests' stamp: 'tlk 1/5/2004 13:05'!
testMonthsDo
	| monthArray |
	monthArray := Array
				with: (Month
						starting: (DateAndTime year: 2003 day: 1)
						duration: 31 days)
				with: (Month
						starting: (DateAndTime year: 2003 day: 32)
						duration: 28 days)
				with: (Month
						starting: (DateAndTime year: 2003 day: 60)
						duration: 31 days)		
				with: (Month
						starting: (DateAndTime year: 2003 day: 91)
						duration: 30 days).
	self assert: aTimespan months = monthArray! !

!TimespanDoTest methodsFor: 'tests' stamp: 'tlk 1/5/2004 16:39'!
testDoWithWhen
	| count |
	count := 0.
	aTimespan
		do: [:each | count := count + 1]
		with: (Timespan starting: aDate duration: 7 days)
		when: [:each | count < 5].
	self assert: count = 5	
! !

!TimespanDoTest methodsFor: 'tests' stamp: 'tlk 1/5/2004 13:07'!
testWeeksDo
	| weekArray |
	weekArray := OrderedCollection new.
	7
		to: 98
		by: 7
		do: [:each | weekArray
				addLast: (Week
						starting: (DateAndTime year: 2003 day: each)
						duration: 7 days)].
	weekArray := weekArray asArray.
	self assert: aTimespan weeks = weekArray
! !

!TimespanDoTest methodsFor: 'tests' stamp: 'tlk 1/5/2004 16:09'!
testNext
	self assert: aTimespan next 
			= (Timespan
					starting: (DateAndTime
							year: 2003
							month: 4
							day: 8
							hour: 0
							minute: 0
							second: 0)
					duration: aDuration)! !

!TimespanDoTest methodsFor: 'running' stamp: 'tlk 1/5/2004 13:01'!
setUp
	aDate := DateAndTime
				year: 2003
				month: 01
				day: 07
				hour: 0
				minute: 0
				second: 0.
	aDuration := Duration
				days: 91
				hours: 0
				minutes: 0
				seconds: 0
				nanoSeconds: 0.
	aTimespan := Timespan starting: aDate duration: aDuration! !

!TimespanDoTest methodsFor: 'tests' stamp: 'tlk 1/5/2004 15:39'!
testEveryDo
	|count  duration |
	count := 0.
	duration := 7 days.
	(aTimespan
			every: duration
			do: [:each | count := count + 1]).
	self assert: count = 13
			! !

!TimespanTest commentStamp: 'TorstenBergmann 2/5/2014 08:49'!
SUnit tests for Timespan class!
!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testNext
	self assert: aTimespan next = aDisjointTimespan
! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testIncludes
	self assert: (aTimespan includes: jan01).
	self deny: (aTimespan includes: jan08)
! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testUnionWithSelf
	self assert: (aTimespan union: aTimespan) = aTimespan
	! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testDaysInMonth
	self assert: aTimespan  daysInMonth  = 31.
	"MessageNotUnderstood: Month class>>starting:"
! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testPrevious
	self assert: aTimespan  = aDisjointTimespan previous.
	self assert: aTimespan next previous = aTimespan 
! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testAsDateAndTime
	self assert: aTimespan asDateAndTime =   jan01.
	"MessageNotUnderstood: Date class>>starting:"
	
! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testDay
	self assert: aTimespan day =   jan01 day
! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/7/2004 16:25'!
testAccessing

	self 
		assert: (timespan start =
				 (DateAndTime year: 2003 month: 03 day: 22 hour: 12 minute: 0 second: 0));
		assert: timespan duration = (Duration hours: 100);
		assert: timespan month = 3;
		assert: timespan monthName = 'March';
		assert: timespan monthAbbreviation = 'Mar'
		

! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testAsYear
	self assert: aTimespan asYear =   jan01 asYear.

! !

!TimespanTest methodsFor: 'tests' stamp: 'ClementBera 12/2/2013 12:46'!
testIncludesAny
	self deny: (aTimespan includesAnyOf: (Bag with: dec31)).
	self assert: (aTimespan includesAnyOf: (Bag with: jan01 with: jan08))
	"Error is due to bug in Timespan 
includesAnyOf: aCollection "
	"Answer whether any element of aCollection is included in the receiver"
	"aCollection do: [ :elem | (self includes: elem) ifTrue: [^ true]].
Shouldn't this return false if none are included?
"
! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testUnionWithIncluded

	self 
		assert: (aTimespan union: anIncludedTimespan) = aTimespan 	! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testUnionWithSeparate

	self 
		assert: (anOverlappingTimespan union: aDisjointTimespan) = 
			(Timespan 
				starting: anOverlappingTimespan start
				ending:  (aDisjointTimespan end + DateAndTime clockPrecision))
			
! !

!TimespanTest methodsFor: 'tests' stamp: 'ClementBera 12/2/2013 12:44'!
testIncludesAll
	self assert: (aTimespan includesAllOf: (Bag with: jan01)).
	self deny: (aTimespan includesAllOf: (Bag with: jan01 with: jan08))
! !

!TimespanTest methodsFor: 'tests' stamp: 'nk 3/30/2004 09:26'!
testCurrent
	self assert: (Timespan starting: DateAndTime current)
			<= Timespan current.
	self assert:  Timespan current
			<= (Timespan starting: DateAndTime current)! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testAsWeek
	self assert: aTimespan asWeek =   jan01 asWeek.
	"DateAndTime new asWeek
	 MessageNotUnderstood: Week class>>starting:"
! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testMonth
	self assert: aTimespan month  = 1.
	self assert: aTimespan monthName = 'January'.
	self assert: aTimespan monthIndex = 1.! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testUnionWithOverlapping

	self 
		assert: (aTimespan union: anOverlappingTimespan)  = 
				(Timespan starting: dec31 duration: (8 days))! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testTo
	self assert: (anIncludedTimespan to: jan08) = aTimespan 
! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 9/23/2004 09:57'!
testZeroDuration
	| ts |
	ts := Timespan starting: Date today duration: Duration zero.
	self
		assert: ts start = ts end! !

!TimespanTest methodsFor: 'tests' stamp: 'damiencassou 5/30/2008 11:09'!
testPrintOn
	| cs rw |
	cs := 'a Timespan(2005-01-01T00:00:00+00:00D7:00:00:00)' readStream.
	rw := ReadWriteStream on: ''.
	aTimespan printOn: rw.
	self assert: rw contents = cs contents! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testDayOfYear
	self assert: aTimespan  dayOfYear  = 1.
	"MessageNotUnderstood: UndefinedObject>>year:, Undefined object is Year class"
! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 9/23/2004 09:58'!
testClockPrecisionDuration
	| ts |
	ts := Timespan starting: Date today duration: DateAndTime clockPrecision.
	self
		assert: ts start = ts end! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testPlus
	self assert: aTimespan + aWeek = aDisjointTimespan.
	self assert: anOverlappingTimespan + aDay = aTimespan.
! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/9/2004 06:43'!
testInclusion

	| t1 t2 t3 t4 |
	t1 := timespan start.
	t2 := timespan start + (timespan duration / 2).
	t3 := timespan end.
	t4 := timespan start + (timespan duration).

	self 
		assert: (timespan includes: t1);
		assert: (timespan includes: t2);
		assert: (timespan includes: t3)";
		deny: (timespan includes: t4).
	self
		assert: (timespan includes: (t1 to: t2));
		assert: (timespan includes: (t1 to: t4));
		deny: (timespan includes: (Timespan starting: t2 duration: (timespan duration * 2))).
	self 
		assert: (timespan includesAllOf: { t1. t2. t3 } );
		deny: (timespan includesAllOf: { t1. t2. t3. t4} ).
	self 
		assert: (timespan includesAnyOf: { t1. t2. t3 } );
		deny: (timespan includesAnyOf: { t4 } ).
"! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testYear
	self assert: aTimespan year = 2005.

	! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testWorkDatesDo
	| count |
	count := 0.
	aTimespan
		workDatesDo: [:each | count := count + 1].
	self assert: count = 5! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testIntersectionWithSelf
	self assert: (aTimespan intersection: aTimespan)  = 
	(Timespan starting: jan01 duration: (Duration days: 6 hours: 23 minutes: 59 seconds: 59 nanoSeconds: 999999999)).		
	self deny: (aTimespan intersection: anIncludedTimespan)	= aTimespan
! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testDoWith
	| count |
	count := 0.
	aTimespan
		do: [:each | count := count + 1]
		with: (Timespan starting: jan01 duration: aDay).
	self assert: count = 7! !

!TimespanTest methodsFor: 'coverage' stamp: 'brp 9/15/2003 14:15'!
classToBeTested

	^ Timespan
! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testIntersectionWithSeparate
	self assert: (aTimespan intersection: aDisjointTimespan) isNil.
	self deny: (aTimespan intersection: anOverlappingTimespan) isNil.
	self assert: (aTimespan intersection: anIncludedTimespan)  = 
	(Timespan starting: jan01 duration: (Duration days: 0 hours: 23 minutes: 59 seconds: 59 nanoSeconds: 999999999)).		
	self deny: (aTimespan intersection: anIncludedTimespan)	= anIncludedTimespan
! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testIntersectionWithIncluded
	self assert: (aTimespan intersection: anIncludedTimespan)  = 
	(Timespan starting: jan01 duration: (Duration days: 0 hours: 23 minutes: 59 seconds: 59 nanoSeconds: 999999999)).		
	self deny: (aTimespan intersection: anIncludedTimespan)	= anIncludedTimespan
! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testMinusADuration
	"It appears that subtracting a duration from a Timespan gives you a Timespan shifted by the duration"
	self assert: aTimespan - aDay =  anOverlappingTimespan.
	self assert: aDisjointTimespan - aWeek =  aTimespan.	


! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testFirstDayOfMonth
	self assert: aTimespan firstDayOfMonth =   1. 
	self assert: aDisjointTimespan firstDayOfMonth =   1
! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/9/2004 16:49'!
testUnion

	| union |
	union := timespan union: timespan.
	
	self 
		assert: (union start = timespan start);
		assert: (union duration = timespan duration)
! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testDoWithWhen
	| count |
	count := 0.
	aTimespan
		do: [:each | count := count + 1]
		with: (Timespan starting: jan01 duration: aDay)
		when: [:each | count < 5].
	self assert: count = 5! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testDuration
	self assert: aTimespan duration  = aWeek.
	aTimespan duration: aDay.
	self assert: aTimespan duration =  aDay.

! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testStartingEnding
	self assert: aTimespan  = (Timespan starting: jan01 ending: jan08)
! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testIntersectionWithDisjoint
	self assert: (aTimespan intersection: aDisjointTimespan) isNil.
! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testStart
	self assert: aTimespan start =   jan01.
	aTimespan start: jan08.
	self assert: aTimespan start =   jan08.! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testAsDate
	self assert: aTimespan asDate =   jan01 asDate.
	"MessageNotUnderstood: Date class>>starting:"
! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testDaysInYear
	self assert: aTimespan  daysInYear  = 365.
	"MessageNotUnderstood: UndefinedObject>>starting:  UndefinedObject is Year class"
! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testIsLeapYear
	"self assert: anOverlappingTimespan isLeapYear."
	"not sure why this fails"
	self deny: aTimespan isLeapYear
! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testJulianDayNumber
	self assert: aTimespan julianDayNumber =  (jan01 julianDayNumber).
! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testMinusADateAndTime
	"It appears that subtracting a date from a Timespan gives you a duration = to the difference between the start of the timespan and the date "
	self assert: aTimespan - dec31 =  aDay.
	self assert: aDisjointTimespan - jan01 =  aWeek.


! !

!TimespanTest methodsFor: 'running' stamp: 'nk 3/30/2004 09:22'!
tearDown
	DateAndTime localTimeZone: localTimeZoneToRestore.
	timespan := nil
! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testAsMonth
	self assert: aTimespan asMonth =   jan01 asMonth.
! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testDayOfWeek
	self assert: aTimespan  dayOfWeek  = 7.
	self assert: aTimespan  dayOfWeekName = 'Saturday'.
! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testAsDuration
	self assert: aTimespan asDuration =  aWeek.

	
	
! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testAsTime
	self assert: aTimespan asTime =  jan01 asTime
	"MessageNotUnderstood: Time class>>seconds:nanoSeconds:"
 ! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testDayOfMonth
	self assert: aTimespan dayOfMonth  = 1.
! !

!TimespanTest methodsFor: 'running' stamp: 'nk 3/30/2004 09:21'!
setUp

	localTimeZoneToRestore := DateAndTime localTimeZone.
	DateAndTime localTimeZone: TimeZone default.

	"100 hours starting noon 22 March 2003"
	timespan := Timespan starting:
					(DateAndTime year: 2003 month: 03 day: 22 hour: 12 minute: 0 second: 0)
						duration: (Duration hours: 100).

	dec31 := (DateAndTime year: 2004 month: 12 day: 31 hour: 0 minute: 0 second: 0).
	jan01 := (DateAndTime year: 2005 month: 1 day: 1 hour: 0 minute: 0 second: 0).
	jan08 := (DateAndTime year: 2005 month: 1 day: 8 hour: 0 minute: 0 second:0).
	aDay := Duration days: 1 hours: 0 minutes: 0 seconds: 0 nanoSeconds: 0.
	aWeek := Duration days: 7 hours: 0 minutes: 0 seconds: 0 nanoSeconds: 0.
	aTimespan := Timespan starting: jan01 duration: aWeek.
	anOverlappingTimespan := Timespan starting: dec31 duration: aWeek.
	anIncludedTimespan := Timespan starting: jan01 duration: aDay.
	aDisjointTimespan := Timespan starting: jan08 duration: aWeek.



! !

!TimespanTest methodsFor: 'tests' stamp: 'StephaneDucasse 9/18/2010 21:38'!
testEnd
	"self debug: #testEnd"
	self assert: aTimespan end + (Duration  nanoSeconds: 1) =  aDisjointTimespan start.
	self assert: aTimespan end = (DateAndTime year: 2005 month: 1 day: 7 hour: 23 minute: 59 second: 59 nanoSecond: 999999999 offset: 0 hours).
	

! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testEveryDo
	| count duration |
	count := 0.
	duration := 7 days.
	aTimespan
		every: duration
		do: [:each | count := count + 1].
	self assert: count = 1! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testIntersectionWithOverlapping
	self assert: (aTimespan intersection: anOverlappingTimespan)  = 
	(Timespan starting: jan01 duration: (Duration days: 5 hours: 23 minutes: 59 seconds: 59 nanoSeconds: 999999999)).		

! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testNew
	self assert: Timespan new = (Timespan starting: '01-01-1901' asDate)! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testUnionWithDisjoint

	self assert: (aTimespan union: aDisjointTimespan)  = 
		(Timespan starting: jan01 duration: (14 days)).	
			
! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testLessThan
	self assert: aTimespan  < aDisjointTimespan.
	self deny: anIncludedTimespan < aTimespan
	! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 9/15/2003 14:29'!
testArithmetic

	| ts1 ts2 d |
	ts1 := timespan + 2 days.
	ts2 := ts1 - 2 days.
	d := ts1 - (DateAndTime year: 2003 month: 03 day: 20).

	self 
		assert: (ts1 start = 
				 (DateAndTime year: 2003 month: 03 day: 24 hour: 12 minute: 0 second: 0));
		assert: (ts1 duration = timespan duration);
		assert: (ts2 start = timespan start);
		assert: (ts2 duration = timespan duration).

	self
		assert: d = (Duration days: 4 hours: 12 minutes: 0 seconds: 0)

! !

!TimespanTest methodsFor: 'tests' stamp: 'brp 1/21/2004 18:31'!
testDaysLeftInYear
	self assert: aTimespan  daysLeftInYear  = 364.
	"MessageNotUnderstood: UndefinedObject>>starting:  UndefinedObject is Year class"
! !

!ToManyRelationSlot commentStamp: 'JanVanDeSandt 2/27/2015 11:26'!
I'm a relation slot  that  describes  slots that contain collections.!
!ToManyRelationSlot methodsFor: 'internal' stamp: 'JanVanDeSandt 2/21/2015 17:06'!
add: newObject to: collectionOwner

	self checkValue: newObject.
	self hasInverse
		ifTrue: [ self addAssociationFrom: collectionOwner to: newObject ]
! !

!ToManyRelationSlot methodsFor: 'initialization' stamp: 'JanVanDeSandt 2/27/2015 11:24'!
initialize: anObject
	self write: (RelationSet owner: anObject slot: self) to: anObject. 
	! !

!ToManyRelationSlot methodsFor: 'internal' stamp: 'JanVanDeSandt 2/21/2015 17:08'!
remove: oldObject from: collectionOwner

	self hasInverse
		ifTrue: [ self removeAssociationFrom: collectionOwner to: oldObject ]
! !

!ToManyRelationSlot methodsFor: 'meta-object-protocol' stamp: 'JanVanDeSandt 2/20/2015 15:48'!
wantsInitalization
	^ true! !

!ToOneRelationSlot commentStamp: 'JanVanDeSandt 2/27/2015 11:26'!
I'm an relation slot  that  describes the one or zero side of an association.!
!ToOneRelationSlot methodsFor: 'testing' stamp: 'JanVanDeSandt 2/21/2015 16:37'!
isToOneSlot

	^true! !

!ToOneRelationSlot methodsFor: 'meta-object-protocol' stamp: 'JanVanDeSandt 2/21/2015 17:03'!
write: newValue to: anObject

	| oldValue |

	oldValue := self read: anObject.
	newValue notNil
		ifTrue: [ self checkValue: newValue ].
	self hasInverse 
		ifTrue: [ 
			oldValue notNil
				ifTrue: [ self removeAssociationFrom: anObject to: oldValue ].
			newValue notNil
				ifTrue: [ self addAssociationFrom: anObject to: newValue ] ].
		
	super write: newValue to: anObject! !

!ToOneRelationSlot methodsFor: 'internal' stamp: 'JanVanDeSandt 2/21/2015 16:39'!
writeInverse: newValue to: anObject
	^anObject instVarAt: index put: newValue! !

!ToggleIconicButton commentStamp: '<historical>'!
A ToogleIconicButton is an iconic button with two different images, one when the button is activated, one when it is desactivated.

Not really usefull since there is PluggableThreePhaseButtonMorph!
!ToggleIconicButton methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 4/12/2011 16:31'!
update: aSymbol

	aSymbol = self statusSelector
		ifTrue: [ self updateStatus ].
	super update: aSymbol! !

!ToggleIconicButton methodsFor: 'private' stamp: 'BenjaminVanRyseghem 4/12/2011 16:37'!
updateStatus

	self getStatus
		ifTrue: [
			self enabledIcon
				ifNotNil: [:icon |
					 self labelGraphic: icon ]]
		ifFalse: [
			self disabledIcon
				ifNotNil: [:icon | 
					self labelGraphic: icon ]].! !

!ToggleIconicButton methodsFor: 'private' stamp: 'SeanDeNigris 7/11/2012 09:47'!
extraBorder

	^ 0.! !

!ToggleIconicButton methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/12/2011 16:12'!
disabledIcon

		^ disabledIcon! !

!ToggleIconicButton methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/12/2011 16:36'!
enabledIcon: anObject
	
		enabledIcon := anObject.
		self updateStatus.! !

!ToggleIconicButton methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/12/2011 16:12'!
statusSelector

		^ statusSelector! !

!ToggleIconicButton methodsFor: 'private' stamp: 'BenjaminVanRyseghem 4/12/2011 17:41'!
balloonText

	^ helpText! !

!ToggleIconicButton methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/12/2011 16:25'!
model

	^ model! !

!ToggleIconicButton methodsFor: 'private' stamp: 'BenjaminVanRyseghem 4/12/2011 16:26'!
getStatus

	self model 
		ifNotNil: [:mod | 
			self statusSelector
				ifNotNil:[:selector | 
					^ mod perform: selector ]].
	^ true! !

!ToggleIconicButton methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/12/2011 16:12'!
enabledIcon

		^ enabledIcon! !

!ToggleIconicButton methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/12/2011 16:36'!
disabledIcon: anObject
	
		disabledIcon := anObject.
		self updateStatus.! !

!ToggleIconicButton methodsFor: 'private' stamp: 'BenjaminVanRyseghem 1/21/2012 21:47'!
borderRaised
"	self borderStyle: (BorderStyle raised width: 0)."! !

!ToggleIconicButton methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/12/2011 17:10'!
model: anObject
	
	model ifNotNil: [model removeDependent: self].
	anObject ifNotNil: [anObject addDependent: self].
	model := anObject.
	self target: anObject! !

!ToggleIconicButton methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/12/2011 16:12'!
statusSelector: anObject
	
		statusSelector := anObject! !

!ToggleIconicButton class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 1/21/2012 22:33'!
on: model actionSelector: actionSelector status: status enabledIcon: enabledIcon disabledIcon: disabledIcon 

	^ self new
			model: model;
			actionSelector: actionSelector;
			color: Color transparent;
			borderWidth: 0;
			statusSelector: status;
			enabledIcon: enabledIcon;
			disabledIcon: disabledIcon;
			yourself! !

!ToggleMenuItemMorph commentStamp: 'gvc 5/18/2007 10:22'!
A menu item that supports on/off state (using standard icons), enablement and display of "accelerator" key text.!
!ToggleMenuItemMorph methodsFor: 'accessing' stamp: 'gvc 11/24/2008 12:57'!
isEnabled
	"Answer whether the item is enabled."
	
	|state|
	self enablementSelector ifNil: [^super isEnabled].
	state := self enablementSelector isSymbol
		ifTrue: [self target perform: self enablementSelector]
		ifFalse: [self enablementSelector value].
	self isEnabled: state.
	^state! !

!ToggleMenuItemMorph methodsFor: 'drawing-private' stamp: 'StephaneDucasse 9/28/2014 16:09'!
drawSubMenuMarker: aForm on: aCanvas in: aRectangle
	"Draw the submenu marker on the canvas within the given bounds."
	
	|markerRect| 
	markerRect := aRectangle topRight + (aForm width negated @ (aRectangle height - aForm height // 2)) extent: aForm extent.
	self drawIcon: aForm on: aCanvas in: markerRect! !

!ToggleMenuItemMorph methodsFor: 'private' stamp: 'MarcusDenker 7/5/2014 18:35'!
offImage
	"Return the form to be used for indicating an '<off>' marker."
	
	|m form|
	m := CheckboxButtonMorph new
		privateOwner: self owner;
		adoptPaneColor: self paneColor;
		selected: false.
	form := Form extent: m extent depth: 32.
	form fillColor: (Color white alpha: 0.003922).
	form getCanvas fullDrawMorph: m.
	^form! !

!ToggleMenuItemMorph methodsFor: 'selecting' stamp: 'StephaneDucasse 9/28/2014 16:09'!
adjacentTo

	^{self bounds topRight + (5 @ 0). self bounds topLeft + (2@0)}
	! !

!ToggleMenuItemMorph methodsFor: 'accessing' stamp: 'gvc 6/9/2006 09:16'!
getStateSelector: anObject
	"Set the value of getStateSelector"

	getStateSelector := anObject! !

!ToggleMenuItemMorph methodsFor: 'drawing-private' stamp: 'ClementBera 9/30/2013 11:01'!
basicDrawOn: aCanvas 
	"Draw on the canvas. Taken from MenuItemMorph for minor refactoring."
	
	| stringColor stringBounds|
	stringColor := self stringColorToUse.
	stringBounds := self stringBoundsToUse.
	(self isSelected and: [self isEnabled]) ifTrue: [
		aCanvas
			fillRectangle: self bounds
			fillStyle: self selectionFillStyle
			borderStyle: self selectionBorderStyle].
	self hasIcon ifTrue: [ |iconForm|
		iconForm := self icon.
		self drawIcon: iconForm on: aCanvas in: stringBounds.
		stringBounds := stringBounds left: stringBounds left + iconForm width + 2].
	self hasMarker ifTrue: [
		stringBounds := stringBounds left: stringBounds left + self submorphBounds width + 8].
	stringBounds := stringBounds top: stringBounds top + stringBounds bottom - self fontToUse height // 2.
	stringBounds := stringBounds bottom: stringBounds top + self fontToUse height.
	self drawText: contents on: aCanvas in: stringBounds.
	self hasSubMenu ifTrue: [ |subMenuMarker| 
		subMenuMarker := self subMenuMarker deepCopy mapColor: Color black to: stringColor.
		self drawSubMenuMarker: subMenuMarker on: aCanvas in: stringBounds]! !

!ToggleMenuItemMorph methodsFor: 'accessing' stamp: 'gvc 3/1/2010 15:55'!
stringColorToUse
	"Answer the state dependent color to use for drawing text."
	
	^self isEnabled
		ifTrue: [self isSelected
					ifTrue: [self theme menuItemSelectedTextColorFor: self]
					ifFalse: [self theme menuItemNormalTextColorFor: self]]
		ifFalse: [self theme menuItemDisabledTextColorFor: self]! !

!ToggleMenuItemMorph methodsFor: 'accessing' stamp: 'gvc 3/29/2007 16:25'!
adoptPaneColor: paneColor
	"Pass on to submenu too."
	
	super adoptPaneColor: paneColor.
	self hasSubMenu ifTrue: [self subMenu adoptPaneColor: paneColor]! !

!ToggleMenuItemMorph methodsFor: 'drawing-private' stamp: 'EstebanLorenzano 1/30/2013 17:35'!
drawText: aStringOrText on: aCanvas in: aRectangle
	^ self 
		drawText: aStringOrText 
		on: aCanvas 
		in: aRectangle 
		color: self stringColorToUse.! !

!ToggleMenuItemMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 9/28/2014 16:10'!
stringBoundsToUse
	"Answer the bounds to use when drawing the item text."
	
	^ self bounds! !

!ToggleMenuItemMorph methodsFor: 'testing' stamp: 'gvc 10/17/2008 14:44'!
isEnabled: aBoolean

	isEnabled = aBoolean ifTrue: [^ self].
	isEnabled := aBoolean.
	self changed! !

!ToggleMenuItemMorph methodsFor: 'layout' stamp: 'AlainPlantec 2/15/2010 10:47'!
minWidth
	"Plus the key text if any."
	
	|w|
	w := super minWidth.
	self keyText ifNotNil: [w := w + (self fontToUse widthOfString: self keyText) + 12].
	^w! !

!ToggleMenuItemMorph methodsFor: 'accessing' stamp: 'gvc 6/9/2006 16:13'!
keyText
	"Answer the value of keyText"

	^ keyText! !

!ToggleMenuItemMorph methodsFor: 'drawing-private' stamp: 'gvc 10/17/2008 14:05'!
drawIcon: aForm on: aCanvas in: aRectangle
	"Draw the icon on the canvas within the given bounds."
	
	|iconForm|
	self isEnabled
		ifTrue: [iconForm := aForm]
		ifFalse: [iconForm := Form extent: aForm extent depth: 32.
				iconForm fillColor: (Color white alpha: 0.003922).
				(iconForm getCanvas asAlphaBlendingCanvas: 0.5)
					drawImage: aForm
					at: 0@0].
	aCanvas
		translucentImage: iconForm
		at: aRectangle topLeft + (0@(aRectangle height - iconForm height // 2))! !

!ToggleMenuItemMorph methodsFor: 'private' stamp: 'MarcusDenker 7/5/2014 18:34'!
onImage
	"Return the form to be used for indicating an '<on>' marker."
	
	|m form|
	m := CheckboxButtonMorph new
		privateOwner: self owner;
		adoptPaneColor: self paneColor;
		selected: true.
	form := Form extent: m extent depth: 32.
	form fillColor: (Color white alpha: 0.003922).
	form getCanvas fullDrawMorph: m.
	^form! !

!ToggleMenuItemMorph methodsFor: 'private' stamp: 'StephaneDucasse 9/28/2014 16:10'!
selectionFillStyle
	"Answer the fill style to use with the receiver is the selected element."
	
	^ self theme menuItemSelectedFillStyleFor: self! !

!ToggleMenuItemMorph methodsFor: 'accessing' stamp: 'gvc 6/9/2006 09:35'!
enablementSelector
	"Answer the value of enablementSelector"

	^ enablementSelector! !

!ToggleMenuItemMorph methodsFor: 'accessing' stamp: 'gvc 6/9/2006 16:13'!
keyText: anObject
	"Set the value of keyText"

	keyText := anObject! !

!ToggleMenuItemMorph methodsFor: 'drawing-private' stamp: 'EstebanLorenzano 5/1/2014 11:10'!
drawKeyTextOn: aCanvas 
	"Draw the key text on the canvas."
	
	|ktp ktw b|
	self keyText ifNil: [^self].	
	ktp := self hasSubMenu ifTrue: [self right - self subMenuMarker width] ifFalse: [self right].
	ktp := ktp - (ktw := self fontToUse widthOfString: self keyText).
	b := (ktp @ (self bounds top + self bounds bottom - self fontToUse height // 2) extent: ktw @ self height).
	self drawText: self keyText on: aCanvas in: b color: self theme disabledTextColor.! !

!ToggleMenuItemMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/1/2013 18:28'!
balloonText: aText

	self assureExtension balloonText: aText! !

!ToggleMenuItemMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 9/28/2014 16:09'!
selectionBorderStyle
	"Answer the border style to use with the receiver is the selected element."
	
	^ self theme menuItemSelectedBorderStyleFor: self! !

!ToggleMenuItemMorph methodsFor: 'drawing' stamp: 'gvc 10/12/2006 15:30'!
drawOn: aCanvas 
	"Need to check isEnabled here."
	
	self
		isEnabled;
		basicDrawOn: aCanvas;
		drawKeyTextOn: aCanvas! !

!ToggleMenuItemMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/1/2013 14:51'!
argumentsBlock: aBlock

	self arguments: aBlock value! !

!ToggleMenuItemMorph methodsFor: 'drawing-private' stamp: 'EstebanLorenzano 1/30/2013 17:38'!
drawText: aStringOrText on: aCanvas in: aRectangle color: stringColor 
	"Draw the text on the canvas within the given bounds."
	
	(self enabled not and: [self theme disabledItemStyle = #inset])
		ifTrue: [
				aCanvas
					drawString: aStringOrText
					in: aRectangle 
					font: self fontToUse
					color: stringColor muchLighter lighter;
					drawString: aStringOrText
					in: (aRectangle translateBy: -1)
					font: self fontToUse
					color: stringColor]
		ifFalse: [aCanvas
					drawString: aStringOrText
					in: aRectangle 
					font: self fontToUse
					color: stringColor ]! !

!ToggleMenuItemMorph methodsFor: 'events' stamp: 'Sd 1/28/2011 14:36'!
mouseEnter: evt
	"The mouse entered the receiver.
	Handle the case when in an EmbeddedMenuMorph."

	super mouseEnter: evt.
	(owner notNil and: [owner isKindOf: EmbeddedMenuMorph]) ifTrue:[
		owner selectedItem ~~ self
			ifTrue: [owner selectItem: self event: evt]]! !

!ToggleMenuItemMorph methodsFor: 'selecting' stamp: 'gvc 6/9/2006 15:07'!
select: evt
	"Don't if not enabled."
	
	self isEnabled ifFalse: [^self].
	^super select: evt! !

!ToggleMenuItemMorph methodsFor: 'accessing' stamp: 'gvc 6/9/2006 09:35'!
enablementSelector: anObject
	"Set the value of enablementSelector"

	enablementSelector := anObject! !

!ToggleMenuItemMorph methodsFor: 'events' stamp: 'gvc 5/6/2008 14:36'!
mouseLeave: evt
	"The mouse left the receiver.
	Handle the case when in an EmbeddedMenuMorph."

	super mouseLeave: evt.
	(owner notNil and: [owner isKindOf: EmbeddedMenuMorph]) ifTrue:[
		owner selectedItem == self
			ifTrue: [owner selectItem: nil event: evt]]! !

!ToggleMenuItemMorph methodsFor: 'accessing' stamp: 'gvc 6/9/2006 09:16'!
getStateSelector
	"Answer the value of getStateSelector"

	^ getStateSelector! !

!ToggleMenuItemMorph methodsFor: 'accessing' stamp: 'MarcusDenker 7/5/2014 18:35'!
icon
	"Answer the receiver's icon. Handle legacy case
	of wording-based mechanism."
	
	|state| 
	self getStateSelector ifNil: [^super icon].
	state := (MessageSend receiver: self target selector: self getStateSelector)
		valueWithEnoughArguments: self arguments .
	self flag: #CleanYesNoOnOffAfter.
	(state isKindOf: Association)
		ifTrue: [^ state key ifTrue: [self onImage] ifFalse: [self offImage]]
		ifFalse: [
	(state = true or: [state isString and: [(state beginsWith: '<yes>') or: [state beginsWith: '<on>']]])
		ifTrue: [^self onImage].
	(state = false or: [state isString and: [(state beginsWith: '<no>') or: [state beginsWith: '<off>']]])
		ifTrue: [^self offImage]].
	^super icon! !

!TokenTreeFilter commentStamp: '<historical>'!
I am a filter for a token.

If a node item contains my token I accept it!
!TokenTreeFilter methodsFor: 'initialization' stamp: 'CamilloBruni 7/17/2013 23:08'!
initialize

	super initialize.

	token := ''.! !

!TokenTreeFilter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/18/2013 17:00'!
token: anObject
	
	token := anObject! !

!TokenTreeFilter methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 4/18/2013 17:00'!
token
	^ token! !

!TokenTreeFilter methodsFor: 'filtering' stamp: 'BenjaminVanRyseghem 4/18/2013 17:33'!
keepTreeNode: aNode

	^ aNode matchTokenFilter: self! !

!TokenTreeFilter class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 4/18/2013 17:00'!
token: token

	^ self new
		token: token;
		yourself! !

!ToolDockingBarMorph commentStamp: 'gvc 5/18/2007 10:20'!
A non user-moveable docking bar that uses theme-based fill styles.!
!ToolDockingBarMorph methodsFor: 'as yet unclassified' stamp: 'gvc 10/16/2006 14:27'!
wantsYellowButtonMenu
	"Answer true if the receiver wants a yellow button menu."
	
	^false! !

!ToolDockingBarMorph methodsFor: 'as yet unclassified' stamp: 'gvc 3/14/2007 13:28'!
gradientRamp
	"If not set answer based on orininal color."
	
	^self normalFillStyle colorRamp! !

!ToolDockingBarMorph methodsFor: 'as yet unclassified' stamp: 'gvc 3/14/2007 13:29'!
updateColor
	"private - update the receiver's color"
	
	self autoGradient
		ifFalse: [^ self].
	self fillStyle: self normalFillStyle! !

!ToolDockingBarMorph methodsFor: '*Spec-Core' stamp: 'BenjaminVanRyseghem 2/18/2014 23:33'!
adoptMenuModel: aMenuModel

	aMenuModel menuGroups doWithIndex: [ :aGroup :index | 
		self 
			adoptMenuGroupModel: aGroup
			first: (index = 1) ]! !

!ToolDockingBarMorph methodsFor: '*Spec-Core' stamp: 'BenjaminVanRyseghem 2/18/2014 23:42'!
adoptMenuItemModel: item accumulator: controls
	
	item subMenu
		ifNil: [ | button |
			button := self buildButtonFor: item.
			controls add: button ]
		ifNotNil: [ 
			self emptyAccumulator: controls.
			self addMorphBack: (Smalltalk ui theme newToolSpacerIn: self).
			self 
				add: item name
				font: Smalltalk ui theme menuBarFont
				icon: item icon
				help: item description
				subMenu: item subMenu buildWithSpecAsPopup.
			self addMorphBack: (Smalltalk ui theme newToolSpacerIn: self) ]! !

!ToolDockingBarMorph methodsFor: '*Spec-Core' stamp: 'BenjaminVanRyseghem 2/18/2014 23:31'!
emptyAccumulator: controls
	
	controls do: [ :button | self addMorphBack: button ].
	controls removeAll! !

!ToolDockingBarMorph methodsFor: 'as yet unclassified' stamp: 'gvc 5/23/2007 14:28'!
normalFillStyle
	"Return the normal fillStyle of the receiver."
	
	^self theme dockingBarNormalFillStyleFor: self! !

!ToolDockingBarMorph methodsFor: '*Spec-Core' stamp: 'BenjaminVanRyseghem 2/18/2014 23:46'!
buildButtonFor: item

	^ Smalltalk ui theme
		newButtonIn: self for: item
		getState: #enabled
		action: #performMenuActionWith:
		arguments: { self }
		getEnabled: #enabled 
		label: (IconicListItem text: item name icon: item icon)
		help: item description ! !

!ToolDockingBarMorph methodsFor: '*Spec-Core' stamp: 'BenjaminVanRyseghem 2/18/2014 23:33'!
adoptMenuGroupModel: aGroupModel first: aBoolean
	| controls |
	
	aBoolean ifFalse: [ 
		self 
			addMorphBack: (Smalltalk ui theme newToolSpacerIn: self);
			addMorphBack: (Smalltalk ui theme newToolbarHandleIn: self);
			addMorphBack: (Smalltalk ui theme newToolSpacerIn: self) ].
			
	controls := OrderedCollection new.
	aGroupModel menuItems do: [ :item | self adoptMenuItemModel: item accumulator: controls ].
	
	self emptyAccumulator: controls! !

!ToolRegistry commentStamp: 'BernardoContreras 1/18/2012 21:44'!
I am serving as a system-wide hub for various tools.
Instead of using direct class names for tools, which is not always nice because can introduce inter-package
dependencies, i provide a uniform way for accessing tools, via Smalltalk global:

Smalltalk tools someToolName,

where 'someToolName' is a name of the tool , under which some tool are registered.

Tools are adding themselves to registry by implementing #registerToolsOn: message at class side, for example:

MyClass>>registerToolsOn: registry
   registry register: self as: #myTool

Registers a MyClass as a tool under name #myTool, and can be accessed via:

Smalltalk tools myTool 

and avoid putting 'MyClass' reference into code.

You can add  ' self registerToolsOn: Smalltalk tools ' in class #initialize,
so your new tool(s) can be registered during package loading.

To reset tool registry to defaults , use: 
Smalltalk resetTools.

Also registry storing a map of inspector types. 
This is to replace an old scheme which using #inspectorClass , and introducing dependencies.
Now, an inspecting class dont needs to have any knowledge about its specialized inspector.
Instead, a specialized inspector could tell registry that it is available for inspecting instances of given class (see #registerInspector:for:  senders).
This allows to avoid dependency from instance class to its inspector class or using extension methods.

WARNING: The point of the tools registry is NOT to be a facade full of protocols but to be a registration for tools that get loaded. So, the tools registry should NOT hold specific tool's protocol.  the tool's client should invoke the correct methods of the tool.

----------- 
The category 'menu' is for backward compatibility with ToolSet. We should remove it.

!
!ToolRegistry methodsFor: '*Deprecated40' stamp: 'PavelKrivanek 7/24/2014 16:14'!
shortcuts

	self deprecated: 'use Morph shortcutsHandler' on: '24 July 2014' in: #Pharo40.
	^ Morph shortcutsHandler! !

!ToolRegistry methodsFor: 'menu' stamp: 'MarcusDenker 9/29/2013 15:31'!
menuItems
	"Answer the menu items available for this tool set"

	^#(
		('System Browser' 			#openClassBrowser)
		-
		('Workspace'				#openWorkspace)
		('Transcript' 				#openTranscript)
		('File Browser'				#openFileList)
		-
		('Test Runner'				#openTestRunner)
		('Process Browser' 			#openProcessBrowser)
		-
		('Monticello Browser'		#openMonticelloBrowser)
		('Recover lost changes...'	#openRecentChangesLog)
		('Change Sorter'			#openChangeSorter)
	)
! !

!ToolRegistry methodsFor: 'menu' stamp: 'IgorStasenko 2/19/2011 03:58'!
openWorkspace
	^ self workspace open! !

!ToolRegistry methodsFor: 'registration' stamp: 'BenjaminVanRyseghem 2/22/2012 14:53'!
register: anObject as: aNameSelector
	"Register a tool class under given name"
	tools at: aNameSelector put: anObject.
	WorldState defaultWorldMenu! !

!ToolRegistry methodsFor: 'tools' stamp: 'IgorStasenko 2/20/2011 14:36'!
transcript
	"No need to register transcript. But for uniformity,
	implement this method, so transcript can be accessed via
	Smalltalk tools transcript , as any other tool "
	^ Transcript! !

!ToolRegistry methodsFor: 'testing' stamp: 'IgorStasenko 2/19/2011 03:18'!
hasToolNamed: aToolName
	^ tools includesKey: aToolName ! !

!ToolRegistry methodsFor: 'initialize-release' stamp: 'IgorStasenko 8/12/2011 16:37'!
initDefaultToolSet
	
	"Query the system for registering tools"
	"we cannot afford to show warnings because not all tools e.g Debugger, Inspector are registered yet"
	
	[	
	Object withAllSubclassesDo: [:ea | 
		
	"evaluate only for classes which directly implement this message,
	not via subclassing"
		(ea isMeta  and: [
			ea includesSelector: #registerToolsOn: ]) ifTrue: [
			 ea theNonMetaClass registerToolsOn: self  ]].
	] on: Warning do: [:ex | ex resume ]! !

!ToolRegistry methodsFor: 'menu' stamp: 'MarcusDenker 4/2/2013 15:50'!
openFileList
	self fileList open! !

!ToolRegistry methodsFor: 'convenience-inspecting' stamp: 'AndreiChis 12/20/2013 16:32'!
inspectorClass

	^ EyeInspector 
	
! !

!ToolRegistry methodsFor: 'tools' stamp: 'MarcusDenker 9/28/2013 15:48'!
inspector
	"understand by Object, so we need to work around not getting a DNU"
	^self doesNotUnderstand: (Message selector: #inspector)! !

!ToolRegistry methodsFor: 'menu' stamp: 'IgorStasenko 2/19/2011 03:55'!
openClassBrowser
	^ self browser open! !

!ToolRegistry methodsFor: 'menu' stamp: 'IgorStasenko 2/20/2011 14:39'!
openRecentChangesLog
	self changeList browseRecentLog! !

!ToolRegistry methodsFor: 'misc' stamp: 'IgorStasenko 10/29/2008 02:09'!
informNoDebugger
	(self includes: #uiManager) 
		ifTrue: [
			self uiManager inform: 'Cannot open debugger' ]
		ifFalse: [
			"If we throw an exception here, this can lead to recursion.
			Any idea what else we can do here?"
			Processor activeProcess terminate ]! !

!ToolRegistry methodsFor: 'initialization' stamp: 'cb 6/25/2013 13:32'!
initialize

	"symbols used as keys "
	tools := IdentityDictionary new.  
	
	self initDefaultToolSet! !

!ToolRegistry methodsFor: 'handling DNU' stamp: 'IgorStasenko 2/19/2011 03:15'!
doesNotUnderstand: aMessage
	"Return a tool identified by a message selector.
	We need to handle special case, when no debugger registered.
	"
	| tool |
	tool := tools at: aMessage selector ifAbsent: nil.
	tool ifNotNil: [ ^ tool value ].

	^ (aMessage selector == #debugger) 
		ifTrue: [ 
			Smalltalk 
				logError: 'No debugger installed to handle debug request.' 
				inContext: thisContext.
		
			nil. "Smalltalk snapshot: false andQuit: true."
		]
		ifFalse: [ super doesNotUnderstand: aMessage ]
! !

!ToolRegistry methodsFor: 'menu' stamp: 'MarcusDenker 4/2/2013 15:49'!
openMonticelloBrowser
	self monticelloBrowser open
	! !

!ToolRegistry methodsFor: 'menu' stamp: 'IgorStasenko 10/29/2008 03:43'!
openProcessBrowser
	self using: #processBrowser do: [:tool |
		tool open
		]
! !

!ToolRegistry methodsFor: '*Deprecated40' stamp: 'PavelKrivanek 7/13/2014 13:50'!
userManager

	self deprecated: 'use UserManager default' on: '13 July 2014' in: #Pharo40.
	^ UserManager default! !

!ToolRegistry methodsFor: 'registration' stamp: 'IgorStasenko 10/29/2008 01:31'!
remove: aName
	"remove tool with given name"
	tools removeKey: aName ifAbsent: []! !

!ToolRegistry methodsFor: 'misc' stamp: 'IgorStasenko 2/19/2011 04:03'!
using: aToolName do: aBlock
	"Evaluate a block for tool found under corresponding name or silently ignore if its not found or nil"
	| tool |
	
	tool := tools at: aToolName ifAbsent: [ ^ self ].
	tool ifNotNil: [ ^ aBlock value: tool value ]! !

!ToolRegistry methodsFor: 'misc' stamp: 'MarcusDenker 5/27/2011 14:24'!
codeCompletionAround: aBlock textMorph: aTextMorph keyStroke: evt
	^(self hasToolNamed: #codeCompletion)
	ifTrue: [ self codeCompletion codeCompletionAround: aBlock textMorph: aTextMorph keyStroke: evt ]
	ifFalse: [ aBlock value ]! !

!ToolRegistry methodsFor: 'menu' stamp: 'IgorStasenko 2/19/2011 04:02'!
openTestRunner
	self using: #testRunner do: [:tool | tool open ]! !

!ToolRegistry methodsFor: 'menu' stamp: 'MarcusDenker 4/2/2013 15:48'!
openTranscript
	^ self transcript open! !

!ToolRegistry methodsFor: 'misc' stamp: 'MarcusDenker 7/12/2012 18:02'!
browseDirectToolReferences
	"Smalltalk tools browseDirectToolReferences"
	"Browse all direct references of all of my registered tools.
	Useful for converting calls like:

		MyTool foo
	into:
		Smalltalk tools myTool foo 	"
	
	| bindings |
	
	bindings := tools values select: [:each | each value isBehavior ]
		thenCollect: [:each | each value binding ].
	bindings := bindings copyWith: (Smalltalk bindingOf: #ToolSet).

	^  SystemNavigation new
		browseMessageList: (
			SystemNavigation new allMethodsSelect: [:m |
				(m literals allButLast select: [:lit| lit isVariableBinding ]) includesAnyOf: bindings ] )
		name: 'All direct references to tools to fix'! !

!ToolShortcutsCategory commentStamp: 'BenComan 2/17/2014 23:07'!
ToolShortcuts defines some global keyboard shortcuts to open tools for workspaces, system browser, monticello browser, settings, transcript and also image saving. !
!ToolShortcutsCategory methodsFor: 'keymaps' stamp: 'CamilloBruni 2/19/2014 16:33'!
openSettings
	<shortcut>
	^ KMKeymap
			shortcut: $o command, $s command
			action: [ SettingBrowser open ]! !

!ToolShortcutsCategory methodsFor: 'keymaps' stamp: 'CamilloBruni 2/19/2014 16:30'!
openWorkspace
	<shortcut>
	^ KMKeymap
			shortcut: $o command, $w command
			action: [ Smalltalk tools workspace open ]! !

!ToolShortcutsCategory methodsFor: 'keymaps' stamp: 'CamilloBruni 2/19/2014 16:30'!
saveImage
	<shortcut>
	^ KMKeymap
			shortcut: $s command shift
			action: [ Smalltalk snapshot: true andQuit: false. UIManager default inform: 'Image saved' ]! !

!ToolShortcutsCategory methodsFor: 'keymaps' stamp: 'CamilloBruni 2/19/2014 16:30'!
openMonticelloPackageBrowser
	<shortcut>
	^ KMKeymap
			shortcut: $o command, $p command
			action: [ Smalltalk tools openMonticelloBrowser ]! !

!ToolShortcutsCategory methodsFor: 'keymaps' stamp: 'CamilloBruni 2/19/2014 16:29'!
openTranscript
	<shortcut>
	^ KMKeymap
			shortcut: $o command, $t command
			action: [ Smalltalk tools openTranscript ]! !

!ToolShortcutsCategory methodsFor: 'keymaps' stamp: 'CamilloBruni 2/19/2014 16:29'!
openSystemBrowser
	<shortcut>
	^ KMKeymap
			shortcut: $o command, $b command
			action: [ Smalltalk tools openClassBrowser ]! !

!ToolShortcutsCategory methodsFor: 'keymaps' stamp: 'CamilloBruni 2/19/2014 16:29'!
openUnitTestRunner
	<shortcut>
	^ KMKeymap
			shortcut: $o command, $u command
			action: [ Smalltalk tools openTestRunner ]! !

!ToolShortcutsCategory class methodsFor: 'testing' stamp: 'LeoGassman 11/7/2013 16:35'!
isGlobalCategory

	^ true ! !

!TopLeftGripMorph commentStamp: 'jmv 1/29/2006 17:18'!
I am the handle in the left top of windows used for resizing them.!
!TopLeftGripMorph methodsFor: 'accessing' stamp: 'jmv 1/29/2006 17:52'!
resizeCursor

	^ Cursor resizeForEdge: #topLeft! !

!TopLeftGripMorph methodsFor: 'target resize' stamp: 'md 2/24/2006 22:44'!
ptName
	^#topLeft! !

!TopLeftGripMorph methodsFor: 'target resize' stamp: 'jmv 1/29/2006 18:02'!
apply: delta 
	| oldBounds |
	oldBounds := target bounds.
	target
		bounds: (oldBounds origin + delta corner: oldBounds corner)! !

!TopLeftGripMorph methodsFor: 'drawing' stamp: 'gvc 5/13/2008 10:21'!
drawOn: aCanvas
	"Draw the grip on the given canvas."

	| dotBounds alphaCanvas windowBorderWidth dotBounds2 |
	
	self shouldDraw ifFalse: [^self].

	windowBorderWidth := SystemWindow borderWidth.
	alphaCanvas := aCanvas asAlphaBlendingCanvas: 0.7.	
	"alphaCanvas
		frameRectangle: bounds color: Color blue."

	dotBounds := self bounds.
	dotBounds2 := dotBounds right: (dotBounds left + windowBorderWidth).
	dotBounds2 := dotBounds2 bottom: (dotBounds2 top + windowBorderWidth).
	alphaCanvas
		fillRectangle: dotBounds2
		color: self handleColor.
	
	dotBounds2 := dotBounds left: (dotBounds left + windowBorderWidth).
	dotBounds2 := dotBounds2 bottom: (dotBounds2 top + windowBorderWidth).
	alphaCanvas
		fillRectangle: dotBounds2
		color: self handleColor.

	dotBounds2 := dotBounds2 left: (dotBounds2 left + 7).
	dotBounds2 := dotBounds2 right: (dotBounds2 right - 7).
	alphaCanvas
		fillRectangle: dotBounds2
		color: self dotColor.

	dotBounds2 := dotBounds right: (dotBounds left + windowBorderWidth).
	dotBounds2 := dotBounds2 top: (dotBounds2 top + windowBorderWidth).
	alphaCanvas
		fillRectangle: dotBounds2
		color: self handleColor.

	dotBounds2 := dotBounds2 top: (dotBounds2 top + 7).
	dotBounds2 := dotBounds2 bottom: (dotBounds2 bottom - 7).
	alphaCanvas
		fillRectangle: dotBounds2
		color: self dotColor! !

!TopLeftGripMorph methodsFor: 'accessing' stamp: 'IgorStasenko 12/20/2012 14:57'!
gripLayoutFrame
	^ (0 @ 0 corner: 0 @ 0) asLayoutFrame 
			topOffset: -27;
		 	rightOffset: self defaultWidth! !

!TopLeftGripMorph methodsFor: 'testing' stamp: 'gvc 3/12/2007 10:53'!
containsPoint: aPoint
	"Answer true only if on edges."
	
	|w|
	^(super containsPoint: aPoint) and: [
		w := SystemWindow borderWidth.
		((self bounds translateBy: w@w)
			containsPoint: aPoint) not]! !

!TopRightGripMorph commentStamp: 'jmv 1/29/2006 17:18'!
I am the handle in the right top of windows used for resizing them.!
!TopRightGripMorph methodsFor: 'accessing' stamp: 'jmv 1/29/2006 17:52'!
resizeCursor

	^ Cursor resizeForEdge: #topRight! !

!TopRightGripMorph methodsFor: 'accessing' stamp: 'md 2/24/2006 22:44'!
ptName
	^#topRight! !

!TopRightGripMorph methodsFor: 'target resize' stamp: 'jmv 1/29/2006 18:05'!
apply: delta 
	| oldBounds |
	oldBounds := target bounds.
	target
		bounds: (oldBounds origin + (0@delta y) corner: oldBounds corner + (delta x @ 0))! !

!TopRightGripMorph methodsFor: 'drawing' stamp: 'gvc 5/13/2008 10:21'!
drawOn: aCanvas
	"Draw the grip on the given canvas."

	| dotBounds alphaCanvas windowBorderWidth dotBounds2 |
	
	self shouldDraw ifFalse: [^self].

	windowBorderWidth := SystemWindow borderWidth.
	alphaCanvas := aCanvas asAlphaBlendingCanvas: 0.7.	
	"alphaCanvas
		frameRectangle: bounds color: Color blue."

	dotBounds := self bounds.
	dotBounds2 := dotBounds left: (dotBounds right - windowBorderWidth).
	dotBounds2 := dotBounds2 bottom: (dotBounds2 top + windowBorderWidth).
	alphaCanvas
		fillRectangle: dotBounds2
		color: self handleColor.
	
	dotBounds2 := dotBounds right: (dotBounds right - windowBorderWidth).
	dotBounds2 := dotBounds2 bottom: (dotBounds2 top + windowBorderWidth).
	alphaCanvas
		fillRectangle: dotBounds2
		color: self handleColor.

	dotBounds2 := dotBounds2 left: (dotBounds2 left + 7).
	dotBounds2 := dotBounds2 right: (dotBounds2 right - 7).
	alphaCanvas
		fillRectangle: dotBounds2
		color: self dotColor.

	dotBounds2 := dotBounds left: (dotBounds right - windowBorderWidth).
	dotBounds2 := dotBounds2 top: (dotBounds2 top + windowBorderWidth).
	alphaCanvas
		fillRectangle: dotBounds2
		color: self handleColor.

	dotBounds2 := dotBounds2 top: (dotBounds2 top + 7).
	dotBounds2 := dotBounds2 bottom: (dotBounds2 bottom - 7).
	alphaCanvas
		fillRectangle: dotBounds2
		color: self dotColor! !

!TopRightGripMorph methodsFor: 'accessing' stamp: 'IgorStasenko 12/20/2012 14:59'!
gripLayoutFrame
	^ (1 @ 0 corner: 1 @ 0) asLayoutFrame 
			topLeftOffset: self defaultWidth negated @ -27! !

!TopRightGripMorph methodsFor: 'testing' stamp: 'gvc 3/12/2007 10:53'!
containsPoint: aPoint
	"Answer true only if on edges."
	
	|w|
	^(super containsPoint: aPoint) and: [
		w := SystemWindow borderWidth.
		((self bounds translateBy: w negated@w)
			containsPoint: aPoint) not]! !

!TotalCost commentStamp: 'StephaneDucasse 6/9/2010 20:53'!
Part of an test resource to verify that super is well bound.
See CompilerEvaluationTest!
!TotalCost methodsFor: 'as yet unclassified' stamp: 'NikoSchwarz 6/5/2010 15:53'!
total
	^25000 ! !

!Trait commentStamp: '<historical>'!
Each trait in the system is represented as an instance of me. Like Class, I concretize my superclass by providing instance variables for the name and the environment. Since traits do not define variables, I not provide facilities for pool variables. However, I declare an instance variable to hold the associated classtrait, which is an instance of the class ClassTrait. !
!Trait methodsFor: '*Deprecated40' stamp: ''!
ensureClassPool
	self deprecated: 'just use the accessor for classPool' on: '2 July 2014' in: 'Pharo40'.
	^self classPool.! !

!Trait methodsFor: 'testing' stamp: ''!
isObsolete
	"Return true if the receiver is obsolete."
	^self propertyValueAt: #obsolete ifAbsent: false! !

!Trait methodsFor: '*Deprecated40' stamp: ''!
classPoolFrom: aClass
	"share the classPool with aClass."
	self deprecated: 'just use the accessor for classPool' on: '2 July 2014' in: 'Pharo40'.
	self classPool: aClass classPool.! !

!Trait methodsFor: 'class variables' stamp: ''!
classVariableDefinitionString
	"Answer a string that evaluates to the definition of the class Variables"
	
	^String streamContents: [ :str | | special |
		str nextPutAll: '{ '.
		self classVariables do: [:global |
				str nextPutAll: global definitionString.
				special := global isSpecial]				
			separatedBy: [ 
				str nextPutAll: '. '.  
				special ifTrue: [ str cr;tab;tab;tab;tab ]].
		str nextPutAll: ' }'. ]! !

!Trait methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterExamplesFor: aStep
	<spotterOrder: 50>
	aStep listProcessor
			title: 'Examples';
			allCandidates: [ self gtExamples ];
			itemName: [ :example | example title ];
			filter: GTFilterSubstring! !

!Trait methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/4/2013 14:46'!
baseTrait
	^ self! !

!Trait methodsFor: 'initialize-release' stamp: ''!
name: aString traitComposition: aComposition methodDict: aMethodDict localSelectors: aSet organization: aClassOrganization

	"Used by copy"
	
	self name: aString.
	self localSelectors: aSet.
	self methodDict: aMethodDict.
	self traitComposition: aComposition.
	self organization: aClassOrganization! !

!Trait methodsFor: 'viewer' stamp: ''!
externalName
	"Answer a name by which the receiver can be known."

	^ self name! !

!Trait methodsFor: 'initialization' stamp: 'al 7/17/2004 14:16'!
initialize
	super initialize.
	classTrait := ClassTrait for: self! !

!Trait methodsFor: 'class variables' stamp: ''!
classVariableNamed: aString
	"Answer the Class Variable"

	^self classPool associationAt: aString asSymbol ifAbsent: [self error: 'no such class var']! !

!Trait methodsFor: 'subclass creation - slots' stamp: ''!
subclass: aSubclassSymbol  layout: layoutClass slots: slotDefinition classVariables: classVarDefinition category: aCategorySymbol

	^ PharoClassInstaller make: [ :builder |
		builder name: aSubclassSymbol;
		superclass: self;
		layoutClass: layoutClass;
		slots: slotDefinition;
		sharedVariables: classVarDefinition;
		category: aCategorySymbol ].
! !

!Trait methodsFor: '*FuelTests' stamp: ''!
renameSilently: aName
	 [ self rename: aName] fuelValueWithoutNotifications! !

!Trait methodsFor: 'accessing' stamp: 'al 7/17/2004 14:16'!
environment: anObject
	environment := anObject! !

!Trait methodsFor: 'subclass creation' stamp: ''!
weakSubclass: aName uses: aTraitComposition instanceVariableNames: someInstanceVariableNames classVariableNames: someClassVariableNames poolDictionaries: someSharedPoolNames category: aCategory
	"Creates a new class as a subclass of an existing class (the receiver) 
	in which the subclass is to have weak indexable pointer variables."
	
	^ self
		subclass: aName
		uses: aTraitComposition
		with: [ 
			self
				weakSubclass: aName
				instanceVariableNames: someInstanceVariableNames
				classVariableNames: someClassVariableNames
				poolDictionaries: someSharedPoolNames
				category: aCategory ]! !

!Trait methodsFor: '*Polymorph-Widgets-Themes' stamp: 'YuriyTymchuk 12/20/2013 11:21'!
systemIcon 
	^ Smalltalk ui icons traitIcon! !

!Trait methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterPreviewCodeIn: aComposite
	<spotterPreview: 10>
	aComposite pharoMethod
		title: [self name];
		display: #definitionForNautilus;
		smalltalkClass: [ nil ];
		entity: self.
		
	self flag: 'move "entity: self" somewhere else, maybe'! !

!Trait methodsFor: '*Ring-Core-Kernel' stamp: ''!
asFullRingDefinition
	"A behavior is converted to a ring class including its variables, methods, direct superclass, direct subclasses and the package in which is loaded.
	Active methods are generated and each knows its package as well.
	Note that for its direct superclass and subclasses no full definitions are requested. If you need to traverse hierarchies use #asRingDefinitionWithMethods:withSuperclasses:withSubclasses:withPackages:"
	
	| rgClass rgSuper rgSub rgMethod packageKeys |
	rgClass:= self asRingDefinition.
	rgClass package: (RGContainer packageOfClass: rgClass).
	
	self superclass notNil 
		ifTrue: [ 
			rgSuper := self superclass asRingDefinition.
			rgClass superclass: rgSuper ]
		ifFalse: [  
			self isTrait ifTrue: [ 
				rgSuper := Trait asRingDefinition.
				rgClass superclass: rgSuper. ]
			].

	self subclasses do:[ :each |
		rgSub := each asRingDefinition.
		rgSub superclass: rgClass ].
	
	packageKeys := RGContainer packageKeys.
	self methodsDo:[ :mth|  
			rgMethod := mth asActiveRingDefinition.
			rgClass addMethod: rgMethod.
			rgMethod package: (RGContainer packageOfMethod: rgMethod using: packageKeys) ].
	self theMetaClass methodsDo:[ :mth|  
			rgMethod := mth asActiveRingDefinition.
			rgClass theMetaClass addMethod: rgMethod.
			rgMethod package: (RGContainer packageOfMethod: rgMethod using: packageKeys) ].
	
	^ rgClass! !

!Trait methodsFor: 'initialize-release' stamp: ''!
superclass: aClass methodDictionary: mDict format: fmt
	"Basic initialization of the receiver"
	super superclass: aClass methodDictionary: mDict format: fmt.
	self subclasses: nil. ! !

!Trait methodsFor: 'accessing' stamp: 'al 3/18/2006 13:23'!
basicCategory
	^category! !

!Trait methodsFor: 'subclass creation' stamp: ''!
subclass: t uses: aTraitComposition 
	| cls |
	cls := self
				subclass: t
				instanceVariableNames: ''
				classVariableNames: ''
				poolDictionaries: ''
				category: 'Unclassified'.
	cls setTraitComposition: aTraitComposition asTraitComposition.
	^ cls! !

!Trait methodsFor: 'class variables' stamp: ''!
readClassVariableNamed: aString
	"Answer the content of the Class Variable"

	^(self classVariableNamed: aString) read! !

!Trait methodsFor: 'initialize-release' stamp: ''!
removeFromSystemUnlogged
	"Forget the receiver from the Smalltalk global dictionary. Any existing instances will refer to an obsolete version of the receiver.  Do not log the removal either to the current change set nor to the system changes log"
	^self removeFromSystem: false! !

!Trait methodsFor: 'subclass creation' stamp: ''!
variableByteSubclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s category: cat
	"This is the standard initialization message for creating a new class as a 
	subclass of an existing class (the receiver) in which the subclass is to 
	have indexable byte-sized nonpointer variables."
	^self classBuilder
		superclass: self
		variableByteSubclass: t
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: cat! !

!Trait methodsFor: 'initialize-release' stamp: ''!
superclass: sup methodDict: md format: ft name: nm organization: org instVarNames: nilOrArray classPool: pool sharedPools: poolSet 
	"Answer an instance of me, a new class, using the arguments of the 
	message as the needed information.
	Must only be sent to a new instance; else we would need Object flushCache."

	self superclass: sup.
	self methodDict: md.
	self setFormat: ft.
	self setName: nm.
	self instanceVariables: nilOrArray.
	self classPool: pool.
	self sharedPools: poolSet.
	self organization: org.! !

!Trait methodsFor: 'accessing parallel hierarchy' stamp: 'al 7/17/2004 14:16'!
classTrait
	^classTrait! !

!Trait methodsFor: '*Monticello' stamp: 'al 3/26/2006 21:44'!
asClassDefinition
	^ MCTraitDefinition
		name: self name
		traitComposition: self traitCompositionString
		category: self category 
		comment: self organization classComment asString
		commentStamp: self organization commentStamp.! !

!Trait methodsFor: 'class variables' stamp: ''!
writeClassVariableNamed: aString value: anObject
	"Store anObject in the class variable."
	
	(self classVariableNamed: aString) write: anObject! !

!Trait methodsFor: 'subclass creation - slots' stamp: ''!
subclass: aSubclassSymbol  layout: layoutClass  slots: slotDefinition classVariables: classVarDefinition poolDictionaries: someSharedPoolNames category: aCategorySymbol

	^ PharoClassInstaller make: [ :builder |
		builder name: aSubclassSymbol;
		superclass: self;
		layoutClass: layoutClass;
		slots: slotDefinition;
		sharedVariables:  classVarDefinition;
		sharedPools: someSharedPoolNames;
		category: aCategorySymbol ].
! !

!Trait methodsFor: 'accessing' stamp: 'al 7/17/2004 14:16'!
name: aSymbol
	name := aSymbol! !

!Trait methodsFor: 'subclass creation' stamp: 'SebastianTleye 7/12/2013 14:19'!
subclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat 
	"Compatibility purposes"
	^self error: 'Traits cannot have subclasses'.! !

!Trait methodsFor: 'class variables' stamp: ''!
hasClassVariable: aGlobal
	"Return whether the receiver has a class variables (shared variables among its class and subclasses) named: aString"
	
	^ self classVariables identityIncludes: aGlobal! !

!Trait methodsFor: 'subclass creation - slots' stamp: ''!
subclass: aSubclassSymbol uses: aTraitCompositionOrArray  layout: layoutClass slots: slotDefinition classVariables: classVarDefinition poolDictionaries: someSharedPoolNames category: aCategorySymbol
	^ self
		subclass: aSubclassSymbol
		uses: aTraitCompositionOrArray
		with: [ 
			PharoClassInstaller
				make: [ :builder | 
					builder
						name: aSubclassSymbol;
						superclass: self;
						layoutClass: layoutClass;
						slots: slotDefinition;
						sharedVariables: classVarDefinition;
						sharedPools: someSharedPoolNames;
						category: aCategorySymbol ] ]! !

!Trait methodsFor: '*Slot' stamp: ''!
removeSlot: aSlot 

	(self layout slots includes: aSlot)
		ifFalse: [self error: aSlot name , ' is not one of my slots'].
		
	^PharoClassInstaller make: [ :builder |
		builder
			superclass:  self superclass;
			name:  self name;
			layoutClass: (OldClassBuilderAdapter new layoutForType: self typeOfClass);
			slots: (self layout slots copyWithout: aSlot);
			sharedVariablesFromString: self classVariablesString;
			sharedPools: self sharedPoolsString;
			category: self category;
			environment: self environment;
			copyTraitCompositionFromExistingClass;
			copyClassSlotsFromExistingClass]
	! !

!Trait methodsFor: 'pool variables' stamp: 'SebastianTleye 7/12/2013 15:40'!
sharedPools
	"Answer an ordered collection of  the shared pools that the receiver shares"

	^ OrderedCollection new! !

!Trait methodsFor: 'organization' stamp: ''!
category: aString 
	"Categorize the receiver under the system category, aString, removing it from 
	any previous categorization."

	| oldCategory |
	oldCategory := self basicCategory.
	aString isString
		ifTrue: [
			self basicCategory: aString asSymbol.
			self environment organization classify: self name under: self basicCategory ]
		ifFalse: [self errorCategoryName].
	SystemAnnouncer uniqueInstance
		class: self recategorizedFrom: oldCategory to: self basicCategory! !

!Trait methodsFor: 'testing' stamp: ''!
isAnonymous
	^self getName isNil! !

!Trait methodsFor: 'pool variables' stamp: ''!
removeSharedPool: aDictionary 
	"Remove the pool dictionary, aDictionary, as one of the receiver's pool 
	dictionaries. Create an error notification if the dictionary is not one of 
	the pools.
	: Note that it removes the wrong one if there are two empty Dictionaries in the list."

	| satisfiedSet workingSet aSubclass |
	(self sharedPools includes: aDictionary)
		ifFalse: [^self error: 'the dictionary is not in my pool'].

	"first see if it is declared in a superclass in which case we can remove it."
	(self selectSuperclasses: [:class | class sharedPools includes: aDictionary]) isEmpty
		ifFalse: [self sharedPools remove: aDictionary.
				self sharedPools isEmpty ifTrue: [self sharedPools: nil].
				^self]. 

	"second get all the subclasses that reference aDictionary through me rather than a 
	superclass that is one of my subclasses."

	workingSet := self subclasses asOrderedCollection.
	satisfiedSet := Set new.
	[workingSet isEmpty] whileFalse:
		[aSubclass := workingSet removeFirst.
		(aSubclass sharedPools includes: aDictionary)
			ifFalse: 
				[satisfiedSet add: aSubclass.
				workingSet addAll: aSubclass subclasses]].

	"for each of these, see if they refer to any of the variables in aDictionary because 
	if they do, we can not remove the dictionary."
	satisfiedSet add: self.
	satisfiedSet do: 
		[:sub | 
		aDictionary associationsDo: 
			[:aGlobal | 
			(sub whichSelectorsReferTo: aGlobal) isEmpty 
				ifFalse: [^self error: aGlobal key 
								, ' is still used in code of class '
								, sub name]]].
	self sharedPools remove: aDictionary.
	self sharedPools isEmpty ifTrue: [self sharedPools: nil]! !

!Trait methodsFor: 'class variables' stamp: ''!
usesClassVarNamed: aString
	"Return whether the receiver or its superclasses have a class variable named: aString"
	
	^ self allClassVarNames includes: aString! !

!Trait methodsFor: 'subclass creation - slots' stamp: ''!
subclass: aSubclassSymbol uses: aTraitCompositionOrArray slots: slotDefinition classVariables: classVarDefinition poolDictionaries: someSharedPoolNames category: aCategorySymbol
	^ self
		subclass: aSubclassSymbol
		uses: aTraitCompositionOrArray
		with: [ 
			PharoClassInstaller
				make: [ :builder | 
					builder
						name: aSubclassSymbol;
						superclass: self;
						slots: slotDefinition;
						sharedVariables: classVarDefinition;
						sharedPools: someSharedPoolNames;
						category: aCategorySymbol ] ]! !

!Trait methodsFor: 'class name' stamp: ''!
rename: aString 
	"The new name of the receiver is the argument, aString."

	| oldName newName |
	(newName := aString asSymbol) = (oldName := self name)
		ifTrue: [^ self].
	(self environment includesKey: newName)
		ifTrue: [^ self error: newName , ' already exists'].
	self setName: newName.
	self environment renameClass: self from: oldName.
	(Undeclared includesKey: newName)
		ifTrue: [self inform: 'There are references to, ' , aString printString , '
from Undeclared. Check them after this change.'].! !

!Trait methodsFor: 'compiling' stamp: ''!
compileAllFrom: oldClass
	"Recompile all the methods in the receiver's method dictionary (not the
	subclasses). Also recompile the methods in the metaclass."

	super compileAllFrom: oldClass.
	self class compileAllFrom: oldClass class! !

!Trait methodsFor: 'fileIn/Out' stamp: ''!
shouldFileOutPool: aPoolName
	"respond with true if the user wants to file out aPoolName"
	^self confirm: ('FileOut the sharedPool ', aPoolName, '?')! !

!Trait methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterReferenceFor: aStep
	<spotterOrder: 30>
	aStep listProcessor
			title: 'References';
			allCandidates: [ (SystemNavigation default allReferencesTo: self binding) collect: #compiledMethod ];
			itemName: [ :method | method gtDisplayString ];
			filter: GTFilterSubstring! !

!Trait methodsFor: 'traits' stamp: ''!
applyChangesOfNewTraitCompositionReplacing: oldComposition

	| changedSelectors |
	changedSelectors := super applyChangesOfNewTraitCompositionReplacing: oldComposition.
	self classSide noteNewBaseTraitCompositionApplied: self traitComposition.
	^ changedSelectors! !

!Trait methodsFor: 'testing' stamp: ''!
hasMethods
	"Answer a Boolean according to whether any methods are defined for the 
	receiver (includes whether there are methods defined in the receiver's 
	metaclass)."

	^super hasMethods or: [self class hasMethods]! !

!Trait methodsFor: 'subclass creation' stamp: ''!
classBuilder
		"Answer the object responsible of creating subclasses of myself in the system."
	
		^ Smalltalk classBuilder! !

!Trait methodsFor: 'pool variables' stamp: 'SebastianTleye 7/12/2013 15:00'!
sharedPools: aCollection
	"Compatibilty purposes"! !

!Trait methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterActDefault
	^ self browse! !

!Trait methodsFor: '*Ring-Core-Kernel' stamp: ''!
asRingDefinitionWithMethods: methodsBoolean withSuperclasses: supersBoolean withSubclasses: subsBoolean withPackages: packsBoolean
	"Retrieves a ring class/trait based on the receiver.
	The data loaded in the class/trait (active methods, superclasses, subclasses and packages) is requested by the users.
	As it may need to traverse hierarchies for retrieving super and subclasses a ring slice is created as the container for every class, method and package.
	To retrieve the slice:  aRGClass environment "
	| rgClass rgSlice  rgPackageKeys |
	
	rgSlice := RGSlice named: #fromImage.
	packsBoolean ifTrue: [ 
		rgPackageKeys := rgSlice loadPackagesFromImage ].
	rgClass := self asRingDefinitionWithMethods: methodsBoolean withSuperclasses: supersBoolean withSubclasses: subsBoolean withPackageKeys: rgPackageKeys in: rgSlice.
	rgSlice cleanEmptyPackages.
	rgSlice loadTraitUsers.
		
	^ rgClass! !

!Trait methodsFor: 'compiling' stamp: ''!
compileAll
	super compileAll.
	self classSide compileAll.! !

!Trait methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterSuperClassMethodsFor: aStep
	<spotterOrder: 16>
	|superclasses|
	superclasses := self class withAllSuperclasses select: #isMeta.
	aStep listProcessor
			title: 'Super class methods';
			allCandidates: [ self classSide allMethods select: [ :each |(each methodClass = self classSide) not & (superclasses includes: each methodClass) ] ];
			filter: GTFilterSubstring! !

!Trait methodsFor: 'subclass creation' stamp: ''!
variableSubclass: className instanceVariableNames: instVarNames classVariableNames: classVarNames category: cat
	"Added to allow for a simplified subclass creation experience. "

	^ self variableSubclass: className
		instanceVariableNames: instVarNames 
		classVariableNames: classVarNames 
		poolDictionaries: ''
		category: cat
! !

!Trait methodsFor: 'private' stamp: ''!
setName: aSymbol andRegisterInCategory: categorySymbol environment: aSystemDictionary
	(self isValidTraitName: aSymbol) ifFalse: [TraitException signal: 'Invalid trait name'].
	
	(self environment == aSystemDictionary
		and: [self name = aSymbol
			and: [self category = categorySymbol]]) ifTrue: [^self].
		
	((aSystemDictionary includes: aSymbol) and: [(aSystemDictionary at: aSymbol) ~~ self])
		ifTrue: [TraitException signal: 'The name ''' , aSymbol , ''' is already used'].

	(self environment notNil and: [self name notNil and: [self name ~= aSymbol]]) ifTrue: [
		self environment renameClass: self as: aSymbol].
	
	self name: aSymbol.
	self environment: aSystemDictionary.	
	self environment at: self name put: self.
	self environment organization classify: self name under: categorySymbol.
	^ true! !

!Trait methodsFor: 'accessing class hierarchy' stamp: ''!
subclassesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the receiver's immediate subclasses."
	self subclasses size == 0 
		ifFalse:[self subclasses do: aBlock]! !

!Trait methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterMethodsFor: aStep
	<spotterOrder: 10>
	aStep listProcessor
			title: 'Instance methods';
			allCandidates: [ self methods ];
			itemName: [ :method | method selector ];
			filter: GTFilterSubstring! !

!Trait methodsFor: 'class variables' stamp: ''!
definesClassVariableNamed: aString
	"Return whether the receiver has a class variables (shared variables among its class and subclasses) named: aString"
	
	^ self classVarNames includes: aString! !

!Trait methodsFor: 'subclass creation' stamp: ''!
variableWordSubclass: aName uses: aTraitComposition instanceVariableNames: someInstanceVariableNames classVariableNames: someClassVariableNames poolDictionaries: someSharedPoolNames category: aCategory
	"Creates a new class as a subclass of an existing class (the receiver) 
	in which the subclass is to have indexable word-sized nonpointer variables."
	
	^ self
		subclass: aName
		uses: aTraitComposition
		with: [ 
			self
				variableWordSubclass: aName
				instanceVariableNames: someInstanceVariableNames
				classVariableNames: someClassVariableNames
				poolDictionaries: someSharedPoolNames
				category: aCategory ]! !

!Trait methodsFor: 'fileIn/Out' stamp: 'SebastianTleye 7/12/2013 16:19'!
fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex initializing: aBool
	"File a description of the receiver on aFileStream. If the boolean argument,
	moveSource, is true, then set the trailing bytes to the position of aFileStream and
	to fileIndex in order to indicate where to find the source code."

	self crTrace: name.
	super
		fileOutOn: aFileStream
		moveSource: moveSource
		toFile: fileIndex.
	self hasClassSide ifTrue: [
		aFileStream cr; nextPutAll: '"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!'; cr; cr.
		self classTrait
			fileOutOn: aFileStream
			moveSource: moveSource
			toFile: fileIndex]! !

!Trait methodsFor: 'compiling' stamp: ''!
possibleVariablesFor: misspelled continuedFrom: oldResults

	| results |
	results := misspelled correctAgainstDictionary: self classPool continuedFrom: oldResults.
	self sharedPools do: [:pool | 
		results := misspelled correctAgainstDictionary: pool continuedFrom: results ].
	self superclass == nil
		ifTrue: 
			[ ^ misspelled correctAgainstDictionary: self environment continuedFrom: results ]
		ifFalse:
			[ ^ self superclass possibleVariablesFor: misspelled continuedFrom: results ]! !

!Trait methodsFor: 'private' stamp: ''!
setName: aSymbol
	self name: aSymbol.! !

!Trait methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/4/2013 14:46'!
isClassTrait
	^false! !

!Trait methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/4/2013 14:46'!
isBaseTrait
	^true! !

!Trait methodsFor: 'pool variables' stamp: ''!
allSharedPools
	"Answer an ordered collection of the pools the receiver shares, including those defined  in the superclasses of the receiver."
	| aSet | 
	^self superclass == nil
		ifTrue: [self sharedPools copy]
		ifFalse: [aSet := self superclass allSharedPools.
			aSet addAll: self sharedPools.
			aSet]! !

!Trait methodsFor: 'subclass creation' stamp: ''!
variableSubclass: aClassName uses: aTraitCompositionOrArray instanceVariableNames: instVarNames 
	classVariableNames: classVarNames category: cat
	"Added to allow for a simplified subclass creation experience. "
	
	^ self variableSubclass: aClassName 
		uses: aTraitCompositionOrArray
		instanceVariableNames: instVarNames  
		classVariableNames: classVarNames 
		poolDictionaries: ''
		category: cat! !

!Trait methodsFor: 'initialize-release' stamp: ''!
replaceClassVariable: newVar 
	"replace an exisiting class var with the same name. used to wrap class vars for MetaLinks"
	
	(self classPool includesKey: newVar key) ifFalse: [ ^self ].
	self classPool removeKey: newVar key.
	self classPool add: newVar.! !

!Trait methodsFor: 'subclass creation' stamp: ''!
newSubclass
	| i className |
	i := 1.
	[className := (self name , i printString) asSymbol.
	 self environment includesKey: className]
		whileTrue: [i := i + 1].

	^ self subclass: className
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: 'Unclassified'

"Point newSubclass new"! !

!Trait methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/12/2013 14:35'!
subclasses
	"for compatibility with classes"
	
	^ #()! !

!Trait methodsFor: '*GT-InspectorExtensions-Core' stamp: ''!
gtInspectorAllReferencesIn: composite
	"This provides a list of all methods provided by the current class"
	<gtInspectorPresentationOrder: 20>
	composite list 
		title: 'All Ref';
		display: [ (SystemNavigation default allReferencesTo: self binding) 
						sorted: [ :x :y | x name < y name ] ];
		format: #name;
		tags: [ :each | { each package name } ]! !

!Trait methodsFor: 'copying' stamp: ''!
duplicateClassWithNewName: aSymbol
	| copysName class newDefinition |
	copysName := aSymbol asSymbol.
	copysName = self name
		ifTrue: [ ^ self ].
	(Smalltalk globals includesKey: copysName)
		ifTrue: [ ^ self error: copysName , ' already exists' ].
	newDefinition := self definition copyReplaceAll: '#' , self name asString with: '#' , copysName asString.
	class := self class compiler source: newDefinition; logged: true; evaluate.
	class classSide instanceVariableNames: self classSide instanceVariablesString.
	class copyAllCategoriesFrom: self.
	class class copyAllCategoriesFrom: self class.
	^ class! !

!Trait methodsFor: '*GT-InspectorExtensions-Core' stamp: ''!
gtInspectorMethodsIn: composite
	"This provides a list of all methods provided by the current class"
	<gtInspectorPresentationOrder: 20>
	composite list 
		title: 'Methods';
		display: [ (self allMethods collect: #asRingDefinition) 
						sorted: [ :x :y | x selector < y selector ] ];
		format: #selector;
		tags: [ :each | {each methodClass name} ]! !

!Trait methodsFor: 'subclass creation' stamp: ''!
variableSubclass: aName uses: aTraitComposition instanceVariableNames: someInstanceVariableNames classVariableNames: someClassVariableNames poolDictionaries: someSharedPoolNames category: aCategory
	"Creates a new class as a subclass of an existing class (the receiver) 
	in which the subclass is to have indexable pointer variables."
	
	^ self
		subclass: aName
		uses: aTraitComposition
		with: [ 
			self
				variableSubclass: aName
				instanceVariableNames: someInstanceVariableNames
				classVariableNames: someClassVariableNames
				poolDictionaries: someSharedPoolNames
				category: aCategory ]! !

!Trait methodsFor: 'subclass creation' stamp: ''!
subclass: aSubclassSymbol instanceVariableNames: instVarNames classVariableNames: classVarNames category: aCategorySymbol
	"Added to allow for a simplified subclass creation experience. "
	^ self
		subclass: aSubclassSymbol
		instanceVariableNames: instVarNames
		classVariableNames: classVarNames
		poolDictionaries: ''
		category: aCategorySymbol! !

!Trait methodsFor: 'pool variables' stamp: ''!
usesLocalPoolVarNamed: aString
	"Return whether the receiver uses a pool variable named: aString which is defined locally"
	
	self hasSharedPools
		ifTrue: [ self sharedPools do: [:each | (each usesClassVarNamed: aString) 
												ifTrue: [ ^true ]]]
		ifFalse: [ ^false ].
	^false! !

!Trait methodsFor: 'private' stamp: ''!
getName
	^ self name! !

!Trait methodsFor: 'class variables' stamp: ''!
hasClassVarNamed: aString
	"Return whether the receiver has a class variables (shared variables among its class and subclasses) named: aString"
	
	^ self classVarNames includes: aString! !

!Trait methodsFor: 'subclass creation' stamp: ''!
weakSubclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s category: cat
	"This is the standard initialization message for creating a new class as a subclass of an existing class (the receiver) in which the subclass is to have weak indexable pointer variables."
	^self classBuilder
		superclass: self
		weakSubclass: t
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: cat! !

!Trait methodsFor: 'class variables' stamp: ''!
removeClassVarNamed: aString
	"Remove the class variable whose name is the argument, aString, from 
    the names defined in the receiver, a class. Create an error notification if 
    aString is not a class variable or if it is still being used in the code of 
    the class."

	| aSymbol |
	aSymbol := aString asSymbol.
	(self classPool includesKey: aSymbol)
		ifFalse: [ ^ self error: aString , ' is not a class variable' ].
	self withAllSubclasses
		do: [ :subclass | 
			(Array with: subclass with: subclass class)
				do: [ :classOrMeta | 
					(classOrMeta whichSelectorsReferTo: (self classPool associationAt: aSymbol)) isEmpty
						ifFalse: [ 
							InMidstOfFileinNotification signal
								ifTrue: [ 
									self crTrace: self name , ' (' , aString , ' is Undeclared) '.
									^ Undeclared declare: aSymbol from: self classPool ]
								ifFalse: [ 
									(self
										confirm:
											(aString , ' is still used in code of class ' , classOrMeta name , '.\Is it okay to move it to Undeclared?') withCRs)
										ifTrue: [ ^ Undeclared declare: aSymbol from: self classPool ]
										ifFalse: [ ^ self ] ] ] ] ].
	self classPool removeKey: aSymbol.
	self classPool isEmpty
		ifTrue: [ self classPool: nil ]! !

!Trait methodsFor: 'class variables' stamp: ''!
addClassVarNamed: aString 
	"Add the argument, aString, as a class variable of the receiver.
	Signal an error if the first character of aString is not capitalized,
	or if it is already a variable named in the class."
	
	self addClassVariable: (aString asSymbol => ClassVariable)! !

!Trait methodsFor: 'class variables' stamp: ''!
allClassVarNames
	"Answer a Set of the names of the receiver's class variables, including those
	defined in the superclasses of the receiver."

	| aSet |
	self superclass == nil
		ifTrue: 
			[^self classVarNames asSet]  "This is the keys so it is a new Set."
		ifFalse: 
			[aSet := self superclass allClassVarNames.
			aSet addAll: self classVarNames.
			^aSet]! !

!Trait methodsFor: '*Manifest-Core' stamp: ''!
criticTheNonMetaclassClass

	"Return the class of the receiver for the critic browser. This behavior may be folded later by changing the name of this method or using another one."
	
	^ self ! !

!Trait methodsFor: 'compiling' stamp: ''!
bindingOf: varName
	"Answer the binding of some variable resolved in the scope of the receiver, or nil
	if variable with such name is not defined"

	"The lookup recurses up to superclasses looking inside their class and shared pools,
	but not the environment, since two classes, even if they have ancestry relationship,
	could use different environments.
	That's why we doing an environment lookup only as a last step of symbol lookup 
	and taking only the environment of receiver only, not any of it's superclass(es) "
	
	| aSymbol |
	aSymbol := varName asSymbol.

	^ (self innerBindingOf: aSymbol) ifNil: [
		 self environment bindingOf: aSymbol
	]! !

!Trait methodsFor: 'subclass creation' stamp: ''!
variableWordSubclass: className instanceVariableNames: instVarNames
	classVariableNames: classVarNames category: cat
	"Added to allow for a simplified subclass creation experience. "
	 
	^ self variableWordSubclass: className
		instanceVariableNames: instVarNames  
		classVariableNames: classVarNames 
		poolDictionaries: ''
		category: cat! !

!Trait methodsFor: 'class variables' stamp: ''!
addClassVariable: aGlobal
	"Add the argument, aString, as a class variable of the receiver.
	Signal an error if the first character of aString is not capitalized,
	or if it is already a variable named in the class."
	| symbol oldState |
	oldState := self copy.
	symbol := aGlobal name asSymbol.
	self withAllSubclasses do: 
		[:subclass | 
		(subclass bindingOf: symbol) ifNotNil:[
			^ self error: symbol asString 
				, ' is already used as a variable name in class ' 
				, subclass name]].
	(self classPool includesKey: symbol) ifFalse: 
		["Pick up any refs in Undeclared"
		self classPool declareVariable: aGlobal from: Undeclared.
		SystemAnnouncer uniqueInstance classDefinitionChangedFrom: oldState to: self]! !

!Trait methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterClassMethodsFor: aStep
	<spotterOrder: 15>
	aStep listProcessor
			title: 'Class methods';
			allCandidates: [ self classSide methods ];
			itemName: [ :method | method selector ];
			filter: GTFilterSubstring! !

!Trait methodsFor: 'subclass creation - slots' stamp: ''!
subclass: aSubclassSymbol slots: slotDefinition classVariables: classVarDefinition poolDictionaries: someSharedPoolNames category: aCategorySymbol

	^ PharoClassInstaller make: [ :builder |
		builder name: aSubclassSymbol;
		superclass: self;
		slots: slotDefinition;
		sharedVariables:  classVarDefinition;
		sharedPools: someSharedPoolNames;
		category: aCategorySymbol ].
! !

!Trait methodsFor: 'class variables' stamp: ''!
removeClassVariable: aGlobal
	"Remove the class variable"
	self removeClassVarNamed: aGlobal name

	! !

!Trait methodsFor: 'accessing class hierarchy' stamp: 'CamilleTeruel 4/14/2014 14:41'!
addSubclass: aSubclass 
	self shouldNotImplement! !

!Trait methodsFor: 'initialize-release' stamp: ''!
obsolete
	"Change the receiver and all of its subclasses to an obsolete class."
	self == Object 
		ifTrue: [^self error: 'Object is NOT obsolete'].
	self setName: 'AnObsolete' , self name.
	Object class instSize + 1 to: self classSide instSize do:
		[:i | self instVarAt: i put: nil]. "Store nil over class instVars."
	self classPool: nil.
	self sharedPools: nil.
	self hasClassSide ifTrue: [ self theMetaClass obsolete].
	self propertyValueAt: #obsolete put: true.
	super obsolete.! !

!Trait methodsFor: 'organization' stamp: ''!
category
	"Answer the system organization category for the receiver. First check whether the
	category name stored in the ivar is still correct and only if this fails look it up
	(latter is much more expensive)"

	| result |
	self basicCategory ifNotNil: [ :symbol |
		((self environment organization listAtCategoryNamed: symbol) includes: self name)
			ifTrue: [ ^symbol ] ].
	result := (self environment organization categoryOfElement: self name)
		ifNil: [ #Unclassified ]
		ifNotNil: #yourself.
	self basicCategory: result.
	
	^ result! !

!Trait methodsFor: '*OpalCompiler-Core' stamp: ''!
classSideCompiler
	"Redefine this method if you want to customize the compiler for class-side methods"
	^self classSideCompilerClass new
		environment: self classSide environment;
		class: self classSide! !

!Trait methodsFor: 'private' stamp: ''!
isValidTraitName: aSymbol
	^(aSymbol isEmptyOrNil
		or: [aSymbol first isLetter not
		or: [aSymbol anySatisfy: [:character | character isAlphaNumeric not]]]) not! !

!Trait methodsFor: 'initialize-release' stamp: ''!
removeFromSystem
	"Forget the receiver from the Smalltalk global dictionary. Any existing 
	instances will refer to an obsolete version of the receiver."
	self removeFromSystem: true.! !

!Trait methodsFor: 'initialize-release' stamp: ''!
sharing: poolString 
	"Set up sharedPools. Answer whether recompilation is advisable."
	| oldPools |
	oldPools := self sharedPools.
	self sharedPools: OrderedCollection new.
	(poolString substrings: ' ') do: 
		[:poolName | 
		self sharedPools add: (self environment at: poolName asSymbol ifAbsent:[
			(self confirm: 'The pool dictionary ', poolName,' does not exist.',
						'\Do you want it automatically created?' withCRs)
				ifTrue: [ PharoClassInstaller make: [ :builder | 
							builder superclass: SharedPool;
							name: poolName;
							category: self category ]]
				ifFalse:[^self error: poolName,' does not exist']])].
	self sharedPools isEmpty ifTrue: [self sharedPools: nil].
	oldPools do: [:pool |
				| found |
				found := self sharedPools anySatisfy: [:p | p == pool].
				found ifFalse: [^ true "A pool got deleted"]].
	^ false! !

!Trait methodsFor: '*HelpSystem-Core' stamp: ''!
asHelpTopic
	^SystemReference forClass: self! !

!Trait methodsFor: 'compiling' stamp: ''!
innerBindingOf: aSymbol
	"Answer the binding of some variable resolved in the scope of the receiver, or one of its superclass
	but do not look up binding in receiver's environment.
	Use #bindingOf: for looking up the variable binding in a full scope, including receiver's environment"

	"First look in classVar dictionary."
	(self classPool bindingOf: aSymbol) ifNotNil: [:binding | ^binding].
	"Next look in shared pools."
	self sharedPools do: [:pool | (pool bindingOf: aSymbol) ifNotNil: [:binding | ^binding]].
	self superclass ifNotNil: [:supercl | ^ supercl innerBindingOf: aSymbol].	
	^ nil! !

!Trait methodsFor: 'subclass creation' stamp: ''!
weakSubclass: className uses: aTraitCompositionOrArray instanceVariableNames: instVarNames 
	classVariableNames: classVarNames category: cat
	"Added to allow for a simplified subclass creation experience. "
	
	^ self weakSubclass: className
		uses: aTraitCompositionOrArray
		instanceVariableNames: instVarNames 
		classVariableNames: classVarNames 
		poolDictionaries: ''
		category: cat
! !

!Trait methodsFor: 'initialize-release' stamp: ''!
removeFromSystem: logged
	"Forget the receiver from the Smalltalk global dictionary. Any existing 
	instances will refer to an obsolete version of the receiver."
	
	"keep the class name and category for triggering the system change message. If we wait to long, then we get obsolete information which is not what we want."

	"tell class to deactivate and unload itself-- two separate events in the module system"
	self unload.
	self traitUsers do: [ :user | user removeFromComposition: self ].
	self superclass ifNotNil:
		["If we have no superclass there's nothing to be remembered"
		self superclass addObsoleteSubclass: self].
	self environment forgetClass: self logged: logged.
	self obsolete.! !

!Trait methodsFor: 'compiling' stamp: ''!
binding
       "Answer a binding for the receiver, sharing if possible"
      | binding |
	binding := self environment associationAt: self name ifAbsent: [nil -> self].
       ^binding value == self ifTrue: [binding] ifFalse: [nil -> self]! !

!Trait methodsFor: 'subclass creation' stamp: ''!
subclass: t
	^ self subclass: t instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Unclassified' ! !

!Trait methodsFor: 'pool variables' stamp: ''!
usesPoolVarNamed: aString
	"Return whether the receiver has a pool variable named: aString, taking into account superclasses too"
	
	self allSharedPools do: [:each | (each usesClassVarNamed: aString) ifTrue: [^true]].
	^false! !

!Trait methodsFor: '*Ring-Core-Kernel' stamp: 'MarcusDenker 7/30/2014 21:40'!
asRingDefinition
	"A triat is converted to a ring class. Only the receiver is converted.
	Methods, superclasses, subclasses are not generated"

	| ring |
	ring:= (RGTraitDefinition named: self name)
		category: self category;
		superclassName: #Trait;  
		traitCompositionSource: self traitCompositionString;
		comment: self organization classComment;
		stamp: self organization commentStamp;
		definitionSource: self definition;
		withMetaclass.
		
	ring theMetaClass 
		traitCompositionSource: self theMetaClass traitCompositionString;
		definitionSource: self theMetaClass definition.
	^ring! !

!Trait methodsFor: 'testing' stamp: ''!
hasAbstractMethods
	"Tells whether the receiver locally defines an abstract method, i.e., a method sending subclassResponsibility"
	^ super hasAbstractMethods or: [self class hasAbstractMethods]
! !

!Trait methodsFor: 'subclass creation - private' stamp: ''!
subclass: aName uses: aTraitComposition with: aBlock 
	"Define (or redefine) a subclass by evaluating a block closure. 

	Note (MartinDias): 
		This is a workaround for the subclass creation API when a trait is specified. 
		To fix it well, in Pharo 4, a bit deeper refactoring is required, delegating this responsibility
		to SlotClassBuilder."

	^ self environment 
		at: aName
		ifPresent: [ :old | 
			| copyOfOld newClass |
			copyOfOld := old copy.

			"Modify the class and set the new trait composition"
			newClass := aBlock value. 
			newClass setTraitComposition: aTraitComposition asTraitComposition.

			"Announce that the definition changed when there is a new trait composution. 
			Note: It may be a re-announce if there was other change in the class definition, 
			e.g. an instace variable added."
			(newClass traitComposition syntacticallyEquals: copyOfOld traitComposition) ifFalse: [ 
				SystemAnnouncer uniqueInstance 
					classDefinitionChangedFrom: copyOfOld 
					to: newClass ].

			newClass ]
		ifAbsent: [
			"Create the class and set the trait composition"
			aBlock value
				setTraitComposition: aTraitComposition asTraitComposition;
				yourself ].! !

!Trait methodsFor: 'accessing' stamp: 'al 7/17/2004 14:16'!
name
	^name! !

!Trait methodsFor: 'accessing' stamp: 'SebastianTleye 7/12/2013 14:34'!
classPool: aDictionary
	"Compatibility purposes"! !

!Trait methodsFor: 'class variables' stamp: ''!
classVariables
	"Answer the meta objects of all class variables"

	^self classPool associations! !

!Trait methodsFor: 'fileIn/Out' stamp: ''!
fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex 
	"File a description of the receiver on aFileStream. If the boolean argument,
	moveSource, is true, then set the trailing bytes to the position of aFileStream and
	to fileIndex in order to indicate where to find the source code."
	^self fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex initializing: true! !

!Trait methodsFor: 'instance variables' stamp: ''!
removeInstVarNamed: aString 
	"Remove the argument, aString, as one of the receiver's instance variables."

	| newInstVarString |
	(self instVarNames includes: aString)
		ifFalse: [self error: aString , ' is not one of my instance variables'].
	newInstVarString := ''.
	(self instVarNames copyWithout: aString) do: 
		[:varName | newInstVarString := newInstVarString , ' ' , varName].
	^self classBuilder
		name: self name
		inEnvironment: self environment
		subclassOf: self superclass
		type: self typeOfClass
		instanceVariableNames: newInstVarString
		classVariableNames: self classVariablesString
		poolDictionaries: self sharedPoolsString
		category: self category! !

!Trait methodsFor: 'accessing class hierarchy' stamp: ''!
removeSubclass: aSubclass 
	"If the argument, aSubclass, is one of the receiver's subclasses, remove it."

	self subclasses == nil ifFalse:
		[self subclasses:  (self subclasses copyWithout: aSubclass).
		self subclasses isEmpty ifTrue: [self subclasses: nil]].! !

!Trait methodsFor: 'pool variables' stamp: ''!
sharedPoolOfVarNamed: aString
	"Returns the SharedPool or nil from which the pool variable named aString is coming from."
	
	 ^ self sharedPools 
			detect: [:each | each usesClassVarNamed: aString ]
			ifNone: [
						self superclass == nil
							ifTrue: [nil]
							ifFalse: [self superclass sharedPoolOfVarNamed: aString]
						]! !

!Trait methodsFor: 'fileIn/Out' stamp: ''!
fileOutPool: aPool onFileStream: aFileStream 
	| aPoolName |
	(aPool  isKindOf: SharedPool class) ifTrue:[^self notify: 'we do not fileout SharedPool type shared pools for now'].
	aPoolName := self environment keyAtIdentityValue: aPool.
	self crTrace: aPoolName.
	aFileStream nextPutAll: 'Transcript show: ''' , aPoolName , '''; cr!!'; cr.
	aFileStream nextPutAll: 'Smalltalk at: #' , aPoolName , ' put: Dictionary new!!'; cr.
	aPool keys asSortedCollection do: [ :aKey | | aValue |
		aValue := aPool at: aKey.
		aFileStream nextPutAll: aPoolName , ' at: #''' , aKey asString , '''', ' put:  '.
		(aValue isKindOf: Number)
			ifTrue: [aValue printOn: aFileStream]
			ifFalse: [aFileStream nextPutAll: '('.
					aValue printOn: aFileStream.
					aFileStream nextPutAll: ')'].
		aFileStream nextPutAll: '!!'; cr].
	aFileStream cr! !

!Trait methodsFor: 'accessing' stamp: 'al 3/18/2006 13:22'!
basicCategory: aSymbol
	category := aSymbol! !

!Trait methodsFor: 'subclass creation - slots' stamp: ''!
subclass: aSubclassSymbol uses: aTraitCompositionOrArray  layout: layoutClass slots: slotDefinition classVariables: classVarDefinition category: aCategorySymbol
	^ self
		subclass: aSubclassSymbol
		uses: aTraitCompositionOrArray
		with: [ 
			PharoClassInstaller
				make: [ :builder | 
					builder
						name: aSubclassSymbol;
						superclass: self;
						layoutClass: layoutClass;
						slots: slotDefinition;
						sharedVariables: classVarDefinition;
						category: aCategorySymbol ] ]! !

!Trait methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/12/2013 14:38'!
subclasses: aCollection
	"Compatibility purposes"! !

!Trait methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterSuperMethodsFor: aStep
	<spotterOrder: 11>
	aStep listProcessor
			title: 'Super instance methods';
			allCandidates: [ self allMethods reject: [ :each | each methodClass = self ] ];
			filter: GTFilterSubstring! !

!Trait methodsFor: '*Fuel' stamp: 'MartinDias 3/29/2012 03:05'!
fuelAccept: aGeneralMapper

	^aGeneralMapper visitTrait: self! !

!Trait methodsFor: 'testing' stamp: ''!
isClassOrTrait
	^true! !

!Trait methodsFor: 'accessing' stamp: 'al 7/17/2004 14:16'!
environment
	^environment! !

!Trait methodsFor: 'fileIn/Out' stamp: ''!
fileOutInitializerOn: aStream
	^self class fileOutInitializerOn: aStream! !

!Trait methodsFor: 'fileIn/Out' stamp: ''!
shouldFileOutPools
	"respond with true if the user wants to file out the shared pools"
	^self confirm: 'FileOut selected sharedPools?'! !

!Trait methodsFor: 'accessing parallel hierarchy' stamp: 'jannik.laval 5/1/2010 16:36'!
classTrait: aTrait
	"Assigns the class trait associated with the receiver."
	
	[aTrait isClassTrait] assert.
	classTrait := aTrait! !

!Trait methodsFor: 'class variables' stamp: ''!
classVarNames
	"Answer a collection of the names of the class variables defined in the receiver."

	^self classPool keys sort! !

!Trait methodsFor: 'fileIn/Out' stamp: ''!
removeFromChanges
	"References to the receiver, a class, and its metaclass should no longer be included in the system ChangeSet."

	ChangeSet current removeClassAndMetaClassChanges: self! !

!Trait methodsFor: 'initialize-release' stamp: ''!
unload
	"Sent when a the class is removed.  Does nothing, but may be overridden by (class-side) subclasses."! !

!Trait methodsFor: 'compiling' stamp: ''!
reformatAll 
	"Reformat all methods in this class.
	Leaves old code accessible to version browsing"
	super reformatAll.		"me..."
	self class reformatAll	"...and my metaclass"! !

!Trait methodsFor: 'class variables' stamp: ''!
classVarNamed: aString
	"for compatibility"

	^self readClassVariableNamed: aString! !

!Trait methodsFor: 'subclass creation' stamp: ''!
variableWordSubclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s category: cat
	"This is the standard initialization message for creating a new class as a 
	subclass of an existing class (the receiver) in which the subclass is to 
	have indexable word-sized nonpointer variables."
	^self classBuilder
		superclass: self
		variableWordSubclass: t
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: cat
! !

!Trait methodsFor: '*Monticello' stamp: 'SebastianTleye 7/12/2013 13:59'!
classDefinitions
	| definitions |
	definitions := OrderedCollection with: self asClassDefinition.
	(self hasClassSide
		and: [self classTrait hasTraitComposition])
					ifTrue: [definitions add: self classTrait asMCDefinition].
	^definitions asArray! !

!Trait methodsFor: 'accessing parallel hierarchy' stamp: ''!
hasClassSide
	^self classSide notNil.! !

!Trait methodsFor: 'fileIn/Out' stamp: ''!
hasSharedPools
	"Returns whether the receiver uses shared pools directly (Does not take into account that it may inherit shared pool uses."
	^ self sharedPools notEmpty! !

!Trait methodsFor: 'subclass creation' stamp: ''!
subclass: aName uses: aTraitCompositionOrArray instanceVariableNames: someInstanceVariableNames classVariableNames: someClassVariableNames poolDictionaries: someSharedPoolNames category: aCategory

	^ self
		subclass: aName
		uses: aTraitCompositionOrArray
		with: [ 
			self
				subclass: aName
				instanceVariableNames: someInstanceVariableNames
				classVariableNames: someClassVariableNames
				poolDictionaries: someSharedPoolNames
				category: aCategory ]! !

!Trait methodsFor: 'subclass creation' stamp: ''!
variableSubclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s category: cat
	"This is the standard initialization message for creating a new class as a 
	subclass of an existing class (the receiver) in which the subclass is to 
	have indexable pointer variables."
	^self classBuilder
		superclass: self
		variableSubclass: t
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: cat
! !

!Trait methodsFor: 'subclass creation - slots' stamp: ''!
subclass: aSubclassSymbol uses: aTraitCompositionOrArray slots: slotDefinition classVariables: classVarDefinition category: aCategorySymbol
	^ self
		subclass: aSubclassSymbol
		uses: aTraitCompositionOrArray
		with: [ 
			PharoClassInstaller
				make: [ :builder | 
					builder
						name: aSubclassSymbol;
						superclass: self;
						slots: slotDefinition;
						sharedVariables: classVarDefinition;
						category: aCategorySymbol ] ]! !

!Trait methodsFor: '*OpalCompiler-Core' stamp: ''!
classSideCompilerClass 
	"Redefine this method if you want to customize the compiler class for class-side methods"
	^ Smalltalk compilerClass! !

!Trait methodsFor: 'class variables' stamp: ''!
classVarNamed: aString put: anObject
	"for compatibility"
	
	self writeClassVariableNamed: aString value: anObject! !

!Trait methodsFor: 'pool variables' stamp: ''!
addSharedPool: aSharedPool 
	"Add the argument, aSharedPool, as one of the receiver's shared pools. 
	Create an error if the shared pool is already one of the pools.
	This method will work with shared pools that are plain Dictionaries or thenewer SharedPool subclasses"

	(self sharedPools includes: aSharedPool)
		ifTrue: [^self error: 'This is already in my shared pool list'].
	self sharedPools == nil
		ifTrue: [self sharedPools: (OrderedCollection with: aSharedPool)]
		ifFalse: [self sharedPools add: aSharedPool]! !

!Trait methodsFor: 'subclass creation' stamp: ''!
weakSubclass: className instanceVariableNames: instVarNames 
	classVariableNames: classVarNames category: cat
	"Added to allow for a simplified subclass creation experience. "
	
	^ self weakSubclass: className 
		instanceVariableNames: instVarNames 
		classVariableNames: classVarNames 
		poolDictionaries: ''
		category: cat! !

!Trait methodsFor: 'subclass creation' stamp: ''!
subclass: t instanceVariableNames: ins
	^ self subclass: t instanceVariableNames: ins classVariableNames: '' poolDictionaries: '' category: 'Unclassified' ! !

!Trait methodsFor: 'subclass creation' stamp: ''!
variableByteSubclass: aName uses: aTraitComposition instanceVariableNames: someInstanceVariableNames classVariableNames: someClassVariableNames poolDictionaries: someSharedPoolNames category: aCategory
	"Creates a new class as a subclass of an existing class (the receiver) 
	in which the subclass is to have indexable byte-sized nonpointer variables."
	
	^ self
		subclass: aName
		uses: aTraitComposition
		with: [ 
			self
				variableByteSubclass: aName
				instanceVariableNames: someInstanceVariableNames
				classVariableNames: someClassVariableNames
				poolDictionaries: someSharedPoolNames
				category: aCategory ]! !

!Trait methodsFor: 'copying' stamp: 'MarcusDenker 8/16/2010 15:28'!
copy 
	| newTrait |
	newTrait := self class basicNew initialize
		name: self name
		traitComposition: self traitComposition copyTraitExpression 
		methodDict: self methodDict copy
		localSelectors: self localSelectors copy
		organization: self organization copy.
	
	newTrait environment: self environment.	
	newTrait classTrait initializeFrom: self classTrait.
	^newTrait! !

!Trait methodsFor: 'subclass creation' stamp: ''!
variableByteSubclass: className instanceVariableNames: instvarNames 
	classVariableNames: classVarNames category: cat
	"Added to allow for a simplified subclass creation experience. "
	^self variableByteSubclass: className
		instanceVariableNames: instvarNames
		classVariableNames: classVarNames
		poolDictionaries: ''
		category: cat! !

!Trait methodsFor: 'accessing' stamp: 'SebastianTleye 7/12/2013 14:33'!
classPool
	^ Dictionary new! !

!Trait methodsFor: 'initialize-release' stamp: ''!
declareClassVariables: newVars 
	"Declare class variables common to all instances. Answer whether 
	recompilation is advisable."
	|  conflicts |
	
	conflicts := false.	
	(self classVariables reject: [:x | newVars includes: x]) do: [:var | [self removeClassVariable: var] on: InMidstOfFileinNotification do: [:ex | ex resume: true]].
	
	(newVars reject: [:var | self classVariables includes: var]) do: [:var | "adding"
			"check if new vars defined elsewhere"
			(self innerBindingOf: var key) 
				ifNotNil: [(DuplicatedVariableError new) variable: var name;
						signal: var name , ' is defined elsewhere'.
					conflicts := true]].
	newVars notEmpty
		ifTrue: 
			[self classPool: self classPool.
			"in case it was nil"
			newVars do: [:var | self classPool declareVariable: var from: Undeclared]].
	^conflicts! !

!Trait methodsFor: 'subclass creation - slots' stamp: ''!
subclass: aSubclassSymbol slots: slotDefinition classVariables: classVarDefinition category: aCategorySymbol

	^ PharoClassInstaller make: [ :builder |
		builder name: aSubclassSymbol;
		superclass: self;
		slots: slotDefinition;
		sharedVariables: classVarDefinition;
		category: aCategorySymbol ].
! !

!Trait methodsFor: 'subclass creation' stamp: ''!
variableWordSubclass: className uses: aTraitCompositionOrArray instanceVariableNames: instVarNames
	classVariableNames: classVarNames category: cat
	"Added to allow for a simplified subclass creation experience. "

	^ self variableWordSubclass: className
		uses: aTraitCompositionOrArray
		instanceVariableNames: instVarNames
		classVariableNames: classVarNames
		poolDictionaries: ''
		category: cat! !

!Trait methodsFor: 'class variables' stamp: ''!
definesClassVariable: aGlobal
	"Return whether the receiver has a class variables (shared variables among its class and subclasses) named: aString"
	
	^ self classVariables includes: aGlobal! !

!Trait methodsFor: 'fileIn/Out' stamp: ''!
fileOutSharedPoolsOn: aFileStream
	"file out the shared pools of this class after prompting the user about each pool"
	| poolsToFileOut |
	poolsToFileOut := self sharedPools select: 
		[:aPool | (self shouldFileOutPool: (self environment keyAtIdentityValue: aPool))].
	poolsToFileOut do: [:aPool | self fileOutPool: aPool onFileStream: aFileStream].
	! !

!Trait methodsFor: 'subclass creation' stamp: ''!
subclass: aTraitName uses: aTraitCompositionOrArray instanceVariableNames: instVarNames classVariableNames: classVarNames category: cat 

	^ self
		subclass: aTraitName
		uses: aTraitCompositionOrArray
		instanceVariableNames: instVarNames
		classVariableNames: classVarNames
		poolDictionaries: ''
		category: cat ! !

!Trait methodsFor: 'subclass creation' stamp: ''!
variableByteSubclass: className uses: aTraitCompositionOrArray instanceVariableNames: instVarNames 
	classVariableNames: classVarNames category: cat
		"Added to allow for a simplified subclass creation experience. "
	
	^ self variableByteSubclass: className
		uses: aTraitCompositionOrArray
		instanceVariableNames: instVarNames
		classVariableNames: classVarNames 
		poolDictionaries: ''
		category: cat! !

!Trait methodsFor: 'self evaluating' stamp: ''!
isSelfEvaluating
	^self isObsolete not! !

!Trait methodsFor: '*GT-InspectorExtensions-Core' stamp: ''!
gtInspectorCommentIn: composite
	"This provides an editable comment of the current class"
	<gtInspectorPresentationOrder: 20>
	composite text 
		title: 'Comment';
		display: [ self comment ];
		act: [ :text | 
			self comment: text text stamp: Author changeStamp]
			icon: GLMUIThemeExtraIcons glamorousAccept 
			on: $s
			entitled: 'Accept'! !

!Trait methodsFor: 'fileIn/Out' stamp: ''!
fileOut
	"Create a file whose name is the name of the receiver with '.st' as the 
	extension, and file a description of the receiver onto it."
	
	| internalStream |
	internalStream := (String new: 100) writeStream.
	internalStream header; timeStamp.

	self hasSharedPools ifTrue: [
		self shouldFileOutPools
			ifTrue: [self fileOutSharedPoolsOn: internalStream]].
	self fileOutOn: internalStream moveSource: false toFile: 0.
	internalStream trailer.

	FileStream writeSourceCodeFrom: internalStream baseName: self name isSt: true! !

!Trait methodsFor: '*GT-InspectorExtensions-Core' stamp: ''!
gtInspectorAllReferencesOutsideIn: composite
	"This provides a list of all methods provided by the current class"
	<gtInspectorPresentationOrder: 20>
	composite list 
		title: 'All Ref Outside';
		display: [ ((SystemNavigation default allReferencesTo: self binding) 
							reject: [ :method | method package name == self package name ])
						sorted: [ :x :y | x name < y name ] ];
		format: #name;
		tags: [ :each | { each package name } ]! !

!Trait methodsFor: '*Ring-Core-Kernel' stamp: 'MarcusDenker 10/7/2013 13:03'!
asRingDefinitionWithMethods: methodsBoolean withSuperclasses: supersBoolean withSubclasses: subsBoolean withPackageKeys: packageKeys in: aRGSlice
	
	| rgClass rgMethod rgSuper sup |	
	rgClass := self asRingDefinition.
	aRGSlice loadClass: rgClass using: packageKeys.

	methodsBoolean ifTrue: [
		self methodsDo:[ :mth|  
			rgMethod := mth asActiveRingDefinition.
			aRGSlice loadMethod: rgMethod inClass: rgClass using: packageKeys ].
		self theMetaClass methodsDo:[ :mth|  
			rgMethod := mth asActiveRingDefinition.
			aRGSlice loadMethod: rgMethod inClass: rgClass theMetaClass using: packageKeys ] ].

	supersBoolean ifTrue: [
		rgSuper := aRGSlice classNamed: rgClass superclassName.
		rgSuper isNil ifTrue: [
			sup := aRGSlice environment classNamed: rgClass superclassName.
			rgSuper := sup asRingDefinitionWithMethods: methodsBoolean withSuperclasses: supersBoolean withSubclasses: subsBoolean withPackageKeys: packageKeys in: aRGSlice ].
		rgClass superclass: rgSuper ].
	
	^rgClass! !

!Trait class methodsFor: 'fileIn/Out' stamp: ''!
doesNotIncludeInstanceOrSuperclassesFor: aClass in: unprocessedClasses cache: cache 
	| soleInstance |
	soleInstance := aClass soleInstance.
	^ (unprocessedClasses includes: soleInstance) not and: [
				self hasNoSuperclassesOf: soleInstance in: unprocessedClasses cache: cache]! !

!Trait class methodsFor: 'instance creation' stamp: 'Alexandre Bergel 5/22/2010 14:41'!
named: aSymbol
	^ self named: aSymbol uses: {} category: 'Unclassified'! !

!Trait class methodsFor: 'printing' stamp: 'al 2/9/2004 22:23'!
newTemplateIn: categoryString
	^String streamContents: [:stream |
		stream
			nextPutAll: self name;
			nextPutAll: ' named: #NameOfTrait';
			cr; tab;
			nextPutAll: 'uses: {}';
			cr; tab;
			nextPutAll: 'category: ';
			nextPut: $';
			nextPutAll: categoryString;
			nextPut: $' ]! !

!Trait class methodsFor: 'instance creation' stamp: 'md 3/3/2006 11:05'!
named: aSymbol uses: aTraitCompositionOrCollection category: aString
	| env |
	env := self environment.
	^self
		named: aSymbol
		uses: aTraitCompositionOrCollection
		category: aString
		env: env! !

!Trait class methodsFor: 'fileIn/Out' stamp: ''!
allSuperclassesFor: aClass cache: cache 	
	^ cache at: aClass ifAbsentPut: [aClass allSuperclasses asArray]! !

!Trait class methodsFor: 'inquiries' stamp: ''!
rootsOfTheWorld
	"return all classes that have a nil superclass"
	
	^(Smalltalk globals select: [:each | each isBehavior and: [each superclass isNil]]) asOrderedCollection! !

!Trait class methodsFor: 'instance creation' stamp: 'al 12/7/2003 16:00'!
defaultEnvironment
	^Smalltalk! !

!Trait class methodsFor: 'instance creation' stamp: 'MaxLeske 11/1/2014 20:20'!
named: aSymbol uses: aTraitCompositionOrCollection category: aString env: anEnvironment
	| trait oldTrait systemCategory oldCategory |
	
	systemCategory := aString asSymbol.
	trait := anEnvironment
		at: aSymbol
		ifAbsent: [nil].
	oldTrait := trait copy.
	"Since there some strange side effect who changes teh category before being able to 
	  actually update (and that causes a problem on RPackage organization), we take also the 
	  category"
	oldCategory := oldTrait ifNotNil: [ oldTrait category ].
	trait := trait ifNil: [ super new ].
	
	(trait isKindOf: Trait) ifFalse: [
		^self error: trait name , ' is not a Trait'].
	trait
		setName: aSymbol
		andRegisterInCategory: systemCategory
		environment: anEnvironment.
		
	trait setTraitComposition: aTraitCompositionOrCollection asTraitComposition.
	
	"... notify interested clients ..."
	oldTrait ifNil: [
		SystemAnnouncer uniqueInstance 
			classAdded: trait 
			inCategory: systemCategory.
		^trait].

	SystemAnnouncer uniqueInstance traitDefinitionChangedFrom: oldTrait to: trait.

	systemCategory ~= oldCategory
		ifTrue: [ 
			SystemAnnouncer uniqueInstance 
				class: trait 
				recategorizedFrom: (oldCategory ifNil: [ #Unclassified ])
				to: systemCategory].
		
	^ trait! !

!Trait class methodsFor: 'instance creation' stamp: 'al 12/19/2003 15:03'!
new
	self shouldNotImplement! !

!Trait class methodsFor: 'private' stamp: ''!
hasNoDependenciesFor: aClass in: unprocessedClasses cache: cache 
	^ (self hasNoSuperclassesOf: aClass in: unprocessedClasses cache: cache) and: [
		aClass isMeta not or: [
			self hasNoDependenciesForMetaclass: aClass in: unprocessedClasses cache: cache]] ! !

!Trait class methodsFor: 'instance creation' stamp: ''!
template: aSystemCategoryName 
	"Answer an expression that can be edited and evaluated in order to define a new class."

	^ self templateForSubclassOf: Object name category: aSystemCategoryName ! !

!Trait class methodsFor: 'fileIn/Out' stamp: ''!
superclassOrder: classes
	"Arrange the classes in the collection, classes, in superclass order so the 
	classes can be properly filed in. Do it in sets instead of ordered collections."

	| all unprocessedClasses cache |

	unprocessedClasses := classes asSet. 
	cache := Dictionary new.
	all := OrderedCollection new: unprocessedClasses size.
	unprocessedClasses size timesRepeat: [ |nextClass|
		nextClass := unprocessedClasses detect: [:aClass | self hasNoDependenciesFor: aClass in: unprocessedClasses cache: cache].
		all add: nextClass.
		unprocessedClasses remove: nextClass].
	^all! !

!Trait class methodsFor: 'instance creation' stamp: ''!
templateForSubclassOf: priorClassName category: systemCategoryName 
	"Answer an expression that can be edited and evaluated in order to define a new class, given that the class previously looked at was as given"

	^priorClassName asString, ' subclass: #NameOfSubclass
	instanceVariableNames: ''''
	classVariableNames: ''''
	poolDictionaries: ''''
	category: ''' , systemCategoryName asString , ''''! !

!Trait class methodsFor: 'fileIn/Out' stamp: ''!
hasNoSuperclassesOf: aClass in: unprocessedClasses cache: cache 
	^ (unprocessedClasses includesAnyOf: (self allSuperclassesFor: aClass cache: cache)) not
	! !

!Trait class methodsFor: 'fileIn/Out' stamp: ''!
fileOutPool: aString
	"file out the global pool named aString"
	
	| internalStream |
	internalStream := (String new: 1000) writeStream.
	self new fileOutPool: (self environment at: aString asSymbol) onFileStream: internalStream.

	FileStream writeSourceCodeFrom: internalStream baseName: aString isSt: true.! !

!Trait class methodsFor: 'fileIn/Out' stamp: ''!
hasNoDependenciesForMetaclass: aClass in: unprocessedClasses cache: cache 
	| soleInstance |
	soleInstance := aClass soleInstance.
	^ (unprocessedClasses includes: soleInstance) not and: [
				self hasNoSuperclassesOf: soleInstance in: unprocessedClasses cache: cache]! !

!TraitAlias commentStamp: '<historical>'!
See comment of my superclass TraitTransformation.!
!TraitAlias methodsFor: 'accessing' stamp: 'al 3/12/2004 16:43'!
aliases
	"Collection of associations where key is the
	alias and value the original selector."
	
	^aliases! !

!TraitAlias methodsFor: 'testing' stamp: 'al 4/10/2004 23:57'!
isEmpty
	^self aliases isEmpty! !

!TraitAlias methodsFor: 'enquiries' stamp: 'al 3/7/2004 23:26'!
allSelectors
	^self subject allSelectors
		addAll: (self aliases collect: [:each | each key]) asSet;
		yourself! !

!TraitAlias methodsFor: 'enquiries' stamp: 'al 4/7/2004 21:16'!
collectMethodsFor: aSelector into: methodDescription
	| originalSelector association |
	self subject
		collectMethodsFor: aSelector
		into: methodDescription.			
	association := self aliasNamed: aSelector ifAbsent: [nil].
	association notNil ifTrue: [
		originalSelector := association value.
		self subject
			collectMethodsFor: originalSelector
			into: methodDescription]! !

!TraitAlias methodsFor: 'enquiries' stamp: 'al 7/13/2004 16:53'!
allAliasesDict
	| dict |
	dict := super allAliasesDict.
	self aliases do: [:assoc |
		dict at: assoc key put: assoc value].
	^dict! !

!TraitAlias methodsFor: 'accessing' stamp: 'al 3/17/2004 15:22'!
aliases: anArrayOfAssociations
	| newNames |
	newNames := (anArrayOfAssociations collect: [:each | each key]) asIdentitySet.
	newNames size < anArrayOfAssociations size ifTrue: [
		TraitCompositionException signal: 'Cannot use the same alias name twice'].
	anArrayOfAssociations do: [:each |
		(newNames includes: each value) ifTrue: [
			TraitCompositionException signal: 'Cannot define an alias for an alias']].
	aliases := anArrayOfAssociations! !

!TraitAlias methodsFor: 'composition' stamp: 'al 3/3/2004 19:49'!
- anArrayOfSelectors
	^TraitExclusion
		with: self
		exclusions: anArrayOfSelectors! !

!TraitAlias methodsFor: 'copying' stamp: 'dvf 8/25/2005 16:07'!
copyTraitExpression
	^super copyTraitExpression
		aliases: self aliases deepCopy;
		yourself! !

!TraitAlias methodsFor: 'enquiries' stamp: 'al 3/12/2004 17:10'!
aliasesForSelector: aSymbol
	| selectors |
	selectors := self aliases
		select: [:association | association value = aSymbol]
		thenCollect: [:association | association key].
	^(super aliasesForSelector: aSymbol)
		addAll: selectors;
		yourself
		 ! !

!TraitAlias methodsFor: 'enumeration' stamp: 'al 4/7/2004 21:14'!
aliasNamed: aSymbol ifAbsent: aBlock
	^self aliases
		detect: [:association |  association key = aSymbol]
		ifNone: aBlock! !

!TraitAlias methodsFor: 'printing' stamp: 'al 2/22/2004 21:45'!
printOn: aStream
	super printOn: aStream.
	aStream
		space;
		nextPut: $@;
		space;
		nextPut: ${.
	self aliases do: [:each | aStream print: each]
		separatedBy: [aStream nextPutAll: '. '].
	aStream nextPut: $}! !

!TraitAlias methodsFor: 'copying' stamp: 'nice 1/13/2010 22:02'!
postCopy
	super postCopy.
	aliases := self aliases copy! !

!TraitAlias methodsFor: 'composition' stamp: 'ST 6/5/2013 17:11'!
@ anArrayOfAssociations 
	^TraitAlias 
		with: subject
		aliases: (anArrayOfAssociations, self aliases)! !

!TraitAlias methodsFor: 'composition' stamp: 'al 4/10/2004 23:51'!
removeAlias: aSymbol
	self aliases: (self aliases
		reject: [:each | each key = aSymbol])! !

!TraitAlias methodsFor: 'comparing' stamp: 'MartinDias 1/23/2014 15:15'!
syntacticallyEquals: aTraitTransformation
	"Test syntactic equivalence of this trait transformation with another. 
	The order of aliases is taken into account. For example, A @ { #x -> #y. #z -> #w } ~= A @ { #z -> #w. #x -> #y }."

	self == aTraitTransformation ifTrue: [ ^ true ].
	self species = aTraitTransformation species ifFalse: [ ^ false ].
	^ self aliases = aTraitTransformation aliases! !

!TraitAlias class methodsFor: 'instance creation' stamp: 'al 3/17/2004 15:22'!
assertValidAliasDefinition: anArrayOfAssociations
	"Throw an exceptions if the alias definition is not valid.
	It is expected to be a collection of associations and
	the number of arguments of the alias selector has to
	be the same as the original selector."

	((anArrayOfAssociations isKindOf: Collection) and: [
		anArrayOfAssociations allSatisfy: [:each |
			each isKindOf: Association]]) ifFalse: [
		TraitCompositionException signal: 'Invalid alias definition: Not a collection of associations.'].
	
	(anArrayOfAssociations allSatisfy: [:association |
		(association key numArgs = association value numArgs and: [
			(association key numArgs = -1) not])]) ifFalse: [
		TraitCompositionException signal: 'Invalid alias definition: Alias and original selector have to have the same number of arguments.']! !

!TraitAlias class methodsFor: 'instance creation' stamp: 'al 3/12/2004 16:24'!
with: aTraitComposition aliases: anArrayOfAssociations
	self assertValidAliasDefinition: anArrayOfAssociations.
	^self new
		subject: aTraitComposition;
		aliases: anArrayOfAssociations;
		yourself! !

!TraitBehavior commentStamp: 'apb 3/2/2006 17:49'!
I declare the instance variables methodDict, traitComposition and localSelectors that normally would be defined on PureBehavior (see class comment of PureBehavior). Furthermore I keep track of where I am used and I provide compatibility methods to make me useable in tools where originally a class was expected.!
!TraitBehavior methodsFor: 'traits' stamp: ''!
noteChangedSelectors: aCollection
	"Start update of my methodDict (after changes to traits in traitComposition
	or after a local method was removed from my methodDict). The argument 
	is a collection of method selectors that may have been changed. Most of the time
	aCollection only holds one selector. But when there are aliases involved 
	there may be several method changes that have to be propagated to users."

	| affectedSelectors |
	affectedSelectors := IdentitySet new.
	aCollection do: [:selector |
		affectedSelectors addAll: (self updateMethodDictionarySelector: selector)].
	self notifyUsersOfChangedSelectors: affectedSelectors.
	^ affectedSelectors! !

!TraitBehavior methodsFor: 'enumerating' stamp: ''!
allUnreferencedInstanceVariables
	"Return a list of the instance variables known to the receiver which are not referenced in the receiver or any of its subclasses OR superclasses"

	^ self allInstVarNames reject: [:ivn |
		| definingClass |		
		definingClass := self classThatDefinesInstanceVariable: ivn.
		definingClass withAllSubclasses anySatisfy: [:class |  
				(class whichSelectorsAccess: ivn asSymbol) notEmpty]]! !

!TraitBehavior methodsFor: 'testing' stamp: ''!
isObsolete
	"Return true if the receiver is obsolete."
	^self instanceCount = 0! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
methodDictionary
	^self methodDict! !

!TraitBehavior methodsFor: 'private' stamp: ''!
becomeCompact
	"Make me compact.
	This means: 
	- find a free slot in 'Smalltalk compactClassArray'
	- add me in that array
	- update my format with the index
	- update my instances
	"
	| compactClassesArray index |
	self isWeak 
		ifTrue: [^ self error: 'You must not make a weak class compact'].
	compactClassesArray := Smalltalk compactClassesArray.
	(self isCompact or: [compactClassesArray includes: self])
		ifTrue: [^ self error: self name , 'is already compact'].
	index := compactClassesArray indexOf: nil
		ifAbsent: [^ self error: 'compact class table is full'].
	"Install this class in the compact class table"
	compactClassesArray at: index put: self.

	"Update instspec so instances will be compact. 
	The layout has the responsibility for setting the format."
	self layout compactClassIndex: index.

	"Make up new instances and become old ones into them"
	self updateInstancesFrom: self.
	"Purge any old instances"
	Smalltalk garbageCollect.! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
compiledMethodAt: selector ifAbsent: aBlock
	"Answer the compiled method associated with the argument, selector (a Symbol), a message selector in the receiver's method dictionary. If the selector is not in the dictionary, return the value of aBlock"

	^ self methodDict at: selector ifAbsent: aBlock! !

!TraitBehavior methodsFor: 'queries' stamp: ''!
copiesFromSuperclass: method
	"Checks whether the receiver copied the argument,  method, from its superclasses"
	
	self allSuperclassesDo: [ :cls|
		(cls includesSelector: method selector)
			ifTrue: [ ^ (cls >> method selector) sourceCode  = method sourceCode]].
	^ false! !

!TraitBehavior methodsFor: 'accessing class hierarchy' stamp: ''!
allSuperclassesIncluding: aClass
	"Answer an OrderedCollection of the receiver's and the receiver's  ancestor's superclasses
	up to aClass included. If aClass is not part of the receiver's superclass, returns up to the root."
	| temp |
	self class == ProtoObject class ifTrue: [ ^ OrderedCollection new].
	^ self superclass == aClass
		ifTrue: [ OrderedCollection with: aClass]
		ifFalse: [temp := self superclass allSuperclassesIncluding: aClass.
			temp addFirst: self superclass.
			temp]! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: ''!
whichSelectorsReferTo: literal special: specialFlag byte: specialByte
	"Answer a set of selectors whose methods access the argument as a literal."

	| who |
	who := IdentitySet new.
	self selectorsAndMethodsDo: 
		[:sel :method |
		((method hasLiteral: literal) or: [specialFlag and: [method scanFor: specialByte]])
			ifTrue:
				[((literal isVariableBinding) not
					or: [method literals allButLast identityIncludes: literal])
						ifTrue: [who add: sel]]].
	^ who! !

!TraitBehavior methodsFor: 'initialization' stamp: ''!
initializeSlots: anObject 
	self layout initializeInstance: anObject! !

!TraitBehavior methodsFor: 'initialization' stamp: ''!
emptyMethodDictionary

	^ MethodDictionary new! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
supermostPrecodeCommentFor: selector 
	"Answer a string representing the precode comment in the most distant 
	superclass's implementation of the selector. Return nil if none found."
	| aSuper superComment |
	(self == Behavior
			or: [self superclass == nil
					or: [(aSuper := self superclass whichClassIncludesSelector: selector) == nil]])
		ifFalse: ["There is a super implementor"
			superComment := aSuper supermostPrecodeCommentFor: selector].
	^ superComment
		ifNil: [self firstPrecodeCommentFor: selector
			"ActorState supermostPrecodeCommentFor: #printOn:"]! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
localSelectors: aSet 
	self basicLocalSelectors: aSet! !

!TraitBehavior methodsFor: 'queries' stamp: ''!
copiedFromSuperclass: method
	"Returns the methods that the receiver copied with its ancestors"
	
	self allSuperclassesDo: [ :cls|
		(cls includesSelector: method selector)
			ifTrue: [ 
				((cls >> method selector) sourceCode  = method sourceCode)
					ifTrue: [ ^ {cls >> method selector}]
					ifFalse: [ ^ #()]]].
	^ #().
	! !

!TraitBehavior methodsFor: 'user interface' stamp: ''!
withAllSubAndSuperclassesDo: aBlock

	self withAllSubclassesDo: aBlock.
	self allSuperclassesDo: aBlock.
! !

!TraitBehavior methodsFor: 'queries' stamp: ''!
whichSelectorsRead: aString
	
	| index |
	index := self
		instVarIndexFor: aString
		ifAbsent: [ ^ IdentitySet new ].
	^ self selectors select: [ :each |
		(self compiledMethodAt: each)
			readsField: index ]! !

!TraitBehavior methodsFor: 'initialization' stamp: ''!
initialize
	"moved here from the class side's #new"
	super initialize.
	self superclass: Object.
	"no longer sending any messages, some of them crash the VM"
	self methodDict: self emptyMethodDictionary.
	self setFormat: Object format.
	self traitComposition: nil.
	self users: IdentitySet new.! !

!TraitBehavior methodsFor: 'system startup' stamp: ''!
startUp
	"This message is sent to registered classes when the system is coming up."
 ! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/3/2013 22:40'!
instSize
	^0! !

!TraitBehavior methodsFor: 'testing' stamp: ''!
isPointers
	"Answer whether the receiver contains just pointers (not bits)."

	^self isBits not! !

!TraitBehavior methodsFor: '*OpalCompiler-Core' stamp: ''!
evaluate: aString
	^self compiler evaluate: aString! !

!TraitBehavior methodsFor: 'traits' stamp: ''!
setTraitComposition: aTraitComposition
	| oldComposition |
	(self hasTraitComposition not and: [aTraitComposition isEmpty]) ifTrue: [^self].
	aTraitComposition assertValidUser: self.

	oldComposition := self traitComposition.
	self traitComposition: aTraitComposition.
	self applyChangesOfNewTraitCompositionReplacing: oldComposition.
	
	oldComposition traits do: [:each | each removeUser: self].
	aTraitComposition traits do: [:each | each addUser: self]! !

!TraitBehavior methodsFor: '*ast-core' stamp: ''!
parseTreeFor: aSymbol	
	^ RBParser parseMethod: (self sourceCodeAt: aSymbol) onError: [ :msg :pos | ^ nil ]! !

!TraitBehavior methodsFor: 'private' stamp: ''!
becomeCompactSimplyAt: index
	"The same as #becomeCompact but without updating my instances."

	| compactClassesArray |

	self isWeak 
		ifTrue: [^ self error: 'You must not make a weak class compact'].
	compactClassesArray := Smalltalk compactClassesArray.
	(self isCompact or: [compactClassesArray includes: self])
		ifTrue: [^ self error: self name, 'is already compact'].		
	(compactClassesArray at: index) ifNotNil: [^ self error: 'compact table slot already in use'].
	"Install this class in the compact class table"
	compactClassesArray at: index put: self.

	"Update instspec so instances will be compact. 
	The layout has the responsibility for setting the format."
	self layout compactClassIndex: index.! !

!TraitBehavior methodsFor: 'adding/removing methods' stamp: ''!
addSelector: selector withMethod: compiledMethod notifying: requestor
	^ self addSelectorSilently: selector withMethod: compiledMethod! !

!TraitBehavior methodsFor: '*System-Support' stamp: ''!
referencedClasses
	"Return the set of classes that are directly referenced by my methods"

	| answer |
	answer := Set new.
	self methods do: [ :cm |
		answer addAll: 
			( cm literals select: [ :l | l isKindOf: Association ] thenCollect: #value ) ].
		
	^ answer! !

!TraitBehavior methodsFor: 'accessing-properties' stamp: 'MarcusDenker 3/2/2015 18:22'!
properties
	^ TraitProperties at: self ifAbsent: nil
		! !

!TraitBehavior methodsFor: 'accessing class hierarchy' stamp: ''!
allSuperclasses
	"Answer an OrderedCollection of the receiver's and the receiver's  
	ancestor's superclasses. The first element is the receiver's immediate  
	superclass, followed by its superclass; the last element is Object."
	| temp |
	^ self superclass == nil
		ifTrue: [ OrderedCollection new]
		ifFalse: [temp := self superclass allSuperclasses.
			temp addFirst: self superclass.
			temp]! !

!TraitBehavior methodsFor: '*OpalCompiler-Core' stamp: ''!
recompileChanges
	"Compile all the methods that are in the changes file.
	This validates sourceCode and variable references and forces
	methods to use the current bytecode set"

	self selectorsAndMethodsDo:
		[:sel :meth | meth fileIndex > 1 ifTrue:
			[self recompile: sel from: self]]! !

!TraitBehavior methodsFor: '*OpalCompiler-Core' stamp: ''!
sourceCodeTemplate
	"Answer an expression to be edited and evaluated in order to define 
	methods in this class or trait."

	^ 'messageSelectorAndArgumentNames
	"comment stating purpose of message"

	| temporary variable names |
	statements'! !

!TraitBehavior methodsFor: 'testing' stamp: ''!
isBits
	"Answer whether the receiver contains just bits (not pointers)."

	^ self instSpec >= 6! !

!TraitBehavior methodsFor: 'queries' stamp: ''!
whichSuperclassSatisfies: aBlock 
	(aBlock value: self) ifTrue: [^self].
	^self superclass ifNotNil: [self superclass whichSuperclassSatisfies: aBlock]! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: ''!
instanceCount
	"Answer the number of instances of the receiver that are currently in 
	use."

	| count |
	count := 0.
	self allInstancesDo: [:x | count := count + 1].
	^count! !

!TraitBehavior methodsFor: 'traits' stamp: ''!
removeFromComposition: aTrait
	self setTraitComposition: (self traitComposition copyTraitExpression
		removeFromComposition: aTrait)! !

!TraitBehavior methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterSuperclassesFor: aStep
	<spotterOrder: 40>
	aStep listProcessor
			title: 'All superclasses';
			allCandidates: [ self allSuperclasses ];
			itemIcon: #systemIcon;
			filter: GTFilterSubstring! !

!TraitBehavior methodsFor: 'traits' stamp: ''!
purgeLocalSelectors
	self basicLocalSelectors: nil! !

!TraitBehavior methodsFor: 'accessing' stamp: ''!
numberOfInstanceVariables
	^ self instVarNames size
! !

!TraitBehavior methodsFor: 'enumerating' stamp: ''!
allSubclassesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the receiver's subclasses."

	self subclassesDo: 
		[:cl | 
		aBlock value: cl.
		cl allSubclassesDo: aBlock]! !

!TraitBehavior methodsFor: 'queries' stamp: ''!
methodsAccessingSlot: aSlot
	^self methods select: [ :method | method accessesSlot: aSlot ]! !

!TraitBehavior methodsFor: '*Ring-Core-Kernel' stamp: ''!
methodsInProtocol: aString

	^ (self organization listAtCategoryNamed: aString) 
			collect: [ :each | (self compiledMethodAt: each) ]! !

!TraitBehavior methodsFor: 'enumerating' stamp: ''!
allSubInstancesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the current instances of the 
	receiver and all its subclasses."

	self allInstancesDo: aBlock.
	self allSubclassesDo: [:sub | sub allInstancesDo: aBlock]! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: ''!
isDisabledSelector: selector
	^ self classAndMethodFor: selector do: [:c :m | m isDisabled] ifAbsent: [false]! !

!TraitBehavior methodsFor: 'testing' stamp: ''!
isAnonymous
	^true! !

!TraitBehavior methodsFor: 'queries' stamp: ''!
whichClassDefinesClassVar: aString 
	Symbol hasInterned: aString ifTrue: [ :aSymbol |
		^self whichSuperclassSatisfies: 
			[:aClass | 
			aClass classVarNames anySatisfy: [:each | each = aSymbol]]].
	^#()! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
changeRecordsAt: selector
	"Return a list of ChangeRecords for all versions of the method at selector. Source code can be retrieved by sending string to any one.  Return nil if the method is absent."

	"(Pen changeRecordsAt: #go:) collect: [:cRec | cRec string]"
	^ChangeSet 
		scanVersionsOf: (self compiledMethodAt: selector ifAbsent: [^ nil])
		class: self meta: self isMeta
		category: (self whichCategoryIncludesSelector: selector)
		selector: selector.! !

!TraitBehavior methodsFor: 'instance creation' stamp: 'SebastianTleye 7/17/2013 10:08'!
basicNew
	self error: 'Traits cannot create instances'.! !

!TraitBehavior methodsFor: 'traits' stamp: ''!
hasTraitComposition

	^ self traitComposition notEmpty.! !

!TraitBehavior methodsFor: '*OpalCompiler-Core' stamp: ''!
compileAllFrom: oldClass
	"Compile all the methods in the receiver's method dictionary.
	This validates sourceCode and variable references and forces
	all methods to use the current bytecode set"
	
	oldClass localSelectors do: [:sel | self recompile: sel from: oldClass].
	! !

!TraitBehavior methodsFor: 'adding/removing methods' stamp: ''!
removeSelectorSilently: selector 
	"Remove selector without sending system change notifications"

	^ SystemAnnouncer uniqueInstance suspendAllWhile: [self removeSelector: selector].! !

!TraitBehavior methodsFor: 'system startup' stamp: ''!
shutDown
	"This message is sent on system shutdown to registered classes"
! !

!TraitBehavior methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterUsedTraitsFor: aStep
	<spotterOrder: 60>
	aStep listProcessor
			title: 'Uses Traits';
			allCandidates: [ self traits asArray ];
			itemIcon: #systemIcon;
			filter: GTFilterSubstring! !

!TraitBehavior methodsFor: 'adding/removing methods' stamp: ''!
adoptInstance: anInstance
	"Change the class of anInstance to me.
	Primitive (found in Cog and new VMs)  follows the same rules as primitiveChangeClassTo:, but returns the 	class rather than the modified instance"
	<primitive: 160 error: ec>
	anInstance primitiveChangeClassTo: self basicNew.
	^self! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: ''!
allSubInstances 
	"Answer a list of all current instances of the receiver and all of its subclasses."
	| aCollection |
	aCollection := OrderedCollection new.
	self allSubInstancesDo:
		[:x | x == aCollection ifFalse: [aCollection add: x]].
	^ aCollection! !

!TraitBehavior methodsFor: 'printing' stamp: ''!
printHierarchy
	"Answer a description containing the names and instance variable names 
	of all of the subclasses and superclasses of the receiver."

	| aStream index |
	index := 0.
	aStream := (String new: 16) writeStream.
	self allSuperclasses reverseDo: 
		[:aClass | 
		aStream crtab: index.
		index := index + 1.
		aStream nextPutAll: aClass name.
		aStream space.
		aStream print: aClass instVarNames].
	aStream cr.
	self printSubclassesOn: aStream level: index.
	^aStream contents! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: ''!
hasMethods
	"Answer whether the receiver has any methods in its method dictionary."

	^ self methodDict notEmpty! !

!TraitBehavior methodsFor: 'enumerating' stamp: ''!
allSuperclassesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the receiver's superclasses."

	self superclass == nil
		ifFalse: [aBlock value: self superclass.
				self superclass allSuperclassesDo: aBlock]! !

!TraitBehavior methodsFor: 'accessing-properties' stamp: ''!
propertyValueAt: propName put: propValue
	^ self ensureProperties
		at: propName
		ifAbsentPut: propValue
		! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: ''!
includesSelector: aSymbol 
	"Answer whether the message whose selector is the argument is in the 
	method dictionary of the receiver's class."

	^ self methodDict includesKey: aSymbol! !

!TraitBehavior methodsFor: 'traits' stamp: ''!
addTraitSelector: aSymbol withMethod: aCompiledMethod
	"Add aMethod with selector aSymbol to my
	methodDict. aMethod must not be defined locally."

	| source method |
	[(self includesLocalSelector: aSymbol) not] assert.
	self ensureLocalSelectors.
		
	source := aCompiledMethod getSourceReplacingSelectorWith: aSymbol.
	method  := aCompiledMethod copy.
	method selector: aSymbol.
	method methodClass: self.
		
	method putSource: source inFile: 2
		withPreamble: [:f | f cr; nextPut: $!!; nextChunkPut: 'Trait method'; cr].
	
	self isTrait ifFalse: [ method properties at: #traitSource put: aCompiledMethod].
	
	self basicAddSelector: aSymbol withMethod: method! !

!TraitBehavior methodsFor: '*System-Support' stamp: ''!
allUnsentMessages
	"Answer an array of all the messages defined by the receiver that are not sent anywhere in the system."

	^ SystemNavigation new allUnsentMessagesIn: self selectors! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
deregisterLocalSelector: aSymbol
	self basicLocalSelectors notNil ifTrue: [
		self basicLocalSelectors remove: aSymbol ifAbsent: []]! !

!TraitBehavior methodsFor: '*OpalCompiler-Core' stamp: ''!
compileAll
	^ self compileAllFrom: self! !

!TraitBehavior methodsFor: 'traits' stamp: 'al 12/12/2003 21:42'!
traitComposition
	traitComposition ifNil: [traitComposition := TraitComposition new].
	^traitComposition! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: ''!
canPerform: selector
	"Answer whether the receiver can safely perform to the message whose selector 
	is the argument: it is not an abstract or cancelled method"

	^ self classAndMethodFor: selector do: [:c :m | m isProvided] ifAbsent: [false].! !

!TraitBehavior methodsFor: 'enumerating' stamp: ''!
allInstancesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the current instances of the 
	receiver.
	
	Because aBlock might change the class of inst (for example, using become:),
	it is essential to compute next before aBlock value: inst."
	| inst next |
	inst := self someInstance.
	[inst == nil]
		whileFalse:
		[
		next := inst nextInstance.
		aBlock value: inst.
		inst := next]! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: ''!
allInstVarNames
	"Answer an Array of the names of the receiver's instance variables. The 
	Array ordering is the order in which the variables are stored and 
	accessed by the interpreter."

	| vars |
	self superclass == nil
		ifTrue: [vars := self instVarNames copy]	"Guarantee a copy is answered."
		ifFalse: [vars := self superclass allInstVarNames , self instVarNames].
	^vars! !

!TraitBehavior methodsFor: 'accessing-properties' stamp: ''!
propertyValueAt: propName
	^ self
		propertyValueAt: propName
		ifAbsent: [ nil ]
		! !

!TraitBehavior methodsFor: 'private' stamp: 'SebastianTleye 7/4/2013 11:21'!
setFormat: aFormatInstanceDescription
	"Compatibility purposes"! !

!TraitBehavior methodsFor: 'dependencies' stamp: ''!
dependentClasses
	"Return the list of classes used myself"
	
	"Morph dependentClasses"
	| cll | 
	cll := Set new.
	"A class depends on its superclass"
	self superclass ifNotNil: [ cll add: self superclass ].
	
	"We unify a class and its metaclass"
	(self methods, self class methods) 
		do: [ :m | m literalsDo: [ :l | 
					"We also check if the method is not an extension"
					((((l isVariableBinding 
					and: [ l value notNil ]) 
					and: [ l value isBehavior ])
					and: [ m category notEmpty ] )
					and: [ m category first ~= $* ])  ifTrue: [ cll add: l value ] ]  ].
	^ cll asArray! !

!TraitBehavior methodsFor: 'queries' stamp: ''!
copiesMethodsFromSuperclass
	"Checks whether the receiver copied some method from its superclass"

	self methodsDo: [ :method|
		(self copiesFromSuperclass: method)
			ifTrue: [ ^ true ]].
	^ false! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: ''!
allSharedPools
	"Answer an ordered collection of the shared pools that the receiver and the receiver's ancestors share."

	^self superclass allSharedPools! !

!TraitBehavior methodsFor: 'traits' stamp: 'NicolaiHess 11/27/2014 23:11'!
traitUsers
	^users! !

!TraitBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/3/2013 19:12'!
superclass
	"For compatibility with classes"

	^ nil! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
compress
	"Compact the method dictionary of the receiver."

	self methodDict rehash! !

!TraitBehavior methodsFor: 'traits' stamp: 'NS 4/12/2004 14:17'!
users
	^users! !

!TraitBehavior methodsFor: 'printing' stamp: ''!
literalScannedAs: scannedLiteral notifying: requestor
	"Postprocesses a literal scanned by Scanner scanToken (esp. xLitQuote).
	If scannedLiteral is not an association, answer it.
	Else, if it is of the form:
		nil->#NameOfMetaclass
	answer nil->theMetaclass, if any has that name, else report an error.
	Else, if it is of the form:
		#NameOfGlobalVariable->anythiEng
	answer the global, class, or pool association with that nameE, if any, else
	add it to Undeclared a answer the new Association."

	| key value |
	(scannedLiteral isVariableBinding)
		ifFalse: [^ scannedLiteral].
	key := scannedLiteral key.
	value := scannedLiteral value.
	key ifNil: "###<metaclass soleInstance name>"
			[(self bindingOf: value) ifNotNil:[:assoc|
				 (assoc value isKindOf: Behavior)
					ifTrue: [^ nil->assoc value class]].
			 requestor notify: 'No such metaclass'.
			 ^false].
	(key isSymbol)
		ifTrue: "##<global var name>"
			[(self bindingOf: key) ifNotNil:[:assoc | ^assoc].
			Undeclared at: key put: nil.
			 ^Undeclared bindingOf: key].
	requestor notify: '## must be followed by a non-local variable name'.
	^false

"	Form literalScannedAs: 14 notifying: nil 14
	Form literalScannedAs: #OneBitForm notiEfying: nil  OneBitForm
	Form literalScannedAs: ##OneBitForm notifying: nil  OneBitForm->a Form
	Form literalScannedAs: ##Form notifying: nil   Form->Form
	Form literalScannedAs: ###Form notifying: nil   nilE->Form class
"! !

!TraitBehavior methodsFor: 'traits' stamp: ''!
classesComposedWithMe
	self isTrait
		ifTrue: [ ^ self traitUsers gather: [ :u | u classesComposedWithMe ] ]
		ifFalse: [ ^ {self} ]! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
commentsIn: sourceString

	
	| commentStart nextQuotePos someComments aPos |
	('*"*' match: sourceString) ifFalse: [^#()].
	someComments:= OrderedCollection new.
	sourceString size = 0 ifTrue: [^ someComments].
	aPos:=1.
	nextQuotePos:= 0.
	[commentStart := sourceString findString: '"' startingAt: aPos.
	nextQuotePos:= self nextQuotePosIn: sourceString startingFrom: commentStart.
	(commentStart ~= 0 and: [nextQuotePos >commentStart])] whileTrue: [
		commentStart ~= nextQuotePos ifTrue: [
			someComments add: ((sourceString copyFrom: commentStart + 1 to: nextQuotePos - 1) copyReplaceAll: '""' with: '"').].
	aPos := nextQuotePos+1].
	^someComments! !

!TraitBehavior methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterSubclassesFor: aStep
	<spotterOrder: 50>
	aStep listProcessor
			title: 'All subclasses';
			allCandidates: [ self allSubclasses ];
			itemIcon: #systemIcon;
			filter: GTFilterSubstring! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
allSelectors
	"Answer all selectors understood by instances of the receiver"

	^ self allSelectorsBelow: nil! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: ''!
subclassInstVarNames
	"Answer a Set of the names of the receiver's subclasses' instance 
	variables."
	| vars |
	vars := Set new.
	self allSubclasses do: [:aSubclass | vars addAll: aSubclass instVarNames].
	^vars! !

!TraitBehavior methodsFor: '*System-Support' stamp: ''!
allCallsOn
	"Answer a SortedCollection of all the methods that refer to me by name or as part of an association in a global dict."
	
	^ (self allCallsOnIn: self systemNavigation)! !

!TraitBehavior methodsFor: 'traits' stamp: 'NS 12/11/2003 16:35'!
traitComposition: aTraitComposition
	traitComposition := aTraitComposition! !

!TraitBehavior methodsFor: 'traits' stamp: ''!
addUser: aClassOrTrait
	self traitUsers add: aClassOrTrait.! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: ''!
classBindingOf: varName
	"Answer the binding of some variable resolved in the scope of the receiver's class"
	^self bindingOf: varName! !

!TraitBehavior methodsFor: 'queries' stamp: ''!
methodsWritingSlot: aSlot
	^self methods select: [ :method | method writesSlot: aSlot ]! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
zapAllMethods
	"Remove all methods in this class which is assumed to be obsolete"

	self methodDict: self emptyMethodDictionary.
	self class isMeta ifTrue: [self class zapAllMethods]! !

!TraitBehavior methodsFor: 'printing' stamp: ''!
longPrintOn: aStream
	"Append to the argument, aStream, the names and values of all of the receiver's instance variables.  But, not useful for a class with a method dictionary."

	aStream nextPutAll: '<<too complex to show>>'; cr.! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: ''!
allInstances
	"Answer a collection of all current instances of the receiver."

	| all inst next |
	all := OrderedCollection new.
	inst := self someInstance.
	[inst == nil]
		whileFalse: [
		next := inst nextInstance.
		inst == all ifFalse: [all add: inst].
		inst := next].
	^ all asArray! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
methodsDo: aBlock
	"Evaluate aBlock for all the compiled methods in my method dictionary."

	^ self methodDict valuesDo: aBlock! !

!TraitBehavior methodsFor: 'compiling' stamp: ''!
instVarNamesAndOffsetsDo: aBinaryBlock
	"This is part of the interface between the compiler and a class's instance or field names.
	 The class should enumerate aBinaryBlock with the instance variable name strings and
	 their integer offsets.  The order is important. Names evaluated later will override the
	 same names occurring earlier."

	"Nothing to do here; ClassDescription introduces named instance variables"
	^self! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
commentsAt:  selector
	"Answer a string representing the first comment in the method associated with selector.  Return an empty string if the relevant source file is not available, or if the method's source code does not contain a comment.  Not smart enough to bypass quotes in string constants, but does map doubled quote into a single quote."


	^self commentsIn:  (self sourceCodeAt: selector) asString.
	
"Behavior commentsAt: #commentsAt:"! !

!TraitBehavior methodsFor: 'system startup' stamp: ''!
startUp: resuming
	"This message is sent to registered classes when the system is coming up."
	^self startUp! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
removeSelector: aSelector
	"Assuming that the argument, selector (a Symbol), is a message selector 
	in my method dictionary, remove it and its method.
	
	If the method to remove will be replaced by a method from my trait composition,
	the current method does not have to be removed because we mark it as non-local.
	If it is not identical to the actual method from the trait it will be replaced automatically
	by #noteChangedSelectors:.
	
	This is useful to avoid bootstrapping problems when moving methods to a trait
	(e.g., from TBehavior to TMethodDictionaryBehavior). Manual moving (implementing
	the method in the trait and then remove it from the class) does not work if the methods
	themselves are used for this process (such as compiledMethodAt:, includesLocalSelector: or
	addTraitSelector:withMethod:)"
	
	| changeFromLocalToTraitMethod |
	changeFromLocalToTraitMethod := (self includesLocalSelector: aSelector)
		and: [self hasTraitComposition
				and: [self traitComposition includesMethod: aSelector]].

	changeFromLocalToTraitMethod
		ifFalse: [self basicRemoveSelector: aSelector]
		ifTrue: [self ensureLocalSelectors].
	self deregisterLocalSelector: aSelector.
	self noteChangedSelectors: (Array with: aSelector).
	
	self isTrait ifTrue: [ self notifyUsersOfChangedSelector: aSelector].! !

!TraitBehavior methodsFor: 'initialization' stamp: ''!
obsolete
	"Invalidate and recycle local methods,
	e.g., zap the method dictionary if can be done safely."
	self canZapMethodDictionary
		ifTrue: [self methodDict: self emptyMethodDictionary].
	self hasTraitComposition ifTrue: [
		self traitComposition traits do: [:each |
			each removeUser: self]]! !

!TraitBehavior methodsFor: '*OpalCompiler-Core' stamp: ''!
recompile
	self compileAll! !

!TraitBehavior methodsFor: '*System-Support' stamp: ''!
allCallsOnIn: aSystemNavigation
	"Answer a SortedCollection of all the methods that refer to me by name or as part of an association in a global dict."

	^ (aSystemNavigation 
		allReferencesTo: (self environment associationAt: self theNonMetaClass name)), 
		(aSystemNavigation allCallsOn: self theNonMetaClass name)	! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/3/2013 18:40'!
isTrait
	^true! !

!TraitBehavior methodsFor: 'accessing' stamp: ''!
classDepth

	self superclass ifNil: [^ 1].
	^ self superclass classDepth + 1! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: ''!
isLocalAliasSelector: aSymbol
	"Return true if the selector aSymbol is an alias defined
	in my trait composition."

	^(self includesLocalSelector: aSymbol) not
		and: [self hasTraitComposition
				and: [self traitComposition isLocalAliasSelector: aSymbol]]! !

!TraitBehavior methodsFor: 'compiling' stamp: ''!
variablesAndOffsetsDo: aBinaryBlock
	"This is the interface between the compiler and a class's instance or field names.  The
	 class should enumerate aBinaryBlock with the field definitions (with nil offsets) followed
	 by the instance variable name strings and their integer offsets (1-relative).  The order is
	 important; names evaluated later will override the same names occurring earlier."

	"Only need to do instance variables here.  CProtoObject introduces field definitions."
	self instVarNamesAndOffsetsDo: aBinaryBlock! !

!TraitBehavior methodsFor: 'copying' stamp: ''!
postCopy
	super postCopy.
	self methodDict: self copyOfMethodDictionary! !

!TraitBehavior methodsFor: 'testing' stamp: ''!
sourceMatchesBytecodeAt: selector
	"Answers true if the source code at the selector compiles to the bytecode at the selector, and false
	otherwise. Implemented to detect an error where Monticello did not recompile sources when the class
	shape changed"

	"This code was copied from #recompile:from:, with few changes. Several methods would benefit from a
	method which turned a selector and class into a CompiledMethod, without  installing it into the 
	methodDictionary"

	| method newMethod |

	method := self compiledMethodAt: selector.
	newMethod := self compiler
			source: (self sourceCodeAt: selector);
			class: self;
			failBlock: [^ false];
			compiledMethodTrailer: method trailer;
			compile.   "Assume OK after proceed from SyntaxError"
	selector == newMethod selector ifFalse: [self error: 'selector changed!!!!'].
	^ newMethod = method! !

!TraitBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/4/2013 11:17'!
superclass: aClass 
	"Compatibility purposes"! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/4/2013 11:07'!
users: aCollection
	users := aCollection.! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
compiledMethodAt: selector ifPresent: anotherBlock ifAbsent: aBlock
	"Answer the compiled method associated with the argument, selector (a Symbol), a message selector in the receiver's method dictionary. If the selector is not in the dictionary, return the value of aBlock"

	^ self methodDict at: selector ifPresent: anotherBlock ifAbsent: aBlock! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'NS 3/30/2004 13:26'!
basicLocalSelectors: aSetOrNil
	localSelectors := aSetOrNil! !

!TraitBehavior methodsFor: 'traits' stamp: ''!
traitTransformations 
	^ self traitComposition transformations ! !

!TraitBehavior methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterInstanceVariablesFor: aStep
	<spotterOrder: 20>
	self isTrait ifTrue: [ ^ self ].
	aStep listProcessor
			title: 'Instance variables';
			allCandidates: [ self layout allSlots ];
			itemName: [:each | each name asString];
			filter: GTFilterSubstring! !

!TraitBehavior methodsFor: 'private' stamp: ''!
checkCanBeUncompact 
	"Certain classes cannot be uncompacted in CogVM.  If you download VMMaker and see the VM code, these are as defined by StackInterpreter>>#checkAssumedCompactClasses and the ones that can't be uncompacted are the following: "
	({ Array. LargeNegativeInteger. LargePositiveInteger. Float. Context } includes: self)
		 ifTrue: [ self error: 'Class ', self name, ' cannot be uncompact. ' ]
! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: ''!
canUnderstand: selector
	"Answer whether the receiver can respond to the message whose selector 
	is the argument."

	^ self
		classAndMethodFor: selector
		do: [ :c :m | true ]
		ifAbsent: [ false ].! !

!TraitBehavior methodsFor: 'obsolete subclasses' stamp: ''!
obsoleteSubclasses
	"Return all the weakly remembered obsolete subclasses of the receiver"
	| obs |
	obs := self basicObsoleteSubclasses at: self ifAbsent: [^ #()].
	^ obs copyWithout: nil! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
firstPrecodeCommentFor:  selector
	"If there is a comment in the source code at the given selector that preceeds the body of the method, return it here, else return nil"

	| method |
	"Behavior firstPrecodeCommentFor: #firstPrecodeCommentFor:"
	(#(Comment Definition Hierarchy) includes: selector)
		ifTrue: [^ nil].
	method := self compiledMethodAt: selector asSymbol ifAbsent: [^ nil].
	^method ast firstPrecodeComment.
	! !

!TraitBehavior methodsFor: 'enumerating' stamp: ''!
withAllSuperclassesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the receiver's superclasses."
	aBlock value: self.
	self superclass == nil
		ifFalse: [self superclass withAllSuperclassesDo: aBlock]! !

!TraitBehavior methodsFor: 'traits' stamp: ''!
flattenDown: aTrait
	| selectors |
	[self hasTraitComposition and: [self traitComposition allTraits includes: aTrait]] assert.
	selectors := (self traitComposition transformationOfTrait: aTrait) selectors.
	self basicLocalSelectors: self basicLocalSelectors , selectors.
	self removeFromComposition: aTrait.! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
allSelectorsAbove

	^ self allSelectorsAboveUntil: ProtoObject 
	

! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: ''!
someInstance
	"Primitive. Answer the first instance in the enumeration of all instances 
	of the receiver. Fails if there are none. Essential. See Object 
	documentation whatIsAPrimitive."

	<primitive: 77>
	^nil! !

!TraitBehavior methodsFor: 'testing' stamp: ''!
isCompact

	^self indexIfCompact ~= 0! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
ultimateSourceCodeAt: selector ifAbsent: aBlock
	"Return the source code at selector, deferring to superclass if necessary"
	^ self sourceCodeAt: selector ifAbsent:
		[self superclass
			ifNil:
				[aBlock value]
			 ifNotNil:
				[self superclass ultimateSourceCodeAt: selector ifAbsent: aBlock]]! !

!TraitBehavior methodsFor: 'accessing-properties' stamp: ''!
removeProperty: propName ifAbsent: aBlock
	| property |
	self properties ifNil: [^aBlock value].
	property := self properties
		removeKey: propName
		ifAbsent: aBlock.
	self removePropertiesIfEmpty.
	^ property! !

!TraitBehavior methodsFor: 'copying' stamp: ''!
deepCopy
	"Classes should only be shallowCopied or made anew."

	^ self shallowCopy! !

!TraitBehavior methodsFor: 'testing' stamp: ''!
isMeta
	^ false! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
methodDictionary: aDictionary
	self methodDict: aDictionary! !

!TraitBehavior methodsFor: 'accessing' stamp: ''!
isComposedBy: aTrait
	"Answers if this object includes trait aTrait into its composition"
	aTrait isTrait ifFalse: [ ^false].
	^self hasTraitComposition 
		ifTrue: [ self traitComposition includesTrait: aTrait ]
		ifFalse: [ false ]! !

!TraitBehavior methodsFor: 'enumerating' stamp: ''!
withAllSuperAndSubclassesDo: aBlock
	self allSuperclassesDo: aBlock.
	aBlock value: self.
	self allSubclassesDo: aBlock! !

!TraitBehavior methodsFor: 'testing' stamp: ''!
canZapMethodDictionary
	"Return true if it is safe to zap the method dictionary on #obsolete"
	^true! !

!TraitBehavior methodsFor: '*Tools' stamp: ''!
browseHierarchy
	self systemNavigation browseHierarchy: self! !

!TraitBehavior methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterUsedSlotsFor: aStep
	<spotterOrder: 70>
	aStep listProcessor
			title: 'Special Slots';
			allCandidates: [ self slots select: [ :slot | slot isSpecial ] ];
			itemName: [ :item | item definitionString ];
			filter: GTFilterSubstring! !

!TraitBehavior methodsFor: 'traits' stamp: ''!
flattenDownAllTraits
	self traitComposition allTraits do: [:each | self flattenDown: each].
	[ self traitComposition isEmpty ] assert.
	self traitComposition: nil.! !

!TraitBehavior methodsFor: '*Refactoring-Environment' stamp: ''!
asEnvironment
	^ RBClassEnvironment class: self! !

!TraitBehavior methodsFor: 'instance creation' stamp: ''!
new
	"Answer a new initialized instance of the receiver (which is a class) with no indexable variables. Fail if the class is indexable."

	^ self basicNew initialize
! !

!TraitBehavior methodsFor: 'adding/removing methods' stamp: ''!
addSelectorSilently: selector withMethod: compiledMethod
	self methodDictAddSelectorSilently: selector withMethod: compiledMethod.
	self registerLocalSelector: selector.
	self isTrait ifTrue: [ self notifyUsersOfChangedSelector: selector].! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'NS 1/6/2004 09:02'!
basicLocalSelectors
	"Direct accessor for the instance variable localSelectors.
	Since localSelectors is lazily initialized, this may 
	return nil, which means that all selectors are local."

	^ localSelectors! !

!TraitBehavior methodsFor: 'enumerating' stamp: ''!
selectSubclasses: aBlock 
	"Evaluate the argument, aBlock, with each of the receiver's (next level) 
	subclasses as its argument. Collect into a Set only those subclasses for 
	which aBlock evaluates to true. In addition, evaluate aBlock for the 
	subclasses of each of these successful subclasses and collect into the set 
	those for which aBlock evaluates true. Answer the resulting set."

	| aSet |
	aSet := Set new.
	self allSubclasses do: 
		[:aSubclass | 
		(aBlock value: aSubclass) ifTrue: [aSet add: aSubclass]].
	^aSet! !

!TraitBehavior methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterTraitUsersFor: aStep
	<spotterOrder: 20>
	self isTrait ifFalse: [ ^ self ].
	aStep listProcessor
			title: 'Users';
			allCandidates: [ self traitUsers asArray ];
			itemIcon: #systemIcon;
			filter: GTFilterSubstring! !

!TraitBehavior methodsFor: '*Fuel' stamp: ''!
fuelNew: sizeRequested 
	"Answer an instance of mine in which serialized references will be injected."

	^ self basicNew: sizeRequested! !

!TraitBehavior methodsFor: 'traits' stamp: ''!
setTraitCompositionFrom: aTraitExpression
	^ self setTraitComposition: aTraitExpression asTraitComposition! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
allSelectorsWithout: behaviors
	"Returns all the selectors of the receiver and its superclasses, except the ones define in behaviors"

	| selectors |
	selectors := IdentitySet new.
	self withAllSuperclassesDo: [ :class | 
			(behaviors includes: class)
				ifFalse: [ selectors addAll: class selectors ] ].
	^ selectors! !

!TraitBehavior methodsFor: 'instance creation' stamp: ''!
new: sizeRequested 
	"Answer an initialized instance of this class with the number of indexable
	variables specified by the argument, sizeRequested."

	^ (self basicNew: sizeRequested) initialize  ! !

!TraitBehavior methodsFor: 'obsolete subclasses' stamp: ''!
removeAllObsoleteSubclasses
	"Remove all the obsolete subclasses of the receiver"
	self basicObsoleteSubclasses removeKey: self ifAbsent: [].
! !

!TraitBehavior methodsFor: 'testing class hierarchy' stamp: ''!
includesBehavior: aClass
	
	self isTrait ifTrue: [ ^false ].
	^self == aClass or:[self inheritsFrom: aClass]! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: ''!
instVarNames
	"Answer an Array of the instance variable names. Behaviors must make 
	up fake local instance variable names because Behaviors have instance 
	variables for the purpose of compiling methods, but these are not named 
	instance variables."

	| mySize superSize |
	mySize := self instSize.
	superSize := 
		self superclass == nil
			ifTrue: [0]
			ifFalse: [self superclass instSize].
	mySize = superSize ifTrue: [^#()].	
	^(superSize + 1 to: mySize) collect: [:i | 'inst' , i printString]! !

!TraitBehavior methodsFor: 'adding/removing methods' stamp: ''!
basicAddSelector: selector withMethod: compiledMethod 
	"Add the message selector with the corresponding compiled method to the 
	receiver's method dictionary.
	Do this without sending system change notifications"

	| oldMethodOrNil |	
	oldMethodOrNil := self lookupSelector: selector.
	self methodDict at: selector put: compiledMethod.
	compiledMethod methodClass: self.
	compiledMethod selector: selector.

	"Now flush Pharo's method cache, either by selector or by method"
	oldMethodOrNil ifNotNil: [oldMethodOrNil flushCache].
	selector flushCache.! !

!TraitBehavior methodsFor: 'accessing-properties' stamp: ''!
removeProperty: propName
	^ self
		removeProperty: propName
		ifAbsent: [ nil ]! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
classAndMethodFor: aSymbol do: binaryBlock ifAbsent: absentBlock
	"Looks up the selector aSymbol in the class chain. If it is found, binaryBlock is evaluated
	with the class that defines the selector and the associated method. Otherwise
	absentBlock is evaluated."

	
	self withAllSuperclassesDo: [:class | | method |
		method := class compiledMethodAt: aSymbol ifAbsent: [nil].
		method ifNotNil: [^ binaryBlock value: class value: method].
	].
	^ absentBlock value.! !

!TraitBehavior methodsFor: 'accessing-properties' stamp: 'MarcusDenker 3/2/2015 18:22'!
ensureProperties
	^ TraitProperties at: self ifAbsentPut: WeakKeyDictionary new
		! !

!TraitBehavior methodsFor: 'accessing class hierarchy' stamp: ''!
withAllSubclassesDo: aBlock
	"Evaluate the argument, aBlock, for the receiver and each of its 
	subclasses."
	self withAllSubclasses do: [ :subclass | aBlock value: subclass ].! !

!TraitBehavior methodsFor: 'instance creation' stamp: 'SebastianTleye 7/17/2013 10:08'!
basicNew: sizeRequested 
	self error: 'Traits cannot create instances'.! !

!TraitBehavior methodsFor: '*OpalCompiler-Core' stamp: ''!
compile: code 
	"Compile the argument, code, as source code in the context of the 
	receiver. Create an error notification if the code can not be compiled. 
	The argument is either a string or an object that converts to a string or a 
	PositionableStream on an object that converts to a string."

	^self compile: code notifying: nil! !

!TraitBehavior methodsFor: 'accessing class hierarchy' stamp: ''!
withAllSubclasses
	"Answer a Set of the receiver, the receiver's descendent's, and the  
	receiver's descendent's subclasses."

	^ self allSubclasses add: self;
		 yourself! !

!TraitBehavior methodsFor: 'queries' stamp: ''!
whichSelectorsAssign: instVarName 
	"Answer a Set of selectors whose methods store into the argument, 
	instVarName, as a named instance variable."
	^self whichSelectorsStoreInto: instVarName! !

!TraitBehavior methodsFor: 'initialize-release' stamp: ''!
superclass: aClass methodDictionary: mDict format: fmt
	"Basic initialization of the receiver.
	Must only be sent to a new instance; else we would need Object flushCache."
	self superclass: aClass.
	self setFormat: fmt.
	self methodDict: mDict.
	self traitComposition: nil! !

!TraitBehavior methodsFor: 'testing class hierarchy' stamp: ''!
kindOfSubclass
	"Answer a String that is the keyword that describes the receiver's kind 
	of subclass, either a regular subclass, a variableSubclass, a  
	variableByteSubclass, a variableWordSubclass, or a weakSubclass."
	self isWeak
		ifTrue: [^ ' weakSubclass: '].
	^ self isVariable
		ifTrue: [self isBits
				ifTrue: [self isBytes
						ifTrue: [ ' variableByteSubclass: ']
						ifFalse: [ ' variableWordSubclass: ']]
				ifFalse: [ ' variableSubclass: ']]
		ifFalse: [ ' subclass: ']! !

!TraitBehavior methodsFor: 'queries' stamp: ''!
copiedMethodsFromSuperclass
	"Returns the methods that the receiver copied with its ancestors"
	
	| methods |
	methods := OrderedCollection new.
	self methodsDo: [ :method|
		methods addAll:  (self copiedFromSuperclass: method)].
	^ methods! !

!TraitBehavior methodsFor: '*OpalCompiler-Core' stamp: ''!
compile: code notifying: requestor 
	"Compile the argument, code, as source code in the context of the 
	receiver and insEtall the result in the receiver's method dictionary. The 
	second argument, requestor, is to be notified if an error occurs. The 
	argument code is either a string or an object that converts to a string or 
	a PositionableStream. This method also saves the source code."
	
	| method |
	method  := self compiler
		source: code;
		requestor: requestor;
		failBlock: [ ^nil ];
		compile.
		
	method putSource: code inFile: 2
			withPreamble: [:f | f cr; nextPut: $!!; nextChunkPut: 'Behavior method'; cr].
	self addSelector: method selector withMethod: method notifying: requestor.
	^ method selector! !

!TraitBehavior methodsFor: 'adding/removing methods' stamp: ''!
addSelector: selector withMethod: compiledMethod 
	^ self addSelector: selector withMethod: compiledMethod notifying: nil! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
methods
	
	^ self methodDict values! !

!TraitBehavior methodsFor: '*System-Support' stamp: ''!
allCallsOn: aSymbol
	"Answer a SortedCollection of all the methods that call on aSymbol."

	^ self  systemNavigation allCallsOn: aSymbol from: self .
	! !

!TraitBehavior methodsFor: 'traits' stamp: ''!
traitOrClassOfSelector: aSymbol
	"Return the trait or the class which originally defines the method aSymbol
	or return self if locally defined or if it is a conflict marker method.
	This is primarly used by Debugger to determin the behavior in which a recompiled
	method should be put. If a conflict method is recompiled it should be put into
	the class, thus return self. Also see TraitComposition>>traitProvidingSelector:"
	
	((self includesLocalSelector: aSymbol) or: [
		self hasTraitComposition not]) ifTrue: [^self].
	^(self traitComposition traitProvidingSelector: aSymbol) ifNil: [self]! !

!TraitBehavior methodsFor: 'adding/removing methods' stamp: ''!
methodDictAddSelectorSilently: selector withMethod: compiledMethod
	self basicAddSelector: selector withMethod: compiledMethod! !

!TraitBehavior methodsFor: 'accessing class hierarchy' stamp: ''!
allSubclassesWithLevelDo: classAndLevelBlock startingLevel: level 
	"Walk the tree of subclasses, giving the class and its level"
	| subclassNames |
	classAndLevelBlock value: self value: level.
	self == Class ifTrue:  [^ self].  "Don't visit all the metaclasses"
	"Visit subclasses in alphabetical order"
	subclassNames := SortedCollection new.
	self subclassesDo: [:subC | subclassNames add: subC name].
	subclassNames do:
		[:name | (self environment at: name)
			allSubclassesWithLevelDo: classAndLevelBlock
			startingLevel: level+1]! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
allSelectorsAboveUntil: aRootClass

	| coll |
	coll := IdentitySet new.
	(self allSuperclassesIncluding: aRootClass) 
		do: [:aClass | 
				aClass selectorsDo: [ :sel | coll add: sel ]].
	^ coll
	

! !

!TraitBehavior methodsFor: 'accessing-properties' stamp: 'YuriyTymchuk 10/7/2014 19:24'!
removePropertiesIfEmpty
	^ TraitProperties at: self ifPresent: [ :dict |
		dict ifEmpty: [ TraitProperties removeKey: self ] ]
		! !

!TraitBehavior methodsFor: '*Ring-Core-Kernel' stamp: ''!
protocols
	
	^ self organization categories copy! !

!TraitBehavior methodsFor: 'accessing' stamp: ''!
sharedPoolNames
	^ self sharedPools collect: [:ea |
		ea isObsolete
			ifTrue: [ ea name ]
			ifFalse: [ self environment keyAtIdentityValue: ea ] ]! !

!TraitBehavior methodsFor: 'system startup' stamp: ''!
shutDown: quitting
	"This message is sent on system shutdown to registered classes"
	^self shutDown.! !

!TraitBehavior methodsFor: 'obsolete subclasses' stamp: ''!
allLocalCallsOn: aSymbol
	"Answer a SortedCollection of all the methods that call on aSymbol, anywhere in my class hierarchy."

	^(SystemNavigation new allLocalCallsOn: aSymbol ofClass: (self theNonMetaClass)).
! !

!TraitBehavior methodsFor: 'private' stamp: ''!
flushCache
	"Tell the interpreter to remove the contents of its method lookup cache, if it has 
	one.  Essential.  See Object documentation whatIsAPrimitive."

	<primitive: 89>
	self primitiveFailed! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
sourceCodeAt: selector

	^ (self compiledMethodAt: selector) sourceCode.! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
registerLocalSelector: aSymbol
	self basicLocalSelectors notNil ifTrue: [
		self basicLocalSelectors add: aSymbol]! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
firstCommentAt:  selector
	"Answer a string representing the first comment in the method associated with selector.  Return an empty string if the relevant source file is not available, or if the method's source code does not contain a comment.  Not smart enough to bypass quotes in string constants, but does map doubled quote into a single quote."

	|someComments|
	someComments := self commentsAt: selector.
	^someComments isEmpty ifTrue: [''] ifFalse: [someComments first]


"Behavior firstCommentAt: #firstCommentAt:"! !

!TraitBehavior methodsFor: 'traits' stamp: ''!
addToComposition: aTrait
	self setTraitComposition: (self traitComposition copyTraitExpression
		add: aTrait;
		yourself)! !

!TraitBehavior methodsFor: 'traits' stamp: ''!
applyChangesOfNewTraitCompositionReplacing: oldComposition
	| changedSelectors |
	changedSelectors := self traitComposition
		changedSelectorsComparedTo: oldComposition.
	changedSelectors isEmpty ifFalse: [
		self noteChangedSelectors: changedSelectors].
	self traitComposition isEmpty ifTrue: [
		self purgeLocalSelectors].
	^changedSelectors! !

!TraitBehavior methodsFor: '*Ring-Core-Kernel' stamp: ''!
methodNamed: aSelector

	^ self methodDict at: aSelector! !

!TraitBehavior methodsFor: 'traits' stamp: ''!
addExclusionOf: aSymbol to: aTrait
	self setTraitComposition: (
		self traitComposition copyWithExclusionOf: aSymbol to: aTrait)! !

!TraitBehavior methodsFor: 'cleanup' stamp: ''!
cleanUp: aggressive
	"Clean out any caches and other state that should be flushed when trying to get an image into a pristine state. The argument should be used to indicate how aggressive the cleanup should be. Some subclasses may act differently depending on its value - for example, ChangeSet will only delete all unused and reinitialize the current change set if we're asking it to be aggressive."

	^self cleanUp! !

!TraitBehavior methodsFor: 'traits' stamp: ''!
traitsProvidingSelector: aSymbol
	| result |
	result := OrderedCollection new.
	self hasTraitComposition ifFalse: [^result].
	(self traitComposition methodDescriptionsForSelector: aSymbol)
		do: [:methodDescription | methodDescription selector = aSymbol ifTrue: [
			result addAll: (methodDescription locatedMethods
				collect: [:each | each methodClass])]].
	^result! !

!TraitBehavior methodsFor: '*OpalCompiler-Core' stamp: ''!
compilerClass
	"Answer a compiler class appropriate for source methods of this class."

	^Smalltalk compilerClass! !

!TraitBehavior methodsFor: '*Manifest-Core' stamp: ''!
isManifest
	(self name beginsWith: 'Manifest')
		ifTrue: [ self deprecated: 'Package Manifest should now inherit from PackageManifest class' ].
	^ false! !

!TraitBehavior methodsFor: 'traits' stamp: ''!
removeUser: aClassOrTrait
	self traitUsers remove: aClassOrTrait ifAbsent: []! !

!TraitBehavior methodsFor: 'printing' stamp: ''!
printOn: aStream 
	"Refer to the comment in Object|printOn:." 

	aStream nextPutAll: 'a descendent of '.
	self superclass printOn: aStream! !

!TraitBehavior methodsFor: 'testing' stamp: ''!
isFixed
	"Answer whether the receiver does not have a variable (indexable) part."

	^self isVariable not! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
selectorsAndMethodsDo: selectorAndMethodBlock
	"Evaluate selectorAndMethodBlock with two arguments for each selector/method pair in my method dictionary."

	^ self methodDict keysAndValuesDo: selectorAndMethodBlock! !

!TraitBehavior methodsFor: 'testing' stamp: ''!
isWeak
	"Answer whether the receiver has contains weak references."
	^ self instSpec = 4! !

!TraitBehavior methodsFor: 'enumerating' stamp: ''!
subclassesDo: aBlock
	"Evaluate the argument, aBlock, for each of the receiver's immediate subclasses."
	self subclasses do: aBlock! !

!TraitBehavior methodsFor: 'traits' stamp: ''!
ensureLocalSelectors
	"Ensures that the instance variable localSelectors is effectively used to maintain
	the set of local selectors.
	This method must be called before any non-local selectors are added to the
	method dictionary!!"

	self basicLocalSelectors ifNil: [self basicLocalSelectors: self selectors asSet]! !

!TraitBehavior methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterClassInstanceVariablesFor: aStep
	<spotterOrder: 25>
	self isTrait ifTrue: [ ^ self ].
	aStep listProcessor
			title: 'Class instance variables';
			allCandidates: [ self class layout allSlots ];
			itemName: [:each | each name asString];
			filter: GTFilterSubstring! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
localSelectors
	"Return a set of selectors defined locally.
	The instance variable is lazily initialized. If it is nil then there
	are no non-local selectors"

	^ self basicLocalSelectors 
		ifNil: [self selectors asSet]
		ifNotNil: [self basicLocalSelectors].! !

!TraitBehavior methodsFor: 'printing' stamp: ''!
storeLiteral: aCodeLiteral on: aStream
	"Store aCodeLiteral on aStream, changing an Association to ##GlobalName
	 or ###MetaclassSoleInstanceName format if appropriate"
	| key value |
	(aCodeLiteral isVariableBinding)
		ifFalse:
			[aCodeLiteral storeOn: aStream.
			 ^self].
	key := aCodeLiteral key.
	(key isNil and: [(value := aCodeLiteral value) isMemberOf: Metaclass])
		ifTrue:
			[aStream nextPutAll: '###'; nextPutAll: value soleInstance name.
			 ^self].
	(key isSymbol and: [(self bindingOf: key) notNil])
		ifTrue:
			[aStream nextPutAll: '##'; nextPutAll: key.
			 ^self].
	aCodeLiteral storeOn: aStream! !

!TraitBehavior methodsFor: 'accessing' stamp: ''!
realClass

	^ self! !

!TraitBehavior methodsFor: '*OpalCompiler-Core' stamp: ''!
recompile: selector
	"Compile the method associated with selector in the receiver's method dictionary."
	^self recompile: selector from: self! !

!TraitBehavior methodsFor: '*Fuel' stamp: ''!
fuelIgnoredInstanceVariableNames
	"Indicates which variables have to be ignored during serialization."

	^#()! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: ''!
thoroughWhichSelectorsReferTo: literal special: specialFlag byte: specialByte
	"Answer a set of selectors whose methods access the argument as a 
	literal. Dives into the compact literal notation, making it slow but 
	thorough "
	| selectors |
	selectors := IdentitySet new.
	self selectorsAndMethodsDo: 
		[ :sel :method |
			((self isTrait ifTrue: [method hasLiteralThorough: literal]
				     		 ifFalse: [method refersToLiteral: literal]) or: [specialFlag and: [method scanFor: specialByte]]) ifTrue: [selectors add: sel]].
	^ selectors! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
allSelectorsBelow: topClass 
	| coll |
	coll := IdentitySet new.
	self withAllSuperclassesDo: 
			[:aClass | 
			aClass = topClass
				ifTrue: [^ coll ]
				ifFalse: [aClass selectorsDo: [ :sel | coll add: sel ]]].
	^ coll
	

! !

!TraitBehavior methodsFor: 'adding/removing methods' stamp: ''!
basicRemoveSelector: selector 
	"Assuming that the argument, selector (a Symbol), is a message selector 
	in my method dictionary, remove it and its method."

	| oldMethod |
	oldMethod := self methodDict at: selector ifAbsent: [^ self].
	self methodDict removeKey: selector.

	"Now flush the method cache"
	oldMethod flushCache.
	selector flushCache.! !

!TraitBehavior methodsFor: '*OpalCompiler-Core' stamp: ''!
compiler
	"Answer a compiler appropriate for source methods of this class."

	^self compilerClass new
		environment: self environment;
		class: self! !

!TraitBehavior methodsFor: 'user interface' stamp: ''!
unreferencedInstanceVariables
	"Return a list of the instance variables defined in the receiver which are not referenced in the receiver or any of its subclasses."

	^ self instVarNames reject: [:ivn | 
		self withAllSubclasses anySatisfy: [:class | 
			(class whichSelectorsAccess: ivn) notEmpty]]! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: ''!
isAliasSelector: aSymbol
	"Return true if the selector aSymbol is an alias defined
	in my or in another composition somewhere deeper in 
	the tree of traits compositions."

	^(self includesLocalSelector: aSymbol) not
		and: [self hasTraitComposition
				and: [self traitComposition isAliasSelector: aSymbol]]! !

!TraitBehavior methodsFor: 'accessing' stamp: ''!
typeOfClass
	"Answer a symbol uniquely describing the type of the receiver"
	self instSpec = CompiledMethod instSpec ifTrue:[^#compiledMethod]. "Very special!!"
	self isBytes ifTrue:[^#bytes].
	(self isWords and:[self isPointers not]) ifTrue:[^#words].
	self isWeak ifTrue:[^#weak].
	self isVariable ifTrue:[^#variable].
	^#normal.! !

!TraitBehavior methodsFor: 'testing class hierarchy' stamp: ''!
inheritsFrom: aClass 
	"Answer whether the argument, aClass, is on the receiver's superclass 
	chain."

	| aSuperclass |
	aSuperclass := self superclass.
	[aSuperclass == nil]
		whileFalse: 
			[aSuperclass == aClass ifTrue: [^true].
			aSuperclass := aSuperclass superclass].
	^false! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
allMethods
	"Return the collection of compiled method I and my superclasses are defining"
	"asArray is used to not bump into a bug when comparing compiled methods."
	
	^ self allSelectors asArray collect: [ :s | self lookupSelector: s ]! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
sourceCodeAt: selector ifAbsent: aBlock

	^ (self compiledMethodAt: selector ifAbsent: [^ aBlock value]) sourceCode.! !

!TraitBehavior methodsFor: 'traits' stamp: ''!
removeAlias: aSymbol of: aTrait
	self setTraitComposition: (
		self traitComposition copyWithoutAlias: aSymbol of: aTrait)! !

!TraitBehavior methodsFor: 'traits' stamp: ''!
traits
	"Returns a collection of all traits used by the receiver"
	^ self traitComposition traits! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: ''!
includesLocalSelector: aSymbol
	^self basicLocalSelectors 
		ifNil: [self includesSelector: aSymbol]
		ifNotNil: [self localSelectors includes: aSymbol]! !

!TraitBehavior methodsFor: '*Tools' stamp: ''!
browse

	^  Smalltalk tools browser fullOnClass: self! !

!TraitBehavior methodsFor: 'traits' stamp: ''!
notifyUsersOfChangedSelector: aSelector
	self notifyUsersOfChangedSelectors: (Array with: aSelector)! !

!TraitBehavior methodsFor: 'testing' stamp: ''!
isBytes
	"Answer whether the receiver has 8-bit instance variables."

	^ self instSpec >= 8! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: ''!
allClassVarNames
	"Answer a Set of the names of the receiver's and the receiver's ancestor's 
	class variables."

	^self superclass allClassVarNames! !

!TraitBehavior methodsFor: 'testing' stamp: ''!
isVariable
	"Answer whether the receiver has indexable variables."

	^ self instSpec >= 2! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/1/2013 17:54'!
bindingOf: varName
	
	"Answer the binding of some variable resolved in the scope of the receiver"

	^ self environment bindingOf: varName asSymbol.! !

!TraitBehavior methodsFor: 'queries' stamp: ''!
whichClassDefinesInstVar: aString 
	^self 
		whichSuperclassSatisfies: [:aClass | aClass instVarNames includes: aString]! !

!TraitBehavior methodsFor: 'traits' stamp: ''!
traitCompositionString
	^self hasTraitComposition
		ifTrue: [self traitComposition asString]
		ifFalse: ['{}']! !

!TraitBehavior methodsFor: 'testing' stamp: ''!
isWords
	"Answer true if the receiver is made of 32-bit instance variables."

	^self isBytes not! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
nextQuotePosIn: sourceString startingFrom: commentStart
	| pos nextQuotePos |
	pos := commentStart + 1.
	[((nextQuotePos := sourceString findString: '"' startingAt: pos) == (sourceString findString: '""' startingAt: pos)) and: [nextQuotePos ~= 0]]
		whileTrue:
			[pos := nextQuotePos + 2].
	^nextQuotePos! !

!TraitBehavior methodsFor: '*Tools' stamp: ''!
inspectSubInstances 
	"Inspect all instances of the receiver and all its subclasses.  CAUTION - don't do this for something as generic as Object!!"

	| all allSize prefix |
	all := self allSubInstances.
	(allSize := all size) isZero ifTrue: [^ self inform: 'There are no 
instances of ', self name, '
or any of its subclasses'].
	prefix := allSize = 1
		ifTrue: 	['The lone instance']
		ifFalse:	['The ', allSize printString, ' instances'].
	
	all asArray inspectWithLabel: (prefix, ' of ', self name, ' & its subclasses')! !

!TraitBehavior methodsFor: 'memory usage' stamp: ''!
instancesSizeInMemory
	"Answers the number of bytes consumed by all its instances including their object header"
	
	| bytes |
	bytes := 0.
	self allInstancesDo: [:each | bytes := bytes + each sizeInMemory  ].
	^ bytes! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: ''!
whichSelectorsReferTo: literal 
	"Answer a Set of selectors whose methods access the argument as a
literal."

	| special byte |
	special := Smalltalk hasSpecialSelector: literal ifTrueSetByte: [:b |
byte := b].
	^self whichSelectorsReferTo: literal special: special byte: byte

	"Rectangle whichSelectorsReferTo: #+."! !

!TraitBehavior methodsFor: 'private' stamp: ''!
indexIfCompact
	"If these 5 bits are non-zero, then instances of this class
	will be compact.  It is crucial that there be an entry in
	Smalltalk compactClassesArray for any class so optimized.
	See the msgs becomeCompact and becomeUncompact."
	^ (self format bitShift: -11) bitAnd: 16r1F


"
Array indexIfCompact

Verify if the compactClassesArray and indexIfCompact are coheren
Smalltalk compactClassesArray doWithIndex: 
	[:c :i | c == nil ifFalse:
		[c indexIfCompact = i ifFalse: [self halt]]]
"! !

!TraitBehavior methodsFor: '*Tools' stamp: ''!
inspectAllInstances 
	"Inspect all instances of the receiver."

	| all allSize prefix |
	all := self allInstances.
	(allSize := all size) isZero ifTrue: [^ self inform: 'There are no 
instances of ', self name].
	prefix := allSize = 1
		ifTrue: 	['The lone instance']
		ifFalse:	['The ', allSize printString, ' instances'].
	
	all asArray inspectWithLabel: (prefix, ' of ', self name)! !

!TraitBehavior methodsFor: 'cleanup' stamp: ''!
cleanUp
	"Clean out any caches and other state that should be flushed when trying to get an image into a pristine state. Subclasses may override #cleanUp: to provide different levels of cleanliness"
! !

!TraitBehavior methodsFor: 'private' stamp: ''!
becomeUncompact
	"The inverse of #becomeCompact. However, some classes can not be uncompact see #checkCanBeUncompact."

	| compactClassesArray index |
	compactClassesArray := Smalltalk compactClassesArray.
	(index := self indexIfCompact) = 0
		ifTrue: [^ self].
	self assert:[compactClassesArray includes: self].
	self checkCanBeUncompact.

	"Update instspec so instances will be compact. 
	The layout has the responsibility for setting the format."
	self layout compactClassIndex: 0.
	
	"Make up new instances and become old ones into them"
	self updateInstancesFrom: self.
	"Make sure there are no compact ones left around"
	Smalltalk garbageCollect.
	"Remove this class from the compact class table"
	compactClassesArray at: index put: nil.
! !

!TraitBehavior methodsFor: 'accessing' stamp: ''!
allSlots
	^#()! !

!TraitBehavior methodsFor: 'accessing' stamp: ''!
binding
	^ nil -> self! !

!TraitBehavior methodsFor: 'obsolete subclasses' stamp: ''!
addObsoleteSubclass: aClass
	"Weakly remember that aClass was a subclass of the receiver and is now obsolete"
	| obs |

	obs := self basicObsoleteSubclasses at: self ifAbsent:[WeakArray new].
	(obs includes: aClass) ifTrue:[^self].
	obs := obs copyWithout: nil.
	obs := obs copyWith: aClass.
	self basicObsoleteSubclasses at: self put: obs.! !

!TraitBehavior methodsFor: 'testing' stamp: ''!
hasAbstractMethods
	"Tells whether the receiver locally defines an abstract method, i.e., a method sending subclassResponsibility"
	
	^ (self methods anySatisfy: [:cm | cm sendsSelector: #subclassResponsibility ])! !

!TraitBehavior methodsFor: 'traits' stamp: ''!
notifyUsersOfChangedSelectors: aCollection! !

!TraitBehavior methodsFor: 'naming' stamp: 'MarcusDenker 9/9/2013 09:28'!
name
	^ self subclassResponsibility.! !

!TraitBehavior methodsFor: 'queries' stamp: ''!
allMethodsAccessingSlot: aSlot
	"return all methods that access aSlot in this class and subclasses"
	^self withAllSubclasses flatCollect: [ :class |
		class methodsAccessingSlot: aSlot.
	]! !

!TraitBehavior methodsFor: 'accessing-properties' stamp: ''!
propertyValueAt: propName ifAbsent: aBlock
	self properties ifNil: [^aBlock value].
	^ self properties
		at: propName
		ifAbsent: aBlock
		! !

!TraitBehavior methodsFor: '*Fuel' stamp: ''!
fuelNew
	"Answer an instance of mine in which serialized references will be injected."

	^ self basicNew! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
selectorsWithArgs: numberOfArgs
	"Return all selectors defined in this class that take this number of arguments"

	^ self selectors select: [:selector | selector numArgs = numberOfArgs]! !

!TraitBehavior methodsFor: 'traits' stamp: 'NicolaiHess 11/27/2014 23:11'!
traitUsers: aCollection
	users := aCollection.! !

!TraitBehavior methodsFor: 'testing' stamp: ''!
instSpec
	^ (self format bitShift: -7) bitAnd: 16rF! !

!TraitBehavior methodsFor: 'traits' stamp: ''!
traitCompositionIncludes: aTrait
	^self == aTrait or: 
		[self hasTraitComposition and: 
			[self traitComposition allTraits includes: aTrait]]! !

!TraitBehavior methodsFor: '*OpalCompiler-Core' stamp: 'MarcusDenker 7/23/2014 16:49'!
recompile: selector from: oldClass
	"Compile the method associated with selector in the receiver's method dictionary."

	| method methodNode |
	method := oldClass compiledMethodAt: selector.
	methodNode := self compiler
				source: (oldClass sourceCodeAt: selector);
				failBlock:  [^ self];
				translate.
	selector == methodNode selector ifFalse: [self error: 'selector changed!!'].
	self basicAddSelector: selector withMethod: (methodNode generate: method trailer).
	self notifyUsersOfChangedSelector: selector.
! !

!TraitBehavior methodsFor: 'copying' stamp: ''!
copyOfMethodDictionary
	"Return a copy of the receiver's method dictionary"

	^ self methodDict copy! !

!TraitBehavior methodsFor: 'queries' stamp: ''!
methodsReadingSlot: aSlot
	^self methods select: [ :method | method readsSlot: aSlot ]! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: ''!
thoroughHasSelectorReferringTo: literal special: specialFlag byte: specialByte
	"Answer true if any of my methods access the argument as a 
	literal. Dives into the compact literal notation, making it slow but 
	thorough "

	
	self methodsDo: [ :method |
		((method hasLiteralThorough: literal) or: [specialFlag and: [method scanFor: specialByte]])
			ifTrue: [^true]].
	^false! !

!TraitBehavior methodsFor: 'naming' stamp: ''!
environment
	"Return the environment in which the receiver is visible"
	^Smalltalk globals! !

!TraitBehavior methodsFor: 'traits' stamp: ''!
updateMethodDictionarySelector: aSymbol
	"A method with selector aSymbol in myself or my traitComposition has been changed.
	Do the appropriate update to my methodDict (remove or update method) and
	return all affected selectors of me so that my useres get notified."

	| modifiedSelectors descriptions oldProtocol |
	modifiedSelectors := IdentitySet new.
	descriptions := self traitComposition methodDescriptionsForSelector: aSymbol.
	descriptions do: [:methodDescription | | effectiveMethod selector |
		selector := methodDescription selector.
		(self includesLocalSelector: selector) ifFalse: [
			methodDescription isEmpty
				ifTrue: [
					self removeTraitSelector: selector.
					modifiedSelectors add: selector]
				ifFalse: [
					effectiveMethod := methodDescription effectiveMethod.
					self addTraitSelector: selector withMethod: effectiveMethod.
					
					"If the method was not categorized yet, we categorize it "
					oldProtocol := self organization categoryOfElement: selector.
					(oldProtocol isNil or: [ oldProtocol = Protocol unclassified ]) 
						ifTrue: [ self organization classify: selector under: methodDescription effectiveMethodCategory. ].
					
					modifiedSelectors add: selector]]].
	^modifiedSelectors! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
lookupSelector: selector
	"Look up the given selector in my methodDictionary.
	Return the corresponding method if found.
	Otherwise chase the superclass chain and try again.
	Return nil if no method is found."
	| lookupClass |
	lookupClass := self.
	[lookupClass == nil]
		whileFalse: 
			[(lookupClass includesSelector: selector)
				ifTrue: [^ lookupClass compiledMethodAt: selector].
			lookupClass := lookupClass superclass].
	^ nil! !

!TraitBehavior methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterCompositionFor: aStep
	<spotterOrder: 25>
	aStep listProcessor
			title: 'Composing traits';
			allCandidates: [ self traitComposition allTraits ];
			itemIcon: #systemIcon;
			filter: GTFilterSubstring! !

!TraitBehavior methodsFor: 'obsolete subclasses' stamp: 'SebastianTleye 7/5/2013 17:46'!
basicObsoleteSubclasses
	^WeakKeyToCollectionDictionary new.! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: ''!
classVarNames
	"Answer a collection of the receiver's class variable names."

	^#()! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: ''!
whichSelectorsAccess: instVarName 
	"Answer a set of selectors whose methods access the argument, 
	instVarName, as a named instance variable."

	| instVarIndex |
	instVarIndex := self instVarIndexFor: instVarName ifAbsent: [^IdentitySet new].
	^ self selectors select:  [:sel | 
		((self compiledMethodAt: sel)
			readsField: instVarIndex)
			or: [(self compiledMethodAt: sel) writesField: instVarIndex]]! !

!TraitBehavior methodsFor: 'initialize-release' stamp: ''!
nonObsoleteClass
	"Attempt to find and return the current version of this obsolete class"

	| obsName |
	obsName := self name.
	[obsName beginsWith: 'AnObsolete']
		whileTrue: [obsName := obsName copyFrom: 'AnObsolete' size + 1 to: obsName size].
	^ self environment at: obsName asSymbol! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'NS 12/9/2003 10:51'!
methodDict
	^ methodDict! !

!TraitBehavior methodsFor: 'accessing class hierarchy' stamp: ''!
allSubclasses
	"Answer an orderedCollection of the receiver's and the receiver's descendent's subclasses. "

	| scan scanTop |
	scan := OrderedCollection withAll: self subclasses.
	scanTop := 1.
	[scanTop > scan size]
		whileFalse: [scan addAll: (scan at: scanTop) subclasses.
			scanTop := scanTop + 1].
	^ scan! !

!TraitBehavior methodsFor: 'accessing class hierarchy' stamp: ''!
withAllSuperclasses
	"Answer an OrderedCollection of the receiver and the receiver's 
	superclasses. The first element is the receiver, 
	followed by its superclass; the last element is Object."

	| temp |
	temp := self allSuperclasses.
	temp addFirst: self.
	^ temp! !

!TraitBehavior methodsFor: 'traits' stamp: ''!
removeTraitSelector: aSymbol
	[(self includesLocalSelector: aSymbol) not] assert.
	self basicRemoveSelector: aSymbol! !

!TraitBehavior methodsFor: 'class compatibility' stamp: 'NS 4/12/2004 14:34'!
subclassDefinerClass
	^nil subclassDefinerClass ! !

!TraitBehavior methodsFor: '*Rpackage-Core' stamp: ''!
originalName
	^ ((self isObsolete and: [ self name beginsWith: 'AnObsolete' ])
		ifTrue: [ (self name copyFrom:   'AnObsolete' size + 1 to: self name size ) ]
		ifFalse:  [ self name ]) asSymbol! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
precodeCommentOrInheritedCommentFor: selector 
	"Answer a string representing the first comment in the method associated 
	with selector, considering however only comments that occur before the 
	beginning of the actual code. If the version recorded in the receiver is 
	uncommented, look up the inheritance chain. Return nil if none found."
	
	| aSuper aComment |
	^ (aComment := self firstPrecodeCommentFor: selector) isEmptyOrNil
		ifTrue: [(self == Behavior
					or: [self superclass == nil
							or: [(aSuper := self superclass whichClassIncludesSelector: selector) == nil]])
				ifFalse: [aSuper precodeCommentOrInheritedCommentFor: selector]]
		ifFalse: [aComment]! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'NS 12/9/2003 10:50'!
methodDict: aDictionary
	methodDict := aDictionary! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: ''!
whichClassIncludesSelector: aSymbol 
	"Answer the class on the receiver's superclass chain where the 
	argument, aSymbol (a message selector), will be found. Answer nil if none found."
	"Rectangle whichClassIncludesSelector: #inspect."
	(self includesSelector: aSymbol)
		ifTrue: [^ self].
	self superclass == nil
		ifTrue: [^ nil].
	^ self superclass whichClassIncludesSelector: aSymbol! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: ''!
whichSelectorsStoreInto: instVarName 
	"Answer a Set of selectors whose methods access the argument, 
	instVarName, as a named instance variable."
	| instVarIndex |
	instVarIndex := self instVarIndexFor: instVarName ifAbsent: [^IdentitySet new].
	^ self selectors select: [:sel | (self compiledMethodAt: sel) writesField: instVarIndex]

	"Point whichSelectorsStoreInto: 'x'."! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
compiledMethodAt: selector 
	"Answer the compiled method associated with the argument, selector (a 
	Symbol), a message selector in the receiver's method dictionary. If the 
	selector is not in the dictionary, create an error notification."

	^ self methodDict at: selector! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
>> selector 
	"Answer the compiled method associated with the argument, selector (a 
	Symbol), a message selector in the receiver's method dictionary. If the 
	selector is not in the dictionary, create an error notification."

	^self compiledMethodAt: selector
! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
selectors
	"Answer a Set of all the message selectors specified in the receiver's 
	method dictionary."

	^ self methodDict keys! !

!TraitBehavior methodsFor: 'enumerating' stamp: ''!
selectSuperclasses: aBlock 
	"Evaluate the argument, aBlock, with the receiver's superclasses as the 
	argument. Collect into an OrderedCollection only those superclasses for 
	which aBlock evaluates to true. In addition, evaluate aBlock for the 
	superclasses of each of these successful superclasses and collect into the 
	OrderedCollection ones for which aBlock evaluates to true. Answer the 
	resulting OrderedCollection."

	| aSet |
	aSet := Set new.
	self allSuperclasses do: 
		[:aSuperclass | 
		(aBlock value: aSuperclass) ifTrue: [aSet add: aSuperclass]].
	^aSet! !

!TraitBehavior methodsFor: 'private' stamp: ''!
spaceUsed
	"Answer a rough estimate of number of bytes used by this class and its metaclass. Does not include space used by class variables."

	| space |
	space := 0.
	self methodsDo: [:method  |
		space := space + 16.  "dict and org'n space"
		space := space + (method size + 6 "hdr + avg pad").
		method literalsDo: [:lit |
			(lit isMemberOf: Array) ifTrue: [space := space + ((lit size + 1) * 4)].
			(lit isMemberOf: Float) ifTrue: [space := space + 12].
			(lit isMemberOf: ByteString) ifTrue: [space := space + (lit size + 6)].
			(lit isMemberOf: LargeNegativeInteger) ifTrue: [space := space + ((lit size + 1) * 4)].
			(lit isMemberOf: LargePositiveInteger) ifTrue: [space := space + ((lit size + 1) * 4)]]].
		^ space! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: ''!
selectorsDo: selectorBlock
	"Evaluate selectorBlock for all the message selectors in my method dictionary."

	^ self methodDict keysDo: selectorBlock! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: ''!
includesSharedPoolNamed:  aSharedPoolString 
	"Answer whether the receiver uses the shared pool named aSharedPoolString"
	
	^ (self sharedPools anySatisfy: [:each | each name = aSharedPoolString])! !

!TraitBehavior class methodsFor: 'initialization' stamp: 'YuriyTymchuk 10/8/2014 11:42'!
initialize

	TraitProperties
		ifNil: [ TraitProperties := WeakIdentityKeyDictionary new ]
		ifNotNil: [ | newDict | 
			newDict := WeakIdentityKeyDictionary newFrom: TraitProperties.
			newDict rehash.
			TraitProperties := newDict ]! !

!TraitBehavior class methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
gtExampleTraitUsers
	<gtExample: 'Trait Users'>
	^ TBehavior! !

!TraitBehavior class methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
gtExampleAllSubclasses
	<gtExample: 'All Subclasses'>
	^ Object! !

!TraitBehavior class methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
gtExampleSuperclasses
	<gtExample: 'Superclasses'>
	^ Metaclass! !

!TraitBehavior class methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
gtExampleClassVariables
	<gtExample: 'Class Variables'>
	^ Behavior! !

!TraitBehavior class methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
gtExampleInstanceVariables
	<gtExample: 'Instance Variables'>
	^ ClassDescription! !

!TraitBehavior class methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
gtExampleTraits
	<gtExample: 'Traits'>
	^ Class! !

!TraitBehavior class methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
gtExampleTraitComposition
	<gtExample: 'Trait Composition'>
	^ Class! !

!TraitComposition commentStamp: '<historical>'!
I hold a collection of trait transformations and provide important facilities to query the trait composition. For each trait in the composition clause there exists exactly one transformation in the collection.

Note, that directly manipulating the composition of a class or trait does not effect changes automatically. Use PureBehavior>>setTraitComposition: to do this. You have to make a copy of the old trait composition before changing it because only the difference between the new and the old composition is updated!!!
!TraitComposition methodsFor: 'converting' stamp: 'al 1/18/2004 19:35'!
asTraitComposition
	^self! !

!TraitComposition methodsFor: 'composition' stamp: 'al 4/10/2004 00:08'!
normalizeTransformations
	self transformations: (
		self transformations collect: [:each |
			each normalized])! !

!TraitComposition methodsFor: 'accessing' stamp: 'al 3/17/2004 19:34'!
transformations
	^transformations! !

!TraitComposition methodsFor: 'enquiries' stamp: 'SebastianTleye 7/19/2013 16:02'!
allSelectors
	^ Array streamContents: [ :stream | 
		self transformations do: [ :transformation | stream nextPutAll: transformation allSelectors ]]! !

!TraitComposition methodsFor: 'accessing' stamp: 'al 4/13/2004 15:30'!
traits
	^self transformations collect: [:each |
		each trait]! !

!TraitComposition methodsFor: 'alias' stamp: 'EstebanLorenzano 1/15/2013 18:56'!
originSelectorOf: aSelector
 
	self isEmpty ifTrue: [ ^ aSelector ].
	self transformations do:[ :transformation | 
		transformation allAliasesDict 
			at: aSelector ifPresent: [:value | ^ value ]].
		
	^aSelector! !

!TraitComposition methodsFor: 'error-handling' stamp: 'al 3/17/2004 15:22'!
errorIfNotAddable: aTraitTransformation
	(self includesTrait: aTraitTransformation trait) ifTrue: [
		^TraitCompositionException
			signal: 'Trait ' , aTraitTransformation trait asString, ' already in composition']! !

!TraitComposition methodsFor: 'composition' stamp: 'apb 8/22/2005 17:52'!
+ aTraitExpression
	^ aTraitExpression addCompositionOnLeft: self.
! !

!TraitComposition methodsFor: 'initialization' stamp: 'al 3/12/2004 17:06'!
initialize
	super initialize.
	transformations := OrderedCollection new! !

!TraitComposition methodsFor: 'composition' stamp: 'ST 6/5/2013 17:11'!
- anArray
	"the modifier operators #@ and #- bind stronger than +"
	
	self transformations: (self transformations collect: [ :t | t - anArray ])! !

!TraitComposition methodsFor: 'error-handling' stamp: 'al 3/18/2004 14:19'!
assertValidUser: aBehavior
	"Assert that this trait composition set for aBehavior
	does not introduce a cycle."
	
	(self allTraits includes: aBehavior) ifTrue: [
		TraitCompositionException signal: 'Cycle in compositions:  The composition (in)directly includes this trait!!']! !

!TraitComposition methodsFor: 'enquiries' stamp: 'nice 1/5/2010 15:59'!
changedSelectorsComparedTo: oldComposition
	| changedSelectors traits |
	changedSelectors := IdentitySet new.
	traits := self traits asIdentitySet addAll: oldComposition traits asIdentitySet; yourself.
	traits do: [:each | | oldTransformation newTransformation |
		newTransformation := self transformationOfTrait: each.
		oldTransformation := oldComposition transformationOfTrait: each.
		(newTransformation isNil or: [oldTransformation isNil])
			ifTrue: [
				changedSelectors addAll: each selectors]
			ifFalse: [
				changedSelectors addAll: 
					(newTransformation changedSelectorsComparedTo: oldTransformation)]].
	^changedSelectors! !

!TraitComposition methodsFor: 'accessing' stamp: 'al 3/18/2004 14:10'!
add: aTraitTransformation
	self errorIfNotAddable: aTraitTransformation.
	self transformations addLast: aTraitTransformation! !

!TraitComposition methodsFor: 'enquiries' stamp: 'al 7/21/2004 21:03'!
methodDescriptionsForSelector: aSymbol
	"Return a collection of TraitMethodDescriptions for aSymbol and all the 
	aliases of aSymbol."

	| selectors collection |
	selectors := IdentitySet with: aSymbol.
	self transformations do: [:each |
		selectors addAll: (each aliasesForSelector: aSymbol)].
	collection := OrderedCollection new: selectors size.
	selectors do: [:each |
		collection add: (self methodDescriptionForSelector: each)].
	^collection! !

!TraitComposition methodsFor: 'printing' stamp: 'SebastianTleye 7/2/2013 16:13'!
printOn: aStream
	
	self transformations isEmptyOrNil
		ifFalse: [
			
			"The first element does not need parenthesis"
			aStream nextPutAll: (self transformations at: 1) asString.
			(self transformations size > 1) ifTrue: [ aStream nextPutAll: ' + '].
			
			"The rest of the elements either need or not parenthesis depending if they are trait compositions or traits"
			(self transformations allButFirst)
				do: [:each | aStream nextPutAll: (each isTrait 
														ifTrue: [ each asString]
														ifFalse: [ '(', each asString, ')' ])]										 
				separatedBy: [aStream nextPutAll: ' + '] ]
			
		ifTrue: [aStream nextPutAll: '{}']! !

!TraitComposition methodsFor: 'printing' stamp: 'al 12/16/2003 22:16'!
printString
	^String streamContents: [:stream |
		self printOn: stream]! !

!TraitComposition methodsFor: 'accessing' stamp: 'al 3/7/2004 22:31'!
transformationOfTrait: aTrait
	"Return the transformation which holds aTrait
	or nil if this composition doesn't include aTrait."
	
	^self transformations
		detect: [:each | each trait = aTrait]
		ifNone: [nil]! !

!TraitComposition methodsFor: 'composition' stamp: 'ST 6/5/2013 17:12'!
@ anArrayOfAssociations
	"the modifier operators #@ and #- bind stronger than +"

	self transformations: (self transformations collect: [ :t | t @ anArrayOfAssociations ]).! !

!TraitComposition methodsFor: 'enquiries' stamp: 'al 7/21/2004 21:03'!
methodDescriptionForSelector: aSymbol
	"Return a TraitMethodDescription for the selector aSymbol."

	| description |
	description := TraitMethodDescription selector: aSymbol.
	self transformations do: [:each |
		each collectMethodsFor: aSymbol into: description].
	^description! !

!TraitComposition methodsFor: 'comparing' stamp: 'MartinDias 1/23/2014 15:17'!
syntacticallyEquals: aTraitComposition
	"Test syntactic equivalence of this trait composition with another. 
	The order of the transformations is taken into account. For example, A + B ~= B + A."

	self == aTraitComposition ifTrue: [ ^ true ].
	self species = aTraitComposition species ifFalse: [ ^ false ].
	self transformations size = aTraitComposition transformations size ifFalse: [ ^ false ].
	
	self transformations with: aTraitComposition transformations do: [ :mine :their | 
		(mine syntacticallyEquals: their) ifFalse: [ ^ false ] ].

	^ true! !

!TraitComposition methodsFor: 'enquiries' stamp: 'MarianoMartinezPeck 6/26/2012 10:39'!
traitProvidingSelector: aSymbol
	"Return the trait which originally provides the method aSymbol or return nil
	if trait composition does not provide this selector or there is a conflict.
	Take aliases into account. Return the trait which the aliased method is defined in."

	| methodDescription locatedMethod |
	methodDescription := self methodDescriptionForSelector: aSymbol.
	(methodDescription isProvided not or: [methodDescription isConflict])	
		ifTrue: [^nil].
	locatedMethod := methodDescription providedLocatedMethod.
	^locatedMethod methodClass traitOrClassOfSelector: locatedMethod selector! !

!TraitComposition methodsFor: 'accessing' stamp: 'al 1/18/2004 19:29'!
size
	^transformations size! !

!TraitComposition methodsFor: 'private' stamp: 'al 7/30/2004 15:50'!
includesMethod: aSelector
	^(self methodDescriptionForSelector: aSelector) isEmpty not! !

!TraitComposition methodsFor: 'private' stamp: 'al 3/6/2004 19:05'!
isEmpty
	^self transformations isEmpty! !

!TraitComposition methodsFor: 'composition' stamp: 'apb 8/22/2005 17:28'!
addOnTheLeft: aTrait 
	self errorIfNotAddable: aTrait.
	self transformations addFirst: aTrait! !

!TraitComposition methodsFor: 'testing' stamp: 'al 3/19/2004 10:30'!
transformations: aCollection
	transformations := aCollection! !

!TraitComposition methodsFor: 'copying' stamp: 'nice 1/13/2010 22:04'!
copy
	self error: 'should not be called'.
	^super copy! !

!TraitComposition methodsFor: 'private' stamp: 'al 1/18/2004 19:32'!
includesTrait: aTrait
	^self traits includes: aTrait! !

!TraitComposition methodsFor: 'private' stamp: 'al 3/6/2004 19:05'!
notEmpty
	^self isEmpty not! !

!TraitComposition methodsFor: 'accessing' stamp: 'al 3/26/2006 22:03'!
allTraits
	^self traits gather: [:trait |
		trait hasTraitComposition
			ifTrue: [trait traitComposition allTraits copyWith: trait]
			ifFalse: [Array with: trait]]! !

!TraitComposition methodsFor: 'copying' stamp: 'stephane.ducasse 4/13/2009 20:32'!
copyTraitExpression
	| newCopy |
	newCopy := self shallowCopy.
	newCopy transformations: (self transformations collect: [ :each | each copyTraitExpression ]).
	^ newCopy
! !

!TraitComposition methodsFor: 'accessing' stamp: 'al 4/9/2004 17:12'!
removeFromComposition: aTrait
	self remove:
		(self transformationOfTrait: aTrait)! !

!TraitComposition methodsFor: 'private' stamp: 'al 4/10/2004 23:34'!
isLocalAliasSelector: aSymbol
	"Return true if the selector aSymbol is an alias defined
	in this composition."

	| methodDescription |
	methodDescription := (self methodDescriptionsForSelector: aSymbol)
		detect: [:each | each selector = aSymbol].
	^methodDescription isLocalAliasSelector! !

!TraitComposition methodsFor: 'copying' stamp: 'nice 1/13/2010 21:53'!
postCopy
	super postCopy.
	transformations := transformations collect: [:each | each copy].! !

!TraitComposition methodsFor: 'copying' stamp: 'al 12/7/2005 20:50'!
copyWithoutAlias: aSymbol of: aTrait
	| composition transformation |
	composition := self copyTraitExpression.
	transformation := (composition transformationOfTrait: aTrait).
	^composition
		remove: transformation;
		add: (transformation removeAlias: aSymbol);
		normalizeTransformations;
		yourself! !

!TraitComposition methodsFor: 'accessing' stamp: 'al 4/9/2004 17:12'!
remove: aTransformation
	self transformations
		remove: aTransformation! !

!TraitComposition methodsFor: 'testing' stamp: 'stephane.ducasse 4/13/2009 20:33'!
addCompositionOnLeft: aTraitComposition
	self transformations do: [ :each | aTraitComposition add: each ].
	^ aTraitComposition! !

!TraitComposition methodsFor: 'copying' stamp: 'al 12/7/2005 20:49'!
copyWithExclusionOf: aSymbol to: aTrait
	| composition transformation |
	composition := self copyTraitExpression.
	transformation := (composition transformationOfTrait: aTrait).
	^composition
		remove: transformation;
		add: (transformation addExclusionOf: aSymbol);
		yourself! !

!TraitComposition methodsFor: 'private' stamp: 'al 4/10/2004 23:25'!
isAliasSelector: aSymbol
	"Return true if the selector aSymbol is an alias defined
	in this or in another composition somewhere deeper in 
	the tree of traits compositions."

	| methodDescription |
	methodDescription := (self methodDescriptionsForSelector: aSymbol)
		detect: [:each | each selector = aSymbol].
	^methodDescription isAliasSelector! !

!TraitComposition class methodsFor: 'instance creation' stamp: 'al 12/12/2003 18:24'!
with: aTraitTransformation with: anotherTraitTransformation
	^self new
		add: aTraitTransformation;
		add: anotherTraitTransformation;
		yourself! !

!TraitComposition class methodsFor: 'instance creation' stamp: 'al 12/12/2003 18:24'!
with: aTraitTransformation
	^self new
		add: aTraitTransformation;
		yourself! !

!TraitCompositionException commentStamp: '<historical>'!
Signal invalid trait compositions.!
!TraitCompositionTest methodsFor: 'testing-basic' stamp: 'al 12/15/2003 20:51'!
testEmptyTrait
	| composition |
	composition := {} asTraitComposition.
	
	self assert: (composition isKindOf: TraitComposition).
	self assert: composition transformations isEmpty.
	self assert: composition traits isEmpty! !

!TraitCompositionTest methodsFor: 'testing-basic' stamp: 'EstebanLorenzano 1/15/2013 19:01'!
testOriginSelectorOf
	
	"regular method "
	self assert: (MOPTestClassC traitComposition originSelectorOf: #c) equals: #c.	
	"non aliased trait method "
	self assert: (MOPTestClassD traitComposition originSelectorOf: #c2) equals: #c2.	
	"aliased method "
	self assert: (MOPTestClassD traitComposition originSelectorOf: #c3) equals: #c2.! !

!TraitCompositionTest methodsFor: 'testing-comparing' stamp: 'MartinDias 1/23/2014 15:19'!
testSyntacticEqualsWithComplexCompositions

	self assert: ((self t1 + (self t2 - {#a. #b}) + (self t3 @ {#x -> #y})) 
		syntacticallyEquals: (self t1 + (self t2 - {#a. #b}) + (self t3 @ {#x -> #y}))).
	self deny: ((self t1 + (self t2 - {#a. #b}) + (self t3 @ {#x -> #y})) 
		syntacticallyEquals: (self t1 + (self t2 - {#A. #B}) + (self t3 @ {#X -> #Y}))).
	
	self assert: ((self t1 @ {#x -> #y} @ {#z -> #w} - {#a. #b} - {#c} + self t2) 
		syntacticallyEquals: (self t1 @ {#x -> #y} @ {#z -> #w} - {#a. #b} - {#c} + self t2)).
	self deny: ((self t1 @ {#x -> #y} @ {#z -> #w} - {#a. #b} - {#c} + self t2) 
		syntacticallyEquals: (self t1 @ {#x -> #y} @ {#z -> #w} - {#a. #b} - {#C} + self t2)).
! !

!TraitCompositionTest methodsFor: 'testing-basic' stamp: 'dvf 8/30/2005 14:07'!
testCompositionFromArray
	| composition |
	composition := { (self t1) } asTraitComposition.
	self assert: (composition isKindOf: TraitComposition).
	self assert: (composition traits includes: self t1).
	self assert: composition traits size = 1.
	composition := { (self t1). self t2 } asTraitComposition.
	self assert: (composition isKindOf: TraitComposition).
	self assert: (composition traits includes: self t1).
	self assert: (composition traits includes: self t2).
	self assert: composition traits size = 2! !

!TraitCompositionTest methodsFor: 'testing-basic' stamp: 'CamilloBruni 8/31/2013 20:23'!
testAliasCompositions
	"unary"

	self t2 setTraitCompositionFrom: self t1 @ {(#aliasM11 -> #m11)}.
	self should: [ self t2 setTraitCompositionFrom: self t1 @ {(#alias: -> #m11)} ] raise: TraitCompositionException.
	self should: [ self t2 setTraitCompositionFrom: self t1 @ {(#alias:x:y: -> #m11)} ] raise: TraitCompositionException.	"binary"
	self t1 compile: '= anObject'.
	self t2 setTraitCompositionFrom: self t1 @ {(#equals: -> #=)}.
	self t2 setTraitCompositionFrom: self t1 @ {(#% -> #=)}.
	self should: [ self t2 setTraitCompositionFrom: self t1 @ {(#equals -> #=)} ] raise: TraitCompositionException.
	self should: [ self t2 setTraitCompositionFrom: self t1 @ {(#equals:x: -> #=)} ] raise: TraitCompositionException.	"keyword"
	self t1 compile: 'x: a y: b z: c'.
	self should: [ self t2 setTraitCompositionFrom: self t1 @ {(#== -> #x:y:z:)} ] raise: TraitCompositionException.
	self should: [ self t2 setTraitCompositionFrom: self t1 @ {(#x -> #x:y:z:)} ] raise: TraitCompositionException.
	self should: [ self t2 setTraitCompositionFrom: self t1 @ {(#x: -> #x:y:z:)} ] raise: TraitCompositionException.
	self should: [ self t2 setTraitCompositionFrom: self t1 @ {(#x:y: -> #x:y:z:)} ] raise: TraitCompositionException.
	self t2 setTraitCompositionFrom: self t1 @ {(#myX:y:z: -> #x:y:z:)}.	"alias same as selector"
	self should: [ self t2 setTraitCompositionFrom: self t1 @ {(#m11 -> #m11)} ] raise: TraitCompositionException.	"same alias name used twice"
	self
		should: [ 
			self t2
				setTraitCompositionFrom:
					self t1
						@
							{(#alias -> #m11).
							(#alias -> #m12)} ]
		raise: TraitCompositionException.	"aliasing an alias"
	self
		should: [ 
			self t2
				setTraitCompositionFrom:
					self t1
						@
							{(#alias -> #m11).
							(#alias2 -> #alias)} ]
		raise: TraitCompositionException! !

!TraitCompositionTest methodsFor: 'testing-basic' stamp: 'dvf 8/26/2005 14:31'!
testSum
	| composition |
	composition := self t1 + self t2 + self t3.
	self assert: (composition isKindOf: TraitComposition).
	self assert: (composition traits includes: self t1).
	self assert: (composition traits includes: self t2).
	self assert: (composition traits includes: self t3).
	self assert: composition traits size = 3! !

!TraitCompositionTest methodsFor: 'testing-comparing' stamp: 'MartinDias 1/23/2014 15:18'!
testSyntacticEqualsWithAlias

	self assert: ((self t1 @ {#a -> #b}) syntacticallyEquals: (self t1 @ {#a -> #b})).
	self deny: ((self t1 @ {#a -> #b}) syntacticallyEquals: self t1).
	self deny: ((self t1 @ {#a -> #b}) syntacticallyEquals: (self t1 @ {#a -> #B})).
	self deny: ((self t1 @ {#a -> #b}) syntacticallyEquals: (self t1 @ {#A -> #b})).

	self assert: ((self t1 @ {#a -> #b} @ {#x -> #y}) syntacticallyEquals: (self t1 @ {#a -> #b} @ {#x -> #y})).
	self deny: ((self t1 @ {#a -> #b} @ {#x -> #y}) syntacticallyEquals: (self t1 @ {#x -> #y} @ {#a -> #b})).! !

!TraitCompositionTest methodsFor: 'testing-basic' stamp: 'SebastianTleye 6/28/2013 17:34'!
testPrinting
	| composition1 composition2 |
	composition1 := ((self t2 + self t1) @ { (#z -> #c) } - {#a. #b. #c } 
				+ self t3 - { #d. #e } 
				+ self t4).
	composition2 := self t4 @ { (#x -> #a). (#y -> #b) } + self t1 - { #a } 
				+ self t3 - { #d. #e } 
				+ self t2 - { #b. #c }.
	self assertPrints: composition1 printString
		like: 'T2 @ {#z->#c} - {#d. #e. #a. #b. #c} + (T1 @ {#z->#c} - {#d. #e. #a. #b. #c}) + (T3 - {#d. #e}) + T4'.
	self assertPrints: composition2 printString
		like: 'T4 @ {#x->#a. #y->#b} - {#b. #c. #d. #e. #a} + (T1 - {#b. #c. #d. #e. #a}) + (T3 - {#b. #c. #d. #e}) + (T2 - {#b. #c})'
		
		! !

!TraitCompositionTest methodsFor: 'testing-basic' stamp: 'dvf 8/26/2005 14:31'!
testSumWithParenthesis
	| composition |
	composition := self t1 + (self t2 + self t3).
	self assert: (composition isKindOf: TraitComposition).
	self assert: (composition traits includes: self t1).
	self assert: (composition traits includes: self t2).
	self assert: (composition traits includes: self t3).
	self assert: composition traits size = 3.
	self assert: composition size = 3! !

!TraitCompositionTest methodsFor: 'testing-enquiries' stamp: 'MarcusDenker 5/4/2013 12:53'!
testClassMethodsTakePrecedenceOverTraitsMethods
	| keys |
	keys := Set new.
	self t4 methodDict bindingsDo: [:each | keys add: each key].
	self assert: keys size = 6.
	self 
		assert: (keys includesAllOf: #(
						#m12
						#m13
						#m13
						#m21
						#m22
						#m11
						#m42
					)).
	self assert: (self t4 methodDict at: #m11) sourceCode = 'm11 ^41'! !

!TraitCompositionTest methodsFor: 'testing-comparing' stamp: 'MartinDias 1/23/2014 15:19'!
testSyntacticEqualsWithComposition

	self assert: ({} asTraitComposition syntacticallyEquals: {} asTraitComposition).
	self deny: ({} asTraitComposition syntacticallyEquals: self t1 asTraitComposition).

	self assert: (self t1 asTraitComposition syntacticallyEquals: self t1 asTraitComposition).
	self deny: (self t1 asTraitComposition syntacticallyEquals: self t2 asTraitComposition).
	
	self assert: ((self t1 + self t2) syntacticallyEquals: (self t1 + self t2)).
	self deny: ((self t1 + self t2) syntacticallyEquals: (self t1 + self t3)).
	self deny: ((self t1 + self t2) syntacticallyEquals: (self t2 + self t1)).
	
	self assert: ((self t1 + self t2 + self t3) syntacticallyEquals: (self t1 + self t2 + self t3)).
	self deny: ((self t1 + self t2 + self t3) syntacticallyEquals: (self t3 + self t2 + self t1)).
! !

!TraitCompositionTest methodsFor: 'testing-comparing' stamp: 'MartinDias 1/23/2014 15:19'!
testSyntacticEqualsWithExclusion

	self assert: ((self t1 - {#a}) syntacticallyEquals: (self t1 - {#a})).
	self deny: ((self t1 - {#a}) syntacticallyEquals: (self t1 - {#b})).
	self deny: ((self t1 - {#a. #b}) syntacticallyEquals: (self t1 - {#b. #a})).
	
	self assert: ((self t1 - {#a} - {#b}) syntacticallyEquals: (self t1 - {#a} - {#b})).
	self deny: ((self t1 - {#a} - {#b}) syntacticallyEquals: (self t1 - {#b} - {#a})).
! !

!TraitCompositionTest methodsFor: 'testing-basic' stamp: 'CamilloBruni 8/31/2013 20:23'!
testInvalidComposition
	self t1 @ {(#a -> #b)} @ {(#x -> #y)}.
	(self t1 + self t2) @ {(#a -> #b)} @ {(#x -> #y)}.
	self t1 - {#a} - {#b}.
	self t1 + self t2 - {#a} - {#b}.
	self should: [ (self t1 - {#x}) @ {(#a -> #b)} ] raise: TraitCompositionException.
	self should: [ (self t1 + self t2 - {#x}) @ {(#a -> #b)} ] raise: TraitCompositionException.
	self should: [ self t1 + self t1 ] raise: TraitCompositionException.
	self should: [ (self t1 + self t2) @ {(#a -> #b)} + self t1 ] raise: TraitCompositionException.
	self
		should: [ 
			self t1
				@
					{(#a -> #m11).
					(#a -> #m12)} ]
		raise: TraitCompositionException.
	self
		should: [ 
			self t1
				@
					{(#a -> #m11).
					(#b -> #a)} ]
		raise: TraitCompositionException! !

!TraitDescription commentStamp: '<historical>'!
I add a number of facilities (most defined by traits which are also used in ClassDescription):
	Category organization for methods
	The maintenance of a ChangeSet, and logging changes on a file
	Most of the mechanism for fileOut.
	Copying of methods to other traits/classes
	Operators to create trait compositions!
!TraitDescription methodsFor: 'accessing comment' stamp: ''!
comment: aStringOrText
	"Set the receiver's comment to be the argument, aStringOrText."

	self instanceSide classComment: aStringOrText.! !

!TraitDescription methodsFor: 'filein/out' stamp: ''!
fileOutCategory: aSymbol on: aFileStream moveSource: moveSource toFile: fileIndex 
	"File a description of the receiver's category, aString, onto aFileStream. If 
	moveSource, is true, then set the method source pointer to the new file position.
	Note when this method is called with moveSource=true, it is condensing the
	.sources file, and should only write one preamble per method category."

	| selectors |
	aFileStream cr.
	selectors := self selectorsToFileOutCategory: aSymbol.

	"Overridden to preserve author stamps in sources file regardless"
	selectors do: [:sel |
		self printMethodChunk: sel 
			withPreamble: true
			on: aFileStream 
			moveSource: moveSource 
			toFile: fileIndex].
	^ self! !

!TraitDescription methodsFor: 'accessing' stamp: 'SebastianTleye 7/3/2013 19:27'!
instanceVariables
	^#().! !

!TraitDescription methodsFor: 'slots' stamp: ''!
definesSlotNamed: aString
	"Return true whether the receiver defines an instance variable named aString."
	
	^ self slotNames includes: aString! !

!TraitDescription methodsFor: 'accessing parallel hierarchy' stamp: 'al 4/21/2004 10:01'!
baseTrait
	self subclassResponsibility! !

!TraitDescription methodsFor: 'private' stamp: ''!
newInstanceFrom: oldInstance variable: variable size: instSize
	"Create a new instance of the receiver based on the given old instance.
	The supplied map contains a mapping of the old instVar names into
	the receiver's instVars"

	| new  value |
	variable
		ifTrue: [ new := self basicNew: oldInstance basicSize ]
		ifFalse: [ new := self basicNew ].
		
	"Slot migration happens there"		
	self allSlots
		do: [ :newSlot | 
			oldInstance class
				slotNamed: newSlot name
				ifFound: [ :oldSlot | 
					value := oldSlot read: oldInstance.
					newSlot write: value to: new ] ].
	variable
		ifTrue: [ 1 to: oldInstance basicSize do: [ :offset | new basicAt: offset put: (oldInstance basicAt: offset) ] ].
	^ new! !

!TraitDescription methodsFor: '*NautilusRefactoring' stamp: ''!
renameMethodAllItem: aBuilder

	^ (aBuilder item: #'Rename method (all)')
			keyText: 'r, m' if: Nautilus useOldStyleKeys not;
			keyText: 'r' if: Nautilus useOldStyleKeys;
			action: [ | target |
				target := aBuilder model.
				"scroll := target methodWidget vScrollValue."
				target refactor renameMethodFor: target selectedMethod originMethod.
				"target methodWidget vScrollValue: scroll"
				 ].! !

!TraitDescription methodsFor: 'accessing parallel hierarchy' stamp: 'al 12/10/2003 00:07'!
theNonMetaClass
	^ self baseTrait! !

!TraitDescription methodsFor: 'organization' stamp: ''!
zapOrganization
	"Remove the organization of this class by message categories.
	This is typically done to save space in small systems.  Classes and methods
	created or filed in subsequently will, nonetheless, be organized"

	self organization: nil.
	self isClassSide ifFalse: [self classSide zapOrganization]! !

!TraitDescription methodsFor: '*Nautilus' stamp: 'ST 8/13/2013 10:33'!
buildAnalyzeSubMenu: aBuilder

	| target |
	target := aBuilder model.
	
	(aBuilder item: #'Generate initialize method')
		keyText: 'h, i' if: Nautilus useOldStyleKeys not;
		keyText: 'I' if: Nautilus useOldStyleKeys;
		action: [ target generateInitialize ];
		parent: #Analyze;
		order: 350.
		
	(aBuilder item: #'Force the generaton of the initialize method')
		keyText: 'h, k' if: Nautilus useOldStyleKeys not;
		keyText: 'K' if: Nautilus useOldStyleKeys;		
		action: [ target forceGenerateInitialize ];
		parent: #Analyze;
		order: 375;
		enabledBlock: [ target showInstance ];
		withSeparatorAfter.

	(target selectedClass inheritsFrom: SharedPool )
		ifTrue: [ 
			(aBuilder item: #'Shared Pool Users')
				action: [ target systemNavigation browseSharedPoolUsersOf: target selectedClass ];
				parent: #Analyze;
				enabledBlock: [ target enableSingleClassSelection ];
				order: 700].
				
	(aBuilder item: #'Unsent methods...')
		action: [target browseUnusedMethods.];
		parent: #Analyze;
		order: 800.
	
	! !

!TraitDescription methodsFor: '*GT-Inspector-Examples' stamp: ''!
gtExamples

	^	self examplesProvider gtExamples! !

!TraitDescription methodsFor: 'accessing method dictionary' stamp: ''!
addSelector: selector withMethod: compiledMethod notifying: requestor
	| priorMethodOrNil oldProtocol |
	priorMethodOrNil := self compiledMethodAt: selector ifAbsent: [nil].
	oldProtocol := priorMethodOrNil ifNotNil: [ priorMethodOrNil protocol ].
	self addSelectorSilently: selector withMethod: compiledMethod.
	priorMethodOrNil 
		ifNil: [SystemAnnouncer uniqueInstance methodAdded: compiledMethod ]
		ifNotNil: [SystemAnnouncer uniqueInstance methodChangedFrom: priorMethodOrNil to: compiledMethod oldProtocol: oldProtocol ].! !

!TraitDescription methodsFor: 'accessing parallel hierarchy' stamp: ''!
isClassSide
	^self == self classSide! !

!TraitDescription methodsFor: 'accessing method dictionary' stamp: ''!
allProtocolsUpTo: mostGenericClass
	"Answer a list of all the method protocols of the receiver and all its superclasses, up through mostGenericClass"

	| otherClassCategories thisClassCategories lowercaseSortBlock  |
		
	otherClassCategories := OrderedCollection new.
	lowercaseSortBlock  := [ :a :b | a asLowercase <= b asLowercase ].
	
	(self allSuperclassesIncluding: mostGenericClass) do: [ :aClass | 
		 otherClassCategories addAll: aClass organization categories ].
	otherClassCategories remove: 'no messages' ifAbsent: [  ].
	thisClassCategories := self organization categories sorted: lowercaseSortBlock.
													
	^ thisClassCategories , ((otherClassCategories asSet removeAllSuchThat: [ :each |
								thisClassCategories includes: each ]) sorted: lowercaseSortBlock)! !

!TraitDescription methodsFor: 'accessing method dictionary' stamp: ''!
noteAddedSelector: aSelector meta: isMeta
	"A hook allowing some classes to react to adding of certain selectors"! !

!TraitDescription methodsFor: '*System-Support' stamp: ''!
allUnreferencedClassVariables
	"Answer a list of the names of all the receiver's unreferenced class vars, including those defined in superclasses"

	^ self systemNavigation allUnreferencedClassVariablesOf: self! !

!TraitDescription methodsFor: 'accessing parallel hierarchy' stamp: 'al 4/21/2004 10:01'!
classTrait
	self subclassResponsibility! !

!TraitDescription methodsFor: '*NautilusRefactoring' stamp: 'SebastianTleye 8/13/2013 14:26'!
refactoringMenu: aBuilder
	| target |
	
	target := aBuilder model.
	
	(aBuilder item: #'Refactoring')
			order: -100.
	
	(aBuilder item: #'Code Rewriting')
			order: 0;
			parent: #'Refactoring'.
			
	(aBuilder item: #'Trait Refactoring')
			order: 100;
			parent: #'Refactoring';
			withSeparatorAfter.
		
	(aBuilder item: #'Undo')
			order: 400;
			label: target refactor undoLabel;
			action: [ target refactor undoOperation ];
			enabled: target refactor undoEnabled;
			parent: #'Refactoring'.
	
	(aBuilder item: #'Redo')
			order: 500;
			label: target refactor redoLabel;
			action: [ target refactor redoOperation ];
			enabled: target refactor redoEnabled;
			parent: #'Refactoring';
			withSeparatorAfter.! !

!TraitDescription methodsFor: 'copying' stamp: ''!
copyCategory: cat from: class 
	"Specify that one of the categories of messages for the receiver is cat, as 
	found in the class, class. Copy each message found in this category."

	self copyCategory: cat
		from: class
		classified: cat! !

!TraitDescription methodsFor: '*NautilusRefactoring' stamp: ''!
groupRefactoring: aBuilder
	| target |
	target := aBuilder model.
	
	(aBuilder item: #'Rewrite Code')
		order:  100;
		withSeparatorAfter.
	
	(aBuilder item: #'Rewrite Code')
		action: [ target refactor rewriteCode ];
		parent: #'Rewrite Code';
		order: 0.

	(aBuilder item: #'Search Code')
		action: [ target refactor searchCode ];
		parent: #'Rewrite Code';
		order: 100.! !

!TraitDescription methodsFor: 'private' stamp: ''!
addCompositionOnLeft: aTraitComposition
	^ aTraitComposition add: self! !

!TraitDescription methodsFor: 'organization updating' stamp: ''!
noteMethodChanged: oldMethod to: newMethod
	self flag: #todo. "oldProtocol is not set properly here"
	SystemAnnouncer uniqueInstance methodChangedFrom: oldMethod to: newMethod oldProtocol: Protocol unclassified! !

!TraitDescription methodsFor: 'instance variables' stamp: ''!
classThatDefinesInstanceVariable: instVarName
	(self instVarNames notNil and: [self instVarNames includes: instVarName asString]) ifTrue: [^ self]. 
	^self superclass ifNotNil: [self superclass classThatDefinesInstanceVariable: instVarName]! !

!TraitDescription methodsFor: 'printing' stamp: ''!
classVariablesString
	"Answer a string of my class variable names separated by spaces."

	^String streamContents: [ :stream | 
		self classVarNames 
			do: [ :each | stream nextPutAll: each ]
			separatedBy: [ stream space ] ]! !

!TraitDescription methodsFor: 'instance variables' stamp: ''!
hasInstVarNamed: aString
	"Return true whether the receiver defines an instance variable named aString."
	
	^ self instVarNames includes: aString! !

!TraitDescription methodsFor: 'accessing method dictionary' stamp: 'VincentBlondeau 3/6/2015 17:47'!
addAndClassifySelector: selector withMethod: compiledMethod inProtocol: category notifying: requestor 
	| priorMethodOrNil priorOriginOrNil oldProtocol  |
	
	priorMethodOrNil := self
		compiledMethodAt: selector
		ifAbsent: [].
	priorMethodOrNil ifNotNil: [ priorOriginOrNil := priorMethodOrNil origin ].
	
	"We categorize first, so the users can use the categorization at the add moment"			
	oldProtocol := self organization categoryOfElement: selector.
	SystemAnnouncer uniqueInstance
		suspendAllWhile: [ self organization classify: selector under: category ].
	
	self addSelectorSilently: selector withMethod: compiledMethod.

	(priorMethodOrNil isNil or: [ priorOriginOrNil ~= compiledMethod origin ])
		ifTrue: [ SystemAnnouncer uniqueInstance methodAdded: compiledMethod ]
		ifFalse: [
			SystemAnnouncer uniqueInstance
				methodChangedFrom: priorMethodOrNil
				to: compiledMethod
				oldProtocol: oldProtocol ]! !

!TraitDescription methodsFor: '*rpackage-core' stamp: ''!
isExtended

	^ self extendingPackages isEmpty! !

!TraitDescription methodsFor: 'composition' stamp: ''!
+ aTraitOrTraitComposition
	"Use double dispatch to avoid having nested composition in cases where
	parenthesis are used, such as T1 + (T2 + T3)"
	
	^aTraitOrTraitComposition addOnTheLeft: self! !

!TraitDescription methodsFor: 'organization' stamp: 'SebastianTleye 7/4/2013 14:59'!
basicOrganization: aClassOrg
	organization := aClassOrg! !

!TraitDescription methodsFor: '*GT-Inspector-Examples' stamp: ''!
gtInspectorExamplesIn: composite
	"This provides a list of example objects for the current class"
	<gtInspectorPresentationOrder: 20>
	<gtInspectorTag: #examples>
	|exampleProvider|

	exampleProvider := self examplesProvider.
	(exampleProvider gtDisplayExamplesIn: composite)
			"when: [ self exampleProvider rootExamples notEmpty ];"
			morphicSelectionAct: [ :list | 
					list rawSelection methodReference browse ] 
				icon: GLMUIThemeExtraIcons glamorousBrowse 
				on: $b 
				entitled: 'Browse source'
! !

!TraitDescription methodsFor: '*NautilusRefactoring' stamp: 'SebastianTleye 8/13/2013 14:18'!
instVarRefactoring: aBuilder
	! !

!TraitDescription methodsFor: 'slots' stamp: ''!
hasSlot: aSlot
	"Return true whether the receivers hierarchy defines an instance variable named aString."
	
	^ self allSlots identityIncludes: aSlot! !

!TraitDescription methodsFor: 'slots' stamp: 'MarcusDenker 7/2/2014 10:18'!
slotNamed: aName
	"Tratis have no slots"
	^self error: 'no slot found'.! !

!TraitDescription methodsFor: 'compiling' stamp: ''!
compileSilently: code classified: category notifying: requestor
	"Compile the code and classify the resulting method in the given category, leaving no trail in the system log, nor in any change set, nor in the 'recent submissions' list. This should only be used when you know for sure that the compilation will succeed."

	^ SystemAnnouncer uniqueInstance 
		suspendAllWhile: [self compile: code classified: category notifying: requestor].! !

!TraitDescription methodsFor: '*rpackage-core' stamp: ''!
definedSelectors
	^ self package definedSelectorsForClass: self! !

!TraitDescription methodsFor: 'organization updating' stamp: ''!
noteMethodAdded: aMethod
	SystemAnnouncer uniqueInstance
		methodAdded: aMethod! !

!TraitDescription methodsFor: 'enquiries' stamp: ''!
trait
	"for compatibility with TraitTransformations"
	^ self
! !

!TraitDescription methodsFor: 'accessing method dictionary' stamp: ''!
removeProtocol: aString 
	"Remove each of the messages categorized under aString in the method 
	dictionary of the receiver. Then remove the category aString."
	| categoryName |
	categoryName := aString asSymbol.
	(self organization listAtCategoryNamed: categoryName) do:
		[:sel | self removeSelector: sel].
	self organization removeCategory: categoryName! !

!TraitDescription methodsFor: 'instance variables' stamp: ''!
instVarNameForIndex: index
	"Answer the named instance variable with index index or nil if none."

	| superInstSize |
	index > self instSize ifTrue: [^nil].
	superInstSize := self superclass ifNil: [0] ifNotNil: [self superclass instSize].
	index > superInstSize ifTrue:
		[^self instanceVariables at: index - superInstSize].
	self superclass ifNil: [^nil].
	^self superclass instVarNameForIndex: index

	"(Object allSubclasses select:
		[:cls| cls instSize > cls superclass instSize and: [cls subclasses isEmpty and: [cls superclass instSize > 0]]]) collect:
			[:cls| (1 to: cls instSize) collect: [:i| cls instVarNameForIndex: i]]"! !

!TraitDescription methodsFor: 'accessing class hierarchy' stamp: ''!
commentInventory
	"Answer a string with a count of the classes with and without comments 
	for all the classes in the package of which this class is a member."

	"Morph commentInventory"

	^ self environment organization commentInventory: (self category copyUpTo: $-), '*'! !

!TraitDescription methodsFor: 'compiling' stamp: ''!
compile: text classified: category withStamp: changeStamp notifying: requestor logSource: logSource
 
	| method selector |

	method := self compiler
		source: text;
		requestor: requestor;
		category: category;
		failBlock:  [ ^nil ];
		compile.
	
	selector := method selector.
	logSource ifTrue: [
		self 
			logMethodSource: (requestor ifNotNil: [ :r | r text ] ifNil: [ text ]) "the requestor text might have been changed by the compiler and may be different thant text argument"
			forMethod: method
			inCategory: category 
			withStamp: changeStamp].
		
	self 
		addAndClassifySelector: selector 
		withMethod: method 
		inProtocol: category 
		notifying: requestor.
			
	self instanceSide 
		noteCompilationOf: selector 
		meta: self isClassSide.

	^ selector! !

!TraitDescription methodsFor: 'accessing parallel hierarchy' stamp: 'al 3/16/2004 10:47'!
isBaseTrait
	self subclassResponsibility! !

!TraitDescription methodsFor: 'copying' stamp: 'SebastianTleye 7/3/2013 18:37'!
copyTraitExpression
	"When recursively copying a trait expression, the primitive traits should NOT be copied
because they are globally named 'well-known' objects"
	^ self ! !

!TraitDescription methodsFor: 'pool variable' stamp: ''!
allSharedPools
	"Answer an ordered collection  of the shared pools the receiver shares, including those defined  in the superclasses of the receiver."
	
	^ OrderedCollection new! !

!TraitDescription methodsFor: 'private' stamp: ''!
linesOfCode 
	"An approximate measure of lines of code.
	Includes comments, but excludes blank lines."
	| lines |
	lines := self localMethods inject: 0 into: [:sum :each | sum + each linesOfCode]. 
	^ self isMeta 
		ifTrue: [lines]
		ifFalse: [lines + self class linesOfCode]! !

!TraitDescription methodsFor: 'filein/out' stamp: ''!
selectorsToFileOutCategory: aSymbol
	^ self organization listAtCategoryNamed: aSymbol! !

!TraitDescription methodsFor: 'compiling' stamp: ''!
compile: text classified: category notifying: requestor
	| stamp |
	stamp := self acceptsLoggingOfCompilation
		ifTrue: [ Author changeStamp ]
		ifFalse: [ nil ].
	^ self
		compile: text
		classified: category
		withStamp: stamp
		notifying: requestor! !

!TraitDescription methodsFor: 'printing' stamp: ''!
sharedPoolsString
	"Answer a string of my shared pool names separated by spaces."

	^String streamContents: [ :stream |
		self sharedPools 
			do: [ :each |
				stream nextPutAll: (self environment 
					keyAtIdentityValue: each 
					ifAbsent: [ 
						each isObsolete
							ifTrue: [ each name ] "obsolete classes should be visible"
							ifFalse: [ 'private' ] ]) ] "if class is from different environment, mark it as private"
			separatedBy: [ stream space ] ]! !

!TraitDescription methodsFor: '*NautilusRefactoring' stamp: ''!
refactoringMethod: aBuilder

	(aBuilder item: #'Refactoring')
		order: -100.
			
	(self renameMethodAllItem: aBuilder)
		order: -90;
		withSeparatorAfter! !

!TraitDescription methodsFor: '*GT-Inspector-Examples' stamp: ''!
examplesProvider

	^ GTExampleProvider on: self! !

!TraitDescription methodsFor: 'compiling' stamp: ''!
noteCompilationOf: aSelector meta: isMeta
	"A hook allowing some classes to react to recompilation of certain selectors"! !

!TraitDescription methodsFor: 'accessing method dictionary' stamp: ''!
allSelectorsInProtocol: aName 
	"Answer a list of all the methods of the receiver and all its 
	superclasses that are in the protocol named aName"
	
	| aColl |
	aColl := OrderedCollection new.
	self withAllSuperclasses do: [:aClass | 
		aColl addAll: (aClass organization listAtCategoryNamed: aName) ].
	^ aColl asSet asArray sort! !

!TraitDescription methodsFor: 'instance variables' stamp: ''!
instVarIndexFor: instVarName ifAbsent: aBlock
	"Answer the index of the named instance variable."

	| index |
	index := self instanceVariables == nil 
			ifTrue: [0]
			ifFalse: [self instanceVariables indexOf: instVarName ifAbsent: [0]].
	index = 0 ifTrue: 
		[^self superclass == nil 
			ifTrue: [aBlock value]
			ifFalse: [self superclass instVarIndexFor: instVarName ifAbsent: aBlock]].
	^self superclass == nil 	
		ifTrue: [index]
		ifFalse: [index + self superclass instSize]! !

!TraitDescription methodsFor: '*Nautilus' stamp: ''!
definitionForNautilusWithSlots

	^ self definition! !

!TraitDescription methodsFor: 'accessing comment' stamp: ''!
comment
	"Answer the receiver's comment. (If missing, supply a template) "
	| aString |
	aString := self instanceSide organization classComment.
	aString isEmpty ifFalse: [^ aString].
	^self classCommentBlank! !

!TraitDescription methodsFor: 'organization' stamp: ''!
whichCategoryIncludesSelector: aSelector 
	"Answer the category of the argument, aSelector, in the organization of 
	the receiver, or answer nil if the receiver does not inlcude this selector."

	(self includesSelector: aSelector)
		ifTrue: [^ self organization categoryOfElement: aSelector]
		ifFalse: [^nil]! !

!TraitDescription methodsFor: 'accessing class hierarchy' stamp: ''!
printSubclassesOn: aStream level: level 
	"As part of the algorithm for printing a description of the receiver, print the
	subclass on the file stream, aStream, indenting level times."

	| subclassNames |
	aStream crtab: level.
	aStream nextPutAll: self name.
	aStream space; print: self instVarNames.
	self == Class
		ifTrue: 
			[aStream crtab: level + 1; nextPutAll: '[ ... all the Metaclasses ... ]'.
			^self].
	subclassNames := self subclasses asSortedCollection:[:c1 :c2| c1 name <= c2 name].
	"Print subclasses in alphabetical order"
	subclassNames do:
		[:subclass | subclass printSubclassesOn: aStream level: level + 1]! !

!TraitDescription methodsFor: 'slots' stamp: ''!
allSlotsEverywhere
	"Answer the set of slots used by the receiver, all superclasses, and all subclasses"

	| aList |
	aList := OrderedCollection new.
	(self allSuperclasses , self withAllSubclasses asOrderedCollection) do:
		[:cls | aList addAll: cls slots].
	^ aList asSet! !

!TraitDescription methodsFor: 'accessing method dictionary' stamp: ''!
uncategorizedSelectors
	^ self selectorsInProtocol: Protocol unclassified! !

!TraitDescription methodsFor: 'compiling' stamp: ''!
instVarNamesAndOffsetsDo: aBinaryBlock
	"This is part of the interface between the compiler and a class's instance or field names.
	 The class should enumerate aBinaryBlock with the instance variable name strings and
	 their integer offsets.  The order is important. Names evaluated later will override the
	 same names occurring earlier."

	| superInstSize |
	(superInstSize := self superclass notNil ifTrue: [self superclass instSize] ifFalse: [0]) > 0 ifTrue:
		[self superclass instVarNamesAndOffsetsDo: aBinaryBlock].
	1 to: self instSize - superInstSize do:
		[:i| aBinaryBlock value: (self instanceVariables at: i) value: i + superInstSize]! !

!TraitDescription methodsFor: 'private' stamp: ''!
instVarMappingFrom: oldClass
	"Return the mapping from instVars of oldClass to new class that is used for converting old instances of oldClass."
	| oldInstVarNames |
	oldInstVarNames := oldClass allInstVarNames.
	^self allInstVarNames 
			collect: [:instVarName | oldInstVarNames indexOf: instVarName].! !

!TraitDescription methodsFor: 'accessing method dictionary' stamp: ''!
removeSelector: selector 
	"Remove the message whose selector is given from the method 
	dictionary of the receiver, if it is there. Answer nil otherwise."
	
	| priorMethod priorProtocol origin | 
	priorMethod := self compiledMethodAt: selector ifAbsent: [^ nil].
	origin := priorMethod origin.
	priorProtocol := self whichCategoryIncludesSelector: selector.
	super removeSelector: selector.
	SystemAnnouncer uniqueInstance 
		suspendAllWhile: [self updateOrganizationSelector: selector oldCategory: priorProtocol newCategory: nil].
	SystemAnnouncer uniqueInstance methodRemoved: priorMethod protocol: priorProtocol origin: origin! !

!TraitDescription methodsFor: '*NautilusCommon' stamp: ''!
correspondingForTest
	"Return the unit test that correspond to me. If it does not exist, it returns myself. 
	 Return the tested class if sent to a class"
	
	| className |
	className := (self inheritsFrom: TestCase)
		ifTrue: [ self name copyReplaceAll: 'Test' with: '' ]
		ifFalse: [ self name, 'Test' ].
	^ Smalltalk 
		at: className asSymbol 
		ifAbsent: [ self ]
	! !

!TraitDescription methodsFor: 'initialize-release' stamp: ''!
obsolete
	"Make the receiver obsolete."
	self superclass removeSubclass: self.
	self organization: nil.
	super obsolete.! !

!TraitDescription methodsFor: 'private' stamp: ''!
errorCategoryName
	self error: 'Category name must be a String'! !

!TraitDescription methodsFor: 'organization' stamp: ''!
organization: aClassOrg
	"Install an instance of ClassOrganizer that represents the organization of the messages of the receiver."

	aClassOrg ifNotNil: [aClassOrg setSubject: self].
	self basicOrganization: aClassOrg.! !

!TraitDescription methodsFor: '*Manifest-Core' stamp: ''!
criticClass
	"Return the class of the receiver for the critic browser. This behavior may be folded later by changing the name of this method or using another one."
	
	^ self! !

!TraitDescription methodsFor: 'accessing method dictionary' stamp: ''!
selectorsInCategory: aName 
	"Answer a list of the selectors of the receiver that are in category named aName"
	
	| aColl |
	aColl := Set withAll: (self organization listAtCategoryNamed: aName).
	^ aColl asArray sort! !

!TraitDescription methodsFor: '*rpackage-core' stamp: ''!
extensionSelectors
	^ self extendingPackages flatCollect: [ :each | each extensionSelectorsForClass: self ]! !

!TraitDescription methodsFor: '*Manifest-Core' stamp: ''!
mcWorkingCopy
	MCWorkingCopy managersForClass:  self do: [: package | ^ package ]! !

!TraitDescription methodsFor: 'pool variable' stamp: ''!
usesPoolVarNamed: aString
	"Only classes may use a pool variable named: aString"
	
	^ false! !

!TraitDescription methodsFor: '*rpackage-core' stamp: ''!
isDefinedInPackage: aPackage
	"returns true if aPackage contains the definitino of this class"
	
	^ aPackage includesClass: self.! !

!TraitDescription methodsFor: 'copying' stamp: ''!
copyAllCategoriesFrom: aClass 
	"Specify that the categories of messages for the receiver include all of 
	those found in the class, aClass. Install each of the messages found in 
	these categories into the method dictionary of the receiver, classified 
	under the appropriate categories."

	aClass organization categories do: [:cat | self copyCategory: cat from: aClass]! !

!TraitDescription methodsFor: 'instance variables' stamp: ''!
allInstVarNamesEverywhere
	"Answer the set of inst var names used by the receiver, all superclasses, and all subclasses"

	| aList |
	aList := OrderedCollection new.
	(self allSuperclasses , self withAllSubclasses asOrderedCollection) do:
		[:cls | aList addAll: cls instVarNames].
	^ aList asSet

	"BorderedMorph allInstVarNamesEverywhere"! !

!TraitDescription methodsFor: 'filein/out' stamp: ''!
commentStamp: changeStamp prior: indexAndOffset
	"Prior source link ignored when filing in."

	^ ClassCommentReader new setClass: self
				category: #Comment
				changeStamp: changeStamp! !

!TraitDescription methodsFor: 'copying' stamp: ''!
copy: sel from: class 
	"Install the method associated with the first argument, sel, a message 
	selector, found in the method dictionary of the second argument, class, 
	as one of the receiver's methods. Classify the message under -As yet not 
	classified-."

	self copy: sel
		from: class
		classified: nil! !

!TraitDescription methodsFor: 'filein/out' stamp: ''!
fileOutMethod: selector
	"Write source code of a single method on a file.  Make up a name for the file."
	
	| internalStream |
	internalStream := (String new: 1000) writeStream.
	self fileOutMethod: selector on: internalStream.
	FileStream writeSourceCodeFrom: internalStream baseName: (self name , '-' , (selector copyReplaceAll: ':' with: '')) isSt: true.! !

!TraitDescription methodsFor: 'organization' stamp: 'SebastianTleye 7/4/2013 14:59'!
basicOrganization
	^ organization ! !

!TraitDescription methodsFor: 'filein/out' stamp: ''!
fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex
	"File a description of the receiver on aFileStream. If the boolean 
	argument, moveSource, is true, then set the trailing bytes to the position 
	of aFileStream and to fileIndex in order to indicate where to find the 
	source code."

	aFileStream nextChunkPut: self definition.

	self organization
		putCommentOnFile: aFileStream
		numbered: fileIndex
		moveSource: moveSource
		forClass: self.
	self organization realCategories do: 
		[:heading |
		self fileOutCategory: heading
			on: aFileStream
			moveSource: moveSource
			toFile: fileIndex]! !

!TraitDescription methodsFor: 'pool variable' stamp: ''!
sharedPoolOfVarNamed: aString
	"Only classes may have shared pools"
	
	^ nil! !

!TraitDescription methodsFor: 'filein/out' stamp: ''!
fileOutChangedMessages: aSet on: aFileStream moveSource: moveSource toFile: fileIndex 
	"File a description of the messages of this class that have been 
	changed (i.e., are entered into the argument, aSet) onto aFileStream.  If 
	moveSource, is true, then set the method source pointer to the new file position.
	Note when this method is called with moveSource=true, it is condensing the
	.changes file, and should only write a preamble for every method."
	| org |
	(org := self organization) realCategories do: 
		[:cat | | sels | 
		sels := (org listAtCategoryNamed: cat) select: [:sel | aSet includes: sel].
		sels do:
			[:sel |  self printMethodChunk: sel withPreamble: true on: aFileStream
							moveSource: moveSource toFile: fileIndex]]! !

!TraitDescription methodsFor: '*NautilusRefactoring' stamp: 'SebastianTleye 8/13/2013 14:26'!
refactoringSubmenu: aBuilder
	| target |
	target := aBuilder model.
	
	(aBuilder item: #'Rename...')
		keyText: 'r, c' if: Nautilus useOldStyleKeys not;
		keyText: 'r' if: Nautilus useOldStyleKeys;		
		action: [ target renameClassWithRefactoringEngine: target selectedClass theNonMetaClass ];
		parent: #'Trait Refactoring';
		order: 0.
	
	(aBuilder item: #'Remove...')
		action: [ target removeClassWithRefactoringEngine: target selectedClasses ];
		icon: (Smalltalk ui icons iconNamed: #removeIcon);
		parent: #'Trait Refactoring';
		order: 100;
		withSeparatorAfter.
		
	(aBuilder item: #'Realize')
		action: [ target refactor realizeClass ];
		parent: #'Trait Refactoring';
		order: 500.! !

!TraitDescription methodsFor: 'composition' stamp: 'CamilloBruni 4/27/2012 16:58'!
- anArrayOfSelectors
	^TraitExclusion
		with: self
		exclusions: (anArrayOfSelectors isSymbol 
							ifTrue: [{ anArrayOfSelectors }] 
							ifFalse: [ anArrayOfSelectors])! !

!TraitDescription methodsFor: '*Fuel' stamp: ''!
instanceVariableNamesDo: anUnaryBlock
	"This is part of the interface between the compiler and a class's instance or field names.
	 The class should enumerate anUnaryBlock with the instance variable name strings.  The order is important. Names evaluated later will override the
	 same names occurring earlier."

	| superInstSize |
	(superInstSize := self superclass notNil ifTrue: [self superclass instSize] ifFalse: [0]) > 0 ifTrue:
		[self superclass instanceVariableNamesDo: anUnaryBlock].
	1 to: self instSize - superInstSize do:
		[:i| anUnaryBlock value: (self instanceVariables at: i)]! !

!TraitDescription methodsFor: 'accessing parallel hierarchy' stamp: 'NS 12/9/2003 11:18'!
theMetaClass
	^ self classTrait! !

!TraitDescription methodsFor: 'accessing method dictionary' stamp: ''!
selectorsInProtocol: aName 
	"Answer a list of the selectors of the receiver that are in category named aName"
	
	| aColl |
	aColl := Set withAll: (self organization listAtCategoryNamed: aName).
	^ aColl asArray sort! !

!TraitDescription methodsFor: 'compiling' stamp: ''!
reformatAll
	"Reformat all methods in this class"
	self methods do: [:method | method reformat]! !

!TraitDescription methodsFor: 'accessing parallel hierarchy' stamp: ''!
isInstanceSide
	^self isClassSide not! !

!TraitDescription methodsFor: 'pool variable' stamp: ''!
hasSharedPools
	"Only a class may have shared pools"
	^ false! !

!TraitDescription methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
spotterPackageFor: aStep
	<spotterOrder: 50>
	aStep listProcessor
			title: 'Package';
			allCandidates: [ {self package} ];
			itemName: [ :item | item packageName ];
			itemIcon: #systemIcon;
			filter: GTFilterSubstring! !

!TraitDescription methodsFor: 'accessing parallel hierarchy' stamp: ''!
isMeta
	^self isClassSide! !

!TraitDescription methodsFor: 'filein/out' stamp: ''!
commentStamp: changeStamp
	self organization commentStamp: changeStamp.
	^ self commentStamp: changeStamp prior: 0! !

!TraitDescription methodsFor: 'copying' stamp: ''!
copyMethodDictionaryFrom: donorClass
	"Copy the method dictionary of the donor class over to the receiver"

	self methodDict: donorClass copyOfMethodDictionary.
	self organization: donorClass organization deepCopy.! !

!TraitDescription methodsFor: '*rpackage-core' stamp: ''!
packageFromOrganizer: anOrganizer
	"returns the package that defines this class"
	^ anOrganizer packageOf: self.! !

!TraitDescription methodsFor: 'slots' stamp: ''!
definesSlot: aSlot
	"Return true whether the receiver defines an instance variable named aString"
	
	^ self slots identityIncludes: aSlot! !

!TraitDescription methodsFor: 'accessing parallel hierarchy' stamp: ''!
classSide
	^self theMetaClass.! !

!TraitDescription methodsFor: 'accessing method dictionary' stamp: ''!
addSelectorSilently: selector withMethod: compiledMethod
	super addSelectorSilently: selector withMethod: compiledMethod.
	self instanceSide noteAddedSelector: selector meta: self isMeta.! !

!TraitDescription methodsFor: 'compiling' stamp: ''!
wantsRecompilationProgressReported
	"Answer whether the receiver would like progress of its recompilation reported interactively to the user."

	^ true! !

!TraitDescription methodsFor: 'filein/out' stamp: ''!
fileOutOrganizationOn: aFileStream
	"File a description of the receiver's organization on aFileStream."

	aFileStream cr; nextPut: $!!.
	aFileStream nextChunkPut: self name, ' reorganize'; cr.
	aFileStream nextChunkPut: self organization stringForFileOut ; cr! !

!TraitDescription methodsFor: 'slots' stamp: ''!
usesSpecialVariables
	"retirn true if we define something else than InstanceVariableSlots"
	^self usesSpecialSlot or: [self classVariables anySatisfy: [ :each | each isSpecial ] ]! !

!TraitDescription methodsFor: 'private' stamp: ''!
numberOfMethods
	"count all methods that are local (not comming from a trait)"
	| num |
	num := self localMethods size.
	^ self isMeta  
		ifTrue: [ num ]
		ifFalse: [ num + self class numberOfMethods ] ! !

!TraitDescription methodsFor: '*rpackage-core' stamp: ''!
isExtendedInPackage: aPackage
	"returns true if aPackage defines an extension to this class"
	^ aPackage extendsClass: self.! !

!TraitDescription methodsFor: 'slots' stamp: ''!
slotNames
	^self slots collect: [ :each | each name ]! !

!TraitDescription methodsFor: 'printing' stamp: ''!
instanceVariablesString
	"Answer a string of my instance variable names separated by spaces."

	^String streamContents: [ :stream |
		self instVarNames 
			do: [ :each | stream nextPutAll: each ]
			separatedBy: [ stream space ] ]! !

!TraitDescription methodsFor: 'organization updating' stamp: ''!
notifyOfRecategorizedSelector: selector from: oldCategory to: newCategory
	"If compiled method is not there, it meens it has been removed, not recategorized... so I skip 
	 the method recategorized announce"
	(self compiledMethodAt: selector ifAbsent: [ nil ]) 
		ifNotNil: [ :method | 
			SystemAnnouncer uniqueInstance 
				methodRecategorized: method
				oldProtocol: oldCategory ].
	SystemAnnouncer uniqueInstance suspendAllWhile: [
		self 
			notifyUsersOfRecategorizedSelector: selector 
			from: oldCategory 
			to: newCategory ]! !

!TraitDescription methodsFor: 'filein/out' stamp: ''!
fileOutCategory: catName 

	| internalStream |
	internalStream := (String new: 1000) writeStream.
	internalStream header; timeStamp.
	self fileOutCategory: catName on: internalStream moveSource: false toFile: 0.
	internalStream trailer.

	^ FileStream writeSourceCodeFrom: internalStream baseName: (self name , '-' , catName) isSt: true.! !

!TraitDescription methodsFor: 'initialize-release' stamp: ''!
updateInstancesFrom: oldClass
	"Recreate any existing instances of the argument, oldClass, as instances of 
	the receiver, which is a newly changed class. Permute variables as 
	necessary. Return the array of old instances (none of which should be
	pointed to legally by anyone but the array)."
	"ar 7/15/1999: The updating below is possibly dangerous. If there are any
	contexts having an old instance as receiver it might crash the system if
	the new receiver in which the context is executed has a different layout.
	See bottom below for a simple example:"
	| oldInstances |
	oldInstances := oldClass allInstances asArray.
	oldInstances := self updateInstances: oldInstances from: oldClass isMeta: self isMeta.
	^oldInstances

"	| crashingBlock class |
	class := Object subclass: #CrashTestDummy
		instanceVariableNames: 'instVar'
		classVariableNames: ''
		poolDictionaries: ''
		category: 'Crash-Test'.
	class compile:'instVar: value instVar := value'.
	class compile:'crashingBlock ^[instVar]'.
	crashingBlock := (class new) instVar: 42; crashingBlock.
	Object subclass: #CrashTestDummy
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: 'Crash-Test'.
	crashingBlock.
	crashingBlock value.
	"
! !

!TraitDescription methodsFor: '*rpackage-core' stamp: ''!
packageOrganizer
	"Returns the organizer of this class"
	^ RPackage organizer ! !

!TraitDescription methodsFor: 'instance variables' stamp: ''!
instVarNames
	"Answer an Array of the receiver's instance variable names."

	self instanceVariables
		ifNil: [^#()]
		ifNotNil: [^self instanceVariables]! !

!TraitDescription methodsFor: 'testing' stamp: ''!
isTestCase
	^false! !

!TraitDescription methodsFor: '*FuelTests' stamp: ''!
duringTestCompileSilently: code
	^ self 
		duringTestCompileSilently: code 
		storeSource: true! !

!TraitDescription methodsFor: 'enquiries' stamp: ''!
subject
	"for compatibility with TraitTransformations"
	^ self
! !

!TraitDescription methodsFor: 'filein/out' stamp: ''!
printCategoryChunk: category on: aFileStream withStamp: changeStamp priorMethod: priorMethod 
	"Print a method category preamble.  This must have a category name.
	It may have an author/date stamp, and it may have a prior source link.
	If it has a prior source link, it MUST have a stamp, even if it is empty."

"The current design is that changeStamps and prior source links are preserved in the changes file.  All fileOuts include changeStamps.  Condensing sources, however, eliminates all stamps (and links, natch)."

	aFileStream cr; nextPut: $!!.
	aFileStream nextChunkPut: (String streamContents:
		[:strm |
		strm nextPutAll: self name; nextPutAll: ' methodsFor: '; print: category asString.
		(changeStamp ~~ nil and:
			[changeStamp size > 0 or: [priorMethod ~~ nil]]) ifTrue:
			[strm nextPutAll: ' stamp: '; print: changeStamp].
		priorMethod ~~ nil ifTrue:
			[strm nextPutAll: ' prior: '; print: priorMethod sourcePointer]]).
	! !

!TraitDescription methodsFor: '*NautilusRefactoring' stamp: ''!
codeRewritingClass: aBuilder
	| target |
	target := aBuilder model.
	
	(aBuilder item: #'Rewrite Code')
		action: [ target refactor rewriteCode ];
		parent: #'Code Rewriting';
		order: 0.

	(aBuilder item: #'Search Code')
		action: [ target refactor searchCode ];
		parent: #'Code Rewriting';
		order: 100.
		
	(aBuilder item: #'Type class')
		action: [ target refactor typeClass ];
		parent: #'Code Rewriting';
		order: 200;
		withSeparatorAfter.
		
	(aBuilder item: #'Category Regex')
		action: [ target refactor categoryRegex ];
		parent: #'Code Rewriting';
		order: 300.
		
	(aBuilder item: #'Class Regex')
		action: [ target refactor classRegex ];
		parent: #'Code Rewriting';
		order: 400.
		
	(aBuilder item: #'Protocol Regex')
		action: [ target refactor protocolRegex ];
		parent: #'Code Rewriting';
		order: 500.
		
	(aBuilder item: #'Source Regex')
		action: [ target refactor sourceRegex ];
		parent: #'Code Rewriting';
		order: 600;
		withSeparatorAfter.! !

!TraitDescription methodsFor: 'compiling' stamp: ''!
compileSilently: code classified: category
	"Compile the code and classify the resulting method in the given category, leaving no trail in the system log, nor in any change set, nor in the 'recent submissions' list. This should only be used when you know for sure that the compilation will succeed."

	^ self compileSilently: code classified: category notifying: nil.! !

!TraitDescription methodsFor: 'accessing class hierarchy' stamp: ''!
classesThatImplementAllOf: selectorSet
	"Return an array of any classes that implement all the messages in selectorSet."

	| found remaining |
	found := OrderedCollection new.
	selectorSet do:
		[:sel | (self includesSelector: sel) ifTrue: [found add: sel]].
	found isEmpty
		ifTrue: [^ self subclasses inject: Array new
						into: [:subsThatDo :sub |
							subsThatDo , (sub classesThatImplementAllOf: selectorSet)]]
		ifFalse: [remaining := selectorSet copyWithoutAll: found.
				remaining isEmpty ifTrue: [^ Array with: self].
				^ self subclasses inject: Array new
						into: [:subsThatDo :sub |
							subsThatDo , (sub classesThatImplementAllOf: remaining)]]! !

!TraitDescription methodsFor: 'printing' stamp: ''!
slotDefinitionString
	"Answer a string that contains an executable description of my Slots"

	"^self slots ifNotEmpty: [self slots asString] ifEmpty: ['{}']"
	
	^String streamContents: [ :str | | special |
		str nextPutAll: '{ '.
		self slots do: [:slot |
				str nextPutAll: slot definitionString.
				special := slot isSpecial]				
			separatedBy: [ 
				str nextPutAll: '. '.  
				special ifTrue: [ str cr;tab;tab;tab;tab ]].
		str nextPutAll: ' }'. ]
! !

!TraitDescription methodsFor: 'slots' stamp: 'MarcusDenker 3/23/2015 14:47'!
slotNamed: aName ifFound: foundBlock ifNone: exceptionBlock
	"Tratis have no slots"
	^self error: 'no slot found'.! !

!TraitDescription methodsFor: 'filein/out' stamp: ''!
fileOutOn: aFileStream 
	"File a description of the receiver on aFileStream."

	self fileOutOn: aFileStream
		moveSource: false
		toFile: 0! !

!TraitDescription methodsFor: 'initialize-release' stamp: ''!
updateInstances: oldInstances from: oldClass isMeta: isMeta
	"Recreate any existing instances of the argument, oldClass, as instances of the receiver, which is a newly changed class. Permute variables as necessary. Return the array of old instances (none of which should be pointed to legally by anyone but the array)."

	"If there are any contexts having an old instance as receiver it might crash the system because the layout has changed, and the method only knows about the old layout."

	| variable instSize newInstances |
	oldInstances isEmpty
		ifTrue: [ ^ #() ].	"no instances to convert"
	isMeta
		ifTrue: [ 
			oldInstances size = 1
				ifFalse: [ ^ self error: 'Metaclasses can only have one instance' ].
			self soleInstance class == self
				ifTrue: [ ^ self error: 'Metaclasses can only have one instance' ] ].
	variable := self isVariable.
	instSize := self instSize.
	newInstances := Array new: oldInstances size.
	1 to: oldInstances size do: [ :i | newInstances at: i put: (self newInstanceFrom: (oldInstances at: i) variable: variable size: instSize) ].	"Now perform a bulk mutation of old instances into new ones"
	oldInstances elementsExchangeIdentityWith: newInstances.
	^ newInstances	"which are now old"! !

!TraitDescription methodsFor: 'initialize-release' stamp: ''!
superclass: aClass methodDictionary: mDict format: fmt
	"Basic initialization of the receiver"
	super superclass: aClass methodDictionary: mDict format: fmt.
	self instanceVariables: nil.
	self organization: nil.! !

!TraitDescription methodsFor: 'organization' stamp: ''!
organization
	"Answer the instance of ClassOrganizer that represents the organization 
	of the messages of the receiver."

	self basicOrganization
		ifNil: [ self basicOrganization: (self isTrait
						ifTrue: [ ClassOrganization new ]
						ifFalse: [ ClassOrganization forClass: self ]) ].
	^self basicOrganization setSubject: self.	"Making sure that subject is set correctly. It should not be necessary."
	
	! !

!TraitDescription methodsFor: 'accessing' stamp: 'SebastianTleye 7/12/2013 16:09'!
instanceVariables: anObject
	"Compatibility purposes"! !

!TraitDescription methodsFor: 'compiling' stamp: ''!
compile: code notifying: requestor 
	"Refer to the comment in Behavior|compile:notifying:." 

	^self compile: code
		 classified: Protocol unclassified
		 notifying: requestor! !

!TraitDescription methodsFor: 'organization updating' stamp: ''!
updateOrganizationDescription: each oldCategory: newCategoryOrNil newCategory: oldCategoryOrNil changed: changedCategories
	| sel effectiveCategory currentCategory |
	
	sel := each selector.
	(self includesLocalSelector: sel) ifTrue: [ ^ self ].
	
	currentCategory := self organization categoryOfElement: sel.
	effectiveCategory := each 
		effectiveMethodCategoryCurrent: currentCategory 
		new: newCategoryOrNil.
	
	effectiveCategory 
		ifNil: [ 
			currentCategory ifNotNil: [ changedCategories add: currentCategory ].
			self organization removeElement: sel.
			^ self ].
		
	(currentCategory isNil 
		or: [ currentCategory == Protocol ambiguous 
		or: [ currentCategory == oldCategoryOrNil ] ])
	ifFalse: [ ^ self ].
	
	(currentCategory ~~ effectiveCategory)
		ifTrue: [ 
			currentCategory ifNotNil: [ changedCategories add: currentCategory ].
			self organization classify: sel under: effectiveCategory suppressIfDefault: false ]! !

!TraitDescription methodsFor: 'instance variables' stamp: 'SebastianTleye 7/12/2013 16:06'!
addInstVarNamed: aString
	"Compatibility purposes"! !

!TraitDescription methodsFor: 'slots' stamp: 'MarcusDenker 3/23/2015 14:47'!
slotNamed: aName ifFound: foundBlock
	"Tratis have no slots"
	^self error: 'no slot found'.! !

!TraitDescription methodsFor: '*NautilusRefactoring' stamp: 'MarkRizun 7/20/2014 20:57'!
methodRefactoring: aBuilder
	| target selectedMethod selectedMethods |

	target := aBuilder model.
	selectedMethod := target selectedMethod.
	selectedMethods := target selectedMethods.
	selectedMethod ifNil:[ ^ target ].
	
	(aBuilder item: #'Add a parameter')
		action: [ target refactor addAParameterFor: selectedMethod ];
		order: 50;
		parent: #'Refactoring'.
		
	(aBuilder item: #'Deprecate')
		action: [ target refactor deprecateMethodFor: selectedMethod ];
		order: 75;
		parent: #'Refactoring'.
			
	(aBuilder item: #'Inline parameter')
		action: [ target refactor inlineParameterFor: selectedMethod ];
		order: 100;
		parent: #'Refactoring'.
			
	(aBuilder item: #'Inline target sends')
		action: [ target refactor inlineAllSendersFor: selectedMethod ];
		order: 200;
		parent: #'Refactoring'.
			
	(aBuilder item: #'Move')
		action: [ target refactor moveMethodFor: selectedMethod ];
		order: 300;
		parent: #'Refactoring'.
			
	(aBuilder item: #'Remove')
		action: [ target refactor removeMethodsFor: selectedMethods ];
		order: 700;
		parent: #'Refactoring'.
		
	(aBuilder item: #'Remove parameter')
		action: [ target refactor removeParameterFor: selectedMethod ];
		order: 800;
		enabledBlock: [ selectedMethods size < 2 ];
		parent: #'Refactoring'.
			
	(self renameMethodAllItem: aBuilder)
		order: 850;
		parent: #'Refactoring';
		withSeparatorAfter.
				
	(aBuilder item: #'Undo')
		order: 900;
		label: target refactor undoLabel;
		action: [ target refactor undoOperation ];
		enabled: target refactor undoEnabled;
		parent: #'Refactoring'.
	
	(aBuilder item: #'Redo')
		order: 1000;
		label: target refactor redoLabel;
		action: [ target refactor redoOperation ];
		enabled: target refactor redoEnabled;
		parent: #'Refactoring';
		withSeparatorAfter.! !

!TraitDescription methodsFor: 'accessing comment' stamp: ''!
classCommentBlank

	| existingComment stream |
	existingComment := self theNonMetaClass organization classComment.
	existingComment isEmpty
		ifFalse: [^existingComment].

	stream := (String new: 100) writeStream.
	
	stream nextPutAll: 'Please comment me using the following template inspired by Class Responsibility Collaborator (CRC) design:

For the Class part:  State the name of the class with one line description: For example, I''m xxx the root of the hierarchy of visitor objects.

For the Responsibility part: Three sentences about my main responsibility, what I''m doing, what services do I offer.

For the Collaborators Part: State my main collaborators and one line about how I interact with them. 

Public API and Key Messages

- message one   
- message two 
- what is the way to create instances is a plus.

   One simple example is simply gorgeous.
 
Internal Representation and Key Implementation Points.'.
			
	(self instVarNames size > 0)
		 ifTrue: [stream cr; cr; nextPutAll: '    Instance Variables'.  ].
		
	self instVarNames asSortedCollection do: [:each |
		stream
			cr; tab; nextPutAll: each;
			nextPut: $:;
			tab; tab;
			nextPutAll: '<Object>'].
	stream cr.
stream cr; cr; nextPutAll: '    Implementation Points'.
	^stream contents! !

!TraitDescription methodsFor: 'filein/out' stamp: ''!
methodsFor: categoryName 
	"Answer a ClassCategoryReader for compiling the messages in the category, categoryName, of the receiver."

	^ ClassCategoryReader new setClass: self category: categoryName asSymbol

	"(False methodsFor: 'logical operations') inspect"! !

!TraitDescription methodsFor: 'filein/out' stamp: ''!
fileOutChangedMessages: aSet on: aFileStream 
	"File a description of the messages of the receiver that have been 
	changed (i.e., are entered into the argument, aSet) onto aFileStream."

	self fileOutChangedMessages: aSet
		on: aFileStream
		moveSource: false
		toFile: 0! !

!TraitDescription methodsFor: 'accessing comment' stamp: ''!
hasComment
	"return whether this class truly has a comment other than the default"
	| org |
	org := self instanceSide organization.
	^org classComment isEmptyOrNil not! !

!TraitDescription methodsFor: '*NautilusRefactoring' stamp: ''!
sourceCodeRefactoring: aBuilder
	| target |
	target := aBuilder model.
	
	(aBuilder item: #'Create cascade')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor createCascadeBetween: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 0.
			
	(aBuilder item: #'Extract method')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor extractBetween: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 100.
			
	(aBuilder item: #'Extract method to component')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor extractToComponentBetween: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 200.
		
	(aBuilder item: #'Extract to temporary')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor extractToTemporaryBetween: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 300.
			
	(aBuilder item: #'Inline method')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor inlineMethodBetween: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 400.
			
	(aBuilder item: #'Inline method from component')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor inlineMethodFromComponentBetween: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 500.
			
	(aBuilder item: #'Inline temporary')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor inlineTemporaryBetween: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 600.
			
	(aBuilder item: #'Move variable definition')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor moveVariableDefinitionBetween: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 700.
				
	(aBuilder item: #'Rename temporary')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor renameTemporaryNamed: target sourceTextArea selectedContents Between: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 800.	
						
	(aBuilder item: #'Split cascade')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor splitCascadeBetween: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 900.	
					
	(aBuilder item: #'Temporary to instvar')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor temporaryToInstanceVariableNamed: target sourceTextArea selectedContents asString Between: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 1000;
			withSeparatorAfter.
			
		(aBuilder item: #'Undo')
			order: 1100;
			label: target refactor undoLabel;
			action: [ target refactor undoOperation ];
			enabled: target refactor undoEnabled;
			parent: #'Source code refactoring'.
	
	(aBuilder item: #'Redo')
			order: 1200;
			label: target refactor redoLabel;
			action: [ target refactor redoOperation ];
			enabled: target refactor redoEnabled;
			parent: #'Source code refactoring';
			withSeparatorAfter.! !

!TraitDescription methodsFor: 'enquiries' stamp: ''!
allAliasesDict
	^IdentityDictionary new
! !

!TraitDescription methodsFor: '*rpackage-core' stamp: ''!
packages
	"the extending packages of a class are the packages that extend it."
	
	^  self extendingPackages asSet copy add: self package; yourself! !

!TraitDescription methodsFor: 'organization updating' stamp: ''!
applyChangesOfNewTraitCompositionReplacing: oldComposition
	| changedSelectors oldMethodDict |
	oldMethodDict := self methodDict copy.
	changedSelectors := super applyChangesOfNewTraitCompositionReplacing: oldComposition.
	self noteRecategorizedSelectors: changedSelectors oldComposition: oldComposition.
	self noteChangesFrom: oldMethodDict.
	^ changedSelectors.! !

!TraitDescription methodsFor: '*Manifest-Core' stamp: ''!
manifestBuilderForRuleChecker: aRuleChecker
	"Return the manifestsince the rulechecker is keeping a cache, we ask it back"

	^ aRuleChecker manifestBuilderOfClass: self! !

!TraitDescription methodsFor: 'slots' stamp: ''!
usesSpecialSlot
	"retirn true if we define something else than InstanceVariableSlots"
	^self slots anySatisfy: [ :each | each isSpecial ]! !

!TraitDescription methodsFor: 'printing' stamp: ''!
printOn: aStream 
	aStream nextPutAll: self name! !

!TraitDescription methodsFor: 'organization updating' stamp: ''!
noteRecategorizedSelectors: aCollection oldComposition: aTraitComposition
	
	aCollection do: [:each | | oldCategory newCategory | 
		oldCategory := self organization categoryOfElement: each.
		newCategory := (self traitComposition methodDescriptionForSelector: each) effectiveMethodCategory.
		self noteRecategorizedSelector: each from: oldCategory to: newCategory]! !

!TraitDescription methodsFor: 'accessing class hierarchy' stamp: ''!
subclassesDo: aBlock
	"Evaluate the argument, aBlock, for each of the receiver's immediate subclasses."
	^self subclasses do: aBlock! !

!TraitDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/12/2013 16:11'!
definition
	"Answer a String that defines the receiver"

	^String streamContents: [:stream |
		stream nextPutAll: self class name.
		stream nextPutAll: ' named: ';
				store: self name.
		stream cr; tab; nextPutAll: 'uses: ';
				nextPutAll: self traitCompositionString.
		stream cr; tab; nextPutAll: 'category: ';
				store: self category asString].! !

!TraitDescription methodsFor: 'printing' stamp: ''!
storeOn: aStream
	"Classes and Metaclasses have global names."

	aStream nextPutAll: self name! !

!TraitDescription methodsFor: 'enquiries' stamp: ''!
collectMethodsFor: aSelector into: methodDescription
	(self includesSelector: aSelector) ifTrue: [ 
		methodDescription addLocatedMethod: 
			(self compiledMethodAt: aSelector)
		]! !

!TraitDescription methodsFor: 'organization updating' stamp: ''!
noteMethodRemoved: oldMethod
	self flag: #todo. "protocol and origin are not set properly here"
	SystemAnnouncer uniqueInstance methodRemoved: oldMethod protocol: oldMethod protocol origin: oldMethod origin! !

!TraitDescription methodsFor: 'instance variables' stamp: ''!
forceNewFrom: anArray
    "Create a new instance of the class and fill
    its instance variables up with the array."
    | object max |

    object := self new.
    max := self instSize.
    anArray doWithIndex: [:each :index |
        index > max ifFalse:
            [object instVarAt: index put: each]].
    ^ object! !

!TraitDescription methodsFor: 'accessing parallel hierarchy' stamp: 'al 3/16/2004 10:47'!
isClassTrait
	self subclassResponsibility! !

!TraitDescription methodsFor: '*FuelTests' stamp: ''!
duringTestCompileSilently: code storeSource: storeSource
	^ self
		duringTestCompileSilently: code
		storeSource: storeSource
		classified: ''! !

!TraitDescription methodsFor: 'private' stamp: ''!
newInstanceFrom: oldInstance variable: variable size: instSize map: map
	"Create a new instance of the receiver based on the given old instance.
	The supplied map contains a mapping of the old instVar names into
	the receiver's instVars"
	| new |
	variable
		ifTrue: [new := self basicNew: oldInstance basicSize]
		ifFalse: [new := self basicNew].
	1 to: instSize do: 
		[:offset |  (map at: offset) > 0 ifTrue:
			[new instVarAt: offset
					put: (oldInstance instVarAt: (map at: offset))]].
	variable 
		ifTrue: [1 to: oldInstance basicSize do: 
					[:offset |
					new basicAt: offset put: (oldInstance basicAt: offset)]].
	^new! !

!TraitDescription methodsFor: 'organization updating' stamp: 'SebastianTleye 7/1/2013 17:53'!
updateOrganizationSelector: aSymbol oldCategory: oldCategoryOrNil newCategory: newCategoryOrNil
	| changedCategories composition |
	
	changedCategories := IdentitySet new.
	
	composition := self hasTraitComposition
		ifTrue: [ self traitComposition ]
		ifFalse: [ TraitComposition new ].
	
	(composition methodDescriptionsForSelector: aSymbol)
		do: [ :each | 
			self
				updateOrganizationDescription: each
				oldCategory: newCategoryOrNil
				newCategory: oldCategoryOrNil
				changed: changedCategories ].
			
	^ changedCategories! !

!TraitDescription methodsFor: 'filein/out' stamp: ''!
moveChangesTo: newFile 
	"Used in the process of condensing changes, this message requests that 
	the source code of all methods of the receiver that have been changed 
	should be moved to newFile."

	| changes |
	changes := self selectors select: [:sel | (self compiledMethodAt: sel) fileIndex > 1 ].
	self
		fileOutChangedMessages: changes
		on: newFile
		moveSource: true
		toFile: 2! !

!TraitDescription methodsFor: 'compiling' stamp: ''!
wantsChangeSetLogging
	"Answer whether code submitted for the receiver should be remembered by the changeSet mechanism."

	^ true! !

!TraitDescription methodsFor: '*NautilusRefactoring' stamp: 'SebastianTleye 8/13/2013 14:21'!
varRefactoringSubMenu: aBuilder
	! !

!TraitDescription methodsFor: '*NautilusRefactoring' stamp: ''!
sourceCodeRefactoringMenu: aBuilder
	| target |
	target := aBuilder model.
	
	(aBuilder item: #'Format')
		order: 1100;
		keyText: 'Shift f';
		action: [ target refactor formatSourceCode ].
		
	(aBuilder item: #'Source code refactoring')
			order: 1101;
			arguments: {};
			withSeparatorAfter.! !

!TraitDescription methodsFor: 'composition' stamp: 'al 12/7/2005 21:00'!
addExclusionOf: aSymbol
	^self - {aSymbol}! !

!TraitDescription methodsFor: 'users notification' stamp: ''!
notifyUsersOfRecategorizedSelector: element from: oldCategory to: newCategory
	self traitUsers do: [:each |
		each noteRecategorizedSelector: element from: oldCategory to: newCategory]! !

!TraitDescription methodsFor: 'organization' stamp: ''!
addCategory: newName before: aCategory

	^ self organization addCategory: newName before: aCategory ! !

!TraitDescription methodsFor: '*rpackage-core' stamp: ''!
packagesWithoutExtensions
	^ Set new add: self package; yourself.! !

!TraitDescription methodsFor: 'copying' stamp: ''!
copyCategory: cat from: aClass classified: newCat 
	"Specify that one of the categories of messages for the receiver is the 
	third argument, newCat. Copy each message found in the category cat in 
	class aClass into this new category."

	self copyAll: (aClass organization listAtCategoryNamed: cat)
		from: aClass
		classified: newCat! !

!TraitDescription methodsFor: 'slots' stamp: 'MarcusDenker 6/26/2014 14:02'!
slots
	^#()! !

!TraitDescription methodsFor: 'pool variable' stamp: ''!
usesLocalPoolVarNamed: aString
	^false.! !

!TraitDescription methodsFor: 'enquiries' stamp: ''!
aliasesForSelector: aSelector 
	^ OrderedCollection new
! !

!TraitDescription methodsFor: 'filein/out' stamp: ''!
classComment: aString stamp: aStamp
	"Store the comment, aString or Text or RemoteString, associated with the class we are organizing.  Empty string gets stored only if had a non-empty one before."

	| pointer header file oldCommentRemoteString oldComment oldStamp |
	oldComment := self organization classComment.
	oldStamp := self organization commentStamp.

	(aString isKindOf: RemoteString) ifTrue: [
		SystemAnnouncer uniqueInstance 
			class: self 
			oldComment: oldComment 
			newComment: aString string 
			oldStamp: oldStamp 
			newStamp: aStamp.
		^ self organization classComment: aString stamp: aStamp].

	oldCommentRemoteString := self organization commentRemoteString.
	(aString size = 0) & (oldCommentRemoteString isNil) ifTrue: [^ self organization classComment: nil].
		"never had a class comment, no need to write empty string out"

	pointer := oldCommentRemoteString 
			ifNil: [0] 
			ifNotNil: [oldCommentRemoteString sourcePointer].
	
	(file := SourceFiles at: 2) ifNotNil: [
		file setToEnd; cr; nextPut: $!!.	"directly"
		"Should be saying (file command: 'H3') for HTML, but ignoring it here"
		header := String streamContents: [:strm | strm nextPutAll: self name;
			nextPutAll: ' commentStamp: '.
			aStamp storeOn: strm.
			strm nextPutAll: ' prior: '; nextPutAll: pointer printString].
		file nextChunkPut: header].
	
	self organization 
		classComment: (RemoteString newString: aString onFileNumber: 2) 
		stamp: aStamp.
	
	SystemAnnouncer uniqueInstance 
		class: self 
		oldComment: oldComment 
		newComment: aString 
		oldStamp: oldStamp 
		newStamp: aStamp! !

!TraitDescription methodsFor: 'composition' stamp: ''!
@ anArrayOfAssociations 
	^ TraitAlias with: self aliases: anArrayOfAssociations! !

!TraitDescription methodsFor: '*rpackage-core' stamp: ''!
package
	^ RPackage organizer packageOf: self.	! !

!TraitDescription methodsFor: 'copying' stamp: ''!
copyAll: selArray from: class 
	"Install all the methods found in the method dictionary of the second 
	argument, class, as the receiver's methods. Classify the messages under 
	-As yet not classified-."

	self copyAll: selArray
		from: class
		classified: nil! !

!TraitDescription methodsFor: 'compiling' stamp: ''!
compile: code classified: heading 
	"Compile the argument, code, as source code in the context of the 
	receiver and install the result in the receiver's method dictionary under 
	the classification indicated by the second argument, heading. nil is to be 
	notified if an error occurs. The argument code is either a string or an 
	object that converts to a string or a PositionableStream on an object that 
	converts to a string."

	^self
		compile: code
		classified: heading
		notifying: nil! !

!TraitDescription methodsFor: '*NautilusRefactoring' stamp: ''!
packageRefactoringMenu: aBuilder
	| target |
	target := aBuilder model.
	
	(aBuilder item: #'Rewrite Code')
		order:  100;
		withSeparatorAfter.
	
	(aBuilder item: #'Rewrite Code')
		action: [ target refactor rewriteCode ];
		parent: #'Rewrite Code';
		order: 0.

	(aBuilder item: #'Search Code')
		action: [ target refactor searchCode ];
		parent: #'Rewrite Code';
		order: 100.! !

!TraitDescription methodsFor: 'accessing comment' stamp: ''!
comment: aStringOrText stamp: aStamp
	"Set the receiver's comment to be the argument, aStringOrText."

	self instanceSide classComment: aStringOrText stamp: aStamp.! !

!TraitDescription methodsFor: '*Nautilus' stamp: ''!
definitionForNautilus

	^ self definition! !

!TraitDescription methodsFor: 'organization updating' stamp: ''!
noteRecategorizedSelector: aSymbol from: oldCategoryOrNil to: newCategoryOrNil
	| changedCategories |
	changedCategories := self updateOrganizationSelector: aSymbol oldCategory: oldCategoryOrNil newCategory: newCategoryOrNil.
	changedCategories do: [:each |
		(self organization isEmptyCategoryNamed: each) ifTrue: [self organization removeCategory: each]]! !

!TraitDescription methodsFor: 'instance variables' stamp: ''!
instVarIndexFor: instVarName
	"Answer the index of the named instance variable."

	^self instVarIndexFor: instVarName ifAbsent: 0! !

!TraitDescription methodsFor: 'private' stamp: ''!
addOnTheLeft: aTraitExpression
	^TraitComposition with: aTraitExpression with: self! !

!TraitDescription methodsFor: '*GT-InspectorExtensions-Core' stamp: ''!
gtInspectorUsersIn: composite
	<gtInspectorPresentationOrder: 30>
	composite list 	
		title: 'Users';
		when: [ self isTrait ];
		display: [ 
			self traitUsers asArray
			"Smalltalk allClasses select: [ :class |
			   class traitComposition traits includes: self ]" ]! !

!TraitDescription methodsFor: 'filein/out' stamp: ''!
fileOutMethod: selector on: aStream
	
	(selector == #Comment) ifTrue: [^ self inform: 'Sorry, cannot file out class comment in isolation.'].
	(self includesSelector: selector) ifFalse: [^ self error: 'Selector ', selector asString, ' not found'].
	aStream header; timeStamp.
	self printMethodChunk: selector withPreamble: true
		on: aStream moveSource: false toFile: 0.! !

!TraitDescription methodsFor: 'slots' stamp: 'MarcusDenker 6/26/2014 14:02'!
allSlots
	^#()! !

!TraitDescription methodsFor: '*Glamour-Morphic-Brick' stamp: ''!
slotsDictionary
	^ self isTrait 
		ifTrue: [ Dictionary new ]
		ifFalse: [ self layout slotsDictionary ]! !

!TraitDescription methodsFor: 'authors' stamp: ''!
authors
	"Returns a bag representing the author frequency based on the latest version of the methods of the receiver."

	^(self methods, self class methods) collect: [ :each | each author ] as: Bag .
	
	! !

!TraitDescription methodsFor: 'organization' stamp: ''!
reorganize
	"During fileIn, !!Rectangle reorganize!! allows Rectangle to seize control and treat the next chunk as its organization.  See the transfer of control where ReadWriteStream fileIn calls scanFrom:"

	^self organization! !

!TraitDescription methodsFor: 'users notification' stamp: ''!
notifyUsersOfChangedSelectors: aCollection
	self traitUsers do: [:each |
		each noteChangedSelectors: aCollection]! !

!TraitDescription methodsFor: 'instance variables' stamp: ''!
classThatDefinesClassVariable: classVarName
	"Answer the class that defines the given class variable"

	(self classPool includesKey: classVarName asSymbol) ifTrue: [^ self]. 
	^self superclass ifNotNil: [self superclass classThatDefinesClassVariable: classVarName]! !

!TraitDescription methodsFor: 'compiling' stamp: ''!
logMethodSource: aText forMethod: aCompiledMethod inCategory: category withStamp: changeStamp
	aCompiledMethod
		putSource: aText
		class: self
		category: category
		withStamp: changeStamp 
		inFile: 2
		priorMethod: (self
					compiledMethodAt: aCompiledMethod selector
					ifAbsent: [])! !

!TraitDescription methodsFor: 'copying' stamp: ''!
copyAll: selArray from: class classified: cat 
	"Install all the methods found in the method dictionary of the second 
	argument, class, as the receiver's methods. Classify the messages under 
	the third argument, cat."

	selArray do: [:s |
		(class includesLocalSelector: s) ifTrue: [
			self copy: s
				from: class
				classified: cat ] ]! !

!TraitDescription methodsFor: 'compiling' stamp: ''!
acceptsLoggingOfCompilation
	"Answer whether the receiver's method submisions and class defintions should be logged to the changes file and to the current change set.  The metaclass follows the rule of the class itself
	Weird name is so that it will come lexically before #compile, so that a clean build can make it through."

	^ true! !

!TraitDescription methodsFor: 'private' stamp: ''!
notifyRepackage: selector method: compiledMethod oldProtocol: oldProtocol newProtocol: newProtocol
	| oldPackage newPackage |
	
	(newProtocol = oldProtocol)
		ifTrue: [ ^ self ].
		
	"This indirection is because we need to abstract RPackage from the kernel"
	#RPackage asClassIfPresent: [ :rPackageClass | 
			newPackage := rPackageClass organizer 
				packageForProtocol: newProtocol 
				inClass: self.
			oldPackage := rPackageClass organizer 
				packageForProtocol: oldProtocol 
				inClass: self.
			
			"Announce recategorization"
			newPackage = oldPackage
				ifFalse: [ 
					SystemAnnouncer uniqueInstance 
						methodRepackaged: compiledMethod 
						from: oldPackage 
						to: newPackage ] ].	
	
	SystemAnnouncer uniqueInstance methodRecategorized: compiledMethod oldProtocol: oldProtocol! !

!TraitDescription methodsFor: 'converting' stamp: ''!
asTraitComposition
	^TraitComposition with: self! !

!TraitDescription methodsFor: 'instance variables' stamp: ''!
removeInstVarNamed: aString 
	"Remove the argument, aString, as one of the receiver's instance 
	variables. Create an error notification if the argument is not found."

	^self subclassResponsibility! !

!TraitDescription methodsFor: 'filein/out' stamp: ''!
classComment: aString
	"Store the comment, aString or Text or RemoteString, associated with the class we are orgainzing.  Empty string gets stored only if had a non-empty one before."
	^ self classComment: aString stamp: '<historical>'! !

!TraitDescription methodsFor: 'copying' stamp: ''!
copy: sel from: class classified: cat 
	"Install the method associated with the first arugment, sel, a message 
	selector, found in the method dictionary of the second argument, class, 
	as one of the receiver's methods. Classify the message under the third 
	argument, cat."

	| code category |
	"Useful when modifying an existing class"
	code := class sourceCodeAt: sel.
	code ifNotNil: 
			[cat
				ifNil: [category := class organization categoryOfElement: sel]
				ifNotNil: [category := cat].
			(self includesLocalSelector: sel)
				ifTrue: [code asString = (self sourceCodeAt: sel) asString 
							ifFalse: [self error: self name 
										, ' ' 
										, sel 
										, ' will be redefined if you proceed.']].
			self compile: code classified: category]! !

!TraitDescription methodsFor: '*rpackage-core' stamp: ''!
compileSilently: code 
	"Compile the code and classify the resulting method in the given category, leaving no trail in the system log, nor in any change set, nor in the 'recent submissions' list. This should only be used when you know for sure that the compilation will succeed."

	^ self compileSilently: code classified: 'not defined category' notifying: nil.! !

!TraitDescription methodsFor: '*rpackage-core' stamp: ''!
extendingPackages
	"the extending packages of a class are the packages that extend it."
	^ RPackage organizer extendingPackagesOf: self! !

!TraitDescription methodsFor: '*Manifest-Core' stamp: ''!
criticNameOn: aStream
	"This behavior may be folded later by changing the name of this method or using another one."
	
	aStream 
		<< self name 
		<< ' (' 
		<< self category 
		<< ')' ! !

!TraitDescription methodsFor: 'organization updating' stamp: ''!
updateOrganizationDescription: aTraitMethodDescription oldCategory: oldCategoryOrNil newCategory: newCategoryOrNil changedCategories: changedCategories
	| sel effectiveCategory currentCategory |
	sel := aTraitMethodDescription selector.
	
	(self includesLocalSelector: sel) ifTrue: [ ^ self ].
	 
	currentCategory := self organization categoryOfElement: sel.
	effectiveCategory := aTraitMethodDescription effectiveMethodCategoryCurrent: currentCategory new: newCategoryOrNil.
	
	effectiveCategory ifNil: [ 
		currentCategory ifNotNil: [ changedCategories add: currentCategory ].
		^ self organization removeElement: sel ].
		
	((currentCategory isNil 
		or: [ 
				currentCategory == Protocol ambiguous 
				or: [ currentCategory == oldCategoryOrNil ] ])
		and: [ currentCategory ~~ effectiveCategory ])
		ifTrue: [ 
			currentCategory ifNotNil: [ changedCategories add: currentCategory ].
			self organization classify: sel under: effectiveCategory suppressIfDefault: false ]! !

!TraitDescription methodsFor: 'enquiries' stamp: ''!
changedSelectorsComparedTo: aTraitTransformation
	| selectors otherSelectors changedSelectors aliases otherAliases |
	selectors := self allSelectors asIdentitySet.
	otherSelectors := aTraitTransformation allSelectors asIdentitySet.
	changedSelectors := IdentitySet withAll: (
		(selectors difference: otherSelectors) union: (otherSelectors difference: selectors)).
	aliases := self allAliasesDict.
	otherAliases := aTraitTransformation allAliasesDict.
	aliases keysAndValuesDo: [:key :value |
		(value ~~ (otherAliases at: key ifAbsent: [nil])) ifTrue: [changedSelectors add: key]].
	otherAliases keysAndValuesDo: [:key :value |
		(value ~~ (aliases at: key ifAbsent: [nil])) ifTrue: [changedSelectors add: key]].
	^ changedSelectors.
! !

!TraitDescription methodsFor: '*FuelTests' stamp: ''!
duringTestCompileSilently: code classified: aCategory
	^ self 
		duringTestCompileSilently: code
		storeSource: true
		classified: aCategory! !

!TraitDescription methodsFor: '*FuelTests' stamp: ''!
duringTestCompileSilently: code storeSource: storeSource classified: aCategory
	^ Author 
		useAuthor: 'TestsAuthor'
		during: [ [
			self 
				compile: code
				classified: (aCategory ifNil: [ '' ])
				withStamp: nil 
				notifying: nil 
				logSource: storeSource ] fuelValueWithoutNotifications ]! !

!TraitDescription methodsFor: 'as yet unclassified ' stamp: 'MartinDias 1/23/2014 15:15'!
syntacticallyEquals: aTraitTransformation
	"Test syntactic equivalence of this trait (as a trait transformation) with another."

	^ self = aTraitTransformation! !

!TraitDescription methodsFor: 'accessing parallel hierarchy' stamp: ''!
hasClassSide
	^self subclassResponsibility.! !

!TraitDescription methodsFor: 'accessing parallel hierarchy' stamp: ''!
instanceSide
	^ self theNonMetaClass! !

!TraitDescription methodsFor: 'compiling' stamp: ''!
compile: text classified: category withStamp: changeStamp notifying: requestor
	^ self
		compile: text
		classified: category
		withStamp: changeStamp
		notifying: requestor
		logSource: self acceptsLoggingOfCompilation! !

!TraitDescription methodsFor: 'filein/out' stamp: ''!
printMethodChunk: selector withPreamble: doPreamble on: outStream moveSource: moveSource toFile: fileIndex
	"Copy the source code for the method associated with selector onto the fileStream.  If moveSource true, then also set the source code pointer of the method."

	| preamble method oldPos newPos sourceFile |
	doPreamble
		ifTrue: [ preamble := self name , ' methodsFor: ' , (self organization categoryOfElement: selector) asString printString ]
		ifFalse: [ preamble := '' ].
	method := self methodDict
		at: selector
		ifAbsent: [ 
			outStream
				nextPutAll: selector;
				cr.
			outStream
				tab;
				nextPutAll: '** ERROR!!  THIS SCRIPT IS MISSING ** ' translated;
				cr;
				cr.
			outStream nextPutAll: '  '.
			^ outStream ].
	oldPos := method filePosition.
	sourceFile := SourceFiles at: method fileIndex.
	preamble size > 0
		ifTrue: [ 
			"Copy the preamble"
			outStream copyPreamble: preamble from: sourceFile at: oldPos ]
		ifFalse: [ sourceFile position: oldPos ].	"Copy the method chunk"
	newPos := outStream position.
	outStream copyMethodChunkFrom: sourceFile.
	sourceFile skipSeparators.	"The following chunk may have ]style["
	sourceFile peek == $]
		ifTrue: [ 
			outStream
				cr;
				copyMethodChunkFrom: sourceFile ].
	moveSource
		ifTrue: [ 
			"Set the new method source pointer"
			method setSourcePosition: newPos inFile: fileIndex ].
	preamble size > 0
		ifTrue: [ outStream nextChunkPut: ' ' ].
	^ outStream cr! !

!TraitDescription methodsFor: 'organization updating' stamp: 'CamilloBruni 4/27/2012 14:53'!
noteChangesFrom: oldMethodDict
	"create notifications about the changes made to the method dictionary"
	
	"deal with additions"
	self methodDict keysAndValuesDo:  [ :selector :currentMethod|
		oldMethodDict 
			at: selector 
			ifAbsent: [ self noteMethodAdded: currentMethod ]].
	
	" deal with removal / updates"
	oldMethodDict keysAndValuesDo: [ :selector :oldMethod|
		self methodDict 
			at: selector
			ifPresent: [ :currentMethod|
				currentMethod = oldMethod
					ifFalse: [ self noteMethodChanged: oldMethod to: currentMethod]]
			ifAbsent: [ self noteMethodRemoved: oldMethod ]].
	! !

!TraitDescription methodsFor: 'filein/out' stamp: ''!
localMethods
	"returns the methods of classes including the ones of the traits that the class uses" 
	 
	^ self methods select: [:each | self includesLocalSelector: each selector].! !

!TraitDescription methodsFor: 'private' stamp: ''!
spaceUsed
	^super spaceUsed + (self hasClassSide
		ifTrue: [self classSide spaceUsed] 
		ifFalse: [0])! !

!TraitDescription methodsFor: 'slots' stamp: ''!
hasSlotNamed: aString
	"Return true whether the receiver defines an instance variable named aString."
	
	^ self allSlots anySatisfy: [:slot | slot name = aString]! !

!TraitDescription class methodsFor: '*GT-SpotterExtensions-Core' stamp: ''!
gtExamplePackage
	<gtExample: 'Package'>
	^ TClassDescription! !

!TraitException commentStamp: '<historical>'!
General exception used for example to signal invalid trait compositions!
!TraitExclusion commentStamp: '<historical>'!
See comment of my superclass TraitTransformation.!
!TraitExclusion methodsFor: 'composition' stamp: 'ST 6/5/2013 17:12'!
- anArrayOfSelectors
	^TraitExclusion
		with: subject
		exclusions: (anArrayOfSelectors, exclusions asArray)! !

!TraitExclusion methodsFor: 'copying' stamp: 'dvf 8/25/2005 16:07'!
copyTraitExpression
	^super copyTraitExpression 
		exclusions: self exclusions deepCopy;
		yourself! !

!TraitExclusion methodsFor: 'accessing' stamp: 'al 12/7/2003 11:58'!
exclusions
	^exclusions! !

!TraitExclusion methodsFor: 'copying' stamp: 'nice 1/13/2010 21:52'!
postCopy
	super postCopy.
	exclusions := exclusions copy! !

!TraitExclusion methodsFor: 'testing' stamp: 'al 4/10/2004 23:56'!
isEmpty
	^self exclusions isEmpty! !

!TraitExclusion methodsFor: 'enquiries' stamp: 'al 3/7/2004 22:48'!
allSelectors
	| selectors |
	selectors := self subject allSelectors.
	self exclusions do: [:each |
		selectors remove: each ifAbsent: []].
	^selectors! !

!TraitExclusion methodsFor: 'enquiries' stamp: 'al 3/4/2004 16:35'!
collectMethodsFor: aSelector into: methodDescription
	(self exclusions includes: aSelector) ifFalse: [
		self subject
			collectMethodsFor: aSelector
			into: methodDescription]! !

!TraitExclusion methodsFor: 'printing' stamp: 'al 2/22/2004 21:45'!
printOn: aStream
	super printOn: aStream. 
	aStream
		space;
		nextPut: $-;
		space;
		nextPut: ${.
	self exclusions do: [:each | aStream print: each]
		separatedBy: [aStream nextPutAll: '. '].
	aStream nextPut: $}! !

!TraitExclusion methodsFor: 'composition' stamp: 'al 4/9/2004 16:55'!
addExclusionOf: aSymbol
	self exclusions: (self exclusions copyWith: aSymbol)! !

!TraitExclusion methodsFor: 'accessing' stamp: 'al 12/7/2003 11:58'!
exclusions: aCollection
	exclusions := aCollection! !

!TraitExclusion methodsFor: 'comparing' stamp: 'MartinDias 1/23/2014 15:15'!
syntacticallyEquals: aTraitTransformation
	"Test syntactic equivalence of this trait transformation with another. 
	The order of the exclusions is taken into account. For example, A - { #x. #y } ~= A - { #y. #x }."

	self == aTraitTransformation ifTrue: [ ^ true ].
	self species = aTraitTransformation species ifFalse: [ ^ false ].
	^ self exclusions = aTraitTransformation exclusions! !

!TraitExclusion class methodsFor: 'instance creation' stamp: 'dvf 8/18/2005 17:36'!
with: aTraitComposition exclusions: anArrayOfSelectors
	^self new
		subject: aTraitComposition;
		exclusions: anArrayOfSelectors;
		yourself
! !

!TraitFileOutTest methodsFor: 'running' stamp: 'StephaneDucasse 10/6/2010 20:00'!
setUp
	super setUp.
	self class environment organization addCategory: self categoryName.
	
	td := self createTraitNamed: #TD uses: {}.		
	td compile: 'd' classified: #cat1.
	tc := self createTraitNamed: #TC uses: td.		
	tc compile: 'c' classified: #cat1.
	tb := self createTraitNamed: #TB uses: td.		
	tb compile: 'b' classified: #cat1.
	ta := self createTraitNamed: #TA uses: tb + tc @ {#cc->#c} - {#c}.
	ta compile: 'a' classified: #cat1.
	
	ca := self createClassNamed: #CA superclass: Object uses: {}.
	ca compile: 'ca' classified: #cat1.
	cb := self createClassNamed: #CB superclass: ca uses: ta.
	cb compile: 'cb' classified: #cat1.
	
	"make the class of cb also use tc:"
	cb class uses: ta classTrait + tc instanceVariableNames: ''.! !

!TraitFileOutTest methodsFor: 'testing' stamp: 'SebastianTleye 6/28/2013 17:35'!
testFileOutCategory
	"File out whole system category, delete all classes and traits and then
	file them in again."

	"self run: #testFileOutCategory"

	| file |
	self class environment organization fileOutCategory: self categoryName.
	self class environment organization removeSystemCategory: self categoryName.
	self deny: (Smalltalk globals keys asSet includesAnyOf: #(#CA #CB #TA #TB #TC #TD)).
	[ 
	file := FileStream readOnlyFileNamed: self categoryName , '.st'.
	file fileIn ] ensure: [ file close ].
	self assert: (Smalltalk globals keys asSet includesAllOf: #(#CA #CB #TA #TB #TC #TD)).
	ta := Smalltalk globals at: #TA.
	self assert: ta traitComposition asString = 'TB @ {#cc->#c} - {#c} + (TC @ {#cc->#c} - {#c})'.
	self assert: (ta selectors asSet includesAllOf: #(#a #b #cc)).
	cb := Smalltalk globals at: #CB.
	self assert: cb traitComposition asString = 'TA'.
	self assert: (cb selectors asSet includesAllOf: #(#cb #a #b #cc)).	"test classSide traitComposition of CB"
	self assert: cb classSide traitComposition asString = 'TA classTrait + TC'.
	self assert: (cb classSide selectors asSet includesAllOf: #(#d #c))! !

!TraitFileOutTest methodsFor: 'testing' stamp: 'MarcusDenker 12/2/2013 14:40'!
testFileOutTrait
	"fileOut trait T6, remove it from system and then file it in again"

	"self run: #testFileOutTrait"

	| fileName file |
	self t6 compile: 'localMethod: argument ^argument'.
	self t6 classSide compile: 'localClassSideMethod: argument ^argument'.
	self t6 fileOut.
	fileName := self t6 asString , '.st'.
	self resourceClassesAndTraits remove: self t6.
	self t6 removeFromSystem.
	[ 
	file := FileStream readOnlyFileNamed: fileName.
	file fileIn ] ensure: [ file close ].
	self assert: (Smalltalk globals includesKey: #T6).
	TraitsResource current t6: (Smalltalk globals at: #T6).
	self resourceClassesAndTraits add: self t6.
	self assert: self t6 traitComposition asString = 'T1 + (T2 @ {#m22Alias->#m22})'.
	self assert: (self t6 selectors asSet includesAllOf: #(#localMethod: #m11 #m12 #m13 #m21 #m22 #m22Alias)).
	self assert: self t6 classSide methods size = 2.
	self assert: (self t6 classSide selectors asSet includesAllOf: #(#localClassSideMethod: #m2ClassSide:))! !

!TraitFileOutTest methodsFor: 'testing' stamp: 'dvf 8/26/2005 14:32'!
testRemovingMethods
	"When removing a local method, assure that the method
	from the trait is installed instead and that the users are 
	updated."

	"self run: #testRemovingMethods"

	"Classes"

	self c2 compile: 'm12 ^0' classified: #xxx.
	self assert: (self c2 includesLocalSelector: #m12).
	self c2 removeSelector: #m12.
	self deny: (self c2 includesLocalSelector: #m12).
	self assert: (self c2 selectors includes: #m12).

	"Traits"
	self t5 compile: 'm12 ^0' classified: #xxx.
	self assert: self c2 new m12 = 0.
	self t5 removeSelector: #m12.
	self deny: (self t5 includesLocalSelector: #m12).
	self assert: (self t5 selectors includes: #m12).
	self assert: self c2 new m12 = 12! !

!TraitFileOutTest methodsFor: 'running' stamp: 'al 4/25/2004 16:29'!
categoryName
	^'Traits-Tests-FileOut'! !

!TraitFileOutTest methodsFor: 'running' stamp: 'Anonymous 6/17/2013 13:16'!
tearDown
	| dir |
	dir := FileSystem workingDirectory.
	self createdClassesAndTraits, self resourceClassesAndTraits  do: [:each |
		(dir / each asString,'st') ensureDelete ] .
	(dir / self categoryName,'st') ensureDelete.
	self class environment organization removeSystemCategory: self categoryName.
	super tearDown! !

!TraitMethodDescription commentStamp: '<historical>'!
Used by TraitComposition to encapsulates a collection of methods for one particular selector when querying for changes. According to the number and kind of those methods a provided method exists, there is a conflict or there are no provided nor conflicting methods at all. I provide the interface to query for those situations, e.g., effectiveMethod returns the provided method or the conflict marker method.
!
!TraitMethodDescription methodsFor: 'testing' stamp: 'al 2/20/2004 22:18'!
isBinarySelector
	^self locatedMethods anyOne
		isBinarySelector! !

!TraitMethodDescription methodsFor: 'accessing' stamp: 'al 1/23/2004 10:19'!
selector
	^selector! !

!TraitMethodDescription methodsFor: 'accessing' stamp: 'al 1/23/2004 10:20'!
addLocatedMethod: aLocatedMethod
	locatedMethods add: aLocatedMethod! !

!TraitMethodDescription methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/28/2013 14:07'!
effectiveMethodCategoryCurrent: currentCategoryOrNil new: newCategoryOrNil
	| result size isCurrent isConflict |
	size := self size.
	size = 0 ifTrue: [^ nil].
	result := self locatedMethods anyOne category.
	size = 1 ifTrue: [^ result].
	
	isCurrent := currentCategoryOrNil isNil.
	isConflict := false.
	self locatedMethods do: [:each | | cat |
		cat := each category.
		isCurrent := isCurrent or: [cat == currentCategoryOrNil].
		isConflict := isConflict or: [cat ~~ result]].
	isConflict ifFalse: [^ result].
	(isCurrent not and: [newCategoryOrNil notNil]) ifTrue: [^ newCategoryOrNil].
	
	^ Protocol ambiguous ! !

!TraitMethodDescription methodsFor: 'testing' stamp: 'NS 4/19/2004 16:10'!
isProvided
	^ self providedMethod notNil! !

!TraitMethodDescription methodsFor: 'accessing' stamp: 'PabloHerrero 1/4/2015 10:48'!
conflictMethod
	| binary numberOfArguments |
	self isConflict ifFalse: [^nil].
	binary := self isBinarySelector.
	numberOfArguments := self numberOfArguments.
	
	^self
		generateMethod: self selector
		withMarker: CompiledMethod conflictMarker
		forArgs: numberOfArguments
		binary: binary! !

!TraitMethodDescription methodsFor: 'accessing' stamp: 'mada 5/5/2012 11:24'!
providedLocatedMethod
	| locatedMethod aLocatedMethod refOrigin |
	locatedMethod := nil.
	self locatedMethods ifEmpty: [ ^ nil].

	self locatedMethods size > 1
		ifTrue: [ 	aLocatedMethod := self locatedMethods anyOne.
						refOrigin := (aLocatedMethod methodClass >> aLocatedMethod selector) origin.
						(self locatedMethods 
							allSatisfy: [:each | each origin == refOrigin])
						ifTrue: [^ aLocatedMethod].  ].
	
	self locatedMethods do: [:each |
		each isProvided ifTrue: [
			locatedMethod isNil ifFalse: [^nil].
			locatedMethod := each]].
	^locatedMethod! !

!TraitMethodDescription methodsFor: 'testing' stamp: 'al 1/23/2004 10:31'!
isEmpty
	^self size = 0! !

!TraitMethodDescription methodsFor: 'accessing' stamp: 'al 1/23/2004 12:54'!
size
	^self locatedMethods size! !

!TraitMethodDescription methodsFor: 'accessing' stamp: 'VincentBlondeau 3/6/2015 17:42'!
effectiveMethod
	"Return the effective compiled method of this method description." 

	| method |
	method := self providedMethod.
	method isNil ifFalse: [^ method].
	method := self conflictMethod.
	method isNil ifFalse: [^ method].
	^ self requiredMethod.! !

!TraitMethodDescription methodsFor: 'accessing' stamp: 'al 1/23/2004 10:20'!
locatedMethods
	^locatedMethods! !

!TraitMethodDescription methodsFor: 'accessing' stamp: 'marcus.denker 11/10/2008 10:04'!
providedMethod
	^self providedLocatedMethod ifNotNil: [:locatedMethod | locatedMethod method]! !

!TraitMethodDescription methodsFor: 'accessing' stamp: 'PabloHerrero 1/4/2015 10:48'!
requiredMethod
	| numberOfArguments binary |
	self isRequired ifFalse: [^nil].
	self size = 1 ifTrue: [^self locatedMethods anyOne].

	binary := self isBinarySelector.
	numberOfArguments := self numberOfArguments.
	
	 ^self
		generateMethod: self selector
		withMarker: CompiledMethod implicitRequirementMarker
		forArgs: numberOfArguments
		binary: binary.! !

!TraitMethodDescription methodsFor: 'accessing' stamp: 'al 1/23/2004 10:19'!
selector: aSymbol 
	selector := aSymbol! !

!TraitMethodDescription methodsFor: 'initialization' stamp: 'mada 5/5/2012 12:57'!
initialize
	super initialize.
	locatedMethods := IdentitySet new! !

!TraitMethodDescription methodsFor: 'testing' stamp: 'mada 5/5/2012 11:25'!
isConflict
	| count originMethodReferenciel |
	count := 0.

	self locatedMethods size > 1
		ifTrue: 
			["If they are more than 1 located method, then check whether these methods have the same origin"
			originMethodReferenciel := self locatedMethods anyOne  origin.
			(self locatedMethods allSatisfy: [:each | each origin == originMethodReferenciel])
				ifTrue: [ ^ false ]].

	self methodsDo: [:each |
		each isProvided ifTrue: [
			count := count + 1.
			count > 1 ifTrue: [^true]]].
	^false! !

!TraitMethodDescription methodsFor: 'testing' stamp: 'mada 5/5/2012 11:25'!
isRequired
	self isEmpty ifTrue: [^ false].
	^ self locatedMethods allSatisfy: [:each | each isRequired]! !

!TraitMethodDescription methodsFor: 'accessing' stamp: 'NS 4/16/2004 15:06'!
effectiveMethodCategory
	^ self effectiveMethodCategoryCurrent: nil new: nil! !

!TraitMethodDescription methodsFor: 'private' stamp: 'PabloHerrero 1/4/2015 13:38'!
numberOfArguments
	^ self locatedMethods anyOne selector numArgs
		! !

!TraitMethodDescription methodsFor: 'enumeration' stamp: 'mada 5/5/2012 11:24'!
methodsDo: aBlock
	self locatedMethods do: [:each |
		aBlock value: each ]! !

!TraitMethodDescription methodsFor: 'testing' stamp: 'al 4/10/2004 23:34'!
isLocalAliasSelector
	"Return true if the selector is an alias (if it is different
	from the original selector). Return false, if not or if we
	have a conflict."
	
	^self size = 1 and: [
		(self locatedMethods anyOne selector ~= self selector)]! !

!TraitMethodDescription methodsFor: 'testing' stamp: 'mada 5/5/2012 11:30'!
isAliasSelector
	"Return true if the selector is an alias (if it is different
	from the original selector) or already an aliased method
	in the original location (recursively search the compositions).
	Return false, if not or if we have a conflict."
	
	| locatedMethod |
	^self size = 1 and: [
		locatedMethod := self locatedMethods anyOne.
		(locatedMethod selector ~= self selector) or: [
			locatedMethod methodClass isAliasSelector: self selector]]! !

!TraitMethodDescription methodsFor: 'private' stamp: 'PabloHerrero 1/4/2015 10:42'!
generateMethod: aSelector withMarker: aSymbol forArgs: aNumber binary: aBoolean
	| source node keywords |
	source := String streamContents: [:stream |
		aNumber < 1
			ifTrue: [stream nextPutAll: aSelector]
			ifFalse: [aBoolean
				ifTrue: [
					stream nextPutAll: aSelector; space; nextPutAll: 'anObject']
				ifFalse: [
					keywords := aSelector keywords.
					1 to: aNumber do: [:argumentNumber |
						stream
							nextPutAll: (keywords at: argumentNumber); space;
							nextPutAll: 'arg'; nextPutAll: argumentNumber asString; space]]].
		stream cr; tab; nextPutAll: 'self '; nextPutAll: aSymbol].
	
	node := self class compiler
		source: source;
		class: self class;
		failBlock: [];
		translate.
	^(node generateWithSource) selector: aSelector; yourself! !

!TraitMethodDescription class methodsFor: 'private' stamp: 'NS 4/19/2004 16:26'!
maxArguments
	^30! !

!TraitMethodDescription class methodsFor: 'instance creation' stamp: 'al 1/23/2004 13:04'!
selector: aSymbol
	^self new
		selector: aSymbol
		yourself! !

!TraitMethodDescription class methodsFor: 'instance creation' stamp: 'al 1/23/2004 12:52'!
new
	^super new
		initialize;
		yourself! !

!TraitMethodDescriptionTest methodsFor: 'testing' stamp: 'md 5/1/2012 17:33'!
testConflictMethodCreation
	"Generate conflicting methods between t1 and t2
	and check the resulting method in Trait t5 (or c2).
	Also test selectors like foo:x (without space) or selectors with CRs."

	"unary"

	self t2 compile: 'm12 ^false'.
	self assert: ((self t5 sourceCodeAt: #m12) asString beginsWith: 'm12').
	self should: [self c2 new m12] raise: Error.

	"binary"
	self t1 compile: '@ myArgument ^true'.
	self t2 compile: '@myArgument ^false'.
	self 
		assert: ((self t5 sourceCodeAt: #@) asString beginsWith: '@ anObject').
	self should: [self c2 new @ 17] raise: Error.

	"keyword"
	self t1 compile: 'zork: myArgument
		^true'.
	self t2 compile: 'zork: myArgument ^false'.
	self assert: ((self t5 sourceCodeAt: #zork:) asString 
				beginsWith: 'zork: arg1').
	self should: [self c2 new zork: 17] raise: Error.
	self t1 compile: 'zork:myArgument ^true'.
	self t2 compile: 'zork:myArgument ^false'.
	self assert: ((self t5 sourceCodeAt: #zork:) asString 
				beginsWith: 'zork: arg1').
	self should: [self c2 new zork: 17] raise: Error.
	self t1 compile: 'zork1: t1 zork2: t2 ^true'.
	self t2 compile: 'zork1: anObject zork2: anotherObject ^false'.
	self assert: ((self t5 sourceCodeAt: #zork1:zork2:) asString 
				beginsWith: 'zork1: arg1 zork2: arg2').
	self should: [self c2 new zork1: 1 zork2: 2] raise: Error! !

!TraitMethodDescriptionTest methodsFor: 'testing' stamp: 'al 1/23/2004 12:57'!
testInitialize
	| empty |
	empty := TraitMethodDescription new.
	self assert: empty isEmpty.
	self deny: empty isConflict.
	self deny: empty isProvided.
	self deny: empty isRequired! !

!TraitMethodDescriptionTest methodsFor: 'testing' stamp: 'EstebanLorenzano 5/29/2013 09:06'!
testConflictingCategories
	| t7 t8 |
	self t2 compile: 'm11' classified: #catY.
	self assert: (self t4 organization categoryOfElement: #m11) equals: #catX.
	self assert: (self t5 organization categoryOfElement: #m11) equals: #cat1.
	t7 := self createTraitNamed: #T7 uses: self t1 + self t2.
	self assert: (t7 organization categoryOfElement: #m11) 
				equals: Protocol ambiguous.
	self t1 removeSelector: #m11.
	self assert: (self t4 organization categoryOfElement: #m11) equals: #catX.
	self assert: (self t5 organization categoryOfElement: #m11) equals: #catY.
	self assert: (t7 organization categoryOfElement: #m11) equals: #catY.
	self assert: (t7 organization categories includes: Protocol ambiguous) not.
	self t1 compile: 'm11' classified: #cat1.
	t8 := self createTraitNamed: #T8 uses: self t1 + self t2.
	t8 organization classify: #m11 under: #cat1.
	self t1 organization classify: #m11 under: #catZ.
	self assert: (self t4 organization categoryOfElement: #m11) equals: #catX.
	self assert: (self t5 organization categoryOfElement: #m11) equals: #catY.
	self assert: (t8 organization categoryOfElement: #m11) equals: #catZ! !

!TraitMethodDescriptionTest methodsFor: 'testing' stamp: 'CamilloBruni 4/27/2012 17:54'!
testCategories
	self assert: (self t4 organization categoryOfElement: #m21) equals: #cat1.
	self assert: (self t4 organization categoryOfElement: #m22) equals: #cat2.
	self assert: (self t4 organization categoryOfElement: #m11) equals: #catX.
	self assert: (self t4 organization categoryOfElement: #m12) equals: #cat2.
	self assert: (self t4 organization categoryOfElement: #m13) equals: #cat3.
	self assert: (self t6 organization categoryOfElement: #m22Alias) equals: #cat2.
	self t2 organization classify: #m22 under: #catX.
	self assert: (self t4 organization categoryOfElement: #m22) equals: #catX.
	self assert: (self t6 organization categoryOfElement: #m22Alias) equals: #catX.
	self t6 organization classify: #m22 under: #catY.
	self t6 organization classify: #m22Alias under: #catY.
	self t2 organization classify: #m22 under: #catZ.
	self assert: (self t6 organization categoryOfElement: #m22) equals: #catY.
	self assert: (self t6 organization categoryOfElement: #m22Alias) equals: #catY.
	self t1 compile: 'mA' classified: #catA.
	self assert: (self t4 organization categoryOfElement: #mA) equals: #catA.
	self t1 organization classify: #mA under: #cat1.
	self assert: (self t4 organization categories includes: #catA) not! !

!TraitMethodDescriptionTest methodsFor: 'testing' stamp: 'md 5/1/2012 17:30'!
testArgumentNames
	self t1 compile: 'zork1: myArgument zork2: mySecondArgument ^true'.
	self t2 compile: 'zork1: myArgument zork2: somethingElse ^false'.
	self assert: ((self t5 sourceCodeAt: #zork1:zork2:) asString 
				beginsWith: 'zork1: arg1 zork2: arg2').
	self t1 compile: 'zork1: myArgument zork2: mySecondArgument ^true'.
	self t2 compile: 'zork1: somethingElse zork2: myArgument ^false'.
	self assert: ((self t5 sourceCodeAt: #zork1:zork2:) asString 
				beginsWith: 'zork1: arg1 zork2: arg2')! !

!TraitPureBehaviorTest methodsFor: 'testing-applying trait composition' stamp: 'dvf 8/26/2005 14:21'!
testPropagationOfChangesInTraitsToAliasMethodsWhenOriginalMethodIsExcluded
	"Assert that alias method is updated although
	the original method is excluded from this user."

	| anObject |
	anObject := (self 
				createClassNamed: #AliasTestClass
				superclass: Object
				uses: self t1 @ { (#aliasM11 -> #m11) } - { #m11 }) new.
	self assert: anObject aliasM11 = 11.
	self deny: (anObject class methodDict includesKey: #m11).
	self t1 compile: 'm11 ^17'.
	self assert: anObject aliasM11 = 17! !

!TraitPureBehaviorTest methodsFor: 'testing' stamp: 'dvf 8/26/2005 14:32'!
testLocalSelectors
	"self run: #testLocalSelectors"

	self assert: self t3 localSelectors size = 3.
	self assert: (self t3 localSelectors includesAllOf: #(#m31 #m32 #m33 )).
	self assert: (self t3 includesLocalSelector: #m32).
	self deny: (self t3 includesLocalSelector: #inexistantSelector).
	self assert: self t5 localSelectors size = 3.
	self assert: (self t5 localSelectors includes: #m51).
	self assert: (self t5 includesLocalSelector: #m51).
	self deny: (self t5 includesLocalSelector: #m11).
	self t5 removeSelector: #m51.
	self deny: (self t3 includesLocalSelector: #m51).
	self deny: (self t5 includesLocalSelector: #m11).
	self assert: self t5 localSelectors size = 2.
	self t5 compile: 'm52 ^self'.
	self assert: self t5 localSelectors size = 2.
	self assert: (self t5 localSelectors includes: #m52).

	"test that propagated methods do not get in as local methods"
	self t2 compile: 'local2 ^self'.
	self deny: (self t5 includesLocalSelector: #local2).
	self assert: self t5 localSelectors size = 2.
	self assert: (self t5 localSelectors includes: #m52).
	self assert: self c2 localSelectors size = 2.
	self assert: (self c2 localSelectors includesAllOf: #(#foo #bar ))! !

!TraitPureBehaviorTest methodsFor: 'testing-applying trait composition' stamp: 'dvf 8/26/2005 14:32'!
testUpdateWhenLocalMethodRemoved
	| aC2 |
	aC2 := self c2 new.
	self t5 compile: 'foo ^123'.
	self deny: aC2 foo.
	self c2 removeSelector: #foo.
	self assert: aC2 foo = 123! !

!TraitPureBehaviorTest methodsFor: 'testing' stamp: 'dvf 8/26/2005 14:32'!
testRemovingMethods
	"When removing a local method, assure that the method
	from the trait is installed instead and that the users are 
	updated."

	"self run: #testRemovingMethods"

	"Classes"

	self c2 compile: 'm12 ^0' classified: #xxx.
	self assert: (self c2 includesLocalSelector: #m12).
	self c2 removeSelector: #m12.
	self deny: (self c2 includesLocalSelector: #m12).
	self assert: (self c2 selectors includes: #m12).

	"Traits"
	self t5 compile: 'm12 ^0' classified: #xxx.
	self assert: self c2 new m12 = 0.
	self t5 removeSelector: #m12.
	self deny: (self t5 includesLocalSelector: #m12).
	self assert: (self t5 selectors includes: #m12).
	self assert: self c2 new m12 = 12! !

!TraitPureBehaviorTest methodsFor: 'testing-applying trait composition' stamp: 'adrian_lienhard 2/1/2009 16:43'!
testMethodClass
	"Test sharing of compiled methods between traits and their users. Methods are installed in exactly one behavior, however, the source pointers of methods are shared (unless sources or changes have been condensed). Verify	that methodClass properties are set correctly."
	
	"self debug: #testMethodClass"

	| m1 m2 |
	m1 := self t5 >> #m51.
	m2 := self c2 >> #m51.
	
	self assert: m1 methodClass == self t5.
	self assert: m2 methodClass == self c2.
	
	self deny: m1 == m2.
	
	self deny: m1 sourcePointer = m2 sourcePointer.! !

!TraitPureBehaviorTest methodsFor: 'testing-applying trait composition' stamp: 'dvf 8/26/2005 14:33'!
testPropagationOfChangesInTraitsToAliasMethods
	| anObject |
	anObject := (self 
				createClassNamed: #AliasTestClass
				superclass: Object
				uses: self t6) new.
	self assert: anObject m22Alias = 22.

	"test update alias method"
	self t2 compile: 'm22 ^17'.
	self assert: anObject m22Alias = 17.

	"removing original method should also remove alias method"
	self t2 removeSelector: #m22.
	self should: [anObject m22Alias] raise: MessageNotUnderstood! !

!TraitPureBehaviorTest methodsFor: 'testing-applying trait composition' stamp: 'adrian_lienhard 1/31/2009 20:51'!
testSuperSends
	"self debug: #testSuperSends"
	
	| aC2 |
	aC2 := self c2 new.
	self assert: aC2 m51.
	self deny: aC2 foo.
	self deny: aC2 bar! !

!TraitPureBehaviorTest methodsFor: 'testing' stamp: 'damiencassou 1/6/2009 10:59'!
testTraitsAccessor
	"self debug: #testTraitsAccessor"
	self assert: self c1 traits isEmpty.
	self assert: (self c2 traits hasEqualElements: (Array with: self t5))! !

!TraitPureBehaviorTest methodsFor: 'testing-applying trait composition' stamp: 'MarcusDenker 5/4/2013 12:52'!
testOwnMethodsTakePrecedenceOverTraitsMethods
	"First create a trait with no subtraits and then
	add subtrait t1 which implements m11 as well."

	| trait |
	trait := self createTraitNamed: #T
				uses: { }.
	trait compile: 'm11 ^999'.
	self assert: trait methodDict size = 1.
	self assert: (trait methodDict at: #m11) sourceCode = 'm11 ^999'.
	Trait 
		named: #T
		uses: self t1
		category: self class category.
	self assert: trait methodDict size = 3.
	self assert: (trait selectors asSet includesAllOf: #(#m11 #m12 #m13 )).
	self assert: (trait methodDict at: #m11) sourceCode = 'm11 ^999'.
	self assert: (trait methodDict at: #m12) sourceCode = 'm12 ^12'! !

!TraitPureBehaviorTest methodsFor: 'testing' stamp: 'dvf 8/26/2005 14:33'!
traitOrClassOfSelector
	"self run: #traitOrClassOfSelector"

	"locally defined in trait or class"

	self assert: (self t1 traitOrClassOfSelector: #m12) = self t1.
	self assert: (self c1 traitOrClassOfSelector: #foo) = self c1.

	"not locally defined - simple"
	self assert: (self t4 traitOrClassOfSelector: #m21) = self t2.
	self assert: (self c2 traitOrClassOfSelector: #m51) = self t5.

	"not locally defined - into nested traits"
	self assert: (self c2 traitOrClassOfSelector: #m22) = self t2.

	"not locally defined - aliases"
	self assert: (self t6 traitOrClassOfSelector: #m22Alias) = self t2.

	"class side"
	self assert: (self t2 classSide traitOrClassOfSelector: #m2ClassSide:) 
				= self t2 classSide.
	self assert: (self t6 classSide traitOrClassOfSelector: #m2ClassSide:) 
				= self t2 classSide! !

!TraitPureBehaviorTest methodsFor: 'testing-applying trait composition' stamp: 'MarcusDenker 2/21/2010 12:52'!
testPropagationWhenTraitCompositionModifications
	"Test that the propagation mechanism works when
	setting new traitCompositions."

	self assert: self c2 methodDict size = 9.	"2 + (3+(3+2))-1"

	"removing methods"
	Trait 
		named: #T5
		uses: self t1 + self t2 - { #m21. #m22 }
		category: self class category.
	self assert: self c2 methodDict size = 7.

	"adding methods"
	Trait 
		named: #T2
		uses: self t3
		category: self class category.
	self assert: self c2 methodDict size = 10.
	self assert: (self c2 selectors asSet includesAllOf: #(#m31 #m32 #m33 ))! !

!TraitPureBehaviorTest methodsFor: 'testing-applying trait composition' stamp: 'dvf 8/26/2005 14:31'!
testTraitCompositionWithCycles
	self should: [self t1 setTraitComposition: self t1 asTraitComposition]
		raise: Error.
	self t2 setTraitComposition: self t3 asTraitComposition.
	self should: [self t3 setTraitComposition: self t5 asTraitComposition]
		raise: Error! !

!TraitPureBehaviorTest methodsFor: 'testing' stamp: 'dvf 8/26/2005 14:33'!
testIsAliasSelector
	self deny: (self t1 isAliasSelector: #m11).
	self deny: (self t1 isAliasSelector: #foo).

	"directly"
	self assert: (self t6 isAliasSelector: #m22Alias).
	self deny: (self t6 isAliasSelector: #m22).

	"indirectly"
	self c1 setTraitCompositionFrom: self t6.
	self assert: (self c1 isAliasSelector: #m22Alias).
	self deny: (self c1 isAliasSelector: #m22)! !

!TraitPureBehaviorTest methodsFor: 'testing-applying trait composition' stamp: 'dvf 8/26/2005 14:32'!
testPropagationOfChangesInTraits
	| aC2 |
	aC2 := self c2 new.
	self assert: self c2 methodDict size = 9.
	self t1 compile: 'zork ^false'.
	self assert: self c2 methodDict size = 10.
	self deny: aC2 zork.
	self t1 removeSelector: #m12.
	self assert: self c2 methodDict size = 9.
	self should: [aC2 m12] raise: MessageNotUnderstood.
	self assert: aC2 m21 = 21.
	self t2 compile: 'm21 ^99'.
	self assert: aC2 m21 = 99! !

!TraitPureBehaviorTest methodsFor: 'testing-applying trait composition' stamp: 'MarcusDenker 2/21/2010 12:52'!
testTraitCompositionModifications
	self assert: self t6 methodDict size = 6.
	self assert: (self t6 sourceCodeAt: #m22Alias) asString = 'm22Alias ^22'.
	self t6 setTraitComposition: self t2 asTraitComposition.
	self assert: self t6 methodDict size = 2.
	self deny: (self t6 methodDict includesKey: #m22Alias).
	self t6 
		setTraitCompositionFrom: self t1 @ { (#m13Alias -> #m13) } - { #m11. #m12 } 
				+ self t2.
	self assert: self t6 methodDict size = 4.
	self 
		assert: (self t6 selectors asSet includesAllOf: #(#m13 #m13Alias #m21 #m22 )).
	self 
		assert: (self t6 sourceCodeAt: #m13Alias) asString = 'm13Alias ^self m12'! !

!TraitPureBehaviorTest methodsFor: 'testing-applying trait composition' stamp: 'MarcusDenker 10/8/2013 13:05'!
testChangeSuperclass
	"self run: #testChangeSuperclass"

	"Test that when the superclass of a class is changed the non-local methods
	of the class sending super are recompiled to correctly store the new superclass."

	| aC2 newSuperclass |
	aC2 := self c2 new.

	"C1 is current superclass of C2"
	self assert: aC2 m51.
	self assert: self c2 superclass == self c1.
	self deny: (self c2 localSelectors includes: #m51).
	self deny: (self c2 >> #m52) == (self t5 >> #m52). "no sharing!!!!"
	
	self assert: self c2 traitCompositionString = 'T5 - {#m11}'.
	self assert: self c2 selectors sorted =  #(bar foo m12 m13 m21 m22 m51 m52 m53).
	self assert: self c2 localSelectors sorted =  #(bar foo).


	"change superclass of C2 from C1 to X"
	newSuperclass := self createClassNamed: #X superclass: Object uses: {}.
	newSuperclass
		subclass: self c2 name
		uses: self c2 traitComposition
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: self c2 category.

	self assert: self c2 superclass == newSuperclass.

	newSuperclass compile: 'foo ^17'.
	self assert: aC2 m51 = 17.
	self deny: (self c2 localSelectors includes: #m51).

	self c2 compile: 'm51 ^19'.
	self assert: aC2 m51 = 19.
	
	self deny: (self c2 >> #m52) == (self t5 >> #m52). "no sharing!!!!"

	self assert: self c2 traitCompositionString = 'T5 - {#m11}'.
	self assert: self c2 selectors sorted =  #(bar foo m12 m13 m21 m22 m51 m52 m53).
	self assert: self c2 localSelectors sorted =  #(bar foo m51).

	"change superclass of C2 back to C1"
	self c1
		subclass: self c2 name
		uses: self c2 traitComposition
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: self c2 category.

	self assert: (aC2 m51 = 19).
	self assert: self c2 superclass == self c1.
	self assert: (self c2 localSelectors includes: #m51).
	self deny: (self c2 >> #m52) == (self t5 >> #m52). "no sharing!!!!"

	self assert: self c2 traitCompositionString = 'T5 - {#m11}'.
	self assert: self c2 selectors sorted =  #(bar foo m12 m13 m21 m22 m51 m52 m53).
	self assert: self c2 localSelectors sorted =  #(bar foo m51).! !

!TraitPureBehaviorTest methodsFor: 'testing' stamp: 'dvf 8/26/2005 14:33'!
testIsLocalAliasSelector
	self deny: (self t1 isLocalAliasSelector: #m11).
	self deny: (self t1 isLocalAliasSelector: #foo).

	"directly"
	self assert: (self t6 isLocalAliasSelector: #m22Alias).
	self deny: (self t6 isLocalAliasSelector: #m22).

	"indirectly"
	self c1 setTraitComposition: self t6 asTraitComposition.
	self deny: (self c1 isLocalAliasSelector: #m22Alias).
	self deny: (self c1 isLocalAliasSelector: #m22)! !

!TraitPureBehaviorTest methodsFor: 'testing-applying trait composition' stamp: 'SebastianTleye 6/28/2013 17:36'!
testReshapeClass
	"self run: #testReshapeClass"

	"Ensure that reshaping a class has no impact on its traits"

	self assert: self c2 traitCompositionString = 'T5 - {#m11}'.
	self assert: self c2 selectors sorted =  #(bar foo m12 m13 m21 m22 m51 m52 m53).
	self assert: self c2 localSelectors sorted =  #(bar foo).

	self c2 addInstVarNamed: 'foobar'.

	self assert: self c2 traitCompositionString = 'T5 - {#m11}'.
	self assert: self c2 selectors sorted =  #(bar foo m12 m13 m21 m22 m51 m52 m53).
	self assert: self c2 localSelectors sorted =  #(bar foo).

	self c2 removeInstVarNamed: 'foobar'.

	self assert: self c2 traitCompositionString = 'T5 - {#m11}'.
	self assert: self c2 selectors sorted =  #(bar foo m12 m13 m21 m22 m51 m52 m53).
	self assert: self c2 localSelectors sorted =  #(bar foo).! !

!TraitPureBehaviorTest methodsFor: 'testing-applying trait composition' stamp: 'al 3/26/2006 12:24'!
testClassesWithTraits
	"self debug: #testClassesWithTraits"

	self assert: (self c1 methodDict includesKey: #foo).
	self assert: (self c2 methodDict includesKey: #bar).
	self assert: (self c2 methodDict includesKey: #m51).
	self assert: (self c2 methodDict includesKey: #m12).
	self assert: (self c2 methodDict includesKey: #m13).
	self assert: (self c2 methodDict includesKey: #m21).
	self assert: (self c2 methodDict includesKey: #m22).
	
	self deny: self c1 class hasTraitComposition.
	self assert: self c2 class hasTraitComposition.

	self assert: (self c2 class traitComposition size = 1).
	self assert: (self c2 class traitComposition includesTrait: self t5 classTrait)! !

!TraitPureBehaviorTest methodsFor: 'testing' stamp: 'dvf 8/26/2005 14:32'!
testMethodCategoryReorganization
	"self run: #testMethodCategory"

	self t1 compile: 'm1' classified: 'category1'.
	self assert: (self t5 organization categoryOfElement: #m1) = #category1.
	self assert: (self c2 organization categoryOfElement: #m1) = #category1.
	self t1 organization 
		classify: #m1
		under: #category2
		suppressIfDefault: true.
	self assert: (self t5 organization categoryOfElement: #m1) = #category2.
	self assert: (self c2 organization categoryOfElement: #m1) = #category2! !

!TraitTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testExplicitRequirementDoesNotTakePrecedenceInDeepHierarchy
	"Make sure that an explicitRequirement method from a trait does not take precedence over a superclass implementation, even if the superclass implementation is not just in the direct superclass."

	"C9 inherits from Object. C10 inherits from C9. C11 inherits from C10. Each Ci uses the trait Ti."

	self t11 compile: 'm ^self explicitRequirement'.
	self should: [ self c11 new m ] raise: Error.
	self t9 compile: 'm ^2'.
	self c9 new m.
	self c10 new m.
	self c11 new m.
	self assert: self c9 new m equals: 2.
	self assert: self c10 new m equals: 2.
	self assert: self c11 new m equals: 2! !

!TraitTest methodsFor: 'testing' stamp: 'al 10/13/2006 13:54'!
testExplicitRequirement
	"self run: #testExplicitRequirement"

	self t1 compile: 'm self explicitRequirement'.
	self t2 compile: 'm ^true'.
	self deny: self t4 >> #m == (self t2 >> #m).
	self assert: self c2 new m.
	self t2 removeSelector: #m.
	self deny: self t5 >> #m == (self t1 >> #m).
	self should: [self c2 new m] raise: Error! !

!TraitTest methodsFor: 'testing' stamp: 'VincentBlondeau 3/6/2015 16:41'!
testTraitsMethodClassSanity
	"self debug: #testTraitsMethodClassSanity"
	
	(Smalltalk globals allTraits gather: #traitUsers) asSet do: [ :each |
		each selectorsDo: [ :selector |
			self should: [ (each >> selector) methodClass == each ] ] ]! !

!TraitTest methodsFor: 'testing' stamp: 'ms 5/8/2007 19:23'!
testAllClassVarNames
	
	
	self assert: self t1 allClassVarNames isEmpty! !

!TraitTest methodsFor: 'testing' stamp: 'VincentBlondeau 3/6/2015 16:41'!
testErrorClassCreation
    | tmpCategory trait aSubclass aClass |
	
    tmpCategory := 'TemporaryGeneratedClasses'.
    trait := Trait named: #TMyTrait uses: {} category: tmpCategory.
    
    [ aClass := nil
        subclass: #AClass
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: tmpCategory.    
	"----------------"
    aSubclass := aClass
        subclass: #AClass2
        uses: trait
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: tmpCategory.    
	"----------------"
    "Change the superclass of AClass"
    Object
        subclass: #AClass
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: tmpCategory.
        
    self assert: trait traitUsers asArray equals: {aSubclass}.
    self assert: aSubclass traits asArray equals: {trait}. 

    ] ensure: [
        #(AClass AClass2 TMyTrait) do: [ :aClassName |
            Smalltalk globals at: aClassName ifPresent: [ :v | v removeFromSystem ]]]! !

!TraitTest methodsFor: 'testing' stamp: 'DamienCassou 7/4/2013 18:51'!
testExplicitRequirementDoesNotTakePrecedenceEvenWhenAddingTraits
	"Make sure that an explicitRequirement method from a trait does not take precedence over a superclass implementation, even if he trait is created later."

	| tempClass tempTrait |
	self c9 compile: 'm ^100'.
	tempTrait := self createTraitNamed: #TTempTrait uses: {}.
	tempTrait compile: 'm ^self explicitRequirement.'.
	tempClass := self createClassNamed: #TempClass superclass: self c9 uses: {tempTrait}.
	self assert: tempClass new m equals: 100! !

!TraitTest methodsFor: 'testing' stamp: 'VincentBlondeau 3/6/2015 16:41'!
testUsers
	self assert: self t1 traitUsers size = 3.
	self assert: (self t1 traitUsers includesAllOf: {self t4. self t5. self t6 }).
	self assert: self t3 traitUsers isEmpty.
	self assert: self t5 traitUsers size = 1.
	self assert: self t5 traitUsers anyOne = self c2.
	self c2 setTraitCompositionFrom: self t1 + self t5.
	self assert: self t5 traitUsers size = 1.
	self assert: self t5 traitUsers anyOne = self c2.
	self c2 setTraitComposition: self t2 asTraitComposition.
	self assert: self t5 traitUsers isEmpty! !

!TraitTest methodsFor: 'testing' stamp: 'mada 5/5/2012 13:04'!
testOrigin
	| tr1 tr2 tr3 tr23 aMethodDescription |
	tr1 := self createTraitNamed: #TTT1 uses: {}.
	tr2 := self createTraitNamed: #TTT2 uses: {tr1}.
	tr3 := self createTraitNamed: #TTT3 uses: {tr1}.
	tr23 := self createTraitNamed: #TTT23 uses: {tr3 + tr2}.
	
	tr1 compile: 'foo ^ 4'.
	self assert: (tr1 >> #foo) origin == tr1.
	self assert: (tr2 >> #foo) origin == tr1.
	self assert: (tr3 >> #foo) origin == tr1.
	
	"-----------"
	"For TR2"
	aMethodDescription := tr2 traitComposition methodDescriptionForSelector: #foo.
	self assert: (aMethodDescription locatedMethods size = 1).
	self assert: (aMethodDescription locatedMethods includes: ( tr1 >>  #foo)).

	self assert: (aMethodDescription providedLocatedMethod notNil).	
	"The method is provided, it cannot be nil"
	self assert: (aMethodDescription providedMethod notNil).	
	self assert: (aMethodDescription isProvided).	
		
	self assert: (tr2 traitComposition traitProvidingSelector: #foo) == tr1.
	self assert: (tr2 >> #foo) origin == tr1.
	"-----------"
	
	"-----------"
	"For TR23"
	aMethodDescription := tr23 traitComposition methodDescriptionForSelector: #foo.
	self assert: (aMethodDescription locatedMethods size = 2).
	self assert: (aMethodDescription locatedMethods includes: (tr2 >> #foo)).
	self assert: (aMethodDescription locatedMethods includes: (tr3 >> #foo)).

	self assert: (aMethodDescription providedLocatedMethod notNil).	
	"The method is provided, it cannot be nil"
	self assert: (aMethodDescription providedMethod notNil).	

	self assert: (aMethodDescription isProvided).	
		
	self assert: (tr23 traitComposition traitProvidingSelector: #foo) == tr1.
	self assert: (tr23 >> #foo) origin == tr1.
	"----------"! !

!TraitTest methodsFor: 'testing' stamp: 'al 2/13/2006 17:41'!
testMarkerMethods
	"self debug: #testMarkerMethods"

	self t1 compile: 'm1 self foo bar'.
	self assert: (self t1 >> #m1) markerOrNil isNil.


	self t1 compile: 'm2 self requirement'.
	self assert: (self t1 >> #m2) markerOrNil == #requirement.
	
	self t1 compile: 'm3 ^self requirement'.
	self assert: (self t1 >> #m3) markerOrNil == #requirement.! !

!TraitTest methodsFor: 'testing' stamp: 'VincentBlondeau 3/6/2015 16:41'!
testTraitRemoval
	self flag: #fix.	"It has to be refactored when Mariano's ClassBuilder for testCase is integrated :)"
	SystemAnnouncer uniqueInstance
		suspendAllWhile: [ 
			| aClass aTrait |
			[ 
			aTrait := self createTrait.
			aClass := self createClassUsing: aTrait.
			self assert: aClass localSelectors isEmpty.
			aClass removeFromComposition: aTrait.
			self assert: aClass localSelectors isEmpty.
			self assert: aClass organization allMethodSelectors isEmpty.
			self deny: aClass hasTraitComposition.
			self deny: (aTrait traitUsers includes: aClass). ]
				ensure: [ 
					aClass removeFromSystem: false.
					aTrait removeFromSystem: false ] ]! !

!TraitTest methodsFor: 'testing' stamp: 'PabloHerrero 6/7/2014 03:16'!
testExplicitRequirementWithSuperclassImplementatiosAlwaysReturnsTheCorrectValue
	"Make sure that an explicitRequirement method from a trait that is overrided by a method on a superclass always returns the value from the class defined method, even when an explict return from the trait defined method is missing."

	"C9 inherits from Object. C10 inherits from C9.  Each Ci uses the trait Ti."

	self t10 compile: 'm1 ^self explicitRequirement'.
	self t10 compile: 'm2 self explicitRequirement'.
	self t9 compile: 'm1 ^2'.
	self t9 compile: 'm2 ^2'.
	
	self assert: self c10 new m1 equals: 2.
	self assert: self c10 new m2 equals: 2.! !

!TraitTest methodsFor: 'testing' stamp: 'ST 6/5/2013 17:17'!
testPrinting
	self assertPrints: self t6 definition
		like: 'Trait named: #T6
	uses: T1 + (T2 @ {#m22Alias->#m22})
	category: ''Tests-Traits'''! !

!TraitTest methodsFor: 'testing' stamp: 'CamilleTeruel 2/12/2013 10:48'!
testRemoveFromSystem
	self flag: #fix.	"It has to be refactored when Mariano's ClassBuilder for testCase is integrated :)"
	SystemAnnouncer uniqueInstance
		suspendAllWhile: [ 
			| aClass aTrait |
			[ 
			aTrait := self createTrait.
			aClass := self createClassUsing: aTrait.
			aTrait removeFromSystem: false.
			self deny: aClass hasTraitComposition.
			self assert: aTrait isObsolete. ]
				ensure: [ aClass removeFromSystem: false ] ]! !

!TraitTest methodsFor: 'utils' stamp: 'CamilleTeruel 2/12/2013 10:56'!
createTrait
	| trait |
	trait := Trait named: #ATraitForTests uses: {} category: 'AAA'.
	trait compile: 'm1 ^1' classified: 'test'.
	^ trait! !

!TraitTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testAddAndRemoveMethodsInClassOrTrait
	| aC2 |
	aC2 := self c2 new.
	self assert: aC2 m51.
	self c2 compile: 'm51 ^123'.
	self assert: aC2 m51 = 123.
	self c2 removeSelector: #m51.
	aC2 m51.
	self assert: aC2 m51.
	self t4 removeSelector: #m11.
	self assert: (self t4 includesSelector: #m11)! !

!TraitTest methodsFor: 'testing' stamp: 'VincentBlondeau 3/6/2015 16:41'!
testTraitsUsersSanity
	"This documents bug http://code.google.com/p/pharo/issues/detail?id=443"
	"self debug: #testTraitsUsersSanity"
	
	Smalltalk allClassesAndTraits do: [ :each |
		self assert: (each traits allSatisfy: [ :t | t traitUsers includes: each  ]) ].

	Smalltalk allTraits do: [ :each |
		self assert: (each traitUsers allSatisfy: [ :b | b traits includes: each ]) ]! !

!TraitTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testTraitCompositionRespectsParenthesis
	self t1 compile: 'method ^1234'.
	self t2 compile: 'method ^4'.
	self c1 setTraitComposition: self t1 + self t2 - #method.
	self should: [ self c1 new method ] raise: MessageNotUnderstood.
	self c1 setTraitComposition: self t1 + (self t2 - #method).
	self c1 new method.
	self assert: self c1 new method = 1234! !

!TraitTest methodsFor: 'testing' stamp: 'md 8/15/2008 16:56'!
testPrintingClassSide
	"self run: #testPrintingClassSide"
	
	self assertPrints: self t6 classSide definition
		like: 'T6 classTrait
	uses: T1 classTrait + T2 classTrait'! !

!TraitTest methodsFor: 'testing' stamp: 'al 10/13/2006 13:54'!
testRequirement
	"self debug: #testRequirement"

	self t1 compile: 'm self requirement'.
	self t2 compile: 'm ^true'.
	self assert: self c2 new m.
	self t2 removeSelector: #m.
	self should: [self c2 new m] raise: Error! !

!TraitTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testAddAndRemoveMethodsFromSubtraits
	| aC2 |
	aC2 := self c2 new.
	self assert: aC2 m51.
	self t5 removeSelector: #m51.
	self should: [ aC2 m51 ] raise: MessageNotUnderstood.
	self t1 compile: 'foo ^true'.
	self deny: aC2 foo.
	self t1 compile: 'm51 ^self'.
	aC2 m51.
	self assert: aC2 m51 == aC2! !

!TraitTest methodsFor: 'testing' stamp: 'TudorGirba 11/3/2013 20:54'!
testCompositionCopy
	| t6compositionCopyFirst c2compositionCopy |
	self assert: (self t1 + self t2) allTraits 
				= (self t1 + self t2) copyTraitExpression allTraits.
	self assert: (self t1 classTrait + self t2 classTrait) allTraits 
				= (self t1 classTrait + self t2 classTrait) copyTraitExpression allTraits.
	self assert: self t6 traitComposition allTraits 
				= self t6 traitComposition copyTraitExpression allTraits.
	self 
		assert: (self t6 asTraitComposition copyTraitExpression allTraits includesAll: { (self t1). (self t2). (self t6) }).
	"make no undue sharing happens of exclusions and aliases after an expression copy"
	t6compositionCopyFirst := self t6 traitComposition copyTraitExpression.
	t6compositionCopyFirst transformations at: 1 put: #m22Alias -> #m33.
	self 
		assert: self t6 traitComposition transformations second aliases first value 
				= #m22.
	c2compositionCopy := self c2 traitComposition copyTraitExpression.
	c2compositionCopy transformations first exclusions at: 1 put: #m4.
	self c2 traitComposition transformations first exclusions = #(#m11 )! !

!TraitTest methodsFor: 'testing' stamp: 'DamienCassou 7/4/2013 18:55'!
testExplicitRequirementTakesPrecedenceOverTraitImplementation
	"If i create an explicit requirement method on a trait, the method has to be explicit requirement "
	self t12 compile: 'm ^11'.
	self t11 compile: 'm ^self explicitRequirement'.
	
	self should: [ self c11 new m ] raise: Error.
	
	"If i create an explicit requirement method on a class, and the superclass already have the method (non explicit requirement), the class should raise an exception"
	self c10 compile: 'm ^111'.
	self c11 compile: 'm ^self explicitRequirement'.
	self should: [ self c11 new m ] raise: Error.
	
	! !

!TraitTest methodsFor: 'utils' stamp: 'CamilleTeruel 2/12/2013 10:56'!
createClassUsing: aTrait
	^ Object
		subclass: #AClassForTests
		uses: aTrait
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: 'AAA'! !

!TraitTest methodsFor: 'testing' stamp: 'MarcusDenker 5/7/2013 23:27'!
testLocalMethodWithSameCodeInTrait
	"Test whether there are no unintentional overridden traits methods"

	SystemNavigation new allBehaviorsDo: [ :each |
		each hasTraitComposition ifTrue: [
			each selectorsDo: [ :selector |
				(each includesLocalSelector: selector) ifTrue: [
					(each traitComposition traitProvidingSelector: selector) ifNotNil: [ :trait |
						(trait selectors includes: selector) ifTrue: [
							self deny: (trait >> selector = (each >> selector)) ] ] ] ] ] ]! !

!TraitTest methodsFor: 'testing' stamp: 'DamienCassou 7/4/2013 18:55'!
testExplicitRequirementInClassAlwaysTakesPrecedence
	"If i create an explicit requirement method on a class, and the superclass already have the method (non explicit requirement), the class should raise an exception"

	self c10 compile: 'm ^111'.
	self c11 compile: 'm ^self explicitRequirement'.
	self should: [ self c11 new m ] raise: Error! !

!TraitTest methodsFor: 'testing' stamp: 'guillermoPolito 4/28/2012 16:41'!
testOriginWithRequiredMethod
	| tr1 c1 |
	tr1 := self createTraitNamed: #TTT1 uses: {}.
	
	tr1 compile: 'foo ^ self explicitRequirement'.
	self assert: (tr1 >> #foo) origin == tr1.
	
	c1 := self createClassNamed: #CTT1 superclass: Object uses: tr1.
	self assert: (c1 >> #foo) origin == tr1.! !

!TraitTest methodsFor: 'testing' stamp: 'VincentBlondeau 3/6/2015 16:41'!
testUsersWithClassChanges
	"This documents bug http://code.google.com/p/pharo/issues/detail?id=443"
	"self debug: #testUsersWithClassChanges"
	
	self c2 setTraitCompositionFrom: self t5.
	self assert: self t5 traitUsers size = 1.
	self assert: self t5 classSide traitUsers size = 1.
	self assert: self c2 traits size = 1.
	self assert: self c2 class traits size = 1.
	
	"Change class definition"
	self c2 addInstVarNamed: 'foo'.
	self assert: self t5 traitUsers size = 1.
	self assert: self t5 classSide traitUsers size = 1.
	self assert: self c2 traits size = 1.
	self assert: self c2 class traits size = 1.
	
	"Change metaclass definition"
	self c2 class instanceVariableNames: 'bar'.
	self assert: self t5 traitUsers size = 1.
	self assert: self t5 classSide traitUsers size = 1.
	self assert: self c2 traits size = 1.
	self assert: self c2 class traits size = 1.! !

!TraitTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testExplicitRequirementWithSuperclassImplementation
	"Make sure that an explicitRequirement method from a trait does not take precedence over a superclass implementation."

	self t10 compile: 'm ^self explicitRequirement'.
	self should: [ self c10 new m ] raise: Error.
	self c9 compile: 'm ^123'.
	self assert: self c10 new m equals: 123.
	self c9 removeSelector: #m.
	self t10 removeSelector: #m.	"The previous is still true even if we compile the superclass method before the trait method."
	self c9 compile: 'm ^123'.
	self t10 compile: 'm ^self explicitRequirement'.
	self c10 new m.
	self c9 removeSelector: #m.
	self should: [ self c10 new m ] raise: Error.
	self t10 removeSelector: #m! !

!TraitTest methodsFor: 'testing' stamp: 'DamienCassou 7/4/2013 18:54'!
testExplicitRequirementWithSuperclassImplementationAndAnotherTrait
	"Make sure that an explicitRequirement method from a trait does not take precedence over a superclass implementation."

	"The previous should still be true even in the presence of a superclass importing another explicitRequirement method."

	"C9 inherits from Object. C10 inherits from C9. C11 inherits from C10. Each Ci uses the trait Ti."

	self t10 compile: 'm ^self explicitRequirement'.
	self t11 compile: 'm ^self explicitRequirement'.
	self should: [ self c10 new m ] raise: Error.
	self should: [ self c11 new m ] raise: Error.
	self t9 compile: 'm ^2'.
	self assert: self c9 new m equals: 2.
	self assert: self c10 new m equals: 2.
	self assert: self c11 new m equals: 2! !

!TraitTransformation commentStamp: 'apb 8/25/2005 11:54'!
A trait transformation is an instance of one of my concrete subclasses, TraitAlias or TraitExclusion. These represent a transformation of a trait, specified by the alias and exclusion operators. 

I define an instance variable named subject which holds the object that is transformed.  Thus, an alias transformation has as its subject a trait, and a trait exclusion has as its subject either a trait alias or a trait. Each of the concrete transformation classes implement the method allSelectors according to the transformation it represents. 

(There was formerly a subclass called TraitHolder, which was the identity transformation and which did not modify the trait.  This was clearly redundant, and was removed.)!
!TraitTransformation methodsFor: 'enquiries' stamp: 'dvf 8/16/2005 17:35'!
traitTransformations 
	^ { subject }! !

!TraitTransformation methodsFor: 'converting' stamp: ''!
asTraitComposition
	^TraitComposition with: self! !

!TraitTransformation methodsFor: 'enquiries' stamp: 'al 3/7/2004 22:36'!
allSelectors
	^self subclassResponsibility! !

!TraitTransformation methodsFor: 'enquiries' stamp: 'NS 4/16/2004 13:40'!
allAliasesDict
	"Return a dictionary with all alias associations that are defined in this transformation."
	
	^self subject allAliasesDict! !

!TraitTransformation methodsFor: 'accessing' stamp: 'NS 12/11/2003 15:13'!
subject
	^subject! !

!TraitTransformation methodsFor: 'composition' stamp: ''!
+ aTraitOrTraitComposition
	"Use double dispatch to avoid having nested composition in cases where
	parenthesis are used, such as T1 + (T2 + T3)"
	
	^aTraitOrTraitComposition addOnTheLeft: self! !

!TraitTransformation methodsFor: 'composition' stamp: 'al 12/7/2005 21:19'!
- anArray
	TraitCompositionException signal: 'Invalid trait exclusion. Exclusions have to be specified after aliases.'! !

!TraitTransformation methodsFor: 'accessing' stamp: 'al 4/9/2004 18:23'!
subject: aTraitTransformation
	subject := aTraitTransformation! !

!TraitTransformation methodsFor: 'enquiries' stamp: 'al 3/11/2004 21:49'!
aliasesForSelector: aSymbol
	"Return a collection of alias selectors that are defined in this transformation."
	
	^self subject aliasesForSelector: aSymbol! !

!TraitTransformation methodsFor: 'enquiries' stamp: 'NS 4/16/2004 14:20'!
changedSelectorsComparedTo: aTraitTransformation
	| selectors otherSelectors changedSelectors aliases otherAliases |
	selectors := self allSelectors asIdentitySet.
	otherSelectors := aTraitTransformation allSelectors asIdentitySet.
	changedSelectors := IdentitySet withAll: (
		(selectors difference: otherSelectors) union: (otherSelectors difference: selectors)).
	aliases := self allAliasesDict.
	otherAliases := aTraitTransformation allAliasesDict.
	aliases keysAndValuesDo: [:key :value |
		(value ~~ (otherAliases at: key ifAbsent: [nil])) ifTrue: [changedSelectors add: key]].
	otherAliases keysAndValuesDo: [:key :value |
		(value ~~ (aliases at: key ifAbsent: [nil])) ifTrue: [changedSelectors add: key]].
	^ changedSelectors.! !

!TraitTransformation methodsFor: 'printing' stamp: 'al 12/12/2003 18:29'!
printOn: aStream
	aStream print: self subject! !

!TraitTransformation methodsFor: 'accessing parallel hierarchy' stamp: 'dvf 8/18/2005 18:28'!
theNonMetaClass 
	^ self subject theNonMetaClass  ! !

!TraitTransformation methodsFor: 'composition' stamp: 'al 12/7/2005 21:20'!
@ anArrayOfAssociations
	TraitCompositionException signal: 'Invalid trait exclusion. Aliases have to be specified before exclusions.'! !

!TraitTransformation methodsFor: 'comparing' stamp: 'MartinDias 1/23/2014 15:17'!
syntacticallyEquals: aTraitTransformation
	"Test syntactic equivalence of this trait transformation with another."
	
	^ self subclassResponsibility ! !

!TraitTransformation methodsFor: 'enquiries' stamp: 'al 12/12/2003 18:00'!
trait
	^self subject trait! !

!TraitTransformation methodsFor: 'testing' stamp: 'al 4/10/2004 23:56'!
isEmpty
	self subclassResponsibility! !

!TraitTransformation methodsFor: 'enquiries' stamp: 'al 3/6/2004 18:51'!
collectMethodsFor: aSelector into: methodDescription
	"Collect instances of LocatedMethod into methodDescription
	for each method that has the selector aSelector and is not excluded
	or for which aSelector is an alias."

	self subclassResponsibility! !

!TraitTransformation methodsFor: 'accessing parallel hierarchy' stamp: 'dvf 8/18/2005 18:29'!
isMeta
	^self subject isMeta! !

!TraitTransformation methodsFor: 'private' stamp: ''!
addOnTheLeft: aTraitExpression
	^TraitComposition with: aTraitExpression with: self! !

!TraitTransformation methodsFor: 'copying' stamp: 'nice 1/13/2010 22:02'!
copy
	self error: 'should not be called'.
	^super copy! !

!TraitTransformation methodsFor: 'copying' stamp: 'dvf 8/25/2005 16:06'!
copyTraitExpression
	^self shallowCopy 
		subject: self subject copyTraitExpression;
		yourself! !

!TraitTransformation methodsFor: 'copying' stamp: 'nice 1/13/2010 21:54'!
postCopy
	super postCopy.
	subject := subject copy! !

!TraitTransformation methodsFor: 'private' stamp: ''!
addCompositionOnLeft: aTraitComposition
	^ aTraitComposition add: self! !

!TraitTransformation methodsFor: 'accessing' stamp: 'al 4/10/2004 00:06'!
normalized
	^self isEmpty
		ifFalse: [
			self subject: self subject normalized.
			self]
		ifTrue: [self subject normalized]
		
		! !

!TraitTransformation methodsFor: 'composition' stamp: 'al 4/10/2004 23:48'!
removeAlias: aSymbol
	self subject removeAlias: aSymbol! !

!TraitTransformation methodsFor: 'composition' stamp: 'al 4/9/2004 17:01'!
addExclusionOf: aSymbol
	^self - {aSymbol}! !

!TraitTransformation methodsFor: 'enquiries' stamp: 'dvf 8/18/2005 18:39'!
selectors
	^self allSelectors! !

!TraitsResource commentStamp: 'MartinDias 1/22/2014 15:40'!
I define objects to be used for testing traits.

Browsr references to myself.!
!TraitsResource methodsFor: 'accessing' stamp: 'ST 6/11/2013 16:40'!
t8: anObject
	^t8 := anObject! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 14:00'!
c7: anObject
	^c7 := anObject! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 14:00'!
c4: anObject
	^c4 := anObject! !

!TraitsResource methodsFor: 'running' stamp: 'noha 6/11/2008 18:42'!
setUpTwoLevelRequiresFixture
	self c4: (self 
				createClassNamed: #C4
				superclass: ProtoObject
				uses: { }).
	ProtoObject removeSubclass: self c4.
	self c4 superclass: nil.
	self c5: (self 
				createClassNamed: #C5
				superclass: self c4
				uses: { }).
	self c4 compile: 'foo ^self blew' classified: #accessing.
	self c5 compile: 'foo ^self blah' classified: #accessing! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 13:59'!
t2
	^t2! !

!TraitsResource methodsFor: 'accessing' stamp: 'SebastianTleye 6/27/2013 16:55'!
c11: anObject
	^c11 := anObject! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 14:01'!
c8: anObject
	^c8 := anObject! !

!TraitsResource methodsFor: 'accessing' stamp: 'SebastianTleye 7/1/2013 14:15'!
t12: anObject
	^t12 := anObject! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 13:59'!
t6
	^t6! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 14:01'!
c8
	^c8! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 14:00'!
c2: anObject
	^c2 := anObject! !

!TraitsResource methodsFor: 'utility' stamp: 'dvf 8/30/2005 11:47'!
createTraitNamed: aSymbol uses: aTraitComposition
	| trait |
	trait := Trait
		named: aSymbol
		uses: aTraitComposition
		category: self categoryName.
	self createdClassesAndTraits add: trait.
	^trait! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 14:00'!
c5: anObject
	^c5 := anObject! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 13:58'!
t1: anObject
	^t1 := anObject! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 13:58'!
t1
	^t1! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 14:00'!
c3
	^c3! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 13:59'!
t4: anObject
	^t4 := anObject! !

!TraitsResource methodsFor: 'accessing' stamp: 'ST 6/11/2013 16:34'!
c9: anObject
	^c9 := anObject! !

!TraitsResource methodsFor: 'accessing' stamp: 'ST 6/11/2013 16:40'!
t8
	^t8! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 14:00'!
c7
	^c7! !

!TraitsResource methodsFor: 'accessing' stamp: 'SebastianTleye 6/27/2013 16:54'!
t11: anObject
	^t11 := anObject! !

!TraitsResource methodsFor: 'accessing' stamp: 'SebastianTleye 6/27/2013 16:25'!
t10: anObject
	^t10 := anObject! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 14:00'!
c3: anObject
	^c3 := anObject! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 14:00'!
c6
	^c6! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 13:59'!
t6: anObject
	^t6 := anObject! !

!TraitsResource methodsFor: 'accessing' stamp: 'SebastianTleye 6/27/2013 16:24'!
c10
	^c10.! !

!TraitsResource methodsFor: 'accessing' stamp: 'SebastianTleye 7/1/2013 14:15'!
t12
	^t12.! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 13:59'!
t2: anObject
	^t2 := anObject! !

!TraitsResource methodsFor: 'accessing' stamp: 'SebastianTleye 6/27/2013 16:54'!
c11
	^c11.! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 14:00'!
c6: anObject
	^c6 := anObject! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 11:47'!
createdClassesAndTraits
	createdClassesAndTraits ifNil: [
		createdClassesAndTraits := OrderedCollection new].
	^createdClassesAndTraits! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 14:00'!
c4
	^c4! !

!TraitsResource methodsFor: 'accessing' stamp: 'ST 6/11/2013 16:38'!
t9: anObject
	^t9 := anObject! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 14:00'!
c2
	^c2! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 13:59'!
t3: anObject
	^t3 := anObject! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 14:00'!
c1
	^c1! !

!TraitsResource methodsFor: 'accessing' stamp: 'ST 6/11/2013 16:38'!
t9
	^t9! !

!TraitsResource methodsFor: 'running' stamp: 'noha 6/11/2008 18:42'!
setUpTrivialRequiresFixture
	self c3: (self 
				createClassNamed: #C3
				superclass: ProtoObject
				uses: { }).
	ProtoObject removeSubclass: self c3.
	self c3 superclass: nil.
	self c3 compile: 'foo ^self bla' classified: #accessing! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 14:00'!
c5
	^c5! !

!TraitsResource methodsFor: 'accessing' stamp: 'ST 6/11/2013 16:34'!
c9
	^c9! !

!TraitsResource methodsFor: 'running' stamp: 'GuillermoPolito 8/2/2012 12:12'!
tearDown
	self createdClassesAndTraits
		do: [ :aClassOrTrait | 
			| behaviorName |
			behaviorName := aClassOrTrait name.
			Smalltalk globals at: behaviorName ifPresent: [ :classOrTrait | classOrTrait removeFromSystem ].
			ChangeSet current removeClassChanges: behaviorName ].
	createdClassesAndTraits := self
		t1:
			(self
				t2:
					(self
						t3:
							(self
								t4:
									(self t5: (self t6: (self c1: (self c2: (self c3: (self c4: (self c5: (self c6: (self c7: (self c8: nil))))))))))))).! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 11:47'!
categoryName
	^self class category! !

!TraitsResource methodsFor: 'running' stamp: 'SebastianTleye 7/18/2013 16:32'!
setUp
	"Please note, that most tests rely on this setup of traits and
	classes - and that especially the order of the definitions matters."
	"SetUpCount := SetUpCount + 1."

	dirty := false.
	SystemAnnouncer uniqueInstance suspendAllWhile: 
			[self t1: (self createTraitNamed: #T1
						uses: { }).
			self t1 comment: 'I am the trait T1'.
			
			self t1 compile: 'm11 ^11' classified: #cat1.
			self t1 compile: 'm12 ^12' classified: #cat2.
			self t1 compile: 'm13 ^self m12' classified: #cat3.
			
			self t2: (self createTraitNamed: #T2
						uses: { }).
			self t2 compile: 'm21 ^21' classified: #cat1.
			self t2 compile: 'm22 ^22' classified: #cat2.
			self t2 classSide compile: 'm2ClassSide: a ^a'.
			
			self t3: (self createTraitNamed: #T3
						uses: { }).
			self t3 compile: 'm31 ^31' classified: #cat1.
			self t3 compile: 'm32 ^32' classified: #cat2.
			self t3 compile: 'm33 ^33' classified: #cat3.
			
			self t4: (self createTraitNamed: #T4
						uses: { (self t1). (self t2) }).
			self t4 compile: 'm11 ^41' classified: #catX.	"overrides T1>>m11"
			self t4 compile: 'm42 ^42' classified: #cat2.
			
			self t5: (self createTraitNamed: #T5 uses: self t1 + self t2).
			self t5 compile: 'm51 ^super foo' classified: #cat1.
			self t5 compile: 'm52 ^ self class bar' classified: #cat1.
			self t5 compile: 'm53 ^ self class bar' classified: #cat1.
			
			self t6: (self createTraitNamed: #T6
						uses: self t1 + (self t2 @ { (#m22Alias -> #m22) })).

			self t9: (self createTraitNamed: #T9
						uses: { }).
						
			self t10: (self createTraitNamed: #T10
						uses: { }).
						
			self t12: (self createTraitNamed: #T12
						uses: {}).
	
			self t11: (self createTraitNamed: #T11
						uses: { self t12}).
			

						
			self c1: (self 
						createClassNamed: #C1
						superclass: Object
						uses: { }).
			self c1 compile: 'foo ^true' classified: #accessing.
			self c2: (self 
						createClassNamed: #C2
						superclass: self c1
						uses: self t5 - { #m11 }).
			self c2 compile: 'foo ^false' classified: #private.
			self c2 compile: 'bar ^self foo' classified: #private.
						
			self c9: (self 
						createClassNamed: #C9
						superclass: Object
						uses: self t9 ).
						
			self c10: (self 
						createClassNamed: #C10
						superclass: self c9
						uses: self t10 ).
						
			self c11: (self 
						createClassNamed: #C11
						superclass: self c10
						uses: self t11 ).
			
			self setUpTrivialRequiresFixture.
			self setUpTwoLevelRequiresFixture.
			self setUpTranslatingRequiresFixture].! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 13:59'!
t5
	^t5! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 13:59'!
t5: anObject
	^t5 := anObject! !

!TraitsResource methodsFor: 'utility' stamp: 'dvf 8/30/2005 11:47'!
createClassNamed: aSymbol superclass: aClass uses: aTraitComposition
	| class |
	class := aClass
		subclass: aSymbol
		uses: aTraitComposition
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''		
		category: self categoryName.
	self createdClassesAndTraits add: class.
	^class! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 13:59'!
t4
	^t4! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 14:00'!
c1: anObject
	^c1 := anObject! !

!TraitsResource methodsFor: 'accessing' stamp: 'dvf 8/30/2005 13:59'!
t3
	^t3! !

!TraitsResource methodsFor: 'accessing' stamp: 'SebastianTleye 6/27/2013 16:24'!
c10: anObject
	^c10 := anObject! !

!TraitsResource methodsFor: 'accessing' stamp: 'SebastianTleye 6/27/2013 16:25'!
t10
	^t10.! !

!TraitsResource methodsFor: 'running' stamp: 'noha 6/11/2008 18:41'!
setUpTranslatingRequiresFixture
	self c6: (self 
				createClassNamed: #C6
				superclass: ProtoObject
				uses: { }).
	ProtoObject removeSubclass: self c6.
	self c6 superclass: nil.
	self c7: (self 
				createClassNamed: #C7
				superclass: self c6
				uses: { }).
	self c8: (self 
				createClassNamed: #C8
				superclass: self c7
				uses: { }).
	self c6 compile: 'foo ^self x' classified: #accessing.
	self c7 compile: 'foo ^3' classified: #accessing.
	self c7 compile: 'bar ^super foo' classified: #accessing.
	self c8 compile: 'bar ^self blah' classified: #accessing! !

!TraitsResource methodsFor: 'accessing' stamp: 'SebastianTleye 6/27/2013 16:54'!
t11
	^t11.! !

!TraitsTestCase methodsFor: 'accessing' stamp: 'SebastianTleye 6/27/2013 17:04'!
c11
	^TraitsResource current c11! !

!TraitsTestCase methodsFor: 'utility' stamp: 'dvf 8/30/2005 14:44'!
createdClassesAndTraits
	createdClassesAndTraits ifNil: [
		createdClassesAndTraits := OrderedCollection new].
	^createdClassesAndTraits! !

!TraitsTestCase methodsFor: 'accessing' stamp: 'dvf 8/30/2005 11:44'!
t2
	^TraitsResource current t2! !

!TraitsTestCase methodsFor: 'accessing' stamp: 'dvf 8/30/2005 11:44'!
c4
	^TraitsResource current c4! !

!TraitsTestCase methodsFor: 'accessing' stamp: 'dvf 8/30/2005 11:44'!
c2
	^TraitsResource current c2! !

!TraitsTestCase methodsFor: 'accessing' stamp: 'dvf 8/30/2005 11:44'!
c1
	^TraitsResource current c1! !

!TraitsTestCase methodsFor: 'accessing' stamp: 'dvf 8/30/2005 11:45'!
t6
	^TraitsResource current t6! !

!TraitsTestCase methodsFor: 'accessing' stamp: 'dvf 8/30/2005 11:44'!
c8
	^TraitsResource current c8! !

!TraitsTestCase methodsFor: 'utility' stamp: 'dvf 8/30/2005 14:44'!
createTraitNamed: aSymbol uses: aTraitComposition
	| trait |
	trait := Trait
		named: aSymbol
		uses: aTraitComposition
		category: self categoryName.
	self createdClassesAndTraits add: trait.
	^trait! !

!TraitsTestCase methodsFor: 'accessing' stamp: 'ST 6/11/2013 17:06'!
t9
	^TraitsResource current t9! !

!TraitsTestCase methodsFor: 'utility' stamp: 'dvf 8/30/2005 14:49'!
resourceClassesAndTraits
	^TraitsResource current createdClassesAndTraits! !

!TraitsTestCase methodsFor: 'accessing' stamp: 'ST 6/11/2013 17:06'!
c9
	^TraitsResource current c9! !

!TraitsTestCase methodsFor: 'accessing' stamp: 'dvf 8/30/2005 11:44'!
c5
	^TraitsResource current c5! !

!TraitsTestCase methodsFor: 'accessing' stamp: 'dvf 8/30/2005 11:44'!
t1
	^TraitsResource current t1! !

!TraitsTestCase methodsFor: 'accessing' stamp: 'dvf 8/30/2005 11:44'!
c3
	^TraitsResource current c3! !

!TraitsTestCase methodsFor: 'running' stamp: 'EstebanLorenzano 8/3/2012 14:26'!
tearDown
	TraitsResource reset.
	self createdClassesAndTraits
		do: [ :aClassOrTrait || behaviorName |
			behaviorName := aClassOrTrait name.
			Smalltalk globals at: behaviorName ifPresent: [ :classOrTrait | classOrTrait removeFromSystem ].
			ChangeSet current removeClassChanges: behaviorName ].
	createdClassesAndTraits := nil.
	SystemAnnouncer announcer: oldAnnouncer.
! !

!TraitsTestCase methodsFor: 'accessing' stamp: 'ST 6/11/2013 17:06'!
t8
	^TraitsResource current t8! !

!TraitsTestCase methodsFor: 'accessing' stamp: 'dvf 8/30/2005 11:44'!
c7
	^TraitsResource current c7! !

!TraitsTestCase methodsFor: 'running' stamp: 'al 4/25/2004 16:31'!
categoryName
	^self class category! !

!TraitsTestCase methodsFor: 'accessing' stamp: 'dvf 8/30/2005 11:45'!
t5
	^TraitsResource current t5! !

!TraitsTestCase methodsFor: 'running' stamp: 'EstebanLorenzano 8/3/2012 14:26'!
setUp

	super setUp.
	oldAnnouncer := SystemAnnouncer uniqueInstance.
	SystemAnnouncer announcer: nil.
! !

!TraitsTestCase methodsFor: 'utility' stamp: 'dvf 8/30/2005 14:44'!
createClassNamed: aSymbol superclass: aClass uses: aTraitComposition
	| class |
	class := aClass
		subclass: aSymbol
		uses: aTraitComposition
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''		
		category: self categoryName.
	self createdClassesAndTraits add: class.
	^class! !

!TraitsTestCase methodsFor: 'accessing' stamp: 'dvf 8/30/2005 11:44'!
c6
	^TraitsResource current c6! !

!TraitsTestCase methodsFor: 'utility' stamp: 'al 12/16/2003 22:16'!
assertPrints: aString like: anotherString 
	self assert: (aString copyWithout: $ )
		= (anotherString copyWithout: $ )! !

!TraitsTestCase methodsFor: 'accessing' stamp: 'dvf 8/30/2005 11:45'!
t4
	^TraitsResource current t4! !

!TraitsTestCase methodsFor: 'accessing' stamp: 'SebastianTleye 6/27/2013 17:04'!
c10
	^TraitsResource current c10! !

!TraitsTestCase methodsFor: 'accessing' stamp: 'SebastianTleye 7/1/2013 14:17'!
t12
	^TraitsResource current t12! !

!TraitsTestCase methodsFor: 'accessing' stamp: 'dvf 8/30/2005 11:45'!
t3
	^TraitsResource current t3! !

!TraitsTestCase methodsFor: 'accessing' stamp: 'SebastianTleye 6/27/2013 17:04'!
t10
	^TraitsResource current t10! !

!TraitsTestCase methodsFor: 'accessing' stamp: 'SebastianTleye 6/27/2013 17:04'!
t11
	^TraitsResource current t11! !

!TraitsTestCase class methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 4/27/2012 13:20'!
resources
	^ super resources copyWith: TraitsResource! !

!TraitsTestCase class methodsFor: 'testing' stamp: 'JorgeRessia 3/16/2010 20:38'!
isUnitTest
	^false! !

!Transcripter commentStamp: 'StephaneDucasse 11/19/2011 16:48'!
Transcripter is a dog-simple scrolling stream with display.  It is intended to operate with no support from MVC or color in a minimal, or headless version of Pharo.  No attention has been paid to appearance or performance.

type exit (without quote) to exit the evaluator
type revert (without quote) to revert the last changes.

Transcripter askForEmergencyEvaluatorOrExitWithText: 'Emergency Evaluator'

Transcripter emergencyEvaluator!
!Transcripter methodsFor: 'private' stamp: 'di 8/14/97 12:12'!
black
	Display depth = 1 ifTrue: [^ Bitmap with: 16rFFFFFFFF "Works without color support"].
	^ Color black! !

!Transcripter methodsFor: 'initialization' stamp: 'AlainPlantec 9/15/2011 17:27'!
initInFrame: rect
	frame := rect.
	para := Paragraph new.
	self compose! !

!Transcripter methodsFor: 'accessing' stamp: 'StephaneDucasse 11/19/2011 16:49'!
clear
	self clearFrame.
	self on: (String new: 100);  endEntry ! !

!Transcripter methodsFor: 'private' stamp: 'AlainPlantec 9/12/2011 01:43'!
clearFrame
	Display getCanvas
		frameAndFillRectangle: frame
		fillColor: self white
		borderWidth: 2
		borderColor: self black! !

!Transcripter methodsFor: 'command line' stamp: 'AlainPlantec 9/11/2011 22:36'!
request: prompt 
	| startPos char contents |
	self cr; show: prompt.
	startPos := position.
	Sensor flushKeyboard.
	[(char := self nextChar) = Character cr]
		whileFalse: [char = Character backspace
				ifTrue: [readLimit := position := position - 1 max: startPos]
				ifFalse: [self nextPut: char].
			self endEntry].
	contents := self contents.
	^ contents copyFrom: startPos + 1 to: contents size ! !

!Transcripter methodsFor: 'accessing' stamp: 'AlainPlantec 9/12/2011 00:35'!
endEntry
	| c d cb |
	c := self contents.
	Display extent ~= DisplayScreen actualScreenSize
		ifTrue: ["Handle case of user resizing physical window"
			DisplayScreen startUp.
			frame := frame intersect: Display boundingBox.
			^ self clear; show: c].
	self compose.
	d := para extent y - frame bottom.
	d > 0
		ifTrue: ["Scroll up to keep all contents visible"
			cb := para characterBlockAtPoint: para compositionRectangle topLeft + (0 @ (d + self textStyle lineGrid)).
			self on: (c copyFrom: cb stringIndex to: c size).
			readLimit := position := collection size.
			^ self endEntry].
	self display! !

!Transcripter methodsFor: 'private' stamp: 'di 8/14/97 12:12'!
white
	Display depth = 1 ifTrue: [^ Bitmap with: 0 "Works without color support"].
	^ Color white! !

!Transcripter methodsFor: 'command line' stamp: 'MarcusDenker 5/2/2013 11:35'!
readEvalPrint
	| line okToRevert |
	okToRevert := true.
	Sensor flushKeyboard.
	[#('quit' 'exit' 'done' ) includes: (line := self request: '> ')]
		whileFalse: [line = 'revert'
				ifTrue: [okToRevert
						ifTrue: [(self confirm: 'Revert: ' , RecentMessageList uniqueInstance lastEntry asString , ' ?')
								ifTrue: [RecentMessageList uniqueInstance revertLastMethodSubmission.
									self cr; show: 'reverted: ' , RecentMessageList uniqueInstance lastEntry asString.
									okToRevert := false]]
						ifFalse: [self cr; show: 'Only one level of revert currently supported']]
				ifFalse: [self cr;
						show: ([self class compiler evaluate: line]
								ifError: [:err | err])]]. 
	self cr; show: 'Done'.
! !

!Transcripter methodsFor: 'accessing' stamp: 'AlainPlantec 9/12/2011 01:43'!
display
	self clearFrame.
	Display getCanvas
		paragraph: para
		bounds: frame
		color: self black! !

!Transcripter methodsFor: 'accessing' stamp: 'AlainPlantec 9/12/2011 00:30'!
compose 
	para
		compose: self contents asText 
		style: self textStyle
		from: 1
		in: ((frame insetBy: 4) withHeight: 9999).
! !

!Transcripter methodsFor: 'command line' stamp: 'StephaneDucasse 11/19/2011 09:43'!
confirm: queryString 
	| choice |
	[true]
		whileTrue: 
			[choice := self request: queryString , '
Please type Yes or No followed by return
> '.
			choice first asUppercase = $Y ifTrue: [^ true].
			choice first asUppercase = $N ifTrue: [^ false]]! !

!Transcripter methodsFor: 'command line' stamp: 'AlainPlantec 9/11/2011 23:58'!
nextChar
	^ self class nextChar! !

!Transcripter methodsFor: 'accessing' stamp: 'sma 2/26/2000 19:35'!
show: anObject
	self nextPutAll: anObject asString; endEntry! !

!Transcripter methodsFor: 'private' stamp: 'AlainPlantec 9/11/2011 16:12'!
textStyle
	^ TextStyle default! !

!Transcripter class methodsFor: 'utilities' stamp: 'StephaneDucasse 11/19/2011 17:15'!
buildIcon

	| bitmap |
	bitmap := (Bitmap new: 256) copyFromByteArray:   #[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6 170 128 0 0 0 0 0 52 255 186 0 9 142 113 0 10 153 102 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 7 182 146 0 27 179 132 0 20 255 153 0 31 156 107 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 29 202 149 0 51 205 145 0 48 234 112 0 233 254 111 0 95 244 121 0 33 209 155 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 46 0 0 0 189 46 20 0 245 102 44 0 255 159 69 0 198 215 93 0 22 197 116 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6 0 0 0 49 0 0 0 96 0 0 0 81 0 0 0 225 0 0 0 191 0 0 0 86 21 9 0 42 79 36 0 55 9 5 0 49 167 120 0 3 170 85 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 93 0 0 0 236 0 3 0 255 12 34 12 255 36 66 36 255 26 42 26 255 0 0 0 188 0 0 0 33 0 0 0 0 0 0 0 48 0 0 0 2 128 128 0 1 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 150 0 0 0 255 0 16 0 255 27 89 27 255 77 136 77 255 116 162 116 255 107 135 107 255 67 83 67 255 73 97 73 245 2 3 2 46 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 83 0 0 0 255 0 6 0 255 0 77 0 255 51 119 51 255 102 153 102 255 151 185 151 255 191 212 191 255 200 218 200 255 168 197 168 255 65 89 65 209 0 0 0 6 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 201 0 0 0 255 0 47 0 255 5 88 5 255 58 124 58 255 111 159 111 255 165 195 165 255 218 230 218 255 238 244 238 255 185 208 185 255 130 171 130 255 10 18 10 77 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4 0 0 0 247 0 0 0 255 0 68 0 255 0 85 0 255 51 119 51 255 102 153 102 255 150 185 150 255 189 211 189 255 198 217 198 255 166 196 166 255 120 165 120 255 25 47 25 135 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 15 0 0 0 255 0 0 0 255 0 74 0 255 0 85 0 255 31 105 31 255 76 135 76 255 115 161 115 255 141 179 141 255 146 182 146 255 127 169 127 255 91 146 91 255 21 50 21 155 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 220 0 0 0 255 0 57 0 255 0 85 0 255 1 86 1 255 39 111 39 255 71 132 71 255 90 145 90 255 93 147 93 255 80 138 80 255 52 120 52 255 4 23 4 99 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 143 0 0 0 255 0 23 0 255 0 85 0 255 0 85 0 255 0 85 0 255 23 100 23 255 38 110 38 255 40 112 40 255 30 105 30 255 6 73 6 244 0 2 0 28 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 9 0 0 0 213 0 0 0 255 0 45 0 255 0 85 0 255 0 85 0 255 0 85 0 255 0 85 0 255 0 85 0 255 0 77 0 255 0 15 0 105 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6 128 128 128 68 68 68 68 206 11 11 11 255 0 23 0 255 0 58 0 255 0 74 0 255 0 67 0 255 0 47 0 249 1 7 1 155 31 31 31 57 130 130 130 22 128 128 128 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 17 135 135 135 63 125 125 125 88 128 128 128 147 57 57 57 194 28 28 28 227 12 12 12 214 19 19 19 181 38 38 38 120 91 91 91 92 128 128 128 80 128 128 128 41 124 124 124 2 128 128 128 0 0 0 0].
	^ Form extent: 16@16 depth: 32 bits: bitmap! !

!Transcripter class methodsFor: 'utilities' stamp: 'StephaneDucasse 11/19/2011 09:57'!
startTranscriptProcess
	"Transcripter startTranscriptProcess. Pay attention exit will quit the image."
	
	| activeProcess |
	Transcript := self newInFrame: Display boundingBox.
	activeProcess := [ Transcript readEvalPrint.
					Smalltalk processShutDownList: true;
				 		quitPrimitive ] newProcess priority: Processor userSchedulingPriority.
	activeProcess resume.
	Processor terminateActive ! !

!Transcripter class methodsFor: 'utilities' stamp: 'GaryChambers 10/26/2011 12:42'!
nextChar
	[| evt type | 
		(Delay forMilliseconds: 20) wait.
		Sensor nextEvent
		ifNotNil: [:evtBuf | 
			type := evtBuf first.
			type = EventTypeKeyboard
				ifTrue: [evt := World currentHand generateKeyboardEvent: evtBuf.
					evt isKeystroke
						ifTrue: [| c |
							c := evt keyCharacter.
							(c asciiValue < 128
									or: [c isSeparator
											or: [c isSpecial
													or: [c = Character backspace]]])
								ifTrue: [Sensor flushKeyboard.
									^ evt keyCharacter]]]]] repeat! !

!Transcripter class methodsFor: 'utilities' stamp: 'StephaneDucasse 11/19/2011 09:58'!
newInFrame: frame 
	"Create a transcript of a given size. Does not launch the evaluator"
	
	"
	(Transcripter newInFrame: (0@0 extent: 100@200))
	nextPutAll: 'Hello there'; endEntry;
	cr; print: 355.0/113; endEntry;
	readEvalPrint
	"
	| transcript |
	transcript := self on: (String new: 100).
	transcript initInFrame: frame.
	^ transcript clear! !

!Transcripter class methodsFor: 'menu' stamp: 'TorstenBergmann 2/12/2014 09:30'!
emergencyEvaluatorMenuOn: aBuilder 
	<worldMenu> 
	
	(aBuilder item: #'Emergency Evaluator')
		action: [self emergencyEvaluator. World restoreMorphicDisplay];
		parent: #Tools;
		order: 0.57;	
		help: 'Invoke the emergency evaluator';
		icon: self icon
	! !

!Transcripter class methodsFor: 'launching' stamp: 'MarcusDenker 2/27/2012 10:03'!
emergencyEvaluator
	"Display and launch an evaluator"
	
	(self newInFrame: (0@0 corner: 420@300))
		show: 'Type revert (without quote) to revert your last method change.
Type exit (without quote) to exit the emergency evaluator.';
		readEvalPrint.! !

!Transcripter class methodsFor: 'launching' stamp: 'StephaneDucasse 11/19/2011 16:46'!
askForEmergencyEvaluatorOrExitWithText: aText 
	| m |
	m := String streamContents: [:s | 
					s nextPutAll: aText.
					s cr; nextPutAll: '-----------------------------------------------------------------'.
					s cr; nextPutAll: 'Type CR to enter an emergency evaluator.'.
					s cr; nextPutAll: 'Type any other character to restart.'].
	Display getCanvas 
		drawString: m
		from: 1
		to: m size
		autoBoundAt: 0 @ 0
		font: nil
		color: Color black.
	self nextChar = Character cr
		ifTrue: [self emergencyEvaluator]! !

!Transcripter class methodsFor: 'utilities' stamp: 'StephaneDucasse 11/19/2011 17:17'!
icon

	^ Icon ifNil: [Icon := self buildIcon]! !

!TransferMorph commentStamp: 'nk 6/16/2003 16:52'!
This is a Morph that is used to visually indicate the progress of a drag operation, and also as a container for various bits of drag state information.

It polls the shift state in its step method to update its copy state (shift pressed = should copy).

And if you hit the Escape key while dragging, it aborts the drag operation.!
!TransferMorph methodsFor: 'private' stamp: 'StephaneDucasse 5/23/2013 18:40'!
updateCopyIcon

	| copyIcon |	
	copyIcon := self submorphWithProperty: #tmCopyIcon.
	self shouldCopy ifFalse: [
		^ copyIcon ifNotNil: [ copyIcon delete ]].
	copyIcon ifNotNil: [ ^ self ].
	copyIcon := ImageMorph new form: CopyPlusIcon.
	copyIcon setProperty: #tmCopyIcon toValue: true.
	^ self addMorphFront: copyIcon.
! !

!TransferMorph methodsFor: 'initialization' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
defaultColor
	"answer the default color/fill style for the receiver"
	^ Smalltalk ui theme selectionColor! !

!TransferMorph methodsFor: 'event handling' stamp: 'nk 6/16/2003 16:51'!
keyStroke: evt
	"Abort the drag on an escape"
	evt keyCharacter ~= Character escape ifTrue: [ ^self ].
	self delete.! !

!TransferMorph methodsFor: 'private' stamp: 'nk 6/16/2003 16:49'!
initDraggedMorph
	draggedMorph ifNotNil: [^self].
	draggedMorph := self passenger asDraggableMorph.
	self addMorphBack: draggedMorph.
	self updateCopyIcon.
	self changed; fullBounds! !

!TransferMorph methodsFor: 'accessing' stamp: 'sr 4/16/2000 18:52'!
dropNotifyRecipient
	^dropNotifyRecipient! !

!TransferMorph methodsFor: 'accessing' stamp: 'ar 12/22/2008 11:56'!
dragHand
	"The hand dragging this morph"
	^dragHand! !

!TransferMorph methodsFor: 'accessing' stamp: 'mir 5/5/2000 14:39'!
move
	copy := false! !

!TransferMorph methodsFor: 'initialization' stamp: 'CamilloBruni 10/21/2012 23:53'!
initialize
	"initialize the state of the receiver"
	super initialize.
	self layoutPolicy: TableLayout new.
	
	self listDirection: #leftToRight;
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap;
		layoutInset: 3;
		cellInset: 3;
		wrapCentering: #center;
		cellPositioning: #leftCenter.
		
	self borderStyle: (BorderStyle
		width: 1 color: Color lightGray).
		
	accepted := false.	
	copy := false.
	self on: #keyStroke send: #keyStroke: to: self! !

!TransferMorph methodsFor: 'accessing' stamp: 'sr 4/16/2000 18:52'!
passenger
	^passenger! !

!TransferMorph methodsFor: 'accessing' stamp: 'sr 4/16/2000 11:55'!
source
	^source! !

!TransferMorph methodsFor: 'dropping/grabbing' stamp: 'lr 10/29/2008 22:00'!
result: aResult from: aResultGenerator 
	"Send aResult of the drop operation computed by aResultGenerator to a   
	resultRecipient, if it exists."! !

!TransferMorph methodsFor: 'accessing' stamp: 'panda 4/25/2000 16:31'!
draggedMorph: aMorph
	draggedMorph := aMorph! !

!TransferMorph methodsFor: 'stepping and presenter' stamp: 'nk 6/16/2003 16:42'!
stepTime
	^100! !

!TransferMorph methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 5/16/2013 12:27'!
isTransferable

	^ true! !

!TransferMorph methodsFor: 'accessing' stamp: 'nk 6/16/2003 16:29'!
shouldCopy: aBoolean
	copy := aBoolean.! !

!TransferMorph methodsFor: 'drag and drop' stamp: 'panda 4/28/2000 16:11'!
dragTransferType
	^transferType! !

!TransferMorph methodsFor: 'accessing' stamp: 'CamilloBruni 10/21/2012 23:55'!
dropNotifyRecipient: anObject
	dropNotifyRecipient := anObject! !

!TransferMorph methodsFor: 'stepping and presenter' stamp: 'CamilloBruni 10/21/2012 23:50'!
step
	self shouldCopy = dragHand shiftPressed
		ifTrue: [ ^ self ].
	
	self shouldCopy: dragHand shiftPressed.
	self updateCopyIcon.! !

!TransferMorph methodsFor: 'accessing' stamp: 'sr 4/16/2000 18:53'!
passenger: anObject
	passenger := anObject! !

!TransferMorph methodsFor: 'submorphs-add/remove' stamp: 'CamilloBruni 10/21/2012 23:49'!
delete
	"See also >>justDroppedInto:event:."
	accepted ifFalse: [
		self dropNotifyRecipient ifNotNil: [ self dropNotifyRecipient dropRejectedMorph: self ]].
	self changed: #deleted.
	self breakDependents.
	super delete! !

!TransferMorph methodsFor: 'dropping/grabbing' stamp: 'CamilloBruni 10/22/2012 00:08'!
animationForMoveSuccess: success 
	| start stop slideForm |
	success
		ifTrue: [^ self]
		ifFalse: [
			start := self fullBounds origin.
			stop := self formerPosition ifNil: [ self source bounds origin ]].
	start = stop ifTrue: [^ self].
	
	slideForm := self imageForm offset: 0@0.
	slideForm
		slideWithFirstFrom: start
		to: stop
		nSteps: 12
		delay: 20! !

!TransferMorph methodsFor: 'dropping/grabbing' stamp: 'CamilloBruni 10/21/2012 16:42'!
aboutToBeGrabbedBy: aHand 
	"The receiver is being grabbed by a hand.                           
	Perform necessary adjustments (if any) and return the actual morph    
	     that should be added to the hand."
	"Since this morph has been initialized automatically with bounds origin   
	     0@0, we have to move it to aHand position."
	super aboutToBeGrabbedBy: aHand.
	self draggedMorph.
	"self align: self bottomLeft with: aHand position."
	self formerPosition: self position.
	aHand newKeyboardFocus: self.! !

!TransferMorph methodsFor: 'accessing' stamp: 'ar 12/22/2008 11:55'!
dragHand: aHandMorph
	"The hand dragging this morph"
	dragHand := aHandMorph! !

!TransferMorph methodsFor: 'accessing' stamp: 'panda 4/28/2000 16:11'!
dragTransferType: aSymbol
	transferType := aSymbol! !

!TransferMorph methodsFor: 'dropping/grabbing' stamp: 'CamilloBruni 10/21/2012 16:32'!
justDroppedInto: targetMorph event: anEvent 
	"If only world wants this TransferMorph, treat it as unaccepted (see also >>delete)."
	| formerPosition |
	formerPosition := self formerPosition.
	super justDroppedInto: targetMorph event: anEvent.
	self formerPosition: formerPosition.
	accepted := targetMorph ~= self world.
	self animationForMoveSuccess: accepted.
	accepted ifTrue: [
		self dropNotifyRecipient ifNotNil: [
			self dropNotifyRecipient dropAcceptedMorph: self from: targetMorph ]].
	self delete! !

!TransferMorph methodsFor: 'accessing' stamp: 'sr 4/16/2000 18:53'!
source: anObject
	source := anObject! !

!TransferMorph methodsFor: 'accessing' stamp: 'mir 5/5/2000 17:34'!
draggedMorph
	draggedMorph ifNil: [self initDraggedMorph].
	^draggedMorph! !

!TransferMorph methodsFor: 'accessing' stamp: 'mir 5/5/2000 14:39'!
shouldCopy
	^copy! !

!TransferMorph methodsFor: 'private' stamp: 'mir 5/14/2000 00:11'!
privateFullMoveBy: delta 
	super privateFullMoveBy: delta.
	self changed: #position! !

!TransferMorph methodsFor: 'dropping/grabbing' stamp: 'sr 4/16/2000 18:53'!
result: result 
	^ self result: result from: nil! !

!TransferMorph class methodsFor: 'initialization' stamp: 'mir 5/5/2000 14:48'!
initialize
	"TransferMorph initialize"

	self initIcons! !

!TransferMorph class methodsFor: 'instance creation' stamp: 'ThierryGoubier 10/24/2012 10:08'!
withPassenger: anObject from: source hand: dragHand
	| hand |
	
	hand := (dragHand ifNil:[ ActiveHand ]).
	
	^ self new
		passenger: anObject;
		source: source;
		"If the client hasn't provided a hand use the currently active hand"
		dragHand: hand;
		shouldCopy: hand shiftPressed;
		position: source positionInWorld;
		yourself! !

!TransferMorph class methodsFor: 'initialization' stamp: 'mir 5/5/2000 14:49'!
initIcons
	"TransferMorph initIcons"

	CopyPlusIcon := Form
		extent: 16@16
		depth: 8
		fromArray: #( 0 0 65535 0 0 0 16768220 4278190080 0 0 16768220 4278190080 0 255 4294958300 4294967040 0 65500 3705461980 3705462015 0 65500 3705461980 3705462015 0 255 4294958300 4294967295 0 0 16768220 4278190080 0 0 16768220 4278190080 0 0 65535 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
		offset: 0@0! !

!TransferMorph class methodsFor: 'instance creation' stamp: 'ar 12/22/2008 11:57'!
withPassenger: anObject from: source 
	^self withPassenger: anObject from: source hand: nil! !

!TransferMorph class methodsFor: 'instance creation' stamp: 'sr 4/13/2000 21:52'!
withPassenger: anObject 
	^ self withPassenger: anObject from: nil! !

!TransformMorph commentStamp: 'wiz 11/6/2005 15:59'!
A TransformMorph introduces a 2-D transformation between its (global) coordinates and the (local) coordinates of its submorphs, while also clipping all display to its bounds.  Specifically, with no offset, angle or scaling, a submorph with coordinates (0@0) will appear exactly at the topLeft of the windowMorph (its position).  Rotation and scaling are relative to the local origin, (0@0).

instance var	type				description
 transform		MorphicTransform	The coordinate transform between my coordinates and the
									local coordinates of my submorphs.
 smoothing		anInteger in 1..3	Perform smoothing of my contents during drawing
										1 No smoothing (#smoothingOff)
										2 Smoothing w/ edge adjacent pixels (#smoothingOn)
										3 Smoothing w/ edge and corner adj pixels
			
 localBounds	Rectangle or nil		caches the value of #localSubmorphBounds for performance

TransformMorphs operate with two different display strategies, depending on whether the transformation is a pure translation or not.  If so, then they simply use a clipping canvas and display their submorphs with the appropriate offset.  If the transformation includes scaling or rotation, then a caching canvas is used, whose active area covers the fullBounds of the submorphs intersected with the source quadrilateral corresponding to the window bounds.!
!TransformMorph methodsFor: '*Athens-Morphic' stamp: 'IgorStasenko 10/7/2012 23:18'!
clipDuring: aBlock canvas: aCanvas 

	self clipSubmorphs 
		ifTrue: [ 
			aCanvas
				clipBy: self clippingBounds 
				during: aBlock ] 
		ifFalse: [ ^ aBlock value ]
! !

!TransformMorph methodsFor: 'initialization' stamp: 'dgd 2/14/2003 22:31'!
defaultColor
	"answer the default color/fill style for the receiver"
	^ Color lightGreen! !

!TransformMorph methodsFor: '*FreeType-override' stamp: 'Nicolaihess 3/10/2015 12:33'!
drawSubmorphsOn: aCanvas

	aCanvas transformBy: transform
		clippingTo: self innerBounds
		during: [:myCanvas |
			(self angle ~= 0.0 or: [self scale ~= 1.0])
				ifTrue:[ 
					FreeTypeSettings current forceNonSubPixelDuring:[
						submorphs reverseDo:[:m | myCanvas fullDrawMorph: m] ] ]
				ifFalse:[
					submorphs reverseDo:[:m | myCanvas fullDrawMorph: m] ] ] 
		smoothing: smoothing! !

!TransformMorph methodsFor: 'accessing' stamp: ''!
offset
	^ transform offset + self innerBounds topLeft! !

!TransformMorph methodsFor: 'dropping/grabbing' stamp: 'ar 10/22/2000 18:00'!
grabTransform
	"Return the transform for the receiver which should be applied during grabbing"
	^owner ifNil:[self transform] ifNotNil:[owner grabTransform composedWithLocal: self transform]! !

!TransformMorph methodsFor: 'geometry' stamp: 'nk 4/12/2002 14:02'!
localVisibleSubmorphBounds
	"Answer, in my coordinate system, the bounds of all my visible submorphs (or nil if no visible submorphs)"
	| subBounds |
	subBounds := nil.
	self submorphsDo: [:m |
		(m visible) ifTrue: [
			subBounds
				ifNil: [subBounds := m fullBounds copy]
				ifNotNil: [subBounds := subBounds quickMerge: m fullBounds]]
			].
	^subBounds! !

!TransformMorph methodsFor: 'accessing' stamp: ''!
smoothing: cellSize
	smoothing := cellSize.
	self changed! !

!TransformMorph methodsFor: 'accessing' stamp: 'ar 5/19/1999 18:04'!
transform
	^transform! !

!TransformMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/22/2015 22:47'!
drawSubmorphsOnAthensCanvas: anAthensCanvas
	| clip |
	clip := self clippingBounds intersect: anAthensCanvas clipRect.
	anAthensCanvas
		transformBy: self transform
		withClip: clip
		in: self innerBounds
		during: [ :c | submorphs do: [ :m | m fullDrawOnAthensCanvas: c ] ]! !

!TransformMorph methodsFor: 'accessing' stamp: ''!
smoothingOn
	smoothing := 2.
	self changed! !

!TransformMorph methodsFor: 'geometry' stamp: 'BenjaminVanRyseghem 2/23/2013 00:59'!
numberOfItemsPotentiallyInViewWith: listSize 
	"This is a refactoring for numberOfItemsPotentiallyInView because in some cases the numberOfSubmorhps
	needs to be passed from the outside. "
	| height |
	height := self localSubmorphBounds height.
	height isZero ifTrue: [ ^ 0 ].
	^ self innerBounds height // (height / listSize)! !

!TransformMorph methodsFor: 'accessing' stamp: ''!
scale
	^ transform scale! !

!TransformMorph methodsFor: 'initialization' stamp: 'MarcusDenker 12/12/2009 00:01'!
initialize
	"initialize the state of the receiver"
	super initialize.
	
	smoothing := 1.
	transform := MorphicTransform identity! !

!TransformMorph methodsFor: 'geometry' stamp: 'nk 3/8/2004 11:05'!
numberOfItemsInView
	"Answer the number of my submorphs whose (transformed) bounds intersect mine.
	This includes items that are only partially visible.
	Ignore visibility of submorphs."

	^(submorphs select: [ :ea | self innerBounds intersects: (transform localBoundsToGlobal: ea bounds) ]) size! !

!TransformMorph methodsFor: 'geometry' stamp: 'efc 7/24/2003 16:43'!
layoutChanged

	"A submorph could have moved, thus changing my localBounds. Invalidate the cache."
	localBounds := nil.

	^super layoutChanged! !

!TransformMorph methodsFor: 'geometry' stamp: 'efc 7/24/2003 16:41'!
localSubmorphBounds
	"Answer, in my coordinate system, the bounds of all my submorphs (or nil if no submorphs). We will cache this value for performance. The value is invalidated upon recieving #layoutChanged."

	localBounds ifNil:[
		self submorphsDo:[:m |
			localBounds ifNil: [localBounds := m fullBounds]
						ifNotNil: [localBounds := localBounds quickMerge: m fullBounds]].
	].	

	^ localBounds! !

!TransformMorph methodsFor: 'accessing' stamp: 'ar 5/19/1999 18:04'!
transform: aTransform
	transform := aTransform.! !

!TransformMorph methodsFor: 'layout' stamp: 'MarcusDenker 10/3/2013 23:51'!
submorphBounds
	"Answer, in owner coordinates, the bounds of my visible submorphs, or my bounds"
	^ (self localVisibleSubmorphBounds ifNotNil: [ :box |transform localBoundsToGlobal: box ] ifNil: [ self bounds ]) truncated.
! !

!TransformMorph methodsFor: 'geometry testing' stamp: 'wiz 11/6/2005 15:53'!
containsPoint: aPoint
	(bounds containsPoint: aPoint) ifFalse: [^ false].
	self hasSubmorphs
		ifTrue: [ | localPoint |  localPoint := (transform globalPointToLocal: aPoint) .
				self submorphsDo: 
					[:m | (m containsPoint: localPoint)
							ifTrue: [^ true]].
				^ false]
		ifFalse: [^ true]! !

!TransformMorph methodsFor: 'accessing' stamp: 'gvc 11/17/2006 10:12'!
clipSubmorphs
	"Answer true since we do!!
	This avoids the senseless over-invalidation
	with lists etc."
	
	^true! !

!TransformMorph methodsFor: 'accessing' stamp: ''!
setOffset: newOffset angle: newAngle scale: newScale

	transform := MorphicTransform offset: newOffset angle: newAngle scale: newScale.
	self changed! !

!TransformMorph methodsFor: 'accessing' stamp: 'gvc 5/16/2007 11:35'!
extent: aPoint
	"Changed to not cause layoutChanged on the receiver."
	
	bounds extent = aPoint ifTrue: [^ self].
	self changed.
	bounds := (bounds topLeft extent: aPoint) rounded.
	super layoutChanged. "skip submorph bounds recalculation"
	self changed.
! !

!TransformMorph methodsFor: 'change reporting' stamp: 'IgorStasenko 12/22/2012 02:46'!
invalidRect: damageRect from: aMorph
	"Translate damage reports from submorphs by the scrollOffset."
	aMorph == self
		ifTrue:[super invalidRect: damageRect from: self]
		ifFalse:[super invalidRect: (((transform localBoundsToGlobal: damageRect) intersect: bounds ifNone: [ ^ self ] ) expandBy: 1) from: self].! !

!TransformMorph methodsFor: 'accessing' stamp: ''!
angle
	^ transform angle! !

!TransformMorph methodsFor: 'menu' stamp: 'StephaneDucasse 10/27/2014 09:34'!
addCustomMenuItems: aCustomMenu hand: aHandMorph
	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
	smoothing = 1
		ifTrue: [aCustomMenu add: 'turn on smoothing' selector: #smoothingOn]
		ifFalse: [aCustomMenu add: 'turn off smoothing' selector: #smoothingOff]! !

!TransformMorph methodsFor: 'geometry' stamp: 'GabrielOmarCotelli 6/8/2009 23:06'!
numberOfItemsPotentiallyInView

	"Answer the number of items that could potentially be viewed in full,
	computed as my visible height divided by the average height of my submorphs.
	Ignore visibility of submorphs."

	^ self numberOfItemsPotentiallyInViewWith: self submorphCount! !

!TransformMorph methodsFor: 'change reporting' stamp: 'StephaneDucasse 12/5/2009 21:09'!
areasRemainingToFill: aRectangle

	^Array with: aRectangle! !

!TransformMorph methodsFor: 'accessing' stamp: 'di 2/23/98 14:44'!
colorForInsets
	^ owner ifNil: [color] ifNotNil: [owner color]! !

!TransformMorph methodsFor: 'halos and balloon help' stamp: 'sw 12/29/1999 15:51'!
wantsHaloFromClick
	^ false! !

!TransformMorph methodsFor: 'accessing' stamp: ''!
offset: newOffset

	transform := transform withOffset: newOffset - self innerBounds topLeft.
	self changed! !

!TransformMorph methodsFor: 'accessing' stamp: ''!
smoothingOff
	smoothing := 1.
	self changed! !

!TransformMorph methodsFor: 'accessing' stamp: 'jm 4/17/1998 05:23'!
scale: newScale

	self changed.
	transform := transform withScale: newScale.
	self layoutChanged.
	self changed.
! !

!TransformMorph methodsFor: 'accessing' stamp: 'sps 11/29/2002 17:03'!
smoothing
	^smoothing
! !

!TransformMorph methodsFor: 'layout' stamp: 'di 11/20/2000 11:54'!
fullBounds
	"Overridden to clip submorph hit detection to my bounds."
	"It might be better to override doLayoutIn:, and remove this method"

	fullBounds ifNotNil:[^ fullBounds].
	fullBounds := bounds.
	submorphs do: [:m| m ownerChanged].
	^ fullBounds! !

!TransformMorph methodsFor: 'private' stamp: 'kfr 8/7/2004 18:48'!
privateFullMoveBy: delta
	"Private!! Relocate me, but not my subMorphs."

	self privateMoveBy: delta.
	transform :=  (transform asMorphicTransform) withOffset: (transform offset - delta).
! !

!TransformMorph methodsFor: 'event handling' stamp: 'dgd 2/21/2003 22:52'!
transformFrom: uberMorph 
	"Return a transform to map coorinates of uberMorph, a morph above me in my owner chain, into the coordinates of my submorphs."

	(self == uberMorph or: [owner isNil]) ifTrue: [^transform].
	^(owner transformFrom: uberMorph) composedWithLocal: transform! !

!TransformMorph methodsFor: 'accessing' stamp: 'ar 1/30/2001 23:20'!
angle: newAngle

	self changed.
	transform := transform withAngle: newAngle.
	self layoutChanged.
	self changed! !

!TransformWithLayoutMorph commentStamp: 'gvc 5/18/2007 10:18'!
A transform morph that allows the use of a layout policy to arrange submorphs.!
!TransformWithLayoutMorph methodsFor: 'layout' stamp: 'gvc 8/29/2006 14:56'!
fullBounds
	"Do the ordinary thing. See comment in superclass."

	^self perform: #fullBounds withArguments: #() inSuperclass: Morph! !

!TransformWithLayoutMorph methodsFor: 'layout' stamp: 'MarcusDenker 10/10/2013 23:44'!
doLayoutIn: layoutBounds 
	"Compute a new layout based on the given layout bounds."

	"Note: Testing for #bounds or #layoutBounds would be sufficient to
	figure out if we need an invalidation afterwards but #outerBounds
	is what we need for all leaf nodes so we use that."

	| box priorBounds |
	priorBounds := self outerBounds.
	submorphs isEmpty ifTrue: [^fullBounds := priorBounds].
	"Send #ownerChanged to our children"
	submorphs do: [:m | m ownerChanged].
	self layoutPolicy ifNotNil: [:layout | layout layout: self in: (0@0 extent: layoutBounds extent // self scale)].
	self adjustLayoutBounds.
	fullBounds := self privateFullBounds.
	box := self outerBounds.
	box = priorBounds 
		ifFalse: [self invalidRect: (priorBounds quickMerge: box)]! !

!TransformWithLayoutMorphForMultipleEditors commentStamp: '<historical>'!
A TransformWithLayoutMorphExpander is a layout which expand its submorph.

I am designed for having only one submorph !!

I am really specific to the multi source code widget!
!TransformWithLayoutMorphForMultipleEditors methodsFor: 'geometry' stamp: 'MarcusDenker 9/27/2013 18:07'!
updateSubMorph: newBounds
	| submorph |
	
	self submorphs ifEmpty: [ ^ self ].
	submorph := self submorphs first.
	submorph submorphs ifEmpty: [ ^ self ].
	
	submorph height < newBounds height 
		ifTrue: [ 
			" Growing "
			submorph height: newBounds height ].
	submorph submorphs last height > newBounds height 
		ifTrue: [ | height |
			" Shrinking "
			height := submorph submorphs allButLast inject: 0 into: [:sum :e | e height + sum ].
			height := height + ( newBounds height ).
			submorph height: height ]! !

!TransformWithLayoutMorphForMultipleEditors methodsFor: 'geometry' stamp: 'BenjaminVanRyseghem 8/5/2012 16:23'!
bounds: newBounds
	| oldExtent newExtent |
	oldExtent := self extent.
	newExtent := newBounds extent.
	(oldExtent dotProduct: oldExtent) <= (newExtent dotProduct: newExtent) ifTrue:[
		"We're growing. First move then resize."
		self position: newBounds topLeft; extent: newExtent.
		self updateSubMorph: newBounds.
	] ifFalse:[
		"We're shrinking. First resize then move."
		self extent: newExtent; position: newBounds topLeft.
	].! !

!TransformationMorph commentStamp: 'AlainPlantec 5/5/2010 09:19'!
A TransformationMorph is like a transformMorph, except that it does not clip, and its bounds include its entire submorph.  TransformationMorphs are assumed to have only one submorph -- the idea is that it is a wrapper that enables its submorph to scale and rotate.  A TransformationMorph may come to have more than one submorph if, eg, a menu sprouts a sub menu, using the transformationMorph temporarily as its world, but this ability is only sparsely supported (as in layoutChanged).

See TransformationMorph class example1 method.!
!TransformationMorph methodsFor: 'accessing' stamp: 'jm 4/25/1998 05:55'!
hasNoScaleOrRotation

	^ transform isPureTranslation
! !

!TransformationMorph methodsFor: 'classification' stamp: 'jm 5/7/1998 13:46'!
isRenderer

	^ true
! !

!TransformationMorph methodsFor: 't-rotating' stamp: ''!
forwardDirection: newDirection
	"Set the receiver's forward direction (in eToy terms)"
	self setProperty: #forwardDirection toValue: newDirection.! !

!TransformationMorph methodsFor: 'geometry' stamp: 'ar 10/25/2000 16:24'!
transformedBy: aTransform
	self changed.
	self transform: (self transform composedWithGlobal: aTransform).
	self computeBounds.
	self changed.! !

!TransformationMorph methodsFor: 'rotate scale and flex' stamp: 'AlainPlantec 5/7/2010 21:29'!
prepareForScaling
! !

!TransformationMorph methodsFor: 'dropping/grabbing' stamp: 'ar 10/22/2000 18:26'!
grabTransform
	"Return the transform for the receiver which should be applied during grabbing"
	self renderedMorph isWorldMorph 
		ifTrue:[^owner ifNil:[IdentityTransform new] ifNotNil:[owner grabTransform]].
	^owner ifNil:[self transform] ifNotNil:[owner grabTransform composedWithLocal: self transform]! !

!TransformationMorph methodsFor: 'private' stamp: 'MarcusDenker 9/13/2013 16:21'!
adjustAfter: changeBlock 
	"Cause this morph to remain cetered where it was before, and
	choose appropriate smoothing, after a change of scale or rotation."

	changeBlock value.
	self chooseSmoothing.
	self layoutChanged.
	owner ifNotNil: [owner invalidRect: bounds]
! !

!TransformationMorph methodsFor: 'classification' stamp: 'AlainPlantec 5/7/2010 22:02'!
renderedMorph
"We are a renderer. Answer appropriately."

	submorphs isEmpty ifTrue: [^self].
	^self firstSubmorph renderedMorph! !

!TransformationMorph methodsFor: 'testing' stamp: 'marcus.denker 9/17/2008 19:13'!
isSticky
	submorphs isEmpty ifFalse: [^ submorphs first isSticky].
	^false! !

!TransformationMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/7/2010 23:52'!
forwardDirection
	"Return the rendee's forward direction. 
	If I have no rendee then return 0.0 degrees "
	| rendee |
	^ ( rendee := self renderedMorph) == self  
		ifTrue: [0.0 ]
		ifFalse: [^ rendee forwardDirection]! !

!TransformationMorph methodsFor: 'layout' stamp: 'ar 10/25/2000 16:21'!
layoutChanged
	"Recompute bounds as a result of change"
	self computeBounds.
	super layoutChanged! !

!TransformationMorph methodsFor: 'menu' stamp: 'stephane.ducasse 11/8/2008 19:33'!
removeFlexShell
	"Remove the shell used to make a morph rotatable and scalable."

	| oldHalo unflexed myWorld refPos aPosition |
	refPos := self referencePosition.
	myWorld := self world.
	oldHalo := self halo.
	submorphs isEmpty ifTrue: [^ self delete].
	aPosition := (owner submorphIndexOf: self) ifNil: [1].
	unflexed := self firstSubmorph.
	self submorphs do: [:m |
		m position: self center - (m extent // 2).
		owner addMorph: m asElementNumber: aPosition].
	oldHalo ifNotNil: [oldHalo setTarget: unflexed].
	myWorld ifNotNil: [myWorld startSteppingSubmorphsOf: unflexed].
	self delete.
	unflexed referencePosition: refPos.
	^ unflexed! !

!TransformationMorph methodsFor: 'printing' stamp: 'dgd 2/21/2003 22:42'!
printOn: aStream 
	super printOn: aStream.
	submorphs isEmpty 
		ifTrue: [aStream nextPutAll: ' with no transformee!!']
		ifFalse: [aStream nextPutAll: ' on ' , submorphs first printString]! !

!TransformationMorph methodsFor: 'rotate scale and flex' stamp: 'AlainPlantec 5/7/2010 21:29'!
prepareForRotating
! !

!TransformationMorph methodsFor: 'geometry etoy' stamp: 'AlainPlantec 5/7/2010 23:56'!
setDirectionFrom: aPoint
	| delta degrees inner |
	inner := self renderedMorph.
	inner == self ifTrue:[^self].
	delta := (inner transformFromWorld globalPointToLocal: aPoint) - inner referencePosition.
	degrees := delta degrees + 90.0.
	self forwardDirection: (degrees \\ 360) rounded.
! !

!TransformationMorph methodsFor: 'testing' stamp: 'mdr 10/3/2000 11:28'!
stepTime
	"Answer the stepTime of my rendered morph if posible"

	| rendered |
	rendered := self renderedMorph.
	rendered = self ifTrue: [^super stepTime].	"Hack to avoid infinite recursion"
	^rendered stepTime.
	! !

!TransformationMorph methodsFor: 'accessing' stamp: 'AlainPlantec 5/8/2010 00:04'!
rotationDegrees: degrees
	self adjustAfter:[self angle: degrees degreesToRadians negated]! !

!TransformationMorph methodsFor: 'geometry etoy' stamp: 'sw 10/6/2004 11:33'!
visible: aBoolean
	"Set the receiver's visibility property"

	super visible: aBoolean.
	submorphs isEmptyOrNil ifFalse: [submorphs first visible: aBoolean]! !

!TransformationMorph methodsFor: 'private' stamp: 'aoy 2/17/2003 01:02'!
chooseSmoothing
	"Choose appropriate smoothing, after a change of scale or rotation."

	smoothing := (self scale < 1.0 or: [self angle ~= (self angle roundTo: Float pi / 2.0)]) 
		ifTrue: [ 2]
		ifFalse: [1]! !

!TransformationMorph methodsFor: 'classification' stamp: 'jm 4/17/1998 00:44'!
isFlexMorph

	^ true
! !

!TransformationMorph methodsFor: 'geometry' stamp: 'nice 1/5/2010 15:59'!
extent: newExtent
	
	self adjustAfter:
		[ | scaleFactor |scaleFactor := (self scale * newExtent r / self fullBounds extent r) max: 0.1.
		self scale: (scaleFactor detentBy: 0.1 atMultiplesOf: 1.0 snap: false)]! !

!TransformationMorph methodsFor: 'geometry etoy' stamp: 'AlainPlantec 5/7/2010 23:39'!
degreesOfFlex
	"Return any rotation due to flexing"
	^ self rotationDegrees! !

!TransformationMorph methodsFor: 'drawing' stamp: 'di 2/23/98 19:59'!
drawOn: aCanvas
	submorphs isEmpty ifTrue: [super drawOn: aCanvas]! !

!TransformationMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/10/2015 18:15'!
drawOnAthensCanvas: anAthensCanvas
	submorphs isEmpty ifTrue: [super drawOnAthensCanvas: anAthensCanvas]! !

!TransformationMorph methodsFor: 'accessing' stamp: 'PavelKrivanek 7/24/2014 10:58'!
embeddedWindowOrNil

	"answer nil for common morphs, yourself from system windows and first submorph for transformation morphs"
	
	| s | 
	
	(self submorphs size = 1) ifTrue: [ 
		s := self firstSubmorph.
		s isSystemWindow ifTrue: [ ^ s ] ].
	^ nil.! !

!TransformationMorph methodsFor: 'geometry etoy' stamp: 'AlainPlantec 5/7/2010 23:35'!
heading
	"End recusion when necessary."
	| rendee |
	^ (rendee := self renderedMorph) == self 
		ifTrue: [ 0.0 ]
		ifFalse: [rendee heading]! !

!TransformationMorph methodsFor: 'accessing' stamp: 'sw 2/15/2002 02:27'!
scaleFactor
	"Answer the scaleFactor"

	^ transform scale! !

!TransformationMorph methodsFor: 'initialization' stamp: 'di 2/21/98 14:35'!
asFlexOf: aMorph
	"Initialize me with position and bounds of aMorph,
	and with an offset that provides centered rotation."
	| pos |
	pos := aMorph position.
	self addMorph: aMorph.
	aMorph position: (aMorph extent // 2) negated.
	self position: pos.
	transform := transform withOffset: aMorph position - pos
! !

!TransformationMorph methodsFor: 'geometry etoy' stamp: 'sw 3/28/2001 14:24'!
referencePosition
	"Answer the  receiver's reference position, bullet-proofed against infinite recursion in the unlikely but occasionally-seen case that I am my own renderee"

	| rendered |
	^ (rendered := self renderedMorph) == self
		ifTrue:
			[super referencePosition]
		ifFalse:
			[transform localPointToGlobal: rendered referencePosition]! !

!TransformationMorph methodsFor: 'nil' stamp: 'ar 9/23/2000 13:40'!
scaleToMatch: aPoint
	| scaleFactor tfm originalScale |
	tfm := transform withScale: 1.0.
	originalScale := ((tfm localBoundsToGlobal: self renderedMorph fullBounds) corner -
		(tfm localPointToGlobal: self renderedMorph referencePosition)) r.
	"Catch cases where the reference point is on fullBounds corner"
	originalScale < 1.0 ifTrue:[originalScale := 1.0].
	scaleFactor := (aPoint - self referencePosition) r / originalScale.
	scaleFactor := scaleFactor < 1.0
		ifTrue: [scaleFactor detentBy: 0.05 atMultiplesOf: 0.25 snap: false]
		ifFalse: [scaleFactor detentBy: 0.1 atMultiplesOf: 0.5 snap: false].
	self adjustAfter:[self scale: ((scaleFactor min: 8.0) max: 0.1)].! !

!TransformationMorph methodsFor: 'geometry' stamp: 'ar 11/21/2000 17:00'!
computeBounds
	self hasSubmorphs ifTrue:
		[bounds := (transform localBoundsToGlobal:
					(Rectangle merging:
						(self submorphs collect: [:m | m fullBounds]))) truncated
				expandBy: 1].
	fullBounds := bounds.! !

!TransformationMorph methodsFor: 'rotate scale and flex' stamp: 'AlainPlantec 5/7/2010 23:00'!
rotationDegrees
	^ self angle radiansToDegrees negated! !

!TransformationMorph methodsFor: 'submorphs-add/remove' stamp: 'di 11/18/1999 15:44'!
replaceSubmorph: oldMorph by: newMorph
	| t b |
	t := transform.
	b := bounds.
	super replaceSubmorph: oldMorph by: newMorph.
	transform := t.
	bounds := b.
	self layoutChanged! !

!TransformationMorph class methodsFor: 'example' stamp: 'mk 8/14/2005 16:07'!
example1
	| stringMorph transformationMorph |
	stringMorph := 'vertical text' asMorph.
	transformationMorph := TransformationMorph new asFlexOf: stringMorph.
	transformationMorph angle: Float pi / 2.
	transformationMorph position: 5@5.
	transformationMorph openInWorld.! !

!TreeColumnModel commentStamp: '<historical>'!
I represent a tree column. I am used to specify how to render nodes, as well as the header title, icon , action on click and properties (resizable, initial width)!
!TreeColumnModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/2/2013 17:57'!
container

	^ container value! !

!TreeColumnModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/2/2013 16:59'!
headerLabel

	^ headerLabel value! !

!TreeColumnModel methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 11/2/2013 17:44'!
registerEvents

	displayBlock whenChangedDo: [ self changed: #displayBlockChanged ].
	resizable whenChangedDo: [ self changed: #resizableChanged ].
	headerLabel whenChangedDo: [ self changed: #headerLabelChanged ].
	headerFont whenChangedDo: [ self changed: #headerFontChanged ].
	headerIcon whenChangedDo: [ self changed: #headerIconChanged ]! !

!TreeColumnModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/2/2013 16:36'!
displayBlock: aBlock

	displayBlock value: aBlock! !

!TreeColumnModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/2/2013 17:58'!
container: aTreeModel

	container value: aTreeModel! !

!TreeColumnModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/2/2013 16:59'!
headerLabel: aString

	headerLabel value: aString! !

!TreeColumnModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/2/2013 17:00'!
resizable

	^ resizable value! !

!TreeColumnModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/2/2013 17:00'!
resizable: aBoolean

	resizable value: aBoolean! !

!TreeColumnModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/2/2013 17:00'!
headerAction: aBlock

	headerAction value: aBlock! !

!TreeColumnModel methodsFor: 'initialization' stamp: 'DucasseStephane 9/10/2014 09:59'!
initialize

	super initialize.

	container := nil asValueHolder.
	displayBlock := [ :node | node printString ] asValueHolder.
	initialWidth := 100 asValueHolder.
	resizable := true asValueHolder.
	headerLabel := nil asValueHolder.
	headerFont := StandardFonts defaultFont asValueHolder.
	headerIcon := nil asValueHolder.
	headerAction := nil asValueHolder.
	
	self registerEvents! !

!TreeColumnModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/2/2013 16:59'!
headerFont: aFont

	headerFont value: aFont! !

!TreeColumnModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/2/2013 16:59'!
headerIcon

	^ headerIcon value! !

!TreeColumnModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/2/2013 16:59'!
headerFont

	^ headerFont value! !

!TreeColumnModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/2/2013 17:00'!
headerAction

	^ headerAction value! !

!TreeColumnModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/2/2013 16:59'!
initialWidth: anInteger

	initialWidth value: anInteger! !

!TreeColumnModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/2/2013 16:36'!
displayBlock

	^ displayBlock value! !

!TreeColumnModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/2/2013 16:58'!
initialWidth

	^ initialWidth value! !

!TreeColumnModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/2/2013 16:59'!
headerIcon: anIcon

	headerIcon value: anIcon! !

!TreeColumnModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 11/2/2013 20:09'!
defaultSpec
	<spec: #default>
	
	^ #(TreeColumnAdapter
		adapt: #(model))! !

!TreeColumnModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/13/2014 15:27'!
adapterName

	^ #TreeColumnAdapter! !

!TreeListMorph commentStamp: 'StephaneDucasse 6/23/2014 16:48'!
A SimpleHierarchicalListMorph subclass supporting alternative fonts for all items.

This class is badly named and should be merged with its superclass - Stephane Ducasse!
!TreeListMorph methodsFor: 'accessing' stamp: 'gvc 2/22/2010 17:51'!
keystrokeActionSelector
	"Answer the selector of the message to send to the model when a keystroke occurs."

	^keystrokeActionSelector! !

!TreeListMorph methodsFor: 'accessing' stamp: 'gvc 2/22/2010 17:52'!
keystrokeActionSelector: aSymbol
	"Set the selector of the message to send to the model when a keystroke occurs.
	One or two arguments... 1 for character, 2 for character and sender (self)."

	keystrokeActionSelector := aSymbol! !

!TreeListMorph methodsFor: 'private' stamp: 'gvc 1/29/2009 16:34'!
layoutBounds: aRectangle
	"Set the bounds for laying out children of the receiver.
	Update the scroller and scrollbars now since bounds set directly
	(not via #extent:)."
	
	super layoutBounds: aRectangle.
	self
		resizeScroller;
		setScrollDeltas! !

!TreeListMorph methodsFor: 'private' stamp: 'NicolaiHess 12/7/2014 11:52'!
addSubmorphsAfter: parentMorph fromCollection: aCollection allowSorting: sortBoolean
	"Update the font on each morph."
	
	|answer|
	answer := super addSubmorphsAfter: parentMorph fromCollection: aCollection allowSorting: sortBoolean.
	"I commented out the following lines, because it makes this morph incredible slow.
	This is used to browse diffs from monticello which can be really big.
	I couldn't find any place where this Morph is used and needs the following lines.
	nicolai."
	self flag:#issue12027.
	"self scroller submorphsDo: [:i |
		i
			font: self font;
			extent: i minWidth @ i minHeight]."
	^answer! !

!TreeListMorph methodsFor: 'accessing' stamp: 'gvc 9/8/2006 14:01'!
font
	"Answer the value of font"

	^font ifNil: [TextStyle defaultFont]! !

!TreeListMorph methodsFor: 'private' stamp: 'gvc 5/15/2007 16:16'!
insertNewMorphs: morphList
	"Update the font on each morph."
	
	morphList do: [:m |
		m
			font: self font;
			extent: m minWidth @ m minHeight].
	^super insertNewMorphs: morphList! !

!TreeListMorph methodsFor: 'accessing' stamp: 'gvc 9/8/2006 14:00'!
font: anObject
	"Set the value of font"

	font := anObject! !

!TreeModel commentStamp: '<historical>'!
I am the Spec model of a MorphTreeMorph tree.!
!TreeModel methodsFor: 'focus' stamp: 'DamienCassou 6/6/2013 16:48'!
eventKeyStrokesForPreviousFocus
	"String describing the keystroke to perform to jump to the previous widget"
	
	^ { Character tab shift asKeyCombination }! !

!TreeModel methodsFor: 'api-filtering' stamp: 'BenjaminVanRyseghem 11/21/2013 11:50'!
filterWith: aFilter
	
	self selection: nil.
	self updateTree.

	self expandAll.
	self changed: #filterWith: with: {aFilter}.
	
	self expandAll.! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
oddRowColor

	^ oddRowColor value! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 5/21/2013 15:35'!
resetSelection

	self selectedItems: {}! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
allowMenuOnNoItem

	^ allowMenuOnNoItem value! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
keyStroke: aKeyStroke

	keyStroke value cull: aKeyStroke! !

!TreeModel methodsFor: 'initialization' stamp: 'BernardoContreras 9/27/2014 09:32'!
registerEvents
	
	rootsHolder whenChangedDo: [ self updateTree ].
	childrenBlockHolder whenChangedDo: [ self updateTree ].
	hasChildrenBlockHolder whenChangedDo: [ self updateTree ].
	displayBlock whenChangedDo: [ self updateTree ].
	
	iconBlock whenChangedDo: [ self updateTree ].
	autoDeselection whenChangedDo: [ :boolean | self update: {#autoDeselection:. boolean} ].
	columns whenChangedDo: [ :col | 
		col do: [ :each | each container: self ].
		self changed: #columns: with: { col } ].
	selectionHolder whenChangedDo: [:items | self changed: { #selectItems. items } ].
	rootNodeHolder whenChangedDo: [ :aBlock | self updateTree ].
	isCheckList whenChangedDo: [ :boolean | self changed: #isCheckList: with: { boolean }].
	
	menuBlockHolder  whenChangedDo: [ :aMenuModel :oldMenuModel |
		oldMenuModel ifNotNil: [ | oldMenu |
			oldMenuModel isBlock
				ifTrue: [ 
					oldMenu := MenuModel new.
					oldMenuModel cull: oldMenu cull: false ]
				ifFalse: [ oldMenu := oldMenuModel ].
		oldMenu applyTo: self ].
		
		aMenuModel ifNotNil: [ | newMenu |
			aMenuModel isBlock
				ifTrue: [ 
					newMenu := MenuModel new.
					aMenuModel cull: newMenu cull: false ]
				ifFalse: [ newMenu := aMenuModel ].
		newMenu applyTo: self ] ].

	self announcer weak
		when: WidgetBuilt
		send: #onWidgetBuilt
		to: self.! !

!TreeModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:19'!
highlightedItem: anItem
	"< api: #st getter: #highlightedItem registration: #whenHighlightedItemChanged:>"
	"Set the highlightedItem item"
	"In the case of keyboard navigation with checklist, it may differ from the last selected item"
	
	highlightedItem value: anItem! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
preferedPaneColor

	^ preferedPaneColor value! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/21/2013 22:51'!
removeOnlyLastSelected: aBoolean

	removeOnlyLastSelected value: aBoolean! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
columns: aCollection
	
	columns value: aCollection! !

!TreeModel methodsFor: 'api-compatibility' stamp: 'StephaneDucasse 2/26/2015 17:22'!
childrenBlock: aBlock
	"< api: #block getter: #childrenBlock registration: #whenChildrenBlockChanged:>"
	"Set the block used to retrieve the children of a node.
	The optional block arguments are:
		- the node
		- the tree"

	childrenBlockHolder value: aBlock! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
preferedPaneColor: aColor

	preferedPaneColor value: aColor! !

!TreeModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:20'!
selectedItem: anItem
	"< api: #st getter: #selectedItem registration: #whenSelectedItemsChanged:>"
	"Set the selected item"
	"In the case of a multiple selection list, it returns the last selected item"
	
	self selectedItems: { anItem }! !

!TreeModel methodsFor: 'api-compatibility' stamp: 'StephaneDucasse 2/26/2015 17:21'!
hasChildrenBlock: aBlock
	"< api: #block getter: #hasChildrenBlock registration: #whenHasChildrenBlockChanged:>"
	"Set the block used to  check if a node has children.
	The optional block arguments are:
		- the node
		- the tree"

	hasChildrenBlockHolder value: aBlock! !

!TreeModel methodsFor: 'initialization' stamp: 'DucasseStephane 9/10/2014 09:59'!
initialize
	super initialize.

	childrenBlockHolder := [ {} ] asValueHolder.
	hasChildrenBlockHolder := [ :item | (self childrenFor: item) notEmpty ] asValueHolder.
	rootsHolder := {} asValueHolder.
	selectionHolder := {} asValueHolder.
	menuBlockHolder := [] asValueHolder.
	displayBlock := [:item | item asString ] asValueHolder.
	
	removeOnlyLastSelected := false asValueHolder.
	autoDeselection := true asValueHolder.
	autoMultiSelection := false asValueHolder.
	columnInset := 5 asValueHolder.
	doubleClick := [] asValueHolder.
	allowMenuOnNoItem := false asValueHolder.
	isCheckList := false asValueHolder.
	keyStroke := [ :key | ] asValueHolder.
	multiSelection := false asValueHolder.
	evenRowColor := Smalltalk ui theme backgroundColor asValueHolder.
	oddRowColor := Smalltalk ui theme backgroundColor asValueHolder.
	preferedPaneColor := Smalltalk ui theme backgroundColor asValueHolder.
	resizerWidth := 2 asValueHolder.
	rowInset := 2 asValueHolder.
	iconBlock := [ :each : node | node icon ] asValueHolder.
	highlightedItem := nil asValueHolder.
	rootNodeHolder := [ :item |
		TreeNodeModel new 
			content: item;
			children: [ self childrenFor: item ] ] asValueHolder.
	
	columns := { TreeColumnModel new
		displayBlock: [:node | (self wrapItem: node content) ] } asValueHolder.
	
	"Since my nodes are already morphs, dragging them will actually extract them from their owner"
	dragTransformationBlock := [ :item :source | item complexContents ] asValueHolder.

	treeUpdated := nil asValueHolder.

	self registerEvents! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 9/28/2013 23:05'!
expandRoots

	self changed: #expandRoots with: #()! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
autoMultiSelection: aBoolean

	autoMultiSelection value: aBoolean! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
iconBlock: aBlock

	iconBlock value: aBlock! !

!TreeModel methodsFor: 'api-events' stamp: 'BenjaminVanRyseghem 4/18/2013 17:42'!
whenRootsChanged: aBlock

	rootsHolder whenChangedDo: aBlock! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
autoDeselection

	^ autoDeselection value! !

!TreeModel methodsFor: 'api-events' stamp: 'BenjaminVanRyseghem 4/20/2013 02:58'!
whenTreeUpdated: aBlock

	treeUpdated whenChangedDo: aBlock! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
doubleClick

	doubleClick value value! !

!TreeModel methodsFor: 'api-events-compatibility' stamp: 'CD 11/29/2013 15:40'!
whenSelectedItemChanged: aBlock
	"Set a block to perform when a new item is selected"

	selectionHolder whenChangedDo: [ :col | 
		col 
			ifNil: [ aBlock value: nil ]
			ifNotNil: [ col isEmpty
					ifTrue: [ aBlock value: nil ]
					ifFalse: [ aBlock value: (col last lastClicked
						ifTrue: [ col last content ]
						ifFalse: [ nil ]) ] ] ]! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
rowInset: anInteger

	rowInset value: anInteger! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
columnInset

	^ columnInset value! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
resizerWidth

	^ resizerWidth value! !

!TreeModel methodsFor: 'api-events-compatibility' stamp: 'BenjaminVanRyseghem 4/17/2013 21:23'!
whenChildrenBlockChanged: aBlock
	"Set a block to perform when a new childrenBlock is set"

	childrenBlockHolder whenChangedDo: aBlock! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
isCheckList: aBoolean

	isCheckList value: aBoolean! !

!TreeModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:12'!
hasSelectedItem
	"< api: #inspect>"
	"Return true if the tree contains any selected items"
	
	^ selectionHolder value isNotEmpty! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
columnInset: anInteger

	columnInset value: anInteger! !

!TreeModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:55'!
roots: aCollection
	"< api: #st getter: #roots registration: #whenRootsChanged:>"
	"Set the tree roots"

	rootsHolder value: aCollection.
	self changed: #setRoots: with: { aCollection }! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
rowInset

	^ rowInset value! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
resizerWidth: anInteger

	resizerWidth value: anInteger! !

!TreeModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:18'!
selectedItems
	"< api: #inspect>"
	"Return the selected items"
	
	^ selectionHolder value! !

!TreeModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:01'!
highlightedItem
	"<api: #inspect>"
	"Return the currently highlighted item"

	^ highlightedItem value! !

!TreeModel methodsFor: 'api-events' stamp: 'BenjaminVanRyseghem 11/22/2013 10:51'!
whenHighlightedItemChanged: aBlock

	highlightedItem whenChangedDo: aBlock! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
columns
	
	^ columns value! !

!TreeModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 16:49'!
selectedItems: aCollection
	"<api: #st getter: #selectedItems registration: #whenSelectedItemsChanged:>"
	"Set the selected item"
	"In the case of a multiple selection list, it returns the last selected item"

	"treeModel selectNodePath: aCollection."
	selectionHolder value: aCollection.
	! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 5/11/2013 23:11'!
beCheckList

	self isCheckList: true! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 3/4/2014 17:18:07'!
hasChildrenFor: anItem

	^ self hasChildrenBlock cull: anItem cull: self! !

!TreeModel methodsFor: 'api-events-compatibility' stamp: 'BenjaminVanRyseghem 4/17/2013 21:24'!
whenDisplayBlockChanged: aBlock
	"Set a block to perform when a new displayBlock is set"

	displayBlock whenChangedDo: aBlock! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/30/2013 20:39'!
iconFor: aNode

	^ iconBlock value cull: aNode content cull: aNode! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/24/2013 14:59'!
selectAll
	
	self changed: #selectAdd with: #()! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
multiSelection: aBoolean

	multiSelection value: aBoolean! !

!TreeModel methodsFor: 'api-compatibility' stamp: 'StephaneDucasse 2/26/2015 17:16'!
childrenBlock
	"< api: #inspect>"
	"Return the block used to retrieve the children of a node.
	The optional block arguments are:
		- the node
		- the tree"

	^ childrenBlockHolder value! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
wrapItem: anItem

	^ displayBlock value cull: anItem cull: self! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 9/28/2013 23:05'!
expandAll

	self changed: #expandAll with: #()! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
oddRowColor: aColor

	oddRowColor value: aColor! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/23/2013 21:57'!
collapseAll
	
	self changed: #collapseAll with: #()! !

!TreeModel methodsFor: 'api-events' stamp: 'BenjaminVanRyseghem 4/17/2013 21:23'!
whenMenuChanged: aBlock
	"Set a block to perform when a new menuBlock is set"

	menuBlockHolder whenChangedDo: aBlock! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/2/2013 18:37'!
rootNodeHolder

	^ rootNodeHolder value! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
autoDeselection: aBoolean

	autoDeselection value: aBoolean! !

!TreeModel methodsFor: 'api-compatibility' stamp: 'StephaneDucasse 2/26/2015 17:04'!
hasChildrenBlock
	"<api: #inspect>"
	"Get the block used to check if a node has children.
	The optional block arguments are:
		- the node
		- the tree"

	^ hasChildrenBlockHolder value! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
keyStrokeAction: aBlock

	keyStroke value: aBlock! !

!TreeModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:16'!
updateTree
	"< api: #do>"
	"Force the tree to refresh"

	self changed: #updateTree with: {}.
	treeUpdated value: nil.! !

!TreeModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:19'!
menu: aBlock
"	< api: #block getter: #menu registration: #whenMenuChanged:>"
	"Set the block used to generate the tree menu"

	menuBlockHolder value: aBlock! !

!TreeModel methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
onWidgetBuilt
	^ self selectedItems: selectionHolder value! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
evenRowColor

	^ evenRowColor value! !

!TreeModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:18'!
selectedItem
	"< api: #inspect>"
	"Return the selected item"
	"In the case of a multiple selection list, it returns the last selected item"
	
	^ selectionHolder value
		ifEmpty: [ nil ]
		ifNotEmpty: [ :col | col  last ]! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/2/2013 19:21'!
selection: aSelection
 
	self changed: #selection: with: { aSelection }! !

!TreeModel methodsFor: 'focus' stamp: 'DamienCassou 6/6/2013 16:48'!
eventKeyStrokesForNextFocus
	"String describing the keystroke to perform to jump to the next widget"	
		
	^ { Character tab asKeyCombination }! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 6/18/2013 16:20'!
secondSelection: anItem
	
	self widget ifNotNil: [ :w | w listManager secondSelection: anItem ]! !

!TreeModel methodsFor: 'api' stamp: 'PabloHerrero 11/29/2013 14:19'!
menu: aMenu shifted: aBoolean
	| menu |
	
	(self allowMenuOnNoItem not and: [ self selectedItems isEmpty ])
		ifTrue: [ ^ nil ].
		
	
	menuBlockHolder value ifNil: [ ^ nil ].
	menuBlockHolder value isBlock ifFalse: [ ^ menuBlockHolder value ].
	
	menu := MenuModel new.
	
	menuBlockHolder value cull: menu cull: aBoolean.
	
	^ menu! !

!TreeModel methodsFor: 'api' stamp: 'YuriyTymchuk 10/7/2014 17:03'!
deselectAll
	
	self changed: #deselectAll with: #()! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
allowMenuOnNoItem: aBoolean

	allowMenuOnNoItem value: aBoolean! !

!TreeModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:01'!
menu
	"<api: #inspect>"
	"Return the block used to generate the tree menu"

	^ menuBlockHolder value! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
evenRowColor: aColor

	evenRowColor value: aColor! !

!TreeModel methodsFor: 'api-compatibility' stamp: 'StephaneDucasse 2/26/2015 16:49'!
displayBlock: aBlock
	"<api: #block getter: #displayBlock registration: #whenDisplayBlockChanged:>"
	"Set the block used to generate the display of the items.
	The optioanl block arguments are:
		- the item
		- the tree"

	displayBlock value: aBlock! !

!TreeModel methodsFor: 'api' stamp: 'StephaneDucasse 2/26/2015 17:12'!
roots
	"< api: #inspect>"
	"Return the tree roots"

	^ rootsHolder value! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 3/4/2014 17:18:07'!
childrenFor: anItem

	^ self childrenBlock cull: anItem cull: self! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
autoMultiSelection

	^ autoMultiSelection value! !

!TreeModel methodsFor: '*Versionner-Spec-Browser' stamp: 'ChristopheDemarey 2/28/2014 15:35'!
whenSelectedNodesChanged: aBlock
	"Set a block to perform when a new node is selected"

	selectionHolder whenChangedDo: [ :col | aBlock cull: col ]! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/21/2013 10:31'!
rootNodeFor: item
	| node |
	
	node := self rootNodeHolder cull: item.
	node container: self.
	
	^ node! !

!TreeModel methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 11/22/2013 12:42'!
selectionChanged: ann

	^ selectionHolder value: (ann selection
		ifNil: [ #() ]
		ifNotNil: [:selection | selection selectedNodes ])! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
isCheckList

	^ isCheckList value! !

!TreeModel methodsFor: 'api-events-compatibility' stamp: 'BenjaminVanRyseghem 3/4/2014 17:18:07'!
whenHasChildrenBlockChanged: aBlock
	"Set a block to perform when a new hasChildrenBlock is set"

	hasChildrenBlockHolder whenChangedDo: aBlock! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/26/2013 18:16'!
selectOnlyLastHighlighted

	^ removeOnlyLastSelected value! !

!TreeModel methodsFor: 'api-compatibility' stamp: 'StephaneDucasse 2/26/2015 17:13'!
displayBlock
	"< api: #inspect>"
	"Return the block used to generate the display of the items.
	The optioanl block arguments are:
		- the item
		- the tree"

	^ displayBlock value! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/22/2013 11:41'!
selectionChanged
	
	self changed: #selectionChanged with: #()! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
multiSelection

	^ multiSelection value! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
doubleClick: aBlock

	doubleClick value: aBlock! !

!TreeModel methodsFor: 'api-events' stamp: 'BenjaminVanRyseghem 11/24/2013 00:45'!
whenSelectedItemsChanged: aBlock
	"Set a block to perform when a new item is selected"

	selectionHolder whenChangedDo: [ :col | aBlock cull: (col collect: [:e | e content ]) ]! !

!TreeModel methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 3/4/2014 17:18:07'!
defaultNodeFor: item

	^ TreeNodeModel new
		content: item;
		children: [ self childrenFor: item ];
		hasChildren: [ self hasChildrenFor: item ];
		yourself! !

!TreeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/8/2013 12:00'!
rootNodeHolder: aBlock

	rootNodeHolder value: aBlock! !

!TreeModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/1/2013 13:39'!
defaultSpec
	<spec: #default>
	
	^ #(TreeAdapter
		adapt: #(model))! !

!TreeModel class methodsFor: 'examples' stamp: 'BenjaminVanRyseghem 11/12/2013 22:26'!
exampleWithNoSpecifiedNodes
	"self exampleWithNoSpecifiedNodes"

	TreeModel new
		 roots: (1 to: 5);
		 childrenBlock: [ :item | 1+item to: 5+item ];
		 openWithSpec! !

!TreeModel class methodsFor: 'examples' stamp: 'BenjaminVanRyseghem 11/2/2013 19:38'!
exampleWithCustomColumnsAndNodes
	"self exampleWithCustomColumnsAndNodes"
	| m col1 col2 |

	m := TreeModel new.
	m roots: #(#a #b #c #d).
	m rootNodeHolder: [ :item | 
		TreeNodeModel new
			content: item;
			icon: Smalltalk ui icons smallConfigurationIcon
	].
	
	m openWithSpec.
	
	col1 := TreeColumnModel new
		displayBlock: [ :node | node content asString ];
		headerLabel: 'Character'.
	col2 := TreeColumnModel new
		displayBlock: [ :node | (Character value: node content asString first asciiValue + 1) asString ];
		headerLabel: 'Character +1';
		headerIcon: Smalltalk ui icons smallBackIcon.
	
	m
		columns: {col1. col2};
		dragEnabled: true;
		dropEnabled: true;
		acceptDropBlock: [ :transfer :event :source :receiver | self halt ].
		
	col2 
		headerLabel: 'Character +2';
		headerIcon: Smalltalk ui icons smallBackIcon;
		displayBlock: [ :node | (Character value: node content asString first asciiValue + 2) asString ].
	
	m rootNodeHolder: [ :item | 
		TreeNodeModel new
			content: (Character value: (item asString first asciiValue + 5)) asSymbol;
			icon: Smalltalk ui icons smallFullscreenIcon
	].

	col1 headerIcon: Smalltalk ui icons nautilusIcon.! !

!TreeModel class methodsFor: 'examples' stamp: 'BenjaminVanRyseghem 9/28/2013 23:51'!
example
	| m |

	m := self new.
	m openWithSpec.
	
	m roots: #(a b c d).
	m childrenBlock: [:it | it = #c 
		ifTrue: [ {1. 2. 3} ]
		ifFalse: [ {} ]].
	m displayBlock: [:item | item isSymbol
		ifTrue: [ item asUppercase , ' symbol' ]
		ifFalse: [ item printString ]].
	m 
		dragEnabled: true;
		dropEnabled: true;
		acceptDropBlock: [ :transfer :event :source :receiver |  self halt ].
		
	^ m! !

!TreeModel class methodsFor: 'examples' stamp: 'BenjaminVanRyseghem 11/12/2013 22:35'!
exampleWithCustomColumnsAndNodesAndChildren
	"self exampleWithCustomColumnsAndNodesAndChildren"
	| m col1 col2 |

	m := TreeModel new.
	m roots: #(#a #b #c #d).
	m rootNodeHolder: [ :item | 
		TreeNodeModel new
			content: item;
			children: [ (1 to: item asString first asciiValue) collect: [:e | 
				TreeNodeModel new content: e ] ];
			icon: Smalltalk ui icons smallConfigurationIcon
	].
	
	m openWithSpec.
	
	col1 := TreeColumnModel new
		displayBlock: [ :node | node content asString ];
		headerAction: [ self halt ].
	col2 := TreeColumnModel new
		displayBlock: [ :node | (Character value: node content asString first asciiValue + 1) asString ].
	
	m
		columns: {col1. col2};
		dragEnabled: true;
		dropEnabled: true;
		acceptDropBlock: [ :transfer :event :source :receiver | self halt ].
		
	col2 displayBlock: [ :node | (Character value: node content asString first asciiValue + 2) asString ].! !

!TreeModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/13/2014 15:36'!
adapterName! !

!TreeNodeModel commentStamp: '<historical>'!
I represent a node in a tree widget.
I hold an item, an icon and the list of my children.

In addition, I have a filtering mechanism!
!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/22/2013 15:42'!
hasContentToShow

	^ hasContentToShow value! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/2/2013 18:38'!
container

	^ container value! !

!TreeNodeModel methodsFor: 'api' stamp: 'ChristopheDemarey 11/20/2013 14:37'!
childNodeClass: aBlock

	childNodeClass value: aBlock! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/2/2013 19:19'!
matchTokenFilterBlock

	^ matchTokenFilter value! !

!TreeNodeModel methodsFor: 'filtering' stamp: 'BenjaminVanRyseghem 11/21/2013 12:21'!
updateAccordingTo: aFilter

	(aFilter keepTreeNode: self) 
		ifFalse: [
			self changed: #updateAccordingTo: with: { aFilter } ]! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/2/2013 18:33'!
children

	^ children value! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/24/2013 13:37'!
isExpanded: aBoolean

	isExpanded value: aBoolean! !

!TreeNodeModel methodsFor: 'initialization' stamp: 'DucasseStephane 9/10/2014 09:59'!
initialize

	super initialize.

	children := [ self container childrenFor: self content ] asValueHolder.
	hasChildren := [ self container hasChildrenFor: self content ] asValueHolder.
	content := nil asValueHolder.
	icon := nil asValueHolder.
	container := nil asValueHolder.
	matchTokenFilter := [ :aFilter | false ] asValueHolder.
	parentNode := nil asValueHolder.
	childNodeClass := self class asValueHolder.
	selected := false asValueHolder.
	lastClicked := false asValueHolder.
	mouseDownAction := [:event | ] asValueHolder.
	hasContentToShow := false asValueHolder.
	isExpanded := false asValueHolder.
	
	selected whenChangedDo: [ :aBoolean | self changed: #selected: with: { aBoolean } ].
	isExpanded whenChangedDo: [ :aBoolean | self changed: #isExpanded: with: { aBoolean } ].! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/25/2013 13:33'!
selectAllChildren

	self children value do: [ :e | 
		e selected: true.
		e selectAllChildren ].! !

!TreeNodeModel methodsFor: 'converting' stamp: 'ChristopheDemarey 11/20/2013 14:39'!
isTreeNodeModel

	^ true! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/2/2013 19:28'!
matchTokenFilterBlock: aBlock

	matchTokenFilter value: aBlock! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/21/2013 22:57'!
mouseDownAction

	^ mouseDownAction value! !

!TreeNodeModel methodsFor: 'api-events' stamp: 'BenjaminVanRyseghem 11/22/2013 12:31'!
whenSelectedChanged: aBlock

	selected whenChangedDo: aBlock

	! !

!TreeNodeModel methodsFor: 'api-events' stamp: 'BenjaminVanRyseghem 11/24/2013 13:41'!
whenIsExpandedChanged: aBlock

	isExpanded whenChangedDo: aBlock

	! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/23/2013 11:49'!
buildChildren

	contents := self children value collect: [ :each || node | 
		node := each isTreeNodeModel
			ifTrue: [ each ]
			ifFalse: [  (self childNodeClassFor: each) new
				content: each  ].
		node 
			parentNode: self;
			yourself ].
		
	^ contents! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/21/2013 18:00'!
lastClicked: aBoolean

	lastClicked value: aBoolean! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 3/14/2014 12:06'!
hasChildren: aBlock

	hasChildren value: aBlock! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/24/2013 13:37'!
isExpanded
	
	^ isExpanded value! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/25/2013 16:27'!
takeHighlight

	self changed: #takeHighlight with: #()! !

!TreeNodeModel methodsFor: 'api' stamp: 'ChristopheDemarey 11/20/2013 14:37'!
childNodeClass

	^ childNodeClass value! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/21/2013 17:46'!
selected: aBoolean

	selected value: aBoolean! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/18/2013 10:19'!
parentNode: aNode

	parentNode value: aNode! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/26/2013 11:40'!
allSelectedItems
	| result |
	
	result := OrderedCollection new.
	self selected ifTrue: [ result add: self ].
	self children value do: [ :e | 
		result addAll: e allSelectedItems ].
	^ result! !

!TreeNodeModel methodsFor: 'filtering' stamp: 'BenjaminVanRyseghem 11/2/2013 19:19'!
isEmpty
	^ self contents isEmpty! !

!TreeNodeModel methodsFor: 'api-events' stamp: 'BenjaminVanRyseghem 11/22/2013 13:18'!
whenContentChanged: aBlock

	content whenChangedDo: aBlock

	! !

!TreeNodeModel methodsFor: 'filtering' stamp: 'BenjaminVanRyseghem 11/2/2013 19:26'!
matchTokenFilter: aFilter

	^ self matchTokenFilterBlock value: aFilter! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/2/2013 18:38'!
container: anObject

	container value: anObject! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/24/2013 21:21'!
unselectAllChildren

	self children value do: [ :e | 
		e selected: false.
		e unselectAllChildren ].	! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/21/2013 22:57'!
mouseDownAction: aBlock

	mouseDownAction value: aBlock! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/22/2013 15:42'!
hasContentToShow: aBlock

	hasContentToShow value: aBlock! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/26/2013 12:27'!
allUnselectedItems
	| result |
	
	result := OrderedCollection new.
	self selected ifFalse: [ result add: self ].
	self children value do: [ :e | 
		result addAll: e allUnselectedItems ].
	^ result! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/18/2013 10:19'!
parentNode

	^ parentNode value! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/2/2013 18:34'!
icon: anIcon

	icon value: anIcon! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/21/2013 17:55'!
selected
	
	^ selected value! !

!TreeNodeModel methodsFor: 'api' stamp: 'ChristopheDemarey 11/20/2013 14:37'!
childNodeClassFor: anItem

	^ childNodeClass value! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 3/4/2014 17:18:07'!
hasChildren

	^ hasChildren value! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/12/2013 22:33'!
children: aBlock

	children value: aBlock! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/2/2013 18:34'!
content

	^ content value! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/23/2013 23:37'!
isPartialMatch
	| result |

	result := false.
	
	self children value do: [:each | 
		(each selected or: [ each isPartialMatch ]) ifTrue: [ result := true ] ].

	^ result! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/21/2013 18:00'!
lastClicked
	
	^ lastClicked value! !

!TreeNodeModel methodsFor: 'filtering' stamp: 'BenjaminVanRyseghem 11/21/2013 10:36'!
contents
	^ contents ifNil: [ 
		self buildChildren.
		contents ]! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/2/2013 18:34'!
content: anObject

	content value: anObject! !

!TreeNodeModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/2/2013 18:34'!
icon

	^ icon value! !

!TreeNodeModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 11/2/2013 20:08'!
defaultSpec
	<spec: #default>
	
	^ #(TreeNodeAdapter
		adapt: #(model))! !

!TreeNodeModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/13/2014 15:29'!
adapterName

	^ #TreeNodeAdapter! !

!TreeWithLoading commentStamp: '<historical>'!
Wrap a tree with a loading page!
!TreeWithLoading methodsFor: 'reflective operations' stamp: 'BenjaminVanRyseghem 11/25/2013 14:31'!
doesNotUnderstand: aMessage

	^ tree
		perform: aMessage selector
		withArguments: aMessage arguments! !

!TreeWithLoading methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 1/24/2014 16:07'!
initialize

	super initialize.

	loading := true asValueHolder.
	
	loading whenChangedDo: [ :boolean | 
		boolean
			ifTrue: [ self showLoading ]
			ifFalse: [ self showTree ] ]! !

!TreeWithLoading methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/25/2013 14:18'!
loadingSpec

	^ SpecLayout composed
		add: #loadingAnimation;
		yourself! !

!TreeWithLoading methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/25/2013 14:13'!
tree
	^ tree! !

!TreeWithLoading methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/25/2013 14:17'!
treeSpec

	^ SpecLayout composed
		add: #tree;
		yourself! !

!TreeWithLoading methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/25/2013 14:14'!
loading

	^ loading value! !

!TreeWithLoading methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/25/2013 16:33'!
showTree

	self needRebuild: false.
	self buildWithSpecLayout: self treeSpec.

	self focusOrder 
		removeAll;
		add: tree! !

!TreeWithLoading methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 11/25/2013 14:18'!
initializeWidgets

	tree := self newTree! !

!TreeWithLoading methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/25/2013 16:33'!
showLoading

	self needRebuild: false.
	self buildWithSpecLayout: self loadingSpec.

	self focusOrder removeAll! !

!TreeWithLoading methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/26/2013 22:36'!
loadingAnimation

	^ LoadingMorph new 
		applyState: BigCogInitialState new;
		asSpecAdapter! !

!TreeWithLoading methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/25/2013 14:14'!
loading: anObject

	loading value: anObject! !

!TreeWithLoading class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 11/25/2013 14:18'!
defaultSpec

	^ SpecLayout composed
		add: #loadingAnimation;
		yourself! !

!True commentStamp: '<historical>'!
True defines the behavior of its single instance, true -- logical assertion. Notice how the truth-value checks become direct message sends, without the need for explicit testing.

Be aware however that most of these methods are not sent as real messages in normal use. Most are inline coded by the compiler as test and jump bytecodes - avoiding the overhead of the full message sends. So simply redefining these methods here will have no effect.!
!True methodsFor: 'controlling' stamp: ''!
and: alternativeBlock 
	"Nonevaluating conjunction -- answer the value of alternativeBlock since
	the receiver is true."

	^alternativeBlock value! !

!True methodsFor: 'logical operations' stamp: ''!
| aBoolean 
	"Evaluating disjunction (OR) -- answer true since the receiver is true."

	^self! !

!True methodsFor: 'controlling' stamp: ''!
ifTrue: alternativeBlock 
	"Answer the value of alternativeBlock. Execution does not actually 
	reach here because the expression is compiled in-line."

	^alternativeBlock value! !

!True methodsFor: 'controlling' stamp: ''!
ifTrue: trueAlternativeBlock ifFalse: falseAlternativeBlock 
	"Answer with the value of trueAlternativeBlock. Execution does not 
	actually reach here because the expression is compiled in-line."

	^trueAlternativeBlock value! !

!True methodsFor: 'controlling' stamp: ''!
ifFalse: alternativeBlock 
	"Since the condition is true, the value is the true alternative, which is nil. 
	Execution does not actually reach here because the expression is compiled 
	in-line."

	^nil! !

!True methodsFor: 'controlling' stamp: ''!
or: alternativeBlock 
	"Nonevaluating disjunction -- answer true since the receiver is true."

	^self! !

!True methodsFor: 'printing' stamp: ''!
printOn: aStream 

	aStream nextPutAll: 'true'! !

!True methodsFor: 'logical operations' stamp: 'md 7/30/2005 18:04'!
& aBoolean 
	"Evaluating conjunction -- answer aBoolean since receiver is true."

	^aBoolean! !

!True methodsFor: 'logical operations' stamp: 'CamilloBruni 8/1/2012 16:25'!
xor: aBoolean
	^aBoolean value not! !

!True methodsFor: 'logical operations' stamp: ''!
not
	"Negation--answer false since the receiver is true."

	^false! !

!True methodsFor: 'controlling' stamp: ''!
ifFalse: falseAlternativeBlock ifTrue: trueAlternativeBlock 
	"Answer the value of trueAlternativeBlock. Execution does not 
	actually reach here because the expression is compiled in-line."

	^trueAlternativeBlock value! !

!True methodsFor: 'converting' stamp: 'IgorStasenko 12/28/2012 15:09'!
asBit

	^ 1! !

!True class methodsFor: '*Fuel' stamp: 'MartinDias 2/21/2013 12:51'!
materializeFrom: aDecoder
	"Answer my unique instance"

	^ true! !

!TrueTest commentStamp: 'TorstenBergmann 2/5/2014 08:49'!
SUnit tests for true/True class!
!TrueTest methodsFor: 'tests controlling' stamp: 'NicolaiHess 12/1/2014 08:52'!
testOr

	self assert: (true or: [ 'alternativeBlock' ])! !

!TrueTest methodsFor: 'tests controlling' stamp: 'NicolaiHess 12/1/2014 08:54'!
testIfFalse
	
	self assert: ((true ifFalse: ['alternativeBlock']) isNil). ! !

!TrueTest methodsFor: 'tests controlling' stamp: 'NicolaiHess 12/1/2014 08:53'!
testIfFalseIfTrue

	self assert: (true ifFalse: ['falseAlternativeBlock'] 
                      ifTrue: ['trueAlternativeBlock']) = 'trueAlternativeBlock'. ! !

!TrueTest methodsFor: 'tests controlling' stamp: 'NicolaiHess 12/1/2014 08:53'!
testIfTrueIfFalse

	self assert: (true ifTrue: ['trueAlternativeBlock'] 
                      ifFalse: ['falseAlternativeBlock']) = 'trueAlternativeBlock'. ! !

!TrueTest methodsFor: 'tests controlling' stamp: 'NicolaiHess 12/1/2014 08:50'!
testAnd
	
	self assert: ((true and: ['alternativeBlock']) = 'alternativeBlock'). ! !

!TrueTest methodsFor: 'tests logical operations' stamp: 'NicolaiHess 12/1/2014 08:56'!
testOR

	self assert: (true | true).
	self assert: (true | false).! !

!TrueTest methodsFor: 'tests logical operations' stamp: 'StephaneDucasse 3/5/2010 15:32'!
testAND

	self assert: (true & true).
	self deny: (true & false).! !

!TrueTest methodsFor: 'tests logical operations' stamp: 'NicolaiHess 12/1/2014 08:55'!
testNot

	self deny: (true not).! !

!TrueTest methodsFor: 'tests printing' stamp: 'sd 6/5/2005 09:06'!
testPrintOn

	self assert: (String streamContents: [:stream | true printOn: stream]) = 'true'. ! !

!TrueTest methodsFor: 'tests instance creation' stamp: 'NicolaiHess 12/1/2014 08:46'!
testNew

	self should: [True new] raise: self defaultTestError ! !

!TrueTest methodsFor: 'tests logical operations' stamp: 'Md 11/18/2010 18:48'!
testXor
	self assert: (true xor: true) = false.
	self assert: (true xor: false) = true.
	self assert: (true xor: [true]) = false.
	self assert: (true xor: [false]) = true.! !

!TrueTest methodsFor: 'tests converting' stamp: 'StephaneDucasse 2/2/2010 13:49'!
testAsBit

       self assert: (true asBit = 1).! !

!TrueTest methodsFor: 'tests controlling' stamp: 'NicolaiHess 12/1/2014 09:10'!
testIfTrue

	self assert: ((true ifTrue: ['alternativeBlock']) = 'alternativeBlock'). ! !

!TutorialPlayer commentStamp: 'LaurentLaffont 1/21/2010 20:34'!
I can navigate through an AbstractTutorial subclass. With #next and #previous you can go forward and backward through the tutorial. !
!TutorialPlayer methodsFor: 'navigating' stamp: 'DannyChan 2/9/2010 19:29'!
last
	tutorialPosition := self size.
	^ self currentLesson! !

!TutorialPlayer methodsFor: 'accessing' stamp: 'LaurentLaffont 1/21/2010 13:40'!
size
	^ self tutorial size! !

!TutorialPlayer methodsFor: 'navigating' stamp: 'LaurentLaffont 1/21/2010 20:43'!
first
	self rewind.
	^ self currentLesson! !

!TutorialPlayer methodsFor: 'navigating' stamp: 'LaurentLaffont 1/21/2010 15:40'!
next
	self tutorialPosition < self size
		ifTrue: [tutorialPosition := tutorialPosition + 1].
	^ self currentLesson! !

!TutorialPlayer methodsFor: 'navigating' stamp: 'LaurentLaffont 1/21/2010 20:43'!
rewind
	tutorialPosition := 1.! !

!TutorialPlayer methodsFor: 'accessing' stamp: 'LaurentLaffont 1/21/2010 15:37'!
currentLesson
	^ self tutorial lessonAt: self tutorialPosition.! !

!TutorialPlayer methodsFor: 'accessing' stamp: 'CamilloBruni 2/22/2014 18:48'!
tutorial
	^ tutorial  ifNil: [tutorial := PharoSyntaxTutorial new]! !

!TutorialPlayer methodsFor: 'navigating' stamp: 'LaurentLaffont 1/18/2010 12:53'!
previous
	tutorialPosition >  1 ifTrue: [tutorialPosition := tutorialPosition  - 1].
	^ self currentLesson! !

!TutorialPlayer methodsFor: 'accessing' stamp: 'LaurentLaffont 1/21/2010 15:22'!
tutorial: aTutorial
	tutorial := aTutorial! !

!TutorialPlayer methodsFor: 'accessing' stamp: 'DannyChan 2/1/2010 19:25'!
tutorialPosition: aTutorialPosition 
	tutorialPosition := aTutorialPosition 
	! !

!TutorialPlayer methodsFor: 'accessing' stamp: 'LaurentLaffont 1/21/2010 20:43'!
tutorialPosition 
	^ tutorialPosition  ifNil: [
		self rewind.
		tutorialPosition.
	].
	! !

!TutorialPlayerTestTutorialAccessor commentStamp: 'TorstenBergmann 2/12/2014 22:53'!
SUnit tests for tutorial player!
!TutorialPlayerTestTutorialAccessor methodsFor: 'tests' stamp: 'LaurentLaffont 1/21/2010 21:19'!
testWithMockTutorial
	| mockTutorial player |
	mockTutorial := MockTutorial new.
	player := TutorialPlayer new tutorial: mockTutorial; yourself.
	self assert: player tutorial equals: mockTutorial.! !

!TutorialPlayerTestTutorialAccessor methodsFor: 'tests' stamp: 'CamilloBruni 2/22/2014 18:48'!
testDefaultsToSmalltalkSyntaxTutorial
	| player |
	player := TutorialPlayer new.
	self assert: (player tutorial isKindOf: PharoSyntaxTutorial).! !

!TutorialPlayerTestWithMockTutorial commentStamp: 'TorstenBergmann 2/12/2014 22:53'!
SUnit tests for tutorial player!
!TutorialPlayerTestWithMockTutorial methodsFor: 'tests' stamp: 'LaurentLaffont 1/21/2010 20:40'!
testSizeReturnsThree
	self assert: player size equals: 3.! !

!TutorialPlayerTestWithMockTutorial methodsFor: 'tests' stamp: 'LaurentLaffont 1/21/2010 20:40'!
testCurrentLessonIsFirstOneAtCreation
	self assert: player currentLesson title equals: 'first'.! !

!TutorialPlayerTestWithMockTutorial methodsFor: 'tests' stamp: 'LaurentLaffont 1/21/2010 20:40'!
testNavigation
	self assert: player next title equals: 'second'.
	self assert: player currentLesson title equals: 'second'.
	
	self assert: player next title equals: 'third'.
	self assert: player currentLesson title equals: 'third'.
	
	self assert: player next title equals: 'third'.
	self assert: player currentLesson title equals: 'third'.
	
	self assert: player previous title equals: 'second'.
	self assert: player currentLesson title equals: 'second'.
	
	self assert: player previous title equals: 'first'.
	self assert: player currentLesson title equals: 'first'.
	
	self assert: player previous title equals: 'first'.
	self assert: player currentLesson title equals: 'first'.! !

!TutorialPlayerTestWithMockTutorial methodsFor: 'tests' stamp: 'LaurentLaffont 1/21/2010 20:43'!
testResetTutorialGoBackToFirstLesson
	player next; next.
	self assert: player currentLesson title equals: 'third'.
	
	player rewind.
	self assert: player currentLesson title equals: 'first'.! !

!TutorialPlayerTestWithMockTutorial methodsFor: 'running' stamp: 'LaurentLaffont 1/21/2010 20:40'!
setUp
	| tutorial |
	tutorial := MockTutorial new.
	player := TutorialPlayer new tutorial: (MockTutorial new)! !

!TxActionAttribute commentStamp: 'IgorStasenko 9/10/2014 17:05'!
The action attribute has following semantic:
 - whenever we have UI event, which is about interacting with text portion that having action attribute,
an action receives such event, and then if it passing the filter , the action is triggered.

The value instance variable should be a zero or one-arg block, holding an action, which will receive an event.!
!TxActionAttribute methodsFor: 'accessing' stamp: 'IgorStasenko 9/10/2014 17:03'!
filter
	^ filter! !

!TxActionAttribute methodsFor: 'event handling' stamp: 'IgorStasenko 9/11/2014 14:14'!
filterEvent: anEvent
	"Answer true if event passes the filter, false otherwise"
	
	filter ifNil: [ ^ false ].
	^ filter value: anEvent! !

!TxActionAttribute methodsFor: 'accessing' stamp: 'IgorStasenko 9/24/2014 15:53'!
value
	^ self! !

!TxActionAttribute methodsFor: 'comparing' stamp: 'IgorStasenko 9/10/2014 17:02'!
= anObject
	^ super = anObject and: [ filter = anObject filter ]! !

!TxActionAttribute methodsFor: 'event handling' stamp: 'IgorStasenko 9/24/2014 15:57'!
handleEvent: anEvent
	"Answer true if event passes the filter, false otherwise"
	
	(self filterEvent: anEvent) ifTrue: [ 
		value cull: anEvent.
		^ true
		 ].
	^ false
! !

!TxActionAttribute methodsFor: 'accessing' stamp: 'IgorStasenko 9/10/2014 17:03'!
filter: aBlock
	filter := aBlock! !

!TxActionAttribute class methodsFor: 'defaults' stamp: 'IgorStasenko 9/24/2014 15:49'!
defaultValue
	^ Default ifNil: [  Default := self new ]! !

!TxAdapterBindings methodsFor: 'initialize' stamp: 'IgorStasenko 4/18/2014 15:30'!
initializeBindings
	
	#(
		#ButtonAdapter				 #MorphicButtonAdapter
		#CheckBoxAdapter			 #MorphicCheckBoxAdapter
		#ContainerAdapter			 #MorphicContainerAdapter
		 #DiffAdapter				 #MorphicDiffAdapter
		 #DropListAdapter			 #MorphicDropListAdapter
		 #LabelAdapter				 #MorphicLabelAdapter
		 #ListAdapter				 #MorphicListAdapter
		 #IconListAdapter			 #MorphicIconListAdapter
		 #ImageAdapter			 #MorphicImageAdapter
		 #MultiColumnListAdapter	 #MorphicMultiColumnListAdapter
		 #MenuAdapter				 #MorphicMenuAdapter
		 #MenuGroupAdapter		 #MorphicMenuGroupAdapter
		 #MenuItemAdapter			 #MorphicMenuItemAdapter
		 #NewListAdapter			 #MorphicNewListAdapter
		 #RadioButtonAdapter		 #MorphicRadioButtonAdapter
		 #SliderAdapter				 #MorphicSliderAdapter
		 #TabManagerAdapter		 #MorphicTabManagerAdapter
		 #TabAdapter				 #MorphicTabAdapter
		 #TextAdapter				 #TxTextAdapter
		 #TextInputFieldAdapter		 #MorphicTextInputFieldAdapter
		 #TreeAdapter				 #MorphicTreeAdapter
		 #TreeColumnAdapter		 #MorphicTreeColumnAdapter
		 #TreeNodeAdapter			 #MorphicTreeNodeAdapter
		 #WindowAdapter			 #MorphicWindowAdapter
		 #TickingWindowAdapter	 #MorphicTickingWindowAdapter
		 #DialogWindowAdapter		 #MorphicDialogWindowAdapter
	
	) pairsDo: [ :key :val | bindings at: key put: val ].	
	
		! !

!TxApplicationWithToolbar commentStamp: 'IgorStasenko 4/18/2014 15:21'!
TxApplicationWithToolbar new openWithSpec!
!TxApplicationWithToolbar methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 4/22/2014 13:33'!
openWithSpec
	
	| old result |
	old := SpecInterpreter bindings.
	
	SpecInterpreter bindings: TxAdapterBindings new.
	
	[ result :=  super openWithSpec ]
	ensure: [ SpecInterpreter bindings: old ].
	^ result
	! !

!TxApplicationWithToolbar methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 4/18/2014 15:23'!
text
	^ text! !

!TxApplicationWithToolbar methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 4/25/2014 17:35'!
initializeWidgets

	text := self newText.
	
	self focusOrder add:  text 
	
! !

!TxApplicationWithToolbar class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 4/18/2014 17:07'!
defaultSpec
	<spec: #default>
	^ SpecLayout composed
		newColumn: [ :c | 
			c 
				add: #text ];
		yourself.
	 ! !

!TxAthensCharacterWrappingStrategy commentStamp: 'IgorStasenko 5/9/2014 17:44'!
This layout strategy wraps text, so it never overflows view horizontally.
If line is too long to be shown fully as a single text line in view,
it is automatically wrapped to the next line.

Therefore, the layout is calculated based on view's extent.
The 'rightMargin' can be used to wrap the text before it gets wider than view width, e.g:

maxLineWidth := view width - rightMargin.

By default, right margin is Zero, meaning the max line width is same as view width.

Note, if you using this strategy, the view must never use horizontal scrolling,
and its offset x must be always Zero (since it makes little sense to have something else with such strategy).!
!TxAthensCharacterWrappingStrategy methodsFor: 'accessing' stamp: 'IgorStasenko 5/9/2014 17:40'!
rightMargin
	^ rightMargin! !

!TxAthensCharacterWrappingStrategy methodsFor: 'initialization' stamp: 'IgorStasenko 5/9/2014 17:39'!
initialize
	super initialize.
	rightMargin := 0.! !

!TxAthensCharacterWrappingStrategy methodsFor: 'accessing' stamp: 'IgorStasenko 5/12/2014 15:56'!
rightMargin: aNumber
	rightMargin := aNumber! !

!TxAthensCharacterWrappingStrategy methodsFor: 'visitor' stamp: 'IgorStasenko 8/7/2014 16:27'!
visitCharacterSpan: aSpan
	
	| chars pos startPos font w  fontMetricsProvider  viewWidth  glyphWidth  |
	
	chars := aSpan characters.
	
	startPos := pos := currentPosition spanPosition.

	font := aSpan getAttribute: TxFontAttribute.  
	
	fontMetricsProvider := self fontMetricsProviderFor: font.
	currentLine accumulateHeight: fontMetricsProvider fontHeight.
	currentLine accumulateAscent: fontMetricsProvider fontAscent.
	
	viewWidth := self view extent x.
	glyphWidth := w := 0.
	startPos := pos + 1.
	
	[ pos < chars size ] whileTrue: [ | char |
	
		char := chars at: pos+1.
		char == Character tab ifTrue: [ | ta | 
			ta := self alignTab: font.
			((currentLine width + ta x > (viewWidth - rightMargin)) and: [ currentLine width >0 ]) ifTrue: [ 
				"Need to wrap"
				
				currentLine addCommand: (
					fontMetricsProvider 
						newCharacterSpanDisplayCommand: aSpan 
						start: startPos 
						stop: pos 
						advance: w@0).

				currentPosition := aSpan positionAt: pos.
				self completeLine.
				^ currentPosition
				].
				
			currentLine addCommand: (
				fontMetricsProvider 
					newCharacterSpanDisplayCommand: aSpan 
					start: startPos 
					stop: pos
					advance: w@0).

			
			currentLine addWidth: ta x.
			currentLine addCommand: (fontMetricsProvider 
						newTabDisplayCommand: aSpan
						start: pos-1
						stop: pos
						advance: ta).
				currentPosition := aSpan positionAt: pos+1.
				^ currentPosition
			].
		
		
		glyphWidth := (fontMetricsProvider getGlyphWidth: char).
		"Do not wrap unless we put at least one character into current line"
		((currentLine width + glyphWidth > (viewWidth - rightMargin)) and: [ currentLine width >0 ]) ifTrue: [ 
				"wrap to new line"
				currentLine addCommand: (
					fontMetricsProvider 
						newCharacterSpanDisplayCommand: aSpan 
						start: startPos 
						stop: pos 
						advance: w@0).

				currentPosition := aSpan positionAt: pos.
				self completeLine.
				^ currentPosition
			] 
		ifFalse: [ 
			currentLine addWidth: glyphWidth.
			w := w + glyphWidth.
			pos := pos +1
		]
	].

	currentLine addCommand: (
		fontMetricsProvider 
			newCharacterSpanDisplayCommand: aSpan 
			start: startPos 
			stop: chars size
			advance: w@0).
			
	^ aSpan next startPosition
! !

!TxAthensCursor commentStamp: 'IgorStasenko 8/26/2014 13:12'!
i am a base class to display a cursor in text!
!TxAthensCursor methodsFor: 'drawing-not supported' stamp: 'FernandoOlivero 9/3/2013 00:46'!
drawOn: aCanvas 
	self subclassResponsibility ! !

!TxAthensCursor methodsFor: 'blinking support' stamp: 'IgorStasenko 10/22/2013 17:12'!
startBlinking
	self startStepping! !

!TxAthensCursor methodsFor: 'testing' stamp: 'FernandoOlivero 9/19/2013 00:29'!
isBlinking
	^ false ! !

!TxAthensCursor methodsFor: 'accessing' stamp: 'IgorStasenko 10/22/2013 14:02'!
calculateNewBounds
	self subclassResponsibility! !

!TxAthensCursor methodsFor: 'blinking support' stamp: 'IgorStasenko 10/22/2013 17:33'!
blinkIntervalMs
	^ 500! !

!TxAthensCursor methodsFor: 'initialize-release' stamp: 'FernandoOlivero 9/4/2013 13:55'!
initialize 
	super initialize.
	bounds := 0@0 extent: 1 @10. 
	paint := Color blue.! !

!TxAthensCursor methodsFor: 'blinking support' stamp: 'IgorStasenko 10/22/2013 17:22'!
isBlinkingVisibleNow
	| tick |
	
	tick := Time millisecondClockValue - lastChangeTick.
	
	tick < 0 ifTrue: [ 
		"rare case when tick counter wrapped"
		lastChangeTick := Time millisecondClockValue.
		tick := 0 ].
	
	^ (tick // self blinkIntervalMs) even
	! !

!TxAthensCursor methodsFor: 'blinking support' stamp: 'IgorStasenko 10/22/2013 17:23'!
step
	
	self visible 
		ifFalse: [ self stopStepping ]
		ifTrue: [ self changed ]! !

!TxAthensCursor methodsFor: 'blinking support' stamp: 'IgorStasenko 4/25/2014 16:59'!
wantsSteps
	^ false! !

!TxAthensCursor methodsFor: 'accessing' stamp: 'IgorStasenko 10/30/2013 16:43'!
cursorColor
	^ Color red " self theme selectionColor alpha: 0.5"! !

!TxAthensCursor methodsFor: 'geometry' stamp: 'FernandoOlivero 9/4/2013 13:52'!
position
	^ layoutPosition topPointInView ! !

!TxAthensCursor methodsFor: 'accessing' stamp: 'IgorStasenko 4/25/2014 15:57'!
layoutPosition: aPosition
	
	lastChangeTick := Time millisecondClockValue.
	layoutPosition := aPosition.

	"update bounds according to new layout position"
	self bounds: self calculateNewBounds.
	
"	self startStepping"! !

!TxAthensCursor methodsFor: 'blinking support' stamp: 'IgorStasenko 10/22/2013 17:27'!
stepTime
	^ self blinkIntervalMs! !

!TxAthensCursor methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 4/25/2014 17:04'!
visible: aBoolean

	super visible: aBoolean.
	aBoolean ifTrue: [  self startStepping ].
! !

!TxAthensLayout commentStamp: 'IgorStasenko 12/29/2013 16:30'!
i represent the cached visual layout of given text.

Note, that layout is considered a private information maintained by concerete view, and not accessible (userful) without having a view.

!
!TxAthensLayout methodsFor: 'accessing' stamp: 'IgorStasenko 3/27/2014 14:57'!
setLines: newLines

	lines := newLines asOrderedCollection.
	self updateExtent.! !

!TxAthensLayout methodsFor: 'geometry' stamp: 'IgorStasenko 11/28/2013 09:21'!
positionAt: aTextPosition ifOutside: aBlock
	(self interval contains: aTextPosition)
		ifTrue:[ ^ TxAthensLayoutPosition textPosition: aTextPosition layout: self ] 
		ifFalse: [  ^ aBlock value ].
		 
! !

!TxAthensLayout methodsFor: 'accessing' stamp: 'IgorStasenko 8/8/2013 18:08'!
lines
	^ lines! !

!TxAthensLayout methodsFor: 'scanning' stamp: 'IgorStasenko 12/19/2013 15:54'!
extendOneLineUp
	
	| pos newLine extraLines h |
	
	pos := self startPosition.
	
	pos isAtStart ifTrue: [ ^ false ].
		
	pos := self startPosition moveUp moveToLineStart.
	
	extraLines := OrderedCollection new.
	
	[ 
		newLine := strategy scanSingleVisualLineFor: self startingAt: pos.	
		extraLines add: newLine.
		
		"if end position is at line separator, advance to next line"
		pos := newLine endPosition.
		(pos span isLineSeparator and: [ pos isAtSpanStart ]) ifTrue: [  pos := pos nextPosition ].
		pos = self startPosition
	] whileFalse.

	h := extent y.
	extraLines reverseDo: [ :line |
		lines addFirst: line.
		extent := (extent x max: line width) @ (extent y + line height).
	].
	
	view privSetVerticalOffset: view offset y + (extent y - h).
	
	^ true.! !

!TxAthensLayout methodsFor: 'accessing' stamp: 'IgorStasenko 11/28/2013 09:53'!
height
	^ extent y ! !

!TxAthensLayout methodsFor: 'accessing' stamp: 'IgorStasenko 11/28/2013 09:22'!
text
	^ self startPosition text! !

!TxAthensLayout methodsFor: 'factory' stamp: 'IgorStasenko 9/18/2014 17:48'!
newEmbeddedObjectCommand: anEmbeddedObjectSpan

	^ self view newEmbeddedObjectCommand: anEmbeddedObjectSpan! !

!TxAthensLayout methodsFor: 'accessing' stamp: 'IgorStasenko 11/28/2013 09:19'!
endPosition
	^ lines last endPosition! !

!TxAthensLayout methodsFor: 'initialize-release' stamp: 'IgorStasenko 11/28/2013 08:24'!
initialize
	lines := OrderedCollection new.
	extent := 0@0.! !

!TxAthensLayout methodsFor: 'initialize-release' stamp: 'IgorStasenko 11/28/2013 10:20'!
initializePosition: pos strategy: layoutStrategy
	"initialize layout and scan a single line using given strategy"
	| line |
	
	lines := OrderedCollection new.
	strategy := layoutStrategy.

	line := strategy scanSingleVisualLineFor: self startingAt: pos.
	
	self setLines: { line }! !

!TxAthensLayout methodsFor: 'geometry' stamp: 'IgorStasenko 8/27/2013 11:47'!
fontMetricsProviderFor: aFont 
	^ view fontMetricsProviderFor: aFont ! !

!TxAthensLayout methodsFor: 'accessing' stamp: 'IgorStasenko 8/27/2013 11:47'!
view: aLayoutView
	view := aLayoutView! !

!TxAthensLayout methodsFor: 'accessing' stamp: 'IgorStasenko 11/28/2013 09:20'!
startPosition
	^ lines first startPosition! !

!TxAthensLayout methodsFor: 'scanning' stamp: 'IgorStasenko 12/10/2013 15:29'!
extendOneLineDown
	
	"Extend layout to the bottom, by scanning one more visual line.
	Answer true if new line was added due to scanning..
	or false, if there's nothing left to scan (end of text) "
	| pos newLine |
	
	pos := self endPosition.
	pos isAtEnd ifTrue: [ ^ false ].

	"if end position is at line separator, advance to next line"
	(pos span isLineSeparator and: [ pos isAtSpanStart ]) ifTrue: [  pos := pos nextPosition ].
	
	newLine := strategy scanSingleVisualLineFor: self startingAt: pos.
	lines add: newLine.
	extent := (extent x max: newLine width) @ (extent y + newLine height).
	
	^ true.! !

!TxAthensLayout methodsFor: 'accessing' stamp: 'IgorStasenko 12/29/2013 16:33'!
width
	^ extent x! !

!TxAthensLayout methodsFor: 'private' stamp: 'IgorStasenko 3/27/2014 14:57'!
updateExtent
	"Recalculate the current extent, based on lines width"
	| x y |
	
	x := y := 0.
	lines do: [:each |
		x := x max: each width.
		y := y + each height.
	].

	extent := x@y! !

!TxAthensLayout methodsFor: 'accessing' stamp: 'IgorStasenko 8/26/2014 12:40'!
commandForPosition: aTextPosition ifOutside: aBlock
	"Answer the display command which correspond to given text position in layout,
	or evaluate block if layout does not contains given position"
	
	lines do: [:line |
		(line interval contains: aTextPosition) ifTrue: [ 
			^ line commandForPosition: aTextPosition ifOutside: aBlock ]
	].

	^ aBlock value! !

!TxAthensLayout methodsFor: 'accessing' stamp: 'FernandoOlivero 8/25/2013 11:10'!
numberOfLines
	^ lines size! !

!TxAthensLayout methodsFor: 'accessing' stamp: 'IgorStasenko 8/7/2014 14:18'!
tabWidthUsingFont: aFont
	"Initialize tab width based on first attempt to use it in text (therefore it will use font metrics of font used in character span, where tab has occured).
	The tab width is then considered same for whole layout, regardless of font size/font metrics used by any other tabs.
	"
	| metricsProvider |

	tabWidth ifNotNil: [ ^ tabWidth ].

	metricsProvider := self fontMetricsProviderFor: aFont.
	"Take arbitrary number and multiply it by 8.. this is how you get the tab width!! "
	^ tabWidth := (metricsProvider getGlyphWidth: Character space) * 8.
! !

!TxAthensLayout methodsFor: 'geometry' stamp: 'FernandoOlivero 9/2/2013 16:03'!
textPositionAt: aPoint
	|  line height index |
	self numberOfLines = 0 ifTrue:[ ^ 0 ].
	 
	"find the line under the aPoint y by: accumulating the heights starting from the first line of the layout,  till we reach the Y of the point"
	
	aPoint y <= 0 ifTrue: [ ^ lines first  textPositionAtHorizontalOffset: aPoint x ].
	
	height := 0.
	index := 1.
	[ index <= lines size and:[ height < aPoint y ]] whileTrue:[
		line := lines at: index.
		height := height + line height.
		index := index + 1
	].
	
	index > lines size ifTrue: [  ^ lines last  textPositionAtHorizontalOffset: aPoint x ].
	
	^ line textPositionAtHorizontalOffset: aPoint x ! !

!TxAthensLayout methodsFor: 'private' stamp: 'IgorStasenko 9/18/2014 17:07'!
compact
	"Remove lines outside of view, answer updated view's vertical offset"
	| viewOffsetY line height linesToKeep oldLines |
	viewOffsetY := view offset y.
	
	[ line := lines first. viewOffsetY > line height ] whileTrue: [ 
		lines removeFirst notifyRemovedFrom: self. 
		viewOffsetY := viewOffsetY - line height.
	].
	
	height := 0.
	linesToKeep := lines count: [ :each |
		height := height + each height.
		height - viewOffsetY < view extent y
		 ].
	linesToKeep := (linesToKeep +1) min: lines size.
	oldLines := lines allButFirst: linesToKeep.
	lines := lines first: linesToKeep.
	oldLines do: [ :each | each notifyRemovedFrom: self ].

	self updateExtent.

	^ viewOffsetY
! !

!TxAthensLayout methodsFor: 'geometry' stamp: 'IgorStasenko 8/8/2013 17:09'!
extent
	^ extent! !

!TxAthensLayout methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 9/18/2014 18:43'!
hideEmbeddedObject: morph
	^ view hideEmbeddedObject: morph! !

!TxAthensLayout methodsFor: 'testing' stamp: 'IgorStasenko 11/28/2013 09:21'!
isWellFormed
	"check that every position within the receiver interval corresponds to some line "

	| pos end |

	pos := self startPosition.
	end := self endPosition.
	
	[ pos <= end ] whileTrue: [ 
		self positionAt: pos ifOutside: [ ^ false ].
		pos := pos nextPosition.
	 ].
	^ true.! !

!TxAthensLayout methodsFor: 'scanning' stamp: 'IgorStasenko 3/27/2014 14:56'!
addLine: newLine

	lines add: newLine.
	extent := (extent x max: newLine width) @ (extent y + newLine height)! !

!TxAthensLayout methodsFor: 'accessing' stamp: 'IgorStasenko 11/28/2013 09:18'!
interval
	^ lines first startPosition to: lines last endPosition! !

!TxAthensLayout methodsFor: 'accessing' stamp: 'IgorStasenko 8/27/2013 15:37'!
view
	^ view! !

!TxAthensLayoutLine commentStamp: '<historical>'!
I represent a single text line, which belongs to specific layout.

I carry various geometrical information, such as maximum ascent, line height and width.
My commands are TxDisplayCommand-s which contain enough information to render
the line correctly on canvas , as well as for measuring font metrics.

I am certainly not the top level API and my implementation is considered private
(in contrast to LayoutView).!
!TxAthensLayoutLine methodsFor: 'initalize-release' stamp: 'IgorStasenko 8/27/2013 14:58'!
layout: aLayout
	layout := aLayout ! !

!TxAthensLayoutLine methodsFor: 'rendering' stamp: 'IgorStasenko 8/26/2013 13:07'!
debugRenderOn: aTxTextRenderer 
	
	aTxTextRenderer canvas 
		setPaint: Color red;
		drawShape: (0@ maxAscent negated corner: width@(maxAscent negated+height)).
	
	commands do: [:cmd | cmd renderOn: aTxTextRenderer ]! !

!TxAthensLayoutLine methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 9/18/2014 18:40'!
notifyRemovedFrom: aTxAthensLayout 
	""
	commands do: [ :ea | ea notifyRemovedFrom: aTxAthensLayout ]! !

!TxAthensLayoutLine methodsFor: 'accessing' stamp: 'IgorStasenko 11/28/2013 10:21'!
endPosition: aTxTextPosition 
	interval := interval 
		ifNil: [ aTxTextPosition to: aTxTextPosition ]
		ifNotNil: [ interval start to: aTxTextPosition ]! !

!TxAthensLayoutLine methodsFor: 'geometry' stamp: 'IgorStasenko 8/8/2013 16:36'!
height
	^ height! !

!TxAthensLayoutLine methodsFor: 'accessing' stamp: 'IgorStasenko 8/12/2013 15:24'!
accumulateAscent: asc
	maxAscent := maxAscent max: asc! !

!TxAthensLayoutLine methodsFor: 'accessing' stamp: 'IgorStasenko 8/8/2013 16:39'!
endPosition
	^ interval end ! !

!TxAthensLayoutLine methodsFor: 'initalize-release' stamp: 'IgorStasenko 8/12/2013 15:23'!
initialize
	super initialize.
	maxAscent := height := baselineOffset := width := 0.
	commands := OrderedCollection new! !

!TxAthensLayoutLine methodsFor: 'accessing' stamp: 'IgorStasenko 8/8/2013 16:36'!
baselineOffset
	^ baselineOffset! !

!TxAthensLayoutLine methodsFor: 'printing' stamp: 'IgorStasenko 9/19/2013 13:31'!
printOn: aStream

	super printOn: aStream.
	aStream space; print: interval.! !

!TxAthensLayoutLine methodsFor: 'accessing' stamp: 'IgorStasenko 8/12/2013 15:33'!
addCommand: cmd

	commands add: cmd
	! !

!TxAthensLayoutLine methodsFor: 'accessing' stamp: 'FernandoOlivero 8/26/2013 16:30'!
startPosition
	^ interval start! !

!TxAthensLayoutLine methodsFor: 'accessing' stamp: 'IgorStasenko 8/12/2013 15:22'!
maxAscent
	^ maxAscent! !

!TxAthensLayoutLine methodsFor: 'geometry' stamp: 'IgorStasenko 8/8/2013 16:36'!
width: anObject
	width := anObject! !

!TxAthensLayoutLine methodsFor: 'geometry' stamp: 'IgorStasenko 8/8/2013 16:36'!
width
	^ width! !

!TxAthensLayoutLine methodsFor: 'rendering' stamp: 'IgorStasenko 8/26/2014 13:10'!
renderOn: aTxTextRenderer 
	
	"aTxTextRenderer canvas 
		setPaint: (Color red alpha:0.5);
		drawShape: (0@ maxAscent negated corner: width@(maxAscent negated+height)).
"	
	commands do: [:cmd | cmd renderOn: aTxTextRenderer ]! !

!TxAthensLayoutLine methodsFor: 'scanning' stamp: 'IgorStasenko 8/8/2013 17:07'!
addWidth: aNumber 
	width := width + aNumber! !

!TxAthensLayoutLine methodsFor: 'accessing' stamp: 'IgorStasenko 8/26/2014 12:39'!
commandForPosition: aTextPosition ifOutside: aBlock
	"Answer the display command which correspond to given text position in line,
	or evaluate block if receiver does not contains given position"
	
	(interval contains: aTextPosition) ifTrue: [ 
			commands do: [ :each | (each contains: aTextPosition) ifTrue: [^ each ]]].

	^ aBlock value! !

!TxAthensLayoutLine methodsFor: 'accessing' stamp: 'IgorStasenko 11/28/2013 10:12'!
startPosition: aTxTextPosition 
	
	interval ifNotNil: [  self error: 'start position can be set only once' ].

	interval := (aTxTextPosition to: aTxTextPosition).
	"set initial height and ascent"
	self accumulateSpanFontMetrics: aTxTextPosition span.
			
! !

!TxAthensLayoutLine methodsFor: 'geometry' stamp: 'IgorStasenko 9/19/2013 11:39'!
horizontalOffsetFor: textPosition 
	
	| totalAdvance |
	
	totalAdvance := 0. 
	
	"special case, when line starting position don't matching the first command position"
	commands isEmpty ifTrue: [ "empty line" ^ 0 ].
	commands first startPosition > textPosition ifTrue: [  ^ 0 ]. 
		
	commands do: [:cmd |
		(cmd contains: textPosition) ifTrue: [
			^ totalAdvance + (cmd horizontalAdvanceUpTo: textPosition layout: layout)
			  ]
		ifFalse: [ totalAdvance := totalAdvance + cmd advance x]
	].

	"if we reach here, just answert he accumulated total advance"
	^ totalAdvance! !

!TxAthensLayoutLine methodsFor: 'accessing' stamp: 'IgorStasenko 8/27/2013 14:58'!
layout
	^ layout! !

!TxAthensLayoutLine methodsFor: 'geometry' stamp: 'IgorStasenko 9/19/2013 13:17'!
textPositionAtHorizontalOffset: anOffset 
	| advance |
	anOffset < 0 ifTrue:[ ^ self startPosition ].
	advance := 0.
	commands do: [:cmd | 
		(cmd advance x + advance > anOffset)
			ifTrue:[ ^ cmd textPositionForHorizontalOffset: anOffset - advance layout: layout].
		advance := advance + cmd advance x ].
	^ self endPosition! !

!TxAthensLayoutLine methodsFor: 'accessing' stamp: 'IgorStasenko 10/15/2013 11:43'!
accumulateSpanFontMetrics: span
	"accumulate max font height and ascent for given span"
	| font fontMetricsProvider |

	font := interval start span getAttribute: TxFontAttribute.  
	fontMetricsProvider := layout fontMetricsProviderFor: font.
	self accumulateHeight: fontMetricsProvider fontHeight.
	self accumulateAscent: fontMetricsProvider fontAscent.		
	! !

!TxAthensLayoutLine methodsFor: 'accessing' stamp: 'IgorStasenko 8/8/2013 03:19'!
commands
	
	^ commands! !

!TxAthensLayoutLine methodsFor: 'accessing' stamp: 'IgorStasenko 8/8/2013 17:56'!
accumulateHeight: h
	height := height max: h! !

!TxAthensLayoutLine methodsFor: 'accessing' stamp: 'IgorStasenko 8/8/2013 03:19'!
interval
	
	^ interval! !

!TxAthensLayoutPosition commentStamp: '<historical>'!
i provide mapping from text position (TxTextPosition)
to position inside view's layout.

!
!TxAthensLayoutPosition methodsFor: 'accessing' stamp: 'IgorStasenko 8/26/2014 12:35'!
command
	"Answer the display command which correspond to given layout position"
	^ command! !

!TxAthensLayoutPosition methodsFor: 'accessing' stamp: 'IgorStasenko 10/29/2013 13:50'!
topPointInView
	"answer the point at baseline matching with given layout position"
	
	^ self topPoint - layout view offset! !

!TxAthensLayoutPosition methodsFor: 'accessing' stamp: 'IgorStasenko 11/29/2013 16:57'!
bottomPointInView
	"answer the point at baseline matching with given layout position"
	
	^ self bottomPoint - layout view offset! !

!TxAthensLayoutPosition methodsFor: 'accessing' stamp: 'IgorStasenko 8/27/2013 12:51'!
baselinePoint
	"answer the point at baseline matching with given layout position"
	
	^ horizontalOffset @ (lineTopOffset + line maxAscent )! !

!TxAthensLayoutPosition methodsFor: 'accessing' stamp: 'IgorStasenko 8/26/2014 12:18'!
textPosition
	^ textPosition! !

!TxAthensLayoutPosition methodsFor: 'accessing' stamp: 'IgorStasenko 8/27/2013 15:42'!
horizontalOffset
	^ horizontalOffset! !

!TxAthensLayoutPosition methodsFor: 'accessing' stamp: 'IgorStasenko 10/22/2013 14:09'!
layout
	^ layout! !

!TxAthensLayoutPosition methodsFor: 'initializing' stamp: 'FernandoOlivero 9/2/2013 16:05'!
textPosition: aTextPosition layout: txLayout
	
	textPosition := aTextPosition.
	layout := txLayout.
	
	self updateInfo.
	
 ! !

!TxAthensLayoutPosition methodsFor: 'accessing' stamp: 'IgorStasenko 8/27/2013 12:51'!
topPoint
	"answer the point at baseline matching with given layout position"
	
	^ horizontalOffset @ lineTopOffset ! !

!TxAthensLayoutPosition methodsFor: 'accessing' stamp: 'FernandoOlivero 9/2/2013 15:37'!
line
	^ line ! !

!TxAthensLayoutPosition methodsFor: 'calculating' stamp: 'IgorStasenko 8/26/2014 12:38'!
updateInfo

 	lineTopOffset := 0.
	
	layout lines do: [:each |
		(each interval contains: textPosition) ifTrue: [ 
			"found the line"
			line := each.
			horizontalOffset := line horizontalOffsetFor: textPosition .
			command := line commandForPosition: textPosition ifOutside: nil.
			^ self
		].
		lineTopOffset := lineTopOffset + each height.
	].

	horizontalOffset isNil ifTrue:[ self error: 'should not get here!!'].! !

!TxAthensLayoutPosition methodsFor: 'accessing' stamp: 'IgorStasenko 10/29/2013 13:50'!
baselinePointInView
	"answer the point at baseline matching with given layout position"
	
	^ self baselinePoint - layout view offset! !

!TxAthensLayoutPosition methodsFor: 'accessing' stamp: 'IgorStasenko 11/29/2013 17:04'!
bottomPoint
	"answer the point at baseline matching with given layout position"
	
	^ self topPoint + (0@line height)! !

!TxAthensLayoutPosition class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/27/2013 11:34'!
textPosition: textPosition layout: txLayout

	^ self new textPosition: textPosition layout: txLayout
! !

!TxAthensLayoutStrategy methodsFor: 'visiting' stamp: 'IgorStasenko 11/28/2013 10:23'!
visitLineSeparator: aSpan

	"A line separator indicates new line
	if current span position = 0 then we finish scanning,
	else we treat it as beginning of a new line, and must continue"
	currentPosition isAtSpanStart ifTrue: [
		"end of line"
		self completeLine.
		^ currentPosition
	].

	^ currentPosition nextPosition! !

!TxAthensLayoutStrategy methodsFor: 'visiting' stamp: 'IgorStasenko 9/18/2014 17:46'!
visitEmbeddedObjectSpan: aSpan

	| font fontMetricsProvider command |

	font := aSpan getAttribute: TxFontAttribute.  
	fontMetricsProvider := layout fontMetricsProviderFor: font.

	command := layout newEmbeddedObjectCommand: aSpan.
	
	"embedded object's height contributes to font ascent, as its bottom is aligned to baseline"
	currentLine accumulateAscent: command height.
	currentLine accumulateHeight: command height + (fontMetricsProvider fontHeight - fontMetricsProvider fontAscent).
	currentLine addWidth: command width.
	
	currentLine addCommand: command.

	^ aSpan next startPosition
! !

!TxAthensLayoutStrategy methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/7/2014 15:12'!
alignTab: font
	| tabWidth lineWidth |
	tabWidth := self layout tabWidthUsingFont: font.
	lineWidth := currentLine width.
	
	^ lineWidth // tabWidth + 1 * tabWidth - lineWidth @ 0
	! !

!TxAthensLayoutStrategy methodsFor: 'building' stamp: 'IgorStasenko 11/28/2013 10:22'!
completeLine

	currentLine endPosition: currentPosition.
	metStopCondition := true.! !

!TxAthensLayoutStrategy methodsFor: 'scanning' stamp: 'IgorStasenko 11/28/2013 09:51'!
scanSingleVisualLineFor: aLayout startingAt: aPosition
	"Scan a single visual line until meeting stop condition.
	Note, the incoming position can be in the middle of text line (because of wrapping)"
	
	layout := aLayout.
	currentPosition := aPosition.	
	self startNewLine.
	metStopCondition := false.
	
	[ currentPosition := currentPosition span accept: self. metStopCondition ] whileFalse.

	^ currentLine! !

!TxAthensLayoutStrategy methodsFor: 'building' stamp: 'IgorStasenko 11/28/2013 09:40'!
startNewLine

	currentLine := TxAthensLayoutLine new
		layout: self layout;
		startPosition: currentPosition;
		yourself.
	! !

!TxAthensLayoutStrategy methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/28/2013 09:52'!
fontMetricsProviderFor: aFont
	^ self view fontMetricsProviderFor: aFont! !

!TxAthensLayoutStrategy methodsFor: 'visiting' stamp: 'IgorStasenko 10/15/2013 11:38'!
visitStartSpan: aSpan

	"usually just skip over start span"
	^ aSpan next startPosition! !

!TxAthensLayoutStrategy methodsFor: 'visiting' stamp: 'IgorStasenko 10/15/2013 11:52'!
visitEndSpan: aSpan

	self completeLine.
! !

!TxAthensLayoutStrategy methodsFor: 'accessing' stamp: 'IgorStasenko 11/28/2013 09:49'!
layout
	^ layout! !

!TxAthensLayoutStrategy methodsFor: 'accessing' stamp: 'IgorStasenko 11/28/2013 09:49'!
view
	^ layout view! !

!TxAthensLayoutTest methodsFor: 'running' stamp: 'FernandoOlivero 8/25/2013 10:08'!
setUp
	text := self newText: self defaultText.
	view := self newViewOn: text.! !

!TxAthensLayoutTest methodsFor: 'tests' stamp: 'IgorStasenko 10/14/2013 12:01'!
testLayoutShouldHaveNoGaps
	"check that layout has no gaps"
	self assert: view layout isWellFormed! !

!TxAthensLayoutTest methodsFor: 'private' stamp: 'IgorStasenko 10/21/2014 17:29'!
defaultText
^
'"Lorem
ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum."
Section 1.10.32 of "de Finibus Bonorum et Malorum", written by Cicero in 45 BC
"Sed ut perspiciatis unde omnis iste natus error sit voluptatem accusan
tium doloremque laudantium, totam rem aperiam, eaque ipsa quae ab illo inventore veritatis et quasi architecto beatae vitae dicta sunt explicabo. Nemo enim ipsam voluptatem quia voluptas sit aspernatur aut odit aut fugit, sed quia consequuntur magni dolores eos qui ratione voluptatem sequi nesciunt. Neque porro quisquam est, qui dolorem ipsum quia dolor sit amet, consectetur, adipisci velit, sed quia non numquam eius modi tempora incidunt ut labore et dolore magnam aliquam quaerat voluptatem. Ut e
nim ad minima veniam, quis nostrum exercitationem ullam corporis suscipit laboriosam, nisi ut aliquid ex ea commodi consequatur? Quis autem vel eum iure reprehenderit qui in ea voluptate velit esse quam nihil molestiae consequatur, vel illum qui dolorem eum fugiat quo voluptas nulla pariatur?"
1914 translation by H. Rackham

"But I must explain to you how all this mistaken idea of denouncing pleasure and praising pain was born and I will give you a complete account of the system, and expound the actual teachings of the great explorer of the truth, the master-builder of human happiness. No one rejects, dislikes, or avoids pleasure itself, because it is pleasure, but because those who do not know how to pursue pleasure rationally encounter consequences that are extremely painful. Nor again is there anyone who loves or pursues or desires to obtain pain of itself, because it is pain, but because occasionally circumstances occur in which toil and pain can procure him some great pleasure. To take a trivial example, which of us ever undertakes laborious physical exercise, except to obtain some advantage from it? But who has any right to find fault with a man who chooses to enjoy a pleasure that has no annoying consequences, or one who avoids a pain that produces no resultant pleasure?"
Section 1.10.33 of "de Finibus Bonorum et Malorum", written by Cicero in 45 BC

"At vero eos et accusamus et iusto odio dignissimos ducimus qui blanditiis praesentium voluptatum deleniti atque corrupti quos dolores et quas molestias excepturi sint occaecati cupiditate non provident, similique sunt in culpa qui officia deserunt mollitia animi, id est laborum et dolorum fuga. Et harum quidem rerum facilis est et expedita distinctio. Nam libero tempore, cum soluta nobis est eligendi optio cumque nihil impedit quo minus id quod maxime placeat facere possimus, omnis voluptas assumenda est, omnis dolor repellendus. Temporibus autem quibusdam et aut officiis debitis aut rerum necessitatibus saepe eveniet ut et voluptates repudiandae sint et molestiae non recusandae. Itaque earum rerum hic tenetur a sapiente delectus, ut aut reiciendis voluptatibus maiores alias consequatur aut perferendis doloribus asperiores repellat."
'.

	! !

!TxAthensLayoutTest methodsFor: 'tests' stamp: 'IgorStasenko 8/6/2013 18:11'!
testFreshViewPositionIsAtStart
	"layout should answer text position from visual position"
	self assert: view layout startPosition equals: text startPosition! !

!TxAthensLayoutTest methodsFor: 'tests' stamp: 'IgorStasenko 8/8/2013 17:57'!
testLayoutShouldComputeExtent
	"text is not empty, so layout should be not empty either"
	self assert: view layout extent x isZero not.
	self assert: view layout extent y isZero not.
	
! !

!TxAthensLayoutTest methodsFor: 'tests' stamp: 'IgorStasenko 8/5/2013 17:21'!
testSettingViewExtent
	"layout should answer text position from visual position"
	
	
	view extent:100@100.
	
	self assert: view extent equals:100@100! !

!TxAthensLayoutTest methodsFor: 'tests' stamp: 'IgorStasenko 12/29/2013 16:20'!
testScrollToNegativeX
	"never scroll beyond layout"
	
	
	view scrollBy: -1000@0.
	
	self assert: view offset x = 0.! !

!TxAthensLayoutTest methodsFor: 'private' stamp: 'FernandoOlivero 8/25/2013 10:09'!
defaultLayoutViewExtent
	^ 100@100! !

!TxAthensLayoutTest methodsFor: 'tests' stamp: 'IgorStasenko 8/6/2013 18:08'!
testFreshViewOffsetShouldBeZero
	"initially origin should be set to 0@0 "
	
	
	self assert: view offset equals: 0@0! !

!TxAthensLayoutTest methodsFor: 'tests' stamp: 'IgorStasenko 8/6/2013 18:22'!
testFreshViewLayoutNotNil
		
	self assert: view layout isNil not ! !

!TxAthensLayoutTest methodsFor: 'tests' stamp: 'IgorStasenko 12/29/2013 16:34'!
testScrollToLargeX
	"never scroll beyond layout"

	view scrollBy: 10000@0.
	
	self assert: view offset x <= (view layout width - view extent x).! !

!TxAthensLayoutTest methodsFor: 'as yet unclassified' stamp: 'SeanDeNigris 4/3/2014 13:13'!
layout

	^ view layout.! !

!TxAthensLayoutView commentStamp: '<historical>'!
I represent a view of portion of text, laid out using specified layout 
strategy.

The view is defined using following inputs:

- position in text
- view extent (width and height)
- surface, which will be used to render the view.

I support rendering via #renderOn: method, as well as translating between view point 
and text position (but only in the area of view itself).

The surface is responsible for providing the font renderer,
which is used to measure text metrics and lay it out properly
using specified strategy and keep synchronized with what renderer
will produce on surface.

Please note, that view's layout is computed only for a portion of text (unless text fully fits into it), just neccessary to display an area visible through view,
which makes the view completely independent from the size of text.

The text layout needs to be adjusted/reset when following variables changed: 
 - a view's text position changed
 - view scrolled up/down (which indirectly changes view's text position)
 - text is modified
 - layout strategy is changed
 - drawing surface is changed 

!
!TxAthensLayoutView methodsFor: 'accessing' stamp: 'IgorStasenko 9/18/2014 17:22'!
container
	^ container! !

!TxAthensLayoutView methodsFor: 'debug rendering' stamp: 'IgorStasenko 8/26/2013 13:06'!
debugRenderOn: canvas

	"
	set up clipping
	- draw line by line
	"
	| renderer |

	canvas
		setStrokePaint: Color green;
		drawShape: (0@0 corner: self extent).

	renderer := TxTextRenderer new.
	renderer renderLines: layout lines on: canvas.
	
! !

!TxAthensLayoutView methodsFor: 'geometry' stamp: 'StephaneDucasse 2/11/2014 12:40'!
ensurePointWithinLayout: aLayoutPoint
	"Note, the layout will not extend beyond the actual text"
	[ aLayoutPoint y > layout height ] whileTrue: [ 
		" try to extend layout until we cover given point"
		layout extendOneLineDown ifFalse: [  ^ self ]		
	].

	aLayoutPoint y < 0 ifTrue: [ | y h |
		y := aLayoutPoint y.
		h := layout height.
		layout extendOneLineUp ifFalse: [ ^ self ].
		y := y - (layout height - h).
	 ]! !

!TxAthensLayoutView methodsFor: 'accessing' stamp: 'IgorStasenko 8/6/2013 14:46'!
offset
	^ offset! !

!TxAthensLayoutView methodsFor: 'testing' stamp: 'IgorStasenko 5/12/2014 16:22'!
needsHorizontalScrolling
	"Answer true, if text layout is wider than view , and therefore could use scrolling"
	^ (offset x > 0) or: [ self width < layout width ]! !

!TxAthensLayoutView methodsFor: 'accessing' stamp: 'IgorStasenko 10/29/2013 13:52'!
height
	^ extent y! !

!TxAthensLayoutView methodsFor: 'initializing' stamp: 'IgorStasenko 11/28/2013 09:35'!
resetLayout

	^ self resetLayout: layout startPosition.! !

!TxAthensLayoutView methodsFor: 'factory' stamp: 'IgorStasenko 9/18/2014 17:48'!
newEmbeddedObjectCommand: anEmbeddedObjectSpan

	^ container newEmbeddedObjectCommand: anEmbeddedObjectSpan! !

!TxAthensLayoutView methodsFor: 'geometry' stamp: 'IgorStasenko 8/27/2013 13:25'!
layoutPositionAt: aTextPosition ifOutside: aBlock
	"calculate the point at given text position, might return an invalid position (outside the layout)"
	^ self layout positionAt: aTextPosition ifOutside: aBlock! !

!TxAthensLayoutView methodsFor: 'initializing' stamp: 'IgorStasenko 9/18/2014 17:41'!
initialize

	offset := 0@0.
	announcer := Announcer new.
	container := TxAthensNullViewContainer new.! !

!TxAthensLayoutView methodsFor: 'accessing' stamp: 'IgorStasenko 8/30/2013 13:23'!
text
	^ layout text! !

!TxAthensLayoutView methodsFor: 'geometry' stamp: 'IgorStasenko 8/30/2013 16:14'!
fontMetricsProviderFor: aFont 

"aFont glyphRendererOn: surface."

	^ CairoFontMetricsProvider new 
			font: aFont ;
			yourself ! !

!TxAthensLayoutView methodsFor: 'accessing' stamp: 'IgorStasenko 8/26/2013 11:30'!
layoutStrategy: anObject
	layoutStrategy := anObject.
	self resetLayout.! !

!TxAthensLayoutView methodsFor: 'rendering' stamp: 'SeanDeNigris 4/4/2014 10:39'!
renderHighlight: anInterval with: paint on: canvas

	| renderer |
	renderer := TxHighlightRenderer highlighting: anInterval in: self with: paint.
	renderer renderHighlightOn: canvas.! !

!TxAthensLayoutView methodsFor: 'initializing' stamp: 'IgorStasenko 9/18/2014 18:21'!
layoutIsAboutToReset

	container layoutIsAboutToResetIn: self! !

!TxAthensLayoutView methodsFor: 'accessing' stamp: 'IgorStasenko 3/26/2014 14:58'!
announcer
	^ announcer! !

!TxAthensLayoutView methodsFor: 'accessing' stamp: 'IgorStasenko 8/26/2013 12:48'!
extent: aPoint 
	extent := aPoint.
	self resetLayout.! !

!TxAthensLayoutView methodsFor: 'accessing' stamp: 'IgorStasenko 8/6/2013 17:41'!
layoutStrategy
	^ layoutStrategy! !

!TxAthensLayoutView methodsFor: 'accessing' stamp: 'IgorStasenko 3/11/2014 14:04'!
visibleArea
	"Answer the approximate x@y portion of text currently visible in the view in terms of fraction 0..1"
	

	| x y |
	x := layout width / self width.
	y := self text numberOfLines / (layout endPosition lineNumber - layout startPosition lineNumber).
	
	^ x@y! !

!TxAthensLayoutView methodsFor: 'internal-masking' stamp: 'IgorStasenko 10/25/2013 04:30'!
maskCharacters: characters
	"This is a hook to possibly replace original characters , which _always_ coming from spans during scanning the text
	with something else. This method should answer a string with exactly same number of characters as in provided one.
	Default implementation just answers original characters."
	
	^ characters ! !

!TxAthensLayoutView methodsFor: 'accessing' stamp: 'IgorStasenko 10/29/2013 13:51'!
width
	^ extent x! !

!TxAthensLayoutView methodsFor: 'private ' stamp: 'IgorStasenko 12/29/2013 18:04'!
extendLayoutDown: delta
	| y heightExtended |
	y := delta.
	heightExtended := 0.
	"Note, the layout will not extend beyond the actual text"
	[ layout height < (y + extent y) ] whileTrue: [ | h |
		" try to extend layout until we cover given point"
		h := layout height.
		layout extendOneLineDown ifFalse: [ ^ heightExtended ].
		heightExtended := heightExtended + (layout height - h)
	].
	^ heightExtended
	! !

!TxAthensLayoutView methodsFor: 'accessing' stamp: 'IgorStasenko 9/18/2014 17:22'!
container: anObject
	container := anObject! !

!TxAthensLayoutView methodsFor: 'testing' stamp: 'IgorStasenko 5/12/2014 16:29'!
needsVerticalScrolling
	"Answer true if, vertically, text are not fitting completely inside a view, and may use vertical scrolling.
	
	This is simple: if it fits completely, layout start = text start, layout end = text end
	"
	
	^ (layout startPosition isAtStart and: [ layout endPosition isAtEnd]) not! !

!TxAthensLayoutView methodsFor: 'rendering' stamp: 'IgorStasenko 10/30/2013 14:44'!
renderOn: canvas

	"
	set up clipping
	- draw line by line
	"
	| renderer |

	canvas pathTransform restoreAfter: [

		canvas pathTransform translateBy: offset negated.
			
		renderer := TxTextRenderer new.
		renderer renderLines: layout lines on: canvas.
	
	]! !

!TxAthensLayoutView methodsFor: 'scrolling' stamp: 'AlainPlantec 1/12/2015 21:58'!
scrollIntoView: aTextPosition margin: visibleMargin

	"Scroll the view so, that given position is fully visible inside a view.
	The margin controls the minimal offset from view border and given position.
	"
	
	"Simple case first: position is inside a layout"
	| margin |
	
	margin := visibleMargin asMargin.
	
	(layout interval contains: aTextPosition) ifTrue: [ 
		
		| layoutPos deltaX newXOffset deltaY newYOffset |
	
		layoutPos := self layoutPositionAt: aTextPosition ifOutside: [  self error: 'should not happen' ].
		
		deltaX := layoutPos horizontalOffset - offset x. 
		
		newXOffset := offset x.
		"position to the left from current view"
		deltaX < margin left 
			ifTrue: [ 
				 newXOffset := layoutPos horizontalOffset - margin left ].

		"position to the right from current view"
		deltaX > (self width - margin right)
			ifTrue: [ newXOffset := layoutPos horizontalOffset - self width + margin right  ].
		
		"Just to be sure, check side constraints"
		newXOffset + self width > (layout extent x + margin right) ifTrue: [ 
			newXOffset := layout extent x + margin right - self width ].
		newXOffset < 0 ifTrue: [  newXOffset := 0 ].

		"now check vertical offset(s)"
		newYOffset := offset y.
		deltaY := layoutPos bottomPointInView y + margin bottom - self height. 
		deltaY > 0 ifTrue: [ 
			newYOffset := layoutPos bottomPoint y + margin bottom - self height.
			 ].
		
		deltaY := layoutPos topPoint y.
		deltaY < newYOffset ifTrue: [ newYOffset := deltaY ].
		
		offset := newXOffset @ newYOffset.	
		"make sure layout fully covers the view after scrolling"
		self ensurePointWithinLayout: (0@(offset y + self height)).
		self ensurePointWithinLayout: (0@offset y).
		"compact the layout"
		self compact. 
			
	] ifFalse: [  | repeat |
		repeat := true.
		"position is outside of current layout"
		aTextPosition > layout endPosition ifTrue: [ 
			[repeat and: [aTextPosition > layout endPosition] ] 
				whileTrue: [ repeat := layout extendOneLineDown ]
		] ifFalse: [ 
			[repeat and: [aTextPosition < layout startPosition]] 
				whileTrue: [ repeat := layout extendOneLineUp ]
		 ].
		"repeat"
		repeat ifTrue: [ ^ self scrollIntoView: aTextPosition margin: visibleMargin ]
	].

	self announceViewChanged.
! !

!TxAthensLayoutView methodsFor: 'geometry' stamp: 'IgorStasenko 11/29/2013 16:54'!
textPositionAt: aPoint
	"Answer the text position closest to given point in view"
	^ self layout textPositionAt: aPoint + offset ! !

!TxAthensLayoutView methodsFor: 'accessing' stamp: 'IgorStasenko 8/6/2013 18:12'!
layout
	^ layout! !

!TxAthensLayoutView methodsFor: 'scrolling' stamp: 'BenComan 3/29/2015 14:40'!
scrollBy: aPoint
	"Scroll receiver by some offset"
	| x y  |
	
	x := offset x + aPoint x.
	y := offset y + aPoint y.


	[y < 0] whileTrue: [ | h |
		h := layout height.
		layout extendOneLineUp 
			ifFalse: [ y :=0 ]
			ifTrue: [ y := y + (layout height - h) ].
	 ].

	aPoint y > 0 ifTrue:[
		self extendLayoutDown: y ].

	"Don't scroll beyond layout"
	x := (x min: layout width - extent x) max: 0. 
	y := (y min: layout height - extent y) max: 0.

	offset := x@y.	
	self compact.
	self announceViewChanged.! !

!TxAthensLayoutView methodsFor: 'geometry' stamp: 'IgorStasenko 9/18/2014 17:03'!
compact
	"remove lines which vent outside of view and no longer visible"
	offset := offset x @ layout compact.! !

!TxAthensLayoutView methodsFor: 'defaults' stamp: 'IgorStasenko 11/28/2013 10:15'!
defaultStrategy
	^  TxAthensNoWrapStrategy  new! !

!TxAthensLayoutView methodsFor: 'accessing' stamp: 'IgorStasenko 8/5/2013 17:25'!
extent
	^ extent! !

!TxAthensLayoutView methodsFor: 'view notifications' stamp: 'IgorStasenko 9/18/2014 18:46'!
hideEmbeddedObject: morph
	container hideEmbeddedObject: morph! !

!TxAthensLayoutView methodsFor: 'private ' stamp: 'IgorStasenko 12/19/2013 15:54'!
privSetVerticalOffset: y

	offset := offset x @ y! !

!TxAthensLayoutView methodsFor: 'announcements' stamp: 'IgorStasenko 9/18/2014 17:41'!
announceViewChanged

	announcer announce: (TxLayoutViewChanged new view:self).
	container viewChanged: self.! !

!TxAthensLayoutView methodsFor: 'initializing' stamp: 'AlainPlantec 1/12/2015 18:08'!
resetLayout: startPosition
	| pos |
	
	"Always align with line start"
	self layoutIsAboutToReset.
	
	pos := startPosition asPosition moveToLineStart.	
	pos span prev isAtStart ifTrue: [ pos := pos moveLeft ].

	layout := TxAthensLayout new view: self.
	layout initializePosition: pos strategy: layoutStrategy.
	
	"Keep scanning until it's enough to fill the view"
	[  		
		extent y + offset y > layout height
	] whileTrue: [ 
		"or nothing more to scan"

		layout extendOneLineDown ifFalse: [ ^ self announceViewChanged ] .	
	].

	self announceViewChanged! !

!TxAthensLayoutView methodsFor: 'initializing' stamp: 'IgorStasenko 11/28/2013 09:35'!
initWithStrategy: aLayoutStrategy position: aStartPosition extent: aPoint
	
	offset := 0@0.
	layoutStrategy := aLayoutStrategy.
	extent := aPoint.
	
	self resetLayout: aStartPosition! !

!TxAthensLayoutView methodsFor: 'initializing' stamp: 'FernandoOlivero 8/26/2013 16:11'!
initWithPosition: aStartPosition extent: aPoint
	
	
	^ self initWithStrategy: self defaultStrategy position: aStartPosition extent: aPoint! !

!TxAthensLayoutView class methodsFor: 'instance creation' stamp: 'IgorStasenko 8/30/2013 13:26'!
on: aTxModel extent: aPoint
	^ self new
		initWithPosition: aTxModel startPosition extent: aPoint
! !

!TxAthensLayoutView class methodsFor: 'instance creation' stamp: 'IgorStasenko 9/18/2014 18:00'!
on: aTxModel extent: aPoint container: aContainer
	^ self new
		container: aContainer;
		initWithPosition: aTxModel startPosition extent: aPoint
! !

!TxAthensNoWrapStrategy commentStamp: 'IgorStasenko 5/9/2014 17:41'!
I'm a layout strategy that computes the layout of each text line from the starting position to the end of the line.

Therefore, I compute the line as it is,  and its up to the view to clip all the characters outside of the layout view's extent.

!
!TxAthensNoWrapStrategy methodsFor: 'visiting' stamp: 'IgorStasenko 8/7/2014 15:16'!
visitCharacterSpan: aSpan
	
	| chars startPos font w  fontMetricsProvider |
	
	chars := aSpan characters.
	
	startPos := currentPosition spanPosition.
	startPos = 0 ifTrue: [  startPos := 1 ].
	
	font := aSpan getAttribute: TxFontAttribute.  
	
	fontMetricsProvider := self fontMetricsProviderFor: font.
	currentLine accumulateHeight: fontMetricsProvider fontHeight.
	currentLine accumulateAscent: fontMetricsProvider fontAscent.
	
	w := 0.
	startPos to: chars size do: [ :i | | char tabAdvance |
		char := chars at: i.
		char == Character tab 
			ifTrue: [ 
				i > startPos ifTrue: [ 
					currentLine addWidth: w.

					currentLine addCommand: (fontMetricsProvider 
						newCharacterSpanDisplayCommand: aSpan
						start: startPos
						stop: i-1
						advance: w@0).
					].
					tabAdvance := (self alignTab: font).
					currentLine addCommand: (fontMetricsProvider 
						newTabDisplayCommand: aSpan
						start: i-1
						stop: i
						advance: tabAdvance).
						
					currentLine addWidth: tabAdvance x.
					
					^ aSpan positionAt: i+1.
			 ]	
			ifFalse: [ w := w + (fontMetricsProvider getGlyphWidth: (chars at:i)) ]
			
	].
	currentLine addWidth: w.

	currentLine addCommand: (fontMetricsProvider 
		newCharacterSpanDisplayCommand: aSpan
		start: startPos
		stop: aSpan size
		advance: w@0).
		
	^ aSpan next startPosition! !

!TxAthensNullViewContainer commentStamp: 'IgorStasenko 9/18/2014 17:39'!
A view container is responsible is responsible for taking care about platform-specific duties like connecting view with outer world (like Morphic) in order to handle events etc.
A null container simply ignores all notifications from view.!
!TxAthensNullViewContainer methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 9/18/2014 18:22'!
layoutIsAboutToResetIn: view
	"ignored"! !

!TxAthensNullViewContainer methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 9/18/2014 17:42'!
viewChanged: layoutView
	"Received when view is changed, including scrolling or full reset of it.
	Ignored"! !

!TxAthensNullViewContainer methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 9/18/2014 17:54'!
newEmbeddedObjectCommand: aTxEmbeddedObjectSpan 

	self error: 'This container does not supports embedded objects in text'.! !

!TxAthensRenderingTest class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/23/2013 14:11'!
newText
	| text |
	text := TxModel new.
	
	text endPosition insert: '"Lorem
ipsum dolor sit
amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum."
Section 1.10.32 of "de Finibus Bonorum et Malorum", written by Cicero in 45 BC

"Sed ut perspiciatis unde omnis iste natus error sit voluptatem accusantium doloremque laudantium, totam rem aperiam, eaque ipsa quae ab illo inventore veritatis et quasi architecto beatae vitae dicta sunt explicabo. Nemo enim ipsam voluptatem quia voluptas sit aspernatur aut odit aut fugit, sed quia consequuntur magni dolores eos qui ratione voluptatem sequi nesciunt. Neque porro quisquam est, qui dolorem ipsum quia dolor sit amet, consectetur, adipisci velit, sed quia non numquam eius modi tempora incidunt ut labore et dolore magnam aliquam quaerat voluptatem. Ut enim ad minima veniam, quis nostrum exercitationem ullam corporis suscipit laboriosam, nisi ut aliquid ex ea commodi consequatur? Quis autem vel eum iure reprehenderit qui in ea voluptate velit esse quam nihil molestiae consequatur, vel illum qui dolorem eum fugiat quo voluptas nulla pariatur?"
1914 translation by H. Rackham

"But I must explain to you how all this mistaken idea of denouncing pleasure and praising pain was born and I will give you a complete account of the system, and expound the actual teachings of the great explorer of the truth, the master-builder of human happiness. No one rejects, dislikes, or avoids pleasure itself, because it is pleasure, but because those who do not know how to pursue pleasure rationally encounter consequences that are extremely painful. Nor again is there anyone who loves or pursues or desires to obtain pain of itself, because it is pain, but because occasionally circumstances occur in which toil and pain can procure him some great pleasure. To take a trivial example, which of us ever undertakes laborious physical exercise, except to obtain some advantage from it? But who has any right to find fault with a man who chooses to enjoy a pleasure that has no annoying consequences, or one who avoids a pain that produces no resultant pleasure?"
Section 1.10.33 of "de Finibus Bonorum et Malorum", written by Cicero in 45 BC

"At vero eos et accusamus et iusto odio dignissimos ducimus qui blanditiis praesentium voluptatum deleniti atque corrupti quos dolores et quas molestias excepturi sint occaecati cupiditate non provident, similique sunt in culpa qui officia deserunt mollitia animi, id est laborum et dolorum fuga. Et harum quidem rerum facilis est et expedita distinctio. Nam libero tempore, cum soluta nobis est eligendi optio cumque nihil impedit quo minus id quod maxime placeat facere possimus, omnis voluptas assumenda est, omnis dolor repellendus. Temporibus autem quibusdam et aut officiis debitis aut rerum necessitatibus saepe eveniet ut et voluptates repudiandae sint et molestiae non recusandae. Itaque earum rerum hic tenetur a sapiente delectus, ut aut reiciendis voluptatibus maiores alias consequatur aut perferendis doloribus asperiores repellat."
'.

	^ text! !

!TxAthensRenderingTest class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 9/12/2013 12:56'!
test
	| text view  sceneView sel |
	text := self newText.
	
	sel := text select all.

	sel applyAttribute: (TxFontAttribute with: (LogicalFont familyName: 'Arial'
 pointSize: 10)).

	sel end 
		moveToStart;
		moveRight: 22.
	sel
		applyAttribute: (TxFontAttribute with: (LogicalFont familyName: 'Tahoma'
 pointSize: 20)).
	view := nil.
	
	sceneView := AthensSceneView new scene:
		[ :canvas |
			view ifNil: [ 
				view := TxAthensLayoutView surface: canvas surface on:text extent:300@200.
				 ].
			view surface: canvas surface.
			view renderOn: canvas.
		 ].
	^ sceneView openInWindow.
! !

!TxAthensTextTest methodsFor: 'private' stamp: 'FernandoOlivero 8/26/2013 17:16'!
newViewOn: aText 
	| layoutView |
	layoutView :=  TxAthensLayoutView on: aText extent: self defaultLayoutViewExtent.
	layoutView layoutStrategy: self defaultStrategy.
	^ layoutView! !

!TxAthensTextTest methodsFor: 'private' stamp: 'FernandoOlivero 8/26/2013 17:17'!
defaultStrategy
	^ TxAthensNoWrapStrategy new! !

!TxAthensTextTest methodsFor: 'private' stamp: 'IgorStasenko 8/30/2013 13:39'!
newText: aString
	| text |
	text := TxModel new.
	text endPosition insert:  aString.
	^ text! !

!TxAthensTextTransformsTest methodsFor: 'private' stamp: 'FernandoOlivero 8/26/2013 17:15'!
defaultLayoutViewExtent
	^ 100@500.! !

!TxAthensTextTransformsTest methodsFor: 'private' stamp: 'FernandoOlivero 8/26/2013 17:17'!
defaultStrategy
	^ TxAthensCharacterWrappingStrategy new! !

!TxAthensTextTransformsTest methodsFor: 'private' stamp: 'FernandoOlivero 8/26/2013 15:57'!
defaultText
	^ 'The view coordinates should be properly transformed into a text position to interact with a text being displayed'! !

!TxAthensTextTransformsTest methodsFor: 'running' stamp: 'FernandoOlivero 8/26/2013 15:55'!
setUp
	| text |
	text := self newText: self defaultText.
	view := self newViewOn: text.! !

!TxAttribute commentStamp: '<historical>'!
I am separate property which can be applied to single text span.
The concerete meaning or purpose of property defined by my subclasses.!
!TxAttribute methodsFor: 'comparing' stamp: 'IgorStasenko 9/17/2012 14:55'!
hash
	^ self species hash! !

!TxAttribute methodsFor: 'accessing' stamp: 'DenisKudryashov 1/19/2013 23:45'!
value
	^ value! !

!TxAttribute methodsFor: 'comparing' stamp: 'IgorStasenko 10/25/2013 14:06'!
= anObject
	^  self species == anObject species and: [ value = anObject value ]! !

!TxAttribute methodsFor: 'accessing' stamp: 'DenisKudryashov 1/19/2013 23:45'!
value: anObject
	value := anObject! !

!TxAttribute class methodsFor: 'instance creation' stamp: 'DenisKudryashov 1/20/2013 01:03'!
with: valueObject
	^self new 
		value: valueObject ! !

!TxAttribute class methodsFor: 'defaults' stamp: 'IgorStasenko 8/29/2014 15:33'!
defaultValue
	self subclassResponsibility! !

!TxBackColorAttribute commentStamp: '<historical>'!
I represent background color attribute for text span!
!TxBackColorAttribute class methodsFor: 'defaults' stamp: 'IgorStasenko 8/29/2014 15:33'!
defaultValue
	^ Color white! !

!TxBasicSpan commentStamp: '<historical>'!
I am abtract class, representing a portion of text (span).
I form a double-linked list with my neighbour spans and full list as result form the contents of text.

Spans could have attributes and size. Size determines the number of positions which span can contain (number of positions is always = size +1).
For instance a character span with 2 characters 'AB' , can have 3 different positions:
 |AB
 A|B
 AB|

where '|' showing the position in span and ranged from 0 to 2.
Like that TxTextPosition can navigate inside a span (using moveLeft/moveRight commands),
without actually needing to deal with strings, characters or anything else.!
!TxBasicSpan methodsFor: 'enumerating' stamp: 'IgorStasenko 6/10/2013 17:08'!
last
	| span |
	span := self.
	[ span next == span ] whileFalse: [ span := span next ].
	^ span! !

!TxBasicSpan methodsFor: 'private' stamp: 'IgorStasenko 9/17/2012 14:50'!
basicNext: anObject
	
	next := anObject! !

!TxBasicSpan methodsFor: 'testing' stamp: 'IgorStasenko 6/7/2013 17:29'!
isAtEnd
	^ false! !

!TxBasicSpan methodsFor: 'accessing' stamp: 'IgorStasenko 9/17/2012 15:45'!
lastInsertPosition
	^ 0! !

!TxBasicSpan methodsFor: 'accessing' stamp: 'IgorStasenko 10/14/2012 09:58'!
nextIfNone: aBlock
	
	^ next == self ifTrue: [ aBlock value] ifFalse: [ next ]! !

!TxBasicSpan methodsFor: 'accessing' stamp: 'IgorStasenko 6/10/2013 17:34'!
numberOfLinesBefore
	"Count the number of lines just before the receiver"
	| number |
	number := 1.
	text spansDo: [:span |
		span == self ifTrue: [ ^ number ].
		span isLineSeparator ifTrue: [ number := number + 1].
		].

	self error: 'cannot happen'! !

!TxBasicSpan methodsFor: 'accessing' stamp: 'IgorStasenko 10/14/2012 09:57'!
prevIfNone: aBlock
	
	^ prev == self ifTrue: [ aBlock value] ifFalse: [ prev ]! !

!TxBasicSpan methodsFor: 'testing' stamp: 'IgorStasenko 10/23/2013 19:31'!
< aSpan
	"Answer true if receiver is closer to start of the text than argument, false otherwise.
	Note, spans must belong to same text"
	
	|  forward backward  |
	
	text == aSpan text ifFalse: [ self error: 'Cannot compare positions belonging to different text' ].

	"equivalent case first"
	self == aSpan ifTrue: [  ^ false ].
	
	"go both ways: forward and backward.. and see where is span relative to receiver"
	forward := backward := self.
	 [
		forward := forward next.
		backward := backward prev.
	
		forward == aSpan ifTrue: [ ^ true ].
		backward == aSpan ifTrue: [ ^ false ].
		
		"reached start"
		backward isAtStart ifTrue: [ ^ true ]. 
		"reached end"
		forward isAtEnd ifTrue: [ ^ false ].
		
	] repeat.
	! !

!TxBasicSpan methodsFor: 'accessing' stamp: 'IgorStasenko 9/17/2012 16:37'!
prev: anObject
	
	self basicPrev: anObject.
	anObject basicNext: self.
	^ anObject! !

!TxBasicSpan methodsFor: 'operation' stamp: 'IgorStasenko 8/26/2014 15:06'!
deleteUpTo: end startingAt: start
	"start and end pointing to receiver, nothing to remove"
	self assert: start span == self.
	
	end span == self ifTrue: [
		start spanPosition > 0 ifTrue: [ "nothing to delete" ^ end ].
		end spanPosition = 1 ifTrue: [ self delete. ^ next startPosition ].
		^ end
	].
	
	start spanPosition = 0 ifTrue: [
		self delete.
	].
	^ next deleteUpTo: end startingAt: next startPosition.
! !

!TxBasicSpan methodsFor: 'initialize-release' stamp: 'IgorStasenko 10/14/2012 08:07'!
initialize
	next := prev := self! !

!TxBasicSpan methodsFor: 'operation' stamp: 'IgorStasenko 10/2/2014 18:08'!
tryMergeWithNextPreserving: selection
	"Applicable only to character spans"
	^ self! !

!TxBasicSpan methodsFor: 'visitor' stamp: 'IgorStasenko 8/8/2013 03:45'!
accept: anObject
	"visitor pattern"
	
	self subclassResponsibility ! !

!TxBasicSpan methodsFor: 'printing' stamp: 'IgorStasenko 4/10/2014 15:57'!
asStringOn: aStream upTo: index
	self asStringOn: aStream startingAt: 0 upTo: index.! !

!TxBasicSpan methodsFor: 'accessing' stamp: 'IgorStasenko 10/14/2012 08:50'!
insertNext: aSpans
	"insert new span(s) after receiver. "
	| oldNext |
	oldNext := next.
	aSpans prev: self.
	
	(oldNext == self)
		ifFalse: [ aSpans last next: oldNext ].

	^ aSpans! !

!TxBasicSpan methodsFor: 'testing' stamp: 'IgorStasenko 6/10/2013 22:14'!
isAtLineStart: spanPosition
	"just after the line start"
	^ spanPosition = 0 and: [ prev isLineSeparator ]! !

!TxBasicSpan methodsFor: 'accessing' stamp: 'IgorStasenko 10/14/2012 05:27'!
lineNumber
	| number |
	number := 1.
	text spansDo: [:span |
		span isLineSeparator ifTrue: [ number := number + 1].
		span == self ifTrue: [ ^ number ].
		].

	self error: 'cannot happen'! !

!TxBasicSpan methodsFor: 'accessing' stamp: 'CamilloBruni 10/11/2012 20:17'!
lineStartSpanIfNone: aBlock
	self reverseDo: [ :span | 
		span isAtLineStart ifTrue: [ ^ span ]].
	^ aBlock value ! !

!TxBasicSpan methodsFor: 'operation' stamp: 'IgorStasenko 6/7/2013 16:37'!
insertNewLine: aString 
	"Insert a newline then the String"
	| newline chars |
	newline := text newLineSeparator.
	aString isEmpty ifTrue: [ self insertNext: newline. ^ newline ].
	chars := text newCharacterSpan: aString.
	newline next: chars.
	self insertNext: newline.
	^ chars! !

!TxBasicSpan methodsFor: 'accessing' stamp: 'CamilloBruni 10/11/2012 20:19'!
lineStartSpan
	" return the closest line start span "
	self reverseDo: [ :span | 
		span isAtLineStart ifTrue: [ ^ span ]].
	Error signal: 'Should not happen'.! !

!TxBasicSpan methodsFor: 'accessing-text position' stamp: 'IgorStasenko 9/20/2013 02:14'!
positionAt: characterIndex
	^ TxTextPosition span: self spanPosition: characterIndex! !

!TxBasicSpan methodsFor: 'initialize-release' stamp: 'IgorStasenko 8/29/2014 16:30'!
initWithText: anObject
	
	text := anObject! !

!TxBasicSpan methodsFor: 'accessing-text position' stamp: 'IgorStasenko 6/7/2013 14:41'!
startPosition
	"answer the text position, pointing to the start of receiver"
	self subclassResponsibility! !

!TxBasicSpan methodsFor: 'testing' stamp: 'IgorStasenko 10/14/2012 08:27'!
isAtLineStart
	^ self isAtStart or: [ self prev isLineSeparator ]! !

!TxBasicSpan methodsFor: 'operation' stamp: 'IgorStasenko 9/2/2014 13:14'!
at: txPosition insert: aString
	"
	Insert a possibly multi-line string at given position of receiver.
	Answer the position past the last character of inserted string.
	The inserted portion of text must have same attributes as insertion point.
	"

	| position first insertAttributes |
	position := txPosition.
	first := true.
	insertAttributes := self styleAtPosition: txPosition.

	self string: aString linesDo: [:chars |
		
		first 
			ifTrue: [ first := false. ]
			ifFalse: [ 
				| separator |
				separator := text newLineSeparator replaceAttributes: insertAttributes.
				position := position span insertLineSeparator: separator at: position ].

		chars size > 0 ifTrue: [
			position := position span insertCharacters: chars at: position attributes: insertAttributes
			]  
	].
	^ position! !

!TxBasicSpan methodsFor: 'accessing' stamp: 'IgorStasenko 9/17/2012 16:37'!
next: anObject
	
	self basicNext: anObject.
	anObject basicPrev: self.
	^ anObject! !

!TxBasicSpan methodsFor: 'accessing' stamp: 'IgorStasenko 10/14/2012 09:39'!
lineEndSpan
	"Answer the last span in the same line as receiver" 
	self do: [ :span | 
		span isAtLineEnd ifTrue: [ ^ span ]].
	Error signal: 'Should not happen'.! !

!TxBasicSpan methodsFor: 'operation' stamp: 'IgorStasenko 8/21/2014 11:59'!
at: txPosition insertObject: anObject
	"
	Insert an embedded object at given position into the receiver
	"

	| newSpan |
	
	newSpan := TxEmbeddedObjectSpan text: self text.
	newSpan object: anObject.
	
	txPosition isAtSpanStart 
		ifTrue: [  self insertPrev: newSpan. ^ txPosition ].
	txPosition isAtSpanEnd 
		ifTrue: [  self insertNext: newSpan. ^ self next endPosition ].
	
	"split & insert"
	self splitAt: txPosition spanPosition.
	self insertNext: newSpan.
	^ self next endPosition 	

! !

!TxBasicSpan methodsFor: 'operation' stamp: 'CamilloBruni 10/11/2012 21:30'!
delete
	"remove myself from the span list".
	prev next: next.! !

!TxBasicSpan methodsFor: 'enumerating' stamp: 'IgorStasenko 10/14/2012 10:00'!
reverseDo: aBlock
	| span |
	span := self.
	
	[ aBlock value: span. span := span prevIfNone: [ ^ self ] ] repeat! !

!TxBasicSpan methodsFor: 'testing' stamp: 'IgorStasenko 6/10/2013 16:34'!
isCharacterSpan
	^ false! !

!TxBasicSpan methodsFor: 'accessing' stamp: 'CamilloBruni 10/11/2012 20:29'!
sizeToLineEnd
	| size |
	size := 0.
	self do: [ :span| 
		size := size + span size.
		span isAtLineEnd ifTrue: [ ^ size ]].
	Error signal: 'Should not happen!!'.! !

!TxBasicSpan methodsFor: 'testing' stamp: 'IgorStasenko 10/14/2012 05:27'!
isLineSeparator
	^ false! !

!TxBasicSpan methodsFor: 'operation' stamp: 'IgorStasenko 10/14/2012 09:40'!
nextLineIfNone: aBlock
	| span |
	
	span := self lineEndSpan.
	span isAtEnd ifTrue: [ ^ aBlock value ].
	^ span next next! !

!TxBasicSpan methodsFor: 'printing' stamp: 'IgorStasenko 9/17/2012 16:50'!
asStringOn: aStream
	"specialize in subclasses	"! !

!TxBasicSpan methodsFor: 'enumerating' stamp: 'CamilloBruni 9/18/2012 16:19'!
spanAndPositionDo:  aBlock
	| position |
	position := 0.
	self do: [ :span|
		aBlock value: span value: position.
		position := position + span size ]! !

!TxBasicSpan methodsFor: 'private' stamp: 'IgorStasenko 8/27/2014 13:09'!
string: aString linesDo: aBlock

	| stream cr current|
	
	stream := aString readStream.
	current := String new writeStream.
	cr := Character cr.
	
	[ stream atEnd ] whileFalse: [ | c |
		(c := stream next) == cr ifTrue: [
			aBlock value: current contents.
			current := String new writeStream ]
		ifFalse: [ current nextPut: c ]
	].
	aBlock value: current contents! !

!TxBasicSpan methodsFor: 'accessing' stamp: 'IgorStasenko 9/2/2014 13:15'!
styleAtPosition: txPosition 

	"The receiver's attributes is defined for the next line,
	however a text position pointing to beginning of receiver is formally an insertion point belonging
	to previous line, therefore we must use previous span attributes"
	
	^ self style! !

!TxBasicSpan methodsFor: 'enumerating' stamp: 'IgorStasenko 10/14/2012 08:30'!
first
	| span |
	span := self.
	[ span isAtStart ] whileFalse: [ span := span prev ].
	^ span! !

!TxBasicSpan methodsFor: 'accessing' stamp: 'IgorStasenko 6/7/2013 16:27'!
lineNumberAt: aTxTextPosition 
	self subclassResponsibility.! !

!TxBasicSpan methodsFor: 'accessing' stamp: 'IgorStasenko 9/17/2012 14:37'!
next
	
	^ next! !

!TxBasicSpan methodsFor: 'attributes' stamp: 'IgorStasenko 6/4/2013 18:01'!
applyAttribute: anAttribute from: startPosition to: endPosition
	
	"Apply attribute to receiver.
	
	If start position not points to receiver, it means the start of span covered by attribute,
	if endPosition not points to receiver , it means end of span covered by attribute.
	
	Else, they define a split point.

	
	4 cases: 
		- span already has given attribute (so do nothing )
		- start/end covers entire span (just add attribute)
		- split on 2 spans if start or end is at end of span 
		- split on 3 spans both start and end in the middle or span
	"

	
	self subclassResponsibility ! !

!TxBasicSpan methodsFor: 'printing' stamp: 'DenisKudrayshov 4/28/2013 17:37'!
printTextOn: aStream upTo: endSpan 
	self do: [ :eachSpan |
		
		eachSpan == endSpan ifTrue: [ ^self ].
		eachSpan asStringOn: aStream.			
		
	 ]

		! !

!TxBasicSpan methodsFor: 'accessing' stamp: 'IgorStasenko 9/17/2012 14:37'!
text
	
	^ text! !

!TxBasicSpan methodsFor: 'accessing-text position' stamp: 'IgorStasenko 6/7/2013 14:42'!
endPosition
	"answer the text position, pointing to the end of receiver"
	self subclassResponsibility! !

!TxBasicSpan methodsFor: 'accessing' stamp: 'IgorStasenko 10/14/2012 10:22'!
insertPrev: aSpan
	
	self isAtStart 
		ifFalse: [ aSpan prev: prev ].
	aSpan next: self.
	^ aSpan
! !

!TxBasicSpan methodsFor: 'printing' stamp: 'IgorStasenko 10/14/2012 08:35'!
printOn: aStream

	self isAtStart ifTrue: [ aStream nextPutAll: '<< ' ].
	self printContentsOn: aStream.
	self isAtEnd ifTrue: [ aStream nextPutAll: ' >>' ].! !

!TxBasicSpan methodsFor: 'attributes' stamp: 'IgorStasenko 6/11/2013 02:43'!
replaceAttributes: newAttributes
	"replace receiver's attributes by copying from given one"
	self subclassResponsibility ! !

!TxBasicSpan methodsFor: 'testing' stamp: 'CamilloBruni 9/18/2012 15:31'!
isLastPosition: aNumber
	^ false! !

!TxBasicSpan methodsFor: 'attributes' stamp: 'IgorStasenko 6/4/2013 17:28'!
applyAttribute: anAttribute

	self subclassResponsibility ! !

!TxBasicSpan methodsFor: 'printing' stamp: 'IgorStasenko 4/10/2014 15:58'!
asStringOn: aStream startingAt: startIndex upTo: endIndex
	"specialized in subclasses"! !

!TxBasicSpan methodsFor: 'private' stamp: 'IgorStasenko 6/11/2013 02:09'!
splitLinesOf: aString


	| lines |
	
	lines := OrderedCollection new.
	self string: aString linesDo: [:line | lines add: line ].

	^ lines! !

!TxBasicSpan methodsFor: 'operation' stamp: 'IgorStasenko 6/14/2013 18:02'!
tryMergeWithNext
	"Applicable only to character spans"
	^ self! !

!TxBasicSpan methodsFor: 'testing' stamp: 'IgorStasenko 6/7/2013 17:29'!
isAtStart
	^ false! !

!TxBasicSpan methodsFor: 'testing' stamp: 'IgorStasenko 10/14/2012 09:43'!
isAtLineEnd
	^ self isAtEnd or: [ next isLineSeparator ]! !

!TxBasicSpan methodsFor: 'operation' stamp: 'IgorStasenko 6/11/2013 03:05'!
insertCharacters: chars at: position attributes: insertAttributes

	"Insert characters (no line separators allowed!!!!!!), with given attributes at given position into receiver.
	Answer the end position of inserted characters"

	
	self subclassResponsibility ! !

!TxBasicSpan methodsFor: 'private' stamp: 'IgorStasenko 9/17/2012 14:45'!
basicPrev: anObject
	
	prev := anObject! !

!TxBasicSpan methodsFor: 'attributes' stamp: 'IgorStasenko 9/2/2014 13:18'!
getAttribute: anAttributeClass

	^self style get: anAttributeClass ifAbsent: [ text getAttribute: anAttributeClass ] ! !

!TxBasicSpan methodsFor: 'copying' stamp: 'IgorStasenko 10/11/2013 13:43'!
appendCopyTo: anotherText
	"Create a copy of receiver and append it to the another text (at the end of it).
	Answer the copy"
	
	self subclassResponsibility ! !

!TxBasicSpan methodsFor: 'accessing' stamp: 'IgorStasenko 10/23/2014 16:19'!
characterBeforePosition: spanPosition ifNone: aBlock

	"Answer character which is right before the position, located in receiver
	or evaluate a block if there's none"
	^ aBlock value! !

!TxBasicSpan methodsFor: 'accessing' stamp: 'IgorStasenko 9/17/2012 14:37'!
prev
	
	^ prev! !

!TxBasicSpan methodsFor: 'enumerating' stamp: 'IgorStasenko 10/14/2012 10:00'!
do: aBlock
	| span |
	span := self.
	[ aBlock value: span. span := span nextIfNone: [ ^ self ] ] repeat.! !

!TxBasicSpan methodsFor: 'accessing' stamp: 'CamilloBruni 10/11/2012 20:27'!
lineSize
	^ self lineStartSpan sizeToLineEnd ! !

!TxBasicSpan methodsFor: 'accessing' stamp: 'IgorStasenko 10/14/2012 10:38'!
nextLineSeparatorIfNone: aBlock
	"Find a nearest line separator next to receiver or evaluate a block if none found"
	
	| span |
	span := self.
	[ span := span nextIfNone: aBlock. span isLineSeparator ] whileFalse.
	^ span! !

!TxBasicSpan methodsFor: 'accessing' stamp: 'IgorStasenko 9/10/2014 15:50'!
attributeAt: anAttributeClass
	^ self style get: anAttributeClass! !

!TxBasicSpan class methodsFor: 'instance creation' stamp: 'IgorStasenko 8/29/2014 16:30'!
text: aTxModel
	^ self new
		initWithText: aTxModel;
		yourself! !

!TxBasicTextPosition commentStamp: '<historical>'!
i am abstract class, defining protocol for text position.!
!TxBasicTextPosition methodsFor: 'operations' stamp: 'IgorStasenko 8/21/2014 11:48'!
insert: aString 
	"
	Insert a possibly multi-line string at given position of receiver.
	Answer the position right after the last character of inserted string.
	The inserted portion of will inherit same attributes as current position attributes.
	"
	self subclassResponsibility ! !

!TxBasicTextPosition methodsFor: 'testing' stamp: 'IgorStasenko 9/20/2013 01:30'!
isAtEnd
	"Answer true if receiver points to the end of text"
	^ self span next isAtEnd and: [ self spanPosition = self span size ]! !

!TxBasicTextPosition methodsFor: 'comparing' stamp: 'IgorStasenko 9/20/2013 01:37'!
hasSamePositionAs: position
	"Answer true if receiver having same position (in terms of text index) as another position.
	See #textIndex for explanation of text index"
	
	self span == position span ifTrue: [	^ self spanPosition = position spanPosition ].
		
	(self isAtSpanStart and: [ position isAtSpanEnd and: [ self span prev = position span]])
			ifTrue: [ ^ true ].

	(self isAtSpanEnd and: [ position isAtSpanStart and: [ self span next = position span]])
		ifTrue: [ ^ true ].
	
	^ false! !

!TxBasicTextPosition methodsFor: 'navigation' stamp: 'IgorStasenko 9/20/2013 12:40'!
moveLeft: number
	self subclassResponsibility ! !

!TxBasicTextPosition methodsFor: 'navigation' stamp: 'IgorStasenko 9/20/2013 12:41'!
moveToLineEnd
	self subclassResponsibility ! !

!TxBasicTextPosition methodsFor: 'comparing' stamp: 'IgorStasenko 10/23/2013 19:32'!
< aPosition
	"Answer true if receiver is closer to start of the text than argument, false otherwise.
	Note, both positions should belong to same text"
		
	aPosition text == self text ifFalse: [ self error: 'Cannot compare positions belonging to different text' ].

	"local case first"
	self span == aPosition span ifTrue: [ 
		^ self spanPosition < aPosition spanPosition
	].
	
	^ self span < aPosition span! !

!TxBasicTextPosition methodsFor: 'testing' stamp: 'IgorStasenko 9/20/2013 01:27'!
isAtSpanEnd
	^ self span isLastPosition: self spanPosition! !

!TxBasicTextPosition methodsFor: 'printing' stamp: 'IgorStasenko 10/7/2013 09:57'!
printTextOn: aStream upTo: endPosition 

	self span == endPosition span ifTrue: [ 
		^self span asStringOn: aStream startingAt: self spanPosition upTo: endPosition spanPosition].

	self span asStringOn: aStream startingAt: self spanPosition.
	self span next printTextOn: aStream upTo: endPosition span.
	endPosition span asStringOn: aStream upTo: endPosition spanPosition.

	! !

!TxBasicTextPosition methodsFor: 'navigation' stamp: 'IgorStasenko 9/20/2013 12:39'!
moveUp
	^ self moveUp: 1! !

!TxBasicTextPosition methodsFor: 'accessing' stamp: 'IgorStasenko 9/20/2013 01:10'!
linePosition: offset 
	"Answer the position, in same line as receiver, relative to line start.
	If offset bigger than line size, answer position for the end of line. "
	self subclassResponsibility! !

!TxBasicTextPosition methodsFor: 'accessing' stamp: 'IgorStasenko 10/23/2013 20:12'!
+ anInteger
	"Answer the position moved anInteger times right (positive) or left (negative) relative to receiver"
	
	^ self moveRight: anInteger! !

!TxBasicTextPosition methodsFor: 'converting' stamp: 'IgorStasenko 9/24/2013 15:17'!
asSelection
	^ TxSelection from: self to: self! !

!TxBasicTextPosition methodsFor: 'accessing' stamp: 'IgorStasenko 9/20/2013 00:37'!
text
	"Answer the TxModel instance where receiver is pointing in. "
	self subclassResponsibility! !

!TxBasicTextPosition methodsFor: 'navigation' stamp: 'IgorStasenko 9/20/2013 12:40'!
moveToEnd
	self subclassResponsibility ! !

!TxBasicTextPosition methodsFor: 'navigation' stamp: 'IgorStasenko 9/20/2013 12:40'!
moveRight: number
	self subclassResponsibility ! !

!TxBasicTextPosition methodsFor: 'accessing' stamp: 'IgorStasenko 10/14/2014 13:40'!
nextPosition
	"answer the position in text, which follows the receiver"
	self subclassResponsibility ! !

!TxBasicTextPosition methodsFor: 'accessing' stamp: 'IgorStasenko 10/13/2014 15:44'!
characterStream
	"answer the character stream, starting at receiver's position"
	
	^ TxCharacterStream onPosition: self! !

!TxBasicTextPosition methodsFor: 'converting' stamp: 'IgorStasenko 10/14/2013 12:11'!
selectTo: aPosition
	^ self text selection start: self; end: aPosition; yourself 
! !

!TxBasicTextPosition methodsFor: 'accessing' stamp: 'IgorStasenko 9/20/2013 01:33'!
lineNumber
	"Answer the 1-based line number, where receiver is currently in. "
	^ self span lineNumberAt: self ! !

!TxBasicTextPosition methodsFor: 'navigation' stamp: 'IgorStasenko 9/20/2013 12:39'!
moveDown
	^ self moveDown: 1! !

!TxBasicTextPosition methodsFor: 'accessing' stamp: 'IgorStasenko 9/20/2013 00:31'!
spanPosition
	"Answer the span position, where receiver is currently in. "
	self subclassResponsibility! !

!TxBasicTextPosition methodsFor: 'testing' stamp: 'IgorStasenko 9/20/2013 01:26'!
isValid

	^ ( self text includesSpan: self span ) and: [ self span size >= self spanPosition and: [ self spanPosition >=0 ] ]! !

!TxBasicTextPosition methodsFor: 'private' stamp: 'IgorStasenko 10/23/2013 20:58'!
timesToMoveRightTo: aPosition
	"Private.
	Assuming that receiver <= aPosition, answer the number of times
	to move receiver right to reach the given position.
	"
	
	| result mySpan targetSpan |

	mySpan := self span.
	targetSpan := aPosition span.
	result := 0.	
	
	mySpan == targetSpan ifTrue: [  ^ aPosition spanPosition - self spanPosition ].
	
	mySpan do: [ :each |  
		each == targetSpan 
			ifTrue: [ ^ result + aPosition spanPosition ]
			ifFalse: [ 
				each == mySpan 
					ifTrue: [ result := mySpan size - self spanPosition ]
					ifFalse: [ result := result + each size  ]
				 ]
		].

	self invalidPosition
	! !

!TxBasicTextPosition methodsFor: 'navigation' stamp: 'IgorStasenko 9/20/2013 12:40'!
moveUp: number
	self subclassResponsibility ! !

!TxBasicTextPosition methodsFor: 'accessing' stamp: 'IgorStasenko 10/23/2013 20:13'!
-- aPosition
	"Answer the distance between receiver and position, in terms of number of moving receiver right (positive)
	or left (negative) until it meets a given position. Answer zero if two positions coincide"
	
	(self hasSamePositionAs: aPosition) ifTrue: [  ^ 0 ].
	
	^ self < aPosition 
		ifTrue: [ self timesToMoveRightTo: aPosition ]
		ifFalse: [ (aPosition timesToMoveRightTo: self) negated ]! !

!TxBasicTextPosition methodsFor: 'testing' stamp: 'IgorStasenko 9/20/2013 01:30'!
isAtStart
	"Answer true if receiver points to the start of text"

	^ self span prev isAtStart and: [ self spanPosition = 0 ]! !

!TxBasicTextPosition methodsFor: 'navigation' stamp: 'IgorStasenko 9/20/2013 12:41'!
moveToStart
	self subclassResponsibility ! !

!TxBasicTextPosition methodsFor: 'navigation' stamp: 'IgorStasenko 9/20/2013 12:39'!
moveLeft
	
	^ self moveLeft: 1! !

!TxBasicTextPosition methodsFor: 'comparing' stamp: 'IgorStasenko 4/10/2014 15:50'!
hash
	^ self span hash bitXor: self spanPosition hash! !

!TxBasicTextPosition methodsFor: 'converting' stamp: 'IgorStasenko 9/20/2013 12:43'!
asPosition
	^ self subclassResponsibility ! !

!TxBasicTextPosition methodsFor: 'testing' stamp: 'IgorStasenko 11/28/2013 09:26'!
isAtLineEnd
	^ (self spanPosition = 0 and: [ self span isLineSeparator ])
		or: [  (self isAtSpanEnd and: [self span next isLineSeparator ])]! !

!TxBasicTextPosition methodsFor: 'testing' stamp: 'IgorStasenko 12/19/2013 16:03'!
isAtLineStart
	^ self isAtStart or: [ self span isLineSeparator and: [ self isAtSpanEnd ] ]! !

!TxBasicTextPosition methodsFor: 'testing' stamp: 'IgorStasenko 9/20/2013 01:27'!
isAtSpanStart
	^ self spanPosition = 0! !

!TxBasicTextPosition methodsFor: 'error handling' stamp: 'IgorStasenko 9/20/2013 01:08'!
invalidPosition
	"The receiver is no longer a valid text position for TxModel"

	Error signal: 'Invalid text position'! !

!TxBasicTextPosition methodsFor: 'accessing' stamp: 'IgorStasenko 9/20/2013 12:47'!
linePosition
	"Answer the position of receiver, relative to line start. "

	(self span isLineSeparator and: [self spanPosition =1 ]) ifTrue: [ ^ 0 ].
	
	self span lineStartSpan spanAndPositionDo: [ :newSpan :spanStartPosition |
		newSpan = self span 
			ifTrue: [ ^ spanStartPosition + self spanPosition ]].
		
	^ self invalidPosition 
! !

!TxBasicTextPosition methodsFor: 'navigation' stamp: 'IgorStasenko 9/20/2013 12:40'!
moveDown: number
	self subclassResponsibility ! !

!TxBasicTextPosition methodsFor: 'converting' stamp: 'IgorStasenko 10/23/2013 21:49'!
asTextIndex
	"Answer the absolute index which corresponds to receiver's location inside text.
	The resulting number is equivalent to the number of times of moving text starting position
	right, to reach same position as the receiver.

	Please note that converting text index<->position does not takes constant time, 
	because it requires linear scan from the beginning of text.

	Also note that answered number does not corresponds to some the character index in text, 
	but to index of unique insertion point in text, with the exception that endpoints of adjacent spans
	considered as same insertion point, not two separate ones.
	
	This method is symmetrical to TxModel>>#positionAtTextIndex:. 
	"
	
	^ self text startPosition timesToMoveRightTo: self! !

!TxBasicTextPosition methodsFor: 'navigation' stamp: 'IgorStasenko 9/20/2013 12:41'!
moveToLineStart
	self subclassResponsibility ! !

!TxBasicTextPosition methodsFor: 'accessing' stamp: 'IgorStasenko 9/20/2013 00:31'!
span
	"Answer the span, where receiver is currently in. "
	self subclassResponsibility! !

!TxBasicTextPosition methodsFor: 'navigation' stamp: 'IgorStasenko 9/20/2013 12:42'!
moveTo: anotherTextPosition

	self subclassResponsibility ! !

!TxBasicTextPosition methodsFor: 'converting' stamp: 'IgorStasenko 10/14/2013 12:11'!
to: aPosition
	^ TxInterval from: self to: aPosition! !

!TxBasicTextPosition methodsFor: 'accessing' stamp: 'IgorStasenko 10/23/2014 16:22'!
getCharacter
	"Answer the character, right before the receiver,
	answer nil, if there's no character at given position"
	
	^ self span characterBeforePosition: self spanPosition ifNone: nil! !

!TxBasicTextPosition methodsFor: 'navigation' stamp: 'IgorStasenko 9/20/2013 12:39'!
moveRight

	^ self moveRight: 1

! !

!TxBasicTextPosition methodsFor: 'comparing' stamp: 'IgorStasenko 9/20/2013 01:17'!
= anObject
	^ (anObject isKindOf: TxBasicTextPosition) and: [
		anObject text = self text and: [ anObject span = self span and: [ anObject spanPosition = self spanPosition ]]]! !

!TxBasicTextPosition methodsFor: 'converting' stamp: 'IgorStasenko 9/20/2013 02:23'!
asCursor
	^ self subclassResponsibility ! !

!TxBasicTextPosition methodsFor: 'operations' stamp: 'IgorStasenko 8/21/2014 11:49'!
insertObject: anObject 
	"
	Insert an embedded object at receiver.
	Answer the position right after the inserted object.
	"
	self subclassResponsibility ! !

!TxBasicViewMorph methodsFor: 'scrolling' stamp: 'IgorStasenko 12/29/2013 17:14'!
scrollBy: aPoint 
	self subclassResponsibility .! !

!TxBasicViewMorph methodsFor: 'scrolling' stamp: 'IgorStasenko 3/27/2014 16:20'!
resetViewTo: startPosition

	self subclassResponsibility ! !

!TxBasicViewMorph methodsFor: 'drawing' stamp: 'NicolaiHess 2/18/2015 00:05'!
drawOnAthensCanvas: anAthensCanvas 
	| border |
	border := self borderStyle. 
	anAthensCanvas setPaint: self fillStyle.
	anAthensCanvas drawShape: self bounds.
	
	"Fill the given rectangle."
	anAthensCanvas drawShape: (self bounds insetBy: border width).

	(anAthensCanvas setStrokePaint: border color) width: border width.
	anAthensCanvas drawShape: (self bounds insetBy: (border width /2 asFloat)).
! !

!TxBasicViewMorph methodsFor: 'accessing' stamp: 'IgorStasenko 5/12/2014 16:13'!
layoutStrategy: aStrategy
	self subclassResponsibility ! !

!TxBasicViewMorph methodsFor: 'drawing' stamp: 'NicolaiHess 2/18/2015 00:04'!
fullDrawOnAthensCanvas: anAthensCanvas 
	"Draw the full Morphic structure on the given Canvas"

	self visible ifFalse: [^ self].
	(anAthensCanvas isVisible: self fullBounds) ifFalse: [^self].
	(self hasProperty: #errorOnDraw) ifTrue: [^self "drawErrorOn: aCanvas" ].

	(anAthensCanvas isVisible: self bounds) ifTrue: [ anAthensCanvas draw: self ].
	
	submorphs isEmpty ifTrue: [^self].

	self clipSubmorphs ifTrue: [ | clip |
		clip := self clippingBounds.
		anAthensCanvas 
			clipBy: clip
			during: [
				submorphs reverseDo: [:m | anAthensCanvas fullDrawMorph: m ] 
			]
	] 
	ifFalse: [
		submorphs reverseDo: [:m | anAthensCanvas fullDrawMorph: m ]
	]
! !

!TxBasicViewMorph methodsFor: 'text wrapping' stamp: 'IgorStasenko 5/12/2014 16:16'!
wrapText: aBoolean
	"turn text wrapping on/off by switching layout strategy"

	| strategy |
	
	strategy := 
		aBoolean 
			ifTrue: [ self characterWrappingStrategy ] 
			ifFalse: [  self noWrapStrategy ].

	self layoutStrategy: strategy.! !

!TxBasicViewMorph methodsFor: 'accessing' stamp: 'IgorStasenko 5/13/2014 15:02'!
contents: aText

	"Set the new contents" 
	self subclassResponsibility.! !

!TxBasicViewMorph methodsFor: 'scrolling' stamp: 'IgorStasenko 3/27/2014 15:38'!
scrollIntoView: aTextPosition
	self subclassResponsibility! !

!TxBasicViewMorph methodsFor: 'text wrapping' stamp: 'IgorStasenko 5/12/2014 16:09'!
noWrapStrategy
	^ TxAthensNoWrapStrategy new! !

!TxBasicViewMorph methodsFor: 'text wrapping' stamp: 'IgorStasenko 5/12/2014 16:10'!
characterWrappingStrategy
	^ TxAthensCharacterWrappingStrategy new! !

!TxBlockCursor commentStamp: '<historical>'!
when it was not possible to show a vertical bar between characters to show where the new text would be inserted, so an underscore or block cursor was used instead!
!TxCairoCharacterSpanDisplayCommand methodsFor: 'rendering' stamp: 'IgorStasenko 9/26/2014 15:27'!
renderOn: renderer
	| canvas glyphRenderer |
	
	canvas := renderer canvas.
	glyphRenderer := canvas setFont: (span getAttribute: TxFontAttribute).
	canvas setPaint: (span getAttribute: TxForeColorAttribute).
	
	glyphs ifNil: [ self getGlyphsUsing: glyphRenderer ].
	glyphRenderer renderGlyphs: glyphs.
	
"	canvas setPaint: Color random.
	canvas drawShape: (0@0 corner: advance x @ 3).
"	renderer advance:advance.! !

!TxCairoCharacterSpanDisplayCommand methodsFor: 'private' stamp: 'SeanDeNigris 4/4/2014 15:00'!
getGlyphsUsing: renderer 

	glyphs := renderer glyphsOf: span characters from: start to: stop.
! !

!TxCairoCharacterSpanDisplayCommand methodsFor: 'setting up' stamp: 'SeanDeNigris 4/4/2014 14:49'!
span: aSpan start: startPos stop: stopPos

	span := aSpan.
	start := startPos.
	stop := stopPos.
	glyphs := nil.! !

!TxCaretCursor commentStamp: '<historical>'!
In most command-line interfaces or text editors, the text cursor or caret navigation, is an underscore, a solid rectangle, or a vertical line, which may be flashing or steady, indicating where text will be placed when entered (the insertion point).!
!TxCaretCursor methodsFor: 'accessing' stamp: 'IgorStasenko 10/22/2013 16:16'!
calculateNewBounds
	| topLeft bottomRight |

	"the top point in view is relative to view, 
	since morphic uses absolute coordinates we should add view position here"
	topLeft := owner layoutViewMorph topLeft + layoutPosition topPointInView.
	bottomRight := topLeft + (2@layoutPosition line height).
	
	"we round bounds here to avoid clipping artefacts"
	^ topLeft floor corner: bottomRight ceiling! !

!TxCaretCursor methodsFor: 'drawing' stamp: 'IgorStasenko 4/25/2014 17:05'!
drawOnAthensCanvas: aCanvas

	| cursorShape |

	cursorShape := owner layoutViewMorph topLeft + layoutPosition topPointInView extent: 2@ layoutPosition line height.
	
	self isBlinkingVisibleNow ifTrue: [ 
		aCanvas 
			setShape: cursorShape;
			setPaint: self cursorColor;
			draw
		]! !

!TxCaretCursor methodsFor: 'testing' stamp: 'FernandoOlivero 9/19/2013 00:30'!
isBlinking
	^ true ! !

!TxCharacterSpan commentStamp: '<historical>'!
I am the span which holds characters. Usually i am most often used span type (along with line separator).!
!TxCharacterSpan methodsFor: 'printing' stamp: 'IgorStasenko 9/17/2012 16:45'!
asStringOn: aStream
	aStream nextPutAll: characters.! !

!TxCharacterSpan methodsFor: 'accessing' stamp: 'IgorStasenko 9/17/2012 15:48'!
lastInsertPosition
	^ characters size ! !

!TxCharacterSpan methodsFor: 'accessing' stamp: 'IgorStasenko 6/7/2013 16:27'!
lineNumberAt: aTxTextPosition 
	"i am not changing the number of lines"
	^ self numberOfLinesBefore.! !

!TxCharacterSpan methodsFor: 'drawing' stamp: 'DenisKudryashov 3/23/2013 21:58'!
drawOn: aCanvas from: start to: end at: aPoint font: aFont

	aCanvas 
		drawString: characters 
		from: start
		to: end 
		at: aPoint 
		font: aFont
		color: (self getAttribute: TxForeColorAttribute)! !

!TxCharacterSpan methodsFor: 'operation' stamp: 'CamilloBruni 10/11/2012 11:07'!
removeBefore: aSize
	characters := characters allButFirst: aSize! !

!TxCharacterSpan methodsFor: 'operation' stamp: 'IgorStasenko 10/2/2014 17:55'!
applyAttribute: anAttribute from: startPosition to: endPosition
	
	"Apply attribute to receiver.
	
	If start position not points to receiver, it means that span head should be covered by attribute,
	if endPosition not points to receiver , it means that span tail should be covered by attribute.
	
	Else, they define a split point.

	
	4 cases: 
		- span already has given attribute (so do nothing )
		- start/end covers entire span (just add attribute)
		- split on 2 spans if start or end is at end of span 
		- split on 3 spans both start and end in the middle or span
	"

	| splitStart splitEnd secondSpan |
	
	(style includes: anAttribute) ifTrue: [ ^ self ].

	startPosition span == self 
		ifTrue: [ splitStart := startPosition spanPosition ]
		ifFalse: [ splitStart := 0 ].
	
	endPosition span == self 
		ifTrue: [ splitEnd := endPosition spanPosition ]
		ifFalse: [ splitEnd := self size ].
		
	splitStart > 0 
		ifTrue: [ secondSpan := self splitAt: splitStart ]
		ifFalse: [ secondSpan := self ].
	
	splitEnd - splitStart < secondSpan size ifTrue: [
		secondSpan splitAt: (splitEnd - splitStart).
		"update the position"
		endPosition position: secondSpan endPosition.
	].
	
	secondSpan applyAttribute: anAttribute.
	! !

!TxCharacterSpan methodsFor: 'accessing' stamp: 'dik 1/6/2013 15:25'!
height
	| font |
	font := self getAttribute: TxFontAttribute.
	^font height! !

!TxCharacterSpan methodsFor: 'operation' stamp: 'IgorStasenko 8/5/2013 13:33'!
deleteUpTo: endPosition startingAt: startPosition
	"Note, startPosition span == self" 
	
	self assert: startPosition span == self.
	
	endPosition span = self ifTrue: [
		"perform a local removal"
		self removeFrom: startPosition spanPosition to: endPosition spanPosition ]
	ifFalse: [
		self removeAfter: startPosition spanPosition.
		self next: endPosition span.
		self next removeBefore: endPosition spanPosition.
	].
	^ self tryMergeAndUpdatePosition: startPosition copy 
	
! !

!TxCharacterSpan methodsFor: 'operation' stamp: 'IgorStasenko 9/2/2014 13:22'!
splitAt: offset
	| newSpan |
	characters ifEmpty: [ ^ self ].

	newSpan := text newCharacterSpan: (characters allButFirst: offset).
	characters := characters first: offset.
	"also inherit style"
	newSpan setStyle: self style.
	
	^ self insertNext: newSpan.! !

!TxCharacterSpan methodsFor: 'accessing-text position' stamp: 'IgorStasenko 6/7/2013 15:48'!
endPosition
	^ self positionAt: self lastInsertPosition! !

!TxCharacterSpan methodsFor: 'initialize-release' stamp: 'IgorStasenko 8/29/2014 16:29'!
initialize 
	super initialize.
	style := TxStyle new.
	characters := String empty.! !

!TxCharacterSpan methodsFor: 'operation' stamp: 'IgorStasenko 10/2/2014 18:11'!
tryMergeWithNextPreserving: selection
	"Applicable only to character spans"
	
	"Merge with next span, if it has same attributes"
	characters size isZero ifTrue: [ ^ self delete ].
	
	[ next isCharacterSpan ] whileTrue: [
	
		next style = self style ifTrue: [
			characters := characters , next characters.
			
			"preserve the selection, while merging"
			selection start span == next ifTrue: [ 
				selection start: (self positionAt: (self size + selection start spanPosition))
				 ].
			
			selection end span == next ifTrue: [ 
				selection end: (self positionAt: (self size + selection end spanPosition))
				 ].

			next delete.
		] ifFalse: [ ^ self ]
	]
! !

!TxCharacterSpan methodsFor: 'visitor' stamp: 'IgorStasenko 8/8/2013 03:45'!
accept: anObject
	"visitor pattern"
	
	^ anObject visitCharacterSpan: self! !

!TxCharacterSpan methodsFor: 'printing' stamp: 'DenisKudrayshov 4/28/2013 17:41'!
asStringOn: aStream upTo: index
	self asStringOn: aStream startingAt: 0 upTo: index.! !

!TxCharacterSpan methodsFor: 'testing' stamp: 'CamilloBruni 9/18/2012 15:32'!
isLastPosition: position
	^ position = self size! !

!TxCharacterSpan methodsFor: 'private' stamp: 'CamilloBruni 10/11/2012 21:33'!
removeFrom: start to: end
	"remove all the characters in the given range. 
	Note that start is 0 based as it is the start point of the selection, left from the character"
	characters := characters copyReplaceFrom: (start + 1) to: end with: ''.! !

!TxCharacterSpan methodsFor: 'accessing-text position' stamp: 'IgorStasenko 6/7/2013 15:48'!
startPosition
	^ self positionAt: 0! !

!TxCharacterSpan methodsFor: 'printing' stamp: 'DenisKudrayshov 4/28/2013 17:43'!
asStringOn: aStream startingAt: startIndex upTo: endIndex
	aStream nextPutAll: (characters copyFrom: startIndex + 1 to: endIndex).! !

!TxCharacterSpan methodsFor: 'operation' stamp: 'IgorStasenko 9/26/2014 15:23'!
tryMergeWithNext
	"Applicable only to character spans.
	
	Merge with next span, if it has same attributes"
	characters size isZero ifTrue: [ ^ self delete ].
	
	[ next isCharacterSpan ] whileTrue: [
	
		next style = self style ifTrue: [
			characters := characters , next characters.
			next delete
		] ifFalse: [ ^ self ]
	]
! !

!TxCharacterSpan methodsFor: 'printing' stamp: 'IgorStasenko 10/14/2012 08:34'!
printContentsOn: aStream
	aStream 
		nextPutAll: '"';
		nextPutAll: characters; 
		nextPutAll: '"'.
	! !

!TxCharacterSpan methodsFor: 'accessing' stamp: 'IgorStasenko 9/17/2012 16:27'!
size
	^ characters size! !

!TxCharacterSpan methodsFor: 'operation' stamp: 'IgorStasenko 8/29/2014 16:29'!
insertCharacters: chars at: position attributes: insertAttributes
	"Insert a single line character string at the given position,
	answer a new position pointing to the end of inserted string"

	| spanPos insertionEnd |

	spanPos := position spanPosition.
	
	style = insertAttributes ifFalse: [
		"going to create a separate character span, since attributes are incompatible"
		| newSpan |
		newSpan := (text newCharacterSpan: chars) replaceAttributes: insertAttributes.
		
		spanPos = 0 ifTrue: [
			self insertPrev: newSpan.
			^ self startPosition
			].
		
		spanPos < self size ifTrue: [ self splitAt: spanPos ].
			
		self insertNext: newSpan.
		^ newSpan endPosition.
	].
		
	"attributes are same, just insert characters"
 	insertionEnd := self size - spanPos.
	characters := String new: self size + chars size streamContents: [ :s|
		s
			next: spanPos putAll: characters; 
			nextPutAll: chars;
			next: insertionEnd putAll: characters startingAt: spanPos + 1 ].
	
	^ self positionAt: spanPos + chars size.! !

!TxCharacterSpan methodsFor: 'testing' stamp: 'DenisKudrayshov 4/24/2013 23:43'!
isEmpty
	^self size = 0! !

!TxCharacterSpan methodsFor: 'operations' stamp: 'TristanBourgois 1/21/2013 12:17'!
mergeUpTo: aSpan
	(aSpan = self next) ifTrue:[
		(self next doMerge: self) ifTrue:[
			self merge: self next.
			^self.
		]
		ifFalse:[
			^self next.
		].
	].
	
	(self next doMerge: self) ifTrue:[
			self merge: self next.
			^self mergeUpTo: aSpan.
		]
	ifFalse:[
			^self next mergeUpTo: aSpan.
		].! !

!TxCharacterSpan methodsFor: 'accessing' stamp: 'IgorStasenko 9/17/2012 14:52'!
characters
	^ characters! !

!TxCharacterSpan methodsFor: 'operation' stamp: 'IgorStasenko 6/10/2013 21:54'!
tryMergeAndUpdatePosition: position

	"try to merge receiver with its neighbors, answer the updated position"
	
	"position is assumed to be inside of receiver"
	self assert: position span == self.
	
	self isEmpty ifTrue: [  
		self delete.
		^ prev endPosition ].
		
	^ position! !

!TxCharacterSpan methodsFor: 'accessing' stamp: 'IgorStasenko 9/17/2012 14:52'!
characters: anObject
	
	characters := anObject! !

!TxCharacterSpan methodsFor: 'accessing' stamp: 'IgorStasenko 10/23/2014 16:20'!
characterBeforePosition: spanPosition ifNone: aBlock

	"Answer character which is right before the position, located in receiver
	or evaluate a block if there's none"
	^ characters at: spanPosition ifAbsent: aBlock
! !

!TxCharacterSpan methodsFor: 'operation' stamp: 'IgorStasenko 6/11/2013 02:03'!
removeAfter: anOffset
	characters := characters first: anOffset.
	characters isEmpty ifTrue: [ self delete ]! !

!TxCharacterSpan methodsFor: 'printing' stamp: 'DenisKudrayshov 4/28/2013 17:41'!
asStringOn: aStream startingAt: index
	self asStringOn: aStream startingAt: index upTo: characters size.! !

!TxCharacterSpan methodsFor: 'operation' stamp: 'IgorStasenko 6/7/2013 16:56'!
at: aTxPosition insertSingleLine: aString
	"Insert a single line character string at the given position,
	answer a new position pointing to the end of inserted string"
	| insertionEnd |
	insertionEnd := self size - aTxPosition spanPosition.
	characters := String new: self size + aString size streamContents: [ :s|
		s
			next: aTxPosition spanPosition putAll: characters; 
			nextPutAll: aString;
			next: insertionEnd putAll: characters startingAt: aTxPosition spanPosition + 1 ].
	
	^ self positionAt: aTxPosition spanPosition + aString size.! !

!TxCharacterSpan methodsFor: 'operations' stamp: 'TristanBourgois 1/21/2013 12:18'!
doMerge: aCharacterSpan
	^ aCharacterSpan attributes = self attributes.! !

!TxCharacterSpan methodsFor: 'actions' stamp: 'TristanBourgois 1/21/2013 12:11'!
merge: aSpan
	self characters: ((self characters), aSpan characters).
	"I'am at the end of the text"
	(self next  = self next next) ifTrue:[
			self next: self.
		]
	ifFalse:[
			self next: aSpan next.
		].
	
	
	! !

!TxCharacterSpan methodsFor: 'drawing' stamp: 'DenisKudryashov 1/19/2013 23:51'!
drawOn: aCanvas at: aPoint 

	aCanvas 
		drawString: characters 
		at: aPoint 
		font: (self getAttribute: TxFontAttribute) 
		color: (self getAttribute: TxForeColorAttribute)! !

!TxCharacterSpan methodsFor: 'testing' stamp: 'IgorStasenko 6/14/2013 15:28'!
isCharacterSpan
	^ true! !

!TxCharacterSpan methodsFor: 'operation' stamp: 'IgorStasenko 6/11/2013 03:21'!
insertLineSeparator: separator at: position
	
	| spanPos |
	
	spanPos := position spanPosition.
	
	"at start"
	spanPos = 0 ifTrue: [
		self insertPrev: separator.
		^ position
		].
	
	"at end & middle"
	spanPos < self size ifTrue: [ self splitAt: spanPos ].
	
	self insertNext: separator.
	^ next endPosition
 ! !

!TxCharacterSpan methodsFor: 'copying' stamp: 'IgorStasenko 10/11/2013 14:07'!
postCopy
	
	super postCopy.
	characters := characters copy.! !

!TxCharacterSpan class methodsFor: 'instance creation' stamp: 'IgorStasenko 9/17/2012 16:31'!
text: aText
	^ self text: aText characters: String empty! !

!TxCharacterSpan class methodsFor: 'instance creation' stamp: 'IgorStasenko 9/17/2012 16:29'!
text: aText characters: aString
	^ self new
		text: aText;
		characters: aString;
		yourself.! !

!TxCharacterSpanDisplayCommand methodsFor: 'geometry' stamp: 'IgorStasenko 10/15/2013 12:06'!
horizontalAdvanceUpTo: aTextPosition layout: aTextLayout
"	<compilerOptions: #(- optionInlineToDo )>"
	| horizontalAdvance fontMetricsProvider   characters spanPosition |

	fontMetricsProvider := self  fontMetricsProvider: aTextLayout. 
	horizontalAdvance := 0.
	characters := self span characters.
	spanPosition := aTextPosition spanPosition.
	
	start to: stop do: [ :index |
		| glyphWidth |
		index > spanPosition  ifTrue: [  ^ horizontalAdvance ].
		glyphWidth := fontMetricsProvider getGlyphWidth: (characters at: index).
		horizontalAdvance := horizontalAdvance + glyphWidth.
	].
	"we should never reach here"
	^ horizontalAdvance! !

!TxCharacterSpanDisplayCommand methodsFor: 'accessing' stamp: 'IgorStasenko 8/22/2013 15:08'!
advance
	
	^ advance! !

!TxCharacterSpanDisplayCommand methodsFor: 'accessing' stamp: 'IgorStasenko 8/12/2013 15:31'!
span
	^ span! !

!TxCharacterSpanDisplayCommand methodsFor: 'geometry' stamp: 'IgorStasenko 10/22/2013 01:30'!
textPositionForHorizontalOffset: anOffset layout: layout
	| x fontMetricsProvider  |

	fontMetricsProvider := self fontMetricsProvider: layout.
	x := anOffset.

	start to: stop do: [ :index |
		| glyphWidth |	
		glyphWidth := fontMetricsProvider getGlyphWidth: (span characters at: index).
		x <= glyphWidth ifTrue: [ 
			"if offset closer to left side of glyph, we answer the position prior to it,
			otherwise after it"
			x < (glyphWidth/2) 
				ifTrue: [ ^ span positionAt: index - 1 ]
				ifFalse: [ ^ span positionAt: index ]
			].
		x := x - glyphWidth].
	^ span positionAt: stop! !

!TxCharacterSpanDisplayCommand methodsFor: 'setting up' stamp: 'IgorStasenko 8/7/2014 15:03'!
span: aSpan start: startPos stop: stopPos

	span := aSpan.
	start := startPos.
	stop := stopPos.
! !

!TxCharacterSpanDisplayCommand methodsFor: 'rendering' stamp: 'IgorStasenko 8/22/2013 15:10'!
renderOn: renderer

	renderer setFont: (span getAttribute: TxFontAttribute).
	renderer setColor: (span getAttribute: TxForeColorAttribute).
	
	renderer renderCharacters: span characters from: start to: stop.
	renderer advance:advance.! !

!TxCharacterSpanDisplayCommand methodsFor: 'accessing' stamp: 'IgorStasenko 8/12/2013 15:31'!
stop
	^ stop! !

!TxCharacterSpanDisplayCommand methodsFor: 'accessing' stamp: 'IgorStasenko 8/12/2013 15:31'!
stop: anObject
	stop := anObject! !

!TxCharacterSpanDisplayCommand methodsFor: 'geometry' stamp: 'IgorStasenko 8/27/2013 15:19'!
fontMetricsProvider: aTextLayout
	| font |
	font := self span getAttribute: TxFontAttribute.  
	^ aTextLayout  fontMetricsProviderFor: font.
! !

!TxCharacterSpanDisplayCommand methodsFor: 'accessing' stamp: 'IgorStasenko 8/12/2013 15:31'!
span: anObject
	span := anObject! !

!TxCharacterSpanDisplayCommand methodsFor: 'accessing' stamp: 'IgorStasenko 8/22/2013 15:08'!
advance: anObject
	
	advance := anObject! !

!TxCharacterSpanDisplayCommand methodsFor: 'accessing' stamp: 'IgorStasenko 8/12/2013 15:31'!
start
	^ start! !

!TxCharacterSpanDisplayCommand methodsFor: 'accessing' stamp: 'IgorStasenko 8/12/2013 15:31'!
start: anObject
	start := anObject! !

!TxCharacterSpanDisplayCommand methodsFor: 'accessing' stamp: 'IgorStasenko 9/20/2013 02:14'!
startPosition
	"answer the text position, matching the start of command"
	^ TxTextPosition span: span spanPosition: start -1! !

!TxCharacterSpanDisplayCommand methodsFor: 'testing' stamp: 'IgorStasenko 8/27/2013 12:14'!
contains: aTextPosition

	"this one is tricky and should be covered by tests, because
	start and stop here is start charater index and stop character index, but not positions
	 "
	
	self flag: #coverByTest.
	
	^ aTextPosition span == span and: [ | spanPos |  
			spanPos := aTextPosition spanPosition.
			spanPos between: start-1 and: stop ]! !

!TxCharacterSpanTests methodsFor: 'accessing' stamp: 'DenisKudryashov 1/20/2013 01:10'!
spanClass
	^TxCharacterSpan ! !

!TxCharacterSpanTests methodsFor: 'tests' stamp: 'IgorStasenko 10/21/2014 17:23'!
testGettingAbsentAttribute

	| actual |

	textModel := TxMockTextModel new.
	span text: textModel.
	
	actual := span getAttribute: TxFontAttribute.
	
	self assert: actual equals: #mockValue! !

!TxCharacterSpanTests methodsFor: 'tests' stamp: 'IgorStasenko 10/21/2014 17:35'!
testGettingExistedAttribute

	|  actual |
	
	span style add: TxFontAttribute with: #font.
	
	actual := span getAttribute: TxFontAttribute.
	
	self assert: actual == #font
	! !

!TxCharacterStream commentStamp: 'IgorStasenko 10/13/2014 15:54'!
I am a specialized read-only stream, intended to work with text in order to extract 
characters out of it. Since text model can hold not just characters, but any sort of objects, which not necessary can be represented by character(s),
this stream can be used to filter only character data.

Please note, that if you will attempt to modify text while using this stream,
the results may be vary, since any modification of text invalidates all positions, held externally, and not maintained implicitly during text modification operations (like selection does).

Thus, special care must be taken to reinitialize the stream's position to valid  position after modifying the subject text.

Handling the position updates is, of course, not the responsibility of this classs, since it cannot know, nor predict, what kind of modification it may be and where it will occur and how it will affect the position it holds.

The only responsibility of this class is provide a convenient stream for reading character data from text.!
!TxCharacterStream methodsFor: 'accesing' stamp: 'IgorStasenko 10/13/2014 15:47'!
text
	^ position text! !

!TxCharacterStream methodsFor: 'accesing' stamp: 'IgorStasenko 10/23/2014 16:16'!
isAtEnd

	^ position isAtEnd ! !

!TxCharacterStream methodsFor: 'accesing' stamp: 'IgorStasenko 10/23/2014 16:12'!
position: aTxPosition
	position := aTxPosition asPosition! !

!TxCharacterStream methodsFor: 'accesing' stamp: 'IgorStasenko 10/13/2014 15:46'!
position
	^ position! !

!TxCharacterStream methodsFor: 'accesing' stamp: 'IgorStasenko 10/23/2014 16:16'!
next
	| char |
	
	[ 
		position := position nextPosition.
		char := position getCharacter.
		char ifNotNil: [ ^ char ].
		position isAtEnd ifTrue: [ ^ nil ].
	] repeat.! !

!TxCharacterStream class methodsFor: 'instance creation' stamp: 'IgorStasenko 10/13/2014 15:45'!
onPosition: aTxPosition
	^ self basicNew position: aTxPosition! !

!TxCharacterStream class methodsFor: 'instance creation' stamp: 'IgorStasenko 10/13/2014 15:44'!
on: txModel
	^ self onPosition: txModel startPosition ! !

!TxCharacterStreamTest methodsFor: 'tests' stamp: 'IgorStasenko 10/23/2014 16:22'!
testBasicStuff

	| text stream |
	
	text :=  'asdf' asTxModel.
	stream := text characterStream.


	self assert: stream next = $a.
	self assert: stream next = $s.
	self assert: stream next = $d.
	self assert: stream next = $f.
	self assert: stream next = nil.
	self assert: stream next = nil.

	self assert: stream isAtEnd.! !

!TxCharacterStreamTest methodsFor: 'tests' stamp: 'IgorStasenko 10/13/2014 15:41'!
testFreshInstanceDefaults

	| text stream |
	
	text :=  'asdf' asTxModel.
	stream := text characterStream.
	
	self assert: stream text == text.
	self assert: stream position isAtStart.! !

!TxCharacterWrappingStrategyTest methodsFor: 'private' stamp: 'FernandoOlivero 8/26/2013 17:16'!
defaultStrategy
	^ TxAthensCharacterWrappingStrategy new 
	

! !

!TxCharacterWrappingStrategyTest methodsFor: 'testing' stamp: 'FernandoOlivero 8/25/2013 11:22'!
testLayoutShouldContainMultipleLines
	self assert: (view layout numberOfLines >  1)! !

!TxContextMenuAnnouncement methodsFor: 'accessing' stamp: 'IgorStasenko 11/11/2014 14:51'!
textPosition: anObject
	textPosition := anObject! !

!TxContextMenuAnnouncement methodsFor: 'accessing' stamp: 'IgorStasenko 11/11/2014 14:51'!
event
	^ event! !

!TxContextMenuAnnouncement methodsFor: 'accessing' stamp: 'IgorStasenko 11/11/2014 14:51'!
event: anObject
	event := anObject! !

!TxContextMenuAnnouncement methodsFor: 'accessing' stamp: 'IgorStasenko 11/11/2014 14:51'!
editorMorph: anObject
	editorMorph := anObject! !

!TxContextMenuAnnouncement methodsFor: 'accessing' stamp: 'IgorStasenko 11/11/2014 14:51'!
textPosition
	^ textPosition! !

!TxContextMenuAnnouncement methodsFor: 'accessing' stamp: 'IgorStasenko 11/11/2014 14:51'!
editorMorph
	^ editorMorph! !

!TxCursorAttribute commentStamp: 'IgorStasenko 9/10/2014 15:46'!
This attribute controls the mouse cursor appearance when user holding mouse over it.!
!TxCursorAttribute class methodsFor: 'defaults' stamp: 'IgorStasenko 9/10/2014 15:45'!
defaultValue
	^ Cursor overEditableText! !

!TxDeleteOperation commentStamp: 'IgorStasenko 8/26/2014 13:13'!
a history record containing delete operation!
!TxDeleteOperation methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/11/2013 12:58'!
do
	selection cut! !

!TxDeletedTextAnnouncement commentStamp: 'IgorStasenko 11/11/2014 16:44'!
I am announced when editor deletes the portion of text.
The announcement triggered right after the operation.!
!TxDisplayCommand methodsFor: 'geometry' stamp: 'IgorStasenko 8/27/2013 12:15'!
horizontalAdvanceUpTo: textPosition layout: layout

	self subclassResponsibility! !

!TxDisplayCommand methodsFor: 'geometry' stamp: 'IgorStasenko 8/27/2013 15:11'!
textPositionForHorizontalOffset: anOffset layout: layout

	self subclassResponsibility! !

!TxDisplayCommand methodsFor: 'accessing' stamp: 'IgorStasenko 8/8/2013 18:40'!
insert: aCommands

	| nn |
	nn := next.
	next := aCommands.
	next tail next: nn! !

!TxDisplayCommand methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 9/18/2014 18:41'!
notifyRemovedFrom: aTxAthensLayout 
! !

!TxDisplayCommand methodsFor: 'accessing' stamp: 'IgorStasenko 8/8/2013 18:40'!
next

	^ next! !

!TxDisplayCommand methodsFor: 'rendering' stamp: 'IgorStasenko 8/8/2013 18:40'!
renderOn: renderer
	self shouldBeImplemented ! !

!TxDisplayCommand methodsFor: 'accessing' stamp: 'IgorStasenko 8/8/2013 18:40'!
tail
	| nn |
	nn := self.
	[ nn next notNil ] whileTrue: [ nn := nn next ].
	^ nn! !

!TxDisplayCommand methodsFor: 'accessing' stamp: 'IgorStasenko 8/8/2013 18:40'!
next: anObject
	
	next := anObject! !

!TxDisplayCommand methodsFor: 'accessing' stamp: 'IgorStasenko 8/8/2013 18:40'!
addLast: aCommand
	self tail next: aCommand! !

!TxDisplayCommand methodsFor: 'accessing' stamp: 'IgorStasenko 8/8/2013 18:40'!
do: aBlock
	| nn |
	nn := self.
	
	[ nn isNil ] whileFalse: [ 
		aBlock value: nn.
		nn := nn next. ]! !

!TxDisplayCommand methodsFor: 'copying' stamp: 'IgorStasenko 8/8/2013 18:40'!
postCopy
	"unlink the copy by default"
	next := nil! !

!TxDisplayCommand methodsFor: 'accessing' stamp: 'IgorStasenko 8/27/2013 12:40'!
startPosition
	"answer the text position, matching the start of command"
	self subclassResponsibility! !

!TxDisplayCommand methodsFor: 'testing' stamp: 'IgorStasenko 8/27/2013 12:14'!
contains: aTextPosition
	self subclassResponsibility! !

!TxEditorOperation commentStamp: '<historical>'!
my subclasses representing a concrete operation which modifies target text which is being edited,
including changing the text or changing selection.

i am kind of command, to support undo/redo operations.!
!TxEditorOperation methodsFor: 'initialization' stamp: 'IgorStasenko 10/23/2013 20:37'!
editor: anEditor
	editor := anEditor! !

!TxEditorOperation methodsFor: 'recording the changes' stamp: 'IgorStasenko 10/23/2013 20:38'!
captureDuring: aBlock
	self subclassResponsibility! !

!TxEditorOperation methodsFor: 'do/undo' stamp: 'IgorStasenko 10/9/2013 16:33'!
undo
	"perform a reverse operation"! !

!TxEditorOperation methodsFor: 'do/undo' stamp: 'IgorStasenko 10/23/2013 20:23'!
redo
	"perform an operation"! !

!TxEditorOperation class methodsFor: 'instance creation' stamp: 'IgorStasenko 10/23/2013 20:37'!
editor: anEditor
	^ self new editor: anEditor! !

!TxEmbeddedObjectCommand methodsFor: 'geometry' stamp: 'IgorStasenko 8/21/2014 12:49'!
horizontalAdvanceUpTo: aTextPosition layout: aTextLayout

	^ aTextPosition spanPosition = 0 
		ifTrue:[ 0 ]
		ifFalse: [ self morph width ]! !

!TxEmbeddedObjectCommand methodsFor: 'accessing' stamp: 'IgorStasenko 8/21/2014 12:46'!
advance
	^ self width @ 0! !

!TxEmbeddedObjectCommand methodsFor: 'accessing' stamp: 'IgorStasenko 9/18/2014 18:05'!
morph: aMorph
	morph := aMorph! !

!TxEmbeddedObjectCommand methodsFor: 'accessing' stamp: 'IgorStasenko 8/21/2014 12:37'!
span
	^ span! !

!TxEmbeddedObjectCommand methodsFor: 'geometry' stamp: 'IgorStasenko 8/21/2014 12:54'!
textPositionForHorizontalOffset: anOffset layout: layout

	^ anOffset < (self advance x/2) 
		ifTrue: [ span startPosition ]
		ifFalse: [ span endPosition ]
	! !

!TxEmbeddedObjectCommand methodsFor: 'notification' stamp: 'IgorStasenko 9/18/2014 18:42'!
notifyRemovedFrom: layout 
	^ layout hideEmbeddedObject: morph! !

!TxEmbeddedObjectCommand methodsFor: 'accessing' stamp: 'IgorStasenko 8/21/2014 12:38'!
width
	^ self morph width! !

!TxEmbeddedObjectCommand methodsFor: 'rendering' stamp: 'IgorStasenko 8/21/2014 12:40'!
renderOn: renderer

	renderer 
		renderMorph: self morph;
		advance: self advance.! !

!TxEmbeddedObjectCommand methodsFor: 'accessing' stamp: 'IgorStasenko 8/21/2014 12:38'!
height
	^ self morph height! !

!TxEmbeddedObjectCommand methodsFor: 'accessing' stamp: 'IgorStasenko 8/21/2014 12:37'!
span: anObject
	span := anObject! !

!TxEmbeddedObjectCommand methodsFor: 'accessing' stamp: 'IgorStasenko 9/18/2014 18:05'!
morph
	^ morph! !

!TxEmbeddedObjectCommand methodsFor: 'accessing' stamp: 'IgorStasenko 8/21/2014 13:11'!
startPosition
	^ span startPosition! !

!TxEmbeddedObjectCommand methodsFor: 'testing' stamp: 'IgorStasenko 8/21/2014 12:44'!
contains: aTextPosition

	^ aTextPosition span == span ! !

!TxEmbeddedObjectSpan commentStamp: 'IgorStasenko 8/21/2014 11:46'!
To place embedded object into a text!
!TxEmbeddedObjectSpan methodsFor: 'accessing' stamp: 'IgorStasenko 8/21/2014 11:46'!
object: anObject
	object := anObject! !

!TxEmbeddedObjectSpan methodsFor: 'accessing-text position' stamp: 'IgorStasenko 8/21/2014 12:01'!
endPosition
	"answer the text position, pointing to the end of receiver"
	^ self positionAt: 1! !

!TxEmbeddedObjectSpan methodsFor: 'accessing' stamp: 'IgorStasenko 8/21/2014 11:46'!
object
	^ object! !

!TxEmbeddedObjectSpan methodsFor: 'accessing' stamp: 'IgorStasenko 8/21/2014 12:02'!
size
	^ 1! !

!TxEmbeddedObjectSpan methodsFor: 'operation' stamp: 'IgorStasenko 8/21/2014 12:56'!
insertCharacters: aString at: aTxTextPosition attributes: aTxAttributes 
	^ self next insertCharacters: aString at: self next startPosition attributes: aTxAttributes ! !

!TxEmbeddedObjectSpan methodsFor: 'visitor' stamp: 'IgorStasenko 8/21/2014 12:23'!
accept: anObject
	"visitor pattern"
	
	^ anObject visitEmbeddedObjectSpan: self! !

!TxEmbeddedObjectSpan methodsFor: 'accessing' stamp: 'IgorStasenko 8/21/2014 12:02'!
lineNumberAt: aTxTextPosition 
	^ self numberOfLinesBefore.! !

!TxEmbeddedObjectSpan methodsFor: 'operation' stamp: 'IgorStasenko 8/26/2014 12:59'!
removeBefore: anIndex
	anIndex = 1 ifTrue: [
			"remove ourselves"
			self delete.
	].
! !

!TxEmbeddedObjectSpan methodsFor: 'operation' stamp: 'IgorStasenko 8/26/2014 15:06'!
insertLineSeparator: separator at: position 

	position spanPosition > 0 ifTrue: [
		self insertNext: separator. 
		^ next endPosition ].
	
	self insertPrev: separator.
	^ self startPosition! !

!TxEmbeddedObjectSpan methodsFor: 'attributes' stamp: 'IgorStasenko 9/22/2014 16:39'!
applyAttribute: anAttribute from: startPosition to: endPosition
	"do not apply only if start position is > 1 or end < 1"
	
	(startPosition span == self and: [ startPosition spanPosition > 0 ]) ifTrue: [ ^ self ].
	(endPosition span == self and: [ endPosition spanPosition = 0 ]) ifTrue: [ ^ self ].
	self applyAttribute: anAttribute.
! !

!TxEmbeddedObjectSpan methodsFor: 'accessing-text position' stamp: 'IgorStasenko 8/21/2014 12:22'!
startPosition
	^ self positionAt: 0! !

!TxEmbeddedObjectSpan methodsFor: 'printing' stamp: 'IgorStasenko 8/21/2014 12:05'!
printContentsOn: aStream 
	aStream nextPut:$[; print: object; nextPut:$].! !

!TxEmbeddedObjectTest methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/21/2014 12:11'!
testInsertingObject
	| theObject  newPosition |
	theObject := Object new.
	newPosition := (text startPosition moveRight:5) insertObject: theObject.
	
	self assert: (newPosition moveLeft: 5) isAtStart not.
	self assert: (newPosition moveLeft: 6) isAtStart.
	

	! !

!TxEmbeddedObjectTest methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/21/2014 17:27'!
testBuildingLayoutWithObject
	| theObject   |
	theObject := Object new.
	(text startPosition moveRight:5) insertObject: theObject.

	"null containter don't allows embedded objects"
	self should: [ view resetLayout ] raise: Error.

	! !

!TxEndSpan commentStamp: '<historical>'!
End span is span which _always_ last span of text and only one. 
So this span used to denote end of text.!
!TxEndSpan methodsFor: 'accessing' stamp: 'IgorStasenko 9/2/2014 13:19'!
style
	"My attributes are always same as my previous span,
	unless text is empty, then it is default text attributes"
	
	^ text isEmpty
		ifTrue: [ text defaultStyle ]
		ifFalse: [ prev style ]! !

!TxEndSpan methodsFor: 'testing' stamp: 'IgorStasenko 6/7/2013 17:30'!
isAtEnd
	^ true! !

!TxEndSpan methodsFor: 'operation' stamp: 'IgorStasenko 6/14/2013 15:28'!
insertCharacters: chars at: position attributes: insertAttributes
	
	"Insert characters (no line separators allowed!!!!!!), with given attributes at given position in receiver.
	Answer the end position of inserted characters"
	
	"Since we cannot insert anything into end span, and its only valid position is zero,
	we either delegate to the previous character span, or create a new one, if none"
	
	| span |
	prev isCharacterSpan ifTrue: [
		^ prev insertCharacters: chars at: prev endPosition attributes: insertAttributes 
	].

	span := (text newCharacterSpan: chars) replaceAttributes: insertAttributes.
	self insertPrev: span.
	^ position
	! !

!TxEndSpan methodsFor: 'operation' stamp: 'IgorStasenko 6/10/2013 17:12'!
at: aTxTextPosition insertSingleLine: aString 

	prev isCharacterSpan ifFalse: [
		self insertPrev: text newCharacterSpan 
		].
	
	^ prev at: prev endPosition insertSingleLine: aString ! !

!TxEndSpan methodsFor: 'accessing' stamp: 'IgorStasenko 6/10/2013 17:14'!
lineNumberAt: aTxTextPosition
	"same as my previous span"
	^ prev lineNumberAt: prev endPosition! !

!TxEndSpan methodsFor: 'operation' stamp: 'IgorStasenko 6/10/2013 21:40'!
removeBefore: anIndex

	self assert: anIndex = 0.
	^ self! !

!TxEndSpan methodsFor: 'visitor' stamp: 'IgorStasenko 8/8/2013 03:46'!
accept: anObject
	"visitor pattern"
	
	^ anObject visitEndSpan: self! !

!TxEndSpan methodsFor: 'printing' stamp: 'IgorStasenko 6/10/2013 17:36'!
printOn: aStream

	 aStream nextPutAll: ' >>' ! !

!TxEndSpan methodsFor: 'accessing' stamp: 'IgorStasenko 6/11/2013 02:50'!
next: anObject
	self error: 'End span cannot have next span!!'! !

!TxEndSpan methodsFor: 'accessing-text position' stamp: 'IgorStasenko 6/11/2013 03:11'!
replaceAttributes: newAttributes
	"replace receiver's attributes by copying from given one"
	^ self! !

!TxEndSpan methodsFor: 'operation' stamp: 'IgorStasenko 6/11/2013 02:48'!
insertLineSeparator: separator at: position

	self insertPrev: separator.
	^ position! !

!TxEndSpan methodsFor: 'copying' stamp: 'IgorStasenko 10/11/2013 13:45'!
appendCopyTo: anotherText
	"Create a copy of receiver and append it to the another text (at the end of it).
	Answer the copy"

	"End span cannot be copied, instead we just answer the existing end span of another text"
	^ anotherText endSpan! !

!TxFontAttribute commentStamp: '<historical>'!
I represent font attribute for text span!
!TxFontAttribute class methodsFor: 'instance creation' stamp: 'IgorStasenko 8/8/2013 16:29'!
fontNamed: aFamilyName size: pointSize

	^  self new value: (LogicalFont familyName: aFamilyName pointSize: pointSize )! !

!TxFontAttribute class methodsFor: 'defaults' stamp: 'IgorStasenko 11/11/2014 17:40'!
defaultValue 
	| font |
	
	font := TextStyle defaultFont. 
	
	(font isKindOf: StrikeFont) ifTrue: [ 
		"no strike fonts please"
"		^  LogicalFont familyName: 'Verdana' pointSize: 12. "
		
		^  LogicalFont familyName: 'Helvetica' pointSize: 12. 
		 ].
	^ font! !

!TxForeColorAttribute commentStamp: '<historical>'!
I represent foreground color attribute for text span!
!TxForeColorAttribute class methodsFor: 'defaults' stamp: 'dik 1/5/2013 21:19'!
defaultValue 
	^Color black! !

!TxHighlightRenderer commentStamp: 'SeanDeNigris 4/4/2014 10:36'!
I highlight text backgroung e.g. to show a selection. I require a layout view, paint, and text interval.!
!TxHighlightRenderer methodsFor: 'private-accessing' stamp: 'SeanDeNigris 4/2/2014 17:43'!
paint: anObject
	paint := anObject! !

!TxHighlightRenderer methodsFor: 'private' stamp: 'SeanDeNigris 4/3/2014 15:06'!
trimIntervalToLayout
	| start end |

	interval minMaxDo: [ :min :max |
		start := (self layout startPosition max: min) min: self layout endPosition.
		extendEnd := self layout endPosition < max.
		end := (self layout startPosition max: max) min: self layout endPosition ].

	interval := start to: end.! !

!TxHighlightRenderer methodsFor: 'private-accessing' stamp: 'SeanDeNigris 4/2/2014 17:43'!
layoutView: anObject
	layoutView := anObject! !

!TxHighlightRenderer methodsFor: 'private-accessing' stamp: 'AlainPlantec 1/23/2015 11:32'!
shapes

	| lineStream currentLine startPoint endPoint height highlightStartPosition highlightEndPosition |
	shapes ifNotNil: [ ^ shapes ].
	
	shapes := OrderedCollection new.
	self trimIntervalToLayout.
	interval isEmpty ifTrue: [ ^ shapes ].

	highlightStartPosition := self layout positionAt: interval start ifOutside: [ self shouldNotHappen ].
	highlightEndPosition := self layout positionAt: interval end ifOutside: [ self shouldNotHappen ]. 
	
	height := 0.
	lineStream := self layout lines readStream.

	"Skip to line where highlight starts, caching the accumulated y offset for later"	
	[ (currentLine := lineStream next) = highlightStartPosition line ] whileFalse: [ height := height + currentLine height ].

	"The highlight of the first line of the interval will always start at... the start of the interval, duh"
	startPoint := highlightStartPosition topPoint.
	
	"The highlight of each line except the last ends at the right side of the view"
	[ currentLine == highlightEndPosition line ] whileFalse: [  
		endPoint := (layoutView width + layoutView offset x) @ (height + currentLine height).
		shapes add: (startPoint rectangle: endPoint).
		
		height := height + currentLine height.
		currentLine := lineStream next.
		startPoint := 0@height.
	].

	"We're at the last line, end the highlight at the end of the interval"
	endPoint := extendEnd 
		ifTrue: [ (layoutView width + layoutView offset x) @ (height + currentLine height) ]
		ifFalse: [ highlightEndPosition bottomPoint ].
	
	shapes add: (startPoint rectangle: endPoint).

	^ shapes.! !

!TxHighlightRenderer methodsFor: 'rendering' stamp: 'SeanDeNigris 4/3/2014 14:06'!
renderHighlightOn: canvas
	
	canvas pathTransform restoreAfter: [
		canvas pathTransform translateBy: layoutView offset negated.
		canvas setPaint: paint.
		self shapes do: [ :e | canvas drawShape: e ]
	].! !

!TxHighlightRenderer methodsFor: 'private-accessing' stamp: 'SeanDeNigris 4/3/2014 15:06'!
interval: aTxInterval
	interval := aTxInterval.
	shapes := nil.! !

!TxHighlightRenderer methodsFor: 'private-accessing' stamp: 'SeanDeNigris 4/2/2014 17:43'!
layout

	^ layoutView layout.! !

!TxHighlightRenderer class methodsFor: 'instance creation' stamp: 'SeanDeNigris 4/4/2014 10:38'!
highlighting: aTxInterval in: layoutView with: paint

	^ self new
		layoutView: layoutView;
		interval: aTxInterval;
		paint: paint;
		yourself.! !

!TxHighlightRendererTest methodsFor: 'canvas' stamp: 'SeanDeNigris 4/3/2014 11:19'!
pathTransform
! !

!TxHighlightRendererTest methodsFor: 'tests' stamp: 'SeanDeNigris 4/4/2014 10:43'!
testNoHighlightIfOutOfView
	
	| lastVisibleLine lastVisibleLineIndex |
	lastVisibleLine := self layout lines last.
	lastVisibleLineIndex := self layout lines size.
	self 
		initializeRendererWithIntervalFrom: lastVisibleLine startPosition moveDown + 1
		to: lastVisibleLine endPosition moveDown moveDown moveToLineEnd.

	renderer renderHighlightOn: self.

	self assert: drawnShapes isEmpty.! !

!TxHighlightRendererTest methodsFor: 'canvas' stamp: 'SeanDeNigris 4/3/2014 11:19'!
restoreAfter: aBlock

	aBlock value.! !

!TxHighlightRendererTest methodsFor: 'tests' stamp: 'SeanDeNigris 4/4/2014 10:43'!
testHighlightsOnlyToLayoutEndPosition
	"For a sample interval whose end is after the layout end, the highlight should end at the layout end"
	
	| lastVisibleLine lastVisibleLineIndex |
	lastVisibleLine := self layout lines last.
	lastVisibleLineIndex := self layout lines size.
	self 
		initializeRendererWithIntervalFrom: lastVisibleLine startPosition + 1
		to: lastVisibleLine endPosition moveDown moveToLineEnd.

	renderer renderHighlightOn: self.

	"Assert second line, which is out of view, is not highlighted"
	self assert: drawnShapes size equals: 1.
	self assertRectangle: 1 coversRightPartOfLine: lastVisibleLineIndex.! !

!TxHighlightRendererTest methodsFor: 'canvas' stamp: 'SeanDeNigris 4/3/2014 11:19'!
translateBy: aPoint 
! !

!TxHighlightRendererTest methodsFor: 'tests' stamp: 'SeanDeNigris 4/4/2014 10:43'!
testHighlightPartialLine
	"Where the selection is totally inside the layout"

	self 
		initializeRendererWithIntervalFrom: view text startPosition + 1
		to: view text startPosition + 5.
		
	renderer renderHighlightOn: self.

	self assert: drawnShapes size equals: 1.
	self assertRectangleCoversMiddleOfLine: 1.! !

!TxHighlightRendererTest methodsFor: 'running' stamp: 'SeanDeNigris 4/4/2014 10:42'!
setUp

	super setUp.
	drawnShapes := OrderedCollection new.
	isPaintSet := false.! !

!TxHighlightRendererTest methodsFor: 'canvas' stamp: 'SeanDeNigris 4/3/2014 11:21'!
drawShape: aRectangle 

	drawnShapes add: aRectangle.! !

!TxHighlightRendererTest methodsFor: 'tests' stamp: 'SeanDeNigris 4/4/2014 10:43'!
testHighlightsOnlyFromLayoutStartPosition
	"For a sample interval whose start is before the layout start, the highlight should start from the layout start"
		
	self 
		initializeRendererWithIntervalFrom: view text startPosition + 1
		to: view text startPosition moveDown + 5.
		
	view scrollBy: 0 @ self layout lines first height + 1.
		
	renderer renderHighlightOn: self.

	"Assert first line, which is out of view, is not highlighted"
	self assert: drawnShapes size equals: 1.
	self assertRectangle: 1 coversLeftPartOfLine: 1. "From the layout's perspective, 1 is the first one visible e.g. the second line in our selection"! !

!TxHighlightRendererTest methodsFor: 'canvas' stamp: 'SeanDeNigris 4/3/2014 11:20'!
setPaint: anObject

	isPaintSet := true.! !

!TxHighlightRendererTest methodsFor: 'tests' stamp: 'SeanDeNigris 4/4/2014 10:43'!
testHighlightMoreThanTwoLines
	"Where the selection is totally inside the layout"
	
	self 
		initializeRendererWithIntervalFrom: view text startPosition + 1
		to: view text startPosition moveDown moveDown + 5.
		
	renderer renderHighlightOn: self.

	self assert: drawnShapes size equals: 3.
	self assertRectangle: 1 coversRightPartOfLine: 1.
	self assertRectangle: 2 coversFullViewWidthOfLine: 2.
	self assertRectangle: 3 coversLeftPartOfLine: 3.! !

!TxHighlightRendererTest methodsFor: 'helpers' stamp: 'SeanDeNigris 4/4/2014 10:43'!
initializeRendererWithIntervalFrom: startTextPosition to: endTextPosition
	
	interval := startTextPosition to: endTextPosition.
	renderer := TxHighlightRenderer highlighting: interval in: view with: nil.! !

!TxHighlightRendererTest methodsFor: 'asserting' stamp: 'SeanDeNigris 4/4/2014 09:26'!
assertRectangleCoversMiddleOfLine: aNumber
	"For a single line selection, simply from the start to end of the selection should be highlighted"

	| expectedStart expectedEnd |
	expectedStart := view layout positionAt: interval start ifOutside: [ self fail ].
	self assert: drawnShapes first topLeft equals: expectedStart topPoint.
	
	expectedEnd := view layout positionAt: interval end ifOutside: [ self fail ].
	self assert: drawnShapes first bottomRight equals: expectedEnd bottomPoint.! !

!TxHighlightRendererTest methodsFor: 'asserting' stamp: 'SeanDeNigris 4/4/2014 09:37'!
assertRectangle: rectangleNumber coversFullViewWidthOfLine: lineNumber
	"When a highlighted line is not the first or the last, highlight from view left to view right"

	| line rectangle expectedStart expectedEndPoint lineEndPosition |
	line := view layout lines at: lineNumber.
	rectangle := drawnShapes at: rectangleNumber.
	expectedStart := view layout positionAt: line startPosition ifOutside: [ self fail ].
	self assert: rectangle topLeft equals: expectedStart topPoint.
	lineEndPosition := view layout positionAt: line endPosition ifOutside: [ self fail ].
	expectedEndPoint := view width @ lineEndPosition bottomPoint y.
	self assert: rectangle bottomRight equals: expectedEndPoint.! !

!TxHighlightRendererTest methodsFor: 'asserting' stamp: 'SeanDeNigris 4/4/2014 09:24'!
assertRectangle: rectangleNumber coversLeftPartOfLine: lineNumber
	"For the last line of a multi-line highlight, cover from the start of the line to the end of the selection"

	| line rectangle expectedStart expectedEnd |
	line := view layout lines at: lineNumber.
	rectangle := drawnShapes at: rectangleNumber.
	expectedStart := view layout positionAt: line startPosition ifOutside: [ self fail ].
	self assert: rectangle topLeft equals: expectedStart topPoint.
	expectedEnd := view layout positionAt: interval end ifOutside: [ self fail ].
	self assert: rectangle bottomRight equals: expectedEnd bottomPoint.! !

!TxHighlightRendererTest methodsFor: 'asserting' stamp: 'SeanDeNigris 4/4/2014 09:54'!
assertRectangle: rectangleNumber coversRightPartOfLine: lineNumber 
	"For the first line of a multi-line highlight, cover from the start of the selection to the right side of the view"

	| line rectangle expectedStart expectedEndPoint lineEndPosition |
	line := view layout lines at: lineNumber.
	rectangle := drawnShapes at: rectangleNumber.
	expectedStart := view layout positionAt: interval start ifOutside: [ self fail ].
	self assert: rectangle topLeft equals: expectedStart topPoint.
	lineEndPosition := view layout positionAt: line endPosition ifOutside: [ self fail ].
	expectedEndPoint := view width @ lineEndPosition bottomPoint y.
	self assert: rectangle bottomRight equals: expectedEndPoint.! !

!TxHighlightRendererTest methodsFor: 'tests' stamp: 'SeanDeNigris 4/4/2014 10:43'!
testHighlightTwoLines
	"For a sample interval which is on two lines, which are totally inside the layout, the following should be highlighted:
		- first line from interval start to view width
		- second line from line start to interval end"
		
	self 
		initializeRendererWithIntervalFrom: view text startPosition + 1
		to: view text startPosition moveDown + 5.
		
	renderer renderHighlightOn: self.

	self assert: drawnShapes size equals: 2.	
	self assertRectangle: 1 coversRightPartOfLine: 1.
	self assertRectangle: 2 coversLeftPartOfLine: 2.! !

!TxHorizontalSlider methodsFor: 'initialize' stamp: 'IgorStasenko 3/18/2014 15:55'!
defaultBounds
	^ (0@0 corner: 100 @ self defaultWidth)! !

!TxHorizontalSlider methodsFor: 'as yet unclassified ' stamp: 'IgorStasenko 3/21/2014 17:27'!
handleEventWhileDraggingSlider: event delta: delta

	| deltaPos newPosition ann |
	event redButtonPressed ifFalse: [ ^ false ]. "finished"
	
	event isMove ifTrue: [ 
		"adjust slider position relative to dragged position"

		deltaPos :=  (event position x - bounds left) - delta.
		newPosition := deltaPos / bounds width.
		ann := (TxSliderDragged source: self) oldPosition: sliderPosition; newPosition: newPosition; yourself.
		self sliderPosition: newPosition.
		
		self announcer announce: ann.
	 ].
	

	^ true.! !

!TxHorizontalSlider methodsFor: 'geometry' stamp: 'IgorStasenko 9/10/2014 16:20'!
extent: newExtent
	
	^ super extent: newExtent x @ self  defaultWidth.! !

!TxHorizontalSlider methodsFor: 'drawing' stamp: 'IgorStasenko 4/29/2014 16:48'!
drawOnAthensCanvas: aCanvas
	"before rendering transform from a global coordinates (Morphic) to relative coordinates (Athens)"
	| left right |
	left := bounds left + 1.
	right := bounds right - 1.
	aCanvas 
		setPaint: self backgroundColor;
		drawShape: bounds.
		
	aCanvas 
		setPaint: (captured ifTrue: [ self sliderHighlightColor ] ifFalse: [ self sliderColor] ).
		
	aCanvas drawShape: 
		((bounds left + mappedPosition max: left) @ (bounds top+1)
		rectangle: (bounds left + mappedPosition + mappedThickness min: right ) @ (bounds bottom-1)).
! !

!TxHorizontalSlider methodsFor: 'geometry' stamp: 'IgorStasenko 3/19/2014 10:51'!
mapMouseRelativeToSlider: aPosition

	"Map mouse (screen position) relative to slider position"

	^ (aPosition x - bounds left) min: bounds width max: 0
! !

!TxHorizontalSlider methodsFor: 'geometry' stamp: 'IgorStasenko 3/21/2014 15:32'!
originForDragStart: point


	^ point x - bounds left - mappedPosition! !

!TxHorizontalSlider methodsFor: 'geometry' stamp: 'IgorStasenko 4/29/2014 16:46'!
computeSliderBounds
	| max |
	
	max := self width.
		
	mappedThickness := max * thickness max: self minimumThicknessInPixels.
	mappedPosition := max * sliderPosition min: max.
	
	mappedPosition + mappedThickness > max ifTrue: [ 
		mappedPosition := max - mappedThickness.
		 ]
	 ! !

!TxInsertOperation commentStamp: 'IgorStasenko 8/26/2014 13:13'!
a history record containing insert operation!
!TxInsertOperation methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/20/2013 14:23'!
text: aString
	text := aString! !

!TxInsertOperation methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 11/20/2013 14:23'!
undo
	
	editor selection end moveLeft: text size.
	editor selection cut! !

!TxInsertedTextAnnouncement commentStamp: 'IgorStasenko 11/11/2014 16:47'!
I am announced right after some text are inserted into text.!
!TxInsertedTextAnnouncement methodsFor: 'accessing' stamp: 'IgorStasenko 11/11/2014 16:33'!
insertedText
	^ insertedText! !

!TxInsertedTextAnnouncement methodsFor: 'accessing' stamp: 'IgorStasenko 11/11/2014 16:33'!
insertedText: anObject
	insertedText := anObject! !

!TxInterval commentStamp: '<historical>'!
I am interval of text. I am immutable.!
!TxInterval methodsFor: 'conversion' stamp: 'IgorStasenko 6/4/2013 15:37'!
asString 
	| min max |
	min := start min: end.
	max := start max: end.
		
	^String streamContents: [ :s | 
		min printTextOn: s upTo: max.		
	]! !

!TxInterval methodsFor: 'enumeration' stamp: 'DenisKudrayshov 4/7/2013 00:23'!
do: aBlock

	| iterator |
	end < start ifTrue:[^self].
	
	iterator := start copy.
		
	[end = iterator] whileFalse: [ 
		aBlock value: iterator. 
		iterator moveRight] ! !

!TxInterval methodsFor: 'initialization' stamp: 'IgorStasenko 11/28/2013 10:14'!
initStart: startPosition end: endPosition

	start := startPosition asPosition.
	end := endPosition asPosition! !

!TxInterval methodsFor: 'testing' stamp: 'IgorStasenko 6/17/2013 17:56'!
isEmpty

	^ end hasSamePositionAs: start! !

!TxInterval methodsFor: 'enumeration' stamp: 'IgorStasenko 6/6/2013 11:52'!
minMaxDo: minMaxBlock

	^ start < end 
		ifTrue: [ minMaxBlock value: start value: end ]
		ifFalse: [ minMaxBlock value: end value: start ]! !

!TxInterval methodsFor: 'printing' stamp: 'IgorStasenko 10/15/2013 12:44'!
printOn: aStream

	super printOn: aStream.
	aStream 
		nextPut: $[;
		print: start.
		
	
		aStream 
			nextPutAll: ' .. ';
			print: end.
	
	
	aStream
		nextPut: $]! !

!TxInterval methodsFor: 'accessing' stamp: 'IgorStasenko 8/13/2012 17:21'!
end
	
	^ end! !

!TxInterval methodsFor: 'accessing' stamp: 'IgorStasenko 8/13/2012 17:21'!
start
	
	^ start! !

!TxInterval methodsFor: 'conversion' stamp: 'IgorStasenko 10/11/2013 13:05'!
copyText
	"answer a new text, holding a copy of text enclosed by receiver"
	
	^ self text copy: self! !

!TxInterval methodsFor: 'accessing' stamp: 'IgorStasenko 9/24/2013 14:55'!
text
	
	^ start text! !

!TxInterval methodsFor: 'testing' stamp: 'IgorStasenko 7/25/2013 16:39'!
contains: aPosition

	^ start <= aPosition and: [ end >= aPosition ]! !

!TxInterval class methodsFor: 'instance creation' stamp: 'IgorStasenko 9/24/2013 14:53'!
from: startPosition to: endPosition

	^ self basicNew initStart: startPosition end: endPosition
! !

!TxInterval class methodsFor: 'instance creation' stamp: 'IgorStasenko 10/7/2013 10:29'!
on: aText
	"Answer an interval, containing whole text"
	^ self from: aText startPosition to: aText endPosition! !

!TxLayoutStrategyTest methodsFor: 'private' stamp: 'IgorStasenko 8/26/2013 11:28'!
defaultLayoutViewExtent
	^ 10@1000! !

!TxLayoutStrategyTest methodsFor: 'running' stamp: 'FernandoOlivero 8/25/2013 10:13'!
setUp
	| text |
	text := self newText: self defaultText.
	view := self newViewOn: text.! !

!TxLayoutStrategyTest methodsFor: 'private' stamp: 'FernandoOlivero 8/25/2013 10:15'!
defaultText
	^ 'Pharo is a modern Smalltalk implementation'! !

!TxLayoutViewChanged methodsFor: 'accessing' stamp: 'IgorStasenko 3/26/2014 14:37'!
view: anObject
	
	view := anObject! !

!TxLayoutViewChanged methodsFor: 'accessing' stamp: 'IgorStasenko 3/26/2014 14:37'!
view
	
	^ view! !

!TxLayoutViewMorph methodsFor: 'updating' stamp: 'IgorStasenko 3/27/2014 16:20'!
resetViewTo: startPosition

	layoutView resetLayout: startPosition.
	self changed.! !

!TxLayoutViewMorph methodsFor: 'geometry' stamp: 'IgorStasenko 11/29/2013 17:18'!
ensurePointWithinLayout: aLayoutPoint
	^ layoutView ensurePointWithinLayout: aLayoutPoint! !

!TxLayoutViewMorph methodsFor: 'morphic geometry' stamp: 'IgorStasenko 9/19/2014 18:37'!
transform
	
	^ MorphicTransform offset: bounds topLeft negated + layoutView offset! !

!TxLayoutViewMorph methodsFor: 'view notifications' stamp: 'IgorStasenko 9/18/2014 18:32'!
registerEmbeddedMorph: aTxWrappingMorph 

	self addMorph: aTxWrappingMorph! !

!TxLayoutViewMorph methodsFor: 'updating' stamp: 'StephaneDucasse 2/11/2014 12:43'!
resetLayout
	layoutView resetLayout.
	self changed.! !

!TxLayoutViewMorph methodsFor: 'accessing' stamp: 'FernandoOlivero 9/4/2013 12:36'!
text
	^ layoutView text ! !

!TxLayoutViewMorph methodsFor: 'factory' stamp: 'IgorStasenko 9/18/2014 18:18'!
newEmbeddedObjectCommand: aTxEmbeddedObjectSpan 
	| morph |
	morph := TxWrappingMorph for: (aTxEmbeddedObjectSpan object asMorph).
	self registerEmbeddedMorph: morph.
	
	^ TxEmbeddedObjectCommand new 
		span: aTxEmbeddedObjectSpan;
		morph: morph;
		yourself! !

!TxLayoutViewMorph methodsFor: 'geometry' stamp: 'FernandoOlivero 9/4/2013 13:13'!
layoutPositionAt:  aTextPosition ifOutside: aBlock 
	^ layoutView layoutPositionAt:  aTextPosition ifOutside: aBlock! !

!TxLayoutViewMorph methodsFor: 'initialization' stamp: 'IgorStasenko 2/12/2014 14:04'!
initialize
	super initialize.
	self initializeText: '' asTxModel ! !

!TxLayoutViewMorph methodsFor: 'updating' stamp: 'IgorStasenko 10/22/2013 15:43'!
updateMorph
	layoutView resetLayout.
	self changed.
	! !

!TxLayoutViewMorph methodsFor: 'view notifications' stamp: 'IgorStasenko 9/18/2014 18:37'!
layoutIsAboutToResetIn: view
	"ignored"
	submorphs := #().! !

!TxLayoutViewMorph methodsFor: 'drawing' stamp: 'IgorStasenko 10/23/2013 01:24'!
layoutChanged
	
	self extent ~= layoutView extent ifTrue: [  layoutView extent: self extent ].
	super layoutChanged.
! !

!TxLayoutViewMorph methodsFor: 'accessing' stamp: 'IgorStasenko 10/30/2013 14:37'!
layoutStrategy: aStrategy

	layoutView layoutStrategy: aStrategy.
	self layoutChanged.! !

!TxLayoutViewMorph methodsFor: 'view notifications' stamp: 'IgorStasenko 9/18/2014 18:01'!
viewChanged: aTxAthensLayoutView 
	self changed.! !

!TxLayoutViewMorph methodsFor: 'accessing' stamp: 'IgorStasenko 3/26/2014 15:07'!
layoutView
	^ layoutView! !

!TxLayoutViewMorph methodsFor: 'event handling' stamp: 'IgorStasenko 9/19/2014 17:16'!
handleMouseOver: anEvent
	super handleMouseOver: anEvent.
! !

!TxLayoutViewMorph methodsFor: 'initialization' stamp: 'IgorStasenko 9/18/2014 17:59'!
initializeText: aTxModel 
	layoutView := TxAthensLayoutView new.
	layoutView container: self.
	layoutView initWithPosition: aTxModel startPosition extent: self extent. ! !

!TxLayoutViewMorph methodsFor: 'morphic geometry' stamp: 'IgorStasenko 9/19/2014 17:29'!
containsPoint: aPoint
	^ (bounds containsPoint: aPoint)! !

!TxLayoutViewMorph methodsFor: 'drawing' stamp: 'FernandoOlivero 9/4/2013 13:14'!
drawOn: aCanvas
	"do nothing"! !

!TxLayoutViewMorph methodsFor: 'drawing' stamp: 'IgorStasenko 9/22/2014 15:56'!
drawOnAthensCanvas: aCanvas
	"before rendering transform from a global coordinates (Morphic) to relative coordinates (Athens)"

	aCanvas pathTransform restoreAfter: [ 
		aCanvas pathTransform 
			translateBy: self innerBounds origin.
		layoutView renderOn: aCanvas ].! !

!TxLayoutViewMorph methodsFor: 'morphic geometry' stamp: 'IgorStasenko 9/24/2014 15:24'!
invalidRect: damageRect from: aMorph
	"Translate damage reports from submorphs by the scrollOffset."
	aMorph == self
		ifTrue:[super invalidRect: damageRect from: self]
		ifFalse:[super invalidRect: (((self transform localBoundsToGlobal: damageRect) intersect: bounds ifNone: [ ^ self ] ) expandBy: 1) from: self].
! !

!TxLayoutViewMorph methodsFor: 'updating' stamp: 'IgorStasenko 11/29/2013 17:11'!
scrollIntoView: aTextPosition
	^ self scrollIntoView: aTextPosition margin: 0! !

!TxLayoutViewMorph methodsFor: 'updating' stamp: 'IgorStasenko 10/30/2013 15:26'!
scrollIntoView: aTextPosition margin: visibleMargin
	layoutView scrollIntoView: aTextPosition margin: visibleMargin.
	self changed.! !

!TxLayoutViewMorph methodsFor: 'geometry' stamp: 'FernandoOlivero 9/4/2013 13:37'!
textPositionAt:  aPoint  
	^ layoutView textPositionAt:  aPoint! !

!TxLayoutViewMorph methodsFor: 'updating' stamp: 'IgorStasenko 12/29/2013 17:16'!
scrollBy: aPoint 
	layoutView scrollBy: aPoint.
	self changed.! !

!TxLayoutViewMorph methodsFor: 'view notifications' stamp: 'IgorStasenko 9/18/2014 18:44'!
hideEmbeddedObject: morph
	morph delete.! !

!TxLayoutViewMorph methodsFor: 'morphic geometry' stamp: 'IgorStasenko 9/19/2014 18:40'!
privateFullMoveBy: delta
	"Private!! Relocate me and all of my subMorphs by recursion. Subclasses that implement different coordinate systems may override this method."
	self privateMoveBy: delta.
! !

!TxLayoutViewMorph methodsFor: 'morphic geometry' stamp: 'IgorStasenko 9/19/2014 17:37'!
transformFrom: uberMorph
	"my local coordinate system is in sync with text layout"
	
	(owner isNil or:[self == uberMorph]) ifTrue: [ ^self transform].
	^(owner transformFrom: uberMorph) composedWithLocal: self transform! !

!TxLayoutViewMorph class methodsFor: 'instance creation' stamp: 'IgorStasenko 2/12/2014 14:03'!
text: aTxModel 
	^ self new initializeText: aTxModel asTxModel.! !

!TxLayoutViewMorph class methodsFor: 'examples' stamp: 'FernandoOlivero 9/4/2013 11:27'!
openInWindowWithText: aTxModel

	| viewMorph  wrapper |
	
	viewMorph := self text: aTxModel.
	
	viewMorph 
		hResizing: #spaceFill;
		vResizing: #spaceFill.
		
	wrapper := AthensWrapMorph new.
	
	wrapper addMorph: viewMorph.
	
	^ wrapper openInWindow! !

!TxLayoutViewMorph class methodsFor: 'examples' stamp: 'IgorStasenko 8/30/2013 14:58'!
openInWindowWithString: aString

	| text |
	
	text := TxModel new.
	text atAttribute: TxFontAttribute  put: (LogicalFont familyName: 'Monaco' pointSize: 20 ).
	text endPosition insert: aString.
	
	^ self openInWindowWithText: text! !

!TxLineSeparator commentStamp: '<historical>'!
i representing a line separator
(NOT a new line in text).

My size is always 1. And my textual representation is always Character cr.

I have only two valid span positions:
 0 - denotes the last valid position of previous line (line end)
 1 - denotes the first valid position of next line (line start).

My attributes defining the default attributes of the new line, so even if next span
is a line separator (meaning that next line is empty), i can provide information for visual properties such as line height etc.
!
!TxLineSeparator methodsFor: 'printing' stamp: 'IgorStasenko 9/17/2012 16:50'!
asStringOn: aStream
	aStream cr.! !

!TxLineSeparator methodsFor: 'accessing' stamp: 'IgorStasenko 6/7/2013 15:42'!
size
	^ 1! !

!TxLineSeparator methodsFor: 'operation' stamp: 'IgorStasenko 6/11/2013 03:29'!
insertCharacters: chars at: position attributes: insertAttributes
	"Insert a single line character string at the given position,
	answer a new position pointing to the end of inserted string"

	| spanPos newSpan |

	spanPos := position spanPosition.
	spanPos = 0 ifTrue: [ 
		prev isCharacterSpan ifTrue: [ 
			^ prev insertCharacters: chars at: prev endPosition attributes: insertAttributes ].
		newSpan := (text newCharacterSpan: chars) replaceAttributes: insertAttributes.
		self insertPrev: newSpan.
		^ position	
	].
	
	next isCharacterSpan ifTrue: [ 
		^ next insertCharacters: chars at: next startPosition attributes: insertAttributes ].
	newSpan := (text newCharacterSpan: chars) replaceAttributes: insertAttributes.
	self insertNext: newSpan.
	^ next endPosition! !

!TxLineSeparator methodsFor: 'operations' stamp: 'TristanBourgois 1/21/2013 12:15'!
mergeUpTo: aSpan
(aSpan = self next) ifTrue:[
			^self next.
	].
	^self next mergeUpTo: aSpan.! !

!TxLineSeparator methodsFor: 'accessing' stamp: 'IgorStasenko 6/7/2013 16:28'!
lineNumberAt: textPosition 
	"i am not changing the number of lines"
	^ self numberOfLinesBefore + (textPosition spanPosition "0 or 1")! !

!TxLineSeparator methodsFor: 'drawing' stamp: 'DenisKudryashov 3/23/2013 21:58'!
drawOn: aCanvas from: start to: end at: aPoint font: aFont! !

!TxLineSeparator methodsFor: 'operation' stamp: 'IgorStasenko 6/10/2013 21:41'!
removeBefore: anIndex
	anIndex = 1 ifTrue: [
		"remove ourselves"
		self delete.
		].
	! !

!TxLineSeparator methodsFor: 'operations' stamp: 'IgorStasenko 9/18/2014 18:41'!
styleAtPosition: txPosition 

	"The receiver's attributes is defined for the next line,
	however a text position pointing to beginning of receiver is formally an insertion point belonging
	to previous line, therefore we must use previous span attributes"
	
	^ txPosition spanPosition = 0
		ifTrue: [ prev style ]
		ifFalse: [ style ]! !

!TxLineSeparator methodsFor: 'attributes' stamp: 'IgorStasenko 6/18/2013 14:05'!
applyAttribute: anAttribute from: startPosition to: endPosition
	"do not apply only if start position is > 1 or end < 1"
	
	(startPosition span == self and: [ startPosition spanPosition > 0 ]) ifTrue: [ ^ self ].
	(endPosition span == self and: [ endPosition spanPosition = 0 ]) ifTrue: [ ^ self ].
	self applyAttribute: anAttribute.
! !

!TxLineSeparator methodsFor: 'operation' stamp: 'IgorStasenko 6/14/2013 15:50'!
deleteUpTo: end startingAt: start
	self assert: start span == self.
	
	end span == self ifTrue: [
		start spanPosition > 0 ifTrue: [ "nothing to delete" ^ end ].
		end spanPosition = 1 ifTrue: [ self delete. ^ next startPosition ].
		^ end
	].
	
	start spanPosition = 0 ifTrue: [
		self delete.
	].
	^ next deleteUpTo: end startingAt: next startPosition.
! !

!TxLineSeparator methodsFor: 'accessing' stamp: 'IgorStasenko 10/23/2014 16:21'!
characterBeforePosition: spanPosition ifNone: aBlock

	"Answer character which is right before the position, located in receiver
	or evaluate a block if there's none"
	
	(spanPosition = 1)
		ifTrue: [ ^ Character cr ].
		
	^ aBlock value! !

!TxLineSeparator methodsFor: 'printing' stamp: 'IgorStasenko 4/10/2014 15:52'!
asStringOn: aStream startingAt: index
	index < 1 ifTrue: [  aStream cr ].! !

!TxLineSeparator methodsFor: 'accessing-text position' stamp: 'IgorStasenko 6/7/2013 15:48'!
endPosition
	"answer the text position, pointing to the end of receiver"
	^ self positionAt: 1! !

!TxLineSeparator methodsFor: 'visitor' stamp: 'IgorStasenko 8/8/2013 03:46'!
accept: anObject
	"visitor pattern"
	
	^ anObject visitLineSeparator: self! !

!TxLineSeparator methodsFor: 'operations' stamp: 'TristanBourgois 1/21/2013 12:18'!
doMerge: aCharacterSpan
	^ false.! !

!TxLineSeparator methodsFor: 'testing' stamp: 'IgorStasenko 6/10/2013 22:13'!
isAtLineStart: spanPosition
	"position behind #cr , means a line start"
	^ spanPosition > 0! !

!TxLineSeparator methodsFor: 'testing' stamp: 'IgorStasenko 10/14/2013 12:07'!
isLastPosition: aNumber
	^ aNumber = 1! !

!TxLineSeparator methodsFor: 'operation' stamp: 'IgorStasenko 6/11/2013 02:51'!
insertLineSeparator: separator at: position
	
	position spanPosition > 0 ifTrue: [
		self insertNext: separator. 
		^ next endPosition ].
	
	self insertPrev: separator.
	^ self startPosition! !

!TxLineSeparator methodsFor: 'printing' stamp: 'IgorStasenko 6/7/2013 17:07'!
printOn: aStream
	aStream nextPutAll: '#cr'! !

!TxLineSeparator methodsFor: 'accessing-text position' stamp: 'IgorStasenko 6/7/2013 15:46'!
startPosition
	"answer the text position, pointing to the start of receiver"
	^ self positionAt: 0! !

!TxLineSeparator methodsFor: 'printing' stamp: 'IgorStasenko 4/10/2014 16:00'!
asStringOn: aStream startingAt: startIndex upTo: endIndex
	"specialized in subclasses"
	(endIndex - startIndex > 0) ifTrue: [ 
		aStream cr.
		 ]! !

!TxLineSeparator methodsFor: 'testing' stamp: 'IgorStasenko 10/14/2012 09:49'!
isLineSeparator
	^ true! !

!TxLineSeparator methodsFor: 'printing' stamp: 'IgorStasenko 6/7/2013 15:44'!
printContentsOn: aStream
	aStream cr! !

!TxMockAttribute commentStamp: 'IgorStasenko 10/21/2014 17:20'!
this is mock, go away!
!TxMockAttribute class methodsFor: 'defaults' stamp: 'IgorStasenko 10/21/2014 17:16'!
defaultValue 
	^ #mockDefaultValue! !

!TxMockTextModel commentStamp: 'IgorStasenko 10/21/2014 17:20'!
this is mock, go away!
!TxMockTextModel methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/21/2014 17:22'!
getAttribute: anAttributeClass
	^ #mockValue! !

!TxMockTextModel methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/21/2014 17:21'!
defaultStyle
	^ TxStyle new.! !

!TxModel commentStamp: '<historical>'!
I am central class, representing the text. 

Internally my instances are organized as a list spans (TxBasicSpan subclasses). There are multiple kinds of spans, like: CharacterSpan and LineSeparator. Each span has reference to next and previous spans, forming double-linked list.
The list is terminated from both ends with special TxStartSpan and TxEndSpan instances (which means even empty text consists of at least two such spans). 

Spans carrying the actual text content, like characters and attributes. 
The model designed in a way that it should be fairly easy to extend it by introducing new kinds of spans later. 

I don't provide a direct interface for mutating/editing my data (and this is very important point), instead 
any modifications of my instances involving position(s) (TxTextPosition)
and/or selection(s) (TxInterval/TxSelection), providing a rich protocol for various operations over text. 

!
!TxModel methodsFor: 'private' stamp: 'IgorStasenko 10/13/2014 15:22'!
applyAttribute: anAttribute onSelection: selection
	"Apply given attribute to selection.  Preserve the selection interval while modifying the text"
	| currentSpan min max |
	
	selection isEmpty ifTrue: [ ^ self ].
	min := (selection start min: selection end).
	max := (selection start max: selection end).
	currentSpan := min span.
	[ 
		currentSpan applyAttribute: anAttribute from: min to: max.
		currentSpan == max span ifTrue: [  ^ self normalize: selection. "done" ].
		currentSpan := currentSpan next.
	] repeat.
	
	! !

!TxModel methodsFor: 'conversion' stamp: 'IgorStasenko 9/17/2012 16:42'!
asStringOn: aStream
	self spansDo: [:span | span asStringOn: aStream ].! !

!TxModel methodsFor: 'accessing' stamp: 'IgorStasenko 9/24/2013 14:50'!
cursor
	"answer a position , corresponding to start position in receiver"
	^ self startPosition asCursor! !

!TxModel methodsFor: 'accessing' stamp: 'IgorStasenko 10/23/2013 20:00'!
positionAtTextIndex: textIndex
	"Answer the position, which corresponds to given text index.
	This method is symmetrical to 
	TxBasicTextPosition>>#textIndex. 
	
	Please note that converting text index<->position does not takes constant time, 
	because it requires linear scan from the beginning of text.

	Also note that text index does not corresponds to some the character index in text, 
	but to index of unique insertion point in text, with the exception that endpoints of adjacent spans
	considered as same(single) insertion point, not two separate ones.
	"

	^ self startPosition moveRight: textIndex! !

!TxModel methodsFor: 'accessing' stamp: 'IgorStasenko 8/29/2014 16:40'!
addStyle: aTxStyle

	^ styles addStyle: aTxStyle ! !

!TxModel methodsFor: 'private' stamp: 'TristanBourgois 1/21/2013 11:02'!
mergeFrom: aSpan
		self mergeFrom: aSpan to: self endSpan.
	
	! !

!TxModel methodsFor: 'accessing' stamp: 'CamilloBruni 9/18/2012 15:37'!
spans
	^ Array streamContents: [ :s|
		self spansDo: [ :span | s nextPut: span ]]! !

!TxModel methodsFor: 'private' stamp: 'IgorStasenko 10/14/2012 08:45'!
newCharacterSpan: aString
	^ self newCharacterSpan
		characters: aString;
		yourself! !

!TxModel methodsFor: 'private' stamp: 'CamilloBruni 10/10/2012 21:20'!
deleteFrom: startPos to: endPos
	| start end |
	"note, end can be 'before' the start"
	start := endPos min: startPos.
	end := endPos max: startPos.

	start deleteUpTo: end.! !

!TxModel methodsFor: 'accessing' stamp: 'IgorStasenko 9/20/2013 12:46'!
endPosition
	^ TxTextPosition span: endSpan spanPosition: 0! !

!TxModel methodsFor: 'initialize-release' stamp: 'IgorStasenko 8/28/2014 14:35'!
initialize
	super initialize.
	styles := TxTextStyles on: self.
	self setNewContents.
	! !

!TxModel methodsFor: 'operations' stamp: 'IgorStasenko 10/2/2014 18:13'!
normalize: selection
	"Normalize the spans found in selection, trying to merge adjacent spans if they 
	has same style"
	| min max span |
	
	min := selection start min: selection end.
	max := selection start max: selection end.
	
	span := min span prev.
	
	[  span tryMergeWithNextPreserving: selection.
	   span == max span ] whileFalse: [ span := span next ].

! !

!TxModel methodsFor: 'testing' stamp: 'IgorStasenko 6/4/2013 16:27'!
includesSpan: span

	self spansDo: [:each | each == span ifTrue: [ ^ true ] ].
	^ false! !

!TxModel methodsFor: 'accessing' stamp: 'IgorStasenko 10/13/2014 15:42'!
characterStream
	^ self startPosition characterStream! !

!TxModel methodsFor: 'copying' stamp: 'IgorStasenko 10/14/2013 12:12'!
copy: interval
	"Answer a new text, holding a copy of text enclosed by receiver"

	| copyStartSpan copyEndSpan  newText |
	 
	newText := self class new. 

	interval isEmpty ifTrue: [ ^ newText ].
	
	interval minMaxDo: [ :min :max |
		| span |
		
		span := min span.
		
		[ | copy | 
			copy := span appendCopyTo: newText.
			span == min span ifTrue: [ copyStartSpan := copy  ].
			span == max span ifTrue: [ copyEndSpan := copy  ].
			span ~= max span ] whileTrue: [  span := span next ].
		 
		"we cut the end first, to not invalidate the start position"
		((copyEndSpan positionAt: max spanPosition) selectTo: newText endPosition) cut.
		(newText startPosition selectTo: (copyStartSpan positionAt: min spanPosition)) cut.
	 ].

	^ newText

! !

!TxModel methodsFor: 'printing' stamp: 'IgorStasenko 6/14/2013 16:29'!
printOn: aStream
	super printOn: aStream.
	aStream space; print: self spans! !

!TxModel methodsFor: 'factory-selection ' stamp: 'IgorStasenko 6/17/2013 18:17'!
selection
	^ self newSelection ! !

!TxModel methodsFor: 'initialize-release' stamp: 'IgorStasenko 6/7/2013 17:39'!
setNewContents
	startSpan := TxStartSpan text: self.
	endSpan := TxEndSpan text: self.
	startSpan next: endSpan! !

!TxModel methodsFor: 'enumerating' stamp: 'IgorStasenko 10/14/2012 05:27'!
spansAndLineNumbersDo: aBlock
	| lineNumber |
	lineNumber := 1.
	
	self startSpan do: [:span |
		aBlock value: span value: lineNumber.
		span isLineSeparator ifTrue: [ lineNumber := lineNumber + 1].].! !

!TxModel methodsFor: 'operations' stamp: 'DenisKudrayshov 5/11/2013 01:24'!
import: anotherTextModel 

	| copy |
	copy := anotherTextModel veryDeepCopy.
	copy spansDo: [ :each | each text: self ].
	startSpan := copy startSpan.
	endSpan := startSpan last! !

!TxModel methodsFor: 'factory-selection ' stamp: 'IgorStasenko 10/7/2013 10:28'!
newSelection
	"Asking for selection from any text instance, should give a selection holding whole text"

	^ TxSelection on: self! !

!TxModel methodsFor: 'operations' stamp: 'IgorStasenko 6/7/2013 15:08'!
delete: anInterval
	"Delete portion of text enclosed by interval.
	Answer the insertion position pointing to the text where
	interval was residing"
	
	^ anInterval minMaxDo: [:min :max | min deleteUpTo: max ]! !

!TxModel methodsFor: 'accessing' stamp: 'IgorStasenko 9/20/2013 12:46'!
startPosition
	^ TxTextPosition span: startSpan spanPosition: 0! !

!TxModel methodsFor: 'conversion' stamp: 'IgorStasenko 8/13/2012 17:07'!
asString 
	^ String streamContents: [:str | self asStringOn: str ]
	! !

!TxModel methodsFor: 'testing' stamp: 'IgorStasenko 6/10/2013 16:29'!
isEmpty
	^ startSpan next == endSpan ! !

!TxModel methodsFor: 'private' stamp: 'IgorStasenko 10/14/2012 08:40'!
newCharacterSpan
	^ TxCharacterSpan text: self! !

!TxModel methodsFor: 'enumerating' stamp: 'IgorStasenko 10/14/2012 10:32'!
spansDo: aBlock
	self startSpan do: aBlock! !

!TxModel methodsFor: 'operations' stamp: 'IgorStasenko 6/11/2013 03:08'!
at: aTxPosition insert: aString 

	^ aTxPosition span at: aTxPosition insert: aString! !

!TxModel methodsFor: 'private' stamp: 'IgorStasenko 6/4/2013 17:16'!
applyAttribute: anAttribute to: interval 
	| start end |
	"note, end can be 'before' the start"
	start := interval start.
	end := interval end.
	start := start min: end.
	end := start max: end.
	
	start applyAttribute: anAttribute UpTo: end.
	! !

!TxModel methodsFor: 'operations' stamp: 'IgorStasenko 6/14/2013 18:01'!
normalize
	"normalize the receiver, merging spans which having same attributes"
	self spansDo: [:span | span tryMergeWithNext ]
	! !

!TxModel methodsFor: 'conversion' stamp: 'IgorStasenko 2/12/2014 13:58'!
asTxModel
	^ self! !

!TxModel methodsFor: 'accessing' stamp: 'IgorStasenko 9/2/2014 13:09'!
getAttribute: attributeClass

	^ self defaultStyle get: attributeClass ! !

!TxModel methodsFor: 'accessing' stamp: 'IgorStasenko 6/7/2013 17:40'!
endSpan
	^ endSpan ! !

!TxModel methodsFor: 'accessing' stamp: 'IgorStasenko 6/7/2013 17:40'!
startSpan
	^ startSpan ! !

!TxModel methodsFor: 'copying' stamp: 'IgorStasenko 8/27/2013 15:55'!
postCopy
	self halt.! !

!TxModel methodsFor: '*TxText-Athens' stamp: 'IgorStasenko 9/26/2014 13:53'!
editInWindow
	^ TxViewContainer editText: self! !

!TxModel methodsFor: 'private' stamp: 'IgorStasenko 6/4/2013 15:51'!
mergeFrom: aStartSpan to: aEndSpan
	(aStartSpan = aEndSpan) ifFalse:[
		
		
			aStartSpan mergeUpTo: aEndSpan.
		].
	
	! !

!TxModel methodsFor: 'private' stamp: 'IgorStasenko 10/14/2012 09:09'!
newLineSeparator 
	^ TxLineSeparator text: self! !

!TxModel methodsFor: 'accessing' stamp: 'IgorStasenko 8/29/2014 15:27'!
defaultStyle
	^ styles defaultStyle! !

!TxModel methodsFor: 'factory-selection ' stamp: 'IgorStasenko 6/7/2013 17:38'!
select
	"convenience method for modifying selection"
	^ self selection! !

!TxModel methodsFor: 'factory-selection ' stamp: 'IgorStasenko 7/30/2013 16:48'!
selectAll
	"convenience method for getting selection which covers entire text"
	^ self selection all! !

!TxModel methodsFor: 'accessing' stamp: 'IgorStasenko 8/29/2014 15:28'!
styles
	^ styles! !

!TxModel class methodsFor: 'instance creation' stamp: 'IgorStasenko 2/12/2014 14:01'!
fromString: aString
	| text |
	text := self new.
	
	text endPosition insert: aString.
	
	^ text! !

!TxModelTest methodsFor: 'tests-navigation' stamp: 'dik 11/25/2012 21:44'!
testCut
	self newText: 'ABCDEF'.
	
	selection all.
	selection end moveLeft: 2.
	selection start moveRight: 2.
	
	selection cut.

	self assert: text asString equals: 'ABEF'! !

!TxModelTest methodsFor: 'tests-navigation' stamp: 'dik 11/25/2012 21:41'!
testReplacePart

	self newText: 'ABCDEF'.
	selection all.
	selection end moveLeft: 3.

	selection replaceWith: 'DEF'.

	self assert: text asString equals: 'DEFDEF'! !

!TxModelTest methodsFor: 'tests-selection' stamp: 'dik 11/25/2012 21:43'!
testSelectionAll
	
	self newText: 'ABC', String cr, 'DEF'.
	
	selection all.
	
	self assert: selection start isAtStart.
	self assert: selection end isAtEnd.! !

!TxModelTest methodsFor: 'tests-insertion' stamp: 'dik 11/25/2012 21:36'!
testInsertAtStart
	
	self newText: 'ABC'.
	
	cursor moveToStart.
	
	self assert: cursor isAtStart.
	cursor insert: 'xyz'.
	
	self assert: text asString equals: 'xyzABC'.	
	self assert: cursor linePosition equals: 3
! !

!TxModelTest methodsFor: 'tests-navigation' stamp: 'dik 11/25/2012 21:37'!
testDown

	self newText: 'ABC', String cr, 'DEF'.

	cursor moveToStart.	
	cursor moveDown.

	self assert: cursor lineNumber equals: 2.
	self assert: cursor linePosition equals: 0.
	
	cursor moveDown.
	self assert: cursor isAtEnd.! !

!TxModelTest methodsFor: 'test-attribute' stamp: 'IgorStasenko 9/2/2014 14:11'!
testApplySameFont
	"I made this test because for other attribute like bold if you apply this attribute when it already on the span the attribute is removed "
	|font  |
	self newText: 'AAACCC'.
	font := TxFontAttribute with: #fakeFont.
	
	selection all.
	
	selection applyAttribute:  font.
	"use start position because there are one span "
	self assert: ((selection start span  style) get: TxFontAttribute) equals: #fakeFont.
	
	selection applyAttribute:  font.
	
	self assert: ((selection start span style) get: TxFontAttribute) equals: #fakeFont.! !

!TxModelTest methodsFor: 'tests-selection' stamp: 'DenisKudrayshov 4/28/2013 17:59'!
testReversedSelectionAsString
	
	self newText: 'ABCDEF'.

	selection beSelection.
	selection start moveToStart.
	selection end moveToStart.
	selection start moveRight.
	
	self assert: selection asString equals: 'A'.

! !

!TxModelTest methodsFor: 'tests-insertion' stamp: 'dik 11/25/2012 21:35'!
testInsertAtCurrentPosition
	
	self newText: 'ABC'.
	
	self assert: text asString equals: 'ABC'.
	
	self assert: cursor isAtEnd.
	self deny: cursor isAtStart.
	
	self assert: cursor linePosition equals: 3.
	self assert: cursor lineNumber equals: 1! !

!TxModelTest methodsFor: 'tests-insertion' stamp: 'IgorStasenko 10/7/2013 10:51'!
testInsertTwoEmptyLinesThenDeleteFirstAndMoveRight
	
	self newText: 'AAACCC'.

	cursor linePosition: 3.	
	cursor insert: String cr; insert: String cr.
	cursor moveToStart.
	cursor linePosition: 3.	
		
	selection := cursor asSelection. 
	selection deleteKey.
	cursor moveRight.
	
	self assert: text asString equals: 'AAA', String cr, 'CCC'.
	
	self assert: cursor lineNumber equals: 2.
	self assert: cursor linePosition equals: 0.
	! !

!TxModelTest methodsFor: 'tests-selection' stamp: 'IgorStasenko 10/11/2013 13:02'!
testCopyText
	| newText |	
	self newText: 'ABCDEF'.

	selection all.	
	selection start moveRight.
	selection end moveLeft.
	
	newText := selection copyText.
	
	self assert: newText asString equals: 'BCDE'.

! !

!TxModelTest methodsFor: 'test-attribute' stamp: 'IgorStasenko 9/2/2014 15:46'!
testApplyFontWithTwoSplit
	"We can have only one or two split apply on a TextModel "
	| color default |
	self newText: 'AAACCC'.
	self assert: text spans size = 3.
	color := TxBackColorAttribute with: #foo.
	default := text getAttribute: TxBackColorAttribute.
	
	selection beSelection end moveLeft: 2.
	selection start moveLeft:4.

	selection applyAttribute:  color.
	cursor := selection end.
	cursor moveToStart.
	self assert: text spans size = 5.
	self assert: ((cursor  span  style) get: TxBackColorAttribute) equals: default.
	cursor moveRight:3.
	self assert: ((cursor  span style) get: TxBackColorAttribute) equals:  #foo.
	cursor moveRight:3.
	self assert: ((cursor  span style) get: TxBackColorAttribute) equals: default.! !

!TxModelTest methodsFor: 'tests-navigation' stamp: 'IgorStasenko 10/7/2013 10:43'!
testBackspaceKey
	
	self newText: 'ABC',String cr,'DEF'.
	
	"place cursor to the start of second line"

	selection := text startPosition moveDown asSelection.
	
	selection backspaceKey.
	
	self assert: text asString equals: 'ABCDEF'.
	
	selection backspaceKey.

	self assert: text asString equals: 'ABDEF'.

	selection start moveToEnd.
	selection end moveToEnd.
	selection backspaceKey.

	self assert: text asString equals: 'ABDE'.
! !

!TxModelTest methodsFor: 'tests-navigation' stamp: 'dik 11/25/2012 21:40'!
testLeftSingleLine
	
	self newText: 'ABC'.
	
	self deny: cursor isAtStart.
	
	cursor moveLeft: 3.
	self assert: cursor isAtStart.
	
	cursor moveLeft.
	self assert: cursor isAtStart.! !

!TxModelTest methodsFor: 'tests-selection' stamp: 'DenisKudrayshov 4/28/2013 17:19'!
testSelectionAsString
	
	self newText: 'ABC', String cr, 'DEF'.
	
	selection all.
	selection start moveRight.
	selection end moveLeft.
	
	self assert: selection asString equals: 'BC
DE'.

! !

!TxModelTest methodsFor: 'tests-navigation' stamp: 'IgorStasenko 9/20/2013 12:56'!
testStartEnd
	| pos |
	self newText: 'ABC', String cr, 'DEF'.
	
	pos := text startPosition.
	
	self assert: pos isAtStart.
	self assert: pos lineNumber equals: 1.
	self assert: pos linePosition equals: 0.
	
	pos := text endPosition.

	self assert: pos isAtEnd.
	self assert: pos lineNumber equals: 2.
	self assert: pos linePosition equals: 3.! !

!TxModelTest methodsFor: 'tests-insertion' stamp: 'IgorStasenko 6/14/2013 15:32'!
testInsertNewLineShouldChangeTextEndSpan
	
	self newText: 'AAACCC'.

	cursor linePosition: 3.	
	cursor insert: String cr.
	
	self assert: text asString = ('AAA',String cr,'CCC').
	self assert: cursor lineNumber equals: 2.! !

!TxModelTest methodsFor: 'test-attribute' stamp: 'IgorStasenko 9/2/2014 14:10'!
testApplyFontOnOneSpan
	|font|
	self newText: 'AAACCC'.
	font := TxFontAttribute with: #fakeFont.
	
	selection all.
	
	selection applyAttribute:  font.
	"use start position because there are one span "
	self assert: (selection start span getAttribute: TxFontAttribute) equals: #fakeFont.
	! !

!TxModelTest methodsFor: 'tests-insertion' stamp: 'DenisKudrayshov 4/24/2013 20:41'!
testInsertEmptyLineThenMoveRightThenMoveLeftTwice
	
	self newText: 'AAACCC'.

	cursor linePosition: 3.	
	cursor insert: String cr.
	
	self assert: text asString equals: 'AAA', String cr, 'CCC'.
	
	cursor moveRight.
	cursor moveLeft.
	cursor moveLeft.
	self assert: cursor lineNumber equals: 1.
	self assert: cursor linePosition equals: 3.
	! !

!TxModelTest methodsFor: 'test-attribute' stamp: 'IgorStasenko 6/4/2013 14:49'!
testInsertingNewLinePreservesAttributes
	
	self newText: 'AAACCC'.
	
	cursor linePosition: 3.
	self assert: cursor linePosition equals: 3.
	
	cursor insert: 'bbb'.
	
	self assert: text asString equals: 'AAAbbbCCC'.
	
	self assert: cursor linePosition equals: 6
! !

!TxModelTest methodsFor: 'tests-insertion' stamp: 'IgorStasenko 6/10/2013 17:39'!
testInsertEmptyLine
	
	self newText: 'AAACCC'.

	cursor linePosition: 3.	
	cursor insert: String cr.
	
	self assert: text asString equals: 'AAA', String cr, 'CCC'.
	
	self assert: cursor lineNumber equals: 2.
	self assert: cursor linePosition equals: 0.
	self assert: text spans size equals: 5.
	! !

!TxModelTest methodsFor: 'tests-navigation' stamp: 'dik 11/25/2012 21:40'!
testLinePosition
	
	self newText: 'ABC'.
	
	self assert: cursor isAtEnd.
	
	cursor linePosition: 1.
	self deny: cursor isAtStart.
	self assert: cursor linePosition equals: 1.
	self deny: cursor isAtEnd.
	
	cursor linePosition: 0.
	self assert: cursor isAtStart.
	self assert: cursor linePosition equals: 0.
	self deny: cursor isAtEnd.
	! !

!TxModelTest methodsFor: 'test-attribute' stamp: 'IgorStasenko 10/13/2014 15:26'!
testApplyFontOnDifferentSpan
	"We can have only one or two split apply on a TextModel "
	|color font |
	self newText: 'AAACCC'.
	self assert: text spans size = 3.
	color := TxBackColorAttribute with: Color red.
	font := TxFontAttribute with: #something.
	selection end moveLeft: 2.
	selection start moveLeft: 4.
	selection applyAttribute:  color.
	selection all.
	selection applyAttribute: font.
	cursor moveToStart.
	self assert: text spans size = 5.
	self assert: ((cursor  span  style) get: TxFontAttribute) equals: #something.
	cursor moveRight:3.
	self assert: ((cursor  span  style) get: TxFontAttribute) equals: #something.
	cursor moveRight:3.
	self assert: ((cursor  span  style) get: TxFontAttribute) equals: #something.! !

!TxModelTest methodsFor: 'convenience' stamp: 'IgorStasenko 10/7/2013 10:04'!
newText: aString
	
	text := TxModel new.
	
	text endPosition insert: aString.
	selection := text endPosition asSelection.
	cursor := selection end.! !

!TxModelTest methodsFor: 'test-attribute' stamp: 'IgorStasenko 10/13/2014 15:28'!
testApplyFontOnDifferentSpanOffsetBeforeTheFirstSpan
	"We can have only one or two split apply on a TextModel "
	|color font  |
	self newText: 'AAA','CCC'.
	self assert: text spans size = 3.
	color := TxBackColorAttribute new.
	font := TxFontAttribute with: #something.
	selection end moveLeft: 2.
	selection start moveLeft: 4.
	selection applyAttribute:  color.
	selection all.
	selection start moveRight.
	selection applyAttribute: font.
	cursor moveToStart.
	self assert: text spans size = 6.
	self assert: ((cursor  span  style) get: TxFontAttribute) equals: (TxFontAttribute defaultValue).
	cursor moveRight:2.
	self assert: ((cursor  span  style) get: TxFontAttribute) equals:  #something.
	cursor moveRight.
	self assert: ((cursor  span  style) get: TxFontAttribute) equals:  #something.
	cursor moveRight: 3.
	self assert: ((cursor  span  style) get: TxFontAttribute) equals:  #something.! !

!TxModelTest methodsFor: 'tests-navigation' stamp: 'IgorStasenko 10/7/2013 10:47'!
testDeleteKeyBetweenThreeEmptyLines

	self newText: 'ABC', String cr, String cr, String cr, 'DEF'.
	
	cursor moveToStart; moveToLineEnd; moveRight.
	self assert: cursor lineNumber equals: 2.
	self assert: cursor linePosition equals: 0.
	
	selection := cursor asSelection.
	selection deleteKey.
	
	self assert: text asString equals: 'ABC

DEF'.! !

!TxModelTest methodsFor: 'tests-navigation' stamp: 'IgorStasenko 10/7/2013 10:48'!
testDeleteKeyBetweenTwoEmptyLinesThenMoveRightAndLeftTwice

	self newText: 'ABC', String cr, String cr, 'DEF'.
	
	cursor moveToStart; moveToLineEnd; moveRight.
	self assert: cursor lineNumber equals: 2.
	self assert: cursor linePosition equals: 0.
	
	selection := cursor asSelection.
	selection deleteKey.
	
	self assert: text asString equals: 'ABC
DEF'.
	cursor moveRight; moveLeft; moveLeft.
		
	self assert: cursor lineNumber equals: 1.
	self assert: cursor linePosition equals: 3! !

!TxModelTest methodsFor: 'tests-navigation' stamp: 'DenisKudrayshov 4/24/2013 21:59'!
testEmptyLine
	
	self newText: String cr. 

	self assert: cursor isAtEnd.
	self assert: cursor lineNumber equals: 2.
	
	cursor moveToStart.
		
	self assert: cursor lineNumber equals: 1.
	
	cursor moveRight.
	
	self assert: cursor lineNumber equals: 2.

	cursor moveToStart.
	cursor moveDown.
	
	self assert: cursor lineNumber equals: 2.

! !

!TxModelTest methodsFor: 'tests-insertion' stamp: 'dik 11/25/2012 21:36'!
testInsertMultilineString
	
	self newText: 'AAACCC'.

	cursor linePosition: 3.	
	cursor insert: 'bb', String cr, 'bb'.
	
	self assert: text asString equals: 'AAAbb', String cr, 'bbCCC'.
	
	self assert: cursor lineNumber equals: 2.
	self assert: cursor linePosition equals: 2! !

!TxModelTest methodsFor: 'tests-navigation' stamp: 'dik 11/25/2012 21:41'!
testReplaceAll
	
	self newText: 'ABC'.

	selection all.	
	selection replaceWith: 'DEF'.

	self assert: text asString equals: 'DEF'! !

!TxModelTest methodsFor: 'tests-default state' stamp: 'dik 11/25/2012 21:33'!
testTextShouldBeEmptyByDefault

	self assert: text isEmpty.
	self assert: text asString equals: String empty.! !

!TxModelTest methodsFor: 'tests-model basics' stamp: 'IgorStasenko 10/7/2013 10:28'!
testGettingSelectionOfNewText
	"Asking for selection from any text instance, should give a selection holding whole text"

	| sel |
	
	text := TxModel new.
	
	sel := text newSelection.
	
	self assert: sel start isAtStart.
	self assert: sel end isAtEnd.
	self assert: sel text == text.  "identity equal!!"! !

!TxModelTest methodsFor: 'test-attribute' stamp: 'IgorStasenko 10/7/2013 09:58'!
testApplyingAttributeTwiceShouldNotChangeSameSelectionPositions
	| pos1 pos2 |
	self newText: '123456'.
	selection all.
	selection start moveRight: 2.
	selection end moveLeft.
	
	
	pos1 := selection start asTextIndex.
	pos2 := selection end asTextIndex.
	
	selection applyAttribute:  TxFontAttribute new.
	selection applyAttribute:  TxFontAttribute new.
	
	self assert: selection start asTextIndex = pos1.
	self assert: selection end asTextIndex = pos2.
	
! !

!TxModelTest methodsFor: 'tests-navigation' stamp: 'dik 11/25/2012 21:42'!
testRightSingleLine

	self newText: 'ABC'.
		
	cursor moveToStart.
	self assert: cursor isAtStart.
	self assert: cursor linePosition equals: 0.
	
	cursor moveRight: 3.
	self assert: cursor isAtEnd.
	self assert: cursor linePosition equals: 3.
	
	cursor moveRight.
	self assert: cursor isAtEnd.
	self assert: cursor linePosition equals: 3.! !

!TxModelTest methodsFor: 'tests-default state' stamp: 'IgorStasenko 6/18/2013 12:51'!
testCursorShouldBeAtStartAndEndBoth

	self assert: cursor isAtStart.
	self assert: cursor isAtEnd.! !

!TxModelTest methodsFor: 'tests-selection' stamp: 'DenisKudrayshov 4/28/2013 17:45'!
testMultiLinesSelectionAsString
	
	self newText: 'ABC', String cr, 'DEF'.
	
	selection all.
	selection start moveRight.
	selection end moveLeft.
	
	self assert: selection asString equals: 'BC
DE'.

! !

!TxModelTest methodsFor: 'tests-insertion' stamp: 'dik 11/25/2012 21:34'!
testInsert
	
	self newText: 'AAACCC'.
	
	self assert: cursor linePosition equals: 6.
	
	cursor linePosition: 3.
	self assert: cursor linePosition equals: 3.
	
	cursor insert: 'bbb'.
	
	self assert: text asString equals: 'AAAbbbCCC'.
	
	self assert: cursor linePosition equals: 6
! !

!TxModelTest methodsFor: 'tests-navigation' stamp: 'IgorStasenko 9/20/2013 12:57'!
testMinMax
	| pos1 pos2  | 

	self newText: 'ABC',String cr,'DEF'.

	pos1 := text startPosition moveRight: 2.
	pos2 := text endPosition moveLeft: 2.
	
	
	self assert:  (pos1 min: pos2 ) equals: pos1.
	self assert:  (pos2 min: pos1 ) equals: pos1.

	self assert: (pos1 max: pos2) equals: pos2.
	self assert: (pos2 max: pos1) equals: pos2.! !

!TxModelTest methodsFor: 'tests-model basics' stamp: 'IgorStasenko 10/7/2013 10:28'!
testGettingSelectionOfNonEmptyText
	"Asking for selection from any text instance, should give a selection holding whole text"
	| sel |
	
	text := TxModel new.
	text endPosition insert:'something'.
	
	sel := text newSelection.
	
	self assert: sel start isAtStart.
	self assert: sel end isAtEnd.
	self assert: sel text == text.  "identity equal!!"! !

!TxModelTest methodsFor: 'test-attribute' stamp: 'IgorStasenko 9/2/2014 15:45'!
testApplyFontWithOneSplitAtStart
	"We can have only one or two split apply on a TextModel "
	|color |
	self newText: 'AAACCC'.
	self assert: text spans size = 3.
	color := TxBackColorAttribute with: #foo.
	
	selection := text selection.
	selection end moveLeft: 3.
	
	selection applyAttribute:  color.

	
	self assert: text spans size = 4.
	cursor moveToStart.
	self assert: ((cursor  span  style) get: TxBackColorAttribute) equals: #foo .
	cursor moveToEnd.
	self assert: ((cursor  span  style) get: TxBackColorAttribute) equals: (text getAttribute: TxBackColorAttribute).! !

!TxModelTest methodsFor: 'tests-navigation' stamp: 'IgorStasenko 9/20/2013 12:51'!
testTextIndex
	| pos |
	self newText: 'ABC', String cr, 'DEF'.
	
	pos := text startPosition moveRight: 4.
	
	self assert: pos asTextIndex equals: 4.
	
	pos := text positionAtTextIndex: 4.
	self assert: pos linePosition equals: 0.
	self assert: pos isAtLineStart.
	
	pos := text positionAtTextIndex: 3.

	self assert: pos linePosition equals: 3.
	self assert: pos isAtLineEnd.
! !

!TxModelTest methodsFor: 'tests-navigation' stamp: 'dik 11/25/2012 21:44'!
testCutMultiline
	
	self newText: 'ABC',String cr,'DEF'.
	selection all.
	selection end moveLeft: 2.
	selection start moveRight: 2.
	
	self assert: selection start lineNumber equals: 1.
	selection cut.

	self assert: text asString equals: 'ABEF'! !

!TxModelTest methodsFor: 'tests-default state' stamp: 'IgorStasenko 6/18/2013 12:50'!
testSelectionShouldBeEmptyByDefault

	self assert: text isEmpty.
	self assert: selection isEmpty
	! !

!TxModelTest methodsFor: 'tests-insertion' stamp: 'IgorStasenko 10/7/2013 10:50'!
testInsertEmptyLineAtStartThenMoveLeftThenDelete
	
	self newText: 'ABC'.
	
	cursor moveToStart. 
	cursor insert: String cr.
	cursor moveLeft.
	selection := cursor asSelection.
	selection deleteKey.
	
	cursor := selection end.
	
	self assert: cursor isAtStart.
	
	self assert: text asString equals: 'ABC'.
	self assert: cursor linePosition equals: 0
! !

!TxModelTest methodsFor: 'tests-selection' stamp: 'DenisKudrayshov 4/28/2013 17:47'!
testSingleLineSelectionAsString
	
	self newText: 'ABCDEF'.

	selection all.	
	selection start moveRight.
	selection end moveLeft.
	
	self assert: selection asString equals: 'BCDE'.

! !

!TxModelTest methodsFor: 'tests-positionDiff' stamp: 'IgorStasenko 10/23/2013 20:14'!
testDifferenceEquivalentToMovingRight
	| start  end |
	self newText: 'ABC', String cr, 'DEF'.

	start := text startPosition.
	end := text endPosition.
	
	self assert: end -- start = -7.
	self assert: start -- end = 7.

	self assert: (end + (-7) ) isAtStart.
	self assert: (start + (7) ) isAtEnd.
				
! !

!TxModelTest methodsFor: 'test-attribute' stamp: 'IgorStasenko 10/7/2013 09:58'!
testApplyingAttributeShouldNotChangeSelection
	| pos1 pos2 |
	self newText: '123456'.
	selection all.
	selection start moveRight: 2.
	selection end moveLeft.
	
	
	pos1 := selection start asTextIndex.
	pos2 := selection end asTextIndex.
	
	selection applyAttribute:  TxFontAttribute new.
	
	self assert: selection start asTextIndex = pos1.
	self assert: selection end asTextIndex = pos2.
	
! !

!TxModelTest methodsFor: 'tests-navigation' stamp: 'dik 11/25/2012 21:44'!
testCutMultiline2

	self newText: 'ABC',String cr, 	'zzzz' , String cr , 'DEF'.
	selection all.
	selection end moveLeft: 2.
	selection start moveRight: 2.
	
	self assert: selection start lineNumber equals: 1.
	selection cut.

	self assert: text asString equals: 'ABEF'! !

!TxModelTest methodsFor: 'tests-insertion' stamp: 'IgorStasenko 10/7/2013 10:50'!
testInsertEmptyLineThenBacksaceThenInsertLineThenMoveRightThenMoveLeftTwice
	
	self newText: 'AAACCC'.

	cursor linePosition: 3.	
	cursor insert: String cr.
	selection := cursor asSelection.
	selection backspaceKey.
	cursor := selection end.
	cursor insert: String cr.
	
	self assert: text asString equals: 'AAA', String cr, 'CCC'.
	
	cursor moveRight.
	cursor moveLeft.
	cursor moveLeft.
	self assert: cursor lineNumber equals: 1.
	self assert: cursor linePosition equals: 3.
	! !

!TxModelTest methodsFor: 'tests-insertion' stamp: 'dik 11/25/2012 21:35'!
testInsertAtEnd
	
	self newText: 'ABC'.
	
	cursor moveToEnd. 
	
	self assert: cursor isAtEnd.
	
	cursor insert: 'xyz'.
	
	self assert: text asString equals: 'ABCxyz'.
	self assert: cursor linePosition equals: 6
! !

!TxModelTest methodsFor: 'tests-navigation' stamp: 'dik 11/25/2012 21:39'!
testLeftMultiLine

	self newText: 'ABC', String cr, 'DEF'.
	
	cursor moveLeft: 3.
	self assert: cursor lineNumber equals: 2.
	self assert: cursor linePosition equals: 0.
	
	cursor moveLeft.
	self assert: cursor lineNumber equals: 1.
	self assert: cursor linePosition equals: 3.! !

!TxModelTest methodsFor: 'tests-navigation' stamp: 'IgorStasenko 9/20/2013 12:55'!
testUp
	| pos |
	self newText: 'ABC', String cr, 'DEF'.
	
	pos := text endPosition moveUp.
	
	self assert: pos lineNumber equals: 1.
	self assert: pos linePosition equals: 3.
	
	pos := pos moveUp.
	self assert: pos isAtStart.! !

!TxModelTest methodsFor: 'test-attribute' stamp: 'IgorStasenko 9/2/2014 15:38'!
testApplyAttributeAndMerge
	"When you apply an TxAttribute on a span and is neighboor have the same collection of attribute you have to merge them"
	|color |
	self newText: 'AAACCC'.
	color := TxBackColorAttribute with: #something.
	
	selection all. 
	selection end moveToStart moveRight:3.
	
	selection applyAttribute:  color.  " <<  AAA CCC  >>"
	self assert: text spans size = 4.

	selection start moveToEnd.
	selection applyAttribute: color.  "CCC is now colored"
	
	"text spans second attributes = text spans third attributes"
	self assert: text spans size = 3. " <<  AAACCC  >>"
	cursor moveToStart.
	self assert: ((cursor  span  style) get: TxBackColorAttribute) equals: #something.! !

!TxModelTest methodsFor: 'test-attribute' stamp: 'IgorStasenko 9/2/2014 15:39'!
testApplyAttributeAndMerge2
	| color |
	self newText: 'AABBCC'.
	color := TxBackColorAttribute with: #something.
	selection beSelection end moveLeft: 2.
	selection start moveLeft: 4.
	
	selection applyAttribute:  color.
	self assert: text spans size = 5.  "<<  'AA' 'BB' 'CC'  >>"
	selection all.
	
	selection applyAttribute:  color.
	
	self assert: selection isValid.
	
	self assert: text spans size = 3. "<<  'AABBCC'  >>"
	cursor moveToStart.
	self assert: ((cursor  span style) get: TxBackColorAttribute) equals: #something.! !

!TxModelTest methodsFor: 'test-attribute' stamp: 'IgorStasenko 9/2/2014 15:43'!
testApplyFontWithOneSplit
	"We can have only one or two split apply on a TextModel "
	|color |
	self newText: 'AAACCC'.
	self assert: text spans size = 3. "<< AAACCC >>"
	color := TxBackColorAttribute with: #foo.

	selection start moveToStart.
	selection end moveToStart moveRight: 3.

	selection applyAttribute: color.
	self assert: text spans size = 4.
	cursor moveToStart.
	self assert: (cursor span style get: TxBackColorAttribute) equals: #foo.
	cursor moveToEnd.
	self assert: (cursor span style get: TxBackColorAttribute) equals: (TxBackColorAttribute defaultValue).! !

!TxModelTest methodsFor: 'tests-navigation' stamp: 'DenisKudrayshov 4/28/2013 15:28'!
testMoveToLineEnd

	self newText: 'ac', String cr, 'def', String cr, 'ghi'.
	
	cursor moveToStart.
	cursor moveDown.
	self assert: cursor lineNumber equals: 2.
	self assert: cursor linePosition equals: 0.
	
	cursor moveToLineEnd.
	
	self assert: cursor lineNumber equals: 2.
	self assert: cursor linePosition equals: 3.! !

!TxModelTest methodsFor: 'test-attribute' stamp: 'IgorStasenko 9/2/2014 14:09'!
testApplyColor
	| color |
	self newText: 'AAACCC'.
	color := TxBackColorAttribute with: Color red.
	
	selection all.
	
	selection applyAttribute:  color.
	"use start position because there are one span "
	self assert: (text startSpan next getAttribute: TxBackColorAttribute) equals: Color red.
	! !

!TxModelTest methodsFor: 'tests-navigation' stamp: 'dik 11/25/2012 21:39'!
testEmptyLines
	
	self newText: String cr, String cr, String cr. 
	
	self assert: cursor isAtEnd.	
	self assert: cursor lineNumber equals: 4.
	
! !

!TxModelTest methodsFor: 'tests-insertion' stamp: 'IgorStasenko 10/7/2013 10:49'!
testInsertEmptyLineAtEndThenMoveLeftThenDelete
	
	self newText: 'ABC'.
	
	cursor moveToEnd. 
	cursor insert: String cr.
	
	cursor moveLeft.
	selection := cursor asSelection.
	
	selection deleteKey.
	
	self assert: selection end isAtEnd.
	
	self assert: text asString equals: 'ABC'.
	self assert: selection end linePosition equals: 3
! !

!TxModelTest methodsFor: 'running' stamp: 'IgorStasenko 6/18/2013 12:49'!
setUp
	super setUp.
	
	text := TxModel new.
	selection  := text selection.
	cursor := selection end! !

!TxModelTest methodsFor: 'tests-navigation' stamp: 'dik 11/25/2012 21:39'!
testEmptyLinesAtStartOfText
	
	self newText: String cr, String cr, String cr, 'CDE'. 
	
	self assert: cursor isAtEnd.
	self assert: cursor lineNumber equals: 4! !

!TxModelTest methodsFor: 'test-attribute' stamp: 'IgorStasenko 9/2/2014 15:37'!
testApplyFontMultipleLine
	"When applying same attribute over whole text, all spans should have it"
	
	| font |
	self newText: String cr,'AAA',String cr,'CCC',String cr,'ttt',String cr.
	font := TxFontAttribute new.
	selection all.
	selection applyAttribute: font.

	text spans do: [:span |
		self assert: (span style includes: font) ]
! !

!TxModelTest methodsFor: 'tests-navigation' stamp: 'IgorStasenko 10/7/2013 10:45'!
testDeleteKey

	self newText: 'ABC',String cr,'DEF'.
	
	cursor moveToStart moveToLineEnd.

	selection 
		start: cursor;
		end: cursor.
		
	selection deleteKey.
	
	self assert: text asString equals: 'ABCDEF'.
	
	selection deleteKey.
	self assert: text asString equals: 'ABCEF'! !

!TxModelTest methodsFor: 'tests-attributes accessing' stamp: 'IgorStasenko 10/21/2014 17:17'!
testGettingAbsentAttribute

	|  actual attributeClass |
	
	attributeClass := TxMockAttribute.
	actual := text defaultStyle get: attributeClass.
	
	self assert: actual equals: attributeClass defaultValue ! !

!TxModelTest methodsFor: 'tests-navigation' stamp: 'dik 11/25/2012 21:42'!
testRightMultiLine
	
	self newText: 'ABC', String cr, 'DEF'.
	
	cursor moveToStart.
	self assert: cursor lineNumber equals: 1.
	self assert: cursor linePosition equals: 0.
	
	cursor moveRight: 3.
	self assert: cursor lineNumber equals: 1.
	self assert: cursor linePosition equals: 3.
	
	cursor moveRight.
	self assert: cursor lineNumber equals: 2.
	self assert: cursor linePosition equals: 0.! !

!TxModelTest methodsFor: 'tests-model basics' stamp: 'IgorStasenko 10/7/2013 10:36'!
testSelectionUsesMutableCursors
	"Check that selection start and end is cursors (mutable positions)"
	| sel start end |
	
	text := TxModel new.
	sel := text newSelection.
	
	start :=  sel start.
	end := sel end.
	
	self assert: start ~~ end.
	
	"moving the end and start does not changes the identity"
	sel end moveToStart.
	sel start moveToEnd.	
	
	self assert: sel start == start.
	self assert: sel end == end. ! !

!TxModelTest methodsFor: 'tests-default state' stamp: 'IgorStasenko 8/30/2013 13:48'!
testTextPositionShouldReferToText


	self assert: text startPosition text == text.
	self assert: text endPosition text == text.
	
	self assert: text startPosition copy text == text.
! !

!TxModelTest methodsFor: 'test-attribute' stamp: 'IgorStasenko 9/2/2014 15:44'!
testApplyFontWithOneSplitAtEnd
	"We can have only one or two split apply on a TextModel "
	| color |
	self newText: 'AAACCC'.
	color := TxBackColorAttribute with: #foo.
	selection := text selection.
	selection start moveRight:3.
	selection applyAttribute:  color.
	cursor moveToEnd.
	self assert: text spans size = 4.
	self assert: ((cursor  span  style) get: TxBackColorAttribute) equals: #foo.
	cursor moveToStart.
	self assert: ((cursor  span  style) get: TxBackColorAttribute) equals: (text getAttribute: TxBackColorAttribute).! !

!TxModelTest methodsFor: 'tests-insertion' stamp: 'IgorStasenko 6/11/2013 02:04'!
testInsertEmptyLineAtEndThenBackspaceThenDelete
	
	self newText: 'ABC'.
	
	cursor moveToEnd. 
	cursor insert: String cr.
	
	selection backspaceKey.
	selection deleteKey.
	
	self assert: selection end isAtEnd.
	
	self assert: text asString equals: 'ABC'.
	self assert: selection end linePosition equals: 3
! !

!TxModelTest methodsFor: 'tests-navigation' stamp: 'IgorStasenko 10/7/2013 10:46'!
testDeleteKeyBeforeTwoLines

	self newText: 'ABC', String cr, String cr, 'DEF'.
	
	cursor moveToStart.
	cursor linePosition: 3.
	
	selection := cursor asSelection.
	
	selection deleteKey.
	selection deleteKey.
	
	self assert: text asString equals: 'ABCDEF'.
	
	self assert: cursor lineNumber equals: 1.
	self assert: cursor linePosition equals: 3! !

!TxModelTest methodsFor: 'tests-attributes accessing' stamp: 'IgorStasenko 10/21/2014 17:36'!
testGettingExistedAttribute

	| actual |
		
	text defaultStyle add: TxFontAttribute with: #font.
	
	actual := text defaultStyle get: TxFontAttribute.
	
	self assert: actual == #font
	! !

!TxMultilineSmallTextLayoutTest methodsFor: 'private' stamp: 'FernandoOlivero 8/25/2013 09:58'!
textForView1
^
'1: Line 1
2: Line2'.
! !

!TxMultilineSmallTextLayoutTest methodsFor: 'tests' stamp: 'IgorStasenko 8/8/2013 17:58'!
testAddingLineShouldIncreaseLayoutHeight
 

	self assert: (view1 layout extent y < view2 layout extent y)! !

!TxMultilineSmallTextLayoutTest methodsFor: 'tests' stamp: 'IgorStasenko 8/8/2013 18:12'!
testView2LayoutShouldHaveThreeLines

	self assert: view2 layout lines size equals: 3.
	! !

!TxMultilineSmallTextLayoutTest methodsFor: 'private' stamp: 'FernandoOlivero 8/25/2013 09:58'!
defaultLayoutViewExtent 
	^ 100@10000.
	! !

!TxMultilineSmallTextLayoutTest methodsFor: 'private' stamp: 'FernandoOlivero 8/25/2013 09:58'!
textForView2
^
'1: Line 1
2: Line2
3: Line3'.
! !

!TxMultilineSmallTextLayoutTest methodsFor: 'tests' stamp: 'IgorStasenko 8/8/2013 18:11'!
testView1LayoutShouldHaveTwoLines

	self assert: view1 layout lines size equals: 2.
	! !

!TxMultilineSmallTextLayoutTest methodsFor: 'tests' stamp: 'IgorStasenko 8/8/2013 17:54'!
testLayoutExtentHeightShouldNotBeZero

	self assert: (view1 layout extent y ~= 0)! !

!TxNewLineDisplayCommand methodsFor: 'accessing' stamp: 'IgorStasenko 9/19/2013 12:30'!
horizontalAdvanceUpTo: textPosition layout: layout

	^ 10! !

!TxNewLineDisplayCommand methodsFor: 'accessing' stamp: 'IgorStasenko 9/19/2013 12:28'!
advance
	^ 10@0! !

!TxNewLineDisplayCommand methodsFor: 'accessing' stamp: 'IgorStasenko 9/19/2013 16:57'!
textPositionForHorizontalOffset: anOffset layout: layout

	^ span startPosition! !

!TxNewLineDisplayCommand methodsFor: 'testing' stamp: 'IgorStasenko 9/19/2013 12:31'!
contains: aTextPosition
	^ false
	
	"^ aTextPosition span == span"! !

!TxNewLineDisplayCommand methodsFor: 'rendering' stamp: 'IgorStasenko 9/19/2013 12:26'!
renderOn: renderer

	renderer renderEndOfLineMark.
	
	! !

!TxNewLineDisplayCommand methodsFor: 'accessing' stamp: 'IgorStasenko 9/19/2013 12:24'!
startPosition
	^ span startPosition! !

!TxNewLineDisplayCommand methodsFor: 'accessing' stamp: 'IgorStasenko 9/19/2013 12:24'!
span: aTxLineSeparator 
	span := aTxLineSeparator! !

!TxNoWrapStrategyTest methodsFor: 'private' stamp: 'FernandoOlivero 8/26/2013 17:16'!
defaultStrategy
	^ TxAthensNoWrapStrategy new ! !

!TxNoWrapStrategyTest methodsFor: 'tests' stamp: 'FernandoOlivero 8/25/2013 10:41'!
testLayoutShouldContainASingleLine
	self assert: (view layout numberOfLines =  1)! !

!TxOneLineTextLayoutTest methodsFor: 'private' stamp: 'FernandoOlivero 8/25/2013 10:01'!
textForView1
	^ '1'! !

!TxOneLineTextLayoutTest methodsFor: 'private' stamp: 'FernandoOlivero 8/25/2013 09:55'!
defaultLayoutViewExtent 
	^ 1000@10000! !

!TxOneLineTextLayoutTest methodsFor: 'private' stamp: 'FernandoOlivero 8/25/2013 10:01'!
textForView2
	^ '12'! !

!TxOneLineTextLayoutTest methodsFor: 'tests' stamp: 'IgorStasenko 8/8/2013 18:03'!
testLineSizeIncreasesLayoutExtent
 

	self assert: (view1 layout extent x< view2 layout extent x)! !

!TxOneLineTextLayoutTest methodsFor: 'tests' stamp: 'IgorStasenko 8/8/2013 18:10'!
testLayoutShouldHaveOneLine

	self assert: view1 layout lines size equals: 1.
	self assert: view2 layout lines size equals: 1.
	! !

!TxPasswordSpan commentStamp: 'IgorStasenko 11/10/2014 15:19'!
- this class need further revision. don't use!
!TxPasswordSpan methodsFor: 'accessing' stamp: 'IgorStasenko 10/30/2013 16:50'!
characters

	^ String new: characters size withAll: $*! !

!TxScrollbarDecorator methodsFor: 'misc' stamp: 'IgorStasenko 3/21/2014 17:59'!
disconnectFromContainer
	"unregister from all boring stuff.. one day"
	scrollbar ifNotNil: [
		 scrollbar announcer unsubscribe: self ]. ! !

!TxScrollbarDecorator methodsFor: 'geometry' stamp: 'IgorStasenko 3/21/2014 17:40'!
width
	^ vertical
		ifTrue: [ scrollbar width ]
		ifFalse: [ super width ]! !

!TxScrollbarDecorator methodsFor: 'accessing' stamp: 'IgorStasenko 5/13/2014 14:40'!
autohide
	^ autohide! !

!TxScrollbarDecorator methodsFor: 'placement' stamp: 'IgorStasenko 3/21/2014 17:36'!
placeLeft

	vertical := true.
	self initScrollbar.

	super placeLeft! !

!TxScrollbarDecorator methodsFor: 'accessing' stamp: 'IgorStasenko 3/26/2014 15:06'!
setContainer: anObject

	viewContainer := anObject.
	
	viewContainer layoutView announcer weak on: TxLayoutViewChanged send: #viewChanged: to: self! !

!TxScrollbarDecorator methodsFor: 'geometry' stamp: 'IgorStasenko 3/21/2014 17:40'!
height
	^ vertical
		ifFalse: [ scrollbar height ]
		ifTrue: [ super height ]! !

!TxScrollbarDecorator methodsFor: 'initialize' stamp: 'IgorStasenko 2/12/2014 17:56'!
defaultBounds

"answer the default bounds for the receiver"
	^ 0 @ 0 corner: self theme scrollbarThickness @ self theme scrollbarThickness.! !

!TxScrollbarDecorator methodsFor: 'accessing' stamp: 'IgorStasenko 3/27/2014 16:38'!
sliderDragged: aTxSliderDragged

	|  view viewMorph |
	
	
	viewMorph := viewContainer viewMorph.
	view :=  viewMorph layoutView.
	

	vertical ifFalse: [ 
		| totalSize delta |
		delta := aTxSliderDragged newPosition - aTxSliderDragged oldPosition.
		totalSize := view layout extent x.
		viewMorph scrollBy: (delta * totalSize) @ 0.
		
	 ] ifTrue: [ 
	"vertical one"
		| totalLines approxNewLine clampedPos |
		totalLines := view text endPosition lineNumber.
		clampedPos :=aTxSliderDragged newPosition min: 1 max: 0.
		approxNewLine := (totalLines * clampedPos ) rounded.

		(approxNewLine = 0) ifTrue: [  
			view scrollBy: 0 @ view offset y negated.
			viewMorph resetViewTo: view text startPosition.
			^ self.
			].
	
		view text spansAndLineNumbersDo: [ :span :lineNumber | 
			lineNumber >= approxNewLine ifTrue: [ 
				viewMorph resetViewTo: span startPosition.
				"scrolling up , if layout height is smaller than view height" 
				view height > view layout height ifTrue: [ 
					viewMorph scrollBy: 0 @ (view height - view layout height) negated
					 ].
				^ self.
				].
		].
		self error: 'not reachable.. else it is buggy'.
		view resetLayout: view text endPosition.
		viewMorph scrollBy: (0 @ view extent y negated).
	 ]! !

!TxScrollbarDecorator methodsFor: 'initialization' stamp: 'IgorStasenko 5/13/2014 14:40'!
initialize

	super initialize.
	self placeRight.
	autohide := true.! !

!TxScrollbarDecorator methodsFor: 'accessing' stamp: 'IgorStasenko 5/13/2014 14:40'!
autohide: anBoolean
	autohide := anBoolean! !

!TxScrollbarDecorator methodsFor: 'layout' stamp: 'IgorStasenko 3/21/2014 17:21'!
layoutChanged
	^ super layoutChanged! !

!TxScrollbarDecorator methodsFor: 'initialize' stamp: 'IgorStasenko 3/21/2014 17:57'!
initScrollbar
	| ann |
	self removeAllMorphs.
	scrollbar ifNotNil: [  scrollbar announcer unsubscribe: self ].

	scrollbar := (vertical ifTrue: [ TxSlider vertical ] ifFalse: [ TxSlider horizontal  ]) new.
	
	self addMorph: scrollbar.

	ann := scrollbar announcer weak.
	
	ann 
		on: TxSliderDragged send: #sliderDragged: to: self;
		on: TxSliderScrollBackward send: #sliderScrollBackward to: self;
		on: TxSliderScrollForward send: #sliderScrollForward to: self
	! !

!TxScrollbarDecorator methodsFor: 'misc' stamp: 'IgorStasenko 2/12/2014 18:11'!
computeBoundsIn: layoutBounds
	| result |
	result := super computeBoundsIn: layoutBounds.
	
	scrollbar bounds: self bounds.
	^ result
! !

!TxScrollbarDecorator methodsFor: 'accessing' stamp: 'IgorStasenko 3/26/2014 15:27'!
sliderScrollBackward

	vertical ifTrue: [ 
		viewContainer viewMorph scrollBy: 0@viewContainer viewMorph height negated
		]
	ifFalse: [ 
		viewContainer viewMorph scrollBy: viewContainer viewMorph width negated @0
		
		 ]! !

!TxScrollbarDecorator methodsFor: 'accessing' stamp: 'IgorStasenko 3/26/2014 15:26'!
sliderScrollForward

	vertical ifTrue: [ 
		viewContainer viewMorph scrollBy: 0@viewContainer viewMorph height
		]
	ifFalse: [ 
		viewContainer viewMorph scrollBy: viewContainer viewMorph width@0
		
		 ]! !

!TxScrollbarDecorator methodsFor: 'accessing' stamp: 'IgorStasenko 5/13/2014 14:45'!
viewChanged: aTxLayoutViewChanged
	| view |
	
	view := aTxLayoutViewChanged view.
	
	vertical ifFalse: [ 
		| totalSize |
		
		autohide ifTrue: [ 
			"automatically hide if we can"
			view needsHorizontalScrolling ifFalse: [ self hide. ^ self ]].
		
		self visible: true.
		
		totalSize := view layout extent x.
		
		totalSize isZero 
			ifTrue: [ scrollbar sliderPosition: 0; thickness: 1 ]
			ifFalse: [ 
				scrollbar 
					sliderPosition: view offset x / totalSize;
					thickness: (view width/ totalSize min: 1.0)].
	] ifTrue: [ 
		"vertical one"
		| numberOfLines |

		autohide ifTrue: [ 
			"automatically hide if we can"
			view needsVerticalScrolling ifFalse: [ self hide. ^ self ]].

		self visible: true.
		numberOfLines := view text endPosition lineNumber.
		
		scrollbar thickness: (view layout numberOfLines / numberOfLines).
		scrollbar sliderPosition: (view layout startPosition lineNumber - 1) / numberOfLines. 
	
	 ]! !

!TxScrollbarDecorator methodsFor: 'initialization' stamp: 'IgorStasenko 3/26/2014 15:14'!
setupView: viewMorph
	"view morph has changed.. rewire the events if necessary"
	

	viewMorph layoutView announcer weak on: TxLayoutViewChanged send: #viewChanged: to: self! !

!TxScrollbarDecorator methodsFor: 'placement' stamp: 'IgorStasenko 3/21/2014 17:36'!
placeRight

	vertical := true.
	self initScrollbar.

	super placeRight! !

!TxScrollbarDecorator methodsFor: 'placement' stamp: 'IgorStasenko 3/21/2014 17:37'!
placeTop

	vertical := false.
	self initScrollbar.

	super placeTop! !

!TxScrollbarDecorator methodsFor: 'placement' stamp: 'IgorStasenko 3/21/2014 17:36'!
placeBottom

	vertical := false.
	self initScrollbar.
	super placeBottom! !

!TxSelection commentStamp: '<historical>'!
I represent a selection interval of a text.!
!TxSelection methodsFor: 'operations' stamp: 'IgorStasenko 10/15/2013 13:37'!
cut
	
	"Delete the portion of text selected by receiver.
	Note, the receiver is in collapsed state afterwards!!"
	| position |
	
	position := self text delete: self.
	self 
		start: position;
		end:  position.! !

!TxSelection methodsFor: 'accessing' stamp: 'IgorStasenko 10/7/2013 09:54'!
end: aPosition
	end position: aPosition asPosition! !

!TxSelection methodsFor: 'operations' stamp: 'CamilloBruni 10/11/2012 21:29'!
deleteKey
	"behave as if user pressed the Delete key"
	
	self isEmpty ifTrue: [ 
		self beSelection. 
		end moveRight ].
	self cut! !

!TxSelection methodsFor: 'operations' stamp: 'IgorStasenko 8/13/2012 16:51'!
beCursor

	self collapse! !

!TxSelection methodsFor: 'initialization' stamp: 'IgorStasenko 9/24/2013 15:15'!
initStart: startPosition end: endPosition

	start := startPosition asCursor.
	end := endPosition asCursor ! !

!TxSelection methodsFor: 'helpers' stamp: 'IgorStasenko 10/7/2013 09:52'!
preservePositionsDuring: aBlock
	"Restore start and end after evaluating a block, using slow text index calculation"
	
	| startPos endPos |
	
	startPos := start asTextIndex.
	endPos := end asTextIndex.
	
	aBlock ensure: [
		start position: (self text positionAtTextIndex: startPos).
		end position: (self text positionAtTextIndex: endPos).
	]. ! !

!TxSelection methodsFor: 'operations' stamp: 'IgorStasenko 8/13/2012 17:34'!
none
	self collapse.! !

!TxSelection methodsFor: 'operations' stamp: 'IgorStasenko 8/26/2014 15:06'!
replaceWith: aString

	self cut.
	self end insert: aString.
	start moveTo: end! !

!TxSelection methodsFor: 'testing' stamp: 'IgorStasenko 7/27/2012 18:48'!
isCursor

	^ end == start! !

!TxSelection methodsFor: 'operations' stamp: 'IgorStasenko 8/13/2012 16:55'!
delete
	self cut! !

!TxSelection methodsFor: 'copying' stamp: 'IgorStasenko 10/9/2013 13:51'!
postCopy
	start := start copy.
	end := end copy.
! !

!TxSelection methodsFor: 'accessing' stamp: 'IgorStasenko 10/7/2013 09:54'!
start: aPosition
	start position: aPosition asPosition! !

!TxSelection methodsFor: 'operations' stamp: 'CamilloBruni 10/11/2012 11:38'!
backspaceKey
	"behave as if user pressed the Backspace key"
	
	self isEmpty ifTrue: [ 
		self beSelection. 
		start moveLeft ].
	self cut! !

!TxSelection methodsFor: 'debugging' stamp: 'IgorStasenko 6/4/2013 16:23'!
isValid
	^ start isValid and: [ end isValid ]! !

!TxSelection methodsFor: 'operations' stamp: 'IgorStasenko 8/13/2012 16:54'!
all
	self beSelection.
	start moveToStart.
	end moveToEnd.! !

!TxSelection methodsFor: 'operations' stamp: 'IgorStasenko 10/2/2014 17:59'!
applyAttribute: anAttribute

	self text applyAttribute: anAttribute onSelection: self.! !

!TxSelection methodsFor: 'operations' stamp: 'IgorStasenko 10/9/2013 13:48'!
collapse

	"collapse the selection (making start == end)"
	
	start position: end position.! !

!TxSelection methodsFor: 'operations' stamp: 'IgorStasenko 8/6/2013 18:21'!
beSelection
	"make sure that start and end are distinct objects,
	so when you start moving one, you don't move the other one"
	end == start ifTrue: [ end := start copy ]! !

!TxSelectionChangeOperation commentStamp: 'IgorStasenko 8/26/2014 13:13'!
a history record containing selection change operation!
!TxSelectionChangeOperation methodsFor: 'recording the changes' stamp: 'IgorStasenko 10/23/2013 20:47'!
captureDuring: aBlock

	| before after |
	before := editor selection copy.
	
	aBlock ensure: [ 
		after := editor selection.	
		startDelta := before start -- after start.
		endDelta := before end -- after end.
	].! !

!TxSelectionChangeOperation methodsFor: 'converting' stamp: 'IgorStasenko 10/23/2013 20:22'!
reversed
	^ self copy
		startOffset: startDelta negated;
		endOffset: endDelta negated;
		yourself! !

!TxSelectionChangeOperation methodsFor: 'do/undo' stamp: 'IgorStasenko 10/23/2013 20:22'!
undo
	editor selection start moveRight: startDelta negated.
	editor selection end moveRight: endDelta negated.
	! !

!TxSelectionChangeOperation methodsFor: 'printing' stamp: 'IgorStasenko 10/23/2013 20:52'!
printOn: aStream
	super printOn: aStream.
	
	aStream space; 
		print: '['; 
		print: startDelta;
		print: ' , ';
		print: endDelta;
		print: ']'! !

!TxSelectionChangeOperation methodsFor: 'do/undo' stamp: 'IgorStasenko 10/23/2013 20:22'!
redo
	editor selection start moveRight: startDelta.
	editor selection end moveRight: endDelta.
	! !

!TxSelectionChangedAnnouncement commentStamp: 'IgorStasenko 11/11/2014 16:57'!
i am announced each time when selection has changed!
!TxSelectionChangedAnnouncement methodsFor: 'accessing' stamp: 'IgorStasenko 11/11/2014 16:57'!
newSelection: anObject
	newSelection := anObject! !

!TxSelectionChangedAnnouncement methodsFor: 'accessing' stamp: 'IgorStasenko 11/11/2014 16:57'!
newSelection
	^ newSelection! !

!TxSlider commentStamp: 'IgorStasenko 3/11/2014 16:10'!
position:  0..1
thickness: 0..1!
!TxSlider methodsFor: 'for testing' stamp: 'IgorStasenko 3/21/2014 17:27'!
retreat

	self sliderPosition: sliderPosition - 0.1! !

!TxSlider methodsFor: 'for testing' stamp: 'IgorStasenko 3/21/2014 17:27'!
advance

	self sliderPosition: sliderPosition + 0.1! !

!TxSlider methodsFor: 'event handling' stamp: 'IgorStasenko 3/21/2014 14:52'!
mouseUp: evt

	self stopStepping ! !

!TxSlider methodsFor: 'settings' stamp: 'IgorStasenko 9/25/2014 17:08'!
scrollingDelay
	"Number of milliseconds between steps while scrolling the slider when user holds the button"
	^ 100! !

!TxSlider methodsFor: 'accessing' stamp: 'IgorStasenko 3/11/2014 17:41'!
thickness: newValue

	thickness := newValue min: 1.0 max: 0.0.
	
	self computeSliderBounds.
	self changed! !

!TxSlider methodsFor: 'event handling' stamp: 'IgorStasenko 3/18/2014 13:12'!
handlesMouseDown: evt
	^ evt redButtonPressed! !

!TxSlider methodsFor: 'event handling' stamp: 'IgorStasenko 3/21/2014 15:27'!
handleMouseDownAheadOfSlider: evt mappedPosition: downPos

	self announcer announce: (TxSliderScrollBackward source: self).

	self world 
		startStepping: self 
		at: Time millisecondClockValue
		selector: #animateScrollingBackward: arguments: { downPos } stepTime: self scrollingDelay.
	! !

!TxSlider methodsFor: 'event handling' stamp: 'IgorStasenko 3/21/2014 15:34'!
handleMouseDownOnSlider: evt mappedPosition: aNumber 
	| originalPos |
	
	originalPos := self originForDragStart: evt position.
	captured := true. 
	self changed.
	
	[ 
		evt hand captureEventsWhile: [ :event |
			event isMouse not or: [ self handleEventWhileDraggingSlider: event delta: originalPos ]
		].
	] ensure: [  
		captured := false. 
		self changed.
		self currentHand releaseMouseFocus
	 ]! !

!TxSlider methodsFor: 'protocol' stamp: 'IgorStasenko 3/11/2014 17:25'!
sliderColor
	^ Color lightGray ! !

!TxSlider methodsFor: 'protocol' stamp: 'IgorStasenko 3/11/2014 17:25'!
backgroundColor
	^ Color darkGray ! !

!TxSlider methodsFor: 'initialization' stamp: 'IgorStasenko 3/21/2014 17:26'!
initialize
	super initialize.
	sliderPosition := 0.
	thickness  := 0.1.
	captured := false.
	
	self computeSliderBounds ! !

!TxSlider methodsFor: 'stepping' stamp: 'IgorStasenko 3/21/2014 14:56'!
animateScrollingForward: downPos

	"stop scrolling if slider reached cursor position"
	(downPos > (mappedPosition+ mappedThickness)) 
		ifTrue: [ self announcer announce: (TxSliderScrollForward source: self) ]
		ifFalse: [ self stopStepping  ] 

! !

!TxSlider methodsFor: 'column drawing' stamp: 'IgorStasenko 3/11/2014 17:47'!
defaultWidth
	"answer the default width of slider (column width for vertical, row height for horizontal one"
	^ 10! !

!TxSlider methodsFor: 'layout' stamp: 'IgorStasenko 3/11/2014 17:29'!
layoutChanged
	super layoutChanged.
	self computeSliderBounds ! !

!TxSlider methodsFor: 'event handling' stamp: 'IgorStasenko 3/18/2014 13:03'!
mouseDown: evt

	| downPos |
	
	downPos := self mapMouseRelativeToSlider: evt position.
	
	downPos < mappedPosition ifTrue: [ ^ self handleMouseDownAheadOfSlider: evt mappedPosition: downPos ].
	downPos > (mappedPosition + mappedThickness) ifTrue: [ ^ self handleMouseDownAfterSlider: evt  mappedPosition: downPos].
	
	self handleMouseDownOnSlider: evt  mappedPosition: downPos! !

!TxSlider methodsFor: 'accessing' stamp: 'IgorStasenko 3/21/2014 17:27'!
sliderPosition: newValue

	sliderPosition := newValue min: 1.0 max: 0.0.
	
	self computeSliderBounds.
	self changed! !

!TxSlider methodsFor: 'settings' stamp: 'IgorStasenko 3/11/2014 16:10'!
minimumThicknessInPixels
	"answer the minimum slider thickness (in pixels), so that slider is large enough on screen to operate with, even if model reports smaller area"
	^ 16! !

!TxSlider methodsFor: 'event handling' stamp: 'IgorStasenko 3/21/2014 15:27'!
handleMouseDownAfterSlider: evt  mappedPosition: downPos

	self announcer announce: (TxSliderScrollForward source: self).

	self world 
		startStepping: self 
		at: Time millisecondClockValue
		selector: #animateScrollingForward: arguments: { downPos } stepTime: self scrollingDelay.
	! !

!TxSlider methodsFor: 'stepping' stamp: 'IgorStasenko 3/21/2014 14:59'!
animateScrollingBackward: downPos

	"stop scrolling if slider reached cursor position"
	(downPos < mappedPosition) 
		ifTrue: [ self announcer announce: (TxSliderScrollBackward source: self) ]
		ifFalse: [ self stopStepping  ] 

! !

!TxSlider methodsFor: 'protocol' stamp: 'IgorStasenko 3/27/2014 16:41'!
sliderHighlightColor
	^ Color lightGray muchLighter  ! !

!TxSlider class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 3/21/2014 15:00'!
test
"self test"
	| m w |
	
	m := self new.
	m announcer on: TxSliderScrollForward send: #advance to: m.
	m announcer on: TxSliderScrollBackward send: #retreat to: m.
	
	w := AthensWrapMorph new.
	
	w addMorph: m.
	w openInWindow.! !

!TxSlider class methodsFor: 'factory' stamp: 'IgorStasenko 3/19/2014 10:53'!
vertical
" e.g. 

TxSlider vertical new

instead of

TxVerticalSlider new

"

	^ TxVerticalSlider ! !

!TxSlider class methodsFor: 'factory' stamp: 'IgorStasenko 3/19/2014 10:53'!
horizontal
	^ TxHorizontalSlider ! !

!TxSliderAnnouncement methodsFor: 'accessing' stamp: 'IgorStasenko 3/19/2014 11:28'!
source
	
	^ source! !

!TxSliderAnnouncement methodsFor: 'accessing' stamp: 'IgorStasenko 3/19/2014 11:28'!
source: anObject
	
	source := anObject! !

!TxSliderAnnouncement class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 3/19/2014 11:29'!
source: aSlider

	^ self new source: aSlider ! !

!TxSliderDragged methodsFor: 'accessing' stamp: 'IgorStasenko 3/21/2014 15:03'!
oldPosition
	
	^ oldPosition! !

!TxSliderDragged methodsFor: 'accessing' stamp: 'IgorStasenko 3/21/2014 15:03'!
oldPosition: anObject
	
	oldPosition := anObject! !

!TxSliderDragged methodsFor: 'accessing' stamp: 'IgorStasenko 3/21/2014 15:03'!
newPosition: anObject
	
	newPosition := anObject! !

!TxSliderDragged methodsFor: 'accessing' stamp: 'IgorStasenko 3/21/2014 15:03'!
newPosition
	
	^ newPosition! !

!TxSpanTestCase methodsFor: 'running' stamp: 'DenisKudryashov 1/20/2013 01:32'!
setUp
	super setUp.
	textModel := TxModel new.
	
	span := self spanClass new.
	span text: textModel! !

!TxSpanTestCase class methodsFor: 'testing' stamp: 'DenisKudryashov 1/20/2013 01:09'!
isAbstract 
	^self == TxSpanTestCase! !

!TxSpanWithStyle commentStamp: '<historical>'!
i am common ancestor of spans which can carry separate (own) list of attributes.!
!TxSpanWithStyle methodsFor: 'accessing' stamp: 'IgorStasenko 8/29/2014 16:31'!
style
	^ style! !

!TxSpanWithStyle methodsFor: 'initialize-release' stamp: 'IgorStasenko 8/29/2014 16:29'!
initialize
	super initialize.
	style := TxStyle new.! !

!TxSpanWithStyle methodsFor: 'accessing' stamp: 'IgorStasenko 8/29/2014 16:39'!
setStyle: aStyle

	style := text styles addStyle: aStyle.! !

!TxSpanWithStyle methodsFor: 'copying' stamp: 'IgorStasenko 8/29/2014 16:29'!
postCopy

	style := style copy.	
! !

!TxSpanWithStyle methodsFor: 'accessing' stamp: 'IgorStasenko 8/29/2014 16:29'!
replaceAttributes: newAttributes
	"replace receiver's attributes by copying from given one"
	style := newAttributes copy.! !

!TxSpanWithStyle methodsFor: 'operation' stamp: 'IgorStasenko 9/2/2014 14:06'!
applyAttribute: anAttribute
	"Apply attribute to whole receiver"
	style := self text styles extend: style with: anAttribute.
! !

!TxSpanWithStyle methodsFor: 'accessing' stamp: 'IgorStasenko 8/29/2014 16:29'!
text: anObject
	
	text := anObject.
	style := text defaultStyle.! !

!TxSpanWithStyle methodsFor: 'copying' stamp: 'IgorStasenko 10/11/2013 14:12'!
appendCopyTo: anotherText

	"Create a copy of receiver and append it to the another text (at the end of it).
	Answer the copy"

	| copy |
	
	copy := self copy.
	
	copy 
		text: anotherText;
		basicNext: copy.
	
	anotherText endSpan prev insertNext: copy.
	
	^ copy
	! !

!TxStartSpan commentStamp: '<historical>'!
Start span is span which _always_ first span of text and only one of his kind per text model. 
So this span used to denote start of text.!
!TxStartSpan methodsFor: 'accessing' stamp: 'IgorStasenko 9/2/2014 13:19'!
style
	"My attributes are always same as my next span,
	unless text is empty, then it is default text attributes"
	
	^ text isEmpty
		ifTrue: [ text defaultStyle ]
		ifFalse: [ next style ]! !

!TxStartSpan methodsFor: 'testing' stamp: 'IgorStasenko 6/7/2013 17:29'!
isAtStart
	^ true! !

!TxStartSpan methodsFor: 'operation' stamp: 'IgorStasenko 6/11/2013 03:07'!
insertCharacters: chars at: position attributes: insertAttributes
	
	"Insert characters (no line separators allowed!!!!!!), with given attributes at given position in receiver.
	Answer the end position of inserted characters"
	
	"Since we cannot insert anything into start span, and our only valid position is zero,
	we either delegate to next character span, or create a new one, if none"
	
	| span |
	next isCharacterSpan ifTrue: [
		^ next insertCharacters: chars at: next startPosition attributes: insertAttributes 
	].

	span := (text newCharacterSpan: chars) replaceAttributes: insertAttributes.
	self insertNext: span.
	^ next endPosition
	! !

!TxStartSpan methodsFor: 'visitor' stamp: 'IgorStasenko 8/8/2013 03:47'!
accept: anObject
	"visitor pattern"
	
	^ anObject visitStartSpan: self! !

!TxStartSpan methodsFor: 'accessing' stamp: 'IgorStasenko 6/10/2013 17:14'!
lineNumberAt: aTxTextPosition
	"i am always at 1st line"
	^ 1! !

!TxStartSpan methodsFor: 'testing' stamp: 'IgorStasenko 6/10/2013 22:12'!
isAtLineStart: spanPosition
	"start of text always starts a new line "
	^ true! !

!TxStartSpan methodsFor: 'printing' stamp: 'IgorStasenko 6/10/2013 17:36'!
printOn: aStream

	 aStream nextPutAll: '<< ' ! !

!TxStartSpan methodsFor: 'operation' stamp: 'IgorStasenko 6/11/2013 02:48'!
insertLineSeparator: separator at: position
	| pos |
	pos := next startPosition.
	self insertNext: separator.
	^ pos
! !

!TxStartSpan methodsFor: 'accessing' stamp: 'IgorStasenko 6/11/2013 02:49'!
prev: anObject
	self error: 'Start span cannot have previous span!!'! !

!TxStartSpan methodsFor: 'operation' stamp: 'IgorStasenko 7/22/2013 18:06'!
deleteUpTo: end startingAt: start
	
	end span == self ifTrue: [ "nothing to remove"  ^ end ].
	
	self next: end span.
	end span removeBefore: end spanPosition.
	
	^ self tryMergeAndUpdatePosition: start ! !

!TxStartSpan methodsFor: 'copying' stamp: 'IgorStasenko 10/11/2013 13:45'!
appendCopyTo: anotherText
	"Create a copy of receiver and append it to the another text (at the end of it).
	Answer the copy"

	"Start span cannot be copied, instead we just answer the existing start span of another text"
	^ anotherText startSpan! !

!TxStyle commentStamp: 'IgorStasenko 8/27/2014 16:09'!
I hold a set of attributes assigned to single text span.
I maintain a following invariant: 
 - there can be as many as one want attributes for span (including none), but only one per its kind (one forgeground color,
one font, one background color etc).!
!TxStyle methodsFor: 'accessing' stamp: 'IgorStasenko 8/29/2014 15:12'!
get: anAttributeClass ifAbsent: aBlock

	^ (attributes at: anAttributeClass ifAbsent: aBlock) value! !

!TxStyle methodsFor: 'testing' stamp: 'IgorStasenko 8/29/2014 15:14'!
isEmpty
	^ attributes isEmpty! !

!TxStyle methodsFor: 'accessing' stamp: 'IgorStasenko 8/29/2014 15:31'!
get: anAttributeClass

	^ self get: anAttributeClass ifAbsent: [ anAttributeClass defaultValue ]! !

!TxStyle methodsFor: 'testing' stamp: 'IgorStasenko 8/29/2014 15:10'!
includes: anAttribute
	"Note, we're testing an attribute value here.. the attribute set may already have 
	an attribute of same class, but it is important that it should match the attribute value as well,
	else receiver is not considered as one, which includes given attribute"
	^ ( attributes at: anAttribute class ifAbsent: [^false] ) = anAttribute! !

!TxStyle methodsFor: 'initialize-release' stamp: 'IgorStasenko 8/29/2014 13:44'!
initialize 
	super initialize.
	
	attributes := Dictionary new! !

!TxStyle methodsFor: 'comparing' stamp: 'IgorStasenko 8/29/2014 13:52'!
= anAttributes
	^ (anAttributes class == self class) and: [ attributes = anAttributes attributes ].
! !

!TxStyle methodsFor: 'accessing' stamp: 'DenisKudryashov 1/20/2013 01:19'!
add: anAttrabuteClass with: attributeValue
	self add: (anAttrabuteClass with: attributeValue)! !

!TxStyle methodsFor: 'accessing' stamp: 'IgorStasenko 8/29/2014 13:44'!
add: aTxAttribute 
	attributes at: aTxAttribute class put: aTxAttribute ! !

!TxStyle methodsFor: 'accessing' stamp: 'IgorStasenko 8/28/2014 14:49'!
at: anAttributeClass 

	^ self at: anAttributeClass ifAbsent: nil! !

!TxStyle methodsFor: 'accessing' stamp: 'IgorStasenko 8/29/2014 15:09'!
at: anAttributeClass ifAbsent: aBlock

	^ (attributes at: anAttributeClass ifAbsent: aBlock)! !

!TxStyle methodsFor: 'accessing' stamp: 'IgorStasenko 8/28/2014 14:46'!
at: anAttributeClass put: attributeValue
	^ self add: (anAttributeClass with: attributeValue)! !

!TxStyle methodsFor: 'private' stamp: 'IgorStasenko 8/29/2014 13:52'!
attributes
	^ attributes
	! !

!TxStyle methodsFor: 'iterating' stamp: 'IgorStasenko 8/29/2014 13:47'!
attributesDo: aBlock

	attributes valuesDo: aBlock	! !

!TxStyle methodsFor: 'copying' stamp: 'IgorStasenko 8/29/2014 13:44'!
postCopy
	
	attributes := attributes copy! !

!TxStyle methodsFor: 'accessing' stamp: 'IgorStasenko 8/29/2014 15:11'!
removeAll
	"Remove all attributes from receiver. Use with care"
	
	attributes removeAll.! !

!TxStyleTests methodsFor: 'tests' stamp: 'IgorStasenko 8/29/2014 15:13'!
testAddingAttribute

	| attribute |
	attribute := TxFontAttribute new.
	
	style add: attribute.
	
	self assert: (style includes: attribute)! !

!TxStyleTests methodsFor: 'tests' stamp: 'IgorStasenko 10/21/2014 17:38'!
testGettingAbsentAttributeValue

	| actual |
	
	style removeAll.
	
	actual := style at: TxFontAttribute ifAbsent: [#result].
	
	self assert: actual == #result! !

!TxStyleTests methodsFor: 'tests' stamp: 'IgorStasenko 8/29/2014 15:14'!
testHasEmptyContentsByDefault

	self assert: style isEmpty! !

!TxStyleTests methodsFor: 'tests' stamp: 'IgorStasenko 10/21/2014 17:37'!
testAddingAttributeWithValue

	| actual |
	style add: TxFontAttribute with: #font.
	
	actual := style at: TxFontAttribute. 

	self assert: (actual value == #font)! !

!TxStyleTests methodsFor: 'tests' stamp: 'IgorStasenko 10/21/2014 17:38'!
testGettingExistedAttributeValue

	| attribute actual |
	attribute := TxFontAttribute with: #font.
	
	style add: attribute.
	
	actual := style get: TxFontAttribute ifAbsent: nil.
	
	self assert: actual == #font! !

!TxStyleTests methodsFor: 'running' stamp: 'IgorStasenko 8/29/2014 15:13'!
setUp
	super setUp.
	
	style := TxStyle new! !

!TxTabDisplayCommand methodsFor: 'geometry' stamp: 'IgorStasenko 7/31/2014 17:03'!
horizontalAdvanceUpTo: aTextPosition layout: aTextLayout

	^ stop > aTextPosition spanPosition
		ifTrue: [ 0 ] 
		ifFalse: [ advance x ]
! !

!TxTabDisplayCommand methodsFor: 'geometry' stamp: 'IgorStasenko 8/1/2014 15:21'!
textPositionForHorizontalOffset: anOffset layout: layout

	"Tab is a single unbreakable space, return start if offset closer to tab starting position, or end otherwise"
	^ anOffset < (advance x/2) 
		ifTrue: [ span positionAt: start ]
		ifFalse: [ span positionAt: stop ]
! !

!TxTabDisplayCommand methodsFor: 'rendering' stamp: 'IgorStasenko 8/5/2014 14:03'!
renderOn: renderer

	renderer advance:advance.! !

!TxTerminalSpan commentStamp: '<historical>'!
i denoting a terminal span
(either start or end of text)

my size is always ZERO
and i have only single valid position (spanPosition = 0)!
!TxTerminalSpan methodsFor: 'converting' stamp: 'IgorStasenko 6/10/2013 17:20'!
asStringOn: aStream startingAt: index
	"i am empty"
	^ self! !

!TxTerminalSpan methodsFor: 'accessing-text position' stamp: 'IgorStasenko 6/7/2013 17:26'!
endPosition
	^ self positionAt: 0! !

!TxTerminalSpan methodsFor: 'accessing' stamp: 'IgorStasenko 6/7/2013 17:25'!
size
	^ 0! !

!TxTerminalSpan methodsFor: 'operation' stamp: 'IgorStasenko 6/10/2013 21:46'!
tryMergeAndUpdatePosition: position
	^ position! !

!TxTerminalSpan methodsFor: 'operations' stamp: 'IgorStasenko 6/10/2013 21:48'!
mergeUpTo: aTxEndSpan 
	^ self! !

!TxTerminalSpan methodsFor: 'accessing-text position' stamp: 'IgorStasenko 6/11/2013 03:11'!
replaceAttributes: newAttributes
	"replace receiver's attributes by copying from given one"
	^ self! !

!TxTerminalSpan methodsFor: 'drawing' stamp: 'IgorStasenko 7/22/2013 18:07'!
drawOn: aCanvas from: start to: end at: aPoint font: aFont

	"do nothing"! !

!TxTerminalSpan methodsFor: 'testing' stamp: 'IgorStasenko 6/17/2013 18:06'!
isLastPosition: aNumber
	^ aNumber = 0! !

!TxTerminalSpan methodsFor: 'accessing-text position' stamp: 'IgorStasenko 6/7/2013 17:26'!
positionAt: index
	index ~= 0 ifTrue:  [self error: 'invalid position' ].
	
	^ super positionAt: 0! !

!TxTerminalSpan methodsFor: 'attributes' stamp: 'IgorStasenko 6/10/2013 21:47'!
applyAttribute: anAttribute from: startPosition to: endPosition
	^ self! !

!TxTerminalSpan methodsFor: 'accessing-text position' stamp: 'IgorStasenko 6/7/2013 17:26'!
startPosition
	^ self positionAt: 0! !

!TxTerminalSpan methodsFor: 'converting' stamp: 'IgorStasenko 9/20/2013 12:53'!
asStringOn: aStream startingAt: startIndex upTo: endIndex
	"i am empty"
	^ self! !

!TxTextAdapter methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 4/25/2014 15:33'!
setScrollValue: aPoint 
	! !

!TxTextAdapter methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 4/30/2014 13:05'!
editorDo: aBlock

	^ self widgetDo: [ :w | aBlock value: w submorphs first viewMorph ]
! !

!TxTextAdapter methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 4/30/2014 13:12'!
setSelectionFromModel: x
1halt! !

!TxTextAdapter methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 4/30/2014 13:10'!
pendingText: aText
1halt.
	self editorDo: [ :e | 
		e insert: aText ]! !

!TxTextAdapter methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 4/30/2014 13:50'!
getText
	1halt! !

!TxTextAdapter methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 5/13/2014 15:30'!
buildWidget
	| view wrapper |
	
	view := TxViewContainer new.
	view addDecorator: (TxScrollbarDecorator new placeRight color: Color blue;yourself).
	view addDecorator: (TxScrollbarDecorator new placeBottom color: Color green;yourself).
	view useEditor.
	view wrapText: true.
	
	view hResizing: #spaceFill ; vResizing: #spaceFill .
	view layoutFrame: (LayoutFrame identity).
	
	wrapper := AthensWrapMorph new.
	wrapper layoutPolicy: ProportionalLayout new.
	wrapper addMorph: view.
	wrapper hResizing: #spaceFill ; vResizing: #spaceFill .

	^ wrapper
! !

!TxTextAdapter methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 4/30/2014 13:11'!
classOrMetaClass: aClass! !

!TxTextAdapter methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 4/30/2014 13:05'!
takeKeyboardFocus

	self editorDo: [ :e | e takeKeyboardFocus ]! !

!TxTextAdapter methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 5/13/2014 15:00'!
adapt: aComposableModel

	model := aComposableModel.
	aComposableModel addDependent: self.

	widget := self buildWidget.
	
	model whenTextChanged: [ :new :old | 
		self editorDo: [ :e | e contents: new ]
		 ].
	"model text whenChangedSend: #setNewText: to: self"! !

!TxTextAdapter methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 4/30/2014 13:11'!
font: aFont! !

!TxTextCursor commentStamp: '<historical>'!
i holding a position
and polymorphic with its protocol.
However, in contrast to position, i am mutable, so that any navigation or insertion operations can affect my position in text.!
!TxTextCursor methodsFor: 'accessing' stamp: 'IgorStasenko 9/24/2013 15:18'!
span
	^ position span! !

!TxTextCursor methodsFor: 'converting' stamp: 'IgorStasenko 9/20/2013 12:43'!
asPosition
	^ position! !

!TxTextCursor methodsFor: 'operations' stamp: 'IgorStasenko 10/7/2013 09:46'!
insert: aString 
	"
	Insert a possibly multi-line string at given position of receiver.
	Move position right after the last character of inserted string.
	The inserted portion of will inherit same attributes as current position attributes.
	"
	position := self span at: position insert: aString.
! !

!TxTextCursor methodsFor: 'navigation' stamp: 'IgorStasenko 9/24/2013 14:43'!
moveLeft: number
	position := position moveLeft: number! !

!TxTextCursor methodsFor: 'navigation' stamp: 'IgorStasenko 9/24/2013 14:45'!
moveToLineEnd
	position := position moveToLineEnd! !

!TxTextCursor methodsFor: 'navigation' stamp: 'IgorStasenko 9/24/2013 14:45'!
moveToLineStart
	position := position moveToLineStart! !

!TxTextCursor methodsFor: 'operations' stamp: 'IgorStasenko 10/7/2013 09:43'!
deleteUpTo: aTxPosition
	^ position deleteUpTo: aTxPosition ! !

!TxTextCursor methodsFor: 'navigation' stamp: 'IgorStasenko 9/24/2013 14:43'!
moveDown: number
	position := position moveDown: number! !

!TxTextCursor methodsFor: 'accessing' stamp: 'IgorStasenko 9/20/2013 01:56'!
position: aTextPosition
	position := aTextPosition! !

!TxTextCursor methodsFor: 'navigation' stamp: 'IgorStasenko 4/10/2014 17:39'!
moveTo: anotherTextPosition
	position := anotherTextPosition asPosition ! !

!TxTextCursor methodsFor: 'navigation' stamp: 'IgorStasenko 10/7/2013 09:37'!
linePosition: offset
	position := position linePosition: offset! !

!TxTextCursor methodsFor: 'accessing' stamp: 'IgorStasenko 9/24/2013 15:18'!
text
	^ position text! !

!TxTextCursor methodsFor: 'navigation' stamp: 'IgorStasenko 9/24/2013 14:44'!
moveToEnd
	position := self text endPosition! !

!TxTextCursor methodsFor: 'navigation' stamp: 'IgorStasenko 9/24/2013 14:44'!
moveRight: number
	position := position moveRight: number! !

!TxTextCursor methodsFor: 'accessing' stamp: 'IgorStasenko 10/14/2014 13:40'!
nextPosition
	"answer the position in text, which follows the receiver"
	^ position nextPosition! !

!TxTextCursor methodsFor: 'converting' stamp: 'IgorStasenko 9/20/2013 01:58'!
asCursor
	^ self! !

!TxTextCursor methodsFor: 'accessing' stamp: 'IgorStasenko 9/20/2013 01:56'!
position
	^ position! !

!TxTextCursor methodsFor: 'printing' stamp: 'IgorStasenko 10/7/2013 09:59'!
printOn: aStream

	"super printOn: aStream. "
	self isValid ifFalse: [ aStream nextPutAll: '**invalid cursor position**'. ^ self ].
	aStream 
		nextPutAll: 'cursor line: ';
		print: self lineNumber;
		nextPutAll: ' col: ';
		print: self linePosition 
		! !

!TxTextCursor methodsFor: 'accessing' stamp: 'IgorStasenko 9/24/2013 15:18'!
spanPosition
	^ position spanPosition! !

!TxTextCursor methodsFor: 'navigation' stamp: 'IgorStasenko 9/24/2013 14:44'!
moveUp: number
	position := position moveUp: number! !

!TxTextCursor methodsFor: 'navigation' stamp: 'IgorStasenko 9/24/2013 14:45'!
moveToStart
	position := self text startPosition! !

!TxTextEditor commentStamp: 'IgorStasenko 8/26/2014 13:14'!
I control text edit operations by using selection 
 and can support undo operations.!
!TxTextEditor methodsFor: 'editing' stamp: 'IgorStasenko 11/11/2014 16:36'!
insert: aString
	| operation |
	
	selection isEmpty ifFalse: [ 
		self delete.
		 ].
	
	operation := TxInsertOperation editor: self.
	operation text: aString.
	self addUndo: operation.
	
	selection replaceWith: aString.
	
	self announce: (TxInsertedTextAnnouncement new insertedText: aString; editor: self; yourself).
	
	"selection collapse."! !

!TxTextEditor methodsFor: 'navigation' stamp: 'IgorStasenko 11/11/2014 17:05'!
moveToLineEnd
	self recordSelectionChange: [ 
		selection end moveToLineEnd.
		selection collapse
	].
! !

!TxTextEditor methodsFor: 'private' stamp: 'IgorStasenko 11/11/2014 17:06'!
recordSelectionChange: aBlock

	| operation |
	operation := (TxSelectionChangeOperation editor: self).
	operation captureDuring: aBlock.
	self addUndo: operation. 

	"And last thing, announce that selection has changed"
	
	self announce: (TxSelectionChangedAnnouncement new editor: self; newSelection: selection).
	! !

!TxTextEditor methodsFor: 'selection' stamp: 'IgorStasenko 11/11/2014 17:04'!
extendSelectionUp
	self recordSelectionChange: [ selection end moveUp ].
	! !

!TxTextEditor methodsFor: 'navigation' stamp: 'IgorStasenko 11/11/2014 17:05'!
moveUp
	self recordSelectionChange: [ 
		selection end moveUp.
		selection collapse.
	].
! !

!TxTextEditor methodsFor: 'private' stamp: 'IgorStasenko 11/11/2014 17:13'!
announce: something
	announcer announce: something! !

!TxTextEditor methodsFor: 'accessing' stamp: 'IgorStasenko 11/11/2014 17:26'!
text
	^ text! !

!TxTextEditor methodsFor: 'undo/redo' stamp: 'IgorStasenko 10/23/2013 20:46'!
addUndo: operation
	undoBuffer addLast: operation 
! !

!TxTextEditor methodsFor: 'initialization' stamp: 'IgorStasenko 11/11/2014 16:30'!
initialize
	self resetUndoBuffer.
	announcer := Announcer new.! !

!TxTextEditor methodsFor: 'accessing' stamp: 'IgorStasenko 10/23/2013 20:47'!
selection
	^ selection! !

!TxTextEditor methodsFor: 'navigation' stamp: 'IgorStasenko 11/11/2014 17:05'!
moveDown
	self recordSelectionChange: [ 
		selection end moveDown.
		selection collapse.
	].
! !

!TxTextEditor methodsFor: 'initialization' stamp: 'IgorStasenko 5/13/2014 15:08'!
resetUndoBuffer
	undoBuffer := OrderedCollection new.! !

!TxTextEditor methodsFor: 'selection' stamp: 'IgorStasenko 11/11/2014 17:04'!
extendSelectionRight
	self recordSelectionChange: [ selection end moveRight ]
	! !

!TxTextEditor methodsFor: 'accessing' stamp: 'IgorStasenko 11/11/2014 17:07'!
announcer
	^ announcer weak! !

!TxTextEditor methodsFor: 'navigation' stamp: 'AlainPlantec 1/12/2015 18:01'!
moveLeft
	(selection end isAtStart and: [ selection end span prev isAtStart ])
		ifTrue: [ ^ self ].
	self recordSelectionChange: [ 
		selection end moveLeft.
		selection collapse
	].! !

!TxTextEditor methodsFor: 'selection' stamp: 'IgorStasenko 11/11/2014 17:04'!
extendSelectionToLineEnd
	self recordSelectionChange: [ selection end moveToLineEnd ].
! !

!TxTextEditor methodsFor: 'navigation' stamp: 'IgorStasenko 11/11/2014 17:05'!
moveToLineStart
	self recordSelectionChange: [ 
		selection end moveToLineStart.
		selection collapse
	].
! !

!TxTextEditor methodsFor: 'navigation' stamp: 'IgorStasenko 11/11/2014 17:05'!
moveSelectionEndTo: aTextPosition
	(aTextPosition hasSamePositionAs: selection end)
		ifFalse: [ self recordSelectionChange: [ selection end: aTextPosition ] ].
! !

!TxTextEditor methodsFor: 'initialization' stamp: 'IgorStasenko 5/13/2014 15:09'!
text: aText

	text := aText.
	selection := text startPosition asSelection.
	self resetUndoBuffer! !

!TxTextEditor methodsFor: 'undo/redo' stamp: 'IgorStasenko 10/23/2013 20:45'!
undo
	undoBuffer isEmpty ifTrue: [ ^ self ].
	undoBuffer removeLast undo.! !

!TxTextEditor methodsFor: 'navigation' stamp: 'IgorStasenko 11/11/2014 17:05'!
moveCursorTo: aTextPosition
	self recordSelectionChange: [ 
		selection end: aTextPosition.
		selection collapse.
	].
	! !

!TxTextEditor methodsFor: 'navigation' stamp: 'IgorStasenko 11/11/2014 17:05'!
moveRight
	self recordSelectionChange: [ 
		selection end moveRight.
		selection collapse.
	].
! !

!TxTextEditor methodsFor: 'editing' stamp: 'IgorStasenko 11/11/2014 16:39'!
delete
	selection isEmpty ifTrue: [ 
		selection end moveRight.
	 ].

	selection isEmpty ifFalse: [ 
		selection cut.
		self announce: (TxDeletedTextAnnouncement new editor: self; yourself) ].

	! !

!TxTextEditor methodsFor: 'selection' stamp: 'IgorStasenko 11/11/2014 17:05'!
extendSelectionLeft
	self recordSelectionChange: [ selection end moveLeft ].
	! !

!TxTextEditor methodsFor: 'selection' stamp: 'IgorStasenko 11/11/2014 17:04'!
extendSelectionToLineStart
	self recordSelectionChange: [ selection end moveToLineStart ].
! !

!TxTextEditor methodsFor: 'accessing' stamp: 'IgorStasenko 5/13/2014 15:09'!
contents: anObject

	"Unconditionally reset the contents, including selection and undo/redo buffers"
	
	self text: anObject asTxModel.
! !

!TxTextEditor methodsFor: 'accessing' stamp: 'IgorStasenko 10/14/2013 11:08'!
cursorPosition
	^ selection end! !

!TxTextEditor methodsFor: 'selection' stamp: 'IgorStasenko 11/11/2014 17:05'!
collapseSelection
	"collapse the selection, moving selection start to selection end"
	self recordSelectionChange: [ 
		selection collapse.
	].
! !

!TxTextEditor methodsFor: 'selection' stamp: 'IgorStasenko 11/11/2014 17:04'!
selectAll
	self recordSelectionChange: [ selection start moveToStart. selection end moveToEnd ].
! !

!TxTextEditor methodsFor: 'editing' stamp: 'IgorStasenko 11/11/2014 16:39'!
backspace
	selection isEmpty ifTrue: [ 
		selection end moveLeft.
	 ].

	selection isEmpty ifFalse: [ 
		selection cut.
		self announce: (TxDeletedTextAnnouncement new editor: self; yourself) ].! !

!TxTextEditor methodsFor: 'selection' stamp: 'IgorStasenko 11/11/2014 17:05'!
extendSelectionDown
	self recordSelectionChange: [ selection end moveDown ].
! !

!TxTextEditor class methodsFor: 'instance creation' stamp: 'IgorStasenko 10/14/2013 11:06'!
text: aTxModel
	^ self new text: aTxModel! !

!TxTextEditorAnnouncement commentStamp: 'IgorStasenko 11/11/2014 16:43'!
This is root class of announcements related to text editor events.!
!TxTextEditorAnnouncement methodsFor: 'accessing' stamp: 'IgorStasenko 11/11/2014 16:35'!
editor: anObject
	editor := anObject! !

!TxTextEditorAnnouncement methodsFor: 'accessing' stamp: 'IgorStasenko 11/11/2014 16:35'!
editor
	^ editor! !

!TxTextEditorMorph methodsFor: 'event handling' stamp: 'FernandoOlivero 9/4/2013 11:10'!
handlesKeyDown: event
	^ true! !

!TxTextEditorMorph methodsFor: 'navigation' stamp: 'IgorStasenko 4/10/2014 17:07'!
moveToLineEnd

	controller moveToLineEnd.
	self updateCursor: true.! !

!TxTextEditorMorph methodsFor: 'event handling' stamp: 'IgorStasenko 9/19/2013 11:34'!
keyStroke: anEvent 
	self insert:  anEvent keyCharacter asString. 
	
	! !

!TxTextEditorMorph methodsFor: 'initialization' stamp: 'FernandoOlivero 9/4/2013 12:59'!
defaultCursor
	^ TxCaretCursor new! !

!TxTextEditorMorph methodsFor: 'navigation-selection' stamp: 'IgorStasenko 4/10/2014 15:30'!
extendSelectionUp
	self moveUp: true.
	! !

!TxTextEditorMorph methodsFor: 'testing' stamp: 'FernandoOlivero 9/19/2013 01:21'!
allowsKeymapping
	^ true! !

!TxTextEditorMorph methodsFor: 'drawing' stamp: 'IgorStasenko 10/22/2013 03:47'!
drawKeyboardFocusOn: aCanvas 
	"draw an outline, indicating that receiver has the input focus"
	| stroke |
	stroke := aCanvas setStrokePaint: Color yellow  .
	stroke 
		width: self borderWidth;
		joinRound.
	aCanvas
		drawShape: (self innerBounds expandBy: self borderWidth/2.0) ;
		draw.
		! !

!TxTextEditorMorph methodsFor: 'event handling' stamp: 'FernandoOlivero 9/4/2013 11:10'!
handlesMouseDown: event
	^ true! !

!TxTextEditorMorph methodsFor: 'event handling' stamp: 'SeanDeNigris 2/10/2015 14:15'!
mouseWheel: event
	event isUp ifTrue: [
		layoutViewMorph scrollBy: 0@ (layoutViewMorph height/10) negated.
		  ].
	event isDown ifTrue: [ 
		layoutViewMorph scrollBy: 0@ (layoutViewMorph height/10).
	  ].
	
	self updateCursor: false.! !

!TxTextEditorMorph methodsFor: 'event handling' stamp: 'IgorStasenko 9/19/2014 15:06'!
handlesMouseOver: evt 
	"Do I want to receive mouseEnter: and mouseLeave: when the button is up and the hand is empty?"
	^ true! !

!TxTextEditorMorph methodsFor: 'navigation' stamp: 'IgorStasenko 4/10/2014 15:29'!
moveUp
	"move cursor up"

	^ self moveUp: false! !

!TxTextEditorMorph methodsFor: 'accessing' stamp: 'IgorStasenko 5/12/2014 16:00'!
layoutStrategy: aStrategy

	self layoutViewMorph layoutStrategy: aStrategy! !

!TxTextEditorMorph methodsFor: 'editing' stamp: 'IgorStasenko 9/26/2014 13:10'!
handleDeleteKey

	(controller selection contains: (self layoutView layout startPosition)) ifTrue: [ 
		"The selected portion to delete contains layout starting position. We must
		take care resetting view to new position"
		self layoutView resetLayout: controller selection start.
		 ].

	controller delete.
	self controllerChanged.! !

!TxTextEditorMorph methodsFor: 'editing' stamp: 'IgorStasenko 4/8/2014 15:01'!
cutToClipboard
	
	controller selection isEmpty ifTrue: [ ^ self ].

	Clipboard clipboardText: controller selection asString.
	self handleDeleteKey.
! !

!TxTextEditorMorph methodsFor: 'navigation' stamp: 'IgorStasenko 10/30/2013 15:29'!
moveLeft

	controller moveLeft.
	self updateCursor: true.! !

!TxTextEditorMorph methodsFor: 'event handling' stamp: 'FernandoOlivero 9/4/2013 11:10'!
handlesKeyboard: evt
	
	^true! !

!TxTextEditorMorph methodsFor: 'drawing-not supported' stamp: 'FernandoOlivero 9/19/2013 01:03'!
drawOn: aCanvas
	"I'm Athens only!!"! !

!TxTextEditorMorph methodsFor: 'drawing' stamp: 'IgorStasenko 9/22/2014 16:04'!
drawOnAthensCanvas: aCanvas
	super drawOnAthensCanvas: aCanvas.

	self drawSelectionOn: aCanvas.
	

	self hasKeyboardFocus ifTrue: [ 
			self drawKeyboardFocusOn: aCanvas.
		]! !

!TxTextEditorMorph methodsFor: 'initialization' stamp: 'FernandoOlivero 9/19/2013 01:50'!
initializeShortcuts: aKMDispatcher
	aKMDispatcher attachCategory: #TxTextEditorMorph ! !

!TxTextEditorMorph methodsFor: 'scrolling' stamp: 'IgorStasenko 4/10/2014 16:59'!
autoScrollView: evt
	"This is kind of a hack because the PluggableTextMorph expects me to first expand the selection before auto scrolling will work."

	evt position y < self top
		ifTrue: [ layoutViewMorph scrollBy: 0 @ (evt position y - self top) abs negated ]
		ifFalse: [ layoutViewMorph scrollBy: 0 @ (evt position y - self top) abs ].
	
	self selectTo: evt position - layoutViewMorph innerBounds origin.! !

!TxTextEditorMorph methodsFor: 'editing' stamp: 'IgorStasenko 9/19/2013 11:53'!
handleEnterKey
	self insert: String cr.
	self controllerChanged.! !

!TxTextEditorMorph methodsFor: 'navigation' stamp: 'IgorStasenko 4/10/2014 15:32'!
moveDown: extendingSelection
	"move down visually"
	| pos visualPos point |

	pos := controller cursorPosition.
	visualPos := layoutViewMorph layoutPositionAt:  pos ifOutside: [
		"outside of layout, lets move down via text"
		controller moveDown.
		^ self updateCursor: true.
		].
	
	"we are adding small constant to point just outside the bounds of current line where cursor is located"
	point := visualPos bottomPoint + (0@0.001).
	layoutViewMorph ensurePointWithinLayout: point.

	".. and if there's something more, let layout give us new position "
	point := layoutViewMorph textPositionAt: point.
	extendingSelection 
		ifTrue: [ controller moveSelectionEndTo: point ] 
		ifFalse: [ controller moveCursorTo: point ].

	self updateCursor:true.
	! !

!TxTextEditorMorph methodsFor: 'navigation' stamp: 'IgorStasenko 4/10/2014 17:05'!
moveToLineStart

	controller moveToLineStart.
	self updateCursor: true.! !

!TxTextEditorMorph methodsFor: 'initialization' stamp: 'FernandoOlivero 9/4/2013 14:18'!
newViewMorphOn: aTxModel 
	^ TxLayoutViewMorph text: aTxModel .
! !

!TxTextEditorMorph methodsFor: 'focus management' stamp: 'FernandoOlivero 9/4/2013 11:11'!
takesKeyboardFocus
	^ true! !

!TxTextEditorMorph methodsFor: 'navigation' stamp: 'IgorStasenko 11/28/2013 10:41'!
moveTo: aPoint
	"when user clicks on text, move a text cursor close to hand position"
	| textPosition |
	textPosition := layoutViewMorph textPositionAt: aPoint.
	controller moveCursorTo: textPosition.
	self updateCursor: true.
	! !

!TxTextEditorMorph methodsFor: 'editing' stamp: 'IgorStasenko 9/19/2013 14:38'!
undo 	
	controller undo.
	self controllerChanged.! !

!TxTextEditorMorph methodsFor: 'navigation' stamp: 'IgorStasenko 3/10/2014 16:06'!
movePageDown
	"move down visually"
	| pos visualPos point |

	pos := controller cursorPosition.
	visualPos := layoutViewMorph layoutPositionAt:  pos ifOutside: [
		layoutViewMorph scrollIntoView: pos.
		visualPos := layoutViewMorph layoutPositionAt:  pos ifOutside: [ self error: 'that''s not damn possible' ].
	].
	
	
	"we are adding small constant to point just outside the bounds of current line where cursor is located"
	point := visualPos topPointInView.
	layoutViewMorph scrollBy: 0@visualPos layout view height.
 
 	controller moveCursorTo: (layoutViewMorph textPositionAt: point).		
	self updateCursor:true.
	! !

!TxTextEditorMorph methodsFor: 'navigation' stamp: 'IgorStasenko 4/10/2014 17:07'!
selectToLineEnd

	controller extendSelectionToLineEnd.
	self updateCursor: true.! !

!TxTextEditorMorph methodsFor: 'updating' stamp: 'IgorStasenko 5/13/2014 15:23'!
updateCursor
	self updateCursor: false.! !

!TxTextEditorMorph methodsFor: 'editing' stamp: 'AlainPlantec 1/12/2015 23:06'!
handleBackspaceKey
	(controller selection contains: self layoutView layout startPosition)
		ifTrue: [ 
			"The selected portion to delete contains layout starting position. We must
			take care resetting view to new position"
			self layoutView resetLayout: controller selection start ].
	controller backspace.
	self layoutView layout startPosition isValid
		ifFalse: [ self layoutView resetLayout: controller selection start ].
	self controllerChanged! !

!TxTextEditorMorph methodsFor: 'focus management' stamp: 'IgorStasenko 4/25/2014 15:43'!
hasFocus
	^ self hasKeyboardFocus! !

!TxTextEditorMorph methodsFor: 'updating' stamp: 'IgorStasenko 11/28/2013 10:43'!
controllerChanged
	layoutViewMorph updateMorph.
	self updateCursor: true.! !

!TxTextEditorMorph methodsFor: 'event handling' stamp: 'IgorStasenko 4/10/2014 15:34'!
handlesMouseWheel: event
	^ true! !

!TxTextEditorMorph methodsFor: 'drawing' stamp: 'IgorStasenko 10/22/2013 02:48'!
fullDrawOnAthensCanvas: aCanvas
	| clip |
	super fullDrawOnAthensCanvas: aCanvas.
	clip := self clippingBounds.

	aCanvas 
		clipBy: clip
		during: [ self drawOverlaysOn: aCanvas ]! !

!TxTextEditorMorph methodsFor: 'event handling' stamp: 'NicolaiHess 2/15/2015 12:27'!
handleMouseMove: anEvent
	"Reimplemented because we really want #mouseMove when a morph is dragged around"
	anEvent wasHandled ifTrue:[^self]. "not interested"
	(anEvent hand hasSubmorphs) ifTrue:[^self].
	anEvent wasHandled: true.
	self mouseMove: anEvent.
	(self handlesMouseStillDown: anEvent) ifTrue:[
		"Step at the new location"
		self startStepping: #handleMouseStillDown: 
			at: Time millisecondClockValue
			arguments: {anEvent copy resetHandlerFields}
			stepTime: 1].
! !

!TxTextEditorMorph methodsFor: 'editing' stamp: 'IgorStasenko 11/11/2014 15:58'!
insertObject: anObject 	

	controller insertObject: anObject.
	self controllerChanged.! !

!TxTextEditorMorph methodsFor: 'focus management' stamp: 'IgorStasenko 4/25/2014 16:00'!
keyboardFocusChange: gotFocus

	super keyboardFocusChange: gotFocus.
	
	cursorMorph visible: gotFocus; stopStepping.! !

!TxTextEditorMorph methodsFor: 'text wrapping' stamp: 'IgorStasenko 5/13/2014 14:49'!
characterWrappingStrategy

	^ TxAthensCharacterWrappingStrategy new rightMargin: CursorEdgeMargin! !

!TxTextEditorMorph methodsFor: 'editing' stamp: 'IgorStasenko 4/8/2014 14:55'!
pasteClipboard
	| stuff |
	
	stuff := Clipboard clipboardText asString.
	
	self insert: stuff.! !

!TxTextEditorMorph methodsFor: 'navigation-selection' stamp: 'IgorStasenko 11/11/2014 15:47'!
selectAll
	controller selectAll.
	self updateCursor: false.
	self changed.! !

!TxTextEditorMorph methodsFor: 'navigation-selection' stamp: 'IgorStasenko 4/10/2014 15:32'!
extendSelectionDown
	self moveDown: true.
	! !

!TxTextEditorMorph methodsFor: 'drawing' stamp: 'SeanDeNigris 4/3/2014 15:00'!
drawSelectionOn: aCanvas

	controller selection isEmpty ifTrue: [ ^ self ].
	aCanvas pathTransform restoreAfter: [ 
		aCanvas pathTransform translateBy: self innerBounds topLeft.  
		aCanvas clipBy: (0@0 extent: self layoutView extent)  during: [ 
			self layoutView renderHighlight: controller selection with: self theme selectionColor on: aCanvas.
			]
	]! !

!TxTextEditorMorph methodsFor: 'event handling' stamp: 'IgorStasenko 9/10/2014 15:46'!
cursorForPosition: aPoint
	| pos |
	pos := layoutViewMorph textPositionAt: (aPoint - layoutViewMorph innerBounds origin).
	^ pos span attributeAt: TxCursorAttribute.
	! !

!TxTextEditorMorph methodsFor: 'drawing-not supported' stamp: 'FernandoOlivero 9/19/2013 01:02'!
drawSubmorphsOn: aCanvas
	"I'm Athens only!!"! !

!TxTextEditorMorph methodsFor: 'editing' stamp: 'IgorStasenko 11/11/2014 16:31'!
insert: aString 	

	controller insert: aString.

	self controllerChanged.! !

!TxTextEditorMorph methodsFor: 'event handling' stamp: 'IgorStasenko 4/10/2014 16:53'!
mouseUp: anEvent
	self stopSteppingSelector: #autoScrollView:.! !

!TxTextEditorMorph methodsFor: 'scrolling' stamp: 'IgorStasenko 3/27/2014 16:24'!
resetViewTo: startPosition

	layoutViewMorph resetViewTo: startPosition.
	self updateCursor: false.
! !

!TxTextEditorMorph methodsFor: 'updating' stamp: 'IgorStasenko 4/30/2014 12:48'!
updateCursor: scrollViewToCursorPos

	| position textPosition |

	scrollViewToCursorPos ifTrue: [  
		layoutViewMorph 
			scrollIntoView: controller cursorPosition
			margin: CursorEdgeMargin
		 ].

	textPosition := controller cursorPosition.
	position := layoutViewMorph layoutPositionAt: textPosition ifOutside: [  
		^ cursorMorph visible: false.
		].
	cursorMorph visible: self hasFocus.
	cursorMorph layoutPosition: position.
! !

!TxTextEditorMorph methodsFor: 'updating' stamp: 'IgorStasenko 5/13/2014 15:22'!
ownerChanged

	self updateCursor .
	! !

!TxTextEditorMorph methodsFor: 'accessing' stamp: 'FernandoOlivero 9/4/2013 12:56'!
text
	^ layoutViewMorph text ! !

!TxTextEditorMorph methodsFor: 'editing' stamp: 'IgorStasenko 4/8/2014 14:58'!
copyToClipboard
	
	controller selection isEmpty ifTrue: [ ^ self ].

	
	Clipboard clipboardText: controller selection asString.
	
! !

!TxTextEditorMorph methodsFor: 'navigation-selection' stamp: 'IgorStasenko 4/10/2014 15:13'!
selectTo: aPoint 
	"when user clicks on text, shift key select close to hand position"
	| textPosition |
	textPosition := layoutViewMorph textPositionAt: aPoint.
	controller moveSelectionEndTo: textPosition.
	self updateCursor: true.
	! !

!TxTextEditorMorph methodsFor: 'navigation' stamp: 'IgorStasenko 11/29/2013 17:35'!
moveDown
	"move down visually"
	| pos visualPos point |

	pos := controller cursorPosition.
	visualPos := layoutViewMorph layoutPositionAt:  pos ifOutside: [
		"outside of layout, lets move down via text"
		controller moveDown.
		^ self updateCursor: true.
		].
	
	"we are adding small constant to point just outside the bounds of current line where cursor is located"
	point := visualPos bottomPoint + (0@0.001).
	layoutViewMorph ensurePointWithinLayout: point.

	".. and if there's something more, let layout give us new position "
	controller moveCursorTo: (layoutViewMorph textPositionAt: point).		
	self updateCursor:true.
	! !

!TxTextEditorMorph methodsFor: 'accessing' stamp: 'SeanDeNigris 4/2/2014 15:11'!
borderWidth
	^ 0! !

!TxTextEditorMorph methodsFor: 'drawing' stamp: 'IgorStasenko 10/22/2013 03:45'!
drawCursorPositionOn: aCanvas
	"debugging: draw the cursor position (line/col numbers)"
	| pathTransform pos |

	pos := controller cursorPosition asString.
	
	pathTransform := aCanvas pathTransform.
	pathTransform restoreAfter: [
		pathTransform translateX: 0 Y: self height - 20.
		aCanvas setFont: (LogicalFont familyName: 'Arial' pointSize: 16).
		aCanvas setPaint: (Color red alpha:0.5).
		aCanvas drawString: pos ]
	
	! !

!TxTextEditorMorph methodsFor: 'accessing' stamp: 'IgorStasenko 3/26/2014 15:17'!
layoutView
	^ layoutViewMorph layoutView! !

!TxTextEditorMorph methodsFor: 'event handling' stamp: 'IgorStasenko 9/10/2014 16:41'!
mouseMove: anEvent

	anEvent hand showTemporaryCursor: (self cursorForPosition: anEvent position).

	anEvent redButtonPressed "left button" ifTrue: [ 
		(anEvent position y between: self top and: self bottom) ifFalse:[
			self startStepping: #autoScrollView:
			at: Time millisecondClockValue
			arguments: (Array with: anEvent)
			stepTime: 100. "fast enough" ]
		ifTrue: [ 		
			self stopSteppingSelector: #autoScrollView:.
			self selectTo: anEvent position - layoutViewMorph innerBounds origin.
		]
	 ]! !

!TxTextEditorMorph methodsFor: 'navigation' stamp: 'IgorStasenko 4/10/2014 15:29'!
moveUp: extendingSelection
	"move up visually"
	| pos visualPos point |
	pos := controller cursorPosition.
	visualPos := layoutViewMorph layoutPositionAt:  pos ifOutside: [
		"outside of layout, lets move down via text"
		controller moveUp.

		^ self updateCursor: true.
		].
	"we are subtracting small constant to point just outside the bounds at the top of current line"

	point := visualPos topPointInView - (0@0.0001).
	layoutViewMorph ensurePointWithinLayout: point.

	pos := layoutViewMorph textPositionAt: point.

	extendingSelection 
		ifTrue: [ controller moveSelectionEndTo:pos ] 
		ifFalse: [ controller moveCursorTo: pos ].
	self updateCursor: true.! !

!TxTextEditorMorph methodsFor: 'initialization' stamp: 'IgorStasenko 10/22/2013 15:33'!
initializeText: aTxModel 
	layoutViewMorph := self newViewMorphOn: aTxModel.

	cursorMorph := TxCaretCursor new.
	self addMorph: cursorMorph.

	layoutViewMorph 
"		hResizing: #spaceFill;
		vResizing: #spaceFill".
	self addMorph: layoutViewMorph.

 	
	self initializeController.
	self color: Color white.! !

!TxTextEditorMorph methodsFor: 'drawing' stamp: 'IgorStasenko 4/25/2014 15:49'!
drawOverlaysOn: aCanvas
	"draw an overlays (after all submorphs being drawn)"
	
	| pathTransform |
	pathTransform := aCanvas pathTransform.
	pathTransform restoreAfter: [
		pathTransform translateBy: self innerBounds topLeft.  
		
		self hasFocus ifTrue: [ 
			aCanvas setPaint: (Color yellow alpha:0.05).
			aCanvas drawShape: (0@0 extent: self innerBounds extent)
			 ]
		
	"	self drawCursorPositionOn: aCanvas."
	].
! !

!TxTextEditorMorph methodsFor: 'accessing' stamp: 'IgorStasenko 10/22/2013 02:46'!
clipSubmorphs
	"we're always clipping"
	^ true! !

!TxTextEditorMorph methodsFor: 'navigation-selection' stamp: 'SeanDeNigris 4/2/2014 15:35'!
extendSelectionRight
	controller extendSelectionRight.
	self updateCursor: true.! !

!TxTextEditorMorph methodsFor: 'editing' stamp: 'IgorStasenko 9/19/2013 11:53'!
addNewLineAtCursor
	self insert: Character cr! !

!TxTextEditorMorph methodsFor: 'navigation' stamp: 'IgorStasenko 3/27/2014 15:40'!
scrollIntoView: aTextPosition

	layoutViewMorph scrollIntoView: aTextPosition.
	self updateCursor: false.! !

!TxTextEditorMorph methodsFor: 'testing' stamp: 'IgorStasenko 11/11/2014 15:19'!
selectionIsEmpty
	^ controller selection isEmpty! !

!TxTextEditorMorph methodsFor: 'updating' stamp: 'IgorStasenko 10/14/2013 11:05'!
initializeController
	controller := TxTextEditor text: self text.
	self controllerChanged.! !

!TxTextEditorMorph methodsFor: 'scrolling' stamp: 'IgorStasenko 3/21/2014 18:20'!
scrollBy: aPoint 
	layoutViewMorph scrollBy: aPoint.
	self changed.! !

!TxTextEditorMorph methodsFor: 'navigation' stamp: 'IgorStasenko 9/25/2014 17:11'!
movePageUp
	"move up visually"
	| pos visualPos point |


	pos := controller cursorPosition.
	visualPos := layoutViewMorph layoutPositionAt:  pos ifOutside: [
		layoutViewMorph scrollIntoView: pos.
		visualPos := layoutViewMorph layoutPositionAt:  pos ifOutside: [ self error: 'that''s not damn possible' ].
		].
	
	
	"we are adding small constant to point just outside the bounds of current line where cursor is located"
	point := visualPos topPointInView.
	layoutViewMorph scrollBy: 0@visualPos layout view height negated.
 
 	controller moveCursorTo: (layoutViewMorph textPositionAt: point).		
	self updateCursor:true.
	! !

!TxTextEditorMorph methodsFor: 'navigation' stamp: 'IgorStasenko 10/30/2013 14:38'!
moveRight
	
	controller moveRight.
	self updateCursor: true.! !

!TxTextEditorMorph methodsFor: 'updating' stamp: 'IgorStasenko 5/13/2014 15:24'!
doLayoutIn: layoutBounds

	"force view morph to always cover layout bounds"
	layoutViewMorph bounds: layoutBounds.
	self updateCursor.
	super doLayoutIn:layoutBounds.
	! !

!TxTextEditorMorph methodsFor: 'navigation' stamp: 'IgorStasenko 4/10/2014 17:08'!
selectToLineStart

	controller extendSelectionToLineStart.
	self updateCursor: true.! !

!TxTextEditorMorph methodsFor: 'navigation-selection' stamp: 'SeanDeNigris 4/2/2014 15:32'!
extendSelectionLeft
	controller extendSelectionLeft.
	self updateCursor: true.! !

!TxTextEditorMorph methodsFor: 'accessing' stamp: 'IgorStasenko 10/22/2013 14:22'!
layoutViewMorph
	^ layoutViewMorph! !

!TxTextEditorMorph methodsFor: 'event handling' stamp: 'IgorStasenko 11/11/2014 15:01'!
mouseDown: anEvent
	| pos action point |
	self takeKeyboardFocus.
	
	point := anEvent position - layoutViewMorph innerBounds origin.
	pos := layoutViewMorph textPositionAt: point. 
	action := pos span attributeAt: TxActionAttribute.
	(action handleEvent: anEvent) ifTrue: [  ^ self ].
	
	anEvent redButtonPressed ifTrue: [
		anEvent shiftPressed
			ifTrue: [ self selectTo: point ]
			ifFalse: [ self moveTo: point ] ].

	anEvent yellowButtonPressed ifTrue: [
		
		self announcer announce: (TxContextMenuAnnouncement new
			event: anEvent;
			editorMorph: self;
			textPosition: pos;
			yourself
		).
	]! !

!TxTextEditorMorph methodsFor: 'accessing' stamp: 'IgorStasenko 11/11/2014 15:18'!
controller
	^ controller! !

!TxTextEditorMorph methodsFor: 'event handling' stamp: 'IgorStasenko 9/10/2014 15:52'!
mouseLeave: evt
	"Handle a mouseLeave event, meaning the mouse just left my bounds with no button pressed."
	super mouseLeave: evt.
	self currentHand showTemporaryCursor: nil
	! !

!TxTextEditorMorph methodsFor: 'accessing' stamp: 'IgorStasenko 5/13/2014 15:15'!
contents: anObject
 
	controller contents: anObject.
	
	self resetViewTo: controller cursorPosition.
	self controllerChanged.! !

!TxTextEditorMorph class methodsFor: 'initialization' stamp: 'IgorStasenko 11/29/2013 17:27'!
initialize
	"This constant controls the margin between view's edge and cursor,
	used when view is auto-scrolled to make current cursor position fully visible
	and not clipped "
	CursorEdgeMargin := 10.! !

!TxTextEditorMorph class methodsFor: 'examples' stamp: 'IgorStasenko 10/22/2013 03:12'!
openInWindowWithString: aString

	| text |
	
	text := TxModel new.
	text atAttribute: TxFontAttribute  put: (LogicalFont familyName: 'Microsoft Sans Serif' pointSize: 16 ).
	text atAttribute: TxForeColorAttribute  put: (Color black).
	
	text endPosition insert: aString.
	
	^ self openInWindowWithText: text! !

!TxTextEditorMorph class methodsFor: 'examples' stamp: 'IgorStasenko 9/19/2014 14:44'!
openInWindowWithText: aTxModel
	"PLEASE NOTE!!!!!! This method is not part of official API.
	used only for examples"
 
	| editorMorph wrapper |
	editorMorph := self text: aTxModel.
	editorMorph
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		layoutFrame: LayoutFrame identity;
		wrapText: true.
		
	wrapper := AthensWrapMorph new.
	wrapper
		layoutPolicy: ProportionalLayout new;
		addMorph: editorMorph.
	
	^ wrapper openInWindow! !

!TxTextEditorMorph class methodsFor: 'examples' stamp: 'IgorStasenko 12/19/2013 20:08'!
exampleTextMultiSizeFont

	"self exampleTextMultiSizeFont"

	| text |
	text := TxModel new.
100 timesRepeat: [ 	
	1 to: 10 do: [ :i | | font | 

		text endPosition insert: 'The quick brown fox jumps over the lazy dog 1234567890'.
		font := LogicalFont familyName: 'Tahoma' pointSize: 9 + i.
		
		(text endPosition moveToLineStart selectTo: text endPosition) applyAttribute: (TxFontAttribute with: font).
		text endPosition insert: String cr.
	].
].
	^ self openInWindowWithText: text! !

!TxTextEditorMorph class methodsFor: 'examples' stamp: 'IgorStasenko 9/24/2014 18:00'!
exampleWithEmbeddedObject

| text |
text := 'abciuwhfi whifu wehifuhweifu wi ' asTxModel.

1000 timesRepeat:[ 
text endPosition insert: 'wioeuhfiw eufi'.
text endPosition insertObject:  Morph new "((SimpleButtonMorph newWithLabel: 'DEADBEEF' ) color: Color random )" .
text endPosition insert: 'uwe hfiuweh fiue', String cr.
text endPosition insert: '-------', String cr.
].

(text startPosition selectTo: (text startPosition + 10)) applyAttribute: (TxCursorAttribute with: Cursor webLink ).
TxTextEditorMorph openInWindowWithText: text
! !

!TxTextEditorMorph class methodsFor: 'examples' stamp: 'IgorStasenko 9/24/2014 16:01'!
exampleWithCustomClickAction
| text |
text := 'abciuwhfi whifu wehifuhweifu wi ' asTxModel.

10 timesRepeat:[  
	
text endPosition insert: 'wioeuhfiw eufi'.

text endPosition insert: 'uwe hfiuweh fiue', String cr.
].


(text startPosition selectTo: (text startPosition + 10))
	applyAttribute: (TxActionAttribute new 
		filter: [ :evt | evt commandKeyPressed and: [ evt  isMouseDown] ];
		value: [ self inform: 'action' ]
	);
	applyAttribute: (TxForeColorAttribute with: Color red).

TxTextEditorMorph openInWindowWithText: text
! !

!TxTextEditorMorph class methodsFor: 'examples' stamp: 'IgorStasenko 9/10/2014 16:16'!
exampleWithCustomCursor
| text selection |
text := 'abciuwhfi whifu wehifuhweifu wi ' asTxModel.

10 timesRepeat:[ 
text endPosition insert: 'wioeuhfiw eufi'.
text endPosition insert: 'uwe hfiuweh fiue', String cr.
].

selection := (text startPosition selectTo: (text startPosition + 20)).

selection applyAttribute: (TxCursorAttribute with: Cursor webLink ).
selection applyAttribute: (TxForeColorAttribute with: Color blue ).

TxTextEditorMorph openInWindowWithText: text! !

!TxTextEditorMorph class methodsFor: 'keybindings' stamp: 'IgorStasenko 11/11/2014 15:46'!
buildTextEditorKeymapsOn: aBuilder	 
	<keymap> 
	 
	{  
		Character home. #moveToLineStart.
		Character home shift. #selectToLineStart.
		Character end. #moveToLineEnd.
		Character end shift. #selectToLineEnd.
		
		Character arrowRight. #moveRight.
		Character arrowLeft. #moveLeft.
		Character arrowUp. #moveUp.
		Character arrowDown. #moveDown.
		Character cr. #handleEnterKey.
		Character delete. #handleDeleteKey.
		Character backspace. #handleBackspaceKey.
		Character pageDown. #movePageDown.
		Character pageUp. #movePageUp.
		$z command. #undo.
		Character arrowRight shift. #extendSelectionRight.
		Character arrowLeft shift. #extendSelectionLeft.
		Character arrowUp shift. #extendSelectionUp.
		Character arrowDown shift. #extendSelectionDown.
		$v command. #pasteClipboard.
		$c command. #copyToClipboard.
		$x command. #cutToClipboard.
		$a command. #selectAll.
		
	 } pairsDo: [ :key :action |
		(aBuilder shortcut: action )
		category: #TxTextEditorMorph
		default: key asKeyCombination
		do: [ :morph | morph perform: action ].
	]! !

!TxTextEditorMorph class methodsFor: 'instance creation' stamp: 'FernandoOlivero 9/4/2013 11:23'!
text: aTxModel 
	| editor |
	editor := self new.
	editor initializeText: aTxModel .
	^ editor ! !

!TxTextEditorMorph class methodsFor: 'examples' stamp: 'IgorStasenko 8/17/2014 17:43'!
exampleTextMultiSizeFont2

	"self exampleTextMultiSizeFont2"

	| text font |
	text := TxModel new.
	
	1 to: 100000 do: [ :i | 

		text endPosition insert: i asString , ' The quick brown fox jumps over the lazy dog 1234567890'.
		text endPosition insert: String cr.
	].

	font := LogicalFont familyName: 'Tahoma' pointSize: 12.
	text selectAll applyAttribute: (TxFontAttribute with: font).


	^ self openInWindowWithText: text! !

!TxTextLayoutTest methodsFor: 'private' stamp: 'FernandoOlivero 8/25/2013 09:57'!
textForView1
	^ self subclassResponsibility ! !

!TxTextLayoutTest methodsFor: 'private' stamp: 'FernandoOlivero 8/25/2013 09:57'!
defaultLayoutViewExtent
	^ self subclassResponsibility ! !

!TxTextLayoutTest methodsFor: 'private' stamp: 'FernandoOlivero 8/25/2013 09:57'!
textForView2
	^ self subclassResponsibility ! !

!TxTextLayoutTest methodsFor: 'running' stamp: 'FernandoOlivero 8/25/2013 10:12'!
setUp
	| text |
	text := self newText: self textForView1.
	view1 := self newViewOn:  text .
	
	text := self newText: self textForView2.
	view2 := self newViewOn:  text .
! !

!TxTextPosition commentStamp: 'IgorStasenko 10/2/2014 14:58'!
I represent position inside a text. I am immutable.
I'm characterized by a span and position inside span.

Usually, one do not specify absolute positioning in text (using textIndex accessors),
but instead a relative, by starting from some known point (like already known position, or text start/end),
and navigating to desired position using the navigation protocol (moveLeft/moveRight etc).
 
I provide operations to 
	- query the position in a text (isAtEnd, isAtStart, isValid)
	- compute new position relative to existing one (moveToLeft: 3, moveToUp)
	- insert new text (#insert: ) or embedded object (#insertObject:).
	
I can also give access to absolute positioning in text using #asTextIndex accessors,
but they are much slower/ineffective comparing to relative positioning, and should not be used unless ultimately necessary.
!
!TxTextPosition methodsFor: 'operations' stamp: 'IgorStasenko 10/23/2013 02:06'!
insert: aString
	^ span at: self insert: aString.
! !

!TxTextPosition methodsFor: 'navigation' stamp: 'IgorStasenko 9/20/2013 02:32'!
moveLeft: number
	| newSpan newSpanPos |
	
	(number < 0)
		ifTrue: [ ^ self moveRight: number negated ].
		
	"Decrement spanPosition, if we're going to stay in same span,
	otherwise move prior to last character of previous span"
	newSpan := span.
	newSpanPos := spanPosition.
	
	number timesRepeat: [
		newSpanPos > 0 
			ifTrue: [ newSpanPos := newSpanPos - 1 ]
			ifFalse: [ 
				newSpan := newSpan prevIfNone: [  "can't go further than start " ^ self text startPosition ].
				newSpanPos := newSpan size - 1 max: 0.
			].
	].

	^ self class span: newSpan spanPosition: newSpanPos.
	! !

!TxTextPosition methodsFor: 'navigation' stamp: 'IgorStasenko 9/20/2013 02:41'!
moveToLineEnd

	^ (span nextLineSeparatorIfNone: [ ^ self text endPosition ])
		startPosition! !

!TxTextPosition methodsFor: 'operations' stamp: 'IgorStasenko 6/14/2013 15:52'!
deleteUpTo: aTxPosition
	^ span deleteUpTo: aTxPosition startingAt: self! !

!TxTextPosition methodsFor: 'operations' stamp: 'IgorStasenko 9/19/2013 14:53'!
removePreviousCharacter
	| copy |
	copy := self copy.
	copy moveLeft.
	^ (copy to: self) cut start! !

!TxTextPosition methodsFor: 'navigation' stamp: 'IgorStasenko 9/20/2013 12:38'!
moveUp
	^ self moveUp: 1! !

!TxTextPosition methodsFor: 'accessing' stamp: 'IgorStasenko 10/2/2014 14:53'!
linePosition: pos 
	"Compute new position, located at new position in the same line as receiver.
	If given position larger than line length, answer the position at the end of line.
	The line position is a number of moves right from the beginning of line.
	"
	| sz linespan |
	
	sz := pos.
	(span isLineSeparator and: [ spanPosition = 1 ]) 
		ifTrue: [ linespan := span next ]
		ifFalse: [ linespan := span lineStartSpan ].

	[ sz  > linespan size ] whileTrue: [
		sz := sz - linespan size.
		linespan := linespan next.
		
		( linespan isLineSeparator or: [linespan isAtEnd ] ) ifTrue: [
			"reached end of line, set position to last valid position in current line"
			^ TxTextPosition span: linespan prev spanPosition: linespan size.
			]
	]. 
	^ TxTextPosition span: linespan spanPosition: sz
! !

!TxTextPosition methodsFor: 'accessing' stamp: 'IgorStasenko 9/17/2012 16:11'!
span: aSpan
	span := aSpan.! !

!TxTextPosition methodsFor: 'accessing' stamp: 'IgorStasenko 9/20/2013 02:17'!
text
	^ span text! !

!TxTextPosition methodsFor: 'navigation' stamp: 'IgorStasenko 9/20/2013 02:17'!
moveToEnd
	^ self text endPosition! !

!TxTextPosition methodsFor: 'navigation' stamp: 'IgorStasenko 9/26/2014 14:55'!
moveRight: number
	| newSpan newSpanPos |
	(number < 0)
		ifTrue: [ ^ self moveLeft: number negated ].
		
	newSpan := span.
	newSpanPos := spanPosition.
	
	number timesRepeat: [ 
 		newSpanPos < newSpan size 
			ifTrue: [ newSpanPos := newSpanPos  + 1 ]
			ifFalse: [ 
				newSpan := newSpan nextIfNone: [ "reached end" ^ self text endPosition ].
"				self assert: newSpan size > 0."
				newSpanPos := 1 min: newSpan size ]
 	].

	^ self class span: newSpan spanPosition: newSpanPos
	! !

!TxTextPosition methodsFor: 'navigation' stamp: 'IgorStasenko 10/14/2013 11:57'!
nextPosition
	"answer the position which is right next to the receiver"
	
	^ self isAtSpanEnd 
		ifFalse: [  span positionAt: spanPosition + 1 ]
		ifTrue: [ span next startPosition ]! !

!TxTextPosition methodsFor: 'printing' stamp: 'IgorStasenko 6/4/2013 16:29'!
printOn: aStream

	"super printOn: aStream. "
	self isValid ifFalse: [ aStream nextPutAll: '**invalid position**'. ^ self ].
	aStream 
		nextPutAll: ' line: ';
		print: self lineNumber;
		nextPutAll: ' col: ';
		print: self linePosition 
		! !

!TxTextPosition methodsFor: 'accessing' stamp: 'IgorStasenko 9/17/2012 16:21'!
spanPosition
	^ spanPosition! !

!TxTextPosition methodsFor: 'operations' stamp: 'IgorStasenko 9/20/2013 12:59'!
nextPutAll: aString
	^ self text at: self insert: aString
! !

!TxTextPosition methodsFor: 'navigation' stamp: 'IgorStasenko 9/20/2013 12:38'!
moveUp: number
	| oldLinePosition  pos |
	
	(number < 0)
		ifTrue: [ ^ self moveDown: number negated ].
	
	oldLinePosition := self linePosition.
	pos := self.
	
	number timesRepeat: [ 
		pos := pos moveToLineStart moveLeft.
		pos isAtStart ifTrue: [  ^ pos ]
	].

	^ pos linePosition: oldLinePosition.
! !

!TxTextPosition methodsFor: 'navigation' stamp: 'IgorStasenko 9/20/2013 02:17'!
moveToStart
	^ self text startPosition! !

!TxTextPosition methodsFor: 'operations' stamp: 'IgorStasenko 9/19/2013 14:53'!
removeNextCharacter
	| copy |
	copy := self copy.
	copy moveRight.
	^ (self to: copy) cut start! !

!TxTextPosition methodsFor: 'comparing' stamp: 'IgorStasenko 9/17/2012 15:05'!
hash
	^ span hash bitXor: spanPosition hash! !

!TxTextPosition methodsFor: 'converting' stamp: 'IgorStasenko 9/20/2013 12:44'!
asPosition
	^ self! !

!TxTextPosition methodsFor: 'accessing' stamp: 'IgorStasenko 9/17/2012 16:41'!
span
	^ span! !

!TxTextPosition methodsFor: 'operations' stamp: 'DenisKudrayshov 4/25/2013 00:21'!
mergeUpTo: aTxPosition
	span deleteUpTo: aTxPosition startingAt: self! !

!TxTextPosition methodsFor: 'navigation' stamp: 'IgorStasenko 12/19/2013 15:47'!
moveToLineStart
	| sp |
	self isAtLineStart ifTrue: [  ^ self ].
	sp := span.
	(span isLineSeparator and: [ spanPosition = 0 ]) ifTrue: [ sp := span prev ].
	sp reverseDo: [ :each | each isLineSeparator ifTrue: [ ^ each endPosition ] ].
	^ self text startPosition! !

!TxTextPosition methodsFor: 'operations' stamp: 'IgorStasenko 7/27/2012 14:34'!
nextPut: aCharacter
	self shouldBeImplemented ! !

!TxTextPosition methodsFor: 'navigation' stamp: 'AlainPlantec 1/9/2015 08:25'!
moveDown: number
	"Answer the new position, *number* of lines below than receiver's line,
	trying to preserve the same line position"

	| linePos newSpan |
	
	(number < 0)
		ifTrue: [ ^ self moveUp: number negated ].
		
	linePos := self linePosition.
	newSpan := span.
	number timesRepeat: [
		newSpan := newSpan nextLineSeparatorIfNone: [ ^ self moveToEnd ].
	].
	
	^ newSpan endPosition linePosition: linePos.
	! !

!TxTextPosition methodsFor: 'navigation' stamp: 'IgorStasenko 9/20/2013 02:39'!
moveTo: anotherTextPosition

	^ anotherTextPosition ! !

!TxTextPosition methodsFor: 'converting' stamp: 'IgorStasenko 9/20/2013 01:59'!
asCursor
	^ TxTextCursor new position: self! !

!TxTextPosition methodsFor: 'operations' stamp: 'IgorStasenko 8/21/2014 11:50'!
insertObject: anObject 
	"
	Insert an embedded object at receiver.
	Answer the position right after the inserted object.
	"
	^ span at: self insertObject: anObject.
! !

!TxTextPosition methodsFor: 'initialize-release' stamp: 'IgorStasenko 9/20/2013 02:16'!
span: aSpan spanPosition: aSpanPosition

	span := aSpan.
	spanPosition := aSpanPosition
	! !

!TxTextPosition methodsFor: 'accessing' stamp: 'IgorStasenko 9/17/2012 16:22'!
spanPosition: anInteger
	spanPosition := anInteger! !

!TxTextPosition class methodsFor: 'instance creation' stamp: 'IgorStasenko 9/20/2013 02:13'!
span: span spanPosition: spanPosition

	^ self basicNew
			span: span spanPosition: spanPosition
! !

!TxTextPosition class methodsFor: 'instance creation' stamp: 'IgorStasenko 9/20/2013 12:45'!
on: aText
	^ self span: aText startSpan spanPosition: 0! !

!TxTextRenderer methodsFor: 'rendering' stamp: 'IgorStasenko 9/19/2013 12:43'!
renderEndOfLineMark
	canvas 
		setPaint: Color red;
		drawShape: (0@ 0 corner: 10@ -10).! !

!TxTextRenderer methodsFor: 'rendering' stamp: 'IgorStasenko 8/22/2013 15:18'!
renderCharacters: aString from: start to: stop 
	

	" accumulate advance while rendering spans"
	"canvas drawShape: (advance x @ advance y extent: 2 @ 2)."
	canvas 
		setPaint: color;
		setFont: font;
		drawString: aString from: start to: stop! !

!TxTextRenderer methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/22/2013 15:21'!
advance: ad
	
	canvas pathTransform translateBy: ad! !

!TxTextRenderer methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/9/2013 15:31'!
initialize
	color := Color black.! !

!TxTextRenderer methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 10/23/2013 02:49'!
renderLines: lines on: aCanvas

	canvas := aCanvas.
	
	canvas pathTransform restoreAfter: [
		lines do: [:line | |  |
			currentLine := line.
			maxAscent := line maxAscent.
			"set the origin to font's baseline position"
			canvas pathTransform translateX: 0 Y: maxAscent.
			"reset advance"
			advance := 0@0.
			
			canvas pathTransform restoreAfter: [
				line renderOn: self ].
			
			
			"line is rendered, advance vertically by line height"
			canvas pathTransform translateX: 0 Y: line height - maxAscent.

"			canvas pathTransform translateX: 0 Y: line height * 1.2 - maxAscent."
		] ]! !

!TxTextRenderer methodsFor: 'rendering' stamp: 'IgorStasenko 9/19/2014 18:14'!
renderMorph: aMorph

	canvas pathTransform restoreAfter: [  
	"	canvas pathTransform translateX: 0 Y: aMorph height negated. "
		
		aMorph currentPosition: (canvas pathTransform transform: 0@0).
	"	canvas fullDrawMorph: aMorph."
	]! !

!TxTextRenderer methodsFor: 'rendering' stamp: 'IgorStasenko 8/12/2013 15:39'!
setFont: aFont 
	font := aFont! !

!TxTextRenderer methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/19/2013 16:01'!
canvas
	^ canvas! !

!TxTextRenderer methodsFor: 'rendering' stamp: 'IgorStasenko 8/12/2013 16:03'!
setColor: aColor 
	color := aColor.! !

!TxTextRenderer methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/22/2013 15:16'!
render: aText lines: lines on: aCanvas

	text := aText.
	canvas := aCanvas.
	
	canvas pathTransform restoreAfter: [

		lines do: [:line | |  |
			currentLine := line.
			maxAscent := line maxAscent.
			"set the origin to font's baseline position"
			canvas pathTransform translateX: 220 Y: maxAscent.
			"reset advance"
			advance := 0@0.
			canvas pathTransform restoreAfter: [
				line renderOn: self ].
			"line is rendered, advance vertically by line height"
			canvas pathTransform translateX: 0 Y: line height * 1.2 - maxAscent.
		] ]! !

!TxTextRenderer class methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/9/2013 15:31'!
textGoryDetails

"
Took from: http://www.freetype.org/freetype2/docs/tutorial/step2.html

(Font face metrics)
In this case, you can access the global design metrics as:

units_per_EM 	

This is the size of the EM square for the font face. It is used by scalable formats to scale design coordinates to device pixels, as described in the last chapter of this section. Its value usually is 2048 (for TrueType) or 1000 (for Type 1), but others are possible too. It is set to 1 for fixed-size formats like FNT/FON/PCF/BDF.

bbox 	

The global bounding box is defined as the largest rectangle that can enclose all the glyphs in a font face.

ascender 	

The ascender is the vertical distance from the horizontal baseline to the highest ‘character’ coordinate in a font face. Unfortunately, font formats define the ascender differently. For some, it represents the ascent of all capital latin characters (without accents), for others it is the ascent of the highest accented character, and finally, other formats define it as being equal to bbox.yMax.

descender 	

The descender is the vertical distance from the horizontal baseline to the lowest ‘character’ coordinate in a font face. Unfortunately, font formats define the descender differently. For some, it represents the descent of all capital latin characters (without accents), for others it is the ascent of the lowest accented character, and finally, other formats define it as being equal to bbox.yMin. This field is negative for values below the baseline.

height 	

This field is simply used to compute a default line spacing (i.e., the baseline-to-baseline distance) when writing text with this font. Note that it usually is larger than the sum of the ascender and descender taken as absolute values. There is also no guarantee that no glyphs extend above or below subsequent baselines when using this distance.

max_advance_width 	

This field gives the maximum horizontal cursor advance for all glyphs in the font. It can be used to quickly compute the maximum advance width of a string of text. It doesn't correspond to the maximum glyph image width!!

max_advance_height 	

Same as max_advance_width but for vertical text layout.

underline_position 	

When displaying or rendering underlined text, this value corresponds to the vertical position, relative to the baseline, of the underline bar's center. It is negative if it is below the baseline.

underline_thickness 	

When displaying or rendering underlined text, this value corresponds to the vertical thickness of the underline.


"! !

!TxTextStyler commentStamp: 'IgorStasenko 10/21/2014 16:20'!
(TxTextStyler new
	styleMethod: (TxTextStyler >> #initializeStylesFor:))
	editInWindow


- supports some ast-based navigation:
 	- cmd-click on message selection to show implementors of it
	- shift-cmd-click to show senders of it
	- cmd-click on class name to browse it!
!TxTextStyler methodsFor: 'visiting' stamp: 'IgorStasenko 9/26/2014 12:51'!
addStyle: styleName forNode: node  
	self addAttributes: (self attributesFor: styleName) forNode: node.! !

!TxTextStyler methodsFor: 'visiting' stamp: 'IgorStasenko 9/26/2014 14:27'!
addAttribute: attr forNode: node
	| start selection |
	start := text startPosition moveRight: node start-1.
	
	selection := start selectTo: (start + (node stop - node start + 1)).
	
	selection applyAttribute:  attr.! !

!TxTextStyler methodsFor: 'styling' stamp: 'IgorStasenko 9/26/2014 12:52'!
attributesFor: aName 
	^ styles at: aName ! !

!TxTextStyler methodsFor: 'styling' stamp: 'IgorStasenko 11/10/2014 17:38'!
styleCode: aCode inContext: aContext isMethod: isMethod
	| ast |
	
	ast := isMethod 
		ifTrue: [
			[ RBParser parseFaultyMethod: aCode asString ] 
			on: Error 
			do: [ RBParser parseFaultyExpression: aCode asString] ]
		ifFalse: [ RBParser parseFaultyExpression: aCode asString ].
	
	aContext ifNotNil: [  
		ast methodClass: aContext ].
	ast doSemanticAnalysis.
	text := ast source asTxModel.
	
	ast acceptVisitor: self.
	
	^ text
! !

!TxTextStyler methodsFor: 'visiting' stamp: 'IgorStasenko 10/21/2014 16:17'!
visitMessageNode: aMessageNode 
	| style link hand |
	style := #keyword.
	(Symbol findInterned: aMessageNode selector asString)
		ifNil: [ 
			style := (Symbol thatStartsCaseSensitive: aMessageNode selector asString skipping: nil) isNil
				ifTrue: [ #undefinedKeyword ]
				ifFalse: [ #incompleteKeyword ] ].

	aMessageNode selectorParts do: [ :token | self addStyle: style forNode: token ].
	
	link := TxActionAttribute new 
		filter: [ :evt | evt commandKeyPressed and: [ evt  isMouseDown] ];
		value: [:evt |
				evt shiftPressed ifTrue: [ 
					SystemNavigation new browseSendersOf: aMessageNode selector name: 'Senders of ', aMessageNode selector autoSelect: aMessageNode selector  ]
				ifFalse: [ SystemNavigation new browseAllImplementorsOf: aMessageNode selector ] ].
	hand := TxCursorAttribute with: Cursor webLink.

	aMessageNode selectorParts do: [ :token | 
		self addAttribute: link forNode: token.
		self addAttribute: hand forNode: token.
		 ].

	
	(aMessageNode isCascaded not or: [ aMessageNode isFirstCascaded ])
		ifTrue: [ self visitNode: aMessageNode receiver ].
	aMessageNode arguments do: [ :each | self visitNode: each ]! !

!TxTextStyler methodsFor: 'visiting' stamp: 'IgorStasenko 9/26/2014 14:05'!
visitMethodNode: aMethodNode 

	aMethodNode comments do: [ :comment |
		self 
			addStyle: #comment
			from: comment first
			to: comment last ].
		
	aMethodNode arguments do: [ :argument |
		self 
			addStyle: #patternArg
			forNode: argument ].
		
	aMethodNode selectorParts do: [ :selectorPart |
		self 
			addStyle: #patternKeyword
			forNode: selectorPart ].
	
	aMethodNode pragmas
		do: [ :each | self visitNode: each ].
		
	self visitNode: aMethodNode body! !

!TxTextStyler methodsFor: 'visiting' stamp: 'IgorStasenko 11/11/2014 17:29'!
visitParseErrorNode: errorNode

	self 
		addStyle: #invalid
		forNode: errorNode.
	! !

!TxTextStyler methodsFor: 'visiting' stamp: 'IgorStasenko 9/26/2014 15:25'!
visitSelfNode: aSelfNode
	| link methodClass |
	
	self 
		addStyle: #self
		forNode: aSelfNode.
	
	methodClass := aSelfNode method methodClass.
		
	link := TxActionAttribute new 
		filter: [ :evt | evt commandKeyPressed and: [ evt  isMouseDown] ];
		value: [ methodClass browse ].

	self 
		addAttribute: link
		forNode: aSelfNode.! !

!TxTextStyler methodsFor: 'visiting' stamp: 'IgorStasenko 9/26/2014 13:38'!
visitArgumentNode: node 
	self 
		addStyle: #argument
		forNode: node.! !

!TxTextStyler methodsFor: 'visiting' stamp: 'IgorStasenko 9/26/2014 13:48'!
visitBlockNode: aBlockNode 
	aBlockNode arguments do: [ :argument|
		self 
			addStyle: #blockPatternArg
			forNode: argument ].
	
	self visitNode: aBlockNode body! !

!TxTextStyler methodsFor: 'visiting' stamp: 'IgorStasenko 9/26/2014 13:30'!
visitNode: node
	"node comments do: [ :comment |
		self 
			addStyle: #comment
			from: comment first
			to: comment last ]."

	^node acceptVisitor: self 
! !

!TxTextStyler methodsFor: 'styling' stamp: 'IgorStasenko 11/11/2014 17:33'!
restyle: aText inContext: aContext isMethod: isMethod
	| ast code |
	
	code := aText asString.
	ast := isMethod 
		ifTrue: [
			[ RBParser parseFaultyMethod: code ] 
			on: Error 
			do: [ RBParser parseFaultyExpression: code ] ]
		ifFalse: [ RBParser parseFaultyExpression: code ].
	
	aContext ifNotNil: [  
		ast methodClass: aContext ].
	ast doSemanticAnalysis.
	text := aText.
	
	ast acceptVisitor: self.
	
	^ text
! !

!TxTextStyler methodsFor: 'visiting' stamp: 'IgorStasenko 9/26/2014 13:30'!
visitSequenceNode: node
	
	node temporaries do: [ :temporary|
		self 
			addStyle: #patternTempVar
			forNode: temporary ].
	
	node statements do: [:each | self visitNode: each] 
! !

!TxTextStyler methodsFor: 'private' stamp: 'IgorStasenko 9/26/2014 14:16'!
initializeStylesFor: styleTable

	styles := IdentityDictionary new.
	
	styleTable
		do: [:each |   | stream styleName style temp |
			
			
			stream := each readStream.
			style := TxStyle new.
			
			"style name"
			styleName := stream next.
		
			"color"
			temp := stream next.
			temp ifNotNil: [
				style add: (TxForeColorAttribute with: (Color colorFrom: temp)).
			].
			
			"emphasis"	
			temp := stream next.
			temp ifNotNil: [
				style add: (TxFontAttribute with: (self pickFontWithEmphasis: temp)).
			 ].	
				
			"text style name, ignored"
			stream next.
			
			"pixel height"
			temp := stream next.
			temp ifNotNil: [ 
				"ignored by now"
				 ].
			
			styles at: styleName put: style.
		]! !

!TxTextStyler methodsFor: 'visiting' stamp: 'IgorStasenko 9/26/2014 13:48'!
visitTemporaryNode: aTemporaryNode 
	self 
		addStyle: #tempVar
		forNode: aTemporaryNode! !

!TxTextStyler methodsFor: 'visiting' stamp: 'IgorStasenko 9/26/2014 14:48'!
addAttributes: style forNode: node
	| start selection |
	start := text startPosition moveRight: node start -1 .
	
	selection := start selectTo: (start moveRight: (node stop - node start + 1)).
	
	style attributes valuesDo: [ :each |	selection applyAttribute:  each ].! !

!TxTextStyler methodsFor: 'initialization' stamp: 'IgorStasenko 11/11/2014 17:41'!
initialize

	self initializeStylesFor: SHTextStylerST80 solarizedStyleTable ! !

!TxTextStyler methodsFor: 'visiting' stamp: 'IgorStasenko 9/26/2014 13:32'!
visitAssignmentNode: node 

	self visitNode: node variable.
	self visitNode: node value! !

!TxTextStyler methodsFor: 'styling' stamp: 'IgorStasenko 11/11/2014 17:43'!
literalStyleSymbol: aValue
	aValue isSymbol
		ifTrue: [ ^ #symbol ].
	aValue isString
		ifTrue: [ ^ #string ].
	aValue isNumber
		ifTrue: [ ^ #number ].
	aValue == true
		ifTrue: [ ^ #true ].
	aValue == false
		ifTrue: [ ^ #false ].
	aValue isNil
		ifTrue: [ ^ #nil ].
	^ #default! !

!TxTextStyler methodsFor: 'visiting' stamp: 'IgorStasenko 11/10/2014 17:16'!
visitVariableNode: aVariableNode 
"	aVariableNode name first isUppercase 
		ifTrue: [environment ifNil: [ ^ self visitClassReferenceNode: aVariableNode ]].
"
	| link |
	
	self 
		addStyle: (self resolveStyleFor: aVariableNode) 
		forNode: aVariableNode.
	
	(aVariableNode binding notNil and: [  
	aVariableNode isGlobal ]) ifTrue: [  
		link := TxActionAttribute new 
			filter: [ :evt | evt commandKeyPressed and: [ evt  isMouseDown] ];
		value: [ aVariableNode binding value instanceSide browse ].

		self 
			addAttribute: link
			forNode: aVariableNode.
	]! !

!TxTextStyler methodsFor: 'visiting' stamp: 'IgorStasenko 11/11/2014 17:44'!
visitLiteralNode: node 
	
	self 
		addStyle: (self literalStyleSymbol: node value)
		forNode: node! !

!TxTextStyler methodsFor: 'private' stamp: 'IgorStasenko 12/6/2014 18:23'!
resolveStyleFor: aVariableNode
	aVariableNode binding isUndeclared ifTrue: [
		| var |
		var := aVariableNode scope findVariable: [ :varS | varS name beginsWith: aVariableNode name ] ifNone: [ nil ].
		var ifNil: [ #default ] ifNotNil: [ #incompleteIdentifier ].
	].
	aVariableNode isArg ifTrue: [ ^#methodArg].
	aVariableNode isTemp ifTrue: [ ^#tempVar].
	aVariableNode isInstance ifTrue: [ ^#instVar]. 

	aVariableNode isUndeclared ifTrue: [ ^#invalid]. 
	aVariableNode isGlobal ifTrue: [ ^  #globalVar ].
	self flag: 'todo: see if its incompleteIdentifier'.
	^#invalid.! !

!TxTextStyler methodsFor: 'private' stamp: 'IgorStasenko 9/25/2014 18:19'!
pickFontWithEmphasis: emphasisName
	| emphasis |
	emphasis := TextEmphasis perform: emphasisName.
	
	^ TxFontAttribute defaultValue emphasized: emphasis emphasisCode.

! !

!TxTextStyler methodsFor: 'styling' stamp: 'IgorStasenko 9/26/2014 13:49'!
styleMethod: aMethod
	| ast |
	
	ast := aMethod ast.
	text := ast source asTxModel.
	
	ast acceptVisitor: self.
	
	^ text
! !

!TxTextStyler class methodsFor: 'examples' stamp: 'IgorStasenko 11/11/2014 11:59'!
highlightIncompleteCode
	| styler text code |
	
	
	code := 'thisIsIncompleteMethod: argument
		| dork zork |
		Wo
	
	'.
	
	styler := self new.
	text := styler styleCode: code inContext: self "class" isMethod: true.

	^ text editInWindow.! !

!TxTextStyler class methodsFor: 'examples' stamp: 'IgorStasenko 11/10/2014 15:23'!
useCase

	| styler text |
	
	styler := self new.
	text := styler styleMethod: (self >> #initializeStylesFor:).
	^ text editInWindow.! !

!TxTextStyles commentStamp: 'IgorStasenko 8/29/2014 13:58'!
I am holding a list of styles used by particular text.
There's always at least one style provided - the default one.

Note, i holding the style list weakly, so the styles no longer used by text are 
automatically removed. And only default style always kept around.!
!TxTextStyles methodsFor: 'operations' stamp: 'IgorStasenko 8/29/2014 16:39'!
extend: style with: aNewAttribute
	"Answer a style, which is same as base style, but with new/different attribute value.
	We look for a list of existing attribute sets to check, if there's already a matching one, then simply answer it.
	Else we will create a new attribute set which will inherit most from its base set of attributes.
	"
	| newStyle |
	
	"Do nothing, if it already matches"
	(style includes: aNewAttribute) ifTrue: [  ^ style ].
	
	newStyle := style copy add: aNewAttribute.
	^ self addStyle: newStyle! !

!TxTextStyles methodsFor: 'initialize' stamp: 'IgorStasenko 8/29/2014 13:50'!
initialize

	self initializeDefaultStyle.
	styles := WeakOrderedCollection new.! !

!TxTextStyles methodsFor: 'copying' stamp: 'IgorStasenko 8/28/2014 14:39'!
postCopy
	defaultStyle := defaultStyle copy.
	styles := styles collect: [ :each | each copy ].! !

!TxTextStyles methodsFor: 'operations' stamp: 'IgorStasenko 8/29/2014 16:38'!
addStyle: aStyle
	"Register a new style, but only if none of existing styles matching an argument, answer the 
	registered style"
	
	aStyle = defaultStyle ifTrue: [ ^ defaultStyle ].
	^ styles detect: [ :each | aStyle = each ] ifNone: [ styles add: aStyle ]! !

!TxTextStyles methodsFor: 'accessing' stamp: 'IgorStasenko 8/29/2014 13:58'!
defaultStyle
	^ defaultStyle! !

!TxTextStyles methodsFor: 'initialize' stamp: 'IgorStasenko 8/29/2014 13:43'!
initializeDefaultStyle

	defaultStyle := TxStyle new.
	! !

!TxTextStyles methodsFor: 'initialize' stamp: 'IgorStasenko 8/29/2014 13:56'!
initWithText: aTxModel
	text := aTxModel! !

!TxTextStyles methodsFor: 'accessing' stamp: 'IgorStasenko 8/29/2014 13:55'!
text
	^ text! !

!TxTextStyles class methodsFor: 'instance creation' stamp: 'IgorStasenko 8/29/2014 13:56'!
on: aTxModel
	^ self new initWithText: aTxModel! !

!TxTextStylesTest commentStamp: '<historical>'!
A TxTextStylesTest is a test class for testing the behavior of TxTextStyles!
!TxTextStylesTest methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/29/2014 16:46'!
testAddingCopyOfSameStyleReturnsOriginalStyle
	| style attribute result original copy |
	
	style := TxStyle new.
	attribute := TxForeColorAttribute with: Color red.
	style add: attribute.
	
	original := text addStyle: style.
	copy := original copy.
		
	result := text addStyle: copy.
	
	self assert: result == original! !

!TxTextStylesTest methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/29/2014 16:45'!
testAddingSameStyleTwice
	| style attribute result |
	
	style := TxStyle new.
	attribute := TxForeColorAttribute with: Color red.
	style add: attribute.
	
	result := text addStyle: style.
	
	self assert: result == style! !

!TxTextStylesTest methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 8/29/2014 16:42'!
setUp
	text := 'abc' asTxModel ! !

!TxVerticalSlider methodsFor: 'initialize' stamp: 'IgorStasenko 3/18/2014 15:55'!
defaultBounds
	^ (0@0 corner: self defaultWidth @ 100)! !

!TxVerticalSlider methodsFor: 'event handling' stamp: 'IgorStasenko 3/21/2014 17:28'!
handleEventWhileDraggingSlider: event delta: delta

	| deltaPos newPosition ann |
	event redButtonPressed ifFalse: [ ^ false ]. "finished"
	
	event isMove ifTrue: [ 
		"adjust slider position relative to dragged position"

		deltaPos :=  (event position y - bounds top) - delta.
		newPosition := deltaPos / bounds height.
		ann := (TxSliderDragged source: self) oldPosition: sliderPosition; newPosition: newPosition; yourself.
		self sliderPosition: newPosition.
		
		self announcer announce: ann.
	 ].
	

	^ true.! !

!TxVerticalSlider methodsFor: 'geometry' stamp: 'IgorStasenko 3/18/2014 15:05'!
extent: newExtent
	
	^ super extent: self  defaultWidth @ newExtent y ! !

!TxVerticalSlider methodsFor: 'drawing' stamp: 'IgorStasenko 4/29/2014 16:49'!
drawOnAthensCanvas: aCanvas
	"before rendering transform from a global coordinates (Morphic) to relative coordinates (Athens)"
	| top bottom |
	
	top := bounds top + 1.
	bottom := bounds bottom - 1.
	
	aCanvas 
		setPaint: self backgroundColor;
		drawShape: bounds.
		
		
	aCanvas 
		setPaint: (captured ifTrue: [ self sliderHighlightColor ] ifFalse: [ self sliderColor] ).
		
	 aCanvas drawShape: 
		(bounds left + 1 @ (bounds top + mappedPosition max: top ) 
		rectangle: bounds right -1 @ (bounds top + mappedPosition + mappedThickness min: bottom ))  
	 ! !

!TxVerticalSlider methodsFor: 'geometry' stamp: 'IgorStasenko 3/19/2014 10:51'!
mapMouseRelativeToSlider: aPosition

	"Map mouse (screen position) relative to slider position"

	^ (aPosition y - bounds top) min: bounds height max: 0! !

!TxVerticalSlider methodsFor: 'geometry' stamp: 'IgorStasenko 3/21/2014 15:33'!
originForDragStart: point


	^ point y - bounds top - mappedPosition! !

!TxVerticalSlider methodsFor: 'geometry' stamp: 'IgorStasenko 4/29/2014 16:44'!
computeSliderBounds
	| max |
	
	max := self height.
		
	mappedThickness := max * thickness max: self minimumThicknessInPixels.
	mappedPosition := (max * sliderPosition) min: max.
	
	mappedPosition + mappedThickness > max ifTrue: [ 
		mappedPosition := (max - mappedThickness).
	]
	 ! !

!TxViewContainer commentStamp: 'IgorStasenko 11/11/2014 14:58'!
the container holds the view (or editor) morph and all decorators together (scollbars/line numbers etc).

The model serves as an application-level object, that is final client of text updates/changes/context menu etc.!
!TxViewContainer methodsFor: 'instance creation' stamp: 'IgorStasenko 9/25/2014 16:42'!
newEditor: aText

	^ TxTextEditorMorph text: aText! !

!TxViewContainer methodsFor: 'instance creation' stamp: 'IgorStasenko 9/25/2014 16:43'!
newEditor

	^ self newEditor: ''! !

!TxViewContainer methodsFor: 'accessing' stamp: 'IgorStasenko 5/12/2014 16:12'!
wrapText: aBoolean
	"turn text wrapping on/off by switching layout strategy"

	self viewMorph wrapText: aBoolean! !

!TxViewContainer methodsFor: 'initialization' stamp: 'IgorStasenko 9/25/2014 16:45'!
editText: aText
	self setView: (self newEditor: aText)! !

!TxViewContainer methodsFor: 'initialization' stamp: 'IgorStasenko 11/11/2014 14:59'!
setView: newView

	view == newView ifTrue:  [ ^ self ].
	view delete.
	view := newView.
	self addMorph: view.

	decorators do: [ :each | each setupView: newView ]! !

!TxViewContainer methodsFor: 'initialization' stamp: 'IgorStasenko 2/12/2014 14:56'!
initialize
	super initialize.
	self layoutPolicy: ProportionalLayout new.
	self layoutInset: 0.
	decorators := OrderedCollection new.
	view := self newView.
	view 
		layoutFrame: LayoutFrame identity;
		hResizing: #spaceFill;
		vResizing: #spaceFill.

	self addMorph: view.
	
! !

!TxViewContainer methodsFor: 'accessing' stamp: 'IgorStasenko 11/11/2014 14:56'!
model
	^ model! !

!TxViewContainer methodsFor: 'layout' stamp: 'IgorStasenko 3/10/2014 13:51'!
doLayoutIn: layoutBounds
	| box priorBounds processedBounds |
	priorBounds := self outerBounds.
	processedBounds := layoutBounds.
	decorators do: [:morph |
		processedBounds := morph computeBoundsIn: processedBounds ].
	
	
	view bounds: processedBounds.
	
	fullBounds := bounds.
	
	box := self outerBounds.
	box = priorBounds 
		ifFalse: [self invalidRect: (priorBounds quickMerge: box)]! !

!TxViewContainer methodsFor: 'initialization' stamp: 'IgorStasenko 3/26/2014 15:16'!
useEditor
	self setView: self newEditor! !

!TxViewContainer methodsFor: 'accessing' stamp: 'IgorStasenko 3/26/2014 15:05'!
viewMorph
	^ view! !

!TxViewContainer methodsFor: 'accessing' stamp: 'IgorStasenko 3/26/2014 15:06'!
layoutView
	^ view layoutView! !

!TxViewContainer methodsFor: 'instance creation' stamp: 'IgorStasenko 2/12/2014 14:15'!
newView

	^ TxLayoutViewMorph new! !

!TxViewContainer methodsFor: 'accessing' stamp: 'IgorStasenko 11/11/2014 14:57'!
model: aModel
	model := aModel! !

!TxViewContainer methodsFor: 'accessing' stamp: 'IgorStasenko 9/25/2014 16:41'!
view
	^ view! !

!TxViewContainer methodsFor: 'accessing' stamp: 'IgorStasenko 3/21/2014 17:47'!
addDecorator: morph
	decorators add: morph.
	self addMorph: morph.
	morph setContainer: self.! !

!TxViewContainer class methodsFor: 'examples' stamp: 'IgorStasenko 9/26/2014 13:15'!
exampleEditorExistingTextWithEmbeddedObjects
"self exampleEditorExistingTextWithEmbeddedObjects
"
	| view wrapper text |

	text := 'abciuwhfi whifu wehifuhweifu wi ' asTxModel.

	1 to: 1000 do: [:i | 
	text endPosition insert: i asString, ' empty bottles on the bar'.
	text endPosition insertObject:  ((SimpleButtonMorph newWithLabel: 'DEADBEEF' ) color: Color random ) .
	text endPosition insert: 'uwe hfiuweh fiue', String cr.
	(text endPosition moveLeft selectTo: (text endPosition moveLeft: 5)) applyAttribute: (TxForeColorAttribute with: Color random).
	text endPosition insert: '-------', String cr.
	].

	view := TxViewContainer new.

"	view addDecorator: (TxViewDecoratorMorph new placeTop color: Color red;yourself).
	view addDecorator: (TxViewDecoratorMorph new placeLeft  color: Color blue;yourself).
	view addDecorator: (TxViewDecoratorMorph new placeBottom color: Color green;yourself)."
	view addDecorator: (TxScrollbarDecorator new placeRight color: Color blue;yourself).
	view addDecorator: (TxScrollbarDecorator new placeBottom color: Color green;yourself).
	view editText: text.
	view wrapText: false.
	view hResizing: #spaceFill ; vResizing: #spaceFill .
	view layoutFrame: LayoutFrame identity.
	
	wrapper := AthensWrapMorph new.
	wrapper layoutPolicy: ProportionalLayout new.
	wrapper addMorph: view.
	
	wrapper openInWindow extent: 400@400.


! !

!TxViewContainer class methodsFor: 'examples' stamp: 'IgorStasenko 2/12/2014 17:46'!
example1

	| view |

	view := TxViewContainer new.

	view addDecorator: (TxViewDecoratorMorph new placeTop color: Color red;yourself).
	view addDecorator: (TxViewDecoratorMorph new placeRight color: Color yellow;yourself).
	view addDecorator: (TxViewDecoratorMorph new placeLeft  color: Color blue;yourself).
	view addDecorator: (TxViewDecoratorMorph new placeBottom color: Color green;yourself).

	view  openInWindow


! !

!TxViewContainer class methodsFor: 'convenience' stamp: 'IgorStasenko 11/11/2014 14:29'!
editText: aText
	| view wrapper |

	view := self new.

	view addDecorator: (TxScrollbarDecorator new placeRight color: Color blue;yourself).
	view addDecorator: (TxScrollbarDecorator new placeBottom color: Color green;yourself).
	view editText: aText.
	view wrapText: false.
	view hResizing: #spaceFill ; vResizing: #spaceFill .
	view layoutFrame: LayoutFrame identity.
	
	wrapper := AthensWrapMorph new.
	wrapper layoutPolicy: ProportionalLayout new.
	wrapper addMorph: view.
	
	^ wrapper openInWindow extent: 400@400.


! !

!TxViewContainer class methodsFor: 'examples' stamp: 'IgorStasenko 11/11/2014 14:32'!
example2

	| view wrapper |

	view := TxViewContainer new.

	view addDecorator: (TxViewDecoratorMorph new placeTop color: Color red;yourself).
	view addDecorator: (TxViewDecoratorMorph new placeLeft  color: Color blue;yourself).
	view addDecorator: (TxViewDecoratorMorph new placeBottom color: Color green;yourself).
	view addDecorator: (TxScrollbarDecorator new placeRight color: Color blue;yourself).
	view addDecorator: (TxScrollbarDecorator new placeBottom color: Color green;yourself).
	view useEditor.
	view wrapText: false.
	view hResizing: #spaceFill ; vResizing: #spaceFill .
	view layoutFrame: LayoutFrame identity.
	
	wrapper := AthensWrapMorph new.
	wrapper layoutPolicy: ProportionalLayout new.
	wrapper addMorph: view.
	
	wrapper openInWindow extent: 400@400.


! !

!TxViewContainer class methodsFor: 'examples' stamp: 'IgorStasenko 8/18/2014 16:51'!
exampleOneLineEditor

	| view wrapper |

	view := TxViewContainer new.

"	view addDecorator: (TxViewDecoratorMorph new placeTop color: Color red;yourself).
	view addDecorator: (TxViewDecoratorMorph new placeLeft  color: Color blue;yourself).
	view addDecorator: (TxViewDecoratorMorph new placeBottom color: Color green;yourself)."
	view addDecorator: (TxScrollbarDecorator new placeBottom color: Color green;yourself).
	view useEditor.
	view wrapText: false.
	view hResizing: #spaceFill ; vResizing: #spaceFill .
	view layoutFrame: LayoutFrame identity.
	
	wrapper := AthensWrapMorph new.
	wrapper layoutPolicy: ProportionalLayout new.
	wrapper addMorph: view.
	
	wrapper openInWindow extent: 400@400.


! !

!TxViewCoordinatesToTextPositionTest methodsFor: 'tests' stamp: 'IgorStasenko 8/30/2013 13:24'!
testLayoutPositionShouldBeBeyondStartPosition
	|  oneCharRight layoutPosition |
	
	oneCharRight := view layout startPosition copy moveRight.
	layoutPosition := view layoutPositionAt: oneCharRight ifOutside: [  self assert: false ].

	self assert: view text == oneCharRight text.
	
	self assert: layoutPosition baselinePoint x > 0.! !

!TxViewCoordinatesToTextPositionTest methodsFor: 'tests' stamp: 'StephaneDucasse 2/11/2014 10:47'!
testOriginMovedRightShouldIncreaseTextPosition
	| position oneCharRight pt layoutPosition |
	
	oneCharRight := view layout startPosition moveRight.
	layoutPosition := view layoutPositionAt: oneCharRight ifOutside: [  self assert: false ].
	pt := layoutPosition baselinePointInView.
	
	position := view textPositionAt: pt + (1@0).

	self assert: position = oneCharRight! !

!TxViewCoordinatesToTextPositionTest methodsFor: 'tests' stamp: 'IgorStasenko 10/15/2013 12:35'!
testOriginShouldTransformToStartPosition
	| position |
	position := view textPositionAt: 0@0.
	self assert: position asTextIndex = view layout startPosition asTextIndex .! !

!TxViewDecoratorMorph commentStamp: 'IgorStasenko 2/12/2014 12:13'!
This is not a decorator pattern.
!
!TxViewDecoratorMorph methodsFor: 'initialization' stamp: 'IgorStasenko 2/12/2014 17:15'!
initialize
	super initialize.
	self hResizing: #spaceFill; vResizing: #spaceFill.
	self placeDefault.! !

!TxViewDecoratorMorph methodsFor: 'placement' stamp: 'IgorStasenko 2/12/2014 17:42'!
placeLeft

	placement := [ :layoutBounds | 
		self bounds: (layoutBounds origin extent: self width @ layoutBounds height).
		
		layoutBounds origin x+self width @ layoutBounds origin y corner: layoutBounds corner
	].
! !

!TxViewDecoratorMorph methodsFor: 'accessing' stamp: 'IgorStasenko 3/21/2014 17:47'!
setContainer: anObject
	
	viewContainer := anObject! !

!TxViewDecoratorMorph methodsFor: 'as yet unclassified' stamp: 'IgorStasenko 5/13/2014 14:33'!
computeBoundsIn: layoutBounds
	| rest oldBounds |

	self visible ifFalse: [ ^ layoutBounds ].
	
	oldBounds := bounds.
	rest := placement value: layoutBounds.
	
	oldBounds ~= bounds ifTrue: [ 
		self invalidRect: (oldBounds quickMerge: bounds)
		 ].
	^ rest! !

!TxViewDecoratorMorph methodsFor: 'accessing' stamp: 'IgorStasenko 3/21/2014 17:47'!
viewContainer
	
	^ viewContainer! !

!TxViewDecoratorMorph methodsFor: 'setting up' stamp: 'IgorStasenko 3/26/2014 15:12'!
setupView: viewMorph
	"view morph has changed.. rewire the events if necessary"! !

!TxViewDecoratorMorph methodsFor: 'placement' stamp: 'IgorStasenko 2/12/2014 13:03'!
placeDefault
	^ self placeTop! !

!TxViewDecoratorMorph methodsFor: 'placement' stamp: 'IgorStasenko 2/12/2014 17:38'!
placeRight

	placement := [ :layoutBounds | 
		self bounds: (layoutBounds right - self width @ layoutBounds top corner: layoutBounds corner).
		layoutBounds origin corner: bounds origin x@layoutBounds bottom 
		].
! !

!TxViewDecoratorMorph methodsFor: 'placement' stamp: 'IgorStasenko 2/12/2014 17:45'!
placeBottom

	placement := [ :layoutBounds | 
		self bounds: (layoutBounds left @ (layoutBounds bottom - self height) corner: layoutBounds corner).
		
		layoutBounds origin corner: layoutBounds right @ bounds top.
	].
! !

!TxViewDecoratorMorph methodsFor: 'placement' stamp: 'IgorStasenko 2/12/2014 17:32'!
placeTop

	placement := [ :layoutBounds | 
		self bounds: (layoutBounds topLeft extent: layoutBounds width @ self height).
		layoutBounds origin x@ (layoutBounds origin y + self height) corner: layoutBounds corner
		].
	 ! !

!TxWorkspace commentStamp: 'TorstenBergmann 3/14/2015 18:18'!
A workspace using TxTextStyler!
!TxWorkspace methodsFor: 'opening' stamp: 'IgorStasenko 11/11/2014 17:11'!
wireEvents
	| textEditor |
	
	textEditor := editor controller.
	
	textEditor announcer on: TxDeletedTextAnnouncement send: #onTextDeleted: to: self.
	textEditor announcer on: TxInsertedTextAnnouncement send: #onTextInserted: to: self.! !

!TxWorkspace methodsFor: 'syntax highlighting' stamp: 'IgorStasenko 11/11/2014 17:36'!
updateSyntaxHighlighting
	"don't try it at home"
	| textEditor start end  |
	
	textEditor := editor controller.	
	text := textEditor text.
		
	self flag: 'styling changes the text, and we forced to use crappy method of preserving selection..'.
	start := textEditor selection start asTextIndex.
	end := textEditor selection end asTextIndex.
	
	styler restyle: text inContext: nil isMethod: false.

	"restore selection"	
	textEditor selection start: (text positionAtTextIndex: start).
	textEditor selection end: (text positionAtTextIndex: end).

! !

!TxWorkspace methodsFor: 'actions' stamp: 'MarcusDenker 2/20/2015 11:39'!
invokeDoitIn: editorMorph 
	| myeditor |
	myeditor := editorMorph controller. 

	myeditor selection isEmpty ifTrue: [  
		myeditor moveToLineStart; extendSelectionToLineEnd. 
	].

	myeditor selection isEmpty ifFalse: [ 
		Smalltalk compiler evaluate: myeditor selection asString.
	 ].! !

!TxWorkspace methodsFor: 'initialization' stamp: 'IgorStasenko 11/11/2014 17:36'!
initialize 
	super initialize.
	styler := TxTextStyler new.! !

!TxWorkspace methodsFor: 'events' stamp: 'IgorStasenko 11/11/2014 17:18'!
onTextInserted: ann 
	self updateSyntaxHighlighting.! !

!TxWorkspace methodsFor: 'morphic ui' stamp: 'IgorStasenko 11/11/2014 14:38'!
defaultExtent
	^ 800@500! !

!TxWorkspace methodsFor: 'opening' stamp: 'IgorStasenko 11/11/2014 16:17'!
buildContextMenu: announcement

	| menu isEmpty | 
	menu := MenuMorph new.
"	menu addTitle: 'Operations'."
		
	isEmpty := announcement editorMorph selectionIsEmpty.
	
	(menu add: 'Copy' target: announcement editorMorph selector: #copyToClipboard) enabled: isEmpty not.
	(menu add: 'Cut' target: announcement editorMorph selector: #cutToClipboard) enabled: isEmpty not.
	(menu add: 'Paste' target: announcement editorMorph selector: #pasteClipboard) enabled: Clipboard clipboardText isEmpty not.

	menu addLine.
	menu add: 'Do it' target: self selector: #invokeDoitIn: argument: announcement editorMorph.
	menu add: 'Print it' target: self selector: #invokePrintItIn: argument: announcement editorMorph.
	menu add: 'Inspect it' target: self selector: #invokeInspectItIn: argument: announcement editorMorph.
	
	menu popUpEvent: announcement event in: announcement editorMorph world.
	announcement editorMorph takeKeyboardFocus.! !

!TxWorkspace methodsFor: 'actions' stamp: 'MarcusDenker 2/20/2015 11:39'!
invokePrintItIn: editorMorph 
	| myeditor result |
	myeditor := editorMorph controller.

	myeditor selection isEmpty ifTrue: [  
		myeditor moveToLineStart; extendSelectionToLineEnd. 
	].

	myeditor selection isEmpty ifFalse: [ 
		result := ' ' , (Smalltalk compiler evaluate: myeditor selection asString) printString.
		myeditor collapseSelection.
		editorMorph insert: result
		
	 ].! !

!TxWorkspace methodsFor: 'actions' stamp: 'MarcusDenker 2/20/2015 11:40'!
invokeInspectItIn: editorMorph 
	| myeditor |
	myeditor := editorMorph controller.

	myeditor selection isEmpty ifTrue: [  
		myeditor moveToLineStart; extendSelectionToLineEnd. 
	].

	myeditor selection isEmpty ifFalse: [ 
		(Smalltalk compiler evaluate: myeditor selection asString) inspect.	
	 ].! !

!TxWorkspace methodsFor: 'opening' stamp: 'IgorStasenko 11/11/2014 17:08'!
openText: aText withLabel: aLabel
	| view wrapper |
	
	text := aText asTxModel.
	view := TxViewContainer new.

	view addDecorator: (TxScrollbarDecorator new placeRight color: Color blue;yourself).
	view addDecorator: (TxScrollbarDecorator new placeBottom color: Color green;yourself).
	view editText: text.
	view wrapText: true.
	view hResizing: #spaceFill ; vResizing: #spaceFill .
	view layoutFrame: LayoutFrame identity.
	
	view view onAnnouncement: TxContextMenuAnnouncement send: #buildContextMenu: to: self.
	editor := view view.
	
	self wireEvents.
	
	wrapper := AthensWrapMorph new.
	wrapper layoutPolicy: ProportionalLayout new.
	wrapper addMorph: view.
	
	^ (wrapper openInWindowLabeled: aLabel) extent: self defaultExtent.! !

!TxWorkspace methodsFor: 'opening' stamp: 'IgorStasenko 11/11/2014 14:36'!
openLabel: aLabel
	^ self openText: '' withLabel: aLabel
	! !

!TxWorkspace methodsFor: 'events' stamp: 'IgorStasenko 11/11/2014 17:17'!
onTextDeleted: ann 
	"self scheduleSyntaxHighlightingUpdate."
	
	self updateSyntaxHighlighting.! !

!TxWorkspace class methodsFor: 'instance creation' stamp: 'TorstenBergmann 3/14/2015 18:17'!
open
	<script>
	^ self openLabel: 'Tx-Workspace'! !

!TxWorkspace class methodsFor: 'instance creation' stamp: 'IgorStasenko 11/11/2014 14:22'!
openLabel: aLabel
	^ self new openLabel: aLabel ; yourself! !

!TxWrappingMorph commentStamp: 'IgorStasenko 9/24/2014 15:36'!
Any morphs embedded in the text should use me as a wrapper.

This class is private (you are not supposed to create 
its instances by yourself).

This morph wraps a user morph, embedded in a text,
and provides some helpers in morph's positioning etc.

An example for using embedded object can be found in
#exampleWithEmbeddedObject


To insert embedded object use #insertObject: protocol 
by text position, for example:
text endPosition insertObject: 123.!
!TxWrappingMorph methodsFor: 'accessing' stamp: 'IgorStasenko 9/19/2014 18:07'!
wrapAround: aMorph
	aMorph delete.
	aMorph position: 0@0.
	self addMorph: aMorph.
	
	self extent: aMorph extent.! !

!TxWrappingMorph methodsFor: 'initialization' stamp: 'IgorStasenko 9/24/2014 15:29'!
initialize
	super initialize.
	! !

!TxWrappingMorph methodsFor: 'events-processing' stamp: 'IgorStasenko 9/19/2014 14:56'!
containsPoint: aPoint event: anEvent
	Transcript show: 'contans ..';cr.
	^ super containsPoint: aPoint event: anEvent
	! !

!TxWrappingMorph methodsFor: 'drawing' stamp: 'IgorStasenko 9/22/2014 16:21'!
drawOnAthensCanvas: aCanvas
	"nothing"
	
"	aCanvas setPaint: (Color red alpha: 0.4).
	aCanvas pathTransform restoreAfter: [ 

		aCanvas drawShape: (bounds expandBy: 3) .
	].

"! !

!TxWrappingMorph methodsFor: 'accessing' stamp: 'IgorStasenko 9/24/2014 15:29'!
currentPosition: aPoint
	self position: aPoint x @ (aPoint y - self height).
! !

!TxWrappingMorph methodsFor: 'drawing' stamp: 'IgorStasenko 9/24/2014 17:47'!
fullDrawOnAthensCanvas: aCanvas
	"nothing"
	
	aCanvas pathTransform restoreAfter: [ 
		aCanvas pathTransform translateBy: owner innerBounds origin.
		super fullDrawOnAthensCanvas: aCanvas.
	].

! !

!TxWrappingMorph methodsFor: 'events-processing' stamp: 'IgorStasenko 9/19/2014 18:16'!
processEvent: anEvent using: defaultDispatcher
"	| evt |
	evt := anEvent transformedBy: owner transform.

	Transcript show: 'event pos: '; show: anEvent position;cr."
"	Transcript show: bounds;cr."
	
	"evt := anEvent transformedBy: self transform."
	
	"^ #rejected."
	^ super processEvent: anEvent using: defaultDispatcher! !

!TxWrappingMorph methodsFor: 'accessing' stamp: 'IgorStasenko 9/19/2014 15:07'!
isLocked
	^ false! !

!TxWrappingMorph methodsFor: 'accessing' stamp: 'IgorStasenko 9/19/2014 16:54'!
layoutView
	^ owner layoutView! !

!TxWrappingMorph methodsFor: 'events-processing' stamp: 'IgorStasenko 9/22/2014 16:22'!
handleMouseOver: anEvent

"	Transcript show: 'mouse over'; show: anEvent;cr."
	
	super handleMouseOver: anEvent.! !

!TxWrappingMorph class methodsFor: 'instance creation' stamp: 'IgorStasenko 9/18/2014 18:13'!
for: aMorph
	^ self new wrapAround: aMorph! !

!UCSTable commentStamp: 'yo 10/19/2004 19:54'!
This class represents the Unicode conversion table from/to the domestic encodings and Unicode.
!
!UCSTable class methodsFor: 'accessing - table' stamp: 'yo 10/14/2003 10:36'!
gb2312Table

	^ GB2312Table.
! !

!UCSTable class methodsFor: 'accessing - table' stamp: 'yo 10/14/2003 10:41'!
initialize
"
	self initialize
"

	self initializeGB2312Table.
	self initializeJISX0208Table.
	self initializeKSX1001Table.
	self initializeLatin1Table.
! !

!UCSTable class methodsFor: 'accessing - table' stamp: 'yo 10/14/2003 10:41'!
initializeLatin1Table
	"UCSTable initializeLatin1Table"

	Latin1Table := (0 to: 255) asArray.
! !

!UCSTable class methodsFor: '*Unicode-Initialization' stamp: 'MarcusDenker 9/12/2013 16:40'!
initializeKSX1001Table
	"UCSTable initializeKSX1001Table"

	| table size ksX1001 unicode ksX10012 |
	table := #(16r2121 16r3000 16r2122 16r3001 16r2123 16r3002 16r2124 16r00B7 16r2125 16r2025 16r2126 16r2026 16r2127 16r00A8 16r2128 16r3003 16r2129 16r00AD 16r212A 16r2015 16r212B 16r2225 16r212C 16rFF3C 16r212D 16r223C 16r212E 16r2018 16r212F 16r2019 16r2130 16r201C 16r2131 16r201D 16r2132 16r3014 16r2133 16r3015 16r2134 16r3008 16r2135 16r3009 16r2136 16r300A 16r2137 16r300B 16r2138 16r300C 16r2139 16r300D 16r213A 16r300E 16r213B 16r300F 16r213C 16r3010 16r213D 16r3011 16r213E 16r00B1 16r213F 16r00D7 16r2140 16r00F7 16r2141 16r2260 16r2142 16r2264 16r2143 16r2265 16r2144 16r221E 16r2145 16r2234 16r2146 16r00B0 16r2147 16r2032 16r2148 16r2033 16r2149 16r2103 16r214A 16r212B 16r214B 16rFFE0 16r214C 16rFFE1 16r214D 16rFFE5 16r214E 16r2642 16r214F 16r2640 16r2150 16r2220 16r2151 16r22A5 16r2152 16r2312 16r2153 16r2202 16r2154 16r2207 16r2155 16r2261 16r2156 16r2252 16r2157 16r00A7 16r2158 16r203B 16r2159 16r2606 16r215A 16r2605 16r215B 16r25CB 16r215C 16r25CF 16r215D 16r25CE 16r215E 16r25C7 16r215F 16r25C6 16r2160 16r25A1 16r2161 16r25A0 16r2162 16r25B3 16r2163 16r25B2 16r2164 16r25BD 16r2165 16r25BC 16r2166 16r2192 16r2167 16r2190 16r2168 16r2191 16r2169 16r2193 16r216A 16r2194 16r216B 16r3013 16r216C 16r226A 16r216D 16r226B 16r216E 16r221A 16r216F 16r223D 16r2170 16r221D 16r2171 16r2235 16r2172 16r222B 16r2173 16r222C 16r2174 16r2208 16r2175 16r220B 16r2176 16r2286 16r2177 16r2287 16r2178 16r2282 16r2179 16r2283 16r217A 16r222A 16r217B 16r2229 16r217C 16r2227 16r217D 16r2228 16r217E 16rFFE2 16r2221 16r21D2 16r2222 16r21D4 16r2223 16r2200 16r2224 16r2203 16r2225 16r00B4 16r2226 16rFF5E 16r2227 16r02C7 16r2228 16r02D8 16r2229 16r02DD 16r222A 16r02DA 16r222B 16r02D9 16r222C 16r00B8 16r222D 16r02DB 16r222E 16r00A1 16r222F 16r00BF 16r2230 16r02D0 16r2231 16r222E 16r2232 16r2211 16r2233 16r220F 16r2234 16r00A4 16r2235 16r2109 16r2236 16r2030 16r2237 16r25C1 16r2238 16r25C0 16r2239 16r25B7 16r223A 16r25B6 16r223B 16r2664 16r223C 16r2660 16r223D 16r2661 16r223E 16r2665 16r223F 16r2667 16r2240 16r2663 16r2241 16r2299 16r2242 16r25C8 16r2243 16r25A3 16r2244 16r25D0 16r2245 16r25D1 16r2246 16r2592 16r2247 16r25A4 16r2248 16r25A5 16r2249 16r25A8 16r224A 16r25A7 16r224B 16r25A6 16r224C 16r25A9 16r224D 16r2668 16r224E 16r260F 16r224F 16r260E 16r2250 16r261C 16r2251 16r261E 16r2252 16r00B6 16r2253 16r2020 16r2254 16r2021 16r2255 16r2195 16r2256 16r2197 16r2257 16r2199 16r2258 16r2196 16r2259 16r2198 16r225A 16r266D 16r225B 16r2669 16r225C 16r266A 16r225D 16r266C 16r225E 16r327F 16r225F 16r321C 16r2260 16r2116 16r2261 16r33C7 16r2262 16r2122 16r2263 16r33C2 16r2264 16r33D8 16r2265 16r2121 16r2321 16rFF01 16r2322 16rFF02 16r2323 16rFF03 16r2324 16rFF04 16r2325 16rFF05 16r2326 16rFF06 16r2327 16rFF07 16r2328 16rFF08 16r2329 16rFF09 16r232A 16rFF0A 16r232B 16rFF0B 16r232C 16rFF0C 16r232D 16rFF0D 16r232E 16rFF0E 16r232F 16rFF0F 16r2330 16rFF10 16r2331 16rFF11 16r2332 16rFF12 16r2333 16rFF13 16r2334 16rFF14 16r2335 16rFF15 16r2336 16rFF16 16r2337 16rFF17 16r2338 16rFF18 16r2339 16rFF19 16r233A 16rFF1A 16r233B 16rFF1B 16r233C 16rFF1C 16r233D 16rFF1D 16r233E 16rFF1E 16r233F 16rFF1F 16r2340 16rFF20 16r2341 16rFF21 16r2342 16rFF22 16r2343 16rFF23 16r2344 16rFF24 16r2345 16rFF25 16r2346 16rFF26 16r2347 16rFF27 16r2348 16rFF28 16r2349 16rFF29 16r234A 16rFF2A 16r234B 16rFF2B 16r234C 16rFF2C 16r234D 16rFF2D 16r234E 16rFF2E 16r234F 16rFF2F 16r2350 16rFF30 16r2351 16rFF31 16r2352 16rFF32 16r2353 16rFF33 16r2354 16rFF34 16r2355 16rFF35 16r2356 16rFF36 16r2357 16rFF37 16r2358 16rFF38 16r2359 16rFF39 16r235A 16rFF3A 16r235B 16rFF3B 16r235C 16rFFE6 16r235D 16rFF3D 16r235E 16rFF3E 16r235F 16rFF3F 16r2360 16rFF40 16r2361 16rFF41 16r2362 16rFF42 16r2363 16rFF43 16r2364 16rFF44 16r2365 16rFF45 16r2366 16rFF46 16r2367 16rFF47 16r2368 16rFF48 16r2369 16rFF49 16r236A 16rFF4A 16r236B 16rFF4B 16r236C 16rFF4C 16r236D 16rFF4D 16r236E 16rFF4E 16r236F 16rFF4F 16r2370 16rFF50 16r2371 16rFF51 16r2372 16rFF52 16r2373 16rFF53 16r2374 16rFF54 16r2375 16rFF55 16r2376 16rFF56 16r2377 16rFF57 16r2378 16rFF58 16r2379 16rFF59 16r237A 16rFF5A 16r237B 16rFF5B 16r237C 16rFF5C 16r237D 16rFF5D 16r237E 16rFFE3 16r2421 16r3131 16r2422 16r3132 16r2423 16r3133 16r2424 16r3134 16r2425 16r3135 16r2426 16r3136 16r2427 16r3137 16r2428 16r3138 16r2429 16r3139 16r242A 16r313A 16r242B 16r313B 16r242C 16r313C 16r242D 16r313D 16r242E 16r313E 16r242F 16r313F 16r2430 16r3140 16r2431 16r3141 16r2432 16r3142 16r2433 16r3143 16r2434 16r3144 16r2435 16r3145 16r2436 16r3146 16r2437 16r3147 16r2438 16r3148 16r2439 16r3149 16r243A 16r314A 16r243B 16r314B 16r243C 16r314C 16r243D 16r314D 16r243E 16r314E 16r243F 16r314F 16r2440 16r3150 16r2441 16r3151 16r2442 16r3152 16r2443 16r3153 16r2444 16r3154 16r2445 16r3155 16r2446 16r3156 16r2447 16r3157 16r2448 16r3158 16r2449 16r3159 16r244A 16r315A 16r244B 16r315B 16r244C 16r315C 16r244D 16r315D 16r244E 16r315E 16r244F 16r315F 16r2450 16r3160 16r2451 16r3161 16r2452 16r3162 16r2453 16r3163 16r2454 16r3164 16r2455 16r3165 16r2456 16r3166 16r2457 16r3167 16r2458 16r3168 16r2459 16r3169 16r245A 16r316A 16r245B 16r316B 16r245C 16r316C 16r245D 16r316D 16r245E 16r316E 16r245F 16r316F 16r2460 16r3170 16r2461 16r3171 16r2462 16r3172 16r2463 16r3173 16r2464 16r3174 16r2465 16r3175 16r2466 16r3176 16r2467 16r3177 16r2468 16r3178 16r2469 16r3179 16r246A 16r317A 16r246B 16r317B 16r246C 16r317C 16r246D 16r317D 16r246E 16r317E 16r246F 16r317F 16r2470 16r3180 16r2471 16r3181 16r2472 16r3182 16r2473 16r3183 16r2474 16r3184 16r2475 16r3185 16r2476 16r3186 16r2477 16r3187 16r2478 16r3188 16r2479 16r3189 16r247A 16r318A 16r247B 16r318B 16r247C 16r318C 16r247D 16r318D 16r247E 16r318E 16r2521 16r2170 16r2522 16r2171 16r2523 16r2172 16r2524 16r2173 16r2525 16r2174 16r2526 16r2175 16r2527 16r2176 16r2528 16r2177 16r2529 16r2178 16r252A 16r2179 16r2530 16r2160 16r2531 16r2161 16r2532 16r2162 16r2533 16r2163 16r2534 16r2164 16r2535 16r2165 16r2536 16r2166 16r2537 16r2167 16r2538 16r2168 16r2539 16r2169 16r2541 16r0391 16r2542 16r0392 16r2543 16r0393 16r2544 16r0394 16r2545 16r0395 16r2546 16r0396 16r2547 16r0397 16r2548 16r0398 16r2549 16r0399 16r254A 16r039A 16r254B 16r039B 16r254C 16r039C 16r254D 16r039D 16r254E 16r039E 16r254F 16r039F 16r2550 16r03A0 16r2551 16r03A1 16r2552 16r03A3 16r2553 16r03A4 16r2554 16r03A5 16r2555 16r03A6 16r2556 16r03A7 16r2557 16r03A8 16r2558 16r03A9 16r2561 16r03B1 16r2562 16r03B2 16r2563 16r03B3 16r2564 16r03B4 16r2565 16r03B5 16r2566 16r03B6 16r2567 16r03B7 16r2568 16r03B8 16r2569 16r03B9 16r256A 16r03BA 16r256B 16r03BB 16r256C 16r03BC 16r256D 16r03BD 16r256E 16r03BE 16r256F 16r03BF 16r2570 16r03C0 16r2571 16r03C1 16r2572 16r03C3 16r2573 16r03C4 16r2574 16r03C5 16r2575 16r03C6 16r2576 16r03C7 16r2577 16r03C8 16r2578 16r03C9 16r2621 16r2500 16r2622 16r2502 16r2623 16r250C 16r2624 16r2510 16r2625 16r2518 16r2626 16r2514 16r2627 16r251C 16r2628 16r252C 16r2629 16r2524 16r262A 16r2534 16r262B 16r253C 16r262C 16r2501 16r262D 16r2503 16r262E 16r250F 16r262F 16r2513 16r2630 16r251B 16r2631 16r2517 16r2632 16r2523 16r2633 16r2533 16r2634 16r252B 16r2635 16r253B 16r2636 16r254B 16r2637 16r2520 16r2638 16r252F 16r2639 16r2528 16r263A 16r2537 16r263B 16r253F 16r263C 16r251D 16r263D 16r2530 16r263E 16r2525 16r263F 16r2538 16r2640 16r2542 16r2641 16r2512 16r2642 16r2511 16r2643 16r251A 16r2644 16r2519 16r2645 16r2516 16r2646 16r2515 16r2647 16r250E 16r2648 16r250D 16r2649 16r251E 16r264A 16r251F 16r264B 16r2521 16r264C 16r2522 16r264D 16r2526 16r264E 16r2527 16r264F 16r2529 16r2650 16r252A 16r2651 16r252D 16r2652 16r252E 16r2653 16r2531 16r2654 16r2532 16r2655 16r2535 16r2656 16r2536 16r2657 16r2539 16r2658 16r253A 16r2659 16r253D 16r265A 16r253E 16r265B 16r2540 16r265C 16r2541 16r265D 16r2543 16r265E 16r2544 16r265F 16r2545 16r2660 16r2546 16r2661 16r2547 16r2662 16r2548 16r2663 16r2549 16r2664 16r254A 16r2721 16r3395 16r2722 16r3396 16r2723 16r3397 16r2724 16r2113 16r2725 16r3398 16r2726 16r33C4 16r2727 16r33A3 16r2728 16r33A4 16r2729 16r33A5 16r272A 16r33A6 16r272B 16r3399 16r272C 16r339A 16r272D 16r339B 16r272E 16r339C 16r272F 16r339D 16r2730 16r339E 16r2731 16r339F 16r2732 16r33A0 16r2733 16r33A1 16r2734 16r33A2 16r2735 16r33CA 16r2736 16r338D 16r2737 16r338E 16r2738 16r338F 16r2739 16r33CF 16r273A 16r3388 16r273B 16r3389 16r273C 16r33C8 16r273D 16r33A7 16r273E 16r33A8 16r273F 16r33B0 16r2740 16r33B1 16r2741 16r33B2 16r2742 16r33B3 16r2743 16r33B4 16r2744 16r33B5 16r2745 16r33B6 16r2746 16r33B7 16r2747 16r33B8 16r2748 16r33B9 16r2749 16r3380 16r274A 16r3381 16r274B 16r3382 16r274C 16r3383 16r274D 16r3384 16r274E 16r33BA 16r274F 16r33BB 16r2750 16r33BC 16r2751 16r33BD 16r2752 16r33BE 16r2753 16r33BF 16r2754 16r3390 16r2755 16r3391 16r2756 16r3392 16r2757 16r3393 16r2758 16r3394 16r2759 16r2126 16r275A 16r33C0 16r275B 16r33C1 16r275C 16r338A 16r275D 16r338B 16r275E 16r338C 16r275F 16r33D6 16r2760 16r33C5 16r2761 16r33AD 16r2762 16r33AE 16r2763 16r33AF 16r2764 16r33DB 16r2765 16r33A9 16r2766 16r33AA 16r2767 16r33AB 16r2768 16r33AC 16r2769 16r33DD 16r276A 16r33D0 16r276B 16r33D3 16r276C 16r33C3 16r276D 16r33C9 16r276E 16r33DC 16r276F 16r33C6 16r2821 16r00C6 16r2822 16r00D0 16r2823 16r00AA 16r2824 16r0126 16r2826 16r0132 16r2828 16r013F 16r2829 16r0141 16r282A 16r00D8 16r282B 16r0152 16r282C 16r00BA 16r282D 16r00DE 16r282E 16r0166 16r282F 16r014A 16r2831 16r3260 16r2832 16r3261 16r2833 16r3262 16r2834 16r3263 16r2835 16r3264 16r2836 16r3265 16r2837 16r3266 16r2838 16r3267 16r2839 16r3268 16r283A 16r3269 16r283B 16r326A 16r283C 16r326B 16r283D 16r326C 16r283E 16r326D 16r283F 16r326E 16r2840 16r326F 16r2841 16r3270 16r2842 16r3271 16r2843 16r3272 16r2844 16r3273 16r2845 16r3274 16r2846 16r3275 16r2847 16r3276 16r2848 16r3277 16r2849 16r3278 16r284A 16r3279 16r284B 16r327A 16r284C 16r327B 16r284D 16r24D0 16r284E 16r24D1 16r284F 16r24D2 16r2850 16r24D3 16r2851 16r24D4 16r2852 16r24D5 16r2853 16r24D6 16r2854 16r24D7 16r2855 16r24D8 16r2856 16r24D9 16r2857 16r24DA 16r2858 16r24DB 16r2859 16r24DC 16r285A 16r24DD 16r285B 16r24DE 16r285C 16r24DF 16r285D 16r24E0 16r285E 16r24E1 16r285F 16r24E2 16r2860 16r24E3 16r2861 16r24E4 16r2862 16r24E5 16r2863 16r24E6 16r2864 16r24E7 16r2865 16r24E8 16r2866 16r24E9 16r2867 16r2460 16r2868 16r2461 16r2869 16r2462 16r286A 16r2463 16r286B 16r2464 16r286C 16r2465 16r286D 16r2466 16r286E 16r2467 16r286F 16r2468 16r2870 16r2469 16r2871 16r246A 16r2872 16r246B 16r2873 16r246C 16r2874 16r246D 16r2875 16r246E 16r2876 16r00BD 16r2877 16r2153 16r2878 16r2154 16r2879 16r00BC 16r287A 16r00BE 16r287B 16r215B 16r287C 16r215C 16r287D 16r215D 16r287E 16r215E 16r2921 16r00E6 16r2922 16r0111 16r2923 16r00F0 16r2924 16r0127 16r2925 16r0131 16r2926 16r0133 16r2927 16r0138 16r2928 16r0140 16r2929 16r0142 16r292A 16r00F8 16r292B 16r0153 16r292C 16r00DF 16r292D 16r00FE 16r292E 16r0167 16r292F 16r014B 16r2930 16r0149 16r2931 16r3200 16r2932 16r3201 16r2933 16r3202 16r2934 16r3203 16r2935 16r3204 16r2936 16r3205 16r2937 16r3206 16r2938 16r3207 16r2939 16r3208 16r293A 16r3209 16r293B 16r320A 16r293C 16r320B 16r293D 16r320C 16r293E 16r320D 16r293F 16r320E 16r2940 16r320F 16r2941 16r3210 16r2942 16r3211 16r2943 16r3212 16r2944 16r3213 16r2945 16r3214 16r2946 16r3215 16r2947 16r3216 16r2948 16r3217 16r2949 16r3218 16r294A 16r3219 16r294B 16r321A 16r294C 16r321B 16r294D 16r249C 16r294E 16r249D 16r294F 16r249E 16r2950 16r249F 16r2951 16r24A0 16r2952 16r24A1 16r2953 16r24A2 16r2954 16r24A3 16r2955 16r24A4 16r2956 16r24A5 16r2957 16r24A6 16r2958 16r24A7 16r2959 16r24A8 16r295A 16r24A9 16r295B 16r24AA 16r295C 16r24AB 16r295D 16r24AC 16r295E 16r24AD 16r295F 16r24AE 16r2960 16r24AF 16r2961 16r24B0 16r2962 16r24B1 16r2963 16r24B2 16r2964 16r24B3 16r2965 16r24B4 16r2966 16r24B5 16r2967 16r2474 16r2968 16r2475 16r2969 16r2476 16r296A 16r2477 16r296B 16r2478 16r296C 16r2479 16r296D 16r247A 16r296E 16r247B 16r296F 16r247C 16r2970 16r247D 16r2971 16r247E 16r2972 16r247F 16r2973 16r2480 16r2974 16r2481 16r2975 16r2482 16r2976 16r00B9 16r2977 16r00B2 16r2978 16r00B3 16r2979 16r2074 16r297A 16r207F 16r297B 16r2081 16r297C 16r2082 16r297D 16r2083 16r297E 16r2084 16r2A21 16r3041 16r2A22 16r3042 16r2A23 16r3043 16r2A24 16r3044 16r2A25 16r3045 16r2A26 16r3046 16r2A27 16r3047 16r2A28 16r3048 16r2A29 16r3049 16r2A2A 16r304A 16r2A2B 16r304B 16r2A2C 16r304C 16r2A2D 16r304D 16r2A2E 16r304E 16r2A2F 16r304F 16r2A30 16r3050 16r2A31 16r3051 16r2A32 16r3052 16r2A33 16r3053 16r2A34 16r3054 16r2A35 16r3055 16r2A36 16r3056 16r2A37 16r3057 16r2A38 16r3058 16r2A39 16r3059 16r2A3A 16r305A 16r2A3B 16r305B 16r2A3C 16r305C 16r2A3D 16r305D 16r2A3E 16r305E 16r2A3F 16r305F 16r2A40 16r3060 16r2A41 16r3061 16r2A42 16r3062 16r2A43 16r3063 16r2A44 16r3064 16r2A45 16r3065 16r2A46 16r3066 16r2A47 16r3067 16r2A48 16r3068 16r2A49 16r3069 16r2A4A 16r306A 16r2A4B 16r306B 16r2A4C 16r306C 16r2A4D 16r306D 16r2A4E 16r306E 16r2A4F 16r306F 16r2A50 16r3070 16r2A51 16r3071 16r2A52 16r3072 16r2A53 16r3073 16r2A54 16r3074 16r2A55 16r3075 16r2A56 16r3076 16r2A57 16r3077 16r2A58 16r3078 16r2A59 16r3079 16r2A5A 16r307A 16r2A5B 16r307B 16r2A5C 16r307C 16r2A5D 16r307D 16r2A5E 16r307E 16r2A5F 16r307F 16r2A60 16r3080 16r2A61 16r3081 16r2A62 16r3082 16r2A63 16r3083 16r2A64 16r3084 16r2A65 16r3085 16r2A66 16r3086 16r2A67 16r3087 16r2A68 16r3088 16r2A69 16r3089 16r2A6A 16r308A 16r2A6B 16r308B 16r2A6C 16r308C 16r2A6D 16r308D 16r2A6E 16r308E 16r2A6F 16r308F 16r2A70 16r3090 16r2A71 16r3091 16r2A72 16r3092 16r2A73 16r3093 16r2B21 16r30A1 16r2B22 16r30A2 16r2B23 16r30A3 16r2B24 16r30A4 16r2B25 16r30A5 16r2B26 16r30A6 16r2B27 16r30A7 16r2B28 16r30A8 16r2B29 16r30A9 16r2B2A 16r30AA 16r2B2B 16r30AB 16r2B2C 16r30AC 16r2B2D 16r30AD 16r2B2E 16r30AE 16r2B2F 16r30AF 16r2B30 16r30B0 16r2B31 16r30B1 16r2B32 16r30B2 16r2B33 16r30B3 16r2B34 16r30B4 16r2B35 16r30B5 16r2B36 16r30B6 16r2B37 16r30B7 16r2B38 16r30B8 16r2B39 16r30B9 16r2B3A 16r30BA 16r2B3B 16r30BB 16r2B3C 16r30BC 16r2B3D 16r30BD 16r2B3E 16r30BE 16r2B3F 16r30BF 16r2B40 16r30C0 16r2B41 16r30C1 16r2B42 16r30C2 16r2B43 16r30C3 16r2B44 16r30C4 16r2B45 16r30C5 16r2B46 16r30C6 16r2B47 16r30C7 16r2B48 16r30C8 16r2B49 16r30C9 16r2B4A 16r30CA 16r2B4B 16r30CB 16r2B4C 16r30CC 16r2B4D 16r30CD 16r2B4E 16r30CE 16r2B4F 16r30CF 16r2B50 16r30D0 16r2B51 16r30D1 16r2B52 16r30D2 16r2B53 16r30D3 16r2B54 16r30D4 16r2B55 16r30D5 16r2B56 16r30D6 16r2B57 16r30D7 16r2B58 16r30D8 16r2B59 16r30D9 16r2B5A 16r30DA 16r2B5B 16r30DB 16r2B5C 16r30DC 16r2B5D 16r30DD 16r2B5E 16r30DE 16r2B5F 16r30DF 16r2B60 16r30E0 16r2B61 16r30E1 16r2B62 16r30E2 16r2B63 16r30E3 16r2B64 16r30E4 16r2B65 16r30E5 16r2B66 16r30E6 16r2B67 16r30E7 16r2B68 16r30E8 16r2B69 16r30E9 16r2B6A 16r30EA 16r2B6B 16r30EB 16r2B6C 16r30EC 16r2B6D 16r30ED 16r2B6E 16r30EE 16r2B6F 16r30EF 16r2B70 16r30F0 16r2B71 16r30F1 16r2B72 16r30F2 16r2B73 16r30F3 16r2B74 16r30F4 16r2B75 16r30F5 16r2B76 16r30F6 16r2C21 16r0410 16r2C22 16r0411 16r2C23 16r0412 16r2C24 16r0413 16r2C25 16r0414 16r2C26 16r0415 16r2C27 16r0401 16r2C28 16r0416 16r2C29 16r0417 16r2C2A 16r0418 16r2C2B 16r0419 16r2C2C 16r041A 16r2C2D 16r041B 16r2C2E 16r041C 16r2C2F 16r041D 16r2C30 16r041E 16r2C31 16r041F 16r2C32 16r0420 16r2C33 16r0421 16r2C34 16r0422 16r2C35 16r0423 16r2C36 16r0424 16r2C37 16r0425 16r2C38 16r0426 16r2C39 16r0427 16r2C3A 16r0428 16r2C3B 16r0429 16r2C3C 16r042A 16r2C3D 16r042B 16r2C3E 16r042C 16r2C3F 16r042D 16r2C40 16r042E 16r2C41 16r042F 16r2C51 16r0430 16r2C52 16r0431 16r2C53 16r0432 16r2C54 16r0433 16r2C55 16r0434 16r2C56 16r0435 16r2C57 16r0451 16r2C58 16r0436 16r2C59 16r0437 16r2C5A 16r0438 16r2C5B 16r0439 16r2C5C 16r043A 16r2C5D 16r043B 16r2C5E 16r043C 16r2C5F 16r043D 16r2C60 16r043E 16r2C61 16r043F 16r2C62 16r0440 16r2C63 16r0441 16r2C64 16r0442 16r2C65 16r0443 16r2C66 16r0444 16r2C67 16r0445 16r2C68 16r0446 16r2C69 16r0447 16r2C6A 16r0448 16r2C6B 16r0449 16r2C6C 16r044A 16r2C6D 16r044B 16r2C6E 16r044C 16r2C6F 16r044D 16r2C70 16r044E 16r2C71 16r044F 16r3021 16rAC00 16r3022 16rAC01 16r3023 16rAC04 16r3024 16rAC07 16r3025 16rAC08 16r3026 16rAC09 16r3027 16rAC0A 16r3028 16rAC10 16r3029 16rAC11 16r302A 16rAC12 16r302B 16rAC13 16r302C 16rAC14 16r302D 16rAC15 16r302E 16rAC16 16r302F 16rAC17 16r3030 16rAC19 16r3031 16rAC1A 16r3032 16rAC1B 16r3033 16rAC1C 16r3034 16rAC1D 16r3035 16rAC20 16r3036 16rAC24 16r3037 16rAC2C 16r3038 16rAC2D 16r3039 16rAC2F 16r303A 16rAC30 16r303B 16rAC31 16r303C 16rAC38 16r303D 16rAC39 16r303E 16rAC3C 16r303F 16rAC40 16r3040 16rAC4B 16r3041 16rAC4D 16r3042 16rAC54 16r3043 16rAC58 16r3044 16rAC5C 16r3045 16rAC70 16r3046 16rAC71 16r3047 16rAC74 16r3048 16rAC77 16r3049 16rAC78 16r304A 16rAC7A 16r304B 16rAC80 16r304C 16rAC81 16r304D 16rAC83 16r304E 16rAC84 16r304F 16rAC85 16r3050 16rAC86 16r3051 16rAC89 16r3052 16rAC8A 16r3053 16rAC8B 16r3054 16rAC8C 16r3055 16rAC90 16r3056 16rAC94 16r3057 16rAC9C 16r3058 16rAC9D 16r3059 16rAC9F 16r305A 16rACA0 16r305B 16rACA1 16r305C 16rACA8 16r305D 16rACA9 16r305E 16rACAA 16r305F 16rACAC 16r3060 16rACAF 16r3061 16rACB0 16r3062 16rACB8 16r3063 16rACB9 16r3064 16rACBB 16r3065 16rACBC 16r3066 16rACBD 16r3067 16rACC1 16r3068 16rACC4 16r3069 16rACC8 16r306A 16rACCC 16r306B 16rACD5 16r306C 16rACD7 16r306D 16rACE0 16r306E 16rACE1 16r306F 16rACE4 16r3070 16rACE7 16r3071 16rACE8 16r3072 16rACEA 16r3073 16rACEC 16r3074 16rACEF 16r3075 16rACF0 16r3076 16rACF1 16r3077 16rACF3 16r3078 16rACF5 16r3079 16rACF6 16r307A 16rACFC 16r307B 16rACFD 16r307C 16rAD00 16r307D 16rAD04 16r307E 16rAD06 16r3121 16rAD0C 16r3122 16rAD0D 16r3123 16rAD0F 16r3124 16rAD11 16r3125 16rAD18 16r3126 16rAD1C 16r3127 16rAD20 16r3128 16rAD29 16r3129 16rAD2C 16r312A 16rAD2D 16r312B 16rAD34 16r312C 16rAD35 16r312D 16rAD38 16r312E 16rAD3C 16r312F 16rAD44 16r3130 16rAD45 16r3131 16rAD47 16r3132 16rAD49 16r3133 16rAD50 16r3134 16rAD54 16r3135 16rAD58 16r3136 16rAD61 16r3137 16rAD63 16r3138 16rAD6C 16r3139 16rAD6D 16r313A 16rAD70 16r313B 16rAD73 16r313C 16rAD74 16r313D 16rAD75 16r313E 16rAD76 16r313F 16rAD7B 16r3140 16rAD7C 16r3141 16rAD7D 16r3142 16rAD7F 16r3143 16rAD81 16r3144 16rAD82 16r3145 16rAD88 16r3146 16rAD89 16r3147 16rAD8C 16r3148 16rAD90 16r3149 16rAD9C 16r314A 16rAD9D 16r314B 16rADA4 16r314C 16rADB7 16r314D 16rADC0 16r314E 16rADC1 16r314F 16rADC4 16r3150 16rADC8 16r3151 16rADD0 16r3152 16rADD1 16r3153 16rADD3 16r3154 16rADDC 16r3155 16rADE0 16r3156 16rADE4 16r3157 16rADF8 16r3158 16rADF9 16r3159 16rADFC 16r315A 16rADFF 16r315B 16rAE00 16r315C 16rAE01 16r315D 16rAE08 16r315E 16rAE09 16r315F 16rAE0B 16r3160 16rAE0D 16r3161 16rAE14 16r3162 16rAE30 16r3163 16rAE31 16r3164 16rAE34 16r3165 16rAE37 16r3166 16rAE38 16r3167 16rAE3A 16r3168 16rAE40 16r3169 16rAE41 16r316A 16rAE43 16r316B 16rAE45 16r316C 16rAE46 16r316D 16rAE4A 16r316E 16rAE4C 16r316F 16rAE4D 16r3170 16rAE4E 16r3171 16rAE50 16r3172 16rAE54 16r3173 16rAE56 16r3174 16rAE5C 16r3175 16rAE5D 16r3176 16rAE5F 16r3177 16rAE60 16r3178 16rAE61 16r3179 16rAE65 16r317A 16rAE68 16r317B 16rAE69 16r317C 16rAE6C 16r317D 16rAE70 16r317E 16rAE78 16r3221 16rAE79 16r3222 16rAE7B 16r3223 16rAE7C 16r3224 16rAE7D 16r3225 16rAE84 16r3226 16rAE85 16r3227 16rAE8C 16r3228 16rAEBC 16r3229 16rAEBD 16r322A 16rAEBE 16r322B 16rAEC0 16r322C 16rAEC4 16r322D 16rAECC 16r322E 16rAECD 16r322F 16rAECF 16r3230 16rAED0 16r3231 16rAED1 16r3232 16rAED8 16r3233 16rAED9 16r3234 16rAEDC 16r3235 16rAEE8 16r3236 16rAEEB 16r3237 16rAEED 16r3238 16rAEF4 16r3239 16rAEF8 16r323A 16rAEFC 16r323B 16rAF07 16r323C 16rAF08 16r323D 16rAF0D 16r323E 16rAF10 16r323F 16rAF2C 16r3240 16rAF2D 16r3241 16rAF30 16r3242 16rAF32 16r3243 16rAF34 16r3244 16rAF3C 16r3245 16rAF3D 16r3246 16rAF3F 16r3247 16rAF41 16r3248 16rAF42 16r3249 16rAF43 16r324A 16rAF48 16r324B 16rAF49 16r324C 16rAF50 16r324D 16rAF5C 16r324E 16rAF5D 16r324F 16rAF64 16r3250 16rAF65 16r3251 16rAF79 16r3252 16rAF80 16r3253 16rAF84 16r3254 16rAF88 16r3255 16rAF90 16r3256 16rAF91 16r3257 16rAF95 16r3258 16rAF9C 16r3259 16rAFB8 16r325A 16rAFB9 16r325B 16rAFBC 16r325C 16rAFC0 16r325D 16rAFC7 16r325E 16rAFC8 16r325F 16rAFC9 16r3260 16rAFCB 16r3261 16rAFCD 16r3262 16rAFCE 16r3263 16rAFD4 16r3264 16rAFDC 16r3265 16rAFE8 16r3266 16rAFE9 16r3267 16rAFF0 16r3268 16rAFF1 16r3269 16rAFF4 16r326A 16rAFF8 16r326B 16rB000 16r326C 16rB001 16r326D 16rB004 16r326E 16rB00C 16r326F 16rB010 16r3270 16rB014 16r3271 16rB01C 16r3272 16rB01D 16r3273 16rB028 16r3274 16rB044 16r3275 16rB045 16r3276 16rB048 16r3277 16rB04A 16r3278 16rB04C 16r3279 16rB04E 16r327A 16rB053 16r327B 16rB054 16r327C 16rB055 16r327D 16rB057 16r327E 16rB059 16r3321 16rB05D 16r3322 16rB07C 16r3323 16rB07D 16r3324 16rB080 16r3325 16rB084 16r3326 16rB08C 16r3327 16rB08D 16r3328 16rB08F 16r3329 16rB091 16r332A 16rB098 16r332B 16rB099 16r332C 16rB09A 16r332D 16rB09C 16r332E 16rB09F 16r332F 16rB0A0 16r3330 16rB0A1 16r3331 16rB0A2 16r3332 16rB0A8 16r3333 16rB0A9 16r3334 16rB0AB 16r3335 16rB0AC 16r3336 16rB0AD 16r3337 16rB0AE 16r3338 16rB0AF 16r3339 16rB0B1 16r333A 16rB0B3 16r333B 16rB0B4 16r333C 16rB0B5 16r333D 16rB0B8 16r333E 16rB0BC 16r333F 16rB0C4 16r3340 16rB0C5 16r3341 16rB0C7 16r3342 16rB0C8 16r3343 16rB0C9 16r3344 16rB0D0 16r3345 16rB0D1 16r3346 16rB0D4 16r3347 16rB0D8 16r3348 16rB0E0 16r3349 16rB0E5 16r334A 16rB108 16r334B 16rB109 16r334C 16rB10B 16r334D 16rB10C 16r334E 16rB110 16r334F 16rB112 16r3350 16rB113 16r3351 16rB118 16r3352 16rB119 16r3353 16rB11B 16r3354 16rB11C 16r3355 16rB11D 16r3356 16rB123 16r3357 16rB124 16r3358 16rB125 16r3359 16rB128 16r335A 16rB12C 16r335B 16rB134 16r335C 16rB135 16r335D 16rB137 16r335E 16rB138 16r335F 16rB139 16r3360 16rB140 16r3361 16rB141 16r3362 16rB144 16r3363 16rB148 16r3364 16rB150 16r3365 16rB151 16r3366 16rB154 16r3367 16rB155 16r3368 16rB158 16r3369 16rB15C 16r336A 16rB160 16r336B 16rB178 16r336C 16rB179 16r336D 16rB17C 16r336E 16rB180 16r336F 16rB182 16r3370 16rB188 16r3371 16rB189 16r3372 16rB18B 16r3373 16rB18D 16r3374 16rB192 16r3375 16rB193 16r3376 16rB194 16r3377 16rB198 16r3378 16rB19C 16r3379 16rB1A8 16r337A 16rB1CC 16r337B 16rB1D0 16r337C 16rB1D4 16r337D 16rB1DC 16r337E 16rB1DD 16r3421 16rB1DF 16r3422 16rB1E8 16r3423 16rB1E9 16r3424 16rB1EC 16r3425 16rB1F0 16r3426 16rB1F9 16r3427 16rB1FB 16r3428 16rB1FD 16r3429 16rB204 16r342A 16rB205 16r342B 16rB208 16r342C 16rB20B 16r342D 16rB20C 16r342E 16rB214 16r342F 16rB215 16r3430 16rB217 16r3431 16rB219 16r3432 16rB220 16r3433 16rB234 16r3434 16rB23C 16r3435 16rB258 16r3436 16rB25C 16r3437 16rB260 16r3438 16rB268 16r3439 16rB269 16r343A 16rB274 16r343B 16rB275 16r343C 16rB27C 16r343D 16rB284 16r343E 16rB285 16r343F 16rB289 16r3440 16rB290 16r3441 16rB291 16r3442 16rB294 16r3443 16rB298 16r3444 16rB299 16r3445 16rB29A 16r3446 16rB2A0 16r3447 16rB2A1 16r3448 16rB2A3 16r3449 16rB2A5 16r344A 16rB2A6 16r344B 16rB2AA 16r344C 16rB2AC 16r344D 16rB2B0 16r344E 16rB2B4 16r344F 16rB2C8 16r3450 16rB2C9 16r3451 16rB2CC 16r3452 16rB2D0 16r3453 16rB2D2 16r3454 16rB2D8 16r3455 16rB2D9 16r3456 16rB2DB 16r3457 16rB2DD 16r3458 16rB2E2 16r3459 16rB2E4 16r345A 16rB2E5 16r345B 16rB2E6 16r345C 16rB2E8 16r345D 16rB2EB 16r345E 16rB2EC 16r345F 16rB2ED 16r3460 16rB2EE 16r3461 16rB2EF 16r3462 16rB2F3 16r3463 16rB2F4 16r3464 16rB2F5 16r3465 16rB2F7 16r3466 16rB2F8 16r3467 16rB2F9 16r3468 16rB2FA 16r3469 16rB2FB 16r346A 16rB2FF 16r346B 16rB300 16r346C 16rB301 16r346D 16rB304 16r346E 16rB308 16r346F 16rB310 16r3470 16rB311 16r3471 16rB313 16r3472 16rB314 16r3473 16rB315 16r3474 16rB31C 16r3475 16rB354 16r3476 16rB355 16r3477 16rB356 16r3478 16rB358 16r3479 16rB35B 16r347A 16rB35C 16r347B 16rB35E 16r347C 16rB35F 16r347D 16rB364 16r347E 16rB365 16r3521 16rB367 16r3522 16rB369 16r3523 16rB36B 16r3524 16rB36E 16r3525 16rB370 16r3526 16rB371 16r3527 16rB374 16r3528 16rB378 16r3529 16rB380 16r352A 16rB381 16r352B 16rB383 16r352C 16rB384 16r352D 16rB385 16r352E 16rB38C 16r352F 16rB390 16r3530 16rB394 16r3531 16rB3A0 16r3532 16rB3A1 16r3533 16rB3A8 16r3534 16rB3AC 16r3535 16rB3C4 16r3536 16rB3C5 16r3537 16rB3C8 16r3538 16rB3CB 16r3539 16rB3CC 16r353A 16rB3CE 16r353B 16rB3D0 16r353C 16rB3D4 16r353D 16rB3D5 16r353E 16rB3D7 16r353F 16rB3D9 16r3540 16rB3DB 16r3541 16rB3DD 16r3542 16rB3E0 16r3543 16rB3E4 16r3544 16rB3E8 16r3545 16rB3FC 16r3546 16rB410 16r3547 16rB418 16r3548 16rB41C 16r3549 16rB420 16r354A 16rB428 16r354B 16rB429 16r354C 16rB42B 16r354D 16rB434 16r354E 16rB450 16r354F 16rB451 16r3550 16rB454 16r3551 16rB458 16r3552 16rB460 16r3553 16rB461 16r3554 16rB463 16r3555 16rB465 16r3556 16rB46C 16r3557 16rB480 16r3558 16rB488 16r3559 16rB49D 16r355A 16rB4A4 16r355B 16rB4A8 16r355C 16rB4AC 16r355D 16rB4B5 16r355E 16rB4B7 16r355F 16rB4B9 16r3560 16rB4C0 16r3561 16rB4C4 16r3562 16rB4C8 16r3563 16rB4D0 16r3564 16rB4D5 16r3565 16rB4DC 16r3566 16rB4DD 16r3567 16rB4E0 16r3568 16rB4E3 16r3569 16rB4E4 16r356A 16rB4E6 16r356B 16rB4EC 16r356C 16rB4ED 16r356D 16rB4EF 16r356E 16rB4F1 16r356F 16rB4F8 16r3570 16rB514 16r3571 16rB515 16r3572 16rB518 16r3573 16rB51B 16r3574 16rB51C 16r3575 16rB524 16r3576 16rB525 16r3577 16rB527 16r3578 16rB528 16r3579 16rB529 16r357A 16rB52A 16r357B 16rB530 16r357C 16rB531 16r357D 16rB534 16r357E 16rB538 16r3621 16rB540 16r3622 16rB541 16r3623 16rB543 16r3624 16rB544 16r3625 16rB545 16r3626 16rB54B 16r3627 16rB54C 16r3628 16rB54D 16r3629 16rB550 16r362A 16rB554 16r362B 16rB55C 16r362C 16rB55D 16r362D 16rB55F 16r362E 16rB560 16r362F 16rB561 16r3630 16rB5A0 16r3631 16rB5A1 16r3632 16rB5A4 16r3633 16rB5A8 16r3634 16rB5AA 16r3635 16rB5AB 16r3636 16rB5B0 16r3637 16rB5B1 16r3638 16rB5B3 16r3639 16rB5B4 16r363A 16rB5B5 16r363B 16rB5BB 16r363C 16rB5BC 16r363D 16rB5BD 16r363E 16rB5C0 16r363F 16rB5C4 16r3640 16rB5CC 16r3641 16rB5CD 16r3642 16rB5CF 16r3643 16rB5D0 16r3644 16rB5D1 16r3645 16rB5D8 16r3646 16rB5EC 16r3647 16rB610 16r3648 16rB611 16r3649 16rB614 16r364A 16rB618 16r364B 16rB625 16r364C 16rB62C 16r364D 16rB634 16r364E 16rB648 16r364F 16rB664 16r3650 16rB668 16r3651 16rB69C 16r3652 16rB69D 16r3653 16rB6A0 16r3654 16rB6A4 16r3655 16rB6AB 16r3656 16rB6AC 16r3657 16rB6B1 16r3658 16rB6D4 16r3659 16rB6F0 16r365A 16rB6F4 16r365B 16rB6F8 16r365C 16rB700 16r365D 16rB701 16r365E 16rB705 16r365F 16rB728 16r3660 16rB729 16r3661 16rB72C 16r3662 16rB72F 16r3663 16rB730 16r3664 16rB738 16r3665 16rB739 16r3666 16rB73B 16r3667 16rB744 16r3668 16rB748 16r3669 16rB74C 16r366A 16rB754 16r366B 16rB755 16r366C 16rB760 16r366D 16rB764 16r366E 16rB768 16r366F 16rB770 16r3670 16rB771 16r3671 16rB773 16r3672 16rB775 16r3673 16rB77C 16r3674 16rB77D 16r3675 16rB780 16r3676 16rB784 16r3677 16rB78C 16r3678 16rB78D 16r3679 16rB78F 16r367A 16rB790 16r367B 16rB791 16r367C 16rB792 16r367D 16rB796 16r367E 16rB797 16r3721 16rB798 16r3722 16rB799 16r3723 16rB79C 16r3724 16rB7A0 16r3725 16rB7A8 16r3726 16rB7A9 16r3727 16rB7AB 16r3728 16rB7AC 16r3729 16rB7AD 16r372A 16rB7B4 16r372B 16rB7B5 16r372C 16rB7B8 16r372D 16rB7C7 16r372E 16rB7C9 16r372F 16rB7EC 16r3730 16rB7ED 16r3731 16rB7F0 16r3732 16rB7F4 16r3733 16rB7FC 16r3734 16rB7FD 16r3735 16rB7FF 16r3736 16rB800 16r3737 16rB801 16r3738 16rB807 16r3739 16rB808 16r373A 16rB809 16r373B 16rB80C 16r373C 16rB810 16r373D 16rB818 16r373E 16rB819 16r373F 16rB81B 16r3740 16rB81D 16r3741 16rB824 16r3742 16rB825 16r3743 16rB828 16r3744 16rB82C 16r3745 16rB834 16r3746 16rB835 16r3747 16rB837 16r3748 16rB838 16r3749 16rB839 16r374A 16rB840 16r374B 16rB844 16r374C 16rB851 16r374D 16rB853 16r374E 16rB85C 16r374F 16rB85D 16r3750 16rB860 16r3751 16rB864 16r3752 16rB86C 16r3753 16rB86D 16r3754 16rB86F 16r3755 16rB871 16r3756 16rB878 16r3757 16rB87C 16r3758 16rB88D 16r3759 16rB8A8 16r375A 16rB8B0 16r375B 16rB8B4 16r375C 16rB8B8 16r375D 16rB8C0 16r375E 16rB8C1 16r375F 16rB8C3 16r3760 16rB8C5 16r3761 16rB8CC 16r3762 16rB8D0 16r3763 16rB8D4 16r3764 16rB8DD 16r3765 16rB8DF 16r3766 16rB8E1 16r3767 16rB8E8 16r3768 16rB8E9 16r3769 16rB8EC 16r376A 16rB8F0 16r376B 16rB8F8 16r376C 16rB8F9 16r376D 16rB8FB 16r376E 16rB8FD 16r376F 16rB904 16r3770 16rB918 16r3771 16rB920 16r3772 16rB93C 16r3773 16rB93D 16r3774 16rB940 16r3775 16rB944 16r3776 16rB94C 16r3777 16rB94F 16r3778 16rB951 16r3779 16rB958 16r377A 16rB959 16r377B 16rB95C 16r377C 16rB960 16r377D 16rB968 16r377E 16rB969 16r3821 16rB96B 16r3822 16rB96D 16r3823 16rB974 16r3824 16rB975 16r3825 16rB978 16r3826 16rB97C 16r3827 16rB984 16r3828 16rB985 16r3829 16rB987 16r382A 16rB989 16r382B 16rB98A 16r382C 16rB98D 16r382D 16rB98E 16r382E 16rB9AC 16r382F 16rB9AD 16r3830 16rB9B0 16r3831 16rB9B4 16r3832 16rB9BC 16r3833 16rB9BD 16r3834 16rB9BF 16r3835 16rB9C1 16r3836 16rB9C8 16r3837 16rB9C9 16r3838 16rB9CC 16r3839 16rB9CE 16r383A 16rB9CF 16r383B 16rB9D0 16r383C 16rB9D1 16r383D 16rB9D2 16r383E 16rB9D8 16r383F 16rB9D9 16r3840 16rB9DB 16r3841 16rB9DD 16r3842 16rB9DE 16r3843 16rB9E1 16r3844 16rB9E3 16r3845 16rB9E4 16r3846 16rB9E5 16r3847 16rB9E8 16r3848 16rB9EC 16r3849 16rB9F4 16r384A 16rB9F5 16r384B 16rB9F7 16r384C 16rB9F8 16r384D 16rB9F9 16r384E 16rB9FA 16r384F 16rBA00 16r3850 16rBA01 16r3851 16rBA08 16r3852 16rBA15 16r3853 16rBA38 16r3854 16rBA39 16r3855 16rBA3C 16r3856 16rBA40 16r3857 16rBA42 16r3858 16rBA48 16r3859 16rBA49 16r385A 16rBA4B 16r385B 16rBA4D 16r385C 16rBA4E 16r385D 16rBA53 16r385E 16rBA54 16r385F 16rBA55 16r3860 16rBA58 16r3861 16rBA5C 16r3862 16rBA64 16r3863 16rBA65 16r3864 16rBA67 16r3865 16rBA68 16r3866 16rBA69 16r3867 16rBA70 16r3868 16rBA71 16r3869 16rBA74 16r386A 16rBA78 16r386B 16rBA83 16r386C 16rBA84 16r386D 16rBA85 16r386E 16rBA87 16r386F 16rBA8C 16r3870 16rBAA8 16r3871 16rBAA9 16r3872 16rBAAB 16r3873 16rBAAC 16r3874 16rBAB0 16r3875 16rBAB2 16r3876 16rBAB8 16r3877 16rBAB9 16r3878 16rBABB 16r3879 16rBABD 16r387A 16rBAC4 16r387B 16rBAC8 16r387C 16rBAD8 16r387D 16rBAD9 16r387E 16rBAFC 16r3921 16rBB00 16r3922 16rBB04 16r3923 16rBB0D 16r3924 16rBB0F 16r3925 16rBB11 16r3926 16rBB18 16r3927 16rBB1C 16r3928 16rBB20 16r3929 16rBB29 16r392A 16rBB2B 16r392B 16rBB34 16r392C 16rBB35 16r392D 16rBB36 16r392E 16rBB38 16r392F 16rBB3B 16r3930 16rBB3C 16r3931 16rBB3D 16r3932 16rBB3E 16r3933 16rBB44 16r3934 16rBB45 16r3935 16rBB47 16r3936 16rBB49 16r3937 16rBB4D 16r3938 16rBB4F 16r3939 16rBB50 16r393A 16rBB54 16r393B 16rBB58 16r393C 16rBB61 16r393D 16rBB63 16r393E 16rBB6C 16r393F 16rBB88 16r3940 16rBB8C 16r3941 16rBB90 16r3942 16rBBA4 16r3943 16rBBA8 16r3944 16rBBAC 16r3945 16rBBB4 16r3946 16rBBB7 16r3947 16rBBC0 16r3948 16rBBC4 16r3949 16rBBC8 16r394A 16rBBD0 16r394B 16rBBD3 16r394C 16rBBF8 16r394D 16rBBF9 16r394E 16rBBFC 16r394F 16rBBFF 16r3950 16rBC00 16r3951 16rBC02 16r3952 16rBC08 16r3953 16rBC09 16r3954 16rBC0B 16r3955 16rBC0C 16r3956 16rBC0D 16r3957 16rBC0F 16r3958 16rBC11 16r3959 16rBC14 16r395A 16rBC15 16r395B 16rBC16 16r395C 16rBC17 16r395D 16rBC18 16r395E 16rBC1B 16r395F 16rBC1C 16r3960 16rBC1D 16r3961 16rBC1E 16r3962 16rBC1F 16r3963 16rBC24 16r3964 16rBC25 16r3965 16rBC27 16r3966 16rBC29 16r3967 16rBC2D 16r3968 16rBC30 16r3969 16rBC31 16r396A 16rBC34 16r396B 16rBC38 16r396C 16rBC40 16r396D 16rBC41 16r396E 16rBC43 16r396F 16rBC44 16r3970 16rBC45 16r3971 16rBC49 16r3972 16rBC4C 16r3973 16rBC4D 16r3974 16rBC50 16r3975 16rBC5D 16r3976 16rBC84 16r3977 16rBC85 16r3978 16rBC88 16r3979 16rBC8B 16r397A 16rBC8C 16r397B 16rBC8E 16r397C 16rBC94 16r397D 16rBC95 16r397E 16rBC97 16r3A21 16rBC99 16r3A22 16rBC9A 16r3A23 16rBCA0 16r3A24 16rBCA1 16r3A25 16rBCA4 16r3A26 16rBCA7 16r3A27 16rBCA8 16r3A28 16rBCB0 16r3A29 16rBCB1 16r3A2A 16rBCB3 16r3A2B 16rBCB4 16r3A2C 16rBCB5 16r3A2D 16rBCBC 16r3A2E 16rBCBD 16r3A2F 16rBCC0 16r3A30 16rBCC4 16r3A31 16rBCCD 16r3A32 16rBCCF 16r3A33 16rBCD0 16r3A34 16rBCD1 16r3A35 16rBCD5 16r3A36 16rBCD8 16r3A37 16rBCDC 16r3A38 16rBCF4 16r3A39 16rBCF5 16r3A3A 16rBCF6 16r3A3B 16rBCF8 16r3A3C 16rBCFC 16r3A3D 16rBD04 16r3A3E 16rBD05 16r3A3F 16rBD07 16r3A40 16rBD09 16r3A41 16rBD10 16r3A42 16rBD14 16r3A43 16rBD24 16r3A44 16rBD2C 16r3A45 16rBD40 16r3A46 16rBD48 16r3A47 16rBD49 16r3A48 16rBD4C 16r3A49 16rBD50 16r3A4A 16rBD58 16r3A4B 16rBD59 16r3A4C 16rBD64 16r3A4D 16rBD68 16r3A4E 16rBD80 16r3A4F 16rBD81 16r3A50 16rBD84 16r3A51 16rBD87 16r3A52 16rBD88 16r3A53 16rBD89 16r3A54 16rBD8A 16r3A55 16rBD90 16r3A56 16rBD91 16r3A57 16rBD93 16r3A58 16rBD95 16r3A59 16rBD99 16r3A5A 16rBD9A 16r3A5B 16rBD9C 16r3A5C 16rBDA4 16r3A5D 16rBDB0 16r3A5E 16rBDB8 16r3A5F 16rBDD4 16r3A60 16rBDD5 16r3A61 16rBDD8 16r3A62 16rBDDC 16r3A63 16rBDE9 16r3A64 16rBDF0 16r3A65 16rBDF4 16r3A66 16rBDF8 16r3A67 16rBE00 16r3A68 16rBE03 16r3A69 16rBE05 16r3A6A 16rBE0C 16r3A6B 16rBE0D 16r3A6C 16rBE10 16r3A6D 16rBE14 16r3A6E 16rBE1C 16r3A6F 16rBE1D 16r3A70 16rBE1F 16r3A71 16rBE44 16r3A72 16rBE45 16r3A73 16rBE48 16r3A74 16rBE4C 16r3A75 16rBE4E 16r3A76 16rBE54 16r3A77 16rBE55 16r3A78 16rBE57 16r3A79 16rBE59 16r3A7A 16rBE5A 16r3A7B 16rBE5B 16r3A7C 16rBE60 16r3A7D 16rBE61 16r3A7E 16rBE64 16r3B21 16rBE68 16r3B22 16rBE6A 16r3B23 16rBE70 16r3B24 16rBE71 16r3B25 16rBE73 16r3B26 16rBE74 16r3B27 16rBE75 16r3B28 16rBE7B 16r3B29 16rBE7C 16r3B2A 16rBE7D 16r3B2B 16rBE80 16r3B2C 16rBE84 16r3B2D 16rBE8C 16r3B2E 16rBE8D 16r3B2F 16rBE8F 16r3B30 16rBE90 16r3B31 16rBE91 16r3B32 16rBE98 16r3B33 16rBE99 16r3B34 16rBEA8 16r3B35 16rBED0 16r3B36 16rBED1 16r3B37 16rBED4 16r3B38 16rBED7 16r3B39 16rBED8 16r3B3A 16rBEE0 16r3B3B 16rBEE3 16r3B3C 16rBEE4 16r3B3D 16rBEE5 16r3B3E 16rBEEC 16r3B3F 16rBF01 16r3B40 16rBF08 16r3B41 16rBF09 16r3B42 16rBF18 16r3B43 16rBF19 16r3B44 16rBF1B 16r3B45 16rBF1C 16r3B46 16rBF1D 16r3B47 16rBF40 16r3B48 16rBF41 16r3B49 16rBF44 16r3B4A 16rBF48 16r3B4B 16rBF50 16r3B4C 16rBF51 16r3B4D 16rBF55 16r3B4E 16rBF94 16r3B4F 16rBFB0 16r3B50 16rBFC5 16r3B51 16rBFCC 16r3B52 16rBFCD 16r3B53 16rBFD0 16r3B54 16rBFD4 16r3B55 16rBFDC 16r3B56 16rBFDF 16r3B57 16rBFE1 16r3B58 16rC03C 16r3B59 16rC051 16r3B5A 16rC058 16r3B5B 16rC05C 16r3B5C 16rC060 16r3B5D 16rC068 16r3B5E 16rC069 16r3B5F 16rC090 16r3B60 16rC091 16r3B61 16rC094 16r3B62 16rC098 16r3B63 16rC0A0 16r3B64 16rC0A1 16r3B65 16rC0A3 16r3B66 16rC0A5 16r3B67 16rC0AC 16r3B68 16rC0AD 16r3B69 16rC0AF 16r3B6A 16rC0B0 16r3B6B 16rC0B3 16r3B6C 16rC0B4 16r3B6D 16rC0B5 16r3B6E 16rC0B6 16r3B6F 16rC0BC 16r3B70 16rC0BD 16r3B71 16rC0BF 16r3B72 16rC0C0 16r3B73 16rC0C1 16r3B74 16rC0C5 16r3B75 16rC0C8 16r3B76 16rC0C9 16r3B77 16rC0CC 16r3B78 16rC0D0 16r3B79 16rC0D8 16r3B7A 16rC0D9 16r3B7B 16rC0DB 16r3B7C 16rC0DC 16r3B7D 16rC0DD 16r3B7E 16rC0E4 16r3C21 16rC0E5 16r3C22 16rC0E8 16r3C23 16rC0EC 16r3C24 16rC0F4 16r3C25 16rC0F5 16r3C26 16rC0F7 16r3C27 16rC0F9 16r3C28 16rC100 16r3C29 16rC104 16r3C2A 16rC108 16r3C2B 16rC110 16r3C2C 16rC115 16r3C2D 16rC11C 16r3C2E 16rC11D 16r3C2F 16rC11E 16r3C30 16rC11F 16r3C31 16rC120 16r3C32 16rC123 16r3C33 16rC124 16r3C34 16rC126 16r3C35 16rC127 16r3C36 16rC12C 16r3C37 16rC12D 16r3C38 16rC12F 16r3C39 16rC130 16r3C3A 16rC131 16r3C3B 16rC136 16r3C3C 16rC138 16r3C3D 16rC139 16r3C3E 16rC13C 16r3C3F 16rC140 16r3C40 16rC148 16r3C41 16rC149 16r3C42 16rC14B 16r3C43 16rC14C 16r3C44 16rC14D 16r3C45 16rC154 16r3C46 16rC155 16r3C47 16rC158 16r3C48 16rC15C 16r3C49 16rC164 16r3C4A 16rC165 16r3C4B 16rC167 16r3C4C 16rC168 16r3C4D 16rC169 16r3C4E 16rC170 16r3C4F 16rC174 16r3C50 16rC178 16r3C51 16rC185 16r3C52 16rC18C 16r3C53 16rC18D 16r3C54 16rC18E 16r3C55 16rC190 16r3C56 16rC194 16r3C57 16rC196 16r3C58 16rC19C 16r3C59 16rC19D 16r3C5A 16rC19F 16r3C5B 16rC1A1 16r3C5C 16rC1A5 16r3C5D 16rC1A8 16r3C5E 16rC1A9 16r3C5F 16rC1AC 16r3C60 16rC1B0 16r3C61 16rC1BD 16r3C62 16rC1C4 16r3C63 16rC1C8 16r3C64 16rC1CC 16r3C65 16rC1D4 16r3C66 16rC1D7 16r3C67 16rC1D8 16r3C68 16rC1E0 16r3C69 16rC1E4 16r3C6A 16rC1E8 16r3C6B 16rC1F0 16r3C6C 16rC1F1 16r3C6D 16rC1F3 16r3C6E 16rC1FC 16r3C6F 16rC1FD 16r3C70 16rC200 16r3C71 16rC204 16r3C72 16rC20C 16r3C73 16rC20D 16r3C74 16rC20F 16r3C75 16rC211 16r3C76 16rC218 16r3C77 16rC219 16r3C78 16rC21C 16r3C79 16rC21F 16r3C7A 16rC220 16r3C7B 16rC228 16r3C7C 16rC229 16r3C7D 16rC22B 16r3C7E 16rC22D 16r3D21 16rC22F 16r3D22 16rC231 16r3D23 16rC232 16r3D24 16rC234 16r3D25 16rC248 16r3D26 16rC250 16r3D27 16rC251 16r3D28 16rC254 16r3D29 16rC258 16r3D2A 16rC260 16r3D2B 16rC265 16r3D2C 16rC26C 16r3D2D 16rC26D 16r3D2E 16rC270 16r3D2F 16rC274 16r3D30 16rC27C 16r3D31 16rC27D 16r3D32 16rC27F 16r3D33 16rC281 16r3D34 16rC288 16r3D35 16rC289 16r3D36 16rC290 16r3D37 16rC298 16r3D38 16rC29B 16r3D39 16rC29D 16r3D3A 16rC2A4 16r3D3B 16rC2A5 16r3D3C 16rC2A8 16r3D3D 16rC2AC 16r3D3E 16rC2AD 16r3D3F 16rC2B4 16r3D40 16rC2B5 16r3D41 16rC2B7 16r3D42 16rC2B9 16r3D43 16rC2DC 16r3D44 16rC2DD 16r3D45 16rC2E0 16r3D46 16rC2E3 16r3D47 16rC2E4 16r3D48 16rC2EB 16r3D49 16rC2EC 16r3D4A 16rC2ED 16r3D4B 16rC2EF 16r3D4C 16rC2F1 16r3D4D 16rC2F6 16r3D4E 16rC2F8 16r3D4F 16rC2F9 16r3D50 16rC2FB 16r3D51 16rC2FC 16r3D52 16rC300 16r3D53 16rC308 16r3D54 16rC309 16r3D55 16rC30C 16r3D56 16rC30D 16r3D57 16rC313 16r3D58 16rC314 16r3D59 16rC315 16r3D5A 16rC318 16r3D5B 16rC31C 16r3D5C 16rC324 16r3D5D 16rC325 16r3D5E 16rC328 16r3D5F 16rC329 16r3D60 16rC345 16r3D61 16rC368 16r3D62 16rC369 16r3D63 16rC36C 16r3D64 16rC370 16r3D65 16rC372 16r3D66 16rC378 16r3D67 16rC379 16r3D68 16rC37C 16r3D69 16rC37D 16r3D6A 16rC384 16r3D6B 16rC388 16r3D6C 16rC38C 16r3D6D 16rC3C0 16r3D6E 16rC3D8 16r3D6F 16rC3D9 16r3D70 16rC3DC 16r3D71 16rC3DF 16r3D72 16rC3E0 16r3D73 16rC3E2 16r3D74 16rC3E8 16r3D75 16rC3E9 16r3D76 16rC3ED 16r3D77 16rC3F4 16r3D78 16rC3F5 16r3D79 16rC3F8 16r3D7A 16rC408 16r3D7B 16rC410 16r3D7C 16rC424 16r3D7D 16rC42C 16r3D7E 16rC430 16r3E21 16rC434 16r3E22 16rC43C 16r3E23 16rC43D 16r3E24 16rC448 16r3E25 16rC464 16r3E26 16rC465 16r3E27 16rC468 16r3E28 16rC46C 16r3E29 16rC474 16r3E2A 16rC475 16r3E2B 16rC479 16r3E2C 16rC480 16r3E2D 16rC494 16r3E2E 16rC49C 16r3E2F 16rC4B8 16r3E30 16rC4BC 16r3E31 16rC4E9 16r3E32 16rC4F0 16r3E33 16rC4F1 16r3E34 16rC4F4 16r3E35 16rC4F8 16r3E36 16rC4FA 16r3E37 16rC4FF 16r3E38 16rC500 16r3E39 16rC501 16r3E3A 16rC50C 16r3E3B 16rC510 16r3E3C 16rC514 16r3E3D 16rC51C 16r3E3E 16rC528 16r3E3F 16rC529 16r3E40 16rC52C 16r3E41 16rC530 16r3E42 16rC538 16r3E43 16rC539 16r3E44 16rC53B 16r3E45 16rC53D 16r3E46 16rC544 16r3E47 16rC545 16r3E48 16rC548 16r3E49 16rC549 16r3E4A 16rC54A 16r3E4B 16rC54C 16r3E4C 16rC54D 16r3E4D 16rC54E 16r3E4E 16rC553 16r3E4F 16rC554 16r3E50 16rC555 16r3E51 16rC557 16r3E52 16rC558 16r3E53 16rC559 16r3E54 16rC55D 16r3E55 16rC55E 16r3E56 16rC560 16r3E57 16rC561 16r3E58 16rC564 16r3E59 16rC568 16r3E5A 16rC570 16r3E5B 16rC571 16r3E5C 16rC573 16r3E5D 16rC574 16r3E5E 16rC575 16r3E5F 16rC57C 16r3E60 16rC57D 16r3E61 16rC580 16r3E62 16rC584 16r3E63 16rC587 16r3E64 16rC58C 16r3E65 16rC58D 16r3E66 16rC58F 16r3E67 16rC591 16r3E68 16rC595 16r3E69 16rC597 16r3E6A 16rC598 16r3E6B 16rC59C 16r3E6C 16rC5A0 16r3E6D 16rC5A9 16r3E6E 16rC5B4 16r3E6F 16rC5B5 16r3E70 16rC5B8 16r3E71 16rC5B9 16r3E72 16rC5BB 16r3E73 16rC5BC 16r3E74 16rC5BD 16r3E75 16rC5BE 16r3E76 16rC5C4 16r3E77 16rC5C5 16r3E78 16rC5C6 16r3E79 16rC5C7 16r3E7A 16rC5C8 16r3E7B 16rC5C9 16r3E7C 16rC5CA 16r3E7D 16rC5CC 16r3E7E 16rC5CE 16r3F21 16rC5D0 16r3F22 16rC5D1 16r3F23 16rC5D4 16r3F24 16rC5D8 16r3F25 16rC5E0 16r3F26 16rC5E1 16r3F27 16rC5E3 16r3F28 16rC5E5 16r3F29 16rC5EC 16r3F2A 16rC5ED 16r3F2B 16rC5EE 16r3F2C 16rC5F0 16r3F2D 16rC5F4 16r3F2E 16rC5F6 16r3F2F 16rC5F7 16r3F30 16rC5FC 16r3F31 16rC5FD 16r3F32 16rC5FE 16r3F33 16rC5FF 16r3F34 16rC600 16r3F35 16rC601 16r3F36 16rC605 16r3F37 16rC606 16r3F38 16rC607 16r3F39 16rC608 16r3F3A 16rC60C 16r3F3B 16rC610 16r3F3C 16rC618 16r3F3D 16rC619 16r3F3E 16rC61B 16r3F3F 16rC61C 16r3F40 16rC624 16r3F41 16rC625 16r3F42 16rC628 16r3F43 16rC62C 16r3F44 16rC62D 16r3F45 16rC62E 16r3F46 16rC630 16r3F47 16rC633 16r3F48 16rC634 16r3F49 16rC635 16r3F4A 16rC637 16r3F4B 16rC639 16r3F4C 16rC63B 16r3F4D 16rC640 16r3F4E 16rC641 16r3F4F 16rC644 16r3F50 16rC648 16r3F51 16rC650 16r3F52 16rC651 16r3F53 16rC653 16r3F54 16rC654 16r3F55 16rC655 16r3F56 16rC65C 16r3F57 16rC65D 16r3F58 16rC660 16r3F59 16rC66C 16r3F5A 16rC66F 16r3F5B 16rC671 16r3F5C 16rC678 16r3F5D 16rC679 16r3F5E 16rC67C 16r3F5F 16rC680 16r3F60 16rC688 16r3F61 16rC689 16r3F62 16rC68B 16r3F63 16rC68D 16r3F64 16rC694 16r3F65 16rC695 16r3F66 16rC698 16r3F67 16rC69C 16r3F68 16rC6A4 16r3F69 16rC6A5 16r3F6A 16rC6A7 16r3F6B 16rC6A9 16r3F6C 16rC6B0 16r3F6D 16rC6B1 16r3F6E 16rC6B4 16r3F6F 16rC6B8 16r3F70 16rC6B9 16r3F71 16rC6BA 16r3F72 16rC6C0 16r3F73 16rC6C1 16r3F74 16rC6C3 16r3F75 16rC6C5 16r3F76 16rC6CC 16r3F77 16rC6CD 16r3F78 16rC6D0 16r3F79 16rC6D4 16r3F7A 16rC6DC 16r3F7B 16rC6DD 16r3F7C 16rC6E0 16r3F7D 16rC6E1 16r3F7E 16rC6E8 16r4021 16rC6E9 16r4022 16rC6EC 16r4023 16rC6F0 16r4024 16rC6F8 16r4025 16rC6F9 16r4026 16rC6FD 16r4027 16rC704 16r4028 16rC705 16r4029 16rC708 16r402A 16rC70C 16r402B 16rC714 16r402C 16rC715 16r402D 16rC717 16r402E 16rC719 16r402F 16rC720 16r4030 16rC721 16r4031 16rC724 16r4032 16rC728 16r4033 16rC730 16r4034 16rC731 16r4035 16rC733 16r4036 16rC735 16r4037 16rC737 16r4038 16rC73C 16r4039 16rC73D 16r403A 16rC740 16r403B 16rC744 16r403C 16rC74A 16r403D 16rC74C 16r403E 16rC74D 16r403F 16rC74F 16r4040 16rC751 16r4041 16rC752 16r4042 16rC753 16r4043 16rC754 16r4044 16rC755 16r4045 16rC756 16r4046 16rC757 16r4047 16rC758 16r4048 16rC75C 16r4049 16rC760 16r404A 16rC768 16r404B 16rC76B 16r404C 16rC774 16r404D 16rC775 16r404E 16rC778 16r404F 16rC77C 16r4050 16rC77D 16r4051 16rC77E 16r4052 16rC783 16r4053 16rC784 16r4054 16rC785 16r4055 16rC787 16r4056 16rC788 16r4057 16rC789 16r4058 16rC78A 16r4059 16rC78E 16r405A 16rC790 16r405B 16rC791 16r405C 16rC794 16r405D 16rC796 16r405E 16rC797 16r405F 16rC798 16r4060 16rC79A 16r4061 16rC7A0 16r4062 16rC7A1 16r4063 16rC7A3 16r4064 16rC7A4 16r4065 16rC7A5 16r4066 16rC7A6 16r4067 16rC7AC 16r4068 16rC7AD 16r4069 16rC7B0 16r406A 16rC7B4 16r406B 16rC7BC 16r406C 16rC7BD 16r406D 16rC7BF 16r406E 16rC7C0 16r406F 16rC7C1 16r4070 16rC7C8 16r4071 16rC7C9 16r4072 16rC7CC 16r4073 16rC7CE 16r4074 16rC7D0 16r4075 16rC7D8 16r4076 16rC7DD 16r4077 16rC7E4 16r4078 16rC7E8 16r4079 16rC7EC 16r407A 16rC800 16r407B 16rC801 16r407C 16rC804 16r407D 16rC808 16r407E 16rC80A 16r4121 16rC810 16r4122 16rC811 16r4123 16rC813 16r4124 16rC815 16r4125 16rC816 16r4126 16rC81C 16r4127 16rC81D 16r4128 16rC820 16r4129 16rC824 16r412A 16rC82C 16r412B 16rC82D 16r412C 16rC82F 16r412D 16rC831 16r412E 16rC838 16r412F 16rC83C 16r4130 16rC840 16r4131 16rC848 16r4132 16rC849 16r4133 16rC84C 16r4134 16rC84D 16r4135 16rC854 16r4136 16rC870 16r4137 16rC871 16r4138 16rC874 16r4139 16rC878 16r413A 16rC87A 16r413B 16rC880 16r413C 16rC881 16r413D 16rC883 16r413E 16rC885 16r413F 16rC886 16r4140 16rC887 16r4141 16rC88B 16r4142 16rC88C 16r4143 16rC88D 16r4144 16rC894 16r4145 16rC89D 16r4146 16rC89F 16r4147 16rC8A1 16r4148 16rC8A8 16r4149 16rC8BC 16r414A 16rC8BD 16r414B 16rC8C4 16r414C 16rC8C8 16r414D 16rC8CC 16r414E 16rC8D4 16r414F 16rC8D5 16r4150 16rC8D7 16r4151 16rC8D9 16r4152 16rC8E0 16r4153 16rC8E1 16r4154 16rC8E4 16r4155 16rC8F5 16r4156 16rC8FC 16r4157 16rC8FD 16r4158 16rC900 16r4159 16rC904 16r415A 16rC905 16r415B 16rC906 16r415C 16rC90C 16r415D 16rC90D 16r415E 16rC90F 16r415F 16rC911 16r4160 16rC918 16r4161 16rC92C 16r4162 16rC934 16r4163 16rC950 16r4164 16rC951 16r4165 16rC954 16r4166 16rC958 16r4167 16rC960 16r4168 16rC961 16r4169 16rC963 16r416A 16rC96C 16r416B 16rC970 16r416C 16rC974 16r416D 16rC97C 16r416E 16rC988 16r416F 16rC989 16r4170 16rC98C 16r4171 16rC990 16r4172 16rC998 16r4173 16rC999 16r4174 16rC99B 16r4175 16rC99D 16r4176 16rC9C0 16r4177 16rC9C1 16r4178 16rC9C4 16r4179 16rC9C7 16r417A 16rC9C8 16r417B 16rC9CA 16r417C 16rC9D0 16r417D 16rC9D1 16r417E 16rC9D3 16r4221 16rC9D5 16r4222 16rC9D6 16r4223 16rC9D9 16r4224 16rC9DA 16r4225 16rC9DC 16r4226 16rC9DD 16r4227 16rC9E0 16r4228 16rC9E2 16r4229 16rC9E4 16r422A 16rC9E7 16r422B 16rC9EC 16r422C 16rC9ED 16r422D 16rC9EF 16r422E 16rC9F0 16r422F 16rC9F1 16r4230 16rC9F8 16r4231 16rC9F9 16r4232 16rC9FC 16r4233 16rCA00 16r4234 16rCA08 16r4235 16rCA09 16r4236 16rCA0B 16r4237 16rCA0C 16r4238 16rCA0D 16r4239 16rCA14 16r423A 16rCA18 16r423B 16rCA29 16r423C 16rCA4C 16r423D 16rCA4D 16r423E 16rCA50 16r423F 16rCA54 16r4240 16rCA5C 16r4241 16rCA5D 16r4242 16rCA5F 16r4243 16rCA60 16r4244 16rCA61 16r4245 16rCA68 16r4246 16rCA7D 16r4247 16rCA84 16r4248 16rCA98 16r4249 16rCABC 16r424A 16rCABD 16r424B 16rCAC0 16r424C 16rCAC4 16r424D 16rCACC 16r424E 16rCACD 16r424F 16rCACF 16r4250 16rCAD1 16r4251 16rCAD3 16r4252 16rCAD8 16r4253 16rCAD9 16r4254 16rCAE0 16r4255 16rCAEC 16r4256 16rCAF4 16r4257 16rCB08 16r4258 16rCB10 16r4259 16rCB14 16r425A 16rCB18 16r425B 16rCB20 16r425C 16rCB21 16r425D 16rCB41 16r425E 16rCB48 16r425F 16rCB49 16r4260 16rCB4C 16r4261 16rCB50 16r4262 16rCB58 16r4263 16rCB59 16r4264 16rCB5D 16r4265 16rCB64 16r4266 16rCB78 16r4267 16rCB79 16r4268 16rCB9C 16r4269 16rCBB8 16r426A 16rCBD4 16r426B 16rCBE4 16r426C 16rCBE7 16r426D 16rCBE9 16r426E 16rCC0C 16r426F 16rCC0D 16r4270 16rCC10 16r4271 16rCC14 16r4272 16rCC1C 16r4273 16rCC1D 16r4274 16rCC21 16r4275 16rCC22 16r4276 16rCC27 16r4277 16rCC28 16r4278 16rCC29 16r4279 16rCC2C 16r427A 16rCC2E 16r427B 16rCC30 16r427C 16rCC38 16r427D 16rCC39 16r427E 16rCC3B 16r4321 16rCC3C 16r4322 16rCC3D 16r4323 16rCC3E 16r4324 16rCC44 16r4325 16rCC45 16r4326 16rCC48 16r4327 16rCC4C 16r4328 16rCC54 16r4329 16rCC55 16r432A 16rCC57 16r432B 16rCC58 16r432C 16rCC59 16r432D 16rCC60 16r432E 16rCC64 16r432F 16rCC66 16r4330 16rCC68 16r4331 16rCC70 16r4332 16rCC75 16r4333 16rCC98 16r4334 16rCC99 16r4335 16rCC9C 16r4336 16rCCA0 16r4337 16rCCA8 16r4338 16rCCA9 16r4339 16rCCAB 16r433A 16rCCAC 16r433B 16rCCAD 16r433C 16rCCB4 16r433D 16rCCB5 16r433E 16rCCB8 16r433F 16rCCBC 16r4340 16rCCC4 16r4341 16rCCC5 16r4342 16rCCC7 16r4343 16rCCC9 16r4344 16rCCD0 16r4345 16rCCD4 16r4346 16rCCE4 16r4347 16rCCEC 16r4348 16rCCF0 16r4349 16rCD01 16r434A 16rCD08 16r434B 16rCD09 16r434C 16rCD0C 16r434D 16rCD10 16r434E 16rCD18 16r434F 16rCD19 16r4350 16rCD1B 16r4351 16rCD1D 16r4352 16rCD24 16r4353 16rCD28 16r4354 16rCD2C 16r4355 16rCD39 16r4356 16rCD5C 16r4357 16rCD60 16r4358 16rCD64 16r4359 16rCD6C 16r435A 16rCD6D 16r435B 16rCD6F 16r435C 16rCD71 16r435D 16rCD78 16r435E 16rCD88 16r435F 16rCD94 16r4360 16rCD95 16r4361 16rCD98 16r4362 16rCD9C 16r4363 16rCDA4 16r4364 16rCDA5 16r4365 16rCDA7 16r4366 16rCDA9 16r4367 16rCDB0 16r4368 16rCDC4 16r4369 16rCDCC 16r436A 16rCDD0 16r436B 16rCDE8 16r436C 16rCDEC 16r436D 16rCDF0 16r436E 16rCDF8 16r436F 16rCDF9 16r4370 16rCDFB 16r4371 16rCDFD 16r4372 16rCE04 16r4373 16rCE08 16r4374 16rCE0C 16r4375 16rCE14 16r4376 16rCE19 16r4377 16rCE20 16r4378 16rCE21 16r4379 16rCE24 16r437A 16rCE28 16r437B 16rCE30 16r437C 16rCE31 16r437D 16rCE33 16r437E 16rCE35 16r4421 16rCE58 16r4422 16rCE59 16r4423 16rCE5C 16r4424 16rCE5F 16r4425 16rCE60 16r4426 16rCE61 16r4427 16rCE68 16r4428 16rCE69 16r4429 16rCE6B 16r442A 16rCE6D 16r442B 16rCE74 16r442C 16rCE75 16r442D 16rCE78 16r442E 16rCE7C 16r442F 16rCE84 16r4430 16rCE85 16r4431 16rCE87 16r4432 16rCE89 16r4433 16rCE90 16r4434 16rCE91 16r4435 16rCE94 16r4436 16rCE98 16r4437 16rCEA0 16r4438 16rCEA1 16r4439 16rCEA3 16r443A 16rCEA4 16r443B 16rCEA5 16r443C 16rCEAC 16r443D 16rCEAD 16r443E 16rCEC1 16r443F 16rCEE4 16r4440 16rCEE5 16r4441 16rCEE8 16r4442 16rCEEB 16r4443 16rCEEC 16r4444 16rCEF4 16r4445 16rCEF5 16r4446 16rCEF7 16r4447 16rCEF8 16r4448 16rCEF9 16r4449 16rCF00 16r444A 16rCF01 16r444B 16rCF04 16r444C 16rCF08 16r444D 16rCF10 16r444E 16rCF11 16r444F 16rCF13 16r4450 16rCF15 16r4451 16rCF1C 16r4452 16rCF20 16r4453 16rCF24 16r4454 16rCF2C 16r4455 16rCF2D 16r4456 16rCF2F 16r4457 16rCF30 16r4458 16rCF31 16r4459 16rCF38 16r445A 16rCF54 16r445B 16rCF55 16r445C 16rCF58 16r445D 16rCF5C 16r445E 16rCF64 16r445F 16rCF65 16r4460 16rCF67 16r4461 16rCF69 16r4462 16rCF70 16r4463 16rCF71 16r4464 16rCF74 16r4465 16rCF78 16r4466 16rCF80 16r4467 16rCF85 16r4468 16rCF8C 16r4469 16rCFA1 16r446A 16rCFA8 16r446B 16rCFB0 16r446C 16rCFC4 16r446D 16rCFE0 16r446E 16rCFE1 16r446F 16rCFE4 16r4470 16rCFE8 16r4471 16rCFF0 16r4472 16rCFF1 16r4473 16rCFF3 16r4474 16rCFF5 16r4475 16rCFFC 16r4476 16rD000 16r4477 16rD004 16r4478 16rD011 16r4479 16rD018 16r447A 16rD02D 16r447B 16rD034 16r447C 16rD035 16r447D 16rD038 16r447E 16rD03C 16r4521 16rD044 16r4522 16rD045 16r4523 16rD047 16r4524 16rD049 16r4525 16rD050 16r4526 16rD054 16r4527 16rD058 16r4528 16rD060 16r4529 16rD06C 16r452A 16rD06D 16r452B 16rD070 16r452C 16rD074 16r452D 16rD07C 16r452E 16rD07D 16r452F 16rD081 16r4530 16rD0A4 16r4531 16rD0A5 16r4532 16rD0A8 16r4533 16rD0AC 16r4534 16rD0B4 16r4535 16rD0B5 16r4536 16rD0B7 16r4537 16rD0B9 16r4538 16rD0C0 16r4539 16rD0C1 16r453A 16rD0C4 16r453B 16rD0C8 16r453C 16rD0C9 16r453D 16rD0D0 16r453E 16rD0D1 16r453F 16rD0D3 16r4540 16rD0D4 16r4541 16rD0D5 16r4542 16rD0DC 16r4543 16rD0DD 16r4544 16rD0E0 16r4545 16rD0E4 16r4546 16rD0EC 16r4547 16rD0ED 16r4548 16rD0EF 16r4549 16rD0F0 16r454A 16rD0F1 16r454B 16rD0F8 16r454C 16rD10D 16r454D 16rD130 16r454E 16rD131 16r454F 16rD134 16r4550 16rD138 16r4551 16rD13A 16r4552 16rD140 16r4553 16rD141 16r4554 16rD143 16r4555 16rD144 16r4556 16rD145 16r4557 16rD14C 16r4558 16rD14D 16r4559 16rD150 16r455A 16rD154 16r455B 16rD15C 16r455C 16rD15D 16r455D 16rD15F 16r455E 16rD161 16r455F 16rD168 16r4560 16rD16C 16r4561 16rD17C 16r4562 16rD184 16r4563 16rD188 16r4564 16rD1A0 16r4565 16rD1A1 16r4566 16rD1A4 16r4567 16rD1A8 16r4568 16rD1B0 16r4569 16rD1B1 16r456A 16rD1B3 16r456B 16rD1B5 16r456C 16rD1BA 16r456D 16rD1BC 16r456E 16rD1C0 16r456F 16rD1D8 16r4570 16rD1F4 16r4571 16rD1F8 16r4572 16rD207 16r4573 16rD209 16r4574 16rD210 16r4575 16rD22C 16r4576 16rD22D 16r4577 16rD230 16r4578 16rD234 16r4579 16rD23C 16r457A 16rD23D 16r457B 16rD23F 16r457C 16rD241 16r457D 16rD248 16r457E 16rD25C 16r4621 16rD264 16r4622 16rD280 16r4623 16rD281 16r4624 16rD284 16r4625 16rD288 16r4626 16rD290 16r4627 16rD291 16r4628 16rD295 16r4629 16rD29C 16r462A 16rD2A0 16r462B 16rD2A4 16r462C 16rD2AC 16r462D 16rD2B1 16r462E 16rD2B8 16r462F 16rD2B9 16r4630 16rD2BC 16r4631 16rD2BF 16r4632 16rD2C0 16r4633 16rD2C2 16r4634 16rD2C8 16r4635 16rD2C9 16r4636 16rD2CB 16r4637 16rD2D4 16r4638 16rD2D8 16r4639 16rD2DC 16r463A 16rD2E4 16r463B 16rD2E5 16r463C 16rD2F0 16r463D 16rD2F1 16r463E 16rD2F4 16r463F 16rD2F8 16r4640 16rD300 16r4641 16rD301 16r4642 16rD303 16r4643 16rD305 16r4644 16rD30C 16r4645 16rD30D 16r4646 16rD30E 16r4647 16rD310 16r4648 16rD314 16r4649 16rD316 16r464A 16rD31C 16r464B 16rD31D 16r464C 16rD31F 16r464D 16rD320 16r464E 16rD321 16r464F 16rD325 16r4650 16rD328 16r4651 16rD329 16r4652 16rD32C 16r4653 16rD330 16r4654 16rD338 16r4655 16rD339 16r4656 16rD33B 16r4657 16rD33C 16r4658 16rD33D 16r4659 16rD344 16r465A 16rD345 16r465B 16rD37C 16r465C 16rD37D 16r465D 16rD380 16r465E 16rD384 16r465F 16rD38C 16r4660 16rD38D 16r4661 16rD38F 16r4662 16rD390 16r4663 16rD391 16r4664 16rD398 16r4665 16rD399 16r4666 16rD39C 16r4667 16rD3A0 16r4668 16rD3A8 16r4669 16rD3A9 16r466A 16rD3AB 16r466B 16rD3AD 16r466C 16rD3B4 16r466D 16rD3B8 16r466E 16rD3BC 16r466F 16rD3C4 16r4670 16rD3C5 16r4671 16rD3C8 16r4672 16rD3C9 16r4673 16rD3D0 16r4674 16rD3D8 16r4675 16rD3E1 16r4676 16rD3E3 16r4677 16rD3EC 16r4678 16rD3ED 16r4679 16rD3F0 16r467A 16rD3F4 16r467B 16rD3FC 16r467C 16rD3FD 16r467D 16rD3FF 16r467E 16rD401 16r4721 16rD408 16r4722 16rD41D 16r4723 16rD440 16r4724 16rD444 16r4725 16rD45C 16r4726 16rD460 16r4727 16rD464 16r4728 16rD46D 16r4729 16rD46F 16r472A 16rD478 16r472B 16rD479 16r472C 16rD47C 16r472D 16rD47F 16r472E 16rD480 16r472F 16rD482 16r4730 16rD488 16r4731 16rD489 16r4732 16rD48B 16r4733 16rD48D 16r4734 16rD494 16r4735 16rD4A9 16r4736 16rD4CC 16r4737 16rD4D0 16r4738 16rD4D4 16r4739 16rD4DC 16r473A 16rD4DF 16r473B 16rD4E8 16r473C 16rD4EC 16r473D 16rD4F0 16r473E 16rD4F8 16r473F 16rD4FB 16r4740 16rD4FD 16r4741 16rD504 16r4742 16rD508 16r4743 16rD50C 16r4744 16rD514 16r4745 16rD515 16r4746 16rD517 16r4747 16rD53C 16r4748 16rD53D 16r4749 16rD540 16r474A 16rD544 16r474B 16rD54C 16r474C 16rD54D 16r474D 16rD54F 16r474E 16rD551 16r474F 16rD558 16r4750 16rD559 16r4751 16rD55C 16r4752 16rD560 16r4753 16rD565 16r4754 16rD568 16r4755 16rD569 16r4756 16rD56B 16r4757 16rD56D 16r4758 16rD574 16r4759 16rD575 16r475A 16rD578 16r475B 16rD57C 16r475C 16rD584 16r475D 16rD585 16r475E 16rD587 16r475F 16rD588 16r4760 16rD589 16r4761 16rD590 16r4762 16rD5A5 16r4763 16rD5C8 16r4764 16rD5C9 16r4765 16rD5CC 16r4766 16rD5D0 16r4767 16rD5D2 16r4768 16rD5D8 16r4769 16rD5D9 16r476A 16rD5DB 16r476B 16rD5DD 16r476C 16rD5E4 16r476D 16rD5E5 16r476E 16rD5E8 16r476F 16rD5EC 16r4770 16rD5F4 16r4771 16rD5F5 16r4772 16rD5F7 16r4773 16rD5F9 16r4774 16rD600 16r4775 16rD601 16r4776 16rD604 16r4777 16rD608 16r4778 16rD610 16r4779 16rD611 16r477A 16rD613 16r477B 16rD614 16r477C 16rD615 16r477D 16rD61C 16r477E 16rD620 16r4821 16rD624 16r4822 16rD62D 16r4823 16rD638 16r4824 16rD639 16r4825 16rD63C 16r4826 16rD640 16r4827 16rD645 16r4828 16rD648 16r4829 16rD649 16r482A 16rD64B 16r482B 16rD64D 16r482C 16rD651 16r482D 16rD654 16r482E 16rD655 16r482F 16rD658 16r4830 16rD65C 16r4831 16rD667 16r4832 16rD669 16r4833 16rD670 16r4834 16rD671 16r4835 16rD674 16r4836 16rD683 16r4837 16rD685 16r4838 16rD68C 16r4839 16rD68D 16r483A 16rD690 16r483B 16rD694 16r483C 16rD69D 16r483D 16rD69F 16r483E 16rD6A1 16r483F 16rD6A8 16r4840 16rD6AC 16r4841 16rD6B0 16r4842 16rD6B9 16r4843 16rD6BB 16r4844 16rD6C4 16r4845 16rD6C5 16r4846 16rD6C8 16r4847 16rD6CC 16r4848 16rD6D1 16r4849 16rD6D4 16r484A 16rD6D7 16r484B 16rD6D9 16r484C 16rD6E0 16r484D 16rD6E4 16r484E 16rD6E8 16r484F 16rD6F0 16r4850 16rD6F5 16r4851 16rD6FC 16r4852 16rD6FD 16r4853 16rD700 16r4854 16rD704 16r4855 16rD711 16r4856 16rD718 16r4857 16rD719 16r4858 16rD71C 16r4859 16rD720 16r485A 16rD728 16r485B 16rD729 16r485C 16rD72B 16r485D 16rD72D 16r485E 16rD734 16r485F 16rD735 16r4860 16rD738 16r4861 16rD73C 16r4862 16rD744 16r4863 16rD747 16r4864 16rD749 16r4865 16rD750 16r4866 16rD751 16r4867 16rD754 16r4868 16rD756 16r4869 16rD757 16r486A 16rD758 16r486B 16rD759 16r486C 16rD760 16r486D 16rD761 16r486E 16rD763 16r486F 16rD765 16r4870 16rD769 16r4871 16rD76C 16r4872 16rD770 16r4873 16rD774 16r4874 16rD77C 16r4875 16rD77D 16r4876 16rD781 16r4877 16rD788 16r4878 16rD789 16r4879 16rD78C 16r487A 16rD790 16r487B 16rD798 16r487C 16rD799 16r487D 16rD79B 16r487E 16rD79D 16r4A21 16r4F3D 16r4A22 16r4F73 16r4A23 16r5047 16r4A24 16r50F9 16r4A25 16r52A0 16r4A26 16r53EF 16r4A27 16r5475 16r4A28 16r54E5 16r4A29 16r5609 16r4A2A 16r5AC1 16r4A2B 16r5BB6 16r4A2C 16r6687 16r4A2D 16r67B6 16r4A2E 16r67B7 16r4A2F 16r67EF 16r4A30 16r6B4C 16r4A31 16r73C2 16r4A32 16r75C2 16r4A33 16r7A3C 16r4A34 16r82DB 16r4A35 16r8304 16r4A36 16r8857 16r4A37 16r8888 16r4A38 16r8A36 16r4A39 16r8CC8 16r4A3A 16r8DCF 16r4A3B 16r8EFB 16r4A3C 16r8FE6 16r4A3D 16r99D5 16r4A3E 16r523B 16r4A3F 16r5374 16r4A40 16r5404 16r4A41 16r606A 16r4A42 16r6164 16r4A43 16r6BBC 16r4A44 16r73CF 16r4A45 16r811A 16r4A46 16r89BA 16r4A47 16r89D2 16r4A48 16r95A3 16r4A49 16r4F83 16r4A4A 16r520A 16r4A4B 16r58BE 16r4A4C 16r5978 16r4A4D 16r59E6 16r4A4E 16r5E72 16r4A4F 16r5E79 16r4A50 16r61C7 16r4A51 16r63C0 16r4A52 16r6746 16r4A53 16r67EC 16r4A54 16r687F 16r4A55 16r6F97 16r4A56 16r764E 16r4A57 16r770B 16r4A58 16r78F5 16r4A59 16r7A08 16r4A5A 16r7AFF 16r4A5B 16r7C21 16r4A5C 16r809D 16r4A5D 16r826E 16r4A5E 16r8271 16r4A5F 16r8AEB 16r4A60 16r9593 16r4A61 16r4E6B 16r4A62 16r559D 16r4A63 16r66F7 16r4A64 16r6E34 16r4A65 16r78A3 16r4A66 16r7AED 16r4A67 16r845B 16r4A68 16r8910 16r4A69 16r874E 16r4A6A 16r97A8 16r4A6B 16r52D8 16r4A6C 16r574E 16r4A6D 16r582A 16r4A6E 16r5D4C 16r4A6F 16r611F 16r4A70 16r61BE 16r4A71 16r6221 16r4A72 16r6562 16r4A73 16r67D1 16r4A74 16r6A44 16r4A75 16r6E1B 16r4A76 16r7518 16r4A77 16r75B3 16r4A78 16r76E3 16r4A79 16r77B0 16r4A7A 16r7D3A 16r4A7B 16r90AF 16r4A7C 16r9451 16r4A7D 16r9452 16r4A7E 16r9F95 16r4B21 16r5323 16r4B22 16r5CAC 16r4B23 16r7532 16r4B24 16r80DB 16r4B25 16r9240 16r4B26 16r9598 16r4B27 16r525B 16r4B28 16r5808 16r4B29 16r59DC 16r4B2A 16r5CA1 16r4B2B 16r5D17 16r4B2C 16r5EB7 16r4B2D 16r5F3A 16r4B2E 16r5F4A 16r4B2F 16r6177 16r4B30 16r6C5F 16r4B31 16r757A 16r4B32 16r7586 16r4B33 16r7CE0 16r4B34 16r7D73 16r4B35 16r7DB1 16r4B36 16r7F8C 16r4B37 16r8154 16r4B38 16r8221 16r4B39 16r8591 16r4B3A 16r8941 16r4B3B 16r8B1B 16r4B3C 16r92FC 16r4B3D 16r964D 16r4B3E 16r9C47 16r4B3F 16r4ECB 16r4B40 16r4EF7 16r4B41 16r500B 16r4B42 16r51F1 16r4B43 16r584F 16r4B44 16r6137 16r4B45 16r613E 16r4B46 16r6168 16r4B47 16r6539 16r4B48 16r69EA 16r4B49 16r6F11 16r4B4A 16r75A5 16r4B4B 16r7686 16r4B4C 16r76D6 16r4B4D 16r7B87 16r4B4E 16r82A5 16r4B4F 16r84CB 16r4B50 16rF900 16r4B51 16r93A7 16r4B52 16r958B 16r4B53 16r5580 16r4B54 16r5BA2 16r4B55 16r5751 16r4B56 16rF901 16r4B57 16r7CB3 16r4B58 16r7FB9 16r4B59 16r91B5 16r4B5A 16r5028 16r4B5B 16r53BB 16r4B5C 16r5C45 16r4B5D 16r5DE8 16r4B5E 16r62D2 16r4B5F 16r636E 16r4B60 16r64DA 16r4B61 16r64E7 16r4B62 16r6E20 16r4B63 16r70AC 16r4B64 16r795B 16r4B65 16r8DDD 16r4B66 16r8E1E 16r4B67 16rF902 16r4B68 16r907D 16r4B69 16r9245 16r4B6A 16r92F8 16r4B6B 16r4E7E 16r4B6C 16r4EF6 16r4B6D 16r5065 16r4B6E 16r5DFE 16r4B6F 16r5EFA 16r4B70 16r6106 16r4B71 16r6957 16r4B72 16r8171 16r4B73 16r8654 16r4B74 16r8E47 16r4B75 16r9375 16r4B76 16r9A2B 16r4B77 16r4E5E 16r4B78 16r5091 16r4B79 16r6770 16r4B7A 16r6840 16r4B7B 16r5109 16r4B7C 16r528D 16r4B7D 16r5292 16r4B7E 16r6AA2 16r4C21 16r77BC 16r4C22 16r9210 16r4C23 16r9ED4 16r4C24 16r52AB 16r4C25 16r602F 16r4C26 16r8FF2 16r4C27 16r5048 16r4C28 16r61A9 16r4C29 16r63ED 16r4C2A 16r64CA 16r4C2B 16r683C 16r4C2C 16r6A84 16r4C2D 16r6FC0 16r4C2E 16r8188 16r4C2F 16r89A1 16r4C30 16r9694 16r4C31 16r5805 16r4C32 16r727D 16r4C33 16r72AC 16r4C34 16r7504 16r4C35 16r7D79 16r4C36 16r7E6D 16r4C37 16r80A9 16r4C38 16r898B 16r4C39 16r8B74 16r4C3A 16r9063 16r4C3B 16r9D51 16r4C3C 16r6289 16r4C3D 16r6C7A 16r4C3E 16r6F54 16r4C3F 16r7D50 16r4C40 16r7F3A 16r4C41 16r8A23 16r4C42 16r517C 16r4C43 16r614A 16r4C44 16r7B9D 16r4C45 16r8B19 16r4C46 16r9257 16r4C47 16r938C 16r4C48 16r4EAC 16r4C49 16r4FD3 16r4C4A 16r501E 16r4C4B 16r50BE 16r4C4C 16r5106 16r4C4D 16r52C1 16r4C4E 16r52CD 16r4C4F 16r537F 16r4C50 16r5770 16r4C51 16r5883 16r4C52 16r5E9A 16r4C53 16r5F91 16r4C54 16r6176 16r4C55 16r61AC 16r4C56 16r64CE 16r4C57 16r656C 16r4C58 16r666F 16r4C59 16r66BB 16r4C5A 16r66F4 16r4C5B 16r6897 16r4C5C 16r6D87 16r4C5D 16r7085 16r4C5E 16r70F1 16r4C5F 16r749F 16r4C60 16r74A5 16r4C61 16r74CA 16r4C62 16r75D9 16r4C63 16r786C 16r4C64 16r78EC 16r4C65 16r7ADF 16r4C66 16r7AF6 16r4C67 16r7D45 16r4C68 16r7D93 16r4C69 16r8015 16r4C6A 16r803F 16r4C6B 16r811B 16r4C6C 16r8396 16r4C6D 16r8B66 16r4C6E 16r8F15 16r4C6F 16r9015 16r4C70 16r93E1 16r4C71 16r9803 16r4C72 16r9838 16r4C73 16r9A5A 16r4C74 16r9BE8 16r4C75 16r4FC2 16r4C76 16r5553 16r4C77 16r583A 16r4C78 16r5951 16r4C79 16r5B63 16r4C7A 16r5C46 16r4C7B 16r60B8 16r4C7C 16r6212 16r4C7D 16r6842 16r4C7E 16r68B0 16r4D21 16r68E8 16r4D22 16r6EAA 16r4D23 16r754C 16r4D24 16r7678 16r4D25 16r78CE 16r4D26 16r7A3D 16r4D27 16r7CFB 16r4D28 16r7E6B 16r4D29 16r7E7C 16r4D2A 16r8A08 16r4D2B 16r8AA1 16r4D2C 16r8C3F 16r4D2D 16r968E 16r4D2E 16r9DC4 16r4D2F 16r53E4 16r4D30 16r53E9 16r4D31 16r544A 16r4D32 16r5471 16r4D33 16r56FA 16r4D34 16r59D1 16r4D35 16r5B64 16r4D36 16r5C3B 16r4D37 16r5EAB 16r4D38 16r62F7 16r4D39 16r6537 16r4D3A 16r6545 16r4D3B 16r6572 16r4D3C 16r66A0 16r4D3D 16r67AF 16r4D3E 16r69C1 16r4D3F 16r6CBD 16r4D40 16r75FC 16r4D41 16r7690 16r4D42 16r777E 16r4D43 16r7A3F 16r4D44 16r7F94 16r4D45 16r8003 16r4D46 16r80A1 16r4D47 16r818F 16r4D48 16r82E6 16r4D49 16r82FD 16r4D4A 16r83F0 16r4D4B 16r85C1 16r4D4C 16r8831 16r4D4D 16r88B4 16r4D4E 16r8AA5 16r4D4F 16rF903 16r4D50 16r8F9C 16r4D51 16r932E 16r4D52 16r96C7 16r4D53 16r9867 16r4D54 16r9AD8 16r4D55 16r9F13 16r4D56 16r54ED 16r4D57 16r659B 16r4D58 16r66F2 16r4D59 16r688F 16r4D5A 16r7A40 16r4D5B 16r8C37 16r4D5C 16r9D60 16r4D5D 16r56F0 16r4D5E 16r5764 16r4D5F 16r5D11 16r4D60 16r6606 16r4D61 16r68B1 16r4D62 16r68CD 16r4D63 16r6EFE 16r4D64 16r7428 16r4D65 16r889E 16r4D66 16r9BE4 16r4D67 16r6C68 16r4D68 16rF904 16r4D69 16r9AA8 16r4D6A 16r4F9B 16r4D6B 16r516C 16r4D6C 16r5171 16r4D6D 16r529F 16r4D6E 16r5B54 16r4D6F 16r5DE5 16r4D70 16r6050 16r4D71 16r606D 16r4D72 16r62F1 16r4D73 16r63A7 16r4D74 16r653B 16r4D75 16r73D9 16r4D76 16r7A7A 16r4D77 16r86A3 16r4D78 16r8CA2 16r4D79 16r978F 16r4D7A 16r4E32 16r4D7B 16r5BE1 16r4D7C 16r6208 16r4D7D 16r679C 16r4D7E 16r74DC 16r4E21 16r79D1 16r4E22 16r83D3 16r4E23 16r8A87 16r4E24 16r8AB2 16r4E25 16r8DE8 16r4E26 16r904E 16r4E27 16r934B 16r4E28 16r9846 16r4E29 16r5ED3 16r4E2A 16r69E8 16r4E2B 16r85FF 16r4E2C 16r90ED 16r4E2D 16rF905 16r4E2E 16r51A0 16r4E2F 16r5B98 16r4E30 16r5BEC 16r4E31 16r6163 16r4E32 16r68FA 16r4E33 16r6B3E 16r4E34 16r704C 16r4E35 16r742F 16r4E36 16r74D8 16r4E37 16r7BA1 16r4E38 16r7F50 16r4E39 16r83C5 16r4E3A 16r89C0 16r4E3B 16r8CAB 16r4E3C 16r95DC 16r4E3D 16r9928 16r4E3E 16r522E 16r4E3F 16r605D 16r4E40 16r62EC 16r4E41 16r9002 16r4E42 16r4F8A 16r4E43 16r5149 16r4E44 16r5321 16r4E45 16r58D9 16r4E46 16r5EE3 16r4E47 16r66E0 16r4E48 16r6D38 16r4E49 16r709A 16r4E4A 16r72C2 16r4E4B 16r73D6 16r4E4C 16r7B50 16r4E4D 16r80F1 16r4E4E 16r945B 16r4E4F 16r5366 16r4E50 16r639B 16r4E51 16r7F6B 16r4E52 16r4E56 16r4E53 16r5080 16r4E54 16r584A 16r4E55 16r58DE 16r4E56 16r602A 16r4E57 16r6127 16r4E58 16r62D0 16r4E59 16r69D0 16r4E5A 16r9B41 16r4E5B 16r5B8F 16r4E5C 16r7D18 16r4E5D 16r80B1 16r4E5E 16r8F5F 16r4E5F 16r4EA4 16r4E60 16r50D1 16r4E61 16r54AC 16r4E62 16r55AC 16r4E63 16r5B0C 16r4E64 16r5DA0 16r4E65 16r5DE7 16r4E66 16r652A 16r4E67 16r654E 16r4E68 16r6821 16r4E69 16r6A4B 16r4E6A 16r72E1 16r4E6B 16r768E 16r4E6C 16r77EF 16r4E6D 16r7D5E 16r4E6E 16r7FF9 16r4E6F 16r81A0 16r4E70 16r854E 16r4E71 16r86DF 16r4E72 16r8F03 16r4E73 16r8F4E 16r4E74 16r90CA 16r4E75 16r9903 16r4E76 16r9A55 16r4E77 16r9BAB 16r4E78 16r4E18 16r4E79 16r4E45 16r4E7A 16r4E5D 16r4E7B 16r4EC7 16r4E7C 16r4FF1 16r4E7D 16r5177 16r4E7E 16r52FE 16r4F21 16r5340 16r4F22 16r53E3 16r4F23 16r53E5 16r4F24 16r548E 16r4F25 16r5614 16r4F26 16r5775 16r4F27 16r57A2 16r4F28 16r5BC7 16r4F29 16r5D87 16r4F2A 16r5ED0 16r4F2B 16r61FC 16r4F2C 16r62D8 16r4F2D 16r6551 16r4F2E 16r67B8 16r4F2F 16r67E9 16r4F30 16r69CB 16r4F31 16r6B50 16r4F32 16r6BC6 16r4F33 16r6BEC 16r4F34 16r6C42 16r4F35 16r6E9D 16r4F36 16r7078 16r4F37 16r72D7 16r4F38 16r7396 16r4F39 16r7403 16r4F3A 16r77BF 16r4F3B 16r77E9 16r4F3C 16r7A76 16r4F3D 16r7D7F 16r4F3E 16r8009 16r4F3F 16r81FC 16r4F40 16r8205 16r4F41 16r820A 16r4F42 16r82DF 16r4F43 16r8862 16r4F44 16r8B33 16r4F45 16r8CFC 16r4F46 16r8EC0 16r4F47 16r9011 16r4F48 16r90B1 16r4F49 16r9264 16r4F4A 16r92B6 16r4F4B 16r99D2 16r4F4C 16r9A45 16r4F4D 16r9CE9 16r4F4E 16r9DD7 16r4F4F 16r9F9C 16r4F50 16r570B 16r4F51 16r5C40 16r4F52 16r83CA 16r4F53 16r97A0 16r4F54 16r97AB 16r4F55 16r9EB4 16r4F56 16r541B 16r4F57 16r7A98 16r4F58 16r7FA4 16r4F59 16r88D9 16r4F5A 16r8ECD 16r4F5B 16r90E1 16r4F5C 16r5800 16r4F5D 16r5C48 16r4F5E 16r6398 16r4F5F 16r7A9F 16r4F60 16r5BAE 16r4F61 16r5F13 16r4F62 16r7A79 16r4F63 16r7AAE 16r4F64 16r828E 16r4F65 16r8EAC 16r4F66 16r5026 16r4F67 16r5238 16r4F68 16r52F8 16r4F69 16r5377 16r4F6A 16r5708 16r4F6B 16r62F3 16r4F6C 16r6372 16r4F6D 16r6B0A 16r4F6E 16r6DC3 16r4F6F 16r7737 16r4F70 16r53A5 16r4F71 16r7357 16r4F72 16r8568 16r4F73 16r8E76 16r4F74 16r95D5 16r4F75 16r673A 16r4F76 16r6AC3 16r4F77 16r6F70 16r4F78 16r8A6D 16r4F79 16r8ECC 16r4F7A 16r994B 16r4F7B 16rF906 16r4F7C 16r6677 16r4F7D 16r6B78 16r4F7E 16r8CB4 16r5021 16r9B3C 16r5022 16rF907 16r5023 16r53EB 16r5024 16r572D 16r5025 16r594E 16r5026 16r63C6 16r5027 16r69FB 16r5028 16r73EA 16r5029 16r7845 16r502A 16r7ABA 16r502B 16r7AC5 16r502C 16r7CFE 16r502D 16r8475 16r502E 16r898F 16r502F 16r8D73 16r5030 16r9035 16r5031 16r95A8 16r5032 16r52FB 16r5033 16r5747 16r5034 16r7547 16r5035 16r7B60 16r5036 16r83CC 16r5037 16r921E 16r5038 16rF908 16r5039 16r6A58 16r503A 16r514B 16r503B 16r524B 16r503C 16r5287 16r503D 16r621F 16r503E 16r68D8 16r503F 16r6975 16r5040 16r9699 16r5041 16r50C5 16r5042 16r52A4 16r5043 16r52E4 16r5044 16r61C3 16r5045 16r65A4 16r5046 16r6839 16r5047 16r69FF 16r5048 16r747E 16r5049 16r7B4B 16r504A 16r82B9 16r504B 16r83EB 16r504C 16r89B2 16r504D 16r8B39 16r504E 16r8FD1 16r504F 16r9949 16r5050 16rF909 16r5051 16r4ECA 16r5052 16r5997 16r5053 16r64D2 16r5054 16r6611 16r5055 16r6A8E 16r5056 16r7434 16r5057 16r7981 16r5058 16r79BD 16r5059 16r82A9 16r505A 16r887E 16r505B 16r887F 16r505C 16r895F 16r505D 16rF90A 16r505E 16r9326 16r505F 16r4F0B 16r5060 16r53CA 16r5061 16r6025 16r5062 16r6271 16r5063 16r6C72 16r5064 16r7D1A 16r5065 16r7D66 16r5066 16r4E98 16r5067 16r5162 16r5068 16r77DC 16r5069 16r80AF 16r506A 16r4F01 16r506B 16r4F0E 16r506C 16r5176 16r506D 16r5180 16r506E 16r55DC 16r506F 16r5668 16r5070 16r573B 16r5071 16r57FA 16r5072 16r57FC 16r5073 16r5914 16r5074 16r5947 16r5075 16r5993 16r5076 16r5BC4 16r5077 16r5C90 16r5078 16r5D0E 16r5079 16r5DF1 16r507A 16r5E7E 16r507B 16r5FCC 16r507C 16r6280 16r507D 16r65D7 16r507E 16r65E3 16r5121 16r671E 16r5122 16r671F 16r5123 16r675E 16r5124 16r68CB 16r5125 16r68C4 16r5126 16r6A5F 16r5127 16r6B3A 16r5128 16r6C23 16r5129 16r6C7D 16r512A 16r6C82 16r512B 16r6DC7 16r512C 16r7398 16r512D 16r7426 16r512E 16r742A 16r512F 16r7482 16r5130 16r74A3 16r5131 16r7578 16r5132 16r757F 16r5133 16r7881 16r5134 16r78EF 16r5135 16r7941 16r5136 16r7947 16r5137 16r7948 16r5138 16r797A 16r5139 16r7B95 16r513A 16r7D00 16r513B 16r7DBA 16r513C 16r7F88 16r513D 16r8006 16r513E 16r802D 16r513F 16r808C 16r5140 16r8A18 16r5141 16r8B4F 16r5142 16r8C48 16r5143 16r8D77 16r5144 16r9321 16r5145 16r9324 16r5146 16r98E2 16r5147 16r9951 16r5148 16r9A0E 16r5149 16r9A0F 16r514A 16r9A65 16r514B 16r9E92 16r514C 16r7DCA 16r514D 16r4F76 16r514E 16r5409 16r514F 16r62EE 16r5150 16r6854 16r5151 16r91D1 16r5152 16r55AB 16r5153 16r513A 16r5154 16rF90B 16r5155 16rF90C 16r5156 16r5A1C 16r5157 16r61E6 16r5158 16rF90D 16r5159 16r62CF 16r515A 16r62FF 16r515B 16rF90E 16r515C 16rF90F 16r515D 16rF910 16r515E 16rF911 16r515F 16rF912 16r5160 16rF913 16r5161 16r90A3 16r5162 16rF914 16r5163 16rF915 16r5164 16rF916 16r5165 16rF917 16r5166 16rF918 16r5167 16r8AFE 16r5168 16rF919 16r5169 16rF91A 16r516A 16rF91B 16r516B 16rF91C 16r516C 16r6696 16r516D 16rF91D 16r516E 16r7156 16r516F 16rF91E 16r5170 16rF91F 16r5171 16r96E3 16r5172 16rF920 16r5173 16r634F 16r5174 16r637A 16r5175 16r5357 16r5176 16rF921 16r5177 16r678F 16r5178 16r6960 16r5179 16r6E73 16r517A 16rF922 16r517B 16r7537 16r517C 16rF923 16r517D 16rF924 16r517E 16rF925 16r5221 16r7D0D 16r5222 16rF926 16r5223 16rF927 16r5224 16r8872 16r5225 16r56CA 16r5226 16r5A18 16r5227 16rF928 16r5228 16rF929 16r5229 16rF92A 16r522A 16rF92B 16r522B 16rF92C 16r522C 16r4E43 16r522D 16rF92D 16r522E 16r5167 16r522F 16r5948 16r5230 16r67F0 16r5231 16r8010 16r5232 16rF92E 16r5233 16r5973 16r5234 16r5E74 16r5235 16r649A 16r5236 16r79CA 16r5237 16r5FF5 16r5238 16r606C 16r5239 16r62C8 16r523A 16r637B 16r523B 16r5BE7 16r523C 16r5BD7 16r523D 16r52AA 16r523E 16rF92F 16r523F 16r5974 16r5240 16r5F29 16r5241 16r6012 16r5242 16rF930 16r5243 16rF931 16r5244 16rF932 16r5245 16r7459 16r5246 16rF933 16r5247 16rF934 16r5248 16rF935 16r5249 16rF936 16r524A 16rF937 16r524B 16rF938 16r524C 16r99D1 16r524D 16rF939 16r524E 16rF93A 16r524F 16rF93B 16r5250 16rF93C 16r5251 16rF93D 16r5252 16rF93E 16r5253 16rF93F 16r5254 16rF940 16r5255 16rF941 16r5256 16rF942 16r5257 16rF943 16r5258 16r6FC3 16r5259 16rF944 16r525A 16rF945 16r525B 16r81BF 16r525C 16r8FB2 16r525D 16r60F1 16r525E 16rF946 16r525F 16rF947 16r5260 16r8166 16r5261 16rF948 16r5262 16rF949 16r5263 16r5C3F 16r5264 16rF94A 16r5265 16rF94B 16r5266 16rF94C 16r5267 16rF94D 16r5268 16rF94E 16r5269 16rF94F 16r526A 16rF950 16r526B 16rF951 16r526C 16r5AE9 16r526D 16r8A25 16r526E 16r677B 16r526F 16r7D10 16r5270 16rF952 16r5271 16rF953 16r5272 16rF954 16r5273 16rF955 16r5274 16rF956 16r5275 16rF957 16r5276 16r80FD 16r5277 16rF958 16r5278 16rF959 16r5279 16r5C3C 16r527A 16r6CE5 16r527B 16r533F 16r527C 16r6EBA 16r527D 16r591A 16r527E 16r8336 16r5321 16r4E39 16r5322 16r4EB6 16r5323 16r4F46 16r5324 16r55AE 16r5325 16r5718 16r5326 16r58C7 16r5327 16r5F56 16r5328 16r65B7 16r5329 16r65E6 16r532A 16r6A80 16r532B 16r6BB5 16r532C 16r6E4D 16r532D 16r77ED 16r532E 16r7AEF 16r532F 16r7C1E 16r5330 16r7DDE 16r5331 16r86CB 16r5332 16r8892 16r5333 16r9132 16r5334 16r935B 16r5335 16r64BB 16r5336 16r6FBE 16r5337 16r737A 16r5338 16r75B8 16r5339 16r9054 16r533A 16r5556 16r533B 16r574D 16r533C 16r61BA 16r533D 16r64D4 16r533E 16r66C7 16r533F 16r6DE1 16r5340 16r6E5B 16r5341 16r6F6D 16r5342 16r6FB9 16r5343 16r75F0 16r5344 16r8043 16r5345 16r81BD 16r5346 16r8541 16r5347 16r8983 16r5348 16r8AC7 16r5349 16r8B5A 16r534A 16r931F 16r534B 16r6C93 16r534C 16r7553 16r534D 16r7B54 16r534E 16r8E0F 16r534F 16r905D 16r5350 16r5510 16r5351 16r5802 16r5352 16r5858 16r5353 16r5E62 16r5354 16r6207 16r5355 16r649E 16r5356 16r68E0 16r5357 16r7576 16r5358 16r7CD6 16r5359 16r87B3 16r535A 16r9EE8 16r535B 16r4EE3 16r535C 16r5788 16r535D 16r576E 16r535E 16r5927 16r535F 16r5C0D 16r5360 16r5CB1 16r5361 16r5E36 16r5362 16r5F85 16r5363 16r6234 16r5364 16r64E1 16r5365 16r73B3 16r5366 16r81FA 16r5367 16r888B 16r5368 16r8CB8 16r5369 16r968A 16r536A 16r9EDB 16r536B 16r5B85 16r536C 16r5FB7 16r536D 16r60B3 16r536E 16r5012 16r536F 16r5200 16r5370 16r5230 16r5371 16r5716 16r5372 16r5835 16r5373 16r5857 16r5374 16r5C0E 16r5375 16r5C60 16r5376 16r5CF6 16r5377 16r5D8B 16r5378 16r5EA6 16r5379 16r5F92 16r537A 16r60BC 16r537B 16r6311 16r537C 16r6389 16r537D 16r6417 16r537E 16r6843 16r5421 16r68F9 16r5422 16r6AC2 16r5423 16r6DD8 16r5424 16r6E21 16r5425 16r6ED4 16r5426 16r6FE4 16r5427 16r71FE 16r5428 16r76DC 16r5429 16r7779 16r542A 16r79B1 16r542B 16r7A3B 16r542C 16r8404 16r542D 16r89A9 16r542E 16r8CED 16r542F 16r8DF3 16r5430 16r8E48 16r5431 16r9003 16r5432 16r9014 16r5433 16r9053 16r5434 16r90FD 16r5435 16r934D 16r5436 16r9676 16r5437 16r97DC 16r5438 16r6BD2 16r5439 16r7006 16r543A 16r7258 16r543B 16r72A2 16r543C 16r7368 16r543D 16r7763 16r543E 16r79BF 16r543F 16r7BE4 16r5440 16r7E9B 16r5441 16r8B80 16r5442 16r58A9 16r5443 16r60C7 16r5444 16r6566 16r5445 16r65FD 16r5446 16r66BE 16r5447 16r6C8C 16r5448 16r711E 16r5449 16r71C9 16r544A 16r8C5A 16r544B 16r9813 16r544C 16r4E6D 16r544D 16r7A81 16r544E 16r4EDD 16r544F 16r51AC 16r5450 16r51CD 16r5451 16r52D5 16r5452 16r540C 16r5453 16r61A7 16r5454 16r6771 16r5455 16r6850 16r5456 16r68DF 16r5457 16r6D1E 16r5458 16r6F7C 16r5459 16r75BC 16r545A 16r77B3 16r545B 16r7AE5 16r545C 16r80F4 16r545D 16r8463 16r545E 16r9285 16r545F 16r515C 16r5460 16r6597 16r5461 16r675C 16r5462 16r6793 16r5463 16r75D8 16r5464 16r7AC7 16r5465 16r8373 16r5466 16rF95A 16r5467 16r8C46 16r5468 16r9017 16r5469 16r982D 16r546A 16r5C6F 16r546B 16r81C0 16r546C 16r829A 16r546D 16r9041 16r546E 16r906F 16r546F 16r920D 16r5470 16r5F97 16r5471 16r5D9D 16r5472 16r6A59 16r5473 16r71C8 16r5474 16r767B 16r5475 16r7B49 16r5476 16r85E4 16r5477 16r8B04 16r5478 16r9127 16r5479 16r9A30 16r547A 16r5587 16r547B 16r61F6 16r547C 16rF95B 16r547D 16r7669 16r547E 16r7F85 16r5521 16r863F 16r5522 16r87BA 16r5523 16r88F8 16r5524 16r908F 16r5525 16rF95C 16r5526 16r6D1B 16r5527 16r70D9 16r5528 16r73DE 16r5529 16r7D61 16r552A 16r843D 16r552B 16rF95D 16r552C 16r916A 16r552D 16r99F1 16r552E 16rF95E 16r552F 16r4E82 16r5530 16r5375 16r5531 16r6B04 16r5532 16r6B12 16r5533 16r703E 16r5534 16r721B 16r5535 16r862D 16r5536 16r9E1E 16r5537 16r524C 16r5538 16r8FA3 16r5539 16r5D50 16r553A 16r64E5 16r553B 16r652C 16r553C 16r6B16 16r553D 16r6FEB 16r553E 16r7C43 16r553F 16r7E9C 16r5540 16r85CD 16r5541 16r8964 16r5542 16r89BD 16r5543 16r62C9 16r5544 16r81D8 16r5545 16r881F 16r5546 16r5ECA 16r5547 16r6717 16r5548 16r6D6A 16r5549 16r72FC 16r554A 16r7405 16r554B 16r746F 16r554C 16r8782 16r554D 16r90DE 16r554E 16r4F86 16r554F 16r5D0D 16r5550 16r5FA0 16r5551 16r840A 16r5552 16r51B7 16r5553 16r63A0 16r5554 16r7565 16r5555 16r4EAE 16r5556 16r5006 16r5557 16r5169 16r5558 16r51C9 16r5559 16r6881 16r555A 16r6A11 16r555B 16r7CAE 16r555C 16r7CB1 16r555D 16r7CE7 16r555E 16r826F 16r555F 16r8AD2 16r5560 16r8F1B 16r5561 16r91CF 16r5562 16r4FB6 16r5563 16r5137 16r5564 16r52F5 16r5565 16r5442 16r5566 16r5EEC 16r5567 16r616E 16r5568 16r623E 16r5569 16r65C5 16r556A 16r6ADA 16r556B 16r6FFE 16r556C 16r792A 16r556D 16r85DC 16r556E 16r8823 16r556F 16r95AD 16r5570 16r9A62 16r5571 16r9A6A 16r5572 16r9E97 16r5573 16r9ECE 16r5574 16r529B 16r5575 16r66C6 16r5576 16r6B77 16r5577 16r701D 16r5578 16r792B 16r5579 16r8F62 16r557A 16r9742 16r557B 16r6190 16r557C 16r6200 16r557D 16r6523 16r557E 16r6F23 16r5621 16r7149 16r5622 16r7489 16r5623 16r7DF4 16r5624 16r806F 16r5625 16r84EE 16r5626 16r8F26 16r5627 16r9023 16r5628 16r934A 16r5629 16r51BD 16r562A 16r5217 16r562B 16r52A3 16r562C 16r6D0C 16r562D 16r70C8 16r562E 16r88C2 16r562F 16r5EC9 16r5630 16r6582 16r5631 16r6BAE 16r5632 16r6FC2 16r5633 16r7C3E 16r5634 16r7375 16r5635 16r4EE4 16r5636 16r4F36 16r5637 16r56F9 16r5638 16rF95F 16r5639 16r5CBA 16r563A 16r5DBA 16r563B 16r601C 16r563C 16r73B2 16r563D 16r7B2D 16r563E 16r7F9A 16r563F 16r7FCE 16r5640 16r8046 16r5641 16r901E 16r5642 16r9234 16r5643 16r96F6 16r5644 16r9748 16r5645 16r9818 16r5646 16r9F61 16r5647 16r4F8B 16r5648 16r6FA7 16r5649 16r79AE 16r564A 16r91B4 16r564B 16r96B7 16r564C 16r52DE 16r564D 16rF960 16r564E 16r6488 16r564F 16r64C4 16r5650 16r6AD3 16r5651 16r6F5E 16r5652 16r7018 16r5653 16r7210 16r5654 16r76E7 16r5655 16r8001 16r5656 16r8606 16r5657 16r865C 16r5658 16r8DEF 16r5659 16r8F05 16r565A 16r9732 16r565B 16r9B6F 16r565C 16r9DFA 16r565D 16r9E75 16r565E 16r788C 16r565F 16r797F 16r5660 16r7DA0 16r5661 16r83C9 16r5662 16r9304 16r5663 16r9E7F 16r5664 16r9E93 16r5665 16r8AD6 16r5666 16r58DF 16r5667 16r5F04 16r5668 16r6727 16r5669 16r7027 16r566A 16r74CF 16r566B 16r7C60 16r566C 16r807E 16r566D 16r5121 16r566E 16r7028 16r566F 16r7262 16r5670 16r78CA 16r5671 16r8CC2 16r5672 16r8CDA 16r5673 16r8CF4 16r5674 16r96F7 16r5675 16r4E86 16r5676 16r50DA 16r5677 16r5BEE 16r5678 16r5ED6 16r5679 16r6599 16r567A 16r71CE 16r567B 16r7642 16r567C 16r77AD 16r567D 16r804A 16r567E 16r84FC 16r5721 16r907C 16r5722 16r9B27 16r5723 16r9F8D 16r5724 16r58D8 16r5725 16r5A41 16r5726 16r5C62 16r5727 16r6A13 16r5728 16r6DDA 16r5729 16r6F0F 16r572A 16r763B 16r572B 16r7D2F 16r572C 16r7E37 16r572D 16r851E 16r572E 16r8938 16r572F 16r93E4 16r5730 16r964B 16r5731 16r5289 16r5732 16r65D2 16r5733 16r67F3 16r5734 16r69B4 16r5735 16r6D41 16r5736 16r6E9C 16r5737 16r700F 16r5738 16r7409 16r5739 16r7460 16r573A 16r7559 16r573B 16r7624 16r573C 16r786B 16r573D 16r8B2C 16r573E 16r985E 16r573F 16r516D 16r5740 16r622E 16r5741 16r9678 16r5742 16r4F96 16r5743 16r502B 16r5744 16r5D19 16r5745 16r6DEA 16r5746 16r7DB8 16r5747 16r8F2A 16r5748 16r5F8B 16r5749 16r6144 16r574A 16r6817 16r574B 16rF961 16r574C 16r9686 16r574D 16r52D2 16r574E 16r808B 16r574F 16r51DC 16r5750 16r51CC 16r5751 16r695E 16r5752 16r7A1C 16r5753 16r7DBE 16r5754 16r83F1 16r5755 16r9675 16r5756 16r4FDA 16r5757 16r5229 16r5758 16r5398 16r5759 16r540F 16r575A 16r550E 16r575B 16r5C65 16r575C 16r60A7 16r575D 16r674E 16r575E 16r68A8 16r575F 16r6D6C 16r5760 16r7281 16r5761 16r72F8 16r5762 16r7406 16r5763 16r7483 16r5764 16rF962 16r5765 16r75E2 16r5766 16r7C6C 16r5767 16r7F79 16r5768 16r7FB8 16r5769 16r8389 16r576A 16r88CF 16r576B 16r88E1 16r576C 16r91CC 16r576D 16r91D0 16r576E 16r96E2 16r576F 16r9BC9 16r5770 16r541D 16r5771 16r6F7E 16r5772 16r71D0 16r5773 16r7498 16r5774 16r85FA 16r5775 16r8EAA 16r5776 16r96A3 16r5777 16r9C57 16r5778 16r9E9F 16r5779 16r6797 16r577A 16r6DCB 16r577B 16r7433 16r577C 16r81E8 16r577D 16r9716 16r577E 16r782C 16r5821 16r7ACB 16r5822 16r7B20 16r5823 16r7C92 16r5824 16r6469 16r5825 16r746A 16r5826 16r75F2 16r5827 16r78BC 16r5828 16r78E8 16r5829 16r99AC 16r582A 16r9B54 16r582B 16r9EBB 16r582C 16r5BDE 16r582D 16r5E55 16r582E 16r6F20 16r582F 16r819C 16r5830 16r83AB 16r5831 16r9088 16r5832 16r4E07 16r5833 16r534D 16r5834 16r5A29 16r5835 16r5DD2 16r5836 16r5F4E 16r5837 16r6162 16r5838 16r633D 16r5839 16r6669 16r583A 16r66FC 16r583B 16r6EFF 16r583C 16r6F2B 16r583D 16r7063 16r583E 16r779E 16r583F 16r842C 16r5840 16r8513 16r5841 16r883B 16r5842 16r8F13 16r5843 16r9945 16r5844 16r9C3B 16r5845 16r551C 16r5846 16r62B9 16r5847 16r672B 16r5848 16r6CAB 16r5849 16r8309 16r584A 16r896A 16r584B 16r977A 16r584C 16r4EA1 16r584D 16r5984 16r584E 16r5FD8 16r584F 16r5FD9 16r5850 16r671B 16r5851 16r7DB2 16r5852 16r7F54 16r5853 16r8292 16r5854 16r832B 16r5855 16r83BD 16r5856 16r8F1E 16r5857 16r9099 16r5858 16r57CB 16r5859 16r59B9 16r585A 16r5A92 16r585B 16r5BD0 16r585C 16r6627 16r585D 16r679A 16r585E 16r6885 16r585F 16r6BCF 16r5860 16r7164 16r5861 16r7F75 16r5862 16r8CB7 16r5863 16r8CE3 16r5864 16r9081 16r5865 16r9B45 16r5866 16r8108 16r5867 16r8C8A 16r5868 16r964C 16r5869 16r9A40 16r586A 16r9EA5 16r586B 16r5B5F 16r586C 16r6C13 16r586D 16r731B 16r586E 16r76F2 16r586F 16r76DF 16r5870 16r840C 16r5871 16r51AA 16r5872 16r8993 16r5873 16r514D 16r5874 16r5195 16r5875 16r52C9 16r5876 16r68C9 16r5877 16r6C94 16r5878 16r7704 16r5879 16r7720 16r587A 16r7DBF 16r587B 16r7DEC 16r587C 16r9762 16r587D 16r9EB5 16r587E 16r6EC5 16r5921 16r8511 16r5922 16r51A5 16r5923 16r540D 16r5924 16r547D 16r5925 16r660E 16r5926 16r669D 16r5927 16r6927 16r5928 16r6E9F 16r5929 16r76BF 16r592A 16r7791 16r592B 16r8317 16r592C 16r84C2 16r592D 16r879F 16r592E 16r9169 16r592F 16r9298 16r5930 16r9CF4 16r5931 16r8882 16r5932 16r4FAE 16r5933 16r5192 16r5934 16r52DF 16r5935 16r59C6 16r5936 16r5E3D 16r5937 16r6155 16r5938 16r6478 16r5939 16r6479 16r593A 16r66AE 16r593B 16r67D0 16r593C 16r6A21 16r593D 16r6BCD 16r593E 16r6BDB 16r593F 16r725F 16r5940 16r7261 16r5941 16r7441 16r5942 16r7738 16r5943 16r77DB 16r5944 16r8017 16r5945 16r82BC 16r5946 16r8305 16r5947 16r8B00 16r5948 16r8B28 16r5949 16r8C8C 16r594A 16r6728 16r594B 16r6C90 16r594C 16r7267 16r594D 16r76EE 16r594E 16r7766 16r594F 16r7A46 16r5950 16r9DA9 16r5951 16r6B7F 16r5952 16r6C92 16r5953 16r5922 16r5954 16r6726 16r5955 16r8499 16r5956 16r536F 16r5957 16r5893 16r5958 16r5999 16r5959 16r5EDF 16r595A 16r63CF 16r595B 16r6634 16r595C 16r6773 16r595D 16r6E3A 16r595E 16r732B 16r595F 16r7AD7 16r5960 16r82D7 16r5961 16r9328 16r5962 16r52D9 16r5963 16r5DEB 16r5964 16r61AE 16r5965 16r61CB 16r5966 16r620A 16r5967 16r62C7 16r5968 16r64AB 16r5969 16r65E0 16r596A 16r6959 16r596B 16r6B66 16r596C 16r6BCB 16r596D 16r7121 16r596E 16r73F7 16r596F 16r755D 16r5970 16r7E46 16r5971 16r821E 16r5972 16r8302 16r5973 16r856A 16r5974 16r8AA3 16r5975 16r8CBF 16r5976 16r9727 16r5977 16r9D61 16r5978 16r58A8 16r5979 16r9ED8 16r597A 16r5011 16r597B 16r520E 16r597C 16r543B 16r597D 16r554F 16r597E 16r6587 16r5A21 16r6C76 16r5A22 16r7D0A 16r5A23 16r7D0B 16r5A24 16r805E 16r5A25 16r868A 16r5A26 16r9580 16r5A27 16r96EF 16r5A28 16r52FF 16r5A29 16r6C95 16r5A2A 16r7269 16r5A2B 16r5473 16r5A2C 16r5A9A 16r5A2D 16r5C3E 16r5A2E 16r5D4B 16r5A2F 16r5F4C 16r5A30 16r5FAE 16r5A31 16r672A 16r5A32 16r68B6 16r5A33 16r6963 16r5A34 16r6E3C 16r5A35 16r6E44 16r5A36 16r7709 16r5A37 16r7C73 16r5A38 16r7F8E 16r5A39 16r8587 16r5A3A 16r8B0E 16r5A3B 16r8FF7 16r5A3C 16r9761 16r5A3D 16r9EF4 16r5A3E 16r5CB7 16r5A3F 16r60B6 16r5A40 16r610D 16r5A41 16r61AB 16r5A42 16r654F 16r5A43 16r65FB 16r5A44 16r65FC 16r5A45 16r6C11 16r5A46 16r6CEF 16r5A47 16r739F 16r5A48 16r73C9 16r5A49 16r7DE1 16r5A4A 16r9594 16r5A4B 16r5BC6 16r5A4C 16r871C 16r5A4D 16r8B10 16r5A4E 16r525D 16r5A4F 16r535A 16r5A50 16r62CD 16r5A51 16r640F 16r5A52 16r64B2 16r5A53 16r6734 16r5A54 16r6A38 16r5A55 16r6CCA 16r5A56 16r73C0 16r5A57 16r749E 16r5A58 16r7B94 16r5A59 16r7C95 16r5A5A 16r7E1B 16r5A5B 16r818A 16r5A5C 16r8236 16r5A5D 16r8584 16r5A5E 16r8FEB 16r5A5F 16r96F9 16r5A60 16r99C1 16r5A61 16r4F34 16r5A62 16r534A 16r5A63 16r53CD 16r5A64 16r53DB 16r5A65 16r62CC 16r5A66 16r642C 16r5A67 16r6500 16r5A68 16r6591 16r5A69 16r69C3 16r5A6A 16r6CEE 16r5A6B 16r6F58 16r5A6C 16r73ED 16r5A6D 16r7554 16r5A6E 16r7622 16r5A6F 16r76E4 16r5A70 16r76FC 16r5A71 16r78D0 16r5A72 16r78FB 16r5A73 16r792C 16r5A74 16r7D46 16r5A75 16r822C 16r5A76 16r87E0 16r5A77 16r8FD4 16r5A78 16r9812 16r5A79 16r98EF 16r5A7A 16r52C3 16r5A7B 16r62D4 16r5A7C 16r64A5 16r5A7D 16r6E24 16r5A7E 16r6F51 16r5B21 16r767C 16r5B22 16r8DCB 16r5B23 16r91B1 16r5B24 16r9262 16r5B25 16r9AEE 16r5B26 16r9B43 16r5B27 16r5023 16r5B28 16r508D 16r5B29 16r574A 16r5B2A 16r59A8 16r5B2B 16r5C28 16r5B2C 16r5E47 16r5B2D 16r5F77 16r5B2E 16r623F 16r5B2F 16r653E 16r5B30 16r65B9 16r5B31 16r65C1 16r5B32 16r6609 16r5B33 16r678B 16r5B34 16r699C 16r5B35 16r6EC2 16r5B36 16r78C5 16r5B37 16r7D21 16r5B38 16r80AA 16r5B39 16r8180 16r5B3A 16r822B 16r5B3B 16r82B3 16r5B3C 16r84A1 16r5B3D 16r868C 16r5B3E 16r8A2A 16r5B3F 16r8B17 16r5B40 16r90A6 16r5B41 16r9632 16r5B42 16r9F90 16r5B43 16r500D 16r5B44 16r4FF3 16r5B45 16rF963 16r5B46 16r57F9 16r5B47 16r5F98 16r5B48 16r62DC 16r5B49 16r6392 16r5B4A 16r676F 16r5B4B 16r6E43 16r5B4C 16r7119 16r5B4D 16r76C3 16r5B4E 16r80CC 16r5B4F 16r80DA 16r5B50 16r88F4 16r5B51 16r88F5 16r5B52 16r8919 16r5B53 16r8CE0 16r5B54 16r8F29 16r5B55 16r914D 16r5B56 16r966A 16r5B57 16r4F2F 16r5B58 16r4F70 16r5B59 16r5E1B 16r5B5A 16r67CF 16r5B5B 16r6822 16r5B5C 16r767D 16r5B5D 16r767E 16r5B5E 16r9B44 16r5B5F 16r5E61 16r5B60 16r6A0A 16r5B61 16r7169 16r5B62 16r71D4 16r5B63 16r756A 16r5B64 16rF964 16r5B65 16r7E41 16r5B66 16r8543 16r5B67 16r85E9 16r5B68 16r98DC 16r5B69 16r4F10 16r5B6A 16r7B4F 16r5B6B 16r7F70 16r5B6C 16r95A5 16r5B6D 16r51E1 16r5B6E 16r5E06 16r5B6F 16r68B5 16r5B70 16r6C3E 16r5B71 16r6C4E 16r5B72 16r6CDB 16r5B73 16r72AF 16r5B74 16r7BC4 16r5B75 16r8303 16r5B76 16r6CD5 16r5B77 16r743A 16r5B78 16r50FB 16r5B79 16r5288 16r5B7A 16r58C1 16r5B7B 16r64D8 16r5B7C 16r6A97 16r5B7D 16r74A7 16r5B7E 16r7656 16r5C21 16r78A7 16r5C22 16r8617 16r5C23 16r95E2 16r5C24 16r9739 16r5C25 16rF965 16r5C26 16r535E 16r5C27 16r5F01 16r5C28 16r8B8A 16r5C29 16r8FA8 16r5C2A 16r8FAF 16r5C2B 16r908A 16r5C2C 16r5225 16r5C2D 16r77A5 16r5C2E 16r9C49 16r5C2F 16r9F08 16r5C30 16r4E19 16r5C31 16r5002 16r5C32 16r5175 16r5C33 16r5C5B 16r5C34 16r5E77 16r5C35 16r661E 16r5C36 16r663A 16r5C37 16r67C4 16r5C38 16r68C5 16r5C39 16r70B3 16r5C3A 16r7501 16r5C3B 16r75C5 16r5C3C 16r79C9 16r5C3D 16r7ADD 16r5C3E 16r8F27 16r5C3F 16r9920 16r5C40 16r9A08 16r5C41 16r4FDD 16r5C42 16r5821 16r5C43 16r5831 16r5C44 16r5BF6 16r5C45 16r666E 16r5C46 16r6B65 16r5C47 16r6D11 16r5C48 16r6E7A 16r5C49 16r6F7D 16r5C4A 16r73E4 16r5C4B 16r752B 16r5C4C 16r83E9 16r5C4D 16r88DC 16r5C4E 16r8913 16r5C4F 16r8B5C 16r5C50 16r8F14 16r5C51 16r4F0F 16r5C52 16r50D5 16r5C53 16r5310 16r5C54 16r535C 16r5C55 16r5B93 16r5C56 16r5FA9 16r5C57 16r670D 16r5C58 16r798F 16r5C59 16r8179 16r5C5A 16r832F 16r5C5B 16r8514 16r5C5C 16r8907 16r5C5D 16r8986 16r5C5E 16r8F39 16r5C5F 16r8F3B 16r5C60 16r99A5 16r5C61 16r9C12 16r5C62 16r672C 16r5C63 16r4E76 16r5C64 16r4FF8 16r5C65 16r5949 16r5C66 16r5C01 16r5C67 16r5CEF 16r5C68 16r5CF0 16r5C69 16r6367 16r5C6A 16r68D2 16r5C6B 16r70FD 16r5C6C 16r71A2 16r5C6D 16r742B 16r5C6E 16r7E2B 16r5C6F 16r84EC 16r5C70 16r8702 16r5C71 16r9022 16r5C72 16r92D2 16r5C73 16r9CF3 16r5C74 16r4E0D 16r5C75 16r4ED8 16r5C76 16r4FEF 16r5C77 16r5085 16r5C78 16r5256 16r5C79 16r526F 16r5C7A 16r5426 16r5C7B 16r5490 16r5C7C 16r57E0 16r5C7D 16r592B 16r5C7E 16r5A66 16r5D21 16r5B5A 16r5D22 16r5B75 16r5D23 16r5BCC 16r5D24 16r5E9C 16r5D25 16rF966 16r5D26 16r6276 16r5D27 16r6577 16r5D28 16r65A7 16r5D29 16r6D6E 16r5D2A 16r6EA5 16r5D2B 16r7236 16r5D2C 16r7B26 16r5D2D 16r7C3F 16r5D2E 16r7F36 16r5D2F 16r8150 16r5D30 16r8151 16r5D31 16r819A 16r5D32 16r8240 16r5D33 16r8299 16r5D34 16r83A9 16r5D35 16r8A03 16r5D36 16r8CA0 16r5D37 16r8CE6 16r5D38 16r8CFB 16r5D39 16r8D74 16r5D3A 16r8DBA 16r5D3B 16r90E8 16r5D3C 16r91DC 16r5D3D 16r961C 16r5D3E 16r9644 16r5D3F 16r99D9 16r5D40 16r9CE7 16r5D41 16r5317 16r5D42 16r5206 16r5D43 16r5429 16r5D44 16r5674 16r5D45 16r58B3 16r5D46 16r5954 16r5D47 16r596E 16r5D48 16r5FFF 16r5D49 16r61A4 16r5D4A 16r626E 16r5D4B 16r6610 16r5D4C 16r6C7E 16r5D4D 16r711A 16r5D4E 16r76C6 16r5D4F 16r7C89 16r5D50 16r7CDE 16r5D51 16r7D1B 16r5D52 16r82AC 16r5D53 16r8CC1 16r5D54 16r96F0 16r5D55 16rF967 16r5D56 16r4F5B 16r5D57 16r5F17 16r5D58 16r5F7F 16r5D59 16r62C2 16r5D5A 16r5D29 16r5D5B 16r670B 16r5D5C 16r68DA 16r5D5D 16r787C 16r5D5E 16r7E43 16r5D5F 16r9D6C 16r5D60 16r4E15 16r5D61 16r5099 16r5D62 16r5315 16r5D63 16r532A 16r5D64 16r5351 16r5D65 16r5983 16r5D66 16r5A62 16r5D67 16r5E87 16r5D68 16r60B2 16r5D69 16r618A 16r5D6A 16r6249 16r5D6B 16r6279 16r5D6C 16r6590 16r5D6D 16r6787 16r5D6E 16r69A7 16r5D6F 16r6BD4 16r5D70 16r6BD6 16r5D71 16r6BD7 16r5D72 16r6BD8 16r5D73 16r6CB8 16r5D74 16rF968 16r5D75 16r7435 16r5D76 16r75FA 16r5D77 16r7812 16r5D78 16r7891 16r5D79 16r79D5 16r5D7A 16r79D8 16r5D7B 16r7C83 16r5D7C 16r7DCB 16r5D7D 16r7FE1 16r5D7E 16r80A5 16r5E21 16r813E 16r5E22 16r81C2 16r5E23 16r83F2 16r5E24 16r871A 16r5E25 16r88E8 16r5E26 16r8AB9 16r5E27 16r8B6C 16r5E28 16r8CBB 16r5E29 16r9119 16r5E2A 16r975E 16r5E2B 16r98DB 16r5E2C 16r9F3B 16r5E2D 16r56AC 16r5E2E 16r5B2A 16r5E2F 16r5F6C 16r5E30 16r658C 16r5E31 16r6AB3 16r5E32 16r6BAF 16r5E33 16r6D5C 16r5E34 16r6FF1 16r5E35 16r7015 16r5E36 16r725D 16r5E37 16r73AD 16r5E38 16r8CA7 16r5E39 16r8CD3 16r5E3A 16r983B 16r5E3B 16r6191 16r5E3C 16r6C37 16r5E3D 16r8058 16r5E3E 16r9A01 16r5E3F 16r4E4D 16r5E40 16r4E8B 16r5E41 16r4E9B 16r5E42 16r4ED5 16r5E43 16r4F3A 16r5E44 16r4F3C 16r5E45 16r4F7F 16r5E46 16r4FDF 16r5E47 16r50FF 16r5E48 16r53F2 16r5E49 16r53F8 16r5E4A 16r5506 16r5E4B 16r55E3 16r5E4C 16r56DB 16r5E4D 16r58EB 16r5E4E 16r5962 16r5E4F 16r5A11 16r5E50 16r5BEB 16r5E51 16r5BFA 16r5E52 16r5C04 16r5E53 16r5DF3 16r5E54 16r5E2B 16r5E55 16r5F99 16r5E56 16r601D 16r5E57 16r6368 16r5E58 16r659C 16r5E59 16r65AF 16r5E5A 16r67F6 16r5E5B 16r67FB 16r5E5C 16r68AD 16r5E5D 16r6B7B 16r5E5E 16r6C99 16r5E5F 16r6CD7 16r5E60 16r6E23 16r5E61 16r7009 16r5E62 16r7345 16r5E63 16r7802 16r5E64 16r793E 16r5E65 16r7940 16r5E66 16r7960 16r5E67 16r79C1 16r5E68 16r7BE9 16r5E69 16r7D17 16r5E6A 16r7D72 16r5E6B 16r8086 16r5E6C 16r820D 16r5E6D 16r838E 16r5E6E 16r84D1 16r5E6F 16r86C7 16r5E70 16r88DF 16r5E71 16r8A50 16r5E72 16r8A5E 16r5E73 16r8B1D 16r5E74 16r8CDC 16r5E75 16r8D66 16r5E76 16r8FAD 16r5E77 16r90AA 16r5E78 16r98FC 16r5E79 16r99DF 16r5E7A 16r9E9D 16r5E7B 16r524A 16r5E7C 16rF969 16r5E7D 16r6714 16r5E7E 16rF96A 16r5F21 16r5098 16r5F22 16r522A 16r5F23 16r5C71 16r5F24 16r6563 16r5F25 16r6C55 16r5F26 16r73CA 16r5F27 16r7523 16r5F28 16r759D 16r5F29 16r7B97 16r5F2A 16r849C 16r5F2B 16r9178 16r5F2C 16r9730 16r5F2D 16r4E77 16r5F2E 16r6492 16r5F2F 16r6BBA 16r5F30 16r715E 16r5F31 16r85A9 16r5F32 16r4E09 16r5F33 16rF96B 16r5F34 16r6749 16r5F35 16r68EE 16r5F36 16r6E17 16r5F37 16r829F 16r5F38 16r8518 16r5F39 16r886B 16r5F3A 16r63F7 16r5F3B 16r6F81 16r5F3C 16r9212 16r5F3D 16r98AF 16r5F3E 16r4E0A 16r5F3F 16r50B7 16r5F40 16r50CF 16r5F41 16r511F 16r5F42 16r5546 16r5F43 16r55AA 16r5F44 16r5617 16r5F45 16r5B40 16r5F46 16r5C19 16r5F47 16r5CE0 16r5F48 16r5E38 16r5F49 16r5E8A 16r5F4A 16r5EA0 16r5F4B 16r5EC2 16r5F4C 16r60F3 16r5F4D 16r6851 16r5F4E 16r6A61 16r5F4F 16r6E58 16r5F50 16r723D 16r5F51 16r7240 16r5F52 16r72C0 16r5F53 16r76F8 16r5F54 16r7965 16r5F55 16r7BB1 16r5F56 16r7FD4 16r5F57 16r88F3 16r5F58 16r89F4 16r5F59 16r8A73 16r5F5A 16r8C61 16r5F5B 16r8CDE 16r5F5C 16r971C 16r5F5D 16r585E 16r5F5E 16r74BD 16r5F5F 16r8CFD 16r5F60 16r55C7 16r5F61 16rF96C 16r5F62 16r7A61 16r5F63 16r7D22 16r5F64 16r8272 16r5F65 16r7272 16r5F66 16r751F 16r5F67 16r7525 16r5F68 16rF96D 16r5F69 16r7B19 16r5F6A 16r5885 16r5F6B 16r58FB 16r5F6C 16r5DBC 16r5F6D 16r5E8F 16r5F6E 16r5EB6 16r5F6F 16r5F90 16r5F70 16r6055 16r5F71 16r6292 16r5F72 16r637F 16r5F73 16r654D 16r5F74 16r6691 16r5F75 16r66D9 16r5F76 16r66F8 16r5F77 16r6816 16r5F78 16r68F2 16r5F79 16r7280 16r5F7A 16r745E 16r5F7B 16r7B6E 16r5F7C 16r7D6E 16r5F7D 16r7DD6 16r5F7E 16r7F72 16r6021 16r80E5 16r6022 16r8212 16r6023 16r85AF 16r6024 16r897F 16r6025 16r8A93 16r6026 16r901D 16r6027 16r92E4 16r6028 16r9ECD 16r6029 16r9F20 16r602A 16r5915 16r602B 16r596D 16r602C 16r5E2D 16r602D 16r60DC 16r602E 16r6614 16r602F 16r6673 16r6030 16r6790 16r6031 16r6C50 16r6032 16r6DC5 16r6033 16r6F5F 16r6034 16r77F3 16r6035 16r78A9 16r6036 16r84C6 16r6037 16r91CB 16r6038 16r932B 16r6039 16r4ED9 16r603A 16r50CA 16r603B 16r5148 16r603C 16r5584 16r603D 16r5B0B 16r603E 16r5BA3 16r603F 16r6247 16r6040 16r657E 16r6041 16r65CB 16r6042 16r6E32 16r6043 16r717D 16r6044 16r7401 16r6045 16r7444 16r6046 16r7487 16r6047 16r74BF 16r6048 16r766C 16r6049 16r79AA 16r604A 16r7DDA 16r604B 16r7E55 16r604C 16r7FA8 16r604D 16r817A 16r604E 16r81B3 16r604F 16r8239 16r6050 16r861A 16r6051 16r87EC 16r6052 16r8A75 16r6053 16r8DE3 16r6054 16r9078 16r6055 16r9291 16r6056 16r9425 16r6057 16r994D 16r6058 16r9BAE 16r6059 16r5368 16r605A 16r5C51 16r605B 16r6954 16r605C 16r6CC4 16r605D 16r6D29 16r605E 16r6E2B 16r605F 16r820C 16r6060 16r859B 16r6061 16r893B 16r6062 16r8A2D 16r6063 16r8AAA 16r6064 16r96EA 16r6065 16r9F67 16r6066 16r5261 16r6067 16r66B9 16r6068 16r6BB2 16r6069 16r7E96 16r606A 16r87FE 16r606B 16r8D0D 16r606C 16r9583 16r606D 16r965D 16r606E 16r651D 16r606F 16r6D89 16r6070 16r71EE 16r6071 16rF96E 16r6072 16r57CE 16r6073 16r59D3 16r6074 16r5BAC 16r6075 16r6027 16r6076 16r60FA 16r6077 16r6210 16r6078 16r661F 16r6079 16r665F 16r607A 16r7329 16r607B 16r73F9 16r607C 16r76DB 16r607D 16r7701 16r607E 16r7B6C 16r6121 16r8056 16r6122 16r8072 16r6123 16r8165 16r6124 16r8AA0 16r6125 16r9192 16r6126 16r4E16 16r6127 16r52E2 16r6128 16r6B72 16r6129 16r6D17 16r612A 16r7A05 16r612B 16r7B39 16r612C 16r7D30 16r612D 16rF96F 16r612E 16r8CB0 16r612F 16r53EC 16r6130 16r562F 16r6131 16r5851 16r6132 16r5BB5 16r6133 16r5C0F 16r6134 16r5C11 16r6135 16r5DE2 16r6136 16r6240 16r6137 16r6383 16r6138 16r6414 16r6139 16r662D 16r613A 16r68B3 16r613B 16r6CBC 16r613C 16r6D88 16r613D 16r6EAF 16r613E 16r701F 16r613F 16r70A4 16r6140 16r71D2 16r6141 16r7526 16r6142 16r758F 16r6143 16r758E 16r6144 16r7619 16r6145 16r7B11 16r6146 16r7BE0 16r6147 16r7C2B 16r6148 16r7D20 16r6149 16r7D39 16r614A 16r852C 16r614B 16r856D 16r614C 16r8607 16r614D 16r8A34 16r614E 16r900D 16r614F 16r9061 16r6150 16r90B5 16r6151 16r92B7 16r6152 16r97F6 16r6153 16r9A37 16r6154 16r4FD7 16r6155 16r5C6C 16r6156 16r675F 16r6157 16r6D91 16r6158 16r7C9F 16r6159 16r7E8C 16r615A 16r8B16 16r615B 16r8D16 16r615C 16r901F 16r615D 16r5B6B 16r615E 16r5DFD 16r615F 16r640D 16r6160 16r84C0 16r6161 16r905C 16r6162 16r98E1 16r6163 16r7387 16r6164 16r5B8B 16r6165 16r609A 16r6166 16r677E 16r6167 16r6DDE 16r6168 16r8A1F 16r6169 16r8AA6 16r616A 16r9001 16r616B 16r980C 16r616C 16r5237 16r616D 16rF970 16r616E 16r7051 16r616F 16r788E 16r6170 16r9396 16r6171 16r8870 16r6172 16r91D7 16r6173 16r4FEE 16r6174 16r53D7 16r6175 16r55FD 16r6176 16r56DA 16r6177 16r5782 16r6178 16r58FD 16r6179 16r5AC2 16r617A 16r5B88 16r617B 16r5CAB 16r617C 16r5CC0 16r617D 16r5E25 16r617E 16r6101 16r6221 16r620D 16r6222 16r624B 16r6223 16r6388 16r6224 16r641C 16r6225 16r6536 16r6226 16r6578 16r6227 16r6A39 16r6228 16r6B8A 16r6229 16r6C34 16r622A 16r6D19 16r622B 16r6F31 16r622C 16r71E7 16r622D 16r72E9 16r622E 16r7378 16r622F 16r7407 16r6230 16r74B2 16r6231 16r7626 16r6232 16r7761 16r6233 16r79C0 16r6234 16r7A57 16r6235 16r7AEA 16r6236 16r7CB9 16r6237 16r7D8F 16r6238 16r7DAC 16r6239 16r7E61 16r623A 16r7F9E 16r623B 16r8129 16r623C 16r8331 16r623D 16r8490 16r623E 16r84DA 16r623F 16r85EA 16r6240 16r8896 16r6241 16r8AB0 16r6242 16r8B90 16r6243 16r8F38 16r6244 16r9042 16r6245 16r9083 16r6246 16r916C 16r6247 16r9296 16r6248 16r92B9 16r6249 16r968B 16r624A 16r96A7 16r624B 16r96A8 16r624C 16r96D6 16r624D 16r9700 16r624E 16r9808 16r624F 16r9996 16r6250 16r9AD3 16r6251 16r9B1A 16r6252 16r53D4 16r6253 16r587E 16r6254 16r5919 16r6255 16r5B70 16r6256 16r5BBF 16r6257 16r6DD1 16r6258 16r6F5A 16r6259 16r719F 16r625A 16r7421 16r625B 16r74B9 16r625C 16r8085 16r625D 16r83FD 16r625E 16r5DE1 16r625F 16r5F87 16r6260 16r5FAA 16r6261 16r6042 16r6262 16r65EC 16r6263 16r6812 16r6264 16r696F 16r6265 16r6A53 16r6266 16r6B89 16r6267 16r6D35 16r6268 16r6DF3 16r6269 16r73E3 16r626A 16r76FE 16r626B 16r77AC 16r626C 16r7B4D 16r626D 16r7D14 16r626E 16r8123 16r626F 16r821C 16r6270 16r8340 16r6271 16r84F4 16r6272 16r8563 16r6273 16r8A62 16r6274 16r8AC4 16r6275 16r9187 16r6276 16r931E 16r6277 16r9806 16r6278 16r99B4 16r6279 16r620C 16r627A 16r8853 16r627B 16r8FF0 16r627C 16r9265 16r627D 16r5D07 16r627E 16r5D27 16r6321 16r5D69 16r6322 16r745F 16r6323 16r819D 16r6324 16r8768 16r6325 16r6FD5 16r6326 16r62FE 16r6327 16r7FD2 16r6328 16r8936 16r6329 16r8972 16r632A 16r4E1E 16r632B 16r4E58 16r632C 16r50E7 16r632D 16r52DD 16r632E 16r5347 16r632F 16r627F 16r6330 16r6607 16r6331 16r7E69 16r6332 16r8805 16r6333 16r965E 16r6334 16r4F8D 16r6335 16r5319 16r6336 16r5636 16r6337 16r59CB 16r6338 16r5AA4 16r6339 16r5C38 16r633A 16r5C4E 16r633B 16r5C4D 16r633C 16r5E02 16r633D 16r5F11 16r633E 16r6043 16r633F 16r65BD 16r6340 16r662F 16r6341 16r6642 16r6342 16r67BE 16r6343 16r67F4 16r6344 16r731C 16r6345 16r77E2 16r6346 16r793A 16r6347 16r7FC5 16r6348 16r8494 16r6349 16r84CD 16r634A 16r8996 16r634B 16r8A66 16r634C 16r8A69 16r634D 16r8AE1 16r634E 16r8C55 16r634F 16r8C7A 16r6350 16r57F4 16r6351 16r5BD4 16r6352 16r5F0F 16r6353 16r606F 16r6354 16r62ED 16r6355 16r690D 16r6356 16r6B96 16r6357 16r6E5C 16r6358 16r7184 16r6359 16r7BD2 16r635A 16r8755 16r635B 16r8B58 16r635C 16r8EFE 16r635D 16r98DF 16r635E 16r98FE 16r635F 16r4F38 16r6360 16r4F81 16r6361 16r4FE1 16r6362 16r547B 16r6363 16r5A20 16r6364 16r5BB8 16r6365 16r613C 16r6366 16r65B0 16r6367 16r6668 16r6368 16r71FC 16r6369 16r7533 16r636A 16r795E 16r636B 16r7D33 16r636C 16r814E 16r636D 16r81E3 16r636E 16r8398 16r636F 16r85AA 16r6370 16r85CE 16r6371 16r8703 16r6372 16r8A0A 16r6373 16r8EAB 16r6374 16r8F9B 16r6375 16rF971 16r6376 16r8FC5 16r6377 16r5931 16r6378 16r5BA4 16r6379 16r5BE6 16r637A 16r6089 16r637B 16r5BE9 16r637C 16r5C0B 16r637D 16r5FC3 16r637E 16r6C81 16r6421 16rF972 16r6422 16r6DF1 16r6423 16r700B 16r6424 16r751A 16r6425 16r82AF 16r6426 16r8AF6 16r6427 16r4EC0 16r6428 16r5341 16r6429 16rF973 16r642A 16r96D9 16r642B 16r6C0F 16r642C 16r4E9E 16r642D 16r4FC4 16r642E 16r5152 16r642F 16r555E 16r6430 16r5A25 16r6431 16r5CE8 16r6432 16r6211 16r6433 16r7259 16r6434 16r82BD 16r6435 16r83AA 16r6436 16r86FE 16r6437 16r8859 16r6438 16r8A1D 16r6439 16r963F 16r643A 16r96C5 16r643B 16r9913 16r643C 16r9D09 16r643D 16r9D5D 16r643E 16r580A 16r643F 16r5CB3 16r6440 16r5DBD 16r6441 16r5E44 16r6442 16r60E1 16r6443 16r6115 16r6444 16r63E1 16r6445 16r6A02 16r6446 16r6E25 16r6447 16r9102 16r6448 16r9354 16r6449 16r984E 16r644A 16r9C10 16r644B 16r9F77 16r644C 16r5B89 16r644D 16r5CB8 16r644E 16r6309 16r644F 16r664F 16r6450 16r6848 16r6451 16r773C 16r6452 16r96C1 16r6453 16r978D 16r6454 16r9854 16r6455 16r9B9F 16r6456 16r65A1 16r6457 16r8B01 16r6458 16r8ECB 16r6459 16r95BC 16r645A 16r5535 16r645B 16r5CA9 16r645C 16r5DD6 16r645D 16r5EB5 16r645E 16r6697 16r645F 16r764C 16r6460 16r83F4 16r6461 16r95C7 16r6462 16r58D3 16r6463 16r62BC 16r6464 16r72CE 16r6465 16r9D28 16r6466 16r4EF0 16r6467 16r592E 16r6468 16r600F 16r6469 16r663B 16r646A 16r6B83 16r646B 16r79E7 16r646C 16r9D26 16r646D 16r5393 16r646E 16r54C0 16r646F 16r57C3 16r6470 16r5D16 16r6471 16r611B 16r6472 16r66D6 16r6473 16r6DAF 16r6474 16r788D 16r6475 16r827E 16r6476 16r9698 16r6477 16r9744 16r6478 16r5384 16r6479 16r627C 16r647A 16r6396 16r647B 16r6DB2 16r647C 16r7E0A 16r647D 16r814B 16r647E 16r984D 16r6521 16r6AFB 16r6522 16r7F4C 16r6523 16r9DAF 16r6524 16r9E1A 16r6525 16r4E5F 16r6526 16r503B 16r6527 16r51B6 16r6528 16r591C 16r6529 16r60F9 16r652A 16r63F6 16r652B 16r6930 16r652C 16r723A 16r652D 16r8036 16r652E 16rF974 16r652F 16r91CE 16r6530 16r5F31 16r6531 16rF975 16r6532 16rF976 16r6533 16r7D04 16r6534 16r82E5 16r6535 16r846F 16r6536 16r84BB 16r6537 16r85E5 16r6538 16r8E8D 16r6539 16rF977 16r653A 16r4F6F 16r653B 16rF978 16r653C 16rF979 16r653D 16r58E4 16r653E 16r5B43 16r653F 16r6059 16r6540 16r63DA 16r6541 16r6518 16r6542 16r656D 16r6543 16r6698 16r6544 16rF97A 16r6545 16r694A 16r6546 16r6A23 16r6547 16r6D0B 16r6548 16r7001 16r6549 16r716C 16r654A 16r75D2 16r654B 16r760D 16r654C 16r79B3 16r654D 16r7A70 16r654E 16rF97B 16r654F 16r7F8A 16r6550 16rF97C 16r6551 16r8944 16r6552 16rF97D 16r6553 16r8B93 16r6554 16r91C0 16r6555 16r967D 16r6556 16rF97E 16r6557 16r990A 16r6558 16r5704 16r6559 16r5FA1 16r655A 16r65BC 16r655B 16r6F01 16r655C 16r7600 16r655D 16r79A6 16r655E 16r8A9E 16r655F 16r99AD 16r6560 16r9B5A 16r6561 16r9F6C 16r6562 16r5104 16r6563 16r61B6 16r6564 16r6291 16r6565 16r6A8D 16r6566 16r81C6 16r6567 16r5043 16r6568 16r5830 16r6569 16r5F66 16r656A 16r7109 16r656B 16r8A00 16r656C 16r8AFA 16r656D 16r5B7C 16r656E 16r8616 16r656F 16r4FFA 16r6570 16r513C 16r6571 16r56B4 16r6572 16r5944 16r6573 16r63A9 16r6574 16r6DF9 16r6575 16r5DAA 16r6576 16r696D 16r6577 16r5186 16r6578 16r4E88 16r6579 16r4F59 16r657A 16rF97F 16r657B 16rF980 16r657C 16rF981 16r657D 16r5982 16r657E 16rF982 16r6621 16rF983 16r6622 16r6B5F 16r6623 16r6C5D 16r6624 16rF984 16r6625 16r74B5 16r6626 16r7916 16r6627 16rF985 16r6628 16r8207 16r6629 16r8245 16r662A 16r8339 16r662B 16r8F3F 16r662C 16r8F5D 16r662D 16rF986 16r662E 16r9918 16r662F 16rF987 16r6630 16rF988 16r6631 16rF989 16r6632 16r4EA6 16r6633 16rF98A 16r6634 16r57DF 16r6635 16r5F79 16r6636 16r6613 16r6637 16rF98B 16r6638 16rF98C 16r6639 16r75AB 16r663A 16r7E79 16r663B 16r8B6F 16r663C 16rF98D 16r663D 16r9006 16r663E 16r9A5B 16r663F 16r56A5 16r6640 16r5827 16r6641 16r59F8 16r6642 16r5A1F 16r6643 16r5BB4 16r6644 16rF98E 16r6645 16r5EF6 16r6646 16rF98F 16r6647 16rF990 16r6648 16r6350 16r6649 16r633B 16r664A 16rF991 16r664B 16r693D 16r664C 16r6C87 16r664D 16r6CBF 16r664E 16r6D8E 16r664F 16r6D93 16r6650 16r6DF5 16r6651 16r6F14 16r6652 16rF992 16r6653 16r70DF 16r6654 16r7136 16r6655 16r7159 16r6656 16rF993 16r6657 16r71C3 16r6658 16r71D5 16r6659 16rF994 16r665A 16r784F 16r665B 16r786F 16r665C 16rF995 16r665D 16r7B75 16r665E 16r7DE3 16r665F 16rF996 16r6660 16r7E2F 16r6661 16rF997 16r6662 16r884D 16r6663 16r8EDF 16r6664 16rF998 16r6665 16rF999 16r6666 16rF99A 16r6667 16r925B 16r6668 16rF99B 16r6669 16r9CF6 16r666A 16rF99C 16r666B 16rF99D 16r666C 16rF99E 16r666D 16r6085 16r666E 16r6D85 16r666F 16rF99F 16r6670 16r71B1 16r6671 16rF9A0 16r6672 16rF9A1 16r6673 16r95B1 16r6674 16r53AD 16r6675 16rF9A2 16r6676 16rF9A3 16r6677 16rF9A4 16r6678 16r67D3 16r6679 16rF9A5 16r667A 16r708E 16r667B 16r7130 16r667C 16r7430 16r667D 16r8276 16r667E 16r82D2 16r6721 16rF9A6 16r6722 16r95BB 16r6723 16r9AE5 16r6724 16r9E7D 16r6725 16r66C4 16r6726 16rF9A7 16r6727 16r71C1 16r6728 16r8449 16r6729 16rF9A8 16r672A 16rF9A9 16r672B 16r584B 16r672C 16rF9AA 16r672D 16rF9AB 16r672E 16r5DB8 16r672F 16r5F71 16r6730 16rF9AC 16r6731 16r6620 16r6732 16r668E 16r6733 16r6979 16r6734 16r69AE 16r6735 16r6C38 16r6736 16r6CF3 16r6737 16r6E36 16r6738 16r6F41 16r6739 16r6FDA 16r673A 16r701B 16r673B 16r702F 16r673C 16r7150 16r673D 16r71DF 16r673E 16r7370 16r673F 16rF9AD 16r6740 16r745B 16r6741 16rF9AE 16r6742 16r74D4 16r6743 16r76C8 16r6744 16r7A4E 16r6745 16r7E93 16r6746 16rF9AF 16r6747 16rF9B0 16r6748 16r82F1 16r6749 16r8A60 16r674A 16r8FCE 16r674B 16rF9B1 16r674C 16r9348 16r674D 16rF9B2 16r674E 16r9719 16r674F 16rF9B3 16r6750 16rF9B4 16r6751 16r4E42 16r6752 16r502A 16r6753 16rF9B5 16r6754 16r5208 16r6755 16r53E1 16r6756 16r66F3 16r6757 16r6C6D 16r6758 16r6FCA 16r6759 16r730A 16r675A 16r777F 16r675B 16r7A62 16r675C 16r82AE 16r675D 16r85DD 16r675E 16r8602 16r675F 16rF9B6 16r6760 16r88D4 16r6761 16r8A63 16r6762 16r8B7D 16r6763 16r8C6B 16r6764 16rF9B7 16r6765 16r92B3 16r6766 16rF9B8 16r6767 16r9713 16r6768 16r9810 16r6769 16r4E94 16r676A 16r4F0D 16r676B 16r4FC9 16r676C 16r50B2 16r676D 16r5348 16r676E 16r543E 16r676F 16r5433 16r6770 16r55DA 16r6771 16r5862 16r6772 16r58BA 16r6773 16r5967 16r6774 16r5A1B 16r6775 16r5BE4 16r6776 16r609F 16r6777 16rF9B9 16r6778 16r61CA 16r6779 16r6556 16r677A 16r65FF 16r677B 16r6664 16r677C 16r68A7 16r677D 16r6C5A 16r677E 16r6FB3 16r6821 16r70CF 16r6822 16r71AC 16r6823 16r7352 16r6824 16r7B7D 16r6825 16r8708 16r6826 16r8AA4 16r6827 16r9C32 16r6828 16r9F07 16r6829 16r5C4B 16r682A 16r6C83 16r682B 16r7344 16r682C 16r7389 16r682D 16r923A 16r682E 16r6EAB 16r682F 16r7465 16r6830 16r761F 16r6831 16r7A69 16r6832 16r7E15 16r6833 16r860A 16r6834 16r5140 16r6835 16r58C5 16r6836 16r64C1 16r6837 16r74EE 16r6838 16r7515 16r6839 16r7670 16r683A 16r7FC1 16r683B 16r9095 16r683C 16r96CD 16r683D 16r9954 16r683E 16r6E26 16r683F 16r74E6 16r6840 16r7AA9 16r6841 16r7AAA 16r6842 16r81E5 16r6843 16r86D9 16r6844 16r8778 16r6845 16r8A1B 16r6846 16r5A49 16r6847 16r5B8C 16r6848 16r5B9B 16r6849 16r68A1 16r684A 16r6900 16r684B 16r6D63 16r684C 16r73A9 16r684D 16r7413 16r684E 16r742C 16r684F 16r7897 16r6850 16r7DE9 16r6851 16r7FEB 16r6852 16r8118 16r6853 16r8155 16r6854 16r839E 16r6855 16r8C4C 16r6856 16r962E 16r6857 16r9811 16r6858 16r66F0 16r6859 16r5F80 16r685A 16r65FA 16r685B 16r6789 16r685C 16r6C6A 16r685D 16r738B 16r685E 16r502D 16r685F 16r5A03 16r6860 16r6B6A 16r6861 16r77EE 16r6862 16r5916 16r6863 16r5D6C 16r6864 16r5DCD 16r6865 16r7325 16r6866 16r754F 16r6867 16rF9BA 16r6868 16rF9BB 16r6869 16r50E5 16r686A 16r51F9 16r686B 16r582F 16r686C 16r592D 16r686D 16r5996 16r686E 16r59DA 16r686F 16r5BE5 16r6870 16rF9BC 16r6871 16rF9BD 16r6872 16r5DA2 16r6873 16r62D7 16r6874 16r6416 16r6875 16r6493 16r6876 16r64FE 16r6877 16rF9BE 16r6878 16r66DC 16r6879 16rF9BF 16r687A 16r6A48 16r687B 16rF9C0 16r687C 16r71FF 16r687D 16r7464 16r687E 16rF9C1 16r6921 16r7A88 16r6922 16r7AAF 16r6923 16r7E47 16r6924 16r7E5E 16r6925 16r8000 16r6926 16r8170 16r6927 16rF9C2 16r6928 16r87EF 16r6929 16r8981 16r692A 16r8B20 16r692B 16r9059 16r692C 16rF9C3 16r692D 16r9080 16r692E 16r9952 16r692F 16r617E 16r6930 16r6B32 16r6931 16r6D74 16r6932 16r7E1F 16r6933 16r8925 16r6934 16r8FB1 16r6935 16r4FD1 16r6936 16r50AD 16r6937 16r5197 16r6938 16r52C7 16r6939 16r57C7 16r693A 16r5889 16r693B 16r5BB9 16r693C 16r5EB8 16r693D 16r6142 16r693E 16r6995 16r693F 16r6D8C 16r6940 16r6E67 16r6941 16r6EB6 16r6942 16r7194 16r6943 16r7462 16r6944 16r7528 16r6945 16r752C 16r6946 16r8073 16r6947 16r8338 16r6948 16r84C9 16r6949 16r8E0A 16r694A 16r9394 16r694B 16r93DE 16r694C 16rF9C4 16r694D 16r4E8E 16r694E 16r4F51 16r694F 16r5076 16r6950 16r512A 16r6951 16r53C8 16r6952 16r53CB 16r6953 16r53F3 16r6954 16r5B87 16r6955 16r5BD3 16r6956 16r5C24 16r6957 16r611A 16r6958 16r6182 16r6959 16r65F4 16r695A 16r725B 16r695B 16r7397 16r695C 16r7440 16r695D 16r76C2 16r695E 16r7950 16r695F 16r7991 16r6960 16r79B9 16r6961 16r7D06 16r6962 16r7FBD 16r6963 16r828B 16r6964 16r85D5 16r6965 16r865E 16r6966 16r8FC2 16r6967 16r9047 16r6968 16r90F5 16r6969 16r91EA 16r696A 16r9685 16r696B 16r96E8 16r696C 16r96E9 16r696D 16r52D6 16r696E 16r5F67 16r696F 16r65ED 16r6970 16r6631 16r6971 16r682F 16r6972 16r715C 16r6973 16r7A36 16r6974 16r90C1 16r6975 16r980A 16r6976 16r4E91 16r6977 16rF9C5 16r6978 16r6A52 16r6979 16r6B9E 16r697A 16r6F90 16r697B 16r7189 16r697C 16r8018 16r697D 16r82B8 16r697E 16r8553 16r6A21 16r904B 16r6A22 16r9695 16r6A23 16r96F2 16r6A24 16r97FB 16r6A25 16r851A 16r6A26 16r9B31 16r6A27 16r4E90 16r6A28 16r718A 16r6A29 16r96C4 16r6A2A 16r5143 16r6A2B 16r539F 16r6A2C 16r54E1 16r6A2D 16r5713 16r6A2E 16r5712 16r6A2F 16r57A3 16r6A30 16r5A9B 16r6A31 16r5AC4 16r6A32 16r5BC3 16r6A33 16r6028 16r6A34 16r613F 16r6A35 16r63F4 16r6A36 16r6C85 16r6A37 16r6D39 16r6A38 16r6E72 16r6A39 16r6E90 16r6A3A 16r7230 16r6A3B 16r733F 16r6A3C 16r7457 16r6A3D 16r82D1 16r6A3E 16r8881 16r6A3F 16r8F45 16r6A40 16r9060 16r6A41 16rF9C6 16r6A42 16r9662 16r6A43 16r9858 16r6A44 16r9D1B 16r6A45 16r6708 16r6A46 16r8D8A 16r6A47 16r925E 16r6A48 16r4F4D 16r6A49 16r5049 16r6A4A 16r50DE 16r6A4B 16r5371 16r6A4C 16r570D 16r6A4D 16r59D4 16r6A4E 16r5A01 16r6A4F 16r5C09 16r6A50 16r6170 16r6A51 16r6690 16r6A52 16r6E2D 16r6A53 16r7232 16r6A54 16r744B 16r6A55 16r7DEF 16r6A56 16r80C3 16r6A57 16r840E 16r6A58 16r8466 16r6A59 16r853F 16r6A5A 16r875F 16r6A5B 16r885B 16r6A5C 16r8918 16r6A5D 16r8B02 16r6A5E 16r9055 16r6A5F 16r97CB 16r6A60 16r9B4F 16r6A61 16r4E73 16r6A62 16r4F91 16r6A63 16r5112 16r6A64 16r516A 16r6A65 16rF9C7 16r6A66 16r552F 16r6A67 16r55A9 16r6A68 16r5B7A 16r6A69 16r5BA5 16r6A6A 16r5E7C 16r6A6B 16r5E7D 16r6A6C 16r5EBE 16r6A6D 16r60A0 16r6A6E 16r60DF 16r6A6F 16r6108 16r6A70 16r6109 16r6A71 16r63C4 16r6A72 16r6538 16r6A73 16r6709 16r6A74 16rF9C8 16r6A75 16r67D4 16r6A76 16r67DA 16r6A77 16rF9C9 16r6A78 16r6961 16r6A79 16r6962 16r6A7A 16r6CB9 16r6A7B 16r6D27 16r6A7C 16rF9CA 16r6A7D 16r6E38 16r6A7E 16rF9CB 16r6B21 16r6FE1 16r6B22 16r7336 16r6B23 16r7337 16r6B24 16rF9CC 16r6B25 16r745C 16r6B26 16r7531 16r6B27 16rF9CD 16r6B28 16r7652 16r6B29 16rF9CE 16r6B2A 16rF9CF 16r6B2B 16r7DAD 16r6B2C 16r81FE 16r6B2D 16r8438 16r6B2E 16r88D5 16r6B2F 16r8A98 16r6B30 16r8ADB 16r6B31 16r8AED 16r6B32 16r8E30 16r6B33 16r8E42 16r6B34 16r904A 16r6B35 16r903E 16r6B36 16r907A 16r6B37 16r9149 16r6B38 16r91C9 16r6B39 16r936E 16r6B3A 16rF9D0 16r6B3B 16rF9D1 16r6B3C 16r5809 16r6B3D 16rF9D2 16r6B3E 16r6BD3 16r6B3F 16r8089 16r6B40 16r80B2 16r6B41 16rF9D3 16r6B42 16rF9D4 16r6B43 16r5141 16r6B44 16r596B 16r6B45 16r5C39 16r6B46 16rF9D5 16r6B47 16rF9D6 16r6B48 16r6F64 16r6B49 16r73A7 16r6B4A 16r80E4 16r6B4B 16r8D07 16r6B4C 16rF9D7 16r6B4D 16r9217 16r6B4E 16r958F 16r6B4F 16rF9D8 16r6B50 16rF9D9 16r6B51 16rF9DA 16r6B52 16rF9DB 16r6B53 16r807F 16r6B54 16r620E 16r6B55 16r701C 16r6B56 16r7D68 16r6B57 16r878D 16r6B58 16rF9DC 16r6B59 16r57A0 16r6B5A 16r6069 16r6B5B 16r6147 16r6B5C 16r6BB7 16r6B5D 16r8ABE 16r6B5E 16r9280 16r6B5F 16r96B1 16r6B60 16r4E59 16r6B61 16r541F 16r6B62 16r6DEB 16r6B63 16r852D 16r6B64 16r9670 16r6B65 16r97F3 16r6B66 16r98EE 16r6B67 16r63D6 16r6B68 16r6CE3 16r6B69 16r9091 16r6B6A 16r51DD 16r6B6B 16r61C9 16r6B6C 16r81BA 16r6B6D 16r9DF9 16r6B6E 16r4F9D 16r6B6F 16r501A 16r6B70 16r5100 16r6B71 16r5B9C 16r6B72 16r610F 16r6B73 16r61FF 16r6B74 16r64EC 16r6B75 16r6905 16r6B76 16r6BC5 16r6B77 16r7591 16r6B78 16r77E3 16r6B79 16r7FA9 16r6B7A 16r8264 16r6B7B 16r858F 16r6B7C 16r87FB 16r6B7D 16r8863 16r6B7E 16r8ABC 16r6C21 16r8B70 16r6C22 16r91AB 16r6C23 16r4E8C 16r6C24 16r4EE5 16r6C25 16r4F0A 16r6C26 16rF9DD 16r6C27 16rF9DE 16r6C28 16r5937 16r6C29 16r59E8 16r6C2A 16rF9DF 16r6C2B 16r5DF2 16r6C2C 16r5F1B 16r6C2D 16r5F5B 16r6C2E 16r6021 16r6C2F 16rF9E0 16r6C30 16rF9E1 16r6C31 16rF9E2 16r6C32 16rF9E3 16r6C33 16r723E 16r6C34 16r73E5 16r6C35 16rF9E4 16r6C36 16r7570 16r6C37 16r75CD 16r6C38 16rF9E5 16r6C39 16r79FB 16r6C3A 16rF9E6 16r6C3B 16r800C 16r6C3C 16r8033 16r6C3D 16r8084 16r6C3E 16r82E1 16r6C3F 16r8351 16r6C40 16rF9E7 16r6C41 16rF9E8 16r6C42 16r8CBD 16r6C43 16r8CB3 16r6C44 16r9087 16r6C45 16rF9E9 16r6C46 16rF9EA 16r6C47 16r98F4 16r6C48 16r990C 16r6C49 16rF9EB 16r6C4A 16rF9EC 16r6C4B 16r7037 16r6C4C 16r76CA 16r6C4D 16r7FCA 16r6C4E 16r7FCC 16r6C4F 16r7FFC 16r6C50 16r8B1A 16r6C51 16r4EBA 16r6C52 16r4EC1 16r6C53 16r5203 16r6C54 16r5370 16r6C55 16rF9ED 16r6C56 16r54BD 16r6C57 16r56E0 16r6C58 16r59FB 16r6C59 16r5BC5 16r6C5A 16r5F15 16r6C5B 16r5FCD 16r6C5C 16r6E6E 16r6C5D 16rF9EE 16r6C5E 16rF9EF 16r6C5F 16r7D6A 16r6C60 16r8335 16r6C61 16rF9F0 16r6C62 16r8693 16r6C63 16r8A8D 16r6C64 16rF9F1 16r6C65 16r976D 16r6C66 16r9777 16r6C67 16rF9F2 16r6C68 16rF9F3 16r6C69 16r4E00 16r6C6A 16r4F5A 16r6C6B 16r4F7E 16r6C6C 16r58F9 16r6C6D 16r65E5 16r6C6E 16r6EA2 16r6C6F 16r9038 16r6C70 16r93B0 16r6C71 16r99B9 16r6C72 16r4EFB 16r6C73 16r58EC 16r6C74 16r598A 16r6C75 16r59D9 16r6C76 16r6041 16r6C77 16rF9F4 16r6C78 16rF9F5 16r6C79 16r7A14 16r6C7A 16rF9F6 16r6C7B 16r834F 16r6C7C 16r8CC3 16r6C7D 16r5165 16r6C7E 16r5344 16r6D21 16rF9F7 16r6D22 16rF9F8 16r6D23 16rF9F9 16r6D24 16r4ECD 16r6D25 16r5269 16r6D26 16r5B55 16r6D27 16r82BF 16r6D28 16r4ED4 16r6D29 16r523A 16r6D2A 16r54A8 16r6D2B 16r59C9 16r6D2C 16r59FF 16r6D2D 16r5B50 16r6D2E 16r5B57 16r6D2F 16r5B5C 16r6D30 16r6063 16r6D31 16r6148 16r6D32 16r6ECB 16r6D33 16r7099 16r6D34 16r716E 16r6D35 16r7386 16r6D36 16r74F7 16r6D37 16r75B5 16r6D38 16r78C1 16r6D39 16r7D2B 16r6D3A 16r8005 16r6D3B 16r81EA 16r6D3C 16r8328 16r6D3D 16r8517 16r6D3E 16r85C9 16r6D3F 16r8AEE 16r6D40 16r8CC7 16r6D41 16r96CC 16r6D42 16r4F5C 16r6D43 16r52FA 16r6D44 16r56BC 16r6D45 16r65AB 16r6D46 16r6628 16r6D47 16r707C 16r6D48 16r70B8 16r6D49 16r7235 16r6D4A 16r7DBD 16r6D4B 16r828D 16r6D4C 16r914C 16r6D4D 16r96C0 16r6D4E 16r9D72 16r6D4F 16r5B71 16r6D50 16r68E7 16r6D51 16r6B98 16r6D52 16r6F7A 16r6D53 16r76DE 16r6D54 16r5C91 16r6D55 16r66AB 16r6D56 16r6F5B 16r6D57 16r7BB4 16r6D58 16r7C2A 16r6D59 16r8836 16r6D5A 16r96DC 16r6D5B 16r4E08 16r6D5C 16r4ED7 16r6D5D 16r5320 16r6D5E 16r5834 16r6D5F 16r58BB 16r6D60 16r58EF 16r6D61 16r596C 16r6D62 16r5C07 16r6D63 16r5E33 16r6D64 16r5E84 16r6D65 16r5F35 16r6D66 16r638C 16r6D67 16r66B2 16r6D68 16r6756 16r6D69 16r6A1F 16r6D6A 16r6AA3 16r6D6B 16r6B0C 16r6D6C 16r6F3F 16r6D6D 16r7246 16r6D6E 16rF9FA 16r6D6F 16r7350 16r6D70 16r748B 16r6D71 16r7AE0 16r6D72 16r7CA7 16r6D73 16r8178 16r6D74 16r81DF 16r6D75 16r81E7 16r6D76 16r838A 16r6D77 16r846C 16r6D78 16r8523 16r6D79 16r8594 16r6D7A 16r85CF 16r6D7B 16r88DD 16r6D7C 16r8D13 16r6D7D 16r91AC 16r6D7E 16r9577 16r6E21 16r969C 16r6E22 16r518D 16r6E23 16r54C9 16r6E24 16r5728 16r6E25 16r5BB0 16r6E26 16r624D 16r6E27 16r6750 16r6E28 16r683D 16r6E29 16r6893 16r6E2A 16r6E3D 16r6E2B 16r6ED3 16r6E2C 16r707D 16r6E2D 16r7E21 16r6E2E 16r88C1 16r6E2F 16r8CA1 16r6E30 16r8F09 16r6E31 16r9F4B 16r6E32 16r9F4E 16r6E33 16r722D 16r6E34 16r7B8F 16r6E35 16r8ACD 16r6E36 16r931A 16r6E37 16r4F47 16r6E38 16r4F4E 16r6E39 16r5132 16r6E3A 16r5480 16r6E3B 16r59D0 16r6E3C 16r5E95 16r6E3D 16r62B5 16r6E3E 16r6775 16r6E3F 16r696E 16r6E40 16r6A17 16r6E41 16r6CAE 16r6E42 16r6E1A 16r6E43 16r72D9 16r6E44 16r732A 16r6E45 16r75BD 16r6E46 16r7BB8 16r6E47 16r7D35 16r6E48 16r82E7 16r6E49 16r83F9 16r6E4A 16r8457 16r6E4B 16r85F7 16r6E4C 16r8A5B 16r6E4D 16r8CAF 16r6E4E 16r8E87 16r6E4F 16r9019 16r6E50 16r90B8 16r6E51 16r96CE 16r6E52 16r9F5F 16r6E53 16r52E3 16r6E54 16r540A 16r6E55 16r5AE1 16r6E56 16r5BC2 16r6E57 16r6458 16r6E58 16r6575 16r6E59 16r6EF4 16r6E5A 16r72C4 16r6E5B 16rF9FB 16r6E5C 16r7684 16r6E5D 16r7A4D 16r6E5E 16r7B1B 16r6E5F 16r7C4D 16r6E60 16r7E3E 16r6E61 16r7FDF 16r6E62 16r837B 16r6E63 16r8B2B 16r6E64 16r8CCA 16r6E65 16r8D64 16r6E66 16r8DE1 16r6E67 16r8E5F 16r6E68 16r8FEA 16r6E69 16r8FF9 16r6E6A 16r9069 16r6E6B 16r93D1 16r6E6C 16r4F43 16r6E6D 16r4F7A 16r6E6E 16r50B3 16r6E6F 16r5168 16r6E70 16r5178 16r6E71 16r524D 16r6E72 16r526A 16r6E73 16r5861 16r6E74 16r587C 16r6E75 16r5960 16r6E76 16r5C08 16r6E77 16r5C55 16r6E78 16r5EDB 16r6E79 16r609B 16r6E7A 16r6230 16r6E7B 16r6813 16r6E7C 16r6BBF 16r6E7D 16r6C08 16r6E7E 16r6FB1 16r6F21 16r714E 16r6F22 16r7420 16r6F23 16r7530 16r6F24 16r7538 16r6F25 16r7551 16r6F26 16r7672 16r6F27 16r7B4C 16r6F28 16r7B8B 16r6F29 16r7BAD 16r6F2A 16r7BC6 16r6F2B 16r7E8F 16r6F2C 16r8A6E 16r6F2D 16r8F3E 16r6F2E 16r8F49 16r6F2F 16r923F 16r6F30 16r9293 16r6F31 16r9322 16r6F32 16r942B 16r6F33 16r96FB 16r6F34 16r985A 16r6F35 16r986B 16r6F36 16r991E 16r6F37 16r5207 16r6F38 16r622A 16r6F39 16r6298 16r6F3A 16r6D59 16r6F3B 16r7664 16r6F3C 16r7ACA 16r6F3D 16r7BC0 16r6F3E 16r7D76 16r6F3F 16r5360 16r6F40 16r5CBE 16r6F41 16r5E97 16r6F42 16r6F38 16r6F43 16r70B9 16r6F44 16r7C98 16r6F45 16r9711 16r6F46 16r9B8E 16r6F47 16r9EDE 16r6F48 16r63A5 16r6F49 16r647A 16r6F4A 16r8776 16r6F4B 16r4E01 16r6F4C 16r4E95 16r6F4D 16r4EAD 16r6F4E 16r505C 16r6F4F 16r5075 16r6F50 16r5448 16r6F51 16r59C3 16r6F52 16r5B9A 16r6F53 16r5E40 16r6F54 16r5EAD 16r6F55 16r5EF7 16r6F56 16r5F81 16r6F57 16r60C5 16r6F58 16r633A 16r6F59 16r653F 16r6F5A 16r6574 16r6F5B 16r65CC 16r6F5C 16r6676 16r6F5D 16r6678 16r6F5E 16r67FE 16r6F5F 16r6968 16r6F60 16r6A89 16r6F61 16r6B63 16r6F62 16r6C40 16r6F63 16r6DC0 16r6F64 16r6DE8 16r6F65 16r6E1F 16r6F66 16r6E5E 16r6F67 16r701E 16r6F68 16r70A1 16r6F69 16r738E 16r6F6A 16r73FD 16r6F6B 16r753A 16r6F6C 16r775B 16r6F6D 16r7887 16r6F6E 16r798E 16r6F6F 16r7A0B 16r6F70 16r7A7D 16r6F71 16r7CBE 16r6F72 16r7D8E 16r6F73 16r8247 16r6F74 16r8A02 16r6F75 16r8AEA 16r6F76 16r8C9E 16r6F77 16r912D 16r6F78 16r914A 16r6F79 16r91D8 16r6F7A 16r9266 16r6F7B 16r92CC 16r6F7C 16r9320 16r6F7D 16r9706 16r6F7E 16r9756 16r7021 16r975C 16r7022 16r9802 16r7023 16r9F0E 16r7024 16r5236 16r7025 16r5291 16r7026 16r557C 16r7027 16r5824 16r7028 16r5E1D 16r7029 16r5F1F 16r702A 16r608C 16r702B 16r63D0 16r702C 16r68AF 16r702D 16r6FDF 16r702E 16r796D 16r702F 16r7B2C 16r7030 16r81CD 16r7031 16r85BA 16r7032 16r88FD 16r7033 16r8AF8 16r7034 16r8E44 16r7035 16r918D 16r7036 16r9664 16r7037 16r969B 16r7038 16r973D 16r7039 16r984C 16r703A 16r9F4A 16r703B 16r4FCE 16r703C 16r5146 16r703D 16r51CB 16r703E 16r52A9 16r703F 16r5632 16r7040 16r5F14 16r7041 16r5F6B 16r7042 16r63AA 16r7043 16r64CD 16r7044 16r65E9 16r7045 16r6641 16r7046 16r66FA 16r7047 16r66F9 16r7048 16r671D 16r7049 16r689D 16r704A 16r68D7 16r704B 16r69FD 16r704C 16r6F15 16r704D 16r6F6E 16r704E 16r7167 16r704F 16r71E5 16r7050 16r722A 16r7051 16r74AA 16r7052 16r773A 16r7053 16r7956 16r7054 16r795A 16r7055 16r79DF 16r7056 16r7A20 16r7057 16r7A95 16r7058 16r7C97 16r7059 16r7CDF 16r705A 16r7D44 16r705B 16r7E70 16r705C 16r8087 16r705D 16r85FB 16r705E 16r86A4 16r705F 16r8A54 16r7060 16r8ABF 16r7061 16r8D99 16r7062 16r8E81 16r7063 16r9020 16r7064 16r906D 16r7065 16r91E3 16r7066 16r963B 16r7067 16r96D5 16r7068 16r9CE5 16r7069 16r65CF 16r706A 16r7C07 16r706B 16r8DB3 16r706C 16r93C3 16r706D 16r5B58 16r706E 16r5C0A 16r706F 16r5352 16r7070 16r62D9 16r7071 16r731D 16r7072 16r5027 16r7073 16r5B97 16r7074 16r5F9E 16r7075 16r60B0 16r7076 16r616B 16r7077 16r68D5 16r7078 16r6DD9 16r7079 16r742E 16r707A 16r7A2E 16r707B 16r7D42 16r707C 16r7D9C 16r707D 16r7E31 16r707E 16r816B 16r7121 16r8E2A 16r7122 16r8E35 16r7123 16r937E 16r7124 16r9418 16r7125 16r4F50 16r7126 16r5750 16r7127 16r5DE6 16r7128 16r5EA7 16r7129 16r632B 16r712A 16r7F6A 16r712B 16r4E3B 16r712C 16r4F4F 16r712D 16r4F8F 16r712E 16r505A 16r712F 16r59DD 16r7130 16r80C4 16r7131 16r546A 16r7132 16r5468 16r7133 16r55FE 16r7134 16r594F 16r7135 16r5B99 16r7136 16r5DDE 16r7137 16r5EDA 16r7138 16r665D 16r7139 16r6731 16r713A 16r67F1 16r713B 16r682A 16r713C 16r6CE8 16r713D 16r6D32 16r713E 16r6E4A 16r713F 16r6F8D 16r7140 16r70B7 16r7141 16r73E0 16r7142 16r7587 16r7143 16r7C4C 16r7144 16r7D02 16r7145 16r7D2C 16r7146 16r7DA2 16r7147 16r821F 16r7148 16r86DB 16r7149 16r8A3B 16r714A 16r8A85 16r714B 16r8D70 16r714C 16r8E8A 16r714D 16r8F33 16r714E 16r9031 16r714F 16r914E 16r7150 16r9152 16r7151 16r9444 16r7152 16r99D0 16r7153 16r7AF9 16r7154 16r7CA5 16r7155 16r4FCA 16r7156 16r5101 16r7157 16r51C6 16r7158 16r57C8 16r7159 16r5BEF 16r715A 16r5CFB 16r715B 16r6659 16r715C 16r6A3D 16r715D 16r6D5A 16r715E 16r6E96 16r715F 16r6FEC 16r7160 16r710C 16r7161 16r756F 16r7162 16r7AE3 16r7163 16r8822 16r7164 16r9021 16r7165 16r9075 16r7166 16r96CB 16r7167 16r99FF 16r7168 16r8301 16r7169 16r4E2D 16r716A 16r4EF2 16r716B 16r8846 16r716C 16r91CD 16r716D 16r537D 16r716E 16r6ADB 16r716F 16r696B 16r7170 16r6C41 16r7171 16r847A 16r7172 16r589E 16r7173 16r618E 16r7174 16r66FE 16r7175 16r62EF 16r7176 16r70DD 16r7177 16r7511 16r7178 16r75C7 16r7179 16r7E52 16r717A 16r84B8 16r717B 16r8B49 16r717C 16r8D08 16r717D 16r4E4B 16r717E 16r53EA 16r7221 16r54AB 16r7222 16r5730 16r7223 16r5740 16r7224 16r5FD7 16r7225 16r6301 16r7226 16r6307 16r7227 16r646F 16r7228 16r652F 16r7229 16r65E8 16r722A 16r667A 16r722B 16r679D 16r722C 16r67B3 16r722D 16r6B62 16r722E 16r6C60 16r722F 16r6C9A 16r7230 16r6F2C 16r7231 16r77E5 16r7232 16r7825 16r7233 16r7949 16r7234 16r7957 16r7235 16r7D19 16r7236 16r80A2 16r7237 16r8102 16r7238 16r81F3 16r7239 16r829D 16r723A 16r82B7 16r723B 16r8718 16r723C 16r8A8C 16r723D 16rF9FC 16r723E 16r8D04 16r723F 16r8DBE 16r7240 16r9072 16r7241 16r76F4 16r7242 16r7A19 16r7243 16r7A37 16r7244 16r7E54 16r7245 16r8077 16r7246 16r5507 16r7247 16r55D4 16r7248 16r5875 16r7249 16r632F 16r724A 16r6422 16r724B 16r6649 16r724C 16r664B 16r724D 16r686D 16r724E 16r699B 16r724F 16r6B84 16r7250 16r6D25 16r7251 16r6EB1 16r7252 16r73CD 16r7253 16r7468 16r7254 16r74A1 16r7255 16r755B 16r7256 16r75B9 16r7257 16r76E1 16r7258 16r771E 16r7259 16r778B 16r725A 16r79E6 16r725B 16r7E09 16r725C 16r7E1D 16r725D 16r81FB 16r725E 16r852F 16r725F 16r8897 16r7260 16r8A3A 16r7261 16r8CD1 16r7262 16r8EEB 16r7263 16r8FB0 16r7264 16r9032 16r7265 16r93AD 16r7266 16r9663 16r7267 16r9673 16r7268 16r9707 16r7269 16r4F84 16r726A 16r53F1 16r726B 16r59EA 16r726C 16r5AC9 16r726D 16r5E19 16r726E 16r684E 16r726F 16r74C6 16r7270 16r75BE 16r7271 16r79E9 16r7272 16r7A92 16r7273 16r81A3 16r7274 16r86ED 16r7275 16r8CEA 16r7276 16r8DCC 16r7277 16r8FED 16r7278 16r659F 16r7279 16r6715 16r727A 16rF9FD 16r727B 16r57F7 16r727C 16r6F57 16r727D 16r7DDD 16r727E 16r8F2F 16r7321 16r93F6 16r7322 16r96C6 16r7323 16r5FB5 16r7324 16r61F2 16r7325 16r6F84 16r7326 16r4E14 16r7327 16r4F98 16r7328 16r501F 16r7329 16r53C9 16r732A 16r55DF 16r732B 16r5D6F 16r732C 16r5DEE 16r732D 16r6B21 16r732E 16r6B64 16r732F 16r78CB 16r7330 16r7B9A 16r7331 16rF9FE 16r7332 16r8E49 16r7333 16r8ECA 16r7334 16r906E 16r7335 16r6349 16r7336 16r643E 16r7337 16r7740 16r7338 16r7A84 16r7339 16r932F 16r733A 16r947F 16r733B 16r9F6A 16r733C 16r64B0 16r733D 16r6FAF 16r733E 16r71E6 16r733F 16r74A8 16r7340 16r74DA 16r7341 16r7AC4 16r7342 16r7C12 16r7343 16r7E82 16r7344 16r7CB2 16r7345 16r7E98 16r7346 16r8B9A 16r7347 16r8D0A 16r7348 16r947D 16r7349 16r9910 16r734A 16r994C 16r734B 16r5239 16r734C 16r5BDF 16r734D 16r64E6 16r734E 16r672D 16r734F 16r7D2E 16r7350 16r50ED 16r7351 16r53C3 16r7352 16r5879 16r7353 16r6158 16r7354 16r6159 16r7355 16r61FA 16r7356 16r65AC 16r7357 16r7AD9 16r7358 16r8B92 16r7359 16r8B96 16r735A 16r5009 16r735B 16r5021 16r735C 16r5275 16r735D 16r5531 16r735E 16r5A3C 16r735F 16r5EE0 16r7360 16r5F70 16r7361 16r6134 16r7362 16r655E 16r7363 16r660C 16r7364 16r6636 16r7365 16r66A2 16r7366 16r69CD 16r7367 16r6EC4 16r7368 16r6F32 16r7369 16r7316 16r736A 16r7621 16r736B 16r7A93 16r736C 16r8139 16r736D 16r8259 16r736E 16r83D6 16r736F 16r84BC 16r7370 16r50B5 16r7371 16r57F0 16r7372 16r5BC0 16r7373 16r5BE8 16r7374 16r5F69 16r7375 16r63A1 16r7376 16r7826 16r7377 16r7DB5 16r7378 16r83DC 16r7379 16r8521 16r737A 16r91C7 16r737B 16r91F5 16r737C 16r518A 16r737D 16r67F5 16r737E 16r7B56 16r7421 16r8CAC 16r7422 16r51C4 16r7423 16r59BB 16r7424 16r60BD 16r7425 16r8655 16r7426 16r501C 16r7427 16rF9FF 16r7428 16r5254 16r7429 16r5C3A 16r742A 16r617D 16r742B 16r621A 16r742C 16r62D3 16r742D 16r64F2 16r742E 16r65A5 16r742F 16r6ECC 16r7430 16r7620 16r7431 16r810A 16r7432 16r8E60 16r7433 16r965F 16r7434 16r96BB 16r7435 16r4EDF 16r7436 16r5343 16r7437 16r5598 16r7438 16r5929 16r7439 16r5DDD 16r743A 16r64C5 16r743B 16r6CC9 16r743C 16r6DFA 16r743D 16r7394 16r743E 16r7A7F 16r743F 16r821B 16r7440 16r85A6 16r7441 16r8CE4 16r7442 16r8E10 16r7443 16r9077 16r7444 16r91E7 16r7445 16r95E1 16r7446 16r9621 16r7447 16r97C6 16r7448 16r51F8 16r7449 16r54F2 16r744A 16r5586 16r744B 16r5FB9 16r744C 16r64A4 16r744D 16r6F88 16r744E 16r7DB4 16r744F 16r8F1F 16r7450 16r8F4D 16r7451 16r9435 16r7452 16r50C9 16r7453 16r5C16 16r7454 16r6CBE 16r7455 16r6DFB 16r7456 16r751B 16r7457 16r77BB 16r7458 16r7C3D 16r7459 16r7C64 16r745A 16r8A79 16r745B 16r8AC2 16r745C 16r581E 16r745D 16r59BE 16r745E 16r5E16 16r745F 16r6377 16r7460 16r7252 16r7461 16r758A 16r7462 16r776B 16r7463 16r8ADC 16r7464 16r8CBC 16r7465 16r8F12 16r7466 16r5EF3 16r7467 16r6674 16r7468 16r6DF8 16r7469 16r807D 16r746A 16r83C1 16r746B 16r8ACB 16r746C 16r9751 16r746D 16r9BD6 16r746E 16rFA00 16r746F 16r5243 16r7470 16r66FF 16r7471 16r6D95 16r7472 16r6EEF 16r7473 16r7DE0 16r7474 16r8AE6 16r7475 16r902E 16r7476 16r905E 16r7477 16r9AD4 16r7478 16r521D 16r7479 16r527F 16r747A 16r54E8 16r747B 16r6194 16r747C 16r6284 16r747D 16r62DB 16r747E 16r68A2 16r7521 16r6912 16r7522 16r695A 16r7523 16r6A35 16r7524 16r7092 16r7525 16r7126 16r7526 16r785D 16r7527 16r7901 16r7528 16r790E 16r7529 16r79D2 16r752A 16r7A0D 16r752B 16r8096 16r752C 16r8278 16r752D 16r82D5 16r752E 16r8349 16r752F 16r8549 16r7530 16r8C82 16r7531 16r8D85 16r7532 16r9162 16r7533 16r918B 16r7534 16r91AE 16r7535 16r4FC3 16r7536 16r56D1 16r7537 16r71ED 16r7538 16r77D7 16r7539 16r8700 16r753A 16r89F8 16r753B 16r5BF8 16r753C 16r5FD6 16r753D 16r6751 16r753E 16r90A8 16r753F 16r53E2 16r7540 16r585A 16r7541 16r5BF5 16r7542 16r60A4 16r7543 16r6181 16r7544 16r6460 16r7545 16r7E3D 16r7546 16r8070 16r7547 16r8525 16r7548 16r9283 16r7549 16r64AE 16r754A 16r50AC 16r754B 16r5D14 16r754C 16r6700 16r754D 16r589C 16r754E 16r62BD 16r754F 16r63A8 16r7550 16r690E 16r7551 16r6978 16r7552 16r6A1E 16r7553 16r6E6B 16r7554 16r76BA 16r7555 16r79CB 16r7556 16r82BB 16r7557 16r8429 16r7558 16r8ACF 16r7559 16r8DA8 16r755A 16r8FFD 16r755B 16r9112 16r755C 16r914B 16r755D 16r919C 16r755E 16r9310 16r755F 16r9318 16r7560 16r939A 16r7561 16r96DB 16r7562 16r9A36 16r7563 16r9C0D 16r7564 16r4E11 16r7565 16r755C 16r7566 16r795D 16r7567 16r7AFA 16r7568 16r7B51 16r7569 16r7BC9 16r756A 16r7E2E 16r756B 16r84C4 16r756C 16r8E59 16r756D 16r8E74 16r756E 16r8EF8 16r756F 16r9010 16r7570 16r6625 16r7571 16r693F 16r7572 16r7443 16r7573 16r51FA 16r7574 16r672E 16r7575 16r9EDC 16r7576 16r5145 16r7577 16r5FE0 16r7578 16r6C96 16r7579 16r87F2 16r757A 16r885D 16r757B 16r8877 16r757C 16r60B4 16r757D 16r81B5 16r757E 16r8403 16r7621 16r8D05 16r7622 16r53D6 16r7623 16r5439 16r7624 16r5634 16r7625 16r5A36 16r7626 16r5C31 16r7627 16r708A 16r7628 16r7FE0 16r7629 16r805A 16r762A 16r8106 16r762B 16r81ED 16r762C 16r8DA3 16r762D 16r9189 16r762E 16r9A5F 16r762F 16r9DF2 16r7630 16r5074 16r7631 16r4EC4 16r7632 16r53A0 16r7633 16r60FB 16r7634 16r6E2C 16r7635 16r5C64 16r7636 16r4F88 16r7637 16r5024 16r7638 16r55E4 16r7639 16r5CD9 16r763A 16r5E5F 16r763B 16r6065 16r763C 16r6894 16r763D 16r6CBB 16r763E 16r6DC4 16r763F 16r71BE 16r7640 16r75D4 16r7641 16r75F4 16r7642 16r7661 16r7643 16r7A1A 16r7644 16r7A49 16r7645 16r7DC7 16r7646 16r7DFB 16r7647 16r7F6E 16r7648 16r81F4 16r7649 16r86A9 16r764A 16r8F1C 16r764B 16r96C9 16r764C 16r99B3 16r764D 16r9F52 16r764E 16r5247 16r764F 16r52C5 16r7650 16r98ED 16r7651 16r89AA 16r7652 16r4E03 16r7653 16r67D2 16r7654 16r6F06 16r7655 16r4FB5 16r7656 16r5BE2 16r7657 16r6795 16r7658 16r6C88 16r7659 16r6D78 16r765A 16r741B 16r765B 16r7827 16r765C 16r91DD 16r765D 16r937C 16r765E 16r87C4 16r765F 16r79E4 16r7660 16r7A31 16r7661 16r5FEB 16r7662 16r4ED6 16r7663 16r54A4 16r7664 16r553E 16r7665 16r58AE 16r7666 16r59A5 16r7667 16r60F0 16r7668 16r6253 16r7669 16r62D6 16r766A 16r6736 16r766B 16r6955 16r766C 16r8235 16r766D 16r9640 16r766E 16r99B1 16r766F 16r99DD 16r7670 16r502C 16r7671 16r5353 16r7672 16r5544 16r7673 16r577C 16r7674 16rFA01 16r7675 16r6258 16r7676 16rFA02 16r7677 16r64E2 16r7678 16r666B 16r7679 16r67DD 16r767A 16r6FC1 16r767B 16r6FEF 16r767C 16r7422 16r767D 16r7438 16r767E 16r8A17 16r7721 16r9438 16r7722 16r5451 16r7723 16r5606 16r7724 16r5766 16r7725 16r5F48 16r7726 16r619A 16r7727 16r6B4E 16r7728 16r7058 16r7729 16r70AD 16r772A 16r7DBB 16r772B 16r8A95 16r772C 16r596A 16r772D 16r812B 16r772E 16r63A2 16r772F 16r7708 16r7730 16r803D 16r7731 16r8CAA 16r7732 16r5854 16r7733 16r642D 16r7734 16r69BB 16r7735 16r5B95 16r7736 16r5E11 16r7737 16r6E6F 16r7738 16rFA03 16r7739 16r8569 16r773A 16r514C 16r773B 16r53F0 16r773C 16r592A 16r773D 16r6020 16r773E 16r614B 16r773F 16r6B86 16r7740 16r6C70 16r7741 16r6CF0 16r7742 16r7B1E 16r7743 16r80CE 16r7744 16r82D4 16r7745 16r8DC6 16r7746 16r90B0 16r7747 16r98B1 16r7748 16rFA04 16r7749 16r64C7 16r774A 16r6FA4 16r774B 16r6491 16r774C 16r6504 16r774D 16r514E 16r774E 16r5410 16r774F 16r571F 16r7750 16r8A0E 16r7751 16r615F 16r7752 16r6876 16r7753 16rFA05 16r7754 16r75DB 16r7755 16r7B52 16r7756 16r7D71 16r7757 16r901A 16r7758 16r5806 16r7759 16r69CC 16r775A 16r817F 16r775B 16r892A 16r775C 16r9000 16r775D 16r9839 16r775E 16r5078 16r775F 16r5957 16r7760 16r59AC 16r7761 16r6295 16r7762 16r900F 16r7763 16r9B2A 16r7764 16r615D 16r7765 16r7279 16r7766 16r95D6 16r7767 16r5761 16r7768 16r5A46 16r7769 16r5DF4 16r776A 16r628A 16r776B 16r64AD 16r776C 16r64FA 16r776D 16r6777 16r776E 16r6CE2 16r776F 16r6D3E 16r7770 16r722C 16r7771 16r7436 16r7772 16r7834 16r7773 16r7F77 16r7774 16r82AD 16r7775 16r8DDB 16r7776 16r9817 16r7777 16r5224 16r7778 16r5742 16r7779 16r677F 16r777A 16r7248 16r777B 16r74E3 16r777C 16r8CA9 16r777D 16r8FA6 16r777E 16r9211 16r7821 16r962A 16r7822 16r516B 16r7823 16r53ED 16r7824 16r634C 16r7825 16r4F69 16r7826 16r5504 16r7827 16r6096 16r7828 16r6557 16r7829 16r6C9B 16r782A 16r6D7F 16r782B 16r724C 16r782C 16r72FD 16r782D 16r7A17 16r782E 16r8987 16r782F 16r8C9D 16r7830 16r5F6D 16r7831 16r6F8E 16r7832 16r70F9 16r7833 16r81A8 16r7834 16r610E 16r7835 16r4FBF 16r7836 16r504F 16r7837 16r6241 16r7838 16r7247 16r7839 16r7BC7 16r783A 16r7DE8 16r783B 16r7FE9 16r783C 16r904D 16r783D 16r97AD 16r783E 16r9A19 16r783F 16r8CB6 16r7840 16r576A 16r7841 16r5E73 16r7842 16r67B0 16r7843 16r840D 16r7844 16r8A55 16r7845 16r5420 16r7846 16r5B16 16r7847 16r5E63 16r7848 16r5EE2 16r7849 16r5F0A 16r784A 16r6583 16r784B 16r80BA 16r784C 16r853D 16r784D 16r9589 16r784E 16r965B 16r784F 16r4F48 16r7850 16r5305 16r7851 16r530D 16r7852 16r530F 16r7853 16r5486 16r7854 16r54FA 16r7855 16r5703 16r7856 16r5E03 16r7857 16r6016 16r7858 16r629B 16r7859 16r62B1 16r785A 16r6355 16r785B 16rFA06 16r785C 16r6CE1 16r785D 16r6D66 16r785E 16r75B1 16r785F 16r7832 16r7860 16r80DE 16r7861 16r812F 16r7862 16r82DE 16r7863 16r8461 16r7864 16r84B2 16r7865 16r888D 16r7866 16r8912 16r7867 16r900B 16r7868 16r92EA 16r7869 16r98FD 16r786A 16r9B91 16r786B 16r5E45 16r786C 16r66B4 16r786D 16r66DD 16r786E 16r7011 16r786F 16r7206 16r7870 16rFA07 16r7871 16r4FF5 16r7872 16r527D 16r7873 16r5F6A 16r7874 16r6153 16r7875 16r6753 16r7876 16r6A19 16r7877 16r6F02 16r7878 16r74E2 16r7879 16r7968 16r787A 16r8868 16r787B 16r8C79 16r787C 16r98C7 16r787D 16r98C4 16r787E 16r9A43 16r7921 16r54C1 16r7922 16r7A1F 16r7923 16r6953 16r7924 16r8AF7 16r7925 16r8C4A 16r7926 16r98A8 16r7927 16r99AE 16r7928 16r5F7C 16r7929 16r62AB 16r792A 16r75B2 16r792B 16r76AE 16r792C 16r88AB 16r792D 16r907F 16r792E 16r9642 16r792F 16r5339 16r7930 16r5F3C 16r7931 16r5FC5 16r7932 16r6CCC 16r7933 16r73CC 16r7934 16r7562 16r7935 16r758B 16r7936 16r7B46 16r7937 16r82FE 16r7938 16r999D 16r7939 16r4E4F 16r793A 16r903C 16r793B 16r4E0B 16r793C 16r4F55 16r793D 16r53A6 16r793E 16r590F 16r793F 16r5EC8 16r7940 16r6630 16r7941 16r6CB3 16r7942 16r7455 16r7943 16r8377 16r7944 16r8766 16r7945 16r8CC0 16r7946 16r9050 16r7947 16r971E 16r7948 16r9C15 16r7949 16r58D1 16r794A 16r5B78 16r794B 16r8650 16r794C 16r8B14 16r794D 16r9DB4 16r794E 16r5BD2 16r794F 16r6068 16r7950 16r608D 16r7951 16r65F1 16r7952 16r6C57 16r7953 16r6F22 16r7954 16r6FA3 16r7955 16r701A 16r7956 16r7F55 16r7957 16r7FF0 16r7958 16r9591 16r7959 16r9592 16r795A 16r9650 16r795B 16r97D3 16r795C 16r5272 16r795D 16r8F44 16r795E 16r51FD 16r795F 16r542B 16r7960 16r54B8 16r7961 16r5563 16r7962 16r558A 16r7963 16r6ABB 16r7964 16r6DB5 16r7965 16r7DD8 16r7966 16r8266 16r7967 16r929C 16r7968 16r9677 16r7969 16r9E79 16r796A 16r5408 16r796B 16r54C8 16r796C 16r76D2 16r796D 16r86E4 16r796E 16r95A4 16r796F 16r95D4 16r7970 16r965C 16r7971 16r4EA2 16r7972 16r4F09 16r7973 16r59EE 16r7974 16r5AE6 16r7975 16r5DF7 16r7976 16r6052 16r7977 16r6297 16r7978 16r676D 16r7979 16r6841 16r797A 16r6C86 16r797B 16r6E2F 16r797C 16r7F38 16r797D 16r809B 16r797E 16r822A 16r7A21 16rFA08 16r7A22 16rFA09 16r7A23 16r9805 16r7A24 16r4EA5 16r7A25 16r5055 16r7A26 16r54B3 16r7A27 16r5793 16r7A28 16r595A 16r7A29 16r5B69 16r7A2A 16r5BB3 16r7A2B 16r61C8 16r7A2C 16r6977 16r7A2D 16r6D77 16r7A2E 16r7023 16r7A2F 16r87F9 16r7A30 16r89E3 16r7A31 16r8A72 16r7A32 16r8AE7 16r7A33 16r9082 16r7A34 16r99ED 16r7A35 16r9AB8 16r7A36 16r52BE 16r7A37 16r6838 16r7A38 16r5016 16r7A39 16r5E78 16r7A3A 16r674F 16r7A3B 16r8347 16r7A3C 16r884C 16r7A3D 16r4EAB 16r7A3E 16r5411 16r7A3F 16r56AE 16r7A40 16r73E6 16r7A41 16r9115 16r7A42 16r97FF 16r7A43 16r9909 16r7A44 16r9957 16r7A45 16r9999 16r7A46 16r5653 16r7A47 16r589F 16r7A48 16r865B 16r7A49 16r8A31 16r7A4A 16r61B2 16r7A4B 16r6AF6 16r7A4C 16r737B 16r7A4D 16r8ED2 16r7A4E 16r6B47 16r7A4F 16r96AA 16r7A50 16r9A57 16r7A51 16r5955 16r7A52 16r7200 16r7A53 16r8D6B 16r7A54 16r9769 16r7A55 16r4FD4 16r7A56 16r5CF4 16r7A57 16r5F26 16r7A58 16r61F8 16r7A59 16r665B 16r7A5A 16r6CEB 16r7A5B 16r70AB 16r7A5C 16r7384 16r7A5D 16r73B9 16r7A5E 16r73FE 16r7A5F 16r7729 16r7A60 16r774D 16r7A61 16r7D43 16r7A62 16r7D62 16r7A63 16r7E23 16r7A64 16r8237 16r7A65 16r8852 16r7A66 16rFA0A 16r7A67 16r8CE2 16r7A68 16r9249 16r7A69 16r986F 16r7A6A 16r5B51 16r7A6B 16r7A74 16r7A6C 16r8840 16r7A6D 16r9801 16r7A6E 16r5ACC 16r7A6F 16r4FE0 16r7A70 16r5354 16r7A71 16r593E 16r7A72 16r5CFD 16r7A73 16r633E 16r7A74 16r6D79 16r7A75 16r72F9 16r7A76 16r8105 16r7A77 16r8107 16r7A78 16r83A2 16r7A79 16r92CF 16r7A7A 16r9830 16r7A7B 16r4EA8 16r7A7C 16r5144 16r7A7D 16r5211 16r7A7E 16r578B 16r7B21 16r5F62 16r7B22 16r6CC2 16r7B23 16r6ECE 16r7B24 16r7005 16r7B25 16r7050 16r7B26 16r70AF 16r7B27 16r7192 16r7B28 16r73E9 16r7B29 16r7469 16r7B2A 16r834A 16r7B2B 16r87A2 16r7B2C 16r8861 16r7B2D 16r9008 16r7B2E 16r90A2 16r7B2F 16r93A3 16r7B30 16r99A8 16r7B31 16r516E 16r7B32 16r5F57 16r7B33 16r60E0 16r7B34 16r6167 16r7B35 16r66B3 16r7B36 16r8559 16r7B37 16r8E4A 16r7B38 16r91AF 16r7B39 16r978B 16r7B3A 16r4E4E 16r7B3B 16r4E92 16r7B3C 16r547C 16r7B3D 16r58D5 16r7B3E 16r58FA 16r7B3F 16r597D 16r7B40 16r5CB5 16r7B41 16r5F27 16r7B42 16r6236 16r7B43 16r6248 16r7B44 16r660A 16r7B45 16r6667 16r7B46 16r6BEB 16r7B47 16r6D69 16r7B48 16r6DCF 16r7B49 16r6E56 16r7B4A 16r6EF8 16r7B4B 16r6F94 16r7B4C 16r6FE0 16r7B4D 16r6FE9 16r7B4E 16r705D 16r7B4F 16r72D0 16r7B50 16r7425 16r7B51 16r745A 16r7B52 16r74E0 16r7B53 16r7693 16r7B54 16r795C 16r7B55 16r7CCA 16r7B56 16r7E1E 16r7B57 16r80E1 16r7B58 16r82A6 16r7B59 16r846B 16r7B5A 16r84BF 16r7B5B 16r864E 16r7B5C 16r865F 16r7B5D 16r8774 16r7B5E 16r8B77 16r7B5F 16r8C6A 16r7B60 16r93AC 16r7B61 16r9800 16r7B62 16r9865 16r7B63 16r60D1 16r7B64 16r6216 16r7B65 16r9177 16r7B66 16r5A5A 16r7B67 16r660F 16r7B68 16r6DF7 16r7B69 16r6E3E 16r7B6A 16r743F 16r7B6B 16r9B42 16r7B6C 16r5FFD 16r7B6D 16r60DA 16r7B6E 16r7B0F 16r7B6F 16r54C4 16r7B70 16r5F18 16r7B71 16r6C5E 16r7B72 16r6CD3 16r7B73 16r6D2A 16r7B74 16r70D8 16r7B75 16r7D05 16r7B76 16r8679 16r7B77 16r8A0C 16r7B78 16r9D3B 16r7B79 16r5316 16r7B7A 16r548C 16r7B7B 16r5B05 16r7B7C 16r6A3A 16r7B7D 16r706B 16r7B7E 16r7575 16r7C21 16r798D 16r7C22 16r79BE 16r7C23 16r82B1 16r7C24 16r83EF 16r7C25 16r8A71 16r7C26 16r8B41 16r7C27 16r8CA8 16r7C28 16r9774 16r7C29 16rFA0B 16r7C2A 16r64F4 16r7C2B 16r652B 16r7C2C 16r78BA 16r7C2D 16r78BB 16r7C2E 16r7A6B 16r7C2F 16r4E38 16r7C30 16r559A 16r7C31 16r5950 16r7C32 16r5BA6 16r7C33 16r5E7B 16r7C34 16r60A3 16r7C35 16r63DB 16r7C36 16r6B61 16r7C37 16r6665 16r7C38 16r6853 16r7C39 16r6E19 16r7C3A 16r7165 16r7C3B 16r74B0 16r7C3C 16r7D08 16r7C3D 16r9084 16r7C3E 16r9A69 16r7C3F 16r9C25 16r7C40 16r6D3B 16r7C41 16r6ED1 16r7C42 16r733E 16r7C43 16r8C41 16r7C44 16r95CA 16r7C45 16r51F0 16r7C46 16r5E4C 16r7C47 16r5FA8 16r7C48 16r604D 16r7C49 16r60F6 16r7C4A 16r6130 16r7C4B 16r614C 16r7C4C 16r6643 16r7C4D 16r6644 16r7C4E 16r69A5 16r7C4F 16r6CC1 16r7C50 16r6E5F 16r7C51 16r6EC9 16r7C52 16r6F62 16r7C53 16r714C 16r7C54 16r749C 16r7C55 16r7687 16r7C56 16r7BC1 16r7C57 16r7C27 16r7C58 16r8352 16r7C59 16r8757 16r7C5A 16r9051 16r7C5B 16r968D 16r7C5C 16r9EC3 16r7C5D 16r532F 16r7C5E 16r56DE 16r7C5F 16r5EFB 16r7C60 16r5F8A 16r7C61 16r6062 16r7C62 16r6094 16r7C63 16r61F7 16r7C64 16r6666 16r7C65 16r6703 16r7C66 16r6A9C 16r7C67 16r6DEE 16r7C68 16r6FAE 16r7C69 16r7070 16r7C6A 16r736A 16r7C6B 16r7E6A 16r7C6C 16r81BE 16r7C6D 16r8334 16r7C6E 16r86D4 16r7C6F 16r8AA8 16r7C70 16r8CC4 16r7C71 16r5283 16r7C72 16r7372 16r7C73 16r5B96 16r7C74 16r6A6B 16r7C75 16r9404 16r7C76 16r54EE 16r7C77 16r5686 16r7C78 16r5B5D 16r7C79 16r6548 16r7C7A 16r6585 16r7C7B 16r66C9 16r7C7C 16r689F 16r7C7D 16r6D8D 16r7C7E 16r6DC6 16r7D21 16r723B 16r7D22 16r80B4 16r7D23 16r9175 16r7D24 16r9A4D 16r7D25 16r4FAF 16r7D26 16r5019 16r7D27 16r539A 16r7D28 16r540E 16r7D29 16r543C 16r7D2A 16r5589 16r7D2B 16r55C5 16r7D2C 16r5E3F 16r7D2D 16r5F8C 16r7D2E 16r673D 16r7D2F 16r7166 16r7D30 16r73DD 16r7D31 16r9005 16r7D32 16r52DB 16r7D33 16r52F3 16r7D34 16r5864 16r7D35 16r58CE 16r7D36 16r7104 16r7D37 16r718F 16r7D38 16r71FB 16r7D39 16r85B0 16r7D3A 16r8A13 16r7D3B 16r6688 16r7D3C 16r85A8 16r7D3D 16r55A7 16r7D3E 16r6684 16r7D3F 16r714A 16r7D40 16r8431 16r7D41 16r5349 16r7D42 16r5599 16r7D43 16r6BC1 16r7D44 16r5F59 16r7D45 16r5FBD 16r7D46 16r63EE 16r7D47 16r6689 16r7D48 16r7147 16r7D49 16r8AF1 16r7D4A 16r8F1D 16r7D4B 16r9EBE 16r7D4C 16r4F11 16r7D4D 16r643A 16r7D4E 16r70CB 16r7D4F 16r7566 16r7D50 16r8667 16r7D51 16r6064 16r7D52 16r8B4E 16r7D53 16r9DF8 16r7D54 16r5147 16r7D55 16r51F6 16r7D56 16r5308 16r7D57 16r6D36 16r7D58 16r80F8 16r7D59 16r9ED1 16r7D5A 16r6615 16r7D5B 16r6B23 16r7D5C 16r7098 16r7D5D 16r75D5 16r7D5E 16r5403 16r7D5F 16r5C79 16r7D60 16r7D07 16r7D61 16r8A16 16r7D62 16r6B20 16r7D63 16r6B3D 16r7D64 16r6B46 16r7D65 16r5438 16r7D66 16r6070 16r7D67 16r6D3D 16r7D68 16r7FD5 16r7D69 16r8208 16r7D6A 16r50D6 16r7D6B 16r51DE 16r7D6C 16r559C 16r7D6D 16r566B 16r7D6E 16r56CD 16r7D6F 16r59EC 16r7D70 16r5B09 16r7D71 16r5E0C 16r7D72 16r6199 16r7D73 16r6198 16r7D74 16r6231 16r7D75 16r665E 16r7D76 16r66E6 16r7D77 16r7199 16r7D78 16r71B9 16r7D79 16r71BA 16r7D7A 16r72A7 16r7D7B 16r79A7 16r7D7C 16r7A00 16r7D7D 16r7FB2 16r7D7E 16r8A70).
	table size even ifFalse: [^ self error: 'given table size must be even'].
	size := table size / 2.
	ksX1001 := Array new: size.
	unicode := Array new: size.
	1 to: table size by: 2 do: [:index |
		| tableIndex |
		tableIndex := index + 1 / 2.
		ksX1001 at: tableIndex put: (table at: index).
		unicode at: tableIndex put: (table at: index + 1)].
	ksX10012 := Array new: 94*94 withAll: -1.
	ksX1001 withIndexDo: [:elem :index | | uIndex u code |
		code := (elem // 256 - 33) * 94 + (elem \\ 256 - 33) + 1.
		(ksX10012 at: code) ~= -1 ifTrue: [self error].
		uIndex := ksX1001 indexOf: elem.
		uIndex = 0 ifFalse: [
			u := unicode at: uIndex.
			ksX10012 at: code put: u.
		].
	].
	KSX1001Table := ksX10012
! !

!UCSTable class methodsFor: 'accessing - table' stamp: 'yo 10/14/2003 10:36'!
ksx1001Table

	^ KSX1001Table.
! !

!UCSTable class methodsFor: '*Unicode-Initialization' stamp: 'MarcusDenker 9/12/2013 16:40'!
initializeJISX0208Table
	"self halt. UCSTable initializeJISX0208Table"

	| table size jisX0208 unicode jisX02082 |
	table := #(16r2121 16r3000 16r2122 16r3001 16r2123 16r3002 16r2124 16rFF0C 16r2125 16rFF0E 16r2126 16r30FB 16r2127 16rFF1A 16r2128 16rFF1B 16r2129 16rFF1F 16r212A 16rFF01 16r212B 16r309B 16r212C 16r309C 16r212D 16rB4 16r212E 16rFF40 16r212F 16rA8 16r2130 16rFF3E 16r2131 16rFFE3 16r2132 16rFF3F 16r2133 16r30FD 16r2134 16r30FE 16r2135 16r309D 16r2136 16r309E 16r2137 16r3003 16r2138 16r4EDD 16r2139 16r3005 16r213A 16r3006 16r213B 16r3007 16r213C 16r30FC 16r213D 16r2015 16r213E 16r2010 16r213F 16rFF0F 16r2140 16r5C 16r2141 16r301C 16r2142 16r2016 16r2143 16rFF5C 16r2144 16r2026 16r2145 16r2025 16r2146 16r2018 16r2147 16r2019 16r2148 16r201C 16r2149 16r201D 16r214A 16rFF08 16r214B 16rFF09 16r214C 16r3014 16r214D 16r3015 16r214E 16rFF3B 16r214F 16rFF3D 16r2150 16rFF5B 16r2151 16rFF5D 16r2152 16r3008 16r2153 16r3009 16r2154 16r300A 16r2155 16r300B 16r2156 16r300C 16r2157 16r300D 16r2158 16r300E 16r2159 16r300F 16r215A 16r3010 16r215B 16r3011 16r215C 16rFF0B 16r215D 16r2212 16r215E 16rB1 16r215F 16rD7 16r2160 16rF7 16r2161 16rFF1D 16r2162 16r2260 16r2163 16rFF1C 16r2164 16rFF1E 16r2165 16r2266 16r2166 16r2267 16r2167 16r221E 16r2168 16r2234 16r2169 16r2642 16r216A 16r2640 16r216B 16rB0 16r216C 16r2032 16r216D 16r2033 16r216E 16r2103 16r216F 16rFFE5 16r2170 16rFF04 16r2171 16rA2 16r2172 16rA3 16r2173 16rFF05 16r2174 16rFF03 16r2175 16rFF06 16r2176 16rFF0A 16r2177 16rFF20 16r2178 16rA7 16r2179 16r2606 16r217A 16r2605 16r217B 16r25CB 16r217C 16r25CF 16r217D 16r25CE 16r217E 16r25C7 16r2221 16r25C6 16r2222 16r25A1 16r2223 16r25A0 16r2224 16r25B3 16r2225 16r25B2 16r2226 16r25BD 16r2227 16r25BC 16r2228 16r203B 16r2229 16r3012 16r222A 16r2192 16r222B 16r2190 16r222C 16r2191 16r222D 16r2193 16r222E 16r3013 16r223A 16r2208 16r223B 16r220B 16r223C 16r2286 16r223D 16r2287 16r223E 16r2282 16r223F 16r2283 16r2240 16r222A 16r2241 16r2229 16r224A 16r2227 16r224B 16r2228 16r224C 16rAC 16r224D 16r21D2 16r224E 16r21D4 16r224F 16r2200 16r2250 16r2203 16r225C 16r2220 16r225D 16r22A5 16r225E 16r2312 16r225F 16r2202 16r2260 16r2207 16r2261 16r2261 16r2262 16r2252 16r2263 16r226A 16r2264 16r226B 16r2265 16r221A 16r2266 16r223D 16r2267 16r221D 16r2268 16r2235 16r2269 16r222B 16r226A 16r222C 16r2272 16r212B 16r2273 16r2030 16r2274 16r266F 16r2275 16r266D 16r2276 16r266A 16r2277 16r2020 16r2278 16r2021 16r2279 16rB6 16r227E 16r25EF 16r2330 16rFF10 16r2331 16rFF11 16r2332 16rFF12 16r2333 16rFF13 16r2334 16rFF14 16r2335 16rFF15 16r2336 16rFF16 16r2337 16rFF17 16r2338 16rFF18 16r2339 16rFF19 16r2341 16rFF21 16r2342 16rFF22 16r2343 16rFF23 16r2344 16rFF24 16r2345 16rFF25 16r2346 16rFF26 16r2347 16rFF27 16r2348 16rFF28 16r2349 16rFF29 16r234A 16rFF2A 16r234B 16rFF2B 16r234C 16rFF2C 16r234D 16rFF2D 16r234E 16rFF2E 16r234F 16rFF2F 16r2350 16rFF30 16r2351 16rFF31 16r2352 16rFF32 16r2353 16rFF33 16r2354 16rFF34 16r2355 16rFF35 16r2356 16rFF36 16r2357 16rFF37 16r2358 16rFF38 16r2359 16rFF39 16r235A 16rFF3A 16r2361 16rFF41 16r2362 16rFF42 16r2363 16rFF43 16r2364 16rFF44 16r2365 16rFF45 16r2366 16rFF46 16r2367 16rFF47 16r2368 16rFF48 16r2369 16rFF49 16r236A 16rFF4A 16r236B 16rFF4B 16r236C 16rFF4C 16r236D 16rFF4D 16r236E 16rFF4E 16r236F 16rFF4F 16r2370 16rFF50 16r2371 16rFF51 16r2372 16rFF52 16r2373 16rFF53 16r2374 16rFF54 16r2375 16rFF55 16r2376 16rFF56 16r2377 16rFF57 16r2378 16rFF58 16r2379 16rFF59 16r237A 16rFF5A 16r2421 16r3041 16r2422 16r3042 16r2423 16r3043 16r2424 16r3044 16r2425 16r3045 16r2426 16r3046 16r2427 16r3047 16r2428 16r3048 16r2429 16r3049 16r242A 16r304A 16r242B 16r304B 16r242C 16r304C 16r242D 16r304D 16r242E 16r304E 16r242F 16r304F 16r2430 16r3050 16r2431 16r3051 16r2432 16r3052 16r2433 16r3053 16r2434 16r3054 16r2435 16r3055 16r2436 16r3056 16r2437 16r3057 16r2438 16r3058 16r2439 16r3059 16r243A 16r305A 16r243B 16r305B 16r243C 16r305C 16r243D 16r305D 16r243E 16r305E 16r243F 16r305F 16r2440 16r3060 16r2441 16r3061 16r2442 16r3062 16r2443 16r3063 16r2444 16r3064 16r2445 16r3065 16r2446 16r3066 16r2447 16r3067 16r2448 16r3068 16r2449 16r3069 16r244A 16r306A 16r244B 16r306B 16r244C 16r306C 16r244D 16r306D 16r244E 16r306E 16r244F 16r306F 16r2450 16r3070 16r2451 16r3071 16r2452 16r3072 16r2453 16r3073 16r2454 16r3074 16r2455 16r3075 16r2456 16r3076 16r2457 16r3077 16r2458 16r3078 16r2459 16r3079 16r245A 16r307A 16r245B 16r307B 16r245C 16r307C 16r245D 16r307D 16r245E 16r307E 16r245F 16r307F 16r2460 16r3080 16r2461 16r3081 16r2462 16r3082 16r2463 16r3083 16r2464 16r3084 16r2465 16r3085 16r2466 16r3086 16r2467 16r3087 16r2468 16r3088 16r2469 16r3089 16r246A 16r308A 16r246B 16r308B 16r246C 16r308C 16r246D 16r308D 16r246E 16r308E 16r246F 16r308F 16r2470 16r3090 16r2471 16r3091 16r2472 16r3092 16r2473 16r3093 16r2521 16r30A1 16r2522 16r30A2 16r2523 16r30A3 16r2524 16r30A4 16r2525 16r30A5 16r2526 16r30A6 16r2527 16r30A7 16r2528 16r30A8 16r2529 16r30A9 16r252A 16r30AA 16r252B 16r30AB 16r252C 16r30AC 16r252D 16r30AD 16r252E 16r30AE 16r252F 16r30AF 16r2530 16r30B0 16r2531 16r30B1 16r2532 16r30B2 16r2533 16r30B3 16r2534 16r30B4 16r2535 16r30B5 16r2536 16r30B6 16r2537 16r30B7 16r2538 16r30B8 16r2539 16r30B9 16r253A 16r30BA 16r253B 16r30BB 16r253C 16r30BC 16r253D 16r30BD 16r253E 16r30BE 16r253F 16r30BF 16r2540 16r30C0 16r2541 16r30C1 16r2542 16r30C2 16r2543 16r30C3 16r2544 16r30C4 16r2545 16r30C5 16r2546 16r30C6 16r2547 16r30C7 16r2548 16r30C8 16r2549 16r30C9 16r254A 16r30CA 16r254B 16r30CB 16r254C 16r30CC 16r254D 16r30CD 16r254E 16r30CE 16r254F 16r30CF 16r2550 16r30D0 16r2551 16r30D1 16r2552 16r30D2 16r2553 16r30D3 16r2554 16r30D4 16r2555 16r30D5 16r2556 16r30D6 16r2557 16r30D7 16r2558 16r30D8 16r2559 16r30D9 16r255A 16r30DA 16r255B 16r30DB 16r255C 16r30DC 16r255D 16r30DD 16r255E 16r30DE 16r255F 16r30DF 16r2560 16r30E0 16r2561 16r30E1 16r2562 16r30E2 16r2563 16r30E3 16r2564 16r30E4 16r2565 16r30E5 16r2566 16r30E6 16r2567 16r30E7 16r2568 16r30E8 16r2569 16r30E9 16r256A 16r30EA 16r256B 16r30EB 16r256C 16r30EC 16r256D 16r30ED 16r256E 16r30EE 16r256F 16r30EF 16r2570 16r30F0 16r2571 16r30F1 16r2572 16r30F2 16r2573 16r30F3 16r2574 16r30F4 16r2575 16r30F5 16r2576 16r30F6 16r2621 16r391 16r2622 16r392 16r2623 16r393 16r2624 16r394 16r2625 16r395 16r2626 16r396 16r2627 16r397 16r2628 16r398 16r2629 16r399 16r262A 16r39A 16r262B 16r39B 16r262C 16r39C 16r262D 16r39D 16r262E 16r39E 16r262F 16r39F 16r2630 16r3A0 16r2631 16r3A1 16r2632 16r3A3 16r2633 16r3A4 16r2634 16r3A5 16r2635 16r3A6 16r2636 16r3A7 16r2637 16r3A8 16r2638 16r3A9 16r2641 16r3B1 16r2642 16r3B2 16r2643 16r3B3 16r2644 16r3B4 16r2645 16r3B5 16r2646 16r3B6 16r2647 16r3B7 16r2648 16r3B8 16r2649 16r3B9 16r264A 16r3BA 16r264B 16r3BB 16r264C 16r3BC 16r264D 16r3BD 16r264E 16r3BE 16r264F 16r3BF 16r2650 16r3C0 16r2651 16r3C1 16r2652 16r3C3 16r2653 16r3C4 16r2654 16r3C5 16r2655 16r3C6 16r2656 16r3C7 16r2657 16r3C8 16r2658 16r3C9 16r2721 16r410 16r2722 16r411 16r2723 16r412 16r2724 16r413 16r2725 16r414 16r2726 16r415 16r2727 16r401 16r2728 16r416 16r2729 16r417 16r272A 16r418 16r272B 16r419 16r272C 16r41A 16r272D 16r41B 16r272E 16r41C 16r272F 16r41D 16r2730 16r41E 16r2731 16r41F 16r2732 16r420 16r2733 16r421 16r2734 16r422 16r2735 16r423 16r2736 16r424 16r2737 16r425 16r2738 16r426 16r2739 16r427 16r273A 16r428 16r273B 16r429 16r273C 16r42A 16r273D 16r42B 16r273E 16r42C 16r273F 16r42D 16r2740 16r42E 16r2741 16r42F 16r2751 16r430 16r2752 16r431 16r2753 16r432 16r2754 16r433 16r2755 16r434 16r2756 16r435 16r2757 16r451 16r2758 16r436 16r2759 16r437 16r275A 16r438 16r275B 16r439 16r275C 16r43A 16r275D 16r43B 16r275E 16r43C 16r275F 16r43D 16r2760 16r43E 16r2761 16r43F 16r2762 16r440 16r2763 16r441 16r2764 16r442 16r2765 16r443 16r2766 16r444 16r2767 16r445 16r2768 16r446 16r2769 16r447 16r276A 16r448 16r276B 16r449 16r276C 16r44A 16r276D 16r44B 16r276E 16r44C 16r276F 16r44D 16r2770 16r44E 16r2771 16r44F 16r2821 16r2500 16r2822 16r2502 16r2823 16r250C 16r2824 16r2510 16r2825 16r2518 16r2826 16r2514 16r2827 16r251C 16r2828 16r252C 16r2829 16r2524 16r282A 16r2534 16r282B 16r253C 16r282C 16r2501 16r282D 16r2503 16r282E 16r250F 16r282F 16r2513 16r2830 16r251B 16r2831 16r2517 16r2832 16r2523 16r2833 16r2533 16r2834 16r252B 16r2835 16r253B 16r2836 16r254B 16r2837 16r2520 16r2838 16r252F 16r2839 16r2528 16r283A 16r2537 16r283B 16r253F 16r283C 16r251D 16r283D 16r2530 16r283E 16r2525 16r283F 16r2538 16r2840 16r2542 16r3021 16r4E9C 16r3022 16r5516 16r3023 16r5A03 16r3024 16r963F 16r3025 16r54C0 16r3026 16r611B 16r3027 16r6328 16r3028 16r59F6 16r3029 16r9022 16r302A 16r8475 16r302B 16r831C 16r302C 16r7A50 16r302D 16r60AA 16r302E 16r63E1 16r302F 16r6E25 16r3030 16r65ED 16r3031 16r8466 16r3032 16r82A6 16r3033 16r9BF5 16r3034 16r6893 16r3035 16r5727 16r3036 16r65A1 16r3037 16r6271 16r3038 16r5B9B 16r3039 16r59D0 16r303A 16r867B 16r303B 16r98F4 16r303C 16r7D62 16r303D 16r7DBE 16r303E 16r9B8E 16r303F 16r6216 16r3040 16r7C9F 16r3041 16r88B7 16r3042 16r5B89 16r3043 16r5EB5 16r3044 16r6309 16r3045 16r6697 16r3046 16r6848 16r3047 16r95C7 16r3048 16r978D 16r3049 16r674F 16r304A 16r4EE5 16r304B 16r4F0A 16r304C 16r4F4D 16r304D 16r4F9D 16r304E 16r5049 16r304F 16r56F2 16r3050 16r5937 16r3051 16r59D4 16r3052 16r5A01 16r3053 16r5C09 16r3054 16r60DF 16r3055 16r610F 16r3056 16r6170 16r3057 16r6613 16r3058 16r6905 16r3059 16r70BA 16r305A 16r754F 16r305B 16r7570 16r305C 16r79FB 16r305D 16r7DAD 16r305E 16r7DEF 16r305F 16r80C3 16r3060 16r840E 16r3061 16r8863 16r3062 16r8B02 16r3063 16r9055 16r3064 16r907A 16r3065 16r533B 16r3066 16r4E95 16r3067 16r4EA5 16r3068 16r57DF 16r3069 16r80B2 16r306A 16r90C1 16r306B 16r78EF 16r306C 16r4E00 16r306D 16r58F1 16r306E 16r6EA2 16r306F 16r9038 16r3070 16r7A32 16r3071 16r8328 16r3072 16r828B 16r3073 16r9C2F 16r3074 16r5141 16r3075 16r5370 16r3076 16r54BD 16r3077 16r54E1 16r3078 16r56E0 16r3079 16r59FB 16r307A 16r5F15 16r307B 16r98F2 16r307C 16r6DEB 16r307D 16r80E4 16r307E 16r852D 16r3121 16r9662 16r3122 16r9670 16r3123 16r96A0 16r3124 16r97FB 16r3125 16r540B 16r3126 16r53F3 16r3127 16r5B87 16r3128 16r70CF 16r3129 16r7FBD 16r312A 16r8FC2 16r312B 16r96E8 16r312C 16r536F 16r312D 16r9D5C 16r312E 16r7ABA 16r312F 16r4E11 16r3130 16r7893 16r3131 16r81FC 16r3132 16r6E26 16r3133 16r5618 16r3134 16r5504 16r3135 16r6B1D 16r3136 16r851A 16r3137 16r9C3B 16r3138 16r59E5 16r3139 16r53A9 16r313A 16r6D66 16r313B 16r74DC 16r313C 16r958F 16r313D 16r5642 16r313E 16r4E91 16r313F 16r904B 16r3140 16r96F2 16r3141 16r834F 16r3142 16r990C 16r3143 16r53E1 16r3144 16r55B6 16r3145 16r5B30 16r3146 16r5F71 16r3147 16r6620 16r3148 16r66F3 16r3149 16r6804 16r314A 16r6C38 16r314B 16r6CF3 16r314C 16r6D29 16r314D 16r745B 16r314E 16r76C8 16r314F 16r7A4E 16r3150 16r9834 16r3151 16r82F1 16r3152 16r885B 16r3153 16r8A60 16r3154 16r92ED 16r3155 16r6DB2 16r3156 16r75AB 16r3157 16r76CA 16r3158 16r99C5 16r3159 16r60A6 16r315A 16r8B01 16r315B 16r8D8A 16r315C 16r95B2 16r315D 16r698E 16r315E 16r53AD 16r315F 16r5186 16r3160 16r5712 16r3161 16r5830 16r3162 16r5944 16r3163 16r5BB4 16r3164 16r5EF6 16r3165 16r6028 16r3166 16r63A9 16r3167 16r63F4 16r3168 16r6CBF 16r3169 16r6F14 16r316A 16r708E 16r316B 16r7114 16r316C 16r7159 16r316D 16r71D5 16r316E 16r733F 16r316F 16r7E01 16r3170 16r8276 16r3171 16r82D1 16r3172 16r8597 16r3173 16r9060 16r3174 16r925B 16r3175 16r9D1B 16r3176 16r5869 16r3177 16r65BC 16r3178 16r6C5A 16r3179 16r7525 16r317A 16r51F9 16r317B 16r592E 16r317C 16r5965 16r317D 16r5F80 16r317E 16r5FDC 16r3221 16r62BC 16r3222 16r65FA 16r3223 16r6A2A 16r3224 16r6B27 16r3225 16r6BB4 16r3226 16r738B 16r3227 16r7FC1 16r3228 16r8956 16r3229 16r9D2C 16r322A 16r9D0E 16r322B 16r9EC4 16r322C 16r5CA1 16r322D 16r6C96 16r322E 16r837B 16r322F 16r5104 16r3230 16r5C4B 16r3231 16r61B6 16r3232 16r81C6 16r3233 16r6876 16r3234 16r7261 16r3235 16r4E59 16r3236 16r4FFA 16r3237 16r5378 16r3238 16r6069 16r3239 16r6E29 16r323A 16r7A4F 16r323B 16r97F3 16r323C 16r4E0B 16r323D 16r5316 16r323E 16r4EEE 16r323F 16r4F55 16r3240 16r4F3D 16r3241 16r4FA1 16r3242 16r4F73 16r3243 16r52A0 16r3244 16r53EF 16r3245 16r5609 16r3246 16r590F 16r3247 16r5AC1 16r3248 16r5BB6 16r3249 16r5BE1 16r324A 16r79D1 16r324B 16r6687 16r324C 16r679C 16r324D 16r67B6 16r324E 16r6B4C 16r324F 16r6CB3 16r3250 16r706B 16r3251 16r73C2 16r3252 16r798D 16r3253 16r79BE 16r3254 16r7A3C 16r3255 16r7B87 16r3256 16r82B1 16r3257 16r82DB 16r3258 16r8304 16r3259 16r8377 16r325A 16r83EF 16r325B 16r83D3 16r325C 16r8766 16r325D 16r8AB2 16r325E 16r5629 16r325F 16r8CA8 16r3260 16r8FE6 16r3261 16r904E 16r3262 16r971E 16r3263 16r868A 16r3264 16r4FC4 16r3265 16r5CE8 16r3266 16r6211 16r3267 16r7259 16r3268 16r753B 16r3269 16r81E5 16r326A 16r82BD 16r326B 16r86FE 16r326C 16r8CC0 16r326D 16r96C5 16r326E 16r9913 16r326F 16r99D5 16r3270 16r4ECB 16r3271 16r4F1A 16r3272 16r89E3 16r3273 16r56DE 16r3274 16r584A 16r3275 16r58CA 16r3276 16r5EFB 16r3277 16r5FEB 16r3278 16r602A 16r3279 16r6094 16r327A 16r6062 16r327B 16r61D0 16r327C 16r6212 16r327D 16r62D0 16r327E 16r6539 16r3321 16r9B41 16r3322 16r6666 16r3323 16r68B0 16r3324 16r6D77 16r3325 16r7070 16r3326 16r754C 16r3327 16r7686 16r3328 16r7D75 16r3329 16r82A5 16r332A 16r87F9 16r332B 16r958B 16r332C 16r968E 16r332D 16r8C9D 16r332E 16r51F1 16r332F 16r52BE 16r3330 16r5916 16r3331 16r54B3 16r3332 16r5BB3 16r3333 16r5D16 16r3334 16r6168 16r3335 16r6982 16r3336 16r6DAF 16r3337 16r788D 16r3338 16r84CB 16r3339 16r8857 16r333A 16r8A72 16r333B 16r93A7 16r333C 16r9AB8 16r333D 16r6D6C 16r333E 16r99A8 16r333F 16r86D9 16r3340 16r57A3 16r3341 16r67FF 16r3342 16r86CE 16r3343 16r920E 16r3344 16r5283 16r3345 16r5687 16r3346 16r5404 16r3347 16r5ED3 16r3348 16r62E1 16r3349 16r64B9 16r334A 16r683C 16r334B 16r6838 16r334C 16r6BBB 16r334D 16r7372 16r334E 16r78BA 16r334F 16r7A6B 16r3350 16r899A 16r3351 16r89D2 16r3352 16r8D6B 16r3353 16r8F03 16r3354 16r90ED 16r3355 16r95A3 16r3356 16r9694 16r3357 16r9769 16r3358 16r5B66 16r3359 16r5CB3 16r335A 16r697D 16r335B 16r984D 16r335C 16r984E 16r335D 16r639B 16r335E 16r7B20 16r335F 16r6A2B 16r3360 16r6A7F 16r3361 16r68B6 16r3362 16r9C0D 16r3363 16r6F5F 16r3364 16r5272 16r3365 16r559D 16r3366 16r6070 16r3367 16r62EC 16r3368 16r6D3B 16r3369 16r6E07 16r336A 16r6ED1 16r336B 16r845B 16r336C 16r8910 16r336D 16r8F44 16r336E 16r4E14 16r336F 16r9C39 16r3370 16r53F6 16r3371 16r691B 16r3372 16r6A3A 16r3373 16r9784 16r3374 16r682A 16r3375 16r515C 16r3376 16r7AC3 16r3377 16r84B2 16r3378 16r91DC 16r3379 16r938C 16r337A 16r565B 16r337B 16r9D28 16r337C 16r6822 16r337D 16r8305 16r337E 16r8431 16r3421 16r7CA5 16r3422 16r5208 16r3423 16r82C5 16r3424 16r74E6 16r3425 16r4E7E 16r3426 16r4F83 16r3427 16r51A0 16r3428 16r5BD2 16r3429 16r520A 16r342A 16r52D8 16r342B 16r52E7 16r342C 16r5DFB 16r342D 16r559A 16r342E 16r582A 16r342F 16r59E6 16r3430 16r5B8C 16r3431 16r5B98 16r3432 16r5BDB 16r3433 16r5E72 16r3434 16r5E79 16r3435 16r60A3 16r3436 16r611F 16r3437 16r6163 16r3438 16r61BE 16r3439 16r63DB 16r343A 16r6562 16r343B 16r67D1 16r343C 16r6853 16r343D 16r68FA 16r343E 16r6B3E 16r343F 16r6B53 16r3440 16r6C57 16r3441 16r6F22 16r3442 16r6F97 16r3443 16r6F45 16r3444 16r74B0 16r3445 16r7518 16r3446 16r76E3 16r3447 16r770B 16r3448 16r7AFF 16r3449 16r7BA1 16r344A 16r7C21 16r344B 16r7DE9 16r344C 16r7F36 16r344D 16r7FF0 16r344E 16r809D 16r344F 16r8266 16r3450 16r839E 16r3451 16r89B3 16r3452 16r8ACC 16r3453 16r8CAB 16r3454 16r9084 16r3455 16r9451 16r3456 16r9593 16r3457 16r9591 16r3458 16r95A2 16r3459 16r9665 16r345A 16r97D3 16r345B 16r9928 16r345C 16r8218 16r345D 16r4E38 16r345E 16r542B 16r345F 16r5CB8 16r3460 16r5DCC 16r3461 16r73A9 16r3462 16r764C 16r3463 16r773C 16r3464 16r5CA9 16r3465 16r7FEB 16r3466 16r8D0B 16r3467 16r96C1 16r3468 16r9811 16r3469 16r9854 16r346A 16r9858 16r346B 16r4F01 16r346C 16r4F0E 16r346D 16r5371 16r346E 16r559C 16r346F 16r5668 16r3470 16r57FA 16r3471 16r5947 16r3472 16r5B09 16r3473 16r5BC4 16r3474 16r5C90 16r3475 16r5E0C 16r3476 16r5E7E 16r3477 16r5FCC 16r3478 16r63EE 16r3479 16r673A 16r347A 16r65D7 16r347B 16r65E2 16r347C 16r671F 16r347D 16r68CB 16r347E 16r68C4 16r3521 16r6A5F 16r3522 16r5E30 16r3523 16r6BC5 16r3524 16r6C17 16r3525 16r6C7D 16r3526 16r757F 16r3527 16r7948 16r3528 16r5B63 16r3529 16r7A00 16r352A 16r7D00 16r352B 16r5FBD 16r352C 16r898F 16r352D 16r8A18 16r352E 16r8CB4 16r352F 16r8D77 16r3530 16r8ECC 16r3531 16r8F1D 16r3532 16r98E2 16r3533 16r9A0E 16r3534 16r9B3C 16r3535 16r4E80 16r3536 16r507D 16r3537 16r5100 16r3538 16r5993 16r3539 16r5B9C 16r353A 16r622F 16r353B 16r6280 16r353C 16r64EC 16r353D 16r6B3A 16r353E 16r72A0 16r353F 16r7591 16r3540 16r7947 16r3541 16r7FA9 16r3542 16r87FB 16r3543 16r8ABC 16r3544 16r8B70 16r3545 16r63AC 16r3546 16r83CA 16r3547 16r97A0 16r3548 16r5409 16r3549 16r5403 16r354A 16r55AB 16r354B 16r6854 16r354C 16r6A58 16r354D 16r8A70 16r354E 16r7827 16r354F 16r6775 16r3550 16r9ECD 16r3551 16r5374 16r3552 16r5BA2 16r3553 16r811A 16r3554 16r8650 16r3555 16r9006 16r3556 16r4E18 16r3557 16r4E45 16r3558 16r4EC7 16r3559 16r4F11 16r355A 16r53CA 16r355B 16r5438 16r355C 16r5BAE 16r355D 16r5F13 16r355E 16r6025 16r355F 16r6551 16r3560 16r673D 16r3561 16r6C42 16r3562 16r6C72 16r3563 16r6CE3 16r3564 16r7078 16r3565 16r7403 16r3566 16r7A76 16r3567 16r7AAE 16r3568 16r7B08 16r3569 16r7D1A 16r356A 16r7CFE 16r356B 16r7D66 16r356C 16r65E7 16r356D 16r725B 16r356E 16r53BB 16r356F 16r5C45 16r3570 16r5DE8 16r3571 16r62D2 16r3572 16r62E0 16r3573 16r6319 16r3574 16r6E20 16r3575 16r865A 16r3576 16r8A31 16r3577 16r8DDD 16r3578 16r92F8 16r3579 16r6F01 16r357A 16r79A6 16r357B 16r9B5A 16r357C 16r4EA8 16r357D 16r4EAB 16r357E 16r4EAC 16r3621 16r4F9B 16r3622 16r4FA0 16r3623 16r50D1 16r3624 16r5147 16r3625 16r7AF6 16r3626 16r5171 16r3627 16r51F6 16r3628 16r5354 16r3629 16r5321 16r362A 16r537F 16r362B 16r53EB 16r362C 16r55AC 16r362D 16r5883 16r362E 16r5CE1 16r362F 16r5F37 16r3630 16r5F4A 16r3631 16r602F 16r3632 16r6050 16r3633 16r606D 16r3634 16r631F 16r3635 16r6559 16r3636 16r6A4B 16r3637 16r6CC1 16r3638 16r72C2 16r3639 16r72ED 16r363A 16r77EF 16r363B 16r80F8 16r363C 16r8105 16r363D 16r8208 16r363E 16r854E 16r363F 16r90F7 16r3640 16r93E1 16r3641 16r97FF 16r3642 16r9957 16r3643 16r9A5A 16r3644 16r4EF0 16r3645 16r51DD 16r3646 16r5C2D 16r3647 16r6681 16r3648 16r696D 16r3649 16r5C40 16r364A 16r66F2 16r364B 16r6975 16r364C 16r7389 16r364D 16r6850 16r364E 16r7C81 16r364F 16r50C5 16r3650 16r52E4 16r3651 16r5747 16r3652 16r5DFE 16r3653 16r9326 16r3654 16r65A4 16r3655 16r6B23 16r3656 16r6B3D 16r3657 16r7434 16r3658 16r7981 16r3659 16r79BD 16r365A 16r7B4B 16r365B 16r7DCA 16r365C 16r82B9 16r365D 16r83CC 16r365E 16r887F 16r365F 16r895F 16r3660 16r8B39 16r3661 16r8FD1 16r3662 16r91D1 16r3663 16r541F 16r3664 16r9280 16r3665 16r4E5D 16r3666 16r5036 16r3667 16r53E5 16r3668 16r533A 16r3669 16r72D7 16r366A 16r7396 16r366B 16r77E9 16r366C 16r82E6 16r366D 16r8EAF 16r366E 16r99C6 16r366F 16r99C8 16r3670 16r99D2 16r3671 16r5177 16r3672 16r611A 16r3673 16r865E 16r3674 16r55B0 16r3675 16r7A7A 16r3676 16r5076 16r3677 16r5BD3 16r3678 16r9047 16r3679 16r9685 16r367A 16r4E32 16r367B 16r6ADB 16r367C 16r91E7 16r367D 16r5C51 16r367E 16r5C48 16r3721 16r6398 16r3722 16r7A9F 16r3723 16r6C93 16r3724 16r9774 16r3725 16r8F61 16r3726 16r7AAA 16r3727 16r718A 16r3728 16r9688 16r3729 16r7C82 16r372A 16r6817 16r372B 16r7E70 16r372C 16r6851 16r372D 16r936C 16r372E 16r52F2 16r372F 16r541B 16r3730 16r85AB 16r3731 16r8A13 16r3732 16r7FA4 16r3733 16r8ECD 16r3734 16r90E1 16r3735 16r5366 16r3736 16r8888 16r3737 16r7941 16r3738 16r4FC2 16r3739 16r50BE 16r373A 16r5211 16r373B 16r5144 16r373C 16r5553 16r373D 16r572D 16r373E 16r73EA 16r373F 16r578B 16r3740 16r5951 16r3741 16r5F62 16r3742 16r5F84 16r3743 16r6075 16r3744 16r6176 16r3745 16r6167 16r3746 16r61A9 16r3747 16r63B2 16r3748 16r643A 16r3749 16r656C 16r374A 16r666F 16r374B 16r6842 16r374C 16r6E13 16r374D 16r7566 16r374E 16r7A3D 16r374F 16r7CFB 16r3750 16r7D4C 16r3751 16r7D99 16r3752 16r7E4B 16r3753 16r7F6B 16r3754 16r830E 16r3755 16r834A 16r3756 16r86CD 16r3757 16r8A08 16r3758 16r8A63 16r3759 16r8B66 16r375A 16r8EFD 16r375B 16r981A 16r375C 16r9D8F 16r375D 16r82B8 16r375E 16r8FCE 16r375F 16r9BE8 16r3760 16r5287 16r3761 16r621F 16r3762 16r6483 16r3763 16r6FC0 16r3764 16r9699 16r3765 16r6841 16r3766 16r5091 16r3767 16r6B20 16r3768 16r6C7A 16r3769 16r6F54 16r376A 16r7A74 16r376B 16r7D50 16r376C 16r8840 16r376D 16r8A23 16r376E 16r6708 16r376F 16r4EF6 16r3770 16r5039 16r3771 16r5026 16r3772 16r5065 16r3773 16r517C 16r3774 16r5238 16r3775 16r5263 16r3776 16r55A7 16r3777 16r570F 16r3778 16r5805 16r3779 16r5ACC 16r377A 16r5EFA 16r377B 16r61B2 16r377C 16r61F8 16r377D 16r62F3 16r377E 16r6372 16r3821 16r691C 16r3822 16r6A29 16r3823 16r727D 16r3824 16r72AC 16r3825 16r732E 16r3826 16r7814 16r3827 16r786F 16r3828 16r7D79 16r3829 16r770C 16r382A 16r80A9 16r382B 16r898B 16r382C 16r8B19 16r382D 16r8CE2 16r382E 16r8ED2 16r382F 16r9063 16r3830 16r9375 16r3831 16r967A 16r3832 16r9855 16r3833 16r9A13 16r3834 16r9E78 16r3835 16r5143 16r3836 16r539F 16r3837 16r53B3 16r3838 16r5E7B 16r3839 16r5F26 16r383A 16r6E1B 16r383B 16r6E90 16r383C 16r7384 16r383D 16r73FE 16r383E 16r7D43 16r383F 16r8237 16r3840 16r8A00 16r3841 16r8AFA 16r3842 16r9650 16r3843 16r4E4E 16r3844 16r500B 16r3845 16r53E4 16r3846 16r547C 16r3847 16r56FA 16r3848 16r59D1 16r3849 16r5B64 16r384A 16r5DF1 16r384B 16r5EAB 16r384C 16r5F27 16r384D 16r6238 16r384E 16r6545 16r384F 16r67AF 16r3850 16r6E56 16r3851 16r72D0 16r3852 16r7CCA 16r3853 16r88B4 16r3854 16r80A1 16r3855 16r80E1 16r3856 16r83F0 16r3857 16r864E 16r3858 16r8A87 16r3859 16r8DE8 16r385A 16r9237 16r385B 16r96C7 16r385C 16r9867 16r385D 16r9F13 16r385E 16r4E94 16r385F 16r4E92 16r3860 16r4F0D 16r3861 16r5348 16r3862 16r5449 16r3863 16r543E 16r3864 16r5A2F 16r3865 16r5F8C 16r3866 16r5FA1 16r3867 16r609F 16r3868 16r68A7 16r3869 16r6A8E 16r386A 16r745A 16r386B 16r7881 16r386C 16r8A9E 16r386D 16r8AA4 16r386E 16r8B77 16r386F 16r9190 16r3870 16r4E5E 16r3871 16r9BC9 16r3872 16r4EA4 16r3873 16r4F7C 16r3874 16r4FAF 16r3875 16r5019 16r3876 16r5016 16r3877 16r5149 16r3878 16r516C 16r3879 16r529F 16r387A 16r52B9 16r387B 16r52FE 16r387C 16r539A 16r387D 16r53E3 16r387E 16r5411 16r3921 16r540E 16r3922 16r5589 16r3923 16r5751 16r3924 16r57A2 16r3925 16r597D 16r3926 16r5B54 16r3927 16r5B5D 16r3928 16r5B8F 16r3929 16r5DE5 16r392A 16r5DE7 16r392B 16r5DF7 16r392C 16r5E78 16r392D 16r5E83 16r392E 16r5E9A 16r392F 16r5EB7 16r3930 16r5F18 16r3931 16r6052 16r3932 16r614C 16r3933 16r6297 16r3934 16r62D8 16r3935 16r63A7 16r3936 16r653B 16r3937 16r6602 16r3938 16r6643 16r3939 16r66F4 16r393A 16r676D 16r393B 16r6821 16r393C 16r6897 16r393D 16r69CB 16r393E 16r6C5F 16r393F 16r6D2A 16r3940 16r6D69 16r3941 16r6E2F 16r3942 16r6E9D 16r3943 16r7532 16r3944 16r7687 16r3945 16r786C 16r3946 16r7A3F 16r3947 16r7CE0 16r3948 16r7D05 16r3949 16r7D18 16r394A 16r7D5E 16r394B 16r7DB1 16r394C 16r8015 16r394D 16r8003 16r394E 16r80AF 16r394F 16r80B1 16r3950 16r8154 16r3951 16r818F 16r3952 16r822A 16r3953 16r8352 16r3954 16r884C 16r3955 16r8861 16r3956 16r8B1B 16r3957 16r8CA2 16r3958 16r8CFC 16r3959 16r90CA 16r395A 16r9175 16r395B 16r9271 16r395C 16r783F 16r395D 16r92FC 16r395E 16r95A4 16r395F 16r964D 16r3960 16r9805 16r3961 16r9999 16r3962 16r9AD8 16r3963 16r9D3B 16r3964 16r525B 16r3965 16r52AB 16r3966 16r53F7 16r3967 16r5408 16r3968 16r58D5 16r3969 16r62F7 16r396A 16r6FE0 16r396B 16r8C6A 16r396C 16r8F5F 16r396D 16r9EB9 16r396E 16r514B 16r396F 16r523B 16r3970 16r544A 16r3971 16r56FD 16r3972 16r7A40 16r3973 16r9177 16r3974 16r9D60 16r3975 16r9ED2 16r3976 16r7344 16r3977 16r6F09 16r3978 16r8170 16r3979 16r7511 16r397A 16r5FFD 16r397B 16r60DA 16r397C 16r9AA8 16r397D 16r72DB 16r397E 16r8FBC 16r3A21 16r6B64 16r3A22 16r9803 16r3A23 16r4ECA 16r3A24 16r56F0 16r3A25 16r5764 16r3A26 16r58BE 16r3A27 16r5A5A 16r3A28 16r6068 16r3A29 16r61C7 16r3A2A 16r660F 16r3A2B 16r6606 16r3A2C 16r6839 16r3A2D 16r68B1 16r3A2E 16r6DF7 16r3A2F 16r75D5 16r3A30 16r7D3A 16r3A31 16r826E 16r3A32 16r9B42 16r3A33 16r4E9B 16r3A34 16r4F50 16r3A35 16r53C9 16r3A36 16r5506 16r3A37 16r5D6F 16r3A38 16r5DE6 16r3A39 16r5DEE 16r3A3A 16r67FB 16r3A3B 16r6C99 16r3A3C 16r7473 16r3A3D 16r7802 16r3A3E 16r8A50 16r3A3F 16r9396 16r3A40 16r88DF 16r3A41 16r5750 16r3A42 16r5EA7 16r3A43 16r632B 16r3A44 16r50B5 16r3A45 16r50AC 16r3A46 16r518D 16r3A47 16r6700 16r3A48 16r54C9 16r3A49 16r585E 16r3A4A 16r59BB 16r3A4B 16r5BB0 16r3A4C 16r5F69 16r3A4D 16r624D 16r3A4E 16r63A1 16r3A4F 16r683D 16r3A50 16r6B73 16r3A51 16r6E08 16r3A52 16r707D 16r3A53 16r91C7 16r3A54 16r7280 16r3A55 16r7815 16r3A56 16r7826 16r3A57 16r796D 16r3A58 16r658E 16r3A59 16r7D30 16r3A5A 16r83DC 16r3A5B 16r88C1 16r3A5C 16r8F09 16r3A5D 16r969B 16r3A5E 16r5264 16r3A5F 16r5728 16r3A60 16r6750 16r3A61 16r7F6A 16r3A62 16r8CA1 16r3A63 16r51B4 16r3A64 16r5742 16r3A65 16r962A 16r3A66 16r583A 16r3A67 16r698A 16r3A68 16r80B4 16r3A69 16r54B2 16r3A6A 16r5D0E 16r3A6B 16r57FC 16r3A6C 16r7895 16r3A6D 16r9DFA 16r3A6E 16r4F5C 16r3A6F 16r524A 16r3A70 16r548B 16r3A71 16r643E 16r3A72 16r6628 16r3A73 16r6714 16r3A74 16r67F5 16r3A75 16r7A84 16r3A76 16r7B56 16r3A77 16r7D22 16r3A78 16r932F 16r3A79 16r685C 16r3A7A 16r9BAD 16r3A7B 16r7B39 16r3A7C 16r5319 16r3A7D 16r518A 16r3A7E 16r5237 16r3B21 16r5BDF 16r3B22 16r62F6 16r3B23 16r64AE 16r3B24 16r64E6 16r3B25 16r672D 16r3B26 16r6BBA 16r3B27 16r85A9 16r3B28 16r96D1 16r3B29 16r7690 16r3B2A 16r9BD6 16r3B2B 16r634C 16r3B2C 16r9306 16r3B2D 16r9BAB 16r3B2E 16r76BF 16r3B2F 16r6652 16r3B30 16r4E09 16r3B31 16r5098 16r3B32 16r53C2 16r3B33 16r5C71 16r3B34 16r60E8 16r3B35 16r6492 16r3B36 16r6563 16r3B37 16r685F 16r3B38 16r71E6 16r3B39 16r73CA 16r3B3A 16r7523 16r3B3B 16r7B97 16r3B3C 16r7E82 16r3B3D 16r8695 16r3B3E 16r8B83 16r3B3F 16r8CDB 16r3B40 16r9178 16r3B41 16r9910 16r3B42 16r65AC 16r3B43 16r66AB 16r3B44 16r6B8B 16r3B45 16r4ED5 16r3B46 16r4ED4 16r3B47 16r4F3A 16r3B48 16r4F7F 16r3B49 16r523A 16r3B4A 16r53F8 16r3B4B 16r53F2 16r3B4C 16r55E3 16r3B4D 16r56DB 16r3B4E 16r58EB 16r3B4F 16r59CB 16r3B50 16r59C9 16r3B51 16r59FF 16r3B52 16r5B50 16r3B53 16r5C4D 16r3B54 16r5E02 16r3B55 16r5E2B 16r3B56 16r5FD7 16r3B57 16r601D 16r3B58 16r6307 16r3B59 16r652F 16r3B5A 16r5B5C 16r3B5B 16r65AF 16r3B5C 16r65BD 16r3B5D 16r65E8 16r3B5E 16r679D 16r3B5F 16r6B62 16r3B60 16r6B7B 16r3B61 16r6C0F 16r3B62 16r7345 16r3B63 16r7949 16r3B64 16r79C1 16r3B65 16r7CF8 16r3B66 16r7D19 16r3B67 16r7D2B 16r3B68 16r80A2 16r3B69 16r8102 16r3B6A 16r81F3 16r3B6B 16r8996 16r3B6C 16r8A5E 16r3B6D 16r8A69 16r3B6E 16r8A66 16r3B6F 16r8A8C 16r3B70 16r8AEE 16r3B71 16r8CC7 16r3B72 16r8CDC 16r3B73 16r96CC 16r3B74 16r98FC 16r3B75 16r6B6F 16r3B76 16r4E8B 16r3B77 16r4F3C 16r3B78 16r4F8D 16r3B79 16r5150 16r3B7A 16r5B57 16r3B7B 16r5BFA 16r3B7C 16r6148 16r3B7D 16r6301 16r3B7E 16r6642 16r3C21 16r6B21 16r3C22 16r6ECB 16r3C23 16r6CBB 16r3C24 16r723E 16r3C25 16r74BD 16r3C26 16r75D4 16r3C27 16r78C1 16r3C28 16r793A 16r3C29 16r800C 16r3C2A 16r8033 16r3C2B 16r81EA 16r3C2C 16r8494 16r3C2D 16r8F9E 16r3C2E 16r6C50 16r3C2F 16r9E7F 16r3C30 16r5F0F 16r3C31 16r8B58 16r3C32 16r9D2B 16r3C33 16r7AFA 16r3C34 16r8EF8 16r3C35 16r5B8D 16r3C36 16r96EB 16r3C37 16r4E03 16r3C38 16r53F1 16r3C39 16r57F7 16r3C3A 16r5931 16r3C3B 16r5AC9 16r3C3C 16r5BA4 16r3C3D 16r6089 16r3C3E 16r6E7F 16r3C3F 16r6F06 16r3C40 16r75BE 16r3C41 16r8CEA 16r3C42 16r5B9F 16r3C43 16r8500 16r3C44 16r7BE0 16r3C45 16r5072 16r3C46 16r67F4 16r3C47 16r829D 16r3C48 16r5C61 16r3C49 16r854A 16r3C4A 16r7E1E 16r3C4B 16r820E 16r3C4C 16r5199 16r3C4D 16r5C04 16r3C4E 16r6368 16r3C4F 16r8D66 16r3C50 16r659C 16r3C51 16r716E 16r3C52 16r793E 16r3C53 16r7D17 16r3C54 16r8005 16r3C55 16r8B1D 16r3C56 16r8ECA 16r3C57 16r906E 16r3C58 16r86C7 16r3C59 16r90AA 16r3C5A 16r501F 16r3C5B 16r52FA 16r3C5C 16r5C3A 16r3C5D 16r6753 16r3C5E 16r707C 16r3C5F 16r7235 16r3C60 16r914C 16r3C61 16r91C8 16r3C62 16r932B 16r3C63 16r82E5 16r3C64 16r5BC2 16r3C65 16r5F31 16r3C66 16r60F9 16r3C67 16r4E3B 16r3C68 16r53D6 16r3C69 16r5B88 16r3C6A 16r624B 16r3C6B 16r6731 16r3C6C 16r6B8A 16r3C6D 16r72E9 16r3C6E 16r73E0 16r3C6F 16r7A2E 16r3C70 16r816B 16r3C71 16r8DA3 16r3C72 16r9152 16r3C73 16r9996 16r3C74 16r5112 16r3C75 16r53D7 16r3C76 16r546A 16r3C77 16r5BFF 16r3C78 16r6388 16r3C79 16r6A39 16r3C7A 16r7DAC 16r3C7B 16r9700 16r3C7C 16r56DA 16r3C7D 16r53CE 16r3C7E 16r5468 16r3D21 16r5B97 16r3D22 16r5C31 16r3D23 16r5DDE 16r3D24 16r4FEE 16r3D25 16r6101 16r3D26 16r62FE 16r3D27 16r6D32 16r3D28 16r79C0 16r3D29 16r79CB 16r3D2A 16r7D42 16r3D2B 16r7E4D 16r3D2C 16r7FD2 16r3D2D 16r81ED 16r3D2E 16r821F 16r3D2F 16r8490 16r3D30 16r8846 16r3D31 16r8972 16r3D32 16r8B90 16r3D33 16r8E74 16r3D34 16r8F2F 16r3D35 16r9031 16r3D36 16r914B 16r3D37 16r916C 16r3D38 16r96C6 16r3D39 16r919C 16r3D3A 16r4EC0 16r3D3B 16r4F4F 16r3D3C 16r5145 16r3D3D 16r5341 16r3D3E 16r5F93 16r3D3F 16r620E 16r3D40 16r67D4 16r3D41 16r6C41 16r3D42 16r6E0B 16r3D43 16r7363 16r3D44 16r7E26 16r3D45 16r91CD 16r3D46 16r9283 16r3D47 16r53D4 16r3D48 16r5919 16r3D49 16r5BBF 16r3D4A 16r6DD1 16r3D4B 16r795D 16r3D4C 16r7E2E 16r3D4D 16r7C9B 16r3D4E 16r587E 16r3D4F 16r719F 16r3D50 16r51FA 16r3D51 16r8853 16r3D52 16r8FF0 16r3D53 16r4FCA 16r3D54 16r5CFB 16r3D55 16r6625 16r3D56 16r77AC 16r3D57 16r7AE3 16r3D58 16r821C 16r3D59 16r99FF 16r3D5A 16r51C6 16r3D5B 16r5FAA 16r3D5C 16r65EC 16r3D5D 16r696F 16r3D5E 16r6B89 16r3D5F 16r6DF3 16r3D60 16r6E96 16r3D61 16r6F64 16r3D62 16r76FE 16r3D63 16r7D14 16r3D64 16r5DE1 16r3D65 16r9075 16r3D66 16r9187 16r3D67 16r9806 16r3D68 16r51E6 16r3D69 16r521D 16r3D6A 16r6240 16r3D6B 16r6691 16r3D6C 16r66D9 16r3D6D 16r6E1A 16r3D6E 16r5EB6 16r3D6F 16r7DD2 16r3D70 16r7F72 16r3D71 16r66F8 16r3D72 16r85AF 16r3D73 16r85F7 16r3D74 16r8AF8 16r3D75 16r52A9 16r3D76 16r53D9 16r3D77 16r5973 16r3D78 16r5E8F 16r3D79 16r5F90 16r3D7A 16r6055 16r3D7B 16r92E4 16r3D7C 16r9664 16r3D7D 16r50B7 16r3D7E 16r511F 16r3E21 16r52DD 16r3E22 16r5320 16r3E23 16r5347 16r3E24 16r53EC 16r3E25 16r54E8 16r3E26 16r5546 16r3E27 16r5531 16r3E28 16r5617 16r3E29 16r5968 16r3E2A 16r59BE 16r3E2B 16r5A3C 16r3E2C 16r5BB5 16r3E2D 16r5C06 16r3E2E 16r5C0F 16r3E2F 16r5C11 16r3E30 16r5C1A 16r3E31 16r5E84 16r3E32 16r5E8A 16r3E33 16r5EE0 16r3E34 16r5F70 16r3E35 16r627F 16r3E36 16r6284 16r3E37 16r62DB 16r3E38 16r638C 16r3E39 16r6377 16r3E3A 16r6607 16r3E3B 16r660C 16r3E3C 16r662D 16r3E3D 16r6676 16r3E3E 16r677E 16r3E3F 16r68A2 16r3E40 16r6A1F 16r3E41 16r6A35 16r3E42 16r6CBC 16r3E43 16r6D88 16r3E44 16r6E09 16r3E45 16r6E58 16r3E46 16r713C 16r3E47 16r7126 16r3E48 16r7167 16r3E49 16r75C7 16r3E4A 16r7701 16r3E4B 16r785D 16r3E4C 16r7901 16r3E4D 16r7965 16r3E4E 16r79F0 16r3E4F 16r7AE0 16r3E50 16r7B11 16r3E51 16r7CA7 16r3E52 16r7D39 16r3E53 16r8096 16r3E54 16r83D6 16r3E55 16r848B 16r3E56 16r8549 16r3E57 16r885D 16r3E58 16r88F3 16r3E59 16r8A1F 16r3E5A 16r8A3C 16r3E5B 16r8A54 16r3E5C 16r8A73 16r3E5D 16r8C61 16r3E5E 16r8CDE 16r3E5F 16r91A4 16r3E60 16r9266 16r3E61 16r937E 16r3E62 16r9418 16r3E63 16r969C 16r3E64 16r9798 16r3E65 16r4E0A 16r3E66 16r4E08 16r3E67 16r4E1E 16r3E68 16r4E57 16r3E69 16r5197 16r3E6A 16r5270 16r3E6B 16r57CE 16r3E6C 16r5834 16r3E6D 16r58CC 16r3E6E 16r5B22 16r3E6F 16r5E38 16r3E70 16r60C5 16r3E71 16r64FE 16r3E72 16r6761 16r3E73 16r6756 16r3E74 16r6D44 16r3E75 16r72B6 16r3E76 16r7573 16r3E77 16r7A63 16r3E78 16r84B8 16r3E79 16r8B72 16r3E7A 16r91B8 16r3E7B 16r9320 16r3E7C 16r5631 16r3E7D 16r57F4 16r3E7E 16r98FE 16r3F21 16r62ED 16r3F22 16r690D 16r3F23 16r6B96 16r3F24 16r71ED 16r3F25 16r7E54 16r3F26 16r8077 16r3F27 16r8272 16r3F28 16r89E6 16r3F29 16r98DF 16r3F2A 16r8755 16r3F2B 16r8FB1 16r3F2C 16r5C3B 16r3F2D 16r4F38 16r3F2E 16r4FE1 16r3F2F 16r4FB5 16r3F30 16r5507 16r3F31 16r5A20 16r3F32 16r5BDD 16r3F33 16r5BE9 16r3F34 16r5FC3 16r3F35 16r614E 16r3F36 16r632F 16r3F37 16r65B0 16r3F38 16r664B 16r3F39 16r68EE 16r3F3A 16r699B 16r3F3B 16r6D78 16r3F3C 16r6DF1 16r3F3D 16r7533 16r3F3E 16r75B9 16r3F3F 16r771F 16r3F40 16r795E 16r3F41 16r79E6 16r3F42 16r7D33 16r3F43 16r81E3 16r3F44 16r82AF 16r3F45 16r85AA 16r3F46 16r89AA 16r3F47 16r8A3A 16r3F48 16r8EAB 16r3F49 16r8F9B 16r3F4A 16r9032 16r3F4B 16r91DD 16r3F4C 16r9707 16r3F4D 16r4EBA 16r3F4E 16r4EC1 16r3F4F 16r5203 16r3F50 16r5875 16r3F51 16r58EC 16r3F52 16r5C0B 16r3F53 16r751A 16r3F54 16r5C3D 16r3F55 16r814E 16r3F56 16r8A0A 16r3F57 16r8FC5 16r3F58 16r9663 16r3F59 16r976D 16r3F5A 16r7B25 16r3F5B 16r8ACF 16r3F5C 16r9808 16r3F5D 16r9162 16r3F5E 16r56F3 16r3F5F 16r53A8 16r3F60 16r9017 16r3F61 16r5439 16r3F62 16r5782 16r3F63 16r5E25 16r3F64 16r63A8 16r3F65 16r6C34 16r3F66 16r708A 16r3F67 16r7761 16r3F68 16r7C8B 16r3F69 16r7FE0 16r3F6A 16r8870 16r3F6B 16r9042 16r3F6C 16r9154 16r3F6D 16r9310 16r3F6E 16r9318 16r3F6F 16r968F 16r3F70 16r745E 16r3F71 16r9AC4 16r3F72 16r5D07 16r3F73 16r5D69 16r3F74 16r6570 16r3F75 16r67A2 16r3F76 16r8DA8 16r3F77 16r96DB 16r3F78 16r636E 16r3F79 16r6749 16r3F7A 16r6919 16r3F7B 16r83C5 16r3F7C 16r9817 16r3F7D 16r96C0 16r3F7E 16r88FE 16r4021 16r6F84 16r4022 16r647A 16r4023 16r5BF8 16r4024 16r4E16 16r4025 16r702C 16r4026 16r755D 16r4027 16r662F 16r4028 16r51C4 16r4029 16r5236 16r402A 16r52E2 16r402B 16r59D3 16r402C 16r5F81 16r402D 16r6027 16r402E 16r6210 16r402F 16r653F 16r4030 16r6574 16r4031 16r661F 16r4032 16r6674 16r4033 16r68F2 16r4034 16r6816 16r4035 16r6B63 16r4036 16r6E05 16r4037 16r7272 16r4038 16r751F 16r4039 16r76DB 16r403A 16r7CBE 16r403B 16r8056 16r403C 16r58F0 16r403D 16r88FD 16r403E 16r897F 16r403F 16r8AA0 16r4040 16r8A93 16r4041 16r8ACB 16r4042 16r901D 16r4043 16r9192 16r4044 16r9752 16r4045 16r9759 16r4046 16r6589 16r4047 16r7A0E 16r4048 16r8106 16r4049 16r96BB 16r404A 16r5E2D 16r404B 16r60DC 16r404C 16r621A 16r404D 16r65A5 16r404E 16r6614 16r404F 16r6790 16r4050 16r77F3 16r4051 16r7A4D 16r4052 16r7C4D 16r4053 16r7E3E 16r4054 16r810A 16r4055 16r8CAC 16r4056 16r8D64 16r4057 16r8DE1 16r4058 16r8E5F 16r4059 16r78A9 16r405A 16r5207 16r405B 16r62D9 16r405C 16r63A5 16r405D 16r6442 16r405E 16r6298 16r405F 16r8A2D 16r4060 16r7A83 16r4061 16r7BC0 16r4062 16r8AAC 16r4063 16r96EA 16r4064 16r7D76 16r4065 16r820C 16r4066 16r8749 16r4067 16r4ED9 16r4068 16r5148 16r4069 16r5343 16r406A 16r5360 16r406B 16r5BA3 16r406C 16r5C02 16r406D 16r5C16 16r406E 16r5DDD 16r406F 16r6226 16r4070 16r6247 16r4071 16r64B0 16r4072 16r6813 16r4073 16r6834 16r4074 16r6CC9 16r4075 16r6D45 16r4076 16r6D17 16r4077 16r67D3 16r4078 16r6F5C 16r4079 16r714E 16r407A 16r717D 16r407B 16r65CB 16r407C 16r7A7F 16r407D 16r7BAD 16r407E 16r7DDA 16r4121 16r7E4A 16r4122 16r7FA8 16r4123 16r817A 16r4124 16r821B 16r4125 16r8239 16r4126 16r85A6 16r4127 16r8A6E 16r4128 16r8CCE 16r4129 16r8DF5 16r412A 16r9078 16r412B 16r9077 16r412C 16r92AD 16r412D 16r9291 16r412E 16r9583 16r412F 16r9BAE 16r4130 16r524D 16r4131 16r5584 16r4132 16r6F38 16r4133 16r7136 16r4134 16r5168 16r4135 16r7985 16r4136 16r7E55 16r4137 16r81B3 16r4138 16r7CCE 16r4139 16r564C 16r413A 16r5851 16r413B 16r5CA8 16r413C 16r63AA 16r413D 16r66FE 16r413E 16r66FD 16r413F 16r695A 16r4140 16r72D9 16r4141 16r758F 16r4142 16r758E 16r4143 16r790E 16r4144 16r7956 16r4145 16r79DF 16r4146 16r7C97 16r4147 16r7D20 16r4148 16r7D44 16r4149 16r8607 16r414A 16r8A34 16r414B 16r963B 16r414C 16r9061 16r414D 16r9F20 16r414E 16r50E7 16r414F 16r5275 16r4150 16r53CC 16r4151 16r53E2 16r4152 16r5009 16r4153 16r55AA 16r4154 16r58EE 16r4155 16r594F 16r4156 16r723D 16r4157 16r5B8B 16r4158 16r5C64 16r4159 16r531D 16r415A 16r60E3 16r415B 16r60F3 16r415C 16r635C 16r415D 16r6383 16r415E 16r633F 16r415F 16r63BB 16r4160 16r64CD 16r4161 16r65E9 16r4162 16r66F9 16r4163 16r5DE3 16r4164 16r69CD 16r4165 16r69FD 16r4166 16r6F15 16r4167 16r71E5 16r4168 16r4E89 16r4169 16r75E9 16r416A 16r76F8 16r416B 16r7A93 16r416C 16r7CDF 16r416D 16r7DCF 16r416E 16r7D9C 16r416F 16r8061 16r4170 16r8349 16r4171 16r8358 16r4172 16r846C 16r4173 16r84BC 16r4174 16r85FB 16r4175 16r88C5 16r4176 16r8D70 16r4177 16r9001 16r4178 16r906D 16r4179 16r9397 16r417A 16r971C 16r417B 16r9A12 16r417C 16r50CF 16r417D 16r5897 16r417E 16r618E 16r4221 16r81D3 16r4222 16r8535 16r4223 16r8D08 16r4224 16r9020 16r4225 16r4FC3 16r4226 16r5074 16r4227 16r5247 16r4228 16r5373 16r4229 16r606F 16r422A 16r6349 16r422B 16r675F 16r422C 16r6E2C 16r422D 16r8DB3 16r422E 16r901F 16r422F 16r4FD7 16r4230 16r5C5E 16r4231 16r8CCA 16r4232 16r65CF 16r4233 16r7D9A 16r4234 16r5352 16r4235 16r8896 16r4236 16r5176 16r4237 16r63C3 16r4238 16r5B58 16r4239 16r5B6B 16r423A 16r5C0A 16r423B 16r640D 16r423C 16r6751 16r423D 16r905C 16r423E 16r4ED6 16r423F 16r591A 16r4240 16r592A 16r4241 16r6C70 16r4242 16r8A51 16r4243 16r553E 16r4244 16r5815 16r4245 16r59A5 16r4246 16r60F0 16r4247 16r6253 16r4248 16r67C1 16r4249 16r8235 16r424A 16r6955 16r424B 16r9640 16r424C 16r99C4 16r424D 16r9A28 16r424E 16r4F53 16r424F 16r5806 16r4250 16r5BFE 16r4251 16r8010 16r4252 16r5CB1 16r4253 16r5E2F 16r4254 16r5F85 16r4255 16r6020 16r4256 16r614B 16r4257 16r6234 16r4258 16r66FF 16r4259 16r6CF0 16r425A 16r6EDE 16r425B 16r80CE 16r425C 16r817F 16r425D 16r82D4 16r425E 16r888B 16r425F 16r8CB8 16r4260 16r9000 16r4261 16r902E 16r4262 16r968A 16r4263 16r9EDB 16r4264 16r9BDB 16r4265 16r4EE3 16r4266 16r53F0 16r4267 16r5927 16r4268 16r7B2C 16r4269 16r918D 16r426A 16r984C 16r426B 16r9DF9 16r426C 16r6EDD 16r426D 16r7027 16r426E 16r5353 16r426F 16r5544 16r4270 16r5B85 16r4271 16r6258 16r4272 16r629E 16r4273 16r62D3 16r4274 16r6CA2 16r4275 16r6FEF 16r4276 16r7422 16r4277 16r8A17 16r4278 16r9438 16r4279 16r6FC1 16r427A 16r8AFE 16r427B 16r8338 16r427C 16r51E7 16r427D 16r86F8 16r427E 16r53EA 16r4321 16r53E9 16r4322 16r4F46 16r4323 16r9054 16r4324 16r8FB0 16r4325 16r596A 16r4326 16r8131 16r4327 16r5DFD 16r4328 16r7AEA 16r4329 16r8FBF 16r432A 16r68DA 16r432B 16r8C37 16r432C 16r72F8 16r432D 16r9C48 16r432E 16r6A3D 16r432F 16r8AB0 16r4330 16r4E39 16r4331 16r5358 16r4332 16r5606 16r4333 16r5766 16r4334 16r62C5 16r4335 16r63A2 16r4336 16r65E6 16r4337 16r6B4E 16r4338 16r6DE1 16r4339 16r6E5B 16r433A 16r70AD 16r433B 16r77ED 16r433C 16r7AEF 16r433D 16r7BAA 16r433E 16r7DBB 16r433F 16r803D 16r4340 16r80C6 16r4341 16r86CB 16r4342 16r8A95 16r4343 16r935B 16r4344 16r56E3 16r4345 16r58C7 16r4346 16r5F3E 16r4347 16r65AD 16r4348 16r6696 16r4349 16r6A80 16r434A 16r6BB5 16r434B 16r7537 16r434C 16r8AC7 16r434D 16r5024 16r434E 16r77E5 16r434F 16r5730 16r4350 16r5F1B 16r4351 16r6065 16r4352 16r667A 16r4353 16r6C60 16r4354 16r75F4 16r4355 16r7A1A 16r4356 16r7F6E 16r4357 16r81F4 16r4358 16r8718 16r4359 16r9045 16r435A 16r99B3 16r435B 16r7BC9 16r435C 16r755C 16r435D 16r7AF9 16r435E 16r7B51 16r435F 16r84C4 16r4360 16r9010 16r4361 16r79E9 16r4362 16r7A92 16r4363 16r8336 16r4364 16r5AE1 16r4365 16r7740 16r4366 16r4E2D 16r4367 16r4EF2 16r4368 16r5B99 16r4369 16r5FE0 16r436A 16r62BD 16r436B 16r663C 16r436C 16r67F1 16r436D 16r6CE8 16r436E 16r866B 16r436F 16r8877 16r4370 16r8A3B 16r4371 16r914E 16r4372 16r92F3 16r4373 16r99D0 16r4374 16r6A17 16r4375 16r7026 16r4376 16r732A 16r4377 16r82E7 16r4378 16r8457 16r4379 16r8CAF 16r437A 16r4E01 16r437B 16r5146 16r437C 16r51CB 16r437D 16r558B 16r437E 16r5BF5 16r4421 16r5E16 16r4422 16r5E33 16r4423 16r5E81 16r4424 16r5F14 16r4425 16r5F35 16r4426 16r5F6B 16r4427 16r5FB4 16r4428 16r61F2 16r4429 16r6311 16r442A 16r66A2 16r442B 16r671D 16r442C 16r6F6E 16r442D 16r7252 16r442E 16r753A 16r442F 16r773A 16r4430 16r8074 16r4431 16r8139 16r4432 16r8178 16r4433 16r8776 16r4434 16r8ABF 16r4435 16r8ADC 16r4436 16r8D85 16r4437 16r8DF3 16r4438 16r929A 16r4439 16r9577 16r443A 16r9802 16r443B 16r9CE5 16r443C 16r52C5 16r443D 16r6357 16r443E 16r76F4 16r443F 16r6715 16r4440 16r6C88 16r4441 16r73CD 16r4442 16r8CC3 16r4443 16r93AE 16r4444 16r9673 16r4445 16r6D25 16r4446 16r589C 16r4447 16r690E 16r4448 16r69CC 16r4449 16r8FFD 16r444A 16r939A 16r444B 16r75DB 16r444C 16r901A 16r444D 16r585A 16r444E 16r6802 16r444F 16r63B4 16r4450 16r69FB 16r4451 16r4F43 16r4452 16r6F2C 16r4453 16r67D8 16r4454 16r8FBB 16r4455 16r8526 16r4456 16r7DB4 16r4457 16r9354 16r4458 16r693F 16r4459 16r6F70 16r445A 16r576A 16r445B 16r58F7 16r445C 16r5B2C 16r445D 16r7D2C 16r445E 16r722A 16r445F 16r540A 16r4460 16r91E3 16r4461 16r9DB4 16r4462 16r4EAD 16r4463 16r4F4E 16r4464 16r505C 16r4465 16r5075 16r4466 16r5243 16r4467 16r8C9E 16r4468 16r5448 16r4469 16r5824 16r446A 16r5B9A 16r446B 16r5E1D 16r446C 16r5E95 16r446D 16r5EAD 16r446E 16r5EF7 16r446F 16r5F1F 16r4470 16r608C 16r4471 16r62B5 16r4472 16r633A 16r4473 16r63D0 16r4474 16r68AF 16r4475 16r6C40 16r4476 16r7887 16r4477 16r798E 16r4478 16r7A0B 16r4479 16r7DE0 16r447A 16r8247 16r447B 16r8A02 16r447C 16r8AE6 16r447D 16r8E44 16r447E 16r9013 16r4521 16r90B8 16r4522 16r912D 16r4523 16r91D8 16r4524 16r9F0E 16r4525 16r6CE5 16r4526 16r6458 16r4527 16r64E2 16r4528 16r6575 16r4529 16r6EF4 16r452A 16r7684 16r452B 16r7B1B 16r452C 16r9069 16r452D 16r93D1 16r452E 16r6EBA 16r452F 16r54F2 16r4530 16r5FB9 16r4531 16r64A4 16r4532 16r8F4D 16r4533 16r8FED 16r4534 16r9244 16r4535 16r5178 16r4536 16r586B 16r4537 16r5929 16r4538 16r5C55 16r4539 16r5E97 16r453A 16r6DFB 16r453B 16r7E8F 16r453C 16r751C 16r453D 16r8CBC 16r453E 16r8EE2 16r453F 16r985B 16r4540 16r70B9 16r4541 16r4F1D 16r4542 16r6BBF 16r4543 16r6FB1 16r4544 16r7530 16r4545 16r96FB 16r4546 16r514E 16r4547 16r5410 16r4548 16r5835 16r4549 16r5857 16r454A 16r59AC 16r454B 16r5C60 16r454C 16r5F92 16r454D 16r6597 16r454E 16r675C 16r454F 16r6E21 16r4550 16r767B 16r4551 16r83DF 16r4552 16r8CED 16r4553 16r9014 16r4554 16r90FD 16r4555 16r934D 16r4556 16r7825 16r4557 16r783A 16r4558 16r52AA 16r4559 16r5EA6 16r455A 16r571F 16r455B 16r5974 16r455C 16r6012 16r455D 16r5012 16r455E 16r515A 16r455F 16r51AC 16r4560 16r51CD 16r4561 16r5200 16r4562 16r5510 16r4563 16r5854 16r4564 16r5858 16r4565 16r5957 16r4566 16r5B95 16r4567 16r5CF6 16r4568 16r5D8B 16r4569 16r60BC 16r456A 16r6295 16r456B 16r642D 16r456C 16r6771 16r456D 16r6843 16r456E 16r68BC 16r456F 16r68DF 16r4570 16r76D7 16r4571 16r6DD8 16r4572 16r6E6F 16r4573 16r6D9B 16r4574 16r706F 16r4575 16r71C8 16r4576 16r5F53 16r4577 16r75D8 16r4578 16r7977 16r4579 16r7B49 16r457A 16r7B54 16r457B 16r7B52 16r457C 16r7CD6 16r457D 16r7D71 16r457E 16r5230 16r4621 16r8463 16r4622 16r8569 16r4623 16r85E4 16r4624 16r8A0E 16r4625 16r8B04 16r4626 16r8C46 16r4627 16r8E0F 16r4628 16r9003 16r4629 16r900F 16r462A 16r9419 16r462B 16r9676 16r462C 16r982D 16r462D 16r9A30 16r462E 16r95D8 16r462F 16r50CD 16r4630 16r52D5 16r4631 16r540C 16r4632 16r5802 16r4633 16r5C0E 16r4634 16r61A7 16r4635 16r649E 16r4636 16r6D1E 16r4637 16r77B3 16r4638 16r7AE5 16r4639 16r80F4 16r463A 16r8404 16r463B 16r9053 16r463C 16r9285 16r463D 16r5CE0 16r463E 16r9D07 16r463F 16r533F 16r4640 16r5F97 16r4641 16r5FB3 16r4642 16r6D9C 16r4643 16r7279 16r4644 16r7763 16r4645 16r79BF 16r4646 16r7BE4 16r4647 16r6BD2 16r4648 16r72EC 16r4649 16r8AAD 16r464A 16r6803 16r464B 16r6A61 16r464C 16r51F8 16r464D 16r7A81 16r464E 16r6934 16r464F 16r5C4A 16r4650 16r9CF6 16r4651 16r82EB 16r4652 16r5BC5 16r4653 16r9149 16r4654 16r701E 16r4655 16r5678 16r4656 16r5C6F 16r4657 16r60C7 16r4658 16r6566 16r4659 16r6C8C 16r465A 16r8C5A 16r465B 16r9041 16r465C 16r9813 16r465D 16r5451 16r465E 16r66C7 16r465F 16r920D 16r4660 16r5948 16r4661 16r90A3 16r4662 16r5185 16r4663 16r4E4D 16r4664 16r51EA 16r4665 16r8599 16r4666 16r8B0E 16r4667 16r7058 16r4668 16r637A 16r4669 16r934B 16r466A 16r6962 16r466B 16r99B4 16r466C 16r7E04 16r466D 16r7577 16r466E 16r5357 16r466F 16r6960 16r4670 16r8EDF 16r4671 16r96E3 16r4672 16r6C5D 16r4673 16r4E8C 16r4674 16r5C3C 16r4675 16r5F10 16r4676 16r8FE9 16r4677 16r5302 16r4678 16r8CD1 16r4679 16r8089 16r467A 16r8679 16r467B 16r5EFF 16r467C 16r65E5 16r467D 16r4E73 16r467E 16r5165 16r4721 16r5982 16r4722 16r5C3F 16r4723 16r97EE 16r4724 16r4EFB 16r4725 16r598A 16r4726 16r5FCD 16r4727 16r8A8D 16r4728 16r6FE1 16r4729 16r79B0 16r472A 16r7962 16r472B 16r5BE7 16r472C 16r8471 16r472D 16r732B 16r472E 16r71B1 16r472F 16r5E74 16r4730 16r5FF5 16r4731 16r637B 16r4732 16r649A 16r4733 16r71C3 16r4734 16r7C98 16r4735 16r4E43 16r4736 16r5EFC 16r4737 16r4E4B 16r4738 16r57DC 16r4739 16r56A2 16r473A 16r60A9 16r473B 16r6FC3 16r473C 16r7D0D 16r473D 16r80FD 16r473E 16r8133 16r473F 16r81BF 16r4740 16r8FB2 16r4741 16r8997 16r4742 16r86A4 16r4743 16r5DF4 16r4744 16r628A 16r4745 16r64AD 16r4746 16r8987 16r4747 16r6777 16r4748 16r6CE2 16r4749 16r6D3E 16r474A 16r7436 16r474B 16r7834 16r474C 16r5A46 16r474D 16r7F75 16r474E 16r82AD 16r474F 16r99AC 16r4750 16r4FF3 16r4751 16r5EC3 16r4752 16r62DD 16r4753 16r6392 16r4754 16r6557 16r4755 16r676F 16r4756 16r76C3 16r4757 16r724C 16r4758 16r80CC 16r4759 16r80BA 16r475A 16r8F29 16r475B 16r914D 16r475C 16r500D 16r475D 16r57F9 16r475E 16r5A92 16r475F 16r6885 16r4760 16r6973 16r4761 16r7164 16r4762 16r72FD 16r4763 16r8CB7 16r4764 16r58F2 16r4765 16r8CE0 16r4766 16r966A 16r4767 16r9019 16r4768 16r877F 16r4769 16r79E4 16r476A 16r77E7 16r476B 16r8429 16r476C 16r4F2F 16r476D 16r5265 16r476E 16r535A 16r476F 16r62CD 16r4770 16r67CF 16r4771 16r6CCA 16r4772 16r767D 16r4773 16r7B94 16r4774 16r7C95 16r4775 16r8236 16r4776 16r8584 16r4777 16r8FEB 16r4778 16r66DD 16r4779 16r6F20 16r477A 16r7206 16r477B 16r7E1B 16r477C 16r83AB 16r477D 16r99C1 16r477E 16r9EA6 16r4821 16r51FD 16r4822 16r7BB1 16r4823 16r7872 16r4824 16r7BB8 16r4825 16r8087 16r4826 16r7B48 16r4827 16r6AE8 16r4828 16r5E61 16r4829 16r808C 16r482A 16r7551 16r482B 16r7560 16r482C 16r516B 16r482D 16r9262 16r482E 16r6E8C 16r482F 16r767A 16r4830 16r9197 16r4831 16r9AEA 16r4832 16r4F10 16r4833 16r7F70 16r4834 16r629C 16r4835 16r7B4F 16r4836 16r95A5 16r4837 16r9CE9 16r4838 16r567A 16r4839 16r5859 16r483A 16r86E4 16r483B 16r96BC 16r483C 16r4F34 16r483D 16r5224 16r483E 16r534A 16r483F 16r53CD 16r4840 16r53DB 16r4841 16r5E06 16r4842 16r642C 16r4843 16r6591 16r4844 16r677F 16r4845 16r6C3E 16r4846 16r6C4E 16r4847 16r7248 16r4848 16r72AF 16r4849 16r73ED 16r484A 16r7554 16r484B 16r7E41 16r484C 16r822C 16r484D 16r85E9 16r484E 16r8CA9 16r484F 16r7BC4 16r4850 16r91C6 16r4851 16r7169 16r4852 16r9812 16r4853 16r98EF 16r4854 16r633D 16r4855 16r6669 16r4856 16r756A 16r4857 16r76E4 16r4858 16r78D0 16r4859 16r8543 16r485A 16r86EE 16r485B 16r532A 16r485C 16r5351 16r485D 16r5426 16r485E 16r5983 16r485F 16r5E87 16r4860 16r5F7C 16r4861 16r60B2 16r4862 16r6249 16r4863 16r6279 16r4864 16r62AB 16r4865 16r6590 16r4866 16r6BD4 16r4867 16r6CCC 16r4868 16r75B2 16r4869 16r76AE 16r486A 16r7891 16r486B 16r79D8 16r486C 16r7DCB 16r486D 16r7F77 16r486E 16r80A5 16r486F 16r88AB 16r4870 16r8AB9 16r4871 16r8CBB 16r4872 16r907F 16r4873 16r975E 16r4874 16r98DB 16r4875 16r6A0B 16r4876 16r7C38 16r4877 16r5099 16r4878 16r5C3E 16r4879 16r5FAE 16r487A 16r6787 16r487B 16r6BD8 16r487C 16r7435 16r487D 16r7709 16r487E 16r7F8E 16r4921 16r9F3B 16r4922 16r67CA 16r4923 16r7A17 16r4924 16r5339 16r4925 16r758B 16r4926 16r9AED 16r4927 16r5F66 16r4928 16r819D 16r4929 16r83F1 16r492A 16r8098 16r492B 16r5F3C 16r492C 16r5FC5 16r492D 16r7562 16r492E 16r7B46 16r492F 16r903C 16r4930 16r6867 16r4931 16r59EB 16r4932 16r5A9B 16r4933 16r7D10 16r4934 16r767E 16r4935 16r8B2C 16r4936 16r4FF5 16r4937 16r5F6A 16r4938 16r6A19 16r4939 16r6C37 16r493A 16r6F02 16r493B 16r74E2 16r493C 16r7968 16r493D 16r8868 16r493E 16r8A55 16r493F 16r8C79 16r4940 16r5EDF 16r4941 16r63CF 16r4942 16r75C5 16r4943 16r79D2 16r4944 16r82D7 16r4945 16r9328 16r4946 16r92F2 16r4947 16r849C 16r4948 16r86ED 16r4949 16r9C2D 16r494A 16r54C1 16r494B 16r5F6C 16r494C 16r658C 16r494D 16r6D5C 16r494E 16r7015 16r494F 16r8CA7 16r4950 16r8CD3 16r4951 16r983B 16r4952 16r654F 16r4953 16r74F6 16r4954 16r4E0D 16r4955 16r4ED8 16r4956 16r57E0 16r4957 16r592B 16r4958 16r5A66 16r4959 16r5BCC 16r495A 16r51A8 16r495B 16r5E03 16r495C 16r5E9C 16r495D 16r6016 16r495E 16r6276 16r495F 16r6577 16r4960 16r65A7 16r4961 16r666E 16r4962 16r6D6E 16r4963 16r7236 16r4964 16r7B26 16r4965 16r8150 16r4966 16r819A 16r4967 16r8299 16r4968 16r8B5C 16r4969 16r8CA0 16r496A 16r8CE6 16r496B 16r8D74 16r496C 16r961C 16r496D 16r9644 16r496E 16r4FAE 16r496F 16r64AB 16r4970 16r6B66 16r4971 16r821E 16r4972 16r8461 16r4973 16r856A 16r4974 16r90E8 16r4975 16r5C01 16r4976 16r6953 16r4977 16r98A8 16r4978 16r847A 16r4979 16r8557 16r497A 16r4F0F 16r497B 16r526F 16r497C 16r5FA9 16r497D 16r5E45 16r497E 16r670D 16r4A21 16r798F 16r4A22 16r8179 16r4A23 16r8907 16r4A24 16r8986 16r4A25 16r6DF5 16r4A26 16r5F17 16r4A27 16r6255 16r4A28 16r6CB8 16r4A29 16r4ECF 16r4A2A 16r7269 16r4A2B 16r9B92 16r4A2C 16r5206 16r4A2D 16r543B 16r4A2E 16r5674 16r4A2F 16r58B3 16r4A30 16r61A4 16r4A31 16r626E 16r4A32 16r711A 16r4A33 16r596E 16r4A34 16r7C89 16r4A35 16r7CDE 16r4A36 16r7D1B 16r4A37 16r96F0 16r4A38 16r6587 16r4A39 16r805E 16r4A3A 16r4E19 16r4A3B 16r4F75 16r4A3C 16r5175 16r4A3D 16r5840 16r4A3E 16r5E63 16r4A3F 16r5E73 16r4A40 16r5F0A 16r4A41 16r67C4 16r4A42 16r4E26 16r4A43 16r853D 16r4A44 16r9589 16r4A45 16r965B 16r4A46 16r7C73 16r4A47 16r9801 16r4A48 16r50FB 16r4A49 16r58C1 16r4A4A 16r7656 16r4A4B 16r78A7 16r4A4C 16r5225 16r4A4D 16r77A5 16r4A4E 16r8511 16r4A4F 16r7B86 16r4A50 16r504F 16r4A51 16r5909 16r4A52 16r7247 16r4A53 16r7BC7 16r4A54 16r7DE8 16r4A55 16r8FBA 16r4A56 16r8FD4 16r4A57 16r904D 16r4A58 16r4FBF 16r4A59 16r52C9 16r4A5A 16r5A29 16r4A5B 16r5F01 16r4A5C 16r97AD 16r4A5D 16r4FDD 16r4A5E 16r8217 16r4A5F 16r92EA 16r4A60 16r5703 16r4A61 16r6355 16r4A62 16r6B69 16r4A63 16r752B 16r4A64 16r88DC 16r4A65 16r8F14 16r4A66 16r7A42 16r4A67 16r52DF 16r4A68 16r5893 16r4A69 16r6155 16r4A6A 16r620A 16r4A6B 16r66AE 16r4A6C 16r6BCD 16r4A6D 16r7C3F 16r4A6E 16r83E9 16r4A6F 16r5023 16r4A70 16r4FF8 16r4A71 16r5305 16r4A72 16r5446 16r4A73 16r5831 16r4A74 16r5949 16r4A75 16r5B9D 16r4A76 16r5CF0 16r4A77 16r5CEF 16r4A78 16r5D29 16r4A79 16r5E96 16r4A7A 16r62B1 16r4A7B 16r6367 16r4A7C 16r653E 16r4A7D 16r65B9 16r4A7E 16r670B 16r4B21 16r6CD5 16r4B22 16r6CE1 16r4B23 16r70F9 16r4B24 16r7832 16r4B25 16r7E2B 16r4B26 16r80DE 16r4B27 16r82B3 16r4B28 16r840C 16r4B29 16r84EC 16r4B2A 16r8702 16r4B2B 16r8912 16r4B2C 16r8A2A 16r4B2D 16r8C4A 16r4B2E 16r90A6 16r4B2F 16r92D2 16r4B30 16r98FD 16r4B31 16r9CF3 16r4B32 16r9D6C 16r4B33 16r4E4F 16r4B34 16r4EA1 16r4B35 16r508D 16r4B36 16r5256 16r4B37 16r574A 16r4B38 16r59A8 16r4B39 16r5E3D 16r4B3A 16r5FD8 16r4B3B 16r5FD9 16r4B3C 16r623F 16r4B3D 16r66B4 16r4B3E 16r671B 16r4B3F 16r67D0 16r4B40 16r68D2 16r4B41 16r5192 16r4B42 16r7D21 16r4B43 16r80AA 16r4B44 16r81A8 16r4B45 16r8B00 16r4B46 16r8C8C 16r4B47 16r8CBF 16r4B48 16r927E 16r4B49 16r9632 16r4B4A 16r5420 16r4B4B 16r982C 16r4B4C 16r5317 16r4B4D 16r50D5 16r4B4E 16r535C 16r4B4F 16r58A8 16r4B50 16r64B2 16r4B51 16r6734 16r4B52 16r7267 16r4B53 16r7766 16r4B54 16r7A46 16r4B55 16r91E6 16r4B56 16r52C3 16r4B57 16r6CA1 16r4B58 16r6B86 16r4B59 16r5800 16r4B5A 16r5E4C 16r4B5B 16r5954 16r4B5C 16r672C 16r4B5D 16r7FFB 16r4B5E 16r51E1 16r4B5F 16r76C6 16r4B60 16r6469 16r4B61 16r78E8 16r4B62 16r9B54 16r4B63 16r9EBB 16r4B64 16r57CB 16r4B65 16r59B9 16r4B66 16r6627 16r4B67 16r679A 16r4B68 16r6BCE 16r4B69 16r54E9 16r4B6A 16r69D9 16r4B6B 16r5E55 16r4B6C 16r819C 16r4B6D 16r6795 16r4B6E 16r9BAA 16r4B6F 16r67FE 16r4B70 16r9C52 16r4B71 16r685D 16r4B72 16r4EA6 16r4B73 16r4FE3 16r4B74 16r53C8 16r4B75 16r62B9 16r4B76 16r672B 16r4B77 16r6CAB 16r4B78 16r8FC4 16r4B79 16r4FAD 16r4B7A 16r7E6D 16r4B7B 16r9EBF 16r4B7C 16r4E07 16r4B7D 16r6162 16r4B7E 16r6E80 16r4C21 16r6F2B 16r4C22 16r8513 16r4C23 16r5473 16r4C24 16r672A 16r4C25 16r9B45 16r4C26 16r5DF3 16r4C27 16r7B95 16r4C28 16r5CAC 16r4C29 16r5BC6 16r4C2A 16r871C 16r4C2B 16r6E4A 16r4C2C 16r84D1 16r4C2D 16r7A14 16r4C2E 16r8108 16r4C2F 16r5999 16r4C30 16r7C8D 16r4C31 16r6C11 16r4C32 16r7720 16r4C33 16r52D9 16r4C34 16r5922 16r4C35 16r7121 16r4C36 16r725F 16r4C37 16r77DB 16r4C38 16r9727 16r4C39 16r9D61 16r4C3A 16r690B 16r4C3B 16r5A7F 16r4C3C 16r5A18 16r4C3D 16r51A5 16r4C3E 16r540D 16r4C3F 16r547D 16r4C40 16r660E 16r4C41 16r76DF 16r4C42 16r8FF7 16r4C43 16r9298 16r4C44 16r9CF4 16r4C45 16r59EA 16r4C46 16r725D 16r4C47 16r6EC5 16r4C48 16r514D 16r4C49 16r68C9 16r4C4A 16r7DBF 16r4C4B 16r7DEC 16r4C4C 16r9762 16r4C4D 16r9EBA 16r4C4E 16r6478 16r4C4F 16r6A21 16r4C50 16r8302 16r4C51 16r5984 16r4C52 16r5B5F 16r4C53 16r6BDB 16r4C54 16r731B 16r4C55 16r76F2 16r4C56 16r7DB2 16r4C57 16r8017 16r4C58 16r8499 16r4C59 16r5132 16r4C5A 16r6728 16r4C5B 16r9ED9 16r4C5C 16r76EE 16r4C5D 16r6762 16r4C5E 16r52FF 16r4C5F 16r9905 16r4C60 16r5C24 16r4C61 16r623B 16r4C62 16r7C7E 16r4C63 16r8CB0 16r4C64 16r554F 16r4C65 16r60B6 16r4C66 16r7D0B 16r4C67 16r9580 16r4C68 16r5301 16r4C69 16r4E5F 16r4C6A 16r51B6 16r4C6B 16r591C 16r4C6C 16r723A 16r4C6D 16r8036 16r4C6E 16r91CE 16r4C6F 16r5F25 16r4C70 16r77E2 16r4C71 16r5384 16r4C72 16r5F79 16r4C73 16r7D04 16r4C74 16r85AC 16r4C75 16r8A33 16r4C76 16r8E8D 16r4C77 16r9756 16r4C78 16r67F3 16r4C79 16r85AE 16r4C7A 16r9453 16r4C7B 16r6109 16r4C7C 16r6108 16r4C7D 16r6CB9 16r4C7E 16r7652 16r4D21 16r8AED 16r4D22 16r8F38 16r4D23 16r552F 16r4D24 16r4F51 16r4D25 16r512A 16r4D26 16r52C7 16r4D27 16r53CB 16r4D28 16r5BA5 16r4D29 16r5E7D 16r4D2A 16r60A0 16r4D2B 16r6182 16r4D2C 16r63D6 16r4D2D 16r6709 16r4D2E 16r67DA 16r4D2F 16r6E67 16r4D30 16r6D8C 16r4D31 16r7336 16r4D32 16r7337 16r4D33 16r7531 16r4D34 16r7950 16r4D35 16r88D5 16r4D36 16r8A98 16r4D37 16r904A 16r4D38 16r9091 16r4D39 16r90F5 16r4D3A 16r96C4 16r4D3B 16r878D 16r4D3C 16r5915 16r4D3D 16r4E88 16r4D3E 16r4F59 16r4D3F 16r4E0E 16r4D40 16r8A89 16r4D41 16r8F3F 16r4D42 16r9810 16r4D43 16r50AD 16r4D44 16r5E7C 16r4D45 16r5996 16r4D46 16r5BB9 16r4D47 16r5EB8 16r4D48 16r63DA 16r4D49 16r63FA 16r4D4A 16r64C1 16r4D4B 16r66DC 16r4D4C 16r694A 16r4D4D 16r69D8 16r4D4E 16r6D0B 16r4D4F 16r6EB6 16r4D50 16r7194 16r4D51 16r7528 16r4D52 16r7AAF 16r4D53 16r7F8A 16r4D54 16r8000 16r4D55 16r8449 16r4D56 16r84C9 16r4D57 16r8981 16r4D58 16r8B21 16r4D59 16r8E0A 16r4D5A 16r9065 16r4D5B 16r967D 16r4D5C 16r990A 16r4D5D 16r617E 16r4D5E 16r6291 16r4D5F 16r6B32 16r4D60 16r6C83 16r4D61 16r6D74 16r4D62 16r7FCC 16r4D63 16r7FFC 16r4D64 16r6DC0 16r4D65 16r7F85 16r4D66 16r87BA 16r4D67 16r88F8 16r4D68 16r6765 16r4D69 16r83B1 16r4D6A 16r983C 16r4D6B 16r96F7 16r4D6C 16r6D1B 16r4D6D 16r7D61 16r4D6E 16r843D 16r4D6F 16r916A 16r4D70 16r4E71 16r4D71 16r5375 16r4D72 16r5D50 16r4D73 16r6B04 16r4D74 16r6FEB 16r4D75 16r85CD 16r4D76 16r862D 16r4D77 16r89A7 16r4D78 16r5229 16r4D79 16r540F 16r4D7A 16r5C65 16r4D7B 16r674E 16r4D7C 16r68A8 16r4D7D 16r7406 16r4D7E 16r7483 16r4E21 16r75E2 16r4E22 16r88CF 16r4E23 16r88E1 16r4E24 16r91CC 16r4E25 16r96E2 16r4E26 16r9678 16r4E27 16r5F8B 16r4E28 16r7387 16r4E29 16r7ACB 16r4E2A 16r844E 16r4E2B 16r63A0 16r4E2C 16r7565 16r4E2D 16r5289 16r4E2E 16r6D41 16r4E2F 16r6E9C 16r4E30 16r7409 16r4E31 16r7559 16r4E32 16r786B 16r4E33 16r7C92 16r4E34 16r9686 16r4E35 16r7ADC 16r4E36 16r9F8D 16r4E37 16r4FB6 16r4E38 16r616E 16r4E39 16r65C5 16r4E3A 16r865C 16r4E3B 16r4E86 16r4E3C 16r4EAE 16r4E3D 16r50DA 16r4E3E 16r4E21 16r4E3F 16r51CC 16r4E40 16r5BEE 16r4E41 16r6599 16r4E42 16r6881 16r4E43 16r6DBC 16r4E44 16r731F 16r4E45 16r7642 16r4E46 16r77AD 16r4E47 16r7A1C 16r4E48 16r7CE7 16r4E49 16r826F 16r4E4A 16r8AD2 16r4E4B 16r907C 16r4E4C 16r91CF 16r4E4D 16r9675 16r4E4E 16r9818 16r4E4F 16r529B 16r4E50 16r7DD1 16r4E51 16r502B 16r4E52 16r5398 16r4E53 16r6797 16r4E54 16r6DCB 16r4E55 16r71D0 16r4E56 16r7433 16r4E57 16r81E8 16r4E58 16r8F2A 16r4E59 16r96A3 16r4E5A 16r9C57 16r4E5B 16r9E9F 16r4E5C 16r7460 16r4E5D 16r5841 16r4E5E 16r6D99 16r4E5F 16r7D2F 16r4E60 16r985E 16r4E61 16r4EE4 16r4E62 16r4F36 16r4E63 16r4F8B 16r4E64 16r51B7 16r4E65 16r52B1 16r4E66 16r5DBA 16r4E67 16r601C 16r4E68 16r73B2 16r4E69 16r793C 16r4E6A 16r82D3 16r4E6B 16r9234 16r4E6C 16r96B7 16r4E6D 16r96F6 16r4E6E 16r970A 16r4E6F 16r9E97 16r4E70 16r9F62 16r4E71 16r66A6 16r4E72 16r6B74 16r4E73 16r5217 16r4E74 16r52A3 16r4E75 16r70C8 16r4E76 16r88C2 16r4E77 16r5EC9 16r4E78 16r604B 16r4E79 16r6190 16r4E7A 16r6F23 16r4E7B 16r7149 16r4E7C 16r7C3E 16r4E7D 16r7DF4 16r4E7E 16r806F 16r4F21 16r84EE 16r4F22 16r9023 16r4F23 16r932C 16r4F24 16r5442 16r4F25 16r9B6F 16r4F26 16r6AD3 16r4F27 16r7089 16r4F28 16r8CC2 16r4F29 16r8DEF 16r4F2A 16r9732 16r4F2B 16r52B4 16r4F2C 16r5A41 16r4F2D 16r5ECA 16r4F2E 16r5F04 16r4F2F 16r6717 16r4F30 16r697C 16r4F31 16r6994 16r4F32 16r6D6A 16r4F33 16r6F0F 16r4F34 16r7262 16r4F35 16r72FC 16r4F36 16r7BED 16r4F37 16r8001 16r4F38 16r807E 16r4F39 16r874B 16r4F3A 16r90CE 16r4F3B 16r516D 16r4F3C 16r9E93 16r4F3D 16r7984 16r4F3E 16r808B 16r4F3F 16r9332 16r4F40 16r8AD6 16r4F41 16r502D 16r4F42 16r548C 16r4F43 16r8A71 16r4F44 16r6B6A 16r4F45 16r8CC4 16r4F46 16r8107 16r4F47 16r60D1 16r4F48 16r67A0 16r4F49 16r9DF2 16r4F4A 16r4E99 16r4F4B 16r4E98 16r4F4C 16r9C10 16r4F4D 16r8A6B 16r4F4E 16r85C1 16r4F4F 16r8568 16r4F50 16r6900 16r4F51 16r6E7E 16r4F52 16r7897 16r4F53 16r8155 16r5021 16r5F0C 16r5022 16r4E10 16r5023 16r4E15 16r5024 16r4E2A 16r5025 16r4E31 16r5026 16r4E36 16r5027 16r4E3C 16r5028 16r4E3F 16r5029 16r4E42 16r502A 16r4E56 16r502B 16r4E58 16r502C 16r4E82 16r502D 16r4E85 16r502E 16r8C6B 16r502F 16r4E8A 16r5030 16r8212 16r5031 16r5F0D 16r5032 16r4E8E 16r5033 16r4E9E 16r5034 16r4E9F 16r5035 16r4EA0 16r5036 16r4EA2 16r5037 16r4EB0 16r5038 16r4EB3 16r5039 16r4EB6 16r503A 16r4ECE 16r503B 16r4ECD 16r503C 16r4EC4 16r503D 16r4EC6 16r503E 16r4EC2 16r503F 16r4ED7 16r5040 16r4EDE 16r5041 16r4EED 16r5042 16r4EDF 16r5043 16r4EF7 16r5044 16r4F09 16r5045 16r4F5A 16r5046 16r4F30 16r5047 16r4F5B 16r5048 16r4F5D 16r5049 16r4F57 16r504A 16r4F47 16r504B 16r4F76 16r504C 16r4F88 16r504D 16r4F8F 16r504E 16r4F98 16r504F 16r4F7B 16r5050 16r4F69 16r5051 16r4F70 16r5052 16r4F91 16r5053 16r4F6F 16r5054 16r4F86 16r5055 16r4F96 16r5056 16r5118 16r5057 16r4FD4 16r5058 16r4FDF 16r5059 16r4FCE 16r505A 16r4FD8 16r505B 16r4FDB 16r505C 16r4FD1 16r505D 16r4FDA 16r505E 16r4FD0 16r505F 16r4FE4 16r5060 16r4FE5 16r5061 16r501A 16r5062 16r5028 16r5063 16r5014 16r5064 16r502A 16r5065 16r5025 16r5066 16r5005 16r5067 16r4F1C 16r5068 16r4FF6 16r5069 16r5021 16r506A 16r5029 16r506B 16r502C 16r506C 16r4FFE 16r506D 16r4FEF 16r506E 16r5011 16r506F 16r5006 16r5070 16r5043 16r5071 16r5047 16r5072 16r6703 16r5073 16r5055 16r5074 16r5050 16r5075 16r5048 16r5076 16r505A 16r5077 16r5056 16r5078 16r506C 16r5079 16r5078 16r507A 16r5080 16r507B 16r509A 16r507C 16r5085 16r507D 16r50B4 16r507E 16r50B2 16r5121 16r50C9 16r5122 16r50CA 16r5123 16r50B3 16r5124 16r50C2 16r5125 16r50D6 16r5126 16r50DE 16r5127 16r50E5 16r5128 16r50ED 16r5129 16r50E3 16r512A 16r50EE 16r512B 16r50F9 16r512C 16r50F5 16r512D 16r5109 16r512E 16r5101 16r512F 16r5102 16r5130 16r5116 16r5131 16r5115 16r5132 16r5114 16r5133 16r511A 16r5134 16r5121 16r5135 16r513A 16r5136 16r5137 16r5137 16r513C 16r5138 16r513B 16r5139 16r513F 16r513A 16r5140 16r513B 16r5152 16r513C 16r514C 16r513D 16r5154 16r513E 16r5162 16r513F 16r7AF8 16r5140 16r5169 16r5141 16r516A 16r5142 16r516E 16r5143 16r5180 16r5144 16r5182 16r5145 16r56D8 16r5146 16r518C 16r5147 16r5189 16r5148 16r518F 16r5149 16r5191 16r514A 16r5193 16r514B 16r5195 16r514C 16r5196 16r514D 16r51A4 16r514E 16r51A6 16r514F 16r51A2 16r5150 16r51A9 16r5151 16r51AA 16r5152 16r51AB 16r5153 16r51B3 16r5154 16r51B1 16r5155 16r51B2 16r5156 16r51B0 16r5157 16r51B5 16r5158 16r51BD 16r5159 16r51C5 16r515A 16r51C9 16r515B 16r51DB 16r515C 16r51E0 16r515D 16r8655 16r515E 16r51E9 16r515F 16r51ED 16r5160 16r51F0 16r5161 16r51F5 16r5162 16r51FE 16r5163 16r5204 16r5164 16r520B 16r5165 16r5214 16r5166 16r520E 16r5167 16r5227 16r5168 16r522A 16r5169 16r522E 16r516A 16r5233 16r516B 16r5239 16r516C 16r524F 16r516D 16r5244 16r516E 16r524B 16r516F 16r524C 16r5170 16r525E 16r5171 16r5254 16r5172 16r526A 16r5173 16r5274 16r5174 16r5269 16r5175 16r5273 16r5176 16r527F 16r5177 16r527D 16r5178 16r528D 16r5179 16r5294 16r517A 16r5292 16r517B 16r5271 16r517C 16r5288 16r517D 16r5291 16r517E 16r8FA8 16r5221 16r8FA7 16r5222 16r52AC 16r5223 16r52AD 16r5224 16r52BC 16r5225 16r52B5 16r5226 16r52C1 16r5227 16r52CD 16r5228 16r52D7 16r5229 16r52DE 16r522A 16r52E3 16r522B 16r52E6 16r522C 16r98ED 16r522D 16r52E0 16r522E 16r52F3 16r522F 16r52F5 16r5230 16r52F8 16r5231 16r52F9 16r5232 16r5306 16r5233 16r5308 16r5234 16r7538 16r5235 16r530D 16r5236 16r5310 16r5237 16r530F 16r5238 16r5315 16r5239 16r531A 16r523A 16r5323 16r523B 16r532F 16r523C 16r5331 16r523D 16r5333 16r523E 16r5338 16r523F 16r5340 16r5240 16r5346 16r5241 16r5345 16r5242 16r4E17 16r5243 16r5349 16r5244 16r534D 16r5245 16r51D6 16r5246 16r535E 16r5247 16r5369 16r5248 16r536E 16r5249 16r5918 16r524A 16r537B 16r524B 16r5377 16r524C 16r5382 16r524D 16r5396 16r524E 16r53A0 16r524F 16r53A6 16r5250 16r53A5 16r5251 16r53AE 16r5252 16r53B0 16r5253 16r53B6 16r5254 16r53C3 16r5255 16r7C12 16r5256 16r96D9 16r5257 16r53DF 16r5258 16r66FC 16r5259 16r71EE 16r525A 16r53EE 16r525B 16r53E8 16r525C 16r53ED 16r525D 16r53FA 16r525E 16r5401 16r525F 16r543D 16r5260 16r5440 16r5261 16r542C 16r5262 16r542D 16r5263 16r543C 16r5264 16r542E 16r5265 16r5436 16r5266 16r5429 16r5267 16r541D 16r5268 16r544E 16r5269 16r548F 16r526A 16r5475 16r526B 16r548E 16r526C 16r545F 16r526D 16r5471 16r526E 16r5477 16r526F 16r5470 16r5270 16r5492 16r5271 16r547B 16r5272 16r5480 16r5273 16r5476 16r5274 16r5484 16r5275 16r5490 16r5276 16r5486 16r5277 16r54C7 16r5278 16r54A2 16r5279 16r54B8 16r527A 16r54A5 16r527B 16r54AC 16r527C 16r54C4 16r527D 16r54C8 16r527E 16r54A8 16r5321 16r54AB 16r5322 16r54C2 16r5323 16r54A4 16r5324 16r54BE 16r5325 16r54BC 16r5326 16r54D8 16r5327 16r54E5 16r5328 16r54E6 16r5329 16r550F 16r532A 16r5514 16r532B 16r54FD 16r532C 16r54EE 16r532D 16r54ED 16r532E 16r54FA 16r532F 16r54E2 16r5330 16r5539 16r5331 16r5540 16r5332 16r5563 16r5333 16r554C 16r5334 16r552E 16r5335 16r555C 16r5336 16r5545 16r5337 16r5556 16r5338 16r5557 16r5339 16r5538 16r533A 16r5533 16r533B 16r555D 16r533C 16r5599 16r533D 16r5580 16r533E 16r54AF 16r533F 16r558A 16r5340 16r559F 16r5341 16r557B 16r5342 16r557E 16r5343 16r5598 16r5344 16r559E 16r5345 16r55AE 16r5346 16r557C 16r5347 16r5583 16r5348 16r55A9 16r5349 16r5587 16r534A 16r55A8 16r534B 16r55DA 16r534C 16r55C5 16r534D 16r55DF 16r534E 16r55C4 16r534F 16r55DC 16r5350 16r55E4 16r5351 16r55D4 16r5352 16r5614 16r5353 16r55F7 16r5354 16r5616 16r5355 16r55FE 16r5356 16r55FD 16r5357 16r561B 16r5358 16r55F9 16r5359 16r564E 16r535A 16r5650 16r535B 16r71DF 16r535C 16r5634 16r535D 16r5636 16r535E 16r5632 16r535F 16r5638 16r5360 16r566B 16r5361 16r5664 16r5362 16r562F 16r5363 16r566C 16r5364 16r566A 16r5365 16r5686 16r5366 16r5680 16r5367 16r568A 16r5368 16r56A0 16r5369 16r5694 16r536A 16r568F 16r536B 16r56A5 16r536C 16r56AE 16r536D 16r56B6 16r536E 16r56B4 16r536F 16r56C2 16r5370 16r56BC 16r5371 16r56C1 16r5372 16r56C3 16r5373 16r56C0 16r5374 16r56C8 16r5375 16r56CE 16r5376 16r56D1 16r5377 16r56D3 16r5378 16r56D7 16r5379 16r56EE 16r537A 16r56F9 16r537B 16r5700 16r537C 16r56FF 16r537D 16r5704 16r537E 16r5709 16r5421 16r5708 16r5422 16r570B 16r5423 16r570D 16r5424 16r5713 16r5425 16r5718 16r5426 16r5716 16r5427 16r55C7 16r5428 16r571C 16r5429 16r5726 16r542A 16r5737 16r542B 16r5738 16r542C 16r574E 16r542D 16r573B 16r542E 16r5740 16r542F 16r574F 16r5430 16r5769 16r5431 16r57C0 16r5432 16r5788 16r5433 16r5761 16r5434 16r577F 16r5435 16r5789 16r5436 16r5793 16r5437 16r57A0 16r5438 16r57B3 16r5439 16r57A4 16r543A 16r57AA 16r543B 16r57B0 16r543C 16r57C3 16r543D 16r57C6 16r543E 16r57D4 16r543F 16r57D2 16r5440 16r57D3 16r5441 16r580A 16r5442 16r57D6 16r5443 16r57E3 16r5444 16r580B 16r5445 16r5819 16r5446 16r581D 16r5447 16r5872 16r5448 16r5821 16r5449 16r5862 16r544A 16r584B 16r544B 16r5870 16r544C 16r6BC0 16r544D 16r5852 16r544E 16r583D 16r544F 16r5879 16r5450 16r5885 16r5451 16r58B9 16r5452 16r589F 16r5453 16r58AB 16r5454 16r58BA 16r5455 16r58DE 16r5456 16r58BB 16r5457 16r58B8 16r5458 16r58AE 16r5459 16r58C5 16r545A 16r58D3 16r545B 16r58D1 16r545C 16r58D7 16r545D 16r58D9 16r545E 16r58D8 16r545F 16r58E5 16r5460 16r58DC 16r5461 16r58E4 16r5462 16r58DF 16r5463 16r58EF 16r5464 16r58FA 16r5465 16r58F9 16r5466 16r58FB 16r5467 16r58FC 16r5468 16r58FD 16r5469 16r5902 16r546A 16r590A 16r546B 16r5910 16r546C 16r591B 16r546D 16r68A6 16r546E 16r5925 16r546F 16r592C 16r5470 16r592D 16r5471 16r5932 16r5472 16r5938 16r5473 16r593E 16r5474 16r7AD2 16r5475 16r5955 16r5476 16r5950 16r5477 16r594E 16r5478 16r595A 16r5479 16r5958 16r547A 16r5962 16r547B 16r5960 16r547C 16r5967 16r547D 16r596C 16r547E 16r5969 16r5521 16r5978 16r5522 16r5981 16r5523 16r599D 16r5524 16r4F5E 16r5525 16r4FAB 16r5526 16r59A3 16r5527 16r59B2 16r5528 16r59C6 16r5529 16r59E8 16r552A 16r59DC 16r552B 16r598D 16r552C 16r59D9 16r552D 16r59DA 16r552E 16r5A25 16r552F 16r5A1F 16r5530 16r5A11 16r5531 16r5A1C 16r5532 16r5A09 16r5533 16r5A1A 16r5534 16r5A40 16r5535 16r5A6C 16r5536 16r5A49 16r5537 16r5A35 16r5538 16r5A36 16r5539 16r5A62 16r553A 16r5A6A 16r553B 16r5A9A 16r553C 16r5ABC 16r553D 16r5ABE 16r553E 16r5ACB 16r553F 16r5AC2 16r5540 16r5ABD 16r5541 16r5AE3 16r5542 16r5AD7 16r5543 16r5AE6 16r5544 16r5AE9 16r5545 16r5AD6 16r5546 16r5AFA 16r5547 16r5AFB 16r5548 16r5B0C 16r5549 16r5B0B 16r554A 16r5B16 16r554B 16r5B32 16r554C 16r5AD0 16r554D 16r5B2A 16r554E 16r5B36 16r554F 16r5B3E 16r5550 16r5B43 16r5551 16r5B45 16r5552 16r5B40 16r5553 16r5B51 16r5554 16r5B55 16r5555 16r5B5A 16r5556 16r5B5B 16r5557 16r5B65 16r5558 16r5B69 16r5559 16r5B70 16r555A 16r5B73 16r555B 16r5B75 16r555C 16r5B78 16r555D 16r6588 16r555E 16r5B7A 16r555F 16r5B80 16r5560 16r5B83 16r5561 16r5BA6 16r5562 16r5BB8 16r5563 16r5BC3 16r5564 16r5BC7 16r5565 16r5BC9 16r5566 16r5BD4 16r5567 16r5BD0 16r5568 16r5BE4 16r5569 16r5BE6 16r556A 16r5BE2 16r556B 16r5BDE 16r556C 16r5BE5 16r556D 16r5BEB 16r556E 16r5BF0 16r556F 16r5BF6 16r5570 16r5BF3 16r5571 16r5C05 16r5572 16r5C07 16r5573 16r5C08 16r5574 16r5C0D 16r5575 16r5C13 16r5576 16r5C20 16r5577 16r5C22 16r5578 16r5C28 16r5579 16r5C38 16r557A 16r5C39 16r557B 16r5C41 16r557C 16r5C46 16r557D 16r5C4E 16r557E 16r5C53 16r5621 16r5C50 16r5622 16r5C4F 16r5623 16r5B71 16r5624 16r5C6C 16r5625 16r5C6E 16r5626 16r4E62 16r5627 16r5C76 16r5628 16r5C79 16r5629 16r5C8C 16r562A 16r5C91 16r562B 16r5C94 16r562C 16r599B 16r562D 16r5CAB 16r562E 16r5CBB 16r562F 16r5CB6 16r5630 16r5CBC 16r5631 16r5CB7 16r5632 16r5CC5 16r5633 16r5CBE 16r5634 16r5CC7 16r5635 16r5CD9 16r5636 16r5CE9 16r5637 16r5CFD 16r5638 16r5CFA 16r5639 16r5CED 16r563A 16r5D8C 16r563B 16r5CEA 16r563C 16r5D0B 16r563D 16r5D15 16r563E 16r5D17 16r563F 16r5D5C 16r5640 16r5D1F 16r5641 16r5D1B 16r5642 16r5D11 16r5643 16r5D14 16r5644 16r5D22 16r5645 16r5D1A 16r5646 16r5D19 16r5647 16r5D18 16r5648 16r5D4C 16r5649 16r5D52 16r564A 16r5D4E 16r564B 16r5D4B 16r564C 16r5D6C 16r564D 16r5D73 16r564E 16r5D76 16r564F 16r5D87 16r5650 16r5D84 16r5651 16r5D82 16r5652 16r5DA2 16r5653 16r5D9D 16r5654 16r5DAC 16r5655 16r5DAE 16r5656 16r5DBD 16r5657 16r5D90 16r5658 16r5DB7 16r5659 16r5DBC 16r565A 16r5DC9 16r565B 16r5DCD 16r565C 16r5DD3 16r565D 16r5DD2 16r565E 16r5DD6 16r565F 16r5DDB 16r5660 16r5DEB 16r5661 16r5DF2 16r5662 16r5DF5 16r5663 16r5E0B 16r5664 16r5E1A 16r5665 16r5E19 16r5666 16r5E11 16r5667 16r5E1B 16r5668 16r5E36 16r5669 16r5E37 16r566A 16r5E44 16r566B 16r5E43 16r566C 16r5E40 16r566D 16r5E4E 16r566E 16r5E57 16r566F 16r5E54 16r5670 16r5E5F 16r5671 16r5E62 16r5672 16r5E64 16r5673 16r5E47 16r5674 16r5E75 16r5675 16r5E76 16r5676 16r5E7A 16r5677 16r9EBC 16r5678 16r5E7F 16r5679 16r5EA0 16r567A 16r5EC1 16r567B 16r5EC2 16r567C 16r5EC8 16r567D 16r5ED0 16r567E 16r5ECF 16r5721 16r5ED6 16r5722 16r5EE3 16r5723 16r5EDD 16r5724 16r5EDA 16r5725 16r5EDB 16r5726 16r5EE2 16r5727 16r5EE1 16r5728 16r5EE8 16r5729 16r5EE9 16r572A 16r5EEC 16r572B 16r5EF1 16r572C 16r5EF3 16r572D 16r5EF0 16r572E 16r5EF4 16r572F 16r5EF8 16r5730 16r5EFE 16r5731 16r5F03 16r5732 16r5F09 16r5733 16r5F5D 16r5734 16r5F5C 16r5735 16r5F0B 16r5736 16r5F11 16r5737 16r5F16 16r5738 16r5F29 16r5739 16r5F2D 16r573A 16r5F38 16r573B 16r5F41 16r573C 16r5F48 16r573D 16r5F4C 16r573E 16r5F4E 16r573F 16r5F2F 16r5740 16r5F51 16r5741 16r5F56 16r5742 16r5F57 16r5743 16r5F59 16r5744 16r5F61 16r5745 16r5F6D 16r5746 16r5F73 16r5747 16r5F77 16r5748 16r5F83 16r5749 16r5F82 16r574A 16r5F7F 16r574B 16r5F8A 16r574C 16r5F88 16r574D 16r5F91 16r574E 16r5F87 16r574F 16r5F9E 16r5750 16r5F99 16r5751 16r5F98 16r5752 16r5FA0 16r5753 16r5FA8 16r5754 16r5FAD 16r5755 16r5FBC 16r5756 16r5FD6 16r5757 16r5FFB 16r5758 16r5FE4 16r5759 16r5FF8 16r575A 16r5FF1 16r575B 16r5FDD 16r575C 16r60B3 16r575D 16r5FFF 16r575E 16r6021 16r575F 16r6060 16r5760 16r6019 16r5761 16r6010 16r5762 16r6029 16r5763 16r600E 16r5764 16r6031 16r5765 16r601B 16r5766 16r6015 16r5767 16r602B 16r5768 16r6026 16r5769 16r600F 16r576A 16r603A 16r576B 16r605A 16r576C 16r6041 16r576D 16r606A 16r576E 16r6077 16r576F 16r605F 16r5770 16r604A 16r5771 16r6046 16r5772 16r604D 16r5773 16r6063 16r5774 16r6043 16r5775 16r6064 16r5776 16r6042 16r5777 16r606C 16r5778 16r606B 16r5779 16r6059 16r577A 16r6081 16r577B 16r608D 16r577C 16r60E7 16r577D 16r6083 16r577E 16r609A 16r5821 16r6084 16r5822 16r609B 16r5823 16r6096 16r5824 16r6097 16r5825 16r6092 16r5826 16r60A7 16r5827 16r608B 16r5828 16r60E1 16r5829 16r60B8 16r582A 16r60E0 16r582B 16r60D3 16r582C 16r60B4 16r582D 16r5FF0 16r582E 16r60BD 16r582F 16r60C6 16r5830 16r60B5 16r5831 16r60D8 16r5832 16r614D 16r5833 16r6115 16r5834 16r6106 16r5835 16r60F6 16r5836 16r60F7 16r5837 16r6100 16r5838 16r60F4 16r5839 16r60FA 16r583A 16r6103 16r583B 16r6121 16r583C 16r60FB 16r583D 16r60F1 16r583E 16r610D 16r583F 16r610E 16r5840 16r6147 16r5841 16r613E 16r5842 16r6128 16r5843 16r6127 16r5844 16r614A 16r5845 16r613F 16r5846 16r613C 16r5847 16r612C 16r5848 16r6134 16r5849 16r613D 16r584A 16r6142 16r584B 16r6144 16r584C 16r6173 16r584D 16r6177 16r584E 16r6158 16r584F 16r6159 16r5850 16r615A 16r5851 16r616B 16r5852 16r6174 16r5853 16r616F 16r5854 16r6165 16r5855 16r6171 16r5856 16r615F 16r5857 16r615D 16r5858 16r6153 16r5859 16r6175 16r585A 16r6199 16r585B 16r6196 16r585C 16r6187 16r585D 16r61AC 16r585E 16r6194 16r585F 16r619A 16r5860 16r618A 16r5861 16r6191 16r5862 16r61AB 16r5863 16r61AE 16r5864 16r61CC 16r5865 16r61CA 16r5866 16r61C9 16r5867 16r61F7 16r5868 16r61C8 16r5869 16r61C3 16r586A 16r61C6 16r586B 16r61BA 16r586C 16r61CB 16r586D 16r7F79 16r586E 16r61CD 16r586F 16r61E6 16r5870 16r61E3 16r5871 16r61F6 16r5872 16r61FA 16r5873 16r61F4 16r5874 16r61FF 16r5875 16r61FD 16r5876 16r61FC 16r5877 16r61FE 16r5878 16r6200 16r5879 16r6208 16r587A 16r6209 16r587B 16r620D 16r587C 16r620C 16r587D 16r6214 16r587E 16r621B 16r5921 16r621E 16r5922 16r6221 16r5923 16r622A 16r5924 16r622E 16r5925 16r6230 16r5926 16r6232 16r5927 16r6233 16r5928 16r6241 16r5929 16r624E 16r592A 16r625E 16r592B 16r6263 16r592C 16r625B 16r592D 16r6260 16r592E 16r6268 16r592F 16r627C 16r5930 16r6282 16r5931 16r6289 16r5932 16r627E 16r5933 16r6292 16r5934 16r6293 16r5935 16r6296 16r5936 16r62D4 16r5937 16r6283 16r5938 16r6294 16r5939 16r62D7 16r593A 16r62D1 16r593B 16r62BB 16r593C 16r62CF 16r593D 16r62FF 16r593E 16r62C6 16r593F 16r64D4 16r5940 16r62C8 16r5941 16r62DC 16r5942 16r62CC 16r5943 16r62CA 16r5944 16r62C2 16r5945 16r62C7 16r5946 16r629B 16r5947 16r62C9 16r5948 16r630C 16r5949 16r62EE 16r594A 16r62F1 16r594B 16r6327 16r594C 16r6302 16r594D 16r6308 16r594E 16r62EF 16r594F 16r62F5 16r5950 16r6350 16r5951 16r633E 16r5952 16r634D 16r5953 16r641C 16r5954 16r634F 16r5955 16r6396 16r5956 16r638E 16r5957 16r6380 16r5958 16r63AB 16r5959 16r6376 16r595A 16r63A3 16r595B 16r638F 16r595C 16r6389 16r595D 16r639F 16r595E 16r63B5 16r595F 16r636B 16r5960 16r6369 16r5961 16r63BE 16r5962 16r63E9 16r5963 16r63C0 16r5964 16r63C6 16r5965 16r63E3 16r5966 16r63C9 16r5967 16r63D2 16r5968 16r63F6 16r5969 16r63C4 16r596A 16r6416 16r596B 16r6434 16r596C 16r6406 16r596D 16r6413 16r596E 16r6426 16r596F 16r6436 16r5970 16r651D 16r5971 16r6417 16r5972 16r6428 16r5973 16r640F 16r5974 16r6467 16r5975 16r646F 16r5976 16r6476 16r5977 16r644E 16r5978 16r652A 16r5979 16r6495 16r597A 16r6493 16r597B 16r64A5 16r597C 16r64A9 16r597D 16r6488 16r597E 16r64BC 16r5A21 16r64DA 16r5A22 16r64D2 16r5A23 16r64C5 16r5A24 16r64C7 16r5A25 16r64BB 16r5A26 16r64D8 16r5A27 16r64C2 16r5A28 16r64F1 16r5A29 16r64E7 16r5A2A 16r8209 16r5A2B 16r64E0 16r5A2C 16r64E1 16r5A2D 16r62AC 16r5A2E 16r64E3 16r5A2F 16r64EF 16r5A30 16r652C 16r5A31 16r64F6 16r5A32 16r64F4 16r5A33 16r64F2 16r5A34 16r64FA 16r5A35 16r6500 16r5A36 16r64FD 16r5A37 16r6518 16r5A38 16r651C 16r5A39 16r6505 16r5A3A 16r6524 16r5A3B 16r6523 16r5A3C 16r652B 16r5A3D 16r6534 16r5A3E 16r6535 16r5A3F 16r6537 16r5A40 16r6536 16r5A41 16r6538 16r5A42 16r754B 16r5A43 16r6548 16r5A44 16r6556 16r5A45 16r6555 16r5A46 16r654D 16r5A47 16r6558 16r5A48 16r655E 16r5A49 16r655D 16r5A4A 16r6572 16r5A4B 16r6578 16r5A4C 16r6582 16r5A4D 16r6583 16r5A4E 16r8B8A 16r5A4F 16r659B 16r5A50 16r659F 16r5A51 16r65AB 16r5A52 16r65B7 16r5A53 16r65C3 16r5A54 16r65C6 16r5A55 16r65C1 16r5A56 16r65C4 16r5A57 16r65CC 16r5A58 16r65D2 16r5A59 16r65DB 16r5A5A 16r65D9 16r5A5B 16r65E0 16r5A5C 16r65E1 16r5A5D 16r65F1 16r5A5E 16r6772 16r5A5F 16r660A 16r5A60 16r6603 16r5A61 16r65FB 16r5A62 16r6773 16r5A63 16r6635 16r5A64 16r6636 16r5A65 16r6634 16r5A66 16r661C 16r5A67 16r664F 16r5A68 16r6644 16r5A69 16r6649 16r5A6A 16r6641 16r5A6B 16r665E 16r5A6C 16r665D 16r5A6D 16r6664 16r5A6E 16r6667 16r5A6F 16r6668 16r5A70 16r665F 16r5A71 16r6662 16r5A72 16r6670 16r5A73 16r6683 16r5A74 16r6688 16r5A75 16r668E 16r5A76 16r6689 16r5A77 16r6684 16r5A78 16r6698 16r5A79 16r669D 16r5A7A 16r66C1 16r5A7B 16r66B9 16r5A7C 16r66C9 16r5A7D 16r66BE 16r5A7E 16r66BC 16r5B21 16r66C4 16r5B22 16r66B8 16r5B23 16r66D6 16r5B24 16r66DA 16r5B25 16r66E0 16r5B26 16r663F 16r5B27 16r66E6 16r5B28 16r66E9 16r5B29 16r66F0 16r5B2A 16r66F5 16r5B2B 16r66F7 16r5B2C 16r670F 16r5B2D 16r6716 16r5B2E 16r671E 16r5B2F 16r6726 16r5B30 16r6727 16r5B31 16r9738 16r5B32 16r672E 16r5B33 16r673F 16r5B34 16r6736 16r5B35 16r6741 16r5B36 16r6738 16r5B37 16r6737 16r5B38 16r6746 16r5B39 16r675E 16r5B3A 16r6760 16r5B3B 16r6759 16r5B3C 16r6763 16r5B3D 16r6764 16r5B3E 16r6789 16r5B3F 16r6770 16r5B40 16r67A9 16r5B41 16r677C 16r5B42 16r676A 16r5B43 16r678C 16r5B44 16r678B 16r5B45 16r67A6 16r5B46 16r67A1 16r5B47 16r6785 16r5B48 16r67B7 16r5B49 16r67EF 16r5B4A 16r67B4 16r5B4B 16r67EC 16r5B4C 16r67B3 16r5B4D 16r67E9 16r5B4E 16r67B8 16r5B4F 16r67E4 16r5B50 16r67DE 16r5B51 16r67DD 16r5B52 16r67E2 16r5B53 16r67EE 16r5B54 16r67B9 16r5B55 16r67CE 16r5B56 16r67C6 16r5B57 16r67E7 16r5B58 16r6A9C 16r5B59 16r681E 16r5B5A 16r6846 16r5B5B 16r6829 16r5B5C 16r6840 16r5B5D 16r684D 16r5B5E 16r6832 16r5B5F 16r684E 16r5B60 16r68B3 16r5B61 16r682B 16r5B62 16r6859 16r5B63 16r6863 16r5B64 16r6877 16r5B65 16r687F 16r5B66 16r689F 16r5B67 16r688F 16r5B68 16r68AD 16r5B69 16r6894 16r5B6A 16r689D 16r5B6B 16r689B 16r5B6C 16r6883 16r5B6D 16r6AAE 16r5B6E 16r68B9 16r5B6F 16r6874 16r5B70 16r68B5 16r5B71 16r68A0 16r5B72 16r68BA 16r5B73 16r690F 16r5B74 16r688D 16r5B75 16r687E 16r5B76 16r6901 16r5B77 16r68CA 16r5B78 16r6908 16r5B79 16r68D8 16r5B7A 16r6922 16r5B7B 16r6926 16r5B7C 16r68E1 16r5B7D 16r690C 16r5B7E 16r68CD 16r5C21 16r68D4 16r5C22 16r68E7 16r5C23 16r68D5 16r5C24 16r6936 16r5C25 16r6912 16r5C26 16r6904 16r5C27 16r68D7 16r5C28 16r68E3 16r5C29 16r6925 16r5C2A 16r68F9 16r5C2B 16r68E0 16r5C2C 16r68EF 16r5C2D 16r6928 16r5C2E 16r692A 16r5C2F 16r691A 16r5C30 16r6923 16r5C31 16r6921 16r5C32 16r68C6 16r5C33 16r6979 16r5C34 16r6977 16r5C35 16r695C 16r5C36 16r6978 16r5C37 16r696B 16r5C38 16r6954 16r5C39 16r697E 16r5C3A 16r696E 16r5C3B 16r6939 16r5C3C 16r6974 16r5C3D 16r693D 16r5C3E 16r6959 16r5C3F 16r6930 16r5C40 16r6961 16r5C41 16r695E 16r5C42 16r695D 16r5C43 16r6981 16r5C44 16r696A 16r5C45 16r69B2 16r5C46 16r69AE 16r5C47 16r69D0 16r5C48 16r69BF 16r5C49 16r69C1 16r5C4A 16r69D3 16r5C4B 16r69BE 16r5C4C 16r69CE 16r5C4D 16r5BE8 16r5C4E 16r69CA 16r5C4F 16r69DD 16r5C50 16r69BB 16r5C51 16r69C3 16r5C52 16r69A7 16r5C53 16r6A2E 16r5C54 16r6991 16r5C55 16r69A0 16r5C56 16r699C 16r5C57 16r6995 16r5C58 16r69B4 16r5C59 16r69DE 16r5C5A 16r69E8 16r5C5B 16r6A02 16r5C5C 16r6A1B 16r5C5D 16r69FF 16r5C5E 16r6B0A 16r5C5F 16r69F9 16r5C60 16r69F2 16r5C61 16r69E7 16r5C62 16r6A05 16r5C63 16r69B1 16r5C64 16r6A1E 16r5C65 16r69ED 16r5C66 16r6A14 16r5C67 16r69EB 16r5C68 16r6A0A 16r5C69 16r6A12 16r5C6A 16r6AC1 16r5C6B 16r6A23 16r5C6C 16r6A13 16r5C6D 16r6A44 16r5C6E 16r6A0C 16r5C6F 16r6A72 16r5C70 16r6A36 16r5C71 16r6A78 16r5C72 16r6A47 16r5C73 16r6A62 16r5C74 16r6A59 16r5C75 16r6A66 16r5C76 16r6A48 16r5C77 16r6A38 16r5C78 16r6A22 16r5C79 16r6A90 16r5C7A 16r6A8D 16r5C7B 16r6AA0 16r5C7C 16r6A84 16r5C7D 16r6AA2 16r5C7E 16r6AA3 16r5D21 16r6A97 16r5D22 16r8617 16r5D23 16r6ABB 16r5D24 16r6AC3 16r5D25 16r6AC2 16r5D26 16r6AB8 16r5D27 16r6AB3 16r5D28 16r6AAC 16r5D29 16r6ADE 16r5D2A 16r6AD1 16r5D2B 16r6ADF 16r5D2C 16r6AAA 16r5D2D 16r6ADA 16r5D2E 16r6AEA 16r5D2F 16r6AFB 16r5D30 16r6B05 16r5D31 16r8616 16r5D32 16r6AFA 16r5D33 16r6B12 16r5D34 16r6B16 16r5D35 16r9B31 16r5D36 16r6B1F 16r5D37 16r6B38 16r5D38 16r6B37 16r5D39 16r76DC 16r5D3A 16r6B39 16r5D3B 16r98EE 16r5D3C 16r6B47 16r5D3D 16r6B43 16r5D3E 16r6B49 16r5D3F 16r6B50 16r5D40 16r6B59 16r5D41 16r6B54 16r5D42 16r6B5B 16r5D43 16r6B5F 16r5D44 16r6B61 16r5D45 16r6B78 16r5D46 16r6B79 16r5D47 16r6B7F 16r5D48 16r6B80 16r5D49 16r6B84 16r5D4A 16r6B83 16r5D4B 16r6B8D 16r5D4C 16r6B98 16r5D4D 16r6B95 16r5D4E 16r6B9E 16r5D4F 16r6BA4 16r5D50 16r6BAA 16r5D51 16r6BAB 16r5D52 16r6BAF 16r5D53 16r6BB2 16r5D54 16r6BB1 16r5D55 16r6BB3 16r5D56 16r6BB7 16r5D57 16r6BBC 16r5D58 16r6BC6 16r5D59 16r6BCB 16r5D5A 16r6BD3 16r5D5B 16r6BDF 16r5D5C 16r6BEC 16r5D5D 16r6BEB 16r5D5E 16r6BF3 16r5D5F 16r6BEF 16r5D60 16r9EBE 16r5D61 16r6C08 16r5D62 16r6C13 16r5D63 16r6C14 16r5D64 16r6C1B 16r5D65 16r6C24 16r5D66 16r6C23 16r5D67 16r6C5E 16r5D68 16r6C55 16r5D69 16r6C62 16r5D6A 16r6C6A 16r5D6B 16r6C82 16r5D6C 16r6C8D 16r5D6D 16r6C9A 16r5D6E 16r6C81 16r5D6F 16r6C9B 16r5D70 16r6C7E 16r5D71 16r6C68 16r5D72 16r6C73 16r5D73 16r6C92 16r5D74 16r6C90 16r5D75 16r6CC4 16r5D76 16r6CF1 16r5D77 16r6CD3 16r5D78 16r6CBD 16r5D79 16r6CD7 16r5D7A 16r6CC5 16r5D7B 16r6CDD 16r5D7C 16r6CAE 16r5D7D 16r6CB1 16r5D7E 16r6CBE 16r5E21 16r6CBA 16r5E22 16r6CDB 16r5E23 16r6CEF 16r5E24 16r6CD9 16r5E25 16r6CEA 16r5E26 16r6D1F 16r5E27 16r884D 16r5E28 16r6D36 16r5E29 16r6D2B 16r5E2A 16r6D3D 16r5E2B 16r6D38 16r5E2C 16r6D19 16r5E2D 16r6D35 16r5E2E 16r6D33 16r5E2F 16r6D12 16r5E30 16r6D0C 16r5E31 16r6D63 16r5E32 16r6D93 16r5E33 16r6D64 16r5E34 16r6D5A 16r5E35 16r6D79 16r5E36 16r6D59 16r5E37 16r6D8E 16r5E38 16r6D95 16r5E39 16r6FE4 16r5E3A 16r6D85 16r5E3B 16r6DF9 16r5E3C 16r6E15 16r5E3D 16r6E0A 16r5E3E 16r6DB5 16r5E3F 16r6DC7 16r5E40 16r6DE6 16r5E41 16r6DB8 16r5E42 16r6DC6 16r5E43 16r6DEC 16r5E44 16r6DDE 16r5E45 16r6DCC 16r5E46 16r6DE8 16r5E47 16r6DD2 16r5E48 16r6DC5 16r5E49 16r6DFA 16r5E4A 16r6DD9 16r5E4B 16r6DE4 16r5E4C 16r6DD5 16r5E4D 16r6DEA 16r5E4E 16r6DEE 16r5E4F 16r6E2D 16r5E50 16r6E6E 16r5E51 16r6E2E 16r5E52 16r6E19 16r5E53 16r6E72 16r5E54 16r6E5F 16r5E55 16r6E3E 16r5E56 16r6E23 16r5E57 16r6E6B 16r5E58 16r6E2B 16r5E59 16r6E76 16r5E5A 16r6E4D 16r5E5B 16r6E1F 16r5E5C 16r6E43 16r5E5D 16r6E3A 16r5E5E 16r6E4E 16r5E5F 16r6E24 16r5E60 16r6EFF 16r5E61 16r6E1D 16r5E62 16r6E38 16r5E63 16r6E82 16r5E64 16r6EAA 16r5E65 16r6E98 16r5E66 16r6EC9 16r5E67 16r6EB7 16r5E68 16r6ED3 16r5E69 16r6EBD 16r5E6A 16r6EAF 16r5E6B 16r6EC4 16r5E6C 16r6EB2 16r5E6D 16r6ED4 16r5E6E 16r6ED5 16r5E6F 16r6E8F 16r5E70 16r6EA5 16r5E71 16r6EC2 16r5E72 16r6E9F 16r5E73 16r6F41 16r5E74 16r6F11 16r5E75 16r704C 16r5E76 16r6EEC 16r5E77 16r6EF8 16r5E78 16r6EFE 16r5E79 16r6F3F 16r5E7A 16r6EF2 16r5E7B 16r6F31 16r5E7C 16r6EEF 16r5E7D 16r6F32 16r5E7E 16r6ECC 16r5F21 16r6F3E 16r5F22 16r6F13 16r5F23 16r6EF7 16r5F24 16r6F86 16r5F25 16r6F7A 16r5F26 16r6F78 16r5F27 16r6F81 16r5F28 16r6F80 16r5F29 16r6F6F 16r5F2A 16r6F5B 16r5F2B 16r6FF3 16r5F2C 16r6F6D 16r5F2D 16r6F82 16r5F2E 16r6F7C 16r5F2F 16r6F58 16r5F30 16r6F8E 16r5F31 16r6F91 16r5F32 16r6FC2 16r5F33 16r6F66 16r5F34 16r6FB3 16r5F35 16r6FA3 16r5F36 16r6FA1 16r5F37 16r6FA4 16r5F38 16r6FB9 16r5F39 16r6FC6 16r5F3A 16r6FAA 16r5F3B 16r6FDF 16r5F3C 16r6FD5 16r5F3D 16r6FEC 16r5F3E 16r6FD4 16r5F3F 16r6FD8 16r5F40 16r6FF1 16r5F41 16r6FEE 16r5F42 16r6FDB 16r5F43 16r7009 16r5F44 16r700B 16r5F45 16r6FFA 16r5F46 16r7011 16r5F47 16r7001 16r5F48 16r700F 16r5F49 16r6FFE 16r5F4A 16r701B 16r5F4B 16r701A 16r5F4C 16r6F74 16r5F4D 16r701D 16r5F4E 16r7018 16r5F4F 16r701F 16r5F50 16r7030 16r5F51 16r703E 16r5F52 16r7032 16r5F53 16r7051 16r5F54 16r7063 16r5F55 16r7099 16r5F56 16r7092 16r5F57 16r70AF 16r5F58 16r70F1 16r5F59 16r70AC 16r5F5A 16r70B8 16r5F5B 16r70B3 16r5F5C 16r70AE 16r5F5D 16r70DF 16r5F5E 16r70CB 16r5F5F 16r70DD 16r5F60 16r70D9 16r5F61 16r7109 16r5F62 16r70FD 16r5F63 16r711C 16r5F64 16r7119 16r5F65 16r7165 16r5F66 16r7155 16r5F67 16r7188 16r5F68 16r7166 16r5F69 16r7162 16r5F6A 16r714C 16r5F6B 16r7156 16r5F6C 16r716C 16r5F6D 16r718F 16r5F6E 16r71FB 16r5F6F 16r7184 16r5F70 16r7195 16r5F71 16r71A8 16r5F72 16r71AC 16r5F73 16r71D7 16r5F74 16r71B9 16r5F75 16r71BE 16r5F76 16r71D2 16r5F77 16r71C9 16r5F78 16r71D4 16r5F79 16r71CE 16r5F7A 16r71E0 16r5F7B 16r71EC 16r5F7C 16r71E7 16r5F7D 16r71F5 16r5F7E 16r71FC 16r6021 16r71F9 16r6022 16r71FF 16r6023 16r720D 16r6024 16r7210 16r6025 16r721B 16r6026 16r7228 16r6027 16r722D 16r6028 16r722C 16r6029 16r7230 16r602A 16r7232 16r602B 16r723B 16r602C 16r723C 16r602D 16r723F 16r602E 16r7240 16r602F 16r7246 16r6030 16r724B 16r6031 16r7258 16r6032 16r7274 16r6033 16r727E 16r6034 16r7282 16r6035 16r7281 16r6036 16r7287 16r6037 16r7292 16r6038 16r7296 16r6039 16r72A2 16r603A 16r72A7 16r603B 16r72B9 16r603C 16r72B2 16r603D 16r72C3 16r603E 16r72C6 16r603F 16r72C4 16r6040 16r72CE 16r6041 16r72D2 16r6042 16r72E2 16r6043 16r72E0 16r6044 16r72E1 16r6045 16r72F9 16r6046 16r72F7 16r6047 16r500F 16r6048 16r7317 16r6049 16r730A 16r604A 16r731C 16r604B 16r7316 16r604C 16r731D 16r604D 16r7334 16r604E 16r732F 16r604F 16r7329 16r6050 16r7325 16r6051 16r733E 16r6052 16r734E 16r6053 16r734F 16r6054 16r9ED8 16r6055 16r7357 16r6056 16r736A 16r6057 16r7368 16r6058 16r7370 16r6059 16r7378 16r605A 16r7375 16r605B 16r737B 16r605C 16r737A 16r605D 16r73C8 16r605E 16r73B3 16r605F 16r73CE 16r6060 16r73BB 16r6061 16r73C0 16r6062 16r73E5 16r6063 16r73EE 16r6064 16r73DE 16r6065 16r74A2 16r6066 16r7405 16r6067 16r746F 16r6068 16r7425 16r6069 16r73F8 16r606A 16r7432 16r606B 16r743A 16r606C 16r7455 16r606D 16r743F 16r606E 16r745F 16r606F 16r7459 16r6070 16r7441 16r6071 16r745C 16r6072 16r7469 16r6073 16r7470 16r6074 16r7463 16r6075 16r746A 16r6076 16r7476 16r6077 16r747E 16r6078 16r748B 16r6079 16r749E 16r607A 16r74A7 16r607B 16r74CA 16r607C 16r74CF 16r607D 16r74D4 16r607E 16r73F1 16r6121 16r74E0 16r6122 16r74E3 16r6123 16r74E7 16r6124 16r74E9 16r6125 16r74EE 16r6126 16r74F2 16r6127 16r74F0 16r6128 16r74F1 16r6129 16r74F8 16r612A 16r74F7 16r612B 16r7504 16r612C 16r7503 16r612D 16r7505 16r612E 16r750C 16r612F 16r750E 16r6130 16r750D 16r6131 16r7515 16r6132 16r7513 16r6133 16r751E 16r6134 16r7526 16r6135 16r752C 16r6136 16r753C 16r6137 16r7544 16r6138 16r754D 16r6139 16r754A 16r613A 16r7549 16r613B 16r755B 16r613C 16r7546 16r613D 16r755A 16r613E 16r7569 16r613F 16r7564 16r6140 16r7567 16r6141 16r756B 16r6142 16r756D 16r6143 16r7578 16r6144 16r7576 16r6145 16r7586 16r6146 16r7587 16r6147 16r7574 16r6148 16r758A 16r6149 16r7589 16r614A 16r7582 16r614B 16r7594 16r614C 16r759A 16r614D 16r759D 16r614E 16r75A5 16r614F 16r75A3 16r6150 16r75C2 16r6151 16r75B3 16r6152 16r75C3 16r6153 16r75B5 16r6154 16r75BD 16r6155 16r75B8 16r6156 16r75BC 16r6157 16r75B1 16r6158 16r75CD 16r6159 16r75CA 16r615A 16r75D2 16r615B 16r75D9 16r615C 16r75E3 16r615D 16r75DE 16r615E 16r75FE 16r615F 16r75FF 16r6160 16r75FC 16r6161 16r7601 16r6162 16r75F0 16r6163 16r75FA 16r6164 16r75F2 16r6165 16r75F3 16r6166 16r760B 16r6167 16r760D 16r6168 16r7609 16r6169 16r761F 16r616A 16r7627 16r616B 16r7620 16r616C 16r7621 16r616D 16r7622 16r616E 16r7624 16r616F 16r7634 16r6170 16r7630 16r6171 16r763B 16r6172 16r7647 16r6173 16r7648 16r6174 16r7646 16r6175 16r765C 16r6176 16r7658 16r6177 16r7661 16r6178 16r7662 16r6179 16r7668 16r617A 16r7669 16r617B 16r766A 16r617C 16r7667 16r617D 16r766C 16r617E 16r7670 16r6221 16r7672 16r6222 16r7676 16r6223 16r7678 16r6224 16r767C 16r6225 16r7680 16r6226 16r7683 16r6227 16r7688 16r6228 16r768B 16r6229 16r768E 16r622A 16r7696 16r622B 16r7693 16r622C 16r7699 16r622D 16r769A 16r622E 16r76B0 16r622F 16r76B4 16r6230 16r76B8 16r6231 16r76B9 16r6232 16r76BA 16r6233 16r76C2 16r6234 16r76CD 16r6235 16r76D6 16r6236 16r76D2 16r6237 16r76DE 16r6238 16r76E1 16r6239 16r76E5 16r623A 16r76E7 16r623B 16r76EA 16r623C 16r862F 16r623D 16r76FB 16r623E 16r7708 16r623F 16r7707 16r6240 16r7704 16r6241 16r7729 16r6242 16r7724 16r6243 16r771E 16r6244 16r7725 16r6245 16r7726 16r6246 16r771B 16r6247 16r7737 16r6248 16r7738 16r6249 16r7747 16r624A 16r775A 16r624B 16r7768 16r624C 16r776B 16r624D 16r775B 16r624E 16r7765 16r624F 16r777F 16r6250 16r777E 16r6251 16r7779 16r6252 16r778E 16r6253 16r778B 16r6254 16r7791 16r6255 16r77A0 16r6256 16r779E 16r6257 16r77B0 16r6258 16r77B6 16r6259 16r77B9 16r625A 16r77BF 16r625B 16r77BC 16r625C 16r77BD 16r625D 16r77BB 16r625E 16r77C7 16r625F 16r77CD 16r6260 16r77D7 16r6261 16r77DA 16r6262 16r77DC 16r6263 16r77E3 16r6264 16r77EE 16r6265 16r77FC 16r6266 16r780C 16r6267 16r7812 16r6268 16r7926 16r6269 16r7820 16r626A 16r792A 16r626B 16r7845 16r626C 16r788E 16r626D 16r7874 16r626E 16r7886 16r626F 16r787C 16r6270 16r789A 16r6271 16r788C 16r6272 16r78A3 16r6273 16r78B5 16r6274 16r78AA 16r6275 16r78AF 16r6276 16r78D1 16r6277 16r78C6 16r6278 16r78CB 16r6279 16r78D4 16r627A 16r78BE 16r627B 16r78BC 16r627C 16r78C5 16r627D 16r78CA 16r627E 16r78EC 16r6321 16r78E7 16r6322 16r78DA 16r6323 16r78FD 16r6324 16r78F4 16r6325 16r7907 16r6326 16r7912 16r6327 16r7911 16r6328 16r7919 16r6329 16r792C 16r632A 16r792B 16r632B 16r7940 16r632C 16r7960 16r632D 16r7957 16r632E 16r795F 16r632F 16r795A 16r6330 16r7955 16r6331 16r7953 16r6332 16r797A 16r6333 16r797F 16r6334 16r798A 16r6335 16r799D 16r6336 16r79A7 16r6337 16r9F4B 16r6338 16r79AA 16r6339 16r79AE 16r633A 16r79B3 16r633B 16r79B9 16r633C 16r79BA 16r633D 16r79C9 16r633E 16r79D5 16r633F 16r79E7 16r6340 16r79EC 16r6341 16r79E1 16r6342 16r79E3 16r6343 16r7A08 16r6344 16r7A0D 16r6345 16r7A18 16r6346 16r7A19 16r6347 16r7A20 16r6348 16r7A1F 16r6349 16r7980 16r634A 16r7A31 16r634B 16r7A3B 16r634C 16r7A3E 16r634D 16r7A37 16r634E 16r7A43 16r634F 16r7A57 16r6350 16r7A49 16r6351 16r7A61 16r6352 16r7A62 16r6353 16r7A69 16r6354 16r9F9D 16r6355 16r7A70 16r6356 16r7A79 16r6357 16r7A7D 16r6358 16r7A88 16r6359 16r7A97 16r635A 16r7A95 16r635B 16r7A98 16r635C 16r7A96 16r635D 16r7AA9 16r635E 16r7AC8 16r635F 16r7AB0 16r6360 16r7AB6 16r6361 16r7AC5 16r6362 16r7AC4 16r6363 16r7ABF 16r6364 16r9083 16r6365 16r7AC7 16r6366 16r7ACA 16r6367 16r7ACD 16r6368 16r7ACF 16r6369 16r7AD5 16r636A 16r7AD3 16r636B 16r7AD9 16r636C 16r7ADA 16r636D 16r7ADD 16r636E 16r7AE1 16r636F 16r7AE2 16r6370 16r7AE6 16r6371 16r7AED 16r6372 16r7AF0 16r6373 16r7B02 16r6374 16r7B0F 16r6375 16r7B0A 16r6376 16r7B06 16r6377 16r7B33 16r6378 16r7B18 16r6379 16r7B19 16r637A 16r7B1E 16r637B 16r7B35 16r637C 16r7B28 16r637D 16r7B36 16r637E 16r7B50 16r6421 16r7B7A 16r6422 16r7B04 16r6423 16r7B4D 16r6424 16r7B0B 16r6425 16r7B4C 16r6426 16r7B45 16r6427 16r7B75 16r6428 16r7B65 16r6429 16r7B74 16r642A 16r7B67 16r642B 16r7B70 16r642C 16r7B71 16r642D 16r7B6C 16r642E 16r7B6E 16r642F 16r7B9D 16r6430 16r7B98 16r6431 16r7B9F 16r6432 16r7B8D 16r6433 16r7B9C 16r6434 16r7B9A 16r6435 16r7B8B 16r6436 16r7B92 16r6437 16r7B8F 16r6438 16r7B5D 16r6439 16r7B99 16r643A 16r7BCB 16r643B 16r7BC1 16r643C 16r7BCC 16r643D 16r7BCF 16r643E 16r7BB4 16r643F 16r7BC6 16r6440 16r7BDD 16r6441 16r7BE9 16r6442 16r7C11 16r6443 16r7C14 16r6444 16r7BE6 16r6445 16r7BE5 16r6446 16r7C60 16r6447 16r7C00 16r6448 16r7C07 16r6449 16r7C13 16r644A 16r7BF3 16r644B 16r7BF7 16r644C 16r7C17 16r644D 16r7C0D 16r644E 16r7BF6 16r644F 16r7C23 16r6450 16r7C27 16r6451 16r7C2A 16r6452 16r7C1F 16r6453 16r7C37 16r6454 16r7C2B 16r6455 16r7C3D 16r6456 16r7C4C 16r6457 16r7C43 16r6458 16r7C54 16r6459 16r7C4F 16r645A 16r7C40 16r645B 16r7C50 16r645C 16r7C58 16r645D 16r7C5F 16r645E 16r7C64 16r645F 16r7C56 16r6460 16r7C65 16r6461 16r7C6C 16r6462 16r7C75 16r6463 16r7C83 16r6464 16r7C90 16r6465 16r7CA4 16r6466 16r7CAD 16r6467 16r7CA2 16r6468 16r7CAB 16r6469 16r7CA1 16r646A 16r7CA8 16r646B 16r7CB3 16r646C 16r7CB2 16r646D 16r7CB1 16r646E 16r7CAE 16r646F 16r7CB9 16r6470 16r7CBD 16r6471 16r7CC0 16r6472 16r7CC5 16r6473 16r7CC2 16r6474 16r7CD8 16r6475 16r7CD2 16r6476 16r7CDC 16r6477 16r7CE2 16r6478 16r9B3B 16r6479 16r7CEF 16r647A 16r7CF2 16r647B 16r7CF4 16r647C 16r7CF6 16r647D 16r7CFA 16r647E 16r7D06 16r6521 16r7D02 16r6522 16r7D1C 16r6523 16r7D15 16r6524 16r7D0A 16r6525 16r7D45 16r6526 16r7D4B 16r6527 16r7D2E 16r6528 16r7D32 16r6529 16r7D3F 16r652A 16r7D35 16r652B 16r7D46 16r652C 16r7D73 16r652D 16r7D56 16r652E 16r7D4E 16r652F 16r7D72 16r6530 16r7D68 16r6531 16r7D6E 16r6532 16r7D4F 16r6533 16r7D63 16r6534 16r7D93 16r6535 16r7D89 16r6536 16r7D5B 16r6537 16r7D8F 16r6538 16r7D7D 16r6539 16r7D9B 16r653A 16r7DBA 16r653B 16r7DAE 16r653C 16r7DA3 16r653D 16r7DB5 16r653E 16r7DC7 16r653F 16r7DBD 16r6540 16r7DAB 16r6541 16r7E3D 16r6542 16r7DA2 16r6543 16r7DAF 16r6544 16r7DDC 16r6545 16r7DB8 16r6546 16r7D9F 16r6547 16r7DB0 16r6548 16r7DD8 16r6549 16r7DDD 16r654A 16r7DE4 16r654B 16r7DDE 16r654C 16r7DFB 16r654D 16r7DF2 16r654E 16r7DE1 16r654F 16r7E05 16r6550 16r7E0A 16r6551 16r7E23 16r6552 16r7E21 16r6553 16r7E12 16r6554 16r7E31 16r6555 16r7E1F 16r6556 16r7E09 16r6557 16r7E0B 16r6558 16r7E22 16r6559 16r7E46 16r655A 16r7E66 16r655B 16r7E3B 16r655C 16r7E35 16r655D 16r7E39 16r655E 16r7E43 16r655F 16r7E37 16r6560 16r7E32 16r6561 16r7E3A 16r6562 16r7E67 16r6563 16r7E5D 16r6564 16r7E56 16r6565 16r7E5E 16r6566 16r7E59 16r6567 16r7E5A 16r6568 16r7E79 16r6569 16r7E6A 16r656A 16r7E69 16r656B 16r7E7C 16r656C 16r7E7B 16r656D 16r7E83 16r656E 16r7DD5 16r656F 16r7E7D 16r6570 16r8FAE 16r6571 16r7E7F 16r6572 16r7E88 16r6573 16r7E89 16r6574 16r7E8C 16r6575 16r7E92 16r6576 16r7E90 16r6577 16r7E93 16r6578 16r7E94 16r6579 16r7E96 16r657A 16r7E8E 16r657B 16r7E9B 16r657C 16r7E9C 16r657D 16r7F38 16r657E 16r7F3A 16r6621 16r7F45 16r6622 16r7F4C 16r6623 16r7F4D 16r6624 16r7F4E 16r6625 16r7F50 16r6626 16r7F51 16r6627 16r7F55 16r6628 16r7F54 16r6629 16r7F58 16r662A 16r7F5F 16r662B 16r7F60 16r662C 16r7F68 16r662D 16r7F69 16r662E 16r7F67 16r662F 16r7F78 16r6630 16r7F82 16r6631 16r7F86 16r6632 16r7F83 16r6633 16r7F88 16r6634 16r7F87 16r6635 16r7F8C 16r6636 16r7F94 16r6637 16r7F9E 16r6638 16r7F9D 16r6639 16r7F9A 16r663A 16r7FA3 16r663B 16r7FAF 16r663C 16r7FB2 16r663D 16r7FB9 16r663E 16r7FAE 16r663F 16r7FB6 16r6640 16r7FB8 16r6641 16r8B71 16r6642 16r7FC5 16r6643 16r7FC6 16r6644 16r7FCA 16r6645 16r7FD5 16r6646 16r7FD4 16r6647 16r7FE1 16r6648 16r7FE6 16r6649 16r7FE9 16r664A 16r7FF3 16r664B 16r7FF9 16r664C 16r98DC 16r664D 16r8006 16r664E 16r8004 16r664F 16r800B 16r6650 16r8012 16r6651 16r8018 16r6652 16r8019 16r6653 16r801C 16r6654 16r8021 16r6655 16r8028 16r6656 16r803F 16r6657 16r803B 16r6658 16r804A 16r6659 16r8046 16r665A 16r8052 16r665B 16r8058 16r665C 16r805A 16r665D 16r805F 16r665E 16r8062 16r665F 16r8068 16r6660 16r8073 16r6661 16r8072 16r6662 16r8070 16r6663 16r8076 16r6664 16r8079 16r6665 16r807D 16r6666 16r807F 16r6667 16r8084 16r6668 16r8086 16r6669 16r8085 16r666A 16r809B 16r666B 16r8093 16r666C 16r809A 16r666D 16r80AD 16r666E 16r5190 16r666F 16r80AC 16r6670 16r80DB 16r6671 16r80E5 16r6672 16r80D9 16r6673 16r80DD 16r6674 16r80C4 16r6675 16r80DA 16r6676 16r80D6 16r6677 16r8109 16r6678 16r80EF 16r6679 16r80F1 16r667A 16r811B 16r667B 16r8129 16r667C 16r8123 16r667D 16r812F 16r667E 16r814B 16r6721 16r968B 16r6722 16r8146 16r6723 16r813E 16r6724 16r8153 16r6725 16r8151 16r6726 16r80FC 16r6727 16r8171 16r6728 16r816E 16r6729 16r8165 16r672A 16r8166 16r672B 16r8174 16r672C 16r8183 16r672D 16r8188 16r672E 16r818A 16r672F 16r8180 16r6730 16r8182 16r6731 16r81A0 16r6732 16r8195 16r6733 16r81A4 16r6734 16r81A3 16r6735 16r815F 16r6736 16r8193 16r6737 16r81A9 16r6738 16r81B0 16r6739 16r81B5 16r673A 16r81BE 16r673B 16r81B8 16r673C 16r81BD 16r673D 16r81C0 16r673E 16r81C2 16r673F 16r81BA 16r6740 16r81C9 16r6741 16r81CD 16r6742 16r81D1 16r6743 16r81D9 16r6744 16r81D8 16r6745 16r81C8 16r6746 16r81DA 16r6747 16r81DF 16r6748 16r81E0 16r6749 16r81E7 16r674A 16r81FA 16r674B 16r81FB 16r674C 16r81FE 16r674D 16r8201 16r674E 16r8202 16r674F 16r8205 16r6750 16r8207 16r6751 16r820A 16r6752 16r820D 16r6753 16r8210 16r6754 16r8216 16r6755 16r8229 16r6756 16r822B 16r6757 16r8238 16r6758 16r8233 16r6759 16r8240 16r675A 16r8259 16r675B 16r8258 16r675C 16r825D 16r675D 16r825A 16r675E 16r825F 16r675F 16r8264 16r6760 16r8262 16r6761 16r8268 16r6762 16r826A 16r6763 16r826B 16r6764 16r822E 16r6765 16r8271 16r6766 16r8277 16r6767 16r8278 16r6768 16r827E 16r6769 16r828D 16r676A 16r8292 16r676B 16r82AB 16r676C 16r829F 16r676D 16r82BB 16r676E 16r82AC 16r676F 16r82E1 16r6770 16r82E3 16r6771 16r82DF 16r6772 16r82D2 16r6773 16r82F4 16r6774 16r82F3 16r6775 16r82FA 16r6776 16r8393 16r6777 16r8303 16r6778 16r82FB 16r6779 16r82F9 16r677A 16r82DE 16r677B 16r8306 16r677C 16r82DC 16r677D 16r8309 16r677E 16r82D9 16r6821 16r8335 16r6822 16r8334 16r6823 16r8316 16r6824 16r8332 16r6825 16r8331 16r6826 16r8340 16r6827 16r8339 16r6828 16r8350 16r6829 16r8345 16r682A 16r832F 16r682B 16r832B 16r682C 16r8317 16r682D 16r8318 16r682E 16r8385 16r682F 16r839A 16r6830 16r83AA 16r6831 16r839F 16r6832 16r83A2 16r6833 16r8396 16r6834 16r8323 16r6835 16r838E 16r6836 16r8387 16r6837 16r838A 16r6838 16r837C 16r6839 16r83B5 16r683A 16r8373 16r683B 16r8375 16r683C 16r83A0 16r683D 16r8389 16r683E 16r83A8 16r683F 16r83F4 16r6840 16r8413 16r6841 16r83EB 16r6842 16r83CE 16r6843 16r83FD 16r6844 16r8403 16r6845 16r83D8 16r6846 16r840B 16r6847 16r83C1 16r6848 16r83F7 16r6849 16r8407 16r684A 16r83E0 16r684B 16r83F2 16r684C 16r840D 16r684D 16r8422 16r684E 16r8420 16r684F 16r83BD 16r6850 16r8438 16r6851 16r8506 16r6852 16r83FB 16r6853 16r846D 16r6854 16r842A 16r6855 16r843C 16r6856 16r855A 16r6857 16r8484 16r6858 16r8477 16r6859 16r846B 16r685A 16r84AD 16r685B 16r846E 16r685C 16r8482 16r685D 16r8469 16r685E 16r8446 16r685F 16r842C 16r6860 16r846F 16r6861 16r8479 16r6862 16r8435 16r6863 16r84CA 16r6864 16r8462 16r6865 16r84B9 16r6866 16r84BF 16r6867 16r849F 16r6868 16r84D9 16r6869 16r84CD 16r686A 16r84BB 16r686B 16r84DA 16r686C 16r84D0 16r686D 16r84C1 16r686E 16r84C6 16r686F 16r84D6 16r6870 16r84A1 16r6871 16r8521 16r6872 16r84FF 16r6873 16r84F4 16r6874 16r8517 16r6875 16r8518 16r6876 16r852C 16r6877 16r851F 16r6878 16r8515 16r6879 16r8514 16r687A 16r84FC 16r687B 16r8540 16r687C 16r8563 16r687D 16r8558 16r687E 16r8548 16r6921 16r8541 16r6922 16r8602 16r6923 16r854B 16r6924 16r8555 16r6925 16r8580 16r6926 16r85A4 16r6927 16r8588 16r6928 16r8591 16r6929 16r858A 16r692A 16r85A8 16r692B 16r856D 16r692C 16r8594 16r692D 16r859B 16r692E 16r85EA 16r692F 16r8587 16r6930 16r859C 16r6931 16r8577 16r6932 16r857E 16r6933 16r8590 16r6934 16r85C9 16r6935 16r85BA 16r6936 16r85CF 16r6937 16r85B9 16r6938 16r85D0 16r6939 16r85D5 16r693A 16r85DD 16r693B 16r85E5 16r693C 16r85DC 16r693D 16r85F9 16r693E 16r860A 16r693F 16r8613 16r6940 16r860B 16r6941 16r85FE 16r6942 16r85FA 16r6943 16r8606 16r6944 16r8622 16r6945 16r861A 16r6946 16r8630 16r6947 16r863F 16r6948 16r864D 16r6949 16r4E55 16r694A 16r8654 16r694B 16r865F 16r694C 16r8667 16r694D 16r8671 16r694E 16r8693 16r694F 16r86A3 16r6950 16r86A9 16r6951 16r86AA 16r6952 16r868B 16r6953 16r868C 16r6954 16r86B6 16r6955 16r86AF 16r6956 16r86C4 16r6957 16r86C6 16r6958 16r86B0 16r6959 16r86C9 16r695A 16r8823 16r695B 16r86AB 16r695C 16r86D4 16r695D 16r86DE 16r695E 16r86E9 16r695F 16r86EC 16r6960 16r86DF 16r6961 16r86DB 16r6962 16r86EF 16r6963 16r8712 16r6964 16r8706 16r6965 16r8708 16r6966 16r8700 16r6967 16r8703 16r6968 16r86FB 16r6969 16r8711 16r696A 16r8709 16r696B 16r870D 16r696C 16r86F9 16r696D 16r870A 16r696E 16r8734 16r696F 16r873F 16r6970 16r8737 16r6971 16r873B 16r6972 16r8725 16r6973 16r8729 16r6974 16r871A 16r6975 16r8760 16r6976 16r875F 16r6977 16r8778 16r6978 16r874C 16r6979 16r874E 16r697A 16r8774 16r697B 16r8757 16r697C 16r8768 16r697D 16r876E 16r697E 16r8759 16r6A21 16r8753 16r6A22 16r8763 16r6A23 16r876A 16r6A24 16r8805 16r6A25 16r87A2 16r6A26 16r879F 16r6A27 16r8782 16r6A28 16r87AF 16r6A29 16r87CB 16r6A2A 16r87BD 16r6A2B 16r87C0 16r6A2C 16r87D0 16r6A2D 16r96D6 16r6A2E 16r87AB 16r6A2F 16r87C4 16r6A30 16r87B3 16r6A31 16r87C7 16r6A32 16r87C6 16r6A33 16r87BB 16r6A34 16r87EF 16r6A35 16r87F2 16r6A36 16r87E0 16r6A37 16r880F 16r6A38 16r880D 16r6A39 16r87FE 16r6A3A 16r87F6 16r6A3B 16r87F7 16r6A3C 16r880E 16r6A3D 16r87D2 16r6A3E 16r8811 16r6A3F 16r8816 16r6A40 16r8815 16r6A41 16r8822 16r6A42 16r8821 16r6A43 16r8831 16r6A44 16r8836 16r6A45 16r8839 16r6A46 16r8827 16r6A47 16r883B 16r6A48 16r8844 16r6A49 16r8842 16r6A4A 16r8852 16r6A4B 16r8859 16r6A4C 16r885E 16r6A4D 16r8862 16r6A4E 16r886B 16r6A4F 16r8881 16r6A50 16r887E 16r6A51 16r889E 16r6A52 16r8875 16r6A53 16r887D 16r6A54 16r88B5 16r6A55 16r8872 16r6A56 16r8882 16r6A57 16r8897 16r6A58 16r8892 16r6A59 16r88AE 16r6A5A 16r8899 16r6A5B 16r88A2 16r6A5C 16r888D 16r6A5D 16r88A4 16r6A5E 16r88B0 16r6A5F 16r88BF 16r6A60 16r88B1 16r6A61 16r88C3 16r6A62 16r88C4 16r6A63 16r88D4 16r6A64 16r88D8 16r6A65 16r88D9 16r6A66 16r88DD 16r6A67 16r88F9 16r6A68 16r8902 16r6A69 16r88FC 16r6A6A 16r88F4 16r6A6B 16r88E8 16r6A6C 16r88F2 16r6A6D 16r8904 16r6A6E 16r890C 16r6A6F 16r890A 16r6A70 16r8913 16r6A71 16r8943 16r6A72 16r891E 16r6A73 16r8925 16r6A74 16r892A 16r6A75 16r892B 16r6A76 16r8941 16r6A77 16r8944 16r6A78 16r893B 16r6A79 16r8936 16r6A7A 16r8938 16r6A7B 16r894C 16r6A7C 16r891D 16r6A7D 16r8960 16r6A7E 16r895E 16r6B21 16r8966 16r6B22 16r8964 16r6B23 16r896D 16r6B24 16r896A 16r6B25 16r896F 16r6B26 16r8974 16r6B27 16r8977 16r6B28 16r897E 16r6B29 16r8983 16r6B2A 16r8988 16r6B2B 16r898A 16r6B2C 16r8993 16r6B2D 16r8998 16r6B2E 16r89A1 16r6B2F 16r89A9 16r6B30 16r89A6 16r6B31 16r89AC 16r6B32 16r89AF 16r6B33 16r89B2 16r6B34 16r89BA 16r6B35 16r89BD 16r6B36 16r89BF 16r6B37 16r89C0 16r6B38 16r89DA 16r6B39 16r89DC 16r6B3A 16r89DD 16r6B3B 16r89E7 16r6B3C 16r89F4 16r6B3D 16r89F8 16r6B3E 16r8A03 16r6B3F 16r8A16 16r6B40 16r8A10 16r6B41 16r8A0C 16r6B42 16r8A1B 16r6B43 16r8A1D 16r6B44 16r8A25 16r6B45 16r8A36 16r6B46 16r8A41 16r6B47 16r8A5B 16r6B48 16r8A52 16r6B49 16r8A46 16r6B4A 16r8A48 16r6B4B 16r8A7C 16r6B4C 16r8A6D 16r6B4D 16r8A6C 16r6B4E 16r8A62 16r6B4F 16r8A85 16r6B50 16r8A82 16r6B51 16r8A84 16r6B52 16r8AA8 16r6B53 16r8AA1 16r6B54 16r8A91 16r6B55 16r8AA5 16r6B56 16r8AA6 16r6B57 16r8A9A 16r6B58 16r8AA3 16r6B59 16r8AC4 16r6B5A 16r8ACD 16r6B5B 16r8AC2 16r6B5C 16r8ADA 16r6B5D 16r8AEB 16r6B5E 16r8AF3 16r6B5F 16r8AE7 16r6B60 16r8AE4 16r6B61 16r8AF1 16r6B62 16r8B14 16r6B63 16r8AE0 16r6B64 16r8AE2 16r6B65 16r8AF7 16r6B66 16r8ADE 16r6B67 16r8ADB 16r6B68 16r8B0C 16r6B69 16r8B07 16r6B6A 16r8B1A 16r6B6B 16r8AE1 16r6B6C 16r8B16 16r6B6D 16r8B10 16r6B6E 16r8B17 16r6B6F 16r8B20 16r6B70 16r8B33 16r6B71 16r97AB 16r6B72 16r8B26 16r6B73 16r8B2B 16r6B74 16r8B3E 16r6B75 16r8B28 16r6B76 16r8B41 16r6B77 16r8B4C 16r6B78 16r8B4F 16r6B79 16r8B4E 16r6B7A 16r8B49 16r6B7B 16r8B56 16r6B7C 16r8B5B 16r6B7D 16r8B5A 16r6B7E 16r8B6B 16r6C21 16r8B5F 16r6C22 16r8B6C 16r6C23 16r8B6F 16r6C24 16r8B74 16r6C25 16r8B7D 16r6C26 16r8B80 16r6C27 16r8B8C 16r6C28 16r8B8E 16r6C29 16r8B92 16r6C2A 16r8B93 16r6C2B 16r8B96 16r6C2C 16r8B99 16r6C2D 16r8B9A 16r6C2E 16r8C3A 16r6C2F 16r8C41 16r6C30 16r8C3F 16r6C31 16r8C48 16r6C32 16r8C4C 16r6C33 16r8C4E 16r6C34 16r8C50 16r6C35 16r8C55 16r6C36 16r8C62 16r6C37 16r8C6C 16r6C38 16r8C78 16r6C39 16r8C7A 16r6C3A 16r8C82 16r6C3B 16r8C89 16r6C3C 16r8C85 16r6C3D 16r8C8A 16r6C3E 16r8C8D 16r6C3F 16r8C8E 16r6C40 16r8C94 16r6C41 16r8C7C 16r6C42 16r8C98 16r6C43 16r621D 16r6C44 16r8CAD 16r6C45 16r8CAA 16r6C46 16r8CBD 16r6C47 16r8CB2 16r6C48 16r8CB3 16r6C49 16r8CAE 16r6C4A 16r8CB6 16r6C4B 16r8CC8 16r6C4C 16r8CC1 16r6C4D 16r8CE4 16r6C4E 16r8CE3 16r6C4F 16r8CDA 16r6C50 16r8CFD 16r6C51 16r8CFA 16r6C52 16r8CFB 16r6C53 16r8D04 16r6C54 16r8D05 16r6C55 16r8D0A 16r6C56 16r8D07 16r6C57 16r8D0F 16r6C58 16r8D0D 16r6C59 16r8D10 16r6C5A 16r9F4E 16r6C5B 16r8D13 16r6C5C 16r8CCD 16r6C5D 16r8D14 16r6C5E 16r8D16 16r6C5F 16r8D67 16r6C60 16r8D6D 16r6C61 16r8D71 16r6C62 16r8D73 16r6C63 16r8D81 16r6C64 16r8D99 16r6C65 16r8DC2 16r6C66 16r8DBE 16r6C67 16r8DBA 16r6C68 16r8DCF 16r6C69 16r8DDA 16r6C6A 16r8DD6 16r6C6B 16r8DCC 16r6C6C 16r8DDB 16r6C6D 16r8DCB 16r6C6E 16r8DEA 16r6C6F 16r8DEB 16r6C70 16r8DDF 16r6C71 16r8DE3 16r6C72 16r8DFC 16r6C73 16r8E08 16r6C74 16r8E09 16r6C75 16r8DFF 16r6C76 16r8E1D 16r6C77 16r8E1E 16r6C78 16r8E10 16r6C79 16r8E1F 16r6C7A 16r8E42 16r6C7B 16r8E35 16r6C7C 16r8E30 16r6C7D 16r8E34 16r6C7E 16r8E4A 16r6D21 16r8E47 16r6D22 16r8E49 16r6D23 16r8E4C 16r6D24 16r8E50 16r6D25 16r8E48 16r6D26 16r8E59 16r6D27 16r8E64 16r6D28 16r8E60 16r6D29 16r8E2A 16r6D2A 16r8E63 16r6D2B 16r8E55 16r6D2C 16r8E76 16r6D2D 16r8E72 16r6D2E 16r8E7C 16r6D2F 16r8E81 16r6D30 16r8E87 16r6D31 16r8E85 16r6D32 16r8E84 16r6D33 16r8E8B 16r6D34 16r8E8A 16r6D35 16r8E93 16r6D36 16r8E91 16r6D37 16r8E94 16r6D38 16r8E99 16r6D39 16r8EAA 16r6D3A 16r8EA1 16r6D3B 16r8EAC 16r6D3C 16r8EB0 16r6D3D 16r8EC6 16r6D3E 16r8EB1 16r6D3F 16r8EBE 16r6D40 16r8EC5 16r6D41 16r8EC8 16r6D42 16r8ECB 16r6D43 16r8EDB 16r6D44 16r8EE3 16r6D45 16r8EFC 16r6D46 16r8EFB 16r6D47 16r8EEB 16r6D48 16r8EFE 16r6D49 16r8F0A 16r6D4A 16r8F05 16r6D4B 16r8F15 16r6D4C 16r8F12 16r6D4D 16r8F19 16r6D4E 16r8F13 16r6D4F 16r8F1C 16r6D50 16r8F1F 16r6D51 16r8F1B 16r6D52 16r8F0C 16r6D53 16r8F26 16r6D54 16r8F33 16r6D55 16r8F3B 16r6D56 16r8F39 16r6D57 16r8F45 16r6D58 16r8F42 16r6D59 16r8F3E 16r6D5A 16r8F4C 16r6D5B 16r8F49 16r6D5C 16r8F46 16r6D5D 16r8F4E 16r6D5E 16r8F57 16r6D5F 16r8F5C 16r6D60 16r8F62 16r6D61 16r8F63 16r6D62 16r8F64 16r6D63 16r8F9C 16r6D64 16r8F9F 16r6D65 16r8FA3 16r6D66 16r8FAD 16r6D67 16r8FAF 16r6D68 16r8FB7 16r6D69 16r8FDA 16r6D6A 16r8FE5 16r6D6B 16r8FE2 16r6D6C 16r8FEA 16r6D6D 16r8FEF 16r6D6E 16r9087 16r6D6F 16r8FF4 16r6D70 16r9005 16r6D71 16r8FF9 16r6D72 16r8FFA 16r6D73 16r9011 16r6D74 16r9015 16r6D75 16r9021 16r6D76 16r900D 16r6D77 16r901E 16r6D78 16r9016 16r6D79 16r900B 16r6D7A 16r9027 16r6D7B 16r9036 16r6D7C 16r9035 16r6D7D 16r9039 16r6D7E 16r8FF8 16r6E21 16r904F 16r6E22 16r9050 16r6E23 16r9051 16r6E24 16r9052 16r6E25 16r900E 16r6E26 16r9049 16r6E27 16r903E 16r6E28 16r9056 16r6E29 16r9058 16r6E2A 16r905E 16r6E2B 16r9068 16r6E2C 16r906F 16r6E2D 16r9076 16r6E2E 16r96A8 16r6E2F 16r9072 16r6E30 16r9082 16r6E31 16r907D 16r6E32 16r9081 16r6E33 16r9080 16r6E34 16r908A 16r6E35 16r9089 16r6E36 16r908F 16r6E37 16r90A8 16r6E38 16r90AF 16r6E39 16r90B1 16r6E3A 16r90B5 16r6E3B 16r90E2 16r6E3C 16r90E4 16r6E3D 16r6248 16r6E3E 16r90DB 16r6E3F 16r9102 16r6E40 16r9112 16r6E41 16r9119 16r6E42 16r9132 16r6E43 16r9130 16r6E44 16r914A 16r6E45 16r9156 16r6E46 16r9158 16r6E47 16r9163 16r6E48 16r9165 16r6E49 16r9169 16r6E4A 16r9173 16r6E4B 16r9172 16r6E4C 16r918B 16r6E4D 16r9189 16r6E4E 16r9182 16r6E4F 16r91A2 16r6E50 16r91AB 16r6E51 16r91AF 16r6E52 16r91AA 16r6E53 16r91B5 16r6E54 16r91B4 16r6E55 16r91BA 16r6E56 16r91C0 16r6E57 16r91C1 16r6E58 16r91C9 16r6E59 16r91CB 16r6E5A 16r91D0 16r6E5B 16r91D6 16r6E5C 16r91DF 16r6E5D 16r91E1 16r6E5E 16r91DB 16r6E5F 16r91FC 16r6E60 16r91F5 16r6E61 16r91F6 16r6E62 16r921E 16r6E63 16r91FF 16r6E64 16r9214 16r6E65 16r922C 16r6E66 16r9215 16r6E67 16r9211 16r6E68 16r925E 16r6E69 16r9257 16r6E6A 16r9245 16r6E6B 16r9249 16r6E6C 16r9264 16r6E6D 16r9248 16r6E6E 16r9295 16r6E6F 16r923F 16r6E70 16r924B 16r6E71 16r9250 16r6E72 16r929C 16r6E73 16r9296 16r6E74 16r9293 16r6E75 16r929B 16r6E76 16r925A 16r6E77 16r92CF 16r6E78 16r92B9 16r6E79 16r92B7 16r6E7A 16r92E9 16r6E7B 16r930F 16r6E7C 16r92FA 16r6E7D 16r9344 16r6E7E 16r932E 16r6F21 16r9319 16r6F22 16r9322 16r6F23 16r931A 16r6F24 16r9323 16r6F25 16r933A 16r6F26 16r9335 16r6F27 16r933B 16r6F28 16r935C 16r6F29 16r9360 16r6F2A 16r937C 16r6F2B 16r936E 16r6F2C 16r9356 16r6F2D 16r93B0 16r6F2E 16r93AC 16r6F2F 16r93AD 16r6F30 16r9394 16r6F31 16r93B9 16r6F32 16r93D6 16r6F33 16r93D7 16r6F34 16r93E8 16r6F35 16r93E5 16r6F36 16r93D8 16r6F37 16r93C3 16r6F38 16r93DD 16r6F39 16r93D0 16r6F3A 16r93C8 16r6F3B 16r93E4 16r6F3C 16r941A 16r6F3D 16r9414 16r6F3E 16r9413 16r6F3F 16r9403 16r6F40 16r9407 16r6F41 16r9410 16r6F42 16r9436 16r6F43 16r942B 16r6F44 16r9435 16r6F45 16r9421 16r6F46 16r943A 16r6F47 16r9441 16r6F48 16r9452 16r6F49 16r9444 16r6F4A 16r945B 16r6F4B 16r9460 16r6F4C 16r9462 16r6F4D 16r945E 16r6F4E 16r946A 16r6F4F 16r9229 16r6F50 16r9470 16r6F51 16r9475 16r6F52 16r9477 16r6F53 16r947D 16r6F54 16r945A 16r6F55 16r947C 16r6F56 16r947E 16r6F57 16r9481 16r6F58 16r947F 16r6F59 16r9582 16r6F5A 16r9587 16r6F5B 16r958A 16r6F5C 16r9594 16r6F5D 16r9596 16r6F5E 16r9598 16r6F5F 16r9599 16r6F60 16r95A0 16r6F61 16r95A8 16r6F62 16r95A7 16r6F63 16r95AD 16r6F64 16r95BC 16r6F65 16r95BB 16r6F66 16r95B9 16r6F67 16r95BE 16r6F68 16r95CA 16r6F69 16r6FF6 16r6F6A 16r95C3 16r6F6B 16r95CD 16r6F6C 16r95CC 16r6F6D 16r95D5 16r6F6E 16r95D4 16r6F6F 16r95D6 16r6F70 16r95DC 16r6F71 16r95E1 16r6F72 16r95E5 16r6F73 16r95E2 16r6F74 16r9621 16r6F75 16r9628 16r6F76 16r962E 16r6F77 16r962F 16r6F78 16r9642 16r6F79 16r964C 16r6F7A 16r964F 16r6F7B 16r964B 16r6F7C 16r9677 16r6F7D 16r965C 16r6F7E 16r965E 16r7021 16r965D 16r7022 16r965F 16r7023 16r9666 16r7024 16r9672 16r7025 16r966C 16r7026 16r968D 16r7027 16r9698 16r7028 16r9695 16r7029 16r9697 16r702A 16r96AA 16r702B 16r96A7 16r702C 16r96B1 16r702D 16r96B2 16r702E 16r96B0 16r702F 16r96B4 16r7030 16r96B6 16r7031 16r96B8 16r7032 16r96B9 16r7033 16r96CE 16r7034 16r96CB 16r7035 16r96C9 16r7036 16r96CD 16r7037 16r894D 16r7038 16r96DC 16r7039 16r970D 16r703A 16r96D5 16r703B 16r96F9 16r703C 16r9704 16r703D 16r9706 16r703E 16r9708 16r703F 16r9713 16r7040 16r970E 16r7041 16r9711 16r7042 16r970F 16r7043 16r9716 16r7044 16r9719 16r7045 16r9724 16r7046 16r972A 16r7047 16r9730 16r7048 16r9739 16r7049 16r973D 16r704A 16r973E 16r704B 16r9744 16r704C 16r9746 16r704D 16r9748 16r704E 16r9742 16r704F 16r9749 16r7050 16r975C 16r7051 16r9760 16r7052 16r9764 16r7053 16r9766 16r7054 16r9768 16r7055 16r52D2 16r7056 16r976B 16r7057 16r9771 16r7058 16r9779 16r7059 16r9785 16r705A 16r977C 16r705B 16r9781 16r705C 16r977A 16r705D 16r9786 16r705E 16r978B 16r705F 16r978F 16r7060 16r9790 16r7061 16r979C 16r7062 16r97A8 16r7063 16r97A6 16r7064 16r97A3 16r7065 16r97B3 16r7066 16r97B4 16r7067 16r97C3 16r7068 16r97C6 16r7069 16r97C8 16r706A 16r97CB 16r706B 16r97DC 16r706C 16r97ED 16r706D 16r9F4F 16r706E 16r97F2 16r706F 16r7ADF 16r7070 16r97F6 16r7071 16r97F5 16r7072 16r980F 16r7073 16r980C 16r7074 16r9838 16r7075 16r9824 16r7076 16r9821 16r7077 16r9837 16r7078 16r983D 16r7079 16r9846 16r707A 16r984F 16r707B 16r984B 16r707C 16r986B 16r707D 16r986F 16r707E 16r9870 16r7121 16r9871 16r7122 16r9874 16r7123 16r9873 16r7124 16r98AA 16r7125 16r98AF 16r7126 16r98B1 16r7127 16r98B6 16r7128 16r98C4 16r7129 16r98C3 16r712A 16r98C6 16r712B 16r98E9 16r712C 16r98EB 16r712D 16r9903 16r712E 16r9909 16r712F 16r9912 16r7130 16r9914 16r7131 16r9918 16r7132 16r9921 16r7133 16r991D 16r7134 16r991E 16r7135 16r9924 16r7136 16r9920 16r7137 16r992C 16r7138 16r992E 16r7139 16r993D 16r713A 16r993E 16r713B 16r9942 16r713C 16r9949 16r713D 16r9945 16r713E 16r9950 16r713F 16r994B 16r7140 16r9951 16r7141 16r9952 16r7142 16r994C 16r7143 16r9955 16r7144 16r9997 16r7145 16r9998 16r7146 16r99A5 16r7147 16r99AD 16r7148 16r99AE 16r7149 16r99BC 16r714A 16r99DF 16r714B 16r99DB 16r714C 16r99DD 16r714D 16r99D8 16r714E 16r99D1 16r714F 16r99ED 16r7150 16r99EE 16r7151 16r99F1 16r7152 16r99F2 16r7153 16r99FB 16r7154 16r99F8 16r7155 16r9A01 16r7156 16r9A0F 16r7157 16r9A05 16r7158 16r99E2 16r7159 16r9A19 16r715A 16r9A2B 16r715B 16r9A37 16r715C 16r9A45 16r715D 16r9A42 16r715E 16r9A40 16r715F 16r9A43 16r7160 16r9A3E 16r7161 16r9A55 16r7162 16r9A4D 16r7163 16r9A5B 16r7164 16r9A57 16r7165 16r9A5F 16r7166 16r9A62 16r7167 16r9A65 16r7168 16r9A64 16r7169 16r9A69 16r716A 16r9A6B 16r716B 16r9A6A 16r716C 16r9AAD 16r716D 16r9AB0 16r716E 16r9ABC 16r716F 16r9AC0 16r7170 16r9ACF 16r7171 16r9AD1 16r7172 16r9AD3 16r7173 16r9AD4 16r7174 16r9ADE 16r7175 16r9ADF 16r7176 16r9AE2 16r7177 16r9AE3 16r7178 16r9AE6 16r7179 16r9AEF 16r717A 16r9AEB 16r717B 16r9AEE 16r717C 16r9AF4 16r717D 16r9AF1 16r717E 16r9AF7 16r7221 16r9AFB 16r7222 16r9B06 16r7223 16r9B18 16r7224 16r9B1A 16r7225 16r9B1F 16r7226 16r9B22 16r7227 16r9B23 16r7228 16r9B25 16r7229 16r9B27 16r722A 16r9B28 16r722B 16r9B29 16r722C 16r9B2A 16r722D 16r9B2E 16r722E 16r9B2F 16r722F 16r9B32 16r7230 16r9B44 16r7231 16r9B43 16r7232 16r9B4F 16r7233 16r9B4D 16r7234 16r9B4E 16r7235 16r9B51 16r7236 16r9B58 16r7237 16r9B74 16r7238 16r9B93 16r7239 16r9B83 16r723A 16r9B91 16r723B 16r9B96 16r723C 16r9B97 16r723D 16r9B9F 16r723E 16r9BA0 16r723F 16r9BA8 16r7240 16r9BB4 16r7241 16r9BC0 16r7242 16r9BCA 16r7243 16r9BB9 16r7244 16r9BC6 16r7245 16r9BCF 16r7246 16r9BD1 16r7247 16r9BD2 16r7248 16r9BE3 16r7249 16r9BE2 16r724A 16r9BE4 16r724B 16r9BD4 16r724C 16r9BE1 16r724D 16r9C3A 16r724E 16r9BF2 16r724F 16r9BF1 16r7250 16r9BF0 16r7251 16r9C15 16r7252 16r9C14 16r7253 16r9C09 16r7254 16r9C13 16r7255 16r9C0C 16r7256 16r9C06 16r7257 16r9C08 16r7258 16r9C12 16r7259 16r9C0A 16r725A 16r9C04 16r725B 16r9C2E 16r725C 16r9C1B 16r725D 16r9C25 16r725E 16r9C24 16r725F 16r9C21 16r7260 16r9C30 16r7261 16r9C47 16r7262 16r9C32 16r7263 16r9C46 16r7264 16r9C3E 16r7265 16r9C5A 16r7266 16r9C60 16r7267 16r9C67 16r7268 16r9C76 16r7269 16r9C78 16r726A 16r9CE7 16r726B 16r9CEC 16r726C 16r9CF0 16r726D 16r9D09 16r726E 16r9D08 16r726F 16r9CEB 16r7270 16r9D03 16r7271 16r9D06 16r7272 16r9D2A 16r7273 16r9D26 16r7274 16r9DAF 16r7275 16r9D23 16r7276 16r9D1F 16r7277 16r9D44 16r7278 16r9D15 16r7279 16r9D12 16r727A 16r9D41 16r727B 16r9D3F 16r727C 16r9D3E 16r727D 16r9D46 16r727E 16r9D48 16r7321 16r9D5D 16r7322 16r9D5E 16r7323 16r9D64 16r7324 16r9D51 16r7325 16r9D50 16r7326 16r9D59 16r7327 16r9D72 16r7328 16r9D89 16r7329 16r9D87 16r732A 16r9DAB 16r732B 16r9D6F 16r732C 16r9D7A 16r732D 16r9D9A 16r732E 16r9DA4 16r732F 16r9DA9 16r7330 16r9DB2 16r7331 16r9DC4 16r7332 16r9DC1 16r7333 16r9DBB 16r7334 16r9DB8 16r7335 16r9DBA 16r7336 16r9DC6 16r7337 16r9DCF 16r7338 16r9DC2 16r7339 16r9DD9 16r733A 16r9DD3 16r733B 16r9DF8 16r733C 16r9DE6 16r733D 16r9DED 16r733E 16r9DEF 16r733F 16r9DFD 16r7340 16r9E1A 16r7341 16r9E1B 16r7342 16r9E1E 16r7343 16r9E75 16r7344 16r9E79 16r7345 16r9E7D 16r7346 16r9E81 16r7347 16r9E88 16r7348 16r9E8B 16r7349 16r9E8C 16r734A 16r9E92 16r734B 16r9E95 16r734C 16r9E91 16r734D 16r9E9D 16r734E 16r9EA5 16r734F 16r9EA9 16r7350 16r9EB8 16r7351 16r9EAA 16r7352 16r9EAD 16r7353 16r9761 16r7354 16r9ECC 16r7355 16r9ECE 16r7356 16r9ECF 16r7357 16r9ED0 16r7358 16r9ED4 16r7359 16r9EDC 16r735A 16r9EDE 16r735B 16r9EDD 16r735C 16r9EE0 16r735D 16r9EE5 16r735E 16r9EE8 16r735F 16r9EEF 16r7360 16r9EF4 16r7361 16r9EF6 16r7362 16r9EF7 16r7363 16r9EF9 16r7364 16r9EFB 16r7365 16r9EFC 16r7366 16r9EFD 16r7367 16r9F07 16r7368 16r9F08 16r7369 16r76B7 16r736A 16r9F15 16r736B 16r9F21 16r736C 16r9F2C 16r736D 16r9F3E 16r736E 16r9F4A 16r736F 16r9F52 16r7370 16r9F54 16r7371 16r9F63 16r7372 16r9F5F 16r7373 16r9F60 16r7374 16r9F61 16r7375 16r9F66 16r7376 16r9F67 16r7377 16r9F6C 16r7378 16r9F6A 16r7379 16r9F77 16r737A 16r9F72 16r737B 16r9F76 16r737C 16r9F95 16r737D 16r9F9C 16r737E 16r9FA0 16r7421 16r582F 16r7422 16r69C7 16r7423 16r9059 16r7424 16r7464 16r7425 16r51DC 16r7426 16r7199).
	table size even ifFalse: [^ self error: 'given table size must be even'].
	size := table size / 2.
	jisX0208 := Array new: size.
	unicode := Array new: size.
	1 to: table size by: 2 do: [:index |
		| tableIndex |
		tableIndex := index + 1 / 2.
		jisX0208 at: tableIndex put: (table at: index).
		unicode at: tableIndex put: (table at: index + 1)].
	jisX02082 := Array new: 94*94 withAll: -1.
	jisX0208 withIndexDo: [:elem :index | | uIndex u code |
		code := (elem // 256 - 33) * 94 + (elem \\ 256 - 33) + 1.
		(jisX02082 at: code) ~= -1 ifTrue: [self error].
		uIndex := jisX0208 indexOf: elem.
		uIndex = 0 ifFalse: [
			u := unicode at: uIndex.
			jisX02082 at: code put: u.
		].
	].
	JISX0208Table := jisX02082.
! !

!UCSTable class methodsFor: 'accessing - table' stamp: 'yo 10/14/2003 10:36'!
latin1Table

	^ Latin1Table.
! !

!UCSTable class methodsFor: 'accessing - table' stamp: 'yo 10/14/2003 09:38'!
jisx0208Table

	^ JISX0208Table.
! !

!UCSTable class methodsFor: '*Unicode-Initialization' stamp: 'MarcusDenker 9/12/2013 16:39'!
initializeGB2312Table
	"UCSTable initializeGB2312Table"

	| table size gb2312 unicode gb23122 |
	table := #(16r2121 16r3000 16r2122 16r3001 16r2123 16r3002 16r2124 16r30FB 16r2125 16r02C9 16r2126 16r02C7 16r2127 16r00A8 16r2128 16r3003 16r2129 16r3005 16r212A 16r2015 16r212B 16rFF5E 16r212C 16r2016 16r212D 16r2026 16r212E 16r2018 16r212F 16r2019 16r2130 16r201C 16r2131 16r201D 16r2132 16r3014 16r2133 16r3015 16r2134 16r3008 16r2135 16r3009 16r2136 16r300A 16r2137 16r300B 16r2138 16r300C 16r2139 16r300D 16r213A 16r300E 16r213B 16r300F 16r213C 16r3016 16r213D 16r3017 16r213E 16r3010 16r213F 16r3011 16r2140 16r00B1 16r2141 16r00D7 16r2142 16r00F7 16r2143 16r2236 16r2144 16r2227 16r2145 16r2228 16r2146 16r2211 16r2147 16r220F 16r2148 16r222A 16r2149 16r2229 16r214A 16r2208 16r214B 16r2237 16r214C 16r221A 16r214D 16r22A5 16r214E 16r2225 16r214F 16r2220 16r2150 16r2312 16r2151 16r2299 16r2152 16r222B 16r2153 16r222E 16r2154 16r2261 16r2155 16r224C 16r2156 16r2248 16r2157 16r223D 16r2158 16r221D 16r2159 16r2260 16r215A 16r226E 16r215B 16r226F 16r215C 16r2264 16r215D 16r2265 16r215E 16r221E 16r215F 16r2235 16r2160 16r2234 16r2161 16r2642 16r2162 16r2640 16r2163 16r00B0 16r2164 16r2032 16r2165 16r2033 16r2166 16r2103 16r2167 16rFF04 16r2168 16r00A4 16r2169 16rFFE0 16r216A 16rFFE1 16r216B 16r2030 16r216C 16r00A7 16r216D 16r2116 16r216E 16r2606 16r216F 16r2605 16r2170 16r25CB 16r2171 16r25CF 16r2172 16r25CE 16r2173 16r25C7 16r2174 16r25C6 16r2175 16r25A1 16r2176 16r25A0 16r2177 16r25B3 16r2178 16r25B2 16r2179 16r203B 16r217A 16r2192 16r217B 16r2190 16r217C 16r2191 16r217D 16r2193 16r217E 16r3013 16r2231 16r2488 16r2232 16r2489 16r2233 16r248A 16r2234 16r248B 16r2235 16r248C 16r2236 16r248D 16r2237 16r248E 16r2238 16r248F 16r2239 16r2490 16r223A 16r2491 16r223B 16r2492 16r223C 16r2493 16r223D 16r2494 16r223E 16r2495 16r223F 16r2496 16r2240 16r2497 16r2241 16r2498 16r2242 16r2499 16r2243 16r249A 16r2244 16r249B 16r2245 16r2474 16r2246 16r2475 16r2247 16r2476 16r2248 16r2477 16r2249 16r2478 16r224A 16r2479 16r224B 16r247A 16r224C 16r247B 16r224D 16r247C 16r224E 16r247D 16r224F 16r247E 16r2250 16r247F 16r2251 16r2480 16r2252 16r2481 16r2253 16r2482 16r2254 16r2483 16r2255 16r2484 16r2256 16r2485 16r2257 16r2486 16r2258 16r2487 16r2259 16r2460 16r225A 16r2461 16r225B 16r2462 16r225C 16r2463 16r225D 16r2464 16r225E 16r2465 16r225F 16r2466 16r2260 16r2467 16r2261 16r2468 16r2262 16r2469 16r2265 16r3220 16r2266 16r3221 16r2267 16r3222 16r2268 16r3223 16r2269 16r3224 16r226A 16r3225 16r226B 16r3226 16r226C 16r3227 16r226D 16r3228 16r226E 16r3229 16r2271 16r2160 16r2272 16r2161 16r2273 16r2162 16r2274 16r2163 16r2275 16r2164 16r2276 16r2165 16r2277 16r2166 16r2278 16r2167 16r2279 16r2168 16r227A 16r2169 16r227B 16r216A 16r227C 16r216B 16r2321 16rFF01 16r2322 16rFF02 16r2323 16rFF03 16r2324 16rFFE5 16r2325 16rFF05 16r2326 16rFF06 16r2327 16rFF07 16r2328 16rFF08 16r2329 16rFF09 16r232A 16rFF0A 16r232B 16rFF0B 16r232C 16rFF0C 16r232D 16rFF0D 16r232E 16rFF0E 16r232F 16rFF0F 16r2330 16rFF10 16r2331 16rFF11 16r2332 16rFF12 16r2333 16rFF13 16r2334 16rFF14 16r2335 16rFF15 16r2336 16rFF16 16r2337 16rFF17 16r2338 16rFF18 16r2339 16rFF19 16r233A 16rFF1A 16r233B 16rFF1B 16r233C 16rFF1C 16r233D 16rFF1D 16r233E 16rFF1E 16r233F 16rFF1F 16r2340 16rFF20 16r2341 16rFF21 16r2342 16rFF22 16r2343 16rFF23 16r2344 16rFF24 16r2345 16rFF25 16r2346 16rFF26 16r2347 16rFF27 16r2348 16rFF28 16r2349 16rFF29 16r234A 16rFF2A 16r234B 16rFF2B 16r234C 16rFF2C 16r234D 16rFF2D 16r234E 16rFF2E 16r234F 16rFF2F 16r2350 16rFF30 16r2351 16rFF31 16r2352 16rFF32 16r2353 16rFF33 16r2354 16rFF34 16r2355 16rFF35 16r2356 16rFF36 16r2357 16rFF37 16r2358 16rFF38 16r2359 16rFF39 16r235A 16rFF3A 16r235B 16rFF3B 16r235C 16rFF3C 16r235D 16rFF3D 16r235E 16rFF3E 16r235F 16rFF3F 16r2360 16rFF40 16r2361 16rFF41 16r2362 16rFF42 16r2363 16rFF43 16r2364 16rFF44 16r2365 16rFF45 16r2366 16rFF46 16r2367 16rFF47 16r2368 16rFF48 16r2369 16rFF49 16r236A 16rFF4A 16r236B 16rFF4B 16r236C 16rFF4C 16r236D 16rFF4D 16r236E 16rFF4E 16r236F 16rFF4F 16r2370 16rFF50 16r2371 16rFF51 16r2372 16rFF52 16r2373 16rFF53 16r2374 16rFF54 16r2375 16rFF55 16r2376 16rFF56 16r2377 16rFF57 16r2378 16rFF58 16r2379 16rFF59 16r237A 16rFF5A 16r237B 16rFF5B 16r237C 16rFF5C 16r237D 16rFF5D 16r237E 16rFFE3 16r2421 16r3041 16r2422 16r3042 16r2423 16r3043 16r2424 16r3044 16r2425 16r3045 16r2426 16r3046 16r2427 16r3047 16r2428 16r3048 16r2429 16r3049 16r242A 16r304A 16r242B 16r304B 16r242C 16r304C 16r242D 16r304D 16r242E 16r304E 16r242F 16r304F 16r2430 16r3050 16r2431 16r3051 16r2432 16r3052 16r2433 16r3053 16r2434 16r3054 16r2435 16r3055 16r2436 16r3056 16r2437 16r3057 16r2438 16r3058 16r2439 16r3059 16r243A 16r305A 16r243B 16r305B 16r243C 16r305C 16r243D 16r305D 16r243E 16r305E 16r243F 16r305F 16r2440 16r3060 16r2441 16r3061 16r2442 16r3062 16r2443 16r3063 16r2444 16r3064 16r2445 16r3065 16r2446 16r3066 16r2447 16r3067 16r2448 16r3068 16r2449 16r3069 16r244A 16r306A 16r244B 16r306B 16r244C 16r306C 16r244D 16r306D 16r244E 16r306E 16r244F 16r306F 16r2450 16r3070 16r2451 16r3071 16r2452 16r3072 16r2453 16r3073 16r2454 16r3074 16r2455 16r3075 16r2456 16r3076 16r2457 16r3077 16r2458 16r3078 16r2459 16r3079 16r245A 16r307A 16r245B 16r307B 16r245C 16r307C 16r245D 16r307D 16r245E 16r307E 16r245F 16r307F 16r2460 16r3080 16r2461 16r3081 16r2462 16r3082 16r2463 16r3083 16r2464 16r3084 16r2465 16r3085 16r2466 16r3086 16r2467 16r3087 16r2468 16r3088 16r2469 16r3089 16r246A 16r308A 16r246B 16r308B 16r246C 16r308C 16r246D 16r308D 16r246E 16r308E 16r246F 16r308F 16r2470 16r3090 16r2471 16r3091 16r2472 16r3092 16r2473 16r3093 16r2521 16r30A1 16r2522 16r30A2 16r2523 16r30A3 16r2524 16r30A4 16r2525 16r30A5 16r2526 16r30A6 16r2527 16r30A7 16r2528 16r30A8 16r2529 16r30A9 16r252A 16r30AA 16r252B 16r30AB 16r252C 16r30AC 16r252D 16r30AD 16r252E 16r30AE 16r252F 16r30AF 16r2530 16r30B0 16r2531 16r30B1 16r2532 16r30B2 16r2533 16r30B3 16r2534 16r30B4 16r2535 16r30B5 16r2536 16r30B6 16r2537 16r30B7 16r2538 16r30B8 16r2539 16r30B9 16r253A 16r30BA 16r253B 16r30BB 16r253C 16r30BC 16r253D 16r30BD 16r253E 16r30BE 16r253F 16r30BF 16r2540 16r30C0 16r2541 16r30C1 16r2542 16r30C2 16r2543 16r30C3 16r2544 16r30C4 16r2545 16r30C5 16r2546 16r30C6 16r2547 16r30C7 16r2548 16r30C8 16r2549 16r30C9 16r254A 16r30CA 16r254B 16r30CB 16r254C 16r30CC 16r254D 16r30CD 16r254E 16r30CE 16r254F 16r30CF 16r2550 16r30D0 16r2551 16r30D1 16r2552 16r30D2 16r2553 16r30D3 16r2554 16r30D4 16r2555 16r30D5 16r2556 16r30D6 16r2557 16r30D7 16r2558 16r30D8 16r2559 16r30D9 16r255A 16r30DA 16r255B 16r30DB 16r255C 16r30DC 16r255D 16r30DD 16r255E 16r30DE 16r255F 16r30DF 16r2560 16r30E0 16r2561 16r30E1 16r2562 16r30E2 16r2563 16r30E3 16r2564 16r30E4 16r2565 16r30E5 16r2566 16r30E6 16r2567 16r30E7 16r2568 16r30E8 16r2569 16r30E9 16r256A 16r30EA 16r256B 16r30EB 16r256C 16r30EC 16r256D 16r30ED 16r256E 16r30EE 16r256F 16r30EF 16r2570 16r30F0 16r2571 16r30F1 16r2572 16r30F2 16r2573 16r30F3 16r2574 16r30F4 16r2575 16r30F5 16r2576 16r30F6 16r2621 16r0391 16r2622 16r0392 16r2623 16r0393 16r2624 16r0394 16r2625 16r0395 16r2626 16r0396 16r2627 16r0397 16r2628 16r0398 16r2629 16r0399 16r262A 16r039A 16r262B 16r039B 16r262C 16r039C 16r262D 16r039D 16r262E 16r039E 16r262F 16r039F 16r2630 16r03A0 16r2631 16r03A1 16r2632 16r03A3 16r2633 16r03A4 16r2634 16r03A5 16r2635 16r03A6 16r2636 16r03A7 16r2637 16r03A8 16r2638 16r03A9 16r2641 16r03B1 16r2642 16r03B2 16r2643 16r03B3 16r2644 16r03B4 16r2645 16r03B5 16r2646 16r03B6 16r2647 16r03B7 16r2648 16r03B8 16r2649 16r03B9 16r264A 16r03BA 16r264B 16r03BB 16r264C 16r03BC 16r264D 16r03BD 16r264E 16r03BE 16r264F 16r03BF 16r2650 16r03C0 16r2651 16r03C1 16r2652 16r03C3 16r2653 16r03C4 16r2654 16r03C5 16r2655 16r03C6 16r2656 16r03C7 16r2657 16r03C8 16r2658 16r03C9 16r2721 16r0410 16r2722 16r0411 16r2723 16r0412 16r2724 16r0413 16r2725 16r0414 16r2726 16r0415 16r2727 16r0401 16r2728 16r0416 16r2729 16r0417 16r272A 16r0418 16r272B 16r0419 16r272C 16r041A 16r272D 16r041B 16r272E 16r041C 16r272F 16r041D 16r2730 16r041E 16r2731 16r041F 16r2732 16r0420 16r2733 16r0421 16r2734 16r0422 16r2735 16r0423 16r2736 16r0424 16r2737 16r0425 16r2738 16r0426 16r2739 16r0427 16r273A 16r0428 16r273B 16r0429 16r273C 16r042A 16r273D 16r042B 16r273E 16r042C 16r273F 16r042D 16r2740 16r042E 16r2741 16r042F 16r2751 16r0430 16r2752 16r0431 16r2753 16r0432 16r2754 16r0433 16r2755 16r0434 16r2756 16r0435 16r2757 16r0451 16r2758 16r0436 16r2759 16r0437 16r275A 16r0438 16r275B 16r0439 16r275C 16r043A 16r275D 16r043B 16r275E 16r043C 16r275F 16r043D 16r2760 16r043E 16r2761 16r043F 16r2762 16r0440 16r2763 16r0441 16r2764 16r0442 16r2765 16r0443 16r2766 16r0444 16r2767 16r0445 16r2768 16r0446 16r2769 16r0447 16r276A 16r0448 16r276B 16r0449 16r276C 16r044A 16r276D 16r044B 16r276E 16r044C 16r276F 16r044D 16r2770 16r044E 16r2771 16r044F 16r2821 16r0101 16r2822 16r00E1 16r2823 16r01CE 16r2824 16r00E0 16r2825 16r0113 16r2826 16r00E9 16r2827 16r011B 16r2828 16r00E8 16r2829 16r012B 16r282A 16r00ED 16r282B 16r01D0 16r282C 16r00EC 16r282D 16r014D 16r282E 16r00F3 16r282F 16r01D2 16r2830 16r00F2 16r2831 16r016B 16r2832 16r00FA 16r2833 16r01D4 16r2834 16r00F9 16r2835 16r01D6 16r2836 16r01D8 16r2837 16r01DA 16r2838 16r01DC 16r2839 16r00FC 16r283A 16r00EA 16r2845 16r3105 16r2846 16r3106 16r2847 16r3107 16r2848 16r3108 16r2849 16r3109 16r284A 16r310A 16r284B 16r310B 16r284C 16r310C 16r284D 16r310D 16r284E 16r310E 16r284F 16r310F 16r2850 16r3110 16r2851 16r3111 16r2852 16r3112 16r2853 16r3113 16r2854 16r3114 16r2855 16r3115 16r2856 16r3116 16r2857 16r3117 16r2858 16r3118 16r2859 16r3119 16r285A 16r311A 16r285B 16r311B 16r285C 16r311C 16r285D 16r311D 16r285E 16r311E 16r285F 16r311F 16r2860 16r3120 16r2861 16r3121 16r2862 16r3122 16r2863 16r3123 16r2864 16r3124 16r2865 16r3125 16r2866 16r3126 16r2867 16r3127 16r2868 16r3128 16r2869 16r3129 16r2924 16r2500 16r2925 16r2501 16r2926 16r2502 16r2927 16r2503 16r2928 16r2504 16r2929 16r2505 16r292A 16r2506 16r292B 16r2507 16r292C 16r2508 16r292D 16r2509 16r292E 16r250A 16r292F 16r250B 16r2930 16r250C 16r2931 16r250D 16r2932 16r250E 16r2933 16r250F 16r2934 16r2510 16r2935 16r2511 16r2936 16r2512 16r2937 16r2513 16r2938 16r2514 16r2939 16r2515 16r293A 16r2516 16r293B 16r2517 16r293C 16r2518 16r293D 16r2519 16r293E 16r251A 16r293F 16r251B 16r2940 16r251C 16r2941 16r251D 16r2942 16r251E 16r2943 16r251F 16r2944 16r2520 16r2945 16r2521 16r2946 16r2522 16r2947 16r2523 16r2948 16r2524 16r2949 16r2525 16r294A 16r2526 16r294B 16r2527 16r294C 16r2528 16r294D 16r2529 16r294E 16r252A 16r294F 16r252B 16r2950 16r252C 16r2951 16r252D 16r2952 16r252E 16r2953 16r252F 16r2954 16r2530 16r2955 16r2531 16r2956 16r2532 16r2957 16r2533 16r2958 16r2534 16r2959 16r2535 16r295A 16r2536 16r295B 16r2537 16r295C 16r2538 16r295D 16r2539 16r295E 16r253A 16r295F 16r253B 16r2960 16r253C 16r2961 16r253D 16r2962 16r253E 16r2963 16r253F 16r2964 16r2540 16r2965 16r2541 16r2966 16r2542 16r2967 16r2543 16r2968 16r2544 16r2969 16r2545 16r296A 16r2546 16r296B 16r2547 16r296C 16r2548 16r296D 16r2549 16r296E 16r254A 16r296F 16r254B 16r3021 16r554A 16r3022 16r963F 16r3023 16r57C3 16r3024 16r6328 16r3025 16r54CE 16r3026 16r5509 16r3027 16r54C0 16r3028 16r7691 16r3029 16r764C 16r302A 16r853C 16r302B 16r77EE 16r302C 16r827E 16r302D 16r788D 16r302E 16r7231 16r302F 16r9698 16r3030 16r978D 16r3031 16r6C28 16r3032 16r5B89 16r3033 16r4FFA 16r3034 16r6309 16r3035 16r6697 16r3036 16r5CB8 16r3037 16r80FA 16r3038 16r6848 16r3039 16r80AE 16r303A 16r6602 16r303B 16r76CE 16r303C 16r51F9 16r303D 16r6556 16r303E 16r71AC 16r303F 16r7FF1 16r3040 16r8884 16r3041 16r50B2 16r3042 16r5965 16r3043 16r61CA 16r3044 16r6FB3 16r3045 16r82AD 16r3046 16r634C 16r3047 16r6252 16r3048 16r53ED 16r3049 16r5427 16r304A 16r7B06 16r304B 16r516B 16r304C 16r75A4 16r304D 16r5DF4 16r304E 16r62D4 16r304F 16r8DCB 16r3050 16r9776 16r3051 16r628A 16r3052 16r8019 16r3053 16r575D 16r3054 16r9738 16r3055 16r7F62 16r3056 16r7238 16r3057 16r767D 16r3058 16r67CF 16r3059 16r767E 16r305A 16r6446 16r305B 16r4F70 16r305C 16r8D25 16r305D 16r62DC 16r305E 16r7A17 16r305F 16r6591 16r3060 16r73ED 16r3061 16r642C 16r3062 16r6273 16r3063 16r822C 16r3064 16r9881 16r3065 16r677F 16r3066 16r7248 16r3067 16r626E 16r3068 16r62CC 16r3069 16r4F34 16r306A 16r74E3 16r306B 16r534A 16r306C 16r529E 16r306D 16r7ECA 16r306E 16r90A6 16r306F 16r5E2E 16r3070 16r6886 16r3071 16r699C 16r3072 16r8180 16r3073 16r7ED1 16r3074 16r68D2 16r3075 16r78C5 16r3076 16r868C 16r3077 16r9551 16r3078 16r508D 16r3079 16r8C24 16r307A 16r82DE 16r307B 16r80DE 16r307C 16r5305 16r307D 16r8912 16r307E 16r5265 16r3121 16r8584 16r3122 16r96F9 16r3123 16r4FDD 16r3124 16r5821 16r3125 16r9971 16r3126 16r5B9D 16r3127 16r62B1 16r3128 16r62A5 16r3129 16r66B4 16r312A 16r8C79 16r312B 16r9C8D 16r312C 16r7206 16r312D 16r676F 16r312E 16r7891 16r312F 16r60B2 16r3130 16r5351 16r3131 16r5317 16r3132 16r8F88 16r3133 16r80CC 16r3134 16r8D1D 16r3135 16r94A1 16r3136 16r500D 16r3137 16r72C8 16r3138 16r5907 16r3139 16r60EB 16r313A 16r7119 16r313B 16r88AB 16r313C 16r5954 16r313D 16r82EF 16r313E 16r672C 16r313F 16r7B28 16r3140 16r5D29 16r3141 16r7EF7 16r3142 16r752D 16r3143 16r6CF5 16r3144 16r8E66 16r3145 16r8FF8 16r3146 16r903C 16r3147 16r9F3B 16r3148 16r6BD4 16r3149 16r9119 16r314A 16r7B14 16r314B 16r5F7C 16r314C 16r78A7 16r314D 16r84D6 16r314E 16r853D 16r314F 16r6BD5 16r3150 16r6BD9 16r3151 16r6BD6 16r3152 16r5E01 16r3153 16r5E87 16r3154 16r75F9 16r3155 16r95ED 16r3156 16r655D 16r3157 16r5F0A 16r3158 16r5FC5 16r3159 16r8F9F 16r315A 16r58C1 16r315B 16r81C2 16r315C 16r907F 16r315D 16r965B 16r315E 16r97AD 16r315F 16r8FB9 16r3160 16r7F16 16r3161 16r8D2C 16r3162 16r6241 16r3163 16r4FBF 16r3164 16r53D8 16r3165 16r535E 16r3166 16r8FA8 16r3167 16r8FA9 16r3168 16r8FAB 16r3169 16r904D 16r316A 16r6807 16r316B 16r5F6A 16r316C 16r8198 16r316D 16r8868 16r316E 16r9CD6 16r316F 16r618B 16r3170 16r522B 16r3171 16r762A 16r3172 16r5F6C 16r3173 16r658C 16r3174 16r6FD2 16r3175 16r6EE8 16r3176 16r5BBE 16r3177 16r6448 16r3178 16r5175 16r3179 16r51B0 16r317A 16r67C4 16r317B 16r4E19 16r317C 16r79C9 16r317D 16r997C 16r317E 16r70B3 16r3221 16r75C5 16r3222 16r5E76 16r3223 16r73BB 16r3224 16r83E0 16r3225 16r64AD 16r3226 16r62E8 16r3227 16r94B5 16r3228 16r6CE2 16r3229 16r535A 16r322A 16r52C3 16r322B 16r640F 16r322C 16r94C2 16r322D 16r7B94 16r322E 16r4F2F 16r322F 16r5E1B 16r3230 16r8236 16r3231 16r8116 16r3232 16r818A 16r3233 16r6E24 16r3234 16r6CCA 16r3235 16r9A73 16r3236 16r6355 16r3237 16r535C 16r3238 16r54FA 16r3239 16r8865 16r323A 16r57E0 16r323B 16r4E0D 16r323C 16r5E03 16r323D 16r6B65 16r323E 16r7C3F 16r323F 16r90E8 16r3240 16r6016 16r3241 16r64E6 16r3242 16r731C 16r3243 16r88C1 16r3244 16r6750 16r3245 16r624D 16r3246 16r8D22 16r3247 16r776C 16r3248 16r8E29 16r3249 16r91C7 16r324A 16r5F69 16r324B 16r83DC 16r324C 16r8521 16r324D 16r9910 16r324E 16r53C2 16r324F 16r8695 16r3250 16r6B8B 16r3251 16r60ED 16r3252 16r60E8 16r3253 16r707F 16r3254 16r82CD 16r3255 16r8231 16r3256 16r4ED3 16r3257 16r6CA7 16r3258 16r85CF 16r3259 16r64CD 16r325A 16r7CD9 16r325B 16r69FD 16r325C 16r66F9 16r325D 16r8349 16r325E 16r5395 16r325F 16r7B56 16r3260 16r4FA7 16r3261 16r518C 16r3262 16r6D4B 16r3263 16r5C42 16r3264 16r8E6D 16r3265 16r63D2 16r3266 16r53C9 16r3267 16r832C 16r3268 16r8336 16r3269 16r67E5 16r326A 16r78B4 16r326B 16r643D 16r326C 16r5BDF 16r326D 16r5C94 16r326E 16r5DEE 16r326F 16r8BE7 16r3270 16r62C6 16r3271 16r67F4 16r3272 16r8C7A 16r3273 16r6400 16r3274 16r63BA 16r3275 16r8749 16r3276 16r998B 16r3277 16r8C17 16r3278 16r7F20 16r3279 16r94F2 16r327A 16r4EA7 16r327B 16r9610 16r327C 16r98A4 16r327D 16r660C 16r327E 16r7316 16r3321 16r573A 16r3322 16r5C1D 16r3323 16r5E38 16r3324 16r957F 16r3325 16r507F 16r3326 16r80A0 16r3327 16r5382 16r3328 16r655E 16r3329 16r7545 16r332A 16r5531 16r332B 16r5021 16r332C 16r8D85 16r332D 16r6284 16r332E 16r949E 16r332F 16r671D 16r3330 16r5632 16r3331 16r6F6E 16r3332 16r5DE2 16r3333 16r5435 16r3334 16r7092 16r3335 16r8F66 16r3336 16r626F 16r3337 16r64A4 16r3338 16r63A3 16r3339 16r5F7B 16r333A 16r6F88 16r333B 16r90F4 16r333C 16r81E3 16r333D 16r8FB0 16r333E 16r5C18 16r333F 16r6668 16r3340 16r5FF1 16r3341 16r6C89 16r3342 16r9648 16r3343 16r8D81 16r3344 16r886C 16r3345 16r6491 16r3346 16r79F0 16r3347 16r57CE 16r3348 16r6A59 16r3349 16r6210 16r334A 16r5448 16r334B 16r4E58 16r334C 16r7A0B 16r334D 16r60E9 16r334E 16r6F84 16r334F 16r8BDA 16r3350 16r627F 16r3351 16r901E 16r3352 16r9A8B 16r3353 16r79E4 16r3354 16r5403 16r3355 16r75F4 16r3356 16r6301 16r3357 16r5319 16r3358 16r6C60 16r3359 16r8FDF 16r335A 16r5F1B 16r335B 16r9A70 16r335C 16r803B 16r335D 16r9F7F 16r335E 16r4F88 16r335F 16r5C3A 16r3360 16r8D64 16r3361 16r7FC5 16r3362 16r65A5 16r3363 16r70BD 16r3364 16r5145 16r3365 16r51B2 16r3366 16r866B 16r3367 16r5D07 16r3368 16r5BA0 16r3369 16r62BD 16r336A 16r916C 16r336B 16r7574 16r336C 16r8E0C 16r336D 16r7A20 16r336E 16r6101 16r336F 16r7B79 16r3370 16r4EC7 16r3371 16r7EF8 16r3372 16r7785 16r3373 16r4E11 16r3374 16r81ED 16r3375 16r521D 16r3376 16r51FA 16r3377 16r6A71 16r3378 16r53A8 16r3379 16r8E87 16r337A 16r9504 16r337B 16r96CF 16r337C 16r6EC1 16r337D 16r9664 16r337E 16r695A 16r3421 16r7840 16r3422 16r50A8 16r3423 16r77D7 16r3424 16r6410 16r3425 16r89E6 16r3426 16r5904 16r3427 16r63E3 16r3428 16r5DDD 16r3429 16r7A7F 16r342A 16r693D 16r342B 16r4F20 16r342C 16r8239 16r342D 16r5598 16r342E 16r4E32 16r342F 16r75AE 16r3430 16r7A97 16r3431 16r5E62 16r3432 16r5E8A 16r3433 16r95EF 16r3434 16r521B 16r3435 16r5439 16r3436 16r708A 16r3437 16r6376 16r3438 16r9524 16r3439 16r5782 16r343A 16r6625 16r343B 16r693F 16r343C 16r9187 16r343D 16r5507 16r343E 16r6DF3 16r343F 16r7EAF 16r3440 16r8822 16r3441 16r6233 16r3442 16r7EF0 16r3443 16r75B5 16r3444 16r8328 16r3445 16r78C1 16r3446 16r96CC 16r3447 16r8F9E 16r3448 16r6148 16r3449 16r74F7 16r344A 16r8BCD 16r344B 16r6B64 16r344C 16r523A 16r344D 16r8D50 16r344E 16r6B21 16r344F 16r806A 16r3450 16r8471 16r3451 16r56F1 16r3452 16r5306 16r3453 16r4ECE 16r3454 16r4E1B 16r3455 16r51D1 16r3456 16r7C97 16r3457 16r918B 16r3458 16r7C07 16r3459 16r4FC3 16r345A 16r8E7F 16r345B 16r7BE1 16r345C 16r7A9C 16r345D 16r6467 16r345E 16r5D14 16r345F 16r50AC 16r3460 16r8106 16r3461 16r7601 16r3462 16r7CB9 16r3463 16r6DEC 16r3464 16r7FE0 16r3465 16r6751 16r3466 16r5B58 16r3467 16r5BF8 16r3468 16r78CB 16r3469 16r64AE 16r346A 16r6413 16r346B 16r63AA 16r346C 16r632B 16r346D 16r9519 16r346E 16r642D 16r346F 16r8FBE 16r3470 16r7B54 16r3471 16r7629 16r3472 16r6253 16r3473 16r5927 16r3474 16r5446 16r3475 16r6B79 16r3476 16r50A3 16r3477 16r6234 16r3478 16r5E26 16r3479 16r6B86 16r347A 16r4EE3 16r347B 16r8D37 16r347C 16r888B 16r347D 16r5F85 16r347E 16r902E 16r3521 16r6020 16r3522 16r803D 16r3523 16r62C5 16r3524 16r4E39 16r3525 16r5355 16r3526 16r90F8 16r3527 16r63B8 16r3528 16r80C6 16r3529 16r65E6 16r352A 16r6C2E 16r352B 16r4F46 16r352C 16r60EE 16r352D 16r6DE1 16r352E 16r8BDE 16r352F 16r5F39 16r3530 16r86CB 16r3531 16r5F53 16r3532 16r6321 16r3533 16r515A 16r3534 16r8361 16r3535 16r6863 16r3536 16r5200 16r3537 16r6363 16r3538 16r8E48 16r3539 16r5012 16r353A 16r5C9B 16r353B 16r7977 16r353C 16r5BFC 16r353D 16r5230 16r353E 16r7A3B 16r353F 16r60BC 16r3540 16r9053 16r3541 16r76D7 16r3542 16r5FB7 16r3543 16r5F97 16r3544 16r7684 16r3545 16r8E6C 16r3546 16r706F 16r3547 16r767B 16r3548 16r7B49 16r3549 16r77AA 16r354A 16r51F3 16r354B 16r9093 16r354C 16r5824 16r354D 16r4F4E 16r354E 16r6EF4 16r354F 16r8FEA 16r3550 16r654C 16r3551 16r7B1B 16r3552 16r72C4 16r3553 16r6DA4 16r3554 16r7FDF 16r3555 16r5AE1 16r3556 16r62B5 16r3557 16r5E95 16r3558 16r5730 16r3559 16r8482 16r355A 16r7B2C 16r355B 16r5E1D 16r355C 16r5F1F 16r355D 16r9012 16r355E 16r7F14 16r355F 16r98A0 16r3560 16r6382 16r3561 16r6EC7 16r3562 16r7898 16r3563 16r70B9 16r3564 16r5178 16r3565 16r975B 16r3566 16r57AB 16r3567 16r7535 16r3568 16r4F43 16r3569 16r7538 16r356A 16r5E97 16r356B 16r60E6 16r356C 16r5960 16r356D 16r6DC0 16r356E 16r6BBF 16r356F 16r7889 16r3570 16r53FC 16r3571 16r96D5 16r3572 16r51CB 16r3573 16r5201 16r3574 16r6389 16r3575 16r540A 16r3576 16r9493 16r3577 16r8C03 16r3578 16r8DCC 16r3579 16r7239 16r357A 16r789F 16r357B 16r8776 16r357C 16r8FED 16r357D 16r8C0D 16r357E 16r53E0 16r3621 16r4E01 16r3622 16r76EF 16r3623 16r53EE 16r3624 16r9489 16r3625 16r9876 16r3626 16r9F0E 16r3627 16r952D 16r3628 16r5B9A 16r3629 16r8BA2 16r362A 16r4E22 16r362B 16r4E1C 16r362C 16r51AC 16r362D 16r8463 16r362E 16r61C2 16r362F 16r52A8 16r3630 16r680B 16r3631 16r4F97 16r3632 16r606B 16r3633 16r51BB 16r3634 16r6D1E 16r3635 16r515C 16r3636 16r6296 16r3637 16r6597 16r3638 16r9661 16r3639 16r8C46 16r363A 16r9017 16r363B 16r75D8 16r363C 16r90FD 16r363D 16r7763 16r363E 16r6BD2 16r363F 16r728A 16r3640 16r72EC 16r3641 16r8BFB 16r3642 16r5835 16r3643 16r7779 16r3644 16r8D4C 16r3645 16r675C 16r3646 16r9540 16r3647 16r809A 16r3648 16r5EA6 16r3649 16r6E21 16r364A 16r5992 16r364B 16r7AEF 16r364C 16r77ED 16r364D 16r953B 16r364E 16r6BB5 16r364F 16r65AD 16r3650 16r7F0E 16r3651 16r5806 16r3652 16r5151 16r3653 16r961F 16r3654 16r5BF9 16r3655 16r58A9 16r3656 16r5428 16r3657 16r8E72 16r3658 16r6566 16r3659 16r987F 16r365A 16r56E4 16r365B 16r949D 16r365C 16r76FE 16r365D 16r9041 16r365E 16r6387 16r365F 16r54C6 16r3660 16r591A 16r3661 16r593A 16r3662 16r579B 16r3663 16r8EB2 16r3664 16r6735 16r3665 16r8DFA 16r3666 16r8235 16r3667 16r5241 16r3668 16r60F0 16r3669 16r5815 16r366A 16r86FE 16r366B 16r5CE8 16r366C 16r9E45 16r366D 16r4FC4 16r366E 16r989D 16r366F 16r8BB9 16r3670 16r5A25 16r3671 16r6076 16r3672 16r5384 16r3673 16r627C 16r3674 16r904F 16r3675 16r9102 16r3676 16r997F 16r3677 16r6069 16r3678 16r800C 16r3679 16r513F 16r367A 16r8033 16r367B 16r5C14 16r367C 16r9975 16r367D 16r6D31 16r367E 16r4E8C 16r3721 16r8D30 16r3722 16r53D1 16r3723 16r7F5A 16r3724 16r7B4F 16r3725 16r4F10 16r3726 16r4E4F 16r3727 16r9600 16r3728 16r6CD5 16r3729 16r73D0 16r372A 16r85E9 16r372B 16r5E06 16r372C 16r756A 16r372D 16r7FFB 16r372E 16r6A0A 16r372F 16r77FE 16r3730 16r9492 16r3731 16r7E41 16r3732 16r51E1 16r3733 16r70E6 16r3734 16r53CD 16r3735 16r8FD4 16r3736 16r8303 16r3737 16r8D29 16r3738 16r72AF 16r3739 16r996D 16r373A 16r6CDB 16r373B 16r574A 16r373C 16r82B3 16r373D 16r65B9 16r373E 16r80AA 16r373F 16r623F 16r3740 16r9632 16r3741 16r59A8 16r3742 16r4EFF 16r3743 16r8BBF 16r3744 16r7EBA 16r3745 16r653E 16r3746 16r83F2 16r3747 16r975E 16r3748 16r5561 16r3749 16r98DE 16r374A 16r80A5 16r374B 16r532A 16r374C 16r8BFD 16r374D 16r5420 16r374E 16r80BA 16r374F 16r5E9F 16r3750 16r6CB8 16r3751 16r8D39 16r3752 16r82AC 16r3753 16r915A 16r3754 16r5429 16r3755 16r6C1B 16r3756 16r5206 16r3757 16r7EB7 16r3758 16r575F 16r3759 16r711A 16r375A 16r6C7E 16r375B 16r7C89 16r375C 16r594B 16r375D 16r4EFD 16r375E 16r5FFF 16r375F 16r6124 16r3760 16r7CAA 16r3761 16r4E30 16r3762 16r5C01 16r3763 16r67AB 16r3764 16r8702 16r3765 16r5CF0 16r3766 16r950B 16r3767 16r98CE 16r3768 16r75AF 16r3769 16r70FD 16r376A 16r9022 16r376B 16r51AF 16r376C 16r7F1D 16r376D 16r8BBD 16r376E 16r5949 16r376F 16r51E4 16r3770 16r4F5B 16r3771 16r5426 16r3772 16r592B 16r3773 16r6577 16r3774 16r80A4 16r3775 16r5B75 16r3776 16r6276 16r3777 16r62C2 16r3778 16r8F90 16r3779 16r5E45 16r377A 16r6C1F 16r377B 16r7B26 16r377C 16r4F0F 16r377D 16r4FD8 16r377E 16r670D 16r3821 16r6D6E 16r3822 16r6DAA 16r3823 16r798F 16r3824 16r88B1 16r3825 16r5F17 16r3826 16r752B 16r3827 16r629A 16r3828 16r8F85 16r3829 16r4FEF 16r382A 16r91DC 16r382B 16r65A7 16r382C 16r812F 16r382D 16r8151 16r382E 16r5E9C 16r382F 16r8150 16r3830 16r8D74 16r3831 16r526F 16r3832 16r8986 16r3833 16r8D4B 16r3834 16r590D 16r3835 16r5085 16r3836 16r4ED8 16r3837 16r961C 16r3838 16r7236 16r3839 16r8179 16r383A 16r8D1F 16r383B 16r5BCC 16r383C 16r8BA3 16r383D 16r9644 16r383E 16r5987 16r383F 16r7F1A 16r3840 16r5490 16r3841 16r5676 16r3842 16r560E 16r3843 16r8BE5 16r3844 16r6539 16r3845 16r6982 16r3846 16r9499 16r3847 16r76D6 16r3848 16r6E89 16r3849 16r5E72 16r384A 16r7518 16r384B 16r6746 16r384C 16r67D1 16r384D 16r7AFF 16r384E 16r809D 16r384F 16r8D76 16r3850 16r611F 16r3851 16r79C6 16r3852 16r6562 16r3853 16r8D63 16r3854 16r5188 16r3855 16r521A 16r3856 16r94A2 16r3857 16r7F38 16r3858 16r809B 16r3859 16r7EB2 16r385A 16r5C97 16r385B 16r6E2F 16r385C 16r6760 16r385D 16r7BD9 16r385E 16r768B 16r385F 16r9AD8 16r3860 16r818F 16r3861 16r7F94 16r3862 16r7CD5 16r3863 16r641E 16r3864 16r9550 16r3865 16r7A3F 16r3866 16r544A 16r3867 16r54E5 16r3868 16r6B4C 16r3869 16r6401 16r386A 16r6208 16r386B 16r9E3D 16r386C 16r80F3 16r386D 16r7599 16r386E 16r5272 16r386F 16r9769 16r3870 16r845B 16r3871 16r683C 16r3872 16r86E4 16r3873 16r9601 16r3874 16r9694 16r3875 16r94EC 16r3876 16r4E2A 16r3877 16r5404 16r3878 16r7ED9 16r3879 16r6839 16r387A 16r8DDF 16r387B 16r8015 16r387C 16r66F4 16r387D 16r5E9A 16r387E 16r7FB9 16r3921 16r57C2 16r3922 16r803F 16r3923 16r6897 16r3924 16r5DE5 16r3925 16r653B 16r3926 16r529F 16r3927 16r606D 16r3928 16r9F9A 16r3929 16r4F9B 16r392A 16r8EAC 16r392B 16r516C 16r392C 16r5BAB 16r392D 16r5F13 16r392E 16r5DE9 16r392F 16r6C5E 16r3930 16r62F1 16r3931 16r8D21 16r3932 16r5171 16r3933 16r94A9 16r3934 16r52FE 16r3935 16r6C9F 16r3936 16r82DF 16r3937 16r72D7 16r3938 16r57A2 16r3939 16r6784 16r393A 16r8D2D 16r393B 16r591F 16r393C 16r8F9C 16r393D 16r83C7 16r393E 16r5495 16r393F 16r7B8D 16r3940 16r4F30 16r3941 16r6CBD 16r3942 16r5B64 16r3943 16r59D1 16r3944 16r9F13 16r3945 16r53E4 16r3946 16r86CA 16r3947 16r9AA8 16r3948 16r8C37 16r3949 16r80A1 16r394A 16r6545 16r394B 16r987E 16r394C 16r56FA 16r394D 16r96C7 16r394E 16r522E 16r394F 16r74DC 16r3950 16r5250 16r3951 16r5BE1 16r3952 16r6302 16r3953 16r8902 16r3954 16r4E56 16r3955 16r62D0 16r3956 16r602A 16r3957 16r68FA 16r3958 16r5173 16r3959 16r5B98 16r395A 16r51A0 16r395B 16r89C2 16r395C 16r7BA1 16r395D 16r9986 16r395E 16r7F50 16r395F 16r60EF 16r3960 16r704C 16r3961 16r8D2F 16r3962 16r5149 16r3963 16r5E7F 16r3964 16r901B 16r3965 16r7470 16r3966 16r89C4 16r3967 16r572D 16r3968 16r7845 16r3969 16r5F52 16r396A 16r9F9F 16r396B 16r95FA 16r396C 16r8F68 16r396D 16r9B3C 16r396E 16r8BE1 16r396F 16r7678 16r3970 16r6842 16r3971 16r67DC 16r3972 16r8DEA 16r3973 16r8D35 16r3974 16r523D 16r3975 16r8F8A 16r3976 16r6EDA 16r3977 16r68CD 16r3978 16r9505 16r3979 16r90ED 16r397A 16r56FD 16r397B 16r679C 16r397C 16r88F9 16r397D 16r8FC7 16r397E 16r54C8 16r3A21 16r9AB8 16r3A22 16r5B69 16r3A23 16r6D77 16r3A24 16r6C26 16r3A25 16r4EA5 16r3A26 16r5BB3 16r3A27 16r9A87 16r3A28 16r9163 16r3A29 16r61A8 16r3A2A 16r90AF 16r3A2B 16r97E9 16r3A2C 16r542B 16r3A2D 16r6DB5 16r3A2E 16r5BD2 16r3A2F 16r51FD 16r3A30 16r558A 16r3A31 16r7F55 16r3A32 16r7FF0 16r3A33 16r64BC 16r3A34 16r634D 16r3A35 16r65F1 16r3A36 16r61BE 16r3A37 16r608D 16r3A38 16r710A 16r3A39 16r6C57 16r3A3A 16r6C49 16r3A3B 16r592F 16r3A3C 16r676D 16r3A3D 16r822A 16r3A3E 16r58D5 16r3A3F 16r568E 16r3A40 16r8C6A 16r3A41 16r6BEB 16r3A42 16r90DD 16r3A43 16r597D 16r3A44 16r8017 16r3A45 16r53F7 16r3A46 16r6D69 16r3A47 16r5475 16r3A48 16r559D 16r3A49 16r8377 16r3A4A 16r83CF 16r3A4B 16r6838 16r3A4C 16r79BE 16r3A4D 16r548C 16r3A4E 16r4F55 16r3A4F 16r5408 16r3A50 16r76D2 16r3A51 16r8C89 16r3A52 16r9602 16r3A53 16r6CB3 16r3A54 16r6DB8 16r3A55 16r8D6B 16r3A56 16r8910 16r3A57 16r9E64 16r3A58 16r8D3A 16r3A59 16r563F 16r3A5A 16r9ED1 16r3A5B 16r75D5 16r3A5C 16r5F88 16r3A5D 16r72E0 16r3A5E 16r6068 16r3A5F 16r54FC 16r3A60 16r4EA8 16r3A61 16r6A2A 16r3A62 16r8861 16r3A63 16r6052 16r3A64 16r8F70 16r3A65 16r54C4 16r3A66 16r70D8 16r3A67 16r8679 16r3A68 16r9E3F 16r3A69 16r6D2A 16r3A6A 16r5B8F 16r3A6B 16r5F18 16r3A6C 16r7EA2 16r3A6D 16r5589 16r3A6E 16r4FAF 16r3A6F 16r7334 16r3A70 16r543C 16r3A71 16r539A 16r3A72 16r5019 16r3A73 16r540E 16r3A74 16r547C 16r3A75 16r4E4E 16r3A76 16r5FFD 16r3A77 16r745A 16r3A78 16r58F6 16r3A79 16r846B 16r3A7A 16r80E1 16r3A7B 16r8774 16r3A7C 16r72D0 16r3A7D 16r7CCA 16r3A7E 16r6E56 16r3B21 16r5F27 16r3B22 16r864E 16r3B23 16r552C 16r3B24 16r62A4 16r3B25 16r4E92 16r3B26 16r6CAA 16r3B27 16r6237 16r3B28 16r82B1 16r3B29 16r54D7 16r3B2A 16r534E 16r3B2B 16r733E 16r3B2C 16r6ED1 16r3B2D 16r753B 16r3B2E 16r5212 16r3B2F 16r5316 16r3B30 16r8BDD 16r3B31 16r69D0 16r3B32 16r5F8A 16r3B33 16r6000 16r3B34 16r6DEE 16r3B35 16r574F 16r3B36 16r6B22 16r3B37 16r73AF 16r3B38 16r6853 16r3B39 16r8FD8 16r3B3A 16r7F13 16r3B3B 16r6362 16r3B3C 16r60A3 16r3B3D 16r5524 16r3B3E 16r75EA 16r3B3F 16r8C62 16r3B40 16r7115 16r3B41 16r6DA3 16r3B42 16r5BA6 16r3B43 16r5E7B 16r3B44 16r8352 16r3B45 16r614C 16r3B46 16r9EC4 16r3B47 16r78FA 16r3B48 16r8757 16r3B49 16r7C27 16r3B4A 16r7687 16r3B4B 16r51F0 16r3B4C 16r60F6 16r3B4D 16r714C 16r3B4E 16r6643 16r3B4F 16r5E4C 16r3B50 16r604D 16r3B51 16r8C0E 16r3B52 16r7070 16r3B53 16r6325 16r3B54 16r8F89 16r3B55 16r5FBD 16r3B56 16r6062 16r3B57 16r86D4 16r3B58 16r56DE 16r3B59 16r6BC1 16r3B5A 16r6094 16r3B5B 16r6167 16r3B5C 16r5349 16r3B5D 16r60E0 16r3B5E 16r6666 16r3B5F 16r8D3F 16r3B60 16r79FD 16r3B61 16r4F1A 16r3B62 16r70E9 16r3B63 16r6C47 16r3B64 16r8BB3 16r3B65 16r8BF2 16r3B66 16r7ED8 16r3B67 16r8364 16r3B68 16r660F 16r3B69 16r5A5A 16r3B6A 16r9B42 16r3B6B 16r6D51 16r3B6C 16r6DF7 16r3B6D 16r8C41 16r3B6E 16r6D3B 16r3B6F 16r4F19 16r3B70 16r706B 16r3B71 16r83B7 16r3B72 16r6216 16r3B73 16r60D1 16r3B74 16r970D 16r3B75 16r8D27 16r3B76 16r7978 16r3B77 16r51FB 16r3B78 16r573E 16r3B79 16r57FA 16r3B7A 16r673A 16r3B7B 16r7578 16r3B7C 16r7A3D 16r3B7D 16r79EF 16r3B7E 16r7B95 16r3C21 16r808C 16r3C22 16r9965 16r3C23 16r8FF9 16r3C24 16r6FC0 16r3C25 16r8BA5 16r3C26 16r9E21 16r3C27 16r59EC 16r3C28 16r7EE9 16r3C29 16r7F09 16r3C2A 16r5409 16r3C2B 16r6781 16r3C2C 16r68D8 16r3C2D 16r8F91 16r3C2E 16r7C4D 16r3C2F 16r96C6 16r3C30 16r53CA 16r3C31 16r6025 16r3C32 16r75BE 16r3C33 16r6C72 16r3C34 16r5373 16r3C35 16r5AC9 16r3C36 16r7EA7 16r3C37 16r6324 16r3C38 16r51E0 16r3C39 16r810A 16r3C3A 16r5DF1 16r3C3B 16r84DF 16r3C3C 16r6280 16r3C3D 16r5180 16r3C3E 16r5B63 16r3C3F 16r4F0E 16r3C40 16r796D 16r3C41 16r5242 16r3C42 16r60B8 16r3C43 16r6D4E 16r3C44 16r5BC4 16r3C45 16r5BC2 16r3C46 16r8BA1 16r3C47 16r8BB0 16r3C48 16r65E2 16r3C49 16r5FCC 16r3C4A 16r9645 16r3C4B 16r5993 16r3C4C 16r7EE7 16r3C4D 16r7EAA 16r3C4E 16r5609 16r3C4F 16r67B7 16r3C50 16r5939 16r3C51 16r4F73 16r3C52 16r5BB6 16r3C53 16r52A0 16r3C54 16r835A 16r3C55 16r988A 16r3C56 16r8D3E 16r3C57 16r7532 16r3C58 16r94BE 16r3C59 16r5047 16r3C5A 16r7A3C 16r3C5B 16r4EF7 16r3C5C 16r67B6 16r3C5D 16r9A7E 16r3C5E 16r5AC1 16r3C5F 16r6B7C 16r3C60 16r76D1 16r3C61 16r575A 16r3C62 16r5C16 16r3C63 16r7B3A 16r3C64 16r95F4 16r3C65 16r714E 16r3C66 16r517C 16r3C67 16r80A9 16r3C68 16r8270 16r3C69 16r5978 16r3C6A 16r7F04 16r3C6B 16r8327 16r3C6C 16r68C0 16r3C6D 16r67EC 16r3C6E 16r78B1 16r3C6F 16r7877 16r3C70 16r62E3 16r3C71 16r6361 16r3C72 16r7B80 16r3C73 16r4FED 16r3C74 16r526A 16r3C75 16r51CF 16r3C76 16r8350 16r3C77 16r69DB 16r3C78 16r9274 16r3C79 16r8DF5 16r3C7A 16r8D31 16r3C7B 16r89C1 16r3C7C 16r952E 16r3C7D 16r7BAD 16r3C7E 16r4EF6 16r3D21 16r5065 16r3D22 16r8230 16r3D23 16r5251 16r3D24 16r996F 16r3D25 16r6E10 16r3D26 16r6E85 16r3D27 16r6DA7 16r3D28 16r5EFA 16r3D29 16r50F5 16r3D2A 16r59DC 16r3D2B 16r5C06 16r3D2C 16r6D46 16r3D2D 16r6C5F 16r3D2E 16r7586 16r3D2F 16r848B 16r3D30 16r6868 16r3D31 16r5956 16r3D32 16r8BB2 16r3D33 16r5320 16r3D34 16r9171 16r3D35 16r964D 16r3D36 16r8549 16r3D37 16r6912 16r3D38 16r7901 16r3D39 16r7126 16r3D3A 16r80F6 16r3D3B 16r4EA4 16r3D3C 16r90CA 16r3D3D 16r6D47 16r3D3E 16r9A84 16r3D3F 16r5A07 16r3D40 16r56BC 16r3D41 16r6405 16r3D42 16r94F0 16r3D43 16r77EB 16r3D44 16r4FA5 16r3D45 16r811A 16r3D46 16r72E1 16r3D47 16r89D2 16r3D48 16r997A 16r3D49 16r7F34 16r3D4A 16r7EDE 16r3D4B 16r527F 16r3D4C 16r6559 16r3D4D 16r9175 16r3D4E 16r8F7F 16r3D4F 16r8F83 16r3D50 16r53EB 16r3D51 16r7A96 16r3D52 16r63ED 16r3D53 16r63A5 16r3D54 16r7686 16r3D55 16r79F8 16r3D56 16r8857 16r3D57 16r9636 16r3D58 16r622A 16r3D59 16r52AB 16r3D5A 16r8282 16r3D5B 16r6854 16r3D5C 16r6770 16r3D5D 16r6377 16r3D5E 16r776B 16r3D5F 16r7AED 16r3D60 16r6D01 16r3D61 16r7ED3 16r3D62 16r89E3 16r3D63 16r59D0 16r3D64 16r6212 16r3D65 16r85C9 16r3D66 16r82A5 16r3D67 16r754C 16r3D68 16r501F 16r3D69 16r4ECB 16r3D6A 16r75A5 16r3D6B 16r8BEB 16r3D6C 16r5C4A 16r3D6D 16r5DFE 16r3D6E 16r7B4B 16r3D6F 16r65A4 16r3D70 16r91D1 16r3D71 16r4ECA 16r3D72 16r6D25 16r3D73 16r895F 16r3D74 16r7D27 16r3D75 16r9526 16r3D76 16r4EC5 16r3D77 16r8C28 16r3D78 16r8FDB 16r3D79 16r9773 16r3D7A 16r664B 16r3D7B 16r7981 16r3D7C 16r8FD1 16r3D7D 16r70EC 16r3D7E 16r6D78 16r3E21 16r5C3D 16r3E22 16r52B2 16r3E23 16r8346 16r3E24 16r5162 16r3E25 16r830E 16r3E26 16r775B 16r3E27 16r6676 16r3E28 16r9CB8 16r3E29 16r4EAC 16r3E2A 16r60CA 16r3E2B 16r7CBE 16r3E2C 16r7CB3 16r3E2D 16r7ECF 16r3E2E 16r4E95 16r3E2F 16r8B66 16r3E30 16r666F 16r3E31 16r9888 16r3E32 16r9759 16r3E33 16r5883 16r3E34 16r656C 16r3E35 16r955C 16r3E36 16r5F84 16r3E37 16r75C9 16r3E38 16r9756 16r3E39 16r7ADF 16r3E3A 16r7ADE 16r3E3B 16r51C0 16r3E3C 16r70AF 16r3E3D 16r7A98 16r3E3E 16r63EA 16r3E3F 16r7A76 16r3E40 16r7EA0 16r3E41 16r7396 16r3E42 16r97ED 16r3E43 16r4E45 16r3E44 16r7078 16r3E45 16r4E5D 16r3E46 16r9152 16r3E47 16r53A9 16r3E48 16r6551 16r3E49 16r65E7 16r3E4A 16r81FC 16r3E4B 16r8205 16r3E4C 16r548E 16r3E4D 16r5C31 16r3E4E 16r759A 16r3E4F 16r97A0 16r3E50 16r62D8 16r3E51 16r72D9 16r3E52 16r75BD 16r3E53 16r5C45 16r3E54 16r9A79 16r3E55 16r83CA 16r3E56 16r5C40 16r3E57 16r5480 16r3E58 16r77E9 16r3E59 16r4E3E 16r3E5A 16r6CAE 16r3E5B 16r805A 16r3E5C 16r62D2 16r3E5D 16r636E 16r3E5E 16r5DE8 16r3E5F 16r5177 16r3E60 16r8DDD 16r3E61 16r8E1E 16r3E62 16r952F 16r3E63 16r4FF1 16r3E64 16r53E5 16r3E65 16r60E7 16r3E66 16r70AC 16r3E67 16r5267 16r3E68 16r6350 16r3E69 16r9E43 16r3E6A 16r5A1F 16r3E6B 16r5026 16r3E6C 16r7737 16r3E6D 16r5377 16r3E6E 16r7EE2 16r3E6F 16r6485 16r3E70 16r652B 16r3E71 16r6289 16r3E72 16r6398 16r3E73 16r5014 16r3E74 16r7235 16r3E75 16r89C9 16r3E76 16r51B3 16r3E77 16r8BC0 16r3E78 16r7EDD 16r3E79 16r5747 16r3E7A 16r83CC 16r3E7B 16r94A7 16r3E7C 16r519B 16r3E7D 16r541B 16r3E7E 16r5CFB 16r3F21 16r4FCA 16r3F22 16r7AE3 16r3F23 16r6D5A 16r3F24 16r90E1 16r3F25 16r9A8F 16r3F26 16r5580 16r3F27 16r5496 16r3F28 16r5361 16r3F29 16r54AF 16r3F2A 16r5F00 16r3F2B 16r63E9 16r3F2C 16r6977 16r3F2D 16r51EF 16r3F2E 16r6168 16r3F2F 16r520A 16r3F30 16r582A 16r3F31 16r52D8 16r3F32 16r574E 16r3F33 16r780D 16r3F34 16r770B 16r3F35 16r5EB7 16r3F36 16r6177 16r3F37 16r7CE0 16r3F38 16r625B 16r3F39 16r6297 16r3F3A 16r4EA2 16r3F3B 16r7095 16r3F3C 16r8003 16r3F3D 16r62F7 16r3F3E 16r70E4 16r3F3F 16r9760 16r3F40 16r5777 16r3F41 16r82DB 16r3F42 16r67EF 16r3F43 16r68F5 16r3F44 16r78D5 16r3F45 16r9897 16r3F46 16r79D1 16r3F47 16r58F3 16r3F48 16r54B3 16r3F49 16r53EF 16r3F4A 16r6E34 16r3F4B 16r514B 16r3F4C 16r523B 16r3F4D 16r5BA2 16r3F4E 16r8BFE 16r3F4F 16r80AF 16r3F50 16r5543 16r3F51 16r57A6 16r3F52 16r6073 16r3F53 16r5751 16r3F54 16r542D 16r3F55 16r7A7A 16r3F56 16r6050 16r3F57 16r5B54 16r3F58 16r63A7 16r3F59 16r62A0 16r3F5A 16r53E3 16r3F5B 16r6263 16r3F5C 16r5BC7 16r3F5D 16r67AF 16r3F5E 16r54ED 16r3F5F 16r7A9F 16r3F60 16r82E6 16r3F61 16r9177 16r3F62 16r5E93 16r3F63 16r88E4 16r3F64 16r5938 16r3F65 16r57AE 16r3F66 16r630E 16r3F67 16r8DE8 16r3F68 16r80EF 16r3F69 16r5757 16r3F6A 16r7B77 16r3F6B 16r4FA9 16r3F6C 16r5FEB 16r3F6D 16r5BBD 16r3F6E 16r6B3E 16r3F6F 16r5321 16r3F70 16r7B50 16r3F71 16r72C2 16r3F72 16r6846 16r3F73 16r77FF 16r3F74 16r7736 16r3F75 16r65F7 16r3F76 16r51B5 16r3F77 16r4E8F 16r3F78 16r76D4 16r3F79 16r5CBF 16r3F7A 16r7AA5 16r3F7B 16r8475 16r3F7C 16r594E 16r3F7D 16r9B41 16r3F7E 16r5080 16r4021 16r9988 16r4022 16r6127 16r4023 16r6E83 16r4024 16r5764 16r4025 16r6606 16r4026 16r6346 16r4027 16r56F0 16r4028 16r62EC 16r4029 16r6269 16r402A 16r5ED3 16r402B 16r9614 16r402C 16r5783 16r402D 16r62C9 16r402E 16r5587 16r402F 16r8721 16r4030 16r814A 16r4031 16r8FA3 16r4032 16r5566 16r4033 16r83B1 16r4034 16r6765 16r4035 16r8D56 16r4036 16r84DD 16r4037 16r5A6A 16r4038 16r680F 16r4039 16r62E6 16r403A 16r7BEE 16r403B 16r9611 16r403C 16r5170 16r403D 16r6F9C 16r403E 16r8C30 16r403F 16r63FD 16r4040 16r89C8 16r4041 16r61D2 16r4042 16r7F06 16r4043 16r70C2 16r4044 16r6EE5 16r4045 16r7405 16r4046 16r6994 16r4047 16r72FC 16r4048 16r5ECA 16r4049 16r90CE 16r404A 16r6717 16r404B 16r6D6A 16r404C 16r635E 16r404D 16r52B3 16r404E 16r7262 16r404F 16r8001 16r4050 16r4F6C 16r4051 16r59E5 16r4052 16r916A 16r4053 16r70D9 16r4054 16r6D9D 16r4055 16r52D2 16r4056 16r4E50 16r4057 16r96F7 16r4058 16r956D 16r4059 16r857E 16r405A 16r78CA 16r405B 16r7D2F 16r405C 16r5121 16r405D 16r5792 16r405E 16r64C2 16r405F 16r808B 16r4060 16r7C7B 16r4061 16r6CEA 16r4062 16r68F1 16r4063 16r695E 16r4064 16r51B7 16r4065 16r5398 16r4066 16r68A8 16r4067 16r7281 16r4068 16r9ECE 16r4069 16r7BF1 16r406A 16r72F8 16r406B 16r79BB 16r406C 16r6F13 16r406D 16r7406 16r406E 16r674E 16r406F 16r91CC 16r4070 16r9CA4 16r4071 16r793C 16r4072 16r8389 16r4073 16r8354 16r4074 16r540F 16r4075 16r6817 16r4076 16r4E3D 16r4077 16r5389 16r4078 16r52B1 16r4079 16r783E 16r407A 16r5386 16r407B 16r5229 16r407C 16r5088 16r407D 16r4F8B 16r407E 16r4FD0 16r4121 16r75E2 16r4122 16r7ACB 16r4123 16r7C92 16r4124 16r6CA5 16r4125 16r96B6 16r4126 16r529B 16r4127 16r7483 16r4128 16r54E9 16r4129 16r4FE9 16r412A 16r8054 16r412B 16r83B2 16r412C 16r8FDE 16r412D 16r9570 16r412E 16r5EC9 16r412F 16r601C 16r4130 16r6D9F 16r4131 16r5E18 16r4132 16r655B 16r4133 16r8138 16r4134 16r94FE 16r4135 16r604B 16r4136 16r70BC 16r4137 16r7EC3 16r4138 16r7CAE 16r4139 16r51C9 16r413A 16r6881 16r413B 16r7CB1 16r413C 16r826F 16r413D 16r4E24 16r413E 16r8F86 16r413F 16r91CF 16r4140 16r667E 16r4141 16r4EAE 16r4142 16r8C05 16r4143 16r64A9 16r4144 16r804A 16r4145 16r50DA 16r4146 16r7597 16r4147 16r71CE 16r4148 16r5BE5 16r4149 16r8FBD 16r414A 16r6F66 16r414B 16r4E86 16r414C 16r6482 16r414D 16r9563 16r414E 16r5ED6 16r414F 16r6599 16r4150 16r5217 16r4151 16r88C2 16r4152 16r70C8 16r4153 16r52A3 16r4154 16r730E 16r4155 16r7433 16r4156 16r6797 16r4157 16r78F7 16r4158 16r9716 16r4159 16r4E34 16r415A 16r90BB 16r415B 16r9CDE 16r415C 16r6DCB 16r415D 16r51DB 16r415E 16r8D41 16r415F 16r541D 16r4160 16r62CE 16r4161 16r73B2 16r4162 16r83F1 16r4163 16r96F6 16r4164 16r9F84 16r4165 16r94C3 16r4166 16r4F36 16r4167 16r7F9A 16r4168 16r51CC 16r4169 16r7075 16r416A 16r9675 16r416B 16r5CAD 16r416C 16r9886 16r416D 16r53E6 16r416E 16r4EE4 16r416F 16r6E9C 16r4170 16r7409 16r4171 16r69B4 16r4172 16r786B 16r4173 16r998F 16r4174 16r7559 16r4175 16r5218 16r4176 16r7624 16r4177 16r6D41 16r4178 16r67F3 16r4179 16r516D 16r417A 16r9F99 16r417B 16r804B 16r417C 16r5499 16r417D 16r7B3C 16r417E 16r7ABF 16r4221 16r9686 16r4222 16r5784 16r4223 16r62E2 16r4224 16r9647 16r4225 16r697C 16r4226 16r5A04 16r4227 16r6402 16r4228 16r7BD3 16r4229 16r6F0F 16r422A 16r964B 16r422B 16r82A6 16r422C 16r5362 16r422D 16r9885 16r422E 16r5E90 16r422F 16r7089 16r4230 16r63B3 16r4231 16r5364 16r4232 16r864F 16r4233 16r9C81 16r4234 16r9E93 16r4235 16r788C 16r4236 16r9732 16r4237 16r8DEF 16r4238 16r8D42 16r4239 16r9E7F 16r423A 16r6F5E 16r423B 16r7984 16r423C 16r5F55 16r423D 16r9646 16r423E 16r622E 16r423F 16r9A74 16r4240 16r5415 16r4241 16r94DD 16r4242 16r4FA3 16r4243 16r65C5 16r4244 16r5C65 16r4245 16r5C61 16r4246 16r7F15 16r4247 16r8651 16r4248 16r6C2F 16r4249 16r5F8B 16r424A 16r7387 16r424B 16r6EE4 16r424C 16r7EFF 16r424D 16r5CE6 16r424E 16r631B 16r424F 16r5B6A 16r4250 16r6EE6 16r4251 16r5375 16r4252 16r4E71 16r4253 16r63A0 16r4254 16r7565 16r4255 16r62A1 16r4256 16r8F6E 16r4257 16r4F26 16r4258 16r4ED1 16r4259 16r6CA6 16r425A 16r7EB6 16r425B 16r8BBA 16r425C 16r841D 16r425D 16r87BA 16r425E 16r7F57 16r425F 16r903B 16r4260 16r9523 16r4261 16r7BA9 16r4262 16r9AA1 16r4263 16r88F8 16r4264 16r843D 16r4265 16r6D1B 16r4266 16r9A86 16r4267 16r7EDC 16r4268 16r5988 16r4269 16r9EBB 16r426A 16r739B 16r426B 16r7801 16r426C 16r8682 16r426D 16r9A6C 16r426E 16r9A82 16r426F 16r561B 16r4270 16r5417 16r4271 16r57CB 16r4272 16r4E70 16r4273 16r9EA6 16r4274 16r5356 16r4275 16r8FC8 16r4276 16r8109 16r4277 16r7792 16r4278 16r9992 16r4279 16r86EE 16r427A 16r6EE1 16r427B 16r8513 16r427C 16r66FC 16r427D 16r6162 16r427E 16r6F2B 16r4321 16r8C29 16r4322 16r8292 16r4323 16r832B 16r4324 16r76F2 16r4325 16r6C13 16r4326 16r5FD9 16r4327 16r83BD 16r4328 16r732B 16r4329 16r8305 16r432A 16r951A 16r432B 16r6BDB 16r432C 16r77DB 16r432D 16r94C6 16r432E 16r536F 16r432F 16r8302 16r4330 16r5192 16r4331 16r5E3D 16r4332 16r8C8C 16r4333 16r8D38 16r4334 16r4E48 16r4335 16r73AB 16r4336 16r679A 16r4337 16r6885 16r4338 16r9176 16r4339 16r9709 16r433A 16r7164 16r433B 16r6CA1 16r433C 16r7709 16r433D 16r5A92 16r433E 16r9541 16r433F 16r6BCF 16r4340 16r7F8E 16r4341 16r6627 16r4342 16r5BD0 16r4343 16r59B9 16r4344 16r5A9A 16r4345 16r95E8 16r4346 16r95F7 16r4347 16r4EEC 16r4348 16r840C 16r4349 16r8499 16r434A 16r6AAC 16r434B 16r76DF 16r434C 16r9530 16r434D 16r731B 16r434E 16r68A6 16r434F 16r5B5F 16r4350 16r772F 16r4351 16r919A 16r4352 16r9761 16r4353 16r7CDC 16r4354 16r8FF7 16r4355 16r8C1C 16r4356 16r5F25 16r4357 16r7C73 16r4358 16r79D8 16r4359 16r89C5 16r435A 16r6CCC 16r435B 16r871C 16r435C 16r5BC6 16r435D 16r5E42 16r435E 16r68C9 16r435F 16r7720 16r4360 16r7EF5 16r4361 16r5195 16r4362 16r514D 16r4363 16r52C9 16r4364 16r5A29 16r4365 16r7F05 16r4366 16r9762 16r4367 16r82D7 16r4368 16r63CF 16r4369 16r7784 16r436A 16r85D0 16r436B 16r79D2 16r436C 16r6E3A 16r436D 16r5E99 16r436E 16r5999 16r436F 16r8511 16r4370 16r706D 16r4371 16r6C11 16r4372 16r62BF 16r4373 16r76BF 16r4374 16r654F 16r4375 16r60AF 16r4376 16r95FD 16r4377 16r660E 16r4378 16r879F 16r4379 16r9E23 16r437A 16r94ED 16r437B 16r540D 16r437C 16r547D 16r437D 16r8C2C 16r437E 16r6478 16r4421 16r6479 16r4422 16r8611 16r4423 16r6A21 16r4424 16r819C 16r4425 16r78E8 16r4426 16r6469 16r4427 16r9B54 16r4428 16r62B9 16r4429 16r672B 16r442A 16r83AB 16r442B 16r58A8 16r442C 16r9ED8 16r442D 16r6CAB 16r442E 16r6F20 16r442F 16r5BDE 16r4430 16r964C 16r4431 16r8C0B 16r4432 16r725F 16r4433 16r67D0 16r4434 16r62C7 16r4435 16r7261 16r4436 16r4EA9 16r4437 16r59C6 16r4438 16r6BCD 16r4439 16r5893 16r443A 16r66AE 16r443B 16r5E55 16r443C 16r52DF 16r443D 16r6155 16r443E 16r6728 16r443F 16r76EE 16r4440 16r7766 16r4441 16r7267 16r4442 16r7A46 16r4443 16r62FF 16r4444 16r54EA 16r4445 16r5450 16r4446 16r94A0 16r4447 16r90A3 16r4448 16r5A1C 16r4449 16r7EB3 16r444A 16r6C16 16r444B 16r4E43 16r444C 16r5976 16r444D 16r8010 16r444E 16r5948 16r444F 16r5357 16r4450 16r7537 16r4451 16r96BE 16r4452 16r56CA 16r4453 16r6320 16r4454 16r8111 16r4455 16r607C 16r4456 16r95F9 16r4457 16r6DD6 16r4458 16r5462 16r4459 16r9981 16r445A 16r5185 16r445B 16r5AE9 16r445C 16r80FD 16r445D 16r59AE 16r445E 16r9713 16r445F 16r502A 16r4460 16r6CE5 16r4461 16r5C3C 16r4462 16r62DF 16r4463 16r4F60 16r4464 16r533F 16r4465 16r817B 16r4466 16r9006 16r4467 16r6EBA 16r4468 16r852B 16r4469 16r62C8 16r446A 16r5E74 16r446B 16r78BE 16r446C 16r64B5 16r446D 16r637B 16r446E 16r5FF5 16r446F 16r5A18 16r4470 16r917F 16r4471 16r9E1F 16r4472 16r5C3F 16r4473 16r634F 16r4474 16r8042 16r4475 16r5B7D 16r4476 16r556E 16r4477 16r954A 16r4478 16r954D 16r4479 16r6D85 16r447A 16r60A8 16r447B 16r67E0 16r447C 16r72DE 16r447D 16r51DD 16r447E 16r5B81 16r4521 16r62E7 16r4522 16r6CDE 16r4523 16r725B 16r4524 16r626D 16r4525 16r94AE 16r4526 16r7EBD 16r4527 16r8113 16r4528 16r6D53 16r4529 16r519C 16r452A 16r5F04 16r452B 16r5974 16r452C 16r52AA 16r452D 16r6012 16r452E 16r5973 16r452F 16r6696 16r4530 16r8650 16r4531 16r759F 16r4532 16r632A 16r4533 16r61E6 16r4534 16r7CEF 16r4535 16r8BFA 16r4536 16r54E6 16r4537 16r6B27 16r4538 16r9E25 16r4539 16r6BB4 16r453A 16r85D5 16r453B 16r5455 16r453C 16r5076 16r453D 16r6CA4 16r453E 16r556A 16r453F 16r8DB4 16r4540 16r722C 16r4541 16r5E15 16r4542 16r6015 16r4543 16r7436 16r4544 16r62CD 16r4545 16r6392 16r4546 16r724C 16r4547 16r5F98 16r4548 16r6E43 16r4549 16r6D3E 16r454A 16r6500 16r454B 16r6F58 16r454C 16r76D8 16r454D 16r78D0 16r454E 16r76FC 16r454F 16r7554 16r4550 16r5224 16r4551 16r53DB 16r4552 16r4E53 16r4553 16r5E9E 16r4554 16r65C1 16r4555 16r802A 16r4556 16r80D6 16r4557 16r629B 16r4558 16r5486 16r4559 16r5228 16r455A 16r70AE 16r455B 16r888D 16r455C 16r8DD1 16r455D 16r6CE1 16r455E 16r5478 16r455F 16r80DA 16r4560 16r57F9 16r4561 16r88F4 16r4562 16r8D54 16r4563 16r966A 16r4564 16r914D 16r4565 16r4F69 16r4566 16r6C9B 16r4567 16r55B7 16r4568 16r76C6 16r4569 16r7830 16r456A 16r62A8 16r456B 16r70F9 16r456C 16r6F8E 16r456D 16r5F6D 16r456E 16r84EC 16r456F 16r68DA 16r4570 16r787C 16r4571 16r7BF7 16r4572 16r81A8 16r4573 16r670B 16r4574 16r9E4F 16r4575 16r6367 16r4576 16r78B0 16r4577 16r576F 16r4578 16r7812 16r4579 16r9739 16r457A 16r6279 16r457B 16r62AB 16r457C 16r5288 16r457D 16r7435 16r457E 16r6BD7 16r4621 16r5564 16r4622 16r813E 16r4623 16r75B2 16r4624 16r76AE 16r4625 16r5339 16r4626 16r75DE 16r4627 16r50FB 16r4628 16r5C41 16r4629 16r8B6C 16r462A 16r7BC7 16r462B 16r504F 16r462C 16r7247 16r462D 16r9A97 16r462E 16r98D8 16r462F 16r6F02 16r4630 16r74E2 16r4631 16r7968 16r4632 16r6487 16r4633 16r77A5 16r4634 16r62FC 16r4635 16r9891 16r4636 16r8D2B 16r4637 16r54C1 16r4638 16r8058 16r4639 16r4E52 16r463A 16r576A 16r463B 16r82F9 16r463C 16r840D 16r463D 16r5E73 16r463E 16r51ED 16r463F 16r74F6 16r4640 16r8BC4 16r4641 16r5C4F 16r4642 16r5761 16r4643 16r6CFC 16r4644 16r9887 16r4645 16r5A46 16r4646 16r7834 16r4647 16r9B44 16r4648 16r8FEB 16r4649 16r7C95 16r464A 16r5256 16r464B 16r6251 16r464C 16r94FA 16r464D 16r4EC6 16r464E 16r8386 16r464F 16r8461 16r4650 16r83E9 16r4651 16r84B2 16r4652 16r57D4 16r4653 16r6734 16r4654 16r5703 16r4655 16r666E 16r4656 16r6D66 16r4657 16r8C31 16r4658 16r66DD 16r4659 16r7011 16r465A 16r671F 16r465B 16r6B3A 16r465C 16r6816 16r465D 16r621A 16r465E 16r59BB 16r465F 16r4E03 16r4660 16r51C4 16r4661 16r6F06 16r4662 16r67D2 16r4663 16r6C8F 16r4664 16r5176 16r4665 16r68CB 16r4666 16r5947 16r4667 16r6B67 16r4668 16r7566 16r4669 16r5D0E 16r466A 16r8110 16r466B 16r9F50 16r466C 16r65D7 16r466D 16r7948 16r466E 16r7941 16r466F 16r9A91 16r4670 16r8D77 16r4671 16r5C82 16r4672 16r4E5E 16r4673 16r4F01 16r4674 16r542F 16r4675 16r5951 16r4676 16r780C 16r4677 16r5668 16r4678 16r6C14 16r4679 16r8FC4 16r467A 16r5F03 16r467B 16r6C7D 16r467C 16r6CE3 16r467D 16r8BAB 16r467E 16r6390 16r4721 16r6070 16r4722 16r6D3D 16r4723 16r7275 16r4724 16r6266 16r4725 16r948E 16r4726 16r94C5 16r4727 16r5343 16r4728 16r8FC1 16r4729 16r7B7E 16r472A 16r4EDF 16r472B 16r8C26 16r472C 16r4E7E 16r472D 16r9ED4 16r472E 16r94B1 16r472F 16r94B3 16r4730 16r524D 16r4731 16r6F5C 16r4732 16r9063 16r4733 16r6D45 16r4734 16r8C34 16r4735 16r5811 16r4736 16r5D4C 16r4737 16r6B20 16r4738 16r6B49 16r4739 16r67AA 16r473A 16r545B 16r473B 16r8154 16r473C 16r7F8C 16r473D 16r5899 16r473E 16r8537 16r473F 16r5F3A 16r4740 16r62A2 16r4741 16r6A47 16r4742 16r9539 16r4743 16r6572 16r4744 16r6084 16r4745 16r6865 16r4746 16r77A7 16r4747 16r4E54 16r4748 16r4FA8 16r4749 16r5DE7 16r474A 16r9798 16r474B 16r64AC 16r474C 16r7FD8 16r474D 16r5CED 16r474E 16r4FCF 16r474F 16r7A8D 16r4750 16r5207 16r4751 16r8304 16r4752 16r4E14 16r4753 16r602F 16r4754 16r7A83 16r4755 16r94A6 16r4756 16r4FB5 16r4757 16r4EB2 16r4758 16r79E6 16r4759 16r7434 16r475A 16r52E4 16r475B 16r82B9 16r475C 16r64D2 16r475D 16r79BD 16r475E 16r5BDD 16r475F 16r6C81 16r4760 16r9752 16r4761 16r8F7B 16r4762 16r6C22 16r4763 16r503E 16r4764 16r537F 16r4765 16r6E05 16r4766 16r64CE 16r4767 16r6674 16r4768 16r6C30 16r4769 16r60C5 16r476A 16r9877 16r476B 16r8BF7 16r476C 16r5E86 16r476D 16r743C 16r476E 16r7A77 16r476F 16r79CB 16r4770 16r4E18 16r4771 16r90B1 16r4772 16r7403 16r4773 16r6C42 16r4774 16r56DA 16r4775 16r914B 16r4776 16r6CC5 16r4777 16r8D8B 16r4778 16r533A 16r4779 16r86C6 16r477A 16r66F2 16r477B 16r8EAF 16r477C 16r5C48 16r477D 16r9A71 16r477E 16r6E20 16r4821 16r53D6 16r4822 16r5A36 16r4823 16r9F8B 16r4824 16r8DA3 16r4825 16r53BB 16r4826 16r5708 16r4827 16r98A7 16r4828 16r6743 16r4829 16r919B 16r482A 16r6CC9 16r482B 16r5168 16r482C 16r75CA 16r482D 16r62F3 16r482E 16r72AC 16r482F 16r5238 16r4830 16r529D 16r4831 16r7F3A 16r4832 16r7094 16r4833 16r7638 16r4834 16r5374 16r4835 16r9E4A 16r4836 16r69B7 16r4837 16r786E 16r4838 16r96C0 16r4839 16r88D9 16r483A 16r7FA4 16r483B 16r7136 16r483C 16r71C3 16r483D 16r5189 16r483E 16r67D3 16r483F 16r74E4 16r4840 16r58E4 16r4841 16r6518 16r4842 16r56B7 16r4843 16r8BA9 16r4844 16r9976 16r4845 16r6270 16r4846 16r7ED5 16r4847 16r60F9 16r4848 16r70ED 16r4849 16r58EC 16r484A 16r4EC1 16r484B 16r4EBA 16r484C 16r5FCD 16r484D 16r97E7 16r484E 16r4EFB 16r484F 16r8BA4 16r4850 16r5203 16r4851 16r598A 16r4852 16r7EAB 16r4853 16r6254 16r4854 16r4ECD 16r4855 16r65E5 16r4856 16r620E 16r4857 16r8338 16r4858 16r84C9 16r4859 16r8363 16r485A 16r878D 16r485B 16r7194 16r485C 16r6EB6 16r485D 16r5BB9 16r485E 16r7ED2 16r485F 16r5197 16r4860 16r63C9 16r4861 16r67D4 16r4862 16r8089 16r4863 16r8339 16r4864 16r8815 16r4865 16r5112 16r4866 16r5B7A 16r4867 16r5982 16r4868 16r8FB1 16r4869 16r4E73 16r486A 16r6C5D 16r486B 16r5165 16r486C 16r8925 16r486D 16r8F6F 16r486E 16r962E 16r486F 16r854A 16r4870 16r745E 16r4871 16r9510 16r4872 16r95F0 16r4873 16r6DA6 16r4874 16r82E5 16r4875 16r5F31 16r4876 16r6492 16r4877 16r6D12 16r4878 16r8428 16r4879 16r816E 16r487A 16r9CC3 16r487B 16r585E 16r487C 16r8D5B 16r487D 16r4E09 16r487E 16r53C1 16r4921 16r4F1E 16r4922 16r6563 16r4923 16r6851 16r4924 16r55D3 16r4925 16r4E27 16r4926 16r6414 16r4927 16r9A9A 16r4928 16r626B 16r4929 16r5AC2 16r492A 16r745F 16r492B 16r8272 16r492C 16r6DA9 16r492D 16r68EE 16r492E 16r50E7 16r492F 16r838E 16r4930 16r7802 16r4931 16r6740 16r4932 16r5239 16r4933 16r6C99 16r4934 16r7EB1 16r4935 16r50BB 16r4936 16r5565 16r4937 16r715E 16r4938 16r7B5B 16r4939 16r6652 16r493A 16r73CA 16r493B 16r82EB 16r493C 16r6749 16r493D 16r5C71 16r493E 16r5220 16r493F 16r717D 16r4940 16r886B 16r4941 16r95EA 16r4942 16r9655 16r4943 16r64C5 16r4944 16r8D61 16r4945 16r81B3 16r4946 16r5584 16r4947 16r6C55 16r4948 16r6247 16r4949 16r7F2E 16r494A 16r5892 16r494B 16r4F24 16r494C 16r5546 16r494D 16r8D4F 16r494E 16r664C 16r494F 16r4E0A 16r4950 16r5C1A 16r4951 16r88F3 16r4952 16r68A2 16r4953 16r634E 16r4954 16r7A0D 16r4955 16r70E7 16r4956 16r828D 16r4957 16r52FA 16r4958 16r97F6 16r4959 16r5C11 16r495A 16r54E8 16r495B 16r90B5 16r495C 16r7ECD 16r495D 16r5962 16r495E 16r8D4A 16r495F 16r86C7 16r4960 16r820C 16r4961 16r820D 16r4962 16r8D66 16r4963 16r6444 16r4964 16r5C04 16r4965 16r6151 16r4966 16r6D89 16r4967 16r793E 16r4968 16r8BBE 16r4969 16r7837 16r496A 16r7533 16r496B 16r547B 16r496C 16r4F38 16r496D 16r8EAB 16r496E 16r6DF1 16r496F 16r5A20 16r4970 16r7EC5 16r4971 16r795E 16r4972 16r6C88 16r4973 16r5BA1 16r4974 16r5A76 16r4975 16r751A 16r4976 16r80BE 16r4977 16r614E 16r4978 16r6E17 16r4979 16r58F0 16r497A 16r751F 16r497B 16r7525 16r497C 16r7272 16r497D 16r5347 16r497E 16r7EF3 16r4A21 16r7701 16r4A22 16r76DB 16r4A23 16r5269 16r4A24 16r80DC 16r4A25 16r5723 16r4A26 16r5E08 16r4A27 16r5931 16r4A28 16r72EE 16r4A29 16r65BD 16r4A2A 16r6E7F 16r4A2B 16r8BD7 16r4A2C 16r5C38 16r4A2D 16r8671 16r4A2E 16r5341 16r4A2F 16r77F3 16r4A30 16r62FE 16r4A31 16r65F6 16r4A32 16r4EC0 16r4A33 16r98DF 16r4A34 16r8680 16r4A35 16r5B9E 16r4A36 16r8BC6 16r4A37 16r53F2 16r4A38 16r77E2 16r4A39 16r4F7F 16r4A3A 16r5C4E 16r4A3B 16r9A76 16r4A3C 16r59CB 16r4A3D 16r5F0F 16r4A3E 16r793A 16r4A3F 16r58EB 16r4A40 16r4E16 16r4A41 16r67FF 16r4A42 16r4E8B 16r4A43 16r62ED 16r4A44 16r8A93 16r4A45 16r901D 16r4A46 16r52BF 16r4A47 16r662F 16r4A48 16r55DC 16r4A49 16r566C 16r4A4A 16r9002 16r4A4B 16r4ED5 16r4A4C 16r4F8D 16r4A4D 16r91CA 16r4A4E 16r9970 16r4A4F 16r6C0F 16r4A50 16r5E02 16r4A51 16r6043 16r4A52 16r5BA4 16r4A53 16r89C6 16r4A54 16r8BD5 16r4A55 16r6536 16r4A56 16r624B 16r4A57 16r9996 16r4A58 16r5B88 16r4A59 16r5BFF 16r4A5A 16r6388 16r4A5B 16r552E 16r4A5C 16r53D7 16r4A5D 16r7626 16r4A5E 16r517D 16r4A5F 16r852C 16r4A60 16r67A2 16r4A61 16r68B3 16r4A62 16r6B8A 16r4A63 16r6292 16r4A64 16r8F93 16r4A65 16r53D4 16r4A66 16r8212 16r4A67 16r6DD1 16r4A68 16r758F 16r4A69 16r4E66 16r4A6A 16r8D4E 16r4A6B 16r5B70 16r4A6C 16r719F 16r4A6D 16r85AF 16r4A6E 16r6691 16r4A6F 16r66D9 16r4A70 16r7F72 16r4A71 16r8700 16r4A72 16r9ECD 16r4A73 16r9F20 16r4A74 16r5C5E 16r4A75 16r672F 16r4A76 16r8FF0 16r4A77 16r6811 16r4A78 16r675F 16r4A79 16r620D 16r4A7A 16r7AD6 16r4A7B 16r5885 16r4A7C 16r5EB6 16r4A7D 16r6570 16r4A7E 16r6F31 16r4B21 16r6055 16r4B22 16r5237 16r4B23 16r800D 16r4B24 16r6454 16r4B25 16r8870 16r4B26 16r7529 16r4B27 16r5E05 16r4B28 16r6813 16r4B29 16r62F4 16r4B2A 16r971C 16r4B2B 16r53CC 16r4B2C 16r723D 16r4B2D 16r8C01 16r4B2E 16r6C34 16r4B2F 16r7761 16r4B30 16r7A0E 16r4B31 16r542E 16r4B32 16r77AC 16r4B33 16r987A 16r4B34 16r821C 16r4B35 16r8BF4 16r4B36 16r7855 16r4B37 16r6714 16r4B38 16r70C1 16r4B39 16r65AF 16r4B3A 16r6495 16r4B3B 16r5636 16r4B3C 16r601D 16r4B3D 16r79C1 16r4B3E 16r53F8 16r4B3F 16r4E1D 16r4B40 16r6B7B 16r4B41 16r8086 16r4B42 16r5BFA 16r4B43 16r55E3 16r4B44 16r56DB 16r4B45 16r4F3A 16r4B46 16r4F3C 16r4B47 16r9972 16r4B48 16r5DF3 16r4B49 16r677E 16r4B4A 16r8038 16r4B4B 16r6002 16r4B4C 16r9882 16r4B4D 16r9001 16r4B4E 16r5B8B 16r4B4F 16r8BBC 16r4B50 16r8BF5 16r4B51 16r641C 16r4B52 16r8258 16r4B53 16r64DE 16r4B54 16r55FD 16r4B55 16r82CF 16r4B56 16r9165 16r4B57 16r4FD7 16r4B58 16r7D20 16r4B59 16r901F 16r4B5A 16r7C9F 16r4B5B 16r50F3 16r4B5C 16r5851 16r4B5D 16r6EAF 16r4B5E 16r5BBF 16r4B5F 16r8BC9 16r4B60 16r8083 16r4B61 16r9178 16r4B62 16r849C 16r4B63 16r7B97 16r4B64 16r867D 16r4B65 16r968B 16r4B66 16r968F 16r4B67 16r7EE5 16r4B68 16r9AD3 16r4B69 16r788E 16r4B6A 16r5C81 16r4B6B 16r7A57 16r4B6C 16r9042 16r4B6D 16r96A7 16r4B6E 16r795F 16r4B6F 16r5B59 16r4B70 16r635F 16r4B71 16r7B0B 16r4B72 16r84D1 16r4B73 16r68AD 16r4B74 16r5506 16r4B75 16r7F29 16r4B76 16r7410 16r4B77 16r7D22 16r4B78 16r9501 16r4B79 16r6240 16r4B7A 16r584C 16r4B7B 16r4ED6 16r4B7C 16r5B83 16r4B7D 16r5979 16r4B7E 16r5854 16r4C21 16r736D 16r4C22 16r631E 16r4C23 16r8E4B 16r4C24 16r8E0F 16r4C25 16r80CE 16r4C26 16r82D4 16r4C27 16r62AC 16r4C28 16r53F0 16r4C29 16r6CF0 16r4C2A 16r915E 16r4C2B 16r592A 16r4C2C 16r6001 16r4C2D 16r6C70 16r4C2E 16r574D 16r4C2F 16r644A 16r4C30 16r8D2A 16r4C31 16r762B 16r4C32 16r6EE9 16r4C33 16r575B 16r4C34 16r6A80 16r4C35 16r75F0 16r4C36 16r6F6D 16r4C37 16r8C2D 16r4C38 16r8C08 16r4C39 16r5766 16r4C3A 16r6BEF 16r4C3B 16r8892 16r4C3C 16r78B3 16r4C3D 16r63A2 16r4C3E 16r53F9 16r4C3F 16r70AD 16r4C40 16r6C64 16r4C41 16r5858 16r4C42 16r642A 16r4C43 16r5802 16r4C44 16r68E0 16r4C45 16r819B 16r4C46 16r5510 16r4C47 16r7CD6 16r4C48 16r5018 16r4C49 16r8EBA 16r4C4A 16r6DCC 16r4C4B 16r8D9F 16r4C4C 16r70EB 16r4C4D 16r638F 16r4C4E 16r6D9B 16r4C4F 16r6ED4 16r4C50 16r7EE6 16r4C51 16r8404 16r4C52 16r6843 16r4C53 16r9003 16r4C54 16r6DD8 16r4C55 16r9676 16r4C56 16r8BA8 16r4C57 16r5957 16r4C58 16r7279 16r4C59 16r85E4 16r4C5A 16r817E 16r4C5B 16r75BC 16r4C5C 16r8A8A 16r4C5D 16r68AF 16r4C5E 16r5254 16r4C5F 16r8E22 16r4C60 16r9511 16r4C61 16r63D0 16r4C62 16r9898 16r4C63 16r8E44 16r4C64 16r557C 16r4C65 16r4F53 16r4C66 16r66FF 16r4C67 16r568F 16r4C68 16r60D5 16r4C69 16r6D95 16r4C6A 16r5243 16r4C6B 16r5C49 16r4C6C 16r5929 16r4C6D 16r6DFB 16r4C6E 16r586B 16r4C6F 16r7530 16r4C70 16r751C 16r4C71 16r606C 16r4C72 16r8214 16r4C73 16r8146 16r4C74 16r6311 16r4C75 16r6761 16r4C76 16r8FE2 16r4C77 16r773A 16r4C78 16r8DF3 16r4C79 16r8D34 16r4C7A 16r94C1 16r4C7B 16r5E16 16r4C7C 16r5385 16r4C7D 16r542C 16r4C7E 16r70C3 16r4D21 16r6C40 16r4D22 16r5EF7 16r4D23 16r505C 16r4D24 16r4EAD 16r4D25 16r5EAD 16r4D26 16r633A 16r4D27 16r8247 16r4D28 16r901A 16r4D29 16r6850 16r4D2A 16r916E 16r4D2B 16r77B3 16r4D2C 16r540C 16r4D2D 16r94DC 16r4D2E 16r5F64 16r4D2F 16r7AE5 16r4D30 16r6876 16r4D31 16r6345 16r4D32 16r7B52 16r4D33 16r7EDF 16r4D34 16r75DB 16r4D35 16r5077 16r4D36 16r6295 16r4D37 16r5934 16r4D38 16r900F 16r4D39 16r51F8 16r4D3A 16r79C3 16r4D3B 16r7A81 16r4D3C 16r56FE 16r4D3D 16r5F92 16r4D3E 16r9014 16r4D3F 16r6D82 16r4D40 16r5C60 16r4D41 16r571F 16r4D42 16r5410 16r4D43 16r5154 16r4D44 16r6E4D 16r4D45 16r56E2 16r4D46 16r63A8 16r4D47 16r9893 16r4D48 16r817F 16r4D49 16r8715 16r4D4A 16r892A 16r4D4B 16r9000 16r4D4C 16r541E 16r4D4D 16r5C6F 16r4D4E 16r81C0 16r4D4F 16r62D6 16r4D50 16r6258 16r4D51 16r8131 16r4D52 16r9E35 16r4D53 16r9640 16r4D54 16r9A6E 16r4D55 16r9A7C 16r4D56 16r692D 16r4D57 16r59A5 16r4D58 16r62D3 16r4D59 16r553E 16r4D5A 16r6316 16r4D5B 16r54C7 16r4D5C 16r86D9 16r4D5D 16r6D3C 16r4D5E 16r5A03 16r4D5F 16r74E6 16r4D60 16r889C 16r4D61 16r6B6A 16r4D62 16r5916 16r4D63 16r8C4C 16r4D64 16r5F2F 16r4D65 16r6E7E 16r4D66 16r73A9 16r4D67 16r987D 16r4D68 16r4E38 16r4D69 16r70F7 16r4D6A 16r5B8C 16r4D6B 16r7897 16r4D6C 16r633D 16r4D6D 16r665A 16r4D6E 16r7696 16r4D6F 16r60CB 16r4D70 16r5B9B 16r4D71 16r5A49 16r4D72 16r4E07 16r4D73 16r8155 16r4D74 16r6C6A 16r4D75 16r738B 16r4D76 16r4EA1 16r4D77 16r6789 16r4D78 16r7F51 16r4D79 16r5F80 16r4D7A 16r65FA 16r4D7B 16r671B 16r4D7C 16r5FD8 16r4D7D 16r5984 16r4D7E 16r5A01 16r4E21 16r5DCD 16r4E22 16r5FAE 16r4E23 16r5371 16r4E24 16r97E6 16r4E25 16r8FDD 16r4E26 16r6845 16r4E27 16r56F4 16r4E28 16r552F 16r4E29 16r60DF 16r4E2A 16r4E3A 16r4E2B 16r6F4D 16r4E2C 16r7EF4 16r4E2D 16r82C7 16r4E2E 16r840E 16r4E2F 16r59D4 16r4E30 16r4F1F 16r4E31 16r4F2A 16r4E32 16r5C3E 16r4E33 16r7EAC 16r4E34 16r672A 16r4E35 16r851A 16r4E36 16r5473 16r4E37 16r754F 16r4E38 16r80C3 16r4E39 16r5582 16r4E3A 16r9B4F 16r4E3B 16r4F4D 16r4E3C 16r6E2D 16r4E3D 16r8C13 16r4E3E 16r5C09 16r4E3F 16r6170 16r4E40 16r536B 16r4E41 16r761F 16r4E42 16r6E29 16r4E43 16r868A 16r4E44 16r6587 16r4E45 16r95FB 16r4E46 16r7EB9 16r4E47 16r543B 16r4E48 16r7A33 16r4E49 16r7D0A 16r4E4A 16r95EE 16r4E4B 16r55E1 16r4E4C 16r7FC1 16r4E4D 16r74EE 16r4E4E 16r631D 16r4E4F 16r8717 16r4E50 16r6DA1 16r4E51 16r7A9D 16r4E52 16r6211 16r4E53 16r65A1 16r4E54 16r5367 16r4E55 16r63E1 16r4E56 16r6C83 16r4E57 16r5DEB 16r4E58 16r545C 16r4E59 16r94A8 16r4E5A 16r4E4C 16r4E5B 16r6C61 16r4E5C 16r8BEC 16r4E5D 16r5C4B 16r4E5E 16r65E0 16r4E5F 16r829C 16r4E60 16r68A7 16r4E61 16r543E 16r4E62 16r5434 16r4E63 16r6BCB 16r4E64 16r6B66 16r4E65 16r4E94 16r4E66 16r6342 16r4E67 16r5348 16r4E68 16r821E 16r4E69 16r4F0D 16r4E6A 16r4FAE 16r4E6B 16r575E 16r4E6C 16r620A 16r4E6D 16r96FE 16r4E6E 16r6664 16r4E6F 16r7269 16r4E70 16r52FF 16r4E71 16r52A1 16r4E72 16r609F 16r4E73 16r8BEF 16r4E74 16r6614 16r4E75 16r7199 16r4E76 16r6790 16r4E77 16r897F 16r4E78 16r7852 16r4E79 16r77FD 16r4E7A 16r6670 16r4E7B 16r563B 16r4E7C 16r5438 16r4E7D 16r9521 16r4E7E 16r727A 16r4F21 16r7A00 16r4F22 16r606F 16r4F23 16r5E0C 16r4F24 16r6089 16r4F25 16r819D 16r4F26 16r5915 16r4F27 16r60DC 16r4F28 16r7184 16r4F29 16r70EF 16r4F2A 16r6EAA 16r4F2B 16r6C50 16r4F2C 16r7280 16r4F2D 16r6A84 16r4F2E 16r88AD 16r4F2F 16r5E2D 16r4F30 16r4E60 16r4F31 16r5AB3 16r4F32 16r559C 16r4F33 16r94E3 16r4F34 16r6D17 16r4F35 16r7CFB 16r4F36 16r9699 16r4F37 16r620F 16r4F38 16r7EC6 16r4F39 16r778E 16r4F3A 16r867E 16r4F3B 16r5323 16r4F3C 16r971E 16r4F3D 16r8F96 16r4F3E 16r6687 16r4F3F 16r5CE1 16r4F40 16r4FA0 16r4F41 16r72ED 16r4F42 16r4E0B 16r4F43 16r53A6 16r4F44 16r590F 16r4F45 16r5413 16r4F46 16r6380 16r4F47 16r9528 16r4F48 16r5148 16r4F49 16r4ED9 16r4F4A 16r9C9C 16r4F4B 16r7EA4 16r4F4C 16r54B8 16r4F4D 16r8D24 16r4F4E 16r8854 16r4F4F 16r8237 16r4F50 16r95F2 16r4F51 16r6D8E 16r4F52 16r5F26 16r4F53 16r5ACC 16r4F54 16r663E 16r4F55 16r9669 16r4F56 16r73B0 16r4F57 16r732E 16r4F58 16r53BF 16r4F59 16r817A 16r4F5A 16r9985 16r4F5B 16r7FA1 16r4F5C 16r5BAA 16r4F5D 16r9677 16r4F5E 16r9650 16r4F5F 16r7EBF 16r4F60 16r76F8 16r4F61 16r53A2 16r4F62 16r9576 16r4F63 16r9999 16r4F64 16r7BB1 16r4F65 16r8944 16r4F66 16r6E58 16r4F67 16r4E61 16r4F68 16r7FD4 16r4F69 16r7965 16r4F6A 16r8BE6 16r4F6B 16r60F3 16r4F6C 16r54CD 16r4F6D 16r4EAB 16r4F6E 16r9879 16r4F6F 16r5DF7 16r4F70 16r6A61 16r4F71 16r50CF 16r4F72 16r5411 16r4F73 16r8C61 16r4F74 16r8427 16r4F75 16r785D 16r4F76 16r9704 16r4F77 16r524A 16r4F78 16r54EE 16r4F79 16r56A3 16r4F7A 16r9500 16r4F7B 16r6D88 16r4F7C 16r5BB5 16r4F7D 16r6DC6 16r4F7E 16r6653 16r5021 16r5C0F 16r5022 16r5B5D 16r5023 16r6821 16r5024 16r8096 16r5025 16r5578 16r5026 16r7B11 16r5027 16r6548 16r5028 16r6954 16r5029 16r4E9B 16r502A 16r6B47 16r502B 16r874E 16r502C 16r978B 16r502D 16r534F 16r502E 16r631F 16r502F 16r643A 16r5030 16r90AA 16r5031 16r659C 16r5032 16r80C1 16r5033 16r8C10 16r5034 16r5199 16r5035 16r68B0 16r5036 16r5378 16r5037 16r87F9 16r5038 16r61C8 16r5039 16r6CC4 16r503A 16r6CFB 16r503B 16r8C22 16r503C 16r5C51 16r503D 16r85AA 16r503E 16r82AF 16r503F 16r950C 16r5040 16r6B23 16r5041 16r8F9B 16r5042 16r65B0 16r5043 16r5FFB 16r5044 16r5FC3 16r5045 16r4FE1 16r5046 16r8845 16r5047 16r661F 16r5048 16r8165 16r5049 16r7329 16r504A 16r60FA 16r504B 16r5174 16r504C 16r5211 16r504D 16r578B 16r504E 16r5F62 16r504F 16r90A2 16r5050 16r884C 16r5051 16r9192 16r5052 16r5E78 16r5053 16r674F 16r5054 16r6027 16r5055 16r59D3 16r5056 16r5144 16r5057 16r51F6 16r5058 16r80F8 16r5059 16r5308 16r505A 16r6C79 16r505B 16r96C4 16r505C 16r718A 16r505D 16r4F11 16r505E 16r4FEE 16r505F 16r7F9E 16r5060 16r673D 16r5061 16r55C5 16r5062 16r9508 16r5063 16r79C0 16r5064 16r8896 16r5065 16r7EE3 16r5066 16r589F 16r5067 16r620C 16r5068 16r9700 16r5069 16r865A 16r506A 16r5618 16r506B 16r987B 16r506C 16r5F90 16r506D 16r8BB8 16r506E 16r84C4 16r506F 16r9157 16r5070 16r53D9 16r5071 16r65ED 16r5072 16r5E8F 16r5073 16r755C 16r5074 16r6064 16r5075 16r7D6E 16r5076 16r5A7F 16r5077 16r7EEA 16r5078 16r7EED 16r5079 16r8F69 16r507A 16r55A7 16r507B 16r5BA3 16r507C 16r60AC 16r507D 16r65CB 16r507E 16r7384 16r5121 16r9009 16r5122 16r7663 16r5123 16r7729 16r5124 16r7EDA 16r5125 16r9774 16r5126 16r859B 16r5127 16r5B66 16r5128 16r7A74 16r5129 16r96EA 16r512A 16r8840 16r512B 16r52CB 16r512C 16r718F 16r512D 16r5FAA 16r512E 16r65EC 16r512F 16r8BE2 16r5130 16r5BFB 16r5131 16r9A6F 16r5132 16r5DE1 16r5133 16r6B89 16r5134 16r6C5B 16r5135 16r8BAD 16r5136 16r8BAF 16r5137 16r900A 16r5138 16r8FC5 16r5139 16r538B 16r513A 16r62BC 16r513B 16r9E26 16r513C 16r9E2D 16r513D 16r5440 16r513E 16r4E2B 16r513F 16r82BD 16r5140 16r7259 16r5141 16r869C 16r5142 16r5D16 16r5143 16r8859 16r5144 16r6DAF 16r5145 16r96C5 16r5146 16r54D1 16r5147 16r4E9A 16r5148 16r8BB6 16r5149 16r7109 16r514A 16r54BD 16r514B 16r9609 16r514C 16r70DF 16r514D 16r6DF9 16r514E 16r76D0 16r514F 16r4E25 16r5150 16r7814 16r5151 16r8712 16r5152 16r5CA9 16r5153 16r5EF6 16r5154 16r8A00 16r5155 16r989C 16r5156 16r960E 16r5157 16r708E 16r5158 16r6CBF 16r5159 16r5944 16r515A 16r63A9 16r515B 16r773C 16r515C 16r884D 16r515D 16r6F14 16r515E 16r8273 16r515F 16r5830 16r5160 16r71D5 16r5161 16r538C 16r5162 16r781A 16r5163 16r96C1 16r5164 16r5501 16r5165 16r5F66 16r5166 16r7130 16r5167 16r5BB4 16r5168 16r8C1A 16r5169 16r9A8C 16r516A 16r6B83 16r516B 16r592E 16r516C 16r9E2F 16r516D 16r79E7 16r516E 16r6768 16r516F 16r626C 16r5170 16r4F6F 16r5171 16r75A1 16r5172 16r7F8A 16r5173 16r6D0B 16r5174 16r9633 16r5175 16r6C27 16r5176 16r4EF0 16r5177 16r75D2 16r5178 16r517B 16r5179 16r6837 16r517A 16r6F3E 16r517B 16r9080 16r517C 16r8170 16r517D 16r5996 16r517E 16r7476 16r5221 16r6447 16r5222 16r5C27 16r5223 16r9065 16r5224 16r7A91 16r5225 16r8C23 16r5226 16r59DA 16r5227 16r54AC 16r5228 16r8200 16r5229 16r836F 16r522A 16r8981 16r522B 16r8000 16r522C 16r6930 16r522D 16r564E 16r522E 16r8036 16r522F 16r7237 16r5230 16r91CE 16r5231 16r51B6 16r5232 16r4E5F 16r5233 16r9875 16r5234 16r6396 16r5235 16r4E1A 16r5236 16r53F6 16r5237 16r66F3 16r5238 16r814B 16r5239 16r591C 16r523A 16r6DB2 16r523B 16r4E00 16r523C 16r58F9 16r523D 16r533B 16r523E 16r63D6 16r523F 16r94F1 16r5240 16r4F9D 16r5241 16r4F0A 16r5242 16r8863 16r5243 16r9890 16r5244 16r5937 16r5245 16r9057 16r5246 16r79FB 16r5247 16r4EEA 16r5248 16r80F0 16r5249 16r7591 16r524A 16r6C82 16r524B 16r5B9C 16r524C 16r59E8 16r524D 16r5F5D 16r524E 16r6905 16r524F 16r8681 16r5250 16r501A 16r5251 16r5DF2 16r5252 16r4E59 16r5253 16r77E3 16r5254 16r4EE5 16r5255 16r827A 16r5256 16r6291 16r5257 16r6613 16r5258 16r9091 16r5259 16r5C79 16r525A 16r4EBF 16r525B 16r5F79 16r525C 16r81C6 16r525D 16r9038 16r525E 16r8084 16r525F 16r75AB 16r5260 16r4EA6 16r5261 16r88D4 16r5262 16r610F 16r5263 16r6BC5 16r5264 16r5FC6 16r5265 16r4E49 16r5266 16r76CA 16r5267 16r6EA2 16r5268 16r8BE3 16r5269 16r8BAE 16r526A 16r8C0A 16r526B 16r8BD1 16r526C 16r5F02 16r526D 16r7FFC 16r526E 16r7FCC 16r526F 16r7ECE 16r5270 16r8335 16r5271 16r836B 16r5272 16r56E0 16r5273 16r6BB7 16r5274 16r97F3 16r5275 16r9634 16r5276 16r59FB 16r5277 16r541F 16r5278 16r94F6 16r5279 16r6DEB 16r527A 16r5BC5 16r527B 16r996E 16r527C 16r5C39 16r527D 16r5F15 16r527E 16r9690 16r5321 16r5370 16r5322 16r82F1 16r5323 16r6A31 16r5324 16r5A74 16r5325 16r9E70 16r5326 16r5E94 16r5327 16r7F28 16r5328 16r83B9 16r5329 16r8424 16r532A 16r8425 16r532B 16r8367 16r532C 16r8747 16r532D 16r8FCE 16r532E 16r8D62 16r532F 16r76C8 16r5330 16r5F71 16r5331 16r9896 16r5332 16r786C 16r5333 16r6620 16r5334 16r54DF 16r5335 16r62E5 16r5336 16r4F63 16r5337 16r81C3 16r5338 16r75C8 16r5339 16r5EB8 16r533A 16r96CD 16r533B 16r8E0A 16r533C 16r86F9 16r533D 16r548F 16r533E 16r6CF3 16r533F 16r6D8C 16r5340 16r6C38 16r5341 16r607F 16r5342 16r52C7 16r5343 16r7528 16r5344 16r5E7D 16r5345 16r4F18 16r5346 16r60A0 16r5347 16r5FE7 16r5348 16r5C24 16r5349 16r7531 16r534A 16r90AE 16r534B 16r94C0 16r534C 16r72B9 16r534D 16r6CB9 16r534E 16r6E38 16r534F 16r9149 16r5350 16r6709 16r5351 16r53CB 16r5352 16r53F3 16r5353 16r4F51 16r5354 16r91C9 16r5355 16r8BF1 16r5356 16r53C8 16r5357 16r5E7C 16r5358 16r8FC2 16r5359 16r6DE4 16r535A 16r4E8E 16r535B 16r76C2 16r535C 16r6986 16r535D 16r865E 16r535E 16r611A 16r535F 16r8206 16r5360 16r4F59 16r5361 16r4FDE 16r5362 16r903E 16r5363 16r9C7C 16r5364 16r6109 16r5365 16r6E1D 16r5366 16r6E14 16r5367 16r9685 16r5368 16r4E88 16r5369 16r5A31 16r536A 16r96E8 16r536B 16r4E0E 16r536C 16r5C7F 16r536D 16r79B9 16r536E 16r5B87 16r536F 16r8BED 16r5370 16r7FBD 16r5371 16r7389 16r5372 16r57DF 16r5373 16r828B 16r5374 16r90C1 16r5375 16r5401 16r5376 16r9047 16r5377 16r55BB 16r5378 16r5CEA 16r5379 16r5FA1 16r537A 16r6108 16r537B 16r6B32 16r537C 16r72F1 16r537D 16r80B2 16r537E 16r8A89 16r5421 16r6D74 16r5422 16r5BD3 16r5423 16r88D5 16r5424 16r9884 16r5425 16r8C6B 16r5426 16r9A6D 16r5427 16r9E33 16r5428 16r6E0A 16r5429 16r51A4 16r542A 16r5143 16r542B 16r57A3 16r542C 16r8881 16r542D 16r539F 16r542E 16r63F4 16r542F 16r8F95 16r5430 16r56ED 16r5431 16r5458 16r5432 16r5706 16r5433 16r733F 16r5434 16r6E90 16r5435 16r7F18 16r5436 16r8FDC 16r5437 16r82D1 16r5438 16r613F 16r5439 16r6028 16r543A 16r9662 16r543B 16r66F0 16r543C 16r7EA6 16r543D 16r8D8A 16r543E 16r8DC3 16r543F 16r94A5 16r5440 16r5CB3 16r5441 16r7CA4 16r5442 16r6708 16r5443 16r60A6 16r5444 16r9605 16r5445 16r8018 16r5446 16r4E91 16r5447 16r90E7 16r5448 16r5300 16r5449 16r9668 16r544A 16r5141 16r544B 16r8FD0 16r544C 16r8574 16r544D 16r915D 16r544E 16r6655 16r544F 16r97F5 16r5450 16r5B55 16r5451 16r531D 16r5452 16r7838 16r5453 16r6742 16r5454 16r683D 16r5455 16r54C9 16r5456 16r707E 16r5457 16r5BB0 16r5458 16r8F7D 16r5459 16r518D 16r545A 16r5728 16r545B 16r54B1 16r545C 16r6512 16r545D 16r6682 16r545E 16r8D5E 16r545F 16r8D43 16r5460 16r810F 16r5461 16r846C 16r5462 16r906D 16r5463 16r7CDF 16r5464 16r51FF 16r5465 16r85FB 16r5466 16r67A3 16r5467 16r65E9 16r5468 16r6FA1 16r5469 16r86A4 16r546A 16r8E81 16r546B 16r566A 16r546C 16r9020 16r546D 16r7682 16r546E 16r7076 16r546F 16r71E5 16r5470 16r8D23 16r5471 16r62E9 16r5472 16r5219 16r5473 16r6CFD 16r5474 16r8D3C 16r5475 16r600E 16r5476 16r589E 16r5477 16r618E 16r5478 16r66FE 16r5479 16r8D60 16r547A 16r624E 16r547B 16r55B3 16r547C 16r6E23 16r547D 16r672D 16r547E 16r8F67 16r5521 16r94E1 16r5522 16r95F8 16r5523 16r7728 16r5524 16r6805 16r5525 16r69A8 16r5526 16r548B 16r5527 16r4E4D 16r5528 16r70B8 16r5529 16r8BC8 16r552A 16r6458 16r552B 16r658B 16r552C 16r5B85 16r552D 16r7A84 16r552E 16r503A 16r552F 16r5BE8 16r5530 16r77BB 16r5531 16r6BE1 16r5532 16r8A79 16r5533 16r7C98 16r5534 16r6CBE 16r5535 16r76CF 16r5536 16r65A9 16r5537 16r8F97 16r5538 16r5D2D 16r5539 16r5C55 16r553A 16r8638 16r553B 16r6808 16r553C 16r5360 16r553D 16r6218 16r553E 16r7AD9 16r553F 16r6E5B 16r5540 16r7EFD 16r5541 16r6A1F 16r5542 16r7AE0 16r5543 16r5F70 16r5544 16r6F33 16r5545 16r5F20 16r5546 16r638C 16r5547 16r6DA8 16r5548 16r6756 16r5549 16r4E08 16r554A 16r5E10 16r554B 16r8D26 16r554C 16r4ED7 16r554D 16r80C0 16r554E 16r7634 16r554F 16r969C 16r5550 16r62DB 16r5551 16r662D 16r5552 16r627E 16r5553 16r6CBC 16r5554 16r8D75 16r5555 16r7167 16r5556 16r7F69 16r5557 16r5146 16r5558 16r8087 16r5559 16r53EC 16r555A 16r906E 16r555B 16r6298 16r555C 16r54F2 16r555D 16r86F0 16r555E 16r8F99 16r555F 16r8005 16r5560 16r9517 16r5561 16r8517 16r5562 16r8FD9 16r5563 16r6D59 16r5564 16r73CD 16r5565 16r659F 16r5566 16r771F 16r5567 16r7504 16r5568 16r7827 16r5569 16r81FB 16r556A 16r8D1E 16r556B 16r9488 16r556C 16r4FA6 16r556D 16r6795 16r556E 16r75B9 16r556F 16r8BCA 16r5570 16r9707 16r5571 16r632F 16r5572 16r9547 16r5573 16r9635 16r5574 16r84B8 16r5575 16r6323 16r5576 16r7741 16r5577 16r5F81 16r5578 16r72F0 16r5579 16r4E89 16r557A 16r6014 16r557B 16r6574 16r557C 16r62EF 16r557D 16r6B63 16r557E 16r653F 16r5621 16r5E27 16r5622 16r75C7 16r5623 16r90D1 16r5624 16r8BC1 16r5625 16r829D 16r5626 16r679D 16r5627 16r652F 16r5628 16r5431 16r5629 16r8718 16r562A 16r77E5 16r562B 16r80A2 16r562C 16r8102 16r562D 16r6C41 16r562E 16r4E4B 16r562F 16r7EC7 16r5630 16r804C 16r5631 16r76F4 16r5632 16r690D 16r5633 16r6B96 16r5634 16r6267 16r5635 16r503C 16r5636 16r4F84 16r5637 16r5740 16r5638 16r6307 16r5639 16r6B62 16r563A 16r8DBE 16r563B 16r53EA 16r563C 16r65E8 16r563D 16r7EB8 16r563E 16r5FD7 16r563F 16r631A 16r5640 16r63B7 16r5641 16r81F3 16r5642 16r81F4 16r5643 16r7F6E 16r5644 16r5E1C 16r5645 16r5CD9 16r5646 16r5236 16r5647 16r667A 16r5648 16r79E9 16r5649 16r7A1A 16r564A 16r8D28 16r564B 16r7099 16r564C 16r75D4 16r564D 16r6EDE 16r564E 16r6CBB 16r564F 16r7A92 16r5650 16r4E2D 16r5651 16r76C5 16r5652 16r5FE0 16r5653 16r949F 16r5654 16r8877 16r5655 16r7EC8 16r5656 16r79CD 16r5657 16r80BF 16r5658 16r91CD 16r5659 16r4EF2 16r565A 16r4F17 16r565B 16r821F 16r565C 16r5468 16r565D 16r5DDE 16r565E 16r6D32 16r565F 16r8BCC 16r5660 16r7CA5 16r5661 16r8F74 16r5662 16r8098 16r5663 16r5E1A 16r5664 16r5492 16r5665 16r76B1 16r5666 16r5B99 16r5667 16r663C 16r5668 16r9AA4 16r5669 16r73E0 16r566A 16r682A 16r566B 16r86DB 16r566C 16r6731 16r566D 16r732A 16r566E 16r8BF8 16r566F 16r8BDB 16r5670 16r9010 16r5671 16r7AF9 16r5672 16r70DB 16r5673 16r716E 16r5674 16r62C4 16r5675 16r77A9 16r5676 16r5631 16r5677 16r4E3B 16r5678 16r8457 16r5679 16r67F1 16r567A 16r52A9 16r567B 16r86C0 16r567C 16r8D2E 16r567D 16r94F8 16r567E 16r7B51 16r5721 16r4F4F 16r5722 16r6CE8 16r5723 16r795D 16r5724 16r9A7B 16r5725 16r6293 16r5726 16r722A 16r5727 16r62FD 16r5728 16r4E13 16r5729 16r7816 16r572A 16r8F6C 16r572B 16r64B0 16r572C 16r8D5A 16r572D 16r7BC6 16r572E 16r6869 16r572F 16r5E84 16r5730 16r88C5 16r5731 16r5986 16r5732 16r649E 16r5733 16r58EE 16r5734 16r72B6 16r5735 16r690E 16r5736 16r9525 16r5737 16r8FFD 16r5738 16r8D58 16r5739 16r5760 16r573A 16r7F00 16r573B 16r8C06 16r573C 16r51C6 16r573D 16r6349 16r573E 16r62D9 16r573F 16r5353 16r5740 16r684C 16r5741 16r7422 16r5742 16r8301 16r5743 16r914C 16r5744 16r5544 16r5745 16r7740 16r5746 16r707C 16r5747 16r6D4A 16r5748 16r5179 16r5749 16r54A8 16r574A 16r8D44 16r574B 16r59FF 16r574C 16r6ECB 16r574D 16r6DC4 16r574E 16r5B5C 16r574F 16r7D2B 16r5750 16r4ED4 16r5751 16r7C7D 16r5752 16r6ED3 16r5753 16r5B50 16r5754 16r81EA 16r5755 16r6E0D 16r5756 16r5B57 16r5757 16r9B03 16r5758 16r68D5 16r5759 16r8E2A 16r575A 16r5B97 16r575B 16r7EFC 16r575C 16r603B 16r575D 16r7EB5 16r575E 16r90B9 16r575F 16r8D70 16r5760 16r594F 16r5761 16r63CD 16r5762 16r79DF 16r5763 16r8DB3 16r5764 16r5352 16r5765 16r65CF 16r5766 16r7956 16r5767 16r8BC5 16r5768 16r963B 16r5769 16r7EC4 16r576A 16r94BB 16r576B 16r7E82 16r576C 16r5634 16r576D 16r9189 16r576E 16r6700 16r576F 16r7F6A 16r5770 16r5C0A 16r5771 16r9075 16r5772 16r6628 16r5773 16r5DE6 16r5774 16r4F50 16r5775 16r67DE 16r5776 16r505A 16r5777 16r4F5C 16r5778 16r5750 16r5779 16r5EA7 16r5821 16r4E8D 16r5822 16r4E0C 16r5823 16r5140 16r5824 16r4E10 16r5825 16r5EFF 16r5826 16r5345 16r5827 16r4E15 16r5828 16r4E98 16r5829 16r4E1E 16r582A 16r9B32 16r582B 16r5B6C 16r582C 16r5669 16r582D 16r4E28 16r582E 16r79BA 16r582F 16r4E3F 16r5830 16r5315 16r5831 16r4E47 16r5832 16r592D 16r5833 16r723B 16r5834 16r536E 16r5835 16r6C10 16r5836 16r56DF 16r5837 16r80E4 16r5838 16r9997 16r5839 16r6BD3 16r583A 16r777E 16r583B 16r9F17 16r583C 16r4E36 16r583D 16r4E9F 16r583E 16r9F10 16r583F 16r4E5C 16r5840 16r4E69 16r5841 16r4E93 16r5842 16r8288 16r5843 16r5B5B 16r5844 16r556C 16r5845 16r560F 16r5846 16r4EC4 16r5847 16r538D 16r5848 16r539D 16r5849 16r53A3 16r584A 16r53A5 16r584B 16r53AE 16r584C 16r9765 16r584D 16r8D5D 16r584E 16r531A 16r584F 16r53F5 16r5850 16r5326 16r5851 16r532E 16r5852 16r533E 16r5853 16r8D5C 16r5854 16r5366 16r5855 16r5363 16r5856 16r5202 16r5857 16r5208 16r5858 16r520E 16r5859 16r522D 16r585A 16r5233 16r585B 16r523F 16r585C 16r5240 16r585D 16r524C 16r585E 16r525E 16r585F 16r5261 16r5860 16r525C 16r5861 16r84AF 16r5862 16r527D 16r5863 16r5282 16r5864 16r5281 16r5865 16r5290 16r5866 16r5293 16r5867 16r5182 16r5868 16r7F54 16r5869 16r4EBB 16r586A 16r4EC3 16r586B 16r4EC9 16r586C 16r4EC2 16r586D 16r4EE8 16r586E 16r4EE1 16r586F 16r4EEB 16r5870 16r4EDE 16r5871 16r4F1B 16r5872 16r4EF3 16r5873 16r4F22 16r5874 16r4F64 16r5875 16r4EF5 16r5876 16r4F25 16r5877 16r4F27 16r5878 16r4F09 16r5879 16r4F2B 16r587A 16r4F5E 16r587B 16r4F67 16r587C 16r6538 16r587D 16r4F5A 16r587E 16r4F5D 16r5921 16r4F5F 16r5922 16r4F57 16r5923 16r4F32 16r5924 16r4F3D 16r5925 16r4F76 16r5926 16r4F74 16r5927 16r4F91 16r5928 16r4F89 16r5929 16r4F83 16r592A 16r4F8F 16r592B 16r4F7E 16r592C 16r4F7B 16r592D 16r4FAA 16r592E 16r4F7C 16r592F 16r4FAC 16r5930 16r4F94 16r5931 16r4FE6 16r5932 16r4FE8 16r5933 16r4FEA 16r5934 16r4FC5 16r5935 16r4FDA 16r5936 16r4FE3 16r5937 16r4FDC 16r5938 16r4FD1 16r5939 16r4FDF 16r593A 16r4FF8 16r593B 16r5029 16r593C 16r504C 16r593D 16r4FF3 16r593E 16r502C 16r593F 16r500F 16r5940 16r502E 16r5941 16r502D 16r5942 16r4FFE 16r5943 16r501C 16r5944 16r500C 16r5945 16r5025 16r5946 16r5028 16r5947 16r507E 16r5948 16r5043 16r5949 16r5055 16r594A 16r5048 16r594B 16r504E 16r594C 16r506C 16r594D 16r507B 16r594E 16r50A5 16r594F 16r50A7 16r5950 16r50A9 16r5951 16r50BA 16r5952 16r50D6 16r5953 16r5106 16r5954 16r50ED 16r5955 16r50EC 16r5956 16r50E6 16r5957 16r50EE 16r5958 16r5107 16r5959 16r510B 16r595A 16r4EDD 16r595B 16r6C3D 16r595C 16r4F58 16r595D 16r4F65 16r595E 16r4FCE 16r595F 16r9FA0 16r5960 16r6C46 16r5961 16r7C74 16r5962 16r516E 16r5963 16r5DFD 16r5964 16r9EC9 16r5965 16r9998 16r5966 16r5181 16r5967 16r5914 16r5968 16r52F9 16r5969 16r530D 16r596A 16r8A07 16r596B 16r5310 16r596C 16r51EB 16r596D 16r5919 16r596E 16r5155 16r596F 16r4EA0 16r5970 16r5156 16r5971 16r4EB3 16r5972 16r886E 16r5973 16r88A4 16r5974 16r4EB5 16r5975 16r8114 16r5976 16r88D2 16r5977 16r7980 16r5978 16r5B34 16r5979 16r8803 16r597A 16r7FB8 16r597B 16r51AB 16r597C 16r51B1 16r597D 16r51BD 16r597E 16r51BC 16r5A21 16r51C7 16r5A22 16r5196 16r5A23 16r51A2 16r5A24 16r51A5 16r5A25 16r8BA0 16r5A26 16r8BA6 16r5A27 16r8BA7 16r5A28 16r8BAA 16r5A29 16r8BB4 16r5A2A 16r8BB5 16r5A2B 16r8BB7 16r5A2C 16r8BC2 16r5A2D 16r8BC3 16r5A2E 16r8BCB 16r5A2F 16r8BCF 16r5A30 16r8BCE 16r5A31 16r8BD2 16r5A32 16r8BD3 16r5A33 16r8BD4 16r5A34 16r8BD6 16r5A35 16r8BD8 16r5A36 16r8BD9 16r5A37 16r8BDC 16r5A38 16r8BDF 16r5A39 16r8BE0 16r5A3A 16r8BE4 16r5A3B 16r8BE8 16r5A3C 16r8BE9 16r5A3D 16r8BEE 16r5A3E 16r8BF0 16r5A3F 16r8BF3 16r5A40 16r8BF6 16r5A41 16r8BF9 16r5A42 16r8BFC 16r5A43 16r8BFF 16r5A44 16r8C00 16r5A45 16r8C02 16r5A46 16r8C04 16r5A47 16r8C07 16r5A48 16r8C0C 16r5A49 16r8C0F 16r5A4A 16r8C11 16r5A4B 16r8C12 16r5A4C 16r8C14 16r5A4D 16r8C15 16r5A4E 16r8C16 16r5A4F 16r8C19 16r5A50 16r8C1B 16r5A51 16r8C18 16r5A52 16r8C1D 16r5A53 16r8C1F 16r5A54 16r8C20 16r5A55 16r8C21 16r5A56 16r8C25 16r5A57 16r8C27 16r5A58 16r8C2A 16r5A59 16r8C2B 16r5A5A 16r8C2E 16r5A5B 16r8C2F 16r5A5C 16r8C32 16r5A5D 16r8C33 16r5A5E 16r8C35 16r5A5F 16r8C36 16r5A60 16r5369 16r5A61 16r537A 16r5A62 16r961D 16r5A63 16r9622 16r5A64 16r9621 16r5A65 16r9631 16r5A66 16r962A 16r5A67 16r963D 16r5A68 16r963C 16r5A69 16r9642 16r5A6A 16r9649 16r5A6B 16r9654 16r5A6C 16r965F 16r5A6D 16r9667 16r5A6E 16r966C 16r5A6F 16r9672 16r5A70 16r9674 16r5A71 16r9688 16r5A72 16r968D 16r5A73 16r9697 16r5A74 16r96B0 16r5A75 16r9097 16r5A76 16r909B 16r5A77 16r909D 16r5A78 16r9099 16r5A79 16r90AC 16r5A7A 16r90A1 16r5A7B 16r90B4 16r5A7C 16r90B3 16r5A7D 16r90B6 16r5A7E 16r90BA 16r5B21 16r90B8 16r5B22 16r90B0 16r5B23 16r90CF 16r5B24 16r90C5 16r5B25 16r90BE 16r5B26 16r90D0 16r5B27 16r90C4 16r5B28 16r90C7 16r5B29 16r90D3 16r5B2A 16r90E6 16r5B2B 16r90E2 16r5B2C 16r90DC 16r5B2D 16r90D7 16r5B2E 16r90DB 16r5B2F 16r90EB 16r5B30 16r90EF 16r5B31 16r90FE 16r5B32 16r9104 16r5B33 16r9122 16r5B34 16r911E 16r5B35 16r9123 16r5B36 16r9131 16r5B37 16r912F 16r5B38 16r9139 16r5B39 16r9143 16r5B3A 16r9146 16r5B3B 16r520D 16r5B3C 16r5942 16r5B3D 16r52A2 16r5B3E 16r52AC 16r5B3F 16r52AD 16r5B40 16r52BE 16r5B41 16r54FF 16r5B42 16r52D0 16r5B43 16r52D6 16r5B44 16r52F0 16r5B45 16r53DF 16r5B46 16r71EE 16r5B47 16r77CD 16r5B48 16r5EF4 16r5B49 16r51F5 16r5B4A 16r51FC 16r5B4B 16r9B2F 16r5B4C 16r53B6 16r5B4D 16r5F01 16r5B4E 16r755A 16r5B4F 16r5DEF 16r5B50 16r574C 16r5B51 16r57A9 16r5B52 16r57A1 16r5B53 16r587E 16r5B54 16r58BC 16r5B55 16r58C5 16r5B56 16r58D1 16r5B57 16r5729 16r5B58 16r572C 16r5B59 16r572A 16r5B5A 16r5733 16r5B5B 16r5739 16r5B5C 16r572E 16r5B5D 16r572F 16r5B5E 16r575C 16r5B5F 16r573B 16r5B60 16r5742 16r5B61 16r5769 16r5B62 16r5785 16r5B63 16r576B 16r5B64 16r5786 16r5B65 16r577C 16r5B66 16r577B 16r5B67 16r5768 16r5B68 16r576D 16r5B69 16r5776 16r5B6A 16r5773 16r5B6B 16r57AD 16r5B6C 16r57A4 16r5B6D 16r578C 16r5B6E 16r57B2 16r5B6F 16r57CF 16r5B70 16r57A7 16r5B71 16r57B4 16r5B72 16r5793 16r5B73 16r57A0 16r5B74 16r57D5 16r5B75 16r57D8 16r5B76 16r57DA 16r5B77 16r57D9 16r5B78 16r57D2 16r5B79 16r57B8 16r5B7A 16r57F4 16r5B7B 16r57EF 16r5B7C 16r57F8 16r5B7D 16r57E4 16r5B7E 16r57DD 16r5C21 16r580B 16r5C22 16r580D 16r5C23 16r57FD 16r5C24 16r57ED 16r5C25 16r5800 16r5C26 16r581E 16r5C27 16r5819 16r5C28 16r5844 16r5C29 16r5820 16r5C2A 16r5865 16r5C2B 16r586C 16r5C2C 16r5881 16r5C2D 16r5889 16r5C2E 16r589A 16r5C2F 16r5880 16r5C30 16r99A8 16r5C31 16r9F19 16r5C32 16r61FF 16r5C33 16r8279 16r5C34 16r827D 16r5C35 16r827F 16r5C36 16r828F 16r5C37 16r828A 16r5C38 16r82A8 16r5C39 16r8284 16r5C3A 16r828E 16r5C3B 16r8291 16r5C3C 16r8297 16r5C3D 16r8299 16r5C3E 16r82AB 16r5C3F 16r82B8 16r5C40 16r82BE 16r5C41 16r82B0 16r5C42 16r82C8 16r5C43 16r82CA 16r5C44 16r82E3 16r5C45 16r8298 16r5C46 16r82B7 16r5C47 16r82AE 16r5C48 16r82CB 16r5C49 16r82CC 16r5C4A 16r82C1 16r5C4B 16r82A9 16r5C4C 16r82B4 16r5C4D 16r82A1 16r5C4E 16r82AA 16r5C4F 16r829F 16r5C50 16r82C4 16r5C51 16r82CE 16r5C52 16r82A4 16r5C53 16r82E1 16r5C54 16r8309 16r5C55 16r82F7 16r5C56 16r82E4 16r5C57 16r830F 16r5C58 16r8307 16r5C59 16r82DC 16r5C5A 16r82F4 16r5C5B 16r82D2 16r5C5C 16r82D8 16r5C5D 16r830C 16r5C5E 16r82FB 16r5C5F 16r82D3 16r5C60 16r8311 16r5C61 16r831A 16r5C62 16r8306 16r5C63 16r8314 16r5C64 16r8315 16r5C65 16r82E0 16r5C66 16r82D5 16r5C67 16r831C 16r5C68 16r8351 16r5C69 16r835B 16r5C6A 16r835C 16r5C6B 16r8308 16r5C6C 16r8392 16r5C6D 16r833C 16r5C6E 16r8334 16r5C6F 16r8331 16r5C70 16r839B 16r5C71 16r835E 16r5C72 16r832F 16r5C73 16r834F 16r5C74 16r8347 16r5C75 16r8343 16r5C76 16r835F 16r5C77 16r8340 16r5C78 16r8317 16r5C79 16r8360 16r5C7A 16r832D 16r5C7B 16r833A 16r5C7C 16r8333 16r5C7D 16r8366 16r5C7E 16r8365 16r5D21 16r8368 16r5D22 16r831B 16r5D23 16r8369 16r5D24 16r836C 16r5D25 16r836A 16r5D26 16r836D 16r5D27 16r836E 16r5D28 16r83B0 16r5D29 16r8378 16r5D2A 16r83B3 16r5D2B 16r83B4 16r5D2C 16r83A0 16r5D2D 16r83AA 16r5D2E 16r8393 16r5D2F 16r839C 16r5D30 16r8385 16r5D31 16r837C 16r5D32 16r83B6 16r5D33 16r83A9 16r5D34 16r837D 16r5D35 16r83B8 16r5D36 16r837B 16r5D37 16r8398 16r5D38 16r839E 16r5D39 16r83A8 16r5D3A 16r83BA 16r5D3B 16r83BC 16r5D3C 16r83C1 16r5D3D 16r8401 16r5D3E 16r83E5 16r5D3F 16r83D8 16r5D40 16r5807 16r5D41 16r8418 16r5D42 16r840B 16r5D43 16r83DD 16r5D44 16r83FD 16r5D45 16r83D6 16r5D46 16r841C 16r5D47 16r8438 16r5D48 16r8411 16r5D49 16r8406 16r5D4A 16r83D4 16r5D4B 16r83DF 16r5D4C 16r840F 16r5D4D 16r8403 16r5D4E 16r83F8 16r5D4F 16r83F9 16r5D50 16r83EA 16r5D51 16r83C5 16r5D52 16r83C0 16r5D53 16r8426 16r5D54 16r83F0 16r5D55 16r83E1 16r5D56 16r845C 16r5D57 16r8451 16r5D58 16r845A 16r5D59 16r8459 16r5D5A 16r8473 16r5D5B 16r8487 16r5D5C 16r8488 16r5D5D 16r847A 16r5D5E 16r8489 16r5D5F 16r8478 16r5D60 16r843C 16r5D61 16r8446 16r5D62 16r8469 16r5D63 16r8476 16r5D64 16r848C 16r5D65 16r848E 16r5D66 16r8431 16r5D67 16r846D 16r5D68 16r84C1 16r5D69 16r84CD 16r5D6A 16r84D0 16r5D6B 16r84E6 16r5D6C 16r84BD 16r5D6D 16r84D3 16r5D6E 16r84CA 16r5D6F 16r84BF 16r5D70 16r84BA 16r5D71 16r84E0 16r5D72 16r84A1 16r5D73 16r84B9 16r5D74 16r84B4 16r5D75 16r8497 16r5D76 16r84E5 16r5D77 16r84E3 16r5D78 16r850C 16r5D79 16r750D 16r5D7A 16r8538 16r5D7B 16r84F0 16r5D7C 16r8539 16r5D7D 16r851F 16r5D7E 16r853A 16r5E21 16r8556 16r5E22 16r853B 16r5E23 16r84FF 16r5E24 16r84FC 16r5E25 16r8559 16r5E26 16r8548 16r5E27 16r8568 16r5E28 16r8564 16r5E29 16r855E 16r5E2A 16r857A 16r5E2B 16r77A2 16r5E2C 16r8543 16r5E2D 16r8572 16r5E2E 16r857B 16r5E2F 16r85A4 16r5E30 16r85A8 16r5E31 16r8587 16r5E32 16r858F 16r5E33 16r8579 16r5E34 16r85AE 16r5E35 16r859C 16r5E36 16r8585 16r5E37 16r85B9 16r5E38 16r85B7 16r5E39 16r85B0 16r5E3A 16r85D3 16r5E3B 16r85C1 16r5E3C 16r85DC 16r5E3D 16r85FF 16r5E3E 16r8627 16r5E3F 16r8605 16r5E40 16r8629 16r5E41 16r8616 16r5E42 16r863C 16r5E43 16r5EFE 16r5E44 16r5F08 16r5E45 16r593C 16r5E46 16r5941 16r5E47 16r8037 16r5E48 16r5955 16r5E49 16r595A 16r5E4A 16r5958 16r5E4B 16r530F 16r5E4C 16r5C22 16r5E4D 16r5C25 16r5E4E 16r5C2C 16r5E4F 16r5C34 16r5E50 16r624C 16r5E51 16r626A 16r5E52 16r629F 16r5E53 16r62BB 16r5E54 16r62CA 16r5E55 16r62DA 16r5E56 16r62D7 16r5E57 16r62EE 16r5E58 16r6322 16r5E59 16r62F6 16r5E5A 16r6339 16r5E5B 16r634B 16r5E5C 16r6343 16r5E5D 16r63AD 16r5E5E 16r63F6 16r5E5F 16r6371 16r5E60 16r637A 16r5E61 16r638E 16r5E62 16r63B4 16r5E63 16r636D 16r5E64 16r63AC 16r5E65 16r638A 16r5E66 16r6369 16r5E67 16r63AE 16r5E68 16r63BC 16r5E69 16r63F2 16r5E6A 16r63F8 16r5E6B 16r63E0 16r5E6C 16r63FF 16r5E6D 16r63C4 16r5E6E 16r63DE 16r5E6F 16r63CE 16r5E70 16r6452 16r5E71 16r63C6 16r5E72 16r63BE 16r5E73 16r6445 16r5E74 16r6441 16r5E75 16r640B 16r5E76 16r641B 16r5E77 16r6420 16r5E78 16r640C 16r5E79 16r6426 16r5E7A 16r6421 16r5E7B 16r645E 16r5E7C 16r6484 16r5E7D 16r646D 16r5E7E 16r6496 16r5F21 16r647A 16r5F22 16r64B7 16r5F23 16r64B8 16r5F24 16r6499 16r5F25 16r64BA 16r5F26 16r64C0 16r5F27 16r64D0 16r5F28 16r64D7 16r5F29 16r64E4 16r5F2A 16r64E2 16r5F2B 16r6509 16r5F2C 16r6525 16r5F2D 16r652E 16r5F2E 16r5F0B 16r5F2F 16r5FD2 16r5F30 16r7519 16r5F31 16r5F11 16r5F32 16r535F 16r5F33 16r53F1 16r5F34 16r53FD 16r5F35 16r53E9 16r5F36 16r53E8 16r5F37 16r53FB 16r5F38 16r5412 16r5F39 16r5416 16r5F3A 16r5406 16r5F3B 16r544B 16r5F3C 16r5452 16r5F3D 16r5453 16r5F3E 16r5454 16r5F3F 16r5456 16r5F40 16r5443 16r5F41 16r5421 16r5F42 16r5457 16r5F43 16r5459 16r5F44 16r5423 16r5F45 16r5432 16r5F46 16r5482 16r5F47 16r5494 16r5F48 16r5477 16r5F49 16r5471 16r5F4A 16r5464 16r5F4B 16r549A 16r5F4C 16r549B 16r5F4D 16r5484 16r5F4E 16r5476 16r5F4F 16r5466 16r5F50 16r549D 16r5F51 16r54D0 16r5F52 16r54AD 16r5F53 16r54C2 16r5F54 16r54B4 16r5F55 16r54D2 16r5F56 16r54A7 16r5F57 16r54A6 16r5F58 16r54D3 16r5F59 16r54D4 16r5F5A 16r5472 16r5F5B 16r54A3 16r5F5C 16r54D5 16r5F5D 16r54BB 16r5F5E 16r54BF 16r5F5F 16r54CC 16r5F60 16r54D9 16r5F61 16r54DA 16r5F62 16r54DC 16r5F63 16r54A9 16r5F64 16r54AA 16r5F65 16r54A4 16r5F66 16r54DD 16r5F67 16r54CF 16r5F68 16r54DE 16r5F69 16r551B 16r5F6A 16r54E7 16r5F6B 16r5520 16r5F6C 16r54FD 16r5F6D 16r5514 16r5F6E 16r54F3 16r5F6F 16r5522 16r5F70 16r5523 16r5F71 16r550F 16r5F72 16r5511 16r5F73 16r5527 16r5F74 16r552A 16r5F75 16r5567 16r5F76 16r558F 16r5F77 16r55B5 16r5F78 16r5549 16r5F79 16r556D 16r5F7A 16r5541 16r5F7B 16r5555 16r5F7C 16r553F 16r5F7D 16r5550 16r5F7E 16r553C 16r6021 16r5537 16r6022 16r5556 16r6023 16r5575 16r6024 16r5576 16r6025 16r5577 16r6026 16r5533 16r6027 16r5530 16r6028 16r555C 16r6029 16r558B 16r602A 16r55D2 16r602B 16r5583 16r602C 16r55B1 16r602D 16r55B9 16r602E 16r5588 16r602F 16r5581 16r6030 16r559F 16r6031 16r557E 16r6032 16r55D6 16r6033 16r5591 16r6034 16r557B 16r6035 16r55DF 16r6036 16r55BD 16r6037 16r55BE 16r6038 16r5594 16r6039 16r5599 16r603A 16r55EA 16r603B 16r55F7 16r603C 16r55C9 16r603D 16r561F 16r603E 16r55D1 16r603F 16r55EB 16r6040 16r55EC 16r6041 16r55D4 16r6042 16r55E6 16r6043 16r55DD 16r6044 16r55C4 16r6045 16r55EF 16r6046 16r55E5 16r6047 16r55F2 16r6048 16r55F3 16r6049 16r55CC 16r604A 16r55CD 16r604B 16r55E8 16r604C 16r55F5 16r604D 16r55E4 16r604E 16r8F94 16r604F 16r561E 16r6050 16r5608 16r6051 16r560C 16r6052 16r5601 16r6053 16r5624 16r6054 16r5623 16r6055 16r55FE 16r6056 16r5600 16r6057 16r5627 16r6058 16r562D 16r6059 16r5658 16r605A 16r5639 16r605B 16r5657 16r605C 16r562C 16r605D 16r564D 16r605E 16r5662 16r605F 16r5659 16r6060 16r565C 16r6061 16r564C 16r6062 16r5654 16r6063 16r5686 16r6064 16r5664 16r6065 16r5671 16r6066 16r566B 16r6067 16r567B 16r6068 16r567C 16r6069 16r5685 16r606A 16r5693 16r606B 16r56AF 16r606C 16r56D4 16r606D 16r56D7 16r606E 16r56DD 16r606F 16r56E1 16r6070 16r56F5 16r6071 16r56EB 16r6072 16r56F9 16r6073 16r56FF 16r6074 16r5704 16r6075 16r570A 16r6076 16r5709 16r6077 16r571C 16r6078 16r5E0F 16r6079 16r5E19 16r607A 16r5E14 16r607B 16r5E11 16r607C 16r5E31 16r607D 16r5E3B 16r607E 16r5E3C 16r6121 16r5E37 16r6122 16r5E44 16r6123 16r5E54 16r6124 16r5E5B 16r6125 16r5E5E 16r6126 16r5E61 16r6127 16r5C8C 16r6128 16r5C7A 16r6129 16r5C8D 16r612A 16r5C90 16r612B 16r5C96 16r612C 16r5C88 16r612D 16r5C98 16r612E 16r5C99 16r612F 16r5C91 16r6130 16r5C9A 16r6131 16r5C9C 16r6132 16r5CB5 16r6133 16r5CA2 16r6134 16r5CBD 16r6135 16r5CAC 16r6136 16r5CAB 16r6137 16r5CB1 16r6138 16r5CA3 16r6139 16r5CC1 16r613A 16r5CB7 16r613B 16r5CC4 16r613C 16r5CD2 16r613D 16r5CE4 16r613E 16r5CCB 16r613F 16r5CE5 16r6140 16r5D02 16r6141 16r5D03 16r6142 16r5D27 16r6143 16r5D26 16r6144 16r5D2E 16r6145 16r5D24 16r6146 16r5D1E 16r6147 16r5D06 16r6148 16r5D1B 16r6149 16r5D58 16r614A 16r5D3E 16r614B 16r5D34 16r614C 16r5D3D 16r614D 16r5D6C 16r614E 16r5D5B 16r614F 16r5D6F 16r6150 16r5D5D 16r6151 16r5D6B 16r6152 16r5D4B 16r6153 16r5D4A 16r6154 16r5D69 16r6155 16r5D74 16r6156 16r5D82 16r6157 16r5D99 16r6158 16r5D9D 16r6159 16r8C73 16r615A 16r5DB7 16r615B 16r5DC5 16r615C 16r5F73 16r615D 16r5F77 16r615E 16r5F82 16r615F 16r5F87 16r6160 16r5F89 16r6161 16r5F8C 16r6162 16r5F95 16r6163 16r5F99 16r6164 16r5F9C 16r6165 16r5FA8 16r6166 16r5FAD 16r6167 16r5FB5 16r6168 16r5FBC 16r6169 16r8862 16r616A 16r5F61 16r616B 16r72AD 16r616C 16r72B0 16r616D 16r72B4 16r616E 16r72B7 16r616F 16r72B8 16r6170 16r72C3 16r6171 16r72C1 16r6172 16r72CE 16r6173 16r72CD 16r6174 16r72D2 16r6175 16r72E8 16r6176 16r72EF 16r6177 16r72E9 16r6178 16r72F2 16r6179 16r72F4 16r617A 16r72F7 16r617B 16r7301 16r617C 16r72F3 16r617D 16r7303 16r617E 16r72FA 16r6221 16r72FB 16r6222 16r7317 16r6223 16r7313 16r6224 16r7321 16r6225 16r730A 16r6226 16r731E 16r6227 16r731D 16r6228 16r7315 16r6229 16r7322 16r622A 16r7339 16r622B 16r7325 16r622C 16r732C 16r622D 16r7338 16r622E 16r7331 16r622F 16r7350 16r6230 16r734D 16r6231 16r7357 16r6232 16r7360 16r6233 16r736C 16r6234 16r736F 16r6235 16r737E 16r6236 16r821B 16r6237 16r5925 16r6238 16r98E7 16r6239 16r5924 16r623A 16r5902 16r623B 16r9963 16r623C 16r9967 16r623D 16r9968 16r623E 16r9969 16r623F 16r996A 16r6240 16r996B 16r6241 16r996C 16r6242 16r9974 16r6243 16r9977 16r6244 16r997D 16r6245 16r9980 16r6246 16r9984 16r6247 16r9987 16r6248 16r998A 16r6249 16r998D 16r624A 16r9990 16r624B 16r9991 16r624C 16r9993 16r624D 16r9994 16r624E 16r9995 16r624F 16r5E80 16r6250 16r5E91 16r6251 16r5E8B 16r6252 16r5E96 16r6253 16r5EA5 16r6254 16r5EA0 16r6255 16r5EB9 16r6256 16r5EB5 16r6257 16r5EBE 16r6258 16r5EB3 16r6259 16r8D53 16r625A 16r5ED2 16r625B 16r5ED1 16r625C 16r5EDB 16r625D 16r5EE8 16r625E 16r5EEA 16r625F 16r81BA 16r6260 16r5FC4 16r6261 16r5FC9 16r6262 16r5FD6 16r6263 16r5FCF 16r6264 16r6003 16r6265 16r5FEE 16r6266 16r6004 16r6267 16r5FE1 16r6268 16r5FE4 16r6269 16r5FFE 16r626A 16r6005 16r626B 16r6006 16r626C 16r5FEA 16r626D 16r5FED 16r626E 16r5FF8 16r626F 16r6019 16r6270 16r6035 16r6271 16r6026 16r6272 16r601B 16r6273 16r600F 16r6274 16r600D 16r6275 16r6029 16r6276 16r602B 16r6277 16r600A 16r6278 16r603F 16r6279 16r6021 16r627A 16r6078 16r627B 16r6079 16r627C 16r607B 16r627D 16r607A 16r627E 16r6042 16r6321 16r606A 16r6322 16r607D 16r6323 16r6096 16r6324 16r609A 16r6325 16r60AD 16r6326 16r609D 16r6327 16r6083 16r6328 16r6092 16r6329 16r608C 16r632A 16r609B 16r632B 16r60EC 16r632C 16r60BB 16r632D 16r60B1 16r632E 16r60DD 16r632F 16r60D8 16r6330 16r60C6 16r6331 16r60DA 16r6332 16r60B4 16r6333 16r6120 16r6334 16r6126 16r6335 16r6115 16r6336 16r6123 16r6337 16r60F4 16r6338 16r6100 16r6339 16r610E 16r633A 16r612B 16r633B 16r614A 16r633C 16r6175 16r633D 16r61AC 16r633E 16r6194 16r633F 16r61A7 16r6340 16r61B7 16r6341 16r61D4 16r6342 16r61F5 16r6343 16r5FDD 16r6344 16r96B3 16r6345 16r95E9 16r6346 16r95EB 16r6347 16r95F1 16r6348 16r95F3 16r6349 16r95F5 16r634A 16r95F6 16r634B 16r95FC 16r634C 16r95FE 16r634D 16r9603 16r634E 16r9604 16r634F 16r9606 16r6350 16r9608 16r6351 16r960A 16r6352 16r960B 16r6353 16r960C 16r6354 16r960D 16r6355 16r960F 16r6356 16r9612 16r6357 16r9615 16r6358 16r9616 16r6359 16r9617 16r635A 16r9619 16r635B 16r961A 16r635C 16r4E2C 16r635D 16r723F 16r635E 16r6215 16r635F 16r6C35 16r6360 16r6C54 16r6361 16r6C5C 16r6362 16r6C4A 16r6363 16r6CA3 16r6364 16r6C85 16r6365 16r6C90 16r6366 16r6C94 16r6367 16r6C8C 16r6368 16r6C68 16r6369 16r6C69 16r636A 16r6C74 16r636B 16r6C76 16r636C 16r6C86 16r636D 16r6CA9 16r636E 16r6CD0 16r636F 16r6CD4 16r6370 16r6CAD 16r6371 16r6CF7 16r6372 16r6CF8 16r6373 16r6CF1 16r6374 16r6CD7 16r6375 16r6CB2 16r6376 16r6CE0 16r6377 16r6CD6 16r6378 16r6CFA 16r6379 16r6CEB 16r637A 16r6CEE 16r637B 16r6CB1 16r637C 16r6CD3 16r637D 16r6CEF 16r637E 16r6CFE 16r6421 16r6D39 16r6422 16r6D27 16r6423 16r6D0C 16r6424 16r6D43 16r6425 16r6D48 16r6426 16r6D07 16r6427 16r6D04 16r6428 16r6D19 16r6429 16r6D0E 16r642A 16r6D2B 16r642B 16r6D4D 16r642C 16r6D2E 16r642D 16r6D35 16r642E 16r6D1A 16r642F 16r6D4F 16r6430 16r6D52 16r6431 16r6D54 16r6432 16r6D33 16r6433 16r6D91 16r6434 16r6D6F 16r6435 16r6D9E 16r6436 16r6DA0 16r6437 16r6D5E 16r6438 16r6D93 16r6439 16r6D94 16r643A 16r6D5C 16r643B 16r6D60 16r643C 16r6D7C 16r643D 16r6D63 16r643E 16r6E1A 16r643F 16r6DC7 16r6440 16r6DC5 16r6441 16r6DDE 16r6442 16r6E0E 16r6443 16r6DBF 16r6444 16r6DE0 16r6445 16r6E11 16r6446 16r6DE6 16r6447 16r6DDD 16r6448 16r6DD9 16r6449 16r6E16 16r644A 16r6DAB 16r644B 16r6E0C 16r644C 16r6DAE 16r644D 16r6E2B 16r644E 16r6E6E 16r644F 16r6E4E 16r6450 16r6E6B 16r6451 16r6EB2 16r6452 16r6E5F 16r6453 16r6E86 16r6454 16r6E53 16r6455 16r6E54 16r6456 16r6E32 16r6457 16r6E25 16r6458 16r6E44 16r6459 16r6EDF 16r645A 16r6EB1 16r645B 16r6E98 16r645C 16r6EE0 16r645D 16r6F2D 16r645E 16r6EE2 16r645F 16r6EA5 16r6460 16r6EA7 16r6461 16r6EBD 16r6462 16r6EBB 16r6463 16r6EB7 16r6464 16r6ED7 16r6465 16r6EB4 16r6466 16r6ECF 16r6467 16r6E8F 16r6468 16r6EC2 16r6469 16r6E9F 16r646A 16r6F62 16r646B 16r6F46 16r646C 16r6F47 16r646D 16r6F24 16r646E 16r6F15 16r646F 16r6EF9 16r6470 16r6F2F 16r6471 16r6F36 16r6472 16r6F4B 16r6473 16r6F74 16r6474 16r6F2A 16r6475 16r6F09 16r6476 16r6F29 16r6477 16r6F89 16r6478 16r6F8D 16r6479 16r6F8C 16r647A 16r6F78 16r647B 16r6F72 16r647C 16r6F7C 16r647D 16r6F7A 16r647E 16r6FD1 16r6521 16r6FC9 16r6522 16r6FA7 16r6523 16r6FB9 16r6524 16r6FB6 16r6525 16r6FC2 16r6526 16r6FE1 16r6527 16r6FEE 16r6528 16r6FDE 16r6529 16r6FE0 16r652A 16r6FEF 16r652B 16r701A 16r652C 16r7023 16r652D 16r701B 16r652E 16r7039 16r652F 16r7035 16r6530 16r704F 16r6531 16r705E 16r6532 16r5B80 16r6533 16r5B84 16r6534 16r5B95 16r6535 16r5B93 16r6536 16r5BA5 16r6537 16r5BB8 16r6538 16r752F 16r6539 16r9A9E 16r653A 16r6434 16r653B 16r5BE4 16r653C 16r5BEE 16r653D 16r8930 16r653E 16r5BF0 16r653F 16r8E47 16r6540 16r8B07 16r6541 16r8FB6 16r6542 16r8FD3 16r6543 16r8FD5 16r6544 16r8FE5 16r6545 16r8FEE 16r6546 16r8FE4 16r6547 16r8FE9 16r6548 16r8FE6 16r6549 16r8FF3 16r654A 16r8FE8 16r654B 16r9005 16r654C 16r9004 16r654D 16r900B 16r654E 16r9026 16r654F 16r9011 16r6550 16r900D 16r6551 16r9016 16r6552 16r9021 16r6553 16r9035 16r6554 16r9036 16r6555 16r902D 16r6556 16r902F 16r6557 16r9044 16r6558 16r9051 16r6559 16r9052 16r655A 16r9050 16r655B 16r9068 16r655C 16r9058 16r655D 16r9062 16r655E 16r905B 16r655F 16r66B9 16r6560 16r9074 16r6561 16r907D 16r6562 16r9082 16r6563 16r9088 16r6564 16r9083 16r6565 16r908B 16r6566 16r5F50 16r6567 16r5F57 16r6568 16r5F56 16r6569 16r5F58 16r656A 16r5C3B 16r656B 16r54AB 16r656C 16r5C50 16r656D 16r5C59 16r656E 16r5B71 16r656F 16r5C63 16r6570 16r5C66 16r6571 16r7FBC 16r6572 16r5F2A 16r6573 16r5F29 16r6574 16r5F2D 16r6575 16r8274 16r6576 16r5F3C 16r6577 16r9B3B 16r6578 16r5C6E 16r6579 16r5981 16r657A 16r5983 16r657B 16r598D 16r657C 16r59A9 16r657D 16r59AA 16r657E 16r59A3 16r6621 16r5997 16r6622 16r59CA 16r6623 16r59AB 16r6624 16r599E 16r6625 16r59A4 16r6626 16r59D2 16r6627 16r59B2 16r6628 16r59AF 16r6629 16r59D7 16r662A 16r59BE 16r662B 16r5A05 16r662C 16r5A06 16r662D 16r59DD 16r662E 16r5A08 16r662F 16r59E3 16r6630 16r59D8 16r6631 16r59F9 16r6632 16r5A0C 16r6633 16r5A09 16r6634 16r5A32 16r6635 16r5A34 16r6636 16r5A11 16r6637 16r5A23 16r6638 16r5A13 16r6639 16r5A40 16r663A 16r5A67 16r663B 16r5A4A 16r663C 16r5A55 16r663D 16r5A3C 16r663E 16r5A62 16r663F 16r5A75 16r6640 16r80EC 16r6641 16r5AAA 16r6642 16r5A9B 16r6643 16r5A77 16r6644 16r5A7A 16r6645 16r5ABE 16r6646 16r5AEB 16r6647 16r5AB2 16r6648 16r5AD2 16r6649 16r5AD4 16r664A 16r5AB8 16r664B 16r5AE0 16r664C 16r5AE3 16r664D 16r5AF1 16r664E 16r5AD6 16r664F 16r5AE6 16r6650 16r5AD8 16r6651 16r5ADC 16r6652 16r5B09 16r6653 16r5B17 16r6654 16r5B16 16r6655 16r5B32 16r6656 16r5B37 16r6657 16r5B40 16r6658 16r5C15 16r6659 16r5C1C 16r665A 16r5B5A 16r665B 16r5B65 16r665C 16r5B73 16r665D 16r5B51 16r665E 16r5B53 16r665F 16r5B62 16r6660 16r9A75 16r6661 16r9A77 16r6662 16r9A78 16r6663 16r9A7A 16r6664 16r9A7F 16r6665 16r9A7D 16r6666 16r9A80 16r6667 16r9A81 16r6668 16r9A85 16r6669 16r9A88 16r666A 16r9A8A 16r666B 16r9A90 16r666C 16r9A92 16r666D 16r9A93 16r666E 16r9A96 16r666F 16r9A98 16r6670 16r9A9B 16r6671 16r9A9C 16r6672 16r9A9D 16r6673 16r9A9F 16r6674 16r9AA0 16r6675 16r9AA2 16r6676 16r9AA3 16r6677 16r9AA5 16r6678 16r9AA7 16r6679 16r7E9F 16r667A 16r7EA1 16r667B 16r7EA3 16r667C 16r7EA5 16r667D 16r7EA8 16r667E 16r7EA9 16r6721 16r7EAD 16r6722 16r7EB0 16r6723 16r7EBE 16r6724 16r7EC0 16r6725 16r7EC1 16r6726 16r7EC2 16r6727 16r7EC9 16r6728 16r7ECB 16r6729 16r7ECC 16r672A 16r7ED0 16r672B 16r7ED4 16r672C 16r7ED7 16r672D 16r7EDB 16r672E 16r7EE0 16r672F 16r7EE1 16r6730 16r7EE8 16r6731 16r7EEB 16r6732 16r7EEE 16r6733 16r7EEF 16r6734 16r7EF1 16r6735 16r7EF2 16r6736 16r7F0D 16r6737 16r7EF6 16r6738 16r7EFA 16r6739 16r7EFB 16r673A 16r7EFE 16r673B 16r7F01 16r673C 16r7F02 16r673D 16r7F03 16r673E 16r7F07 16r673F 16r7F08 16r6740 16r7F0B 16r6741 16r7F0C 16r6742 16r7F0F 16r6743 16r7F11 16r6744 16r7F12 16r6745 16r7F17 16r6746 16r7F19 16r6747 16r7F1C 16r6748 16r7F1B 16r6749 16r7F1F 16r674A 16r7F21 16r674B 16r7F22 16r674C 16r7F23 16r674D 16r7F24 16r674E 16r7F25 16r674F 16r7F26 16r6750 16r7F27 16r6751 16r7F2A 16r6752 16r7F2B 16r6753 16r7F2C 16r6754 16r7F2D 16r6755 16r7F2F 16r6756 16r7F30 16r6757 16r7F31 16r6758 16r7F32 16r6759 16r7F33 16r675A 16r7F35 16r675B 16r5E7A 16r675C 16r757F 16r675D 16r5DDB 16r675E 16r753E 16r675F 16r9095 16r6760 16r738E 16r6761 16r7391 16r6762 16r73AE 16r6763 16r73A2 16r6764 16r739F 16r6765 16r73CF 16r6766 16r73C2 16r6767 16r73D1 16r6768 16r73B7 16r6769 16r73B3 16r676A 16r73C0 16r676B 16r73C9 16r676C 16r73C8 16r676D 16r73E5 16r676E 16r73D9 16r676F 16r987C 16r6770 16r740A 16r6771 16r73E9 16r6772 16r73E7 16r6773 16r73DE 16r6774 16r73BA 16r6775 16r73F2 16r6776 16r740F 16r6777 16r742A 16r6778 16r745B 16r6779 16r7426 16r677A 16r7425 16r677B 16r7428 16r677C 16r7430 16r677D 16r742E 16r677E 16r742C 16r6821 16r741B 16r6822 16r741A 16r6823 16r7441 16r6824 16r745C 16r6825 16r7457 16r6826 16r7455 16r6827 16r7459 16r6828 16r7477 16r6829 16r746D 16r682A 16r747E 16r682B 16r749C 16r682C 16r748E 16r682D 16r7480 16r682E 16r7481 16r682F 16r7487 16r6830 16r748B 16r6831 16r749E 16r6832 16r74A8 16r6833 16r74A9 16r6834 16r7490 16r6835 16r74A7 16r6836 16r74D2 16r6837 16r74BA 16r6838 16r97EA 16r6839 16r97EB 16r683A 16r97EC 16r683B 16r674C 16r683C 16r6753 16r683D 16r675E 16r683E 16r6748 16r683F 16r6769 16r6840 16r67A5 16r6841 16r6787 16r6842 16r676A 16r6843 16r6773 16r6844 16r6798 16r6845 16r67A7 16r6846 16r6775 16r6847 16r67A8 16r6848 16r679E 16r6849 16r67AD 16r684A 16r678B 16r684B 16r6777 16r684C 16r677C 16r684D 16r67F0 16r684E 16r6809 16r684F 16r67D8 16r6850 16r680A 16r6851 16r67E9 16r6852 16r67B0 16r6853 16r680C 16r6854 16r67D9 16r6855 16r67B5 16r6856 16r67DA 16r6857 16r67B3 16r6858 16r67DD 16r6859 16r6800 16r685A 16r67C3 16r685B 16r67B8 16r685C 16r67E2 16r685D 16r680E 16r685E 16r67C1 16r685F 16r67FD 16r6860 16r6832 16r6861 16r6833 16r6862 16r6860 16r6863 16r6861 16r6864 16r684E 16r6865 16r6862 16r6866 16r6844 16r6867 16r6864 16r6868 16r6883 16r6869 16r681D 16r686A 16r6855 16r686B 16r6866 16r686C 16r6841 16r686D 16r6867 16r686E 16r6840 16r686F 16r683E 16r6870 16r684A 16r6871 16r6849 16r6872 16r6829 16r6873 16r68B5 16r6874 16r688F 16r6875 16r6874 16r6876 16r6877 16r6877 16r6893 16r6878 16r686B 16r6879 16r68C2 16r687A 16r696E 16r687B 16r68FC 16r687C 16r691F 16r687D 16r6920 16r687E 16r68F9 16r6921 16r6924 16r6922 16r68F0 16r6923 16r690B 16r6924 16r6901 16r6925 16r6957 16r6926 16r68E3 16r6927 16r6910 16r6928 16r6971 16r6929 16r6939 16r692A 16r6960 16r692B 16r6942 16r692C 16r695D 16r692D 16r6984 16r692E 16r696B 16r692F 16r6980 16r6930 16r6998 16r6931 16r6978 16r6932 16r6934 16r6933 16r69CC 16r6934 16r6987 16r6935 16r6988 16r6936 16r69CE 16r6937 16r6989 16r6938 16r6966 16r6939 16r6963 16r693A 16r6979 16r693B 16r699B 16r693C 16r69A7 16r693D 16r69BB 16r693E 16r69AB 16r693F 16r69AD 16r6940 16r69D4 16r6941 16r69B1 16r6942 16r69C1 16r6943 16r69CA 16r6944 16r69DF 16r6945 16r6995 16r6946 16r69E0 16r6947 16r698D 16r6948 16r69FF 16r6949 16r6A2F 16r694A 16r69ED 16r694B 16r6A17 16r694C 16r6A18 16r694D 16r6A65 16r694E 16r69F2 16r694F 16r6A44 16r6950 16r6A3E 16r6951 16r6AA0 16r6952 16r6A50 16r6953 16r6A5B 16r6954 16r6A35 16r6955 16r6A8E 16r6956 16r6A79 16r6957 16r6A3D 16r6958 16r6A28 16r6959 16r6A58 16r695A 16r6A7C 16r695B 16r6A91 16r695C 16r6A90 16r695D 16r6AA9 16r695E 16r6A97 16r695F 16r6AAB 16r6960 16r7337 16r6961 16r7352 16r6962 16r6B81 16r6963 16r6B82 16r6964 16r6B87 16r6965 16r6B84 16r6966 16r6B92 16r6967 16r6B93 16r6968 16r6B8D 16r6969 16r6B9A 16r696A 16r6B9B 16r696B 16r6BA1 16r696C 16r6BAA 16r696D 16r8F6B 16r696E 16r8F6D 16r696F 16r8F71 16r6970 16r8F72 16r6971 16r8F73 16r6972 16r8F75 16r6973 16r8F76 16r6974 16r8F78 16r6975 16r8F77 16r6976 16r8F79 16r6977 16r8F7A 16r6978 16r8F7C 16r6979 16r8F7E 16r697A 16r8F81 16r697B 16r8F82 16r697C 16r8F84 16r697D 16r8F87 16r697E 16r8F8B 16r6A21 16r8F8D 16r6A22 16r8F8E 16r6A23 16r8F8F 16r6A24 16r8F98 16r6A25 16r8F9A 16r6A26 16r8ECE 16r6A27 16r620B 16r6A28 16r6217 16r6A29 16r621B 16r6A2A 16r621F 16r6A2B 16r6222 16r6A2C 16r6221 16r6A2D 16r6225 16r6A2E 16r6224 16r6A2F 16r622C 16r6A30 16r81E7 16r6A31 16r74EF 16r6A32 16r74F4 16r6A33 16r74FF 16r6A34 16r750F 16r6A35 16r7511 16r6A36 16r7513 16r6A37 16r6534 16r6A38 16r65EE 16r6A39 16r65EF 16r6A3A 16r65F0 16r6A3B 16r660A 16r6A3C 16r6619 16r6A3D 16r6772 16r6A3E 16r6603 16r6A3F 16r6615 16r6A40 16r6600 16r6A41 16r7085 16r6A42 16r66F7 16r6A43 16r661D 16r6A44 16r6634 16r6A45 16r6631 16r6A46 16r6636 16r6A47 16r6635 16r6A48 16r8006 16r6A49 16r665F 16r6A4A 16r6654 16r6A4B 16r6641 16r6A4C 16r664F 16r6A4D 16r6656 16r6A4E 16r6661 16r6A4F 16r6657 16r6A50 16r6677 16r6A51 16r6684 16r6A52 16r668C 16r6A53 16r66A7 16r6A54 16r669D 16r6A55 16r66BE 16r6A56 16r66DB 16r6A57 16r66DC 16r6A58 16r66E6 16r6A59 16r66E9 16r6A5A 16r8D32 16r6A5B 16r8D33 16r6A5C 16r8D36 16r6A5D 16r8D3B 16r6A5E 16r8D3D 16r6A5F 16r8D40 16r6A60 16r8D45 16r6A61 16r8D46 16r6A62 16r8D48 16r6A63 16r8D49 16r6A64 16r8D47 16r6A65 16r8D4D 16r6A66 16r8D55 16r6A67 16r8D59 16r6A68 16r89C7 16r6A69 16r89CA 16r6A6A 16r89CB 16r6A6B 16r89CC 16r6A6C 16r89CE 16r6A6D 16r89CF 16r6A6E 16r89D0 16r6A6F 16r89D1 16r6A70 16r726E 16r6A71 16r729F 16r6A72 16r725D 16r6A73 16r7266 16r6A74 16r726F 16r6A75 16r727E 16r6A76 16r727F 16r6A77 16r7284 16r6A78 16r728B 16r6A79 16r728D 16r6A7A 16r728F 16r6A7B 16r7292 16r6A7C 16r6308 16r6A7D 16r6332 16r6A7E 16r63B0 16r6B21 16r643F 16r6B22 16r64D8 16r6B23 16r8004 16r6B24 16r6BEA 16r6B25 16r6BF3 16r6B26 16r6BFD 16r6B27 16r6BF5 16r6B28 16r6BF9 16r6B29 16r6C05 16r6B2A 16r6C07 16r6B2B 16r6C06 16r6B2C 16r6C0D 16r6B2D 16r6C15 16r6B2E 16r6C18 16r6B2F 16r6C19 16r6B30 16r6C1A 16r6B31 16r6C21 16r6B32 16r6C29 16r6B33 16r6C24 16r6B34 16r6C2A 16r6B35 16r6C32 16r6B36 16r6535 16r6B37 16r6555 16r6B38 16r656B 16r6B39 16r724D 16r6B3A 16r7252 16r6B3B 16r7256 16r6B3C 16r7230 16r6B3D 16r8662 16r6B3E 16r5216 16r6B3F 16r809F 16r6B40 16r809C 16r6B41 16r8093 16r6B42 16r80BC 16r6B43 16r670A 16r6B44 16r80BD 16r6B45 16r80B1 16r6B46 16r80AB 16r6B47 16r80AD 16r6B48 16r80B4 16r6B49 16r80B7 16r6B4A 16r80E7 16r6B4B 16r80E8 16r6B4C 16r80E9 16r6B4D 16r80EA 16r6B4E 16r80DB 16r6B4F 16r80C2 16r6B50 16r80C4 16r6B51 16r80D9 16r6B52 16r80CD 16r6B53 16r80D7 16r6B54 16r6710 16r6B55 16r80DD 16r6B56 16r80EB 16r6B57 16r80F1 16r6B58 16r80F4 16r6B59 16r80ED 16r6B5A 16r810D 16r6B5B 16r810E 16r6B5C 16r80F2 16r6B5D 16r80FC 16r6B5E 16r6715 16r6B5F 16r8112 16r6B60 16r8C5A 16r6B61 16r8136 16r6B62 16r811E 16r6B63 16r812C 16r6B64 16r8118 16r6B65 16r8132 16r6B66 16r8148 16r6B67 16r814C 16r6B68 16r8153 16r6B69 16r8174 16r6B6A 16r8159 16r6B6B 16r815A 16r6B6C 16r8171 16r6B6D 16r8160 16r6B6E 16r8169 16r6B6F 16r817C 16r6B70 16r817D 16r6B71 16r816D 16r6B72 16r8167 16r6B73 16r584D 16r6B74 16r5AB5 16r6B75 16r8188 16r6B76 16r8182 16r6B77 16r8191 16r6B78 16r6ED5 16r6B79 16r81A3 16r6B7A 16r81AA 16r6B7B 16r81CC 16r6B7C 16r6726 16r6B7D 16r81CA 16r6B7E 16r81BB 16r6C21 16r81C1 16r6C22 16r81A6 16r6C23 16r6B24 16r6C24 16r6B37 16r6C25 16r6B39 16r6C26 16r6B43 16r6C27 16r6B46 16r6C28 16r6B59 16r6C29 16r98D1 16r6C2A 16r98D2 16r6C2B 16r98D3 16r6C2C 16r98D5 16r6C2D 16r98D9 16r6C2E 16r98DA 16r6C2F 16r6BB3 16r6C30 16r5F40 16r6C31 16r6BC2 16r6C32 16r89F3 16r6C33 16r6590 16r6C34 16r9F51 16r6C35 16r6593 16r6C36 16r65BC 16r6C37 16r65C6 16r6C38 16r65C4 16r6C39 16r65C3 16r6C3A 16r65CC 16r6C3B 16r65CE 16r6C3C 16r65D2 16r6C3D 16r65D6 16r6C3E 16r7080 16r6C3F 16r709C 16r6C40 16r7096 16r6C41 16r709D 16r6C42 16r70BB 16r6C43 16r70C0 16r6C44 16r70B7 16r6C45 16r70AB 16r6C46 16r70B1 16r6C47 16r70E8 16r6C48 16r70CA 16r6C49 16r7110 16r6C4A 16r7113 16r6C4B 16r7116 16r6C4C 16r712F 16r6C4D 16r7131 16r6C4E 16r7173 16r6C4F 16r715C 16r6C50 16r7168 16r6C51 16r7145 16r6C52 16r7172 16r6C53 16r714A 16r6C54 16r7178 16r6C55 16r717A 16r6C56 16r7198 16r6C57 16r71B3 16r6C58 16r71B5 16r6C59 16r71A8 16r6C5A 16r71A0 16r6C5B 16r71E0 16r6C5C 16r71D4 16r6C5D 16r71E7 16r6C5E 16r71F9 16r6C5F 16r721D 16r6C60 16r7228 16r6C61 16r706C 16r6C62 16r7118 16r6C63 16r7166 16r6C64 16r71B9 16r6C65 16r623E 16r6C66 16r623D 16r6C67 16r6243 16r6C68 16r6248 16r6C69 16r6249 16r6C6A 16r793B 16r6C6B 16r7940 16r6C6C 16r7946 16r6C6D 16r7949 16r6C6E 16r795B 16r6C6F 16r795C 16r6C70 16r7953 16r6C71 16r795A 16r6C72 16r7962 16r6C73 16r7957 16r6C74 16r7960 16r6C75 16r796F 16r6C76 16r7967 16r6C77 16r797A 16r6C78 16r7985 16r6C79 16r798A 16r6C7A 16r799A 16r6C7B 16r79A7 16r6C7C 16r79B3 16r6C7D 16r5FD1 16r6C7E 16r5FD0 16r6D21 16r603C 16r6D22 16r605D 16r6D23 16r605A 16r6D24 16r6067 16r6D25 16r6041 16r6D26 16r6059 16r6D27 16r6063 16r6D28 16r60AB 16r6D29 16r6106 16r6D2A 16r610D 16r6D2B 16r615D 16r6D2C 16r61A9 16r6D2D 16r619D 16r6D2E 16r61CB 16r6D2F 16r61D1 16r6D30 16r6206 16r6D31 16r8080 16r6D32 16r807F 16r6D33 16r6C93 16r6D34 16r6CF6 16r6D35 16r6DFC 16r6D36 16r77F6 16r6D37 16r77F8 16r6D38 16r7800 16r6D39 16r7809 16r6D3A 16r7817 16r6D3B 16r7818 16r6D3C 16r7811 16r6D3D 16r65AB 16r6D3E 16r782D 16r6D3F 16r781C 16r6D40 16r781D 16r6D41 16r7839 16r6D42 16r783A 16r6D43 16r783B 16r6D44 16r781F 16r6D45 16r783C 16r6D46 16r7825 16r6D47 16r782C 16r6D48 16r7823 16r6D49 16r7829 16r6D4A 16r784E 16r6D4B 16r786D 16r6D4C 16r7856 16r6D4D 16r7857 16r6D4E 16r7826 16r6D4F 16r7850 16r6D50 16r7847 16r6D51 16r784C 16r6D52 16r786A 16r6D53 16r789B 16r6D54 16r7893 16r6D55 16r789A 16r6D56 16r7887 16r6D57 16r789C 16r6D58 16r78A1 16r6D59 16r78A3 16r6D5A 16r78B2 16r6D5B 16r78B9 16r6D5C 16r78A5 16r6D5D 16r78D4 16r6D5E 16r78D9 16r6D5F 16r78C9 16r6D60 16r78EC 16r6D61 16r78F2 16r6D62 16r7905 16r6D63 16r78F4 16r6D64 16r7913 16r6D65 16r7924 16r6D66 16r791E 16r6D67 16r7934 16r6D68 16r9F9B 16r6D69 16r9EF9 16r6D6A 16r9EFB 16r6D6B 16r9EFC 16r6D6C 16r76F1 16r6D6D 16r7704 16r6D6E 16r770D 16r6D6F 16r76F9 16r6D70 16r7707 16r6D71 16r7708 16r6D72 16r771A 16r6D73 16r7722 16r6D74 16r7719 16r6D75 16r772D 16r6D76 16r7726 16r6D77 16r7735 16r6D78 16r7738 16r6D79 16r7750 16r6D7A 16r7751 16r6D7B 16r7747 16r6D7C 16r7743 16r6D7D 16r775A 16r6D7E 16r7768 16r6E21 16r7762 16r6E22 16r7765 16r6E23 16r777F 16r6E24 16r778D 16r6E25 16r777D 16r6E26 16r7780 16r6E27 16r778C 16r6E28 16r7791 16r6E29 16r779F 16r6E2A 16r77A0 16r6E2B 16r77B0 16r6E2C 16r77B5 16r6E2D 16r77BD 16r6E2E 16r753A 16r6E2F 16r7540 16r6E30 16r754E 16r6E31 16r754B 16r6E32 16r7548 16r6E33 16r755B 16r6E34 16r7572 16r6E35 16r7579 16r6E36 16r7583 16r6E37 16r7F58 16r6E38 16r7F61 16r6E39 16r7F5F 16r6E3A 16r8A48 16r6E3B 16r7F68 16r6E3C 16r7F74 16r6E3D 16r7F71 16r6E3E 16r7F79 16r6E3F 16r7F81 16r6E40 16r7F7E 16r6E41 16r76CD 16r6E42 16r76E5 16r6E43 16r8832 16r6E44 16r9485 16r6E45 16r9486 16r6E46 16r9487 16r6E47 16r948B 16r6E48 16r948A 16r6E49 16r948C 16r6E4A 16r948D 16r6E4B 16r948F 16r6E4C 16r9490 16r6E4D 16r9494 16r6E4E 16r9497 16r6E4F 16r9495 16r6E50 16r949A 16r6E51 16r949B 16r6E52 16r949C 16r6E53 16r94A3 16r6E54 16r94A4 16r6E55 16r94AB 16r6E56 16r94AA 16r6E57 16r94AD 16r6E58 16r94AC 16r6E59 16r94AF 16r6E5A 16r94B0 16r6E5B 16r94B2 16r6E5C 16r94B4 16r6E5D 16r94B6 16r6E5E 16r94B7 16r6E5F 16r94B8 16r6E60 16r94B9 16r6E61 16r94BA 16r6E62 16r94BC 16r6E63 16r94BD 16r6E64 16r94BF 16r6E65 16r94C4 16r6E66 16r94C8 16r6E67 16r94C9 16r6E68 16r94CA 16r6E69 16r94CB 16r6E6A 16r94CC 16r6E6B 16r94CD 16r6E6C 16r94CE 16r6E6D 16r94D0 16r6E6E 16r94D1 16r6E6F 16r94D2 16r6E70 16r94D5 16r6E71 16r94D6 16r6E72 16r94D7 16r6E73 16r94D9 16r6E74 16r94D8 16r6E75 16r94DB 16r6E76 16r94DE 16r6E77 16r94DF 16r6E78 16r94E0 16r6E79 16r94E2 16r6E7A 16r94E4 16r6E7B 16r94E5 16r6E7C 16r94E7 16r6E7D 16r94E8 16r6E7E 16r94EA 16r6F21 16r94E9 16r6F22 16r94EB 16r6F23 16r94EE 16r6F24 16r94EF 16r6F25 16r94F3 16r6F26 16r94F4 16r6F27 16r94F5 16r6F28 16r94F7 16r6F29 16r94F9 16r6F2A 16r94FC 16r6F2B 16r94FD 16r6F2C 16r94FF 16r6F2D 16r9503 16r6F2E 16r9502 16r6F2F 16r9506 16r6F30 16r9507 16r6F31 16r9509 16r6F32 16r950A 16r6F33 16r950D 16r6F34 16r950E 16r6F35 16r950F 16r6F36 16r9512 16r6F37 16r9513 16r6F38 16r9514 16r6F39 16r9515 16r6F3A 16r9516 16r6F3B 16r9518 16r6F3C 16r951B 16r6F3D 16r951D 16r6F3E 16r951E 16r6F3F 16r951F 16r6F40 16r9522 16r6F41 16r952A 16r6F42 16r952B 16r6F43 16r9529 16r6F44 16r952C 16r6F45 16r9531 16r6F46 16r9532 16r6F47 16r9534 16r6F48 16r9536 16r6F49 16r9537 16r6F4A 16r9538 16r6F4B 16r953C 16r6F4C 16r953E 16r6F4D 16r953F 16r6F4E 16r9542 16r6F4F 16r9535 16r6F50 16r9544 16r6F51 16r9545 16r6F52 16r9546 16r6F53 16r9549 16r6F54 16r954C 16r6F55 16r954E 16r6F56 16r954F 16r6F57 16r9552 16r6F58 16r9553 16r6F59 16r9554 16r6F5A 16r9556 16r6F5B 16r9557 16r6F5C 16r9558 16r6F5D 16r9559 16r6F5E 16r955B 16r6F5F 16r955E 16r6F60 16r955F 16r6F61 16r955D 16r6F62 16r9561 16r6F63 16r9562 16r6F64 16r9564 16r6F65 16r9565 16r6F66 16r9566 16r6F67 16r9567 16r6F68 16r9568 16r6F69 16r9569 16r6F6A 16r956A 16r6F6B 16r956B 16r6F6C 16r956C 16r6F6D 16r956F 16r6F6E 16r9571 16r6F6F 16r9572 16r6F70 16r9573 16r6F71 16r953A 16r6F72 16r77E7 16r6F73 16r77EC 16r6F74 16r96C9 16r6F75 16r79D5 16r6F76 16r79ED 16r6F77 16r79E3 16r6F78 16r79EB 16r6F79 16r7A06 16r6F7A 16r5D47 16r6F7B 16r7A03 16r6F7C 16r7A02 16r6F7D 16r7A1E 16r6F7E 16r7A14 16r7021 16r7A39 16r7022 16r7A37 16r7023 16r7A51 16r7024 16r9ECF 16r7025 16r99A5 16r7026 16r7A70 16r7027 16r7688 16r7028 16r768E 16r7029 16r7693 16r702A 16r7699 16r702B 16r76A4 16r702C 16r74DE 16r702D 16r74E0 16r702E 16r752C 16r702F 16r9E20 16r7030 16r9E22 16r7031 16r9E28 16r7032 16r9E29 16r7033 16r9E2A 16r7034 16r9E2B 16r7035 16r9E2C 16r7036 16r9E32 16r7037 16r9E31 16r7038 16r9E36 16r7039 16r9E38 16r703A 16r9E37 16r703B 16r9E39 16r703C 16r9E3A 16r703D 16r9E3E 16r703E 16r9E41 16r703F 16r9E42 16r7040 16r9E44 16r7041 16r9E46 16r7042 16r9E47 16r7043 16r9E48 16r7044 16r9E49 16r7045 16r9E4B 16r7046 16r9E4C 16r7047 16r9E4E 16r7048 16r9E51 16r7049 16r9E55 16r704A 16r9E57 16r704B 16r9E5A 16r704C 16r9E5B 16r704D 16r9E5C 16r704E 16r9E5E 16r704F 16r9E63 16r7050 16r9E66 16r7051 16r9E67 16r7052 16r9E68 16r7053 16r9E69 16r7054 16r9E6A 16r7055 16r9E6B 16r7056 16r9E6C 16r7057 16r9E71 16r7058 16r9E6D 16r7059 16r9E73 16r705A 16r7592 16r705B 16r7594 16r705C 16r7596 16r705D 16r75A0 16r705E 16r759D 16r705F 16r75AC 16r7060 16r75A3 16r7061 16r75B3 16r7062 16r75B4 16r7063 16r75B8 16r7064 16r75C4 16r7065 16r75B1 16r7066 16r75B0 16r7067 16r75C3 16r7068 16r75C2 16r7069 16r75D6 16r706A 16r75CD 16r706B 16r75E3 16r706C 16r75E8 16r706D 16r75E6 16r706E 16r75E4 16r706F 16r75EB 16r7070 16r75E7 16r7071 16r7603 16r7072 16r75F1 16r7073 16r75FC 16r7074 16r75FF 16r7075 16r7610 16r7076 16r7600 16r7077 16r7605 16r7078 16r760C 16r7079 16r7617 16r707A 16r760A 16r707B 16r7625 16r707C 16r7618 16r707D 16r7615 16r707E 16r7619 16r7121 16r761B 16r7122 16r763C 16r7123 16r7622 16r7124 16r7620 16r7125 16r7640 16r7126 16r762D 16r7127 16r7630 16r7128 16r763F 16r7129 16r7635 16r712A 16r7643 16r712B 16r763E 16r712C 16r7633 16r712D 16r764D 16r712E 16r765E 16r712F 16r7654 16r7130 16r765C 16r7131 16r7656 16r7132 16r766B 16r7133 16r766F 16r7134 16r7FCA 16r7135 16r7AE6 16r7136 16r7A78 16r7137 16r7A79 16r7138 16r7A80 16r7139 16r7A86 16r713A 16r7A88 16r713B 16r7A95 16r713C 16r7AA6 16r713D 16r7AA0 16r713E 16r7AAC 16r713F 16r7AA8 16r7140 16r7AAD 16r7141 16r7AB3 16r7142 16r8864 16r7143 16r8869 16r7144 16r8872 16r7145 16r887D 16r7146 16r887F 16r7147 16r8882 16r7148 16r88A2 16r7149 16r88C6 16r714A 16r88B7 16r714B 16r88BC 16r714C 16r88C9 16r714D 16r88E2 16r714E 16r88CE 16r714F 16r88E3 16r7150 16r88E5 16r7151 16r88F1 16r7152 16r891A 16r7153 16r88FC 16r7154 16r88E8 16r7155 16r88FE 16r7156 16r88F0 16r7157 16r8921 16r7158 16r8919 16r7159 16r8913 16r715A 16r891B 16r715B 16r890A 16r715C 16r8934 16r715D 16r892B 16r715E 16r8936 16r715F 16r8941 16r7160 16r8966 16r7161 16r897B 16r7162 16r758B 16r7163 16r80E5 16r7164 16r76B2 16r7165 16r76B4 16r7166 16r77DC 16r7167 16r8012 16r7168 16r8014 16r7169 16r8016 16r716A 16r801C 16r716B 16r8020 16r716C 16r8022 16r716D 16r8025 16r716E 16r8026 16r716F 16r8027 16r7170 16r8029 16r7171 16r8028 16r7172 16r8031 16r7173 16r800B 16r7174 16r8035 16r7175 16r8043 16r7176 16r8046 16r7177 16r804D 16r7178 16r8052 16r7179 16r8069 16r717A 16r8071 16r717B 16r8983 16r717C 16r9878 16r717D 16r9880 16r717E 16r9883 16r7221 16r9889 16r7222 16r988C 16r7223 16r988D 16r7224 16r988F 16r7225 16r9894 16r7226 16r989A 16r7227 16r989B 16r7228 16r989E 16r7229 16r989F 16r722A 16r98A1 16r722B 16r98A2 16r722C 16r98A5 16r722D 16r98A6 16r722E 16r864D 16r722F 16r8654 16r7230 16r866C 16r7231 16r866E 16r7232 16r867F 16r7233 16r867A 16r7234 16r867C 16r7235 16r867B 16r7236 16r86A8 16r7237 16r868D 16r7238 16r868B 16r7239 16r86AC 16r723A 16r869D 16r723B 16r86A7 16r723C 16r86A3 16r723D 16r86AA 16r723E 16r8693 16r723F 16r86A9 16r7240 16r86B6 16r7241 16r86C4 16r7242 16r86B5 16r7243 16r86CE 16r7244 16r86B0 16r7245 16r86BA 16r7246 16r86B1 16r7247 16r86AF 16r7248 16r86C9 16r7249 16r86CF 16r724A 16r86B4 16r724B 16r86E9 16r724C 16r86F1 16r724D 16r86F2 16r724E 16r86ED 16r724F 16r86F3 16r7250 16r86D0 16r7251 16r8713 16r7252 16r86DE 16r7253 16r86F4 16r7254 16r86DF 16r7255 16r86D8 16r7256 16r86D1 16r7257 16r8703 16r7258 16r8707 16r7259 16r86F8 16r725A 16r8708 16r725B 16r870A 16r725C 16r870D 16r725D 16r8709 16r725E 16r8723 16r725F 16r873B 16r7260 16r871E 16r7261 16r8725 16r7262 16r872E 16r7263 16r871A 16r7264 16r873E 16r7265 16r8748 16r7266 16r8734 16r7267 16r8731 16r7268 16r8729 16r7269 16r8737 16r726A 16r873F 16r726B 16r8782 16r726C 16r8722 16r726D 16r877D 16r726E 16r877E 16r726F 16r877B 16r7270 16r8760 16r7271 16r8770 16r7272 16r874C 16r7273 16r876E 16r7274 16r878B 16r7275 16r8753 16r7276 16r8763 16r7277 16r877C 16r7278 16r8764 16r7279 16r8759 16r727A 16r8765 16r727B 16r8793 16r727C 16r87AF 16r727D 16r87A8 16r727E 16r87D2 16r7321 16r87C6 16r7322 16r8788 16r7323 16r8785 16r7324 16r87AD 16r7325 16r8797 16r7326 16r8783 16r7327 16r87AB 16r7328 16r87E5 16r7329 16r87AC 16r732A 16r87B5 16r732B 16r87B3 16r732C 16r87CB 16r732D 16r87D3 16r732E 16r87BD 16r732F 16r87D1 16r7330 16r87C0 16r7331 16r87CA 16r7332 16r87DB 16r7333 16r87EA 16r7334 16r87E0 16r7335 16r87EE 16r7336 16r8816 16r7337 16r8813 16r7338 16r87FE 16r7339 16r880A 16r733A 16r881B 16r733B 16r8821 16r733C 16r8839 16r733D 16r883C 16r733E 16r7F36 16r733F 16r7F42 16r7340 16r7F44 16r7341 16r7F45 16r7342 16r8210 16r7343 16r7AFA 16r7344 16r7AFD 16r7345 16r7B08 16r7346 16r7B03 16r7347 16r7B04 16r7348 16r7B15 16r7349 16r7B0A 16r734A 16r7B2B 16r734B 16r7B0F 16r734C 16r7B47 16r734D 16r7B38 16r734E 16r7B2A 16r734F 16r7B19 16r7350 16r7B2E 16r7351 16r7B31 16r7352 16r7B20 16r7353 16r7B25 16r7354 16r7B24 16r7355 16r7B33 16r7356 16r7B3E 16r7357 16r7B1E 16r7358 16r7B58 16r7359 16r7B5A 16r735A 16r7B45 16r735B 16r7B75 16r735C 16r7B4C 16r735D 16r7B5D 16r735E 16r7B60 16r735F 16r7B6E 16r7360 16r7B7B 16r7361 16r7B62 16r7362 16r7B72 16r7363 16r7B71 16r7364 16r7B90 16r7365 16r7BA6 16r7366 16r7BA7 16r7367 16r7BB8 16r7368 16r7BAC 16r7369 16r7B9D 16r736A 16r7BA8 16r736B 16r7B85 16r736C 16r7BAA 16r736D 16r7B9C 16r736E 16r7BA2 16r736F 16r7BAB 16r7370 16r7BB4 16r7371 16r7BD1 16r7372 16r7BC1 16r7373 16r7BCC 16r7374 16r7BDD 16r7375 16r7BDA 16r7376 16r7BE5 16r7377 16r7BE6 16r7378 16r7BEA 16r7379 16r7C0C 16r737A 16r7BFE 16r737B 16r7BFC 16r737C 16r7C0F 16r737D 16r7C16 16r737E 16r7C0B 16r7421 16r7C1F 16r7422 16r7C2A 16r7423 16r7C26 16r7424 16r7C38 16r7425 16r7C41 16r7426 16r7C40 16r7427 16r81FE 16r7428 16r8201 16r7429 16r8202 16r742A 16r8204 16r742B 16r81EC 16r742C 16r8844 16r742D 16r8221 16r742E 16r8222 16r742F 16r8223 16r7430 16r822D 16r7431 16r822F 16r7432 16r8228 16r7433 16r822B 16r7434 16r8238 16r7435 16r823B 16r7436 16r8233 16r7437 16r8234 16r7438 16r823E 16r7439 16r8244 16r743A 16r8249 16r743B 16r824B 16r743C 16r824F 16r743D 16r825A 16r743E 16r825F 16r743F 16r8268 16r7440 16r887E 16r7441 16r8885 16r7442 16r8888 16r7443 16r88D8 16r7444 16r88DF 16r7445 16r895E 16r7446 16r7F9D 16r7447 16r7F9F 16r7448 16r7FA7 16r7449 16r7FAF 16r744A 16r7FB0 16r744B 16r7FB2 16r744C 16r7C7C 16r744D 16r6549 16r744E 16r7C91 16r744F 16r7C9D 16r7450 16r7C9C 16r7451 16r7C9E 16r7452 16r7CA2 16r7453 16r7CB2 16r7454 16r7CBC 16r7455 16r7CBD 16r7456 16r7CC1 16r7457 16r7CC7 16r7458 16r7CCC 16r7459 16r7CCD 16r745A 16r7CC8 16r745B 16r7CC5 16r745C 16r7CD7 16r745D 16r7CE8 16r745E 16r826E 16r745F 16r66A8 16r7460 16r7FBF 16r7461 16r7FCE 16r7462 16r7FD5 16r7463 16r7FE5 16r7464 16r7FE1 16r7465 16r7FE6 16r7466 16r7FE9 16r7467 16r7FEE 16r7468 16r7FF3 16r7469 16r7CF8 16r746A 16r7D77 16r746B 16r7DA6 16r746C 16r7DAE 16r746D 16r7E47 16r746E 16r7E9B 16r746F 16r9EB8 16r7470 16r9EB4 16r7471 16r8D73 16r7472 16r8D84 16r7473 16r8D94 16r7474 16r8D91 16r7475 16r8DB1 16r7476 16r8D67 16r7477 16r8D6D 16r7478 16r8C47 16r7479 16r8C49 16r747A 16r914A 16r747B 16r9150 16r747C 16r914E 16r747D 16r914F 16r747E 16r9164 16r7521 16r9162 16r7522 16r9161 16r7523 16r9170 16r7524 16r9169 16r7525 16r916F 16r7526 16r917D 16r7527 16r917E 16r7528 16r9172 16r7529 16r9174 16r752A 16r9179 16r752B 16r918C 16r752C 16r9185 16r752D 16r9190 16r752E 16r918D 16r752F 16r9191 16r7530 16r91A2 16r7531 16r91A3 16r7532 16r91AA 16r7533 16r91AD 16r7534 16r91AE 16r7535 16r91AF 16r7536 16r91B5 16r7537 16r91B4 16r7538 16r91BA 16r7539 16r8C55 16r753A 16r9E7E 16r753B 16r8DB8 16r753C 16r8DEB 16r753D 16r8E05 16r753E 16r8E59 16r753F 16r8E69 16r7540 16r8DB5 16r7541 16r8DBF 16r7542 16r8DBC 16r7543 16r8DBA 16r7544 16r8DC4 16r7545 16r8DD6 16r7546 16r8DD7 16r7547 16r8DDA 16r7548 16r8DDE 16r7549 16r8DCE 16r754A 16r8DCF 16r754B 16r8DDB 16r754C 16r8DC6 16r754D 16r8DEC 16r754E 16r8DF7 16r754F 16r8DF8 16r7550 16r8DE3 16r7551 16r8DF9 16r7552 16r8DFB 16r7553 16r8DE4 16r7554 16r8E09 16r7555 16r8DFD 16r7556 16r8E14 16r7557 16r8E1D 16r7558 16r8E1F 16r7559 16r8E2C 16r755A 16r8E2E 16r755B 16r8E23 16r755C 16r8E2F 16r755D 16r8E3A 16r755E 16r8E40 16r755F 16r8E39 16r7560 16r8E35 16r7561 16r8E3D 16r7562 16r8E31 16r7563 16r8E49 16r7564 16r8E41 16r7565 16r8E42 16r7566 16r8E51 16r7567 16r8E52 16r7568 16r8E4A 16r7569 16r8E70 16r756A 16r8E76 16r756B 16r8E7C 16r756C 16r8E6F 16r756D 16r8E74 16r756E 16r8E85 16r756F 16r8E8F 16r7570 16r8E94 16r7571 16r8E90 16r7572 16r8E9C 16r7573 16r8E9E 16r7574 16r8C78 16r7575 16r8C82 16r7576 16r8C8A 16r7577 16r8C85 16r7578 16r8C98 16r7579 16r8C94 16r757A 16r659B 16r757B 16r89D6 16r757C 16r89DE 16r757D 16r89DA 16r757E 16r89DC 16r7621 16r89E5 16r7622 16r89EB 16r7623 16r89EF 16r7624 16r8A3E 16r7625 16r8B26 16r7626 16r9753 16r7627 16r96E9 16r7628 16r96F3 16r7629 16r96EF 16r762A 16r9706 16r762B 16r9701 16r762C 16r9708 16r762D 16r970F 16r762E 16r970E 16r762F 16r972A 16r7630 16r972D 16r7631 16r9730 16r7632 16r973E 16r7633 16r9F80 16r7634 16r9F83 16r7635 16r9F85 16r7636 16r9F86 16r7637 16r9F87 16r7638 16r9F88 16r7639 16r9F89 16r763A 16r9F8A 16r763B 16r9F8C 16r763C 16r9EFE 16r763D 16r9F0B 16r763E 16r9F0D 16r763F 16r96B9 16r7640 16r96BC 16r7641 16r96BD 16r7642 16r96CE 16r7643 16r96D2 16r7644 16r77BF 16r7645 16r96E0 16r7646 16r928E 16r7647 16r92AE 16r7648 16r92C8 16r7649 16r933E 16r764A 16r936A 16r764B 16r93CA 16r764C 16r938F 16r764D 16r943E 16r764E 16r946B 16r764F 16r9C7F 16r7650 16r9C82 16r7651 16r9C85 16r7652 16r9C86 16r7653 16r9C87 16r7654 16r9C88 16r7655 16r7A23 16r7656 16r9C8B 16r7657 16r9C8E 16r7658 16r9C90 16r7659 16r9C91 16r765A 16r9C92 16r765B 16r9C94 16r765C 16r9C95 16r765D 16r9C9A 16r765E 16r9C9B 16r765F 16r9C9E 16r7660 16r9C9F 16r7661 16r9CA0 16r7662 16r9CA1 16r7663 16r9CA2 16r7664 16r9CA3 16r7665 16r9CA5 16r7666 16r9CA6 16r7667 16r9CA7 16r7668 16r9CA8 16r7669 16r9CA9 16r766A 16r9CAB 16r766B 16r9CAD 16r766C 16r9CAE 16r766D 16r9CB0 16r766E 16r9CB1 16r766F 16r9CB2 16r7670 16r9CB3 16r7671 16r9CB4 16r7672 16r9CB5 16r7673 16r9CB6 16r7674 16r9CB7 16r7675 16r9CBA 16r7676 16r9CBB 16r7677 16r9CBC 16r7678 16r9CBD 16r7679 16r9CC4 16r767A 16r9CC5 16r767B 16r9CC6 16r767C 16r9CC7 16r767D 16r9CCA 16r767E 16r9CCB 16r7721 16r9CCC 16r7722 16r9CCD 16r7723 16r9CCE 16r7724 16r9CCF 16r7725 16r9CD0 16r7726 16r9CD3 16r7727 16r9CD4 16r7728 16r9CD5 16r7729 16r9CD7 16r772A 16r9CD8 16r772B 16r9CD9 16r772C 16r9CDC 16r772D 16r9CDD 16r772E 16r9CDF 16r772F 16r9CE2 16r7730 16r977C 16r7731 16r9785 16r7732 16r9791 16r7733 16r9792 16r7734 16r9794 16r7735 16r97AF 16r7736 16r97AB 16r7737 16r97A3 16r7738 16r97B2 16r7739 16r97B4 16r773A 16r9AB1 16r773B 16r9AB0 16r773C 16r9AB7 16r773D 16r9E58 16r773E 16r9AB6 16r773F 16r9ABA 16r7740 16r9ABC 16r7741 16r9AC1 16r7742 16r9AC0 16r7743 16r9AC5 16r7744 16r9AC2 16r7745 16r9ACB 16r7746 16r9ACC 16r7747 16r9AD1 16r7748 16r9B45 16r7749 16r9B43 16r774A 16r9B47 16r774B 16r9B49 16r774C 16r9B48 16r774D 16r9B4D 16r774E 16r9B51 16r774F 16r98E8 16r7750 16r990D 16r7751 16r992E 16r7752 16r9955 16r7753 16r9954 16r7754 16r9ADF 16r7755 16r9AE1 16r7756 16r9AE6 16r7757 16r9AEF 16r7758 16r9AEB 16r7759 16r9AFB 16r775A 16r9AED 16r775B 16r9AF9 16r775C 16r9B08 16r775D 16r9B0F 16r775E 16r9B13 16r775F 16r9B1F 16r7760 16r9B23 16r7761 16r9EBD 16r7762 16r9EBE 16r7763 16r7E3B 16r7764 16r9E82 16r7765 16r9E87 16r7766 16r9E88 16r7767 16r9E8B 16r7768 16r9E92 16r7769 16r93D6 16r776A 16r9E9D 16r776B 16r9E9F 16r776C 16r9EDB 16r776D 16r9EDC 16r776E 16r9EDD 16r776F 16r9EE0 16r7770 16r9EDF 16r7771 16r9EE2 16r7772 16r9EE9 16r7773 16r9EE7 16r7774 16r9EE5 16r7775 16r9EEA 16r7776 16r9EEF 16r7777 16r9F22 16r7778 16r9F2C 16r7779 16r9F2F 16r777A 16r9F39 16r777B 16r9F37 16r777C 16r9F3D 16r777D 16r9F3E 16r777E 16r9F44).
	table size even ifFalse: [^ self error: 'given table size must be even'].
	size := table size / 2.
	gb2312 := Array new: size.
	unicode := Array new: size.
	1 to: table size by: 2 do: [:index |
		| tableIndex |
		tableIndex := index + 1 / 2.
		gb2312 at: tableIndex put: (table at: index).
		unicode at: tableIndex put: (table at: index + 1)].
	gb23122 := Array new: 94*94 withAll: -1.
	gb2312 withIndexDo: [:elem :index | | uIndex code u |
		code := (elem // 256 - 33) * 94 + (elem \\ 256 - 33) + 1.
		(gb23122 at: code) ~= -1 ifTrue: [self error].
		uIndex := gb2312 indexOf: elem.
		uIndex = 0 ifFalse: [
			u := unicode at: uIndex.
			gb23122 at: code put: u.
		].
	].
	GB2312Table := gb23122.
! !

!UDPSocketEchoTest commentStamp: 'SvenVanCaekenberghe 10/21/2014 14:45'!
UDPSocketEchoTest is both a unit test and an example.
It implements and tests a UDP echo service.
Each datagram sent to it is echoed back as is.

You can also run the example manually,
by inspecting each expression separately.

  UDPSocketEchoTest new runServer.
  UDPSocketEchoTest new clientSend: 'Hello @ ', Time now asString.
  UDPSocketEchoTest new clientSend: #quit.

The server runs until it receives quit as message. If necessary, use the Process Browser to terminate a running server.!
!UDPSocketEchoTest methodsFor: 'private' stamp: 'SvenVanCaekenberghe 3/3/2015 11:34'!
withUDPEchoServer: block
	"Run a local UDP echo server on localhost:port and execute block.
	Optionally pass the new process to block. When quit is received, stop the server"
	
	| socket loop result process |
	socket := Socket newUDP setPort: self port; yourself.
	loop := true.
	process := [ 
		[ [ loop ] whileTrue: [ 
			result := self receiveUDPDataFrom: socket.
			"echo what we received to where it came from"
			socket sendUDPData: result first toHost: result second port: result third.
			result first asLowercase = #quit ifTrue: [ loop := false ] ] ]
				ensure: [ socket closeAndDestroy ] ] 
					forkAt: Processor userBackgroundPriority named: 'UDP echo server'.
	^ block cull: process! !

!UDPSocketEchoTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 10/21/2014 14:09'!
testEcho
	| socket message result |
	socket := Socket newUDP.
	[ 
		self withUDPEchoServer: [ :process |
			message := 'Testing ', 99 atRandom asString. 
			socket sendUDPData: message toHost: self localhost port: self port.
			result := self receiveUDPDataFrom: socket.
			self assert: result first equals: message.
			self assert: result second equals: self localhost.
			self assert: result third equals: self port.
			socket sendUDPData: #quit toHost: self localhost port: self port ]  
	] ensure: [ socket closeAndDestroy ]! !

!UDPSocketEchoTest methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/21/2014 14:15'!
localhost
	"Return the host address where the UDP echo service runs, the local host address"
	
	^ NetNameResolver localHostAddress! !

!UDPSocketEchoTest methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/21/2014 14:15'!
port
	"Return the port where the UDP echo service runs"

	^ 6666! !

!UDPSocketEchoTest methodsFor: 'private' stamp: 'SvenVanCaekenberghe 10/21/2014 20:54'!
receiveUDPDataFrom: socket
	"Receive a UDP datagram from socket, return a 3-element array:
	{ contents. source host address. source port }
	We wait indefinitely for incoming data."
	
	| buffer result |
	buffer := String new: 256.
	socket waitForData.
	result := socket receiveUDPDataInto: buffer.
	^ { buffer copyFrom: 1 to: result first. result second. result third }! !

!UDPSocketEchoTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 10/21/2014 14:20'!
runServer
	"Run and return a local UDP echo server"
	
	^ self withUDPEchoServer: [ :process | process ]! !

!UDPSocketEchoTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 10/21/2014 14:33'!
clientSend: message
	"Send message to the local UDP echo service and return the result"
	
	| socket |
	socket := Socket newUDP.
	^ [ 
		socket sendUDPData: message toHost: self localhost port: self port.
		self receiveUDPDataFrom: socket ] 
			ensure: [ socket closeAndDestroy ]! !

!UIManager commentStamp: 'ar 12/27/2004 08:39'!
UIManager is a dispatcher for various UI requests.!
!UIManager methodsFor: 'ui TEasilyThemed' stamp: 'ChristopheDemarey 1/3/2013 11:38'!
questionWithoutCancel: aStringOrText
	"Open a question dialog."

	^self subclassResponsibility ! !

!UIManager methodsFor: '*Deprecated40' stamp: 'MarcusDenker 10/7/2014 11:03'!
displayProgress: titleString at: aPoint from: minVal to: maxVal during: workBlock 
	self 
		deprecated: 'Use displayProgress:at:from:to:during: instead'
		on: 	'7 October 2014' 
		in: 'UIManager'.
	^ self displayProgress: titleString at: aPoint from: minVal to: maxVal during: workBlock ! !

!UIManager methodsFor: 'ui requests' stamp: 'ar 7/15/2005 23:43'!
chooseFrom: labelList values: valueList lines: linesArray title: aString
	"Choose an item from the given list. Answer the selected item."
	^self subclassResponsibility! !

!UIManager methodsFor: 'ui requests' stamp: 'StephaneDucasse 9/7/2011 21:51'!
request: queryString initialAnswer: defaultAnswer
	"Create an instance of me whose question is queryString with the given initial answer. Answer the string the user accepts. Answer the empty string if the user cancels."

	^self subclassResponsibility! !

!UIManager methodsFor: 'ui requests' stamp: 'gvc 2/6/2009 12:44'!
chooseFrom: aList message: messageString title: aString
	"Choose an item from the given list. Answer the index of the selected item."
	
	^self chooseFrom: aList lines: #() message: messageString title: aString! !

!UIManager methodsFor: 'ui requests' stamp: 'StephaneDucasse 9/7/2011 21:21'!
multiLineRequest: queryString initialAnswer: defaultAnswer answerHeight: answerHeight
	"Create a multi-line instance of me whose question is queryString with
	the given initial answer. Invoke it centered at the given point, and
	answer the string the user accepts.  Answer nil if the user cancels.  An
	empty string returned means that the ussr cleared the editing area and
	then hit 'accept'.  Because multiple lines are invited, we ask that the user
	use the ENTER key, or (in morphic anyway) hit the 'accept' button, to 
	submit; that way, the return key can be typed to move to the next line."
	^self subclassResponsibility! !

!UIManager methodsFor: 'ui TEasilyThemed' stamp: 'ChristopheDemarey 1/3/2013 11:36'!
deny: aStringOrText
	"Open a denial dialog."

	^self subclassResponsibility ! !

!UIManager methodsFor: '*Versionner-Core-Model' stamp: 'ChristopheDemarey 10/19/2012 11:25'!
multilineRequest: request initialAnswer: initial
	
	^ self multiLineRequest: request initialAnswer: initial answerHeight: 200! !

!UIManager methodsFor: 'ui requests' stamp: 'gvc 2/6/2009 12:49'!
chooseFrom: aList values: valueList message: messageString
	"Choose an item from the given list. Answer the index of the selected item."
	
	^self chooseFrom: aList values: valueList lines: #() message: messageString! !

!UIManager methodsFor: 'accessing' stamp: 'MarcusDenker 11/5/2014 13:56'!
theme  
	^ Smalltalk ui theme! !

!UIManager methodsFor: 'ui requests' stamp: 'GaryChambers 8/23/2010 12:11'!
confirm: queryString trueChoice: trueChoice falseChoice: falseChoice cancelChoice: cancelChoice default: aSymbol
	"Put up a yes/no/cancel menu with caption queryString. The actual wording for the choices will be as provided in the trueChoice, falseChoice and cancelChoice parameters.
	Default should be one of #yes, #no or #cancel to set the default button.
	Answer true if the response is the true-choice, false if it's the false-choice, nil if the cancelChoice.
	This is a modal question -- the user must respond."
	
	^self subclassResponsibility! !

!UIManager methodsFor: 'ui requests' stamp: 'gvc 2/6/2009 12:47'!
chooseFrom: aList lines: linesArray message: messageString title: aString
	"Choose an item from the given list. Answer the selected item."
	
	^self
		chooseFrom: aList
		lines: linesArray
		title: (aString 
				ifEmpty: [messageString]
				ifNotEmpty: [aString, String cr, messageString])! !

!UIManager methodsFor: 'ui requests' stamp: 'SeanDeNigris 6/20/2012 23:29'!
informUserDuring: aBlock
	"Display a message above (or below if insufficient room) the cursor 
	during execution of the given block.
		UIManager default informUserDuring:[:bar|
			#(one two three) do:[:info|
				bar label: info.
				(Delay forSeconds: 1) wait]]"
	^self subclassResponsibility! !

!UIManager methodsFor: 'ui requests' stamp: 'gvc 2/6/2009 12:50'!
chooseFrom: aList values: valueList message: messageString title: aString
	"Choose an item from the given list. Answer the index of the selected item."
	
	^self chooseFrom: aList values: valueList lines: #() message: messageString title: aString! !

!UIManager methodsFor: 'private' stamp: 'SeanDeNigris 8/30/2012 11:26'!
activate! !

!UIManager methodsFor: 'default actions' stamp: 'pavel.krivanek 6/17/2010 09:27'!
lowSpaceWatcherDefaultAction: preemptedProcess! !

!UIManager methodsFor: 'ui requests' stamp: 'ar 12/27/2004 09:37'!
chooseFrom: aList lines: linesArray title: aString
	"Choose an item from the given list. Answer the index of the selected item."
	^self subclassResponsibility! !

!UIManager methodsFor: 'ui requests' stamp: 'ar 12/27/2004 08:47'!
requestPassword: queryString
	"Create an instance of me whose question is queryString. Invoke it centered
	at the cursor, and answer the string the user accepts. Answer the empty 
	string if the user cancels."
	^self subclassResponsibility! !

!UIManager methodsFor: 'events' stamp: 'Pavel.Krivanek 10/28/2008 11:22'!
onEventSensorStartup: anEventSensor

! !

!UIManager methodsFor: 'ui requests' stamp: 'ar 7/17/2005 00:26'!
chooseFileMatching: patterns
	"Let the user choose a file matching the given patterns"
	^self chooseFileMatching: patterns label: nil! !

!UIManager methodsFor: 'non-interactive' stamp: 'IgorStasenko 1/24/2011 16:31'!
nonInteractiveManager
	" Answer an instance of non-interactive manager, which will be used when image runs headless.
	  We put it here, so subclasses can override it. "
	^ NonInteractiveUIManager replacing: self! !

!UIManager methodsFor: 'private' stamp: 'SeanDeNigris 8/30/2012 11:21'!
beDefault

	self class default: self.! !

!UIManager methodsFor: 'ui requests' stamp: 'StephaneDucasse 6/22/2012 18:49'!
chooseDirectory
	"Let the user choose a directory"
	^self chooseDirectoryFrom: FileSystem workingDirectory! !

!UIManager methodsFor: 'ui requests' stamp: 'AlainPlantec 10/19/2010 16:30'!
request: aStringOrText initialAnswer: defaultAnswer title: aTitle
	"Create an instance of me whose question is queryString with the given 
	initial answer. Invoke it centered at the given point, and answer the 
	string the user accepts. Answer the empty string if the user cancels."
	^self subclassResponsibility! !

!UIManager methodsFor: 'events' stamp: 'IgorStasenko 1/24/2011 15:56'!
onSnapshot: resuming

	"The resuming argument is true when image boots from disk,
	and false, if user just did an image snapshot."

	" do nothing by default "! !

!UIManager methodsFor: 'ui process' stamp: 'MarcusDenker 12/2/2011 16:30'!
terminateUIProcess
	"do nothing by default "! !

!UIManager methodsFor: 'ui requests' stamp: 'ar 12/27/2004 08:39'!
confirm: queryString
	"Put up a yes/no menu with caption queryString. Answer true if the 
	response is yes, false if no. This is a modal question--the user must 
	respond yes or no."
	^self subclassResponsibility! !

!UIManager methodsFor: 'ui requests' stamp: 'SeanDeNigris 6/20/2012 23:35'!
informUser: aString during: aBlock
	"Display a message above (or below if insufficient room) the cursor 
	during execution of the given block.
		UIManager default informUser: 'Just a sec!!' during: [(Delay forSeconds: 1) wait].
	"
	^self informUserDuring: [:bar | bar label: aString. aBlock value].! !

!UIManager methodsFor: 'ui requests' stamp: 'ar 12/27/2004 08:41'!
request: queryString 
	"Create an instance of me whose question is queryString. Invoke it 
	centered at the cursor, and answer the string the user accepts. Answer 
	the empty string if the user cancels."
	^self request: queryString initialAnswer: ''! !

!UIManager methodsFor: 'default actions' stamp: 'IgorStasenko 1/25/2011 13:07'!
warningDefaultAction: aWarning

	"Handle warning notification. Should be overidden by subclass"
	
	self subclassResponsibility  ! !

!UIManager methodsFor: 'default actions' stamp: 'pavel.krivanek 6/17/2010 09:23'!
fileDoesNotExistsDefaultAction: anException

	^ self subclassResponsibility ! !

!UIManager methodsFor: 'ui requests' stamp: 'ar 12/27/2004 08:46'!
inform: aString
	"Display a message for the user to read and then dismiss"
	^self subclassResponsibility! !

!UIManager methodsFor: 'ui requests' stamp: 'StephaneDucasse 2/25/2011 18:44'!
newMenuIn: aThemedMorph for: aModel
	"Answer a new menu."
	
	^ self subclassResponsibility! !

!UIManager methodsFor: 'ui TEasilyThemed' stamp: 'ChristopheDemarey 1/3/2013 11:37'!
proceed: aStringOrText
	"Open a proceed dialog."
	
	^self subclassResponsibility ! !

!UIManager methodsFor: 'ui requests' stamp: ''!
chooseFullFileNameMatching: patterns label: labelString
	"Let the user choose a file matching the given patterns"
	^self subclassResponsibility! !

!UIManager methodsFor: 'ui TEasilyThemed' stamp: 'ChristopheDemarey 1/3/2013 11:36'!
deny: aStringOrText title: aString
	"Open a denial dialog."

	^self subclassResponsibility ! !

!UIManager methodsFor: 'ui TEasilyThemed' stamp: 'ChristopheDemarey 1/3/2013 11:35'!
alert: aStringOrText title: aString configure: aBlock
	"Open an alert dialog.
	Configure the dialog with the 1 argument block
	before opening modally."

	^self subclassResponsibility ! !

!UIManager methodsFor: '*Regex-Core' stamp: 'CamilloBruni 11/21/2012 00:52'!
request: aTitleString regex: initialRegexString
	"Prompt the user for a valid regex.
	Return nil on cancel or a valid RxMatcher"
	| regex |
	regex := initialRegexString.
	"loop until we get a valid regex string back"
	[
		regex := UIManager default 
			multiLineRequest: aTitleString 
			initialAnswer: regex 
			answerHeight: 200.
		"cancelled dialog ==> nil"	
		regex ifNil: [ ^ nil ].
		
		[ ^ regex asRegex ] on: Error do: [ :regexParsingError|
			self defer: [	self inform: 'Bad Regex: ', regexParsingError asString ]].
	] repeat.! !

!UIManager methodsFor: 'ui requests' stamp: 'ar 7/17/2005 00:26'!
chooseFileMatching: patterns label: labelString
	"Let the user choose a file matching the given patterns"
	^self subclassResponsibility! !

!UIManager methodsFor: 'ui requests' stamp: 'AlainPlantec 11/26/2010 10:18'!
request: queryString initialAnswer: defaultAnswer entryCompletion: anEntryCompletion
	"Create an instance of me whose question is queryString with the given 
	initial answer. Invoke it centered at the given point, and answer the 
	string the user accepts. Answer the empty string if the user cancels."
	^self subclassResponsibility! !

!UIManager methodsFor: 'ui process' stamp: 'MarcusDenker 12/2/2011 16:35'!
spawnNewProcessIfThisIsUI: suspendedProcess

	self uiProcess == suspendedProcess ifTrue: [
		self spawnNewProcess.
		^true
	].
	^false		"no new process was created"
! !

!UIManager methodsFor: 'display' stamp: 'Pavel.Krivanek 10/28/2008 11:05'!
restoreDisplay	
	
	self subclassResponsibility ! !

!UIManager methodsFor: 'ui requests' stamp: 'ar 7/15/2005 23:43'!
chooseFrom: labelList values: valueList title: aString
	"Choose an item from the given list. Answer the selected item."
	^self chooseFrom: labelList values: valueList lines: #() title: aString! !

!UIManager methodsFor: 'ui requests' stamp: 'gvc 2/6/2009 12:50'!
chooseFrom: aList values: valueList lines: linesArray message: messageString
	"Choose an item from the given list. Answer the index of the selected item."
	
	^self chooseFrom: aList values: valueList lines: linesArray message: messageString title: ''! !

!UIManager methodsFor: 'ui requests' stamp: 'EstebanLorenzano 11/21/2009 10:48'!
chooseOrRequestFrom: labelList values: valueList lines: linesArray title: aString
	self subclassResponsibility! !

!UIManager methodsFor: 'ui requests' stamp: 'dc 1/10/2008 08:09'!
confirm: queryString trueChoice: trueChoice falseChoice: falseChoice 
	"Put up a yes/no menu with caption queryString. The actual wording for the two choices will be as provided in the trueChoice and falseChoice parameters. Answer true if the response is the true-choice, false if it's the false-choice.
	This is a modal question -- the user must respond one way or the other."
	^self subclassResponsibility! !

!UIManager methodsFor: 'ui requests' stamp: 'AlainPlantec 4/15/2010 10:39'!
enterOrRequestFrom: aList title: aString
	"Choose an item from the given list. Answer the index of the selected item."
	^self enterOrRequestFrom: aList lines: #() title: aString! !

!UIManager methodsFor: 'ui requests' stamp: 'ar 7/16/2005 18:56'!
edit: aText
	"Open an editor on the given string/text"
	^self edit: aText label: nil! !

!UIManager methodsFor: 'ui requests' stamp: 'ar 12/27/2004 10:44'!
chooseFrom: aList
	"Choose an item from the given list. Answer the index of the selected item."
	^self chooseFrom: aList lines: #()! !

!UIManager methodsFor: 'events' stamp: 'Pavel.Krivanek 10/28/2008 11:01'!
onDebug: process context: context title: title full: bool! !

!UIManager methodsFor: 'default actions' stamp: 'pavel.krivanek 6/17/2010 09:19'!
fileExistsDefaultAction: anException

	^ self subclassResponsibility ! !

!UIManager methodsFor: 'default actions' stamp: 'pavel.krivanek 6/17/2010 09:24'!
onFontsChanged

	! !

!UIManager methodsFor: 'default actions' stamp: 'pavel.krivanek 6/17/2010 09:25'!
syntaxErrorNotificationDefaultAction: anException

	^ self subclassResponsibility ! !

!UIManager methodsFor: 'default actions' stamp: 'IgorStasenko 1/25/2011 13:07'!
unhandledErrorDefaultAction: anException

	"Provide a default handling for unhandled error. 
	We should never reach this code, because it should be overridden by subclasses. 
	(but we can't put 'self subclassResponsibility' , because it will cause infinite loop,
	in case if current ui manager having no override of this method).
	This method is only for documentation purposes."
		
	Smalltalk snapshot: false andQuit: true.! !

!UIManager methodsFor: 'display' stamp: 'CamilloBruni 8/30/2012 16:20'!
displayProgress: titleString from: minVal to: maxVal during: workBlock
	"SystemProgressMorph show: titleString from: minVal to:  during: "

	^ workBlock asJob
			title: titleString;
			min: minVal;
			max: maxVal;
			run.! !

!UIManager methodsFor: 'ui requests' stamp: 'ar 7/16/2005 18:56'!
edit: aText label: labelString
	"Open an editor on the given string/text"
	^self edit: aText label: labelString accept: nil! !

!UIManager methodsFor: 'ui process' stamp: 'PavelKrivanek 7/17/2014 10:17'!
defer: aBlock
	" Evaluate the given Block in the UI thread as soon as there is nothing scheduled. Evaluate immediately when there is no UI"
	aBlock value! !

!UIManager methodsFor: 'ui requests' stamp: 'SeanDeNigris 1/23/2014 00:06'!
merge: merger informing: aString

	self subclassResponsibility.! !

!UIManager methodsFor: 'ui requests' stamp: 'AlainPlantec 11/25/2010 17:42'!
request: aStringOrText initialAnswer: defaultAnswer title: aTitle entryCompletion: anEntryCompletion
	"Create an instance of me whose question is queryString with the given 
	initial answer. Invoke it centered at the given point, and answer the 
	string the user accepts. Answer the empty string if the user cancels."
	^self subclassResponsibility! !

!UIManager methodsFor: 'ui requests' stamp: 'jrd 5/12/2009 18:02'!
confirm: queryString label: titleString
	
	^self subclassResponsibility! !

!UIManager methodsFor: 'ui TEasilyThemed' stamp: 'ChristopheDemarey 1/3/2013 11:39'!
textEntry: aStringOrText title: aString entryText: defaultEntryText
	"Open a text entry dialog."

	^self subclassResponsibility ! !

!UIManager methodsFor: 'ui requests' stamp: 'ar 7/15/2005 23:42'!
chooseFrom: labelList values: valueList
	"Choose an item from the given list. Answer the selected item."
	^self chooseFrom: labelList values: valueList lines: #()! !

!UIManager methodsFor: 'ui TEasilyThemed' stamp: 'ChristopheDemarey 1/3/2013 11:42'!
alert: aStringOrText
	"Open an alert dialog."
	
	^ self subclassResponsibility! !

!UIManager methodsFor: 'ui TEasilyThemed' stamp: 'ChristopheDemarey 1/3/2013 11:42'!
alert: aStringOrText title: aString
	"Open an alert dialog."
	
	^self subclassResponsibility ! !

!UIManager methodsFor: 'ui TEasilyThemed' stamp: 'ChristopheDemarey 1/3/2013 11:37'!
proceed: aStringOrText title: aString
	"Open a proceed dialog and answer true if not cancelled, false otherwise."
	
	^self subclassResponsibility ! !

!UIManager methodsFor: 'ui requests' stamp: 'ar 7/16/2005 19:36'!
chooseDirectoryFrom: dir
	"Let the user choose a directory"
	^self chooseDirectory: nil from: dir! !

!UIManager methodsFor: 'ui requests' stamp: 'ar 7/16/2005 18:56'!
edit: aText label: labelString accept: anAction
	"Open an editor on the given string/text"
	^self subclassResponsibility! !

!UIManager methodsFor: 'private' stamp: 'SeanDeNigris 8/30/2012 11:20'!
deactivate! !

!UIManager methodsFor: 'ui requests' stamp: 'gvc 2/6/2009 12:45'!
chooseFrom: aList lines: linesArray message: messageString
	"Choose an item from the given list. Answer the index of the selected item."
	
	^self chooseFrom: aList lines: linesArray message: messageString title: ''! !

!UIManager methodsFor: 'ui TEasilyThemed' stamp: 'ChristopheDemarey 1/3/2013 11:35'!
abort: aStringOrText
	"Open an error dialog."

	^self subclassResponsibility ! !

!UIManager methodsFor: 'accessing' stamp: 'CamilloBruni 2/9/2012 13:06'!
headlessManager
	" Answer an instance of headless manager, which will be used when image runs headless and non-interactive.
	  We put it here, so subclasses can override it. "
	^ CommandLineUIManager replacing: self! !

!UIManager methodsFor: 'ui requests' stamp: 'gvc 2/6/2009 12:52'!
chooseFrom: labelList values: valueList lines: linesArray message: messageString title: aString
	"Choose an item from the given list. Answer the selected item."
	
	^self
		chooseFrom: labelList
		values: valueList 
		lines: linesArray
		title: (aString 
				ifEmpty: [messageString]
				ifNotEmpty: [aString, String cr, messageString])! !

!UIManager methodsFor: 'ui requests' stamp: 'gvc 2/6/2009 12:45'!
chooseFrom: aList message: messageString
	"Choose an item from the given list. Answer the index of the selected item."
	
	^self chooseFrom: aList lines: #() message: messageString! !

!UIManager methodsFor: '*Deprecated40' stamp: 'MarcusDenker 10/7/2014 11:07'!
request: queryString initialAnswer: defaultAnswer centerAt: aPoint
	"Create an instance of me whose question is queryString with the given
	initial answer. Invoke it centered at the given point, and answer the
	string the user accepts. Answer the empty string if the user cancels."

	self 
		deprecated: 'Use request:initialAnswer: instead'
		on: 	'7 October 2014' 
		in: 'UIManager'.
	^self subclassResponsibility! !

!UIManager methodsFor: 'settings' stamp: 'CamilloBruni 7/10/2013 16:34'!
interactiveParserFor: requestor	
	
	requestor ifNil: [^ false ].
	(requestor respondsTo: #interactive)
		ifTrue: [ ^requestor interactive ].
	^true! !

!UIManager methodsFor: 'ui requests' stamp: 'ar 7/15/2005 23:43'!
chooseFrom: labelList values: valueList lines: linesArray
	"Choose an item from the given list. Answer the selected item."
	^self chooseFrom: labelList values: valueList lines: linesArray title: ''! !

!UIManager methodsFor: 'ui TEasilyThemed' stamp: 'ChristopheDemarey 1/3/2013 11:37'!
question: aStringOrText title: aString
	"Open a question dialog and answer true if yes,
	false if no and nil if cancelled."

	^self subclassResponsibility ! !

!UIManager methodsFor: 'ui process' stamp: 'MarcusDenker 12/2/2011 16:44'!
interruptName: labelString preemptedProcess: theInterruptedProcess
	"Create a Notifier on the active scheduling process with the given label."

	^ self error: 'Cannot perform a given request'! !

!UIManager methodsFor: 'ui TEasilyThemed' stamp: 'ChristopheDemarey 1/3/2013 11:38'!
textEntry: aStringOrText title: aString
	"Open a text entry dialog."

	^self subclassResponsibility ! !

!UIManager methodsFor: 'ui requests' stamp: 'ar 12/27/2004 09:49'!
confirm: aString orCancel: cancelBlock
	"Put up a yes/no/cancel menu with caption aString. Answer true if  
	the response is yes, false if no. If cancel is chosen, evaluate  
	cancelBlock. This is a modal question--the user must respond yes or no."
	^self subclassResponsibility! !

!UIManager methodsFor: 'ui requests' stamp: 'StephaneDucasse 6/22/2012 18:49'!
chooseDirectory: label
	"Let the user choose a directory"
	^self chooseDirectory: label from: FileSystem workingDirectory! !

!UIManager methodsFor: 'ui requests' stamp: 'Pavel.Krivanek 10/28/2008 10:45'!
fontFromUser: priorFont	
	
	self subclassResponsibility! !

!UIManager methodsFor: 'ui requests' stamp: 'CarloTeixeira 5/23/2011 15:40'!
chooseFullFileNameMatching: patterns
	"Let the user choose a file matching the given patterns"
	^self chooseFullFileNameMatching: patterns label: nil! !

!UIManager methodsFor: 'display' stamp: 'Pavel.Krivanek 10/28/2008 11:05'!
checkForNewDisplaySize	
	
	self subclassResponsibility ! !

!UIManager methodsFor: 'ui TEasilyThemed' stamp: 'ChristopheDemarey 1/3/2013 11:37'!
question: aStringOrText
	"Open a question dialog."
	
	^self subclassResponsibility ! !

!UIManager methodsFor: 'display' stamp: 'Pavel.Krivanek 10/28/2008 11:05'!
newDisplayDepthNoRestore: pixelSize	
	
	self subclassResponsibility ! !

!UIManager methodsFor: 'ui requests' stamp: 'EstebanLorenzano 11/21/2009 17:01'!
chooseOrRequestFrom: aList title: aString
	"Choose an item from the given list. Answer the index of the selected item."
	^self chooseOrRequestFrom: aList lines: #() title: aString! !

!UIManager methodsFor: 'ui TEasilyThemed' stamp: 'ChristopheDemarey 1/3/2013 11:38'!
textEntry: aStringOrText
	"Open a text entry dialog."

	^self subclassResponsibility ! !

!UIManager methodsFor: 'ui requests' stamp: 'FernandoOlivero 3/30/2011 15:47'!
openComparisionFrom: targetMethodSource
					to: originalMethodSource
					belongingTo: aClass
					from: aChange 
	^ self subclassResponsibility				! !

!UIManager methodsFor: 'ui TEasilyThemed' stamp: 'ChristopheDemarey 1/3/2013 11:38'!
questionWithoutCancel: aStringOrText title: aString
	"Open a question dialog and answer true if yes,
	false if no and nil if cancelled."

	^self subclassResponsibility ! !

!UIManager methodsFor: 'image startup' stamp: 'SeanDeNigris 8/30/2012 11:23'!
boot: bootingFromDisk during: aBlock

	bootingFromDisk ifTrue: [ 
		"use non-interactive manager while processing startup list"
		self class default: (StartupUIManager replacing: self) ].

	aBlock ensure: [ self class default: self ].

	self onSnapshot: bootingFromDisk! !

!UIManager methodsFor: 'events' stamp: 'Pavel.Krivanek 10/28/2008 11:01'!
onPrimitiveError: aString	! !

!UIManager methodsFor: 'ui requests' stamp: 'ar 12/27/2004 10:44'!
chooseFrom: aList title: aString
	"Choose an item from the given list. Answer the index of the selected item."
	^self chooseFrom: aList lines: #() title: aString! !

!UIManager methodsFor: 'ui requests' stamp: 'ar 7/16/2005 19:36'!
chooseDirectory: label from: dir
	"Let the user choose a directory"
	^self subclassResponsibility! !

!UIManager methodsFor: 'ui requests' stamp: 'ar 12/27/2004 10:45'!
chooseFrom: aList lines: linesArray
	"Choose an item from the given list. Answer the index of the selected item."
	^self chooseFrom: aList lines: linesArray title: ''! !

!UIManager methodsFor: 'display' stamp: 'Pavel.Krivanek 10/28/2008 11:05'!
restoreDisplayAfter: aBlock	
	
	self subclassResponsibility ! !

!UIManager methodsFor: 'ui requests' stamp: 'AlainPlantec 11/26/2010 10:18'!
request: queryString entryCompletion: anEntryCompletion
	"Create an instance of me whose question is queryString. Invoke it 
	centered at the cursor, and answer the string the user accepts. Answer 
	the empty string if the user cancels."
	^self request: queryString initialAnswer: '' entryCompletion: anEntryCompletion! !

!UIManager methodsFor: 'ui process' stamp: 'MarcusDenker 12/2/2011 16:35'!
spawnNewProcess.

	"do nothing by default"! !

!UIManager methodsFor: 'ui TEasilyThemed' stamp: 'ChristopheDemarey 1/3/2013 11:36'!
abort: aStringOrText title: aString
	"Open an error dialog."

	^self subclassResponsibility ! !

!UIManager class methodsFor: 'initialization' stamp: 'GabrielOmarCotelli 12/4/2013 09:59'!
default
	^ Default
		ifNil: [ 
			"Note: The way the following is phrased ensures that you can always make 'more specific' managers merely by subclassing a tool builder and implementing a more specific way of reacting to #isActiveManager. For example, a BobsUIManager can subclass MorphicUIManager and will be considered before the parent (generic MorphicUIManager)."
			self allSubclasses
				detect: [ :any | any isActiveManager and: [ any subclasses noneSatisfy: [ :sub | sub isActiveManager ] ] ]
				ifFound: [ :mgrClass | Default := mgrClass new ] ]! !

!UIManager class methodsFor: 'initialization' stamp: 'SeanDeNigris 8/30/2012 11:25'!
default: aUIManager

	Default deactivate.
	Default := aUIManager.
	Default activate.! !

!UIManager class methodsFor: 'initialization' stamp: 'ar 2/11/2005 15:41'!
isActiveManager
	"Answer whether I should act as the active ui manager"
	^false! !

!UIManager class methodsFor: 'utils' stamp: 'nice 1/5/2010 15:59'!
createPageTestWorkspace
	"Used to generate a workspace window for testing page up and page down stuff."
	"self createPageTestWorkspace"

	| numberOfLines maxStringLength minLineCounterSize lineCounterSize offsetSize stream headerConstant prevStart prevStrLen prevLineNumber |
	numberOfLines := 400.
	maxStringLength := 22.
	minLineCounterSize := 3.
	lineCounterSize := (numberOfLines log asInteger + 1) max: minLineCounterSize.
	offsetSize := 5.
	stream := ReadWriteStream on: ''.
	headerConstant := lineCounterSize + 1 + offsetSize + 1.
	prevStart := headerConstant negated.
	prevStrLen := 0.
	prevLineNumber := 0.
	numberOfLines timesRepeat: [ | pad lineNumber stringLen start charIndex log |
		stringLen := maxStringLength atRandom max: 1.
		lineNumber := prevLineNumber + 1.
		start := prevStart + prevStrLen + headerConstant + 1.
		prevStart := start.
		prevStrLen := stringLen.
		prevLineNumber := lineNumber.
		log := lineNumber log asInteger.
		pad := lineCounterSize - log - 1.
		pad timesRepeat: [stream nextPutAll: '0'].
		stream nextPutAll: lineNumber printString.
		stream space.
		log := start log asInteger.
		pad := offsetSize - log - 1.
		pad timesRepeat: [stream nextPutAll: '0'].
		stream nextPutAll: start printString.
		stream space.
		charIndex := 'a' first asInteger.
		stringLen timesRepeat: [ | char |
			char := Character value: charIndex.
			charIndex := charIndex + 1.
			stream nextPut: char].
		lineNumber = numberOfLines ifFalse: [stream cr]
		].
	self default edit: stream contents label: 'Test Data'.
! !

!UIManager class methodsFor: 'utils' stamp: 'DamienPollet 10/26/2011 17:23'!
nonInteractiveDuring: aBlock
	| currentManager |
	currentManager := self default.
	currentManager nonInteractiveManager.
	
	aBlock ensure: [ currentManager beDefault ]! !

!UITestCase commentStamp: '<historical>'!
All instances of UITestCase are skipped in headless mode.!
!UITestCase methodsFor: 'running' stamp: 'BenComan 2/7/2014 00:25'!
runCase
	| result |
	"Skip the test if we're in headless mode"
	self flag: 'Use skip feature once it is ready'.
	Smalltalk isHeadless
		ifTrue: [ ^ self skip ].
	SystemProgressMorph allInstances do: [  :spm | spm hide ].
	World activeHand resetClickState.
	result := super runCase .
	SystemProgressMorph allInstances do: [  :spm | spm show ].
	^ result! !

!UITheme commentStamp: 'HilaireFernandes 3/22/2014 17:21'!
Common superclass for User Interface themes. Provides methods for creating new morphs in a standard way, various "services" like a file dialog, message dialogs etc. and also methods for customising aspects of the appearance of various morphs.
Though conceptually abstract, no code is "missing". Subclasses, therefore, should override the aspects they wish to change.

WidgetExamples new exampleBasicControls
WidgetExamples new exampleOtherControls
WidgetExamples new exampleColorControls
WidgetExamples new exampleDialogs
WidgetExamples new exampleGroups
WidgetExamples new exampleTextEntryWithCompletionDialog
WidgetExamples new exampleWindowWithToolbars!
!UITheme methodsFor: 'label-styles' stamp: 'gvc 5/15/2007 10:00'!
windowMinimizeForm
	"Answer the form to use for the minimize button of a window."

	^self forms at: #windowMinimize ifAbsent: [Form extent: 10@10 depth: Display depth]! !

!UITheme methodsFor: 'fill-styles-buttons' stamp: 'BenjaminVanRyseghem 3/18/2013 23:08'!
checkboxButtonLabelNormalFillStyleFor: aCheckboxButton label: aLabel
	"Return the selected disabled checkbox button fillStyle for the given button."
	
	^ aLabel color! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 2/9/2009 17:12'!
configureWindowDropShadowFor: aWindow
	"Configure the drop shadow for the given window."

	aWindow
		addDropShadow;
		shadowColor: self windowShadowColor;
		shadowOffset: 1@1! !

!UITheme methodsFor: 'basic-colors' stamp: 'gvc 5/9/2007 15:11'!
taskbarMinimizedButtonColorFor: aButton
	"Answer the colour for the given minimized taskbar button."

	^self taskbarButtonColorFor: aButton! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 1/27/2009 16:43'!
scrollPaneNormalBorderStyleFor: aScrollPane
	"Return the normal borderStyle for the given scroll pane"

	^BorderStyle inset
		width: 1;
		baseColor: aScrollPane paneColor! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 5/22/2007 10:53'!
windowInactiveTitleFillStyleFor: aWindow
	"Return the window inactive title fillStyle for the given color."
	
	^self windowActiveTitleFillStyleFor: aWindow! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 1/16/2007 15:49'!
newLabelIn: aThemedMorph label: aString
	"Answer a new text label."

	^self
		newLabelIn: aThemedMorph
		for: nil
		label: aString
		getEnabled: nil! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 1/16/2007 14:15'!
newEmbeddedMenuIn: aThemedMorph for: aModel
	"Answer a new menu."

	^EmbeddedMenuMorph new
		defaultTarget: aModel;
		color: (self menuColorFor: aThemedMorph)! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 4/26/2007 10:14'!
splitterPressedFillStyleFor: aSplitter
	"Return the pressed splitter fillStyle for the given splitter."
	
	|aColor|
	aColor := aSplitter paneColor twiceDarker.
	^(GradientFillStyle ramp: {
			0.0->Color white. 0.4-> aColor twiceLighter.
			1.0->aColor darker duller})
		origin: aSplitter topLeft;
		direction: (aSplitter splitsTopAndBottom
			ifTrue: [0 @ aSplitter height]
			ifFalse: [aSplitter width @ 0]);
		radial: false! !

!UITheme methodsFor: 'fill-styles' stamp: 'AlainPlantec 12/14/2009 14:30'!
windowInactiveLabelFillStyleFor: aWindow
	"Return the window inactive label fillStyle for the given window."
	
	^self settings fadedBackgroundWindows
		ifTrue: [aWindow paneColorToUse alphaMixed: 0.6 with: Color black]
		ifFalse: [self windowActiveLabelFillStyleFor: aWindow]! !

!UITheme methodsFor: 'defaults' stamp: 'gvc 12/3/2008 17:22'!
buttonMinWidth
	"Answer the minumum width of a button for this theme."
	
	^16! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 9/19/2006 09:59'!
newGroupboxIn: aThemedMorph for: control
	"Answer a plain groupbox."

	^(self newGroupboxIn: aThemedMorph)
		addMorph: control! !

!UITheme methodsFor: 'initialize-release' stamp: 'HilaireFernandes 3/22/2014 16:34'!
initializeForms
	"Initialize the receiver's image forms."

	self forms: Dictionary new.
	self forms
		at: #checkboxMarker put: self newCheckboxMarkerForm;
		at: #radioButtonMarker put: self newRadioButtonMarkerForm;
		at: #treeExpanded put: self newTreeExpandedForm;
		at: #treeUnexpanded put: self newTreeUnexpandedForm;
		at: #windowClose put: self newWindowCloseForm;
		at: #windowMinimize put: self newWindowMinimizeForm;
		at: #windowMaximize put: self newWindowMaximizeForm;
		at: #windowMenu put: self newWindowMenuForm;
		at: #windowCloseOver put: self newWindowCloseOverForm;
		at: #windowMinimizeOver put: self newWindowMinimizeOverForm;
		at: #windowMaximizeOver put: self newWindowMaximizeOverForm! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 12/8/2008 19:17'!
checkboxCornerStyleFor: aCheckbox
	"Answer the corner style for checkbox buttons."
	
	^#square! !

!UITheme methodsFor: 'initialize-release' stamp: 'gvc 10/25/2007 17:47'!
newCheckboxMarkerForm
	"Answer a new checkbox marker form."

	^(Form
	extent: 12@12
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1342177280 1610612736 134217728 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3338665984 4278190080 1476395008 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 671088640 4278190080 4009754624 134217728 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2147483648 4278190080 2533359616 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3607101440 4278190080 1207959552 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1073741824 4278190080 3875536896 16777215 16777215 16777215 16777215 16777215 1207959552 3204448256 134217728 16777215 2801795072 4278190080 2147483648 16777215 16777215 16777215 16777215 134217728 3607101440 4278190080 2936012800 268435456 4143972352 4278190080 536870912 16777215 16777215 16777215 16777215 16777215 536870912 4009754624 4278190080 3607101440 4278190080 3070230528 16777215 16777215 16777215 16777215 16777215 16777215 16777215 805306368 4009754624 4278190080 4278190080 1342177280 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 671088640 2936012800 2801795072 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: 0@0)! !

!UITheme methodsFor: '*growl' stamp: 'TudorGirba 10/25/2011 17:07'!
growlBorderColorFor: aGrowlMorph
	^ Color transparent ! !

!UITheme methodsFor: 'fill-styles' stamp: 'SeanDeNigris 1/23/2014 12:51'!
taskListFillStyleFor: aTasklist
	
	| aColor result |
	aColor := aTasklist color.
	result := GradientFillStyle ramp: {
			0.0->aColor whiter whiter. 0.2->aColor lighter.
			0.8->aColor darker. 1.0->aColor blacker}.
	^ result		
		origin: aTasklist topLeft;
		direction: 0 @ aTasklist height;
		radial: false;
		yourself.! !

!UITheme methodsFor: 'border-styles-scrollbars' stamp: 'gvc 10/24/2007 15:05'!
scrollbarThumbCornerStyleIn: aThemedMorph
	"Allow for themes to override default behaviour."
	
	^#square! !

!UITheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 4/29/2014 14:48'!
selectionTextColor
 ^ self settings selectionTextColor! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 1/4/2007 11:54'!
newPanelIn: aThemedMorph
	"Answer a new panel."

	^PanelMorph new
		changeTableLayout;
		layoutInset: 4;
		cellInset: 8;
		cornerStyle: aThemedMorph preferredCornerStyle;
		yourself! !

!UITheme methodsFor: 'services' stamp: 'GaryChambers 12/6/2011 10:00'!
abortIn: aThemedMorph text: aStringOrText title: aString
	"Answer the result of an error dialog (true) with the given label and title."

	self abortSound play.
	^(aThemedMorph openModal: (
		(ErrorDialogWindow newWithTheme: aThemedMorph theme)
			textFont: self textFont;
			title: aString;
			text: aStringOrText)) cancelled not! !

!UITheme methodsFor: 'fill-styles-buttons' stamp: 'gvc 4/25/2007 18:53'!
buttonSelectedFillStyleFor: aButton
	"Return the button selected fillStyle for the given color."
	
	^self buttonNormalFillStyleFor: aButton! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 5/23/2007 13:10'!
textEditorNormalBorderStyleFor: aTextEditor
	"Return the normal text editor borderStyle for the given text editor."

	^BorderStyle inset
		width: 1;
		baseColor: aTextEditor paneColor! !

!UITheme methodsFor: 'configure' stamp: 'EstebanLorenzano 4/29/2014 12:52'!
configureScrollPane: aMorph
	aMorph color: Color white.! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 9/19/2006 10:03'!
newToolSpacerIn: aThemedMorph
	"Answer a new tool spacer."

	^Morph new
		borderWidth: 0;
		color: Color transparent;
		extent: 3@3! !

!UITheme methodsFor: 'morph creation' stamp: 'GaryChambers 12/8/2011 16:44'!
newExpanderIn: aThemedMorph label: aString forAll: controls
	"Answer an expander with the given label and controls."

	|answer|
	answer := ExpanderMorph basicNew
		basicTheme: self;
		initialize;
		font: self menuFont;
		titleText: aString;
		basicTheme: nil.
	controls do: [:m |
		answer addMorphBack: m].
	^answer! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 1/16/2008 13:44'!
groupPanelBorderStyleFor: aGroupPanel
	"Answer the normal border style for a group panel."

	^BorderStyle simple
		width: 0;
		baseColor: Color transparent! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 3/6/2010 17:24'!
newSVSelectorIn: aThemedMorph color: aColor help: helpText
	"Answer a saturation-volume selector."

	^SVColorSelectorMorph new
		color: aColor;
		selectedColor: aColor;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		setBalloonText: helpText! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 1/16/2007 15:49'!
newLabelIn: aThemedMorph for: aModel label: aString getEnabled: enabledSel
	"Answer a new text label."

	^(LabelMorph contents: aString font: self labelFont)
		model: aModel;
		getEnabledSelector: enabledSel! !

!UITheme methodsFor: 'border-styles-scrollbars' stamp: 'gvc 4/2/2007 14:04'!
scrollbarPressedButtonBorderStyleFor: aScrollbar
	"Return the pressed button borderStyle for the given scrollbar."

	^self scrollbarPressedThumbBorderStyleFor: aScrollbar! !

!UITheme methodsFor: 'sounds' stamp: 'gvc 9/12/2007 14:46'!
windowRestoreDownSound
	"Answer the window restore down sound."

	^self soundTheme windowRestoreDownSound! !

!UITheme methodsFor: 'sounds' stamp: 'gvc 9/12/2007 14:43'!
questionSound
	"Answer the question sound."

	^self soundTheme questionSound! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 2/16/2009 17:18'!
windowActiveDropShadowStyle
	"Answer the style of drop shadow to use for active windows."
	
	^#plain! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 8/10/2007 10:14'!
radioButtonDisabledBorderStyleFor: aRadioButton
	"Return the disabled radio button borderStyle for the given button."

	^self checkboxButtonDisabledBorderStyleFor: aRadioButton! !

!UITheme methodsFor: 'defaults' stamp: 'gvc 10/7/2008 11:45'!
scrollbarMinimumThumbThickness
	"Answer the minumum width or height of a scrollbar thumb 
	as appropriate to its orientation."
	
	^7! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 4/25/2007 17:27'!
buttonDisabledBorderStyleFor: aButton
	"Return the disabled button borderStyle for the given button."

	^self buttonNormalBorderStyleFor: aButton! !

!UITheme methodsFor: 'fill-styles-buttons' stamp: 'gvc 11/13/2007 11:29'!
controlButtonMouseOverFillStyleFor: aButton
	"Return the mouse over control button fillStyle for the given button.
	Control buttons are generally used for drop-lists and expanders."
	
	^self buttonMouseOverFillStyleFor: aButton! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 5/15/2007 17:41'!
newDialogPanelIn: aThemedMorph
	"Answer a new (main) dialog panel."

	^self newPanelIn: aThemedMorph! !

!UITheme methodsFor: 'morph creation' stamp: 'GaryChambers 12/2/2011 11:49'!
newOKButtonIn: aThemedMorph for: aModel getEnabled: enabledSel
	"Answer a new OK button."

	^self
		newButtonIn: aThemedMorph
		for: aModel
		getState: nil
		action: #ok
		arguments: nil
		getEnabled: enabledSel
		label: 'OK' translated
		help: 'Apply changes and close the window' translated! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 8/9/2007 13:16'!
newMorphDropListIn: aThemedMorph for: aModel list: listSel getSelected: getSel setSelected: setSel getEnabled: enabledSel help: helpText
	"Answer a morph drop list for the given model."

	^self
		newMorphDropListIn: aThemedMorph
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		useIndex: true
		help: helpText! !

!UITheme methodsFor: 'accessing' stamp: 'gvc 9/22/2006 17:19'!
settings
	"Answer the value of settings"

	^ settings! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 2/16/2009 17:20'!
drawWindowPlainDropShadowFor: aSystemWindow on: aCanvas
	"Draw the plain drop shadow for the given window."
	
	|blOffset brOffset trOffset|
	(aSystemWindow owner notNil and: [aSystemWindow owner isHandMorph])
		ifTrue: [^self]. "skip if being dragged"
	blOffset := (aSystemWindow wantsRoundedCorners and: [aSystemWindow roundedCorners includes: 2])	
		ifTrue: [7] ifFalse: [1].
	brOffset := (aSystemWindow wantsRoundedCorners and: [aSystemWindow roundedCorners includes: 3])	
		ifTrue: [7] ifFalse: [1].
	trOffset := (aSystemWindow wantsRoundedCorners and: [aSystemWindow roundedCorners includes: 4])	
		ifTrue: [7] ifFalse: [1].
	aCanvas
		fillRectangle: (aSystemWindow bounds bottomLeft + (blOffset @ 0)
						corner: aSystemWindow bounds bottomRight - (brOffset @ -1))
		fillStyle: aSystemWindow shadowColor;
		fillRectangle: (aSystemWindow bounds topRight + (0 @ trOffset)
						corner: aSystemWindow bounds bottomRight + (1 @ brOffset negated))
		fillStyle: aSystemWindow shadowColor.
	aCanvas
		clipBy: (aSystemWindow bounds bottomRight - brOffset
			corner: aSystemWindow bounds bottomRight + (1@1))
			during: [:c | ((RoundedBorder new
							baseColor: aSystemWindow shadowColor;
							width: 1) cornerRadius: brOffset - 1)
							frameRectangle: (aSystemWindow bounds translateBy: 1)
							on: c]! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 8/10/2007 10:14'!
radioButtonNormalBorderStyleFor: aRadioButton
	"Return the disabled radio button borderStyle for the given button."

	^self checkboxButtonNormalBorderStyleFor: aRadioButton! !

!UITheme methodsFor: 'accessing' stamp: 'gvc 7/30/2009 18:34'!
soundTheme
	"Answer the sound theme to use, if not specified
	use the default sound theme."

	^soundTheme ifNil: [self defaultSoundTheme]! !

!UITheme methodsFor: 'morph creation' stamp: 'GaryChambers 10/5/2010 13:50'!
newOverflowRowIn: aThemedMorph forAll: aCollectionOfMorphs
	"Answer a new overflow row morph with the given contents."

	^OverflowRowMorph new
		baseMorphs: aCollectionOfMorphs;
		yourself! !

!UITheme methodsFor: 'initialize-release' stamp: 'gvc 5/24/2007 10:11'!
newWindowMinimizeForm
	"Answer a new form for a window minimize box."

	^Form
		extent: 10@10
		depth: 32
		fromArray: #( 0 0 4127260929 4127260929 4127260929 4127260929 4127260929 0 0 0 0 3875602689 3212869760 3212869760 3212869760 3212869760 3212869760 4227924225 0 0 4127260929 3212869760 3212869760 0 0 0 0 3212869760 4127260929 0 4127260929 3212869760 0 0 0 0 0 0 4127260929 3212869760 4127260929 3212869760 0 0 0 0 0 0 4127260929 3212869760 4127260929 3212869760 0 0 0 0 0 0 4127260929 3212869760 4128708375 3212869760 0 0 0 0 0 0 4127260929 3212869760 0 4127260929 3212869760 0 0 0 0 4127260929 3208659008 3212869760 0 3208659008 4127260929 4127260929 4127260929 4127260929 4127260929 3208659008 3212869760 0 0 0 3212869760 3212869760 3212869760 3212869760 3212869760 3212869760 0 0)
		offset: 0@0! !

!UITheme methodsFor: 'services' stamp: 'GaryChambers 12/2/2011 12:01'!
chooseFileNameIn: aThemedMorph title: title extensions: exts path: path preview: preview
	"Answer the result of a file name chooser dialog with the given title, extensions
	path and preview type.
	Answer nil or a filename."

	|fd|
	fd := FileDialogWindow basicNew
		basicTheme: aThemedMorph theme;
		previewType: preview;
		initialize;
		title: title;
		answerFileName.
	exts ifNotNil: [fd validExtensions: exts].
	path ifNotNil: [fd selectPathName: path].
	^(aThemedMorph openModal: fd) answer! !

!UITheme methodsFor: 'fill-styles-scrollbars' stamp: 'gvc 3/30/2007 10:42'!
scrollbarPressedButtonFillStyleFor: aScrollbar
	"Return the pressed scrollbar button fillStyle for the given scrollbar."
	
	^self scrollbarPressedThumbFillStyleFor: aScrollbar! !

!UITheme methodsFor: 'morph creation' stamp: 'GaryChambers 12/2/2011 11:15'!
newButtonIn: aThemedMorph for: aModel getState: stateSel action: actionSel arguments: args getEnabled: enabledSel getLabel: labelSel help: helpText
	"Answer a new button."

	|b|
	b := PluggableButtonMorph
			on: aModel
			getState: stateSel
			action: actionSel
			label: labelSel.
	b
		theme: self;
		label: ' ' font: self buttonFont;
		update: labelSel;
		arguments: (args ifNil: [{b}]);
		getEnabledSelector: enabledSel;
		cornerStyle: (self buttonCornerStyleIn: aThemedMorph);
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap;
		setBalloonText: helpText;
		extent: b minExtent;
		removeProperty: #theme.
	^b! !

!UITheme methodsFor: 'fill-styles' stamp: 'AlainPlantec 2/11/2011 22:31'!
morphTreeSplitterPressedFillStyleFor: aSplitter
	"Return the pressed splitter fillStyle for the given splitter."
	
	|aColor|
	aColor := aSplitter paneColor twiceDarker.
	^(GradientFillStyle ramp: {
			0.0->Color white. 0.4-> aColor twiceLighter.
			1.0->aColor darker duller})
		origin: aSplitter topLeft;
		direction: (aSplitter splitsTopAndBottom
			ifTrue: [0 @ aSplitter height]
			ifFalse: [aSplitter width @ 0]);
		radial: false! !

!UITheme methodsFor: 'defaults' stamp: 'gvc 1/20/2009 16:39'!
dropListFocusIndicatorCornerRadiusFor: aDropList
	"Answer the default corner radius preferred for the focus indicator
	for the drop list for themes that support this."

	^self focusIndicatorCornerRadiusFor: aDropList! !

!UITheme methodsFor: 'border-styles' stamp: 'StephaneDucasse 12/26/2011 12:31'!
drawWindowDiffuseDropShadowFor: aSystemWindow on: aCanvas
	"Draw the diffuse drop shadow for the given window."
	
	|or b r o gc|
	or := self windowActiveDropShadowOffsetRectangleFor: aSystemWindow.
	o := or bottom.
	(aSystemWindow roundedCorners includesAnyOf: #(2 3))
		ifTrue: [o := o + 2].
	b := aSystemWindow bounds expandBy: or.
	gc := {Color black alpha: 0.6. Color transparent}.
	r := b topLeft extent: o asPoint.
	aCanvas
		fillRectangle: r
		fillStyle: ((GradientFillStyle colors: gc)
					origin: r bottomRight;
					direction: o@0;
					radial: true).
	r := b topLeft + (o@0) extent: (b width - o - o @ o).
	aCanvas
		fillRectangle: r
		fillStyle: ((GradientFillStyle colors: gc)
					origin: r bottomLeft;
					direction: 0@o negated).
	r := b topRight - (o@0) extent: o asPoint.
	aCanvas
		fillRectangle: r
		fillStyle: ((GradientFillStyle colors: gc)
					origin: r bottomLeft;
					direction: o@0;
					radial: true).
	r := b topRight + (o negated@o) extent: (o @ (b height - o - o)).
	aCanvas
		fillRectangle: r
		fillStyle: ((GradientFillStyle colors: gc)
					origin: r topLeft;
					direction: o@0).
	r := b bottomRight - o asPoint extent: o asPoint.
	aCanvas
		fillRectangle: r
		fillStyle: ((GradientFillStyle colors: gc)
					origin: r topLeft;
					direction: o@0;
					radial: true).
	r := b bottomLeft + (o@o negated) extent: (b width - o - o @ o).
	aCanvas
		fillRectangle: r
		fillStyle: ((GradientFillStyle colors: gc)
					origin: r topLeft;
					direction: 0@o).
	r := b bottomLeft - (0@o) extent: o asPoint.
	aCanvas
		fillRectangle: r
		fillStyle: ((GradientFillStyle colors: gc)
					origin: r topRight;
					direction: o@0;
					radial: true).
	r := b topLeft + (0@o) extent: (o @ (b height - o - o)).
	aCanvas
		fillRectangle: r
		fillStyle: ((GradientFillStyle colors: gc)
					origin: r topRight;
					direction: o negated@0)
! !

!UITheme methodsFor: 'fill-styles' stamp: 'AlainPlantec 11/24/2010 11:09'!
menuFillStyleFor: aMenu
	"Return the fillStyle for the given menu."
	
	| bc fill |
	bc := aMenu valueOfProperty: #basicColor ifAbsent: [self settings derivedMenuColor].
	fill := GradientFillStyle ramp: {0.0 -> (bc alphaMixed: 0.2 with: Color white). 1.0 -> bc}.
	fill
		radial: false;
		origin: aMenu topLeft;
		direction: 0 @ aMenu height.
	^ fill.! !

!UITheme methodsFor: 'morph creation' stamp: 'SeanDeNigris 1/23/2014 11:59'!
newTaskListButtonIn: aTasklist for: aTask
	"Answer a tasklist button morph for the given task."
	
	|lm lab button |
	lab := (self buttonLabelForText: (aTask label contractTo: 40)).
	aTask isActive
		ifTrue: [ lab emphasis: 1 "1 -> bold" ].
	lm := self
		newRowIn: aTasklist
		for: {(aTask icon ifNil: [self smallWindowIcon]) asMorph. lab}.
	button := self
		newButtonIn: aTasklist
		for: aTask morph
		getState: #isActive
		action: #buttonClickedForTaskList:
		arguments: {aTasklist}
		getEnabled: nil
		label: lm
		help: nil.
	button
		useSquareCorners;
		onColor: (self taskbarMinimizedButtonColorFor: button)
		offColor: (aTask isActive
				ifTrue: [self taskbarActiveButtonColorFor: button]
				ifFalse: [self taskbarButtonColorFor: button]);
		hResizing: #spaceFill.
	lab color: (self taskbarButtonLabelColorFor: button).
	button model: aTask.
	^button! !

!UITheme methodsFor: 'configure' stamp: 'EstebanLorenzano 4/29/2014 12:45'!
configurePluggableTextFieldMorph: textFieldMorph! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 10/11/2006 13:12'!
newImageIn: aThemedMorph form: aForm
	"Answer a new text label."

	^self
		newImageIn: aThemedMorph
		form: aForm
		size: aForm extent! !

!UITheme methodsFor: 'accessing' stamp: 'FernandoOlivero 4/12/2011 09:47'!
currentSettings
	^ self class currentSettings! !

!UITheme methodsFor: 'basic-colors' stamp: 'GuillermoPolito 11/17/2014 17:31'!
patchworkUIThemeColorFor: aWindowOrModel
	"Answer the colour for the given window."
	^ self settings windowColor! !

!UITheme methodsFor: 'services' stamp: 'GaryChambers 12/2/2011 12:01'!
fileOpenIn: aThemedMorph title: title extensions: exts path: path preview: preview
	"Answer the result of a file open dialog with the given title, extensions path and preview type."

	|fd|
	fd := FileDialogWindow basicNew
		basicTheme: aThemedMorph theme;
		previewType: preview;
		initialize;
		title: title;
		answerOpenFile.
	exts ifNotNil: [fd validExtensions: exts].
	path ifNotNil: [fd selectPathName: path].
	^(aThemedMorph openModal: fd) answer! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 1/27/2009 16:43'!
scrollPaneDisabledBorderStyleFor: aScrollPane
	"Return the disabled borderStyle for the given scroll pane."

	^self scrollPaneNormalBorderStyleFor: aScrollPane! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 8/25/2006 10:12'!
newGroupboxIn: aThemedMorph label: aString for: control
	"Answer a groupbox with the given label and control."

	^(self newGroupboxIn: aThemedMorph label: aString)
		addContentMorph: control;
		yourself! !

!UITheme methodsFor: 'services' stamp: 'GaryChambers 12/6/2011 10:05'!
fileSaveIn: aThemedMorph title: title extensions: exts path: path
	"Answer the result of a file save dialog with the given title, extensions and path."

	|fd|
	fd := (FileDialogWindow newWithTheme: aThemedMorph theme)
		title: title;
		answerSaveFile.
	exts ifNotNil: [fd validExtensions: exts].
	path ifNotNil: [fd selectPathName: path].
	^(aThemedMorph openModal: fd) answer! !

!UITheme methodsFor: 'basic-colors' stamp: 'gvc 4/16/2007 12:59'!
scrollbarColorFor: aScrollbar
	"Answer the colour for the given scrollbar."

	^self settings standardColorsOnly
		ifTrue: [self settings scrollbarColor]
		ifFalse: [(aScrollbar valueOfProperty: #lastPaneColor)
					 ifNil: [Color white]]! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 1/17/2008 11:28'!
newTabGroupIn: aThemedMorph for: labelsAndControls
	"Answer a tab group morph with the given tab labels and associated pages."

	^(TabGroupMorph new
		font: self labelFont;
		cornerStyle: (self tabGroupCornerStyleIn: aThemedMorph);
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		labelsAndPages: labelsAndControls)
		selectedPageIndex: (labelsAndControls isEmpty ifTrue: [0] ifFalse: [1])! !

!UITheme methodsFor: 'fill-styles-scrollbars' stamp: 'gvc 4/25/2007 18:22'!
scrollbarPressedThumbFillStyleFor: aScrollbar
	"Return the pressed scrollbar thumb fillStyle for the given scrollbar."
	
	^self scrollbarNormalThumbFillStyleFor: aScrollbar! !

!UITheme methodsFor: 'scrollbars' stamp: 'AlainPlantec 12/17/2009 11:13'!
updateScrollBarButtonsAspect: aCollection color: aColor 
	"update aCollection of morphs with aColor"
	
	
	aCollection
		do: [:each | self updateScrollBarButtonAspect: each color: aColor]! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 3/23/2007 17:19'!
buttonSelectedMouseOverBorderStyleFor: aButton
	"Return the selected mouse over button borderStyle for the given button."

	^self buttonSelectedBorderStyleFor: aButton! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 8/8/2007 15:16'!
newAlphaImageIn: aThemedMorph image: aForm help: helpText
	"Answer an alpha image morph."
	
	|answer|
	answer := AlphaImageMorph new
		hResizing: #rigid;
		vResizing: #rigid;
		setBalloonText: helpText.
	aForm ifNotNil: [answer image: aForm].
	^answer! !

!UITheme methodsFor: 'services' stamp: 'HernanMoralesDurand 2/16/2014 20:37'!
centeredAlertIn: aThemedMorph text: aStringOrText title: aString configure: aBlock
	"Answer the result of an alert dialog (true) with the given label and title."

	| dialog |
	SoundTheme useThemeSounds ifTrue: [ self alertSound play ].
	dialog := (AlertDialogWindow newWithTheme: aThemedMorph theme)
		textFont: self textFont;
		title: aString;
		text: aStringOrText.
	aBlock value: dialog.
	dialog left: ((World width / 2) - (dialog width /2)).
	dialog top: ((World height / 2) - (dialog height /2)).
	aThemedMorph openModal: dialog.
	^ dialog cancelled not! !

!UITheme methodsFor: 'sounds' stamp: 'gvc 9/12/2007 14:45'!
abortSound
	"Answer the abort sound."

	^self soundTheme abortSound! !

!UITheme methodsFor: '*growl' stamp: 'TudorGirba 10/25/2011 17:07'!
growlContentsColorFor: aGrowlMorph
	^ Color white! !

!UITheme methodsFor: 'defaults' stamp: 'gvc 9/8/2006 13:59'!
labelFont
	"Answer the label font to use."

	^self textFont! !

!UITheme methodsFor: 'defaults' stamp: 'gvc 3/1/2010 15:55'!
menuItemDisabledTextColorFor: aMenuItem
	"Answer the color to use for disabled menu item text."

	^((aMenuItem color luminance - aMenuItem owner color luminance) abs < 0.3)
		ifTrue: [aMenuItem owner color contrastingColor muchDarker]
		ifFalse: [aMenuItem owner color muchDarker]! !

!UITheme methodsFor: 'services' stamp: 'GaryChambers 12/2/2011 12:01'!
chooseFullFileNameIn: aThemedMorph title: title extensions: exts path: path preview: preview
	"Answer the result of a file name chooser dialog with the given title, extensions
	path and preview type.
	Answer nil or a full filename."

	|fd|
	fd := FileDialogWindow basicNew
		basicTheme: aThemedMorph theme;
		previewType: preview;
		initialize;
		title: title;
		answerPathName.
	exts ifNotNil: [fd validExtensions: exts].
	path ifNotNil: [fd selectPathName: path].
	^(aThemedMorph openModal: fd) answer! !

!UITheme methodsFor: 'border-styles-scrollbars' stamp: 'gvc 6/4/2007 15:50'!
scrollbarMouseOverThumbButtonBorderStyleFor: aScrollbar
	"Return the button borderStyle for the given scrollbar when
	the mouse is over the thumb."

	^self scrollbarMouseOverBarButtonBorderStyleFor: aScrollbar! !

!UITheme methodsFor: 'scrollbars' stamp: 'AlainPlantec 12/17/2009 13:45'!
scrollBarButtonArrowVertices: aRectangle 
	^ self verticesForComplexArrow: aRectangle! !

!UITheme methodsFor: 'basic-colors' stamp: 'gvc 4/24/2007 11:45'!
progressBarProgressColorFor: aProgressBar
	"Answer the colour for the progress part of the given progress bar."

	^self settings progressBarProgressColor! !

!UITheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 4/29/2014 16:12'!
disabledColor 
	^ Color gray! !

!UITheme methodsFor: 'copying' stamp: 'gvc 9/22/2006 17:20'!
postCopy
	"Copy the settings too."
	
	super postCopy.
	self settings: self settings copy! !

!UITheme methodsFor: 'border-styles-scrollbars' stamp: 'gvc 6/4/2007 15:41'!
scrollbarMouseOverBarThumbBorderStyleFor: aScrollbar
	"Return the thumb borderStyle for the given scrollbar when
	the mouse is over the bar."

	^self scrollbarNormalThumbBorderStyleFor: aScrollbar! !

!UITheme methodsFor: 'label-styles' stamp: 'gvc 5/7/2007 12:50'!
windowLabelFor: aWindow
	"Answer the label to use for the given window."

	^self windowLabelForText: aWindow labelString! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 8/7/2007 10:56'!
dropListNormalFillStyleFor: aDropList
	"Return the normal fillStyle for the given drop list."
	
	^Color white! !

!UITheme methodsFor: 'morph creation' stamp: 'GaryChambers 12/2/2011 12:31'!
newListIn: aThemedMorph for: aModel list: listSelector selected: getSelector changeSelected: setSelector icon: iconSelector getEnabled: enabledSel help: helpText
	"Answer an icon list for the given model."

	^PluggableIconListMorph new
		selectionColor: self selectionColor;
		textColor: self listTextColor;
		font: self listFont;
		on: aModel
		list: listSelector
		selected: getSelector
		changeSelected: setSelector
		menu: nil
		keystroke: nil;
		autoDeselect: false;
		cornerStyle: aThemedMorph preferredCornerStyle;
		color: Color white;
		borderStyle: (BorderStyle inset width: 1);
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		getIconSelector: iconSelector;
		getEnabledSelector: enabledSel;
		setBalloonText: helpText! !

!UITheme methodsFor: 'accessing' stamp: 'gvc 5/14/2007 11:39'!
forms
	"Answer the value of forms"

	^ forms! !

!UITheme methodsFor: 'basic-colors' stamp: 'NickAlexander 2/6/2011 12:01'!
taskbarButtonLabelColorForExpanded: aButton
	"Answer the colour for the label of the given taskbar button, given that the corresponding window is expanded."

	^Color black! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 2/23/2009 13:32'!
handlesWindowDropShadowInHandFor: aSystemWindow
	"Answer whether the receiver will handle drop shadow drawing
	for a window when picked up in the hand. We will when diffuse."

	^self windowActiveDropShadowStyle == #diffuse and: [
		aSystemWindow isActive]! !

!UITheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 4/29/2014 16:12'!
enabledColor 
	^ Color black! !

!UITheme methodsFor: 'initialize-release' stamp: 'BenComan 3/24/2014 21:18'!
newWindowMaximizeOverForm
	"Answer a new form for a window menu box."

	^ self newWindowMaximizeForm! !

!UITheme methodsFor: 'defaults' stamp: 'gvc 12/5/2008 14:56'!
buttonLabelInsetFor: aButton
	"Answer the inset to use for a button's label."

	^2! !

!UITheme methodsFor: 'fill-styles-buttons' stamp: 'gvc 11/13/2007 11:29'!
controlButtonDisabledFillStyleFor: aButton
	"Return the disabled control button fillStyle for the given button.
	Control buttons are generally used for drop-lists and expanders."
	
	^self buttonDisabledFillStyleFor: aButton! !

!UITheme methodsFor: 'morph creation' stamp: 'AlainPlantec 11/25/2010 09:45'!
newAutoAcceptTextEntryIn: aThemedMorph for: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel help: helpText 
	"Answer a text entry for the given model.
	Object conversion will be automatic based on the class of
	object returned after performing the get selector, aClass
	is provided in case of initial nil returns."
	^ self
		newAutoAcceptTextEntryIn: aThemedMorph
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel
		help: helpText
		entryCompletion: nil ! !

!UITheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 5/1/2014 12:11'!
caretColor
	^ Color blue! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 8/7/2007 12:42'!
listNormalBorderStyleFor: aList
	"Return the normal borderStyle for the given list"

	^BorderStyle inset
		width: 1;
		baseColor: aList paneColor! !

!UITheme methodsFor: 'morph creation' stamp: 'GaryChambers 8/30/2011 15:34'!
newImageIn: aThemedMorph for: aModel get: getSel help: helpText
	"Answer a new image morph."

	^AlphaImageMorph new
		model: aModel;
		borderStyle: (BorderStyle inset width: 0);
		getImageSelector: getSel;
		setBalloonText: helpText;
		updateImage! !

!UITheme methodsFor: 'services' stamp: 'StephaneDucasse 10/26/2014 17:51'!
chooseIn: aThemedMorph title: title labels: labels values: values lines: lines
	"Answer the result of a popup choice with the given title, labels, values and lines."

	| pd |
	pd := (PopupChoiceDialogWindow newWithTheme: aThemedMorph theme)
		title: (title isEmpty ifTrue: ['Choose' translated] ifFalse: [title asString]);
		labels: labels;
		lines: (lines ifNil: [#()]);
		model: values.
	^(aThemedMorph openModal: pd) choice! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 11/13/2007 11:33'!
controlButtonMouseOverBorderStyleFor: aButton
	"Return the mouse over control button borderStyle for the given button.
	Control buttons are generally used for drop-lists and expanders."

	^self buttonMouseOverBorderStyleFor: aButton! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 3/16/2007 15:51'!
newNoButtonIn: aThemedMorph for: aModel
	"Answer a new No button."

	^(self
			newButtonIn: aThemedMorph
			for: aModel
			getState: nil
			action: #no
			arguments: nil
			getEnabled: nil
			label: 'No' translated
			help: 'Answer no and close the window' translated)
		hResizing: #rigid;
		vResizing: #rigid! !

!UITheme methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/15/2014 18:58'!
borderWidth
	^ 1! !

!UITheme methodsFor: 'defaults' stamp: 'AlainPlantec 11/29/2009 21:36'!
buttonFont
	"Answer the button font to use."

	^StandardFonts buttonFont! !

!UITheme methodsFor: 'initialize-release' stamp: 'gvc 10/16/2008 16:18'!
defaultSettings
	"Answer the default settings."

	^self class defaultSettings copy! !

!UITheme methodsFor: 'border-styles-scrollbars' stamp: 'gvc 6/4/2007 15:15'!
scrollbarMouseOverBarButtonBorderStyleFor: aScrollbar
	"Return the button borderStyle for the given scrollbar when
	the mouse is over the bar."

	^self scrollbarNormalButtonBorderStyleFor: aScrollbar! !

!UITheme methodsFor: 'fill-styles' stamp: 'AlainPlantec 12/14/2009 14:30'!
windowInactiveFillStyleFor: aWindow
	"Return the window inactive fillStyle for the given window."
	
	^self settings fadedBackgroundWindows
		ifTrue: [aWindow paneColorToUse
					alphaMixed: 0.9
					with: (Color white alpha: aWindow paneColorToUse alpha)]
		ifFalse: [aWindow paneColorToUse]! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 7/30/2010 13:28'!
newLabelIn: aThemedMorph for: aModel getLabel: labelSel getEnabled: enabledSel
	"Answer a new text label."

	^(LabelMorph contents: '' font: self labelFont)
		model: aModel;
		getEnabledSelector: enabledSel;
		getTextSelector: labelSel! !

!UITheme methodsFor: 'configure' stamp: 'EstebanLorenzano 11/20/2013 13:58'!
configureTextMorph: textMorph ! !

!UITheme methodsFor: 'defaults' stamp: 'gvc 9/13/2006 11:26'!
menuBarFont
	"Answer the menu bar font to use."

	^self textFont! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 4/24/2007 11:47'!
progressBarProgressFillStyleFor: aProgressBar
	"Return the progress bar progress fillStyle for the given progress bar."
	
	|aColor area|
	aColor := self progressBarProgressColorFor: aProgressBar.
	area :=  aProgressBar innerBounds.
	^(GradientFillStyle ramp: {
			0.0->(aColor alphaMixed: 0.3 with: (Color white alpha: aColor alpha)).
			0.2-> aColor twiceLighter.
			0.8->aColor darker.
			1.0->aColor darker duller})	
		origin: area origin;
		direction: 0@area height;
		radial: false! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 5/23/2007 13:13'!
textEditorDisabledFillStyleFor: aTextEditor
	"Return the disabled fillStyle for the given text editor."
	
	^aTextEditor paneColor alphaMixed: 0.3 with: Color white! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 1/30/2009 15:09'!
newBalloonHelpIn: aThemedMorph contents: aTextStringOrMorph for: aMorph corner: cornerSymbol
	"Answer a new balloon help morph with the given text
	and positioning for aMorph."
	
	^SimpleBalloonMorph
		string: aTextStringOrMorph
		for: aMorph
		corner: cornerSymbol! !

!UITheme methodsFor: 'morph creation' stamp: 'GaryChambers 10/5/2010 13:26'!
newWindowIn: aThemedMorph for: aModel title: titleString
	"Answer a new StandardWindow with given model and title."

	^StandardWindow new
		title: titleString;
		model: aModel;
		yourself! !

!UITheme methodsFor: 'defaults' stamp: 'nice 3/5/2010 22:42'!
tabSelectorMorphMinExtentFor: aTabSelectorMorph
	"Answer the min extent of the given tab selector."
	
	^aTabSelectorMorph basicMinExtent + (8 @ 1)! !

!UITheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 5/15/2014 19:04'!
menuShadowColor
	^ self settings menuShadowColor! !

!UITheme methodsFor: 'fill-styles-buttons' stamp: 'gvc 4/25/2007 18:24'!
buttonNormalFillStyleFor: aButton
	"Return the normal button fillStyle for the given button."
	
	^self buttonColorFor: aButton! !

!UITheme methodsFor: 'defaults' stamp: 'GaryChambers 6/10/2011 11:36'!
windowPreferredCornerStyleFor: aWindow
	"Answer the preferred corner style for the given window."

	aWindow isEmbedded ifTrue: [^#square].
	^(self settings preferRoundCorner  or: [
			aWindow cornerStyle == #rounded])
		ifTrue: [#rounded]
		ifFalse: [#square]! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 1/23/2007 16:39'!
newVerticalSeparatorIn: aThemedMorph
	"Answer a new vertical separator."

	^SeparatorMorph new
		fillStyle: Color transparent;
		borderStyle: (BorderStyle inset baseColor: Color blue; width: 1);
		extent: 2@2;
		vResizing: #spaceFill! !

!UITheme methodsFor: 'defaults' stamp: 'gvc 2/22/2008 21:28'!
defaultButtonBorderColor
	"Answer the color to use for a 'default' button."

	^self settings selectionColor! !

!UITheme methodsFor: 'services' stamp: 'GaryChambers 12/6/2011 10:04'!
denyIn: aThemedMorph text: aStringOrText title: aString
	"Answer the result of an deny dialog (true) with the given label and title."

	self denySound play.
	^(aThemedMorph openModal: (
		(DenyDialogWindow newWithTheme: aThemedMorph theme)
			textFont: self textFont;
			title: aString;
			text: aStringOrText)) cancelled not! !

!UITheme methodsFor: 'morph creation' stamp: 'GaryChambers 11/15/2011 13:56'!
newLabelGroupIn: aThemedMorph for: labelsAndControls font: aFont labelColor: aColor
	"Answer a morph laid out with a column of labels and a column of associated controls.
	If spaceFill is tru then each row will share available space to pad."

	| labels labelWidth lc|
	lc := labelsAndControls collect: [:a |
		(a key isMorph
			ifTrue: [a key]
			ifFalse: [(self newLabelIn: aThemedMorph label: (a key ifNil: ['']) asString)
						font: aFont;
						color: aColor])
			-> a value].
	labels := Morph new
		hResizing: #shrinkWrap;
		vResizing: #spaceFill;
		changeTableLayout.
	lc do: [:a |
		labels addMorphBack: a key].
	labelWidth := labels minExtent x.
	^self newColumnIn: aThemedMorph for: (lc collect: [:a | | row |
		a key hResizing: #rigid; extent: labelWidth@ a key height.
		row := self newRowIn: aThemedMorph for: {a key. a value}.
		row vResizing: (a value vResizing = #spaceFill ifTrue: [#spaceFill] ifFalse: [#shrinkWrap]).
		row])! !

!UITheme methodsFor: 'fill-styles-buttons' stamp: 'gvc 2/29/2008 21:47'!
checkboxButtonSelectedDisabledFillStyleFor: aCheckboxButton
	"Return the selected disabled checkbox button fillStyle for the given button."
	
	^self checkboxButtonDisabledFillStyleFor: aCheckboxButton! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 6/2/2009 10:58'!
drawTabGroupFinishingFor: aTabGroupMorph on: aCanvas
	"Patch up any visuals for the selected tab."! !

!UITheme methodsFor: 'defaults' stamp: 'StephaneDucasse 9/7/2013 13:10'!
editableDropListMargins
	"Answer the text margins for an editable drop list for this theme."
	
	^Margin left: 0 top: 1 right: 2 bottom: 1! !

!UITheme methodsFor: 'fill-styles-buttons' stamp: 'gvc 4/25/2007 18:52'!
buttonSelectedPressedFillStyleFor: aButton
	"Return the button selected pressed fillStyle for the given color."

	^self buttonSelectedMouseOverFillStyleFor: aButton! !

!UITheme methodsFor: 'morph creation' stamp: 'GaryChambers 11/15/2011 15:41'!
newCheckboxIn: aThemedMorph for: aModel getSelected: getSel setSelected: setSel getEnabled: enabledSel label: label help: helpText
	"Answer a checkbox with the given label ."

	| answer |
	answer := CheckboxMorph
			on: aModel selected: getSel changeSelected: setSel.
	answer
		getEnabledSelector: enabledSel;
		label: label;
		labelMorph: (self checkboxLabelFor: answer);
		font: self labelFont;
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap;
		setBalloonText: helpText.
	^answer! !

!UITheme methodsFor: 'defaults' stamp: 'AlainPlantec 11/29/2009 22:05'!
menuFont
	"Answer the menu font to use."

	^StandardFonts menuFont! !

!UITheme methodsFor: 'scrollbars' stamp: 'AlainPlantec 5/7/2010 23:01'!
createArrowOfDirection: aSymbol in: aRectangle 
	"PRIVATE - create an arrow bounded in aRectangle"

	| arrow vertices |
	vertices := self scrollBarButtonArrowVertices: aRectangle.
	""
	arrow := PolygonMorph 
				vertices: vertices
				color: Color transparent
				borderWidth: 0
				borderColor: Color black.
	""
	arrow bounds: (arrow bounds insetBy: (aRectangle width / 6) rounded).
	""
	aSymbol == #right 
		ifTrue: [arrow rotationDegrees: arrow rotationDegrees + 90].
	aSymbol == #bottom 
		ifTrue: [arrow rotationDegrees: arrow rotationDegrees + 180].
	aSymbol == #left 
		ifTrue: [arrow rotationDegrees: arrow rotationDegrees + 270].
	""
	^arrow! !

!UITheme methodsFor: 'fill-styles-scrollbars' stamp: 'NicolasPetton 3/18/2013 18:39'!
scrollbarNormalFillStyleFor: aScrollbar
	"Return the normal scrollbar fillStyle for the given scrollbar."
	
	^ Color white! !

!UITheme methodsFor: 'services' stamp: 'GaryChambers 12/6/2011 10:02'!
chooseDropListIn: aThemedMorph text: aStringOrText title: aString list: aList
	"Answer the result of a drop list chooser with the given label, title and list."

	^(aThemedMorph openModal: (
		(ChooseDropListDialogWindow newWithTheme: aThemedMorph theme)
			textFont: self textFont;
			title: aString;
			text: aStringOrText;
			list: aList)) selectedItem! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 2/29/2008 22:00'!
checkboxButtonSelectedBorderStyleFor: aCheckboxButton
	"Return the selected checkbox button borderStyle for the given button."

	^self checkboxButtonNormalBorderStyleFor: aCheckboxButton! !

!UITheme methodsFor: 'defaults' stamp: 'gvc 12/5/2008 16:54'!
controlButtonLabelInsetFor: aButton
	"Answer the inset to use for a control button's label."

	^self buttonLabelInsetFor: aButton! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 1/25/2008 14:43'!
groupLabelBorderStyleFor: aGroupPanel
	"Answer the normal border style for a group label."

	^BorderStyle simple
		width: 0;
		baseColor: Color transparent! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 9/1/2009 15:26'!
drawTextAdornmentFor: aPluggableTextMorph color: aColor on: aCanvas
	"Indicate edit status for the given morph."
	
	aCanvas frameRectangle: aPluggableTextMorph innerBounds width: 2 color: aColor! !

!UITheme methodsFor: 'label-styles' stamp: 'gvc 10/17/2008 12:19'!
disabledItemStyle
	"Answer either #plain or #inset to determine how
	diabled text is drawn."

	^#plain! !

!UITheme methodsFor: 'fill-styles-scrollbars' stamp: 'gvc 3/30/2007 10:29'!
scrollbarPressedFillStyleFor: aScrollbar
	"Return the pressed scrollbar fillStyle for the given scrollbar."
	
	^self scrollbarNormalFillStyleFor: aScrollbar ! !

!UITheme methodsFor: 'accessing' stamp: 'FernandoOlivero 4/12/2011 09:43'!
builder
	^ self class builder! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'MarcusDenker 12/11/2009 09:35'!
buttonCornerStyleIn: aThemedMorph
	"Allow for themes to override default behaviour."
	
	^aThemedMorph
		ifNil: [#square]
		ifNotNil: [:tm | 
			tm preferredButtonCornerStyle
				ifNil: [tm preferredCornerStyle]
				ifNotNil: [:bcs | bcs]]! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 1/7/2008 11:19'!
tabLabelSelectedBorderStyleFor: aTabLabel
	"Answer the selected border style for a tab label."

	^self tabLabelNormalBorderStyleFor: aTabLabel! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 1/28/2009 18:00'!
multiFormFillStyleFrom: anArray cornerWidths: widthArray in: aRectangle
	"Answer a composite fill style from the given forms and central colour
	in the given bounds. Use the widths specified for the portion of the
	corner forms to display."
	
	|tl tm tr ml mr bl bm br c tlw trw blw brw|
	tl := anArray first. tlw:= widthArray first.
	tm := anArray second.
	tr := anArray third. trw := widthArray second.
	ml  := anArray fourth.
	c := anArray fifth.
	mr  := anArray sixth.
	bl := anArray seventh. blw := widthArray third.
	bm := anArray eighth.
	br := anArray ninth. brw := widthArray fourth.
	^CompositeFillStyle fillStyles: {
		(ImageFillStyle form: tl)
			origin: aRectangle topLeft;
			extent: tlw@tl height.
		(AlphaInfiniteForm with: tm)
			origin: aRectangle topLeft + (tlw@0);
			extent: (aRectangle width - trw - tlw)@tm height.
		(ImageFillStyle form: tr)
			origin: aRectangle topRight - (tr width@0);
			extent: trw@tr height;
			offset: (tr width - trw)@0.
		(AlphaInfiniteForm with: ml)
			origin: aRectangle topLeft + (0@tl height);
			extent: ml width@(aRectangle height - tl height - bl height).
		(ColorFillStyle color: c)
			origin: aRectangle topLeft + (tlw@tl height);
			extent: aRectangle extent - (tlw@tl height) - (brw@br height).
		(AlphaInfiniteForm with: mr)
			origin: aRectangle topRight + (trw negated@tr height);
			extent: mr width@(aRectangle height - tr height - br height).
		(ImageFillStyle form: bl)
			origin: aRectangle bottomLeft - (0@bl height);
			extent: blw@bl height.
		(AlphaInfiniteForm with: bm)
			origin: aRectangle bottomLeft - (blw negated@bl height);
			extent: (aRectangle width - blw - brw)@bm height.
		(ImageFillStyle form: br)
			origin: aRectangle bottomRight - br extent;
			extent: brw@br height;
			offset: (br width - brw)@0}! !

!UITheme methodsFor: 'basic-colors' stamp: 'gvc 9/5/2007 15:08'!
treeLineWidth
	"Answer the width of the tree lines."

	^1! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 9/8/2009 13:09'!
newBracketSliderIn: aThemedMorph for: aModel getValue: getSel setValue: setSel min: minValue max: maxValue quantum: quantum getEnabled: enabledSel help: helpText
	"Answer a bracket slider."

	^(BracketSliderMorph
			on: aModel
			getValue: getSel
			setValue: setSel
			min: minValue
			max: maxValue
			quantum: quantum)
		getEnabledSelector: enabledSel;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		setBalloonText: helpText! !

!UITheme methodsFor: 'configure' stamp: 'EstebanLorenzano 4/29/2014 18:27'!
configureLabelMorph: aMorph! !

!UITheme methodsFor: 'fill-styles-buttons' stamp: 'gvc 10/28/2007 16:53'!
controlButtonNormalFillStyleFor: aButton
	"Return the normal control button fillStyle for the given button.
	Control buttons are generally used for drop-lists and expanders."
	
	^self buttonNormalFillStyleFor: aButton! !

!UITheme methodsFor: 'morph creation' stamp: 'GaryChambers 12/13/2011 18:03'!
newDropListIn: aThemedMorph for: aModel list: listSel getSelected: getSel setSelected: setSel getEnabled: enabledSel useIndex: useIndex help: helpText
	"Answer a drop list for the given model."

	^(DropListMorph basicNew
		basicTheme: self;
			initialize;
			useSelectionIndex: useIndex;
			on: aModel
			list: listSel
			selected: getSel
			changeSelected: setSel)
		selectionColor: self selectionColor;
		getEnabledSelector: enabledSel;
		font: self dropListFont;
		listFont: self listFont;
		cornerStyle: aThemedMorph preferredCornerStyle;
		hResizing: #spaceFill;
		vResizing: #shrinkWrap;
		setBalloonText: helpText;
		basicTheme: nil! !

!UITheme methodsFor: 'border-styles-scrollbars' stamp: 'gvc 10/24/2007 15:14'!
scrollbarButtonCornerStyleIn: aThemedMorph
	"Allow for themes to override default behaviour."
	
	^#square! !

!UITheme methodsFor: 'basic-colors' stamp: 'GuillermoPolito 11/17/2014 17:29'!
windowColorFor: aWindowOrModel 
	"Answer the colour for the given window."

	^ self settings windowColor! !

!UITheme methodsFor: 'defaults' stamp: 'gvc 1/28/2009 17:07'!
dropListControlButtonWidth
	"Answer the width of a drop list control button for this theme."
	
	^self buttonMinWidth! !

!UITheme methodsFor: 'scrollbars' stamp: 'MarcusDenker 10/26/2011 15:20'!
createBoxIn: aRectangle 
	"PRIVATE - create an box bounded in aRectangle"
	| box |
	box := Morph new.
	box extent: (aRectangle scaleBy: 1 / 2) extent rounded;
		 borderWidth: 0.
	""
	^ box! !

!UITheme methodsFor: 'morph creation' stamp: 'EstebanLorenzano 4/29/2014 12:37'!
newTextEntryIn: aThemedMorph for: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel help: helpText entryCompletion: anEntryCompletion
	"Answer a text entry for the given model."

	|pt|
	pt := PluggableTextFieldMorph new
		convertTo: aClass;
		alwaysAccept: true;
		on: aModel
		text: getSel
		accept: setSel
		readSelection: nil
		menu: nil;
		acceptOnCR: true;
		getEnabledSelector: enabledSel;
		font: self textFont;
		cornerStyle: (self textEntryCornerStyleIn: aThemedMorph);
		hResizing: #spaceFill;
		vResizing: #rigid;
		borderStyle: (BorderStyle inset width: 1);
		"color: Color darkGray;
		selectionColor: self selectionColor;"
		hideScrollBarsIndefinitely;
		extent: 24@(self textFont height + 8);
		setBalloonText: helpText;
		entryCompletion: anEntryCompletion.

	pt textMorph
		autoFit: true;
		wrapFlag: false;
		margins: (2@1 corner: 2@1).
	^pt! !

!UITheme methodsFor: 'configure' stamp: 'EstebanLorenzano 10/16/2013 00:07'!
configurePluggableTextMorph: textMorph 
	textMorph 
		color: Color white;
		borderWidth: 1.! !

!UITheme methodsFor: 'morph creation' stamp: 'GaryChambers 12/2/2011 10:25'!
newCheckboxIn: aThemedMorph for: aModel getSelected: getSel setSelected: setSel getEnabled: enabledSel getLabel: labelSel help: helpText
	"Answer a checkbox with the given label ."

	| answer |
	answer := CheckboxMorph
			on: aModel selected: getSel changeSelected: setSel.
	answer
		getEnabledSelector: enabledSel;
		getLabelSelector: labelSel;
		labelMorph: (self checkboxLabelFor: answer);
		font: self labelFont;
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap;
		setBalloonText: helpText.
	^answer! !

!UITheme methodsFor: 'label-styles' stamp: 'AlainPlantec 2/11/2011 16:26'!
whiteTreeUnexpandedForm
	"Answer the form to use for an unexpanded tree item when a contrasting one is needed."

	^self forms 
		at: #whiteTreeUnexpanded
		ifAbsent: [ | f |
			f := self treeUnexpandedForm deepCopy.
			f replaceColor: Color white withColor: Color transparent.
			(f colorsUsed reject: [:c | c isTransparent]) do: [:c | f replaceColor:  c withColor: c whiter whiter whiter whiter whiter whiter].
			self forms at: #whiteTreeUnexpanded put: f.
			self whiteTreeUnexpandedForm]! !

!UITheme methodsFor: 'morph creation' stamp: 'BenjaminVanRyseghem 3/22/2013 16:02'!
newWindowHeaderFor: aWindow

	^ (AlignmentMorph newSpacer: Color transparent)
			vResizing: #spaceFill;
			layoutPolicy: ProportionalLayout new! !

!UITheme methodsFor: 'morph creation' stamp: 'GaryChambers 8/17/2010 16:06'!
newEditableDropListIn: aThemedMorph for: aModel list: listSel getSelected: getSel setSelected: setSel addToList: addSel class: aClass default: defaultValue ghostText: ghostText getEnabled: enabledSel useIndex: useIndex help: helpText
	"Answer an editable drop list for the given model."

	^(EditableDropListMorph
			on: aModel
			list: listSel
			selected: getSel
			changeSelected: setSel
			useIndex: useIndex
			addToList: addSel
			class: aClass
			getEnabled: enabledSel
			default: defaultValue)
		ghostText: ghostText;
		selectionColor: self selectionColor;
		font: self dropListFont;
		cornerStyle: aThemedMorph preferredCornerStyle;
		hResizing: #spaceFill;
		vResizing: #shrinkWrap;
		setBalloonText: helpText! !

!UITheme methodsFor: 'basic-colors' stamp: 'AlainPlantec 12/13/2009 22:30'!
worldMainDockingBarColorFor: aDockingBar
	"Answer the base colour to use for a world main docking bar in this theme."

	^self settings derivedMenuColor ! !

!UITheme methodsFor: 'initialize-release' stamp: 'BenComan 3/24/2014 21:14'!
newWindowMinimizeOverForm
	"Answer a new form for a window menu box."

	^ self newWindowMinimizeForm! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 11/13/2007 11:34'!
controlButtonSelectedPressedBorderStyleFor: aButton
	"Return the selected pressed control button borderStyle for the given button.
	Control buttons are generally used for drop-lists and expanders."

	^self buttonSelectedPressedBorderStyleFor: aButton! !

!UITheme methodsFor: 'morph creation' stamp: 'CamilloBruni 2/19/2014 20:40'!
newScrollBarUpButtonFor: aScrollbar
	^ BorderedMorph newBounds: (self scrollBarUpButtonBoundsFor: aScrollbar)! !

!UITheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 5/15/2014 14:38'!
borderColor 
	^ Color gray! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 4/25/2007 18:12'!
buttonPressedBorderStyleFor: aButton
	"Return the pressed button borderStyle for the given button."

	^self buttonSelectedBorderStyleFor: aButton! !

!UITheme methodsFor: 'services' stamp: 'GaryChambers 12/6/2011 10:03'!
chooseFontIn: aThemedMorph title: aString font: aFont
	"Answer the result of a font selector dialog with the given title and initial font."

	|d|
	d := aThemedMorph openModal: (
		Cursor wait showWhile: [
			self newFontSelector
				basicTheme: aThemedMorph theme;
				title: aString;
				selectedFont: aFont]).
	^d  cancelled
		ifFalse: [d selectedFont]! !

!UITheme methodsFor: 'morph creation' stamp: 'EstebanLorenzano 5/15/2014 17:53'!
newAutoAcceptTextEditorIn: aThemedMorph for: aModel getText: getSel setText: setSel getEnabled: enabledSel
	"Answer a text editor for the given model."

	^PluggableTextMorph new
		autoAccept: true;
		on: aModel
		text: getSel
		accept: setSel
		readSelection: nil
		menu: nil;
		getEnabledSelector: enabledSel;
		font: self textFont;
		cornerStyle: aThemedMorph preferredCornerStyle;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		borderStyle: (BorderStyle inset width: 1);
		selectionColor: self selectionColor! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 2/16/2009 17:21'!
drawWindowActiveDropShadowFor: aSystemWindow on: aCanvas
	"Draw the active drop shadow for the given window."
	
	
	^self windowActiveDropShadowStyle == #diffuse
		ifTrue: [self drawWindowDiffuseDropShadowFor: aSystemWindow on: aCanvas]
		ifFalse: [self drawWindowPlainDropShadowFor: aSystemWindow on: aCanvas]! !

!UITheme methodsFor: 'fill-styles-buttons' stamp: 'gvc 4/25/2007 18:54'!
buttonMouseOverFillStyleFor: aButton
	"Return the button mouse over fillStyle for the given color."

	^self buttonNormalFillStyleFor: aButton! !

!UITheme methodsFor: 'defaults' stamp: 'AlainPlantec 12/13/2009 18:02'!
defaultMenuColor
	"Answer the default color to use for a menu
	in the absence of an override in settings."

	^ self settings fallbackMenuColor ! !

!UITheme methodsFor: 'fill-styles-buttons' stamp: 'AlainPlantec 12/19/2009 14:17'!
menuItemInDockingBarSelectedFillStyleFor: aMenuItem
	"Answer the selected fill style to use for the given menu item that is in a docking bar."
	
	^ self menuItemSelectedFillStyleFor: aMenuItem
! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 1/23/2009 12:27'!
dropListFocusBoundsFor: aDropList
	"Answer the bounds for drawing the focus indication for the
	given drop list."

	^(aDropList innerBounds
		insetBy: (0@0 corner: aDropList buttonMorph width@0))
		insetBy: aDropList layoutInset! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 3/2/2009 12:27'!
taskbarThumbnailCornerStyleFor: aMorph
	"Answer the corner style for the taskbar thumbnail/tasklist."
	
	^#rounded! !

!UITheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 4/29/2014 16:53'!
secondarySelectionColor
	^ self settings secondarySelectionColor! !

!UITheme methodsFor: 'fill-styles-buttons' stamp: 'gvc 5/23/2007 12:03'!
checkboxButtonNormalFillStyleFor: aCheckboxButton
	"Return the normal checkbox button fillStyle for the given button."
	
	^Color white! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 10/26/2006 16:48'!
newMenuIn: aThemedMorph for: aModel
	"Answer a new menu."

	^MenuMorph new
		defaultTarget: aModel;
		color: (self menuColorFor: aThemedMorph)! !

!UITheme methodsFor: 'morph creation' stamp: 'BenjaminVanRyseghem 3/22/2013 17:24'!
windowCollapseBoxLayoutFor: aWindow

	^ LayoutFrame new 
		leftFraction: 1; 
		leftOffset: aWindow boxExtent x negated;
		yourself! !

!UITheme methodsFor: 'label-styles' stamp: 'gvc 6/1/2009 12:20'!
configureDialogWindowLabelAreaFrameFor: aWindow
	"Configure the layout frame for the label area for the given dialog window."

	|frame|
	self configureWindowLabelAreaFrameFor: aWindow.
	aWindow labelArea ifNil: [^ self].	
	frame := aWindow labelArea layoutFrame.
	frame
		leftOffset: 0;
		rightOffset: 0! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 3/6/2010 15:28'!
newColumnIn: aThemedMorph for: controls
	"Answer a morph laid out with a column of controls."

	|answer|
	answer := PanelMorph new
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		fillStyle: Color transparent; "non pane color tracking"
		changeTableLayout;
		cellInset: 8;
		cellPositioning: #leftCenter.
	controls do: [:m | answer addMorphBack: m].
	^answer
			! !

!UITheme methodsFor: '*Rubric-Editing-Core' stamp: 'TudorGirba 6/2/2014 11:32'!
rubScrolledTextMorphThemer
	^ RubScrolledTextMorphThemer new! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 12/1/2008 15:29'!
windowPaneBorderStyleFor: aMorph in: aSystemWindow
	"Answer the border style for a morph that is to be added
	as a pane in the given system window,"

	^BorderStyle inset
		color: aSystemWindow paneColor;
		width: (aMorph borderWidth = 0 ifTrue: [0] ifFalse: [1])! !

!UITheme methodsFor: 'fill-styles-buttons' stamp: 'gvc 11/13/2007 11:30'!
controlButtonSelectedDisabledFillStyleFor: aButton
	"Return the selected disabled control button fillStyle for the given button.
	Control buttons are generally used for drop-lists and expanders."
	
	^self buttonSelectedDisabledFillStyleFor: aButton! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 2/2/2009 15:11'!
newCancelButtonIn: aThemedMorph for: aModel
	"Answer a new cancel button."

	^self
		newButtonIn: aThemedMorph
		for: aModel
		getState: nil
		action: #cancel
		arguments: nil
		getEnabled: nil
		label: 'Cancel' translated
		help: 'Cancel changes and close the window' translated! !

!UITheme methodsFor: 'services' stamp: 'StephaneDucasse 8/22/2013 23:34'!
chooseColorIn: aThemedMorph title: aString color: aColor for: aBlock
	"execute block with result of a color selector dialog with the given title and initial color."

	|d newColor|
	d := (ColorSelectorDialogWindow newWithTheme: aThemedMorph theme)
			title: aString;
			selectedColor: aColor.
	d extent: d initialExtent.
	d announcer when: ColorChanged do: [:ann | 
		aBlock value: ann newColor].
	d openInHand.
	self runModal: d.
	
	newColor := d  cancelled
		ifTrue: [aColor]
		ifFalse: [d selectedColor].
				
	aBlock value: newColor.! !

!UITheme methodsFor: 'accessing colors' stamp: 'BenjaminVanRyseghem 6/10/2013 04:06'!
lightBaseColor

	^ self class lightBaseColor! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 3/6/2010 16:12'!
newRowIn: aThemedMorph for: controls
	"Answer a morph laid out with a row of controls."

	|answer|
	answer := PanelMorph new
		hResizing: #spaceFill;
		vResizing: #shrinkWrap;
		fillStyle: Color transparent; "non pane color tracking"
		changeTableLayout;
		listDirection: #leftToRight;
		cellInset: 8;
		cellPositioning: #center.
	controls do: [:m | answer addMorphBack: m].
	^answer
			! !

!UITheme methodsFor: 'morph creation' stamp: 'GaryChambers 12/2/2011 12:31'!
newListIn: aThemedMorph for: aModel list: listSelector selected: getSelector changeSelected: setSelector getEnabled: enabledSel help: helpText
	"Answer a list for the given model."

	^PluggableListMorph new
		selectionColor: self selectionColor;
		textColor: self listTextColor;
		font: self listFont;
		on: aModel
		list: listSelector
		selected: getSelector
		changeSelected: setSelector
		menu: nil
		keystroke: nil;
		autoDeselect: false;
		cornerStyle: aThemedMorph preferredCornerStyle;
		color: Color white;
		borderStyle: (BorderStyle inset width: 1);
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		getEnabledSelector: enabledSel;
		setBalloonText: helpText! !

!UITheme methodsFor: 'accessing colors' stamp: 'gvc 10/26/2006 16:48'!
menuColor
	"Answer the menu color to use."

	^self settings menuColor! !

!UITheme methodsFor: 'configure' stamp: 'EstebanLorenzano 5/1/2014 15:53'!
configureMorphTreeMorph: aMorph
	aMorph preferedPaneColor: Color white.
	aMorph 
		rowColorForEven: Color white
		odd: Color white.! !

!UITheme methodsFor: 'label-styles' stamp: 'StephaneDucasse 5/31/2013 17:53'!
checkboxLabelFor: aCheckbox
	"Answer the label to use for the given checkbox."

	|label|
	label := self checkboxLabelForText: aCheckbox label.
	label enabled: aCheckbox enabled.
	label font: self labelFont.
	^label! !

!UITheme methodsFor: 'fill-styles' stamp: 'GaryChambers 2/15/2011 12:40'!
paneColorFor: aWindow
	"Answer the pane color that should be used."
	
	| cc |
	(cc := aWindow valueOfProperty: #paneColor) 
		ifNotNil: [
			^self settings fadedBackgroundWindows
				ifTrue: [aWindow isActive
					ifTrue: [cc]
					ifFalse: [cc alphaMixed: 0.5 with: (Color white alpha: cc alpha)]]
				ifFalse: [cc]].
	cc := aWindow paneMorphs isEmptyOrNil ifFalse: [aWindow paneMorphs first color].
	aWindow setProperty: #paneColor toValue: (cc ifNil: [aWindow defaultBackgroundColor]).
	^aWindow paneColor! !

!UITheme methodsFor: 'services' stamp: 'GaryChambers 12/6/2011 10:05'!
messageIn: aThemedMorph text: aStringOrText title: aString
	"Answer the result of a message dialog (true) with the given label and title."

	self messageSound play.
	^(aThemedMorph openModal: (
		(MessageDialogWindow newWithTheme: aThemedMorph theme)
			textFont: self textFont;
			title: aString;
			text: aStringOrText)) cancelled not! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 8/9/2007 12:57'!
newFuzzyLabelIn: aThemedMorph for: aModel label: aString offset: offset alpha: alpha getEnabled: enabledSel
	"Answer a new fuzzy label."

	^(FuzzyLabelMorph contents: aString font: self labelFont)
		offset: offset;
		alpha: alpha;
		model: aModel;
		getEnabledSelector: enabledSel	! !

!UITheme methodsFor: 'services' stamp: 'GaryChambers 12/6/2011 10:05'!
textEditorIn: aThemedMorph text: aStringOrText title: aString entryText: defaultEntryText entryHeight: entryHeight
	"Answer the result of a text editor (multiline) dialog ( a string or nil if cancelled)
	with the given label and title."

	self questionSound play.
	^(aThemedMorph openModal: (
		(TextEditorDialogWindow newWithTheme: aThemedMorph theme)
			textFont: self textFont;
			title: aString;
			text: aStringOrText;
			entryText: defaultEntryText;
			entryHeight: entryHeight)) entryText! !

!UITheme methodsFor: 'sounds' stamp: 'gvc 9/12/2007 14:46'!
windowMinimizeSound
	"Answer the window minimize sound."

	^self soundTheme windowMinimizeSound! !

!UITheme methodsFor: 'morph creation' stamp: 'SeanDeNigris 1/23/2014 12:03'!
newTaskbarThumbnailIn: aThemedMorph for: aWindow
	"Answer a taskbar thumbnail morph for the given window."

	|answer thumb|
	thumb := aWindow taskbarThumbnail.
	answer := PanelMorph new
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap;
		changeTableLayout;
		layoutInset: 8;
		cellInset: 4;
		addMorphBack: thumb;
		addMorphBack: (self
			buttonLabelForText: (aWindow labelString truncateWithElipsisTo: 50)).
	answer
		extent: answer minExtent;
		fillStyle: (self taskListFillStyleFor: answer);
		borderStyle: (self taskbarThumbnailNormalBorderStyleFor: aWindow);
		cornerStyle: (self taskbarThumbnailCornerStyleFor: answer).
	^answer! !

!UITheme methodsFor: 'defaults' stamp: 'gvc 6/8/2009 14:20'!
buttonPressedLabelInsetFor: aButton
	"Answer the inset to use for a button's label when pressed."

	^self buttonLabelInsetFor: aButton! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 8/3/2007 15:27'!
sliderNormalFillStyleFor: aSlider
	"Return the normal fillStyle for the given slider."
	
	^Color white! !

!UITheme methodsFor: 'scrollbars' stamp: 'AlainPlantec 11/27/2010 20:36'!
basicCreateArrowOfDirection: aSymbolDirection size: finalSizeInteger color: aColor 
	"PRIVATE - create an arrow with aSymbolDirectionDirection,  
	finalSizeInteger and aColor.
	aSymbolDirectionDirection = #top, #bottom. #left or #right .
	Try with:  
	(UITheme current
		basicCreateArrowOfDirection: #top 
		size: 32 
		color: Color lightGreen) asMorph openInHand. 
	Fixed to work with translucent colours."
	
	|form resizeFactor arrow resizedForm |
	resizeFactor := 4.
	form := Form
		extent: finalSizeInteger asPoint * resizeFactor
		depth: Display depth.
	form fillColor: Color transparent.
	arrow := (self createArrowOfDirection: aSymbolDirection in: form boundingBox)
		borderWidth: 1;
		borderColor: aColor lighter.
	self
		updateScrollBarButtonAspect: arrow
		color: (aColor alphaMixed: 0.7 with: Color black).
	arrow fullDrawOn: form getCanvas.
	resizedForm := form
		magnify: form boundingBox
		by: 1 / resizeFactor
		smoothing: 4.
	^resizedForm trimBordersOfColor: Color transparent! !

!UITheme methodsFor: 'fill-styles-buttons' stamp: 'gvc 8/10/2007 11:48'!
radioButtonDisabledFillStyleFor: aRadioButton
	"Return the disabled radio button fillStyle for the given button."
	
	^self checkboxButtonDisabledFillStyleFor: aRadioButton! !

!UITheme methodsFor: 'accessing colors' stamp: 'gvc 2/9/2009 17:12'!
windowShadowColor
	"Answer the window shadow color to use."

	^Color black alpha: 0.5! !

!UITheme methodsFor: 'fill-styles-scrollbars' stamp: 'gvc 6/4/2007 15:15'!
scrollbarMouseOverBarButtonFillStyleFor: aScrollbar
	"Return the button fillStyle for the given scrollbar when
	the mouse is over the bar."

	^self scrollbarNormalButtonFillStyleFor: aScrollbar! !

!UITheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 5/15/2014 14:06'!
lightBackgroundColor 
	^ Color veryLightGray muchLighter! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 5/23/2007 12:28'!
checkboxButtonNormalBorderStyleFor: aCheckboxButton
	"Return the normal checkbox button borderStyle for the given button."

	^BorderStyle simple
		width: 1;
		baseColor: aCheckboxButton paneColor twiceDarker! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 8/7/2007 11:07'!
dropListNormalListFillStyleFor: aDropList
	"Return the normal fillStyle for the list of the given drop list."
	
	^Color white! !

!UITheme methodsFor: 'services' stamp: 'GaryChambers 12/6/2011 10:00'!
alertIn: aThemedMorph text: aStringOrText title: aString configure: aBlock
	"Answer the result of an alert dialog (true) with the given label and title."

	|dialog|
	SoundTheme useThemeSounds ifTrue: [self alertSound play].
	dialog := (AlertDialogWindow newWithTheme: aThemedMorph theme)
		textFont: self textFont;
		title: aString;
		text: aStringOrText.
	aBlock value: dialog.
	aThemedMorph openModal: dialog.
	^dialog cancelled not! !

!UITheme methodsFor: '*Glamour-Morphic-Pager' stamp: 'AndreiChis 4/24/2014 13:42'!
pagerWidgetThemer
	^ GLMPagerWidgetThemer new! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 9/8/2006 14:57'!
newGroupboxIn: aThemedMorph label: aString
	"Answer a groupbox with the given label."

	^GroupboxMorph new
		font: self labelFont;
		cornerStyle: aThemedMorph preferredCornerStyle;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		label: aString;
		yourself! !

!UITheme methodsFor: 'sounds' stamp: 'gvc 9/12/2007 17:49'!
windowOpenSound
	"Answer the window open sound."

	^self soundTheme windowOpenSound! !

!UITheme methodsFor: 'defaults' stamp: 'gvc 1/20/2009 17:00'!
focusIndicatorCornerRadiusFor: aMorph
	"Answer the default corner radius preferred for the focus indicator
	for the morph for themes that support this."

	^aMorph wantsRoundedCorners
		ifTrue: [6]
		ifFalse: [2]! !

!UITheme methodsFor: 'morph creation' stamp: 'StephaneDucasse 9/7/2013 12:41'!
newToolbarIn: aThemedMorph
	"Answer a new toolbar."

	|bar|
	bar := PanelMorph new
		changeTableLayout;
		layoutInset: 0@1;
		listDirection: #leftToRight;
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap.
	bar
		addMorphBack: (self newToolSpacerIn: aThemedMorph);
		addMorphBack: (self newToolbarHandleIn: aThemedMorph);
		addMorphBack: (self newToolSpacerIn: aThemedMorph).
	^bar! !

!UITheme methodsFor: 'border-styles-scrollbars' stamp: 'gvc 3/30/2007 10:16'!
scrollbarMouseOverThumbBorderStyleFor: aScrollbar
	"Return the mouse over thumb borderStyle for the given scrollbar."

	^self scrollbarNormalThumbBorderStyleFor: aScrollbar! !

!UITheme methodsFor: 'services' stamp: 'StephaneDucasse 6/5/2011 22:39'!
runModal: aWidget
	
	[aWidget world notNil] whileTrue: [
		aWidget outermostWorldMorph doOneCycle]! !

!UITheme methodsFor: 'defaults' stamp: 'gvc 12/19/2006 13:10'!
dropListFont
	"Answer the drop list font to use."

	^self textFont! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 8/25/2006 14:38'!
newTitleIn: aThemedMorph label: aString for: control
	"Answer a morph laid out with a column with the title and control aligned to the left."

	^(self newColumnIn: aThemedMorph for: {
		self newLabelIn: aThemedMorph label: aString.
		control})
		cellPositioning: #leftCenter;
		cellInset: 2! !

!UITheme methodsFor: 'defaults' stamp: 'BenjaminVanRyseghem 3/22/2013 15:48'!
selectionColorForFrame: frame 

	^ self selectionColor! !

!UITheme methodsFor: 'services' stamp: 'GaryChambers 12/2/2011 12:01'!
chooseFileNameIn: aThemedMorph title: title patterns: patterns path: path preview: preview
	"Answer the result of a file name chooser dialog with the given title, patterns
	path and preview type.
	Answer nil or a filename."

	|fd|
	fd := FileDialogWindow basicNew
		basicTheme: aThemedMorph theme;
		previewType: preview;
		initialize;
		title: title;
		answerFileName.
	patterns ifNotNil: [
		fd fileSelectionBlock: [:de |
			(fd defaultFileSelectionBlock value: de) and: [
				de isDirectory or: [patterns anySatisfy: [:pat | pat match: de name]]]]].
	path ifNotNil: [fd selectPathName: path].
	^(aThemedMorph openModal: fd) answer! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 5/23/2007 14:25'!
expanderTitleNormalFillStyleFor: anExpanderTitle
	"Return the normal expander title fillStyle for the given expander title."
	
	^anExpanderTitle paneColor! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 5/23/2007 12:56'!
textEditorNormalFillStyleFor: aTextEditor
	"Return the normal fillStyle for the given text editor."
	
	^Color white! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 11/13/2007 11:32'!
controlButtonNormalBorderStyleFor: aButton
	"Return the normal control button borderStyle for the given button.
	Control buttons are generally used for drop-lists and expanders."

	^self buttonNormalBorderStyleFor: aButton! !

!UITheme methodsFor: 'accessing' stamp: 'gvc 7/30/2009 18:32'!
soundTheme: anObject
	"Set the sound theme specific to this instance of ui theme,"

	soundTheme := anObject! !

!UITheme methodsFor: 'label-styles' stamp: 'EstebanLorenzano 4/30/2014 11:56'!
windowLabelForText: aTextOrString
	"Answer the window label to use for the given text."
	^ LabelMorph new
		contents: aTextOrString;
		font: StandardFonts windowTitleFont emphasis: 0! !

!UITheme methodsFor: 'defaults' stamp: 'gvc 6/2/2009 10:18'!
dialogWindowPreferredCornerStyleFor: aDialogWindow
	"Answer the preferred corner style for the given dialog."

	^#rounded! !

!UITheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 4/29/2014 14:43'!
selectionColor
	"Answer the selection color to use.."

	^ self settings selectionColor! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 9/6/2007 15:27'!
newFocusIndicatorMorphFor: aMorph
	"Answer a new focus indicator for the given morph."

	^BorderedMorph new
		fillStyle: Color transparent;
		borderStyle: (DashedBorder
						width: 1
						dashColors: {aMorph focusColor. Color transparent} dashLengths: #(1 1));
		bounds: aMorph focusBounds! !

!UITheme methodsFor: 'morph creation' stamp: 'GaryChambers 1/20/2011 12:06'!
newSliderIn: aThemedMorph for: aModel getValue: getSel setValue: setSel min: min max: max quantum: quantum getEnabled: enabledSel help: helpText
	"Answer a slider. Resizing set for horizontal usage by default."

	^(PluggableSliderMorph
			on: aModel
			getValue: getSel
			setValue: setSel
			min: min
			max: max
			quantum: quantum)
		getEnabledSelector: enabledSel;
		hResizing: #spaceFill;
		vResizing: #shrinkWrap;
		setBalloonText: helpText;
		minHeight: 16! !

!UITheme methodsFor: 'defaults' stamp: 'BenjaminVanRyseghem 6/12/2013 14:00'!
windowBottomOffset

	^ 0! !

!UITheme methodsFor: 'morph creation' stamp: 'GaryChambers 8/10/2010 16:01'!
newButtonLabelIn: aThemedMorph for: aModel label: aString getEnabled: enabledSel
	"Answer a new button text label."

	^(self buttonLabelForText: aString)
		model: aModel;
		getEnabledSelector: enabledSel! !

!UITheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 5/1/2014 01:08'!
disabledTextColor 
	^ self disabledColor! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 6/2/2009 11:30'!
configureWindowBorderFor: aWindow
	"Configure the border for the given window."

	aWindow roundedCorners: #(1 2 3 4).
	aWindow borderStyle: (BorderStyle
		width: 1 color: Color lightGray)! !

!UITheme methodsFor: 'morph creation' stamp: 'GaryChambers 6/7/2011 15:12'!
newImageIn: aThemedMorph form: aForm size: aPoint
	"Answer a new image morph."

	^AlphaImageMorph new
		borderStyle: (BorderStyle inset width: 0);
		image: aForm size: aPoint! !

!UITheme methodsFor: 'morph creation' stamp: 'AlainPlantec 11/25/2010 09:44'!
newAutoAcceptTextEntryIn: aThemedMorph for: aModel  get: getSel set: setSel class: aClass getEnabled: enabledSel help: helpText entryCompletion: anEntryCompletion
	"Answer a text entry for the given model.
	Object conversion will be automatic based on the class of
	object returned after performing the get selector, aClass
	is provided in case of initial nil returns."

	^self
		newAutoAcceptTextEntryIn: aThemedMorph
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel
		font: self textFont
		help: helpText
		entryCompletion: anEntryCompletion! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 1/7/2008 14:12'!
tabPanelBorderStyleFor: aTabPanel
	"Answer the normal border style for a tab panel."

	^BorderStyle simple
		width: 0;
		baseColor: Color transparent! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 3/16/2007 15:51'!
newYesButtonIn: aThemedMorph for: aModel
	"Answer a new Yes button."

	^(self
			newButtonIn: aThemedMorph
			for: aModel
			getState: nil
			action: #yes
			arguments: nil
			getEnabled: nil
			label: 'Yes' translated
			help: 'Answer yes and close the window' translated)
		hResizing: #rigid;
		vResizing: #rigid! !

!UITheme methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 1/30/2015 17:58'!
brickThemer

	^ GLMBrickThemer new! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 3/6/2010 17:29'!
newHSVASelectorIn: aThemedMorph color: aColor help: helpText
	"Answer a hue-saturation-volume-alpha selector."

	^HSVAColorSelectorMorph new
		selectedColor: aColor;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		setBalloonText: helpText! !

!UITheme methodsFor: 'label-styles' stamp: 'gvc 1/7/2008 14:54'!
tabSelectorCellInsetFor: aTabSelector
	"Answer the cell inset to use for the given tab selector."

	^2@0! !

!UITheme methodsFor: 'defaults' stamp: 'gvc 1/28/2009 17:08'!
expanderTitleControlButtonWidth
	"Answer the width of an expander title control button for this theme."
	
	^self buttonMinWidth! !

!UITheme methodsFor: 'fill-styles' stamp: 'AlainPlantec 12/14/2009 14:30'!
dialogWindowInactiveFillStyleFor: aWindow
	"Return the dialog window inactive fillStyle for the given window."
	
	^self settings  fadedBackgroundWindows
		ifTrue: [aWindow paneColorToUse lighter
					alphaMixed: 0.9
					with: (Color white alpha: aWindow paneColorToUse alpha)]
		ifFalse: [aWindow paneColorToUse lighter]! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'MarcusDenker 12/11/2009 09:35'!
textEntryCornerStyleIn: aThemedMorph
	"Answer the corner style to use for text entry morphs."
	
	^aThemedMorph
		ifNil: [#square]
		ifNotNil: [:tm | tm preferredCornerStyle]! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 9/8/2009 13:17'!
newIncrementalSliderIn: aThemedMorph for: aModel getValue: getSel setValue: setSel min: min max: max quantum: quantum getEnabled: enabledSel help: helpText
	"Answer a slider inrement/decrement buttons."

	^(IncrementalSliderMorph
			on: aModel
			getValue: getSel
			setValue: setSel
			min: min
			max: max
			quantum: quantum)
		getEnabledSelector: enabledSel;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		setBalloonText: helpText! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 1/7/2008 11:19'!
tabLabelNormalBorderStyleFor: aTabLabel
	"Answer the normal border style for a tab label."

	^BorderStyle simple
		width: 0;
		baseColor: Color transparent! !

!UITheme methodsFor: '*growl' stamp: 'FernandoOlivero 9/9/2013 01:51'!
growlDismissHandleFor: aGrowlMorph
	| handle form image |
	handle := BorderedMorph newBounds: ((3@3) extent: (20@20))  color: Color white.
	handle borderColor: handle color muchDarker.
	handle borderWidth: 1.
	handle wantsYellowButtonMenu: false.
	form := self "haloDismissIcon" windowCloseForm.
	form ifNotNil: [
		image := ImageMorph new.
		image form: form.
		image color: handle color contrastingForegroundColor.
		image lock.
		handle addMorphCentered: image].
	^ handle! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 7/30/2009 14:12'!
newToolbarIn: aThemedMorph for: controls
	"Answer a new toolbar with the given controls."

	|answer|
	answer := self newToolbarIn: aThemedMorph.
	controls do: [:m | answer addMorphBack: m].
	^answer! !

!UITheme methodsFor: 'morph creation' stamp: 'CamilloBruni 2/19/2014 20:40'!
scrollBarUpButtonBoundsFor: aScrollbar
	^ aScrollbar innerBounds topLeft extent: aScrollbar buttonExtent! !

!UITheme methodsFor: 'morph creation' stamp: 'EstebanLorenzano 5/1/2014 11:02'!
newTreeIn: aThemedMorph for: aModel list: listSelector selected: getSelector changeSelected: setSelector
	"Answer a new tree morph."
	
	^TreeListMorph new
		selectionColor: self selectionColor;
		font: self listFont;
		on: aModel
		list: listSelector
		selected: getSelector
		changeSelected: setSelector
		menu: nil
		keystroke: nil;
		cornerStyle: aThemedMorph preferredCornerStyle;
		"color: Color white;"
		borderStyle: (BorderStyle inset width: 1);
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		autoDeselect: false;
		yourself
		! !

!UITheme methodsFor: 'label-styles' stamp: 'StephaneDucasse 5/31/2013 17:53'!
buttonLabelFor: aButton
	"Answer the label to use for the given button."

	|label|
	label := self buttonLabelForText: aButton label.
	label enabled: aButton enabled.
	label font: self buttonFont.
	^label! !

!UITheme methodsFor: 'accessing colors' stamp: 'AlainPlantec 2/8/2011 10:10'!
unfocusedSelectionColor
	^ self settings unfocusedSelectionColor! !

!UITheme methodsFor: 'services' stamp: 'GaryChambers 12/2/2011 12:01'!
chooseFullFileNameIn: aThemedMorph title: title patterns: patterns path: path preview: preview
	"Answer the result of a file name chooser dialog with the given title, patterns
	path and preview type.
	Answer nil or a filename."

	|fd|
	fd := FileDialogWindow basicNew
		basicTheme: aThemedMorph theme;
		previewType: preview;
		initialize;
		title: title;
		answerPathName.
	patterns ifNotNil: [
		fd fileSelectionBlock: [:de |
			(fd defaultFileSelectionBlock value: de) and: [
				de isDirectory or: [patterns anySatisfy: [:pat | pat match: de name]]]]].
	path ifNotNil: [fd selectPathName: path].
	^(aThemedMorph openModal: fd) answer! !

!UITheme methodsFor: 'fill-styles-buttons' stamp: 'gvc 8/10/2007 11:48'!
radioButtonNormalFillStyleFor: aRadioButton
	"Return the normal radio button fillStyle for the given button."
	
	^self checkboxButtonNormalFillStyleFor: aRadioButton! !

!UITheme methodsFor: 'initialize-release' stamp: 'BenComan 3/24/2014 21:12'!
newWindowCloseOverForm
	"Answer a new form for a window menu box."

	^ self newWindowCloseForm! !

!UITheme methodsFor: 'services' stamp: 'GaryChambers 12/6/2011 10:05'!
longMessageIn: aThemedMorph text: aStringOrText title: aString
	"Answer the result of a (potentially long) message dialog (true) with the given label and title."

	self messageSound play.
	^(aThemedMorph openModal: (
		(LongMessageDialogWindow newWithTheme: aThemedMorph theme)
			textFont: self textFont;
			title: aString;
			text: aStringOrText)) cancelled not! !

!UITheme methodsFor: 'fill-styles-scrollbars' stamp: 'gvc 3/30/2007 10:15'!
scrollbarMouseOverThumbFillStyleFor: aScrollbar
	"Return the scrollbar mouse over thumb fillStyle for the given color."

	^self scrollbarNormalThumbFillStyleFor: aScrollbar! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 4/18/2007 11:48'!
taskbarThumbnailNormalBorderStyleFor: aWindow
	"Return the normal thumbnail borderStyle for the given button."

	|c|
	c := self windowColorFor: aWindow.
	^BorderStyle raised
		width: 1;
		baseColor: c! !

!UITheme methodsFor: 'morph creation' stamp: 'EstebanLorenzano 5/15/2014 17:54'!
newAutoAcceptTextEntryIn: aThemedMorph for: aModel  get: getSel set: setSel class: aClass getEnabled: enabledSel font: aFont help: helpText entryCompletion: anEntryCompletion
	"Answer a text entry for the given model.
	Object conversion will be automatic based on the class of
	object returned after performing the get selector, aClass
	is provided in case of initial nil returns."

	|pt|
	pt := PluggableTextFieldMorph new
		autoAccept: true;
		alwaysAccept: true;
		convertTo: aClass;
		on: aModel
		text: getSel
		accept: setSel
		readSelection: nil
		menu: nil;
		acceptOnCR: true;
		getEnabledSelector: enabledSel;
		font: aFont;
		cornerStyle: (self textEntryCornerStyleIn: aThemedMorph);
		hResizing: #spaceFill;
		vResizing: #rigid;
		borderStyle: (BorderStyle inset width: 1);
		selectionColor: self selectionColor;
		hideScrollBarsIndefinitely;
		extent: 24@(aFont height + 8);
		setBalloonText: helpText;
		entryCompletion: anEntryCompletion.
	pt textMorph
		autoFit: true;
		wrapFlag: false;
		margins: (2@1 corner: 2@1).
	^pt
! !

!UITheme methodsFor: 'border-styles' stamp: 'BenjaminVanRyseghem 11/27/2013 14:51'!
drawTextAdornmentsFor: aPluggableTextMorph on: aCanvas
	"Indicate edit status for the given morph."
	
	(aPluggableTextMorph hasEditingConflicts or: [aPluggableTextMorph hasValidText not])
		ifTrue: [^self drawTextAdornmentFor: aPluggableTextMorph color: Color red on: aCanvas].
	aPluggableTextMorph hasUnacceptedEdits
		ifTrue: [aPluggableTextMorph model wantsDiffFeedback
					ifTrue: [^self drawTextAdornmentFor: aPluggableTextMorph color: Color yellow darker on: aCanvas]
					ifFalse: [
						aPluggableTextMorph model wantsVisualFeedback
							ifTrue: [ ^self drawTextAdornmentFor: aPluggableTextMorph color: Color orange on: aCanvas] ] ].
	aPluggableTextMorph model wantsDiffFeedback
		ifTrue: [self drawTextAdornmentFor: aPluggableTextMorph color: Color green on: aCanvas]! !

!UITheme methodsFor: 'services' stamp: 'GaryChambers 12/6/2011 10:05'!
questionIn: aThemedMorph text: aStringOrText title: aString
	"Answer the result of a question dialog with the given label and title."

	self questionSound play.
	^(aThemedMorph openModal: (
		(QuestionDialogWindow newWithTheme: aThemedMorph theme)
			textFont: self textFont;
			title: aString;
			text: aStringOrText)) answer! !

!UITheme methodsFor: 'services' stamp: 'GaryChambers 12/6/2011 10:04'!
customQuestionIn: aThemedMorph text: labelText yesText: yesText noText: noText title: aString
	"Answer the result of a question dialog with the given label, button labels and title."

	self questionSound play.
	^(aThemedMorph openModal: (
		(CustomQuestionDialogWindow newWithTheme: aThemedMorph theme)
			textFont: self textFont;
			title: aString;
			text: labelText;
			yesText: yesText help: nil;
			noText: noText help: nil)) answer! !

!UITheme methodsFor: 'initialization' stamp: 'EstebanLorenzano 10/17/2013 13:22'!
initialize
	"Initialize the receiver."

	super initialize.
	self
		initializeForms;
		settings: self defaultSettings.! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 2/29/2008 22:01'!
radioButtonSelectedDisabledBorderStyleFor: aRadioButton
	"Return the selecteddisabled radio button borderStyle for the given button."

	^self radioButtonDisabledBorderStyleFor: aRadioButton! !

!UITheme methodsFor: 'configure' stamp: 'EstebanLorenzano 4/30/2014 09:06'!
configureSystemWindow: aWindow 
	aWindow basicBorderColor: Color lightGray.
	aWindow basicBorderWidth: 1.
	aWindow color: Color lightGray lighter lighter lighter.	
	self
		configureWindowBorderFor: aWindow;
		configureWindowDropShadowFor: aWindow.	
! !

!UITheme methodsFor: 'defaults' stamp: 'gvc 12/3/2008 17:22'!
buttonMinHeight
	"Answer the minumum height of a button for this theme."
	
	^16! !

!UITheme methodsFor: 'label-styles' stamp: 'StephaneDucasse 9/7/2013 13:10'!
configureWindowLabelAreaFrameFor: aWindow
	"Configure the layout frame for the label area for the given window."

	|frame windowBorderWidth|
	aWindow labelArea ifNil: [^ self].	
	windowBorderWidth := aWindow class borderWidth.
	aWindow labelArea
		layoutPolicy: RowLayout new;
		cellPositioning: #topCenter;
		hResizing: #spaceFill;
		wrapCentering: #topLeft;
		layoutInset: (Margin left: 0 top: windowBorderWidth right: 0 bottom: 1).
	frame := (0@0 corner: 1@0) asLayoutFrame topOffset: aWindow labelHeight negated.
	aWindow labelArea layoutFrame: frame! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 3/6/2010 15:27'!
newColorChooserIn: aThemedMorph for: aModel getColor: getSel setColor: setSel getEnabled: enabledSel help: helpText
	"Answer a color chooser ."

	^(ColorChooserMorph
			on: aModel color: getSel changeColor: setSel)
		getEnabledSelector: enabledSel;
		hResizing: #spaceFill;
		vResizing: #shrinkWrap;
		setBalloonText: helpText! !

!UITheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 4/29/2014 17:38'!
buttonColor 
	^ self settings buttonColor! !

!UITheme methodsFor: 'sounds' stamp: 'gvc 9/12/2007 14:45'!
windowMaximizeSound
	"Answer the window maximize sound."

	^self soundTheme windowMaximizeSound! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 1/23/2007 16:25'!
newSeparatorIn: aThemedMorph
	"Answer a new horizontal separator."

	^SeparatorMorph new
		fillStyle: Color transparent;
		borderStyle: (BorderStyle inset baseColor: Color blue; width: 1);
		extent: 2@2;
		hResizing: #spaceFill! !

!UITheme methodsFor: 'label-styles' stamp: 'GaryChambers 12/21/2011 12:15'!
labelDisabledColorFor: aLabel
	"Answer the color to use for a label when disabled."

	^aLabel owner
		ifNil: [aLabel paneColor muchDarker]
		ifNotNil: [aLabel owner color isTransparent
					ifTrue: [aLabel owner paneColor muchDarker]
					ifFalse: [aLabel owner color muchDarker]].
			! !

!UITheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 6/3/2014 21:36'!
menuKeyboardFocusColor
	^ self settings menuKeyboardFocusColor! !

!UITheme methodsFor: 'morph creation' stamp: 'MarcusDenker 9/23/2011 10:03'!
newFontSelector
	"Answer a new font selector dialog"
		^FreeTypeFontSelectorDialogWindow new
	! !

!UITheme methodsFor: 'sounds' stamp: 'gvc 9/12/2007 14:45'!
denySound
	"Answer the deny sound."

	^self soundTheme denySound! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 10/1/2007 12:16'!
newMorphListIn: aThemedMorph for: aModel list: listSelector getSelected: getSelector setSelected: setSelector getEnabled: enabledSel help: helpText
	"Answer a morph list for the given model."

	^(PluggableMorphListMorph
			on: aModel
			list: listSelector
			selected: getSelector
			changeSelected: setSelector
			menu: nil
			keystroke: nil)
		selectionColor: self selectionColor;
		autoDeselect: false;
		cornerStyle: aThemedMorph preferredCornerStyle;
		color: Color white;
		borderStyle: (BorderStyle inset width: 1);
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		getEnabledSelector: enabledSel;
		setBalloonText: helpText
		! !

!UITheme methodsFor: 'services' stamp: 'GaryChambers 12/6/2011 10:05'!
proceedIn: aThemedMorph text: aStringOrText title: aString
	"Answer the result of a proceed dialog with the given label and title."

	self questionSound play.
	^(aThemedMorph openModal: (
		(ProceedDialogWindow newWithTheme: aThemedMorph theme)
			textFont: self textFont;
			title: aString;
			text: aStringOrText)) cancelled not! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 5/23/2007 13:11'!
textFieldNormalBorderStyleFor: aTextField
	"Return the normal text field borderStyle for the given text field."

	^self textEditorNormalBorderStyleFor: aTextField! !

!UITheme methodsFor: 'label-styles' stamp: 'gvc 5/15/2007 10:00'!
windowMaximizeForm
	"Answer the form to use for the maximize button of a window."

	^self forms at: #windowMaximize ifAbsent: [Form extent: 10@10 depth: Display depth]! !

!UITheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 5/15/2014 19:03'!
menuBorderColor
	^  self settings menuBorderColor! !

!UITheme methodsFor: 'basic-colors' stamp: 'gvc 9/5/2007 15:04'!
treeLineColorsFrom: aColor
	"Answer the colours to use for the tree lines.
	The given colour is the preferred colour."

	^{aColor. Color transparent}! !

!UITheme methodsFor: 'morph creation' stamp: 'GaryChambers 11/15/2011 13:56'!
newLabelGroupIn: aThemedMorph for: labelsAndControls
	"Answer a morph laid out with a column of labels and a column of associated controls.
	The vResizing for each row will be #spaceFill if the control for that row specifies
	this, otherwise #shrinkWrap."

	| labels labelWidth lc |
	lc := labelsAndControls collect: [:a |
		(a key isMorph
			ifTrue: [a key]
			ifFalse: [a key ifNotNil: [self newLabelIn: aThemedMorph label: a key asString]])
			-> a value].
	labels := Morph new
		hResizing: #shrinkWrap;
		vResizing: #spaceFill;
		changeTableLayout.
	lc do: [:a |
		a key ifNotNil: [labels addMorphBack: a key]].
	labelWidth := labels minExtent x.
	^self newColumnIn: aThemedMorph for: (lc collect: [:a | | row |
		a key ifNotNil: [a key hResizing: #rigid; extent: labelWidth@ a key height].
		row := self newRowIn: aThemedMorph for: (a key ifNil: [{a value}] ifNotNil: [{a key. a value}]).
		row vResizing: (a value vResizing = #spaceFill ifTrue: [#spaceFill] ifFalse: [#shrinkWrap]).
		row])! !

!UITheme methodsFor: '*Polymorph-Widgets-Themes' stamp: 'TudorGirba 5/23/2012 14:10'!
watcherWindowInactiveFillStyleFor: aWindow

	^ self windowInactiveFillStyleFor: aWindow! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 8/3/2007 15:26'!
sliderNormalBorderStyleFor: aSlider
	"Return the normal slider borderStyle for the given text editor."

	^BorderStyle inset
		width: 1;
		baseColor: aSlider paneColor twiceDarker! !

!UITheme methodsFor: 'label-styles' stamp: 'gvc 10/25/2007 17:06'!
radioButtonMarkerForm
	"Answer the form to use for a radio button marker."

	^self forms at: #radioButtonMarker ifAbsent: [Form extent: 12@12 depth: Display depth]! !

!UITheme methodsFor: 'basic-colors' stamp: 'gvc 5/9/2007 15:33'!
taskbarActiveButtonColorFor: aButton
	"Answer the colour for the given active taskbar button."

	^(self taskbarButtonColorFor: aButton) twiceDarker! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 8/3/2007 15:25'!
sliderDisabledBorderStyleFor: aSlider
	"Return the disabled slider borderStyle for the given text editor."

	^self sliderNormalBorderStyleFor: aSlider! !

!UITheme methodsFor: 'defaults' stamp: 'AlainPlantec 12/17/2009 14:36'!
scrollbarThickness
	"Answer the width or height of a scrollbar as appropriate to
	its orientation."
	
	^ self settings scrollBarThickness! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 8/7/2007 10:56'!
dropListDisabledFillStyleFor: aDropList
	"Return the disabled fillStyle for the given drop list."
	
	^aDropList paneColor alphaMixed: 0.3 with: Color white! !

!UITheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 5/1/2014 01:46'!
spotlightWindowColor 
	^ self selectionColor muchDarker! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 1/13/2009 14:00'!
dropListNormalListBorderStyleFor: aDropList
	"Return the normal borderStyle for the list of the given given drop list"

	^BorderStyle inset
		width: 1;
		baseColor: aDropList paneColor! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 1/28/2009 17:43'!
multiFormFillStyleFrom: anArray in: aRectangle
	"Answer a composite fill style from the given forms and central colour
	in the given bounds."
	
	|tl tm tr ml mr bl bm br c|
	tl := anArray first.
	tm := anArray second.
	tr := anArray third.
	ml  := anArray fourth.
	c := anArray fifth.
	mr  := anArray sixth.
	bl := anArray seventh.
	bm := anArray eighth.
	br := anArray ninth.
	^CompositeFillStyle fillStyles: {
		(ImageFillStyle form: tl) origin: aRectangle topLeft.
		(AlphaInfiniteForm with: tm)
			origin: aRectangle topLeft + (tl width@0);
			extent: (aRectangle width - tl width - tr width)@tm height.
		(ImageFillStyle form: tr)
			origin: aRectangle topRight - (tr width@0).
		(AlphaInfiniteForm with: ml)
			origin: aRectangle topLeft + (0@tl height);
			extent: ml width@(aRectangle height - tl height - bl height).
		(ColorFillStyle color: c)
			origin: aRectangle topLeft + tl extent;
			extent: aRectangle extent - tl extent - br extent.
		(AlphaInfiniteForm with: mr)
			origin: aRectangle topRight + (tr width negated@tr height);
			extent: mr width@(aRectangle height - tr height - br height).
		(ImageFillStyle form: bl) origin: aRectangle bottomLeft - (0@bl height).
		(AlphaInfiniteForm with: bm)
			origin: aRectangle bottomLeft - (bl width negated@bl height);
			extent: (aRectangle width - bl width - br width)@bm height.
		(ImageFillStyle form: br)
			origin: aRectangle bottomRight - br extent}! !

!UITheme methodsFor: 'fill-styles-buttons' stamp: 'gvc 4/25/2007 18:52'!
buttonPressedFillStyleFor: aButton
	"Return the button pressed fillStyle for the given color."
	
	^self buttonMouseOverFillStyleFor: aButton! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 11/13/2007 11:33'!
controlButtonDisabledBorderStyleFor: aButton
	"Return the disabled control button borderStyle for the given button.
	Control buttons are generally used for drop-lists and expanders."

	^self buttonDisabledBorderStyleFor: aButton! !

!UITheme methodsFor: 'morph creation' stamp: 'GaryChambers 11/15/2011 15:41'!
newRadioButtonIn: aThemedMorph for: aModel getSelected: getSel setSelected: setSel getEnabled: enabledSel label: label help: helpText
	"Answer a checkbox (radio button appearance) with the given label ."

	| answer |
	answer := CheckboxMorph
			on: aModel selected: getSel changeSelected: setSel.
	answer
		getEnabledSelector: enabledSel;
		label: label;
		labelMorph: (self checkboxLabelFor: answer);
		font: self labelFont;
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap;
		setBalloonText: helpText;
		beRadioButton.
	^answer! !

!UITheme methodsFor: 'morph creation' stamp: 'StephaneDucasse 5/31/2013 18:34'!
newButtonIn: aThemedMorph for: aModel getState: stateSel action: actionSel arguments: args getEnabled: enabledSel label: label help: helpText
	"Answer a new button."

	|b|
	b := PluggableButtonMorph
			on: aModel getState: stateSel action: actionSel.
	b
		theme: self;
		arguments: (args ifNil: [{b}]);
		cornerStyle: (self buttonCornerStyleIn: aThemedMorph);
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap;
		label: label font: self buttonFont;
		getEnabledSelector: enabledSel;
		setBalloonText: helpText;
		extent: b minExtent;
		hResizing: #rigid;
		vResizing: #rigid;
		removeProperty: #theme.
	^b! !

!UITheme methodsFor: 'basic-colors' stamp: 'gvc 4/23/2007 17:22'!
progressBarColorFor: aProgressBar
	"Answer the colour for the given progress bar."

	^self settings progressBarColor! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 8/9/2007 11:41'!
newStringIn: aThemedMorph label: aStringOrText font: aFont style: aStyle
	"Answer a new string/text morph."

	^(EmbossedStringMorph contents: aStringOrText font: aFont)
		style: aStyle! !

!UITheme methodsFor: 'accessing colors' stamp: 'AlainPlantec 12/21/2009 11:20'!
menuTitleColor
	"Answer the menu title color to use."
	^self settings menuTitleColor! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 4/26/2007 09:53'!
dialogWindowActiveFillStyleFor: aWindow
	"Return the dialog window active fillStyle for the given window."
	
	^aWindow paneColorToUse lighter! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 1/7/2008 11:13'!
tabLabelNormalFillStyleFor: aTabLabel
	"Return the normal fillStyle for the given tab label."
	
	^aTabLabel paneColor lighter! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 4/25/2007 17:32'!
windowActiveTitleFillStyleFor: aWindow
	"Return the window active title fillStyle for the given color."
	
	^Color transparent! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 2/16/2009 17:21'!
drawWindowInactiveDropShadowFor: aSystemWindow on: aCanvas
	"Draw the inactive drop shadow for the given window."
	
	self drawWindowPlainDropShadowFor: aSystemWindow on: aCanvas! !

!UITheme methodsFor: 'border-styles-scrollbars' stamp: 'gvc 3/30/2007 10:30'!
scrollbarNormalBorderStyleFor: aScrollbar
	"Return the normal button borderStyle for the given scrollbar."

	^BorderStyle simple
		width: 0;
		baseColor: Color transparent! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 6/2/2009 12:16'!
textFocusBoundsFor: aPluggableTextMorph
	"Answer the bounds for drawing the focus indication."

	^aPluggableTextMorph bounds! !

!UITheme methodsFor: 'defaults' stamp: 'AlainPlantec 11/29/2009 22:00'!
listFont
	"Answer the list font to use."

	^StandardFonts listFont! !

!UITheme methodsFor: 'label-styles' stamp: 'gvc 5/15/2007 10:01'!
windowMenuForm
	"Answer the form to use for the menu button of a window."

	^self forms at: #windowMenu ifAbsent: [Form extent: 10@10 depth: Display depth]! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 5/13/2008 15:17'!
worldMainDockingBarBorderStyleFor: aDockingBar
	"Return the world main docking bar borderStyle for the given docking bar."

	^BorderStyle raised
		width: 2;
		color: aDockingBar color! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 6/1/2009 13:18'!
newMorphDropListIn: aThemedMorph for: aModel list: listSel getSelected: getSel setSelected: setSel getEnabled: enabledSel useIndex: useIndex help: helpText
	"Answer a morph drop list for the given model."

	^(MorphDropListMorph
			on: aModel
			list: listSel
			selected: getSel
			changeSelected: setSel
			useIndex: useIndex)
		selectionColor: self selectionColor;
		getEnabledSelector: enabledSel;
		cornerStyle: aThemedMorph preferredCornerStyle;
		hResizing: #spaceFill;
		vResizing: #shrinkWrap;
		setBalloonText: helpText! !

!UITheme methodsFor: 'border-styles-scrollbars' stamp: 'gvc 4/5/2007 14:24'!
scrollbarPressedBorderStyleFor: aScrollbar
	"Return the pressed borderStyle for the given scrollbar."

	^self scrollbarNormalBorderStyleFor: aScrollbar! !

!UITheme methodsFor: 'fill-styles' stamp: 'AlainPlantec 12/13/2009 11:29'!
preferGradientFill
	^ self settings preferGradientFill! !

!UITheme methodsFor: 'services' stamp: 'GaryChambers 12/6/2011 10:02'!
chooseDirectoryIn: aThemedMorph title: title path: path
	"Answer the result of a file dialog with the given title, choosing directories only."

	|fd|
	fd := (FileDialogWindow newWithTheme: aThemedMorph theme)
		title: title;
		answerDirectory.
	path ifNotNil: [fd selectPathName: path].
	^(aThemedMorph openModal: fd) answer! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 8/7/2007 12:41'!
listDisabledBorderStyleFor: aList
	"Return the disabled borderStyle for the given list."

	^self listNormalBorderStyleFor: aList! !

!UITheme methodsFor: 'label-styles' stamp: 'gvc 6/1/2009 11:40'!
dropListButtonLabelFor: aDropList
	"Answer the label for the button of the given drop list."

	^AlphaImageMorph new
		image: (ScrollBar
			arrowOfDirection: #bottom
			size: aDropList buttonWidth - 3
			color: aDropList paneColor darker);
		enabled: aDropList enabled! !

!UITheme methodsFor: 'fill-styles-scrollbars' stamp: 'gvc 4/25/2007 18:21'!
scrollbarNormalThumbFillStyleFor: aScrollbar
	"Return the normal scrollbar thumb fillStyle for the given scrollbar."
	
	^self scrollbarColorFor: aScrollbar! !

!UITheme methodsFor: '*growl' stamp: 'EstebanLorenzano 5/10/2013 09:30'!
growlFillColorFor: aGrowlMorph
	^ self selectionColor! !

!UITheme methodsFor: 'morph creation' stamp: 'CamilloBruni 2/19/2014 20:39'!
newScrollBarDownButtonFor: aScrollbar
	^ BorderedMorph newBounds: (self scrollBarDownButtonBoundsFor: aScrollbar)! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 2/16/2009 17:19'!
windowActiveDropShadowOffsetRectangleFor: aSystemWindow
	"Answer a rectangle describing the offsets for each corner
	of the the active window bounds for the drop shadow area."
	
	^self windowActiveDropShadowStyle == #diffuse
		ifTrue: [self windowDiffuseDropShadowOffsetRectangleFor: aSystemWindow]
		ifFalse: [self windowPlainDropShadowOffsetRectangleFor: aSystemWindow]! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 1/12/2009 13:11'!
separatorFillStyleFor: aSeparator
	"Return the separator fillStyle for the given separator."
	
	|aColor|
	aColor := aSeparator paneColor.
	^(GradientFillStyle ramp: {
		0.0->aColor whiter whiter. 0.2->aColor lighter.
		0.8->aColor darker. 1.0->aColor blacker})
		origin: aSeparator topLeft;
		direction: (aSeparator bounds isWide
			ifTrue: [0 @ aSeparator height]
			ifFalse: [aSeparator width @ 0]);
		radial: false! !

!UITheme methodsFor: 'morph creation' stamp: 'GaryChambers 2/9/2012 11:18'!
newBasicTextEditorIn: aThemedMorph for: aModel getText: getSel setText: setSel getEnabled: enabledSel menu: aMenuSelector
	"Answer a text editor (not Smalltalk code) for the given model."

	^PluggableTextEditorMorph new
		on: aModel
		text: getSel
		accept: setSel
		readSelection: nil
		menu: aMenuSelector;
		theme: self;
		getEnabledSelector: enabledSel;
		font: self textFont;
		cornerStyle: aThemedMorph preferredCornerStyle;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		borderStyle: (BorderStyle inset width: 1);
		color: Color white;
		selectionColor: self selectionColor;
		removeProperty: #theme! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 2/16/2009 17:22'!
windowInactiveDropShadowOffsetRectangleFor: aSystemWindow
	"Answer a rectangle describing the offsets for each corner
	of the the inactive window bounds for the drop shadow area."
	
	^self windowPlainDropShadowOffsetRectangleFor: aSystemWindow! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 9/2/2009 13:00'!
newHueSelectorIn: aThemedMorph for: aModel getHue: getSel setHue: setSel help: helpText
	"Answer a hue selector ."

	^(HColorSelectorMorph
			on: aModel
			getValue: getSel
			setValue: setSel)
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		setBalloonText: helpText! !

!UITheme methodsFor: 'scrollbars' stamp: 'MarcusDenker 10/26/2011 15:21'!
createBoxOfSize: finalSizeInteger color: aColor 
	"PRIVATE - create a box with finalSizeInteger and aColor  
	 
	Try with:  
	(UITheme current createBoxOfSize: 32 color: Color lightGreen) 
          asMorph openInHand.  
	"
	| resizeFactor outerBox innerBox resizedForm |
	resizeFactor := 4.
	outerBox := Morph new.
	outerBox extent: finalSizeInteger asPoint * resizeFactor;
		 color: aColor.
	""
	innerBox := self createBoxIn: outerBox bounds.
	self updateScrollBarButtonAspect: innerBox color: aColor muchDarker.
	outerBox addMorphCentered: innerBox.
	""
	resizedForm := outerBox imageForm
				magnify: outerBox imageForm boundingBox
				by: 1 / resizeFactor
				smoothing: 4.
	""
	^ (resizedForm replaceColor: aColor withColor: Color transparent)
		trimBordersOfColor: Color transparent! !

!UITheme methodsFor: 'border-styles-scrollbars' stamp: 'gvc 3/30/2007 10:16'!
scrollbarMouseOverButtonBorderStyleFor: aScrollbar
	"Return the mouse over button borderStyle for the given scrollbar."

	^self scrollbarNormalButtonBorderStyleFor: aScrollbar! !

!UITheme methodsFor: '*Polymorph-Widgets-Themes' stamp: 'TudorGirba 5/23/2012 13:10'!
configureWatcherWindowLabelAreaFor: aWindow
	^ self configureWindowLabelAreaFor: aWindow! !

!UITheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 4/29/2014 17:37'!
scrollbarColor
	^ self settings scrollbarColor! !

!UITheme methodsFor: 'morph creation' stamp: 'GaryChambers 10/5/2010 13:30'!
newScrollPaneIn: aThemedMorph for: aMorph
	"Answer a new GeneralScrollPane with given content morph."

	^GeneralScrollPane new
		scrollTarget: aMorph;
		yourself! !

!UITheme methodsFor: 'defaults' stamp: 'StephaneDucasse 9/7/2013 13:10'!
tabLabelInsetFor: aButton
	"Answer the inset to use for a tab label."

	^ Margin left: 4 top: 2 right: 4 bottom: 0! !

!UITheme methodsFor: 'morph creation' stamp: 'CamilloBruni 2/19/2014 20:39'!
scrollBarDownButtonBoundsFor: aScrollbar
	^ aScrollbar innerBounds bottomRight - aScrollbar buttonExtent extent: aScrollbar buttonExtent! !

!UITheme methodsFor: 'fill-styles' stamp: 'HilaireFernandes 8/3/2010 10:07'!
menuTitleFillStyleFor: aMenuTitle
	"Return the fillStyle for the given title menu."
	| fill |

	fill := GradientFillStyle ramp: {0.0 -> aMenuTitle color twiceLighter. 1 -> aMenuTitle color twiceDarker}.
	fill
		origin: aMenuTitle topLeft;
		direction: aMenuTitle width @ 0.
	^ fill! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 6/4/2007 13:05'!
menuItemInDockingBarSelectedBorderStyleFor: aMenuItem
	"Return the selected menu item borderStyle when in a docking bar for the given menu item."

	^self menuItemSelectedBorderStyleFor: aMenuItem! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 7/30/2009 14:11'!
dockingBarNormalFillStyleFor: aToolDockingBar
	"Return the normal docking bar fillStyle for the given color."
	
	|aColor|
	aColor := aToolDockingBar originalColor.
	^(GradientFillStyle ramp: {
			0.0->aColor whiter whiter. 0.2->aColor lighter.
			0.8->aColor darker. 1.0->aColor blacker})
		origin: aToolDockingBar topLeft;
		direction: (aToolDockingBar isVertical
			ifTrue: [aToolDockingBar width @ 0]
			ifFalse: [0 @ aToolDockingBar height]);
		radial: false! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 8/7/2007 12:41'!
dropListDisabledBorderStyleFor: aDropList
	"Return the disabled borderStyle for the given drop list."

	^self dropListNormalBorderStyleFor: aDropList! !

!UITheme methodsFor: 'sounds' stamp: 'gvc 9/12/2007 14:40'!
windowCloseSound
	"Answer the window close sound."

	^self soundTheme windowCloseSound! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 3/9/2010 15:13'!
desktopImageLayout
	"Answer the layout symbol for any desktop image.
	See AlphaImageMorph>>layoutSymbols."

	^self settings desktopImageLayout! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 3/27/2008 21:35'!
resizerGripNormalFillStyleFor: aResizer
	"Return the normal fillStyle for the given resizer.
	For the moment, answer a transparent colour for no drawing,
	non transparent to draw as normal."
	
	^Color white! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 5/23/2007 12:26'!
checkboxButtonDisabledBorderStyleFor: aCheckboxButton
	"Return the disabled checkbox button borderStyle for the given button."

	^BorderStyle simple
		width: 1;
		baseColor: aCheckboxButton paneColor darker! !

!UITheme methodsFor: '*Polymorph-Widgets-Themes' stamp: 'TudorGirba 5/23/2012 13:28'!
watcherWindowActiveFillStyleFor: aWindow

	^ self windowActiveFillStyleFor: aWindow! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 5/23/2007 13:06'!
textFieldDisabledFillStyleFor: aTextField
	"Return the disabled fillStyle for the given text field."
	
	^self textEditorDisabledFillStyleFor: aTextField! !

!UITheme methodsFor: 'fill-styles-buttons' stamp: 'AlainPlantec 12/19/2009 14:17'!
menuItemSelectedFillStyleFor: aMenuItem
	"Answer the selected fill style to use for the given menu item."
	
	Display depth <= 2 ifTrue: [^ Color gray].
	^ self settings menuSelectionColor.
! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 10/16/2008 15:38'!
menuColorFor: aThemedMorph
	"Answer the menu color to use."

	|w|
	^self menuColor ifNil: [
		aThemedMorph ifNil: [^self defaultMenuColor].
		w := aThemedMorph isSystemWindow
			ifTrue: [aThemedMorph]
			ifFalse: [aThemedMorph ownerThatIsA: SystemWindow].
		w isNil
			ifTrue: [self defaultMenuColor]
			ifFalse: [(w valueOfProperty: #paneColor) ifNil: [self defaultMenuColor]]]! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 9/2/2009 12:39'!
newAlphaSelectorIn: aThemedMorph for: aModel getAlpha: getSel setAlpha: setSel help: helpText
	"Answer an alpha selector ."

	^(AColorSelectorMorph
			on: aModel
			getValue: getSel
			setValue: setSel)
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		setBalloonText: helpText! !

!UITheme methodsFor: 'configure' stamp: 'EstebanLorenzano 4/29/2014 13:43'!
configureLazyListMorph: listMorph 
	self configureScrollPane: listMorph.! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 7/30/2009 14:12'!
newPluggableDialogWindowIn: aThemedMorph title: title for: contentMorph
	"Answer a new pluggable dialog panel with the given content."

	|answer|
	answer := PluggableDialogWindow new
		setWindowColor: aThemedMorph paneColor;
		title: title;
		contentMorph: contentMorph.
	contentMorph ifNotNil: [answer model: nil].
	^answer! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 11/13/2007 11:34'!
controlButtonSelectedMouseOverBorderStyleFor: aButton
	"Return the selected mouse over control button borderStyle for the given button.
	Control buttons are generally used for drop-lists and expanders."

	^self buttonSelectedMouseOverBorderStyleFor: aButton! !

!UITheme methodsFor: 'fill-styles-scrollbars' stamp: 'gvc 4/26/2007 14:02'!
scrollbarImageColorFor: aScrollbar
	"Return the scrollbar image colour (on buttons) for the given scrollbar."
	
	^self scrollbarColorFor: aScrollbar! !

!UITheme methodsFor: 'accessing' stamp: 'gvc 9/22/2006 17:19'!
settings: anObject
	"Set the value of settings"

	settings := anObject! !

!UITheme methodsFor: 'label-styles' stamp: 'tbn 7/29/2010 21:27'!
createMenuBoxFor: aSystemWindow
	"Answer a button for the window menu."
	
	^aSystemWindow createBox
		labelGraphic: (self windowMenuIconFor: aSystemWindow);
		extent: aSystemWindow boxExtent;
		actWhen: #buttonDown;
		actionSelector: #offerWindowMenu;
		setBalloonText: 'Window menu' translated! !

!UITheme methodsFor: 'defaults' stamp: 'AlainPlantec 11/29/2009 21:55'!
textFont
	"Answer the text font to use."

	^StandardFonts defaultFont! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 2/16/2009 17:16'!
windowPlainDropShadowOffsetRectangleFor: aSystemWindow
	"Answer a rectangle describing the offsets for each corner
	of the the active window bounds for the drop shadow area
	when the plain style is used."
	
	^aSystemWindow shadowOffset negated corner: aSystemWindow shadowOffset! !

!UITheme methodsFor: 'services' stamp: 'GaryChambers 12/6/2011 10:04'!
customQuestionIn: aThemedMorph text: labelText yesText: yesText noText: noText cancelText: cancelText default: defaultOption title: aString
	"Answer the result of a question dialog with the given label, button labels and title.
	defaultOption should be one of true, false or nil to set the default button."

	self questionSound play.
	^(aThemedMorph openModal: (
		(CustomQuestionDialogWindow newWithTheme: aThemedMorph theme)
			textFont: self textFont;
			title: aString;
			text: labelText;
			yesText: yesText help: nil;
			noText: noText help: nil;
			cancelText: cancelText help: nil;
			default: defaultOption)) answer! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 8/7/2007 12:39'!
listNormalFillStyleFor: aList
	"Return the normal fillStyle for the given list."
	
	^Color white! !

!UITheme methodsFor: 'services' stamp: 'GaryChambers 12/6/2011 10:05'!
questionWithoutCancelIn: aThemedMorph text: aStringOrText title: aString
	"Answer the result of a question dialog with the given label and title."

	self questionSound play.
	^(aThemedMorph openModal: (
		(QuestionWithoutCancelDialogWindow newWithTheme: aThemedMorph theme)
			textFont: self textFont;
			title: aString;
			text: aStringOrText)) answer! !

!UITheme methodsFor: 'accessing colors' stamp: 'IgorStasenko 1/14/2011 13:30'!
selectionBarColor

	^ self settings selectionBarColor

! !

!UITheme methodsFor: 'defaults' stamp: 'BenjaminVanRyseghem 6/12/2013 13:59'!
windowLeftOffset

	^ 0! !

!UITheme methodsFor: 'configure' stamp: 'EstebanLorenzano 4/29/2014 22:38'!
configureDropListMorph: aMorph
	"This also uses the fillStyle hack :(
	 check at: #dropListNormalFillStyleFor: for changing style"! !

!UITheme methodsFor: 'label-styles' stamp: 'gvc 5/15/2007 10:01'!
windowCloseForm
	"Answer the form to use for the close button of a window."

	^self forms at: #windowClose ifAbsent: [Form extent: 10@10 depth: Display depth]! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 10/24/2007 11:34'!
worldMainDockingBarNormalFillStyleFor: aDockingBar
	"Return the world main docking bar fillStyle for the given docking bar."
	
	|aColor|
	aColor := aDockingBar originalColor.
	^(GradientFillStyle ramp: {0.0 -> aColor muchLighter. 1.0 -> aColor})
		origin: aDockingBar topLeft;
		direction: (aDockingBar isVertical
			ifTrue: [aDockingBar width @ 0]
			ifFalse: [0 @ aDockingBar height]);
		radial: false! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 9/11/2006 09:46'!
newTextIn: aThemedMorph text: aStringOrText
	"Answer a new text."

	^TextMorph new
		wrapFlag: true;
		contents: aStringOrText;
		font: self textFont;
		autoFit: true;
		lock;
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap! !

!UITheme methodsFor: 'basic-colors' stamp: 'gvc 9/5/2007 15:05'!
treeLineDashes
	"Answer the dash lengths to use for the tree lines."

	^#(1 1)! !

!UITheme methodsFor: 'initialize-release' stamp: 'gvc 2/14/2009 17:38'!
updateWorldDockingBars
	"Update the world docking bar gradients."
	
	World mainDockingBars do: [:d |
		d
			color: (self worldMainDockingBarColorFor: d);
			gradientRamp: (self class current
				worldMainDockingBarNormalFillStyleFor: d) colorRamp;
			borderStyle: (self worldMainDockingBarBorderStyleFor: d)]! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 2/29/2008 22:00'!
checkboxButtonSelectedDisabledBorderStyleFor: aCheckboxButton
	"Return the selected disabled checkbox button borderStyle for the given button."

	^self checkboxButtonDisabledBorderStyleFor: aCheckboxButton! !

!UITheme methodsFor: 'sounds' stamp: 'gvc 9/12/2007 14:45'!
alertSound
	"Answer the alert sound."

	^self soundTheme alertSound! !

!UITheme methodsFor: 'label-styles' stamp: 'AlainPlantec 12/17/2009 11:33'!
scrollbarArrowOfDirection: aSymbol size: finalSizeInteger color: aColor
	"Answer a new scrollbar arrow form (normally cached by Scrollbar)."
	
	^self basicCreateArrowOfDirection: aSymbol size: finalSizeInteger color: aColor! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 4/16/2007 11:08'!
newToolbarHandleIn: aThemedMorph
	"Answer a new toolbar handle."

	^PanelMorph new
		fillStyle: Color transparent; "non pane color tracking"
		borderStyle: (BorderStyle raised baseColor: Color blue; width: 1);
		extent: 4@3;
		vResizing: #spaceFill! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 5/23/2007 13:11'!
textFieldDisabledBorderStyleFor: aTextField
	"Return the disabled text field borderStyle for the given text field."

	^self textEditorDisabledBorderStyleFor: aTextField! !

!UITheme methodsFor: 'fill-styles-scrollbars' stamp: 'gvc 6/4/2007 15:42'!
scrollbarMouseOverBarThumbFillStyleFor: aScrollbar
	"Return the thumb fillStyle for the given scrollbar when
	the mouse is over the bar."

	^self scrollbarNormalThumbFillStyleFor: aScrollbar! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 1/17/2008 11:44'!
plainGroupPanelBorderStyleFor: aGroupPanel
	"Answer the normal border style for a plain group panel."

	^BorderStyle simple
		width: 0;
		baseColor: Color transparent! !

!UITheme methodsFor: '*Glamour-Morphic-Theme' stamp: 'AndreiChis 6/26/2014 15:12'!
backgroundColor

	^ Color white! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 3/6/2010 17:43'!
newColorPresenterIn: aThemedMorph for: aModel getColor: getSel help: helpText
	"Answer a color presenter."

	^(ColorPresenterMorph
			on: aModel color: getSel)
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		setBalloonText: helpText! !

!UITheme methodsFor: 'scrollbars' stamp: 'SvenVanCaekenberghe 1/12/2014 15:45'!
createArrowImagesCache
	"Creates the cache to store the arrow forms"

	^ LRUCache new
		maximumWeight: 40;
		factory: [ :key |
			self
				scrollbarArrowOfDirection: key first
				size: key second
				color: key third ];
		yourself! !

!UITheme methodsFor: 'services' stamp: 'gvc 5/1/2007 11:32'!
textEditorIn: aThemedMorph text: aStringOrText title: aString entryText: defaultEntryText
	"Answer the result of a text editor (multiline) dialog ( a string or nil if cancelled)
	with the given label and title."

	^self
		textEditorIn: aThemedMorph
		text: aStringOrText
		title: aString
		entryText: defaultEntryText
		entryHeight: 64! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 5/23/2007 13:06'!
textFieldNormalFillStyleFor: aTextField
	"Return the normal fillStyle for the given text field."
	
	^self textEditorNormalFillStyleFor: aTextField! !

!UITheme methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/15/2014 19:08'!
flatMenu
	^ self settings flatMenu! !

!UITheme methodsFor: 'services' stamp: 'gvc 7/30/2009 18:15'!
textEntryIn: aThemedMorph text: aStringOrText title: aString entryText: defaultEntryText
	"Answer the result of a text entry dialog ( a string or nil if cancelled)
	with the given label and title."

	self questionSound play.
	^(aThemedMorph openModal: (
		TextEntryDialogWindow new
			textFont: self textFont;
			title: aString;
			text: aStringOrText;
			entryText: defaultEntryText)) entryText! !

!UITheme methodsFor: 'basic-colors' stamp: 'gvc 1/16/2008 13:35'!
subgroupColorFrom: paneColor
	"Answer the colour for a subgroup given the pane colour."

	^paneColor whiter whiter! !

!UITheme methodsFor: 'border-styles-scrollbars' stamp: 'gvc 3/30/2007 10:27'!
scrollbarNormalButtonBorderStyleFor: aScrollbar
	"Return the normal button borderStyle for the given scrollbar."

	^self scrollbarNormalThumbBorderStyleFor: aScrollbar! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 12/4/2007 16:22'!
buttonFocusBoundsFor: aButton
	"Answer the bounds for drawing the focus indication for the
	given button."

	^(aButton bounds extent min < 6)
		ifTrue: [aButton bounds]
		ifFalse: [aButton bounds insetBy: aButton borderWidth + 
					(aButton label isMorph ifTrue: [1] ifFalse: [2])]! !

!UITheme methodsFor: 'fill-styles-buttons' stamp: 'gvc 11/13/2007 11:59'!
controlButtonPressedFillStyleFor: aButton
	"Return the pressed button fillStyle for the given button.
	Control buttons are generally used for drop-lists and expanders."
	
	^self buttonPressedFillStyleFor: aButton! !

!UITheme methodsFor: 'defaults' stamp: 'StephaneDucasse 9/7/2013 13:10'!
dropListInsetFor: aDropList
	"Answer the inset to use for drop-list layout."

	^Margin left: 1 top: 0 right: -1 bottom: 0! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 8/25/2006 15:55'!
newGroupboxIn: aThemedMorph
	"Answer a plain groupbox."

	^PlainGroupboxMorph new
		cornerStyle: aThemedMorph preferredCornerStyle;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		yourself! !

!UITheme methodsFor: 'fill-styles-scrollbars' stamp: 'gvc 3/30/2007 10:09'!
scrollbarMouseOverButtonFillStyleFor: aScrollbar
	"Return the scrollbar mouse over button fillStyle for the given color."

	^self scrollbarNormalButtonFillStyleFor: aScrollbar! !

!UITheme methodsFor: 'fill-styles-scrollbars' stamp: 'gvc 3/30/2007 10:28'!
scrollbarNormalButtonFillStyleFor: aScrollbar
	"Return the normal scrollbar button fillStyle for the given scrollbar."
	
	^self scrollbarNormalThumbFillStyleFor: aScrollbar! !

!UITheme methodsFor: 'initialize-release' stamp: 'gvc 5/14/2007 11:44'!
newTreeUnexpandedForm
	"Answer a new form for an unexpanded tree item."

	^(Form
		extent: 9@9
		depth: 32
		fromArray: #( 3749280121 4285822068 4285822068 4285822068 4285822068 4285822068 4285822068 4285822068 3816191606 4218778997 4293256677 4293322470 4292861919 4292401368 4291940817 4291546059 4290953922 4285822068 4218778997 4293059298 4293125091 4292203989 4278519045 4291348680 4291282887 4290624957 4285822068 4218778997 4292664540 4292664540 4291743438 4278190080 4290822336 4290822336 4290164406 4285822068 4218778997 4291809231 4278519045 4278519045 4278190080 4278519045 4278519045 4289769648 4285822068 4218778997 4291743438 4291743438 4290822336 4278190080 4289967027 4289901234 4289309097 4285822068 4218778997 4291348680 4291282887 4290361785 4278190080 4289506476 4289440683 4288848546 4285822068 4218778997 4290559164 4290493371 4290032820 4289638062 4289177511 4288716960 4288256409 4285822068 3665262455 4218713204 4218713204 4218713204 4218713204 4218713204 4218713204 4218713204 3749016949)
		offset: 0@0)
			asFormOfDepth: Display depth;
			replaceColor: Color white withColor: Color transparent;
			yourself! !

!UITheme methodsFor: 'fill-styles-scrollbars' stamp: 'gvc 2/22/2008 21:17'!
useScrollbarThumbShadow
	"Answer whether a shadow morph should be displayed when
	dragging a scrollbar thumb."

	^true! !

!UITheme methodsFor: 'defaults' stamp: 'AlainPlantec 12/21/2009 11:31'!
defaultMenuTitleColor
	"Answer the default color to use for a menu title
	in the absence of an override in settings."

	^self settings menuTitleColor! !

!UITheme methodsFor: 'label-styles' stamp: 'tbn 7/29/2010 21:27'!
createCollapseBoxFor: aSystemWindow
	"Answer a button for minimising the window."
	
	^aSystemWindow createBox
		labelGraphic: self windowMinimizeForm;
		extent: aSystemWindow boxExtent;
		actionSelector: #collapseBoxHit;
		setBalloonText: 'Collapse this window' translated! !

!UITheme methodsFor: 'initialize-release' stamp: 'gvc 5/24/2007 10:11'!
newWindowCloseForm
	"Answer a new form for a window close box."

	^Form
		extent: 10@10
		depth: 32
		fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 3326099520 3330310272 0 0 0 0 0 0 0 0 4144038145 3326099520 3330310272 0 0 0 4144038145 3326099520 0 0 0 4227924225 3326099520 3330310272 0 4144038145 3326099520 3330310272 0 0 0 0 4144038145 3326099520 4144038145 3326099520 3330310272 3336494814 0 0 0 0 0 4227924225 3326099520 3330310272 3336494814 0 0 0 0 0 4144038145 3326099520 4144038145 3326099520 3330310272 3336494814 0 0 0 4144038145 3326099520 3330310272 3336494814 4144038145 3326099520 3330310272 0 0 4144038145 3326099520 3330310272 3336494814 0 0 4144038145 3326099520 0 0 0 3330310272 3336494814 0 0 0 0 0 0)
		offset: 0@0! !

!UITheme methodsFor: 'services' stamp: 'GaryChambers 12/2/2011 12:01'!
chooseFileIn: aThemedMorph title: title extensions: exts path: path preview: preview
	"Answer the result of a file open dialog with the given title, extensions path and preview type.
	Answer nil or a filename."

	|fd|
	fd := FileDialogWindow basicNew
		basicTheme: aThemedMorph theme;
		previewType: preview;
		initialize;
		title: title;
		answerFileEntry.
	exts ifNotNil: [fd validExtensions: exts].
	path ifNotNil: [fd selectPathName: path].
	^(aThemedMorph openModal: fd) answer! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 11/13/2007 11:58'!
controlButtonPressedBorderStyleFor: aButton
	"Return the pressed control button borderStyle for the given button.
	Control buttons are generally used for drop-lists and expanders."

	^self buttonPressedBorderStyleFor: aButton! !

!UITheme methodsFor: 'morph creation' stamp: 'GaryChambers 11/16/2011 17:15'!
newTaskbarButtonIn: aTaskbar for: aWindow
	"Answer a taskbar button morph for the given window."

	|lm lab button labSize|
	labSize := (150 // (aTaskbar tasks size + 1) max: 10) min: 30.
	lab := (self buttonLabelForText: (aWindow taskbarLabel truncateWithElipsisTo: labSize)).
	aWindow isActive
		ifTrue: [ lab emphasis: 1 "1 -> bold" ].
	lm := self
		newRowIn: aTaskbar
		for: {(aWindow taskbarIcon ifNil: [^nil]) asMorph. lab}.
	lm cellInset: 2.
	button := self
		newButtonIn: aTaskbar
		for: aWindow
		getState: #isActive
		action: #taskbarButtonClicked
		arguments: #()
		getEnabled: nil
		label: lm
		help: nil.
	button
		useSquareCorners;
		wantsYellowButtonMenu: true;
		getMenuSelector: #taskbarButtonMenu:;
		on: #mouseEnter send: #taskbarButtonEntered:event:in: to: aWindow withValue: button;
		on: #mouseLeave send: #taskbarButtonLeft:event:in: to: aWindow withValue: button.
	aWindow isCollapsed
		ifTrue:  [ lab color: (self taskbarButtonLabelColorForCollapsed: button) ]
		ifFalse: [ lab color: (self taskbarButtonLabelColorForExpanded: button). ].
	^button! !

!UITheme methodsFor: '*growl' stamp: 'BenjaminVanRyseghem 3/2/2012 00:04'!
growlLabelColorFor: aGrowlMorph
	^ Color black lighter! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 4/25/2007 17:17'!
progressBarBorderStyleFor: aProgressBar
	"Return the progress bar borderStyle for the given progress bar."

	|c|
	c := self progressBarColorFor: aProgressBar.
	^BorderStyle simple
		width: 1;
		baseColor: c darker! !

!UITheme methodsFor: 'border-styles-scrollbars' stamp: 'gvc 4/25/2007 17:15'!
scrollbarNormalThumbBorderStyleFor: aScrollbar
	"Return the normal thumb borderStyle for the given scrollbar."

	|aColor|
	aColor := self scrollbarColorFor: aScrollbar.
	^BorderStyle simple
		width: 1;
		baseColor: aColor twiceDarker! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 3/14/2007 13:06'!
taskbarFillStyleFor: aTaskbar
	"Return the taskbar fillStyle for the given taskbar."
	
	|aColor|
	aColor := aTaskbar color.
	^(GradientFillStyle ramp: {
			0.0->(aColor alphaMixed: 0.3 with: (Color white alpha: aColor alpha)).
			0.2-> aColor twiceLighter.
			0.8->aColor darker.
			1.0->aColor darker duller})	
		origin: aTaskbar position;
		direction: 0@27;
		radial: false! !

!UITheme methodsFor: 'accessing' stamp: 'gvc 5/14/2007 11:39'!
forms: anObject
	"Set the value of forms"

	forms := anObject! !

!UITheme methodsFor: 'defaults' stamp: 'EstebanLorenzano 5/15/2014 19:05'!
setSystemProgressMorphDefaultParameters: aProgressMorph
	"Set up the given progress morph."
	aProgressMorph color: self settings derivedMenuColor.
	self settings preferRoundCorner
		ifTrue: [aProgressMorph useRoundedCorners].
	aProgressMorph borderWidth: self menuBorderWidth.
	aProgressMorph borderColor: self menuBorderColor.
	aProgressMorph updateColor.! !

!UITheme methodsFor: 'fill-styles-buttons' stamp: 'gvc 2/29/2008 21:50'!
radioButtonSelectedFillStyleFor: aRadioButton
	"Return the selected radio button fillStyle for the given button."
	
	^self checkboxButtonSelectedFillStyleFor: aRadioButton! !

!UITheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 5/1/2014 11:38'!
textColorForNonStandardBackground
	^ self textColor! !

!UITheme methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/15/2014 19:08'!
autoMenuColor
	^ self settings autoMenuColor! !

!UITheme methodsFor: 'fill-styles-buttons' stamp: 'gvc 4/25/2007 18:53'!
buttonSelectedMouseOverFillStyleFor: aButton
	"Return the button selected mouse over fillStyle for the given color."
	
	^self buttonSelectedFillStyleFor: aButton! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 6/1/2009 15:18'!
listFocusBoundsFor: aListMorph
	"Answer the bounds for drawing the focus indication."

	^aListMorph bounds! !

!UITheme methodsFor: 'label-styles' stamp: 'GaryChambers 8/10/2010 16:35'!
createCloseBoxFor: aSystemWindow
	"Answer a button for closing the window."
	
	^(self
		newCloseControlIn: aSystemWindow
		for: aSystemWindow
		action: [aSystemWindow closeBoxHit]
		help: 'Close this window' translated)
		extent: aSystemWindow boxExtent! !

!UITheme methodsFor: 'services' stamp: 'GaryChambers 12/6/2011 10:06'!
textEntryIn: aThemedMorph text: aStringOrText title: aString entryText: defaultEntryText entryCompletion: anEntryCompletion
	"Answer the result of a text entry dialog ( a string or nil if cancelled)
	with the given label and title."

	self questionSound play.
	^(aThemedMorph openModal: (
		(TextEntryDialogWindow newWithTheme: aThemedMorph theme)
			textFont: self textFont;
			title: aString;
			text: aStringOrText;
			entryText: defaultEntryText;
			entryCompletion: anEntryCompletion)) entryText! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 4/25/2007 17:29'!
buttonSelectedDisabledBorderStyleFor: aButton
	"Return the selecteddisabled button borderStyle for the given button."

	^self buttonSelectedBorderStyleFor: aButton! !

!UITheme methodsFor: 'label-styles' stamp: 'gvc 5/14/2007 11:49'!
treeUnexpandedForm
	"Answer the form to use for an unexpanded tree item."

	^self forms at: #treeUnexpanded ifAbsent: [Form extent: 10@9 depth: Display depth]! !

!UITheme methodsFor: 'scrollbars' stamp: 'AlainPlantec 12/17/2009 13:12'!
verticesForSimpleArrow: aRectangle 
	"PRIVATE - answer a collection of vertices to draw a simple arrow"
	| vertices |
	vertices := OrderedCollection new.
	""
	vertices add: aRectangle bottomLeft.
	vertices add: aRectangle center x @ (aRectangle top + (aRectangle width / 8)).
	vertices add: aRectangle bottomRight.
	vertices add: aRectangle bottomRight + (0@0.01).
	""
	^ vertices! !

!UITheme methodsFor: 'scrollbars' stamp: 'AlainPlantec 12/17/2009 13:11'!
verticesForComplexArrow: aRectangle 
	"PRIVATE - answer a collection of vertices to draw a complex arrow"

	|r vertices aux b c|
	r := aRectangle origin extent: aRectangle width asPoint.
	aux := (r width / 5) rounded.
	b := (aux * aux * 2) sqrt.
	c := (b * b * 2) sqrt rounded.
	vertices := OrderedCollection new.
	vertices add: r bottomLeft - (0 @ aux).
	vertices add: r topCenter + (0 @ aux).
	vertices add: r bottomRight - (0 @ aux).
	vertices add: r bottomRight - (aux @ 0).
	vertices add: r topCenter + (0 @ (aux + c)).
	vertices add: r bottomLeft + (aux @ 0).
	^vertices! !

!UITheme methodsFor: 'label-styles' stamp: 'gvc 6/15/2009 13:00'!
buttonLabelForText: aTextOrString
	"Answer the label to use for the given text."

	^aTextOrString isString
		ifTrue: [(LabelMorph contents: aTextOrString)
					disabledStyle: self disabledItemStyle]
		ifFalse: [|t|
				t := TextMorph new newContents: aTextOrString.
				t
					extent: t optimalExtent;
					margins: (0@0 corner: 0@1);
					lock]! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 2/2/2009 15:11'!
newCloseButtonIn: aThemedMorph for: aModel
	"Answer a new close button."

	^self
		newButtonIn: aThemedMorph
		for: aModel
		getState: nil
		action: #close
		arguments: nil
		getEnabled: nil
		label: 'Close' translated
		help: 'Close the window' translated! !

!UITheme methodsFor: 'defaults' stamp: 'gvc 3/1/2010 15:43'!
menuItemNormalTextColorFor: aMenuItem
	"Answer the color to use for normal menu item text."

	^((aMenuItem color luminance - aMenuItem owner paneColor luminance) abs < 0.3)
		ifTrue: [aMenuItem owner paneColor contrastingColor]
		ifFalse: [aMenuItem color]! !

!UITheme methodsFor: 'fill-styles-buttons' stamp: 'gvc 5/23/2007 12:17'!
checkboxButtonDisabledFillStyleFor: aCheckboxButton
	"Return the disabled checkbox button fillStyle for the given button."
	
	^aCheckboxButton paneColor
		alphaMixed: 0.3
		with: Color white! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 4/24/2007 11:44'!
progressBarFillStyleFor: aProgressBar
	"Return the progress bar fillStyle for the given progress bar."
	
	|aColor area|
	aColor := self progressBarColorFor: aProgressBar.
	area :=  aProgressBar bounds.
	^(GradientFillStyle ramp: {
			0.0->aColor darker duller. 0.2-> aColor darker.
			0.8->aColor twiceLighter. 1.0->aColor})	
		origin: area origin;
		direction: 0@area height;
		radial: false! !

!UITheme methodsFor: 'morph creation' stamp: 'GaryChambers 8/10/2010 16:33'!
newCloseControlIn: aThemedMorph for: aModel action: aValuable help: helpText
	"Answer a button for closing things."
	
	|form msb|
	form := self windowCloseForm.
	msb := MultistateButtonMorph new extent: form extent.
	msb
		activeEnabledNotOverUpFillStyle: (ImageFillStyle form: form);
		addUpAction: aValuable;
		setBalloonText: helpText.
	^msb! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 5/22/2007 11:16'!
windowActiveLabelFillStyleFor: aWindow
	"Return the window active label fillStyle for the given window."
	
	^Color black! !

!UITheme methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/15/2014 19:03'!
menuBorderWidth 
	^  self settings menuBorderWidth! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 1/7/2008 11:14'!
tabLabelSelectedFillStyleFor: aTabLabel
	"Return the selected fillStyle for the given tab label."
	
	^aTabLabel paneColor! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 8/9/2007 16:19'!
newGroupboxIn: aThemedMorph forAll: controls
	"Answer a plain groupbox."

	^self
		newGroupboxIn: aThemedMorph
		for: (self newColumnIn: aThemedMorph for: controls)! !

!UITheme methodsFor: 'services' stamp: 'GaryChambers 12/6/2011 10:04'!
chooseIn: aThemedMorph title: title message: aMessage labels: labels values: values lines: lines
	"Answer the result of a popup choice with the given title, labels, values and lines."

	|pd|
	pd := (PopupChoiceDialogWindowWithMessage newWithTheme: aThemedMorph theme)
		title: (title isEmpty ifTrue: ['Choose' translated] ifFalse: [title asString]);
		textFont: self textFont;
		message: aMessage;
		labels: labels;
		lines: (lines ifNil: [#()]);
		model: values.
	^(aThemedMorph openModal: pd) choice! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 8/7/2007 12:39'!
listDisabledFillStyleFor: aList
	"Return the disabled fillStyle for the given list."
	
	^aList paneColor alphaMixed: 0.3 with: Color white! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 8/7/2007 11:38'!
sliderDisabledFillStyleFor: aSlider
	"Return the disabled fillStyle for the given slider."
	
	^aSlider paneColor alphaMixed: 0.3 with: Color white! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 11/13/2007 11:33'!
controlButtonSelectedDisabledBorderStyleFor: aButton
	"Return the selected disabled control button borderStyle for the given button.
	Control buttons are generally used for drop-lists and expanders."

	^self buttonSelectedDisabledBorderStyleFor: aButton! !

!UITheme methodsFor: 'fill-styles-buttons' stamp: 'gvc 4/26/2007 09:58'!
buttonDisabledFillStyleFor: aButton
	"Return the disabled button fillStyle for the given color."

	^self buttonNormalFillStyleFor: aButton! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 4/25/2007 18:01'!
windowActiveFillStyleFor: aWindow
	"Return the window active fillStyle for the given window."
	
	^aWindow paneColorToUse! !

!UITheme methodsFor: 'label-styles' stamp: 'MarcusDenker 12/11/2009 07:43'!
configureWindowLabelAreaFor: aWindow
	"Configure the label area for the given window."

	aWindow labelArea
		addMorphBack: (Morph new extent: aWindow class borderWidth @ 0).
	aWindow hasCloseBox ifTrue: [aWindow addCloseBox].
	aWindow hasMenuBox ifTrue: [aWindow addMenuControl].
	aWindow labelArea
		addMorphBack: (Morph new extent: aWindow class borderWidth @ 0).
	aWindow basicLabel ifNotNil: [:label |
		label hResizing: #spaceFill.
		aWindow labelArea addMorphBack: label].
	aWindow hasExpandBox ifTrue: [aWindow addExpandBox].
	aWindow hasCollapseBox ifTrue: [aWindow addCollapseBox].
	aWindow labelArea
		addMorphBack: (Morph new extent: aWindow class borderWidth @ 0)! !

!UITheme methodsFor: 'initialize-release' stamp: 'gvc 5/24/2007 10:12'!
newWindowMenuForm
	"Answer a new form for a window menu box."

	^Form
		extent: 10@10
		depth: 32
		fromArray: #( 4227858432 4127195136 4127195136 4127195136 4127195136 4127195136 4127195136 4127195136 4227858432 0 4127195136 3212869760 3212869760 3212869760 3212869760 3212869760 3212869760 3212869760 4127195136 3212869760 4127195136 3212869760 0 0 0 0 0 0 4127195136 3212869760 4127195136 4127195136 4127195136 4127195136 4127195136 4127195136 4127195136 4127195136 4127195136 3212869760 4127195136 3212869760 0 0 0 0 0 0 4127195136 3212869760 4127195136 3212869760 0 0 0 0 0 0 4127195136 3212869760 4227858432 4127195136 4127195136 4127195136 4127195136 4127195136 4127195136 4127195136 4127195136 3212869760 4127195136 3212869760 0 0 0 0 0 0 4127195136 3212869760 4227858432 4127195136 4127195136 4127195136 4127195136 4127195136 4127195136 4127195136 4227858432 3212869760 0 3212869760 3212869760 3212869760 3212869760 3212869760 3212869760 3212869760 3212869760 3212869760)
		offset: 0@0! !

!UITheme methodsFor: 'border-styles-scrollbars' stamp: 'gvc 4/25/2007 17:11'!
scrollbarPressedThumbBorderStyleFor: aScrollbar
	"Return the pressed thumb borderStyle for the given scrollbar."

	^self scrollbarNormalThumbBorderStyleFor: aScrollbar! !

!UITheme methodsFor: 'accessing colors' stamp: 'gvc 10/12/2006 14:53'!
windowColor
	"Answer the window color to use."

	^self settings windowColor! !

!UITheme methodsFor: 'morph creation' stamp: 'GaryChambers 10/5/2010 13:40'!
newMultistateButtonIn: aThemedMorph
	"Answer a new multistate button morph."

	^MultistateButtonMorph new! !

!UITheme methodsFor: 'defaults' stamp: 'BenjaminVanRyseghem 6/12/2013 13:59'!
windowTopOffset

	^ 0! !

!UITheme methodsFor: 'basic-colors' stamp: 'NickAlexander 2/6/2011 12:28'!
taskbarButtonLabelColorForCollapsed: aButton
	"Answer the colour for the label of the given taskbar button, given that the corresponding window is collapsed."

	^Color darkGray! !

!UITheme methodsFor: 'defaults' stamp: 'gvc 12/5/2008 14:55'!
expanderTitleInsetFor: anExpanderTitle
	"Answer the inset to use for expander title layout."

	^anExpanderTitle borderWidth negated! !

!UITheme methodsFor: 'defaults' stamp: 'gvc 1/9/2009 17:45'!
buttonFocusIndicatorCornerRadiusFor: aButton
	"Answer the default corner radius preferred for the focus indicator
	for the button for themes that support this."

	^self focusIndicatorCornerRadiusFor: aButton! !

!UITheme methodsFor: 'label-styles' stamp: 'EstebanLorenzano 5/10/2013 11:27'!
menuPinForm
	"Answer the form to use for the pin button of a menu."

	^ self icons smallPushpinIcon! !

!UITheme methodsFor: 'fill-styles' stamp: 'AlainPlantec 2/11/2011 22:29'!
morphTreeSplitterNormalFillStyleFor: aSplitter
	"Return the normal splitter fillStyle for the given splitter."
	
	|aColor|
	aColor := aSplitter paneColor.
	^(GradientFillStyle ramp: {
		0.0->aColor whiter whiter. 0.2->aColor lighter.
		0.8->aColor darker. 1.0->aColor blacker})
		origin: aSplitter topLeft;
		direction: (aSplitter splitsTopAndBottom
			ifTrue: [0 @ aSplitter height]
			ifFalse: [aSplitter width @ 0]);
		radial: false! !

!UITheme methodsFor: 'defaults' stamp: 'BenjaminVanRyseghem 6/12/2013 13:59'!
windowRightOffset

	^ 0! !

!UITheme methodsFor: 'icons-utilities' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
icons
	^ Smalltalk ui icons! !

!UITheme methodsFor: 'fill-styles-scrollbars' stamp: 'gvc 6/4/2007 15:51'!
scrollbarMouseOverThumbButtonFillStyleFor: aScrollbar
	"Return the button fillStyle for the given scrollbar when
	the mouse is over the thumb."

	^self scrollbarMouseOverBarButtonFillStyleFor: aScrollbar! !

!UITheme methodsFor: 'fill-styles-buttons' stamp: 'GaryChambers 11/16/2011 15:29'!
fadeCheckboxWhenDisabled
	"Answer whether a checkbox should fade its appearance when disabled.
	If false, assumed that is covered by the relevant disabled fill styles."

	^true! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 1/20/2009 11:09'!
focusIndicatorMorphFor: aMorph
	"Answer a (cached) focus indicator for the given morph."

	(self focusIndicator isNil or: [
			self focusIndicator isMorph
				ifTrue: [self focusIndicator ~~ aMorph]
				ifFalse: [self focusIndicator key ~~ aMorph]])
		ifTrue: [self focusIndicator: aMorph ->(self newFocusIndicatorMorphFor: aMorph)].
	^self focusIndicator value 
		privateBounds: aMorph focusBounds! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 3/23/2007 17:19'!
buttonSelectedPressedBorderStyleFor: aButton
	"Return the selected pressed button borderStyle for the given button."

	^self buttonNormalBorderStyleFor: aButton! !

!UITheme methodsFor: '*Morphic-Widgets-Taskbar' stamp: 'SeanDeNigris 1/23/2014 12:00'!
openTaskListIn: world from: aKeyboardEvent

	| tasklistMorph |
	tasklistMorph := TaskListMorph from: aKeyboardEvent.
	tasklistMorph openAsIsIn: world.! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 3/23/2007 17:16'!
buttonMouseOverBorderStyleFor: aButton
	"Return the mouse over button borderStyle for the given button."
	
	^self buttonNormalBorderStyleFor: aButton! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 4/26/2007 10:12'!
splitterNormalFillStyleFor: aSplitter
	"Return the normal splitter fillStyle for the given splitter."
	
	|aColor|
	aColor := aSplitter paneColor.
	^(GradientFillStyle ramp: {
		0.0->aColor whiter whiter. 0.2->aColor lighter.
		0.8->aColor darker. 1.0->aColor blacker})
		origin: aSplitter topLeft;
		direction: (aSplitter splitsTopAndBottom
			ifTrue: [0 @ aSplitter height]
			ifFalse: [aSplitter width @ 0]);
		radial: false! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 1/12/2009 18:23'!
multiFormTopFillStyleFrom: anArray in: aRectangle
	"Answer a composite fill style from the given forms and central colour
	in the given bounds. Only top and middle sections are considered."
	
	|tl tm tr ml mr c|
	tl := anArray first.
	tm := anArray second.
	tr := anArray third.
	ml  := anArray fourth.
	c := anArray fifth.
	mr  := anArray sixth.
	^CompositeFillStyle fillStyles: {
		(ImageFillStyle form: tl) origin: aRectangle topLeft.
		(AlphaInfiniteForm with: tm)
			origin: aRectangle topLeft + (tl width@0);
			extent: (aRectangle width - tl width - tr width)@tm height.
		(ImageFillStyle form: tr)
			origin: aRectangle topRight - (tr width@0).
		(AlphaInfiniteForm with: ml)
			origin: aRectangle topLeft + (0@tr height);
			extent: ml width@(aRectangle height - tl height).
		(ColorFillStyle color: c)
			origin: aRectangle topLeft + tl extent;
			extent: aRectangle extent - tl extent - (mr width @0).
		(AlphaInfiniteForm with: mr)
			origin: aRectangle topRight + (tr width negated@tr height);
			extent: mr width@(aRectangle height - tr height)}! !

!UITheme methodsFor: 'label-styles' stamp: 'gvc 10/25/2007 17:06'!
checkboxMarkerForm
	"Answer the form to use for a checkbox marker."

	^self forms at: #checkboxMarker ifAbsent: [Form extent: 12@12 depth: Display depth]! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 10/1/2007 14:22'!
windowEdgeNormalFillStyleFor: anEdgeGrip
	"Return the normal window edge fillStyle for the given edge grip."
	
	^Color transparent! !

!UITheme methodsFor: 'configure' stamp: 'EstebanLorenzano 4/29/2014 18:16'!
configurePluggableButtonMorph: aMorph
	"This will not work because it is using the #normalFillStyle hack :(
	 So, go check the #buttonNormalFillStyleFor: method, which is the one that 
	 actually does something (he and his siblings)"! !

!UITheme methodsFor: 'initialize-release' stamp: 'gvc 10/25/2007 17:27'!
newRadioButtonMarkerForm
	"Answer a new radio button marker form."

	^(Form
	extent: 12@12
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1207959552 2533359616 2533359616 1207959552 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2399141888 4278190080 4278190080 4278190080 4009754624 2399141888 16777215 16777215 16777215 16777215 16777215 1207959552 4278190080 4278190080 4278190080 4278190080 4278190080 4143972352 1207959552 16777215 16777215 16777215 16777215 2533359616 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 2533359616 16777215 16777215 16777215 16777215 2533359616 4278190080 4278190080 4278190080 4278190080 4278190080 4278190080 2399141888 16777215 16777215 16777215 16777215 1207959552 4278190080 4278190080 4278190080 4278190080 4143972352 4278190080 1073741824 16777215 16777215 16777215 16777215 16777215 2399141888 4278190080 4278190080 4278190080 4278190080 2399141888 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1207959552 2533359616 2533359616 1207959552 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: 0@0)! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 5/23/2007 13:10'!
textEditorDisabledBorderStyleFor: aTextEditor
	"Return the disabled text editor borderStyle for the given text editor."

	^self textEditorNormalBorderStyleFor: aTextEditor! !

!UITheme methodsFor: 'border-styles-scrollbars' stamp: 'gvc 10/24/2007 15:04'!
scrollbarPagingAreaCornerStyleIn: aThemedMorph
	"Allow for themes to override default behaviour."
	
	^#square! !

!UITheme methodsFor: 'fill-styles-buttons' stamp: 'gvc 2/29/2008 21:50'!
radioButtonSelectedDisabledFillStyleFor: aRadioButton
	"Return the selected disabled radio button fillStyle for the given button."
	
	^self checkboxButtonSelectedDisabledFillStyleFor: aRadioButton! !

!UITheme methodsFor: 'accessing' stamp: 'gvc 9/12/2007 14:40'!
focusIndicator
	"Answer the value of focusIndicator"

	^ focusIndicator! !

!UITheme methodsFor: 'services' stamp: 'GaryChambers 12/6/2011 10:00'!
chooseColorIn: aThemedMorph title: aString color: aColor
	"Answer the result of a color selector dialog with the given title and initial color."

	|d|
	d := aThemedMorph openModal: (
		(ColorSelectorDialogWindow newWithTheme: aThemedMorph theme)
			title: aString;
			selectedColor: aColor).
	^d  cancelled
		ifFalse: [d selectedColor]! !

!UITheme methodsFor: 'basic-colors' stamp: 'AlainPlantec 12/16/2009 14:41'!
taskbarButtonColorFor: aButton
	"Answer the colour for the given taskbar button." 
	^ self windowColorFor: aButton model! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 12/8/2008 19:17'!
radioButtonCornerStyleFor: aRadioButton
	"Answer the corner style for radio buttons."
	
	^#rounded! !

!UITheme methodsFor: 'label-styles' stamp: 'gvc 6/15/2009 12:58'!
checkboxLabelForText: aTextOrString
	"Answer the label to use for the given text."

	|morph|
	morph := aTextOrString isString
		ifTrue: [(LabelMorph contents: aTextOrString)
				disabledStyle: self disabledItemStyle]
		ifFalse: [|t|
				t := TextMorph new newContents: aTextOrString.
				t extent: t optimalExtent].
	^morph 
		vResizing: #shrinkWrap;
		hResizing: #spaceFill;
		lock! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 6/4/2007 13:03'!
menuItemSelectedBorderStyleFor: aMenuItem
	"Return the selected menu item borderStyle for the given menu item."

	^BorderStyle simple
		width: 0! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 10/1/2007 14:21'!
windowEdgePressedFillStyleFor: anEdgeGrip
	"Return the pressed window edge fillStyle for the given edge grip."
	
	^self windowEdgeNormalFillStyleFor: anEdgeGrip! !

!UITheme methodsFor: 'label-styles' stamp: 'gvc 2/10/2009 12:55'!
menuCloseForm
	"Answer the form to use for the close button of a menu."

	^self windowCloseForm! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 8/7/2007 12:42'!
dropListNormalBorderStyleFor: aDropList
	"Return the normal borderStyle for the given drop list"

	^BorderStyle inset
		width: 1;
		baseColor: aDropList paneColor! !

!UITheme methodsFor: 'fill-styles' stamp: 'gvc 6/2/2009 16:04'!
windowExtentChangedFor: aWindow
	"Update any extent related visuals."
! !

!UITheme methodsFor: 'fill-styles' stamp: 'tbn 6/22/2012 13:15'!
desktopImageFor: aWorld
	"Answer the desktop image for the given world.
	Look for an image file with the name of the theme.
	Answer nil for none available."

	|file|
	file := FileSystem disk workingDirectory / self class themeName , 'jpg'.
	^ file exists ifTrue: [
		ImageReadWriter formFromFileNamed: file fullName]! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 2/29/2008 22:08'!
radioButtonSelectedBorderStyleFor: aRadioButton
	"Return the selected radio button borderStyle for the given button."

	^self radioButtonNormalBorderStyleFor: aRadioButton! !

!UITheme methodsFor: 'scrollbars' stamp: 'SvenVanCaekenberghe 1/12/2014 15:45'!
createBoxImagesCache
	"Creates the cache to store the arrow forms"
	
	^ LRUCache new
		maximumWeight: 20;
		factory: [ :key |
			self createBoxOfSize: key first color: key second ];
		yourself! !

!UITheme methodsFor: 'defaults' stamp: 'gvc 12/1/2008 11:40'!
statusFont
	"Answer the status font to use."

	^((TextStyle named: #BitstreamVeraSansMono) ifNil: [TextStyle default])
		fontOfPointSize: 8! !

!UITheme methodsFor: 'fill-styles' stamp: 'AlainPlantec 12/21/2009 11:20'!
menuTitleColorFor: aThemedMorph
	"Answer the menu titlecolor to use."

	|w|
	^self menuTitleColor ifNil: [
		aThemedMorph ifNil: [^self defaultMenuTitleColor].
		w := aThemedMorph isSystemWindow
			ifTrue: [aThemedMorph]
			ifFalse: [aThemedMorph ownerThatIsA: SystemWindow].
		w isNil
			ifTrue: [self defaultMenuTitleColor]
			ifFalse: [(w valueOfProperty: #paneColor) darker ifNil: [self defaultMenuTitleColor]]]! !

!UITheme methodsFor: 'basic-colors' stamp: 'gvc 5/9/2007 15:17'!
taskbarButtonLabelColorFor: aButton
	"Answer the colour for the label of the given taskbar button."

	^Color black! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 4/25/2007 17:27'!
buttonSelectedBorderStyleFor: aButton
	"Return the selected button borderStyle for the given button."

	^self buttonNormalBorderStyleFor: aButton! !

!UITheme methodsFor: 'initialize-release' stamp: 'gvc 5/14/2007 11:44'!
newTreeExpandedForm
	"Answer a new form for an expanded tree item."

	^(Form
		extent: 9@9
		depth: 32
		fromArray: #( 3749280121 4285822068 4285822068 4285822068 4285822068 4285822068 4285822068 4285822068 3816191606 4218778997 4293256677 4293322470 4292861919 4292401368 4291940817 4291546059 4290953922 4285822068 4218778997 4293059298 4293125091 4292664540 4292203989 4291743438 4291282887 4290624957 4285822068 4218778997 4292664540 4292664540 4292203989 4291743438 4291282887 4290822336 4290164406 4285822068 4218778997 4291809231 4278519045 4278519045 4278519045 4278519045 4278519045 4289769648 4285822068 4218778997 4291743438 4291743438 4291282887 4290822336 4290361785 4289901234 4289309097 4285822068 4218778997 4291348680 4291282887 4290822336 4290361785 4289901234 4289440683 4288848546 4285822068 4218778997 4290559164 4290493371 4290032820 4289638062 4289177511 4288716960 4288256409 4285822068 3665262455 4218713204 4218713204 4218713204 4218713204 4218713204 4218713204 4218713204 3749016949)
		offset: 0@0)
			asFormOfDepth: Display depth;
			replaceColor: Color white withColor: Color transparent;
			yourself! !

!UITheme methodsFor: 'label-styles' stamp: 'AlainPlantec 2/11/2011 16:26'!
whiteTreeExpandedForm
	"Answer the form to use for an expanded tree item when a contrasting one is needed."

	^self forms 
		at: #whiteTreeExpanded 
		ifAbsent: [ | f |
			f := self treeExpandedForm deepCopy.
			f replaceColor: Color white withColor: Color transparent.
			(f colorsUsed reject: [:c | c isTransparent]) do: [:c | f replaceColor:  c withColor: c whiter whiter whiter whiter whiter whiter].
			self forms at: #whiteTreeExpanded put: f.
			self whiteTreeExpandedForm]! !

!UITheme methodsFor: 'configure' stamp: 'EstebanLorenzano 4/29/2014 12:51'!
configurePluggableListMorph: listMorph 
	self configureScrollPane: listMorph.! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 6/20/2007 09:37'!
newToolDockingBarIn: aThemedMorph
	"Answer a new tool docking bar."

	^ToolDockingBarMorph new
		borderWidth: 0;
		hResizing: #spaceFill;
		vResizing: #shrinkWrap;
		clipSubmorphs: true! !

!UITheme methodsFor: 'fill-styles-buttons' stamp: 'gvc 4/25/2007 18:53'!
buttonSelectedDisabledFillStyleFor: aButton
	"Return the button selected disabled fillStyle for the given color."
	
	^self buttonSelectedFillStyleFor: aButton! !

!UITheme methodsFor: 'fill-styles' stamp: 'HilaireFernandes 8/3/2010 10:20'!
progressFillStyleFor: aProgress
	"Return the progress fillStyle for the given progress morph."
	| fill |
	fill := GradientFillStyle ramp: {0.0 -> Color white. 1 ->aProgress color}.
	fill radial: false;
		origin: aProgress topLeft;
		direction: 0 @ aProgress height.
	^ fill! !

!UITheme methodsFor: 'fill-styles-scrollbars' stamp: 'gvc 3/30/2007 10:08'!
scrollbarMouseOverFillStyleFor: aScrollbar
	"Return the scrollbar mouse over fillStyle for the given color."

	^self scrollbarNormalFillStyleFor: aScrollbar! !

!UITheme methodsFor: 'label-styles' stamp: 'gvc 5/14/2007 11:49'!
treeExpandedForm
	"Answer the form to use for an expanded tree item."

	^self forms at: #treeExpanded ifAbsent: [Form extent: 10@9 depth: Display depth]! !

!UITheme methodsFor: 'border-styles-buttons' stamp: 'gvc 4/25/2007 17:25'!
buttonNormalBorderStyleFor: aButton
	"Return the normal button borderStyle for the given button."

	|c|
	c := aButton colorToUse.
	aButton isDefault
		ifTrue: [c := c alphaMixed: 0.5 with: Color black].
	^BorderStyle simple
		width: 1;
		baseColor: c! !

!UITheme methodsFor: 'basic-colors' stamp: 'EstebanLorenzano 4/29/2014 17:38'!
buttonColorFor: aButton
	"Answer the colour for the given button."

	^self settings standardColorsOnly
		ifTrue: [self buttonColor]
		ifFalse: [ aButton colorToUse ]! !

!UITheme methodsFor: 'scrollbars' stamp: 'MarcusDenker 7/9/2014 21:39'!
updateScrollBarButtonAspect: aMorph color: aColor 
	"update aMorph with aColor"
	aMorph isNil ifTrue: [^ self].
	aMorph color: aColor.
! !

!UITheme methodsFor: 'fill-styles-buttons' stamp: 'gvc 2/29/2008 21:48'!
checkboxButtonSelectedFillStyleFor: aCheckboxButton
	"Return the selected checkbox button fillStyle for the given button."
	
	^self checkboxButtonNormalFillStyleFor: aCheckboxButton! !

!UITheme methodsFor: 'border-styles-scrollbars' stamp: 'gvc 3/30/2007 10:16'!
scrollbarMouseOverBorderStyleFor: aScrollbar
	"Return the mouse over borderStyle for the given scrollbar."

	^self scrollbarNormalBorderStyleFor: aScrollbar! !

!UITheme methodsFor: 'accessing colors' stamp: 'EstebanLorenzano 4/29/2014 13:15'!
textColor 
	^ Color black! !

!UITheme methodsFor: 'border-styles' stamp: 'TudorGirba 3/11/2015 08:36'!
morphTreeColumnBorderStyleFor: aMorph
	^ self buttonNormalBorderStyleFor: aMorph! !

!UITheme methodsFor: 'services' stamp: 'GaryChambers 12/6/2011 10:04'!
chooseOrRequestIn: aThemedMorph title: title labels: labels values: values lines: lines
	"Answer the result of a popup choice with the given title, labels, values and lines."

	| dialog choice |
	dialog := (PopupChoiceOrRequestDialogWindow newWithTheme: aThemedMorph theme)
		title: (title isEmpty ifTrue: ['Choose' translated] ifFalse: [title asString]);
		labels: labels;
		lines: (lines ifNil: [#()]);
		model: values.
	choice := (aThemedMorph openModal: dialog) choice.
	dialog cancelled ifTrue: [ ^nil ].
	choice 
		ifNotNil: [ ^choice ]
		ifNil: [ ^dialog filterValue ]! !

!UITheme methodsFor: 'morph creation' stamp: 'AlainPlantec 11/25/2010 09:43'!
newAutoAcceptTextEntryIn: aThemedMorph for: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel font: aFont help: helpText 
	"Answer a text entry for the given model.
	Object conversion will be automatic based on the class of
	object returned after performing the get selector, aClass
	is provided in case of initial nil returns."
	^ self
		newAutoAcceptTextEntryIn: aThemedMorph
		for: aModel
		get: getSel
		set: setSel
		class: aClass 
		getEnabled: enabledSel
		font: aFont
		help: helpText
		entryCompletion: nil! !

!UITheme methodsFor: 'sounds' stamp: 'gvc 9/12/2007 14:45'!
messageSound
	"Answer the message sound."

	^self soundTheme messageSound! !

!UITheme methodsFor: 'scrollbars' stamp: 'AlainPlantec 12/17/2009 13:20'!
createArrowOfDirection: aSymbolDirection size: finalSizeInteger color: aColor 
	"Defer to current UITheme if available."
	
	^self
		scrollbarArrowOfDirection: aSymbolDirection
		size: finalSizeInteger
		color: aColor! !

!UITheme methodsFor: 'label-styles' stamp: 'tbn 7/29/2010 21:27'!
createExpandBoxFor: aSystemWindow
	"Answer a button for maximising/restoring the window."
	
	^aSystemWindow createBox
		labelGraphic: self windowMaximizeForm;
		extent: aSystemWindow boxExtent;
		actionSelector: #expandBoxHit;
		setBalloonText: 'Expand to full screen' translated! !

!UITheme methodsFor: 'services' stamp: 'GaryChambers 12/6/2011 10:04'!
enterOrRequestIn: aThemedMorph title: title labels: labels values: values lines: lines
	"Answer the result of a popup choice with the given title, labels, values and lines."

	| dialog choice |
	dialog := (PopupChoiceOrRequestDialogWindow newWithTheme: aThemedMorph theme)
		title: (title isEmpty ifTrue: ['Choose' translated] ifFalse: [title asString]);
		labels: labels;
		lines: (lines ifNil: [#()]);
		model: values.
	choice := (aThemedMorph openModal: dialog) choice.
	dialog cancelled ifTrue: [ ^nil ].
	choice 
		ifNotNil: [ ^choice ]
		ifNil: [ ^dialog filterValue ]! !

!UITheme methodsFor: 'fill-styles-buttons' stamp: 'gvc 11/13/2007 11:30'!
controlButtonSelectedMouseOverFillStyleFor: aButton
	"Return the selected mouse over control button fillStyle for the given button.
	Control buttons are generally used for drop-lists and expanders."
	
	^self buttonSelectedMouseOverFillStyleFor: aButton! !

!UITheme methodsFor: 'defaults' stamp: 'AlainPlantec 2/11/2011 21:07'!
menuItemSelectedTextColorFor: aMenuItem
	"Answer the color to use for selected menu item text."

	^ self settings menuSelectionTextColor! !

!UITheme methodsFor: 'label-styles' stamp: 'EstebanLorenzano 5/9/2013 20:34'!
windowMenuIconFor: aWindow
	"Answer the menu icon for the given window."

	^ aWindow taskbarIcon ifNil: [self windowMenuForm]! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 3/6/2010 17:22'!
newHSVSelectorIn: aThemedMorph color: aColor help: helpText
	"Answer a hue-saturation-volume selector."

	^HSVColorSelectorMorph new
		selectedColor: aColor;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		setBalloonText: helpText! !

!UITheme methodsFor: 'defaults' stamp: 'BenjaminVanRyseghem 3/22/2013 16:16'!
windowBorderWidthFor: aWindow

	^ 4! !

!UITheme methodsFor: 'fill-styles-buttons' stamp: 'gvc 12/9/2008 13:05'!
controlButtonSelectedFillStyleFor: aButton
	"Return the selected control button fillStyle for the given button.
	Control buttons are generally used for drop-lists and expanders."
	
	^self buttonSelectedFillStyleFor: aButton! !

!UITheme methodsFor: 'border-styles' stamp: 'gvc 2/16/2009 17:17'!
windowDiffuseDropShadowOffsetRectangleFor: aSystemWindow
	"Answer a rectangle describing the offsets for each corner
	of the the active window bounds for the drop shadow area
	when the difuse style is used."
	
	^8@4 corner: 8@10! !

!UITheme methodsFor: 'morph creation' stamp: 'EstebanLorenzano 4/29/2014 12:35'!
newTextEditorIn: aThemedMorph for: aModel getText: getSel setText: setSel getEnabled: enabledSel menu: aMenuSelector
	"Answer a text (Smalltalk code) editor for the given model."

	^PluggableTextMorph new
		on: aModel
		text: getSel
		accept: setSel
		readSelection: nil
		menu: aMenuSelector;
		theme: self;
		getEnabledSelector: enabledSel;
		font: self textFont;
		cornerStyle: aThemedMorph preferredCornerStyle;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		borderStyle: (BorderStyle inset width: 1);
		"color: Color darkGray;
		selectionColor: self selectionColor;"
		removeProperty: #theme! !

!UITheme methodsFor: 'initialize-release' stamp: 'gvc 7/30/2009 18:33'!
defaultSoundTheme
	"Answer the default sound theme.
	Answer the system sound theme by default."

	^SoundTheme current! !

!UITheme methodsFor: 'border-styles' stamp: 'MarcusDenker 12/11/2009 09:35'!
tabGroupCornerStyleIn: aThemedMorph
	"Allow for themes to override default behaviour."
	
	^aThemedMorph
		ifNil: [#square]
		ifNotNil: [:tm | tm preferredCornerStyle]! !

!UITheme methodsFor: 'fill-styles-buttons' stamp: 'gvc 11/13/2007 11:31'!
controlButtonSelectedPressedFillStyleFor: aButton
	"Return the selected pressed button fillStyle for the given button.
	Control buttons are generally used for drop-lists and expanders."
	
	^self buttonSelectedPressedFillStyleFor: aButton! !

!UITheme methodsFor: 'accessing' stamp: 'gvc 9/12/2007 14:40'!
focusIndicator: anObject
	"Set the value of focusIndicator"

	focusIndicator := anObject! !

!UITheme methodsFor: 'initialize-release' stamp: 'gvc 5/24/2007 10:11'!
newWindowMaximizeForm
	"Answer a new form for a window maximize box."

	^Form
		extent: 10@10
		depth: 32
		fromArray: #( 3875602689 3875602689 3875602689 3875602689 3875602689 3875602689 0 0 0 0 3875602689 0 0 0 0 4127260929 3877181721 3877181721 3875602689 0 3875602689 0 0 0 0 3875602689 3212869760 0 3875602689 3212869760 3875602689 0 0 0 0 3875602689 3212869760 0 3875602689 3212869760 3875602689 0 0 0 0 3875602689 3212869760 0 3875602689 3212869760 3875602689 4127260929 3875602689 3875602689 3875602689 3875602689 3212869760 0 3875602689 3212869760 0 3877181721 3212869760 3212869760 3212869760 3212869760 3212869760 0 3875602689 3212869760 0 3877181721 0 0 0 0 0 0 3875602689 3212869760 0 3875602689 3875602689 3875602689 3875602689 3875602689 3875602689 3875602689 3875602689 3212869760 0 0 3212869760 3212869760 3212869760 3212869760 3212869760 3212869760 3212869760 3212869760)
		offset: 0@0! !

!UITheme methodsFor: 'cursor' stamp: 'AlainPlantec 2/1/2011 09:39'!
overTextCursorFor: aTextMorph
	"Answer the pointer cursor when over an active text 
	(answer nil if no particular cursor is wanted)."

	^ Cursor overEditableText! !

!UITheme methodsFor: 'fill-styles' stamp: 'TudorGirba 3/11/2015 08:33'!
morphTreeColumnFillStyleFor: aMorph
	^ self buttonNormalFillStyleFor: aMorph ! !

!UITheme methodsFor: 'sounds' stamp: 'gvc 9/12/2007 14:46'!
windowRestoreUpSound
	"Answer the window restore up sound."

	^self soundTheme windowRestoreUpSound! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 10/21/2009 14:44'!
newStackIn: aThemedMorph for: controls
	"Answer a morph laid out with a stack of controls."

	|answer|
	answer := PanelMorph new
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		fillStyle: Color transparent; "non pane color tracking"
		layoutPolicy: StackLayout new.
	controls do: [:m | answer addMorphBack: m].
	^answer
			! !

!UITheme methodsFor: 'services' stamp: 'GaryChambers 12/6/2011 10:05'!
passwordEntryIn: aThemedMorph text: aStringOrText title: aString entryText: defaultEntryText
	"Answer the result of a password entry dialog (a string or nil if cancelled)
	with the given label and title."

	^(aThemedMorph openModal: (
		(PasswordDialogWindow newWithTheme: aThemedMorph theme)
			textFont: self textFont;
			title: aString;
			text: aStringOrText;
			entryText: defaultEntryText)) entryText! !

!UITheme methodsFor: 'accessing colors' stamp: 'GaryChambers 12/2/2011 12:29'!
listTextColor
	"Answer the list text color to use."

	^Color black! !

!UITheme methodsFor: 'morph creation' stamp: 'gvc 8/25/2006 14:36'!
newGroupboxIn: aThemedMorph label: aString forAll: controls
	"Answer a groupbox with the given label and controls."

	^(self newGroupboxIn: aThemedMorph label: aString)
		addContentMorph: (self newColumnIn: aThemedMorph for: controls);
		yourself! !

!UITheme methodsFor: 'morph creation' stamp: 'EstebanLorenzano 5/1/2014 16:05'!
newTextEntryIn: aThemedMorph for: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel help: helpText
	"Answer a text entry for the given model."

	|pt|
	pt := PluggableTextFieldMorph new
		convertTo: aClass;
		alwaysAccept: true;
		on: aModel
		text: getSel
		accept: setSel
		readSelection: nil
		menu: nil;
		acceptOnCR: true;
		getEnabledSelector: enabledSel;
		font: self textFont;
		cornerStyle: (self textEntryCornerStyleIn: aThemedMorph);
		hResizing: #spaceFill;
		vResizing: #rigid;
		borderStyle: (BorderStyle inset width: 1);
		"color: Color white;"
		selectionColor: self selectionColor;
		hideScrollBarsIndefinitely;
		extent: 24@(self textFont height + 8);
		setBalloonText: helpText.
	pt textMorph
		autoFit: true;
		wrapFlag: false;
		margins: (2@1 corner: 2@1).
	^pt! !

!UITheme class methodsFor: 'accessing' stamp: 'gvc 10/16/2008 16:04'!
defaultSettings
	"Answer the default settings for the theme."
	
	^defaultSettings ifNil: [
		self defaultSettings: self newDefaultSettings.
		defaultSettings]! !

!UITheme class methodsFor: 'initialize-release' stamp: 'GaryChambers 12/12/2011 12:49'!
resetBuilder
	"self resetBuilder"
	
	Builder := nil! !

!UITheme class methodsFor: 'accessing' stamp: 'AlainPlantec 5/14/2010 16:12'!
resetAllDefaultSettings
	"Reset the default settings of all themes"
	"self resetAllDefaultSettings"
	self withAllSubclassesDo: [:cls | cls defaultSettings: nil]! !

!UITheme class methodsFor: 'accessing' stamp: 'gvc 2/6/2007 11:43'!
builder
	"Answer a morph that has the TEasilyThemed trait."

	^Builder ifNil: [Builder := self newBuilder. Builder]! !

!UITheme class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 7/22/2013 14:31'!
current: aUITheme
	"Set the current ui theme."

	Current := aUITheme.
	SystemProgressMorph reset. "reset to use new fill styles"
	ScrollBar initializeImagesCache. "reset to use new arrows"
	aUITheme updateWorldDockingBars.
	World themeChanged.! !

!UITheme class methodsFor: 'testing' stamp: 'gvc 6/22/2007 14:24'!
isAbstract
	"Answer whether the receiver is considered to be abstract."

	^true! !

!UITheme class methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/10/2013 09:53'!
defaultThemeIconsClass
	^ ThemeIcons! !

!UITheme class methodsFor: 'accessing' stamp: 'AlainPlantec 12/13/2009 13:24'!
currentSettings
	"Answer the current ui theme settings."

	^ self current settings! !

!UITheme class methodsFor: 'accessing' stamp: 'gvc 10/16/2008 16:05'!
defaultSettings: aThemeSettings
	"Set the default settings for the theme."
	
	defaultSettings := aThemeSettings! !

!UITheme class methodsFor: 'installing' stamp: 'MarcusDenker 11/25/2014 17:43'!
installFullTheme
	"Installs full theme: 
		this theme
		default forts
		desktop background
		completion list colors"
		
	self beCurrent.
	SHPreferences setStyleTable: SHTextStylerST80 blueStyleTable.
	PolymorphSystemSettings desktopColor: Color lightGray lighter lighter.
	NECPreferences backgroundColor: UITheme current windowColor. 
	Paragraph insertionPointColor: UITheme current caretColor.! !

!UITheme class methodsFor: 'accessing' stamp: 'BenComan 3/24/2014 20:55'!
standardThemeClass
	^ Pharo3Theme ! !

!UITheme class methodsFor: 'accessing' stamp: 'gvc 8/24/2006 18:28'!
newDefault
	"Answer a new default ui theme."

	^self new! !

!UITheme class methodsFor: 'testing' stamp: 'gvc 6/22/2007 15:19'!
isCurrent
	"Answer whether an instance of the receiver is the current theme."

	^Current class == self! !

!UITheme class methodsFor: 'accessing' stamp: 'gvc 10/16/2008 16:16'!
resetDefaultSettings
	"Reset the default settings to use the original values."

	self defaultSettings: nil! !

!UITheme class methodsFor: 'initialize-release' stamp: 'StephaneDucasse 10/9/2010 08:15'!
initialize
	"self initialize"
	self current class = UITheme
		ifTrue: [self current: nil
			"due to change to being abstract"].
	Smalltalk addToStartUpList: self! !

!UITheme class methodsFor: 'query' stamp: 'gvc 12/1/2008 15:43'!
allThemeClasses
	"Answer the subclasses of the receiver that are considered to be
	concrete (useable as a theme)."

	^(self allSubclasses reject: [:c | c isAbstract]) asSortedCollection: [:a :b |
		a themeName <= b themeName]! !

!UITheme class methodsFor: 'accessing' stamp: 'AlainPlantec 12/15/2009 10:27'!
currentAnimationSettings
	"Answer the current ui theme settings."

	^ self currentSettings animationSettings! !

!UITheme class methodsFor: 'accessing' stamp: 'gvc 2/6/2007 11:44'!
newBuilder
	"Answer a new builder morph."

	^ComposableMorph new! !

!UITheme class methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 6/10/2013 04:06'!
lightBaseColor

	^ Color white! !

!UITheme class methodsFor: 'query' stamp: 'gvc 6/22/2007 14:25'!
beCurrent
	"Make a new instance of the receiver be the current theme."

	self isAbstract ifTrue: [^self error: self name, ' is abstract, send #beCurrent to a subclass.'].
	self current: self newDefault! !

!UITheme class methodsFor: 'accessing' stamp: 'gvc 6/22/2007 15:18'!
themeName
	"Answer the friendly name of the theme."

	self subclassResponsibility! !

!UITheme class methodsFor: 'accessing' stamp: 'BenComan 3/24/2014 20:55'!
current
	"Answer the current ui theme.
	WARNING: Direct access to this method is ill-adviced, use Smalltalk ui theme instead."

	^Current ifNil: [
		Current := Pharo3Theme newDefault.
		Current ]! !

!UITheme class methodsFor: 'accessing' stamp: 'MarcusDenker 9/27/2010 15:31'!
newDefaultSettings
	"Answer a new original default settings."

	^ThemeSettings new
		buttonColor: Color gray;
		scrollbarColor: Color gray;
		yourself! !

!UIThemeRegistry commentStamp: 'TorstenBergmann 2/5/2014 10:31'!
Registry for UI themes!
!UIThemeRegistry class methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/10/2013 11:08'!
theme 
	^ UITheme current! !

!UIThemeRegistry class methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/10/2013 11:08'!
icons
	^ ThemeIcons current! !

!UIThemeWatery commentStamp: 'TorstenBergmann 2/5/2014 10:31'!
Watery UI theme!
!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'gvc 12/8/2008 18:41'!
radioButtonNormalFillStyleFor: aRadioButton
	"Return the normal radio button fillStyle for the given button."
	
	^(ImageFillStyle form: self radioButtonForm) origin: aRadioButton topLeft! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'MarcusDenker 7/22/2013 13:50'!
newWindowCloseOverForm
	"Answer a new form for a window close box for use when the mouse is over it."

	^(Form
	extent: 16@16
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4290361785 4285822068 4282071867 4279440147 4279440147 4282071867 4285822068 4290361785 0 0 0 0 0 0 0 4287335307 4281808438 4283254086 4286543478 4288254096 4288188560 4286543478 4283254086 4281808438 4287335307 0 0 0 0 0 4287138185 4280425243 4285027670 4289633180 4292135884 4293254878 4293320928 4292267469 4289567644 4285093206 4280490779 4287203978 0 0 0 4290164406 4282134834 4284233271 4287126365 4286603617 4292192940 4292850869 4292785333 4292192940 4286011738 4286666328 4284364600 4282266163 4290230199 0 0 4286545534 4283178015 4286985273 4284555811 4284360999 4285741623 4291126110 4290272343 4285676086 4284360743 4284555811 4287182394 4283309344 4286611327 0 0 4283383359 4285867306 4288685092 4289012512 4285079066 4284293404 4285344037 4285803560 4284293404 4285472540 4289340193 4288619300 4285867562 4283711040 0 0 4282782229 4287833644 4289996837 4290787376 4291381825 4285870380 4284886569 4284952105 4286395695 4291578692 4290984239 4290193702 4287833644 4283044630 0 0 4284026900 4289014315 4291051835 4291973448 4292502105 4286988605 4285544758 4285610550 4287054910 4292830299 4292236105 4291445307 4289014058 4284092436 0 0 4285414719 4289343786 4291712331 4292502618 4287513921 4285808187 4287779662 4287713869 4285808443 4287514433 4292699484 4291974475 4289343785 4285545791 0 0 4287264888 4288555300 4292239449 4288171078 4286333501 4287320653 4294614419 4294351761 4287846482 4286333758 4287448897 4292501850 4288751652 4287330424 0 0 4290558650 4286658615 4291253841 4291718762 4287518032 4293564045 4294617247 4294618017 4293827729 4287518289 4291193701 4291779154 4286789430 4290493114 0 0 4292664540 4288385426 4287573545 4292374633 4293629325 4294289824 4294555050 4294555308 4294356387 4293958547 4292835183 4287836460 4288385426 4292664540 0 0 0 4292993505 4288320403 4286993487 4289421400 4291463295 4292845463 4293043354 4291660419 4289684573 4287256400 4288254867 4292993505 0 0 0 0 0 4292927712 4291282630 4287858566 4286996058 4286533190 4286598726 4287324509 4287858309 4291348680 4292927712 0 0 0 0 0 0 0 4292401368 4293125091 4293454056 4293190884 4293190884 4293190884 4293125091 4292401368 0 0 0 0)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 12/8/2008 18:38'!
newRadioButtonSelectedForm
	"Answer the form for a selected radio button."

	^(Form
	extent: 14@14
	depth: 32
	fromArray: #( 16777215 16777215 16777215 195273727 2641329849 3563221416 4067918510 4051207088 3546444457 2574352313 160337634 16777215 16777215 16777215 16777215 16777215 1433764797 4033509543 4289442502 4292467941 4292928234 4292928234 4292467941 4289442502 4016797863 1299613120 16777215 16777215 16777215 1383498170 4252665514 4291152600 4291744478 4291744478 4291744478 4291744478 4291744478 4291744478 4291087064 4235822507 1216120505 16777215 192187321 4033181089 4290232016 4290560980 4290560980 4290560980 4290560980 4290560980 4290560980 4290560980 4290560980 4290100687 3982914979 140541887 2623959968 4286746800 4289574859 4289574859 4289574859 4289574859 4289574859 4289574859 4289574859 4289574859 4289574859 4289574859 4286549679 2456319395 3579801242 4286353071 4288654533 4288654533 4288654533 4288654533 4288654533 4288654533 4288654533 4288654533 4288654533 4288654533 4286089901 3495980954 3965612183 4284709539 4286944951 4287011000 4287011000 4287011000 4287011000 4287011000 4287011000 4287011000 4287011000 4286813622 4284643746 3915280279 3915345555 4284973226 4284973226 4284973226 4284973226 4284973226 4284973226 4284973226 4284973226 4284973226 4284973226 4284973226 4284973226 3864947858 3512362887 4285500082 4285500082 4285500082 4285500082 4285500082 4285500082 4285500082 4285500082 4285500082 4285500082 4285500082 4285500082 3428345476 2286835828 4285433514 4286026683 4286026683 4286026683 4286026683 4286026683 4286026683 4286026683 4286026683 4286026683 4286026683 4285235879 2152552048 187582022 3813958010 4286421439 4286553283 4286553283 4286553283 4286553283 4286553283 4286553283 4286553283 4286553283 4286355645 3763494776 187582022 16777215 959790667 4116343939 4286685122 4287014603 4287014603 4287014603 4287014603 4287014603 4287014603 4286619329 4099500930 926039117 16777215 16777215 16777215 908735550 3679148137 4285630628 4286882500 4287541204 4287541204 4286816707 4268787875 3645527655 892024127 16777215 16777215 16777215 16777215 16777215 169482778 1798387264 3040494156 3679082084 3662239075 3023716940 1798452800 169482778 16777215 16777215 16777215)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'label-styles' stamp: 'MarcusDenker 7/22/2013 13:50'!
windowMaximizePassiveForm
	"Answer the form to use for passive (background) window maximize/restore buttons"

	^self forms at: #windowMaximizePassive ifAbsent: [Form extent: 16@16 depth: Display depth]! !

!UIThemeWatery methodsFor: 'basic-colors' stamp: 'MarcusDenker 7/22/2013 13:50'!
taskbarMinimizedButtonColorFor: aButton
	"Answer the colour for the given minimized taskbar button."

	^Color transparent! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 12/11/2008 16:38'!
newCheckboxSelectedForm
	"Answer the form for a selected checkbox."

	^(Form
	extent: 14@14
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 591416973 3914425236 4134435746 4134435746 4134435746 4134435746 4134435746 4134435746 4134435746 4134435746 4134435746 4134435746 3914425236 591416973 2571195527 4289245124 4293125612 4293125612 4293125612 4293125612 4293125612 4293125612 4293125612 4293125612 4293125612 4293125612 4289245124 2520929417 2655015551 4289114053 4291744479 4291744479 4291744479 4291744479 4291744479 4291744479 4291744479 4291744479 4291744479 4291744479 4289114053 2604684160 2654949242 4288456640 4290560980 4290560980 4290560980 4290560980 4290560980 4290560980 4290560980 4290560980 4290560980 4290560980 4288456640 2604748668 2654817654 4287799485 4289443276 4289443276 4289443276 4289443276 4289443276 4289443276 4289443276 4289443276 4289443276 4289443276 4287799485 2604486007 2654686063 4287273914 4288457669 4288457669 4288457669 4288457669 4288457669 4288457669 4288457669 4288457669 4288457669 4288457669 4287273914 2604420207 2654816618 4284907433 4284907433 4284907433 4284907433 4284907433 4284907433 4284907433 4284907433 4284907433 4284907433 4284907433 4284907433 2604484971 2654619492 4285500082 4285500082 4285500082 4285500082 4285500082 4285500082 4285500082 4285500082 4285500082 4285500082 4285500082 4285500082 2604353637 2654684509 4286092732 4286092732 4286092732 4286092732 4286092732 4286092732 4286092732 4286092732 4286092732 4286092732 4286092732 4286092732 2604352863 2654487128 4286685382 4286685382 4286685382 4286685382 4286685382 4286685382 4286685382 4286685382 4286685382 4286685382 4286685382 4286685382 2604221017 2603892560 4287146187 4287278031 4287278031 4287278031 4287278031 4287278031 4287278031 4287278031 4287278031 4287278031 4287278031 4287146187 2553626706 1310531626 4232599666 4284512149 4284512149 4284512149 4284512149 4284512149 4284512149 4284512149 4284512149 4284512149 4284512149 4232599666 1276977451 50331648 1210064935 1646208047 1646208047 1646208047 1646208047 1646208047 1646208047 1646208047 1646208047 1646208047 1646208047 1210064935 50331648)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'border-styles' stamp: 'gvc 1/27/2009 16:44'!
scrollPaneNormalBorderStyleFor: aScrollPane
	"Return the normal borderStyle for the given scroll pane."

	^BorderStyle simple
		width: 1;
		baseColor: aScrollPane paneColor! !

!UIThemeWatery methodsFor: 'initialization' stamp: 'gvc 2/16/2009 17:22'!
initialize
	"Initialize the receiver."

	super initialize.
	self windowActiveDropShadowStyle: #diffuse! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'AlainPlantec 10/23/2010 17:44'!
windowInactiveTitleFillStyleFor: aWindow
	"Return the window inactive title fillStyle for the given window."
	
	|aColor|
	aColor := self windowInactiveFillStyleFor: aWindow.
	^(GradientFillStyle ramp: {
			0.0->aColor twiceLighter.
			1.0->aColor})	
		origin: aWindow labelArea topLeft;
		direction: 0 @ aWindow labelHeight;
		radial: false! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 12/8/2008 14:00'!
buttonBottomMiddleForm
	"Answer the form to use for the bottom middle of a button."

	^self forms at: #buttonBottomMiddle ifAbsent: [Form extent: 1@11 depth: Display depth]! !

!UIThemeWatery methodsFor: 'label-styles' stamp: 'MarcusDenker 7/22/2013 13:50'!
windowMenuOverForm
	"Answer the form to use for mouse over window menu buttons"

	^self forms at: #windowMenuOver ifAbsent: [Form extent: 16@16 depth: Display depth]! !

!UIThemeWatery methodsFor: 'defaults' stamp: 'gvc 12/3/2008 17:23'!
buttonMinHeight
	"Answer the minumum height of a button for this theme."
	
	^24! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'MarcusDenker 7/22/2013 13:50'!
splitterPressedFillStyleFor: aSplitter
	"Return the pressed splitter fillStyle for the given splitter."
	
	|aColor|
	aColor := aSplitter paneColor duller.
	^(GradientFillStyle ramp: {
			0.0->aColor twiceLighter. 1.0->aColor twiceDarker})
		origin: aSplitter topLeft;
		direction: (aSplitter splitsTopAndBottom
			ifTrue: [0 @ aSplitter height]
			ifFalse: [aSplitter width @ 0]);
		radial: false! !

!UIThemeWatery methodsFor: 'defaults' stamp: 'gvc 1/23/2009 12:23'!
buttonMinWidth
	"Answer the minumum width of a button for this theme."
	
	^24! !

!UIThemeWatery methodsFor: 'fill-styles-scrollbars' stamp: 'gvc 10/3/2008 13:32'!
scrollbarNormalHorizontalThumbFillStyleFor: aScrollbar
	"Return the normal scrollbar horizontal thumb fillStyle for the given scrollbar."
	
	|s l m r|
	s := aScrollbar slider.
	l := self scrollbarThumbLeftForm.
	m := self scrollbarThumbHorizontalMiddleForm.
	r := self scrollbarThumbRightForm.
	^CompositeFillStyle fillStyles: {
		(ImageFillStyle form: l) origin: s topLeft.
		(AlphaInfiniteForm with: m)
			origin: s topLeft + (l width@0);
			extent: (s width - l width - r width)@m height.
		(ImageFillStyle form: r)
			origin: s topRight - (r width@0)}! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'HilaireFernandes 3/22/2014 16:34'!
initializeForms
	"Initialize the receiver's image forms."

	super initializeForms.
	self forms
		at: #sbHThumbLeft put: self newScrollbarThumbLeftForm;
		at: #sbHThumbMiddle put: self newScrollbarThumbHorizontalMiddleForm;
		at: #sbHThumbRight put: self newScrollbarThumbRightForm;
		at: #sbVThumbTop put: self newScrollbarThumbTopForm;
		at: #sbVThumbMiddle put: self newScrollbarThumbVerticalMiddleForm;
		at: #sbVThumbBottom put: self newScrollbarThumbBottomForm;
		at: #buttonTopLeft put: self newButtonTopLeftForm;
		at: #buttonTopMiddle put: self newButtonTopMiddleForm;
		at: #buttonTopRight put: self newButtonTopRightForm;
		at: #buttonMiddleLeft put: self newButtonMiddleLeftForm;
		at: #buttonMiddleRight put: self newButtonMiddleRightForm;
		at: #buttonBottomLeft put: self newButtonBottomLeftForm;
		at: #buttonBottomMiddle put: self newButtonBottomMiddleForm;
		at: #buttonBottomRight put: self newButtonBottomRightForm;
		at: #buttonSquareTopLeft put: self newButtonSquareTopLeftForm;
		at: #buttonSquareTopRight put: self newButtonSquareTopRightForm;
		at: #buttonSquareBottomLeft put: self newButtonSquareBottomLeftForm;
		at: #buttonSquareBottomRight put: self newButtonSquareBottomRightForm;
		at: #buttonSelectedTopLeft put: self newButtonSelectedTopLeftForm;
		at: #buttonSelectedTopMiddle put: self newButtonSelectedTopMiddleForm;
		at: #buttonSelectedTopRight put: self newButtonSelectedTopRightForm;
		at: #buttonSelectedMiddleLeft put: self newButtonSelectedMiddleLeftForm;
		at: #buttonSelectedMiddleRight put: self newButtonSelectedMiddleRightForm;
		at: #buttonSelectedBottomLeft put: self newButtonSelectedBottomLeftForm;
		at: #buttonSelectedBottomMiddle put: self newButtonSelectedBottomMiddleForm;
		at: #buttonSelectedBottomRight put: self newButtonSelectedBottomRightForm;
		at: #buttonSquareSelectedTopLeft put: self newButtonSquareSelectedTopLeftForm;
		at: #buttonSquareSelectedTopRight put: self newButtonSquareSelectedTopRightForm;
		at: #buttonSquareSelectedBottomLeft put: self newButtonSquareSelectedBottomLeftForm;
		at: #buttonSquareSelectedBottomRight put: self newButtonSquareSelectedBottomRightForm;
		at: #radioButton put: self newRadioButtonForm;
		at: #radioButtonSelected put: self newRadioButtonSelectedForm;
		at: #checkbox put: self newCheckboxForm;
		at: #checkboxSelected put: self newCheckboxSelectedForm;
		at: #windowClosePassive put: self newWindowInactiveControlForm;
		at: #windowMinimizePassive put: self newWindowInactiveControlForm;
		at: #windowMaximizePassive put: self newWindowInactiveControlForm;
		at: #windowMenuPassive put: self newWindowMenuPassiveForm;
		at: #windowMenuOver put: self newWindowMenuOverForm
! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'MarcusDenker 7/22/2013 13:50'!
newCheckboxMarkerForm
	"Answer a new checkbox marker form."

	^(Form
	extent: 12@14
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1342177280 1610612736 134217728 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3338665984 4278190080 1476395008 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 671088640 4278190080 4009754624 134217728 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2147483648 4278190080 2533359616 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3607101440 4278190080 1207959552 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1073741824 4278190080 3875536896 16777215 16777215 16777215 16777215 16777215 1207959552 3204448256 134217728 16777215 2801795072 4278190080 2147483648 16777215 16777215 16777215 16777215 134217728 3607101440 4278190080 2936012800 268435456 4143972352 4278190080 536870912 16777215 16777215 16777215 16777215 16777215 536870912 4009754624 4278190080 3607101440 4278190080 3070230528 16777215 16777215 16777215 16777215 16777215 16777215 16777215 805306368 4009754624 4278190080 4278190080 1342177280 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 671088640 2936012800 2801795072 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'GaryChambers 8/17/2010 14:08'!
buttonSelectedFillStyleFor: aButton
	"Return the selected button fillStyle for the given button."
	
	^aButton isDefault 
		ifTrue: [self buttonPlainFillStyleFor: aButton]
		ifFalse: [self buttonColouredFillStyleFor: aButton]! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 1/22/2009 15:21'!
newButtonSquareTopLeftForm
	"Answer the form for the top left of a square button."

	^(Form
	extent: 12@12
	depth: 32
	fromArray: #( 633520834 3333994680 3954422707 3971199923 3971199923 3971199923 3971199923 3971199923 3971199923 3971199923 3971199923 3971199923 3032004792 4289243304 4290822336 4293585642 4293585642 4293585642 4293585642 4293585642 4293585642 4293585642 4293585642 4293585642 3920736689 4289374890 4292730333 4294111986 4294111986 4294111986 4294111986 4294111986 4294111986 4294111986 4294111986 4294111986 3970805165 4289638062 4292796126 4293783021 4293848814 4293848814 4293848814 4293848814 4293848814 4293848814 4293848814 4293848814 3970476200 4289901234 4292664540 4293585642 4293585642 4293585642 4293585642 4293585642 4293585642 4293585642 4293585642 4293585642 3970278821 4290164406 4292532954 4293322470 4293322470 4293322470 4293322470 4293322470 4293322470 4293322470 4293322470 4293322470 3970015649 4290493371 4292532954 4293190884 4293190884 4293190884 4293125091 4293125091 4293190884 4293190884 4293190884 4293190884 3969686684 4290756543 4292467161 4292993505 4293059298 4293059298 4293059298 4293059298 4293059298 4293059298 4293059298 4293059298 3969423512 4291019715 4292467161 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 3969160340 4291282887 4292467161 4292796126 4292796126 4292796126 4292796126 4292796126 4292796126 4292796126 4292796126 4292796126 3968831375 4291546059 4292467161 4292796126 4292796126 4292796126 4292796126 4292796126 4292796126 4292796126 4292796126 4292796126 3968568203 4291809231 4292203989 4292335575 4292335575 4292335575 4292335575 4292335575 4292335575 4292335575 4292335575 4292335575)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'border-styles-scrollbars' stamp: 'EstebanLorenzano 5/15/2014 19:25'!
scrollbarPressedButtonBorderStyleFor: aScrollbar
	"Return the pressed button borderStyle for the given scrollbar."
	^ self scrollbarNormalButtonBorderStyleFor: aScrollbar! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 12/9/2008 12:43'!
checkboxSelectedForm
	"Answer the form to use for a selected checkbox."

	^self forms at: #checkboxSelected ifAbsent: [Form extent: 14@14 depth: Display depth]! !

!UIThemeWatery methodsFor: 'basic-colors' stamp: 'EstebanLorenzano 4/29/2014 17:36'!
taskbarActiveButtonColorFor: aButton
	"Answer the colour for the given active taskbar button."

	^self scrollbarColor alphaMixed: 0.7 with: Color white! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 12/8/2008 14:01'!
buttonTopRightForm
	"Answer the form to use for the top right of a button."

	^self forms at: #buttonTopRight ifAbsent: [Form extent: 11@12 depth: Display depth]! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 1/22/2009 15:18'!
newButtonMiddleRightForm
	"Answer the form for the middle right of a button."

	^(Form
	extent: 12@1
	depth: 32
	fromArray: #( 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 3934750599)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'accessing' stamp: 'gvc 2/16/2009 17:24'!
windowActiveDropShadowStyle
	"Answer the style of drop shadow to use for active windows."
	
	^windowActiveDropShadowStyle! !

!UIThemeWatery methodsFor: 'defaults' stamp: 'MarcusDenker 7/22/2013 13:50'!
scrollbarMinimumThumbThickness
	"Answer the minumum width or height of a scrollbar thumb 
	as appropriate to its orientation."
	
	^15! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 1/22/2009 14:30'!
buttonSelectedMiddleLeftForm
	"Answer the form to use for the middle left of a selected button."

	^self forms at: #buttonSelectedMiddleLeft ifAbsent: [Form extent: 12@1 depth: Display depth]! !

!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'MarcusDenker 7/22/2013 13:50'!
controlButtonMouseOverFillStyleFor: aButton
	"Return the mouse over control button fillStyle for the given button.
	Control buttons are generally used for drop-lists and expanders."
	
	^self controlButtonNormalFillStyleFor: aButton! !

!UIThemeWatery methodsFor: 'defaults' stamp: 'gvc 10/3/2008 13:05'!
scrollbarThickness
	"Answer the width or height of a scrollbar as appropriate to
	its orientation."
	
	^13! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'GaryChambers 8/17/2010 14:37'!
dropListDisabledFillStyleFor: aDropList
	"Return the disabled fillStyle for the given drop list."
	
	^self dropListNormalFillStyleFor: aDropList! !

!UIThemeWatery methodsFor: 'morph creation' stamp: 'MarcusDenker 7/22/2013 13:50'!
newDialogPanelIn: aThemedMorph
	"Answer a new (main) dialog panel."

	^(super 
		newDialogPanelIn: aThemedMorph)
		fillStyle: (SolidFillStyle color: Color transparent) "no pane colour tracking"! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 10/3/2008 13:22'!
newScrollbarThumbBottomForm
	"Answer the form for the bottom of a scrollbar thumb."

	^(Form
	extent: 13@7
	depth: 32
	fromArray: #( 4284182411 4287142063 4287931577 4287602613 4287208113 4286879149 4286484649 4286155685 4285761185 4285432221 4285103257 4284577427 4282669690 4284182411 4286287012 4287931577 4287602613 4287208113 4286879149 4286484649 4286155685 4285761185 4285432221 4285103257 4284182670 4282669690 2906411633 4284445326 4287536820 4287602613 4287208113 4286879149 4286484649 4286155685 4285761185 4285432221 4285103257 4283261825 3023720303 2033601901 4284182411 4285037205 4287339698 4287208113 4286879149 4286484649 4286155685 4285761185 4285432221 4283919242 4282801275 2503363949 1149473452 2755548019 4284050825 4284248204 4285958562 4286681770 4286484649 4286155685 4285037464 4283656069 4282998397 3023720559 1262704758 0 422725477 2083867754 2671004523 4283787654 4283656068 4283656325 4283392897 4283195776 3023786609 2688176497 926700403 73298833 0 0 0 1345735788 1999981163 2671004523 2671004523 2671004523 2167753578 1580616556 171134054 0 0)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'label-styles' stamp: 'MarcusDenker 7/22/2013 13:50'!
windowMaximizeOverForm
	"Answer the form to use for mouse over window maximize buttons"

	^self forms at: #windowMaximizeOver ifAbsent: [Form extent: 16@16 depth: Display depth]! !

!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'MarcusDenker 7/22/2013 13:50'!
buttonPressedFillStyleFor: aButton
	"Return the button pressed fillStyle for the given button."
		
	^self buttonSelectedFillStyleFor: aButton! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 1/22/2009 15:22'!
buttonSquareBottomLeftForm
	"Answer the form to use for the bottom left of a square button."

	^self forms at: #buttonSquareBottomLeft ifAbsent: [Form extent: 12@12 depth: Display depth]! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 12/8/2008 14:00'!
buttonBottomRightForm
	"Answer the form to use for the bottom right of a button."

	^self forms at: #buttonBottomRight ifAbsent: [Form extent: 11@11 depth: Display depth]! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 1/22/2009 15:24'!
buttonSquareTopRightForm
	"Answer the form to use for the top right of a square button."

	^self forms at: #buttonSquareTopRight ifAbsent: [Form extent: 12@12 depth: Display depth]! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'GaryChambers 2/15/2011 16:15'!
newWindowMenuOverForm
	"Answer a new form for a window menu box when the mouse is over it."

	^(Form
	extent: 24@16
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4293257970 4287735753 4284054189 4281884573 4281490073 4281555866 4281555866 4281555866 4281555866 4281555866 4281555866 4281555866 4281555866 4281490073 4281884573 4284054189 4287735753 4293257970 0 0 0 0 0 4293192178 4286026172 4283462312 4287538375 4289970905 4290759648 4291088354 4291022817 4291022817 4291088354 4291088354 4291022817 4291022817 4291088354 4290759648 4289970905 4287538375 4283462312 4286026172 4293192178 0 0 0 0 4287735753 4283265191 4288721616 4292074729 4293060849 4293455092 4293652469 4293652469 4293652469 4293652469 4293652469 4293652469 4293652469 4293652469 4293455092 4293060849 4292074729 4288721616 4283265191 4287801545 0 0 0 0 4284185518 4286420927 4290233820 4291877352 4292468972 4292535021 4292535021 4292535021 4292534765 4292534765 4292534765 4292534765 4292535021 4292535021 4292535021 4292468972 4291877352 4290233820 4286420927 4284185518 0 0 0 0 4282476193 4288261581 4290759648 4291351268 4291680231 4291746023 4291811559 4291811559 4291746023 4291680231 4291680231 4291746023 4291811559 4291811559 4291746023 4291680231 4291351268 4290759648 4288261581 4282476193 0 0 0 0 4282673314 4289116371 4291614438 4292403180 4292797935 4292929264 4293060849 4292929264 4292995056 4293060849 4293060849 4292995056 4292929264 4293060849 4292929264 4292797935 4292403180 4291614438 4289116371 4282607522 0 0 0 0 4284645809 4288655823 4291746023 4293323763 4294244090 4294638589 4294507004 4294638589 4294572796 4294638589 4294638589 4294572796 4294638589 4294507004 4294638589 4294244090 4293323763 4291746023 4288655823 4284645809 0 0 0 0 4287669960 4284514224 4290891232 4293323763 4294704381 4294835710 4294901503 4294901503 4294901503 4294901503 4294901503 4294901503 4294901503 4294901503 4294835710 4294704381 4293323763 4290891232 4284514224 4287669960 0 0 0 0 4292600558 4286880962 4283988397 4288392910 4291285731 4292468972 4292600558 4292600558 4292600558 4292600558 4292600558 4292600558 4292600558 4292600558 4292732143 4291811559 4288392910 4283988397 4286880962 4292600558 0 0 0 0 4292535021 4292600558 4288524495 4284777138 4281884573 4281029782 4281161367 4281161367 4281161367 4281161367 4281161367 4281161367 4281161367 4281161367 4281029782 4282015902 4284777138 4288524495 4292600558 4292535021 0 0 0 0 0 4292403180 4292403180 4292534765 4292535021 4293060849 4293060849 4293060849 4293060849 4293060849 4293060849 4293060849 4293060849 4293060849 4292797935 4292535021 4292534765 4292468972 4292403180 0 0 0 0 0 0 0 4292206058 4292535021 4292600558 4292863472 4292863472 4292863472 4292863472 4292863472 4292863472 4292863472 4292863472 4292863472 4292929264 4292600558 4292535021 4292206058 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'MarcusDenker 7/22/2013 13:50'!
newWindowMinimizeForm
	"Answer a new form for a window minimize box."

	^(Form
	extent: 16@16
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4290295992 4285953140 4282726971 4280619283 4280619283 4282661434 4285953140 4290295992 0 0 0 0 0 0 0 4287400586 4282921779 4284629572 4287526262 4288909456 4288974992 4287591798 4284761414 4282856243 4287400586 0 0 0 0 0 4287334536 4282588703 4286796631 4290682268 4292529868 4293385950 4293385950 4292529612 4290682268 4286731095 4282654242 4287400329 0 0 0 4290164406 4283247407 4286332215 4290281068 4292457116 4293447349 4293579448 4293579447 4293447349 4292457116 4290346605 4286660409 4283771952 4290164406 0 0 4287004286 4284555291 4289551160 4291461439 4292647750 4292978252 4292978510 4292978510 4292912459 4292516422 4291461695 4289485625 4285736224 4287004543 0 0 4284694079 4287316261 4291129383 4292379927 4292907543 4293237538 4293434920 4293369896 4293303330 4293104407 4292380439 4291130151 4288301098 4284694078 0 0 4285013269 4289947179 4292577049 4293498387 4293959974 4294159159 4294291774 4294357567 4294291256 4294091813 4293695508 4292774682 4290144044 4285013782 0 0 4286197779 4291263275 4293565218 4294486826 4294752322 4294754384 4294624599 4294756183 4294755663 4294753345 4294618155 4293828129 4291395115 4286263315 0 0 4286797373 4291592487 4294093364 4294753602 4294822482 4294825059 4294826346 4294826603 4294825828 4294822740 4294753602 4294225462 4291855399 4286928446 0 0 4287791736 4290870043 4294029633 4294691156 4294826081 4294894447 4294962297 4294963066 4294895474 4294892130 4294691669 4294096449 4291001115 4287857272 0 0 4290558649 4287916079 4292847677 4294431071 4294829938 4294964349 4294965892 4294966661 4294964606 4294896499 4294563169 4292980029 4287981872 4290558648 0 0 4292664540 4288452497 4288312611 4292590416 4294239351 4294636933 4294835601 4294835346 4294637704 4294306681 4293052245 4288576291 4288452497 4292664540 0 0 0 4292993505 4288321426 4287199810 4289700930 4291873639 4293321856 4293387137 4292005738 4290096709 4287463236 4288321426 4292993505 0 0 0 0 0 4292927712 4291282629 4287861124 4287137103 4286939445 4286939701 4287532112 4287926916 4291348680 4292927712 0 0 0 0 0 0 0 4292401368 4293125091 4293454056 4293190884 4293190884 4293190884 4293125091 4292401368 0 0 0 0)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 12/8/2008 14:00'!
buttonTopLeftForm
	"Answer the form to use for the top left of a button."

	^self forms at: #buttonTopLeft ifAbsent: [Form extent: 11@12 depth: Display depth]! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 10/9/2008 17:25'!
dialogWindowActiveFillStyleFor: aWindow
	"Return the window active fillStyle for the given window."
	
	^self windowActiveFillStyleFor: aWindow! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 1/22/2009 15:17'!
newButtonBottomMiddleForm
	"Answer the form for the bottom middle of a button."

	^(Form
	extent: 1@12
	depth: 32
	fromArray: #( 4292072403 4292401368 4292664540 4292927712 4293190884 4293454056 4293717228 4294046193 4294309365 4294572537 4289506476 3443342653)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'GaryChambers 11/23/2011 14:15'!
tabLabelNormalFillStyleFor: aTabLabel
	"Return the normal fillStyle for the given tab label."
	
	|round roundCorners tl t tr l m r|
	round := aTabLabel wantsRoundedCorners.
	roundCorners := aTabLabel roundedCorners.
	tl := (round and: [roundCorners includes: 1]) ifTrue: [self buttonTopLeftForm] ifFalse: [self buttonSquareTopLeftForm].
	t := self buttonTopMiddleForm.
	tr := (round and: [roundCorners includes: 4]) ifTrue: [self buttonTopRightForm] ifFalse: [self buttonSquareTopRightForm].
	l := self buttonMiddleLeftForm. m := self buttonPlainMiddleColor. r := self buttonMiddleRightForm.
	^self
		multiFormTopFillStyleFrom: {tl. t. tr. l. m. r}
		in: aTabLabel bounds! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 1/22/2009 14:29'!
newButtonSelectedTopRightForm
	"Answer the form for the top right of a selected button."

	^(Form
	extent: 12@12
	depth: 32
	fromArray: #( 3748625849 3262810310 2441121744 1184342758 295085538 33554431 0 0 0 0 0 0 4290099916 4287271854 4284904087 4266680208 4016534958 2156237519 75464703 0 0 0 0 0 4292994026 4292994026 4292994026 4292730856 4288981953 4250297491 3463873727 646616786 16777471 0 0 0 4292270819 4292270819 4292270819 4292270819 4292270819 4291284185 4285233565 4066800809 1551994565 16777471 0 0 4291547356 4291547356 4291547356 4291547356 4291547356 4291547356 4291547356 4287929784 4016798124 545033153 0 0 4290889943 4290889943 4290889943 4290889943 4290889943 4290889943 4290889943 4290889943 4287009457 3379658160 61516543 0 4290297809 4290297809 4290297809 4290297809 4290297809 4290297809 4290297809 4290297809 4290166480 4234639009 2003992240 33554431 4289706189 4289706189 4289706189 4289706189 4289706189 4289706189 4289706189 4289706189 4289706189 4286286508 3949425826 258373546 4289114568 4289114568 4289114568 4289114568 4289114568 4289114568 4289114568 4289114568 4289114568 4286747057 4167135387 896300710 4288654276 4288654276 4288654276 4288654276 4288654276 4288654276 4288654276 4288654276 4288654276 4285760937 4250693017 1785229980 4288128705 4288128705 4288128705 4288128705 4288128705 4288128705 4288128705 4288128705 4287471035 4284446367 4284314268 2841668498 4286353587 4286353587 4286353587 4286353587 4286353587 4286353587 4286353587 4286353587 4285038503 4284578211 4284578211 3663554701)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 10/3/2008 13:26'!
scrollbarThumbLeftForm
	"Answer the form to use for the left of a horizontal scrollbar."

	^self forms at: #sbHThumbLeft ifAbsent: [Form extent: 7@13 depth: Display depth]! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 1/22/2009 14:35'!
newButtonSquareSelectedBottomRightForm
	"Answer the form for the bottom right of a selected square button."

	^(Form
	extent: 12@12
	depth: 32
	fromArray: #( 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 3931727240 4285171117 4285171117 4285171117 4285171117 4285171117 4285171117 4285171117 4285171117 4285171117 4285171117 4285170861 3931595651 4285500082 4285500082 4285500082 4285500082 4285500082 4285500082 4285500082 4285500082 4285500082 4285500082 4285500082 3931464061 4285763767 4285763767 4285763511 4285763511 4285763511 4285763511 4285763511 4285763511 4285763511 4285763511 4285763511 3931200888 4286092732 4286092732 4286092732 4286092732 4286092732 4286092732 4286092732 4286092732 4286092732 4286092732 4286092732 3931003251 4286356417 4286356160 4286356160 4286356160 4286356160 4286356160 4286356160 4286356160 4286356160 4286356160 4286356160 3930871661 4286685381 4286685381 4286685381 4286685381 4286685381 4286685381 4286685381 4286685381 4286685381 4286685381 4286685381 3930674280 4286948810 4286948810 4286948810 4286948810 4286948810 4286948810 4286948810 4286948810 4286948810 4286948810 4286948810 3930476899 4287278031 4287278031 4287278031 4287278031 4287278031 4287278031 4287278031 4287278031 4287278031 4287278031 4287278031 3930345054 4287606996 4287606996 4287606996 4287606996 4287606996 4287606996 4287606996 4287541460 4287541460 4287541460 4286948549 3778691918 4285038229 4285038229 4285038229 4285038485 4285038485 4285038485 4285038485 4285038485 4285038485 4284841105 4232796519 2452040237 3442226232 3442226232 3442226232 3442226232 3442226232 3442226232 3442226232 3442226232 3442226232 3392025400 2351311407 622599196)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'GaryChambers 11/16/2011 16:35'!
buttonColouredMiddleColor
	"Return the middle area colour for a coloured button fillStyle."
	
	^Color r: 102 g: 127 b: 168 range: 255! !

!UIThemeWatery methodsFor: 'accessing' stamp: 'gvc 2/16/2009 17:22'!
windowActiveDropShadowStyle: anObject
	"Set the value of windowActiveDropShadowStyle"

	windowActiveDropShadowStyle := anObject! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 10/7/2008 12:26'!
windowActiveTitleFillStyleFor: aWindow
	"Return the window active title fillStyle for the given window."
	
	|aColor|
	aColor := self windowColor.
	^(GradientFillStyle ramp: {
			0.0->aColor twiceLighter.
			1.0->aColor})	
		origin: aWindow labelArea topLeft;
		direction: 0 @ aWindow labelHeight;
		radial: false! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 12/8/2008 14:00'!
buttonTopMiddleForm
	"Answer the form to use for the top middle of a button."

	^self forms at: #buttonTopMiddle ifAbsent: [Form extent: 1@12 depth: Display depth]! !

!UIThemeWatery methodsFor: 'defaults' stamp: 'GaryChambers 8/18/2010 17:16'!
dropListFocusIndicatorCornerRadiusFor: aDropList
	"Answer the default corner radius preferred for the focus indicator
	for the drop list for themes that support this."

	^aDropList wantsRoundedCorners
		ifTrue: [7]
		ifFalse: [2]! !

!UIThemeWatery methodsFor: 'border-styles' stamp: 'MarcusDenker 7/22/2013 13:50'!
worldMainDockingBarBorderStyleFor: aDockingBar
	"Return the world main docking bar borderStyle for the given docking bar."

	^BorderStyle simple
		width: 0;
		color: Color transparent! !

!UIThemeWatery methodsFor: 'fill-styles-scrollbars' stamp: 'gvc 10/3/2008 13:33'!
scrollbarNormalThumbFillStyleFor: aScrollbar
	"Return the normal scrollbar thumb fillStyle for the given scrollbar."
	
	^aScrollbar bounds isWide
		ifTrue: [self scrollbarNormalHorizontalThumbFillStyleFor: aScrollbar]
		ifFalse: [self scrollbarNormalVerticalThumbFillStyleFor: aScrollbar]! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 12/8/2008 18:40'!
radioButtonSelectedForm
	"Answer the form to use for a selected radio button."

	^self forms at: #radioButtonSelected ifAbsent: [Form extent: 14@14 depth: Display depth]! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 1/22/2009 15:17'!
newButtonBottomLeftForm
	"Answer the form for the bottom left of a button."

	^(Form
	extent: 12@12
	depth: 32
	fromArray: #( 3716317826 4291743438 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 2842718320 4290953922 4292401368 4292401368 4292401368 4292401368 4292401368 4292401368 4292401368 4292401368 4292401368 4292401368 1784635231 4255886251 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 978802519 4170157967 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 374427985 3815599469 4291611852 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 41975936 1699499084 4168973693 4293190884 4293454056 4293454056 4293454056 4293454056 4293454056 4293454056 4293454056 4293454056 0 154745145 2891010385 4271873951 4293717228 4293717228 4293717228 4293717228 4293717228 4293717228 4293717228 4293717228 0 16777216 675299392 3764280926 4290098613 4293980400 4294046193 4294046193 4294046193 4294046193 4294046193 4294046193 0 0 33554432 1295332661 3595850836 4253583496 4292993505 4294309365 4294309365 4294309365 4294309365 4294309365 0 0 0 33554432 640626479 2688433726 4083574374 4289835441 4293125091 4294506744 4294572537 4294572537 0 0 0 0 16777216 138428480 1546267178 3510780482 3981989976 4184895600 4270360712 4288651167 0 0 0 0 0 0 33554432 338044454 941629472 1511989023 2268016431 3124575549)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'defaults' stamp: 'StephaneDucasse 9/7/2013 13:10'!
tabLabelInsetFor: aButton
	"Answer the inset to use for a tab label."
	^ Margin left: 8 top: 2 right: 8 bottom: 2
! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'MarcusDenker 7/22/2013 13:50'!
newWindowMenuPassiveForm
	"Answer a new form for a window menu box when inactive."

	^(Form
	extent: 24@16
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4294046193 4291085508 4289111718 4287927444 4287664272 4287730065 4287730065 4287730065 4287730065 4287730065 4287730065 4287730065 4287730065 4287664272 4287927444 4289111718 4291085508 4294046193 0 0 0 0 0 4293980400 4290164406 4288782753 4290953922 4292269782 4292664540 4292861919 4292796126 4292796126 4292861919 4292861919 4292796126 4292796126 4292861919 4292664540 4292269782 4290953922 4288782753 4290164406 4293980400 0 0 0 0 4291085508 4288651167 4291546059 4293388263 4293914607 4294111986 4294243572 4294243572 4294243572 4294243572 4294243572 4294243572 4294243572 4294243572 4294111986 4293914607 4293388263 4291546059 4288651167 4291085508 0 0 0 0 4289177511 4290361785 4292401368 4293322470 4293585642 4293651435 4293651435 4293651435 4293651435 4293651435 4293651435 4293651435 4293651435 4293651435 4293651435 4293585642 4293322470 4292401368 4290361785 4289177511 0 0 0 0 4288190616 4291348680 4292664540 4292993505 4293190884 4293190884 4293256677 4293256677 4293190884 4293190884 4293190884 4293190884 4293256677 4293256677 4293190884 4293190884 4292993505 4292664540 4291348680 4288190616 0 0 0 0 4288322202 4291809231 4293125091 4293585642 4293783021 4293848814 4293914607 4293848814 4293914607 4293914607 4293914607 4293914607 4293848814 4293914607 4293848814 4293783021 4293585642 4293125091 4291809231 4288322202 0 0 0 0 4289374890 4291546059 4293190884 4294046193 4294572537 4294769916 4294704123 4294769916 4294704123 4294769916 4294769916 4294704123 4294769916 4294704123 4294769916 4294572537 4294046193 4293190884 4291546059 4289374890 0 0 0 0 4291019715 4289309097 4292730333 4294046193 4294769916 4294835709 4294901502 4294901502 4294901502 4294901502 4294901502 4294901502 4294901502 4294901502 4294835709 4294769916 4294046193 4292730333 4289309097 4291019715 0 0 0 0 4293717228 4290624957 4289045925 4291414473 4292927712 4293585642 4293717228 4293717228 4293717228 4293717228 4293717228 4293717228 4293717228 4293717228 4293783021 4293256677 4291414473 4289045925 4290624957 4293717228 0 0 0 0 4293651435 4293717228 4291480266 4289440683 4287927444 4287466893 4287532686 4287532686 4287532686 4287532686 4287532686 4287532686 4287532686 4287532686 4287466893 4287993237 4289440683 4291480266 4293717228 4293651435 0 0 0 0 0 4293585642 4293585642 4293651435 4293651435 4293914607 4293914607 4293914607 4293914607 4293914607 4293914607 4293914607 4293914607 4293914607 4293783021 4293651435 4293651435 4293585642 4293585642 0 0 0 0 0 0 0 4293454056 4293651435 4293717228 4293848814 4293848814 4293848814 4293848814 4293848814 4293848814 4293848814 4293848814 4293848814 4293848814 4293717228 4293651435 4293454056 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 10/9/2008 13:26'!
dockingBarNormalFillStyleFor: aToolDockingBar
	"Return the normal docking bar fillStyle for the given color."
	
	^aToolDockingBar paneColor! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 1/22/2009 15:24'!
buttonSquareTopLeftForm
	"Answer the form to use for the top left of a square button."

	^self forms at: #buttonSquareTopLeft ifAbsent: [Form extent: 12@12 depth: Display depth]! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'MarcusDenker 7/22/2013 13:50'!
resizerGripNormalFillStyleFor: aResizer
	"Return the normal fillStyle for the given resizer.
	For the moment, answer a transparent colour for no drawing,
	non transparent to draw as normal."
	
	^Color transparent! !

!UIThemeWatery methodsFor: 'border-styles-buttons' stamp: 'gvc 12/9/2008 13:06'!
checkboxButtonDisabledBorderStyleFor: aCheckboxButton
	"Return the disabled checkbox button borderStyle for the given button."

	^self checkboxButtonNormalBorderStyleFor: aCheckboxButton! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 12/8/2008 14:00'!
buttonMiddleRightForm
	"Answer the form to use for the middle right of a button."

	^self forms at: #buttonMiddleRight ifAbsent: [Form extent: 11@1 depth: Display depth]! !

!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'MarcusDenker 7/22/2013 13:50'!
menuItemSelectedFillStyleFor: aMenuItem
	"Answer the selected fill style to use for the given menu item."
	
	| fill baseColor preferenced |
	Display depth <= 2 ifTrue: [^ Color gray].
	preferenced := self settings menuSelectionColor.
	baseColor := preferenced isNil
		ifTrue: [aMenuItem owner color negated]
		ifFalse: [preferenced].
	self preferGradientFill
		ifFalse: [^baseColor].
	fill := GradientFillStyle ramp: {0.0 -> baseColor twiceLighter . 1 -> baseColor twiceDarker}.
	fill
		origin: aMenuItem topLeft;
		direction: 0@aMenuItem height.
	^ fill! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 10/3/2008 13:22'!
newScrollbarThumbVerticalMiddleForm
	"Answer the form for the middle of a vertical scrollbar thumb."

	^(Form
	extent: 13@1
	depth: 32
	fromArray: #( 4284182411 4288326078 4287931577 4287602613 4287208113 4286879149 4286484649 4286155685 4285761185 4285432221 4285103257 4284709013 4282669690)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 1/22/2009 14:28'!
newButtonSelectedMiddleRightForm
	"Answer the form for the middle right of a selected button."

	^(Form
	extent: 12@1
	depth: 32
	fromArray: #( 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 3931727240)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'fill-styles-scrollbars' stamp: 'gvc 2/3/2009 14:28'!
scrollbarImageColorFor: aScrollbar
	"Return the scrollbar image colour (on buttons) for the given scrollbar."
	
	^(self baseScrollbarColorFor: aScrollbar) darker! !

!UIThemeWatery methodsFor: 'label-styles' stamp: 'MarcusDenker 7/22/2013 13:50'!
createMenuBoxFor: aSystemWindow
	"Answer a button for the window menu."
	
	|form msb|
	form := self windowMenuForm.
	msb := MultistateButtonMorph new extent: form extent.
	msb activeEnabledNotOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowMenuPassiveForm.
	msb extent: form extent.
	msb passiveEnabledNotOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowMenuOverForm.
	msb extent: form extent.
	msb
		activeEnabledOverUpFillStyle: (ImageFillStyle form: form);
		passiveEnabledOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowMenuPassiveForm.
	msb
		extent: form extent;
		activeEnabledOverDownFillStyle: (ImageFillStyle form: form);
		passiveEnabledOverDownFillStyle: (ImageFillStyle form: form);
		addUpAction: [aSystemWindow offerWindowMenu];
		setBalloonText: 'Window menu' translated;
		extent: form extent.
	^msb! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 1/22/2009 14:35'!
newButtonSquareSelectedBottomLeftForm
	"Answer the form for the bottom left of a selected square button."

	^(Form
	extent: 12@12
	depth: 32
	fromArray: #( 3965347464 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 3965215874 4285171117 4285171117 4285171117 4285171117 4285171117 4285171117 4285171117 4285171117 4285171117 4285171117 4285171117 3964952703 4285500082 4285500082 4285500082 4285500082 4285500082 4285500082 4285500082 4285500082 4285500082 4285500082 4285500082 3964821113 4285763767 4285763767 4285763767 4285763767 4285763767 4285763767 4285763767 4285763767 4285763767 4285763767 4285763767 3964623476 4286092732 4286092732 4286092732 4286092732 4286092732 4286092732 4286092732 4286092732 4286092732 4286092732 4286092732 3964426350 4286421953 4286421953 4286421953 4286421953 4286356417 4286356417 4286356417 4286356417 4286356417 4286356417 4286356417 3964294248 4286685382 4286685382 4286685382 4286685382 4286685382 4286685382 4286685382 4286685382 4286685381 4286685381 4286685381 3964097124 4287014602 4287014602 4287014602 4287014346 4287014346 4287014346 4287014346 4287014346 4287014346 4287014346 4287014346 3963833950 4287278031 4287278031 4287278031 4287278031 4287278031 4287278031 4287278031 4287278031 4287278031 4287278031 4287278031 3829154896 4287211978 4287607252 4287606996 4287606996 4287606996 4287606996 4287606996 4287606996 4287606996 4287606996 4287606996 2502502958 4249705579 4284972435 4285038229 4285038229 4285038229 4285038229 4285038229 4285038229 4285038229 4285038229 4285038229 622599196 2351311407 3408802615 3442226232 3442226232 3442226232 3442226232 3442226232 3442226232 3442226232 3442226232 3442226232)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 1/22/2009 15:20'!
newButtonSquareBottomRightForm
	"Answer the form for the bottom right of a square button."

	^(Form
	extent: 12@12
	depth: 32
	fromArray: #( 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 3934750599 4292401368 4292401368 4292401368 4292401368 4292401368 4292401368 4292401368 4292401368 4292401368 4292401368 4292335575 3934421634 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 3934158462 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 3933895290 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 3933632118 4293454056 4293454056 4293454056 4293454056 4293454056 4293454056 4293454056 4293454056 4293454056 4293454056 4293454056 3933368946 4293717228 4293717228 4293717228 4293717228 4293717228 4293717228 4293717228 4293717228 4293717228 4293717228 4293717228 3933039981 4294046193 4294046193 4294046193 4294046193 4294046193 4294046193 4294046193 4294046193 4294046193 4294046193 4294046193 3932776809 4294309365 4294309365 4294309365 4294309365 4294309365 4294309365 4294309365 4294309365 4294309365 4294309365 4294309365 3932447844 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4293388263 3780400212 4289506476 4289506476 4289506476 4289506476 4289506476 4289506476 4289506476 4289506476 4289506476 4289243304 4235556213 2452565807 3443342653 3443342653 3443342653 3443342653 3443342653 3443342653 3443342653 3443342653 3443342653 3393076798 2352034097 622599196)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'GaryChambers 11/16/2011 17:17'!
dropListNormalFillStyleFor: aDropList
	"Return the normal fillStyle for the given drop list."
	
	|round roundCorners tl t tr l m r bl b br|
	round := aDropList wantsRoundedCorners.
	roundCorners := aDropList roundedCorners.
	tl := (round and: [roundCorners includes: 1]) ifTrue: [self buttonTopLeftForm] ifFalse: [self buttonSquareTopLeftForm].
	t := self buttonTopMiddleForm.
	tr:= (round and: [roundCorners includes: 4]) ifTrue: [self buttonTopRightForm] ifFalse: [self buttonSquareTopRightForm].
	l := self buttonMiddleLeftForm. m := self buttonPlainMiddleColor. r := self buttonMiddleRightForm.
	bl := (round and: [roundCorners includes: 2]) ifTrue: [self buttonBottomLeftForm] ifFalse: [self buttonSquareBottomLeftForm].
	b := self buttonBottomMiddleForm.
	br := (round and: [roundCorners includes: 3]) ifTrue: [self buttonBottomRightForm] ifFalse: [self buttonSquareBottomRightForm].
	^self
		multiFormFillStyleFrom: {tl. t. tr. l. m. r. bl. b. br}
		in: aDropList bounds! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 1/22/2009 15:19'!
newButtonSquareBottomLeftForm
	"Answer the form for the bottom left of a square button."

	^(Form
	extent: 12@12
	depth: 32
	fromArray: #( 3968305031 4292138196 4292138196 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 3967976066 4292401368 4292401368 4292401368 4292401368 4292401368 4292401368 4292401368 4292401368 4292401368 4292401368 4292401368 3967778687 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 3967449722 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 3967252343 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 3966923378 4293454056 4293454056 4293454056 4293454056 4293454056 4293454056 4293454056 4293454056 4293454056 4293454056 4293454056 3966660206 4293783021 4293783021 4293783021 4293783021 4293783021 4293783021 4293783021 4293783021 4293717228 4293717228 4293717228 3966397034 4294046193 4294046193 4294046193 4294046193 4294046193 4294046193 4294046193 4294046193 4294046193 4294046193 4294046193 3966133862 4294309365 4294309365 4294309365 4294309365 4294309365 4294309365 4294309365 4294309365 4294309365 4294309365 4294309365 3830929239 4293783021 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 2502963248 4252596601 4289309097 4289506476 4289506476 4289506476 4289506476 4289506476 4289506476 4289506476 4289506476 4289506476 622599196 2352034097 3409854014 3443342653 3443342653 3443342653 3443342653 3443342653 3443342653 3443342653 3443342653 3443342653)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 1/22/2009 14:28'!
newButtonSelectedBottomLeftForm
	"Answer the form for the bottom left of a selected button."

	^(Form
	extent: 12@12
	depth: 32
	fromArray: #( 3713688967 4284841382 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 2840812155 4284841122 4285170861 4285170861 4285170861 4285170861 4285170861 4285170861 4285170861 4285170861 4285170861 4285170861 1783452780 4251022487 4285499826 4285499826 4285499826 4285499826 4285499826 4285499826 4285499826 4285499826 4285499826 4285499826 977750885 4166608772 4285763511 4285763511 4285763511 4285763511 4285763511 4285763511 4285763511 4285763511 4285763511 4285763511 373704285 3813365101 4285499564 4286092476 4286092476 4286092476 4286092476 4286092476 4286092476 4286092476 4286092476 4286092476 33554560 1698382676 4166082166 4286224317 4286356160 4286356160 4286356160 4286356160 4286356160 4286356160 4286356160 4286356160 0 154745173 2889761365 4267668108 4286685125 4286685125 4286685125 4286685125 4286685125 4286685125 4286685125 4286685125 0 16777216 674444102 3762375258 4285103772 4286948554 4286948554 4286948554 4286948554 4286948554 4286948554 4286948554 0 0 33554432 1294675516 3594273360 4250231929 4286619071 4287277775 4287277775 4287277775 4287277775 4287277775 0 0 0 33554432 640165935 2687513663 4081274461 4285169818 4286882243 4287606740 4287606740 4287606740 0 0 0 0 16777216 134234176 1545872426 3509597758 3980150095 4182267235 4267009399 4284642698 0 0 0 0 0 0 33554432 338044454 941629472 1511791647 2267424813 3123524408)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'MarcusDenker 7/22/2013 13:50'!
worldMainDockingBarNormalFillStyleFor: aDockingBar
	"Return the world main docking bar fillStyle for the given docking bar."
	
	|aColor|
	aColor := aDockingBar originalColor alpha: 0.7.
	^(GradientFillStyle ramp: {
			0.0->(aColor alphaMixed: 0.3 with: (Color white alpha: aColor alpha)).
			0.8->aColor darker.
			1.0->aColor darker duller})
		origin: aDockingBar topLeft;
		direction: (aDockingBar isVertical
			ifTrue: [aDockingBar width @ 0]
			ifFalse: [0 @ aDockingBar height]);
		radial: false! !

!UIThemeWatery methodsFor: 'label-styles' stamp: 'MarcusDenker 7/22/2013 13:50'!
windowMinimizePassiveForm
	"Answer the form to use for passive (background) window minimize buttons"

	^self forms at: #windowMinimizePassive ifAbsent: [Form extent: 16@16 depth: Display depth]! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'MarcusDenker 7/22/2013 13:50'!
newWindowMaximizeOverForm
	"Answer a new form for a window maximize box for use when the mouse is over it."

	^(Form
	extent: 16@16
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4290295992 4285822068 4282071867 4279440147 4279440147 4282071867 4285822068 4290295992 0 0 0 0 0 0 0 4287269514 4281611316 4282795590 4285953654 4287664528 4287730320 4285953654 4282861383 4281611316 4287269514 0 0 0 0 0 4287137928 4280360481 4283914839 4288455580 4291547084 4288980902 4289046437 4291547341 4288390044 4283980376 4280294689 4287203721 0 0 0 4290164406 4281348144 4282010170 4285369453 4288527772 4287405445 4284113749 4284113749 4287405445 4288593820 4285303917 4282009913 4281348144 4290164406 0 0 4286479998 4280431648 4282282296 4283995198 4286033222 4284581178 4282209061 4282274853 4284515642 4285967429 4284060735 4282216504 4280497696 4286545791 0 0 4282402111 4281097769 4282549797 4282216466 4283070226 4283793437 4281749780 4281684244 4283661853 4283201813 4282282258 4282484773 4281097769 4282402111 0 0 4279972116 4282219307 4282347796 4281355787 4281750291 4282210588 4282276125 4282144028 4282210588 4281881876 4281421323 4282544916 4282219308 4280037908 0 0 4279975186 4283600171 4283531037 4281815829 4282473504 4282604837 4282999593 4282999594 4282736679 4282539552 4281881621 4283662365 4283600683 4280172817 0 0 4282736189 4284126245 4286692666 4285175604 4285832770 4286424651 4283657010 4283657267 4286490700 4285898818 4285175604 4286758970 4284126756 4282803005 0 0 4286284920 4283533850 4287283524 4288731993 4289718632 4287346007 4284118074 4284183610 4287478106 4289850729 4288797788 4287415878 4283599642 4286350968 0 0 4290362041 4283331374 4286560575 4289322854 4290770809 4288134753 4284511807 4284577344 4288200290 4290903163 4289455464 4286889281 4283462959 4290362040 0 0 4292664540 4287928465 4283793702 4288007509 4290572412 4291689100 4288920687 4288920687 4291885710 4290900861 4288666201 4284122406 4287928465 4292664540 0 0 0 4292993505 4288059538 4284842051 4286688328 4289384043 4290962050 4291224710 4289646450 4287083084 4285171781 4287928466 4292993505 0 0 0 0 0 4292927712 4291217093 4287402885 4285630033 4284907832 4284973881 4285893715 4287468677 4291348680 4292927712 0 0 0 0 0 0 0 4292401368 4293125091 4293454056 4293190884 4293190884 4293190884 4293125091 4292401368 0 0 0 0)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 1/22/2009 14:30'!
buttonSelectedBottomLeftForm
	"Answer the form to use for the bottom left of a selected button."

	^self forms at: #buttonSelectedBottomLeft ifAbsent: [Form extent: 12@12 depth: Display depth]! !

!UIThemeWatery methodsFor: 'defaults' stamp: 'StephaneDucasse 9/7/2013 13:10'!
buttonLabelInsetFor: aButton
	"Answer the inset to use for a button's label."

	|left right|
	^aButton wantsRoundedCorners
		ifTrue: [left := ((aButton roundedCorners includesAnyOf: #(1 2)) ifTrue: [8] ifFalse: [4]).
				right := ((aButton roundedCorners includesAnyOf: #(3 4)) ifTrue: [8] ifFalse: [4]).
				Margin left: left top: 2 right: right bottom: 2]		
		ifFalse: [3@2]! !

!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'GaryChambers 8/17/2010 14:38'!
controlButtonDisabledFillStyleFor: aButton
	"Return the disabled control button fillStyle for the given button.
	Control buttons are generally used for drop-lists and expanders."
	
	^self controlButtonSelectedFillStyleFor: aButton! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 1/22/2009 15:23'!
buttonSquareBottomRightForm
	"Answer the form to use for the bottom right of a square button."

	^self forms at: #buttonSquareBottomRight ifAbsent: [Form extent: 12@12 depth: Display depth]! !

!UIThemeWatery methodsFor: 'border-styles' stamp: 'gvc 12/9/2008 12:08'!
listNormalBorderStyleFor: aList
	"Return the normal borderStyle for the given list"

	^BorderStyle simple
		width: 1;
		baseColor: aList paneColor! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 10/3/2008 13:22'!
newScrollbarThumbLeftForm
	"Answer the form for the left hand side of a scrollbar thumb."

	^(Form
	extent: 7@13
	depth: 32
	fromArray: #( 0 0 1149473452 2033601901 2906411633 4284182411 4284182411 0 422725477 2755548019 4284182411 4284445326 4286287012 4287142063 0 2083867754 4284050825 4285037205 4287536820 4287931577 4287931577 1345735788 2671004523 4284248204 4287339698 4287602613 4287602613 4287602613 1999981163 4283787654 4285958562 4287208113 4287208113 4287208113 4287208113 2671004523 4283656068 4286681770 4286879149 4286879149 4286879149 4286879149 2671004523 4283656325 4286484649 4286484649 4286484649 4286484649 4286484649 2671004523 4283392897 4286155685 4286155685 4286155685 4286155685 4286155685 2167753578 4283195776 4285037464 4285761185 4285761185 4285761185 4285761185 1580616556 3023786609 4283656069 4285432221 4285432221 4285432221 4285432221 171134054 2688176497 4282998397 4283919242 4285103257 4285103257 4285103257 0 926700403 3023720559 4282801275 4283261825 4284182670 4284577427 0 73298833 1262704758 2503363949 3023720303 4282669690 4282669690)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 12/9/2008 12:43'!
checkboxForm
	"Answer the form to use for a normal checkbox."

	^self forms at: #checkbox ifAbsent: [Form extent: 14@14 depth: Display depth]! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'BenjaminVanRyseghem 11/26/2013 23:06'!
textFieldNormalFillStyleFor: aTextField
	"Return the normal fillStyle for the given text field."
	
	^ Color white! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'GaryChambers 2/15/2011 12:47'!
windowInactiveFillStyleFor: aWindow
	"Return the window inactive fillStyle for the given window."
	
	^self settings fadedBackgroundWindows
		ifTrue: [self windowColor muchLighter]
		ifFalse: [self windowColor]
! !

!UIThemeWatery methodsFor: 'border-styles-scrollbars' stamp: 'MarcusDenker 7/22/2013 13:50'!
scrollbarNormalButtonBorderStyleFor: aScrollbar
	"Return the normal button borderStyle for the given scrollbar."

	^BorderStyle simple
		width: 0! !

!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'MarcusDenker 7/22/2013 13:50'!
buttonFocusBoundsFor: aButton
	"Answer the bounds for drawing the focus indication for the
	given button."

	^aButton bounds! !

!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'gvc 1/28/2009 17:55'!
controlButtonPressedFillStyleFor: aButton
	"Return the pressed button fillStyle for the given button.
	Control buttons are generally used for drop-lists and expanders."
	
	^self controlButtonSelectedFillStyleFor: aButton! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 1/22/2009 14:30'!
buttonSelectedBottomRightForm
	"Answer the form to use for the bottom right of a selected button."

	^self forms at: #buttonSelectedBottomRight ifAbsent: [Form extent: 12@12 depth: Display depth]! !

!UIThemeWatery methodsFor: 'defaults' stamp: 'StephaneDucasse 9/7/2013 13:10'!
dropListInsetFor: aDropList
	"Answer the inset to use for drop-list layout."
	
	^ Margin left: 6 top: 0 right: 0 bottom: 0
	! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 10/3/2008 13:28'!
scrollbarThumbTopForm
	"Answer the form to use for the top of a vertical scrollbar."

	^self forms at: #sbVThumbTop ifAbsent: [Form extent: 13@7 depth: Display depth]! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'MarcusDenker 7/22/2013 13:50'!
progressBarProgressFillStyleFor: aProgressBar
	"Return the progress bar progress fillStyle for the given progress bar."
	
	|area c|
	c := self progressBarProgressColorFor: aProgressBar.
	area :=  aProgressBar bounds.
	^(GradientFillStyle ramp: {
			0.0->c twiceDarker.
			0.2->c twiceLighter lighter.
			0.3->c twiceLighter lighter.
			0.4->c darker.
			0.6->c twiceLighter lighter.
			1.0->Color white})
		origin: area origin;
		direction: 0@area height;
		radial: false! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'MarcusDenker 7/22/2013 13:50'!
textEditorDisabledFillStyleFor: aTextEditor
	"Return the disabled fillStyle for the given text editor."
	
	^self windowColor lighter! !

!UIThemeWatery methodsFor: 'fill-styles-scrollbars' stamp: 'gvc 2/3/2009 14:28'!
scrollbarNormalButtonFillStyleFor: aScrollbar
	"Return the normal scrollbar button fillStyle for the given scrollbar."
	
	|c|
	c := self baseScrollbarColorFor: aScrollbar.
	^(GradientFillStyle ramp: {0.0->c twiceLighter. 1.0->c darker})
		origin: aScrollbar topLeft;
		direction: (aScrollbar bounds isWide
			ifTrue: [0 @ aScrollbar height]
			ifFalse: [aScrollbar width @ 0]);
		radial: false! !

!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'GaryChambers 11/16/2011 16:36'!
buttonColouredFillStyleFor: aButton
	"Return the coloured button fillStyle for the given button."
	
	|round roundCorners tl t tr l m r bl b br|
	round := aButton wantsRoundedCorners.
	roundCorners := aButton roundedCorners.
	tl := (round and: [roundCorners includes: 1]) ifTrue: [self buttonSelectedTopLeftForm] ifFalse: [self buttonSquareSelectedTopLeftForm].
	t := self buttonSelectedTopMiddleForm.
	tr:= (round and: [roundCorners includes: 4]) ifTrue: [self buttonSelectedTopRightForm] ifFalse: [self buttonSquareSelectedTopRightForm].
	l := self buttonSelectedMiddleLeftForm. m := self buttonColouredMiddleColor. r := self buttonSelectedMiddleRightForm.
	bl := (round and: [roundCorners includes: 2]) ifTrue: [self buttonSelectedBottomLeftForm] ifFalse: [self buttonSquareSelectedBottomLeftForm].
	b := self buttonSelectedBottomMiddleForm.
	br := (round and: [roundCorners includes: 3]) ifTrue: [self buttonSelectedBottomRightForm] ifFalse: [self buttonSquareSelectedBottomRightForm].
	^self
		multiFormFillStyleFrom: {tl. t. tr. l. m. r. bl. b. br}
		in: aButton bounds! !

!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'GaryChambers 8/17/2010 14:08'!
buttonNormalFillStyleFor: aButton
	"Return the normal button fillStyle for the given button."
	
	^aButton isDefault 
		ifTrue: [self buttonColouredFillStyleFor: aButton]
		ifFalse: [self buttonPlainFillStyleFor: aButton]! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'MarcusDenker 7/22/2013 13:50'!
newTreeUnexpandedForm
	"Answer a new form for an unexpanded tree item."

	^(Form
	extent: 9@9
	depth: 32
	fromArray: #( 1049135240 461932680 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2324203656 4152920200 2458421384 428378248 16777215 16777215 16777215 16777215 16777215 2357758088 4287137928 4287137928 4152920200 2408089736 394823816 16777215 16777215 16777215 2391312520 4287137928 4287137928 4287137928 4287137928 4119365768 2324203656 344492168 16777215 2408089736 4287137928 4287137928 4287137928 4287137928 4287137928 4287137928 3968370824 780699784 2391312520 4287137928 4287137928 4287137928 4287137928 4236806280 2659747976 529041544 16777215 2357758088 4287137928 4287137928 4253583496 2810742920 646482056 16777215 16777215 16777215 2324203656 4253583496 2777188488 696813704 16777215 16777215 16777215 16777215 16777215 1200130184 663259272 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 1/22/2009 14:38'!
buttonSquareSelectedBottomRightForm
	"Answer the form to use for the bottom right of a selected square button."

	^self forms at: #buttonSquareSelectedBottomRight ifAbsent: [Form extent: 12@12 depth: Display depth]! !

!UIThemeWatery methodsFor: 'fill-styles-scrollbars' stamp: 'MarcusDenker 7/22/2013 13:50'!
useScrollbarThumbShadow
	"Answer whether a shadow morph should be displayed when
	dragging a scrollbar thumb."

	^false! !

!UIThemeWatery methodsFor: 'label-styles' stamp: 'MarcusDenker 7/22/2013 13:50'!
createCollapseBoxFor: aSystemWindow
	"Answer a button for minimising the window."
	
	|form msb|
	form := self windowMinimizeForm.
	msb := MultistateButtonMorph new extent: form extent.
	msb activeEnabledNotOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowMinimizePassiveForm.
	msb extent: form extent.
	msb passiveEnabledNotOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowMinimizeOverForm.
	msb extent: form extent.
	msb
		activeEnabledOverUpFillStyle: (ImageFillStyle form: form);
		passiveEnabledOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowMinimizePassiveForm.
	msb
		extent: form extent;
		activeEnabledOverDownFillStyle: (ImageFillStyle form: form);
		passiveEnabledOverDownFillStyle: (ImageFillStyle form: form);
		addUpAction: [aSystemWindow collapseBoxHit];
		setBalloonText: 'Collapse this window' translated;
		extent: aSystemWindow boxExtent.
	^msb! !

!UIThemeWatery methodsFor: 'fill-styles-scrollbars' stamp: 'EstebanLorenzano 4/29/2014 22:06'!
baseScrollbarColorFor: aScrollbar
	"Return the scrollbar last pane colour or that of our settings if unavailable"
	
	^ (aScrollbar valueOfProperty: #lastPaneColor) 
		ifNil: [ self scrollbarColor ]! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'MarcusDenker 7/22/2013 13:50'!
newWindowCloseForm
	"Answer a new form for a window close box."

	^(Form
	extent: 16@16
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4290361785 4285822068 4282071867 4279440147 4279440147 4282071867 4285822068 4290361785 0 0 0 0 0 0 0 4287335307 4281808438 4283254086 4286543478 4288254096 4288188560 4286543478 4283254086 4281808438 4287335307 0 0 0 0 0 4287138185 4280425243 4285027670 4289633180 4292135884 4293254878 4293320928 4292267469 4289567644 4285093206 4280490779 4287203978 0 0 0 4290164406 4282134834 4284233271 4288637549 4291401881 4292653234 4292850869 4292785333 4292653234 4291467161 4288637549 4284364600 4282266163 4290230199 0 0 4286545534 4283178015 4287182138 4289281086 4290597711 4290995037 4291126110 4291126109 4290929244 4290662991 4289281086 4287182394 4283309344 4286611327 0 0 4283383359 4285867306 4288685092 4289799715 4290590512 4290856252 4290988611 4291054147 4290922044 4290590256 4289930531 4288619300 4285867562 4283711040 0 0 4282782229 4287833644 4289996837 4290787376 4291381825 4291909968 4292173910 4292239446 4292106833 4291578692 4290984239 4290193702 4287833644 4283044630 0 0 4284026900 4289014315 4291051835 4291973448 4292633434 4293226345 4293556336 4293622129 4293358699 4292896092 4292236105 4291445307 4289014058 4284092436 0 0 4285414719 4289343786 4291712331 4293027933 4293949038 4294280317 4294479236 4294479236 4294346110 4294015086 4293224799 4291974475 4289343785 4285545791 0 0 4287264888 4288555300 4292239449 4293818479 4294542716 4294546314 4294614419 4294614676 4294546828 4294543230 4293884271 4292501850 4288751652 4287330424 0 0 4290558650 4286658615 4291253841 4293951868 4294481292 4294615447 4294617247 4294618017 4294616217 4294481550 4294214781 4291779154 4286789430 4290493114 0 0 4292664540 4288385426 4287573545 4292374633 4293892240 4294289824 4294555050 4294555308 4294356387 4293958547 4292835183 4287836460 4288385426 4292664540 0 0 0 4292993505 4288320403 4286993487 4289421400 4291463295 4292845463 4293043354 4291660419 4289684573 4287256400 4288254867 4292993505 0 0 0 0 0 4292927712 4291282630 4287858566 4286996058 4286533190 4286598726 4287324509 4287858309 4291348680 4292927712 0 0 0 0 0 0 0 4292401368 4293125091 4293454056 4293190884 4293190884 4293190884 4293125091 4292401368 0 0 0 0)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 1/22/2009 15:19'!
newButtonTopMiddleForm
	"Answer the form for the top middle of a button."

	^(Form
	extent: 1@12
	depth: 32
	fromArray: #( 3971199923 4293585642 4294111986 4293848814 4293585642 4293322470 4293190884 4293059298 4292927712 4292796126 4292796126 4292335575)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'border-styles-scrollbars' stamp: 'gvc 10/3/2008 11:45'!
scrollbarNormalThumbBorderStyleFor: aScrollbar
	"Return the normal thumb borderStyle for the given scrollbar."

	^BorderStyle simple width: 0! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'MarcusDenker 7/22/2013 13:50'!
taskbarFillStyleFor: aTaskbar
	"Return the taskbar fillStyle for the given taskbar."
	
	|aColor c cm cd cb|
	aColor := self settings scrollbarColor alphaMixed: 0.5 with: aTaskbar color.
	c := aColor  alphaMixed: 0.3 with: Color white.
	cm := aColor alphaMixed: 0.8 with: Color white.
	cd := aColor alphaMixed: 0.6 with: Color black.
	cb := aColor alphaMixed: 0.7 with: Color white.
	^(GradientFillStyle ramp: {0.0->c. 0.1->cm. 0.9->cd. 1.0->cb})
		origin: aTaskbar position;
		direction: 0@27;
		radial: false! !

!UIThemeWatery methodsFor: 'defaults' stamp: 'StephaneDucasse 9/7/2013 13:10'!
editableDropListMargins
	"Answer the text margins for an editable drop list for this theme."
	^ Margin left: 0 top: 3 right: 2 bottom: 1
	! !

!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'MarcusDenker 7/22/2013 13:50'!
buttonSelectedPressedFillStyleFor: aButton
	"Return the button selected pressed fillStyle for the given color."

	^self buttonNormalFillStyleFor: aButton! !

!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'gvc 12/8/2008 18:42'!
radioButtonSelectedFillStyleFor: aRadioButton
	"Return the selected radio button fillStyle for the given button."
	
	^(ImageFillStyle form: self radioButtonSelectedForm) origin: aRadioButton topLeft! !

!UIThemeWatery methodsFor: 'fill-styles-scrollbars' stamp: 'gvc 2/3/2009 14:29'!
scrollbarNormalFillStyleFor: aScrollbar
	"Return the normal scrollbar fillStyle for the given scrollbar."
	
	|aColor c|
	aColor := (self baseScrollbarColorFor: aScrollbar) muchLighter.
	c := aColor alphaMixed: 0.9 with: Color black.
	^(GradientFillStyle ramp: {0.0->c. 0.15->aColor. 0.75-> aColor lighter. 1.0->c})
		origin: aScrollbar topLeft;
		direction: (aScrollbar bounds isWide
			ifTrue: [0 @ aScrollbar height]
			ifFalse: [aScrollbar width @ 0]);
		radial: false! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 12/8/2008 18:40'!
radioButtonForm
	"Answer the form to use for a normal radio button."

	^self forms at: #radioButton ifAbsent: [Form extent: 14@14 depth: Display depth]! !

!UIThemeWatery methodsFor: 'defaults' stamp: 'gvc 12/5/2008 14:58'!
controlButtonLabelInsetFor: aButton
	"Answer the inset to use for a control button's label."

	^2! !

!UIThemeWatery methodsFor: 'border-styles' stamp: 'MarcusDenker 7/22/2013 13:50'!
drawTextAdornmentFor: aPluggableTextMorph color: aColor on: aCanvas
	"Indicate edit status for the given morph."
	
	|bounds size fillStyle|
	bounds := aPluggableTextMorph innerBounds.
	size := 25.
	fillStyle := (GradientFillStyle ramp: {
			0.0->(Color white alpha: 0.01).
			0.8->aColor.
			1.0->aColor})
		origin: bounds topRight - (size@0);
		direction: (size @ size negated) // 4;
		radial: false.
	aCanvas
		drawPolygon:  {bounds topRight. bounds topRight + (0@size). bounds topRight - (size@0)}
		fillStyle: fillStyle! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'MarcusDenker 7/22/2013 13:50'!
newWindowInactiveControlForm
	"Answer a new form for an inactive window control box."

	^(Form
	extent: 16@16
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4291677645 4288585374 4286085240 4284243036 4284243036 4286085240 4288585374 4291677645 0 0 0 0 0 0 0 4289572269 4285756275 4286479998 4288716960 4289835441 4289835441 4288716960 4286479998 4285756275 4289572269 0 0 0 0 0 4289506476 4284835173 4287335307 4290559164 4292598747 4293322470 4293322470 4292598747 4290559164 4287335307 4284703587 4289506476 0 0 0 4291546059 4285493103 4286414205 4288980132 4291217094 4292335575 4292598747 4292598747 4292335575 4291282887 4288980132 4286282619 4285493103 4291546059 0 0 4288980132 4285361517 4287466893 4288782753 4289835441 4290295992 4290295992 4290427578 4290164406 4289835441 4288782753 4287466893 4285361517 4288980132 0 0 4286282619 4286611584 4288059030 4288716960 4289177511 4289572269 4289835441 4289835441 4289703855 4289374890 4288782753 4288059030 4286611584 4286282619 0 0 4285164138 4287664272 4288782753 4289374890 4289835441 4290427578 4290624957 4290624957 4290559164 4290032820 4289374890 4288914339 4287664272 4285164138 0 0 4285361517 4288322202 4289703855 4290295992 4290822336 4291414473 4291677645 4291677645 4291414473 4291085508 4290427578 4289703855 4288453788 4285624689 0 0 4287072135 4288716960 4290427578 4291217094 4291677645 4292203989 4292598747 4292598747 4292335575 4291809231 4291217094 4290427578 4288716960 4287203721 0 0 4288980132 4288256409 4290624957 4291677645 4292335575 4292927712 4293256677 4293256677 4293059298 4292598747 4291809231 4290822336 4288256409 4289177511 0 0 4291677645 4287664272 4290295992 4292006610 4293059298 4293454056 4293585642 4293585642 4293454056 4293125091 4292203989 4290427578 4287730065 4291677645 0 0 4293256677 4290032820 4288124823 4291217094 4292796126 4293322470 4293717228 4293717228 4293454056 4292927712 4291677645 4288256409 4290032820 4293256677 0 0 0 4293454056 4290032820 4288322202 4289967027 4291546059 4292598747 4292664540 4291677645 4290295992 4288716960 4290032820 4293454056 0 0 0 0 0 4293322470 4292203989 4289835441 4288782753 4288322202 4288453788 4288980132 4289835441 4292335575 4293322470 0 0 0 0 0 0 0 4293059298 4293585642 4293717228 4293585642 4293585642 4293585642 4293585642 4293059298 0 0 0 0)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'GaryChambers 11/16/2011 16:36'!
buttonPlainMiddleColor
	"Return the middle area colour for a plain button fillStyle."
	
	^Color r: 211 g: 211 b: 211 range: 255! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 1/22/2009 15:21'!
newButtonSquareTopRightForm
	"Answer the form for the top right of a square button."

	^(Form
	extent: 12@12
	depth: 32
	fromArray: #( 3971199923 3971199923 3971199923 3971199923 3971199923 3971199923 3971199923 3971199923 3971199923 3954422707 3250240186 549042617 4293651435 4293651435 4293651435 4293651435 4293651435 4293651435 4293651435 4293651435 4293585642 4290690750 4289243304 2931341496 4294111986 4294111986 4294111986 4294111986 4294111986 4294111986 4294111986 4294111986 4294111986 4292598747 4289374890 3887182257 4293848814 4293848814 4293848814 4293848814 4293848814 4293848814 4293848814 4293848814 4293848814 4292664540 4289638062 3937184940 4293585642 4293585642 4293585642 4293585642 4293585642 4293585642 4293585642 4293585642 4293585642 4292532954 4289901234 3936987561 4293388263 4293388263 4293388263 4293388263 4293388263 4293388263 4293388263 4293388263 4293388263 4292467161 4290164406 3936658596 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4292401368 4290427578 3936329631 4293059298 4293059298 4293059298 4293059298 4293059298 4292993505 4292993505 4292993505 4292993505 4292335575 4290690750 3936132252 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292401368 4291019715 3935803287 4292796126 4292796126 4292861919 4292861919 4292861919 4292861919 4292861919 4292861919 4292861919 4292401368 4291282887 3935540115 4292796126 4292796126 4292796126 4292796126 4292796126 4292796126 4292796126 4292796126 4292796126 4292467161 4291546059 3935276943 4292335575 4292335575 4292335575 4292335575 4292335575 4292335575 4292335575 4292335575 4292335575 4292203989 4291809231 3935013771)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'border-styles-buttons' stamp: 'MarcusDenker 7/22/2013 13:50'!
buttonCornerStyleIn: aThemedMorph
	"Allow for themes to override default behaviour."
	
	^aThemedMorph
		ifNil: [#rounded]
		ifNotNil: [:tm | 
			tm preferredButtonCornerStyle
				ifNil: [#rounded]
				ifNotNil: [:bcs | bcs]]! !

!UIThemeWatery methodsFor: 'defaults' stamp: 'MarcusDenker 7/22/2013 13:50'!
treeLineWidth
	"Answer the width of the tree lines."

	^0! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 1/22/2009 15:18'!
newButtonMiddleLeftForm
	"Answer the form for the middle left of a button."

	^(Form
	extent: 12@1
	depth: 32
	fromArray: #( 3968305031 4292138196 4292138196 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'gvc 1/20/2010 12:02'!
controlButtonNormalFillStyleFor: aButton
	"Return the normal control button fillStyle for the given button.
	Control buttons are generally used for drop-lists and expanders."
	
	^self buttonSelectedFillStyleFor: aButton! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 10/3/2008 13:22'!
newScrollbarThumbHorizontalMiddleForm
	"Answer the form for the middle of a horizontal scrollbar thumb."

	^(Form
	extent: 1@13
	depth: 32
	fromArray: #( 4284182411 4288326078 4287931577 4287602613 4287208113 4286879149 4286484649 4286155685 4285761185 4285432221 4285103257 4284709013 4282669690)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'border-styles-buttons' stamp: 'gvc 1/28/2009 17:09'!
dropListControlButtonWidth
	"Answer the width of a drop list control button for this theme."
	
	^20! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 1/22/2009 14:31'!
buttonSelectedTopRightForm
	"Answer the form to use for the top right of a selected button."

	^self forms at: #buttonSelectedTopRight ifAbsent: [Form extent: 12@12 depth: Display depth]! !

!UIThemeWatery methodsFor: 'label-styles' stamp: 'MarcusDenker 7/22/2013 13:50'!
buttonLabelForText: aTextOrString
	"Answer the label to use for the given text."
	
	^aTextOrString isString
		ifTrue: [(FuzzyLabelMorph contents: aTextOrString)
					alpha: 0.3]
		ifFalse: [super buttonLabelForText: aTextOrString]! !

!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'gvc 12/9/2008 13:08'!
checkboxButtonDisabledFillStyleFor: aCheckboxButton
	"Return the disabled checkbox button fillStyle for the given button."
	
	^self checkboxButtonNormalFillStyleFor: aCheckboxButton! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'MarcusDenker 7/22/2013 13:50'!
progressBarFillStyleFor: aProgressBar
	"Return the progress bar fillStyle for the given progress bar."
	
	|area c|
	c := self progressBarColorFor: aProgressBar.
	area :=  aProgressBar bounds.
	^(GradientFillStyle ramp: {
			0.0->c twiceDarker.
			0.2->c twiceLighter lighter.
			0.3->c twiceLighter lighter.
			0.4->c darker.
			0.6->c twiceLighter lighter.
			1.0->Color white})
		origin: area origin;
		direction: 0@area height;
		radial: false! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 12/8/2008 12:41'!
buttonSelectedTopMiddleForm
	"Answer the form to use for the top middle of a selected button."

	^self forms at: #buttonSelectedTopMiddle ifAbsent: [Form extent: 1@12 depth: Display depth]! !

!UIThemeWatery methodsFor: 'morph creation' stamp: 'MarcusDenker 7/22/2013 13:50'!
newCloseControlIn: aThemedMorph for: aModel action: aValuable help: helpText
	"Answer a button for closing things."
	
	|form msb|
	form := self windowCloseForm.
	msb := MultistateButtonMorph new extent: form extent.
	msb activeEnabledNotOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowClosePassiveForm.
	msb extent: form extent.
	msb activeDisabledNotOverUpFillStyle: (ImageFillStyle form: form).
	msb passiveEnabledNotOverUpFillStyle: (ImageFillStyle form: form).
	msb passiveDisabledNotOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowCloseOverForm.
	msb extent: form extent.
	msb
		activeEnabledOverUpFillStyle: (ImageFillStyle form: form);
		passiveEnabledOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowClosePassiveForm.
	msb
		extent: form extent;
		activeEnabledOverDownFillStyle: (ImageFillStyle form: form);
		passiveEnabledOverDownFillStyle: (ImageFillStyle form: form);
		addUpAction: aValuable;
		setBalloonText: helpText.
	^msb! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 1/22/2009 14:38'!
buttonSquareSelectedTopRightForm
	"Answer the form to use for the top right of a selected square button."

	^self forms at: #buttonSquareSelectedTopRight ifAbsent: [Form extent: 12@12 depth: Display depth]! !

!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'GaryChambers 11/23/2011 14:15'!
tabLabelSelectedFillStyleFor: aTabLabel
	"Return the selected fillStyle for the given tab label."
	
	|round roundCorners tl t tr l m r|
	round := aTabLabel wantsRoundedCorners.
	roundCorners := aTabLabel roundedCorners.
	tl := (round and: [roundCorners includes: 1]) ifTrue: [self buttonSelectedTopLeftForm] ifFalse: [self buttonSquareSelectedTopLeftForm].
	t := self buttonSelectedTopMiddleForm.
	tr := (round and: [roundCorners includes: 4]) ifTrue: [self buttonSelectedTopRightForm] ifFalse: [self buttonSquareSelectedTopRightForm].
	l := self buttonSelectedMiddleLeftForm. m := self buttonColouredMiddleColor. r := self buttonSelectedMiddleRightForm.
	^self
		multiFormTopFillStyleFrom: {tl. t. tr. l. m. r}
		in: aTabLabel bounds! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 1/22/2009 14:29'!
newButtonSelectedTopMiddleForm
	"Answer the form for the top middle of a selected button."

	^(Form
	extent: 1@12
	depth: 32
	fromArray: #( 3966269361 4291941599 4292994026 4292205027 4291547356 4290889943 4290297809 4289640652 4289114568 4288588740 4288128705 4286353587)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'MarcusDenker 7/22/2013 13:50'!
newWindowMinimizeOverForm
	"Answer a new form for a window maximize box for use when the mouse is over it."

	^(Form
	extent: 16@16
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4290295992 4285953140 4282726971 4280619283 4280619283 4282661434 4285953140 4290295992 0 0 0 0 0 0 0 4287400586 4282921779 4284629572 4287526262 4288909456 4288974992 4287591798 4284761414 4282856243 4287400586 0 0 0 0 0 4287334536 4282588703 4286796631 4290682268 4292529868 4293385950 4293385950 4292529612 4290682268 4286731095 4282654242 4287400329 0 0 0 4290164406 4283247407 4286332215 4290281068 4292457116 4293447349 4293579448 4293579447 4293447349 4292457116 4290346605 4286660409 4283771952 4290164406 0 0 4287004286 4284555291 4289551160 4291461439 4292647750 4292978252 4292978510 4292978510 4292912459 4292516422 4291461695 4289485625 4285736224 4287004543 0 0 4284694079 4287316261 4291129383 4288438288 4288833808 4289097752 4289229341 4289164317 4289098008 4288965136 4288438544 4291130151 4288301098 4284694078 0 0 4285013269 4289947179 4288569618 4285154312 4285483537 4285615897 4285616412 4285616669 4285616153 4285549585 4285285641 4288766994 4290144044 4285013782 0 0 4286197779 4291263275 4289294360 4285287186 4285748254 4285420579 4285487142 4285618471 4285618211 4285814302 4285352722 4289491479 4291395115 4286263315 0 0 4286797373 4291592487 4294093364 4290152751 4290220603 4290222407 4290223436 4290223693 4290222920 4290220860 4290152751 4294225462 4291855399 4286928446 0 0 4287791736 4290870043 4294029633 4294691156 4294826081 4294894447 4294962297 4294963066 4294895474 4294892130 4294691669 4294096449 4291001115 4287857272 0 0 4290558649 4287916079 4292847677 4294431071 4294829938 4294964349 4294965892 4294966661 4294964606 4294896499 4294563169 4292980029 4287981872 4290558648 0 0 4292664540 4288452497 4288312611 4292590416 4294239351 4294636933 4294835601 4294835346 4294637704 4294306681 4293052245 4288576291 4288452497 4292664540 0 0 0 4292993505 4288321426 4287199810 4289700930 4291873639 4293321856 4293387137 4292005738 4290096709 4287463236 4288321426 4292993505 0 0 0 0 0 4292927712 4291282629 4287861124 4287137103 4286939445 4286939701 4287532112 4287926916 4291348680 4292927712 0 0 0 0 0 0 0 4292401368 4293125091 4293454056 4293190884 4293190884 4293190884 4293125091 4292401368 0 0 0 0)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'MarcusDenker 7/22/2013 13:50'!
windowActiveFillStyleFor: aWindow
	"Return the window active fillStyle for the given window."
	
	^self windowColor! !

!UIThemeWatery methodsFor: 'label-styles' stamp: 'EstebanLorenzano 4/30/2014 09:08'!
configureWindowLabelAreaFor: aWindow
	"Configure the label area for the given window."

	|padding|

	padding := 0.
	aWindow labelArea
		addMorphBack: (Morph new extent: aWindow class borderWidth @ 0).
	aWindow hasCloseBox ifTrue: [aWindow addCloseBox. padding := padding + 1].
	aWindow hasCollapseBox ifTrue: [aWindow addCollapseBox. padding := padding + 1].
	aWindow hasExpandBox ifTrue: [aWindow addExpandBox. padding := padding + 1].
	aWindow hasMenuBox ifTrue: [padding := padding - 1].
	aWindow labelArea
		addMorphBack: (Morph new extent: aWindow class borderWidth @ 0; hResizing: #spaceFill).
	aWindow basicLabel ifNotNil: [:label | 
		aWindow labelArea addMorphBack: label; hResizing: #shrinkWrap].
	aWindow labelArea
		addMorphBack: (Morph new extent: aWindow class borderWidth @ 0; hResizing: #spaceFill).
	padding > 0 ifTrue: [
		aWindow labelArea
			addMorphBack: (Morph new extent: (aWindow boxExtent x * padding) @ 0)].
	aWindow hasMenuBox ifTrue: [aWindow addMenuControl].
	aWindow labelArea
		addMorphBack: (Morph new extent: aWindow class borderWidth @ 0)! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'MarcusDenker 7/22/2013 13:50'!
newWindowMenuForm
	"Answer a new form for a window menu box."

	^(Form
	extent: 24@16
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4293125091 4287335307 4283453520 4281150765 4280690214 4280821800 4280821800 4280821800 4280821800 4280821800 4280821800 4280821800 4280821800 4280690214 4281150765 4283453520 4287335307 4293125091 0 0 0 0 0 4293059298 4285493103 4282795590 4287072135 4289638062 4290493371 4290822336 4290756543 4290756543 4290822336 4290822336 4290756543 4290756543 4290822336 4290493371 4289638062 4287072135 4282795590 4285493103 4293059298 0 0 0 0 4287335307 4282598211 4288322202 4291875024 4292927712 4293322470 4293519849 4293519849 4293519849 4293519849 4293519849 4293519849 4293519849 4293519849 4293322470 4292927712 4291875024 4288322202 4282598211 4287401100 0 0 0 0 4283585106 4285953654 4289967027 4291677645 4292269782 4292401368 4292401368 4292401368 4292335575 4292335575 4292335575 4292335575 4292401368 4292401368 4292401368 4292269782 4291677645 4289967027 4285953654 4283585106 0 0 0 0 4281742902 4287861651 4290493371 4291085508 4291480266 4291546059 4291611852 4291611852 4291546059 4291480266 4291480266 4291546059 4291611852 4291611852 4291546059 4291480266 4291085508 4290493371 4287861651 4281742902 0 0 0 0 4281940281 4288782753 4291414473 4292203989 4292664540 4292796126 4292927712 4292796126 4292861919 4292927712 4292927712 4292861919 4292796126 4292927712 4292796126 4292664540 4292203989 4291414473 4288782753 4281874488 0 0 0 0 4284045657 4288256409 4291546059 4293190884 4294177779 4294572537 4294440951 4294572537 4294506744 4294572537 4294572537 4294506744 4294572537 4294440951 4294572537 4294177779 4293190884 4291546059 4288256409 4284045657 0 0 0 0 4287269514 4283914071 4290624957 4293190884 4294638330 4294769916 4294835709 4294835709 4294835709 4294835709 4294835709 4294835709 4294835709 4294835709 4294769916 4294638330 4293190884 4290624957 4283914071 4287269514 0 0 0 0 4292467161 4286414205 4283387727 4287993237 4291019715 4292269782 4292467161 4292467161 4292467161 4292467161 4292467161 4292467161 4292467161 4292467161 4292598747 4291611852 4287993237 4283387727 4286414205 4292467161 0 0 0 0 4292401368 4292467161 4288124823 4284177243 4281150765 4280229663 4280361249 4280361249 4280361249 4280361249 4280361249 4280361249 4280361249 4280361249 4280229663 4281282351 4284177243 4288124823 4292467161 4292401368 0 0 0 0 0 4292203989 4292203989 4292335575 4292401368 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292664540 4292401368 4292335575 4292269782 4292203989 0 0 0 0 0 0 0 4292006610 4292401368 4292467161 4292730333 4292730333 4292730333 4292730333 4292730333 4292730333 4292730333 4292730333 4292730333 4292796126 4292467161 4292401368 4292006610 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 1/22/2009 15:18'!
newButtonBottomRightForm
	"Answer the form for the bottom right of a button."

	^(Form
	extent: 12@12
	depth: 32
	fromArray: #( 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 4292072403 4291282887 3548216701 4292401368 4292401368 4292401368 4292401368 4292401368 4292401368 4292401368 4292401368 4292401368 4292401368 4290230199 2607574124 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4238187933 1616731485 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4119365768 962156889 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4290756543 3697895785 374427985 4293454056 4293454056 4293454056 4293454056 4293454056 4293454056 4293454056 4293454056 4292730333 4118378873 1666010445 41975936 4293717228 4293717228 4293717228 4293717228 4293717228 4293717228 4293717228 4293717228 4254175633 2790215503 154745145 0 4294046193 4294046193 4294046193 4294046193 4294046193 4294046193 4293848814 4289177511 3663288665 675299392 16777216 0 4294309365 4294309365 4294309365 4294309365 4294309365 4292467161 4253188738 3545453395 1295332661 33554432 0 0 4294572537 4294572537 4294440951 4292861919 4289309097 4066797158 2655010880 640626479 33554432 0 0 0 4288519581 4270294919 4168052591 3965081174 3477291843 1546267178 138428480 16777216 0 0 0 0 3107864126 2268016431 1511989023 941629472 338044454 33554432 0 0 0 0 0 0)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'defaults' stamp: 'gvc 1/23/2009 12:35'!
expanderTitleInsetFor: aDropList
	"Answer the inset to use for expander title layout."

	^0! !

!UIThemeWatery methodsFor: 'defaults' stamp: 'gvc 1/9/2009 17:52'!
buttonFocusIndicatorCornerRadiusFor: aButton
	"Answer the default corner radius preferred for the focus indicator
	for the button for themes that support this."

	^aButton wantsRoundedCorners
		ifTrue: [7]
		ifFalse: [2]! !

!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'MarcusDenker 7/22/2013 13:50'!
dropListFocusBoundsFor: aDropList
	"Answer the bounds for drawing the focus indication for the
	given drop list."

	^aDropList bounds! !

!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'MarcusDenker 7/22/2013 13:50'!
menuItemInDockingBarSelectedFillStyleFor: aMenuItem
	"Answer the selected fill style to use for the given menu item that is in a docking bar."
	
	| fill baseColor |
	Display depth <= 2
		ifTrue: [^ Color gray].
	baseColor := self settings derivedMenuColor.
	self preferGradientFill ifFalse: [^baseColor].
	fill := GradientFillStyle ramp: {0.0 -> baseColor twiceDarker . 1 -> baseColor twiceLighter}.
	fill
		origin: aMenuItem topLeft;
		direction: 0@aMenuItem height.
	^ fill! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 10/3/2008 13:28'!
scrollbarThumbVerticalMiddleForm
	"Answer the form to use for the middle of a vertical scrollbar."

	^self forms at: #sbVThumbMiddle ifAbsent: [Form extent: 13@1 depth: Display depth]! !

!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'gvc 12/9/2008 12:45'!
checkboxButtonNormalFillStyleFor: aCheckboxButton
	"Return the normal checkbox button fillStyle for the given checkbox button."
	
	^(ImageFillStyle form: self checkboxForm) origin: aCheckboxButton topLeft! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 1/22/2009 14:29'!
newButtonSelectedTopLeftForm
	"Answer the form for the top left of a selected button."

	^(Form
	extent: 12@12
	depth: 32
	fromArray: #( 0 0 0 0 0 0 33554431 362719975 1268031205 2541850575 3279521477 3765271736 0 0 0 0 0 111848191 2407633100 4049957547 4266548622 4284838039 4287271854 4290099916 0 0 0 16777471 814060743 3581116602 4266877583 4288982209 4292730856 4292994026 4292994026 4292994026 0 0 16777471 1903987394 4099960739 4285430685 4291349978 4292270819 4292270819 4292270819 4292270819 4292270819 0 0 713067455 4083709352 4288259003 4291547356 4291547356 4291547356 4291547356 4291547356 4291547356 4291547356 0 75464703 3580787373 4287535542 4290889943 4290889943 4290889943 4290889943 4290889943 4290889943 4290889943 4290889943 33554431 2389802158 4251744930 4290297809 4290297809 4290297809 4290297809 4290297809 4290297809 4290297809 4290297809 4290297809 258373546 4016337568 4286878386 4289706189 4289706189 4289706189 4289706189 4289706189 4289706189 4289706189 4289706189 4289706189 1097823911 4200558234 4287207349 4289114568 4289114568 4289114568 4289114568 4289114568 4289114568 4289114568 4289114568 4289114568 2070376603 4284182168 4286155693 4288654276 4288654276 4288654276 4288654276 4288654276 4288654276 4288654276 4288654276 4288654276 3160435603 4284314525 4284577696 4287668413 4288128705 4288128705 4288128705 4288128705 4288128705 4288128705 4288128705 4288128705 3780930190 4284578211 4284578211 4285301417 4286353587 4286353587 4286353587 4286353587 4286353587 4286353587 4286353587 4286353587)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'MarcusDenker 7/22/2013 13:50'!
splitterNormalFillStyleFor: aSplitter
	"Return the normal splitter fillStyle for the given splitter."
	
	|aColor|
	aColor := aSplitter paneColor.
	^(GradientFillStyle ramp: {
		0.0->aColor twiceLighter. 1.0->aColor darker})
		origin: aSplitter topLeft;
		direction: (aSplitter splitsTopAndBottom
			ifTrue: [0 @ aSplitter height]
			ifFalse: [aSplitter width @ 0]);
		radial: false! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 10/3/2008 13:22'!
newScrollbarThumbTopForm
	"Answer the form for the top of a scrollbar thumb."

	^(Form
	extent: 13@7
	depth: 32
	fromArray: #( 0 0 0 422725477 1345735788 1832209003 1999981163 1916095595 1345735788 758270315 0 0 0 0 0 1261587049 2587118699 4283787654 4283656068 4283458947 4283392897 4283195776 2671004523 1664502380 171134054 0 211462590 2033601901 4284050825 4283919239 4284971669 4285629597 4285695391 4285169048 4284379535 4283195775 4282998397 2419477869 322261099 1396330353 4284182411 4284313740 4286418855 4287208113 4286879149 4286484649 4286155685 4285761185 4285037464 4283327362 4282801275 2436846708 2587118699 4284182411 4286682026 4287602613 4287208113 4286879149 4286484649 4286155685 4285761185 4285432221 4284905878 4282932861 2755021932 4284182411 4285629341 4287931577 4287602613 4287208113 4286879149 4286484649 4286155685 4285761185 4285432221 4285103257 4283853961 4282669690 4284182411 4287010734 4287931577 4287602613 4287208113 4286879149 4286484649 4286155685 4285761185 4285432221 4285103257 4284380048 4282669690)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'label-styles' stamp: 'MarcusDenker 7/22/2013 13:50'!
windowMenuPassiveForm
	"Answer the form to use for inactive window menu buttons"

	^self forms at: #windowMenuPassive ifAbsent: [Form extent: 16@16 depth: Display depth]! !

!UIThemeWatery methodsFor: 'border-styles' stamp: 'MarcusDenker 7/22/2013 13:50'!
windowPaneBorderStyleFor: aMorph in: aSystemWindow
	"Answer the border style for a morph that is to be added
	as a pane in the given system window,"

	^BorderStyle simple
		color: aSystemWindow paneColor;
		width: (aMorph borderWidth = 0 ifTrue: [0] ifFalse: [1])! !

!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'gvc 1/28/2009 17:53'!
controlButtonSelectedDisabledFillStyleFor: aButton
	"Return the selected disabled control button fillStyle for the given button.
	Control buttons are generally used for drop-lists and expanders."
	
	^self controlButtonSelectedFillStyleFor: aButton! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 10/3/2008 13:27'!
scrollbarThumbRightForm
	"Answer the form to use for the right of a horizontal scrollbar."

	^self forms at: #sbHThumbRight ifAbsent: [Form extent: 7@13 depth: Display depth]! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 1/22/2009 14:28'!
newButtonSelectedBottomMiddleForm
	"Answer the form for the bottom middle of a selected button."

	^(Form
	extent: 1@12
	depth: 32
	fromArray: #( 4284907432 4285171117 4285500082 4285763767 4286092732 4286356417 4286685381 4286948810 4287278031 4287606996 4285038229 3442226232)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'MarcusDenker 7/22/2013 13:50'!
newRadioButtonMarkerForm
	"Answer a new radio button marker form."

	^(Form
	extent: 12@12
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 0 0 0 0 0 0 0 0 16777215 16777215 16777215 16777215 0 0 268435456 1392508928 1392508928 268435456 0 0 16777215 16777215 16777215 16777215 0 268435456 3439329280 4278190080 4211081216 3355443200 268435456 0 16777215 16777215 16777215 16777215 0 1392508928 4278190080 4278190080 4278190080 4244635648 1392508928 0 16777215 16777215 16777215 16777215 0 1392508928 4278190080 4278190080 4261412864 4261412864 1308622848 0 16777215 16777215 16777215 16777215 0 268435456 3439329280 4278190080 4261412864 3422552064 234881024 0 16777215 16777215 16777215 16777215 0 0 268435456 1392508928 1392508928 268435456 0 0 16777215 16777215 16777215 16777215 0 0 0 0 0 0 0 0 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'border-styles-scrollbars' stamp: 'MarcusDenker 7/22/2013 13:50'!
scrollbarPagingAreaCornerStyleIn: aThemedMorph
	"Allow for themes to override default behaviour."
	
	^#rounded! !

!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'gvc 12/9/2008 13:11'!
radioButtonSelectedDisabledFillStyleFor: aRadioButton
	"Return the selected disabled radio button fillStyle for the given button."
	
	^self radioButtonNormalFillStyleFor: aRadioButton! !

!UIThemeWatery methodsFor: 'border-styles-buttons' stamp: 'gvc 12/8/2008 19:15'!
radioButtonCornerStyleFor: aRadioButton
	"Answer the corner style for radio buttons.
	Answer square when not disabled since the form is rounded."
	
	^aRadioButton enabled
		ifTrue: [#square]
		ifFalse: [#rounded]! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'GaryChambers 2/15/2011 12:52'!
paneColorFor: aWindow
	"Answer the pane color that should be used."
	
	^self settings fadedBackgroundWindows
		ifTrue: [aWindow fillStyleToUse asColor]
		ifFalse: [(self windowActiveFillStyleFor: aWindow) asColor]! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 1/22/2009 14:30'!
buttonSelectedTopLeftForm
	"Answer the form to use for the top left of a selected button."

	^self forms at: #buttonSelectedTopLeft ifAbsent: [Form extent: 12@12 depth: Display depth]! !

!UIThemeWatery methodsFor: 'border-styles' stamp: 'GaryChambers 8/18/2010 17:14'!
dropListNormalBorderStyleFor: aDropList
	"Return the normal borderStyle for the given drop list"

	^BorderStyle simple
		width: 0;
		baseColor: Color transparent! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 10/3/2008 13:28'!
scrollbarThumbBottomForm
	"Answer the form to use for the bottom of a vertical scrollbar."

	^self forms at: #sbVThumbBottom ifAbsent: [Form extent: 13@7 depth: Display depth]! !

!UIThemeWatery methodsFor: 'morph creation' stamp: 'SeanDeNigris 1/23/2014 12:03'!
newTaskbarThumbnailIn: aThemedMorph for: aWindow
	"Answer a taskbar thumbnail morph for the given window."

	|answer thumb|
	thumb := aWindow taskbarThumbnail.
	answer := PanelMorph new
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap;
		changeTableLayout;
		layoutInset: 8;
		cellInset: 4;
		addMorphBack: thumb;
		addMorphBack: ((self
			buttonLabelForText: (aWindow labelString truncateWithElipsisTo: 50))
				color: Color white).
	answer
		extent: answer minExtent;
		fillStyle: (self taskListFillStyleFor: answer);
		borderStyle: (self taskbarThumbnailNormalBorderStyleFor: aWindow);
		cornerStyle: (self taskbarThumbnailCornerStyleFor: answer).
	^answer
			! !

!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'GaryChambers 11/16/2011 16:36'!
buttonPlainFillStyleFor: aButton
	"Return the plain button fillStyle for the given button."
	
	|round roundCorners tl t tr l m r bl b br|
	round := aButton wantsRoundedCorners.
	roundCorners := aButton roundedCorners.
	tl := (round and: [roundCorners includes: 1]) ifTrue: [self buttonTopLeftForm] ifFalse: [self buttonSquareTopLeftForm].
	t := self buttonTopMiddleForm.
	tr:= (round and: [roundCorners includes: 4]) ifTrue: [self buttonTopRightForm] ifFalse: [self buttonSquareTopRightForm].
	l := self buttonMiddleLeftForm. m := self buttonPlainMiddleColor. r := self buttonMiddleRightForm.
	bl := (round and: [roundCorners includes: 2]) ifTrue: [self buttonBottomLeftForm] ifFalse: [self buttonSquareBottomLeftForm].
	b := self buttonBottomMiddleForm.
	br := (round and: [roundCorners includes: 3]) ifTrue: [self buttonBottomRightForm] ifFalse: [self buttonSquareBottomRightForm].
	^self
		multiFormFillStyleFrom: {tl. t. tr. l. m. r. bl. b. br}
		in: aButton bounds! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 1/22/2009 14:28'!
newButtonSelectedBottomRightForm
	"Answer the form for the bottom right of a selected button."

	^(Form
	extent: 12@12
	depth: 32
	fromArray: #( 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284775331 3545850757 4285170861 4285170861 4285170861 4285170861 4285170861 4285170861 4285170861 4285170861 4285170861 4285170861 4284643228 2605931385 4285499826 4285499826 4285499826 4285499826 4285499826 4285499826 4285499826 4285499826 4285499826 4285499826 4233915791 1615745901 4285763511 4285763511 4285763511 4285763511 4285763511 4285763511 4285763511 4285763511 4285763511 4285763511 4116079488 961039463 4286092476 4286092476 4286092476 4286092476 4286092476 4286092476 4286092476 4286092476 4286092476 4285169827 3695858538 373704285 4286356160 4286356160 4286356160 4286356160 4286356160 4286356160 4286356160 4286356160 4286092472 4115618674 1664828245 33554560 4286685125 4286685125 4286685125 4286685125 4286685125 4286685125 4286685125 4286685125 4250495363 2789098069 154745173 0 4286948554 4286948554 4286948554 4286948554 4286948554 4286948554 4286882504 4284642962 3661580376 674444102 16777216 0 4287277775 4287277775 4287277775 4287277775 4287277775 4286421177 4250034292 3543876175 1294675516 33554432 0 0 4287606740 4287606740 4287540947 4286750399 4284906131 4064496988 2654025280 640165935 33554432 0 0 0 4284445576 4266943863 4165424226 3963307086 3476109119 1545872426 134234176 16777216 0 0 0 0 3106812728 2267424813 1511791647 941629472 338044454 33554432 0 0 0 0 0 0)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'gvc 12/9/2008 13:10'!
radioButtonDisabledFillStyleFor: aRadioButton
	"Return the disabled radio button fillStyle for the given button."
	
	^self radioButtonNormalFillStyleFor: aRadioButton! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 1/22/2009 14:28'!
newButtonSelectedMiddleLeftForm
	"Answer the form for the middle left of a selected button."

	^(Form
	extent: 12@1
	depth: 32
	fromArray: #( 3965347464 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432 4284907432)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'basic-colors' stamp: 'MarcusDenker 12/11/2009 09:36'!
taskbarButtonLabelColorFor: aButton
	"Answer the colour for the label of the given taskbar button."

	^aButton model
		ifNil: [super taskbarButtonLabelColorFor: aButton]
		ifNotNil: [:win |
			win isActive
				ifTrue: [self selectionColor darker]
				ifFalse: [super taskbarButtonLabelColorFor: aButton]]! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'MarcusDenker 7/22/2013 13:50'!
newTreeExpandedForm
	"Answer a new form for an expanded tree item."

	^(Form
	extent: 9@9
	depth: 32
	fromArray: #( 1049135240 2290649224 2290649224 2290649224 2290649224 2290649224 2290649224 2290649224 1200130184 478709896 4169697416 4287137928 4287137928 4287137928 4287137928 4287137928 4236806280 646482056 16777215 2508753032 4287137928 4287137928 4287137928 4287137928 4287137928 2726856840 16777215 16777215 495487112 4186474632 4287137928 4287137928 4287137928 4236806280 612927624 16777215 16777215 16777215 2542307464 4287137928 4287137928 4287137928 2676525192 16777215 16777215 16777215 16777215 478709896 4169697416 4287137928 4220029064 579373192 16777215 16777215 16777215 16777215 16777215 2424866952 4287137928 2626193544 16777215 16777215 16777215 16777215 16777215 16777215 394823816 4018702472 529041544 16777215 16777215 16777215 16777215 16777215 16777215 16777215 864585864 16777215 16777215 16777215 16777215)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'border-styles-buttons' stamp: 'gvc 12/9/2008 12:46'!
checkboxButtonNormalBorderStyleFor: aChecboxButton
	"Return the normal checkbox button borderStyle for the given button."

	^BorderStyle simple
		width: 1;
		baseColor: Color transparent! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 12/8/2008 18:37'!
newRadioButtonForm
	"Answer the form for a normal radio button."

	^(Form
	extent: 14@14
	depth: 32
	fromArray: #( 16777215 16777215 16777215 198234320 2645865652 3568415153 4072521149 4055875519 3551637937 2578756788 164021958 16777215 16777215 16777215 16777215 16777215 1437906100 4038506166 4292598747 4293914607 4294111986 4294111986 4293914607 4292598747 4021728950 1303556786 16777215 16777215 16777215 1386916522 4257465283 4293388263 4293651435 4293651435 4293651435 4293651435 4293651435 4293651435 4293388263 4240556481 1219144362 16777215 195207842 4038177201 4293125091 4293256677 4293256677 4293256677 4293256677 4293256677 4293256677 4293256677 4293256677 4293059298 3987713967 144678815 2627640990 4291875024 4292993505 4292993505 4292993505 4292993505 4292993505 4292993505 4292993505 4292993505 4292993505 4292993505 4291743438 2459803037 3584139681 4292072403 4292861919 4292861919 4292861919 4292861919 4292861919 4292861919 4292861919 4292861919 4292861919 4292861919 4292006610 3500056222 3970476200 4291809231 4292467161 4292532954 4292532954 4292532954 4292532954 4292532954 4292532954 4292532954 4292532954 4292467161 4291809231 3919947173 3919749794 4292203989 4292203989 4292203989 4292203989 4292203989 4292203989 4292203989 4292203989 4292203989 4292203989 4292203989 4292203989 3869154974 3515846543 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 3431697291 2289333364 4291480266 4293125091 4293125091 4293125091 4293125091 4293125091 4293125091 4293125091 4293125091 4293125091 4293125091 4291151301 2154918257 189154886 3817178501 4293256677 4293585642 4293585642 4293585642 4293585642 4293585642 4293585642 4293585642 4293585642 4293059298 3766583681 189154886 16777215 960906822 4120221077 4293322470 4294111986 4294111986 4294111986 4294111986 4294111986 4294111986 4293256677 4103180689 927549769 16777215 16777215 16777215 910048830 3682039671 4290756543 4293256677 4294572537 4294506744 4293190884 4273847741 3648287860 893337407 16777215 16777215 16777215 16777215 16777215 169482778 1799570243 3042202708 3681710706 3664867697 3025359699 1799636036 169482778 16777215 16777215 16777215)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 1/22/2009 14:37'!
buttonSquareSelectedBottomLeftForm
	"Answer the form to use for the bottom left of a selected square button."

	^self forms at: #buttonSquareSelectedBottomLeft ifAbsent: [Form extent: 12@12 depth: Display depth]! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 1/22/2009 14:30'!
buttonSelectedBottomMiddleForm
	"Answer the form to use for the bottom middle of a selected button."

	^self forms at: #buttonSelectedBottomMiddle ifAbsent: [Form extent: 1@12 depth: Display depth]! !

!UIThemeWatery methodsFor: 'border-styles-buttons' stamp: 'gvc 12/5/2008 14:33'!
buttonNormalBorderStyleFor: aButton
	"Return the normal button borderStyle for the given button."

	^BorderStyle simple
		width: 0;
		baseColor: Color transparent! !

!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'gvc 12/9/2008 12:45'!
checkboxButtonSelectedFillStyleFor: aCheckboxButton
	"Return the selected checkbox button fillStyle for the given checkbox button."
	
	^(ImageFillStyle form: self checkboxSelectedForm) origin: aCheckboxButton topLeft! !

!UIThemeWatery methodsFor: 'label-styles' stamp: 'MarcusDenker 7/22/2013 13:50'!
windowClosePassiveForm
	"Answer the form to use for passive (background) window close buttons"

	^self forms at: #windowClosePassive ifAbsent: [Form extent: 16@16 depth: Display depth]! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 1/22/2009 14:36'!
newButtonSquareSelectedTopLeftForm
	"Answer the form for the top left of a selected square button."

	^(Form
	extent: 12@12
	depth: 32
	fromArray: #( 630892779 3329853638 3949492146 3966269361 3966269361 3966269361 3966269361 3966269361 3966269361 3966269361 3966269361 3966269361 3028455632 4282141565 4285561500 4291744478 4291876062 4291876062 4291876062 4291876062 4291876062 4291876062 4291876062 4291876062 3916792766 4281944439 4289771209 4292928234 4292928234 4292928234 4292928234 4292928234 4292994026 4292994026 4292994026 4292994026 3966992312 4282207868 4289705673 4292139234 4292205027 4292205027 4292205027 4292205027 4292205027 4292205027 4292205027 4292205027 3966860723 4282537089 4289311174 4291481564 4291481564 4291481564 4291481564 4291481564 4291481564 4291547356 4291547356 4291547356 3966598062 4282800518 4288785346 4290889686 4290889686 4290889686 4290889686 4290889686 4290889686 4290889686 4290889686 4290889686 3966334888 4283129739 4288456639 4290232273 4290232273 4290232273 4290232273 4290232273 4290297809 4290297809 4290297809 4290297809 3966268835 4283393168 4288062397 4289640396 4289640652 4289640652 4289640652 4289640652 4289640652 4289640652 4289640652 4289640652 3966071197 4283722133 4287799227 4289114568 4289114568 4289114568 4289114568 4289114568 4289114568 4289114568 4289114568 4289114568 3965874072 4283985818 4287405242 4288523204 4288523204 4288588740 4288588740 4288588740 4288588740 4288588740 4288588740 4288588740 3965741971 4284314782 4287208120 4288128705 4288128705 4288128705 4288128705 4288128705 4288128705 4288128705 4288128705 4288128705 3965544845 4284578467 4285893551 4286288050 4286288050 4286353587 4286353587 4286353587 4286353587 4286353587 4286353587 4286353587)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'label-styles' stamp: 'MarcusDenker 7/22/2013 13:50'!
windowMinimizeOverForm
	"Answer the form to use for mouse over window minimize buttons"

	^self forms at: #windowMinimizeOver ifAbsent: [Form extent: 16@16 depth: Display depth]! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'MarcusDenker 7/22/2013 13:50'!
expanderTitleNormalFillStyleFor: anExpanderTitle
	"Return the normal expander title fillStyle for the given expander title."
	
	|aColor|
	aColor := anExpanderTitle paneColor.
	^(GradientFillStyle ramp: {
			0.0->Color white.
			0.05-> aColor lighter.
			1.0->aColor darker})
		origin: anExpanderTitle topLeft;
		direction: 0 @ anExpanderTitle height;
		radial: false! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 12/11/2008 16:38'!
newCheckboxForm
	"Answer the form for a normal checkbox."

	^(Form
	extent: 14@14
	depth: 32
	fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 594242411 3918960278 4138774704 4138774704 4138774704 4138774704 4138774704 4138774704 4138774704 4138774704 4138774704 4138774704 3919026071 594242411 2575072380 4292467161 4294177779 4294177779 4294177779 4294177779 4294177779 4294177779 4294177779 4294177779 4294177779 4294177779 4292467161 2524806525 2658695288 4292664540 4293651435 4293651435 4293651435 4293651435 4293651435 4293651435 4293651435 4293651435 4293651435 4293651435 4292664540 2608429433 2658432116 4292532954 4293322470 4293322470 4293322470 4293322470 4293322470 4293322470 4293322470 4293322470 4293322470 4293322470 4292532954 2608232054 2658366323 4292467161 4293059298 4293059298 4293059298 4293059298 4293059298 4293059298 4293059298 4293059298 4293059298 4293059298 4292467161 2608100468 2658037358 4292532954 4292861919 4292861919 4292861919 4292861919 4292861919 4292861919 4292861919 4292861919 4292861919 4292861919 4292532954 2607771503 2657839979 4292138196 4292138196 4292138196 4292138196 4292138196 4292138196 4292138196 4292138196 4292138196 4292138196 4292138196 4292138196 2607639917 2657642600 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 4292664540 2607442538 2657313635 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 2607113573 2657116256 4293717228 4293717228 4293717228 4293717228 4293717228 4293717228 4293717228 4293717228 4293717228 4293717228 4293717228 4293717228 2606850401 2606455643 4294046193 4294309365 4294309365 4294309365 4294309365 4294309365 4294309365 4294309365 4294309365 4294309365 4294309365 4294046193 2556255581 1311978291 4237003659 4289967027 4289967027 4289967027 4289967027 4289967027 4289967027 4289967027 4289967027 4289967027 4289967027 4237003659 1278555445 50331648 1210986030 1647917369 1647917369 1647917369 1647917369 1647917369 1647917369 1647917369 1647917369 1647917369 1647917369 1210986030 50331648)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'label-styles' stamp: 'MarcusDenker 7/22/2013 13:50'!
createExpandBoxFor: aSystemWindow
	"Answer a button for maximising/restoring the window."
	
	|form msb|
	form := self windowMaximizeForm.
	msb := MultistateButtonMorph new extent: form extent.
	msb activeEnabledNotOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowMaximizePassiveForm.
	msb extent: form extent.
	msb passiveEnabledNotOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowMaximizeOverForm.
	msb extent: form extent.
	msb
		activeEnabledOverUpFillStyle: (ImageFillStyle form: form);
		passiveEnabledOverUpFillStyle: (ImageFillStyle form: form).
	form := self windowMaximizePassiveForm.
	msb
		extent: form extent;
		activeEnabledOverDownFillStyle: (ImageFillStyle form: form);
		passiveEnabledOverDownFillStyle: (ImageFillStyle form: form);
		addUpAction: [aSystemWindow expandBoxHit];
		setBalloonText: 'Expand to full screen' translated;
		extent: aSystemWindow boxExtent.
	^msb! !

!UIThemeWatery methodsFor: 'morph creation' stamp: 'MarcusDenker 7/22/2013 13:50'!
newFocusIndicatorMorphFor: aMorph
	"Answer a new focus indicator for the given morph."

	|radius|
	radius := aMorph focusIndicatorCornerRadius.
	^BorderedMorph new
		fillStyle: Color transparent;
		borderStyle: ((CompositeBorder new width: radius)
						borders: {RoundedBorder new
									cornerRadius: radius;
									width: 1;
									baseColor: self settings scrollbarColor.
								RoundedBorder new	
									cornerRadius: radius - 1;
									width: 1;
									baseColor: (self settings scrollbarColor alpha: 0.4)});
		bounds: aMorph focusBounds! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 1/22/2009 14:36'!
newButtonSquareSelectedTopRightForm
	"Answer the form for the top right of a selected square button."

	^(Form
	extent: 12@12
	depth: 32
	fromArray: #( 3966269361 3966269361 3966269361 3966269361 3966269361 3966269105 3966269105 3966269105 3966269105 3949492146 3246098890 547072752 4291941599 4291941599 4291941599 4291941599 4291941599 4291941599 4291941599 4291941599 4291810270 4285298585 4282338943 2927923665 4292994026 4292994026 4292994026 4292994026 4292994026 4292994283 4292994283 4292994283 4292994283 4289442502 4281878647 3883238334 4292205027 4292270819 4292270819 4292270819 4292270819 4292270819 4292270819 4292270819 4292270819 4289442758 4282207868 3933503928 4291547356 4291547356 4291547356 4291547356 4291547356 4291547356 4291612893 4291612893 4291612893 4289048003 4282471297 3933240756 4290889943 4290889943 4290889943 4290889943 4290889943 4290889943 4290889943 4290889943 4290889943 4288653760 4282800518 3933043629 4290297809 4290297809 4290297809 4290297809 4290297809 4290298066 4290298066 4290298066 4290298066 4288325054 4283063947 3932911528 4289640652 4289706189 4289706189 4289706189 4289706189 4289706189 4289706189 4289706189 4289706189 4287930812 4283393168 3932714660 4289114568 4289114568 4289114568 4289114568 4289114568 4289114568 4289180360 4289180360 4289180360 4287602105 4283656596 3932516765 4288588740 4288588740 4288654532 4288654532 4288654532 4288654532 4288654532 4288654532 4288654532 4287339448 4283985817 3932319385 4288128705 4288128705 4288128705 4288128705 4288128705 4288128705 4288128705 4288194497 4288194497 4287142327 4284314782 3932187795 4286353587 4286353587 4286353587 4286353587 4286353587 4286353587 4286353587 4286353587 4286353587 4285827758 4284578467 3931924878)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'gvc 1/28/2009 17:54'!
controlButtonSelectedMouseOverFillStyleFor: aButton
	"Return the selected mouse over control button fillStyle for the given button.
	Control buttons are generally used for drop-lists and expanders."
	
	^self controlButtonSelectedFillStyleFor: aButton! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 10/3/2008 13:28'!
scrollbarThumbHorizontalMiddleForm
	"Answer the form to use for the middle of a horizontal scrollbar."

	^self forms at: #sbHThumbMiddle ifAbsent: [Form extent: 1@13 depth: Display depth]! !

!UIThemeWatery methodsFor: 'border-styles' stamp: 'MarcusDenker 7/22/2013 13:50'!
configureWindowBorderFor: aWindow
	"Configure the border for the given window."

	super configureWindowBorderFor: aWindow.
	aWindow roundedCorners: #(1 4) "just top"! !

!UIThemeWatery methodsFor: 'label-styles' stamp: 'MarcusDenker 7/22/2013 13:50'!
windowMenuIconFor: aWindow
	"Answer the menu icon for the given window."
	
	^ self windowMenuForm! !

!UIThemeWatery methodsFor: 'border-styles' stamp: 'gvc 1/12/2009 18:28'!
tabPanelBorderStyleFor: aTabGroup
	"Answer the normal border style for a tab group."

	^TabPanelBorder new
		width: 1;
		baseColor: (aTabGroup paneColor alphaMixed: 0.8 with: Color black);
		tabSelector: aTabGroup tabSelectorMorph! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 1/22/2009 14:30'!
buttonSelectedMiddleRightForm
	"Answer the form to use for the middle right of a selected button."

	^self forms at: #buttonSelectedMiddleRight ifAbsent: [Form extent: 12@1 depth: Display depth]! !

!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'gvc 1/20/2010 12:02'!
controlButtonSelectedFillStyleFor: aButton
	"Return the selected control button fillStyle for the given button.
	Control buttons are generally used for drop-lists and expanders."
	
	^self buttonNormalFillStyleFor: aButton! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 1/22/2009 15:19'!
newButtonTopRightForm
	"Answer the form for the top right of a button."

	^(Form
	extent: 12@12
	depth: 32
	fromArray: #( 3753227701 3266885816 2445065404 1187103169 298042307 33554431 0 0 0 0 0 0 4292796126 4291546059 4290427578 4272729260 4021334192 2159655353 75464575 0 0 0 0 0 4294111986 4294111986 4294111986 4293980400 4292401368 4256346802 3467817650 649113776 33554431 0 0 0 4293848814 4293848814 4293848814 4293848814 4293848814 4293388263 4290822336 4071534254 1554886061 33554431 0 0 4293585642 4293585642 4293585642 4293585642 4293585642 4293585642 4293585642 4292072403 4020873641 548055722 0 0 4293388263 4293388263 4293388263 4293388263 4293388263 4293388263 4293388263 4293388263 4291611852 3382944675 67108863 0 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293125091 4239701172 2006686619 33554431 4293059298 4293059298 4293059298 4293059298 4293059298 4293059298 4293059298 4293059298 4293059298 4291809231 3953041054 261724569 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292072403 4171473827 898206089 4292861919 4292861919 4292861919 4292861919 4292861919 4292861919 4292861919 4292861919 4292861919 4291875024 4256215216 1787069572 4292796126 4292796126 4292796126 4292796126 4292796126 4292796126 4292796126 4292796126 4292532954 4291611852 4290822336 2843968387 4292335575 4292335575 4292335575 4292335575 4292335575 4292335575 4292335575 4292335575 4291940817 4291809231 4291677645 3666380936)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'fill-styles-scrollbars' stamp: 'gvc 10/3/2008 13:30'!
scrollbarNormalVerticalThumbFillStyleFor: aScrollbar
	"Return the normal scrollbar vertical thumb fillStyle for the given scrollbar."
	
	|s t m b|
	s := aScrollbar slider.
	t := self scrollbarThumbTopForm.
	m := self scrollbarThumbVerticalMiddleForm.
	b := self scrollbarThumbBottomForm.
	^CompositeFillStyle fillStyles: {
		(ImageFillStyle form: t) origin: s topLeft.
		(AlphaInfiniteForm with: m)
			origin: s topLeft + (0@t height);
			extent: m width@(s height - t height - b height).
		(ImageFillStyle form: b)
			origin: s bottomLeft - (0@b height)}! !

!UIThemeWatery methodsFor: 'defaults' stamp: 'gvc 1/14/2009 15:32'!
tabSelectorCellInsetFor: aTabSelector
	"Answer the cell inset to use for the given tab selector."

	^0! !

!UIThemeWatery methodsFor: 'label-styles' stamp: 'MarcusDenker 7/22/2013 13:50'!
windowCloseOverForm
	"Answer the form to use for mouse over window close buttons"

	^self forms at: #windowCloseOver ifAbsent: [Form extent: 16@16 depth: Display depth]! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 12/8/2008 13:59'!
buttonBottomLeftForm
	"Answer the form to use for the bottom left of a button."

	^self forms at: #buttonBottomLeft ifAbsent: [Form extent: 11@11 depth: Display depth]! !

!UIThemeWatery methodsFor: 'border-styles-buttons' stamp: 'gvc 1/28/2009 17:11'!
expanderTitleControlButtonWidth
	"Answer the width of an expander title control button for this theme."
	
	^20! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 10/9/2008 17:25'!
dialogWindowInactiveFillStyleFor: aWindow
	"Return the window active fillStyle for the given window."
	
	^self windowInactiveFillStyleFor: aWindow! !

!UIThemeWatery methodsFor: 'border-styles-buttons' stamp: 'MarcusDenker 7/22/2013 13:50'!
textEntryCornerStyleIn: aThemedMorph
	"Answer the corner style to use for text entry morphs."
	
	^#square! !

!UIThemeWatery methodsFor: 'fill-styles-buttons' stamp: 'gvc 1/20/2010 12:02'!
controlButtonSelectedPressedFillStyleFor: aButton
	"Return the selected pressed button fillStyle for the given button.
	Control buttons are generally used for drop-lists and expanders."
	
	^self controlButtonNormalFillStyleFor: aButton! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'MarcusDenker 7/22/2013 13:50'!
newWindowMaximizeForm
	"Answer a new form for a window minimize box."

	^(Form
	extent: 16@16
	depth: 32
	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4290295992 4285822068 4282071867 4279440147 4279440147 4282071867 4285822068 4290295992 0 0 0 0 0 0 0 4287269514 4281611316 4282795590 4285953654 4287664528 4287730320 4285953654 4282861383 4281611316 4287269514 0 0 0 0 0 4287137928 4280360481 4283914839 4288455580 4291547084 4292731360 4292796894 4291547341 4288390044 4283980376 4280294689 4287203721 0 0 0 4290164406 4281348144 4282010170 4285369453 4288527772 4290565299 4291025080 4291025080 4290630835 4288593820 4285303917 4282009913 4281348144 4290164406 0 0 4286479998 4280431648 4282282296 4283995198 4286033222 4286821198 4286952786 4287018578 4286755662 4285967429 4284060735 4282216504 4280497696 4286545791 0 0 4282402111 4281097769 4282549797 4283800345 4284982554 4285771048 4285903149 4285837356 4285771304 4285114397 4283866393 4282484773 4281097769 4282402111 0 0 4279972116 4282219307 4283997212 4285114906 4285969451 4286824254 4287152961 4287218498 4286890301 4286167084 4285246490 4284260124 4282219308 4280037908 0 0 4279975186 4283600171 4285640744 4286561842 4287547718 4288336981 4288731227 4288731228 4288402775 4287614279 4286627889 4285772072 4283600683 4280172817 0 0 4282736189 4284126245 4286692666 4287877449 4288797275 4289586536 4290112367 4290112368 4289718377 4288863579 4287877448 4286758970 4284126756 4282803005 0 0 4286284920 4283533850 4287283524 4288731993 4289718632 4290507893 4291099774 4291165055 4290705785 4289850729 4288797788 4287415878 4283599642 4286350968 0 0 4290362041 4283331374 4286560575 4289322854 4290770809 4291559299 4291952522 4292083595 4291690372 4290903163 4289455464 4286889281 4283462959 4290362040 0 0 4292664540 4287928465 4283793702 4288007509 4290572412 4291689100 4292607381 4292607382 4291885710 4290900861 4288666201 4284122406 4287928465 4292664540 0 0 0 4292993505 4288059538 4284842051 4286688328 4289384043 4290962050 4291224710 4289646450 4287083084 4285171781 4287928466 4292993505 0 0 0 0 0 4292927712 4291217093 4287402885 4285630033 4284907832 4284973881 4285893715 4287468677 4291348680 4292927712 0 0 0 0 0 0 0 4292401368 4293125091 4293454056 4293190884 4293190884 4293190884 4293125091 4292401368 0 0 0 0)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 10/3/2008 13:22'!
newScrollbarThumbRightForm
	"Answer the form for the right hand side of a scrollbar thumb."

	^(Form
	extent: 7@13
	depth: 32
	fromArray: #( 4284182411 4284182411 2587118699 1396330353 211462590 0 0 4287010734 4285629341 4284182411 4284182411 2033601901 0 0 4287931577 4287931577 4286682026 4284313740 4284050825 1261587049 0 4287602613 4287602613 4287602613 4286418855 4283919239 2587118699 422725477 4287208113 4287208113 4287208113 4287208113 4284971669 4283787654 1345735788 4286879149 4286879149 4286879149 4286879149 4285629597 4283656068 1832209003 4286484649 4286484649 4286484649 4286484649 4285695391 4283458947 1999981163 4286155685 4286155685 4286155685 4286155685 4285169048 4283392897 1916095595 4285761185 4285761185 4285761185 4285761185 4284379535 4283195776 1345735788 4285432221 4285432221 4285432221 4285037464 4283195775 2671004523 758270315 4285103257 4285103257 4284905878 4283327362 4282998397 1664502380 0 4284380048 4283853961 4282932861 4282801275 2419477869 171134054 0 4282669690 4282669690 2755021932 2436846708 322261099 0 0)
	offset: 0@0)! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 12/8/2008 14:00'!
buttonMiddleLeftForm
	"Answer the form to use for the middle left of a button."

	^self forms at: #buttonMiddleLeft ifAbsent: [Form extent: 11@1 depth: Display depth]! !

!UIThemeWatery methodsFor: 'fill-styles' stamp: 'gvc 1/22/2009 14:38'!
buttonSquareSelectedTopLeftForm
	"Answer the form to use for the top left of a selected square button."

	^self forms at: #buttonSquareSelectedTopLeft ifAbsent: [Form extent: 12@12 depth: Display depth]! !

!UIThemeWatery methodsFor: 'initialize-release' stamp: 'gvc 1/22/2009 15:19'!
newButtonTopLeftForm
	"Answer the form for the top left of a button."

	^(Form
	extent: 12@12
	depth: 32
	fromArray: #( 0 0 0 0 0 0 33554431 365151171 1270791870 2545662907 3283663032 3770004917 0 0 0 0 0 111848106 2411247800 4054954417 4272729260 4290427578 4291546059 4292796126 0 0 0 33554431 817083315 3585192369 4273058225 4292401368 4293980400 4294111986 4294111986 4294111986 0 0 33554431 1907076011 4105022893 4290953922 4293454056 4293848814 4293848814 4293848814 4293848814 4293848814 0 0 715696296 4088179884 4292269782 4293585642 4293585642 4293585642 4293585642 4293585642 4293585642 4293585642 0 79675327 3584402853 4291940817 4293388263 4293388263 4293388263 4293388263 4293388263 4293388263 4293388263 4293388263 33554431 2392628380 4256938939 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 4293190884 261724569 4020281504 4292006610 4293059298 4293059298 4293059298 4293059298 4293059298 4293059298 4293059298 4293059298 4293059298 1099795853 4205488810 4292269782 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 4292927712 2072413830 4290361785 4292006610 4292861919 4292861919 4292861919 4292861919 4292861919 4292861919 4292861919 4292861919 4292861919 3163196042 4291217094 4291611852 4292664540 4292796126 4292796126 4292796126 4292796126 4292796126 4292796126 4292796126 4292796126 3784150413 4291809231 4291809231 4292006610 4292335575 4292335575 4292335575 4292335575 4292335575 4292335575 4292335575 4292335575)
	offset: 0@0)! !

!UIThemeWatery class methodsFor: 'accessing' stamp: 'MarcusDenker 7/22/2013 14:43'!
themeName
	"Answer the friendly name of the theme."

	^'Watery'! !

!UIThemeWatery class methodsFor: 'accessing' stamp: 'PavelKrivanek 10/1/2013 20:24'!
isAbstract
	"Answer whether the receiver is considered to be abstract."

	^false! !

!UIThemeWatery class methodsFor: 'accessing' stamp: 'HilaireFernandes 3/22/2014 18:03'!
newDefaultSettings
	"Answer a new original default settings."
	"self defaultSettings: nil"
	^super newDefaultSettings
		standardColorsOnly: true;
		autoSelectionColor: false;
		buttonColor: (Color r: 232 g: 232 b: 232 range: 255);
		windowColor: (Color r: 200 g: 200 b: 200 range: 255);
		scrollbarColor: (Color r: 62 g: 142 b: 220 range: 255) ;
		selectionColor: (Color r: 0.0 g: 0.0 b: 0.8 alpha: 0.2) ;
		menuSelectionColor: (Color r: 81 g: 106 b: 230 range: 255) ;
		progressBarColor: (Color r: 232 g: 232 b: 232 range: 255);
		progressBarProgressColor: (Color r: 62 g: 142 b: 220 range: 255);
		yourself! !

!URLPlugin commentStamp: '<historical>'!
An URLPlugin is a plugin which shows the URL of the current navigation!
!URLPlugin methodsFor: 'registration' stamp: 'BernardoContreras 10/22/2014 19:15'!
registerTo: aModel

	aModel announcer
		when: NautilusPackageSelected send: #changed: to: self;
		when: NautilusClassSelected send: #changed: to: self;
		when: NautilusGroupSelected send: #changed: to: self;
		when: NautilusProtocolSelected send: #changed: to: self;
		when: NautilusMethodSelected send: #changed: to: self;
		when: NautilusShowGroupsChanged send: #changed: to: self.! !

!URLPlugin methodsFor: 'private' stamp: 'StephaneDucasse 10/30/2014 08:08'!
buildString

	| first  separator |
	separator := ' > '.
	first := self model showGroups
				ifTrue: [ self model selectedGroup ]
				ifFalse: [ self model selectedPackage ].
	first
		ifNil: [ ^''].			
	^ String streamContents: [ :str | 
			str nextPutAll: first name.
			self model selectedClass
				ifNotNil: [ :class |
					str nextPutAll:  separator ; nextPutAll: class name.
					self model selectedCategory 
						ifNotNil: [ :category |
							str nextPutAll:  separator ; nextPutAll: category.
							self model selectedMethod
								ifNotNil: [ :method | str nextPutAll: separator ; nextPutAll: method selector printString]]].
			str].
! !

!URLPlugin methodsFor: 'announcement' stamp: 'BenjaminVanRyseghem 5/11/2011 16:23'!
changed: ann
	
	| string |
	string := self buildString.
	morph ifNotNil: [ morph contents: string ]! !

!URLPlugin methodsFor: 'display' stamp: 'BenjaminVanRyseghem 5/11/2011 16:21'!
display

	morph :=  LabelMorph new 
					contents: '';
					enabled: false;
					vResizing: #shrinkWrap;
					hResizing: #spaceFill;
					yourself.
	^ morph! !

!URLPlugin class methodsFor: 'position' stamp: 'BenjaminVanRyseghem 8/25/2011 10:03'!
defaultPosition

	^ #middle! !

!URLPlugin class methodsFor: 'information' stamp: 'BenjaminVanRyseghem 2/17/2012 16:27'!
description

	^ 'Display the URI of the selected element'! !

!UTF16TextConverter commentStamp: 'HenrikSperreJohansen 8/9/2010 15:29'!
Text converter for UTF-16.  It supports the endianness and byte order mark.

The default is to not use a BOM, make sure to set this if using the converter to write to a location where encoding metadata is not present / specified by the protocol.

This usually means you want to write one when storing strings to files on disk, but not when transmitting encoded string to a web client, nor when sending data to a database.!
!UTF16TextConverter methodsFor: 'private' stamp: 'HenrikSperreJohansen 8/9/2010 15:19'!
charFromStream: aStream withFirst: firstValue

	^(firstValue < 16rD800 or: [firstValue > 16rDBFF])
		ifTrue:
			[Unicode value: firstValue]
		ifFalse:  "We have a surrogate pair"
			[| character1 character2 n secondValue |
			character1 := aStream basicNext ifNil: [^nil].
			character2 := aStream basicNext ifNil: [^nil].
			self useLittleEndian ifTrue: [ |tmp|
				tmp := character1.
				character1 := character2.
				character2 := tmp].
			secondValue := (character1 charCode << 8) + (character2 charCode).
			Unicode value: (firstValue - 16rD800) * 16r400 + (secondValue - 16rDC00) + 16r10000.]
! !

!UTF16TextConverter methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 8/9/2010 15:02'!
useLittleEndian

	^ useLittleEndian
! !

!UTF16TextConverter methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 8/9/2010 15:02'!
useByteOrderMark

	^ useByteOrderMark
! !

!UTF16TextConverter methodsFor: 'accessing' stamp: 'yo 1/12/2004 13:54'!
useByteOrderMark: aBoolean

	useByteOrderMark := aBoolean.
! !

!UTF16TextConverter methodsFor: 'private' stamp: 'HenrikSperreJohansen 8/10/2010 16:21'!
nextPutByteString: aString toStream: aStream
	| utf16Bytes start |
	"No bytestring character will be a surrogate pair, so simply write the 2x size string with the correct endianness"
	utf16Bytes := String new: aString size* 2.
	start := useLittleEndian ifTrue: [1] ifFalse: [2].
	start to: utf16Bytes size by: 2 do: [:ix | utf16Bytes at: ix put: (aString at: ix +1 // 2 )].
	aStream basicNextPutAll: utf16Bytes.
	! !

!UTF16TextConverter methodsFor: 'conversion' stamp: 'HenrikSperreJohansen 8/9/2010 15:12'!
nextFromStream: aStream

	| character1 character2 readBOM charValue |
	aStream isBinary ifTrue: [^ aStream basicNext].
	character1 := aStream basicNext ifNil: [^nil].
	character2 := aStream basicNext ifNil: [^nil].

	readBOM := false.
	(character1 asciiValue = 16rFF and: [character2 asciiValue = 16rFE]) ifTrue: 
		[self useLittleEndian: true.
		readBOM := true].
	(character1 asciiValue = 16rFE and: [character2 asciiValue = 16rFF]) ifTrue: 
		[self useLittleEndian: false.
		readBOM := true].

	readBOM ifTrue: 
		[self useByteOrderMark: true.
		character1 := aStream basicNext ifNil: [^nil]..
		character2 := aStream basicNext ifNil: [^nil]].

	charValue := self useLittleEndian 
		ifTrue: [(character2 charCode bitShift: 8) + character1 charCode] 
		ifFalse: [(character1 charCode bitShift: 8) + character2 charCode].

	^ self charFromStream: aStream withFirst: charValue.
! !

!UTF16TextConverter methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 6/7/2010 14:16'!
useLittleEndian: aBoolean
	aBoolean = self useLittleEndian ifFalse: [self swapLatin1EncodingByteOrder].
	useLittleEndian := aBoolean.
! !

!UTF16TextConverter methodsFor: 'initialization' stamp: 'HenrikSperreJohansen 8/9/2010 15:02'!
initialize
	super initialize.
	byteOrderMarkDone := false.
	useByteOrderMark := false.
	useLittleEndian := false.! !

!UTF16TextConverter methodsFor: 'conversion' stamp: 'HenrikSperreJohansen 8/9/2010 15:04'!
nextPutAll: aString toStream: aStream
	
	self checkBOMOn: aStream.
	^super nextPutAll: aString toStream: aStream! !

!UTF16TextConverter methodsFor: 'private' stamp: 'HenrikSperreJohansen 6/7/2010 14:28'!
swapLatin1EncodingByteOrder
	latin1Encodings := latin1Encodings collect: [:each | each reverse]! !

!UTF16TextConverter methodsFor: 'private' stamp: 'yo 1/13/2004 12:59'!
next16BitValue: value toStream: aStream

	| v1 v2 |
	v1 := (value >> 8) bitAnd: 16rFF.
	v2 := value bitAnd: 16rFF.

	self useLittleEndian ifTrue: [
		aStream basicNextPut: (Character value: v2).
		aStream basicNextPut: (Character value: v1).
	] ifFalse: [
		aStream basicNextPut: (Character value: v1).
		aStream basicNextPut: (Character value: v2).
	].
! !

!UTF16TextConverter methodsFor: 'conversion' stamp: 'HenrikSperreJohansen 8/9/2010 15:01'!
nextPut: aCharacter toStream: aStream

	| v low high |
	
	self checkBOMOn: aStream.

	v := aCharacter charCode.
	v > 16rFFFF ifFalse: [
		self next16BitValue: v toStream: aStream.
		^ self.
	] ifTrue: [
		v := v - 16r10000.
		low := (v \\ 16r400) + 16rDC00.
		high := (v // 16r400) + 16rD800.
		self next16BitValue: high toStream: aStream.
		self next16BitValue: low toStream: aStream.
	]! !

!UTF16TextConverter methodsFor: 'private' stamp: 'HenrikSperreJohansen 8/9/2010 15:01'!
checkBOMOn: aStream
	"Write bom if applicable, and we are at beginning of stream"
	(self useByteOrderMark and: [byteOrderMarkDone not]) ifTrue: [
		aStream position = 0 ifTrue: [self next16BitValue: (16rFEFF) toStream: aStream].
		byteOrderMarkDone := true.
	].! !

!UTF16TextConverter class methodsFor: 'utilities' stamp: 'yo 2/10/2004 05:23'!
encodingNames

	^ #('utf-16' 'utf16' 'utf-16-le' 'utf-16-be') copy.
! !

!UTF16TextConverterTest commentStamp: 'TorstenBergmann 2/5/2014 10:18'!
SUnit tests for UTF16TextConverter 
!
!UTF16TextConverterTest methodsFor: 'helpers' stamp: 'HenrikSperreJohansen 8/9/2010 16:25'!
assert: originalText isTheSameAfterLittleEndianConversion: aBooleanOrNil

	"Test that encoding / decoding a string witll produce the original string for both byte orders"

	| converter bytes decodedText |

	converter := UTF16TextConverter new.
	aBooleanOrNil ifNotNil: [converter useLittleEndian: aBooleanOrNil].
	bytes := (originalText convertToWithConverter: converter).
	decodedText := bytes convertFromWithConverter: converter.
	
	self assert: originalText equals: decodedText.
	! !

!UTF16TextConverterTest methodsFor: 'helpers' stamp: 'HenrikSperreJohansen 8/9/2010 15:58'!
assertBOMIsWrittenWithOrder: anOrder andConversion: aBlock

	|converter stream  BOM  |
	
	converter := UTF16TextConverter new.
	converter useByteOrderMark: true.
	
	anOrder = #bigEndian ifTrue: [converter useLittleEndian: false].
	anOrder = #littleEndian ifTrue: [converter useLittleEndian: true].
	
	BOM := (converter useLittleEndian 
				ifTrue: [16rFFFE]
				ifFalse: [16rFEFF]) asByteArray asString.
	
	stream := String new writeStream. 
	aBlock value: converter value: stream.
	
	self assert: BOM equals: (stream contents  first: 2).
	! !

!UTF16TextConverterTest methodsFor: 'testing' stamp: 'HenrikSperreJohansen 8/9/2010 16:26'!
testByteOrders

	"Test that encoding / decoding a string witll produce the original string for both byte orders"

	"Default endianness"
	self assert: 'test' isTheSameAfterLittleEndianConversion: nil.
	"Big endian"
	self assert: 'test' isTheSameAfterLittleEndianConversion: false.
	"Little endian"
	self assert: 'test' isTheSameAfterLittleEndianConversion: true.
! !

!UTF16TextConverterTest methodsFor: 'testing' stamp: 'HenrikSperreJohansen 8/9/2010 16:43'!
testNoBOMWriteInMiddleOfFile
	
	"Test that BOM is not written when our first write does not occur at start of writestream"
	
	| converter stream |
	converter := UTF16TextConverter new.

	
	stream := String new writeStream.
	converter nextPutAll: 'testing' toStream: stream.
	stream position: 2.
	converter useByteOrderMark: true.
		
	converter nextPut: $a toStream: stream.
	self assert: 0 equals:  (stream contents indexOfSubCollection: 16rFEFF asByteArray asString)! !

!UTF16TextConverterTest methodsFor: 'testing' stamp: 'HenrikSperreJohansen 8/9/2010 16:19'!
testBOMWrite
	
	"Test that BOM is written correctly for both endians, both when using a nextPut:, and nextPutAll:"
	
	| batchConversion oneByOneConversion |
	batchConversion := [:converter :stream | converter nextPutAll: 'test' toStream: stream].
	oneByOneConversion := [:converter :stream | 'test' do: [:each | converter nextPut: each toStream: stream]].
	
	self assertBOMIsWrittenWithOrder: #bigEndian 
		andConversion: oneByOneConversion.
	self assertBOMIsWrittenWithOrder: #bigEndian 
		andConversion: batchConversion.
		
	self assertBOMIsWrittenWithOrder: #littleEndian 
		andConversion: oneByOneConversion.
	self assertBOMIsWrittenWithOrder: #littleEndian 
		andConversion: batchConversion.
		
	self assertBOMIsWrittenWithOrder: nil 
		andConversion: oneByOneConversion.
	self assertBOMIsWrittenWithOrder: nil 
		andConversion: batchConversion.! !

!UTF8DecomposedTextConverter commentStamp: 'michael.rueger 3/2/2009 13:51'!
An UTF8DecomposedTextConverter converts from decomposed UTF8 using the UnicodeCompositionStream.

Instance Variables
!
!UTF8DecomposedTextConverter methodsFor: 'conversion' stamp: 'michael.rueger 3/2/2009 14:12'!
nextFromStream: aStream

	| char resultChar |
	char := super nextFromStream: aStream.
	(CombinedChar isCompositionCharacter: char charCode)
		ifFalse: [^char].
	combinedChar
		ifNil: [
			combinedChar := CombinedChar new.
			combinedChar simpleAdd: char]
		ifNotNil: [
			[combinedChar simpleAdd: char]
				whileFalse: [char := super nextFromStream: aStream].
			resultChar := combinedChar combined.
			combinedChar := CombinedChar new.
			combinedChar simpleAdd: char.
			^resultChar]
! !

!UTF8DecomposedTextConverter class methodsFor: 'utilities' stamp: 'michael.rueger 3/31/2009 16:38'!
encodingNames

	^Array new
! !

!UTF8TextConverter commentStamp: '<historical>'!
Text converter for UTF-8.  Since the BOM is used to distinguish the MacRoman code and UTF-8 code, BOM is written for UTF-8 by #writeBOMOn: which is called by client.!
!UTF8TextConverter methodsFor: 'conversion' stamp: 'ar 4/9/2005 22:29'!
nextPut: aCharacter toStream: aStream 
	| leadingChar nBytes mask shift ucs2code |
	aStream isBinary ifTrue: [^aCharacter storeBinaryOn: aStream].
	leadingChar := aCharacter leadingChar.
	(leadingChar = 0 and: [aCharacter asciiValue < 128]) ifTrue: [
		aStream basicNextPut: aCharacter.
		^ aStream.
	].

	"leadingChar > 3 ifTrue: [^ aStream]."

	ucs2code := aCharacter asUnicode.
	ucs2code ifNil: [^ aStream].

	nBytes := ucs2code highBit + 3 // 5.
	mask := #(128 192 224 240 248 252 254 255) at: nBytes.
	shift := nBytes - 1 * -6.
	aStream basicNextPut: (Character value: (ucs2code bitShift: shift) + mask).
	2 to: nBytes do: [:i | 
		shift := shift + 6.
		aStream basicNextPut: (Character value: ((ucs2code bitShift: shift) bitAnd: 63) + 128).
	].

	^ aStream.
! !

!UTF8TextConverter methodsFor: 'friend' stamp: 'yo 11/8/2002 16:17'!
leadingChar

	^ self shouldNotImplement
! !

!UTF8TextConverter methodsFor: 'conversion' stamp: 'nicolascellier 5/30/2013 22:05'!
errorMalformedInput
	^ZnInvalidUTF8 new signal: 'Invalid utf8 input detected'! !

!UTF8TextConverter methodsFor: 'conversion' stamp: 'GabrielOmarCotelli 5/25/2010 21:22'!
nextFromStream: aStream
	| character1 value1 character2 value2 unicode character3 value3 character4 value4 |
	aStream isBinary
		ifTrue: [ ^ aStream basicNext ].
	character1 := aStream basicNext.
	character1 isNil
		ifTrue: [ ^ nil ].
	value1 := character1 asciiValue.
	value1 <= 127
		ifTrue: [ 
			"1-byte character"
			^ character1 ].	"at least 2-byte character"
	character2 := aStream basicNext.
	character2 isNil
		ifTrue: [ ^ self errorMalformedInput ].
	value2 := character2 asciiValue.
	(value1 bitAnd: 16rE0) = 192
		ifTrue: [ ^ Unicode value: ((value1 bitAnd: 31) bitShift: 6) + (value2 bitAnd: 63) ].	"at least 3-byte character"
	character3 := aStream basicNext.
	character3 isNil
		ifTrue: [ ^ self errorMalformedInput ].
	value3 := character3 asciiValue.
	(value1 bitAnd: 16rF0) = 224
		ifTrue: [ unicode := ((value1 bitAnd: 15) bitShift: 12) + ((value2 bitAnd: 63) bitShift: 6) + (value3 bitAnd: 63) ].
	(value1 bitAnd: 16rF8) = 240
		ifTrue: [ 
			"4-byte character"
			character4 := aStream basicNext.
			character4 isNil
				ifTrue: [ ^ self errorMalformedInput ].
			value4 := character4 asciiValue.
			unicode := ((value1 bitAnd: 16r7) bitShift: 18) + ((value2 bitAnd: 63) bitShift: 12)
				+ ((value3 bitAnd: 63) bitShift: 6) + (value4 bitAnd: 63) ].
	unicode isNil
		ifTrue: [ ^ self errorMalformedInput ].
	unicode > 16r10FFFD
		ifTrue: [ ^ self errorMalformedInput ].
	unicode = 16rFEFF
		ifTrue: [ ^ self nextFromStream: aStream ].
	^ Unicode value: unicode! !

!UTF8TextConverter class methodsFor: 'utilities' stamp: 'yo 12/19/2003 22:01'!
encodingNames

	^ #('utf-8' 'utf8') copy.
! !

!UTF8TextConverter class methodsFor: 'accessing' stamp: 'tak 1/12/2005 13:22'!
writeBOMOn: aStream
	"Write Byte Order Mark"
	aStream nextPut: 16rEF.
	aStream nextPut: 16rBB.
	aStream nextPut: 16rBF.
! !

!UTF8TextConverterTest commentStamp: 'TorstenBergmann 2/5/2014 10:18'!
SUnit tests for UTF8TextConverter!
!UTF8TextConverterTest methodsFor: 'testing' stamp: 'HenrikSperreJohansen 7/17/2012 13:07'!
testPutSingleCharacterBinary
	| actual |
	"Test that the raw 8/32bit representations of Characters/WideCharacters are stored when stream is binary.
	(In the case of internal writeStreams, that its destination is a ByteArray)"
	actual := ByteArray streamContents: [ :stream |
		| converter |
		converter := UTF8TextConverter new.
		converter
			nextPut: $a
			toStream: stream.
		converter
			nextPut: (Unicode value: 16r20AC)
			toStream: stream ].
	self assert: actual = #[97 0 0 16r20 16rAC]! !

!UTF8TextConverterTest methodsFor: 'testing' stamp: 'HenrikSperreJohansen 6/29/2012 10:52'!
testPutSingle4ByteEncodedCharacter
	| actual |
	"Test that the utf8-encoded bytes are stored when stream is ascii.
	(In the case of internal writeStreams, that its destination is a String)"
	actual := String streamContents: [ :stream |
		| converter |
		converter := UTF8TextConverter new.
		converter
			nextPut: (Unicode value: 16r24B62)
			toStream: stream ].
	self assert: actual asByteArray = #[2r11110000 2r10100100 2r10101101 2r10100010]
	! !

!UTF8TextConverterTest methodsFor: 'testing' stamp: 'HenrikSperreJohansen 6/29/2012 10:53'!
testPutSingle3ByteEncodedCharacter
	| actual |
	"Test that the utf8-encoded bytes are stored when stream is ascii.
	(In the case of internal writeStreams, that its destination is a String)"
	actual := String streamContents: [ :stream |
		| converter |
		converter := UTF8TextConverter new.
		converter
			nextPut: (Unicode value: 16r20AC)
			toStream: stream ].
	self assert: actual asByteArray = #[2r11100010 2r10000010 2r10101100]
	! !

!UTF8TextConverterTest methodsFor: 'testing' stamp: 'HenrikSperreJohansen 8/17/2012 11:37'!
testNextPutAllStartingAt
	"Test that non-ascii ByteString characters are converted correctly when using next:putAll:startingAt:"
	|converter stream source|
	converter := UTF8TextConverter new.
	stream := (String new: 10) writeStream.
	source := 'abcdefågh'. "Notice å at 7, which is a non-ascii character in latin1-range, hence ByteString encoded"
converter next: 5 putAll: source startingAt: 5 toStream: stream.
"C3A5 is twobyte utf8-encoding of å"
self assert: stream contents asByteArray = #[16r65 16r66 16rC3 16rA5 16r67 16r68] ! !

!UTF8TextConverterTest methodsFor: 'testing' stamp: 'HenrikSperreJohansen 6/29/2012 10:53'!
testPutSingle2ByteEncodedCharacter
	| actual |
	"Test that the utf8-encoded bytes are stored when stream is ascii.
	(In the case of internal writeStreams, that its destination is a String)"
	actual := String streamContents: [ :stream |
		| converter |
		converter := UTF8TextConverter new.
		converter
			nextPut: $ç
			toStream: stream ].
	self assert: actual asByteArray = #[2r11000011  2r10100111]
	! !

!UUID commentStamp: '<historical>'!
A class to generate UUID
by John M McIntosh johnmci@smalltalkconsulting.com

See http://www.webdav.org/specs/draft-leach-uuids-guids-01.txt

If a plugin does not exist then we generate a UUID version 4 type GUUID!
!UUID methodsFor: 'converting' stamp: 'damiencassou 5/30/2008 15:52'!
asUUID: aString 
	| stream token byte |
	stream := (aString 
		copyReplaceAll: '-'
		with: '') asUppercase readStream.
	1 
		to: stream size / 2
		do: 
			[ :i | 
			token := stream next: 2.
			byte := Integer 
				readFrom: token readStream
				base: 16.
			self 
				at: i
				put: byte ].
	^ self! !

!UUID methodsFor: 'comparing' stamp: 'JMM 11/22/2001 17:30'!
> aMagnitude 
	"Answer whether the receiver is greater than the argument."

	^aMagnitude < self! !

!UUID methodsFor: 'system primitives' stamp: 'ar 2/3/2002 19:42'!
primMakeUUID
	<primitive: 'primitiveMakeUUID' module: 'UUIDPlugin'>
	UUIDGenerator default generateBytes: self forVersion: 4.! !

!UUID methodsFor: 'comparing' stamp: 'JMM 11/22/2001 17:30'!
>= aMagnitude 
	"Answer whether the receiver is greater than or equal to the argument."

	^(self < aMagnitude) not! !

!UUID methodsFor: 'comparing' stamp: 'EstebanLorenzano 11/18/2011 13:56'!
< aMagnitude 
	"Answer whether the receiver is less than the argument."

	(self size = aMagnitude size) ifFalse: [ 
		^ self size < aMagnitude size ].
	1 to: self size do: [:i |
		(self at: i) = (aMagnitude at: i) ifFalse: [
			^ (self at: i) < (aMagnitude at: i) ]].			
	^false.! !

!UUID methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 11:15'!
initialize
	super initialize.
	self primMakeUUID.! !

!UUID methodsFor: 'converting' stamp: 'ar 2/8/2004 12:16'!
printHexAt: index to: aStream
	| map v |
	map := '0123456789abcdef'.
	v := self at: index.
	aStream nextPut: (map at: (v bitShift: -4) + 1). 
	aStream nextPut: (map at: (v bitAnd: 15) + 1).
! !

!UUID methodsFor: 'printing' stamp: 'ar 2/8/2004 12:16'!
printString
	^self asString! !

!UUID methodsFor: 'printing' stamp: 'JMM 10/9/2001 14:46'!
printOn: aStream
	aStream nextPutAll: 'an UUID('.
	self asString printOn: aStream.
	aStream nextPutAll: ')'! !

!UUID methodsFor: 'converting' stamp: 'gk 4/18/2006 22:15'!
asString36
	"Encode the UUID as a base 36 string using 0-9 and lowercase a-z.
	This is the shortest representation still being able to work as
	filenames etc since it does not depend on case nor characters
	that might cause problems, and it fits into short filenames like on
	the old MacOS HFS filesystem. The check for 36r is to make this code
	work in versions before Squeak 3.8."

	| num candidate |
	num := 0.
	1 to: self size do: [:i | num := num + ((256 raisedTo: i - 1) * (self at: i))].
	candidate := num printStringBase: 36.
	^((candidate beginsWith: '36r')
			ifTrue: [candidate copyFrom: 4 to: candidate size]
			ifFalse: [candidate]) asLowercase! !

!UUID methodsFor: 'converting' stamp: 'PeterHugossonMiller 9/3/2009 11:46'!
createStringStartingAt: index for: bytes

	| results candidate data |
	data := String new: bytes*2.
	results := data writeStream.
	index to: index+bytes -1 do: 
		[:i |
		candidate := ((self at: i) printStringBase: 16) last: 2.
		candidate first = $r ifTrue: [candidate := String with: $0 with: candidate last].
		results nextPutAll: candidate].
	^data asLowercase! !

!UUID methodsFor: 'testing' stamp: 'JMM 10/9/2001 14:17'!
isNilUUID
	1 to: self size do: [:i | (self at: i) ~= 0 ifTrue: [^false]].
	^true.! !

!UUID methodsFor: 'comparing' stamp: 'JMM 11/22/2001 17:30'!
<= aMagnitude 
	"Answer whether the receiver is less than or equal to the argument."

	^(self > aMagnitude) not! !

!UUID methodsFor: 'converting' stamp: 'PeterHugossonMiller 9/3/2009 11:46'!
asString
	| result data |
	data := String new: 36.
	result := data writeStream.
	1 to: 4 do:[:i| self printHexAt: i to: result].
	result nextPut: $-.
	5 to: 6 do:[:i| self printHexAt: i to: result].
	result nextPut: $-.
	7 to: 8 do:[:i| self printHexAt: i to: result].
	result nextPut: $-.
	9 to: 10 do:[:i| self printHexAt: i to: result].
	result nextPut: $-.
	11 to: 16 do:[:i| self printHexAt: i to: result].
	^data.
	! !

!UUID class methodsFor: 'instance creation' stamp: 'StephaneDucasse 8/21/2010 22:01'!
fromString36: aString
	"Decode the UUID from a base 36 string using 0-9 and lowercase a-z.
	This is the shortest representation still being able to work as
	filenames etc since it does not depend on case nor characters
	that might cause problems."

	| object num |
	object := self nilUUID.
	num := Integer readFrom: aString asUppercase readStream base: 36.
	1 to: 16 do: [:i | object at: i put: (num digitAt: i)].
	^object! !

!UUID class methodsFor: 'instance creation' stamp: 'nk 6/28/2004 16:10'!
nilUUID
	"Must call basicNew: here because I have a non-trivial initialize method."

	^self basicNew: 16! !

!UUID class methodsFor: 'instance creation' stamp: 'nk 7/30/2004 21:49'!
new
	^(self new: 16)! !

!UUID class methodsFor: 'instance creation' stamp: 'dvf 9/10/2004 23:10'!
fromString: aString
	| object |
	aString size ~= 36 ifTrue: [Error signal].
	object := self nilUUID. 
	object asUUID: aString.
	^object! !

!UUIDGenerator commentStamp: '<historical>'!
This class generates a pseudo-random UUID
by John M McIntosh johnmci@smalltalkconsulting.com

See http://www.webdav.org/specs/draft-leach-uuids-guids-01.txt!
!UUIDGenerator methodsFor: 'random seed' stamp: 'StephaneDucasse 2/2/2010 22:18'!
makeUnixSeed
	
	^ [FileStream readOnlyFileNamed: '/dev/urandom' do: [ :strm | 
			strm binary.
			strm converter: Latin1TextConverter new.
			Integer
				byte1: strm next
				byte2: strm next
				byte3: strm next
				byte4: strm next. ] ] on: FileStreamException do: [ nil ].
! !

!UUIDGenerator methodsFor: 'instance creation' stamp: 'JMM 11/22/2001 23:12'!
placeFields: aByteArray

	aByteArray at: 1 put: ((timeLow bitShift: -24) bitAnd: 16rFF).
	aByteArray at: 2 put: ((timeLow bitShift: -16) bitAnd: 16rFF).
	aByteArray at: 3 put: ((timeLow bitShift: -8) bitAnd: 16rFF).
	aByteArray at: 4 put: (timeLow bitAnd: 16rFF).
	aByteArray at: 5 put: ((timeMid bitShift: -8) bitAnd: 16rFF).
	aByteArray at: 6 put: (timeMid bitAnd: 16rFF).
	aByteArray at: 7 put: ((timeHiAndVersion bitShift: -8) bitAnd: 16rFF).
	aByteArray at: 8 put: (timeHiAndVersion bitAnd: 16rFF).
	aByteArray at: 9 put: clockSeqHiAndReserved.
	aByteArray at: 10 put: clockSeqLow.
	0 to: 5 do: [:i |
		aByteArray at: 11 + i put: ((node bitShift: (-8*i)) bitAnd: 16rFF)]
! !

!UUIDGenerator methodsFor: 'instance creation' stamp: 'CdG 11/19/2002 21:30'!
setupRandom
	randomCounter := 0.
	randomGenerator := Random seed: self makeSeed.! !

!UUIDGenerator methodsFor: 'instance creation' stamp: 'JMM 11/22/2001 23:13'!
generateFieldsVersion4

	timeLow := self generateRandomBitsOfLength: 32.
	timeMid := self generateRandomBitsOfLength: 16.
	timeHiAndVersion := 16r4000 bitOr: (self generateRandomBitsOfLength: 12).
	clockSeqHiAndReserved := 16r80 bitOr: (self generateRandomBitsOfLength: 6).
	clockSeqLow := self generateRandomBitsOfLength: 8.
	node := self generateRandomBitsOfLength: 48.
	! !

!UUIDGenerator methodsFor: 'accessors and mutators' stamp: 'JMM 11/21/2001 14:27'!
randomGenerator: aGenerator
	randomGenerator := aGenerator
! !

!UUIDGenerator methodsFor: 'accessors and mutators' stamp: 'JMM 11/21/2001 14:28'!
randomCounter
	^randomCounter! !

!UUIDGenerator methodsFor: 'accessors and mutators' stamp: 'JMM 11/21/2001 14:29'!
semaphoreForGenerator
	^semaphoreForGenerator! !

!UUIDGenerator methodsFor: 'generator' stamp: 'nice 1/5/2010 20:55'!
generateOneOrZero
	^self semaphoreForGenerator
		critical: [
			| value | 
			value := self randomGenerator next.
			self randomCounter: self randomCounter + 1.
			self randomCounter > 100000
				ifTrue: [self setupRandom].
			value < 0.5
					ifTrue: [0]
					ifFalse: [1]]! !

!UUIDGenerator methodsFor: 'instance creation' stamp: 'JMM 11/22/2001 13:45'!
generateBytes: aPlaceHolder forVersion: aVersion
	aVersion = 4 ifTrue: [self generateFieldsVersion4]
		ifFalse: [self error: 'Unsupported version'].
	self placeFields: aPlaceHolder.! !

!UUIDGenerator methodsFor: 'initialization' stamp: 'alain.plantec 5/28/2009 11:15'!
initialize
	super initialize.
	self setupRandom.
	semaphoreForGenerator := Semaphore forMutualExclusion.
	! !

!UUIDGenerator methodsFor: 'random seed' stamp: 'dew 2/8/2003 00:28'!
makeSeed
	"Try various methods of getting good seeds"
	| seed |
	seed := self makeUnixSeed.
	seed ifNotNil: [^seed].

	"not sure if this is reliably random... commented out for now. -dew"
	"seed := self makeSeedFromSound.
	seed ifNotNil: [^seed]."
	
	"default"
	[seed := (Time millisecondClockValue bitAnd: 16r3FFFFFFF) bitXor: self hash.
	seed := seed bitXor: (Time totalSeconds bitAnd: 16r3FFFFFFF).
	seed = 0] whileTrue: ["Try again if ever get a seed = 0"].

	^seed
! !

!UUIDGenerator methodsFor: 'generator' stamp: 'JMM 11/21/2001 15:12'!
generateRandomBitsOfLength: aNumberOfBits
| target |
	target := 0.
	aNumberOfBits isZero ifTrue: [^target].
	target := self generateOneOrZero.
	(aNumberOfBits - 1)  timesRepeat:
		[target := (target bitShift: 1)  bitOr: self generateOneOrZero].
	^target! !

!UUIDGenerator methodsFor: 'accessors and mutators' stamp: 'JMM 11/21/2001 14:29'!
randomCounter: aNumber
	randomCounter := aNumber
! !

!UUIDGenerator methodsFor: 'accessors and mutators' stamp: 'JMM 11/21/2001 14:27'!
randomGenerator
	^randomGenerator
! !

!UUIDGenerator methodsFor: 'accessors and mutators' stamp: 'JMM 11/21/2001 14:29'!
semaphoreForGenerator: aSema
	semaphoreForGenerator := aSema
! !

!UUIDGenerator class methodsFor: 'initialization' stamp: 'PavelKrivanek 6/10/2011 17:00'!
initialize
  Smalltalk addToStartUpList: self ! !

!UUIDGenerator class methodsFor: 'instance creation' stamp: 'JMM 11/22/2001 13:41'!
default
	Default ifNil: [self generateDefault].
	^Default! !

!UUIDGenerator class methodsFor: 'initialization' stamp: 'CdG 11/19/2002 21:07'!
startUp
	Default := nil! !

!UUIDGenerator class methodsFor: 'instance creation' stamp: 'nk 7/30/2004 21:51'!
generateDefault
	Default := self new! !

!UUIDPrimitivesTest commentStamp: 'TorstenBergmann 2/5/2014 10:11'!
SUnit tests for UUIDPrimitives !
!UUIDPrimitivesTest methodsFor: 'tests' stamp: 'JMM 11/22/2001 17:17'!
testCreationFromString
	| uuid string |
	string := UUID nilUUID asString.
	uuid := UUID fromString: string.
	self should: [uuid size = 16].
	self should: [uuid = UUID nilUUID].
	self should: [uuid isNilUUID].
	self should: [uuid asString size = 36].
	self should: [uuid asArray asSet size = 1].
	self should: [(uuid asArray asSet asArray at: 1) = 0].
! !

!UUIDPrimitivesTest methodsFor: 'tests' stamp: 'JMM 11/22/2001 17:16'!
testCreationNil
	| uuid |
	uuid := UUID nilUUID.
	self should: [uuid size = 16].
	self should: [uuid isNilUUID].
	self should: [uuid asString size = 36].
	self should: [uuid asArray asSet size = 1].
	self should: [(uuid asArray asSet asArray at: 1) = 0].
! !

!UUIDPrimitivesTest methodsFor: 'tests' stamp: 'JMM 11/22/2001 17:27'!
testCreationEquality
	| uuid1 uuid2 |
	uuid1 := UUID new.
	uuid2 := UUID new.
	self should: [uuid1 = uuid1].
	self should: [uuid2 = uuid2].
	self shouldnt: [uuid1 = uuid2].
	self shouldnt: [uuid1 hash = uuid2 hash].
! !

!UUIDPrimitivesTest methodsFor: 'tests' stamp: 'JMM 11/22/2001 17:18'!
testCreationFromStringNotNil
	| uuid string |
	string := UUID new asString.
	uuid := UUID fromString: string.
	self should: [uuid size = 16].
	self should: [uuid asString size = 36].

! !

!UUIDPrimitivesTest methodsFor: 'tests' stamp: 'StephaneDucasse 8/21/2010 20:54'!
testCreationFromString36NotNil
	| uuid uuid36 |
	uuid := UUID fromString: 'fedcba98-7654-3210-0123-456789abcdef'.
	uuid36 := UUID fromString36: 'e738i8a5the1f87mrh14o6vi6'.
	self should: [uuid = uuid36]! !

!UUIDPrimitivesTest methodsFor: 'tests' stamp: 'StephaneDucasse 8/21/2010 20:58'!
testCreationFromString36With0
	| uuid |
	uuid := UUID fromString36: '0'.
	self assert: (uuid isNilUUID).
	
! !

!UUIDPrimitivesTest methodsFor: 'tests' stamp: 'StephaneDucasse 7/22/2011 18:09'!
testUniqueness 
	"Test uniqueness for a given number of generated values"
	
	|maxTestValue|
	maxTestValue := 1000.
	self assert: ((1 to: maxTestValue) collect: [ :i | UUID new asString ]) asSet size = maxTestValue! !

!UUIDPrimitivesTest methodsFor: 'tests' stamp: 'nice 1/5/2010 15:59'!
testCreationNodeBased
	

	(UUID new asString last: 12) = (UUID new asString last: 12) ifFalse: [^self].
	1000 timesRepeat:
		[ | uuid |uuid := UUID new.
		self should: [((uuid at: 7) bitAnd: 16rF0) = 16r10].
		self should: [((uuid at: 9) bitAnd: 16rC0) = 16r80]]
! !

!UUIDPrimitivesTest methodsFor: 'tests' stamp: 'nice 1/5/2010 15:59'!
testOrder
	
	100 timesRepeat:
		[ | uuid1 uuid2 |uuid1 := UUID new.
		uuid2 := UUID new.
		(uuid1 asString last: 12) = (uuid2 asString last: 12) ifTrue:
			[self should: [uuid1 < uuid2].
			self should: [uuid2 > uuid1].
			self shouldnt: [uuid1 = uuid2]]]
! !

!UUIDPrimitivesTest methodsFor: 'tests' stamp: 'nice 1/5/2010 15:59'!
testDuplicationsKinda
	| check size |

	size := 5000.
	check := Set new: size.
	size timesRepeat: 
		[ | uuid |uuid := UUID new.
		self shouldnt: [check includes: uuid].
		check add: uuid].
		! !

!UUIDPrimitivesTest methodsFor: 'tests' stamp: 'StephaneDucasse 11/5/2011 15:35'!
testComparison
	"self debug: #testComparison"
	|a b|
	a := UUID fromString: '0608b9dc-02e4-4dd0-9f8a-ea45160df641'.
	b := UUID fromString: 'e85ae7ba-3ca3-4bae-9f62-cc2ce51c525e'.
	self assert: a < b.
	self deny: a> b.
	
	a := UUID fromString: '0608b9dc-02e4-4dd0-9f8a-ea45160df641'.
	b := UUID fromString: '0608b9dc-02e4-4dd0-9f8a-ea45160df642'.
	self assert: a < b.
	
	a := UUID fromString: '0608b9dc-02e4-4dd0-9f8a-ea45160df641'.
	b := UUID fromString: '0608b9dc-02e4-4dd0-9f8a-ea45160df640'.
	self assert: a > b.
	! !

!UUIDPrimitivesTest methodsFor: 'tests' stamp: 'CamilloBruni 9/1/2013 03:09'!
testCreationFromString36WithNillUUID
	
	UUID fromString36: (UUID nilUUID asString36).! !

!UUIDPrimitivesTest methodsFor: 'tests' stamp: 'JMM 11/22/2001 17:14'!
testCreation
	| uuid |
	uuid := UUID new.
	self should: [uuid size = 16].
	self shouldnt: [uuid isNilUUID].
	self should: [uuid asString size = 36].
! !

!UUIDTest commentStamp: 'TorstenBergmann 2/5/2014 10:12'!
SUnit tests for UUID!
!UUIDTest methodsFor: 'testing' stamp: 'EstebanLorenzano 11/18/2011 13:58'!
testComparison
	|a b|
	
	a := UUID fromString: '0608b9dc-02e4-4dd0-9f8a-ea45160df641'.
	b := UUID fromString: 'e85ae7ba-3ca3-4bae-9f62-cc2ce51c525e'.
	
	self assert: a = a copy.
	self assert: b = b copy.
	self assert: a < b.
	self assert: b > a.
	
	self deny: (a > b) = (b > a)
	
	! !

!UndeclaredVariable commentStamp: 'TorstenBergmann 1/31/2014 11:18'!
Notify about an undeclared variable!
!UndeclaredVariable methodsFor: 'as yet unclassified' stamp: 'cwp 10/15/2007 23:04'!
setParser: aParser name: aString range: anInterval 
	parser := aParser.
	name := aString.
	interval := anInterval! !

!UndeclaredVariable methodsFor: 'as yet unclassified' stamp: 'TorstenBergmann 11/29/2012 15:05'!
openMenuIn: aBlock 
	| alternatives labels actions lines caption choice |
	alternatives := parser possibleVariablesFor: name.
	labels := OrderedCollection new.
	actions := OrderedCollection new.
	lines := OrderedCollection new.
	name first isLowercase 
		ifTrue: 
			[labels add: 'Declare new temporary variable'.
			actions add: [parser declareTempAndPaste: name].
			labels add: 'Declare new instance variable'.
			actions add: [parser declareInstVar: name]]
		ifFalse: 
			[labels add: 'Define new class'.
			actions add: [parser defineClass: name].
			labels add: 'Declare new global'.
			actions add: [parser declareGlobal: name].
			parser canDeclareClassVariable 
				ifTrue: 
					[labels add: 'Declare new class variable'.
					actions add: [parser declareClassVar: name]]].
	lines add: labels size.
	alternatives do: 
		[:each | 
		labels add: each.
		actions add: [parser substituteVariable: each atInterval: interval]].
	lines add: labels size.
	labels add: 'Cancel'.
	caption := 'Unknown variable: ' , name , ' please correct, or cancel:'.
	choice := aBlock value: labels value: lines value: caption.
	choice ifNotNil: [self resume: (actions at: choice ifAbsent: [nil])]! !

!UndeclaredVariable class methodsFor: 'as yet unclassified' stamp: 'cwp 10/15/2007 22:37'!
signalFor: aParser name: aString inRange: anInterval 
	^ (self new setParser: aParser name: aString range: anInterval) signal! !

!UndeclaredVariableWarning commentStamp: 'TorstenBergmann 1/31/2014 11:16'!
A warning for an undeclared variable in a method of a class!
!UndeclaredVariableWarning methodsFor: 'initialize-release' stamp: 'eem 7/27/2008 17:37'!
name: aString selector: aSymbolOrNil class: aBehavior
	name := aString.
	selector := aSymbolOrNil.
	class := aBehavior! !

!UndeclaredVariableWarning methodsFor: 'exceptionDescription' stamp: 'CamilloBruni 7/25/2012 14:54'!
messageText
	^ String streamContents: [ :s | 
		selector 
			ifNotNil: [ s print: class; nextPutAll:  '>>'; print: selector; space]
			ifNil: [ s cr ].
		s nextPut: $(; print: name; nextPutAll: ' is Undeclared) ' ]! !

!UndeclaredVariableWarning methodsFor: 'exceptionDescription' stamp: 'StephaneDucasse 11/20/2011 15:32'!
defaultAction
	"The user should be notified of the occurrence of an exceptional occurrence and
	 given an option of continuing or aborting the computation. The description of the
	 occurrence should include any text specified as the argument of the #signal: message."
	
	selector ifNotNil: [self crTrace: class name, '>>', selector, ' ']
			ifNil: [self traceCr:''].
	self traceCr: '(' , name , ' is Undeclared) '.
	^true! !

!UndeclaredVariableWarning methodsFor: 'exceptionDescription' stamp: 'StephaneDucasse 2/16/2010 14:03'!
defaultResumeValue
	"Answer the value that by default should be returned if the exception is resumed"
	^true! !

!UndefinedObject commentStamp: '<historical>'!
I describe the behavior of my sole instance, nil. nil represents a prior value for variables that have not been initialized, or for results which are meaningless.!
!UndefinedObject methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
metacelloRegistrationHash
    ^ self hash! !

!UndefinedObject methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
asMetacelloVersionNumber

	^MetacelloVersionNumber fromString: ''! !

!UndefinedObject methodsFor: '*metacello-core' stamp: 'dkh 6/21/2012 18:06'!
asMetacelloSemanticVersionNumber
    ^ MetacelloSemanticVersionNumber fromString: ''! !

!UndefinedObject methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 1/23/2015 22:04'!
phlowValue: anObject withEnoughArguments: aCollection

	^ aCollection first! !

!UndefinedObject methodsFor: 'testing' stamp: 'MarcusDenker 4/9/2013 14:26'!
isNotNil 
	"Refer to the comment in Object|isNotNil."

	^false! !

!UndefinedObject methodsFor: 'testing' stamp: ''!
ifNotNil: aBlock
	"A convenient test, in conjunction with Object ifNotNil:"

	^ self! !

!UndefinedObject methodsFor: 'testing' stamp: ''!
ifNil: nilBlock ifNotNil: ifNotNilBlock
	"Evaluate the block for nil because I'm == nil"

	^ nilBlock value! !

!UndefinedObject methodsFor: 'testing' stamp: 'MarcusDenker 12/2/2013 14:13'!
ifNotNilDo: aBlock
	"Please use #ifNotNil: instead"

	^ self
! !

!UndefinedObject methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setProject: aString withInMetacelloConfig: aMetacelloConfig

	aMetacelloConfig setProject: aString withString: self! !

!UndefinedObject methodsFor: 'testing' stamp: 'MarcusDenker 12/2/2013 14:16'!
ifNotNilDo: ifNotNilBlock ifNil: nilBlock 
	"please use #ifNotNil:ifNil: "

	^ nilBlock value! !

!UndefinedObject methodsFor: 'dependents access' stamp: ''!
release
	"Nil release is a no-op"! !

!UndefinedObject methodsFor: 'class hierarchy' stamp: 'ar 7/15/1999 16:49'!
addSubclass: aClass
	"Ignored -- necessary to support disjoint class hierarchies"! !

!UndefinedObject methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setDescriptionInMetacelloVersion: aMetacelloVersionSpec

	aMetacelloVersionSpec setDescription: self! !

!UndefinedObject methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 1/22/2015 21:38'!
phlowValue: anObject value: otherObject

	^ anObject! !

!UndefinedObject methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setTimestampInMetacelloVersion: aMetacelloVersionSpec

	aMetacelloVersionSpec setTimestamp: self! !

!UndefinedObject methodsFor: 'testing' stamp: ''!
isNil 
	"Refer to the comment in Object|isNil."

	^true! !

!UndefinedObject methodsFor: 'testing' stamp: 'sw 1/12/98 18:09'!
haltIfNil
	self halt! !

!UndefinedObject methodsFor: 'testing' stamp: 'MarcusDenker 12/2/2013 14:15'!
ifNil: nilBlock ifNotNilDo: ifNotNilBlock
	"please use #ifNil:ifNotNil: "

	^ nilBlock value! !

!UndefinedObject methodsFor: 'class hierarchy' stamp: 'ClementBera 12/13/2013 15:02'!
subclass: nameOfClass  
	instanceVariableNames: instVarNames
	classVariableNames: classVarNames
	poolDictionaries: poolDictnames
	category: category
	"Calling this method is now considered an accident.  If you really want to create a class with a nil superclass, then create the class and then set the superclass using #superclass:"
	self traceCr: ('Attempt to create ', nameOfClass, ' as a subclass of nil.  Possibly a class is being loaded before its superclass.').
	^ Object
		subclass: nameOfClass
		instanceVariableNames: instVarNames
		classVariableNames: classVarNames
		poolDictionaries: poolDictnames
		category: category
! !

!UndefinedObject methodsFor: 'bottom context' stamp: 'ajh 2/1/2003 01:31'!
handleSignal: exception
	"When no more handler (on:do:) context left in sender chain this gets called.  Return from signal with default action."

	^ exception resumeUnchecked: exception defaultAction! !

!UndefinedObject methodsFor: '*NautilusCommon' stamp: 'BenjaminVanRyseghem 8/27/2011 22:49'!
asRingDefinition
	
	^ self! !

!UndefinedObject methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 2/17/2015 12:38'!
brickValue: anObject withEnoughArguments: aCollection

	^ anObject! !

!UndefinedObject methodsFor: '*opalcompiler-core' stamp: 'MarcusDenker 4/22/2013 16:56'!
allTempNames
	^#()! !

!UndefinedObject methodsFor: 'class hierarchy' stamp: 'ikp 9/26/97 14:45'!
removeSubclass: aClass
	"Ignored -- necessary to support disjoint class hierarchies"! !

!UndefinedObject methodsFor: '*Glamour-Morphic-Brick' stamp: 'AliakseiSyrel 1/22/2015 21:15'!
phlowValue: anObject

	^ anObject! !

!UndefinedObject methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setBlessingInMetacelloVersion: aMetacelloVersionSpec

	aMetacelloVersionSpec setBlessing: self! !

!UndefinedObject methodsFor: '*Fuel' stamp: 'MartinDias 2/21/2013 12:47'!
fuelAccept: aGeneralMapper

	^aGeneralMapper visitHookPrimitive: self! !

!UndefinedObject methodsFor: 'testing' stamp: ''!
ifNotNil: ifNotNilBlock ifNil: nilBlock 
	"If I got here, I am nil, so evaluate the block nilBlock"

	^ nilBlock value! !

!UndefinedObject methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setPostLoadDoItInMetacelloSpec: aMetacelloSpec

	aMetacelloSpec setPostLoadDoIt: 
		(aMetacelloSpec project valueHolderSpec
			value: self;
			yourself)! !

!UndefinedObject methodsFor: 'class hierarchy' stamp: 'sd 3/28/2003 15:16'!
environment
	"Necessary to support disjoint class hierarchies."

	^self class environment! !

!UndefinedObject methodsFor: 'class hierarchy' stamp: 'MarcusDenker 4/22/2014 17:24'!
allSuperclassesDo: aBlockContext 
	"Ignored -- necessary to support disjoint class hierarchies"! !

!UndefinedObject methodsFor: 'class hierarchy' stamp: 'MarcusDenker 7/15/2013 08:57'!
classBuilder
	"Answer the object responsible of creating classes in the system."
	
	^ OldClassBuilderAdapter new! !

!UndefinedObject methodsFor: 'printing' stamp: ''!
printOn: aStream 
	"Refer to the comment in Object|printOn:." 

	aStream nextPutAll: 'nil'! !

!UndefinedObject methodsFor: 'testing' stamp: ''!
ifNil: aBlock
	"A convenient test, in conjunction with Object ifNil:"

	^ aBlock value! !

!UndefinedObject methodsFor: 'copying' stamp: 'tk 8/20/1998 16:07'!
veryDeepCopyWith: deepCopier
	"Return self.  I can't be copied.  Do not record me."! !

!UndefinedObject methodsFor: '*monticellofiletree-core' stamp: 'topa 7/22/2013 01:03'!
writeCypressJsonOn: aStream forHtml: forHtml indent: startIndent
    "by default ignore <forHtml> ... <forHtml> is used for Dictionary and Array, i.e., container objects and String which actually encodes itself differently for HTML"

    aStream nextPutAll: 'null'.! !

!UndefinedObject methodsFor: 'bottom context' stamp: 'ajh 2/1/2003 01:31'!
canHandleSignal: exception
	"When no more handler (on:do:) context left in sender chain this gets called"

	^ false! !

!UndefinedObject methodsFor: 'class hierarchy' stamp: 'StephaneDucasse 2/13/2010 15:35'!
subclassesDo: aBlock
	"Evaluate aBlock with all subclasses of nil.  Others are not direct subclasses of Class."

	^ Class subclassesDo: [:cl | 
			cl isMeta ifTrue: [aBlock value: cl soleInstance]].! !

!UndefinedObject methodsFor: 'printing' stamp: ''!
storeOn: aStream 
	"Refer to the comment in Object|storeOn:." 

	aStream nextPutAll: 'nil'! !

!UndefinedObject methodsFor: 'copying' stamp: ''!
deepCopy
	"Only one instance of UndefinedObject should ever be made, so answer 
	with self."! !

!UndefinedObject methodsFor: 'class hierarchy' stamp: 'MarcusDenker 5/2/2013 11:38'!
subclassDefinerClass
	"For disjunct class hierarchies -- how should subclasses of nil be evaluated"
	^self class compilerClass! !

!UndefinedObject methodsFor: 'testing' stamp: 'sma 6/6/2000 22:53'!
isLiteral
	^ true! !

!UndefinedObject methodsFor: 'dependents access' stamp: ''!
addDependent: ignored 
	"Refer to the comment in Object|dependents."

	self error: 'Nil should not have dependents'! !

!UndefinedObject methodsFor: 'testing' stamp: ''!
notNil 
	"Refer to the comment in Object|notNil."

	^false! !

!UndefinedObject methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setAuthorInMetacelloVersion: aMetacelloVersionSpec

	aMetacelloVersionSpec setAuthor: self! !

!UndefinedObject methodsFor: 'copying' stamp: ''!
shallowCopy
	"Only one instance of UndefinedObject should ever be made, so answer 
	with self."! !

!UndefinedObject methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 16:04'!
gtInspectorSourceCodeIn: composite
	" nothing to do "! !

!UndefinedObject methodsFor: 'sets support' stamp: 'Igor.Stasenko 11/13/2009 06:16'!
asSetElement
	"Since nil is a singleton, we need only a single wrapper instance to represent it in set,
	created in advance"
	^ SetElement withNil! !

!UndefinedObject methodsFor: 'dependents access' stamp: ''!
suspend
	"Kills off processes that didn't terminate properly"
	"Display reverse; reverse."  "<-- So we can catch the suspend bug"
	Processor terminateActive! !

!UndefinedObject methodsFor: '*Fuel' stamp: 'MartinDias 2/21/2013 12:48'!
serializeOn: anEncoder
	"Do nothing"! !

!UndefinedObject methodsFor: 'class hierarchy' stamp: 'ajh 1/27/2003 17:48'!
literalScannedAs: scannedLiteral notifying: requestor 
	^ scannedLiteral! !

!UndefinedObject methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
setPreLoadDoItInMetacelloSpec: aMetacelloSpec

	aMetacelloSpec setPreLoadDoIt: 
		(aMetacelloSpec project valueHolderSpec
			value: self;
			yourself)! !

!UndefinedObject methodsFor: '*metacello-core' stamp: 'dkh 6/5/2012 19:01:24'!
registrationsCompareEqual: aMetacelloProjectSpec
    ^ self = aMetacelloProjectSpec! !

!UndefinedObject methodsFor: 'testing' stamp: 'sw 4/7/1999 17:44'!
isEmptyOrNil
	"Answer whether the receiver contains any elements, or is nil.  Useful in numerous situations where one wishes the same reaction to an empty collection or to nil"
	^ true! !

!UndefinedObject methodsFor: 'class hierarchy' stamp: 'ar 7/13/1999 06:08'!
typeOfClass
	"Necessary to support disjoint class hierarchies."
	^#normal! !

!UndefinedObject methodsFor: 'class hierarchy' stamp: 'PeterHugossonMiller 9/3/2009 11:46'!
subclasses
	"Return all the subclasses of nil"
	| classList |
	classList := Array new writeStream.
	self subclassesDo:[:class| classList nextPut: class].
	^classList contents! !

!UndefinedObject class methodsFor: 'accessing' stamp: 'nice 11/14/2009 19:22'!
allInstances
	"It is well known there is a single instance"
	
	^Array with: nil! !

!UndefinedObject class methodsFor: 'accessing' stamp: 'nice 11/14/2009 19:22'!
allInstancesDo: aBlock
	"It is well known there is a single instance"
	
	aBlock value: nil! !

!UndefinedObject class methodsFor: '*Fuel' stamp: 'MartinDias 2/21/2013 12:51'!
materializeFrom: aDecoder
	"Answer my unique instance"

	^ nil! !

!UndefinedObject class methodsFor: 'instance creation' stamp: ''!
new
	self error: 'You may not create any more undefined objects--use nil'! !

!UndefinedObjectTest commentStamp: '<historical>'!
This is the unit test for the class UndefinedObject. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see: 
	- http://www.c2.com/cgi/wiki?UnitTest
	- there is a chapter in the PharoByExample book (http://pharobyexample.org)
	- the sunit class category!
!UndefinedObjectTest methodsFor: 'tests - copying' stamp: 'GabrielOmarCotelli 5/25/2010 21:22'!
testVeryDeepCopyWith
	self assert: (nil veryDeepCopyWith: nil) isNil! !

!UndefinedObjectTest methodsFor: 'tests - testing' stamp: 'sd 6/5/2005 09:07'!
testIfNil

	self should: [ nil ifNil: [self halt]] raise: Halt.


! !

!UndefinedObjectTest methodsFor: 'tests - testing' stamp: 'sd 6/5/2005 09:08'!
testIsEmptyOrNil

	self assert: (nil isEmptyOrNil).! !

!UndefinedObjectTest methodsFor: 'tests - testing' stamp: 'sd 6/5/2005 09:08'!
testNotNil

	self deny: (nil notNil).! !

!UndefinedObjectTest methodsFor: 'tests - copying' stamp: 'GabrielOmarCotelli 5/25/2010 21:22'!
testDeepCopy
	self assert: nil deepCopy isNil! !

!UndefinedObjectTest methodsFor: 'tests - Class Methods' stamp: 'nice 11/14/2009 19:25'!
testAllInstances
	self assert: UndefinedObject allInstances size = 1 description: 'There should be a single instance of UndefinedObject'.
	self assert: (UndefinedObject allInstances includes: nil) description: 'nil should be an instance of UndefinedObject'.! !

!UndefinedObjectTest methodsFor: 'tests - copying' stamp: 'GabrielOmarCotelli 5/25/2010 21:22'!
testShallowCopy
	self assert: nil shallowCopy isNil! !

!UndefinedObjectTest methodsFor: 'tests - testing' stamp: 'sd 6/5/2005 09:08'!
testIfNilIfNotNil

	self should: [ nil ifNil: [self halt] ifNotNil: [self error] ] raise: Halt.


! !

!UndefinedObjectTest methodsFor: 'tests - testing' stamp: 'CamilloBruni 9/1/2013 03:09'!
testIfNotNil

	nil ifNotNil: [
		self fail: 'should not get here' ].


! !

!UndefinedObjectTest methodsFor: 'tests - testing' stamp: 'CamilloBruni 9/1/2013 03:09'!
testIfNotNilDo

	nil ifNotNil: [
		self fail: 'should not get here' ].
! !

!UndefinedObjectTest methodsFor: 'tests - testing' stamp: 'sd 6/5/2005 09:08'!
testIsNil

	self assert: (nil isNil).! !

!UndefinedObjectTest methodsFor: 'tests - Class Methods' stamp: 'sd 6/5/2005 09:09'!
testNew

	self should: [ UndefinedObject new] raise: Error.! !

!UndefinedObjectTest methodsFor: 'tests - testing' stamp: 'sd 6/5/2005 09:08'!
testIfNotNilIfNil

	self should: [ nil ifNotNil: [self error] ifNil: [self halt] ] raise: Halt.


! !

!UndefinedObjectTest methodsFor: 'tests - printing' stamp: 'sd 6/5/2005 09:09'!
testPrintOn

	| string |
	string := String streamContents: [:stream | nil printOn: stream].
	self assert: (string = 'nil').! !

!UndefinedObjectTest methodsFor: 'tests - testing' stamp: 'sd 6/5/2005 09:07'!
testHaltIfNil

	self should: [ nil haltIfNil] raise: Halt.! !

!UndefinedObjectTest methodsFor: 'tests - testing' stamp: 'sd 6/5/2005 09:08'!
testIsLiteral

	self assert: (nil isLiteral).! !

!UndefinedObjectTest methodsFor: 'tests - printing' stamp: 'MarcusDenker 5/3/2013 09:51'!
testStoreOn
	| string |
	string := String streamContents: [ :stream | nil storeOn: stream ].
	self assert: (self class compiler evaluate: string) isNil! !

!UndefinedVariable commentStamp: 'TorstenBergmann 1/31/2014 11:18'!
Notify about an undefined variable!
!UndefinedVariable methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 11/27/2012 15:28'!
openMenuIn: aBlock
	| caption index |
	caption := name, ' appears to be 
undefined at this point.
Proceed anyway?'.
	index := aBlock value: #('yes' 'no') value: #() value: caption.
	^ self resume: index = 1! !

!UndoRedoGroup commentStamp: 'AlainPlantec 12/14/2010 23:30'!
An UndoRedoGroup is a composite node of an history tree. It is made to allow redoing or undoing of several commands in one shot. See for example its use to record all text replacement when a "replace all" is performed from a FindReplaceService (see TextEditor>>replaceAll: with: startingAt:)

Instance Variables
!
!UndoRedoGroup methodsFor: 'undo-undo' stamp: 'AlainPlantec 12/14/2010 18:31'!
do
	self redo! !

!UndoRedoGroup methodsFor: 'undo-undo' stamp: 'AlainPlantec 12/14/2010 19:29'!
undo
	self history reverseDo: [:i | i undo]! !

!UndoRedoGroup methodsFor: 'undo-undo' stamp: 'AlainPlantec 12/14/2010 13:18'!
redo
	self history do: [:i | i redo]! !

!UndoRedoRecord commentStamp: 'AlainPlantec 12/14/2010 23:26'!
An UndoRedoRecord is a leaf of an history tree. It  holds undo and redo commands. Such a command is represented by a MessageSend. 

Instance Variables
	redoMessage:		<MessageSend>
	undoMessage:		<MessageSend>

redoMessage
	- The command which is performed for redoing

undoMessage
	- The command which is performed for undoing
!
!UndoRedoRecord methodsFor: 'compatibility' stamp: 'AlainPlantec 12/14/2010 08:17'!
doMessage: aMessageSend
	^ self redoMessage: aMessageSend
! !

!UndoRedoRecord methodsFor: 'accessing' stamp: 'AlainPlantec 12/13/2010 22:22'!
undoMessage

	^ undoMessage! !

!UndoRedoRecord methodsFor: 'accessing' stamp: 'AlainPlantec 12/13/2010 22:22'!
undoMessage: aMessageSend

	undoMessage := aMessageSend! !

!UndoRedoRecord methodsFor: 'accessing' stamp: 'AlainPlantec 12/13/2010 22:42'!
redoMessage

	^ redoMessage! !

!UndoRedoRecord methodsFor: 'compatibility' stamp: 'AlainPlantec 12/14/2010 08:16'!
do
	^self redo! !

!UndoRedoRecord methodsFor: 'compatibility' stamp: 'AlainPlantec 12/14/2010 08:16'!
doMessage

	^ self redoMessage! !

!UndoRedoRecord methodsFor: 'accessing' stamp: 'AlainPlantec 12/13/2010 22:42'!
redoMessage: aMessageSend

	redoMessage := aMessageSend! !

!UndoRedoRecord methodsFor: 'redo-undo' stamp: 'AlainPlantec 12/14/2010 13:12'!
undo
	^self undoMessage
		ifNotNil: [self undoMessage value].! !

!UndoRedoRecord methodsFor: 'redo-undo' stamp: 'AlainPlantec 12/14/2010 13:12'!
redo
	^self redoMessage value.! !

!UndoRedoRecord class methodsFor: 'compatibility' stamp: 'AlainPlantec 12/14/2010 08:15'!
doArray: doArray undoArray: undoArray
	^ self redoArray: doArray undoArray: undoArray! !

!UndoRedoRecord class methodsFor: 'instance creation' stamp: 'AlainPlantec 12/13/2010 22:43'!
redoArray: doArray undoArray: undoArray
	" doArray and undoArray are constructed as follow: #(receiver selector arguments) "
	| anUndoRecord |
	anUndoRecord := self new.
	anUndoRecord redoMessage: (MessageSend 
		receiver: 	(doArray first) 
		selector: 	(doArray second) 
		arguments: 	(doArray third)).
	undoArray 
		ifNotNil: [ 
			anUndoRecord undoMessage: (MessageSend 
				receiver: 	(undoArray first) 
				selector: 	(undoArray second) 
				arguments: 	(undoArray third))].
	^anUndoRecord.! !

!UndoRedoRecord class methodsFor: 'instance creation' stamp: 'AlainPlantec 12/13/2010 22:43'!
redo: doMessageSend undo: undoMessageSend

	| anUndoRecord |
	anUndoRecord := self new.
	anUndoRecord redoMessage: doMessageSend.
	anUndoRecord undoMessage: undoMessageSend.
	^anUndoRecord.! !

!UndoRedoRecord class methodsFor: 'compatibility' stamp: 'AlainPlantec 12/14/2010 08:15'!
do: doMessageSend undo: undoMessageSend
	^ self redo: doMessageSend undo: undoMessageSend! !

!UnhandledError commentStamp: '<historical>'!
I am the ultimate error. 
By default if an Error or Exception is not handled by the code the default action is to raise an UnhandledError which in interactive mode triggers the UIManager to open a debugger.

	Error signal
	...
	UnhandledError signalForException: error
	...
	UIManager opens a debugger
	!
!UnhandledError methodsFor: 'accessing' stamp: 'ajh 9/4/2002 19:15'!
exception: anError

	exception := anError! !

!UnhandledError methodsFor: 'accessing' stamp: 'ajh 9/4/2002 19:15'!
exception

	^ exception! !

!UnhandledError methodsFor: 'priv handling' stamp: 'MarcusDenker 4/22/2013 10:17'!
defaultAction
	<reflective: #unhandledErrorDefaultAction:message:>
 	^ Smalltalk globals 
		at: #UIManager
		ifPresent: [:class | class default unhandledErrorDefaultAction: self exception]
		ifAbsent: [ Transcript show: 'unhandled error' ].! !

!UnhandledError methodsFor: 'priv handling' stamp: 'ajh 2/1/2003 00:56'!
isResumable
	
	^ false! !

!UnhandledError class methodsFor: 'signalling' stamp: 'ajh 9/4/2002 19:17'!
signalForException: anError

	^ self new
		exception: anError;
		signal! !

!Unicode commentStamp: 'yo 10/19/2004 20:44'!
This class holds the entry points for the utility functions around characters.
!
!Unicode class methodsFor: 'class methods' stamp: 'yo 12/4/2004 22:47'!
isCharset

	^ false.
! !

!Unicode class methodsFor: '*Multilingual-OtherLanguages' stamp: 'yo 1/12/2004 18:11'!
isJapanese: code

	^ code > 255 and: [(JISX0208 charFromUnicode: code) notNil].
! !

!Unicode class methodsFor: '*Multilingual-OtherLanguages' stamp: 'yo 1/12/2004 18:00'!
isTraditionalChinese: code

	^ false.
! !

!Unicode class methodsFor: 'casing' stamp: 'CamilloBruni 9/29/2011 02:19'!
toUppercase: aCharacter
	"Transform a Wide String into uppercase.
	This does not handle special cases where number of characters could change.
	The algorithm would work for ByteString, however it's far from the most efficient."
	
	(ToUpper at: aCharacter charCode ifAbsent: [ ^ aCharacter ])
			ifNotNil: [:up | ^ self value: up]! !

!Unicode class methodsFor: '*Multilingual-OtherLanguages' stamp: 'yo 1/12/2004 17:55'!
isUnifiedKanji: code

	^ ((((16r2E80 <= code and: [code <= 16rA4CF])
		or: [16rF900 <= code and: [code <= 16rFAFF]])
			or: [16rFE30 <= code and: [code <= 16rFE4F]])
				or: [16rFF00 <= code and: [code <= 16rFFEF]])
					or: [16r20000 <= code and: [code <= 16r2FA1F]].
! !

!Unicode class methodsFor: 'class initialization' stamp: 'StephaneDucasse 8/22/2013 14:34'!
initialize
	"This class should be initialized using the textual unicode definitions that can be found in
	http://www.unicode.org/Public/UNIDATA/UnicodeData.txt
	http://www.unicode.org/Public/UNIDATA/CaseFolding.txt
	
	To do that, this class posesses the class side methods:
	#parseCaseMappingFrom:
	#parseUnicodeDataFrom:
	
	The initialization order is:
	1) tag constants
	2) unicode data
	3) case mappings
	"
	"If you are in a full image, you can try the following Zinc scripts to download the file automatically:
	
	UIManager default informUserDuring: [ :bar| | result |
            bar label: 'Downloading Unicode data'.
            (result := ZnEasy get: 'http://www.unicode.org/Public/UNIDATA/UnicodeData.txt') isSuccess
                ifFalse: [ ^ self error: 'Download failed' ].
            bar label: 'Updating Case Mappings'.
            self parseUnicodeDataFrom: result contents readStream ].

	UIManager default informUserDuring: [ :bar| | result |
		bar label: 'Downloading Unicode case mappings data'.
		(result := ZnEasy get: 'http://www.unicode.org/Public/UNIDATA/CaseFolding.txt') isSuccess
			ifFalse: [ ^ self error: 'Download failed' ].
		bar label: 'Updating Case Mappings'.
		self parseCaseMappingFrom: result contents readStream ].
	"
	
	EncodedCharSet declareEncodedCharSet: self atIndex: 0+1.
	EncodedCharSet declareEncodedCharSet: self atIndex: 256.
! !

!Unicode class methodsFor: 'instance creation' stamp: 'nice 2/28/2010 20:05'!
value: code

	| l |
	code < 256 ifTrue: [^ Character value: code].
	l := Locale currentPlatform languageEnvironment leadingChar.
	^ Character leadingChar: l code: code.
! !

!Unicode class methodsFor: 'instance creation' stamp: 'nice 5/1/2011 19:25'!
charFromUnicode: uniCode

	^ Character value: uniCode
! !

!Unicode class methodsFor: 'character classification' stamp: 'kwl 6/30/2006 02:56'!
isLetter: char 
	| value codeCat |
	value := char charCode.
	value > (GeneralCategory size - 1)
		ifTrue: [^ false].
	^ (codeCat := GeneralCategory at: value + 1) >= Ll
		and: [codeCat <= Lu]! !

!Unicode class methodsFor: 'comments' stamp: 'yo 12/23/2002 13:04'!
blocks320Comment

"# Blocks-3.2.0.txt
# Correlated with Unicode 3.2
# Start Code..End Code; Block Name
0000..007F; Basic Latin
0080..00FF; Latin-1 Supplement
0100..017F; Latin Extended-A
0180..024F; Latin Extended-B
0250..02AF; IPA Extensions
02B0..02FF; Spacing Modifier Letters
0300..036F; Combining Diacritical Marks
0370..03FF; Greek and Coptic
0400..04FF; Cyrillic
0500..052F; Cyrillic Supplementary
0530..058F; Armenian
0590..05FF; Hebrew
0600..06FF; Arabic
0700..074F; Syriac
0780..07BF; Thaana
0900..097F; Devanagari
0980..09FF; Bengali
0A00..0A7F; Gurmukhi
0A80..0AFF; Gujarati
0B00..0B7F; Oriya
0B80..0BFF; Tamil
0C00..0C7F; Telugu
0C80..0CFF; Kannada
0D00..0D7F; Malayalam
0D80..0DFF; Sinhala
0E00..0E7F; Thai
0E80..0EFF; Lao
0F00..0FFF; Tibetan
1000..109F; Myanmar
10A0..10FF; Georgian
1100..11FF; Hangul Jamo
1200..137F; Ethiopic
13A0..13FF; Cherokee
1400..167F; Unified Canadian Aboriginal Syllabics
1680..169F; Ogham
16A0..16FF; Runic
1700..171F; Tagalog
1720..173F; Hanunoo
1740..175F; Buhid
1760..177F; Tagbanwa
1780..17FF; Khmer
1800..18AF; Mongolian
1E00..1EFF; Latin Extended Additional
1F00..1FFF; Greek Extended
2000..206F; General Punctuation
2070..209F; Superscripts and Subscripts
20A0..20CF; Currency Symbols
20D0..20FF; Combining Diacritical Marks for Symbols
2100..214F; Letterlike Symbols
2150..218F; Number Forms
2190..21FF; Arrows
2200..22FF; Mathematical Operators
2300..23FF; Miscellaneous Technical
2400..243F; Control Pictures
2440..245F; Optical Character Recognition
2460..24FF; Enclosed Alphanumerics
2500..257F; Box Drawing
2580..259F; Block Elements
25A0..25FF; Geometric Shapes
2600..26FF; Miscellaneous Symbols
2700..27BF; Dingbats
27C0..27EF; Miscellaneous Mathematical Symbols-A
27F0..27FF; Supplemental Arrows-A
2800..28FF; Braille Patterns
2900..297F; Supplemental Arrows-B
2980..29FF; Miscellaneous Mathematical Symbols-B
2A00..2AFF; Supplemental Mathematical Operators
2E80..2EFF; CJK Radicals Supplement
2F00..2FDF; Kangxi Radicals
2FF0..2FFF; Ideographic Description Characters
3000..303F; CJK Symbols and Punctuation
3040..309F; Hiragana
30A0..30FF; Katakana
3100..312F; Bopomofo
3130..318F; Hangul Compatibility Jamo
3190..319F; Kanbun
31A0..31BF; Bopomofo Extended
31F0..31FF; Katakana Phonetic Extensions
3200..32FF; Enclosed CJK Letters and Months
3300..33FF; CJK Compatibility
3400..4DBF; CJK Unified Ideographs Extension A
4E00..9FFF; CJK Unified Ideographs
A000..A48F; Yi Syllables
A490..A4CF; Yi Radicals
AC00..D7AF; Hangul Syllables
D800..DB7F; High Surrogates
DB80..DBFF; High Private Use Surrogates
DC00..DFFF; Low Surrogates
E000..F8FF; Private Use Area
F900..FAFF; CJK Compatibility Ideographs
FB00..FB4F; Alphabetic Presentation Forms
FB50..FDFF; Arabic Presentation Forms-A
FE00..FE0F; Variation Selectors
FE20..FE2F; Combining Half Marks
FE30..FE4F; CJK Compatibility Forms
FE50..FE6F; Small Form Variants
FE70..FEFF; Arabic Presentation Forms-B
FF00..FFEF; Halfwidth and Fullwidth Forms
FFF0..FFFF; Specials
10300..1032F; Old Italic
10330..1034F; Gothic
10400..1044F; Deseret
1D000..1D0FF; Byzantine Musical Symbols
1D100..1D1FF; Musical Symbols
1D400..1D7FF; Mathematical Alphanumeric Symbols
20000..2A6DF; CJK Unified Ideographs Extension B
2F800..2FA1F; CJK Compatibility Ideographs Supplement
E0000..E007F; Tags
F0000..FFFFF; Supplementary Private Use Area-A
100000..10FFFF; Supplementary Private Use Area-B


"! !

!Unicode class methodsFor: 'class initialization' stamp: 'GuillermoPolito 6/29/2012 17:58'!
parseUnicodeDataFrom: stream
	| line fieldEnd point fieldStart toNumber generalCategory decimalProperty loValue |

	toNumber := [:quad | ('16r', quad) asNumber].

	GeneralCategory := SparseLargeTable new: 16rE0080 chunkSize: 1024 arrayClass: Array base: 1 defaultValue:  (self classPool at: #Cn).
	DecimalProperty := SparseLargeTable new: 16rE0080 chunkSize: 32 arrayClass: Array base: 1 defaultValue: -1.

	loValue := (self classPool at: #Lo).
	16r3400 to: 16r4DB5 do: [:i | GeneralCategory at: i+1 put: loValue].
	16r4E00 to: 16r9FA5 do: [:i | GeneralCategory at: i+1 put: loValue].
	16rAC00 to: 16rD7FF do: [:i | GeneralCategory at: i+1 put: loValue].

	[(line := stream nextLine) notNil and: [line size > 0 ]] whileTrue: [
		fieldEnd := line indexOf: $; startingAt: 1.
		point := toNumber value: (line copyFrom: 1 to: fieldEnd - 1).
		point > 16rE007F ifTrue: [
			GeneralCategory zapDefaultOnlyEntries.
			DecimalProperty zapDefaultOnlyEntries.
			^ self].
		2 to: 3 do: [:i |
			fieldStart := fieldEnd + 1.
			fieldEnd := line indexOf: $; startingAt: fieldStart.
		].
		generalCategory := line copyFrom: fieldStart to: fieldEnd - 1.
		GeneralCategory at: point+1 put: (self classPool at: generalCategory asSymbol).
		generalCategory = 'Nd' ifTrue: [
			4 to: 7 do: [:i |
				fieldStart := fieldEnd + 1.
				fieldEnd := line indexOf: $; startingAt: fieldStart.
			].
			decimalProperty :=  line copyFrom: fieldStart to: fieldEnd - 1.
			DecimalProperty at: point+1 put: decimalProperty asNumber.
		].
	].
	GeneralCategory zapDefaultOnlyEntries.
	DecimalProperty zapDefaultOnlyEntries.
! !

!Unicode class methodsFor: '*Multilingual-OtherLanguages' stamp: 'yo 1/12/2004 18:11'!
isKorean: code

	^ code > 255 and: [(KSX1001 charFromUnicode: code) notNil]

! !

!Unicode class methodsFor: '*Multilingual-OtherLanguages' stamp: 'yo 1/12/2004 18:11'!
isSimplifiedChinese: code

	^ code > 255 and: [(GB2312 charFromUnicode: code) notNil]


! !

!Unicode class methodsFor: 'class initialization' stamp: 'nice 3/28/2011 23:40'!
initializeTagConstants
	" Unicode initializeTagConstants "
	(self classPool keys
		select: [:sym | sym size = 2 
						and: [sym first isUppercase and: [sym last isLowercase]]]) asSortedCollection
		inject: 1
		into: [:index :sym | sym = #Cn
				ifTrue: [self classPool at: sym put: 0. index]
				ifFalse: [self classPool at: sym put: index. index + 1]]! !

!Unicode class methodsFor: 'casing' stamp: 'nice 7/14/2010 15:00'!
toCasefold: aWideString
	"Transform a Wide String into fold case.
	This is to enable case insensitive conversion."
	
	^aWideString collect: [:e |
		(ToCasefold at: e charCode ifAbsent: [nil])
			ifNil: [e]
			ifNotNil: [:low | self value: low]]! !

!Unicode class methodsFor: 'class methods' stamp: 'yo 12/24/2002 07:49'!
compoundTextFinalChar

	self shouldNotImplement.
! !

!Unicode class methodsFor: 'casing' stamp: 'CamilloBruni 9/29/2011 02:17'!
toUppercaseString: aWideString
	"Transform a Wide String into uppercase.
	This does not handle special cases where number of characters could change.
	The algorithm would work for ByteString, however it's far from the most efficient."
	
	^aWideString collect: [:e |
		(ToUpper at: e charCode ifAbsent: [nil])
			ifNil: [e]
			ifNotNil: [:up | self value: up]]! !

!Unicode class methodsFor: 'character classification' stamp: 'kwl 6/30/2006 02:58'!
isUppercase: char 
	| value |
	value := char charCode.
	value > (GeneralCategory size - 1)
		ifTrue: [^ false].
	^ (GeneralCategory at: value + 1)
		= Lu! !

!Unicode class methodsFor: 'comments' stamp: 'yo 3/17/2004 23:38'!
blocks320Comment2

"# Blocks-3.2.0.txt
# Correlated with Unicode 3.2
# Start Code..End Code; Block Name
0000..007F; Basic Latin
0080..00FF; Latin-1 Supplement

 => Latin 1

0100..017F; Latin Extended-A
0180..024F; Latin Extended-B
0250..02AF; IPA Extensions

  => LatinExtended1

02B0..02FF; Spacing Modifier Letters
0300..036F; Combining Diacritical Marks

  => Modifiers

0370..03FF; Greek and Coptic
0400..04FF; Cyrillic
0500..052F; Cyrillic Supplementary
0530..058F; Armenian

   => EuropeanAlphabetic1

0590..05FF; Hebrew
0600..06FF; Arabic
0700..074F; Syriac
0780..07BF; Thaana

   => MiddleEastern

0900..097F; Devanagari
0980..09FF; Bengali
0A00..0A7F; Gurmukhi
0A80..0AFF; Gujarati
0B00..0B7F; Oriya
0B80..0BFF; Tamil
0C00..0C7F; Telugu
0C80..0CFF; Kannada
0D00..0D7F; Malayalam
0D80..0DFF; Sinhala

  => South Asian1


0E00..0E7F; Thai
0E80..0EFF; Lao

 => Southeastern 1

0F00..0FFF; Tibetan

  => South Asian1

1000..109F; Myanmar

 => Southeastern 1


10A0..10FF; Georgian

   => European Alphabetic 2

1100..11FF; Hangul Jamo

   => Korean

1200..137F; Ethiopic
13A0..13FF; Cherokee
1400..167F; Unified Canadian Aboriginal Syllabics

  => Additional1

1680..169F; Ogham
16A0..16FF; Runic

  => European Alphabetic 3

1700..171F; Tagalog
1720..173F; Hanunoo
1740..175F; Buhid
1760..177F; Tagbanwa
1780..17FF; Khmer

  => Southeastern2

1800..18AF; Mongolian

  => Additional2

1E00..1EFF; Latin Extended Additional
1F00..1FFF; Greek Extended

  => EuropeanAlphabetic4

2000..206F; General Punctuation
2070..209F; Superscripts and Subscripts
20A0..20CF; Currency Symbols
20D0..20FF; Combining Diacritical Marks for Symbols
2100..214F; Letterlike Symbols
2150..218F; Number Forms
2190..21FF; Arrows
2200..22FF; Mathematical Operators
2300..23FF; Miscellaneous Technical
2400..243F; Control Pictures
2440..245F; Optical Character Recognition
2460..24FF; Enclosed Alphanumerics
2500..257F; Box Drawing
2580..259F; Block Elements
25A0..25FF; Geometric Shapes
2600..26FF; Miscellaneous Symbols
2700..27BF; Dingbats
27C0..27EF; Miscellaneous Mathematical Symbols-A
27F0..27FF; Supplemental Arrows-A
2800..28FF; Braille Patterns
2900..297F; Supplemental Arrows-B
2980..29FF; Miscellaneous Mathematical Symbols-B
2A00..2AFF; Supplemental Mathematical Operators

  => Symbols2

2E80..2EFF; CJK Radicals Supplement
2F00..2FDF; Kangxi Radicals
2FF0..2FFF; Ideographic Description Characters
3000..303F; CJK Symbols and Punctuation
3040..309F; Hiragana
30A0..30FF; Katakana
3100..312F; Bopomofo
3130..318F; Hangul Compatibility Jamo
3190..319F; Kanbun
31A0..31BF; Bopomofo Extended
31F0..31FF; Katakana Phonetic Extensions
3200..32FF; Enclosed CJK Letters and Months
3300..33FF; CJK Compatibility
3400..4DBF; CJK Unified Ideographs Extension A
4E00..9FFF; CJK Unified Ideographs
A000..A48F; Yi Syllables
A490..A4CF; Yi Radicals

  => CJK

AC00..D7AF; Hangul Syllables

  => Korean

D800..DB7F; High Surrogates
DB80..DBFF; High Private Use Surrogates
DC00..DFFF; Low Surrogates
E000..F8FF; Private Use Area

F900..FAFF; CJK Compatibility Ideographs

  => CJK

FB00..FB4F; Alphabetic Presentation Forms
FB50..FDFF; Arabic Presentation Forms-A

  => Middle Eastern 2

FE00..FE0F; Variation Selectors
FE20..FE2F; Combining Half Marks

FE30..FE4F; CJK Compatibility Forms

  => CJK

FE50..FE6F; Small Form Variants

 => Symbol3

FE70..FEFF; Arabic Presentation Forms-B

  => Middle Eastern 3

FF00..FFEF; Halfwidth and Fullwidth Forms
FFF0..FFFF; Specials

  => Specials

10300..1032F; Old Italic
10330..1034F; Gothic
10400..1044F; Deseret

   => European

1D000..1D0FF; Byzantine Musical Symbols
1D100..1D1FF; Musical Symbols
1D400..1D7FF; Mathematical Alphanumeric Symbols

  => Symbols

20000..2A6DF; CJK Unified Ideographs Extension B
2F800..2FA1F; CJK Compatibility Ideographs Supplement

  => CJK

E0000..E007F; Tags
F0000..FFFFF; Supplementary Private Use Area-A
100000..10FFFF; Supplementary Private Use Area-B

  => Special

"! !

!Unicode class methodsFor: 'character classification' stamp: 'kwl 6/30/2006 02:55'!
isDigit: char 
	| value |
	value := char charCode.
	value > (GeneralCategory size - 1)
		ifTrue: [^ false].
	^ (GeneralCategory at: value + 1)
		= Nd! !

!Unicode class methodsFor: 'class methods' stamp: 'yo 12/24/2002 08:03'!
compoundTextSequence

	self subclassResponsibility.
! !

!Unicode class methodsFor: 'class methods' stamp: 'yo 8/5/2003 16:12'!
generalCategoryComment
"
Lu Letter, Uppercase 
Ll Letter, Lowercase 
Lt Letter, Titlecase 
Lm Letter, Modifier 
Lo Letter, Other 
Mn Mark, Non-Spacing 
Mc Mark, Spacing Combining 
Me Mark, Enclosing 
Nd Number, Decimal 
Nl Number, Letter 
No Number, Other 
Pc Punctuation, Connector 
Pd Punctuation, Dash 
Ps Punctuation, Open 
Pe Punctuation, Close 
Pi Punctuation, Initial quote (may behave like Ps or Pe depending on usage) 
Pf Punctuation, Final quote (may behave like Ps or Pe depending on usage) 
Po Punctuation, Other 
Sm Symbol, Math 
Sc Symbol, Currency 
Sk Symbol, Modifier 
So Symbol, Other 
Zs Separator, Space 
Zl Separator, Line 
Zp Separator, Paragraph 
Cc Other, Control 
Cf Other, Format 
Cs Other, Surrogate 
Co Other, Private Use 
Cn Other, Not Assigned (no characters in the file have this property) 
"! !

!Unicode class methodsFor: 'class methods' stamp: 'nice 2/28/2010 16:34'!
leadingChar
	^ 0! !

!Unicode class methodsFor: 'casing' stamp: 'CamilloBruni 9/29/2011 02:19'!
toLowercase: aCharacter
	"Transform a Wide String into lowercase.
	This does not handle special cases where number of characters could change.
	The algorithm would work for ByteString, however it's far from the most efficient."
	
	(ToLower at: aCharacter charCode ifAbsent: [ ^ aCharacter ])
			ifNotNil: [:low | ^ self value: low ]! !

!Unicode class methodsFor: 'class methods' stamp: 'yo 2/20/2004 14:12'!
generalCategory

	^ GeneralCategory.

! !

!Unicode class methodsFor: 'character classification' stamp: 'kwl 6/30/2006 02:57'!
isLowercase: char 
	| value |
	value := char charCode.
	value > (GeneralCategory size - 1)
		ifTrue: [^ false].
	^ (GeneralCategory at: value + 1)
		= Ll! !

!Unicode class methodsFor: 'class methods' stamp: 'StephaneDucasse 2/13/2010 16:04'!
digitValueOf: char
	"Answer 0-9 if the receiver is $0-$9, 10-35 if it is $A-$Z, and < 0
	otherwise. This is used to parse literal numbers of radix 2-36."
	
	| value |
	value := char charCode.
	value <= $9 asciiValue 
		ifTrue: [^value - $0 asciiValue].
	value >= $A asciiValue 
		ifTrue: [ value <= $Z asciiValue ifTrue: [^value - $A asciiValue + 10].
				(value >= $a asciiValue and: [value <= $z asciiValue]) 
					ifTrue: [^value - $a asciiValue + 10]].

	value > (DecimalProperty size - 1) ifTrue: [^ -1].
	^ (DecimalProperty at: value+1)
! !

!Unicode class methodsFor: 'class initialization' stamp: 'GabrielOmarCotelli 12/4/2013 10:09'!
parseCaseMappingFrom: stream
	"Parse the Unicode casing mappings from the given stream.
	Handle only the simple mappings"

	ToCasefold := IdentityDictionary new: 2048.
	ToUpper := IdentityDictionary new: 2048.
	ToLower := IdentityDictionary new: 2048.
	[ stream atEnd ]
		whileFalse: [ 
			| fields line srcCode dstCode |
			line := stream nextLine copyUpTo: $#.
			fields := line trimBoth findTokens: $;.
			(fields size > 2 and: [ #('C' 'S') includes: (fields at: 2) trimBoth ])
				ifTrue: [ 
					srcCode := Integer readFrom: (fields at: 1) trimBoth base: 16.
					dstCode := Integer readFrom: (fields at: 3) trimBoth base: 16.
					ToCasefold at: srcCode put: dstCode ] ].
	ToCasefold
		keysAndValuesDo: [ :k :v | 
			(self isUppercase: (self value: k))
				ifTrue: [ 
					"In most cases, uppercase letter are folded to lower case"
					ToUpper at: v ifAbsentPut: k.
					ToLower at: k ifAbsentPut: v ].
			(self isLowercase: (self value: k))
				ifTrue: [ 
					"In a few cases, two lower case letters are folded to the same lower case.
				We must find an upper case letter folded to the same letter"
					ToCasefold keys
						detect: [ :e | (self isUppercase: (self value: e)) and: [ (ToCasefold at: e) = v ] ]
						ifFound: [ :up | ToUpper at: k ifAbsentPut: up ] ] ]! !

!Unicode class methodsFor: 'casing' stamp: 'CamilloBruni 9/29/2011 02:17'!
toLowercaseString: aWideString
	"Transform a Wide String into lowercase.
	This does not handle special cases where number of characters could change.
	The algorithm would work for ByteString, however it's far from the most efficient."
	
	^aWideString collect: [:e |
		(ToLower at: e charCode ifAbsent: [nil])
			ifNil: [e]
			ifNotNil: [:low | self value: low]]! !

!UnixClipboard commentStamp: 'HenrikSperreJohansen 1/28/2011 15:15'!
The Unix vm does not do line-ending conversion, thus this subclass which specifies we convert CR's to LF's when pasting to it!
!UnixClipboard methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 1/28/2011 15:19'!
clipboardText: text 

        | string |
        string := text asString.
        self noteRecentClipping: text asText.
        contents := text asText.
        string := string convertToWithConverter: UTF8TextConverter new.
        string := string replaceAll: 13 asCharacter with: 10 asCharacter.
        self primitiveClipboardText: string.! !

!UnixEnvironment commentStamp: '<historical>'!
I am a specialized OSEnvironment version for *nix systems (Linux, OSX).!
!UnixEnvironment methodsFor: 'enumeration' stamp: 'CamilloBruni 4/29/2013 17:46'!
keysAndValuesDo: aBlock
	| index associationString  |
	index := 1	.
	[ 
		associationString := self environAt: index.
		associationString ifNil: [ ^ self ].
		self keysAndValuesDo: aBlock withAssociationString: associationString.
		index := index + 1
	] repeat.! !

!UnixEnvironment methodsFor: 'private' stamp: 'CamilloBruni 4/29/2013 17:41'!
environAt: index
	| address |
	address := NBExternalAddress value: (self environ nbUInt32AtOffset: index-1 * 4).
	address isNull ifTrue: [ ^ nil ].
	^ address readString! !

!UnixEnvironment methodsFor: 'accessing' stamp: 'CamilloBruni 4/29/2013 17:41'!
environ
	"Return the address of the array holding the environment variables"
	^ NBExternalAddress value: ((NativeBoost loadSymbol: 'environ' fromModule: NativeBoost CLibrary) nbUInt32AtOffset: 0)! !

!UnixEnvironment methodsFor: 'private' stamp: 'CamilloBruni 4/29/2013 17:18'!
setEnv: nameString value: valueString
	"This method calls the Standard C Library getenv() function"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode >
	 ^ self nbCall: #( int setenv (String nameString, String valueString, 1) ) module: NativeBoost CLibrary! !

!UnixEnvironment class methodsFor: 'testing' stamp: 'EstebanLorenzano 1/25/2014 13:16'!
isDefaultFor: aPlatform 
	^  aPlatform isUnix 
		or: [ aPlatform isMacOSX 
		or: [ aPlatform isMacOS ] ]! !

!UnixPlatform commentStamp: '<historical>'!
I am a an object representing a Unix platform. Use myself to access platform specific features.

Please keep me polymorphic to the the other platform objects.

To get the current platform, you can evaluate:

OSPlatform current.!
!UnixPlatform methodsFor: '*System-Clipboard' stamp: 'HenrikSperreJohansen 1/28/2011 15:21'!
clipboardClass
	^UnixClipboard! !

!UnixPlatform methodsFor: '*Glamour-Core' stamp: 'EstebanLorenzano 12/10/2014 22:44'!
menuShortcutModifierString
	^ 'alt'! !

!UnixPlatform methodsFor: 'accessing' stamp: 'cami 7/22/2013 18:33'!
family
	^#Unix! !

!UnixPlatform methodsFor: 'testing' stamp: 'CamilloBruni 5/9/2013 22:28'!
isUnix
	^ true! !

!UnixPlatform methodsFor: '*Files' stamp: 'CamilloBruni 11/7/2013 21:05'!
potentialLocationsOfSourcesFile
	^ { Smalltalk vm directory. FileLocator userData }! !

!UnixPlatform methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/12/2013 14:23'!
lineEnding

	^ String lf! !

!UnixPlatform methodsFor: '*Keymapping-KeyCombinations' stamp: 'BenjaminVanRyseghem 11/29/2013 16:03'!
defaultModifier

	^ KMModifier control! !

!UnixPlatform methodsFor: 'accessing' stamp: 'GuillermoPolito 4/10/2013 17:27'!
keyForValue: aKeyValue
	^Key valueForUnixPlatform: aKeyValue.! !

!UnixPlatform class methodsFor: 'testing' stamp: 'CamilloBruni 5/9/2013 22:39'!
isActivePlatform
	^ self currentPlatformName = 'unix'! !

!UnixResolver commentStamp: '<historical>'!
I am an expert on Unix filesystem conventions. I resolve origins according to these conventions.!
!UnixResolver methodsFor: 'origins' stamp: 'DamienCassou 7/4/2013 16:18'!
preferences
	"http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html"

	^ self directoryFromEnvVariableNamed: 'XDG_CONFIG_HOME' or: [ self home / '.config' ]! !

!UnixResolver methodsFor: 'origins' stamp: 'DamienCassou 7/4/2013 16:11'!
home
	^ self directoryFromEnvVariableNamed: 'HOME'! !

!UnixResolver methodsFor: 'origins' stamp: 'DamienCassou 7/4/2013 15:46'!
cache
	"http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html"

	^ self directoryFromEnvVariableNamed: 'XDG_CACHE_HOME' or: [ self home / '.cache' ]! !

!UnixResolver methodsFor: 'origins' stamp: 'DamienCassou 3/25/2013 17:45'!
desktop
	^ (self xdgUserDir: 'DESKTOP') ifNil: [ self home / 'Desktop' ]! !

!UnixResolver methodsFor: 'helpers' stamp: 'DamienCassou 7/4/2013 16:31'!
xdgParseUserDirLine: aStream
	"Format is XDG_xxx_DIR=""$HOME/yyy"", where yyy is a shell-escaped homedir-relative path, or XDG_xxx_DIR=""/yyy"", where /yyy is an absolute path. No other format is supported."
	| path firstChar |
	(aStream next = $") ifFalse: [ ^ nil ].
	firstChar := aStream next.
	(#($$ $/) includes: firstChar) ifFalse: [ ^ nil ].
	path := firstChar = $$
				ifTrue: [ (aStream next: 5) = 'HOME/' ifFalse: [ ^ nil ].
					       self home / (aStream upTo: $") ]
				ifFalse: [ self resolveString: '/', (aStream upTo: $") ].
	^ path! !

!UnixResolver methodsFor: 'helpers' stamp: 'DamienCassou 3/25/2013 17:57'!
xdgUserDir: userDirName
	"Read ~/.config/user-dirs.dirs to find the directory of userDirName (e.g., 'DESKTOP')"
	"http://freedesktop.org/wiki/Software/xdg-user-dirs"
	"This file is written by xdg-user-dirs-update If you want to change or add directories, just edit the line you're interested in. All local changes will be retained on the next run Format is XDG_xxx_DIR=""$HOME/yyy"", where yyy is a shell-escaped homedir-relative path, or XDG_xxx_DIR=""/yyy"", where /yyy is an absolute path. No other format is supported."
	| configFile |
	configFile := self preferences / 'user-dirs.dirs'.
	(configFile isFile and: [ configFile isReadable ]) ifFalse: [ ^ nil ].
	configFile readStreamDo: [ :stream | 
		[ stream atEnd ]
			whileFalse: [ 
				((stream peek ~= $#) and: [ (stream upTo: $=) = ('XDG_', userDirName, '_DIR') ])
							ifTrue: [ ^ self xdgParseUserDirLine: stream ]
							ifFalse: [ stream nextLine ] ] ].
	^ nil! !

!UnixResolver methodsFor: 'origins' stamp: 'DamienCassou 3/25/2013 17:45'!
documents
	^ (self xdgUserDir: 'DOCUMENTS') ifNil: [ self home / 'Documents' ]! !

!UnixResolver methodsFor: 'origins' stamp: 'DamienCassou 11/7/2013 16:29'!
userData
	^ self directoryFromEnvVariableNamed: 'XDG_DATA_HOME' or: [ self home / '.local' / 'share' ]! !

!UnixResolver methodsFor: 'resolving' stamp: 'DamienCassou 11/7/2013 16:42'!
supportedOrigins
	^ super supportedOrigins , #( userData )! !

!UnixResolver methodsFor: 'origins' stamp: 'DamienCassou 12/20/2013 11:57'!
temp
	^ '/tmp' asFileReference! !

!UnixResolver class methodsFor: 'accessing' stamp: 'pls
12/18/2009 04:53'!
platformName
	^  'unix'! !

!UnixStore commentStamp: '<historical>'!
I'm a specific store for Unix file systems!
!UnixStore methodsFor: 'public' stamp: 'CamilloBruni 5/10/2012 16:08'!
checkName: aFileName fixErrors: fixing
	"Check if the file name contains any invalid characters"
	| fName |
	fName := super checkName: aFileName fixErrors: fixing.
	
	(fName includes: self delimiter) ifFalse:
		[^fName].
	
	fixing ifFalse: [self error:'Invalid file name'].
	
	^ fName copyReplaceAll: self delimiter asString with: '#'! !

!UnixStore class methodsFor: 'public' stamp: 'CamilloBruni 5/10/2012 16:04'!
maxFileNameLength

	^ 255! !

!UnixStore class methodsFor: 'public' stamp: 'CamilloBruni 5/7/2012 01:11'!
separator 
	^ $:! !

!UnixStore class methodsFor: 'current' stamp: 'CamilloBruni 5/10/2012 15:43'!
isActiveClass
	^ Smalltalk os isUnix and: [ super isActiveClass ]! !

!UnixStore class methodsFor: 'public' stamp: 'cwp 2/18/2011 17:19'!
delimiter
	^ $/! !

!UnixStore class methodsFor: 'public' stamp: 'cami 7/22/2013 18:26'!
isCaseSensitive
	"except for OSX the default is case sensitive"
	^ Smalltalk os isMacOSX not! !

!UnknownSelector commentStamp: 'TorstenBergmann 1/31/2014 11:17'!
Notify about an unknown selector!
!UnknownSelector methodsFor: 'as yet unclassified' stamp: 'cwp 10/17/2007 23:34/eem 9/5/2009 11:10 - => :='!
openMenuIn: aBlock
	| alternatives labels lines caption choice |
	alternatives := Symbol possibleSelectorsFor: name.
	labels := Array streamContents:
				[:s | s nextPut: name; nextPutAll: alternatives; nextPut: 'cancel'].
	lines := {1. alternatives size + 1}.
	caption := 'Unknown selector, please\confirm, correct, or cancel' withCRs.
	
	choice := aBlock value: labels value: lines value: caption.
	choice = 0 ifTrue: [self resume: nil].
	choice = 1 ifTrue: [self resume: name asSymbol].
	choice = labels size ifTrue: [self resume: nil].
	self resume: (alternatives at: choice - 1)! !

!UnlockedKeyChain commentStamp: '<historical>'!
An UnlockedKeyChain is a keychain with no password.

It stores values that anyone can access!
!UnlockedKeyChain methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/11/2012 13:50'!
setUserName: user forGroup: group

	self 
		setUserName: user 
		password: nil 
		forGroup: group! !

!UnlockedKeyChain methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/11/2012 18:04'!
isLocked

	^ false! !

!UnlockedKeyChain methodsFor: 'protocol' stamp: 'CamilloBruni 7/17/2013 23:40'!
setUserName: user password: pass forGroup: group withUnlockPassword: aString

	(encryptor encrypt: aString) = password 
		ifTrue: [ groups 
					at: group 
					put: (UsernamePassword 
								username: user 
								password:nil).
								
				^ true ].
	^ false! !

!UnlockedKeyChain methodsFor: 'private' stamp: 'BenjaminVanRyseghem 5/11/2012 13:47'!
isUnlocked

	^ true! !

!UnlockedKeyChain methodsFor: 'protocol' stamp: 'CamilloBruni 7/17/2013 23:40'!
userNameFor: aGroup

	^ self isUnlocked
		ifTrue: [ (groups at: aGroup ifAbsent: [ ^ nil ]) username ]! !

!UnlockedKeyChain methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/11/2012 14:07'!
userNamePasswordFor: aGroup

	^ self userNameFor: aGroup! !

!UnlockedKeyChain methodsFor: 'protocol' stamp: 'CamilloBruni 7/17/2013 23:40'!
setUserName: user password: pass forGroup: group

	self isUnlocked
		ifTrue: [ 
			groups 
				at: group 
				put: (UsernamePassword 
							username: user 
							password: nil).
			^ true ].
	^ false! !

!UnmodifiedField commentStamp: '<historical>'!
Ceci n'est pas une modifications.
I am used to migrate non modified fields from the old to the new instance.
Typically I am used when only certain fields are modified and others are left as is.!
!UnmodifiedField methodsFor: 'accessing' stamp: 'ToonVerwaest 3/28/2011 17:28'!
installOn: aModification
	aModification installUnmodifiedSlot: self! !

!UnmodifiedField methodsFor: 'accessing' stamp: 'ToonVerwaest 3/28/2011 17:48'!
slot: anObject
	slot := anObject! !

!UnmodifiedField methodsFor: 'migrating' stamp: 'ToonVerwaest 3/30/2011 13:55'!
migrateAt: index to: newInstance from: oldInstance
	newInstance
		instVarAt: index
		put: (oldInstance instVarAt: index)! !

!UnmodifiedField methodsFor: 'accessing' stamp: 'ToonVerwaest 3/28/2011 17:48'!
slot
	^ slot! !

!UnmodifiedField methodsFor: 'accessing' stamp: 'ToonVerwaest 3/28/2011 17:27'!
fieldIndex
	^ slot index + fieldIndex! !

!UnreferencedSharedPool commentStamp: 'NicoPaez 10/17/2010 14:45'!
Just a class for testing!
!UnusedVariable commentStamp: 'TorstenBergmann 1/31/2014 11:17'!
Notify about an unused temporary variable!
!UnusedVariable methodsFor: 'as yet unclassified' stamp: 'eem 9/5/2009 11:10'!
openMenuIn: aBlock
	| index |
	index := aBlock value: #('yes' 'no')
					value: #()
					value: name, ' appears to be\unused in this method.\OK to remove it?' withCRs.
	self resume: index = 1! !

!UpdateFileNotLoaded commentStamp: '<historical>'!
This warning is signalled if during the update process, certain update files cannot be found.!
!UpdateFileNotLoaded methodsFor: 'accessing' stamp: 'CamilloBruni 10/26/2013 21:27'!
file
	
	^ file! !

!UpdateFileNotLoaded methodsFor: 'accessing' stamp: 'CamilloBruni 10/26/2013 21:28'!
messageText
	^ 'Could not load the update file: ', self file asString! !

!UpdateFileNotLoaded methodsFor: 'accessing' stamp: 'CamilloBruni 10/26/2013 21:27'!
file: anObject
	
	file := anObject! !

!UpdateFileNotLoaded class methodsFor: 'signaling' stamp: 'CamilloBruni 10/26/2013 21:26'!
signalFile: aFilePath
	^ self new
		file: aFilePath;
		signal! !

!UpdateStreamer commentStamp: 'StephaneDucasse 9/1/2010 21:59'!
I'm a little class inspired heavily from Utilities that download update.list and launch update.

you can tell me to update throw a given number of update or to be verbose.


UpdateStreamer new 
	beVerbose;
	updateFromServer
	
This will update all the updates available and show up dialogs
	!
!UpdateStreamer methodsFor: 'public' stamp: 'TorstenBergmann 1/24/2015 22:10'!
updateFolderURL
	"in the future it may be wiser to use SystemVersion to avoid to duplicate the logic"
	"SystemVersion current major"
	^ 'http://', self server, '/',self path, '/'! !

!UpdateStreamer methodsFor: 'private - actions' stamp: 'CamilloBruni 1/14/2013 16:47'!
newUpdatesFromFile: aFileReference
	"
	A file should be of following format:

#Pharo2.0a
20000-Pha-Empty.cs
20001-Pha-Empty2.cs
20002-Pha-DelScriptLoader.cs
	
	 "
	^self newUpdatesFromString: aFileReference readStream contents
! !

!UpdateStreamer methodsFor: 'private - updating' stamp: 'CamilloBruni 10/26/2013 21:22'!
updateWith: anUpdateBlock

	"Scan the update server for unassimilated updates. If upToNumber is not nil, it represents the highest-numbered update to load.  This makes it possible to update only up to a particular point.   If saveLocally is true, then save local copies of the update files on disc.  If shouldApplyChanges is true, then absorb the updates into the current image.

A file on the server called updates.list has the names of the last N update files.  We look backwards for the first one we do not have, and start there"
"* To add a new update:  Name it starting with a new two-digit code.  
* Do not use %, /, *, space, or more than one period in the name of an update file.
* The update name does not need to have any relation to the version name.
* Figure out which versions of the system the update makes sense for.
* Add the name of the file to each version's category below.
* Put this file and the update file on all of the servers.
*
* To make a new version of the system:  Pick a name for it (no restrictions)
* Put # and exactly that name on a new line at the end of this file.
* During the release process, fill in exactly that name in the dialog box.
* Put this file on the server."

"When two sets of updates need to use the same directory, one of them has a * in its 
serverUrls description.  When that is true, the first word of the description is put on
the front of 'updates.list', and that is the index file used."
	[[[
		| pair failed loaded |
		pair := anUpdateBlock value.
		failed := pair first.
		loaded := pair second.
		failed ifNil: [
			"is OK"
			 self feedback:  (loaded printString ,' new update file(s) processed.')]] 
	on: MCMergeOrLoadWarning do: [ :e | e merge ]] 
	on: MCNoChangesException do: [ :e | e resume ]]
 	on: MCMergeResolutionRequest do: [ :request | request autoMerge ].! !

!UpdateStreamer methodsFor: 'private - actions' stamp: 'MarcusDenker 10/3/2013 23:11'!
newUpdatesFromString: aString
	"A string should be of following format:

	#Pharo2.0a
	20000-Pha-Empty.cs
	20001-Pha-Empty2.cs
	20002-Pha-DelScriptLoader.cs "
	
	| list out existing |
	
	out := OrderedCollection new.
	existing := SystemVersion current updates.
	list := self extractVersion: SystemVersion current version from: aString.
	
	list reverseDo: [:fileName | | itsNumber |
		itsNumber := fileName initialIntegerOrNil. 
		(existing includes: itsNumber)
			ifFalse: [ (itsNumber isNil or: [itsNumber <= self upToNumber])
							ifTrue: [out addFirst: self updateFolderURL, fileName]]
			ifTrue: [^ out]].
	out notEmpty  ifTrue:
				[^ out "we have our list"].	
	self feedback: 'All code update servers seem to be unavailable'.
	^ out
	
! !

!UpdateStreamer methodsFor: 'accessing' stamp: 'TorstenBergmann 1/24/2015 22:21'!
updatesListFileName: aString
	"Sets the name of the update file"
	
	updatesListFileName := aString! !

!UpdateStreamer methodsFor: 'accessing' stamp: 'TorstenBergmann 1/24/2015 22:16'!
path
	"Path part ... in the following  http:// server / path /updatesXX.list
	 where path is usually pathX.X including the Pharo version."
	
	^ path ifNil: [ path := self defaultPath ].! !

!UpdateStreamer methodsFor: 'private - actions' stamp: 'CamilloBruni 1/14/2013 16:47'!
newUpdates
	"Return a list of fully formed URLs of update files we do not yet have up to the upToNumber instance variable if set." 

	"self new newUpdates"

	| result |
	
	result := ZnClient new
		systemPolicy;
		setAcceptEncodingGzip;
		beOneShot;
		accept: ZnMimeType text;
		url: self updateListFileURLString;
		ifFail: [ :exception | self error: 'Cannot access update server: ' , exception printString ];
		get.
		
	^ self newUpdatesFromString: result.! !

!UpdateStreamer methodsFor: 'private - actions' stamp: 'CamilloBruni 10/1/2012 12:53'!
silentRetrieveUrls: urls ontoQueue: queue withWaitSema: waitSema 
	"download the given list of URLs. The queue will be loaded alternately  
	with url's and with the retrieved contents. If a download fails, the  
	contents will be #failed. If all goes well, a special pair with an empty  
	URL and the contents #finished will be put on the queue. waitSema is  
	waited on every time before a new document is downloaded; this keeps 
	the downloader from getting too far  ahead of the main process"
	"kill the existing downloader if there is one"
	
	self zapUpdateDownloader.
	"fork a new downloading process"
	UpdateDownloader := [
		urls do: [ :url | | doc | 
			waitSema wait.
			queue nextPut: url.
			doc := ZnClient new
				systemPolicy;
				setAcceptEncodingGzip;
				beOneShot;
				ifFail: [ :exception | 
					queue nextPut: #failed.
					UpdateDownloader := nil.
					Processor activeProcess terminate ];
				get: url.
			queue nextPut: doc readStream ].		
		queue nextPut: ''.
		queue nextPut: #finished.
		UpdateDownloader := nil] newProcess.
	UpdateDownloader priority: Processor userInterruptPriority.
	"start the process running"
	UpdateDownloader resume! !

!UpdateStreamer methodsFor: 'accessing' stamp: 'TorstenBergmann 1/24/2015 22:22'!
upToNumber
	"When specified the update will stop at this number"
	
	^ upToNumber ifNil: [ upToNumber := 1000000 ].! !

!UpdateStreamer methodsFor: 'public' stamp: 'MarcusDenker 10/3/2013 23:05'!
updateFromServerSilently
	"Scan the update server for unassimilated updates. If upToNumber is not nil, it represents the highest-numbered update to load.  This makes it possible to update only up to a particular point.   If saveLocally is true, then save local copies of the update files on disc.  If shouldApplyChanges is true, then absorb the updates into the current image.

A file on the server called updates.list has the names of the last N update files.  We look backwards for the first one we do not have, and start there"
"* To add a new update:  Name it starting with a new two-digit code.  
* Do not use %, /, *, space, or more than one period in the name of an update file.
* The update name does not need to have any relation to the version name.
* Figure out which versions of the system the update makes sense for.
* Add the name of the file to each version's category below.
* Put this file and the update file on all of the servers.
*
* To make a new version of the system:  Pick a name for it (no restrictions)
* Put # and exactly that name on a new line at the end of this file.
* During the release process, fill in exactly that name in the dialog box.
* Put this file on the server."

"When two sets of updates need to use the same directory, one of them has a * in its 
serverUrls description.  When that is true, the first word of the description is put on
the front of 'updates.list', and that is the index file used."

	self elementaryReadServerUpdates.
	^ true! !

!UpdateStreamer methodsFor: 'defaults' stamp: 'TorstenBergmann 1/24/2015 22:06'!
defaultServer
	"Return the default Pharo update server"
	
	^'updates.pharo.org'! !

!UpdateStreamer methodsFor: 'private - actions' stamp: 'CamilloBruni 1/14/2013 16:50'!
elementaryReadServerUpdates
	"Scan the update server(s) for unassimilated updates. If the instance variable upToNumber is not nil, it represents the highest-numbered update to load.  This makes it possible to update only up to a particular point."

	"UpdateStreamer new elementaryReadServerUpdates"

	^ self elementaryReadServerUpdates: self newUpdates.! !

!UpdateStreamer methodsFor: 'private - actions' stamp: 'StephaneDucasse 9/1/2010 19:15'!
retrieveUrls: urls ontoQueue: queue withWaitSema: waitSema 
	"download the given list of URLs. The queue will be loaded alternately  
	with url's and with the retrieved contents. If a download fails, the  
	contents will be #failed. If all goes well, a special pair with an empty  
	URL and the contents #finished will be put on the queue. waitSema is  
	waited on every time before a new document is downloaded; this keeps 
	the downloader from getting too far  ahead of the main process"
	"kill the existing downloader if there is one"
	
	self silent 
		ifTrue: [self silentRetrieveUrls: urls ontoQueue: queue withWaitSema: waitSema ]
		ifFalse: [self verboseRetrieveUrls: urls ontoQueue: queue withWaitSema: waitSema ]
! !

!UpdateStreamer methodsFor: 'public' stamp: 'CamilloBruni 1/14/2013 16:55'!
updateFromServer
	self updateWith: [ self elementaryReadServerUpdates ]! !

!UpdateStreamer methodsFor: 'defaults' stamp: 'TorstenBergmann 1/24/2015 22:22'!
defaultUpdatesListFileName

	^ 'updates', (SystemVersion current majorMinor:''), '.list'! !

!UpdateStreamer methodsFor: 'private - actions' stamp: 'CamilloBruni 10/1/2012 12:53'!
verboseRetrieveUrls: urls ontoQueue: queue withWaitSema: waitSema 
	"download the given list of URLs. The queue will be loaded alternately  
	with url's and with the retrieved contents. If a download fails, the  
	contents will be #failed. If all goes well, a special pair with an empty  
	URL and the contents #finished will be put on the queue. waitSema is  
	waited on every time before a new document is downloaded; this keeps 
	the downloader from getting too far  ahead of the main process"
	"kill the existing downloader if there is one"
	
	self zapUpdateDownloader.
	"fork a new downloading process"
	UpdateDownloader := [ | updateCounter |
		updateCounter := 0.
		'Downloading updates' displayProgressFrom: 0 to: urls size during: [:bar |
			urls do: [ :url | | doc | 
				waitSema wait.
				queue nextPut: url.
				doc := ZnClient new
					systemPolicy;
					setAcceptEncodingGzip;
					beOneShot;
					ifFail: [ :exception | 
						queue nextPut: #failed.
						UpdateDownloader := nil.
						Processor activeProcess terminate ];
					get: url.
				queue nextPut: doc readStream. 
				updateCounter := updateCounter + 1. 
				bar current: updateCounter ] ].
			queue nextPut: ''.
			queue nextPut: #finished.
			UpdateDownloader := nil ] newProcess.
	UpdateDownloader priority: Processor userInterruptPriority.
	"start the process running"
	UpdateDownloader resume ! !

!UpdateStreamer methodsFor: 'accessing' stamp: 'TorstenBergmann 1/24/2015 22:21'!
updatesListFileName
	"Returns the name of the update file"
	
	^ updatesListFileName ifNil: [ updatesListFileName := self defaultUpdatesListFileName ]! !

!UpdateStreamer methodsFor: 'private - actions' stamp: 'MarcusDenker 10/3/2013 23:07'!
groupUpdatesByVersion: updateContents
	"Parse the contents of updates.list into {{vers. {fileNames*}}*}, and return it."
	
	| sections vers strm line fileNames |
	self flag: #shouldUseADictionary.
	sections := OrderedCollection new.
	fileNames := OrderedCollection new: 1000.
	strm := updateContents readStream.
	[ strm atEnd ] whileFalse: 
		[ line := strm nextLine.
		line notEmpty ifTrue: 
			[ line first = $# 
				ifTrue: 
					[ vers ifNotNil: [ sections addLast: {  vers. (fileNames asArray)  } ].
					"Start a new section"
					vers := line allButFirst.
					fileNames resetTo: 1 ]
				ifFalse: [ line first = $* ifFalse: [ fileNames addLast: line ] ] ] ].
	vers ifNotNil: [ sections addLast: {  vers. (fileNames asArray)  } ].
	^ sections 
	! !

!UpdateStreamer methodsFor: 'accessing' stamp: 'TorstenBergmann 1/24/2015 22:16'!
path: aString
	"Sets the Path part ... in the following  http:// server / path /updatesXX.list"
	
	path := aString! !

!UpdateStreamer methodsFor: 'accessing' stamp: 'MarcusDenker 10/5/2013 18:06'!
saveLocally
	^false! !

!UpdateStreamer methodsFor: 'private - actions' stamp: 'CamilloBruni 10/26/2013 21:52'!
elementaryReadServerUpdates: urls
	"Scan the update server(s) for unassimilated updates. If the instance variable upToNumber is not nil, it represents the highest-numbered update to load.  This makes it possible to update only up to a particular point."

	"UpdateStreamer new elementaryReadServerUpdates"

	| str failed loaded this nextDoc updateName |
	(Smalltalk globals includesKey: #ScriptLoader)
		ifFalse: [ ^ self feedback: 'ScriptLoader is not present (this may happen if you have run cleanUpForProduction). ' ].
	Cursor wait
		showWhile: [ 
			| docQueue docQueueSema |
			loaded := 0.
			failed := nil.	"send downloaded documents throuh this queue"
			docQueue := SharedQueue new.	"this semaphore keeps too many documents from beeing queueed up at a time"
			docQueueSema := Semaphore new.
			5 timesRepeat: [ docQueueSema signal ].	"fork a process to download the updates"
			self retrieveUrls: urls ontoQueue: docQueue withWaitSema: docQueueSema.	"process downloaded updates in the foreground"
			[ 
			this := docQueue next.
			nextDoc := docQueue next.
			nextDoc = #failed
				ifTrue: [ failed := this ].
			failed isNil and: [ nextDoc ~= #finished ] ]
				whileTrue: [ 
					failed
						ifNil: [ 
							nextDoc isEmpty
								ifTrue: [ failed := this ] ].
					failed
						ifNil: [ 
							nextDoc peek asciiValue = 4
								ifTrue: [ failed := this ]	"pure object file" ].	"Must be fileIn, not pure object file"
					failed
						ifNil: [ 
							self shouldApplyChanges
								ifTrue: [ 
									updateName := (this findTokens: '/') last.
									ChangeSet newChangesFromStream: nextDoc named: updateName.
									SystemVersion current registerUpdate: updateName initialIntegerOrNil ]].
					loaded := loaded + 1.
					docQueueSema signal ] ].
	failed notNil & (urls size - loaded > 0)
		ifTrue: [ 
			str := loaded printString , ' new update file(s) processed.'.
			str := str , '\Could not load ' withCRs , (urls size - loaded) printString , ' update file(s).'
				, '\Starting with "' withCRs , failed , '".'.
			self feedback: str.
			UpdateFileNotLoaded signalFile: failed ].
	^ Array with: failed with: loaded! !

!UpdateStreamer methodsFor: 'accessing' stamp: 'StephaneDucasse 9/1/2010 16:43'!
beVerbose

	silent := false! !

!UpdateStreamer methodsFor: 'accessing' stamp: 'TorstenBergmann 1/24/2015 22:17'!
server
	"Returns the update server name"
	
	pharoServer ifNil: [ pharoServer := self defaultServer ].
	^ pharoServer! !

!UpdateStreamer methodsFor: 'private - actions' stamp: 'StephaneDucasse 9/1/2010 16:46'!
feedback: aString

	self silent 
		ifFalse: [self inform: aString]
		ifTrue: [Transcript show: aString ; cr]! !

!UpdateStreamer methodsFor: 'accessing' stamp: 'TorstenBergmann 1/24/2015 22:16'!
silent
	
	^ silent ifNil: [ self beVerbose. false ]! !

!UpdateStreamer methodsFor: 'private - updating' stamp: 'StephaneDucasse 1/31/2011 22:24'!
updateListFileURLString
	"in the future it may be wiser to use VersionNumber to avoid to duplicate the logic"
	
	^ self updateFolderURL, self updatesListFileName! !

!UpdateStreamer methodsFor: 'private - actions' stamp: 'StephaneDucasse 9/1/2010 17:32'!
newUpdatesUpToNumber: aNumber
	"Return a list of fully formed URLs of update files we do not yet have.  Look at the file 'updates.list'.
	No updates numbered higher than aNumber (if it is not nil) are returned " 

	"self new newUpdatesToNumber: 14000"

	self upToNumber: aNumber.
	^ self newUpdates.! !

!UpdateStreamer methodsFor: 'accessing' stamp: 'TorstenBergmann 1/24/2015 22:17'!
shouldApplyChanges: aBoolean
	"When true the changes are downloaded and executed in the image"
	
	applyChanges := aBoolean ! !

!UpdateStreamer methodsFor: 'public' stamp: 'CamilloBruni 10/26/2013 21:38'!
updateFromFile: aFileReference
	self updateWith: [ 
		self elementaryReadServerUpdates: (self newUpdatesFromFile: aFileReference) ]! !

!UpdateStreamer methodsFor: 'accessing' stamp: 'TorstenBergmann 1/24/2015 22:17'!
shouldApplyChanges
	"When true the changes are downloaded and executed in the image"
	
	^ applyChanges ifNil: [ applyChanges := true ]! !

!UpdateStreamer methodsFor: 'accessing' stamp: 'StephaneDucasse 9/1/2010 16:43'!
beSilent

	silent := true! !

!UpdateStreamer methodsFor: 'accessing' stamp: 'TorstenBergmann 1/24/2015 22:17'!
upToNumber: aNumber
	"When specified the update will stop at this number"
	
	upToNumber := aNumber. ! !

!UpdateStreamer methodsFor: 'private - actions' stamp: ''!
zapUpdateDownloader

	UpdateDownloader ifNotNil: [UpdateDownloader terminate].
	UpdateDownloader := nil.! !

!UpdateStreamer methodsFor: 'defaults' stamp: 'TorstenBergmann 1/24/2015 22:19'!
defaultPath
	"Returns the default path on the update server. For instance 'pharo4.0' 
 	 within http://updates.pharo.org/pharo4.0/"
	
	^'pharo', (Smalltalk globals at: #ScriptLoader) currentMajorVersionNumber asString  ! !

!UpdateStreamer methodsFor: 'private - actions' stamp: 'MarcusDenker 10/3/2013 23:04'!
extractVersion: aVersion from: updateList
	"Pull out the part of the list that applies to a version."
	"self new extractVersion: 'Pharo1.1' from: ..."
	
	| listContents versIndex |
	self flag: #shouldUseADictionary.
	listContents := self groupUpdatesByVersion: updateList.
	versIndex := (listContents collect: [ :pair | pair first]) indexOf: aVersion.
	versIndex = 0 ifTrue: [^ Array new].
	^ (listContents at: versIndex) last! !

!UpdateStreamer methodsFor: 'public' stamp: 'SeanDeNigris 7/12/2012 08:44'!
updatesListFile
	^  self updatesListFileName asFileReference! !

!UpdateStreamerTest commentStamp: 'TorstenBergmann 2/4/2014 20:31'!
SUnit test for update streamer!
!UpdateStreamerTest methodsFor: 'tests' stamp: 'CamilloBruni 10/26/2013 21:42'!
testMiniUpdateFiles
	self deny: (self miniUpdate includes: Character lf).
	self deny: (self miniUpdateLf includes: Character cr).! !

!UpdateStreamerTest methodsFor: 'tests' stamp: 'CamilloBruni 10/26/2013 21:46'!
testGroupUpdatesByVersionLf
	"self debug: #testGroupUpdatesByVersionLf"
	
	| res |
	res := UpdateStreamer new groupUpdatesByVersion: self miniUpdateLf.
	self assert: res size = 3.
	self assert: res first first = #'Pharo1.1a'.
	self assert: res second first = #'Pharo1.1b'.
	self assert: res third first = #'Pharo1.2a'.
	
	self assert: res first second size = 13.
	self assert: ((res first second) allSatisfy: [:each | each beginsWith: '110']).
	self assert: ((res first second) first = #'11000-Pha-Empty.cs').
	
	self assert: ((res first second) last = #'11012-Pha-ScriptingSystemRemoval.cs').
	


	! !

!UpdateStreamerTest methodsFor: 'resources' stamp: ''!
miniUpdate

	^ '#Pharo1.1a
11000-Pha-Empty.cs
11001-Pha-FlapRemoval.cs
11002-Pha-Scriptloader11.cs
11003-Pha-CopyReturnPartOne.cs
11004-Pha-CopyReturnPartTwo.cs
11005-Pha-asSmallPositiveAndMultiCharacter.cs
11006-Pha-TextAlignmentDoesNotUseTextConstants.cs
11007-Pha-IntervalStoreOnIncorrectForSomeScaledDecimal.cs
11008-Pha-DictionaryAsSetDoesNotBehaveLikeSet.cs
11009-Pha-UndoPolygonPaintingCauseDrawingNotFunctioningAnymore.cs
11010-Pha-FloatNegativeZeroFloatNanComparison.cs
11011-Pha-IncludesSelector.cs
11012-Pha-ScriptingSystemRemoval.cs
#Pharo1.1b
11013-Pha-MinorSqueakFixesAndWho.cs
11014-Pha-copyCleaningUp.cs
11015-Pha-PostCopyPart3AndHostWindowsTests.cs
11016-Pha-selectDictionaryAndPseudoClassFix.cs
11017-Pha-RemoveAllAndBlockClosure.cs
11018-Pha-SqueezeOutNumberAndNumberreadFrom.cs
11019-Pha-PragmasCleaning.cs
11020-Pha-DiverseFixes.cs
11021-Pha-RemovingPresenter.cs
11022-Pha-CleaningPlayerLeftOver.cs
11023-Pha-SettingAndMouseOverHandler.cs
11024-Pha-MultiByteSpeedUpPartOne.cs
11025-Pha-MultiByteSpeedUpPartTw	
#Pharo1.2a
12000-Pha-Empty.cs 
12001-Pha-NewScriptLoaderPackage.cs
12002-Pha-Fixing12.cs
12003-Pha-RemovalAddViewingFromPasteUpMorph.cs
12004-Pha-MorphCleaning.cs
12005-Pha-harvestmd.cs
'


	! !

!UpdateStreamerTest methodsFor: 'tests' stamp: ''!
testExtractUpdatesForVersion
	"self debug: #testExtractUpdatesForVersion"
	
	| res |
	res := UpdateStreamer new extractVersion: 'Pharo1.1a' from: self miniUpdate.
	self assert: (res size = 13).
	res := UpdateStreamer new extractVersion: 'Pharo1.2a' from: self miniUpdate.
	self assert: (res size = 6).
	res := UpdateStreamer new extractVersion: 'ZORK.2a' from: self miniUpdate.
	self assert: (res isEmpty).! !

!UpdateStreamerTest methodsFor: 'tests' stamp: 'TorstenBergmann 1/24/2015 22:22'!
testDefaultPath
	"pharo4.0"

	self assert: (UpdateStreamer new path beginsWith: 'pharo')! !

!UpdateStreamerTest methodsFor: 'resources' stamp: 'CamilloBruni 10/26/2013 21:41'!
miniUpdateLf

	^ self miniUpdate copyReplaceAll: String cr with: String lf

	! !

!UpdateStreamerTest methodsFor: 'tests' stamp: 'TorstenBergmann 1/24/2015 22:09'!
testDefaultServer
	|streamer|
	streamer := UpdateStreamer new.	
	self assert: streamer server = streamer defaultServer! !

!UpdateStreamerTest methodsFor: 'tests' stamp: ''!
testGroupUpdatesByVersion
	"self debug: #testGroupUpdatesByVersion"
	
	| res |
	res := UpdateStreamer new groupUpdatesByVersion: self miniUpdate.
	self assert: res size = 3.
	self assert: res first first = #'Pharo1.1a'.
	self assert: res second first = #'Pharo1.1b'.
	self assert: res third first = #'Pharo1.2a'.
	
	self assert: res first second size = 13.
	self assert: ((res first second) allSatisfy: [:each | each beginsWith: '110']).
	self assert: ((res first second) first = #'11000-Pha-Empty.cs').
	
	self assert: ((res first second) last = #'11012-Pha-ScriptingSystemRemoval.cs').
	


	! !

!UpdateStreamerTest methodsFor: 'tests' stamp: 'CamilloBruni 10/26/2013 21:46'!
testExtractUpdatesForVersionLf
	"self debug: #testExtractUpdatesForVersionLf"
	
	| res |
	res := UpdateStreamer new extractVersion: 'Pharo1.1a' from: self miniUpdateLf.
	self assert: (res size = 13).
	res := UpdateStreamer new extractVersion: 'Pharo1.2a' from: self miniUpdateLf.
	self assert: (res size = 6).
	res := UpdateStreamer new extractVersion: 'ZORK.2a' from: self miniUpdateLf.
	self assert: (res isEmpty).! !

!UpdateStreamerTest methodsFor: 'tests' stamp: 'TorstenBergmann 1/24/2015 22:25'!
testDefaultUpdatesListFileName
	"Usually 'updatesXX.list' where XX is the Pharo version like 40"

	|streamer|
	streamer := UpdateStreamer new.
	self 
		assert: (streamer updatesListFileName beginsWith: 'updates');
		assert: (streamer updatesListFileName endsWith: '.list')! !

!UpdatingMenuItemMorph commentStamp: '<historical>'!
I am a menu item morph with the ability to refresh periodically all my values (name, state, enablement, icon, submenu)

Since it is not a good idea to change the shortcut, this ability is not available!
!UpdatingMenuItemMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/1/2013 17:55'!
iconSelector
	^ iconSelector! !

!UpdatingMenuItemMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/1/2013 18:18'!
balloonTextSelector: anObject
	balloonTextSelector := anObject.
	self updateBalloonText! !

!UpdatingMenuItemMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/1/2013 18:16'!
balloonText: aText

	self assureExtension balloonText: aText! !

!UpdatingMenuItemMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/1/2013 17:41'!
updateContents

	target ifNotNil: [ contents := (target perform: nameSelector) ]! !

!UpdatingMenuItemMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/1/2013 18:03'!
subMenuSelector
	^ subMenuSelector! !

!UpdatingMenuItemMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/1/2013 17:32'!
nameSelector
	^ nameSelector! !

!UpdatingMenuItemMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/1/2013 18:17'!
updateBalloonText

	target ifNotNil: [ self balloonText: (target perform: balloonTextSelector) ]! !

!UpdatingMenuItemMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/1/2013 18:17'!
balloonTextSelector
	^ balloonTextSelector! !

!UpdatingMenuItemMorph methodsFor: 'stepping' stamp: 'BenjaminVanRyseghem 11/1/2013 18:21'!
step

	owner ifNil: [ ^ self stopStepping ].
	self updateContents.
	self changed! !

!UpdatingMenuItemMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/1/2013 18:20'!
balloonText

	^ self target perform: balloonTextSelector! !

!UpdatingMenuItemMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/1/2013 17:55'!
iconSelector: anObject
	iconSelector := anObject.
	self updateIcon! !

!UpdatingMenuItemMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/1/2013 18:06'!
updateSubMenu

	target ifNotNil: [ subMenu := (target perform: subMenuSelector) ]! !

!UpdatingMenuItemMorph methodsFor: 'private' stamp: 'BenjaminVanRyseghem 11/1/2013 17:55'!
updateIcon

	target ifNotNil: [ self icon: (target perform: iconSelector) ]! !

!UpdatingMenuItemMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/1/2013 18:05'!
subMenuSelector: anObject
	subMenuSelector := anObject.
	self updateSubMenu! !

!UpdatingMenuItemMorph methodsFor: 'stepping' stamp: 'BenjaminVanRyseghem 11/1/2013 17:45'!
stepTime
	
	^ 250! !

!UpdatingMenuItemMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/1/2013 17:35'!
contents

	^ self target perform: nameSelector! !

!UpdatingMenuItemMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/1/2013 17:44'!
nameSelector: aSymbol
	nameSelector := aSymbol.
	self updateContents! !

!UpdatingMenuItemMorph methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 11/1/2013 17:59'!
icon

	^ (target perform: iconSelector)
		ifNil: [ super icon ]! !

!UserInputEvent commentStamp: 'TorstenBergmann 2/20/2014 18:30'!
A general user input event like for keyboard or mouse!
!UserInputEvent methodsFor: 'initialize' stamp: 'ar 9/13/2000 15:54'!
copyHandlerState: anEvent
	"Copy the handler state from anEvent. Used for quickly transferring handler information between transformed events."
	handler := anEvent handler.
	wasHandled := anEvent wasHandled.! !

!UserInputEvent methodsFor: 'transforming' stamp: 'ar 10/9/2000 00:38'!
transformedBy: aMorphicTransform
	"Return the receiver transformed by the given transform into a local coordinate system."
	^self shallowCopy transformBy: aMorphicTransform! !

!UserInputEvent methodsFor: 'initialize' stamp: 'ar 9/13/2000 15:54'!
resetHandlerFields
	"Reset anything that is used to cross-communicate between two eventual handlers during event dispatch"
	handler := nil.
	wasHandled := false.! !

!UserInputEvent methodsFor: 'accessing' stamp: 'ar 9/13/2000 15:54'!
wasHandled: aBool
	wasHandled := aBool.! !

!UserInputEvent methodsFor: 'printing' stamp: 'ar 10/7/2000 21:56'!
modifierString
	"Return a string identifying the currently pressed modifiers"
	| string |
	string := ''.
	self commandKeyPressed ifTrue:[string := string,'CMD '].
	self shiftPressed ifTrue:[string := string,'SHIFT '].
	self controlKeyPressed ifTrue:[string := string,'CTRL '].
	^string! !

!UserInputEvent methodsFor: 'transforming' stamp: 'ar 10/9/2000 00:38'!
transformBy: aMorphicTransform
	"Transform the receiver into a local coordinate system."
	position :=  aMorphicTransform globalPointToLocal: position.! !

!UserInputEvent methodsFor: 'transforming' stamp: 'ar 10/9/2000 00:37'!
translateBy: delta
	"add delta to cursorPoint, and return the new event"
	position := position + delta.! !

!UserInputEvent methodsFor: 'modifier state' stamp: 'GuillermoPolito 4/21/2013 19:32'!
commandKeyPressed
	"Answer true if the command key on the keyboard was being held down when this event occurred."

	"The mask for command bit pressed"
	^ buttons anyMask: 2r01000000! !

!UserInputEvent methodsFor: 'accessing' stamp: 'ar 9/13/2000 15:54'!
wasHandled
	^wasHandled! !

!UserInputEvent methodsFor: 'printing' stamp: 'ar 10/7/2000 21:57'!
buttonString
	"Return a string identifying the currently pressed buttons"
	| string |
	string := ''.
	self redButtonPressed ifTrue:[string := string,'red '].
	self yellowButtonPressed ifTrue:[string := string,'yellow '].
	self blueButtonPressed ifTrue:[string := string,'blue '].
	^string! !

!UserInputEvent methodsFor: 'accessing' stamp: 'ar 9/13/2000 15:54'!
handler
	^handler! !

!UserInputEvent methodsFor: 'transforming' stamp: 'ar 10/9/2000 00:38'!
translatedBy: delta
	"add delta to cursorPoint, and return the new event"
	^self shallowCopy translateBy: delta! !

!UserInputEvent methodsFor: 'modifier state' stamp: 'GuillermoPolito 4/21/2013 19:28'!
altKeyPressed
	"Answer true if the alt/option key on the keyboard was being held down when this event occurred."

	"00100000 is the bit that marks that option/alt has been pressed"
	^self optionKeyPressed! !

!UserInputEvent methodsFor: 'modifier state' stamp: 'GuillermoPolito 4/21/2013 19:32'!
controlKeyPressed
	"Answer true if the control key on the keyboard was being held down when this event occurred."

	"The mask for control bit pressed"
	^ buttons anyMask: 2r00010000! !

!UserInputEvent methodsFor: 'modifier state' stamp: 'GuillermoPolito 4/21/2013 19:28'!
optionKeyPressed
	"Answer true if the alt/option key on the keyboard was being held down when this event occurred."

	"00100000 is the bit that marks that option/alt has been pressed"
	^ buttons anyMask: 2r00100000! !

!UserInputEvent methodsFor: 'accessing' stamp: 'ar 9/15/2000 22:45'!
position
	^position! !

!UserInputEvent methodsFor: 'modifier state' stamp: 'GuillermoPolito 4/21/2013 19:31'!
anyModifierKeyPressed
	"ignore, however, the shift keys 'cause that's not REALLY a command key "

	^ self buttons anyMask: 2r01110000	"cmd | opt | ctrl"! !

!UserInputEvent methodsFor: 'accessing' stamp: 'ar 9/13/2000 15:45'!
type
	"Return a symbol indicating the type this event."

	^ type! !

!UserInputEvent methodsFor: 'accessing' stamp: 'ar 9/13/2000 15:54'!
handler: anObject
	handler := anObject! !

!UserInputEvent methodsFor: 'accessing' stamp: 'ar 9/13/2000 15:45'!
buttons
	"Return the a word encoding the mouse and modifier buttons for this event."

	^ buttons! !

!UserInputEvent methodsFor: 'private' stamp: 'ar 10/24/2000 16:33'!
setPosition: aPoint
	position := aPoint! !

!UserInputEvent methodsFor: 'modifier state' stamp: 'ar 9/13/2000 15:44'!
shiftPressed
	"Answer true if the shift key on the keyboard was being held down when this event occurred."

	^ buttons anyMask: 8
! !

!UserInterruptHandler commentStamp: 'michael.rueger 4/22/2009 12:01'!
An UserInterruptHandler watches incoming input events and checks for the user interrupt key.
If encountered it interrupts the current process and opens a notifier..

Instance Variables
	interruptKey:		<Object>

interruptKey
	- definition of the user interrupt key
!
!UserInterruptHandler methodsFor: 'private' stamp: 'SeanDeNigris 2/10/2013 14:46'!
handleUserInterrupt
	"This will be called from the event-fetcher process. 
	Assume no system-vital processes have a lower priority than this, and are thus ok to interrupt"
	UserInterruptHandler cmdDotEnabled ifFalse: [ ^ self ]. 

	[
		self processToInterrupt
			ifNotNil: [ :proc | proc debugWithTitle: 'User Interrupt' ]
			ifNil: [ UIManager default inform: 'Process not interruptable' ]
	
	"fork exceptions, we don't want interrupt handler to die"
	] on: Error fork: [:ex | ex pass].! !

!UserInterruptHandler methodsFor: 'events' stamp: 'ThierryGoubier 6/28/2013 14:49'!
handleEvent: evt
	"Interrupt event... evt is shared, so make a copy of it."

	| buf |
	buf := evt shallowCopy.
	(self isKbdEvent: evt)
		ifTrue: [ 
			| keycode modifiers |
			"Check if the event is a user interrupt"
			keycode := buf sixth.
			modifiers := buf fifth.
			(keycode = interruptKey and: [ modifiers anyMask: 16r0E ])
				ifTrue: [ 
					Display deferUpdates: false.
					(Smalltalk hasClassNamed: #SoundService)
						ifTrue: [ (Smalltalk classNamed: #SoundService) default shutDown ].
					self handleUserInterrupt ].
			^ self ]! !

!UserInterruptHandler methodsFor: 'initialize-release' stamp: 'mir 11/19/2008 14:41'!
setInterruptKeyValue: anInt
	interruptKey := anInt
! !

!UserInterruptHandler methodsFor: 'private' stamp: 'HenrikSperreJohansen 5/3/2013 10:08'!
processToInterrupt 
	"Look for best candidate to interrupt: 
		- any scheduled non-finalization process of lower priority 
		- the weak-finalization process, if scheduled 
		- the UI process 
	Never interrupt the idle process, since killing it is fatal" 

	| fallback | 
	fallback := UIManager default uiProcess. 
	Processor 
		scanSchedule: [:p | 
		 "suspendedContext sender == nil usually means that process is only scheduled but had no chance to run" 
			(p ~~ Processor backgroundProcess and: [p suspendedContext sender notNil]) ifTrue: [
				p ~~  WeakArray runningFinalizationProcess 
					ifTrue: [^p] 
					ifFalse: [fallback := p]]]
		startingAt: Processor activePriority. 
	^fallback! !

!UserInterruptHandler class methodsFor: 'setting' stamp: 'AlainPlantec 12/5/2009 18:22'!
cmdDotEnabled: aBoolean
	CmdDotEnabled := aBoolean! !

!UserInterruptHandler class methodsFor: 'setting' stamp: 'AlainPlantec 12/5/2009 18:21'!
cmdDotEnabled 
	^ CmdDotEnabled ifNil: [CmdDotEnabled := true]! !

!UserInterruptHandler class methodsFor: 'instance creation' stamp: 'ThierryGoubier 6/28/2013 14:57'!
new
	^ super new setInterruptKeyValue: $. asciiValue! !

!UserManager commentStamp: '<historical>'!
An UsersManager is xxxxxxxxx.

|- user1 -> keyChain1
|- user2 -> keyChain2!
!UserManager methodsFor: 'permissions' stamp: 'BenjaminVanRyseghem 5/4/2013 01:35'!
canRunStartupScript

	^ self currentUser canRunStartupScript! !

!UserManager methodsFor: 'permissions' stamp: 'BenjaminVanRyseghem 5/4/2013 01:39'!
canBrowse

	^ self currentUser canBrowse! !

!UserManager methodsFor: 'permissions' stamp: 'BenjaminVanRyseghem 5/4/2013 01:37'!
canEditCode

	^ self currentUser canEditCode! !

!UserManager methodsFor: 'permissions' stamp: 'BenjaminVanRyseghem 5/4/2013 01:37'!
canDropOSFile

	^ self currentUser canDropOSFile! !

!UserManager methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/11/2012 15:34'!
userNameFor: aGroup

	^ self currentUser userNameFor: aGroup ! !

!UserManager methodsFor: 'protocol' stamp: 'EstebanLorenzano 12/6/2012 18:57'!
addUser: aName password: aPassword
	| user |
	
	user := (PharoUser username: aName).
	user keychain setPassword: aPassword.
			
	^ self addUser: user! !

!UserManager methodsFor: 'protocol-forward' stamp: 'BenjaminVanRyseghem 5/9/2012 16:14'!
setPassword: aString

	^ self currentUser setPassword: aString ! !

!UserManager methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/4/2013 01:36'!
userNamePasswordFor: aGroup

	^ self currentUser userNamePasswordFor: aGroup! !

!UserManager methodsFor: 'permissions' stamp: 'BenjaminVanRyseghem 5/4/2013 01:35'!
canInspect

	^ self currentUser canRunStartupScript! !

!UserManager methodsFor: 'permissions' stamp: 'BenjaminVanRyseghem 5/7/2013 18:56'!
canSaveImage

	^ self currentUser canSaveImage! !

!UserManager methodsFor: 'protocol' stamp: 'EstebanLorenzano 12/6/2012 18:58'!
addUser: aPharoUser
	
	users add: aPharoUser.
	users size = 1
		ifTrue: [ self setCurrentUser: aPharoUser ].
	aPharoUser  keychain
			username: aPharoUser username.

	^ aPharoUser! !

!UserManager methodsFor: 'permissions' stamp: 'BenjaminVanRyseghem 5/4/2013 01:37'!
canEvaluateCode

	^ self currentUser canEvaluateCode! !

!UserManager methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/4/2013 01:38'!
includesUser: aUser

	^ self users includes: aUser! !

!UserManager methodsFor: 'initialization' stamp: 'PavelKrivanek 7/8/2014 15:47'!
initialize

	super initialize.

	users := SortedCollection new 
					sortBlock: [:a :b | a username printString < b username printString ].
	
	currentUser := nil.
	self addDefaultUser.! !

!UserManager methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/9/2012 11:45'!
setCurrentUser: aName
	
	currentUser := aName! !

!UserManager methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/16/2012 15:19'!
currentUser

	^ currentUser! !

!UserManager methodsFor: 'permissions' stamp: 'BenjaminVanRyseghem 5/4/2013 01:36'!
canShowMorphHalo

	^ self currentUser canShowMorphHalo! !

!UserManager methodsFor: 'accessing' stamp: 'EstebanLorenzano 12/6/2012 19:05'!
userNames
	^ self users collect: #username! !

!UserManager methodsFor: 'accessing' stamp: 'EstebanLorenzano 12/12/2012 11:41'!
addDefaultUser
	| user |
	
	user := PharoUser new 
		username: 'root';
		yourself.
	user isRoot: true.
	
	self addUser: user.
	^ user! !

!UserManager methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/16/2012 15:11'!
removeUser: aName
	
	users remove: aName! !

!UserManager methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/16/2012 15:11'!
users

	^ users! !

!UserManager methodsFor: 'protocol' stamp: 'BenjaminVanRyseghem 5/9/2012 16:14'!
groupsFor: anUser

	^ self currentUser keychain groups! !

!UserManager methodsFor: 'protocol-forward' stamp: 'BenjaminVanRyseghem 5/9/2012 16:14'!
setUserName: user password: pass forGroup: group

	^ self currentUser setUserName: user password: pass forGroup: group! !

!UserManager methodsFor: 'permissions' stamp: 'BenjaminVanRyseghem 5/4/2013 01:29'!
canDebug

	^ self currentUser canDebug! !

!UserManager class methodsFor: 'accessing' stamp: 'PavelKrivanek 7/8/2014 15:48'!
currentUser

	^ self default currentUser! !

!UserManager class methodsFor: 'accessing' stamp: 'PavelKrivanek 7/8/2014 15:38'!
default

	^ Default ifNil: [ Default := self new ]! !

!UserOfFooSharedPool commentStamp: 'NicoPaez 10/17/2010 14:45'!
I am an sunit test for SystemNavigation.!
!UserOfFooSharedPool methodsFor: 'as yet unclassified' stamp: 'NicoPaez 10/17/2010 15:10'!
simpleMethod
	^FooValue1! !

!UsernamePassword commentStamp: '<historical>'!
An UsernamePassword is just a simple wrapper!
!UsernamePassword methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/9/2012 10:50'!
password
	^ password! !

!UsernamePassword methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem2 5/11/2012 18:26'!
= another

	self species = another species ifFalse: [ ^ false ].
	^ self username = another username and: [ self password = another password ]! !

!UsernamePassword methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/9/2012 10:50'!
password: anObject
	password := anObject! !

!UsernamePassword methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/9/2012 10:50'!
username
	^ username! !

!UsernamePassword methodsFor: 'printing' stamp: 'MarcusDenker 10/10/2013 14:01'!
printOn: aStream

	super printOn: aStream.
	
	aStream 
		nextPutAll: '(';
		nextPutAll: username printString;
		nextPutAll: ' -> ';
		nextPutAll: password asString;
		nextPutAll: ')'.! !

!UsernamePassword methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 5/9/2012 10:50'!
username: anObject
	username := anObject! !

!UsernamePassword class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 5/9/2012 10:50'!
username: username password: password

	^ self new
		password: password;
		username: username;
		yourself! !

!VGTigerDemo commentStamp: '<historical>'!
self runDemo !
!VGTigerDemo methodsFor: 'conversion' stamp: ''!
convertPathData2

	| paths pathData cmdStream ptStream fillBlocks strokeBlocks capBlocks joinBlocks cmdBlocks |
	
	paths := OrderedCollection new.
	cmdStream := self class commands readStream.
	ptStream := self class tigerPoints readStream.
	pathData := nil.
	
	fillBlocks := { 
		"N" [].
		"F" [ pathData addFill ].
		"E" [ pathData addFill; fillRule: #VGEVENODD ] }.

	strokeBlocks := {
		"N" [].
		"S" [ pathData addStroke ] }.
	
	capBlocks := {
		"B" [ pathData capStyle: #VGCAPBUTT ].
		"R" [ pathData capStyle: #VGCAPROUND ].
		"S" [ pathData capStyle: #VGCAPSQUARE ]	}.
	
	joinBlocks := {
		"M" [ pathData joinStyle: #VGJOINMITER ].
		"R" [ pathData joinStyle: #VGJOINROUND ].
		"B" [ pathData joinStyle: #VGJOINBEVEL ] }.
		
	cmdBlocks := {		
		"M"[:s | s moveToX: ptStream next Y: ptStream next ].
		"L" [:s | s lineToX: ptStream next Y: ptStream next ].
		"C"	[:s | s  
			curveVia: (ptStream next @ ptStream next)
			and: (ptStream next @ ptStream next)
			to: (ptStream next @ ptStream next) ].
		"E"	[:s | s close ] }.

	[		
		pathData := AthensTigerShape new.

		fillBlocks := { 
			"N" [].
			"F" [ pathData addFill; fillRule: #VGNONZERO.  ].
			"E" [ pathData addFill; fillRule: #VGEVENODD ] }.

		strokeBlocks := {
			"N" [].
			"S" [ pathData addStroke ] }.
		
		" fill type "
		pathData fillRule: #VGNONZERO.
		(fillBlocks at: ('NFE' indexOf: cmdStream next)) value.

		" stroke type "	
		(strokeBlocks at: ('NS' indexOf: cmdStream next)) value.

		" line cap "
		(capBlocks at: ('BRS' indexOf: cmdStream next)) value.
	
		" line join "
		(joinBlocks at: ('MRB' indexOf: cmdStream next)) value.
	
		" the rest of stroke attributes "
		pathData miterLimit: ptStream next.
		pathData strokeWidth: ptStream next.

		" paints "
		pathData strokePaint: ((Color r: ptStream next g: ptStream next b: ptStream next )).
		
		pathData fillPaint: ((Color r: ptStream next g: ptStream next b: ptStream next )).
		
		pathData setPath: (
			surface createPath: [:builder |
				builder absolute.
				(ptStream next asInteger) timesRepeat: [
					(cmdBlocks at: ('MLCE' indexOf: cmdStream next) ) value: builder.
				]
				]
		).

		paths add: pathData.
		cmdStream atEnd
	] whileFalse.

	paths do: [:ea |
		self assert: ea fillRule = #VGNONZERO.	
		ea prepareFor: surface
		].
	
	self assert: (ptStream atEnd).
	
	^ paths! !

!VGTigerDemo methodsFor: 'run' stamp: 'IgorStasenko 6/10/2012 09:40'!
runDemo
	| paths extent rotation scale translation rotationSpeed time frames zoom |
	
	paths := self convertPathData2.

	rotationSpeed := 1.
	rotation := 0.
	extent := surface extent.
	scale := extent x / self class tigerMaxY.
	translation := 0@0.

	time := Time millisecondClockValue.
	frames := 0.
	[ Sensor anyButtonPressed ] whileFalse: [
		
		rotation := rotation + rotationSpeed.
		frames := frames + 1.

		zoom := (frames/100) sin abs .
		
		surface 

			drawDuring: [:can |

				can pathTransform 
					loadIdentity. 
					
				can 
					setPaint: Color white;
					drawShape: (0@0 corner: surface extent).
					
				can pathTransform 
					translateX: (0.5 * (extent x - (self class tigerMaxX * scale*zoom))) Y: extent y / -12.0 ;
					scaleBy: scale*zoom ;

					translateX: (self class tigerMaxX * 0.5) Y: (self class tigerMaxY * 0.5 );
					scaleBy: 0.8;
					rotateByDegrees: rotation;
					translateX: (self class tigerMaxX * -0.5) Y: (self class tigerMaxY * -0.5 ).

				paths do: [:each | each renderOn: can ].

			].
			"display it"
			Display getCanvas drawImage: surface asForm  at: 0@0 
	].

	World invalidRect: (World bounds).
	time := Time millisecondClockValue - time.
	
	Transcript show: 'Total rendering time: ', time asString,  ' ms, total frames: ' , frames asString ; cr;
		show: ' FPS: ' , (1000*frames/time) asFloat asString! !

!VGTigerDemo methodsFor: 'initialization' stamp: 'IgorStasenko 6/10/2012 09:42'!
initialize 
	surface := AthensCairoSurface extent: 400@400.
	! !

!VGTigerDemo class methodsFor: 'private' stamp: ''!
tigerMaxY 
	^ 792.0! !

!VGTigerDemo class methodsFor: 'private' stamp: ''!
checkDataSizes

" 
VGTigerDemo checkDataSizes
"

	self assert: (self commands size = self tigerCommandCount).
	self assert: (self tigerPointsCount = self tigerPoints size).! !

!VGTigerDemo class methodsFor: 'huge data' stamp: ''!
tigerCommands

	^ #(
'FNBMMCCCENS'
'BMMCCCEFNBMMCCCENSBM'
'MCCCEFNBMMCCCENSBMMC'
'CCEFNBMMCCCENSBMMCCC'
'EFNBMMCCCENSBMMCCCEF'
'NBMMCCCENSBMMCCCEFNB'
'MMCCCENSBMMCCCEFNBMM'
'CCCENSBMMCCCEFNBMMCC'
'CENSBMMCCCEFNBMMCCCE'
'NSBMMCCCEFNBMMCCCENS'
'BMMCCCEFNBMMCCCENSBM'
'MCCCEFNBMMCCCCCCCCLC'
'LCLCCCCCLCCLCCCCCCCL'
'CCCCCCCCCCCCCCCCCCCC'
'CCCCCCCCCCCLLCCLCCCC'
'LCCCCCCCCCCCCCCCLNSB'
'MMCCCCCCCCLCLCLCCCCC'
'LCCLCCCCCCCLCCCCCCCC'
'CCCCCCCCCCCCCCCCCCCC'
'CCCLLCCLCCCCLCCCCCCC'
'CCCCCCCCLFNBMMCCCCCC'
'LCLCCCCCCCCCCCCLCCCC'
'CCCCCCCCCCCCCCCCENSB'
'MMCCCCCCLCLCCCCCCCCC'
'CCCLCCCCCCCCCCCCCCCC'
'CCCCEFNBMMCCCCLCCCCC'
'CCCCCCLFNBMMCCCCCCCC'
'LCCCCLCCCEFNBMMCCCCC'
'CCCLCCCCLCCCEFNBMMCC'
'CCCCCCLCCCCLCCCEFNBM'
'MCCCCCCCCLCCCCLCCCEF'
'NBMMCCCCCCCCLCCCCLCC'
'CEFNBMMCCCCCCCCLCCCC'
'LCCCEFNBMMCCCCCCCCLC'
'CCCLCCCEFNBMMCCCCCCC'
'CLCCCCLCCCEFNBMMCCCC'
'CCCCLCCCCLCCCEFNBMMC'
'CCCCCCCLCCCCLCCCEFNB'
'MMCCCCLCCCCCCCCCCCLF'
'NBMMCCCCCEFNBMMCCCCC'
'CEFNRMMCLCLCCCCLCLCC'
'EFNRMMCCCEFNRMMCCCEF'
'NRMMCCCEFNRMMCCCEFNR'
'MMCCCEFNRMMLCCCCCCCC'
'CCCCCCCCCCCCCLFNBMMC'
'CCLLCCCCCCCCEFNBMMCC'
'CCCCEFNBMMCCCCLFNBMM'
'CCCCCCCCCCCEFNBMMCCC'
'LCCCCCCENSBMMCCCLCCC'
'CCCEFNBMMCCCCCENSBMM'
'CCCCCEFNBMMCCCCCCCEN'
'SBMMCCFNBMMCCCENSBMM'
'CCCEFNBMMCCCENSBMMCC'
'CEFNBMMCCCENSBMMCCCE'
'FNBMMCCCENSBMMCCCEFN'
'BMMCCCENSBMMCCCEFNBM'
'MCCCENSBMMCCCENSBMMC'
'CCNSBMMCCCFNBMMCCCCC'
'ENSBMMCCCCCENSBMMCNS'
'BMMCFNBMMCCCCEFNBMMC'
'CCCCENSBMMCCCCCEFNBM'
'MCCCCCENSBMMCCCCCEFN'
'BMMCCCCENSBMMCCCCEFN'
'BMMCCCCCCCCEFNBMMCCC'
'CENSBMMCCCCEFNBMMCCC'
'ENSBMMCCCEFNBMMCCCEN'
'SBMMCCCEFNBMMCCCENSB'
'MMCCCEFNBMMCCCENSBMM'
'CCCEFNBMMLCCCLFNBMMC'
'CCCCEFNBMMCCCCCCCCEF'
'NBMMCCCCCCCCEFNBMMCC'
'CCCCCCEFNBMMCCCCCCCC'
'EFNBMMCCCCCCCCEFNBMM'
'CCCCCCCCEFNBMMCCCCEF'
'NBMMCCCCLCCCCEFNBMMC'
'CCCEFNBMMCCCCEFNBMMC'
'CEFNBMMCCCCEFNBMMCCC'
'CCLCCCCLCCEFNBMMCCCC'
'CLCCCCLCCEFNBMMCCLCC'
'CCLCCCCCEFNBMMCCLCCC'
'CLCCCCCEFNBMMCCLCCCC'
'LCCCCCEFNBMMCCCCCLCC'
'CCLCCEFNBMMCCCEFNBMM'
'CCCEFNBMMCCCEFNBMMCC'
'CCCCCCCCCCCCCCCCCCCC'
'CCCCCCCCCCCCCCCCCCCC'
'EFNBMMCCCCLCCCCCLFNB'
'MMCCCCCCEFNBMMCCCCCC'
'EFNBMMCCCCCCEFNBMMCC'
'CCCCEFNBMMCCCCCCEFNB'
'MMCCCCCCEFNBMMCCCCCL'
'CCCCCCCCCCCCCCCCLFNR'
'MMCCCEFNRMMCCLLCEFNR'
'MMCCCEFNRMMCCCCEFNRM'
'MCCCEFNBMMCLLLCCCCCC'
'CCCCCCCCCLCCCCCLCCCC'
'CCCCLCCCLLCLCCCCCCCC'
'CCCCCCCCLCCEFNBMMCCC'
'CCCCCCCCCCCCCCCCCCCC'
'CCCCCCCCCEFNBMMCCCCC'
'CCCCCCEFNBMMCCCCCCCC'
'CCCCCCCCCCCCCCCCCCCC'
'CCCCCCCCEFNBMMCCCCCC'
'CCCCCCCCCCCCCCCEFNBM'
'MCCCCCCCCCCCCCCCCCCC'
'CCCCEFNBMMCCCCCCCCEF'
'NBMMCCCCEFNBMMCCCCCC'
'CCCCCCCCCCCCCCCCCCCC'
'CCCCCCCCCCCCCCCCCCCC'
'CCCLCCCCCCCCLLLCCCCC'
'CLLCCCCCCLLLLNSRMMCC'
'NSRMMCCNSRMMCCCNSRMM'
'CCCFNBMMCCCCCCCCCCCC'
'CCCCCCCCCCCCCCCCCCCC'
'CCCCCCCCCCLCCCCCCCCC'
'CCCCCCCCCCCCCCCCCCCC'
'CCLCCCCCCCCCCCCCCCCL'
'CCCCCCCCCCCCCCCCCCCC'
'CCCCCCCCCCCCCCCCCCCC'
'CCCCCCCCCCCCCCCCCCCC'
'CCCCCCCCCCCCCCCEFNRM'
'MCCCCCEFNBMMCCCCEFNB'
'MMCCCCEFNBMMCCCCEFNB'
'MMCCCCCCCCCCCLCCCEFN'
'BMMCCCCCCCCCCCCEFNBM'
'MCCCCCCCCCCCCFNBMMCC'
'CCCCCCCCCCCCCCCCLFNB'
'MMCCCCLFNBMMCLCCCCCC'
'CCCEFNBMMCCCCCCCCCCC'
'CCCCCCCCCCCCCCCEFNBM'
'MCCCCCCCCCCCCCCCCCEF'
'NBMMCCCCCCCCCCCCCCCC'
'CCCEFNBMMCCCCCCCCCCC'
'CCCCCCCCCCCCCCCCCCCC'
'CCCCCCCCCCCCCCCCCCCC'
'CCCCCCCCCCCCCCCCCCCC'
'EFNBMMCCCLCCCCCCCCCL'
'LCCCCLLCCCCCCLCFNBMM'
'CLCCEFNBMMCCCCCEFNBM'
'MCCCLCCCCLFNBMMCCCCC'
'CEFNBMMCCCCCCCCCCCCC'
'CCCCCCCCCEFNBMMCCCCC'
'CCCCEFNBMMCCCCCCCCCC'
'CCCEFNBMMCCCCCCCCCEF'
'NBMMCCCCCCCCCEFNBMMC'
'CCCCCCCCEFNBMMCCLFNB'
'MMCCLFNBMMCCLFNBMMCC'
'LFNBMMCCLFNBMMCCLFNB'
'MMCCLFNBMMCCLFNBMMCC'
'LFNBMMCCLFNBMMCCLFNB'
'MMCCLFNBMMCCLFNBMMCC'
'LFNBMMCCLFNBMMCCLFNB'
'MMCCCEFNBMMCCCEFNBMM'
'LLCCEFNBMMCCCCCCCCCC'
'CCCCCCCCCCCCCCCCEFNB'
'MMCCCCCCCCCEFNRMMCCC'
'ENSRMMCCCEFNRMMCCCEN'
'SRMMCCCEFNRMMCCCENSR'
'MMCCCEFNRMMCCCENSRMM'
'CCCEFNRMMCCCENSRMMCC'
'CEFNRMMCCCENSRMMCCCE'
'FNRMMCCCENSRMMCCCEFN'
'RMMCCCENSRMMCCCEFNBM'
'MCCCCCCCCCEFNBMMCCCC'
'CCCCCEFNBMMCCLFNBMMC'
'CLFNBMMCCLFNBMMCCLFN'
'BMMCCLFNBMMCCLFNBMMC'
'CLFNBMMCCLFNBMMCCLFN'
'RMMCCCENSRMMCCCEFNBM'
'MCCCCCCCCEFNRMMCCCEN'
'SRMMCCCEFNRMMCCCENSR'
'MMCCCEFNRMMCCCENSRMM'
'CCCEFNRMMCCCENSRMMCC'
'CEFNRMMCCCENSRMMCCCE'
'FNRMMCCCENSRMMCCCEFN'
'RMMCCCENSRMMCCCEFNRM'
'MCCCENSRMMCCCEFNRMMC'
'CCENSRMMCCCEFNRMMCCC'
'ENSRMMCCCEFNRMMCCCEN'
'SRMMCCCEFNRMMCCCENSR'
'MMCCCEFNRMMCCCENSRMM'
'CCCEFNRMMCCCENSRMMCC'
'CEFNRMMCCCENSRMMCCCE'
'FNRMMCCCENSRMMCCCEFN'
'RMMCCCENSRMMCCCEFNRM'
'MCCCENSRMMCCCEFNRMMC'
'CCENSRMMCCCEFNRMMCCC'
'ENSRMMCCCEFNRMMCCCEN'
'SRMMCCCEFNRMMCCCENSR'
'MMCCCEFNRMMCCCENSRMM'
'CCCEFNRMMCCCENSRMMCC'
'CEFNRMMCCCENSRMMCCCE'
'FNBMMCCLFNBMMCCLFNBM'
'MCCLFNBMMCCLFNBMMCCL'
'FNBMMCCLFNRMMCCCEFNR'
'MMCCCCCCCEFNRMMCCCCC'
'CCEFNRMMCCCCCCCCCEFN'
'RMMCCCCCEFNRMMCCCCCC'
'CCEFNRMMCCCCEFNRMMCC'
'CCCCCCCCCCCCCCCEFNRM'
'MCCCCEFNRMMCCCEFNRMM'
'CCCEFNRMMCCCEFNRMMCC'
'CCCCEFNRMMCCCEFNRMMC'
'CCCEFNRMMCCCCEFNRMMC'
'CEFNRMMCCCCEFNRMMCCC'
'EFNRMMCCCEFNRMMCCCEF'
'NRMMLCLNSRMMLNSRMMCN'
'SRMMCNSRMMC' ).! !

!VGTigerDemo class methodsFor: 'run' stamp: 'TudorGirba 3/24/2015 15:02'!
runDemo
	<script>
	^ self new runDemo! !

!VGTigerDemo class methodsFor: 'private' stamp: ''!
tigerMaxX 
	^ 612.0! !

!VGTigerDemo class methodsFor: 'private' stamp: ''!
tigerMinX 
	^ 0.0
! !

!VGTigerDemo class methodsFor: 'private' stamp: ''!
tigerMinY 
	^ 0.0
! !

!VGTigerDemo class methodsFor: 'private' stamp: ''!
tigerCommandCount 
	^ 4142! !

!VGTigerDemo class methodsFor: 'private' stamp: ''!
tigerPointsCount 
	^ 16988! !

!VGTigerDemo class methodsFor: 'huge data' stamp: ''!
tigerPoints

	^ #(10 0 1
1 1 1 1 1 5 85.25 487.75 85.25 487.75
85.5742 485.199 84.25 484.746 83.7617 485.242 65.6641 538.125 43.2461 535.746
43.2422 535.746 62.6445 543.746 85.25 487.75 10 0.1892 0 0
0 0 0 0 5 85.25 487.75 85.25 487.75 85.5742
485.199 84.25 484.746 83.7617 485.242 65.6641 538.125 43.2461 535.746 43.2422
535.746 62.6445 543.746 85.25 487.75 10 0 1 1 1
1 1 1 5 89.2461 490.75 89.2461 490.75 88.7422 488.613
88.2461 488.746 87.0508 489.27 88.0234 545.156 66.2461 550.746 66.2461 550.742
87.0977 551.469 89.2461 490.75 10 0.1892 0 0 0 0
0 0 5 89.2461 490.75 89.2461 490.75 88.7422 488.613 88.2461
488.746 87.0508 489.27 88.0234 545.156 66.2461 550.746 66.2461 550.742 87.0977
551.469 89.2461 490.75 10 0 1 1 1 1 1
1 5 119.25 443.75 119.25 443.75 121.387 442.992 121.246 442.746
120.352 441.504 66.2578 455.586 56.25 435.75 56.25 435.75 59.9062 456.168
119.25 443.75 10 0.1892 0 0 0 0 0 0
5 119.25 443.75 119.25 443.75 121.387 442.992 121.246 442.746 120.352
441.504 66.2578 455.586 56.25 435.75 56.25 435.75 59.9062 456.168 119.25
443.75 10 0 1 1 1 1 1 1 5
116.246 432.75 116.246 432.75 118.539 432.383 118.25 431.746 118.023 430.641
62.25 426.965 58.25 404.75 58.25 404.75 56.0391 425.516 116.246 432.75
10 0.1892 0 0 0 0 0 0 5 116.246
432.75 116.246 432.75 118.539 432.383 118.25 431.746 118.023 430.641 62.25
426.965 58.25 404.75 58.25 404.75 56.0391 425.516 116.246 432.75 10
0 1 1 1 1 1 1 5 112.25 438.746
112.25 438.742 113.82 438.164 113.25 437.75 113.059 436.52 57.3437 441.016
50.2461 419.75 50.2461 419.75 50.9883 440.492 112.25 438.746 10 0.1892
0 0 0 0 0 0 5 112.25 438.746 112.25
438.742 113.82 438.164 113.25 437.75 113.059 436.52 57.3437 441.016 50.2461
419.75 50.2461 419.75 50.9883 440.492 112.25 438.746 10 0 1
1 1 1 1 1 5 100.246 458.746 100.246 458.746
101.527 457.406 101.25 456.746 100.121 456.262 52.0039 484.699 36.25 467.746
36.25 467.746 46.0586 487.012 100.246 458.746 10 0.1892 0 0
0 0 0 0 5 100.246 458.746 100.246 458.746 101.527
457.406 101.25 456.746 100.121 456.262 52.0039 484.699 36.25 467.746 36.25
467.746 46.0586 487.012 100.246 458.746 10 0 1 1 1
1 1 1 5 92.2461 454.75 92.2422 454.75 93.3906 452.969
93.2461 452.75 92.125 451.672 41.0976 474.484 27.25 456.746 27.25 456.746
34.9258 476.105 92.2461 454.75 10 0.1892 0 0 0 0
0 0 5 92.2461 454.75 92.2422 454.75 93.3906 452.969 93.2461
452.75 92.125 451.672 41.0976 474.484 27.25 456.746 27.25 456.746 34.9258
476.105 92.2461 454.75 10 0 1 1 1 1 1
1 5 89.2461 449.746 89.2461 449.742 90.6992 448.723 90.25 447.746
89.6211 447.262 35.9609 462.906 25.25 442.746 25.25 442.742 29.625 463.676
89.2461 449.746 10 0.1892 0 0 0 0 0 0
5 89.2461 449.746 89.2461 449.742 90.6992 448.723 90.25 447.746 89.6211
447.262 35.9609 462.906 25.25 442.746 25.25 442.742 29.625 463.676 89.2461
449.746 10 0 1 1 1 1 1 1 5
100.246 448.75 100.246 448.75 101.969 447.469 101.25 446.75 100.43 446.512
56.3516 480.887 39.2461 466.746 39.2461 466.742 50.75 483.941 100.246 448.75
10 0.1892 0 0 0 0 0 0 5 100.246
448.75 100.246 448.75 101.969 447.469 101.25 446.75 100.43 446.512 56.3516
480.887 39.2461 466.746 39.2461 466.742 50.75 483.941 100.246 448.75 10
0 1 1 1 1 1 1 5 79.25 480.746
79.25 480.746 79.6367 479.02 79.25 478.746 77.8789 478.578 46.418 524.777
25.25 516.75 25.25 516.75 42.0195 529.398 79.25 480.746 10 0.1892
0 0 0 0 0 0 5 79.25 480.746 79.25
480.746 79.6367 479.02 79.25 478.746 77.8789 478.578 46.418 524.777 25.25
516.75 25.25 516.75 42.0195 529.398 79.25 480.746 10 0 1
1 1 1 1 1 5 79.25 473.746 79.25 473.742
80.8164 471.527 80.25 470.75 79.1914 470.723 38.5078 509.051 19.25 496.75
19.25 496.75 33.2148 512.609 79.25 473.746 10 0.1892 0 0
0 0 0 0 5 79.25 473.746 79.25 473.742 80.8164
471.527 80.25 470.75 79.1914 470.723 38.5078 509.051 19.25 496.75 19.25
496.75 33.2148 512.609 79.25 473.746 10 0 1 1 1
1 1 1 5 79.25 468.75 79.25 468.75 80.8516 466.828
80.25 466.746 79.3086 465.875 35.2305 500.246 17.25 485.75 17.25 485.75
29.6289 503.301 79.25 468.75 10 0.1892 0 0 0 0
0 0 5 79.25 468.75 79.25 468.75 80.8516 466.828 80.25
466.746 79.3086 465.875 35.2305 500.246 17.25 485.75 17.25 485.75 29.6289
503.301 79.25 468.75 10 0 1 1 1 1 1
1 88 77.2461 466.746 77.7383 459.973 78.8242 452.746 80.25 449.746
80.25 449.742 76.7773 435.676 86.25 420.746 86.25 420.742 86.0195 413.238
88.2461 409.746 88.2461 409.742 92.1797 400.477 97.25 399.75 101.73 398.887
111.324 395.508 122.246 393.75 122.246 393.75 141.02 378.477 137.246 364.75
137.242 364.75 137.059 346.355 133.246 344.75 133.246 344.75 145.859 356.918
135.25 338.75 130.25 317.746 130.25 317.742 158.617 341.516 141.25 321.746
130.25 292.75 130.25 292.75 152.02 312.918 144.246 303.75 140.25 293.746
140.25 293.746 188.098 323.918 154.246 291.746 154.242 291.746 163.02 295.316
168.25 291.746 168.25 291.746 175.34 293.559 174.25 291.746 174.25 291.746
151.578 280.355 147.25 259.746 147.25 259.746 156.859 271.117 153.246 258.746
154.246 246.746 154.242 246.746 158.18 270.238 157.25 228.746 157.25 228.742
178.859 248.676 166.246 225.746 166.246 207.75 166.246 207.75 182.816 225.355
176.246 211.75 176.246 211.75 186.777 220.957 182.25 203.746 182.25 203.746
181.5 192.797 186.25 204.746 186.25 204.746 203.938 238.777 197.25 209.75
197.25 209.75 196.457 188.836 201.246 204.746 201.246 204.746 202.18 193.676
212.246 185.75 212.246 185.75 210.977 241.637 225.25 201.746 229.25 183.746
229.25 183.742 232.539 194.117 232.246 199.75 232.246 199.75 248.379 217.879
241.25 190.746 241.25 190.746 257.617 216.117 254.246 201.746 254.246 201.746
245.738 183.996 247.246 178.75 247.242 178.75 265.977 216.996 267.246 218.75
267.246 218.75 265.098 172.117 277.246 211.75 277.246 211.75 283.137 198.516
280.246 193.746 280.242 193.746 288.859 202.477 288.246 205.746 288.246 205.742
293.039 215.016 296.25 199.75 296.25 199.75 298.098 189.719 300.246 192.746
300.246 192.746 304.258 166.836 305.25 191.746 305.25 191.746 307.34 206.879
299.246 219.75 299.246 219.75 300.297 223.156 297.246 227.746 297.246 227.742
312.18 203.797 304.25 235.746 304.25 235.746 316.578 226.676 318.25 226.746
318.25 226.746 302.937 252.195 312.246 246.746 312.242 246.746 306.898 258.355
326.25 244.75 326.25 244.75 309.098 262.758 328.25 251.75 328.25 251.75
337.258 245.156 329.25 255.75 329.25 255.75 313.059 273.758 337.25 253.75
337.25 253.75 350.02 235.918 351.25 232.75 351.25 232.75 339.898 264.957
335.246 267.75 335.242 267.75 344.301 308.078 389.246 290.75 389.246 290.75
397.098 271.996 402.246 291.746 402.242 291.746 416.02 299.277 428.25 268.75
428.25 268.75 432.738 283.879 432.246 286.746 432.246 286.742 439.34 285.637
438.25 286.746 438.25 286.742 452.98 282.117 454.246 282.746 454.246 282.746
461.777 275.516 462.246 279.75 462.242 279.75 472.34 276.398 470.25 280.746
470.25 280.746 479.82 263.195 480.246 258.746 483.25 274.75 485.25 271.746
485.25 271.746 486.859 279.918 486.25 280.746 485.098 282.559 507.98 273.758
513.246 250.746 515.246 241.75 515.242 241.75 522.059 257.918 520.246 262.75
520.246 262.75 526.02 261.438 526.246 256.746 526.242 256.746 530.859 282.117
525.25 288.746 525.25 288.742 530.418 289.598 531.246 285.75 531.246 293.746
531.246 293.746 539.66 292.676 539.246 295.746 539.242 295.742 544.5 299.719
546.246 294.75 546.242 294.75 533.059 333.156 553.246 311.75 553.246 311.75
561.219 300.156 557.246 320.75 553.301 341.516 548.898 343.277 554.25 343.746
554.25 343.742 555.059 347.676 553.246 349.75 550.66 351.195 554.25 349.75
554.25 349.75 554.25 349.75 559.461 345.035 553.246 368.746 553.246 368.746
560.777 367.477 547.25 399.75 547.25 399.75 550.66 402.238 546.246 411.746
546.242 411.742 555.059 406.637 558.25 408.75 558.25 408.75 557.699 410.156
554.25 414.746 554.25 414.746 530.418 474.84 553.246 450.75 553.246 450.75
565.895 435.73 559.246 460.746 559.242 460.742 548.832 487.223 549.25 491.746
77.2461 466.746 10 1.1 0 0 0 0 0 0
88 77.2461 466.746 77.7383 459.973 78.8242 452.746 80.25 449.746 80.25
449.742 76.7773 435.676 86.25 420.746 86.25 420.742 86.0195 413.238 88.2461
409.746 88.2461 409.742 92.1797 400.477 97.25 399.75 101.73 398.887 111.324
395.508 122.246 393.75 122.246 393.75 141.02 378.477 137.246 364.75 137.242
364.75 137.059 346.355 133.246 344.75 133.246 344.75 145.859 356.918 135.25
338.75 130.25 317.746 130.25 317.742 158.617 341.516 141.25 321.746 130.25
292.75 130.25 292.75 152.02 312.918 144.246 303.75 140.25 293.746 140.25
293.746 188.098 323.918 154.246 291.746 154.242 291.746 163.02 295.316 168.25
291.746 168.25 291.746 175.34 293.559 174.25 291.746 174.25 291.746 151.578
280.355 147.25 259.746 147.25 259.746 156.859 271.117 153.246 258.746 154.246
246.746 154.242 246.746 158.18 270.238 157.25 228.746 157.25 228.742 178.859
248.676 166.246 225.746 166.246 207.75 166.246 207.75 182.816 225.355 176.246
211.75 176.246 211.75 186.777 220.957 182.25 203.746 182.25 203.746 181.5
192.797 186.25 204.746 186.25 204.746 203.938 238.777 197.25 209.75 197.25
209.75 196.457 188.836 201.246 204.746 201.246 204.746 202.18 193.676 212.246
185.75 212.246 185.75 210.977 241.637 225.25 201.746 229.25 183.746 229.25
183.742 232.539 194.117 232.246 199.75 232.246 199.75 248.379 217.879 241.25
190.746 241.25 190.746 257.617 216.117 254.246 201.746 254.246 201.746 245.738
183.996 247.246 178.75 247.242 178.75 265.977 216.996 267.246 218.75 267.246
218.75 265.098 172.117 277.246 211.75 277.246 211.75 283.137 198.516 280.246
193.746 280.242 193.746 288.859 202.477 288.246 205.746 288.246 205.742 293.039
215.016 296.25 199.75 296.25 199.75 298.098 189.719 300.246 192.746 300.246
192.746 304.258 166.836 305.25 191.746 305.25 191.746 307.34 206.879 299.246
219.75 299.246 219.75 300.297 223.156 297.246 227.746 297.246 227.742 312.18
203.797 304.25 235.746 304.25 235.746 316.578 226.676 318.25 226.746 318.25
226.746 302.937 252.195 312.246 246.746 312.242 246.746 306.898 258.355 326.25
244.75 326.25 244.75 309.098 262.758 328.25 251.75 328.25 251.75 337.258
245.156 329.25 255.75 329.25 255.75 313.059 273.758 337.25 253.75 337.25
253.75 350.02 235.918 351.25 232.75 351.25 232.75 339.898 264.957 335.246
267.75 335.242 267.75 344.301 308.078 389.246 290.75 389.246 290.75 397.098
271.996 402.246 291.746 402.242 291.746 416.02 299.277 428.25 268.75 428.25
268.75 432.738 283.879 432.246 286.746 432.246 286.742 439.34 285.637 438.25
286.746 438.25 286.742 452.98 282.117 454.246 282.746 454.246 282.746 461.777
275.516 462.246 279.75 462.242 279.75 472.34 276.398 470.25 280.746 470.25
280.746 479.82 263.195 480.246 258.746 483.25 274.75 485.25 271.746 485.25
271.746 486.859 279.918 486.25 280.746 485.098 282.559 507.98 273.758 513.246
250.746 515.246 241.75 515.242 241.75 522.059 257.918 520.246 262.75 520.246
262.75 526.02 261.438 526.246 256.746 526.242 256.746 530.859 282.117 525.25
288.746 525.25 288.742 530.418 289.598 531.246 285.75 531.246 293.746 531.246
293.746 539.66 292.676 539.246 295.746 539.242 295.742 544.5 299.719 546.246
294.75 546.242 294.75 533.059 333.156 553.246 311.75 553.246 311.75 561.219
300.156 557.246 320.75 553.301 341.516 548.898 343.277 554.25 343.746 554.25
343.742 555.059 347.676 553.246 349.75 550.66 351.195 554.25 349.75 554.25
349.75 554.25 349.75 559.461 345.035 553.246 368.746 553.246 368.746 560.777
367.477 547.25 399.75 547.25 399.75 550.66 402.238 546.246 411.746 546.242
411.742 555.059 406.637 558.25 408.75 558.25 408.75 557.699 410.156 554.25
414.746 554.25 414.746 530.418 474.84 553.246 450.75 553.246 450.75 565.895
435.73 559.246 460.746 559.242 460.742 548.832 487.223 549.25 491.746 77.2461
466.746 10 0 0.8 0.45 0.15 0.8 0.45 0.15 44
549.25 491.746 550.379 491.531 552.805 490.293 554.25 488.746 554.25 488.742
561.66 476.598 556.25 496.75 556.25 496.75 545.82 528.52 555.246 515.746
555.246 515.742 562.098 508.277 558.25 522.746 554.328 541.309 551.25 548.746
551.25 548.746 551.25 548.746 564.301 543.039 535.246 586.75 544.246 582.75
544.246 582.75 522.938 626.199 499.25 631.746 490.25 638.746 490.25 638.742
532.621 680.316 518.25 720.75 518.25 720.75 511.059 726.52 500.246 716.75
500.246 716.75 493.461 711.117 487.246 712.75 487.246 712.75 452.98 711.559
451.25 711.746 448.578 711.559 410.301 752.477 338.25 732.746 338.25 732.742
332.418 730.918 327.25 731.75 327.25 731.75 307.34 749.84 253.246 724.746
253.246 724.746 242.656 722.559 241.25 722.746 239.137 722.559 236.059 722.559
227.25 715.746 218.457 708.477 218.02 707.598 216.25 705.75 216.25 705.75
197.777 693.52 192.25 692.75 192.25 692.75 179.738 685.598 175.25 674.75
171.246 673.746 171.246 673.742 169.18 665.359 168.25 663.75 168.25 663.75
163.457 660.078 162.25 653.746 162.25 653.742 152.898 647.316 153.246 642.746
153.242 642.742 151.578 636.758 150.246 631.746 150.246 631.742 142.777 626.199
143.246 622.75 143.242 622.75 135.297 607.719 136.25 599.75 136.25 599.75
129.578 600.68 126.246 597.75 126.242 597.75 125.617 592.758 124.25 592.746
124.25 592.746 120.777 591 123.25 586.75 123.25 586.75 121.656 583.52
121.246 581.746 121.246 581.746 122.098 578.68 117.25 572.746 117.25 572.742
110.219 551.84 112.25 545.75 112.25 545.75 112.859 540.84 110.246 538.75
110.246 538.75 105.816 539.52 115.246 526.746 115.242 526.742 115.938 525
112.25 522.746 112.25 522.746 93.5 518.398 91.25 500.746 91.25 500.746
75.8984 484.078 76.2461 478.746 75.8984 475.824 76.1953 472.359 77.2461 467.746
77.2461 467.746 76.3398 458.117 106.25 456.746 137.059 456.355 549.25 491.746
549.25 491.746 10 1.1 0 0 0 0 0 0
44 549.25 491.746 550.379 491.531 552.805 490.293 554.25 488.746 554.25
488.742 561.66 476.598 556.25 496.75 556.25 496.75 545.82 528.52 555.246
515.746 555.246 515.742 562.098 508.277 558.25 522.746 554.328 541.309 551.25
548.746 551.25 548.746 551.25 548.746 564.301 543.039 535.246 586.75 544.246
582.75 544.246 582.75 522.938 626.199 499.25 631.746 490.25 638.746 490.25
638.742 532.621 680.316 518.25 720.75 518.25 720.75 511.059 726.52 500.246
716.75 500.246 716.75 493.461 711.117 487.246 712.75 487.246 712.75 452.98
711.559 451.25 711.746 448.578 711.559 410.301 752.477 338.25 732.746 338.25
732.742 332.418 730.918 327.25 731.75 327.25 731.75 307.34 749.84 253.246
724.746 253.246 724.746 242.656 722.559 241.25 722.746 239.137 722.559 236.059
722.559 227.25 715.746 218.457 708.477 218.02 707.598 216.25 705.75 216.25
705.75 197.777 693.52 192.25 692.75 192.25 692.75 179.738 685.598 175.25
674.75 171.246 673.746 171.246 673.742 169.18 665.359 168.25 663.75 168.25
663.75 163.457 660.078 162.25 653.746 162.25 653.742 152.898 647.316 153.246
642.746 153.242 642.742 151.578 636.758 150.246 631.746 150.246 631.742 142.777
626.199 143.246 622.75 143.242 622.75 135.297 607.719 136.25 599.75 136.25
599.75 129.578 600.68 126.246 597.75 126.242 597.75 125.617 592.758 124.25
592.746 124.25 592.746 120.777 591 123.25 586.75 123.25 586.75 121.656
583.52 121.246 581.746 121.246 581.746 122.098 578.68 117.25 572.746 117.25
572.742 110.219 551.84 112.25 545.75 112.25 545.75 112.859 540.84 110.246
538.75 110.246 538.75 105.816 539.52 115.246 526.746 115.242 526.742 115.938
525 112.25 522.746 112.25 522.746 93.5 518.398 91.25 500.746 91.25
500.746 75.8984 484.078 76.2461 478.746 75.8984 475.824 76.1953 472.359 77.2461
467.746 77.2461 467.746 76.3398 458.117 106.25 456.746 137.059 456.355 549.25
491.746 549.25 491.746 10 0 0.8 0.45 0.15 0.8 0.45
0.15 18 93.2461 466.746 65.3398 510.477 81.2461 448.75 81.2461 448.75
90.8594 410.598 233.246 451.746 233.246 451.746 233.246 451.742 419.098 485.398
431.246 489.746 443.738 494.199 548.246 486.746 548.246 486.746 542.246 505.75
471.02 556.68 449.898 531.156 435.246 535.746 419.98 539.957 422.621 529.398
419.246 528.746 415.578 527.637 372.461 554.918 365.246 553.75 358.379 553.156
330.504 579.285 347.25 544.746 364.539 506.957 282.699 501.238 264.246 513.746
245.738 525.879 272.25 493.746 272.25 493.746 292.379 471.316 254.246 489.746
254.246 489.746 216.699 503.879 190.297 475.719 187.246 474.75 183.258 473.957
177.977 470.438 177.246 477.746 176.219 484.52 167.957 502.891 133.246 473.746
111.098 455.695 96.25 479.75 96.25 479.75 93.2461 466.746 10 0
0.91 0.5 0.228 0.91 0.5 0.228 19 367.246 551.75 359.82
551.238 331.914 577.352 348.25 542.75 366.641 503.719 284.141 499.316 265.246
511.746 247.18 523.957 273.25 491.746 273.25 491.746 293.82 469.398 256.246
487.75 256.246 487.75 218.137 501.957 191.738 473.797 188.246 472.75 184.699
472.039 179.418 468.516 178.246 475.746 177.656 482.598 169.543 500.785 134.25
471.746 111.18 452.957 96.25 476.75 96.25 476.75 93.2461 465.75 65.3164
509.219 82.2461 444.746 82.2461 444.746 91.5781 407.238 235.246 449.746 235.246
449.746 235.242 449.742 420.539 483.477 433.246 487.75 445.18 492.277 549.25
485.75 549.25 485.75 543.25 504.746 471.578 555.398 451.34 529.238 436.25
533.746 421.418 538.039 424.059 527.477 420.246 526.746 417.02 525.719 373.898
552.996 367.246 551.75 10 0 0.919 0.55 0.305 0.919 0.55
0.305 19 368.246 549.75 361.258 549.316 334.051 575.75 350.25 540.75
367.641 500.695 285.578 497.398 267.246 509.75 248.617 522.035 275.246 489.746
275.246 489.746 295.258 467.477 257.246 485.75 257.246 485.75 219.578 500.035
193.18 471.875 189.246 470.75 186.137 470.117 180.859 466.598 180.246 473.746
179.098 480.676 171.125 498.68 136.25 469.746 111.258 450.215 97.25 472.75
97.25 472.75 93.2461 463.75 66.6172 506.637 82.2461 441.75 82.2461 441.75
92.2969 403.879 236.25 447.746 236.25 447.746 236.25 447.746 421.98 481.559
434.246 485.75 446.617 490.355 549.25 483.75 549.25 483.75 543.25 502.746
472.141 554.117 452.777 527.316 438.25 531.75 422.859 536.117 425.5 525.559
422.246 524.746 418.457 523.797 375.34 551.078 368.246 549.75 10 0
0.928 0.6 0.382 0.928 0.6 0.382 19 369.25 548.746 362.699
547.398 335.496 573.832 351.25 538.75 369.738 497.285 286.43 495.867 268.246
507.75 250.059 520.117 276.246 487.75 276.246 487.75 296.699 465.559 259.25
483.75 259.25 483.75 221.02 498.117 194.617 469.957 191.246 468.75 187.578
468.199 182.301 464.676 181.25 471.746 180.539 478.758 172.711 496.574 137.246
467.746 111.336 447.477 97.25 469.746 97.25 469.746 93.2461 461.75 68.7969
502.516 83.2461 438.746 83.2461 438.746 93.0195 400.516 237.25 445.746 237.25
445.746 237.25 445.746 423.418 479.637 435.246 483.75 448.059 488.438 550.246
481.75 550.246 481.75 544.246 501.75 472.699 552.84 454.219 525.398 439.25
529.75 424.301 534.199 426.938 523.637 423.246 522.746 419.898 521.879 376.777
549.156 369.25 548.746 10 0 0.937 0.65 0.46 0.937 0.65
0.46 19 371.25 546.746 364.141 545.477 337.492 572.156 352.25 536.75
371.18 493.559 288.457 493.559 270.25 505.75 251.5 518.195 278.246 485.75
278.246 485.75 298.141 463.637 260.25 481.75 260.25 481.75 222.457 496.195
196.059 468.035 192.25 466.746 189.02 466.277 183.738 462.758 183.25 469.746
181.98 476.836 174.297 494.473 139.246 466.746 111.418 444.738 97.25 466.746
97.25 466.746 93.2461 460.746 70.9766 498.617 84.25 434.746 84.25 434.746
93.7383 397.156 239.25 444.746 239.25 444.746 239.25 444.742 424.859 477.715
437.25 481.75 449.5 486.516 550.246 479.75 550.246 479.75 544.246 500.746
473.262 551.559 455.66 523.477 440.25 527.75 425.738 532.277 428.379 521.715
425.25 520.75 421.34 519.957 378.219 547.238 371.25 546.746 10 0
0.946 0.7 0.537 0.946 0.7 0.537 19 372.25 544.746 365.578
543.559 337.02 569.352 354.246 534.75 375.258 492.078 289.898 491.637 271.25
503.75 252.938 516.277 279.246 483.75 279.246 483.75 299.578 461.719 261.25
479.75 261.25 479.75 223.898 494.277 197.5 466.117 194.25 464.746 190.457
464.355 185.18 460.836 184.25 467.746 183.418 474.918 175.879 492.367 140.25
464.746 111.5 441.996 98.2461 462.746 98.2461 462.746 92.2461 458.746 72.9375
495.156 85.25 431.746 85.25 431.746 94.457 393.797 240.25 442.746 240.25
442.746 240.25 442.742 426.301 475.797 438.25 479.75 450.941 484.598 551.25
477.746 551.25 477.746 545.25 498.75 473.82 550.277 457.102 521.559 442.246
525.75 427.18 530.355 429.82 519.797 426.25 518.75 422.781 518.039 379.66
545.316 372.25 544.746 10 0 0.955 0.75 0.614 0.955 0.75
0.614 19 374.25 542.75 367.02 541.637 338.043 567.223 355.246 532.746
378.02 488.836 291.34 489.715 273.25 501.75 254.379 514.355 281.25 481.75
281.25 481.75 301.02 459.797 263.25 478.746 263.25 478.746 225.34 492.355
198.938 464.195 195.25 463.75 191.898 462.438 186.617 458.918 185.25 465.75
184.859 472.996 177.465 490.262 141.25 462.746 111.578 439.258 98.2461 459.75
98.2461 459.75 92.2461 456.746 75.1172 490.156 85.25 428.75 85.25 428.75
95.1797 390.438 242.246 440.746 242.246 440.746 242.246 440.742 427.738 473.875
440.25 478.746 452.379 482.676 551.25 475.746 551.25 475.746 545.25 497.746
474.379 548.996 458.539 519.637 443.246 523.75 428.621 528.438 431.258 517.875
427.25 516.75 424.219 516.117 381.102 543.398 374.25 542.75 10 0
0.964 0.8 0.691 0.964 0.8 0.691 19 375.246 540.75 368.461
539.719 338.273 564.66 357.246 530.746 381.219 487.355 292.777 487.797 274.25
499.746 255.82 512.438 282.25 479.75 282.25 479.75 302.457 457.879 264.246
476.75 264.246 476.75 226.777 490.438 200.379 462.277 197.25 461.75 193.34
460.516 188.059 456.996 187.246 463.75 186.297 471.078 179.047 488.156 143.246
460.746 111.656 436.516 99.2461 456.746 99.2461 456.746 92.2461 454.75 76.8555
486.477 86.25 424.75 86.25 424.75 95.8984 387.074 243.246 438.746 243.246
438.746 243.246 438.742 429.18 471.957 441.246 476.75 453.82 480.758 552.25
474.75 552.25 474.75 546.246 496.75 474.941 547.719 459.98 517.719 445.246
521.746 430.059 526.516 432.699 515.957 429.25 514.75 425.66 514.195 382.539
541.477 375.246 540.75 10 0 0.973 0.85 0.769 0.973 0.85
0.769 19 377.246 538.75 369.898 537.797 339.715 562.738 358.25 528.746
382.66 485.437 294.219 485.875 275.246 497.746 257.258 510.516 283.25 477.746
283.25 477.746 303.898 455.957 266.246 474.75 266.246 474.75 228.219 488.516
201.816 460.355 198.246 459.75 194.777 458.598 189.5 455.078 188.246 461.75
187.738 469.156 180.633 486.051 144.246 458.746 111.738 433.777 99.2461 452.75
99.2461 452.75 92.2461 453.746 77.7188 482.578 87.2461 421.75 87.2461 421.75
96.6172 383.715 245.246 436.746 245.246 436.746 245.246 436.746 430.621 470.035
443.246 474.75 455.258 478.836 552.25 472.75 552.25 472.75 547.25 495.746
475.5 546.438 461.418 515.797 446.246 519.746 431.5 524.598 434.141 514.035
430.246 512.75 427.098 512.277 383.98 539.555 377.246 538.75 10 0
0.982 0.9 0.846 0.982 0.9 0.846 19 378.246 536.75 371.34
535.879 341.578 561.055 360.25 526.746 384.098 482.195 295.66 483.957 277.246
496.75 258.699 508.598 285.25 475.746 285.25 475.746 305.34 454.035 267.246
472.75 267.246 472.75 229.66 486.598 203.258 458.438 199.246 457.75 196.219
456.676 190.937 453.156 190.246 459.75 189.18 467.238 182.219 483.949 146.25
456.746 111.82 431.035 99.2461 449.746 99.2461 449.746 92.2461 451.746 78.3594
478.238 87.2461 417.75 87.2461 417.75 97.3399 380.355 246.246 434.746 246.246
434.746 246.242 434.746 432.059 468.117 444.246 472.75 456.699 476.918 553.246
470.75 553.246 470.75 547.25 493.746 476.059 545.156 462.859 513.879 448.25
518.75 432.938 522.676 435.578 512.117 432.246 510.746 428.539 510.355 385.418
537.637 378.246 536.75 10 0 0.991 0.95 0.923 0.991 0.95
0.923 19 380.25 534.75 372.777 533.957 344.207 559.746 361.25 524.746
384.66 478.078 297.098 482.035 278.246 494.75 260.141 506.676 286.246 473.746
286.246 473.746 306.777 452.117 269.246 470.75 269.246 470.75 231.098 484.676
204.699 456.516 201.246 455.746 197.66 454.758 192.379 451.238 191.246 458.746
190.621 465.316 183.801 481.844 147.25 454.75 111.898 428.297 100.246 446.75
100.246 446.75 92.2461 449.746 78.5586 475.656 88.2461 414.746 88.2461 414.746
98.0586 376.996 248.25 432.75 248.25 432.75 248.25 432.75 433.5 466.195
446.246 470.75 458.141 474.996 553.246 468.75 553.246 468.75 548.246 492.75
476.621 543.879 464.301 511.957 449.25 516.75 434.379 520.758 437.02 510.195
433.246 509.75 429.98 508.438 386.859 535.719 380.25 534.75 10 0
1 1 1 1 1 1 18 92.2461 448.75 78.5391
472.637 89.2461 411.746 89.2461 411.746 98.7773 373.637 249.25 430.75 249.25
430.75 249.25 430.75 434.938 464.277 447.25 468.75 459.578 473.078 553.246
466.746 553.246 466.746 548.246 491.746 477.18 542.598 465.738 510.039 451.25
514.75 435.82 518.84 438.461 508.277 435.246 507.75 431.418 506.52 388.301
533.797 381.25 532.746 374.219 532.039 346.477 558.227 363.25 522.746 387.23
470.762 295.941 481.848 280.246 492.75 261.578 504.758 288.246 471.746 288.246
471.746 308.219 450.195 270.25 468.75 270.25 468.75 232.539 482.758 206.137
454.598 202.246 453.746 199.098 452.836 193.816 449.316 193.25 456.746 192.059
463.398 185.387 479.738 149.246 452.75 111.977 425.559 100.246 442.746 100.246
442.746 92.2461 448.75 10 0 0 0 0 0 0
0 7 138.246 415.75 138.246 415.75 130.457 402.676 153.246 387.746
153.242 387.742 154.879 386.617 135.25 390.746 135.25 390.746 128.258 393.438
126.246 404.75 126.242 404.75 121.219 409.719 116.246 415.75 110.656 422.035
138.246 415.75 138.246 415.75 10 0 0.8 0.8 0.8 0.8
0.8 0.8 8 292.25 467.746 292.25 467.746 311.848 438.297 311.246
432.75 309.758 421.598 309.539 411.035 313.246 406.75 316.578 402.238 326.25
365.746 326.25 365.746 326.25 365.742 325.82 364.398 339.25 405.746 339.25
405.742 352.219 423.797 330.25 443.75 330.25 443.75 291.5 475.719 292.25
467.746 10 0 0 0 0 0 0 0 15
160.246 385.746 160.246 385.742 172.699 378.035 157.25 343.746 164.246 346.746
164.242 346.746 163.02 334.035 159.246 331.75 167.25 334.75 167.25 334.75
172.699 326.117 168.25 320.75 168.25 320.75 186.777 312.035 186.25 304.746
186.25 304.746 192.938 313.797 188.246 320.75 184.137 327.879 176.219 323.477
177.246 343.746 167.25 339.746 167.25 339.742 173.578 349.879 173.25 356.75
165.246 354.746 165.242 354.742 181.793 383.512 170.246 384.75 163.457 385.957
160.246 385.746 160.246 385.746 10 0 0.8 0.8 0.8 0.8
0.8 0.8 5 196.25 367.75 196.25 367.75 199.098 372.316 196.25
371.75 192.938 370.559 158.617 354.277 152.25 343.746 152.25 343.742 189.859
370.559 196.25 367.75 10 0 0.8 0.8 0.8 0.8 0.8
0.8 5 207.25 358.75 207.25 358.75 210.539 363.516 207.25 362.75
204.379 361.758 170.059 345.477 163.25 334.75 163.25 334.75 201.297 361.758
207.25 358.75 10 0 0.8 0.8 0.8 0.8 0.8 0.8
5 222.246 375.75 222.246 375.75 225.059 380.238 222.246 379.746 218.898
378.477 184.578 362.195 178.246 351.75 178.246 351.75 215.816 378.477 222.246
375.75 10 0 0.8 0.8 0.8 0.8 0.8 0.8 5
196.25 327.75 196.25 327.75 196.457 334.035 193.25 332.746 190.297 332.277
150.699 312.918 144.246 302.746 144.246 302.746 190.297 330.516 196.25 327.75
10 0 0.8 0.8 0.8 0.8 0.8 0.8 5 198.246
339.746 198.246 339.742 199.098 344.598 196.25 343.746 193.816 343.719 164.777
330.957 158.25 320.75 158.25 320.75 190.738 344.156 198.246 339.746 10
0 0.8 0.8 0.8 0.8 0.8 0.8 24 182.25 286.746
171.246 278.75 171.246 278.75 182.379 286.957 186.25 285.75 186.25 285.75
178.859 273.316 178.246 267.75 178.246 267.75 189.418 281.676 195.25 280.746
195.25 280.746 203.938 280.797 204.25 268.75 204.25 268.75 210.098 280.355
213.246 279.75 213.242 279.75 214.938 272.879 213.246 265.75 213.242 265.75
218.02 273.758 222.246 271.746 222.246 271.746 229.457 274.195 228.25 261.746
228.25 261.742 228.578 249.996 227.25 246.746 227.25 246.746 233.859 275.957
236.25 276.75 236.25 276.75 245.297 277.719 250.25 267.75 250.25 267.75
246.18 276.398 251.25 273.746 251.25 273.742 263.34 272.438 267.246 264.746
267.246 264.742 259.379 278.156 265.246 274.75 265.246 274.75 273.02 274.637
274.25 267.75 274.25 267.75 283.578 244.277 286.246 242.75 286.246 242.75
277.418 266.277 279.246 266.746 279.242 266.742 276.977 279.477 282.25 262.75
282.25 262.75 279.18 278.598 285.25 277.746 291.5 276.836 296.34 265.836
305.25 268.75 305.25 268.75 316.141 262.316 318.25 338.75 182.25 286.746
10 0 0 0 0 0 0 0 15 187.246
388.75 187.246 388.75 203.5 395.637 247.246 388.75 247.242 388.75 255.418
388.598 263.25 398.746 270.379 407.957 299.859 415.879 307.25 413.75 317.25
406.75 318.25 405.746 318.25 405.742 331.98 393.879 332.246 385.746 332.859
377.156 316.578 324.355 306.25 306.746 295.457 289.156 284.898 275.516 264.246
277.746 264.246 277.742 240.898 282.559 212.246 277.746 212.246 277.742 180.617
279.918 177.246 288.746 174.457 297.516 190.246 313.746 190.246 313.746 190.246
313.746 194.699 323.477 193.25 339.746 192.059 355.156 192.5 385.957 187.246
388.75 10 0 0.9 0.4 0.55 0.9 0.4 0.55 8
211.246 386.75 220.656 366.598 188.246 294.75 188.246 294.75 185.898 293.117
202.023 286.469 213.246 288.746 225.219 292.059 269.246 287.75 269.246 287.75
295.457 304.559 309.246 353.75 309.246 353.75 309.246 353.75 320.98 379.797
301.246 383.746 282.258 386.836 211.246 386.75 211.246 386.75 10 0
0.7 0.2 0.35 0.7 0.2 0.35 6 209.246 352.746 212.844
366.922 214.586 379.902 211.246 386.75 211.246 386.75 280.059 379.797 292.25
402.75 297.043 411.34 313.277 377.598 313.246 366.75 313.242 366.75 243.539
351.195 227.25 363.746 209.246 352.746 10 0 0.65 0.15 0.3
0.65 0.15 0.3 13 214.25 334.75 214.25 334.75 216.258 326.996
213.246 322.75 213.242 322.75 211.859 321.719 210.246 321.746 210.246 321.742
211.859 317.316 218.25 315.746 218.25 315.746 220.656 310.719 223.246 310.746
225.938 309.836 231.219 303.676 235.246 304.746 240.02 306.316 252.25 310.746
252.25 310.746 252.25 310.742 258.5 314.238 268.246 310.746 268.242 310.742
270.789 311.16 271.25 315.746 271.809 320.727 275.219 324.797 277.246 326.746
279.617 329.195 290.18 343.277 289.246 343.746 287.539 344.156 214.25 334.75
214.25 334.75 10 0 1 0.45 0.5 1 0.45 0.5
12 209.246 387.746 209.246 387.742 206.137 363.516 209.246 354.746 213.18
345.035 212.297 342.836 211.246 338.75 210.539 334.035 215.379 323.035 221.246
316.75 234.246 314.75 234.246 314.75 251.457 318.637 261.25 315.746 261.25
315.746 271.473 314.078 275.246 330.746 275.246 330.742 280.5 337.559 288.246
340.75 296.34 343.719 304.258 389.477 300.246 398.746 295.457 407.078 279.617
411.918 262.25 394.746 244.418 377.598 242.219 396.078 209.246 387.746 10
1.1 0 0 0 0 0 0 12 209.246 387.746
209.246 387.742 206.137 363.516 209.246 354.746 213.18 345.035 212.297 342.836
211.246 338.75 210.539 334.035 215.379 323.035 221.246 316.75 234.246 314.75
234.246 314.75 251.457 318.637 261.25 315.746 261.25 315.746 271.473 314.078
275.246 330.746 275.246 330.742 280.5 337.559 288.246 340.75 296.34 343.719
304.258 389.477 300.246 398.746 295.457 407.078 279.617 411.918 262.25 394.746
244.418 377.598 242.219 396.078 209.246 387.746 10 0 1 1
0.8 1 1 0.8 7 211.246 305.75 211.246 305.75 210.098
308.078 205.25 308.746 205.25 308.742 180.617 312.477 171.246 325.75 171.246
325.75 163.898 332.277 168.25 319.746 168.25 319.742 180.18 297.078 187.246
293.746 187.246 293.746 205.699 289.598 211.246 305.75 10 0.55 0
0 0 0 0 0 7 211.246 305.75 211.246 305.75
210.098 308.078 205.25 308.746 205.25 308.742 180.617 312.477 171.246 325.75
171.246 325.75 163.898 332.277 168.25 319.746 168.25 319.742 180.18 297.078
187.246 293.746 187.246 293.746 205.699 289.598 211.246 305.75 10 0
0.8 0.25 0.3 0.8 0.25 0.3 9 299.246 375.75 299.641
384.941 301.789 394.418 300.246 398.746 292.766 412.461 274.098 406.535 262.25
394.746 244.418 377.598 242.219 396.078 209.246 387.746 209.246 387.742 207.297
372.797 208.25 361.746 208.25 361.742 249.258 374.516 250.25 368.746 250.25
368.746 251.898 371.879 262.25 371.75 272.137 371.879 297.152 373.168 299.246
375.75 10 2.2 0.65 0.1 0.15 0.65 0.1 0.15 3
251.25 387.746 251.25 387.742 256.738 381.996 253.246 371.75 253.246 371.75
236.938 353.836 239.25 338.75 10 0 1 1 0.8 1
1 0.8 5 198.246 293.746 198.246 293.746 193.816 308.078 203.25
300.75 203.25 300.75 208.777 298.398 207.25 296.75 206.137 294.879 199.977
290.477 198.246 293.746 10 0.55 0 0 0 0 0
0 5 198.246 293.746 198.246 293.746 193.816 308.078 203.25 300.75
203.25 300.75 208.777 298.398 207.25 296.75 206.137 294.879 199.977 290.477
198.246 293.746 10 0 1 1 0.8 1 1 0.8
5 204.25 292.75 204.25 292.75 200.328 303.941 208.25 297.746 208.25
297.742 212.937 295.266 211.246 294.75 206.227 293.383 211.242 290.566 204.25
292.75 10 0.55 0 0 0 0 0 0 5
204.25 292.75 204.25 292.75 200.328 303.941 208.25 297.746 208.25 297.742
212.937 295.266 211.246 294.75 206.227 293.383 211.242 290.566 204.25 292.75
10 0 1 1 0.8 1 1 0.8 5 209.246
292.75 209.246 292.75 205.609 303.941 213.246 297.746 213.242 297.742 218.168
295.414 216.25 294.75 212.824 293.383 216.523 290.566 209.246 292.75 10
0.55 0 0 0 0 0 0 5 209.246 292.75
209.246 292.75 205.609 303.941 213.246 297.746 213.242 297.742 218.168 295.414
216.25 294.75 212.824 293.383 216.523 290.566 209.246 292.75 10 0
1 1 0.8 1 1 0.8 5 216.25 292.75 216.25
292.75 212.871 303.723 220.246 297.746 220.246 297.742 225.434 295.172 224.246
294.75 220.527 293.383 223.781 290.344 216.25 292.75 10 0.55 0
0 0 0 0 0 5 216.25 292.75 216.25 292.75
212.871 303.723 220.246 297.746 220.246 297.742 225.434 295.172 224.246 294.75
220.527 293.383 223.781 290.344 216.25 292.75 10 0 1 1
0.8 1 1 0.8 5 224.246 292.75 224.242 292.75 220
303.809 227.25 297.746 227.25 297.742 231.969 296.066 231.246 294.75 229.855
293.25 230.91 290.434 224.246 292.75 10 0.55 0 0 0
0 0 0 5 224.246 292.75 224.242 292.75 220 303.809
227.25 297.746 227.25 297.742 231.969 296.066 231.246 294.75 229.855 293.25
230.91 290.434 224.246 292.75 10 0 1 1 0.8 1
1 0.8 5 231.246 291.746 231.246 291.746 225.938 305.438 236.25
298.75 236.25 298.75 241.34 296.195 240.25 294.75 238.699 292.676 240.02
289.156 231.246 291.746 10 0.55 0 0 0 0 0
0 5 231.246 291.746 231.246 291.746 225.938 305.438 236.25 298.75
236.25 298.75 241.34 296.195 240.25 294.75 238.699 292.676 240.02 289.156
231.246 291.746 10 2.2 0.65 0.15 0.3 0.65 0.15 0.3
4 200.246 310.746 200.246 310.742 214.5 313.797 221.246 310.746 221.246
310.742 227.699 308.957 229.25 309.75 230.34 309.836 234.246 310.746 234.246
310.746 10 2.2 0.65 0.15 0.3 0.65 0.15 0.3 4
237.25 300.75 237.25 300.75 250.578 315.996 264.246 310.746 271.496 308.328
270.379 312.035 271.25 314.75 272.137 318.195 272.359 322.816 278.246 325.75
10 0 1 1 0.8 1 1 0.8 7 256.246
318.75 256.246 318.75 251.898 330.516 249.25 316.75 245.738 302.355 242.219
298.398 240.25 295.746 240.25 295.742 240.457 289.598 249.25 289.75 249.25
289.75 261.578 290.477 262.25 293.746 262.457 296.637 260.699 309.398 256.246
318.75 10 0.55 0 0 0 0 0 0 7
256.246 318.75 256.246 318.75 251.898 330.516 249.25 316.75 245.738 302.355
242.219 298.398 240.25 295.746 240.25 295.742 240.457 289.598 249.25 289.75
249.25 289.75 261.578 290.477 262.25 293.746 262.457 296.637 260.699 309.398
256.246 318.75 10 2.2 0.65 0.15 0.3 0.65 0.15 0.3
2 271.25 310.746 271.25 310.742 275.656 313.355 278.246 311.75 10
2.2 0.65 0.15 0.3 0.65 0.15 0.3 2 279.246 328.746
279.242 328.742 282.039 334.148 287.246 334.75 10 0 0.7 0.7
0.7 0.7 0.7 0.7 6 191.246 288.746 191.242 288.742 211.418
284.758 216.25 286.746 216.25 286.742 225.938 286.516 216.25 284.746 216.25
284.742 202.617 284.316 194.25 285.75 194.25 285.75 181.059 291.797 191.246
288.746 10 0 1 1 0.8 1 1 0.8 7
207.25 390.746 207.25 390.746 226.379 390.797 228.25 389.75 228.25 389.75
236.5 356.035 232.246 347.75 232.246 347.75 231.219 344.598 228.25 350.746
228.25 350.742 207.898 386.836 204.25 388.75 200.859 391.238 205.699 390.797
207.25 390.746 10 0.55 0 0 0 0 0 0
7 207.25 390.746 207.25 390.746 226.379 390.797 228.25 389.75 228.25
389.75 236.5 356.035 232.246 347.75 232.246 347.75 231.219 344.598 228.25
350.746 228.25 350.742 207.898 386.836 204.25 388.75 200.859 391.238 205.699
390.797 207.25 390.746 10 0 1 1 0.8 1 1
0.8 7 122.246 393.75 122.246 393.75 132 391.898 146.25 388.75
146.25 388.75 151.137 364.398 154.246 358.75 158.18 353.836 154.219 353.836
150.246 356.75 146.297 359.996 130.02 375.398 128.25 379.746 125.617 385.078
122.246 393.75 122.246 393.75 10 0.55 0 0 0 0
0 0 7 122.246 393.75 122.246 393.75 132 391.898 146.25
388.75 146.25 388.75 151.137 364.398 154.246 358.75 158.18 353.836 154.219
353.836 150.246 356.75 146.297 359.996 130.02 375.398 128.25 379.746 125.617
385.078 122.246 393.75 122.246 393.75 10 0 1 1 0.8
1 1 0.8 6 146.25 388.75 146.25 388.75 152.637 387.094
153.246 384.75 154.855 382.223 152.25 378.75 152.25 378.75 152.25 378.75
151.324 374.961 150.246 377.75 148.68 379.719 145.52 388.145 146.25 388.75
10 0.55 0 0 0 0 0 0 6 146.25
388.75 146.25 388.75 152.637 387.094 153.246 384.75 154.855 382.223 152.25
378.75 152.25 378.75 152.25 378.75 151.324 374.961 150.246 377.75 148.68
379.719 145.52 388.145 146.25 388.75 10 0 0 0 0
0 0 0 10 146.25 388.75 146.25 388.75 150.258 383.316
154.246 383.746 158.18 383.316 158.598 383.77 161.246 382.75 166.758 381.996
166.316 384.195 173.25 382.75 176.48 382.348 179.297 383.316 182.25 381.746
185.457 380.676 188.977 381.559 190.246 383.746 191.617 385.957 197.25 390.746
197.25 390.746 197.25 390.746 182.816 388.598 179.246 387.746 179.246 387.742
155.098 386.398 146.25 388.75 10 0 1 1 0.8 1
1 0.8 6 195.25 388.75 195.25 388.75 188.262 384.969 188.246
382.75 187.383 379.688 193.25 375.75 193.25 375.75 193.25 375.75 196.625
370.559 197.25 372.746 197.941 375.836 196.238 388.379 195.25 388.75 10
0.55 0 0 0 0 0 0 6 195.25 388.75
195.25 388.75 188.262 384.969 188.246 382.75 187.383 379.688 193.25 375.75
193.25 375.75 193.25 375.75 196.625 370.559 197.25 372.746 197.941 375.836
196.238 388.379 195.25 388.75 10 0 1 1 0.8 1
1 0.8 5 154.246 382.75 154.242 382.75 161.832 370.5 162.25
382.75 162.25 382.75 162.684 384.215 160.246 383.746 154.066 384.324 155.738
388.836 154.246 382.75 10 0.55 0 0 0 0 0
0 5 154.246 382.75 154.242 382.75 161.832 370.5 162.25 382.75
162.25 382.75 162.684 384.215 160.246 383.746 154.066 384.324 155.738 388.836
154.246 382.75 10 0 1 1 0.8 1 1 0.8
5 162.25 382.75 162.25 382.75 170.734 370.227 170.246 382.75 170.242
382.75 170.043 383 168.25 382.75 162.891 383.625 163.27 388.594 162.25
382.75 10 0.55 0 0 0 0 0 0 5
162.25 382.75 162.25 382.75 170.734 370.227 170.246 382.75 170.242 382.75
170.043 383 168.25 382.75 162.891 383.625 163.27 388.594 162.25 382.75
10 0 1 1 0.8 1 1 0.8 5 170.246
382.75 170.242 382.75 178.711 370.832 178.246 381.746 178.246 381.746 178.105
382.82 176.246 382.75 172.004 383.93 171.773 387.504 170.246 382.75 10
0.55 0 0 0 0 0 0 5 170.246 382.75
170.242 382.75 178.711 370.832 178.246 381.746 178.246 381.746 178.105 382.82
176.246 382.75 172.004 383.93 171.773 387.504 170.246 382.75 10 0
1 1 0.8 1 1 0.8 5 177.246 382.75 177.246
382.75 186.207 369.719 186.25 380.75 186.25 380.75 188.398 381.992 186.25
381.746 180.078 383.051 180.957 387.953 177.246 382.75 10 0.55 0
0 0 0 0 0 5 177.246 382.75 177.246 382.75
186.207 369.719 186.25 380.75 186.25 380.75 188.398 381.992 186.25 381.746
180.078 383.051 180.957 387.953 177.246 382.75 10 0 0.9 0.9
0.7 0.9 0.9 0.7 6 137.246 378.75 129.25 379.746 126.441
385.738 124.25 392.746 124.25 392.746 124.25 392.746 131.117 391.402 145.25
388.75 145.25 388.75 145.832 384.672 147.25 378.75 137.246 378.75 10
0 0.9 0.9 0.7 0.9 0.9 0.7 7 209.246 383.746
207.469 386.437 206.02 388.371 205.25 388.75 201.992 390.891 206.547 390.477
208.25 390.746 208.25 390.746 226.02 390.477 228.25 389.75 228.25 389.75
228.668 387.18 229.25 383.746 229.25 383.742 218.32 385.66 209.246 383.746
10 0 0.8 0.45 0.15 0.8 0.45 0.15 10 268.246
535.746 298.758 531.289 326.832 570.492 329.25 580.75 330.703 591.789 319.25
604.75 319.25 604.75 321.023 608.246 315.699 623.734 310.246 633.75 304.082
644.063 286.594 642.992 267.246 643.75 249.875 645.031 229.547 619.379 228.25
617.75 226.641 615.508 233.418 573.398 235.246 566.75 236.32 560.813 233.246
531.75 233.246 531.75 271.082 541.781 237.773 540 268.246 535.746 10
0 0.92 0.56 0.32 0.92 0.56 0.32 10 229.25 616.746
227.469 614.828 234.121 573.484 235.246 567.75 236.973 561.129 234.246 532.746
234.246 532.746 270.063 542.387 238.398 540.695 268.246 536.75 298.273 532.141
325.836 570.633 327.25 580.75 329.637 591.543 318.25 604.75 318.25 604.75
320.133 607.699 314.906 622.906 309.246 632.75 303.504 642.867 286.332 641.813
267.246 642.746 250.277 643.816 230.32 618.629 229.25 616.746 10 0
0.94 0.67 0.49 0.94 0.67 0.49 10 229.25 615.75 228.297
614.152 234.824 573.574 236.25 567.75 237.625 561.445 235.246 533.746 235.246
533.746 269.371 543.539 239.023 541.391 268.246 536.75 297.793 532.996 324.844
570.773 326.25 580.75 328.574 591.297 318.25 603.746 318.25 603.746 319.246
607.156 314.113 622.078 308.246 631.746 302.922 641.668 286.066 640.637 267.246
641.75 250.684 642.602 231.094 617.883 229.25 615.75 10 0 0.96
0.78 0.66 0.96 0.78 0.66 10 230.25 615.75 229.125 613.473
235.531 573.66 237.25 567.75 238.277 561.762 235.246 534.75 235.246 534.75
267.91 544.25 239.648 542.086 268.246 537.746 297.309 533.852 323.848 570.914
325.25 580.75 327.508 591.051 317.25 603.746 317.25 603.746 318.355 606.609
313.324 621.254 308.246 630.75 302.34 640.473 285.805 639.457 267.246 640.746
251.09 641.387 231.871 617.133 230.25 615.75 10 0 0.98 0.89
0.83 0.98 0.89 0.83 10 231.246 614.746 229.949 612.797 236.234
573.75 237.25 567.75 238.926 562.082 236.25 534.75 236.25 534.75 266.891
544.965 240.273 542.781 268.246 538.75 296.824 534.703 322.855 571.055 324.246
580.75 326.445 590.805 316.25 602.75 316.25 602.75 317.469 606.063 312.531
620.426 307.25 629.746 301.762 639.273 285.543 638.281 267.246 639.75 251.492
640.172 232.645 616.387 231.246 614.746 10 0 1 1 1
1 1 1 10 268.246 539.746 296.34 535.559 321.859 571.199
323.246 580.75 325.379 590.559 315.25 602.75 315.25 602.75 316.578 605.52
311.738 619.598 306.25 628.75 301.18 638.078 285.277 637.102 267.246 637.75
251.898 638.957 233.418 615.637 232.246 613.75 230.777 612.117 236.938 573.84
238.25 567.75 239.578 562.398 237.25 535.746 237.25 535.746 264.988 545.457
240.898 543.477 268.246 539.746 10 0 0.8 0.8 0.8 0.8
0.8 0.8 6 319.25 576.746 319.25 576.742 289.078 568.559 276.246
570.746 276.246 570.746 258.937 577.578 249.25 553.75 249.25 553.75 245.297
545.68 243.246 543.746 240.898 541.277 319.25 576.746 319.25 576.746 10
0 0 0 0 0 0 0 11 324.246 579.746
324.242 579.746 291.937 565.918 281.25 566.75 281.25 566.75 262.898 571.418
253.246 555.75 253.246 555.75 244.418 545.238 241.25 543.746 241.25 543.742
240.457 541.719 247.246 545.75 259.25 540.75 259.25 540.75 275.219 529.84
286.246 547.75 286.246 547.75 290.18 559.758 290.246 561.746 290.18 564.156
313.5 570.316 315.25 570.746 317.02 571.199 324.277 575.816 324.246 579.746
10 0 0.6 0.8 0.2 0.6 0.8 0.2 6 271.25
539.746 264.141 539.832 254.93 544.086 255.246 550.746 254.93 557.832 264.141
564.723 271.25 564.75 279.258 564.723 285.387 559.152 285.25 552.746 285.387
545.402 279.258 539.832 271.25 539.746 10 0 0.4 0.6 0
0.4 0.6 0 6 267.246 557.746 262.383 557.391 256.785 555.738
257.246 555.75 258.559 561.055 265.555 564.723 271.25 564.75 276.422 564.723
280.59 562.547 283.25 558.75 283.25 558.75 277.203 559.598 267.246 557.746
10 0 1 1 1 1 1 1 4 281.25
558.75 281.25 558.75 276.098 561.957 276.246 559.746 276.246 559.746 280.059
554.699 281.25 558.75 10 0 0 0 0 0 0
0 6 270.25 549.75 267.187 549.5 264.961 551.727 265.246 554.746
264.961 557.227 267.187 559.457 270.25 559.746 272.687 559.457 274.918 557.227
275.246 554.746 274.918 551.727 272.687 549.5 270.25 549.75 10 0
0.8 0.45 0.15 0.8 0.45 0.15 15 155.246 563.746 155.246
563.742 152.02 587.477 154.246 592.746 154.242 592.746 166.539 603.316 166.246
607.746 166.246 607.742 165.656 627.078 164.246 627.746 163.02 628.84 154.656
635.438 148.246 628.75 148.242 628.75 136.617 608.598 137.246 601.746 137.246
599.75 137.242 599.75 129.137 599.797 127.246 597.75 127.246 597.75 126.059
591.879 124.25 591.75 124.25 591.75 121.656 588.797 124.25 585.746 124.25
585.742 121.656 583.078 122.246 578.75 130.25 574.746 130.25 574.742 132.656
558.438 144.246 552.746 149.859 550.156 153.34 557.559 155.246 563.746 10
0 1 1 1 1 1 1 15 154.246 565.746
154.242 565.742 151.27 587.172 153.246 591.75 153.242 591.75 164.34 601.426
164.246 604.75 164.242 604.75 163.547 622.809 162.25 623.746 161.172 624.395
153.645 630.336 147.25 623.746 147.25 623.746 137.41 606.18 138.246 599.75
138.246 597.75 138.246 597.75 130.68 598.258 129.25 596.746 129.25 596.742
127.906 591.129 126.246 590.746 126.242 590.746 123.945 588.359 126.246 585.746
126.242 585.742 123.945 583.211 124.25 579.746 132.246 575.75 132.246 575.75
133.848 561.035 144.246 555.75 149.324 553.582 152.457 560.242 154.246 565.746
10 0 0.925 0.588 0.363 0.925 0.588 0.363 15 164.246
626.75 162.645 627.816 154.406 634.16 148.246 627.746 148.242 627.742 136.816
607.992 137.246 600.75 137.246 598.746 137.242 598.742 129.523 599.414 128.25
597.75 128.25 597.75 126.52 591.691 125.25 591.75 125.25 591.75 122.23
588.688 124.25 585.746 124.25 585.742 122.23 583.109 122.246 578.75 131.246
574.746 131.242 574.742 132.953 559.086 144.246 553.75 149.723 551.012 153.117
558.23 155.246 564.75 155.246 564.75 151.832 587.402 154.246 591.75 154.242
591.75 165.988 602.844 165.246 606.75 165.242 606.75 165.129 626.012 164.246
626.75 10 0 0.95 0.725 0.575 0.95 0.725 0.575 15
163.25 625.746 162.27 626.793 154.152 632.887 148.246 625.746 148.242 625.746
137.016 607.387 138.246 600.75 138.246 598.746 138.246 598.742 129.906 599.027
128.25 596.746 128.25 596.742 126.98 591.504 125.25 590.746 125.25 590.746
122.801 588.578 125.25 585.746 125.25 585.742 122.801 583.145 123.25 578.75
131.246 574.746 131.242 574.742 133.254 559.734 144.246 554.746 149.59 551.867
152.898 558.898 155.246 564.75 155.246 564.75 151.645 587.324 154.246 591.75
154.242 591.75 165.438 602.371 165.246 605.746 165.242 605.742 164.602 624.945
163.25 625.746 10 0 0.975 0.863 0.788 0.975 0.863 0.788
15 163.25 624.75 161.895 625.77 153.898 631.609 148.246 624.75 148.242
624.75 137.211 606.781 138.246 600.75 138.246 597.75 138.246 597.75 130.293
598.645 128.25 596.746 128.25 596.742 127.445 591.316 126.246 590.746 126.242
590.746 123.375 588.469 125.25 585.746 125.25 585.742 123.375 583.176 124.25
578.75 131.246 574.746 131.242 574.742 133.551 560.387 144.246 554.746 149.457
552.727 152.68 559.57 154.246 565.746 154.242 565.742 151.457 587.246 154.246
591.75 154.242 591.75 164.887 601.898 164.246 605.746 164.242 605.742 164.074
623.879 163.25 624.75 10 0 1 1 1 1 1
1 15 154.246 566.75 154.242 566.75 151.27 587.172 153.246 591.75
153.242 591.75 164.34 601.426 164.246 604.75 164.242 604.75 163.547 622.809
162.25 623.746 161.523 624.746 153.645 630.336 147.25 623.746 147.25 623.746
137.41 606.18 138.246 599.75 138.246 597.75 138.246 597.75 130.68 598.258
129.25 596.746 129.25 596.742 127.906 591.129 126.246 590.746 126.242 590.746
123.945 588.359 126.246 585.746 126.242 585.742 123.945 583.211 124.25 579.746
132.246 575.75 132.246 575.75 133.848 561.035 144.246 555.75 149.324 553.582
152.457 560.352 154.246 566.75 10 0 0.8 0.8 0.8 0.8
0.8 0.8 5 151.25 572.746 151.25 572.742 127.27 584.398 126.246
585.746 126.242 585.742 136.289 576.258 137.246 576.746 138.047 576.258 151.25
572.746 151.25 572.746 10 0 0 0 0 0 0
0 5 132.246 579.746 132.246 579.746 152.457 576.039 152.25 570.746
152.457 567.996 152.191 553.234 146.25 554.746 137.059 557.559 141.02 573.398
132.246 579.746 10 0 0.6 0.8 0.2 0.6 0.8 0.2
5 141.25 575.75 141.25 575.75 151.332 574.195 152.25 570.746 153.117
569.438 153.848 560.301 148.246 558.75 142.832 558.098 140.379 569.34 141.25
575.75 10 0 0 0 0 0 0 0 44
236.25 528.746 235.504 530.93 236.949 530.785 239.25 531.75 241.117 532.039
254.539 536.219 255.246 538.75 256.297 541.938 271.25 536.75 271.25 536.75
272.797 536.219 277.246 533.746 277.246 533.746 282.918 532.039 290.246 531.75
290.246 531.75 292.816 530.5 296.25 527.75 296.25 527.75 312.617 516.199
326.25 523.75 326.25 523.75 348.258 531.379 341.25 550.746 341.25 550.746
338.359 560.199 342.246 563.746 342.246 563.746 342.098 568.117 350.25 560.75
350.25 560.75 352.879 556.457 354.246 550.746 354.246 550.746 362.559 538.637
359.25 557.746 359.25 557.746 359.039 559.316 355.961 563.277 356.246 564.75
355.961 565.918 354.246 569.75 354.246 569.75 350.68 573.398 353.246 580.75
353.246 580.75 355.301 596.277 353.246 594.746 353.246 594.746 351.559 596.277
341.25 585.746 341.25 585.746 339.02 581.539 332.246 579.746 332.246 579.746
329.34 577.797 325.25 579.746 325.25 579.746 322.738 579.777 316.25 571.75
316.25 571.75 319.66 572.297 322.301 567.457 325.25 566.75 327.578 567.02
329.559 569.879 331.246 570.746 333.078 571.199 336.25 564.75 336.25 564.75
336.598 561.957 330.25 556.75 330.25 556.75 330 551.617 328.25 553.75
328.25 553.75 324.938 554.039 323.621 549.859 322.246 544.746 321.418 539.738
317.25 539.746 317.25 539.746 315.039 531.156 313.246 534.75 313.246 534.75
313.5 540.617 307.25 533.746 307.25 533.746 305.578 532.039 300.246 534.75
300.246 534.75 293.039 536.656 295.25 538.75 295.25 538.75 297.656 541.277
310.246 538.75 310.246 538.75 312.398 540.617 303.25 544.746 303.25 544.746
302.937 547 304.25 551.75 304.25 551.75 305.359 555.359 313.246 561.746
313.246 561.746 323.18 562.84 320.246 564.75 320.246 564.75 313.277 570.316
307.25 561.746 307.25 561.746 304.477 555.137 285.25 538.75 285.25 538.75
280.059 534.898 282.918 542.379 278.246 538.75 274.117 534.898 251.25 544.746
251.25 544.746 238.738 546.109 235.734 528.793 232.246 531.75 232.246 531.75
237.813 522.855 236.25 528.746 10 0 0 0 0 0
0 0 12 450.25 711.746 450.25 711.746 422.18 703.199 419.246
682.746 419.246 682.742 416.461 657.438 439.25 637.75 439.25 637.75 439.34
631.039 441.246 627.746 441.246 627.742 439.777 622.238 460.246 630.75 490.25
639.75 490.25 639.75 497.418 642.477 503.25 651.746 508.859 661.84 525.578
682.52 521.25 709.75 521.25 709.75 522.938 722.559 516.25 722.746 516.25
722.746 507.098 724.758 499.25 716.75 499.25 716.75 491.699 712.879 489.246
713.746 450.25 711.746 10 0 0 0 0 0 0
0 8 510.25 712.75 510.25 712.75 512.73 722.91 507.25 717.746
507.25 717.742 499.664 711.293 491.246 711.746 491.242 711.746 475.465 708.875
470.25 694.75 470.25 694.75 466.266 664.828 475.25 658.746 475.25 658.746
480.305 650.309 488.25 657.75 495.793 664.828 512.844 698.082 510.25 712.75
10 0 0.2 0.2 0.2 0.2 0.2 0.2 8 510.25
712.75 510.25 712.75 512.309 722.313 507.25 716.75 507.25 716.75 499.48
710.906 491.246 710.746 491.242 710.742 475.719 708.531 471.246 694.75 471.242
694.75 466.691 665.289 475.25 658.746 475.25 658.746 480.469 651.031 488.25
657.75 495.68 665.289 512.387 697.961 510.25 712.75 10 0 0.4
0.4 0.4 0.4 0.4 0.4 8 509.246 712.75 509.246 712.75
511.887 721.715 507.25 716.75 507.25 716.75 499.293 710.52 491.246 710.746
491.242 710.742 475.973 708.188 471.246 693.746 471.242 693.742 467.113 665.746
475.25 659.75 475.25 659.75 480.637 651.754 488.25 658.746 495.563 665.746
511.93 697.84 509.246 712.75 10 0 0.6 0.6 0.6 0.6
0.6 0.6 8 509.246 711.746 509.246 711.746 511.465 721.113 506.246
715.746 506.242 715.742 499.109 710.133 491.246 709.75 491.242 709.75 476.23
707.844 471.246 693.746 471.242 693.742 467.535 666.203 476.246 660.746 476.246
660.742 480.805 652.477 488.25 659.75 495.449 666.203 511.477 697.719 509.246
711.746 10 0 0.8 0.8 0.8 0.8 0.8 0.8 8
509.246 711.746 509.246 711.746 511.043 720.516 506.246 715.746 506.242 715.742
498.926 709.746 491.246 709.75 491.242 709.75 476.484 707.5 472.25 693.746
472.25 693.742 467.957 666.66 476.246 660.746 476.246 660.742 480.973 653.195
488.25 659.75 495.332 666.66 511.02 697.598 509.246 711.746 10 0
1 1 1 1 1 1 8 508.25 710.746 508.25
710.742 510.621 719.918 506.246 714.75 506.242 714.75 498.738 709.359 491.246
709.75 491.242 709.75 476.738 707.156 472.25 693.746 472.25 693.742 468.379
667.117 476.246 661.75 476.246 661.75 481.141 653.918 488.25 660.746 495.219
667.117 510.563 697.477 508.25 710.746 10 0 0.6 0.15 0
0.6 0.15 0 24 275.246 487.75 275.246 487.75 253.219 508.719
244.246 509.75 244.246 509.75 206.578 514 190.246 493.746 190.246 493.742
209.656 516.637 240.25 510.746 240.25 510.742 216.258 515.316 202.246 511.746
202.242 511.746 184.137 511.797 173.25 496.75 170.246 490.75 170.242 490.75
174.898 507.398 195.25 513.746 195.25 513.746 220.219 519.277 232.246 513.746
232.246 513.746 208.34 521.477 197.25 519.746 197.25 519.742 163.898 521.918
150.246 492.75 150.246 492.75 154.219 508.719 170.246 516.75 170.242 516.75
185.457 526.316 208.25 522.746 208.25 522.746 223.738 519.719 229.25 516.75
235.18 514.438 233.859 517.52 224.246 522.746 224.242 522.746 218.457 533.797
203.25 533.746 203.25 533.746 155.977 529.398 144.246 515.746 144.246 515.742
159.5 528.52 171.246 531.75 171.246 531.75 195.578 540.398 205.25 539.746
205.25 539.742 232.098 538.418 240.25 542.75 240.25 542.75 228.137 537.316
231.246 533.746 235.18 530.277 242.656 521.918 242.246 520.75 242.656 519.277
269.277 494.969 273.25 489.746 275.246 487.75 10 0 0.8 0.8
0.8 0.8 0.8 0.8 5 428.25 273.746 428.25 273.742 410.848
314.348 397.246 324.746 397.246 324.746 425.699 307.199 429.25 287.75 429.25
287.75 429.547 276.398 428.25 273.746 10 0 0.8 0.8 0.8
0.8 0.8 0.8 7 479.25 265.75 479.25 265.75 450.449 326.449
430.246 352.746 430.246 352.742 477.949 311.598 483.25 282.746 484.246 276.75
480.246 278.75 480.242 278.75 480.148 269.25 479.25 265.75 10 0
0.8 0.8 0.8 0.8 0.8 0.8 5 542.246 319.746 542.246
319.742 473 384.75 471.246 387.746 471.242 387.742 537.898 314.898 541.25
306.746 541.25 306.742 539 316.547 542.246 319.746 10 0 0.8
0.8 0.8 0.8 0.8 0.8 6 334.246 271.746 334.246 271.746
355.848 328.648 377.246 303.75 377.246 303.75 393.25 292.898 392.25 289.75
392.25 289.75 388.297 296.75 368.246 295.746 368.242 295.742 347.598 299.5
334.246 271.746 10 0 0.8 0.8 0.8 0.8 0.8 0.8
5 544.246 411.746 544.246 411.742 494.449 443.047 486.25 444.746 473.211
447.297 540.648 412.797 546.246 400.75 546.242 400.75 548.348 404 544.246
411.746 10 0 0 0 0 0 0 0 63
378.246 294.75 378.246 294.75 400.621 296.637 408.246 303.75 413.246 299.746
432.246 342.75 436.25 336.75 436.25 336.75 452.098 352.957 451.25 361.746
450.34 370.559 465.246 354.746 465.246 354.746 465.246 354.742 464.418 367.918
472.25 360.75 472.25 360.75 469.699 377.598 479.25 368.746 479.25 368.746
467.348 401.969 492.25 373.75 498.301 366.598 493.246 373.75 493.246 373.75
493.242 373.75 464.859 426.879 488.25 410.75 488.25 410.75 490.82 436.117
489.246 440.746 488.18 445.797 485.98 470.438 480.246 475.746 475.418 481.879
481.141 483.637 487.246 477.746 487.246 477.742 474.98 504.316 489.246 490.75
489.246 490.75 485.539 507.84 480.246 510.746 480.242 510.742 474.539 529.84
491.246 517.746 491.242 517.742 486.418 531.598 483.25 534.75 483.25 534.75
470.141 565.477 478.246 559.746 483.25 555.75 483.25 555.75 475.418 571.637
482.246 566.75 489.5 561.957 489.246 562.75 489.246 562.75 489.246 562.75
466.18 598.918 488.25 579.746 488.25 579.746 479.645 594.867 476.246 602.75
476.246 602.75 455.18 624.879 471.246 617.75 476.246 615.75 476.246 615.75
466.621 627.078 458.246 628.75 449.02 630.598 460.461 637.637 467.246 635.75
474.539 633.238 491.246 624.75 491.246 624.75 491.242 624.75 505.777 604.199
510.25 603.746 510.25 603.746 488.18 612.117 495.246 603.746 495.242 603.746
510.621 587.918 502.246 588.75 502.242 588.75 496.098 580.438 501.25 570.746
501.25 570.746 481.074 590.988 497.25 562.75 505.25 544.746 505.25 544.746
478.059 572.078 490.25 547.75 490.25 547.75 509.301 521.918 511.246 521.746
513.699 521.039 518.25 511.746 518.25 511.746 513.246 513.746 519.25 503.75
519.25 503.75 507.098 517.078 513.246 502.746 520.246 486.746 520.246 486.742
497.418 510.918 512.25 478.746 512.25 478.746 494.34 484.078 504.246 464.746
504.242 464.742 502.258 447.559 502.246 441.75 503.141 436.117 504.461 404.879
499.25 395.75 494.777 387.277 506.219 366.156 508.25 361.746 510.621 357.355
514.578 345.477 505.25 355.75 495.219 365.719 500.059 359.559 502.246 349.75
504.461 340.195 511.059 323.035 510.25 316.75 510.25 316.75 508.859 315.559
505.25 319.746 505.25 319.742 489.059 344.598 491.246 328.746 491.242 328.742
489.5 319.957 486.25 310.746 486.25 310.742 482.461 298.398 482.246 307.75
482.242 307.75 478.938 326.559 476.246 317.746 472.777 309.836 468.82 303.238
465.246 300.75 462.66 297.957 456.938 323.035 455.25 311.75 455.25 311.75
442.418 325.238 437.25 306.746 424.246 288.746 424.242 288.742 423.938 302.797
422.246 295.746 422.246 295.742 389.621 289.598 378.246 294.75 10 0
0 0 0 0 0 0 34 340.25 686.746 340.25
686.742 327.578 695.719 323.246 695.746 318.777 694.84 353.539 704.957 399.246
674.75 399.246 674.75 404.141 671.52 408.246 671.746 408.246 671.742 411.621
669.316 408.246 665.75 408.246 665.75 398.859 654.797 411.246 642.746 411.246
642.742 431.418 635 425.25 644.75 425.25 644.75 437.141 640.277 440.25
635.75 442.418 631.477 441.246 635.75 441.246 635.75 441.246 635.75 434.059
643.797 427.25 649.746 427.25 649.742 421.738 651.719 418.25 660.746 415.578
670.199 412.938 681.199 418.25 684.746 418.25 684.742 413.379 679.879 414.25
684.746 415.141 688.68 419.098 692.637 421.246 692.75 422.621 693.52 440.66
710.898 448.25 711.746 448.25 711.746 438.02 709.797 434.246 710.746 431.418
712 402.16 724.539 395.25 725.75 395.25 725.75 377.078 733.117 390.246
730.746 390.242 730.742 429.66 726.738 449.25 711.746 449.25 711.746 441.758
721.457 421.246 728.746 421.246 728.742 397.098 743.02 358.25 737.746 358.25
737.742 338.801 734 330.25 731.75 330.25 731.75 327.359 732.68 326.25
732.746 326.039 733.559 313.059 743.457 282.25 735.746 282.25 735.746 264
730.699 254.246 725.75 254.246 725.75 237.816 724.098 234.246 720.75 234.246
720.75 213.398 704.52 211.246 703.75 209 702.758 196.457 694.398 195.25
693.746 195.25 693.742 222.637 701.219 225.25 703.75 227.918 706.5 247.059
709.359 249.25 707.75 252.34 706.277 261.578 706.938 251.25 706.746 251.25
706.742 334.18 690 335.246 687.75 335.938 685.598 340.25 686.746 340.25
686.746 10 0 0.8 0.45 0.15 0.8 0.45 0.15 13
419.246 696.75 419.246 696.75 407.66 705.18 405.25 704.746 403.258 705.18
389.621 716.398 385.25 715.746 380.379 715.52 366.961 726.52 337.25 717.746
337.25 717.742 336.16 719.699 340.25 720.75 340.25 720.75 347.16 723
347.25 723.75 347.25 723.75 369.82 728.277 377.246 724.746 377.246 724.746
387.859 721.457 394.25 714.75 394.25 714.75 407 711.117 410.246 711.746
410.246 711.746 420.199 709.797 420.246 707.75 420.246 707.75 427.02 704.52
425.25 701.75 425.25 701.75 425.48 699.898 419.246 696.75 10 0
0.8 0.45 0.15 0.8 0.45 0.15 38 405.25 699.746 406.047
698.664 407.168 698.555 408.246 697.746 408.094 697.32 407.773 696.961 407.25
696.75 406.281 696.504 405.121 697.133 404.25 696.75 403.422 696.258 402.715
696.457 402.246 696.75 400.313 697.105 398.301 697.137 396.25 696.75 394.254
697.621 391.66 696.977 389.246 697.746 389.309 698.109 389.063 697.727 389.246
697.746 385.629 699.016 381.512 698.707 379.246 700.746 376.168 701.672 373.574
702.18 371.25 702.746 368.906 703.488 367.355 704.574 365.246 705.75 364.059
706.27 362.457 706.844 361.25 707.75 358.719 707.75 356.703 707.625 354.246
707.75 354.52 708.227 354.309 707.848 354.246 707.75 353.863 707.996 353.543
708.637 353.246 708.746 351.508 708.004 349.871 709.074 348.25 708.746 346.742
710.043 344.844 709.773 343.246 710.746 339.883 711.195 336.414 709.797 333.246
710.746 337.602 712.926 342.758 711.57 347.25 713.746 349.789 715.148 352.715
713.938 355.246 714.75 356.078 714.934 356.84 715.152 357.246 714.75 357.426
714.566 357.625 714.828 357.246 714.75 360.387 713.527 362.934 712.125 365.246
710.746 366.039 710.793 366.621 711.047 367.246 710.746 368.57 709.488 370.711
709.602 372.25 708.746 374.105 708.809 376.078 708.391 378.246 708.746 378.066
709.109 378.324 708.734 378.246 708.746 379.602 709.582 380.875 709.281 382.25
708.746 382.227 708.82 382.957 708.551 383.25 708.746 384.531 708.164 385.473
707.637 387.246 707.75 386.895 707.414 387.098 707.789 387.246 707.75 388.41
707.277 389.559 707.34 390.246 705.75 390.426 706.207 390.609 706.469 390.246
706.746 391.828 706.066 392.543 705.238 394.25 704.746 394.289 704.855 394.961
704.168 395.25 703.75 398.227 703.168 400.254 701.488 402.246 700.746 403.5
700.16 404.465 699.902 405.25 699.746 10 0 0.8 0.45 0.15
0.8 0.45 0.15 23 321.246 714.75 318.094 716.91 315.488 718.125
313.246 719.746 312.605 720.234 312.207 720.051 312.246 719.746 310.879 720.852
309.902 721.492 309.246 722.746 308.227 722.68 307.324 722.664 307.25 722.746
303.969 724.371 301.074 724.984 298.246 726.746 299.066 727 300.301 726.73
301.246 727.75 301.172 727.309 301.434 726.996 302.246 726.746 303.668 728.203
305.703 728.371 307.25 728.746 309.422 728.172 311.313 727.836 313.246 727.75
313.605 727.484 313.824 726.91 314.25 726.746 316.629 726.074 319.258 726.648
321.246 725.75 323.336 725.035 325.066 724.133 326.25 722.746 326.703 722.441
326.348 722.113 326.25 721.746 326.465 722.02 326.766 721.793 327.25 721.746
326.98 721.184 326.98 720.852 327.25 720.75 326.766 720.246 326.457 720.133
326.25 719.746 324.5 719.871 326.449 721.387 325.25 720.75 324.277 720
325.098 718.453 324.246 716.75 323.973 717.27 323.719 717.512 324.246 717.746
324.098 717.363 323.434 717.043 323.246 716.75 322.824 715.898 321.836 714.344
321.246 714.75 10 0 0.8 0.45 0.15 0.8 0.45 0.15
25 285.25 706.746 281.645 707.801 278.293 707.676 275.246 708.746 274.898
709.109 274.656 708.727 274.25 708.746 273.082 709.41 272.07 710.473 271.25
711.746 269.883 712.602 268.059 712.176 266.246 712.75 266.301 712.848 266.078
713.41 266.246 713.746 264.406 713.625 263.387 714.672 262.25 715.746 264.809
716.172 267.461 716.137 270.25 716.75 270.293 716.582 270.453 716.227 270.25
715.746 270.746 716.227 270.891 716.469 271.25 716.75 271.254 716.309 271.586
715.953 272.25 715.746 272.469 716.824 273.082 716.617 273.25 716.75 273.836
716.563 273.973 716.227 274.25 715.746 274.27 716.227 274.41 716.57 274.25
716.75 274.707 716.57 274.852 716.227 275.246 715.746 275.148 716.227 275.289
716.469 275.246 716.75 276.199 715.758 277.172 716.367 278.246 715.746 279.219
715.922 279.512 714.656 280.246 714.75 285.879 712.895 290.43 710.535 295.25
707.75 295.566 708.078 295.801 707.805 295.25 707.75 295.973 707.379 296.316
707.477 296.25 707.75 297.688 706.523 298.832 705.922 299.246 704.746 299.84
704.34 299.477 703.895 299.246 703.75 294.348 705.047 289.941 705.715 285.25
706.746 10 0 0.8 0.45 0.15 0.8 0.45 0.15 10
270.25 658.746 268.117 659.637 267.477 661.871 266.246 663.75 266 664.215
266.301 664.563 266.246 664.746 267.266 664.832 267.863 664.309 268.246 663.75
270.234 663.137 271.922 661.77 274.25 661.75 276.309 659.16 280.992 658.738
281.25 654.75 281 654.074 279.43 655.082 279.246 653.746 276.262 655.242
273.633 655.129 271.25 656.746 270.336 657.16 270.699 657.66 270.25 658.746
10 0 0.8 0.45 0.15 0.8 0.45 0.15 6 239.25
715.746 239.727 716.129 247.461 715.871 247.246 715.746 247.391 715.406 238.891
714.254 238.25 714.75 238.309 714.523 230.047 711.852 230.25 711.746 230.191
712.148 239.285 716.129 239.25 715.746 10 0 0 0 0
0 0 0 80 256.246 705.75 256.246 705.75 240.238 703.418
235.246 701.75 230.559 700.777 210.098 692.418 207.25 689.746 207.25 689.746
192.059 684.277 173.25 662.746 173.25 662.742 181.719 666.02 184.25 668.75
184.25 668.75 199.098 682.957 199.246 679.75 199.246 679.75 212.297 689.559
211.246 686.746 211.246 686.742 238.477 699.457 236.25 695.746 236.25 695.742
260.039 701 259.25 698.75 259.25 698.75 279.617 693.957 276.246 693.746
276.246 693.742 270.156 692.418 277.246 688.746 277.246 688.742 273.457 683.617
267.246 687.75 261.578 692.418 264.879 690 259.25 688.746 259.25 688.742
256.52 688.02 251.25 692.75 251.25 692.75 245.297 697.477 235.246 693.746
235.242 693.742 201.957 679.656 200.246 678.746 200.246 678.746 195.797 675.918
193.25 671.746 193.25 671.742 186.777 667.117 183.25 665.75 183.25 665.75
169.398 652.816 168.25 651.746 168.25 651.742 164.34 645.559 163.25 644.75
163.25 644.75 170.5 649.297 172.25 651.746 172.25 651.742 188.098 662.5
194.25 663.75 194.25 663.75 198.879 666.68 200.246 667.746 200.246 667.746
215.598 678.34 220.246 678.746 220.246 678.746 230.34 672.617 233.246 680.746
233.246 680.746 239.359 682.297 245.246 680.746 245.246 680.746 249.039 683.84
248.25 686.746 248.25 686.742 249.918 688.238 251.25 683.75 251.25 683.75
254.758 680.098 260.25 682.746 260.25 682.742 264.437 682.52 262.25 679.75
262.25 679.75 257.398 675.699 244.246 675.746 244.246 675.742 230.777 674.816
212.246 666.75 212.246 666.75 179.957 655.02 170.246 643.75 170.242 643.75
162.797 633.898 157.25 632.75 157.25 632.75 150.477 631.699 144.246 623.746
144.246 623.746 154.656 629.938 164.246 629.746 164.242 629.742 168.957 632.578
165.246 628.75 165.242 628.75 160.816 620.258 162.25 614.746 162.25 614.746
161.918 608.598 161.246 606.75 161.246 606.75 152.457 592.758 152.25 589.75
152.457 587.477 153.777 576.699 154.246 575.75 154.656 575.379 153.117 577.797
157.25 574.746 161.477 572.52 164.559 570.758 165.246 567.75 166.316 564.598
163.238 573.617 163.25 575.75 162.797 577.578 158.18 585.5 159.246 587.746
159.242 587.742 160.156 587.039 161.246 585.746 161.246 585.742 160.379 586.156
161.246 589.75 161.246 589.75 161.918 595.84 163.25 599.75 165 602.879
167.199 607.059 167.25 607.746 168.078 608.816 168.078 615.199 169.25 612.746
173.25 609.746 173.25 609.742 170.277 612.34 172.25 614.746 172.25 614.746
171.598 620.918 173.25 623.746 173.25 623.746 181.277 633.02 183.25 633.75
184.797 635.219 183.25 634.746 183.25 634.746 183.25 634.746 189.859 639.398
183.25 637.75 183.25 637.75 179.078 635.879 176.246 635.75 176.246 635.75
167.418 633.68 172.25 638.746 176.219 642.918 187.219 648.859 191.246 648.75
192.25 646.75 204.25 649.746 203.25 648.75 203.25 648.75 203.059 648.859
207.25 649.746 212.297 649.738 218.68 648.199 220.246 649.746 221.758 652.156
225.5 653.258 225.25 651.746 224.617 650.18 224.246 647.746 224.246 647.746
224.242 647.746 229.898 654.359 229.25 651.746 228.578 649.52 219.559 643.797
218.25 636.746 229.25 645.746 233.246 649.746 233.246 649.742 237.379 646.879
237.25 648.75 237.816 650.398 242.879 656.777 244.246 656.746 245.52 656.34
247.719 659.418 247.246 656.746 247.277 653.699 255.246 647.746 255.246 647.746
255.246 647.746 259.156 649.738 260.25 647.746 262.238 646.656 267.246 669.746
267.246 669.746 294.25 681.75 342.246 685.75 323.246 692.75 256.246 705.75
10 2.2 0.3 0 0 0.3 0 0 3 276.246
486.746 276.246 486.742 260.039 504.977 251.25 507.75 251.25 507.75 236.059
515.316 209.246 506.746 10 2.2 0.3 0 0 0.3 0
0 3 247.246 509.75 247.242 509.75 219.559 518.18 202.246 513.746
202.242 513.746 182.379 511.359 173.25 495.746 10 2.2 0.3 0
0 0.3 0 0 4 243.246 510.746 243.246 510.742 224.617
518.617 208.25 520.75 208.25 520.75 190.078 523.898 172.25 515.746 172.25
515.742 158.398 509.379 152.25 497.746 10 2.2 0.3 0 0
0.3 0 0 4 244.246 510.746 244.246 510.742 227.477 522.359
226.25 523.75 226.25 523.75 218.68 536 204.25 536.75 204.25 536.75
180.84 535.559 162.25 526.746 10 0 0 0 0 0
0 0 169 243.246 519.746 244.68 518.543 274.25 486.746 274.25
486.746 313.059 446.457 282.25 483.75 282.25 483.75 273.898 489.359 264.246
509.75 264.246 509.75 262.457 513.117 279.246 501.75 279.246 501.75 283.578
501.238 298.246 479.75 298.246 479.75 291.059 482.758 296.25 474.75 296.25
474.75 299.418 472.637 322.246 455.746 322.246 455.746 325.82 451.078 330.25
449.746 330.25 449.746 345.621 455.035 338.25 440.746 338.25 440.746 341.219
433.035 347.25 445.746 347.25 445.746 359.699 464.277 341.25 461.75 341.25
461.75 308.656 458.559 301.246 475.746 301.246 475.746 298.539 478.797 308.246
475.746 308.246 475.746 317.461 473.957 300.246 489.746 300.246 489.746 302.937
489.797 313.246 482.746 313.246 482.746 324.5 472.199 326.25 474.75 326.25
474.75 346.5 484.078 358.25 475.746 358.25 475.746 360.141 473.957 353.98
466.477 355.246 460.746 357.5 455.035 363.25 441.75 363.25 441.75 360.141
439.637 360.25 427.746 360.25 427.746 379.059 402.238 368.246 404.75 368.246
404.75 351.34 404.879 367.246 396.746 367.246 396.746 371.141 394.316 381.25
386.75 381.25 386.75 377.738 387.719 376.246 381.746 376.246 381.746 381.258
377.598 378.246 372.746 378.246 372.746 371.578 370.996 370.25 366.75 370.25
366.75 377.738 357.797 366.246 357.746 366.246 357.746 370.699 352.516 365.246
339.746 365.246 339.746 360.141 339.316 353.246 332.746 353.246 332.746 355.738
327.879 344.246 321.746 344.246 321.746 335.059 319.957 338.25 312.75 338.25
312.75 329.34 305.879 326.25 288.746 326.25 288.746 325.82 276.836 323.18
273.316 329.25 275.746 334.621 277.719 333.246 291.746 333.246 291.746 328.461
308.516 375.246 325.75 375.246 325.75 379.938 327.879 381.25 333.75 381.25
333.75 383.02 333.156 392.25 324.746 392.25 324.746 401.059 312.477 401.246
322.75 401.246 322.75 402.82 326.559 401.246 332.746 401.246 332.746 407.66
356.918 392.25 363.746 392.25 363.746 381.258 400.918 396.25 391.75 396.25
391.75 399.738 385.516 411.246 379.746 411.246 379.746 415.25 382.75 413.82
387.719 423.246 394.746 423.246 394.746 426.141 387.277 432.246 395.75 432.246
395.75 436.699 422.918 450.25 406.75 450.25 406.75 454.738 405.758 456.246
412.746 456.246 412.746 460.02 424.676 456.246 439.75 456.246 439.75 460.02
440.078 470.25 433.746 470.25 433.746 473.66 437.438 463.539 455.918 468.25
453.746 472.34 450.637 477.25 448.75 477.25 448.75 478.059 451.078 467.246
464.746 467.246 464.746 462.219 467.797 456.246 489.746 456.246 489.746 464.418
486.277 453.25 502.746 453.25 502.746 453.418 506.52 460.246 518.75 460.246
518.75 459.141 526.316 460.246 525.75 460.246 525.75 463.098 524.559 471.898
522.797 464.25 529.75 456.938 536.879 465.246 541.746 465.246 541.746 470.141
545.238 455.25 544.746 455.25 544.746 449.461 549.637 450.25 553.75 450.25
553.75 458.699 551.84 442.859 567.68 440.25 571.75 437.578 575.598 448.25
581.746 448.25 581.746 462.66 585.277 450.25 588.75 450.25 588.75 428.34
588.359 440.25 599.75 440.25 599.75 446.82 599.797 445.246 602.75 445.246
602.75 439.34 603.758 429.25 610.75 429.25 610.75 424.379 614.758 428.25
613.75 428.25 613.75 446.82 612.559 415.25 624.75 415.25 624.75 423.938
624.879 404.25 636.746 404.25 636.746 401.938 638.078 398.246 646.75 398.246
646.75 391.82 652.156 386.246 659.75 386.246 659.75 386.098 664.477 381.25
669.746 381.25 669.746 368.059 684.719 362.25 684.746 362.25 684.746 345.621
688.238 340.25 687.75 340.25 687.75 282.25 682.746 252.777 668.438 261.25
645.746 261.25 645.746 268.398 636.098 278.246 640.746 278.246 640.746 283.578
647.098 296.25 644.75 296.25 644.75 318.777 641.156 316.25 644.75 316.25
644.75 313.277 650.18 295.457 657 295.25 657.75 295.02 658.316 285.25
661.75 285.25 661.75 282.039 663.379 277.246 673.746 277.246 673.746 273.68
677.238 291.246 670.75 291.246 670.75 289.738 669.758 298.246 665.75 298.246
665.75 317.02 666.457 328.25 654.75 328.25 654.75 340.559 636.316 341.25
645.746 341.25 645.746 343.859 655.68 331.246 678.746 331.246 678.746 331.32
681.199 340.25 673.746 340.25 673.746 341.879 676.137 343.246 669.746 343.246
669.746 342.98 667.117 347.25 658.746 347.25 658.746 350.238 644.02 354.246
651.746 354.246 651.746 359.25 641.75 360.801 638.957 354.246 630.75 354.246
630.75 353.98 627.52 354.859 627.738 348.25 619.75 342.539 611.02 346.246
605.746 346.246 605.746 344.738 598.918 354.246 599.75 354.246 599.75 357.277
596.938 361.25 596.746 361.25 596.746 363 594.738 365.246 595.75 365.246
595.75 367.398 599.578 374.25 597.75 374.25 597.75 375.758 600.02 385.25
600.75 385.25 600.75 385.879 603.316 386.32 605.078 390.246 605.746 393.801
606.398 366.246 653.746 366.246 653.746 373.777 654.578 365.246 667.746 365.246
667.746 362.34 675.477 374.879 659.418 377.246 657.75 379.719 656.34 380.82
653.918 379.246 653.746 377.301 654.359 375.32 651.938 377.246 651.746 378.398
651.5 392.699 635 396.25 623.746 400.18 612.559 406.777 608.156 413.246
601.746 420.418 594.957 419.246 568.746 419.246 568.746 419.098 558.656 425.25
546.746 425.25 546.746 427.898 542.816 423.246 522.746 423.246 522.746 421.078
520.379 422.246 519.746 422.246 519.746 423.719 518.18 431.246 503.75 431.246
503.75 429.219 503.879 433.246 499.746 433.246 499.746 438.898 493.316 432.246
496.75 432.246 496.75 425.258 498.379 433.246 487.75 433.246 487.75 434.277
485.617 424.246 490.75 424.246 490.75 414.258 491.34 427.25 483.75 427.25
483.75 436.48 475.5 424.246 480.746 424.246 480.746 418.879 482.316 422.246
474.75 422.246 474.75 425.918 473.078 445.246 465.75 445.246 465.75 445.277
461.195 442.246 455.746 442.246 455.746 442.418 451.297 440.25 447.746 440.25
447.746 438.68 438.535 438.25 437.75 438.25 437.75 433.398 437.438 425.25
422.746 425.25 422.746 423.277 419.398 412.246 405.746 412.246 405.746 409.859
398.496 390.246 406.75 390.246 406.75 382.801 402.676 385.25 406.75 385.25
406.75 384.559 408.836 390.246 415.75 390.246 415.75 397.539 418.297 394.25
429.746 394.25 429.746 399.078 431.719 386.758 434.797 387.246 435.75 387.199
437.438 393.25 438.746 393.25 438.746 402.379 441.176 397.246 443.75 397.246
443.75 396.879 448.219 400.246 454.75 400.246 454.75 412.938 455.258 400.246
472.75 400.246 472.75 388.301 481.438 387.246 487.75 387.246 487.75 401.059
496.84 392.039 510.477 392.25 514.75 392.48 518.398 394.25 541.746 394.25
541.746 391.598 548.977 388.246 563.746 388.246 563.746 390.719 569.656 399.246
583.746 399.246 583.746 401.938 588.137 411.621 593.418 409.246 596.746 406.777
600.02 398.246 597.75 398.246 597.75 389.621 599.578 390.246 593.75 390.246
593.75 388.52 592.758 387.246 587.746 387.246 587.746 386.848 578.531 377.246
571.75 377.246 571.75 364.758 564.816 375.246 560.75 375.246 560.75 381.48
553.156 370.25 552.746 370.25 552.746 358.598 554.918 367.246 543.746 367.246
543.746 379.5 529.617 376.246 526.746 376.246 526.746 364.98 525.438 379.246
515.746 379.246 515.746 379.242 515.742 377.961 517.52 378.246 515.746 378.398
513.559 381.699 508.938 382.25 506.746 383.461 504.539 379.246 504.746 379.246
504.746 379.719 493.758 363.25 498.75 363.25 498.75 363.25 498.75 362.777
498.379 361.25 497.746 359.258 497.938 346.938 498.816 340.25 500.746 334.18
503.656 326.25 503.75 326.25 503.75 326.25 503.75 322.301 501.68 314.25
501.75 305.578 502.117 297.246 498.75 297.246 498.75 291.937 499.477 301.398
504.316 301.246 503.75 301.84 503.879 308 510.039 299.246 509.75 275.223
507.578 263.25 518.75 263.25 518.75 261.137 520.379 258.246 523.75 258.246
523.75 247.277 525.656 260.25 509.75 260.25 509.75 261.137 508.277 259.25
506.746 259.25 506.746 258.719 508.938 250.25 514.75 250.25 514.75 247.047
515.949 245.547 517.414 243.246 519.746 10 0 0.3 0 0
0.3 0 0 7 216.25 532.746 216.25 532.742 229.457 526.758
232.246 523.75 235.18 520.598 250.25 507.75 250.25 507.75 250.25 507.75
244.637 510.258 242.246 511.746 238.918 514.219 227.25 522.746 227.25 522.746
227.25 522.746 222.859 529.84 216.25 532.746 10 0 0.6 0.8
0.2 0.6 0.8 0.2 6 153.246 566.75 153.258 567.398 152.684
570.379 152.25 570.746 151.332 573.977 141.25 575.75 141.25 575.75 141.207
574.098 141.148 572.34 141.25 570.746 141.25 570.746 146.621 564.469 153.246
566.75 10 0 0.4 0.6 0 0.4 0.6 0 6
153.246 567.75 152.395 567.281 152.871 570.461 152.25 570.746 151.555 573.977
141.25 575.75 141.25 575.75 141.207 574.207 141.148 572.449 141.25 570.746
141.25 570.746 145.961 565.02 153.246 567.75 10 0 0 0
0 0 0 0 6 148.246 567.75 147.371 567.297 146.812
568.551 147.25 569.75 146.812 571.645 147.371 572.898 148.246 572.746 148.746
572.898 149.305 571.645 149.246 569.75 149.305 568.551 148.746 567.297 148.246
567.75 10 0 0 0 0 0 0 0 17
98.2461 459.75 98.2422 459.75 91.7383 448.438 119.25 454.75 119.25 454.75
134.418 456.355 137.246 458.746 138.379 458.117 147.582 454.891 150.246 453.746
158.18 452.398 167.25 463.75 167.25 463.75 167.25 463.75 172.477 474.949
175.25 474.75 178.637 474.949 175.25 472.75 175.25 472.75 175.25 472.75
167.859 462.078 168.25 460.746 168.25 460.742 162.578 438.316 145.25 437.75
145.25 437.75 127.215 436.391 128.25 429.746 128.25 429.742 138.379 432.598
141.25 429.746 141.25 429.742 152.898 430.398 144.246 423.746 136.25 410.75
136.25 410.75 136.773 406.289 125.25 409.746 114.84 413.898 103.25 427.746
103.25 427.746 103.25 427.742 85.9648 444.094 98.2461 459.75 10 0
0.9 0.6 0.6 0.9 0.6 0.6 14 96.25 454.75 96.25
454.75 94.3789 444.477 135.25 455.746 135.25 455.742 139.699 455.918 142.246
454.75 144.977 454.156 158.18 451.078 160.246 452.75 160.246 452.75 152.457
437.438 139.246 438.746 139.246 438.742 125.18 437.438 125.25 431.746 125.25
431.742 130.02 424.238 135.25 421.75 135.25 421.75 138.379 418.957 138.246
415.75 137.5 411.918 134.418 410.156 132.246 409.746 130.02 408.398 126.5
411.918 124.25 411.746 122.977 411.918 113.738 418.957 109.246 423.746 104.059
429.516 94.8164 442.719 95.25 445.746 95.6992 448.879 96.25 454.75 96.25
454.75 10 0 0.7 0.4 0.4 0.7 0.4 0.4 13
100.246 435.75 102.957 431.496 106.477 426.879 109.246 423.746 113.738 418.957
122.977 411.918 124.25 411.746 126.5 411.918 130.02 408.398 132.246 409.746
134.418 410.156 137.5 411.918 138.246 415.75 138.379 418.957 135.25 421.75
135.25 421.75 131.926 423.285 128.91 427.125 127.246 429.746 127.246 429.742
127.379 426.879 121.246 427.746 115.938 428.637 110.219 431.719 108.25 434.746
106.699 438.758 104.059 441.398 106.25 437.75 107.578 433.477 110.219 429.516
112.25 428.75 113.738 428.637 113.297 427.316 110.246 427.746 108.02 428.195
104.938 428.637 100.246 434.746 10 0 0.6 0.15 0 0.6
0.15 0 20 97.25 458.746 97.25 458.746 99.2187 473.957 100.246
478.746 100.246 478.746 99.6563 485.84 102.25 490.75 104.938 495.078 107.137
501.898 110.246 507.75 113.738 513.777 113.957 518.18 118.25 519.746 122.758
521.699 129.359 531.156 132.246 532.746 135.52 533.359 135.25 532.746 135.25
532.746 135.25 532.742 142.777 548.758 157.25 544.746 157.25 544.746 139.918
547.438 157.25 557.746 157.25 557.746 152.02 556.566 155.246 564.75 158.07
569.402 157.52 561.957 145.25 548.746 145.25 548.746 139.918 539.52 134.25
535.746 128.477 532.918 115.277 525.219 114.25 520.75 112.637 516.859 109.117
510.477 107.25 508.746 104.719 506.957 101.637 502.34 101.25 498.75 101.25
498.75 99.8789 494.199 98.2461 492.75 96.7969 491.559 96.5781 488.039 96.25
485.75 96.5781 483.637 94.3789 480.559 94.2461 477.746 94.2461 477.742 95.4766
457.016 95.25 454.75 97.25 458.746 10 0 1 1 1
1 1 1 6 88.2461 453.746 88.2461 453.742 85.5781 455.477
80.25 448.75 80.25 448.75 88.7695 412.578 89.2461 410.75 89.2461 410.75
89.9766 413.348 88.2461 421.75 87.1172 429.188 86.25 442.746 86.25 442.746
88.2461 453.746 10 0 0.6 0.15 0 0.6 0.15 0
13 111.246 520.75 111.246 520.75 92.1797 517.078 92.2461 484.746 91.25
457.75 91.25 457.75 90.418 485.84 89.2461 487.75 87.7773 489.359 92.1797
501.68 88.2461 494.75 88.2461 494.75 73.2578 479.68 82.2461 456.746 82.2422
456.746 83.707 452.727 80.25 457.75 80.25 457.75 75.3477 471.648 76.2461
478.746 76.2422 478.746 76.7773 481.109 79.25 483.75 79.25 483.75 88.3281
497.059 91.25 499.746 91.25 499.742 93.2773 515.43 110.246 520.75 110.246
520.75 116.488 523.68 111.246 520.75 10 0 0 0 0
0 0 0 28 265.246 593.75 265.605 593.809 265.594 594.875
266.246 594.746 267.496 595.441 267.676 596.617 268.246 597.75 269.207 598.93
269.418 600.617 270.25 602.75 270.359 603.027 270.387 604.078 270.25 604.75
268.754 607.531 267.98 610.227 266.246 612.746 266.098 613.391 265.812 614.262
265.246 614.746 265.082 616.441 263.699 617.535 263.25 618.746 262.434 619.469
263.012 620.488 262.25 620.746 261.238 620.695 259.645 621.332 259.25 619.75
258.742 617.359 259.852 614.586 261.25 611.75 260.059 611.137 260.426 610.125
260.25 609.746 261.375 605.313 260.055 601.625 259.25 597.75 259.191 597.691
259.57 597.473 259.25 597.75 258.195 594.449 256.598 591.762 254.246 588.75
253.762 588.051 252.805 587.043 252.25 585.746 251.852 585.008 251.402 583.945
251.25 582.75 247.898 579.801 245.426 575.57 242.246 571.75 242.043 570.594
242.363 569.262 243.246 568.746 243.863 568.527 244.918 569.656 245.246 570.746
245.859 571.352 246.25 572.066 247.246 572.746 246.937 572.969 246.738 573.43
247.246 573.75 249.785 576.145 251.621 579.375 254.246 581.746 256.465 582.34
258.152 583.438 260.25 584.75 260.414 584.75 260.992 584.477 261.25 584.75
263.238 585.984 263.238 588.223 263.25 590.746 263.41 591.297 263.625 592.746
265.246 593.75 10 0 0 0 0 0 0 0
19 255.246 598.746 255.289 598.414 255.117 598.879 255.246 598.746 255.418
599.477 255.859 599.68 256.246 599.75 256.16 600.277 255.98 600.695 256.246
600.75 258.695 603.543 258.977 606.867 258.246 609.746 258.965 610.82 259.031
612.207 258.246 612.746 257.625 615.012 257.414 617.129 256.246 618.746 255.457
620.223 253.723 621.59 252.25 619.75 251.75 619.719 251.398 618.852 251.25
617.75 251.773 617.887 252.09 617.727 252.25 617.75 251.941 617.281 251.34
617.035 251.25 616.746 251.301 615.09 250.25 613.43 251.25 611.75 251.793
610.176 252.695 608.133 253.246 605.746 252.082 603.852 253.219 601.156 251.25
598.746 251.141 598.93 251.148 598.508 251.25 598.746 251.605 597.75 252.051
597.305 252.25 596.746 252.809 596.848 253.191 596.848 253.246 596.746 254.047
597.383 254.484 597.918 255.246 598.746 10 0 0 0 0
0 0 0 21 324.246 609.746 325.773 607.703 326.094 604.629
324.246 602.75 324.445 599.457 328.129 601.637 330.25 601.746 330.32 602.645
330.57 603.023 331.246 602.75 332.043 603.047 332.789 604.18 334.246 603.746
334.438 605.691 336.238 606.465 337.25 607.746 338.844 612.047 338.195 616.746
335.246 620.746 335.129 620.598 335.371 621.164 335.246 621.75 334.402 623.996
332.125 624.34 330.25 624.75 328.703 629.359 327.977 633.793 326.25 637.75
324.266 638.133 323.496 640.047 322.246 640.746 320.559 641.629 319.934 639.891
320.246 638.746 319.988 638.516 320.484 638.27 320.246 637.75 320.215 637.688
319.926 637.566 320.246 637.75 319.93 637.27 320.172 637.125 320.246 636.746
319.309 636.074 317.742 635.551 317.25 634.746 316.371 630.211 319.199 626.773
321.246 623.746 321.684 622.004 320.875 620.605 320.246 619.75 319.559 618.512
319.676 617.273 320.246 616.746 320.809 613.766 322.559 611.855 324.246 609.746
10 0 0 0 0 0 0 0 73 283.25
589.75 281.734 587.41 277.98 584.586 281.25 582.75 281.402 582.324 281.809
582.32 282.25 582.75 284.223 584.188 286.426 585.18 289.246 585.746 289.242
585.852 289.543 585.34 290.246 585.746 291.727 586.289 293.938 586.227 295.25
587.746 299.383 587.453 303.305 588.68 307.25 589.75 308.309 590.609 309.707
591.227 311.246 591.75 312.543 592.41 313.867 593.434 315.25 594.746 315.234
594.836 315.625 594.738 316.25 594.746 315.875 595.688 316.934 595.828 317.25
596.746 317.305 596.766 317.141 597.203 317.25 597.75 319.641 599.105 320.652
601.328 319.25 603.746 319.051 604.578 318.777 605.258 318.25 605.746 316.961
606.781 315.75 605.844 314.25 605.746 314.422 605.488 313.621 605.676 313.246
605.746 312.25 604.977 310.785 605.621 310.246 604.75 308.344 604.371 306.977
604.188 305.25 603.746 305.07 603.684 304.215 603.789 304.25 602.75 303.891
603.246 303.727 603.504 303.25 603.746 301.512 603.043 300.125 602.809 298.246
600.75 298.582 600.801 298.098 600.996 298.246 600.75 296.867 599.961 296.422
598.602 295.25 597.75 294.992 597.727 294.602 597.914 294.25 597.75 293.68
597.297 293.277 596.59 292.25 595.75 292.207 595.848 291.766 596.207 292.25
596.746 292.07 598.629 292.789 600.594 292.25 602.75 294.441 605.43 297.211
607.574 299.246 610.75 299.215 612.961 299.977 615.32 300.246 617.75 299.84
617.816 299.523 618.625 299.246 618.746 299.043 619.945 300.039 621.117 299.246
621.75 297.566 623.238 296.145 622.273 295.25 620.746 293.215 620.27 290.945
619.508 289.246 620.746 288.102 621.73 287.465 622.727 286.246 623.746 285.504
625.32 285.871 626.898 286.246 628.75 285.953 628.762 285.609 628.91 285.25
628.75 285.609 629.207 285.852 629.352 286.246 629.746 285.223 630.188 284.918
631.352 284.25 631.746 284.133 632.898 283.391 633.871 282.25 633.75 280.238
634.965 278.395 632.859 276.246 632.75 275.746 632.758 275.23 633.902 274.25
634.746 274.043 634.496 273.27 634.531 273.25 633.75 272.113 633.688 271.465
633.559 270.25 633.75 268.852 632.855 267.449 631.652 266.246 630.75 264.188
629.77 263.137 628.188 262.25 626.75 260.914 625.469 260.762 622.813 262.25
622.75 264.352 621.547 265.785 624.523 268.246 623.746 268.293 624.105 268.52
623.766 268.246 623.746 268.824 623.219 269.066 623.469 269.246 623.746 270.223
622.656 271.504 622.285 272.25 621.75 273.602 620.332 275.523 620.793 276.246
619.75 278.32 618.043 277.707 615.094 280.246 613.75 279.195 612.215 278.527
610.809 278.246 608.75 277.848 607.914 278.941 606.598 280.246 606.75 281.656
606.801 281.945 607.633 282.25 608.75 282.773 608.523 283.289 608.199 283.25
607.746 282.738 605.336 281.609 603.141 281.25 600.75 281.043 600.121 280.707
599.898 280.246 599.75 279.762 595.453 275.305 592.82 272.25 589.75 272.063
588.785 272.059 587.414 272.25 586.75 274.051 585.445 276.207 587.145 278.246
587.746 278.313 589.023 279.258 590.063 280.246 589.75 281.004 589.988 281.262
590.586 281.25 590.746 282 590.879 282.555 590.633 283.25 590.746 284.77
592.164 286.32 593.383 288.246 594.746 288.441 594.832 288.82 594.66 289.246
594.746 289.414 594.957 289.621 595.383 290.246 595.75 290.359 595.805 290.625
595.484 291.246 594.746 290.129 594.793 290.125 593.742 289.246 593.75 288.629
593.223 288.012 592.66 287.246 591.75 286.949 591.957 286.227 592.23 286.246
591.75 285.453 590.902 284.152 590.418 283.25 589.75 10 0 0
0 0 0 0 0 30 222.246 643.75 222.246 643.75
212.258 646.957 200.246 618.746 200.246 618.742 197.34 613 194.25 610.75
192.059 608.598 179.738 604.637 177.246 599.75 166.246 582.75 166.246 582.75
182.379 600.238 186.25 602.75 186.25 602.75 194.699 612.117 191.246 604.75
191.242 604.75 175.777 592.758 177.246 582.75 177.246 582.75 170.938 566.797
170.246 564.75 170.242 564.75 187.656 599.797 190.246 600.75 192.938 602.438
194.258 602.438 193.25 598.746 191.617 594.52 191.18 576.477 188.246 574.746
188.246 574.742 196.898 596.719 196.25 599.75 196.25 599.75 199.539 604.199
202.246 598.746 201.246 580.75 205.25 567.75 205.25 567.75 203.059 580
205.25 596.746 205.25 596.742 202.617 608.598 207.25 602.75 211.418 596.277
221.977 589.68 222.246 584.75 222.246 584.75 216.258 603.758 206.25 608.75
201.246 602.75 200.246 604.75 200.246 604.75 196.457 605.52 201.246 612.746
206.137 620.477 205.25 621.75 205.25 621.75 205.25 621.75 212.738 613.438
214.25 613.75 214.25 613.75 229.02 621.797 230.25 594.746 230.25 594.742
237.816 610.797 227.25 618.746 227.25 618.742 211.418 620.477 212.246 625.746
220.246 639.75 224.617 645.559 223.246 642.746 223.246 642.746 10 0
0 0 0 0 0 0 6 200.246 625.746 200.246
625.746 186.34 625.758 183.25 619.75 175.25 609.746 175.25 609.742 193.816
620.477 198.246 621.75 202.617 623.117 200.246 625.746 200.246 625.746 10
0 0 0 0 0 0 0 7 156.25 618.746
156.25 618.742 154.219 617.398 154.246 614.746 153.34 611.238 150.699 610.797
151.25 607.746 152.457 604.637 154.656 602 154.246 606.75 154.656 610.797
156.418 613 157.25 614.746 158.18 615.637 159.938 620.477 156.25 618.746
10 0 0 0 0 0 0 0 10 146.25
551.75 146.25 551.75 137.5 555.797 134.25 559.746 130.457 563.719 130.957
558.035 125.25 558.75 119.187 558.922 120.246 576.746 120.246 576.746 116.246
567.75 116.246 567.75 114.617 552.277 123.25 554.746 127.715 556.207 129.137
554.477 127.246 553.75 125.617 552.719 133.539 552.277 130.25 550.746 127.379
548.758 143.219 554.477 140.25 542.75 146.25 551.75 10 0 0
0 0 0 0 0 8 133.246 535.746 133.246 535.746
115.938 530.719 112.25 541.746 112.25 541.742 106.699 538.637 109.246 535.746
111.539 532.039 113.25 531.75 113.25 531.75 113.25 531.75 118.797 530.277
118.25 529.75 117.477 528.52 115.246 524.746 115.246 524.746 115.242 524.746
126.059 531.379 133.246 535.746 10 0 1 1 1 1
1 1 24 384.25 449.746 383.648 447.191 381.813 446.309 379.246
445.746 377.609 446.629 374.754 450.047 372.25 447.746 372.156 448.305 371.301
448.371 371.25 448.75 370.41 450.086 370.711 451.238 370.25 451.746 369.734
453.516 368.953 455.016 369.25 456.746 371.145 457.359 371.801 459.457 371.25
461.75 371.203 461.68 370.73 461.895 371.25 462.746 371.156 462.633 371.504
462.883 372.25 462.746 371.652 463.031 371.492 462.773 371.25 462.746 370.699
462.91 370.836 463.613 371.25 463.75 371.621 465.957 373.836 466.25 375.246
464.746 375.602 465.559 376.16 465.348 376.246 465.75 376.586 466.016 377.031
466.594 377.246 466.746 377.82 468.266 379.613 467.047 380.25 467.746 381.672
468.629 382.844 469.398 384.25 468.75 386.02 467.621 387.898 466.285 389.246
464.746 389.848 463.453 390.113 462.047 390.246 460.746 390.008 460.281 388.488
460.668 388.246 459.75 387.402 457.723 389.414 457.152 390.246 455.746 390.465
455.297 390.176 454.961 390.246 454.75 389.375 454.711 388.516 454.922 388.246
454.75 389.734 450.91 386.703 450.164 384.25 449.746 10 0 1
1 1 1 1 1 11 373.25 427.746 373.551 429.891
371.789 431.82 373.25 433.746 373.27 433.551 373.41 433.305 373.25 433.746
373.707 433.305 373.852 433.551 374.25 433.746 375.645 431.258 379.66 430.238
379.246 426.75 379.48 426.617 378.285 425.605 379.246 424.75 377.285 423.414
377.223 420.809 376.246 418.746 374.836 419.051 373.504 419.449 372.25 419.75
372.625 421.691 372.496 423.543 373.25 424.75 373.879 425.766 373.563 426.949
373.25 427.746 10 0 0.8 0.8 0.8 0.8 0.8 0.8
15 190.246 437.75 190.246 437.75 172.195 426.727 187.246 443.75 197.34
454.156 208.25 460.746 208.25 460.746 208.25 460.742 219.777 465.156 223.246
466.746 227.699 467.797 244.418 473.52 248.25 473.746 251.457 474.398 262.02
478.797 269.246 474.75 276.977 470 286.246 464.746 286.246 464.746 286.246
464.742 267.738 474.398 264.246 471.746 259.816 469.117 251.898 469.559 245.246
465.75 245.246 465.75 229.02 461.195 225.25 458.746 221.977 456.797 210.539
444.035 209.246 444.746 207.02 445.797 209.219 446.238 210.246 449.746 211.859
452.398 209.656 454.156 201.246 446.75 192.059 440.078 190.246 437.75 190.246
437.75 10 0 0 0 0 0 0 0 11
199.246 444.746 199.246 444.742 200.434 458.785 210.246 456.746 210.246 456.746
218.809 461.539 222.246 463.75 222.246 463.75 230.758 465.578 232.246 466.746
252.523 475.824 268.715 470.855 269.246 471.746 269.918 473.316 291.504 465.488
295.25 460.746 295.906 460.508 284.219 467.152 273.25 468.75 264.453 471.008
240.691 468.961 228.25 462.746 225.422 461.211 215.582 454.848 213.246 454.75
210.016 455.094 199.246 444.746 199.246 444.746 10 0 0.8 0.8
0.8 0.8 0.8 0.8 11 194.25 416.746 194.25 416.742 177.977
418.957 196.25 420.746 196.25 420.742 216.258 422.918 220.246 428.75 220.246
428.75 235.617 438.758 238.25 438.746 241.777 439.637 274.777 447.559 275.246
449.746 275.656 452.836 281.816 452.836 283.25 451.746 285.34 451.078 284.457
449.758 281.25 448.75 278.297 447.996 243.977 429.957 237.25 428.75 229.898
427.316 217.137 418.957 212.246 417.75 206.578 416.316 194.25 416.746 194.25
416.746 10 0 0 0 0 0 0 0 11
216.25 424.75 216.25 424.75 206.73 425.367 216.25 426.75 216.25 426.75
225.887 430.035 228.25 432.75 228.25 432.75 235.801 438.145 237.25 438.746
238.957 438.594 254.313 442.652 254.246 443.75 254.762 445.355 292.234 459.191
297.246 455.746 300.301 453.371 289.406 455.219 279.246 450.75 277.32 449.684
240.082 433.637 236.25 432.75 232.871 432.285 226.34 428.008 223.246 427.746
220.934 426.656 216.25 424.75 216.25 424.75 10 0 0 0
0 0 0 0 4 207.25 421.75 207.25 421.75 213.18
422.477 212.246 420.746 210.539 418.957 208.25 419.75 208.25 419.75 207.25
421.75 10 0 0 0 0 0 0 0 4
199.246 420.746 199.246 420.742 205.258 420.719 204.25 418.746 202.617 417.195
200.246 417.75 200.246 417.75 199.246 420.746 10 0 0 0
0 0 0 0 4 188.246 418.746 188.246 418.742 193.816
418.957 192.25 416.746 191.18 415.438 188.246 416.746 188.246 416.746 188.246
418.746 10 0 0 0 0 0 0 0 4
179.246 417.75 179.246 417.75 185.457 418.078 184.25 416.746 182.816 414.559
180.246 415.75 180.246 415.75 179.246 417.75 10 0 0 0
0 0 0 0 4 222.246 460.746 222.246 460.742 226.816
461.195 225.25 459.75 224.18 457.676 220.246 457.75 220.246 457.75 222.246
460.746 10 0 0 0 0 0 0 0 4
211.246 454.75 211.246 454.75 218.133 457.391 215.25 453.746 214.059 451.957
211.246 452.75 211.246 452.75 211.246 454.75 10 0 0 0
0 0 0 0 4 198.246 449.746 198.246 449.742 204.379
450.195 203.25 448.75 201.738 446.676 199.246 447.746 199.246 447.746 198.246
449.746 10 0 0 0 0 0 0 0 4
190.246 442.746 190.246 442.742 196.02 443.598 194.25 441.75 193.379 440.078
190.246 440.746 190.246 440.746 190.246 442.746 10 0 0 0
0 0 0 0 4 183.25 437.75 183.25 437.75 188.539
438.316 187.246 436.746 185.898 434.797 183.25 435.75 183.25 435.75 183.25
437.75 10 0 0 0 0 0 0 0 4
226.25 430.75 226.25 430.75 233.422 431.426 231.246 428.75 229.906 426.742
226.25 427.746 226.25 427.746 226.25 430.75 10 0 0 0
0 0 0 0 4 237.25 435.75 237.25 435.75 244.863
436.707 243.246 434.746 241.348 432.02 238.25 432.75 238.25 432.75 237.25
435.75 10 0 0 0 0 0 0 0 4
249.25 440.746 249.25 440.742 256.742 441.547 255.246 438.746 253.227 436.859
249.25 437.75 249.25 437.75 249.25 440.746 10 0 0 0
0 0 0 0 4 260.25 445.746 260.25 445.746 268.18
446.824 266.246 444.746 264.668 442.141 261.25 443.75 261.25 443.75 260.25
445.746 10 0 0 0 0 0 0 0 4
230.25 465.75 230.25 465.75 237.82 466.625 236.25 464.746 234.309 461.941
230.25 461.75 230.25 461.75 230.25 465.75 10 0 0 0
0 0 0 0 4 241.25 469.746 241.25 469.746 248.82
470.145 247.246 467.746 245.309 465.461 240.25 465.75 240.25 465.75 241.25
469.746 10 0 0 0 0 0 0 0 4
216.25 425.746 216.25 425.746 221.977 425.996 220.246 423.746 219.34 422.477
216.25 423.746 216.25 423.746 216.25 425.746 10 0 0.6 0.15
0 0.6 0.15 0 5 135.25 534.75 135.25 534.75 130.898
525 130.25 521.746 130.25 521.742 131.34 531.156 132.246 533.746 133.977
535.559 135.25 534.75 135.25 534.75 10 0 0.6 0.15 0
0.6 0.15 0 5 115.246 519.746 115.242 519.742 111.977 503.438
112.25 500.746 112.25 500.746 111.098 513.117 111.246 514.75 111.977 515.758
115.246 519.746 115.246 519.746 10 0 0.8 0.8 0.8 0.8
0.8 0.8 6 138.246 601.746 138.246 597.75 135.25 597.75 135.25
597.75 151.359 583.738 152.25 575.75 152.25 575.75 152.898 584.398 138.246
601.746 10 0 0 0 0 0 0 0 28
143.246 599.75 142.285 600.402 142.527 601.223 142.246 601.746 141.188 602.078
143.508 602.141 143.246 602.75 142.836 604.254 143.039 604.277 143.246 605.746
142.844 606.34 143.488 608.031 144.246 608.75 145.504 610.332 144.047 613.559
146.25 615.75 146.188 615.582 146.598 616.191 147.25 616.746 147.637 617.711
148.941 618.246 150.246 618.746 150.336 619.461 150.113 620.371 150.246 620.746
151.523 620.141 152.891 620.285 153.246 619.75 152.715 617.027 151.254 615.137
150.246 613.75 150.344 612.527 149.84 611.828 149.246 610.75 148.059 608.336
148.266 605.207 148.246 601.746 148.07 601.992 147.73 601.906 147.25 601.746
148.129 599.277 148.77 596.859 149.246 594.746 150.141 593.387 150.66 592.402
151.25 591.75 150.945 590.625 151.059 589.711 150.246 588.75 152.848 585.754
151.41 582.84 152.25 578.75 152.922 578.27 154.785 576.164 154.246 576.746
151.512 577.297 151.387 577.734 151.25 578.75 151.031 579.25 150.668 580.762
150.246 581.746 150.336 581.605 150.148 583.68 150.246 583.746 148.398 586.434
149.895 586.238 148.246 588.75 146.816 589.582 145.754 590.797 144.246 591.75
144.301 592.297 145.559 593.094 145.25 593.75 144.156 594.746 142.887 595.59
143.246 596.746 143.43 597.992 143.578 599.156 143.246 599.75 10 0
0 0 0 0 0 0 11 139.246 597.75 139.246
597.75 139.258 590.559 142.246 588.75 144.539 587.039 143.219 587.918 139.246
588.75 136.18 590.559 137.246 591.75 137.246 591.75 137.242 591.75 134.418
591 137.246 588.75 139.699 586.598 143.656 583.957 142.246 583.746 140.137
583.957 131.777 588.359 132.246 591.75 131.777 594.52 130.25 598.746 130.25
598.746 130.25 598.742 131.887 599.906 137.246 599.75 137.242 599.75 138.707
599.027 139.246 597.75 10 0 1 1 1 1 1
1 5 138.246 577.75 138.246 577.75 128.566 580.648 108.25 576.746
108.25 576.742 118.172 579.203 139.246 576.746 150.148 575.324 138.246 577.75
138.246 577.75 10 0.11 0 0 0 0 0 0
5 138.246 577.75 138.246 577.75 128.566 580.648 108.25 576.746 108.25
576.742 118.172 579.203 139.246 576.746 150.148 575.324 138.246 577.75 138.246
577.75 10 0 1 1 1 1 1 1 5
140.25 577.75 140.25 577.75 131.176 581.527 110.246 579.746 110.246 579.746
120.695 580.984 141.25 576.746 152.215 574.355 140.25 577.75 140.25 577.75
10 0.11 0 0 0 0 0 0 5 140.25
577.75 140.25 577.75 131.176 581.527 110.246 579.746 110.246 579.746 120.695
580.984 141.25 576.746 152.215 574.355 140.25 577.75 140.25 577.75 10
0 1 1 1 1 1 1 5 142.246 577.75
142.242 577.75 133.453 582.086 113.25 581.746 113.25 581.746 122.965 582.328
143.246 576.746 153.902 573.371 142.246 577.75 142.246 577.75 10 0.11
0 0 0 0 0 0 5 142.246 577.75 142.242
577.75 133.453 582.086 113.25 581.746 113.25 581.746 122.965 582.328 143.246
576.746 153.902 573.371 142.246 577.75 142.246 577.75 10 0 1
1 1 1 1 1 5 143.246 577.75 143.242 577.75
136.102 582.047 117.25 583.746 117.25 583.742 126.715 583.066 144.246 576.746
153.77 572.66 143.246 577.75 143.246 577.75 10 0.11 0 0
0 0 0 0 5 143.246 577.75 143.242 577.75 136.102
582.047 117.25 583.746 117.25 583.742 126.715 583.066 144.246 576.746 153.77
572.66 143.246 577.75 143.246 577.75 10 0 1 1 1
1 1 1 5 270.25 565.746 270.25 565.742 269.398 565.031
269.246 566.75 269.871 567.629 300.898 582.117 305.25 581.746 305.25 581.746
271.602 567.316 270.25 565.746 10 0.11 0 0 0 0
0 0 5 270.25 565.746 270.25 565.742 269.398 565.031 269.246
566.75 269.871 567.629 300.898 582.117 305.25 581.746 305.25 581.746 271.602
567.316 270.25 565.746 10 0 1 1 1 1 1
1 5 266.246 564.75 266.246 564.75 265.727 564.25 266.246 565.746
265.992 566.879 295.785 583.758 300.246 583.746 300.246 583.742 267.742 566.699
266.246 564.75 10 0.11 0 0 0 0 0 0
5 266.246 564.75 266.246 564.75 265.727 564.25 266.246 565.746 265.992
566.879 295.785 583.758 300.246 583.746 300.246 583.742 267.742 566.699 266.246
564.75 10 0 1 1 1 1 1 1 5
263.25 563.746 263.25 563.742 262.164 562.676 262.25 563.746 262.254 565.316
284.055 582.363 295.25 584.75 295.25 584.75 275.016 575.484 263.25 563.746
10 0.11 0 0 0 0 0 0 5 263.25
563.746 263.25 563.742 262.164 562.676 262.25 563.746 262.254 565.316 284.055
582.363 295.25 584.75 295.25 584.75 275.016 575.484 263.25 563.746 10
0 1 1 1 1 1 1 5 260.25 561.746
260.25 561.742 259.09 560.711 259.25 561.746 259.176 563.086 278.793 578.43
288.246 580.75 288.246 580.75 270.656 572.238 260.25 561.746 10 0.11
0 0 0 0 0 0 5 260.25 561.746 260.25
561.742 259.09 560.711 259.25 561.746 259.176 563.086 278.793 578.43 288.246
580.75 288.246 580.75 270.656 572.238 260.25 561.746 10 0 0.8
0.8 0.8 0.8 0.8 0.8 11 225.25 398.746 225.25 398.742
208.34 401.355 227.25 402.75 227.25 402.75 246.617 405.316 251.25 410.75
251.25 410.75 265.977 421.156 269.246 421.75 272.137 422.035 290.18 425.996
290.246 428.75 291.059 431.277 297.656 433.918 299.246 432.75 301.18 432.156
301.18 422.035 298.246 420.746 295.02 420.277 274.34 412.355 267.246 410.75
260.258 409.719 247.5 401.355 242.246 399.75 236.938 398.719 225.25 398.746
225.25 398.746 10 0 0 0 0 0 0 0
11 305.25 439.75 305.25 439.75 302.059 438.098 300.246 434.746 300.246
434.746 293.699 423.578 278.246 419.75 278.246 419.75 252.777 410.156 244.246
407.746 244.246 407.742 229.457 402.457 221.246 403.746 221.246 403.746 213.617
403.117 220.246 401.746 220.246 401.746 242.656 403.559 246.246 405.746 246.242
405.742 263.559 411.258 267.246 413.75 270.156 416.977 290.18 422.477 292.25
424.75 295.02 426.879 305.797 436.117 305.25 439.75 10 0 0
0 0 0 0 0 4 241.25 404.75 241.25 404.75
246.52 405.445 245.246 403.746 243.984 402.035 241.25 402.75 241.25 402.75
241.25 404.75 10 0 0 0 0 0 0 0
4 233.246 403.746 233.246 403.746 238.598 403.957 237.25 402.75 236.063
400.547 233.246 401.746 233.246 401.746 233.246 403.746 10 0 0
0 0 0 0 0 4 221.246 402.75 221.246 402.75
227.125 402.586 226.25 400.75 224.59 399.176 222.246 399.75 222.246 399.75
221.246 402.75 10 0 0 0 0 0 0 0
4 213.246 401.746 213.242 401.746 218.73 401.984 217.25 400.75 216.191
398.578 213.246 399.75 213.246 399.75 213.246 401.746 10 0 0
0 0 0 0 0 4 259.25 413.75 259.25 413.75
266.609 413.664 265.246 411.746 263.234 409.129 259.25 410.75 259.25 410.75
259.25 413.75 10 0 0 0 0 0 0 0
4 270.25 417.75 270.25 417.75 276.855 421.832 276.246 416.746 275.973
413.453 271.25 415.75 271.25 415.75 270.25 417.75 10 0 0
0 0 0 0 0 4 280.246 421.75 280.242 421.75
288.223 425.367 286.246 419.75 285.457 416.664 281.25 418.746 281.25 418.746
280.246 421.75 10 0 0 0 0 0 0 0
4 291.246 426.75 291.242 426.75 295.605 431.996 297.246 424.75 297.227
421.875 291.246 423.746 291.246 423.746 291.246 426.75 10 0 0
0 0 0 0 0 4 249.25 408.75 249.25 408.75
255.266 408.652 254.246 406.75 252.73 405.242 250.25 405.746 250.25 405.746
249.25 408.75 10 0 1 1 1 1 1 1
5 288.246 541.746 288.246 541.742 287.875 541.203 288.246 542.75 287.875
543.559 307.109 558.148 317.25 559.746 317.25 559.746 299.125 552.27 288.246
541.746 10 0.11 0 0 0 0 0 0 5
288.246 541.746 288.246 541.742 287.875 541.203 288.246 542.75 287.875 543.559
307.109 558.148 317.25 559.746 317.25 559.746 299.125 552.27 288.246 541.746
10 0 0 0 0 0 0 0 10 292.25
471.746 292.25 471.742 316.141 447.117 326.25 442.746 326.25 442.742 336.379
430.836 332.246 401.746 332.246 401.746 328.461 393.879 325.25 416.746 325.25
416.742 328.461 444.477 316.25 426.75 316.25 426.75 306.898 437.766 314.25
437.75 314.25 437.75 317.461 435.238 318.25 436.746 318.34 438.758 309.539
453.719 290.246 469.746 271.699 485.398 292.25 471.746 292.25 471.746 10
0 1 1 1 1 1 1 5 227.25 428.75
227.25 428.75 227.477 431.059 229.25 429.746 231.438 429.297 335.059 422.477
370.25 395.75 370.25 395.75 320.098 421.598 227.25 428.75 10 0.11
0 0 0 0 0 0 5 227.25 428.75 227.25
428.75 227.477 431.059 229.25 429.746 231.438 429.297 335.059 422.477 370.25
395.75 370.25 395.75 320.098 421.598 227.25 428.75 10 0 1
1 1 1 1 1 5 239.25 433.746 239.25 433.742
238.918 435.898 241.25 434.746 242.879 434.137 393.141 435.238 419.246 399.75
419.246 399.75 394.898 427.316 239.25 433.746 10 0.11 0 0
0 0 0 0 5 239.25 433.746 239.25 433.742 238.918
435.898 241.25 434.746 242.879 434.137 393.141 435.238 419.246 399.75 419.246
399.75 394.898 427.316 239.25 433.746 10 0 1 1 1
1 1 1 5 252.25 438.746 252.25 438.742 251.68 440.297
253.246 439.75 255.637 438.535 446.379 452.836 472.25 416.746 472.25 416.742
461.777 445.355 252.25 438.746 10 0.11 0 0 0 0
0 0 5 252.25 438.746 252.25 438.742 251.68 440.297 253.246
439.75 255.637 438.535 446.379 452.836 472.25 416.746 472.25 416.742 461.777
445.355 252.25 438.746 10 0 1 1 1 1 1
1 5 263.25 443.75 263.25 443.75 262.68 445.578 264.246 444.746
266.637 443.816 401.059 486.277 427.25 450.75 427.25 450.75 412.277 477.699
263.25 443.75 10 0.11 0 0 0 0 0 0
5 263.25 443.75 263.25 443.75 262.68 445.578 264.246 444.746 266.637
443.816 401.059 486.277 427.25 450.75 427.25 450.75 412.277 477.699 263.25
443.75 10 0 1 1 1 1 1 1 5
199.246 418.746 199.246 418.742 198.879 420.496 201.246 419.75 202.84 418.738
222.418 416.316 224.246 373.75 224.242 373.75 216.699 419.836 199.246 418.746
10 0.11 0 0 0 0 0 0 5 199.246
418.746 199.246 418.742 198.879 420.496 201.246 419.75 202.84 418.738 222.418
416.316 224.246 373.75 224.242 373.75 216.699 419.836 199.246 418.746 10
0 1 1 1 1 1 1 5 189.246 416.746
189.246 416.742 189.199 418.738 191.246 417.75 193.156 416.977 208.777 422.035
205.25 379.746 205.25 379.746 207.02 418.078 189.246 416.746 10 0.11
0 0 0 0 0 0 5 189.246 416.746 189.246
416.742 189.199 418.738 191.246 417.75 193.156 416.977 208.777 422.035 205.25
379.746 205.25 379.746 207.02 418.078 189.246 416.746 10 0 1
1 1 1 1 1 5 180.246 416.746 180.242 416.742
180.398 418.297 182.25 417.75 184.359 416.535 201.297 415.879 187.246 390.746
187.246 390.746 198.219 417.637 180.246 416.746 10 0.11 0 0
0 0 0 0 5 180.246 416.746 180.242 416.742 180.398
418.297 182.25 417.75 184.359 416.535 201.297 415.879 187.246 390.746 187.246
390.746 198.219 417.637 180.246 416.746 10 0 1 1 1
1 1 1 5 232.246 464.746 232.246 464.742 232.187 462.887
234.246 463.75 251.566 478.113 287.254 542.906 348.25 548.746 348.25 548.746
306.367 562.426 232.246 464.746 10 0.11 0 0 0 0
0 0 5 232.246 464.746 232.246 464.742 232.187 462.887 234.246
463.75 251.566 478.113 287.254 542.906 348.25 548.746 348.25 548.746 306.367
562.426 232.246 464.746 10 0 1 1 1 1 1
1 5 245.246 466.746 245.246 466.742 243.496 468.379 245.246 468.75
247.605 469.754 371.293 549.508 414.25 540.75 414.25 540.75 384.688 549.004
245.246 466.746 10 0.11 0 0 0 0 0 0
5 245.246 466.746 245.246 466.742 243.496 468.379 245.246 468.75 247.605
469.754 371.293 549.508 414.25 540.75 414.25 540.75 384.688 549.004 245.246
466.746 10 0 1 1 1 1 1 1 5
222.246 460.746 222.246 460.742 221.512 458.594 223.246 459.75 233.266 465.301
237.242 528.234 285.25 529.75 285.25 529.75 249.523 545.801 222.246 460.746
10 0.11 0 0 0 0 0 0 5 222.246
460.746 222.246 460.742 221.512 458.594 223.246 459.75 233.266 465.301 237.242
528.234 285.25 529.75 285.25 529.75 249.523 545.801 222.246 460.746 10
0 1 1 1 1 1 1 5 200.246 447.746
200.246 447.746 198.973 446.812 201.246 446.75 212.391 448.555 235.937 493.953
285.25 488.746 285.25 488.742 249.656 504.148 200.246 447.746 10 0.11
0 0 0 0 0 0 5 200.246 447.746 200.246
447.746 198.973 446.812 201.246 446.75 212.391 448.555 235.937 493.953 285.25
488.746 285.25 488.742 249.656 504.148 200.246 447.746 10 0 1
1 1 1 1 1 5 212.246 454.75 212.246 454.75
211.625 453.348 213.246 453.746 224.461 457.637 238.852 506.711 288.246 510.746
288.246 510.742 250.363 519.348 212.246 454.75 10 0.11 0 0
0 0 0 0 5 212.246 454.75 212.246 454.75 211.625
453.348 213.246 453.746 224.461 457.637 238.852 506.711 288.246 510.746 288.246
510.742 250.363 519.348 212.246 454.75 10 0 1 1 1
1 1 1 5 192.25 442.746 192.25 442.742 191.453 441.449
193.25 441.75 202.32 442.863 221.395 479.633 261.25 474.75 261.25 474.75
232.508 487.891 192.25 442.746 10 0.11 0 0 0 0
0 0 5 192.25 442.746 192.25 442.742 191.453 441.449 193.25
441.75 202.32 442.863 221.395 479.633 261.25 474.75 261.25 474.75 232.508
487.891 192.25 442.746 10 0 1 1 1 1 1
1 5 184.25 435.75 184.25 435.75 182.949 434.945 184.25 434.746
189.281 435.414 222.984 471.801 243.246 454.75 243.246 454.75 230.082 475.344
184.25 435.75 10 0.11 0 0 0 0 0 0
5 184.25 435.75 184.25 435.75 182.949 434.945 184.25 434.746 189.281
435.414 222.984 471.801 243.246 454.75 243.246 454.75 230.082 475.344 184.25
435.75 10 0 1 1 1 1 1 1 5
260.25 470.75 260.25 470.75 259.219 472.699 261.25 472.75 263.469 473.547
396.242 537.031 438.25 522.746 438.25 522.746 409.465 534.84 260.25 470.75
10 0.11 0 0 0 0 0 0 5 260.25
470.75 260.25 470.75 259.219 472.699 261.25 472.75 263.469 473.547 396.242
537.031 438.25 522.746 438.25 522.746 409.465 534.84 260.25 470.75 10
0 1 1 1 1 1 1 5 223.246 400.75
223.246 400.75 223.52 402.457 225.25 401.746 227.477 400.695 244.418 400.035
231.246 375.75 231.246 375.75 241.34 401.797 223.246 400.75 10 0.11
0 0 0 0 0 0 5 223.246 400.75 223.246
400.75 223.52 402.457 225.25 401.746 227.477 400.695 244.418 400.035 231.246
375.75 231.246 375.75 241.34 401.797 223.246 400.75 10 0 1
1 1 1 1 1 5 235.246 401.746 235.242 401.746
234.957 404.219 237.25 403.746 238.918 402.457 258.5 400.035 260.25 357.746
260.25 357.746 252.777 403.559 235.246 401.746 10 0.11 0 0
0 0 0 0 5 235.246 401.746 235.242 401.746 234.957
404.219 237.25 403.746 238.918 402.457 258.5 400.035 260.25 357.746 260.25
357.746 252.777 403.559 235.246 401.746 10 0 1 1 1
1 1 1 5 242.246 403.746 242.246 403.746 242.437 405.977
244.246 404.75 246.398 404.219 273.457 400.477 299.246 364.75 299.246 364.75
260.258 405.316 242.246 403.746 10 0.11 0 0 0 0
0 0 5 242.246 403.746 242.246 403.746 242.437 405.977 244.246
404.75 246.398 404.219 273.457 400.477 299.246 364.75 299.246 364.75 260.258
405.316 242.246 403.746 10 0 1 1 1 1 1
1 5 251.25 405.746 251.25 405.742 250.566 408.164 252.25 407.746
254.723 406.945 277.199 409.031 319.25 371.75 319.25 371.75 268.316 409.875
251.25 405.746 10 0.11 0 0 0 0 0 0
5 251.25 405.746 251.25 405.742 250.566 408.164 252.25 407.746 254.723
406.945 277.199 409.031 319.25 371.75 319.25 371.75 268.316 409.875 251.25
405.746 10 0 1 1 1 1 1 1 5
262.25 410.75 262.25 410.75 262.004 413.004 264.246 412.746 266.164 411.785
304.48 406.832 361.25 368.746 361.25 368.746 279.754 414.715 262.25 410.75
10 0.11 0 0 0 0 0 0 5 262.25
410.75 262.25 410.75 262.004 413.004 264.246 412.746 266.164 411.785 304.48
406.832 361.25 368.746 361.25 368.746 279.754 414.715 262.25 410.75 10
0 1 1 1 1 1 1 5 218.25 423.746
218.25 423.746 217.797 425.777 220.246 424.75 221.758 424.016 280.5 421.156
314.25 391.75 314.25 391.75 275.547 418.93 218.25 423.746 10 0.11
0 0 0 0 0 0 5 218.25 423.746 218.25
423.746 217.797 425.777 220.246 424.75 221.758 424.016 280.5 421.156 314.25
391.75 314.25 391.75 275.547 418.93 218.25 423.746 10 0 1
1 1 1 1 1 5 207.25 419.75 207.25 419.75
206.797 421.379 209.246 420.746 210.758 419.617 237.816 415.879 264.246 379.746
264.246 379.746 224.617 420.719 207.25 419.75 10 0.11 0 0
0 0 0 0 5 207.25 419.75 207.25 419.75 206.797
421.379 209.246 420.746 210.758 419.617 237.816 415.879 264.246 379.746 264.246
379.746 224.617 420.719 207.25 419.75 10 0 1 1 1
1 1 1 5 274.25 415.75 274.25 415.75 273.828 418.031
276.246 417.75 278.066 417.125 316.645 414.992 376.246 380.75 376.246 380.75
290.746 418.625 274.25 415.75 10 0.11 0 0 0 0
0 0 5 274.25 415.75 274.25 415.75 273.828 418.031 276.246
417.75 278.066 417.125 316.645 414.992 376.246 380.75 376.246 380.75 290.746
418.625 274.25 415.75 10 0 1 1 1 1 1
1 5 283.25 418.746 283.25 418.742 283.07 420.672 285.25 419.75
287.309 419.762 325.883 417.633 385.25 383.746 385.25 383.742 300.648 421.703
283.25 418.746 10 0.11 0 0 0 0 0 0
5 283.25 418.746 283.25 418.742 283.07 420.672 285.25 419.75 287.309
419.762 325.883 417.633 385.25 383.746 385.25 383.742 300.648 421.703 283.25
418.746 10 0 1 1 1 1 1 1 5
294.25 424.75 294.25 424.75 293.629 426.172 296.25 425.746 297.867 425.262
345.242 420.492 444.246 382.75 444.246 382.75 311.207 427.203 294.25 424.75
10 0.11 0 0 0 0 0 0 5 294.25
424.75 294.25 424.75 293.629 426.172 296.25 425.746 297.867 425.262 345.242
420.492 444.246 382.75 444.246 382.75 311.207 427.203 294.25 424.75 10
0 0 0 0 0 0 0 4 172.25 416.746
172.25 416.742 177.539 417.195 176.246 415.75 174.898 413.676 172.25 414.746
172.25 414.746 172.25 416.746 10 0 0 0 0 0
0 0 4 205.25 401.746 205.25 401.746 211.418 401.797 210.246
399.75 208.777 398.277 206.25 398.746 206.25 398.746 205.25 401.746 10
0 0 0 0 0 0 0 4 196.25 401.746
196.25 401.746 201.738 402.238 200.246 400.75 199.098 398.719 196.25 399.75
196.25 399.75 196.25 401.746 10 0 0 0 0 0
0 0 4 91.25 414.746 91.25 414.746 96.6602 413.344 95.25
411.746 93.0156 410.879 91.25 412.746 91.25 412.746 91.25 414.746 10
0 0 0 0 0 0 0 4 93.2461 425.746
93.2422 425.746 98.8633 423.902 97.25 422.746 95.2148 421.441 93.2461 422.746
93.2461 422.746 93.2461 425.746 10 0 0 0 0 0
0 0 4 85.25 429.746 85.25 429.742 90.9414 428.742 89.2461
427.746 87.2969 426.281 85.25 427.746 85.25 427.746 85.25 429.746 10
0 0.8 0.8 0.8 0.8 0.8 0.8 5 173.25 347.75
173.25 347.75 171.379 347.676 167.25 345.75 164.777 345.477 152.457 341.516
146.25 330.746 146.25 330.742 159.938 341.078 173.25 347.75 10 0
0.8 0.8 0.8 0.8 0.8 0.8 9 269.246 245.746 269.781
245.484 269.84 245.02 270.25 244.75 270.887 244.957 272.242 244.625 272.25
245.746 271.172 250.063 270.211 255.492 265.246 257.746 264.961 257.789 263.375
257.332 263.25 256.746 263.156 254.684 263.027 253.203 263.25 251.75 263.695
250.027 266.07 250.016 267.246 251.75 268.109 249.699 268.582 247.672 269.246
245.746 10 0 0.8 0.8 0.8 0.8 0.8 0.8 9
257.246 240.75 258.262 239.004 258.121 236.961 259.25 236.746 260.492 236.016
262.527 237.09 262.25 238.746 261.188 240.539 260.758 243 259.25 244.75
259.012 245.281 259.277 245.867 259.25 245.746 258.445 247.57 257.188 248.379
255.246 247.746 254.41 245.594 255.676 243.25 257.246 241.75 257.5 241.203
257.316 240.793 257.246 240.75 10 0 0.8 0.8 0.8 0.8
0.8 0.8 11 214.25 246.746 213.758 246.684 213.719 247.191 214.25
247.746 214.484 248.68 215.355 249.914 215.25 250.746 214.602 252.203 213.375
252 212.246 251.75 211.41 250.281 211.355 248.273 210.246 246.746 210.379
246.355 210.438 245.723 210.246 245.746 209.43 244.832 208.945 243.152 209.246
242.75 209.109 242.18 208.91 231.281 209.246 231.75 209.836 232.379 213.188
243.086 213.246 243.75 213.328 244.871 214.133 245.383 214.25 246.746 10
0 0.8 0.8 0.8 0.8 0.8 0.8 7 185.25 253.75
188.574 256.488 191.641 259.746 191.246 263.75 191.027 264.902 189.074 264.32
189.246 263.75 187.988 259.402 185.746 256.477 183.25 253.75 180.504 251.594
178.457 244.617 178.246 243.75 182.266 249.84 184.746 252.859 185.25 253.75
10 0 0.8 0.8 0.8 0.8 0.8 0.8 10 170.246
260.746 171.32 260.707 170.988 261.246 171.246 261.746 172.273 263.215 173.707
264.586 173.25 266.746 173.73 266.805 173.313 267.145 173.25 266.746 172.641
266.695 172.262 266.551 172.25 266.746 169.91 263.715 168.371 260.777 167.25
257.746 166.582 257.289 165.324 252.352 165.246 251.75 165.934 252.133 167.824
256.734 168.25 256.746 169.445 257.613 169.457 259.391 170.246 260.746 10
0 0.8 0.8 0.8 0.8 0.8 0.8 6 189.246 238.746
189.641 239.758 191.371 241.078 191.246 241.75 191.117 243.078 191.633 244.664
190.246 243.75 189.246 242.867 185.453 241.383 185.25 234.746 185.129 234.363
188.398 237.328 189.246 238.746 10 0 0.8 0.8 0.8 0.8
0.8 0.8 19 205.25 257.746 205.477 258.434 206.258 257.91 207.25
257.746 207.473 258.609 208.148 259.223 208.25 259.746 209.535 262.301 211.48
264.305 211.246 266.746 209.996 268.484 209.25 266.238 208.25 264.746 207.102
266.988 206.004 264.926 204.25 264.746 204.496 264.324 204.262 264.707 204.25
264.746 202.887 264.195 202.137 263.004 201.246 261.746 200.852 261.996 200.406
262.195 200.246 261.746 199.527 261.383 198.457 261.027 198.246 260.746 196.93
257.297 193.473 254.992 191.246 246.746 191.816 245.695 196.359 254.004 197.25
254.75 197.816 256.086 197.945 252.945 199.246 253.75 199.406 253.707 199.609
253.445 200.246 253.75 199.973 253.605 200.211 253.855 200.246 253.75 200.637
254.176 200.492 254.789 200.246 254.75 202.074 256.039 201.98 257.215 203.25
258.746 203.344 257.711 204.508 258.5 205.25 257.746 10 0 0.8
0.8 0.8 0.8 0.8 0.8 6 271.25 197.75 271.25 197.75
278.957 220.297 274.25 232.75 274.25 232.75 286.656 208.855 281.25 196.75
281.25 196.75 281.156 207.977 277.246 213.746 277.246 213.746 272.359 199.398
271.25 197.75 10 0 0.8 0.8 0.8 0.8 0.8 0.8
5 254.246 200.75 254.246 200.75 260.477 210.398 251.25 230.75 251.25
230.75 250.797 208.195 243.246 195.746 243.246 195.742 258.937 218.316 254.246
200.75 10 0 0.8 0.8 0.8 0.8 0.8 0.8 5
243.246 202.746 243.246 202.746 243.316 224.918 244.246 227.746 244.246 227.742
239.578 209.957 228.25 199.75 228.25 199.75 244.199 212.598 243.246 202.746
10 0 0.8 0.8 0.8 0.8 0.8 0.8 5 233.246
237.746 233.246 237.746 239.578 223.156 228.25 202.746 228.25 202.746 235.617
216.336 230.25 223.746 230.25 223.746 233.199 227.777 233.246 237.746 10
0 0.8 0.8 0.8 0.8 0.8 0.8 8 212.246 203.746
212.246 203.746 210.758 220.516 212.246 222.75 212.246 222.75 212.957 229.977
212.246 230.75 212.246 230.75 216.918 237.898 217.25 229.75 217.25 229.75
218.68 221.176 222.246 215.746 222.246 215.746 225.719 210.176 225.25 202.746
225.25 202.746 214.5 236.355 212.246 203.746 10 0 0.8 0.8
0.8 0.8 0.8 0.8 5 208.25 233.75 208.25 233.75 200.637
221.836 198.246 200.75 198.246 200.75 197.117 207.758 201.246 223.746 201.246
223.746 205.918 240.535 208.25 233.75 10 0 0.8 0.8 0.8
0.8 0.8 0.8 6 184.25 211.75 184.25 211.75 189.418 217.879
191.246 223.746 191.242 223.746 194.918 240.758 188.246 231.75 188.246 231.75
188.098 222.496 179.246 214.746 179.246 214.746 184.359 216.996 184.25 211.75
10 0 0.8 0.8 0.8 0.8 0.8 0.8 6 177.246
217.746 177.246 217.742 181.277 236.578 182.25 237.746 182.25 237.746 184.137
241.195 181.25 237.746 181.25 237.746 171.379 216.559 167.25 209.75 167.25
209.75 175.777 219.418 177.246 217.746 10 0 0.8 0.8 0.8
0.8 0.8 0.8 4 171.246 235.746 171.246 235.746 183.918 260.336
160.246 231.75 160.246 231.75 172.039 242.738 171.246 235.746 10 0
0.8 0.8 0.8 0.8 0.8 0.8 6 154.246 251.75 154.242
251.75 159.5 272.438 162.25 271.746 162.25 271.746 171.379 282.117 164.246
270.75 164.242 270.75 157.52 259.898 158.25 248.746 158.25 248.746 157.52
259.676 154.246 251.75 10 0 0.8 0.8 0.8 0.8 0.8
0.8 5 517.246 264.746 517.242 264.742 504.348 275.297 501.25 278.75
501.25 278.75 516.449 258.797 516.25 250.746 516.25 250.742 519.199 259.348
517.246 264.746 10 0 0.8 0.8 0.8 0.8 0.8 0.8
5 523.25 288.746 523.25 288.742 500.5 305 496.25 312.75 496.25
312.75 525.797 280.797 526.246 275.746 526.242 275.742 526.348 285.75 523.25
288.746 10 0 0.8 0.8 0.8 0.8 0.8 0.8 5
542.246 457.75 542.246 457.75 529.098 466.699 527.25 464.746 527.25 464.742
539 457.348 542.246 447.746 542.246 447.746 540.098 457.898 542.246 457.75
10 0 0.8 0.8 0.8 0.8 0.8 0.8 4 551.25
369.75 532.25 382.75 532.25 382.75 553.297 363.848 554.25 359.746 551.25
369.75 10 1.1 0 0 0 0 0 0 2
122.246 393.75 146.25 388.75 10 1.1 0 0 0 0
0 0 2 177.246 215.746 177.246 215.746 176.547 219.75 166.246
207.75 10 1.1 0 0 0 0 0 0 2
183.25 210.75 183.25 210.75 185.348 217.547 178.246 212.746 10 1.1
0 0 0 0 0 0 2 242.246 200.75 242.246
200.75 244.199 213.148 231.246 198.75
)! !

!VGTigerDemo class methodsFor: 'private' stamp: ''!
commands
" VGTigerDemo commands 
"
	| pt str |
	
	pt := 1.
	
	str := String new: self tigerCommandCount.
	
	"merge everything into a single string"
	self tigerCommands do: [:sub |

		0 to: sub size-1 do: [:i |
			str at: pt+i put: (sub at: i+1).
			].
		pt := pt + sub size.	
	].

	^ str! !

!VMWindowDriver commentStamp: 'IgorStasenko 7/30/2014 17:55'!
This driver using a legacy VM functionality which will be removed in future versions,
because it is limited only to a single OS Window, and furthermore, image don't have a direct control over window creation/destruction neither controlling its various attributes and event delivery and handling mechanisms.

This driver is used by image, when it detects there's no other more suitable driver(s) available on currently running platform.!
!VMWindowDriver methodsFor: 'as yet unclassified' stamp: 'RonieSalgado 1/10/2014 15:50'!
createWindowWithAttributes: attributes osWindow: osWindow
	^ OSVMWindowHandle new initWithAttributes: attributes; osWindow: osWindow; yourself! !

!VMWindowDriver class methodsFor: 'primitives' stamp: 'RonieSalgado 1/15/2014 15:26'!
primitiveScreenDepth
	<primitive: #primitiveScreenDepth>
	^ nil ! !

!VMWindowDriver class methodsFor: 'testing' stamp: 'RonieSalgado 1/15/2014 14:48'!
isSuitable
	"It is never suitable, because we wanna get rid of it"
	^ false! !

!VMWindowDriver class methodsFor: 'testing' stamp: 'RonieSalgado 1/15/2014 15:26'!
isSupported 
	^ self primitiveScreenDepth notNil! !

!VSBrowseConfigurationCommand commentStamp: '<historical>'!
Browse the configuration class.!
!VSBrowseConfigurationCommand methodsFor: 'accessing' stamp: 'AlexandreBergel 4/15/2011 09:26'!
title
	^ 'browse configuration'! !

!VSBrowseConfigurationCommand methodsFor: 'execute' stamp: 'dkh 4/7/2011 00:29'!
execute
	self configurationClass browse! !

!VSBrowseVersionCommand commentStamp: '<historical>'!
Open a browser on the selected version of a configuration.
The receiver is a aCompiledMethod.!
!VSBrowseVersionCommand methodsFor: 'accessing' stamp: 'ChristopheDemarey 10/24/2013 18:03'!
title
	^ 'browse version'! !

!VSBrowseVersionCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 8/28/2013 17:47'!
execute
	"I expect that target is an MCVersion"
	| cm |
	cm := MetacelloToolBox compiledMethodForVersion: target.
	Smalltalk tools browser 
			fullOnClass: cm methodClass
			selector:  cm selector! !

!VSCatalogAdderCommand commentStamp: 'ChristopheDemarey 2/14/2014 17:53'!
A VSCatalogAdderCommand adds methods to ConfigurationOf class to declare catalog metadata.

!
!VSCatalogAdderCommand methodsFor: 'metadata methods defintion' stamp: 'ChristopheDemarey 2/14/2014 17:58'!
defineKeywordsTemplate

	self configurationClass 
		compile: 'catalogKeywords
	"Returns an array of symbols"
	^ #(web fun) ' 
		classified: 'catalog'! !

!VSCatalogAdderCommand methodsFor: 'testing' stamp: 'ChristopheDemarey 2/14/2014 18:06'!
ensureChangeLog
	^ self hasChangeLog 
		ifFalse: [ self defineChangeLogTemplate ]! !

!VSCatalogAdderCommand methodsFor: 'testing' stamp: 'ChristopheDemarey 2/14/2014 17:59'!
hasChangeLog

	^ (self configurationClass includesSelector: #catalogChangeLog) ! !

!VSCatalogAdderCommand methodsFor: 'testing' stamp: 'ChristopheDemarey 2/14/2014 17:59'!
hasContactInfo

	^ (self configurationClass includesSelector: #catalogContactInfo) ! !

!VSCatalogAdderCommand methodsFor: 'testing' stamp: 'StephaneDucasse 2/10/2014 22:03'!
ensureContactInfo

	^ self hasContactInfo 
		ifFalse: [ self defineContactInfoTemplate ]! !

!VSCatalogAdderCommand methodsFor: 'testing' stamp: 'StephaneDucasse 2/10/2014 21:30'!
ensureKeywords

	^ self hasKeywords 
		ifFalse: [ self defineKeywordsTemplate ]! !

!VSCatalogAdderCommand methodsFor: 'testing' stamp: 'ChristopheDemarey 2/14/2014 17:59'!
hasCatalogDescription

	^ (self configurationClass includesSelector: #catalogDescription) ! !

!VSCatalogAdderCommand methodsFor: 'accessing' stamp: 'ChristopheDemarey 2/17/2014 14:52'!
title
	^ 'add catalog methods'! !

!VSCatalogAdderCommand methodsFor: 'testing' stamp: 'StephaneDucasse 2/10/2014 22:13'!
ensureCatalogDescription

	^ self hasCatalogDescription 
		ifFalse: [ self defineCatalogDescriptionTemplate ]! !

!VSCatalogAdderCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 2/14/2014 17:55'!
execute
	self 
		ensureChangeLog;
		ensureCatalogDescription ;
		ensureContactInfo ;
		ensureKeyClasses ;
		ensureKeywords ! !

!VSCatalogAdderCommand methodsFor: 'metadata methods defintion' stamp: 'ChristopheDemarey 2/14/2014 17:58'!
defineContactInfoTemplate

	self configurationClass 
		compile: 'catalogContactInfo
	"Returns a paragraph describing contact information such as email, mailing lists and website."
	^ ''MyProject is an amazing project . You can get in contact with our great MyProject programmer at myProject@gmail.com'''
		classified: 'catalog'! !

!VSCatalogAdderCommand methodsFor: 'testing' stamp: 'StephaneDucasse 2/10/2014 22:22'!
ensureKeyClasses

	^ self hasKeyClasses
		ifFalse: [ self defineKeyClassesTemplate ]! !

!VSCatalogAdderCommand methodsFor: 'metadata methods defintion' stamp: 'ChristopheDemarey 2/14/2014 17:58'!
defineCatalogDescriptionTemplate

	self configurationClass 
		compile: 'catalogDescription
	"Returns a paragraph describing the project"
	^ ''MyProject is an amazing project that will change your life.'''
		classified: 'catalog'! !

!VSCatalogAdderCommand methodsFor: 'testing' stamp: 'ChristopheDemarey 2/14/2014 17:59'!
hasKeyClasses

	^ (self configurationClass includesSelector: #catalogKeyClassesAndExample) ! !

!VSCatalogAdderCommand methodsFor: 'testing' stamp: 'ChristopheDemarey 2/14/2014 18:00'!
hasKeywords

	^ (self configurationClass includesSelector: #catalogKeywords) ! !

!VSCatalogAdderCommand methodsFor: 'metadata methods defintion' stamp: 'ChristopheDemarey 2/14/2014 17:58'!
defineChangeLogTemplate

	self configurationClass 
		compile: 'catalogChangeLog
	"Returns a paragraph describing the most important changes in the configuration class."
	^ ''- Version number - Date - topics
[[[
	ConfigurationOfXXX project version: ''''xx'''' ) load					
]]]
or simply
- Version number - Date - topics
- Version number - Date - topics
- Version number - Date - topics.'''
		classified: 'catalog'! !

!VSCatalogAdderCommand methodsFor: 'metadata methods defintion' stamp: 'ChristopheDemarey 2/14/2014 17:58'!
defineKeyClassesTemplate

	self configurationClass 
		compile: 'catalogKeyClassesAndExample
	"Returns a paragraph or more describing the key classes of your project. You can use Pillar/Pier syntax to layout out the text i.e., ==Code== and - for bullet."
	^ ''MyProject is composed of one cool key class named ==MyProject==. There is also ==MyKeyHelper==
- ==MyProject== is the responsible for many cool aspects.
- ==MyKeyHelper== is helping ==MyProject=='''
		classified: 'catalog'! !

!VSCommand commentStamp: '<historical>'!
VSCommand is a command design pattern for capturing actions.!
!VSCommand methodsFor: 'ui' stamp: 'ChristopheDemarey 9/17/2013 11:48'!
showExecuteWhile: aBlock

	^Cursor execute showWhile:  aBlock! !

!VSCommand methodsFor: 'repositories' stamp: 'ChristopheDemarey 9/17/2013 15:47'!
chooseRepositoryFromList: repositories
	repositories size > 1
		ifTrue: [ 
			^ UIManager default
				chooseFrom: (repositories collect: [ :repository | repository description ])
				values: repositories
				title: 'Select repository' ].
	^ repositories first! !

!VSCommand methodsFor: 'accessing' stamp: 'ChristopheDemarey 8/28/2013 15:03'!
requestor
	^ requestor! !

!VSCommand methodsFor: 'repositories' stamp: 'ChristopheDemarey 8/28/2013 17:31'!
repositoryOfPackageNamed: packageName
	"Return the repository of the package given as parameter. Create one (using UI) if necessary"

	| mcPackage workingCopy repositories repository repositoryIndex |
	mcPackage := MCPackage named: packageName.
	workingCopy := mcPackage workingCopy.
	repositories := workingCopy repositoryGroup repositories reject: [ :rep | rep == MCCacheRepository default ].
	repositories
		ifEmpty: [ repository := NautilusMonticello new newRepository.
				   workingCopy repositoryGroup addRepository: repository. ].
	repositories size > 1
		ifTrue: [ 
			repositoryIndex := self uiManager chooseFrom: (repositories collect: #printString).
			repositoryIndex = 0
				ifTrue: [ ^ nil ].
			repository := repositories at: repositoryIndex ].
	repositories size = 1
		ifTrue: [ repository := repositories first ].
	^ repository! !

!VSCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 8/28/2013 15:02'!
execute
	self subclassResponsibility ! !

!VSCommand methodsFor: 'accessing' stamp: 'ChristopheDemarey 8/28/2013 15:03'!
requestor: anObject
	requestor := anObject! !

!VSCommand methodsFor: 'ordering' stamp: 'ChristopheDemarey 9/17/2013 15:12'!
order
	^ self title! !

!VSCommand methodsFor: 'accessing' stamp: 'ChristopheDemarey 8/28/2013 15:03'!
target
	^ target! !

!VSCommand methodsFor: 'accessing' stamp: 'ChristopheDemarey 8/28/2013 17:33'!
target: aConfigurationClass
	target := aConfigurationClass! !

!VSCommand class methodsFor: 'instance creation' stamp: 'ChristopheDemarey 8/28/2013 15:11'!
target: target for: requestor
	^ self new
		target: target;
		requestor: requestor;
		yourself! !

!VSConfigurationCommand commentStamp: '<historical>'!
A command that apply to a project configuration.!
!VSConfigurationCommand methodsFor: 'accessing' stamp: 'ChristopheDemarey 2/7/2014 09:54'!
configurationClass
	^ target configurationClass! !

!VSConfigurationValidationIssuesDisplayCommand commentStamp: 'ChristopheDemarey 3/17/2014 11:07'!
Display errors found in a configuration validation.
!
!VSConfigurationValidationIssuesDisplayCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 3/17/2014 11:25'!
execute
	| list |

	list := ListModel new.
	list openWithSpec.
	list title: target messageText.
	list items: target issues.! !

!VSDetailsLeafNode commentStamp: 'ChristopheDemarey 2/21/2014 17:41'!
A VSDetailsLeafNode is used to display dependencies requirements or project loads in a tree.!
!VSDetailsLeafNode methodsFor: 'accessing' stamp: 'ChristopheDemarey 6/20/2013 22:52'!
icon
	^  Smalltalk ui icons iconNamed: #forwardIcon! !

!VSDevCycleCommand commentStamp: '<historical>'!
Versionnner commands related to the development workflow.!
!VSDevCycleCommand methodsFor: 'private' stamp: 'ChristopheDemarey 3/28/2014 10:54'!
createDevelopmentVersion
	| workflow newDevVersionString |
	
	workflow := target.
	newDevVersionString := UIManager default
		request: 'No development version found!! (must be a baseline)' , Character cr asString ,
					'Version number for the next development version'
		initialAnswer: 1.0
		title: 'Create a development version'.
	newDevVersionString ifNotNil: [ newDevVersionString := workflow standardizeDevVersionString: newDevVersionString.
									workflow createNextDevelopment: newDevVersionString ]! !

!VSDevCycleCommand methodsFor: 'checking' stamp: 'ChristopheDemarey 3/18/2014 14:25'!
ensureDevelopmentVersionIsBaseline
	|  workflow devVersion |

	workflow := target.	
	devVersion := workflow developmentVersion.
	(devVersion blessing = #baseline) ifFalse: [ self createDevelopmentVersion ]! !

!VSDevCycleCommand methodsFor: 'checking' stamp: 'ChristopheDemarey 3/18/2014 14:25'!
ensureDevelopmentVersionExists
	|  workflow |

	workflow := target.	
	[ workflow developmentVersion ]
		on: MetacelloVersionDoesNotExistError
		do: [ self createDevelopmentVersion ]! !

!VSGroupLeafNode commentStamp: '<historical>'!
Abstract class used to display a group with its specific icons and no child in a tree.!
!VSGroupLeafNode methodsFor: 'accessing' stamp: 'ChristopheDemarey 11/20/2013 14:27'!
children
	^ [ #() ]
! !

!VSGroupLeafNode methodsFor: 'testing' stamp: 'ChristopheDemarey 3/27/2014 16:09'!
hasChildren
	^ false! !

!VSGroupNode commentStamp: '<historical>'!
Abstract class used to display groups in a tree.!
!VSGroupNode methodsFor: 'accessing' stamp: 'ChristopheDemarey 11/20/2013 14:27'!
children
	^ [ self content dependencies ]! !

!VSGroupNode methodsFor: 'accessing' stamp: 'ChristopheDemarey 3/28/2014 16:05'!
childNodeClassFor: anItem
	"Use a specific wrapper node to display different icons."
	
	^ (self content project dependencyNamed: anItem) 
		ifNil: [ VSGroupLeafNode] "can be nil for 'default' or 'ALL'"
		ifNotNilDo: [ :dependency | dependency treeNodeClass ]! !

!VSGroupNode methodsFor: 'testing' stamp: 'ChristopheDemarey 3/27/2014 16:08'!
hasChildren
	^ self content dependencies isNotEmpty! !

!VSGroupNode methodsFor: 'accessing' stamp: 'ChristopheDemarey 6/20/2013 16:22'!
icon
	^  Smalltalk ui icons iconNamed: #groupIcon! !

!VSLoadCommand commentStamp: '<historical>'!
Load into your image the selected version or baseline. If you already have a version installed, then it will be simply overriden!
!VSLoadCommand methodsFor: 'accessing' stamp: 'dkh 3/20/2011 16:15'!
title
	^ 'load version'! !

!VSLoadCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 10/24/2013 17:52'!
execute
	| answer |
	answer := UIManager default 
				confirm: 'Are you sure you want to load ', target name.
	answer ifTrue: 
		[ target version load: target version defaultPackageNamesToLoad ]! !

!VSLoadProjectCommand commentStamp: '<historical>'!
Load a project configuration into the image. The project should have a configuration class. It will always load the latest version of the configuration package.!
!VSLoadProjectCommand methodsFor: 'accessing' stamp: 'ChristopheDemarey 9/18/2013 11:52'!
configurationNameForProject: aProjectName
	^ 'ConfigurationOf', aProjectName! !

!VSLoadProjectCommand methodsFor: 'accessing' stamp: 'ChristopheDemarey 9/18/2013 11:50'!
askProjectName
	^ UIManager default request: 'Enter a project name'! !

!VSLoadProjectCommand methodsFor: 'accessing' stamp: 'AlexandreBergel 5/18/2011 19:05'!
title
	^ 'load project'! !

!VSLoadProjectCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 9/18/2013 16:18'!
execute
	| mcRepository projectName configurationName  |
	mcRepository := NautilusMonticello new newRepository.
	(mcRepository isNil or: [ mcRepository location isEmpty ])
		ifTrue: [ ^ self ].

	projectName := ([ mcRepository project ]
		on: Error
		do: [ UIManager default request: 'Enter the name of the project to load' ]) value.
	(projectName isNil or: [ projectName isEmpty ]) ifTrue: [ ^ self ].
	
	configurationName := self configurationNameForProject: projectName.
	[ Gofer new
		url: mcRepository location;
		package: configurationName;
		load ]
		on: Error
		do: [ :ex | 
			self inform: 'Cannot find the repository or the configuration. Please check'.
			^ self ].! !

!VSOpenRepositoryCommand commentStamp: '<historical>'!
Open an inspector on the remote repository.!
!VSOpenRepositoryCommand methodsFor: 'accessing' stamp: 'dkh 03/12/2011 02:36'!
title
	^ 'open repository'! !

!VSOpenRepositoryCommand methodsFor: 'accessing' stamp: 'ChristopheDemarey 9/17/2013 18:23'!
repository
	^ (target repositories) 
		ifNil: [ nil ]
		ifNotNilDo: [ :repos |self chooseRepositoryFromList: repos ]
! !

!VSOpenRepositoryCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 9/17/2013 18:24'!
execute
	self repository 
		ifNil: [ UIManager default inform: 'No repository associated to this configuration' ]
		ifNotNilDo: [ :repository | repository morphicOpen ]! !

!VSPackageLeafNode commentStamp: '<historical>'!
Abstract class used to display a package with its specific icons and no child in a tree.!
!VSPackageLeafNode methodsFor: 'accessing' stamp: 'ChristopheDemarey 11/20/2013 14:28'!
children
	^ [ #() ]
! !

!VSPackageLeafNode methodsFor: 'testing' stamp: 'ChristopheDemarey 3/27/2014 16:10'!
hasChildren
	^ false! !

!VSPackageNode commentStamp: '<historical>'!
Class used to display packages in a tree.!
!VSPackageNode methodsFor: 'accessing' stamp: 'ChristopheDemarey 8/27/2013 16:31'!
textMorph
	^ self theme newTextIn: World text: self item asString! !

!VSPackageNode methodsFor: 'accessing' stamp: 'ChristopheDemarey 11/20/2013 14:28'!
children
	^ [ self content dependencies collect: [ :each | 'requires: ' , each] ]! !

!VSPackageNode methodsFor: 'accessing' stamp: 'ChristopheDemarey 2/21/2014 17:41'!
childNodeClassFor: anItem
	^ VSDetailsLeafNode! !

!VSPackageNode methodsFor: 'testing' stamp: 'ChristopheDemarey 3/27/2014 16:07'!
hasChildren
	^ self content dependencies isNotEmpty! !

!VSPackageNode methodsFor: 'accessing' stamp: 'ChristopheDemarey 6/20/2013 16:16'!
icon
	^  Smalltalk ui icons iconNamed: #packageColoredIcon! !

!VSProjectLeafNode commentStamp: '<historical>'!
Abstract class used to display a project with its specific icons and no child in a tree.!
!VSProjectLeafNode methodsFor: 'accessing' stamp: 'ChristopheDemarey 11/20/2013 14:28'!
children
	^ [ #() ]
! !

!VSProjectLeafNode methodsFor: 'testing' stamp: 'ChristopheDemarey 3/27/2014 16:11'!
hasChildren
	^ false! !

!VSProjectNode commentStamp: '<historical>'!
Class used to display projects with specific icons and no child in a tree.!
!VSProjectNode methodsFor: 'accessing' stamp: 'ChristopheDemarey 2/21/2014 17:32'!
children
	^ [ self content dependencies collect: [ :each | 'loads: ' , each] ]! !

!VSProjectNode methodsFor: 'accessing' stamp: 'ChristopheDemarey 2/21/2014 17:41'!
childNodeClassFor: anItem
	^ VSDetailsLeafNode! !

!VSProjectNode methodsFor: 'testing' stamp: 'ChristopheDemarey 3/27/2014 16:08'!
hasChildren
	^ self content dependencies isNotEmpty! !

!VSProjectNode methodsFor: 'accessing' stamp: 'TorstenBergmann 2/12/2014 17:41'!
icon
	 
	^ VersionnerSpecBrowser configurationLoadedIcon! !

!VSReleaseDevelopmentVersionCommand commentStamp: '<historical>'!
Turn the version into a release. It therefore appears as #stable afterward".
!
!VSReleaseDevelopmentVersionCommand methodsFor: 'accessing' stamp: 'ChristopheDemarey 2/6/2014 13:09'!
title
	^ 'release from development version'! !

!VSReleaseDevelopmentVersionCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 3/18/2014 14:27'!
execute
	| message workflow devVersion releaseDialog |
	"message := self uiManager multilineRequest: 'Enter commit message' initialAnswer: ''.
	message == nil
		ifTrue: [ ^ self ]."
		
	workflow := target.
	[ devVersion := workflow developmentVersion ]
		on: MetacelloVersionDoesNotExistError
		do: [ UIManager default inform: 'Cannot find a development version for this project!!'.
			^ self ].
	self ensureDevelopmentVersionIsBaseline.
	(releaseDialog := VersionnerReleasePanel openForVersion: devVersion)
		okAction: [ self release:  releaseDialog model releaseNumberText
						andSolveSymbolic: releaseDialog model isSymbolicVersionResolutionChecked ].! !

!VSReleaseDevelopmentVersionCommand methodsFor: 'actions' stamp: 'ChristopheDemarey 3/28/2014 14:33'!
release: releaseVersionString andSolveSymbolic: needsSymbolicVersionResolution
	| workflow |
	
	workflow := target.
	releaseVersionString 
		ifNil: [	UIManager default inform: 'Release aborted!! Specify a valid release version string.'.
				^ self ].

	[ workflow releaseDevelopment: releaseVersionString.
	  needsSymbolicVersionResolution
		ifTrue: [ self resolveSymbolicVersionsIn: (self mcVersionFor: releaseVersionString) ] ]
	on: MetacelloValidationFailure 
	do: [ :error | (VSConfigurationValidationIssuesDisplayCommand target: error for: self) execute]! !

!VSReleaseDevelopmentVersionCommand methodsFor: 'actions' stamp: 'ChristopheDemarey 3/18/2014 11:34'!
projectReference: projectName configurationFrom: aMCVersion 
	| fullProjectSpec |

	fullProjectSpec := (aMCVersion spec packageNamed: projectName) projectReference.
	^ fullProjectSpec projectClassProject! !

!VSReleaseDevelopmentVersionCommand methodsFor: 'actions' stamp: 'ChristopheDemarey 3/18/2014 10:14'!
mcVersionFor: aVersionString
	| config workflow |
	
	workflow := target.
	config := workflow project configurationClass.
	^ config project version: aVersionString! !

!VSReleaseDevelopmentVersionCommand methodsFor: 'actions' stamp: 'ChristopheDemarey 3/18/2014 13:49'!
baselineFor: aVersion
	"Return the baseline on which this version relies on"
	| baselineVersionString |
	
	baselineVersionString := aVersion importedVersions at: 1.
	^ aVersion project version: baselineVersionString! !

!VSReleaseDevelopmentVersionCommand methodsFor: 'actions' stamp: 'ChristopheDemarey 3/18/2014 14:05'!
resolveSymbolicVersionsIn: aVersion
	| metacelloToolBox | 
	
	metacelloToolBox := MetacelloToolBox new.
	metacelloToolBox project: aVersion project.
	
	metacelloToolBox
		modifyVersionMethodForVersion: aVersion versionString
		versionSpecsDo: [  :attribute :versionSpec |
			versionSpec 
				specListProjectDo: [ :spec | | projectRef projectRefConfiguration resolvedVersion |
					projectRef := spec projectReference.
					projectRefConfiguration := self 
						projectReference: projectRef name
						configurationFrom: (self baselineFor: aVersion).
					resolvedVersion := (projectRefConfiguration version: projectRef versionString) versionNumber.
					projectRef versionString: resolvedVersion ]
				packageDo: [ :spec ]
				groupDo: [ :spec ].
			true ].
	metacelloToolBox commitMethod! !

!VSReleaseDevelopmentVersionCommandTest methodsFor: 'test data' stamp: 'PabloHerrero 1/8/2015 03:59'!
generateTestVersion
	| ast |

	ast := (project configurationClass methodNamed: #version101:) ast.
	ast selector: #testVersion:.
	(ast pragmas at: 1) arguments at: #1 put: (RBLiteralValueNode value: '3.0').
	project configurationClass compile: ast formattedCode! !

!VSReleaseDevelopmentVersionCommandTest methodsFor: 'tests' stamp: 'ChristopheDemarey 3/18/2014 17:00'!
testResolveSymbolicVersionsIn
	| initialVersion configurationClass |
	
	self generateTestVersion.
	configurationClass := Smalltalk globals at: #ConfigurationOfVersionnerTestXMLParser.
	initialVersion := configurationClass project version: '3.0'.
	[ cmd resolveSymbolicVersionsIn: initialVersion ]
		on: MetacelloCannotUpdateReleasedVersionError 
		do: [ :e ].
	self 
		assert: (configurationClass methodNamed: #testVersion:) sourceCode
		equals: self expectedTestResolveSymbolicVersionInResult.! !

!VSReleaseDevelopmentVersionCommandTest methodsFor: 'tests' stamp: 'ChristopheDemarey 3/18/2014 16:44'!
testProjectReferenceConfigurationFrom
	| config |
	
	config := cmd 
		projectReference: 'XMLWriter'
		configurationFrom: project devWorkflow developmentVersion.
	self 
		assert: config class
		equals: MetacelloMCProject.
	self 
		assert: config configuration class
		equals: ConfigurationOfVersionnerTestXMLWriter! !

!VSReleaseDevelopmentVersionCommandTest methodsFor: 'expected results' stamp: 'ChristopheDemarey 3/18/2014 17:03'!
expectedTestResolveSymbolicVersionInResult
	^ 'testVersion: spec
	<version: ''3.0'' imports: #(''1.0-baseline'')>
	spec
		for: #common
		do: [ 
			spec blessing: #release.
			spec
				package: ''VersionnerTestXML-Parser'' with: ''VersionnerTestXML-Parser-StephaneDucasse.142'';
				package: ''VersionnerTestXML-Tests-Parser'' with: ''VersionnerTestXML-Tests-Parser-StephaneDucasse.15'' ]'! !

!VSReleaseDevelopmentVersionCommandTest methodsFor: 'running' stamp: 'MaxLeske 11/2/2014 16:45'!
tearDown
	super tearDown.
	ASTCache reset.
	classFactory cleanUp! !

!VSReleaseDevelopmentVersionCommandTest methodsFor: 'running' stamp: 'ChristopheDemarey 3/18/2014 16:44'!
setUp
	| visitor config version |
	super setUp.
	classFactory := ClassFactoryForTestCase new.
	
	visitor := MCModel2MTModelVisitor new.
	classFactory duplicateClass: ConfigurationOfVersionnerTestXMLParserTemplate withNewName: 'ConfigurationOfVersionnerTestXMLParser'.
	config := (Smalltalk globals at: #ConfigurationOfVersionnerTestXMLParser).
	version := config project version: '1.1'.
	project := visitor visitConfiguration: config withVersion: version.

	cmd := VSReleaseDevelopmentVersionCommand 
				target: project
				devWorkflow for: self.! !

!VSRemoveCommand commentStamp: '<historical>'!
Remove from the configuration the selected version or baseline!
!VSRemoveCommand methodsFor: 'accessing' stamp: 'dkh 3/20/2011 16:16'!
title
	^ 'remove version'! !

!VSRemoveCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 3/28/2014 14:39'!
execute
	"Remove from the configuration class what is selected in the versions panel list"

	| answer imported |
	imported := Set new.
	self configurationClass project versions do: [ :version | imported addAll: version importedVersions ].
	(imported includes: target versionString)
		ifTrue: [ 
			^ UIManager default
				inform:
					'The version ' , target printString
						, ' is imported by another version. You must remove the import reference before you can remove this version.' ].
	answer := UIManager default
		confirm: 'Are you sure you want to remove ' , target printString , ' from ' , self configurationClass name , '?'.
	answer
		ifTrue: [ 
			| cm |
			self configurationClass project symbolicVersionSymbols
				do: [ :symbolicVersion | 
						[ (MetacelloToolBox configurationNamed: self configurationClass name asString)
							modifySymbolicVersionMethodFor: symbolicVersion
								symbolicVersionSpecsDo: [ :symbolicVersionSpec | 
									symbolicVersionSpec versionString = target versionString
										ifTrue: [ symbolicVersionSpec versionString: #notDefined ].
									true ];
						commitMethod ]
					on: MetacelloValidationFailure 
					do: [ :error | "ignore" ] ].
			cm := MetacelloToolBox compiledMethodForVersion: target version.
			cm methodClass removeSelector: cm selector ]! !

!VSSaveProjectCommand commentStamp: '<historical>'!
A command to save all dirty packages of a project, including the configuration.!
!VSSaveProjectCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 3/19/2015 16:16'!
execute
	| configClassName |
	
	target ifNil: [ self inform: 'Select the version to commit.'.
				^ self ].
	configClassName := self configurationClass name asString.
	(MetacelloToolBox checkForCriticalValidationIssues: configClassName)
		ifEmpty: [ Komitter openAndCommitToMonticelloWorkingCopiesFilteredBy: self filterBlock ] 
		ifNotEmptyDo: [ :errors | self alertValidationErrors: errors for: configClassName ]
		
! !

!VSSaveProjectCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 1/21/2014 17:21'!
alertValidationErrors: errors for: configClassName
	| message |
	
	message :=  'There are critical issues in configuration ' , configClassName printString, '. Configuration not saved!!' , Character cr asString.
	errors do: [ :error |
		 message := message , Character cr asString, error asString ]. 
	UIManager default 
		alert: message
		title: 'Critical Issues'! !

!VSSaveProjectCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 1/13/2014 16:57'!
filterBlock
	| project packageNames |
	
	project := target.
	packageNames := project packages collect: [ :package | package name ].
	packageNames add: project configurationClass name asString.
	^ [ :workingCopy | packageNames includes: workingCopy package name ]
! !

!VSSetDescriptionCommand commentStamp: '<historical>'!
Set the description on the selected development version!
!VSSetDescriptionCommand methodsFor: 'accessing' stamp: 'dkh 3/2/2011 19:55'!
title
	^ 'set description'! !

!VSSetDescriptionCommand methodsFor: 'execute' stamp: 'AlexandreBergel 4/15/2011 10:29'!
executeWithMessage: message
	| toolbox updatedSpecs |
	toolbox := MetacelloToolBox configurationNamed: target configurationBasename.
	toolbox
		updateVersionMethodForVersion: target version versionString
		updateProjects: false
		updatePackages: false
		versionSpecsDo: [ :attribute :versionSpec | 
			attribute == #common
				ifTrue: [ 
					"update the author, description and timeStamp"
					versionSpec
						author: MetacelloPlatform current authorName;
						timestamp: MetacelloPlatform current timestamp.
					MetacelloToolBox appendDescription: message to: versionSpec ].
			true ].
	toolbox commitMethod
! !

!VSSetDescriptionCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 11/21/2013 14:11'!
execute
	|  message |
	message := UIManager default 
					multilineRequest: 'Enter description' initialAnswer: ''.
	(message isNil or: [ message isEmpty ])
		ifTrue: [ ^ self ].
	self executeWithMessage: message! !

!VSUnloadConfigurationCommand commentStamp: '<historical>'!
Unload the package with the selected configuration.!
!VSUnloadConfigurationCommand methodsFor: 'accessing' stamp: 'dkh 2/27/2011 23:26'!
title
	^ 'unload'! !

!VSUnloadConfigurationCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 2/14/2014 18:03'!
execute
	| answer |
	answer := UIManager default confirm: 'Are you sure you want to unload ' , target name.
	answer
		ifTrue: [ target workingCopy unload ]! !

!VSUpdateDevelopmentVersionCommand commentStamp: 'ChristopheDemarey 2/6/2014 13:29'!
Update the current development version with infomation provided by the project.
!
!VSUpdateDevelopmentVersionCommand methodsFor: 'accessing' stamp: 'ChristopheDemarey 2/6/2014 13:29'!
title
	^ 'Update development version'! !

!VSUpdateDevelopmentVersionCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 3/27/2014 18:07'!
execute
	|  workflow |

	workflow := target.	
	self ensureDevelopmentVersionExists.
	self ensureDevelopmentVersionIsBaseline.
	
	workflow updateDevelopment
! !

!VSUpdateFromItsRepositoryCommand commentStamp: '<historical>'!
Update the configuration from the version contained in its repository.!
!VSUpdateFromItsRepositoryCommand methodsFor: 'accessing' stamp: 'fds 2/27/2011 10:48'!
title
	^ 'update from its repository'! !

!VSUpdateFromItsRepositoryCommand methodsFor: 'execute' stamp: 'dkh 3/2/2011 16:50'!
execute
	"use the Metacello api"

	target project updateProject.
	! !

!VSValidateConfigurationCommand commentStamp: '<historical>'!
This command allows you to check inconsistencies in a Configuration class.!
!VSValidateConfigurationCommand methodsFor: 'accessing' stamp: 'fds 2/27/2011 10:49'!
title
	^ 'validate'! !

!VSValidateConfigurationCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 2/7/2014 14:19'!
execute

	| result |
	result := self validate.
	result ifEmpty: [ UIManager default inform: 'The configuration is correctly defined'. ^ self ].

	UIManager default inform: 'Issues were found'.
	result := result collect: [ :each | each explanation ].
	result explore! !

!VSValidateConfigurationCommand methodsFor: 'execute' stamp: 'ChristopheDemarey 10/18/2012 11:44'!
validate
	self showExecuteWhile: [ ^ target validateFull ]! !

!VSValidateConfigurationCommandTest methodsFor: 'tests' stamp: 'ChristopheDemarey 11/21/2013 14:05'!
testExecute
	self
		should: [ (VSValidateConfigurationCommand target: (MBConfigurationInfo configurationClass: configuration) for: nil) execute ]
		raise: MetacelloStackCacheNotification! !

!VSVersionCommand commentStamp: '<historical>'!
A command that apply to a project version.!
!VSVersionCommand methodsFor: 'accessing' stamp: 'ChristopheDemarey 10/25/2013 18:20'!
configurationClass
	^ target configurationClass! !

!VSVersionMorph commentStamp: '<historical>'!
A MTVersionMorph is morph used to display a Metacello version.
It display the version string and optional tags (dev, stable, etc.)!
!VSVersionMorph methodsFor: 'initialization' stamp: 'ChristopheDemarey 11/20/2013 15:03'!
initialize
	super initialize.	
	tags := OrderedCollection new.
	self 
		changeTableLayout;
		listDirection: #leftToRight;
		vResizing: #shrinkWrap;
		hResizing: #shrinkWrap;
		cellInset: 3;
		color: Color transparent;
		yourself.
	! !

!VSVersionMorph methodsFor: 'private' stamp: 'ChristopheDemarey 4/2/2014 11:15'!
build	
	version isStable 
		ifTrue: [ self addTag: #stable ].
	version isDevelopment 
		ifTrue: [ self addTag: #development ].	
	self addAllMorphs: tags.
	version isDevelopment
		ifFalse: [  self addMorphFront: version name asMorph ]! !

!VSVersionMorph methodsFor: 'private' stamp: 'ChristopheDemarey 11/20/2013 14:54'!
adoptPaneColor: paneColor
	"We prevent the adoption of the parent color to be sure to be able to control the final rendered color"! !

!VSVersionMorph methodsFor: 'private' stamp: 'ChristopheDemarey 10/22/2013 17:49'!
addTag: aStringOrSymbol
	tags add: (TagMorphFactory newTag: aStringOrSymbol asMorph) morph! !

!VSVersionMorph methodsFor: 'accessing' stamp: 'ChristopheDemarey 10/22/2013 17:46'!
version: anObject
	version := anObject.
	version ifNotNil: [ self build ].! !

!VSVersionMorph class methodsFor: 'instance creation' stamp: 'ChristopheDemarey 10/22/2013 17:10'!
withVersion: anMTVersion
	^ self new 
		version: anMTVersion ;
		yourself.! !

!VTermOutputDriver commentStamp: 'GuillermoPolito 3/4/2015 16:01'!
I convert high-level terminal commands like moving the cursor or setting the color to characters sequences understood by the terminal.

Furthermore I do some bookkeeping to reduce the number of characters sent to the terminal.

Example of usage:

	out := VTermOutputDriver stdout.
	out << 'normal text'.
	out lf.
	'red text' do: [ :c | out color256: Color red. out << c ].
	out lf.
	'bold text' do: [ :c | out bold. out << c ].
	out clear.
	out lf.!
!VTermOutputDriver methodsFor: 'navigating' stamp: 'dfgs 7/8/2012 13:30'!
here
	self flag: #todo. "use termcap here"
	self csiEscape.
	outStream nextPut: $E! !

!VTermOutputDriver methodsFor: 'escaping' stamp: 'dfgs 7/8/2012 13:18'!
escape
	outStream nextPut: Character escape! !

!VTermOutputDriver methodsFor: 'navigating' stamp: 'CamilloBruni 10/4/2011 19:16'!
right: distance
	distance < 0
		ifTrue: [ 0 - distance timesRepeat: [ self left ]]
		ifFalse: [ distance timesRepeat: [ self right ]].! !

!VTermOutputDriver methodsFor: 'highlighting' stamp: 'dfgs 7/8/2012 13:31'!
normal
	self termcap: 'me'! !

!VTermOutputDriver methodsFor: 'inserting' stamp: 'dfgs 7/8/2012 13:30'!
insertCharacter
	self termcap:  'ic'! !

!VTermOutputDriver methodsFor: 'coloring' stamp: 'CamilloBruni 5/31/2010 23:57'!
color: aColor
	currentColor := aColor.
	self colorEscape.! !

!VTermOutputDriver methodsFor: 'navigating' stamp: 'dfgs 7/8/2012 13:19'!
saveCursor
	outStream nextPutAll: (termcap getstr: 'sc')! !

!VTermOutputDriver methodsFor: 'highlighting' stamp: 'dfgs 7/8/2012 13:25'!
bold
	" double bright mode "
	self termcap: 'md'! !

!VTermOutputDriver methodsFor: 'initialization' stamp: 'CamilloBruni 10/19/2012 11:26'!
initialize 
	super initialize.
	termcap := Termcap new.
	self reset.! !

!VTermOutputDriver methodsFor: 'navigating' stamp: 'CamilloBruni 10/4/2011 19:16'!
up: distance
	distance < 0
		ifTrue: [ 0 - distance timesRepeat: [ self down ]]
		ifFalse: [ distance timesRepeat: [ self up ]].! !

!VTermOutputDriver methodsFor: 'coloring' stamp: 'MarcusDenker 9/30/2013 22:49'!
color256: aColor background: isBackground
	"use the resources for colors 0-15 - usually more-or-less a reproduction of the standard ANSI colors, but possibly more pleasing shades

	colors 16-231 are a 6x6x6 color cube

	colors 232-255 are a grayscale ramp, intentionally leaving out black and white"
	
	self csiEscape.

	outStream nextPutAll: (isBackground 
		ifFalse: [ '38;5;' ]
		ifTrue:  [ '48;5;' ]).
		
	outStream 
		print: aColor closestXTermPixelValue;
		nextPut: $m.! !

!VTermOutputDriver methodsFor: 'navigating' stamp: 'dfgs 7/8/2012 13:30'!
home
	self termcap: 'ho'! !

!VTermOutputDriver methodsFor: 'coloring' stamp: 'CamilloBruni 5/31/2010 22:50'!
yellow
	self color: 33.! !

!VTermOutputDriver methodsFor: 'accessing' stamp: 'CamilloBruni 5/31/2010 17:40'!
outStream: stream
	outStream := stream.! !

!VTermOutputDriver methodsFor: 'printing' stamp: 'CamilloBruni 2/3/2013 16:37'!
store: anObject 
	outStream store: anObject! !

!VTermOutputDriver methodsFor: 'writing' stamp: 'dfgs 7/8/2012 13:23'!
overwrite: char
	self flag: #TODO. "properly implement this"
	outStream nextPut: char! !

!VTermOutputDriver methodsFor: 'coloring' stamp: 'CamilloBruni 5/31/2010 22:47'!
green
	self color: 32.! !

!VTermOutputDriver methodsFor: 'mode' stamp: 'dfgs 7/8/2012 13:30'!
insertMode
	self termcap: 'im'! !

!VTermOutputDriver methodsFor: 'coloring' stamp: 'CamilloBruni 5/31/2010 22:52'!
black
	self color: 30.! !

!VTermOutputDriver methodsFor: 'removing' stamp: 'dfgs 7/8/2012 13:26'!
clearScreen
	self termcap: 'cl'! !

!VTermOutputDriver methodsFor: 'cursor' stamp: 'dfgs 7/8/2012 13:27'!
cursorEnhanced
	self termcap: 'vs'! !

!VTermOutputDriver methodsFor: 'writing' stamp: 'CamilloBruni 6/14/2010 18:15'!
echo: aBool
	shouldEcho = aBool ifTrue: [ ^ self ].
	shouldEcho := aBool.
	self enable: #echo.! !

!VTermOutputDriver methodsFor: 'coloring' stamp: 'CamilloBruni 7/1/2012 14:19'!
background256: aColor
	"output an xterm 256 color extension sequence"
	self color256: aColor background: true! !

!VTermOutputDriver methodsFor: 'accessing' stamp: 'dfgs 7/8/2012 14:08'!
termcap
	^ termcap! !

!VTermOutputDriver methodsFor: 'coloring' stamp: 'CamilloBruni 5/31/2010 23:19'!
white: aString
	self white; << aString; flush; clear.! !

!VTermOutputDriver methodsFor: 'escaping' stamp: 'CamilloBruni 10/19/2012 12:47'!
colorEscape
	self csiEscape.
	blink ifTrue: [ outStream nextPutAll: '5;' ].
	outStream print: currentColor.
	(currentBackground == 0) ifFalse: [
		outStream nextPut: $;; print: currentBackground ].
	outStream nextPut: $m.! !

!VTermOutputDriver methodsFor: 'removing' stamp: 'dfgs 7/8/2012 13:26'!
clearFromBeginning
	self termcap: 'cb'! !

!VTermOutputDriver methodsFor: 'coloring' stamp: 'ToonVerwaest 8/16/2010 16:23'!
reset
	currentColor := 0.
	currentBackground := 0.
	light := false.
	blink := false.! !

!VTermOutputDriver methodsFor: 'navigating' stamp: 'dfgs 7/8/2012 13:29'!
down
	self termcap: 'do'! !

!VTermOutputDriver methodsFor: 'coloring' stamp: 'CamilloBruni 5/31/2010 23:18'!
black: aString
	self black; << aString; flush; clear.! !

!VTermOutputDriver methodsFor: 'accessing' stamp: 'ToonVerwaest 8/16/2010 16:09'!
columns
	^ termcap getnum: 'co'! !

!VTermOutputDriver methodsFor: 'navigating' stamp: 'dfgs 7/8/2012 13:31'!
restoreCursor
	self termcap: 'rc'! !

!VTermOutputDriver methodsFor: 'navigating' stamp: 'dfgs 7/8/2012 14:22'!
startOfLine
	^ self cr! !

!VTermOutputDriver methodsFor: 'escaping' stamp: 'dfgs 7/8/2012 13:17'!
csiEscape
	"Control Sequence Introducer escape"
	outStream nextPut: Character escape; nextPut: $[! !

!VTermOutputDriver methodsFor: 'coloring' stamp: 'CamilloBruni 5/31/2010 22:49'!
red
	self color: 31.! !

!VTermOutputDriver methodsFor: 'highlighting' stamp: 'dfgs 7/8/2012 13:26'!
blinking
	self termcap: 'mb'! !

!VTermOutputDriver methodsFor: 'escaping' stamp: 'dfgs 7/8/2012 13:19'!
ss3Escape
	"Control Sequence Introducer escape"
	outStream nextPut: Character escape; nextPut: $O! !

!VTermOutputDriver methodsFor: 'removing' stamp: 'dfgs 7/8/2012 13:27'!
deleteLine
	self termcap: 'dl'! !

!VTermOutputDriver methodsFor: 'coloring' stamp: 'ToonVerwaest 8/17/2010 14:01'!
errorColor 
	self red.
	self reverse! !

!VTermOutputDriver methodsFor: 'inserting' stamp: 'dfgs 7/8/2012 13:30'!
insertLine
	self termcap: 'al'.
	self lf! !

!VTermOutputDriver methodsFor: 'printing' stamp: 'CamilloBruni 2/3/2013 16:36'!
print: anObject 
	outStream print: anObject! !

!VTermOutputDriver methodsFor: 'navigating' stamp: 'dfgs 7/8/2012 13:31'!
left
	self termcap:  'le'! !

!VTermOutputDriver methodsFor: 'accessing' stamp: 'ToonVerwaest 8/16/2010 16:09'!
lines
	^ termcap getnum: 'li'! !

!VTermOutputDriver methodsFor: 'scrolling' stamp: 'dfgs 7/8/2012 13:32'!
scrollBackward
	self termcap: 'sr'! !

!VTermOutputDriver methodsFor: 'scrolling' stamp: 'dfgs 7/8/2012 13:33'!
scrollForward
	self termcap: 'sf'! !

!VTermOutputDriver methodsFor: 'coloring' stamp: 'CamilloBruni 5/31/2010 22:50'!
white
	self color: 37.! !

!VTermOutputDriver methodsFor: 'removing' stamp: 'dfgs 7/8/2012 13:27'!
deleteCharacter
	self termcap: 'dc'! !

!VTermOutputDriver methodsFor: 'coloring' stamp: 'dfgs 7/8/2012 13:18'!
pink: aString
	self pink; nextPutAll: aString; flush; clear.! !

!VTermOutputDriver methodsFor: 'writing' stamp: 'dfgs 7/8/2012 13:24'!
<< aStringOrCharacter
	aStringOrCharacter putOn: outStream.! !

!VTermOutputDriver methodsFor: 'mode' stamp: 'dfgs 7/8/2012 13:29'!
endInsertMode
	self termcap: 'ei'! !

!VTermOutputDriver methodsFor: 'highlighting' stamp: 'dfgs 7/8/2012 13:31'!
invisible
	self termcap: 'mk'! !

!VTermOutputDriver methodsFor: 'accessing' stamp: 'CamilloBruni 5/31/2010 17:40'!
outStream
	^ outStream! !

!VTermOutputDriver methodsFor: 'writing' stamp: 'CamilloBruni 6/14/2010 18:15'!
echo
	self echo: true.! !

!VTermOutputDriver methodsFor: 'coloring' stamp: 'CamilloBruni 5/31/2010 23:19'!
green: aString
	self green; << aString; flush; clear.! !

!VTermOutputDriver methodsFor: 'navigating' stamp: 'dfgs 7/8/2012 13:31'!
right
	self termcap: 'nd'! !

!VTermOutputDriver methodsFor: 'coloring' stamp: 'CamilloBruni 5/31/2010 23:36'!
light
	light := true.! !

!VTermOutputDriver methodsFor: 'printing' stamp: 'abc 10/19/2012 15:24'!
nextPutAll: aString
	outStream nextPutAll: aString! !

!VTermOutputDriver methodsFor: 'coloring' stamp: 'CamilloBruni 5/31/2010 23:19'!
yellow: aString
	self yellow; << aString; flush; clear.! !

!VTermOutputDriver methodsFor: 'cursor' stamp: 'dfgs 7/8/2012 13:27'!
cursorInvisible
	self termcap: 'vi'! !

!VTermOutputDriver methodsFor: 'highlighting' stamp: 'dfgs 7/8/2012 13:31'!
reverse
	self termcap: 'mr'! !

!VTermOutputDriver methodsFor: 'navigating' stamp: 'dfgs 7/8/2012 13:27'!
cr
	self termcap: 'cr'! !

!VTermOutputDriver methodsFor: 'writing' stamp: 'ToonVerwaest 8/6/2010 16:59'!
tab
	outStream tab! !

!VTermOutputDriver methodsFor: 'removing' stamp: 'CamilloBruni 10/19/2012 12:52'!
erase
	"outStream nextPutAll:
		(termcap parm: '1' in:
			(termcap getstr: 'ec'))"
	self shouldBeImplemented.! !

!VTermOutputDriver methodsFor: 'coloring' stamp: 'CamilloBruni 5/31/2010 22:46'!
blue
	self color: 34.! !

!VTermOutputDriver methodsFor: 'accessing' stamp: 'CamilloBruni 6/1/2010 00:06'!
clear
	self reset.
	self colorEscape.! !

!VTermOutputDriver methodsFor: 'coloring' stamp: 'CamilloBruni 10/19/2012 12:49'!
color256: aColor
	"output an xterm 256 color extension sequence."
	self color256: aColor background: false! !

!VTermOutputDriver methodsFor: 'navigating' stamp: 'CamilloBruni 10/5/2011 01:04'!
down: distance
	distance < 0
		ifTrue: [ 0 - distance timesRepeat: [ self up ]]
		ifFalse: [ distance timesRepeat: [ self down ]].! !

!VTermOutputDriver methodsFor: 'writing' stamp: 'ToonVerwaest 8/6/2010 16:51'!
lf
	outStream lf! !

!VTermOutputDriver methodsFor: 'printing' stamp: 'abc 10/19/2012 15:50'!
nextPut: aCharacter 
	outStream nextPut: aCharacter.! !

!VTermOutputDriver methodsFor: 'writing' stamp: 'CamilloBruni 6/14/2010 18:15'!
noEcho
	self echo: false.! !

!VTermOutputDriver methodsFor: 'navigating' stamp: 'dfgs 7/8/2012 13:33'!
topLeft
	self termcap: 'ho'! !

!VTermOutputDriver methodsFor: 'highlighting' stamp: 'dfgs 7/8/2012 13:33'!
underline
	self termcap: 'us'! !

!VTermOutputDriver methodsFor: 'coloring' stamp: 'CamilloBruni 5/31/2010 23:18'!
blue: aString
	self blue; << aString; flush; clear.! !

!VTermOutputDriver methodsFor: 'writing' stamp: 'ToonVerwaest 8/6/2010 16:59'!
space
	outStream space! !

!VTermOutputDriver methodsFor: 'highlighting' stamp: 'dfgs 7/8/2012 13:33'!
underlineOff
	self termcap: 'ue'! !

!VTermOutputDriver methodsFor: 'navigating' stamp: 'dfgs 7/8/2012 13:33'!
up
	self termcap: 'up'! !

!VTermOutputDriver methodsFor: 'accessing' stamp: 'dfgs 7/8/2012 14:04'!
width
	^ self columns! !

!VTermOutputDriver methodsFor: 'coloring' stamp: 'CamilloBruni 5/31/2010 23:19'!
cyan: aString
	self cyan; << aString; flush; clear.! !

!VTermOutputDriver methodsFor: 'cursor' stamp: 'dfgs 7/8/2012 13:27'!
cursorNormal
	self termcap: 've'! !

!VTermOutputDriver methodsFor: 'navigating' stamp: 'CamilloBruni 10/4/2011 19:15'!
left: distance
	distance < 0
		ifTrue: [ 0 - distance timesRepeat: [ self right ]]
		ifFalse: [ distance timesRepeat: [ self left ]].! !

!VTermOutputDriver methodsFor: 'removing' stamp: 'dfgs 7/8/2012 13:26'!
clearToEnd
	self termcap: 'ce'! !

!VTermOutputDriver methodsFor: 'coloring' stamp: 'CamilloBruni 5/31/2010 22:47'!
cyan
	self color: 36.! !

!VTermOutputDriver methodsFor: 'writing' stamp: 'ToonVerwaest 8/6/2010 16:51'!
flush
	outStream flush.! !

!VTermOutputDriver methodsFor: 'coloring' stamp: 'CamilloBruni 5/31/2010 22:48'!
pink
	self color: 35.! !

!VTermOutputDriver methodsFor: 'coloring' stamp: 'dfgs 7/8/2012 13:22'!
red: aString
	self red; << aString; flush; clear.! !

!VTermOutputDriver methodsFor: 'private' stamp: 'dfgs 7/8/2012 14:26'!
termcap: termcapCapabilityIdentifier
	"Output the termcap command sequence for the identifier.
	Use #basicNextPutAll: to avoid possible conversions applied by the stream"
	outStream basicNextPutAll: (termcap getstr: termcapCapabilityIdentifier)! !

!VTermOutputDriver methodsFor: 'removing' stamp: 'dfgs 7/8/2012 13:24'!
backspace
	outStream nextPut: Character backspace.
	self deleteCharacter ! !

!VTermOutputDriver methodsFor: 'testing' stamp: 'CamilloBruni 2/10/2013 14:59'!
closed
	^ outStream isNil or: [ outStream closed ]! !

!VTermOutputDriver class methodsFor: 'instance-creation' stamp: 'CamilloBruni 9/29/2011 18:30'!
on: anOutputStream
	^ self new
		outStream: anOutputStream;
		yourself! !

!VTermOutputDriver class methodsFor: 'instance-creation' stamp: 'CamilloBruni 10/19/2012 12:46'!
stderr
	^ self on: FileStream stderr! !

!VTermOutputDriver class methodsFor: 'examples' stamp: 'PavelKrivanek 11/23/2012 12:26'!
printText: aText
	" Example code shows how to output formatted text"
	| out |

	out := self stdout.

	aText doWithIndex: [ :char :index| 
		aText attributesAt: index do: [ :attr| 
			(attr isKindOf: TextEmphasis )	ifTrue: [ out bold ].
			(attr isKindOf: TextColor )	ifTrue: [ out color256: attr color ]].
		(char = Character cr)
			ifTrue: [ out lf ]
			ifFalse: [ out << char ].
		out clear ].

	out lf.! !

!VTermOutputDriver class methodsFor: 'instance-creation' stamp: 'CamilloBruni 10/19/2012 12:46'!
stdout
	^ self on: FileStream stdout! !

!ValueChanged commentStamp: '<historical>'!
A ValueChanged is an announcement raised when a value of a NewValueHolder is changed!
!ValueChanged methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 17:00'!
newValue: anObject
	
	newValue := anObject! !

!ValueChanged methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 17:01'!
oldValue: anObject
	
	oldValue := anObject! !

!ValueChanged methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 17:01'!
oldValue

	^ oldValue! !

!ValueChanged methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:58'!
newValue

	^ newValue! !

!ValueChanged class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 10/17/2013 17:00'!
newValue: newContents

	^ self new
		newValue: newContents;
		yourself! !

!ValueChanged class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 10/17/2013 17:02'!
oldValue: oldContent newValue: newValue

	^ self new
		newValue: newValue;
		oldValue: oldContent;
		yourself! !

!ValueHolder commentStamp: 'TorstenBergmann 2/4/2014 20:43'!
A value holder holding a value !
!ValueHolder methodsFor: 'accessing' stamp: 'MarcusDenker 7/27/2014 09:03'!
contents: newContents
	contents := newContents.
	self changed: #contents! !

!ValueHolder methodsFor: 'accessing' stamp: 'ls 8/5/1998 07:49'!
contents
	^contents! !

!ValueHolder methodsFor: 'accessing' stamp: ''!
= another

	self species = another species ifFalse: [ ^ false ].
	^ self contents = another contents! !

!ValueLink commentStamp: 'HenrikSperreJohansen 10/18/2009 15:57'!
A ValueLink is a Link containing a Value.
Adding an object to a LinkedList which is not a Link will create a ValueLink containing that object.


value - The object this link points to.!
!ValueLink methodsFor: 'comparing' stamp: 'HenrikSperreJohansen 10/18/2009 15:21'!
hash
	^self value hash bitXor: nextLink identityHash 
! !

!ValueLink methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 10/18/2009 14:55'!
value
	^value ! !

!ValueLink methodsFor: 'comparing' stamp: 'StephaneDucasse 5/26/2010 21:40'!
= anotherObject
	^self species == anotherObject species 
		and: [self value = anotherObject value 
				and: [self nextLink == anotherObject nextLink]]! !

!ValueLink methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 10/18/2009 14:54'!
value: aValue
	value := aValue! !

!ValueLink methodsFor: 'printing' stamp: 'HenrikSperreJohansen 10/19/2009 14:51'!
printOn: aStream
	aStream nextPutAll: 'ValueLink('.
	value printOn: aStream.
	aStream nextPut: $)
! !

!ValueLink class methodsFor: 'instance creation' stamp: 'HenrikSperreJohansen 10/18/2009 15:16'!
value:	 aValue
	^self new value: aValue! !

!ValueNotFound commentStamp: 'SvenVanCaekenberghe 4/19/2011 19:42'!
I am ValueNotFound, an exception indicating that a value was not found in a Dictionary.!
!ValueNotFound methodsFor: 'private' stamp: 'nice 12/2/2011 23:36'!
standardMessageText
	"Generate a standard textual description"
	
	^ String streamContents: [ :stream |
		stream << 'value '.
		stream print: self object.
		stream << ' not found in '.
		stream print: self collection class]! !

!ValueNotFound methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/19/2011 19:42'!
value
	^ self object! !

!ValueNotFound methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/19/2011 19:42'!
value: aValue
	^ self object: aValue! !

!VariableLayout commentStamp: '<historical>'!
I am the default layout for variable sized objects such as Array.

I contain a fixed number of Slots plus.
Instances of classes using this kind of layout have only a minimum given size. Instances have a custom number of additional fields which can be accessed with an index.!
!VariableLayout methodsFor: 'reshaping' stamp: 'ToonVerwaest 4/1/2011 02:55'!
extendAgain: aLayout with: someScope
	| result |
	result := self species new.
	result host: aLayout host.
	aLayout compactClassIndex > 0
		ifTrue: [ result compactClassIndex: aLayout compactClassIndex ].
	result slotScope: someScope.
	^ result! !

!VariableLayout methodsFor: 'testing' stamp: 'ToonVerwaest 4/1/2011 01:26'!
isVariable
	^ true! !

!VariableLayout methodsFor: 'format' stamp: 'ToonVerwaest 4/1/2011 01:27'!
instanceSpecificationBase
	^ 2! !

!VariableLayout class methodsFor: 'instance creation' stamp: 'MartinDias 7/11/2013 16:01'!
extending: superLayout scope: aScope host: aClass
	^ (superLayout extendVariable: aScope)
		host: aClass;
		yourself! !

!VariableNode commentStamp: '<historical>'!
I am a parse tree leaf representing a variable. Note that my name and key are different for pool variables: the key is the Object Reference.!
!VariableNode methodsFor: 'testing' stamp: ''!
isVariableReference

	^true! !

!VariableNode methodsFor: 'testing' stamp: 'ar 11/19/2002 14:58'!
isVariableNode
	^true! !

!VariableNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 18:09'!
sizeCodeForStorePop: encoder
	self shouldNotImplement! !

!VariableNode methodsFor: 'code generation' stamp: 'SeanDeNigris 7/7/2012 21:46'!
sizeCodeForValue: encoder
	self reserve: encoder.
	encoder
		if: code
		isSpecialLiteralForPush:
			[:specialLiteral| "i.e. the pseudo-variables nil true & false"
			 ^encoder sizePushSpecialLiteral: specialLiteral].
	(code = LdSelf or: [code = LdSuper]) ifTrue:
		[^encoder sizePushReceiver].
	code = LdThisContext ifTrue:
		[^encoder sizePushThisContext].
	self flag: 'probably superfluous'.
	^encoder sizePushInstVar: index! !

!VariableNode methodsFor: 'initialize-release' stamp: 'eem 5/14/2008 16:01'!
name: varName key: objRef index: i type: type
	"Only used for initting global (litInd) variables"
	^self name: varName key: objRef code: (self code: (index := i) type: type)! !

!VariableNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 16:41'!
emitCodeForReturn: stack encoder: encoder
	encoder
		if: code
		isSpecialLiteralForReturn:
			[:specialLiteral|
			"short returns"
			 encoder genReturnSpecialLiteral: specialLiteral.
			 stack push: 1 "doesnt seem right".
			 ^self].
	(self code = LdSelf or: [self code = LdSuper]) ifTrue: 
		["short returns"
		 encoder genReturnReceiver.
		 stack push: 1 "doesnt seem right".
		 ^self].
	super emitCodeForReturn: stack encoder: encoder! !

!VariableNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 18:09'!
sizeCodeForStore: encoder
	self shouldNotImplement! !

!VariableNode methodsFor: 'visiting' stamp: 'eem 9/6/2009 12:34'!
accept: aVisitor
	^aVisitor visitVariableNode: self! !

!VariableNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 16:58'!
sizeCodeForReturn: encoder
	encoder
		if: code
		isSpecialLiteralForPush:
			[:specialLiteral|
			 ^encoder sizeReturnSpecialLiteral: specialLiteral].
	(self code = LdSelf or: [self code = LdSuper]) ifTrue:
		[^encoder sizeReturnReceiver].
	^super sizeCodeForReturn: encoder! !

!VariableNode methodsFor: 'testing' stamp: 'eem 5/14/2008 09:18'!
type
	"This code attempts to reconstruct the type from its encoding in code.
		This allows one to test, for instance, (aNode type = LdInstType)."
	| type |
	code < 0 ifTrue: [^code negated].
	code >= 256 ifTrue: [^code // 256].
	type := CodeBases findFirst: [:one | code < one].
	^type = 0 ifTrue: [5] ifFalse: [type - 1]! !

!VariableNode methodsFor: 'testing' stamp: 'eem 5/14/2008 09:11'!
assignmentCheck: encoder at: location
	^(encoder cantStoreInto: name) ifTrue: [location] ifFalse: [-1]! !

!VariableNode methodsFor: 'printing' stamp: 'eem 5/6/2008 14:37'!
printOn: aStream indent: level 

	aStream nextPutAll: name! !

!VariableNode methodsFor: 'testing' stamp: 'jannik.laval 5/1/2010 20:18'!
index
	"This code attempts to reconstruct the index from its encoding in code."
	code < 0 ifTrue:[^nil].
	code > 256 ifTrue:
		[[index = (code \\ 256)] assert.
		^code \\ 256].
	code >= (CodeBases at: self type) ifTrue:
		[[index = (code - (CodeBases at: self type))] assert.
		^code - (CodeBases at: self type)].
	[index = (code - self type)] assert.
	^code - self type! !

!VariableNode methodsFor: 'initialize-release' stamp: ''!
asStorableNode: encoder
	^ self! !

!VariableNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 18:08'!
emitCodeForStore: stack encoder: encoder

	self shouldNotImplement! !

!VariableNode methodsFor: 'initialize-release' stamp: 'ar 3/26/2004 15:46'!
name: string key: object code: byte
	"Only used for initting std variables, nil, true, false, self, etc."
	name := string.
	key := object.
	code := byte! !

!VariableNode methodsFor: 'code generation' stamp: 'MarcusDenker 9/12/2013 16:40'!
emitCodeForStorePop: stack encoder: encoder
	self assert: [self type ~= 1].
	encoder genStorePopInstVar: index.
	stack pop: 1! !

!VariableNode methodsFor: 'code generation' stamp: 'eem 9/5/2008 18:14'!
fieldOffset
	"Return temp or instVar offset for this variable"
	^index ifNil: [code < 256
					ifTrue: [code \\ 16]
					ifFalse: [code \\ 256]]! !

!VariableNode methodsFor: 'testing' stamp: 'marcus.denker 2/21/2009 15:04'!
returns
	^false ! !

!VariableNode methodsFor: 'testing' stamp: 'eem 5/14/2008 09:13'!
isSelfPseudoVariable
	"Answer if this ParseNode represents the 'self' pseudo-variable."

	^ key = 'self' or: [name = '{{self}}']! !

!VariableNode methodsFor: 'code generation' stamp: 'SeanDeNigris 7/7/2012 21:46'!
emitCodeForValue: stack encoder: encoder
	stack push: 1.
	encoder
		if: code
		isSpecialLiteralForPush:
			[:specialLiteral|
			 ^encoder genPushSpecialLiteral: specialLiteral].
	(code = LdSelf or: [code = LdSuper]) ifTrue:
		[^encoder genPushReceiver].
	code = LdThisContext ifTrue:
		[^encoder genPushThisContext].
	self flag: 'probably superfluous'.
	^encoder genPushInstVar: index! !

!VariableNode methodsFor: 'initialize-release' stamp: 'eem 12/1/2008 13:51'!
name: string
	"Change name"

	name := string! !

!VariableNode methodsFor: 'initialize-release' stamp: 'eem 5/14/2008 09:33'!
name: varName index: i type: type
	"Only used for initting instVar refs"
	^self name: varName key: varName index: i type: type! !

!VariableNode methodsFor: 'accessing' stamp: 'tk 1/30/2001 13:45'!
name
	^ name! !

!VariableNode methodsFor: 'code generation (closures)' stamp: 'eem 7/20/2009 10:38'!
beingAssignedToAnalyseTempsWithin: scopeBlock "<BlockNode>" rootNode: rootNode "<MethodNode>" assignmentPools: assignmentPools "<Dictionary>"
	"No-op overridden by TempVariableNode"! !

!VariableNode class methodsFor: 'initialization' stamp: ''!
initialize    "VariableNode initialize.  Decompiler initialize"
	| encoder |
	encoder := Encoder new.
	StdVariables := Dictionary new: 16.
	encoder
		fillDict: StdVariables
		with: VariableNode
		mapping: #('self' 'thisContext' 'super' 'nil' 'false' 'true' )
		to: (Array with: LdSelf with: LdThisContext with: LdSuper)
				, (Array with: LdNil with: LdFalse with: LdTrue).
	StdSelectors := Dictionary new: 64.
	encoder
		fillDict: StdSelectors
		with: SelectorNode
		mapping: ((1 to: Smalltalk specialSelectorSize) collect: 
							[:i | Smalltalk specialSelectorAt: i])
		to: (SendPlus to: SendPlus + 31).
	StdLiterals := LiteralDictionary new: 16.
	encoder
		fillDict: StdLiterals
		with: LiteralNode
		mapping: #(-1 0 1 2 )
		to: (LdMinus1 to: LdMinus1 + 3).
	encoder initScopeAndLiteralTables.

	NodeNil := encoder encodeVariable: 'nil'.
	NodeTrue := encoder encodeVariable: 'true'.
	NodeFalse := encoder encodeVariable: 'false'.
	NodeSelf := encoder encodeVariable: 'self'.
	NodeThisContext := encoder encodeVariable: 'thisContext'.
	NodeSuper := encoder encodeVariable: 'super'! !

!VersionListModel commentStamp: 'ChristopheDemarey 3/18/2014 17:31'!
A VersionListModel is a list model used to display package versions.
It is needed to be able to override the okToChange method to be able to ask the user before he loose changes made on the selected version.
!
!VersionListModel methodsFor: 'updating' stamp: 'ChristopheDemarey 3/20/2014 11:10'!
updateSelection
	selectionVersionString ifNil: [ ^self ].
	self listItems 
		detect: [ :item | item versionString = selectionVersionString ]
		ifFound: [ :item | | index |
				 index := self listItems identityIndexOf: item.
				selectionHolder index value: index.
				selectionHolder selection value: item ]
		ifNone: [ self resetSelection ]! !

!VersionListModel methodsFor: 'initialization' stamp: 'ChristopheDemarey 3/18/2014 17:57'!
initialize
	super initialize.
	okToChange := true.
	selectionHolder 
		whenChangedDo: [ selectionVersionString := (self listElementAt: self selectedIndex)
															ifNil: [ nil ]
															ifNotNilDo: [ :item | item versionString] ]! !

!VersionListModel methodsFor: 'private' stamp: 'ChristopheDemarey 4/1/2014 16:42'!
developmentVersionString
	^ (self listItems 
		detect: [ :item | item isDevelopment ]) versionString! !

!VersionListModel methodsFor: 'accessing' stamp: 'ChristopheDemarey 12/12/2013 17:29'!
okToChange

"	okToChange ifTrue: [ ^ true ]."
	changedBlock value ifFalse: [ ^true ].
	okToChange := self askConfirmationIfChanges.
	^ okToChange! !

!VersionListModel methodsFor: 'checking' stamp: 'ChristopheDemarey 12/12/2013 16:36'!
askConfirmationIfChanges
	^ self confirm: 'There are changes made to this version.
You will loose changes.
Ok to continue?'! !

!VersionListModel methodsFor: 'updating' stamp: 'ChristopheDemarey 3/20/2014 11:10'!
updateSelectionVersionString
	| selectedItem |
	
	selectedItem := selectionHolder selection value.
	selectionVersionString := selectedItem 
									ifNil: [ nil ]
									ifNotNil: [ selectedItem versionString ].
	selectionVersionString ifNil: [ ^self ]! !

!VersionListModel methodsFor: 'accessing' stamp: 'ChristopheDemarey 12/12/2013 17:24'!
changedBlock: anObject
	changedBlock := anObject! !

!VersionListModel methodsFor: 'api' stamp: 'ChristopheDemarey 3/19/2014 15:28'!
items: aList
	self updateSelectionVersionString.
	super items: aList.
	self updateSelection! !

!VersionListModel methodsFor: 'api' stamp: 'ChristopheDemarey 4/1/2014 16:41'!
selectDevelopment
	selectionVersionString := self developmentVersionString.
	self updateSelection! !

!VersionListModel methodsFor: 'accessing' stamp: 'ChristopheDemarey 12/12/2013 16:36'!
okToChange: aBoolean
	okToChange := aBoolean! !

!VersionnerProjectBrowser commentStamp: '<historical>'!
A VersionnerProjectBrowser can be used to browse a Metacello configuration.
You can display and edit project versions and dependencies.

Quick overview:
VersionnerProjectBrowser example!
!VersionnerProjectBrowser methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/11/2013 10:00'!
projectPanel
	^ projectPanel! !

!VersionnerProjectBrowser methodsFor: 'announcement registration' stamp: 'ChristopheDemarey 7/26/2013 10:40'!
unregister
	"Unregister from the dependent object. Typically used when closing the browser"
	
	MBConfigurationRoot current announcer unsubscribe: self  ! !

!VersionnerProjectBrowser methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/11/2013 10:02'!
versionsLabel
	^ versionsLabel! !

!VersionnerProjectBrowser methodsFor: 'ui' stamp: 'ChristopheDemarey 7/26/2013 11:20'!
windowIsClosing
	self unregister.! !

!VersionnerProjectBrowser methodsFor: 'announcement registration' stamp: 'BernardoContreras 10/1/2014 10:36'!
register
	MBConfigurationRoot current announcer weak
		when: MBConfigurationInfoChanged
		send: #refreshConfiguration
		to: self! !

!VersionnerProjectBrowser methodsFor: 'api' stamp: 'ChristopheDemarey 3/28/2014 14:18'!
configuration: aMBConfigurationInfo 
	configuration := aMBConfigurationInfo.
	configuration recalculateSilently.
	self versionList: configuration versions.! !

!VersionnerProjectBrowser methodsFor: 'accessing' stamp: 'ChristopheDemarey 9/8/2013 15:58'!
project
	^ project! !

!VersionnerProjectBrowser methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/12/2013 18:07'!
repository
	^ repository! !

!VersionnerProjectBrowser methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/19/2013 14:30'!
versionDescriptionLabel
	^ versionDescriptionLabel! !

!VersionnerProjectBrowser methodsFor: 'testing' stamp: 'ChristopheDemarey 4/2/2014 14:50'!
hasChanges
	|  initialProject |
	
	versionList selectedItem ifNil: [ ^ false ].
	initialProject := MTProject 
						newFromVersion: versionList selectedItem version
						inConfiguration: configuration configurationClass.
	^ (MTModelComparator is: project equalsTo: initialProject) not! !

!VersionnerProjectBrowser methodsFor: 'testing' stamp: 'ChristopheDemarey 4/2/2014 14:51'!
ignoreUnsavedChangesOnDevelopmentIfAny
	^ self hasChanges
		ifTrue: [ self confirm: 'There are unsaved changes to the development version.
Ok to loose these changes?' ]
		ifFalse: [ true ]! !

!VersionnerProjectBrowser methodsFor: 'initialization' stamp: 'ChristopheDemarey 7/26/2013 10:40'!
initialize 
	super initialize.
	self register.! !

!VersionnerProjectBrowser methodsFor: 'refreshing' stamp: 'ChristopheDemarey 4/1/2014 16:43'!
selectDevelopmentVersion
	versionList selectDevelopment! !

!VersionnerProjectBrowser methodsFor: 'refreshing' stamp: 'ChristopheDemarey 10/2/2013 15:08'!
refreshConfiguration
	configuration
		ifNotNil: [ self configuration: (MBConfigurationRoot current configurationInfoFor: configuration configurationClass) ]! !

!VersionnerProjectBrowser methodsFor: 'initialization' stamp: 'ChristopheDemarey 4/2/2014 14:45'!
initializePresenter
	"Initialize widgets behavior"

	versionList
		whenSelectedItemChanged: [ :selection | 
			selection 
				ifNil: [ toolbar releaseEnabled: false ]
				ifNotNil: [ toolbar releaseEnabled: selection isDevelopment.
						versionList menu: [ :aMenu | self loadMenuFor: selection in: aMenu ] ].
			self refreshConfiguration.
			self update ];
		displayBlock: [ :item | VSVersionMorph withVersion: item ];
		yourself.

	allVersionsCheckBox
		whenChangedDo: [ :selector | | shouldUpdateList | 
							shouldUpdateList := self hasChanges
								ifTrue: [ self confirm: 'There are unsaved changes. Ok to loose these changes?' ]
								ifFalse: [ true ].
							shouldUpdateList ifTrue: [ self versionList: configuration versions ] ].
	
	repository acceptBlock: [ project repository: repository text ].
	
	repositoryAddButton action: [ self updateRepository ]! !

!VersionnerProjectBrowser methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/11/2013 12:57'!
title
	^ configuration name configurationBaseName! !

!VersionnerProjectBrowser methodsFor: 'actions' stamp: 'MarcusDenker 7/16/2014 17:25'!
updateRepository
	"Update the core repository of this project"
	| package repoManager |
	
	project ifNotNil: [ 
		package := project configurationClass package mcPackage.
		repoManager := VersionnerRepositoriesManager new.
		repoManager
			selectedChangedBlock:  [:remote :selected |
				selected
					ifTrue: [ | repositoryGroup | 
							repositoryGroup := package workingCopy repositoryGroup.
							repositoryGroup repositoriesDo: [ :aRepository | 
									(aRepository location = repository text) 
										ifTrue: [ repositoryGroup removeRepository: aRepository ] ].
							repository accept: remote location.
							repositoryGroup addRepository: remote ] ];
			open;
			yourself  ]! !

!VersionnerProjectBrowser methodsFor: 'ui' stamp: 'ChristopheDemarey 7/11/2013 11:01'!
iconForVersion: aMBVersionInfo 
	^ Smalltalk ui icons iconNamed: #databaseIcon! !

!VersionnerProjectBrowser methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/25/2013 11:15'!
repositoryAddButton
	^ repositoryAddButton! !

!VersionnerProjectBrowser methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/15/2013 16:02'!
versionDescription
	^ versionDescription! !

!VersionnerProjectBrowser methodsFor: 'initialization' stamp: 'ChristopheDemarey 7/19/2013 14:43'!
initialExtent
	 ^  (900.0@650.0)! !

!VersionnerProjectBrowser methodsFor: 'refreshing' stamp: 'TorstenBergmann 3/4/2015 21:29'!
update
	"Update the project details according to selected configuration and version."

	versionList selectedItem
		ifNil: [ projectPanel project: nil ]
		ifNotNilDo: [ :selectedVersion | 
			project := MTProject 
						newFromVersion: selectedVersion version
						inConfiguration: configuration configurationClass.
			projectPanel project: project.					
			repository text: project repository.
			versionDescription text: project version description.
			versionCommitMessage label: 'Commited: ' , project version author , ' - ' , project version timestamp ]! !

!VersionnerProjectBrowser methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/11/2013 10:00'!
toolbar

	^ toolbar.! !

!VersionnerProjectBrowser methodsFor: 'initialization' stamp: 'TorstenBergmann 3/4/2015 21:28'!
initializeWidgets
	"toolbar"
	toolbar := self instantiate: VersionnerProjectToolBar.
	toolbar browser: self.
	
	"repository"
	(repositoryLabel := self instantiate: LabelModel)
		label: 'Repository:'.
	(repository := self instantiate: TextInputFieldModel)
		entryCompletion: nil;
		acceptOnCR: true;
		ghostText: 'none'.
	repositoryAddButton := (self instantiate: ButtonModel)
		icon: (Smalltalk ui icons iconNamed: #monticelloPackageIcon);
		help: 'Add a new repository to this project';
		yourself.
	
	"versions"
	versionList := (self instantiate: VersionListModel )
		icons: [:version | self iconForVersion: version ];
		on: PharoShortcuts current browseShortcut do: [ versionList selectedItem 
			ifNotNilDo: [ :selection |
				(VSBrowseVersionCommand target: selection version for: self) execute ] ];
		changedBlock: [ self hasChanges ];
		yourself.
	versionsLabel := (self instantiate: LabelModel)
		label: 'Versions';
		yourself.
	allVersionsCheckBox := (self instantiate: CheckBoxModel)
		label: 'browse all';
		state: false;
		yourself.

	"Version details"
	versionDescriptionLabel := (self instantiate: LabelModel)
		label: 'Version description:';
		yourself.
	versionDescription := (self instantiate: TextModel)
		enabled: false;
		yourself.
	versionCommitMessage := self instantiate: LabelModel.
	
	"Project details"
	projectPanel := self instantiate: VersionnerProjectPanel.
	! !

!VersionnerProjectBrowser methodsFor: 'menu' stamp: 'ChristopheDemarey 3/28/2014 14:55'!
loadMenuFor: mbInfo in: aMenu 
	"dynamic menu"
	aMenu target: self.
	((mbInfo commands collect: [ :commandClass |commandClass target: mbInfo for: (versionList selectedItem)])
		asArray sort: [:a :b | a order <= b order ]) 
			do: [:cmd | aMenu add: cmd title 
							    target: [	cmd execute.
										self refreshConfiguration.
										self update ]
							    selector:#value.].
	^ aMenu.! !

!VersionnerProjectBrowser methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/11/2013 10:02'!
versionList: aVersionList
	"Select versions to display and give them to the list model."

	| selectedVersions |
	selectedVersions := allVersionsCheckBox state
		ifTrue: [ aVersionList ]
		ifFalse: [ 
			aVersionList
				select: [ :version | version isStable or: [ version isDevelopment or: [ version isCurrentVersion or: [ version isBleedingEdge ] ] ] ] ].
	self versionList items: selectedVersions! !

!VersionnerProjectBrowser methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/15/2013 15:26'!
versionCommitMessage
	^ versionCommitMessage! !

!VersionnerProjectBrowser methodsFor: 'actions' stamp: 'ChristopheDemarey 8/19/2014 18:11'!
createBaselineIfEmptyConfiguration
	configuration versions ifEmpty: 
		[ | tempProject|
		tempProject := MTProject new
						name: configuration name configurationBaseName;
						configurationClass: configuration;
						yourself.
		tempProject devWorkflow createInitialDevelopment ]! !

!VersionnerProjectBrowser methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/11/2013 09:59'!
allVersionsCheckBox
	^ allVersionsCheckBox! !

!VersionnerProjectBrowser methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/11/2013 10:02'!
versionList
	^ versionList.! !

!VersionnerProjectBrowser methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/12/2013 18:07'!
repositoryLabel
	^ repositoryLabel! !

!VersionnerProjectBrowser class methodsFor: 'spec' stamp: 'ChristopheDemarey 7/25/2013 11:18'!
defaultSpec
	"Define the layout of the Versionner Browser"
	^ SpecLayout composed
		newColumn: [ : column | 
			column
				add: #toolbar height: self toolbarHeight;
				newRow: [ :mainPanel | mainPanel
					newColumn: [ :leftPanel | leftPanel
						newRow: [ :versionsHeader | 
							versionsHeader
								add: #versionsLabel;
								add: #allVersionsCheckBox ] 
						height: self toolbarHeight;					
						
						add: #versionList ] 
					right: 0.7;
					
					addSplitter;
					
					add: #projectPanel left: 0.3
				];
				newRow: [ :row |
					row
						newColumn: [  :col | 
							col
								newRow: [:repoHeader | repoHeader
									add: #repositoryLabel  width: 75;
									add: #repository;
									add: #repositoryAddButton width: self toolbarHeight ] 
								height: self toolbarHeight;
						
								newColumn: [:versionDescRow | versionDescRow 
									add: #versionDescriptionLabel height: self toolbarHeight;
									add: #versionDescription ];
								
								add: #versionCommitMessage height: self toolbarHeight ] ] height: 120
			
			];
	yourself.
 ! !

!VersionnerProjectBrowser class methodsFor: 'examples' stamp: 'NicolaiHess 3/16/2015 15:18'!
example
	^ self
		openOn: (MBConfigurationRoot current configurations detect: [ :config | config name = 'ConfigurationOfOSWindow' ])! !

!VersionnerProjectBrowser class methodsFor: 'ui' stamp: 'ChristopheDemarey 8/25/2014 17:40'!
openOn: configuration
	^ self new
		configuration: configuration;
		createBaselineIfEmptyConfiguration;
		openWithSpec;
		yourself! !

!VersionnerProjectPackagesPanel commentStamp: '<historical>'!
A VersionnerProjectPackagesPanel is the panel related to packages defined in a project (a configuration).
It shows packages and provides actions on them.

Instance Variables
	addPackageButton:		ButtonModel 
	editPackageButton:		ButtonModel
	packageChangesButton:		ButtonModel
	packages: 			A collection of MTPackage to display
	packagesList:		IconListModel 
	packagesLabel:		LabelModel
	project: 	MTProject
	savePackageButton:		ButtonModel

addPackageButton
	- Add a new package

editPackageButton
	- Edit an existing package

packageChangesButton
	- Get changes on a package

packages
	- the list of packages that belongs to a specfied project (configuration)

packagesLabel
	- The top label of this pane

project
 	- The project owning packages.
	
removePackageButton
	- remove a declared package.

savePackageButton
	- Commit changes and update package version
!
!VersionnerProjectPackagesPanel methodsFor: 'metacello' stamp: 'ChristopheDemarey 12/21/2012 13:31'!
workingCopies
	^ MCWorkingCopy allManagers asSortedCollection: [ :a :b | a name <= b name]! !

!VersionnerProjectPackagesPanel methodsFor: 'actions' stamp: 'ChristopheDemarey 2/28/2014 16:02'!
editSelectedPackageRequirements
	"Edit package requirements for the selected package"
	
	| selectedPackage editionWidget |

	selectedPackage := self packageBoundToSelection.
	selectedPackage ifNil: [ ^self ].
	editionWidget := (EditableList new: selectedPackage dependencies) 
		title: selectedPackage name , ' requirements';
		addItemBlock: [ self addPackageRequirement ];
		yourself.	
	editionWidget okAction: [ "propagate changes"
		selectedPackage dependencies: editionWidget list getItems.
		packagesList roots: project packages ].
	self window openModal: editionWidget openDialogWithSpec window
	! !

!VersionnerProjectPackagesPanel methodsFor: 'api' stamp: 'BernardoContreras 10/1/2014 10:36'!
project: anMTProject
	project := anMTProject.
	packagesList roots: self packages.
	project ifNotNil: 
		[ project announcer weak 
			when: MTProjectModelChanged
			send: #refreshPackages
			to: self ].! !

!VersionnerProjectPackagesPanel methodsFor: 'accessing' stamp: 'TesterBob 10/4/2012 15:45'!
packagesLabel
	^ packagesLabel! !

!VersionnerProjectPackagesPanel methodsFor: 'actions' stamp: 'ChristopheDemarey 3/27/2014 17:32'!
addPackageRequirement
	"Add a requirement (a group, another package) for the selected package."
	
	packagesList selectedItem
		ifNil: [ UIManager default inform: 'No package selected' ]
		ifNotNilDo: [ :packageNode |
			|  potentialRequirements |
			potentialRequirements := project dependencies 
											reject: [ :item | | selectedPackage |
													selectedPackage := packageNode content.
													(item = selectedPackage) or: [ selectedPackage dependencies includes: item ] ]
											thenCollect: [ :dependency | dependency name ].
			^ UIManager default chooseFrom: potentialRequirements values: potentialRequirements ].
	^ nil! !

!VersionnerProjectPackagesPanel methodsFor: 'accessing' stamp: 'TesterBob 10/4/2012 15:45'!
addPackageButton
	^ addPackageButton! !

!VersionnerProjectPackagesPanel methodsFor: 'initialization' stamp: 'TorstenBergmann 3/4/2015 21:29'!
initializeWidgets
	packagesList := (self instantiate: TreeModel)
		dragEnabled: true;
		whenBuiltDo: [ packagesList rootNodeHolder: [ :item | VSPackageNode new content: item ] ];
		yourself.  
	"packagesList icons: [:configuration | self iconForConfiguration: configuration ]. "
	"packagesList displayBlock: [:item |  |attributes text version|
							attributes := OrderedCollection new.
							text := item packageName.
							(item name size) > (text size) ifTrue: [
								version := (item name copyFrom: (text size + 2) to: (item name size)).
								(version size > 0) ifTrue: [ 
									text := text , ' (' , version , ')'. ].
								].
							item isDirty
								ifTrue: [ text := '*', text ].
							text.
						 ]."

	packagesLabel := self instantiate: LabelModel .
	packagesLabel label: 'Packages' .
	
	addPackageButton := self instantiate: ButtonModel .
	addPackageButton
		icon: (Smalltalk ui icons iconNamed: #packageAddIcon);
		enabled: false;
		help: 'Add a package to this project'.
	
	removePackageButton  := self instantiate: ButtonModel .
	removePackageButton 
		icon: (Smalltalk ui icons iconNamed: #packageDeleteIcon);
		enabled: false;
		help: 'Remove a package from this project'.
	
	editPackageButton  := self instantiate: ButtonModel .
	editPackageButton
		icon: (Smalltalk ui icons iconNamed: #editIcon);
		enabled: false;
		help: 'Edit package requirements'.
	
	savePackageButton  := self instantiate: ButtonModel .
	savePackageButton
		icon: (Smalltalk ui icons iconNamed: #smallSaveIcon);
		enabled: false;
		help: 'Save the selected package'.! !

!VersionnerProjectPackagesPanel methodsFor: 'accessing' stamp: 'TesterBob 10/4/2012 15:45'!
removePackageButton
	^ removePackageButton! !

!VersionnerProjectPackagesPanel methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/18/2013 18:46'!
packages
	^ project ifNil: [ #() ] ifNotNil: [ project packages ] ! !

!VersionnerProjectPackagesPanel methodsFor: 'actions' stamp: 'ChristopheDemarey 11/27/2013 16:24'!
removeSelectedPackage
	"remove the selected package from the model and the list."
	| selectedPackage index |

	selectedPackage := packagesList selectedItem.
	selectedPackage ifNil: [ ^self ].
	
	selectedPackage content remove.
	"index := packagesList selectedIndex."
	packagesList roots: project packages.
	"packagesList setSelectedIndex: index."
	
! !

!VersionnerProjectPackagesPanel methodsFor: 'refreshing' stamp: 'ChristopheDemarey 10/2/2013 15:25'!
refreshPackages
	packagesList roots: project packages! !

!VersionnerProjectPackagesPanel methodsFor: 'testing' stamp: 'ChristopheDemarey 2/28/2014 15:57'!
isPackage: selection
	| node |
	
	(selection size = 1) ifFalse: [  ^false ].
	node := selection at: 1.
	^ node parentNode isNil! !

!VersionnerProjectPackagesPanel methodsFor: 'initialization' stamp: 'ChristopheDemarey 2/28/2014 15:47'!
initializePresenter
	"Initialize widgets behavior"

	packagesList whenSelectedNodesChanged: [:selection |
		removePackageButton enabled: (self isPackage: selection).
		editPackageButton enabled: selection notEmpty ].
		
	addPackageButton action: [ self addPackage ].
	removePackageButton action: [ self removeSelectedPackage ].
	editPackageButton action: [ self editSelectedPackageRequirements ].! !

!VersionnerProjectPackagesPanel methodsFor: 'accessing' stamp: 'TesterBob 10/4/2012 15:45'!
editPackageButton
	^ editPackageButton! !

!VersionnerProjectPackagesPanel methodsFor: 'actions' stamp: 'ChristopheDemarey 12/10/2013 13:15'!
addPackage
	"Add a package as internal dependency."
	| searchUI packageWC package |
	searchUI := SearchFacade 
		mcPackageSearchRejectAll:  [ :workingCopy || versionedPackages pkgName |
			versionedPackages := project packages collect: [ :each | each name ].
			pkgName := workingCopy package name.			
			(versionedPackages includes: pkgName) or: [pkgName beginsWith: 'ConfigurationOf'] ]
		withInitialFilter: project name.
	packageWC := searchUI chooseFromOwner: self window.

	packageWC
		ifNotNil: [ 
			package := MTPackage newNamed: packageWC package name.
			owner project addDependency: package.
			packagesList roots: project packages.
				"package ancestry ancestors isEmpty
				ifTrue: [ 
					(MBPlatform current
						confirm:
							'The package: ' , package package name printString , ' has not been committed yet. Would you like to commit it into the '
							, repository description printString, ' repository?')
						ifTrue: [ 
							package repositoryGroup repositories size <= 1
								ifTrue: [ package repositoryGroup addRepository: repository ].
							package currentVersionInfo ] ] " ]! !

!VersionnerProjectPackagesPanel methodsFor: 'selection' stamp: 'ChristopheDemarey 2/28/2014 16:05'!
packageBoundToSelection
	| selection |
	
	selection := packagesList selectedItem.
	selection ifNil: [ ^ nil ].
	^ (selection parentNode)
		ifNil: [ selection content ]
		ifNotNil: [ selection parentNode content ]! !

!VersionnerProjectPackagesPanel methodsFor: 'accessing' stamp: 'TesterBob 10/4/2012 15:46'!
savePackageButton
	^ savePackageButton! !

!VersionnerProjectPackagesPanel methodsFor: 'accessing' stamp: 'ChristopheDemarey 12/18/2012 16:42'!
packagesList
	^ packagesList! !

!VersionnerProjectPackagesPanel class methodsFor: 'spec' stamp: 'ChristopheDemarey 2/28/2014 15:48'!
defaultSpec
	<spec>

	"Define the layout of the Project Packages Panel"
	^ SpecLayout composed
		"newColumn: [ :c1 | c1
				newRow: [:r1 | r1
						add: #packagesLabel; 
						add: #addPackageButton;
						add: #removePackageButton;
						add: #editPackageButton;
						add: #savePackageButton]
					height: 25;
				add: #packages
		];"
	"Use the code below because Spec parser takes too much time to load Versionner with the previous declaration."
		add: #packagesLabel origin: 0@0 corner: 1/4@0 offsetOrigin: 0@0 offsetCorner: 0@25;
		add: #addPackageButton origin: 1/4@0 corner: 2/4@0 offsetOrigin: 0@0 offsetCorner: 0@25;
		add: #removePackageButton origin: 2/4@0 corner: 3/4@0 offsetOrigin: 0@0 offsetCorner: 0@25;
		add: #editPackageButton origin: 3/4@0 corner: 4/4@0 offsetOrigin: 0@0 offsetCorner: 0@25;
		"add: #savePackageButton origin: 4/6@0 corner: 5/6@0 offsetOrigin: 0@0 offsetCorner: 0@25;"
		add: #packagesList origin: 0@0 corner: 1@1 offsetOrigin: 0@25 offsetCorner: 0@0;
	yourself.
! !

!VersionnerProjectPanel commentStamp: '<historical>'!
A VersionPanel is the panel used to show details about a given version of a configurationOf.

Instance Variables
	config: 				The configuration (an MBConfigurationInfo instance) of the project to display details on. 
	packageList:			The specWidget used to display packages describes in the version
!
!VersionnerProjectPanel methodsFor: 'accessing-ui' stamp: 'ChristopheDemarey 3/20/2015 11:43'!
requiredProjectMenu: aMenu
	aMenu addMenuGroup: (MenuGroupModel new
		addMenuItem: (MenuItemModel new
			name: #'browse project';
			action: [ self browseSelectedProject ]);
		addMenuItem: (MenuItemModel new
			name: #'edit version';
			action: [  projectList selectedItem content editVersion.
					projectList roots: project requiredProjects ]);
		addMenuItem: (MenuItemModel new
			name: #'edit repositories';
			action: [  projectList selectedItem content editRepositories ]);
		yourself).

	^ aMenu! !

!VersionnerProjectPanel methodsFor: 'accessing-ui' stamp: 'ChristopheDemarey 2/14/2013 16:31'!
projectList
	^ projectList! !

!VersionnerProjectPanel methodsFor: 'actions' stamp: 'ChristopheDemarey 7/24/2013 22:54'!
removeDependentProject: aMTDependantProject 
	aMTDependantProject remove.
	projectList roots: project requiredProjects.! !

!VersionnerProjectPanel methodsFor: 'accessing-ui' stamp: 'ChristopheDemarey 7/23/2013 23:24'!
removeProjectButton
	^ removeProjectButton! !

!VersionnerProjectPanel methodsFor: 'accessing' stamp: 'ChristopheDemarey 12/20/2012 17:55'!
project
	^ project! !

!VersionnerProjectPanel methodsFor: 'initialization' stamp: 'ChristopheDemarey 3/20/2015 11:12'!
initializeProjectsWidget
	projectList := (self instantiate: TreeModel)
		whenBuiltDo: [ projectList rootNodeHolder: [ :item | VSProjectNode new content: item ] ];
		on: PharoShortcuts current browseShortcut
			do: [ self browseSelectedProject ];
		doubleClick: [ self browseSelectedProject ];
		yourself.	"projectList displayBlock: [:item | item asString ].
	projectList childrenBlock: [:item | 
		(item isKindOf: MTDependency )
			ifTrue: [ item dependencies collect: [ :each | '--> loads: ' , each] ] 
			ifFalse: [{}] ]."	"| text version |
		text :=  item name.
		version := item currentVersion.
		(version size > 0) ifTrue: [
			text := text , ' (' , item currentVersion , ')' ].
		text  asStringMorph ]."
	addProjectButton := (self instantiate: ButtonModel)
		label: nil;
		icon: (Smalltalk ui icons iconNamed: #addIcon);
		enabled: false;
		help: 'Add a new dependent project to this project'.
	removeProjectButton := (self instantiate: ButtonModel)
		label: nil;
		icon: (Smalltalk ui icons iconNamed: #deleteIcon);
		enabled: false;
		help: 'Remove a dependent project from this project'.
	editProjectButton := self newButton
		label: nil;
		icon: (Smalltalk ui icons iconNamed: #editIcon);
		enabled: false;
		help: 'Edit the dependent project loads list'! !

!VersionnerProjectPanel methodsFor: 'actions' stamp: 'ChristopheDemarey 3/20/2015 11:12'!
browseSelectedProject
	^ projectList selectedItem ifNotNilDo: [ :selection | self browseProject: selection content configurationClass ]! !

!VersionnerProjectPanel methodsFor: 'actions' stamp: 'ChristopheDemarey 2/28/2014 16:41'!
remove: aDependency fromGroup: aGroup
	"Remove a dependency from a group or project"

	aDependency
		ifNotNil: [ 
			(UIManager default 
					confirm: 'Are your sure you want to remove ', aDependency asString
					label: 'Remove a group')
				ifTrue: [ 
					aGroup
						ifNil: [ project removeDependencyNamed: aDependency name ]
						ifNotNil: [ aGroup dependencies: (aGroup dependencies reject: [ :dependency | dependency = aDependency ]) ].
					groupList roots: project groups ] ]
! !

!VersionnerProjectPanel methodsFor: 'initialization' stamp: 'ChristopheDemarey 2/28/2014 18:00'!
initializePresenter
	"Initialize widgets behavior"

	projectList whenSelectedNodesChanged: [ :selection | 
					removeProjectButton enabled: (self isProject: selection).
					editProjectButton enabled: selection notEmpty.
					projectList menu: [ :aMenu | self requiredProjectMenu: aMenu] ].
	addProjectButton action: [ self addDependentProject ].
	removeProjectButton
		action: [ projectList selectedItem 
					ifNotNilDo: [ :selectedItem | self removeDependentProject: selectedItem content ] ].
	editProjectButton action: [ self editSelectedProjectLoads ].
	
	groupList whenSelectedItemsChanged: [ :selection | removeGroupButton enabled: selection notEmpty ].
	addGroupButton action: [ self addGroup ].
	removeGroupButton
		action: [ 
			groupList selectedItem
				ifNotNilDo: [ :selectedItem | | parentGroup |
					parentGroup :=  groupList selectedItem parentNode
											ifNil: [ nil ]
											ifNotNilDo: [ :parentNode | parentNode content ].
					self 
						remove: selectedItem content 
						fromGroup: parentGroup ] ]! !

!VersionnerProjectPanel methodsFor: 'accessing-ui' stamp: 'ChristopheDemarey 8/13/2012 12:08'!
projectsLabel
	^ projectsLabel! !

!VersionnerProjectPanel methodsFor: 'accessing-ui' stamp: 'ChristopheDemarey 6/25/2013 17:45'!
removeGroupButton
	^ removeGroupButton! !

!VersionnerProjectPanel methodsFor: 'accessing-ui' stamp: 'ChristopheDemarey 2/14/2013 16:33'!
groupList
	^ groupList! !

!VersionnerProjectPanel methodsFor: 'actions' stamp: 'ChristopheDemarey 6/26/2013 17:00'!
addGroup
	"Add a new group to the configuration"

	| groupName |
	project
		ifNotNil: [ 
			groupName := UIManager default request: 'New group:'.
			groupName ifNotNil: [ project addDependency: (MTGroup new name: groupName) ].
			groupList roots: project groups ]! !

!VersionnerProjectPanel methodsFor: 'selection' stamp: 'ChristopheDemarey 2/28/2014 18:02'!
projectBoundToSelection
	| selection |
	
	selection := projectList selectedItem.
	selection ifNil: [ ^ nil ].
	^ (selection parentNode)
		ifNil: [ selection content ]
		ifNotNil: [ selection parentNode content ]! !

!VersionnerProjectPanel methodsFor: 'actions' stamp: 'ChristopheDemarey 3/20/2015 10:59'!
browseProject: aConfigurationClass
	| configInfo |
	configInfo := MBConfigurationRoot current configurationInfoFor: aConfigurationClass.
	configInfo ifNotNil: 
		[ configInfo recalculate.
		^ VersionnerProjectBrowser openOn: configInfo ]! !

!VersionnerProjectPanel methodsFor: 'accessing-ui' stamp: 'TesterBob 10/4/2012 15:58'!
packagesPanel
	^ packagesPanel! !

!VersionnerProjectPanel methodsFor: 'accessing-ui' stamp: 'ChristopheDemarey 2/21/2014 17:59'!
editProjectButton
	^ editProjectButton! !

!VersionnerProjectPanel methodsFor: 'initialization' stamp: 'MarcusDenker 10/13/2014 14:07'!
initializeGroupsWidget
	groupList := (self instantiate: TreeModel)
		autoDeselection: true;
		dragEnabled: true;
		dropEnabled: true;
		acceptDropBlock: [ :transfer :event :source :receiver | | passengerItem myreceiver | 
			myreceiver := receiver.
			myreceiver parent ifNotNil: [ myreceiver := myreceiver parent ]. "Only add dependencies on top elements"
			passengerItem := transfer passenger item.
			myreceiver complexContents item 
				addDependency: ((passengerItem isKindOf: MTDependency) "Ugly test because String>>name adds extra quotes"
					ifTrue: [ passengerItem name ]
					ifFalse: [ passengerItem ]) ];
		whenBuiltDo: [ groupList rootNodeHolder: 
							[ :item | VSGroupNode new content: item ] ];
		yourself.
	
	addGroupButton := (self instantiate: ButtonModel)
		label: nil;
		icon: (Smalltalk ui icons iconNamed: #addIcon);
		enabled: false;
		help: 'Add a new group to this project'.
	
	removeGroupButton  := (self instantiate: ButtonModel)
		label: nil;
		icon: (Smalltalk ui icons iconNamed: #deleteIcon);
		enabled: false;
		help: 'Remove a group from this project'.! !

!VersionnerProjectPanel methodsFor: 'api' stamp: 'BernardoContreras 10/1/2014 10:37'!
project: anMTProject
	project := anMTProject.
	project
		ifNil: [ 
			groupList roots: #().
			projectList roots: #() ]
		ifNotNil: [ 
			project announcer weak 
				when: MTProjectModelChanged
				send:  #refreshGroups
				to:  self.
			groupList roots: project groups.
			projectList roots: project requiredProjects ].
	packagesPanel project: anMTProject.
	addProjectButton enabled: project isNotNil.
	addGroupButton enabled: project isNotNil.
	packagesPanel addPackageButton enabled: project isNotNil.! !

!VersionnerProjectPanel methodsFor: 'actions' stamp: 'ChristopheDemarey 7/24/2013 23:36'!
addDependentProject
	"Add a new dependent project to the configuration"

	| requiredProjectNames dependentProject searchUI |
	project
		ifNotNil: [
			requiredProjectNames := project requiredProjects collect: [ :reqProject | reqProject name ].
			searchUI :=  SearchFacade projectWithConfigurationSearchRejectAll: [ :item | 
				(requiredProjectNames includes: item name configurationBaseName) 
					or: [ project name = item name configurationBaseName ] ].
			dependentProject := searchUI chooseFromOwner: self window.
			dependentProject ifNotNil: [ project addDependency: (MTDependantProject newWithWorkingCopy: dependentProject) ].
			projectList roots: project requiredProjects ]! !

!VersionnerProjectPanel methodsFor: 'actions' stamp: 'ChristopheDemarey 2/21/2014 18:16'!
addProjectLoadDirective
	"Add a load directive to the selected project."
	
	projectList selectedItem
		ifNil: [ UIManager default inform: 'No project selected' ]
		ifNotNilDo: [ :requiredProject |
			^ UIManager default request: 'Package or group to load?' 
			"|  potentialRequirements |
			potentialRequirements := project dependencies collect: [ :dependency | dependency name ].
			^ UIManager default chooseFrom: potentialRequirements values: potentialRequirements" ].
	^ nil! !

!VersionnerProjectPanel methodsFor: 'initialization' stamp: 'TorstenBergmann 3/4/2015 21:29'!
initializeWidgets
	self initializeGroupsWidget.
	self initializeProjectsWidget.
	
	packagesPanel := self instantiate: VersionnerProjectPackagesPanel.

	groupsLabel  := (self instantiate: LabelModel)
		label: 'Groups';
		yourself.
	
	projectsLabel :=  self instantiate: LabelModel.
	projectsLabel label: 'Dependent projects'.
! !

!VersionnerProjectPanel methodsFor: 'accessing-ui' stamp: 'ChristopheDemarey 8/13/2012 12:08'!
groupsLabel
	^ groupsLabel! !

!VersionnerProjectPanel methodsFor: 'refreshing' stamp: 'ChristopheDemarey 10/2/2013 15:18'!
refreshGroups
	groupList roots: project groups! !

!VersionnerProjectPanel methodsFor: 'actions' stamp: 'ChristopheDemarey 2/28/2014 18:03'!
editSelectedProjectLoads
	"Edit load directives for the selected project"
	
	| selectedProject editionWidget |

	selectedProject := self projectBoundToSelection.
	selectedProject ifNil: [ ^self ].
	editionWidget := (EditableList new: selectedProject dependencies) 
		title: selectedProject name , ' load directives';
		addItemBlock: [ self addProjectLoadDirective ];
		yourself.	
	editionWidget okAction: [ "propagate changes"
		selectedProject dependencies: editionWidget list getItems.
		projectList roots: project requiredProjects ].
	self window openModal: editionWidget openDialogWithSpec window
	! !

!VersionnerProjectPanel methodsFor: 'testing' stamp: 'ChristopheDemarey 2/28/2014 17:59'!
isProject: selection
	| node |
	
	(selection size = 1) ifFalse: [  ^false ].
	node := selection at: 1.
	^ node parentNode isNil! !

!VersionnerProjectPanel methodsFor: 'accessing-ui' stamp: 'ChristopheDemarey 7/23/2013 23:24'!
addProjectButton
	^ addProjectButton! !

!VersionnerProjectPanel methodsFor: 'accessing-ui' stamp: 'ChristopheDemarey 6/25/2013 17:45'!
addGroupButton
	^ addGroupButton! !

!VersionnerProjectPanel methodsFor: 'api' stamp: 'ChristopheDemarey 7/18/2013 18:43'!
config: anMBConfigurationInfo
	| allGroups |
	config := anMBConfigurationInfo.

	"allGroups := config groups."
	"(allGroups includes: 'All') ifFalse: [ allGroups addFirst: 'All' ] ."
"	self groups roots: allGroups."
	
	"self packagesPanel packages: config packages."
	"self projects: config projects".
	
	project :=  MCModel2MTModelVisitor new visitConfiguration: anMBConfigurationInfo.
	groupList roots: project groups.
	projectList items: project requiredProjects.
	packagesPanel project: project.! !

!VersionnerProjectPanel class methodsFor: 'spec' stamp: 'ChristopheDemarey 3/18/2014 17:16'!
defaultSpec
	"Define the layout of the Project Panel"

	<spec>
	^ SpecLayout composed
		newColumn: [ :c1 | 
					c1
						newColumn: [ :c11 | 
							c11
								newRow: [ :r1 | 
									r1
										add: #projectsLabel origin: 0@0 corner: 1@1;
										add: #addProjectButton width: 50;
										add: #removeProjectButton width: 50;
										add: #editProjectButton width: 50]
								height: 25;
								add: #projectList ];
						addSplitter;
						newColumn: [ :c12 | 
							c12
								newRow: [ :r2 | 
									r2
										add: #groupsLabel origin: 0@0 corner: 1@1;
										add: #addGroupButton width: 50;
										add: #removeGroupButton width: 50]
								height: 25;
							add: #groupList ];
						addSplitter;
						add: #packagesPanel ];
		yourself! !

!VersionnerProjectToolBar commentStamp: '<historical>'!
Versionner toolbar spec definition.
!
!VersionnerProjectToolBar methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/4/2013 11:50'!
releaseButton
	^ releaseButton.! !

!VersionnerProjectToolBar methodsFor: 'initialization' stamp: 'ChristopheDemarey 3/19/2015 15:37'!
initializePresenter
	"Initialize widgets behavior"

	updateButton action: [  self browser hasChanges 
								ifTrue: [ self executeWithDevWorkflow: VSUpdateDevelopmentVersionCommand ]
								ifFalse: [ UIManager default inform: 'Nothing to save' ] ].
	
	releaseButton action: [ self browser ignoreUnsavedChangesOnDevelopmentIfAny
								ifTrue: [ self executeWithDevWorkflow: VSReleaseDevelopmentVersionCommand ] ].
	
	commitButton action: [ (VSSaveProjectCommand target: browser project for: self) execute ].! !

!VersionnerProjectToolBar methodsFor: 'accessing' stamp: 'JuanPabloSandovalA 6/7/2012 15:59'!
browser: aSpecBrowser
	browser := aSpecBrowser.! !

!VersionnerProjectToolBar methodsFor: 'actions' stamp: 'ChristopheDemarey 4/1/2014 16:31'!
executeWithDevWorkflow: aCommandClass
	browser projectPanel project
		ifNotNilDo: [ :project | | cmd |
			 cmd := aCommandClass 
						target: project	devWorkflow
						for: self.
			[ cmd execute ]
				on: MetacelloValidationFailure 
				do: [ :error | (VSConfigurationValidationIssuesDisplayCommand target: error for: self) execute] ].
	browser refreshConfiguration.
	browser selectDevelopmentVersion.
	browser update! !

!VersionnerProjectToolBar methodsFor: 'accessing' stamp: 'JuanPabloSandovalA 6/7/2012 15:59'!
browser
	^ browser.! !

!VersionnerProjectToolBar methodsFor: 'initialization' stamp: 'ChristopheDemarey 3/19/2015 15:37'!
initializeWidgets
	updateButton := (self instantiate: ButtonModel)
		label: ' Save to development';
		icon: (Smalltalk ui icons iconNamed: #smallSaveIcon);
		help: 'Save the current modifications into the development baseline. It will save your changes into the Configuration class but will not save your code in the Version Control System. To publish your changes, use the commit button.';
		yourself.

	releaseButton := (self instantiate: ButtonModel)
		label: ' Release version';
		icon: (Smalltalk ui icons iconNamed: #smallPublishIcon);
		help: 'Make a release. It will create a version method for this release and a new development baseline. It will save your changes into the Configuration class but will not save your code in the Version Control System. To publish your changes, use the commit button.';
		enabled: false;
		yourself.
	
	commitButton := (self instantiate: ButtonModel)
		label: ' Commit the project';
		icon: (Smalltalk ui icons iconNamed: #monticelloPackageIcon);
		help: 'Commit the configuration and all dirty packages of the project to the main repository of your Version Control system (e.g. Monticello, git)';
		yourself.
! !

!VersionnerProjectToolBar methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/24/2013 23:56'!
updateButton
	^ updateButton.! !

!VersionnerProjectToolBar methodsFor: 'accessing' stamp: 'ChristopheDemarey 1/13/2014 17:13'!
commitButton
	^ commitButton.! !

!VersionnerProjectToolBar methodsFor: 'api' stamp: 'ChristopheDemarey 4/2/2014 11:32'!
releaseEnabled: aBoolean
	releaseButton enabled: aBoolean! !

!VersionnerProjectToolBar class methodsFor: 'specs' stamp: 'ChristopheDemarey 1/13/2014 17:12'!
defaultSpec
	<spec>

	"Define the layout of the Versionner ToolBar"
	^ SpecLayout composed
		newRow: [ :r | r
					add: #updateButton;
					add: #releaseButton;
					add: #commitButton ];
		yourself.! !

!VersionnerProjectToolBar class methodsFor: 'specs' stamp: 'ChristopheDemarey 7/24/2013 23:52'!
title
	^ 'Versionner Project Browser ToolBar'! !

!VersionnerReleasePanel commentStamp: 'ChristopheDemarey 3/11/2014 17:32'!
Window used to release a version.
You can specify the version number and ask for symbolic versions resolution.

self new openDialogWithSpec!
!VersionnerReleasePanel methodsFor: 'accessing' stamp: 'ChristopheDemarey 3/14/2014 17:44'!
releaseNumberText
	^ releaseNumber text! !

!VersionnerReleasePanel methodsFor: 'accessing' stamp: 'ChristopheDemarey 3/11/2014 15:59'!
symbolicVersionResolutionCheckBox
	^ symbolicVersionResolutionCheckBox! !

!VersionnerReleasePanel methodsFor: 'initialization' stamp: 'TorstenBergmann 3/4/2015 21:30'!
initializeWidgets
	(releaseNumberLabel := self newLabel)
		label: 'Version number:'.
	(releaseNumber := self newTextInput)
		autoAccept: true.

	(symbolicVersionResolutionCheckBox := self newCheckBox)
		label: 'Resolve symbolic dependencies? (e.g. stable -> 3.0)';
		state: true;
		whenBuiltDo: [ symbolicVersionResolutionCheckBox labelOnLeft.
						releaseNumber accept: self nextVersionString ];
		whenDesactivatedDo: [ self confirmSymbolicVersionResolutionDesactivation ].! !

!VersionnerReleasePanel methodsFor: 'private' stamp: 'ChristopheDemarey 4/2/2014 14:00'!
nextVersionString
	^ self latestVersionString 
		ifNotNil:  [ :versionString | | lastPointIndex |
					lastPointIndex := versionString 
						lastIndexOf: $. 
						ifAbsent: [ nil ].
					lastPointIndex 
						ifNil: [ (versionString asInteger + 1) asString ]
						ifNotNil: [ | newMinorVersion |
								newMinorVersion := (versionString allButFirst: lastPointIndex) asInteger + 1.
								(versionString  copyFrom: 1 to: lastPointIndex) , (newMinorVersion asString) ] ]
		ifNil: [ '1.0' ] ! !

!VersionnerReleasePanel methodsFor: 'api' stamp: 'ChristopheDemarey 3/11/2014 18:07'!
initialVersion: aString
	releaseNumber text: aString.! !

!VersionnerReleasePanel methodsFor: 'api' stamp: 'ChristopheDemarey 3/17/2014 13:17'!
isSymbolicVersionResolutionChecked
	^ symbolicVersionResolutionCheckBox state! !

!VersionnerReleasePanel methodsFor: 'private' stamp: 'ChristopheDemarey 4/2/2014 11:07'!
latestVersionString
	| latestVersion |
	
	latestVersion := (developmentVersion project versions 
		reject: [ :aVersion |  #(baseline broken) includes: aVersion blessing ])
		detectMax: [ :aVersion | aVersion ].
	^ latestVersion 
		ifNotNil:  [ latestVersion versionString ]
		ifNil: [ nil ] ! !

!VersionnerReleasePanel methodsFor: 'accessing' stamp: 'ChristopheDemarey 3/14/2014 17:28'!
developmentVersion: aVersion
	developmentVersion := aVersion! !

!VersionnerReleasePanel methodsFor: 'initialization' stamp: 'ChristopheDemarey 3/11/2014 17:30'!
title
	^ 'Release a new version'! !

!VersionnerReleasePanel methodsFor: 'confirmation' stamp: 'ChristopheDemarey 3/18/2014 10:34'!
confirmSymbolicVersionResolutionDesactivation
	(UIManager default confirm: 'Are you sure you do not want to resolve symbolic versions? It will lead to unreproductable loads.')
		ifFalse: [ symbolicVersionResolutionCheckBox state: true ]! !

!VersionnerReleasePanel methodsFor: 'accessing' stamp: 'ChristopheDemarey 3/11/2014 15:58'!
releaseNumberLabel
	^ releaseNumberLabel! !

!VersionnerReleasePanel methodsFor: 'accessing' stamp: 'ChristopheDemarey 3/11/2014 15:58'!
releaseNumber
	^ releaseNumber! !

!VersionnerReleasePanel methodsFor: 'initialization' stamp: 'ChristopheDemarey 3/11/2014 17:32'!
initialExtent
	^ 500 @ 120! !

!VersionnerReleasePanel class methodsFor: 'spec' stamp: 'ChristopheDemarey 3/11/2014 18:05'!
defaultSpec
	"Define the layout of the Release Panel"

	<spec>
	^ SpecLayout composed
		newColumn: [ :c | 
					c
						newRow: [ :r1 | 
									r1
										add: #releaseNumberLabel origin: 0@0 corner: 1@1;
										add: #releaseNumber origin: 0@40 corner: 1@100]
							height: self inputTextHeight;
						newRow: [ :r2 | 
									r2 add: #symbolicVersionResolutionCheckBox ]
							height: self inputTextHeight ];
		yourself! !

!VersionnerReleasePanel class methodsFor: 'instance creation' stamp: 'ChristopheDemarey 3/14/2014 17:29'!
openForVersion: developmentVersion
	| releasePanel |
	
	releasePanel := self new.
	releasePanel developmentVersion: developmentVersion.
	^ releasePanel openDialogWithSpec! !

!VersionnerRepositoriesManager commentStamp: 'ChristopheDemarey 1/17/2014 16:28'!
A VersionnerRepositoriesManager allows to select / deselect  / add new repositories. The UI is shared with Komitter.!
!VersionnerRepositoriesManager methodsFor: 'ui' stamp: 'ChristopheDemarey 1/17/2014 16:27'!
open
	| dialog |
	dialog := remotesUI openDialogWithSpec.
	dialog okAction: [  ]! !

!VersionnerRepositoriesManager methodsFor: 'initialization' stamp: 'ChristopheDemarey 1/17/2014 15:47'!
initialize

	super initialize.
	remotesUI := RemotesManager new.! !

!VersionnerRepositoriesManager methodsFor: 'accessing' stamp: 'ChristopheDemarey 1/17/2014 10:36'!
packageName: aString
	packageName := aString! !

!VersionnerRepositoriesManager methodsFor: 'initialization' stamp: 'TorstenBergmann 11/19/2014 10:04'!
initializeSelectedRemotes
	| workingCopy |
	
	workingCopy := MCWorkingCopy allManagers detect: [ :wc | wc package name = packageName ].
	remotesUI selectedRemotes: workingCopy repositoryGroup repositories asOrderedCollection.
	remotesUI initializeWidgets.
	remotesUI initializePresenter
! !

!VersionnerRepositoriesManager methodsFor: 'protocol' stamp: 'ChristopheDemarey 1/17/2014 15:11'!
selectedChangedBlock: aBlock
	remotesUI selectedChangedBlock: aBlock! !

!VersionnerRepositoriesManager class methodsFor: 'instance creation' stamp: 'ChristopheDemarey 1/17/2014 17:48'!
newWithPackage: aPackageName
	| repoManager |
	
	repoManager := self new.
	aPackageName ifNotNil: [ repoManager 
								packageName: aPackageName;
								initializeSelectedRemotes;
								yourself ].
	^ repoManager! !

!VersionnerSpecBrowser commentStamp: '<historical>'!
Tool used to manage project dependencies.
This tool uses ToolBox and Metacello to manage project dependencies (ConfigurationOf*).
The GUI is built with Spec.

You can find Versionner in the World menu (Tools category).
Otherwise, you can launch it with : 
  VersionnerSpecBrowser open.
!
!VersionnerSpecBrowser methodsFor: 'initialization' stamp: 'ChristopheDemarey 3/20/2015 10:12'!
unregister
	"Unregister from the dependent object. Typically used when closing the browser"
	
	MBConfigurationRoot current announcer unsubscribe: self.
	SystemAnnouncer uniqueInstance unsubscribe: self! !

!VersionnerSpecBrowser methodsFor: 'accessing' stamp: 'JuanPabloSandovalAlcocer 6/30/2012 18:29'!
toolbar

	^ toolbar.! !

!VersionnerSpecBrowser methodsFor: 'actions' stamp: 'JuanPabloSandovalAlcocer 6/30/2012 20:35'!
windowIsClosing
	self unregister.! !

!VersionnerSpecBrowser methodsFor: 'initialization' stamp: 'ChristopheDemarey 3/19/2015 16:41'!
register
	"Set up dependencies"
	
	MBConfigurationRoot current announcer weak
		when: MBConfigurationInfoCreated send: #refresh to: self;
		when: MBConfigurationInfoChanged send: #refresh to: self;
		when: MBConfigurationInfoDeleted send: #refresh to: self;
		when: MBInfoListChanged send: #refresh to: self.
	SystemAnnouncer uniqueInstance weak
		when: MCPackageModified send: #refresh to: self.
! !

!VersionnerSpecBrowser methodsFor: 'initialization' stamp: 'ChristopheDemarey 3/20/2015 10:15'!
initializeWidgets
	"configurations"
	configurationList := (self instantiate: NewListModel)
		icons: [ :configuration | self iconForConfiguration: configuration ];
		displayBlock: [:item | item asStringMorph ]; 
		iconMaxSize: 16@16;
		handlesDoubleClick: true;
		on: PharoShortcuts current browseShortcut 
			do: [ configurationList selectedItem 
					ifNotNilDo: [ :selection | selection configurationClass browse ] ];
		doubleClickAction: [ configurationList selectedItem ifNotNilDo: [ :selection | 
				self browseConfiguration: selection ] ];
		yourself.
	
	"toolbar"
	toolbar := self instantiate: VersionnerToolBar.! !

!VersionnerSpecBrowser methodsFor: 'accessing' stamp: 'TorstenBergmann 2/12/2014 17:43'!
iconForConfiguration: aConfiguration

	"should return an IconMorph"
	^ (aConfiguration isDirty)
					ifTrue:  [ self class configurationChangedIcon] 
					ifFalse: [ self class configurationLoadedIcon ].! !

!VersionnerSpecBrowser methodsFor: 'accessing' stamp: 'ChristopheDemarey 2/14/2013 16:47'!
configurationList
	
	^ configurationList! !

!VersionnerSpecBrowser methodsFor: 'menu' stamp: 'ChristopheDemarey 2/6/2014 12:53'!
loadMenuFor: mbInfo in: aMenu 
	| commands menuGroup |
	
	"dynamic menu"
	commands := mbInfo commands collect: [ :commandClass |
												commandClass target: mbInfo for: (configurationList selectedItem) ].
	commands := commands asArray sort: [:a :b | a order <= b order].
	
	menuGroup := MenuGroupModel new.
	commands do: [ :command |
		menuGroup addMenuItem: 
			(MenuItemModel new
				name: command title;
				action: [ self unregister.
						 command execute.
						 self register ]) ].
	aMenu addMenuGroup: menuGroup.
	^aMenu! !

!VersionnerSpecBrowser methodsFor: 'initialization' stamp: 'ChristopheDemarey 10/17/2012 14:57'!
initialize 
	super initialize.
	self register.! !

!VersionnerSpecBrowser methodsFor: 'api' stamp: 'ChristopheDemarey 12/13/2013 14:00'!
browseConfiguration: aConfiguration
	aConfiguration recalculate.
	^ VersionnerProjectBrowser openOn: aConfiguration.! !

!VersionnerSpecBrowser methodsFor: 'actions' stamp: 'ChristopheDemarey 2/21/2014 09:50'!
refresh
	self configurationList: self class imageConfigurations! !

!VersionnerSpecBrowser methodsFor: 'initialization' stamp: 'ChristopheDemarey 2/14/2014 10:58'!
initializePresenter
	"Initialize widgets behavior"
	configurationList
		whenSelectedItemChanged: [ :selection | 
			selection
				ifNil: [ toolbar openButton enabled: false ]
				ifNotNil: [ toolbar openButton enabled: true.
						configurationList menu: [ :aMenu | self loadMenuFor: selection in: aMenu ] ] ].
			! !

!VersionnerSpecBrowser methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/11/2013 13:14'!
title
	^ 'Versionner- Configuration list'! !

!VersionnerSpecBrowser methodsFor: 'accessing' stamp: 'ChristopheDemarey 2/14/2013 16:50'!
configurationList: aList
	"Here I reroute my entry point to the list model's entry point"
	self configurationList items: aList.! !

!VersionnerSpecBrowser methodsFor: 'initialization' stamp: 'ChristopheDemarey 7/11/2013 13:34'!
initialExtent

	 ^  (400.0@500.0)! !

!VersionnerSpecBrowser class methodsFor: 'spec' stamp: 'ChristopheDemarey 7/11/2013 13:11'!
defaultSpec
	"Define the layout of the Versionner Browser"
	^ SpecLayout composed
		newColumn: [ :column | 
			column
				add: #toolbar height: self toolbarHeight;
				add: #configurationList ];
	yourself.
 ! !

!VersionnerSpecBrowser class methodsFor: 'ui' stamp: 'ChristopheDemarey 2/14/2014 15:01'!
menuCommandOn: aBuilder
	<worldMenu>

	(aBuilder item: #VersionnerSpecBrowser)
		order: 0.21;
		parent: #Tools;
		label: 'Versionner';
		icon: (Smalltalk ui icons iconNamed: #databaseIcon);
		action: [ VersionnerSpecBrowser open ]! !

!VersionnerSpecBrowser class methodsFor: 'configurations' stamp: 'ChristopheDemarey 2/14/2014 11:18'!
testConfigurations
	^ #( 'ConfigurationOfVersionnerTestBitmapCharacterSet' . 
		'ConfigurationOfVersionnerTestXMLParserTemplate' .
		'ConfigurationOfVersionnerTestXMLWriter' .
		'MetacelloBaseConfiguration' .
		'MetacelloExampleProjectConfig' .
		'MetacelloMCTestsAbstractConfig' )! !

!VersionnerSpecBrowser class methodsFor: 'ui' stamp: 'ChristopheDemarey 2/14/2013 16:50'!
openOn: configurations
	| browser |
	browser := self new. 
	browser configurationList: configurations.
	browser openWithSpec.
	^ browser.! !

!VersionnerSpecBrowser class methodsFor: 'ui' stamp: 'JuanPabloSandovalAlcocer 6/30/2012 20:36'!
clean
	self allInstances do:[ :a| a unregister].
	Smalltalk garbageCollect.! !

!VersionnerSpecBrowser class methodsFor: 'icons' stamp: 'TorstenBergmann 2/12/2014 17:44'!
configurationLoadedIcon
	^Smalltalk ui icons configIconLoaded! !

!VersionnerSpecBrowser class methodsFor: 'ui' stamp: 'ChristopheDemarey 2/14/2014 11:12'!
open
	|windows|
	windows := self openOn: self imageConfigurations.
	^ windows.! !

!VersionnerSpecBrowser class methodsFor: 'configurations' stamp: 'ChristopheDemarey 2/14/2014 11:15'!
imageConfigurations
	| configs |
	
	configs := MBConfigurationRoot current configurations.
	configs := configs reject: [ :config | self testConfigurations includes: config name ].
	^ configs! !

!VersionnerSpecBrowser class methodsFor: 'icons' stamp: 'TorstenBergmann 2/12/2014 17:43'!
configurationChangedIcon
	^Smalltalk ui icons configIconDirty ! !

!VersionnerToolBar commentStamp: '<historical>'!
Versionner configuration list toolBar spec definition.
!
!VersionnerToolBar methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/11/2013 13:32'!
loadButton
	^ loadButton! !

!VersionnerToolBar methodsFor: 'accessing' stamp: 'ChristopheDemarey 7/11/2013 13:32'!
newButton
	^ newButton! !

!VersionnerToolBar methodsFor: 'initialization' stamp: 'ChristopheDemarey 2/14/2014 10:44'!
initializeWidgets
	newButton := (self instantiate: ButtonModel)
		label: ' New project';
		icon: self class newIcon;
		help: 'Create a new project (configuration). Once created, double-click on the projet to edit it';
		yourself.
	
	loadButton := (self instantiate: ButtonModel)
		label: ' Load project';
		icon: self class loadIcon;
		help: 'Load an existing project (only its configuration) into the image';
		yourself.

	openButton := (self instantiate: ButtonModel)
		label: ' Open project';
		icon: self class openIcon;
		help: 'Open a new window on the selected project';
		yourself.
! !

!VersionnerToolBar methodsFor: 'initialization' stamp: 'ChristopheDemarey 2/14/2014 10:30'!
initializePresenter
	"Initialize widgets behavior"

	newButton action: [ self newConfiguration ].
	loadButton action: [ (VSLoadProjectCommand target: self for: self) execute ].
	openButton action: [ owner configurationList selectedItem ifNotNilDo: [ :selection | 
				owner browseConfiguration: selection ]  ].! !

!VersionnerToolBar methodsFor: 'accessing' stamp: 'ChristopheDemarey 2/14/2014 10:26'!
openButton
	^ openButton! !

!VersionnerToolBar methodsFor: 'actions' stamp: 'ChristopheDemarey 2/7/2014 10:28'!
newConfiguration
	| name selection |
	name := UIManager default request: 'Name of the new project'.
	name isEmptyOrNil ifFalse: [ 
		Cursor execute showWhile:  [ | project |
			project := MTProject
				newNamed: name configurationBaseName
				withInitialVersion: '0.1'
				inRepository: nil.
			MCWorkingCopy forPackage: (MCPackage new name: project configurationClass name).
			selection :=  owner configurationList getItems 
					detect: [ :item | item name configurationBaseName = name configurationBaseName].
			owner configurationList setSelectedItem: selection.
			owner browseConfiguration: selection ]  ]! !

!VersionnerToolBar class methodsFor: 'spec' stamp: 'ChristopheDemarey 2/14/2014 10:29'!
defaultSpec
	<spec>

	"Define the layout of the Versionner configuration list toolBar"
	^ SpecLayout composed
		newRow: [ :row | 
			row
				add: #newButton;
				add: #loadButton;
				add: #openButton ];
	yourself.! !

!VersionnerToolBar class methodsFor: 'icons' stamp: 'ChristopheDemarey 2/14/2014 10:46'!
newIcon
	^ Smalltalk ui icons packageAddIcon ! !

!VersionnerToolBar class methodsFor: 'icons' stamp: 'ChristopheDemarey 2/14/2014 10:46'!
loadIcon
	^ Smalltalk ui icons downIcon ! !

!VersionnerToolBar class methodsFor: 'icons' stamp: 'ChristopheDemarey 2/14/2014 10:34'!
openIcon
	^ Smalltalk ui icons openIcon ! !

!VersionnerToolBox commentStamp: 'ChristopheDemarey 2/21/2014 13:50'!
This class is used to fill the gap between Versionner dependencies model and the flatten objects (collections, maps) expected by Metacello ToolBox.!
!VersionnerToolBox methodsFor: 'spec creation' stamp: 'ChristopheDemarey 7/2/2014 23:34'!
projectSpecFromRequiredProject: aRequiredProject
	| mcProject versionString projectReferenceSpec spec |
 
	aRequiredProject configurationClass 
		ifNil: [ ConfigurationNotFound signal: aRequiredProject name , ' configuration class cannot be found!!' ].
	mcProject := aRequiredProject configurationClass project.
	aRequiredProject symbolicVersionString
		ifNil: [ versionString := aRequiredProject version 
						ifNil: [ (mcProject hasVersion: #stable)
        								ifTrue: [ #stable ]
        								ifFalse: [ #bleedingEdge ] ]
						ifNotNilDo: [ :aVersion | aVersion versionString] ]
		ifNotNil: [ versionString := aRequiredProject symbolicVersionString].
	projectReferenceSpec := mcProject projectSpec
					name: aRequiredProject displayName;
					className: aRequiredProject configurationClass name;
					versionString: versionString;
					yourself.
	spec := mcProject projectReferenceSpec
				name: aRequiredProject displayName;
        			projectReference: projectReferenceSpec.

      aRequiredProject repositories do: [ :repoString | spec repository: repoString ].
      aRequiredProject dependencies ifNotEmptyDo: [ :loadsList | spec projectReference loads: loadsList ].

	^ spec! !

!VersionnerToolBox methodsFor: 'initialization' stamp: 'ChristopheDemarey 2/21/2014 13:59'!
initialize
	super initialize.
	metacelloToolBox := MetacelloToolBox new.! !

!VersionnerToolBox class methodsFor: 'spec creation' stamp: 'ChristopheDemarey 2/21/2014 14:56'!
projectSpecFromRequiredProject: aRequiredProject
	^ self new projectSpecFromRequiredProject: aRequiredProject! !

!VersionnerToolBoxTest commentStamp: 'ChristopheDemarey 2/21/2014 14:00'!
test class for the versionner toolbox.!
!VersionnerToolBoxTest methodsFor: 'test data' stamp: 'ChristopheDemarey 2/21/2014 14:23'!
versionnerTestXMLWriter
	^ MTDependantProject new
		name: 'VersionnerTestXMLWriter';
		configurationClass: ConfigurationOfVersionnerTestXMLWriter;
		displayName: 'aProjectAlias'
		yourself.! !

!VersionnerToolBoxTest methodsFor: 'expected results' stamp: 'ChristopheDemarey 2/21/2014 15:51'!
versionnerTestXMLWriterSpec
	^ 'spec 
	name: ''aProjectAlias'';
	projectReference: [
		spec
			className: #ConfigurationOfVersionnerTestXMLWriter;
			versionString: #''stable'' ].'! !

!VersionnerToolBoxTest methodsFor: 'tests' stamp: 'ChristopheDemarey 2/21/2014 15:53'!
testProjectSpecFromRequiredProject
	| spec |
	
	spec := VersionnerToolBox projectSpecFromRequiredProject: self versionnerTestXMLWriter.
	self assert: spec asString equals: self versionnerTestXMLWriterSpec! !

!VileFinalizer commentStamp: '<historical>'!
I am test object used for a WeakRegistry test.
I add myself to a given WeakRegistry and on finalization I modify the very same registry by removing myself from it.!
!VileFinalizer methodsFor: 'finalization' stamp: 'Igor.Stasenko 10/11/2010 13:29'!
finalize
	weakRegistry remove: self ifAbsent: [].! !

!VileFinalizer methodsFor: 'initialize-release' stamp: 'CamilloBruni 4/25/2013 16:18'!
initialize: registry
	weakRegistry := registry.
	weakRegistry add: self.! !

!VirtualMachine commentStamp: 'IgorStasenko 8/16/2011 17:41'!
I am exposing a various attributes of smalltalk virtual machine.


The direct use of this class is not recommended. 

All attributes are normally should be accessed via

Smalltalk vm someAttribute

instead of 

VirtualMachine someAttribute

!
!VirtualMachine methodsFor: 'accessing' stamp: 'MarcusDenker 5/8/2013 11:09'!
binary
	"Answer the a file reference to the virtual machine binary."
	"SmalltalkImage current vmBinary"

	^ FileLocator vmBinary
! !

!VirtualMachine methodsFor: 'accessing' stamp: 'MarcusDenker 5/8/2013 11:54'!
vmFileName
	^ self fileName! !

!VirtualMachine methodsFor: 'parameters' stamp: 'MarcusDenker 5/7/2013 22:54'!
parameterAt: parameterIndex
	"parameterIndex is a positive integer corresponding to one of the VM's internal
	parameter/metric registers.  Answer with the current value of that register.
	Fail if parameterIndex has no corresponding register.
	VM parameters are numbered as follows:
		1	end of old-space (0-based, read-only)
		2	end of young-space (read-only)
		3	end of memory (read-only)
		4	allocationCount (read-only; nil in Cog VMs)
		5	allocations between GCs (read-write; nil in Cog VMs)
		6	survivor count tenuring threshold (read-write)
		7	full GCs since startup (read-only)
		8	total milliseconds in full GCs since startup (read-only)
		9	incremental GCs since startup (read-only)
		10	total milliseconds in incremental GCs since startup (read-only)
		11	tenures of surving objects since startup (read-only)
		12-20 specific to the translating VM
		21	root table size (read-only)
		22	root table overflows since startup (read-only)
		23	bytes of extra memory to reserve for VM buffers, plugins, etc.
		24	memory threshold above whichto shrink object memory (read-write)
		25	memory headroom when growing object memory (read-write)
		26  interruptChecksEveryNms - force an ioProcessEvents every N milliseconds (read-write)
		27	number of times mark loop iterated for current IGC/FGC (read-only) includes ALL marking
		28	number of times sweep loop iterated  for current IGC/FGC (read-only)
		29	number of times make forward loop iterated for current IGC/FGC (read-only)
		30	number of times compact move loop iterated for current IGC/FGC (read-only)
		31	number of grow memory requests (read-only)
		32	number of shrink memory requests (read-only)
		33	number of root table entries used for current IGC/FGC (read-only)
		34	number of allocations done before current IGC/FGC (read-only)
		35	number of survivor objects after current IGC/FGC (read-only)
		36  millisecond clock when current IGC/FGC completed (read-only)
		37  number of marked objects for Roots of the world, not including Root Table entries for current IGC/FGC (read-only)
		38  milliseconds taken by current IGC  (read-only)
		39  Number of finalization signals for Weak Objects pending when current IGC/FGC completed (read-only)
		40  BytesPerWord for this image
		41  imageFormatVersion for the VM
		42	number of stack pages in use (Cog Stack VM only, otherwise nil)
		43	desired number of stack pages (stored in image file header, max 65535; Cog VMs only, otherwise nil)
		44	size of eden, in bytes (Cog VMs only, otherwise nil)
		45	desired size of eden, in bytes (stored in image file header; Cog VMs only, otherwise nil)
		46	size of machine code zone, in bytes (stored in image file header; Cog JIT VM only, otherwise nil)
		47	desired size of machine code zone, in bytes (applies at startup only, stored in image file header; Cog JIT VM only)
		48	various properties of the Cog VM as an integer encoding an array of bit flags.
			 Bit 0: implies the image's Process class has threadId as its 3rd inst var (zero relative)
		49-55 reserved for VM parameters that persist in the image (such as eden above)
		56	number of process switches since startup (read-only)
		57	number of ioProcessEvents calls since startup (read-only)
		58	number of ForceInterruptCheck (Cog VMs) or quickCheckInterruptCalls (non-Cog VMs) calls since startup (read-only)
		59	number of check event calls since startup (read-only)
		60	number of stack page overflows since startup (read-only; Cog VMs only)
		61	number of stack page divorces since startup (read-only; Cog VMs only)"

	<primitive: 254>
	self primitiveFailed! !

!VirtualMachine methodsFor: 'attributes' stamp: 'MarcusDenker 5/8/2013 11:50'!
extraVMMemory: extraBytesToReserve
	"Request that the given amount of extra memory be reserved for use by the virtual machine to leave extra C heap space available for things like plugins, network and file buffers, and so on. This request is stored when the image is saved and honored when the image is next started up. Answer the previous value of this parameter."

	extraBytesToReserve < 0
		ifTrue: [self error: 'VM memory reservation must be non-negative'].
	^ self parameterAt: 23 put: extraBytesToReserve
! !

!VirtualMachine methodsFor: 'accessing' stamp: 'MarcusDenker 5/8/2013 11:51'!
interpreterSourceDate
	"Return the date of changes given by `self interpreterSourceVersion`"
	| dateString parts | 
	
	dateString := (self interpreterSourceVersion splitOn: 'Date: ') second.
	
	dateString first isDigit
		ifTrue: [ 
			"most probably the date is in ISO 8601 Format" 
			^ dateString asDateAndTime ].
		
	"Otherwise assume the old format: DDD MMM DD HH:MM:SS YYYY +TTTT ..."
	parts := dateString substrings first: 6.
	"create a more reasonable string.."
	dateString := String streamContents: [ :s |
		s 
			nextPutAll: (parts at: 5 ); space; "year"
			nextPutAll: (parts at: 2 ); space; "month name"
			nextPutAll: (parts at: 3 ); space; "day of month"
			nextPutAll: (parts at: 4 ); space; "time"
			nextPutAll: (parts last); space    "timezone"].
	^ dateString asDateAndTime ! !

!VirtualMachine methodsFor: 'gc' stamp: 'MarcusDenker 5/8/2013 11:07'!
allocationsBetweenGC
	"allocations between GCs (read-write)"
	^ self parameterAt: 5! !

!VirtualMachine methodsFor: 'attributes' stamp: 'MarcusDenker 5/8/2013 10:58'!
maxExternalSemaphoresSilently: aSize 
	"Changes the size of array where external signals for semaphores in
	externalObjects are handled.. 
	The size can only grow, and will always be the next power of two
	larger than the parameter.
	
	The intended use is to set the table size to some adequate
	maximum as part of a non-resuming image startUp.
	
	Setting this at any time other than start-up can potentially result in
	lost signals during reallocation.
	i.e. Requests handled during copying og signals from old to new array
	won't be seen if they occur to indices already copied, before
	pointers to the new and old arrays are switched."
	self maxExternalSemaphores
		ifNil: [^ 0].
	"The vm-header field where the size is stored is a short, maximum
	64k entries. 
	Well, on most platforms anyways"
	(aSize < 0
			or: [aSize > 65535])
		ifTrue: [^ DomainError signalFrom: 0 to: 65535].
	^ self parameterAt: 49 put: aSize! !

!VirtualMachine methodsFor: 'gc' stamp: 'MarcusDenker 5/8/2013 11:52'!
memoryEnd
	"end of memory"
		
	^ self parameterAt: 3
! !

!VirtualMachine methodsFor: 'parameters' stamp: 'MarcusDenker 5/7/2013 22:54'!
imageVersionNumber
	"Image version number (6505 means the Squeak V3 format with BlockClosure support (but _without_ BlockContext support)"
		
	^ self parameterAt: 41! !

!VirtualMachine methodsFor: 'testing' stamp: 'MarcusDenker 5/7/2013 22:55'!
isRunningCog
	"Returns true if we're running on a Cog VM (JIT or StackInterpreter)
	 (parameterAt: 42 is the number of stack pages)"

	^[(self parameterAt: 42) > 0] on: Error do:[:ex| ex return: false]! !

!VirtualMachine methodsFor: 'modules' stamp: 'MarcusDenker 5/8/2013 10:57'!
disableModuleLoading
	"Primitive. Disable a new module loading mechanism for the rest of current session.
	This operation is not reversable.
	Any subsequent attempts to load either external or internal module(s) will fail"

	<primitive: 'primitiveDisableModuleLoading' module: ''>! !

!VirtualMachine methodsFor: 'gc' stamp: 'MarcusDenker 5/8/2013 11:51'!
gcBiasToGrowLimit: arg
	"Tell the VM the grow limit if the GC logic has bias to grow."
	
	<primitive: 'primitiveSetGCBiasToGrowGCLimit'>
	^self primitiveFailed! !

!VirtualMachine methodsFor: 'accessing' stamp: 'GuillermoPolito 3/4/2015 16:38'!
path
	"Answer the path for the directory containing the Smalltalk virtual machine. Return the 	empty string if this primitive is not implemented."

	"Smalltalk vm path"

	^ FilePathEncoder decode: self primVmPath! !

!VirtualMachine methodsFor: 'accessing' stamp: 'MarcusDenker 5/8/2013 11:53'!
vmDirectory 
	^ self directory
! !

!VirtualMachine methodsFor: 'modules' stamp: 'MarcusDenker 5/8/2013 10:56'!
listBuiltinModules
	"Smalltalk vm listBuiltinModules"

	"Return a list of all builtin modules (e.g., plugins). Builtin plugins are those that are 
	compiled with the VM directly, as opposed to plugins residing in an external shared library. 	
	The list will include all builtin plugins regardless of whether they are currently loaded 
	or not. Note that the list returned is not sorted!!"

	| modules index tname |
	modules := Array new writeStream.
	index := 1.
	[ true ]
		whileTrue: [ 
			tname := self listBuiltinModule: index.
			tname ifNil: [ ^ modules contents ].
			modules nextPut: tname.
			index := index + 1 ]! !

!VirtualMachine methodsFor: 'attributes' stamp: 'MarcusDenker 5/8/2013 11:50'!
flagInterpretedMethods: aBoolean
	"The Cog VM can be instructed to set the flag bit of CompiledMethods that it executes but will only interpret.  This can be used e.g. to profile startup. See CompiledMethod>>#flag & CompiledMethod>>#clearFlag. This flag persists across snapshots, stored in the image header."
	
	self parameterAt: 48 put: ((self parameterAt: 48) bitClear: 2) + (aBoolean ifTrue: [2] ifFalse: [0])! !

!VirtualMachine methodsFor: 'statistics' stamp: 'MarcusDenker 5/8/2013 11:53'!
tenureCount
	"tenures of surving objects since startup (read-only)."

	^ self parameterAt: 11
! !

!VirtualMachine methodsFor: 'gc' stamp: 'MarcusDenker 5/8/2013 11:52'!
setGCBiasToGrow: aNumber
	"Primitive. Indicate that the GC logic should be bias to grow"
	<primitive: 'primitiveSetGCBiasToGrow'>
	^self primitiveFailed
"Example:
	Smalltalk vm  setGCBiasToGrowGCLimit: 16*1024*1024.
	Smalltalk vm setGCBiasToGrow: 1.
"! !

!VirtualMachine methodsFor: 'modules' stamp: 'MarcusDenker 5/8/2013 10:57'!
forgetModule: aString
	"Primitive. If the module named aString is loaded, unloaded. If not, and it is marked an unloadable, unmark it so the VM will try to load it again next time. See comment for #unloadModule:."
	<primitive: 571>
	^self primitiveFailed! !

!VirtualMachine methodsFor: 'attributes' stamp: 'MarcusDenker 5/8/2013 10:58'!
processPreemptionYields: aBoolean
	"The Cog VM can be instructed not to yield on process preemption, i.e. not to put a preempted process at the back of its run queue.  By default preempting a process causes it to yield (Blue Book semantics) which can have unfortunate effects. This flag persists across snapshots, stored in the image header."
	
	self parameterAt: 48 put: ((self parameterAt: 48) bitClear: 4) + (aBoolean ifTrue: [0] ifFalse: [2r100])! !

!VirtualMachine methodsFor: 'modules' stamp: 'MarcusDenker 5/8/2013 10:56'!
listLoadedModule: index
	"Return the name of the n-th loaded module.
	This list is not sorted!!"
	<primitive: 573>
	^self primitiveFailed! !

!VirtualMachine methodsFor: 'accessing' stamp: 'MarcusDenker 5/8/2013 11:52'!
optionAt: i
	"Answer the i-th option of the command line, or nil if not so many options."
	
	^self getSystemAttribute: i negated! !

!VirtualMachine methodsFor: 'accessing' stamp: 'MarcusDenker 5/8/2013 11:50'!
buildDate			
	"Return a String reflecting the build date of the VM"
	"Smalltalk buildDate"

	^self getSystemAttribute: 1006! !

!VirtualMachine methodsFor: 'statistics' stamp: 'MarcusDenker 5/7/2013 22:51'!
statisticsReport
	"Workspace openContents: (Smalltalk vm statisticsReport) label: 'VM Statistics'"

	| oldSpaceEnd youngSpaceEnd memoryEnd fullGCs fullGCTime incrGCs incrGCTime tenureCount upTime upTime2 fullGCs2 fullGCTime2 incrGCs2 incrGCTime2 tenureCount2 str |
	oldSpaceEnd		:= self oldSpaceEnd.
	youngSpaceEnd		:= self youngSpaceEnd.
	tenureCount			:= self tenureCount.
	memoryEnd			:= self memoryEnd.
	fullGCs				:= self fullGCCount.
	fullGCTime			:= self totalFullGCTime.
	incrGCs				:= self incrementalGCCount.
	incrGCTime			:= self totalIncrementalGCTime.
 
	upTime := Time millisecondClockValue.
	str := (String new: 1000) writeStream.
	str	<< 'uptime			';
		print: (upTime / 1000 / 60 // 60); nextPut: $h;
		print: (upTime / 1000 / 60 \\ 60) asInteger; nextPut: $m;
		print: (upTime / 1000 \\ 60) asInteger; nextPut: $s; cr.

	str	<< 'memory			'.
	memoryEnd printWithCommasOn: str.
	str << ' bytes'; cr.
	str	<<	'	old			'.
	oldSpaceEnd printWithCommasOn: str.
	str << ' bytes (';
		print: ((oldSpaceEnd / memoryEnd * 100) roundTo: 0.1); << '%)'; cr.
	str	<< '	young		'.
	(youngSpaceEnd - oldSpaceEnd) printWithCommasOn: str.
	str << ' bytes (';
		print: ((youngSpaceEnd - oldSpaceEnd / memoryEnd * 100) roundTo: 0.1); << '%)'; cr.
	str	<< '	used		'.
	youngSpaceEnd printWithCommasOn: str.
	str << ' bytes (';
		print: ((youngSpaceEnd / memoryEnd * 100) roundTo: 0.1); << '%)'; cr.
	str	<< '	free		'.
	(memoryEnd - youngSpaceEnd) printWithCommasOn: str.
	str << ' bytes (';
		print: ((memoryEnd - youngSpaceEnd / memoryEnd * 100) roundTo: 0.1); << '%)'; cr.

	str	<< 'GCs				'.
	(fullGCs + incrGCs) printWithCommasOn: str.
	fullGCs + incrGCs > 0 ifTrue: [
		str
			<< ' ('; 
			print: ((upTime / (fullGCs + incrGCs)) roundTo: 1); 
			<< 'ms between GCs)'
	].
	str cr.
	str	<< '	full			';
		print: fullGCs; << ' totalling '.
	fullGCTime printWithCommasOn: str.
	str << 'ms (';
		print: ((fullGCTime / upTime * 100) roundTo: 0.1);
		<< '% uptime)'.
	fullGCs = 0 ifFalse:
		[str	<< ', avg '; print: ((fullGCTime / fullGCs) roundTo: 0.1); << 'ms'].
	str	cr.
	str	<< '	incr		';
		print: incrGCs; << ' totalling '.
	incrGCTime printWithCommasOn: str.
	str << 'ms (';
		print: ((incrGCTime / upTime * 100) roundTo: 0.1);
		<< '% uptime), avg '; print: ((incrGCTime / incrGCs) roundTo: 0.1); << 'ms'; cr.
	str	<< '	tenures		'.
	tenureCount printWithCommasOn: str.
	tenureCount = 0 ifFalse:
		[str << ' (avg '; print: (incrGCs / tenureCount) asInteger; << ' GCs/tenure)'].
	str	cr.

LastStats ifNil: [LastStats := Array new: 6]
ifNotNil: [
	upTime2 := upTime - (LastStats at: 1).
	fullGCs2 := fullGCs - (LastStats at: 2).
	fullGCTime2 := fullGCTime - (LastStats at: 3).
	incrGCs2 := incrGCs - (LastStats at: 4).
	incrGCTime2 := incrGCTime - (LastStats at: 5).
	tenureCount2 := tenureCount - (LastStats at: 6).

	str	<<  'Since last view	'.
	(fullGCs2 + incrGCs2) printWithCommasOn: str.
	fullGCs2 + incrGCs2 > 0 ifTrue: [
		str
			<< ' ('; 
			print: ((upTime2 / (fullGCs2 + incrGCs2)) roundTo: 1); 
			<< 'ms between GCs)'.
	].
	str cr.
	str	<< '	uptime		'; print: ((upTime2 / 1000.0) roundTo: 0.1); << 's'; cr.
	str	<< '	full			';
		print: fullGCs2; << ' totalling '.
	fullGCTime2 printWithCommasOn: str.
	str << 'ms (';
		print: ((fullGCTime2 / upTime2 * 100) roundTo: 0.1);
		<< '% uptime)'.
	fullGCs2 = 0 ifFalse:
		[str	<< ', avg '; print: ((fullGCTime2 / fullGCs2) roundTo: 0.1); << 'ms'].
	str	cr.
	str	<< '	incr		';
		print: incrGCs2; << ' totalling '.
	incrGCTime2 printWithCommasOn: str.
	str << 'ms (';
		print: ((incrGCTime2 / upTime2 * 100) roundTo: 0.1);
		<< '% uptime), avg '.
	incrGCs2 > 0 ifTrue: [
		 str print: ((incrGCTime2 / incrGCs2) roundTo: 0.1); << 'ms'
	].
	str cr.
	str	<< '	tenures		'.
	tenureCount2 printWithCommasOn: str.
	tenureCount2 = 0 ifFalse:
		[str << ' (avg '; print: (incrGCs2 / tenureCount2) asInteger; << ' GCs/tenure)'].
	str	cr.
].
	LastStats at: 1 put: upTime.
	LastStats at: 2 put: fullGCs.
	LastStats at: 3 put: fullGCTime.
	LastStats at: 4 put: incrGCs.
	LastStats at: 5 put: incrGCTime.
	LastStats at: 6 put: tenureCount.

	^ str contents
! !

!VirtualMachine methodsFor: 'accessing' stamp: 'MarcusDenker 5/8/2013 11:50'!
directory
	"Answer the a file reference to the directory containing the Smalltalk virtual machine."
	"SmalltalkImage current directory"

	^ FileLocator vmDirectory
! !

!VirtualMachine methodsFor: 'attributes' stamp: 'MarcusDenker 5/8/2013 11:50'!
getSystemAttribute: attributeID 
	"Optional. Answer the string for the system attribute with the given 
	integer ID. Answer nil if the given attribute is not defined on this 
	platform. On platforms that support invoking programs from command 
	lines (e.g., Unix), this mechanism can be used to pass command line 
	arguments to programs written in Pharo.

	By convention, the first command line argument that is not a VM
	configuration option is considered a 'document' to be filed in. Such a
	document can add methods and classes, can contain a serialized object,
	can include code to be executed, or any combination of these.

	Currently defined attributes include: 
	-1000   1000th command line argument that specify VM options
   	...
	-1              first command line argument that specify VM options
      0               the full path name for currently executing VM
                       (or, on some platforms, just the path name of the VM's directory)
       1               full path name of this image (better use primImageName instead)
       2               a Squeak document to open, if any
       3               first command line argument for Squeak programs
       ...
       1000    1000th command line argument for Squeak programs
       1001    this platform's operating system 'Mac OS', 'Win32', 'unix', ...
       1002    operating system version
       1003    this platform's processor type
       1004    vm version
       1005    window system name
       1006    vm build id
       1007    Interpreter class (Cog VM only)
       1008    Cogit class (Cog VM only)
       1201    max filename length (Mac OS only)
       1202    file last error (Mac OS only)
       10001   hardware details (Win32 only)
       10002   operating system details (Win32 only)
       10003   graphics hardware details (Win32 only)"

	<primitive: 149>
	^ nil! !

!VirtualMachine methodsFor: 'gc' stamp: 'MarcusDenker 5/8/2013 11:51'!
gcBiasToGrow: aBool
	"Tell the VM to grow after tenures instead of running in a tight loop where it does IGCs over and over. For some weird reason the primitive takes an integer not a bool but oh well..."
	
	self primitiveGCBiasToGrow: (aBool ifTrue: [1] ifFalse: [0])! !

!VirtualMachine methodsFor: 'testing' stamp: 'MarcusDenker 5/7/2013 22:55'!
isRunningCogit
	"Returns true if we're running on the Cog JIT
	 (vmParameterAt: 46 is the size of the machine code zone)"

	^[(self parameterAt: 46) > 0] on: Error do:[:ex| ex return: false]! !

!VirtualMachine methodsFor: 'accessing' stamp: 'MarcusDenker 5/8/2013 11:51'!
fullPath
	"Return the full vm path as a string"
	"Ex: '/Applications/Squeak/Squeak 4.2.5beta1U.app/Contents/MacOS/Squeak VM Opt'"
	"SmalltalkImage current vmFullPath"

	^self getSystemAttribute: 0! !

!VirtualMachine methodsFor: '*GT-Spotter' stamp: 'TudorGirba 3/30/2015 22:29'!
canHandleShiftPressed
	^ self interpreterSourceDate < 2015 asYear ! !

!VirtualMachine methodsFor: 'primitives' stamp: 'MarcusDenker 5/7/2013 22:56'!
primVmPath
	"Answer the path for the directory containing the Smalltalk virtual machine. Return the empty string if this primitive is not implemented."
	"Smalltalk vmPath"

	<primitive: 142>
	^ ''! !

!VirtualMachine methodsFor: 'modules' stamp: 'MarcusDenker 5/8/2013 02:26'!
listLoadedModules
	"SmalltalkImage current listLoadedModules"
	"Return a list of all currently loaded modules (e.g., plugins). Loaded modules are those that currently in use (e.g., active). The list returned will contain all currently active modules regardless of whether they're builtin (that is compiled with the VM) or external (e.g., residing in some external shared library). Note that the returned list is not sorted!!"
	| modules index tname |
	modules := Array new writeStream.
	index := 1.
	[true] whileTrue: [
		tname := self listLoadedModule: index.
		tname ifNil:[^modules contents].
		modules nextPut: tname.
		index := index + 1.
	].! !

!VirtualMachine methodsFor: 'gc' stamp: 'MarcusDenker 5/8/2013 11:53'!
setGCParameters
	"Adjust the VM's default GC parameters to avoid premature tenuring."

	self allocationsBetweenGC: 4000.  "do an incremental GC after this many allocations"
	self tenuringThreshold: 2000.  "tenure when more than this many objects survive the GC"
	self setGCBiasToGrowGCLimit: 16*1024*1024.
	self setGCBiasToGrow: 1.
! !

!VirtualMachine methodsFor: 'accessing' stamp: 'MarcusDenker 5/8/2013 11:53'!
versionLabel
	"The use of this primitive not recommended. Not all VMs providing that"

	"Answer a string corresponding to the version of virtual machine. This
	represents the version level of the Smalltalk source code (interpreter
	and various plugins) that is translated to C by a CCodeGenerator,  in
	addition to the external platform source code, typically written in C and
	managed separately for each platform.
	
	This invokes an optional primitive that may not be available on all virtual
	machines. See also vmVersion, which answers a string identifying the image
	from which virtual machine sources were generated."

	"Smalltalk vm versionLabel"

	<primitive: 'primitiveVMVersion'>
	self notify: 'This virtual machine does not support the optional primitive #primitiveVMVersion' translated.
	^''! !

!VirtualMachine methodsFor: 'gc' stamp: 'MarcusDenker 5/8/2013 11:53'!
setGCSemaphore: semaIndex
	"Primitive. Indicate the GC semaphore index to be signaled on GC occurance."
	<primitive: 'primitiveSetGCSemaphore'>
	^self primitiveFailed
"Example:

	| index sema process |
	sema := Semaphore new.
	index := Smalltalk registerExternalObject: sema.
	Smalltalk setGCSemaphore: index.
	process := [
		[[true] whileTrue:[
			sema wait.
			Smalltalk beep.
		]] ensure:[
			Smalltalk setGCSemaphore: 0.
			Smalltalk unregisterExternalObject: sema.
		].
	] fork.
	process inspect.
"! !

!VirtualMachine methodsFor: 'primitives' stamp: 'MarcusDenker 5/7/2013 22:56'!
primitiveGCBiasToGrow: arg
	"Tell the VM to grow after tenures instead of running in a tight loop where it does IGCs over and over. For some weird reason the primitive takes an integer not a bool but oh well..."
	
	<primitive: 'primitiveSetGCBiasToGrow'>
	^self primitiveFailed! !

!VirtualMachine methodsFor: 'gc' stamp: 'MarcusDenker 5/8/2013 10:57'!
voidCogVMState
	"Void any internal caches the VM maintains other than the method lookup caches.
	 These comprise
		- the stack zone, where method activations are stored, and
		- the machine code zone, where the machine code form of CompiledMethods is held."
	<primitive: 214>
	^self primitiveFailed! !

!VirtualMachine methodsFor: 'attributes' stamp: 'MarcusDenker 5/8/2013 10:58'!
processHasThreadIdInstVar: aBoolean
	"The threaded VM needs to know if the 4th inst var of Process
	 is threadId which it uses to control process-to-thread binding.
	 This flag persists across snapshots, stored in the image header."
	aBoolean ifTrue: [self assert: (Process instVarNames at: 4) ='threadId'].
	self parameterAt: 48 put: ((self parameterAt: 48) bitClear: 1) + (aBoolean asBit)
	
! !

!VirtualMachine methodsFor: 'statistics' stamp: 'MarcusDenker 5/8/2013 11:53'!
totalIncrementalGCTime
	"Answer the total time in milliseconds spent in incremental GCs since startup (read-only)."

	^ self parameterAt: 10
! !

!VirtualMachine methodsFor: 'accessing' stamp: 'MarcusDenker 5/8/2013 11:50'!
command
	"return a bash-like lauch command for the vm including all arguments up to the image name "
	^ String streamContents: [ :s|
		s nextPutAll: (self optionAt: 0).
		Smalltalk commandLine options 
			do: [ :argument|
				(argument endsWith: '.image')
					ifTrue: [ ^ s contents ].
				
				s space; nextPutAll: argument]]! !

!VirtualMachine methodsFor: 'parameters' stamp: 'MarcusDenker 5/7/2013 22:55'!
getParameters	
	"Answer an Array containing the current values of the VM's internal
	parameter/metric registers.  Each value is stored in the array at the
	index corresponding to its VM register.  (See #vmParameterAt: and
	#vmParameterAt:put:.)"
	"Smalltalk vm getParameters"
	
	<primitive: 254>
	self primitiveFailed! !

!VirtualMachine methodsFor: 'modules' stamp: 'MarcusDenker 5/8/2013 02:26'!
loadModule: aModuleName
	"Primitive. Attempt to load a module of the given name.
	Fail if module cannot be found, or cannot be loaded,
	or failed to initialize"

	<primitive: 'primLoadModule'  module: '' error: errorCode >
	^ self primitiveFailed! !

!VirtualMachine methodsFor: 'gc' stamp: 'MarcusDenker 5/8/2013 11:51'!
incrementalGCCount
	"Answer the total number of incremental GCs since startup (read-only)."

	^ self parameterAt: 9
! !

!VirtualMachine methodsFor: 'accessing' stamp: 'MarcusDenker 5/8/2013 11:51'!
imagePath
	"Image file path
	Ex:  '/Users/foo/Pharo/Pharo-1.1.1-dev10.09.1.image'"
	^ Smalltalk image imagePath! !

!VirtualMachine methodsFor: 'parameters' stamp: 'MarcusDenker 5/7/2013 22:54'!
parameterAt: parameterIndex put: newValue
	"parameterIndex is a positive integer corresponding to one of the VM's internal
	parameter/metric registers.  Store newValue (a positive integer) into that
	register and answer with the previous value that was stored there.
	Fail if newValue is out of range, if parameterIndex has no corresponding
	register, or if the corresponding register is read-only."

	<primitive: 254>
	self primitiveFailed! !

!VirtualMachine methodsFor: 'accessing' stamp: 'MarcusDenker 5/8/2013 11:50'!
documentPath
	"Answer the absolute path of the document passed to the vm or nil if none."
	"Smalltalk commandLine documentPath"
	
	^self getSystemAttribute: 2! !

!VirtualMachine methodsFor: 'gc' stamp: 'MarcusDenker 5/8/2013 11:52'!
setGCBiasToGrowGCLimit: aNumber
	"Primitive. Indicate that the bias to grow logic should do a GC after aNumber Bytes"
	<primitive: 'primitiveSetGCBiasToGrowGCLimit'>
	^self primitiveFailed
"Example:
	Smalltalk vm setGCBiasToGrowGCLimit: 16*1024*1024.
"! !

!VirtualMachine methodsFor: 'accessing' stamp: 'MarcusDenker 5/8/2013 11:52'!
options
	"return an array with all the options passed to the VM (up to the image) "
	^ Array streamContents: [ :s|
		Smalltalk commandLine options 
			do: [ :argument|
				(argument endsWith: '.image')
					ifTrue: [ ^ s contents ].
				
				s nextPut: argument ]]! !

!VirtualMachine methodsFor: 'accessing' stamp: 'MarcusDenker 5/8/2013 11:51'!
imageFile
	"Image file "
	^ Smalltalk image imageFile! !

!VirtualMachine methodsFor: 'attributes' stamp: 'MarcusDenker 5/8/2013 11:50'!
cogitClass
	"Return the jit class that is currently executing the system (Cog VM only)"
	^self getSystemAttribute: 1008! !

!VirtualMachine methodsFor: 'attributes' stamp: 'MarcusDenker 5/8/2013 11:50'!
extraVMMemory
	"Answer the current setting of the 'extraVMMemory' VM parameter. See the comment in extraVMMemory: for details."

	^ self parameterAt: 23
! !

!VirtualMachine methodsFor: 'accessing' stamp: 'CamilloBruni 9/7/2013 11:28'!
fileName
	^ FilePathEncoder decode: self fullPath! !

!VirtualMachine methodsFor: 'accessing' stamp: 'MarcusDenker 5/8/2013 11:52'!
maxFilenameLength
	"Return the maximal filename length (only under MacOS)"
	"Smalltalk vm maxFilenameLength"

	^ self getSystemAttribute: 1201! !

!VirtualMachine methodsFor: 'gc' stamp: 'MarcusDenker 5/8/2013 11:52'!
oldSpaceEnd
	"end of old-space (0-based, read-only)"
		

	^ self parameterAt: 1
! !

!VirtualMachine methodsFor: 'testing' stamp: 'MarcusDenker 5/7/2013 22:56'!
processPreemptionYields
	"Answer whether the VM causes a process to yield on process preemption, i.e. to put a preempted process at the back of its run queue.  If the parameter is unavailable (non-Cog VMs) or bit 2 (4) is 0 then preemption yields."

	^(([self parameterAt: 48]
			on: Error
			do: [:ex| ^true]) allMask: 2r100) not! !

!VirtualMachine methodsFor: 'modules' stamp: 'MarcusDenker 5/8/2013 10:56'!
listBuiltinModule: index
	"Return the name of the n-th builtin module.
	This list is not sorted!!"
	<primitive: 572>
	^self primitiveFailed! !

!VirtualMachine methodsFor: 'accessing' stamp: 'MarcusDenker 5/8/2013 11:51'!
interpreterClass
	"Return the interpreter class that is currently executing the system (Cog VM only)"
	^ self getSystemAttribute: 1007! !

!VirtualMachine methodsFor: 'gc' stamp: 'MarcusDenker 5/8/2013 11:53'!
tenuringThreshold
	"survivor count tenuring threshold (read-write)"
	^ self parameterAt: 6! !

!VirtualMachine methodsFor: 'gc' stamp: 'MarcusDenker 5/8/2013 11:53'!
tenuringThreshold: anInteger
	"survivor count tenuring threshold (read-write).
	tenure when more than this many objects survive the GC"
	
	^ self parameterAt: 6 put: anInteger! !

!VirtualMachine methodsFor: 'statistics' stamp: 'MarcusDenker 5/8/2013 11:53'!
totalGCTime
	^ self totalFullGCTime + self totalIncrementalGCTime! !

!VirtualMachine methodsFor: 'accessing' stamp: 'CamilloBruni 6/17/2013 16:28'!
optionDash
	"VMs release in Mai 2013 use -- instead of - for VM command line options"
	^ (Smalltalk vm interpreterSourceDate > '2013-05-17' asDate)
		ifTrue: [ '--' ]
		ifFalse: [ '-' ]! !

!VirtualMachine methodsFor: 'statistics' stamp: 'MarcusDenker 5/8/2013 11:51'!
fullGCCount
	"Answer the total number of full GCs since startup (read-only)."

	^ self parameterAt: 7
! !

!VirtualMachine methodsFor: 'attributes' stamp: 'MarcusDenker 5/8/2013 11:49'!
maxExternalSemaphores
	"The size of array in some VM's where external signals for
	semaphores in externalObjects are handled.
	Essentially, if a semaphore is registered in externalObjects outside
	its bounds, they will not be signalled."
	^ [self parameterAt: 49]
		on: PrimitiveFailed
		do: [:ex | ex return: nil]! !

!VirtualMachine methodsFor: 'accessing' stamp: 'MarcusDenker 5/8/2013 11:51'!
interpreterSourceVersion
	"The use of this primitive not recommended. Not all VMs providing that"

	"Answer a string corresponding to the version of the interpreter source.
	This represents the version level of the Smalltalk source code (interpreter
	and various plugins) that is translated to C by a CCodeGenerator, as distinct
	from the external platform source code, typically written in C and managed
	separately for each platform. An optional primitive is invoked that may not
	be available on all virtual machines."

	"Smalltalk vm interpreterSourceVersion"

	<primitive: 'primitiveInterpreterSourceVersion'>
	^ self getSystemAttribute: 1009! !

!VirtualMachine methodsFor: 'statistics' stamp: 'MarcusDenker 5/8/2013 11:53'!
totalFullGCTime
	"Answer the total time in milliseconds spent in full GCs since startup (read-only)."

	^ self parameterAt: 8
! !

!VirtualMachine methodsFor: 'gc' stamp: 'MarcusDenker 5/8/2013 11:54'!
youngSpaceEnd
	"end of young-space"
		
	^ self parameterAt: 2
! !

!VirtualMachine methodsFor: 'accessing' stamp: 'MarcusDenker 5/8/2013 11:53'!
version
	"Return a string of attributes representing the current VM"
	"
	Smalltalk vm version
	"
	^ String streamContents: [ :s |
			s nextPutAll: self interpreterClass; cr.
			self isRunningCogit ifTrue: [ s nextPutAll: self cogitClass; cr ].
			s nextPutAll: self interpreterSourceVersion; cr ].! !

!VirtualMachine methodsFor: 'testing' stamp: 'ClementBera 10/23/2014 09:57'!
isSpur
	^ false! !

!VirtualMachine methodsFor: 'gc' stamp: 'MarcusDenker 5/8/2013 11:09'!
allocationsBetweenGC: anInteger
	"allocations between GCs (read-write)"
	^ self parameterAt: 5 put: anInteger! !

!VirtualMachine methodsFor: 'accessing' stamp: 'CamilloBruni 6/16/2013 20:20'!
headlessOption
	"Return the default name for the headless option for this VM"
	^ self optionDash, (Smalltalk os isUnix
		ifTrue: [ 'vm-display-null' ]
		ifFalse: [ 'headless' ])! !

!VirtualMachine methodsFor: 'attributes' stamp: 'MarcusDenker 10/23/2014 17:17'!
maxExternalSemaphores: aSize
	"This method should never be called as result of normal program
    execution. If it is however, fork off the growth to keep new
    Semaphores flowing for other users, but raise an error in this thread
    indicating that something needs to change to avoid potentially
    unhandled interrupts."

	self maxExternalSemaphores ifNil: [ ^ 0 ].
	
	[ self maxExternalSemaphoresSilently: aSize.
	self
		crTrace: 'WARNING: Had to increase size of semaphore signal handling table due to many external objects concurrently in use';
		crTrace: 'You should increase this size at startup using #maxExternalObjectsSilently:';
		crTrace: 'Current table size: ' , self maxExternalSemaphores printString ] forkAt: Processor userBackgroundPriority.
	
	self error: 'Not enough space for external objects, set a larger size at startup!!'.
	^ self maxExternalSemaphores! !

!VirtualMachine methodsFor: 'modules' stamp: 'MarcusDenker 5/8/2013 02:26'!
unloadModule: aString
	"Primitive. Unload the given module.
	This primitive is intended for development only since some
	platform do not implement unloading of DLL's accordingly.
	Also, the mechanism for unloading may not be supported
	on all platforms."
	<primitive: 571>
	^self primitiveFailed! !

!VirtualMachine methodsFor: 'attributes' stamp: 'MarcusDenker 5/8/2013 10:58'!
wordSize
	^ WordSize ifNil: [WordSize := [self parameterAt: 40] on: Error do: [4]]! !

!VirtualMachine methodsFor: 'testing' stamp: 'EstebanLorenzano 9/19/2013 15:30'!
isPharoVM
	"Answers if this VM is a valid PharoVM (made with our sources)"
	| version |
	
	self flag: #todo. "We need a certain way of identify PharoVM, but in the mean time this ensures "
	version := self version.
	^ (version beginsWith: 'PharoVM')
		or: [ 
			(version includesSubstring: 'NBCoInterpreter')
				or: [
					(version includesSubstring: 'Commit: ') 
						and: [ 
							| pos |
							pos := (version findString: 'Commit: ') + 8.
							(version copyFrom: pos to: pos + 39) allSatisfy: [ :each | (($a to: $f), ($0 to: $9)) includes: each ] ] ] ]! !

!VirtualMachine methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 4/6/2015 12:34'!
gtInspectorDetailsIn: composite
	<gtInspectorPresentationOrder: 0>
	composite table
		title: 'Details';
		display: [ 
			{ 
				'VM directory' -> self vmDirectory asFileReference.
				'VM build date' -> self buildDate.
				'VM version' -> self version.
				'Image directory' -> self imagePath asFileReference parent.
				'Image version' -> self imageVersionNumber.

			} ];
		column: 'Property' evaluated: #key;
		column: 'Value' evaluated: #value;
		send: #value! !

!VirtualMachine methodsFor: 'accessing' stamp: 'MarcusDenker 5/8/2013 11:52'!
platformSourceVersion
	"The use of this primitive not recommended. Not all VMs providing that"


	"Answer a string corresponding to the version of the external platform source
	code, typically written in C and managed separately for each platform. This
	invokes an optional primitive that may not be available on all virtual machines."

	"Smalltalk vm platformSourceVersion"

	<primitive: 'primitivePlatformSourceVersion'>
	self notify: 'This virtual machine does not support the optional primitive #primitivePlatformSourceVersion' translated.
	^''! !

!VirtualMachine class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 4/6/2015 12:30'!
gtExampleBasic
	<gtExample>
	^ self new! !

!WaitfreeQueue commentStamp: 'IgorStasenko 2/28/2011 15:32'!
This is a thread-safe implementation of a queue with wait-free operations. 
It is guaranteed that any message sent to my instance (like adding new item, or fetching item) will not block sender,
nor enter a waiting loop.

The implementation is based on atomicity of simple assignment operations, which can't be interrupted in a middle,
i.e. two assignment statements in a row, like:

x:=y.
y:=z.

can't be interrupted by interpreter and can be seen as a single atomic operation.


This implementation fits best for case, when multiple threads populating queue, but only single thread fetching items from it.

In given implementation, 
inserting new items into queue can't block the sender and insertion operation always takes constant time (if we ignore the possible GC interference here).
For reading/polling operations queue using a lock mechanism, which indicating that queue currently in the middle of extraction,
and therefore, if some thread obtained a lock upon the queue, other threads must wait till one that obtained the lock will finish its operation(s) and release the lock.
All operations which may block the sender will answer the default value(s) instead. 
!
!WaitfreeQueue methodsFor: 'accessing' stamp: 'IgorStasenko 11/2/2010 17:34'!
flushAllSuchThat: aBlock
	"Remove from the queue all objects that satisfy aBlock.
	Note, the operation is no-op, if queue is currently in the middle of extraction by other process"
	
	| item first |

	(item := dummy makeCircular) == dummy ifTrue: [ ^ self ]. 
	first := item.
	
	[ | object |
		object := item object.
		object == dummy ifFalse: [
			( [ aBlock value: object ] ifCurtailed: [ dummy next: first ] ) ifTrue: [
				item object: dummy.
			] ].
	
		item isCircular ifTrue: [
			"this was the last one"
			dummy next: first.
			^ self
			].
		item := item next.
	] repeat.! !

!WaitfreeQueue methodsFor: 'accessing' stamp: 'IgorStasenko 2/28/2011 15:01'!
peek
	"Answer the object that was sent through the receiver first and has not 
	yet been received by anyone but do not remove it from the receiver. 
	If queue is empty or there are other process currently fetching object from queue, answer nil.
	
	Note: do not assume that if #peek answers non-nil object, the next message sent to queue,
	like #next or #nextOrNil will answer the same item.
	The use of this method is discouraged , it is provided only for backward compatibility.
	"

	| item result |

	item := dummy next. 

	[ (result := item object) == dummy ] whileTrue: [
		item isCircular ifTrue: [ 
			self signalNoMoreItems. 
			^ nil ].
		item := item next.
	].
	
	^ result
! !

!WaitfreeQueue methodsFor: 'accessing' stamp: 'IgorStasenko 2/28/2011 15:34'!
nextIfNone: aBlock
	"Attempt to fetch the next item from queue. Evaluate a block if attempt is failed i.e. there is no items available or queue is locked by another process"
	
	| item result |

	(item := dummy makeCircular) == dummy ifTrue: [
		"queue is either empty or currently locked by other feeder,
		just give a quick answer that item not found"
		 ^ aBlock value  ].

	[ (result := item object) == dummy ] whileTrue: [
		item isCircular ifTrue: [ 
			self signalNoMoreItems. 
			dummy next: item. ^ aBlock value ].
		item := item next.
	].
	
	item object: dummy.

	dummy next: item next.
	^ result
! !

!WaitfreeQueue methodsFor: 'accessing' stamp: 'IgorStasenko 2/28/2011 15:14'!
size
	"Answer the size of queue. 
	If queue is currently in the middle of extraction by other process, give a (very) approximate answer.
	
	This method having a non-deterministic results, because of nature of concurrent shared queue. 
	"
	
	| first item count |

	item := dummy.

	count := 0.
	[ item := item next. item object == dummy ifFalse: [ count := count + 1]. item isCircular ] whileFalse.

	count = 0 ifTrue: [
		"if queue is locked by other process, check the tail and give a (very) approximate answer."
		^ tail object == dummy ifTrue: [ 0 ] ifFalse: [ 1]
		].	

	^ count! !

!WaitfreeQueue methodsFor: 'accessing' stamp: 'IgorStasenko 2/28/2011 15:02'!
isEmpty
	"Answer true if queue contains at least one element.
	Note, that answer is non-deterministic, because sender could be interrupted at any moment,
	means that even if message answers true, there is no any guarantees that consequent #nextXX messages could 
	retrieve item(s) from queue.
	
	Therefore use of this method is discouraged. 
	This test will work only if sender is the only process, which fetching items from queue. If there are two or more processes which 
	fetching items from queue, using this method makes no sense "
	
	| item |

	item := dummy next.

	[  item object == dummy ] whileTrue: [
		item isCircular ifTrue: [ ^ true ].
		item := item next.
	].
	
	^ false! !

!WaitfreeQueue methodsFor: 'accessing' stamp: 'Igor.Stasenko 10/16/2010 02:35'!
nextPut: value
	" Add new item to queue "
	| item oldTail |
	
	item := self newItem.
	item object: value.

	" atomic swap here"
	oldTail := tail.
	tail := item.
	
	"self interrupt"
	
	oldTail next: item.

	self signalAddedNewItem.

	^ value! !

!WaitfreeQueue methodsFor: 'accessing' stamp: 'IgorStasenko 2/28/2011 10:50'!
nextOrNil
	"Fetch next item from queue, or nil if queue is either empty or in the middle of extraction by other process.
	If queue can contain a nil as element, use #nextIfNone: instead "
	^ self nextIfNone: nil! !

!WaitfreeQueue methodsFor: 'accessing' stamp: 'IgorStasenko 2/28/2011 11:12'!
flush: aFlushBlock
	"Process all currently available items, passing each item to a flush block.
	If there is another process, which currently fetching items from queue, or queue is empty,
	return immediately"
	
	| item |

	item := dummy makeCircular. 
	item == dummy ifTrue: [ ^ self  ].

	[ | object |
		object := item object.
		object == dummy ifFalse: [
			[ aFlushBlock value: object ] ifCurtailed: [ 
				item object: dummy.
				dummy next: item next ].
		].
		item object: dummy.
		
		item isCircular ifTrue: [
			"this was the last one"
			dummy next: item.
			self signalNoMoreItems.
			^ self
			].
		item := item next.
	] repeat.

	! !

!WaitfreeQueue methodsFor: 'initialization' stamp: 'Igor.Stasenko 10/16/2010 07:27'!
initialize
	dummy := AtomicQueueItem new.
	dummy object: dummy.
	tail := dummy.
! !

!WaitfreeQueue methodsFor: 'accessing' stamp: 'IgorStasenko 2/28/2011 15:24'!
findFirst: aBlock
	"Note, this method only for backward compatibility. It duplicating the semantics of #nextOrNilSuchThat: completely.
	Use #nextOrNilSuchThat: instead "

	
	^ self nextOrNilSuchThat: aBlock
	! !

!WaitfreeQueue methodsFor: 'printing' stamp: 'IgorStasenko 2/28/2011 11:41'!
printOn: aStream

	aStream 
		nextPutAll: self class name;
		nextPutAll: ' with ';
		print: self size;
	 	nextPutAll: ' items' .! !

!WaitfreeQueue methodsFor: 'accessing' stamp: 'Igor.Stasenko 10/16/2010 05:44'!
flush
	self flush: [:ea | ]! !

!WaitfreeQueue methodsFor: 'accessing' stamp: 'IgorStasenko 2/28/2011 10:56'!
nextOrNilSuchThat: aBlock
	"Fetch an object from queue that satisfies aBlock, skipping (but not removing) any intermediate objects.
	If no object has been found, answer <nil> and leave me intact.
	
	NOTA BENE:  aBlock can contain a non-local return (^).
	Found item is removed from queue	.
	
	If queue currently in the middle of extraction by other process, don't wait and return <nil> immediately"
	
	| item first |

	(item := dummy makeCircular) == dummy  ifTrue: [ ^ nil ]. 
	first := item.
	
	[ | object |
		object := item object.
		object == dummy ifFalse: [
			( [ aBlock value: object ] ifCurtailed: [ dummy next: first ] ) ifTrue: [
				item object: dummy.
				dummy next: first.
				^ object
			] ].
	
		item isCircular ifTrue: [
			"this was the last one"
			dummy next: first.
			^ nil
			].
		item := item next.
	] repeat.
	! !

!WaitfreeQueue methodsFor: 'accessing' stamp: 'IgorStasenko 2/28/2011 15:24'!
removeAll
	"
	This message makes no sense in concurrent environment. There is no way to guarantee that when this method returns to sender, the queue will remain empty,
	because at any moment other process may interrupt current process and put new item(s) to queue.

	Therefore we just flush the queue and hope for the best"
	
	self flush! !

!WaitfreeQueue class methodsFor: 'instance creation' stamp: 'Igor.Stasenko 10/16/2010 02:00'!
new: anInteger 
	"Just to match SharedQueue protocol"
	^self new! !

!Warning commentStamp: '<historical>'!
A Warning is a Notification which by default should be brought to the attention of the user.!
!Warning methodsFor: 'exceptionDescription' stamp: 'pavel.krivanek 11/20/2007 09:53'!
defaultAction
	
	UIManager default warningDefaultAction: self! !

!Warning methodsFor: '*SUnit-Core' stamp: 'MonkeyGalactikalIntegrator 9/25/2011 19:12'!
sunitAnnounce: aTestCase toResult: aTestResult
	aTestResult addFailure: aTestCase.
	self sunitExitWith: false.! !

!WarpBlt commentStamp: '<historical>'!
WarpBlt is a little warp-drive added on to BitBlt.  It takes a quadrilateral as its source specification, while its destination is traversed and combined just like any other call to copyBits.

The source quadrilateral is specified as an array of points starting with the corner that wants to end up in the topLeft, and proceding to the successive points that want to follow CCW around the destination rectangle.  Note that in specifying a plain old rectangle source, its non topLeft points must be actual pixels, not outside by 1, as with rectangle bottmRight, eg.  See the method Rectangle asQuad.

WarpBlt does a fast job of rotation, reflection and scaling, and it can even produce a semblance of perspective.  Depth parameters are included for future improvements in this direction. but the primitve does not support this yet.!
!WarpBlt methodsFor: 'primitives' stamp: ''!
startFrom: x1 to: x2 offset: sumOfDeltas
	"Utility routine for computing Warp increments."
	x2 >= x1
		ifTrue: [^ x1]
		ifFalse: [^ x2 - sumOfDeltas]! !

!WarpBlt methodsFor: 'primitives' stamp: ''!
copyQuad: pts toRect: destRect
	self sourceQuad: pts destRect: destRect.
	self warpBits! !

!WarpBlt methodsFor: 'setup' stamp: ''!
cellSize
	^ cellSize! !

!WarpBlt methodsFor: 'primitives' stamp: 'lr 7/4/2009 10:42'!
sourceForm: srcForm destRect: dstRectangle 
	"Set up a WarpBlt from the entire source Form to the given destination rectangle."
	| w h |
	sourceForm := srcForm.
	sourceX := sourceY := 0.
	destX := dstRectangle left.
	destY := dstRectangle top.
	width := dstRectangle width.
	height := dstRectangle height.
	w := 16384 * (srcForm width - 1).
	h := 16384 * (srcForm height - 1).
	p1x := 0.
	p2x := 0.
	p3x := w.
	p4x := w.
	p1y := 0.
	p2y := h.
	p3y := h.
	p4y := 0.
	p1z := p2z := p3z := p4z := 16384	"z-warp ignored for now"! !

!WarpBlt methodsFor: 'smoothing' stamp: 'HenrikSperreJohansen 10/25/2010 15:26'!
rgbMap: sourcePixel from: nBitsIn to: nBitsOut 
	"NOTE: This code is copied verbatim from BitBltSimulation so that it
	may be removed from the system"
	"Convert the given pixel value with nBitsIn bits for each color component to a pixel value with nBitsOut bits for each color component. Typical values for nBitsIn/nBitsOut are 3, 5, or 8."
	| mask d srcPix destPix |
	<inline: true>
	(d := nBitsOut - nBitsIn) > 0 
		ifTrue: 
			[ "Expand to more bits by zero-fill"
			mask := (1 << nBitsIn) - 1.	"Transfer mask"
			srcPix := sourcePixel << d.
			mask := mask << d.
			destPix := srcPix bitAnd: mask.
			mask := mask << nBitsOut.
			srcPix := srcPix << d.
			^ destPix + (srcPix bitAnd: mask) + (srcPix << d bitAnd: mask << nBitsOut) ]
		ifFalse: 
			[ "Compress to fewer bits by truncation"
			d = 0 ifTrue: [ ^ sourcePixel ].	"no compression"
			sourcePixel = 0 ifTrue: [ ^ sourcePixel ].	"always map 0 (transparent) to 0"
			d := nBitsIn - nBitsOut.
			mask := (1 << nBitsOut) - 1.	"Transfer mask"
			srcPix := sourcePixel >> d.
			destPix := srcPix bitAnd: mask.
			mask := mask << nBitsOut.
			srcPix := srcPix >> d.
			destPix := destPix + (srcPix bitAnd: mask) + (srcPix >> d bitAnd: mask << nBitsOut).
			destPix = 0 ifTrue: [ ^ 1 ].	"Dont fall into transparent by truncation"
			^ destPix ]! !

!WarpBlt methodsFor: 'primitives' stamp: 'lr 7/4/2009 10:42'!
sourceQuad: pts destRect: aRectangle 
	| fixedPt1 |
	sourceX := sourceY := 0.
	self destRect: aRectangle.
	fixedPt1 := (pts at: 1) x isInteger 
		ifTrue: [ 16384 ]
		ifFalse: [ 16384.0 ].
	p1x := (pts at: 1) x * fixedPt1.
	p2x := (pts at: 2) x * fixedPt1.
	p3x := (pts at: 3) x * fixedPt1.
	p4x := (pts at: 4) x * fixedPt1.
	p1y := (pts at: 1) y * fixedPt1.
	p2y := (pts at: 2) y * fixedPt1.
	p3y := (pts at: 3) y * fixedPt1.
	p4y := (pts at: 4) y * fixedPt1.
	p1z := p2z := p3z := p4z := 16384	"z-warp ignored for now"! !

!WarpBlt methodsFor: 'setup' stamp: 'lr 7/4/2009 10:42'!
cellSize: s 
	cellSize := s.
	cellSize = 1 ifTrue: [ ^ self ].
	colorMap := Color 
		colorMapIfNeededFrom: 32
		to: destForm depth! !

!WarpBlt methodsFor: 'smoothing' stamp: 'lr 7/4/2009 10:42'!
mixPix: pix sourceMap: sourceMap destMap: destMap 
	"Average the pixels in array pix to produce a destination pixel.
	First average the RGB values either from the pixels directly,
	or as supplied in the sourceMap.  Then return either the resulting
	RGB value directly, or use it to index the destination color map."
	| r g b rgb nPix bitsPerColor d |
	nPix := pix size.
	r := 0.
	g := 0.
	b := 0.
	1 
		to: nPix
		do: 
			[ :i | 
			"Sum R, G, B values for each pixel"
			rgb := sourceForm depth <= 8 
				ifTrue: [ sourceMap at: (pix at: i) + 1 ]
				ifFalse: 
					[ sourceForm depth = 32 
						ifTrue: [ pix at: i ]
						ifFalse: 
							[ self 
								rgbMap: (pix at: i)
								from: 5
								to: 8 ] ].
			r := r + ((rgb bitShift: -16) bitAnd: 255).
			g := g + ((rgb bitShift: -8) bitAnd: 255).
			b := b + ((rgb bitShift: 0) bitAnd: 255) ].
	destMap == nil 
		ifTrue: 
			[ bitsPerColor := 3.	"just in case eg depth <= 8 and no map"
			destForm depth = 16 ifTrue: [ bitsPerColor := 5 ].
			destForm depth = 32 ifTrue: [ bitsPerColor := 8 ] ]
		ifFalse: 
			[ destMap size = 512 ifTrue: [ bitsPerColor := 3 ].
			destMap size = 4096 ifTrue: [ bitsPerColor := 4 ].
			destMap size = 32768 ifTrue: [ bitsPerColor := 5 ] ].
	d := bitsPerColor - 8.
	rgb := ((r // nPix bitShift: d) bitShift: bitsPerColor * 2) + ((g // nPix bitShift: d) bitShift: bitsPerColor) + ((b // nPix bitShift: d) bitShift: 0).
	destMap == nil 
		ifTrue: [ ^ rgb ]
		ifFalse: [ ^ destMap at: rgb + 1 ]! !

!WarpBlt methodsFor: 'primitives' stamp: 'StephaneDucasse 10/25/2013 16:19'!
warpBitsSmoothing: n sourceMap: sourceMap 
	| deltaP12 deltaP43 pA pB deltaPAB sp fixedPtOne picker poker pix nSteps |
	<primitive: 'primitiveWarpBits' module: 'BitBltPlugin'>
	(sourceForm isForm and: 
		[ "Check for compressed source, destination or halftone forms"
		sourceForm unhibernate ]) ifTrue: 
		[ ^ self 
			warpBitsSmoothing: n
			sourceMap: sourceMap ].
	(destForm isForm and: [ destForm unhibernate ]) ifTrue: 
		[ ^ self 
			warpBitsSmoothing: n
			sourceMap: sourceMap ].
	(halftoneForm isForm and: [ halftoneForm unhibernate ]) ifTrue: 
		[ ^ self 
			warpBitsSmoothing: n
			sourceMap: sourceMap ].
	width < 1 | (height < 1) ifTrue: [ ^ self ].
	fixedPtOne := 16384.	"1.0 in fixed-pt representation"
	n > 1 ifTrue: 
		[ (destForm depth < 16 and: [ colorMap == nil ]) ifTrue: 
			[ "color map is required to smooth non-RGB dest"
			^ self primitiveFailed ].
		pix := Array new: n * n ].
	nSteps := height - 1 max: 1.
	deltaP12 := (self 
		deltaFrom: p1x
		to: p2x
		nSteps: nSteps) @ (self 
			deltaFrom: p1y
			to: p2y
			nSteps: nSteps).
	pA := (self 
		startFrom: p1x
		to: p2x
		offset: nSteps * deltaP12 x) @ (self 
			startFrom: p1y
			to: p2y
			offset: nSteps * deltaP12 y).
	deltaP43 := (self 
		deltaFrom: p4x
		to: p3x
		nSteps: nSteps) @ (self 
			deltaFrom: p4y
			to: p3y
			nSteps: nSteps).
	pB := (self 
		startFrom: p4x
		to: p3x
		offset: nSteps * deltaP43 x) @ (self 
			startFrom: p4y
			to: p3y
			offset: nSteps * deltaP43 y).
	picker := BitBlt bitPeekerFromForm: sourceForm.
	poker := BitBlt bitPokerToForm: destForm.
	poker clipRect: self clipRect.
	nSteps := width - 1 max: 1.
	destY 
		to: destY + height - 1
		do: 
			[ :y | 
			deltaPAB := (self 
				deltaFrom: pA x
				to: pB x
				nSteps: nSteps) @ (self 
					deltaFrom: pA y
					to: pB y
					nSteps: nSteps).
			sp := (self 
				startFrom: pA x
				to: pB x
				offset: nSteps * deltaPAB x) @ (self 
					startFrom: pA y
					to: pB y
					offset: nSteps * deltaPAB x).
			destX 
				to: destX + width - 1
				do: 
					[ :x | 
					n = 1 
						ifTrue: 
							[ poker 
								pixelAt: x @ y
								put: (picker pixelAt: sp // fixedPtOne asPoint) ]
						ifFalse: 
							[ 0 
								to: n - 1
								do: 
									[ :dx | 
									0 
										to: n - 1
										do: 
											[ :dy | 
											pix 
												at: dx * n + dy + 1
												put: (picker pixelAt: (sp + (deltaPAB * dx // n) + (deltaP12 * dy // n)) // fixedPtOne asPoint) ] ].
							poker 
								pixelAt: x @ y
								put: (self 
										mixPix: pix
										sourceMap: sourceMap
										destMap: colorMap) ].
					sp := sp + deltaPAB ].
			pA := pA + deltaP12.
			pB := pB + deltaP43 ]! !

!WarpBlt methodsFor: 'primitives' stamp: 'lr 7/4/2009 10:42'!
deltaFrom: x1 to: x2 nSteps: n 
	"Utility routine for computing Warp increments.
	x1 is starting pixel, x2 is ending pixel;  assumes n >= 1"
	| fixedPtOne |
	fixedPtOne := 16384.	"1.0 in fixed-pt representation"
	x2 > x1 
		ifTrue: [ ^ (x2 - x1 + fixedPtOne) // (n + 1) + 1 ]
		ifFalse: 
			[ x2 = x1 ifTrue: [ ^ 0 ].
			^ 0 - ((x1 - x2 + fixedPtOne) // (n + 1) + 1) ]! !

!WarpBlt methodsFor: 'primitives' stamp: 'nk 11/3/2004 09:26'!
warpBits
	"Move those pixels!!"

	cellSize < 1 ifTrue: [ ^self error: 'cellSize must be >= 1' ].

	self warpBitsSmoothing: cellSize
		sourceMap: (sourceForm colormapIfNeededForDepth: 32).
! !

!WarpBlt class methodsFor: 'initialization' stamp: ''!
toForm: destinationForm
	"Default cell size is 1 (no pixel smoothing)"
	^ (super toForm: destinationForm) cellSize: 1! !

!WarpBlt class methodsFor: 'form rotation' stamp: 'lr 7/4/2009 10:42'!
rotate: srcForm degrees: angleInDegrees center: aPoint scaleBy: scalePoint smoothing: cellSize 
	"Rotate the given Form the given number of degrees about the given center and scale its width and height by x and y of the given scale point. Smooth using the given cell size, an integer between 1 and 3, where 1 means no smoothing. Return a pair where the first element is the rotated Form and the second is the position offset required to align the center of the rotated Form with that of the original. Note that the dimensions of the resulting Form generally differ from those of the original."
	| srcRect center radians dstOrigin dstCorner p dstRect inverseScale quad dstForm newCenter warpSrc |
	srcRect := srcForm boundingBox.
	center := srcRect center.
	radians := angleInDegrees degreesToRadians.
	dstOrigin := dstCorner := center.
	srcRect corners do: 
		[ :corner | 
		"find the limits of a rectangle that just encloses the rotated
		 original; in general, this rectangle will be larger than the
		 original (e.g., consider a square rotated by 45 degrees)"
		p := (corner - center scaleBy: scalePoint) + center.
		p := (p 
			rotateBy: radians
			about: center) rounded.
		dstOrigin := dstOrigin min: p.
		dstCorner := dstCorner max: p ].

	"rotate the enclosing rectangle back to get the source quadrilateral"
	dstRect := dstOrigin corner: dstCorner.
	inverseScale := (1.0 / scalePoint x) @ (1.0 / scalePoint y).
	quad := dstRect innerCorners collect: 
		[ :corner | 
		p := corner 
			rotateBy: radians negated
			about: center.
		(p - center scaleBy: inverseScale) + center ].

	"make a Form to hold the result and do the rotation"
	warpSrc := srcForm.
	srcForm isColorForm 
		ifTrue: 
			[ cellSize > 1 | true 
				ifTrue: 
					[ "ar 12/27/2001: Always enable - else sketches won't work"
					warpSrc := Form 
						extent: srcForm extent
						depth: 16.
					srcForm displayOn: warpSrc.
					dstForm := Form 
						extent: dstRect extent
						depth: 16	"use 16-bit depth to allow smoothing" ]
				ifFalse: 
					[ dstForm := srcForm class 
						extent: dstRect extent
						depth: srcForm depth ] ]
		ifFalse: 
			[ dstForm := srcForm class 
				extent: dstRect extent
				depth: srcForm depth ].
	(WarpBlt toForm: dstForm)
		sourceForm: warpSrc;
		colorMap: (warpSrc colormapIfNeededFor: dstForm);
		cellSize: cellSize;
		combinationRule: Form paint;
		copyQuad: quad
			toRect: dstForm boundingBox.	"installs a new colormap if cellSize > 1"
	dstForm isColorForm ifTrue: [ dstForm colors: srcForm colors copy ].
	newCenter := (center 
		rotateBy: radians
		about: aPoint) truncated.
	^ Array 
		with: dstForm
		with: dstRect origin + (newCenter - center)! !

!WateryThemeIcons commentStamp: 'gvc 9/23/2008 12:07'!
Watery theme specific icons.!
!WateryThemeIcons methodsFor: 'private - accessing' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
normalSizeNames
	"Answer the names of the normal icons"
	
	^#('error' 'info' 'lock' 'question' 'warning')! !

!WateryThemeIcons methodsFor: 'private - accessing' stamp: 'EstebanLorenzano 5/9/2013 10:58'!
smallSizeNames
	"Answer the names of the small icons"
	
	^#('smallError' 'smallInfo' 'smallLock' 'smallQuestion' 'smallWarning')! !

!WateryThemeIcons class methodsFor: 'private - accessing' stamp: 'gvc 10/24/2007 11:43'!
normalSizeNames
	"Answer the names of the normal icons"
	
	^#('error' 'info' 'lock' 'question' 'warning')! !

!WateryThemeIcons class methodsFor: 'private - accessing' stamp: 'gvc 10/24/2007 11:38'!
smallSizeNames
	"Answer the names of the small icons"
	
	^#('smallError' 'smallInfo' 'smallLock' 'smallQuestion' 'smallWarning')! !

!WeakActionSequence commentStamp: 'TorstenBergmann 2/4/2014 21:46'!
Weak action sequences for events!
!WeakActionSequence methodsFor: 'evaluating' stamp: 'nk 7/21/2003 15:17'!
valueWithArguments: anArray

	"Return the last result"

    | answer |
    self do:
        [:each |
        	each isValid ifTrue: [answer := each valueWithArguments: anArray]].
    ^answer! !

!WeakActionSequence methodsFor: 'converting' stamp: 'rw 4/27/2002 07:44'!
asActionSequence

	^self! !

!WeakActionSequence methodsFor: 'converting' stamp: 'nk 7/21/2003 15:16'!
asMinimalRepresentation

	| valid |
	valid := self select: [:e | e isValid ].
	valid size = 0
		ifTrue: [^nil].
	valid size = 1
		ifTrue: [^valid first].
	^valid! !

!WeakActionSequence methodsFor: 'evaluating' stamp: 'nk 7/21/2003 15:17'!
value
    "Answer the result of evaluating the elements of the receiver.
	Actually, return just the last result."

    | answer |
    self do:
        [:each | each isValid ifTrue: [answer := each value]].
    ^answer! !

!WeakActionSequence methodsFor: 'printing' stamp: 'rw 4/27/2002 07:46'!
printOn: aStream

	self size < 2 ifTrue: [^super printOn: aStream].
	aStream nextPutAll: '#('.
	self
		do: [:each | each printOn: aStream]
		separatedBy: [aStream cr].
	aStream nextPut: $)! !

!WeakAnnouncementSubscription commentStamp: 'IgorStasenko 3/12/2011 20:43'!
A WeakAnnouncementSubscription is a subscription which is removed automatically when the subscriber is unreferenced.

No support for ephemerons currently prevents this from working for Block actions (blocks hold their receiver, which is the default subscriber strongly). 

To switch between subscription types, use makeStrong/makeWeak on the subscription returned when initially registering with announcer.


Note, that list and next must be first instance variables.!
!WeakAnnouncementSubscription methodsFor: 'accessing' stamp: 'IgorStasenko 3/12/2011 19:57'!
announcer

	^ announcer! !

!WeakAnnouncementSubscription methodsFor: 'accessing' stamp: 'IgorStasenko 3/12/2011 19:51'!
subscriber

	^ self basicAt: 1! !

!WeakAnnouncementSubscription methodsFor: 'finalization' stamp: 'IgorStasenko 3/12/2011 21:21'!
finalize

	announcer removeSubscription: self.
	! !

!WeakAnnouncementSubscription methodsFor: 'accessing' stamp: 'IgorStasenko 3/12/2011 20:48'!
next
	^ next! !

!WeakAnnouncementSubscription methodsFor: 'accessing' stamp: 'IgorStasenko 3/12/2011 19:58'!
valuable: aValuable
	"Used when subscriber should be extracted from valuable object"
	self action:  aValuable.
	self subscriber: aValuable receiver.! !

!WeakAnnouncementSubscription methodsFor: 'converting' stamp: 'IgorStasenko 3/22/2011 15:45'!
makeStrong

	| sub |
	sub := self subscriber.
	sub ifNil: [ ^ self error: 'Subscriber is nil, cannot make strong subscription' ].
	
	^ announcer replace: self with: 
		(AnnouncementSubscription new
			announcer: announcer;
			action: action asMessageSend;
			subscriber: sub;
			announcementClass: announcementClass)
! !

!WeakAnnouncementSubscription methodsFor: 'accessing' stamp: 'IgorStasenko 3/12/2011 19:51'!
subscriber: anObject

	self subscriber ifNotNil: [ self error: 'subscriber already set' ].

	self basicAt: 1 put: anObject! !

!WeakAnnouncementSubscription methodsFor: 'accessing' stamp: 'IgorStasenko 3/12/2011 19:57'!
action: anObject

	action := anObject! !

!WeakAnnouncementSubscription methodsFor: 'accessing' stamp: 'IgorStasenko 3/12/2011 19:57'!
announcer: anAnnouncer
	announcer := anAnnouncer! !

!WeakAnnouncementSubscription methodsFor: 'accessing' stamp: 'IgorStasenko 3/12/2011 19:57'!
announcementClass

	^ announcementClass! !

!WeakAnnouncementSubscription methodsFor: 'initialization' stamp: 'IgorStasenko 3/12/2011 19:48'!
initialize
	list := self class finalizationList! !

!WeakAnnouncementSubscription methodsFor: 'accessing' stamp: 'IgorStasenko 3/12/2011 19:57'!
action

	^ action! !

!WeakAnnouncementSubscription methodsFor: 'announcing' stamp: 'IgorStasenko 1/3/2012 12:22'!
deliver: anAnnouncement
	" deliver an announcement to receiver. In case of failure, it will be handled in separate process"

	^ (self handlesAnnouncement: anAnnouncement ) ifTrue: [
		[action cull: anAnnouncement cull: announcer] 
			on: UnhandledError fork: [:ex | ex pass ]]! !

!WeakAnnouncementSubscription methodsFor: 'error handling' stamp: 'IgorStasenko 1/3/2012 12:20'!
handlesAnnouncement: anAnnouncement

	^ announcementClass handlesAnnouncement: anAnnouncement! !

!WeakAnnouncementSubscription methodsFor: 'converting' stamp: 'IgorStasenko 3/12/2011 19:55'!
makeWeak
	^ self! !

!WeakAnnouncementSubscription methodsFor: 'accessing' stamp: 'IgorStasenko 3/12/2011 19:57'!
announcementClass: anObject

	announcementClass := anObject! !

!WeakAnnouncementSubscription class methodsFor: 'finalization support' stamp: 'IgorStasenko 3/12/2011 21:35'!
finalizeValues
	
	| head |
	
	head := self finalizationList swapWithNil.
	
	[ head notNil ] whileTrue: [ 
		head finalize.
		head := head next
	].! !

!WeakAnnouncementSubscription class methodsFor: 'finalization support' stamp: 'IgorStasenko 3/12/2011 19:43'!
finalizationList
	
	^ FinalizationList ifNil: [ FinalizationList := WeakFinalizationList new ].! !

!WeakAnnouncementSubscription class methodsFor: 'class initialization' stamp: 'IgorStasenko 3/14/2011 13:26'!
initialize
	"self initialize"
	
	
	WeakArray 
		removeWeakDependent: self;
		addWeakDependent: self
		
	"Make sure that it is not added twice."! !

!WeakAnnouncementSubscription class methodsFor: 'instance creation' stamp: 'IgorStasenko 3/12/2011 21:32'!
new
	
	^ ((WeakFinalizationList hasNewFinalization
		ifTrue: [ self ] ifFalse: [ LegacyWeakSubscription ] )
			basicNew: 1) initialize! !

!WeakAnnouncerTest commentStamp: 'TorstenBergmann 2/20/2014 15:15'!
SUnit tests for weak announcements!
!WeakAnnouncerTest methodsFor: 'testing' stamp: 'IgorStasenko 3/12/2011 18:23'!
testWeakObject
	| counter collector forwarder |
	counter := 0.
	collector := [ counter := counter + 1 ].
	forwarder := MessageSend receiver: collector selector: #value.
	(announcer subscribe: AnnouncementMockA send: #value to: forwarder) makeWeak.
	
	" shouldn't go away, we are still holding a reference to 'forwarder': "
	Smalltalk garbageCollect.
	announcer announce: AnnouncementMockA.
	self assert: counter = 1.
	
	" should go away as we let the only reference to 'forwarder' go: "
	forwarder := nil.
	Smalltalk garbageCollect.
	announcer announce: AnnouncementMockA.
	self assert: counter = 1! !

!WeakAnnouncerTest methodsFor: 'benchmarks' stamp: 'BernardoContreras 9/26/2014 11:17'!
benchWeakSubscriptionDynamic

	" run me to see how expensive becomeForward: is (compared to #benchWeakSubscriptionStatic ) "
	| object ann |
	
	object := Object new.
	ann := Announcer new.
	
	^ [
		1000 timesRepeat: [ (ann when: Announcement send: #value to: object) makeWeak ].
	] timeToRun! !

!WeakAnnouncerTest methodsFor: 'testing' stamp: 'MarcusDenker 8/20/2011 13:43'!
testNoWeakBlock
	"There is no such thing as a weak block, these things never go away."

	<expectedFailure>

	| counter |
	counter := 0.

	(announcer subscribe: AnnouncementMockA do: [ :ann | counter := counter + 1 ]) makeWeak.
	
	Smalltalk garbageCollect.
	announcer announce: AnnouncementMockA.
	self assert: counter = 1.
	
	Smalltalk garbageCollect.
	announcer announce: AnnouncementMockA.
	self assert: counter = 2! !

!WeakAnnouncerTest methodsFor: 'testing' stamp: 'BernardoContreras 9/26/2014 11:16'!
testWeakSubscription
	| obj  subscription |
	
	obj := Object new.
	
	subscription := 
		(announcer when: AnnouncementMockA send: #value to: obj) makeWeak.
		
	self assert: (obj == subscription subscriber).! !

!WeakAnnouncerTest methodsFor: 'benchmarks' stamp: 'BernardoContreras 9/26/2014 11:15'!
benchManyWeakGuys

	| object ann time |
	
	object := Object new.
	ann := Announcer new.
	
	50000 timesRepeat: [ (ann weak when: Announcement send: #value to: object) ].
	
	self assert: (ann numberOfSubscriptions =  50000).
	
	Smalltalk garbageCollect.
	
	time := [object := nil.
		Smalltalk garbageCollect. 
		 ]timeToRun.
	
	self assert: (ann numberOfSubscriptions = 0).
	^ time! !

!WeakAnnouncerTest methodsFor: 'benchmarks' stamp: 'BernardoContreras 9/26/2014 11:18'!
benchWeakSubscriptionStatic

	" run me to see how cheap object creation is (compared to #benchWeakSubscriptionDynamic ) "
	| object ann |
	
	object := Object new.
	ann := Announcer new.
	
	^ [
		1000 timesRepeat: [ (ann weak when: Announcement send: #value to: object)  ].
	] timeToRun! !

!WeakArray commentStamp: '<historical>'!
WeakArray is an array which holds only weakly on its elements. This means whenever an object is only referenced by instances of WeakArray it will be garbage collected.!
!WeakArray class methodsFor: 'private' stamp: 'CamilloBruni 8/21/2013 19:14'!
restartFinalizationProcess
	"kill any old process, just in case"
	FinalizationProcess
		ifNotNil: [FinalizationProcess terminate.
			FinalizationProcess := nil].

	FinalizationSemaphore := Smalltalk specialObjectsArray at: 42.
	FinalizationDependents ifNil: [FinalizationDependents := WeakArray new: 10].
	FinalizationLock := Semaphore forMutualExclusion.
	
	FinalizationProcess := [self finalizationProcess]
		forkAt: Processor userInterruptPriority.
	FinalizationProcess name: 'WeakArray Finalization Process'.! !

!WeakArray class methodsFor: 'initialization' stamp: 'GuillermoPolito 5/21/2012 16:16'!
initialize
	"WeakArray initialize"

	"Do we need to initialize specialObjectsArray?"
	Smalltalk specialObjectsArray size < 42 
		ifTrue: [Smalltalk recreateSpecialObjectsArray].

	Smalltalk addToStartUpList: self.

	FinalizationSemaphore := Smalltalk specialObjectsArray at: 42.
	FinalizationLock := Semaphore forMutualExclusion.
	FinalizationDependents ifNil: [FinalizationDependents := WeakArray new: 10].! !

!WeakArray class methodsFor: 'private' stamp: 'ar 10/7/1998 15:24'!
pvtCreateTemporaryObjectIn: tempObject
	"We have to create the temporary object in a separate stack frame"
	tempObject at: 1 put: Object new! !

!WeakArray class methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 5/20/2010 22:39'!
addWeakDependent: anObject
	
	FinalizationLock critical:[ | index finished weakDependent |
		finished := false.
		index := 0.
		[index := index + 1.
		finished not and:[index <= FinalizationDependents size]] whileTrue:[
			weakDependent := FinalizationDependents at: index.
			weakDependent ifNil: [
				FinalizationDependents at: index put: anObject.
				finished := true.
			].
		].
		finished ifFalse:[
			"Grow linearly"
			FinalizationDependents := FinalizationDependents, (WeakArray new: 10).
			FinalizationDependents at: index put: anObject.
		].
	] ifError:[:msg :rcvr| rcvr error: msg].! !

!WeakArray class methodsFor: 'accessing' stamp: 'nk 10/28/2000 20:26'!
runningFinalizationProcess
	"Answer the FinalizationProcess I am running, if any"
	^FinalizationProcess! !

!WeakArray class methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 5/20/2010 22:39'!
removeWeakDependent: anObject
	FinalizationLock critical:[
		1 to: FinalizationDependents size do:[:i|
			((FinalizationDependents at: i) == anObject) ifTrue:[
				FinalizationDependents at: i put: nil.
			].
		].
	] ifError:[:msg :rcvr| rcvr error: msg].! !

!WeakArray class methodsFor: 'private' stamp: 'EstebanLorenzano 9/19/2013 14:00'!
finalizationProcess
	[true] whileTrue: [ 
		FinalizationSemaphore wait.
		FinalizationLock critical: [
			FinalizationDependents do: 	[:weakDependent |
				weakDependent ifNotNil: [
					[ weakDependent finalizeValues ] on: Exception fork: [:ex | ex pass ] ]]]].
! !

!WeakArray class methodsFor: 'system startup' stamp: 'nk 6/21/2004 09:22'!
startUp: resuming
	resuming ifFalse: [ ^self ].
	self restartFinalizationProcess.! !

!WeakFinalizationList commentStamp: 'Igor.Stasenko 9/22/2010 21:09'!
IMPORTANT!!!!!!

This class is a special object, recognized by VM.
Its only purpose is to 
a) identify a special kind of objects who usually having a weak references but
  also having an instance of me held by first non-weak fixed slot (instance variable).

b) a 'first' instance variable points to the head of a list of items, reported by VM which has weak references which became garbage during last garbage collection

At my class side, there are some public behavior, which is used by finalization process to detect if VM supports new finalization scheme or should use the old one.
Weak registry using #hasNewFinalization for switching to correct finalization logic,
depending on VM it currently runs on.
!
!WeakFinalizationList methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/22/2010 21:06'!
first
	^ first! !

!WeakFinalizationList methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/22/2010 21:06'!
swapWithNil

	| head |
	head := first.
	first := nil.
	^ head! !

!WeakFinalizationList class methodsFor: 'class initialization' stamp: 'EstebanLorenzano 9/19/2013 15:32'!
initialize 
	Smalltalk 
		removeFromStartUpList: self;
		addToStartUpList: self after: SmalltalkImage ! !

!WeakFinalizationList class methodsFor: 'system startup' stamp: 'EstebanLorenzano 9/19/2013 14:36'!
startUp: resuming 
	resuming ifTrue: [ 
		HasNewFinalization := Smalltalk vm isPharoVM ]! !

!WeakFinalizationList class methodsFor: 'vm capability test' stamp: 'Igor.Stasenko 9/22/2010 20:18'!
hasNewFinalization
	^ HasNewFinalization == true! !

!WeakFinalizerItem commentStamp: 'Igor.Stasenko 9/22/2010 20:59'!
My instances is used by weak registry to hold a single weak reference
and executor(s).

Once object, referenced weakly by my instance become garbage, a weak registry triggers its execution
by sending #finalizeValues to my instance.

Note, that a new VM finalization scheme does not implies to use this particular class
in order to implement finalization scheme. VM refers only to WeakFinalizationList class. 

In this way, my class and its implementation can serve as an example for implementing various finalization actions, which may differ from this one, provided by default for use by weak registry.

Once initialized, my instance should:
 - point to particular list (an instance of WeakFinalizationList),
 - next should be nil
 - executor or multiple executors initialized
 - weak reference slot should point to some object of interest

At the moment, when object, referenced weakly, become garbage, VM checks if its fist instance variable is an instance of WeakFinalizationList.
If it so, then it adds a given object to this list, and also links the tail of list through 'next' instance variable. 

So, as a result of garbage collection, a list will contain all objects, which had weak references to garbage collected objects. 
It is a responsibility of application to manage the instances of WeakFinalizationList's , as well as clear this list before the next garbage collection.
As a consequence of that you can:
 - use multiple different lists and manage them differently in order to react differently when some objects became garbage
 - you are not obliged to handle/clear the list(s) immediately after GC. You can clean up them periodically.
 - you can implement own kind of weak referencing object(s), which could use same finalization, provided by newer VMs.

VM requires only that an object with weak reference having at least two instance variables,
and its first instance variable points to instance of WeakFinalizationList. Everything else is optional.
!
!WeakFinalizerItem methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/22/2010 21:06'!
list: aList
	list := aList! !

!WeakFinalizerItem methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/22/2010 21:06'!
clear
	list := next := nil.! !

!WeakFinalizerItem methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/22/2010 21:06'!
object
	^ self at: 1! !

!WeakFinalizerItem methodsFor: 'copying' stamp: 'Igor.Stasenko 10/11/2010 15:06'!
postCopy
	executor hasMultipleExecutors ifTrue: [ executor := executor copy ].! !

!WeakFinalizerItem methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/22/2010 21:06'!
add: newExecutor

	executor 
		ifNil: [ executor := newExecutor ]
		ifNotNil: [
			executor hasMultipleExecutors
				ifTrue: [ executor add: newExecutor]
				ifFalse: [ executor := ObjectFinalizerCollection with: executor with: newExecutor ]
		]! !

!WeakFinalizerItem methodsFor: 'initialize-release' stamp: 'Igor.Stasenko 9/22/2010 21:06'!
list: weakFinalizationList object: anObject executor: anExecutor
	self assert: (weakFinalizationList class == WeakFinalizationList).
	list := weakFinalizationList.
	self at: 1 put: anObject.
	executor := anExecutor! !

!WeakFinalizerItem methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/22/2010 21:06'!
next
	^ next! !

!WeakFinalizerItem methodsFor: 'initialize-release' stamp: 'Igor.Stasenko 9/22/2010 21:06'!
list: weakFinalizationList object: anObject
	self assert: (weakFinalizationList class == WeakFinalizationList).
	list := weakFinalizationList.
	self at: 1 put: anObject.
! !

!WeakFinalizerItem methodsFor: 'copying' stamp: 'Igor.Stasenko 9/22/2010 21:06'!
copyWithList: aList

	^ self copy list: aList! !

!WeakFinalizerItem methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/22/2010 21:06'!
executor
	^ executor! !

!WeakFinalizerItem methodsFor: 'finalizing' stamp: 'Igor.Stasenko 9/22/2010 21:06'!
finalizeValues
	" cleanup the receiver, so it could be reused "
	| ex |
	ex := executor.
	executor := nil.
	next := nil.
	ex finalize.! !

!WeakFinalizerItem methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/22/2010 21:06'!
list
	^ list! !

!WeakFinalizerItem class methodsFor: 'as yet unclassified' stamp: 'Igor.Stasenko 3/8/2010 21:00'!
new
	^ self basicNew: 1! !

!WeakFinalizersTest commentStamp: 'TorstenBergmann 2/20/2014 15:36'!
A trait for test purposes!
!WeakFinalizersTest methodsFor: 'as yet unclassified' stamp: 'Igor.Stasenko 3/8/2010 22:15'!
testNewFinalizationSupported
	| list item |

	list := WeakFinalizationList new.
	
	
	item := WeakFinalizerItem new list: list object: Object new executor: nil.
	
	self assert: (list first isNil).
	self assert: (item object notNil).
	
	Smalltalk garbageCollect.
	
	self assert: (item object isNil).
	self assert: (list first == item).
	self assert: (list first next == nil).! !

!WeakIdentityKeyDictionary commentStamp: '<historical>'!
This class represents an identity dictionary with weak keys.!
!WeakIdentityKeyDictionary methodsFor: 'enumeration' stamp: 'SqR 11/7/2013 12:11'!
valuesDo: aBlock 
	"See comments in Dictionary>>valuesDo:.  The code keeps the key so it's
	not collected during the evaluation of aBlock"

	tally = 0 ifTrue: [ ^self ].
	1 to: array size do:
		[ :eachIndex | 
			| eachAssociation eachKey |
			eachAssociation := array at: eachIndex.
			nil == eachAssociation ifFalse:
				[
					eachKey := eachAssociation key.
					nil == eachKey ifFalse: [ aBlock value: eachAssociation value ]
				]
		]! !

!WeakIdentityKeyDictionary methodsFor: 'private' stamp: 'MartinMcClure 3/19/2010 00:08'!
startIndexFor: anObject
	"Return the index at which the scan for anObject should start."
	
	^(anObject identityHash \\ array size) + 1! !

!WeakIdentityKeyDictionary methodsFor: 'private' stamp: 'HenrikSperreJohansen 9/1/2010 22:53'!
scanForEmptySlotFor: aKey
	"Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements."
	
	| index start |
	index := start := aKey identityHash \\ array size + 1.
	[ 
		(array at: index) ifNil: [ ^index ].
		(index := index \\ array size + 1) = start ] whileFalse.
	self errorNoFreeSpace! !

!WeakIdentityKeyDictionary methodsFor: 'private' stamp: 'mvl 3/16/2007 21:27'!
compare: object1 to: object2
	^ object1 == object2! !

!WeakIdentityKeyDictionaryTest commentStamp: 'TorstenBergmann 2/20/2014 15:22'!
SUnit tests for weak identity key dictionaries!
!WeakIdentityKeyDictionaryTest methodsFor: 'tests' stamp: 'sd 7/21/2009 10:46'!
testNoNils
	| d |
	d := WeakIdentityKeyDictionary new
	at: 'hello' copy put: 'world';
		yourself.
	Smalltalk garbageCollect.
	self deny: (d keys includes: nil)! !

!WeakIdentityKeyDictionaryTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 7/1/2009 16:12'!
classToBeTested

^WeakIdentityKeyDictionary ! !

!WeakIdentityKeyDictionaryTest methodsFor: 'errors - specific behavior' stamp: 'CamilloBruni 11/2/2012 16:11'!
testAtPutNil
	"self run: #testAtPut"
	"self debug: #testAtPut"
	
	| aDict keyIn |
	aDict := self nonEmpty .
	keyIn := aDict keys anyOne.
	
	"WeakIdentityKeyDictionary seems to not accept nil key :"
	"dict at: nil put: 'new'.
	self assert: (dict at: nil) = 'new'."
	
	aDict at: keyIn  put: nil.
	self assert: (aDict at: keyIn ) isNil.
	
	aDict at: self keyNotIn put: nil.
	self assert: ( aDict at: self keyNotIn ) isNil.
	
	"dict at: nil put: nil.
	self assert: (dict at: nil) isNil."! !

!WeakIdentityKeyDictionaryTest methodsFor: 'requirements' stamp: 'CamilloBruni 3/23/2013 12:17'!
supportsNilKey
	^ false! !

!WeakIdentityKeyDictionaryTest methodsFor: 'tests' stamp: 'MarcusDenker 5/23/2011 20:35'!
testFinalizeValuesWhenLastChainContinuesAtFront

	| objectWithHashModulo dictionary capacity a b c |
	
	objectWithHashModulo := [ :requestedHash :modulo | | object |
        [
		object := Object new.
			object hash \\ modulo = requestedHash ] whileFalse.
        object ].
		
		dictionary := self classToBeTested new.
		capacity := dictionary capacity.
		a := objectWithHashModulo value: capacity - 2 value: capacity.
		dictionary at: a put: 1.
		b := objectWithHashModulo value: capacity - 1 value: capacity.
		dictionary at: b put: 2.
		c := objectWithHashModulo value: capacity - 2 value: capacity.
		dictionary at: c put: 3.
		self assert: dictionary capacity = capacity.
		self assert: (dictionary array at: capacity - 1) key == a.
		self assert: (dictionary array at: capacity) key == b.
		self assert: (dictionary array at: 1) key == c.
		a := nil.
		Smalltalk garbageCollect.
		dictionary finalizeValues.
		self assert: (dictionary includesKey: b).
		self assert: (dictionary includesKey: c).
		self assert: dictionary slowSize = 2.! !

!WeakKeyAssociation commentStamp: 'mvl 3/11/2007 20:04'!
I am an association holding only weakly on my key.!
!WeakKeyAssociation methodsFor: 'comparing' stamp: 'mvl 3/11/2007 20:54'!
hash
	"Hash is reimplemented because = is implemented."

	^self key hash! !

!WeakKeyAssociation methodsFor: 'accessing' stamp: 'mvl 3/11/2007 20:10'!
key: anObject 
	"Store the argument, anObject, as the lookup key of the receiver."

	self basicAt: 1 put:  anObject! !

!WeakKeyAssociation methodsFor: 'accessing' stamp: 'mvl 3/11/2007 22:44'!
expired
	^value == self! !

!WeakKeyAssociation methodsFor: 'printing' stamp: 'mvl 3/18/2007 11:17'!
storeOn: aStream
	"Store in the format (key->value)"
	aStream 
		nextPut: $(;
		nextPutAll: self class name.
	self expired ifTrue:[
		aStream nextPutAll: ' expired'
	] ifFalse: [
		aStream nextPutAll:' key: '.
		self key storeOn: aStream.
		aStream nextPutAll: ' value:'.
		value storeOn: aStream.
	].
	aStream nextPut: $)! !

!WeakKeyAssociation methodsFor: 'testing' stamp: 'mvl 3/11/2007 20:51'!
isVariableBinding
	"Return true if I represent a literal variable binding"
	^true! !

!WeakKeyAssociation methodsFor: 'comparing' stamp: 'mvl 3/11/2007 20:11'!
< aLookupKey 
	"Refer to the comment in Magnitude|<."

	^self key < aLookupKey key! !

!WeakKeyAssociation methodsFor: 'accessing' stamp: 'mvl 3/16/2007 00:00'!
expire
    "Release the value if the key has gone. Return true if a modification was made."
	(self basicAt: 1) ifNil:[
		value == self ifTrue:[^false].
		value := self.
		^true
	].
	^false! !

!WeakKeyAssociation methodsFor: 'accessing' stamp: 'mvl 3/11/2007 20:32'!
key: aKey value: anObject 
	"Store the arguments as the variables of the receiver."

	self basicAt: 1 put: aKey.
	value := anObject! !

!WeakKeyAssociation methodsFor: 'accessing' stamp: 'mvl 3/11/2007 22:32'!
value
	"Answer the value of the receiver."

	^ value == self ifTrue:[nil] ifFalse:[value]! !

!WeakKeyAssociation methodsFor: 'comparing' stamp: 'mvl 3/11/2007 20:55'!
= aLookupKey

	"XXX why doesn't this consider the value? mvl"

	self species = aLookupKey species
		ifTrue: [^self key = aLookupKey key]
		ifFalse: [^false]! !

!WeakKeyAssociation methodsFor: 'accessing' stamp: 'mvl 3/15/2007 23:31'!
value: anObject 
	"Store the argument, anObject, as the value of the receiver."

	anObject == self ifTrue: [self error: 'Using the WeakAssociation as its own value'].
	value := anObject! !

!WeakKeyAssociation methodsFor: 'printing' stamp: 'mvl 3/11/2007 20:45'!
printOn: aStream

	self key printOn: aStream.
	aStream nextPutAll: '->'.
	value printOn: aStream! !

!WeakKeyAssociation methodsFor: 'accessing' stamp: 'mvl 3/11/2007 20:08'!
key
	"Answer the lookup key of the receiver."

	^self basicAt: 1! !

!WeakKeyAssociation methodsFor: 'accessing' stamp: 'mvl 3/11/2007 20:10'!
name

	^ self key isString
		ifTrue: [self key]
		ifFalse: [self key printString]! !

!WeakKeyAssociation class methodsFor: 'instance creation' stamp: 'mvl 3/18/2007 11:12'!
expired
	"Answer an object that is already expired. Used for printing"
	^(self key: nil value: nil)
		expire;
		yourself! !

!WeakKeyAssociation class methodsFor: 'instance creation' stamp: 'mvl 3/11/2007 20:07'!
key: newKey value: newValue
	"Answer an instance of me with the arguments as the key and value of 
	the association."

	^(self basicNew: 1) key: newKey value: newValue! !

!WeakKeyDictionary commentStamp: 'mvl 3/18/2007 08:48'!
I am a dictionary holding only weakly on my keys. This is a bit dangerous since at any time my keys can go away. Clients are responsible to register my instances by WeakArray such that the appropriate actions can be taken upon loss of any keys. As key may disappear at any time, my reported size may be greater than the number of keys encountered in iterations.

See WeakRegistry for an example of use.

Implementation notes:

I am a set of WeakAssociations. Each WeakAssociation can be in one of three states: a key is present, or the key has been garbage-collected, or the association is expired (meaning that the value has also been released). During finalization, associations with no key expire, but I still keep them to avoid rehashing the entire set. When adding a new entry, the new entry can either go into a slot that is nil, or one that has an expired association. I keep a count of expired associations and rehash when there are too many (currently, if they account for more than 25% of the space).!
!WeakKeyDictionary methodsFor: 'private' stamp: 'mvl 3/11/2007 21:43'!
grow
	super grow.
	expired := 0.! !

!WeakKeyDictionary methodsFor: 'private' stamp: 'HenrikSperreJohansen 2/25/2010 13:03'!
fullCheck
	"Inlined super fullCheck, since the correct + X value for rehash check depends on its implementation"
	"Keep array at least 1/4 free for decent hash behavior"
	array size - tally < (array size // 4 max: 1)
		ifTrue: [self grow].
	"Make sure we never have so many expired entries that adding might fail"
	4 * expired + 4 > array size 
		ifTrue: [self rehash].! !

!WeakKeyDictionary methodsFor: 'testing' stamp: 'IgorStasenko 3/22/2011 16:19'!
isHealthy
	"Test that object hashes match their positions stored in the receiver,
	answer true if everything ok, false otherwise
	
	WeakKeyDictionary allInstances select: [:dict |
		dict isHealthy not ]
	Dictionary allSubInstances select: [:dict |
		dict isHealthy not ]
	"
	array withIndexDo: [:elem :i |
		(elem notNil and: [elem key notNil ])
				ifTrue:  [(self scanFor: elem key) == i ifFalse: [ ^ false ]
			]
	].
	^ true! !

!WeakKeyDictionary methodsFor: 'initialization' stamp: 'mvl 3/11/2007 21:40'!
initialize: n
	expired := 0.
	^super initialize: n! !

!WeakKeyDictionary methodsFor: 'private' stamp: 'mvl 3/18/2007 09:49'!
scanFor: anObject
	"mvl 10/21/2007: The method has been copied to this location to indicate that whenever #scanFor: changes #scanForEmpty: must be changed in the receiver as well."
	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. Expired associations are ignored, since callers take non-nil slots as a successful search. Subclasses should override startIndexFor: and compare:to: if they have a different semantics for matching elements."
	| element start finish |
	finish := array size.
	start := self startIndexFor: anObject.
	
	"Search from (hash mod size) to the end."
	start to: finish do:
		[:index | ((element := array at: index) == nil or: [self compare: element key to: anObject])
			ifTrue: [^ index ]].

	"Search from 1 to where we started."
	1 to: start-1 do:
		[:index | ((element := array at: index) == nil or: [self compare: element key to: anObject])
			ifTrue: [^ index ]].

	^ 0  "No match AND no empty slot"! !

!WeakKeyDictionary methodsFor: 'enumerating' stamp: 'nice 1/5/2010 15:59'!
associationsDo: aBlock 
	"Evaluate aBlock for each of the receiver's elements (key/value 
	associations)."

	

	super associationsDo: [:association | | key | 
		"Hold onto the key so it won't be collected while the block is evaluated."
		key := association key.
		key ifNotNil:[aBlock value: association]].! !

!WeakKeyDictionary methodsFor: 'private' stamp: 'mvl 3/18/2007 11:33'!
valueAtNewKey: aKey put: anObject atIndex: index declareFrom: aDictionary 
	self shouldNotImplement.! !

!WeakKeyDictionary methodsFor: 'removing' stamp: 'mvl 3/18/2007 11:41'!
removeKey: key ifAbsent: aBlock
	"Remove key (and its associated value) from the receiver. If key is not in 
	the receiver, answer the result of evaluating aBlock. Otherwise, answer 
	the value externally named by key."

	| index result assoc |
	index := self findElementOrNil: key.
	assoc := array at: index.
	(assoc == nil or: [assoc key isNil]) ifTrue: [ ^ aBlock value ].
	assoc key: nil.
	result := assoc value.
	assoc expire.
	expired := expired + 1.
	tally := tally - 1.
	^result! !

!WeakKeyDictionary methodsFor: 'adding' stamp: 'ar 3/21/98 16:00'!
add: anAssociation
	self at: anAssociation key put: anAssociation value.
	^ anAssociation! !

!WeakKeyDictionary methodsFor: 'enumerating' stamp: 'SqR 11/7/2013 12:11'!
valuesDo: aBlock 
	"See comments in Dictionary>>valuesDo:.  The code keeps the key so it's
	not collected during the evaluation of aBlock"

	tally = 0 ifTrue: [ ^self ].
	1 to: array size do:
		[ :eachIndex | 
			| eachAssociation eachKey |
			eachAssociation := array at: eachIndex.
			nil == eachAssociation ifFalse:
				[
					eachKey := eachAssociation key.
					aBlock value: eachAssociation value
				]
		]! !

!WeakKeyDictionary methodsFor: 'finalization' stamp: 'mvl 3/17/2007 21:29'!
finalizeValues: finiObjects
	"Clear all associations with key == nil and value is in finiObjects."
	array do:[:assoc|
		(assoc notNil and:[finiObjects includes: assoc value]) ifTrue:[
			assoc expire.
			expired := expired + 1.
			tally := tally - 1.
		].
	].
! !

!WeakKeyDictionary methodsFor: 'private' stamp: 'mvl 3/15/2007 16:18'!
fixCollisionsFrom: oldIndex
	"This is an internal method that should not be needed in WeakKeyDictionary"
	self shouldNotImplement.! !

!WeakKeyDictionary methodsFor: 'accessing' stamp: 'Igor.Stasenko 10/1/2010 17:23'!
slowSize
	"Careful!! Answer the maximum amount
	of elements in the receiver, not the
	exact amount"

	| count |
	count := 0.
	1 to: array size do: [ :index |
		(array at: index) ifNotNil: [ :object |
			object expired ifFalse: [
				count := count + 1 ] ] ].
	^count! !

!WeakKeyDictionary methodsFor: 'private' stamp: 'mvl 3/16/2007 21:21'!
startIndexFor: anObject
	"Return the index at which the scan for anObject should start."
	
	^(anObject hash \\ array size) + 1! !

!WeakKeyDictionary methodsFor: 'enumerating' stamp: 'mvl 3/16/2007 09:55'!
allAssociationsDo: aBlock 
	"Evaluate aBlock for each of the receiver's elements (key/value 
	associations). This includes associations with nil keys, except for
	the expired ones."

	super associationsDo: [:association | 
		association expired ifFalse:[aBlock value: association]].! !

!WeakKeyDictionary methodsFor: 'private' stamp: 'HenrikSperreJohansen 9/1/2010 23:37'!
rehash
	"Rehash the receiver."
	super rehash.
	expired := 0.! !

!WeakKeyDictionary methodsFor: 'private' stamp: 'mvl 3/16/2007 21:28'!
compare: object1 to: object2
	^object1 = object2! !

!WeakKeyDictionary methodsFor: 'finalization' stamp: 'Igor.Stasenko 10/1/2010 18:53'!
expiredValuesDo: aBlock
	"Clear all associations with nil keys"
	1 to: array size do:[:i | | assoc |
		assoc := array at: i.
		(assoc notNil and: [ assoc key isNil and: [assoc expired not ]])
		ifTrue: [ 
			aBlock value: assoc value.
			assoc expire.
			expired := expired + 1.
			tally := tally - 1.	]]! !

!WeakKeyDictionary methodsFor: 'accessing' stamp: 'IgorStasenko 10/31/2010 02:48'!
overridingAt: key put: anObject
	"Set the value at key to be anObject.  If key is not found, create a new
	entry for key and set is value to anObject. Answer anObject.
	May override an association with key == nil"
	
	| index element |
	key isNil ifTrue:[^anObject].
	index := self scanForKeyOrNil: key.
	
	"There should always be room."
	index = 0 ifTrue: [ self error: 'No space left in dictionary' ].
	
	element := array at: index.
	element == nil
		ifTrue: [self atNewIndex: index put: (WeakKeyAssociation key: key value: anObject)]
		ifFalse: [
			element expired ifTrue: [ tally := tally + 1].
			element key: key.
			element value: anObject.
			self fullCheck.
		].
	^ anObject! !

!WeakKeyDictionary methodsFor: 'private' stamp: 'StephaneDucasse 5/26/2010 21:40'!
scanForEmpty: anObject
	"Scan the key array for the first slot containing either a nil or an expired association (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found."
	| element start finish firstNil |
	finish := array size.
	start := self startIndexFor: anObject.
	firstNil := nil.
	
	"Search from (hash mod size) to the end."
	start to: finish do:
		[:index | ((element := array at: index) == nil 
						or: [self compare: element key to: anObject])
			ifTrue: [
				"If we found no match, and have an expired slot, use that one."
				(element isNil and: [firstNil notNil]) ifTrue:[^firstNil].
				^ index 
			].
			"If this slot is expired, and we haven't seen an earlier expired slot, record it"
			(element notNil 
				and: [element expired 
						and: [firstNil isNil]]) ifTrue: [firstNil := index].
		].

	"Search from 1 to where we started."
	1 to: start-1 do:
		[:index | ((element := array at: index) == nil 
					or: [self compare: element key to: anObject])
			ifTrue: [
				(element isNil and: [firstNil notNil]) ifTrue:[^firstNil].
				^ index 
			].
			(element notNil 
				and: [element expired 
						and: [firstNil isNil]]) ifTrue: [firstNil := index].
		].

	"If there is no empty slot, but an expired one, return it."	
	firstNil notNil ifTrue:[^firstNil].

	^ 0  "No match AND no empty slot"! !

!WeakKeyDictionary methodsFor: 'accessing' stamp: 'mvl 3/18/2007 09:50'!
at: key put: anObject 
	"Set the value at key to be anObject.  If key is not found, create a new
	entry for key and set is value to anObject. Answer anObject."
	| index element |
	key isNil ifTrue:[^anObject].
	index := self scanForEmpty: key.
	
	"There should always be room."
	index = 0 ifTrue: [ self error: 'No space left in dictionary' ].
	
	element := array at: index.
	element == nil
		ifTrue: [self atNewIndex: index put: (WeakKeyAssociation key: key value: anObject)]
		ifFalse: [
			element expired ifTrue: [ tally := tally + 1].
			element key: key.
			element value: anObject.
			self fullCheck.
		].
	^ anObject! !

!WeakKeyDictionary methodsFor: 'private' stamp: 'StephaneDucasse 4/30/2010 16:02'!
postCopy
	"Must copy the associations, or later store will affect both the
original and the copy"

	array := array collect: [:assoc |
				assoc 
					ifNil: [nil]
					ifNotNil: [
						assoc expired 
							ifTrue: [ WeakKeyAssociation expired]
							ifFalse: [WeakKeyAssociation key: assoc key value: assoc value]]]! !

!WeakKeyDictionary methodsFor: 'private' stamp: 'IgorStasenko 10/31/2010 02:48'!
scanForKeyOrNil: anObject
	"Same as scanFor: , but treats association with key == nil as empty slot"
	
	| element start finish |
	finish := array size.
	start := self startIndexFor: anObject.
	
	"Search from (hash mod size) to the end."
	start to: finish do:
		[:index | ((element := array at: index) == nil or: [ element key isNil or: [self compare: element key to: anObject]])
			ifTrue: [^ index ]].

	"Search from 1 to where we started."
	1 to: start-1 do:
		[:index | ((element := array at: index) == nil or: [ element key isNil or: [self compare: element key to: anObject]])
			ifTrue: [^ index ]].

	^ 0  "No match AND no empty slot"! !

!WeakKeyDictionary methodsFor: 'finalization' stamp: 'Igor.Stasenko 10/1/2010 18:51'!
finalizeValues
	"Clear all associations with nil keys.
	Avoid using block closures, so it won't produce many garbage 
	(since pushing closure as argument requires creating its preinitialized copy)"
	1 to: array size do:[:i | | assoc |
		assoc := array at: i.
		assoc ifNotNil:[
			assoc expire ifTrue:[
				expired := expired + 1.
				tally := tally - 1.
			].
		].
	].
! !

!WeakKeyDictionary methodsFor: 'private' stamp: 'mvl 3/18/2007 08:03'!
noCheckAddForRehash: anAssociation
	^self noCheckAdd: anAssociation! !

!WeakKeyDictionary methodsFor: 'private' stamp: 'mvl 3/28/2007 12:03'!
noCheckAdd: anAssociation
	"Add anAssociation to the receiver. Discard expired associations. Put nil keys at the beginning."
	
	| key |
	
	key := anAssociation key. "Hold on to the key during this method"

	anAssociation expired ifFalse:[
		key ifNotNil:[
			super noCheckAdd: anAssociation
		] ifNil: [
			1 to: array size do:[:n|
				(array at: n) ifNil:[
					array at: n put: anAssociation. 
					tally := tally + 1.
					^self
				].
			].
			self error: 'could not find an empty slot.'
		].
	].! !

!WeakKeyDictionary methodsFor: 'private' stamp: 'HenrikSperreJohansen 9/1/2010 23:19'!
noCheckNoGrowFillFrom: anArray
	"Add the elements of anArray except nils and flag to me assuming that I don't contain any of them, they are unique and I have more free space than they require."

	tally := 0.
	1 to: anArray size do: [ :index |
		(anArray at: index) ifNotNil: [ :association |
			association key 
				ifNil: [ finalizer ifNotNil: [ finalizer value: association value ] ]
				ifNotNil: [ :key | "Don't let the key go away"
					array
						at: (self scanForEmptySlotFor: key)
						put: association.
					tally := tally + 1 ] ] ]! !

!WeakKeyDictionaryTest commentStamp: 'TorstenBergmann 2/20/2014 15:22'!
SUnit tests for weak key dictionaries!
!WeakKeyDictionaryTest methodsFor: 'testing' stamp: 'mvl 3/28/2007 12:00'!
testGrow
	keys := nil.
	dict at: self put: nil.
	Smalltalk garbageCollect.

	"Keys are gone but not yet finalized."
	dict grow.! !

!WeakKeyDictionaryTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 7/1/2009 12:15'!
classToBeTested

^ SystemDictionary! !

!WeakKeyDictionaryTest methodsFor: 'accessing' stamp: 'mvl 3/15/2007 16:45'!
size
	"Answer the number of keys that should be used in testing."
	^1000! !

!WeakKeyDictionaryTest methodsFor: 'setup' stamp: 'TestRunner 12/11/2009 18:05'!
setUp
	keys := (1 to: 1000) collect:[:n| 'key', n asString].
	dict := WeakKeyDictionary new.
	keys do:[:n| dict at: n put: n,n].
	super setUp.! !

!WeakKeyDictionaryTest methodsFor: 'testing' stamp: 'StephaneDucasse 5/28/2011 13:43'!
testClearing
	keys := nil.
	dict at: self put: nil.
	self assert: dict size = (self size + 1).

	Smalltalk garbageCollect.

	"Keys are gone but not yet finalized."
	self assert: dict size = (self size + 1).
	self assert: dict keys size = 1.
	
	dict finalizeValues.
	
	"Now the size should be adjusted."
	self assert: dict size = 1.
	! !

!WeakKeyDictionaryTest class methodsFor: 'building suites' stamp: 'cyrille.delaunay 7/1/2009 12:15'!
shouldInheritSelectors

^true! !

!WeakKeyDictionaryTest class methodsFor: 'as yet unclassified' stamp: 'nice 1/5/2010 15:59'!
timingMany
	| dicts keys size loops count |
	
	size := 10.
	count := 10000.
	loops := 10.
	
	keys := (1 to: size) collect:[:n| 'foo',n asString].
	
	dicts := OrderedCollection new.
	count timesRepeat:[ | dict |
		dict := WeakKeyDictionary new.
		keys do:[:k| dict at: k put: k].
		dicts add: dict.
	].
	Smalltalk garbageCollect.
	^Time millisecondsToRun: [
			loops timesRepeat:[
				dicts do: [:d| d finalizeValues].
			]].
! !

!WeakKeyDictionaryTest class methodsFor: 'as yet unclassified' stamp: 'mvl 4/15/2007 21:58'!
timingLarge
	| dict keys size loops |
	
	size := 100000.
	loops := 10.
	
	keys := (1 to: size) collect:[:n| 'foo',n asString].
	Smalltalk garbageCollect.
	dict := WeakKeyDictionary new.
	keys do:[:k| dict at: k put: k].
	Smalltalk garbageCollect.
	^Time millisecondsToRun: [
		loops timesRepeat:[
			dict at: 'bar','0' put: 100.
			Smalltalk garbageCollectMost.
			dict finalizeValues.
		]].
! !

!WeakKeyToCollectionDictionary commentStamp: '<historical>'!
This class represents an identity dictionary with weak keys, whose values are collections. 
Keys not in the dictionary are mapped to the empty collection.  Conversely, if a collection becomes empty, the mapping can be removed to save time and space.  However, because this requires re-hashing, it does not pay to do this to eagerly.!
!WeakKeyToCollectionDictionary methodsFor: 'finalization' stamp: 'apb 7/12/2004 23:47'!
finalizeValues 
	self rehash! !

!WeakKeyToCollectionDictionary methodsFor: 'private' stamp: 'mvl 3/18/2007 08:09'!
noCheckAddForRehash: anAssociation
	| cleanedValue |
	anAssociation key ifNil:[^self].
	cleanedValue := anAssociation value copyWithout: nil.
	cleanedValue notEmpty ifTrue:[
		anAssociation value: cleanedValue.
		super noCheckAddForRehash: anAssociation.
	].! !

!WeakKeyToCollectionDictionary methodsFor: 'private' stamp: 'HenrikSperreJohansen 9/1/2010 23:19'!
noCheckNoGrowFillFrom: anArray
	"Add the elements of anArray except nils and associations with empty collections (or with only nils) to me assuming that I don't contain any of them, they are unique and I have more free space than they require."

	tally := 0.
	1 to: anArray size do: [ :index |
		(anArray at: index) ifNotNil: [ :association |
			association key ifNotNil: [ :key | "Don't let the key go away"
				| cleanedValue |
				(cleanedValue := association value copyWithout: nil) isEmpty 
					ifFalse: [
						association value: cleanedValue.
						array
							at: (self scanForEmptySlotFor: key)
							put: association.
						tally := tally + 1 ] ] ] ]! !

!WeakKeyToCollectionDictionaryTest commentStamp: 'TorstenBergmann 2/20/2014 15:27'!
SUnit tests for weak key to collection dictionaries !
!WeakKeyToCollectionDictionaryTest methodsFor: 'errors - those methods should be tested with collection keys' stamp: 'cyrille.delaunay 7/3/2009 11:02'!
testRemoveKeyIfAbsent
	
	"| collection oldSize keyIn value result |
	collection := self nonEmptyDict .
	oldSize := collection size.
	keyIn := collection  keys anyOne.
	value := collection at: keyIn .
	
	result := collection removeKey: keyIn ifAbsent: [888].
	
	self assert: result = value.
	self assert: (collection  size = (oldSize - 1)).
	self should: [ (collection  at: keyIn )] raise: Error.
	
	self assert: (collection removeKey: self keyNotInNonEmptyDict ifAbsent: [888] ) = 888."! !

!WeakKeyToCollectionDictionaryTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 7/3/2009 10:59'!
classToBeTested 
 ^ WeakKeyToCollectionDictionary! !

!WeakKeyToCollectionDictionaryTest methodsFor: 'errors - those methods should be tested with collection keys' stamp: 'cyrille.delaunay 7/3/2009 13:48'!
testRemoveKey
	"self debug: #testRemoveKey"

"	| collection oldSize keyIn |
	collection := self nonEmptyDict .
	oldSize := collection size.
	keyIn := collection  keys anyOne.
	
	collection removeKey: keyIn .
	self assert: (collection  size = (oldSize - 1)).
	self should: [ (collection  at: keyIn )] raise: Error.
	
	self should: [collection removeKey: self keyNotInNonEmptyDict ] raise: Error"! !

!WeakKeyToCollectionDictionaryTest methodsFor: 'errors - those methods should be tested with collection keys' stamp: 'cyrille.delaunay 7/3/2009 13:49'!
testKeysAndValuesRemove
	" should be tested with collection keys"
	
	"| oldSize collection keyIn |
	
	
	collection := self nonEmptyDict .
	oldSize := collection  size.
	keyIn := collection keys anyOne.
	
	collection  keysAndValuesRemove: [:key :value | key == self keyNotInNonEmptyDict ].
	self assert: (collection  size = (oldSize )).
	
	collection  keysAndValuesRemove: [:key :value | key == keyIn ].
	self assert: (collection  size = (oldSize - 1)).
	self should: [ collection at: keyIn  ] raise: Error."! !

!WeakLayout commentStamp: '<historical>'!
I am a special layout for weak variable sized objects such as WeakArray.

I contain a fixed number of Slots plus.
Instances of classes using this kind of layout have only a minimum given size. Instances have a custom number of additional weak fields which can be accessed with an index.

References held in the variable part are held weakly and might be nilled out by the garbage collector at any time. References in the named section are held strongly as in the default layout.!
!WeakLayout methodsFor: 'format' stamp: 'ToonVerwaest 4/1/2011 01:27'!
instanceSpecification
	^ 4! !

!WeakLayout methodsFor: 'testing' stamp: 'ToonVerwaest 4/1/2011 01:26'!
isVariable
	^ true! !

!WeakLayout methodsFor: 'testing' stamp: 'ToonVerwaest 4/1/2011 01:26'!
isWeak
	^ true! !

!WeakLayout class methodsFor: 'instance creation' stamp: 'MartinDias 7/11/2013 16:01'!
extending: superLayout scope: aScope host: aClass
	^ (superLayout extendWeak: aScope)
		host: aClass;
		yourself! !

!WeakMessageSend commentStamp: 'tlk 5/5/2006 12:39'!
Instances of WeakMessageSend encapsulate message sends to objects, like MessageSend. Unlike MessageSend it is not necessarily a valid mesage.  A request to value only results in a send if infact it is valid. 

See MessageSendComments also. WeakMessageSend is used primarily for event regristration. 

Unlike MessageSend WeakMessageSend stoes receiver (object receiving the message send) as a the first and only element of its array as opposed to a named ivar.
But like MessageSend, it does have
 selector		Symbol -- message selector
 arguments		Array -- bound arguments
and it also has
 shouldBeNil		Boolean --  used to ensure array of arguments is not all nils!
!WeakMessageSend methodsFor: 'accessing' stamp: 'nk 4/25/2002 07:54'!
selector
	^selector
! !

!WeakMessageSend methodsFor: 'evaluating' stamp: 'IgorStasenko 3/12/2011 18:22'!
value: anObject1 value: anObject2 value: anObject3
	self ensureReceiver ifFalse: [ ^ nil ].
	
	^self receiver 
		perform: selector 
		with: anObject1
		with: anObject2
		with: anObject3! !

!WeakMessageSend methodsFor: 'private' stamp: 'PavelKrivanek 6/24/2012 11:44'!
ensureReceiver
  "Return true if my receiver hasn't gone away"
  self receiver ifNil: [^ false].
  (self receiver class isObsolete) ifTrue: [^ false].
  (self receiver isBehavior and: [self receiver isObsolete]) ifTrue: [^ false].
  ^ true.
! !

!WeakMessageSend methodsFor: 'converting' stamp: 'nk 4/25/2002 09:33'!
asMessageSend
	^MessageSend receiver: self receiver selector: selector arguments: (Array withAll: self arguments) 
! !

!WeakMessageSend methodsFor: 'private' stamp: 'rw 4/27/2002 07:34'!
isReceiverOrAnyArgumentGarbage
	"Make sure that my receiver hasn't gone away"
	^self isReceiverGarbage 
		or: [self isAnyArgumentGarbage]
! !

!WeakMessageSend methodsFor: 'private' stamp: 'rw 4/27/2002 07:33'!
isAnyArgumentGarbage
	"Make sure that my arguments haven't gone away"
	arguments ifNotNil: [
		arguments with: shouldBeNil do: [ :arg :flag |
			(flag not and: [arg isNil])
				ifTrue: [^true]
		]
	].
	^false
! !

!WeakMessageSend methodsFor: 'evaluating' stamp: 'nk 12/8/2002 12:15'!
valueWithEnoughArguments: anArray
	"call the selector with enough arguments from arguments and anArray"
	| args |
	self ensureReceiverAndArguments ifFalse: [ ^nil ].
	args := Array new: selector numArgs.
	args replaceFrom: 1
		to: ( arguments size min: args size)
		with: arguments
		startingAt: 1.
	args size > arguments size ifTrue: [
		args replaceFrom: arguments size + 1
			to: (arguments size + anArray size min: args size)
			with: anArray
			startingAt: 1.
	].
	^ self receiver perform: selector withArguments: args
! !

!WeakMessageSend methodsFor: 'evaluating' stamp: 'nk 12/8/2002 12:15'!
value
	^ arguments isNil
		ifTrue: [self ensureReceiver
				ifTrue: [self receiver perform: selector] ifFalse: []]
		ifFalse: [self ensureReceiverAndArguments
				ifTrue: [self receiver
						perform: selector
						withArguments: (Array withAll: arguments)] ifFalse: []]! !

!WeakMessageSend methodsFor: 'evaluating' stamp: 'IgorStasenko 3/12/2011 18:21'!
value: anObject
	self ensureReceiver ifFalse: [ ^ nil ].
	
	^self receiver 
		perform: selector 
		with: anObject! !

!WeakMessageSend methodsFor: 'printing' stamp: 'nk 4/25/2002 09:36'!
printOn: aStream

        aStream
                nextPutAll: self class name;
                nextPut: $(.
        selector printOn: aStream.
        aStream nextPutAll: ' -> '.
        self receiver printOn: aStream.
        aStream nextPut: $)
! !

!WeakMessageSend methodsFor: 'private' stamp: 'rw 4/27/2002 07:31'!
isReceiverGarbage
	"Make sure that my receiver hasn't gone away"
	^self receiver isNil
! !

!WeakMessageSend methodsFor: 'testing' stamp: 'nk 4/25/2002 08:04'!
isMessageSend
	^true
! !

!WeakMessageSend methodsFor: 'testing' stamp: 'nk 8/24/2003 01:12'!
isValid
	^self isReceiverOrAnyArgumentGarbage not
! !

!WeakMessageSend methodsFor: 'evaluating' stamp: 'IgorStasenko 3/12/2011 18:20'!
cull: arg1 cull: arg2
	^ selector numArgs < 2 
		ifTrue: [ self cull: arg1]
		ifFalse: [ self value: arg1 value: arg2 ]! !

!WeakMessageSend methodsFor: 'comparing' stamp: 'nk 4/25/2002 09:31'!
hash
	"work like MessageSend>>hash"
	^self receiver hash bitXor: selector hash
! !

!WeakMessageSend methodsFor: 'evaluating' stamp: 'IgorStasenko 3/12/2011 18:21'!
value: anObject1 value: anObject2 
	self ensureReceiver ifFalse: [ ^ nil ].
	
	^self receiver 
		perform: selector 
		with: anObject1
		with: anObject2! !

!WeakMessageSend methodsFor: 'evaluating' stamp: 'IgorStasenko 3/12/2011 18:19'!
cull: arg
	^ selector numArgs = 0 
		ifTrue: [ self value ]
		ifFalse: [ self value: arg ].! !

!WeakMessageSend methodsFor: 'evaluating' stamp: 'IgorStasenko 3/12/2011 18:20'!
cull: arg1 cull: arg2 cull: arg3
	^ selector numArgs < 3 
		ifTrue: [ self cull: arg1 cull: arg2 ]
		ifFalse: [ self value: arg1 value: arg2 value: arg3 ]! !

!WeakMessageSend methodsFor: 'accessing' stamp: 'nk 4/25/2002 07:54'!
receiver: anObject
	self at: 1 put: anObject
! !

!WeakMessageSend methodsFor: 'converting' stamp: 'rww 10/20/2002 19:56'!
asMinimalRepresentation

	self isReceiverOrAnyArgumentGarbage
		ifTrue: [^nil]
		ifFalse:[^self].! !

!WeakMessageSend methodsFor: 'accessing' stamp: 'nk 4/25/2002 09:38'!
arguments: anArray
	arguments := WeakArray withAll: anArray.
	"no reason this should be a WeakArray"
	shouldBeNil := Array withAll: (anArray collect: [ :ea | ea isNil ]).
! !

!WeakMessageSend methodsFor: 'accessing' stamp: 'nk 4/25/2002 07:54'!
receiver
	^self at: 1
! !

!WeakMessageSend methodsFor: 'accessing' stamp: 'nk 4/25/2002 07:55'!
selector: aSymbol
	selector := aSymbol
! !

!WeakMessageSend methodsFor: 'evaluating' stamp: 'nk 12/8/2002 12:15'!
valueWithArguments: anArray
	self ensureReceiverAndArguments ifFalse: [ ^nil ].
	^ self receiver 
		perform: selector 
		withArguments: (self collectArguments: anArray)! !

!WeakMessageSend methodsFor: 'comparing' stamp: 'nk 4/25/2002 08:05'!
= anObject
	"Compare equal to equivalent MessageSend"
	^ anObject isMessageSend
		and: [self receiver == anObject receiver
		and: [selector == anObject selector
		and: [(Array withAll: arguments) = (Array withAll: anObject arguments)]]]
! !

!WeakMessageSend methodsFor: 'private' stamp: 'PavelKrivanek 6/24/2012 11:48'!
ensureReceiverAndArguments

  "Return true if my receiver hasn't gone away"
  self receiver ifNil: [^ false].
  (self receiver class isObsolete) ifTrue: [^ false].
  (self receiver isBehavior and: [self receiver isObsolete]) ifTrue: [^ false].

  "Make sure that my arguments haven't gone away"
  arguments ifNotNil: [
    arguments with: shouldBeNil do: [ :arg :flag |
      arg ifNil: [ flag ifFalse: [ ^false ]]
    ]
  ].

  ^true
! !

!WeakMessageSend methodsFor: 'private' stamp: 'nk 12/8/2002 12:13'!
ensureArguments
	"Return true if my arguments haven't gone away"
	arguments ifNotNil: [
		arguments with: shouldBeNil do: [ :arg :flag |
			arg ifNil: [ flag ifFalse: [ ^false ]]
		]
	].
	^true
! !

!WeakMessageSend methodsFor: 'accessing' stamp: 'nk 4/25/2002 09:54'!
arguments
	^arguments ifNil: [ Array new ]
! !

!WeakMessageSend methodsFor: 'private' stamp: 'nk 4/25/2002 09:49'!
collectArguments: anArgArray
	"Private"
    | staticArgs |
    staticArgs := self arguments.
    ^(anArgArray size = staticArgs size)
        ifTrue: [anArgArray]
        ifFalse:
            [(staticArgs isEmpty
                ifTrue: [ staticArgs := Array new: selector numArgs]
                ifFalse: [staticArgs copy] )
                    replaceFrom: 1
                    to: (anArgArray size min: staticArgs size)
                    with: anArgArray
                    startingAt: 1]
! !

!WeakMessageSend class methodsFor: 'instance creation' stamp: 'nk 4/25/2002 09:37'!
receiver: anObject selector: aSymbol
	^ self receiver: anObject selector: aSymbol arguments: #()
! !

!WeakMessageSend class methodsFor: 'instance creation' stamp: 'nk 4/25/2002 09:37'!
receiver: anObject selector: aSymbol arguments: anArray
	^ self new
		receiver: anObject;
		selector: aSymbol;
		arguments: anArray
! !

!WeakMessageSend class methodsFor: 'instance creation' stamp: 'nk 4/25/2002 10:00'!
new
	^self new: 1
! !

!WeakMessageSend class methodsFor: 'instance creation' stamp: 'nk 4/25/2002 09:37'!
receiver: anObject selector: aSymbol argument: aParameter
	^ self receiver: anObject selector: aSymbol arguments: (Array with: aParameter)
! !

!WeakMessageSendTest commentStamp: 'TorstenBergmann 2/5/2014 08:48'!
SUnit tests for WeakMessageSend!
!WeakMessageSendTest methodsFor: 'tests' stamp: 'sd 6/5/2005 09:11'!
testReceiverWithGC

	| m |
	m := WeakMessageSend
		receiver: Object new
		selector: #isNil.
	Smalltalk garbageCollectMost.
	self assert: (m value isNil).! !

!WeakMessageSendTest methodsFor: 'tests' stamp: 'sd 6/5/2005 09:11'!
testOneArgumentWithGC

	| m |
	m := WeakMessageSend
		receiver: Array
		selector: #with:
		arguments: { Object new }.
	Smalltalk garbageCollectMost.
	self assert: (m value isNil)! !

!WeakMessageSendTest methodsFor: 'tests' stamp: 'sd 6/5/2005 09:10'!
testNoArguments
	"self run: #testNoArguments"

	| m |
	m := WeakMessageSend
			receiver: true
			selector: #yourself.
	self assert: (m value).
! !

!WeakMessageSendTest methodsFor: 'tests' stamp: 'sd 6/5/2005 09:11'!
testTwoArguments

	| m |
	m := WeakMessageSend
		receiver: Array
		selector: #with:with:
		arguments: { 1 . 2 }.
	Smalltalk garbageCollectMost.
	self assert: (m value = { 1 . 2 }).
! !

!WeakMessageSendTest methodsFor: 'tests' stamp: 'sd 6/5/2005 09:11'!
testOneArgument
	"self run: #testOneArgument"	

	| m |
	m := WeakMessageSend
		receiver: Array
		selector: #with:
		argument: 1.
	Smalltalk garbageCollectMost.
	self assert: (m value  = { 1 })
! !

!WeakOrderedCollection commentStamp: '<historical>'!
I am just like an OrderedCollection except that I hold my objects weakly.

In use, be aware that objects only referenced by me are not "removed" (like in OrderedCollection), but merely nilled. So guard against nils when iterating/accessing, and don't expect #size to represent the number of objects I hold. 

For more details, read my tests in WeakOrderedCollectionTest. !
!WeakOrderedCollection class methodsFor: 'as yet unclassified' stamp: 'cmm 10/25/2010 22:27'!
arrayType
	^ WeakArray! !

!WeakOrderedCollectionTest commentStamp: 'TorstenBergmann 2/20/2014 15:36'!
A trait for test purposes!
!WeakOrderedCollectionTest methodsFor: 'as yet unclassified' stamp: 'MarianoMartinezPeck 8/3/2011 14:38'!
testWeakOrderedCollectionAllGarbageCollected
	| anArray anotherObject weakOrderedCollection |
	
	anArray := OrderedCollection new.
	anotherObject := Time new. 
	anotherObject seconds: 40.
	anArray add: Date today.
	anArray add: anotherObject.

	weakOrderedCollection := WeakOrderedCollection new.
	weakOrderedCollection 
		add: anArray;
		add: anotherObject.
		
	"Let's add lot of stuff to be sure #grow is send."
	(1 to: 1000) do: [:index | weakOrderedCollection add: Date today ].
	
	anotherObject := nil.
	anArray := nil.
	
	3 timesRepeat: [Smalltalk garbageCollect].
	self assert: weakOrderedCollection asSet size equals: 1.
	self assert: (weakOrderedCollection asSet includes: nil)

! !

!WeakOrderedCollectionTest methodsFor: 'as yet unclassified' stamp: 'MarianoMartinezPeck 8/3/2011 14:38'!
testWeakOrderedCollectionSomeGarbageCollected
	| anArray anotherObject weakOrderedCollection |
	
	anArray := OrderedCollection new.
	anotherObject := Time new. 
	anotherObject seconds: 40.
	anArray add: Duration new.
	anArray add: anotherObject.

	weakOrderedCollection := WeakOrderedCollection new.
	weakOrderedCollection 
		add: anArray;
		add: anotherObject.
		
	"Let's add lot of stuff to be sure #grow is send."
	(1 to: 1000) do: [:index | weakOrderedCollection add: Date today ].
	
	anArray := nil.
	
	3 timesRepeat: [Smalltalk garbageCollect].
	self assert: weakOrderedCollection asSet size equals: 2.
	self assert: (weakOrderedCollection asSet includes: anotherObject).
	self assert: ((weakOrderedCollection asSet select: [:each | each class = Duration]) isEmpty).
	self assert: ((weakOrderedCollection asSet select: [:each | each class = OrderedCollection]) isEmpty).

! !

!WeakRegistry commentStamp: 'Igor.Stasenko 3/8/2010 23:04'!
This kind of WeakRegistry using a new VM feature,
which allows a more robust finalization support.

In contrast to old implementation, it doesn't spending linear time , checking what elements became garbage.!
!WeakRegistry methodsFor: 'printing' stamp: 'CamilloBruni 10/15/2012 18:40'!
removeAll
	"See super"
	
	self protected:[
		valueDictionary removeAll.
		list swapWithNil. "prune finalization list as well"
	].! !

!WeakRegistry methodsFor: 'private' stamp: 'Igor.Stasenko 5/25/2010 05:35'!
species
	^Set! !

!WeakRegistry methodsFor: 'accessing' stamp: 'IgorStasenko 10/31/2010 02:50'!
size
	"Use #associationsDo: , to count associations with non-nil keys"
	| count |
	count := 0.
	self protected: [
		valueDictionary associationsDo: [:ass | count := count +1 ]].
	^ count! !

!WeakRegistry methodsFor: 'accessing' stamp: 'Igor.Stasenko 10/11/2010 15:11'!
keys

	^self protected: [ valueDictionary keys ]
! !

!WeakRegistry methodsFor: 'printing' stamp: 'Igor.Stasenko 5/25/2010 05:21'!
remove: oldObject ifAbsent: exceptionBlock
	"Remove oldObject as one of the receiver's elements."
	
	oldObject ifNil: [ ^nil ].
	^(self protected: [ valueDictionary removeKey: oldObject ifAbsent: nil ])
		ifNil: [ exceptionBlock value ]! !

!WeakRegistry methodsFor: 'private' stamp: 'Igor.Stasenko 5/25/2010 05:34'!
protected: aBlock
	"Execute aBlock protected by the accessLock"

	^ sema
		critical: aBlock
		ifError: [ :msg :rcvr |
		rcvr error: msg ] ! !

!WeakRegistry methodsFor: 'initialization' stamp: 'Igor.Stasenko 5/28/2010 05:12'!
initialize
	valueDictionary := WeakIdentityKeyDictionary new.
	list := WeakFinalizationList new.
	sema := Semaphore forMutualExclusion.
	self installFinalizer.! !

!WeakRegistry methodsFor: 'enumerating' stamp: 'Igor.Stasenko 5/25/2010 05:11'!
do: aBlock
	^self protected: [
		valueDictionary keysDo: aBlock.
	].
! !

!WeakRegistry methodsFor: 'adding' stamp: 'Igor.Stasenko 3/8/2010 21:03'!
add: anObject
	"Add anObject to the receiver. Store the object as well as the associated executor."
	
	^self add: anObject executor: anObject executor! !

!WeakRegistry methodsFor: 'copying' stamp: 'Igor.Stasenko 5/28/2010 05:16'!
postCopy
	"should we prohibit any attempts to copy receiver?"
	self protected: [ | oldDict |
		sema := Semaphore forMutualExclusion.
		oldDict := valueDictionary.
		list := WeakFinalizationList new.
		valueDictionary := WeakIdentityKeyDictionary new.
		self installFinalizer.
	
		oldDict keysAndValuesDo: [:key :value |
			valueDictionary at: key put: (value copyWithList: list)
		].
	]! !

!WeakRegistry methodsFor: 'finalization' stamp: 'IgorStasenko 5/23/2011 12:42'!
finalizeValues
	"Finalize any values, which happen to stocked in our list, due to some weak references become garbage"
	
	| finalizer |

	" Do the old way, if VM don't supports us"
	WeakFinalizationList hasNewFinalization ifFalse: [ | finalizers |
		finalizers := OrderedCollection new.
		self protected: [ 
			valueDictionary expiredValuesDo: [:finItem |
				finalizers add: finItem.
				].
		 ].
		finalizers do: [:each | [each finalizeValues] on: Exception fork: [:ex | ex pass ] ].
		^ self ].

	self protected: [ finalizer := list swapWithNil ].

	"We don't need to protect a following loop from concurrent access,
	because at the moment we're finalizing values, 
	only we can access this list of finalizers, because valueDictionary already see them
	as an unused slots, because they're associated with key == nil"
	
	[ finalizer notNil ] whileTrue: [
		| next |
		next := finalizer next.
		[ finalizer finalizeValues] on: Exception fork: [:ex | ex pass ].
		finalizer := next
	].! !

!WeakRegistry methodsFor: 'printing' stamp: 'Igor.Stasenko 5/25/2010 05:13'!
printElementsOn: aStream
	sema ifNil: [^super printElementsOn: aStream].
	aStream nextPutAll: '(<this WeakRegistry is locked>)'! !

!WeakRegistry methodsFor: 'initialize-release' stamp: 'Igor.Stasenko 10/1/2010 18:01'!
installFinalizer
	" do nothing, pharo does not supports it right now
	valueDictionary finalizer: #finalizeValues
	"! !

!WeakRegistry methodsFor: 'adding' stamp: 'IgorStasenko 10/31/2010 02:44'!
add: anObject executor: anExecutor
" with new finalization, we can simply override associations with key == nil in valueDictionary "
	self protected: [ | finItem |
		finItem := valueDictionary at: anObject ifAbsent: [
			WeakFinalizationList hasNewFinalization ifTrue: [
				valueDictionary overridingAt: anObject put: (WeakFinalizerItem new list: list object: anObject) ]
			ifFalse: [
				valueDictionary at: anObject put: (WeakFinalizerItem new list: list object: anObject) 
				]
		].
		finItem add: anExecutor ].
	^ anObject
! !

!WeakRegistry class methodsFor: 'instance creation' stamp: 'Igor.Stasenko 5/25/2010 05:31'!
new: n
	^ self new! !

!WeakRegistry class methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/22/2010 21:22'!
default
	^Default ifNil:[Default := self new]! !

!WeakRegistry class methodsFor: 'instance creation' stamp: 'Igor.Stasenko 3/8/2010 21:47'!
new
	| registry |
	registry := super new.
	WeakArray addWeakDependent: registry.
	^registry
! !

!WeakRegistryTest commentStamp: 'TorstenBergmann 2/20/2014 15:36'!
A trait for test purposes!
!WeakRegistryTest methodsFor: 'tests' stamp: 'ul 2/26/2010 14:50'!
testRemovingByAHighPriorityProcessDoesntLeak

	| w finalized block hash object executor semaphore |
	w := WeakRegistry new: 1.
	finalized := false.
	block := [ :v | finalized := v ].
	object := Object new.
	executor := ObjectFinalizer
		receiver: block
		selector: #value:
		argument: true.
	hash := object hash.
	w add: hash.
	w add: object executor: executor.
	semaphore := Semaphore new.
	[ 
		object := nil. "let it go"
		w remove: hash.
		semaphore signal ] 
			forkAt: WeakArray runningFinalizationProcess priority + 1.
	semaphore wait.
	Smalltalk garbageCollect. "finalize it"
	self assert: w isEmpty.
	self assert: finalized! !

!WeakRegistryTest methodsFor: 'tests' stamp: 'CamilloBruni 4/25/2013 16:20'!
testFinalizationWithBadFinalizer

	" Test that if error occurs during finalization, the finalization process continues to run normally.

		This test tests that if we adding a faulty finalizer to WeakArray's finalization dependants,
		its not causing troubles to the finalization process.	
	"
	
	| mock1 mock2 sema timedOut |
	
	mock1 := MockFinalizerAction new finalizationAction: [ self signalMockException ].
	mock2 := MockFinalizerAction new finalizationAction: [ sema signal ].
	sema := Semaphore new.

	WeakArray 
		addWeakDependent: mock1;
		addWeakDependent: mock2.
	
	errorWasHere := false.
	
	Smalltalk garbageCollect.
	
	timedOut := sema waitTimeoutSeconds: 1.
	
	self assert: (errorWasHere == true).
	self assert: (timedOut == false)
	! !

!WeakRegistryTest methodsFor: 'tests' stamp: 'CamilloBruni 4/25/2013 16:20'!
testFinalizationWithOnFork

	" Test that if error occurs during finalization, the finalization process continues to run normally.
	
	We addting two executors into weak registry:
	 the faulty one, which causing an error
	 and good one, which signals semaphore
	
	test shows that both finalizers are evaluated and error doesn't prevents a good finalizer from execution
	"
	
	| reg obj1 obj2 sema timedOut |
	
	reg := WeakRegistry new.
	sema := Semaphore new.
	WeakArray removeWeakDependent: reg.
	obj1 := Array new: 1.
	obj2 := Array new: 2.
	
	reg add: obj1 executor: ( MockFinalizerAction new finalizationAction: [ self signalMockException ] ).
	reg add: obj2 executor: ( MockFinalizerAction new finalizationAction: [ sema signal ] ).

	errorWasHere := false.
	
	obj1 := obj2 := nil.
	Smalltalk garbageCollect.
	
	reg finalizeValues.
	
	timedOut := sema waitTimeoutSeconds: 1.
	
	self assert: (errorWasHere == true).
	self assert: (timedOut == false)
	! !

!WeakRegistryTest methodsFor: 'tests' stamp: 'ul 2/26/2010 14:50'!
testGrowingByAHighPriorityProcessDoesntLeak

	| w finalized block object executor semaphore |
	w := WeakRegistry new: 1.
	finalized := false.
	block := [ :v | finalized := v ].
	object := Object new.
	executor := ObjectFinalizer
		receiver: block
		selector: #value:
		argument: true.
	w add: object executor: executor.
	semaphore := Semaphore new.
	[ 
		object := nil. "let it go"
		w addAll: (1 to: 1000). "force growing"
		semaphore signal ] 
			forkAt: WeakArray runningFinalizationProcess priority + 1.
	semaphore wait.
	Smalltalk garbageCollect. "finalize it"
	self assert: w size = 1000.
	self assert: finalized! !

!WeakRegistryTest methodsFor: 'tests' stamp: 'ul 2/26/2010 13:59'!
testFinalizationWithMultipleFinalizersPerObject

	| object registry counter |
	registry := WeakRegistry new.
	object := Object new.
	counter := 0.
	5 timesRepeat: [
		registry add: object executor: (ObjectFinalizer
			receiver: [ counter := counter + 1 ]
			selector: #value) ].
	self assert: registry size = 1.
	object := nil. 
	Smalltalk garbageCollect.
	registry finalizeValues.
	self assert: registry isEmpty.
	self assert: counter = 5
! !

!WeakRegistryTest methodsFor: 'tests' stamp: 'ar 4/6/2010 22:31'!
testFinalization

	| w finalized block object |
	w := WeakRegistry new: 1.
	finalized := false.
	block := [ :v | finalized := v ].
	object := ObjectFinalizer "an object that responds to #finalize"
		receiver: block
		selector: #value:
		argument: true.
	w add: object.
	object := nil. "let it go"
	Smalltalk garbageCollect. "finalize it"

	"This is an odd issue. It seems that in some situations the finalization
	process doesn't run 'in time' for the isEmpty assertion below to succeed.
	This really *shouldn't* happen since isEmpty is full of real sends and
	there ought to be an interrupt check in there somewhere. However,
	since there are no real-time guarantees about finalization, it's fair to
	just wait a little to ensure that the finalization process has been run."
	(Delay forMilliseconds: 100) wait.

	self assert: w isEmpty.
	self assert: finalized! !

!WeakRegistryTest methodsFor: 'mocketry' stamp: 'IgorStasenko 5/23/2011 13:13'!
signalMockException
	MockExceptionWithPassAction new
		passAction: [ errorWasHere := true];
		signal! !

!WeakRegistryTest methodsFor: 'tests' stamp: 'ul 2/26/2010 14:46'!
testRemovingDoesntLeak

	| w finalized block hash object executor |
	w := WeakRegistry new: 1.
	finalized := false.
	block := [ :v | finalized := v ].
	object := Object new.
	executor := ObjectFinalizer
		receiver: block
		selector: #value:
		argument: true.
	hash := object hash.
	w add: hash.
	w add: object executor: executor.
	object := nil. "let it go"
	w remove: hash.
	Smalltalk garbageCollect. "finalize it"
	self assert: w isEmpty.
	self assert: finalized! !

!WeakRegistryTest methodsFor: 'tests' stamp: 'CamilloBruni 4/25/2013 16:16'!
testVileFinalizer
	" this test checks that manipulation (or accessing) a weak registry 
	does not lead to deadlocks when performed from within a #finalize implementation"
	
	| reg villian proc locked |
	
	reg := WeakRegistry new.
	WeakArray removeWeakDependent: reg.  "to prevent test interference with finalization process"
	
	villian := VileFinalizer new initialize: reg.  "add object with vile finalization to registry"
	
	locked := true.

	proc := [ reg finalizeValues. locked := false ] newProcess.
	villian := nil.	
	Smalltalk garbageCollect.
	
	proc resume.
	100 milliSeconds wait. "give chance for created process to run "
	
	proc isTerminated ifFalse: [ proc terminate ].

	self assert: locked == false.
! !

!WeakRegistryTest methodsFor: 'tests' stamp: 'ul 2/26/2010 14:50'!
testGrowingDoesntLeak

	| w finalized block object executor |
	w := WeakRegistry new: 1.
	finalized := false.
	block := [ :v | finalized := v ].
	object := Object new.
	executor := ObjectFinalizer
		receiver: block
		selector: #value:
		argument: true.
	w add: object executor: executor.
	object := nil. "let it go"
	w addAll: (1 to: 1000). "force growing"
	Smalltalk garbageCollect. "finalize it"
	self assert: w size = 1000.
	self assert: finalized! !

!WeakSet commentStamp: 'IgorStasenko 3/22/2011 16:25'!
I'm a Set with weak elements. 

Implementation.

	flag is a special object that indicates that at a given slot the set has a free entry.!
!WeakSet methodsFor: 'public' stamp: 'ar 2/1/2010 21:32'!
do: aBlock after: anElement

	| startIndex |
	tally = 0 ifTrue: [ ^self ].
	startIndex := anElement
		ifNil: [ 0 ]
		ifNotNil: [ self scanFor: anElement ].
	startIndex + 1 to: array size do: [ :index |
		(array at: index) ifNotNil: [ :object |
			object == flag ifFalse: [
				aBlock value: object enclosedSetElement] ] ]! !

!WeakSet methodsFor: 'accessing' stamp: 'ar 2/1/2010 21:30'!
like: anObject
	"Answer an object in the receiver that is equal to anObject,
	nil if no such object is found. Relies heavily on hash properties"

	| element |
	^(element  := array at: (self scanFor: anObject)) == flag
		ifFalse: [ element enclosedSetElement]! !

!WeakSet methodsFor: 'private' stamp: 'MartinMcClure 3/18/2010 22:53'!
grow
	"Grow the elements array if needed.
	Since WeakSets just nil their slots, alot of the occupied (in the eyes of the set) slots are usually 	empty. Doubling size if unneeded can lead to BAD performance, therefore we see if reassigning 	the <live> elements to a Set of similiar size leads to a sufficiently (50% used here) empty set first.
	and reinsert the old elements"

	| oldTally |
	oldTally := tally.
	self growTo: array size.
	oldTally >> 1 < tally
		ifTrue: [ self growTo: (HashTableSizes atLeast: 2 * array size) ]! !

!WeakSet methodsFor: 'testing' stamp: 'CamilloBruni 7/3/2013 13:25'!
isHealthy
	"Test that object hashes match their positions stored in set's array,
	answer true if everything ok, false otherwise
	
	WeakSet allSubInstances select: [:badSet |
		badSet isHealthy not ]
	"
	array withIndexDo: [ :element :index |
		(element isNotNil and: [ element ~~ flag ]) ifTrue: [
			(self scanFor: element) == index
				ifFalse: [ ^ false ]]].
	^ true! !

!WeakSet methodsFor: 'private' stamp: 'ul 2/5/2010 04:10'!
fixCollisionsFrom: start
	"The element at start has been removed and replaced by flag.
	This method moves forward from there, relocating any entries
	that had been placed below due to collisions with this one."

	| element index |
	index := start.
	[ (element := array at: (index := index \\ array size + 1)) == flag ] whileFalse: [
		element 
			ifNil: [ "This object is gone"
				array at: index put: flag.
				tally := tally - 1 ]
			ifNotNil: [
				| newIndex |
				(newIndex := self scanFor: element enclosedSetElement) = index ifFalse: [
					array 
						at: newIndex put: element;
						at: index put: flag ] ] ]
! !

!WeakSet methodsFor: 'private' stamp: 'SqR 8/23/2000 15:43'!
rehash
	self growTo: array size! !

!WeakSet methodsFor: 'private' stamp: 'yo 11/11/2002 23:10'!
scanForLoadedSymbol: anObject
	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements"

	| element start finish |

	start := (anObject hash \\ array size) + 1.
	finish := array size.

	"Search from (hash mod size) to the end."
	start to: finish do:
		[:index | ((element := array at: index) == flag or: [element asString = anObject asString])
			ifTrue: [^ index ]].

	"Search from 1 to where we started."
	1 to: start-1 do:
		[:index | ((element := array at: index) == flag or: [element asString = anObject asString])
			ifTrue: [^ index ]].

	^ 0  "No match AND no empty slot"! !

!WeakSet methodsFor: 'removing' stamp: 'ul 9/23/2009 21:14'!
remove: oldObject ifAbsent: aBlock

	| index |
	index := self scanFor: oldObject.
	(array at: index) == flag ifTrue: [ ^ aBlock value ].
	array at: index put: flag.
	tally := tally - 1.
	self fixCollisionsFrom: index.
	^oldObject! !

!WeakSet methodsFor: 'initialization' stamp: 'nice 4/4/2006 22:09'!
initialize: n
	"Initialize array to an array size of n"

	flag := Object new.
	array := WeakArray new: n.
	array atAllPut: flag.
	tally := 0! !

!WeakSet methodsFor: 'private' stamp: 'ar 2/1/2010 21:30'!
scanFor: anObject
	"Scan the key array for the first slot containing either flag (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."

	| index start |
	index := start := anObject hash \\ array size + 1.
	[ 
		| element |
		((element := array at: index) == flag or: [ element enclosedSetElement = anObject ])
			ifTrue: [ ^index ].
		(index := index \\ array size + 1) = start ] whileFalse.
	self errorNoFreeSpace! !

!WeakSet methodsFor: 'private' stamp: 'HenrikSperreJohansen 9/1/2010 22:55'!
scanForEmptySlotFor: aKey
	"Scan the key array for the first slot containing an empty slot (indicated by flag or a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements."
	
	| index start |
	index := start := aKey hash \\ array size + 1.
	[ 
		| element |
		((element := array at: index) == flag or: [ element == nil ]) ifTrue: [ ^index ].
		(index := index \\ array size + 1) = start ] whileFalse.
	self errorNoFreeSpace! !

!WeakSet methodsFor: 'testing' stamp: 'ul 1/25/2010 22:24'!
includes: anObject 
	
	^(array at: (self scanFor: anObject))
		ifNil: [ false ]
		ifNotNil: [ :object | object ~~ flag ]! !

!WeakSet methodsFor: 'accessing' stamp: 'ul 2/19/2010 14:56'!
like: anObject ifAbsent: aBlock
	"Answer an object in the receiver that is equal to anObject,
	or evaluate the block if not found. Relies heavily on hash properties"

	| element |
	((element  := array at: (self scanFor: anObject)) == flag or: [ element == nil ])
		ifTrue: [ ^aBlock value ]
		ifFalse: [ ^element enclosedSetElement ]! !

!WeakSet methodsFor: 'enumerating' stamp: 'ar 2/1/2010 21:31'!
do: aBlock

	tally = 0 ifTrue: [ ^self ].
	1 to: array size do: [ :index |
		(array at: index) ifNotNil: [ :object |
			object  == flag ifFalse: [
				aBlock value: object enclosedSetElement] ] ]! !

!WeakSet methodsFor: 'adding' stamp: 'ar 2/1/2010 21:31'!
add: newObject
	"Include newObject as one of the receiver's elements, but only if
	not already present. Answer newObject"

	| index element |
	index := self scanFor: newObject.
	((element := array at: index) == flag or: [ element == nil ])
		ifTrue: [self atNewIndex: index put: newObject asSetElement].
	^newObject! !

!WeakSet methodsFor: 'enumerating' stamp: 'ar 2/1/2010 21:32'!
collect: aBlock

	| newSet |
	newSet := self species new: self size.
	tally = 0 ifTrue: [ ^newSet ].
	1 to: array size do: [ :index |
		(array at: index) ifNotNil: [ :object |
			object == flag ifFalse: [
				newSet add: (aBlock value: object enclosedSetElement) ] ] ].
	^newSet! !

!WeakSet methodsFor: 'copying' stamp: 'nice 10/5/2009 08:59'!
postCopy
	| oldFlag |
	super postCopy.
	oldFlag := flag.
	flag := Object new.
	array replaceAll: oldFlag with: flag.! !

!WeakSet methodsFor: 'public' stamp: 'di 2/3/2001 16:46'!
printElementsOn: aStream
	| oldPos |
	aStream nextPut: $(.
	oldPos := aStream position.
	self do: [:element | aStream print: element; space].
	aStream position > oldPos ifTrue: [aStream skip: -1 "remove the extra space"].
	aStream nextPut: $)! !

!WeakSet methodsFor: 'private' stamp: 'ul 1/25/2010 22:31'!
growTo: anInteger
	"Grow the elements array and reinsert the old elements"

	| oldElements |
	oldElements := array.
	array := WeakArray new: anInteger withAll: flag.
	self noCheckNoGrowFillFrom: oldElements! !

!WeakSet methodsFor: 'private' stamp: 'ar 2/1/2010 21:32'!
noCheckNoGrowFillFrom: anArray
	"Add the elements of anArray except nils and flag to me assuming that I don't contain any of them, they are unique and I have more free space than they require."

	tally := 0.
	1 to: anArray size do: [ :index |
		(anArray at: index) ifNotNil: [ :object |
			object == flag ifFalse: [ 
				array
					at: (self scanForEmptySlotFor: object enclosedSetElement)
					put: object.
				tally := tally + 1 ] ] ]! !

!WeakSet methodsFor: 'public' stamp: 'ul 2/4/2010 01:10'!
slowSize
	"Careful!! Answer the maximum amount
	of elements in the receiver, not the
	exact amount"

	| count |
	count := 0.
	1 to: array size do: [ :index |
		(array at: index) ifNotNil: [ :object |
			object == flag ifFalse: [
				count := count + 1 ] ] ].
	^count! !

!WeakSetTest commentStamp: 'TorstenBergmann 2/20/2014 15:36'!
A trait for test purposes!
!WeakSetTest methodsFor: 'testing' stamp: 'nice 5/7/2009 01:06'!
testAddIncludesSizeReclaim
	| ws o2 o3 |
	o2 := 1/2.
	o3 := '123' copy.
	ws := WeakSet new.
	ws add: o2.
	ws add: o3.
	self assert: ws size = 2.
	self assert: (ws includes: o2).
	self assert: (ws includes: o3).
	
	"inclusion test does use equality, not identity"
	self assert: (ws includes: o3 copy) description: 'WeakSet are not WeakIdentitySet'.
	
	"only one copy is added"
	ws add: o3 copy.
	self assert: ws size = 2.
	
	"reclame objects so that slots of ws are nilled out"
	o2 := o3 := nil.
	Smalltalk garbageCollect.
	self deny: (ws includes: 1/2).
	self deny: (ws includes: '123' copy).
	
	"fast #size is not updated automatically by dead object reclamation
	But there is a slowSize trying to tell the truth"
	self assert: ws slowSize = 0.! !

!WeakSetTest methodsFor: 'testing' stamp: 'StephaneDucasse 5/28/2011 13:43'!
testCollisions

	| ws o1 o2 o5 on remember forget |

	"create a weak set"
	ws := WeakSet new: 15.
	
	"select some fractions wanting same place in ws array"
	o1 := (2 to: 100) select: [:i | (ws scanFor: 1 / i) = 1].
	o2 := (2 to: 100) select: [:i | (ws scanFor: 1 / i) = 2].
	o5 := (2 to: 100) select: [:i | (ws scanFor: 1 / i) = 5].
	on := (2 to: 100) select: [:i | (ws scanFor: 1 / i) = (ws array size - 1)].
	
	"Add some fractions to the weak set, and remember a pointer for a few of them"
	remember := OrderedCollection new.
	forget := OrderedCollection new.
	ws add: (remember add: 1 / o1 first).
	ws add: (forget add: 1 / on second).
	ws add: (forget add: 1 / o1 second).
	ws add: (forget add: 1 / o5 second).
	ws add: (forget add: 1 / o2 second).
	ws add: (forget add: 1 / o1 third).
	ws add: (remember add: 1 / o2 first).
	ws add: (forget add: 1 / o5 third).
	ws add: (forget add: 1 / on third).
	ws add: (remember add: 1 / o2 fourth).
	ws add: (remember add: 1 / on first).
	ws add: (remember add: 1 / o5 first).
	
	"forget and reclaim all entries but those in remember"
	forget := nil.
	Smalltalk garbageCollect.
	
	remember do: [:m | self assert: (ws includes: m)].
	ws add: 1/on second.
	remember do: [:m | self assert: (ws includes: m)].
	
	ws add: (remember add: 1 / o1 fourth).
	ws add: (remember add: 1 / on fourth).
	remember remove: (ws remove: (1 / o5 first)).
	remember remove: (ws remove: (1 / on first)).
	remember remove: (ws remove: (1 / o2 first)).
	remember remove: (ws remove: (1 / o1 first)).
	remember do: [:m | self assert: (ws includes: m)].
	ws add: 1/on second.
	ws add: 1/o5 second.
	remember do: [:m | self assert: (ws includes: m)].
	! !

!WeakSetTest methodsFor: 'testing' stamp: 'nice 5/7/2009 00:40'!
testDontGrowWhenUnecessary
	| ws objs initialSize |
	objs := (2 to: 20) collect: [:i | 1 / i].
	
	ws := WeakSet new: 20.
	initialSize := ws array size.
	objs do: [:k | ws add: k].
	objs do: [:k | ws remove: k].
	self assert: ws array size = initialSize
		description: 'The WeakSet did not have to grow because enough room were preallocated'.
	
	objs do: [:k | ws add: k + 1].
	Smalltalk garbageCollect.
	objs do: [:k | ws add: k].
	self assert: ws array size = initialSize
		description: 'The WeakSet did not have to grow because slots of reclaimed objects were recycled'.! !

!WeakSetTest methodsFor: 'testing' stamp: 'nice 5/7/2009 01:15'!
testGrowWhenNecessary
	| ws objs initialSize |
	objs := (2 to: 20) collect: [:i | 1 / i].
	ws := WeakSet new: 5.
	initialSize := ws array size.
	1 to: objs size do: [:k | ws add: (objs at: k)].
	self assert: ws array size > initialSize
		description: 'The WeakSet grown because not enough room were preallocated'.! !

!WeakSetTest methodsFor: 'requirements' stamp: 'StephaneDucasse 5/9/2010 20:47'!
classToBeTested
	^ WeakSet! !

!WeakSetTest methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2013 20:23'!
testAddNil
	| ws |
	ws := WeakSet new.
	ws add: nil.
	self assert: (ws includes: nil)! !

!WeakSetTest methodsFor: 'testing' stamp: 'nice 5/7/2009 01:11'!
testIncludesNil

	| ws |
	ws := WeakSet new.
	self deny: (ws includes: nil).
	
	"After reclamation, should not includes nil: nil counts for nothing"
	ws add: 1/2.
	ws add: 1/3.
	Smalltalk garbageCollect.
	self deny: (ws includes: nil).! !

!WeakSetTest methodsFor: 'tests' stamp: 'StephaneDucasse 5/9/2010 20:54'!
testIncludes
	"self debug: #testIncludes"
	
	| weakSet transientFakeNilObject |
	weakSet := WeakSet new.
	#(true nil 1) do: [ :each | self deny: (weakSet includes: each) ].
	weakSet add: true.
	self assert: (weakSet includes: true).
 	weakSet remove: true.
	self deny: (weakSet includes: true).
	transientFakeNilObject := ((1 to: 1000) detect: [ :each | each asString hash - nil hash \\ weakSet capacity = 0 ]) asString. "this string will occupy the same slot as nil would"

	weakSet add: transientFakeNilObject.
	transientFakeNilObject := transientFakeNilObject copy.
	Smalltalk garbageCollect. "get rid of transientFakeNilObject"
	self deny: (weakSet includes: transientFakeNilObject).
	self deny: (weakSet includes: nil)! !

!WeakSetTest methodsFor: 'tests' stamp: 'StephaneDucasse 5/9/2010 20:55'!
testDoAfter
	"self debug: #testDoAfter"
	| input weakSet array |
	input := (1 to: 11) collect: [ :each | each asString asSymbol ]. "Some symbols might be garbage collected without this variable"
	weakSet := WeakSet withAll: input.
	array := weakSet asArray. "Assume that the elements will have the same order as the internal array of the weakset"
	0 to: array size do: [ :index |
		| element result |
		element := array at: index ifAbsent: nil.
		result := Array new: weakSet size - index streamContents: [ :stream |
			weakSet
				do: [ :each | stream nextPut: each ]
				after: element ].
		self assert: result sort = (array allButFirst: index) sort ]! !

!WeakSetTest methodsFor: 'testing' stamp: 'nice 5/7/2009 01:20'!
testDoDontIterateOnReclaimedObjects

	| ws o1 o2 size |
	ws := WeakSet new.
	2 to: 20 do: [:i | ws add: 1 / i].
	
	o1 := 3.0.
	o2 := 4.0.
	ws add: o1; add: o2.
	
	"Reclaim memory"
	Smalltalk garbageCollect.
	
	size := 0.
	ws do: [:each |
		size := size + 1.
		self deny: each isNil].
	
	self assert: size = 2! !

!WeakSetTest class methodsFor: 'building suites' stamp: 'cyrille.delaunay 6/29/2009 11:28'!
shouldInheritSelectors

^true! !

!WeakSlot commentStamp: 'GuillermoPolito 2/26/2015 12:08'!
A WeakSlot is a slot that references weakly an object.

Internally it is implemented with a weak array of size one. Writing into the slot writes the only field in the array. 

weakArray at: 1 put: aValue.

Reading into the Slot reads the only field in the array.

weakArray at: 1 .

This slot inherits from IndexedSlot to guarantee that this slot has a real field inside an object.!
!WeakSlot methodsFor: 'meta-object-protocol' stamp: 'GuillermoPolito 2/26/2015 11:42'!
wantsInitalization

	^ true! !

!WeakSlot methodsFor: 'code generation' stamp: 'GuillermoPolito 2/26/2015 18:40'!
emitStore: aMethodBuilder
	| temp |
	temp := Object new.
	"Pop the value to store into a temp to push it back in the right order"
	aMethodBuilder addTemp: temp.
	aMethodBuilder storeTemp: temp.
	
	"Push the weak array into the stack, then the arguments, then send"
	aMethodBuilder pushInstVar: index.
	aMethodBuilder pushLiteral: 1.
	aMethodBuilder pushTemp: temp.
	aMethodBuilder send: #at:put:! !

!WeakSlot methodsFor: 'code generation' stamp: 'GuillermoPolito 2/26/2015 12:23'!
emitValue: aMethodBuilder
	"Push the weak array into the stack"
	aMethodBuilder pushInstVar: index.
	aMethodBuilder pushLiteral: 1.
	aMethodBuilder send: #at:! !

!WeakSlot methodsFor: 'meta-object-protocol' stamp: 'GuillermoPolito 2/26/2015 11:47'!
write: aValue to: anObject

	(super read: anObject) at: 1 put: aValue.
	^ aValue! !

!WeakSlot methodsFor: 'initialization' stamp: 'GuillermoPolito 2/26/2015 11:51'!
initialize: anObject
	super write: (WeakArray new: 1) to: anObject! !

!WeakSlot methodsFor: 'meta-object-protocol' stamp: 'GuillermoPolito 2/26/2015 11:47'!
read: anObject

	^ (super read: anObject) at: 1.! !

!WeakSubscriptionBuilder commentStamp: 'IgorStasenko 3/12/2011 20:37'!
I am a wrapper around an Announcer, used to create weak subscriptions at subscription time.

Use me like this:

anAnnouncer weak subscribe: Announcement send: #foo to: barObject.

I raise an error for block subscriptions, as they require non-existing Ephemeron support to function correctly.!
!WeakSubscriptionBuilder methodsFor: 'wrapped protocol' stamp: 'IgorStasenko 3/12/2011 20:33'!
subscribe: anAnnouncementClass send: aSelector to: anObject
	^ self subscribe: anAnnouncementClass do: (WeakMessageSend receiver: anObject selector: aSelector)! !

!WeakSubscriptionBuilder methodsFor: 'wrapped protocol' stamp: 'EstebanLorenzano 9/8/2013 16:52'!
when: anAnnouncementClass do: aValuable
	"Do not use this message on announcer weak. We did not deprecated this method because it may break some behavior."
	self error: 'Not supported'! !

!WeakSubscriptionBuilder methodsFor: 'wrapped protocol' stamp: 'EstebanLorenzano 9/8/2013 16:52'!
on: anAnnouncementClass do: aValuable
	"Do not use this message on announcer weak. We did not deprecated this method because it may break some behavior."
	self error: 'Not supported'! !

!WeakSubscriptionBuilder methodsFor: 'wrapped protocol' stamp: 'IgorStasenko 3/12/2011 20:25'!
weak
	"already weak"
	^ self! !

!WeakSubscriptionBuilder methodsFor: 'initialize-release' stamp: 'IgorStasenko 3/12/2011 20:24'!
announcer: anAnnouncer
	announcer := anAnnouncer ! !

!WeakSubscriptionBuilder methodsFor: 'wrapped protocol' stamp: 'IgorStasenko 3/12/2011 20:25'!
on: anAnnouncementClass send: aSelector to: anObject
	^ self subscribe: anAnnouncementClass send: aSelector to: anObject! !

!WeakSubscriptionBuilder methodsFor: 'private' stamp: 'StephaneDucasse 8/27/2013 21:50'!
subscribe: anAnnouncementClass do: aValuable 
	"Do not use this message on weak announcer because it does not work. The block will hold strongly the receiver and more.
	 We need ephemerons for that'"
	"aValuable isBlock ifTrue: [  
		self error: 'Do not use this message on weak and block because it does not work. We need ephemerons for that']."
	^	announcer basicSubscribe: (
			WeakAnnouncementSubscription new 
				announcer: announcer;
				announcementClass: anAnnouncementClass;
				valuable: aValuable)! !

!WeakSubscriptionBuilder methodsFor: 'wrapped protocol' stamp: 'StephaneDucasse 8/27/2013 21:51'!
when: anAnnouncementClass send: aSelector to: anObject
	^ self subscribe: anAnnouncementClass send: aSelector to: anObject! !

!WeakSubscriptionBuilder class methodsFor: 'instance creation' stamp: 'IgorStasenko 3/12/2011 20:26'!
on: announcer
	^ self new announcer: announcer! !

!WeakValueAssociation commentStamp: '<historical>'!
I am a lookup key (acting like an association but) holding only weakly on my value.!
!WeakValueAssociation methodsFor: 'accessing' stamp: 'r++ 5/27/2000 18:11'!
key: aKey value: anObject 
	"Store the arguments as the variables of the receiver."

	key := aKey.
	self value: anObject! !

!WeakValueAssociation methodsFor: 'accessing' stamp: 'r++ 5/27/2000 18:08'!
value
	^self at: 1! !

!WeakValueAssociation methodsFor: 'accessing' stamp: 'r++ 5/27/2000 18:08'!
value: anObject 
	"Store the argument, anObject, as the value of the receiver."

	self at: 1 put: anObject! !

!WeakValueAssociation class methodsFor: 'as yet unclassified' stamp: 'r++ 5/27/2000 18:12'!
new
	^ self new: 1! !

!WeakValueAssociation class methodsFor: 'instance creation' stamp: 'r++ 5/27/2000 18:07'!
key: anObject value: bObject
	^ self new key: anObject value: bObject! !

!WeakValueDictionary commentStamp: '<historical>'!
I am a dictionary holding only weakly on my values. Clients may expect to get a nil value for any object they request.!
!WeakValueDictionary methodsFor: 'enumerating' stamp: 'SqR 11/7/2013 12:11'!
valuesDo: aBlock 
	"See comments in Dictionary>>valuesDo:.  The code keeps
	a reference to the value to facilitate debugging"

	tally = 0 ifTrue: [ ^self ].
	1 to: array size do:
		[ :eachIndex | 
			| eachAssociation eachValue |
			eachAssociation := array at: eachIndex.
			nil == eachAssociation ifFalse:
				[
					eachValue := eachAssociation value.
					aBlock value: eachValue
				]
		]! !

!WeakValueDictionary methodsFor: 'adding' stamp: 'ar 3/21/98 16:02'!
add: anAssociation
	self at: anAssociation key put: anAssociation value.
	^ anAssociation! !

!WeakValueDictionary methodsFor: 'accessing' stamp: 'ar 3/21/98 16:01'!
at: key put: anObject 
	"Set the value at key to be anObject.  If key is not found, create a new
	entry for key and set is value to anObject. Answer anObject."
	| index element |
	index := self findElementOrNil: key.
	element := array at: index.
	element == nil
		ifTrue: [self atNewIndex: index put: (WeakValueAssociation key: key value: anObject)]
		ifFalse: [element value: anObject].
	^ anObject! !

!WeakValueDictionaryTest commentStamp: 'TorstenBergmann 2/20/2014 15:27'!
SUnit tests for weak value dictionaries!
!WeakValueDictionaryTest methodsFor: 'requirements' stamp: 'cyrille.delaunay 7/1/2009 16:25'!
classToBeTested

^ WeakValueDictionary! !

!WeakValueDictionaryTest class methodsFor: 'building suites' stamp: 'cyrille.delaunay 7/1/2009 16:25'!
shouldInheritSelectors

^true! !

!Week commentStamp: 'brp 5/13/2003 09:48'!
I represent a week.!
!Week methodsFor: 'conversion' stamp: 'brp 5/13/2003 09:36'!
asWeek

	^ self ! !

!Week methodsFor: 'printing' stamp: 'brp 5/13/2003 09:37'!
printOn: aStream

	aStream nextPutAll: 'a Week starting: '.
	self start printOn: aStream. ! !

!Week methodsFor: 'accessing' stamp: 'brp 1/30/2005 09:31'!
index

	^ self asMonth dayOfWeek + self dayOfMonth - 2  // 7 + 1
! !

!Week class methodsFor: 'accessing' stamp: 'CamilloBruni 8/22/2013 18:47'!
startDay

	^ StartDay ifNil: [ StartDay := DayNames first ]! !

!Week class methodsFor: 'accessing' stamp: 'brp 8/23/2003 09:30'!
startDay: aSymbol

	(DayNames includes: aSymbol)
		ifTrue: [ StartDay := aSymbol ]
		ifFalse: [ self error: aSymbol, ' is not a recognised day name' ]
! !

!Week class methodsFor: 'accessing' stamp: 'brp 5/13/2003 09:34'!
dayNames

	^ DayNames ! !

!Week class methodsFor: 'accessing' stamp: 'brp 5/13/2003 09:34'!
nameOfDay: anIndex

	^ DayNames at: anIndex ! !

!Week class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/22/2013 18:53'!
starting: aDateAndTime duration: aDuration
	"Override - the duration is always one week.
	 Week will start from the Week class>>startDay"

	| midnight delta adjusted |
	midnight := aDateAndTime asDateAndTime midnight.
	delta := ((midnight dayOfWeek + 7 - (DayNames indexOf: self startDay)) rem: 7) abs.
	adjusted := midnight - (Duration days: delta seconds: 0).

	^ super
		starting: adjusted
		duration: (Duration weeks: 1).! !

!Week class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/22/2013 19:36'!
week: weekNumber
	"Return a week in this year"
	^ self year: Year current week: weekNumber! !

!Week class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/22/2013 19:36'!
year: aYear week: weekNumber
	"Return the ISO week for the given week number and the given year.
	Week 1 contains the year's first Thursday (weekday = 5)"
	^ self starting: aYear asYear firstThursday + (weekNumber * 7 - 5"adjust for firstThursday") days! !

!Week class methodsFor: 'accessing' stamp: 'brp 5/13/2003 09:34'!
indexOfDay: aSymbol

	^ DayNames indexOf: aSymbol ! !

!WeekTest commentStamp: 'TorstenBergmann 2/5/2014 08:48'!
SUnit tests for weeks!
!WeekTest methodsFor: 'tests' stamp: 'it 7/14/2009 19:47'!
testDayNames
	self assert: (Week dayNames) = #(#Sunday #Monday #Tuesday #Wednesday #Thursday #Friday #Saturday).! !

!WeekTest methodsFor: 'tests' stamp: 'brp 1/30/2005 09:30'!
testInquiries

	self
		assert: week start asDate = '28 June 1998' asDate;
		assert: week end asDate = '4 July 1998' asDate;
		assert: week index = 5;
		assert: week duration = (7 days).
! !

!WeekTest methodsFor: 'tests' stamp: 'it 7/14/2009 19:52'!
testIndexOfDay
	| days |
	days := #(#Sunday #Monday #Tuesday #Wednesday #Thursday #Friday #Saturday).
	
	days withIndexDo: [:item :index | self assert: (Week indexOfDay: item) = index].
	
	"This should probably raise an error rather than returning 0."
	self assert: (Week indexOfDay: 0) = 0.
	self assert: (Week indexOfDay: 1) = 0.
	self assert: (Week indexOfDay: 7) = 0.
	self assert: (Week indexOfDay: 8) = 0.
	self assert: (Week indexOfDay: #Sunnyday) = 0.! !

!WeekTest methodsFor: 'tests' stamp: 'nk 7/30/2004 17:52'!
testPreviousNext
	self
		assert: week next = (Week starting: '6 July 1998' asDate);
		assert: week previous = (Week starting:  '22 June 1998' asDate)! !

!WeekTest methodsFor: 'coverage' stamp: 'brp 1/30/2005 09:21'!
selectorsToBeIgnored

	| deprecated private special |

	deprecated := #().
	private := #( #printOn: ).
	special := #( #next #do: ).

	^ super selectorsToBeIgnored, deprecated, private, special.! !

!WeekTest methodsFor: 'tests' stamp: 'CamilloBruni 8/22/2013 22:43'!
testByWeekNumberInCurrentYear
	week := Week week: 2.
	self assert: week year asYear equals: Year current.! !

!WeekTest methodsFor: 'running' stamp: 'brp 9/26/2004 18:53'!
tearDown

	super tearDown.
	Week startDay: restoredStartDay.
	week := nil.

! !

!WeekTest methodsFor: 'tests' stamp: 'StephaneDucasse 6/9/2012 22:53'!
testNameOfDay
	| days |
	days := #(#Sunday #Monday #Tuesday #Wednesday #Thursday #Friday #Saturday).
	
	days withIndexDo: [:item :index | self assert: (Week nameOfDay: index) = item].
	
	self should: [Week nameOfDay: 0] raise: self defaultTestError.
	self should: [Week nameOfDay: 8] raise: self defaultTestError.
	self should: [Week nameOfDay: #Sunday] raise: self defaultTestError.! !

!WeekTest methodsFor: 'coverage' stamp: 'brp 7/27/2003 12:42'!
classToBeTested

	^ Week! !

!WeekTest methodsFor: 'tests' stamp: 'CamilloBruni 8/22/2013 22:42'!
testByWeekNumber
	"Check some week dates, assuming that the week starts on Sunday"
	week := Week year: 2013 week: 1.
	self assert: week start equals: (DateAndTime year: 2012 month: 12 day: 30).
	
	week := Week year: 2013 week: 32.
	self assert: week start equals: (DateAndTime year: 2013 month: 8 day: 4).
	
	week := Week year: 2013 week: 52.
	self assert: week start equals: (DateAndTime year: 2013 month: 12 day: 22).
	
	week := Week year: 2014 week: 1.
	self assert: week start equals: (DateAndTime year: 2013 month: 12 day: 29).! !

!WeekTest methodsFor: 'running' stamp: 'brp 9/26/2004 18:52'!
setUp
	"June 1998, 5th week"

	super setUp.
	restoredStartDay := Week startDay.
	Week startDay: #Sunday.
	week := Week starting: '4 July 1998' asDate! !

!WeekTest methodsFor: 'tests' stamp: 'brp 1/30/2005 09:32'!
testEnumerating

	| days |
	days := OrderedCollection new.
	0 to: 6 do: [ :i | days add: ('28 June 1998' asDate addDays: i) ].

	week datesDo: [ :d | days remove: d ].
	
	self assert: days isEmpty.
! !

!WeightedAverageCost commentStamp: 'StephaneDucasse 6/9/2010 20:53'!
Part of an test resource to verify that super is well bound.
See CompilerEvaluationTest!
!WhereIsDebugAction commentStamp: '<historical>'!
A WhereIsDebugAction highlights in the code editor the current instruction.
!
!WhereIsDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/18/2013 18:50'!
id

	^ #whereIs! !

!WhereIsDebugAction methodsFor: 'actions' stamp: 'AndreiChis 9/18/2013 18:49'!
executeAction

	self debugger code setSelection: (self session 
		pcRangeForContext:  self currentContext)	! !

!WhereIsDebugAction methodsFor: 'initialization' stamp: 'AndreiChis 9/25/2013 17:34'!
initialize

	super initialize.
	"This action just updates the selection in the code editor. 
	No need to do any update or validation."
	self needsUpdate: false.
	self needsValidation: false.
	self withSeparatorAfter! !

!WhereIsDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/17/2013 19:13'!
defaultLabel

	^ 'Where is?'! !

!WhereIsDebugAction methodsFor: 'accessing' stamp: 'AndreiChis 9/18/2013 18:57'!
defaultOrder

	^ 40! !

!WhereIsDebugAction class methodsFor: 'registration' stamp: 'AndreiChis 9/21/2013 22:15'!
actionType
	<debuggingAction>
	<contextMenuDebuggingAction>! !

!WideCharacterSet commentStamp: 'nice 12/10/2009 19:17'!
WideCharacterSet is used to store a Set of WideCharacter with fast access and inclusion test.

Implementation should be efficient in memory if sets are sufficently sparse.

Wide Characters are at most 32bits.
We split them into 16 highBits and 16 lowBits.

map is a dictionary key: 16 highBits value: map of 16 lowBits.

Maps of lowBits  are stored as arrays of bits in a ByteArray.
If a bit is set to 1, this indicate that corresponding character is present.
8192 bytes are necessary in each lowmap.
Empty lowmap are removed from the map Dictionary.

A byteArrayMap is maintained in parallel with map for fast handling of ByteString.
(byteArrayMap at: i+1) = 0 means that character of asciiValue i is absent, = 1 means present.!
!WideCharacterSet methodsFor: 'comparing' stamp: 'nice 11/15/2007 21:26'!
hash
	"Answer a hash code aimed at storing and retrieving the receiver in a Set or Dictionary.
	Two equal objects should have equal hash.
	Note: as the receiver can be equal to an ordinary CharacterSet,
	the hash code must reflect this"
	
	^self hasWideCharacters
		ifTrue: [map hash]
		ifFalse: [self asCharacterSet hash]! !

!WideCharacterSet methodsFor: 'collection ops' stamp: 'nice 5/9/2006 23:00'!
size
	| size |
	size := 0.
	map
		keysAndValuesDo: [:high :lowmap | self
				bitmap: lowmap
				do: [:low | size := size + 1]].
	^ size! !

!WideCharacterSet methodsFor: 'comparing' stamp: 'nice 5/9/2006 23:29'!
species
	^self hasWideCharacters
		ifTrue: [WideCharacterSet]
		ifFalse: [CharacterSet]! !

!WideCharacterSet methodsFor: 'private' stamp: 'nice 12/10/2009 18:34'!
bitmap: aMap do: aBlock
	"Execute a block with each value (0 based) corresponding to set bits.
	Implementation notes: this version works best for sparse maps.
	It has (byte lowBit) inlined for speed."
	
	| byte byteOffset lowBits |
	lowBits := #[1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 6 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 7 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 6 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 8 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 6 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 7 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 6 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1]. "The lowBits table gives a 1-based bitOffset"
	1 to: aMap size do: [:i | 
		(byte := aMap at: i) = 0 ifFalse: [
			byteOffset := (i bitShift: 3) - 9. "This byteOffset is -1 based"
			["Evaluate the block with 0-based (byteOffset + bitOffset)"
			aBlock value: (byteOffset + (lowBits at: byte)).
			"Eliminate the low bit and loop if some bit remain"
			(byte := byte bitAnd: byte - 1) = 0] whileFalse]]! !

!WideCharacterSet methodsFor: 'converting' stamp: 'nice 11/20/2007 00:19'!
complement
	"return a character set containing precisely the characters the receiver does not"
	
	^CharacterSetComplement of: self copy! !

!WideCharacterSet methodsFor: 'collection ops' stamp: 'nice 12/10/2009 19:20'!
remove: aCharacter ifAbsent: aBlock
	(self includes: aCharacter) ifFalse: [^aBlock value].
	^self remove: aCharacter! !

!WideCharacterSet methodsFor: 'private' stamp: 'nice 12/9/2009 20:28'!
setBitmap: aMap at: shortInteger
	"set a single bit in aMap.
	shortInteger should be between: 0 and: 16rFFFF"
	
	| collecIndex bitIndex |
	collecIndex := shortInteger bitShift: -3.
	bitIndex := shortInteger bitAnd: 7.
	^aMap at: collecIndex + 1 put: ((aMap at: collecIndex + 1) bitOr: (1 bitShift: bitIndex))! !

!WideCharacterSet methodsFor: 'collection ops' stamp: 'nice 12/9/2009 15:30'!
findFirstInByteString: aByteString startingAt: startIndex
	"Double dispatching: since we know this is a ByteString, we can use a superfast primitive using a ByteArray map with 0 slots for byte characters not included and 1 for byte characters included in the receiver."
	^ByteString
		findFirstInString: aByteString
		inSet: self byteArrayMap
		startingAt: startIndex! !

!WideCharacterSet methodsFor: 'comparing' stamp: 'nice 12/10/2009 19:01'!
byteArrayMap
	"return a ByteArray mapping each ascii value to a 1 if that ascii value is in the set, and a 0 if it isn't.
	Intended for use by primitives only. (and comparison)
	This version will answer a subset with only byte characters"
	
	| lowmap |
	byteArrayMap ifNil: [
		byteArrayMap := ByteArray new: 256.
		lowmap := map at: 0 ifAbsent: [^byteArrayMap].
		lowmap := lowmap copyFrom: 1 to: 32. "Keep first 8*32=256 bits..."
		self bitmap: lowmap do: [:code | byteArrayMap at: code + 1 put: 1]].
	^byteArrayMap! !

!WideCharacterSet methodsFor: 'collection ops' stamp: 'nice 5/9/2006 23:49'!
includes: aCharacter 
	| val high low |
	val := aCharacter asciiValue.
	high := val bitShift: -16.
	low := val bitAnd: 16rFFFF.
	^(self
		bitmap: (map
				at: high
				ifAbsent: [^ false])
		at: low) isZero not! !

!WideCharacterSet methodsFor: 'comparing' stamp: 'nice 5/9/2006 23:14'!
wideCharacterMap
	^map! !

!WideCharacterSet methodsFor: 'initialization' stamp: 'nice 12/10/2009 19:34'!
initialize
	super initialize.
	map := Dictionary new.
	byteArrayMap := ByteArray new: 256! !

!WideCharacterSet methodsFor: 'comparing' stamp: 'nice 5/9/2006 23:29'!
= anObject
	^self species == anObject species and: [
		self wideCharacterMap = anObject wideCharacterMap ]! !

!WideCharacterSet methodsFor: 'collection ops' stamp: 'nice 12/10/2009 19:11'!
do: aBlock 
	map
		keysAndValuesDo: [:index :lowmap |
			| high16Bits |
			high16Bits := index bitShift: 16.
			self
				bitmap: lowmap
				do: [:low16Bits | aBlock value: (Character value: high16Bits + low16Bits)]]! !

!WideCharacterSet methodsFor: 'collection ops' stamp: 'nice 12/10/2009 18:57'!
add: aCharacter 
	| val high low lowmap |
	val := aCharacter asciiValue.
	val < 256 ifTrue: [self byteArrayMap at: val + 1 put: 1].
	high := val bitShift: -16.
	low := val bitAnd: 16rFFFF.
	lowmap := map at: high ifAbsentPut: ["create a chunk of 65536=8192*8 bits"
		ByteArray new: 8192].
	self setBitmap: lowmap at: low.
	^ aCharacter! !

!WideCharacterSet methodsFor: 'testing' stamp: 'nice 5/9/2006 23:25'!
hasWideCharacters
	"Answer true if i contain any wide character"
	
	self do: [:e | e asciiValue >= 256 ifTrue: [^true]].
	^false! !

!WideCharacterSet methodsFor: 'private' stamp: 'nice 12/9/2009 20:27'!
clearBitmap: aMap at: shortInteger
	"clear a single bit in aMap.
	shortInteger should be between: 0 and: 16rFFFF"
	
	| collecIndex bitIndex |
	collecIndex := shortInteger bitShift: -3.
	bitIndex := shortInteger bitAnd: 7.
	^aMap at: collecIndex + 1 put: ((aMap at: collecIndex + 1) bitClear: (1 bitShift: bitIndex))! !

!WideCharacterSet methodsFor: 'copying' stamp: 'nice 10/5/2009 08:53'!
postCopy
	super postCopy.
	map := map collect: [:each | each copy]! !

!WideCharacterSet methodsFor: 'collection ops' stamp: 'nice 12/10/2009 19:18'!
remove: aCharacter 
	| val high low lowmap |
	val := aCharacter asciiValue.
	val < 256 ifTrue: [self byteArrayMap at: val + 1 put: 0].
	high := val bitShift: -16.
	low := val bitAnd: 16rFFFF.
	lowmap := map
				at: high
				ifAbsent: [^ aCharacter].
	self clearBitmap: lowmap at: low.
	(lowmap allSatisfy: [:e | e = 0])
		ifTrue: [map removeKey: high].
	^ aCharacter! !

!WideCharacterSet methodsFor: 'private' stamp: 'nice 12/9/2009 20:12'!
bitmap: aMap at: shortInteger
	"access a single bit in aMap.
	shortInteger should be between: 0 and: 16rFFFF"
	
	| collecIndex bitIndex |
	collecIndex := shortInteger bitShift: -3.
	bitIndex := shortInteger bitAnd: 7.
	^(aMap at: collecIndex + 1) bitAnd: (1 bitShift: bitIndex)! !

!WideCharacterSet methodsFor: 'collection ops' stamp: 'nice 12/10/2009 18:58'!
removeAll
	map removeAll.
	byteArrayMap := ByteArray new: 256! !

!WideCharacterSet class methodsFor: 'instance creation' stamp: 'nice 11/15/2007 22:38'!
newFrom: aCollection
	| newCollection |
	newCollection := self new.
	newCollection addAll: aCollection.
	^newCollection! !

!WideCharacterSetTest commentStamp: 'nice 11/19/2007 22:45'!
WideCharacterSetTest holds tests for WideCharacterSet!
!WideCharacterSetTest methodsFor: 'testing' stamp: 'nice 11/20/2007 00:52'!
testCopy
    | theOriginal theCopy |
    theOriginal := WideCharacterSet newFrom: ('abc' copyWith: 300 asCharacter).
    theCopy := theOriginal copy.
    theCopy remove: $a.
    ^self should: [theOriginal includes: $a] description: 'Changing the copy should not change the original'.! !

!WideCharacterSetTest methodsFor: 'testing' stamp: 'nice 11/19/2007 23:34'!
testCreation
	"By now, only creation method is newFrom:"

	| cs1 wcs1 cs2 wcs2 byteString wideString |
	byteString := 'aeiouy'.
	wideString := 'aeiouy' copyWith: 340 asCharacter.

	cs1 := CharacterSet newFrom: byteString.
	wcs1 := WideCharacterSet newFrom: byteString.
	self should: [wcs1 = cs1].
	self should: [wcs1 size = byteString "asSet" size].
	
	cs2 := CharacterSet newFrom: wideString.
	wcs2 := WideCharacterSet newFrom: wideString.
	self should: [wcs2 = cs2].
	self should: [wcs2 size = wideString "asSet" size].
	
	self should: [(byteString indexOfAnyOf: wcs1) = 1] description: 'This should used optimized byteArrayMap method'.
	self should: [(byteString indexOfAnyOf: wcs2) = 1] description: 'This should used optimized byteArrayMap method'.
	
	self should: [('bcd' indexOfAnyOf: wcs1) = 0] description: 'This should used optimized byteArrayMap method'.
	self should: [('bcd' indexOfAnyOf: wcs2) = 0] description: 'This should used optimized byteArrayMap method'.! !

!WideCharacterSetTest methodsFor: 'testing' stamp: 'CamilloBruni 10/16/2013 18:14'!
testAddingToCharacterSet

	| cs wcs wc |
	cs := CharacterSet newFrom: 'aeiouy'.
	wcs := cs copy.
	wc := 4452 asCharacter.
	
	"adding a WideCharacter to an ordinary CharacterSet should turn it into a WideCharacterSet"
	wcs add: wc.

	self should: [wcs size = (cs size + 1)] description: 'We just added a Character, size should be increased by one'.
	self shouldnt: [wcs = cs] description: 'We just added a Character, sets should not be equal'.
	self shouldnt: [cs = wcs] description: 'We just added a Character, sets should not be equal'.
	self should: [cs allSatisfy: [:char | wcs includes: char]] description: 'Each character of the original CharacterSet should be included in the WideCharacterSet'.
	self should: [wcs hasWideCharacters] description: 'We just added a WideCharacter, so this WideCharacterSet definitely has one'.
	self should: [wcs includes: wc] description: 'We just added this WideCharacter, so this WideCharacterSet should include it'.
	
	wcs add: wc.
	self should: [wcs size = (cs size + 1)] description: 'We just added a Character already included in the set, size should be unchanged'.
	
	wcs remove: wc.
	self should: [wcs size = cs size] description: 'We added then removed a Character, now size should be equal to original'.
	self shouldnt: [wcs hasWideCharacters] description: 'We just removed the only WideCharacter, so this WideCharacterSet definitely has no WideCharacter'.
	
	self should: [wcs = cs] description: 'A WideCharacterSet can be equal to an Ordinary CharacterSet'.
	self should: [cs = wcs] description: 'An ordinary CharacterSet can be equal to a WideCharacterSet'.
	self should: [cs hash = wcs hash] description: 'If some objects are equal, then they should have same hash code'.
	
	! !

!WideString commentStamp: 'yo 10/19/2004 22:34'!
This class represents the array of 32 bit wide characters.
!
!WideString methodsFor: 'converting' stamp: 'yo 3/14/2005 11:41'!
copyFrom: start to: stop

	| n |
	n := super copyFrom: start to: stop.
	n isOctetString ifTrue: [^ n asOctetString].
	^ n.
! !

!WideString methodsFor: 'testing' stamp: 'ar 4/12/2005 19:52'!
isWideString
	"Answer whether the receiver is a WideString"
	^true! !

!WideString methodsFor: 'accessing' stamp: 'yo 10/31/2002 22:29'!
byteAt: index

	| d r |
	d := (index + 3) // 4.
	r := (index - 1) \\ 4 + 1.
	^ (self wordAt: d) digitAt: ((4 - r) + 1).
! !

!WideString methodsFor: 'converting' stamp: 'CamilloBruni 9/5/2011 18:06'!
asLowercase
	"Answer a copy of self with all characters in a lower case.
	This might be a difficult task, ask Unicode."
	
	^ Unicode toLowercaseString: self! !

!WideString methodsFor: 'converting' stamp: 'CamilloBruni 9/5/2011 18:06'!
asUppercase
	"Answer a copy of self with all characters in an upper case.
	This might be a difficult task, ask Unicode."
	
	^ Unicode toUppercaseString: self! !

!WideString methodsFor: 'comparing' stamp: 'SeanDeNigris 1/24/2011 23:30'!
findIn: body startingAt: start matchTable: matchTable
	
	^ self findSubstring: self in: body startingAt: start matchTable: matchTable! !

!WideString methodsFor: 'accessing' stamp: 'yo 8/27/2002 14:22'!
byteSize

	^ self size * 4.
! !

!WideString methodsFor: 'converting' stamp: 'CamilloBruni 9/5/2011 18:05'!
asFourCode

	| result |
	self size = 1 ifFalse: [^ Error signal: 'must be exactly four octets' ].
	result := self basicAt: 1.
	(result bitAnd: 16r80000000) = 0 
		ifFalse: [ Error signal: 'cannot resolve fourcode' ].
	(result bitAnd: 16r40000000) = 0 
		ifFalse: [ ^ result - 16r80000000 ].
	^ result
! !

!WideString methodsFor: 'accessing' stamp: 'yo 11/3/2002 13:19'!
byteAt: index put: aByte

	| d r w |
	d := (index + 3) // 4.
	r := (index - 1) \\ 4 + 1.
	w := (self wordAt: d) bitAnd: ((16rFF<<((4 - r)*8)) bitInvert32).
	w := w + (aByte<<((4 - r)*8)).
	self basicAt: d put: w.
	^ aByte.
! !

!WideString methodsFor: 'accessing' stamp: 'ar 4/10/2005 17:14'!
wordAt: index
	<primitive: 60>
	^ (self basicAt: index).
! !

!WideString methodsFor: 'converting' stamp: 'SeanDeNigris 1/24/2011 23:22'!
asWideString 

	^ self.! !

!WideString methodsFor: '*NativeBoost-Examples' stamp: 'IgorStasenko 11/23/2012 18:02'!
nbStringHash: speciesHash

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout
		function: #(ulong (oop self , ulong speciesHash)) emit: [:gen |
		| asm proxy rcvr cnt EAX EDX ECX ESI EBX |
		asm := gen asm.
		EAX := asm EAX. EDX := asm EDX. ECX := asm ECX. 
		ESI := asm ESI. EBX := asm EBX.
		
		proxy := gen proxy.
		rcvr := gen reserveTemp.
		cnt := gen reserveTemp.
		
		asm pop: rcvr.
		proxy stSizeOf: rcvr.
		asm mov: EAX to: cnt.  "size"
		proxy firstIndexableField: rcvr.
		asm 
			pop: EDX; "speciesHash"
			push: EBX;
			push: ESI;
			mov: cnt to: ECX;
		label: #loop;
			and: EDX with: 16rFFFFFFF;
			dec: ECX;
			jl: #wedone;
			add: EDX with: EAX ptr; "hash := hash + (aString at: pos) asInteger."
			mov: EDX to: EBX;
			and: EBX with: 16r3FFF;  "low := hash bitAnd: 16383."
			mov: EBX to: ESI;
			imul: ESI with: 16r260D;  " 16r260D * low "
			shr: EDX with: 14; 
			imul: EDX with: 16r260D; "16r260D * (hash bitShift: -14)"
			imul: EBX with: 16r0065; " (16r0065 * low) "
			add: EDX with: EBX;
			and: EDX with: 16383;
			shl: EDX with: 14;   " (16r260D * (hash bitShift: -14) + (16r0065 * low) bitAnd: 16383) * 16384 "
			add: EDX with: ESI;

			add: EAX with: 4;
			jmp: #loop;
		label: #wedone;
			pop: ESI;
			pop: EBX;
			mov: asm EDX to: asm EAX.
			
	].
	
! !

!WideString methodsFor: 'accessing' stamp: 'nice 4/2/2008 23:53'!
at: index put: aCharacter 
	"Store the Character in the field of the receiver indicated by the index."
	aCharacter isCharacter ifFalse:[self errorImproperStore].
	self wordAt: index put: aCharacter asInteger.
	^aCharacter! !

!WideString methodsFor: 'accessing' stamp: 'ar 4/10/2005 17:14'!
at: index 
	"Answer the Character stored in the field of the receiver indexed by the argument."
	^ Character value: (self wordAt: index).
! !

!WideString methodsFor: '*Multilingual-OtherLanguages' stamp: 'ar 4/9/2005 22:31'!
mutateJISX0208StringToUnicode

	| c |
	1 to: self size do: [:i |
		c := self at: i.
		(c leadingChar = JISX0208 leadingChar or: [
			c leadingChar = (JISX0208 leadingChar bitShift: 2)]) ifTrue: [
			self basicAt: i put: (Character leadingChar: JapaneseEnvironment leadingChar code: (c asUnicode)) asciiValue.
		]
	].
! !

!WideString methodsFor: 'accessing' stamp: 'ar 4/10/2005 17:14'!
wordAt: index put: anInteger
	<primitive: 61>
	self basicAt: index put: anInteger.
! !

!WideString methodsFor: '*NativeBoost-Examples' stamp: 'Igor.Stasenko 5/15/2010 00:31'!
nbHash

	^ self nbStringHash: ByteString identityHash! !

!WideString methodsFor: 'testing' stamp: 'MarcusDenker 3/28/2011 22:17'!
isUnicodeStringWithCJK

	^self anySatisfy: [:char | Unicode isUnifiedKanji: char charCode]
	! !

!WideString methodsFor: 'accessing' stamp: 'ar 4/12/2005 17:36'!
replaceFrom: start to: stop with: replacement startingAt: repStart 

	<primitive: 105>
	replacement class == String ifTrue: [
		^ self replaceFrom: start to: stop with: (replacement asWideString) startingAt: repStart.
	]. 

	^ super replaceFrom: start to: stop with: replacement startingAt: repStart.
! !

!WideString methodsFor: '*Text-Scanning' stamp: 'tpr 10/2/2013 17:28'!
scanCharactersFrom: startIndex to: stopIndex with: aCharacterScanner rightX: rightX  font: aFont
	"NB: strongly consider getting almost all these parameters from the scanner"
	"Since I'm a wide char string, I know that we have to scan multi-byte characters and handle encodings etc"
	| charSet |
	startIndex > stopIndex
		ifTrue: [^aCharacterScanner handleEndOfRunAt: stopIndex].
	charSet := self encodedCharSetAt: startIndex.
	^charSet scanMultibyteCharactersFrom: startIndex to: stopIndex in: self with: aCharacterScanner rightX: rightX font: aFont	! !

!WideString methodsFor: 'testing' stamp: 'yo 7/29/2003 14:10'!
includesUnifiedCharacter

	^ self isUnicodeStringWithCJK
! !

!WideString class methodsFor: 'instance creation' stamp: 'ar 4/12/2005 20:00'!
from: aString 

	| newString |
	(aString isMemberOf: self)
		ifTrue: [^ aString copy].
	newString := self new: aString size.
	1 to: aString size do: [:index | newString basicAt: index put: (aString basicAt: index)].
	^ newString
! !

!WideString class methodsFor: 'instance creation' stamp: 'ar 4/10/2005 19:38'!
fromByteArray: aByteArray 

	| inst |
	aByteArray size \\ 4 = 0 ifFalse: [^ ByteString fromByteArray: aByteArray ].
	inst := self new: aByteArray size // 4.
	4 to: aByteArray size by: 4 do: [:i |
		inst basicAt: i // 4
			put: ((aByteArray at: i - 3) << 24) + 
				((aByteArray at: i - 2) << 16) +
				 ((aByteArray at: i - 1) << 8) +
				(aByteArray at: i)
	].

	^ inst
! !

!WideString class methodsFor: 'instance creation' stamp: 'yo 8/28/2002 13:39'!
fromString: aString 
	"Answer an instance of me that is a copy of the argument, aString."

	| inst |
	(aString isMemberOf: self) ifTrue: [
		^ aString copy.
	].
	inst := self new: aString size.
	1 to: aString size do: [:pos |
		inst basicAt: pos put: (aString basicAt: pos).
	].
	^ inst.
! !

!WideStringTest commentStamp: '<historical>'!
This is the unit test for the class String. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see: 
	- http://www.c2.com/cgi/wiki?UnitTest
	- there is a chapter in the PharoByExample book (http://pharobyexample.org/)
	- the sunit class category!
!WideStringTest methodsFor: 'testing' stamp: 'nice 4/2/2008 23:49'!
testAtPut
	"Non regression test for http://bugs.squeak.org/view.php?id=6998"
	
	| w1 |
	w1 := WideString with: (Unicode value: 402) with: $a with: (Unicode value: 400) with: $b.
	self assert: (w1 at: 2 put: $b) = $b description: 'at:put: should return the put-object'
! !

!WideStringTest methodsFor: 'tests - converting' stamp: 'ar 4/12/2005 17:36'!
testAsInteger
	self assert: '1796exportFixes-tkMX' asWideString asInteger = 1796.
	self assert: 'donald' asWideString asInteger isNil.
	self assert: 'abc234def567' asWideString asInteger = 234.
	self assert: '-94' asWideString asInteger = -94.
	self assert: 'foo-bar-92' asWideString asInteger = -92.

	self assert: '1796exportFixes-tkMX' asWideString asSignedInteger = 1796.
	self assert: 'donald' asWideString asSignedInteger isNil.
	self assert: 'abc234def567' asWideString asSignedInteger = 234.
	self assert: '-94' asWideString asSignedInteger = -94.
	self assert: 'foo-bar-92' asWideString asSignedInteger = -92.

	self assert: '1796exportFixes-tkMX' asWideString asUnsignedInteger = 1796.
	self assert: 'donald' asWideString asUnsignedInteger isNil.
	self assert: 'abc234def567' asWideString asUnsignedInteger = 234.
	self assert: '-94' asWideString asUnsignedInteger = 94.
	self assert: 'foo-bar-92' asWideString asUnsignedInteger = 92! !

!WideStringTest methodsFor: 'tests - compare' stamp: 'StephaneDucasse 2/3/2010 22:22'!
testEqual
	"from johnmci at http://bugs.squeak.org/view.php?id=5331"
	
	self assert: 'abc' = 'abc'.
	self assert: 'abc' = 'abc' asWideString.
	self assert: 'abc' asWideString = 'abc'.
	self assert: 'abc' asWideString = 'abc' asWideString.
	self assert: ('abc' = 'ABC') not.
	self assert: ('abc' = 'ABC' asWideString) not.
	self assert: ('abc' asWideString = 'ABC') not.
	self assert: ('abc' asWideString = 'abc' asWideString).
	self assert: ( #[97 0 0 0] asString ~= 'a000' asWideString).
	self assert: ('a000' asWideString ~=  #[97 0 0 0] asString).! !

!WideStringTest methodsFor: 'tests - relation order' stamp: 'nice 7/28/2007 23:21'!
testRelationOrderWithCase
	"from johnmci at http://bugs.squeak.org/view.php?id=5331"
		
	self assert: ('ABC' caseInsensitiveLessOrEqual: 'abc').
	self assert: ('ABC' caseInsensitiveLessOrEqual: 'abd').
	self assert: ('ABD' caseInsensitiveLessOrEqual: 'abc') not.
	self assert: ('ABC' caseInsensitiveLessOrEqual: 'abc' asWideString).
	self assert: ('ABC' caseInsensitiveLessOrEqual: 'abd' asWideString).
	self assert: ('ABD' caseInsensitiveLessOrEqual: 'abc' asWideString) not.
	self assert: ('ABC' asWideString caseInsensitiveLessOrEqual: 'abc').
	self assert: ('ABC' asWideString caseInsensitiveLessOrEqual: 'abd').
	self assert: ('ABD' asWideString caseInsensitiveLessOrEqual: 'abc') not.
	self assert: ('ABC' asWideString caseInsensitiveLessOrEqual: 'abc' asWideString).
	self assert: ('ABC' asWideString caseInsensitiveLessOrEqual: 'abd' asWideString).
	self assert: ('ABD' asWideString caseInsensitiveLessOrEqual: 'abc' asWideString) not.
	
	
	self assert: ('abc' caseSensitiveLessOrEqual: 'abc').
	self assert: ('abc' caseSensitiveLessOrEqual: 'abd').
	self assert: ('abd' caseSensitiveLessOrEqual: 'abc') not.
	self assert: ('abc' caseSensitiveLessOrEqual: 'abc' asWideString).
	self assert: ('abc' caseSensitiveLessOrEqual: 'abd' asWideString).
	self assert: ('abd' caseSensitiveLessOrEqual: 'abc' asWideString) not.
	self assert: ('abc' asWideString caseSensitiveLessOrEqual: 'abc').
	self assert: ('abc' asWideString caseSensitiveLessOrEqual: 'abd').
	self assert: ('abd' asWideString caseSensitiveLessOrEqual: 'abc') not.
	self assert: ('abc' caseSensitiveLessOrEqual: 'ABC') not.
	! !

!WideStringTest methodsFor: 'tests - match' stamp: 'nice 7/28/2007 23:22'!
testCharactersExactlyMatching
	"from johnmci at http://bugs.squeak.org/view.php?id=5331"
	
	self assert: ('abc' charactersExactlyMatching: 'abc') = 3.
	self assert: ('abd' charactersExactlyMatching: 'abc') = 2.
	self assert: ('abc' charactersExactlyMatching: 'abc' asWideString) = 3.
	self assert: ('abd' charactersExactlyMatching: 'abc' asWideString) = 2.
	self assert: ('abc' asWideString charactersExactlyMatching: 'abc') = 3.
	self assert: ('abd' asWideString charactersExactlyMatching: 'abc') = 2.
	self assert: ('abc' asWideString charactersExactlyMatching: 'abc' asWideString) = 3.
	self assert: ('abd' asWideString charactersExactlyMatching: 'abc' asWideString)= 2.
	self assert: ('abc' charactersExactlyMatching: 'ABC') = 0.

! !

!WideStringTest methodsFor: 'tests - substrings' stamp: 'nice 3/23/2007 01:52'!
testSubstrings
	"this is related to http://bugs.squeak.org/view.php?id=6367"
	
	| w1 w2 |
	w1 := WideString with: 401 asCharacter with: $a with: 402 asCharacter with: $b.
	w2 := WideString with: 403 asCharacter with: 404 asCharacter.

	self assert: w1 substrings first = w1.
	self assert: (w1 , ' ' , w2) substrings size = 2.
	self assert: (w1 , ' ' , w2) substrings last = w2.! !

!WideStringTest methodsFor: 'tests - relation order' stamp: 'nice 7/28/2007 23:14'!
testRelationOrder
	"from johnmci at http://bugs.squeak.org/view.php?id=5331"

	self assert: ('aa' < 'ab').
	self assert: ('aa' <= 'ab').
	self assert: ('aa' <= 'aa').
	self assert: ('ab' > 'aa').
	self assert: ('ab' >= 'aa').
	self assert: ('aa' >= 'aa').
	
	self assert: ('aa' < 'ab' asWideString).
	self assert: ('aa' <= 'ab' asWideString).
	self assert: ('aa' <= 'aa' asWideString).
	self assert: ('ab' > 'aa' asWideString).
	self assert: ('ab' >= 'aa' asWideString).
	self assert: ('aa' >= 'aa' asWideString).
	
	self assert: ('aa' asWideString < 'ab').
	self assert: ('aa' asWideString <= 'ab').
	self assert: ('aa' asWideString <= 'aa').
	self assert: ('ab' asWideString > 'aa').
	self assert: ('ab' asWideString >= 'aa').
	self assert: ('aa' asWideString >= 'aa').
	
	self assert: ('aa' asWideString< 'ab' asWideString).
	self assert: ('aa' asWideString<= 'ab' asWideString).
	self assert: ('aa' asWideString<= 'aa' asWideString).
	self assert: ('ab' asWideString> 'aa' asWideString).
	self assert: ('ab' asWideString >= 'aa' asWideString).
	self assert: ('aa' asWideString>= 'aa' asWideString).! !

!WideStringTest methodsFor: 'tests - compare' stamp: 'StephaneDucasse 2/3/2010 22:22'!
testSameAs
	"from johnmci at http://bugs.squeak.org/view.php?id=5331"

	self assert: ('abc' sameAs: 'aBc' asWideString).
	self assert: ('aBc' asWideString sameAs: 'abc').
	self assert: ( #[97 0 0 0] asString sameAs: 'Abcd' asWideString) not.
	self assert: ('a000' asWideString sameAs:  #[97 0 0 0] asString) not.
	! !

!WideStringTest methodsFor: 'tests - match' stamp: 'nice 7/28/2007 23:16'!
testMatch
	"from johnmci at http://bugs.squeak.org/view.php?id=5331"
	
	self assert: ('*baz' match: 'mobaz' ).
	self assert: ('*foo#zort' match: 'afoo3zortthenfoo3zort' ).
	self assert: ('*baz' match: 'mobaz' ).
	self assert: ('*foo#zort' match: 'afoo3zortthenfoo3zort' ).
	
	self assert: ('*baz' match: 'mobaz' asWideString).
	self assert: ('*foo#zort' match: 'afoo3zortthenfoo3zort' asWideString).
	self assert: ('*baz' match: 'mobaz' asWideString).
	self assert: ('*foo#zort' match: 'afoo3zortthenfoo3zort' asWideString).
	
	self assert: ('*baz' asWideString match: 'mobaz' ).
	self assert: ('*foo#zort' asWideString match: 'afoo3zortthenfoo3zort' ).
	self assert: ('*baz' asWideString match: 'mobaz' ).
	self assert: ('*foo#zort' asWideString match: 'afoo3zortthenfoo3zort' ).
	
	self assert: ('*baz' asWideString match: 'mobaz' asWideString).
	self assert: ('*foo#zort' asWideString match: 'afoo3zortthenfoo3zort' asWideString).
	self assert: ('*baz' asWideString match: 'mobaz' asWideString).
	self assert: ('*foo#zort' asWideString match: 'afoo3zortthenfoo3zort' asWideString).! !

!WideStringTest methodsFor: 'testing' stamp: 'DamienPollet 3/25/2015 16:34'!
testIsAsciiString
	"Non-regression for https://pharo.fogbugz.com/f/cases/15232 "
	self assert: '' asWideString isAsciiString = true.
	self assert: 'abcdefGHIJKL 98765,./@#%$' asWideString isAsciiString = true.

	self assert: 'éÀ' asWideString isAsciiString = false.! !

!WideStringTest methodsFor: 'tests - substrings' stamp: 'nice 7/28/2007 00:46'!
testFindSubstring
	"This is related to http://bugs.squeak.org/view.php?id=6366
	finding substring in a WideString was broken because matchTable are byte-wise"
	
	| ws1 ws2 |
	
	self assert: ('abcd' findString: 'bc' startingAt: 1) = 2.
	self assert: ('abcd' asWideString findString: 'bc' startingAt: 1) = 2.
	self assert: ('abcd' findString: 'bc' asWideString startingAt: 1) = 2.
	self assert: ('abcd' asWideString findString: 'bc' asWideString startingAt: 1) = 2.
	
	ws1 := 'A' , (WideString with: (Unicode value: 530)) , 'BCD'.
	self assert: (ws1 findString: 'bc' startingAt: 1 caseSensitive: true) = 0.
	self assert: (ws1 findString: 'bc' startingAt: 1 caseSensitive: false) = 3.
	
	ws2 := (WideString with: (Unicode value: 530)) , 'b'.
	self assert: (ws1 findString: ws2 startingAt: 1 caseSensitive: true) = 0.
	self assert: (ws1 findString: ws2 startingAt: 1 caseSensitive: false) = 2.
	
	self assert: ('abc' findString: ws2 startingAt: 1 caseSensitive: true) = 0.
	self assert: ('abc' findString: ws2 startingAt: 1 caseSensitive: false) = 0.! !

!WideStringTest methodsFor: 'tests - beginswith' stamp: 'nice 7/28/2007 23:29'!
testBeginsWith
	"from johnmci at http://bugs.squeak.org/view.php?id=5331"
	
	| w1 w2 |
	self assert: ('abc' beginsWith: 'ab').
	self assert: ('abc' beginsWith: 'ab' asWideString).
	self assert: ('abc' asWideString beginsWith: 'ab').
	self assert: ('abc' beginsWith: 'aX') not .
	self assert: ('abc' beginsWith: 'AB') not.
	self assert: ('abc' beginsWith: 'AB' asWideString) not .
	self assert: ('ABC' asWideString beginsWith: 'ab') not.

	w1 := WideString with: (Unicode value: 402) with: $a with: (Unicode value: 400) with: $b.
	w2 := WideString with: (Unicode value: 402).
	w1 beginsWith: w2.
! !

!WideStringTest methodsFor: 'tests - compare' stamp: 'nice 7/28/2007 23:19'!
testCompare
	"from johnmci at http://bugs.squeak.org/view.php?id=5331"
	
	self assert: ('abc' compare: 'abc') = 2.
	self assert: ('abc' compare: 'abd') = 1.
	self assert: ('abd' compare: 'abc') = 3.
	self assert: ('abc' compare: 'abC') = 2.
	self assert: ('abc' compare: 'abD') = 1.
	self assert: ('abd' compare: 'abC') = 3.
	self assert: ('aBc' compare: 'abC') = 2.
	self assert: ('aBc' compare: 'abD') = 1.
	self assert: ('aDd' compare: 'abC') = 3.
	
	
	self assert: ('abc' compare: 'abc' asWideString) = 2.
	self assert: ('abc' compare: 'abd' asWideString) = 1.
	self assert: ('abd' compare: 'abc' asWideString) = 3.
	self assert: ('abc' compare: 'abC' asWideString) = 2.
	self assert: ('abc' compare: 'abD' asWideString) = 1.
	self assert: ('abd' compare: 'abC' asWideString) = 3.
	self assert: ('aBc' compare: 'abC' asWideString) = 2.
	self assert: ('aBc' compare: 'abD' asWideString) = 1.
	self assert: ('aDd' compare: 'abC' asWideString) = 3.
	
	self assert: ('abc' asWideString compare: 'abc') = 2.
	self assert: ('abc' asWideString compare: 'abd') = 1.
	self assert: ('abd' asWideString compare: 'abc') = 3.
	self assert: ('abc' asWideString compare: 'abC') = 2.
	self assert: ('abc' asWideString compare: 'abD') = 1.
	self assert: ('abd' asWideString compare: 'abC') = 3.
	self assert: ('aBc' asWideString compare: 'abC') = 2.
	self assert: ('aBc' asWideString compare: 'abD') = 1.
	self assert: ('aDd' asWideString compare: 'abC') = 3.
	
	self assert: ('abc' asWideString compare: 'abc' asWideString) = 2.
	self assert: ('abc' asWideString compare: 'abd' asWideString) = 1.
	self assert: ('abd' asWideString compare: 'abc' asWideString) = 3.
	self assert: ('abc' asWideString compare: 'abC' asWideString) = 2.
	self assert: ('abc' asWideString compare: 'abD' asWideString) = 1.
	self assert: ('abd' asWideString compare: 'abC' asWideString) = 3.
	self assert: ('aBc' asWideString compare: 'abC' asWideString) = 2.
	self assert: ('aBc' asWideString compare: 'abD' asWideString) = 1.
	self assert: ('aDd' asWideString compare: 'abC' asWideString) = 3.
	
	self assert: ('abc' compare: 'abc' caseSensitive: true) = 2.
	self assert: ('abc' compare: 'abC' caseSensitive: false) = 2.
	self assert: ('abc' compare: 'abc' asWideString caseSensitive: true) = 2.
	self assert: ('abc' compare: 'abC' asWideString caseSensitive: false) = 2.
	self assert: ('abc' asWideString compare: 'abc' caseSensitive: true) = 2.
	self assert: ('abc' asWideString compare: 'abC' caseSensitive: false) = 2.
	self assert: ('abc' asWideString compare: 'abc' asWideString caseSensitive: true) = 2.
	self assert: ('abc' asWideString compare: 'abC' asWideString caseSensitive: false) = 2.! !

!WideStringTest methodsFor: 'tests - endswith' stamp: 'nice 7/28/2007 23:30'!
testEndsWith
	"from johnmci at http://bugs.squeak.org/view.php?id=5331"
	
	self assert: ('abc' endsWith: 'bc').
	self assert: ('abc' endsWith: 'bc' asWideString).
	self assert: ('abc' asWideString endsWith: 'bc').
	self assert: ('abc' endsWith: 'bX') not .
	self assert: ('abc' endsWith: 'BC') not.
	self assert: ('abc' endsWith: 'BC' asWideString) not .
	self assert: ('ABC' asWideString endsWith: 'bc') not.

! !

!WideSymbol commentStamp: '<historical>'!
This class represents the symbols containing 32bit characters.!
!WideSymbol methodsFor: 'comparing' stamp: 'SeanDeNigris 1/24/2011 23:30'!
findIn: body startingAt: start matchTable: matchTable
	
	^ self findSubstring: self in: body startingAt: start matchTable: matchTable! !

!WideSymbol methodsFor: 'testing' stamp: 'ar 4/12/2005 19:52'!
isWideString
	"Answer whether the receiver is a WideString"
	^true! !

!WideSymbol methodsFor: 'accessing' stamp: 'ar 4/12/2005 17:34'!
species
	"Answer the preferred class for reconstructing the receiver."
	^WideString
! !

!WideSymbol methodsFor: 'accessing' stamp: 'ar 4/10/2005 23:38'!
byteAt: index

	| d r |
	d := (index + 3) // 4.
	r := (index - 1) \\ 4 + 1.
	^ (self wordAt: d) digitAt: ((4 - r) + 1).
! !

!WideSymbol methodsFor: 'private' stamp: 'CamilloBruni 9/5/2011 20:04'!
string: aString
	1 to: aString size do: [:j | 
		self privateAt: j put: (aString at: j) asInteger].
	^ self! !

!WideSymbol methodsFor: 'private' stamp: 'CamilloBruni 9/5/2011 18:07'!
privateAt: index put: aCharacter
	"Primitive. Store the Character in the field of the receiver indicated by
	the index. Fail if the index is not an Integer or is out of bounds, or if
	the argument is not a Character. Essential. See Object documentation
	whatIsAPrimitive."

	<primitive: 61>
	index isInteger
		ifTrue: [self errorSubscriptBounds: index]
		ifFalse: [self errorNonIntegerIndex]! !

!WideSymbol methodsFor: 'accessing' stamp: 'ar 4/10/2005 23:38'!
byteSize

	^ self size * 4.
! !

!WideSymbol methodsFor: 'accessing' stamp: 'ar 4/10/2005 23:38'!
byteAt: index put: aByte
	self errorNoModification.! !

!WideSymbol methodsFor: 'accessing' stamp: 'ar 4/10/2005 23:38'!
wordAt: index
	<primitive: 60>
	^ (self basicAt: index).
! !

!WideSymbol methodsFor: 'converting' stamp: 'SeanDeNigris 1/24/2011 23:21'!
asWideString 

	^ self.! !

!WideSymbol methodsFor: 'accessing' stamp: 'ar 4/10/2005 23:38'!
at: index 
	"Answer the Character stored in the field of the receiver indexed by the argument."
	^ Character value: (self wordAt: index).
! !

!WideSymbol methodsFor: '*Multilingual-OtherLanguages' stamp: 'yo 7/29/2005 21:53'!
mutateJISX0208StringToUnicode

	| c |
	1 to: self size do: [:i |
		c := self at: i.
		(c leadingChar = JISX0208 leadingChar or: [
			c leadingChar = (JISX0208 leadingChar bitShift: 2)]) ifTrue: [
			self basicAt: i put: (Character leadingChar: JapaneseEnvironment leadingChar code: (c asUnicode)) asciiValue.
		]
	].
! !

!WideSymbol methodsFor: 'accessing' stamp: 'ar 4/10/2005 23:39'!
wordAt: index put: anInteger
	self errorNoModification.! !

!WideSymbol methodsFor: '*Text-Scanning' stamp: 'nice 10/9/2013 01:47'!
scanCharactersFrom: startIndex to: stopIndex with: aCharacterScanner rightX: rightX  font: aFont
	"NB: strongly consider getting almost all these parameters from the scanner"
	"Since I'm a wide char string, I know that we have to scan multi-byte characters and handle encodings etc"
	| charSet |
	startIndex > stopIndex
		ifTrue: [^aCharacterScanner handleEndOfRunAt: stopIndex].
	charSet := self encodedCharSetAt: startIndex.
	^charSet scanMultibyteCharactersFrom: startIndex to: stopIndex in: self with: aCharacterScanner rightX: rightX font: aFont	! !

!WideSymbol class methodsFor: 'initialization' stamp: 'ar 4/10/2005 23:55'!
initialize
	Smalltalk removeFromShutDownList: self. "@@@ Remove this later @@@"! !

!WidgetBuilt commentStamp: '<historical>'!
I am raised when a widget has been built!
!WidgetBuilt methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/22/2013 00:01'!
model
	^ model! !

!WidgetBuilt methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/22/2013 00:01'!
widget
	^ widget! !

!WidgetBuilt methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/22/2013 00:01'!
model: anObject
	model := anObject! !

!WidgetBuilt methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 2/22/2013 00:01'!
widget: anObject
	widget := anObject! !

!WidgetBuilt class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 2/22/2013 00:01'!
model: model widget: widget

	^ self new
		model: model;
		widget: widget;
		yourself! !

!WidgetExamples commentStamp: 'HilaireFernandes 3/22/2014 17:24'!
Examples for different widgets:

WidgetExamples new exampleBasicControls
WidgetExamples new exampleOtherControls
WidgetExamples new exampleColorControls
WidgetExamples new exampleDialogs
WidgetExamples new exampleGroups
WidgetExamples new exampleTextEntryWithCompletionDialog
WidgetExamples new exampleWindowWithToolbars!
!WidgetExamples class methodsFor: 'examples' stamp: 'TorstenBergmann 9/5/2014 16:53'!
exampleColorControls
	"Open a window with examples of each of the color controls."
	"self exampleColorControls"

	|dialog builder|
	builder := self exampleBuilder.
	dialog := (builder newPluggableDialogWindow: 'Example color controls') useDefaultOKButton.
	dialog contentMorph: (dialog newRow: {
		dialog newLabelGroup: {
			'Alpha Selector'->(dialog newAlphaSelector: (ValueHolder new contents: 0)
							getAlpha: #contents setAlpha: #contents: help: 'This is an alpha channel selector').
			'Hue Selector'->(dialog newHueSelector: (ValueHolder new contents: 0)
							getHue: #contents setHue: #contents: help: 'This is a hue selector').
			'SV Color Selector'->((dialog newSVSelector: Color yellow
									help: 'This is a saturation-volume selector') minHeight: 80).
			'HSV Color Selector'->((dialog newHSVSelector: Color green
									help: 'This is a hue-saturation-volume selector') minHeight: 80; minWidth: 120)}.
		dialog newVerticalSeparator.
		dialog newTitle: 'HSVA Color Selector' for:
			((dialog newHSVASelector: Color cyan
					help: 'This is a hue-saturation-volume-alpha selector')
					minHeight: 184; minWidth: 184)});
		model: nil.
	builder openModal: dialog! !

!WidgetExamples class methodsFor: 'examples' stamp: 'TorstenBergmann 9/5/2014 16:53'!
exampleOtherControls
	"Open a window with examples of each of the other controls."
	"self exampleOtherControls"
	
	|dialog builder image emboss fuzzy|
	builder := self exampleBuilder.
	dialog := (builder newPluggableDialogWindow: 'Example other controls') useDefaultOKButton.
	emboss := (dialog newString: 'Hello there') trackPaneColor: false.
	fuzzy := (dialog newFuzzyLabel: 'A Fuzzy Label') minHeight: 40; minWidth: 160.
	dialog contentMorph: (dialog newRow: {
		dialog newTitle: 'Alpha Image' for: (
			dialog newColumn: {
				((image := dialog newAlphaImage: nil help: 'This is an alpha image')
					borderWidth: 1;
					extent: 160@160).
				dialog newLabelGroup: {
				'Scale'->(dialog newSliderFor: image getValue: #scale setValue: #scale:
					min: 0 max: 4 quantum: nil
					getEnabled: nil help: 'The image scale 0..1').
				'Alpha'->((dialog newAlphaSelector: image getAlpha: #alpha setAlpha: #alpha: help: 'The image alpha')
					vResizing: #shrinkWrap;
					minHeight: 16).
				'Layout'->(dialog newDropListFor: image list: #layoutSymbols
					getSelected: #layout setSelected: #layout:
					getEnabled: nil useIndex: false help: 'The image layout')}}).
		dialog newVerticalSeparator.
		dialog newLabelGroup: {
			'Color presenter'->((dialog newColorPresenterFor: (ValueHolder new contents: (Color blue alpha: 0.6))
					getColor: #contents help: 'This is a color presenter')
					vResizing: #shrinkWrap).
			'Color chooser'->(dialog newColorChooserFor: emboss
					getColor: #color setColor: #color: help: 'This is a color chooser').
			'Row with dashed border'->((dialog newRow: {dialog newLabel: 'I have a dashed border!!'})
					borderStyle: (DashedBorder width: 3
							dashColors: {Color red. Color green. Color blue} dashLengths: #(1 2 3))).
			'Embossed string'->emboss.
			'Style'->(dialog newDropListFor: emboss list: #styleSymbols
					getSelected: #style setSelected: #style:
					getEnabled: nil useIndex: false help: 'The embossed string style').
			'Fuzzy label'->fuzzy.
			'Offset'->(dialog newSliderFor: fuzzy getValue: #offset setValue: #offset:
					min: 0 max: 5 quantum: 1
					getEnabled: nil help: 'The fuzzy label offset').
			'Alpha'->((dialog newAlphaSelector: fuzzy getAlpha: #alpha setAlpha: #alpha:
					help: 'The fuzzy label alpha')
					vResizing: #shrinkWrap;
					minHeight: 16)}.
		dialog newVerticalSeparator.
		dialog newTitle: 'Expanders' for: (
			(dialog newColumn: {
				(dialog newExpander: 'An Expander' forAll: {
					dialog newLabel: 'Expanded!!'.
					builder newMorphListFor: (ListModel new items: ((Color red wheel: 15)
									collect: [:c | Morph new extent: 80@12; color: c]))
							list: #getList getSelected: #selectedIndex setSelected: #setSelectedIndex:
							help: 'This is a morph drop list'}) minWidth: 100.
				dialog newExpander: 'Another' forAll: {
					dialog newLabel: 'Expanded!!'.
					builder newMorphDropListFor: (ListModel new items: ((Color red wheel: 8)
									collect: [:c | Morph new extent: 80@12; color: c]))
							list: #getList getSelected: #selectedIndex setSelected: #setSelectedIndex:
							help: 'This is a morph drop list'}})
				cellInset: 0;
				borderStyle: (BorderStyle inset baseColor: dialog paneColor; width: 1))});
		model: nil.
	builder openModal: dialog! !

!WidgetExamples class methodsFor: 'examples - cleanup' stamp: 'TorstenBergmann 9/5/2014 16:50'!
closeExampleDialogs
	"Close the example dialogs."
	"self closeExampleDialogs"
	
	DialogWindow allSubInstances do: [:d | d cancel]! !

!WidgetExamples class methodsFor: 'examples' stamp: 'StephaneDucasse 9/30/2014 12:06'!
exampleTextEntryWithCompletionDialog
	"self exampleTextEntryWithCompletionDialog"
	| applicants entryCompletion |
	applicants := (Array
				streamContents: [:strm | Symbol
						allSymbolTablesDo: [:each | (each notEmpty
									and: [each first canBeGlobalVarInitial
											and: [Smalltalk globals includesKey: each]])
								ifTrue: [strm nextPut: each]]]) sort.
	entryCompletion := EntryCompletion new
				dataSourceBlock: [:currText | applicants];		
				filterBlock: [:currApplicant :currText | currText size > 3
						and: [currApplicant asUppercase includesSubstring: currText asString asUppercase]].
	UIManager default
		request: 'Enter a class name fragment (at least 4 characters)'
		initialAnswer: ''
		title: 'Text entry with completion example: simple find a class'
		entryCompletion: entryCompletion! !

!WidgetExamples class methodsFor: 'examples' stamp: 'TorstenBergmann 9/5/2014 16:53'!
exampleWindowWithToolbars
	"Open an example window with toolbars."
	"self exampleWindowWithToolbars"

	|win fileMenu tools dock text holder|
	win := StandardWindow new.
	fileMenu := win newMenu.
	fileMenu
		addToggle: 'Open' translated
		target: nil "would be model"
		selector: #openFile.
	fileMenu lastItem
		font: win theme menuFont;
		icon: Smalltalk ui icons smallOpenIcon;
		keyText: 'Ctrl+O'.
	fileMenu
		addToggle: 'Save' translated
		target: nil
		selector: #saveFile
		getStateSelector: nil
		enablementSelector: nil.
	fileMenu lastItem
		font: win theme menuFont;
		icon: Smalltalk ui icons smallSaveIcon;
		keyText: 'Ctrl+S'.
	fileMenu
		addToggle: 'Print...' translated
		target: nil
		selector: #print.
	fileMenu lastItem
		font: win theme menuFont;
		icon: Smalltalk ui icons smallPrintIcon;
		keyText: 'Ctrl+P'.
	tools := win newToolbar: {win
			newButtonFor: nil "if we had a model it would go here"
			getState: nil
			action: #openFile
			arguments: nil
			getEnabled: nil
			labelForm: Smalltalk ui icons smallOpenIcon
			help: 'Open file' translated.
		win
			newButtonFor: nil
			getState: nil
			action: #saveFile
			arguments: nil
			getEnabled: nil
			labelForm: Smalltalk ui icons smallSaveIcon
			help: 'Save file' translated.
		win
			newButtonFor: nil
			getState: nil
			action: #print
			arguments: nil
			getEnabled: nil
			labelForm: Smalltalk ui icons smallPrintIcon
			help: 'Print' translated}.
		holder := ValueHolder new.
		text := win
			newTextEditorFor: holder
			getText:  #contents
			setText: #contents:.
		dock := win newToolDockingBar.
		dock
			add: 'File' translated
			font: win theme menuBarFont
			icon: Smalltalk ui icons smallOpenIcon
			help: 'File operations' translated
			subMenu: fileMenu;
			addMorphBack: tools.
		win
			addMorph: dock
			fullFrame: ((0@0 corner: 1@0) asLayoutFrame bottomOffset: dock minExtent y);
			addMorph: text
			fullFrame: ((0@0 corner: 1@1) asLayoutFrame topOffset: dock minExtent y).
		win
			themeChanged;
			openInWorld! !

!WidgetExamples class methodsFor: 'examples' stamp: 'NicolaiHess 12/9/2014 11:22'!
exampleBasicControls
	"Open a window with examples of each of the basic controls."
	"self exampleBasicControls"
	
	|dialog builder radioModel treeModel|
	builder := self exampleBuilder.
	dialog := (builder newPluggableDialogWindow: 'Example basic controls') useDefaultOKButton.
	radioModel := ExampleRadioButtonModel new.
	treeModel := Array with:(MorphWithSubmorphsWrapper with: World).
	dialog contentMorph: ((dialog newRow: {
		dialog newLabelGroup: {
			'Normal Label'->(dialog newLabel: 'A Label').
			'Disabled Label'->(dialog newLabel: 'A Disabled Label') disable.
			'Normal Button'->(dialog newButtonFor: nil action: nil label: 'A Button' help: 'This is a button').
			'Default Button'->((dialog newButtonFor: nil action: nil label: 'Default Button' help: 'This is a default button') isDefault: true).
			'Disabled Button'->(dialog newButtonFor: nil action: nil label: 'Disabled Button'
							help: 'This is a disabled button') disable.
			'Selected Button'->(dialog newButtonFor: (ValueHolder new contents: true) getState: #contents
							action: nil arguments: #() getEnabled: nil label: 'A Button' help: 'This is a selected button').
			'Selected Disabled Button'->(dialog newButtonFor: (ValueHolder new contents: true) getState: #contents
							action: nil arguments: #() getEnabled: nil label: 'Disabled Button'
							help: 'This is a selected disabled button') disable.
			'Checkbox'->(dialog newCheckboxFor: (ValueHolder new contents: true)
							getSelected: #contents setSelected: #contents: label: 'A Checkbox' help: 'This is a checkbox').
			'Disabled Checkbox'->(dialog newCheckboxFor: (ValueHolder new contents: true)
							getSelected: #contents setSelected: #contents:
							label: 'A Disabled Checkbox' help: 'This is a disabled checkbox') disable.
			'Radio Buttons'->((dialog newColumn: {
								(dialog newRadioButtonFor: radioModel
									getSelected: #isLeft setSelected: #beLeft label: 'Left' help: 'This is a radio buton').
								(dialog newRadioButtonFor: radioModel
									getSelected: #isCenter setSelected: #beCenter label: 'Center' help: 'This is a radio buton').
								(dialog newRadioButtonFor: radioModel
									getSelected: #isRight setSelected: #beRight label: 'Right' help: 'This is a radio buton')})
								vResizing: #shrinkWrap).
			'Disabled Radio Button'->(dialog newRadioButtonFor: radioModel
									getSelected: #isRight setSelected: #beRight label: 'Right'
									help: 'This is a disabled radio buton') disable.
			'Text Entry'->(dialog newTextEntryFor: (ValueHolder new contents: 'Hello')
							getText: #contents setText: #contents: help: 'This is a text entry').
			'Disabled Text Entry'->(dialog newTextEntryFor: (ValueHolder new contents: 'Hello')
							getText: #contents setText: #contents: help: 'This is a disabled text entry') disable.
			'Slider'->(dialog newSliderFor: (ValueHolder new contents: 0.5)
							getValue: #contents setValue: #contents: help: 'This is a slider').
			'Disabled Slider'->(dialog newSliderFor: (ValueHolder new contents: 0.75)
							getValue: #contents setValue: #contents: help: 'This is a disabled slider') disable}.
			dialog newVerticalSeparator.
			dialog newLabelGroup: {
			'Drop List'->(dialog newDropListFor: (ListModel new items: #('One' 'Two' 'Three' 'Four'))
							list: #getList getSelected: #selectedIndex setSelected: #setSelectedIndex: help: 'This is a drop list').
			'Disabled Drop List'->(dialog newDropListFor: (ListModel new items: #('One' 'Two' 'Three' 'Four'); setSelectedIndex: 3)
							list: #getList getSelected: #selectedIndex setSelected: #setSelectedIndex:
							help: 'This is a disabled drop list') disable.
			'Editable Drop List'->(dialog newEditableDropListFor: (ListModel new items: SortedCollection new)
							list: #getList getSelected: #selectedIndex setSelected: #setSelectedIndex:
							addToList: #add: ghostText: 'Enter new items' getEnabled: nil help: 'This is an editable drop list').
			'Morph Drop List'->(dialog newMorphDropListFor: (ListModel new items: ((Color red wheel: 20)
									collect: [:c | Morph new extent: 120@12; color: c]))
							list: #getList getSelected: #selectedIndex setSelected: #setSelectedIndex:
							help: 'This is a morph drop list').
			'Normal List'->((dialog newListFor: (ListModel new items: #('One' 'Two' 'Three' 'Four'); setSelectedIndex: 3)
							list: #getList selected: #selectedIndex changeSelected: #setSelectedIndex:
							help: 'This is a list') minWidth: 120).
			'Disabled List'->(dialog newListFor: (ListModel new items: #('One' 'Two' 'Three' 'Four'); setSelectedIndex: 3)
							list: #getList selected: #selectedIndex changeSelected: #setSelectedIndex:
							help: 'This is a disabled list') disable.
			'Morph List'->(dialog newMorphListFor: (ListModel new items: ((Color red wheel: 20)
									collect: [:c | Morph new extent: 80@12; color: c]))
							list: #getList getSelected: #selectedIndex setSelected: #setSelectedIndex:
							help: 'This is a morph list').
			'Tree'->((dialog newTreeFor: treeModel list: #value selected: nil changeSelected: nil) minHeight: 100)}.
			dialog newVerticalSeparator.
			dialog newColumn: {
				dialog newTitle: 'Text Editor' for: (
					(dialog newTextEditorFor: (ValueHolder new contents: 'Hello')
						getText: #contents setText: #contents:) minWidth: 100).
				dialog newTitle: 'Disabled Text Editor' for: (
					(dialog newTextEditorFor: (ValueHolder new contents: 'Hello')
						getText: #contents setText: #contents:) disable)}})
			vResizing: #spaceFill);
		model: nil.
	builder openModal: dialog! !

!WidgetExamples class methodsFor: 'examples' stamp: 'TorstenBergmann 9/5/2014 16:53'!
exampleDialogs
	"Open an example of each services dialog"
	"self exampleDialogs"

	self exampleBuilder
		chooseFont: TextStyle default defaultFont;
		chooseColor: (Color r: 0.529 g: 0.611 b: 0.004);
		chooseDirectory: 'Choose folder';
		chooseFileName: 'Pick a file name' extensions: nil path: nil preview: nil;
		textEntry: 'Choose a name for the project' title: 'Save project' entryText: 'My Project';
		chooseDropList: 'Pick one!!' list: #('One' 'Two' 'Three' 'Four');
		deny: 'Opening the safe is not possible!!';
		message: 'Hello!!';
		proceed: 'Save image?';
		alert: 'Danger!!';
		abort: 'Something has gone wrong...';
		question: 'Save the file?' title: 'Exiting application';
		questionWithoutCancel: 'Save image as well?' title: 'Exiting application'! !

!WidgetExamples class methodsFor: 'private - accessing' stamp: 'TorstenBergmann 9/5/2014 16:52'!
exampleBuilder
	"Answer a morph that implements TEasilyThemed but without honouring modality
	for the example dialogs."
	"self exampleBuilder"

	^ExampleBuilderMorph new! !

!WidgetExamples class methodsFor: 'examples' stamp: 'TorstenBergmann 9/5/2014 16:53'!
exampleGroups
	"Open a window with examples of each of the group type morphs."
	"self exampleGroups"

	|dialog builder|
	builder := self exampleBuilder.
	dialog := (builder newPluggableDialogWindow: 'Example groups') useDefaultOKButton.
	dialog contentMorph: ((dialog newRow: {
		dialog newLabelGroup: {
			'Plain Groupbox'->(dialog newGroupboxForAll: {
				dialog newButtonFor: nil action: nil label: 'A Button' help: 'This is a button'.
				dialog newButtonFor: nil action: nil label: 'A Button' help: 'This is a button'}).
			'Groupbox'->(dialog newGroupbox: 'A groupbox' forAll: {
				dialog newButtonFor: nil action: nil label: 'A Button' help: 'This is a button'.
				dialog newButtonFor: nil action: nil label: 'A Button' help: 'This is a button'})}.
		dialog newLabelGroup: {
			'Tab Group'->(dialog newTabGroup: {
				(dialog newRow: {dialog newImage:  Smalltalk ui icons smallLeftFlushIcon. dialog newLabel: 'Page 1'})->
					(dialog newGroupbox: 'A groupbox' forAll: {
						dialog newButtonFor: nil action: nil label: 'A Button' help: 'This is a button'.
						dialog newButtonFor: nil action: nil label: 'A Button' help: 'This is a button'}).
				'Page 2'->(dialog newCheckboxFor: (ValueHolder new contents: true)
							getSelected: #contents setSelected: #contents: label: 'A Checkbox'
							help: 'This is a checkbox')})}})
		vResizing: #spaceFill);
		model: nil.
	builder openModal: dialog! !

!WikiStyleHelp commentStamp: 'tbn 1/14/2011 00:35'!
This help type extends the system with a wiki like help descriptions!
!WikiStyleHelp class methodsFor: 'conversion' stamp: 'tbn 1/14/2011 00:35'!
asHelpTopic 
	<systemHelp>
	
	^WikiStyleHelpBuilder new build topicToBuild! !

!WikiStyleHelpBuilder commentStamp: 'LaurentLaffont 2/13/2011 16:53'!
I'm an HelpSystem builder which create an HelpSystem book from a wiki-like formatted string. 

!! Usage

- Create a class-side method on the class you want to put documentation.
- Add the pragma <wikiStyleHelp:> with the title of the book as parameter
- The method should answer the documentation as a String (using Pier syntax. See http://www.piercms.com/doc/syntax ). 

!! Example

MyClass class>>aMethod
        <wikiStyleHelp: #'The name of the book I want to write'>
        ^ '
 !! Section 1

 Some text for this section

 !!!! Subsection 1.1
 !!!!!! Subsection 1.1.1
 !!!! Subsection 1.2
 !! Section 2'!
!WikiStyleHelpBuilder methodsFor: 'building' stamp: 'MarcusDenker 11/4/2014 12:04'!
build
	| text extract topic |
	topicToBuild title: 'Wiki style help' translated.
	self class allHelpPragmas
		do: [ :each | 
			"Its assumed that if the pragma is a single keyword only the title is given
		 and the default syntax applies, otherwise the syntax is given as last parameter
		 on the pragmas keyword message"
			text := each method methodClass theNonMetaClass perform: each method selector.
			extract := self extractHelpContentFromString: text.
			topic := self helpTopicFromFormattedString: extract title: each arguments first.
			topicToBuild addSubtopic: topic ]! !

!WikiStyleHelpBuilder methodsFor: 'private accessing' stamp: 'tbn 1/14/2011 00:41'!
defaultSyntax
	^#pier! !

!WikiStyleHelpBuilder methodsFor: 'private conversion' stamp: 'tbn 1/14/2011 01:30'!
helpTopicFromFormattedString: aString title: aTitle
	| helpString currentLevel section topicStack topic |
	helpString := aString.
	topicStack := Stack new.
	topicStack push: (HelpTopic new title: aTitle).
	currentLevel := 0.
	section := ''.
	helpString 
		linesDo: [:line | 
			(line beginsWith: self sectionStartChar asString)
				ifTrue: [ |  level title |					
					section ~= ''
						ifTrue: [topicStack top contents: section trimLeft.
							section := ''].
					level := 0.
					[(level < line size) and: [(line at: level + 1) = self sectionStartChar]]
						whileTrue: [level := level + 1].
					title := (line copyFrom: level + 1 to: line size) trimLeft.
					level > currentLevel 
						ifTrue: [(level - currentLevel)
							timesRepeat: [topicStack push:  HelpTopic new].
							topicStack top title: title]
						ifFalse: [currentLevel = level
							ifTrue: [topic := topicStack pop.
								topicStack top addSubtopic: topic.
								topicStack push: (HelpTopic new title: title)]
							ifFalse: [
								(currentLevel - level) + 1 
									timesRepeat: [topic := topicStack pop.
										topicStack top addSubtopic: topic].
								topicStack push: (HelpTopic new title: title)]].
					currentLevel := level]
				ifFalse: [section := section, String cr, line]].
	section ~= ''
		ifTrue: [topicStack top contents: section trimLeft].
	[topicStack isEmpty]
		whileFalse: [topic := topicStack pop.
			topicStack isEmpty ifFalse: [topicStack top addSubtopic: topic]].
	^ topic
! !

!WikiStyleHelpBuilder methodsFor: 'private extraction' stamp: 'tbn 1/7/2011 12:36'!
helpTag
	^  #help! !

!WikiStyleHelpBuilder methodsFor: 'private extraction' stamp: 'tbn 1/7/2011 12:36'!
helpStartMarker
	^  '<', self helpTag, '>'! !

!WikiStyleHelpBuilder methodsFor: 'private accessing' stamp: 'AlainPlantec 1/9/2011 22:37'!
sectionStartChar
	^ $!!! !

!WikiStyleHelpBuilder methodsFor: 'private accessing' stamp: 'MarcusDenker 11/4/2014 12:03'!
helpContentFromString: aString
	| start stop |
	start := aString findString: self helpStartMarker.
	start := start = 0
		ifTrue: [ 1 ]
		ifFalse: [ start + self helpStartMarker size ].
	stop := aString findString: self helpStopMarker startingAt: start.
	stop := stop = 0
		ifTrue: [ aString size ]
		ifFalse: [ stop - 1 ].
	^ (aString copyFrom: start to: stop) trimBoth! !

!WikiStyleHelpBuilder methodsFor: 'private accessing' stamp: 'tbn 1/14/2011 01:16'!
supportedSyntaxes
	^#(pier) ! !

!WikiStyleHelpBuilder methodsFor: 'private extraction' stamp: 'tbn 1/7/2011 12:36'!
helpStopMarker
	^  '</', self helpTag, '>'! !

!WikiStyleHelpBuilder methodsFor: 'private extraction' stamp: 'MarcusDenker 11/4/2014 12:03'!
extractHelpContentFromString: aString
	| start stop |
	start := aString findString: self helpStartMarker.
	start := start = 0
		ifTrue: [ 1 ]
		ifFalse: [ start + self helpStartMarker size ].
	stop := aString findString: self helpStopMarker startingAt: start.
	stop := stop = 0
		ifTrue: [ aString size ]
		ifFalse: [ stop - 1 ].
	^ (aString copyFrom: start to: stop) trimBoth! !

!WikiStyleHelpBuilder class methodsFor: 'help' stamp: 'LaurentLaffont 2/13/2011 16:52'!
help
        <wikiStyleHelp: #'Write documentation with wiki like syntax'>
        ^ 'From WikiStyleHelpBuilder comment: ', String cr, self comment! !

!WikiStyleHelpBuilder class methodsFor: 'private accessing' stamp: 'tbn 1/14/2011 00:45'!
pragmaKeywords
	 ^#(wikiStyleHelp: wikiStyleHelp:syntax:)
! !

!WikiStyleHelpBuilder class methodsFor: 'private accessing' stamp: 'tbn 1/7/2011 12:33'!
pragmaKeyword
	 ^#wikiStyleHelp:
! !

!WikiStyleHelpBuilder class methodsFor: 'private accessing' stamp: 'tbn 1/14/2011 00:45'!
allHelpPragmas
	 ^(PragmaCollector filter: [:pragma | self pragmaKeywords includes: pragma keyword]) reset collected
! !

!WikiStyleHelpBuilderTest commentStamp: 'TorstenBergmann 2/4/2014 21:19'!
SUnit tests for class WikiStyleHelpBuilder!
!WikiStyleHelpBuilderTest methodsFor: 'testing' stamp: 'tbn 1/14/2011 01:44'!
testDefaultSyntaxAlwaysPier
	self assert: builder defaultSyntax == #pier! !

!WikiStyleHelpBuilderTest methodsFor: 'testing' stamp: 'tbn 1/14/2011 01:47'!
testExtractHelpContentsFromMarkedString
	|content|
	content := builder extractHelpContentFromString: 'outer<help>inner</help>outer'.
	self assert: content = 'inner'.
	! !

!WikiStyleHelpBuilderTest methodsFor: 'accessing' stamp: 'tbn 1/14/2011 01:44'!
defaultTestClass
	^WikiStyleHelpBuilder! !

!WikiStyleHelpBuilderTest methodsFor: 'running' stamp: 'tbn 1/14/2011 01:44'!
setUp
	super setUp.
	builder := self defaultTestClass new! !

!WikiStyleHelpTest commentStamp: 'TorstenBergmann 2/4/2014 21:20'!
SUnit tests for WikiStyleHelp!
!WikiStyleHelpTest methodsFor: 'testing' stamp: 'MarcusDenker 8/20/2014 10:00'!
testOpenBrowserOnThisHelpType
	| browser |
	browser := HelpBrowser openOn: WikiStyleHelp.
	World doOneCycleNow.
	browser close! !

!Win32Environment commentStamp: '<historical>'!
I am a specialized OSEnvironment for Windows!
!Win32Environment methodsFor: 'private' stamp: 'CamilloBrunui 5/6/2013 16:47'!
getEnv: aVariableName
	| valueSize buffer |
	valueSize := self getEnvSize: aVariableName.
	valueSize = 0 
		ifTrue: [ ^ nil ].
	buffer := String new: valueSize.
	(self getEnv: aVariableName buffer: buffer size: valueSize) = (valueSize - 1)
		ifFalse: [ ^ nil ].
	^ buffer allButLast! !

!Win32Environment methodsFor: 'private' stamp: 'CamilloBrunui 5/6/2013 16:53'!
unsetEnv: aString
	^ self setEnv: aString value: nil! !

!Win32Environment methodsFor: 'private' stamp: 'CamilloBrunui 5/6/2013 16:41'!
getEnvSize: nameString

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode >
	 ^ self nbCall: #( int GetEnvironmentVariableA ( String nameString, nil, 0 ) ) module: #Kernel32! !

!Win32Environment methodsFor: 'private' stamp: 'CamilloBrunui 5/6/2013 16:51'!
getEnv: nameString buffer: aBuffer size: anInteger
	"If the function succeeds, the return value is the number of characters stored in the buffer pointed to by aBuffer, not including the terminating null character.
	
If aBuffer is not large enough to hold the data, the return value is the buffer size, in characters, required to hold the string and its terminating null character and the contents of aBuffer are undefined.

If the function fails, the return value is zero. If the specified environment variable was not found in the environment block, GetLastError returns ERROR_ENVVAR_NOT_FOUND."

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode >
	 ^ self nbCall: #( int GetEnvironmentVariableA ( String nameString, char * aBuffer, int anInteger ) ) module: #Kernel32! !

!Win32Environment methodsFor: 'enumeration' stamp: 'MarcusDenker 9/12/2013 14:51'!
keysAndValuesDo: aBlock
	"Under windows the environemtn variables are a single big String."

	"Lines starting with an equal sign are invalid per    
	  http://stackoverflow.com/questions/10431689/what-are-these-strange-environment-variables"

	| environmentStrings nexString |
	environmentStrings := self environmentStrings.
	[ 
	nexString := environmentStrings readString.
	nexString ifEmpty: [ ^ self ].
	nexString first = $=
		ifFalse: [ self keysAndValuesDo: aBlock withAssociationString: nexString ].
	environmentStrings := NBExternalAddress value: environmentStrings value + nexString size + 1 ] repeat! !

!Win32Environment methodsFor: 'accessing' stamp: 'CamilloBruni 4/29/2013 17:40'!
environmentStrings
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode >
	 ^ self nbCall: #( void * GetEnvironmentStrings () ) module: #Kernel32! !

!Win32Environment methodsFor: 'private' stamp: 'CamilloBrunui 5/6/2013 16:56'!
setEnv: nameString value: valueString
	"This method calls the Standard C Library getenv() function"
	<primitive: #primitiveNativeCall module: #NativeBoostPlugin error: errorCode >
	 ^ self nbCall: #( int SetEnvironmentVariableA ( String nameString, String valueString) ) module: #Kernel32 options: #( optStringOrNull )! !

!Win32Environment class methodsFor: 'testing' stamp: 'EstebanLorenzano 1/24/2014 16:40'!
isDefaultFor: aPlatform 
	^ aPlatform isWin32! !

!Win32Platform commentStamp: '<historical>'!
I am a an object representing a Windows platform. Use myself to access platform specific features.

Please keep me polymorphic to the the other platform objects.

To get the current platform, you can evaluate:

OSPlatform current.!
!Win32Platform methodsFor: '*Glamour-Core' stamp: 'EstebanLorenzano 12/10/2014 22:44'!
menuShortcutModifierString
	^ 'alt'! !

!Win32Platform methodsFor: 'accessing' stamp: 'cami 7/22/2013 18:34'!
family
	^#Windows! !

!Win32Platform methodsFor: '*Files' stamp: 'DamienCassou 11/7/2013 16:21'!
potentialLocationsOfSourcesFile
	^ {(Smalltalk vm directory)}! !

!Win32Platform methodsFor: 'testing' stamp: 'CamilloBruni 5/9/2013 22:28'!
isWin32
	^ true! !

!Win32Platform methodsFor: 'accessing' stamp: 'CamilloBruni 5/9/2013 22:32'!
virtualKey: virtualKeyCode
	"Win32Platform virtualKey: $C charCode"

	(virtualKeyCode <=  90 "$Z charCode"
		and: [virtualKeyCode >=  65 "$A "])
		ifFalse: [^nil].
	"#($a $b $c $d $e $f $g $h $i $j $k $l $m $n $o $p $q $r $s $t $u $v $w $x $y $z)"
	
	^(#($a nil $c $d nil $f $g nil nil nil nil $l $m $n nil $p nil nil $s nil nil $v nil $x nil $z)
		at: virtualKeyCode-64) ifNotNil: [:char | char charCode]! !

!Win32Platform methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 12/12/2013 14:16'!
lineEnding

	^ String crlf! !

!Win32Platform methodsFor: '*Keymapping-KeyCombinations' stamp: 'BenjaminVanRyseghem 11/29/2013 16:03'!
defaultModifier

	^ KMModifier control! !

!Win32Platform methodsFor: 'accessing' stamp: 'GuillermoPolito 5/4/2013 11:30'!
keyForValue: aKeyValue
	^Key valueForWindowsPlatform: aKeyValue.! !

!Win32Platform methodsFor: 'testing' stamp: 'cami 7/22/2013 18:27'!
isWindows
	^ true! !

!Win32Platform methodsFor: 'accessing' stamp: 'cami 7/22/2013 18:18'!
environment
	^ environment ifNil: [ environment := Win32Environment new ]! !

!Win32Platform class methodsFor: 'testing' stamp: 'CamilloBruni 5/9/2013 22:39'!
isActivePlatform
	"Answer whether the receiver is the active platform"
	^ self currentPlatformName = 'Win32' ! !

!WindowActivated commentStamp: 'Alexandre.Bergel 8/8/2009 13:55'!
Emitted when navigating between windows. !
!WindowAnnouncement methodsFor: 'accessing' stamp: 'Alexandre.Bergel 5/11/2009 16:45'!
window
	^ window! !

!WindowAnnouncement methodsFor: 'accessing' stamp: 'Alexandre.Bergel 5/11/2009 16:45'!
window: anObject
	window := anObject! !

!WindowAnnouncement methodsFor: 'testing' stamp: 'Alexandre Bergel 1/12/2010 11:14'!
isMoved
	^ false! !

!WindowAnnouncement methodsFor: 'accessing' stamp: 'Alexandre.Bergel 8/8/2009 14:45'!
event
	^ event! !

!WindowAnnouncement methodsFor: 'accessing' stamp: 'Alexandre.Bergel 8/8/2009 14:45'!
event: evt
	event := evt! !

!WindowAnnouncement methodsFor: 'testing' stamp: 'Alexandre Bergel 1/12/2010 11:15'!
isResized
	^ false! !

!WindowAnnouncement methodsFor: 'testing' stamp: 'GaryChambers 6/10/2011 13:06'!
isLabelled
	^ false! !

!WindowAnnouncement methodsFor: 'testing' stamp: 'Alexandre Bergel 1/12/2010 11:13'!
isClosed
	^ false! !

!WindowAnnouncement methodsFor: 'testing' stamp: 'Alexandre Bergel 1/12/2010 11:15'!
isScrolled
	^ false! !

!WindowAnnouncement methodsFor: 'testing' stamp: 'Alexandre Bergel 1/12/2010 11:13'!
isCollapsed
	^ false! !

!WindowAnnouncement methodsFor: 'testing' stamp: 'Alexandre Bergel 1/12/2010 11:14'!
isExpanded
	^ false! !

!WindowAnnouncementTest methodsFor: 'tests - window change' stamp: 'StephaneDucasse 8/22/2013 23:33'!
testMoving
	| t oldBounds  event |
	window := SystemWindow labelled: 'foo'.
	t := 0.
	event := nil.

	window openInWorld.
	oldBounds := window bounds.
	window announcer when: WindowMoved do: [:ann | t := t + 1. event := ann].

	self assert: (t = 0).
	self assert: (event isNil).
	
	"We move the window"
	window position: 50@50.
	self assert: (t = 1).
	self assert: (event oldPosition = oldBounds origin).
	self assert: (event newPosition = (50@50 )).

	"We call position: without moving it actually, nothing should happen"
	window position: 50@50.
	self assert: (t = 1).

	"If we simply resize the window, nothing should happen as well"
	window extent: 50@60.
	self assert: (t = 1).

! !

!WindowAnnouncementTest methodsFor: 'tests - window creation and deletion' stamp: 'StephaneDucasse 8/22/2013 23:34'!
testWindowCreationAndDeletion
	
	| t newWindowCreated |
	t := 0.
	World announcer when: WindowOpened do: [:ann | t := t + 1. newWindowCreated := ann window].
	World announcer when: WindowClosed do: [:ann | t := t + 10. newWindowCreated := ann window].
	window := SystemWindow labelled: 'foo'.
	window openInWorld.

	self assert: (t = 1).
	self assert: (window == newWindowCreated).
	window delete.

	self assert: (t = 11).
	self assert: (window == newWindowCreated).
! !

!WindowAnnouncementTest methodsFor: 'tests - window creation and deletion' stamp: 'StephaneDucasse 8/22/2013 23:34'!
testWindowLabelling
	"Test change of label for a window."
	
	| labels win |
	labels := #().
	World announcer when: WindowLabelled do: [:ann | win := ann window. labels := labels copyWith: ann label].
	window := SystemWindow labelled: 'foo'.
	window openInWorld.
	self assert: win = window.
	self assert: labels = #('foo').
	window setLabel: 'bar'.
	self assert: win = window.
	self assert: labels = #('foo' 'bar')! !

!WindowAnnouncementTest methodsFor: 'running' stamp: 'Alexandre Bergel 1/12/2010 11:16'!
tearDown 
	super tearDown.
	window ifNotNil: [ window delete ]! !

!WindowAnnouncementTest methodsFor: 'tests - window creation and deletion' stamp: 'StephaneDucasse 8/22/2013 23:34'!
testWindowCreation
	| t oldBounds newBounds |
	t := 0.
	World announcer when: WindowResizing do: [:ann | t := t + 1].
	window := SystemWindow labelled: 'foo'.
	window openInWorld.
	oldBounds := window bounds.
	window announcer when: WindowResizing do: [:ann | t := t + 1].
	self assert: (t = 0).
	window extent: 50@60.
	newBounds := window bounds.
	self assert: (t = 1).
! !

!WindowAnnouncementTest methodsFor: 'tests - window change' stamp: 'StephaneDucasse 8/22/2013 23:33'!
testResizing
	| t oldBounds newBounds |
	window := SystemWindow labelled: 'foo'.
	t := 0.
	window openInWorld.
	oldBounds := window bounds.
	window announcer when: WindowResizing do: [:ann | t := t + 1].
	self assert: (t = 0).
	window extent: 50@60.
	newBounds := window bounds.
	self assert: (t = 1).
! !

!WindowAnnouncementTest methodsFor: 'tests - window change' stamp: 'StephaneDucasse 8/22/2013 23:33'!
testCollapsing
	| t |
	window := SystemWindow labelled: 'foo'.
	t := 0.
	window openInWorld.
	window announcer when: WindowCollapsed do: [:ann | t := t + 1].
	self assert: (t = 0).
	window collapse.
	self assert: (t = 1).
! !

!WindowAnnouncementTest methodsFor: 'tests - window creation and deletion' stamp: 'StephaneDucasse 8/22/2013 23:33'!
testResizingClosing
	| coll |

	window := SystemWindow labelled: 'foo'.
	coll := OrderedCollection new.
	window openInWorld.
	window announcer when: WindowAnnouncement do: [:ann | coll add: ann].
	self assert: (coll isEmpty).
	window minimizeOrRestore.
	
	"Resizing, moving, collapsing "
	self assert: (coll size = 3).
	self assert: (coll first isResized).
	self assert: (coll second isMoved).
	self assert: (coll third isCollapsed).
	window delete.

	self assert: (coll size = 4).
	self assert: (coll fourth isClosed).
	window := nil! !

!WindowAnnouncementTest methodsFor: 'tests - window change' stamp: 'StephaneDucasse 8/22/2013 23:33'!
testScrolling
	"This test tests the scrolling values of a scrollpane. We create a reeeeeally big (enormous) morph, to be sure its size is bigger than the screen and therefore its enclosing window has scrollbars.
	When screen sizes become bigger, you should increase the value, or fix morphic, what happens first :).
	"
	| myMorph pane t |
	window := SystemWindow labelled: 'foo'.
	myMorph := Morph new.
	myMorph extent: 10000000000@1000000000.
	pane := ScrollPane new.
	pane scroller addMorph: myMorph.
	window
		addMorph: pane
		fullFrame: LayoutFrame identity.
	t := 0 @ 0.
	window openInWorld.
	window announcer when: WindowScrolling do: [:ann | t := t + ann step ].
	pane hScrollBarValue: 10.
	pane vScrollBarValue: 5.

	window delete.
	
	self assert: (t = (10 @ 5)).
	window := nil! !

!WindowClosed methodsFor: 'testing' stamp: 'Alexandre Bergel 1/12/2010 11:13'!
isClosed
	^ true! !

!WindowCollapsed commentStamp: 'Alexandre.Bergel 8/8/2009 13:20'!
This announcement is emitted when a window is collapsed, by pressing the '-' top left button of a window.!
!WindowCollapsed methodsFor: 'as yet unclassified' stamp: 'Alexandre Bergel 1/12/2010 11:13'!
isCollapsed
	^ true! !

!WindowEdgeGripMorph commentStamp: 'gvc 9/23/2008 11:47'!
Window edge gripper allowing resizing of a window by a particular side.!
!WindowEdgeGripMorph methodsFor: 'style' stamp: 'gvc 10/1/2007 14:17'!
pressedFillStyle
	"Return the pressed fillStyle of the receiver."
	
	^self theme windowEdgePressedFillStyleFor: self! !

!WindowEdgeGripMorph methodsFor: 'event handling' stamp: 'MarcusDenker 12/11/2009 07:43'!
mouseDown: anEvent
	"Activate the window if not currently so."
	
	(self bounds containsPoint: anEvent cursorPoint)
		ifTrue: [self window ifNotNil: [:w | w activate]].
	^super mouseDown: anEvent! !

!WindowEdgeGripMorph methodsFor: 'style' stamp: 'gvc 10/1/2007 14:17'!
normalFillStyle
	"Return the normal fillStyle of the receiver."
	
	^self theme windowEdgeNormalFillStyleFor: self! !

!WindowEdgeGripMorph methodsFor: 'event handling' stamp: 'AlainPlantec 2/22/2012 22:26'!
mouseMove: anEvent
	"Track the mouse for resizing."
	
	target ifNil: [^self].
	self theme settings fastDragging
		ifTrue: [target doFastWindowReframe: self edgeName] 
		ifFalse: [super mouseMove: anEvent]! !

!WindowEvent commentStamp: 'StephaneDucasse 11/29/2011 22:29'!
I'm an event related to the host window, only dispatched to the World. !
!WindowEvent methodsFor: 'accessing' stamp: 'JMM 10/6/2004 21:12'!
rectangle
	^rectangle! !

!WindowEvent methodsFor: 'printing' stamp: 'tbn 3/12/2010 01:45'!
printOn: aStream

	aStream nextPut: $[.
	aStream nextPutAll: self type; space.
	aStream nextPut: $(; print: self rectangle; nextPut: $).
	aStream nextPut: $].! !

!WindowEvent methodsFor: 'accessing' stamp: 'JMM 10/6/2004 21:11'!
action
	^action! !

!WindowEvent methodsFor: 'accessing' stamp: 'JMM 10/6/2004 21:12'!
rectangle: aValue
	rectangle := aValue.! !

!WindowEvent methodsFor: 'dispatching' stamp: 'tbn 3/12/2010 01:45'!
sentTo:anObject
	"Dispatch the receiver into anObject"
	^anObject handleWindowEvent: self.! !

!WindowEvent methodsFor: 'accessing' stamp: 'tbn 3/12/2010 01:43'!
type
	"This should match the definitions in sq.h"
	^#(
		windowMetricChange
		windowClose
		windowIconise
		windowActivated
		windowPaint
	) at: action ifAbsent: [#windowEventUnknown]! !

!WindowEvent methodsFor: 'accessing' stamp: 'JMM 10/6/2004 21:10'!
action: aValue
	action := aValue.! !

!WindowEvent methodsFor: 'testing' stamp: 'JMM 10/6/2004 21:35'!
isWindowEvent
	^true! !

!WindowExpanded commentStamp: 'Alexandre.Bergel 8/8/2009 13:20'!
This announcement is emitted when a window leaves a collapsed mode. This happens when you press on a window icon in the taskbar.!
!WindowExpanded methodsFor: 'as yet unclassified' stamp: 'Alexandre Bergel 1/12/2010 11:14'!
isExpanded
	^ true! !

!WindowLabelled methodsFor: 'accessing' stamp: 'GaryChambers 6/10/2011 13:06'!
label

	^ label! !

!WindowLabelled methodsFor: 'accessing' stamp: 'GaryChambers 6/10/2011 13:06'!
label: anObject

	label := anObject! !

!WindowLabelled methodsFor: 'testing' stamp: 'GaryChambers 6/10/2011 13:06'!
isLabelled

	^true! !

!WindowModel commentStamp: '<historical>'!
A WindowModel is a spec model for a Window!
!WindowModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 1/15/2014 17:16:50.270855'!
isResizeable: aBoolean

	isResizeable value: aBoolean! !

!WindowModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 9/25/2013 16:27'!
askOkToClose

	^ self model askOkToClose! !

!WindowModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 9/25/2013 16:27'!
close

	self changed: #close with: #()! !

!WindowModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/27/2013 15:05'!
triggerCancelAction
	"do nothing (ensure polymorphism with DialogWindow)"! !

!WindowModel methodsFor: 'updating' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
windowIsClosing

	isClosedHolder value: true! !

!WindowModel methodsFor: 'api-events' stamp: 'BenjaminVanRyseghem 9/29/2013 12:29'!
whenClosedDo: aBlock

	isClosedHolder whenChangedDo: [:value |
		value ifTrue: [ aBlock value ] ]! !

!WindowModel methodsFor: 'api' stamp: 'johanfabry 3/11/2015 13:17'!
aboutText
	"if my aboutText has not been set the fallback is:
	  - if I do have a model, use its' about text
	  - else use the behavior defined in super
	"

	^aboutText value
		ifNil: [self model
			ifNil: [ super aboutText ]
			ifNotNil: [:m | m aboutText ]]
		ifNotNil: [ aboutText value ]! !

!WindowModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/25/2013 16:27'!
rebuildWithSpecLayout: aSpec

	self changed: #rebuildWithSpecLayout: with: { aSpec }! !

!WindowModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/25/2013 16:27'!
defaultInitialExtent
	
	^ 400@300! !

!WindowModel methodsFor: 'initialization' stamp: 'DucasseStephane 9/10/2014 09:59'!
initialize

	super initialize.

	model := nil asValueHolder.
	initialExtent := nil asValueHolder.
	title := self class title asValueHolder.
	isClosedHolder := false asValueHolder.
	isResizeable := true asValueHolder.
	
	model whenChangedDo: [:m | self updateTitle ].! !

!WindowModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 9/25/2013 17:14'!
isDisplayed

	^ self window notNil! !

!WindowModel methodsFor: 'menu' stamp: 'NicolaiHess 2/15/2015 22:21'!
addModelItemsToWindowMenu: aMenu

	self model addModelItemsToWindowMenu: aMenu! !

!WindowModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/25/2013 16:27'!
title

	^ self model
		ifNil: [ super title ]
		ifNotNil: [:m | m title ]! !

!WindowModel methodsFor: 'focus' stamp: 'BenjaminVanRyseghem 9/25/2013 16:27'!
giveFocusToPreviousFrom: aModel 

	^ self model giveFocusToPreviousFrom: aModel ! !

!WindowModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
openWithSpecLayout: aSpec

	window value: (self buildWithSpecLayout: aSpec).
	self changed: #open with: #().
	self updateTitle.! !

!WindowModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/25/2013 16:27'!
title: aString

	self changed: #title: with: { aString }! !

!WindowModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/25/2013 16:27'!
updateTitle
	"Update the window title"

	self title: self title! !

!WindowModel methodsFor: 'menu' stamp: 'BenjaminVanRyseghem 10/19/2013 15:17'!
addMenuItemsToWindowMenu: aMenu

	self model addMenuItemsToWindowMenu: aMenu! !

!WindowModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 1/12/2014 17:05'!
initialExtent

	^ initialExtent value
		ifNil: [ self model 
			ifNil: [ self defaultInitialExtent ]
			ifNotNil: [:m | m extent
				ifNil: [ m initialExtent
					ifNil: [ self defaultInitialExtent ] ] ] ]! !

!WindowModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 2/18/2014 23:52:52.039866'!
minimize

	self changed: #minimize with: #()! !

!WindowModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 9/25/2013 16:27'!
triggerOkAction
	"do nothing (ensure polymorphism with DialogWindow)"! !

!WindowModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
taskbarIcon

	^ model value 
		ifNil: [ super taskbarIcon ]
		ifNotNil: [ :m |
			m windowIcon
				ifNil: [ m taskbarIcon ] ]! !

!WindowModel methodsFor: 'private' stamp: 'StephaneDucasse 2/27/2015 21:31'!
buildWithSpecLayout: aSpec
	"Build the widget using the spec name provided as argument"
	| adapter widget |
	
	(self spec notNil and: [ self needRebuild not ])
		ifTrue: [ widget := self spec instance ]
		ifFalse: [
			adapter := self privateAdapterFromModel: self withSpec: self defaultSpecSelector.
			widget := adapter widget.
			self addModelIn: widget withSpecLayout: aSpec ].

	self ensureExtentFor: widget.
	
	^ widget! !

!WindowModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/28/2013 17:10'!
centered

	self changed: #centered with: #()! !

!WindowModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 2/18/2014 23:52:52.039866'!
maximize

	self changed: #maximize with: #()! !

!WindowModel methodsFor: '*GT-InspectorExtensions-Core' stamp: 'TudorGirba 4/2/2013 16:31'!
gtInspectorModelNestingIn: composite
	self model gtInspectorModelNestingIn: composite! !

!WindowModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/25/2013 16:27'!
rebuildWithSpec: aSpec

	self changed: #rebuildWithSpec: with: { aSpec }.! !

!WindowModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 1/16/2014 09:26'!
isResizeable

	^ isResizeable value! !

!WindowModel methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
model
	
	^ model value! !

!WindowModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/28/2013 17:12'!
centeredRelativeTo: aModel

	self changed: #centeredRelativeTo: with: { aModel }! !

!WindowModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 11/26/2013 22:08'!
cancelled

	^ false! !

!WindowModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/25/2013 16:27'!
okToChange

	^ self model okToChange! !

!WindowModel methodsFor: 'focus' stamp: 'BenjaminVanRyseghem 9/25/2013 16:27'!
giveFocusToNextFrom: aModel 

	^ self model giveFocusToNextFrom: aModel! !

!WindowModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/25/2013 16:27'!
addModelIn: widget withSpec: aSpec

	self model ifNil: [ ^ self ].
	
	self changed: #addModelIn:withSpec: with: { widget . aSpec }! !

!WindowModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 9/25/2013 16:27'!
addModelIn: widget withSpecLayout: aSpec

	self model ifNil: [ ^ self ].
	
	self changed: #addModelIn:withSpecLayout: with: { widget . aSpec }! !

!WindowModel methodsFor: 'testing' stamp: 'BenjaminVanRyseghem 10/17/2013 16:05'!
isClosed
	^ isClosedHolder value! !

!WindowModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 10/17/2013 16:06'!
model: aModel

	model value: aModel! !

!WindowModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 9/25/2013 16:27'!
openModal: aWindow 

	self changed: #openModal: with: { aWindow }! !

!WindowModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 12/1/2013 01:07'!
modalRelativeTo: aWindow

	self changed: #modalRelativeTo: with: { aWindow }! !

!WindowModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 10/1/2013 13:39'!
defaultSpec
	<spec>
	
	^ #(WindowAdapter
		adapt: #(model))! !

!WindowModel class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 1/13/2014 15:30'!
adapterName

	^ #WindowAdapter! !

!WindowMoved methodsFor: 'accessing' stamp: 'Alexandre.Bergel 5/11/2009 16:46'!
oldPosition
	^ oldPosition! !

!WindowMoved methodsFor: 'testing' stamp: 'Alexandre Bergel 1/12/2010 11:14'!
isMoved
	^ true! !

!WindowMoved methodsFor: 'accessing' stamp: 'Alexandre.Bergel 5/11/2009 16:46'!
oldPosition: anObject
	oldPosition := anObject! !

!WindowMoved methodsFor: 'accessing' stamp: 'Alexandre.Bergel 5/11/2009 16:45'!
newPosition: anObject
	newPosition := anObject! !

!WindowMoved methodsFor: 'accessing' stamp: 'Alexandre.Bergel 5/11/2009 16:45'!
newPosition
	^ newPosition! !

!WindowResizing methodsFor: 'accessing' stamp: 'Alexandre.Bergel 5/11/2009 16:47'!
oldSize: anObject
	oldSize := anObject! !

!WindowResizing methodsFor: 'accessing' stamp: 'Alexandre.Bergel 5/11/2009 16:46'!
newSize
	^ newSize! !

!WindowResizing methodsFor: 'accessing' stamp: 'Alexandre.Bergel 5/11/2009 16:47'!
oldSize
	^ oldSize! !

!WindowResizing methodsFor: 'testing' stamp: 'Alexandre Bergel 1/12/2010 11:15'!
isResized
	^ true! !

!WindowResizing methodsFor: 'accessing' stamp: 'Alexandre.Bergel 5/11/2009 16:46'!
newSize: anObject
	newSize := anObject! !

!WindowScrolling methodsFor: 'accessing' stamp: 'ab 5/12/2009 14:39'!
step
	^ step! !

!WindowScrolling methodsFor: 'testing' stamp: 'Alexandre Bergel 1/12/2010 11:15'!
isScrolled
	^ true! !

!WindowScrolling methodsFor: 'accessing' stamp: 'ab 5/12/2009 14:39'!
step: anObject
	step := anObject! !

!WindowsResolver commentStamp: 'cwp 11/18/2009 11:57'!
I am an expert on Windows filesystem conventions. I resolve origins according to these conventions.!
!WindowsResolver methodsFor: 'origins' stamp: 'DamienCassou 7/4/2013 16:21'!
preferences
	^ self directoryFromEnvVariableNamed: 'APPDATA' or: [ self home ]! !

!WindowsResolver methodsFor: 'origins' stamp: 'DamienCassou 7/4/2013 16:49'!
documents
	^ self home / 'Documents'! !

!WindowsResolver methodsFor: 'origins' stamp: 'DamienCassou 7/4/2013 16:21'!
home
	"Value of the $USERPROFILE environment variable."

	^ self directoryFromEnvVariableNamed: 'USERPROFILE'! !

!WindowsResolver methodsFor: 'origins' stamp: 'DamienCassou 6/28/2013 16:33'!
cache
	"Because Windows does not define any location for putting cache files, we chose to use the preference directory. http://libertyboy.free.fr/computing/reference/envariables/"
	^ self preferences! !

!WindowsResolver methodsFor: 'origins' stamp: 'cwp 10/27/2009 21:45'!
desktop
	^ self home / 'Desktop'! !

!WindowsResolver methodsFor: 'origins' stamp: 'DamienCassou 12/20/2013 11:56'!
temp
	^ self directoryFromEnvVariableNamed: 'TEMP' or: [ FileLocator C / 'windows' / 'temp' ]! !

!WindowsResolver class methodsFor: 'accessing' stamp: 'cwp 10/27/2009 10:59'!
platformName
	^ 'Win32'! !

!WindowsStore commentStamp: '<historical>'!
I'm a specific store for Windows file systems!
!WindowsStore methodsFor: 'public' stamp: 'CamilloBruni 5/10/2012 16:07'!
checkName: aFileName fixErrors: fixing
	"Check if the file name contains any invalid characters"
	
	| fName badChars hasBadChars |
	fName := super checkName: aFileName fixErrors: fixing.
	badChars := (#( $: $< $> $| $/ $\ $? $* $"), ((0 to: 31) collect: [:n | n asCharacter])) asSet.
	
	(fName includesAnyOf: badChars)
		ifFalse: [^ fName].
	
	fixing ifFalse: [^self error: 'filename contains invalid characters'].
	
	^ fName collect:
		[:char | (badChars includes: char) 
				ifTrue: [$#] 
				ifFalse: [char]]! !

!WindowsStore methodsFor: 'converting' stamp: 'VincentBlondeau 2/1/2015 13:48'!
printPath: aPath on: aStream
	| hasDrive |
	aPath isRoot
		ifTrue: [ ^ self ].	"effectively Windows root is empty string"
	aPath isWorkingDirectory
		ifTrue: [ ^ aPath printOn: aStream delimiter: self delimiter ].
	aPath segments first first = $:
		ifTrue: [ ^ aStream nextPut: self delimiter ].	"as tagged in #pathFromString:  "
	hasDrive := aPath segments first second = $:.
	(aPath isAbsolute and: [ hasDrive not ])
		ifTrue: [ aStream nextPut: self delimiter ].
	aPath printOn: aStream delimiter: self delimiter.
	((aPath isAbsolute and: [ hasDrive ]) and: [ aPath segments size = 1 ])
		ifTrue: [ aStream nextPut: self delimiter ]! !

!WindowsStore methodsFor: 'converting' stamp: 'BenComan 3/13/2014 15:46'!
stripDrive: pathElements
	pathElements ifNotEmpty: [ pathElements at: 1 put: ( ($: split: pathElements first) last)  ]! !

!WindowsStore methodsFor: 'converting' stamp: 'BenComan 3/13/2014 18:05'!
pathFromString: aString
	"Need to distinguish '' and '/' , so tag latter with invalid character ':'  "
	| normalized pathClass pathElements |
	normalized := aString copy replaceAll: UnixStore delimiter with: self delimiter.
	pathElements := self delimiter split: normalized.
	pathClass := (Path isAbsoluteWindowsPath: normalized)
		ifTrue: [ (normalized = self delimiter asString) ifTrue: [ pathElements := { ':' } ].
			AbsolutePath ]
		ifFalse: [ self stripDrive: pathElements.
			RelativePath ].
	^pathClass withAll: (pathClass canonicalizeElements: pathElements).! !

!WindowsStore methodsFor: 'converting' stamp: 'BenComan 3/12/2014 01:29'!
currentDisk
	^ disk ifNil: [  disk := FileSystem workingDirectory path segments first ]! !

!WindowsStore class methodsFor: 'accessing' stamp: 'CamilloBruni 5/10/2012 16:05'!
maxFileNameLength
	self flag: 'TODO: more tests needed here!!'.
	^ 255! !

!WindowsStore class methodsFor: 'accessing' stamp: 'CamilloBruni 5/7/2012 01:11'!
separator 
	^ $\! !

!WindowsStore class methodsFor: 'accessing' stamp: 'cwp 2/18/2011 17:19'!
delimiter
	^ $\! !

!WindowsStore class methodsFor: 'accessing' stamp: 'CamilloBruni 5/7/2012 01:20'!
isCaseSensitive
	^ false! !

!WindowsStoreTest commentStamp: 'TorstenBergmann 1/31/2014 11:48'!
SUnit tests for class WindowsStore!
!WindowsStoreTest methodsFor: 'testing' stamp: 'BenComan 3/18/2014 21:23'!
testRelativeFullName

	"FIleSystem currently does not support MS Windows concept of each drive having its own working directory.
	That is too great a change during Pharo 3 Beta, so for now just drop drive from relative references. 
	Follow up in Case 13094"	

	| filesystem |
	filesystem := FileSystem store: WindowsStore new.
		
	self assert: (filesystem referenceTo: 'C:tmp') fullName equals: (filesystem referenceTo: 'tmp') fullName! !

!WindowsStoreTest methodsFor: 'testing' stamp: 'BenComan 3/12/2014 01:00'!
testRelativePath

	#('a' 'bin\foo' 'temp\test' 'C:temp\test') do: [:each |
		self assert: (WindowsStore current pathFromString: each) isRelative ] 
	! !

!WindowsStoreTest methodsFor: 'testing' stamp: 'BenComan 3/13/2014 15:43'!
testAbsolutePath

	#('c:\' 'C:\temp' 'A:\temp\test' '\test\bar' '\') do: [:each |
		self assert: (WindowsStore current pathFromString: each) isAbsolute ] 
	! !

!WindowsStoreTest methodsFor: 'testing' stamp: 'BenComan 3/18/2014 21:10'!
testAbsoluteFullName
	| filesystem |
	filesystem := FileSystem store: WindowsStore new.

	"Check dropping trailing slash."	
	self assert: (filesystem referenceTo: 'C:\tmp\') fullName equals: 'C:\tmp'.

	"Check round-trip conversion from String to FileReference back to String again."
	#( 	'C:\'		'D:\'		'\'		'C:\tmp'		'D:\tmp'		'C:\tmp\xx'      ) 
		do: [ :pathString | self assert: (filesystem referenceTo: pathString) fullName equals: pathString ].
	
	
! !

!WordArray commentStamp: '<historical>'!
WordArrays store 32-bit unsigned Integer values.
!
!WordArray methodsFor: 'array arithmetic primitives' stamp: 'yo 10/25/2004 15:49'!
primDivScalar: rcvr and: other into: result

	<primitive: 'primitiveDivScalar' module:'KedamaPlugin'>
	"^ KedamaPlugin doPrimitive: #primitiveDivScalar."

	1 to: rcvr size do: [:i |
		result at: i put: (rcvr at: i) / other.
	].
	^ result.
! !

!WordArray methodsFor: 'converting' stamp: 'ar 9/14/1998 23:46'!
asWordArray
	^self! !

!WordArray methodsFor: 'accessing' stamp: 'ar 3/3/2001 16:18'!
byteSize
	^self size * 4! !

!WordArray methodsFor: 'array arithmetic primitives' stamp: 'yo 10/25/2004 15:49'!
primMulScalar: rcvr and: other into: result

	<primitive: 'primitiveMulScalar' module:'KedamaPlugin'>
	"^ KedamaPlugin doPrimitive: #primitiveMulScalar."

	1 to: rcvr size do: [:i |
		result at: i put: (rcvr at: i) * other.
	].
	^ result.
! !

!WordArray methodsFor: 'array arithmetic primitives' stamp: 'yo 10/25/2004 15:10'!
primAddScalar: rcvr and: other into: result

	<primitive: 'primitiveAddScalar' module:'KedamaPlugin'>
	"^ KedamaPlugin doPrimitive: #primitiveAddScalar."

	1 to: rcvr size do: [:i |
		result at: i put: (rcvr at: i) + other.
	].
	^ result.
! !

!WordArray methodsFor: 'array arithmetic primitives' stamp: 'yo 10/25/2004 15:49'!
primSubScalar: rcvr and: other into: result

	<primitive: 'primitiveSubScalar' module:'KedamaPlugin'>
	"^ KedamaPlugin doPrimitive: #primitiveSubScalar."

	1 to: rcvr size do: [:i |
		result at: i put: (rcvr at: i) - other.
	].
	^ result.
! !

!WordArray methodsFor: '*Collections-arithmetic' stamp: 'GuillermoPolito 2/18/2011 07:51'!
+ other

	| result |
	other isNumber ifTrue: [
		other isFloat ifTrue: [
			result := FloatArray new: self size.
			^ self primAddScalar: self and: other into: result.
		] ifFalse: [
			result := WordArray new: self size.
			^ self primAddScalar: self and: other into: result.
		].
	].
	(other isMemberOf: WordArray) ifTrue: [	
		result := WordArray new: self size.
		^ self primAddArray: self and: other into: result.
	].
	(other isMemberOf: FloatArray) ifTrue: [	
		result := FloatArray new: self size.
		^ self primAddArray: self and: other into: result.
	].
	^ super + other.
! !

!WordArray methodsFor: 'array arithmetic primitives' stamp: 'yo 10/25/2004 15:51'!
primMulArray: rcvr and: other into: result

	<primitive: 'primitiveMulArrays' module:'KedamaPlugin'>
	"^ KedamaPlugin doPrimitive: #primitiveMulArrays."

	1 to: rcvr size do: [:i |
		result at: i put: (rcvr at: i) * (other at: i)
	].
	^ result.
! !

!WordArray methodsFor: 'array arithmetic primitives' stamp: 'yo 10/25/2004 15:51'!
primDivArray: rcvr and: other into: result

	<primitive: 'primitiveDivArrays' module:'KedamaPlugin'>
	"^ KedamaPlugin doPrimitive: #primitiveDivArrays."

	1 to: rcvr size do: [:i |
		result at: i put: (rcvr at: i) / (other at: i)
	].
	^ result.
! !

!WordArray methodsFor: '*Collections-arithmetic' stamp: 'GuillermoPolito 2/18/2011 07:52'!
- other

	| result |
	other isNumber ifTrue: [
		other isFloat ifTrue: [
			result := FloatArray new: self size.
			^ self primSubScalar: self and: other into: result.
		] ifFalse: [
			result := WordArray new: self size.
			^ self primSubScalar: self and: other into: result.
		].
	].
	(other isMemberOf: WordArray) ifTrue: [	
		result := WordArray new: self size.
		^ self primSubArray: self and: other into: result.
	].
	(other isMemberOf: FloatArray) ifTrue: [	
		result := FloatArray new: self size.
		^ self primSubArray: self and: other into: result.
	].
	^ super - other.
! !

!WordArray methodsFor: 'accessing' stamp: 'ar 11/2/1998 12:19'!
defaultElement
	"Return the default element of the receiver"
	^0! !

!WordArray methodsFor: 'array arithmetic primitives' stamp: 'yo 10/25/2004 15:50'!
primAddArray: rcvr and: other into: result

	<primitive: 'primitiveAddArrays' module:'KedamaPlugin'>
	"^ KedamaPlugin doPrimitive: #primitiveAddArrays."

	1 to: rcvr size do: [:i |
		result at: i put: (rcvr at: i) + (other at: i)
	].
	^ result.
! !

!WordArray methodsFor: 'private' stamp: 'ar 2/15/1999 00:51'!
replaceFrom: start to: stop with: replacement startingAt: repStart 
	<primitive: 105>
	^super replaceFrom: start to: stop with: replacement startingAt: repStart ! !

!WordArray methodsFor: 'accessing' stamp: 'sma 4/22/2000 17:47'!
atAllPut: value
	"Fill the receiver with the given value"

	<primitive: 145>
	super atAllPut: value! !

!WordArray methodsFor: 'array arithmetic primitives' stamp: 'yo 10/25/2004 15:50'!
primSubArray: rcvr and: other into: result

	<primitive: 'primitiveSubArrays' module:'KedamaPlugin'>
	"^ KedamaPlugin doPrimitive: #primitiveSubArrays."

	1 to: rcvr size do: [:i |
		result at: i put: (rcvr at: i) - (other at: i)
	].
	^ result.
! !

!WordArray methodsFor: '*Collections-arithmetic' stamp: 'GuillermoPolito 2/18/2011 07:52'!
/ other

	| result |
	other isNumber ifTrue: [
		other isFloat ifTrue: [
			result := FloatArray new: self size.
			^ self primDivScalar: self and: other into: result.
		] ifFalse: [
			result := WordArray new: self size.
			^ self primDivScalar: self and: other into: result.
		].
	].
	(other isMemberOf: WordArray) ifTrue: [	
		result := WordArray new: self size.
		^ self primDivArray: self and: other into: result.
	].
	(other isMemberOf: FloatArray) ifTrue: [	
		result := FloatArray new: self size.
		^ self primDivArray: self and: other into: result.
	].
	^ super / other.
! !

!WordArray methodsFor: '*Collections-arithmetic' stamp: 'GuillermoPolito 2/18/2011 07:52'!
* other

	| result |
	other isNumber ifTrue: [
		other isFloat ifTrue: [
			result := FloatArray new: self size.
			^ self primMulScalar: self and: other into: result.
		] ifFalse: [
			result := WordArray new: self size.
			^ self primMulScalar: self and: other into: result.
		].
	].
	(other isMemberOf: WordArray) ifTrue: [	
		result := WordArray new: self size.
		^ self primMulArray: self and: other into: result.
	].
	(other isMemberOf: FloatArray) ifTrue: [	
		result := FloatArray new: self size.
		^ self primMulArray: self and: other into: result.
	].
	^ super * other.
! !

!WordLayout commentStamp: '<historical>'!
I am a raw data layout that holds words (32 / 64 bit depending on the platform).!
!WordLayout methodsFor: 'extending' stamp: 'MartinDias 7/24/2013 13:21'!
extendByte
	IncompatibleLayoutConflict new
		layout: self;
		subType: #byte;
		signal! !

!WordLayout methodsFor: 'format' stamp: 'ToonVerwaest 4/1/2011 01:27'!
instanceSpecification
	^ 6! !

!WordLayout methodsFor: 'testing' stamp: 'MartinDias 1/31/2014 16:19'!
isBytes
	^ false! !

!WordLayout class methodsFor: 'instance creation' stamp: 'MartinDias 8/7/2013 17:46'!
extending: superLayout scope: aScope host: aClass
	^ superLayout extendWord
		host: aClass;
		yourself! !

!WorkingCopyToolBar commentStamp: '<historical>'!
WorkingCopyToolBar new openWithSpec!
!WorkingCopyToolBar methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 6/12/2012 18:44'!
setSliceButton
	sliceButton := self instantiate: ButtonModel.
	sliceButton
		state: false;
		label: '+Slice';
		help: 'Add a slice to cleaning and nicely propose a bug fix';
		action: [ self createSlice ]! !

!WorkingCopyToolBar methodsFor: 'initialization' stamp: 'MarcusDenker 11/3/2014 15:36'!
createPackage
	| name |
	name := UIManager default request: 'Name of package:' translated.
	name isEmptyOrNil
		ifTrue: [ ^ self ].
	RPackageOrganizer default registerPackageNamed: name.
	MCWorkingCopy forPackage: (MCPackage new name: name)! !

!WorkingCopyToolBar methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 6/12/2012 18:44'!
setBrowseButton

	browseButton
		state: false;
		enabled: false;
		label: 'Browse';
		help: 'Browse the working copy of the selected package';
		action: [ self browseWorkingCopy ]! !

!WorkingCopyToolBar methodsFor: 'accessing' stamp: 'StephaneDucasse 4/19/2012 17:34'!
configButton
	
	^ configButton! !

!WorkingCopyToolBar methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 6/12/2012 18:44'!
setPackageButton

	packageButton
		state: false;
		label: '+Package';
		help: 'Add a new package and make it the working copy';
		action: [ self createPackage ]! !

!WorkingCopyToolBar methodsFor: 'accessing' stamp: 'StephaneDucasse 4/19/2012 17:34'!
sliceButton
	
	^ sliceButton! !

!WorkingCopyToolBar methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 6/12/2012 18:44'!
setConfigButton

	configButton
		state: false;
		label: '+Config';
		help: 'Add a new metacello configuration';
		action: [ self createConfiguration ]! !

!WorkingCopyToolBar methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 6/12/2012 18:44'!
initializeWidgets

	self instantiateModels: #(
		browseButton  ButtonModel
		configButton  ButtonModel
		packageButton ButtonModel ).
		
	self setBrowseButton.
	self setConfigButton.
	self setPackageButton.
	self setSliceButton.! !

!WorkingCopyToolBar methodsFor: 'accessing' stamp: 'StephaneDucasse 4/19/2012 17:33'!
browseButton
	^ browseButton! !

!WorkingCopyToolBar methodsFor: 'accessing' stamp: 'StephaneDucasse 4/19/2012 17:32'!
packageButton

	^ packageButton! !

!WorkingCopyToolBar class methodsFor: 'specs' stamp: 'BenjaminVanRyseghem 9/27/2013 10:48'!
defaultSpec 

	^ {#ContainerModel.
			#add: . {{#model . #packageButton.} . #layout: .  #(FrameLayout
										rightFraction: 0.25
										bottomFraction: 0
										bottomOffset: 25)} . 

			#add: . {{#model . #configButton.} .
						#layout: . #(FrameLayout
										leftFraction: 0.25
										rightFraction: 0.5
										bottomFraction: 0
										bottomOffset: 25) } .
											
			#add: . {{#model . #sliceButton.} .
						#layout: . #(FrameLayout
										leftFraction: 0.5
										rightFraction: 0.75
										bottomFraction: 0
										bottomOffset: 25) } .											

			#add: . {{#model . #browseButton.} .
						#layout: . #(FrameLayout
										leftFraction: 0.75
										bottomFraction: 0
										bottomOffset: 25)} 	
		}! !

!Workspace commentStamp: 'ls 10/14/2003 12:13'!
A Workspace is a text area plus a lot of support for executable code.  It is a great place to execute top-level commands to compute something useful, and it is a great place to develop bits of a program before those bits get put into class methods.

To open a new workspace, execute:

	Workspace open


A workspace can have its own variables, called "workspace variables", to hold intermediate results.  For example, if you type into a workspace "x := 5" and do-it, then later you could type in "y := x * 2" and y would become 10.

Additionally, in Morphic, a workspace can gain access to morphs that are on the screen.  If acceptDroppedMorphss is turned on, then whenever a morph is dropped on the workspace, a variable will be created which references that morph.  This functionality is toggled with the window-wide menu of a workspace.


The instance variables of this class are:

	bindings  -  holds the workspace variables for this workspace

	acceptDroppedMorphss - whether dropped morphs should create new variables!
!Workspace methodsFor: 'drag and drop' stamp: 'sd 11/20/2005 21:27'!
acceptDroppingMorph: dropee event: evt inMorph: targetMorph 
	"Return the dropee to its old position, and add a reference to it at the cursor point."

	| bindingName externalName |
	externalName := dropee externalName.
	externalName := externalName isOctetString
		ifTrue: [externalName] ifFalse: ['a' , externalName].
	bindingName := externalName translateToLowercase, dropee identityHash printString.
	targetMorph correctSelectionWithString: bindingName, ' '.
	(self bindingOf: bindingName) value: dropee.
	dropee rejectDropMorphEvent: evt.
	^ true "success"
! !

!Workspace methodsFor: 'variable declarations' stamp: 'sd 3/20/2004 14:39'!
toggleVariableDeclarationMode

	mustDeclareVariables := mustDeclareVariables not! !

!Workspace methodsFor: 'history' stamp: 'AlexandreBergel 1/16/2009 10:35'!
trimHistoryIfNecessary
	(self lastContents size > self historyLength)
		ifTrue: [ LastContents := LastContents copyFrom: 1 to: self historyLength ]! !

!Workspace methodsFor: 'file support' stamp: 'MarcusDenker 12/2/2013 14:14'!
suggestedFileName
	"If the workspace has an associated fileName use that, otherwise derive a reasonable file-name from the window label"
	
	self fileName ifNotNil: [ :f | ^ f ].
						
	^ (self containingWindow 
		ifNil: ['Untitled']
		ifNotNil:	[ :window |  window label ]), '.ws'! !

!Workspace methodsFor: 'initialization' stamp: 'BenjaminVanRyseghem 2/15/2011 13:09'!
openLabel: labelString
	| window pane |
	window := (SystemWindow labelled: labelString) model: self.
	pane := self buildTextMorph.
	window addMorph: pane frame: (0@0 corner: 1@1).
	window openInWorld.
	^ window! !

!Workspace methodsFor: 'window menu' stamp: 'GeorgeHerolyants 1/14/2010 19:14'!
reloadCommand
	"Replaces unsaved content with the content of the associated file"
	
	self warnUser ifTrue: [self openFile: self fileName]! !

!Workspace methodsFor: 'initialization' stamp: 'cami 7/22/2013 18:29'!
initialize
	
	super initialize.
	contents := ''.
	acceptDroppedMorphs := false.
	mustDeclareVariables := false.
	lineEnding := #cr.
	"try to guess default line ending"
	Smalltalk os isWindows ifTrue: [lineEnding := #crlf].
	Smalltalk os isUnix ifTrue: [lineEnding := #lf].
	
	encoding := TextConverter default class encodingNames first.! !

!Workspace methodsFor: 'window menu' stamp: 'MarcusDenker 4/29/2011 00:37'!
saveAsCommand
	"Save the receiver's contents string to a file, prompting the user for a file-name.  Suggest a reasonable file-name."
	| suggestedFileName | 
		
	suggestedFileName := self askForFileNameToSave: self suggestedFileName.
	suggestedFileName ifNil: [^ self].
	
	FileStream newFileNamed: suggestedFileName  do: [ :s | "do nothing"].
	self fileName: suggestedFileName.
	self label: suggestedFileName.

	self codeTextMorph ifNotNil: 
		[ :morph | | stringToSave |
		stringToSave :=  morph text string.
		self saveString: stringToSave toFile: suggestedFileName.
		self contents: stringToSave.
		self changed: #contents]! !

!Workspace methodsFor: 'window menu' stamp: 'StephaneDucasse 10/27/2014 18:01'!
addModelItemsToWindowMenu: aMenu
	aMenu addLine.
	aMenu add: 'Open...'  target: self selector: #openCommand.
	aMenu lastItem icon: Smalltalk ui icons smallOpenIcon.
	aMenu add: 'Save as...'  target: self selector: #saveAsCommand.
	aMenu lastItem icon: Smalltalk ui icons smallSaveAsIcon.
	self fileName ifNotNil: [ aMenu add: 'Reload'  target: self selector: #reloadCommand ].
	aMenu addLine.
	aMenu
		add: 'Encoding'
		subMenu:
			([ :menu | 
			TextConverter allEncodingNames
				do: [ :ea | 
					menu
						addUpdating: #itemForEncoding:
						target: self
						selector: #useEncoding:
						argumentList: {ea} ].
			menu ] value: (UIManager default newMenuIn: self for: self)).
	aMenu addLine.
	aMenu
		addUpdating: #itemForCr
		target: self
		selector: #useLineEnding:
		argumentList: {#cr}.
	aMenu
		addUpdating: #itemForLf
		target: self
		selector: #useLineEnding:
		argumentList: {#lf}.
	aMenu
		addUpdating: #itemForCrLf
		target: self
		selector: #useLineEnding:
		argumentList: {#crlf}.
	aMenu addLine.
	aMenu add: 'Inspect variables'  target: self selector: #browseBindings.
	aMenu add: 'Reset variables'  target: self selector: #initializeBindings.
	aMenu addUpdating: #mustDeclareVariableWording target: self selector: #toggleVariableDeclarationMode.
	aMenu addUpdating: #acceptDroppedMorphsWording target: self selector: #toggleDroppingMorphForReference.
	aMenu add: 'Previous contents...' target: self selector: #selectPreviousContent.
	aMenu addLine.
	aMenu addUpdating: #stylingActiveString target: self selector: #toggleStylingActive! !

!Workspace methodsFor: 'styling' stamp: 'MarcusDenker 9/23/2011 11:24'!
toggleStylingActive

	^stylingActive := self stylingActive not.
	
	! !

!Workspace methodsFor: '*necompletion' stamp: 'MarcusDenker 9/18/2012 13:34'!
selectedClassOrMetaClass
	^nil
! !

!Workspace methodsFor: 'drag and drop' stamp: 'jcg 7/8/2000 00:10'!
acceptsDroppingMorphForReference

	^ acceptDroppedMorphs
		
! !

!Workspace methodsFor: 'binding' stamp: 'MarcusDenker 8/5/2014 16:51'!
bindingOf: aString 
	
	mustDeclareVariables ifTrue: [^ nil].
	"I want to have workspace that force the user to declare  
	variables. Still subclasses may want to do something else"
	bindings ifNil: [self initializeBindings].
	(bindings includesKey: aString)
		ifFalse: [bindings add: (WorkspaceVariable key: aString asSymbol)].
	^ bindings associationAt: aString! !

!Workspace methodsFor: 'history' stamp: 'MarcusDenker 8/1/2014 13:12'!
setContent: aString
	| textMorphs textMorph |
	textMorphs := self dependents select: [:c | c isKindOf: PluggableTextMorph].
	textMorphs ifEmpty: [ ^ self ]. "This case should normally not happen"
	
	textMorph := textMorphs first.
	textMorph setText: aString! !

!Workspace methodsFor: 'variable declarations' stamp: 'StephaneDucasse 4/22/2012 16:42'!
mustDeclareVariableWording
	
	^ mustDeclareVariables -> 'Automatically create variable declaration' translated! !

!Workspace methodsFor: 'accessing' stamp: 'MarcusDenker 10/5/2012 15:54'!
codeTextMorph
	^ self dependents
		detect: [:dep | (dep isKindOf: PluggableTextMorph)
				and: [dep getTextSelector == #contents]]
		ifNone: []! !

!Workspace methodsFor: 'accessing' stamp: 'GeorgeHerolyants 1/14/2010 18:45'!
label: aString
	"Set the window label to the given string"

	self containingWindow setLabel: aString
	
	! !

!Workspace methodsFor: 'styling' stamp: 'AlainPlantec 8/27/2011 01:24'!
shoutAboutToStyle: aPluggableShoutMorphOrView 
	^ self stylingActive! !

!Workspace methodsFor: 'accessing' stamp: 'AlexandreBergel 1/16/2009 10:33'!
lastContents
	LastContents ifNil: [LastContents := OrderedCollection new].
	^ LastContents! !

!Workspace methodsFor: 'toolbuilder' stamp: 'BenjaminVanRyseghem 9/12/2012 14:30'!
buildTextMorph 
	| morph |
	
	morph := PluggableTextMorph 
					on: self 
					text: #contents 
					accept: #acceptContents:
					readSelection: nil 
					menu: #codePaneMenu:shifted:.
	
	morph font: StandardFonts codeFont.
	morph styler workspace: self.
	
	^ morph! !

!Workspace methodsFor: 'accessing' stamp: 'sd 11/20/2005 21:27'!
setBindings: aDictionary
	"Sets the Workspace to use the specified dictionary as its namespace"

	bindings := aDictionary.
! !

!Workspace methodsFor: 'file support' stamp: 'CarloTeixeira 5/22/2011 20:20'!
readStringFromFile: aFileName 
	"Read the content of the given file. Perform line endings normalization."
	| content |
	FileStream
		oldFileNamed: aFileName
		do: [:f | 
			f converter: (TextConverter newForEncoding: encoding).
			f wantsLineEndConversion: true.
			content := f contents.
			lineEnding := f lineEndConvention].
	^ content! !

!Workspace methodsFor: 'window menu' stamp: 'StephaneDucasse 4/22/2012 16:42'!
itemForEncoding: aString
	^ encoding = aString -> aString! !

!Workspace methodsFor: 'file support' stamp: 'CarloTeixeira 5/24/2011 08:59'!
askForFileNameToOpen
	"Ask user for file name to load content from"
	^ UIManager default
			chooseFullFileNameMatching: nil 
			label: 'Choose file to open in the workspace' translated! !

!Workspace methodsFor: 'initialize-release' stamp: 'GeorgeHerolyants 1/14/2010 18:53'!
open
	
	self openLabel: 'Untitled'! !

!Workspace methodsFor: '*SUnit-UITesting' stamp: 'StephaneDucasse 11/2/2012 11:08'!
hasUnacceptedEdits
	"Answer true if any of the views on this model has unaccepted edits."

	self dependents
		do: [:each | 
			self flag: #fixMe. "The check for #respondsTo: is a hack necessary just because the old
			Browser uses it wrong. We need to change this after old Browser removal"
			((each respondsTo: #hasUnacceptedEdits) and: [ each hasUnacceptedEdits ]) 
				ifTrue: [^ true]]
		without: self.
	^ false
! !

!Workspace methodsFor: 'window menu' stamp: 'GeorgeHerolyants 1/18/2010 17:48'!
useEncoding: aString
	encoding := aString.
	self codeTextMorph hasUnacceptedEdits: true.! !

!Workspace methodsFor: 'window menu' stamp: 'StephaneDucasse 4/22/2012 16:41'!
itemForCrLf
	^ (lineEnding = #crlf) -> 'CR+LF'! !

!Workspace methodsFor: '*NodeNavigation' stamp: 'StephaneDucasse 6/22/2014 10:36'!
isWorkspace

	^true! !

!Workspace methodsFor: 'other menus' stamp: 'AlainPlantec 11/6/2011 13:57'!
shiftedYellowButtonMenu
	"Answer the menu to be presented when the yellow button is pressed while the shift key is down"

	^  (PragmaMenuBuilder 
			pragmaKeyword: SmalltalkEditor smalltalkEditorShiftedMenuKeyword
			model: self) menu.! !

!Workspace methodsFor: 'file support' stamp: 'GeorgeHerolyants 1/18/2010 14:50'!
openFile: aFileName
	"Load file content into this workspace. If successful, associate the workspace with this file and change its label"

	aFileName isEmptyOrNil ifTrue: [ ^ self ].
	
	self contents: (self readStringFromFile: aFileName).
	self fileName: aFileName.
	self label: aFileName.
	self changed: #contents! !

!Workspace methodsFor: 'window menu' stamp: 'GeorgeHerolyants 1/18/2010 17:48'!
useLineEnding: aSymbol
	lineEnding := aSymbol.
	self codeTextMorph hasUnacceptedEdits: true.! !

!Workspace methodsFor: '*necompletion' stamp: 'bar 12/16/2004 11:24'!
hasBindingOf: aString 
	^(self guessTypeForName: aString) notNil! !

!Workspace methodsFor: 'drag and drop' stamp: 'jcg 7/7/2000 11:16'!
wantsDroppedMorph: dropee event: evt inMorph: target

	^ acceptDroppedMorphs
		
! !

!Workspace methodsFor: 'styling' stamp: 'StephaneDucasse 4/22/2012 16:42'!
stylingActiveString
	
	^self stylingActive -> 'syntax highlighting' translated! !

!Workspace methodsFor: 'other menus' stamp: 'AlainPlantec 11/6/2011 13:59'!
yellowButtonMenu
	^  (PragmaMenuBuilder 
		pragmaKeyword: SmalltalkEditor smalltalkEditorMenuKeyword
		model: self) menu 
! !

!Workspace methodsFor: '*necompletion' stamp: 'MarcusDenker 9/18/2012 13:32'!
isCodeCompletionAllowed
	^true
! !

!Workspace methodsFor: 'accessing' stamp: 'GeorgeHerolyants 1/20/2010 18:47'!
fileName
	^ fileName! !

!Workspace methodsFor: 'history' stamp: 'NicolaiHess 4/12/2014 12:20'!
selectPreviousContent

	| trimmedContents  |
	trimmedContents := self lastContents collect: [:c | c copyFrom: 1 to: (c size min: 20)].
	^ (UIManager default chooseFrom: trimmedContents values: self lastContents)
		ifNotNil: [ :newContents | self setContent: newContents ]! !

!Workspace methodsFor: 'accessing' stamp: 'sd 3/20/2004 15:17'!
mustDeclareVariables: aBoolean

	mustDeclareVariables := aBoolean! !

!Workspace methodsFor: 'binding' stamp: 'yann.monclair 7/17/2010 12:37'!
browseBindings
	bindings inspect! !

!Workspace methodsFor: 'styling' stamp: 'BenjaminVanRyseghem 2/15/2011 14:16'!
stylingActive

	^stylingActive ifNil:[stylingActive := true]! !

!Workspace methodsFor: '*necompletion' stamp: ''!
completionAdditionalsFromOCompletion
	"should spend more time to get it"
	
	bindings ifNil: [ ^#() ].
	^bindings keys asArray replace: [ :each | 
		NECLocalEntry 
			contents: each
			type: #local ]! !

!Workspace methodsFor: '*necompletion' stamp: 'ClementBera 7/26/2013 17:06'!
guessTypeForName: aString
	| binding |
	
	bindings ifNotNil: [ 
		binding := bindings 
			at: aString
			ifAbsent: [ nil ].
		binding isNil
			ifFalse: [ ^ binding class ] ].

	^ nil! !

!Workspace methodsFor: 'window menu' stamp: 'GeorgeHerolyants 1/18/2010 14:56'!
openCommand
	"Open content of the file choosed by user in this workspace and associate it's name with this workspace"
	| userWarned |

	userWarned := true.
	(self fileName isNil and: [self contents isEmpty not or: [self hasUnacceptedEdits]]) ifTrue: [userWarned := self warnUser].
	(self fileName isNil not and: [self hasUnacceptedEdits]) ifTrue: [userWarned := self warnUser].
	
	userWarned ifTrue: [self openFile: self askForFileNameToOpen]
! !

!Workspace methodsFor: 'initialization' stamp: 'LaurentLaffont 3/14/2010 17:23'!
initialExtent
 	"Start small.  Window aspect ratio is 5 sqrt::1 . Good asthetics. -wiz"
	
	^ 450@200! !

!Workspace methodsFor: 'binding' stamp: 'sd 3/20/2004 14:31'!
initializeBindings
	
	bindings := Dictionary new! !

!Workspace methodsFor: '*necompletion' stamp: 'bar 12/16/2004 11:26'!
hasBindingThatBeginsWith: aString
	^false! !

!Workspace methodsFor: 'window menu' stamp: 'StephaneDucasse 4/22/2012 16:40'!
acceptDroppedMorphsWording

	^ self acceptsDroppingMorphForReference -> 'Create textual references to dropped morphs' translated
	! !

!Workspace methodsFor: 'other menus' stamp: 'EstebanLorenzano 1/31/2013 19:24'!
codePaneMenu: aMenu shifted: shifted 
	"Note that unless we override perform:orSendTo:, 
	PluggableTextController will respond to all menu items in a 
	text pane"
	| donorMenu |
	donorMenu := shifted
				ifTrue: [self shiftedYellowButtonMenu]
				ifFalse: [self yellowButtonMenu].
	^ aMenu addAllFrom: donorMenu! !

!Workspace methodsFor: 'window menu' stamp: 'StephaneDucasse 4/22/2012 16:41'!
itemForCr
	^ (lineEnding = #cr) -> 'CR'! !

!Workspace methodsFor: 'accessing' stamp: 'NicolaiHess 6/7/2014 19:26'!
acceptContents: aString

	self fileName ifNotNil: [ self saveString: aString asString toFile: self fileName ].

	acceptAction ifNotNil:[acceptAction value: aString].
	self contents: aString.
	^ true! !

!Workspace methodsFor: 'accessing' stamp: 'ar 7/16/2005 17:56'!
acceptAction: anAction
	acceptAction := anAction.! !

!Workspace methodsFor: 'configuration' stamp: 'AlexandreBergel 1/16/2009 10:32'!
historyLength
	"Number of contents being stored"
	^ 5! !

!Workspace methodsFor: 'drag and drop' stamp: 'sd 11/20/2005 21:27'!
toggleDroppingMorphForReference

	acceptDroppedMorphs := acceptDroppedMorphs not.
		
! !

!Workspace methodsFor: 'window menu' stamp: 'StephaneDucasse 4/22/2012 16:42'!
itemForLf
	^ lineEnding = #lf -> 'LF'! !

!Workspace methodsFor: 'file support' stamp: 'GeorgeHerolyants 1/14/2010 18:34'!
askForFileNameToSave: suggestedFileName
	"Ask user for the name of the file to save workspace content to. Use the given file name as the initial answer"

	^ UIManager default
			request: 'Enter file name to save the workspace to' translated 
			initialAnswer: suggestedFileName! !

!Workspace methodsFor: 'history' stamp: 'AlexandreBergel 1/16/2009 10:36'!
okToChange
	"This method is called by SystemWindow just before closing a workspace window. 
	The caller of this method is SystemWindow>>delete"
	
	| textMorphs textMorph contentAsString |
	textMorphs := self dependents select: [:c | c isKindOf: PluggableTextMorph].
	textMorphs ifEmpty: [ ^ true ]. "This case should normally not happen"
	
	textMorph := textMorphs first.
	contentAsString := (textMorph text) asString.
	self lastContents addFirst: contentAsString.
	self trimHistoryIfNecessary.
	^ true! !

!Workspace methodsFor: 'accessing' stamp: 'GeorgeHerolyants 1/20/2010 18:47'!
fileName: anObject
	fileName := anObject! !

!Workspace methodsFor: 'file support' stamp: 'GeorgeHerolyants 1/21/2010 12:17'!
saveString: aString toFile: aFileName
	"Save the given string to the given file"
	
	FileStream forceNewFileNamed: aFileName do: 
	[ :stream | 
		stream converter: (TextConverter newForEncoding: encoding).
		stream wantsLineEndConversion: true.
		stream lineEndConvention: lineEnding.
		stream nextPutAll: aString ].
	! !

!Workspace methodsFor: 'window menu' stamp: 'StephaneDucasse 10/26/2014 18:09'!
warnUser
	"Warn the user about the possible content loss"

	^ UIManager default confirm: 'This will replace the current workspace content.', String cr, 'Do you want to continue?' translated! !

!Workspace methodsFor: 'accessing' stamp: 'StephaneDucasse 1/21/2011 17:20'!
contents: stringOrText
	contents := stringOrText.
	self changed: #contents.! !

!Workspace methodsFor: 'accessing' stamp: 'BenjaminVanRyseghem 9/12/2012 14:31'!
contents
	
	^ contents ifNil: [ contents := '' ]! !

!Workspace methodsFor: '*necompletion' stamp: 'StephaneDucasse 2/26/2012 16:53'!
completionAdditionals
	| additionals |
	additionals := SortedCollection new.
	bindings ifNotNil: 
		[ bindings keysDo: 
			[ :each | 
			additionals add: (NECLocalEntry 
					contents: each
					type: #local) ] ].
	^ additionals! !

!Workspace class methodsFor: 'instance creation' stamp: 'IgorStasenko 8/17/2011 16:23'!
openContents: aString label: aLabel
	"Open a new workspace with the given contents"
	
	^ self new
		openLabel: aLabel;
	 	contents: aString;
		changed: #contents;
		yourself! !

!Workspace class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'EstebanLorenzano 5/15/2013 13:51'!
taskbarIcon
	"Answer the icon for the receiver in a task bar."

	^ Smalltalk ui icons iconNamed: #workspaceIcon! !

!Workspace class methodsFor: 'instance creation' stamp: 'TudorGirba 3/15/2015 21:48'!
title
	^ 'Workspace'! !

!Workspace class methodsFor: 'file support' stamp: 'GeorgeHerolyants 1/14/2010 18:53'!
openFile: aFileName
	"Open a new workspace associated with the given file"

	^ self new 
		open;
		openFile: aFileName;
		yourself! !

!Workspace class methodsFor: 'tools registry' stamp: 'IgorStasenko 2/19/2011 03:01'!
registerToolsOn: registry
	"Add ourselves to registry. See [Smalltalk tools]" 
	registry register: self as: #workspace
! !

!Workspace class methodsFor: 'instance creation' stamp: 'StephaneDucasse 1/21/2011 16:52'!
open
	^ self openLabel: 'Workspace'! !

!Workspace class methodsFor: 'instance creation' stamp: 'AlexandreBergel 8/31/2011 17:49'!
openContents: aString
	"Open a new workspace with the given contents. aString has to be Smalltalk code. The style is applied"
	
	^ self new
		open;
	 	contents: aString;
		changed: #contents;
		yourself! !

!Workspace class methodsFor: 'instance creation' stamp: 'StephaneDucasse 1/21/2011 16:51'!
openLabel: aLabel
	^ self new openLabel: aLabel ; yourself! !

!Workspace class methodsFor: 'cleanup' stamp: 'MarcusDenker 2/26/2013 18:01'!
cleanUp
	LastContents := nil.! !

!WorkspaceTest commentStamp: 'TorstenBergmann 2/4/2014 20:47'!
SUnit tests for Workspace!
!WorkspaceTest methodsFor: 'tests' stamp: 'AlexandreBergel 8/31/2011 17:56'!
testStyling

	| workspace |
	workspace := Workspace new.
	self assert: workspace stylingActive.
	
	workspace toggleStylingActive.
	self deny: workspace stylingActive.! !

!WorkspaceTest methodsFor: 'tests' stamp: 'AlexandreBergel 8/31/2011 17:58'!
testEmptyContent

	self assert: (Workspace new contents isEmpty)! !

!WorkspaceVariable commentStamp: 'MarcusDenker 8/5/2014 16:48'!
I am a binding in a Workspace. Used for non-defined temps!
!WorkspaceVariable methodsFor: 'code generation' stamp: 'MarcusDenker 8/5/2014 16:47'!
emitValue: methodBuilder

	methodBuilder pushLiteralVariable: self.! !

!WorkspaceVariable methodsFor: 'code generation' stamp: 'MarcusDenker 8/5/2014 16:47'!
emitStore: methodBuilder

	methodBuilder storeIntoLiteralVariable: self.

! !

!WorldModel commentStamp: '<historical>'!
I am a model representing Pharo World.

This way, every spec application can be opened as the Pharo system window as window, ti simulate native application!
!WorldModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 5/14/2013 16:43'!
ensureExtentFor: aWidget

	self extent ifNotNil: [ :ext | DisplayScreen hostWindowSize: ext ].
	self initialExtent ifNotNil: [ :ext | DisplayScreen hostWindowSize: ext ].! !

!WorldModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 5/14/2013 16:23'!
isDisplayed

	^ true! !

!WorldModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 5/14/2013 16:24'!
title: aString

	^ DisplayScreen hostWindowTitle: aString! !

!WorldModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 5/14/2013 22:40'!
openWithSpecLayout: aSpec

	self buildWithSpecLayout: aSpec.
	self updateTitle! !

!WorldModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 5/14/2013 16:41'!
updateTitle
	"Update the window title"

	DisplayScreen hostWindowTitle: self title! !

!WorldModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 5/14/2013 22:41'!
addModelIn: container withSpec: aSpec
	
	self model ifNil: [ ^ self ].
	widget := self model buildWithSpec: aSpec.
	
	container
		addMorph: widget
		fullFrame: LayoutFrame identity! !

!WorldModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 5/14/2013 22:41'!
addModelIn: container withSpecLayout: aSpec

	self model ifNil: [ ^ self ].
	widget := self model buildWithSpecLayout: aSpec.
	
	container
		addMorph: widget
		fullFrame: LayoutFrame identity! !

!WorldModel methodsFor: 'api' stamp: 'BenjaminVanRyseghem 5/14/2013 22:59'!
widget

	^ widget ! !

!WorldModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 5/14/2013 22:40'!
openWithSpec: aSpec

	self buildWithSpec: aSpec.
	self updateTitle! !

!WorldModel methodsFor: 'factory' stamp: 'StephaneDucasse 8/22/2014 17:54'!
buildWidget

	^ World asSpecAdapter! !

!WorldModel methodsFor: 'private' stamp: 'BenjaminVanRyseghem 5/14/2013 16:23'!
defaultInitialExtent
	
	^ World extent! !

!WorldModel class methodsFor: 'specs' stamp: 'EstebanLorenzano 9/18/2014 17:06'!
defaultSpec
	<spec>
	
	self setUpWorld.
	^ World asSpecAdapter! !

!WorldModel class methodsFor: 'private' stamp: 'EstebanLorenzano 9/24/2014 15:03'!
setUpWorld

	World changeProportionalLayout.
	World submorphs do: [:e | e delete ].
 
 	(Smalltalk at: #PolymorphSystemSettings) 
		perform: #desktopColor: 
		with: Smalltalk ui theme backgroundColor.
 	"((Smalltalk at: #UITheme) perform: #currentSettings) perform: #windowColor: with: (Color r: 0.745 g: 0.745 b: 0.745)."
	(Smalltalk at: #TaskbarMorph) perform: #showTaskbar: with: false! !

!WorldMorph commentStamp: '<historical>'!
A WorldMorph is a special morph that represents the world.
It is a paste up and it holds active hand.

A World, the entire Smalltalk screen, is a PasteUpMorph.  A World responds true to isWorld.!
!WorldMorph methodsFor: 'interaction loop' stamp: 'StephaneDucasse 6/27/2013 19:00'!
doOneCycleNow
	"see the comment in doOneCycleNowFor:"
	worldState doOneCycleNowFor: self.
! !

!WorldMorph methodsFor: 'stepping' stamp: 'StephaneDucasse 6/28/2013 13:07'!
stopStepping: aMorph
	"Remove the given morph from the step list."

	worldState stopStepping: aMorph
! !

!WorldMorph methodsFor: 'world state' stamp: 'StephaneDucasse 6/27/2013 18:53'!
haloMorphs

	^ self hands collect: [ :h | h halo ] thenSelect: [ :halo | halo notNil ]! !

!WorldMorph methodsFor: 'deferred message' stamp: 'AlainPlantec 3/10/2015 20:16'!
defer: aValuable
	"aValuable will be executed in the next UI rendering cycle"
	worldState defer: aValuable! !

!WorldMorph methodsFor: 'session management' stamp: 'RonieSalgado 1/9/2014 18:19'!
checkSession
	session == Smalltalk session ifFalse: [ 
		self recreateOSWindow.
		session := Smalltalk session.
	]! !

!WorldMorph methodsFor: 'updating screen' stamp: 'RonieSalgado 1/13/2014 16:43'!
checkNewWindowSize
	| newExtent |
	newExtent := self osWindow extent.
	newExtent ~= self extent ifTrue: [
		self osWindowRenderer newExtent: newExtent.
		self extent: newExtent.
	]! !

!WorldMorph methodsFor: 'world state' stamp: 'StephaneDucasse 6/27/2013 18:51'!
removeHand: aHandMorph
	"Remove the given hand from the list of hands for this world."

	(worldState hands includes: aHandMorph)
		ifFalse: [ ^ self ].
	aHandMorph dropMorphs.
	self invalidRect: aHandMorph fullBounds.
	worldState removeHand: aHandMorph! !

!WorldMorph methodsFor: 'halos and balloon help' stamp: 'StephaneDucasse 7/2/2013 17:19'!
wantsDirectionHandles

	^ false! !

!WorldMorph methodsFor: 'geometry' stamp: 'MarcusDenker 10/10/2013 23:48'!
position: aPoint
	"Prevent moving a world (e.g. via HandMorph>>specialGesture:)"

	super position: aPoint.
	self viewBox ifNotNil: [:viewBox | self viewBox: (aPoint extent:  viewBox extent)].

! !

!WorldMorph methodsFor: 'world state' stamp: 'StephaneDucasse 6/27/2013 18:57'!
displayWorldSafely
	worldState displayWorldSafely: self.
! !

!WorldMorph methodsFor: 'initialization' stamp: 'StephaneDucasse 7/1/2013 10:09'!
initialize 
	worldState := WorldState new.
 	super initialize! !

!WorldMorph methodsFor: 'Morphic-Base-Windows' stamp: 'StephaneDucasse 6/28/2013 13:25'!
fullRepaintNeeded

	worldState doFullRepaint.
	self  windowsSatisfying: [:w | w makeMeVisible. false].

! !

!WorldMorph methodsFor: 'project state' stamp: 'StephaneDucasse 6/28/2013 13:11'!
isStepping: aMorph
	^ worldState isStepping: aMorph! !

!WorldMorph methodsFor: 'classification' stamp: 'StephaneDucasse 6/27/2013 16:48'!
isWorldMorph

	^ true! !

!WorldMorph methodsFor: 'geometry testing' stamp: 'StephaneDucasse 6/28/2013 13:23'!
fullContainsPoint: pt
	^bounds containsPoint: pt
! !

!WorldMorph methodsFor: 'stepping' stamp: 'StephaneDucasse 6/28/2013 13:06'!
stopStepping: aMorph selector: aSelector
	"Remove the given morph from the step list."

	worldState stopStepping: aMorph selector: aSelector
! !

!WorldMorph methodsFor: 'project state' stamp: 'StephaneDucasse 6/28/2013 13:07'!
stepListSize
	^ worldState stepListSize

"Transcript cr; show: self currentWorld stepListSize printString, ' items on steplist as of ', Date dateAndTimeNow printString"! !

!WorldMorph methodsFor: 'project state' stamp: 'StephaneDucasse 6/27/2013 18:58'!
handsReverseDo: aBlock
	^ worldState handsReverseDo: aBlock! !

!WorldMorph methodsFor: 'world menu' stamp: 'StephaneDucasse 6/28/2013 13:08'!
resetWorldMenu
	
	worldState resetWorldMenu
! !

!WorldMorph methodsFor: 'accessing' stamp: 'RonieSalgado 1/10/2014 16:06'!
osWindowRenderer
	^ self osWindow renderer ifNil: [ 
		self osWindow newFormRenderer: Display.
		self osWindow renderer
	].
	
! !

!WorldMorph methodsFor: 'alarms-scheduler' stamp: 'StephaneDucasse 6/27/2013 17:23'!
addAlarm: aSelector withArguments: argArray for: aTarget at: scheduledTime
	"Add a new alarm with the given set of parameters"
	worldState addAlarm: aSelector withArguments: argArray for: aTarget at: scheduledTime.! !

!WorldMorph methodsFor: 'project state' stamp: 'StephaneDucasse 6/27/2013 18:47'!
hands

	^ worldState hands! !

!WorldMorph methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 8/23/2014 19:49'!
contentsMenu: aMenu
	"Build the menu used from PopUpContentsMenu:"

	| expanded collapsed |
	expanded := self windowsSatisfying: [ :w | w isCollapsed not ].
	collapsed := self windowsSatisfying: [ :w | w isCollapsed ].
	(expanded asSortedCollection: [ :w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label ])
		do: [ :w | 
			aMenu add: w label target: w selector: #activateAndForceLabelToShow.
			aMenu lastItem icon: w taskbarIcon.
			w model canDiscardEdits 
				ifFalse: [ aMenu lastItem color: Color red ] ].
	aMenu addLine.
	(collapsed asSortedCollection: [ :w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label ])
		do: [ :w | 
			aMenu add: w label target: w selector: #collapseOrExpand.
			aMenu lastItem icon: w taskbarIcon.
			w model canDiscardEdits
				ifFalse: [ aMenu lastItem color: Color red ] ].
	aMenu addLine.
	((self submorphs reject: [ :sm | (expanded includes: sm) or: [ collapsed includes: sm ] ])
		asSortedCollection: [ :w1 :w2 | w1 class name caseInsensitiveLessOrEqual: w2 class name ])
		do: [ :w | 
			aMenu add: w class name target: w selector: #comeToFront.
			aMenu lastItem icon: w taskbarIcon ].
	aMenu addStayUpIcons.
	^ aMenu! !

!WorldMorph methodsFor: 'world state' stamp: 'StephaneDucasse 6/27/2013 18:55'!
displayWorld
	worldState displayWorld: self submorphs: submorphs! !

!WorldMorph methodsFor: 'clipboard handling' stamp: 'RonieSalgado 1/17/2014 17:52'!
clipboardText: aString
	^ self osWindow clipboardText: aString! !

!WorldMorph methodsFor: 'menu & halo' stamp: 'StephaneDucasse 6/27/2013 20:07'!
deleteBalloonTarget: aMorph
	"Delete the balloon help targeting the given morph"

	self handsDo: [ :h | h deleteBalloonTarget: aMorph ]! !

!WorldMorph methodsFor: 'session management' stamp: 'RonieSalgado 1/16/2014 17:52'!
recreateOSWindow
	| attributes driver |
	session := Smalltalk session.
	attributes := OSWindowAttributes new.
	attributes extent: self extent;
		title: Smalltalk shortImageName;
		icon: Smalltalk ui icons pharoIcon.
		
	driver := self pickMostSuitableWindowDriver.
	attributes preferableDriver: driver.
	osWindow := OSWindow createWithAttributes: attributes.
	osWindow newFormRenderer: Display.
	osWindow eventHandler: (OSWindowMorphicEventHandler for: self).
	! !

!WorldMorph methodsFor: 'project state' stamp: 'StephaneDucasse 6/28/2013 13:09'!
listOfSteppingMorphs
	^ worldState listOfSteppingMorphs

"self currentWorld listOfSteppingMorphs"! !

!WorldMorph methodsFor: 'private' stamp: 'StephaneDucasse 6/27/2013 19:24'!
privateMoveBy: delta
	super privateMoveBy: delta.
	worldState viewBox ifNotNil: [ worldState viewBox: bounds ]! !

!WorldMorph methodsFor: 'submorphs-accessing' stamp: 'StephaneDucasse 6/27/2013 17:51'!
allMorphsDo: aBlock
	"Enumerate all morphs in the world, including those held in hands."

	super allMorphsDo: aBlock.
	worldState handsReverseDo: [ :h | h allMorphsDo: aBlock ]! !

!WorldMorph methodsFor: 'world state' stamp: 'StephaneDucasse 7/2/2013 17:21'!
startSteppingSubmorphsOf: aMorph
	"Ensure that all submorphs of the given morph that want to be stepped are added to the step list.   Typically used after adding a morph to the world."

	aMorph allMorphsDo: [:m |
		m wantsSteps ifTrue: [m arrangeToStartSteppingIn: m world].
	]

! !

!WorldMorph methodsFor: 'world menu' stamp: 'StephaneDucasse 6/28/2013 13:17'!
isEasySelecting
	"This is to isolate easySelection predicate. 
	Selectors in holders make no sense so we are limiting easy
	selection to the worldMorph.
	It would also make sense in playfield so feel free to adjust this
	predicate. Selection can always be forced by using the shift
	before mouse down."
	^ worldState isEasySelecting! !

!WorldMorph methodsFor: 'stepping' stamp: 'StephaneDucasse 7/2/2013 16:50'!
step
	owner ifNotNil: [ ^ self runLocalStepMethods ].
	^ super step! !

!WorldMorph methodsFor: 'stepping' stamp: 'StephaneDucasse 6/28/2013 13:08'!
runLocalStepMethods

	worldState runLocalStepMethodsIn: self
! !

!WorldMorph methodsFor: 'world state' stamp: 'StephaneDucasse 6/27/2013 17:31'!
defaultWorldColor
	^ self class defaultWorldColor! !

!WorldMorph methodsFor: 'world state' stamp: 'StephaneDucasse 6/27/2013 18:56'!
addHand: aHandMorph
	"Add the given hand to the list of hands for this world."

	aHandMorph owner ifNotNil: [ aHandMorph owner removeHand: aHandMorph ].
	worldState addHand: aHandMorph.
	aHandMorph privateOwner: self! !

!WorldMorph methodsFor: 'world state' stamp: 'StephaneDucasse 6/27/2013 17:57'!
doOneCycle
	"see the comment in doOneCycleFor:"

	worldState doOneCycleFor: self! !

!WorldMorph methodsFor: 'world state' stamp: 'StephaneDucasse 6/28/2013 13:12'!
doOneSubCycle
	"Like doOneCycle, but preserves activeHand."

	worldState doOneSubCycleFor: self! !

!WorldMorph methodsFor: 'alarms-scheduler' stamp: 'StephaneDucasse 6/27/2013 18:51'!
removeAlarm: aSelector for: aTarget
	"Remove the alarm with the given selector"
	
	worldState removeAlarm: aSelector for: aTarget! !

!WorldMorph methodsFor: 'world state' stamp: 'StephaneDucasse 6/27/2013 18:57'!
assuredCanvas
	^ worldState assuredCanvas! !

!WorldMorph methodsFor: 'project state' stamp: 'StephaneDucasse 6/27/2013 18:58'!
viewBox

	^ worldState viewBox! !

!WorldMorph methodsFor: 'world menu' stamp: 'StephaneDucasse 6/28/2013 13:20'!
discoveredWorldMenu
	^ worldState discoveredWorldMenu! !

!WorldMorph methodsFor: 'event handling' stamp: 'StephaneDucasse 7/2/2013 17:13'!
wantsDropFiles: anEvent
	^ true! !

!WorldMorph methodsFor: '*Morphic-Base' stamp: 'StephaneDucasse 7/2/2013 16:07'!
installForUIProcessReinstall
	"This method should be changed because it cannot be invoked from onPrimitiveError: as the previous PasteUpMorph 
	method was used to."
	
	| morphs  |
	owner := nil.
	morphs := World submorphs.
	"we should decide if we get morph or not. Now submorphs returns an array and this is 
	strange that this is not an OrderedCollection"
	
	Sensor
		flushNonKbdEvents;
		flushKeyboard;
		flushEvents;
		shutDown.
	self class shutDown.
 
	self addHand: HandMorph new.	
	self borderWidth: 0.
	self viewBox: Display boundingBox.
	self borderWidth: 0.	"default"
	self color: self class defaultWorldColor.
	self addAllMorphs: morphs.
	SystemWindow noteTopWindowIn: self.
	World  := self.
	ActiveWorld := self.
	ActiveHand := self hands first.	"default"
	ActiveEvent := nil.
	worldState handsDo: [ :h | h releaseCachedState ].
	Sensor startUp.
	self class startUp.
	self displayWorldSafely.! !

!WorldMorph methodsFor: 'event handling' stamp: 'StephaneDucasse 6/27/2013 19:43'!
mouseUp: evt
	self removeAlarm: #invokeWorldMenu:.
	super mouseUp: evt.! !

!WorldMorph methodsFor: 'project state' stamp: 'StephaneDucasse 6/27/2013 17:50'!
canvas

	^ worldState canvas! !

!WorldMorph methodsFor: 'event handling' stamp: 'StephaneDucasse 7/2/2013 17:33'!
releaseCachedState
	super releaseCachedState.
	self cleanseStepList.! !

!WorldMorph methodsFor: 'private' stamp: 'StephaneDucasse 6/27/2013 19:33'!
wantsDroppedMorph: aMorph event: evt
	
	^ true! !

!WorldMorph methodsFor: 'project state' stamp: 'StephaneDucasse 6/27/2013 18:51'!
firstHand
	^ worldState hands first! !

!WorldMorph methodsFor: 'printing' stamp: 'StephaneDucasse 6/27/2013 19:02'!
printOn: aStream
	"Reimplemented to add a tag showing that the receiver is currently functioning as a 'world', if it is"

	super printOn: aStream.
	aStream nextPutAll: ' [world]'! !

!WorldMorph methodsFor: 'project state' stamp: 'StephaneDucasse 6/27/2013 18:57'!
handsDo: aBlock

	^  worldState handsDo: aBlock ! !

!WorldMorph methodsFor: 'clipboard handling' stamp: 'RonieSalgado 1/15/2014 15:59'!
clipboardText
	^ self osWindow clipboardText! !

!WorldMorph methodsFor: 'world state' stamp: 'StephaneDucasse 6/28/2013 13:15'!
viewBox: newViewBox
	"I am now displayed within newViewBox; react."

	(self viewBox isNil or: [ self viewBox extent ~= newViewBox extent ])
		ifTrue: [ worldState canvas: nil ].
	worldState viewBox: newViewBox.
	super viewBox: newViewBox.
	worldState handsDo: [ :hand | hand releaseKeyboardFocus ].
	self fullRepaintNeeded! !

!WorldMorph methodsFor: 'world state' stamp: 'StephaneDucasse 6/28/2013 13:15'!
sleep

	worldState canvas ifNil: [^ self  "already called (clean this up)"].
	Cursor normal show.	"restore the normal cursor"
	worldState canvas: nil.		"free my canvas to save space"
	self fullReleaseCachedState.
! !

!WorldMorph methodsFor: '*Morphic-Base' stamp: 'CamilleTeruel 12/6/2013 14:45'!
acceptDroppingMorph: dropped event: evt
	"The supplied morph, known to be acceptable to the receiver, is now to be assimilated; the precipitating event is supplied"

	| aMorph |
	aMorph := self morphToDropFrom: dropped.	"Add the given morph to this world and start stepping it if it wants to be."
	self addMorphFront: aMorph.
	(aMorph fullBounds intersects: self viewBox)
		ifFalse: [ 
			self inform: 'Dropped morph not in bounds'.
			aMorph position: self bounds center ].
	aMorph
		submorphsDo: [ :m | 
			(m isKindOf: HaloMorph)
				ifTrue: [ m delete ] ].
	self bringTopmostsToFront! !

!WorldMorph methodsFor: '*Morphic-Widgets-Taskbar' stamp: 'SeanDeNigris 1/23/2014 11:57'!
taskList

	^ self submorphs
		detect: [ :e | e isKindOf: TaskListMorph ]
		ifNone: [ NullTaskList in: self ].! !

!WorldMorph methodsFor: 'copying' stamp: 'StephaneDucasse 6/27/2013 18:51'!
veryDeepCopyWith: deepCopier
	"never copy the World"

	^ self! !

!WorldMorph methodsFor: 'accessing' stamp: 'StephaneDucasse 6/27/2013 17:22'!
announcer
	WorldAnnouncer ifNil: [ WorldAnnouncer := Announcer new ].
	^ WorldAnnouncer! !

!WorldMorph methodsFor: 'project state' stamp: 'StephaneDucasse 6/28/2013 13:10'!
isStepping: aMorph selector: aSelector
	^ worldState isStepping: aMorph selector: aSelector! !

!WorldMorph methodsFor: 'geometry' stamp: 'StephaneDucasse 6/27/2013 18:51'!
extent: aPoint
	super extent: aPoint.
	worldState viewBox
		ifNotNil: [ 
			worldState canvas: nil.
			worldState viewBox: bounds ]! !

!WorldMorph methodsFor: 'change reporting' stamp: 'StephaneDucasse 6/27/2013 18:52'!
invalidRect: damageRect from: aMorph
	"Clip damage reports to my bounds, since drawing is clipped to my bounds."

	worldState recordDamagedRect: (damageRect intersect: self bounds ifNone: [ ^ self ])! !

!WorldMorph methodsFor: 'session management' stamp: 'RonieSalgado 1/15/2014 15:00'!
pickMostSuitableWindowDriver
	"TODO: check for headless mode"
	| driver |
	
	driver := OSWindowDriver current.
	
	"well, lets try using the VM driver"
	(driver isNullDriver and: [VMWindowDriver isSupported]) ifTrue: [ 
		^ VMWindowDriver new ].
	
	^ driver! !

!WorldMorph methodsFor: '*Morphic-Base' stamp: 'ClementBera 10/25/2013 14:00'!
dispatchKeystroke: anEvent
	"A keystroke was hit when no keyboard focus was set, so it is sent here to the world instead."

	|  aChar ascii |
	aChar := anEvent keyCharacter.
	(ascii := aChar asciiValue) = 27 ifTrue: "escape key"
		[^ self invokeWorldMenuFromEscapeKey].
	
	(self navigationKey: anEvent) ifTrue: [^self].

	(anEvent commandKeyPressed and: [Editor cmdKeysInText])
		ifTrue: [^ self dispatchCommandKeyInWorld: aChar event: anEvent].

	"It was unhandled. Remember the keystroke."
	self lastKeystroke: anEvent keyString.
	self triggerEvent: #keyStroke.
	super dispatchKeystroke: anEvent! !

!WorldMorph methodsFor: 'accessing' stamp: 'RonieSalgado 1/29/2014 17:03'!
osWindow
	
	self checkSession.
	^ osWindow
	
! !

!WorldMorph methodsFor: 'world menu' stamp: 'StephaneDucasse 6/28/2013 13:05'!
worldMenu
	^ worldState worldMenu
	! !

!WorldMorph methodsFor: 'menu & halo' stamp: 'StephaneDucasse 7/2/2013 17:30'!
wantsWindowEvent: anEvent
	^ true! !

!WorldMorph methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 6/5/2014 19:50'!
contentsMenuTitle
	^ 'World contents' translated! !

!WorldMorph methodsFor: 'submorphs-add/remove' stamp: 'StephaneDucasse 7/2/2013 16:30'!
addAllMorphs: array

	super addAllMorphs: array.
	array do: [:m | self startSteppingSubmorphsOf: m].
! !

!WorldMorph methodsFor: '*Morphic-Base' stamp: 'StephaneDucasse 7/2/2013 16:10'!
install
	"this method was used to be invoked from onPrimitiveError: 
	the problem is that it cannot be used to recreate the world instance.
	For this have a look class side installNewWorld."
	owner := nil.	"since we may have been inside another world previously"
	ActiveWorld := self.
	World := self.
	ActiveHand := self hands first.	"default"
	ActiveEvent := nil.
	submorphs do: [:ss | ss owner isNil ifTrue: [ss privateOwner: self]].
	"Transcript that was in outPointers and then got deleted."
	self viewBox: Display boundingBox.
	Sensor flushAllButDandDEvents.
	worldState handsDo: [:h | h initForEvents].
	self borderWidth: 0.	"default"
	SystemWindow noteTopWindowIn: self.
	self displayWorldSafely! !

!WorldMorph methodsFor: 'structure' stamp: 'StephaneDucasse 6/27/2013 17:46'!
activeHand

	^ worldState activeHand! !

!WorldMorph methodsFor: 'structure' stamp: 'StephaneDucasse 6/27/2013 19:03'!
world
	
	^self! !

!WorldMorph methodsFor: 'world state' stamp: 'StephaneDucasse 6/27/2013 18:57'!
activeHand: aHandMorph
	"temporarily retained for old main event loops"
	worldState activeHand: aHandMorph.

! !

!WorldMorph methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 6/10/2014 07:35'!
mouseDown: evt
	super mouseDown: evt.
	self currentWindow ifNotNil: [ :topWindow | SystemWindow passivateTopWindow ]! !

!WorldMorph methodsFor: 'updating screen' stamp: 'RonieSalgado 1/10/2014 17:39'!
updateOnOSWindow
	"Update this world's display."

	| handsToDraw allDamage worldDamageRects handDamageRects canvas |

	submorphs do: [:m | m fullBounds].  "force re-layout if needed"
	worldState checkIfUpdateNeeded ifFalse: [^ self].  "display is already up-to-date"

	canvas := self osWindowRenderer getCanvas.
	
	self osWindowRenderer deferUpdatesWhile: [  
	
		worldDamageRects := worldState drawWorld: self submorphs: submorphs invalidAreasOn: canvas.  "repair world's damage on canvas"
		"self handsDo:[:h| h noticeDamageRects: worldDamageRects]."
		handsToDraw := worldState selectHandsToDrawForDamage: worldDamageRects.
		handDamageRects := handsToDraw collect: [:h | h savePatchFrom: canvas].
		allDamage := worldDamageRects, handDamageRects.

		handsToDraw reverseDo: [:h | canvas fullDrawMorph: h].  "draw hands onto world canvas"
 
	"*make this true to flash damaged areas for testing*"
		WorldState debugShowDamage ifTrue: [self flashRects: allDamage color: Color black].

		canvas finish.
	"quickly copy altered rects of canvas to Display:"
	
 
		self osWindowRenderer updateAreas: allDamage immediate: false.

 		handsToDraw do: [:h | h restoreSavedPatchOn: canvas].  "restore world canvas under hands"
	].
"	self osWindowRenderer forceDisplayUpdate."
	! !

!WorldMorph methodsFor: 'stepping' stamp: 'StephaneDucasse 6/28/2013 13:07'!
runStepMethods

	worldState runStepMethodsIn: self
! !

!WorldMorph methodsFor: 'world menu' stamp: 'StephaneDucasse 6/28/2013 13:04'!
worldMenuAt: aMenuItemName
	
	^ worldState worldMenuAt: aMenuItemName! !

!WorldMorph methodsFor: 'stepping' stamp: 'StephaneDucasse 6/28/2013 13:07'!
startStepping: aMorph at: scheduledTime selector: aSelector arguments: args stepTime: stepTime
	worldState startStepping: aMorph at: scheduledTime selector: aSelector arguments: args stepTime: stepTime.! !

!WorldMorph methodsFor: 'stepping' stamp: 'StephaneDucasse 6/28/2013 13:12'!
cleanseStepList
	"Remove morphs from the step list that are not in this World."

	worldState cleanseStepListForWorld: self! !

!WorldMorph class methodsFor: 'setting' stamp: 'StephaneDucasse 6/27/2013 19:29'!
defaultWorldColor

	^ Color r: 0.937 g: 0.937 b: 0.937.
! !

!WorldMorph class methodsFor: 'system startup' stamp: 'MarcusDenker 10/15/2013 10:31'!
startUp
	World ifNotNil: [:world | world restoreMorphicDisplay]! !

!WorldMorph class methodsFor: 'system startup' stamp: 'MarcusDenker 10/15/2013 10:32'!
shutDown
	World ifNotNil: [:world | world triggerEvent: #aboutToLeaveWorld ]! !

!WorldMorph class methodsFor: '*Morphic-Base' stamp: 'StephaneDucasse 7/2/2013 16:07'!
installNewWorld
	"let us play God."
	
	 [  |  man |
      
        man := MorphicUIManager new.
        "we do not use UIManager default because in headless mode there is not such process."
        man uiProcess ifNotNil: [ man terminateUIProcess  ].
       self new installForUIProcessReinstall.
        man spawnNewProcess.
     
    ] forkAt:  Processor userInterruptPriority! !

!WorldMorph class methodsFor: 'system startup' stamp: 'StephaneDucasse 6/27/2013 17:00'!
cleanUp
	World cleanseOtherworldlySteppers.! !

!WorldState commentStamp: 'ls 7/10/2003 19:30'!
The state of a Morphic world.  (This needs some serious commenting!!!!)


The MinCycleLapse variable holds the minimum amount of time that a morphic cycle is allowed to take.  If a cycle takes less than this, then interCyclePause: will wait until the full time has been used up.!
!WorldState methodsFor: 'settings' stamp: 'AlainPlantec 12/14/2009 14:01'!
serverMode
	^ self class serverMode! !

!WorldState methodsFor: 'stepping' stamp: 'ar 10/22/2000 16:10'!
stopStepping: aMorph
	"Remove the given morph from the step list."
	lastStepMessage ifNotNil:[
		(lastStepMessage receiver == aMorph) ifTrue:[lastStepMessage := nil]].
	stepList removeAll: (stepList select:[:stepMsg| stepMsg receiver == aMorph]).
! !

!WorldState methodsFor: 'update cycle' stamp: 'alain.plantec 6/2/2008 08:45'!
handleFatalDrawingError: errMsg
	"Handle a fatal drawing error."
	Display deferUpdates: false. "Just in case"
	self primitiveError: errMsg.

	"Hm... we should jump into a 'safe' worldState here, but how do we find it?!!"! !

!WorldState methodsFor: 'deferred message' stamp: 'AlainPlantec 3/10/2015 20:17'!
defer: aValuable
	"aValuable will be executed in the next UI rendering cycle"
	self class defer: aValuable! !

!WorldState methodsFor: 'worldmenu building' stamp: 'MarcusDenker 9/29/2013 09:00'!
fallbackMenuOn: menu
	"Build the menu that is put up if something is going wrong with the menubuilder"
	
	menu addTitle: 'Fallback menu'.
	menu commandKeyHandler: self.
	menu addLine.
	menu
		defaultTarget: Smalltalk tools;
		addList: Smalltalk tools menuItems.
	menu addLine.
	menu add: 'Save'
		target: self class
		selector: #saveSession.
	menu add: 'Save as...'
		target: self class
		selector: #saveAs.
	menu add: 'Save and quit' 
		target: self class
		selector: #saveAndQuit.
	menu add: 'Quit' 
		target: self class
		selector: #quitSession.! !

!WorldState methodsFor: '*Morphic-Base' stamp: 'SeanDeNigris 6/14/2013 03:09'!
menuBuilder
	^ menuBuilder ifNil: [menuBuilder := PragmaMenuBuilder pragmaKeyword: self discoveredMenuPragmaKeyword model: self ]! !

!WorldState methodsFor: 'stepping' stamp: 'dgd 2/22/2003 13:31'!
runLocalStepMethodsIn: aWorld 
	"Run morph 'step' methods (LOCAL TO THIS WORLD) whose time has come. Purge any morphs that are no longer in this world.
	ar 3/13/1999: Remove buggy morphs from the step list so that they don't raise repeated errors."

	| now morphToStep stepTime priorWorld |
	now := Time millisecondClockValue.
	priorWorld := ActiveWorld.
	ActiveWorld := aWorld.
	self triggerAlarmsBefore: now.
	stepList isEmpty 
		ifTrue: 
			[ActiveWorld := priorWorld.
			^self].
	(now < lastStepTime or: [now - lastStepTime > 5000]) 
		ifTrue: [self adjustWakeupTimes: now].	"clock slipped"
	[stepList isEmpty not and: [stepList first scheduledTime < now]] 
		whileTrue: 
			[lastStepMessage := stepList removeFirst.
			morphToStep := lastStepMessage receiver.
			(morphToStep shouldGetStepsFrom: aWorld) 
				ifTrue: 
					[lastStepMessage value: now.
					lastStepMessage ifNotNil: 
							[stepTime := lastStepMessage stepTime ifNil: [morphToStep stepTime].
							lastStepMessage scheduledTime: now + (stepTime max: 1).
							stepList add: lastStepMessage]].
			lastStepMessage := nil].
	lastStepTime := now.
	ActiveWorld := priorWorld! !

!WorldState methodsFor: 'hands' stamp: 'ar 1/22/2001 14:26'!
removeHand: aHandMorph
	"Remove the given hand from the list of hands for this world."

	(hands includes: aHandMorph) ifFalse: [^self].
	hands := hands copyWithout: aHandMorph.
	ActiveHand == aHandMorph ifTrue: [ActiveHand := nil].
! !

!WorldState methodsFor: 'worldmenu building' stamp: 'SeanDeNigris 6/14/2013 02:53'!
discoveredMenuOn: aBuilder

	^ aBuilder menuEntitled: self discoveredMenuTitle! !

!WorldState methodsFor: 'canvas' stamp: 'ClementBera 7/26/2013 17:06'!
canvas: x 
	canvas := x.
	damageRecorder 
		ifNil: [damageRecorder := DamageRecorder new]
		ifNotNil: [damageRecorder doFullRepaint]! !

!WorldState methodsFor: 'initialization' stamp: 'StephaneDucasse 7/2/2013 16:48'!
initialize

	super initialize.
	hands := Array new.
	damageRecorder:= DamageRecorder new.
	stepList := Heap sortBlock: self stepListSortBlock.
	lastStepTime := 0.
	lastAlarmTime := 0.
	self viewBox: Display boundingBox! !

!WorldState methodsFor: 'update cycle' stamp: 'ar 1/22/2001 14:26'!
doOneSubCycleFor: aWorld
	"Like doOneCycle, but preserves activeHand."

	| currentHand |
	currentHand := ActiveHand.
	self doOneCycleFor: aWorld.
	ActiveHand := currentHand! !

!WorldState methodsFor: 'hands' stamp: 'GabrielOmarCotelli 11/30/2013 17:13'!
selectHandsToDrawForDamage: damageList
	"Select the set of hands that must be redrawn because either (a) the hand itself has changed or (b) the hand intersects some damage rectangle."

	^ hands
		select: [ :hand | hand needsToBeDrawn and: [ hand hasChanged or: [ self is: hand overlappingDamagedAreaIn: damageList ] ] ]! !

!WorldState methodsFor: 'cleaning' stamp: 'MarcusDenker 7/4/2014 15:42'!
cleanStepList
	"ensure that we have a cleaner block"
	^stepList sortBlock: self stepListSortBlock
! !

!WorldState methodsFor: 'stepping' stamp: 'ar 10/22/2000 16:09'!
isStepping: aMorph
	"Return true if the given morph is in the step list."
	lastStepMessage ifNotNil:[(lastStepMessage receiver == aMorph) ifTrue:[^true]].
	stepList do:[:entry| entry receiver == aMorph ifTrue:[^true]].
	^ false! !

!WorldState methodsFor: 'alarms' stamp: 'ar 9/11/2000 17:11'!
adjustAlarmTimes: nowTime
	"Adjust the alarm times after some clock weirdness (such as roll-over, image-startup etc)"
	| deltaTime |
	deltaTime := nowTime - lastAlarmTime.
	self alarms do:[:alarm| alarm scheduledTime: alarm scheduledTime + deltaTime].! !

!WorldState methodsFor: 'canvas' stamp: 'ar 1/30/2001 23:25'!
recordDamagedRect: damageRect

	damageRecorder ifNotNil: [damageRecorder recordInvalidRect: damageRect truncated]
! !

!WorldState methodsFor: 'hands' stamp: 'RAA 5/24/2000 12:09'!
handsReverseDo: aBlock

	^ hands reverseDo: aBlock! !

!WorldState methodsFor: 'initialization' stamp: 'sw 9/5/2000 06:39'!
stepListSize
	^ stepList size! !

!WorldState methodsFor: 'stepping' stamp: 'ar 10/22/2000 16:10'!
stopStepping: aMorph selector: aSelector
	"Remove the given morph from the step list."
	lastStepMessage ifNotNil:[
		(lastStepMessage receiver == aMorph and:[lastStepMessage selector == aSelector])
			ifTrue:[lastStepMessage := nil]].
	stepList removeAll: (stepList select:[:stepMsg| stepMsg receiver == aMorph and:[stepMsg selector == aSelector]]).! !

!WorldState methodsFor: 'worldmenu building' stamp: 'HilaireFernandes 9/9/2010 14:55'!
resetWorldMenu
	menuBuilder 
		ifNotNil: [menuBuilder reset.
			menuBuilder := nil]! !

!WorldState methodsFor: '*Morphic-Base' stamp: 'ar 9/11/2000 16:43'!
addAlarm: aSelector withArguments: argArray for: aTarget at: scheduledTime
	"Add a new alarm with the given set of parameters"
	self alarms add: 
		(MorphicAlarm 
			scheduledAt: scheduledTime
			receiver: aTarget
			selector: aSelector
			arguments: argArray).! !

!WorldState methodsFor: 'hands' stamp: 'di 6/7/1999 17:40'!
hands

	^ hands! !

!WorldState methodsFor: 'object filein' stamp: 'RAA 1/5/2001 10:51'!
convertAlarms
	
	alarms ifNotNil: [alarms sortBlock: self alarmSortBlock].	"ensure cleaner block"

! !

!WorldState methodsFor: 'stepping' stamp: 'nice 4/16/2009 19:03'!
stepListSortBlock
	^[ :stepMsg1 :stepMsg2 | 
		stepMsg1 scheduledTime <= stepMsg2 scheduledTime
	]! !

!WorldState methodsFor: 'stepping' stamp: 'ar 10/22/2000 16:05'!
listOfSteppingMorphs
	^stepList collect:[:entry| entry receiver].
! !

!WorldState methodsFor: 'canvas' stamp: 'RAA 5/25/2000 15:10'!
resetDamageRecorder

	damageRecorder reset
! !

!WorldState methodsFor: 'settings' stamp: 'AlainPlantec 12/10/2009 11:37'!
isEasySelecting
	^ self class easySelectingWorld! !

!WorldState methodsFor: 'stepping' stamp: 'BenComan 8/12/2014 00:11'!
runStepMethodsIn: aWorld
	"Perform periodic activity inbetween event cycles"
	
	| queue nextInQueue|
	"If available dispatch some deferred UI Message"
	queue := self class deferredUIMessages.
	[(nextInQueue := queue nextOrNil) isNil]
		whileFalse: [ nextInQueue value].
	self runLocalStepMethodsIn: aWorld.
	"The multi-threaded global Transcript needs to be updated periodically and synchronously with the UI."
	Transcript stepGlobal.! !

!WorldState methodsFor: 'update cycle' stamp: 'nice 1/5/2010 15:59'!
displayWorld: aWorld submorphs: submorphs
	"Update this world's display."

	| deferredUpdateMode handsToDraw allDamage |

	submorphs do: [:m | m fullBounds].  "force re-layout if needed"
	self checkIfUpdateNeeded ifFalse: [^ self].  "display is already up-to-date"

	deferredUpdateMode := self doDeferredUpdatingFor: aWorld.
	deferredUpdateMode ifFalse: [self assuredCanvas].
	canvas roundCornersOf: aWorld during:[ | worldDamageRects handDamageRects |
		worldDamageRects := self drawWorld: aWorld submorphs: submorphs invalidAreasOn: canvas.  "repair world's damage on canvas"
		"self handsDo:[:h| h noticeDamageRects: worldDamageRects]."
		handsToDraw := self selectHandsToDrawForDamage: worldDamageRects.
		handDamageRects := handsToDraw collect: [:h | h savePatchFrom: canvas].
		allDamage := worldDamageRects, handDamageRects.

		handsToDraw reverseDo: [:h | canvas fullDrawMorph: h].  "draw hands onto world canvas"
	].
	"*make this true to flash damaged areas for testing*"
	self class debugShowDamage ifTrue: [aWorld flashRects: allDamage color: Color black].

	canvas finish.
	"quickly copy altered rects of canvas to Display:"
	deferredUpdateMode
		ifTrue: [self forceDamageToScreen: allDamage]
		ifFalse: [canvas showAt: aWorld viewBox origin invalidRects: allDamage].
	handsToDraw do: [:h | h restoreSavedPatchOn: canvas].  "restore world canvas under hands"
	Display deferUpdates: false; forceDisplayUpdate.
! !

!WorldState methodsFor: 'hands' stamp: 'ar 10/26/2000 14:51'!
addHand: aHandMorph
	"Add the given hand to the list of hands for this world."

	hands := (hands copyWithout: aHandMorph) copyWith: aHandMorph.
! !

!WorldState methodsFor: 'alarms' stamp: 'GabrielOmarCotelli 11/30/2013 17:09'!
removeAlarm: aSelector for: aTarget
	"Remove the alarm with the given selector"

	self alarms
		detect: [ :any | any receiver == aTarget and: [ any selector == aSelector ] ]
		ifFound: [ :alarm | self alarms remove: alarm ]! !

!WorldState methodsFor: 'settings' stamp: 'SeanDeNigris 6/14/2013 01:52'!
discoveredMenuPragmaKeyword
	^ self class discoveredMenuPragmaKeyword! !

!WorldState methodsFor: 'canvas' stamp: 'stephane.ducasse 9/25/2008 18:10'!
assuredCanvas

	(canvas isNil or: [(canvas extent ~= viewBox extent) or: [canvas form depth ~= Display depth]])
		ifTrue:
			["allocate a new offscreen canvas the size of the window"
			self canvas: (Display defaultCanvasClass extent: viewBox extent)].
	^ self canvas! !

!WorldState methodsFor: 'alarms' stamp: 'nice 4/16/2009 19:03'!
alarmSortBlock
	^[ :alarm1 :alarm2 | 
		alarm1 scheduledTime < alarm2 scheduledTime.
	]! !

!WorldState methodsFor: 'canvas' stamp: 'di 6/7/1999 17:44'!
viewBox

	^ viewBox! !

!WorldState methodsFor: 'canvas' stamp: 'RAA 5/25/2000 15:12'!
doFullRepaint

	damageRecorder doFullRepaint
! !

!WorldState methodsFor: 'settings' stamp: 'SeanDeNigris 6/14/2013 02:15'!
discoveredMenuTitle
	^ self class discoveredMenuTitle! !

!WorldState methodsFor: 'canvas' stamp: 'di 6/7/1999 17:44'!
canvas

	^ canvas! !

!WorldState methodsFor: 'update cycle' stamp: 'MarcusDenker 7/9/2012 15:28'!
doDeferredUpdatingFor: aWorld
        "If this platform supports deferred updates, then make my canvas be the Display (or a rectangular portion of it), set the Display to deferred update mode, and answer true. Otherwise, do nothing and answer false. One can set the class variable DisableDeferredUpdates to true to completely disable the deferred updating feature."

	(Display deferUpdates: true) ifNil: [^ false].  "deferred updates not supported"
	(canvas notNil and: [canvas form == Display]) ifFalse: [
			aWorld viewBox: Display boundingBox.    "do first since it may clear canvas"
			self canvas: (Display getCanvas copyClipRect: Display boundingBox)].
	^ true
! !

!WorldState methodsFor: 'stepping' stamp: 'ar 10/22/2000 16:23'!
adjustWakeupTimes: now
	"Fix the wakeup times in my step list. This is necessary when this world has been restarted after a pause, say because some other view had control, after a snapshot, or because the millisecond clock has wrapped around. (The latter is a rare occurence with a 32-bit clock!!)"
	| deltaTime |
	deltaTime := now - lastStepTime.
	stepList do:[:entry| entry scheduledTime: entry scheduledTime + deltaTime].
	lastStepTime := now.
! !

!WorldState methodsFor: 'update cycle' stamp: 'nice 1/5/2010 15:59'!
drawWorld: aWorld submorphs: submorphs invalidAreasOn: aCanvas 
	"Redraw the damaged areas of the given canvas and clear the damage list. Return a collection of the areas that
were redrawn."

	| rectList n morphs rects validList |
	rectList := damageRecorder invalidRectsFullBounds: aWorld viewBox.
	"sort by areas to draw largest portions first"
	rectList := rectList asArray sort: [:r1 :r2 | r1 area > r2 area].
	damageRecorder reset.
	n := submorphs size.
	morphs := OrderedCollection new: n * 2.
	rects := OrderedCollection new: n * 2.
	validList := OrderedCollection new: n * 2.
	rectList do: 
			[:dirtyRect | 
			dirtyRect allAreasOutsideList: validList
				do: 
					[:r | | mm rect i c remnantIntersects remnants rectToFill | 
					"Experimental top-down drawing --
			Traverses top to bottom, stopping if the entire area is filled.
			If only a single rectangle remains, then continue with the reduced rectangle."

					rectToFill := r.
					remnants := OrderedCollection with: r.
					i := 1.
					[remnants isEmpty or: [i > n]] whileFalse: 
							[mm := submorphs at: i.
							((remnantIntersects := remnants select: [:each | (mm fullBounds intersects: each)]) notEmpty and: [mm visible]) 
								ifTrue: 
									[morphs addLast: mm.
									
									rects addLast: (Rectangle merging: (remnantIntersects collect: [:each | mm fullBounds intersect: each])).
									remnants removeAll: remnantIntersects.
									remnantIntersects do: [:eachIntersect | remnants addAll: (mm areasRemainingToFill: eachIntersect)].
									remnants size = 1 ifTrue: [rectToFill := remnants first].
									remnants isEmpty ifTrue: [rectToFill := nil]].
							i := i + 1].
					"Now paint from bottom to top, but using the reduced rectangles."
					rectToFill 
						ifNotNil: [aWorld drawOn: (c := aCanvas copyClipRect: rectToFill)].
					[morphs isEmpty] whileFalse: 
							[(rect := rects removeLast) == rectToFill 
								ifFalse: [c := aCanvas copyClipRect: (rectToFill := rect)].
							c fullDrawMorph: morphs removeLast].
					morphs reset.
					rects reset.
					validList add: r]].
	^validList! !

!WorldState methodsFor: 'stepping' stamp: 'ar 10/22/2000 15:22'!
adjustWakeupTimesIfNecessary
	"Fix the wakeup times in my step list if necessary. This is needed after a snapshot, after a long pause (say because some other view had control or because the user was selecting from an MVC-style menu) or when the millisecond clock wraps around (a very rare occurence with a 32-bit clock!!)."

	| now |
	now := Time millisecondClockValue.
	((now < lastStepTime) or: [(now - lastStepTime) > 5000])
		 ifTrue: [self adjustWakeupTimes: now].  "clock slipped"
! !

!WorldState methodsFor: 'update cycle' stamp: 'ar 6/28/2003 01:07'!
displayWorldSafely: aWorld
	"Update this world's display and keep track of errors during draw methods."

	[aWorld displayWorld] ifError: [:err :rcvr |
		"Handle a drawing error"
		| errCtx errMorph |
		errCtx := thisContext.
		[
			errCtx := errCtx sender.
			"Search the sender chain to find the morph causing the problem"
			[errCtx notNil and:[(errCtx receiver isMorph) not]] 
				whileTrue:[errCtx := errCtx sender].
			"If we're at the root of the context chain then we have a fatal drawing problem"
			errCtx ifNil:[^self handleFatalDrawingError: err].
			errMorph := errCtx receiver.
			"If the morph causing the problem has already the #drawError flag set,
			then search for the next morph above in the caller chain."
			errMorph hasProperty: #errorOnDraw
		] whileTrue.
		errMorph setProperty: #errorOnDraw toValue: true.
		"Install the old error handler, so we can re-raise the error"
		rcvr error: err.
	].! !

!WorldState methodsFor: 'hands' stamp: 'RAA 5/24/2000 10:13'!
handsDo: aBlock

	^ hands do: aBlock! !

!WorldState methodsFor: 'canvas' stamp: 'di 6/7/1999 17:58'!
viewBox: x

	viewBox := x! !

!WorldState methodsFor: 'alarms' stamp: 'RAA 1/5/2001 10:46'!
alarms

	^alarms ifNil: [alarms := Heap sortBlock: self alarmSortBlock]! !

!WorldState methodsFor: 'stepping' stamp: 'AlainPlantec 10/17/2009 19:02'!
cleanseStepListForWorld: aWorld
	"Remove morphs from the step list that are not in this World"

	| deletions morphToStep |
	deletions := nil.
	stepList do: [:entry |
		morphToStep := entry receiver.
		morphToStep world == aWorld ifFalse:[
			deletions ifNil: [deletions := OrderedCollection new].
			deletions addLast: entry]].

	deletions ifNotNil:[
		deletions do: [:entry|
			self stopStepping: entry receiver]].

	self alarms copy do:[:entry|
		morphToStep := entry receiver.
		(morphToStep isMorph and:[morphToStep world == aWorld]) 
			ifFalse:[self removeAlarm: entry selector for: entry receiver]].! !

!WorldState methodsFor: 'alarms' stamp: 'ar 10/22/2000 16:55'!
triggerAlarmsBefore: nowTime
	"Trigger all pending alarms that are to be executed before nowTime."
	| pending |
	lastAlarmTime ifNil:[lastAlarmTime := nowTime].
	(nowTime < lastAlarmTime or:[nowTime - lastAlarmTime > 10000])
		ifTrue:[self adjustAlarmTimes: nowTime].
	pending := self alarms.
	[pending isEmpty not and:[pending first scheduledTime < nowTime]]
		whileTrue:[pending removeFirst value: nowTime].
	lastAlarmTime := nowTime.! !

!WorldState methodsFor: 'stepping' stamp: 'ar 10/22/2000 16:09'!
isStepping: aMorph selector: aSelector
	"Return true if the given morph is in the step list."
	lastStepMessage ifNotNil:[
		(lastStepMessage receiver == aMorph and:[lastStepMessage selector == aSelector])
			ifTrue:[^true]].
	stepList do:[:entry| (entry receiver == aMorph and:[entry selector == aSelector]) ifTrue:[^true]].
	^ false! !

!WorldState methodsFor: 'update cycle' stamp: 'RAA 5/24/2000 13:13'!
checkIfUpdateNeeded

	damageRecorder updateIsNeeded ifTrue: [^true].
	hands do: [:h | (h hasChanged and: [h needsToBeDrawn]) ifTrue: [^true]].
	^false  "display is already up-to-date"
! !

!WorldState methodsFor: 'update cycle' stamp: 'BenComan 1/21/2015 00:03'!
interCyclePause: milliSecs
	"delay enough that the previous cycle plus the amount of delay will equal milliSecs.  If the cycle is already expensive, then no delay occurs.  However, if the system is idly waiting for interaction from the user, the method will delay for a proportionally long time and cause the overall CPU usage of Squeak to be low.
	If self serverMode returns true then, always do a complete delay of 50ms, independant of my argument. This prevents the freezing problem described in Mantis #6581"

	| wait wait2 |
	wait := self serverMode
    	ifTrue: [ 50 ]
    	ifFalse: 
		[	wait2 := (lastCycleTime notNil and: [CanSurrenderToOS ~~ false]) 
        		ifFalse: [ 0 ]
        		ifTrue: [ lastCycleTime + milliSecs - Time millisecondClockValue ].
 
      		self flag: 'Issue 14754 - wait2>millisecs is only True for clock rollover. Remove it once DelayScheduler based on microsecondClock - Ben Coman 19.01.2015'.
      		wait2 > milliSecs 
        		ifTrue: [ 0 ]
        		ifFalse: [ wait2 ]. 
		].
		
	wait > 0 ifTrue: 
	[	(Delay forMilliseconds: wait) waitOtherwise: [ self inform: 'WorldState>>interCyclePause failed.' ] 
	].

	lastCycleTime := Time millisecondClockValue.
	CanSurrenderToOS := true.! !

!WorldState methodsFor: 'worldmenu building' stamp: 'MarcusDenker 6/28/2013 12:48'!
worldMenu
	^self  menuBuilder menuEntitled: self discoveredMenuTitle.! !

!WorldState methodsFor: 'hands' stamp: 'GabrielOmarCotelli 11/30/2013 17:13'!
is: hand overlappingDamagedAreaIn: damageList
	| handBounds |
	handBounds := hand fullBounds.
	^ damageList anySatisfy: [ :r | r intersects: handBounds ]! !

!WorldState methodsFor: 'update cycle' stamp: 'stephane.ducasse 9/25/2008 18:11'!
forceDamageToScreen: allDamage

	Display forceDamageToScreen: allDamage.
	! !

!WorldState methodsFor: 'hands' stamp: 'ar 1/22/2001 14:26'!
activeHand

	^ ActiveHand! !

!WorldState methodsFor: 'update cycle' stamp: 'md 4/30/2008 16:33'!
doOneCycleNowFor: aWorld
	"Immediately do one cycle of the interaction loop.
	This should not be called directly, but only via doOneCycleFor:"

	DisplayScreen checkForNewScreenSize.

	"process user input events"
	LastCycleTime := Time millisecondClockValue.
	self handsDo: [:h |
		ActiveHand := h.
		h processEvents.
		ActiveHand := nil
	].

	"the default is the primary hand"
	ActiveHand := self hands first.

	aWorld runStepMethods.		"there are currently some variations here"
	self displayWorldSafely: aWorld.! !

!WorldState methodsFor: 'update cycle' stamp: 'adrian_lienhard 7/18/2009 15:30'!
doOneCycleFor: aWorld
	"Do one cycle of the interaction loop. This method is called repeatedly when the world is running. This is a moderately private method; a better alternative is usually either to wait for events or to check the state of things from #step methods."

	self interCyclePause: MinCycleLapse.
	self doOneCycleNowFor: aWorld.! !

!WorldState methodsFor: '*Morphic-Base' stamp: 'ar 10/22/2000 16:36'!
startStepping: aMorph at: scheduledTime selector: aSelector arguments: args stepTime: stepTime
	"Add the given morph to the step list. Do nothing if it is already being stepped."

	self stopStepping: aMorph selector: aSelector.
	self adjustWakeupTimesIfNecessary.
	stepList add:(
		StepMessage 
			scheduledAt: scheduledTime
			stepTime: stepTime
			receiver: aMorph
			selector: aSelector
			arguments: args)! !

!WorldState class methodsFor: 'settings' stamp: 'AlainPlantec 12/10/2009 11:34'!
easySelectingWorld: aBoolean
	EasySelectingWorld := aBoolean! !

!WorldState class methodsFor: 'settings' stamp: 'AlainPlantec 12/14/2009 14:02'!
serverMode
	^ ServerMode ifNil: [ServerMode := false]! !

!WorldState class methodsFor: 'world menu items' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
helpOn: aBuilder 

	<worldMenu>  
	(aBuilder item: #Help)
		order: 4.0;
		icon: Smalltalk ui icons smallHelpIcon;
		withSeparatorAfter 
		! !

!WorldState class methodsFor: 'deferred message' stamp: 'AlainPlantec 3/10/2015 20:17'!
defer: aValuable
	"aValuable will be executed in the next UI rendering cycle"
	self addDeferredUIMessage: aValuable.

! !

!WorldState class methodsFor: 'settings' stamp: 'SeanDeNigris 6/14/2013 02:15'!
discoveredMenuTitle
	^ DesktopMenuTitle ifNil: [DesktopMenuTitle := 'World']! !

!WorldState class methodsFor: 'world menu items' stamp: 'StephaneDucasse 11/11/2014 18:33'!
screenShotCommandOn: aBuilder 
	<worldMenu>
	(aBuilder item: #Screenshot)
		parent: #Tools;
		target: World;
		order: 0.59;
		selector: #makeAScreenshot;
		label: 'Screenshot';
		icon: Smalltalk ui icons smallScreenshotIcon! !

!WorldState class methodsFor: 'settings' stamp: 'AlainPlantec 4/15/2010 15:59'!
showUpdateOptionInWorldMenu: aBoolean
	ShowUpdateOptionInWorldMenu := aBoolean! !

!WorldState class methodsFor: 'settings' stamp: 'AlainPlantec 12/19/2009 23:56'!
desktopMenuTitle: aString
	DesktopMenuTitle := aString! !

!WorldState class methodsFor: 'accessing' stamp: 'RAA 7/23/2000 17:28'!
lastCycleTime

	^LastCycleTime! !

!WorldState class methodsFor: 'accessing' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
theme
	^ Smalltalk ui theme! !

!WorldState class methodsFor: 'initialization' stamp: 'IgorStasenko 6/22/2012 01:45'!
initialize
	"WorldState initialize"

	MinCycleLapse := 20.		"allows 50 frames per second..."
	DeferredUIMessages := nil.! !

!WorldState class methodsFor: 'testing os' stamp: 'RAA 8/14/2000 16:40'!
canSurrenderToOS: aBoolean

	CanSurrenderToOS := aBoolean! !

!WorldState class methodsFor: 'world menu items' stamp: 'SeanDeNigris 8/29/2011 17:33'!
clearHaltOnce
	Halt disableHaltOnce.
	World resetWorldMenu! !

!WorldState class methodsFor: 'world menu items' stamp: 'AndreiChis 3/19/2015 10:55'!
mostUsedToolsOn: aBuilder   
	<worldMenu>
	(aBuilder group: #MostUsedTools)
		withSeparatorAfter;
		order: 0;
		with: [
			(aBuilder item: #'System Browser') 
				action: [Smalltalk tools openClassBrowser]; 
				icon: Smalltalk tools browser taskbarIcon.
			(aBuilder item: Smalltalk tools workspace title asSymbol) 
				action: [Smalltalk tools openWorkspace]; 
				icon: Smalltalk tools workspace taskbarIcon.
			
			Smalltalk globals at: #TestRunner ifPresent: [ :class |
				(aBuilder item: #'Test Runner') 
					action: [Smalltalk tools openTestRunner]; 
					icon: class taskbarIcon ].
			Smalltalk globals at: #GTSpotter ifPresent: [ :class |
				(aBuilder item: #'Spotter') 
					action: [GTSpotterGlobalShortcut openGlobalSpotter]; 
					icon: FinderUI icon ].
			(aBuilder item: #'Monticello Browser') 
				action: [Smalltalk tools openMonticelloBrowser]; 
				icon: Smalltalk tools monticelloBrowser taskbarIcon]! !

!WorldState class methodsFor: 'deferred message' stamp: 'AlainPlantec 3/10/2015 20:18'!
addDeferredUIMessage: aValuable
	"aValuable will be executed in the next UI rendering cycle"
	self deferredUIMessages nextPut: aValuable

! !

!WorldState class methodsFor: 'settings' stamp: 'AlainPlantec 12/14/2009 14:07'!
serverMode: aBoolean
	(aBoolean = true or: [aBoolean = false or: [aBoolean isNil]])
		ifTrue: [ServerMode := aBoolean]! !

!WorldState class methodsFor: 'world menu items' stamp: 'EstebanLorenzano 5/14/2013 09:44'!
quitItemsOn: aBuilder 
	<worldMenu>
	(aBuilder group: #QuitPharo)
		order: 9999; 
		with: [
			(aBuilder item: #'Save')
				target: self;
				selector: #saveSession;
				help: 'save the current version of the image on disk';
				icon: Smalltalk ui icons smallSaveIcon.
			(aBuilder item: #'Save as...')
				target: self;
				selector: #saveAs;
				help: 'save the current version of the image on disk under a new name.';
				icon: Smalltalk ui icons smallSaveAsIcon.
			(aBuilder item: #'Save and quit')
				target: self;
				selector: #saveAndQuit;
				help: 'save the current image on disk, and quit Pharo.';
				icon: Smalltalk ui icons smallQuitIcon.
			(aBuilder item: #'Quit')
				target: self;
				selector: #quitSession;
				help: 'quit Pharo.';
				icon: Smalltalk ui icons smallQuitIcon ]! !

!WorldState class methodsFor: '*Morphic-Base' stamp: 'IgorStasenko 1/2/2012 19:09'!
startMessageTally
	(self confirm: 'MessageTally will start now,
and stop when the cursor goes
to the top of the screen' translated) 
		ifTrue: [TimeProfiler spyAllOn: [[World activeHand position y > 0] 
					whileTrue: [World doOneCycle]]]! !

!WorldState class methodsFor: 'world menu items' stamp: 'PavelKrivanek 7/13/2014 13:47'!
quitSession
	| save |
	save := UserManager default canSaveImage
		ifFalse: [ false ]
		ifTrue: [ self confirm: 'Save changes before quitting?' translated orCancel: [ ^ self ] ].
	save 
		ifTrue: [Cursor write showWhile: [ Smalltalk snapshot: true andQuit: true ]] 
		ifFalse: [Smalltalk snapshot: false andQuit: true]
 ! !

!WorldState class methodsFor: 'settings' stamp: 'AlainPlantec 12/10/2009 11:34'!
easySelectingWorld
	^ EasySelectingWorld ifNil: [EasySelectingWorld := false]! !

!WorldState class methodsFor: '*Morphic-Base' stamp: 'IgorStasenko 1/2/2012 19:10'!
startThenBrowseMessageTally
	"Tally only the UI process"
	
	(self confirm: 'MessageTally the UI process until the
mouse pointer goes to the top of the screen')
		ifTrue: [TimeProfiler
				onBlock: [[World activeHand position y > 10]
						whileTrue: [World doOneCycle]]]! !

!WorldState class methodsFor: '*Morphic-Base' stamp: 'SvenVanCaekenberghe 1/15/2014 19:17'!
windowsOn: aBuilder 
	<worldMenu>
	(aBuilder item: #Windows)
		order: 4.0;
		withSeparatorAfter ;
		icon: Smalltalk ui icons smallWindowIcon;
		with: [
			(aBuilder item: # 'Collapse all windows') 
				action: [World collapseAll];
				help: 'Reduce all open windows to collapsed forms that only show titles' translated.
			(aBuilder item: # 'Expand all windows') 
				action: [World expandAll];
				help: 'Expand all collapsed windows back to their expanded forms' translated.
			(aBuilder item: # 'Fit all windows') 
				action: [World fitAll];
				help: 'Fit all open windows as visible in World' translated.
			(aBuilder item: #'Close all debuggers') 
				action: [Smalltalk tools debugger closeAllDebuggers].
			(aBuilder item: # 'Send top window to back (\)') 
				action: [SystemWindow sendTopWindowToBack];
				help: 'Make the topmost window become the backmost one, and activate the window just beneath it.' translated.
			(aBuilder item: # 'Move windows onscreen') 
				action: [World bringWindowsFullOnscreen];
				help: 'Make all windows fully visible on the screen' translated.
			(aBuilder item: # 'Delete unchanged windows') 
				action: [World closeUnchangedWindows];
				help: 'Deletes all windows that do not have unsaved text edits.' translated.
			(aBuilder item: # 'Delete all windows discarding edits') 
				action: [World closeAllWindowsDiscardingChanges];
				help: 'Deletes all windows even if they have unsaved text edits.' translated.
			(aBuilder item: # 'Toggle full screen mode') 
				action: [Display toggleFullscreen];
				help: 'Turn full screen mode on when it is off, off when it is on.' translated.
			]! !

!WorldState class methodsFor: 'accessing' stamp: 'AlainPlantec 12/6/2009 21:40'!
MinCycleLapse: milliseconds
	"set the minimum amount of time that may transpire between two calls to doOneCycle"
	MinCycleLapse := milliseconds ifNotNil: [ milliseconds rounded ].! !

!WorldState class methodsFor: 'world menu items' stamp: ''!
saveSession
	Cursor write showWhile: [
		Smalltalk
			snapshot: true
			andQuit: false.
	]! !

!WorldState class methodsFor: 'world menu items' stamp: 'GuillermoPolito 3/16/2012 11:54'!
saveAndQuit
	Cursor write showWhile: [
		Smalltalk snapshot: true andQuit: true
	]! !

!WorldState class methodsFor: 'accessing' stamp: 'AlainPlantec 12/6/2009 21:42'!
debugShowDamage: aBoolean
	DebugShowDamage := aBoolean! !

!WorldState class methodsFor: 'deferred message' stamp: 'IgorStasenko 6/22/2012 01:42'!
deferredUIMessages

	^DeferredUIMessages ifNil: [DeferredUIMessages := WaitfreeQueue  new].
! !

!WorldState class methodsFor: 'accessing' stamp: 'AlainPlantec 12/6/2009 21:42'!
debugShowDamage
	^ DebugShowDamage ifNil: [DebugShowDamage := false]! !

!WorldState class methodsFor: 'world menu items' stamp: 'NicolaiHess 11/26/2014 11:29'!
saveAs
	| reference |
	reference := UIManager default fileSave: 'New File Name?' extensions: #('image') path: Smalltalk imageDirectory.
	reference ifNotNil: [ Smalltalk saveAs: reference parent / reference basenameWithoutExtension ]! !

!WorldState class methodsFor: 'world menu items' stamp: 'SeanDeNigris 8/29/2011 17:30'!
setHaltOnce
	Halt enableHaltOnce.
	World resetWorldMenu! !

!WorldState class methodsFor: 'settings' stamp: 'HilaireFernandes 9/9/2010 15:25'!
desktopMenuPragmaKeyword: aString
	DesktopMenuPragmaKeyword := aString.
	World resetWorldMenu.
! !

!WorldState class methodsFor: '*Morphic-Base' stamp: 'MarcusDenker 7/21/2014 11:38'!
systemOn: aBuilder 
	
	<worldMenu>  
	(aBuilder item: #System)
		order: 3.0;
		icon: Smalltalk ui icons smallConfigurationIcon;
		with: [
			(aBuilder item: #'About...') 
				order: 0;
				icon: Smalltalk ui icons smallLanguageIcon;
				action: [Smalltalk aboutThisSystem].
			(aBuilder item: #'Software update')
				order: 2;
				icon: Smalltalk ui icons smallUpdateIcon;
				precondition: [self showUpdateOptionInWorldMenu];
				action: [ UpdateStreamer new updateFromServer ];
				help: 'Load latest code updates via the internet';
			withSeparatorAfter.
			
			(aBuilder item: #'Start profiling all Processes') 
				action: [self startMessageTally].
			(aBuilder item: #'Start profiling UI ') 
				action: [self startThenBrowseMessageTally].
			(aBuilder item: #'Space left') 
				action: [Smalltalk informSpaceLeftAfterGarbageCollection].
			(aBuilder item: #'Do Image Cleanup') 
				action: [Smalltalk cleanUp: true ];
			withSeparatorAfter.
			
			
			(aBuilder item: #'Start drawing again') 
				action: [World  resumeAfterDrawError].
			(aBuilder item: #'Start stepping again') 
				action: [World  resumeAfterStepError]; 
			withSeparatorAfter.
			
			(aBuilder item: #'Restore display (r)') 
				action: [World restoreMorphicDisplay].
			Halt isHaltOnceEnabled
				ifTrue: [(aBuilder item: 'Disable halt/inspect once') action: [self clearHaltOnce]]
				ifFalse: [(aBuilder item: 'Enable halt/inspect once') action: [self setHaltOnce]]].! !

!WorldState class methodsFor: 'settings' stamp: 'HilaireFernandes 9/9/2010 15:25'!
defaultWorldMenu
	self desktopMenuTitle: 'World'.
	self desktopMenuPragmaKeyword: 'worldMenu'.! !

!WorldState class methodsFor: 'settings' stamp: 'AlainPlantec 4/15/2010 15:59'!
showUpdateOptionInWorldMenu
	^ ShowUpdateOptionInWorldMenu ifNil: [ShowUpdateOptionInWorldMenu := true]! !

!WorldState class methodsFor: 'settings' stamp: 'SeanDeNigris 6/14/2013 01:52'!
discoveredMenuPragmaKeyword
	^ DesktopMenuPragmaKeyword ifNil: [DesktopMenuPragmaKeyword := 'worldMenu']! !

!WriteStream commentStamp: '<historical>'!
I represent an accessor for a sequence of objects that can only store objects in the sequence.!
!WriteStream methodsFor: 'private' stamp: 'djp 11/6/1999 23:15'!
withAttributes: attributes do: strmBlock 
	"No-op here is overriden in TextStream for font emphasis"
	^ strmBlock value! !

!WriteStream methodsFor: 'character writing' stamp: 'eem 10/21/2010 10:22'!
ensureCr
	"Append a cr character to the receiver IFF there is not one on the end."

	self ensureEndsWith: Character cr! !

!WriteStream methodsFor: 'filein/out' stamp: 'PavelKrivanek 4/26/2013 11:35'!
nextChunkPut: aString
	"Append the argument, aString, to the receiver, doubling embedded terminators."
 
	| i remainder terminator | 
	terminator := $!!.
	remainder := aString asString.
	[(i := remainder indexOf: terminator) = 0] whileFalse:
		[self nextPutAll: (remainder copyFrom: 1 to: i).
		self nextPut: terminator.  "double imbedded terminators"
		remainder := remainder copyFrom: i+1 to: remainder size].
	self nextPutAll: remainder. 
	aString asString includesUnifiedCharacter ifTrue: [
		self nextPut: terminator.
		self nextPutAll: ']lang['.
		aString asString writeLeadingCharRunsOn: self.
	].
	self nextPut: terminator.
	self flush.! !

!WriteStream methodsFor: 'private' stamp: 'nice 2/26/2009 11:26'!
pastEndPut: anObject
	"Grow the collection by doubling the size, but keeping the growth between 20 and 1000000.
	Then put <anObject> at the current write position."

	collection := collection grownBy: ((collection size max: 20) min: 1000000).
	writeLimit := collection size.
	collection at: (position := position + 1) put: anObject.
	^ anObject! !

!WriteStream methodsFor: 'character writing' stamp: ''!
crtab
	"Append a return character, followed by a single tab character, to the 
	receiver."

	self nextPut: Character cr.
	self nextPut: Character tab! !

!WriteStream methodsFor: 'character writing' stamp: 'ul 12/2/2009 05:47'!
crlf
	"Append a line feed character to the receiver."

	self nextPut: Character cr; nextPut: Character lf! !

!WriteStream methodsFor: 'accessing' stamp: ''!
next

	self shouldNotImplement! !

!WriteStream methodsFor: 'character writing' stamp: 'tk 9/23/2001 01:16'!
ensureNoSpace
	"If there is not one on the end, remove it."

	(position > 0 and: [(collection at: position) = Character space]) 
		ifTrue: [self skip: -1].! !

!WriteStream methodsFor: 'positioning' stamp: ''!
position: anInteger 
	"Refer to the comment in PositionableStream|position:."

	readLimit := readLimit max: position.
	super position: anInteger! !

!WriteStream methodsFor: 'private' stamp: 'di 11/18/1999 22:50'!
braceArray: anArray
	"This method is used in compilation of brace constructs.
	It MUST NOT be deleted or altered."

	collection := anArray.
	position := 0.
	readLimit := 0.
	writeLimit := anArray size.! !

!WriteStream methodsFor: 'printing' stamp: 'MarcusDenker 7/24/2014 17:01'!
<< aCollection
	"we want a readable version of nextPutAll, that also works with non Collection arguments"

	collection class == aCollection class ifFalse:
		[ aCollection putOn: self. ^ self ].

	self nextPutAll: aCollection
! !

!WriteStream methodsFor: 'character writing' stamp: 'tk 10/19/2001 11:12'!
peekLast
	"Return that item just put at the end of the stream"

	^ position > 0 
		ifTrue: [collection at: position]
		ifFalse: [nil]! !

!WriteStream methodsFor: 'printing' stamp: ''!
store: anObject 
	"Have anObject print on the receiver for purposes of rereading."

	anObject storeOn: self! !

!WriteStream methodsFor: 'accessing' stamp: 'LukasRenggli 5/8/2010 18:40'!
nextPutAll: aCollection
 
 	| newEnd |
 	collection class == aCollection class ifFalse:
 		[^ super nextPutAll: aCollection ].
 
 	newEnd := position + aCollection size.
 	newEnd > writeLimit ifTrue:
 		[self growTo: newEnd + 10].
 
 	collection replaceFrom: position+1 to: newEnd  with: aCollection startingAt: 1.
 	position := newEnd.
	
	^ aCollection! !

!WriteStream methodsFor: 'character writing' stamp: 'JF 7/31/2003 13:00'!
tab: anInteger 
	"Append anInteger tab characters to the receiver."

	anInteger timesRepeat: [self tab]! !

!WriteStream methodsFor: 'private' stamp: ''!
on: aCollection

	super on: aCollection.
	readLimit := 0.
	writeLimit := aCollection size! !

!WriteStream methodsFor: 'private' stamp: 'di 11/18/1999 22:55'!
braceArray
	"This method is used in compilation of brace constructs.
	It MUST NOT be deleted or altered."

	^ collection! !

!WriteStream methodsFor: 'filein/out' stamp: 'StephaneDucasse 3/17/2010 21:23'!
timeStamp
	"Append the current time to the receiver as a String."
	self nextChunkPut:	"double string quotes and !!s"
		(String streamContents: [:s | Smalltalk timeStamp: s]) printString.
	self cr! !

!WriteStream methodsFor: 'positioning' stamp: 'ajh 5/25/2001 20:19'!
setToEnd 
	"Refer to the comment in PositionableStream|setToEnd."

	readLimit := readLimit max: position.
	super setToEnd.! !

!WriteStream methodsFor: 'private' stamp: ''!
withAttribute: att do: strmBlock 
	"No-op here is overriden in TextStream for font emphasis"
	^ strmBlock value! !

!WriteStream methodsFor: 'character writing' stamp: ''!
tab
	"Append a tab character to the receiver."

	self nextPut: Character tab! !

!WriteStream methodsFor: 'filein/out' stamp: 'StephaneDucasse 9/12/2010 09:50'!
nextChunkPutWithStyle: aString
	"Deprecated.  Append the argument, aText, to the receiver, doubling embedded terminators.  Put out one chunk for the string and one for the style runs.  Mark the style with ]style[."
 
	^ self nextChunkPut: aString asString.
! !

!WriteStream methodsFor: 'character writing' stamp: ''!
cr
	"Append a return character to the receiver."

	self nextPut: Character cr! !

!WriteStream methodsFor: '*AsmJit-Extension' stamp: 'CamilloBruni 8/23/2012 15:55'!
asLineStream
	^ AJLineStream on: self! !

!WriteStream methodsFor: 'accessing' stamp: ''!
size

	^readLimit := readLimit max: position! !

!WriteStream methodsFor: 'character writing' stamp: 'ul 12/2/2009 05:47'!
lf
	"Append a line feed character to the receiver."

	self nextPut: Character lf! !

!WriteStream methodsFor: '*Fuel' stamp: 'MartinDias 8/13/2011 14:28'!
nextBytesPutAll: aCollection
	"Append the bytes of aCollection to the sequence of bytes accessible 
	by the receiver. Answer aCollection."
 
 	| newEnd |
 	collection class instSpec == aCollection class instSpec ifFalse:
 		[^ super nextPutAll: aCollection ].
 
 	newEnd := position + aCollection size.
 	newEnd > writeLimit ifTrue:
 		[self growTo: newEnd + 10].
 
 	collection replaceFrom: position+1 to: newEnd  with: aCollection startingAt: 1.
 	position := newEnd.
	
	^ aCollection! !

!WriteStream methodsFor: 'accessing' stamp: 'Henrik Sperre Johansen 8/13/2009 12:16'!
nextPut: anObject 
	"Primitive. Insert the argument at the next position in the Stream
	represented by the receiver. Fail if the collection of this stream is not an
	Array or a String. Fail if the stream is positioned at its end, or if the
	position is out of bounds in the collection. Fail if the argument is not
	of the right type for the collection. Optional. See Object documentation
	whatIsAPrimitive."

	<primitive: 66>
	position >= writeLimit
		ifTrue: [^ self pastEndPut: anObject]
		ifFalse: 
			[position := position + 1.
			^collection at: position put: anObject]! !

!WriteStream methodsFor: 'private' stamp: ''!
with: aCollection

	super on: aCollection.
	position := readLimit := writeLimit := aCollection size! !

!WriteStream methodsFor: 'positioning' stamp: ''!
reset 
	"Refer to the comment in PositionableStream|reset."

	readLimit := readLimit max: position.
	position := 0! !

!WriteStream methodsFor: 'character writing' stamp: ''!
space
	"Append a space character to the receiver."

	self nextPut: Character space! !

!WriteStream methodsFor: 'character writing' stamp: 'RAA 3/5/2001 10:26'!
ensureASpace
	"Append a space character to the receiver IFF there is not one on the end."

	(position > 0 and: [(collection at: position) = Character space]) ifTrue: [^self].
	self nextPut: Character space! !

!WriteStream methodsFor: 'positioning' stamp: 'ar 11/12/1998 21:27'!
resetToStart
	readLimit := position := 0.! !

!WriteStream methodsFor: 'accessing' stamp: 'dc 2/11/2007 14:18'!
ensureEndsWith: anObject
	"Append anObject to the receiver IFF there is not one on the end."

	(position > 0 and: [(collection at: position) = anObject]) ifTrue: [^self].
	self nextPut: anObject! !

!WriteStream methodsFor: 'private' stamp: ''!
on: aCollection from: firstIndex to: lastIndex

	| len |
	collection := aCollection.
	readLimit := 
		writeLimit := lastIndex > (len := collection size)
						ifTrue: [len]
						ifFalse: [lastIndex].
	position := firstIndex <= 1
				ifTrue: [0]
				ifFalse: [firstIndex - 1]! !

!WriteStream methodsFor: 'accessing' stamp: 'yo 2/18/2004 14:41'!
next: anInteger putAll: aCollection startingAt: startIndex
	"Store the next anInteger elements from the given collection."

	| newEnd numPut |
	collection class == aCollection class ifFalse:
		[^ super next: anInteger putAll: aCollection startingAt: startIndex ].

	numPut := anInteger min: (aCollection size - startIndex + 1).
	newEnd := position + numPut.
	newEnd > writeLimit ifTrue:
		[^ super next: anInteger putAll: aCollection startingAt: startIndex "Trigger normal pastEndPut: logic"].

	collection replaceFrom: position+1 to: newEnd with: aCollection startingAt: startIndex.
	position := newEnd.
! !

!WriteStream methodsFor: 'character writing' stamp: ''!
crtab: anInteger 
	"Append a return character, followed by anInteger tab characters, to the 
	receiver."

	self nextPut: Character cr.
	anInteger timesRepeat: [self nextPut: Character tab]! !

!WriteStream methodsFor: 'accessing' stamp: ''!
contents

	readLimit := readLimit max: position.
	^collection copyFrom: 1 to: position! !

!WriteStream methodsFor: 'character writing' stamp: 'JF 7/31/2003 13:01'!
space: anInteger 
	"Append anInteger space characters to the receiver."

	anInteger timesRepeat: [self space]! !

!WriteStream methodsFor: 'private' stamp: 'CamilloBruni 6/22/2012 21:17'!
growTo: anInteger
 
    " anInteger is the required minimal new size of the collection "
 	| oldSize length |
 	oldSize := collection size.
      length := anInteger + (oldSize // 4 max: 20) - oldSize.
 	collection := collection grownBy: length.
 	writeLimit := collection size.
 ! !

!WriteStream class methodsFor: 'instance creation' stamp: ''!
with: aCollection from: firstIndex to: lastIndex 
	"Answer an instance of me on the subcollection of the argument, 
	aCollection, determined by the indices firstIndex and lastIndex. Position 
	the instance to store at the end of the subcollection."

	^self basicNew with: (aCollection copyFrom: firstIndex to: lastIndex)! !

!WriteStream class methodsFor: 'instance creation' stamp: ''!
on: aCollection from: firstIndex to: lastIndex 
	"Answer an instance of me on a copy of the argument, aCollection, 
	determined by the indices firstIndex and lastIndex. Position the instance 
	at the beginning of the collection."

	^self basicNew
		on: aCollection
		from: firstIndex
		to: lastIndex! !

!WriteStream class methodsFor: 'instance creation' stamp: ''!
with: aCollection 
	"Answer an instance of me on the argument, aCollection, positioned to 
	store objects at the end of aCollection."

	^self basicNew with: aCollection! !

!WriteStreamTest commentStamp: 'TorstenBergmann 2/20/2014 15:36'!
A trait for test purposes!
!WriteStreamTest methodsFor: 'testing' stamp: 'PeterHugossonMiller 9/3/2009 11:47'!
testEnsureASpace2
	"self debug: #testEnsureASpace2"
	| stream |
	stream := String new writeStream.
	stream ensureASpace.
	self assert: stream contents = ' '.
	! !

!WriteStreamTest methodsFor: 'testing' stamp: 'DamienCassou 9/26/2014 14:34'!
testContentsReturnCollectionOfCorrectSizeAfterSettingPosition
	| stream data finalPosition |
	stream := WriteStream on: String new.
	data := 'abcd'.
	finalPosition := 3.
	stream nextPutAll: data.
	stream position: finalPosition.
	self assert: stream contents equals: (data first: finalPosition)! !

!WriteStreamTest methodsFor: 'testing' stamp: 'DamienCassou 9/26/2014 14:33'!
testContentsReturnCollectionOfCorrectSize
	| stream data |
	stream := WriteStream on: String new.
	data := 'abcd'.
	stream nextPutAll: data.
	self assert: stream contents equals: data! !

!WriteStreamTest methodsFor: 'testing' stamp: 'PeterHugossonMiller 9/3/2009 11:47'!
testEnsureASpace
	"self debug: #testEnsureASpace"
	| stream |
	stream := String new writeStream.
	stream nextPutAll: 'this is a test'.
	stream ensureASpace.
	stream nextPutAll: 'for WriteStreamTest'.
	self assert: stream contents = 'this is a test for WriteStreamTest'.
	
	"Manually put a space and verify there are no 2 consecutive spaces"
	stream := String new writeStream.
	stream nextPutAll: 'this is a test '.
	stream ensureASpace.
	stream nextPutAll: 'for WriteStreamTest'.
	self assert: stream contents = 'this is a test for WriteStreamTest'.! !

!WriteStreamTest methodsFor: 'tests - testing' stamp: 'PeterHugossonMiller 9/3/2009 11:48'!
testIsEmpty
	| stream |
	stream := String new writeStream.
	self assert: stream isEmpty.
	stream nextPut: $a.
	self deny: stream isEmpty.
	stream reset.
	self deny: stream isEmpty.! !

!WriteStreamTest methodsFor: 'testing' stamp: 'sd 6/5/2005 09:24'!
testSetToEnd

	| string stream |
	string := 'hello'.
	stream := WriteStream with: ''.
	stream nextPutAll: string.
	self assert: stream position = string size.
	stream setToEnd.
	self assert: stream position = string size.
	self assert: stream contents = string! !

!WriteStreamTest methodsFor: 'testing' stamp: 'PeterHugossonMiller 9/3/2009 11:48'!
testEnsureEndsWith
	"self debug: #testEnsureEndsWith"
	| stream |
	stream := String new writeStream.
	stream nextPutAll: 'this is a test'.
	stream ensureEndsWith: Character cr.
	stream nextPutAll: 'for WriteStreamTest'.
	self assert: stream contents = (('this is a test' copyWith: Character cr), 'for WriteStreamTest').
	
	"Manually put a new line and verify there are no 2 new lines"
	stream := String new writeStream.
	stream nextPutAll: ('this is a test' copyWith: Character cr).
	stream ensureEndsWith: Character cr.
	stream nextPutAll: 'for WriteStreamTest'.
	self assert: stream contents = (('this is a test' copyWith: Character cr), 'for WriteStreamTest').! !

!WriteStreamTest methodsFor: 'testing' stamp: 'sd 6/5/2005 09:24'!
testNew

	self should: [WriteStream new] raise: Error. ! !

!X11Encoding commentStamp: 'TorstenBergmann 2/5/2014 09:57'!
X11 encoding!
!X11Encoding class methodsFor: 'accessing' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'!
setTextEnc: encoding
	<primitive: 'primSetTextEnc' module: 'ImmX11Plugin'>
	^ nil
! !

!X11Encoding class methodsFor: 'accessing' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'!
setXWinEnc: encoding
	<primitive: 'primSetXWinEnc' module: 'ImmX11Plugin'>
	^ nil
! !

!X11Encoding class methodsFor: 'accessing' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'!
requestUTF8: bool
	<primitive: 'primSetTextEncUTF8' module: 'ImmX11Plugin'>
	^ nil
! !

!X11Encoding class methodsFor: 'accessing' stamp: 'sd 2/4/2008 21:21'!
encoding

	| enc |
	enc := self getEncoding.
	enc ifNil: [ ^ nil ].
	^ enc asLowercase.! !

!X11Encoding class methodsFor: 'accessing' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'!
setEncodingToLocale
	<primitive: 'primSetEncodingToLocale' module: 'ImmX11Plugin'>
	^ nil
! !

!X11Encoding class methodsFor: 'accessing' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'!
setTextEncToLocale
	<primitive: 'primSetTextEncToLocale' module: 'ImmX11Plugin'>
	^ nil
! !

!X11Encoding class methodsFor: 'accessing' stamp: 'Tsutomu Hiroshima 12/5/2003 15:09'!
getEncoding
	<primitive: 'primGetEncoding' module: 'ImmX11Plugin'>
	^ nil
! !

!X11Encoding class methodsFor: 'accessing' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'!
getPathEnc
	<primitive: 'primGetPathEnc' module: 'ImmX11Plugin'>
	^ nil
! !

!X11Encoding class methodsFor: 'accessing' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'!
getLocaleEncoding
	<primitive: 'primGetLocaleEncoding' module: 'ImmX11Plugin'>
	^ nil
! !

!X11Encoding class methodsFor: 'accessing' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'!
requestUTF8
	<primitive: 'primIsTextEncUTF8' module: 'ImmX11Plugin'>
	^ nil
! !

!X11Encoding class methodsFor: 'accessing' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'!
setPathEnc: encoding
	<primitive: 'primSetPathEnc' module: 'ImmX11Plugin'>
	^ nil
! !

!X11Encoding class methodsFor: 'accessing' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'!
setXWinEncToLocale
	<primitive: 'primSetXWinEncToLocale' module: 'ImmX11Plugin'>
	^ nil
! !

!X11Encoding class methodsFor: 'accessing' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'!
setPathEncToLocale
	<primitive: 'primSetPathEncToLocale' module: 'ImmX11Plugin'>
	^ nil
! !

!X11Encoding class methodsFor: 'accessing' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'!
getXWinEnc
	<primitive: 'primGetXWinEnc' module: 'ImmX11Plugin'>
	^ nil
! !

!X11Encoding class methodsFor: 'accessing' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'!
setEncoding: encoding
	<primitive: 'primSetEncoding' module: 'ImmX11Plugin'>
	^ nil
! !

!X11Encoding class methodsFor: 'accessing' stamp: 'Tsutomu Hiroshima 12/5/2003 15:07'!
getTextEnc
	<primitive: 'primGetTextEnc' module: 'ImmX11Plugin'>
	^ nil
! !

!X11Encoding class methodsFor: 'accessing' stamp: 'mir 7/15/2004 18:57'!
useEncoding: encoding

	self setEncoding: encoding.
	LanguageEnvironment startUp.
	^ self encoding.! !

!X11Encoding class methodsFor: 'accessing' stamp: 'mir 7/15/2004 18:57'!
useLocaleEncoding

	self setEncodingToLocale.
	LanguageEnvironment startUp.
	^ self encoding.! !

!Year commentStamp: 'marcus.denker 6/5/2009 11:24'!
I represent a year.!
!Year methodsFor: 'changes' stamp: 'StephaneDucasse 3/13/2010 13:29'!
previous
	"This implementation handles leap years correctly"
	
	^ self class year: (self year - 1)! !

!Year methodsFor: 'conversion' stamp: 'brp 5/13/2003 09:01'!
asYear 

	^ self ! !

!Year methodsFor: 'accessing' stamp: 'CamilloBruni 8/22/2013 19:21'!
firstThursday
	"Return the years first Thursday.
	According to the ISO 8601 definition, the first week starts with the years first Thursday (week day number 5)"
	 ^ self start + (5 - self start dayOfWeek) days! !

!Year methodsFor: 'accessing' stamp: 'brp 5/13/2003 09:01'!
daysInMonth 

	self shouldNotImplement  ! !

!Year methodsFor: 'printing' stamp: 'brp 5/21/2003 08:38'!
printOn: aStream

	aStream nextPutAll: 'a Year ('.
 	self start year printOn: aStream. 
	aStream nextPutAll: ')'.
! !

!Year methodsFor: 'accessing' stamp: 'brp 5/13/2003 09:01'!
daysInYear

	^ self duration days.! !

!Year class methodsFor: 'accessing' stamp: 'brp 5/13/2003 09:00'!
isLeapYear: aYearInteger


	| adjustedYear |
	adjustedYear := aYearInteger > 0
		ifTrue: [aYearInteger]
		ifFalse: [(aYearInteger + 1) negated].

	"There was no year 0"
	^ ((adjustedYear \\ 4 ~= 0) or: [(adjustedYear \\ 100 = 0) and: [adjustedYear \\ 400 ~= 0]]) not.! !

!Year class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/22/2013 18:54'!
starting: aDateAndTime duration: aDuration 
	"Return a new year, starting from the beginning the year the given DateAndTime is in."
	| aYear |
	aYear := aDateAndTime asDateAndTime year.

	^ super
		starting: (DateAndTime year: aYear month: 1 day: 1)
		duration: (Duration days: (self daysInYear: aYear)).! !

!Year class methodsFor: 'accessing' stamp: 'brp 7/1/2003 13:52'!
daysInYear: yearInteger

	^ 365 + ((self isLeapYear: yearInteger) ifTrue: [1] ifFalse: [0]).
! !

!Year class methodsFor: 'instance creation' stamp: 'brp 5/13/2003 09:00'!
year: aYear

	^ self starting: (DateAndTime year: aYear month: 1 day: 1).! !

!YearMonthWeekTest commentStamp: 'tlk 1/6/2004 17:55'!
I am one of several Sunit test Cases intentended to provide complete coverage for the Chronology set of classes as part of the external testing. See DateAndEpochTestCase for a complete list.  tlk.
I have no fixtures but do make sure to restore anything I change.!
!YearMonthWeekTest methodsFor: 'tests' stamp: 'damiencassou 5/30/2008 11:09'!
testYearPrintOn
	| aYear cs rw |
	aYear := Year 
		starting: DateAndTime new
		duration: 365 days.
	cs := 'a Year (1901)' readStream.
	rw := ReadWriteStream on: ''.
	aYear printOn: rw.
	self assert: rw contents = cs contents! !

!YearMonthWeekTest methodsFor: 'tests' stamp: 'tlk 1/3/2004 13:37'!
testIndexOfDay
	self assert: (Week indexOfDay: 'Friday') = 6.

! !

!YearMonthWeekTest methodsFor: 'tests' stamp: 'tlk 1/3/2004 12:37'!
testDaysInYear
	self assert: (Year daysInYear: 2000) = 366.
	self assert: (Year daysInYear: 2001) = 365.
	self assert: (Year daysInYear: 2004) = 366.
	self assert: (Year daysInYear: 2100) = 365.
	self assert: (Year daysInYear: 2003) = 365.! !

!YearMonthWeekTest methodsFor: 'tests' stamp: 'tlk 1/3/2004 13:34'!
testStartDay
	Week startDay: 'Wednesday'.
	self assert: Week startDay = 'Wednesday'.
	Week startDay: 'Thursday'.
	self assert: Week startDay = 'Thursday'.

! !

!YearMonthWeekTest methodsFor: 'running' stamp: 'brp 9/26/2004 19:27'!
tearDown
	Week startDay: restoredStartDay.
	DateAndTime localTimeZone: restoredTimeZone.! !

!YearMonthWeekTest methodsFor: 'tests' stamp: 'damiencassou 5/30/2008 11:09'!
testMonthPrintOn
	| aMonth cs rw |
	aMonth := Month 
		starting: DateAndTime new
		duration: 31 days.
	cs := 'January 1901' readStream.
	rw := ReadWriteStream on: ''.
	aMonth printOn: rw.
	self assert: rw contents = cs contents! !

!YearMonthWeekTest methodsFor: 'tests' stamp: 'PeterHugossonMiller 9/3/2009 11:51'!
testWeekPrintOn
	| aWeek cs rw |
	aWeek := Week starting: (DateAndTime year: 1900 month: 12 day: 31).
	cs := 'a Week starting: 1900-12-30T00:00:00+00:00'.
	rw := String new writeStream.
	aWeek printOn: rw.
	self assert: rw contents = cs! !

!YearMonthWeekTest methodsFor: 'tests' stamp: 'tlk 1/3/2004 12:33'!
testIsLeapYear
	self assert: (Year isLeapYear: 2000).
	self deny: (Year isLeapYear: 2001).
	self assert: (Year isLeapYear: 2004).
	self deny: (Year isLeapYear: 2100).
	self deny: (Year isLeapYear: 2002).! !

!YearMonthWeekTest methodsFor: 'tests' stamp: 'tlk 1/3/2004 12:51'!
testDaysInMonth
	self assert: (Month daysInMonth: 2 forYear: 2000) = 29.
	self assert: (Month daysInMonth: 2 forYear: 2001) = 28.
	self assert: (Month  daysInMonth: 2 forYear: 2004) = 29.
	self assert: (Month  daysInMonth: 2 forYear: 2100) = 28.
	
	self assert: (Month  daysInMonth: 'January' forYear: 2003) = 31.
	self assert: (Month  daysInMonth: 'February' forYear: 2003) = 28.
	self assert: (Month  daysInMonth: 'March' forYear: 2003) = 31.
	self assert: (Month  daysInMonth: 'April' forYear: 2003) = 30.
	self assert: (Month  daysInMonth: 'May' forYear: 2003) = 31.
	self assert: (Month  daysInMonth: 'June' forYear: 2003) = 30.
	self assert: (Month  daysInMonth: 'July' forYear: 2003) = 31.
	self assert: (Month  daysInMonth: 'August' forYear: 2003) = 31.
	self assert: (Month  daysInMonth: 'September' forYear: 2003) = 30.
	self assert: (Month  daysInMonth: 'October' forYear: 2003) = 31.
	self assert: (Month  daysInMonth: 'November' forYear: 2003) = 30.
	self assert: (Month  daysInMonth: 'December' forYear: 2003) = 31.! !

!YearMonthWeekTest methodsFor: 'running' stamp: 'brp 9/26/2004 19:26'!
setUp
	restoredStartDay := Week startDay.
	restoredTimeZone := DateAndTime localTimeZone.

	Week startDay: #Sunday.
	DateAndTime localTimeZone: (TimeZone timeZones detect: [:tz | tz abbreviation = 'GMT']).! !

!YearTest commentStamp: 'TorstenBergmann 2/5/2014 08:48'!
SUnit tests for year handling!
!YearTest methodsFor: 'tests' stamp: 'StephaneDucasse 3/13/2010 13:31'!
testPreviousInLeapYear
	"self debug: #testPreviousInLeapYear"
	
	| leap |
	leap := Year year: 2008.
	self assert: leap isLeapYear. 
	self assert: (Year year: (leap year - 1)) = leap previous ! !

!YearTest methodsFor: 'coverage' stamp: 'brp 9/11/2003 14:31'!
classToBeTested

	^ Year! !

!YearTest methodsFor: 'tests' stamp: 'StephaneDucasse 3/13/2010 13:30'!
testStart
	"self debug: #testStart"
	
	| yyyy |
	yyyy := DateAndTime now year.
	self assert: Year current start = (DateAndTime year: yyyy month: 1 day: 1)! !

!ZLibReadStream commentStamp: 'TorstenBergmann 2/3/2014 23:03'!
A ZLib read stream!
!ZLibReadStream methodsFor: 'crc' stamp: 'MaxLeske 7/8/2013 21:20'!
updateCrc: oldCrc from: start to: stop in: aCollection
	"Answer an updated CRC for the range of bytes in aCollection"
	^ Adler32 update: oldCrc from: start to: stop in: aCollection! !

!ZLibReadStream methodsFor: 'crc' stamp: 'ar 2/29/2004 04:21'!
verifyCrc
	| stored |
	stored := 0.
	24 to: 0 by: -8 do: [ :i |
		sourcePos >= sourceLimit ifTrue: [ ^ self crcError: 'No checksum (proceed to ignore)' ].
		stored := stored + (self nextByte bitShift: i) ].
	stored = crc ifFalse: [ ^ self crcError: 'Wrong checksum (proceed to ignore)' ].
	^stored! !

!ZLibReadStream methodsFor: 'initialize' stamp: 'ar 2/29/2004 03:31'!
on: aCollection from: firstIndex to: lastIndex
	"Check the header of the ZLib stream."
	| method byte |
	super on: aCollection from: firstIndex to: lastIndex.
	crc := 1.
	method := self nextBits: 8.
	(method bitAnd: 15) = 8 ifFalse:[^self error:'Unknown compression method'].
	(method bitShift: -4) + 8 > 15 ifTrue:[^self error:'Invalid window size'].
	byte := self nextBits: 8.
	(method bitShift: 8) + byte \\ 31 = 0 ifFalse:[^self error:'Incorrect header'].
	(byte anyMask: 32) ifTrue:[^self error:'Need preset dictionary'].
! !

!ZLibWriteStream commentStamp: '<historical>'!
I use the zlib implementation of the deflate algorithm to compress a ByteArray. According to Wikipedia, "this algorithm provides good compression on a wide variety of data with minimal use of system resources." See http://en.wikipedia.org/wiki/DEFLATE for details on the deflate algorithm.

This is how you get a compressed ByteArray from your input:
zipStream := ZLibWriteStream on: (ByteArray new).
zipStream 
	nextPutAll: myByteArray;
	close.
compressed := zipStream encodedStream contents.!
!ZLibWriteStream methodsFor: 'initialization' stamp: 'MaxLeske 7/8/2013 21:21'!
updateCrc: adler from: start to: stop in: aCollection
	"Update crc using the Adler32 checksum technique from RFC1950"
	^ Adler32 update: adler from:  start to:  stop in: aCollection! !

!ZLibWriteStream methodsFor: 'initialization' stamp: 'nk 2/17/2004 18:23'!
writeHeader
	"Write header information"
	encoder nextBits: 8 put: 120. "deflate method with 15bit window size"
	encoder nextBits: 8 put: 94. "checksum; no preset; fast (flevel=1) compression"! !

!ZLibWriteStream methodsFor: 'initialization' stamp: 'nk 2/17/2004 16:28'!
on: aCollectionOrStream
	super on: aCollectionOrStream.
	crc := 1.! !

!ZLibWriteStream methodsFor: 'initialization' stamp: 'ar 2/29/2004 04:40'!
writeFooter
	"Store the Adler32 checksum as the last 4 bytes."
	3 to: 0 by: -1 do:[:i| encoder nextBytePut: (crc >> (i*8) bitAnd: 255)].! !

!ZdcAbstractSSLSession commentStamp: 'SvenVanCaekenberghe 5/18/2011 10:05'!
I am ZdcAbstractSSLSession, an object managing the secure communication between two parties.

I define the abstract interface for my subclasses.

More specifically, I handle connection setup handshaking as well as the encryption
and decryption of data travelling between two parties.

Apart from instanciating and later explicitely destroying me, I am used by feeding data 
into me using the methods in my operations protocol. These might result in data that
has to be sent to the other side.

I am propably too primitive to be used directly, see ZdcSecureSocketStream for a higher level client.!
!ZdcAbstractSSLSession methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/18/2011 10:08'!
certificateName: aString
	"Sets the name of the local certificate to provide to the remote peer.
	OpenSSL: The name is the full path to a .pem file.
	WinSSL: The name is matched against the 'subject' of a certificate in the cert store"

	self subclassResponsibility! !

!ZdcAbstractSSLSession methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/18/2011 10:08'!
certificateName
	"The name of the local certificate to provide to the remote peer"

	self subclassResponsibility! !

!ZdcAbstractSSLSession methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 5/18/2011 10:08'!
decrypt: srcBuf from: start to: stop into: dstBuf
	"Decrypt the input in srcBuf from start to stop into dstBuf."

	self subclassResponsibility! !

!ZdcAbstractSSLSession methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/18/2011 10:08'!
certificateVerificationState
	"Returns the certificate verification bits. The returned value indicates
	whether the certificate is valid. The two standard values are:
		0   - The certificate is valid
		-1  - No certificate has been provided by the peer
	Otherwise, the result is a bit mask of the following values:
		1   - If set, there is an unspecified issue with the cert (generic error)
		2   - If set, the root CA is untrusted (usually a self-signed cert)
		4   - If set, the certificate is expired
		8   - If set, the certificate is used for the wrong purpose
		16 - If set, the CN of the certificate is invalid
		32 - If set, the certificate was revoked"

	self subclassResponsibility! !

!ZdcAbstractSSLSession methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 5/18/2011 10:09'!
destroy
	"Do any necessary cleanup when I am no longer needed"
	
	self subclassResponsibility! !

!ZdcAbstractSSLSession methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/18/2011 10:10'!
sslState
	"Returns the current state of the SSL connection:
		0 - Unused
		1 - In accept handshake
		2 - In connect handshake
		3 - Connected"
		
	self subclassResponsibility! !

!ZdcAbstractSSLSession methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/18/2011 10:09'!
isConnected
	"Returns true if the SSL handshake has been completed"

	self subclassResponsibility! !

!ZdcAbstractSSLSession methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 5/18/2011 10:07'!
accept: srcBuf from: start to: stop into: dstBuf
	"Start or continue the server handshake using the given input token"

	self subclassResponsibility! !

!ZdcAbstractSSLSession methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 5/18/2011 10:08'!
connect: srcBuf from: start to: stop into: dstBuf
	"Start or continue the client handshake using the given input token"

	self subclassResponsibility! !

!ZdcAbstractSSLSession methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/18/2011 10:10'!
peerCertificateName
	"Returns the certificate name of the remote peer.
	The method only returns a name if the certificate has been verified"

	self subclassResponsibility! !

!ZdcAbstractSSLSession methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 5/18/2011 10:09'!
encrypt: srcBuf from: start to: stop into: dstBuf
	"Encrypt the input in srcBuf from start to stop into dstBuf."

	self subclassResponsibility! !

!ZdcAbstractSocketStream commentStamp: 'SvenVanCaekenberghe 5/17/2011 18:56'!
I am ZdcAbstractSocketStream, a binary read/write stream for socket communication.

Interally, IO is done through a read and a write ZdcIOBuffer.

I am abstract, my subclasses should implement actual IO through a delegate.!
!ZdcAbstractSocketStream methodsFor: 'compatibility' stamp: 'SvenVanCaekenberghe 11/10/2011 13:08'!
bufferSize: numberOfBytes
	"Not yet implemented. See #initializeBuffers."! !

!ZdcAbstractSocketStream methodsFor: 'stream in' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
skip: count
	"Skip over count bytes.
	This is an inefficient abstract implementation skipping bytes one by one."
	
	count timesRepeat: [ self next ]! !

!ZdcAbstractSocketStream methodsFor: 'stream in' stamp: 'SvenVanCaekenberghe 7/16/2012 11:57'!
upToEnd
	"Read bytes until the stream is atEnd and return them as a ByteArray.
	This is an inefficient abstract implementation reading bytes one by one.
	Note that even when #atEnd returns false, the following #next could be nil 
	or the connection could suddenly be closed"

	^ self collectionSpecies 
		streamContents: [ :writeStream |
			[ [ self atEnd or: [ self peek isNil ] ] whileFalse: [ 
				writeStream nextPut: self next ] ]
		 		on: ConnectionClosed
				do: [ :exception | exception return ] ]! !

!ZdcAbstractSocketStream methodsFor: 'compatibility' stamp: 'SvenVanCaekenberghe 11/10/2011 13:07'!
shouldSignal: boolean
	"I always signal exceptional situations."! !

!ZdcAbstractSocketStream methodsFor: 'compatibility' stamp: 'SvenVanCaekenberghe 11/10/2011 13:07'!
binary
	"I am always binary."! !

!ZdcAbstractSocketStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 6/3/2013 19:45'!
close
	"Close the stream, flush if necessary"

	[ self flush ] ensure: [ 
		socket ifNotNil: [ 
			self socketClose.
			socket := nil ] ]! !

!ZdcAbstractSocketStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/18/2011 15:59'!
initializeBuffers
	readBuffer := ZdcIOBuffer onByteArrayOfSize: 4096.
	writeBuffer := ZdcIOBuffer onByteArrayOfSize: 4096! !

!ZdcAbstractSocketStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
collectionSpecies
	"Fixed to ByteArray since we are binary"
	
	^ ByteArray
	! !

!ZdcAbstractSocketStream methodsFor: 'private in' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
fillReadBuffer
	"Ask the delegate to fill the read buffer with data. 
	Wait for at least some data."
	
	self subclassResponsibility  ! !

!ZdcAbstractSocketStream methodsFor: 'private out' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
flushWriteBuffer
	"Ask the delegate to write all data in the write buffer. Fail if not successful"
	
	self subclassResponsibility ! !

!ZdcAbstractSocketStream methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
isBinary
	"We are always binary"
	
	^ true! !

!ZdcAbstractSocketStream methodsFor: 'stream in' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
next
	"Read and return a single byte"
	
	readBuffer isEmpty ifTrue: [ self fillReadBuffer ].
	^ readBuffer isEmpty
		ifTrue: [ nil ]
		ifFalse: [ readBuffer next ]! !

!ZdcAbstractSocketStream methodsFor: 'stream in' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
next: requestedCount into: collection
	"Read requestedCount elements into collection,
	returning a copy if less elements are available"
	
	^ self 
		next: requestedCount 
		into: collection 
		startingAt: 1   ! !

!ZdcAbstractSocketStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
timeout
	"Return the number of seconds we wait for socket IO operations"
	
	^ timeout ! !

!ZdcAbstractSocketStream methodsFor: 'stream in' stamp: 'SvenVanCaekenberghe 8/2/2012 11:17'!
nextInto: collection
	"Read the next elements of the receiver into collection,
	returning a copy if less elements are available"
	
	^ self
		next: collection size
		into: collection! !

!ZdcAbstractSocketStream methodsFor: 'private socket' stamp: 'SvenVanCaekenberghe 5/20/2011 13:03'!
socketWaitForData
	^ socket waitForDataFor: self timeout
	! !

!ZdcAbstractSocketStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/18/2011 15:59'!
initialize 
	timeout := 5.
	debug := false.
	self initializeBuffers ! !

!ZdcAbstractSocketStream methodsFor: 'compatibility' stamp: 'SvenVanCaekenberghe 11/10/2011 13:06'!
autoFlush: boolean
	"I flush when asked to, or when my buffer is full."! !

!ZdcAbstractSocketStream methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
log: object
	debug ifTrue: [
		Transcript cr; show: object value ]
	! !

!ZdcAbstractSocketStream methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
printOn: aStream
	aStream 
		nextPutAll: 'a '; 
		nextPutAll: self class name! !

!ZdcAbstractSocketStream methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/7/2012 20:35'!
isStream
	^ true! !

!ZdcAbstractSocketStream methodsFor: 'stream out' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
nextPutAll: collection
	"Write a collection of bytes"
	
	self 
		next: collection size 
		putAll: collection 
		startingAt: 1! !

!ZdcAbstractSocketStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
on: object
	socket := object! !

!ZdcAbstractSocketStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
timeout: seconds
	"Set the number of seconds we wait for socket IO operations"
	
	timeout := seconds! !

!ZdcAbstractSocketStream methodsFor: 'private socket' stamp: 'SvenVanCaekenberghe 5/20/2011 12:59'!
socketIsDataAvailable
	^ socket dataAvailable ! !

!ZdcAbstractSocketStream methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
debug: aBoolean
	debug := aBoolean ! !

!ZdcAbstractSocketStream methodsFor: 'private socket' stamp: 'SvenVanCaekenberghe 5/20/2011 12:58'!
socketIsConnected
	^ socket isConnected and: [ socket isOtherEndClosed not ]! !

!ZdcAbstractSocketStream methodsFor: 'stream in' stamp: 'SvenVanCaekenberghe 5/19/2011 12:50'!
peek
	"Peek and return a single byte"
	
	readBuffer isEmpty ifTrue: [ self fillReadBuffer ].
	^ readBuffer isEmpty
		ifTrue: [ nil ]
		ifFalse: [ readBuffer peek]! !

!ZdcAbstractSocketStream methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
atEnd
	"I am atEnd when there is no more data to be read and there never will be.
	This means that readBuffer must be empty, 
	there must be no more unread data available at the socket,
	and the socket must be closed"
	
	^ self subclassResponsibility ! !

!ZdcAbstractSocketStream methodsFor: 'stream out' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
next: count putAll: collection
	"Write count bytes from collection"
	
	self 
		next: count 
		putAll: collection 
		startingAt: 1! !

!ZdcAbstractSocketStream methodsFor: 'stream out' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
nextPut: object
	"Write a single byte"
	
	writeBuffer isFull ifTrue: [ self flushWriteBuffer ].
	writeBuffer nextPut: object
	! !

!ZdcAbstractSocketStream methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
isConnected
	"Are we connected at the socket level ?"
	
	^ self subclassResponsibility ! !

!ZdcAbstractSocketStream methodsFor: 'stream in' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
next: requestedCount 
	"Read requestedCount bytes and return them as a ByteArray.
	If less are available, a smaller ByteArray will be returned."

	^ self 
		next: requestedCount 
		into: (self collectionSpecies new: requestedCount)! !

!ZdcAbstractSocketStream methodsFor: 'private socket' stamp: 'SvenVanCaekenberghe 5/18/2013 21:26'!
socketClose
	socket closeAndDestroy ! !

!ZdcAbstractSocketStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
socket
	"Return the underlying socket object that I delegate I/O to"
	
	^ socket! !

!ZdcAbstractSocketStream methodsFor: 'private socket' stamp: 'SvenVanCaekenberghe 5/20/2011 12:56'!
socketReceiveDataInto: bytes startingAt: offset count: count
	^ socket 
		primSocket: socket socketHandle 
		receiveDataInto: bytes
		startingAt: offset
		count: count! !

!ZdcAbstractSocketStream methodsFor: 'stream out' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
flush
	"Flush all pending output that might be in the write buffer"
	
	self flushWriteBuffer ! !

!ZdcAbstractSocketStream methodsFor: 'private socket' stamp: 'SvenVanCaekenberghe 5/20/2011 13:13'!
socketSendData: bytes startingAt: offset count: count
	^ socket 
		sendSomeData: bytes 
		startIndex: offset 
		count: count ! !

!ZdcAbstractSocketStream methodsFor: 'stream in' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
upTo: value 
	"Read bytes upto but not including value and return them as a ByteArray.
	If value is not found, return the entire contents of the stream.
	This is an inefficient abstract implementation reading bytes one by one."
	
	^ self collectionSpecies 
		streamContents: [ :writeStream | | element |
			[ self atEnd or: [ (element := self next) = value ] ] whileFalse: [ 
				writeStream nextPut: element ] ]! !

!ZdcAbstractSocketStream methodsFor: 'private socket' stamp: 'SvenVanCaekenberghe 5/20/2011 13:03'!
socketWaitForSendDone
	^ socket waitForSendDoneFor: self timeout
	! !

!ZdcAbstractSocketStream methodsFor: 'stream out' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
next: count putAll: collection startingAt: offset
	"Write count bytes from collection starting at offset.
	This is an inefficient abstract implementation writing bytes one by one."
	
	0 to: count - 1 do: [ :each | 
		self nextPut: (collection at: offset + each) ]! !

!ZdcAbstractSocketStream methodsFor: 'private socket' stamp: 'SvenVanCaekenberghe 5/20/2011 13:04'!
socketConnectTo: hostAddress port: portNumber
	socket 
		connectTo: hostAddress 
		port: portNumber 
		waitForConnectionFor: self timeout        ! !

!ZdcAbstractSocketStream methodsFor: 'stream in' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
next: requestedCount into: collection startingAt: offset
	"Read requestedCount elements into collection starting at offset,
	returning a copy if less elements are available"
	
	| read |
	read := self 
		readInto: collection 
		startingAt: offset 
		count: requestedCount.
	^ read = requestedCount 
		ifTrue: [ collection ]
		ifFalse: [ collection copyFrom: 1 to: offset + read - 1 ]     ! !

!ZdcAbstractSocketStream methodsFor: 'stream in' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
readInto: collection startingAt: offset count: requestedCount
	"Read requestedCount elements into collection starting at offset,
	returning the number of elements read, there could be less elements available.
	This is an inefficient abstract implementation, reading bytes one by one."
	
	0 to: requestedCount - 1 do: [ :count | | object |
		(object := self next) ifNil: [ ^ count ].  
		collection at: offset + count put: object ].
	^ requestedCount! !

!ZdcAbstractSocketStream methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 11:15'!
isDataAvailable
	"Return true when there is data available for reading.
	This does not block."
	
	^ self subclassResponsibility ! !

!ZdcAbstractSocketStream class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
on: object
	^ (self basicNew)
		initialize;
		on: object;
		yourself! !

!ZdcAbstractSocketStreamTests commentStamp: 'SvenVanCaekenberghe 5/17/2011 19:09'!
ZdcAbstractSocketStreamTests holds units tests for socket streams.

This is an abstract class, subclasses should implement #socketStreamClass !
!ZdcAbstractSocketStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/27/2012 11:14'!
testPlainClientSkip10k
	| dataSent dataRead clientStream semaphore |
	dataSent := #[ 6 5 4 3 2 1 ].
	semaphore := self runServer: [ :serverSocket :mySemaphore | | clientSocket serverStream |
		clientSocket := serverSocket waitForAcceptFor: 10.
		serverStream := self referenceSocketStreamOn: clientSocket.
		10000 timesRepeat: [ serverStream nextPut: 0 ].  
		serverStream nextPutAll: dataSent.
		serverStream close.
		mySemaphore signal ].
	clientStream := self openConnectionToHost: #[ 127 0 0 1 ] port: self port.
	dataRead := clientStream skip: 10000; upToEnd.
	clientStream close.
	semaphore wait.
	self assert: dataSent = dataRead.
	semaphore wait! !

!ZdcAbstractSocketStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/27/2012 11:14'!
testPlainClientRead
	| dataSent dataRead clientStream semaphore |
	dataSent := #[ 6 5 4 3 2 1 ].
	semaphore := self runServer: [ :serverSocket :mySemaphore | | clientSocket serverStream |
		clientSocket := serverSocket waitForAcceptFor: 10.
		serverStream := self referenceSocketStreamOn: clientSocket.
		serverStream nextPutAll: dataSent.
		serverStream close.
		mySemaphore signal ].
	clientStream := self openConnectionToHost: #[ 127 0 0 1 ] port: self port.
	dataRead := clientStream upToEnd.
	clientStream close.
	semaphore wait.
	self assert: dataSent = dataRead.
	semaphore wait! !

!ZdcAbstractSocketStreamTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/17/2011 19:05'!
serverSocketOn: port
	| socket |
	(socket := Socket newTCP)
		setOption: 'TCP_NODELAY' value: 1;
		setOption: 'SO_SNDBUF' value: self socketBufferSize;
		setOption: 'SO_RCVBUF' value: self socketBufferSize .
	socket listenOn: port backlogSize: self listenBacklogSize.
	socket isValid
		ifFalse: [ self error: 'Cannot create socket on port ', port printString ].
	^ socket! !

!ZdcAbstractSocketStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/27/2012 11:14'!
testAddOneEcho
	| dataSent dataRead clientStream semaphore |
	semaphore := self runServer: [ :serverSocket | | clientSocket stream data |
		clientSocket := serverSocket waitForAcceptFor: 10.
		stream := self socketStreamOn: clientSocket.
		data := stream next.
		stream nextPut: ((data + 1) bitAnd: 16rff).  
		stream close ].
	dataSent := 99.
	clientStream := self openConnectionToHostNamed: 'localhost' port: self port.
	clientStream nextPut: dataSent; flush.
	dataRead := clientStream next.
	clientStream close.
	self assert: dataRead = (dataSent + 1).
	semaphore wait! !

!ZdcAbstractSocketStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/27/2012 11:15'!
testReverseEcho10kSearch
	| dataSent dataRead clientStream semaphore |
	semaphore := self runServer: [ :serverSocket | | clientSocket stream data |
		clientSocket := serverSocket waitForAcceptFor: 10.
		stream := self socketStreamOn: clientSocket.
		data := stream upTo: 0.
		stream nextPutAll: data reverse; nextPut: 0.  
		stream close ].
	dataSent := (self bytes: 10000) replace: [ :each | each max: 1 ].
	clientStream := self openConnectionToHostNamed: 'localhost' port: self port.
	clientStream nextPutAll: dataSent; nextPut: 0; flush.
	dataRead := clientStream upTo: 0.
	clientStream close.
	self assert: dataRead = dataSent reverse.
	semaphore wait! !

!ZdcAbstractSocketStreamTests methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:58'!
bytes: size
	| count data pattern |
	count := 0.
	pattern := (0 to: 255) asByteArray.
	data := ByteArray streamContents: [ :stream |
		[ count < size ] whileTrue: [
			stream nextPutAll: pattern.
			count := count + pattern size ] ].
	^ data copyFrom: 1 to: size     ! !

!ZdcAbstractSocketStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/27/2012 11:15'!
testReverseEcho10kFixed
	| dataSent dataRead clientStream semaphore |
	semaphore := self runServer: [ :serverSocket | | clientSocket stream data |
		clientSocket := serverSocket waitForAcceptFor: 10.
		stream := self socketStreamOn: clientSocket.
		data := stream next: 10000.
		stream nextPutAll: data reverse.  
		stream close ].
	dataSent := self bytes: 10000.
	clientStream := self openConnectionToHostNamed: 'localhost' port: self port.
	clientStream nextPutAll: dataSent; flush.
	dataRead := clientStream next: 10000.
	clientStream close.
	self assert: dataRead = dataSent reverse.
	semaphore wait! !

!ZdcAbstractSocketStreamTests methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/17/2011 19:06'!
listenBacklogSize
	"Server socket backlog size (number of pending connection waiting to be accepted)"
	
	^ 32! !

!ZdcAbstractSocketStreamTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/26/2013 15:19'!
runClient: block
	| semaphore |
	semaphore := Semaphore new.
	[ block ensure: [ semaphore signal ] ] forkAt: self serverPriority - 1.
	semaphore wait! !

!ZdcAbstractSocketStreamTests methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:58'!
socketStreamClass
	^ self subclassResponsibility ! !

!ZdcAbstractSocketStreamTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 6/27/2012 11:44'!
openConnectionToHost: host port: port
	^ self socketStreamClass 
		openConnectionToHost: host port: port! !

!ZdcAbstractSocketStreamTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 6/27/2012 11:51'!
referenceSocketStreamOn: socket
	| stream |
	stream := SocketStream on: socket.
	self setReferenceSocketStreamOptions: stream.
	^ stream! !

!ZdcAbstractSocketStreamTests methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/26/2013 12:23'!
socketStreamTimeout
	"Timeout in seconds for SocketStream IO"
	
	^ ZnNetworkingUtils socketStreamTimeout! !

!ZdcAbstractSocketStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/27/2013 16:17'!
testReverseEchoUpToEnd
	| dataSent dataRead clientStream semaphore data |
	semaphore := self runServer: [ :serverSocket :mySemaphore | | clientSocket stream |
		clientSocket := serverSocket waitForAcceptFor: 10.
		stream := self socketStreamOn: clientSocket.
		"Doing #upToEnd here does not seem to work"
		data := stream next: 6.
		stream nextPutAll: data reverse.  
		stream close ].
	self runClient: [ 
		dataSent := #[ 1 2 3 4 5 6 ].
		clientStream := self openConnectionToHostNamed: 'localhost' port: self port.
		clientStream nextPutAll: dataSent; flush.
		dataRead := clientStream upToEnd.
		clientStream close.
		self assert: dataRead = dataSent reverse.
		semaphore wait ]! !

!ZdcAbstractSocketStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/27/2012 11:14'!
testPlainClientRead10kInPieces1
	| dataSent dataRead clientStream semaphore |
	dataSent := self bytes: 10000.
	semaphore := self runServer: [ :serverSocket :mySemaphore | | clientSocket serverStream |
		clientSocket := serverSocket waitForAcceptFor: 10.
		serverStream := self referenceSocketStreamOn: clientSocket.
		serverStream nextPutAll: dataSent.
		serverStream close.
		mySemaphore signal ].
	clientStream := self openConnectionToHost: #[ 127 0 0 1 ] port: self port.
	dataRead := ByteArray new: 10000 streamContents: [ :stream |
		10 timesRepeat: [ stream nextPutAll: (clientStream next: 1000) ] ].
	clientStream close.
	semaphore wait.
	self assert: dataSent = dataRead.
	semaphore wait! !

!ZdcAbstractSocketStreamTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 6/27/2012 11:46'!
setReferenceSocketStreamOptions: stream
	stream
		binary;
		shouldSignal: true;
		autoFlush: false;
		bufferSize: self socketBufferSize;
		timeout: self socketStreamTimeout! !

!ZdcAbstractSocketStreamTests methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/17/2011 19:06'!
socketBufferSize
	"Size in bytes for Sockets and SocketStream IO buffers"

	^ 4096! !

!ZdcAbstractSocketStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/27/2012 11:14'!
testPlainClientRead10kInPieces2
	| dataSent dataRead clientStream semaphore |
	dataSent := self bytes: 10000.
	semaphore := self runServer: [ :serverSocket :mySemaphore | | clientSocket serverStream |
		clientSocket := serverSocket waitForAcceptFor: 10.
		serverStream := self referenceSocketStreamOn: clientSocket.
		serverStream nextPutAll: dataSent.
		serverStream close.
		mySemaphore signal ].
	clientStream := self openConnectionToHost: #[ 127 0 0 1 ] port: self port.
	dataRead := ByteArray new: 10000.
	0 to: 9 do: [ :index | 
		clientStream next: 1000 into: dataRead startingAt: (index * 1000) + 1 ].
	clientStream close.
	semaphore wait.
	self assert: dataSent = dataRead.
	semaphore wait! !

!ZdcAbstractSocketStreamTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 6/27/2012 10:59'!
openConnectionToHostNamed: host port: port
	^ self socketStreamClass 
		openConnectionToHostNamed: host port: port! !

!ZdcAbstractSocketStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/27/2012 11:15'!
testPlainClientWrite
	| dataSent dataRead clientStream semaphore |
	semaphore := self runServer: [ :serverSocket :mySemaphore | | clientSocket serverStream |
		clientSocket := serverSocket waitForAcceptFor: 10.
		serverStream := self referenceSocketStreamOn: clientSocket.
		dataRead := serverStream upToEnd.
		serverStream close.
		mySemaphore signal ].
	dataSent := #[ 1 2 3 4 5 6 ].
	clientStream := self openConnectionToHost: #[ 127 0 0 1 ] port: self port.
	clientStream nextPutAll: dataSent.
	clientStream close.
	semaphore wait.
	self assert: dataSent = dataRead.
	semaphore wait! !

!ZdcAbstractSocketStreamTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/26/2013 15:16'!
serverPriority
	^ Processor userBackgroundPriority! !

!ZdcAbstractSocketStreamTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/26/2013 15:16'!
runServer: block
	| serverSocket semaphore |
	serverSocket := self serverSocketOn: self port.
	self assert: serverSocket notNil.
	self assert: serverSocket localPort = self port.
	semaphore := Semaphore new.
	[ 
	semaphore signal.
	[ block cull: serverSocket cull: semaphore ]
		ensure: [ 
			serverSocket closeAndDestroy.
			semaphore signal ] ] forkAt: self serverPriority.
	semaphore wait.
	^ semaphore! !

!ZdcAbstractSocketStreamTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 6/27/2012 10:59'!
socketStreamOn: socket
	^ self socketStreamClass 
		on: socket! !

!ZdcAbstractSocketStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/27/2012 11:15'!
testPlainClientWrite10kInPieces
	| dataSent dataRead clientStream semaphore |
	semaphore := self runServer: [ :serverSocket :mySemaphore | | clientSocket serverStream |
		clientSocket := serverSocket waitForAcceptFor: 10.
		serverStream := self referenceSocketStreamOn: clientSocket.
		dataRead := serverStream upToEnd.
		serverStream close.
		mySemaphore signal ].
	dataSent := self bytes: 10000.
	clientStream := self openConnectionToHost: #[ 127 0 0 1 ] port: self port.
	0 to: 9 do: [ :index |
		clientStream next: 1000 putAll: dataSent startingAt: (1000 * index) + 1 ].
	clientStream close.
	semaphore wait.
	self assert: dataSent = dataRead.
	semaphore wait! !

!ZdcAbstractSocketStreamTests methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:58'!
port 
	^ 1701! !

!ZdcAbstractSocketStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/27/2012 11:14'!
testPlainClientSkip
	| dataSent dataRead clientStream semaphore |
	dataSent := #[ 6 5 4 3 2 1 ].
	semaphore := self runServer: [ :serverSocket :mySemaphore | | clientSocket serverStream |
		clientSocket := serverSocket waitForAcceptFor: 10.
		serverStream := self referenceSocketStreamOn: clientSocket.
		serverStream nextPut: 0; nextPutAll: dataSent.
		serverStream close.
		mySemaphore signal ].
	clientStream := self openConnectionToHost: #[ 127 0 0 1 ] port: self port.
	dataRead := clientStream skip: 1; upToEnd.
	clientStream close.
	semaphore wait.
	self assert: dataSent = dataRead.
	semaphore wait! !

!ZdcAbstractSocketStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/27/2012 11:14'!
testPlainClientRead10k
	| dataSent dataRead clientStream semaphore |
	dataSent := self bytes: 10000.
	semaphore := self runServer: [ :serverSocket :mySemaphore | | clientSocket serverStream |
		clientSocket := serverSocket waitForAcceptFor: 10.
		serverStream := self referenceSocketStreamOn: clientSocket.
		serverStream nextPutAll: dataSent.
		serverStream close.
		mySemaphore signal ].
	clientStream := self openConnectionToHost: #[ 127 0 0 1 ] port: self port.
	dataRead := clientStream upToEnd.
	clientStream close.
	semaphore wait.
	self assert: dataSent = dataRead.
	semaphore wait! !

!ZdcAbstractSocketStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/27/2012 11:15'!
testPlainClientWrite10k
	| dataSent dataRead clientStream semaphore |
	semaphore := self runServer: [ :serverSocket :mySemaphore | | clientSocket serverStream |
		clientSocket := serverSocket waitForAcceptFor: 10.
		serverStream := self referenceSocketStreamOn: clientSocket.
		dataRead := serverStream upToEnd.
		serverStream close.
		mySemaphore signal ].
	dataSent := self bytes: 10000.
	clientStream := self openConnectionToHost: #[ 127 0 0 1 ] port: self port.
	clientStream nextPutAll: dataSent.
	clientStream close.
	semaphore wait.
	self assert: dataSent = dataRead.
	semaphore wait! !

!ZdcAbstractSocketStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/27/2012 11:15'!
testReverseEcho
	| dataSent dataRead clientStream semaphore data |
	semaphore := self runServer: [ :serverSocket | | clientSocket stream |
		clientSocket := serverSocket waitForAcceptFor: 10.
		stream := self socketStreamOn: clientSocket.
		data := stream upTo: 0.
		stream nextPutAll: data reverse; nextPut: 0.  
		stream close ].
	dataSent := #[ 1 2 3 4 5 6 ].
	clientStream := self openConnectionToHostNamed: 'localhost' port: self port.
	clientStream nextPutAll: dataSent; nextPut: 0; flush.
	dataRead := clientStream upTo: 0.
	clientStream close.
	self assert: dataRead = dataSent reverse.
	semaphore wait! !

!ZdcAbstractSocketStreamTests class methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:58'!
isAbstract 
	^ true! !

!ZdcIOBuffer commentStamp: 'SvenVanCaekenberghe 5/17/2011 18:47'!
I am ZdcIOBuffer.

I manage a fixed SequenceableCollection buffer for simultaneous input and output.
I maintain a readPointer and a writePointer.

When data is written to me, it is stored at the end, past my writePointer.
When data is read from me, it is retrieved from the front, past my readPointer.

Invariant: readPointer <= writePointer

My valid contents for reading is defined from contentsStart to contentsEnd, from readPointer + 1 to writePointer.
Data can be added to the free space defined from freeSpaceStart to freeSpaceEnd, from writePointer + 1 to the buffer's' size.

There can be a gap at my front. Compacting moves data if necessary to make (more) room at the end.!
!ZdcIOBuffer methodsFor: 'reading' stamp: 'SvenVanCaekenberghe 5/17/2011 18:46'!
next
	"Access the next readable element, fail is empty"

	^ self availableForReading > 0
		ifTrue: [
			readPointer := readPointer + 1.
			buffer at: readPointer ]
		ifFalse: [
			self bufferEmptyError ]! !

!ZdcIOBuffer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:46'!
freeSpaceEnd
	"Return the current valid free space end index into the buffer (inclusive)"
	
	self isFull ifTrue: [ self bufferFullError ]. 
	^ buffer size! !

!ZdcIOBuffer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:46'!
advanceReadPointer: count
	"Advance the read pointer as if count elements were read"
	
	self assert: count >= 0.
	count <= self availableForReading
		ifTrue: [  
			readPointer := readPointer + count ]
		ifFalse: [
			self bufferEmptyError ]  ! !

!ZdcIOBuffer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:46'!
advanceWritePointer: count
	"Advance the write pointer as if count elements were written"
	
	self assert: count >= 0.
	count <= self availableForWriting 
		ifTrue: [  
			writePointer := writePointer + count ]
		ifFalse: [
			self bufferFullError ]  ! !

!ZdcIOBuffer methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:46'!
printOn: stream
	super printOn: stream.
	stream nextPut: $(.
	self gapAtFront > 0 
		ifTrue: [ stream nextPut: $-; print: self gapAtFront; space ].
	stream print: self contents.
	self availableForWriting > 0
		ifTrue: [ stream space; nextPut: $+; print: self availableForWriting ].
	stream nextPut: $)! !

!ZdcIOBuffer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:46'!
availableForReading
	"How many elements can be read ?"

	^ writePointer - readPointer! !

!ZdcIOBuffer methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/17/2011 18:46'!
on: sequenceableCollection
	buffer := sequenceableCollection.
	self reset! !

!ZdcIOBuffer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:46'!
contentsStart
	"Return the current valid contents start index into the buffer (inclusive)"
	
	self isEmpty ifTrue: [ self bufferEmptyError ].
	^ readPointer + 1! !

!ZdcIOBuffer methodsFor: 'reading' stamp: 'SvenVanCaekenberghe 5/19/2011 12:50'!
peek
	"Peek the next readable element, fail is empty"

	^ self availableForReading > 0
		ifTrue: [
			buffer at: readPointer + 1 ]
		ifFalse: [
			self bufferEmptyError ]! !

!ZdcIOBuffer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:46'!
bufferSize
	"Return the raw size of the underlying buffer"
	
	^ buffer size! !

!ZdcIOBuffer methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/17/2011 18:46'!
bufferEmptyError
	^ self error: 'Buffer empty'! !

!ZdcIOBuffer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:46'!
size
	"Return the number of actual elements available"
	
	^ self availableForReading! !

!ZdcIOBuffer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:46'!
buffer
	"Return our underlying buffer"
	
	^ buffer! !

!ZdcIOBuffer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:46'!
capacity
	"How much room is there both at the front and at the end ?"
	
	^ self gapAtFront + self availableForWriting ! !

!ZdcIOBuffer methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:46'!
isEmpty
	"Can something be read ?"
	
	^ self availableForReading isZero! !

!ZdcIOBuffer methodsFor: 'writing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:46'!
nextPut: anObject
	"Add another element. Fail if full"
	
	self availableForWriting > 0
		ifTrue: [
			writePointer := writePointer + 1 .
			buffer at: writePointer put: anObject ]
		ifFalse: [
			self bufferFullError ].
	^ anObject
! !

!ZdcIOBuffer methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 5/17/2011 18:46'!
reset
	"Do a hard reset"
	
	readPointer := 0.
	writePointer := 0! !

!ZdcIOBuffer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:46'!
contentsEnd
	"Return the current valid contents end index into the buffer (inclusive)"
	
	self isEmpty ifTrue: [ self bufferEmptyError ].
	^ writePointer! !

!ZdcIOBuffer methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:46'!
isFull
	"Is there room for writing ?"
	
	^ self availableForWriting isZero! !

!ZdcIOBuffer methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/17/2011 18:46'!
bufferFullError
	^ self error: 'Buffer full'! !

!ZdcIOBuffer methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 5/17/2011 18:46'!
compact
	"Move data to the front of the buffer to make more room for writing at the end"
	
	| count |
	count := self availableForReading.
	count isZero ifTrue: [ ^ self reset ].
	readPointer isZero ifTrue: [ ^ self ].
	buffer replaceFrom: 1 to: count with: buffer startingAt: readPointer + 1.
	readPointer := 0.
	writePointer := count! !

!ZdcIOBuffer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:46'!
availableForWriting
	"How many elements can be written at the end ?"
	
	^ buffer size - writePointer! !

!ZdcIOBuffer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:46'!
freeSpaceStart
	"Return the current valid free space start index into the buffer (inclusive)"
	
	self isFull ifTrue: [ self bufferFullError ]. 
	^ writePointer + 1! !

!ZdcIOBuffer methodsFor: 'writing' stamp: 'SvenVanCaekenberghe 5/28/2013 15:47'!
next: count putAll: collection startingAt: offset
	"Add count elements from collection starting at offset. Fail if there is not enough room"
	
	| writeOffset |
	count > self availableForWriting ifTrue: [ self bufferFullError ].  
	writeOffset := self freeSpaceStart.
	buffer 
		replaceFrom: writeOffset 
		to: writeOffset + count - 1 
		with: collection 
		startingAt: offset.
	self advanceWritePointer: count! !

!ZdcIOBuffer methodsFor: 'reading' stamp: 'SvenVanCaekenberghe 5/28/2013 15:48'!
readInto: collection startingAt: offset count: requestedCount
	"Read requestedCount elements into collection starting at offset,
	returning the number of elements read, there could be less elements available."
	
	| toRead |
	toRead := requestedCount min: self availableForReading.
	collection 
		replaceFrom: offset 
		to: offset + toRead - 1 
		with: buffer 
		startingAt: self contentsStart.
	self advanceReadPointer: toRead.
	^ toRead! !

!ZdcIOBuffer methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 5/17/2011 18:46'!
contents
	"Return our readable contents"
	
	^ self isEmpty
		ifTrue: [ buffer copyEmpty ]
		ifFalse: [ buffer copyFrom: self contentsStart to: self contentsEnd ]! !

!ZdcIOBuffer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:46'!
gapAtFront
	"How many elements fit in the gap at the front ?"
	
	^ readPointer! !

!ZdcIOBuffer class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 5/17/2011 18:46'!
on: sequenceableCollection
	^ (self new)
		on: sequenceableCollection;
		yourself! !

!ZdcIOBuffer class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 5/17/2011 18:46'!
onByteArrayOfSize: size
	^ self on: (ByteArray new: size)! !

!ZdcIOBufferTests commentStamp: 'SvenVanCaekenberghe 5/17/2011 18:48'!
ZdcIOBufferTests holds unit tests for ZdcIOBuffer.!
!ZdcIOBufferTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/17/2011 19:28'!
testString
	| ioBuffer |
	ioBuffer := ZdcIOBuffer on: (String new: 10).
	($a to: $f) do: [ :each | ioBuffer nextPut: each ].
	self assert: ioBuffer contents = 'abcdef'.
	($a to: $f) do: [ :each | self assert: ioBuffer next = each ]
	
	! !

!ZdcIOBufferTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/17/2011 19:29'!
testReading
	| ioBuffer |
	ioBuffer := ZdcIOBuffer on: (ByteArray new: 10).
	1 to: 6 do: [ :each | ioBuffer nextPut: each ].
	1 to: 3 do: [ :each | self assert: ioBuffer next = each ].
	self assert: ioBuffer contents = #[4 5 6].
	4 to: 6 do: [ :each | self assert: ioBuffer next = each ].
	self assert: ioBuffer isEmpty.
	self should: [ ioBuffer next ] raise: Error! !

!ZdcIOBufferTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/28/2013 19:16'!
testNextPutAllStartingAt
	| ioBuffer |
	ioBuffer := ZdcIOBuffer on: (String new: 12).
	ioBuffer next: 4 putAll: 'abcd' startingAt: 1.
	ioBuffer next: 4 putAll: 'xxxxabcdyyyy' startingAt: 5.
	ioBuffer next: 4 putAll: '--abcd' startingAt: 3.
	self assert: ioBuffer contents equals: 'abcdabcdabcd'! !

!ZdcIOBufferTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/17/2011 19:28'!
testAdvanceReadPointer
	| ioBuffer offset |
	ioBuffer := ZdcIOBuffer on: (ByteArray new: 10).
	3 timesRepeat: [ ioBuffer nextPut: 0 ].
	1 to: 6 do: [ :each | ioBuffer nextPut: each ].
	3 timesRepeat: [ ioBuffer next ].
	offset := ioBuffer contentsStart.
	self assert: ioBuffer availableForReading = 6.
	1 to: 6 do: [ :each | 
		self assert: (ioBuffer buffer at: offset + each - 1) = each ].
	ioBuffer advanceReadPointer: 6.
	self assert: ioBuffer availableForReading = 0.
	ioBuffer compact.
	self assert: ioBuffer isEmpty     
	! !

!ZdcIOBufferTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/28/2013 19:30'!
testBivalentReading
	| data ioBuffer buffer |
	data := 'some string'.
	
	ioBuffer := ZdcIOBuffer on: data.
	ioBuffer advanceWritePointer: data size.
	buffer := ByteArray new: data size.
	ioBuffer readInto: buffer startingAt: 1 count: data size.
	self assert: buffer equals: data asByteArray.
	
	ioBuffer := ZdcIOBuffer on: data asByteArray.
	ioBuffer advanceWritePointer: data size.
	buffer := String new: data size.
	ioBuffer readInto: buffer startingAt: 1 count: data size.
	self assert: buffer equals: data.
! !

!ZdcIOBufferTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/17/2011 19:28'!
testCompactAtBeginning
	| ioBuffer |
	ioBuffer := ZdcIOBuffer on: (ByteArray new: 10).
	ioBuffer compact.
	self assert: ioBuffer isEmpty.
	self assert: ioBuffer availableForWriting = 10.
	1 to: 6 do: [ :each | ioBuffer nextPut: each ].
	ioBuffer compact.
	self assert: ioBuffer availableForReading = 6.
	self assert: ioBuffer availableForWriting = 4.
	self assert: ioBuffer gapAtFront isZero! !

!ZdcIOBufferTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/17/2011 19:28'!
testCompactAtEnd
	| ioBuffer |
	ioBuffer := ZdcIOBuffer on: (ByteArray new: 10).
	10 timesRepeat: [ ioBuffer nextPut: 1 ].
	self assert: ioBuffer gapAtFront isZero.
	10 timesRepeat: [ ioBuffer next ].
	self assert: ioBuffer isFull.
	self assert: ioBuffer gapAtFront = 10.
	ioBuffer compact.
	self assert: ioBuffer isEmpty
	
		! !

!ZdcIOBufferTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/17/2011 19:28'!
testWriting
	| ioBuffer |
	ioBuffer := ZdcIOBuffer on: (ByteArray new: 10).
	self assert: ioBuffer isEmpty.
	self assert: ioBuffer size isZero.
	self assert: ioBuffer availableForWriting = 10.
	1 to: 6 do: [ :each | ioBuffer nextPut: each ].
	self assert: ioBuffer contents = #[1 2 3 4 5 6].
	self assert: ioBuffer size = 6.
	self assert: ioBuffer availableForWriting = 4.
	7 to: 10 do: [ :each | ioBuffer nextPut: each ].
	self assert: ioBuffer isFull.
	self should: [ ioBuffer nextPut: 1 ] raise: Error! !

!ZdcIOBufferTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/17/2011 19:28'!
testCompact
	| ioBuffer |
	ioBuffer := ZdcIOBuffer on: (ByteArray new: 10).
	1 to: 6 do: [ :each | ioBuffer nextPut: each ].
	3 timesRepeat: [ ioBuffer next ].
	ioBuffer compact.
	self assert: ioBuffer availableForReading = 3.
	self assert: ioBuffer availableForWriting = 7.
	3 timesRepeat: [ ioBuffer next ].
	self assert: ioBuffer gapAtFront = 3.
	ioBuffer compact.
	self assert: ioBuffer isEmpty
	
		! !

!ZdcIOBufferTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/17/2011 19:28'!
testCompactDoNothing
	| ioBuffer |
	ioBuffer := ZdcIOBuffer on: (ByteArray new: 10).
	self assert: ioBuffer isEmpty.
	self assert: ioBuffer availableForReading = 0.
	self assert: ioBuffer availableForWriting = 10.
	ioBuffer compact.
	self assert: ioBuffer isEmpty.
	self assert: ioBuffer availableForReading = 0.
	self assert: ioBuffer availableForWriting = 10.	    
	1 to: 6 do: [ :each | ioBuffer nextPut: each ].	
	self assert: ioBuffer isEmpty not.
	self assert: ioBuffer availableForReading = 6.
	self assert: ioBuffer availableForWriting = 4.
	ioBuffer compact.
	self assert: ioBuffer isEmpty not.
	self assert: ioBuffer availableForReading = 6.
	self assert: ioBuffer availableForWriting = 4.! !

!ZdcIOBufferTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/17/2011 19:28'!
testAdvanceWritePointer
	| ioBuffer offset |
	ioBuffer := ZdcIOBuffer on: (ByteArray new: 10).
	self assert: ioBuffer isEmpty.
	offset := ioBuffer freeSpaceStart.
	1 to: 6 do: [ :each |
		ioBuffer buffer at: offset + each - 1 put: each ].
	ioBuffer advanceWritePointer: 6.
	self assert: ioBuffer isEmpty not.
	self assert: ioBuffer availableForReading = 6.
	self assert: ioBuffer contents = #[1 2 3 4 5 6]
	! !

!ZdcIOBufferTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/28/2013 15:08'!
testBivalentWriting
	| data ioBuffer |
	data := 'some string'.
	
	ioBuffer := ZdcIOBuffer on: (String new: data size).
	ioBuffer next: data size putAll: data asByteArray startingAt: 1.
	self assert: ioBuffer contents equals: data.
	
	ioBuffer := ZdcIOBuffer on: (ByteArray new: data size).
	ioBuffer next: data size putAll: data startingAt: 1.
	self assert: ioBuffer contents equals: data asByteArray! !

!ZdcIOBufferTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/28/2013 19:24'!
testReadIntoStartingAtCount
	| data ioBuffer string |
	data := 'abcdefghijkl'.
	ioBuffer := ZdcIOBuffer on: data.
	ioBuffer advanceWritePointer: 12.
	string := String new: 12.
	ioBuffer readInto: string startingAt: 1 count: 4.
	ioBuffer readInto: string startingAt: 5 count: 4.
	ioBuffer readInto: string startingAt: 9 count: 4.
	self assert: string equals: data! !

!ZdcOptimizedSocketStream commentStamp: 'SvenVanCaekenberghe 5/17/2011 18:57'!
I am ZnOptimizedSocketStream.

I am a ZdcSimpleSocketStream.

I re-implement the critical operations dealing with bulk input and output 
more efficiently to work with buffer sized chunks, bypassing #next and #nextPut:!
!ZdcOptimizedSocketStream methodsFor: 'stream in' stamp: 'SvenVanCaekenberghe 5/20/2011 13:35'!
upTo: value 
	"Read bytes upto but not including value and return them as a ByteArray.
	If value is not found, return the entire contents of the stream. Overwritten, optimized"
	
	^ self collectionSpecies 
		streamContents: [ :writeStream |
			[ | position |
				position := 0.
				readBuffer isEmpty ifFalse: [ | count |
					position := readBuffer buffer indexOf: value startingAt: readBuffer contentsStart.
					count := position = 0 ifTrue: [ readBuffer availableForReading ] ifFalse: [ position - readBuffer contentsStart ].
					writeStream next: count putAll: readBuffer buffer startingAt: readBuffer contentsStart.
					readBuffer advanceReadPointer: count.
					position = 0 ifFalse: [ readBuffer advanceReadPointer: 1 ] ].   
				position ~= 0 or: [ self atEnd ] ] whileFalse: [ 
					readBuffer isEmpty ifTrue: [ self fillReadBuffer ] ] ]! !

!ZdcOptimizedSocketStream methodsFor: 'stream in' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
skip: count
	"Skip over count bytes. Overwritten, optimized"
	
	| skipCount |
	skipCount := 0.
	[ | leftToSkip skipping |
		leftToSkip := count - skipCount.
		skipping := readBuffer availableForReading min: leftToSkip.
		readBuffer advanceReadPointer: skipping.
	     (skipCount := skipCount + skipping) = count ] whileFalse: [ self fillReadBuffer ]! !

!ZdcOptimizedSocketStream methodsFor: 'stream out' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
next: count putAll: collection startingAt: offset
	"Write count bytes from collection starting at offset. Overwritten, optimized"
	
	| totalWritten |
	totalWritten := 0.
	[ | toWrite |
		toWrite := (count - totalWritten) min: writeBuffer availableForWriting.
		writeBuffer next: toWrite putAll: collection startingAt: offset + totalWritten.
		totalWritten := totalWritten + toWrite.
		totalWritten = count ] whileFalse: [ self flushWriteBuffer ]! !

!ZdcOptimizedSocketStream methodsFor: 'stream in' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
readInto: collection startingAt: offset count: requestedCount
	"Read requestedCount elements into collection starting at offset,
	returning the number of elements read. Overwritten, optimized"
	
	| totalRead |
	totalRead := 0.
	[ | read |
		(read := readBuffer availableForReading min: (requestedCount - totalRead)) > 0
			ifTrue: [  
				collection 
					replaceFrom: offset + totalRead to: offset + totalRead + read - 1 
					with: readBuffer buffer startingAt: readBuffer contentsStart.
				readBuffer advanceReadPointer: read.
				totalRead := totalRead + read ].
		totalRead = requestedCount or: [ self isConnected not ] ] whileFalse: [ self fillReadBuffer ].   
	^ totalRead! !

!ZdcOptimizedSocketStream methodsFor: 'stream in' stamp: 'SvenVanCaekenberghe 7/13/2012 13:09'!
upToEnd
	"Read bytes until the stream is atEnd and return them as a ByteArray. Overwritten, optimized"

	^ self collectionSpecies 
		streamContents: [ :writeStream |
			[	
				readBuffer isEmpty ifFalse: [
					writeStream 
						next: readBuffer availableForReading 
						putAll: readBuffer buffer 
						startingAt: readBuffer contentsStart.
					readBuffer advanceReadPointer: readBuffer availableForReading ].   
				self atEnd ] whileFalse: [ 
					readBuffer isEmpty 
						ifTrue: [ 
							[ self fillReadBuffer ] 
								on: ConnectionClosed 
								do: [ :exception | exception return ] ] ] ]! !

!ZdcOptimizedSocketStreamTests commentStamp: 'SvenVanCaekenberghe 5/17/2011 19:09'!
ZdcOptimizedSocketStreamTests tests ZdcOptimizedSocketStream!
!ZdcOptimizedSocketStreamTests methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:59'!
socketStreamClass
	^ ZdcOptimizedSocketStream ! !

!ZdcOptimizedSocketStreamTests class methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:58'!
isAbstract 
	^ false! !

!ZdcPluginMissing commentStamp: '<historical>'!
I am ZdcPluginMissing, signaled when a plugin required by Zodiac is missing.

You can find more information on Zodiac's website

	http://zdc.stfx.eu!
!ZdcPluginMissing methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 6/28/2012 09:47'!
messageText
	^ 'SSL/TLS plugin initailization failed (VM plugin missing ? OS libraries missing ?)'! !

!ZdcPluginSSLSession commentStamp: 'SvenVanCaekenberghe 9/13/2011 09:56'!
I am ZdcPluginSSLSession, an object managing the secure communication between two parties.

I am a ZdcAbstractSSLSession.

I am a wrapper for the SqueakSSL plugin.

I am probably too primitive to be used directly, see ZnSecureSocketStream for a higher level client.

Ackowledgement: based on the original SqueakSSL code.!
!ZdcPluginSSLSession methodsFor: 'primitives' stamp: 'SvenVanCaekenberghe 5/18/2011 10:01'!
primitiveSSL: sslHandle connect: srcbuf startingAt: start count: length into: dstbuf
	"Primitive. Starts or continues a client handshake using the provided data.
	Will eventually produce output to be sent to the server.
	Returns:
		> 0   Number of bytes to be sent to the server
		= 0   Success. The connection is established
		= -1  More input is required
		< -1  Other errors"
	
	<primitive: 'primitiveConnect' module: 'SqueakSSL'>
	
	^ self primitiveFailed! !

!ZdcPluginSSLSession methodsFor: 'primitives' stamp: 'SvenVanCaekenberghe 5/18/2011 10:01'!
primitiveSSLDestroy: sslHandle
	"Primitive. Destroys the SSL session handle in the VM plugin"

	<primitive: 'primitiveDestroy' module: 'SqueakSSL'>
	
	^ self primitiveFailed! !

!ZdcPluginSSLSession methodsFor: 'primitives' stamp: 'SvenVanCaekenberghe 5/18/2011 10:01'!
primitiveSSLCreate
	"Primitive. Creates and returns a new SSL handle in the VM plugin"

	<primitive: 'primitiveCreate' module: 'SqueakSSL'>
	
	^ self primitiveFailed! !

!ZdcPluginSSLSession methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 10/24/2014 13:50'!
initialize
	"Initialize the receiver"

	[ handle := self primitiveSSLCreate ]
		on: PrimitiveFailed 
		do: [ :exception |
			"Give a more human friendly error message"
			ZdcPluginMissing signal ].
	self logging: false
! !

!ZdcPluginSSLSession methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 10/24/2014 13:54'!
enableLogging
	"Enable logging of the native code inside the plugin"
	
	self logging: true! !

!ZdcPluginSSLSession methodsFor: 'primitives' stamp: 'SvenVanCaekenberghe 5/18/2011 10:01'!
primitiveSSL: sslHandle getStringProperty: propID
	"Primitive. Returns a string property from an SSL session"

	<primitive: 'primitiveGetStringProperty' module: 'SqueakSSL'>
	
	^ self primitiveFailed! !

!ZdcPluginSSLSession methodsFor: 'private' stamp: 'KrisGybels 10/24/2014 12:31'!
constantsSQSSL_PROP_LOGLEVEL

	^ 1! !

!ZdcPluginSSLSession methodsFor: 'primitives' stamp: 'SvenVanCaekenberghe 5/18/2011 10:01'!
primitiveSSL: sslHandle getIntProperty: propID
	"Primitive. Returns a string property from an SSL session"

	<primitive: 'primitiveGetIntProperty' module: 'SqueakSSL'>
	
	^ self primitiveFailed! !

!ZdcPluginSSLSession methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/18/2011 10:01'!
peerCertificateName
	"Returns the certificate name of the remote peer.
	The method only returns a name if the certificate has been verified"

	^ self primitiveSSL: handle getStringProperty: 0! !

!ZdcPluginSSLSession methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 12/6/2011 11:32'!
encrypt: srcBuf from: start to: stop into: dstBuf
	"Encrypt the input in srcBuf from start to stop into dstBuf."

	^ self primitiveSSL: handle encrypt: srcBuf startingAt: start count: stop - start + 1 into: dstBuf! !

!ZdcPluginSSLSession methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/18/2011 10:01'!
certificateName: aString
	"Sets the name of the local certificate to provide to the remote peer.
	OpenSSL: The name is the full path to a .pem file.
	WinSSL: The name is matched against the 'subject' of a certificate in the cert store"

	^ self primitiveSSL: handle setStringProperty: 1 toValue: (aString ifNil: [ ' ' ])! !

!ZdcPluginSSLSession methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/18/2011 10:01'!
certificateName
	"The name of the local certificate to provide to the remote peer"

	^ self primitiveSSL: handle getStringProperty: 1! !

!ZdcPluginSSLSession methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 12/6/2011 11:32'!
decrypt: srcBuf from: start to: stop into: dstBuf
	"Decrypt the input in srcBuf from start to stop into dstBuf."

	^ self primitiveSSL: handle decrypt: srcBuf startingAt: start count: stop - start + 1 into: dstBuf! !

!ZdcPluginSSLSession methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 5/18/2011 10:01'!
destroy
	"Destroys the platform handle in the VM plugin"

	handle isNil ifTrue: [ ^ self ].  
	self primitiveSSLDestroy: handle.
	handle := nil! !

!ZdcPluginSSLSession methodsFor: 'accessing' stamp: 'KrisGybels 10/24/2014 12:32'!
logging

	^ ((self primitiveSSL: handle getIntProperty: self constantsSQSSL_PROP_LOGLEVEL) = 0) not! !

!ZdcPluginSSLSession methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/18/2011 10:01'!
sslState
	"Returns the current state of the SSL connection:
		0 - Unused
		1 - In accept handshake
		2 - In connect handshake
		3 - Connected"
		
	^ self primitiveSSL: handle getIntProperty: 2
		! !

!ZdcPluginSSLSession methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/18/2011 10:01'!
isConnected
	"Returns true if the SSL handshake has been completed"

	^ self sslState = 3! !

!ZdcPluginSSLSession methodsFor: 'primitives' stamp: 'SvenVanCaekenberghe 5/18/2011 10:01'!
primitiveSSL: sslHandle setStringProperty: propID toValue: aString
	"Primitive. Sets a string property in an SSL session"

	<primitive: 'primitiveSetStringProperty' module: 'SqueakSSL'>
	
	^ self primitiveFailed! !

!ZdcPluginSSLSession methodsFor: 'primitives' stamp: 'SvenVanCaekenberghe 5/18/2011 10:01'!
primitiveSSL: sslHandle accept: srcbuf startingAt: start count: length into: dstbuf
	"Primitive. Starts or continues a server handshake using the provided data.
	Will eventually produce output to be sent to the client.
	Returns:
		> 0   Number of bytes to be sent to the server
		= 0   Success. The connection is established
		= -1  More input is required
		< -1  Other errors"
		
	<primitive: 'primitiveAccept' module: 'SqueakSSL'>
	
	^ self primitiveFailed! !

!ZdcPluginSSLSession methodsFor: 'primitives' stamp: 'KrisGybels 10/24/2014 12:32'!
primitiveSSL: sslHandle setIntProperty: propID toValue: anInteger
	"Primitive. Sets an integer property in an SSL session"

	<primitive: 'primitiveSetIntProperty' module: 'SqueakSSL'>
	
	^ self primitiveFailed! !

!ZdcPluginSSLSession methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/18/2011 10:01'!
certificateVerificationState
	"Returns the certificate verification bits. The returned value indicates
	whether the certificate is valid. The two standard values are:
		0   - The certificate is valid
		-1  - No certificate has been provided by the peer
	Otherwise, the result is a bit mask of the following values:
		1   - If set, there is an unspecified issue with the cert (generic error)
		2   - If set, the root CA is untrusted (usually a self-signed cert)
		4   - If set, the certificate is expired
		8   - If set, the certificate is used for the wrong purpose
		16 - If set, the CN of the certificate is invalid
		32 - If set, the certificate was revoked"
		
	^ self primitiveSSL: handle getIntProperty: 3! !

!ZdcPluginSSLSession methodsFor: 'primitives' stamp: 'SvenVanCaekenberghe 5/18/2011 10:01'!
primitiveSSL: sslHandle encrypt: srcbuf startingAt: start count: length into: dstbuf
	"Primitive. Encrypts the incoming buffer into the result buffer.
	Returns the number of bytes produced as a result"

	<primitive: 'primitiveEncrypt' module: 'SqueakSSL'>
	
	^ self primitiveFailed! !

!ZdcPluginSSLSession methodsFor: 'accessing' stamp: 'KrisGybels 10/24/2014 12:32'!
logging: boolean

	self primitiveSSL: handle setIntProperty: self constantsSQSSL_PROP_LOGLEVEL toValue: (boolean ifFalse: [ 0 ] ifTrue: [ 1 ]).
! !

!ZdcPluginSSLSession methodsFor: 'primitives' stamp: 'SvenVanCaekenberghe 5/18/2011 10:01'!
primitiveSSL: sslHandle decrypt: srcbuf startingAt: start count: length into: dstbuf
	"Primitive. Takes incoming data for decryption and continues to decrypt data.
	Returns the number of bytes produced in the output"

	<primitive: 'primitiveDecrypt' module: 'SqueakSSL'>
	
	^ self primitiveFailed! !

!ZdcPluginSSLSession methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 5/18/2011 10:01'!
accept: srcBuf from: start to: stop into: dstBuf
	"Start or continue the server handshake using the given input token"

	^ self primitiveSSL: handle accept: srcBuf startingAt: start count: stop - start + 1 into: dstBuf! !

!ZdcPluginSSLSession methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 5/18/2011 10:01'!
connect: srcBuf from: start to: stop into: dstBuf
	"Start or continue the client handshake using the given input token"

	^ self primitiveSSL: handle connect: srcBuf startingAt: start count: stop - start + 1 into: dstBuf! !

!ZdcPluginSSLSession methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/18/2011 10:01'!
pluginVersion
	"Returns the version of the plugin"

	^ self primitiveSSL: handle getIntProperty: 0! !

!ZdcReferenceSocketStreamTests commentStamp: 'SvenVanCaekenberghe 5/20/2011 10:20'!
ZdcReferenceSocketStreamTests test the reference SocketStream in the image!
!ZdcReferenceSocketStreamTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 6/27/2012 11:48'!
openConnectionToHostNamed: host port: port
	| stream |
	stream := super openConnectionToHostNamed: host port: port.
	self setReferenceSocketStreamOptions: stream.
	^ stream! !

!ZdcReferenceSocketStreamTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 6/27/2012 11:48'!
socketStreamOn: socket
	| stream |
	stream := super socketStreamOn: socket.
	self setReferenceSocketStreamOptions: stream.
	^ stream	! !

!ZdcReferenceSocketStreamTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 6/27/2012 11:47'!
openConnectionToHost: host port: port
	| stream |
	stream := super openConnectionToHost: host port: port.
	self setReferenceSocketStreamOptions: stream.
	^ stream! !

!ZdcReferenceSocketStreamTests methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/20/2011 10:19'!
socketStreamClass
	^ SocketStream ! !

!ZdcReferenceSocketStreamTests class methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/27/2012 10:48'!
isAbstract 
	^ false! !

!ZdcSecurePOP3Client commentStamp: 'SvenVanCaekenberghe 12/6/2011 12:46'!
I am ZdcSecurePOP3Client.

I open a ZdcSecureSocketStream to the POP3 server and connect it at the SSL level.

ZdcSecurePOP3Client
	retrieveMessagesFromGMailAccount: '<your-name>@gmail.com'
	password: '<your-password>'
	limit: 5.!
!ZdcSecurePOP3Client methodsFor: 'private protocol' stamp: 'SvenVanCaekenberghe 12/6/2011 12:42'!
getMultilineResponse
	"Get a multiple line response to the last command, filtering out LF characters. 
	A multiple line response ends with a line containing only a single period (.) character."

	| response done chunk |
	response := String new writeStream.
	done := false.
	[ done ] whileFalse: [
		chunk := self nextLineFromStream.
		(chunk beginsWith: '.')
			ifTrue: [ response nextPutAll: (chunk copyFrom: 2 to: chunk size); cr ]
			ifFalse: [ response nextPutAll: chunk; cr ].
		done := (chunk = '.') ].
	^ response contents
! !

!ZdcSecurePOP3Client methodsFor: 'private protocol' stamp: 'SvenVanCaekenberghe 12/7/2011 21:12'!
sendCommand: aString
	self logVerbose: aString.
	self stream 
		nextPutAll: aString;
		nextPutAll: #[13 10];
		flush
! !

!ZdcSecurePOP3Client methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/7/2011 21:04'!
setupStreamForSSL
	self stream: (ZdcSecureSocketStream openConnectionToHost: self host port: self port).
	self stream connect.
	self logVerbose: 'SSL Connect OK.'! !

!ZdcSecurePOP3Client methodsFor: 'private protocol' stamp: 'SvenVanCaekenberghe 12/7/2011 21:02'!
nextLineFromStream
	| line |
	line := lineReader nextLine.
	self logVerbose: line.
	^ line! !

!ZdcSecurePOP3Client methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/6/2011 11:51'!
ensureConnection
	"Overwritten & refactored"
		
	self isConnected ifTrue: [ ^ self ].
	self stream ifNotNil: [ self stream close ].

	self setupStream.
	self checkResponse.
	self login! !

!ZdcSecurePOP3Client methodsFor: 'private protocol' stamp: 'SvenVanCaekenberghe 12/6/2011 12:25'!
fetchNextResponse
	self lastResponse: self nextLineFromStream! !

!ZdcSecurePOP3Client methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/7/2011 21:00'!
stream: aStream
	super stream: aStream.
	lineReader := ZnLineReader on: self stream! !

!ZdcSecurePOP3Client methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/6/2011 11:52'!
setupStream
	self setupStreamForSSL! !

!ZdcSecurePOP3Client methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/7/2011 21:06'!
logVerbose: aString
	"self log: aString; log: Character cr"! !

!ZdcSecurePOP3Client class methodsFor: 'constants' stamp: 'SvenVanCaekenberghe 12/6/2011 12:01'!
defaultPortForSSL
	^ 995! !

!ZdcSecurePOP3Client class methodsFor: 'example' stamp: 'SvenVanCaekenberghe 12/6/2011 12:51'!
retrieveMessagesFromGMailAccount: accountAddress password: password limit: limit
	| pop3Client messages messageCount |
	(pop3Client := self openOnHostNamed: 'smtp.gmail.com' port: self defaultPortForSSL)
		loginUser: accountAddress password: password.
	messages := OrderedCollection new.
	messageCount := pop3Client messageCount.
	messageCount to: ((messageCount - limit) max: 0) + 1 by: -1 do: [ :each |
		messages add: (pop3Client retrieveMessage: each) ].
	pop3Client
		quit;
		close.
	^ messages
! !

!ZdcSecureSMTPClient commentStamp: 'SvenVanCaekenberghe 12/6/2011 11:46'!
I am ZdcSecureSMTPClient.

I open a ZdcSecureSocketStream to the SMTP server and connect it at the SSL level.

| mailMessage |
mailMessage := MailMessage empty.
mailMessage setField: 'subject' toString: 'ZdcSecureSMTPClient Test'.
mailMessage body: (MIMEDocument contentType: 'text/plain' content: 'This is test from Pharo Smalltalk').
ZdcSecureSMTPClient
	sendUsingGMailAccount: '<your-name>@gmail.com' 
	password: '<your-password>'
	to: '<email-address>' 
	message: mailMessage!
!ZdcSecureSMTPClient methodsFor: 'private protocol' stamp: 'SvenVanCaekenberghe 12/7/2011 21:12'!
sendCommand: aString
	self logVerbose: aString.
	self stream 
		nextPutAll: aString;
		nextPutAll: #[13 10];
		flush
! !

!ZdcSecureSMTPClient methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 12/5/2011 20:11'!
useSSL
	variant := #ssl! !

!ZdcSecureSMTPClient methodsFor: 'private protocol' stamp: 'SvenVanCaekenberghe 12/6/2011 11:50'!
alternativeLogin
	self initiateSession. "send EHLO first"
	self user ifNil: [ ^ self ].
	self sendCommand: 'AUTH LOGIN'.
	self checkResponse.
	self sendCommand: (self encodeString: self user).
	self checkResponse.
	self sendCommand: (self encodeString: self password).
	self checkResponse! !

!ZdcSecureSMTPClient methodsFor: 'private' stamp: 'NorbertHartl 3/27/2012 16:44'!
ensureConnection
	"Overwritten & refactored"
		
	self isConnected ifTrue: [ ^ self].
	self stream ifNotNil: [ self stream close ].
	self setupStream.
	"regarding RFC2487-5.2 the state after SSL negotiation is to be reset to the state after the
	220 server greeting. EHLO command is next which is issued in the following login method  "
	self login! !

!ZdcSecureSMTPClient methodsFor: 'private protocol' stamp: 'SvenVanCaekenberghe 12/7/2011 21:14'!
fetchNextResponse
	"The FTP and similar protocols allow multi-line responses.
	If the response is multi-line, the fourth character of the first line is a  
	$- and the last line repeats the numeric code but the code is followed by 
	a space."

	| response result firstLine |
	result := '' writeStream.
	firstLine := self nextLineFromStream.
	result nextPutAll: firstLine.
	(self responseIsContinuation: firstLine) 
		ifTrue: [
			"continued over multiple lines. Discard continuation lines."
			[response := self nextLineFromStream.
			response ifNil: [ ^ nil ].
			response size > 3 and: 
					[ (response copyFrom: 1 to: 3) = (firstLine copyFrom: 1 to: 3) 
						and: [ (response at: 4) = Character space ] ] ] whileFalse: [
							result cr; nextPutAll: response ] ].
	self lastResponse: result contents! !

!ZdcSecureSMTPClient methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/5/2011 20:12'!
isStartTLS
	^ variant = #startTLS! !

!ZdcSecureSMTPClient methodsFor: 'private protocol' stamp: 'SvenVanCaekenberghe 4/19/2013 12:37'!
requireStartTLS
	(self lastResponse includesSubstring: 'STARTTLS')
		ifFalse: [ ^ self error: 'Server does not seem to support STARTTLS' ].
! !

!ZdcSecureSMTPClient methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/5/2011 20:21'!
setupStream
	variant = #ssl ifTrue: [ ^ self setupStreamForSSL ].
	variant = #startTLS ifTrue: [ ^ self setupStreamForStartTLS ]! !

!ZdcSecureSMTPClient methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/5/2011 20:14'!
setupStreamForStartTLS
	"See http://www.ietf.org/rfc/rfc3207.txt for how to setup a secure connection"

	self stream: (SocketStream openConnectionToHost: self host port: self port).
	self checkResponse.
	self initiateSession.
	self requireStartTLS.
	self startTLS! !

!ZdcSecureSMTPClient methodsFor: 'private protocol' stamp: 'SvenVanCaekenberghe 12/7/2011 21:12'!
startTLS
	"Send a STARTTLS command and after the response, 
	switch to a SecureSocketStream and do the client handshake"
	
	self sendCommand: 'STARTTLS'.
	self checkResponse.	
	self stream: (ZdcSecureSocketStream on: self stream socket).
	self stream connect.
	self logVerbose: 'SSL Connect OK.'! !

!ZdcSecureSMTPClient methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/7/2011 21:11'!
stream: aStream
	super stream: aStream.
	lineReader := ZnLineReader on: self stream! !

!ZdcSecureSMTPClient methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 12/5/2011 20:13'!
initialize
	super initialize.
	self useSSL! !

!ZdcSecureSMTPClient methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 12/5/2011 20:11'!
useStartTLS
	variant := #startTLS! !

!ZdcSecureSMTPClient methodsFor: 'private' stamp: 'NorbertHartl 3/27/2012 16:38'!
setupStreamForSSL
	self stream: (ZdcSecureSocketStream openConnectionToHost: self host port: self port).
	self stream connect.
	self logVerbose: 'SSL Connect OK.'.
	"as we connect directly with SSL the first message will be a 220 server greeting"
	self checkResponse.
! !

!ZdcSecureSMTPClient methodsFor: 'private protocol' stamp: 'SvenVanCaekenberghe 12/7/2011 21:12'!
nextLineFromStream
	| line |
	line := lineReader nextLine.
	self logVerbose: line.
	^ line! !

!ZdcSecureSMTPClient methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/5/2011 20:12'!
isSSL
	^ variant = #ssl! !

!ZdcSecureSMTPClient methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/7/2011 21:16'!
logVerbose: aString
	"self log: aString; log: Character cr"! !

!ZdcSecureSMTPClient class methodsFor: 'constants' stamp: 'SvenVanCaekenberghe 12/5/2011 20:10'!
defaultPortForSSL
	^ 465! !

!ZdcSecureSMTPClient class methodsFor: 'constants' stamp: 'SvenVanCaekenberghe 12/5/2011 20:10'!
defaultPortForStartTLS
	^ 587! !

!ZdcSecureSMTPClient class methodsFor: 'example' stamp: 'SvenVanCaekenberghe 12/6/2011 13:10'!
sendUsingGMailAccount: senderAddress password: password to: receiverAddress message: mailMessage
	| smtpClient |
	(smtpClient := self new)
		user: senderAddress; 
		password: password.
	smtpClient openOnHost: (NetNameResolver addressForName: 'smtp.gmail.com') port: 465.
	mailMessage setField: 'from' toString: senderAddress.
	mailMessage setField: 'to' toString: receiverAddress.
	^ smtpClient 
		mailFrom: senderAddress to: { receiverAddress } text: mailMessage text;
		quit; 
		close;
		yourself
! !

!ZdcSecureSocketStream commentStamp: 'SvenVanCaekenberghe 5/18/2011 11:50'!
I am ZdcSecureSocketStream, a binary read/write stream for SSL communication.

I am a ZdcOptimizedSocketStream.

When I am used as a client, call #connect on me before using me as a normal stream.

When I am used as a server, call #accept on me before using me as a normal stream.

Currently, certificate management is ignored.
!
!ZdcSecureSocketStream methodsFor: 'ssl' stamp: 'SvenVanCaekenberghe 7/12/2012 15:10'!
connect
	"Do the SSL client handshake."
	
	| count result |
	self resetEncryptedBuffers.
	count := 0.
	connecting := true.
	[ (result := self sslSession connect: in from: 1 to: count into: out) = 0 ] whileFalse: [
		result < -1 ifTrue: [ 
			^ self sslException: 'connect failed' code: result ].
		result > 0 ifTrue: [ 
			self flushEncryptedBytes: out startingAt: 1 count: result ].
		count := self readEncryptedBytes: in startingAt: 1 count: in size ].
	connecting := false
	! !

!ZdcSecureSocketStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/13/2011 09:57'!
sslSession
	"Return the underlying ZdcAbstractSSLSession object 
	that we use for encryption and decryption, 
	as well as connection setup handshaking, connect and accept"
	
	sslSession isNil ifTrue: [ sslSession := self sslSessionClass new ].
	^ sslSession! !

!ZdcSecureSocketStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 6/3/2013 19:46'!
close
	"Close the stream, flush if necessary. 
	Destory the SSLSession object."

	[ super close ] ensure: [ 
		sslSession ifNotNil: [
			sslSession destroy.
			sslSession := nil ] ]! !

!ZdcSecureSocketStream methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 7/12/2012 23:08'!
atEnd
	"I am atEnd when there is no more data to be read and there never will be.
	This means that readBuffer must be empty, there must be no more unread data 
	available at the socket, and the socket must be closed"
	
	readBuffer isEmpty ifFalse: [ ^ false ].
	socket notNil
		ifTrue: [
			"Try reading (there might stil be data in the SSL session) and test again"
			[ self fillReadBufferNoWait ]
				on: ConnectionClosed 
				do: [ ^ true ].
			readBuffer isEmpty ifFalse: [ ^ false ] ].   
	^ self isConnected not! !

!ZdcSecureSocketStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 8/23/2012 11:21'!
initializeBuffers
	"The maximum payload message length of a TLS record is 16Kb,
	add a margin for the header and trailer."
	
	readBuffer := ZdcIOBuffer onByteArrayOfSize: 16 * 1024.
	writeBuffer := ZdcIOBuffer onByteArrayOfSize: 4 * 1024.
	in := ByteArray new: 4096.
	out := ByteArray new: (16 + 1) * 1024
! !

!ZdcSecureSocketStream methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/18/2011 11:49'!
isConnected
	"Are we connected at the socket level ?
	Has the SSL handshake been done successfully ?"

	^ super isConnected 
		and: [ sslSession notNil and: [ connecting or: [ sslSession isConnected ] ] ]! !

!ZdcSecureSocketStream methodsFor: 'private in' stamp: 'SvenVanCaekenberghe 3/5/2015 22:29'!
fillBytes: bytes startingAt: offset count: count
	"Ask to read count elements into bytes starting at offset. Do not wait. Return read count.
	Overwritten: decrypt and if necessary ask the socket for encrypted data using a super call."
	
	| processedCount inCount |
	self resetEncryptedBuffers.
	"The SSL session might contain left over state, get it"
	processedCount := self sslSession decrypt: in from: 1 to: 0 into: out.	
	"We explicitly ignore possible errors here"
	processedCount > 0
		ifTrue: [
			bytes replaceFrom: offset to: offset + processedCount - 1 with: out startingAt: 1.
			^ processedCount ].
	"Now, get new encrypted bytes and decrypt if needed"
	inCount := self fillEncryptedBytes: in startingAt: 1 count: in size.
	inCount > 0
		ifTrue: [ 
			processedCount := self sslSession decrypt: in from: 1 to: inCount into: out.
			"We explicitly ignore possible errors here"
			processedCount > 0
				ifTrue: [
					bytes replaceFrom: offset to: offset + processedCount - 1 with: out startingAt: 1.
					^ processedCount ] ].
	^ 0! !

!ZdcSecureSocketStream methodsFor: 'private out' stamp: 'SvenVanCaekenberghe 7/12/2012 15:01'!
flushBytes: bytes startingAt: offset count: count
	"Ask to write count bytes starting from offset. Wait. Fail if not successful
	Overwritten: first encrypt the data, then send it to the socket using a super call."
	
	| remaining currentOffset |
	self isConnected ifFalse: [ ConnectionClosed signal: 'Cannot write data' ].  
	remaining := count.
	currentOffset := offset.
	[ remaining > 0 ] whileTrue: [ | chunkCount writeCount |
		self resetEncryptedBuffers.
		chunkCount := 4096 min: remaining.
		writeCount := self sslSession encrypt: bytes from: currentOffset to: currentOffset + chunkCount - 1 into: out.
		writeCount < 0 ifTrue: [ ^ self sslException: 'encrypt failed' code: writeCount ].
		self flushEncryptedBytes: out startingAt: 1 count: writeCount.
		remaining := remaining - chunkCount.
		currentOffset := currentOffset + chunkCount ]! !

!ZdcSecureSocketStream methodsFor: 'ssl' stamp: 'SvenVanCaekenberghe 7/12/2012 15:10'!
accept
	"Do the SSL server handshake."
	
	| count result |
	self resetEncryptedBuffers.
	count := 0.
	connecting := true.
	[ self sslSession isConnected ] whileFalse: [
		count := self readEncryptedBytes: in startingAt: 1 count: in size.
		result := self sslSession accept: in from: 1 to: count into: out.
		result < -1 ifTrue: [ 
			^ self sslException: 'accept failed' code: result ].
		result > 0 ifTrue: [ 
			self flushEncryptedBytes: out startingAt: 1 count: result ] ].
	connecting := false! !

!ZdcSecureSocketStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/18/2011 16:00'!
initialize 
	super initialize.
	connecting := false! !

!ZdcSecureSocketStream methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/18/2011 11:49'!
resetEncryptedBuffers
	"Not necessary, but useful for debugging"
	
	in atAllPut: 0.
	out atAllPut: 0! !

!ZdcSecureSocketStream methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/18/2011 11:49'!
sslException: text code: code
	self error: 
		(String streamContents: [ :stream |
			stream << 'SSL Exception: ' << text << ' [code:'.
			stream print: code.
			stream << ']' ]) ! !

!ZdcSecureSocketStream methodsFor: 'private in' stamp: 'SvenVanCaekenberghe 7/12/2012 15:02'!
fillEncryptedBytes: bytes startingAt: offset count: count
	"Read encrypted bytes from the network. Do not wait."
	
	^ super fillBytes: bytes startingAt: offset count: count! !

!ZdcSecureSocketStream methodsFor: 'private out' stamp: 'SvenVanCaekenberghe 7/12/2012 14:57'!
flushEncryptedBytes: bytes startingAt: offset count: count
	"Write encrypted bytes to the network."
	
	^ super flushBytes: bytes startingAt: offset count: count! !

!ZdcSecureSocketStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/18/2011 11:51'!
sslSessionClass
	^ ZdcPluginSSLSession ! !

!ZdcSecureSocketStream methodsFor: 'private in' stamp: 'SvenVanCaekenberghe 7/12/2012 15:09'!
readEncryptedBytes: bytes startingAt: offset count: count
	"Read encrypted bytes from the network. Wait if necessary."
	
	| result |
	result := super fillBytes: bytes startingAt: offset count: count.
	^ result = 0
		ifTrue: [
			self socketWaitForData. "when successful, recurse, else signal exception"
			self readEncryptedBytes: bytes startingAt: offset count: count ]
		ifFalse: [
			result ]! !

!ZdcSecureSocketStream methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 11:26'!
isDataAvailable
	"Return true when there is data available for reading.
	This does not block."
	
	readBuffer isEmpty ifFalse: [ ^ true ].
	socket notNil
		ifTrue: [
			"Try reading (there might stil be data in the SSL session) and test again"
			[ self fillReadBufferNoWait ]
				on: ConnectionClosed 
				do: [ ^ false ].
			readBuffer isEmpty ifFalse: [ ^ true ] ].   
	^ false! !

!ZdcSecureSocketStreamTests commentStamp: 'SvenVanCaekenberghe 5/18/2011 11:52'!
ZdcSecureSocketStreamTests tests ZdcSecureSocketStream !
!ZdcSecureSocketStreamTests methodsFor: 'tests' stamp: 'SvenVanCaekenberghe 7/4/2012 11:23'!
testIsNativeSSLPluginPresent
	"This test succeeds when the SSL VM plugin can be instanciated and intialized."
	
	self 
		assert: self isNativeSSLPluginPresent 
		description: 'It seems that the native VM SSL plugin cannot be instanciated and initialized. (VM plugin missing ? OS libraries missing ?)'! !

!ZdcSecureSocketStreamTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 7/4/2012 11:20'!
isNativeSSLPluginPresent
	"Return whether the SSL VM plugin can be instanciated and intialized."
	
	^ [ ZdcPluginSSLSession new destroy. true ]
			on: ZdcPluginMissing
			do: [ false ]! !

!ZdcSecureSocketStreamTests methodsFor: 'tests' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
testPlain
	| query stream request response |
	self isNativeSSLPluginPresent ifFalse: [ ^ self ].
	query := 'Smalltalk'.
	stream := ZdcSecureSocketStream openConnectionToHostNamed: 'encrypted.google.com' port: 443.
	[
		request := String streamContents: [ :out |
			out << 'GET /search?q=' << query << ' HTTP/1.1' << String crlf.
			out << 'Host: encrypted.google.com' << String crlf.
			out << 'Connection: close' << String crlf.
			out << String crlf ].
		stream connect.
		stream nextPutAll: request asByteArray.
		stream flush.
		response := stream upToEnd asString.
	] ensure: [ stream close ].
	self assert: (response includesSubstring: '200 OK').      
	self assert: (response includesSubstring: 'Google').
	self assert: (response includesSubstring: 'Smalltalk').      ! !

!ZdcSimpleSocketStream commentStamp: 'SvenVanCaekenberghe 5/17/2011 18:56'!
I am ZdcSimpleSocketStream.

I am a ZdcAbstractSocketStream.

I do a minimal implementation of the requirements defined by my superclass.

I rely on the rather inefficient implementation of my superclass' methods, 
funneling all access through #next and #nextPut.!
!ZdcSimpleSocketStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/20/2011 13:07'!
connectTo: hostAddress port: portNumber
	"Connect our socket to hostAddress:portNumber.
	Wait up to timeout for a connection"
	
	self socketConnectTo: hostAddress port: portNumber! !

!ZdcSimpleSocketStream methodsFor: 'private in' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
fillReadBufferNoWait
	"Ask the socket to fill the read buffer with data. Do not wait for data."
	
	| readCount |
	readBuffer compact.
	readCount := self 
		fillBytes: readBuffer buffer 
		startingAt: readBuffer freeSpaceStart
		count: readBuffer availableForWriting .
	readBuffer advanceWritePointer: readCount.
	^ readCount! !

!ZdcSimpleSocketStream methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 7/12/2012 16:25'!
atEnd
	"I am atEnd when there is no more data to be read and there never will be.
	This means that readBuffer must be empty, there must be no more unread data 
	available at the socket, and the socket must be closed"
	
	readBuffer isEmpty ifFalse: [ ^ false ].
	(socket notNil and: [ self socketIsDataAvailable ]) 
		ifTrue: [
			"Assuming there really is data available, read it and recurse"
			self fillReadBufferNoWait.
			^ self atEnd ].   
	^ self isConnected not! !

!ZdcSimpleSocketStream methodsFor: 'private out' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
flushWriteBuffer
	"Ask the socket to write all data in the write buffer. Fail if not successful"
	
	writeBuffer isEmpty ifTrue: [ ^ self ].  
	self 
		flushBytes: writeBuffer buffer
		startingAt: writeBuffer contentsStart
		count: writeBuffer availableForReading. 
	writeBuffer reset ! !

!ZdcSimpleSocketStream methodsFor: 'private in' stamp: 'SvenVanCaekenberghe 3/5/2015 22:21'!
fillReadBuffer
	"Ask the socket to fill the read buffer with data. Wait for a data."
	
	self fillReadBufferNoWait.
	(readBuffer isEmpty and: [ self isConnected ])
		ifTrue: [ 
			[ self socketWaitForData ] on: ConnectionClosed do: [ ^ self ]. "when successful, recurse, else signal exception"
			self fillReadBuffer ]  ! !

!ZdcSimpleSocketStream methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/20/2011 13:02'!
isConnected
	"Are we connected at the socket level ?"
	
	^ socket notNil and: [ self socketIsConnected ]! !

!ZdcSimpleSocketStream methodsFor: 'private in' stamp: 'SvenVanCaekenberghe 5/20/2011 14:21'!
fillBytes: bytes startingAt: offset count: count
	"Ask the socket to read count elements into bytes starting at offset. Do not wait. Return read count."
	
	self isConnected ifFalse: [ ConnectionClosed signal: 'Cannot read data' ].  
	^ self 
		socketReceiveDataInto: bytes 
		startingAt: offset 
		count: count! !

!ZdcSimpleSocketStream methodsFor: 'private out' stamp: 'SvenVanCaekenberghe 5/20/2011 13:05'!
flushBytes: bytes startingAt: offset count: count
	"Ask the socket to write count bytes starting from offset. Wait. Fail if not successful"
	
	| writeCount |
	self isConnected ifFalse: [ ConnectionClosed signal: 'Cannot write data' ].  
	writeCount := 0.
	[ | written |
		written := self socketSendData: bytes startingAt: offset + writeCount count: count - writeCount.
		(writeCount := writeCount + written) = count ] whileFalse: [
		self socketWaitForSendDone
			ifFalse: [ ConnectionTimedOut signal: 'Data send timed out.' ] ]! !

!ZdcSimpleSocketStream methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 11:17'!
isDataAvailable
	"Return true when there is data available for reading.
	This does not block."
	
	readBuffer isEmpty ifFalse: [ ^ true ].
	(socket notNil and: [ self socketIsDataAvailable ]) 
		ifTrue: [
			"Assuming there really is data available, read it and recurse"
			self fillReadBufferNoWait.
			^ self isDataAvailable ].   
	^ false! !

!ZdcSimpleSocketStream class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
openConnectionToHost: hostIP port: portNumber
	| platformSocket |
	platformSocket := Socket newTCP.
	^ (self on: platformSocket)
		connectTo: hostIP port: portNumber;
		yourself! !

!ZdcSimpleSocketStream class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
openConnectionToHostNamed: hostName port: portNumber
	| platformSocket socketStream hostIP |
	platformSocket := Socket newTCP.
	socketStream := self on: platformSocket.
	hostIP := NetNameResolver addressForName: hostName timeout: socketStream timeout.
	^ socketStream 
		connectTo: hostIP port: portNumber;
		yourself! !

!ZdcSimpleSocketStream class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/18/2012 09:19'!
openConnectionToHost: hostIP port: portNumber timeout: timeout
	| platformSocket |
	platformSocket := Socket newTCP.
	^ (self on: platformSocket)
		timeout: timeout;
		connectTo: hostIP port: portNumber;
		yourself! !

!ZdcSimpleSocketStreamTests commentStamp: 'SvenVanCaekenberghe 5/17/2011 19:09'!
ZdcSimpleSocketStreamTests tests ZdcSimpleSocketStream!
!ZdcSimpleSocketStreamTests methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:59'!
socketStreamClass
	^ ZdcSimpleSocketStream ! !

!ZdcSimpleSocketStreamTests class methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:58'!
isAbstract 
	^ false! !

!ZdcSocketStream commentStamp: 'SvenVanCaekenberghe 5/17/2011 18:57'!
I am ZdcSocketStream.

I am a ZdcOptimizedSocketStream.

I further optimize my superclass' methods dealing with bulk input and output
to transparently bypass the internal buffers when this makes sense.!
!ZdcSocketStream methodsFor: 'stream in' stamp: 'SvenVanCaekenberghe 5/20/2011 13:07'!
readInto: collection startingAt: offset count: requestedCount
	"Read requestedCount elements into collection starting at offset,
	returning the number of elements read. Overwritten, optimized"
	
	| totalRead read |
	totalRead := 0.
	(read := readBuffer availableForReading min: requestedCount) > 0
		ifTrue: [  
			collection replaceFrom: offset to: offset + read - 1 with: readBuffer buffer startingAt: readBuffer contentsStart.
			readBuffer advanceReadPointer: read.
			(totalRead := totalRead + read) = requestedCount ifTrue: [ ^ totalRead ] ].  
	[
		read := self fillBytes: collection startingAt: offset + totalRead count: requestedCount - totalRead.
		(totalRead := totalRead + read) = requestedCount or: [ self isConnected not ] ] whileFalse: [ 
			self socketWaitForData ].
	^ totalRead! !

!ZdcSocketStream methodsFor: 'stream out' stamp: 'SvenVanCaekenberghe 5/17/2011 18:52'!
next: count putAll: collection startingAt: offset
	"Write count bytes from collection starting at offset. Overwritten, optimized"
	
	count <= (writeBuffer bufferSize / 8)  
		ifTrue: [
			count > writeBuffer availableForWriting ifTrue: [ self flushWriteBuffer ].  
			writeBuffer next: count putAll: collection startingAt: offset ]
		ifFalse: [
			self flushWriteBuffer.
			self flushBytes: collection startingAt: offset count: count ]! !

!ZdcSocketStreamTests commentStamp: 'SvenVanCaekenberghe 5/17/2011 19:09'!
ZdcSocketStreamTests tests ZdcSocketStream!
!ZdcSocketStreamTests methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:59'!
socketStreamClass
	^ ZdcSocketStream ! !

!ZdcSocketStreamTests class methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/17/2011 18:58'!
isAbstract 
	^ false! !

!ZeroDivide commentStamp: 'SvenVanCaekenberghe 4/21/2011 12:36'!
I am ZeroDivide, an ArithmeticError that may be signaled when a mathematical division by 0 is attempted.!
!ZeroDivide methodsFor: 'exceptiondescription' stamp: 'pnm 8/16/2000 15:05'!
isResumable
	"Determine whether an exception is resumable."

	^true! !

!ZeroDivide methodsFor: 'exceptiondescription' stamp: 'tfei 6/5/1999 17:29'!
dividend
	"Answer the number that was being divided by zero."

	^dividend! !

!ZeroDivide methodsFor: 'exceptionbuilder' stamp: 'pnm 8/16/2000 15:05'!
dividend: argument
	"Specify the number that was being divided by zero."

	dividend := argument! !

!ZeroDivide class methodsFor: 'exceptioninstantiator' stamp: 'bf 9/27/1999 17:26'!
dividend: argument
	^self new dividend: argument; yourself! !

!ZeroDivide class methodsFor: 'signaling' stamp: 'GabrielOmarCotelli 6/6/2009 17:12'!
signalWithDividend: aDividend

	^(self dividend: aDividend) signal! !

!ZipArchive commentStamp: '<historical>'!
A ZipArchive represents an archive that is read and/or written using the PKZIP file format.

ZipArchive instances know how to read and write such archives; their members are subinstances of ZipArchiveMember.!
!ZipArchive methodsFor: 'private' stamp: 'nk 2/22/2001 17:19'!
readEndOfCentralDirectoryFrom: aStream
	"Read EOCD, starting from position before signature."
	| signature zipFileCommentLength |
	signature := self readSignatureFrom: aStream.
	signature = EndOfCentralDirectorySignature ifFalse: [ ^self error: 'bad signature at ', aStream position printString ].

	aStream nextLittleEndianNumber: 2. "# of this disk"
	aStream nextLittleEndianNumber: 2. "# of disk with central dir start"
	aStream nextLittleEndianNumber: 2. "# of entries in central dir on this disk"
	aStream nextLittleEndianNumber: 2. "total # of entries in central dir"
	centralDirectorySize := aStream nextLittleEndianNumber: 4. "size of central directory"
	centralDirectoryOffsetWRTStartingDiskNumber := aStream nextLittleEndianNumber: 4. "offset of start of central directory"
	zipFileCommentLength := aStream nextLittleEndianNumber: 2. "zip file comment"
	zipFileComment := aStream next: zipFileCommentLength.
! !

!ZipArchive methodsFor: 'writing' stamp: 'StephaneDucasse 2/25/2010 18:07'!
writeToFileNamed: aFileName prependingFileNamed: anotherFileName
	
	"Catch attempts to overwrite existing zip file"
	(self canWriteToFileNamed: aFileName)
		ifFalse: [ ^self error: (aFileName, ' is needed by one or more members in this archive') ].
	StandardFileStream 
		forceNewFileNamed: aFileName
		do: [ :stream |  
				self writeTo: stream prependingFileNamed: anotherFileName].
! !

!ZipArchive methodsFor: 'archive operations' stamp: 'ar 2/6/2004 13:20'!
extractAllTo: aDirectory informing: bar
	"Extract all elements to the given directory"
	^self extractAllTo: aDirectory informing: bar overwrite: false! !

!ZipArchive methodsFor: 'archive operations' stamp: 'ar 3/1/2006 23:21'!
addDeflateString: aString as: aFileName
	"Add a verbatim string under the given file name"
	| mbr |
	mbr := self addString: aString as: aFileName.
	mbr desiredCompressionMethod: CompressionDeflated.
	^mbr! !

!ZipArchive methodsFor: 'reading' stamp: 'nk 12/16/2002 17:09'!
readFrom: aStreamOrFileName
	| stream name eocdPosition |
	stream := aStreamOrFileName isStream
		ifTrue: [name := aStreamOrFileName name. aStreamOrFileName]
		ifFalse: [StandardFileStream readOnlyFileNamed: (name := aStreamOrFileName)].
	stream binary.
	eocdPosition := self class findEndOfCentralDirectoryFrom: stream.
	eocdPosition <= 0 ifTrue: [self error: 'can''t find EOCD position'].
	self readEndOfCentralDirectoryFrom: stream.
	stream position: eocdPosition - centralDirectorySize.
	self readMembersFrom: stream named: name! !

!ZipArchive methodsFor: 'private' stamp: 'nk 2/21/2001 20:19'!
writeCentralDirectoryTo: aStream
	| offset |
	offset := writeCentralDirectoryOffset.
	members do: [ :member |
		member writeCentralDirectoryFileHeaderTo: aStream.
		offset := offset + member centralDirectoryHeaderSize.
	].
	writeEOCDOffset := offset.
	self writeEndOfCentralDirectoryTo: aStream.

! !

!ZipArchive methodsFor: 'initialization' stamp: 'ar 3/2/2001 18:47'!
close
	self members do:[:m| m close].! !

!ZipArchive methodsFor: 'private' stamp: 'nk 2/21/2001 18:26'!
memberClass
	^ZipArchiveMember! !

!ZipArchive methodsFor: 'writing' stamp: 'nk 3/27/2002 10:42'!
writeTo: stream prepending: aString
	stream binary.
	stream nextPutAll: aString.
	members do: [ :member |
		member writeTo: stream.
		member endRead.
	].
	writeCentralDirectoryOffset := stream position.
	self writeCentralDirectoryTo: stream.
	! !

!ZipArchive methodsFor: 'private' stamp: 'nice 1/5/2010 15:59'!
readMembersFrom: stream named: fileName
	
	[ | signature newMember |
		newMember := self memberClass newFromZipFile: stream named: fileName.
		signature := self readSignatureFrom: stream.
		signature = EndOfCentralDirectorySignature ifTrue: [ ^self ].
		signature = CentralDirectoryFileHeaderSignature
			ifFalse: [ self error: 'bad CD signature at ', (stream position - 4) printStringHex ].
		newMember readFrom: stream.
		newMember looksLikeDirectory ifTrue: [ newMember := newMember asDirectory ].
		self addMember: newMember.
	] repeat.! !

!ZipArchive methodsFor: 'writing' stamp: 'nk 2/23/2001 10:29'!
writeTo: stream
	stream binary.
	members do: [ :member |
		member writeTo: stream.
		member endRead.
	].
	writeCentralDirectoryOffset := stream position.
	self writeCentralDirectoryTo: stream.
	! !

!ZipArchive methodsFor: 'accessing' stamp: 'nk 2/24/2001 13:44'!
zipFileComment
	^zipFileComment asString! !

!ZipArchive methodsFor: 'writing' stamp: 'nk 3/27/2002 12:41'!
writeTo: stream prependingFileNamed: aFileName
	| prepended buffer |
	stream binary.
	prepended := StandardFileStream readOnlyFileNamed: aFileName.
	prepended binary.
	buffer := ByteArray new: (prepended size min: 32768).
	[ prepended atEnd ] whileFalse: [ | bytesRead |
		bytesRead := prepended readInto: buffer startingAt: 1 count: buffer size.
		stream next: bytesRead putAll: buffer startingAt: 1
	].
	members do: [ :member |
		member writeTo: stream.
		member endRead.
	].
	writeCentralDirectoryOffset := stream position.
	self writeCentralDirectoryTo: stream.
	! !

!ZipArchive methodsFor: 'accessing' stamp: 'ar 3/1/2006 23:21'!
hasMemberSuchThat: aBlock
	"Answer whether we have a member satisfying the given condition"
	^self members anySatisfy: aBlock! !

!ZipArchive methodsFor: 'initialization' stamp: 'nk 2/22/2001 17:20'!
initialize
	super initialize.
	writeEOCDOffset := writeCentralDirectoryOffset := 0.
	zipFileComment := ''.
! !

!ZipArchive methodsFor: 'private' stamp: 'nk 8/21/2004 15:22'!
readSignatureFrom: stream
	"Returns next signature from given stream, leaves stream positioned afterwards."

	| signatureData | 
	signatureData := ByteArray new: 4.
	stream next: 4 into: signatureData.
	({ CentralDirectoryFileHeaderSignature . LocalFileHeaderSignature . EndOfCentralDirectorySignature }
		includes: signatureData)
			ifFalse: [ ^self error: 'bad signature ', signatureData asString asHex, ' at position ', (stream position - 4) asString ].
	^signatureData
! !

!ZipArchive methodsFor: 'private' stamp: 'nk 2/21/2001 21:02'!
writeEndOfCentralDirectoryTo: aStream

	aStream nextPutAll: EndOfCentralDirectorySignature.
	aStream nextLittleEndianNumber: 2 put: 0. "diskNumber"
	aStream nextLittleEndianNumber: 2 put: 0. "diskNumberWithStartOfCentralDirectory"
	aStream nextLittleEndianNumber: 2 put: members size. "numberOfCentralDirectoriesOnThisDisk"
	aStream nextLittleEndianNumber: 2 put: members size. "numberOfCentralDirectories"
	aStream nextLittleEndianNumber: 4 put: writeEOCDOffset - writeCentralDirectoryOffset. "size of central dir"
	aStream nextLittleEndianNumber: 4 put: writeCentralDirectoryOffset. "offset of central dir"
	aStream nextLittleEndianNumber: 2 put: zipFileComment size. "zip file comment"
	zipFileComment isEmpty ifFalse: [ aStream nextPutAll: zipFileComment ].

! !

!ZipArchive methodsFor: 'accessing' stamp: 'nk 2/24/2001 13:43'!
zipFileComment: aString
	zipFileComment := aString! !

!ZipArchive methodsFor: 'archive operations' stamp: 'S 6/17/2013 13:26'!
extractAllTo: aDirectory informing: bar overwrite: allOverwrite
	"Extract all elements to the given directory"
	| overwriteAll |
	overwriteAll := allOverwrite.
	self members do:[:entry| | dir |
		entry isDirectory ifTrue:[
			bar ifNotNil: [bar label: 'Creating ', entry fileName].
			dir := (entry fileName findTokens:'/') 
					inject: aDirectory into:[:base :part| base / part].
			dir ensureCreateDirectory.
		].
	].
	self members do:[:entry| | response |
		entry isDirectory ifFalse:[
			bar ifNotNil: [bar label: 'Extracting ', entry fileName].
			response := entry extractInDirectory: aDirectory overwrite: overwriteAll.
			response == #retryWithOverwrite ifTrue:[
				overwriteAll := true.
				response := entry extractInDirectory: aDirectory overwrite: overwriteAll.
			].
			response == #abort ifTrue:[^self].
			response == #failed ifTrue:[
				(self confirm: 'Failed to extract ', entry fileName, '. Proceed?') ifFalse:[^self].
			].
		].
	].
! !

!ZipArchive methodsFor: 'archive operations' stamp: 'sd 3/28/2008 11:03'!
extractAllTo: aDirectory 
	"Extract all elements to the given directory"
	UIManager default informUserDuring: 
		[ :bar | 
		self 
			extractAllTo: aDirectory
			informing: bar ]! !

!ZipArchive methodsFor: 'writing' stamp: 'StephaneDucasse 2/25/2010 18:06'!
writeToFileNamed: aFileName prepending: aString
	
	"Catch attempts to overwrite existing zip file"
	(self canWriteToFileNamed: aFileName)
		ifFalse: [ ^self error: (aFileName, ' is needed by one or more members in this archive') ].
	StandardFileStream 
		forceNewFileNamed: aFileName
		do: [ :stream | self writeTo: stream prepending: aString].
	! !

!ZipArchive methodsFor: 'accessing' stamp: 'nk 3/27/2002 11:23'!
prependedDataSize
	"Answer the size of whatever data exists before my first member.
	Assumes that I was read from a file or stream (i.e. the first member is a ZipFileMember)"
	^members isEmpty
		ifFalse: [ members first localHeaderRelativeOffset ]
		ifTrue: [ centralDirectoryOffsetWRTStartingDiskNumber ]! !

!ZipArchive class methodsFor: 'constants' stamp: 'nk 2/22/2001 14:12'!
compressionLevelNone
	^CompressionLevelNone ! !

!ZipArchive class methodsFor: '*System-FileRegistry' stamp: 'CamilloBruni 2/3/2013 17:21'!
fileReaderServicesForFile: fullName suffix: suffix 
	<fileService>
	"Answers a collection of services that can handle the file and suffixes"
	|  services |
	services := OrderedCollection new.
	({'zip'.'sar'.'pr'. 'mcz'. '*'} includes: suffix)
		ifTrue: [	services add: self serviceExtractAll].
	^services.! !

!ZipArchive class methodsFor: 'class initialization' stamp: 'IgorStasenko 4/26/2011 16:42'!
initialize
	"self initialize"
	Smalltalk tools fileList registerFileReader: self! !

!ZipArchive class methodsFor: 'constants' stamp: 'nk 2/22/2001 14:12'!
compressionLevelDefault
	^CompressionLevelDefault! !

!ZipArchive class methodsFor: 'file format' stamp: 'di 3/6/2002 21:20'!
isZipArchive: aStreamOrFileName
	"Answer whether the given filename represents a valid zip file."

	| stream eocdPosition |
	stream := aStreamOrFileName isStream
		ifTrue: [aStreamOrFileName]
		ifFalse: [StandardFileStream oldFileNamed: aStreamOrFileName].
	stream ifNil: [^ false].
	"nil happens sometimes somehow"
	stream size < 22 ifTrue: [^ false].
	stream binary.
	eocdPosition := self findEndOfCentralDirectoryFrom: stream.
	stream ~= aStreamOrFileName ifTrue: [stream close].
	^ eocdPosition > 0! !

!ZipArchive class methodsFor: 'constants' stamp: 'nk 2/22/2001 14:13'!
compressionDeflated
	^CompressionDeflated! !

!ZipArchive class methodsFor: 'constants' stamp: 'nk 2/22/2001 14:13'!
compressionStored
	^CompressionStored! !

!ZipArchive class methodsFor: 'fileIn/Out' stamp: 'MarcusDenker 11/8/2014 16:43'!
extractAllIn: aFileName
	"Service method to extract all contents of a zip."
	| directory |
	directory := (UIManager default chooseDirectoryFrom: aFileName asFileReference) ifNil: [^ self].
	^ (self new) 
		readFrom: aFileName;
		extractAllTo: directory.! !

!ZipArchive class methodsFor: '*System-FileRegistry' stamp: 'CarloTeixeira 8/3/2010 01:08'!
serviceExtractAll
	"Answer a service for extracting files in a zip to a user-specified directory"

	^ FileModifyingSimpleServiceEntry 
		provider: self
		label: 'extract all to...'
		selector: #extractAllIn: 
		description: 'extract all files to a user-specified directory'
		buttonLabel: 'extract all'! !

!ZipArchive class methodsFor: 'constants' stamp: 'ar 2/27/2001 13:38'!
validSignatures
	"Return the valid signatures for a zip file"
	^Array 
		with: LocalFileHeaderSignature
		with: CentralDirectoryFileHeaderSignature
		with: EndOfCentralDirectorySignature! !

!ZipArchive class methodsFor: 'constants' stamp: 'nk 8/21/2004 15:19'!
findEndOfCentralDirectoryFrom: stream
	"Seek in the given stream to the end, then read backwards until we find the
	signature of the central directory record. Leave the file positioned right
	before the signature.

	Answers the file position of the EOCD, or 0 if not found."

	| data fileLength seekOffset pos maxOffset |
	stream setToEnd.
	fileLength := stream position.
	"If the file length is less than 18 for the EOCD length plus 4 for the signature, we have a problem"
	fileLength < 22 ifTrue: [^ self error: 'file is too short'].
	
	seekOffset := 0.
	pos := 0.
	data := ByteArray new: 4100.
	maxOffset := 40960 min: fileLength.	"limit search range to 40K"

	[
		seekOffset := (seekOffset + 4096) min: fileLength.
		stream position: fileLength - seekOffset.
		data := stream next: (4100 min: seekOffset) into: data startingAt: 1.
		pos := data lastIndexOfPKSignature: EndOfCentralDirectorySignature.
		pos = 0 and: [seekOffset < maxOffset]
	] whileTrue.

	^ pos > 0
		ifTrue: [ | newPos | stream position: (newPos := (stream position + pos - seekOffset - 1)). newPos]
		ifFalse: [0]! !

!ZipArchiveMember commentStamp: '<historical>'!
Subinstances of me are members in a ZipArchive.
They represent different data sources:
	* ZipDirectoryMember -- a directory to be added to a zip file
	* ZipFileMember -- a file or directory that is already in a zip file
	* ZipNewFilemember -- a file that is to be added to a zip file
	* ZipStringMember -- a string that is to be added to a zip file

They can write their data to another stream either copying, compressing,
or decompressing as desired.!
!ZipArchiveMember methodsFor: 'testing' stamp: 'SeanDeNigris 5/16/2012 13:34'!
isEncrypted
	"Return true if this member is encrypted (this is unsupported)"
	^ (self bitFlag bitAnd: 1) ~= 0! !

!ZipArchiveMember methodsFor: 'accessing' stamp: 'nk 2/22/2001 00:28'!
crc32
	^crc32! !

!ZipArchiveMember methodsFor: 'accessing' stamp: 'SeanDeNigris 6/21/2012 22:34'!
lastModTime
	"Return my last modification date"

	^ lastModFileDateTime.! !

!ZipArchiveMember methodsFor: 'accessing - spec fields' stamp: 'SeanDeNigris 5/16/2012 17:38'!
versionNeededToExtract
	"See .ZIP File Format Specification Version: 6.3.2.
		For example, 2.0 means:
		- File is a folder (directory)
		- File is compressed using Deflate compression
		- File is encrypted using traditional PKWARE encryption"
	
	^ versionNeededToExtract.! !

!ZipArchiveMember methodsFor: 'extraction' stamp: 'CamilloBruni 5/4/2012 21:59'!
extractToFileNamed: aFileName
	self 
		extractToFileNamed: aFileName 
		inDirectory: FileSystem workingDirectory.! !

!ZipArchiveMember methodsFor: 'private-writing' stamp: 'nk 3/7/2004 15:42'!
copyDataWithCRCTo: aStream
	"Copy my data to aStream. Also set the CRC-32.
	Only used when compressionMethod = desiredCompressionMethod = CompressionStored"

	uncompressedSize := compressedSize := readDataRemaining.

	crc32 := 16rFFFFFFFF.

	[ readDataRemaining > 0 ] whileTrue: [ | data |
		data := self readRawChunk: (4096 min: readDataRemaining).
		aStream nextPutAll: data.
		crc32 := ZipWriteStream updateCrc: crc32 from: 1 to: data size in: data.
		readDataRemaining := readDataRemaining - data size.
	].

	crc32 := crc32 bitXor: 16rFFFFFFFF.
! !

!ZipArchiveMember methodsFor: 'testing' stamp: 'SeanDeNigris 5/16/2012 13:33'!
hasDataDescriptor
	^ (self bitFlag bitAnd: 8)	~= 0 "GPBF:=HAS:=DATA:=DESCRIPTOR:=MASK"! !

!ZipArchiveMember methodsFor: 'private' stamp: 'nk 2/21/2001 21:55'!
asDirectory
	^ZipDirectoryMember new copyFrom: self! !

!ZipArchiveMember methodsFor: 'initialization' stamp: 'SeanDeNigris 5/20/2012 10:02'!
initialize
	super initialize.
	lastModFileDateTime := DateAndTime epoch.
	fileAttributeFormat := FaUnix.
	self versionMadeBy: 20. "Dos-compatible file attributes; ZIP v. 2.0. See comment for #versionMadeBy"
	self versionNeededToExtract: 20. "ZIP v. 2.0. See comment for #versionNeededToExtract"
	self bitFlag: 0.
	compressionMethod := CompressionStored.
	desiredCompressionMethod := CompressionDeflated.
	desiredCompressionLevel := CompressionLevelDefault.
	internalFileAttributes := 0.
	externalFileAttributes := 0.
	fileName := ''.
	cdExtraField := ''.
	localExtraField := ''.
	fileComment := ''.
	crc32 := 0.
	compressedSize := 0.
	uncompressedSize := 0.
	self unixFileAttributes: DefaultFilePermissions.! !

!ZipArchiveMember methodsFor: 'testing' stamp: 'nk 2/22/2001 00:41'!
isTextFile
	"Returns true if I am a text file.
	Note that this module does not currently do anything with this flag
	upon extraction or storage.
	That is, bytes are stored in native format whether or not they came
	from a text file."
	^ (internalFileAttributes bitAnd: 1) ~= 0
! !

!ZipArchiveMember methodsFor: 'accessing' stamp: 'S 6/17/2013 13:26'!
extractToFileNamed: aLocalFileName inDirectory: dir
	| file fullDir |
	self isEncrypted
		ifTrue: [ ^self error: 'encryption unsupported' ].
	file := dir / aLocalFileName.
	file parent ensureCreateDirectory.
	self isDirectory 
		ifFalse: [
			fullDir 
				forceNewFileNamed: file basename 
				do: [:stream |  self extractTo: stream]]
		ifTrue: [ fullDir ensureCreateDirectory ]
! !

!ZipArchiveMember methodsFor: 'extraction' stamp: 'nk 12/20/2002 14:49'!
extractInDirectory: dir
	self extractToFileNamed: self localFileName inDirectory: dir
! !

!ZipArchiveMember methodsFor: 'accessing' stamp: 'nk 2/22/2001 00:25'!
fileComment
	^fileComment! !

!ZipArchiveMember methodsFor: 'private-writing' stamp: 'nk 2/22/2001 21:53'!
writeDataDescriptorTo: aStream
	"This writes a data descriptor to the given stream.
	Assumes that crc32, writeOffset, and uncompressedSize are
	set correctly (they should be after a write).
	Further, the local file header should have the
	GPBF:=HAS:=DATA:=DESCRIPTOR:=MASK (8) bit set."

	aStream nextLittleEndianNumber: 4 put: crc32.
	aStream nextLittleEndianNumber: 4 put: compressedSize.
	aStream nextLittleEndianNumber: 4 put: uncompressedSize.! !

!ZipArchiveMember methodsFor: 'testing' stamp: 'nk 2/22/2001 00:43'!
isTextFile: aBoolean
	"Set whether I am a text file.
	Note that this module does not currently do anything with this flag
	upon extraction or storage.
	That is, bytes are stored in native format whether or not they came
	from a text file."
	internalFileAttributes := aBoolean
		ifTrue: [ internalFileAttributes bitOr: 1 ]
		ifFalse: [ internalFileAttributes bitAnd: 1 bitInvert ]
! !

!ZipArchiveMember methodsFor: 'private' stamp: 'SeanDeNigris 5/20/2012 09:35'!
mapPermissionsFromUnix: unixPerms
	"Take Unix permissions (e.g. 8r40755 for a directory) and put them in the high 16 bits. The low 16 bits are for DOS permissions"
	
	^ unixPerms bitShift: 16.! !

!ZipArchiveMember methodsFor: 'private' stamp: 'nk 2/23/2001 08:24'!
endRead
	readDataRemaining := 0.! !

!ZipArchiveMember methodsFor: 'private' stamp: 'nk 4/28/2002 21:53'!
rewindData
	readDataRemaining :=  (desiredCompressionMethod = CompressionDeflated
		and: [ compressionMethod = CompressionDeflated ])
			ifTrue: [ compressedSize ]
			ifFalse: [ uncompressedSize ].
! !

!ZipArchiveMember methodsFor: 'extraction' stamp: 'nk 2/24/2001 18:03'!
extractTo: aStream from: start to: finish
	| oldCompression |
	self isEncrypted ifTrue: [ self error: 'encryption is unsupported' ].
	aStream binary.
	oldCompression := self desiredCompressionMethod: CompressionStored.
	self rewindData.
	self writeDataTo: aStream from: start to: finish.
	self desiredCompressionMethod: oldCompression.
	self endRead.! !

!ZipArchiveMember methodsFor: 'accessing' stamp: 'BG 3/16/2005 08:19'!
crc32String
	| hexString |
	hexString := crc32 storeStringHex.
	^('00000000' copyFrom: 1 to: 11 - (hexString size)) , (hexString copyFrom: 4 to: hexString size)! !

!ZipArchiveMember methodsFor: 'private' stamp: 'nk 2/22/2001 20:42'!
readRawChunk: n
	self subclassResponsibility! !

!ZipArchiveMember methodsFor: 'accessing - spec fields' stamp: 'SeanDeNigris 5/16/2012 17:37'!
bitFlag
	"Per .ZIP File Format Specification Version: 6.3.2:
		2 bytes:
		- Bit 0: If set, indicates that the file is encrypted.

		(For Method 6 - Imploding)
		- Bit 1: If the compression method used was type 6, Imploding, then this bit, if set, indicates an 8K sliding dictionary was used.  If clear, then a 4K sliding dictionary was used.
		- Bit 2: If the compression method used was type 6, Imploding, then this bit, if set, indicates 3 Shannon-Fano trees were used to encode the sliding dictionary output.  If clear, then 2 Shannon-Fano trees were used.

		(For Methods 8 and 9 - Deflating)
		Bit 2  Bit 1
		0      0    Normal (-en) compression option was used.
		0      1    Maximum (-exx/-ex) compression option was used.
		1      0    Fast (-ef) compression option was used.
		1      1    Super Fast (-es) compression option was used.

		(For Method 14 - LZMA)
		Bit 1: If the compression method used was type 14, LZMA, then this bit, if set, indicates an end-of-stream (EOS) marker is used to mark the end of the compressed data stream. If clear, then an EOS marker is not present and the compressed data size must be known to extract.

		Note:  Bits 1 and 2 are undefined if the compression method is any other.

		Bit 3: If this bit is set, the fields crc-32, compressed size and uncompressed size are set to zero in the local header.  The correct values are put in the data descriptor immediately following the compressed data.  (Note: PKZIP version 2.04g for DOS only recognizes this bit for method 8 compression, newer versions of PKZIP recognize this bit for any compression method.)

		Bit 4: Reserved for use with method 8, for enhanced deflating. 

		Bit 5: If this bit is set, this indicates that the file is compressed patched data.  (Note: Requires PKZIP version 2.70 or greater)

		Bit 6: Strong encryption.  If this bit is set, you should set the version needed to extract value to at least 50 and you must also set bit 0.  If AES encryption is used, the version needed to extract value must be at least 51.

		Bit 7: Currently unused.

		Bit 8: Currently unused.

		Bit 9: Currently unused.

		Bit 10: Currently unused.

		Bit 11: Language encoding flag (EFS).  If this bit is set, the filename and comment fields for this file must be encoded using UTF-8. (see APPENDIX D)

		Bit 12: Reserved by PKWARE for enhanced compression.

		Bit 13: Used when encrypting the Central Directory to indicate selected data values in the Local Header are masked to hide their actual values.  See the section describing the Strong Encryption Specification for details.

		Bit 14: Reserved by PKWARE.

		Bit 15: Reserved by PKWARE."
	
	^ bitFlag.! !

!ZipArchiveMember methodsFor: 'accessing' stamp: 'nk 11/11/2002 21:03'!
splitFileName
	"Answer my name split on slash boundaries. A directory will have a trailing empty string."
	^ fileName findTokens: '/'.! !

!ZipArchiveMember methodsFor: 'accessing' stamp: 'yo 2/24/2005 18:34'!
centralDirectoryHeaderSize

	| systemFileName systemFileComment systemCdExtraField |
	systemFileName := fileName asVmPathName.
	systemFileComment := fileComment convertToSystemString.
	systemCdExtraField := cdExtraField.
	^ 46 + systemFileName size + systemCdExtraField size + systemFileComment size
! !

!ZipArchiveMember methodsFor: 'accessing' stamp: 'nicolascellier 5/31/2013 23:01'!
contentStream
	"Answer my contents as a text stream.
	Default is no conversion, since we don't know what the bytes mean."

	^self contentStreamFromEncoding: 'latin1'
! !

!ZipArchiveMember methodsFor: 'private-writing' stamp: 'nk 2/24/2001 17:57'!
copyRawDataTo: aStream from: start to: finish

	readDataRemaining := readDataRemaining min: finish - start + 1.

	self readRawChunk: start - 1.

	[ readDataRemaining > 0 ] whileTrue: [ | data |
		data := self readRawChunk: (32768 min: readDataRemaining).
		aStream nextPutAll: data.
		readDataRemaining := readDataRemaining - data size.
	].
! !

!ZipArchiveMember methodsFor: 'private-writing' stamp: 'GabrielBarbuto 9/27/2010 10:53'!
writeDataTo: aStream
	"Copy my (possibly inflated or deflated) data to the given stream.
	This might do compression, decompression, or straight copying, depending
	on the values of compressionMethod and desiredCompressionMethod"

	"Note: Do not shortcut this method if uncompressedSize = 0. Even in this case
	data may be produced by the compressor (i.e., '' zipped size > 0) and must
	be stored in the file or else other utilities will treat the zip file as corrupt."

	(compressionMethod = CompressionStored and: [ desiredCompressionMethod = CompressionDeflated ])
		ifTrue: [ ^self compressDataTo: aStream ].

	(compressionMethod = CompressionDeflated and: [ desiredCompressionMethod = CompressionStored ])
		ifTrue: [ ^self uncompressDataTo: aStream ].

	self copyDataTo: aStream.! !

!ZipArchiveMember methodsFor: 'testing' stamp: 'nk 2/22/2001 00:00'!
isDirectory
	^false! !

!ZipArchiveMember methodsFor: 'extraction' stamp: 'nk 2/22/2001 18:03'!
extractTo: aStream
	| oldCompression |
	self isEncrypted ifTrue: [ self error: 'encryption is unsupported' ].
	aStream binary.
	oldCompression := self desiredCompressionMethod: CompressionStored.
	self rewindData.
	self writeDataTo: aStream.
	self desiredCompressionMethod: oldCompression.
	self endRead.! !

!ZipArchiveMember methodsFor: 'private-writing' stamp: 'nk 2/23/2001 11:04'!
copyDataTo: aStream

	compressionMethod = CompressionStored ifTrue: [ ^self copyDataWithCRCTo: aStream ].

	self copyRawDataTo: aStream.! !

!ZipArchiveMember methodsFor: 'accessing' stamp: 'nk 2/22/2001 00:25'!
fileComment: aString
	fileComment := aString! !

!ZipArchiveMember methodsFor: 'private-writing' stamp: 'SeanDeNigris 6/19/2012 10:10'!
refreshLocalFileHeaderTo: aStream
	"Re-writes my local header to the given stream.
	To be called after writing the data stream.
	Assumes that fileName and localExtraField sizes didn't change since last written."

	| here systemFileName |
	self flag: 'WTF!! What is the purpose of this method?!! We just wrote the headers. Why write them again?'.
	here := aStream position.
	systemFileName := fileName asVmPathName.
	aStream position: writeLocalHeaderRelativeOffset.

	aStream nextPutAll: LocalFileHeaderSignature.
	aStream nextLittleEndianNumber: 2 put: versionNeededToExtract.
	aStream nextLittleEndianNumber: 2 put: self bitFlag.
	aStream nextLittleEndianNumber: 2 put: desiredCompressionMethod.
	aStream nextLittleEndianNumber: 4 put: lastModFileDateTime asDosTimestamp.
	aStream nextLittleEndianNumber: 4 put: crc32.
	aStream nextLittleEndianNumber: 4 put: (desiredCompressionMethod = CompressionStored
												ifTrue: [ uncompressedSize ] ifFalse: [ compressedSize ]).
	aStream nextLittleEndianNumber: 4 put: uncompressedSize.
	aStream nextLittleEndianNumber: 2 put: systemFileName size.
	aStream nextLittleEndianNumber: 2 put: localExtraField size.

	aStream position: here.
! !

!ZipArchiveMember methodsFor: 'testing' stamp: 'nk 2/21/2001 20:38'!
looksLikeDirectory
	^false! !

!ZipArchiveMember methodsFor: 'writing' stamp: 'nk 2/23/2001 11:28'!
writeTo: aStream
	self rewindData.
	writeLocalHeaderRelativeOffset := aStream position.
	self writeLocalFileHeaderTo: aStream.
	self writeDataTo: aStream.
	self refreshLocalFileHeaderTo: aStream.! !

!ZipArchiveMember methodsFor: 'accessing' stamp: 'nk 2/22/2001 00:38'!
compressedSize
	"Return the compressed size for this member.
	This will not be set for members that were constructed from strings
	or external files until after the member has been written."
	^compressedSize! !

!ZipArchiveMember methodsFor: 'reading' stamp: 'nk 2/24/2001 23:53'!
contentsFrom: start to: finish
	"Answer my contents as a string."
	| s |
	s := RWBinaryOrTextStream on: (String new: finish - start + 1).
	self extractTo: s from: start to: finish.
	s text.
	^s contents! !

!ZipArchiveMember methodsFor: 'accessing - spec fields' stamp: 'SeanDeNigris 5/16/2012 17:29'!
versionNeededToExtract: anInteger
	"See comment for #versionNeededToExtract"
	
	versionNeededToExtract := anInteger.! !

!ZipArchiveMember methodsFor: 'private-writing' stamp: 'ar 2/28/2001 14:01'!
compressDataTo: aStream
	"Copy my deflated data to the given stream."
	| encoder startPos endPos |

	encoder := ZipWriteStream on: aStream.
	startPos := aStream position.

	[ readDataRemaining > 0 ] whileTrue: [ | data |
		data := self readRawChunk: (4096 min: readDataRemaining).
		encoder nextPutAll: data asByteArray.
		readDataRemaining := readDataRemaining - data size.
	].
	encoder finish. "not close!!"
	endPos := aStream position.
	compressedSize := endPos - startPos.
	crc32 := encoder crc.
! !

!ZipArchiveMember methodsFor: 'private' stamp: 'SeanDeNigris 5/20/2012 09:37'!
mapPermissionsToUnix: zipPerms
	"Extract Unix permissions (the high 16 bits) from zip permissions. The low 16 bits are for DOS permissions"
	
	^ zipPerms bitShift: -16.! !

!ZipArchiveMember methodsFor: 'private-writing' stamp: 'SeanDeNigris 6/19/2012 10:11'!
writeCentralDirectoryFileHeaderTo: aStream
	"C2 v3 V4 v5 V2"

	| systemFileName systemFileComment systemCdExtraField |
	systemFileName := fileName asVmPathName.
	systemFileComment := fileComment convertToSystemString.
	systemCdExtraField := cdExtraField.
	aStream nextPutAll: CentralDirectoryFileHeaderSignature.
	aStream nextLittleEndianNumber: 1 put: self versionMadeBy.
	aStream nextLittleEndianNumber: 1 put: fileAttributeFormat.

	aStream nextLittleEndianNumber: 2 put: versionNeededToExtract.
	aStream nextLittleEndianNumber: 2 put: self bitFlag.
	aStream nextLittleEndianNumber: 2 put: desiredCompressionMethod.

	aStream nextLittleEndianNumber: 4 put: lastModFileDateTime asDosTimestamp.

	"These next 3 should have been updated during the write of the data"
	aStream nextLittleEndianNumber: 4 put: crc32.
	aStream nextLittleEndianNumber: 4 put: (desiredCompressionMethod = CompressionStored
												ifTrue: [ uncompressedSize ] ifFalse: [ compressedSize ]).
	aStream nextLittleEndianNumber: 4 put: uncompressedSize.

	aStream nextLittleEndianNumber: 2 put: systemFileName size.
	aStream nextLittleEndianNumber: 2 put: systemCdExtraField size.
	aStream nextLittleEndianNumber: 2 put: systemFileComment size.
	aStream nextLittleEndianNumber: 2 put: 0.		"diskNumberStart"
	aStream nextLittleEndianNumber: 2 put: internalFileAttributes.

	aStream nextLittleEndianNumber: 4 put: externalFileAttributes.
	aStream nextLittleEndianNumber: 4 put: writeLocalHeaderRelativeOffset.

	aStream nextPutAll: systemFileName asByteArray.
	aStream nextPutAll: systemCdExtraField asByteArray.
	aStream nextPutAll: systemFileComment asByteArray.! !

!ZipArchiveMember methodsFor: 'accessing' stamp: 'nk 2/21/2001 22:03'!
desiredCompressionMethod
	"Get my desiredCompressionMethod.
	This is the method that will be used to write"

	^desiredCompressionMethod! !

!ZipArchiveMember methodsFor: 'accessing' stamp: 'CamilloBruni 5/7/2012 02:24'!
localFileName
	"Answer my fileName in terms of the local directory naming convention"
	^ fileName copyReplaceAll: '/' with: FileSystem disk delimiter asString.! !

!ZipArchiveMember methodsFor: 'accessing' stamp: 'nk 2/21/2001 22:14'!
desiredCompressionLevel: aNumber
	"Set my desiredCompressionLevel
	This is the method that will be used to write.
	Returns prior desiredCompressionLevel.

	Valid arguments are 0 (CompressionLevelNone) through 9,
	including 6 (CompressionLevelDefault).

	0 (CompressionLevelNone) will change the desiredCompressionMethod
	to CompressionStored. All other arguments will change the
	desiredCompressionMethod to CompressionDeflated."

	| old |
	old := desiredCompressionLevel.
	desiredCompressionLevel := aNumber.
	desiredCompressionMethod := (aNumber > 0)
		ifTrue: [ CompressionDeflated ]
		ifFalse: [ CompressionStored ].
	^old! !

!ZipArchiveMember methodsFor: 'accessing' stamp: 'nk 2/22/2001 00:38'!
uncompressedSize
	"Return the uncompressed size for this member."
	^uncompressedSize! !

!ZipArchiveMember methodsFor: 'accessing - spec fields' stamp: 'SeanDeNigris 5/16/2012 17:37'!
versionMadeBy
	"Per .ZIP File Format Specification Version: 6.3.2:
		2 Bytes:
		- The upper byte indicates the compatibility of the file attribute information.  If the external file attributes are compatible with MS-DOS and can be read by PKZIP for DOS version 2.04g then this value will be zero.
		- The lower byte indicates the ZIP specification version (the version of PKWARE Appnote) supported by the software used to encode the file.  The value / 10 indicates the major version number, and the value mod 10 is the minor version number"
	
	^ versionMadeBy.! !

!ZipArchiveMember methodsFor: 'accessing - spec fields' stamp: 'SeanDeNigris 5/16/2012 17:20'!
versionMadeBy: anInteger
	"See comment for #versionMadeBy"
	
	versionMadeBy := anInteger.! !

!ZipArchiveMember methodsFor: 'accessing' stamp: 'nk 2/23/2001 08:00'!
clearExtraFields
	cdExtraField := ''.
	localExtraField := ''.! !

!ZipArchiveMember methodsFor: 'accessing' stamp: 'nk 2/21/2001 22:02'!
compressionMethod
	"Returns my compression method. This is the method that is
	currently being used to compress my data.

	This will be CompressionStored for added string or file members,
	or CompressionStored or CompressionDeflated (others are possible but not handled)"

	^compressionMethod! !

!ZipArchiveMember methodsFor: 'extraction' stamp: 'S 6/17/2013 13:26'!
extractInDirectory: aDirectory overwrite: overwriteAll
	"Extract this entry into the given directory. Answer #okay, #failed, #abort, or #retryWithOverwrite."
	| path fileDir file index localName |
	path := fileName findTokens: '/'.
	localName := path last.
	fileDir := path allButLast inject: aDirectory into: [ :base :part | base / part ].
	fileDir ensureCreateDirectory.
	file := fileDir / localName.
	file exists ifTrue: [
		overwriteAll ifFalse:[
			[index := UIManager default chooseFrom: {
						'Yes, overwrite'. 
						'No, don''t overwrite'. 
						'Overwrite ALL files'.
						'Cancel operation'
					} lines: #(2) title: fileName, ' already exists. Overwrite?'.
			index == nil] whileTrue.
			index = 4 ifTrue:[^#abort].
			index = 3 ifTrue:[^#retryWithOverwrite].
			index = 2 ifTrue:[^#okay].
		].
		file ensureDelete.
		file := [file ensureCreateFile] on: Error do:[:ex| ^#failed].
	].
	file writeStreamDo: [ :str | self extractTo: str ].
	^#okay! !

!ZipArchiveMember methodsFor: 'private-writing' stamp: 'nk 2/23/2001 11:04'!
copyRawDataTo: aStream

	[ readDataRemaining > 0 ] whileTrue: [ | data |
		data := self readRawChunk: (4096 min: readDataRemaining).
		aStream nextPutAll: data.
		readDataRemaining := readDataRemaining - data size.
	].
! !

!ZipArchiveMember methodsFor: 'private-writing' stamp: 'SeanDeNigris 6/19/2012 10:10'!
writeLocalFileHeaderTo: aStream
	"Write my local header to a file handle.
	Stores the offset to the start of the header in my
	writeLocalHeaderRelativeOffset member."

	| systemFileName |
	systemFileName := fileName asVmPathName.
	aStream nextPutAll: LocalFileHeaderSignature.
	aStream nextLittleEndianNumber: 2 put: versionNeededToExtract.
	aStream nextLittleEndianNumber: 2 put: self bitFlag.
	aStream nextLittleEndianNumber: 2 put: desiredCompressionMethod.

	aStream nextLittleEndianNumber: 4 put: lastModFileDateTime asDosTimestamp.
	aStream nextLittleEndianNumber: 4 put: crc32.
	aStream nextLittleEndianNumber: 4 put: (desiredCompressionMethod = CompressionStored
												ifTrue: [ uncompressedSize ] ifFalse: [ compressedSize ]).
	aStream nextLittleEndianNumber: 4 put: uncompressedSize.

	aStream nextLittleEndianNumber: 2 put: systemFileName size.
	aStream nextLittleEndianNumber: 2 put: localExtraField size.

	aStream nextPutAll: systemFileName asByteArray.
	aStream nextPutAll: localExtraField asByteArray.
! !

!ZipArchiveMember methodsFor: 'accessing' stamp: 'SeanDeNigris 5/18/2012 12:58'!
modifiedAt: aDateAndTime

	lastModFileDateTime := aDateAndTime.! !

!ZipArchiveMember methodsFor: 'accessing' stamp: 'SeanDeNigris 5/18/2012 11:06'!
desiredCompressionMethod: aNumber
	"Set my desiredCompressionMethod
	This is the method that will be used to write.
	Answers prior desiredCompressionMethod.

	Only CompressionDeflated or CompressionStored are valid arguments.

	Changing to CompressionStored will change my desiredCompressionLevel
	to CompressionLevelNone; changing to CompressionDeflated will change my
	desiredCompressionLevel to CompressionLevelDefault."

	| old |
	self flag: 'should be an error if unsupported, but valid zip compression is requested. Also, clean up test branches here'.
	old := desiredCompressionMethod.
	desiredCompressionMethod := aNumber.
	desiredCompressionLevel := (aNumber = CompressionDeflated)
			ifTrue: [ CompressionLevelDefault ]
			ifFalse: [ CompressionLevelNone ].
	compressionMethod = CompressionStored ifTrue: [ compressedSize := uncompressedSize ].
	^old.! !

!ZipArchiveMember methodsFor: 'private-writing' stamp: 'nk 2/24/2001 18:01'!
writeDataTo: aStream from: start to: finish
	"Copy my (possibly inflated or deflated) data to the given stream.
	But only the specified byte range.
	This might do decompression, or straight copying, depending
	on the values of compressionMethod and desiredCompressionMethod"

	uncompressedSize = 0 ifTrue: [ ^self ].	"nothing to do because no data"
	start > finish ifTrue: [ ^self ].
	start > uncompressedSize ifTrue: [ ^self ].

	(compressionMethod = CompressionStored and: [ desiredCompressionMethod = CompressionDeflated ])
		ifTrue: [ ^self error: 'only supports uncompression or copying right now' ].

	(compressionMethod = CompressionDeflated and: [ desiredCompressionMethod = CompressionStored ])
		ifTrue: [ ^self uncompressDataTo: aStream from: start to: finish ].

	self copyRawDataTo: aStream from: start to: finish.! !

!ZipArchiveMember methodsFor: 'accessing - spec fields' stamp: 'SeanDeNigris 5/16/2012 17:37'!
bitFlag: aNumber
	"See comment for #bitFlag"
	
	bitFlag := aNumber.! !

!ZipArchiveMember methodsFor: 'accessing' stamp: 'SeanDeNigris 5/20/2012 09:38'!
unixFileAttributes: perms
	"See #unixFileAttributes comment"
	
	| oldPerms newPerms |
	oldPerms := self mapPermissionsToUnix: externalFileAttributes.
	newPerms :=  self isDirectory
			ifTrue: [ (perms bitAnd: FileAttrib bitInvert) bitOr: DirectoryAttrib ]
			ifFalse: [ (perms bitAnd: DirectoryAttrib bitInvert) bitOr: FileAttrib ].
	externalFileAttributes := self mapPermissionsFromUnix: newPerms.
	^oldPerms.! !

!ZipArchiveMember methodsFor: 'accessing' stamp: 'nicolascellier 5/31/2013 22:39'!
contentStreamFromEncoding: encodingName
	"Answer my contents as a text stream.
	Interpret the raw bytes with given encodingName"

	| s |
	s := MultiByteBinaryOrTextStream on: (String new: self uncompressedSize).
	s converter:  (TextConverter newForEncoding: encodingName).
	self extractTo: s.
	s reset.
	^ s
! !

!ZipArchiveMember methodsFor: 'accessing' stamp: 'nk 2/21/2001 22:10'!
desiredCompressionLevel
	^desiredCompressionLevel! !

!ZipArchiveMember methodsFor: 'reading' stamp: 'nk 2/24/2001 22:28'!
contents
	"Answer my contents as a string."
	| s |
	s := RWBinaryOrTextStream on: (String new: self uncompressedSize).
	self extractTo: s.
	s text.
	^s contents! !

!ZipArchiveMember methodsFor: 'accessing' stamp: 'SeanDeNigris 5/20/2012 08:27'!
unixFileAttributes
	"See comment at end"

	^self mapPermissionsToUnix: externalFileAttributes.
	
"Per http://unix.stackexchange.com/questions/14705/the-zip-formats-external-file-attribute : These values can all be found in <sys/stat.h> - link to 4.4BSD version. These are not in the POSIX standard (which defines test macros instead); but originate from AT&T Unix and BSD. (in GNU libc / Linux, the values themselves are defined as __S_IFDIR etc in bits/stat.h, though the kernel header might be easier to read - the values are all the same pretty much everywhere.)

#define S_IFIFO  0010000  /* named pipe (fifo) */
#define S_IFCHR  0020000  /* character special */
#define S_IFDIR  0040000  /* directory */
#define S_IFBLK  0060000  /* block special */
#define S_IFREG  0100000  /* regular */
#define S_IFLNK  0120000  /* symbolic link */
#define S_IFSOCK 0140000  /* socket */
And of course, the other 12 bits are for the permissions and setuid/setgid/sticky bits, the same as for chmod:

#define S_ISUID 0004000 /* set user id on execution */
#define S_ISGID 0002000 /* set group id on execution */
#define S_ISTXT 0001000 /* sticky bit */
#define S_IRWXU 0000700 /* RWX mask for owner */
#define S_IRUSR 0000400 /* R for owner */
#define S_IWUSR 0000200 /* W for owner */
#define S_IXUSR 0000100 /* X for owner */
#define S_IRWXG 0000070 /* RWX mask for group */
#define S_IRGRP 0000040 /* R for group */
#define S_IWGRP 0000020 /* W for group */
#define S_IXGRP 0000010 /* X for group */
#define S_IRWXO 0000007 /* RWX mask for other */
#define S_IROTH 0000004 /* R for other */
#define S_IWOTH 0000002 /* W for other */
#define S_IXOTH 0000001 /* X for other */
#define S_ISVTX 0001000 /* save swapped text even after use"! !

!ZipArchiveMember class methodsFor: 'instance creation' stamp: 'nk 2/22/2001 17:27'!
newFromDirectory: aFileName
	^ZipDirectoryMember newNamed: aFileName! !

!ZipArchiveMember class methodsFor: 'instance creation' stamp: 'nk 2/22/2001 17:27'!
newFromFile: aFileName
	^ZipNewFileMember newNamed: aFileName! !

!ZipArchiveMember class methodsFor: 'instance creation' stamp: 'nk 2/22/2001 17:25'!
newFromString: aString named: aFileName
	^ZipStringMember newFrom: aString named: aFileName! !

!ZipArchiveMember class methodsFor: 'instance creation' stamp: 'nk 2/21/2001 20:40'!
newFromZipFile: stream named: fileName
	^ZipFileMember newFrom: stream named: fileName! !

!ZipArchiveTest commentStamp: 'TorstenBergmann 2/3/2014 23:04'!
SUnit tests for ZIP archives!
!ZipArchiveTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/21/2012 22:34'!
testSetLastModification

	| aDateAndTime member |
	aDateAndTime := '15 January, 2000T13:23:55'.
	member := zip addDeflateString: 'foo' as: 'bar'.
	member modifiedAt: aDateAndTime.
	self assert: member lastModTime equals: aDateAndTime.! !

!ZipArchiveTest methodsFor: 'tests' stamp: 'StephaneDucasse 6/17/2013 15:54'!
tearDown

	fileToZip ensureDelete.
	zip close.	
	subdir ensureDeleteAll.
	zipFile ensureDelete.! !

!ZipArchiveTest methodsFor: 'tests' stamp: 'SeanDeNigris 5/18/2012 22:31'!
testAddNonExistentFile
	
	self should: [ zip addFile: 'it_would_be_crazy_if_this_file_existed.ext' ] raise: FileDoesNotExistException.! !

!ZipArchiveTest methodsFor: 'tests' stamp: 'SeanDeNigris 6/21/2012 22:34'!
testDate29Feb2000
	"Ensure that dates with leap years don't screw up in the conversion"

	| archive member theDate |
	theDate := Date year: 2000 month: 2 day: 29.
	archive := ZipArchive new.
	member := archive addDeflateString: 'foo' as: 'bar'.
	member modifiedAt: theDate.
	self assert: member lastModTime equals: theDate.! !

!ZipArchiveTest methodsFor: 'tests' stamp: 'CamilloBruni 10/23/2012 20:51'!
testZip
	
	| localFileHeaderSignature versionNeededToExtract bitFlag deflateCompressionMethod realModificationStamp expectedCrc32 expectedCompressedSize expectedUncompressedSize centralDirectoryOffset centralDirectoryEnd |
	
	realModificationStamp := fileToZip entry modification.
	zip	
		addFile: fileToZip fullName
		as: fileToZip basename.
		
	zip writeToFileNamed: zipFile fullName.
	
	zipFile readStreamDo: [ :str |
		str binary.
		localFileHeaderSignature := 16r04034b50.
		versionNeededToExtract := 20.
		bitFlag := 0.
		deflateCompressionMethod := 8.
		expectedCrc32 := 16r2ab092ee. "I don''t know how to compute this, but OS X returned the same, so guessing it's correct"
		expectedCompressedSize := 15.
		expectedUncompressedSize := 13.
		
		"Test file"
		self assert: (str nextLittleEndianNumber: 4) equals: localFileHeaderSignature.
		self assert: (str nextLittleEndianNumber: 2) equals: versionNeededToExtract.
		self assert: (str nextLittleEndianNumber: 2) equals: bitFlag.
		self assert: (str nextLittleEndianNumber: 2) equals: deflateCompressionMethod.
		self assert: ((DateAndTime fromDosTimestamp: (str nextLittleEndianNumber: 4)) between: realModificationStamp - 1 second and: realModificationStamp + 1 seconds).
		self assert: (str nextLittleEndianNumber: 4) equals: expectedCrc32.
		self assert: (str nextLittleEndianNumber: 4) equals: expectedCompressedSize.
		self assert: (str nextLittleEndianNumber: 4) equals: expectedUncompressedSize.
		self assert: (str nextLittleEndianNumber: 2) equals: fileToZip basename size.
		self assert: (str nextLittleEndianNumber: 2) equals: 0 "Extra header length".
		self assert: (str next: fileToZip basename size) asString equals: fileToZip basename.
		self assert: (str next: expectedCompressedSize) isNil not "I don''t understand the compression yet".
		
		"Central directory structure"
		centralDirectoryOffset := str position.
		self assert: (str nextLittleEndianNumber: 4) equals: 16r02014b50.
		
		self flag: 'I think this is wrong. What is version 1.4?!!'.
		self assert: (str nextLittleEndianNumber: 2) equals:  16r314.
		self assert: (str nextLittleEndianNumber: 2) equals: versionNeededToExtract.
		self assert: (str nextLittleEndianNumber: 2) equals: bitFlag.
		self assert: (str nextLittleEndianNumber: 2) equals: deflateCompressionMethod.
		self assert: ((DateAndTime fromDosTimestamp: (str nextLittleEndianNumber: 4)) between: realModificationStamp - 1 second and: realModificationStamp + 1 seconds).
		self assert: (str nextLittleEndianNumber: 4) equals: expectedCrc32.
		self assert: (str nextLittleEndianNumber: 4) equals: expectedCompressedSize.
		self assert: (str nextLittleEndianNumber: 4) equals: expectedUncompressedSize.
		self assert: (str nextLittleEndianNumber: 2) equals: fileToZip basename size.
		self assert: (str nextLittleEndianNumber: 2) equals: 0 "Extra header length".
		self assert: (str nextLittleEndianNumber: 2) equals: 0 "File comment".
		self assert: (str nextLittleEndianNumber: 2) equals: 0 "Disk number start".
		self assert: (str nextLittleEndianNumber: 2) equals: 0 "Internal file attributes".
		
		self flag: 'I don''t understand the attributes yet'.
		self assert: (str nextLittleEndianNumber: 4) equals:  16r81B60000 "External file attributes".
		self assert: (str nextLittleEndianNumber: 4) equals:  0 "Relative offset of local header".
		self assert: (str next: fileToZip basename size) asString equals: fileToZip basename.
		centralDirectoryEnd := str position.
		
		"End of central directory record"
		self assert: (str nextLittleEndianNumber: 4) equals: 16r6054B50 "Signature".
		self assert: (str nextLittleEndianNumber: 2) equals: 0 "Disk number".
		self assert: (str nextLittleEndianNumber: 2) equals: 0 "Disk # where central dir started".
		self assert: (str nextLittleEndianNumber: 2) equals: 1 "Total entries in central dir on this disk".
		self assert: (str nextLittleEndianNumber: 2) equals: 1 "Total entries in central dir".
		self assert: (str nextLittleEndianNumber: 4) equals: centralDirectoryEnd  - centralDirectoryOffset "Central directory size".
		self assert: (str nextLittleEndianNumber: 4) equals: centralDirectoryOffset "from start of first disk".
		self assert: (str nextLittleEndianNumber: 2) equals: 0 "zip comment length".
		self assert: str atEnd ].! !

!ZipArchiveTest methodsFor: 'tests' stamp: 'CamilloBruni 10/23/2012 20:56'!
testCreateWithRelativeNames
	"Test creating a zip with a relative tree of files, so that the tree will
	be created whereever the ."
	
	| nestedFileToZip localFileHeaderSignature versionNeededToExtract bitFlag deflateCompressionMethod expectedCrc32 expectedUncompressedSize folderModified centralDirectoryOffset centralDirectoryEnd expectedCompressedSize fileModified fileStart |
	nestedFileToZip := subdir / '_test-zip-file'.
	nestedFileToZip writeStreamDo: [ :stream | stream nextPutAll: 'file contents' ].
	fileModified := nestedFileToZip entry modification.
	folderModified := subdir entry modification.
	zip
		addDirectory: subdir fullName
		as: subdir basename.
	zip	
		addFile: nestedFileToZip fullName
		as: nestedFileToZip basename.
		
	zip writeToFileNamed: zipFile fullName.
	
	zipFile readStreamDo: [ :str |
		str binary.
		localFileHeaderSignature := 16r04034b50.
		versionNeededToExtract := 20.
		bitFlag := 0.
		deflateCompressionMethod := 8.
		expectedCrc32 := 16r2ab092ee. "I don''t know how to compute this, but OS X returned the same, so guessing it's correct"
		expectedCompressedSize := 15.
		expectedUncompressedSize := 13.
		
		"folder"
		self assert: (str nextLittleEndianNumber: 4) equals: localFileHeaderSignature.
		self assert: (str nextLittleEndianNumber: 2) equals: versionNeededToExtract.
		self assert: (str nextLittleEndianNumber: 2) equals: bitFlag.
		self assert: (str nextLittleEndianNumber: 2) equals: 0 "No compression".
		self assert: ((DateAndTime fromDosTimestamp: (str nextLittleEndianNumber: 4)) between: folderModified - 1 second and: folderModified + 1 seconds).
		self assert: (str nextLittleEndianNumber: 4) equals: 0 "expectedCrc32".
		self assert: (str nextLittleEndianNumber: 4) equals: 0 "expectedCompressedSize".
		self assert: (str nextLittleEndianNumber: 4) equals: 0 "expectedUncompressedSize".
		self assert: (str nextLittleEndianNumber: 2) equals: subdir basename size + 1.
		self assert: (str nextLittleEndianNumber: 2) equals: 0 "Extra header length".
		self assert: (str next: subdir basename size + 1) asString equals: subdir basename, '/'.
		
		"Test file"
		fileStart := str position.
		self assert: (str nextLittleEndianNumber: 4) equals: localFileHeaderSignature.
		self assert: (str nextLittleEndianNumber: 2) equals: versionNeededToExtract.
		self assert: (str nextLittleEndianNumber: 2) equals: bitFlag.
		self assert: (str nextLittleEndianNumber: 2) equals: deflateCompressionMethod.
		self assert: ((DateAndTime fromDosTimestamp: (str nextLittleEndianNumber: 4)) between: fileModified - 1 second and: fileModified + 1 seconds).
		self assert: (str nextLittleEndianNumber: 4) equals: expectedCrc32.
		self assert: (str nextLittleEndianNumber: 4) equals: expectedCompressedSize.
		self assert: (str nextLittleEndianNumber: 4) equals: expectedUncompressedSize.
		self assert: (str nextLittleEndianNumber: 2) equals: nestedFileToZip basename size.
		self assert: (str nextLittleEndianNumber: 2) equals: 0 "Extra header length".
		self assert: (str next: nestedFileToZip basename size) asString equals: (nestedFileToZip basename copy replaceAll: DiskStore delimiter with: $/).
		self assert: (str next: expectedCompressedSize) isNil not "I don''t understand the compression yet".
		
		"Central directory structure"
		centralDirectoryOffset := str position.
		
		"Folder entry"
		self assert: (str nextLittleEndianNumber: 4) equals: 16r02014b50.	
		self flag: 'I think this is wrong. What is version 1.4?!!'.
		self assert: (str nextLittleEndianNumber: 2) equals:  16r314.
		self assert: (str nextLittleEndianNumber: 2) equals: versionNeededToExtract.
		self assert: (str nextLittleEndianNumber: 2) equals: bitFlag.
		self assert: (str nextLittleEndianNumber: 2) equals: 0 "no compression".
		self assert: ((DateAndTime fromDosTimestamp: (str nextLittleEndianNumber: 4)) between: folderModified - 1 second and: folderModified + 1 seconds).
		self assert: (str nextLittleEndianNumber: 4) equals: 0 "expectedCrc32".
		self assert: (str nextLittleEndianNumber: 4) equals: 0 "expectedCompressedSize".
		self assert: (str nextLittleEndianNumber: 4) equals: 0 "expectedUncompressedSize".
		self assert: (str nextLittleEndianNumber: 2) equals: subdir basename size + 1.
		self assert: (str nextLittleEndianNumber: 2) equals: 0 "Extra header length".
		self assert: (str nextLittleEndianNumber: 2) equals: 0 "File comment".
		self assert: (str nextLittleEndianNumber: 2) equals: 0 "Disk number start".
		self assert: (str nextLittleEndianNumber: 2) equals: 0 "Internal file attributes".
		
		self flag: 'I don''t understand the attributes yet'.
		self assert: (str nextLittleEndianNumber: 4) equals:  8r040755 << 16 "External file attributes".
		self assert: (str nextLittleEndianNumber: 4) equals:  0 "Relative offset of local header".
		self assert: (str next: subdir basename size + 1) asString equals: subdir basename, '/'.
		
		"Nested file entry"
		self assert: (str nextLittleEndianNumber: 4) equals: 16r02014b50.
		
		self flag: 'I think this is wrong. What is version 1.4?!!'.
		self assert: (str nextLittleEndianNumber: 2) equals:  16r314.
		self assert: (str nextLittleEndianNumber: 2) equals: versionNeededToExtract.
		self assert: (str nextLittleEndianNumber: 2) equals: bitFlag.
		self assert: (str nextLittleEndianNumber: 2) equals: deflateCompressionMethod.
		self assert: ((DateAndTime fromDosTimestamp: (str nextLittleEndianNumber: 4)) between: fileModified - 1 second and: fileModified + 1 seconds).
		self assert: (str nextLittleEndianNumber: 4) equals: expectedCrc32.
		self assert: (str nextLittleEndianNumber: 4) equals: expectedCompressedSize.
		self assert: (str nextLittleEndianNumber: 4) equals: expectedUncompressedSize.
		self assert: (str nextLittleEndianNumber: 2) equals: nestedFileToZip basename size.
		self assert: (str nextLittleEndianNumber: 2) equals: 0 "Extra header length".
		self assert: (str nextLittleEndianNumber: 2) equals: 0 "File comment".
		self assert: (str nextLittleEndianNumber: 2) equals: 0 "Disk number start".
		self assert: (str nextLittleEndianNumber: 2) equals: 0 "Internal file attributes".
		
		self flag: 'I don''t understand the attributes yet'.
		self assert: (str nextLittleEndianNumber: 4) equals: 8r0100666 << 16 "External file attributes".
		self assert: (str nextLittleEndianNumber: 4) equals: fileStart "Relative offset of local header".
		self assert: (str next: nestedFileToZip basename size) asString equals:  (nestedFileToZip basename copy replaceAll: DiskStore delimiter with: $/).

		centralDirectoryEnd := str position.
		
		"End of central directory record"
		self assert: (str nextLittleEndianNumber: 4) equals: 16r6054B50 "Signature".
		self assert: (str nextLittleEndianNumber: 2) equals: 0 "Disk number".
		self assert: (str nextLittleEndianNumber: 2) equals: 0 "Disk # where central dir started".
		self assert: (str nextLittleEndianNumber: 2) equals: 2 "Total entries in central dir on this disk".
		self assert: (str nextLittleEndianNumber: 2) equals: 2 "Total entries in central dir".
		self assert: (str nextLittleEndianNumber: 4) equals: centralDirectoryEnd  - centralDirectoryOffset "Central directory size".
		self assert: (str nextLittleEndianNumber: 4) equals: centralDirectoryOffset "from start of first disk".
		self assert: (str nextLittleEndianNumber: 2) equals: 0 "zip comment length".
		self assert: str atEnd ].! !

!ZipArchiveTest methodsFor: 'tests' stamp: 'CamilloBruni 10/23/2012 20:55'!
testFilePermissions

	| nestedFileToZip fileModified folderModified folderMember fileMember |
	nestedFileToZip := subdir / '_test-zip-file'.
	nestedFileToZip writeStreamDo: [ :stream | stream nextPutAll: 'file contents' ].
	fileModified := nestedFileToZip entry modification asTime.
	folderModified := subdir entry modification asTime.
	folderMember := zip
		addDirectory: subdir fullName
		as: subdir basename.
	fileMember := zip	
		addFile: nestedFileToZip fullName
		as: nestedFileToZip basename.
	zip writeToFileNamed: zipFile fullName.
	
	self assert: fileMember unixFileAttributes equals: 8r100666.
	self assert: folderMember unixFileAttributes equals: 8r40755.! !

!ZipArchiveTest methodsFor: 'tests' stamp: 'CamilloBruni 7/17/2012 18:18'!
testParseSqueakZipTimestamp
	"Issue 6054. We're testing a private method. Eventually, the zip timestamp handling should be refactored; maybe a ZipTimestamp subclass of DosTimestamp"

	| squeakDosTimestamp dateAndTime |
	"This was the error-causing timestamp from http://code.google.com/p/pharo/issues/detail?id=6054#c1 . It was the 'package' file inside Balloon-CamilloBruni.85.mcz"
	squeakDosTimestamp := 1001728866.
	dateAndTime := ZipFileMember new unzipTimestamp: squeakDosTimestamp.
	self assert: dateAndTime equals: '2011-09-29T04:01:06+00:00' asDateAndTime.! !

!ZipArchiveTest methodsFor: 'tests' stamp: 'S 6/17/2013 13:26'!
setUp

	| now |
	now := DateAndTime now asString replaceAll: $: with: $_.
	fileToZip := ('_test-zip-file', now) asFileReference.
	fileToZip writeStreamDo: [ :stream | stream nextPutAll: 'file contents' ].
	subdir := ('_test-zip-dir', now) asFileReference.
	subdir ensureCreateDirectory.
	zipFile := ('pharo_test', now) asFileReference, 'zip'.
	zip := ZipArchive new.
! !

!ZipConstants commentStamp: '<historical>'!
This class defines magic numbers taken from RFC1951 [1b], and also 
possibly RFC1950 [1a] & RFC1952 [1c]. 
It presets some dictionary structures as described at [1a] 8.1. 

A class can import these bindings as 'class variables' by including the 
following in its class definition: 
   poolDictionaries: 'ZipFileConstants' 

Following are source references to these constants contained within 
several class side initialization methods. 
(These might be better spread through out those methods as time permits) 

initializeDeflateConstants 
    WindowSize [2e]"w_size", [2a]"windowBits is the base two logarithm 
of windowSize where default windowBits=15" 
    WindowMask [2e]"w_mask" 
    MaxDistance [2e]"MAX_DIST" 
    MinMatch [2c] 
    MaxMatch [2c] 
    HashBits [2e]"hash_bits" 
    HashMask [2e]"hash_mask" 
    HashShift [2e]"hash_shift" 

initializeDistanceCodes 
    BaseDistance [2f] 
    DistanceCodes [2f] 

initializeExtraBits 
    ExtraLengthBits [1]3.2.5, [2b] 
    ExtraDistanceBits [1]3.2.5, [2b] 
    ExtraBitLengthBits [2b] 
    BitLengthOrder [1]3.2.7, [2b] 

initializeFixedTrees 
    [1]3.2.6 

initializeWriteStreamConstants 
    MaxBits [2d] 
    MaxBitLengthBits [2b] 
    EndBlock [2b] 
    StoredBlock [2c] 
    FixedBlock [2c] 
    DynamicBlock [2c] [1]3.2.3"BTYPE" 
    NumLiterals 
    MaxLengthCodes [2e] 
    MaxDistCodes [2e] 
    MaxBitLengthCodes [2e] 
    MaxLiteralCodes 
    Repeat3To6 [2b] 
    Repeat3To10 [2b] 
    Repeat11To138 [2b] 

[1a]  "ZLIB Compressed Data Format Specification version 3.3" 
http://www.ietf.org/rfc/rfc1950.txt
[1b] "DEFLATE Compressed Data Format Specification version 1.3" 
http://www.ietf.org/rfc/rfc1951.txt
[1c] "GZIP file format specification version 4.3" 
http://www.ietf.org/rfc/rfc1952.txt
[2] ZLIB Source Code http://zlib.net/zlib-1.2.5.tar.gz
[2a] zlib.h 
[2b] trees.c 
[2c] zutil.h 
[2d] inftrees.c 
[2e] deflate.h 
[2f] trees.h !
!ZipConstants class methodsFor: 'pool initialization' stamp: 'ar 5/18/2003 19:07'!
initializeExtraBits
	ExtraLengthBits := 
		WordArray withAll: #(0 0 0 0 0 0 0 0 1 1 1 1 2 2 2 2 3 3 3 3 4 4 4 4 5 5 5 5 0).
	ExtraDistanceBits := 
		WordArray withAll: #(0 0 0 0 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9 10 10 11 11 12 12 13 13).
	ExtraBitLengthBits := 
		WordArray withAll: #(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 3 7).
	BitLengthOrder :=
		WordArray withAll: #(16 17 18 0 8 7 9 6 10 5 11 4 12 3 13 2 14 1 15).
! !

!ZipConstants class methodsFor: 'pool initialization' stamp: 'ar 5/18/2003 19:09'!
initialize
	"ZipConstants initialize"
	self initializeDeflateConstants.
	self initializeWriteStreamConstants.! !

!ZipConstants class methodsFor: 'pool initialization' stamp: 'ar 5/18/2003 19:06'!
initializeDeflateConstants

	WindowSize := 16r8000.
	WindowMask := WindowSize - 1.
	MaxDistance := WindowSize.

	MinMatch := 3.
	MaxMatch := 258.

	HashBits := 15.
	HashMask := (1 << HashBits) - 1.
	HashShift := (HashBits + MinMatch - 1) // MinMatch.
! !

!ZipConstants class methodsFor: 'pool initialization' stamp: 'ar 5/18/2003 19:08'!
initializeDistanceCodes
	| dist |
	BaseDistance := WordArray new: MaxDistCodes.
	DistanceCodes := WordArray new: 512.
	dist := 0.
	1 to: 16 do:[:code|
		BaseDistance at: code put: dist.
		1 to: (1 bitShift: (ExtraDistanceBits at: code)) do:[:n|
			dist := dist + 1.
			DistanceCodes at: dist put: code-1]].
	dist = 256 ifFalse:[self error:'Whoops?!!'].
	dist := dist >> 7.
	17 to: MaxDistCodes do:[:code|
		BaseDistance at: code put: dist << 7.
		1 to: (1 bitShift: (ExtraDistanceBits at: code)-7) do:[:n|
			dist := dist + 1.
			DistanceCodes at: 256 + dist put: code-1]].
! !

!ZipConstants class methodsFor: 'pool initialization' stamp: 'ar 5/18/2003 19:08'!
initializeFixedTrees
	"ZipWriteStream initializeFixedTrees"
	| counts nodes |
	FixedLiteralTree := ZipEncoderTree new.
	FixedLiteralTree maxCode: 287.
	counts := WordArray new: MaxBits+1.
	counts at: 7+1 put: 24.
	counts at: 8+1 put: 144+8.
	counts at: 9+1 put: 112.
	nodes := Array new: 288.
	1 to: 288 do:[:i| nodes at: i put: (ZipEncoderNode value: i-1 frequency: 0 height: 0)].
	0 to: 143 do:[:i| (nodes at: i+1) setBitLengthTo: 8].
	144 to: 255 do:[:i| (nodes at: i+1) setBitLengthTo: 9].
	256 to: 279 do:[:i| (nodes at: i+1) setBitLengthTo: 7].
	280 to: 287 do:[:i| (nodes at: i+1) setBitLengthTo: 8].
	FixedLiteralTree buildCodes: nodes counts: counts maxDepth: MaxBits.
	FixedLiteralTree setValuesFrom: nodes.

	FixedDistanceTree := ZipEncoderTree new.
	FixedDistanceTree maxCode: MaxDistCodes.
	FixedDistanceTree
		bitLengths: ((WordArray new: MaxDistCodes+1) atAllPut: 5)
		codes: ((0 to: MaxDistCodes) collect:[:i| FixedDistanceTree reverseBits: i length: 5]).! !

!ZipConstants class methodsFor: 'pool initialization' stamp: 'ar 5/18/2003 19:09'!
initializeWriteStreamConstants

	MaxBits := 15.
	MaxBitLengthBits := 7.
	EndBlock := 256.

	StoredBlock := 0.
	FixedBlock := 1.
	DynamicBlock := 2.

	NumLiterals := 256.
	MaxLengthCodes := 29.
	MaxDistCodes := 30.
	MaxBitLengthCodes := 19.
	MaxLiteralCodes := NumLiterals + MaxLengthCodes + 1. "+ End of Block"

	Repeat3To6 := 16. "Repeat previous bit length 3-6 times (2 bits repeat count)"
	Repeat3To10 := 17. "Repeat previous bit length 3-10 times (3 bits repeat count)"
	Repeat11To138 := 18. "Repeat previous bit length 11-138 times (7 bits repeat count)"

	self initializeExtraBits.
	self initializeLengthCodes.
	self initializeDistanceCodes.
	self initializeFixedTrees.
! !

!ZipConstants class methodsFor: 'pool initialization' stamp: 'ar 5/18/2003 19:07'!
initializeLengthCodes
	| length |
	BaseLength := WordArray new: MaxLengthCodes.
	MatchLengthCodes := WordArray new: MaxMatch - MinMatch + 1.
	length := 0.
	1 to: MaxLengthCodes - 1 do:[:code|
		BaseLength at: code put: length.
		1 to: (1 bitShift: (ExtraLengthBits at: code)) do:[:n|
			length := length + 1.
			MatchLengthCodes at: length put: NumLiterals + code]].
! !

!ZipCrcTests methodsFor: 'tests' stamp: 'nk 3/7/2004 18:37'!
testInvalidZipCrc
	"See that a wrong CRC raises an appropriate error"
	| reader writer bytes |
	writer := ZipWriteStream on: String new.
	writer nextPutAll: 'Hello World'.
	writer close.

	bytes := writer encodedStream contents.

	reader := ZipReadStream on: bytes.
	reader expectedCrc: writer crc - 1.
	self should:[reader upToEnd] raise: CRCError.

	reader := ZipReadStream on: bytes.
	reader expectedCrc: writer crc - 1.
	self should:[reader contents] raise: CRCError.

	reader := ZipReadStream on: bytes.
	reader expectedCrc: writer crc - 1.
	self should:[reader next: 100] raise: CRCError.
! !

!ZipCrcTests methodsFor: 'tests' stamp: 'ar 2/29/2004 04:43'!
testInvalidZLibCrc
	"See that a wrong CRC raises an appropriate error"
	| reader writer bytes crcByte |
	writer := ZLibWriteStream on: String new.
	writer nextPutAll: 'Hello World'.
	writer close.

	bytes := writer encodedStream contents.
	crcByte := bytes byteAt: bytes size-2.
	bytes byteAt: bytes size-2 put: (crcByte + 1 bitAnd: 255).

	reader := ZLibReadStream on: bytes.
	self should:[reader upToEnd] raise: CRCError.

	reader := ZLibReadStream on: bytes.
	self should:[reader contents] raise: CRCError.

	reader := ZLibReadStream on: bytes.
	self should:[reader next: 100] raise: CRCError.
! !

!ZipCrcTests methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:23'!
testMissingZipCrc
	"See that the lack of a CRC does not raise an error"

	| reader writer bytes readBytes |
	writer := ZipWriteStream on: String new.
	writer nextPutAll: 'Hello World'.
	writer close.
	bytes := writer encodedStream contents.
	reader := ZipReadStream on: bytes.
	readBytes := reader upToEnd.
	self assert: readBytes = 'Hello World'.
	reader := ZipReadStream on: bytes.
	reader contents.
	reader := ZipReadStream on: bytes.
	reader next: 100! !

!ZipCrcTests methodsFor: 'tests' stamp: 'nk 3/7/2004 18:46'!
testValidZLibCrc
	| reader writer bytes |
	writer := ZLibWriteStream on: String new.
	writer nextPutAll: 'Hello World'.
	writer close.

	bytes := writer encodedStream contents.
	reader := ZLibReadStream on: bytes.
	self assert: reader upToEnd = 'Hello World'.
	
	bytes := writer encodedStream contents.
	reader := ZLibReadStream on: bytes.
	self assert: (reader next: 100) = 'Hello World'.! !

!ZipCrcTests methodsFor: 'tests' stamp: 'ar 2/29/2004 04:42'!
testMissingGZipCrc
	"See that the lack of a CRC raises an appropriate error"
	| reader writer bytes |
	writer := GZipWriteStream on: String new.
	writer nextPutAll: 'Hello World'.
	writer close.

	bytes := writer encodedStream contents.
	bytes := bytes copyFrom: 1 to: bytes size-6.

	reader := GZipReadStream on: bytes.
	self should:[reader upToEnd] raise: CRCError.

	reader := GZipReadStream on: bytes.
	self should:[reader contents] raise: CRCError.

	reader := GZipReadStream on: bytes.
	self should:[reader next: 100] raise: CRCError.
! !

!ZipCrcTests methodsFor: 'tests' stamp: 'ar 2/29/2004 04:42'!
testMissingZLibCrc
	"See that the lack of a CRC raises an appropriate error"
	| reader writer bytes |
	writer := ZLibWriteStream on: String new.
	writer nextPutAll: 'Hello World'.
	writer close.

	bytes := writer encodedStream contents.
	bytes := bytes copyFrom: 1 to: bytes size-2.

	reader := ZLibReadStream on: bytes.
	self should:[reader upToEnd] raise: CRCError.

	reader := ZLibReadStream on: bytes.
	self should:[reader contents] raise: CRCError.

	reader := ZLibReadStream on: bytes.
	self should:[reader next: 100] raise: CRCError.
! !

!ZipCrcTests methodsFor: 'tests' stamp: 'ar 2/29/2004 04:42'!
testValidGZipCrc
	| reader writer bytes |
	writer := GZipWriteStream on: String new.
	writer nextPutAll: 'Hello World'.
	writer close.

	bytes := writer encodedStream contents.
	reader := GZipReadStream on: bytes.
	self assert: reader upToEnd = 'Hello World'.! !

!ZipCrcTests methodsFor: 'tests' stamp: 'ar 2/29/2004 04:43'!
testInvalidGZipCrc
	"See that a wrong CRC raises an appropriate error"
	| reader writer bytes crcByte |
	writer := GZipWriteStream on: String new.
	writer nextPutAll: 'Hello World'.
	writer close.

	bytes := writer encodedStream contents.
	crcByte := bytes byteAt: bytes size-5. "before the length"
	bytes byteAt: bytes size-5 put: (crcByte + 1 bitAnd: 255).

	reader := GZipReadStream on: bytes.
	self should:[reader upToEnd] raise: CRCError.

	reader := GZipReadStream on: bytes.
	self should:[reader contents] raise: CRCError.

	reader := GZipReadStream on: bytes.
	self should:[reader next: 100] raise: CRCError.
! !

!ZipCrcTests methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2013 20:23'!
testValidZipCrc
	"See that a correct CRC does not raise an error and that we can read what we wrote."

	| reader writer bytes readBytes |
	writer := ZipWriteStream on: String new.
	writer nextPutAll: 'Hello World'.
	writer close.
	bytes := writer encodedStream contents.
	reader := ZipReadStream on: bytes.
	reader expectedCrc: writer crc.
	readBytes := reader upToEnd.
	self assert: readBytes = 'Hello World'.
	reader := ZipReadStream on: bytes.
	reader expectedCrc: writer crc.
	readBytes := reader contents.
	self assert: readBytes = 'Hello World'.
	reader := ZipReadStream on: bytes.
	reader expectedCrc: writer crc.
	readBytes := reader next: 11.
	self assert: readBytes = 'Hello World'.
	reader := ZipReadStream on: bytes.
	reader expectedCrc: writer crc.
	readBytes := reader next: 100.
	self assert: readBytes = 'Hello World'! !

!ZipDirectoryMember commentStamp: '<historical>'!
ZipFileMember instances represent directories inside ZipArchives.
They don't do much other than hold names and permissions (and extra fields).

You can add files in subdirectories to a ZipArchive without using any ZipDirectoryMembers.!
!ZipDirectoryMember methodsFor: 'private' stamp: 'nk 2/21/2001 21:55'!
asDirectory
	^self! !

!ZipDirectoryMember methodsFor: 'initialization' stamp: 'SeanDeNigris 5/20/2012 09:46'!
initialize
	super initialize.
	externalFileAttributes := self mapPermissionsFromUnix: DefaultDirectoryPermissions.
	super desiredCompressionMethod: CompressionStored.! !

!ZipDirectoryMember methodsFor: 'accessing' stamp: 'CamilloBruni 10/23/2012 20:54'!
localFileName: aString

	| file |
	file := aString asFileReference.	
	super localFileName: (file basename copyWith: $/).
	file exists ifFalse: [ ^ self ].
	self modifiedAt: file entry modificationTime.! !

!ZipDirectoryMember methodsFor: 'accessing' stamp: 'nk 2/23/2001 10:00'!
desiredCompressionMethod: aNumber! !

!ZipDirectoryMember methodsFor: 'private' stamp: 'nk 3/27/2002 11:30'!
rewindData! !

!ZipDirectoryMember methodsFor: 'private-writing' stamp: 'GabrielBarbuto 9/27/2010 10:54'!
writeDataTo: aStream
       "Write nothing. Directories have no contents to write."! !

!ZipDirectoryMember methodsFor: 'testing' stamp: 'nk 2/22/2001 00:00'!
isDirectory
	^true! !

!ZipDirectoryMember methodsFor: 'testing' stamp: 'nk 3/27/2002 11:29'!
usesFileNamed: aName
	^false! !

!ZipDirectoryMember class methodsFor: 'as yet unclassified' stamp: 'nk 12/20/2002 14:57'!
newNamed: aFileName
	^(self new) localFileName: aFileName; yourself! !

!ZipEncoder commentStamp: 'TorstenBergmann 2/3/2014 23:04'!
A ZIP encoder!
!ZipEncoder methodsFor: 'initialization' stamp: 'ar 1/2/2000 16:35'!
flushBits
	"Flush currently unsent bits"
	[bitPosition > 0] whileTrue:[
		self nextBytePut: (bitBuffer bitAnd: 255).
		bitBuffer := bitBuffer bitShift: -8.
		bitPosition := bitPosition - 8].
	bitPosition := 0.! !

!ZipEncoder methodsFor: 'block encoding' stamp: 'ar 12/30/1999 18:39'!
sendBlock: literalStream with: distanceStream with: litTree with: distTree
	"Send the current block using the encodings from the given literal/length and distance tree"
	| result |
	result := 0.
	[literalStream atEnd] whileFalse:[
		result := result + (self privateSendBlock: literalStream
						with: distanceStream with: litTree with: distTree).
		self commit.
	].
	self nextBits: (litTree bitLengthAt: EndBlock) put: (litTree codeAt: EndBlock).
	^result! !

!ZipEncoder methodsFor: 'accessing' stamp: 'ar 12/30/1999 00:37'!
encodedStream
	^encodedStream! !

!ZipEncoder methodsFor: 'initialization' stamp: 'sd 1/30/2004 15:24'!
close
	self flush.
	encodedStream close.! !

!ZipEncoder methodsFor: 'accessing' stamp: 'ar 12/30/1999 00:45'!
bitPosition
	^encodedStream position + position * 8 + bitPosition.! !

!ZipEncoder methodsFor: 'accessing' stamp: 'ar 1/2/2000 16:34'!
nextBits: nBits put: value
	"Store a value of nBits"
	"self assert:[value >= 0 and:[(1 bitShift: nBits) > value]]."
	bitBuffer := bitBuffer bitOr: (value bitShift: bitPosition).
	bitPosition := bitPosition + nBits.
	[bitPosition >= 8] whileTrue:[
		self nextBytePut: (bitBuffer bitAnd: 255).
		bitBuffer := bitBuffer bitShift: -8.
		bitPosition := bitPosition - 8].! !

!ZipEncoder methodsFor: 'initialization' stamp: 'ar 12/30/1999 15:51'!
flush
	self flushBits.
	self commit.! !

!ZipEncoder methodsFor: 'accessing' stamp: 'ar 1/2/2000 16:34'!
nextBytePut: anObject 
	"Primitive. Insert the argument at the next position in the Stream
	represented by the receiver. Fail if the collection of this stream is not an
	Array or a String. Fail if the stream is positioned at its end, or if the
	position is out of bounds in the collection. Fail if the argument is not
	of the right type for the collection. Optional. See Object documentation
	whatIsAPrimitive."

	<primitive: 66>
	position >= writeLimit
		ifTrue: [^ self pastEndPut: anObject]
		ifFalse: 
			[position := position + 1.
			^collection byteAt: position put: anObject]! !

!ZipEncoder methodsFor: 'initialization' stamp: 'ar 12/30/1999 15:51'!
commit
	encodedStream next: position putAll: collection.
	position := readLimit := 0.! !

!ZipEncoder methodsFor: 'initialization' stamp: 'PeterHugossonMiller 9/3/2009 11:52'!
on: aCollectionOrStream
	aCollectionOrStream isStream 
		ifTrue:[encodedStream := aCollectionOrStream]
		ifFalse:[	encodedStream := aCollectionOrStream writeStream].
	encodedStream isBinary
		ifTrue:[super on: (ByteArray new: 4096)]
		ifFalse:[super on: (String new: 4096)].
	bitPosition := bitBuffer := 0.! !

!ZipEncoder methodsFor: 'private' stamp: 'ar 1/2/2000 16:38'!
pastEndPut: anObject
	"Flush the current buffer and store the new object at the beginning"
	self commit.
	^self nextBytePut: anObject asInteger! !

!ZipEncoder methodsFor: 'private' stamp: 'ar 2/2/2001 15:47'!
privateSendBlock: literalStream with: distanceStream with: litTree with: distTree
	"Send the current block using the encodings from the given literal/length and distance tree"
	| lit dist code extra sum |
	<primitive: 'primitiveZipSendBlock' module: 'ZipPlugin'>
	sum := 0.
	[lit := literalStream next.
	dist := distanceStream next.
	lit == nil] whileFalse:[
		dist = 0 ifTrue:["lit is a literal"
			sum := sum + 1.
			self nextBits: (litTree bitLengthAt: lit)
				put: (litTree codeAt: lit).
		] ifFalse:["lit is match length"
			sum := sum + lit + MinMatch.
			code := (MatchLengthCodes at: lit + 1).
			self nextBits: (litTree bitLengthAt: code)
				put: (litTree codeAt: code).
			extra := ExtraLengthBits at: code-NumLiterals.
			extra = 0 ifFalse:[
				lit := lit - (BaseLength at: code-NumLiterals).
				self nextBits: extra put: lit.
			].
			dist := dist - 1.
			dist < 256
				ifTrue:[code := DistanceCodes at: dist + 1]
				ifFalse:[code := DistanceCodes at: 257 + (dist bitShift: -7)].
			"self assert:[code < MaxDistCodes]."
			self nextBits: (distTree bitLengthAt: code)
				put: (distTree codeAt: code).
			extra := ExtraDistanceBits at: code+1.
			extra = 0 ifFalse:[
				dist := dist - (BaseDistance at: code+1).
				self nextBits: extra put: dist.
			].
		].
	].
	^sum! !

!ZipEncoderNode commentStamp: '<historical>'!
ZipEncoderNode represents a node in a huffman tree for encoding ZipStreams.

Instance variables:
	value 		<Integer>	- Encoded value
	frequency	<Integer>	- Number of occurences of the encoded value
	height 		<Integer>	- Height of the node in the tree
	bitLength 	<Integer>	- bit length of the code
	code		<Integer>	- Assigned code for this node
	parent		<ZipEncoderNode>		- Parent of this node
	left			<ZipEncoderNode>		- First child of this node
	right		<ZipEncoderNode>		- Second child of this node
!
!ZipEncoderNode methodsFor: 'accessing' stamp: 'ar 12/30/1999 14:28'!
code
	^code ifNil:[0]! !

!ZipEncoderNode methodsFor: 'accessing' stamp: 'ar 12/24/1999 23:43'!
parent: aNode
	parent := aNode! !

!ZipEncoderNode methodsFor: 'accessing' stamp: 'ar 12/25/1999 19:41'!
bitLength
	^bitLength ifNil:[0]! !

!ZipEncoderNode methodsFor: 'accessing' stamp: 'jannik.laval 5/1/2010 16:49'!
code: aCode
	[aCode >= 0 and:[(1 bitShift: bitLength) > aCode]] assert.
	code := aCode.! !

!ZipEncoderNode methodsFor: 'accessing' stamp: 'ar 12/25/1999 20:06'!
right: aNode
	aNode parent: self.
	right := aNode.! !

!ZipEncoderNode methodsFor: 'accessing' stamp: 'ar 12/28/1999 00:56'!
frequency: aNumber
	frequency := aNumber! !

!ZipEncoderNode methodsFor: 'accessing' stamp: 'ar 12/24/1999 23:36'!
frequency
	^frequency! !

!ZipEncoderNode methodsFor: 'accessing' stamp: 'ar 12/24/1999 23:43'!
left
	^left! !

!ZipEncoderNode methodsFor: 'testing' stamp: 'marcus.denker 9/14/2008 19:00'!
isLeaf
	^left isNil! !

!ZipEncoderNode methodsFor: 'private' stamp: 'ar 12/26/1999 10:45'!
computeHeight
	^self isLeaf
		ifTrue:[height := 0]
		ifFalse:[height := (left computeHeight max: right computeHeight) + 1].! !

!ZipEncoderNode methodsFor: 'private' stamp: 'ar 12/25/1999 18:14'!
leafNodes
	self isLeaf
		ifTrue:[^Array with: self]
		ifFalse:[^left leafNodes, right leafNodes]! !

!ZipEncoderNode methodsFor: 'accessing' stamp: 'ar 12/26/1999 10:44'!
height
	^height! !

!ZipEncoderNode methodsFor: 'encoding' stamp: 'ar 12/27/1999 14:27'!
rotateToHeight: maxHeight
	"Rotate the tree to achieve maxHeight depth"
	| newParent |
	height < 4 ifTrue:[^self].
	self left: (left rotateToHeight: maxHeight-1).
	self right: (right rotateToHeight: maxHeight-1).
	height := (left height max: right height) + 1.
	height <= maxHeight ifTrue:[^self].
	(left height - right height) abs <= 2 ifTrue:[^self].
	left height < right height ifTrue:[
		right right height >= right left height ifTrue:[
			newParent := right.
			self right: newParent left.
			newParent left: self.
		] ifFalse:[
			newParent := right left.
			right left: newParent right.
			newParent right: right.
			self right: newParent left.
			newParent left: self.
		].
	] ifFalse:[
		left left height >= left right height ifTrue:[
			newParent := left.
			self left: newParent right.
			newParent right: self.
		] ifFalse:[
			newParent := left right.
			left right: newParent left.
			newParent left: left.
			self left: newParent right.
			newParent right: self.
		].
	].
	parent computeHeight.
	^parent! !

!ZipEncoderNode methodsFor: 'accessing' stamp: 'ar 12/24/1999 23:43'!
right
	^right! !

!ZipEncoderNode methodsFor: 'private' stamp: 'ar 12/26/1999 12:05'!
setBitLengthTo: bl
	bitLength := bl! !

!ZipEncoderNode methodsFor: 'accessing' stamp: 'ar 12/24/1999 23:43'!
value
	^value! !

!ZipEncoderNode methodsFor: 'private' stamp: 'ar 12/26/1999 10:46'!
setValue: v frequency: f height: h
	value := v.
	frequency := f.
	height := h.! !

!ZipEncoderNode methodsFor: 'printing' stamp: 'ar 12/26/1999 10:46'!
printOn: aStream
	super printOn: aStream.
	aStream nextPut:$(;
		nextPutAll:'value = '; print: value;
		nextPutAll:', freq = '; print: frequency;
		nextPutAll:', bitLength = '; print: bitLength;
		nextPutAll:', code = '; print: code;
		nextPutAll:', height = '; print: height; 
	nextPut:$).! !

!ZipEncoderNode methodsFor: 'accessing' stamp: 'ar 12/25/1999 20:06'!
left: aNode
	aNode parent: self.
	left := aNode.! !

!ZipEncoderNode methodsFor: 'accessing' stamp: 'ar 12/24/1999 23:43'!
parent
	^parent! !

!ZipEncoderNode methodsFor: 'encoding' stamp: 'marcus.denker 9/14/2008 19:01'!
encodeBitLength: blCounts from: aTree
	| index |
	"Note: If bitLength is not nil then the tree must be broken"
	bitLength isNil ifFalse:[self error:'Huffman tree is broken'].
	parent  
		ifNil: [bitLength := 0]
		ifNotNil:[bitLength := parent bitLength + 1].
	self isLeaf ifTrue:[
		index := bitLength + 1.
		blCounts at: index put: (blCounts at: index) + 1.
	] ifFalse:[
		left encodeBitLength: blCounts from: aTree.
		right encodeBitLength: blCounts from: aTree.
	].! !

!ZipEncoderNode class methodsFor: 'instance creation' stamp: 'ar 12/26/1999 10:47'!
value: v frequency: f height: h
	^self new setValue: v frequency: f height: h! !

!ZipEncoderTree commentStamp: '<historical>'!
ZipEncoderTree represents a huffman tree for encoding ZipStreams.

Instance variables:
	bitLengths	<WordArray>	 - Bit lengths of each generated code
	codes		<WordArray>	 - Codes for each value
	maxCode		<Integer>	- Maximum value with non-zero frequency!
!ZipEncoderTree methodsFor: 'accessing' stamp: 'ar 12/25/1999 17:15'!
maxCode
	^maxCode! !

!ZipEncoderTree methodsFor: 'accessing' stamp: 'ar 12/30/1999 01:24'!
codes
	"Return an array of all valid codes"
	^codes! !

!ZipEncoderTree methodsFor: 'accessing' stamp: 'ar 12/25/1999 21:45'!
maxCode: aNumber
	maxCode := aNumber.! !

!ZipEncoderTree methodsFor: 'encoding' stamp: 'ar 12/26/1999 10:42'!
buildHierarchyFrom: aHeap
	"Build the node hierarchy based on the leafs in aHeap"
	| left right parent |
	[aHeap size > 1] whileTrue:[
		left := aHeap removeFirst.
		right := aHeap removeFirst.
		parent := ZipEncoderNode value: -1 
			frequency: (left frequency + right frequency)
			height: (left height max: right height) + 1.
		left parent: parent.
		right parent: parent.
		parent left: left.
		parent right: right.
		aHeap add: parent].
	^aHeap removeFirst
! !

!ZipEncoderTree methodsFor: 'private' stamp: 'jannik.laval 5/1/2010 16:50'!
bitLengths: blArray codes: codeArray
	bitLengths := blArray as: WordArray.
	codes := codeArray as: WordArray.
	[(self bitLengthAt: maxCode) > 0] assert.! !

!ZipEncoderTree methodsFor: 'encoding' stamp: 'ar 12/26/1999 10:42'!
nodeSortBlock
	^[:n1 :n2|
		n1 frequency = n2 frequency
			ifTrue:[n1 height <= n2 height]
			ifFalse:[n1 frequency <= n2 frequency]].! !

!ZipEncoderTree methodsFor: 'encoding' stamp: 'jannik.laval 5/1/2010 16:50'!
buildTree: nodeList maxDepth: depth
	"Build either the literal or the distance tree"
	| heap rootNode blCounts |
	heap := Heap new: nodeList size // 3.
	heap sortBlock: self nodeSortBlock.
	"Find all nodes with non-zero frequency and add to heap"
	maxCode := 0.
	nodeList do:[:dNode|
		dNode frequency = 0 ifFalse:[
			maxCode := dNode value.
			heap add: dNode]].
	"The pkzip format requires that at least one distance code exists,
	and that at least one bit should be sent even if there is only one
	possible code. So to avoid special checks later on we force at least
	two codes of non zero frequency."
	heap size = 0 ifTrue:[
		[maxCode = 0] assert.
		heap add: nodeList first.
		heap add: nodeList second.
		maxCode := 1].
	heap size = 1 ifTrue:[
		nodeList first frequency = 0
			ifTrue:[heap add: nodeList first]
			ifFalse:[heap add: nodeList second].
		maxCode := maxCode max: 1].
	rootNode := self buildHierarchyFrom: heap.
	rootNode height > depth ifTrue:[
		rootNode := rootNode rotateToHeight: depth.
		rootNode height > depth ifTrue:[self error:'Cannot encode tree']].
	blCounts := WordArray new: depth+1.
	rootNode encodeBitLength: blCounts from: self.
	self buildCodes: nodeList counts: blCounts maxDepth: depth.
	self setValuesFrom: nodeList.! !

!ZipEncoderTree methodsFor: 'encoding' stamp: 'jannik.laval 5/1/2010 16:50'!
buildCodes: nodeList counts: blCounts maxDepth: depth
	"Build the codes for all nodes"
	| nextCode code node length |
	nextCode := WordArray new: depth+1.
	code := 0.
	1 to: depth do:[:bits|
		code := (code + (blCounts at: bits)) << 1.
		nextCode at: bits+1 put: code].
	[(code + (blCounts at: depth+1) - 1) = (1 << depth - 1)] assert.
	0 to: maxCode do:[:n|
		node := nodeList at: n+1.
		length := node bitLength.
		length = 0 ifFalse:[
			code := nextCode at: length+1.
			node code: (self reverseBits: code length: length).
			nextCode at: length+1 put: code+1.
		].
	].! !

!ZipEncoderTree methodsFor: 'encoding' stamp: 'ar 12/30/1999 01:24'!
buildTreeFrom: frequencies maxDepth: depth
	"Build the receiver from the given frequency values"
	| nodeList |
	nodeList := Array new: frequencies size.
	1 to: frequencies size do:[:i|
		nodeList at: i put: (ZipEncoderNode value: i-1 frequency: (frequencies at: i) height: 0)
	].
	self buildTree: nodeList maxDepth: depth.! !

!ZipEncoderTree methodsFor: 'private' stamp: 'sma 6/1/2000 11:52'!
setValuesFrom: nodeList
	self bitLengths: (nodeList
			collect: [:n | n bitLength]
			from: 1
			to: maxCode + 1)
		codes: (nodeList
				collect: [:n | n code]
				from: 1
				to: maxCode + 1)! !

!ZipEncoderTree methodsFor: 'accessing' stamp: 'ar 12/30/1999 01:43'!
bitLengthAt: index
	^bitLengths at: index+1! !

!ZipEncoderTree methodsFor: 'accessing' stamp: 'ar 12/30/1999 01:32'!
bitLengths
	"Return an array of all bitLength values for valid codes"
	^bitLengths! !

!ZipEncoderTree methodsFor: 'private' stamp: 'ar 12/26/1999 11:02'!
reverseBits: code length: length
	"Bit reverse the given code"
	| result bit bits |
	result := 0.
	bits := code.
	1 to: length do:[:i|
		bit := bits bitAnd: 1.
		result := result << 1 bitOr: bit.
		bits := bits >> 1].
	^result! !

!ZipEncoderTree methodsFor: 'accessing' stamp: 'ar 12/30/1999 01:04'!
codeAt: index
	^codes at: index+1! !

!ZipEncoderTree class methodsFor: 'instance creation' stamp: 'ar 12/30/1999 01:25'!
buildTreeFrom: frequencies maxDepth: depth
	^self new buildTreeFrom: frequencies maxDepth: depth! !

!ZipFileConstants commentStamp: '<historical>'!
This class defines magic numbers taken from the PKWARE ZIP Application 
Note [1] approved by ISO/IEC JTC 1/SC 34 N 1621 in July 2011 [2] to be 
the international normative reference for the zip file format.  A class 
imports these bindings as 'class variables' by including the following 
in its class definition: 
    poolDictionaries: 'ZipFileConstants' 
There is a single method on the class side to initialise the values. 

[1] http://www.pkware.com/documents/casestudies/APPNOTE.TXT
[2] http://www.itscj.ipsj.or.jp/sc34/open/1621.pdf

Following are pertinent extracts from the PKWARE ZIP Application Note.... 
All values are stored in little-endian byte order unless otherwise 
specified. 
A. local file header signature     4 bytes  (0x04034b50) 
C. Data descriptor: 
           crc-32                          4 bytes 
           compressed size                 4 bytes 
           uncompressed size               4 bytes 
F. central file header signature   4 bytes  (0x02014b50) 
I. end of central dir signature    4 bytes  (0x06054b50) 
J.  Explanation of fields: 
     * version made by (2 bytes) 
            0 - MS-DOS and OS/2 (FAT / VFAT / FAT32 file systems) 
            3 - UNIX 
            1,2,4-20 not implemented 
     * compression method: (2 bytes) 
            0 - The file is stored (no compression) 
            6 - The file is Imploded 
            8 - The file is Deflated 
            1-7,9-19,97,98 not implemented 
      * For Methods 8 and 9 - Deflating 
            Bit 2  Bit 1 
              0      0    Normal (-en) compression option was used. 
             0      1    Maximum (-exx/-ex) compression option was used. 
              1      0    Fast (-ef) compression option was used. 
             1      1    Super Fast (-es) compression option was 
used.                               
        * internal file attributes: (2 bytes) 
            Bits 1 and 2 are reserved for use by PKWARE. The lowest bit 
of this field indicates, if set, that the file is apparently an ASCII or 
text file.  If not set, that the file apparently contains binary data. 

Note the following do not appear in the PKWARE ZIP Application Note.   
Should they be defined elsewhere? 
"Unix permission bits" 
DefaultDirectoryPermissions    := 8r040755. 
DefaultFilePermissions        := 8r0100666. 
DirectoryAttrib         := 8r040000. 
FileAttrib             := 8r0100000. !
!ZipFileConstants class methodsFor: 'pool initialization' stamp: 'SeanDeNigris 5/20/2012 08:34'!
initialize
	"ZipFileConstants initialize"
	
	FaMsdos		:= 0.
	FaUnix 		:= 3.
	DeflatingCompressionNormal		:= 0.
	DeflatingCompressionMaximum	:= 2.
	DeflatingCompressionFast		:= 4.
	DeflatingCompressionSuperFast	:= 6.
	CompressionStored				:= 0.
	CompressionDeflated				:= 8.
	CompressionLevelNone			:= 0.
	CompressionLevelDefault			:= 6.
	IfaTextFile						:= 1.
	IfaBinaryFile					:= 0.
	DataDescriptorLength 				:= 12.

	"Unix permission bits"
	DefaultDirectoryPermissions		:= 8r040755.
	DefaultFilePermissions			:= 8r0100666.
	DirectoryAttrib 					:= 8r040000.
	FileAttrib 						:= 8r0100000.

	"0x02014b50 little-endian i.e. #(16r50 16r4B 16r01 16r02) [1]"
	CentralDirectoryFileHeaderSignature := #[80 75 1 2].
	
	"0x04034b50 little-endian i.e. #(16r50 16r4B 16r03 16r04) [1]"
	LocalFileHeaderSignature := #[80 75 3 4].
	
	"0x06054b50 little-endian i.e. #(16r50 16r4B 16r05 16r06) [1]"
	EndOfCentralDirectorySignature := #[80 75 5 6].
	
	"[1] http://en.wikipedia.org/wiki/Zip_(file_format)#File_headers"! !

!ZipFileMember commentStamp: '<historical>'!
ZipNewFileMember instances are used to represent files that have been read from a ZipArchive.
Their data stays in the file on disk, so the original Zip file cannot be directly overwritten.!
!ZipFileMember methodsFor: 'private-writing' stamp: 'nice 12/27/2009 20:46'!
uncompressDataTo: aStream

	| decoder buffer crcErrorMessage |
	decoder := ZipReadStream on: stream.
	decoder expectedCrc: self crc32.
	buffer := ByteArray new: (32768 min: readDataRemaining).
	crcErrorMessage := nil.

	[[ readDataRemaining > 0 ] whileTrue: [
		| chunkSize |
		chunkSize := 32768 min: readDataRemaining.
		buffer := decoder next: chunkSize into: buffer startingAt: 1.
		aStream next: chunkSize putAll: buffer startingAt: 1.
		readDataRemaining := readDataRemaining - chunkSize.
	]] on: CRCError do: [ :ex | crcErrorMessage := ex messageText. ex proceed ].

	crcErrorMessage ifNotNil: [ self isCorrupt: true. CRCError signal: crcErrorMessage ]

! !

!ZipFileMember methodsFor: 'private-reading' stamp: 'nk 11/11/2002 21:48'!
readFrom: aStream 
	"assumes aStream positioned after CD header; leaves stream positioned after my CD entry"

	self readCentralDirectoryFileHeaderFrom: aStream.
	self readLocalDirectoryFileHeaderFrom: aStream.
	self endRead.
	self canonicalizeFileName.
! !

!ZipFileMember methodsFor: 'initialization' stamp: 'ar 3/2/2001 18:46'!
close
	stream ifNotNil:[stream close].! !

!ZipFileMember methodsFor: 'private-reading' stamp: 'nk 2/23/2001 09:56'!
skipLocalDirectoryFileHeaderFrom: aStream 
	"Assumes that stream is positioned after signature."

	|  extraFieldLength fileNameLength |
	aStream next: 22.
	fileNameLength := aStream nextLittleEndianNumber: 2.
	extraFieldLength := aStream nextLittleEndianNumber: 2.
	aStream next: fileNameLength.
	aStream next: extraFieldLength.
	dataOffset := aStream position.
! !

!ZipFileMember methodsFor: 'private-reading' stamp: 'SeanDeNigris 6/19/2012 10:19'!
unzipTimestamp: dosTimestampInteger

	^ [ DateAndTime fromDosTimestamp: dosTimestampInteger ]
		on: Error
		do: [ "Assume we're dealing with the old, incorrect Squeak format"
			DateAndTime fromSeconds: 2492992800 + dosTimestampInteger ]! !

!ZipFileMember methodsFor: 'private-reading' stamp: 'nk 11/11/2002 21:46'!
canonicalizeFileName
	"For security reasons, make all paths relative and remove any ../ portions"

	[fileName beginsWith: '/'] whileTrue: [fileName := fileName allButFirst].
	fileName := fileName copyReplaceAll: '../' with: ''! !

!ZipFileMember methodsFor: 'private-writing' stamp: 'nk 2/23/2001 11:04'!
copyDataTo: aStream

	self copyRawDataTo: aStream.! !

!ZipFileMember methodsFor: 'testing' stamp: 'nk 2/21/2001 21:52'!
looksLikeDirectory
	^fileName last = $/
		and: [ uncompressedSize = 0 ]! !

!ZipFileMember methodsFor: 'private-reading' stamp: 'CamilloBruni 9/7/2013 10:22'!
readCentralDirectoryFileHeaderFrom: aStream
	"Assumes aStream positioned after signature"

	| fileNameLength extraFieldLength fileCommentLength |

	self versionMadeBy: (aStream nextLittleEndianNumber: 1).
	fileAttributeFormat := aStream nextLittleEndianNumber: 1.

	self versionNeededToExtract: (aStream nextLittleEndianNumber: 2).
	self bitFlag: (aStream nextLittleEndianNumber: 2).
	compressionMethod := aStream nextLittleEndianNumber: 2.
	lastModFileDateTime := self unzipTimestamp: (aStream nextLittleEndianNumber: 4).
	crc32 := aStream nextLittleEndianNumber: 4.
	compressedSize := aStream nextLittleEndianNumber: 4.
	uncompressedSize := aStream nextLittleEndianNumber: 4.

	fileNameLength := aStream nextLittleEndianNumber: 2.
	extraFieldLength := aStream nextLittleEndianNumber: 2.
	fileCommentLength := aStream nextLittleEndianNumber: 2.
	aStream nextLittleEndianNumber: 2. 	"disk number start"
	internalFileAttributes := aStream nextLittleEndianNumber: 2.

	externalFileAttributes := aStream nextLittleEndianNumber: 4.
	localHeaderRelativeOffset := aStream nextLittleEndianNumber: 4.

	fileName := (aStream next: fileNameLength) asString.
	cdExtraField := (aStream next: extraFieldLength) asByteArray asString.
	fileComment := (aStream next: fileCommentLength) asString convertFromSystemString.

	self desiredCompressionMethod: compressionMethod! !

!ZipFileMember methodsFor: 'initialization' stamp: 'nk 2/22/2001 16:52'!
initialize
	super initialize.
	crc32 := 0.
	localHeaderRelativeOffset := 0.
	dataOffset := 0.! !

!ZipFileMember methodsFor: 'initialization' stamp: 'nk 2/22/2001 16:51'!
stream: aStream externalFileName: aFileName
	stream := aStream.
	externalFileName := aFileName.! !

!ZipFileMember methodsFor: 'private-reading' stamp: 'nk 2/23/2001 09:56'!
rewindData
	super rewindData.
	(stream isNil or: [ stream closed ])
		ifTrue: [ self error: 'stream missing or closed' ].
	stream position: (localHeaderRelativeOffset + 4).
	self skipLocalDirectoryFileHeaderFrom: stream.! !

!ZipFileMember methodsFor: 'private-writing' stamp: 'nk 2/24/2001 17:52'!
uncompressDataTo: aStream from: start to: finish

	| decoder buffer chunkSize |
	decoder := FastInflateStream on: stream.
	readDataRemaining := readDataRemaining min: finish - start + 1.
	buffer := ByteArray new: (32768 min: readDataRemaining).
	decoder next: start - 1.

	[ readDataRemaining > 0 ] whileTrue: [
		chunkSize := 32768 min: readDataRemaining.
		buffer := decoder next: chunkSize into: buffer startingAt: 1.
		aStream next: chunkSize putAll: buffer startingAt: 1.
		readDataRemaining := readDataRemaining - chunkSize.
	].
! !

!ZipFileMember methodsFor: 'private-reading' stamp: 'CamilloBruni 9/7/2013 10:21'!
readLocalDirectoryFileHeaderFrom: aStream 
	"Positions stream as necessary. Will return stream to its original position"

	| fileNameLength extraFieldLength xcrc32 xcompressedSize xuncompressedSize sig oldPos |

	oldPos := aStream position.

	aStream position: localHeaderRelativeOffset.

	sig := aStream next: 4.
	sig = LocalFileHeaderSignature asByteArray
		ifFalse: [ aStream position: oldPos.
				^self error: 'bad LH signature at ', localHeaderRelativeOffset printStringHex ].

	versionNeededToExtract := aStream nextLittleEndianNumber: 2.
	self bitFlag: (aStream nextLittleEndianNumber: 2).
	compressionMethod := aStream nextLittleEndianNumber: 2.
	lastModFileDateTime := self unzipTimestamp: (aStream nextLittleEndianNumber: 4).
	xcrc32 := aStream nextLittleEndianNumber: 4.
	xcompressedSize := aStream nextLittleEndianNumber: 4.
	xuncompressedSize := aStream nextLittleEndianNumber: 4.

	fileNameLength := aStream nextLittleEndianNumber: 2.
	extraFieldLength := aStream nextLittleEndianNumber: 2.

	fileName := (aStream next: fileNameLength) asString.
	localExtraField := (aStream next: extraFieldLength) asByteArray.

	dataOffset := aStream position.

	"Don't trash these fields if we already got them from the central directory"
	self hasDataDescriptor ifFalse: [
		crc32 := xcrc32.
		compressedSize := xcompressedSize.
		uncompressedSize := xuncompressedSize.
	].

	aStream position: oldPos.! !

!ZipFileMember methodsFor: 'private-reading' stamp: 'nk 2/22/2001 20:46'!
readRawChunk: n
	^stream next: n! !

!ZipFileMember methodsFor: 'private-writing' stamp: 'nk 3/27/2002 11:20'!
localHeaderRelativeOffset
	^localHeaderRelativeOffset! !

!ZipFileMember methodsFor: 'testing' stamp: 'CamilloBruni 5/4/2012 20:55'!
usesFileNamed: aFileName
	"Do I require aFileName? That is, do I care if it's clobbered?"
	^ externalFileName asFileReference = aFileName asFileReference! !

!ZipFileMember class methodsFor: 'as yet unclassified' stamp: 'nk 2/22/2001 17:31'!
newFrom: stream named: fileName
	^(self new) stream: stream externalFileName: fileName! !

!ZipFileSystemDirectory commentStamp: 'MaxLeske 9/27/2014 07:52'!
I represent a zip file system entry for a directory. Together with ZipFileSystemFile I take care of lazily accessing archive members.!
!ZipFileSystemDirectory methodsFor: 'creation' stamp: 'MaxLeske 9/27/2014 14:46'!
ensureCreateDirectory: aDirectoryName
	^ self 
		fileEntryAt: aDirectoryName
		put: (self class named: aDirectoryName)! !

!ZipFileSystemDirectory methodsFor: 'creation' stamp: 'MaxLeske 9/27/2014 07:47'!
ensureCreateFile: aFileName
	^ self 
		fileEntryAt: aFileName 
		put: (ZipFileSystemFile named: aFileName)! !

!ZipFileSystemFile commentStamp: 'MaxLeske 9/27/2014 07:52'!
I represent a zip file system entry for a file. Together with ZipFileSystemDirectory I take care of lazily accessing archive members.!
!ZipFileSystemFile methodsFor: 'accessing' stamp: 'MaxLeske 9/27/2014 13:34'!
bytes
	| uncompressed |
	uncompressed := self readFromMember.
	self updateSize: uncompressed size.
	^ uncompressed! !

!ZipFileSystemFile methodsFor: 'private' stamp: 'MaxLeske 9/27/2014 22:24'!
readFromMember
	^ ByteArray 
		new: self member uncompressedSize
		streamContents: [ :stream |		
			self member extractTo: stream ]! !

!ZipFileSystemFile methodsFor: 'accessing' stamp: 'MaxLeske 9/27/2014 10:20'!
member
	^ member! !

!ZipFileSystemFile methodsFor: 'accessing' stamp: 'MaxLeske 9/27/2014 10:19'!
member: aZipArchiveMember
	member := aZipArchiveMember! !

!ZipNewFileMember commentStamp: '<historical>'!
ZipNewFileMember instances are used to represent files that are going to be written to a ZipArchive.
Their data comes from external file streams.!
!ZipNewFileMember methodsFor: 'initialization' stamp: 'SeanDeNigris 5/20/2012 09:42'!
initialize
	super initialize.
	externalFileName := ''.
	compressionMethod := CompressionStored.
	self mapPermissionsFromUnix: DefaultFilePermissions.
! !

!ZipNewFileMember methodsFor: 'initialization' stamp: 'CamilloBruni 6/17/2012 16:57'!
from: aFileName

	| entry |
	"Now get the size, attributes, and timestamps, and see if the file exists"
	stream := StandardFileStream readOnlyFileNamed: aFileName.
	self localFileName: (externalFileName := stream name).
	entry := stream directoryEntry.
	compressedSize := uncompressedSize := entry size.
	desiredCompressionMethod := compressedSize > 0 ifTrue: [ CompressionDeflated ] ifFalse: [ CompressionStored ].
	self flag: 'When we replace Files with FileSystem, the following line won''t have to jump throught hoops (FS returns aDateAndTime)'.
	self modifiedAt: entry modificationTime.
! !

!ZipNewFileMember methodsFor: 'private-writing' stamp: 'nk 2/23/2001 09:58'!
rewindData
	super rewindData.
	readDataRemaining := stream size.
	stream position: 0.! !

!ZipNewFileMember methodsFor: 'initialization' stamp: 'ar 3/2/2001 18:50'!
close
	stream ifNotNil:[stream close].! !

!ZipNewFileMember methodsFor: 'private' stamp: 'nk 2/22/2001 20:48'!
readRawChunk: n
	^stream next: n! !

!ZipNewFileMember methodsFor: 'testing' stamp: 'CamilloBruni 5/4/2012 20:54'!
usesFileNamed: aFileName
	"Do I require aFileName? That is, do I care if it's clobbered?"
	^externalFileName asFileReference = aFileName asFileReference! !

!ZipNewFileMember class methodsFor: 'instance creation' stamp: 'nk 2/22/2001 17:27'!
newNamed: aFileName
	^(self new) from: aFileName! !

!ZipReadStream commentStamp: 'nk 3/7/2004 18:54'!
ZipReadStream is intended for uncompressing the compressed contents of Zip archive members.

Since Zip archive members keep their expected CRC value separately in Zip headers, this class does not attempt to read the CRC from its input stream.

Instead, if you want the CRC verification to work you have to call #expectedCrc: with the expected CRC-32 value from the Zip member header.!
!ZipReadStream methodsFor: 'crc' stamp: 'nk 3/7/2004 15:32'!
updateCrc: oldCrc from: start to: stop in: aCollection
	^ZipWriteStream updateCrc: oldCrc from: start to: stop in: aCollection! !

!ZipReadStream methodsFor: 'initialize' stamp: 'nk 3/7/2004 15:31'!
on: aCollection from: firstIndex to: lastIndex
	super on: aCollection from: firstIndex to: lastIndex.
	crc := 16rFFFFFFFF.
	expectedCrc := nil.! !

!ZipReadStream methodsFor: 'crc' stamp: 'nk 3/7/2004 18:55'!
expectedCrc: aNumberOrNil
	"If expectedCrc is set, it will be compared against the calculated CRC32 in verifyCrc.
	This number should be the number read from the Zip header (which is the bitwise complement of my crc if all is working correctly)"
	expectedCrc := aNumberOrNil! !

!ZipReadStream methodsFor: 'crc' stamp: 'BG 3/16/2005 08:28'!
verifyCrc
	"Verify the CRC-32 checksum calculated from the input against the expected CRC-32, if any.
	Answer the calculated CRC-32 in any case.
	Note that the CRC-32 used in Zip files is actually the bit inverse of the calculated value, so that is what is returned."

	| invertedCrc |
	invertedCrc := crc bitXor: 16rFFFFFFFF.
	(expectedCrc notNil and: [ expectedCrc ~= invertedCrc ])
		ifTrue: [ ^ self crcError: ('Wrong CRC-32 (expected {1} got {2}) (proceed to ignore)' translated format: { expectedCrc printStringHex. invertedCrc printStringHex }) ].
	^invertedCrc! !

!ZipStore commentStamp: '<historical>'!
I'm a specific store for Zip file systems!
!ZipStore methodsFor: 'private' stamp: 'MaxLeske 9/27/2014 07:40'!
pathFromMember: anArchiveMember
	| path |
	path := Path from: anArchiveMember fileName.
	^ path basename isEmpty
		ifTrue: [ path parent ]
		ifFalse: [ path ]! !

!ZipStore methodsFor: 'initialization' stamp: 'MaxLeske 9/27/2014 07:45'!
initialize
	super initialize.
	root := ZipFileSystemDirectory new! !

!ZipStore methodsFor: 'public' stamp: 'EstebanLorenzano 4/2/2012 11:43'!
close
	| archive fs stream |
	archive := ZipArchive new.
	fs := FileSystem store: self.
	fs root allChildren do: 
		[ :each | 
		each isFile ifTrue: 
			[ each readStreamDo: 
				[ :output | 
				archive addString: output contents as: each path printString ] ] ].
	archive
		writeTo: (stream := WriteStream on: ByteArray new);
		close.
	self reference writeStreamDo: 
		[ :output | output nextPutAll: stream contents ]! !

!ZipStore methodsFor: 'public' stamp: 'cwp 2/18/2011 23:49'!
reference
	^ reference! !

!ZipStore methodsFor: 'initialization' stamp: 'cwp 2/18/2011 23:49'!
initializeWithReference: aReference
	self initialize.
	reference := aReference! !

!ZipStore methodsFor: 'public' stamp: 'MaxLeske 9/27/2014 10:19'!
open
	| archive |
	self reference exists
		ifFalse: [ ^ self ].
	archive := ZipArchive new.
	self reference
		binaryReadStreamDo: [ :input | 
			archive readFrom: input contents readStream.
			archive members
				do: [ :member | 
					| path |
					path := self pathFromMember: member.
					member isDirectory
						ifTrue: [ self ensureCreateDirectory: path ]
						ifFalse: [ 
							self ensureCreateDirectory: path parent.
							(self createFile: path) member: member ] ] ].
	^ self! !

!ZipStore methodsFor: 'printing' stamp: 'MaxLeske 9/27/2014 07:49'!
forReferencePrintOn: aStream
	aStream nextPutAll: 'zip://'! !

!ZipStore class methodsFor: 'as yet unclassified' stamp: 'cwp 2/18/2011 23:46'!
reference: aReference
	^ self basicNew
		initializeWithReference: aReference
		yourself! !

!ZipStringMember commentStamp: '<historical>'!
ZipStringMember instances are used to represent files that are going to be written to a ZipArchive.
Their data comes from in-image strings, though.!
!ZipStringMember methodsFor: 'initialization' stamp: 'nk 2/22/2001 20:50'!
initialize
	super initialize.
	self contents: ''.
	compressionMethod := desiredCompressionMethod := CompressionStored.
! !

!ZipStringMember methodsFor: 'initialization' stamp: 'SeanDeNigris 5/18/2012 12:57'!
contents: aString
	contents := aString.
	compressedSize := uncompressedSize := aString size.
	"set the file date to now"
	self modifiedAt: DateAndTime now.! !

!ZipStringMember methodsFor: 'private-writing' stamp: 'damiencassou 5/30/2008 16:16'!
rewindData
	super rewindData.
	stream := contents readStream.
	readDataRemaining := contents size! !

!ZipStringMember methodsFor: 'private' stamp: 'nk 2/22/2001 20:51'!
readRawChunk: n
	^stream next: n! !

!ZipStringMember methodsFor: 'initialization' stamp: 'nk 2/22/2001 16:47'!
contents
	^contents! !

!ZipStringMember class methodsFor: 'as yet unclassified' stamp: 'nk 12/20/2002 15:06'!
newFrom: aString named: aFileName
	^(self new) contents: aString; localFileName: aFileName; yourself! !

!ZipWriteStream commentStamp: 'TorstenBergmann 2/3/2014 23:03'!
A ZIP write stream!
!ZipWriteStream methodsFor: 'dynamic blocks' stamp: 'ar 12/30/1999 11:40'!
sendLiteralTree: lTree distanceTree: dTree using: blTree bitLengths: bits
	"Send all the trees needed for dynamic huffman tree encoding"
	| lastValue lastCount value |
	encoder nextBits: 5 put: (lTree maxCode - 256).
	encoder nextBits: 5 put: (dTree maxCode).
	self sendBitLengthTree: blTree.
	bits size = 0 ifTrue:[^self].
	lastValue := bits at: 1.
	lastCount := 1.
	2 to: bits size do:[:i|
		value := bits at: i.
		value = lastValue 
			ifTrue:[lastCount := lastCount + 1]
			ifFalse:[self sendBitLength: lastValue repeatCount: lastCount tree: blTree.
					lastValue := value.
					lastCount := 1]].
	self sendBitLength: lastValue repeatCount: lastCount tree: blTree.! !

!ZipWriteStream methodsFor: 'dynamic blocks' stamp: 'ar 12/30/1999 01:55'!
dynamicBlockSizeFor: lTree and: dTree using: blTree and: blFreq
	"Compute the length for the current block using dynamic huffman trees"
	| bits index extra treeBits freq |
	bits := 3 "block type" + 5 "literal codes length" + 5 "distance codes length".

	"Compute the # of bits for sending the bit length tree"
	treeBits := 4. "Max index for bit length tree"
	index := MaxBitLengthCodes.
	[index >= 4] whileTrue:[
		(index = 4 or:[(blFreq at: (BitLengthOrder at: index)+1) > 0])
			ifTrue:[treeBits := treeBits + (index * 3).
					index := -1]
			ifFalse:[index := index - 1]].

	"Compute the # of bits for sending the literal/distance tree.
	Note: The frequency are already stored in the blTree"
	0 to: 15 do:[:i| "First, the non-repeating values"
		freq := blFreq at: i+1.
		freq > 0 ifTrue:[treeBits := treeBits + (freq * (blTree bitLengthAt: i))]].
	"Now the repeating values"
	(Repeat3To6 to: Repeat11To138) with: #(2 3 7) do:[:i :addl|
		freq := blFreq at: i+1.
		freq > 0 ifTrue:[
			treeBits := treeBits + (freq * ((blTree bitLengthAt: i) + addl "addl bits"))]].
	VerboseLevel > 1 ifTrue:[
		Transcript show:'['; print: treeBits; show:' bits for dynamic tree]'].
	bits := bits + treeBits.

	"Compute the size of the compressed block"
	0 to: NumLiterals do:[:i| "encoding of literals"
		freq := literalFreq at: i+1.
		freq > 0 ifTrue:[bits := bits + (freq * (lTree bitLengthAt: i))]].
	NumLiterals+1 to: lTree maxCode do:[:i| "encoding of match lengths"
		freq := literalFreq at: i+1.
		extra := ExtraLengthBits at: i-NumLiterals.
		freq > 0 ifTrue:[bits := bits + (freq * ((lTree bitLengthAt: i) + extra))]].
	0 to: dTree maxCode do:[:i| "encoding of distances"
		freq := distanceFreq at: i+1.
		extra := ExtraDistanceBits at: i+1.
		freq > 0 ifTrue:[bits := bits + (freq * ((dTree bitLengthAt: i) + extra))]].

	^bits! !

!ZipWriteStream methodsFor: 'stored blocks' stamp: 'ar 12/30/1999 00:42'!
storedBlockSize
	"Compute the length for the current block when stored as is"
	^3 "block type bits" 
		+ (8 - (encoder bitPosition + 3 bitAnd: 7) bitAnd: 7)"skipped bits to byte boundary"
			+ 32 "byte length + chksum" 
				+ (blockPosition - blockStart * 8) "actual data bits".! !

!ZipWriteStream methodsFor: 'initialization' stamp: 'ar 2/28/2001 13:39'!
close
	self deflateBlock.
	self flushBlock: true.
	encoder close.! !

!ZipWriteStream methodsFor: 'private' stamp: 'ar 2/24/2001 19:45'!
moveContentsToFront
	"Need to update crc here"
	self updateCrc.
	super moveContentsToFront.
	crcPosition := position + 1.! !

!ZipWriteStream methodsFor: 'dynamic blocks' stamp: 'ar 12/30/1999 00:48'!
sendCompressedBlock: litTree with: distTree
	"Send the current block using the encodings from the given literal/length and distance tree"
	| sum |
	sum := encoder
			sendBlock: (ReadStream on: literals from: 1 to: litCount)
			with: (ReadStream on: distances from: 1 to: litCount)
			with: litTree
			with: distTree.
	sum = (blockPosition - blockStart) ifFalse:[self error:'Wrong number of bytes'].! !

!ZipWriteStream methodsFor: 'private' stamp: 'ar 2/24/2001 19:45'!
updateCrc
	crcPosition <= position ifTrue:[
		bytesWritten := bytesWritten + position - crcPosition + 1.
		crc := self updateCrc: crc from: crcPosition to: position in: collection.
		crcPosition := position + 1].! !

!ZipWriteStream methodsFor: 'fixed blocks' stamp: 'ar 12/29/1999 18:18'!
sendFixedBlock
	"Send a block using fixed huffman trees"
	self sendCompressedBlock: FixedLiteralTree with: FixedDistanceTree.! !

!ZipWriteStream methodsFor: 'initialization' stamp: 'nk 2/17/2004 16:30'!
writeFooter
	"Write footer information if necessary"
	crc := crc bitXor: 16rFFFFFFFF.! !

!ZipWriteStream methodsFor: 'initialization' stamp: 'ar 12/30/1999 00:40'!
initialize
	super initialize.
	literals := ByteArray new: WindowSize.
	distances := WordArray new: WindowSize.
	literalFreq := WordArray new: MaxLiteralCodes.
	distanceFreq := WordArray new: MaxDistCodes.
	self initializeNewBlock.
! !

!ZipWriteStream methodsFor: 'dynamic blocks' stamp: 'ar 12/30/1999 11:55'!
scanBitLengths: bits into: anArray
	"Scan the trees and determine the frequency of the bit lengths.
	For repeating codes, emit a repeat count."
	| lastValue lastCount value |
	bits size = 0 ifTrue:[^self].
	lastValue := bits at: 1.
	lastCount := 1.
	2 to: bits size do:[:i|
		value := bits at: i.
		value = lastValue 
			ifTrue:[lastCount := lastCount + 1]
			ifFalse:[self scanBitLength: lastValue repeatCount: lastCount into: anArray.
					lastValue := value.
					lastCount := 1]].
	self scanBitLength: lastValue repeatCount: lastCount into: anArray.! !

!ZipWriteStream methodsFor: 'encoding' stamp: 'ar 12/29/1999 18:05'!
encodeMatch: length distance: dist
	"Encode the given match of length length starting at dist bytes ahead"
	| literal distance |
	dist > 0 
		ifFalse:[^self error:'Distance must be positive'].
	length < MinMatch 
		ifTrue:[^self error:'Match length must be at least ', MinMatch printString].
	litCount := litCount + 1.
	matchCount := matchCount + 1.
	literals at: litCount put: length - MinMatch.
	distances at: litCount put: dist.
	literal := (MatchLengthCodes at: length - MinMatch + 1).
	literalFreq at: literal+1 put: (literalFreq at: literal+1) + 1.
	dist < 257
		ifTrue:[distance := DistanceCodes at: dist]
		ifFalse:[distance := DistanceCodes at: 257 + (dist - 1 bitShift: -7)].
	distanceFreq at: distance+1 put: (distanceFreq at: distance+1) + 1.
	^self shouldFlush! !

!ZipWriteStream methodsFor: 'accessing' stamp: 'ar 2/24/2001 19:46'!
crc
	^crc! !

!ZipWriteStream methodsFor: 'private' stamp: 'nk 2/17/2004 16:51'!
updateCrc: oldCrc from: start to: stop in: aCollection
	^self class updateCrc: oldCrc from: start to: stop in: aCollection! !

!ZipWriteStream methodsFor: 'initialization' stamp: 'ar 2/24/2001 19:43'!
on: aCollectionOrStream
	crc := 16rFFFFFFFF.
	crcPosition := 1.
	bytesWritten := 0.
	encoder := ZipEncoder on: aCollectionOrStream.
	encoder isBinary
		ifTrue:[super on: ByteArray new]
		ifFalse:[super on: String new].
	self writeHeader.
! !

!ZipWriteStream methodsFor: 'initialization' stamp: 'ar 12/29/1999 18:29'!
initializeNewBlock
	"Initialize the encoder for a new block of data"
	literalFreq atAllPut: 0.
	distanceFreq atAllPut: 0.
	literalFreq at: EndBlock+1 put: 1.
	litCount := 0.
	matchCount := 0.! !

!ZipWriteStream methodsFor: 'dynamic blocks' stamp: 'ar 12/29/1999 18:19'!
sendDynamicBlock: blTree literalTree: lTree distanceTree: dTree bitLengths: bits
	"Send a block using dynamic huffman trees"
	self sendLiteralTree: lTree distanceTree: dTree using: blTree bitLengths: bits.
	self sendCompressedBlock: lTree with: dTree.! !

!ZipWriteStream methodsFor: 'dynamic blocks' stamp: 'ar 12/30/1999 11:55'!
scanBitLength: bitLength repeatCount: repeatCount into: anArray
	"Update the frequency for the aTree based on the given values"
	| count |
	count := repeatCount.
	bitLength = 0 ifTrue:[
		[count >= 11] whileTrue:[
			anArray at: Repeat11To138+1 put: (anArray at: Repeat11To138+1) + 1.
			count := (count - 138) max: 0].
		[count >= 3] whileTrue:[
			anArray at: Repeat3To10+1 put: (anArray at: Repeat3To10+1) + 1.
			count := (count - 10) max: 0].
		count > 0 ifTrue:[anArray at: bitLength+1 put: (anArray at: bitLength+1) + count].
	] ifFalse:[
		anArray at: bitLength+1 put: (anArray at: bitLength+1) + 1.
		count := count - 1.
		[count >= 3] whileTrue:[
			anArray at: Repeat3To6+1 put: (anArray at: Repeat3To6+1) + 1.
			count := (count - 6) max: 0].
		count > 0 ifTrue:[anArray at: bitLength+1 put: (anArray at: bitLength+1) + count].
	].! !

!ZipWriteStream methodsFor: 'dynamic blocks' stamp: 'ar 12/30/1999 11:40'!
sendBitLengthTree: blTree
	"Send the bit length tree"
	| blIndex bitLength |
	MaxBitLengthCodes to: 4 by: -1 do:[:maxIndex|
		blIndex := BitLengthOrder at: maxIndex.
		bitLength := blIndex <= blTree maxCode 
			ifTrue:[blTree bitLengthAt: blIndex] ifFalse:[0].
		(maxIndex = 4 or:[bitLength > 0]) ifTrue:[
			encoder nextBits: 4 put: maxIndex - 4.
			1 to: maxIndex do:[:j|
				blIndex := BitLengthOrder at: j.
				bitLength := blIndex <= blTree maxCode 
					ifTrue:[blTree bitLengthAt: blIndex] ifFalse:[0].
				encoder nextBits: 3 put: bitLength].
			^self]].! !

!ZipWriteStream methodsFor: 'initialization' stamp: 'nk 2/17/2004 16:31'!
release
	"We're done with compression. Do some cleanup."
	literals := distances := literalFreq := distanceFreq := nil.
	self updateCrc.
	encoder flushBits.
	self writeFooter.! !

!ZipWriteStream methodsFor: 'initialization' stamp: 'ar 2/24/2001 19:44'!
writeHeader
	"Write header information if necessary"! !

!ZipWriteStream methodsFor: 'deflating' stamp: 'ar 2/2/2001 15:47'!
deflateBlock: lastIndex chainLength: chainLength goodMatch: goodMatch
	"^DeflatePlugin doPrimitive:#primitiveDeflateBlock"
	<primitive: 'primitiveDeflateBlock' module: 'ZipPlugin'>
	^super deflateBlock: lastIndex chainLength: chainLength goodMatch: goodMatch! !

!ZipWriteStream methodsFor: 'dynamic blocks' stamp: 'ar 12/30/1999 11:40'!
sendBitLength: bitLength repeatCount: repeatCount tree: aTree
	"Send the given bitLength, repeating repeatCount times"
	| count |
	count := repeatCount.
	bitLength = 0 ifTrue:[
		[count >= 11] whileTrue:[
			self sendBitLength: Repeat11To138 tree: aTree.
			encoder nextBits: 7 put: (count min: 138) - 11.
			count := (count - 138) max: 0].
		[count >= 3] whileTrue:[
			self sendBitLength: Repeat3To10 tree: aTree.
			encoder nextBits: 3 put: (count min: 10) - 3.
			count := (count - 10) max: 0].
		count timesRepeat:[self sendBitLength: bitLength tree: aTree].
	] ifFalse:[
		self sendBitLength: bitLength tree: aTree.
		count := count - 1.
		[count >= 3] whileTrue:[
			self sendBitLength: Repeat3To6 tree: aTree.
			encoder nextBits: 2 put: (count min: 6) - 3.
			count := (count - 6) max: 0].
		count timesRepeat:[self sendBitLength: bitLength tree: aTree].
	].! !

!ZipWriteStream methodsFor: 'encoding' stamp: 'ar 12/29/1999 18:05'!
encodeLiteral: lit
	"Encode the given literal"
	litCount := litCount + 1.
	literals at: litCount put: lit.
	distances at: litCount put: 0.
	literalFreq at: lit+1 put: (literalFreq at: lit+1) + 1.
	^self shouldFlush! !

!ZipWriteStream methodsFor: 'encoding' stamp: 'marcus.denker 9/14/2008 21:02'!
flushBlock: lastBlock
	"Send the current block"
	| lastFlag bitsRequired method bitsSent
	storedLength fixedLength dynamicLength 
	blTree lTree dTree blBits blFreq |

	lastFlag := lastBlock ifTrue:[1] ifFalse:[0].

	"Compute the literal/length and distance tree"
	lTree := ZipEncoderTree buildTreeFrom: literalFreq maxDepth: MaxBits.
	dTree := ZipEncoderTree buildTreeFrom: distanceFreq maxDepth: MaxBits.

	"Compute the bit length tree"
	blBits := lTree bitLengths, dTree bitLengths.
	blFreq := WordArray new: MaxBitLengthCodes.
	self scanBitLengths: blBits into: blFreq.
	blTree := ZipEncoderTree buildTreeFrom: blFreq maxDepth: MaxBitLengthBits.

	"Compute the bit length for the current block.
	Note: Most of this could be computed on the fly but it's getting
	really ugly in this case so we do it afterwards."
	storedLength := self storedBlockSize.
	fixedLength := self fixedBlockSizeFor: lTree and: dTree.
	dynamicLength := self dynamicBlockSizeFor: lTree and: dTree 
							using: blTree and: blFreq.
	VerboseLevel > 1 ifTrue:[
		Transcript cr; show:'Block sizes (S/F/D):';
			space; print: storedLength // 8; 
			nextPut:$/; print: fixedLength // 8; 
			nextPut:$/; print: dynamicLength // 8; space; endEntry].

	"Check which method to use"
	method := self forcedMethod.
	method ifNil:[
		method := (storedLength < fixedLength and:[storedLength < dynamicLength]) 
			ifTrue:[#stored]
			ifFalse:[fixedLength < dynamicLength ifTrue:[#fixed] ifFalse:[#dynamic]]].
	(method == #stored and:[blockStart < 0]) ifTrue:[
		"Cannot use #stored if the block is not available"
		method := fixedLength < dynamicLength ifTrue:[#fixed] ifFalse:[#dynamic]].

	bitsSent := encoder bitPosition. "# of bits sent before this block"
	bitsRequired := nil.

	(method == #stored) ifTrue:[
		VerboseLevel > 0 ifTrue:[Transcript show:'S'].
		bitsRequired := storedLength.
		encoder nextBits: 3 put: StoredBlock << 1 + lastFlag.
		self sendStoredBlock].

	(method == #fixed) ifTrue:[
		VerboseLevel > 0 ifTrue:[Transcript show:'F'].
		bitsRequired := fixedLength.
		encoder nextBits: 3 put: FixedBlock << 1 + lastFlag.
		self sendFixedBlock].

	(method == #dynamic) ifTrue:[
		VerboseLevel > 0 ifTrue:[Transcript show:'D'].
		bitsRequired := dynamicLength.
		encoder nextBits: 3 put: DynamicBlock << 1 + lastFlag.
		self sendDynamicBlock: blTree 
			literalTree: lTree 
			distanceTree: dTree 
			bitLengths: blBits].

	bitsRequired = (encoder bitPosition - bitsSent)
		ifFalse:[self error:'Bits size mismatch'].

	lastBlock 
		ifTrue:[self release]
		ifFalse:[self initializeNewBlock].! !

!ZipWriteStream methodsFor: 'accessing' stamp: 'ar 12/29/1999 18:32'!
forcedMethod
	"Return a symbol describing an enforced method or nil if the method should
	be chosen adaptively. Valid symbols are
		#stored	- store blocks (do not compress)
		#fixed	- use fixed huffman trees
		#dynamic	- use dynamic huffman trees."
	^nil! !

!ZipWriteStream methodsFor: 'stored blocks' stamp: 'ar 1/2/2000 16:36'!
sendStoredBlock
	"Send an uncompressed block"
	| inBytes |
	inBytes := blockPosition - blockStart.
	encoder flushBits. "Skip to byte boundary"
	encoder nextBits: 16 put: inBytes.
	encoder nextBits: 16 put: (inBytes bitXor: 16rFFFF).
	encoder flushBits.
	1 to: inBytes do:[:i|
		encoder nextBytePut: (collection byteAt: blockStart+i)].! !

!ZipWriteStream methodsFor: 'fixed blocks' stamp: 'ar 12/29/1999 18:18'!
fixedBlockSizeFor: lTree and: dTree
	"Compute the length for the current block using fixed huffman trees"
	| bits extra |
	bits := 3 "block type".
	"Compute the size of the compressed block"
	0 to: NumLiterals do:[:i| "encoding of literals"
		bits := bits + ((literalFreq at: i+1) * (FixedLiteralTree bitLengthAt: i))].
	NumLiterals+1 to: lTree maxCode+1 do:[:i| "Encoding of match lengths"
		extra := ExtraLengthBits at: i-NumLiterals.
		bits := bits + ((literalFreq at: i+1) * ((FixedLiteralTree bitLengthAt: i) + extra))].
	0 to: dTree maxCode do:[:i| "encoding of distances"
		extra := ExtraDistanceBits at: i+1.
		bits := bits + ((distanceFreq at: i+1) * ((FixedDistanceTree bitLengthAt: i) + extra))].

	^bits! !

!ZipWriteStream methodsFor: 'accessing' stamp: 'ar 12/30/1999 00:37'!
encodedStream
	^encoder encodedStream! !

!ZipWriteStream methodsFor: 'encoding' stamp: 'ar 12/29/1999 18:08'!
shouldFlush
	"Check if we should flush the current block.
	Flushing can be useful if the input characteristics change."
	| nLits |
	litCount = literals size ifTrue:[^true]. "We *must* flush"
	(litCount bitAnd: 16rFFF) = 0 ifFalse:[^false]. "Only check every N kbytes"
	matchCount * 10 <= litCount ifTrue:[
		"This is basically random data. 
		There is no need to flush early since the overhead
		for encoding the trees will add to the overall size"
		^false].
	"Try to adapt to the input data.
	We flush if the ratio between matches and literals
	changes beyound a certain threshold"
	nLits := litCount - matchCount.
	nLits <= matchCount ifTrue:[^false]. "whow!! so many matches"
	^nLits * 4 <= matchCount! !

!ZipWriteStream methodsFor: 'dynamic blocks' stamp: 'ar 12/30/1999 11:40'!
sendBitLength: bitLength tree: aTree
	"Send the given bitLength"
	encoder nextBits: (aTree bitLengthAt: bitLength) 
		put: (aTree codeAt: bitLength).! !

!ZipWriteStream methodsFor: 'encoding' stamp: 'ar 12/29/1999 18:08'!
flushBlock
	^self flushBlock: false! !

!ZipWriteStream methodsFor: 'initialization' stamp: 'ar 2/27/2001 13:23'!
finish
	"Finish pending operation. Do not close output stream."
	self deflateBlock.
	self flushBlock: true.
	encoder flush.! !

!ZipWriteStream class methodsFor: 'accessing' stamp: 'ar 12/29/1999 20:53'!
maxDistanceCodes
	^MaxDistCodes! !

!ZipWriteStream class methodsFor: 'regression test' stamp: 'CamilloBruni 5/4/2012 19:35'!
printRegressionStats: stats from: fd
	| raw compressed numFiles |
	raw := stats at: #rawSize ifAbsent:[0].
	raw = 0 ifTrue:[^self].
	compressed := stats at: #compressedSize ifAbsent:[0].
	numFiles := stats at: #numFiles ifAbsent:[0].
	Transcript cr; nextPutAll: fd fullName.
	Transcript cr; tab; nextPutAll:'Files compressed: ', numFiles asStringWithCommas.
	Transcript cr; tab; nextPutAll:'Bytes compressed: ', raw asStringWithCommas.
	Transcript cr; tab; nextPutAll:'Avg. compression ratio: ';
		print: ((compressed / raw asFloat * 100.0) truncateTo: 0.01).
	Transcript endEntry.! !

!ZipWriteStream class methodsFor: 'accessing' stamp: 'ar 12/30/1999 15:55'!
extraLengthBits
	^ExtraLengthBits! !

!ZipWriteStream class methodsFor: 'regression test' stamp: 'CamilloBruni 5/4/2012 19:36'!
regressionTestFrom: fd using: tempFile stats: stats
	| files |
	files := fd files asSortedCollection.
	files do: [ :file | 
		file = tempFile ifFalse: [
			self 
				compressAndDecompress: (StandardFileStream new open: file fullName forWrite: false) 
				using: tempFile 
				stats: stats]].
	
	stats at: #numFiles put: (stats at: #numFiles ifAbsent:[0]) + files size.
	files := nil.
	
	self printRegressionStats: stats from: fd.
	fd directories asSortedCollection do:[:directory|
		self regressionTestFrom: directory using: tempFile stats: stats.
	].! !

!ZipWriteStream class methodsFor: 'regression test' stamp: 'CamilloBruni 5/4/2012 19:31'!
compressAndDecompress: aFile using: tempFile stats: stats

	| fileSize tempStream result |
	aFile ifNil: [^nil].
	fileSize := aFile size.
	(fileSize < 1"00000" "or:[fileSize > 1000000]") ifTrue:[aFile close. ^nil].
	Transcript cr; show:'Testing ', aFile name,' ... '.
	tempStream := StandardFileStream new open: tempFile fullName forWrite: true.
	'Compressing ', aFile name,'...' displayProgressFrom:  1 to: aFile size during: [ :bar |
			result := self regressionCompress: aFile into: tempStream notifiying: bar stats: stats].
	result ifTrue: [
		'Validating ', aFile name,'...' displayProgressFrom: 0 to: aFile size during: [ :bar |
				result := self regressionDecompress: aFile from: tempStream notifying: bar stats: stats]].
	aFile close.
	tempStream close.
	tempFile delete.
	result ~~ false ifTrue: [
		Transcript show:' ok (', (result * 100 truncateTo: 0.01) printString,')'].
	^result! !

!ZipWriteStream class methodsFor: 'accessing' stamp: 'ar 12/29/1999 20:42'!
distanceCodes
	^DistanceCodes! !

!ZipWriteStream class methodsFor: 'initialization' stamp: 'MaxLeske 7/8/2013 21:28'!
initialize
	"ZipWriteStream initialize"
	VerboseLevel := 0! !

!ZipWriteStream class methodsFor: 'accessing' stamp: 'ar 12/30/1999 15:55'!
baseLength
	^BaseLength! !

!ZipWriteStream class methodsFor: 'accessing' stamp: 'ar 12/30/1999 15:55'!
extraDistanceBits
	^ExtraDistanceBits! !

!ZipWriteStream class methodsFor: 'accessing' stamp: 'ar 12/29/1999 20:42'!
matchLengthCodes
	^MatchLengthCodes! !

!ZipWriteStream class methodsFor: 'regression test' stamp: 'SeanDeNigris 6/21/2012 08:38'!
regressionCompress: aFile into: tempFile notifiying: progressBar stats: stats
	"Compress aFile into tempFile"
	| zip encoded buffer |
	aFile binary.
	aFile position: 0.
	tempFile binary.
	buffer := ByteArray new: 4096.
	zip := self on: (ByteArray new: 10000).
	encoded := zip encodedStream.
	[aFile atEnd] whileFalse:[
		progressBar current: aFile position.
		zip nextPutAll: (aFile nextInto: buffer).
		encoded position > 0 ifTrue:[
			tempFile nextPutAll: encoded contents.
			encoded position: 0]].
	zip close.
	tempFile nextPutAll: encoded contents.
	^true! !

!ZipWriteStream class methodsFor: 'regression test' stamp: 'ClementBera 7/26/2013 16:34'!
regressionDecompress: aFile from: tempFile notifying: progressBar stats: stats
	"Validate aFile as decompressed from tempFile"

	| unzip rawSize compressedSize buffer1 buffer2 |
	rawSize := aFile size.
	compressedSize := tempFile size.
	aFile ascii.
	aFile position: 0.
	tempFile ascii.
	tempFile position: 0.
	buffer1 := ByteArray new: 4096.
	buffer2 := buffer1 copy.
	unzip := FastInflateStream on: tempFile.
	[ aFile atEnd ]
		whileFalse: [ 
			progressBar current: aFile position.
			buffer1 := aFile nextInto: buffer1.
			buffer2 := unzip nextInto: buffer2.
			buffer1 = buffer2
				ifFalse: [ ^ self logProblem: 'contents ' for: aFile ] ].
	unzip next ifNotNil: [ ^ self logProblem: 'EOF' for: aFile ].
	stats at: #rawSize put: (stats at: #rawSize ifAbsent: [ 0 ]) + rawSize.
	stats at: #compressedSize put: (stats at: #compressedSize ifAbsent: [ 0 ]) + compressedSize.
	^ compressedSize asFloat / rawSize asFloat! !

!ZipWriteStream class methodsFor: 'accessing' stamp: 'ar 12/29/1999 20:53'!
maxLiteralCodes
	^MaxLiteralCodes! !

!ZipWriteStream class methodsFor: 'regression test' stamp: 'CamilloBruni 5/4/2012 20:54'!
regressionTest "ZipWriteStream regressionTest"
	"Compress and decompress everything we can 
	find to validate that compression works as expected."
	self regressionTestFrom: FileSystem workingDirectory.! !

!ZipWriteStream class methodsFor: 'regression test' stamp: 'CamilloBruni 5/4/2012 19:26'!
regressionTestFrom: fd
	"ZipWriteStream regressionTestFrom: FileSystem disk workingDirectory"
	"ZipWriteStream regressionTestFrom: (FileSystem disk root)"
	| tempFile stats |
	Transcript clear.
	stats := Dictionary new.
	tempFile := FileSystem disk workingDirectory / '$$sqcompress$$'.
	tempFile delete.
	self regressionTestFrom: fd using: tempFile stats: stats.! !

!ZipWriteStream class methodsFor: 'crc' stamp: 'MaxLeske 7/8/2013 21:34'!
updateCrc: oldCrc from: start to: stop in: aCollection
	^ CRC update: oldCrc from: start to: stop in: aCollection! !

!ZipWriteStream class methodsFor: 'regression test' stamp: 'StephaneDucasse 11/6/2011 23:58'!
logProblem: reason for: aFile
	| errFile |
	errFile := FileStream fileNamed:'problems.log'.
	errFile position: errFile size.
	errFile cr; nextPutAll: aFile name;
			cr; nextPutAll: reason.
	errFile close.
	self trace:' failed (', reason,')'.
	aFile close.
	^false! !

!ZipWriteStream class methodsFor: 'accessing' stamp: 'ar 12/30/1999 15:55'!
baseDistance
	^BaseDistance! !

!ZipWriteStreamTests methodsFor: 'tests' stamp: 'MarianoMartinezPeck 12/16/2011 10:32'!
testEmptyStrings
	| aStream zipStream |

	aStream := ByteArray new writeStream binary.
	zipStream := ZipWriteStream on: aStream.
	zipStream nextStringPut: ''. 
	zipStream nextStringPut: ''.
	zipStream close.
	aStream close.
	aStream := aStream contents readStream binary.
	zipStream := ZipReadStream on: aStream.
	self assert: zipStream nextString isEmpty. 
	self assert: zipStream nextString isEmpty.
	zipStream close.
	aStream close.! !

!ZnApplicationFormUrlEncodedEntity commentStamp: 'SvenVanCaekenberghe 1/18/2011 11:04'!
I am ZnApplicationFormUrlEncodedEntity, a concrete HTTP Entity 
holding a set of fields (key value pairs) that is form URL encoded.
I am a ZnEntity.

Part of Zinc HTTP Components.!
!ZnApplicationFormUrlEncodedEntity methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:34'!
printContentsOn: stream
	super printContentsOn: stream.
	self isEmpty
		ifTrue: [ ^ self ].
	stream space.
	fields printElementsOn: stream! !

!ZnApplicationFormUrlEncodedEntity methodsFor: 'enumerating' stamp: 'SvenVanCaekenberghe 1/31/2011 12:16'!
fieldsDo: block
	self fields keysAndValuesDo: block! !

!ZnApplicationFormUrlEncodedEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/24/2013 10:52'!
addAll: keyedCollection
	"Note that we use #addAllMulti:"

	self invalidateRepresentation.
	self fields addAllMulti: keyedCollection.
	^ keyedCollection ! !

!ZnApplicationFormUrlEncodedEntity methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/4/2010 12:41'!
isEmpty
	^ self fields isEmpty! !

!ZnApplicationFormUrlEncodedEntity methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 1/25/2013 14:32'!
readFrom: stream
	"We parse from stream, limited to content length if available."
	
	| readStream |
	representation := nil.
	contentLength isNil
		ifTrue: [ readStream := ZnCharacterReadStream on: stream encoding: 'ascii' ]
		ifFalse: [ (readStream := ZnLimitedReadStream on: stream limit: contentLength) ascii ].
	fields := ZnResourceMetaUtils parseQueryFrom: readStream! !

!ZnApplicationFormUrlEncodedEntity methodsFor: 'writing' stamp: 'SvenVanCaekenberghe 5/18/2013 19:58'!
writeOn: stream
	"In most use cases, contentLength will have been asked first so that a representation is cached"
	
	representation isNil ifTrue: [ self computeRepresentation ].
	ZnUtils nextPutAll: representation on: stream! !

!ZnApplicationFormUrlEncodedEntity methodsFor: 'writing' stamp: 'KrisGybels 6/11/2014 13:48'!
writeRepresentationOn: stream
	self contentType charSet
		ifNotNil: [:charSet|
			ZnResourceMetaUtils
				writeQueryFields: self fields 
				withEncoder: (ZnCharacterEncoder newForEncoding: charSet)
				on: stream] 
		ifNil: [ 
			ZnResourceMetaUtils 
				writeQueryFields: self fields 
				on: stream ]! !

!ZnApplicationFormUrlEncodedEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/12/2011 11:23'!
at: key add: value
	self invalidateRepresentation.
	^ self fields at: key add: value! !

!ZnApplicationFormUrlEncodedEntity methodsFor: 'private' stamp: 'SvenVanCaekenberghe 9/12/2010 10:19'!
computeRepresentation
	representation := String streamContents: [ :stream | self writeRepresentationOn: stream ].
	contentLength := representation size! !

!ZnApplicationFormUrlEncodedEntity methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/25/2013 14:07'!
includesField: field
	^ self fields includesKey: field! !

!ZnApplicationFormUrlEncodedEntity methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 1/31/2011 12:15'!
initialize
	super initialize.
	fields := ZnMultiValueDictionary new.
	self contentType: self class designatedMimeType ! !

!ZnApplicationFormUrlEncodedEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/12/2010 10:23'!
at: key put: value
	self invalidateRepresentation.
	^ self fields at: key put: value! !

!ZnApplicationFormUrlEncodedEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/11/2010 21:07'!
at: key
	^ self fields at: key! !

!ZnApplicationFormUrlEncodedEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/16/2011 23:26'!
add: association
	self at: association key put: association value! !

!ZnApplicationFormUrlEncodedEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/25/2013 14:11'!
at: key ifAbsent: block
	^ self fields at: key ifAbsent: block! !

!ZnApplicationFormUrlEncodedEntity methodsFor: 'private' stamp: 'SvenVanCaekenberghe 9/12/2010 10:17'!
invalidateRepresentation
	representation := nil.
	contentLength := nil! !

!ZnApplicationFormUrlEncodedEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/17/2010 16:19'!
contents
	^ self fields! !

!ZnApplicationFormUrlEncodedEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/12/2010 10:22'!
contentLength
	contentLength isNil ifTrue: [ self computeRepresentation ].
	^ contentLength ! !

!ZnApplicationFormUrlEncodedEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/11/2010 21:00'!
fields
	^ fields! !

!ZnApplicationFormUrlEncodedEntity class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/13/2010 22:23'!
withAll: keyedCollection
	^ self new
		addAll: keyedCollection;
		yourself ! !

!ZnApplicationFormUrlEncodedEntity class methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/11/2010 20:41'!
designatedMimeType
	^ ZnMimeType applicationFormUrlEncoded ! !

!ZnBase64Encoder commentStamp: '<historical>'!
I am ZnBase64Encoder.

Base64 encoding is a technique to encode binary data as a string of characters that can be safely transported over various protocols. Basically, every 3 bytes are encoded using 4 characters from an alphabet of 64. Each encoded character represents 6 bits.

The most commonly used alphabet is 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'. One or two equal signs (= or ==) are used for padding.

The encoded data can optionally be broken into lines. Characters not part of the alphabet are considered as white space and are ignored.

My #encode: method works from ByteArray to String, while my #decode: method works from String to ByteArray.

Note that to encode a String as Base64, you first have to encode the characters as bytes using a character encoder.

See also http://en.wikipedia.org/wiki/Base64

Part of Zinc HTTP Components.!
!ZnBase64Encoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 12/15/2012 14:07'!
decode: string
	"Decode a Base64 encoded string and return the resulting byte array"
	
	^ ByteArray
		new: string size
		streamContents: [ :byteStream | self decode: string readStream to: byteStream ]! !

!ZnBase64Encoder methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 12/15/2012 00:50'!
lineEndConvention: symbol
	"Set the end of line convention to be used.
	Either #cr, #lf or #crlf (the default)."
	
	self assert: (#(cr lf crlf) includes: symbol).
	lineEnd := String perform: symbol! !

!ZnBase64Encoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 12/15/2012 14:08'!
encode: byteArray
	"Encode byteArray using Base64 encoding and return the resulting string"
	
	^ String
		new: byteArray size
		streamContents: [ :stringStream | self encode: byteArray readStream to: stringStream ]! !

!ZnBase64Encoder methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 12/15/2012 13:48'!
initialize
	super initialize.
	alphabet := DefaultAlphabet.
	inverse := DefaultInverse ! !

!ZnBase64Encoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 12/15/2012 00:54'!
encode: byteStream to: stringStream
	| count |
	count := 0.
	[ byteStream atEnd ]
		whileFalse: [ 
			| byte1 byte2 byte3 |
			byte1 := byteStream next.
			byte2 := byteStream next.
			byte3 := byteStream next.
			self
				encode: byte1
				and: byte2
				and: byte3
				to: stringStream.
			count := count + 4.
			(lineLength notNil and: [ count = lineLength ])
				ifTrue: [ 
					stringStream nextPutAll: lineEnd.
					count := 0 ] ]! !

!ZnBase64Encoder methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/15/2012 00:42'!
encode: byte1 and: byte2 and: byte3 to: stream
	stream
		nextPut: (alphabet at: (byte1 >> 2) + 1);
		nextPut: (alphabet at: ((byte1 bitAnd: 2r11) << 4 bitXor: (byte2 ifNil: [ 0 ]) >> 4) + 1).
	byte2
		ifNil: [ stream nextPutAll: '==' ]
		ifNotNil: [ 
			stream nextPut: (alphabet at: ((byte2 bitAnd: 2r1111) << 2 bitXor: (byte3 ifNil: [ 0 ]) >> 6) + 1).
			byte3
				ifNil: [ stream nextPut: $= ]
				ifNotNil: [ stream nextPut: (alphabet at: (byte3 bitAnd: 2r111111) + 1) ] ]! !

!ZnBase64Encoder methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 12/16/2012 15:13'!
breakLinesAt: length
	"Configure me to break lines at lenth, a multiple of 4, and insert newlines"

	self assert: (length \\ 4) isZero description: 'line length should be a multiple of 4'.
	lineLength := length.
	lineEnd ifNil: [ self lineEndConvention: #crlf ]! !

!ZnBase64Encoder methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/15/2012 00:41'!
decode: char1 and: char2 and: char3 and: char4 to: stream
	| v1 v2 v3 v4 |
	v1 := self valueForCharacter: char1.
	v2 := self valueForCharacter: char2.
	v3 := self valueForCharacter: char3.
	v4 := self valueForCharacter: char4.
	stream nextPut: (v1 << 2 bitXor: (v2 ifNil: [ 0 ]) >> 4).
	char3 ~= $=
		ifTrue: [ 
			stream nextPut: ((v2 bitAnd: 2r1111) << 4 bitXor: (v3 ifNil: [ 0 ]) >> 2).
			char4 ~= $=
				ifTrue: [ stream nextPut: ((v3 bitAnd: 2r11) << 6 bitXor: v4) ] ]! !

!ZnBase64Encoder methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/15/2012 00:31'!
valueForCharacter: char
	| code |
	code := char charCode.
	^ (code between: 0 and: 127)
		ifTrue: [ inverse at: code + 1 ]
		ifFalse: [ nil ]! !

!ZnBase64Encoder methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/16/2012 16:42'!
skipWhiteSpace: stream
	[ stream atEnd not and: [ (self valueForCharacter: stream peek) isNil ] ] 
		whileTrue: [ stream next ]! !

!ZnBase64Encoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 12/16/2012 15:13'!
decode: stringStream to: byteStream
	[ stringStream atEnd ]
		whileFalse: [ 
			| char1 char2 char3 char4 |
			self skipWhiteSpace: stringStream.
			char1 := stringStream next.
			char2 := stringStream next.
			char3 := stringStream next.
			char4 := stringStream next.
			char1 isNil | char2 isNil | char3 isNil | char4 isNil
				ifTrue: [ ZnCharacterEncodingError signal: 'Illegal Base64 input' ].
			self
				decode: char1
				and: char2
				and: char3
				and: char4
				to: byteStream ]! !

!ZnBase64Encoder methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 12/16/2012 15:15'!
alphabet: string
	"Set the alphabet to use to string, containing 64 characters to represent 64 byte values.
	I automatically compute the inverse used for fast decoding."
	
	self assert: string size = 64 description: '64 characters are needed for a Base64 alphabet'.
	alphabet := string.
	inverse := Array new: 128.
	0 to: 127 do: [ :each | 
		| offset |
		offset := alphabet indexOf: each asCharacter ifAbsent: [ nil ].
		inverse at: each + 1 put: (offset ifNotNil: [ offset - 1 ]) ]! !

!ZnBase64Encoder methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 12/15/2012 14:06'!
breakLines
	"Configure me to break lines and insert newlines every 76 characters while encoding"

	self breakLinesAt: 76! !

!ZnBase64Encoder class methodsFor: 'class initialization' stamp: 'SvenVanCaekenberghe 12/16/2012 12:54'!
initialize
	DefaultAlphabet := String withAll: ($A to: $Z) , ($a to: $z) , ($0 to: $9) , #($+ $/).
	DefaultInverse := Array new: 128.
	0 to: 127 do: [ :each | 
		| offset |
		offset := DefaultAlphabet indexOf: each asCharacter ifAbsent: [ nil ].
		DefaultInverse at: each + 1 put: (offset ifNotNil: [ offset - 1 ]) ]! !

!ZnBase64EncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/15/2012 13:44'!
testEmpty
	| encoder |
	encoder := ZnBase64Encoder new.
	self 
		assert: (encoder encode: #[])
		equals: ''.
	self
		assert: (encoder decode: '')
		equals: #[]! !

!ZnBase64EncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/15/2012 13:43'!
testDecodingErrors
	| encoder |
	encoder := ZnBase64Encoder new.
	self should: [ encoder decode: 'A' ] raise: Error.
	self should: [ encoder decode: 'AB' ] raise: Error.
	self should: [ encoder decode: 'ABC' ] raise: Error.! !

!ZnBase64EncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/15/2012 13:39'!
testPadding
	| encoder |
	encoder := ZnBase64Encoder new.
	self assert: (encoder encode: 'M' asByteArray) equals: 'TQ=='.
	self assert: (encoder decode: 'TQ==') equals: 'M' asByteArray.
	self assert: (encoder encode: 'Ma' asByteArray) equals: 'TWE='.
	self assert: (encoder decode: 'TWE=') equals: 'Ma' asByteArray! !

!ZnBase64EncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/15/2012 10:16'!
testFullSpectrum
	| encoder input output |
	encoder := ZnBase64Encoder new.
	input := (0 to: 255) asByteArray , (255 to: 0) asByteArray.
	output := encoder encode: input.
	self assert: (encoder decode: output) equals: input.
	encoder breakLines.
	output := encoder encode: input.
	self assert: (encoder decode: output) equals: input.
! !

!ZnBase64EncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/15/2012 00:07'!
testSimple
	| encoder |
	encoder := ZnBase64Encoder new.
	self 
		assert: (encoder encode: 'Man' asByteArray)
		equals: 'TWFu'.
	self
		assert: (encoder decode: 'TWFu')
		equals: 'Man' asByteArray ! !

!ZnBase64EncoderTests methodsFor: 'testing' stamp: 'KenTreis 01/19/2013 09:28'!
testQuote
	| input output encoder break |
	encoder := ZnBase64Encoder new lineEndConvention: #cr; breakLines; yourself.
	input := 'Man is distinguished, not only by his reason, but by this singular passion from other animals, which is a lust of the mind, that by a perseverance of delight in the continued and indefatigable generation of knowledge, exceeds the short vehemence of any carnal pleasure.'.
	break := String with: Character cr.
	output := 'TWFuIGlzIGRpc3Rpbmd1aXNoZWQsIG5vdCBvbmx5IGJ5IGhpcyByZWFzb24sIGJ1dCBieSB0aGlz' , break 
				, 'IHNpbmd1bGFyIHBhc3Npb24gZnJvbSBvdGhlciBhbmltYWxzLCB3aGljaCBpcyBhIGx1c3Qgb2Yg' , break 
				, 'dGhlIG1pbmQsIHRoYXQgYnkgYSBwZXJzZXZlcmFuY2Ugb2YgZGVsaWdodCBpbiB0aGUgY29udGlu' , break 
				, 'dWVkIGFuZCBpbmRlZmF0aWdhYmxlIGdlbmVyYXRpb24gb2Yga25vd2xlZGdlLCBleGNlZWRzIHRo' , break 
				, 'ZSBzaG9ydCB2ZWhlbWVuY2Ugb2YgYW55IGNhcm5hbCBwbGVhc3VyZS4='.
	self 
		assert: (encoder encode: input asByteArray)
		equals: output.
	self 
		assert: (encoder decode: output) 
		equals: input asByteArray ! !

!ZnBasicAuthenticator commentStamp: 'SvenVanCaekenberghe 9/30/2010 15:37'!
I am ZnBasicAuthenticator.
I help servers handle HTTP Basic Authentication.
I implement the required #authenticateRequest:do:

I have a credentials dictionary with username->password associations.

Part of Zinc HTTP Components.!
!ZnBasicAuthenticator methodsFor: 'accessing' stamp: 'MattKennedy 9/30/2010 17:19'!
atUsername: username putPassword: password
	credentials at: username put: password! !

!ZnBasicAuthenticator methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 9/30/2010 15:37'!
initialize
	credentials := Dictionary new! !

!ZnBasicAuthenticator methodsFor: 'public' stamp: 'MattKennedy 9/30/2010 15:56'!
authenticateRequest: request do: block
	^ (self isRequestAuthenticated: request)
		ifTrue: [ block value ]
		ifFalse: [ ZnResponse unauthorized: self authHeader ]! !

!ZnBasicAuthenticator methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:02'!
realm
	^ realm ifNil: [ realm := self class defaultRealm ]! !

!ZnBasicAuthenticator methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/30/2010 15:41'!
removeUsername: username
	credentials removeKey: username! !

!ZnBasicAuthenticator methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/23/2012 22:13'!
isRequestAuthenticated: request
	| authorization username password |
	authorization := [ request basicAuthentication ] on: Error do: [ ^ false ].
	username := authorization first.
	password := authorization second.
	^ (credentials at: username ifAbsent: [ nil ]) = password
	! !

!ZnBasicAuthenticator methodsFor: 'accessing' stamp: 'MattKennedy 9/30/2010 15:51'!
realm: anObject
	realm := anObject! !

!ZnBasicAuthenticator methodsFor: 'public' stamp: 'SvenVanCaekenberghe 8/18/2011 14:18'!
authHeader
	^ 'Basic realm=', self realm! !

!ZnBasicAuthenticator methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/30/2010 15:41'!
removeAll
	credentials removeAll! !

!ZnBasicAuthenticator class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:19'!
defaultRealm
	^ 'ZincHTTPComponents'! !

!ZnBasicAuthenticator class methodsFor: 'instance creation' stamp: 'MattKennedy 9/30/2010 15:55'!
username: username password: password realm: realm
	^ self new
		atUsername: username putPassword: password;
		realm: realm;
		yourself! !

!ZnBasicAuthenticator class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/30/2010 15:36'!
new
	^ super new 
		initialize;
		yourself! !

!ZnBasicAuthenticator class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/30/2010 15:36'!
username: username password: password
	^ self new
		atUsername: username putPassword: password;
		yourself! !

!ZnBasicCredential commentStamp: 'SvenVanCaekenberghe 12/6/2010 12:58'!
I am ZnBasicCredential, a concrete subclass of ZnCredential.
I implement basic HTTP authentication.
I hold a username and password.

Part of Zinc HTTP Components.!
!ZnBasicCredential methodsFor: 'accessing' stamp: 'MattKennedy 9/28/2010 14:27'!
password
	^ password! !

!ZnBasicCredential methodsFor: 'accessing' stamp: 'MattKennedy 9/28/2010 14:27'!
password: anObject
	password := anObject! !

!ZnBasicCredential methodsFor: 'accessing' stamp: 'MattKennedy 9/28/2010 14:27'!
username: anObject
	username := anObject! !

!ZnBasicCredential methodsFor: 'accessing' stamp: 'MattKennedy 9/28/2010 14:27'!
username
	^ username! !

!ZnBasicCredential methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:21'!
isComplete 
	^ username notNil & password notNil ! !

!ZnBasicCredential methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:21'!
authTokenForUrl: urlObject method: method
	^ 'Basic ', (ZnUtils encodeBase64: (username, ':', password)) ! !

!ZnBasicCredential class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:21'!
authName
	^ 'Basic'! !

!ZnBivalentWriteStream commentStamp: 'SvenVanCaekenberghe 12/6/2010 12:50'!
I am ZnBivalentWriteStream, wrapping another write stream.

I allow both Characters and Strings as well as Integers (0 to: 255) and ByteArrays to be writtten to me.

The write stream that I wrap can be both binary as well as character based.

Part of Zinc HTTP Components.!
!ZnBivalentWriteStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 10/4/2010 20:07'!
close
	stream close! !

!ZnBivalentWriteStream methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 10/4/2010 20:08'!
printOn: aStream
	aStream 
		nextPutAll: 'a '; 
		nextPutAll: self class name! !

!ZnBivalentWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/3/2010 20:54'!
nextPut: object
	self isBinary
		ifTrue: [ stream nextPut: object asInteger ]
		ifFalse: [ stream nextPut: object asCharacter ]! !

!ZnBivalentWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/3/2010 20:54'!
nextPutAll: collection
	self isBinary
		ifTrue: [ stream nextPutAll: collection asByteArray ]
		ifFalse: [ stream nextPutAll: collection asString ]! !

!ZnBivalentWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/4/2012 16:06'!
flush
	stream flush! !

!ZnBivalentWriteStream methodsFor: 'private' stamp: 'SvenVanCaekenberghe 1/4/2011 20:54'!
isBinary
	binary isNil
		ifTrue: [ [ binary := stream isBinary ] on: MessageNotUnderstood do: [ :err | binary := false ] ].
	^ binary! !

!ZnBivalentWriteStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 10/4/2010 20:07'!
on: writeStream
	stream := writeStream! !

!ZnBivalentWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/4/2010 20:12'!
space
	self nextPut: Character space! !

!ZnBivalentWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/22/2013 10:01'!
next: count putAll: collection startingAt: offset
	| buffer |
	self isBinary
		ifTrue: [ 
			(collection isKindOf: ByteArray)
				ifTrue: [ stream next: count putAll: collection startingAt: offset ]
				ifFalse: [ 
					buffer := ByteArray new: count.
					buffer replaceFrom: 1 to: count with: collection startingAt: offset.
					stream nextPutAll: buffer ] ]
		ifFalse: [ 
			(collection isKindOf: ByteArray)
				ifTrue: [ 
					buffer := String new: count.
					buffer replaceFrom: 1 to: count with: collection startingAt: offset.
					stream nextPutAll: buffer ]
				ifFalse: [ stream next: count putAll: collection startingAt: offset ] ]! !

!ZnBivalentWriteStream class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 8/18/2011 14:44'!
on: writeStream
	"Wrap writeStream as a ZnBivalentWriteStream, unless it is already one"
	
	(writeStream isKindOf: self) ifTrue: [ ^ writeStream ].
	
	^ self basicNew
		on: writeStream;
		yourself! !

!ZnBivalentWriteStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/3/2010 21:02'!
testCharacterWriting
	| bytes |
	bytes := ByteArray streamContents: [ :stream | | writeStream |
		writeStream := ZnBivalentWriteStream on: stream.
		writeStream nextPut: $a; space; nextPutAll: '123' ].
	self assert: bytes = 'a 123' asByteArray! !

!ZnBivalentWriteStreamTests methodsFor: 'testing' stamp: 'PaulDeBruicker 04/10/2011 10:43'!
testByteWriting
	| string |
	string := String streamContents: [ :stream | | writeStream |
		writeStream := ZnBivalentWriteStream on: stream.
		writeStream nextPut: 97; nextPutAll: #(98 99) asByteArray ].
	self assert: string asByteArray = #(97 98 99) asByteArray! !

!ZnBufferedReadStream commentStamp: '<historical>'!
I am ZnBufferedReadStream.

I wrap another ReadStream and add efficient buffering for the typical access pattern of parsers: sending lots of #next, #peek and #atEnd messages.

By design I do not implement #position and #position: or anything based on that.

I can wrap both binary or character streams and act accordingly.

Part of Zinc HTTP Components.!
!ZnBufferedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/30/2012 21:36'!
skip: count
	"Skip over count elements.
	This could be further optimzed."
	
	count timesRepeat: [ self next ]! !

!ZnBufferedReadStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 11/30/2012 10:28'!
close
	stream close! !

!ZnBufferedReadStream methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/30/2012 10:39'!
atEnd
	^ position > limit and: [ stream atEnd ]
	! !

!ZnBufferedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/30/2012 20:11'!
nextInto: collection
	"Read the next elements of the receiver into collection,
	returning a copy if less elements are available"
	
	^ self
		next: collection size
		into: collection! !

!ZnBufferedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/30/2012 20:18'!
collectionSpecies
	^ stream isBinary
		ifTrue: [ ByteArray ]
		ifFalse: [ String ]! !

!ZnBufferedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/1/2012 20:48'!
next
	"Return the next element and move over it"
	
	position > limit
		ifTrue: [ self nextBuffer ].
	^ position <= limit
		ifTrue: [ 
			| char |
			char := buffer at: position.
			position := position + 1.
			char ]
		ifFalse: [ nil ]! !

!ZnBufferedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/30/2012 21:28'!
isBinary
	^ stream isBinary! !

!ZnBufferedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/30/2012 20:18'!
next: requestedCount 
	"Read requestedCount elements and return them as a collection.
	If less are available, a smaller collection will be returned."

	^ self 
		next: requestedCount 
		into: (self collectionSpecies new: requestedCount)! !

!ZnBufferedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/30/2012 20:11'!
next: requestedCount into: collection
	"Read requestedCount elements into collection,
	returning a copy if less elements are available"
	
	^ self 
		next: requestedCount 
		into: collection 
		startingAt: 1   ! !

!ZnBufferedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/1/2012 20:47'!
peekFor: object
	"Answer false and do not move over the next element if it is not equal to object, or if the receiver is at the end. 
	Answer true and move over the next element when it is equal to object."

	^ self peek = object
		ifTrue: [ 
			self next.
			true ]
		ifFalse: [ false ]! !

!ZnBufferedReadStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 11/30/2012 20:19'!
sizeBuffer: size
	buffer := self collectionSpecies new: size! !

!ZnBufferedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/30/2012 10:27'!
wrappedStream
	^ stream! !

!ZnBufferedReadStream methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 11/30/2012 20:15'!
initialize
	super initialize.
	position := 1.
	limit := 0! !

!ZnBufferedReadStream methodsFor: 'private' stamp: 'SvenVanCaekenberghe 11/30/2012 11:15'!
nextBuffer
	limit := stream readInto: buffer startingAt: 1 count: buffer size.
	position := 1! !

!ZnBufferedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/30/2012 20:15'!
defaultBufferSize
	^ 2 raisedToInteger: 16! !

!ZnBufferedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/30/2012 21:33'!
upTo: value 
	"Read upto but not including value and return them as a collection.
	If value is not found, return the entire contents of the stream.
	This could be further optimzed."
	
	^ self collectionSpecies 
		streamContents: [ :writeStream | | element |
			[ self atEnd or: [ (element := self next) = value ] ] whileFalse: [ 
				writeStream nextPut: element ] ]! !

!ZnBufferedReadStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 11/30/2012 20:15'!
on: readStream
	stream := readStream.
	self sizeBuffer: self defaultBufferSize! !

!ZnBufferedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/16/2012 16:31'!
upToEnd
	"Read elements until the stream is atEnd and return them as a collection."

	^ self collectionSpecies
		streamContents: [ :out | 
			[ self atEnd ] whileFalse: [ 
				position > limit
					ifTrue: [ self nextBuffer ].	
				out next: limit - position + 1 putAll: buffer startingAt: position.
				position := limit + 1 ] ]! !

!ZnBufferedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/30/2012 20:11'!
next: requestedCount into: collection startingAt: offset
	"Read requestedCount elements into collection starting at offset,
	returning a copy if less elements are available"
	
	| read |
	read := self 
		readInto: collection 
		startingAt: offset 
		count: requestedCount.
	^ read = requestedCount 
		ifTrue: [ collection ]
		ifFalse: [ collection copyFrom: 1 to: offset + read - 1 ]     ! !

!ZnBufferedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/30/2012 22:16'!
readInto: collection startingAt: offset count: requestedCount
	"Read requestedCount elements into collection starting at offset,
	returning the number of elements read, there could be less elements available."

	| read |
	read := 0.
	position <= limit
		ifTrue: [ 
			read := (limit - position + 1) min: requestedCount.
			collection replaceFrom: offset to: offset + read - 1 with: buffer startingAt: position.
			position := position + read.
			read = requestedCount ifTrue: [ ^ requestedCount ] ].
	^ read
		+
			(requestedCount - read < (buffer size / 2)
				ifTrue: [ 
					stream atEnd
						ifTrue: [ 0 ]
						ifFalse: [ 
							self
								nextBuffer;
								readInto: collection startingAt: offset + read count: requestedCount - read ] ]
				ifFalse: [ stream readInto: collection startingAt: offset + read count: requestedCount - read ])! !

!ZnBufferedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/1/2012 20:48'!
peek
	"Return the next element but do not move over it"
	
	position > limit
		ifTrue: [ self nextBuffer ].
	^ position <= limit
		ifTrue: [ buffer at: position ]
		ifFalse: [ nil ]! !

!ZnBufferedReadStream class methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 12/2/2012 19:23'!
on: readStream do: block
	"Execute block with as argument a ZnBufferedReadStream on readStream.
	Return the value of block."

	^ block value: (self on: readStream)! !

!ZnBufferedReadStream class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 11/30/2012 10:57'!
on: readStream
	^ self new
		on: readStream;
		yourself! !

!ZnBufferedReadStreamTests commentStamp: '<historical>'!
I am ZnBufferedReadStreamTests.!
!ZnBufferedReadStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/30/2012 20:49'!
testPeek
	| stream |
	stream := ZnBufferedReadStream on: '0123456789' readStream.
	stream sizeBuffer: 8.
	'0123456789' do: [ :each |
		self deny: stream atEnd.
		self assert: stream peek equals: each.
		self assert: stream next equals: each ].
	self assert: stream atEnd.
	self assert: stream peek isNil.
	self assert: stream next isNil! !

!ZnBufferedReadStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/16/2012 16:24'!
testReadUpTo
	| stream |
	stream := ZnBufferedReadStream on: '0123456789' readStream.
	stream sizeBuffer: 8.
	self assert: (stream upTo: $5) equals: '01234'.
	self assert: stream upToEnd equals: '6789'.
	self assert: stream atEnd! !

!ZnBufferedReadStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/16/2012 16:25'!
testReadUpToEnd
	| stream |
	stream := ZnBufferedReadStream on: '0123456789' readStream.
	stream sizeBuffer: 4.
	stream next: 2.
	self assert: stream upToEnd equals: '23456789'.
	self assert: stream atEnd! !

!ZnBufferedReadStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/30/2012 20:47'!
testBuffering
	| stream |
	stream := ZnBufferedReadStream on: '01234567890123456789' readStream.
	stream sizeBuffer: 8.
	self deny: stream atEnd.
	self assert: (stream next: 10) equals: '0123456789'.
	self deny: stream atEnd.
	self assert: (stream next: 10) equals: '0123456789'.
	self assert: stream atEnd	! !

!ZnBufferedReadStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/30/2012 20:56'!
testReadInto
	| stream buffer count |
	stream := ZnBufferedReadStream on: '0123456789' readStream.
	stream sizeBuffer: 8.
	buffer := String new: 6 withAll: Character space.
	stream skip: 1.
	stream readInto: buffer startingAt: 4 count: 3.
	self assert: buffer equals: '   123'.
	stream readInto: buffer startingAt: 1 count: 3.
	self assert: buffer equals: '456123'.
	count := stream readInto: buffer startingAt: 1 count: 100.
	self assert: count equals: 3.
	self assert: buffer equals: '789123'	 ! !

!ZnBufferedReadStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/30/2012 21:02'!
testReadIntoLarger
	| stream buffer count |
	stream := ZnBufferedReadStream on: '0123456789' readStream.
	stream sizeBuffer: 4.
	buffer := String new: 10.
	count := stream readInto: buffer startingAt: 1 count: 10.
	self assert: count equals: 10.
	self assert: buffer equals: '0123456789'	 ! !

!ZnBufferedWriteStream commentStamp: '<historical>'!
I am ZnBufferedWriteStream.
I wrap a write stream and add buffering.

Make sure to always send me #flush or #close when you're done,
otherwise the last buffer might not yet have been written.
My class side's #on:do: helps to ensure this.

I can wrap both binary or character streams and act accordingly.

Part of Zinc HTTP Components.!
!ZnBufferedWriteStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/18/2013 20:17'!
finish
	self flushBuffer! !

!ZnBufferedWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/8/2010 10:08'!
bufferSize
	^ buffer isNil 
		ifTrue: [ self defaultBufferSize ]
		ifFalse: [ buffer size ]! !

!ZnBufferedWriteStream methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/8/2010 10:15'!
buffer
	buffer isNil 
		ifTrue: [ self sizeBuffer: self defaultBufferSize ].
	^ buffer! !

!ZnBufferedWriteStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 12/7/2010 21:22'!
close
	self flushBuffer.
	stream close! !

!ZnBufferedWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/7/2010 23:42'!
bufferFreeSize
	^ self bufferSize - position! !

!ZnBufferedWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/8/2010 10:16'!
nextPut: object
	self flushBufferIfFull.
	position := position + 1.
	self buffer at: position put: object! !

!ZnBufferedWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/7/2010 21:28'!
sizeBuffer: size
	buffer := (stream isBinary ifTrue: [ ByteArray ] ifFalse: [ String ]) new: size! !

!ZnBufferedWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/30/2012 20:01'!
next: count putAll: collection
	"Write count elements from collection"
	
	self 
		next: count 
		putAll: collection 
		startingAt: 1! !

!ZnBufferedWriteStream methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/7/2010 23:48'!
flushBuffer
	position = 0 ifTrue: [ ^ self ].
	position = self bufferSize
		ifTrue: [
			stream nextPutAll: buffer ]
		ifFalse: [
			(stream respondsTo: #next:putAll:startingAt:)
				ifTrue: [ stream next: position putAll: buffer startingAt: 1 ]
				ifFalse: [ stream nextPutAll: (buffer copyFrom: 1 to: position) ] ].
	position := 0! !

!ZnBufferedWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/7/2010 21:20'!
space
	self nextPut: Character space! !

!ZnBufferedWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/30/2012 22:21'!
print: object
	object printOn: self! !

!ZnBufferedWriteStream methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 12/7/2010 21:19'!
printOn: aStream
	aStream 
		nextPutAll: 'a '; 
		nextPutAll: self class name! !

!ZnBufferedWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/30/2012 21:22'!
defaultBufferSize
	^ 2 raisedToInteger: 16! !

!ZnBufferedWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/7/2010 21:23'!
flush
	self flushBuffer.
	stream flush! !

!ZnBufferedWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/30/2012 20:02'!
nextPutAll: collection
	"Write a collection"
	
	self 
		next: collection size 
		putAll: collection 
		startingAt: 1! !

!ZnBufferedWriteStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 12/7/2010 21:30'!
on: writeStream
	stream := writeStream.
	position := 0! !

!ZnBufferedWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/30/2012 21:20'!
next: count putAll: collection startingAt: offset
	"Write count elements from collection starting at offset."
	
	self flushBufferIfFull.
	count <= self bufferFreeSize
		ifTrue: [
			self buffer replaceFrom: position + 1 to: position + count with: collection startingAt: offset.
			position := position + count ]
		ifFalse: [
			self flushBuffer.
			count > (self bufferSize / 2)
				ifTrue: [ stream next: count putAll: collection startingAt: offset ]
				ifFalse: [ self next: count putAll: collection startingAt: offset ] ]
! !

!ZnBufferedWriteStream methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/7/2010 23:39'!
flushBufferIfFull
	position = self bufferSize 
		ifTrue: [ self flushBuffer ]
! !

!ZnBufferedWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/3/2014 10:04'!
tab
	self nextPut: Character tab! !

!ZnBufferedWriteStream class methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 12/2/2012 19:23'!
on: writeStream do: block
	"Execute block with as argument a ZnBufferedWriteStream on writeStream,
	making sure #flush is called at the end. Return the value of block."
	
	| bufferedWriteStream result |
	bufferedWriteStream := self on: writeStream.
	result := block value: bufferedWriteStream.
	bufferedWriteStream flush.
	^ result! !

!ZnBufferedWriteStream class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 12/7/2010 21:20'!
on: writeStream
	^ self basicNew
		on: writeStream;
		yourself! !

!ZnBufferedWriteStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/8/2010 09:54'!
testWriting
	| string |
	string := String streamContents: [ :stringStream | | bufferedStream |
		bufferedStream := ZnBufferedWriteStream on: stringStream.
		0 to: 9 do: [ :each | bufferedStream nextPut: (Character digitValue: each) ].
		bufferedStream flush ].
	self assert: string = '0123456789'! !

!ZnBufferedWriteStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/8/2010 09:53'!
testWritingOverflow
	| string |
	string := String streamContents: [ :stringStream | | bufferedStream |
		bufferedStream := ZnBufferedWriteStream on: stringStream.
		bufferedStream sizeBuffer: 8.
		0 to: 9 do: [ :each | bufferedStream nextPut: (Character digitValue: each) ].
		bufferedStream nextPutAll: '0123'; nextPutAll: '4567'; nextPutAll: '89'.
		bufferedStream nextPutAll: '0123456789'; nextPutAll: '0123456789'.
		bufferedStream flush ].
	self assert: string = '0123456789012345678901234567890123456789'! !

!ZnBufferedWriteStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/30/2012 21:08'!
testNextPutAllStartingAt
	| string |
	string := String streamContents: [ :stringStream | 
		ZnBufferedWriteStream on: stringStream do: [ : bufferedStream |
			bufferedStream sizeBuffer: 8.
			bufferedStream next: 5 putAll: '--012345--' startingAt: 3.
			bufferedStream next: 5 putAll: '0123456789XX' startingAt: 6. 
			bufferedStream next: 5 putAll: '--012345--' startingAt: 3.
			bufferedStream next: 5 putAll: '0123456789XX' startingAt: 6.] ].
	self assert: string equals: '01234567890123456789'! !

!ZnByteArrayEntity commentStamp: 'SvenVanCaekenberghe 1/18/2011 11:04'!
I am ZnByteArrayEntity, a concrete HTTP Entity based on a ByteArray.
It is used to hold binary (non textual) data.
I am a ZnEntity.

Part of Zinc HTTP Components.!
!ZnByteArrayEntity methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 5/22/2013 10:44'!
hash
	^ super hash bitXor: self bytes hash! !

!ZnByteArrayEntity methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 5/22/2013 10:45'!
= other
	^ super = other and: [ self bytes = other bytes ]! !

!ZnByteArrayEntity methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 9/17/2012 15:00'!
readFrom: stream
	self contentLength isNil
		ifTrue: [ 
			self bytes: (ZnUtils readUpToEnd: stream limit: ZnConstants maximumEntitySize).
			self contentLength: self bytes size ]
		ifFalse: [ | byteArray |
			self contentLength > ZnConstants maximumEntitySize
				ifTrue: [ ZnEntityTooLarge signal ].
			byteArray := ByteArray ofSize: self contentLength.
			self contentLength > ZnUtils streamingBufferSize 
				ifTrue: [
					ZnUtils streamFrom: stream to: byteArray writeStream size: self contentLength ]
				ifFalse: [
					stream next: self contentLength into: byteArray ]. 
			self bytes: byteArray ]! !

!ZnByteArrayEntity methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/1/2011 17:53'!
isEmpty 
	^ self bytes isNil or: [ self bytes isEmpty ]! !

!ZnByteArrayEntity methodsFor: 'writing' stamp: 'SvenVanCaekenberghe 5/18/2013 19:54'!
writeOn: stream
	ZnUtils nextPutAll: self bytes on: stream! !

!ZnByteArrayEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/7/2010 15:12'!
bytes: anObject
	bytes := anObject! !

!ZnByteArrayEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/7/2010 15:12'!
bytes
	^ bytes! !

!ZnByteArrayEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/7/2010 19:27'!
readStream
	^ self bytes readStream! !

!ZnByteArrayEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/13/2010 22:05'!
contents
	^ self bytes! !

!ZnByteArrayEntity methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 12/14/2010 11:20'!
printContentsOn: stream
	super printContentsOn: stream.
	self bytes notNil ifTrue: [ 
		stream space; print: self bytes ]! !

!ZnByteArrayEntity class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/12/2010 11:13'!
bytes: byteArray
	^ (self type: ZnMimeType applicationOctetStream length: byteArray size)
		bytes: byteArray;
		yourself ! !

!ZnByteArrayEntity class methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/4/2013 14:43'!
matches: mimeType
	"I have no designated mime type, I can handle all binary content.
	See #concreteSubclassForType: "
	
	^ false! !

!ZnByteArrayEntity class methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/11/2010 17:22'!
designatedMimeType
	"I have no designated mime type, I can handle all binary content.
	See #concreteSubclassForType: "
	
	^ nil! !

!ZnByteEncoder commentStamp: 'SvenVanCaekenberghe 9/13/2014 22:45'!
I am ZnByteEncoder, a concrete subclass of ZnCharacterEncoder.
I handle single byte encodings where byte values 0 to 127 map to ASCII and 128 to 255 are a permutation to Unicode characters.

I derive my mappings by parsing official unicode.org specifications.

The list of encodings and their names/aliases was taken from http://encoding.spec.whatwg.org/#legacy-single-byte-encodings

I basically support ISO/IEC 8859 1, 2, 3, 4, 5, 6, 7, 8, 10, 13, 14, 15 and 16, Windows Codepages 866, 874, 1250, 1251, 1252, 1253, 1253, 1254, 1255, 1256, 1257, 1258, KOI8 R & U as well as Mac Roman & Cyrillic - each of these with a number of aliases like latin1, latin2, latin3, latin4, latin5, latin6, cyrillic, arabic, greek and hebrew. See #mappingToIdentifiers

Note that most/all of these encodings should be considered legacy, with UTF-8 being the preferred encoding going forward.  

Part of Zinc HTTP Components.!
!ZnByteEncoder methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 1/25/2011 12:31'!
unicodeToByte: map
	unicodeToByte := map! !

!ZnByteEncoder methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/15/2014 10:53'!
byteDomain
	"Return an array with the byte values that are in my domain, that I can decode"
	
	^ (0 to: 127) asArray , ((byteToUnicode withIndexCollect: [ :each :index | each ifNotNil: [ index + 127 ] ]) reject: [ :each | each isNil ]) ! !

!ZnByteEncoder methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/15/2014 09:46'!
identifier
	^ identifier! !

!ZnByteEncoder methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/15/2014 10:02'!
isLenient
	^ strict not! !

!ZnByteEncoder methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 12/17/2012 15:40'!
beLenient
	"Don't be strict, which is the default.
	This means that holes in the mapping are let to pass through."

	strict := false! !

!ZnByteEncoder methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/15/2014 10:06'!
characterDomain
	"Return a set with the characters that are in my domain, that I can encode"

	^ ((0 to: 127) asSet, unicodeToByte keys) collect: [ :each | Character value: each  ]! !

!ZnByteEncoder methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/15/2014 10:02'!
isStrict
	^ strict! !

!ZnByteEncoder methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 9/15/2014 11:55'!
decodeBytesIntoWideString: bytes
	"Variant of #decodeBytes: that is faster when you know upfront 
	that a WideString is probably needed"

	| byteStream |
	byteStream := bytes readStream.
	^ WideString streamContents: [ :stream |
		[ byteStream atEnd ] whileFalse: [
			stream nextPut: (self nextFromStream: byteStream) ] ] ! !

!ZnByteEncoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 2/24/2014 15:37'!
backOnStream: stream
	stream back! !

!ZnByteEncoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 11/8/2013 10:44'!
nextFromStream: stream
	"In non-strict mode, we let byte values for holes in our mapping pass through"

	| byteValue |
	^ (byteValue := stream next) < 128
		ifTrue: [ Character value: byteValue ]
		ifFalse: [ 
			(byteToUnicode at: byteValue - 127 ifAbsent: [ nil ])
				ifNotNil: [ :unicode | unicode ]
				ifNil: [ 
					strict
						ifTrue: [ self errorOutsideRange ]
						ifFalse: [ Character value: byteValue ] ] ]! !

!ZnByteEncoder methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 12/17/2012 14:46'!
initialize
	super initialize.
	strict := true! !

!ZnByteEncoder methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 12/15/2012 21:51'!
identifier: object
	identifier := object! !

!ZnByteEncoder methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 1/15/2013 16:58'!
printOn: stream
	super printOn: stream.
	stream
		nextPut: $(;
		print: identifier.
	strict
		ifTrue: [ stream nextPutAll: ' strict' ].
	stream nextPut: $)! !

!ZnByteEncoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 11/8/2013 10:44'!
nextPut: character toStream: stream
	"In non-strict mode, we let characters for holes in our mapping table pass through"
	
	| code |
	(code := character codePoint) < 128
		ifTrue: [ stream nextPut: code ]
		ifFalse: [ 
			| byte |
			byte := unicodeToByte at: code ifAbsent: [ nil ].
			(byte isNil and: [ strict or: [ code > 255 ] ])
				ifTrue: [ self errorOutsideRange ].
			stream nextPut: (byte ifNil: [ code ]) ]! !

!ZnByteEncoder methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 1/25/2011 12:31'!
byteToUnicode: map
	byteToUnicode := map! !

!ZnByteEncoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 1/25/2011 12:19'!
encodedByteCountFor: character
	^ 1! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 9/13/2014 21:07'!
iso88598Mapping
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/ISO8859/8859-8.TXT'"

	^ #(
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	16r00A0 nil 16r00A2 16r00A3 16r00A4 16r00A5 16r00A6 16r00A7 
	16r00A8 16r00A9 16r00D7 16r00AB 16r00AC 16r00AD 16r00AE 16r00AF 
	16r00B0 16r00B1 16r00B2 16r00B3 16r00B4 16r00B5 16r00B6 16r00B7 
	16r00B8 16r00B9 16r00F7 16r00BB 16r00BC 16r00BD 16r00BE nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil 16r2017 
	16r05D0 16r05D1 16r05D2 16r05D3 16r05D4 16r05D5 16r05D6 16r05D7 
	16r05D8 16r05D9 16r05DA 16r05DB 16r05DC 16r05DD 16r05DE 16r05DF 
	16r05E0 16r05E1 16r05E2 16r05E3 16r05E4 16r05E5 16r05E6 16r05E7 
	16r05E8 16r05E9 16r05EA nil nil 16r200E 16r200F nil )! !

!ZnByteEncoder class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/13/2014 22:11'!
handlesEncoding: string
	"Return true when my instances handle the encoding described by string"
	
	^ ByteTextConverters includesKey: (self canonicalEncodingIdentifier: string)! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 9/13/2014 21:09'!
iso885916Mapping
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/ISO8859/8859-16.TXT'"

	^ #(
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	16r00A0 16r0104 16r0105 16r0141 16r20AC 16r201E 16r0160 16r00A7 
	16r0161 16r00A9 16r0218 16r00AB 16r0179 16r00AD 16r017A 16r017B 
	16r00B0 16r00B1 16r010C 16r0142 16r017D 16r201D 16r00B6 16r00B7 
	16r017E 16r010D 16r0219 16r00BB 16r0152 16r0153 16r0178 16r017C 
	16r00C0 16r00C1 16r00C2 16r0102 16r00C4 16r0106 16r00C6 16r00C7 
	16r00C8 16r00C9 16r00CA 16r00CB 16r00CC 16r00CD 16r00CE 16r00CF 
	16r0110 16r0143 16r00D2 16r00D3 16r00D4 16r0150 16r00D6 16r015A 
	16r0170 16r00D9 16r00DA 16r00DB 16r00DC 16r0118 16r021A 16r00DF 
	16r00E0 16r00E1 16r00E2 16r0103 16r00E4 16r0107 16r00E6 16r00E7 
	16r00E8 16r00E9 16r00EA 16r00EB 16r00EC 16r00ED 16r00EE 16r00EF 
	16r0111 16r0144 16r00F2 16r00F3 16r00F4 16r0151 16r00F6 16r015B 
	16r0171 16r00F9 16r00FA 16r00FB 16r00FC 16r0119 16r021B 16r00FF )! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 9/13/2014 21:09'!
iso885914Mapping
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/ISO8859/8859-14.TXT'"

	^ #(
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	16r00A0 16r1E02 16r1E03 16r00A3 16r010A 16r010B 16r1E0A 16r00A7 
	16r1E80 16r00A9 16r1E82 16r1E0B 16r1EF2 16r00AD 16r00AE 16r0178 
	16r1E1E 16r1E1F 16r0120 16r0121 16r1E40 16r1E41 16r00B6 16r1E56 
	16r1E81 16r1E57 16r1E83 16r1E60 16r1EF3 16r1E84 16r1E85 16r1E61 
	16r00C0 16r00C1 16r00C2 16r00C3 16r00C4 16r00C5 16r00C6 16r00C7 
	16r00C8 16r00C9 16r00CA 16r00CB 16r00CC 16r00CD 16r00CE 16r00CF 
	16r0174 16r00D1 16r00D2 16r00D3 16r00D4 16r00D5 16r00D6 16r1E6A 
	16r00D8 16r00D9 16r00DA 16r00DB 16r00DC 16r00DD 16r0176 16r00DF 
	16r00E0 16r00E1 16r00E2 16r00E3 16r00E4 16r00E5 16r00E6 16r00E7 
	16r00E8 16r00E9 16r00EA 16r00EB 16r00EC 16r00ED 16r00EE 16r00EF 
	16r0175 16r00F1 16r00F2 16r00F3 16r00F4 16r00F5 16r00F6 16r1E6B 
	16r00F8 16r00F9 16r00FA 16r00FB 16r00FC 16r00FD 16r0177 16r00FF )! !

!ZnByteEncoder class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/15/2012 20:02'!
generateByteToUnicodeSpec: url
	"Return the formatted source code for an array mapping 
	the top 128 byte to unicode values from a Unicode.org url"
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/ISO8859/8859-2.TXT'."

	| mapping |
	mapping := self parseUnicodeOrgSpec: url.  
	^ String streamContents: [ :stream |
		stream tab; << '"'; << 'self generateByteToUnicodeSpec: '; print: url; << '"'; cr; cr; tab; << '^ #('.
		128 to: 255 do: [ :each | | unicode |
			each \\ 8 = 0 ifTrue: [ stream cr; tab ].
			(unicode := mapping at: each ifAbsent: [ nil ]) isNil
				ifTrue: [ stream print: nil; space ]  
				ifFalse: [ stream << '16r' << (unicode printPaddedWith: $0 to: 4 base: 16); space ] ].
		stream nextPut: $); cr ]! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 12/15/2012 19:35'!
cp1253Mapping
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1253.TXT'"

	^ #(
	16r20AC nil 16r201A 16r0192 16r201E 16r2026 16r2020 16r2021 
	nil 16r2030 nil 16r2039 nil nil nil nil 
	nil 16r2018 16r2019 16r201C 16r201D 16r2022 16r2013 16r2014 
	nil 16r2122 nil 16r203A nil nil nil nil 
	16r00A0 16r0385 16r0386 16r00A3 16r00A4 16r00A5 16r00A6 16r00A7 
	16r00A8 16r00A9 nil 16r00AB 16r00AC 16r00AD 16r00AE 16r2015 
	16r00B0 16r00B1 16r00B2 16r00B3 16r0384 16r00B5 16r00B6 16r00B7 
	16r0388 16r0389 16r038A 16r00BB 16r038C 16r00BD 16r038E 16r038F 
	16r0390 16r0391 16r0392 16r0393 16r0394 16r0395 16r0396 16r0397 
	16r0398 16r0399 16r039A 16r039B 16r039C 16r039D 16r039E 16r039F 
	16r03A0 16r03A1 nil 16r03A3 16r03A4 16r03A5 16r03A6 16r03A7 
	16r03A8 16r03A9 16r03AA 16r03AB 16r03AC 16r03AD 16r03AE 16r03AF 
	16r03B0 16r03B1 16r03B2 16r03B3 16r03B4 16r03B5 16r03B6 16r03B7 
	16r03B8 16r03B9 16r03BA 16r03BB 16r03BC 16r03BD 16r03BE 16r03BF 
	16r03C0 16r03C1 16r03C2 16r03C3 16r03C4 16r03C5 16r03C6 16r03C7 
	16r03C8 16r03C9 16r03CA 16r03CB 16r03CC 16r03CD 16r03CE nil )! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 12/15/2012 19:36'!
iso88591Mapping
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/ISO8859/8859-1.TXT'"

	^ #(
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	16r00A0 16r00A1 16r00A2 16r00A3 16r00A4 16r00A5 16r00A6 16r00A7 
	16r00A8 16r00A9 16r00AA 16r00AB 16r00AC 16r00AD 16r00AE 16r00AF 
	16r00B0 16r00B1 16r00B2 16r00B3 16r00B4 16r00B5 16r00B6 16r00B7 
	16r00B8 16r00B9 16r00BA 16r00BB 16r00BC 16r00BD 16r00BE 16r00BF 
	16r00C0 16r00C1 16r00C2 16r00C3 16r00C4 16r00C5 16r00C6 16r00C7 
	16r00C8 16r00C9 16r00CA 16r00CB 16r00CC 16r00CD 16r00CE 16r00CF 
	16r00D0 16r00D1 16r00D2 16r00D3 16r00D4 16r00D5 16r00D6 16r00D7 
	16r00D8 16r00D9 16r00DA 16r00DB 16r00DC 16r00DD 16r00DE 16r00DF 
	16r00E0 16r00E1 16r00E2 16r00E3 16r00E4 16r00E5 16r00E6 16r00E7 
	16r00E8 16r00E9 16r00EA 16r00EB 16r00EC 16r00ED 16r00EE 16r00EF 
	16r00F0 16r00F1 16r00F2 16r00F3 16r00F4 16r00F5 16r00F6 16r00F7 
	16r00F8 16r00F9 16r00FA 16r00FB 16r00FC 16r00FD 16r00FE 16r00FF )! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 9/13/2014 22:37'!
mappingToIdentifiers
	"Return a dictionay mapping from encoding specifications to a list of encoding names."
	
	^ Dictionary newFromPairs: #(
		#iso88591Mapping #('iso88591' 'latin1') 
		#iso88592Mapping #('iso88592' 'latin2') 
		#iso88593Mapping #('iso88593' 'latin3') 
		#iso88594Mapping #('iso88594' 'latin4') 
		#iso88595Mapping #('iso88595' 'cyrillic') 
		#iso88596Mapping #('iso88596' 'arabic') 
		#iso88597Mapping #('iso88597' 'greek') 
		#iso88598Mapping #('iso88598' 'hebrew') 
		#iso885910Mapping #('iso885910' 'latin6') 
		#iso885913Mapping #('iso885913') 
		#iso885914Mapping #('iso885914') 
		#iso885915Mapping #('iso885915') 
		#iso885916Mapping #('iso885916') 
		#cp1250Mapping #('cp1250' 'windows1250' 'xcp1250') 
		#cp1251Mapping #('cp1251' 'windows1251' 'xcp1251') 
		#cp1252Mapping #('cp1252' 'windows1252' 'xcp1252' 'ibm819')
		#cp1253Mapping #('cp1253' 'windows1253' 'xcp1253')
		#cp1254Mapping #('cp1254' 'windows1254' 'xcp1254' 'iso88599' 'latin5')
		#cp1255Mapping #('cp1255' 'windows1255' 'xcp1255')
		#cp1256Mapping #('cp1256' 'windows1256' 'xcp1256')
		#cp1257Mapping #('cp1257' 'windows1257' 'xcp1257')
		#cp1258Mapping #('cp1258' 'windows1258' 'xcp1258')
		#cp866Mapping #('cp866' 'ibm866')
		#cp874Mapping #('cp874' 'iso885911' 'windows874' 'dos874')
		#koi8rMapping #('koi8r' 'koi8')
		#koi8uMapping #('koi8u')
		#macRomanMapping #('macroman' 'xmacroman' 'mac' 'macintosh')
		#macCyrillicMapping #('maccyrillic' 'xmaccyrillic') )! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 9/13/2014 21:31'!
cp866Mapping
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/PC/CP866.TXT'"

	^ #(
	16r0410 16r0411 16r0412 16r0413 16r0414 16r0415 16r0416 16r0417 
	16r0418 16r0419 16r041A 16r041B 16r041C 16r041D 16r041E 16r041F 
	16r0420 16r0421 16r0422 16r0423 16r0424 16r0425 16r0426 16r0427 
	16r0428 16r0429 16r042A 16r042B 16r042C 16r042D 16r042E 16r042F 
	16r0430 16r0431 16r0432 16r0433 16r0434 16r0435 16r0436 16r0437 
	16r0438 16r0439 16r043A 16r043B 16r043C 16r043D 16r043E 16r043F 
	16r2591 16r2592 16r2593 16r2502 16r2524 16r2561 16r2562 16r2556 
	16r2555 16r2563 16r2551 16r2557 16r255D 16r255C 16r255B 16r2510 
	16r2514 16r2534 16r252C 16r251C 16r2500 16r253C 16r255E 16r255F 
	16r255A 16r2554 16r2569 16r2566 16r2560 16r2550 16r256C 16r2567 
	16r2568 16r2564 16r2565 16r2559 16r2558 16r2552 16r2553 16r256B 
	16r256A 16r2518 16r250C 16r2588 16r2584 16r258C 16r2590 16r2580 
	16r0440 16r0441 16r0442 16r0443 16r0444 16r0445 16r0446 16r0447 
	16r0448 16r0449 16r044A 16r044B 16r044C 16r044D 16r044E 16r044F 
	16r0401 16r0451 16r0404 16r0454 16r0407 16r0457 16r040E 16r045E 
	16r00B0 16r2219 16r00B7 16r221A 16r2116 16r00A4 16r25A0 16r00A0 )! !

!ZnByteEncoder class methodsFor: 'class initialization' stamp: 'SvenVanCaekenberghe 9/13/2014 22:29'!
initialize
	"Initialize and cache the converters that I know of.
	This includes all of their aliases.
	This method must be changed to make sure it runs 
	when loading in images where it is already present."
	
	self initializeByteTextConverters! !

!ZnByteEncoder class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/15/2014 10:11'!
knownEncodingIdentifiers
	^ ByteTextConverters keys! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 12/15/2012 19:36'!
iso88592Mapping
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/ISO8859/8859-2.TXT'"

	^ #(
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	16r00A0 16r0104 16r02D8 16r0141 16r00A4 16r013D 16r015A 16r00A7 
	16r00A8 16r0160 16r015E 16r0164 16r0179 16r00AD 16r017D 16r017B 
	16r00B0 16r0105 16r02DB 16r0142 16r00B4 16r013E 16r015B 16r02C7 
	16r00B8 16r0161 16r015F 16r0165 16r017A 16r02DD 16r017E 16r017C 
	16r0154 16r00C1 16r00C2 16r0102 16r00C4 16r0139 16r0106 16r00C7 
	16r010C 16r00C9 16r0118 16r00CB 16r011A 16r00CD 16r00CE 16r010E 
	16r0110 16r0143 16r0147 16r00D3 16r00D4 16r0150 16r00D6 16r00D7 
	16r0158 16r016E 16r00DA 16r0170 16r00DC 16r00DD 16r0162 16r00DF 
	16r0155 16r00E1 16r00E2 16r0103 16r00E4 16r013A 16r0107 16r00E7 
	16r010D 16r00E9 16r0119 16r00EB 16r011B 16r00ED 16r00EE 16r010F 
	16r0111 16r0144 16r0148 16r00F3 16r00F4 16r0151 16r00F6 16r00F7 
	16r0159 16r016F 16r00FA 16r0171 16r00FC 16r00FD 16r0163 16r02D9 )! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 9/13/2014 21:05'!
iso88596Mapping
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/ISO8859/8859-6.TXT'"

	^ #(
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	16r00A0 nil nil nil 16r00A4 nil nil nil 
	nil nil nil nil 16r060C 16r00AD nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil 16r061B nil nil nil 16r061F 
	nil 16r0621 16r0622 16r0623 16r0624 16r0625 16r0626 16r0627 
	16r0628 16r0629 16r062A 16r062B 16r062C 16r062D 16r062E 16r062F 
	16r0630 16r0631 16r0632 16r0633 16r0634 16r0635 16r0636 16r0637 
	16r0638 16r0639 16r063A nil nil nil nil nil 
	16r0640 16r0641 16r0642 16r0643 16r0644 16r0645 16r0646 16r0647 
	16r0648 16r0649 16r064A 16r064B 16r064C 16r064D 16r064E 16r064F 
	16r0650 16r0651 16r0652 nil nil nil nil nil 
	nil nil nil nil nil nil nil nil )! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 9/13/2014 21:08'!
iso885913Mapping
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/ISO8859/8859-13.TXT'"

	^ #(
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	16r00A0 16r201D 16r00A2 16r00A3 16r00A4 16r201E 16r00A6 16r00A7 
	16r00D8 16r00A9 16r0156 16r00AB 16r00AC 16r00AD 16r00AE 16r00C6 
	16r00B0 16r00B1 16r00B2 16r00B3 16r201C 16r00B5 16r00B6 16r00B7 
	16r00F8 16r00B9 16r0157 16r00BB 16r00BC 16r00BD 16r00BE 16r00E6 
	16r0104 16r012E 16r0100 16r0106 16r00C4 16r00C5 16r0118 16r0112 
	16r010C 16r00C9 16r0179 16r0116 16r0122 16r0136 16r012A 16r013B 
	16r0160 16r0143 16r0145 16r00D3 16r014C 16r00D5 16r00D6 16r00D7 
	16r0172 16r0141 16r015A 16r016A 16r00DC 16r017B 16r017D 16r00DF 
	16r0105 16r012F 16r0101 16r0107 16r00E4 16r00E5 16r0119 16r0113 
	16r010D 16r00E9 16r017A 16r0117 16r0123 16r0137 16r012B 16r013C 
	16r0161 16r0144 16r0146 16r00F3 16r014D 16r00F5 16r00F6 16r00F7 
	16r0173 16r0142 16r015B 16r016B 16r00FC 16r017C 16r017E 16r2019 )! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 12/15/2012 19:39'!
cp1252Mapping
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1252.TXT'"

	^ #(
	16r20AC nil 16r201A 16r0192 16r201E 16r2026 16r2020 16r2021 
	16r02C6 16r2030 16r0160 16r2039 16r0152 nil 16r017D nil 
	nil 16r2018 16r2019 16r201C 16r201D 16r2022 16r2013 16r2014 
	16r02DC 16r2122 16r0161 16r203A 16r0153 nil 16r017E 16r0178 
	16r00A0 16r00A1 16r00A2 16r00A3 16r00A4 16r00A5 16r00A6 16r00A7 
	16r00A8 16r00A9 16r00AA 16r00AB 16r00AC 16r00AD 16r00AE 16r00AF 
	16r00B0 16r00B1 16r00B2 16r00B3 16r00B4 16r00B5 16r00B6 16r00B7 
	16r00B8 16r00B9 16r00BA 16r00BB 16r00BC 16r00BD 16r00BE 16r00BF 
	16r00C0 16r00C1 16r00C2 16r00C3 16r00C4 16r00C5 16r00C6 16r00C7 
	16r00C8 16r00C9 16r00CA 16r00CB 16r00CC 16r00CD 16r00CE 16r00CF 
	16r00D0 16r00D1 16r00D2 16r00D3 16r00D4 16r00D5 16r00D6 16r00D7 
	16r00D8 16r00D9 16r00DA 16r00DB 16r00DC 16r00DD 16r00DE 16r00DF 
	16r00E0 16r00E1 16r00E2 16r00E3 16r00E4 16r00E5 16r00E6 16r00E7 
	16r00E8 16r00E9 16r00EA 16r00EB 16r00EC 16r00ED 16r00EE 16r00EF 
	16r00F0 16r00F1 16r00F2 16r00F3 16r00F4 16r00F5 16r00F6 16r00F7 
	16r00F8 16r00F9 16r00FA 16r00FB 16r00FC 16r00FD 16r00FE 16r00FF )! !

!ZnByteEncoder class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/13/2014 22:12'!
newForEncoding: string
	"Return a new character encoder object for an encoding described by string.
	We use our precomputed ByteTextConverters tables."

	| tables |
	tables := ByteTextConverters at: (self canonicalEncodingIdentifier: string).
	^ self new
		identifier: string;
		byteToUnicode: tables first;
		unicodeToByte: tables second;
		yourself! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 9/13/2014 21:14'!
koi8uMapping
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/VENDORS/MISC/KOI8-U.TXT'"

	^ #(
	16r2500 16r2502 16r250C 16r2510 16r2514 16r2518 16r251C 16r2524 
	16r252C 16r2534 16r253C 16r2580 16r2584 16r2588 16r258C 16r2590 
	16r2591 16r2592 16r2593 16r2320 16r25A0 16r2219 16r221A 16r2248 
	16r2264 16r2265 16r00A0 16r2321 16r00B0 16r00B2 16r00B7 16r00F7 
	16r2550 16r2551 16r2552 16r0451 16r0454 16r2554 16r0456 16r0457 
	16r2557 16r2558 16r2559 16r255A 16r255B 16r0491 16r255D 16r255E 
	16r255F 16r2560 16r2561 16r0401 16r0404 16r2563 16r0406 16r0407 
	16r2566 16r2567 16r2568 16r2569 16r256A 16r0490 16r256C 16r00A9 
	16r044E 16r0430 16r0431 16r0446 16r0434 16r0435 16r0444 16r0433 
	16r0445 16r0438 16r0439 16r043A 16r043B 16r043C 16r043D 16r043E 
	16r043F 16r044F 16r0440 16r0441 16r0442 16r0443 16r0436 16r0432 
	16r044C 16r044B 16r0437 16r0448 16r044D 16r0449 16r0447 16r044A 
	16r042E 16r0410 16r0411 16r0426 16r0414 16r0415 16r0424 16r0413 
	16r0425 16r0418 16r0419 16r041A 16r041B 16r041C 16r041D 16r041E 
	16r041F 16r042F 16r0420 16r0421 16r0422 16r0423 16r0416 16r0412 
	16r042C 16r042B 16r0417 16r0428 16r042D 16r0429 16r0427 16r042A )! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 9/13/2014 21:11'!
cp1255Mapping
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1255.TXT'"

	^ #(
	16r20AC nil 16r201A 16r0192 16r201E 16r2026 16r2020 16r2021 
	16r02C6 16r2030 nil 16r2039 nil nil nil nil 
	nil 16r2018 16r2019 16r201C 16r201D 16r2022 16r2013 16r2014 
	16r02DC 16r2122 nil 16r203A nil nil nil nil 
	16r00A0 16r00A1 16r00A2 16r00A3 16r20AA 16r00A5 16r00A6 16r00A7 
	16r00A8 16r00A9 16r00D7 16r00AB 16r00AC 16r00AD 16r00AE 16r00AF 
	16r00B0 16r00B1 16r00B2 16r00B3 16r00B4 16r00B5 16r00B6 16r00B7 
	16r00B8 16r00B9 16r00F7 16r00BB 16r00BC 16r00BD 16r00BE 16r00BF 
	16r05B0 16r05B1 16r05B2 16r05B3 16r05B4 16r05B5 16r05B6 16r05B7 
	16r05B8 16r05B9 nil 16r05BB 16r05BC 16r05BD 16r05BE 16r05BF 
	16r05C0 16r05C1 16r05C2 16r05C3 16r05F0 16r05F1 16r05F2 16r05F3 
	16r05F4 nil nil nil nil nil nil nil 
	16r05D0 16r05D1 16r05D2 16r05D3 16r05D4 16r05D5 16r05D6 16r05D7 
	16r05D8 16r05D9 16r05DA 16r05DB 16r05DC 16r05DD 16r05DE 16r05DF 
	16r05E0 16r05E1 16r05E2 16r05E3 16r05E4 16r05E5 16r05E6 16r05E7 
	16r05E8 16r05E9 16r05EA nil nil 16r200E 16r200F nil )! !

!ZnByteEncoder class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/13/2014 21:30'!
parseUnicodeOrgSpec: url
	"Parse and return a mapping from byte to unicode values from url."
	"self parseUnicodeOrgSpec: 'http://unicode.org/Public/MAPPINGS/ISO8859/8859-2.TXT'."
	
	| mapping |
	mapping := Dictionary new: 256.
	url asZnUrl retrieveContents linesDo: [ :each |
		(each isEmpty or: [ each beginsWith: '#' ])
			ifFalse: [ | tokens hexReader |
				hexReader := [ :string | Integer readFrom: (string readStream skip: 2; yourself) base: 16 ].
				tokens := each findTokens: String tab. 
				(tokens size < 3 or: [ tokens last = '<control>' or: [ tokens last = '#UNDEFINED' ] ]) ifFalse: [
					mapping
						at: (hexReader value: tokens first)
						put: (hexReader value: tokens second) ] ] ].
	^ mapping ! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 9/13/2014 21:12'!
cp1258Mapping
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1258.TXT'"

	^ #(
	16r20AC nil 16r201A 16r0192 16r201E 16r2026 16r2020 16r2021 
	16r02C6 16r2030 nil 16r2039 16r0152 nil nil nil 
	nil 16r2018 16r2019 16r201C 16r201D 16r2022 16r2013 16r2014 
	16r02DC 16r2122 nil 16r203A 16r0153 nil nil 16r0178 
	16r00A0 16r00A1 16r00A2 16r00A3 16r00A4 16r00A5 16r00A6 16r00A7 
	16r00A8 16r00A9 16r00AA 16r00AB 16r00AC 16r00AD 16r00AE 16r00AF 
	16r00B0 16r00B1 16r00B2 16r00B3 16r00B4 16r00B5 16r00B6 16r00B7 
	16r00B8 16r00B9 16r00BA 16r00BB 16r00BC 16r00BD 16r00BE 16r00BF 
	16r00C0 16r00C1 16r00C2 16r0102 16r00C4 16r00C5 16r00C6 16r00C7 
	16r00C8 16r00C9 16r00CA 16r00CB 16r0300 16r00CD 16r00CE 16r00CF 
	16r0110 16r00D1 16r0309 16r00D3 16r00D4 16r01A0 16r00D6 16r00D7 
	16r00D8 16r00D9 16r00DA 16r00DB 16r00DC 16r01AF 16r0303 16r00DF 
	16r00E0 16r00E1 16r00E2 16r0103 16r00E4 16r00E5 16r00E6 16r00E7 
	16r00E8 16r00E9 16r00EA 16r00EB 16r0301 16r00ED 16r00EE 16r00EF 
	16r0111 16r00F1 16r0323 16r00F3 16r00F4 16r01A1 16r00F6 16r00F7 
	16r00F8 16r00F9 16r00FA 16r00FB 16r00FC 16r01B0 16r20AB 16r00FF )! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 9/13/2014 21:12'!
cp1257Mapping
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1257.TXT'"

	^ #(
	16r20AC nil 16r201A nil 16r201E 16r2026 16r2020 16r2021 
	nil 16r2030 nil 16r2039 nil 16r00A8 16r02C7 16r00B8 
	nil 16r2018 16r2019 16r201C 16r201D 16r2022 16r2013 16r2014 
	nil 16r2122 nil 16r203A nil 16r00AF 16r02DB nil 
	16r00A0 nil 16r00A2 16r00A3 16r00A4 nil 16r00A6 16r00A7 
	16r00D8 16r00A9 16r0156 16r00AB 16r00AC 16r00AD 16r00AE 16r00C6 
	16r00B0 16r00B1 16r00B2 16r00B3 16r00B4 16r00B5 16r00B6 16r00B7 
	16r00F8 16r00B9 16r0157 16r00BB 16r00BC 16r00BD 16r00BE 16r00E6 
	16r0104 16r012E 16r0100 16r0106 16r00C4 16r00C5 16r0118 16r0112 
	16r010C 16r00C9 16r0179 16r0116 16r0122 16r0136 16r012A 16r013B 
	16r0160 16r0143 16r0145 16r00D3 16r014C 16r00D5 16r00D6 16r00D7 
	16r0172 16r0141 16r015A 16r016A 16r00DC 16r017B 16r017D 16r00DF 
	16r0105 16r012F 16r0101 16r0107 16r00E4 16r00E5 16r0119 16r0113 
	16r010D 16r00E9 16r017A 16r0117 16r0123 16r0137 16r012B 16r013C 
	16r0161 16r0144 16r0146 16r00F3 16r014D 16r00F5 16r00F6 16r00F7 
	16r0173 16r0142 16r015B 16r016B 16r00FC 16r017C 16r017E 16r02D9 )! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 9/13/2014 21:12'!
cp1256Mapping
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1256.TXT'"

	^ #(
	16r20AC 16r067E 16r201A 16r0192 16r201E 16r2026 16r2020 16r2021 
	16r02C6 16r2030 16r0679 16r2039 16r0152 16r0686 16r0698 16r0688 
	16r06AF 16r2018 16r2019 16r201C 16r201D 16r2022 16r2013 16r2014 
	16r06A9 16r2122 16r0691 16r203A 16r0153 16r200C 16r200D 16r06BA 
	16r00A0 16r060C 16r00A2 16r00A3 16r00A4 16r00A5 16r00A6 16r00A7 
	16r00A8 16r00A9 16r06BE 16r00AB 16r00AC 16r00AD 16r00AE 16r00AF 
	16r00B0 16r00B1 16r00B2 16r00B3 16r00B4 16r00B5 16r00B6 16r00B7 
	16r00B8 16r00B9 16r061B 16r00BB 16r00BC 16r00BD 16r00BE 16r061F 
	16r06C1 16r0621 16r0622 16r0623 16r0624 16r0625 16r0626 16r0627 
	16r0628 16r0629 16r062A 16r062B 16r062C 16r062D 16r062E 16r062F 
	16r0630 16r0631 16r0632 16r0633 16r0634 16r0635 16r0636 16r00D7 
	16r0637 16r0638 16r0639 16r063A 16r0640 16r0641 16r0642 16r0643 
	16r00E0 16r0644 16r00E2 16r0645 16r0646 16r0647 16r0648 16r00E7 
	16r00E8 16r00E9 16r00EA 16r00EB 16r0649 16r064A 16r00EE 16r00EF 
	16r064B 16r064C 16r064D 16r064E 16r00F4 16r064F 16r0650 16r00F7 
	16r0651 16r00F9 16r0652 16r00FB 16r00FC 16r200E 16r200F 16r06D2 )! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 12/15/2012 19:38'!
macRomanMapping
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/VENDORS/APPLE/ROMAN.TXT'"

	^ #(
	16r00C4 16r00C5 16r00C7 16r00C9 16r00D1 16r00D6 16r00DC 16r00E1 
	16r00E0 16r00E2 16r00E4 16r00E3 16r00E5 16r00E7 16r00E9 16r00E8 
	16r00EA 16r00EB 16r00ED 16r00EC 16r00EE 16r00EF 16r00F1 16r00F3 
	16r00F2 16r00F4 16r00F6 16r00F5 16r00FA 16r00F9 16r00FB 16r00FC 
	16r2020 16r00B0 16r00A2 16r00A3 16r00A7 16r2022 16r00B6 16r00DF 
	16r00AE 16r00A9 16r2122 16r00B4 16r00A8 16r2260 16r00C6 16r00D8 
	16r221E 16r00B1 16r2264 16r2265 16r00A5 16r00B5 16r2202 16r2211 
	16r220F 16r03C0 16r222B 16r00AA 16r00BA 16r03A9 16r00E6 16r00F8 
	16r00BF 16r00A1 16r00AC 16r221A 16r0192 16r2248 16r2206 16r00AB 
	16r00BB 16r2026 16r00A0 16r00C0 16r00C3 16r00D5 16r0152 16r0153 
	16r2013 16r2014 16r201C 16r201D 16r2018 16r2019 16r00F7 16r25CA 
	16r00FF 16r0178 16r2044 16r20AC 16r2039 16r203A 16rFB01 16rFB02 
	16r2021 16r00B7 16r201A 16r201E 16r2030 16r00C2 16r00CA 16r00C1 
	16r00CB 16r00C8 16r00CD 16r00CE 16r00CF 16r00CC 16r00D3 16r00D4 
	16rF8FF 16r00D2 16r00DA 16r00DB 16r00D9 16r0131 16r02C6 16r02DC 
	16r00AF 16r02D8 16r02D9 16r02DA 16r00B8 16r02DD 16r02DB 16r02C7 )! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 12/15/2012 19:37'!
iso885915Mapping
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/ISO8859/8859-15.TXT'"

	^ #(
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	16r00A0 16r00A1 16r00A2 16r00A3 16r20AC 16r00A5 16r0160 16r00A7 
	16r0161 16r00A9 16r00AA 16r00AB 16r00AC 16r00AD 16r00AE 16r00AF 
	16r00B0 16r00B1 16r00B2 16r00B3 16r017D 16r00B5 16r00B6 16r00B7 
	16r017E 16r00B9 16r00BA 16r00BB 16r0152 16r0153 16r0178 16r00BF 
	16r00C0 16r00C1 16r00C2 16r00C3 16r00C4 16r00C5 16r00C6 16r00C7 
	16r00C8 16r00C9 16r00CA 16r00CB 16r00CC 16r00CD 16r00CE 16r00CF 
	16r00D0 16r00D1 16r00D2 16r00D3 16r00D4 16r00D5 16r00D6 16r00D7 
	16r00D8 16r00D9 16r00DA 16r00DB 16r00DC 16r00DD 16r00DE 16r00DF 
	16r00E0 16r00E1 16r00E2 16r00E3 16r00E4 16r00E5 16r00E6 16r00E7 
	16r00E8 16r00E9 16r00EA 16r00EB 16r00EC 16r00ED 16r00EE 16r00EF 
	16r00F0 16r00F1 16r00F2 16r00F3 16r00F4 16r00F5 16r00F6 16r00F7 
	16r00F8 16r00F9 16r00FA 16r00FB 16r00FC 16r00FD 16r00FE 16r00FF )! !

!ZnByteEncoder class methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 9/13/2014 21:52'!
iso88591
	^ self newForEncoding: 'iso-8859-1'! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 9/13/2014 21:11'!
cp1254Mapping
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1254.TXT'"

	^ #(
	16r20AC nil 16r201A 16r0192 16r201E 16r2026 16r2020 16r2021 
	16r02C6 16r2030 16r0160 16r2039 16r0152 nil nil nil 
	nil 16r2018 16r2019 16r201C 16r201D 16r2022 16r2013 16r2014 
	16r02DC 16r2122 16r0161 16r203A 16r0153 nil nil 16r0178 
	16r00A0 16r00A1 16r00A2 16r00A3 16r00A4 16r00A5 16r00A6 16r00A7 
	16r00A8 16r00A9 16r00AA 16r00AB 16r00AC 16r00AD 16r00AE 16r00AF 
	16r00B0 16r00B1 16r00B2 16r00B3 16r00B4 16r00B5 16r00B6 16r00B7 
	16r00B8 16r00B9 16r00BA 16r00BB 16r00BC 16r00BD 16r00BE 16r00BF 
	16r00C0 16r00C1 16r00C2 16r00C3 16r00C4 16r00C5 16r00C6 16r00C7 
	16r00C8 16r00C9 16r00CA 16r00CB 16r00CC 16r00CD 16r00CE 16r00CF 
	16r011E 16r00D1 16r00D2 16r00D3 16r00D4 16r00D5 16r00D6 16r00D7 
	16r00D8 16r00D9 16r00DA 16r00DB 16r00DC 16r0130 16r015E 16r00DF 
	16r00E0 16r00E1 16r00E2 16r00E3 16r00E4 16r00E5 16r00E6 16r00E7 
	16r00E8 16r00E9 16r00EA 16r00EB 16r00EC 16r00ED 16r00EE 16r00EF 
	16r011F 16r00F1 16r00F2 16r00F3 16r00F4 16r00F5 16r00F6 16r00F7 
	16r00F8 16r00F9 16r00FA 16r00FB 16r00FC 16r0131 16r015F 16r00FF )! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 12/15/2012 19:39'!
iso88597Mapping
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/ISO8859/8859-7.TXT'"

	^ #(
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	16r00A0 16r2018 16r2019 16r00A3 16r20AC 16r20AF 16r00A6 16r00A7 
	16r00A8 16r00A9 16r037A 16r00AB 16r00AC 16r00AD nil 16r2015 
	16r00B0 16r00B1 16r00B2 16r00B3 16r0384 16r0385 16r0386 16r00B7 
	16r0388 16r0389 16r038A 16r00BB 16r038C 16r00BD 16r038E 16r038F 
	16r0390 16r0391 16r0392 16r0393 16r0394 16r0395 16r0396 16r0397 
	16r0398 16r0399 16r039A 16r039B 16r039C 16r039D 16r039E 16r039F 
	16r03A0 16r03A1 nil 16r03A3 16r03A4 16r03A5 16r03A6 16r03A7 
	16r03A8 16r03A9 16r03AA 16r03AB 16r03AC 16r03AD 16r03AE 16r03AF 
	16r03B0 16r03B1 16r03B2 16r03B3 16r03B4 16r03B5 16r03B6 16r03B7 
	16r03B8 16r03B9 16r03BA 16r03BB 16r03BC 16r03BD 16r03BE 16r03BF 
	16r03C0 16r03C1 16r03C2 16r03C3 16r03C4 16r03C5 16r03C6 16r03C7 
	16r03C8 16r03C9 16r03CA 16r03CB 16r03CC 16r03CD 16r03CE nil )! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 9/13/2014 21:11'!
cp1251Mapping
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1251.TXT'"

	^ #(
	16r0402 16r0403 16r201A 16r0453 16r201E 16r2026 16r2020 16r2021 
	16r20AC 16r2030 16r0409 16r2039 16r040A 16r040C 16r040B 16r040F 
	16r0452 16r2018 16r2019 16r201C 16r201D 16r2022 16r2013 16r2014 
	nil 16r2122 16r0459 16r203A 16r045A 16r045C 16r045B 16r045F 
	16r00A0 16r040E 16r045E 16r0408 16r00A4 16r0490 16r00A6 16r00A7 
	16r0401 16r00A9 16r0404 16r00AB 16r00AC 16r00AD 16r00AE 16r0407 
	16r00B0 16r00B1 16r0406 16r0456 16r0491 16r00B5 16r00B6 16r00B7 
	16r0451 16r2116 16r0454 16r00BB 16r0458 16r0405 16r0455 16r0457 
	16r0410 16r0411 16r0412 16r0413 16r0414 16r0415 16r0416 16r0417 
	16r0418 16r0419 16r041A 16r041B 16r041C 16r041D 16r041E 16r041F 
	16r0420 16r0421 16r0422 16r0423 16r0424 16r0425 16r0426 16r0427 
	16r0428 16r0429 16r042A 16r042B 16r042C 16r042D 16r042E 16r042F 
	16r0430 16r0431 16r0432 16r0433 16r0434 16r0435 16r0436 16r0437 
	16r0438 16r0439 16r043A 16r043B 16r043C 16r043D 16r043E 16r043F 
	16r0440 16r0441 16r0442 16r0443 16r0444 16r0445 16r0446 16r0447 
	16r0448 16r0449 16r044A 16r044B 16r044C 16r044D 16r044E 16r044F )! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 9/13/2014 21:04'!
iso88593Mapping
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/ISO8859/8859-3.TXT'"

	^ #(
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	16r00A0 16r0126 16r02D8 16r00A3 16r00A4 nil 16r0124 16r00A7 
	16r00A8 16r0130 16r015E 16r011E 16r0134 16r00AD nil 16r017B 
	16r00B0 16r0127 16r00B2 16r00B3 16r00B4 16r00B5 16r0125 16r00B7 
	16r00B8 16r0131 16r015F 16r011F 16r0135 16r00BD nil 16r017C 
	16r00C0 16r00C1 16r00C2 nil 16r00C4 16r010A 16r0108 16r00C7 
	16r00C8 16r00C9 16r00CA 16r00CB 16r00CC 16r00CD 16r00CE 16r00CF 
	nil 16r00D1 16r00D2 16r00D3 16r00D4 16r0120 16r00D6 16r00D7 
	16r011C 16r00D9 16r00DA 16r00DB 16r00DC 16r016C 16r015C 16r00DF 
	16r00E0 16r00E1 16r00E2 nil 16r00E4 16r010B 16r0109 16r00E7 
	16r00E8 16r00E9 16r00EA 16r00EB 16r00EC 16r00ED 16r00EE 16r00EF 
	nil 16r00F1 16r00F2 16r00F3 16r00F4 16r0121 16r00F6 16r00F7 
	16r011D 16r00F9 16r00FA 16r00FB 16r00FC 16r016D 16r015D 16r02D9 )! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 9/13/2014 21:13'!
cp874Mapping
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP874.TXT'"

	^ #(
	16r20AC nil nil nil nil 16r2026 nil nil 
	nil nil nil nil nil nil nil nil 
	nil 16r2018 16r2019 16r201C 16r201D 16r2022 16r2013 16r2014 
	nil nil nil nil nil nil nil nil 
	16r00A0 16r0E01 16r0E02 16r0E03 16r0E04 16r0E05 16r0E06 16r0E07 
	16r0E08 16r0E09 16r0E0A 16r0E0B 16r0E0C 16r0E0D 16r0E0E 16r0E0F 
	16r0E10 16r0E11 16r0E12 16r0E13 16r0E14 16r0E15 16r0E16 16r0E17 
	16r0E18 16r0E19 16r0E1A 16r0E1B 16r0E1C 16r0E1D 16r0E1E 16r0E1F 
	16r0E20 16r0E21 16r0E22 16r0E23 16r0E24 16r0E25 16r0E26 16r0E27 
	16r0E28 16r0E29 16r0E2A 16r0E2B 16r0E2C 16r0E2D 16r0E2E 16r0E2F 
	16r0E30 16r0E31 16r0E32 16r0E33 16r0E34 16r0E35 16r0E36 16r0E37 
	16r0E38 16r0E39 16r0E3A nil nil nil nil 16r0E3F 
	16r0E40 16r0E41 16r0E42 16r0E43 16r0E44 16r0E45 16r0E46 16r0E47 
	16r0E48 16r0E49 16r0E4A 16r0E4B 16r0E4C 16r0E4D 16r0E4E 16r0E4F 
	16r0E50 16r0E51 16r0E52 16r0E53 16r0E54 16r0E55 16r0E56 16r0E57 
	16r0E58 16r0E59 16r0E5A 16r0E5B nil nil nil nil )! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 9/13/2014 21:05'!
iso88594Mapping
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/ISO8859/8859-4.TXT'"

	^ #(
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	16r00A0 16r0104 16r0138 16r0156 16r00A4 16r0128 16r013B 16r00A7 
	16r00A8 16r0160 16r0112 16r0122 16r0166 16r00AD 16r017D 16r00AF 
	16r00B0 16r0105 16r02DB 16r0157 16r00B4 16r0129 16r013C 16r02C7 
	16r00B8 16r0161 16r0113 16r0123 16r0167 16r014A 16r017E 16r014B 
	16r0100 16r00C1 16r00C2 16r00C3 16r00C4 16r00C5 16r00C6 16r012E 
	16r010C 16r00C9 16r0118 16r00CB 16r0116 16r00CD 16r00CE 16r012A 
	16r0110 16r0145 16r014C 16r0136 16r00D4 16r00D5 16r00D6 16r00D7 
	16r00D8 16r0172 16r00DA 16r00DB 16r00DC 16r0168 16r016A 16r00DF 
	16r0101 16r00E1 16r00E2 16r00E3 16r00E4 16r00E5 16r00E6 16r012F 
	16r010D 16r00E9 16r0119 16r00EB 16r0117 16r00ED 16r00EE 16r012B 
	16r0111 16r0146 16r014D 16r0137 16r00F4 16r00F5 16r00F6 16r00F7 
	16r00F8 16r0173 16r00FA 16r00FB 16r00FC 16r0169 16r016B 16r02D9 )! !

!ZnByteEncoder class methodsFor: 'private' stamp: 'SvenVanCaekenberghe 1/15/2013 17:01'!
initializeByteTextConverters
	"Initialize and cache convertors based on specifications in methods that were autogenerated."

	ByteTextConverters := Dictionary new.
	self mappingToIdentifiers
		keysAndValuesDo: [ :mapping :identifiers | 
			| tables |
			tables := self tablesFromSpec: (self perform: mapping).
			identifiers do: [ :each | ByteTextConverters at: each put: tables ] ]! !

!ZnByteEncoder class methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/15/2012 21:31'!
tablesFromSpec: mapping
	"Initialize the mappings to and from Unicode based on the 128 element array mapping"

	| byteToUnicode unicodeToByte |
	byteToUnicode := Array new: 128.
	unicodeToByte := Dictionary new.	
	"Mind the offset because first 128 characters are not stored into byteToUnicodeSpec"	
	"Note that some entries are nil"
	mapping
		keysAndValuesDo: [ :index :unicode | 
			unicode ifNotNil: [ 
				byteToUnicode at: index put: (Character value: unicode).
				unicodeToByte at: unicode put: 127 + index ] ].
	^ Array with: byteToUnicode with: unicodeToByte! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 9/13/2014 21:05'!
iso88595Mapping
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/ISO8859/8859-5.TXT'"

	^ #(
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	16r00A0 16r0401 16r0402 16r0403 16r0404 16r0405 16r0406 16r0407 
	16r0408 16r0409 16r040A 16r040B 16r040C 16r00AD 16r040E 16r040F 
	16r0410 16r0411 16r0412 16r0413 16r0414 16r0415 16r0416 16r0417 
	16r0418 16r0419 16r041A 16r041B 16r041C 16r041D 16r041E 16r041F 
	16r0420 16r0421 16r0422 16r0423 16r0424 16r0425 16r0426 16r0427 
	16r0428 16r0429 16r042A 16r042B 16r042C 16r042D 16r042E 16r042F 
	16r0430 16r0431 16r0432 16r0433 16r0434 16r0435 16r0436 16r0437 
	16r0438 16r0439 16r043A 16r043B 16r043C 16r043D 16r043E 16r043F 
	16r0440 16r0441 16r0442 16r0443 16r0444 16r0445 16r0446 16r0447 
	16r0448 16r0449 16r044A 16r044B 16r044C 16r044D 16r044E 16r044F 
	16r2116 16r0451 16r0452 16r0453 16r0454 16r0455 16r0456 16r0457 
	16r0458 16r0459 16r045A 16r045B 16r045C 16r00A7 16r045E 16r045F )! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 12/15/2012 19:38'!
koi8rMapping
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/VENDORS/MISC/KOI8-R.TXT'"

	^ #(
	16r2500 16r2502 16r250C 16r2510 16r2514 16r2518 16r251C 16r2524 
	16r252C 16r2534 16r253C 16r2580 16r2584 16r2588 16r258C 16r2590 
	16r2591 16r2592 16r2593 16r2320 16r25A0 16r2219 16r221A 16r2248 
	16r2264 16r2265 16r00A0 16r2321 16r00B0 16r00B2 16r00B7 16r00F7 
	16r2550 16r2551 16r2552 16r0451 16r2553 16r2554 16r2555 16r2556 
	16r2557 16r2558 16r2559 16r255A 16r255B 16r255C 16r255D 16r255E 
	16r255F 16r2560 16r2561 16r0401 16r2562 16r2563 16r2564 16r2565 
	16r2566 16r2567 16r2568 16r2569 16r256A 16r256B 16r256C 16r00A9 
	16r044E 16r0430 16r0431 16r0446 16r0434 16r0435 16r0444 16r0433 
	16r0445 16r0438 16r0439 16r043A 16r043B 16r043C 16r043D 16r043E 
	16r043F 16r044F 16r0440 16r0441 16r0442 16r0443 16r0436 16r0432 
	16r044C 16r044B 16r0437 16r0448 16r044D 16r0449 16r0447 16r044A 
	16r042E 16r0410 16r0411 16r0426 16r0414 16r0415 16r0424 16r0413 
	16r0425 16r0418 16r0419 16r041A 16r041B 16r041C 16r041D 16r041E 
	16r041F 16r042F 16r0420 16r0421 16r0422 16r0423 16r0416 16r0412 
	16r042C 16r042B 16r0417 16r0428 16r042D 16r0429 16r0427 16r042A )! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 9/13/2014 21:08'!
iso885910Mapping
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/ISO8859/8859-10.TXT'"

	^ #(
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	nil nil nil nil nil nil nil nil 
	16r00A0 16r0104 16r0112 16r0122 16r012A 16r0128 16r0136 16r00A7 
	16r013B 16r0110 16r0160 16r0166 16r017D 16r00AD 16r016A 16r014A 
	16r00B0 16r0105 16r0113 16r0123 16r012B 16r0129 16r0137 16r00B7 
	16r013C 16r0111 16r0161 16r0167 16r017E 16r2015 16r016B 16r014B 
	16r0100 16r00C1 16r00C2 16r00C3 16r00C4 16r00C5 16r00C6 16r012E 
	16r010C 16r00C9 16r0118 16r00CB 16r0116 16r00CD 16r00CE 16r00CF 
	16r00D0 16r0145 16r014C 16r00D3 16r00D4 16r00D5 16r00D6 16r0168 
	16r00D8 16r0172 16r00DA 16r00DB 16r00DC 16r00DD 16r00DE 16r00DF 
	16r0101 16r00E1 16r00E2 16r00E3 16r00E4 16r00E5 16r00E6 16r012F 
	16r010D 16r00E9 16r0119 16r00EB 16r0117 16r00ED 16r00EE 16r00EF 
	16r00F0 16r0146 16r014D 16r00F3 16r00F4 16r00F5 16r00F6 16r0169 
	16r00F8 16r0173 16r00FA 16r00FB 16r00FC 16r00FD 16r00FE 16r0138 )! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 9/13/2014 21:32'!
macCyrillicMapping
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/VENDORS/APPLE/CYRILLIC.TXT'"

	^ #(
	16r0410 16r0411 16r0412 16r0413 16r0414 16r0415 16r0416 16r0417 
	16r0418 16r0419 16r041A 16r041B 16r041C 16r041D 16r041E 16r041F 
	16r0420 16r0421 16r0422 16r0423 16r0424 16r0425 16r0426 16r0427 
	16r0428 16r0429 16r042A 16r042B 16r042C 16r042D 16r042E 16r042F 
	16r2020 16r00B0 16r0490 16r00A3 16r00A7 16r2022 16r00B6 16r0406 
	16r00AE 16r00A9 16r2122 16r0402 16r0452 16r2260 16r0403 16r0453 
	16r221E 16r00B1 16r2264 16r2265 16r0456 16r00B5 16r0491 16r0408 
	16r0404 16r0454 16r0407 16r0457 16r0409 16r0459 16r040A 16r045A 
	16r0458 16r0405 16r00AC 16r221A 16r0192 16r2248 16r2206 16r00AB 
	16r00BB 16r2026 16r00A0 16r040B 16r045B 16r040C 16r045C 16r0455 
	16r2013 16r2014 16r201C 16r201D 16r2018 16r2019 16r00F7 16r201E 
	16r040E 16r045E 16r040F 16r045F 16r2116 16r0401 16r0451 16r044F 
	16r0430 16r0431 16r0432 16r0433 16r0434 16r0435 16r0436 16r0437 
	16r0438 16r0439 16r043A 16r043B 16r043C 16r043D 16r043E 16r043F 
	16r0440 16r0441 16r0442 16r0443 16r0444 16r0445 16r0446 16r0447 
	16r0448 16r0449 16r044A 16r044B 16r044C 16r044D 16r044E 16r20AC )! !

!ZnByteEncoder class methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 9/13/2014 21:52'!
latin1
	^ self newForEncoding: 'latin1'! !

!ZnByteEncoder class methodsFor: 'mappings' stamp: 'SvenVanCaekenberghe 12/15/2012 19:34'!
cp1250Mapping
	"self generateByteToUnicodeSpec: 'http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1250.TXT'"

	^ #(
	16r20AC nil 16r201A nil 16r201E 16r2026 16r2020 16r2021 
	nil 16r2030 16r0160 16r2039 16r015A 16r0164 16r017D 16r0179 
	nil 16r2018 16r2019 16r201C 16r201D 16r2022 16r2013 16r2014 
	nil 16r2122 16r0161 16r203A 16r015B 16r0165 16r017E 16r017A 
	16r00A0 16r02C7 16r02D8 16r0141 16r00A4 16r0104 16r00A6 16r00A7 
	16r00A8 16r00A9 16r015E 16r00AB 16r00AC 16r00AD 16r00AE 16r017B 
	16r00B0 16r00B1 16r02DB 16r0142 16r00B4 16r00B5 16r00B6 16r00B7 
	16r00B8 16r0105 16r015F 16r00BB 16r013D 16r02DD 16r013E 16r017C 
	16r0154 16r00C1 16r00C2 16r0102 16r00C4 16r0139 16r0106 16r00C7 
	16r010C 16r00C9 16r0118 16r00CB 16r011A 16r00CD 16r00CE 16r010E 
	16r0110 16r0143 16r0147 16r00D3 16r00D4 16r0150 16r00D6 16r00D7 
	16r0158 16r016E 16r00DA 16r0170 16r00DC 16r00DD 16r0162 16r00DF 
	16r0155 16r00E1 16r00E2 16r0103 16r00E4 16r013A 16r0107 16r00E7 
	16r010D 16r00E9 16r0119 16r00EB 16r011B 16r00ED 16r00EE 16r010F 
	16r0111 16r0144 16r0148 16r00F3 16r00F4 16r0151 16r00F6 16r00F7 
	16r0159 16r016F 16r00FA 16r0171 16r00FC 16r00FD 16r0163 16r02D9 )! !

!ZnByteStringBecameWideString commentStamp: '<historical>'!
I am ZnByteStringBecameWideString, a resumable Error signalled to indicate that some byteString was changed to a wideString.

Used by ZnUTF8Encoder>>#readInto:startingAt:count:fromStream: to avoid a #becomeForward: when a ByteString automagically changes into a WideString.

Part of Zinc HTTP Components.!
!ZnByteStringBecameWideString methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2013 14:44'!
wideString
	^ wideString! !

!ZnByteStringBecameWideString methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 11/13/2013 14:28'!
becomeForward
	"Switch the identities of byteString and wideString using #becomeForward:"

	byteString becomeForward: wideString ! !

!ZnByteStringBecameWideString methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2013 14:44'!
wideString: anObject
	wideString := anObject! !

!ZnByteStringBecameWideString methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2013 14:44'!
byteString
	^ byteString! !

!ZnByteStringBecameWideString methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2013 14:44'!
byteString: anObject
	byteString := anObject! !

!ZnByteStringBecameWideString methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/13/2013 13:26'!
isResumable
	^ true! !

!ZnByteStringBecameWideString class methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 11/13/2013 13:49'!
convert: byteString
	"Convert byteString to a wideString, signalling a resumable error"
	
	| wideString |
	wideString := WideString from: byteString.
	self new
		byteString: byteString;
		wideString: wideString;
		signal.
	^ wideString! !

!ZnCharacterEncoder commentStamp: 'SvenVanCaekenberghe 2/24/2014 15:41'!
I am ZnCharacterEncoder, I encode and decode Character objects to and from a binary stream.
I am an abstract class with following protocol:

#nextFromStream:
#nextPut:toStream:
#encodedByteCountFor:
#backOnStream:

The first two are compatible with TextConverter and subclasses.

I add some convenience methods:

#encodeString:
#decodeBytes:
#encodedByteCountForString:

Contrary to older encoders, I work strictly from strings to bytes and vice versa and I will throw errors instead of silently ignoring them.

I also implement optimized bulk operations:

#next:putAll:startingAt:toStream:
#readInto:startingAt:count:fromStream:

Part of Zinc HTTP Components.!
!ZnCharacterEncoder methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/15/2014 09:47'!
identifier
	^ self subclassResponsibility! !

!ZnCharacterEncoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 11/29/2010 21:17'!
encodedByteCountFor: character
	"Return how many bytes are needed to encode character"
	
	self subclassResponsibility ! !

!ZnCharacterEncoder methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 4/20/2011 12:19'!
hash
	^ self class name hash! !

!ZnCharacterEncoder methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 5/23/2013 09:25'!
readInto: string startingAt: offset count: requestedCount fromStream: stream
	"Read requestedCount characters into string starting at offset,
	returning the number read, there could be less available when stream is atEnd"

	0 to: requestedCount - 1 do: [ :count |
		stream atEnd ifTrue: [ ^ count ].  
		string at: offset + count put: (self nextFromStream: stream) ].
	^ requestedCount! !

!ZnCharacterEncoder methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 12/16/2012 15:17'!
decodeBytes: bytes
	"Decode bytes and return the resulting string"
	
	| byteStream |
	byteStream := bytes readStream.
	^ String streamContents: [ :stream |
		[ byteStream atEnd ] whileFalse: [
			stream nextPut: (self nextFromStream: byteStream) ] ] ! !

!ZnCharacterEncoder methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 12/17/2012 14:47'!
beLenient
	"Don't be strict, which is the default"! !

!ZnCharacterEncoder methodsFor: 'error handling' stamp: 'SvenVanCaekenberghe 11/8/2013 10:44'!
errorOutsideRange
	self error: 'Character Unicode code point outside encoder range'! !

!ZnCharacterEncoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 2/24/2014 15:37'!
backOnStream: stream
	"Move back one character on stream, assuming stream understands #back"
	
	self subclassResponsibility ! !

!ZnCharacterEncoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 11/29/2010 21:16'!
nextFromStream: stream
	"Read and return the next character from stream"
	
	self subclassResponsibility ! !

!ZnCharacterEncoder methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 12/16/2012 15:18'!
encodedByteCountForString: string
	"Return the exact number of bytes it would take to encode string as a byte array"

	^ string 
		inject: 0 
		into: [ :sum :each |
			sum + (self encodedByteCountFor: each) ]! !

!ZnCharacterEncoder methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 5/21/2013 21:55'!
next: count putAll: string startingAt: offset toStream: stream
	"Write count characters from string starting at offset to stream."
	
	0 to: count - 1 do: [ :each | 
		self nextPut: (string at: offset + each) toStream: stream ]! !

!ZnCharacterEncoder methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 12/14/2010 11:56'!
= anObject
	^ self class == anObject class! !

!ZnCharacterEncoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 11/29/2010 21:16'!
nextPut: character toStream: stream
	"Write the encoding for character to stream"
	
	self subclassResponsibility ! !

!ZnCharacterEncoder methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 5/21/2013 21:51'!
encodeString: string
	"Encode string and return the resulting byte array"
	
	^ ByteArray streamContents: [ :stream |
		self next: string size putAll: string startingAt: 1 toStream: stream ]! !

!ZnCharacterEncoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 9/15/2014 11:16'!
asZnCharacterEncoder
	^ self! !

!ZnCharacterEncoder methodsFor: 'error handling' stamp: 'SvenVanCaekenberghe 12/16/2012 15:21'!
error: message
	ZnCharacterEncodingError signal: message! !

!ZnCharacterEncoder class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/25/2011 11:07'!
handlesEncoding: string
	"Return true when my instances handle the encoding described by string"
	
	self subclassResponsibility ! !

!ZnCharacterEncoder class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/14/2014 11:23'!
default
	"Return the default ZnCharacterEncoder to be used 
	when none is otherwise specified."
	
	^ ZnDefaultCharacterEncoder value
		ifNil: [ ZnNullEncoder new ]! !

!ZnCharacterEncoder class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/13/2014 22:09'!
canonicalEncodingIdentifier: string
	^ (string select: [ :each | each isAlphaNumeric  ]) asLowercase! !

!ZnCharacterEncoder class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 5/14/2014 11:25'!
newForEncoding: string
	"Return a new character encoder object for an encoding described by string.
	Search for a subclass that handles it and delegate (subclassResponsibility)."
	
	| concreteSubclass encoding |
	encoding := string asLowercase.
	concreteSubclass := self subclasses 
		detect: [ :each | each handlesEncoding: encoding ] 
		ifNone: [ ^ self default ].
	^ concreteSubclass newForEncoding: encoding! !

!ZnCharacterEncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/15/2012 19:12'!
testLatin1Encoder
	| encoder string bytes |
	encoder := ZnCharacterEncoder newForEncoding: 'latin1'.
	string := 'élève en Français'.
	bytes := #(233 108 232 118 101 32 101 110 32 70 114 97 110 231 97 105 115) asByteArray.
	self assert: (encoder encodeString: string) equals: bytes.
	self assert: (encoder decodeBytes: bytes) equals: string! !

!ZnCharacterEncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/8/2013 14:23'!
testUTF16EncoderBigEndian
	| string bytes encoder |
	string := 'élève en Français'.
	bytes := ByteArray readHexFrom:
		'00E9006C00E80076006500200065006E0020004600720061006E00E7006100690073'.
	encoder := ZnUTF16Encoder new.
	self assert: encoder isBigEndian.
	self assert: (encoder encodeString: string) equals: bytes.
	self assert: (encoder decodeBytes: bytes) equals: string! !

!ZnCharacterEncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/22/2013 13:51'!
testConvencienceMethods
	| encoder string |
	encoder := ZnUTF8Encoder new.
	string := 'élève en Français'.
	self assert: (encoder decodeBytes: (encoder encodeString: string)) equals: string.
	self assert: (encoder encodedByteCountForString: string) = 20.
	
	#( 'ccc' 'ççç' 'c' 'ç' 'çc' 'cç' ) do: [ :each |
		self assert: (encoder decodeBytes: (encoder encodeString: each)) equals: each ]! !

!ZnCharacterEncoderTests methodsFor: 'testing' stamp: 'PaulDeBruicker 04/10/2011 10:45'!
testNullEncoder
	| encoder bytes string |
	encoder := ZnNullEncoder new.
	bytes := self encodeString: 'abc' with: encoder.
	self assert: bytes = #(97 98 99) asByteArray.
	string := self decodeBytes: #(65 66 67) asByteArray with: encoder.
	self assert: string = 'ABC' ! !

!ZnCharacterEncoderTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 11/30/2010 11:57'!
encodeString: string with: encoder
	^ ByteArray streamContents: [ :stream |
		string do: [ :each |
			encoder nextPut: each toStream: stream ] ]! !

!ZnCharacterEncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/8/2013 14:50'!
testUTF16EncoderWide1
	| string bytes encoder |
	string := (Character codePoint: 16r1d11e) asString. "MUSICAL SYMBOL G CLEF"
	bytes := ByteArray readHexFrom: 'D834DD1E'.
	encoder := ZnUTF16Encoder new.
	self assert: encoder isBigEndian.
	self assert: (encoder encodeString: string) equals: bytes.
	self assert: (encoder decodeBytes: bytes) equals: string! !

!ZnCharacterEncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/11/2013 16:17'!
testReadIntoStartingAtCountFromStreamWide
	| encoder |
	encoder := ZnUTF8Encoder new.
	{ 'abc', (WideString withAll: { 300 asCharacter. 400 asCharacter. 500 asCharacter}), 'xyz' } do: [ :each |
			| bytes buffer notified |
			bytes := encoder encodeString: each.
			buffer := String new: each size.
			notified := false.
			[ encoder readInto: buffer startingAt: 1 count: each size fromStream: bytes readStream ]
				on: ZnByteStringBecameWideString 
				do: [ :notification |
					self deny: notified.
					notified := true.
					buffer := notification wideString.
					notification resume ].
			self assert: notified.
			self assert: buffer equals: each ] ! !

!ZnCharacterEncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/24/2014 15:58'!
testUTF16Back
	| encoder stream |
	encoder := ZnUTF16Encoder new.
	stream := (encoder encodeString: 'Les élèves Françaises') readStream.
	self should: [ encoder backOnStream: stream ] raise: Error.
	4 timesRepeat: [ encoder nextFromStream: stream ].
	self assert: (encoder nextFromStream: stream) equals: $é.
	encoder backOnStream: stream.
	self assert: (encoder nextFromStream: stream) equals: $é.
	10 timesRepeat: [ encoder nextFromStream: stream ].
	13 timesRepeat: [ encoder backOnStream: stream ].
	self assert: (encoder nextFromStream: stream) equals: $s! !

!ZnCharacterEncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/15/2014 11:28'!
testByteDecoding
	| encoder bytes |
	encoder := ZnUTF8Encoder new.
	bytes := encoder encodeString: 'élève en Français'.
	self assert: (bytes decodeWith: encoder) equals: (encoder decodeBytes: bytes).
	self assert: (bytes decodeWith: #utf8) equals: (encoder decodeBytes: bytes).
	self assert: bytes utf8Decoded equals: (encoder decodeBytes: bytes)! !

!ZnCharacterEncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/8/2013 15:57'!
testUTF16EncoderByteOrderMark
	| string bytes encoder encoded |
	string := 'foo'.
	bytes := ByteArray readHexFrom: 'FEFF0066006f006f'.
	encoder := ZnUTF16Encoder new.
	self assert: encoder isBigEndian.
	encoded := ByteArray streamContents: [ :out |
		encoder nextPutByteOrderMarkToStream: out.
		encoder next: string size putAll: string startingAt: 1 toStream: out ].
	self assert: encoded equals: bytes.
	self assert: (encoder decodeBytes: bytes) equals: string.
	encoder beLittleEndian.
	self assert: encoder isLittleEndian.
	self assert: (encoder decodeBytes: bytes) equals: string.
	self assert: encoder isBigEndian.
	1 to: bytes size by: 2 do: [ :each | bytes swap: each with: each + 1 ].
	self assert: (encoder decodeBytes: bytes) equals: string.
	self assert: encoder isLittleEndian
! !

!ZnCharacterEncoderTests methodsFor: 'testing' stamp: 'PaulDeBruicker 04/10/2011 10:44'!
testLatin2Encoder
	"Example characters taken from http://en.wikipedia.org/wiki/Latin2"
	
	| encoder inputBytes outputBytes inputString outputString |
	encoder := ZnCharacterEncoder newForEncoding: 'latin2'.
	inputString := String 
		with: (16r0154 asCharacter) with: (16r0110 asCharacter) 
		with: ( 16r0155 asCharacter) with: (16r0111 asCharacter).
	inputBytes := #(192 208 224 240) asByteArray.
	outputBytes := self encodeString: inputString with: encoder.
	self assert: outputBytes = inputBytes.
	outputString := self decodeBytes: inputBytes with: encoder.
	self assert: outputString = inputString ! !

!ZnCharacterEncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/24/2013 16:22'!
testReadIntoStartingAtCountFromStream
	| encoder |
	encoder := ZnUTF8Encoder new.
	#( 'ccc' 'ççç' 'c' 'ç' 'çc' 'cç' 'çç' ) do: [ :each |
		#( ( '' '' ) ( 'ABC' '' ) ( '' 'ABC' ) ( 'ABC' 'ABC' ) 
			( 'AéC' '' ) ( '' 'AèC' ) ( 'AéC' 'AèC' ) 
			( 'AXC' 'AèC' ) ( 'AéC' 'AXC' ) 
			( 'PRE' 'ç' ) ) do: [ :extra |
				| prefix postfix string bytes buffer |
				prefix := extra first.
				postfix := extra last.
				string := prefix, each.
				bytes := encoder encodeString: string, postfix.
				buffer := String new: string size.
				encoder readInto: buffer startingAt: 1 count: string size fromStream: bytes readStream.
				self assert: buffer equals: string ] ]! !

!ZnCharacterEncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/4/2013 17:19'!
testUTF8ByteOrderMark
	"The Unicode Byte Order Mark (BOM) should be skipped."
	
	| bom string bytes encoder |
	encoder := ZnUTF8Encoder new.
	bom := #(239 187 191).
	string := 'élève en Français'.
	bytes := encoder encodeString: string.
	self assert: (encoder decodeBytes: bom, bytes) equals: string.
	self should: [ encoder decodeBytes: bom ] raise: ZnInvalidUTF8 ! !

!ZnCharacterEncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/14/2014 11:31'!
testDefault
	| string bytes |
	self assert: ZnCharacterEncoder default equals: ZnNullEncoder new.
	string := 'Der Weg zur Hölle ist mit guten Vorsätzen gepflastert.'.
	bytes := ZnUTF8Encoder new encodeString: string.
	ZnDefaultCharacterEncoder 
		value: ZnUTF8Encoder new
		during: [ 
			self 
				assert: (ZnCharacterEncoder default decodeBytes: bytes) 
				equals: string ].
	ZnDefaultCharacterEncoder 
		value: ZnUTF8Encoder new
		during: [ 
			self 
				assert: ((ZnCharacterEncoder newForEncoding: 'unknown') decodeBytes: bytes) 
				equals: string ]! !

!ZnCharacterEncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/4/2013 16:56'!
testUTF8Overlong
	"Overlong encoding, aka Non shortest form characters should be rejected.
	See http://en.wikipedia.org/wiki/UTF-8#Overlong_encodings"
	
	self 
		should: [ ZnUTF8Encoder new decodeBytes: #[ 16rF0 16r82 16r82 16rAC ] ] 
		raise: ZnInvalidUTF8.
	self 
		should: [ ZnUTF8Encoder new decodeBytes: #(193 129 193 130 193 131 ) ] 
		raise: ZnInvalidUTF8.
		
	! !

!ZnCharacterEncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/15/2014 11:25'!
testStringEncoding
	| encoder string |
	encoder := ZnUTF8Encoder new.
	string := 'élève en Français'.
	self assert: (string encodeWith: encoder) equals: (encoder encodeString: string).
	self assert: (string encodeWith: #utf8) equals: (encoder encodeString: string).
	self assert: string utf8Encoded equals: (encoder encodeString: string)
! !

!ZnCharacterEncoderTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 11/30/2010 11:57'!
decodeBytes: bytes with: encoder
	| input |
	input := bytes readStream.
	^ String streamContents: [ :stream |
		[ input atEnd ] whileFalse: [ 
			stream nextPut: (encoder nextFromStream: input) ] ]! !

!ZnCharacterEncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/8/2013 14:27'!
testUTF16EncoderLittleEndian
	| string bytes encoder |
	string := 'élève en Français'.
	bytes := ByteArray readHexFrom:
		'E9006C00E80076006500200065006E0020004600720061006E00E700610069007300'.
	encoder := ZnUTF16Encoder new.
	encoder beLittleEndian.
	self assert: encoder isLittleEndian.
	self assert: (encoder encodeString: string) equals: bytes.
	self assert: (encoder decodeBytes: bytes) equals: string! !

!ZnCharacterEncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/17/2012 15:13'!
testBeLenient
	| encoder unmapped |
	encoder := ZnCharacterEncoder newForEncoding: 'iso-8859-1'.
	unmapped := (128 to: 159) asByteArray.
	self should: [ encoder encodeString: unmapped asString ] raise: ZnCharacterEncodingError.
	self should: [ encoder decodeBytes: unmapped ] raise: ZnCharacterEncodingError.
	encoder beLenient.
	self assert: (encoder encodeString: unmapped asString) equals: unmapped.
	self assert: (encoder decodeBytes: unmapped) equals: unmapped asString.! !

!ZnCharacterEncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/24/2014 15:50'!
testUTF8Back
	| encoder stream |
	encoder := ZnUTF8Encoder new.
	stream := (encoder encodeString: 'Les élèves Françaises') readStream.
	self should: [ encoder backOnStream: stream ] raise: Error.
	4 timesRepeat: [ encoder nextFromStream: stream ].
	self assert: (encoder nextFromStream: stream) equals: $é.
	encoder backOnStream: stream.
	self assert: (encoder nextFromStream: stream) equals: $é.
	10 timesRepeat: [ encoder nextFromStream: stream ].
	13 timesRepeat: [ encoder backOnStream: stream ].
	self assert: (encoder nextFromStream: stream) equals: $s! !

!ZnCharacterEncoderTests methodsFor: 'testing' stamp: 'PaulDeBruicker 04/10/2011 10:44'!
testUTF8Encoder
	"The examples are taken from http://en.wikipedia.org/wiki/UTF-8#Description"
	
	| encoder inputBytes outputBytes inputString outputString |
	encoder := ZnUTF8Encoder new.
	inputString := String with: $$ with: (16r00A2 asCharacter) with: (16r20AC asCharacter) with: (16r024B62 asCharacter).
	inputBytes := #(16r24 16rC2 16rA2 16rE2 16r82 16rAC 16rF0 16rA4 16rAD 16rA2) asByteArray.
	outputBytes := self encodeString: inputString with: encoder.
	self assert: outputBytes = inputBytes.
	outputString := self decodeBytes: inputBytes with: encoder.
	self assert: outputString = inputString ! !

!ZnCharacterEncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/3/2013 19:51'!
testUTF8EncoderIncomplete
	"The examples are taken from http://en.wikipedia.org/wiki/UTF-8#Description"
	
	| encoder |
	encoder := ZnUTF8Encoder new.
	#( (16rC2 16rA2) (16rE2 16r82 16rAC) (16rF0 16rA4 16rAD 16rA2) ) do: [ :each |
		2 to: each size do: [ :count |
			self 
				should: [ encoder decodeBytes: (each allButLast: count - 1) ] 
				raise: ZnInvalidUTF8 ] ]! !

!ZnCharacterEncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/30/2010 13:42'!
testUTF8EncoderAuto
	| encoder inputString bytes outputString |
	encoder := ZnUTF8Encoder new.
	inputString := String withAll: ((1 to: 3072) collect: [ :each | Character value: each ]).
	bytes := self encodeString: inputString with: encoder. 
	outputString := self decodeBytes: bytes with: encoder.
	self assert: inputString = outputString ! !

!ZnCharacterEncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/24/2013 13:24'!
testNextPutAllStartingAtToStream
	| encoder |
	encoder := ZnUTF8Encoder new.
	#( 'ccc' 'ççç' 'c' 'ç' 'çc' 'cç' 'çç' ) do: [ :each |
		#( ( '' '' ) ( 'ABC' '' ) ( '' 'ABC' ) ( 'ABC' 'ABC' ) 
			( 'AéC' '' ) ( '' 'AèC' ) ( 'AéC' 'AèC' ) 
			( 'AXC' 'AèC' ) ( 'AéC' 'AXC' ) 
			( 'PRE' 'ç' ) ) do: [ :extra |
				| prefix postfix string bytes |
				prefix := extra first.
				postfix := extra last.
				string := prefix, each, postfix.
				bytes := ByteArray streamContents: [ :out |
					encoder next: each size putAll: string startingAt: prefix size + 1 toStream: out ].
				self assert: (encoder decodeBytes: bytes) equals: each ] ]! !

!ZnCharacterEncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/10/2013 23:12'!
testUTF8EncoderWide
	| encoder |
	encoder := ZnUTF8Encoder new.
	{ 'abc'. 'élève en Français'. 'Pra-ská' copy at: 4 put: (Character value: 382); yourself. '' }
		do: [ :each | | bytes |
			bytes := self encodeString: each with: encoder. 
			self assert: (encoder decodeBytesIntoWideString: bytes) equals: each ]! !

!ZnCharacterEncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/5/2013 22:43'!
testReadIntoStartingAtCountFromStreamWithOffset
	| input encoder bytes readStream string |
	encoder := ZnUTF8Encoder new.
	input := '_élève_'.
	bytes := encoder encodeString: input.
	readStream := bytes readStream.
	readStream next.
	string := String new: 7 withAll: $_.
	encoder readInto: string startingAt: 2 count: 5 fromStream: readStream.
	self assert: string equals: input.
	input := '_Français_'.
	bytes := encoder encodeString: input.
	readStream := bytes readStream.
	readStream next.
	string := String new: 10 withAll: $_.
	encoder readInto: string startingAt: 2 count: 8 fromStream: readStream.
	self assert: string equals: input! !

!ZnCharacterEncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/15/2014 11:03'!
testAllByteEncoderDomains
	| encoder characterDomain byteDomain encoded |
	ZnByteEncoder knownEncodingIdentifiers do: [ :identifier |
		encoder := ZnCharacterEncoder newForEncoding: identifier.
		self assert: encoder identifier equals: identifier.
		self assert: encoder isStrict.
		self assert: encoder isLenient not.
		self assert: (encoder encodeString: 'hello') equals: #[104 101 108 108 111] .
		self assert: (encoder decodeBytes: #[104 101 108 108 111] ) equals: 'hello'.
		characterDomain := encoder characterDomain.
		byteDomain := encoder byteDomain.
		characterDomain do: [ :each |
			self assert: (encoder encodedByteCountFor: each) equals: 1.
			encoded := ByteArray streamContents: [ :out | encoder nextPut: each toStream: out ].
			self assert: encoded size equals: 1.
			self assert: (byteDomain includes: encoded first) ].
		byteDomain do: [ :each |
			self assert: (characterDomain includes: (encoder nextFromStream: (ByteArray with: each) readStream)) ] ]! !

!ZnCharacterEncoderTests methodsFor: 'testing' stamp: 'PaulDeBruicker 04/10/2011 10:44'!
testUTF8EncoderByteCount	
	| encoder |
	encoder := ZnUTF8Encoder new.
	self assert: (encoder encodedByteCountFor: $$) = 1.
	self assert: (encoder encodedByteCountFor: (16r00A2 asCharacter)) = 2.
	self assert: (encoder encodedByteCountFor: (16r20AC asCharacter)) = 3.
	self assert: (encoder encodedByteCountFor: (16r024B62 asCharacter)) = 4! !

!ZnCharacterEncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 4/2/2014 13:45'!
testUTF8Boundaries
	"Test encoding and decoding of the characters at the boundaries between 1, 2, 3, and 4 multi-byte sequences.
	Values taken from http://en.wikipedia.org/wiki/Utf8#Description with the new RFC 3629 limit"
	
	| utf8Encoder string encoded |
	utf8Encoder := ZnUTF8Encoder new.
	#( (0 16r7f) 
		(16r80 16r07FF) 
		(16r0800 16rFFFF) 
		(16r10000 16r10FFFF) 
	) doWithIndex: [ :boundaries :byteCount |
		boundaries do: [ :each |
			string := String with: each asCharacter.
			encoded := utf8Encoder encodeString: string. 
			self assert: (utf8Encoder decodeBytes: encoded) equals: string.
			self assert: encoded size equals: byteCount ] ]! !

!ZnCharacterEncodingError commentStamp: '<historical>'!
I am ZnCharacterEncodingError.
I am an Error.

I signal when something goes wrong while encoding or decoding characters.

Part of Zinc HTTP Components!
!ZnCharacterReadStream commentStamp: '<historical>'!
I am ZnCharacterReadStream.
I wrap another binary ReadStream and use a ZnCharacerEncoder to allow Characters to be read.

I am not positionable, but I do allow a one character peek using a one character internal buffer.

Part of Zinc HTTP Components.
!
!ZnCharacterReadStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 9/15/2014 13:26'!
encoding: encoding
	encoder := encoding asZnCharacterEncoder! !

!ZnCharacterReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/3/2012 15:11'!
skip: count
	count timesRepeat: [ self next ]! !

!ZnCharacterReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/3/2012 15:12'!
contents
	"This is technically not correct, but it is better than nothing"
	
	^ self upToEnd! !

!ZnCharacterReadStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/3/2012 14:39'!
close
	stream close! !

!ZnCharacterReadStream methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/3/2012 21:29'!
atEnd
	^ peekedCharacter isNil and: [ stream atEnd ]! !

!ZnCharacterReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/19/2014 13:42'!
nextLine
	"Read a CR, LF or CRLF terminated line, returning the contents of the line without the EOL. Return nil when the receiver is #atEnd."
	
	self atEnd ifTrue: [ ^ nil ].
	^ self collectionSpecies streamContents: [ :out | | eol char |
		eol := false.
		[ eol ] whileFalse: [ 
			char := self next.
			(char isNil or: [ char = Character lf ])
				ifTrue: [ eol := true ]
				ifFalse: [ 
					char = Character cr 
						ifTrue: [ eol := true. self peekFor: Character lf ]
						ifFalse: [  out nextPut: char ] ] ] ]! !

!ZnCharacterReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/3/2012 15:09'!
collectionSpecies
	^ String! !

!ZnCharacterReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/3/2012 15:46'!
next
	^ peekedCharacter
		ifNil: [ 
			stream atEnd
				ifFalse: [ self encoder nextFromStream: stream ] ]
		ifNotNil: [ | character |
			character := peekedCharacter.
			peekedCharacter := nil.
			character ]! !

!ZnCharacterReadStream methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/3/2012 15:07'!
isBinary
	^ false! !

!ZnCharacterReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/3/2012 15:18'!
next: requestedCount 
	"Read requestedCount elements into new collection and return it,
	 it could be that less elements were available"

	^ self 
		next: requestedCount 
		into: (self collectionSpecies new: requestedCount)! !

!ZnCharacterReadStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/3/2012 14:41'!
encoder: characterEncoder
	encoder := characterEncoder! !

!ZnCharacterReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/3/2012 15:18'!
next: requestedCount into: collection
	"Read requestedCount elements into collection,
	returning a copy if less elements are available"
	
	^ self
		next: requestedCount
		into: collection
		startingAt: 1! !

!ZnCharacterReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/3/2012 14:41'!
wrappedStream
	^ stream! !

!ZnCharacterReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/3/2012 13:05'!
peekFor: object
	^ self peek = object
		ifTrue: [ 
			self next.
			true ]
		ifFalse: [ false ]! !

!ZnCharacterReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/3/2012 15:17'!
upTo: anObject 	
	^ self collectionSpecies 
		streamContents: [ :out | | element |
			[ self atEnd or: [ (element := self next) = anObject ] ] whileFalse: [ 
				out nextPut: element ] ]! !

!ZnCharacterReadStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/3/2012 14:40'!
on: readStream
	stream := readStream! !

!ZnCharacterReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/16/2012 15:42'!
upToEnd
	^ self collectionSpecies
		streamContents: [ :collectionStream | 
			[ self atEnd ] whileFalse: [ collectionStream nextPut: self next ] ]! !

!ZnCharacterReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/3/2012 15:19'!
next: requestedCount into: collection startingAt: offset
	"Read requestedCount elements into collection starting at offset,
	returning a copy if less elements are available"
	
	| readCount |
	readCount := self 
		readInto: collection 
		startingAt: offset 
		count: requestedCount.
	^ requestedCount = readCount
		ifTrue: [ collection ]
		ifFalse: [ collection copyFrom: 1 to: offset + readCount - 1 ]! !

!ZnCharacterReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/3/2012 14:42'!
encoder
	^ encoder ifNil: [ encoder := self class defaultEncoder ]! !

!ZnCharacterReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/13/2013 14:38'!
readInto: collection startingAt: offset count: requestedCount 
	"Read count elements and place them in collection starting at offset.
	Return the number of elements actually read."
	
	^ peekedCharacter 
		ifNil: [ | readCount |
			[ readCount := self encoder 
					readInto: collection 
					startingAt: offset 
					count: requestedCount 
					fromStream: stream ]
				on: ZnByteStringBecameWideString 
				do: [ :byteStringBecameWideString | 
					byteStringBecameWideString becomeForward; resume ].
			readCount ]
		ifNotNil: [ 
			collection at: offset put: peekedCharacter.
			peekedCharacter := nil.
			(self 
				readInto: collection 
				startingAt: offset + 1
				count: requestedCount - 1) + 1 ]! !

!ZnCharacterReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/3/2012 15:35'!
peek
	^ peekedCharacter
		ifNil: [
			stream atEnd
				ifFalse: [ 
					peekedCharacter := self encoder nextFromStream: stream ] ]
! !

!ZnCharacterReadStream class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/3/2012 14:43'!
defaultEncoder
	^ ZnUTF8Encoder new! !

!ZnCharacterReadStream class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 5/3/2012 15:13'!
on: readStream encoding: encoding
	^ self new
		on: readStream;
		encoding: encoding;
		yourself! !

!ZnCharacterReadStream class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 5/3/2012 14:40'!
on: readStream
	^ self new
		on: readStream;
		yourself! !

!ZnCharacterStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/13/2013 14:11'!
testUTF8ReadStreamReadInto
	| string bytes stream buffer |
	string := 'élève en Français'.
	bytes := ZnUTF8Encoder new encodeString: string.
	stream := ZnCharacterReadStream on: bytes readStream.
	buffer := String new: string size.
	stream next: string size into: buffer. 
	self assert: buffer equals: string.
	self assert: stream atEnd.
	string := 'Czech in Czech is {1}e{2}tina.' format: { 269 asCharacter. 353 asCharacter }.
	bytes := ZnUTF8Encoder new encodeString: string.
	stream := ZnCharacterReadStream on: bytes readStream.
	buffer := String new: string size.
	stream next: string size into: buffer. 
	self assert: buffer equals: string.
	self assert: stream atEnd	! !

!ZnCharacterStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/3/2012 21:35'!
testReadStream
	| stream |
	stream := ZnCharacterReadStream on: 'ABC' asByteArray readStream.
	self deny: stream atEnd.
	self deny: stream isBinary.
	self assert: stream next = $A.
	self deny: stream atEnd.
	self assert: stream peek = $B.
	self deny: stream atEnd.
	self assert: stream peek = $B.
	self deny: stream atEnd.
	self assert: stream next = $B.
	self deny: stream atEnd.
	self assert: stream next = $C.
	self assert: stream atEnd.
	self assert: stream next isNil.
	self assert: stream peek isNil		! !

!ZnCharacterStreamTests methodsFor: 'testing' stamp: 'KenTreis 01/18/2013 16:24'!
testSimpleUTF8WriteStream
	| string bytes stream |
	string := 'élève en Français'.
	bytes := ZnUTF8Encoder new encodeString: string.
	stream := (ZnCharacterWriteStream on: ByteArray new writeStream).
	stream nextPutAll: string.
	self 
		assert: stream wrappedStream contents
		equals: bytes! !

!ZnCharacterStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/3/2012 21:26'!
testSimpleUTF8ReadStream
	| string bytes |
	string := 'élève en Français'.
	bytes := ZnUTF8Encoder new encodeString: string.
	self 
		assert: (ZnCharacterReadStream on: bytes readStream) upToEnd
		equals: string! !

!ZnCharacterStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/5/2013 22:44'!
testPeek
	| string bytes readStream |
	string := 'élève en Français'.
	bytes := ZnUTF8Encoder new encodeString: string.
	readStream := ZnCharacterReadStream on: bytes readStream.
	self assert: readStream peek equals: 'é' first.
	self assert: readStream peek equals: 'é' first.
	self assert: readStream next equals: 'é' first.
	readStream skip: 'lève ' size.
	self assert: readStream peek equals: $e.
	self assert: (readStream next: 'en Français' size) equals: 'en Français'! !

!ZnCharacterStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/19/2014 14:20'!
testNextLine
	| stream |
	stream := ZnCharacterReadStream on: 'abc' asByteArray readStream.
	self assert: stream nextLine equals: 'abc'.
	self assert: stream nextLine  equals: nil.
	stream := ZnCharacterReadStream on: '' asByteArray readStream.
	self assert: stream nextLine equals: nil.
	stream := ZnCharacterReadStream on: ({ 
		$a. Character cr. 
		$b. Character lf. 
		$c } collect: #charCode) readStream.
	self assert: stream nextLine equals: 'a'.
	self assert: stream nextLine equals: 'b'.
	self assert: stream nextLine equals: 'c'.
	self assert: stream nextLine equals: nil.
	stream := ZnCharacterReadStream on: ({ 
		$a. Character cr. Character lf.  
		$b. Character cr. Character lf. 
		$c. Character cr. Character lf } collect: #charCode) readStream.
	self assert: stream nextLine equals: 'a'.
	self assert: stream nextLine equals: 'b'.
	self assert: stream nextLine equals: 'c'.
	self assert: stream nextLine equals: nil.
	stream := ZnCharacterReadStream on: ({ 
		$a. Character cr. Character lf.  
		Character cr. Character lf. 
		$c. Character cr. Character lf } collect: #charCode) readStream.
	self assert: stream nextLine equals: 'a'.
	self assert: stream nextLine equals: ''.
	self assert: stream nextLine equals: 'c'.
	self assert: stream nextLine equals: nil.
	! !

!ZnCharacterWriteStream commentStamp: '<historical>'!
I am ZnCharacterWriteStream.
I wrap another binary WriteStream and use a ZnCharacerEncoder to allow Characters to be written.

Part of Zinc HTTP Components.!
!ZnCharacterWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/19/2014 13:13'!
cr
	self nextPut: Character cr! !

!ZnCharacterWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/19/2014 13:13'!
lf
	self nextPut: Character lf! !

!ZnCharacterWriteStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/3/2012 15:51'!
close
	stream close! !

!ZnCharacterWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/3/2012 15:54'!
next: count putAll: collection	
	self 
		next: count 
		putAll: collection 
		startingAt: 1! !

!ZnCharacterWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/3/2012 15:56'!
nextPut: object
	self encoder 
		nextPut: object 
		toStream: stream.
	^ object! !

!ZnCharacterWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/19/2014 13:13'!
crlf
	self cr; lf! !

!ZnCharacterWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/3/2014 10:11'!
print: object
	object printOn: self! !

!ZnCharacterWriteStream methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/3/2012 15:52'!
isBinary
	^ false! !

!ZnCharacterWriteStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/3/2012 15:51'!
encoder: characterEncoder
	encoder := characterEncoder! !

!ZnCharacterWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/3/2012 15:52'!
space
	self nextPut: Character space! !

!ZnCharacterWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/3/2012 18:47'!
wrappedStream
	^ stream! !

!ZnCharacterWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/3/2012 15:59'!
<< collection
	^ self nextPutAll: collection! !

!ZnCharacterWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/3/2012 15:52'!
flush
	stream flush! !

!ZnCharacterWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/3/2012 15:56'!
nextPutAll: collection
	self 
		next: collection size 
		putAll: collection 
		startingAt: 1! !

!ZnCharacterWriteStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/3/2012 15:51'!
on: writeStream
	stream := writeStream! !

!ZnCharacterWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/4/2013 15:25'!
next: count putAll: collection startingAt: offset
	"Write count characters from collection starting at offset."
	
	self encoder 
		next: count 
		putAll: collection 
		startingAt: offset 
		toStream: stream ! !

!ZnCharacterWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/3/2012 18:47'!
encoder
	^ encoder ifNil: [ encoder := self class defaultEncoder ]! !

!ZnCharacterWriteStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 9/15/2014 13:26'!
encoding: encoding
	encoder := encoding asZnCharacterEncoder! !

!ZnCharacterWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/3/2014 10:03'!
tab
	self nextPut: Character tab! !

!ZnCharacterWriteStream class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/3/2012 15:50'!
defaultEncoder
	^ ZnUTF8Encoder new! !

!ZnCharacterWriteStream class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 5/3/2012 15:51'!
on: writeStream encoding: encoding
	^ self new
		on: writeStream;
		encoding: encoding;
		yourself! !

!ZnCharacterWriteStream class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 5/3/2012 15:51'!
on: writeStream
	^ self new
		on: writeStream;
		yourself! !

!ZnChunkedReadStream commentStamp: 'SvenVanCaekenberghe 1/18/2011 11:01'!
I am ZnChunkedReadStream, implementing HTTP 1.1 chunked transfer encoding on a wrapped streams.

Clients should read me until I am atEnd.

After I am completely read, I can tell you my totalSize and optional extraHeaders.

Part of Zinc HTTP Components.!
!ZnChunkedReadStream methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/19/2011 12:45'!
ensureChunkOrAtEnd
	atEnd 
		ifTrue: [ ^ self ].
	(chunk isNil or: [ position >= limit ]) 
		ifTrue: [ self getNextChunk ]
! !

!ZnChunkedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/26/2010 17:10'!
skip: count
	count timesRepeat: [ self next ]! !

!ZnChunkedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/27/2010 08:11'!
binary
	stream binary! !

!ZnChunkedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/26/2010 19:45'!
collectionSpecies
	^ self isBinary ifTrue: [ ByteArray ] ifFalse: [ String ]
	! !

!ZnChunkedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/26/2010 19:57'!
next
	self ensureChunkOrAtEnd.
	self atEnd ifTrue: [ ^ nil ].
	^ chunk at: (position := position + 1)! !

!ZnChunkedReadStream methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/26/2010 19:45'!
isBinary
	^ stream isBinary
! !

!ZnChunkedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/31/2012 21:11'!
next: requestedCount into: collection
	"Read requestedCount elements into collection,
	returning a copy if less elements are available"
	
	^ self
		next: requestedCount
		into: collection
		startingAt: 1! !

!ZnChunkedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/2/2012 16:06'!
match: subCollection
	"Try to read and match the elements of subCollection. 
	If successful return true and leave the me positioned after the match.
	If unsuccesful return false and leave me at end."
	
	| buffer pattern bufferPosition bufferLimit |
	pattern := subCollection readStream.
	"we have to use an internal buffer because we are not positionable"
	buffer := subCollection species new: subCollection size.
	bufferPosition := bufferLimit := 0.
	[ pattern atEnd ] whileFalse: [ | nextElement |
		self atEnd ifTrue: [ ^ false ].
		"get the next char to match either from the buffer or from the stream while buffering it"
		(bufferPosition < bufferLimit) 
			ifTrue: [ 
				nextElement := buffer at: bufferPosition + 1 ]
			ifFalse: [
				nextElement := buffer at: bufferPosition + 1 put: self next.
				bufferLimit := bufferLimit + 1 ].
		bufferPosition := bufferPosition + 1.
		pattern next = nextElement
			ifFalse: [
				"shift the buffer down one element and restart"
				2 to: bufferLimit do: [ :each |
					buffer at: each - 1 put: (buffer at: each) ].
				bufferLimit := bufferLimit - 1.
				bufferPosition := 0.
				pattern position: 0 ] ].
	^ true! !

!ZnChunkedReadStream methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/18/2013 00:36'!
getNextChunk
	| size |
	(size := self getNextChunkSize) = 0
		ifTrue: [
			atEnd := true.
			chunk := position := limit := nil.
			self getExtraHeaders ]
		ifFalse: [
			totalSize := totalSize + size.
			chunkCount := chunkCount + 1.
			self ensureChunkBufferOfSize: size.  
			stream next: size into: chunk.
			stream next: 2. "consume CRLF"
			limit := size.
			position := 0 ]! !

!ZnChunkedReadStream methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 5/18/2013 00:36'!
initialize
	atEnd := false.
	chunkCount := 0.
	totalSize := 0! !

!ZnChunkedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/18/2013 00:36'!
chunkCount
	^ chunkCount! !

!ZnChunkedReadStream methodsFor: 'private' stamp: 'SvenVanCaekenberghe 9/26/2010 17:08'!
getExtraHeaders
	extraHeaders := ZnHeaders readFrom: stream! !

!ZnChunkedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/26/2010 14:21'!
extraHeaders
	^ extraHeaders! !

!ZnChunkedReadStream methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 9/26/2010 14:12'!
printOn: aStream
	aStream 
		nextPutAll: 'a '; 
		nextPutAll: self class name! !

!ZnChunkedReadStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 9/26/2010 14:13'!
on: readStream
	stream := readStream! !

!ZnChunkedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/19/2011 12:36'!
peek
	self ensureChunkOrAtEnd.
	self atEnd ifTrue: [ ^ nil ].
	^ chunk at: (position + 1)! !

!ZnChunkedReadStream methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/26/2010 19:57'!
atEnd
	self ensureChunkOrAtEnd.
	^ atEnd! !

!ZnChunkedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/26/2010 14:12'!
reset
	"We don't allow it"! !

!ZnChunkedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/31/2012 21:11'!
next: requestedCount 
	"Read requestedCount elements into new collection and return it,
	 it could be that less elements were available"

	^ self 
		next: requestedCount 
		into: (self collectionSpecies new: requestedCount)! !

!ZnChunkedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/26/2010 14:20'!
totalSize
	^ totalSize! !

!ZnChunkedReadStream methodsFor: 'private' stamp: 'SvenVanCaekenberghe 9/27/2010 19:26'!
getNextChunkSize
	| line |
	(line := (ZnLineReader on: stream) nextLine) isEmpty ifTrue: [ ^ 0 ].
	^ Integer readFrom: (line copyUpTo: $;) base: 16! !

!ZnChunkedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/27/2010 15:30'!
position
	^ self atEnd 
		ifTrue: [ totalSize ]
		ifFalse: [ totalSize - chunk size + position ]! !

!ZnChunkedReadStream methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/19/2011 12:39'!
ensureChunkBufferOfSize: size
	(chunk notNil and: [ size <= chunk size ]) ifTrue: [ ^ self ].  
	chunk := self collectionSpecies new: size.
! !

!ZnChunkedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/31/2012 13:15'!
upTo: anObject 
	"We use our own collectionSpecies."
	
	^ self collectionSpecies streamContents: [ :out | | element |
		[ self atEnd or: [ (element := self next) = anObject ] ]
			whileFalse: [ out nextPut: element ] ]! !

!ZnChunkedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/17/2013 23:49'!
upToEnd
	"We use our own collectionSpecies and read by chunk"

	^ self collectionSpecies streamContents: [ :out |
		[ self atEnd ] whileFalse: [ 
			out next: limit putAll: chunk.
			position := limit ] ]! !

!ZnChunkedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/31/2012 21:11'!
next: requestedCount into: collection startingAt: offset
	"Read requestedCount elements into collection starting at offset,
	returning a copy if less elements are available"
	
	| readCount |
	readCount := self 
		readInto: collection 
		startingAt: offset 
		count: requestedCount.
	^ requestedCount = readCount
		ifTrue: [ collection ]
		ifFalse: [ collection copyFrom: 1 to: offset + readCount - 1 ]! !

!ZnChunkedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/17/2013 21:06'!
readInto: collection startingAt: offset count: requestedCount
	"Read requestedCount elements into collection starting at offset.
	Return the actual number of elements read."

	| read toRead |
	read := 0.
	[ read < requestedCount and: [ self atEnd not] ] whileTrue: [
		toRead := (limit - position) min: (requestedCount - read).
		collection 
			replaceFrom: offset + read 
			to: offset + read + toRead - 1 
			with: chunk 
			startingAt: position + 1.
		read := read + toRead.
		position := position + toRead ].
	^ read! !

!ZnChunkedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/2/2012 16:02'!
contents
	"This is technically not correct, but it is better than nothing"
	
	^ self upToEnd! !

!ZnChunkedReadStream class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/26/2010 19:43'!
on: stream
	^ self basicNew
		initialize;
		on: stream;
		yourself! !

!ZnChunkedReadStream class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/26/2010 14:10'!
new
	^ super new initialize! !

!ZnChunkedStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/17/2013 23:48'!
testReadingNext
	| data chunked plain |
	data := String withAll: ($a to: $z), ($A to: $Z).
	chunked := String streamContents: [ :stream |
		self nextPutAll: data on: stream chunked: 16 ].
	plain := (ZnChunkedReadStream on: chunked readStream) next: 26 + 26.
	self assert: plain equals: data! !

!ZnChunkedStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/17/2013 15:43'!
testWriting
	| chunks result reference |
	chunks := #( 'ABC' 'DEF' 'GHI' 'JKL' ).
	result := String streamContents: [ :out |
		| stream |
		stream := ZnChunkedWriteStream on: out.
		chunks do: [ :each | stream nextPutAll: each ].
		stream finish ].
	reference := String streamContents: [ :out |
		self nextPutAll: (String new join: chunks) on: out chunked: 3 ].
	self assert: result equals: reference! !

!ZnChunkedStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/17/2013 23:47'!
testReading
	| data chunked plain |
	data := String withAll: ($a to: $z), ($A to: $Z).
	chunked := String streamContents: [ :stream |
		self nextPutAll: data on: stream chunked: 16 ].
	plain := (ZnChunkedReadStream on: chunked readStream) upToEnd.
	self assert: plain equals: data! !

!ZnChunkedStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/17/2013 23:47'!
testReadingGzipStepped
	| data gzipped chunked unchunked ungzipped |
	data := String withAll: ($a to: $z), ($A to: $Z).
	gzipped := String streamContents: [ :stream |
		(GZipWriteStream on: stream) nextPutAll: data; close ].
	chunked := String streamContents: [ :stream |
		self nextPutAll: gzipped on: stream chunked: 16 ].
	unchunked := (ZnChunkedReadStream on: chunked readStream) upToEnd.
	ungzipped := (GZipReadStream on: unchunked) upToEnd.
	self assert: gzipped equals: unchunked.
	self assert: data equals: ungzipped ! !

!ZnChunkedStreamTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/17/2013 15:48'!
nextPutAll: collection on: stream chunked: size
	| written |
	written := 0.
	[ written < collection size ] whileTrue: [ | chunkSize |
		chunkSize := size min: (collection size - written).
		chunkSize printOn: stream base: 16.
		stream nextPutAll: String crlf.
		chunkSize timesRepeat: [ stream nextPut: (collection at: (written := written + 1)) ].
		stream nextPutAll: String crlf ].
	stream print: 0; nextPutAll: String crlf; nextPutAll: String crlf! !

!ZnChunkedStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/17/2013 23:47'!
testReadingGzip
	| data gzipped chunked plain |
	data := String withAll: ($a to: $z), ($A to: $Z).
	gzipped := String streamContents: [ :stream |
		(GZipWriteStream on: stream) nextPutAll: data; close ].
	chunked := String streamContents: [ :stream |
		self nextPutAll: gzipped on: stream chunked: 16 ].
	plain := (GZipReadStream on: (ZnChunkedReadStream on: chunked readStream)) upToEnd.
	self assert: data equals: plain ! !

!ZnChunkedStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/17/2013 15:37'!
testReadingBuffered
	| data chunked plain buffer readStream |
	data := String withAll: ($a to: $z), ($A to: $Z).
	chunked := String streamContents: [ :stream |
		self nextPutAll: data on: stream chunked: 16 ].
	readStream := ZnChunkedReadStream on: chunked readStream.
	buffer := String new: 11.
	plain := String streamContents: [ :output | | readCount |
		[ readStream atEnd ] whileFalse: [
			readCount := readStream readInto: buffer startingAt: 1 count: buffer size.
			output next: readCount putAll: buffer ] ].
	self assert: plain equals: data! !

!ZnChunkedStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/17/2013 16:26'!
testBinaryWriteRead
	| data written read |
	data := ByteArray new: 1024 streamContents: [ :out |
		1024 timesRepeat: [ out nextPut: 256 atRandom - 1 ] ].
	written := ByteArray streamContents: [ :out |
		| stream |
		stream := ZnBufferedWriteStream on: (ZnChunkedWriteStream on: out).
		stream sizeBuffer: 256.
		1 to: 1024 by: 256 do: [ :each |
			stream next: 256 putAll: data startingAt: each ].
		stream close ].
	read := (ZnChunkedReadStream on: written readStream) upToEnd.
	self assert: read equals: data! !

!ZnChunkedStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/17/2013 15:57'!
testWritingBuffered
	| data written read |
	data := String withAll: ($a to: $z), ($A to: $Z).
	written := String streamContents: [ :out |
		| stream |
		stream := ZnBufferedWriteStream on: (ZnChunkedWriteStream on: out).
		stream sizeBuffer: 16.
		stream nextPutAll: data.
		stream close ].
	read := (ZnChunkedReadStream on: written readStream) upToEnd.
	self assert: read equals: data! !

!ZnChunkedStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/18/2013 13:59'!
testGzipWriteRead
	| data written read |
	data := String streamContents: [ :out |
		{ Collection. Stream. Exception. Magnitude } do: [ :cls |
			cls allSubclassesDo: [ :each | out nextPutAll: each comment ] ] ].
	data := data asByteArray.
	written := ByteArray streamContents: [ :out |
		| stream chunkedStream |
		stream := GZipWriteStream on: (chunkedStream := ZnChunkedWriteStream on: out).
		stream nextPutAll: data.
		stream finish.
		chunkedStream finish ].
	read := (GZipReadStream on: (ZnChunkedReadStream on: written readStream)) upToEnd.
	self assert: read equals: data! !

!ZnChunkedStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/17/2013 23:48'!
testReadingNextInto
	| data chunked plain |
	data := String withAll: ($a to: $z), ($A to: $Z).
	chunked := String streamContents: [ :stream |
		self nextPutAll: data on: stream chunked: 16 ].
	plain := String new: 26 + 26.
	(ZnChunkedReadStream on: chunked readStream) next: 26 + 26 into: plain.
	self assert: plain equals: data! !

!ZnChunkedWriteStream commentStamp: '<historical>'!
I am ZnChunkedWriteStream, I wrap another write stream and add HTTP 1.1 chunked transfer encoding.

I write a chunk for each #nextPutAll: or #next:putAll:startingAt:
I should be wrapped in a ZnBufferedWriteStream for #next: to work.
When done, send #close or #finish to me.

Part of Zinc HTTP Components.
!
!ZnChunkedWriteStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/17/2013 15:10'!
binary
	stream binary! !

!ZnChunkedWriteStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/17/2013 15:09'!
close
	self finish.
	stream close! !

!ZnChunkedWriteStream methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/17/2013 16:22'!
crlf
	stream nextPutAll: (self isBinary ifTrue: [ #[ 13 10 ] ] ifFalse: [ String crlf ])! !

!ZnChunkedWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/18/2013 00:23'!
next: count putAll: collection
	self 
		next: count 
		putAll: collection 
		startingAt: 1! !

!ZnChunkedWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/18/2013 21:02'!
nextPut: element
	self error: 'Wrap me into a buffered stream, because each #nexPut: will create a new chunk'! !

!ZnChunkedWriteStream methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/17/2013 15:25'!
isBinary
	^ stream isBinary
! !

!ZnChunkedWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/18/2013 00:37'!
chunkCount
	^ chunkCount! !

!ZnChunkedWriteStream methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 5/18/2013 00:35'!
initialize
	super initialize.
	totalSize := 0.
	chunkCount := 0! !

!ZnChunkedWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 3/2/2014 22:21'!
extraHeaders
	^ extraHeaders ifNil: [ extraHeaders := ZnHeaders new ]! !

!ZnChunkedWriteStream methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/18/2013 00:12'!
isStream
	^ true! !

!ZnChunkedWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/18/2013 00:28'!
position
	^ totalSize! !

!ZnChunkedWriteStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/17/2013 15:09'!
flush
	stream flush! !

!ZnChunkedWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/18/2013 00:26'!
nextPutAll: collection
	self 
		next: collection size
		putAll: collection
		startingAt: 1! !

!ZnChunkedWriteStream methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/17/2013 15:28'!
writeChunkSize: size
	stream nextPutAll: (self isBinary ifTrue: [ size printStringHex asByteArray ] ifFalse: [ size printStringHex ]).
	self crlf! !

!ZnChunkedWriteStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/17/2013 15:08'!
on: writeStream
	stream := writeStream! !

!ZnChunkedWriteStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/18/2013 00:35'!
next: count putAll: collection startingAt: offset
	self writeChunkSize: count.
	stream next: count putAll: collection startingAt: offset.
	self crlf.
	chunkCount := chunkCount + 1.
	totalSize := totalSize + count
! !

!ZnChunkedWriteStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/17/2013 15:31'!
finish
	self writeChunkSize: 0.
	self crlf.
	extraHeaders ifNotNil: [ extraHeaders writeOn: stream ]! !

!ZnChunkedWriteStream class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 5/17/2013 15:08'!
on: writeStream
	^ self new
		on: writeStream;
		yourself! !

!ZnClient commentStamp: 'SvenVanCaekenberghe 11/8/2011 22:31'!
I am ZnClient, an object to build, execute and process HTTP client requests.

I have a rich protocol to construct requests and to access responses.
I have various error handling options.
I can reuse an existing connection to a specific host:port.
I handle sessions, cookies, redirects and authentication.
I have many options (settings) with sensible defaults.

Simplest possible invocation:

	ZnClient new
		get: 'http://zn.stfx.eu/zn/numbers.txt'.
	
Using some features to make a better HTTP request:

	ZnClient new
		systemPolicy;
		accept: ZnMimeType textPlain;
		http;
		host: 'zn.stfx.eu';
		path: 'zn/numbers.txt';
		contentReader: [ :entity | entity contents lines collect: [ :each | each asNumber ] ];
		ifFail: [ :exception | self inform: 'I am sorry: ', exception printString ];
		get.

Part of Zinc HTTP Components.!
!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 9/30/2012 20:53'!
setAcceptEncodingGzip
	"Give the server the hint that we accept gzip content encoding.
	When the server complies, important bandwidth reductions are possible."

	self request setAcceptEncodingGzip! !

!ZnClient methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 11/8/2011 19:12'!
put: url contents: object
	"Execute an HTTP PUT request on url with object as request #contents:
	and return the response #contents."

	^ self 
		url: url; 
		contents: object; 
		put! !

!ZnClient methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/8/2011 19:17'!
isSuccess 
	"Return true it the last executed HTTP request returned an HTTP success response code."
	
	^ response 
		ifNil: [ self error: 'Request not yet executed' ]
		ifNotNil: [ response isSuccess ]! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 3/2/2014 18:42'!
headerAddAll: keyedCollection
	"Add all key/value pairs of keyedCollection as headers.
	Note that #addAllMulti: is used"
	
	request headers 
		addAll: keyedCollection ! !

!ZnClient methodsFor: 'testing' stamp: 'ChristopheDemarey 12/11/2014 10:24'!
isBadRequest
	"Return true if the last executed HTTP request returned an HTTP bad request response code."
	
	^ response 
		ifNil: [ self error: 'Request not yet executed' ]
		ifNotNil: [ response isBadRequest ]! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 10/17/2014 13:18'!
certificate
	"Return the TLS/SSL certificate to be used, or nil for none."
	
	^ self optionAt: #certificate ifAbsent: [ nil ]! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 11/23/2011 17:23'!
maxNumberOfRedirects
	"Return the maximum number of HTTP redirect that will be followed.
	Note that when the #followsRedirect option is false, 
	no redirects will ever be followed regardless of the value of this option.
	Defaults to 3. A ZnTooManyRedirects will be signalled when the count reaches zero."

	^ self optionAt: #maxNumberOfRedirects ifAbsent: [ 3 ]! !

!ZnClient methodsFor: 'private protocol' stamp: 'SvenVanCaekenberghe 6/12/2014 20:04'!
readResponse
	self signalHTTPProgress: 'Reading response'.
	response := request method = #HEAD
		ifTrue: [ ZnResponse readHeaderFrom: connection ]
		ifFalse: [ 
			self streaming
				ifTrue: [ ZnResponse readStreamingFrom: connection ]
				ifFalse: [ ZnResponse readFrom: connection ] ].
	lastUsed := Time totalSeconds! !

!ZnClient methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 7/2/2012 16:19'!
uploadEntityFrom: path
	"Set up a ZnStreamingEntity from the binary contents of the file at path.
	The path extension is used to guess the content-type,
	can be overridden using #contentType: if necessary.
	Use the file's length to set the content-length.
	You can then use #put or #post to actually do an upload."
	
	| stream type length |
	stream := ZnFileSystemUtils fileStreamFor: path.
	stream binary.
	type := ZnMimeType forFilenameExtension: (ZnFileSystemUtils extensionFor: path).
	length := ZnFileSystemUtils fileSizeFor: path.
	self entity: (ZnStreamingEntity readFrom: stream usingType: type andLength: length)! !

!ZnClient methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 6/12/2014 19:48'!
initialize
	request := ZnRequest empty.
	self loggingOn ! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 3/2/2014 18:47'!
resetEntity
	"Make sure that the current request does not hold an entity from a previous request.
	This is sometimes necessary after a POST or PUT. This method will be called automatically
	by #method: for certain requests."
	
	(request notNil and: [ request hasEntity ])
		ifTrue: [ request resetEntity: nil ]! !

!ZnClient methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 5/7/2013 16:04'!
curl
	"Create and return a curl command line invocation equivalent to the current request."
	"ZnClient new url: 'http://zn.stfx.eu/zn/small.html'; method: #GET; curl."
	"ZnClient new url: 'http://zn.stfx.eu/echo'; contents: #[2 4 6 8]; method: #POST; curl."
	
	self prepareRequest.
	^ String streamContents: [ :stream |
		request hasEntity ifTrue: [ 
			 stream << 'echo ' << request entity asByteArray hex << ' | xxd -r -p | ' ].
		stream << 'curl'.
		request method = #GET ifFalse: [ stream << ' -X ' << request method ].
		stream space; print: request uri.
		request headersDo: [ :key :value |
			stream << ' -H"' << key << ':' << value << '"' ].
		request hasEntity ifTrue: [ stream << ' --data-binary @-' ] ]! !

!ZnClient methodsFor: 'accessing response' stamp: 'SvenVanCaekenberghe 11/8/2011 18:58'!
response 
	"Answer the last response, assuming the current request was executed."

	^ response ! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 5/30/2012 21:31'!
timeout: seconds
	"Set the timeout for network socket stream operations
	like connecting, reading and writing to seconds."

	self optionAt: #timeout put: seconds! !

!ZnClient methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/12/2012 10:25'!
isNotFound
	"Return true it the last executed HTTP request returned an HTTP not found response code."
	
	^ response 
		ifNil: [ self error: 'Request not yet executed' ]
		ifNotNil: [ response isNotFound ]! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 11/8/2011 17:30'!
applicationFormUrlEncodedEntity
	"Initialize the current request to have an application/x-www-form-urlencoded entity.
	Return the existing entity if there is one. 
	Fail if another type was already set."
	
	request hasEntity
		ifTrue: [
			request entity contentType = ZnMimeType applicationFormUrlEncoded 
				ifFalse: [ self error: 'An incompatible entity was already set for the request' ] ]
		ifFalse: [
			request entity: ZnApplicationFormUrlEncodedEntity new ].
	^ request entity! !

!ZnClient methodsFor: 'private logging' stamp: 'SvenVanCaekenberghe 6/12/2014 19:51'!
logConnectionClosedAddress: address port: port
	logLevel < 3 ifTrue: [ ^ nil ].
	^ (self newLogEvent: ZnClientConnectionClosedEvent)
		address: address;
		port: port;
		emit! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 11/8/2011 20:58'!
streaming
	"Return whether I will return streaming response objects (see ZnStreamingEntity).
	If true, my users are responsible for actually reading the incoming response entity data stream."
	
	^ self optionAt: #streaming ifAbsent: [ false ]! !

!ZnClient methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 11/8/2011 19:13'!
head
	"Execute a HTTP HEAD ont the request set up and return nil."

	^ self 
		method: #HEAD; 
		execute! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 11/23/2011 16:59'!
dontFollowRedirects
	"Disable the default automatic following of HTTP redirects.
	Redirects will be returned as normal responses."

	^ self followRedirects: false! !

!ZnClient methodsFor: 'private' stamp: 'SvenVanCaekenberghe 6/12/2014 20:09'!
retryExceptionSet
	^ NetworkError, ZnParseError, ZnCharacterEncodingError, ZnUnknownScheme, ZnPortNotANumber! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 11/8/2011 17:33'!
request
	"Return the current request that I am building,
	or the previous request that I executed."
	
	^ request ! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 2/21/2013 15:57'!
prepareRequest: hook
	"Set the current request preparation hook, an object conforming 
	to the #value: protocol that gets the final chance to change a request 
	right before it gets executed. Defaults to nil.
	Typically used to sign requests. See also #prepareRequestHook "

	^ self optionAt: #prepareRequestHook put: hook! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 11/8/2011 17:19'!
formAdd: association
	"Add the key->value association to the application/x-www-form-urlencoded 
	entity of the current request."
	
	self applicationFormUrlEncodedEntity 
		add: association ! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 11/8/2011 17:27'!
https
	"Set the scheme of the current request to HTTPS."
	
	self url: (ZnUrl new scheme: #https; yourself)! !

!ZnClient methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 11/8/2011 19:13'!
get
	"Execute an HTTP GET ont the request set up and return the response #contents."
	
	^ self 
		method: #GET; 
		execute! !

!ZnClient methodsFor: 'logging' stamp: 'SvenVanCaekenberghe 6/16/2014 14:59'!
logToTranscript
	"Setup logging to the Transcript.
	If logging was completely off, turn it on"

	logLevel isZero ifTrue: [ self loggingOn ].
	ZnLogEvent logToTranscript ! !

!ZnClient methodsFor: 'private' stamp: 'SvenVanCaekenberghe 8/19/2011 16:55'!
withTimeoutDo: block
	^ ZnConnectionTimeout value
		ifNil: [
			ZnConnectionTimeout 
				value: self timeout 
				during: [ ^ block value ] ]
		ifNotNil: [ 
			block value ]! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 11/8/2011 17:27'!
http
	"Set the scheme of the current request to HTTP."
	
	self url: (ZnUrl new scheme: #http; yourself)! !

!ZnClient methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 11/8/2011 19:13'!
delete
	"Execute a HTTP DELETE ont the request set up and return the response #contents."
	
	^ self 
		method: #DELETE; 
		execute! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 5/9/2012 09:21'!
contentType: mimeType
	"Set the content-type of the request entity, provided we have one"
	
	request hasEntity
		ifTrue: [ 
			request entity contentType: mimeType asZnMimeType ]
		ifFalse: [ 
			self error: 'There is no request entity yet, cannot set its content-type' ]! !

!ZnClient methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/30/2012 21:30'!
optionAt: key put: value
	"Set my option/setting identified by key to be value.
	This is a generic interface, see my options protocol for specific usages."
	
	options ifNil: [ options := Dictionary new ].
	options at: key put: value! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 9/27/2012 14:26'!
streaming: boolean
	"Set whether I will return streaming response objects (see ZnStreamingEntity) to boolean.
	If true, my users are responsible for actually reading the incoming response entity data stream.
	I cannot do streaming when #isOneShot is true because the stream would be closed too soon."

	(boolean and: [ self isOneShot ])
		ifTrue: [ self error: 'I cannot do streaming when #isOneShot is true.' ].
	self optionAt: #streaming put: boolean! !

!ZnClient methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 11/8/2011 19:05'!
head: url
	"Execute an HTTP HEAD request on url and return nil."

	^ self 
		url: url; 
		head! !

!ZnClient methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 11/8/2011 19:13'!
post
	"Execute a HTTP POST ont the request set up and return the response #contents."

	^ self 
		method: #POST; 
		execute! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 11/23/2011 17:23'!
maxNumberOfRedirects: count
	"Set the maximum number of HTTP redirect that will be followed to count.
	Note that when the #followsRedirect option is false, 
	no redirects will ever be followed regardless of the value of this option.
	A ZnTooManyRedirects will be signalled when the count reaches zero."

	self optionAt: #maxNumberOfRedirects put: count! !

!ZnClient methodsFor: 'logging' stamp: 'SvenVanCaekenberghe 6/12/2014 20:12'!
logLevel: integer
	"Set the log level to integer.
	0 - no logging
	1 - simplified transaction logging
	2 - detailed transaction logging
	3 - log everything"
	
	logLevel := integer! !

!ZnClient methodsFor: 'logging' stamp: 'SvenVanCaekenberghe 6/12/2014 20:13'!
loggingOff
	"Turn logging completely off - do not generate log events."
	
	self logLevel: 0! !

!ZnClient methodsFor: 'private logging' stamp: 'SvenVanCaekenberghe 6/11/2014 15:35'!
newLogEvent: logEventClass
	^ logEventClass new
		clientId: self clientId;
		yourself! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 3/2/2014 18:54'!
method: httpMethod
	"Set the HTTP method of the current request to httpMethod.
	An uppercase symbol such as #GET is expected.
	Note that for all methods in #autoResetEntityMethods #resetEntity is called automatically,
	since you don't want the entity of a previous request to be sent again"

	(self autoResetEntityMethods includes: httpMethod)
		ifTrue: [ self resetEntity ].
	request method: httpMethod! !

!ZnClient methodsFor: 'private protocol' stamp: 'SvenVanCaekenberghe 6/12/2014 16:12'!
prepareRedirect
	"We implement the common behavior that POST/PUT redirects turn into GET request.
	Note also that the body data is dropped, as well as the cookie handling."

	| targetUrl |
	targetUrl := self redirectUrl.
	self logRedirect: targetUrl.
	self receiveCookies.
	self prepareNextRequest.
	(#(POST PUT) includes: request method)
		ifTrue: [ self method: #GET ].
	request hasEntity
		ifTrue: [ request resetEntity: nil ].
	self url: targetUrl.
	self sendCookies! !

!ZnClient methodsFor: 'cleanup' stamp: 'SvenVanCaekenberghe 2/11/2015 15:26'!
close
	"Close any HTTP network connection that I might have kept open."

	connection
		ifNotNil: [ 
			| address port |
			address := [ connection socket remoteAddress ] on: Error do: [ nil ].
			port := [ connection socket remotePort ] on: Error do: [ nil ].
			connection close.
			connection := nil.
			self logConnectionClosedAddress: address port: port ].
	lastUsed := nil! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 11/8/2011 17:03'!
addPath: object
	"Extend the path of the current request with object.
	Either a string or a collection of strings is allowed as argument."
	
	object isString
		ifTrue: [ self addPathSegment: object ] 
		ifFalse: [ object do: [ :each | self addPathSegment: each ] ]! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 9/27/2012 14:29'!
beOneShot
	"Switch me to use connections only for a single request/response cycle.
	By default, I will keep HTTP connections open according to the HTTP 1.1 spec.
	When oneShot is true, I will add a Connection: close header to requests and close after one cycle.
	I cannot be one shot when #streaming is true because the stream would be closed too soon."
	
	self streaming
		ifTrue: [ self error: 'I cannot be one shot when #streaming is true.' ].
	self optionAt: #oneShot put: true   ! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 12/14/2011 14:03'!
timeout
	"Return the timeout in seconds for network socket stream operations
	like connecting, reading and writing. Defaults to a global setting."
	
	^ self optionAt: #timeout ifAbsent: [ ZnNetworkingUtils defaultSocketStreamTimeout ]! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 11/8/2011 20:30'!
isOneShot
	"Return if I use connections only for a single request/response cycle.
	By default, I will keep HTTP connections open according to the HTTP 1.1 spec.
	When oneShot is true, I will add a Connection: close header to requests."

	^ self optionAt: #oneShot ifAbsent: [ false ]! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 11/8/2011 20:33'!
retryDelay
	"Return the number of seconds I will delay retrying a failed request,
	provided I do retry requests. Defaults to 1 seconds."
	
	^ self optionAt: #retryDelay ifAbsent: [ 1 ]! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 11/8/2011 17:14'!
entity: entity
	"Set the entity of the current request to enity.
	A ZnEntity subclass or compatible object is expected."
	
	request entity: entity! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 11/8/2011 20:45'!
signalProgress: boolean
	"Set whether I will signal HTTPProgress notifications during execution to boolean."
	
	self optionAt: #signalProgress put: boolean! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 11/8/2011 17:32'!
port: portNumber
	"Set the port of the current request to portNumber."
	
	self url: (ZnUrl new port: portNumber; yourself)! !

!ZnClient methodsFor: 'private protocol' stamp: 'SvenVanCaekenberghe 6/12/2014 16:05'!
prepareNextRequest
	"The request could be modified destructively in the next run,
	but the request can also be part of a log event, hence copy it"
	request := request copy	
! !

!ZnClient methodsFor: 'private logging' stamp: 'SvenVanCaekenberghe 6/12/2014 14:38'!
logRedirect: url
	^ (self newLogEvent: ZnClientFollowingRedirectEvent)
		target: url;
		emit! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 11/8/2011 17:21'!
formAt: key put: value
	"Set key equal to value in the application/x-www-form-urlencoded 
	entity of the current request."

	self applicationFormUrlEncodedEntity 
		at: key put: value! !

!ZnClient methodsFor: 'private' stamp: 'SvenVanCaekenberghe 8/18/2011 14:10'!
cleanupConnection
	(self isOneShot or: [ request notNil and: [ request wantsConnectionClose ] ])
		ifTrue: [
			self close ]! !

!ZnClient methodsFor: 'private' stamp: 'SvenVanCaekenberghe 2/11/2013 11:24'!
canReuseConnection
	self isConnected ifFalse: [ ^ false ].
	lastUsed ifNil: [ ^ false ].
	^ Time totalSeconds - lastUsed < self connectionReuseTimeout! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 12/12/2012 10:19'!
headerAt: key put: value
	"Set key equals value in the HTTP header of the current request"
	
	request headers 
		at: key put: value   ! !

!ZnClient methodsFor: 'private protocol' stamp: 'SvenVanCaekenberghe 6/12/2014 16:18'!
handleResponse
	self receiveCookies.
	(self enforceHttpSuccess and: [ response isSuccess not ])
		ifTrue: [ 
			(self followRedirects not and: [ response isRedirect ])
				ifFalse: [ (ZnHttpUnsuccessful response: response) signal ] ].
	(self enforceAcceptContentType and: [ self isContentTypeAcceptable not ])
		ifTrue: [ 
			(ZnUnexpectedContentType 
				expected: request accept asZnMimeType 
				actual: response contentType) signal ].
	^ self contents! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 11/8/2011 19:41'!
contentReader
	"Return the current content reader, an object conforming 
	to the #value: protocol to convert a response entity
	as used by #contents. Defaults to nil.
	Can be used to parse incoming data."
	
	^ self optionAt: #contentReader ifAbsent: [ nil ]! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 6/11/2014 15:34'!
clientId
	"Return the id for this HTTP client. Defaults to nil.
	Can be used identify different clients' log events."
	
	^ self optionAt: #clientId ifAbsent: [ nil ]! !

!ZnClient methodsFor: 'private logging' stamp: 'SvenVanCaekenberghe 6/13/2014 13:24'!
logClientTransactionRequestDuration: requestDuration responseDuration: responseDuration
	| logEventClass |
	logLevel < 1 ifTrue: [ ^ nil ].
	logEventClass := logLevel = 1
		ifTrue: [ ZnSimplifiedClientTransactionEvent ]
		ifFalse: [ ZnClientTransactionEvent ].
	^ (self newLogEvent: logEventClass)
		request: request;
		requestDuration: requestDuration;
		response: response; 
		responseDuration: responseDuration;
		emit;
		yourself! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 11/8/2011 17:03'!
addPathSegment: pathSegment
	"Extend the path of the current request with a single pathSegment."
	
	request url 
		ifNil: [ request url: (ZnUrl new addPathSegment: pathSegment; yourself) ]
		ifNotNil: [ request url addPathSegment: pathSegment ]  ! !

!ZnClient methodsFor: 'private protocol' stamp: 'SvenVanCaekenberghe 11/23/2011 17:01'!
executeWithRedirectsRemaining: redirectCount
	self getConnectionAndExecute.
	response isRedirect 
		ifTrue: [
			(redirectCount > 0 and: [ self followRedirects ])
				ifTrue: [
					self 
						prepareRedirect; 
						executeWithRedirectsRemaining: redirectCount - 1 ]
				ifFalse: [
					self followRedirects 
						ifTrue: [ ZnTooManyRedirects signal ] ] ].
	^ self handleResponse
	! !

!ZnClient methodsFor: 'private' stamp: 'SvenVanCaekenberghe 6/11/2014 15:41'!
sendCookies
	| cookies cookiesString |
	session ifNil: [ ^ self ].
	cookies := (session cookieJar cookiesForUrl: request url).
	cookies isEmpty ifTrue: [ ^ self ]. 
	cookiesString := String streamContents: [ :stream |
		cookies
			do: [ :each | each writeNameAndValueOn: stream ]
			separatedBy: [ stream nextPutAll: '; ' ] ].
	request setCookie: cookiesString! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 11/8/2011 17:34'!
request: aRequest
	"Replace my current request with aRequest.
	This is a low level operation only needed in special cases."
	
	self validateConnectionForHost: aRequest url host port: aRequest url port.
	request := aRequest! !

!ZnClient methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 8/18/2011 15:07'!
debugPolicy
	self 
		beOneShot! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 11/8/2011 20:27'!
enforceAcceptContentType
	"Return whether or not I enforce that the content type of the
	response matches the content type specified in the accept request header."
	
	^ self optionAt: #enforceAcceptContentType ifAbsent: [ false ]! !

!ZnClient methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/8/2011 19:14'!
isConnected
	"Return true if I hold an open HTTP connection."

	^ connection notNil and: [ connection isConnected ]! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 10/17/2014 13:20'!
certificate: anObject
	"Set the TLS/SSL certificate to be used to anObject, or nil for none.
	See ZdcAbstractSSLSession>>#certificateName: for more information."
	
	^ self optionAt: #certificate put: anObject! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 11/8/2011 20:28'!
enforceHttpSuccess: boolean
	"Set whether or not I enforce that the response 
	to the request is an HTTP success code to boolean."

	self optionAt: #enforceHttpSuccess put: boolean! !

!ZnClient methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 11/8/2011 19:12'!
post: url contents: object
	"Execute an HTTP POST request on url with object as request #contents:
	and return the response #contents."

	^ self 
		url: url; 
		contents: object; 
		post! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 11/8/2011 20:31'!
numberOfRetries
	"Return how many times I will retry a failed request.
	Defaults to 0."
	
	^ self optionAt: #numberOfRetries ifAbsent: [ 0 ]! !

!ZnClient methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/23/2011 17:17'!
isRedirect
	"Return true it the last executed HTTP request returned an HTTP redirect response code."
	
	^ response 
		ifNil: [ self error: 'Request not yet executed' ]
		ifNotNil: [ response isRedirect ]! !

!ZnClient methodsFor: 'private logging' stamp: 'SvenVanCaekenberghe 6/12/2014 19:53'!
logRequestWrittenStarted: initialMilliseconds
	^ logLevel < 3
		ifTrue: [ Time millisecondsSince: initialMilliseconds ]
		ifFalse: [ 
			(self newLogEvent: ZnRequestWrittenEvent)
				request: request;
				duration: (Time millisecondsSince: initialMilliseconds);
				emit;
				duration ]! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 11/8/2011 20:27'!
enforceAcceptContentType: boolean
	"Set whether or not I enforce that the content type of the
	response matches the content type specified in the accept request
	header to boolean."

	self optionAt: #enforceAcceptContentType put: boolean! !

!ZnClient methodsFor: 'accessing response' stamp: 'SvenVanCaekenberghe 11/8/2011 18:58'!
entity
	"Answer the entity or HTTP payload of the last response, 
	assuming the current request was executed."
	
	^ response ifNotNil: [ response entity ]  ! !

!ZnClient methodsFor: 'private' stamp: 'SvenVanCaekenberghe 6/12/2014 14:32'!
signalHTTPProgress: message
	self signalProgress
		ifTrue: [ HTTPProgress signal: message ]! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 11/8/2011 17:20'!
formAddAll: keyedCollection
	"Add all key->value associations of keyedCollection to 
	the application/x-www-form-urlencoded entity of the current request."

	self applicationFormUrlEncodedEntity 
		addAll: keyedCollection ! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 11/8/2011 17:13'!
contents: object
	"Set the entity contents of the current request to object.
	I will pass this through my contentWriter if I have one.
	Otherwise I delegate to ZnEntity to convert object to a generic entity."
	
	self contentWriter 
		ifNil: [ self entity: (ZnEntity with: object) ]
		ifNotNil: [ :writer | self entity: (writer value: object) ]! !

!ZnClient methodsFor: 'private' stamp: 'SvenVanCaekenberghe 8/12/2011 13:23'!
validateConnectionForHost: host port: port
	(connection isNil or: [ request url isNil ]) 
		ifTrue: [ ^ self ].
	(request url host = host and: [ request url port = port ])
		ifFalse: [ self close ]  ! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 11/8/2011 17:35'!
username: username password: password
	"Set the username/password for basic authenticationfor the current request."
	
	self setBasicAuthenticationUsername: username password: password
! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 9/30/2012 20:59'!
setIfModifiedSince: reference
	"Tell the server that we are only interested in the currently requested URI
	if it was modified since reference, a DateAndTime.
	If the URI was not modified since reference, the response will be #isNotModified."

	self request setIfModifiedSince: reference! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 11/8/2011 19:42'!
contentWriter
	"Return the current content writer, an object conforming 
	to the #value: protocol to convert an object to a request content entity
	as used by #contents:. Defaults to nil.
	Can be used to format data to be uploaded."

	^ self optionAt: #contentWriter ifAbsent: [ nil ]! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 12/12/2012 10:19'!
headerAt: key add: value
	"Add value to key in the HTTP header of the current request.
	This is for multi-values headers."
	
	request headers 
		at: key add: value! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 2/21/2013 15:57'!
prepareRequestHook
	"Return the current request preparation hook, an object conforming 
	to the #value: protocol that gets the final chance to change a request 
	right before it gets executed. Defaults to nil.
	Typically used to sign requests. See also #prepareRequest: "

	^ self optionAt: #prepareRequestHook ifAbsent: [ nil ]! !

!ZnClient methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 11/8/2011 19:04'!
get: url
	"Execute an HTTP GET request on url and return the response #contents."

	^ self 
		url: url; 
		get! !

!ZnClient methodsFor: 'private protocol' stamp: 'SvenVanCaekenberghe 6/12/2014 20:04'!
writeRequest
	self signalHTTPProgress: 'Writing request'.
	request writeOn: connection.
	connection flush! !

!ZnClient methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 11/8/2011 19:14'!
put
	"Execute a HTTP PUT ont the request set up and return the response #contents."

	^ self 
		method: #PUT; 
		execute! !

!ZnClient methodsFor: 'private protocol' stamp: 'SvenVanCaekenberghe 6/12/2014 20:06'!
getConnectionAndExecute
	self canReuseConnection 
		ifTrue: [ 
			[ ^ self executeRequestResponse; cleanupConnection ] 
				on: Exception 
				do: [ :exception | self logIgnoringExceptionOnReusedConnection: exception; close ] ].
	self newConnectionTo: request url.
	[ self executeRequestResponse ]
		ensure: [ self cleanupConnection ]! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 3/2/2014 18:40'!
accept: mimeTypeObject
	"Set the Accept HTTP header to mimeTypeObject for the current request."

	| mimeType |
	mimeType := mimeTypeObject asZnMimeType.
	self request setAccept: mimeType! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 6/11/2014 15:35'!
clientId: anObject
	"Set the id for this HTTP client to anObject. Defaults to nil.
	Can be used identify different clients' log events."
	
	^ self optionAt: #clientId put: anObject! !

!ZnClient methodsFor: 'private' stamp: 'SvenVanCaekenberghe 6/11/2014 15:40'!
receiveCookies
	response cookies do: [ :each |
		each defaultDomain: request url host.
		self session cookieJar add: each ]! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 5/30/2012 21:30'!
contentReader: object
	"Set the content reader, an object conforming 
	to the #value: protocol to convert a response entity
	as used by #contents to object.
	Can be used to parse incoming data."

	self optionAt: #contentReader put: object! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 3/2/2014 18:51'!
autoResetEntityMethods: methods
	"Set the collection of HTTP methods for which to auto #resetEntity.
	The default is to do this only for HEAD and DELETE, although most people 
	would want it for GET too, but this can be used for forms"
	
	^ self optionAt: #autoResetEntityMethods put: methods! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 11/8/2011 17:18'!
addPart: mimePart
	"Add mimePart to the multipart/form-data entity of the current request"

	self multiPartFormDataEntity 
		addPart: mimePart ! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 11/8/2011 17:36'!
queryAddAll: keyedCollection
	"Add all key -> value elements of keyedCollection 
	as an HTTP query parameters to the current request."

	keyedCollection keysAndValuesDo: [ :key :value |
		self queryAt: key put: value ]! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 11/8/2011 17:43'!
path: pathString
	"Set the path of the current request to pathString.
	The argument will be merged with of the current/previous request."
	
	self url: pathString! !

!ZnClient methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/8/2011 16:54'!
session
	"Return the current HTTP session object that I am using.
	This session object holds cookies among other things."

	^ session ifNil: [ session := ZnUserAgentSession new ]! !

!ZnClient methodsFor: 'private protocol' stamp: 'SvenVanCaekenberghe 1/7/2013 09:57'!
redirectUrl
	"We support relative locations although they are not the standard (http://en.wikipedia.org/wiki/HTTP_location)"

	| redirectUrl |
	redirectUrl := response location asZnUrl.
	^ redirectUrl isAbsolute
		ifTrue: [ redirectUrl ]
		ifFalse: [ redirectUrl inContextOf: request url ]! !

!ZnClient methodsFor: 'private logging' stamp: 'SvenVanCaekenberghe 6/12/2014 19:51'!
logRetrying: exception
	logLevel < 3 ifTrue: [ ^ nil ].
	^ (self newLogEvent: ZnClientRetryingEvent)
		exception: exception;
		emit! !

!ZnClient methodsFor: 'private logging' stamp: 'SvenVanCaekenberghe 2/11/2015 15:26'!
logConnectionEstablishedTo: url started: initialMilliseconds
	logLevel < 3 ifTrue: [ ^ nil ].
	(self newLogEvent: ZnConnectionEstablishedEvent)
		hostname: url host;
		port: url portOrDefault;
		address: ([ connection socket remoteAddress ] on: Error do: [ nil ]);
		duration: (Time millisecondsSince: initialMilliseconds);
		emit! !

!ZnClient methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 7/19/2012 15:43'!
connection
	"Return the socket stream connection that I am currently using"
	
	^ connection! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 11/8/2011 20:27'!
enforceHttpSuccess
	"Return whether or not I enforce that the response 
	to the request is an HTTP success code."
	
	^ self optionAt: #enforceHttpSuccess ifAbsent: [ false ]! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 11/8/2011 20:44'!
signalProgress
	"Return true if I signal HTTPProgress notifications during execution."
	
	^ self optionAt: #signalProgress ifAbsent: [ false ]! !

!ZnClient methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 5/10/2012 22:21'!
downloadTo: path
	"Setup streaming, do a GET request and download the entity directly to a file.
	If path describes a file, use that. 
	If path describes a directory, use the last path segment of the URI to construct a file in that directory.
	Return true when successful, false otherwise."

	self 
		streaming: true; 
		get.
	^ self isSuccess
		ifTrue: [
			self downloadEntityTo: path.
			true ]
		ifFalse: [ 
			false ]! !

!ZnClient methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 8/19/2011 16:57'!
interactivePolicy
	self 
		beOneShot;
		ifFail: [ :exception | 
			self inform: 'HTTP call failed with ', exception printString.
			nil ]! !

!ZnClient methodsFor: 'private' stamp: 'SvenVanCaekenberghe 7/12/2012 21:06'!
withProgressDo: block
	^ ZnSignalProgress value
		ifNil: [
			ZnSignalProgress 
				value: self signalProgress 
				during: [ ^ block value ] ]
		ifNotNil: [ 
			block value ]! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 5/21/2013 22:31'!
multiPartFormDataEntity
	"Initialize the current request to have an multipart/form-data entity.
	Return the existing entity if there is one. 
	Fail if another type was already set."

	request hasEntity
		ifTrue: [
			(request entity contentType matches: ZnMimeType multiPartFormData)
				ifFalse: [ self error: 'An incompatible entity was already set for the request' ] ]
		ifFalse: [
			request entity: ZnMultiPartFormDataEntity new ].
	^ request entity! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 5/30/2012 21:30'!
connectionReuseTimeout: seconds
	"Set the timeout used to determine if I should try 
	to reuse an open connection to seconds."

	self optionAt: #connectionReuseTimeout put: seconds! !

!ZnClient methodsFor: 'private protocol' stamp: 'SvenVanCaekenberghe 9/17/2012 10:03'!
executeWithTimeout
	^ self withTimeoutDo: [ 
		[ self executeWithRetriesRemaining: self numberOfRetries ]
			on: Error
			do: self ifFailBlock ]! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 3/2/2014 18:39'!
setBasicAuthenticationUsername: username password: password
	"Set the username/password for basic authenticationfor the current request."
	
	self request setBasicAuthenticationUsername: username password: password
! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 5/30/2012 21:31'!
retryDelay: seconds
	"Set the delay before I will delay retrying a failed request to seconds,
	provided I do retry requests."

	self optionAt: #retryDelay put: seconds! !

!ZnClient methodsFor: 'logging' stamp: 'SvenVanCaekenberghe 6/12/2014 20:13'!
loggingOn
	"Turn full logging on - generate all log events"
	
	self logLevel: 3! !

!ZnClient methodsFor: 'private logging' stamp: 'SvenVanCaekenberghe 6/12/2014 19:51'!
logIgnoringExceptionOnReusedConnection: exception
	logLevel < 3 ifTrue: [ ^ nil ].
	^ (self newLogEvent: ZnClientIgnoringExceptionOnConnectionReuseEvent)
		exception: exception;
		emit! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 11/8/2011 20:29'!
ifFail: block
	"Set the block that I will be execute when the request fails.
	The exception of the failure will be passed as argument."
	
	self optionAt: #ifFailBlock put: block! !

!ZnClient methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/12/2012 10:26'!
isCreated
	"Return true it the last executed HTTP request returned an HTTP created response code."
	
	^ response 
		ifNil: [ self error: 'Request not yet executed' ]
		ifNotNil: [ response isCreated ]! !

!ZnClient methodsFor: 'private protocol' stamp: 'SvenVanCaekenberghe 6/12/2014 20:09'!
executeWithRetriesRemaining: retryCount
	^ [ self executeWithRedirectsRemaining: self maxNumberOfRedirects ]
		on: self retryExceptionSet
		do: [ :exception |
			retryCount > 0
				ifTrue: [
					self 
						handleRetry: exception;
						executeWithRetriesRemaining: retryCount - 1 ]
				ifFalse: [
					exception pass ] ]! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 5/30/2012 21:31'!
followRedirects: boolean
	"Set whether or not I will automatically following of HTTP redirects.
	This is still subject to #maxNumberOfRedirects. Defaults to true.
	When set to false, redirects will be returned as normal responses."

	self optionAt: #followRedirects put: boolean ! !

!ZnClient methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 8/18/2011 20:27'!
systemPolicy
	self 
		enforceHttpSuccess: true;
		enforceAcceptContentType: true;
		numberOfRetries: 2! !

!ZnClient methodsFor: 'private logging' stamp: 'SvenVanCaekenberghe 6/12/2014 19:53'!
logResponseReadStarted: initialMilliseconds
	^ logLevel < 3
		ifTrue: [ Time millisecondsSince: initialMilliseconds ]
		ifFalse: [ 
			(self newLogEvent: ZnResponseReadEvent)
				response: response;
				duration: (Time millisecondsSince: initialMilliseconds);
				emit;
				duration ]! !

!ZnClient methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/8/2011 19:17'!
isContentTypeAcceptable
	"Return true if the contentType of the response of the last executed 
	HTTP request matches the accept header of the request."
	
	^ response 
		ifNil: [ self error: 'Request not yet executed' ]
		ifNotNil: [ 
			response hasEntity not 
				or: [ response contentType matches: request accept asZnMimeType ] ]! !

!ZnClient methodsFor: 'private' stamp: 'SvenVanCaekenberghe 2/27/2015 15:39'!
newConnectionTo: url
	| initialMilliseconds proxied |
	self signalHTTPProgress: 'Connecting to ',  url authority.
	initialMilliseconds := Time millisecondClockValue.
	connection := ZnNetworkingUtils socketStreamToUrl: url.
	proxied := ZnNetworkingUtils shouldProxyUrl: url.
	"Note that the proxy server itself cannot be HTTPS"
	(proxied not and: [ #(https wss) includes: url scheme ]) 
		ifTrue: [
			self certificate ifNotNil: [ :certificate | 
				connection sslSession certificateName: certificate ].
			connection connect ].  
	self logConnectionEstablishedTo: url started: initialMilliseconds! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 3/2/2014 18:50'!
autoResetEntityMethods
	"Return a collection of HTTP methods for which to auto #resetEntity.
	The default is to do this only for HEAD and DELETE, although most people 
	would want it for GET too, but this can be used for forms"
	
	^ self optionAt: #autoResetEntityMethods ifAbsent: [ #(HEAD DELETE) ]! !

!ZnClient methodsFor: 'private protocol' stamp: 'SvenVanCaekenberghe 6/12/2014 14:37'!
handleRetry: exception
	self logRetrying: exception.
	self close.
	(Delay forSeconds: self retryDelay) wait.
! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 11/8/2011 20:31'!
numberOfRetries: count
	"Set the number of times I will retry a failed request to count."
	
	self optionAt: #numberOfRetries put: count! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 11/8/2011 17:26'!
host: hostName
	"Set the host of the current request to hostName."
	
	self url: (ZnUrl new host: hostName; yourself)! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 11/23/2011 16:58'!
followRedirects
	"Return whether I will automatically following of HTTP redirects.
	This is still subject to #maxNumberOfRedirects. Defaults to true.
	When set to false, redirects will be returned as normal responses."

	^ self optionAt: #followRedirects ifAbsent: [ true ]! !

!ZnClient methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 11/8/2011 19:04'!
delete: url
	"Execute an HTTP DELETE request on url and return the response #contents."
	
	^ self 
		url: url; 
		delete! !

!ZnClient methodsFor: 'private protocol' stamp: 'SvenVanCaekenberghe 6/12/2014 20:04'!
executeRequestResponse
	| initialMilliseconds requestDuration responseDuration |
	initialMilliseconds := Time millisecondClockValue.
	self writeRequest.
	requestDuration := self logRequestWrittenStarted: initialMilliseconds.
	initialMilliseconds := Time millisecondClockValue.
	self readResponse.
	responseDuration := self logResponseReadStarted: initialMilliseconds.
	self logClientTransactionRequestDuration: requestDuration responseDuration: responseDuration! !

!ZnClient methodsFor: 'private protocol' stamp: 'SvenVanCaekenberghe 2/21/2013 15:59'!
prepareRequest
	self isOneShot 
		ifTrue: [ request setConnectionClose ].
	request hasEntity
		ifTrue: [ 
			"This is necessary because entities are often modified after first being added empty,
			and a wrong content length is cached at the request level"
			request resetEntity: request entity ].
	self sendCookies.
	self prepareRequestHook 
		ifNotNil: [ :hook | hook value: request ]! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 9/17/2012 10:02'!
ifFailBlock
	"Return the block that I should execute if the request fails.
	Defaults to #pass-ing the exception up. 
	Accepts an exception as argument."
	
	^ self optionAt: #ifFailBlock ifAbsent: [ [ :exception | exception pass ] ]! !

!ZnClient methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 7/12/2012 21:46'!
downloadEntityTo: path
	"If I hold an entity, download it directly to a file.
	If path describes a file, use that. 
	If path describes a directory, use the last path segment of the URI to construct a file in that directory.."

	| target |
	self entity ifNil: [ ^ self ].
	target := ZnFileSystemUtils 
		downloadPathTo: path 
		for: self request uri lastPathSegment.
	ZnFileSystemUtils 
		newFileNamed: target 
		do:  [ :fileStream |
			fileStream binary.
			self withProgressDo: [
				self entity writeOn: fileStream ] ]! !

!ZnClient methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/30/2012 20:59'!
isNotModified
	"Return true it the last executed HTTP request returned an HTTP not modified response code."
	
	^ response 
		ifNil: [ self error: 'Request not yet executed' ]
		ifNotNil: [ response isNotModified ]! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 11/8/2011 17:26'!
formAt: key add: value
	"Add key equals value to the application/x-www-form-urlencoded 
	entity of the current request. This is for multi-values form fields."

	self applicationFormUrlEncodedEntity 
		at: key add: value! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 5/30/2012 21:31'!
contentWriter: object
	"Set current content writer, an object conforming 
	to the #value: protocol to convert an object to a request content entity
	as used by #contents:. Defaults to nil.
	Can be used to format data to be uploaded."

	self optionAt: #contentWriter put: object! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 1/30/2013 19:16'!
url: urlObject
	"Modify the URL of the current request object to urlObject.
	This is done using ZnUrl>>#inContextOf: so that either scheme, 
	host, port or path are set and merged.
	Default the URL using ZnUrl>>#asZnUrlWithDefaults to fall back
	to http or the default http/https ports."
	
	| url |
	url := urlObject asZnUrl.
	request url
		ifNotNil: [ url := url inContextOf: request url ].  
	url := url asZnUrlWithDefaults.  
	self validateConnectionForHost: url host port: url port.   
	request url: url.
	url hasUsername & url hasPassword
		ifTrue: [ self setBasicAuthenticationUsername: url username password: url password ]! !

!ZnClient methodsFor: 'options' stamp: 'SvenVanCaekenberghe 11/8/2011 19:36'!
connectionReuseTimeout
	"Return the timeout in seconds currently used to determine
	if I should try to reuse an open connection. Defaults to 10 seconds."

	^ self optionAt: #connectionReuseTimeout ifAbsent: [ 10 ]! !

!ZnClient methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 6/12/2014 16:01'!
execute
	"Execute the currently set up request to generate a response.
	Return the #contents of the response, if any."

	| result |
	self prepareRequest.
	self withProgressDo: [ result := self executeWithTimeout ].
	self prepareNextRequest.
	^ result! !

!ZnClient methodsFor: 'accessing request' stamp: 'SvenVanCaekenberghe 12/12/2012 10:19'!
queryAt: key put: value
	"Add key equals value as an HTTP query parameter to the current request."
	
	request url 
		ifNil: [ request url: (ZnUrl new queryAt: key put: value; yourself) ]
		ifNotNil: [ request url queryAt: key put: value ]  ! !

!ZnClient methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/8/2011 16:53'!
optionAt: key ifAbsent: block
	"Return my option/settings stored under key.
	Execute block if I have no such option/setting.
	This is a generic interface, see my options protocol for specific usages."

	options ifNil: [ ^ block value ].
	^ options at: key ifAbsent: block! !

!ZnClient methodsFor: 'accessing request' stamp: 'ChristopheDemarey 9/12/2014 17:28'!
queryAt: key add: value 
	"Modify the receiver by adding a query variable key=value.
	If key already exists, value is added to it."

	request url 
		ifNil: [ request url: (ZnUrl new queryAt: key add: value; yourself) ]
		ifNotNil: [ request url queryAt: key add: value ]  ! !

!ZnClient methodsFor: 'accessing response' stamp: 'SvenVanCaekenberghe 11/8/2011 20:56'!
contents 
	"Answer the contents or HTTP payload of the last response, 
	assuming the current request was executed.
	If I have a contentReader, it will be used to compute the contents.
	Otherwise I delegate to ZnResponse>>#contents, unless I am #streaming,
	in which case I return the stream of the streaming entity."

	^ response ifNotNil: [ 
		self contentReader 
			ifNil: [ 
				self streaming
					ifTrue: [  response entity stream ]
					ifFalse: [ response contents ] ]
			ifNotNil: [ :reader | reader value: response entity ] ]  ! !

!ZnClient methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/29/2012 17:40'!
resetCookies
	session ifNotNil: [ session resetCookies ]! !

!ZnClientConnectionClosedEvent commentStamp: 'SvenVanCaekenberghe 6/16/2014 13:58'!
ZnClientConnectionClosedEvent signals that a client side connection to address:port is closed.!
!ZnClientConnectionClosedEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 16:49'!
address
	^ address! !

!ZnClientConnectionClosedEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 16:49'!
address: anObject
	address := anObject! !

!ZnClientConnectionClosedEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 16:57'!
port: anObject
	port := anObject! !

!ZnClientConnectionClosedEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 16:57'!
port
	^ port! !

!ZnClientConnectionClosedEvent methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 6/30/2014 17:06'!
printContentsOn: stream
	super printContentsOn: stream.
	stream << ' Connection Closed '.
	address do: [ :each | stream print: each ] separatedBy: [ stream nextPut: $. ].
	stream nextPut: $:; print: port! !

!ZnClientFollowingRedirectEvent commentStamp: 'SvenVanCaekenberghe 6/16/2014 14:34'!
ZnClientFollowingRedirectEvent signals that a redirect to target is being followed. How many redirects to follow, if any is configurable.!
!ZnClientFollowingRedirectEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 15:46'!
target
	^ target! !

!ZnClientFollowingRedirectEvent methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 6/30/2014 17:06'!
printContentsOn: stream
	super printContentsOn: stream.
	stream << ' Following Redirect '; print: target! !

!ZnClientFollowingRedirectEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 15:46'!
target: anObject
	target := anObject! !

!ZnClientIgnoringExceptionOnConnectionReuseEvent commentStamp: 'SvenVanCaekenberghe 6/16/2014 14:00'!
ZnClientIgnoringExceptionOnConnectionReuseEvent signals that a client connection was reused and that an exception occurred. Normally, there is one retry after that, trying to reconnect.
!
!ZnClientIgnoringExceptionOnConnectionReuseEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 15:47'!
exception: anObject
	exception := anObject! !

!ZnClientIgnoringExceptionOnConnectionReuseEvent methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 6/30/2014 17:06'!
printContentsOn: stream
	super printContentsOn: stream.
	stream << ' Ignoring Exception On Connection Reuse '; print: exception! !

!ZnClientIgnoringExceptionOnConnectionReuseEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 15:47'!
exception
	^ exception! !

!ZnClientLogEvent commentStamp: 'SvenVanCaekenberghe 6/12/2014 15:25'!
I am ZnClientLogEvent, a ZnLogEvent generated by ZnClient.

I hold an optional clientId attribute.
!
!ZnClientLogEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 15:13'!
clientId
	^ clientId! !

!ZnClientLogEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 15:13'!
clientId: anObject
	clientId := anObject! !

!ZnClientLogEvent methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 11/6/2014 15:30'!
printContentsOn: stream
	super printContentsOn: stream.
	clientId ifNotNil: [ stream space; << clientId ]! !

!ZnClientRetryingEvent commentStamp: 'SvenVanCaekenberghe 6/16/2014 14:01'!
ZnClientRetryingEvent signals a client is retrying is main operation. The number of retries is configurable.
!
!ZnClientRetryingEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 15:47'!
exception: anObject
	exception := anObject! !

!ZnClientRetryingEvent methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 6/30/2014 17:06'!
printContentsOn: stream
	super printContentsOn: stream.
	stream << ' Retrying '; print: exception! !

!ZnClientRetryingEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 15:47'!
exception
	^ exception! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
testUploadSmallDocument
	self withServerDo: [ :server | | client contents path |
		path := ZnFileSystemUtils fullNameFor: 'small.txt'.
		contents := String streamContents: [ :stream |
			stream print: DateAndTime now; space; print: 9999 atRandom ].
		ZnFileSystemUtils deleteIfExists: 'small.txt'.
		ZnFileSystemUtils newFileNamed: path do: [ :stream | stream nextPutAll: contents ].
		(client := ZnClient new)
			url: server localUrl;
			addPath: 'echo';
			uploadEntityFrom: path.
		self assert: client request entity contentType = ZnMimeType textPlain.
		client contentType: ZnMimeType textPlain. "Not needed, just test the code path"
		self assert: client request entity contentType = ZnMimeType textPlain.
		client post.
		self assert: client isSuccess.
		self assert: client entity contentType = ZnMimeType textPlain.
		self assert: (client contents includesSubstring: contents).
		client close.
		ZnFileSystemUtils deleteIfExists: 'small.txt' ]! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/2/2014 18:52'!
testGetAfterPost
	self withServerDo: [ :server | | client |
		server onRequestRespond: [ :request | 
			request uri firstPathSegment = 'one'
				ifTrue: [
					(request method = #POST and: [ request hasEntity ])
						ifTrue: [ ZnResponse ok: (ZnEntity text: 'OK for one') ]
						ifFalse: [ ZnResponse badRequest: request ] ]
				ifFalse: [
					request uri firstPathSegment = 'two'
						ifTrue: [ 
							(request method = #GET and: [ request hasEntity not ])
								ifTrue: [ ZnResponse ok: (ZnEntity text: 'OK for two') ]
								ifFalse: [ ZnResponse badRequest: request ] ]
		 				ifFalse: [ ZnResponse notFound: request uri ] ] ].
		(client := ZnClient new) 
			autoResetEntityMethods: #(HEAD DELETE GET);
			url: server localUrl;
			url: 'one';
			entity: (ZnEntity text: 'One two three');
			post.
		self assert: client isSuccess.
		self assert: client contents = 'OK for one'.
		client
			url: 'two';
			get.
		self assert: client isSuccess.
		self assert: client contents = 'OK for two'.
		client close ]! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/13/2014 14:38'!
testGetSmallHTMLStreaming
	| client result contents |
	result := (client := ZnClient new)
		url: self smallHtmlUrl;
		streaming: true;
		get.
	self assert: client isSuccess.
	self assert: client response contentType = ZnMimeType textHtml.
	self assert: result isStream.
	self assert: client entity stream = result.
	contents := ZnUTF8Encoder new decodeBytes: result upToEnd.
	self assert: (contents includesSubstring: 'Small').
	client close! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/11/2012 20:33'!
testRedirectWithCustomHeader
	self withServerDo: [ :server | | client cookie |
		server onRequestRespond: [ :request | 
			(request headers at: 'X-Custom' ifAbsent: [ nil ]) = 'The Secret'
				ifFalse: [ ZnResponse badRequest: request ]
				ifTrue: [
					request uri firstPathSegment = 'one'
						ifTrue: [ ZnResponse redirect: 'two' ]
						ifFalse: [
							request uri firstPathSegment = 'two'
								ifTrue: [ ZnResponse ok: (ZnEntity text: 'OK!!') ]
		 						ifFalse: [ ZnResponse badRequest: request ] ] ] ].
		(client := ZnClient new) 
			url: server localUrl; 
			addPath: 'one';
			headerAt: 'X-Custom' put: 'The Secret'; 
			get.
		self assert: client isSuccess.
		self assert: client contents = 'OK!!'.
		client close ]! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/13/2014 14:40'!
testGetSmallHTMLTwice
	| client |
	(client := ZnClient new)
		url: self smallHtmlUrl;
		get.
	self assert: client isSuccess.
	self assert: client response contentType = ZnMimeType textHtml.
	self assert: (client contents includesSubstring: 'Small').
	client 
		url: self smallHtmlUrl pathPrintString;
		get.
	self assert: client isSuccess.
	self assert: client response contentType = ZnMimeType textHtml.
	self assert: (client contents includesSubstring: 'Small').
	client close! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/12/2012 20:14'!
testTimeout
	self withServerDo: [ :server |
		self 
			should: [ 
				ZnClient new 
					timeout: 1; 
					url: server localUrl;
					addPath: 'echo';
					queryAt: 'delay' put: '2'; 
					get ]
			raise: ConnectionTimedOut ]! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/8/2011 22:16'!
testIfFailNotFound
	| client |
	(client := ZnClient new)
		beOneShot;
		url: 'http://stfx.eu/non-existing';
		ifFail: [ :exception |
			^ self assert: (exception isKindOf: ZnHttpUnsuccessful) ];
		get.
	self assert: client isSuccess not.
	client
		enforceHttpSuccess: true;
		get.
	self fail! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/8/2011 22:16'!
testIfModifiedSinceNotModified
	| client request response |
	(client := ZnClient new) host: 'caretaker.wolf359.be'.
	[
		response := client 
			url: '/small.html'; 
			setIfModifiedSince: (Date year: 2011 month: 1 day: 1);
			get; 
			response.
		self assert: response isNotModified.
		self assert: response hasEntity not ] ensure: [ client close ]! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/10/2013 11:54'!
testRedirect
	| client response target |
	target := 'http://zn.stfx.eu'.
	client := ZnClient new url: target.
	client get.
	self assert: client isSuccess.
	client
		close;
		maxNumberOfRedirects: 0;
		url: target.
	self should: [ client get ] raise: ZnTooManyRedirects.
	client close.
	response := [ 
		ZnClient new
			beOneShot;
			maxNumberOfRedirects: 0;
			get: target;
			response ] on: ZnTooManyRedirects do: [ :exception | exception resume ].
	self assert: response isRedirect! !

!ZnClientTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 1/22/2014 10:14'!
withServerDo: block
	| server |
	server := ZnServer on: 1700 + 32 atRandom.
	[ 
		server start.
		self 
			assert: server isRunning & server isListening
			description: ('Failed to start server on port {1}. Is there one already?' format: { server port }).
		block cull: server
	] 
		ensure: [ server stop ]! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/11/2012 20:19'!
testUsernamePassword
	self withServerDo: [ :server | | client |
		server authenticator: (ZnBasicAuthenticator username: 'foo' password: 'secret').
		(client := ZnClient new) 
			url: server localUrl;
			addPathSegment: 'echo';
			get.
		self deny: client isSuccess.
		self assert: client response isAuthenticationRequired.
		client 
			username: 'foo' password: 'secret'; 
			get.
		self assert: client isSuccess.
		self assert: (client contents includesSubstring: 'Zinc').
		client close ]! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/30/2013 19:19'!
testUsernamePasswordInUserInfo
	self withServerDo: [ :server | | url client |
		server authenticator: (ZnBasicAuthenticator username: 'foo' password: 'secret').
		url := server localUrl.
		url username: 'foo'; password: 'secret'; addPathSegment: 'echo'.
		(client := ZnClient new) 
			get: url.
		self assert: client isSuccess.
		self assert: (client contents includesSubstring: 'Zinc').
		client close ]! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/13/2014 14:38'!
testGetSmallHTMLOneShot
	| client |
	(client := ZnClient new)
		beOneShot;
		url: self smallHtmlUrl;
		get.
	self assert: client isSuccess.
	self assert: client response contentType = ZnMimeType textHtml.
	self assert: (client contents includesSubstring: 'Small').
	self deny: client isConnected! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/24/2013 11:02'!
testPrepareRequest
	| client |
	self withServerDo: [ :server |
		(client := ZnClient new)
			url: server localUrl;
			addPath: 'echo';
			prepareRequest: [ :request | request setAuthorization: 'my-signature' ];
			get.
		self assert: client isSuccess.
		self assert: (client contents includesSubstring: 'my-signature').
		client
			url: server localUrl;
			addPath: 'echo';
			get.
		self assert: client isSuccess.
		self assert: (client contents includesSubstring: 'my-signature').
		client close ]! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/30/2013 20:42'!
testGetWideStringHTML
	| client text |
	text := '<html><h1>Czech is in Czech {1}e{2}tina.</h1></html>' format: { 269 asCharacter. 353 asCharacter}.
	self assert: text isWideString.
	self withServerDo: [ :server |
		server onRequestRespond: [ :request | ZnResponse ok: (ZnEntity html: text) ].
		(client := ZnClient new)
			get: server localUrl.
		self assert: client isSuccess.
		self assert: client response contents equals: text.
		client close ]! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/13/2014 14:42'!
testProgress
	"[ :bar |
		bar title: 'Downloading Sources...'.
		[
			ZnClient new 
				url: 'http://files.pharo.org/sources/PharoV30.sources'; 
				signalProgress: true;	
				downloadTo: FileLocator temp ]
			on: HTTPProgress 
			do: [ :progress |
				progress isEmpty ifFalse: [ bar current: progress percentage ]. 
				progress resume ] ] asJob run."
		
	self 
		should: [ 
			ZnClient new
				beOneShot;
				signalProgress: true;
				get: self smallHtmlUrl ] 
		raise: HTTPProgress
! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/11/2012 20:37'!
testPostTwice
	| client |
	self withServerDo: [ :server |
		(client := ZnClient new)
			url: server localUrl;
			addPath: 'echo';
			contents: 'Foo bar!!';
			post.
		self assert: client isSuccess.
		self assert: (client contents includesSubstring: 'Foo bar!!').
		client
			contents: 'Another one ?';
			post.
		self assert: client isSuccess.
		self assert: (client contents includesSubstring: 'Another one ?').
		client close ]! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/2/2014 18:43'!
testGetForm
	| client |
	self withServerDo: [ :server |
		(client := ZnClient new)
			url: server localUrl;
			addPath: 'echo';
			formAt: 'username' put: 'john';
			formAdd: 'password' -> 'secret';
			get.
		self assert: client isSuccess.
		self assert: (client contents includesSubstring: 'john').
		self assert: (client contents includesSubstring: 'secret') ]! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/14/2012 17:15'!
testCookies
	| client |
	self withServerDo: [ :server |
		server onRequestRespond: [ :request | | cookie1 cookie2 response |
			cookie1 := request cookies detect: [ :each | each name = 'x' ] ifNone: [ ZnCookie name: 'x' value: '0' ].
			cookie2 := request cookies detect: [ :each | each name = 'y' ] ifNone: [ ZnCookie name: 'y' value: '100' ].
			cookie1 value: (cookie1 value asInteger + 1) asString.
			cookie2 value: (cookie2 value asInteger + 2) asString.
			response := ZnResponse ok: (ZnEntity text: 'OK').
			response addCookie: cookie1; addCookie: cookie2.
			response ].
		client := ZnClient new url: server localUrl; yourself.
		self assert: (client session cookieJar cookieAt: 'x' forUrl: client request url) isNil.
		self assert: (client session cookieJar cookieAt: 'y' forUrl: client request url) isNil.
		client get.
		self assert: client isSuccess.
		self assert: (client session cookieJar cookieAt: 'x' forUrl: client request url) value = '1'.
		self assert: (client session cookieJar cookieAt: 'y' forUrl: client request url) value = '102'.
		client get.
		self assert: client isSuccess.
		self assert: (client session cookieJar cookieAt: 'x' forUrl: client request url) value = '2'.
		self assert: (client session cookieJar cookieAt: 'y' forUrl: client request url) value = '104'.
		client close ]! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/11/2012 20:20'!
testUsernamePasswordTwice
	self withServerDo: [ :server | | client |
		server authenticator: (ZnBasicAuthenticator username: 'foo' password: 'secret').
		(client := ZnClient new) 
			url: server localUrl;
			addPathSegment: 'echo';
			username: 'foo' password: 'secret'; 
			get.
		self assert: client isSuccess.
		self assert: (client contents includesSubstring: 'Zinc').
		client get.
		self assert: client isSuccess.
		self assert: (client contents includesSubstring: 'Zinc').
		client close ]! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/13/2014 14:36'!
testDownloadSmallHTML
	| client |
	ZnFileSystemUtils deleteIfExists: self smallHtmlUrl pathSegments last.
	"First download to a directory"
	(client := ZnClient new)
		url: self smallHtmlUrl;
		downloadTo: ZnFileSystemUtils defaultDirectoryPath.
	self assert: client isSuccess.
	self assert: client response contentType = ZnMimeType textHtml.
	ZnFileSystemUtils 
		oldFileNamed: self smallHtmlUrl pathSegments last
		do: [ :stream | self assert: (stream upToEnd includesSubstring: 'Small') ].
	ZnFileSystemUtils deleteIfExists: self smallHtmlUrl pathSegments last.
	"Second download to an explicitly named file"
	client 
		url: self smallHtmlUrl;
		downloadTo: self smallHtmlUrl pathSegments last.
	self assert: client isSuccess.
	self assert: client response contentType = ZnMimeType textHtml.
	ZnFileSystemUtils 
		oldFileNamed: self smallHtmlUrl pathSegments last
		do: [ :stream | self assert: (stream upToEnd includesSubstring: 'Small') ].	
	client close.
	ZnFileSystemUtils deleteIfExists: self smallHtmlUrl pathSegments last
! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/8/2011 22:16'!
testConstruction
	| client |
	(client := ZnClient new)
		http;
		host: 'www.example.com';
		port: 8080;
		addPath: 'foo';
		addPath: 'a space';
		addPath: 'file.txt';
		queryAt: 'key' put: '123456';
		headerAt: 'X-token' put: 'ABCDEF'.
	self assert: client request url host = 'www.example.com'.
	self assert: client request url port = 8080.
	self assert: client request url pathQueryFragmentPrintString = '/foo/a%20space/file.txt?key=123456'.
	self assert: (client request headers at: 'X-token') = 'ABCDEF'! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/8/2011 22:16'!
testIfFailNonExistingHost
	| client |
	(client := ZnClient new)
		beOneShot;
		url: 'http://unknown-stfx.eu';
		ifFail: [ : exception |
			^ self assert: (exception isKindOf: NetworkError) ];
		get.
	self fail! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/13/2014 14:41'!
testIfFailWrongType
	| client |
	(client := ZnClient new)
		beOneShot;
		accept: ZnMimeType imagePng;
		enforceAcceptContentType: true;
		url: self smallHtmlUrl;
		ifFail: [ :exception |
			^ self assert: (exception isKindOf: ZnUnexpectedContentType) ];
		get.
	self fail! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/14/2012 17:16'!
testRedirectWithCookies
	self withServerDo: [ :server | | client cookie |
		server onRequestRespond: [ :request | 
			request uri firstPathSegment = 'one'
				ifTrue: [ 
					(ZnResponse redirect: 'two')
						addCookie: (ZnCookie name: 'session' value: '123456');
						yourself ]
				ifFalse: [
					cookie := request cookies detect: [ :each | each name = 'session' ] ifNone: [ nil ].
					(request uri firstPathSegment = 'two' and: [ cookie notNil and: [ cookie value = '123456' ] ])
						ifTrue: [ ZnResponse ok: (ZnEntity text: 'OK!!') ]
		 				ifFalse: [ ZnResponse badRequest: request ] ] ].
		(client := ZnClient new) 
			url: server localUrl; addPath: 'one'; 
			post.
		self assert: client isSuccess.
		self assert: client contents = 'OK!!'.
		client close ]! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/13/2014 14:37'!
testGetSmallHTML
	| client |
	(client := ZnClient new)
		url: self smallHtmlUrl;
		get.
	self assert: client isSuccess.
	self assert: client isContentTypeAcceptable.
	self assert: client response contentType = ZnMimeType textHtml.
	self assert: (client contents includesSubstring: 'Small').
	self assert: client isConnected.
	client close.
	self deny: client isConnected! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/13/2013 14:10'!
testGetLargeWideStringHTML
	| client text |
	text := '<html>{1}<h1>Czech in Czech is {2}e{3}tina.</h1>{1}</html>' 
		format: { 
			String new: ZnUtils streamingBufferSize withAll: $X.
			269 asCharacter. 
			353 asCharacter }.
	self assert: text isWideString.
	self withServerDo: [ :server |
		server onRequestRespond: [ :request | ZnResponse ok: (ZnEntity html: text) ].
		(client := ZnClient new)
			get: server localUrl.
		self assert: client isSuccess.
		self assert: client response contents equals: text.
		client close ]! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/2/2014 09:30'!
testQueryGoogle
	| client |
	(client := ZnClient new)
		http;
		host: 'www.google.com';
		addPath: 'search';
		queryAt: 'q' put: 'Pharo Smalltalk';
		get.
	self assert: client isSuccess.
	self assert: (client response contentType matches: ZnMimeType textHtml).
	self assert: (client contents includesSubstring: 'pharo.org').
	client close! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/14/2014 15:56'!
testSpecialPosts
	self skip.
	self withServerDo: [ :server |
		{ ZnEntity with: 'A'. ZnEntity with: #[ 42 ]. ZnEntity with: ''. ZnEntity with: #[ ] } 
			do: [ :each |
				| client |
				(client := ZnClient new)
					url: server localUrl;
					addPath: #echo;
					entity: each;
					post.
				self assert: client isSuccess.
				self assert: (each isEmpty or: [client contents includesSubstring: each printString ]).
				client close.
				(client := ZnClient new)
					beOneShot;
					url: server localUrl;
					addPath: #echo;
					entity: each;
					post.
				self assert: client isSuccess.
				self assert: (each isEmpty or: [client contents includesSubstring: each printString ]) ] ]! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/13/2014 14:37'!
testGetGeoIP
	| result client |
	result := (client := ZnClient new)
		systemPolicy;
		url: self t3EasyGeoIPUrl;
		queryAt: 'address' put: '81.83.7.35';
		accept: ZnMimeType applicationJson;
		contentReader: [ :entity | 
					Smalltalk globals
						at: #NeoJSONReader
						ifPresent: [ :parserClass | parserClass fromString: entity contents ]
						ifAbsent: [ ^ self ] ];
		ifFail: [ ^ self fail ];
		get.
	self assert: result isDictionary.
	self assert: (result at: #country) = 'BE'.
	client close! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/12/2012 20:13'!
testHeadSmallHTML
	| client |
	self withServerDo: [ :server |
		(client := ZnClient new)
			url: server localUrl;
			addPath: 'echo';
			head.
		self assert: client isSuccess.
		self assert: client response contentLength > 0.
		self assert: client response hasEntity not.
		client close ]! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
testPostMultipart
	| client filename |
	ZnFileSystemUtils deleteIfExists: 'testPostMultiPart.txt'.
	filename := ZnFileSystemUtils fullNameFor: 'testPostMultiPart.txt'.
	ZnFileSystemUtils newFileNamed: filename do: [ :stream | stream nextPutAll: '0123456789' ].
	self withServerDo: [ :server |
		(client := ZnClient new)
			url: server localUrl;
			addPath: 'echo';
			addPart: (ZnMimePart fieldName: 'username' value: 'john');
			addPart: (ZnMimePart fieldName: 'foo' entity: (ZnEntity text: '123'));
			addPart: (ZnMimePart fieldName: 'file' fileNamed: filename);
			post.
		self assert: client isSuccess.
		self assert: (client contents includesSubstring: 'multipart') ].
	ZnFileSystemUtils deleteIfExists: 'testPostMultiPart.txt'.
! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/13/2014 14:42'!
testProgressNoIfFail
	self 
		should: [ 
			ZnClient new
				beOneShot;
				signalProgress: true;
				ifFail: [ self fail ];
				get: self smallHtmlUrl ] 
		raise: HTTPProgress
! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
testPostForm
	| client |
	self withServerDo: [ :server |
		(client := ZnClient new)
			url: server localUrl;
			addPath: 'echo';
			formAt: 'username' put: 'john';
			formAdd: 'password' -> 'secret';
			post.
		self assert: client isSuccess.
		self assert: (client contents includesSubstring: 'john').
		self assert: (client contents includesSubstring: 'secret') ]! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/10/2013 11:55'!
testRedirectDontFollow
	| client target |
	target := 'http://zn.stfx.eu'.
	(client := ZnClient new) 
		dontFollowRedirects;
		get: target.
	self assert: client response isRedirect.
	client
		enforceHttpSuccess: true;
		get: target.
	self assert: client response isRedirect.
	client close! !

!ZnClientTests methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/13/2014 14:34'!
smallHtmlUrl
	^ 'http://zn.stfx.eu/zn/small.html' asZnUrl! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/16/2015 09:48'!
testLogging
	| client logEventCollection |
	logEventCollection := OrderedCollection new.
	ZnLogEvent announcer when: ZnLogEvent do: [ :event | logEventCollection add: event ]. 
	(client := ZnClient new)
		clientId: #C1;
		beOneShot.
	client	get: self smallHtmlUrl.
	client close.
	ZnLogEvent announcer 
		unsubscribe: logEventCollection.
	self deny: logEventCollection isEmpty.
	self assert: logEventCollection anyOne clientId equals: #C1! !

!ZnClientTests methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/13/2014 14:37'!
t3EasyGeoIPUrl
	^ 'http://easy.t3-platform.net/rest/geo-ip' asZnUrl! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/14/2012 17:16'!
testRelativeRedirect
	self withServerDo: [ :server | | client |
		server onRequestRespond: [ :request | 
			request uri firstPathSegment = 'one'
				ifTrue: [ ZnResponse redirect: 'two' ]
				ifFalse: [
					request uri firstPathSegment = 'two'
						ifTrue: [ ZnResponse ok: (ZnEntity text: 'OK!!') ]
		 				ifFalse: [ ZnResponse notFound: request uri ] ] ].
		(client := ZnClient new) 
			url: server localUrl; addPath: 'one'; 
			post.
		self assert: client isSuccess.
		self assert: client contents = 'OK!!'.
		client close ]! !

!ZnClientTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/13/2014 14:41'!
testGetSmallHTMLUrlConstruction
	| client |
	(client := ZnClient new)
		http;
		host: self smallHtmlUrl host;
		path: self smallHtmlUrl pathPrintString;
		get.
	self assert: client isSuccess.
	self assert: client response contentType = ZnMimeType textHtml.
	self assert: (client contents includesSubstring: 'Small').
	client close! !

!ZnClientTransactionEvent commentStamp: 'SvenVanCaekenberghe 6/16/2014 14:09'!
ZnClientTransactionEvent is a ZnClientLogEvent that notes the completion of a client side HTTP transaction (request/response).

Instance Variables
	request: a ZnRequest
	requestDuration:	 milliseconds
	response:	a ZnResponse
	responseDuration: milliseconds
	
Note that this can be quite large since it includes the entities transferred. See ZnSimplifiedClientTransactionEvent for a more compact representation.!
!ZnClientTransactionEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/12/2014 14:12'!
responseDuration
	^ responseDuration! !

!ZnClientTransactionEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 16:23'!
request: anObject
	request := anObject! !

!ZnClientTransactionEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/12/2014 14:12'!
requestDuration: anObject
	requestDuration := anObject! !

!ZnClientTransactionEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 16:23'!
response: anObject
	response := anObject! !

!ZnClientTransactionEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/12/2014 14:12'!
responseDuration: anObject
	responseDuration := anObject! !

!ZnClientTransactionEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/12/2014 14:12'!
requestDuration
	^ requestDuration! !

!ZnClientTransactionEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 16:23'!
response
	^ response! !

!ZnClientTransactionEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/12/2014 14:12'!
duration
	^ requestDuration + responseDuration! !

!ZnClientTransactionEvent methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 6/30/2014 17:06'!
printContentsOn: stream
	super printContentsOn: stream.
	stream space.
	request requestLine printMethodAndUriOn: stream.
	stream space; print: response code.
	response hasEntity
		ifTrue: [ 
			stream space; print: response entity contentLength; nextPut: $B ].
	stream space; print: self duration; nextPutAll: 'ms'! !

!ZnClientTransactionEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 16:23'!
request
	^ request! !

!ZnConnectionAcceptedEvent commentStamp: 'SvenVanCaekenberghe 6/16/2014 15:04'!
ZnConnectionAcceptedEvent is signalled when an HTTP server accepts an incoming connection from a client at address.!
!ZnConnectionAcceptedEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 11:45'!
address: anObject
	address := anObject! !

!ZnConnectionAcceptedEvent methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 6/30/2014 17:06'!
printContentsOn: stream
	super printContentsOn: stream.
	stream << ' Connection Accepted '.
	address do: [ :each | stream print: each ] separatedBy: [ stream nextPut: $. ]! !

!ZnConnectionAcceptedEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 11:45'!
address
	^ address! !

!ZnConnectionEstablishedEvent commentStamp: 'SvenVanCaekenberghe 6/16/2014 14:35'!
ZnConnectionEstablishedEvent signals that a client HTTP connection to hostname:port (address:port) was established in duration milliseconds. This time includes DNS resolving.!
!ZnConnectionEstablishedEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 15:59'!
hostname
	^ hostname! !

!ZnConnectionEstablishedEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 15:59'!
port: anObject
	port := anObject! !

!ZnConnectionEstablishedEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 15:59'!
port
	^ port! !

!ZnConnectionEstablishedEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 15:59'!
duration: anObject
	duration := anObject! !

!ZnConnectionEstablishedEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 15:59'!
address
	^ address! !

!ZnConnectionEstablishedEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 15:59'!
address: anObject
	address := anObject! !

!ZnConnectionEstablishedEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 15:59'!
hostname: anObject
	hostname := anObject! !

!ZnConnectionEstablishedEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 15:59'!
duration
	^ duration! !

!ZnConnectionEstablishedEvent methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 6/30/2014 17:06'!
printContentsOn: stream
	super printContentsOn: stream.
	stream << ' Connection Established '; nextPutAll: hostname; nextPut: $:; print: port; space. 
	address do: [ :each | stream print: each ] separatedBy: [ stream nextPut: $. ].
	stream space; print: duration; << 'ms '.! !

!ZnConnectionTimeout commentStamp: 'SvenVanCaekenberghe 5/9/2012 20:54'!
I am ZnConnectionTimeout.
I am a DynamicVariable and a ProcessSpecificVariable.

I can be used to modify the global default socket IO timeout on a per process basis, for example:

ZnConnectionTimeout 
	value: 5 
	during: [ ^ ZnClient new get: 'http://zn.stfx.eu/zn/small.html' ]!
!ZnConstants commentStamp: 'SvenVanCaekenberghe 1/18/2011 11:01'!
I am ZnConstants, holding various constants that we use.

Part of Zinc HTTP Components.!
!ZnConstants class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/6/2010 15:22'!
knownHTTPVersions
	^ #('HTTP/1.1' 'HTTP/1.0')! !

!ZnConstants class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/14/2010 10:35'!
frameworkName
	^ 'Zinc HTTP Components'! !

!ZnConstants class methodsFor: 'accessing' stamp: 'PaulDeBruicker 4/10/2011 11:54'!
faviconBytes
	^ #(0 0 1 0 1 0 16 16 16 0 0 0 0 0 40 1 0 0 22 0 0 0 40 0 0 0 16 0 0 0 32 0 0 0 1 0 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 0 0 189 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 17 17 17 1 16 1 16 1 17 17 17 1 16 1 16 1 16 0 0 1 16 1 16 0 17 0 0 1 16 1 16 0 1 16 0 1 16 1 16 0 0 17 0 1 17 17 16 0 0 1 16 1 1 17 0 0 0 0 17 0 0 0 0 1 17 17 17 0 0 0 0 1 17 17 17 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) asByteArray! !

!ZnConstants class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/14/2010 10:36'!
frameworkLicense
	"http://en.wikipedia.org/wiki/MIT_License"
	
	^ 'MIT License'! !

!ZnConstants class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/11/2012 14:43'!
welcomePageHtml
	^ '<?xml version="1.0" encoding="UTF-8"?>
<!!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html>
<head>
<title>Zinc HTTP Components</title>
<style type="text/css">
body {
  color: black;
  background: white;
  width: 900px;
  font-family: Verdana, Arial, Helvetica, sans-serif;
  font-size: 13px;
}
p {
  width: 600px;
  padding: 0 20px 10px 20px;
} 
ul,ol {
  width: 600px;
  padding: 0 5px 5px 30px;
} 
#logo {
  color: orange;
  font-family: Helvetica, sans-serif;
  font-weight: bold;
  font-size: 100px;
}
</style>
</head>
<body>
<div id="logo">Zn</div>
<h1>Zinc HTTP Components</h1>
<p>
Welcome to Zinc HTTP Components, 
a modern, open-source Smalltalk framework to deal with the HTTP networking protocol.
</p>
<ul>
<li>Project homepage <a href="http://zn.stfx.eu/">http://zn.stfx.eu</a></li> 
<li>Locally available pages <a href="/help">/help</a></li>
</ul>
<h4>May the Source be with you!!</h4>
</body>
</html>
'! !

!ZnConstants class methodsFor: 'resource limits' stamp: 'SvenVanCaekenberghe 1/2/2012 17:45'!
maximumLineLength
	"Return the maximum line length to accept.
	Used by ZnLineReader and thus for reading request/status lines as well as headers.
	This helps to protect us from malicious content."
	
	^ 4096! !

!ZnConstants class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/14/2010 10:49'!
defaultUserAgent
	^ self frameworkNameAndVersion ! !

!ZnConstants class methodsFor: 'private' stamp: 'KrisGybels 3/27/2014 17:35'!
initializeHTTPStatusCodes 
	"This is the official list from http://www.iana.org/assignments/http-status-codes"

	HTTPStatusCodes := Dictionary newFromPairs: #(
		100 'Continue'
		101 'Switching Protocols'
		102 'Processing'
		200 'OK'
		201 'Created'
		202 'Accepted'
		203 'Non-Authoritative Information'
		204 'No Content'
		205 'Reset Content'
		206 'Partial Content'
		207 'Multi-Status'
		208 'Already Reported'
		226 'IM Used'
		300 'Multiple Choices'
		301 'Moved Permanently'
		302 'Found'
		303 'See Other'
		304 'Not Modified'
		305 'Use Proxy'
		307 'Temporary Redirect'
		308 'Permanent Redirect'
		400 'Bad Request'
		401 'Unauthorized'
		402 'Payment Required'
		403 'Forbidden'
		404 'Not Found'
		405 'Method Not Allowed'
		406 'Not Acceptable'
		407 'Proxy Authentication Required'
		408 'Request Timeout'
		409 'Conflict'
		410 'Gone'
		411 'Length Required'
		412 'Precondition Failed'
		413 'Payload Too Large'
		414 'URI Too Long'
		415 'Unsupported Media Type'
		416 'Requested Range Not Satisfiable'
		417 'Expectation Failed'
		422 'Unprocessable Entity'
		423 'Locked'
		424 'Failed Dependency'
		426 'Upgrade Required'
		428 'Precondition Required'
		429 'Too Many Requests'
		431 'Request Header Fields Too Large'
		500 'Internal Server Error'
		501 'Not Implemented'
		502 'Bad Gateway'
		503 'Service Unavailable'
		504 'Gateway Timeout'
		505 'HTTP Version Not Supported'
		506 'Variant Also Negotiates (Experimental)'
		507 'Insufficient Storage'
		508 'Loop Detected'
		510 'Not Extended'
		511 'Network Authentication Required')! !

!ZnConstants class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/9/2010 20:19'!
remoteAddressHeader
	^ 'X-Zinc-Remote-Address'! !

!ZnConstants class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:19'!
standardHtmlDocType
	^ '<?xml version="1.0" encoding="UTF-8"?>
<!!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">'! !

!ZnConstants class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 3/31/2011 08:54'!
defaultServerString 
	^ self frameworkNameAndVersion ! !

!ZnConstants class methodsFor: 'class initialization' stamp: 'SvenVanCaekenberghe 9/6/2010 15:51'!
initialize 
	self initializeHTTPStatusCodes! !

!ZnConstants class methodsFor: 'resource limits' stamp: 'SvenVanCaekenberghe 9/5/2012 12:33'!
maximumEntitySize: integer
	"Set the maximum entity size to accept from a stream to integer bytes."
	
	^ DefaultMaximumEntitySize := integer! !

!ZnConstants class methodsFor: 'resource limits' stamp: 'SvenVanCaekenberghe 9/5/2012 12:36'!
maximumEntitySize
	"Return the maximum entity size to accept from a stream.
	Used by ZnEntity and subclasses. Can be set using #maximumEntitySize:
	This affects both client and server code.
	This helps to protect us from malicious content."
	
	^ ZnMaximumEntitySize value 
		ifNil: [ self defaultMaximumEntitySize ]! !

!ZnConstants class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/6/2010 15:18'!
defaultHTTPVersion
	^ 'HTTP/1.1'! !

!ZnConstants class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/17/2010 17:12'!
frameworkMCVersion
	MCWorkingCopy managersForClass: self class do: [ :each | ^ each ancestors first name ]! !

!ZnConstants class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 3/31/2011 08:58'!
frameworkVersion
	^ '1.0'! !

!ZnConstants class methodsFor: 'resource limits' stamp: 'SvenVanCaekenberghe 9/5/2012 12:34'!
defaultMaximumEntitySize
	"Return the default maximum entity size to accept from a stream.
	Used by ZnEntity and subclasses. Can be set using #defaultMaximumEntitySize:
	Default value is 16Mb. This affects both client and server code.
	This helps to protect us from malicious content."
	
	^ DefaultMaximumEntitySize ifNil: [ DefaultMaximumEntitySize := 16 * 1024 * 1024 ] ! !

!ZnConstants class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/14/2010 10:47'!
frameworkNameAndVersion
	^ self frameworkName, ' ', self frameworkVersion ! !

!ZnConstants class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/6/2010 15:53'!
httpStatusCodes
	^ HTTPStatusCodes ! !

!ZnConstants class methodsFor: 'resource limits' stamp: 'SvenVanCaekenberghe 9/5/2012 12:35'!
defaultMaximumEntitySize: integer
	"Set the default maximum entity size to accept from a stream to integer bytes."
	
	^ DefaultMaximumEntitySize := integer! !

!ZnConstants class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/11/2011 18:07'!
knownHTTPMethods
	^ #(
		"Standard HTTP 1.1 Verbs"
		GET PUT POST DELETE HEAD 
		TRACE OPTIONS CONNECT PATCH
		"WebDAV verbs"
		PROPFIND PROPPATCH MKCOL COPY MOVE LOCK UNLOCK)! !

!ZnCookie commentStamp: 'SvenVanCaekenberghe 12/7/2010 00:01'!
I represent an HTTP Cookie token.

Part of Zinc HTTP Components.!
!ZnCookie methodsFor: 'accessing' stamp: 'MattKennedy 9/27/2010 20:25'!
domain: aDomain
	attributes at: 'domain' put: aDomain! !

!ZnCookie methodsFor: 'private' stamp: 'SvenVanCaekenberghe 8/18/2011 14:17'!
extraAttributes
	"Answer all attributes except name and value"
	^ attributes associationsSelect: [ :ea | (ea key = 'name' or: [ ea key = 'value' ]) not ]! !

!ZnCookie methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:37'!
writeNameAndValueOn: aStream
	aStream
		nextPutAll: self name;
		nextPutAll: '=';
		nextPutAll: self value! !

!ZnCookie methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/10/2013 11:31'!
expiresTimeStamp
	self expires ifNil: [ ^ DateAndTime now + 1 day ].
	^ ZnUtils parseHttpDate: self expires! !

!ZnCookie methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:04'!
expires
	^ attributes at: 'expires' ifAbsent: [ nil ]! !

!ZnCookie methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:19'!
maxage
	^ self expires! !

!ZnCookie methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:04'!
path
	^ attributes at: 'path' ifAbsent: [ '/' ]! !

!ZnCookie methodsFor: 'initialization' stamp: 'MattKennedy 9/27/2010 20:21'!
initialize 
	attributes := Dictionary new.! !

!ZnCookie methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 1/8/2012 14:16'!
readAttribute: aToken
	| i key data |
	i := aToken indexOf: $=.
	i > 0
		ifTrue: [
			key := (aToken copyFrom: 1 to: i - 1) trimBoth asLowercase.
			data := (aToken copyFrom: i + 1 to: aToken size) trimBoth ]
		ifFalse: [ 
			key := (aToken copyFrom: 1 to: aToken size) trimBoth asLowercase.
			data := true ].
	attributes at: key put: data! !

!ZnCookie methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:05'!
value
	^ attributes at: 'value' ifAbsent: [ nil ]! !

!ZnCookie methodsFor: 'accessing' stamp: 'MattKennedy 9/27/2010 20:23'!
value: aValue
	attributes at: 'value' put: aValue! !

!ZnCookie methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 8/30/2011 21:43'!
printOn: stream
	self writeOn: stream! !

!ZnCookie methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
isInDomain: urlObject
	| domain |
	domain := (self domain beginsWith: '.')
		ifTrue: [ self domain copyFrom: 2 to: self domain size ]
		ifFalse: [ self domain ].
	^ urlObject host includesSubstring: domain
	! !

!ZnCookie methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 8/30/2011 20:03'!
writeExtraAttributesOn: aStream
	self extraAttributes
		associationsDo: [ :ea | 
			aStream
				nextPutAll: '; ';
				nextPutAll: ea key.
			(ea value isKindOf: Boolean)
				ifFalse: [ 
					aStream
						nextPutAll: '=';
						nextPutAll: ea value ] ]! !

!ZnCookie methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
isInPath: urlObject
	^ urlObject pathPrintString includesSubstring: self path
	! !

!ZnCookie methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:04'!
domain
	^ attributes at: 'domain' ifAbsent: [ nil ]! !

!ZnCookie methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 8/30/2011 21:42'!
nameValueString
	^ String streamContents: [ :stream | 
		self writeNameAndValueOn: stream ]! !

!ZnCookie methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 8/30/2011 19:45'!
defaultDomain: aDomain
	self domain ifNil: [ self domain: aDomain ]! !

!ZnCookie methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 8/30/2011 20:02'!
hash
	^ (self name hash bitXor: self path hash) bitXor: self domain hash! !

!ZnCookie methodsFor: 'accessing' stamp: 'MattKennedy 9/27/2010 20:28'!
secure: aBoolean
	attributes at: 'secure' put: aBoolean! !

!ZnCookie methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 8/30/2011 21:43'!
fullString
	^ String streamContents: [ :stream | 
		self writeOn: stream ]! !

!ZnCookie methodsFor: 'accessing' stamp: 'MattKennedy 9/28/2010 10:08'!
path: aPath
	attributes at: 'path' put: aPath! !

!ZnCookie methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 8/30/2011 21:32'!
writeOn: aStream
	self
		writeNameAndValueOn: aStream;
		writeExtraAttributesOn: aStream ! !

!ZnCookie methodsFor: 'accessing' stamp: 'MattKennedy 9/27/2010 20:26'!
expires: anExpiration
	attributes at: 'expires' put: anExpiration! !

!ZnCookie methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:05'!
secure
	^ attributes at: 'secure' ifAbsent: [ false ]! !

!ZnCookie methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:05'!
= aCookie
	(aCookie isKindOf: self class) ifFalse: [ ^ false ].
	^ (aCookie name = self name) & (aCookie path = self path) & (aCookie domain = self domain)
	! !

!ZnCookie methodsFor: 'accessing' stamp: 'MattKennedy 9/27/2010 20:28'!
httponly: aBoolean
	attributes at: 'httponly' put: aBoolean! !

!ZnCookie methodsFor: 'accessing' stamp: 'MattKennedy 9/27/2010 20:23'!
name: aName
	attributes at: 'name' put: aName! !

!ZnCookie methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 1/8/2012 14:16'!
fromString: aString
	| tokens val data i |
	tokens := aString subStrings: ';'.
	i := tokens first indexOf: $=.
	val := tokens first copyFrom: 1 to: i - 1.
	data := tokens first copyFrom: i + 1 to: tokens first size. 
	self name: val trimBoth; value: data trimBoth.
	2 to: tokens size do: [ :index | 
		self readAttribute: (tokens at: index) ]! !

!ZnCookie methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:19'!
name
	^ attributes at: 'name'! !

!ZnCookie methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:03'!
httponly
	"This is not an RFC cookie attribute, but a supplement found in MS Internet Explorer and supported in PHP.
	 See http://msdn.microsoft.com/en-us/library/ms533046.aspx"
	^ attributes at: 'httponly' ifAbsent: [ false ]! !

!ZnCookie methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/10/2013 11:31'!
isExpired
	^ (self expiresTimeStamp asUTC < DateAndTime now asUTC) or: [ self expires = 0 ]! !

!ZnCookie class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 11/10/2012 19:25'!
name: nameString value: value
	^ self new
		name: nameString;
		value: value;
		yourself! !

!ZnCookie class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 8/30/2011 19:46'!
fromString: aString for: urlObject
	| cookie |
	cookie := self fromString: aString.
	"Ensures a domain value if none provided by the cookie"
	cookie defaultDomain: urlObject host.
	^ cookie! !

!ZnCookie class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 8/30/2011 19:46'!
fromString: aString
	^ self new 
		fromString: aString; 
		yourself! !

!ZnCookieJar commentStamp: 'SvenVanCaekenberghe 12/7/2010 00:01'!
I represent a container for storing HTTP Cookies for a client session.

Part of Zinc HTTP Components.!
!ZnCookieJar methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:07'!
cookies 
	^ cookies ifNil: [ cookies := Bag new ]! !

!ZnCookieJar methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:18'!
add: aCookie
	(self removeIfExpired: aCookie) ifTrue: [ ^ nil ].
	self cookies do: [ :cookie |
		cookie = aCookie ifTrue: [ self cookies remove: cookie ] ].
	self cookies add: aCookie
	! !

!ZnCookieJar methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:06'!
cookiesForUrl: urlObject
	^ self cookies select: [ :cookie | 
		(cookie isExpired not) & (cookie isInDomain: urlObject) & (cookie isInPath: urlObject) ]! !

!ZnCookieJar methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:06'!
remove: aCookie
	self cookies remove: aCookie ifAbsent: [ nil ]! !

!ZnCookieJar methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 8/18/2011 14:07'!
removeIfExpired: aCookie
	^ aCookie isExpired 
		ifTrue: [ 
			self remove: aCookie. 
			true ]
		ifFalse: [
			false ]! !

!ZnCookieJar methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:07'!
cookieAt: aName forUrl: urlObject
	(self cookiesForUrl: urlObject) do: [ :cookie | cookie name = aName ifTrue: [ ^ cookie ] ].
	^ nil! !

!ZnCookieJar methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 2/29/2012 17:39'!
removeAll
	cookies ifNotNil: [ cookies removeAll ]! !

!ZnCredential commentStamp: 'SvenVanCaekenberghe 12/6/2010 12:56'!
I am ZnCredential, an abstract class representing credentials in a domain and realm.

Part of Zinc HTTP Components.!
!ZnCredential methodsFor: 'accessing' stamp: 'MattKennedy 9/28/2010 14:27'!
domain: anObject
	domain := anObject! !

!ZnCredential methodsFor: 'accessing' stamp: 'MattKennedy 9/29/2010 13:42'!
setAuthorizationHeader: headers for: urlObject method: method
	headers at: 'Authorization' put: self authToken! !

!ZnCredential methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:07'!
realm
	^ realm ifNil: [ realm := '' ]! !

!ZnCredential methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:20'!
authToken
	^ self authTokenForUrl: nil method: nil ! !

!ZnCredential methodsFor: 'accessing' stamp: 'MattKennedy 9/29/2010 13:48'!
authTokenForUrl: urlObject method: method
	self subclassResponsibility ! !

!ZnCredential methodsFor: 'accessing' stamp: 'MattKennedy 9/28/2010 14:27'!
realm: anObject
	realm := anObject! !

!ZnCredential methodsFor: 'accessing' stamp: 'MattKennedy 9/28/2010 14:27'!
domain
	^ domain! !

!ZnCredential methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:20'!
isComplete
	^ self subclassResponsibility ! !

!ZnCredential methodsFor: 'operations' stamp: 'MattKennedy 9/29/2010 16:10'!
linkToAuthRequest: aHeader
	"Link this credential to the WWW-Authenticate request in the provided header. 
	Used for authentication methods which require parameters provided by the server
	(e.g. Digest authentication)."
	realm := self class findRealmFor: aHeader! !

!ZnCredential class methodsFor: 'accessing' stamp: 'MattKennedy 9/28/2010 17:28'!
authName
	self subclassResponsibility ! !

!ZnCredential class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
findRealmFor: anAuthHeader
	(anAuthHeader subStrings: ',') do: [ :token |
		"String>>trimBoth: is a grease method, so not sure if we should be using it."
		(token includesSubstring: 'realm=') 
			ifTrue: [ ^ ((token subStrings: '=') second) ] ].
	^ nil! !

!ZnCredential class methodsFor: 'accessing class hierarchy' stamp: 'SvenVanCaekenberghe 8/18/2011 14:09'!
findHandlerFor: anAuthHeader
	| type i |
	i := anAuthHeader indexOf: Character space.
	type := anAuthHeader copyFrom: 1 to: i - 1.
	self allSubclassesDo: [ :subclass |
		subclass authName = type ifTrue: [ ^ subclass ] ].
	^ nil! !

!ZnCurrentServer commentStamp: '<historical>'!
I am ZnSignalProgress.
I am a DynamicVariable and a ProcessSpecificVariable.

I hold a reference to the current ZnServer instance during HTTP processing, during the dynamic scope of #handleRequest:!
!ZnCurrentServerSession commentStamp: '<historical>'!
I am ZnSignalProgress.
I am a ProcessLocalVariable and a ProcessSpecificVariable.

I hold a reference to the current ZnServerSession instance during HTTP processing, during the dynamic scope of #handleRequest:

ZnServerSessions are created lazily.
!
!ZnDefaultCharacterEncoder commentStamp: 'SvenVanCaekenberghe 5/14/2014 11:22'!
I am ZnDefaultCharacterEncoder.
I am a DynamicVariable and a ProcessSpecificVariable.

I can be used to modify the default ZnCharacteEncoder on a per process basis, for example:

ZnDefaultCharacterEncoder 
	value: ZnUTF8Encoder new
	during: [ ^ ZnClient new get: 'http://zn.stfx.eu/zn/small.html' ]!
!ZnDefaultServerDelegate commentStamp: '<historical>'!
I am ZnDefaultServerDelegate.
I function as a delegate for ZnServer, implementing #handleRequest:

I implement responses to the following prefixes:

/echo - an echo text of request information for debugging purposes
/dw-bench - a dynamic html page for benchmarking purposes
/unicode - a unicode test page
/random - a random string (/random/32 for a specific size)
/bytes - bytes according to a pattern (/bytes/32 for a specific size)
/favicon.ico - a Zn favicon
/status - a server status page
/error - force server errors
/session - a simpler session based counter
/help - lists all page prefixes
/ - an html welcome page

Without any matches, I respond with a page not found.

Part of Zinc HTTP Components.!
!ZnDefaultServerDelegate methodsFor: 'responses' stamp: 'SvenVanCaekenberghe 5/27/2013 16:11'!
echoRequest: request	
	"Echo request by generating a plain text response useful for debugging purposes"
	
	| delay info entity |
	delay := Integer readFrom: (request uri queryAt: 'delay' ifAbsent: [ '' ]) ifFail: [ 0 ].
	delay > 0 ifTrue: [ (Delay forSeconds: delay) wait ].  
	info := self generateEchoRequestString: request.
	entity := ZnEntity textCRLF: info.
	^ ZnResponse ok: entity! !

!ZnDefaultServerDelegate methodsFor: 'responses' stamp: 'SvenVanCaekenberghe 1/4/2011 14:52'!
random: request
	"Answer a text plain UTF-8 encoded string of random hex characters.
	Optionally take the size from the URI, as in /random/32 for 32 characters.
	Default to 64 characters with a newline at the end"
	
	| count hexString |
	count := Integer readFrom: request uri lastPathSegment ifFail: [ 64 ].
	hexString := String new: count streamContents: [ :stream |
		count - 1 timesRepeat: [ stream nextPut: '0123456789ABCDEF' atRandom ].
		stream lf ].
	^ ZnResponse ok: (ZnEntity text: hexString)! !

!ZnDefaultServerDelegate methodsFor: 'responses' stamp: 'SvenVanCaekenberghe 11/10/2012 23:41'!
sessionRequest: request	
	"An HTML response that uses a session"
	
	| session hitCount |
	session := request session.
	hitCount := session attributeAt: #hitCount ifAbsent: [ 0 ].
	hitCount := hitCount + 1.
	session attributeAt: #hitCount put: hitCount. 
	^ ZnResponse ok: (ZnEntity html: (self generateSessionRequest: session))! !

!ZnDefaultServerDelegate methodsFor: 'responses' stamp: 'SvenVanCaekenberghe 10/8/2014 16:47'!
formTest1: request
	| input html |
	input := request uri queryAt: #input ifAbsent: [ 'input' ].
	html := '<h1>Form Test 1</h1>',
		'<form action="form-test-1" accept-charset="utf-8" method="get">',
		'Input <input type="input" name="input" value="{1}"> ',
		'<input type="submit"> for input <em>{1}</em>',
		'</form>' format: { input }.
	^ ZnResponse ok: (ZnEntity html: html)! !

!ZnDefaultServerDelegate methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/21/2012 10:35'!
map: prefix to: handler
	"Arrange for the receiver to dispatch requests matching prefix to handler.
	Handler can be a symbol naming a method in the receiver, 
	or a block accepting the request and producing the response"
	
	self prefixMap 
		at: prefix
		put: handler
		! !

!ZnDefaultServerDelegate methodsFor: 'private' stamp: 'SvenVanCaekenberghe 1/4/2013 13:48'!
generateHelp
	"Generate an HTML page with links to all pages I support"
	
	| title |
	title := self class name, ' Help'.
	^ String streamContents: [ :stream |
		stream << ZnConstants standardHtmlDocType.
		stream << '<html><head><title>'; << title; << '</title></head>'.
		stream << '<body><h1>'; << title; << '</h1><h3>Available Pages</h3><ul>'.
		prefixMap keys sorted do: [ :each | 
			stream << '<li><a href="'; << each; << '">'; << each; << '</a></li>' ].
		stream << '<ul></body></html>' ]! !

!ZnDefaultServerDelegate methodsFor: 'responses' stamp: 'SvenVanCaekenberghe 8/18/2011 14:09'!
bytes: request
	"Answer a number of bytes according to a pattern as an application/octet-stream.
	Optionally take the size from the URI, as in /bytes/32 for 32 bytes, default to 64 bytes.
	The main goal is to be efficient, esp. in benchmarks, that's why we cache (non-thread-safe)"
	
	| count |
	count := Integer readFrom: request uri lastPathSegment ifFail: [ 64 ].
	(byteArray isNil or: [ byteArray size ~= count ]) 
		ifTrue: [
			byteArray := ByteArray new: count.
			1 to: count - 1 do: [ :each | 
				byteArray at: each put: (#(65 66 67 68) at: (each \\ 4 + 1)) ].
			byteArray at: count put: 10 ].
	^ ZnResponse ok: (ZnEntity bytes: byteArray)! !

!ZnDefaultServerDelegate methodsFor: 'responses' stamp: 'SvenVanCaekenberghe 12/14/2010 10:30'!
dwbench: request
	"Reply with the dynamic DW-Bench HTML page"

	^ ZnResponse ok: (ZnEntity html: self generateDWBench)! !

!ZnDefaultServerDelegate methodsFor: 'private' stamp: 'SvenVanCaekenberghe 11/10/2012 23:43'!
generateSessionRequest: session
	"Generate an HTML page using a session"
	
	^ String streamContents: [ :stream |
		stream << ZnConstants standardHtmlDocType.
		stream nextPutAll: '<html><head><title>Session</title></head>'.
		stream nextPutAll: '<body><h1>Session</h1>'.
		stream nextPutAll: '<p>I am using '; print: session; nextPutAll: '</p>'.
		stream nextPutAll: '<p>Current session-id='; nextPutAll: session id; nextPutAll: '</p>'.
		stream nextPutAll: '<p>Session hit count is '; print: (session attributeAt: #hitCount); nextPutAll: '</p>'.
		stream nextPutAll: '</body></html>' ] ! !

!ZnDefaultServerDelegate methodsFor: 'responses' stamp: 'SvenVanCaekenberghe 10/10/2014 09:05'!
formTest3: request
	| contents filename contentType html |
	contents := filename := contentType := ''.
	(request hasEntity and: [ request contentType matches: ZnMimeType multiPartFormData ])
		ifTrue: [ 
			(request entity partNamed: #file ifNone: [ nil ]) 
				ifNotNil: [ :part |
					filename := part fileName.
					contents := part contents.
					contentType := part  contentType.
					contentType isBinary ifTrue: [ contents := contents hex ] ] ].
	html := '<h1>Form Test 3</h1>',
		'<form action="form-test-3" accept-charset="utf-8" enctype="multipart/form-data" method="post">',
		'file <input type="file" name="file"> ',
		'<input type="submit">',
		'</form>',
		'<p>filename = <em>{1}</em></p>',
		'<p>content-type = <em>{2}</em></p>',
		'<p>contents = <em>{3}</em></p>' format: { filename. contentType. contents }.
	^ ZnResponse ok: (ZnEntity html: html)! !

!ZnDefaultServerDelegate methodsFor: 'private' stamp: 'SvenVanCaekenberghe 3/31/2011 09:46'!
processes
	^ (Process allSubInstances
		reject: [ :each | each isTerminated or: [ each = Processor activeProcess ] ])
		sorted: [ :a :b | a priority >= b priority ] ! !

!ZnDefaultServerDelegate methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 10/8/2014 16:15'!
initialize
	self
		map: 'welcome' to: #welcome:;
		map: 'help' to: #help:;
		map: 'echo' to: #echoRequest:;
		map: 'dw-bench' to: #dwbench:;
		map: 'favicon.ico' to: #favicon:;
		map: 'random' to: #random:;
		map: 'bytes' to: #bytes:;
		map: 'status' to: #status:;
		map: 'unicode' to: #unicode:;
		map: 'session' to: #sessionRequest:;
		map: 'error' to: #errorResponse:;
		map: 'form-test-1' to: #formTest1:;
		map: 'form-test-2' to: #formTest2:;
		map: 'form-test-3' to: #formTest3:;
		map: '/' to: 'welcome'! !

!ZnDefaultServerDelegate methodsFor: 'public' stamp: 'SvenVanCaekenberghe 8/22/2012 14:40'!
value: request
	"I implement the generic #value: message as equivalent to #handleRequest:"
	
	^ self handleRequest: request! !

!ZnDefaultServerDelegate methodsFor: 'private' stamp: 'SvenVanCaekenberghe 3/1/2012 13:55'!
systemVersionInfo
	^ String streamContents: [ :stream |
			stream 
				print: SystemVersion current; 
				nextPutAll: ' - '; 
				nextPutAll: ZnConstants defaultServerString ]
	! !

!ZnDefaultServerDelegate methodsFor: 'responses' stamp: 'SvenVanCaekenberghe 12/23/2012 18:03'!
errorResponse: request
	"Here we artificially signal an Error at the Smalltalk level,
	optionally with a user defined message."
	
	| message |
	message := request uri queryAt: 'message' ifAbsent: [ 'An artifical error' ].
	Error signal: message! !

!ZnDefaultServerDelegate methodsFor: 'responses' stamp: 'SvenVanCaekenberghe 3/31/2011 09:17'!
help: request
	"Reply with a dynamic HTML page containing links to all pages I support"

	^ ZnResponse ok: (ZnEntity html: self generateHelp)
	! !

!ZnDefaultServerDelegate methodsFor: 'responses' stamp: 'SvenVanCaekenberghe 12/14/2010 10:39'!
favicon: request
	"Answer a nice favicon for browsers to display"

	| entity |
	entity := ZnEntity with: ZnConstants faviconBytes type: 'image/vnd.microsoft.icon'. 
	^ ZnResponse ok: entity! !

!ZnDefaultServerDelegate methodsFor: 'responses' stamp: 'SvenVanCaekenberghe 12/14/2010 10:40'!
unicode: request
	"Answer a Unicode Test HTML page"
	
	^ ZnResponse ok: (ZnEntity html: self generateUnicodeTest)! !

!ZnDefaultServerDelegate methodsFor: 'responses' stamp: 'SvenVanCaekenberghe 12/14/2010 10:39'!
welcome: request
	"Answer a nice HTML welcome page"
	
	| html entity |
	html := ZnConstants welcomePageHtml copy 
		replaceAll: Character cr with: Character lf.
	entity := ZnEntity html: html. 
	^ ZnResponse ok: entity! !

!ZnDefaultServerDelegate methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/21/2012 10:36'!
prefixMap
	^ prefixMap ifNil: [ prefixMap := Dictionary new ]! !

!ZnDefaultServerDelegate methodsFor: 'private' stamp: 'SvenVanCaekenberghe 11/10/2012 18:15'!
generateStatus
	"Generate an HTML page with the state of the server"
	
	^ String streamContents: [ :stream |
		stream << ZnConstants standardHtmlDocType.
		stream nextPutAll: '<html><head><title>ZnServer Status</title></head>'.
		stream nextPutAll: '<body><h1>ZnServer Status</h1>'.
		stream nextPutAll: '<p>I am '; print: ZnCurrentServer value; nextPutAll: '</p>'.
		stream nextPutAll: '<p>'; nextPutAll: self systemVersionInfo; nextPutAll: '</p>'.
		stream nextPutAll: '<pre>'; nextPutAll: self vmStats; nextPutAll: '</pre>'.  
		stream nextPutAll: '<h1>Processes</h1><ol>'.
		self processes do: [ :each |
			stream 
				nextPutAll: '<li>'; 
				nextPutAll: each name; space; nextPut: $[; print: each priority; nextPut: $]; nextPutAll: '<br/>'; nextPutAll: each printString;
				nextPutAll: '</li>' ].
		stream nextPutAll: '</ol>'.  
		stream nextPutAll: '</body></html>' ]! !

!ZnDefaultServerDelegate methodsFor: 'responses' stamp: 'SvenVanCaekenberghe 3/31/2011 09:18'!
status: request
	"Reply with a dynamic HTML page describing the state of the server"

	^ ZnResponse ok: (ZnEntity html: self generateStatus)
	! !

!ZnDefaultServerDelegate methodsFor: 'private' stamp: 'SvenVanCaekenberghe 3/18/2012 19:08'!
generateDWBench
	"Generate the dynamic DW-Bench HTML page.
	Although the date/time is variable, the page size is constant."
	
	^ String streamContents: [ :stream |
		stream << ZnConstants standardHtmlDocType.
		stream << '<html><head><title>DW-Bench Dynamic</title></head>'.
		stream << '<body><h1>DW-Bench Dynamic</h1><table border=1>'.
		1 to: 25 do: [ :row |
			stream << '<tr>'.
			1 to: 25 do: [ :col |
				stream << '<td>'; print: row * col; << '</td>' ].
			stream << '</tr>' ].
		stream << '</table><p>'; << Date today yyyymmdd; space; << Time now print24; << '</p></body></html>' ]! !

!ZnDefaultServerDelegate methodsFor: 'responses' stamp: 'SvenVanCaekenberghe 10/8/2014 16:47'!
formTest2: request
	| input html |
	input := 'input'.
	(request hasEntity and: [ request contentType matches: ZnMimeType applicationFormUrlEncoded  ])
		ifTrue: [ input := request entity at: #input ifAbsent: [ 'input' ] ].
	html := '<h1>Form Test 2</h1>',
		'<form action="form-test-2" accept-charset="utf-8" method="post">',
		'Input <input type="input" name="input" value="{1}"> ',
		'<input type="submit"> for input <em>{1}</em>',
		'</form>' format: { input }.
	^ ZnResponse ok: (ZnEntity html: html)! !

!ZnDefaultServerDelegate methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/7/2013 15:02'!
generateEchoRequestString: request
	"Generate a string echoing the request"
	
	^ String streamContents: [ :stream |
		stream nextPutAll: 'This is Zinc HTTP Components echoing your request !!'; crlf.
		stream nextPutAll: 'Running '; print: request server; crlf.
		stream nextPutAll: request method; nextPutAll: ' request for '.
		request uri printPathQueryFragmentOn: stream.
		stream crlf; nextPutAll: 'with headers'; crlf.
		request headersDo: [ :key :value |
			stream space; nextPutAll: key; nextPutAll: ': '; nextPutAll: value; crlf ].
		request hasEntity ifTrue: [
			stream nextPutAll: ' containing '; print: request entity ] ]! !

!ZnDefaultServerDelegate methodsFor: 'private' stamp: 'SvenVanCaekenberghe 8/11/2011 10:12'!
generateUnicodeTest
	"Generate an HTML page containing all Unicode characters with code points between 0 and 16r024F in a nice table"
	
	^ String streamContents: [ :stream |
		stream << ZnConstants standardHtmlDocType.
		stream << '<html><head><title>Unicode Test Page</title></head>'.
		stream << '<body><h1>Unicode Test Page</h1><table>'.
		0 to: 16r024F by: 8 do: [ :row |
			stream nextPutAll: '<tr>'.
			row to: row + 7 do: [ :each |
				stream nextPutAll: '<td>U+'.
				stream nextPutAll: (each printPaddedWith: $0 to: 4 base: 16). 
				stream nextPut: $=; nextPut: each asCharacter.
				stream nextPutAll: '</td>' ].
			stream nextPutAll: '</tr>' ].
		stream << '</table></body></html>' ]! !

!ZnDefaultServerDelegate methodsFor: 'private' stamp: 'SvenVanCaekenberghe 3/1/2012 13:54'!
vmStats
	^  [ SmalltalkImage current vm statisticsReport ]
		on: MessageNotUnderstood 
		do: [ SmalltalkImage current vmStatisticsReportString ]! !

!ZnDefaultServerDelegate methodsFor: 'public' stamp: 'PaulDeBruicker 4/19/2012 16:02'!
handleRequest: request
	| prefix prefixHandler |
	prefix := request uri isSlash
		ifTrue: [ prefixMap at: '/' ifAbsent: [ nil ] ]
		ifFalse: [ request uri firstPathSegment ].
	prefixHandler := prefixMap at: prefix ifAbsent: [ nil ].
	prefixHandler isNil
		ifFalse: [ 
			^ prefixHandler isSymbol
				ifTrue: [ self perform: prefixHandler with: request ]
				ifFalse: [ prefixHandler value: request ] ].
	^ ZnResponse notFound: request uri! !

!ZnDefaultServerDelegate class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 12/10/2010 15:17'!
new
	^ super new initialize! !

!ZnDigestAuthenticator commentStamp: 'SvenVanCaekenberghe 12/6/2010 12:47'!
I am ZnDigestAuthenticator.
I help servers handle HTTP Digest Authentication.

I have a nonces dictionary with nonce->opaque associations. 
I generate a new nonce value for every 401 response I trigger.

Part of Zinc HTTP Components.!
!ZnDigestAuthenticator methodsFor: 'private' stamp: 'SvenVanCaekenberghe 8/18/2011 14:03'!
a1for: username
	| password |
	password := credentials at: username ifAbsent: [ ^ nil ].
	^ self class md5Hash: username, ':', self realm, ':', password
	! !

!ZnDigestAuthenticator methodsFor: 'private' stamp: 'SvenVanCaekenberghe 8/18/2011 14:18'!
a2forUrl: uri method: method
	^ self class md5Hash: method, ':', uri
	! !

!ZnDigestAuthenticator methodsFor: 'private' stamp: 'SvenVanCaekenberghe 11/10/2013 11:32'!
createNonce
	| pt |
	pt := DateAndTime now asString, ':', Random new next asString.
	^ self class md5Hash: pt! !

!ZnDigestAuthenticator methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:18'!
isRequestAuthenticated: request
	| authorization response cresponse a1 a2 nonce opaque |
	authorization := self class parseAuthRequest: (request headers at: 'Authorization' ifAbsent: [ ^ false ]).
	nonce := authorization at: 'nonce' ifAbsent: [ ^ false ].
	opaque := self nonces at: nonce ifAbsent: [ ^ false ].
	a1 := self a1for: (authorization at: 'username' ifAbsent: [ ^ false ]).
	a1 ifNil: [ ^ false ].
	a2 := self a2forUrl: (authorization at: 'uri' ifAbsent: [ '/' ]) method: request method.
	response := self class md5Hash: (a1, ':', nonce, ':', a2).
	"(opaque = (authorization at: 'opaque' ifAbsent: [^false])) ifFalse: [^false]."
	cresponse := authorization at: 'response' ifAbsent: [ ^ false ].
	^ (response = cresponse)! !

!ZnDigestAuthenticator methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:18'!
nonces 
	^ nonces ifNil: [ nonces := Dictionary new ]! !

!ZnDigestAuthenticator methodsFor: 'public' stamp: 'SvenVanCaekenberghe 8/18/2011 14:18'!
authHeader
	| nonce opaque |
	nonce := self createNonce.
	opaque := self createOpaque.
	self nonces at: nonce put: opaque.
	^ 'Digest realm="', self realm, '", nonce="', nonce, '", opaque="', opaque, '"'! !

!ZnDigestAuthenticator methodsFor: 'private' stamp: 'SvenVanCaekenberghe 11/10/2013 11:32'!
createOpaque
	| pt |
	pt := Random new next asString, ':', DateAndTime now asString.
	^ self class md5Hash: pt! !

!ZnDigestAuthenticator class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/22/2012 10:21'!
parseAuthRequest: headerValue
	| data dict |
	dict := Dictionary new.
	"Chops off the ' Digest ' scheme name, a bit too brittle."
	data := headerValue copyFrom: 8 to: headerValue size.
	(data subStrings: ',') do: [ :fragment | | tokens i key value |
		tokens := fragment trimBoth.
		i := tokens indexOf: $=.
		(i > 0) ifTrue: [
			key := tokens copyFrom: 1 to: i - 1.
			value := tokens copyFrom: i + 1 to: tokens size.  
			dict at: key put: (value trimBoth: [ :char | char = $" ]) ] ].
	^ dict! !

!ZnDigestAuthenticator class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/12/2014 12:52'!
md5Hash: aString
	| hash |
	"Answer hash of aString as lowercase 32 digit hex String."
	Smalltalk at: #MD5 ifPresent: [ :cls |
		^ ((cls new initialize) hashStream: (aString asByteArray readStream)) hex ].
	hash := Smalltalk at: #CMD5Hasher ifPresent: [ :cls |
		cls hashMessage: aString ].
	hash ifNil: [
		hash := Smalltalk at: #TCryptoRandom ifPresent: [ :cls |
			(cls basicNew perform: #md5HashMessage: with: aString) asInteger ] ].
	hash ifNotNil: [
		hash := hash hex asLowercase.
		(hash beginsWith: '16r') ifTrue: [ hash := hash allButFirst: 3 ].
		hash := hash padLeftTo: 32 with: $0 ].
	^ hash
! !

!ZnDigestAuthenticator class methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:19'!
hasMD5Support
	^ (self md5Hash: 'test') isNil not! !

!ZnDigestAuthenticatorTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/22/2012 10:11'!
testParseOK
	| keys headerValue |
	headerValue := ' Digest username="Mufasa",
                     realm="testrealm@host.com",
                     nonce="dcd98b7102dd2f0e8b11d0f600bfb0c093",
                     uri="/dir/index.html",
                     qop=auth,
                     nc=00000001,
                     cnonce="0a4f113b",
                     response="6629fae49393a05397450978507c4ef1",
                     opaque="5ccc069c403ebaf9f0171e9517f40e41"'.
	keys := ZnDigestAuthenticator parseAuthRequest: headerValue.
	self assert: (keys at: 'username') equals: 'Mufasa'.
	self assert: (keys at: 'realm') equals: 'testrealm@host.com'.
	self assert: (keys at: 'qop') equals: 'auth'.
	self assert: (keys at: 'nc') equals: '00000001'.
	self assert: (keys at: 'cnonce') equals: '0a4f113b'.
	self assert: (keys at: 'response') equals: '6629fae49393a05397450978507c4ef1'.
	! !

!ZnDigestAuthenticatorTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/22/2012 10:12'!
testParseEmpty
	| keys headerValue |
	headerValue := ' Digest username="Mufasa",
                     realm="testrealm@host.com",
                     nonce="dcd98b7102dd2f0e8b11d0f600bfb0c093",
                     uri="/dir/index.html",
                     qop=,
                     nc="",
                     cnonce="0a4f113b",
                     response="6629fae49393a05397450978507c4ef1",
                     opaque="5ccc069c403ebaf9f0171e9517f40e41"'.
	keys := ZnDigestAuthenticator parseAuthRequest: headerValue.
	self assert: (keys at: 'username') equals: 'Mufasa'.
	self assert: (keys at: 'realm') equals: 'testrealm@host.com'.
	self assert: (keys at: 'qop') equals: ''.
	self assert: (keys at: 'nc') equals: ''.
	self assert: (keys at: 'cnonce') equals: '0a4f113b'.
	self assert: (keys at: 'response') equals: '6629fae49393a05397450978507c4ef1'.
	! !

!ZnDigestCredential commentStamp: 'SvenVanCaekenberghe 12/6/2010 12:59'!
I am ZnDigestCredential, a concrete subclass of ZnCredential and subclass of ZnBasicCredential.
I implement digest HTTP authentication.
I hold a nounce and opaque.

Part of Zinc HTTP Components.!
!ZnDigestCredential methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:08'!
uriPathFrom: urlObject
	^ urlObject pathPrintString ifNil: [ '/' ]! !

!ZnDigestCredential methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 8/18/2011 14:21'!
parseAuthRequest: aHeader
	^ ZnDigestAuthenticator parseAuthRequest: aHeader! !

!ZnDigestCredential methodsFor: 'operations' stamp: 'MattKennedy 9/29/2010 16:28'!
setAuthorizationHeader: headers for: urlObject method: method
	headers at: 'Authorization' put: (self authTokenForUrl: urlObject method: method)! !

!ZnDigestCredential methodsFor: 'computation' stamp: 'SvenVanCaekenberghe 8/18/2011 14:21'!
a1
	^ ZnDigestAuthenticator md5Hash: self username, ':', self realm, ':', self password! !

!ZnDigestCredential methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 8/18/2011 14:08'!
linkToAuthRequest: aHeader
	| data |
	data := self parseAuthRequest: aHeader.
	self nonce: (data at: 'nonce').
	self realm: (data at: 'realm' ifAbsent: [ '' ])! !

!ZnDigestCredential methodsFor: 'computation' stamp: 'SvenVanCaekenberghe 8/18/2011 14:21'!
a2ForUrl: urlObject method: method
	"This doesn't support all qop options yet."
	^ ZnDigestAuthenticator md5Hash: method, ':', (self uriPathFrom: urlObject)! !

!ZnDigestCredential methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:21'!
isComplete 
	^ super isComplete & nonce notNil ! !

!ZnDigestCredential methodsFor: 'accessing' stamp: 'MattKennedy 9/28/2010 14:48'!
opaque
	^ opaque! !

!ZnDigestCredential methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:37'!
authTokenForUrl: urlObject method: method
	| result |
	result := WriteStream on: String new.
	result
		nextPutAll: 'Digest username="';
		nextPutAll: self username;
		nextPutAll: '", ';
		nextPutAll: 'nonce="';
		nextPutAll: self nonce;
		nextPutAll: '", ';
		nextPutAll: 'realm="';
		nextPutAll: self realm;
		nextPutAll: '", ';
		nextPutAll: 'uri="';
		nextPutAll: (self uriPathFrom: urlObject);
		nextPutAll: '", ';
		nextPutAll: 'response="';
		nextPutAll: (self responseForUrl: urlObject method: method);
		nextPutAll: '", '.
	self opaque isNil
		ifFalse: [ 
			result
				nextPutAll: 'opaque="';
				nextPutAll: self opaque;
				nextPutAll: '"' ].
	^ result contents! !

!ZnDigestCredential methodsFor: 'accessing' stamp: 'MattKennedy 9/28/2010 14:48'!
opaque: anObject
	opaque := anObject! !

!ZnDigestCredential methodsFor: 'accessing' stamp: 'MattKennedy 9/28/2010 14:48'!
nonce: anObject
	nonce := anObject! !

!ZnDigestCredential methodsFor: 'computation' stamp: 'SvenVanCaekenberghe 8/18/2011 14:21'!
responseForUrl: urlObject method: method
	^ ZnDigestAuthenticator md5Hash: self a1, ':', self nonce, ':', (self a2ForUrl: urlObject method: method)! !

!ZnDigestCredential methodsFor: 'accessing' stamp: 'MattKennedy 9/28/2010 14:48'!
nonce
	^ nonce! !

!ZnDigestCredential class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:21'!
authName
	^ 'Digest'! !

!ZnDispatcherDelegate commentStamp: 'SvenVanCaekenberghe 5/15/2012 16:03'!
I am ZnDispatcherDelegate, doing a straight-forward dispatching to mapped URLs.

ZnDispatcherDelegate API:

(server := ZnServer startDefaultOn: 9090)
	delegate: (ZnDispatcherDelegate new 
		map: '/hello' to: [ :request :response | response entity: (ZnEntity html: '<h1>hello server</h1>') ];
		map: '/counter' to: [ :request :response | counterApplication handleRequest: request response: response ]).!
!ZnDispatcherDelegate methodsFor: 'public' stamp: 'NickAger 5/9/2011 16:19'!
map: relativeUrlString to: handler
	self dispatcherDictionary at: relativeUrlString put: handler! !

!ZnDispatcherDelegate methodsFor: 'accessing' stamp: 'NickAger 5/9/2011 16:25'!
dispatcherDictionary
	^ dispatcherDictionary ifNil: [ dispatcherDictionary := Dictionary new ]! !

!ZnDispatcherDelegate methodsFor: 'public' stamp: 'SvenVanCaekenberghe 8/18/2011 14:16'!
handleRequest: request
	| handler |
	handler := self dispatcherDictionary 
		at: request uri pathPrintString 
		ifAbsent: [ ^ ZnResponse notFound: request uri ].	
	^ handler 
		value: request 
		value: (ZnResponse new
			statusLine: (ZnStatusLine ok);
			headers: ZnHeaders defaultResponseHeaders;
			yourself).

! !

!ZnDispatcherDelegateTest methodsFor: 'private' stamp: 'SvenVanCaekenberghe 1/22/2014 10:14'!
withServerDo: block
	| server |
	server := ZnServer on: 1700 + 32 atRandom.
	[ 
		server start.
		self 
			assert: server isRunning & server isListening
			description: ('Failed to start server on port {1}. Is there one already?' format: { server port }).
		self assert: server isRunning & server isListening.
		block cull: server
	] 
		ensure: [ server stop ]! !

!ZnDispatcherDelegateTest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/12/2012 21:13'!
testDispatcherDelegate
	self withServerDo: [ :server |  | client |
		server delegate: (ZnDispatcherDelegate new 
			map: '/hello' to: [ :request :response | response entity: (ZnStringEntity html: '<h1>hello server</h1>') ];
			map: '/' to: [ :request :response | response entity: (ZnStringEntity html: '<h1>default</h1>') ]).

		client := ZnClient new.
		
		client get: (server localUrl addPathSegment: 'missing'; yourself).
		self assert: (client response contentType = ZnMimeType textPlain).
		self assert: (client response status = 404).
		
		client get: server localUrl.
		self assert: (client response contentType = ZnMimeType textHtml).
		self assert: (client response status = 200).
		
		client get: (server localUrl addPathSegment: 'hello'; yourself).
		self assert: (client response contentType = ZnMimeType textHtml).
		self assert: (client response status = 200).
		
		client close ]! !

!ZnEasy commentStamp: '<historical>'!
I am ZnEasy, a simplified HTTP client for occasional use.

My class side implements a number of convenience methods to do common HTTP client operations.

	ZnEasy get: 'http://zn.stfx.eu/zn/small.html'.

For most requests, I return a response object. 

For a couple of message, I return an image Form.

	ZnEasy getPng: 'http://www.pharo-project.org/images/pharo.png'.

For my implementation I use ZnClient, a full featured HTTP client.

Part of Zinc HTTP Components.!
!ZnEasy class methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 8/1/2014 16:10'!
getJpeg: urlObject
	"self getJpeg: 'http://caretaker.wolf359.be/sun-fire-x2100.jpg'."
	
	^ self 
		getImageOfType: ZnMimeType imageJpeg 
		usingParser: JPEGReadWriter 
		fromUrl: urlObject 
	! !

!ZnEasy class methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 9/15/2011 16:24'!
get: urlObject username: username password: password
	^ self client
		url: urlObject;
		setBasicAuthenticationUsername: username password: password;
		get;
		response
	! !

!ZnEasy class methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 9/15/2011 16:24'!
delete: urlObject username: username password: password
	^ self client
		url: urlObject;
		setBasicAuthenticationUsername: username password: password;
		delete;
		response
	! !

!ZnEasy class methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 8/1/2014 16:10'!
get: urlObject
	"self get: 'http://caretaker.wolf359.be/small.html'."
	
	^ self client
		url: urlObject;
		get;
		response
	! !

!ZnEasy class methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 9/15/2011 16:24'!
head: urlObject username: username password: password
	^ self client
		url: urlObject;
		setBasicAuthenticationUsername: username password: password;
		head;
		response! !

!ZnEasy class methodsFor: 'private' stamp: 'SvenVanCaekenberghe 9/15/2011 16:24'!
getImageOfType: mimeType usingParser: parserClass fromUrl: urlObject
	| client |
	(client := self client)
		url: urlObject;
		accept: mimeType;
		enforceHttpSuccess: true;
		enforceAcceptContentType: true;
		get.
	^ (parserClass on: client entity readStream) nextImage
	! !

!ZnEasy class methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 7/4/2012 17:56'!
getGif: urlObject
	"self getGif: 'http://zn.stfx.eu/zn/Hot-Air-Balloon.gif'."
	
	^ self 
		getImageOfType: ZnMimeType imageGif 
		usingParser: GIFReadWriter 
		fromUrl: urlObject 
	! !

!ZnEasy class methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 8/1/2014 16:17'!
getPng: urlObject
	"self getPng: 'http://pharo.org/files/pharo.png'."
	"(self getPng: 'http://chart.googleapis.com/chart?cht=tx&chl=',
		'a^2+b^2=c^2' urlEncoded) asMorph openInHand."
	
	^ self 
		getImageOfType: ZnMimeType imagePng 
		usingParser: PNGReadWriter 
		fromUrl: urlObject 
	! !

!ZnEasy class methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 9/15/2011 16:24'!
put: urlObject data: entity
	^ self client
		url: urlObject;
		entity: entity;
		put;
		response	! !

!ZnEasy class methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 9/15/2011 16:24'!
post: urlObject data: entity username: username password: password
	^ self client
		url: urlObject;
		setBasicAuthenticationUsername: username password: password;
		entity: entity;
		post;
		response! !

!ZnEasy class methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 9/15/2011 16:24'!
head: urlObject
	^ self client
		url: urlObject;
		head;
		response! !

!ZnEasy class methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 9/15/2011 16:24'!
post: urlObject data: entity
	^ self client
		url: urlObject;
		entity: entity;
		post;
		response! !

!ZnEasy class methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 9/15/2011 16:24'!
put: urlObject data: entity username: username password: password
	^ self client
		url: urlObject;
		setBasicAuthenticationUsername: username password: password;
		entity: entity;
		put;
		response	! !

!ZnEasy class methodsFor: 'private' stamp: 'SvenVanCaekenberghe 11/8/2011 22:16'!
client
	^ ZnClient new
		beOneShot;
		yourself! !

!ZnEasy class methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 9/15/2011 16:24'!
delete: urlObject
	^ self client
		url: urlObject;
		delete;
		response! !

!ZnEasyTests methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/13/2014 14:45'!
smallHtmlUrl
	^ 'http://zn.stfx.eu/zn/small.html' asZnUrl! !

!ZnEasyTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/13/2014 14:46'!
testHeadSmallHTMLDocument
	| url response |
	url := self smallHtmlUrl.
	response := ZnEasy head: url.
	self assert: (response headers contentType = ZnMimeType textHtml).
	self assert: (response statusLine code = 200).
	self assert: response hasEntity not! !

!ZnEasyTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/13/2014 14:45'!
testGetSmallHTMLDocument
	| url response |
	url := self smallHtmlUrl.
	response := ZnEasy get: url.
	self assert: (response headers contentType = ZnMimeType textHtml).
	self assert: (response statusLine code = 200).
	self assert: (response entity string includesSubstring: 'small')! !

!ZnEasyTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
testPut
	self withServerDo: [ :server | | response data |
		data := String streamContents: [ :stream | 1 to: 32 do: [ :each | stream nextPut: 'abc' atRandom ] ].
		response := ZnEasy put: (server localUrl addPathSegment: 'echo'; yourself) data: (ZnEntity text: data).
		self assert: (response headers contentType = ZnMimeType textPlain).
		self assert: (response statusLine code = 200).
		self assert: (response entity string includesSubstring: 'PUT').
		self assert: (response entity string includesSubstring: data) ]! !

!ZnEasyTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/15/2011 16:34'!
testGetJpeg
	| url result |
	url := 'http://caretaker.wolf359.be/sun-fire-x2100.jpg'.
	result := ZnEasy getJpeg: url.
	self assert: result isForm! !

!ZnEasyTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/12/2012 21:07'!
testTimeout
	self withServerDo: [ : server |
		self 
			should: [ 
				ZnConnectionTimeout 
					value: 1 
					during: [ ZnEasy get: (server localUrl addPathSegment: 'echo'; queryAt: 'delay' put: '2'; yourself) ] ] 
			raise: ConnectionTimedOut ]
	! !

!ZnEasyTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
testPost
	self withServerDo: [ :server | | response data |
		data := String streamContents: [ :stream | 1 to: 32 do: [ :each | stream nextPut: 'abc' atRandom ] ].
		response := ZnEasy post: (server localUrl addPathSegment: 'echo'; yourself) data: (ZnEntity text: data).
		self assert: (response headers contentType = ZnMimeType textPlain).
		self assert: (response statusLine code = 200).
		self assert: (response entity string includesSubstring: 'POST').
		self assert: (response entity string includesSubstring: data) ]! !

!ZnEasyTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
testDelete
	self withServerDo: [ :server | | response |
		response := ZnEasy delete: (server localUrl addPathSegments: #('echo' 'foo'); yourself).
		self assert: (response headers contentType = ZnMimeType textPlain).
		self assert: (response statusLine code = 200).
		self assert: (response entity string includesSubstring: 'DELETE').
		self assert: (response entity string includesSubstring: 'foo') ]! !

!ZnEasyTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
testPostUnicodeUtf8
	self withServerDo: [ :server | | response data |
		data := String streamContents: [ :stream | 0 to: 16r024F do: [ :each | stream nextPut: each asCharacter ] ].
		response := ZnEasy post: (server localUrl addPathSegment: 'echo'; yourself) data: (ZnEntity text: data).
		self assert: (response headers contentType = ZnMimeType textPlain).
		self assert: (response statusLine code = 200).
		self assert: (response entity string includesSubstring: 'POST').
		self assert: (response entity string includesSubstring: data) ]! !

!ZnEasyTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 1/22/2014 10:15'!
withServerDo: block
	| server |
	server := ZnServer on: 1700 + 32 atRandom.
	[ 
		server start.
		self 
			assert: server isRunning & server isListening
			description: ('Failed to start server on port {1}. Is there one already?' format: { server port }).
		self assert: server isRunning & server isListening.
		block cull: server
	] 
		ensure: [ server stop ]! !

!ZnEntity commentStamp: 'SvenVanCaekenberghe 1/18/2011 11:03'!
I am ZnEntity, an abstract HTTP Entity.

An entity has a content type (mime-type), a content length (byte length) and a contents.

Entities can encode and decode themselves to and from binary streams.

Part of Zinc HTTP Components.!
!ZnEntity methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 12/14/2010 10:56'!
printContentsOn: stream
	self printContentTypeAndLengthOn: stream! !

!ZnEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/6/2010 21:57'!
contentType
	^ contentType ! !

!ZnEntity methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 5/22/2013 10:41'!
hash
	^ self contentType hash bitXor: self contentLength hash! !

!ZnEntity methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 12/14/2010 11:19'!
printContentTypeAndLengthOn: stream
	self hasContentType ifTrue: [ 
		stream print: self contentType; space ].
	self hasContentLength ifTrue: [
		stream print: self contentLength; nextPut: $B ]! !

!ZnEntity methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/1/2011 17:51'!
isEmpty 
	self subclassResponsibility ! !

!ZnEntity methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 9/6/2010 22:02'!
readFrom: stream
	self subclassResponsibility ! !

!ZnEntity methodsFor: 'writing' stamp: 'SvenVanCaekenberghe 9/6/2010 21:30'!
writeOn: stream
	self subclassResponsibility ! !

!ZnEntity methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 8/18/2011 12:50'!
close! !

!ZnEntity methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 10/16/2014 10:53'!
readBinaryFrom: stream
	self readFrom: stream! !

!ZnEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/4/2013 15:25'!
contentType: object
	"We only allow assignment compatible with our designated mime type"
	
	| newType |
	newType := object asZnMimeType.
	contentType = newType 
		ifTrue: [ ^ self ]
		ifFalse: [ 
			(self class designatedMimeType isNil or: [ self class matches: newType ])
				ifTrue: [ contentType := newType ] ]! !

!ZnEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/6/2010 21:57'!
contentLength: integer
	contentLength := integer! !

!ZnEntity methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 5/22/2013 10:42'!
= other
	self class = other class ifFalse: [ ^ false ].
	^ self contentType = other contentType and: [ self contentLength = other contentLength ]! !

!ZnEntity methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/14/2010 11:25'!
hasContentLength
	^ contentLength notNil! !

!ZnEntity methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 12/4/2010 12:24'!
printOn: stream
	super printOn: stream.
	stream nextPut: $(.
	self printContentsOn: stream.
	stream nextPut: $)! !

!ZnEntity methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/14/2010 11:26'!
hasContentType
	^ contentType notNil! !

!ZnEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/13/2010 22:04'!
contents
	self subclassResponsibility! !

!ZnEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/25/2010 22:17'!
contentLength 
	"Content length can be nil when it is (currently) unknown."
	
	^ contentLength! !

!ZnEntity methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 5/7/2013 15:58'!
asByteArray
	"Return the ByteArray that is the binary, encoded representation of the receiver"
	
	^ ByteArray streamContents: [ :stream | self writeOn: stream ]! !

!ZnEntity class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 4/7/2012 17:36'!
readFrom: stream usingType: mimeType andLength: length
	"Create and return a new buffered entity of mimeType and length from stream.
	The concrete subclass depends on mimeType"
	
	| newEntity |
	newEntity := (self concreteSubclassForType: mimeType binary: false) 
						type: mimeType length: length.
	newEntity readFrom: stream.
	^ newEntity 
! !

!ZnEntity class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 10/16/2014 10:42'!
readBinaryFrom: stream usingType: mimeType andLength: length
	"Create and return a new buffered entity of mimeType and length from stream.
	The concrete subclass depends on mimeType, but textual type will remain binary"
	
	| newEntity |
	newEntity := (self concreteSubclassForType: mimeType binary: true) 
						type: mimeType length: length.
	newEntity readBinaryFrom: stream.
	^ newEntity 
! !

!ZnEntity class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 1/6/2013 22:46'!
textCRLF: text
	^ self text: text, String crlf! !

!ZnEntity class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 12/3/2010 14:00'!
bytes: bytes
	^ self byteArrayEntityClass bytes: bytes! !

!ZnEntity class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 12/3/2010 14:01'!
html: html
	^ self stringEntityClass html: html! !

!ZnEntity class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/6/2010 13:48'!
stringEntityClass
	^ ZnStringEntity! !

!ZnEntity class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 12/3/2010 14:02'!
with: object
	"Create a new entity holding object.
	Currently works for strings and byte arrays.
	You will probably want to set the mime type to something more specific"
	
	^ object isString 
		ifTrue: [ self text: object ] 
		ifFalse: [ self bytes: object ]! !

!ZnEntity class methodsFor: 'private' stamp: 'SvenVanCaekenberghe 6/4/2013 15:27'!
concreteSubclassForType: mimeType binary: forceBinary
	"Answer the concrete ZnEntity subclass that handles mimeType"
	
	^ self allSubclasses 
		detect: [ :each | 
			each matches: mimeType ]
		ifNone: [ 
			(mimeType isBinary or: [ forceBinary ])
				ifTrue: [ self byteArrayEntityClass ] 
				ifFalse: [ self stringEntityClass ] ]
! !

!ZnEntity class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 12/3/2010 14:01'!
text: text
	^ self stringEntityClass text: text! !

!ZnEntity class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/12/2010 11:06'!
type: type length: length
	"Create a new entity with a given mime type and length"
	
	^ self new
		contentType: type;
		contentLength: length;
		yourself! !

!ZnEntity class methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/11/2010 17:22'!
designatedMimeType
	"Answer the mime type we are designated to handle.
	See #concreteSubclassForType: "
	
	self subclassResponsibility ! !

!ZnEntity class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/17/2010 17:07'!
new
	^ super new initialize ! !

!ZnEntity class methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/4/2013 14:43'!
matches: mimeType
	"Return whether a given mimeType can be handled by instances of the receiver"
	
	^ mimeType matches: self designatedMimeType ! !

!ZnEntity class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 12/11/2011 18:12'!
xml: text
	^ self stringEntityClass xml: text! !

!ZnEntity class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/25/2010 22:16'!
type: type
	"Create a new entity with a given mime type and (currently) undetermined length"
	
	^ self new
		contentType: type;
		yourself! !

!ZnEntity class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/17/2010 20:39'!
with: object type: type
	"Create a new entity holding object.
	Currently works for strings and byte arrays.
	The entity is set to mime type"
	
	^ (self with: object)
		contentType: type;
		yourself! !

!ZnEntity class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/3/2010 13:57'!
byteArrayEntityClass
	^ ZnByteArrayEntity ! !

!ZnEntityReader commentStamp: 'SvenVanCaekenberghe 4/7/2012 16:37'!
I am ZnEntityReader, I help reading ZnEntities from a stream given meta data in headers.

I deal with chunking and gzip decoding.

I have several options:
	- to read streaming entities, where the client has to do the actual reading
	- to read binary entities, where textual content is not interpreted
	- to allow reading up to end, when there is no content length set

Part of Zinc HTTP Components.!
!ZnEntityReader methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/28/2013 13:17'!
readEntityFromStream
	| entity decodedEntityLength chunkedStream isChunked |
	chunkedStream := (isChunked := self isChunked) ifTrue: [ stream := ZnChunkedReadStream on: stream ] ifFalse: [ nil ].
	self isGzipped 
		ifTrue: [ 
			self hasContentLength ifTrue: [ stream := ZnLimitedReadStream on: stream limit: self contentLength ].
			decodedEntityLength := nil.
			stream := GZipReadStream on: stream ]
		ifFalse: [ decodedEntityLength := self contentLength ].
	entity := self readFrom: stream usingType: self contentType andLength: decodedEntityLength.
	isChunked ifTrue: [ 
		self isIdentityEncoded ifTrue: [ entity contentLength: stream totalSize ].
		chunkedStream extraHeaders ifNotNil: [ :extraHeaders | self headers addAll: extraHeaders ] ].
	^ entity! !

!ZnEntityReader methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/25/2010 22:23'!
stream
	^ stream! !

!ZnEntityReader methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/25/2010 23:11'!
contentType
	^ (self headers includesKey: 'Content-Type') 
		ifTrue: [ self headers contentType ] 
		ifFalse: [ ZnMimeType applicationOctetStream ]! !

!ZnEntityReader methodsFor: 'public' stamp: 'SvenVanCaekenberghe 10/10/2014 09:11'!
readEntity
	| entity |
	self canReadContent ifFalse: [ ^ nil ].
	self withDefaultUtf8Decoding: [ entity := self readEntityFromStream ].
	^ entity isEmpty
		ifTrue: [ nil ]
		ifFalse: [ entity ]    ! !

!ZnEntityReader methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/25/2010 22:23'!
headers
	^ headers! !

!ZnEntityReader methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/25/2010 23:03'!
isStreaming
	^ streaming notNil and: [ streaming ]! !

!ZnEntityReader methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/25/2010 22:31'!
streaming
	streaming := true! !

!ZnEntityReader methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/7/2012 16:37'!
binary
	binary := true! !

!ZnEntityReader methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 10/3/2010 16:07'!
allowsReadingUpToEnd
	^ allowReadingUpToEnd notNil and: [ allowReadingUpToEnd ]! !

!ZnEntityReader methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/25/2010 22:22'!
stream: readStream
	stream := readStream ! !

!ZnEntityReader methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 4/7/2012 16:37'!
isBinary
	^ binary notNil and: [ binary ]! !

!ZnEntityReader methodsFor: 'private' stamp: 'SvenVanCaekenberghe 4/7/2012 16:42'!
readFrom: readStream usingType: contentType andLength: length
	| entityClass selector |
	entityClass := self isStreaming 
		ifTrue: [ ZnStreamingEntity ]
		ifFalse: [ ZnEntity ].
	selector := self isBinary 
		ifTrue: [ #readBinaryFrom:usingType:andLength: ]
		ifFalse: [ #readFrom:usingType:andLength: ].
	^ entityClass perform: selector 
		with: readStream
		with: contentType 
		with: length! !

!ZnEntityReader methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/27/2010 13:55'!
isGzipped
	| contentEncoding |
	contentEncoding := self headers at: 'Content-Encoding' ifAbsent: [ ^ false ].
	^ contentEncoding = 'gzip'! !

!ZnEntityReader methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/27/2010 16:45'!
isIdentityEncoded
	^ self isGzipped not! !

!ZnEntityReader methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 4/20/2011 12:39'!
canReadContent
	^ self hasContentLength or: [ self isChunked or: [ self allowsReadingUpToEnd ] ]! !

!ZnEntityReader methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/28/2013 12:02'!
isChunked
	| transferEncoding |
	transferEncoding := self headers at: 'Transfer-Encoding' ifAbsent: [ ^ false ].
	^ transferEncoding = 'chunked' or: [ transferEncoding beginsWith: 'chunked' ]! !

!ZnEntityReader methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/25/2010 22:35'!
hasContentLength
	^ self headers includesKey: 'Content-Length'! !

!ZnEntityReader methodsFor: 'private' stamp: 'SvenVanCaekenberghe 10/13/2014 22:14'!
withDefaultUtf8Decoding: block
	"Run block with the default character encoder set to UTF-8
	unless it was already set at a higher level, in which case we do nothing"
	
	^ ZnDefaultCharacterEncoder 
		value: (ZnDefaultCharacterEncoder value ifNil: [ ZnUTF8Encoder new ]) 
		during: block! !

!ZnEntityReader methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/3/2010 16:07'!
allowReadingUpToEnd
	allowReadingUpToEnd := true! !

!ZnEntityReader methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/25/2010 23:10'!
contentLength
	^ (self headers includesKey: 'Content-Length')
		ifTrue: [ self headers contentLength ]
		ifFalse: [ nil ]! !

!ZnEntityReader methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/25/2010 22:22'!
headers: znHeaders
	headers := znHeaders! !

!ZnEntityReaderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/3/2010 16:04'!
testChunkedWithExtraHeaders
	| input headers reader entity |
	input := '3', String crlf,
		'con', String crlf,
		'8', String crlf,
		'sequence', String crlf,
		'0', String crlf, 
		'X-Foo:bar', String crlf, 
		String crlf.
	(headers := ZnHeaders new)
		at: 'Content-Type' put: 'text/plain';
		at: 'Transfer-Encoding' put: 'chunked'.
	(reader := ZnEntityReader new)
		headers: headers;
		stream: input asByteArray readStream.
	entity := reader readEntity.
	self assert: entity contents = 'consequence'.
	self assert: (headers at: 'X-Foo') = 'bar'! !

!ZnEntityReaderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/21/2011 23:08'!
testReadStreaming
	| data headers reader entity |
	data := ((1 to: 32) collect: [ :each | (0 to: 9) atRandom ]) asByteArray.
	(headers := ZnHeaders new)
		at: 'Content-Type' put: ZnMimeType applicationOctetStream printString;
		at: 'Content-Length' put: data size printString.
	(reader := ZnEntityReader new)
		headers: headers;
		stream: data readStream;
		streaming.
	entity := reader readEntity.
	self assert: entity contentType = ZnMimeType applicationOctetStream.
	self assert: entity contentLength = data size.
	self assert: entity contents = data! !

!ZnEntityReaderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/21/2011 23:13'!
testReadStreamingWriting
	| data headers reader entity output |
	data := ((1 to: 32) collect: [ :each | (0 to: 9) atRandom ]) asByteArray.
	(headers := ZnHeaders new)
		at: 'Content-Type' put: ZnMimeType applicationOctetStream printString;
		at: 'Content-Length' put: data size printString.
	(reader := ZnEntityReader new)
		headers: headers;
		stream: data readStream;
		streaming.
	entity := reader readEntity.
	self assert: entity contentType = ZnMimeType applicationOctetStream.
	self assert: entity contentLength = data size.
	output := ByteArray streamContents: [ :stream | entity writeOn: stream ].
	self assert: output = data! !

!ZnEntityReaderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/3/2010 16:03'!
testChunked
	| input headers reader entity |
	input := '3', String crlf,
		'con', String crlf,
		'8', String crlf,
		'sequence', String crlf,
		'0', String crlf, String crlf.
	(headers := ZnHeaders new)
		at: 'Content-Type' put: 'text/plain';
		at: 'Transfer-Encoding' put: 'chunked'.
	(reader := ZnEntityReader new)
		headers: headers;
		stream: input asByteArray readStream.
	entity := reader readEntity.
	self assert: entity contents = 'consequence'! !

!ZnEntityTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/3/2010 15:41'!
testReading
	| contents entity |
	contents := 'This is a test'.
	entity := ZnEntity 
				readFrom: contents asByteArray readStream 
				usingType: ZnMimeType textPlain 
				andLength: contents size.
	self assert: entity contents isString.
	self assert: entity string = contents.
	self assert: entity contentLength = contents size.
	self assert: entity contentType = ZnMimeType textPlain ! !

!ZnEntityTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/14/2014 15:42'!
testUnspecifiedEncoding
	| json bytes entity |
	json := '{"text":"Der Weg zur Hölle ist mit guten Vorsätzen gepflastert."}'.
	entity := ZnEntity with: json type: ZnMimeType applicationJson setCharSetUTF8.
	bytes := entity asByteArray.
	entity := ZnEntity with: json type: ZnMimeType applicationJson.
	self assert: entity encoder equals: ZnNullEncoder new.
	ZnDefaultCharacterEncoder 
		value: ZnUTF8Encoder new
		during: [
			entity := ZnEntity 
				readFrom: bytes readStream 
				usingType: ZnMimeType applicationJson 
				andLength: nil. 
			self assert: entity contents equals: json.
			entity := ZnEntity with: json type: ZnMimeType applicationJson.
			self assert: entity encoder equals: ZnUTF8Encoder new ]! !

!ZnEntityTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/25/2013 14:41'!
testReadingApplicationFormUrlEncodingNoLength
	| input entity |
	input := #(111 97 117 116 104 95 116 111 107 101 110 95 115 101 99 114 101 116 61 98 121 112 104 57 99 109 104 106 49 53 101 108 121 56 38 111 97 117 116 104 95 116 111 107 101 110 61 56 54 101 112 106 51 116 118 100 49 107 115 120 111 57)
		asByteArray.
	entity := ZnEntity readFrom: input readStream usingType: ZnMimeType applicationFormUrlEncoded andLength: nil.
	self deny: entity isEmpty.
	self assert: (entity includesField: 'oauth_token_secret').
	self assert: (entity includesField: 'oauth_token').
	self assert: (entity at: 'oauth_token_secret') equals: 'byph9cmhj15ely8'.
	self assert: (entity at: 'oauth_token') equals: '86epj3tvd1ksxo9'! !

!ZnEntityTests methodsFor: 'testing' stamp: 'PaulDeBruicker 04/10/2011 10:46'!
testUTF8Writing
	| string entity bytes |
	string := String with: $$ with: (16r00A2 asCharacter) with: ( 16r20AC asCharacter) with: (16r024B62 asCharacter).
	entity := ZnStringEntity text: string.
	self assert: entity contentType = ZnMimeType textPlain.
	self assert: entity contentLength = 10.
	bytes := ByteArray streamContents: [ :stream | entity writeOn: stream ].
	self assert: bytes = #(16r24 16rC2 16rA2 16rE2 16r82 16rAC 16rF0 16rA4 16rAD 16rA2) asByteArray! !

!ZnEntityTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 10/16/2014 11:27'!
testMultiPartFormDataWriteReadBinary
	| input output bytes |
	input := (ZnMultiPartFormDataEntity new)
		addPart: (ZnMimePart fieldName: 'extra' value: 'my-extra');
		addPart: (ZnMimePart fieldName: 'info' value: 'my-info');
		addPart: (ZnMimePart fieldName: 'file' fileName: 'foo.txt' entity: (ZnEntity text: 'Zinc HTTP Components'));
		yourself.
	self assert: input contentLength notNil.
	self assert: input contentLength > 0.
	self assert: (input contentType matches: ZnMimeType multiPartFormData).
	bytes := ByteArray streamContents: [ :stream | input writeOn: stream ].
	output := ZnEntity readBinaryFrom: bytes readStream usingType: input contentType andLength: bytes size.
	self assert: (output partNamed: 'extra') fieldValue = 'my-extra' asByteArray.
	self assert: (output partNamed: 'info') fieldValue = 'my-info' asByteArray.
	self assert: (output partNamed: 'extra') fieldValueString = 'my-extra'.
	self assert: (output partNamed: 'info') fieldValueString = 'my-info'.
	self deny: (output partNamed: 'file') contents isString.
	self assert: (output partNamed: 'file') contents = 'Zinc HTTP Components' asByteArray! !

!ZnEntityTests methodsFor: 'testing' stamp: 'PaulDeBruicker 04/10/2011 10:46'!
testUTF8ReadingDetermined
	| string entity bytes |
	string := String with: $$ with: (16r00A2 asCharacter) with: ( 16r20AC asCharacter) with: (16r024B62 asCharacter).
	entity := ZnStringEntity type: ZnMimeType textPlain length: 10.
	bytes := #(16r24 16rC2 16rA2 16rE2 16r82 16rAC 16rF0 16rA4 16rAD 16rA2) asByteArray.
	entity readFrom: bytes readStream.
	self assert: entity contentType = ZnMimeType textPlain.
	self assert: entity contentLength = 10.
	self assert: entity contents = string! !

!ZnEntityTests methodsFor: 'testing' stamp: 'PaulDeBruicker 04/10/2011 10:46'!
testUTF8ReadingUndetermined
	| string entity bytes |
	string := String with: $$ with: (16r00A2 asCharacter) with: ( 16r20AC asCharacter) with: (16r024B62 asCharacter).
	entity := ZnStringEntity type: ZnMimeType textPlain.
	bytes := #(16r24 16rC2 16rA2 16rE2 16r82 16rAC 16rF0 16rA4 16rAD 16rA2) asByteArray.
	entity readFrom: bytes readStream.
	self assert: entity contentType = ZnMimeType textPlain.
	self assert: entity contentLength = 10.
	self assert: entity contents = string! !

!ZnEntityTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/5/2012 12:39'!
testReadingLimited
	| contents |
	contents := String new: 1025 withAll: $X.
	ZnMaximumEntitySize value: 1024 during: [
		self should: [
			ZnEntity 
				readFrom: contents asByteArray readStream 
				usingType: ZnMimeType textPlain 
				andLength: contents size ]
			raise: ZnEntityTooLarge.
		self should: [
			ZnEntity 
				readFrom: contents asByteArray readStream 
				usingType: ZnMimeType textPlain 
				andLength: nil ]
			raise: ZnEntityTooLarge ] ! !

!ZnEntityTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/12/2010 10:11'!
testWritingApplicationUrlEncoding
	| entity string |
	entity := ZnApplicationFormUrlEncodedEntity new.
	entity at: 'foo' put: 'bar'.
	string := String streamContents: [ :stream | entity writeOn: stream ].
	self assert: string = 'foo=bar'.
	self assert: entity contentLength = 7! !

!ZnEntityTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/25/2013 14:41'!
testReadingApplicationFormUrlEncoding
	| input entity |
	input := #(111 97 117 116 104 95 116 111 107 101 110 95 115 101 99 114 101 116 61 98 121 112 104 57 99 109 104 106 49 53 101 108 121 56 38 111 97 117 116 104 95 116 111 107 101 110 61 56 54 101 112 106 51 116 118 100 49 107 115 120 111 57)
		asByteArray.
	entity := ZnEntity readFrom: input readStream usingType: ZnMimeType applicationFormUrlEncoded andLength: input size.
	self deny: entity isEmpty.
	self assert: (entity includesField: 'oauth_token_secret').
	self assert: (entity includesField: 'oauth_token').
	self assert: (entity at: 'oauth_token_secret') equals: 'byph9cmhj15ely8'.
	self assert: (entity at: 'oauth_token') equals: '86epj3tvd1ksxo9'! !

!ZnEntityTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 10/16/2014 11:28'!
testMultiPartFormDataWriteRead
	| input output bytes |
	input := (ZnMultiPartFormDataEntity new)
		addPart: (ZnMimePart fieldName: 'extra' value: 'my-extra');
		addPart: (ZnMimePart fieldName: 'info' value: 'my-info');
		addPart: (ZnMimePart fieldName: 'file' fileName: 'foo.txt' entity: (ZnEntity text: 'Zinc HTTP Components'));
		yourself.
	self assert: input contentLength notNil.
	self assert: input contentLength > 0.
	self assert: (input contentType matches: ZnMimeType multiPartFormData).
	bytes := ByteArray streamContents: [ :stream | input writeOn: stream ].
	output := (ZnMultiPartFormDataEntity type: input contentType) readFrom: bytes readStream.
	self assert: (output partNamed: 'extra') fieldValue = 'my-extra'.
	self assert: (output partNamed: 'info') fieldValue = 'my-info'.
	self assert: (output partNamed: 'extra') fieldValueString = 'my-extra'.
	self assert: (output partNamed: 'info') fieldValueString = 'my-info'.
	self assert: (output partNamed: 'file') contents = 'Zinc HTTP Components'.
	output := (ZnMultiPartFormDataEntity type: input contentType length: input contentLength) readFrom: bytes readStream.
	self assert: (output partNamed: 'extra') fieldValue = 'my-extra'.
	self assert: (output partNamed: 'info') fieldValue = 'my-info'.
	self assert: (output partNamed: 'extra') fieldValueString = 'my-extra'.
	self assert: (output partNamed: 'info') fieldValueString = 'my-info'.
	self assert: (output partNamed: 'file') contents = 'Zinc HTTP Components'.

	! !

!ZnEntityTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/14/2010 12:13'!
testStringEntityEncoderInitialization
	| entity response |
	entity := ZnEntity text: 'Regression test'.
	self assert: entity hasEncoder not.
	response := ZnResponse ok: entity.
	self assert: entity hasEncoder.
	ByteArray streamContents: [ :stream | response writeOn: stream ].
	self assert: entity hasEncoder
	! !

!ZnEntityTests methodsFor: 'testing' stamp: 'NorbertHartl 12/6/2011 18:33'!
testWritingApplicationUrlEncodingWithTextEncodingLatin1
	| entity string |
	entity := ZnApplicationFormUrlEncodedEntity new.
	entity contentType charSet: 'iso-8859-1'.
	entity at: 'foo' put: (Character value: 246) asString.
	string := String streamContents: [ :stream | entity writeOn: stream ].
	self assert: string = 'foo=%F6'.
	self assert: entity contentLength = 7
	! !

!ZnEntityTests methodsFor: 'testing' stamp: 'NorbertHartl 12/6/2011 18:33'!
testWritingApplicationUrlEncodingWithTextEncodingUtf8
	| entity string |
	entity := ZnApplicationFormUrlEncodedEntity new.
	entity contentType charSet: 'utf-8'.
	entity at: 'foo' put: (Character value: 246) asString.
	string := String streamContents: [ :stream | entity writeOn: stream ].
	self assert: string = 'foo=%C3%B6'.
	self assert: entity contentLength = 10! !

!ZnEntityTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/24/2013 10:53'!
testApplicationUrlEncodingAddAll
	| entity string data |
	data := Dictionary new.
	data at: 'foo' put: 1 asString.
	data at: 'bar' put: 2 asString.
	entity := ZnApplicationFormUrlEncodedEntity new.
	"Asking for the content length will force an internal computation of the representation"
	self assert: entity contentLength = 0.
	entity addAll: data.
	string := String streamContents: [ :stream | entity writeOn: stream ].
	self assert: entity contentLength > 0.
	entity := ZnEntity 
		readFrom: string readStream 
		usingType: ZnApplicationFormUrlEncodedEntity designatedMimeType 
		andLength: string size.
	self assert: (entity at: 'foo') equals: '1'.
	self assert: (entity at: 'bar') equals: '2'! !

!ZnEntityTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 4/7/2012 17:45'!
testReadingBinary
	| contents entity |
	contents := 'This is a test'.
	entity := ZnEntity 
				readBinaryFrom: contents asByteArray readStream 
				usingType: ZnMimeType textPlain 
				andLength: contents size.
	self deny: entity contents isString.
	self assert: entity contents = contents asByteArray.
	self assert: entity contentLength = contents size.
	self assert: entity contentType = ZnMimeType textPlain ! !

!ZnEntityTooLarge commentStamp: 'SvenVanCaekenberghe 1/31/2012 12:35'!
ZnEntityTooLarge is signalled when too big an entity is read from a stream.

This is a resumable exception!
!ZnEntityTooLarge methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/31/2012 12:35'!
isResumable
	"Determine whether an exception is resumable."

	^ true! !

!ZnEntityWriter commentStamp: '<historical>'!
I am ZnEntityWriter, I help writing ZnEntities to a stream given meta data in headers.

I deal with chunking and gzip encoding.

Part of Zinc HTTP Components.!
!ZnEntityWriter methodsFor: 'public' stamp: 'SvenVanCaekenberghe 10/10/2014 09:11'!
writeEntity: entity
	| actualStream gzipStream bufferedStream chunkedStream isChunked |
	actualStream := stream.
	chunkedStream := gzipStream := bufferedStream := nil.
	(isChunked := self isChunked)
		ifTrue: [ 
			chunkedStream := actualStream := ZnChunkedWriteStream on: actualStream ].
	self isGzipped 
		ifTrue: [ 
			gzipStream := actualStream := GZipWriteStream on: actualStream ]
		ifFalse: [ 
			(isChunked and: [ self contentType isBinary not ])
				ifTrue: [ bufferedStream := actualStream := ZnUtils bufferedWriteStreamOn: actualStream ] ].
	self withDefaultUtf8Encoding: [ entity writeOn: actualStream ].
	gzipStream 
		ifNotNil: [ gzipStream finish ].
	bufferedStream 
		ifNotNil: [ bufferedStream finish ].
	chunkedStream
		ifNotNil: [ chunkedStream finish ]
	! !

!ZnEntityWriter methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/18/2013 12:47'!
stream
	^ stream! !

!ZnEntityWriter methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/18/2013 20:58'!
contentType
	^ (self headers includesKey: 'Content-Type') 
		ifTrue: [ self headers contentType ] 
		ifFalse: [ ZnMimeType applicationOctetStream ]! !

!ZnEntityWriter methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/28/2013 12:02'!
isChunked
	| transferEncoding |
	transferEncoding := self headers at: 'Transfer-Encoding' ifAbsent: [ ^ false ].
	^ transferEncoding = 'chunked' or: [ transferEncoding beginsWith: 'chunked' ]! !

!ZnEntityWriter methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/18/2013 12:47'!
headers
	^ headers! !

!ZnEntityWriter methodsFor: 'private' stamp: 'SvenVanCaekenberghe 10/13/2014 22:15'!
withDefaultUtf8Encoding: block
	"Run block with the default character encoder set to UTF-8
	unless it was already set at a higher level, in which case we do nothing"
	
	^ ZnDefaultCharacterEncoder 
		value: (ZnDefaultCharacterEncoder value ifNil: [ ZnUTF8Encoder new ]) 
		during: block! !

!ZnEntityWriter methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/18/2013 12:47'!
stream: writeStream
	stream := writeStream! !

!ZnEntityWriter methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/18/2013 13:01'!
isGzipped
	| contentEncoding |
	contentEncoding := self headers at: 'Content-Encoding' ifAbsent: [ ^ false ].
	^ contentEncoding = 'gzip'! !

!ZnEntityWriter methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/18/2013 12:47'!
headers: znHeaders
	headers := znHeaders! !

!ZnEntityWriterTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/18/2013 13:26'!
testGzippedAndChunked
	| entity headers writer output reader result |
	entity := 	ZnEntity text: (String streamContents: [ :out |
		{ Collection. Stream. Exception. Magnitude } do: [ :cls |
			cls allSubclassesDo: [ :each | out nextPutAll: each comment ] ] ]).
	headers := ZnHeaders new
		acceptEntityDescription: entity;
		at: 'Content-Encoding' put: 'gzip';
		at: 'Transfer-Encoding' put: 'chunked';
		yourself.
	output := ByteArray streamContents: [ :out |
		writer := ZnEntityWriter new
			stream: out;
			headers: headers;
			yourself.
		writer writeEntity: entity ].
	reader := ZnEntityReader new
		stream: output readStream;
		headers: headers;
		yourself.
	result := reader readEntity.
	self assert: result contents equals: entity contents! !

!ZnEntityWriterTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/19/2013 11:41'!
testChunkedOnly
	| entity headers writer output reader result |
	entity := 	ZnEntity text: (String streamContents: [ :out |
		{ Collection. Stream. Exception. Magnitude } do: [ :cls |
			cls allSubclassesDo: [ :each | out nextPutAll: each comment ] ] ]).
	headers := ZnHeaders new
		acceptEntityDescription: entity;
		at: 'Transfer-Encoding' put: 'chunked';
		yourself.
	output := ByteArray streamContents: [ :out |
		writer := ZnEntityWriter new
			stream: out;
			headers: headers;
			yourself.
		writer writeEntity: entity ].
	reader := ZnEntityReader new
		stream: output readStream;
		headers: headers;
		yourself.
	result := reader readEntity.
	self assert: result contents equals: entity contents! !

!ZnEntityWriterTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/18/2013 13:24'!
testPlainUsingReader
	| entity headers writer output reader result |
	entity := ZnEntity text: 'Foo bar!!'.
	headers := ZnHeaders new 
		acceptEntityDescription: entity; 
		yourself.
	output := ByteArray streamContents: [ :out |
		writer := ZnEntityWriter new
			stream: out;
			headers: headers;
			yourself.
		writer writeEntity: entity ].
	reader := ZnEntityReader new
		stream: output readStream;
		headers: headers;
		yourself.
	result := reader readEntity.
	self assert: result contents equals: 'Foo bar!!'! !

!ZnEntityWriterTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/18/2013 13:10'!
testPlain
	| entity writer output |
	entity := ZnEntity text: 'Foo bar!!'.
	output := ByteArray streamContents: [ :out |
		writer := ZnEntityWriter new
			stream: out;
			headers: ZnHeaders new;
			yourself.
		writer writeEntity: entity ].
	self assert: output equals: 'Foo bar!!' asByteArray! !

!ZnFastLineReader commentStamp: 'SvenVanCaekenberghe 12/11/2014 14:10'!
I am ZnFastLineReader, a helper to efficiently read CR, LF or CRLF terminated lines from a character stream.!
!ZnFastLineReader methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 12/11/2014 13:47'!
initialize
	super initialize.
	cr := Character cr.
	lf := Character lf! !

!ZnFastLineReader methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 12/11/2014 14:09'!
beWide
	self bufferStream: (WideString new: 32) writeStream! !

!ZnFastLineReader methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 12/11/2014 14:09'!
bufferStream: characterWriteStream
	^ bufferStream := characterWriteStream! !

!ZnFastLineReader methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 12/11/2014 13:31'!
close
	readStream close! !

!ZnFastLineReader methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/11/2014 13:31'!
atEnd
	^ readStream atEnd! !

!ZnFastLineReader methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/11/2014 13:55'!
nextLine
	"Read a CR, LF or CRLF terminated line, returning the contents of the line without the EOL. Return nil when the receiver is #atEnd."
	
	self atEnd ifTrue: [ ^ nil ].
	^ self streamContents: [ :out | | eol char |
		eol := false.
		[ eol ] whileFalse: [ 
			char := readStream next.
			(char isNil or: [ char == lf ])
				ifTrue: [ eol := true ]
				ifFalse: [ 
					char == cr 
						ifTrue: [ eol := true. readStream peekFor: lf ]
						ifFalse: [  out nextPut: char ] ] ] ]! !

!ZnFastLineReader methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/11/2014 13:50'!
linesDo: block
	[ self atEnd ]
		whileFalse: [ 
			| line |
			line := self nextLine.
			line isNil
				ifFalse: [ block value: line ] ]! !

!ZnFastLineReader methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 12/11/2014 13:31'!
on: characterReadStream
	readStream := characterReadStream ! !

!ZnFastLineReader methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/11/2014 14:07'!
streamContents: block
	"Like readStream collectionSpecies streamContents: block
	but reusing the underlying buffer for improved efficiency"
	
	bufferStream 
		ifNil: [ 
			bufferStream := (readStream collectionSpecies new: 32) writeStream ].
	bufferStream reset.
	block value: bufferStream.
	^ bufferStream contents! !

!ZnFastLineReader class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 12/11/2014 13:37'!
on: characterReadStream
	^ self new 
		on: characterReadStream;
		yourself! !

!ZnFastLineReaderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/11/2014 14:34'!
testLinesDo
	| lines reader |
	lines := #( 'foo' 'bar' 'last').
	reader := ZnFastLineReader on: (Character lf join: lines) readStream.
	self 
		assert: (Array streamContents: [ :out | 
					reader linesDo: [ :line | out nextPut: line ] ])
		equals: lines! !

!ZnFastLineReaderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/11/2014 14:34'!
testNextLine
	| reader |
	reader := ZnFastLineReader on: 'abc' readStream.
	self assert: reader nextLine equals: 'abc'.
	self assert: reader atEnd.
	self assert: reader nextLine  equals: nil.
	reader := ZnFastLineReader on: '' readStream.
	self assert: reader nextLine equals: nil.
	self assert: reader atEnd.
	reader := ZnFastLineReader on: (String withAll: { 
		$a. Character cr. 
		$b. Character lf. 
		$c }) readStream.
	self assert: reader nextLine equals: 'a'.
	self assert: reader nextLine equals: 'b'.
	self assert: reader nextLine equals: 'c'.
	self assert: reader nextLine equals: nil.
	reader := ZnFastLineReader on: (String withAll: { 
		$a. Character cr. Character lf.  
		$b. Character cr. Character lf. 
		$c. Character cr. Character lf }) readStream.
	self assert: reader nextLine equals: 'a'.
	self assert: reader nextLine equals: 'b'.
	self assert: reader nextLine equals: 'c'.
	self assert: reader nextLine equals: nil.
	reader := ZnFastLineReader on: (String withAll: { 
		$a. Character cr. Character lf.  
		Character cr. Character lf. 
		$c. Character cr. Character lf }) readStream.
	self assert: reader nextLine equals: 'a'.
	self assert: reader nextLine equals: ''.
	self assert: reader nextLine equals: 'c'.
	self assert: reader atEnd! !

!ZnFileRetrieveContents commentStamp: '<historical>'!
I am ZnFileRetrieveContents.
I am a ZnUrlOperation.

I implement the #retrieveContents URL operation for FILE urls.

Part of Zinc HTTP Components.
!
!ZnFileRetrieveContents methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 11/6/2013 14:10'!
performOperation
	"Download and return the FILE resource that url refers to.
	This will typically return a String or a ByteArray (see AbstractFileReference>>#contents).
	If something goes wrong, an exception will be signalled."
	
	^ self url asFileReference contents! !

!ZnFileRetrieveContents class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/6/2013 14:10'!
operation
	^ #retrieveContents! !

!ZnFileRetrieveContents class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/6/2013 14:10'!
schemes
	^ #( #file )! !

!ZnFileSystemUtils commentStamp: '<historical>'!
I am ZnFileSystemUtils.
I help is abstracting over API differences pre and post the introduction of FileSystem in Pharo 2.0

Part of Zinc HTTP Components.!
!ZnFileSystemUtils class methodsFor: 'paths' stamp: 'SvenVanCaekenberghe 7/20/2012 11:53'!
downloadPathTo: directoryOrFileName for: baseName
	| downloadPath |
	downloadPath := directoryOrFileName asFileReference.
	^ downloadPath isDirectory
		ifTrue: [
			baseName ifNil: [ 
				self error: 'Not enough information to construct a download path' ]. 
			(downloadPath / baseName) fullName ]
		ifFalse: [ 
			directoryOrFileName ]
	! !

!ZnFileSystemUtils class methodsFor: 'paths' stamp: 'SvenVanCaekenberghe 7/3/2012 15:10'!
exists: path
	^ path asFileReference exists! !

!ZnFileSystemUtils class methodsFor: 'streams' stamp: 'SvenVanCaekenberghe 7/3/2012 16:12'!
newFileNamed: fileName do: block
	^ fileName asFileReference 
		writeStreamDo: block
		ifPresent: [ self error: fileName asString, ' already exists' ]! !

!ZnFileSystemUtils class methodsFor: 'streams' stamp: 'SvenVanCaekenberghe 7/3/2012 16:13'!
oldFileNamed: fileName do: block
	^ fileName asFileReference 
		readStreamDo: block
		ifAbsent: [ self error: fileName asString, ' does not exists' ]! !

!ZnFileSystemUtils class methodsFor: 'paths' stamp: 'SvenVanCaekenberghe 7/3/2012 15:11'!
extensionFor: fileName
	^ fileName asFileReference extension! !

!ZnFileSystemUtils class methodsFor: 'streams' stamp: 'SvenVanCaekenberghe 7/3/2012 16:13'!
oldFileStreamFor: fileName
	^fileName asFileReference 
		readStreamIfAbsent: [ self error: fileName asString, ' does not exists' ]! !

!ZnFileSystemUtils class methodsFor: 'paths' stamp: 'SvenVanCaekenberghe 7/2/2012 16:57'!
deleteIfExists: path
	^ (self exists: path)
		ifTrue: [ self delete: path. true ]
		ifFalse: [ false ]! !

!ZnFileSystemUtils class methodsFor: 'defaults' stamp: 'SvenVanCaekenberghe 7/3/2012 15:09'!
defaultDirectoryPath
	^ self defaultDirectory fullName! !

!ZnFileSystemUtils class methodsFor: 'paths' stamp: 'SvenVanCaekenberghe 7/3/2012 15:14'!
fullNameFor: fileName
	^ fileName asFileReference fullName! !

!ZnFileSystemUtils class methodsFor: 'queries' stamp: 'SvenVanCaekenberghe 7/3/2012 15:15'!
modificationTimeFor: path
	^ path asFileReference entry modificationTime ! !

!ZnFileSystemUtils class methodsFor: 'streams' stamp: 'SvenVanCaekenberghe 9/12/2012 20:44'!
fileNamed: fileName do: block
	^ fileName asFileReference 
		writeStreamDo: block! !

!ZnFileSystemUtils class methodsFor: 'queries' stamp: 'SvenVanCaekenberghe 7/3/2012 15:12'!
fileSizeFor: fileName
	^ fileName asFileReference entry size! !

!ZnFileSystemUtils class methodsFor: 'paths' stamp: 'SvenVanCaekenberghe 8/28/2012 21:18'!
directory: path
	^ path asFileReference! !

!ZnFileSystemUtils class methodsFor: 'defaults' stamp: 'SvenVanCaekenberghe 7/3/2012 15:09'!
defaultDirectory
	^ FileSystem disk workingDirectory! !

!ZnFileSystemUtils class methodsFor: 'paths' stamp: 'SvenVanCaekenberghe 7/3/2012 15:07'!
baseNameFor: fileName
	^ fileName asFileReference basename ! !

!ZnFileSystemUtils class methodsFor: 'streams' stamp: 'SvenVanCaekenberghe 7/3/2012 16:12'!
fileStreamFor: fileName
	^ fileName asFileReference 
		writeStream! !

!ZnFileSystemUtils class methodsFor: 'paths' stamp: 'SvenVanCaekenberghe 7/3/2012 15:10'!
delete: path
	^ path asFileReference delete! !

!ZnFileUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/14/2013 12:10'!
testSlash
	| fileUrl fileReference |
	fileUrl := 'file:///' asZnUrl.
	self assert: fileUrl isSlash.
	self assert: fileUrl isFile.
	fileReference := fileUrl asFileReference.
	self assert: fileReference isRoot! !

!ZnFileUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/14/2013 12:30'!
testRelative
	| fileReference fileUrl |
	fileReference := 'foo/bar/test.txt' asFileReference.
	self assert: fileReference isRelative.
	fileUrl := fileReference asZnUrl.
	self assert: fileUrl isFile.
	self assert: fileUrl pathSegments size >= fileReference pathSegments size.
	self assert: (fileUrl pathSegments asArray endsWith: fileReference pathSegments asArray)! !

!ZnFileUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/6/2013 04:53'!
testSpaces
	self 
		assert: 'file:///foo%20bar/test.st' asZnUrl asFileReference 
		equals: FileLocator root / 'foo bar' / 'test.st'.
	self 
		assert: (FileLocator root / 'foo bar' / 'test.st') asZnUrl 
		equals: 'file:///foo%20bar/test.st' asZnUrl! !

!ZnFileUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/14/2013 12:17'!
testWrongScheme
	self should: [ 'http://zn.stfx.eu/zn/small.html' asZnUrl asFileReference ] raise: AssertionFailure! !

!ZnFileUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/14/2013 12:23'!
testTrailingSlash
	| fileReference1 fileReference2 fileUrl1 fileUrl2 |
	
	fileReference1 := '/foo/bar' asFileReference.
	fileReference2 := '/foo/bar/' asFileReference.
	self assert: fileReference1 equals: fileReference2.
	self assert: fileReference1 asZnUrl equals: fileReference2 asZnUrl.
	
	fileUrl1 := 'file:///foo/bar' asZnUrl.
	fileUrl2 := 'file:///foo/bar/' asZnUrl.
	self deny: fileUrl1 = fileUrl2.
	self assert: fileUrl1 asFileReference equals: fileUrl2 asFileReference! !

!ZnFileUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/6/2013 04:56'!
testAsFileReference
	| fileUrl fileReference |
	fileUrl := 'file:///foo/bar/test.txt' asZnUrl.
	fileReference := fileUrl asFileReference.
	self assert: fileReference basename equals: 'test.txt'.
	self assert: fileReference pathSegments asArray equals: #( 'foo' 'bar' 'test.txt' ).
	self assert: fileReference isAbsolute ! !

!ZnFileUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/6/2013 04:54'!
testAsZnUrl
	| fileReference fileUrl |
	fileReference := FileLocator root / 'foo' / 'bar' / 'test.txt'.
	fileUrl := fileReference asZnUrl.
	self assert: fileUrl isFile.
	self assert: fileUrl directory equals: 'foo/bar'.
	self assert: fileUrl file equals: 'test.txt'.
	self assert: fileUrl pathSegments asArray equals: #( 'foo' 'bar' 'test.txt').
	self assert: fileUrl pathPrintString equals: '/foo/bar/test.txt'.
	self assert: fileUrl printString equals: 'file:///foo/bar/test.txt'.
	self deny: fileUrl hasHost.
	self deny: fileUrl hasPort.
	self deny: fileUrl hasQuery.
	self deny: fileUrl hasFragment! !

!ZnFileUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/6/2013 04:51'!
testRoot
	| fileUrl fileReference |
	fileReference := FileLocator root.
	self assert: fileReference isRoot.
	fileUrl := fileReference asZnUrl.
	self assert: fileUrl isFile.
	self assert: fileUrl isSlash! !

!ZnFileUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 10/24/2014 10:02'!
testRetrieveContents
	| fileReference contents url |
	SystemVersion current major < 3 ifTrue: [ self skip ].
	fileReference := ('file-{1}.txt' format: {(1000 atRandom)}) asFileReference.
	contents := 'Testing {1} and counting.{2}' format: {(1000 atRandom). (String crlf)}.
	fileReference ensureDelete.
	fileReference writeStreamDo: [ :stream | stream nextPutAll: contents ].
	url := fileReference asZnUrl.
	self assert: url isFile.
	self assert: url retrieveContents equals: contents.
	fileReference ensureDelete! !

!ZnFileUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/26/2015 09:48'!
testWindowsDriveNamesInFileUrl
	"Note the 3 slashes: 2 are from the scheme, file://, 1 is from the empty host and starts the absolute path"
	
	SystemVersion current major < 3 ifTrue: [ self skip ].
	self 
		assert: 'file:///C:/Programs/notepad.exe' asUrl asFileReference
		equals: FileLocator C / 'Programs' / 'notepad.exe'.
	self 
		assert: 'file:///C:' asUrl asFileReference
		equals: FileLocator C! !

!ZnHTTPSTests commentStamp: 'SvenVanCaekenberghe 5/18/2011 14:18'!
ZnHTTPSTests.

These require that the ZnZodiacNetworkingUtils socket stream factory is enabled:

	ZnNetworkingUtils default: ZnZodiacNetworkingUtils new.
	
Part of Zinc HTTP Components!
!ZnHTTPSTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 7/4/2012 11:32'!
ensureSocketStreamFactory
	self 
		assert: ZnNetworkingUtils default secureSocketStreamClass notNil
		description: 'Please set a secure socket stream class in ZnNetworkingUtils default or switch to the ZnZodiacNetworkingUtils socket stream factory'! !

!ZnHTTPSTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 1/21/2014 20:49'!
runningOnWindowsInriaCI
	| platform ci |
	self runningOnWindows
		ifFalse: [ ^ false ].
	^ [ 
	platform := OSPlatform current.
	ci := platform environment at: #CI ifAbsent: [ '' ].
	ci = 'ci.inria.fr' ]
		on: MessageNotUnderstood
		do: [ false ]! !

!ZnHTTPSTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
testAmazonAWS
	| client |
	self ensureSocketStreamFactory.
	self isNativeSSLPluginPresent ifFalse: [ ^ self ].
	(client := ZnClient new) 
		get: 'https://aws.amazon.com/'.
	self assert: client isSuccess.
	self assert: (client contents includesSubstring: 'Amazon').
	client close! !

!ZnHTTPSTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
testGoogleEncrypted
	| client |
	self ensureSocketStreamFactory.
	self isNativeSSLPluginPresent ifFalse: [ ^ self ].
	(client := ZnClient new) 
		get: 'https://encrypted.google.com/search?q=Smalltalk'.
	self assert: client isSuccess.
	self assert: (client contents includesSubstring: 'Google').    
	self assert: (client contents includesSubstring: 'Smalltalk').
	client close! !

!ZnHTTPSTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
testRequestResponse
	| query stream request response |
	self ensureSocketStreamFactory.
	self isNativeSSLPluginPresent ifFalse: [ ^ self ].
	query := 'Smalltalk'.
	stream := ZdcSecureSocketStream openConnectionToHostNamed: 'encrypted.google.com' port: 443.
	[
		request := ZnRequest get: 'https://encrypted.google.com/search?q=', query.
		stream connect.
		request writeOn: stream.
		stream flush.
		response := ZnResponse readFrom: stream.
	] ensure: [ stream close ].
	self assert: response isSuccess.
	self assert: (response contents includesSubstring: 'Google').   
	self assert: (response contents includesSubstring: 'Smalltalk').   
! !

!ZnHTTPSTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 1/21/2014 20:48'!
runningOnWindows
	"Pharo 3+"
	[ ^ OSPlatform current isWindows ] on: MessageNotUnderstood do: [ ].
	"Pharo 2-"
	[ ^ OSPlatform isWin32 ] on: MessageNotUnderstood do: [ ].
	"Give up"
	^ false! !

!ZnHTTPSTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 7/4/2012 11:32'!
isNativeSSLPluginPresent
	"Return whether the SSL VM plugin can be instanciated and intialized."
	
	^ [ ZdcPluginSSLSession new destroy. true ]
			on: ZdcPluginMissing
			do: [ false ]! !

!ZnHTTPSTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/26/2014 23:36'!
testGForceInria
	| client |
	self ensureSocketStreamFactory.
	self isNativeSSLPluginPresent ifFalse: [ ^ self ].
	(client := ZnClient new)
		get: 'http://gforge.inria.fr/frs/?group_id=1299'.
	self assert: client isSuccess.
	self assert: (client contents includesSubstring: 'inria').
	client close! !

!ZnHTTPSTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/21/2013 22:21'!
testTransfers
	self ensureSocketStreamFactory.
	self isNativeSSLPluginPresent ifFalse: [ ^ self ].
	(Integer primesUpTo: 100) do: [ :each | | size client |
		size := 1024 * each + each.
		(client := ZnClient new)
			https;
			host: 's3-eu-west-1.amazonaws.com';
			addPath: 'public-stfx-eu';
			addPath: ('test-', size asString, '.txt');
			get;
			close.
		self assert: client isSuccess.
		self assert: (client response contentType matches: ZnMimeType textPlain).
		self assert: client response contentLength equals: size.
		self 
			assert: client contents 
			equals: (self class generateTestData: size)	]! !

!ZnHTTPSTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/21/2013 22:24'!
testTransfersSingleClient
	| client |
	self ensureSocketStreamFactory.
	self isNativeSSLPluginPresent ifFalse: [ ^ self ].
	(client := ZnClient new)
		https;
		host: 's3-eu-west-1.amazonaws.com'.
	(Integer primesUpTo: 100) do: [ :each | | size |
		size := 1024 * each + each.
		client
			url: ('/public-stfx-eu/test-', size asString, '.txt');
			get.
		self assert: client isSuccess.
		self assert: (client response contentType matches: ZnMimeType textPlain).
		self assert: client response contentLength equals: size.
		self 
			assert: client contents 
			equals: (self class generateTestData: size)	].
	client close! !

!ZnHTTPSTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
testGmailEncrypted
	| client |
	self ensureSocketStreamFactory.
	self isNativeSSLPluginPresent ifFalse: [ ^ self ].  
	(client := ZnClient new) 
		get: 'https://www.gmail.com'.
	self assert: client isSuccess.
	self assert: (client contents includesSubstring: 'Google').    
	self assert: (client contents includesSubstring: 'mail'). 
	client close! !

!ZnHTTPSTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/2/2014 09:34'!
testGetPharoVersion
	| client lastBuildVersion version |
	self ensureSocketStreamFactory.
	self isNativeSSLPluginPresent ifFalse: [ ^ self ].
	self runningOnWindowsInriaCI ifTrue: [ ^ self ].
	lastBuildVersion := (client := ZnClient new)
		beOneShot;
		get: 'https://ci.inria.fr/pharo/job/Pharo-3.0/lastSuccessfulBuild/api/xml?xpath=/*/fullDisplayName'.
	self assert: client isSuccess.
	self assert: (client response contentType matches: ZnMimeType applicationXml).
	self assert: client response contentLength > 0.
	self assert: lastBuildVersion notNil.
	self assert: lastBuildVersion isString.
	self assert: lastBuildVersion size > 0.
	version := (lastBuildVersion copyAfter: $>) copyUpTo: $<.
	self deny: version isEmpty! !

!ZnHTTPSTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
testWikimedia
	| client |
	self ensureSocketStreamFactory.
	self isNativeSSLPluginPresent ifFalse: [ ^ self ]. 
	(client := ZnClient new) 
		get: 'https://secure.wikimedia.org/'.
	self assert: client isSuccess.
	self assert: (client contents includesSubstring: 'Wikimedia').
	client close! !

!ZnHTTPSTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 10/2/2012 14:55'!
disabledTestPayPal
	| client |
	self ensureSocketStreamFactory.
	self isNativeSSLPluginPresent ifFalse: [ ^ self ].
	(client := ZnClient new) 
		get: 'https://www.paypal.com'.
	self assert: client isSuccess.
	self assert: (client contents includesSubstring: 'PayPal').
	client close! !

!ZnHTTPSTests class methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/27/2012 13:27'!
generateTestFiles
	"self generateTestFiles"
	
	(Integer primesUpTo: 100) do: [ :each | | size |
		size := 1024 * each + each.
		FileStream fileNamed: ('test-', size asString, '.txt') do: [ :stream |
			stream nextPutAll: (self generateTestData: size) ] ]! !

!ZnHTTPSTests class methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/27/2012 13:26'!
generateTestData: size
	"self generateTestData: 1111"
	
	^ String 
		streamContents: [ :stream |
			stream << 'Transfer test file of size '; print: size; << ' bytes.'; lf.
			1 to: size do: [ :each |
				stream nextPutAll: 'Line '; print: each; lf ] ] 
		limitedTo: size ! !

!ZnHeaders commentStamp: 'SvenVanCaekenberghe 1/18/2011 10:57'!
I am ZnHeaders.
I am a collection of HTTP headers.
I can be used for generating and parsing.

Header names are normalized and used case insensitive.
Header values can be multi-valued.

Part of Zinc HTTP Components.!
!ZnHeaders methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/14/2013 11:29'!
unlimited
	self headers unlimited! !

!ZnHeaders methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/10/2010 20:27'!
contentType
	^ ZnMimeType fromString: (self headers at: 'Content-Type')! !

!ZnHeaders methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/7/2013 12:20'!
addAll: keyedCollection
	"Note that we use #addAllMulti:"

	keyedCollection isEmpty
		ifFalse: [ self headers addAllMulti: keyedCollection ].
	^ keyedCollection! !

!ZnHeaders methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 6/11/2013 09:48'!
readFrom: stream
	| line reader |
	reader := ZnLineReader on: stream.
	[ (line := reader nextLine) isEmpty ] whileFalse: [ | key |
		key := self readOneHeaderFrom: line readStream.
		"Continuation header lines start with a space or tab"
		[ stream atEnd not and: [ #[ 32 9 ] includes: stream peek ] ]
			whileTrue: [ 
				self extendHeaderAt: key from: reader nextLine ] ] ! !

!ZnHeaders methodsFor: '*GT-InspectorExtensions-Core' stamp: 'SvenVanCaekenberghe 10/6/2014 14:08'!
gtInspectorHeadersIn: composite 
	<gtInspectorPresentationOrder: 30>
	^ (self headers gtInspectorItemsIn: composite) 
		display: [ :anObject | self headers associations ];
		title: [ :anObject | self headers size asString , ' items' ]! !

!ZnHeaders methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/21/2010 12:16'!
removeKey: headerName ifAbsent: block
	self isEmpty ifTrue: [ ^ block value ].
	^ self headers removeKey: (self normalizeHeaderKey: headerName) ifAbsent: block! !

!ZnHeaders methodsFor: 'accessing' stamp: 'PaulDeBruicker 5/12/2012 10:02'!
at: headerName ifPresent: block
	"Like #at: but executes block when the headerName is found"

	^ self headers at: (self normalizeHeaderKey: headerName) ifPresent: block! !

!ZnHeaders methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/10/2010 20:25'!
at: headerName
	"Return the value stored under headerName,
	a String for single-valued headers, an Array of Strings for multi-valued headers"
	
	^ self headers at: (self normalizeHeaderKey: headerName)! !

!ZnHeaders methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 9/20/2010 17:20'!
printOn: stream
	super printOn: stream.
	self isEmpty ifFalse: [ self headers printElementsOn: stream ]
	! !

!ZnHeaders methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/21/2010 12:16'!
at: headerName ifAbsent: block
	"Like #at: but executes block when the headerName is not found"
	
	self isEmpty ifTrue: [ ^ block value ].
	^ self headers at: (self normalizeHeaderKey: headerName) ifAbsent: block! !

!ZnHeaders methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/22/2012 10:27'!
readOneHeaderFrom: stream
	| key value |
	key := stream upTo: $:.
	[ stream peek == Character space ] whileTrue: [ stream next ].
	value := stream upToEnd.
	self at: key add: value.
	^ key! !

!ZnHeaders methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/10/2010 20:29'!
isDescribingEntity
	"Do I include enough information to describe an entity (i.e. content length and type) ?"
	
	^ (self headers includesKey: 'Content-Type') 
		and: [ self headers includesKey: 'Content-Length' ]
! !

!ZnHeaders methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/28/2013 11:59'!
normalizeHeaderKey: string
	"Test string to see if it has proper header key capitalization,
	if true, return string, if not, return a properly capitalized copy"
	
	"Optimization: if string is a know,, properly capitalized header, use it as is"
	(CommonHeaders includes: string) 
		ifTrue: [ ^ string ].
	^ (ZnUtils isCapitalizedString: string)
		ifTrue: [ string ] 
		ifFalse: [ ZnUtils capitalizeString: string ] ! !

!ZnHeaders methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/10/2010 20:49'!
at: headerName put: value ifPresentMerge: binaryBlock
	"Store value under headerName, when there is an existing entry,
	stored the result of evaluating binaryBlock with old and new value"
	
	| normalizedKey existingValue newValue |
	normalizedKey := self normalizeHeaderKey: headerName.
	existingValue := self headers at: normalizedKey ifAbsent: [ nil ].
	newValue := existingValue isNil
		ifTrue: [ value ] 
		ifFalse: [ binaryBlock value: existingValue value: value ].
	^ self headers at: normalizedKey put: newValue 
		

! !

!ZnHeaders methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/21/2010 12:13'!
includesKey: headerName
	^ self isEmpty not and: [ self headers includesKey: (self normalizeHeaderKey: headerName) ]
	! !

!ZnHeaders methodsFor: 'private' stamp: 'SvenVanCaekenberghe 6/11/2013 10:03'!
extendHeaderAt: key from: line
	"The value of a continuation header line is concatenated, 
	keeping the whitespace, but without the CRLF"

	| existingValue newValue |
	existingValue := self at: key.
	newValue := existingValue isArray
		ifTrue: [ | last |
			last := existingValue size.
			existingValue at: last put: ((existingValue at: last) , line).
			existingValue ]
		ifFalse: [ existingValue , line ].
	self at: key put: newValue! !

!ZnHeaders methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 5/22/2013 10:35'!
hash
	^ self headers hash! !

!ZnHeaders methodsFor: 'enumerating' stamp: 'SvenVanCaekenberghe 9/21/2010 12:14'!
headersDo: block
	"Execute a two argument (key, value) block for each header.
	Multi-valued headers are handled transparently."

	self isEmpty ifTrue: [ ^ self ].
	self headers keysAndValuesDo: [ :headerKey :headerValue |
		headerValue isArray
			ifTrue: [ 
				headerValue do: [ :each | 
					block value: headerKey value: each ] ]
			ifFalse: [
				block value: headerKey value: headerValue ] ]! !

!ZnHeaders methodsFor: 'private' stamp: 'SvenVanCaekenberghe 1/2/2012 17:24'!
headers
	headers isNil ifTrue: [ headers := ZnMultiValueDictionary new ].
	^ headers! !

!ZnHeaders methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/6/2010 17:09'!
isEmpty 
	^ headers isNil or: [ self headers isEmpty ]! !

!ZnHeaders methodsFor: 'writing' stamp: 'SvenVanCaekenberghe 12/3/2010 20:39'!
writeOn: stream
	| writeStream |
	writeStream := ZnBivalentWriteStream on: stream.
	self headersDo: [ :key :value |
		writeStream nextPutAll: key; nextPut: $:; space; nextPutAll: value; nextPutAll: String crlf ]! !

!ZnHeaders methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/12/2011 13:08'!
request: url
	"Setup the receiver to request url"
	
	(url isNil or: [ url hasHost not ]) ifTrue: [ ^ self ].  
	self at: 'Host' put: url authority.
	(ZnNetworkingUtils proxyAuthorizationHeaderValueToUrl: url)
		ifNotNil: [ :value | self at: 'Proxy-Authorization' put: value ].    
  ! !

!ZnHeaders methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/14/2010 13:36'!
removeKey: headerName	
	^ self headers removeKey: (self normalizeHeaderKey: headerName)! !

!ZnHeaders methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/29/2013 14:22'!
acceptEntityDescription: entity
	"Take over the content type and length from entity"
	
	entity 
		ifNotNil: [
			self
				contentType: entity contentType;
				contentLength: entity contentLength ]
		ifNil: [
			self 
				clearContentType; 
				clearContentLength ] ! !

!ZnHeaders methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/2/2012 17:27'!
at: headerName add: value
	"Store value under headerName, optionally turning it into a multi-valued header 
	when a value was already present"
	
	^ self headers at: (self normalizeHeaderKey: headerName) add: value 
		
! !

!ZnHeaders methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/20/2013 12:59'!
clearContentType
	self removeKey: 'Content-Type' ifAbsent: [] ! !

!ZnHeaders methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/29/2013 14:21'!
contentType: object
	self at: 'Content-Type' put: object asString! !

!ZnHeaders methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/10/2010 20:26'!
at: headerName put: value
	"Store value under headerName, replace existing entries"
	
	^ self headers at: (self normalizeHeaderKey: headerName) put: value! !

!ZnHeaders methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 5/22/2013 10:34'!
= other
	self class = other class ifFalse: [ ^ false ].
	^ self headers = other headers! !

!ZnHeaders methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/21/2010 12:12'!
hasContentLength
	^ self includesKey: 'Content-Length'! !

!ZnHeaders methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/29/2013 14:21'!
contentLength: object
	self at: 'Content-Length' put: object asString! !

!ZnHeaders methodsFor: 'copying' stamp: 'SvenVanCaekenberghe 6/12/2014 15:58'!
postCopy
	headers := headers copy! !

!ZnHeaders methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/20/2013 12:59'!
clearContentLength
	self removeKey: 'Content-Length' ifAbsent: [] ! !

!ZnHeaders methodsFor: 'enumerating' stamp: 'SvenVanCaekenberghe 9/26/2010 18:13'!
keysAndValuesDo: block
	"Execute a two argument (key, value) block for each header.
	Multi-valued headers are handled transparently."

	self headersDo: block! !

!ZnHeaders methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/21/2010 12:11'!
hasContentType
	^ self includesKey: 'Content-Type'! !

!ZnHeaders methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/20/2011 13:48'!
contentLength
	"We allow multiple content-length headers provided they are identical."
	
	| value |
	(value := self headers at: 'Content-Length') isString
		ifFalse: [
			value asSet size = 1
				ifTrue: [ value := value first ]
				ifFalse: [ self error: 'Multiple, different Content-Length headers are not allowed' ] ].
	^ Integer readFrom: value ifFail: [ self error: 'Illegal HTTP Content Length' ] ! !

!ZnHeaders class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 3/31/2011 08:54'!
defaultResponseHeaders
	^ self new
		at: 'Server' put: ZnConstants defaultServerString;
		at: 'Date' put: ZnUtils httpDate;
		yourself! !

!ZnHeaders class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/6/2010 21:12'!
defaultRequestHeaders
	^ self new
		at: 'User-Agent' put: ZnConstants defaultUserAgent;
		at: 'Accept' put: '*/*';
		yourself! !

!ZnHeaders class methodsFor: 'class initialization' stamp: 'SvenVanCaekenberghe 5/28/2013 11:52'!
initialize
	CommonHeaders := (
		#(
			'Content-Length' 'Content-Type' 'Date' 'Server' 'Connection' 'User-Agent' 'Host'
			'Accept' 'Accept-Language' 'Accept-Encoding'
			'Referer' 'Dnt'
			'Cookie' 'Set-Cookie' 'Authorization' 'WWW-Authenticate' 'Proxy-Authorization'
			'Content-Encoding' 'Transfer-Encoding' 'Location'
			'If-Modified-Since' 'Content-Disposition' 
			'X-Zinc-Remote-Address' 'X-Forwarded-Server' 'X-Forwarded-For' 'X-Forwarded-Host' ) 
			collect: [ :each | ZnUtils capitalizeString: each ]) asSet! !

!ZnHeaders class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/6/2010 17:07'!
readFrom: stream
	^ self new
		readFrom: stream;
		yourself! !

!ZnHeaders class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 09:16'!
gtExampleDefaultRequestHeaders
	<gtExample: 'Default request headers'>
	^ self defaultRequestHeaders! !

!ZnHeaders class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 7/27/2011 14:41'!
requestHeadersFor: url
	| headers |
	headers := self defaultRequestHeaders.
	headers request: url.
	^ headers! !

!ZnHeaders class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/13/2010 21:45'!
withAll: keyedCollection
	^ self new
		addAll: keyedCollection;
		yourself ! !

!ZnHeaders class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 09:16'!
gtExampleDefaultResponseHeaders
	<gtExample: 'Default response headers'>
	^ self defaultResponseHeaders! !

!ZnHeadersTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
testWriting
	| headers string |
	headers := ZnHeaders new 
		at: 'Content-Type' put: 'text/plain'; 
		at: 'Content-Length' put: '128';
		yourself.
	string := String streamContents: [ :stream | headers writeOn: stream ].
	self assert: (string includesSubstring: 'Content-Type: text/plain', String crlf).
	self assert: (string includesSubstring: 'Content-Length: 128', String crlf).
	self assert: (string occurrencesOf: Character cr) = 2.
	self assert: (string occurrencesOf: Character lf) = 2! !

!ZnHeadersTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/11/2013 10:34'!
testMultiValuedStreaming
	| headers keysAndValues |
	headers := ZnHeaders new.
	headers at: 'Set-Cookie' put: 'foo=1'.
	headers at: 'Set-Cookie' add: 'bar=1'.
	keysAndValues := OrderedCollection streamContents: [ : stream |
		headers headersDo: [ :key :value |
			stream nextPut: key; nextPut: value ] ].
	self assert: keysAndValues equals: #('Set-Cookie' 'foo=1' 'Set-Cookie' 'bar=1') asOrderedCollection 
	
	! !

!ZnHeadersTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/11/2013 10:35'!
testReading
	| string headers |
	string := 'Content-Type: text/plain', String crlf, 'Content-Length: 128', String crlf.
	headers := ZnHeaders readFrom: string asByteArray readStream.
	self assert: (headers includesKey: 'Content-Type').
	self assert: (headers includesKey: 'Content-Length').
	self assert: (headers at: 'Content-Type') equals: 'text/plain'.
	self assert: (headers at: 'Content-Length') equals: '128'.! !

!ZnHeadersTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/11/2013 10:35'!
testNormalization
	| headers |
	headers := ZnHeaders new.
	headers at: 'content-TYPE' put: 'text/plain'.
	self assert: (headers includesKey: 'content-type').
	self assert: (headers includesKey: 'content-TYPE').
	self assert: (headers at: 'Content-Type') equals: 'text/plain'.
	headers at: 'CONTENT-type' put: 'text/html'.
	self assert: (headers at: 'Content-Type') equals: 'text/html'.

	! !

!ZnHeadersTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/11/2013 10:38'!
testReadingMultilineMultiValue
	| string headers |
	string := 'Content-Type: text/plain', String crlf, 
		'Long: foo', String crlf, 
		' bar', String crlf, 
		String tab, 'baz', String crlf, 
		'Content-Length: 128', String crlf,
		'Long: more', String crlf.
	headers := ZnHeaders readFrom: string asByteArray readStream.
	self assert: (headers at: #long) equals: #( 'foo bar	baz' 'more').! !

!ZnHeadersTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/11/2013 10:35'!
testReadingMultiline
	| string headers |
	string := 'Content-Type: text/plain', String crlf, 
		'Long: foo', String crlf, 
		' bar', String crlf, 
		String tab, 'baz', String crlf, 
		'Content-Length: 128', String crlf.
	headers := ZnHeaders readFrom: string asByteArray readStream.
	self assert: (headers includesKey: 'Content-Type').
	self assert: (headers includesKey: 'Content-Length').
	self assert: (headers at: 'Content-Type') equals: 'text/plain'.
	self assert: (headers at: 'Content-Length') equals: '128'.
	self assert: (headers includesKey: #Long).
	self assert: (headers at: #long) equals: 'foo bar	baz'.! !

!ZnHeadersTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/11/2013 10:34'!
testMultiValued
	| headers |
	headers := ZnHeaders new.
	headers at: 'Set-Cookie' put: 'foo=1'.
	headers at: 'Set-Cookie' add: 'bar=1'.
	self assert: (headers at: 'Set-Cookie') equals: #('foo=1' 'bar=1')
	
	! !

!ZnHeadersTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/11/2013 10:34'!
testMergeValued
	| headers |
	headers := ZnHeaders new.
	headers at: 'Set-Cookie' put: 'foo=1'.
	headers at: 'Set-Cookie' put: 'bar=1' ifPresentMerge: [ :old :new | old, ';', new ].
	self assert: (headers at: 'Set-Cookie') equals: 'foo=1;bar=1'
	
	! !

!ZnHttpRetrieveContents commentStamp: 'SvenVanCaekenberghe 6/25/2014 17:35'!
I am ZnHttpRetrieveContents.
I am a ZnUrlOperation.

I implement the #retrieveContents URL operation for HTTP(S) urls.

  'http://zn.stfx.eu/zn/numbers.txt' asZnUrl retrieveContents.

Part of Zinc HTTP Components.
!
!ZnHttpRetrieveContents methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 11/6/2013 14:08'!
performOperation
	"Download and return the HTTP(S) resource that url refers to.
	This will typically return a String or a ByteArray (see ZnClient>>#get:).
	If something goes wrong, an exception will be signalled."

	^ ZnClient new
		beOneShot;
		enforceHttpSuccess: true;
		get: self url! !

!ZnHttpRetrieveContents class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/6/2013 14:05'!
operation
	^ #retrieveContents! !

!ZnHttpRetrieveContents class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/6/2013 14:06'!
schemes
	^ #( #http #https )! !

!ZnHttpSaveContentsToFile commentStamp: 'SvenVanCaekenberghe 6/25/2014 17:36'!
I am ZnHttpSaveContentsToFile.
I am a ZnUrlOperation.

I implement the #saveContentsToFile: URL operation for HTTP(S) urls, which downloads the url resource to a file.

  'http://zn.stfx.eu/zn/numbers.txt' asZnUrl saveContentsToFile: Path * 'numbers.txt'.

Part of Zinc HTTP Components.!
!ZnHttpSaveContentsToFile methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 6/25/2014 17:16'!
performOperation
	"Download the HTTP(S) resource specified by url to the file in argument.
	Return a file reference on the file that's just been downloaded.
	If something goes wrong, an exception will be signalled."

	ZnClient new
		enforceHttpSuccess: true;
		url: self url;
		downloadTo: argument.
	^ argument asFileReference! !

!ZnHttpSaveContentsToFile class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/25/2014 17:16'!
operation
	^ #saveContentsToFile:! !

!ZnHttpSaveContentsToFile class methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 6/18/2014 14:35'!
schemes
	^ #( #http #https )! !

!ZnHttpUnsuccessful commentStamp: 'SvenVanCaekenberghe 12/20/2011 12:52'!
ZnHttpUnsuccessful is signalled when an HTTP client receives a non success response.

See ZnResponse>>#isSuccess

I hold the response that was unsuccessful.

Part of Zinc HTTP Components. !
!ZnHttpUnsuccessful methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/20/2011 12:50'!
response
	^ response! !

!ZnHttpUnsuccessful methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/20/2011 12:56'!
standardMessageText
	"Generate a standard textual description"
	
	^ String streamContents: [ :stream |
		response ifNotNil: [
			response statusLine printCodeAndReasonOn: stream ] ]! !

!ZnHttpUnsuccessful methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/20/2011 12:50'!
response: anObject
	response := anObject! !

!ZnHttpUnsuccessful methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/20/2011 12:53'!
messageText
	"Overwritten to initialiaze the message text to a standard text if it has not yet been set"
	
	^ messageText ifNil: [ messageText := self standardMessageText ]! !

!ZnHttpUnsuccessful class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 12/20/2011 12:51'!
response: response
	^ self new
		response: response;
		yourself! !

!ZnImageExampleDelegate commentStamp: '<historical>'!
I am ZnImageExampleDelegate.
I am a implementation of the web app in 'Building and deploying your first web app in Pharo'.

I serve an image that web clients can change by uploading a new one.

  ZnServer startDefaultOn: 1701.
  ZnImageExampleDelegate installInDefaultServer.
  ZnServer stopDefault.

I implement the following API or resources

	GET /image - returns an HTML page showing our image and a form to upload a new image
	GET /image?raw=true - directly serves the last uploaded image
	POST /image - handler accepting a multipart form data entity with a file part containing GIF, JPEG or PNG bytes
	
Part of Zinc HTTP Components.!
!ZnImageExampleDelegate methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 7/6/2013 00:01'!
form
	^ self formForImageEntity: self image
	! !

!ZnImageExampleDelegate methodsFor: 'public' stamp: 'SvenVanCaekenberghe 7/5/2013 14:28'!
value: request
	"I implement the generic #value: message as equivalent to #handleRequest:"
	
	^ self handleRequest: request! !

!ZnImageExampleDelegate methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 7/6/2013 00:09'!
image
	"Return the current image entity.
	Use a default when not yet set."
	
	^ image ifNil: [ image := self downloadPharoLogo ]! !

!ZnImageExampleDelegate methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/26/2014 23:40'!
downloadPharoLogo
	^ ZnClient new beOneShot
		get: 'http://pharo.org/files/pharo.png';
		entity! !

!ZnImageExampleDelegate methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 7/6/2013 11:43'!
html
	^ '<html><head><title>Image</title>
<body>
<h1>Image</h1>
<img src="image?raw=true"/>
<br/>
<form enctype="multipart/form-data" action="image" method="POST">
 <h3>Change the image:</h3>
 <input type="file" name="file"/>
 <input type="submit" value= "Upload"/>
</form>
</body></html>'! !

!ZnImageExampleDelegate methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 7/6/2013 00:10'!
formForImageEntity: imageEntity
	"Parse the actual bytes of imageEntity and return a Form."
	
	| imageType parserClassName parserClass parser |
	imageType := imageEntity contentType sub.
	parserClassName := imageType asUppercase, #ReadWriter.
	parserClass := Smalltalk globals at: parserClassName asSymbol.
	parser := parserClass on: imageEntity readStream.
	^ parser nextImage
	! !

!ZnImageExampleDelegate methodsFor: 'request handling' stamp: 'SvenVanCaekenberghe 7/6/2013 00:07'!
handleGetRequest: request
	"GET /image - Serve an HTML page showing our image and a form to upload a new one.
	GET /image?raw=true - Serve the last image directly"
	
	^ (request uri queryAt: #raw ifAbsent: [ nil ])
		ifNil: [ 
			ZnResponse ok: (ZnEntity html: self html) ]
		ifNotNil: [ 
			ZnResponse ok: self image ]! !

!ZnImageExampleDelegate methodsFor: 'request handling' stamp: 'SvenVanCaekenberghe 7/6/2013 11:42'!
handlePostRequest: request
	"POST /image <multipart form data with file part> - change the image and show the result.
	Do full error checking before accepting the newly uploaded image"
	
	| part newImage badRequest |
	badRequest := [ ^ ZnResponse badRequest: request ].
	(request hasEntity and: [ request contentType matches: ZnMimeType multiPartFormData ])
		ifFalse: badRequest.
	part := request entity 
		partNamed: #file 
		ifNone: badRequest.
	newImage := part entity.
	(newImage notNil and: [ newImage contentType matches: 'image/*' asZnMimeType ])
		ifFalse: badRequest.
	[ self formForImageEntity: newImage ] on: Error do: badRequest.
	image := newImage.
	^ ZnResponse redirect: #image
	! !

!ZnImageExampleDelegate methodsFor: 'public' stamp: 'SvenVanCaekenberghe 7/6/2013 11:43'!
handleRequest: request
	"Dispatch between GET and POST on /image"
	
	request uri path = #image
		ifTrue: [ 
			request method = #GET
				ifTrue: [ 
					^ self handleGetRequest: request ].
			request method = #POST
				ifTrue: [ 
					^ self handlePostRequest: request ] ].
	^ ZnResponse notFound: request uri! !

!ZnImageExampleDelegate class methodsFor: 'public' stamp: 'SvenVanCaekenberghe 7/6/2013 00:12'!
installInDefaultServer
	"Assuming the default server has the default delegate, 
	install ourself under /image"
	
	ZnServer default delegate 
		map: 'image' to: self new! !

!ZnImageExampleDelegateTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 7/7/2013 20:20'!
testDefaultImage
	self withServerDo: [ :server |
		| client |
		client := ZnClient new.
		client url: server localUrl; addPath: #image; queryAt: #raw put: #true.
		client get.
		self assert: client isSuccess.
		self assert: (client entity contentType matches: 'image/*' asZnMimeType).
		self assert: client entity equals: server delegate image.
		client close ]! !

!ZnImageExampleDelegateTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 7/7/2013 20:21'!
testUpload
	self withServerDo: [ :server |
		| image client |
		image := self image.
		client := ZnClient new.
		client url: server localUrl; addPath: #image.
		client addPart: (ZnMimePart fieldName: #file entity: image).
		client post.
		self assert: client isSuccess.
		client resetEntity; queryAt: #raw put: #true.
		client get.
		self assert: client isSuccess.
		self assert: client entity equals: image.
		client close ]! !

!ZnImageExampleDelegateTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 7/5/2013 17:02'!
image
	^ ZnClient new
		beOneShot;
		get: 'http://zn.stfx.eu/zn/Hot-Air-Balloon.gif';
		entity! !

!ZnImageExampleDelegateTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 1/22/2014 10:15'!
withServerDo: block
	| server |
	server := ZnServer on: 1700 + 32 atRandom.
	[ 
		server start.
		self 
			assert: server isRunning & server isListening
			description: ('Failed to start server on port {1}. Is there one already?' format: { server port }).
		server delegate: ZnImageExampleDelegate new.
		block cull: server
	] 
		ensure: [ server stop ]! !

!ZnImageExampleDelegateTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 7/7/2013 20:21'!
testMainPage
	self withServerDo: [ :server |
		| client |
		client := ZnClient new.
		client url: server localUrl; addPath: #image.
		client get.
		self assert: client isSuccess.
		self assert: (client entity contentType matches: ZnMimeType textHtml).
		self assert: (client contents includesSubstring: 'Image').
		client close ]! !

!ZnInvalidUTF8 commentStamp: '<historical>'!
I am ZnInvalidUTF8.
I am a ZnCharacterEncodingError.
I am an Error.

I signal when something goes wrong while encoding or decoding UTF8.

Part of Zinc HTTP Components!
!ZnLimitedReadStream commentStamp: 'SvenVanCaekenberghe 1/18/2011 11:02'!
I am ZnLimitedReadStream, wrapping another read stream delegating to it 
but limiting reading to a fixed number of elements.

I can be atEnd while my wrapped stream is not.

My contentSpecies can be forced to be ByteArray (binary) or ByteString (ascii).

I do byte/char conversions on the fly (support bivalent access).

This implementation is really a kludge.

Part of Zinc HTTP Components.!
!ZnLimitedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/15/2010 20:03'!
skip: count
	count timesRepeat: [ self next ]! !

!ZnLimitedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/15/2010 13:36'!
binary
	binary := true! !

!ZnLimitedReadStream methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/31/2012 20:03'!
atEnd
	^ position >= limit or: [ stream atEnd ]! !

!ZnLimitedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/1/2012 13:35'!
nextInto: collection
	"Read the next elements of the receiver into collection,
	returning a copy if less elements are available"
	
	^ self
		next: collection size
		into: collection! !

!ZnLimitedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/15/2010 19:34'!
collectionSpecies
	"I can be set to binary or ascii explicitely.
	If not set, delegate to our wrapped stream."
	
	^ binary notNil
		ifTrue: [ 
			binary ifTrue: [ ByteArray ] ifFalse: [ ByteString ] ]
		ifFalse: [
			(stream respondsTo: #collectionSpecies)
				ifTrue: [ stream collectionSpecies ]  
				ifFalse: [ stream isBinary ifTrue: [ ByteArray ] ifFalse: [ ByteString ] ] ]! !

!ZnLimitedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/21/2011 23:19'!
next
	"We do byte/char conversions on the fly."
	
	^ self atEnd 
		ifTrue: [ nil ] 
		ifFalse: [ 
			position := position + 1. 
			binary isNil
				ifTrue: [ stream next ] 
				ifFalse: [ 
					binary
					 	ifTrue: [ stream next asInteger ]
						ifFalse: [ stream next asCharacter ] ] ]! !

!ZnLimitedReadStream methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/17/2010 20:06'!
isBinary
	^ binary isNil
		ifTrue: [ stream isBinary ]
		ifFalse: [ binary ]! !

!ZnLimitedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/31/2012 20:14'!
next: requestedCount 
	"Read requestedCount elements into new collection and return it,
	 it could be that less elements were available"

	^ self 
		next: requestedCount 
		into: (self collectionSpecies new: requestedCount)! !

!ZnLimitedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/31/2012 20:11'!
next: requestedCount into: collection
	"Read requestedCount elements into collection,
	returning a copy if less elements are available"
	
	^ self
		next: requestedCount
		into: collection
		startingAt: 1! !

!ZnLimitedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/26/2010 17:20'!
reset
	"We don't allow it"! !

!ZnLimitedReadStream methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 9/27/2010 13:06'!
on: readStream limit: integer
	stream := readStream.
	limit := integer.
	position := 0! !

!ZnLimitedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/15/2010 20:17'!
contentsOfEntireFile
	^ self upToEnd! !

!ZnLimitedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/2/2012 15:55'!
match: subCollection
	"Try to read and match the elements of subCollection. 
	If successful return true and leave the me positioned after the match.
	If unsuccesful return false and leave me at end."
	
	| buffer pattern bufferPosition bufferLimit |
	pattern := subCollection readStream.
	"we have to use an internal buffer because we are not positionable"
	buffer := subCollection species new: subCollection size.
	bufferPosition := bufferLimit := 0.
	[ pattern atEnd ] whileFalse: [ | nextElement |
		self atEnd ifTrue: [ ^ false ].
		"get the next char to match either from the buffer or from the stream while buffering it"
		(bufferPosition < bufferLimit) 
			ifTrue: [ 
				nextElement := buffer at: bufferPosition + 1 ]
			ifFalse: [
				nextElement := buffer at: bufferPosition + 1 put: self next.
				bufferLimit := bufferLimit + 1 ].
		bufferPosition := bufferPosition + 1.
		pattern next = nextElement
			ifFalse: [
				"shift the buffer down one element and restart"
				2 to: bufferLimit do: [ :each |
					buffer at: each - 1 put: (buffer at: each) ].
				bufferLimit := bufferLimit - 1.
				bufferPosition := 0.
				pattern position: 0 ] ].
	^ true! !

!ZnLimitedReadStream methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 9/15/2010 12:50'!
printOn: aStream
	aStream 
		nextPutAll: 'a '; 
		nextPutAll: self class name! !

!ZnLimitedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/27/2010 13:09'!
position
	^ position! !

!ZnLimitedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/31/2012 20:02'!
upTo: anObject 
	"We use our own collectionSpecies."
	
	^ self collectionSpecies streamContents: [ :out | | element |
		[ self atEnd or: [ (element := self next) = anObject ] ] whileFalse: [ 
			out nextPut: element ] ]! !

!ZnLimitedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/15/2010 13:38'!
ascii
	binary := false! !

!ZnLimitedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/31/2012 21:07'!
upToEnd
	^ ZnUtils readUpToEnd: self limit: nil! !

!ZnLimitedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/31/2012 20:14'!
next: requestedCount into: collection startingAt: offset
	"Read requestedCount elements into collection starting at offset,
	returning a copy if less elements are available"
	
	| readCount |
	readCount := self 
		readInto: collection 
		startingAt: offset 
		count: requestedCount.
	^ requestedCount = readCount
		ifTrue: [ collection ]
		ifFalse: [ collection copyFrom: 1 to: offset + readCount - 1 ]! !

!ZnLimitedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/31/2012 21:06'!
readInto: collection startingAt: offset count: count 
	"Read count elements and place them in collection starting at offset.
	Return the number of elements actually read."
	
	| target actual |
	target := count min: (limit - position).
	actual := stream 
		readInto: collection 
		startingAt: offset 
		count: target.
	position := position + actual.
	^ actual! !

!ZnLimitedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/2/2012 16:02'!
contents
	"This is technically not correct, but it is better than nothing"
	
	^ self upToEnd! !

!ZnLimitedReadStream methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/4/2011 18:43'!
peek
	"We do byte/char conversions on the fly."
	
	^ self atEnd 
		ifTrue: [ nil ] 
		ifFalse: [ 
			binary isNil
				ifTrue: [ stream peek ] 
				ifFalse: [ 
					binary
					 	ifTrue: [ stream peek asInteger ]
						ifFalse: [ stream peek asCharacter ] ] ]! !

!ZnLimitedReadStream class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/15/2010 11:15'!
on: stream limit: limit
	^ self basicNew
		on: stream limit: limit;
		yourself! !

!ZnLimitedReadStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/31/2012 20:41'!
testNextCountIntoShort
	| data stream buffer |
	data := '0123456789'.
	stream := ZnLimitedReadStream on: data readStream limit: 5.
	buffer := String new: 6.
	self assert: (stream next: 6 into: buffer) = '01234'
	! !

!ZnLimitedReadStreamTests methodsFor: 'testing' stamp: 'PaulDeBruicker 04/10/2011 10:47'!
testBinary
	| data limitedReadStream |
	data := #(0 1 2 3 4 5 6 7 8 9) asByteArray.
	limitedReadStream := ZnLimitedReadStream on: data readStream limit: 5.
	self assert: limitedReadStream upToEnd = #(0 1 2 3 4) asByteArray! !

!ZnLimitedReadStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/21/2011 23:24'!
testNextCount
	| data stream |
	data := '0123456789'.
	stream := ZnLimitedReadStream on: data readStream limit: 8.
	self assert: (stream next: 4) = '0123'! !

!ZnLimitedReadStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/2/2012 16:05'!
testMatch
	| stream |
	stream := ZnLimitedReadStream on: 'ababcabc' readStream limit: 8.
	self assert: (stream match: 'ab').
	self deny: stream atEnd.
	stream := ZnLimitedReadStream on: 'ababcabc' readStream limit: 8.
	self assert: (stream match: 'abc').
	self deny: stream atEnd.
	self assert: (stream match: 'abc').
	self assert: stream atEnd.
	stream := ZnLimitedReadStream on: 'ababcabc' readStream limit: 8.
	self deny: (stream match: 'xx').
	self assert: stream atEnd.
! !

!ZnLimitedReadStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/21/2011 23:24'!
testNextCountShort
	| data stream |
	data := '0123456789'.
	stream := ZnLimitedReadStream on: data readStream limit: 5.
	self assert: (stream next: 6) = '01234'! !

!ZnLimitedReadStreamTests methodsFor: 'testing' stamp: 'PaulDeBruicker 04/10/2011 10:47'!
testBinaryAll
	| data limitedReadStream |
	data := #(0 1 2 3 4 5 6 7 8 9) asByteArray.
	limitedReadStream := ZnLimitedReadStream on: data readStream limit: data size.
	self assert: limitedReadStream upToEnd = data! !

!ZnLimitedReadStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/21/2011 23:26'!
testNextCountInto
	| data stream buffer |
	data := '0123456789'.
	stream := ZnLimitedReadStream on: data readStream limit: 8.
	buffer := String new: 4.
	self assert: (stream next: 4 into: buffer) = '0123'.
	self assert: buffer = '0123'! !

!ZnLimitedReadStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/31/2012 20:49'!
testNext
	| limitedReadStream |
	limitedReadStream := ZnLimitedReadStream on: String new readStream limit: 10.
	self assert: limitedReadStream atEnd.
	self assert: limitedReadStream next isNil.
	limitedReadStream := ZnLimitedReadStream on: 'ABC' readStream limit: 10.
	self assert: limitedReadStream atEnd not.
	self assert: limitedReadStream next = $A.
	self assert: limitedReadStream peek = $B.
	limitedReadStream next.
	self assert: limitedReadStream next = $C.
	self assert: limitedReadStream next isNil.
	self assert: limitedReadStream atEnd
	! !

!ZnLimitedReadStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/31/2012 20:45'!
testSimpleEof
	| data limitedReadStream |
	data := '0123456789'.
	limitedReadStream := ZnLimitedReadStream on: data readStream limit: 15.
	self assert: limitedReadStream upToEnd = '0123456789'.
	self assert: limitedReadStream atEnd.
	self assert: limitedReadStream next isNil! !

!ZnLimitedReadStreamTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/27/2010 13:04'!
testSimple
	| data limitedReadStream |
	data := '0123456789'.
	limitedReadStream := ZnLimitedReadStream on: data readStream limit: 5.
	self assert: limitedReadStream upToEnd = '01234'! !

!ZnLineReader commentStamp: 'SvenVanCaekenberghe 9/27/2010 17:31'!
I am ZnLineReader and I help reading CRLF terminated lines from a stream.
I can work on ascii and binary streams doing conversions as necessary.
I limit lines to a maximum length.
I work with a reusable buffer.

Part of Zinc HTTP Components.!
!ZnLineReader methodsFor: 'private' stamp: 'SvenVanCaekenberghe 9/12/2011 14:07'!
processNext
	| item |
	stream atEnd ifTrue: [ ^ nil ].
	(item := stream next) ifNil: [ ^ nil ].
	stream isBinary ifTrue: [ item := item asCharacter ].
	item == Character lf
		ifTrue: [
			(position > 0 and: [ (buffer at: position) == Character cr ])
				ifTrue: [
					position := position - 1.
					^ nil ] ].
	self store: item.
	^ item
			
	! !

!ZnLineReader methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/27/2010 19:05'!
nextLine
	self reset.
	[ self processNext isNil ] whileFalse.
	^ buffer copyFrom: 1 to: position ! !

!ZnLineReader methodsFor: 'private' stamp: 'SvenVanCaekenberghe 9/27/2010 18:43'!
store: item
	position >= buffer size ifTrue: [ self growBuffer ].
	position := position + 1.
	buffer at: position put: item		
	! !

!ZnLineReader methodsFor: 'private' stamp: 'SvenVanCaekenberghe 9/27/2010 17:29'!
reset
	position := 0! !

!ZnLineReader methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 1/2/2012 17:51'!
on: readStream
	stream := readStream.
	buffer := String new: 64.
	self 
		limit: ZnConstants maximumLineLength; 
		reset! !

!ZnLineReader methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/27/2010 17:30'!
limit: size
	limit := size! !

!ZnLineReader methodsFor: 'private' stamp: 'SvenVanCaekenberghe 2/28/2011 14:36'!
growBuffer
	| newBuffer |
	buffer size >= limit 
		ifTrue: [
			(ZnLineTooLong limit: limit) signal ].
	newBuffer := String new: buffer size * 2.
	newBuffer replaceFrom: 1 to: buffer size with: buffer.
	buffer := newBuffer ! !

!ZnLineReader class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/27/2010 17:15'!
on: stream
	^ self new
		on: stream;
		yourself! !

!ZnLineReaderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/27/2010 19:22'!
testBinary
	| input reader |
	input := ('Foo', String crlf, 'Bar', String crlf) asByteArray.
	reader := ZnLineReader on: input readStream.
	self assert: reader nextLine = 'Foo'.
	self assert: reader nextLine = 'Bar'.
	self assert: reader nextLine isEmpty! !

!ZnLineReaderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/2/2012 19:18'!
testLineTooLongDefault
	| input reader |
	input := (String new: ZnConstants maximumLineLength + 1) atAllPut: $X.
	reader := ZnLineReader on: input readStream.
	self should: [ reader nextLine ] raise: ZnLineTooLong  ! !

!ZnLineReaderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/27/2010 19:02'!
testSimple
	| input reader |
	input := 'Foo', String crlf, 'Bar', String crlf.
	reader := ZnLineReader on: input readStream.
	self assert: reader nextLine = 'Foo'.
	self assert: reader nextLine = 'Bar'.
	self assert: reader nextLine isEmpty! !

!ZnLineReaderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/28/2011 14:21'!
testLineTooLong
	| input reader |
	input := (String new: 128) atAllPut: $X.
	reader := (ZnLineReader on: input readStream) limit: 64.
	self should: [ reader nextLine ] raise: ZnLineTooLong  ! !

!ZnLineTooLong commentStamp: 'SvenVanCaekenberghe 2/28/2011 14:15'!
ZnLineTooLong is signalled when an HTTP CRLF terminated input line exceeds a predefined limit.

Part of Zinc HTTP Components. !
!ZnLineTooLong methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/28/2011 14:32'!
limit: anObject
	limit := anObject! !

!ZnLineTooLong methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/28/2011 14:32'!
limit
	^ limit! !

!ZnLineTooLong class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 2/28/2011 14:34'!
limit: limit
	^ self new 
		limit: limit; 
		yourself! !

!ZnLogEvent commentStamp: 'SvenVanCaekenberghe 6/11/2014 14:20'!
I am ZnLogEvent, the base class of a log events emitted by elements of the Zinc HTTP Components framework.

I add a timestamp and a simple id attribute. The id can wrap around and should only be used to distinguish between events that have the same timestamp.

ZnLogEvents are distributed as Announcement through a singleton Announcer that I maintain.

I have a small convenience API to log to the Transcript or open a simple GUI on the emitted log events.!
!ZnLogEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 13:58'!
id
	^ id! !

!ZnLogEvent methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 6/11/2014 13:59'!
initialize
	super initialize.
	timestamp := DateAndTime  now.
	id := self nextId! !

!ZnLogEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 13:58'!
announcer
	^ self class announcer! !

!ZnLogEvent methodsFor: 'beacon' stamp: 'SvenVanCaekenberghe 6/30/2014 17:13'!
printOneLineOn: stream
	self printOn: stream! !

!ZnLogEvent methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 6/30/2014 16:52'!
printOn: stream
	timestamp printYMDOn: stream.
	stream space.
	timestamp printHMSOn: stream. 
	stream space.
	id \\ 1000 printOn: stream base: 10 length: 3 padded: true.
	self printContentsOn: stream! !

!ZnLogEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 13:59'!
timestamp
	^ timestamp! !

!ZnLogEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 14:04'!
nextId
	^ self class nextId! !

!ZnLogEvent methodsFor: 'actions' stamp: 'SvenVanCaekenberghe 6/11/2014 13:58'!
emit
	self announcer announce: self! !

!ZnLogEvent methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 6/30/2014 16:52'!
printContentsOn: stream
	"Subclasses should implement this to add output"! !

!ZnLogEvent methodsFor: 'beacon' stamp: 'SvenVanCaekenberghe 6/30/2014 17:13'!
printOneLineContentsOn: stream
	self printContentsOn: stream! !

!ZnLogEvent class methodsFor: 'class initialization' stamp: 'SvenVanCaekenberghe 6/11/2014 13:57'!
initialize
	IdCounter := 0.
	Smalltalk addToStartUpList: self! !

!ZnLogEvent class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 13:58'!
announcer
	^ LogEventAnnouncer ifNil: [ LogEventAnnouncer := Announcer new ]! !

!ZnLogEvent class methodsFor: 'system startup' stamp: 'SvenVanCaekenberghe 6/11/2014 13:57'!
startUp
	"Reset the id counter"
	
	IdCounter := 0! !

!ZnLogEvent class methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 2/11/2015 15:23'!
logToTranscript
	self stopLoggingToTranscript.
	^ self announcer when: ZnLogEvent do: [ :event | Transcript crShow: event ].! !

!ZnLogEvent class methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 6/11/2014 14:09'!
stopLoggingToTranscript
	self announcer unsubscribe: Transcript! !

!ZnLogEvent class methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 6/11/2014 13:57'!
open
	^ self announcer open! !

!ZnLogEvent class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 13:57'!
nextId
	"This should be thread safe because SmallInteger 
	arithmetic primitives cannot be interrupted"
	
	^ IdCounter := IdCounter + 1! !

!ZnMagicCookieJarTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/4/2011 15:02'!
testCookiesForUrl
	| jar c1 c2 |
	jar := ZnCookieJar new.
	c1 := ZnCookie fromString: self cookieString for: 'http://www.google.com' asZnUrl.
	c2 := ZnCookie fromString: self cookieStringAlt for: 'http://www.pharo-project.org' asZnUrl.
	jar add: c1; add: c2.
	self assert: ((jar cookiesForUrl: 'http://www.google.com' asZnUrl) size = 1)! !

!ZnMagicCookieJarTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/4/2011 15:03'!
testCookieAtForUrl
	| jar c1 c2 |
	jar := ZnCookieJar new.
	c1 := ZnCookie fromString: self cookieString for: 'http://www.google.com' asZnUrl.
	c2 := ZnCookie fromString: self cookieStringAlt for: 'http://www.pharo-project.org' asZnUrl.
	jar add: c1; add: c2.
	self assert: ((jar cookieAt: 'PREF' forUrl: 'http://www.google.com' asZnUrl) notNil).
	self assert: ((jar cookieAt: 'foobar' forUrl: 'http://www.google.com' asZnUrl) isNil)! !

!ZnMagicCookieJarTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/4/2011 14:19'!
testAdd
	| jar count |
	jar := ZnCookieJar new.
	count := jar cookies size.
	jar add: (ZnCookie fromString: self cookieString for: 'www.google.com' asZnUrl).
	self assert: ((jar cookies size) = (count + 1))! !

!ZnMagicCookieJarTests methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/28/2012 12:39'!
cookieString
	^ 'PREF=ID=18ae67ce302b6317:TM=1285696140:LM=1285696140:S=hqroFGlRQR1j4Yhy; expires={1}; path=/; domain=.google.com' format: { ZnUtils httpDate: DateAndTime now + 60 days }! !

!ZnMagicCookieJarTests methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/28/2012 12:39'!
cookieStringAlt
	^'PREFS=ID=18ae67ce302b6317:TM=1285696140:LM=1285696140:S=hqroFGlRQR1j4Yhy; expires={1}; path=/; domain=.pharo-project.org' format: { ZnUtils httpDate: DateAndTime now + 60 days }! !

!ZnMagicCookieTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/4/2011 15:01'!
testInDomain
	| cookie |
	cookie := ZnCookie fromString: self cookieString for: 'http://www.google.com' asZnUrl.
	self assert: (cookie isInDomain: 'http://www.google.com' asZnUrl).
	self assert: (cookie isInDomain: 'http://google.com' asZnUrl).
	self assert: ((cookie isInDomain: 'http://pharo-project.org' asZnUrl) not)
	! !

!ZnMagicCookieTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/4/2011 14:20'!
testFromString
	| cookie |
	cookie := ZnCookie fromString: self cookieString for: 'www.google.com' asZnUrl.
	self assert: (cookie name = 'PREF').
	self assert: (cookie path notNil).
	self assert: (cookie domain = '.google.com').
	self assert: (cookie isExpired not)
	! !

!ZnMagicCookieTests methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/28/2012 12:38'!
cookieStringSubpath
	^ 'PREF=ID=18ae67ce302b6317:TM=1285696140:LM=1285696140:S=hqroFGlRQR1j4Yhy; expires={1}; path=/test/; domain=.google.com' format: { ZnUtils httpDate: DateAndTime now + 60 days }! !

!ZnMagicCookieTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/28/2012 12:38'!
cookieString
	^ 'PREF=ID=18ae67ce302b6317:TM=1285696140:LM=1285696140:S=hqroFGlRQR1j4Yhy; expires={1}; path=/; domain=.google.com' format: { ZnUtils httpDate: DateAndTime now + 60 days }! !

!ZnMagicCookieTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/4/2011 14:20'!
testInPath
	| cookie |
	cookie := ZnCookie fromString: self cookieStringSubpath for: 'www.google.com' asZnUrl.
	self assert: (cookie isInPath: 'www.google.com/test/' asZnUrl).
	self assert: ((cookie isInPath: 'www.google.com' asZnUrl) not)
	! !

!ZnManagingMultiThreadedServer commentStamp: '<historical>'!
ZnManagingMultiThreadedServer is a ZnMultiThreadedServer that manages the socket stream connections used by the worker threads that are spawned.

  ZnManagingMultiThreadedServer startDefaultOn: 1701.

I keep track of all the connections that I spawn so that I can close them when I am stopped.

Part of Zinc HTTP Components.!
!ZnManagingMultiThreadedServer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/5/2011 14:14'!
lock
	^ lock ifNil: [ lock := Mutex new ]! !

!ZnManagingMultiThreadedServer methodsFor: 'private' stamp: 'SvenVanCaekenberghe 6/13/2014 13:40'!
closeConnections
	self connections isEmpty ifTrue: [ ^ self ].
	self lock critical: [
		self connections do: [ :each | 
			self logConnectionClosed: each.
			[ each close ] 
				on: Exception 
				do: [ ] ].
		self connections removeAll ]! !

!ZnManagingMultiThreadedServer methodsFor: 'public' stamp: 'SvenVanCaekenberghe 10/10/2012 10:16'!
stop: unregister
	super stop: unregister.
	self closeConnections! !

!ZnManagingMultiThreadedServer methodsFor: 'private' stamp: 'SvenVanCaekenberghe 9/5/2011 14:17'!
socketStreamOn: socket
	| socketStream |
	socketStream := super socketStreamOn: socket.
	self lock critical: [ 
		self connections add: socketStream ].
	^ socketStream! !

!ZnManagingMultiThreadedServer methodsFor: 'private' stamp: 'SvenVanCaekenberghe 6/13/2014 13:40'!
closeSocketStream: socketStream
	super closeSocketStream: socketStream.
	self lock critical: [ 
		self connections remove: socketStream ifAbsent: [ ] ]! !

!ZnManagingMultiThreadedServer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/5/2011 14:14'!
connections
	^ connections ifNil: [ connections := OrderedCollection new ]! !

!ZnMaximumEntitySize commentStamp: '<historical>'!
I am ZnMaximumEntitySize.
I am a DynamicVariable and a ProcessSpecificVariable.

I am used to control the maximum size of entities being read from streams.
!
!ZnMessage commentStamp: 'SvenVanCaekenberghe 12/6/2010 12:46'!
I am ZnMessage, an abstract class representing an HTTP Message.

Part of Zinc HTTP Components.!
!ZnMessage methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/4/2010 20:32'!
hasHeaders
	^ headers notNil and: [ self headers isEmpty not ]! !

!ZnMessage methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/21/2010 12:15'!
contentType
	self hasEntity ifTrue: [ ^ self entity contentType ].
	(self hasHeaders and: [ self headers hasContentType ]) ifTrue: [ ^ self headers contentType ].
	^ nil! !

!ZnMessage methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 6/28/2011 10:31'!
readFrom: stream
	self readHeaderFrom: stream.
	self readEntityFrom: stream
	! !

!ZnMessage methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/7/2010 22:32'!
setConnectionClose
	self headers at: 'Connection' put: 'close'! !

!ZnMessage methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 9/21/2010 11:32'!
readHeaderFrom: stream
	self headers: (ZnHeaders readFrom: stream)
	! !

!ZnMessage methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/18/2013 12:51'!
entityWriterOn: stream
	^ ZnEntityWriter new
		headers: self headers;
		stream: stream;
		yourself! !

!ZnMessage methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/21/2010 12:02'!
hasEntity
	^ self entity notNil! !

!ZnMessage methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/29/2013 14:37'!
setContentType: mimeType
	"Explicitly set my Content-Type to mimeType.
	I normally do this automatically by taking the #contentType from my entity."
	
	self headers contentType: mimeType! !

!ZnMessage methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/19/2011 10:09'!
entity: object
	"Set my entity to object. Unless I already am describing an entity using my content type and length
	set my content type and length as defined by object."

	entity := object.
	self headers isDescribingEntity ifFalse: [
		self headers acceptEntityDescription: object ]! !

!ZnMessage methodsFor: '*GT-InspectorExtensions-Core' stamp: 'SvenVanCaekenberghe 10/6/2014 14:14'!
gtInspectorHeadersIn: composite 
	<gtInspectorPresentationOrder: 30>
	^ (self headers gtInspectorHeadersIn: composite) 
		title: [:anObject | self headers headers size asString , ' headers' ]! !

!ZnMessage methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/14/2010 13:58'!
setConnectionKeepAlive
	self headers at: 'Connection' put: 'keep-alive'! !

!ZnMessage methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/14/2010 14:51'!
isConnectionKeepAlive
	| value |
	value := self headers at: 'Connection' ifAbsent: [ ^ false ].
	^ value sameAs: 'keep-alive'! !

!ZnMessage methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/1/2011 19:02'!
entityReaderOn: stream
	^ ZnEntityReader new
		headers: self headers;
		stream: stream;
		yourself! !

!ZnMessage methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/30/2010 19:53'!
headers: object
	headers := object! !

!ZnMessage methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/20/2012 16:07'!
wantsConnectionClose
	"Return if the HTTP protocol should close the connection after processing the receiver"
	
	^ false! !

!ZnMessage methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 5/22/2013 10:37'!
hash
	^ self headers hash bitXor: self entity hash! !

!ZnMessage methodsFor: 'enumerating' stamp: 'SvenVanCaekenberghe 9/21/2010 12:04'!
headersDo: twoArgumentBlock
	self hasHeaders
		ifTrue: [ self headers headersDo: twoArgumentBlock ]! !

!ZnMessage methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/6/2010 22:34'!
headers
	headers isNil ifTrue: [ headers := ZnHeaders new ].
	^ headers! !

!ZnMessage methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 6/28/2011 10:31'!
readEntityFrom: stream
	self entity: (self entityReaderOn: stream) readEntity
	! !

!ZnMessage methodsFor: 'writing' stamp: 'SvenVanCaekenberghe 5/18/2013 12:52'!
writeOn: stream
	| bivalentWriteStream |
	bivalentWriteStream := ZnBivalentWriteStream on: stream.
	self headers writeOn: bivalentWriteStream.
	bivalentWriteStream nextPutAll: String crlf.
	self hasEntity ifTrue: [ 
		(self entityWriterOn: bivalentWriteStream) writeEntity: self entity ]! !

!ZnMessage methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/10/2012 19:02'!
session
	"Return the current server session.
	This only returns a value during #handleRequest:"

	^ ZnCurrentServerSession value! !

!ZnMessage methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/14/2010 14:51'!
isConnectionClose
	| value |
	value := self headers at: 'Connection' ifAbsent: [ ^ false ].
	^ value sameAs: 'close'! !

!ZnMessage methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 9/27/2010 12:17'!
readStreamingFrom: stream
	| entityReader |
	self readHeaderFrom: stream.
	(entityReader := self entityReaderOn: stream)
		streaming.
	self entity: entityReader readEntity
	! !

!ZnMessage methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 4/7/2012 16:42'!
readBinaryFrom: stream
	| entityReader |
	self readHeaderFrom: stream.
	(entityReader := self entityReaderOn: stream)
		binary.
	self entity: entityReader readEntity! !

!ZnMessage methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/10/2012 17:32'!
server
	"Return the current server.
	This only returns a value during #handleRequest:"

	^ ZnCurrentServer value! !

!ZnMessage methodsFor: 'writing' stamp: 'SvenVanCaekenberghe 1/24/2013 10:00'!
writeToTranscript
	"Write the receiver on the Transcript like when sent or received over the network.
	Useful for debugging, obviously"
	
	self writeOn: Transcript.
	Transcript flush! !

!ZnMessage methodsFor: '*GT-InspectorExtensions-Core' stamp: 'SvenVanCaekenberghe 10/6/2014 15:09'!
gtInspectorContentsIn: composite
	<gtInspectorPresentationOrder: 40>
	self hasEntity
		ifTrue: [ 
			self contentType isBinary
				ifTrue: [ 
					composite table
						title: 'Contents';
						display: [ {'entity' -> self entity} ];
						column: 'Key' evaluated: #key;
						column: 'Value' evaluated: #value;
						send: #value ]
				ifFalse: [ 
					composite rubricText
						title: 'Contents';
						format: self contents ] ]! !

!ZnMessage methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/14/2012 10:37'!
clearEntity
	"Set my entity to nil. 
	Unlike #resetEntity:, my content type and length remain unchanged."

	entity ifNotNil: [
		entity close.
		entity := nil ]! !

!ZnMessage methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/6/2010 22:34'!
entity
	^ entity! !

!ZnMessage methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/30/2011 22:05'!
cookies
	self subclassResponsibility ! !

!ZnMessage methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 5/22/2013 10:38'!
= other
	self class = other class ifFalse: [ ^ false ].
	^ self headers = other headers and: [ self entity = other entity ]! !

!ZnMessage methodsFor: 'copying' stamp: 'SvenVanCaekenberghe 6/12/2014 15:56'!
postCopy
	headers := headers copy.
	"Note that we don't copy the entity, see also #resetEntity: and ZnClient>>#resetEntity"! !

!ZnMessage methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/19/2011 10:26'!
resetEntity: object
	"Set my entity to object. Always set my content type and length as defined by object,
	even if I am already describing an entity using my content type and length.
	See also: #clearEntity"

	(entity ~= object and: [ entity notNil ]) 
		ifTrue: [ entity close ].
	entity := object.
	self headers acceptEntityDescription: object! !

!ZnMessage methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/10/2012 18:58'!
hasSession
	"Return if there currently is a server session.
	This only returns a value during #handleRequest:"

	^ ZnCurrentServerSession value notNil! !

!ZnMessage methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/21/2010 12:17'!
contentLength
	self hasEntity ifTrue: [ ^ self entity contentLength ].
	(self hasHeaders and: [ self headers hasContentLength ]) ifTrue: [ ^ self headers contentLength ].
	^ nil! !

!ZnMessage methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/28/2010 13:03'!
contents
	^ entity isNil ifTrue: [ nil ] ifFalse: [ entity contents ]! !

!ZnMessage class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/21/2010 11:56'!
readFrom: stream
	^ self new
		readFrom: stream;
		yourself! !

!ZnMessage class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/21/2010 11:56'!
readStreamingFrom: stream
	^ self new
		readStreamingFrom: stream;
		yourself! !

!ZnMessage class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/21/2010 12:18'!
readHeaderFrom: stream
	^ self new
		readHeaderFrom: stream;
		yourself! !

!ZnMessage class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 4/7/2012 16:41'!
readBinaryFrom: stream
	^ self new
		readBinaryFrom: stream;
		yourself! !

!ZnMessageBenchmark commentStamp: '<historical>'!
I am ZnMessageBenchmark helps to test the benchmarking and profiling of ZnMessage writing and reading.

Instance Variables
	buffer:					<ByteArray>
	message:				<ZnObject>
	representation:		<ByteArray>

ZnMessageBenchmark new
	simpleRequest;
	write: 10000.

ZnMessageBenchmark new
	simpleRequest;
	writeRepresentation;
	read: 10000.

ZnMessageBenchmark new
	simpleResponse;
	write: 10000.

ZnMessageBenchmark new
	simpleResponse;
	writeRepresentation;
	read: 10000.
!
!ZnMessageBenchmark methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/21/2013 16:18'!
binaryResponse256k
	message := ZnResponse ok: (ZnEntity with: (self randomBytes: 256 * 1024))! !

!ZnMessageBenchmark methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/21/2013 17:06'!
benchWrite
	^ [ self write ] bench! !

!ZnMessageBenchmark methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/21/2013 16:18'!
binaryResponse64k
	message := ZnResponse ok: (ZnEntity with: (self randomBytes: 64 * 1024))! !

!ZnMessageBenchmark methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/21/2013 15:35'!
write: count
	count timesRepeat: [ self write ]! !

!ZnMessageBenchmark methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/21/2013 16:56'!
writeUsingGzipEncodingAndChunkingRepresentation
	message
		setContentEncodingGzip;
		setTransferEncodingChunked.
	representation := self write contents.
	self sizeBuffer: representation size + 1024 ! !

!ZnMessageBenchmark methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/21/2013 20:05'!
asciiResponse8k
	message := ZnResponse ok: 
		(ZnEntity 
			with: (self randomAsciiString: 8 * 1024) 
			type: 'text/plain;charset=ascii')! !

!ZnMessageBenchmark methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/21/2013 16:20'!
textResponse64k
	message := ZnResponse ok: (ZnEntity with: (self randomUnicodeString: 64 * 1024))! !

!ZnMessageBenchmark methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/21/2013 16:20'!
textResponse8k
	message := ZnResponse ok: (ZnEntity with: (self randomUnicodeString: 8 * 1024))! !

!ZnMessageBenchmark methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/21/2013 20:06'!
asciiResponse64k
	message := ZnResponse ok: 
		(ZnEntity 
			with: (self randomAsciiString: 64 * 1024) 
			type: 'text/plain;charset=ascii')! !

!ZnMessageBenchmark methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/21/2013 17:07'!
benchRead
	^ [ self read ] bench! !

!ZnMessageBenchmark methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/21/2013 15:28'!
read
	| readStream |
	readStream := representation readStream.
	^ message class readFrom: readStream! !

!ZnMessageBenchmark methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 6/11/2013 13:24'!
textResponseWide64k
	message := ZnResponse ok: (ZnEntity with: (self randomUnicodeWideString: 64 * 1024))! !

!ZnMessageBenchmark methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/21/2013 16:27'!
textResponse256k
	message := ZnResponse ok: (ZnEntity with: (self randomUnicodeString: 256 * 1024))! !

!ZnMessageBenchmark methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/21/2013 16:01'!
message
	^ message! !

!ZnMessageBenchmark methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/21/2013 15:31'!
simpleRequest
	message := ZnRequest get: 'http://zn.stfx.eu/dw-bench'! !

!ZnMessageBenchmark methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/21/2013 15:26'!
write
	| writeStream |
	writeStream := self buffer writeStream.
	message writeOn: writeStream.
	^ writeStream! !

!ZnMessageBenchmark methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/21/2013 16:14'!
randomAsciiString: count
	^ String
		new: count
		streamContents: [ :stream | 
			count timesRepeat: [ stream nextPut: '0123456789ABCDEF' atRandom ] ]! !

!ZnMessageBenchmark methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/21/2013 16:14'!
randomBytes: count
	| bytes |
	bytes := ByteArray new: count.
	1 to: count do: [ :each | 
		bytes at: each put: (#(65 66 67 68) at: each \\ 4 + 1) ].
	^ bytes! !

!ZnMessageBenchmark methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 6/11/2013 13:25'!
textResponseWide8k
	message := ZnResponse ok: (ZnEntity with: (self randomUnicodeWideString: 8 * 1024))! !

!ZnMessageBenchmark methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/21/2013 16:32'!
writeRepresentation
	representation := self write contents.
	self sizeBuffer: representation size + 1024 ! !

!ZnMessageBenchmark methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 6/11/2013 13:24'!
textResponseWide256k
	message := ZnResponse ok: (ZnEntity with: (self randomUnicodeWideString: 256 * 1024))! !

!ZnMessageBenchmark methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/21/2013 15:24'!
buffer
	^ buffer ifNil: [  buffer := ByteArray new: ZnUtils streamingBufferSize ]! !

!ZnMessageBenchmark methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/21/2013 15:56'!
simpleResponse
	message := ZnResponse ok: (ZnEntity html: ZnDefaultServerDelegate new generateDWBench)! !

!ZnMessageBenchmark methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/21/2013 15:23'!
sizeBuffer: size
	buffer := ByteArray new: size! !

!ZnMessageBenchmark methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/21/2013 16:18'!
binaryResponse8k
	message := ZnResponse ok: (ZnEntity with: (self randomBytes: 8 * 1024))! !

!ZnMessageBenchmark methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/22/2013 09:09'!
randomUnicodeString: count
	^ String
		new: count
		streamContents: [ :stream | 
			"This is about 6% non-ASCII characters, still a ByteString"
			count timesRepeat: [ stream nextPut: '0123456789ABCDEF-élève en Français-0123456789ABCDEF' atRandom ] ]! !

!ZnMessageBenchmark methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/21/2013 19:59'!
asciiResponse256k
	message := ZnResponse ok: 
		(ZnEntity 
			with: (self randomAsciiString: 256 * 1024) 
			type: 'text/plain;charset=ascii')! !

!ZnMessageBenchmark methodsFor: 'private' stamp: 'SvenVanCaekenberghe 6/11/2013 13:23'!
randomUnicodeWideString: count
	| alphabet |
	"This is about 6% non-ASCII characters, 6% non-octet characters, always a WideString"
	alphabet := '0123456789ABCDEF-élève en Français-0123456789ABCDEF', 
		(WideString withAll: (#(300 400 500) collect: [ :each | each asCharacter ])).
	^ WideString
		new: count
		streamContents: [ :stream | 
			count timesRepeat: [ stream nextPut: alphabet atRandom ] ]! !

!ZnMessageBenchmark methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/21/2013 16:24'!
postRequest
	message := (ZnRequest post: 'http://zn.stfx.eu/echo/one/two/three?param1=123&param2=foobar')
		setAcceptEncodingGzip;
		setBasicAuthenticationUsername: 'john' password: 'secret';
		entity: (ZnEntity with: (self randomBytes: 512));
		yourself! !

!ZnMessageBenchmark methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/21/2013 16:08'!
standardRequest
	message := (ZnRequest get: 'http://zn.stfx.eu/echo/one/two/three?param1=123&param2=foobar')
		setAcceptEncodingGzip;
		setBasicAuthenticationUsername: 'john' password: 'secret';
		yourself! !

!ZnMessageBenchmark methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/21/2013 15:34'!
read: count
	count timesRepeat: [ self read ]! !

!ZnMessageBenchmark class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/22/2013 13:37'!
requests
	^ #( simpleRequest standardRequest postRequest )! !

!ZnMessageBenchmark class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/22/2013 14:41'!
bench: messages
	| results |
	results := Dictionary new.
	messages 
		do: [ :each | | bench report |
			bench := self new.
			bench perform: each.
			bench writeRepresentation.
			report := 'Writing {1} - Reading {2}' format: { bench benchWrite. bench benchRead }.
			results at: each put: report ] 
		displayingProgress: 'Benchmarking...'.
	^ results! !

!ZnMessageBenchmark class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/22/2013 14:41'!
benchAll
	^ self bench: self messages! !

!ZnMessageBenchmark class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/22/2013 14:11'!
messages
	^ self requests , self responses! !

!ZnMessageBenchmark class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2013 13:25'!
responses
	^ #( 
		simpleResponse 
		textResponse8k textResponse64k textResponse256k
		textResponseWide8k textResponseWide64k textResponseWide256k
		asciiResponse8k asciiResponse64k asciiResponse256k
		binaryResponse8k binaryResponse64k binaryResponse256k )! !

!ZnMessageBenchmarkTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/22/2013 13:37'!
testResponses
	ZnMessageBenchmark responses do: [ :each |
		| bench |
		bench := ZnMessageBenchmark new.
		bench perform: each.
		self assert: (bench message isKindOf: ZnResponse).
		bench writeRepresentation.
		self assert: (bench read isKindOf: ZnResponse).
		self assert: bench read equals: bench message ]
		
	! !

!ZnMessageBenchmarkTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/22/2013 13:37'!
testRequests
	ZnMessageBenchmark requests do: [ :each |
		| bench |
		bench := ZnMessageBenchmark new.
		bench perform: each.
		self assert: (bench message isKindOf: ZnRequest).
		bench writeRepresentation.
		self assert: (bench read isKindOf: ZnRequest).
		self assert: bench read equals: bench message ]
		
	! !

!ZnMimePart commentStamp: 'SvenVanCaekenberghe 10/5/2010 19:20'!
I am ZnMimePart.
I hold headers and an optional entity.
I am used in MultiPartMimeEncoding.

Acknowledgement: some code borrowed from AJP.

Part of Zinc HTTP Components.!
!ZnMimePart methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/30/2010 19:53'!
contentType
	self hasEntity ifTrue: [ ^ self entity contentType ].
	(self hasHeaders and: [ self headers hasContentType ]) ifTrue: [ ^ self headers contentType ].
	^ nil! !

!ZnMimePart methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 9/30/2010 19:54'!
readFrom: stream
	self headers: (ZnHeaders readFrom: stream).
	self entity: (self entityReaderOn: stream) readEntity
	! !

!ZnMimePart methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/18/2013 12:53'!
entityWriterOn: stream
	^ ZnEntityWriter new
		headers: self headers;
		stream: stream;
		yourself! !

!ZnMimePart methodsFor: '*GT-InspectorExtensions-Core' stamp: 'SvenVanCaekenberghe 10/6/2014 14:17'!
gtInspectorHeadersIn: composite 
	<gtInspectorPresentationOrder: 30>
	^ (self headers gtInspectorHeadersIn: composite) 
		title: [:anObject | self headers headers size asString , ' headers' ]! !

!ZnMimePart methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/30/2010 19:53'!
hasEntity
	^ self entity notNil! !

!ZnMimePart methodsFor: 'private' stamp: 'SvenVanCaekenberghe 10/6/2010 09:30'!
contentDispositionValues
	| contentDisposition values start semiColonIndex |
	(contentDisposition := self contentDisposition) isNil ifTrue: [ ^ #() ].
	values := OrderedCollection new: 3.
	start := 1.
	semiColonIndex := contentDisposition indexOf: $; startingAt: start ifAbsent: [ 0 ].
	[ semiColonIndex isZero ] whileFalse: [
		| value |
		value := contentDisposition copyFrom: start to: semiColonIndex - 1.
		values add: (ZnUtils trimString: value).
		start := semiColonIndex + 1.
		semiColonIndex := contentDisposition indexOf: $; startingAt: start ifAbsent: [ 0 ] ].
	values add: (ZnUtils trimString: (contentDisposition copyFrom: start to: contentDisposition size)).
	^ values! !

!ZnMimePart methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/19/2011 10:09'!
entity: object
	entity := object.
	self headers isDescribingEntity ifFalse: [
		self headers acceptEntityDescription: object ]! !

!ZnMimePart methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/4/2010 18:49'!
setContentDisposition: value
	^ self headers at: 'Content-Disposition' put: value ! !

!ZnMimePart methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/10/2014 09:32'!
fileName
	"Pathnames are often silenty encoded using UTF-8,
	this is a no-op for ASCII, but will fail on Latin-1 and others"

	^ (self detectContentDispositionValue: 'filename')
		ifNotNil: [ :encodedFileName | encodedFileName asByteArray utf8Decoded ]! !

!ZnMimePart methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 6/11/2013 11:24'!
printOn: stream
	super printOn: stream.
	stream nextPut: $(.
	self hasEntity ifTrue: [ 
		self entity printContentTypeAndLengthOn: stream ].
	stream nextPut: $)
	! !

!ZnMimePart methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 7/29/2011 14:17'!
fieldValueString
	^ self fieldValue
		ifNil: [ String empty ]
		ifNotNil: [ :value | value asString ]! !

!ZnMimePart methodsFor: 'private' stamp: 'SvenVanCaekenberghe 10/3/2010 16:10'!
entityReaderOn: stream
	^ ZnEntityReader new
		headers: self headers;
		stream: stream;
		allowReadingUpToEnd;
		yourself! !

!ZnMimePart methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/30/2010 19:53'!
headers: object
	headers := object! !

!ZnMimePart methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 5/22/2013 10:40'!
hash
	^ self headers hash bitXor: self entity hash! !

!ZnMimePart methodsFor: 'enumerating' stamp: 'SvenVanCaekenberghe 9/30/2010 19:53'!
headersDo: twoArgumentBlock
	self hasHeaders
		ifTrue: [ self headers headersDo: twoArgumentBlock ]! !

!ZnMimePart methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/30/2010 19:53'!
headers
	headers isNil ifTrue: [ headers := ZnHeaders new ].
	^ headers! !

!ZnMimePart methodsFor: 'writing' stamp: 'SvenVanCaekenberghe 5/18/2013 12:54'!
writeOn: stream
	self headers writeOn: stream.
	stream nextPutAll: String crlf.
	self hasEntity ifTrue: [ 
		(self entityWriterOn: stream) writeEntity: self entity ]! !

!ZnMimePart methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/5/2010 17:03'!
fieldName
	^ self detectContentDispositionValue: 'name'! !

!ZnMimePart methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 10/16/2014 10:46'!
readBinaryFrom: stream
	| entityReader |
	self headers: (ZnHeaders readFrom: stream).
	(entityReader := self entityReaderOn: stream)
		binary.
	self entity: entityReader readEntity! !

!ZnMimePart methodsFor: '*GT-InspectorExtensions-Core' stamp: 'SvenVanCaekenberghe 10/6/2014 15:15'!
gtInspectorContentsIn: composite
	<gtInspectorPresentationOrder: 40>
	self hasEntity
		ifTrue: [ 
			self contentType isBinary
				ifTrue: [ 
					composite table
						title: 'Contents';
						display: [ {'entity' -> self entity} ];
						column: 'Key' evaluated: #key;
						column: 'Value' evaluated: #value;
						send: #value ]
				ifFalse: [ 
					composite rubricText
						title: 'Contents';
						format: self contents ] ]! !

!ZnMimePart methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 5/22/2013 10:41'!
= other
	self class = other class ifFalse: [ ^ false ].
	^ self headers = other headers and: [ self entity = other entity ]! !

!ZnMimePart methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/30/2010 19:53'!
entity
	^ entity! !

!ZnMimePart methodsFor: 'copying' stamp: 'SvenVanCaekenberghe 6/12/2014 15:58'!
postCopy
	headers := headers copy.
	"Note that we don't copy the entity, see also #resetEntity: and ZnClient>>#resetEntity"! !

!ZnMimePart methodsFor: 'private' stamp: 'SvenVanCaekenberghe 10/5/2010 17:01'!
detectContentDispositionValue: aString
	self contentDispositionValues do: [ :each | 
		((each beginsWith: aString)
			and: [ each size > (aString size + 1)
			and: [ (each at: aString size + 1) = $= ] ]) ifTrue: [
				^ (each copyAfter: $=) withoutQuoting ] ].
	^ nil! !

!ZnMimePart methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/4/2010 18:54'!
fieldValue
	^ self hasEntity 
		ifTrue: [ self entity contents ] 
		ifFalse: [ nil ] ! !

!ZnMimePart methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/3/2010 16:12'!
contentDisposition
	^ self headers at: 'Content-Disposition' ifAbsent: [ nil ]! !

!ZnMimePart methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/4/2010 13:32'!
hasHeaders
	^ headers notNil and: [ self headers isEmpty not ]! !

!ZnMimePart methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/30/2010 19:53'!
contentLength
	self hasEntity ifTrue: [ ^ self entity contentLength ].
	(self hasHeaders and: [ self headers hasContentLength ]) ifTrue: [ ^ self headers contentLength ].
	^ nil! !

!ZnMimePart methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/30/2010 19:53'!
contents
	^ entity isNil ifTrue: [ nil ] ifFalse: [ entity contents ]! !

!ZnMimePart class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 16:56'!
gtExampleFile
	<gtExample: 'File'>
	^ self 
		fieldName: 'file' 
		fileName: 'message.txt' 
		entity: (ZnEntity text: 'Hello World')! !

!ZnMimePart class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 16:56'!
gtExampleField
	<gtExample: 'Field'>
	^ self fieldName: 'message' value: 'hello world'! !

!ZnMimePart class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 16:56'!
gtExampleEmptyField
	<gtExample: 'Empty field'>
	^ self fieldName: 'value' value: ''! !

!ZnMimePart class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 10/9/2014 15:27'!
fieldName: fieldName fileName: fileName entity: entity
	"Pathnames are often silenty encoded using UTF-8,
	this is a no-op for ASCII, but will fail on Latin-1 and others"

	| encodedFileName |
	encodedFileName := fileName utf8Encoded asString.
	^ self new
		setContentDisposition: 'form-data;name="', fieldName, '";filename="', encodedFileName, '"';
		entity: entity;
		yourself! !

!ZnMimePart class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/30/2010 19:57'!
readFrom: stream
	^ self new
		readFrom: stream;
		yourself! !

!ZnMimePart class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 8/16/2011 23:28'!
fieldName: fieldName entity: entity
	^ self new
		setContentDisposition: 'form-data;name="', fieldName, '"';
		entity: entity;
		yourself! !

!ZnMimePart class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 7/2/2012 16:10'!
fieldName: fieldName fileNamed: fileName
	| mimeType size fileStream entity baseName |
	mimeType := ZnMimeType forFilenameExtension: (ZnFileSystemUtils extensionFor: fileName).
	fileStream := ZnFileSystemUtils oldFileStreamFor: fileName.
	mimeType isBinary ifTrue: [ fileStream binary ].
	size := ZnFileSystemUtils fileSizeFor: fileName.
	(entity := ZnStreamingEntity type: mimeType length: size)
		stream: fileStream.
	baseName := ZnFileSystemUtils baseNameFor: fileName.
	^ self fieldName: fieldName fileName: baseName entity: entity
	! !

!ZnMimePart class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 10/16/2014 10:50'!
readBinaryFrom: stream
	^ self new
		readBinaryFrom: stream;
		yourself! !

!ZnMimePart class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 1/29/2012 19:27'!
fieldName: fieldName value: fieldValue
	^ self
		fieldName: fieldName
		entity: (ZnEntity with: fieldValue)! !

!ZnMimeType commentStamp: '<historical>'!
I am ZnMimeType.
Mime types are an element used in describing resources, more specifically their format.

Here are some examples MIME types:

	text/plain
	text/html
	text/plain;charset=utf-8
	image/png
	text/*
 
A mime type has a main/sub form with optional parameters. 

For more information: http://en.wikipedia.org/wiki/MIME_type
I know whether I am binary or not and know my charset when applicable.
My class side offers access to some common constants.
Note that for text types we default to UTF-8 encoding.

Examples:

	ZnMimeType textPlain = 'text/plain;charset=utf-8' asZnMimeType.
	ZnMimeType textPlain charSet.
	ZnMimeType textHtml matches: ZnMimeType text.
	ZnMimeType default matches: ZnMimeType any.
	ZnMimeType imagePng isBinary.
	ZnMimeType forFilenameExtension: 'html'.

I started life as a copy of WAMineType.

Part of Zinc HTTP Components.!
!ZnMimeType methodsFor: 'parameters' stamp: 'SvenVanCaekenberghe 3/6/2012 10:53'!
parameterAt: key ifAbsent: block
	parameters isNil ifTrue: [ ^ block value ].
	^ self parameters at: key ifAbsent: block! !

!ZnMimeType methodsFor: 'parameters' stamp: 'SvenVanCaekenberghe 3/6/2012 11:00'!
parameterAt: key
	^ self parameterAt: key ifAbsent: [ KeyNotFound signalFor: key ]! !

!ZnMimeType methodsFor: 'parameters' stamp: 'SvenVanCaekenberghe 9/7/2010 14:50'!
parameterAt: aKey put: aValue
	self parameters at: aKey put: aValue! !

!ZnMimeType methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/23/2015 14:39'!
isBinary
	"Answers whether the contents of a resource described by me 
	should be considered as binary instead of textual."

	self main = 'text' ifTrue: [ ^ false ].
	^ SubTypeBinaryCache
		at: self sub
		ifAbsentPut: [ 
			| subTypeFragments |
			subTypeFragments := self sub substrings: '+-'.
			subTypeFragments noneSatisfy: [ :each | 
				self class textSubTypeFragments includes: each ] ]! !

!ZnMimeType methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/7/2010 14:47'!
sub
	^ sub! !

!ZnMimeType methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 9/11/2010 20:49'!
printOn: stream
	stream
		nextPutAll: self main;
		nextPut: $/;
		nextPutAll: self sub.
	parameters isNil ifFalse: [ 
		parameters keysAndValuesDo: [ :key :value | 
			stream
				nextPut: $;;
				nextPutAll: key;
				nextPut: $=;
				nextPutAll: value ] ]! !

!ZnMimeType methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/10/2013 11:08'!
isVendorSpecific
	"Tests if the receiver is a vendor specific mime type"
	
	^ self sub beginsWith: 'vnd.'! !

!ZnMimeType methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/10/2013 11:08'!
isNonStandard
	"Tests if the receiver is a non-standard mime type,
	i.e. one that is not registered with IANA"
	
	^ (self main beginsWith: 'x-')
		or: [ (self main beginsWith: 'X-')
		or: [ (self sub beginsWith: 'x-')
		or: [ self sub beginsWith: 'X-' ] ] ]! !

!ZnMimeType methodsFor: 'parameters' stamp: 'SvenVanCaekenberghe 3/6/2012 10:53'!
removeParameter: key
	parameters isNil ifTrue: [ ^ self ].
	^ self parameters removeKey: key ifAbsent: [ nil ]! !

!ZnMimeType methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/21/2013 20:24'!
hasParameters
	^ parameters notNil and: [ parameters isEmpty not ]! !

!ZnMimeType methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 11/15/2013 21:10'!
asMIMEType
	^ self! !

!ZnMimeType methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 5/21/2013 20:32'!
hash
	| hash |
	hash := self main hash bitXor: self sub hash.
	self hasParameters 
		ifTrue: [ hash := hash bitXor: self parameters hash ].
	^ hash! !

!ZnMimeType methodsFor: 'parameters' stamp: 'SvenVanCaekenberghe 3/6/2012 10:54'!
clearCharSet
	self removeParameter: 'charset'! !

!ZnMimeType methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/7/2010 14:47'!
parameters: aDictionary
	parameters := aDictionary! !

!ZnMimeType methodsFor: 'parameters' stamp: 'SvenVanCaekenberghe 12/2/2010 11:24'!
charSet: aString
	self parameters at: 'charset' put: aString! !

!ZnMimeType methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/7/2010 14:47'!
main
	^ main! !

!ZnMimeType methodsFor: 'parameters' stamp: 'SvenVanCaekenberghe 8/18/2011 14:21'!
charSet
	^ self parameterAt: 'charset' ifAbsent: [ nil ]! !

!ZnMimeType methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2013 10:51'!
main: aString
	main := aString asLowercase! !

!ZnMimeType methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/6/2011 20:40'!
parameters
	parameters isNil ifTrue: [ parameters := SmallDictionary new ].
	^ parameters! !

!ZnMimeType methodsFor: 'parameters' stamp: 'SvenVanCaekenberghe 12/2/2010 11:20'!
setCharSetUTF8
	self charSet: 'utf-8'! !

!ZnMimeType methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 1/4/2011 19:47'!
asZnMimeType
	^ self! !

!ZnMimeType methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 6/7/2013 11:54'!
= other
	"#matches should be used instead of #= to ignore parameters."

	^ (self class == other class)
		and: [ self main = other main
			and: [ self sub = other sub 
				and: [ self hasParameters not & other hasParameters not
						or: [ self parameters = other parameters ] ] ] ] ! !

!ZnMimeType methodsFor: 'copying' stamp: 'SvenVanCaekenberghe 12/6/2011 20:41'!
postCopy
	super postCopy.
	parameters := parameters copy! !

!ZnMimeType methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/7/2013 11:53'!
matches: aMimeType
	"Compare the receiver to aMimeType, which is the pattern to match, 
	it is a normal instance where main or sub can be wildcards.
	Matches should be used instead of #= to ignore parameters."
	
	^ (aMimeType main = '*'
		or: [ aMimeType main = self main ])
		and: [
			aMimeType sub = '*'
				or: [ aMimeType sub = self sub ] ]! !

!ZnMimeType methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2013 10:51'!
sub: aString
	sub := aString asLowercase! !

!ZnMimeType methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/2/2010 11:19'!
isCharSetUTF8
	^ self charSet notNil and: [ self charSet sameAs: 'utf-8' ]! !

!ZnMimeType class methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/15/2014 16:29'!
textSubTypeFragments
	"Return a collection of fragments of sub types that indicate for any main type
	that the mime type is non-binary (thus textual)"
	
	^ #('javascript' 'json' 'ston' 'html' 'xml' 'sgml' 'yaml') ! !

!ZnMimeType class methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 10/15/2013 14:35'!
applicationPdf
	^ self main: 'application' sub: 'pdf'! !

!ZnMimeType class methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 10/15/2013 14:47'!
textHtml
	"Note that the charset is set to utf8 automatically"
	
	^ (self main: 'text' sub: 'html') 
		setCharSetUTF8; 
		yourself! !

!ZnMimeType class methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 10/15/2013 14:36'!
imageGif
	^ self main: 'image' sub: 'gif'! !

!ZnMimeType class methodsFor: 'private' stamp: 'SvenVanCaekenberghe 10/15/2013 15:39'!
patchExtensionsMap
	"Patch the extension map that we read from the spec"
	
	#('~' '%') do: [ :each | ExtensionsMap removeKey: each ].
	(ExtensionsMap at: 'text') setCharSetUTF8.
	(ExtensionsMap at: 'html') setCharSetUTF8.
	ExtensionsMap at: 'asc' put: 'text/plain' asZnMimeType! !

!ZnMimeType class methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 10/15/2013 14:47'!
textPlain
	"Note that the charset is set to utf8 automatically"

	^ (self main: 'text' sub: 'plain') 
		setCharSetUTF8; 
		yourself! !

!ZnMimeType class methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 10/15/2013 14:35'!
applicationJson
	^ self main: 'application' sub: 'json'! !

!ZnMimeType class methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 10/15/2013 14:47'!
text
	"This wildcard instance #matches: all textual mime types"
	
	^ self main: 'text' sub: '*'! !

!ZnMimeType class methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 10/15/2013 14:36'!
imagePng
	^ self main: 'image' sub: 'png'! !

!ZnMimeType class methodsFor: 'class initialization' stamp: 'SvenVanCaekenberghe 12/15/2014 16:39'!
initialize
	self 
		initializeExtensionsMap;
		initializeSubTypeBinaryCache! !

!ZnMimeType class methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 10/15/2013 14:36'!
applicationXml
	^ self main: 'application' sub: 'xml'! !

!ZnMimeType class methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 10/15/2013 14:34'!
applicationFormUrlEncoded
	^ self main: 'application' sub: 'x-www-form-urlencoded'! !

!ZnMimeType class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 10/15/2013 15:48'!
forFilenameExtension: extension
	^ self 
		forFilenameExtension: extension 
		ifAbsent: [ self default ]! !

!ZnMimeType class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/15/2013 15:38'!
knownMimeTypesWithFilenameExtensions
	"Return a collection of mime types for which we know a filename extension"
	
	^ ExtensionsMap values! !

!ZnMimeType class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 8/18/2011 14:22'!
main: aMainString sub: aSubString
	^ self new
		main: aMainString;
		sub: aSubString;
		yourself! !

!ZnMimeType class methodsFor: 'private' stamp: 'SvenVanCaekenberghe 10/15/2013 15:10'!
mimeTypeFilenameExtensionsSpec
	"This array maps mime types to a list of filename extensions, based on the Debian/Ubuntu /etc/mime.types file"
	
"('mime.types' asFileReference readStreamDo: [ :in | in contentsOfEntireFile ]) lines 
	collect: [ :line |
		(line isEmpty not and: [ line first ~= $# ])
			ifTrue: [
				(line findTokens: { Character space. Character tab }) asArray ] ]
	thenSelect: [ :each | each notNil and: [ each size > 1 ] ]."
	
	^ #(#('application/andrew-inset' 'ez') #('application/annodex' 'anx') #('application/atom+xml' 'atom') #('application/atomcat+xml' 'atomcat') #('application/atomserv+xml' 'atomsrv') #('application/bbolin' 'lin') #('application/cu-seeme' 'cu') #('application/davmount+xml' 'davmount') #('application/dicom' 'dcm') #('application/dsptype' 'tsp') #('application/ecmascript' 'es') #('application/futuresplash' 'spl') #('application/hta' 'hta') #('application/java-archive' 'jar') #('application/java-serialized-object' 'ser') #('application/java-vm' 'class') #('application/javascript' 'js') #('application/json' 'json') #('application/m3g' 'm3g') #('application/mac-binhex40' 'hqx') #('application/mac-compactpro' 'cpt') #('application/mathematica' 'nb' 'nbp') #('application/mbox' 'mbox') #('application/msaccess' 'mdb') #('application/msword' 'doc' 'dot') #('application/mxf' 'mxf') #('application/octet-stream' 'bin') #('application/oda' 'oda') #('application/ogg' 'ogx') #('application/onenote' 'one' 'onetoc2' 'onetmp' 'onepkg') #('application/pdf' 'pdf') #('application/pgp-encrypted' 'pgp') #('application/pgp-keys' 'key') #('application/pgp-signature' 'sig') #('application/pics-rules' 'prf') #('application/postscript' 'ps' 'ai' 'eps' 'epsi' 'epsf' 'eps2' 'eps3') #('application/rar' 'rar') #('application/rdf+xml' 'rdf') #('application/rtf' 'rtf') #('application/sla' 'stl') #('application/smil' 'smi' 'smil') #('application/xhtml+xml' 'xhtml' 'xht') #('application/xml' 'xml' 'xsl' 'xsd') #('application/xspf+xml' 'xspf') #('application/zip' 'zip') #('application/vnd.android.package-archive' 'apk') #('application/vnd.cinderella' 'cdy') #('application/vnd.google-earth.kml+xml' 'kml') #('application/vnd.google-earth.kmz' 'kmz') #('application/vnd.mozilla.xul+xml' 'xul') #('application/vnd.ms-excel' 'xls' 'xlb' 'xlt') #('application/vnd.ms-excel.addin.macroEnabled.12' 'xlam') #('application/vnd.ms-excel.sheet.binary.macroEnabled.12' 'xlsb') #('application/vnd.ms-excel.sheet.macroEnabled.12' 'xlsm') #('application/vnd.ms-excel.template.macroEnabled.12' 'xltm') #('application/vnd.ms-fontobject' 'eot') #('application/vnd.ms-officetheme' 'thmx') #('application/vnd.ms-pki.seccat' 'cat') #('application/vnd.ms-powerpoint' 'ppt' 'pps') #('application/vnd.ms-powerpoint.addin.macroEnabled.12' 'ppam') #('application/vnd.ms-powerpoint.presentation.macroEnabled.12' 'pptm') #('application/vnd.ms-powerpoint.slide.macroEnabled.12' 'sldm') #('application/vnd.ms-powerpoint.slideshow.macroEnabled.12' 'ppsm') #('application/vnd.ms-powerpoint.template.macroEnabled.12' 'potm') #('application/vnd.ms-word.document.macroEnabled.12' 'docm') #('application/vnd.ms-word.template.macroEnabled.12' 'dotm') #('application/vnd.oasis.opendocument.chart' 'odc') #('application/vnd.oasis.opendocument.database' 'odb') #('application/vnd.oasis.opendocument.formula' 'odf') #('application/vnd.oasis.opendocument.graphics' 'odg') #('application/vnd.oasis.opendocument.graphics-template' 'otg') #('application/vnd.oasis.opendocument.image' 'odi') #('application/vnd.oasis.opendocument.presentation' 'odp') #('application/vnd.oasis.opendocument.presentation-template' 'otp') #('application/vnd.oasis.opendocument.spreadsheet' 'ods') #('application/vnd.oasis.opendocument.spreadsheet-template' 'ots') #('application/vnd.oasis.opendocument.text' 'odt') #('application/vnd.oasis.opendocument.text-master' 'odm') #('application/vnd.oasis.opendocument.text-template' 'ott') #('application/vnd.oasis.opendocument.text-web' 'oth') #('application/vnd.openxmlformats-officedocument.presentationml.presentation' 'pptx') #('application/vnd.openxmlformats-officedocument.presentationml.slide' 'sldx') #('application/vnd.openxmlformats-officedocument.presentationml.slideshow' 'ppsx') #('application/vnd.openxmlformats-officedocument.presentationml.template' 'potx') #('application/vnd.openxmlformats-officedocument.spreadsheetml.sheet' 'xlsx') #('application/vnd.openxmlformats-officedocument.spreadsheetml.sheet' 'xlsx') #('application/vnd.openxmlformats-officedocument.spreadsheetml.template' 'xltx') #('application/vnd.openxmlformats-officedocument.spreadsheetml.template' 'xltx') #('application/vnd.openxmlformats-officedocument.wordprocessingml.document' 'docx') #('application/vnd.openxmlformats-officedocument.wordprocessingml.template' 'dotx') #('application/vnd.rim.cod' 'cod') #('application/vnd.smaf' 'mmf') #('application/vnd.stardivision.calc' 'sdc') #('application/vnd.stardivision.chart' 'sds') #('application/vnd.stardivision.draw' 'sda') #('application/vnd.stardivision.impress' 'sdd') #('application/vnd.stardivision.math' 'sdf') #('application/vnd.stardivision.writer' 'sdw') #('application/vnd.stardivision.writer-global' 'sgl') #('application/vnd.sun.xml.calc' 'sxc') #('application/vnd.sun.xml.calc.template' 'stc') #('application/vnd.sun.xml.draw' 'sxd') #('application/vnd.sun.xml.draw.template' 'std') #('application/vnd.sun.xml.impress' 'sxi') #('application/vnd.sun.xml.impress.template' 'sti') #('application/vnd.sun.xml.math' 'sxm') #('application/vnd.sun.xml.writer' 'sxw') #('application/vnd.sun.xml.writer.global' 'sxg') #('application/vnd.sun.xml.writer.template' 'stw') #('application/vnd.symbian.install' 'sis') #('application/vnd.tcpdump.pcap' 'cap' 'pcap') #('application/vnd.visio' 'vsd') #('application/vnd.wap.wbxml' 'wbxml') #('application/vnd.wap.wmlc' 'wmlc') #('application/vnd.wap.wmlscriptc' 'wmlsc') #('application/vnd.wordperfect' 'wpd') #('application/vnd.wordperfect5.1' 'wp5') #('application/x-123' 'wk') #('application/x-7z-compressed' '7z') #('application/x-abiword' 'abw') #('application/x-apple-diskimage' 'dmg') #('application/x-bcpio' 'bcpio') #('application/x-bittorrent' 'torrent') #('application/x-cab' 'cab') #('application/x-cbr' 'cbr') #('application/x-cbz' 'cbz') #('application/x-cdf' 'cdf' 'cda') #('application/x-cdlink' 'vcd') #('application/x-chess-pgn' 'pgn') #('application/x-comsol' 'mph') #('application/x-cpio' 'cpio') #('application/x-csh' 'csh') #('application/x-debian-package' 'deb' 'udeb') #('application/x-director' 'dcr' 'dir' 'dxr') #('application/x-dms' 'dms') #('application/x-doom' 'wad') #('application/x-dvi' 'dvi') #('application/x-font' 'pfa' 'pfb' 'gsf' 'pcf' 'pcf.Z') #('application/x-font-woff' 'woff') #('application/x-freemind' 'mm') #('application/x-futuresplash' 'spl') #('application/x-ganttproject' 'gan') #('application/x-gnumeric' 'gnumeric') #('application/x-go-sgf' 'sgf') #('application/x-graphing-calculator' 'gcf') #('application/x-gtar' 'gtar') #('application/x-gtar-compressed' 'tgz' 'taz') #('application/x-hdf' 'hdf') #('application/x-hwp' 'hwp') #('application/x-ica' 'ica') #('application/x-info' 'info') #('application/x-internet-signup' 'ins' 'isp') #('application/x-iphone' 'iii') #('application/x-iso9660-image' 'iso') #('application/x-jam' 'jam') #('application/x-java-jnlp-file' 'jnlp') #('application/x-jmol' 'jmz') #('application/x-kchart' 'chrt') #('application/x-killustrator' 'kil') #('application/x-koan' 'skp' 'skd' 'skt' 'skm') #('application/x-kpresenter' 'kpr' 'kpt') #('application/x-kspread' 'ksp') #('application/x-kword' 'kwd' 'kwt') #('application/x-latex' 'latex') #('application/x-lha' 'lha') #('application/x-lyx' 'lyx') #('application/x-lzh' 'lzh') #('application/x-lzx' 'lzx') #('application/x-maker' 'frm' 'maker' 'frame' 'fm' 'fb' 'book' 'fbdoc') #('application/x-md5' 'md5') #('application/x-mif' 'mif') #('application/x-mpegURL' 'm3u8') #('application/x-ms-wmd' 'wmd') #('application/x-ms-wmz' 'wmz') #('application/x-msdos-program' 'com' 'exe' 'bat' 'dll') #('application/x-msi' 'msi') #('application/x-netcdf' 'nc') #('application/x-ns-proxy-autoconfig' 'pac' 'dat') #('application/x-nwc' 'nwc') #('application/x-object' 'o') #('application/x-oz-application' 'oza') #('application/x-pkcs7-certreqresp' 'p7r') #('application/x-pkcs7-crl' 'crl') #('application/x-python-code' 'pyc' 'pyo') #('application/x-qgis' 'qgs' 'shp' 'shx') #('application/x-quicktimeplayer' 'qtl') #('application/x-rdp' 'rdp') #('application/x-redhat-package-manager' 'rpm') #('application/x-rss+xml' 'rss') #('application/x-ruby' 'rb') #('application/x-scilab' 'sci' 'sce') #('application/x-scilab-xcos' 'xcos') #('application/x-sh' 'sh') #('application/x-sha1' 'sha1') #('application/x-shar' 'shar') #('application/x-shockwave-flash' 'swf' 'swfl') #('application/x-silverlight' 'scr') #('application/x-sql' 'sql') #('application/x-stuffit' 'sit' 'sitx') #('application/x-sv4cpio' 'sv4cpio') #('application/x-sv4crc' 'sv4crc') #('application/x-tar' 'tar') #('application/x-tcl' 'tcl') #('application/x-tex-gf' 'gf') #('application/x-tex-pk' 'pk') #('application/x-texinfo' 'texinfo' 'texi') #('application/x-trash' '~' '%' 'bak' 'old' 'sik') #('application/x-troff' 't' 'tr' 'roff') #('application/x-troff-man' 'man') #('application/x-troff-me' 'me') #('application/x-troff-ms' 'ms') #('application/x-ustar' 'ustar') #('application/x-wais-source' 'src') #('application/x-wingz' 'wz') #('application/x-x509-ca-cert' 'crt') #('application/x-xcf' 'xcf') #('application/x-xfig' 'fig') #('application/x-xpinstall' 'xpi') #('audio/amr' 'amr') #('audio/amr-wb' 'awb') #('audio/amr' 'amr') #('audio/amr-wb' 'awb') #('audio/annodex' 'axa') #('audio/basic' 'au' 'snd') #('audio/csound' 'csd' 'orc' 'sco') #('audio/flac' 'flac') #('audio/midi' 'mid' 'midi' 'kar') #('audio/mpeg' 'mpga' 'mpega' 'mp2' 'mp3' 'm4a') #('audio/mpegurl' 'm3u') #('audio/ogg' 'oga' 'ogg' 'spx') #('audio/prs.sid' 'sid') #('audio/x-aiff' 'aif' 'aiff' 'aifc') #('audio/x-gsm' 'gsm') #('audio/x-mpegurl' 'm3u') #('audio/x-ms-wma' 'wma') #('audio/x-ms-wax' 'wax') #('audio/x-pn-realaudio' 'ra' 'rm' 'ram') #('audio/x-realaudio' 'ra') #('audio/x-scpls' 'pls') #('audio/x-sd2' 'sd2') #('audio/x-wav' 'wav') #('chemical/x-alchemy' 'alc') #('chemical/x-cache' 'cac' 'cache') #('chemical/x-cache-csf' 'csf') #('chemical/x-cactvs-binary' 'cbin' 'cascii' 'ctab') #('chemical/x-cdx' 'cdx') #('chemical/x-cerius' 'cer') #('chemical/x-chem3d' 'c3d') #('chemical/x-chemdraw' 'chm') #('chemical/x-cif' 'cif') #('chemical/x-cmdf' 'cmdf') #('chemical/x-cml' 'cml') #('chemical/x-compass' 'cpa') #('chemical/x-crossfire' 'bsd') #('chemical/x-csml' 'csml' 'csm') #('chemical/x-ctx' 'ctx') #('chemical/x-cxf' 'cxf' 'cef') #('chemical/x-embl-dl-nucleotide' 'emb' 'embl') #('chemical/x-galactic-spc' 'spc') #('chemical/x-gamess-input' 'inp' 'gam' 'gamin') #('chemical/x-gaussian-checkpoint' 'fch' 'fchk') #('chemical/x-gaussian-cube' 'cub') #('chemical/x-gaussian-input' 'gau' 'gjc' 'gjf') #('chemical/x-gaussian-log' 'gal') #('chemical/x-gcg8-sequence' 'gcg') #('chemical/x-genbank' 'gen') #('chemical/x-hin' 'hin') #('chemical/x-isostar' 'istr' 'ist') #('chemical/x-jcamp-dx' 'jdx' 'dx') #('chemical/x-kinemage' 'kin') #('chemical/x-macmolecule' 'mcm') #('chemical/x-macromodel-input' 'mmd' 'mmod') #('chemical/x-mdl-molfile' 'mol') #('chemical/x-mdl-rdfile' 'rd') #('chemical/x-mdl-rxnfile' 'rxn') #('chemical/x-mdl-sdfile' 'sd' 'sdf') #('chemical/x-mdl-tgf' 'tgf') #('chemical/x-mmcif' 'mcif') #('chemical/x-mol2' 'mol2') #('chemical/x-molconn-Z' 'b') #('chemical/x-mopac-graph' 'gpt') #('chemical/x-mopac-input' 'mop' 'mopcrt' 'mpc' 'zmt') #('chemical/x-mopac-out' 'moo') #('chemical/x-mopac-vib' 'mvb') #('chemical/x-ncbi-asn1' 'asn') #('chemical/x-ncbi-asn1-ascii' 'prt' 'ent') #('chemical/x-ncbi-asn1-binary' 'val' 'aso') #('chemical/x-ncbi-asn1-spec' 'asn') #('chemical/x-pdb' 'pdb' 'ent') #('chemical/x-rosdal' 'ros') #('chemical/x-swissprot' 'sw') #('chemical/x-vamas-iso14976' 'vms') #('chemical/x-vmd' 'vmd') #('chemical/x-xtel' 'xtel') #('chemical/x-xyz' 'xyz') #('image/gif' 'gif') #('image/ief' 'ief') #('image/jpeg' 'jpeg' 'jpg' 'jpe') #('image/pcx' 'pcx') #('image/png' 'png') #('image/svg+xml' 'svg' 'svgz') #('image/tiff' 'tiff' 'tif') #('image/vnd.djvu' 'djvu' 'djv') #('image/vnd.microsoft.icon' 'ico') #('image/vnd.wap.wbmp' 'wbmp') #('image/x-canon-cr2' 'cr2') #('image/x-canon-crw' 'crw') #('image/x-cmu-raster' 'ras') #('image/x-coreldraw' 'cdr') #('image/x-coreldrawpattern' 'pat') #('image/x-coreldrawtemplate' 'cdt') #('image/x-corelphotopaint' 'cpt') #('image/x-epson-erf' 'erf') #('image/x-jg' 'art') #('image/x-jng' 'jng') #('image/x-ms-bmp' 'bmp') #('image/x-nikon-nef' 'nef') #('image/x-olympus-orf' 'orf') #('image/x-photoshop' 'psd') #('image/x-portable-anymap' 'pnm') #('image/x-portable-bitmap' 'pbm') #('image/x-portable-graymap' 'pgm') #('image/x-portable-pixmap' 'ppm') #('image/x-rgb' 'rgb') #('image/x-xbitmap' 'xbm') #('image/x-xpixmap' 'xpm') #('image/x-xwindowdump' 'xwd') #('message/rfc822' 'eml') #('model/iges' 'igs' 'iges') #('model/mesh' 'msh' 'mesh' 'silo') #('model/vrml' 'wrl' 'vrml') #('model/x3d+vrml' 'x3dv') #('model/x3d+xml' 'x3d') #('model/x3d+binary' 'x3db') #('text/cache-manifest' 'appcache') #('text/calendar' 'ics' 'icz') #('text/css' 'css') #('text/csv' 'csv') #('text/h323' '323') #('text/html' 'html' 'htm' 'shtml') #('text/iuls' 'uls') #('text/mathml' 'mml') #('text/plain' 'asc' 'txt' 'text' 'pot' 'brf' 'srt') #('text/richtext' 'rtx') #('text/scriptlet' 'sct' 'wsc') #('text/texmacs' 'tm') #('text/tab-separated-values' 'tsv') #('text/vnd.sun.j2me.app-descriptor' 'jad') #('text/vnd.wap.wml' 'wml') #('text/vnd.wap.wmlscript' 'wmls') #('text/x-bibtex' 'bib') #('text/x-boo' 'boo') #('text/x-c++hdr' 'h++' 'hpp' 'hxx' 'hh') #('text/x-c++src' 'c++' 'cpp' 'cxx' 'cc') #('text/x-chdr' 'h') #('text/x-component' 'htc') #('text/x-csh' 'csh') #('text/x-csrc' 'c') #('text/x-dsrc' 'd') #('text/x-diff' 'diff' 'patch') #('text/x-haskell' 'hs') #('text/x-java' 'java') #('text/x-lilypond' 'ly') #('text/x-literate-haskell' 'lhs') #('text/x-moc' 'moc') #('text/x-pascal' 'p' 'pas') #('text/x-pcs-gcd' 'gcd') #('text/x-perl' 'pl' 'pm') #('text/x-python' 'py') #('text/x-scala' 'scala') #('text/x-setext' 'etx') #('text/x-sfv' 'sfv') #('text/x-sh' 'sh') #('text/x-tcl' 'tcl' 'tk') #('text/x-tex' 'tex' 'ltx' 'sty' 'cls') #('text/x-vcalendar' 'vcs') #('text/x-vcard' 'vcf') #('video/3gpp' '3gp') #('video/annodex' 'axv') #('video/dl' 'dl') #('video/dv' 'dif' 'dv') #('video/fli' 'fli') #('video/gl' 'gl') #('video/mpeg' 'mpeg' 'mpg' 'mpe') #('video/MP2T' 'ts') #('video/mp4' 'mp4') #('video/quicktime' 'qt' 'mov') #('video/ogg' 'ogv') #('video/webm' 'webm') #('video/vnd.mpegurl' 'mxu') #('video/x-flv' 'flv') #('video/x-la-asf' 'lsf' 'lsx') #('video/x-mng' 'mng') #('video/x-ms-asf' 'asf' 'asx') #('video/x-ms-wm' 'wm') #('video/x-ms-wmv' 'wmv') #('video/x-ms-wmx' 'wmx') #('video/x-ms-wvx' 'wvx') #('video/x-msvideo' 'avi') #('video/x-sgi-movie' 'movie') #('video/x-matroska' 'mpv' 'mkv') #('x-conference/x-cooltalk' 'ice') #('x-epoc/x-sisx-app' 'sisx') #('x-world/x-vrml' 'vrm' 'vrml' 'wrl'))! !

!ZnMimeType class methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 10/15/2013 14:35'!
applicationJavascript
	^ self main: 'application' sub: 'javascript'! !

!ZnMimeType class methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 9/11/2014 15:09'!
applicationSton
	^ self main: 'application' sub: 'ston'! !

!ZnMimeType class methodsFor: 'private' stamp: 'SvenVanCaekenberghe 10/15/2013 15:30'!
initializeExtensionsMap
	"Create a mapping between filename extensions and mime types"

	ExtensionsMap := Dictionary new.
	self mimeTypeFilenameExtensionsSpec
		do: [ :each | 
			| mimeType |
			mimeType := self fromString: each first.
			each allButFirstDo: [ :extension | ExtensionsMap at: extension put: mimeType ] ].
	self patchExtensionsMap! !

!ZnMimeType class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 8/18/2011 14:22'!
main: aMainString sub: aSubString parameters: aDictionary
	^ (self main: aMainString sub: aSubString)
		parameters: aDictionary;
		yourself! !

!ZnMimeType class methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 10/15/2013 14:38'!
textJavascript
	^ self main: 'text' sub: 'javascript'! !

!ZnMimeType class methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 10/15/2013 14:36'!
imageSvg
	^ self main: 'image' sub: 'svg+xml'! !

!ZnMimeType class methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 10/15/2013 14:36'!
imageJpeg
	^ self main: 'image' sub: 'jpeg'! !

!ZnMimeType class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/15/2013 15:37'!
knownFilenameExtensions
	"Return a collection of the filename extensions that we know of"
	
	^ ExtensionsMap keys! !

!ZnMimeType class methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/15/2014 16:44'!
initializeSubTypeBinaryCache
	"This private cache holds sub types of mime types that were classified #isBinary.
	In the future use a limited LRUCache when we no longer have to support Pharo 2.0"
	
	SubTypeBinaryCache := Dictionary new! !

!ZnMimeType class methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 9/16/2010 15:48'!
default
	^ self applicationOctetStream ! !

!ZnMimeType class methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 10/15/2013 14:37'!
textCss
	^ self main: 'text' sub: 'css'! !

!ZnMimeType class methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 10/15/2013 14:37'!
multiPartFormData
	^ self main: 'multipart' sub: 'form-data'! !

!ZnMimeType class methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 10/15/2013 14:35'!
applicationOctetStream
	^ self main: 'application' sub: 'octet-stream'! !

!ZnMimeType class methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 10/15/2013 14:46'!
any
	"This wildcard instance #matches: any mime type"
	
	^ self main: '*' sub: '*'! !

!ZnMimeType class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 2/23/2015 14:39'!
fromString: aString 
	| main endOfSub sub parts parameters |
	main := aString copyUpTo: $/.
	endOfSub := aString indexOf: $;.
	endOfSub := endOfSub = 0 
		ifTrue: [ aString size ]
		ifFalse: [ endOfSub - 1 ].
	sub := aString copyFrom: main size + 2 to: endOfSub.
	endOfSub = aString size ifTrue: [ ^ self main: main sub: sub ].
	parts := (aString copyFrom: endOfSub + 1 to: aString size) substrings: ';'.
	parameters := Dictionary new.
	parts do: [ :each | 
		parameters
			at: (each copyUpTo: $=) trimBoth 
			put: (each copyAfter: $=) trimBoth ].
	^ self 
		main: main
		sub: sub
		parameters: parameters! !

!ZnMimeType class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/15/2013 15:36'!
commonMimeTypes
	"Return a list of commom mime types, the ones we provided convenience accessors for."

	^ #( 
			applicationFormUrlEncoded applicationJavascript applicationJson 
			applicationOctetStream applicationPdf applicationXml 
			imageGif imageJpeg imagePng imageSvg 
			textCss textHtml textJavascript textPlain 
		) collect: [ :each | self perform: each ]! !

!ZnMimeType class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 10/15/2013 15:48'!
forFilenameExtension: extension ifAbsent: block
	^ ExtensionsMap 
		at: extension 
		ifAbsent: block! !

!ZnMimeTypeTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/2/2010 11:29'!
testWriting
	| mimeType |
	(mimeType := ZnMimeType main: 'text' sub: 'plain')
		charSet: 'utf-8'.
	self assert: mimeType printString = 'text/plain;charset=utf-8'.
	self assert: mimeType isCharSetUTF8.
	self assert: mimeType isBinary not! !

!ZnMimeTypeTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/2/2010 11:29'!
testReading
	| mimeType |
	mimeType := ZnMimeType fromString: 'text/plain; charset=utf-8'.
	self assert: (mimeType main = 'text').
	self assert: (mimeType sub = 'plain').
	self assert: (mimeType charSet = 'utf-8').
	self assert: mimeType isCharSetUTF8.
	self assert: mimeType isBinary not! !

!ZnMimeTypeTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/6/2011 20:44'!
testIdentity
	self assert: ZnMimeType textPlain = ZnMimeType textPlain! !

!ZnMimeTypeTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/6/2011 20:44'!
testDefault
	self assert: ZnMimeType default = ZnMimeType applicationOctetStream! !

!ZnMimeTypeTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/6/2012 11:02'!
testParameters
	| mimeType |
	mimeType := ZnMimeType main: 'text' sub: 'plain'.
	self should: [ mimeType parameterAt: 'foo' ] raise: KeyNotFound.
	self assert: (mimeType parameterAt: 'foo' ifAbsent: [ #none ]) = #none.
	mimeType parameterAt: 'foo' put: '1'.
	self assert: (mimeType parameterAt: 'foo') = '1'.
	self assert: (mimeType parameterAt: 'foo' ifAbsent: [ #none ]) = '1'.
	mimeType removeParameter: 'foo'.
	mimeType removeParameter: 'bar'.
	self should: [ mimeType parameterAt: 'foo' ] raise: KeyNotFound.
	self assert: (mimeType parameterAt: 'foo' ifAbsent: [ #none ]) = #none	! !

!ZnMimeTypeTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 7/8/2013 14:31'!
testMatches
	#(
		( 'text/plain' 'text/*' )
		( 'text/plain' '*/*' )
		( 'text/plain;charset=utf-8' 'text/*' ) 
		( 'text/plain;charset=utf-8' 'text/plain' )
		( 'text/plain' 'text/plain;charset=utf-8' )
		( 'text/plain;charset=utf-8' 'text/plain;charset=ascii' ) ) do: [ :each |
			self deny: each first asZnMimeType = each second asZnMimeType.
			self assert: (each first asZnMimeType matches: each second asZnMimeType) ]! !

!ZnMimeTypeTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/6/2012 11:05'!
testCharset
	| mimeType |
	mimeType := ZnMimeType textPlain.
	self assert: mimeType charSet = 'utf-8'.
	mimeType charSet: 'ascii'.
	self assert: mimeType charSet = 'ascii'.
	mimeType clearCharSet.
	self assert: mimeType charSet isNil.
	mimeType setCharSetUTF8.
	self assert: mimeType charSet = 'utf-8'! !

!ZnMimeTypeTests methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/15/2014 16:28'!
someNonBinaryMimeTypes
	^ #(
		'text/plain;charset=ascii' 
		'application/json;charset=utf-8' 
		'application/ston'
		'application/vnd.com.runkeeper.user+json;charset=ISO-8859-1' 
		'application/xml-dtd' 
		'application/xslt+xml' 
		'image/svg+xml' 
		'application/SGML' 
		'model/x3d+xml')! !

!ZnMimeTypeTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/21/2013 20:28'!
testCopying
	| mimeType1 mimeType2 |
	mimeType1 := ZnMimeType textPlain.
	mimeType2 := ZnMimeType textPlain.
	self assert: mimeType1 = mimeType2.
	self assert: mimeType1 parameters = mimeType2 parameters.
	mimeType1 charSet: 'utf-8'.
	self assert: mimeType1 charSet = 'utf-8'.
	mimeType2 charSet: 'latin1'.
	self assert: mimeType2 charSet = 'latin1'.
	self assert: (mimeType1 matches: mimeType2).
	self deny: mimeType1 parameters = mimeType2 parameters.
	self deny: mimeType1 charSet = mimeType2 charSet.
	! !

!ZnMimeTypeTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/21/2013 20:30'!
testAsMimeType
	self assert: 'text/plain;charset=utf-8' asZnMimeType equals: ZnMimeType textPlain.
	self assert: ZnMimeType applicationOctetStream asZnMimeType equals: ZnMimeType applicationOctetStream! !

!ZnMimeTypeTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/15/2014 16:21'!
testIsBinary
	self assert: ZnMimeType applicationOctetStream isBinary.
	self assert: ZnMimeType imagePng isBinary.
	self deny: ZnMimeType textPlain isBinary.
	self deny: ZnMimeType textHtml isBinary.
	self deny: ZnMimeType textJavascript isBinary.
	self deny: ZnMimeType applicationJson isBinary.
	self someNonBinaryMimeTypes do: [ :each |
		self deny: each asZnMimeType isBinary ]! !

!ZnMissingHost commentStamp: 'SvenVanCaekenberghe 8/11/2011 19:37'!
ZnMissingHost is signalled when a host should be specified but was not.

Part of Zinc HTTP Components. !
!ZnMonticelloServerDelegate commentStamp: '<historical>'!
I am ZnMonticelloServerDelegate.
I am a proof of concept implementation of a basic Monticello server.
I function as a delegate for ZnServer.

ZnServer startDefaultOn: 1701.
ZnServer default delegate: ((ZnMonticelloServerDelegate new) 
									directory: '/tmp/monticello'; 
									yourself).

Part of Zinc HTTP Components.!
!ZnMonticelloServerDelegate methodsFor: 'private' stamp: 'SvenVanCaekenberghe 1/30/2013 21:07'!
handleGetMczEntry: request
	| name file stream entity |
	name := request uri firstPathSegment.
	file := self directory / name.
	^ ((self isValidMczName: name) and: [ file exists ]) 
		ifTrue: [ |  |
			(stream := file readStream)
				binary.
			(entity := ZnStreamingEntity type: ZnMimeType applicationOctetStream length: file size)
				stream: stream.
			ZnResponse ok: entity ]
		ifFalse: [ ZnResponse notFound: request uri ]! !

!ZnMonticelloServerDelegate methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/17/2010 10:21'!
mczEntries
	^ (self directory fileNames select: [ :each | each endsWith: '.mcz' ])
		asSortedCollection! !

!ZnMonticelloServerDelegate methodsFor: 'public' stamp: 'SvenVanCaekenberghe 8/22/2012 14:41'!
value: request
	"I implement the generic #value: message as equivalent to #handleRequest:"
	
	^ self handleRequest: request! !

!ZnMonticelloServerDelegate methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/30/2013 20:21'!
directory: object
	directory := object asFileReference! !

!ZnMonticelloServerDelegate methodsFor: 'private' stamp: 'SvenVanCaekenberghe 8/18/2011 14:25'!
handleListMczEntries: request
	^ ZnResponse ok: (ZnEntity html: self repositoryListing)! !

!ZnMonticelloServerDelegate methodsFor: 'public' stamp: 'SvenVanCaekenberghe 1/4/2011 13:42'!
handleRequest: request
	(request method = #GET)
		ifTrue: [
			^ request uri isSlash
				ifTrue: [ self handleListMczEntries: request ]
				ifFalse: [ self handleGetMczEntry: request ] ].
	^ (request method = #PUT) 
		ifTrue: [ self handlePutMczEntry: request ]
		ifFalse: [ ZnResponse badRequest: request ]! !

!ZnMonticelloServerDelegate methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/17/2010 10:20'!
directory
	^ directory ! !

!ZnMonticelloServerDelegate methodsFor: 'private' stamp: 'SvenVanCaekenberghe 9/17/2010 11:00'!
repositoryListing
	^ String streamContents: [ :str |
		str nextPutAll: '<html><head><title>Monticello Repository</title></head>'.
		str nextPutAll: '<body><h1>Monticello Repository</h1>'.
		str nextPutAll: '<ul>'.
		self mczEntries do: [ :each | 
			str nextPutAll: '<li><a href="'; nextPutAll: each; nextPutAll: '">'; nextPutAll: each; nextPutAll: '</a></li>' ].
		str nextPutAll: '</ul></body></html>' ]! !

!ZnMonticelloServerDelegate methodsFor: 'private' stamp: 'SvenVanCaekenberghe 1/30/2013 21:08'!
handlePutMczEntry: request
	| name file |
	name := request uri firstPathSegment.
	file := self directory / name.
	^ ((self isValidMczName: name) and: [ file exists not ]) 
		ifTrue: [
			file writeStreamDo: [ :stream |
				stream binary.
				request entity writeOn: stream ].
			ZnResponse created: request uri ]
		ifFalse: [ ZnResponse badRequest: request ]! !

!ZnMonticelloServerDelegate methodsFor: 'private' stamp: 'SvenVanCaekenberghe 9/17/2010 10:24'!
isValidMczName: string
	^ string isString 
		and: [ string isEmpty not
			and: [ (string endsWith: '.mcz')
				and: [ (string includes: $/) not ] ] ]! !

!ZnMultiPartFormDataEntity commentStamp: 'SvenVanCaekenberghe 1/18/2011 11:04'!
I am ZnMultiPartFormDataEntity, a concrete HTTP Entity 
holding multi part form data that is encoded according to specific rules.
I am a ZnEntity.

Acknowledgement: some code borrowed from AJP.

Part of Zinc HTTP Components.!
!ZnMultiPartFormDataEntity methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 10/16/2014 10:44'!
readFrom: stream
	"Switch to streaming implementation later on"
	
	| bytes |
	"We have to use the contentLength instance variable instead of the accessor else a representation will be computed"
	contentLength isNil
		ifTrue: [ 
			bytes := ZnUtils readUpToEnd: stream limit: ZnConstants maximumEntitySize ]
		ifFalse: [
			self contentLength > ZnConstants maximumEntitySize ifTrue: [ ZnEntityTooLarge signal ].
			bytes := ByteArray ofSize: contentLength.
			stream next: contentLength into: bytes ].
	self parse: bytes boundary: self getBoundary asByteArray binary: false! !

!ZnMultiPartFormDataEntity methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/4/2010 12:43'!
isEmpty
	^ parts isNil or: [ parts isEmpty ]! !

!ZnMultiPartFormDataEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/27/2011 10:29'!
addPart: mimePart
	self invalidateRepresentation.
	self parts add: mimePart! !

!ZnMultiPartFormDataEntity methodsFor: 'private' stamp: 'SvenVanCaekenberghe 10/5/2010 17:19'!
mimeTypeWithBoundary
	| mimeType |
	mimeType := self class designatedMimeType copy.
	mimeType parameterAt: 'boundary' put: self generateBoundary.
	^ mimeType! !

!ZnMultiPartFormDataEntity methodsFor: 'writing' stamp: 'SvenVanCaekenberghe 5/18/2013 19:57'!
writeOn: stream
	"We always go via our representation because we need a bivalent stream"
	
	representation isNil ifTrue: [ self computeRepresentation ].
	ZnUtils nextPutAll: representation on: stream! !

!ZnMultiPartFormDataEntity methodsFor: 'writing' stamp: 'SvenVanCaekenberghe 10/5/2010 17:24'!
writeRepresentationOn: stream
	| boundary |
	boundary := self getBoundary.
	self parts do: [ :each |
		stream nextPutAll: '--'; nextPutAll: boundary; nextPutAll: String crlf.
		each writeOn: stream.
		stream nextPutAll: String crlf ].
	stream nextPutAll: '--'; nextPutAll: boundary; nextPutAll: '--'; nextPutAll: String crlf
! !

!ZnMultiPartFormDataEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/5/2010 19:18'!
partNamed: fieldName ifNone: block
	parts isNil ifTrue: [ block value ].
	^ self parts detect: [ :each | each fieldName = fieldName ] ifNone: block! !

!ZnMultiPartFormDataEntity methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 10/16/2014 10:44'!
readBinaryFrom: stream
	"Switch to streaming implementation later on"
	
	| bytes |
	"We have to use the contentLength instance variable instead of the accessor else a representation will be computed"
	contentLength isNil
		ifTrue: [ 
			bytes := ZnUtils readUpToEnd: stream limit: ZnConstants maximumEntitySize ]
		ifFalse: [
			self contentLength > ZnConstants maximumEntitySize ifTrue: [ ZnEntityTooLarge signal ].
			bytes := ByteArray ofSize: contentLength.
			stream next: contentLength into: bytes ].
	self parse: bytes boundary: self getBoundary asByteArray binary: true! !

!ZnMultiPartFormDataEntity methodsFor: 'private' stamp: 'SvenVanCaekenberghe 10/4/2010 20:11'!
computeRepresentation
	representation := ByteArray streamContents: [ :stream | 
		self writeRepresentationOn: (ZnBivalentWriteStream on: stream) ].
	contentLength := representation size! !

!ZnMultiPartFormDataEntity methodsFor: 'private' stamp: 'SvenVanCaekenberghe 10/16/2014 10:44'!
parse: bytes boundary: boundary binary: binary
	| next start fullBoundary |
	fullBoundary := '--' asByteArray, boundary.
	"Sometimes there is whitespace in front of the first boundary"
	start := (bytes
		indexOfSubCollection: fullBoundary
		startingAt: 1) + 1.
	next := bytes
		indexOfSubCollection: fullBoundary
		startingAt: start 
		ifAbsent: [ bytes size ].
	[ next < (bytes size - 2) ] whileTrue: [ | partReadStream |
		partReadStream := ReadStream on: bytes from: start + 2 to: next - 3.
		self addPart: (ZnMimePart perform: (binary ifTrue: [ #readBinaryFrom: ] ifFalse: [ #readFrom: ]) with: partReadStream).
		start := next + fullBoundary size.
		next := bytes
			indexOfSubCollection: fullBoundary
			startingAt: start
			ifAbsent: [ bytes size ] ]! !

!ZnMultiPartFormDataEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2013 10:43'!
contentType: object
	"We only allow assignment compatible with our designated mime type.
	The main/sub must be equal but the parameters must be allowed to be different"
	
	| newType |
	newType := object asZnMimeType.
	(self class matches: newType)
		ifTrue: [ contentType := newType ]! !

!ZnMultiPartFormDataEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/5/2010 19:17'!
getBoundary
	"Return the multipart/form-data MIME part boundary.
	This should really be there, set externally or internally.
	See #initialize and #mimeTypeWithBoundary"
	
	^ (self contentType parameterAt: 'boundary') withoutQuoting ! !

!ZnMultiPartFormDataEntity methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 10/5/2010 17:17'!
initialize
	super initialize.
	self contentType: self mimeTypeWithBoundary  
	! !

!ZnMultiPartFormDataEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/5/2010 19:12'!
partNamed: fieldName
	^ self partNamed: fieldName ifNone: [ self error: 'Cannot find part named ', fieldName asString ]! !

!ZnMultiPartFormDataEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/30/2010 20:07'!
parts
	parts isNil ifTrue: [ parts := OrderedCollection new ].
	^ parts! !

!ZnMultiPartFormDataEntity methodsFor: 'enumerating' stamp: 'SvenVanCaekenberghe 2/27/2011 20:13'!
partsDo: block
	parts isNil ifTrue: [ ^ self ].
	parts do: block  ! !

!ZnMultiPartFormDataEntity methodsFor: 'private' stamp: 'SvenVanCaekenberghe 1/31/2011 12:13'!
generateBoundary
	^ String streamContents: [ :stream | | letters |
			stream nextPutAll: 'Boundary-Zn-'.
			letters := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
			8 timesRepeat: [ stream nextPut: letters atRandom ] ]
	! !

!ZnMultiPartFormDataEntity methodsFor: 'private' stamp: 'SvenVanCaekenberghe 10/4/2010 19:15'!
invalidateRepresentation
	representation := nil.
	contentLength := nil! !

!ZnMultiPartFormDataEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/27/2011 17:11'!
contentLength
	contentLength isNil ifTrue: [ self computeRepresentation ].
	^ contentLength! !

!ZnMultiPartFormDataEntity methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:34'!
printContentsOn: stream
	super printContentsOn: stream.
	self isEmpty
		ifTrue: [ ^ self ].
	stream space.
	self parts printElementsOn: stream! !

!ZnMultiPartFormDataEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/4/2010 19:14'!
contents
	^ self parts! !

!ZnMultiPartFormDataEntity class methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/11/2013 09:25'!
matches: mimeType
	^ mimeType matches: 'multipart/*' asZnMimeType! !

!ZnMultiPartFormDataEntity class methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/11/2010 20:42'!
designatedMimeType
	^ ZnMimeType multiPartFormData  ! !

!ZnMultiThreadedServer commentStamp: '<historical>'!
I am ZnMultiThreadedServer.
I inherit most features from ZnSingleThreadedServer.

  ZnMultiThreadedServer startDefaultOn: 1701.
  ZnMultiThreadedServer default authenticator: (ZnBasicAuthenticator username: 'foo' password: 'secret').
  ZnClient new username: 'foo' password: 'secret'; get: 'http://localhost:1701'.

I am multi threaded, I fork a new process for each incoming request.
I try to keep connections alive in each process.

Part of Zinc HTTP Components.!
!ZnMultiThreadedServer methodsFor: 'private' stamp: 'SvenVanCaekenberghe 10/4/2011 09:46'!
exceptionSet: classNames
	^ classNames
		inject: ExceptionSet new
		into: [ :set :each |
			(Smalltalk includesKey: each)
				ifTrue: [ set add: (Smalltalk at: each); yourself ]
				ifFalse: [ set ] ]! !

!ZnMultiThreadedServer methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/27/2013 14:57'!
readRequestTerminationExceptionSet
	"Return the set of exceptions which, when they occur while reading a request,
	are interpreted as equivalent to a timeout or connection close."

	^ self
		exceptionSet:
			#(#ConnectionClosed #ConnectionTimedOut #PrimitiveFailed)! !

!ZnMultiThreadedServer methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/13/2010 16:33'!
workerProcessName
	^ String streamContents: [ :stream |
		stream nextPutAll: self class name; nextPutAll: ' HTTP worker' ]! !

!ZnMultiThreadedServer methodsFor: 'private' stamp: 'SvenVanCaekenberghe 6/13/2014 16:50'!
writeResponseBad: exception on: stream timing: timing
	"When we failed to parse a request, write a bad request response before closing."

	| response |
	response := ZnResponse new
		statusLine: ZnStatusLine badRequest;
		headers: ZnHeaders defaultResponseHeaders;
		entity: (ZnEntity textCRLF: 'Bad Request ' , exception printString);
		yourself.
	response setConnectionClose.
	self writeResponseSafely: response on: stream timing: timing! !

!ZnMultiThreadedServer methodsFor: 'request handling' stamp: 'SvenVanCaekenberghe 6/13/2014 21:56'!
writeResponseSafely: response on: stream timing: timing
	"Write response to stream, when the connection is closed or times out we ignore this"

	[ self writeResponse: response on: stream timing: timing ]
		on: self writeResponseTerminationExceptionSet
		do: [ :exception | self logServerWriteError: exception ]! !

!ZnMultiThreadedServer methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/14/2013 10:39'!
writeResponseTerminationExceptionSet
	"Return the set of exceptions which, when they occur while writing a response,
	are interpreted as equivalent to a timeout or connection close."

	^ self exceptionSet: #(#ConnectionClosed #ConnectionTimedOut #PrimitiveFailed)! !

!ZnMultiThreadedServer methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/14/2013 10:43'!
readRequestBadExceptionSet
	"Return the set of exceptions which, when they occur while reading a request,
	are interpreted as equivalent to a request parse error or bad request."

	^ self
		exceptionSet:
			#(#ZnParseError #ZnCharacterEncodingError #ZnUnknownScheme #ZnPortNotANumber #ZnTooManyDictionaryEntries #ZnEntityTooLarge)! !

!ZnMultiThreadedServer methodsFor: 'private' stamp: 'SvenVanCaekenberghe 6/13/2014 15:19'!
closeSocketStream: socketStream
	[ socketStream close ] 
		on: Exception 
		do: [ ]! !

!ZnMultiThreadedServer methodsFor: 'request handling' stamp: 'SvenVanCaekenberghe 11/7/2013 10:52'!
augmentResponse: response forRequest: request
	"Our handler has produced response for request, manipulate the response before writing it"

	super augmentResponse: response forRequest: request.
	response setKeepAliveFor: request.
	response setConnectionCloseFor: request! !

!ZnMultiThreadedServer methodsFor: 'request handling' stamp: 'SvenVanCaekenberghe 12/10/2010 16:00'!
listenLoop
	"We create a listening Socket, then wait for a connection.
	After each connection we also check that the listening Socket is still valid 
	- if not we just make a recursive call to this method to start over."

	self initializeServerSocket.
	[ [ 
		serverSocket isValid 
			ifFalse: [
				"will trigger #ifCurtailed: block and destroy socket"
				^ self listenLoop ].
		self serveConnectionsOn: serverSocket ] repeat ]

		ifCurtailed: [ self releaseServerSocket ]! !

!ZnMultiThreadedServer methodsFor: 'request handling' stamp: 'SvenVanCaekenberghe 6/13/2014 15:50'!
serveConnectionsOn: listeningSocket
	"We wait up to acceptWaitTimeout seconds for an incoming connection.
	If we get one we wrap it in a SocketStream and #executeRequestResponseLoopOn: on it"
		 
	| stream socket |
	socket := listeningSocket waitForAcceptFor: self acceptWaitTimeout.
	socket ifNil: [ ^ self noteAcceptWaitTimedOut ].
	stream := self socketStreamOn: socket.
	[ [ [ self executeRequestResponseLoopOn: stream ]
		ensure: [ self logConnectionClosed: stream. self closeSocketStream: stream ] ]
			ifCurtailed: [ socket destroy ] ]
				forkAt: Processor lowIOPriority
				named: self workerProcessName ! !

!ZnMultiThreadedServer methodsFor: 'request handling' stamp: 'SvenVanCaekenberghe 6/13/2014 16:49'!
executeOneRequestResponseOn: stream
	"Execute one HTTP request / response cycle on stream in 3 steps
	#readRequest: #handleRequest: and #writeResponse:on:
	Return true when the outer loop we are in should stop."

	| request response timing|
	timing := ZnServerTransactionTiming new.
	(request := self readRequestSafely: stream timing: timing)
		ifNil: [ ^ true ]
		ifNotNil: [ 
			response := self handleRequest: request timing: timing.
			self augmentResponse: response forRequest: request.
			self writeResponseSafely: response on: stream timing: timing.
			self logServerTransactionRequest: request response: response timing: timing.
			response useConnection: stream ].
	^ request wantsConnectionClose or: [ response wantsConnectionClose ]! !

!ZnMultiThreadedServer methodsFor: 'request handling' stamp: 'SvenVanCaekenberghe 6/13/2014 14:30'!
executeRequestResponseLoopOn: stream
	"Execute the HTTP request / response loop on stream one cycle at a time
	until the other end indicates it wants to stop or times out"

	ZnCurrentServer 
		value: self 
		during: [ 
			[ self executeOneRequestResponseOn: stream ] whileFalse ]! !

!ZnMultiThreadedServer methodsFor: 'request handling' stamp: 'SvenVanCaekenberghe 6/13/2014 21:55'!
readRequestSafely: stream timing: timing
	"Read request from stream, returning nil when the connection is closed or times out"

	^ [ 
		[ self readRequest: stream timing: timing ]
			on: self readRequestBadExceptionSet
			do: [ :exception | 
				self logServerReadError: exception.
				self writeResponseBad: exception on: stream timing: timing.
				nil ] ]
			on: self readRequestTerminationExceptionSet
			do: [ :exception | 
				self logServerReadError: exception.
				nil ]! !

!ZnMultiValueDictionary commentStamp: '<historical>'!
I am ZnMultiValueDictionary. 
I am a Dictionary.

I offer an #at:add: method to transparently create Array valued multi entries when needed.
My #keysAndValuesDo: is overwritten to transparently deal with multi entries.
To merge two instance preserving multiple values you can use #addAllMulti:
I normally limit the number of entries to protect me from resource abuse.

Note that most other methods will show the actual value.

Part of Zinc HTTP Components.!
!ZnMultiValueDictionary methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 1/2/2012 19:36'!
unlimited
	self limit: nil! !

!ZnMultiValueDictionary methodsFor: 'accessing' stamp: 'KenTreis 01/19/2013 10:41'!
at: key put: anObject
	self checkLimitForKey: key.
	^ super at: key put: anObject! !

!ZnMultiValueDictionary methodsFor: 'adding' stamp: 'KenTreis 01/19/2013 10:41'!
add: anAssociation
	self checkLimitForKey: anAssociation key.
	^ super add: anAssociation! !

!ZnMultiValueDictionary methodsFor: 'private' stamp: 'KenTreis 01/19/2013 10:42'!
checkLimitForKey: aKey
	"Signal an exception when the limit, if present, is exceeded."
	
	(self limit notNil and: [ self size >= self limit and: [ (self includesKey: aKey) not ]])
		ifTrue: [ (ZnTooManyDictionaryEntries limit: self limit) signal ].
! !

!ZnMultiValueDictionary methodsFor: 'adding' stamp: 'SvenVanCaekenberghe 1/7/2013 10:28'!
addAllMulti: keyedCollection
	"Note that we use #at:add:"

	keyedCollection keysAndValuesDo: [ :key :value | 
		self at: key add: value ]! !

!ZnMultiValueDictionary methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/8/2012 19:49'!
defaultLimit
	"Return the maximum number dictionary entries to accept.
	Used by ZnMultiValueDictionary and thus for reading headers, 
	url query and application form url encoded entity fields.
	This helps to protect us from malicious content."
	
	^ 256! !

!ZnMultiValueDictionary methodsFor: 'enumerating' stamp: 'SvenVanCaekenberghe 1/12/2011 11:10'!
keysAndValuesDo: block
	"Execute a two argument (key, value) block for each header.
	Multi-valued headers are handled transparently."

	super keysAndValuesDo: [ :key :value |
		value isArray
			ifTrue: [ 
				value do: [ :each | 
					block value: key value: each ] ]
			ifFalse: [
				block value: key value: value ] ]! !

!ZnMultiValueDictionary methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/14/2013 12:38'!
limit
	^ limit! !

!ZnMultiValueDictionary methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/12/2011 11:19'!
at: key add: value
	"Store value under key. If key already exists, store multiple values as Array"
	
	| existingValue newValue |
	existingValue := self at: key ifAbsent: [ nil ].
	newValue := existingValue isNil
		ifTrue: [ value ] 
		ifFalse: [
			existingValue isArray 
				ifTrue: [ existingValue copyWith: value ]
				ifFalse: [ Array with: existingValue with: value ] ].
	^ self at: key put: newValue 

! !

!ZnMultiValueDictionary methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 1/2/2012 19:35'!
limit: numberOfEntries
	limit := numberOfEntries ! !

!ZnMultiValueDictionary methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 5/14/2013 12:50'!
initialize: n
	super initialize: n.
	limit := self defaultLimit! !

!ZnMultiValueDictionaryTests methodsFor: 'testing' stamp: 'PaulDeBruicker 04/10/2011 10:48'!
testMultiValues
	| dictionary values keys |
	dictionary := ZnMultiValueDictionary new.
	dictionary at: 'foo' add: 1; at: 'foo' add: 2.
	self assert: (dictionary at: 'foo') = #(1 2).
	self assert: dictionary keys asArray = #('foo').
	values := OrderedCollection new.
	keys := OrderedCollection new.
	dictionary keysAndValuesDo: [ :key :value | keys add: key. values add: value ].
	self assert: values = (OrderedCollection with: 1 with: 2).
	self assert: keys = (OrderedCollection with: 'foo' with: 'foo')
	! !

!ZnMultiValueDictionaryTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/8/2012 19:50'!
testTooManyEntries
	| dictionary |
	dictionary := ZnMultiValueDictionary new.
	self
		should: [ 1 to: dictionary limit + 1 do: [ :each | 
						dictionary at: each put: each ] ]
		raise: ZnTooManyDictionaryEntries! !

!ZnNetworkingUtils commentStamp: '<historical>'!
I am ZnNetworkingUtils holding various utilities related to HTTP networking.

My class side is a general API.

My instance side is a factory.

ZnNetworkingUtils default socketStreamClass: SocketStream.
ZnNetworkingUtils default socketStreamClass: ZdcSocketStream.

Part of Zinc HTTP Components.!
!ZnNetworkingUtils methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 7/19/2012 16:09'!
streamClassForScheme: scheme
	(#(http ws) includes: scheme) ifTrue: [ 
		^ self socketStreamClass ].
	(#(https wss) includes: scheme) ifTrue: [ 
		^ self secureSocketStreamClass ifNil: [
			self error: 'No secure socket stream class set or available' ] ].
	(ZnUnknownScheme scheme: scheme) signal! !

!ZnNetworkingUtils methodsFor: 'proxy' stamp: 'SvenVanCaekenberghe 11/10/2011 13:30'!
socketStreamToProxy
	| proxyUrl |
	"System settings do currently not support HTTPS proxies."
	(proxyUrl := ZnUrl new) 
		scheme: #http; 
		host: self httpProxyServer; 
		port: self httpProxyPort.
	^ self socketStreamToUrlDirectly: proxyUrl! !

!ZnNetworkingUtils methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/18/2012 09:30'!
bufferSize
	^ self class socketBufferSize! !

!ZnNetworkingUtils methodsFor: 'public' stamp: 'SvenVanCaekenberghe 5/2/2011 22:41'!
serverSocketOn: port
	| socket |
	socket := Socket newTCP.
	self setServerSocketOptions: socket.
	socket listenOn: port backlogSize: self class listenBacklogSize.
	socket isValid
		ifFalse: [ self error: 'Cannot create socket on port ', port printString ].
	^ socket! !

!ZnNetworkingUtils methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/2/2011 22:41'!
setServerSocketOptions: socket
	socket
		setOption: 'TCP_NODELAY' value: 1;
		setOption: 'SO_SNDBUF' value: self class socketBufferSize;
		setOption: 'SO_RCVBUF' value: self class socketBufferSize ! !

!ZnNetworkingUtils methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/18/2012 09:30'!
timeout
	^ self class socketStreamTimeout! !

!ZnNetworkingUtils methodsFor: 'proxy' stamp: 'SvenVanCaekenberghe 4/8/2014 16:11'!
shouldProxyUrl: url
	"Even when a proxy is set, some URLs should not be proxied.
	There is no setting for this in the image.
	We exclude localhost and explicit exceptions from being proxied."
	
	self isProxySet ifFalse: [ ^ false ].
	^ url isLocalHost not
		and: [ 
			[ (NetworkSystemSettings isAnExceptionFor: url) not ]
				on: MessageNotUnderstood
				do: [ true ] ]! !

!ZnNetworkingUtils methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 11/10/2011 13:15'!
socketStreamClass: anObject
	socketStreamClass := anObject! !

!ZnNetworkingUtils methodsFor: 'proxy' stamp: 'SvenVanCaekenberghe 6/16/2011 22:54'!
httpProxyPassword
	"Return the password for proxy authorization"
	
	^ NetworkSystemSettings proxyPassword ! !

!ZnNetworkingUtils methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/10/2011 13:47'!
socketStreamClass
	^ socketStreamClass ifNil: [ socketStreamClass := SocketStream ]! !

!ZnNetworkingUtils methodsFor: 'proxy' stamp: 'SvenVanCaekenberghe 6/16/2011 22:51'!
httpProxyPort
	"Return the port of the proxy server to use"
	
	^ NetworkSystemSettings httpProxyPort! !

!ZnNetworkingUtils methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 5/20/2013 15:31'!
initialize
	super initialize.
	self socketStreamClass: (Smalltalk globals at: #ZdcSocketStream ifAbsent: [ SocketStream ]).
	self secureSocketStreamClass: (Smalltalk globals at: #ZdcSecureSocketStream ifAbsent: [ nil ])! !

!ZnNetworkingUtils methodsFor: 'private' stamp: 'SvenVanCaekenberghe 9/18/2012 09:30'!
setSocketStreamParameters: stream
	stream 
		binary;
		shouldSignal: true;
		autoFlush: false;
		bufferSize: self bufferSize;
		timeout: self timeout.
! !

!ZnNetworkingUtils methodsFor: 'public' stamp: 'SvenVanCaekenberghe 11/10/2011 13:16'!
socketStreamOn: socket
	| stream |
	stream := self socketStreamClass on: socket.
	self setSocketStreamParameters: stream.  
	^ stream! !

!ZnNetworkingUtils methodsFor: 'proxy' stamp: 'SvenVanCaekenberghe 6/16/2011 22:55'!
isProxyAuthorizationRequired
	"Does the proxy require authorization ?"
	
	^ self isProxySet and: [ NetworkSystemSettings useNetworkAuthentification ]! !

!ZnNetworkingUtils methodsFor: 'public' stamp: 'SvenVanCaekenberghe 8/11/2011 19:37'!
socketStreamToUrl: url
	url hasHost ifFalse: [ ZnMissingHost signal ].  
	^ (self shouldProxyUrl: url)
		ifTrue: [ self socketStreamToProxy ] 
		ifFalse: [ self socketStreamToUrlDirectly: url ]! !

!ZnNetworkingUtils methodsFor: 'public' stamp: 'SvenVanCaekenberghe 10/17/2014 13:23'!
socketStreamToUrlDirectly: url
	| stream address |
	address := NetNameResolver addressForName: url host timeout: self timeout. 
	stream := (self streamClassForScheme: url scheme) 
		openConnectionToHost: address
		port: url portOrDefault
		timeout: self timeout.  
	self setSocketStreamParameters: stream. 
	"note that for TLS/SSL, #connect should be called"
	^ stream! !

!ZnNetworkingUtils methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/13/2011 21:45'!
secureSocketStreamClass
	^ secureSocketStreamClass ifNil: [ 
		secureSocketStreamClass := Smalltalk globals at: #ZdcSecureSocketStream ifAbsent: [ nil ] ]! !

!ZnNetworkingUtils methodsFor: 'public' stamp: 'SvenVanCaekenberghe 3/12/2012 19:22'!
serverSocketOn: port interface: address
	| socket |
	socket := Socket newTCP.
	self setServerSocketOptions: socket.
	socket 
		listenOn: port 
		backlogSize: self class listenBacklogSize 
		interface: address.
	socket isValid
		ifFalse: [ self error: 'Cannot create socket on port ', port printString ].
	^ socket! !

!ZnNetworkingUtils methodsFor: 'proxy' stamp: 'SvenVanCaekenberghe 6/16/2011 22:55'!
isProxySet
	"Should a proxy be used ?"
	
	^ NetworkSystemSettings useHTTPProxy ! !

!ZnNetworkingUtils methodsFor: 'proxy' stamp: 'MarcoSchmidt 6/17/2011 15:25'!
httpProxyUser
	"Return the user for proxy authorization"
	
	^ NetworkSystemSettings proxyUser! !

!ZnNetworkingUtils methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 11/10/2011 13:43'!
secureSocketStreamClass: anObject
	secureSocketStreamClass := anObject! !

!ZnNetworkingUtils methodsFor: 'proxy' stamp: 'SvenVanCaekenberghe 6/16/2011 22:49'!
proxyAuthorizationHeaderValueToUrl: url
	"Answer the Proxy-Authorization header value for HTTP access to url, or nil if none"
	
	^ (self isProxyAuthorizationRequired and: [ self shouldProxyUrl: url ])
		ifTrue: [ 'Basic ', (ZnUtils encodeBase64: (self httpProxyUser, ':', self httpProxyPassword)) ] 
		ifFalse: [ nil ]  ! !

!ZnNetworkingUtils methodsFor: 'proxy' stamp: 'SvenVanCaekenberghe 6/16/2011 22:54'!
httpProxyServer
	"Return the hostname of the proxy server to use"
	
	^ NetworkSystemSettings httpProxyServer! !

!ZnNetworkingUtils class methodsFor: 'networking' stamp: 'SvenVanCaekenberghe 5/2/2011 22:40'!
serverSocketOn: port
	^ self default 
		serverSocketOn: port  ! !

!ZnNetworkingUtils class methodsFor: 'constants' stamp: 'SvenVanCaekenberghe 6/18/2011 22:44'!
defaultSocketStreamTimeout
	"Global default timeout in seconds for SocketStream IO"
	
	^ DefaultSocketStreamTimeout! !

!ZnNetworkingUtils class methodsFor: 'constants' stamp: 'SvenVanCaekenberghe 6/18/2011 22:45'!
defaultSocketStreamTimeout: seconds
	"Global default timeout in seconds for SocketStream IO"
	
	^ DefaultSocketStreamTimeout := seconds! !

!ZnNetworkingUtils class methodsFor: 'proxy' stamp: 'SvenVanCaekenberghe 6/16/2011 22:41'!
shouldProxyUrl: url
	"Answer if we should proxy HTTP access to url."
	
	^ self default shouldProxyUrl: url  ! !

!ZnNetworkingUtils class methodsFor: 'constants' stamp: 'SvenVanCaekenberghe 3/24/2011 08:05'!
listenBacklogSize
	"Server socket backlog size (number of pending connection waiting to be accepted)"
	
	^ 32! !

!ZnNetworkingUtils class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/2/2011 22:08'!
default: instance
	Default := instance ! !

!ZnNetworkingUtils class methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 1/7/2011 19:42'!
ipAddressToString: byteArray
	^ String streamContents: [ :stream |
			byteArray 
				do: [ :each | stream print: each ] 
				separatedBy: [ stream nextPut: $. ] ]! !

!ZnNetworkingUtils class methodsFor: 'class initialization' stamp: 'SvenVanCaekenberghe 5/18/2013 20:03'!
initialize
	"The default will try to use ZdcSocketStream and ZdcSecureSocketStream"
	 
	Default := self new.
	DefaultSocketStreamTimeout := 30! !

!ZnNetworkingUtils class methodsFor: 'networking' stamp: 'SvenVanCaekenberghe 5/2/2011 22:40'!
socketStreamOn: socket
	^ self default 
		socketStreamOn: socket  ! !

!ZnNetworkingUtils class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/2/2011 22:08'!
default
	^ Default ifNil: [ Default := self new ]! !

!ZnNetworkingUtils class methodsFor: 'networking' stamp: 'SvenVanCaekenberghe 3/12/2012 19:22'!
serverSocketOn: port interface: address
	^ self default 
		serverSocketOn: port interface: address ! !

!ZnNetworkingUtils class methodsFor: 'networking' stamp: 'SvenVanCaekenberghe 5/2/2011 22:40'!
socketStreamToUrl: url
	^ self default
		socketStreamToUrl: url  ! !

!ZnNetworkingUtils class methodsFor: 'constants' stamp: 'SvenVanCaekenberghe 3/2/2014 22:42'!
socketStreamTimeout
	"Access the current timeout in seconds for SocketStream IO"
	
	^ ZnConnectionTimeout value 
		ifNil: [ self defaultSocketStreamTimeout ]! !

!ZnNetworkingUtils class methodsFor: 'proxy' stamp: 'SvenVanCaekenberghe 6/16/2011 22:43'!
proxyAuthorizationHeaderValueToUrl: url
	"Answer the Proxy-Authorization header value for HTTP access to url, or nil if none"
	
	^ self default proxyAuthorizationHeaderValueToUrl: url  ! !

!ZnNetworkingUtils class methodsFor: 'constants' stamp: 'SvenVanCaekenberghe 3/24/2011 08:05'!
socketBufferSize
	"Size in bytes for Sockets and SocketStream IO buffers"

	^ 4096! !

!ZnNullEncoder commentStamp: '<historical>'!
I am ZnNullEncoder, a concrete subclass of ZnCharacterEncoder.
I perform no encoding or decoding at all for all characters with a code value below 256.
I can only be used for ASCII.

Note that in principle I could handle Latin1 (ISO-8859-1), although that is not completely correct. To get maximum efficiency, it remains an option.
	
Part of Zinc HTTP Components.!
!ZnNullEncoder methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/15/2014 09:49'!
identifier
	^ #ascii! !

!ZnNullEncoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 1/4/2011 20:52'!
nextFromStream: stream
	^ Character codePoint: stream next! !

!ZnNullEncoder methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 5/22/2013 10:03'!
next: count putAll: string startingAt: offset toStream: stream
	"Write count bytes from string starting at offset to stream."
	
	| bytes |
	bytes := ByteArray new: count.
	bytes replaceFrom: 1 to: count with: string startingAt: offset.
	stream nextPutAll: bytes! !

!ZnNullEncoder methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 5/23/2013 11:34'!
readInto: string startingAt: offset count: requestedCount fromStream: stream
	"Read requestedCount characters into string starting at offset,
	returning the number read, there could be less available when stream is atEnd"

	| byteBuffer readCount |
	byteBuffer := ByteArray new: requestedCount.
	readCount := stream readInto: byteBuffer startingAt: 1 count: requestedCount.
	string replaceFrom: offset to: offset + readCount - 1 with: byteBuffer startingAt: 1.
	^ readCount! !

!ZnNullEncoder methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 5/3/2012 11:32'!
decodeBytes: bytes
	^ bytes asString! !

!ZnNullEncoder methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 5/3/2012 11:32'!
encodedByteCountForString: string
	^ string size! !

!ZnNullEncoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 1/25/2011 12:36'!
nextPut: character toStream: stream
	| code |
	(code := character charCode) < 256
		ifTrue: [ stream nextPut: code ]
		ifFalse: [ self error: 'Character code outside encoder range' ]! !

!ZnNullEncoder methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 5/3/2012 11:32'!
encodeString: string
	^ string asByteArray! !

!ZnNullEncoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 2/24/2014 15:38'!
backOnStream: stream
	stream back! !

!ZnNullEncoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 11/29/2010 21:17'!
encodedByteCountFor: character
	^ 1! !

!ZnNullEncoder class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/13/2014 22:10'!
handlesEncoding: string
	"Return true when my instances handle the encoding described by string.
	Note that in principle I could handle latin1 (iso-8859-1), although that is not 
	completely correct. To get maximum efficiency, it remains an option."
	
	^ (self canonicalEncodingIdentifier: string) = 'ascii'! !

!ZnNullEncoder class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 1/25/2011 11:19'!
newForEncoding: string
	"No further parametrization needed"
	
	^ self new! !

!ZnParseError commentStamp: 'SvenVanCaekenberghe 2/28/2011 14:13'!
ZnParseError is the superclass of all Zinc HTTP parsing related errors.

Part of Zinc HTTP Components.!
!ZnPercentEncoder commentStamp: 'SvenVanCaekenberghe 2/14/2014 14:06'!
I am ZnPercentEncoder.
I implement RFC 3986 percent encoding and decoding.

All characters that are not part of a safe set are encoded using a percent (%) followed by a two digit hexadecimal number of a byte value. Non-ASCII characters are first encoded, normally using UTF-8.

My #encode: and #decode: messages work from String to String.

My decoder will accept + as an encoding for a space by default.

See also http://en.wikipedia.org/wiki/Percent-encoding

Part of Zinc HTTP Components
!
!ZnPercentEncoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 2/14/2014 14:23'!
decode: string
	"Decode a percent encoded string and return the resulting byte array.
	After percent decoding I will use my character encoder to convert byte values to characters."

	| bytes stringStream |
	stringStream := string readStream.
	bytes := ByteArray streamContents: [ :byteStream | 
		self decode: stringStream to: byteStream ].
	^ self characterEncoder decodeBytes: bytes! !

!ZnPercentEncoder methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 12/15/2012 13:53'!
characterEncoder: object
	"Set the character encoding to use to object."
	
	characterEncoder := object! !

!ZnPercentEncoder methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/23/2013 18:55'!
safeSet
	"Return the safe set of characters that I will not encode, as a byte array.
	If not set, I will default to the most commonly used safe set"
	
	^ safeSet ifNil: [ safeSet := self class rfc3986UnreservedCharacters asByteArray ]! !

!ZnPercentEncoder methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 12/15/2012 13:58'!
safeSet: string
	"Set my safe set to be the characters in string, which I will convert to bytes"
	
	safeSet := string asByteArray ! !

!ZnPercentEncoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 2/14/2014 14:24'!
encode: string
	"Encode string using percent encoding and return the resulting string.
	I will use my character encoder to convert string to bytes and then
	percent encode all byte values that are not in my safe set."

	^ String streamContents: [ :stream | 
		self encode: string readStream to: stream ]! !

!ZnPercentEncoder methodsFor: 'private' stamp: 'SvenVanCaekenberghe 10/23/2013 18:56'!
writeHex: integer to: stream
	integer printOn: stream base: 16 length: 2 padded: true! !

!ZnPercentEncoder methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 2/14/2014 14:10'!
decodePlusAsSpace: boolean
	"When boolean is true, $+ on input will be decoded as Character space.
	Else $+ is treated as a normal character, filtered by the safe set.
	This is normally only done application/x-www-form-urlencoded data,
	but is is on by default anyway."
	
	decodePlusAsSpace := boolean! !

!ZnPercentEncoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 10/23/2013 18:57'!
encode: readStream to: writeStream
	| bytes buffer byte |
	buffer := (bytes := ByteArray new: 4) writeStream.
	self safeSet; characterEncoder.
	[ readStream atEnd ]
		whileFalse: [ 
			buffer reset.
			characterEncoder nextPut: readStream next toStream: buffer.
			1 to: buffer position do: [ :index | 
				(safeSet includes: (byte := bytes at: index))
					ifTrue: [ writeStream nextPut: byte asCharacter ]
					ifFalse: [ 
						writeStream nextPut: $%.
						self writeHex: byte to: writeStream ] ] ]! !

!ZnPercentEncoder methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/15/2012 13:53'!
characterEncoder
	"Return the character encoder that I currently use.
	If not set, I will default to using UTF-8."
	
	^ characterEncoder ifNil: [ characterEncoder := ZnUTF8Encoder new ]! !

!ZnPercentEncoder methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/14/2014 14:08'!
decodePlusAsSpace
	"Return if $+ on input should be decoded as Character space.
	This is normally only done application/x-www-form-urlencoded data,
	but is is on by default anyway."
	
	^ decodePlusAsSpace ifNil: [ decodePlusAsSpace := true ]! !

!ZnPercentEncoder methodsFor: 'error handling' stamp: 'SvenVanCaekenberghe 2/14/2014 14:12'!
errorHexDigitExpected
	ZnCharacterEncodingError signal: 'hex digit expected'! !

!ZnPercentEncoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 2/14/2014 14:20'!
decode: stringStream to: byteStream
	| char |
	self decodePlusAsSpace.
	[ stringStream atEnd ]
		whileFalse: [ 
			((char := stringStream next) == $+ and: [ decodePlusAsSpace ])
				ifTrue: [ byteStream nextPut: 32 ]
				ifFalse: [ 
					char == $%
						ifTrue: [ byteStream nextPut: (self readHexFrom: stringStream) ]
						ifFalse: [ 
							char charCode < 128
								ifTrue: [ byteStream nextPut: char charCode ]
								ifFalse: [ self errorAsciiCharacterExpected ] ] ] ]! !

!ZnPercentEncoder methodsFor: 'private' stamp: 'SvenVanCaekenberghe 2/14/2014 14:12'!
readHexFrom: stream
	| first second |
	(stream atEnd not and: [ (first := stream next digitValue) between: 0 and: 15 ])
		ifFalse: [ self errorHexDigitExpected ].
	(stream atEnd not and: [ (second := stream next digitValue) between: 0 and: 15 ])
		ifFalse: [ self errorHexDigitExpected ].
	^ (first << 4) + second! !

!ZnPercentEncoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 2/14/2014 14:24'!
errorAsciiCharacterExpected
	ZnCharacterEncodingError signal: 'ASCII character expected'! !

!ZnPercentEncoder class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/23/2013 18:55'!
rfc3986UnreservedCharacters
	"Return the unreserved characters according to RFC 3986 section 2.3.
	This is the most narrow safe set to be used in a better safe than sorry approach."

	^ 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_.~'! !

!ZnPercentEncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/14/2014 14:23'!
testDecodePlusAsSpace
	| encoder |
	encoder := ZnPercentEncoder new.
	self assert: (encoder decode: '+') equals: ' '.
	self assert: encoder decodePlusAsSpace.
	encoder decodePlusAsSpace: false.
	self assert: (encoder decode: '+') equals: '+'.
	self deny: encoder decodePlusAsSpace! !

!ZnPercentEncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/16/2012 15:12'!
testDecodingErrors
	| encoder |
	encoder := ZnPercentEncoder new.
	self should: [ encoder decode: 'foo%%bar' ] raise: ZnCharacterEncodingError.
	self should: [ encoder decode: 'fooçbar' ] raise: ZnCharacterEncodingError.
	self should: [ encoder decode: 'foo%' ] raise: ZnCharacterEncodingError.
	self should: [ encoder decode: '%XX' ] raise: ZnCharacterEncodingError.
	self should: [ encoder decode: 'foo%F' ] raise: ZnCharacterEncodingError! !

!ZnPercentEncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/1/2013 21:29'!
testLeadingZero
	| encoder |
	encoder := ZnPercentEncoder new.
	self assert: (encoder encode: 'foo', Character tab asString, 'bar') equals: 'foo%09bar'.
	self assert: (encoder decode: 'foo%09bar') equals: 'foo', Character tab asString, 'bar'.
	self assert: (encoder encode: 'foo', Character lf asString, 'bar') equals: 'foo%0Abar'.
	self assert: (encoder decode: 'foo%0Abar') equals: 'foo', Character lf asString, 'bar'! !

!ZnPercentEncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/13/2012 11:26'!
testNonAscii
	| encoder |
	encoder := ZnPercentEncoder new.
	self 
		assert: encoder characterEncoder 
		equals: (ZnCharacterEncoder newForEncoding: 'utf-8').
	self 
		assert: (encoder encode: 'élève en Français') 
		equals: '%C3%A9l%C3%A8ve%20en%20Fran%C3%A7ais'.
	self 
		assert: (encoder decode: '%C3%A9l%C3%A8ve%20en%20Fran%C3%A7ais') 
		equals: 'élève en Français'! !

!ZnPercentEncoderTests methodsFor: 'testing' stamp: 'CamilloBruni 3/26/2013 23:18'!
testStringUrlDecoded
	self assert: ('foo%20bar' urlDecoded) equals: 'foo bar' ! !

!ZnPercentEncoderTests methodsFor: 'testing' stamp: 'CamilloBruni 3/26/2013 23:18'!
testStringUrlEncoded
	self assert: ('foo bar' urlEncoded) equals: 'foo%20bar'! !

!ZnPercentEncoderTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/13/2012 11:58'!
testSimple
	| encoder |
	encoder := ZnPercentEncoder new.
	self assert: (encoder encode: 'foo bar') equals: 'foo%20bar'.
	self assert: (encoder decode: 'foo%20bar') equals: 'foo bar'.
	self assert: (encoder encode: '') equals: ''.
	self assert: (encoder decode: '') equals: ''.
	self assert: (encoder decode: 'foo%25bar') equals: 'foo%bar'.
	self assert: (encoder decode: 'foo+bar') equals: 'foo bar'! !

!ZnPortNotANumber commentStamp: 'SvenVanCaekenberghe 2/28/2011 15:23'!
ZnPortNotANumber is signalled when an URL is parsed containing an illegal port specification.

Part of Zinc HTTP Components.!
!ZnPortNotANumber methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/28/2011 15:22'!
port: anObject
	port := anObject! !

!ZnPortNotANumber methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/28/2011 15:22'!
port
	^ port! !

!ZnPortNotANumber class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 2/28/2011 15:22'!
port: port
	^ self new
		port: port;
		yourself! !

!ZnReadEvalPrintDelegate commentStamp: '<historical>'!
I am ZnReadEvalPrintDelegate, I export a REPL Web Service.
You can use this service to work with a headless image.

	ZnReadEvalPrintDelegate startInServerOn: 1701.
	
	ZnClient new
		url: 'http://localhost:1701/repl';
		contents: '42 factorial';
		post.
	
Web Service API:

	POST /repl <some Smalltalk code>
	 
Here is an example terminal session:

$ curl http://localhost:1701/repl
# Pharo Smalltalk REPL. POST expressions to evaluate
# Here is one way (type ctrl-d to end input)
curl -X POST -H'Content-Type:text/plain' --data-binary @- http://localhost:1701/repl

$ curl -X POST -H'Content-Type:text/plain' -d '42 factorial' http://localhost:1701/repl
1405006117752879898543142606244511569936384000000000

$ curl -X POST -H'Content-Type:text/plain' --data-binary @- http://localhost:1701/repl
{ (1 to: 10) sum. (1 to: 10) average }
{55. (11/2)}

There is error handling as well:

$ curl -X POST -H'Content-Type:text/plain' --data-binary @- http://localhost:1701/repl
1 plus: 2
MessageNotUnderstood: SmallInteger>>plus:
SmallInteger(Object)>>doesNotUnderstand: #plus:
	Receiver: 1
	Arguments and temporary variables: 
		aMessage: 	plus: 2
		exception: 	MessageNotUnderstood: SmallInteger>>plus:
		resumeValue: 	nil
	Receiver's instance variables: 
1
UndefinedObject>>DoIt
Compiler>>evaluate:in:to:notifying:ifFail:logged:
Compiler>>evaluate:in:to:notifying:ifFail:
Compiler>>evaluate:in:to:
ZnReadEvalPrintDelegate>>evaluate: in Block: [| result |...
BlockClosure>>on:do:
ZnReadEvalPrintDelegate>>evaluate: in Block: [:out | [| result |...
String class(SequenceableCollection class)>>new:streamContents:

WARNING: never open this service beyond your local network !!
This service gives you absolute control over and access to everything in your image. 
For example, the following will kill your image:

$ curl -X POST -H'Content-Type:text/plain' -d 'Smalltalk quitPrimitive' http://localhost:1701/repl

Part of Zinc HTTP Components. !
!ZnReadEvalPrintDelegate methodsFor: 'request handling' stamp: 'SvenVanCaekenberghe 5/16/2013 09:51'!
handleGetRequest: request
	^ ZnResponse ok: (ZnEntity text: (self helpText format: { request server port })) ! !

!ZnReadEvalPrintDelegate methodsFor: 'public' stamp: 'SvenVanCaekenberghe 5/15/2013 13:44'!
value: request
	"I implement the generic #value: message as equivalent to #handleRequest:"
	
	^ self handleRequest: request! !

!ZnReadEvalPrintDelegate methodsFor: 'request handling' stamp: 'SvenVanCaekenberghe 5/16/2013 09:54'!
handlePostRequest: request
	^ ZnResponse ok: (ZnEntity text: (self evaluate: request entity contents))! !

!ZnReadEvalPrintDelegate methodsFor: 'public' stamp: 'SvenVanCaekenberghe 5/16/2013 09:52'!
handleRequest: request
	request uri firstPathSegment = #repl
		ifTrue: [ 
			request method = #GET
				ifTrue: [ 
					^ self handleGetRequest: request ].
			(request method = #POST and: [ request hasEntity and: [ request contentType isBinary not ] ])
				ifTrue: [ 
					^ self handlePostRequest: request ] ].
	^ ZnResponse notFound: request uri! !

!ZnReadEvalPrintDelegate methodsFor: 'private' stamp: 'SvenVanCaekenberghe 8/12/2014 20:04'!
evaluate: string
	| output |
	output := String streamContents: [ :out | 
		[ 	| compiler result |
			compiler := [ self class compiler ] 
								on: MessageNotUnderstood 
								do: [ Smalltalk at: #Compiler "for Pharo 2.0" ].		
			result := compiler evaluate: string. 
			out print: result; cr ]
			on: Error, ParserNotification
			do: [ :exception |
				out print: exception; cr.
				exception signalerContext printDetails: out.
				exception signalerContext sender debugStack: 8 on: out ].
		out cr ].
	^ String lf join: output lines! !

!ZnReadEvalPrintDelegate methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/15/2013 21:53'!
helpText
	^ '# Pharo Smalltalk REPL. POST expressions to evaluate\# Here is one way (type ctrl-d to end input)\curl -X POST -H''Content-Type:text/plain'' --data-binary @- http://localhost:{1}/repl\' 
			withCRs 
				replaceAll: Character cr with: Character lf; 
				yourself! !

!ZnReadEvalPrintDelegate class methodsFor: 'public' stamp: 'SvenVanCaekenberghe 5/15/2013 22:05'!
startInServerOn: port
	"Start a new server bound to port on the local network running a REPL web service"

	"self startInServerOn: 1701"
	
	 ^ (ZnServer on: port)
			bindingAddress: NetNameResolver loopBackAddress;
			delegate: self new;
			start;
			yourself! !

!ZnRequest commentStamp: 'SvenVanCaekenberghe 1/18/2011 10:58'!
I am ZnRequest, representing an HTTP Request, 
consisting of a request line, headers and an optional entity (body).
I am a ZnMessage.
I can be used for generating and parsing.

Part of Zinc HTTP Components.!
!ZnRequest methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/27/2010 19:28'!
setAcceptEncodingGzip
	self headers at: 'Accept-Encoding' put: 'gzip'! !

!ZnRequest methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 7/27/2011 14:45'!
method: method
	self requestLine method: method! !

!ZnRequest methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/6/2010 21:06'!
requestLine: object
	requestLine := object! !

!ZnRequest methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/28/2011 10:56'!
setIfModifiedSince: reference
	self headers at: 'If-Modified-Since' put: (ZnUtils httpDate: reference)! !

!ZnRequest methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/7/2013 09:06'!
absoluteUrl
	^ self host 
		ifNil: [ self url ]
		ifNotNil: [ :hostUrl | self url inContextOf: hostUrl ]! !

!ZnRequest methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 9/21/2010 11:33'!
readHeaderFrom: stream
	self requestLine: (ZnRequestLine readFrom: stream).
	super readHeaderFrom: stream
	! !

!ZnRequest methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/8/2010 10:36'!
uri
	^ self requestLine uri ! !

!ZnRequest methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 12/14/2010 11:00'!
printOn: stream
	super printOn: stream.
	stream nextPut: $(.
	self requestLine printMethodAndUriOn: stream.
	stream nextPut: $)! !

!ZnRequest methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/7/2010 20:00'!
setAccept: object
	self headers at: 'Accept' put: object asString! !

!ZnRequest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/14/2010 14:33'!
isHttp11
	^ self requestLine isHttp11! !

!ZnRequest methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/7/2013 11:44'!
host
	| host scheme |
	host := self headers at: 'Host' ifAbsent: [ ^ nil ].
	scheme :=ZnCurrentServer value ifNil: [ #http ] ifNotNil: [ :server | server scheme ].
	^ ZnUrl fromString: host defaultScheme: scheme! !

!ZnRequest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/20/2012 16:09'!
wantsConnectionClose
	"Return if the HTTP protocol should close the connection after processing the receiver.
	Overwritten to return true in case of the presense of an explicit connection close request header
	or the absense of a keep alive header when using the old HTTP 1.0 protocol."

	^ self isConnectionClose 
		or: [ self isHttp10 and: [ self isConnectionKeepAlive not ] ]! !

!ZnRequest methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 5/22/2013 10:37'!
hash
	^ super hash bitXor: self requestLine hash! !

!ZnRequest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/14/2010 14:33'!
isHttp10
	^ self requestLine isHttp10 ! !

!ZnRequest methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/6/2010 21:06'!
requestLine
	^ requestLine ! !

!ZnRequest methodsFor: 'writing' stamp: 'SvenVanCaekenberghe 12/14/2010 11:36'!
writeOn: stream
	| bivalentWriteStream |
	bivalentWriteStream := ZnBivalentWriteStream on: stream.
	self requestLine writeOn: bivalentWriteStream.
	super writeOn: bivalentWriteStream! !

!ZnRequest methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/23/2012 22:12'!
basicAuthentication
	| authorization username password |
	authorization := self authorization findTokens: ' '.
	(authorization size = 2 and: [ authorization first = 'Basic' ]) ifFalse: [ 
		^ NotFound signal: 'Incomplete Basic Authentication' ].
	authorization := (ZnUtils decodeBase64: authorization second) findTokens: ':'.
	authorization size = 2 ifFalse: [
		^ NotFound signal: 'Incomplete Basic Authentication' ].
	^ authorization! !

!ZnRequest methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/8/2010 10:35'!
method
	^ self requestLine method ! !

!ZnRequest methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/21/2010 21:48'!
url
	^ self uri ! !

!ZnRequest methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/23/2012 22:04'!
setAuthorization: authorization
	self headers at: 'Authorization'  put: authorization! !

!ZnRequest methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/10/2012 19:04'!
session
	"Return the current server session.
	If necessary a new session is created.
	This only returns a value during #handleRequest:"

	^ super session
		ifNil: [ 
			| session |
			session := self server sessionFor: self.
			ZnCurrentServerSession value: session.
			session ]! !

!ZnRequest methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/17/2011 16:28'!
accept
	^ self headers at: 'Accept'! !

!ZnRequest methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 7/27/2011 14:44'!
url: url
	self requestLine uri: url.
	self headers request: self url! !

!ZnRequest methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/7/2013 10:52'!
mergedFields
	"Return a new ZnMultiValueDictionary containing all query fields, if any,
	merged with all ZnApplicationFormUrlEncodedEntity fields, if any,
	preserving multi values for identical keys"

	| fields |
	fields := ZnMultiValueDictionary new.
	self uri hasQuery
		ifTrue: [ fields addAllMulti: self uri query ].
	(self contentType = ZnMimeType applicationFormUrlEncoded and: [ self hasEntity ])
		ifTrue: [ fields addAllMulti: self entity fields ].
	^ fields! !

!ZnRequest methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/30/2011 22:41'!
cookies
	| value cookies |
	value := self headers at: 'Cookie' ifAbsent: [ ^ #() ].
	cookies := value isString
		ifTrue: [ value findTokens: #($;) ]
		ifFalse: [ value ].
	^ cookies collect: [ :each | ZnCookie fromString: each ]! !

!ZnRequest methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 5/22/2013 10:39'!
= other
	^ super = other and: [ self requestLine = other requestLine ]! !

!ZnRequest methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/7/2013 09:07'!
relativeUrl
	^ self url asRelativeUrl ! !

!ZnRequest methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/29/2012 19:49'!
setCookie: cookie
	self headers at: 'Cookie' put: cookie
! !

!ZnRequest methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/23/2012 22:05'!
authorization
	^ self headers at: 'Authorization'! !

!ZnRequest methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/19/2013 20:35'!
acceptsEncodingGzip
	| value |
	value := self headers at: 'Accept-Encoding' ifAbsent: [ ^ false ].
	^ value includesSubstring: 'gzip'! !

!ZnRequest methodsFor: 'copying' stamp: 'SvenVanCaekenberghe 6/12/2014 15:56'!
postCopy
	super postCopy.
	requestLine := requestLine copy! !

!ZnRequest methodsFor: '*GT-InspectorExtensions-Core' stamp: 'SvenVanCaekenberghe 10/6/2014 15:18'!
gtInspectorRequestIn: composite
	<gtInspectorPresentationOrder: 25>
	(self requestLine gtInspectorTextIn: composite)
		title: 'Request'! !

!ZnRequest methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/23/2012 22:05'!
setBasicAuthenticationUsername: username password: password
	(username isNil | password isNil)
		ifTrue: [
			self headers removeKey: 'Authorization' ifAbsent: []]
		ifFalse: [
			self setAuthorization: 'Basic ', (ZnUtils encodeBase64: (username, ':', password)) ]
! !

!ZnRequest class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 09:06'!
gtExampleGetPharo
	<gtExample: 'Request message: GET http://pharo.org'>
	^ self method: #GET url: 'http://pharo.org'! !

!ZnRequest class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 09:07'!
gtExampleGetRoot
	<gtExample: 'Request message: GET /'>
	^ self method: #GET url: '/'! !

!ZnRequest class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 7/27/2011 14:57'!
empty
	^ self new
		requestLine: ZnRequestLine empty;
		headers: ZnHeaders defaultRequestHeaders;
		yourself! !

!ZnRequest class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 1/4/2011 14:01'!
method: method url: urlObject
	| url |
	url := urlObject asZnUrl.
	^ self new
		requestLine: (ZnRequestLine method: method uri: url);
		headers: (ZnHeaders requestHeadersFor: url);
		yourself! !

!ZnRequest class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/21/2010 11:08'!
post: urlObject
	^ self method: #POST url: urlObject! !

!ZnRequest class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/21/2010 11:08'!
put: urlObject
	^ self method: #PUT url: urlObject! !

!ZnRequest class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/21/2010 11:07'!
head: urlObject
	^ self method: #HEAD url: urlObject! !

!ZnRequest class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/21/2010 11:00'!
get: urlObject
	^ self method: #GET url: urlObject! !

!ZnRequest class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/21/2010 11:07'!
delete: urlObject
	^ self method: #DELETE url: urlObject! !

!ZnRequest class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 09:07'!
gtExampleGetLocalhost8080
	<gtExample: 'Request message: GET http://localhost:8080'>
	^ self method: #GET url: 'http://localhost:8080'! !

!ZnRequest class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 09:07'!
gtExampleGetEmpty
	<gtExample: 'Request message: GET <>'>
	^ self method: #GET url: ''! !

!ZnRequestLine commentStamp: '<historical>'!
I am an HTTP Request Line.
I consist of an HTTP method, an URI and an HTTP protocol version.
I can be used for generating and parsing.

Part of Zinc HTTP Components.!
!ZnRequestLine methodsFor: 'accessing' stamp: 'DamienPollet 8/4/2011 14:04'!
method: string
	method := ZnConstants knownHTTPMethods 
		detect: [ :each | each = string ] 
		ifNone: [ (ZnUnknownHttpMethod method: string) signal ] ! !

!ZnRequestLine methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 5/22/2013 10:33'!
hash
	^ (self method hash bitXor: self uri hash) bitXor: self version hash! !

!ZnRequestLine methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/14/2010 14:30'!
isHttp10
	^ self version = 'HTTP/1.0'! !

!ZnRequestLine methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 9/27/2010 19:25'!
readFrom: stream
	| line lineStream |
	line := (ZnLineReader on: stream) nextLine.
	lineStream := line readStream.
	self method: (lineStream upTo: Character space).
	self uri: (lineStream upTo: Character space).
	self version: (lineStream upToEnd)! !

!ZnRequestLine methodsFor: 'writing' stamp: 'SvenVanCaekenberghe 6/16/2011 22:40'!
writeOn: stream
	| writeStream |
	writeStream := ZnBivalentWriteStream on: stream.
	writeStream nextPutAll: self method; space.
	(ZnNetworkingUtils shouldProxyUrl: self uri)
		ifTrue: [ self uri printOn: writeStream ]  
		ifFalse: [ self uri printPathQueryFragmentOn: writeStream ].
	writeStream space; nextPutAll: self version; nextPutAll: String crlf ! !

!ZnRequestLine methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/6/2010 13:45'!
uri
	^ uri! !

!ZnRequestLine methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/6/2010 13:45'!
method
	^ method! !

!ZnRequestLine methodsFor: '*GT-InspectorExtensions-Core' stamp: 'SvenVanCaekenberghe 10/6/2014 15:19'!
gtInspectorTextIn: composite
	<gtInspectorPresentationOrder: 30>
	^ composite rubricText
		title: 'HTTP';
		format: [ String streamContents: [ :out | self writeOn: out ] ]! !

!ZnRequestLine methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/6/2010 13:45'!
version
	^ version! !

!ZnRequestLine methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:34'!
printMethodAndUriOn: stream
	(self method notNil and: [ self uri notNil ])
		ifFalse: [ ^ self ].
	stream
		nextPutAll: self method;
		space.
	self uri printPathQueryFragmentOn: stream! !

!ZnRequestLine methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 5/22/2013 11:19'!
= other
	self class = other class ifFalse: [ ^ false ].
	^ self method = other method
		and: [ self uri asRelativeUrl = other uri asRelativeUrl
			and: [ self version = other version ] ]! !

!ZnRequestLine methodsFor: 'copying' stamp: 'SvenVanCaekenberghe 6/12/2014 15:59'!
postCopy
	uri := uri copy! !

!ZnRequestLine methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:34'!
printOn: stream
	super printOn: stream.
	(self method notNil and: [ self uri notNil ])
		ifFalse: [ ^ self ].
	stream nextPut: $(.
	self printMethodAndUriOn: stream.
	stream nextPut: $)! !

!ZnRequestLine methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/30/2013 17:19'!
uri: anURI
	uri := anURI asZnUrl.
	uri enforceKnownScheme! !

!ZnRequestLine methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/4/2011 13:56'!
uriPathQueryFragment
	^ String streamContents: [ :stream | 
			self uri printPathQueryFragmentOn: stream ]! !

!ZnRequestLine methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/14/2010 14:31'!
isHttp11
	^ self version = 'HTTP/1.1'! !

!ZnRequestLine methodsFor: 'accessing' stamp: 'DamienPollet 8/4/2011 14:04'!
version: string
	version := ZnConstants knownHTTPVersions 
		detect: [ :each | each = string ] 
		ifNone: [ (ZnUnknownHttpVersion version: string) signal ] ! !

!ZnRequestLine class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 09:07'!
gtExampleGetEmpty
	<gtExample: 'Request line: GET <>'>
	^ self method: #GET uri: ''! !

!ZnRequestLine class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 7/27/2011 14:58'!
empty
	^ self new
		version: ZnConstants defaultHTTPVersion;
		yourself ! !

!ZnRequestLine class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/6/2010 13:50'!
readFrom: stream
	^ self new
		readFrom: stream;
		yourself! !

!ZnRequestLine class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/6/2010 15:18'!
method: method uri: uri
	^ self new
		method: method;
		uri: uri;
		version: ZnConstants defaultHTTPVersion;
		yourself ! !

!ZnRequestLine class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 09:07'!
gtExampleGetPharo
	<gtExample: 'Request line: GET http://pharo.org'>
	^ self method: #GET uri: 'http://pharo.org'! !

!ZnRequestLine class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 09:07'!
gtExampleGetLocalhost8080
	<gtExample: 'Request line: GET http://localhost:8080'>
	^ self method: #GET uri: 'http://localhost:8080'! !

!ZnRequestLine class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 09:07'!
gtExampleGetRoot
	<gtExample: 'Request line: GET /'>
	^ self method: #GET uri: '/'! !

!ZnRequestLineTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/15/2010 14:11'!
testWriting
	| requestLine string |
	requestLine := ZnRequestLine method: 'GET' uri: '/foo/bar/xyz.txt'.
	string := String streamContents: [ :stream | requestLine writeOn: stream ].
	self assert: string = ('GET /foo/bar/xyz.txt HTTP/1.1', String crlf)! !

!ZnRequestLineTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/15/2010 14:08'!
testReading
	| requestLine string |
	string := 'GET /foo/bar/xyz.txt HTTP/1.1', String crlf.
	requestLine := ZnRequestLine readFrom: string readStream.
	self assert: requestLine method = #GET.
	self assert: requestLine uriPathQueryFragment = '/foo/bar/xyz.txt'.
	self assert: requestLine version = ZnConstants defaultHTTPVersion ! !

!ZnRequestLineTests methodsFor: 'testing' stamp: 'DamienPollet 8/4/2011 14:05'!
testReadingWrongVersion
	| string |
	string := 'GET /foo/bar/xyz.txt HTTP/1.5', String crlf.
	self should: [ ZnRequestLine readFrom: string readStream ] raise: ZnUnknownHttpVersion! !

!ZnRequestLineTests methodsFor: 'testing' stamp: 'DamienPollet 8/4/2011 14:04'!
testReadingWrongMethod
	| string |
	string := 'GETT /foo/bar/xyz.txt HTTP/1.1', String crlf.
	self should: [ ZnRequestLine readFrom: string readStream ] raise: ZnUnknownHttpMethod! !

!ZnRequestReadEvent commentStamp: 'SvenVanCaekenberghe 6/16/2014 15:07'!
ZnRequestReadEvent is signalled when an HTTP server reads a request in duration milliseconds.

Note that the duration can be misleading: when servicing multiple requests over a kept alive connection (the default for HTTP 1.1), the read time includes any wait time (as long as it is below the timeout). The first request read should not contain wait time.!
!ZnRequestReadEvent methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 6/30/2014 17:06'!
printContentsOn: stream
	super printContentsOn: stream.
	stream << ' Request Read '; print: request; space; print: duration; << 'ms'! !

!ZnRequestReadEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 14:55'!
duration
	^ duration! !

!ZnRequestReadEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 14:55'!
request: anObject
	request := anObject! !

!ZnRequestReadEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 14:55'!
duration: anObject
	duration := anObject! !

!ZnRequestReadEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 14:55'!
request
	^ request! !

!ZnRequestResponseHandledEvent commentStamp: 'SvenVanCaekenberghe 6/16/2014 15:09'!
ZnRequestResponseHandledEvent signals that the handler (delegate) processed a request and produced a response in duration in milliseconds. This duration is thus the time taken by the application itself.!
!ZnRequestResponseHandledEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 14:55'!
request: anObject
	request := anObject! !

!ZnRequestResponseHandledEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 14:55'!
duration: anObject
	duration := anObject! !

!ZnRequestResponseHandledEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 14:55'!
response
	^ response! !

!ZnRequestResponseHandledEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 14:55'!
response: anObject
	response := anObject! !

!ZnRequestResponseHandledEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 14:55'!
duration
	^ duration! !

!ZnRequestResponseHandledEvent methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 6/30/2014 17:06'!
printContentsOn: stream
	super printContentsOn: stream.
	stream << ' Request Handled '; print: request; space; print: duration; << 'ms'! !

!ZnRequestResponseHandledEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 14:55'!
request
	^ request! !

!ZnRequestTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/4/2010 13:34'!
testReading
	| input request |
	input := 'GET /foo.html HTTP/1.1', String crlf, 
		'Host: foo.com', String crlf, 
		'Agent: SUnit', String crlf, 
		String crlf.
	request := ZnRequest readFrom: input readStream.
	self assert: request method = #GET.
	self assert: request hasHeaders.
	self assert: (request headers at: 'Host') = 'foo.com'.
	self assert: request hasEntity not
! !

!ZnRequestTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/7/2013 09:09'!
testUrl
	| url request input |
	url := 'http://zn.stfx.eu/zn/small.thml' asZnUrl.
	request := ZnRequest get: url.
	"The original URL is kept inside the request line object inside the request object"
	self assert: request url equals: url.
	self assert: request relativeUrl equals: url asRelativeUrl.
	self assert: request absoluteUrl equals: url.
	url := 'http://foo.com/foo.html' asZnUrl.
	input := 'GET /foo.html HTTP/1.1' , String crlf , 
		'Host: foo.com' , String crlf , 
		String crlf.
	request := ZnRequest readFrom: input readStream.
	self assert: request url equals: url asRelativeUrl.
	self assert: request relativeUrl equals: url asRelativeUrl.
	self assert: request absoluteUrl equals: url! !

!ZnRequestTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/4/2012 21:40'!
testCookiesParsing
	| input request cookies testCookie1 testCookie2 |
	input := 'GET /foo.html HTTP/1.1', String crlf, 
		'Cookie: testCookie1=123; testCookie2=321', String crlf,
		'Host: foo.com', String crlf, 
		'Agent: SUnit', String crlf, 
		String crlf.
	request := ZnRequest readFrom: input readStream.
	
	cookies := request cookies.
	testCookie1 := cookies detect: [ :each | each name = 'testCookie1' ].
	testCookie2 := cookies detect: [ :each | each name = 'testCookie2' ].
	
	self assert: testCookie1 notNil.
	self assert: testCookie1 value = '123'.	
	
	self assert: testCookie2 notNil.
	self assert: testCookie2 value = '321'.	

! !

!ZnRequestTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/21/2013 22:17'!
testReadingWithEntity
	| input request |
	input := 'GET /foo.html HTTP/1.1', String crlf, 
		'Host: foo.com', String crlf, 
		'Content-Length: 8', String crlf, 
		'Content-Type: text/plain', String crlf, 
		String crlf, 
		'12345678'.
	request := ZnRequest readFrom: input asByteArray readStream.
	self assert: request method equals: #GET.
	self assert: request hasHeaders.
	self assert: (request contentType matches: ZnMimeType textPlain).
	self assert: request contentLength equals: 8.
	self assert: request hasHeaders.
	self assert: request entity contents equals: '12345678'
! !

!ZnRequestTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/12/2010 20:25'!
testBasicAuthenticate
	| request |
	request := ZnRequest new.
	request setBasicAuthenticationUsername: 'user' password: 'secret'.
	self assert: (request headers at: 'Authorization') = 'Basic dXNlcjpzZWNyZXQ='! !

!ZnRequestTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/7/2013 11:05'!
testMergedFields
	| request form mergedFields |
	request := ZnRequest post: 'http://host.com/foo?x=1&y=2&x=3'.
	form := ZnApplicationFormUrlEncodedEntity new.
	form
		at: #z put: '100';
		at: #z add: '200';
		at: #y put: '0'.
	request entity: form.
	mergedFields := request mergedFields.
	self assert: mergedFields keys sorted equals: #(x y z).
	self assert: (mergedFields at: #x) sorted equals: #('1' '3').
	self assert: (mergedFields at: #y) sorted equals: #('0' '2').
	self assert: (mergedFields at: #z) sorted equals: #('100' '200')! !

!ZnRequestTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/4/2012 23:18'!
testCookiesWriting
	|  client testCookie1 testCookie2 cookieString cookies|
	client := ZnClient new.
	client url: 'http://www.example.com'.
	(testCookie1 := ZnCookie name: 'testCookie1' value: '123')
		domain: 'example.com'.
	(testCookie2 := ZnCookie name: 'testCookie2' value: '321')
		domain: 'example.com'.
	(client session cookieJar)
		add: testCookie1;
		add: testCookie2.
	client sendCookies.
	cookies := client request cookies do: [ :each | each defaultDomain: 'example.com' ].
	self assert: (cookies includes: testCookie1).
	self assert: (cookies includes: testCookie2)
	
		
! !

!ZnRequestWrittenEvent commentStamp: 'SvenVanCaekenberghe 6/16/2014 14:05'!
ZnRequestWrittenEvent signals that a request was written in duration milliseconds.!
!ZnRequestWrittenEvent methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 6/30/2014 17:06'!
printContentsOn: stream
	super printContentsOn: stream.
	stream << ' Request Written '; print: request; space; print: duration; << 'ms'! !

!ZnRequestWrittenEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 16:23'!
duration
	^ duration! !

!ZnRequestWrittenEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 16:23'!
request: anObject
	request := anObject! !

!ZnRequestWrittenEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 16:23'!
duration: anObject
	duration := anObject! !

!ZnRequestWrittenEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 16:23'!
request
	^ request! !

!ZnResourceMetaUtils commentStamp: '<historical>'!
I am ZnResourceMetaUtils.

I contain some class side utility methods.

Part of Zinc HTTP Components.!
!ZnResourceMetaUtils class methodsFor: 'conversions' stamp: 'SvenVanCaekenberghe 2/14/2014 15:07'!
parseQueryFrom: stream
	| string index fields |
	fields := ZnMultiValueDictionary new.
	[ stream atEnd ] whileFalse: [
		string := stream upTo: $&.
		index := string indexOf: $=.
		index > 0
			ifFalse: [ fields at: (self decodePercentForQuery: string) put: nil ]
			ifTrue: [
				fields
					at: (self decodePercentForQuery: (string copyFrom: 1 to: index - 1))
					add: (self decodePercentForQuery: (string copyFrom: index + 1 to: string size)) ] ].
	^ fields! !

!ZnResourceMetaUtils class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/24/2013 09:39'!
rfc3986SafeSet
	^ ZnPercentEncoder rfc3986UnreservedCharacters ! !

!ZnResourceMetaUtils class methodsFor: 'conversions' stamp: 'SvenVanCaekenberghe 2/14/2014 15:07'!
decodePercentForQuery: string
	^ ZnPercentEncoder new 
		decodePlusAsSpace: true; 
		decode: string! !

!ZnResourceMetaUtils class methodsFor: 'conversions' stamp: 'KrisGybels 6/11/2014 13:47'!
writeQueryFields: dictionary on: stream
	self writeQueryFields: dictionary withEncoder: ZnUTF8Encoder new on: stream ! !

!ZnResourceMetaUtils class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/24/2013 10:22'!
querySafeSet
	^ 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_.~!!$&''()*+,;=:@/?'! !

!ZnResourceMetaUtils class methodsFor: 'conversions' stamp: 'SvenVanCaekenberghe 2/14/2014 15:07'!
decodePercent: string
	^ ZnPercentEncoder new 
		decodePlusAsSpace: false; 
		decode: string! !

!ZnResourceMetaUtils class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/24/2013 10:22'!
urlPathSafeSet
	^ 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_.~!!$&''()*+,;=:@'! !

!ZnResourceMetaUtils class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/15/2014 10:21'!
queryKeyValueSafeSet
	"When a query is interpreted as a list of key=value&.. pairs,
	it is better to encode = and & and leave them out of the safe set.
	Furthermore, since + is interpreted as space in the query part,
	it is unsafe as well"
	
	^ 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_.~!!$''()*,;:@/?'! !

!ZnResourceMetaUtils class methodsFor: 'conversions' stamp: 'KrisGybels 6/11/2014 11:37'!
encodePercent: string safeSet: safeSet encoder: encoder
	^ ZnPercentEncoder new
		characterEncoder: encoder;
		safeSet: (self perform: safeSet);
		encode: string! !

!ZnResourceMetaUtils class methodsFor: 'conversions' stamp: 'KrisGybels 6/11/2014 13:40'!
writeQueryFields: dictionary withEncoder: encoder on: stream
	| first |
	first := true.
	dictionary keysAndValuesDo: [ :key :value | 
		first ifFalse: [ stream nextPut: $& ].
		first := false.
		stream nextPutAll: (self encodePercent: key safeSet: #queryKeyValueSafeSet encoder: encoder).
		value ifNotNil: [ 
			stream
				nextPut: $=;
				nextPutAll: (self encodePercent: value safeSet: #queryKeyValueSafeSet encoder: encoder) ] ]! !

!ZnResourceMetaUtilsTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/17/2012 13:12'!
testDecodePercent
	self assert: (ZnResourceMetaUtils decodePercent: 'foo%20bar') equals: 'foo bar'.
	self should: [ ZnResourceMetaUtils decodePercent: 'foo%%bar' ] raise: ZnCharacterEncodingError ! !

!ZnResourceMetaUtilsTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/8/2012 21:00'!
testQueryWriting
	| fields string |
	(fields := Dictionary new)
		at: 'foo' put: '100';
		at: 'bar' put: 'a b'.
	string := String streamContents: [ :stream | 
		ZnResourceMetaUtils writeQueryFields: fields on: stream ].
	self assert: (string includesSubstring: 'foo=1').
	self assert: (string includesSubstring: 'bar=a%20b').! !

!ZnResourceMetaUtilsTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/17/2012 13:11'!
testQueryParsing
	| string fields |
	string := 'foo=100&x=', (ZnPercentEncoder new encode: '/a b').
	fields := ZnResourceMetaUtils parseQueryFrom: string readStream.
	self assert: (fields at: 'foo') = '100'.
	self assert: (fields at: 'x') = '/a b'.
	! !

!ZnResponse commentStamp: 'SvenVanCaekenberghe 1/18/2011 10:59'!
I am ZnResponse, representing an HTTP Response 
consisting of a status line, headers and an optional entity (body).
I am a ZnMessage.
I can be used for generating and parsing.

Part of Zinc HTTP Components.!
!ZnResponse methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/17/2010 15:19'!
setLocation: uriString
	self headers at: 'Location' put: uriString! !

!ZnResponse methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/28/2011 10:27'!
isNoContent
	^ self code = 204! !

!ZnResponse methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 9/21/2010 11:34'!
readHeaderFrom: stream
	self statusLine: (ZnStatusLine readFrom: stream).
	super readHeaderFrom: stream
	! !

!ZnResponse methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/28/2010 12:38'!
isSuccess
	^ #(200 201 202 204) includes: self code! !

!ZnResponse methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/14/2011 14:43'!
isCreated
	^ self code = 201! !

!ZnResponse methodsFor: 'testing' stamp: 'ChristopheDemarey 12/11/2014 10:27'!
isBadRequest
	^ self code = 400! !

!ZnResponse methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/14/2010 14:34'!
setKeepAliveFor: request
	(request isHttp10 and: [ request isConnectionKeepAlive ])
		ifTrue: [ self setConnectionKeepAlive ]
	! !

!ZnResponse methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/12/2011 13:28'!
wwwAuthenticate
	^ self headers at: 'WWW-Authenticate'! !

!ZnResponse methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/17/2010 15:19'!
setWWWAuthenticate: string
	self headers at: 'WWW-Authenticate' put: string! !

!ZnResponse methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/20/2012 16:55'!
useConnection: connection
	"Hook method that can be overwritten to give subclasses the chance to 
	keep using connection in the current thread/process after the server wrote the response"! !

!ZnResponse methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 12/14/2010 12:54'!
printOn: stream
	super printOn: stream.
	stream nextPut: $(.
	self statusLine printCodeAndReasonOn: stream.
	self hasEntity ifTrue: [ 
		stream space.
		self entity printContentTypeAndLengthOn: stream ].
	stream nextPut: $)
	! !

!ZnResponse methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/7/2010 18:35'!
status
	^ self statusLine code! !

!ZnResponse methodsFor: '*GT-InspectorExtensions-Core' stamp: 'SvenVanCaekenberghe 10/6/2014 15:18'!
gtInspectorResponseIn: composite
	<gtInspectorPresentationOrder: 25>
	(self statusLine gtInspectorTextIn: composite)
		title: 'Response'! !

!ZnResponse methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/10/2012 20:05'!
isNotFound
	^ self code = 404 ! !

!ZnResponse methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/1/2011 19:02'!
entityReaderOn: stream
	"Reading undefined content is allowed for responses"
	
	^ (super entityReaderOn: stream)  
		allowReadingUpToEnd;
		yourself! !

!ZnResponse methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 4/20/2012 10:26'!
isError
	^self code > 399! !

!ZnResponse methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/16/2010 20:44'!
code
	^ self statusLine code! !

!ZnResponse methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/19/2013 21:09'!
hasTransferEncoding
	^ self headers includesKey: 'Transfer-Encoding'! !

!ZnResponse methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 5/22/2013 10:37'!
hash
	^ super hash bitXor: self status hash! !

!ZnResponse methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/28/2011 10:28'!
isInformational
	^ self code between: 100 and: 199! !

!ZnResponse methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/6/2010 22:36'!
statusLine
	^ statusLine! !

!ZnResponse methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 6/28/2011 10:36'!
readEntityFrom: stream
	(self isInformational or: [ self isNoContent or: [ self isNotModified ] ])
		ifFalse: [ super readEntityFrom: stream ]! !

!ZnResponse methodsFor: 'writing' stamp: 'SvenVanCaekenberghe 12/14/2010 11:36'!
writeOn: stream
	| bivalentWriteStream |
	bivalentWriteStream := ZnBivalentWriteStream on: stream.
	self statusLine writeOn: bivalentWriteStream.
	super writeOn: bivalentWriteStream! !

!ZnResponse methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/19/2013 20:24'!
setContentEncodingGzip
	self headers at: 'Content-Encoding' put: 'gzip'! !

!ZnResponse methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/19/2013 21:08'!
hasContentEncoding
	^ self headers includesKey: 'Content-Encoding'! !

!ZnResponse methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/12/2011 13:31'!
location
	^ self headers at: 'Location'! !

!ZnResponse methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/21/2011 10:45'!
isNotModified
	^ self code = 304! !

!ZnResponse methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/27/2012 21:31'!
isRedirect
	^ #(301 302 303 307) includes: self code! !

!ZnResponse methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/12/2011 10:03'!
isAuthenticationRequired
	^ self code = 401 ! !

!ZnResponse methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/7/2013 10:51'!
setConnectionCloseFor: request
	request wantsConnectionClose 
		ifTrue: [ self setConnectionClose ]! !

!ZnResponse methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/6/2010 22:36'!
statusLine: object
	statusLine := object! !

!ZnResponse methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/30/2011 21:53'!
cookies
	| value cookies |
	value := self headers at: 'Set-Cookie' ifAbsent: [ ^ #() ].
	cookies := value isString
		ifTrue: [ Array with: value ]
		ifFalse: [ value ].
	^ cookies collect: [ :each | ZnCookie fromString: each ]! !

!ZnResponse methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 5/22/2013 10:39'!
= other
	^ super = other and: [ self statusLine = other statusLine ]! !

!ZnResponse methodsFor: 'copying' stamp: 'SvenVanCaekenberghe 6/12/2014 15:57'!
postCopy
	super postCopy.
	statusLine := statusLine copy! !

!ZnResponse methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/30/2011 21:44'!
addCookie: cookie
	self headers at: 'Set-Cookie' add: cookie fullString
! !

!ZnResponse methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/20/2013 13:02'!
setTransferEncodingChunked
	self headers 
		at: 'Transfer-Encoding' put: 'chunked';
		clearContentLength! !

!ZnResponse class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 1/6/2013 22:39'!
ok: entity
	^ self new
		statusLine: ZnStatusLine ok;
		headers: ZnHeaders defaultResponseHeaders;
		entity: entity;
		yourself! !

!ZnResponse class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 1/6/2013 22:47'!
badRequest: request
	^ self new
		statusLine: ZnStatusLine badRequest;
		headers: ZnHeaders defaultResponseHeaders;
		entity: (ZnEntity textCRLF: 'Bad Request ' , request method , ' ' , request uri pathQueryFragmentPrintString);
		yourself! !

!ZnResponse class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 1/6/2013 22:47'!
created: url
	| location |
	location := url asString.
	^ self new
		statusLine: ZnStatusLine created;
		headers: ZnHeaders defaultResponseHeaders;
		setLocation: location;
		entity: (ZnEntity textCRLF: 'Created ' , location);
		yourself! !

!ZnResponse class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 09:14'!
gtExampleGetPharo
	<gtExample: 'Response: Created http://pharo.org'>
	^ self created: 'http://pharo.org'! !

!ZnResponse class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 1/6/2013 22:48'!
unauthorized: authString
	^ self new
		statusLine: ZnStatusLine unauthorized;
		headers: ZnHeaders defaultResponseHeaders;
		setWWWAuthenticate: authString;
		entity: (ZnEntity textCRLF: 'Unauthorized');
		yourself! !

!ZnResponse class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 09:12'!
gtExampleGetLocalhost8080
	<gtExample: 'Response: Not Found http://localhost:8080'>
	^ self notFound: 'http://localhost:8080'! !

!ZnResponse class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 09:12'!
gtExampleGetEmpty
	<gtExample: 'Response: Bad request <>'>
	^ self badRequest: ZnRequest gtExampleGetEmpty! !

!ZnResponse class methodsFor: 'instance creation' stamp: 'PaulDeBruicker 5/12/2012 09:54'!
notModified
	^ self new
		statusLine: ZnStatusLine notModified;
		headers: ZnHeaders defaultResponseHeaders;
		yourself! !

!ZnResponse class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 1/6/2013 22:48'!
redirect: url
	| location |
	location := url asString.
	^ self new
		statusLine: ZnStatusLine redirect;
		headers: ZnHeaders defaultResponseHeaders;
		setLocation: location;
		entity: (ZnEntity textCRLF: 'Redirect ' , location);
		yourself! !

!ZnResponse class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 1/6/2013 22:48'!
serverError: string
	^ self new
		statusLine: ZnStatusLine internalServerError;
		headers: ZnHeaders defaultResponseHeaders;
		entity: (ZnEntity textCRLF: string);
		yourself! !

!ZnResponse class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 1/6/2013 22:47'!
methodNotAllowed: request
	^ self new
		statusLine: ZnStatusLine methodNotAllowed;
		headers: ZnHeaders defaultResponseHeaders;
		entity: (ZnEntity textCRLF: 'Method Not Allowed ' , request method , ' ' , request uri pathQueryFragmentPrintString);
		yourself! !

!ZnResponse class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 1/6/2013 22:48'!
notFound: url
	^ self new
		statusLine: ZnStatusLine notFound;
		headers: ZnHeaders defaultResponseHeaders;
		entity: (ZnEntity textCRLF: 'Not Found ' , url asZnUrl pathQueryFragmentPrintString);
		yourself! !

!ZnResponse class methodsFor: 'instance creation' stamp: 'MattKennedy 9/30/2010 15:46'!
unauthorized
	^ self unauthorized: 'Basic realm=ZincHTTPComponents'! !

!ZnResponse class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 09:13'!
gtExampleGetRoot
	<gtExample: 'Response: Redirect /'>
	^ self redirect: '/'! !

!ZnResponseReadEvent commentStamp: 'SvenVanCaekenberghe 6/16/2014 14:06'!
ZnResponseReadEvent signals that a response was read in duration milliseconds. This time includes all waiting, server processing and networking.!
!ZnResponseReadEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 16:23'!
response
	^ response! !

!ZnResponseReadEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 16:23'!
response: anObject
	response := anObject! !

!ZnResponseReadEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 16:23'!
duration
	^ duration! !

!ZnResponseReadEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 16:23'!
duration: anObject
	duration := anObject! !

!ZnResponseReadEvent methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 6/30/2014 17:06'!
printContentsOn: stream
	super printContentsOn: stream.
	stream << ' Response Read '; print: response; space; print: duration; << 'ms'! !

!ZnResponseTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/6/2013 22:42'!
testAbsoluteCreated
	| response uri |
	uri := 'http://www.example.com:8888/something/else/foo.txt'.
	response := ZnResponse created: uri asZnUrl.
	self assert: response code = 201.
	self assert: response hasHeaders.
	self assert: (response headers at: 'Location') = uri.
	self assert: response hasEntity.
	self assert: (response entity contents includesSubstring: uri)! !

!ZnResponseTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/6/2013 22:38'!
testRedirect
	| response uri |
	uri := '/something/else/foo.txt'.
	response := ZnResponse redirect: uri.
	self assert: response code = 302.
	self assert: response code = 302.
	self assert: response hasHeaders.
	self assert: (response headers at: 'Location') = uri.
	self assert: response hasEntity.
	self assert: (response entity contents includesSubstring: uri).
	response := ZnResponse redirect: uri asZnUrl.
	self assert: response code = 302.
	self assert: response code = 302.
	self assert: response hasHeaders.
	self assert: (response headers at: 'Location') = uri.
	self assert: response hasEntity.
	self assert: (response entity contents includesSubstring: uri)! !

!ZnResponseTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
testWritingBinary
	| response bytes string |
	response := ZnResponse ok: (ZnEntity text: 'Okay').
	bytes := ByteArray streamContents: [ :stream | response writeOn: stream ].
	string := bytes asString.
	self assert: (string includesSubstring: '200 OK').
	self assert: (string includesSubstring: 'Okay')! !

!ZnResponseTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
testCookie
	| response cookie1  responseString |
	response := ZnResponse ok: (ZnStringEntity html: '<h1>hello world</h1>').
	cookie1 := ZnCookie new.
	cookie1 
		name: 'testCookie1';
		value: '123'.
		
	response addCookie: cookie1.
	
	responseString := String streamContents: [ :stream | response writeOn: stream ].
	
	self assert: (responseString includesSubstring: 'Set-Cookie: testCookie1=123')	

	
		
		
! !

!ZnResponseTests methodsFor: 'testing' stamp: 'PaulDeBruicker 4/19/2012 17:01'!
testIsError
	| response |
	response := ZnResponse ok: (ZnStringEntity html: '<h1>hello world</h1>').
	self assert: response isError not.
	response := ZnResponse notFound: 'http:///secret.txt'.
	self assert: response isError.
	response := ZnResponse redirect: '/something/else/foo.txt'.
	self assert: response isError not! !

!ZnResponseTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/6/2013 22:37'!
testAbsoluteRedirect
	| response uri |
	uri := 'http://foo.com:8080/something/else/foo.txt?key=123'.
	response := ZnResponse redirect: uri asZnUrl.
	self assert: response code = 302.
	self assert: response isRedirect.
	self assert: response hasHeaders.
	self assert: (response headers at: 'Location') = uri.
	self assert: response hasEntity.
	self assert: (response entity contents includesSubstring: uri)
! !

!ZnResponseTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
testCreated
	| response uri |
	uri := '/something/else/foo.txt'.
	response := ZnResponse created: uri.
	self assert: response code = 201.
	self assert: response hasHeaders.
	self assert: (response headers at: 'Location') = uri.
	self assert: response hasEntity.
	self assert: (response entity contents includesSubstring: uri)! !

!ZnResponseTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
testWritingCharacter
	| response string |
	response := ZnResponse ok: (ZnEntity text: 'Okay').
	string := String streamContents: [ :stream | response writeOn: stream ].
	self assert: (string includesSubstring: '200 OK').
	self assert: (string includesSubstring: 'Okay')! !

!ZnResponseTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
testCookies
	| response cookie1 cookie2 responseString |
	response := ZnResponse ok: (ZnStringEntity html: '<h1>hello world</h1>').
	cookie1 := ZnCookie new.
	cookie1 
		name: 'testCookie1';
		value: '123'.
		
	cookie2 := ZnCookie new.
	cookie2 
		name: 'testCookie2';
		value: '321'.
		
	response addCookie: cookie1.
	response addCookie: cookie2.
	
	responseString := String streamContents: [ :stream | response writeOn: stream ].
	
	self assert: (responseString includesSubstring: 'Set-Cookie: testCookie1=123').  
	self assert: (responseString includesSubstring: 'Set-Cookie: testCookie2=321').  	

	
		
		
! !

!ZnResponseTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
testNotFound
	| response |
	response := ZnResponse notFound: 'http:///secret.txt'.
	self assert: response code = 404.
	self assert: (response headers includesKey: 'Server').
	self assert: (response headers includesKey: 'Date').
	self assert: (response entity contents includesSubstring: 'secret.txt')! !

!ZnResponseTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
testSlashdotGzipChunked
	| request stream response contents |
	(request := ZnRequest get: 'http://slashdot.org')
		setConnectionClose;
		setAcceptEncodingGzip.
	stream := ZnNetworkingUtils socketStreamToUrl: request url.
	response := [ 
  		request writeOn: stream. 
  		stream flush. 
  		ZnResponse readFrom: stream ] ensure: [ stream close ].
	response isRedirect ifTrue: [ ^ self ].
	self assert: response code = 200.
	self assert: ((response headers at: 'Content-Type') beginsWith: 'text/html').
	self assert: (response headers at: 'Content-Encoding' ifAbsent: [ 'gzip' ]) = 'gzip'.
	self assert: (response headers at: 'Transfer-Encoding' ifAbsent: [ 'chunked' ]) = 'chunked'.
	contents := response entity contents.
	self assert: ((contents includesSubstring: 'Slashdot') or: [ contents includesSubstring: 'refresh' ])
! !

!ZnResponseWrittenEvent commentStamp: 'SvenVanCaekenberghe 6/16/2014 15:09'!
ZnResponseWrittenEvent signals that response was written in duration milliseconds.!
!ZnResponseWrittenEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 14:55'!
response
	^ response! !

!ZnResponseWrittenEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 14:55'!
response: anObject
	response := anObject! !

!ZnResponseWrittenEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 14:55'!
duration
	^ duration! !

!ZnResponseWrittenEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 14:55'!
duration: anObject
	duration := anObject! !

!ZnResponseWrittenEvent methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 6/30/2014 17:06'!
printContentsOn: stream
	super printContentsOn: stream.
	stream << ' Response Written '; print: response; space; print: duration; << 'ms'! !

!ZnSecureServer commentStamp: 'SvenVanCaekenberghe 12/13/2011 13:26'!
I am ZnSecureServer, an implementation of an HTTPS server.
I am a ZnMultiThreadedServer

(ZnSecureServer on: 1443)
	certificate: '/home/sven/ssl/key-cert.pem';
	logToTranscript;
	start;
	yourself.
	
Disclaimer: this is an experimental proof of concept.!
!ZnSecureServer methodsFor: 'private' stamp: 'SvenVanCaekenberghe 6/13/2014 14:05'!
socketStreamOn: socket
	| stream |
	stream := ZdcSecureSocketStream on: socket.
	stream sslSession certificateName: self certificate.
	stream accept.
	^ stream! !

!ZnSecureServer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/4/2013 13:14'!
scheme
	^ #https! !

!ZnSecureServer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/13/2011 13:08'!
certificate: anObject
	certificate := anObject! !

!ZnSecureServer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/13/2011 13:08'!
certificate
	^ certificate! !

!ZnServer commentStamp: '<historical>'!
I am ZnServer, an abstract superclass of HTTP Servers.
I am a facade for controlling a default server implementation.

I delegate my public class protocol methods to #defaultServerClass.

  ZnServer startDefaultOn: 1701.
  ZnClient new get: 'http://localhost:1701'.

Subclasses can register with me to have start/stop sent to them on System startUp/shutDown.
The default server instance will be registered automatically when it is started.

Part of Zinc HTTP Components.!
!ZnServer methodsFor: 'public' stamp: 'SvenVanCaekenberghe 6/19/2011 12:00'!
unregister
	"Ask for start/stop to no longer be sent to me on System startUp/shutDown"

	self class unregister: self! !

!ZnServer methodsFor: 'options' stamp: 'SvenVanCaekenberghe 9/5/2012 09:18'!
port: integer
	"Set the port number we will be listening on.
	Cannot be changed after the server is already running."
	
	(self isRunning and: [ self port ~= integer ]) 
		ifTrue: [ self error: 'Stop me before changing my port' ].
	self optionAt: #port put: integer! !

!ZnServer methodsFor: 'options' stamp: 'SvenVanCaekenberghe 9/5/2012 10:07'!
bindingAddress
	"Return the interface address we are (or will be) listening on.
	Nil means that we are (or will be) listening on all/any interfaces."
	
	^ self optionAt: #bindAddress ifAbsent: [ nil ] ! !

!ZnServer methodsFor: 'options' stamp: 'SvenVanCaekenberghe 9/5/2012 11:17'!
reader
	"Return a block that when given a stream reads an entity from it."
	
	^ self optionAt: #reader ifAbsentPut: [ [ :stream | ZnRequest readFrom: stream ] ]! !

!ZnServer methodsFor: 'options' stamp: 'SvenVanCaekenberghe 1/31/2013 11:44'!
debugMode
	"Return whether we are in debug mode, the default is false."
	
	^ self optionAt: #debugMode ifAbsent: [ false ] ! !

!ZnServer methodsFor: 'public' stamp: 'SvenVanCaekenberghe 6/19/2011 12:00'!
register
	"Ask for start/stop to be sent to me on System startUp/shutDown"
	
	self class register: self! !

!ZnServer methodsFor: 'options' stamp: 'SvenVanCaekenberghe 1/4/2013 13:40'!
serverUrl
	"Return the explicitely set external server URL, if any. Defaults to nil."
	
	^ self optionAt: #serverUrl ifAbsent: [ nil ]! !

!ZnServer methodsFor: 'public' stamp: 'SvenVanCaekenberghe 12/22/2011 12:19'!
stop: unregister
	"Stop me. I will stop listening on my port for incoming HTTP connections.
	If unregister is true, unregister me from the list of managed instances.
	Does nothing when I am not running"
	
	self subclassResponsibility ! !

!ZnServer methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/15/2010 21:22'!
isListening
	"Return true when I have a valid server socket listening at the correct port"
	
	self subclassResponsibility ! !

!ZnServer methodsFor: 'options' stamp: 'SvenVanCaekenberghe 9/5/2012 10:07'!
bindingAddress: address
	"Set the interface address we will be listening on.
	Specify nil to listen on all/any interfaces, the default.
	Address must be a 4 element ByteArray, like #[127 0 0 1].
	Cannot be changed after the server is already running."
	
	self optionAt: #bindAddress put: address! !

!ZnServer methodsFor: 'options' stamp: 'SvenVanCaekenberghe 9/5/2012 12:47'!
maximumEntitySize: integer
	"Set the maximum entity size in bytes that I will read from a stream before signalling ZnEntityTooLarge"
	
	^ self optionAt: #maximumEntitySize put: integer! !

!ZnServer methodsFor: 'options' stamp: 'SvenVanCaekenberghe 9/5/2012 11:17'!
authenticator: object
	"Set the object that will be sent #authenticateRequest:do:
	to authenticate or refuse the requests. Can be nil.
	When authentication succeeds, the block should be executed,
	when authentication fails, a appropriate response should be returned"

	self optionAt: #authenticator put: object! !

!ZnServer methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/15/2010 15:26'!
isRunning
	"Return true when I am running"
	
	self subclassResponsibility ! !

!ZnServer methodsFor: 'public' stamp: 'SvenVanCaekenberghe 12/15/2010 15:25'!
start
	"Start me. I will start listening on my port for incoming HTTP connections.
	If I am running, I will first stop and thus effectively restart"
	
	self subclassResponsibility! !

!ZnServer methodsFor: 'options' stamp: 'SvenVanCaekenberghe 9/5/2012 11:17'!
authenticator
	"Return the optional authenticator,
	the object that will be sent #authenticateRequest:do:
	to authenticate or refuse the requests. 
	When authentication succeeds, the block should be executed,
	when authentication fails, a appropriate response should be returned.
	If there is no authenticator, all requests will pass"
	
	^ self optionAt: #authenticator ifAbsent: [ nil ]! !

!ZnServer methodsFor: 'options' stamp: 'SvenVanCaekenberghe 9/5/2012 11:17'!
reader: block
	"Customize how entities are read from a stream, see #reader"
	
	self optionAt: #reader put: block! !

!ZnServer methodsFor: 'options' stamp: 'SvenVanCaekenberghe 1/31/2013 11:44'!
logServerErrorDetails
	"Return whether we log server error details including a short strack trace, the default is true."
	
	^ self optionAt: #debugMode ifAbsent: [ true ] ! !

!ZnServer methodsFor: 'options' stamp: 'SvenVanCaekenberghe 9/5/2012 11:17'!
delegate
	"Return the optional delegate, 
	the object that will be sent #handleRequest: to handle a request and produce a response.
	The default delegate is ZnDefaultServerDelegate"
	
	^ self optionAt: #delegate ifAbsentPut: [ ZnDefaultServerDelegate new ]! !

!ZnServer methodsFor: 'options' stamp: 'SvenVanCaekenberghe 1/31/2013 11:45'!
logServerErrorDetails: boolean
	"Set whether we log server error details including a short strack trace, the default is true."
	
	self optionAt: #debugMode put: boolean! !

!ZnServer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/10/2012 19:17'!
sessionFor: request
	"Bind an existing session to request or create a new session"
	
	^ self sessionManager sessionFor: request! !

!ZnServer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/4/2013 13:15'!
scheme
	^ #http! !

!ZnServer methodsFor: 'options' stamp: 'SvenVanCaekenberghe 9/5/2012 11:17'!
delegate: object
	"Set the delegate to object. Can be nil.
	This will be sent #handleRequest: to handle a request and produce a response"
	
	self optionAt: #delegate put: object! !

!ZnServer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/4/2013 13:15'!
localUrl
	"Return a ZnUrl to access me."
	
	^ ZnUrl new
		scheme: self scheme;
		host: NetNameResolver loopBackName;
		port: self port;
		yourself! !

!ZnServer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/4/2013 13:52'!
url
	"Return the base external URL (a new ZnUrl instance) to access me.
	This defaults to #localUrl but can be set explicitely using the #serverUrl option.
	Missing elements from #serverUrl are merged in from #localUrl."

	^ self serverUrl 
		ifNil: [ self localUrl ] 
		ifNotNil: [ :serverUrl | serverUrl inContextOf: self localUrl ]! !

!ZnServer methodsFor: 'public' stamp: 'SvenVanCaekenberghe 12/22/2011 12:19'!
stop
	"Stop me. I will stop listening on my port for incoming HTTP connections.
	Does nothing when I am not running"
	
	self stop: true ! !

!ZnServer methodsFor: 'options' stamp: 'SvenVanCaekenberghe 1/31/2013 11:44'!
debugMode: boolean
	"Set my debug mode, the default being false.
	In debug mode, Smalltalk Error during #handleRequest: will raise a Debugger.
	When not in debug mode, a Smalltalk Error during #handleRequest: will result in an HTTP Server Error response."
	
	^ self optionAt: #debugMode put: boolean! !

!ZnServer methodsFor: 'options' stamp: 'SvenVanCaekenberghe 12/31/2012 16:57'!
route: object
	"Set the route of the server.
	This is a short identification string to be appended at the end of server session ids, separated by a dot.
	Routes are used by load balancers and proxies to correctly implement session affiinity or stickyness.
	The default is nil, meaning that no route has to be appended."

	self optionAt: #route put: object! !

!ZnServer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/10/2012 19:17'!
sessionManager
	"Return my session manager"

	^ sessionManager ifNil: [ sessionManager := ZnServerSessionManager new ]! !

!ZnServer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/5/2012 09:15'!
optionAt: key put: value
	"Set my option/setting identified by key to be value.
	This is a generic interface, see my options protocol for specific usages."
	
	options ifNil: [ options := Dictionary new ].
	options at: key put: value! !

!ZnServer methodsFor: 'options' stamp: 'SvenVanCaekenberghe 5/19/2013 20:10'!
useGzipCompressionAndChunking
	"Return whether we should try to use gzip content encoding and chunked transfer encoding, the default is false."
	
	^ self optionAt: #useGzipCompressionAndChunking ifAbsent: [ false ] ! !

!ZnServer methodsFor: 'options' stamp: 'SvenVanCaekenberghe 9/5/2012 12:47'!
maximumEntitySize
	"Return the maximum entity size in bytes that I will read from a stream before signalling ZnEntityTooLarge"
	
	^ self optionAt: #maximumEntitySize ifAbsent: [ ZnConstants defaultMaximumEntitySize ]! !

!ZnServer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/5/2012 11:15'!
optionAt: key ifAbsentPut: block
	"Return my option/settings stored under key.
	If I have no such option/setting, store the result of evaluating block as new value and return it.
	This is a generic interface, see my options protocol for specific usages."

	^ options at: key ifAbsentPut: block! !

!ZnServer methodsFor: 'options' stamp: 'SvenVanCaekenberghe 9/5/2012 09:19'!
port
	"Return the integer port number we are (or will be) listening on"
	
	^ self optionAt: #port ifAbsent: [ 1701 ] ! !

!ZnServer methodsFor: 'options' stamp: 'SvenVanCaekenberghe 1/4/2013 13:40'!
serverUrl: urlObject
	"Set the explicit external server URL to urlObject. Defaults to nil.
	urlObject should be a ZnUrl or a String that parses correctly to one.
	See also #url."
	
	^ self optionAt: #serverUrl put: urlObject asZnUrl! !

!ZnServer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/5/2012 09:15'!
optionAt: key ifAbsent: block
	"Return my option/settings stored under key.
	Execute block if I have no such option/setting.
	This is a generic interface, see my options protocol for specific usages."

	options ifNil: [ ^ block value ].
	^ options at: key ifAbsent: block! !

!ZnServer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/15/2010 15:25'!
serverSocket
	"Return the server socket that I am using.
	Will be nil when I am not running"
	
	self subclassResponsibility ! !

!ZnServer methodsFor: 'options' stamp: 'SvenVanCaekenberghe 12/31/2012 16:58'!
route
	"Return the route of the server.
	This is a short identification string to be appended at the end of server session ids, separated by a dot.
	Routes are used by load balancers and proxies to correctly implement session affiinity or stickyness.
	The default is nil, meaning that no route has to be appended."
	
	^ self optionAt: #route ifAbsent: [ nil ]! !

!ZnServer methodsFor: 'options' stamp: 'SvenVanCaekenberghe 5/19/2013 20:11'!
useGzipCompressionAndChunking: boolean
	"Set whether we should try to use gzip content encoding and chunked transfer encoding, the default being false."
	
	self optionAt: #useGzipCompressionAndChunking put: boolean! !

!ZnServer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/15/2010 15:25'!
process
	"Return the process that is running my main listening loop.
	Will be nil when I am not running"
	
	self subclassResponsibility ! !

!ZnServer class methodsFor: 'system startup' stamp: 'SvenVanCaekenberghe 6/19/2011 12:17'!
register: server
	"Arrange for server to be sent start/stop on system startUp/shutDown"
	
	self managedServers add: server! !

!ZnServer class methodsFor: 'public' stamp: 'SvenVanCaekenberghe 12/22/2011 11:30'!
startOn: portNumber
	"Instanciate and return a new listener on a given port and start listening.
	Delegate to the default server class."

	^ self defaultServerClass startOn: portNumber ! !

!ZnServer class methodsFor: 'public' stamp: 'SvenVanCaekenberghe 12/22/2011 11:29'!
stopDefault
	"Stop the default instance, if any, and clear it.
	Return the stopped instance, if any.
	Delegate to the default server class."

	^ self defaultServerClass stopDefault ! !

!ZnServer class methodsFor: 'system startup' stamp: 'SvenVanCaekenberghe 8/18/2011 14:10'!
unregister: server
	"No longer send server start/stop on system startUp/shutDown"
	
	self managedServers remove: server ifAbsent: [ ]! !

!ZnServer class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/18/2012 13:37'!
alwaysRestart: boolean
	"Set if managed servers should always restart on image save, as opposed to only when quiting."

	^ AlwaysRestart := boolean! !

!ZnServer class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/19/2011 12:17'!
managedServers
	^ ManagedServers ifNil: [ ManagedServers := IdentitySet new ]! !

!ZnServer class methodsFor: 'public' stamp: 'SvenVanCaekenberghe 12/22/2011 12:03'!
defaultOn: portNumber
	"Return the default instance on a given port,
	Keep a reference to it in a class instance variable.
	If there was no previous default instance, create a new one.
	If there was a previous default instance, reuse it:
	if it was running stop it, change the port if necessary.
	Delegate to the default server class."

	^ self defaultServerClass defaultOn: portNumber ! !

!ZnServer class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 3/4/2012 20:05'!
defaultServerClass
	"Return the default ZnServer subclass to use"
	
	^ ZnManagingMultiThreadedServer ! !

!ZnServer class methodsFor: 'class initialization' stamp: 'SvenVanCaekenberghe 9/18/2012 13:49'!
initialize
	ManagedServers := IdentitySet new.
	AlwaysRestart := true.
	Smalltalk addToStartUpList: self.
	Smalltalk addToShutDownList: self! !

!ZnServer class methodsFor: 'public' stamp: 'SvenVanCaekenberghe 12/22/2011 11:27'!
default
	"Return the default instance that we manage.
	Delegate to the default server class."
	
	^ self defaultServerClass default! !

!ZnServer class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/18/2012 13:49'!
alwaysRestart
	^ AlwaysRestart ifNil: [ AlwaysRestart := true ]! !

!ZnServer class methodsFor: 'system startup' stamp: 'SvenVanCaekenberghe 9/18/2012 13:38'!
shutDown: quiting
	"Our system shutDown hook: stop all servers we manage"
	
	(quiting or: [ self alwaysRestart ])
		ifTrue: [
			self managedServers do: [ :each | each stop: false ] ]! !

!ZnServer class methodsFor: 'public' stamp: 'SvenVanCaekenberghe 12/22/2011 11:28'!
on: portNumber
	"Instantiate a new listener on a given port,
	send #start to it to start listening.
	Delegate to the default server class."

	^ self defaultServerClass on: portNumber ! !

!ZnServer class methodsFor: 'system startup' stamp: 'SvenVanCaekenberghe 9/29/2012 20:51'!
startUp: resuming
	"Our system startUp hook: start all servers we manage.
	We do this using deferred startup actions to allow normal error handling."

	(resuming or: [ self alwaysRestart ])
		ifTrue: [
			Smalltalk addDeferredStartupAction: [ 
				self managedServers do: [ :each | each start ] ] ]! !

!ZnServer class methodsFor: 'public' stamp: 'SvenVanCaekenberghe 12/22/2011 12:04'!
startDefaultOn: portNumber
	"Start and return the default instance on a given port.
	Keep a reference to it in a class instance variable.
	If there was no previous default instance, create a new one.
	If there was a previous default instance, reuse it:
	if it was running stop and start it, effectively restarting it.
	Change the port if necessary.
	Starting the default server will register it automatically.
	Delegate to the default server class."

	^ self defaultServerClass startDefaultOn: portNumber ! !

!ZnServerConnectionClosedEvent commentStamp: 'SvenVanCaekenberghe 6/16/2014 15:10'!
ZnServerConnectionClosedEvent signals that the server closed a client connection to address. !
!ZnServerConnectionClosedEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 13:28'!
address: anObject
	address := anObject! !

!ZnServerConnectionClosedEvent methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 6/30/2014 17:06'!
printContentsOn: stream
	super printContentsOn: stream.
	stream << ' Server Connection Closed '.
	address do: [ :each | stream print: each ] separatedBy: [ stream nextPut: $. ]! !

!ZnServerConnectionClosedEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 13:28'!
address
	^ address! !

!ZnServerErrorEvent commentStamp: 'SvenVanCaekenberghe 6/16/2014 15:10'!
ZnServerErrorEvent is a ZnServerLogEvent related to an exception that occurred.!
!ZnServerErrorEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 14:22'!
exception: anObject
	exception := anObject! !

!ZnServerErrorEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 14:22'!
exception
	^ exception! !

!ZnServerGenericLogEvent commentStamp: 'SvenVanCaekenberghe 6/16/2014 15:03'!
I am ZnServerGenericLogEvent, a ZnServerLogEvent and ZnLogEvent that holds a generic subject, possibly not limited to a String.

Here are two examples:

(ZnServerGenericLogEvent subject: 'You can''t do that, Dave') emit.

(ZnServerGenericLogEvent subject: { #id->123. #reason->#timeout } asDictionary) emit.!
!ZnServerGenericLogEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/16/2014 11:39'!
subject: anObject
	subject := anObject! !

!ZnServerGenericLogEvent methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 11/6/2014 15:10'!
printContentsOn: stream
	super printContentsOn: stream.
	stream space; nextPutAll: subject asString! !

!ZnServerGenericLogEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/16/2014 11:39'!
subject
	^ subject! !

!ZnServerGenericLogEvent class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 6/16/2014 12:33'!
subject: object
	"self subject: #(i 10 j -1)."
	"self subject: 'How are you?'."
	
	^ self new
		subject: object;
		yourself! !

!ZnServerHandlerErrorEvent commentStamp: 'SvenVanCaekenberghe 6/16/2014 15:12'!
ZnServerHandlerErrorEvent signals an error that occurred during handling by the delegate. This is considered a real error.!
!ZnServerHandlerErrorEvent methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 6/30/2014 17:06'!
printContentsOn: stream
	super printContentsOn: stream.
	stream << ' Server Handler Error ';  print: exception! !

!ZnServerLogEvent commentStamp: 'SvenVanCaekenberghe 6/12/2014 15:27'!
I am ZnServerLogEvent, a ZnLogEvent generated by ZnServer and its subclasses.

I hold a processId attribute.
I hold an optional serverId attribute.!
!ZnServerLogEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 15:15'!
processId
	^ processId! !

!ZnServerLogEvent methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 6/11/2014 15:17'!
initialize
	super initialize.
	processId := ZnUtils currentProcessID! !

!ZnServerLogEvent methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 6/11/2014 15:15'!
processId: anObject
	processId := anObject! !

!ZnServerLogEvent methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 6/11/2014 15:15'!
serverId: anObject
	serverId := anObject! !

!ZnServerLogEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/11/2014 15:15'!
serverId
	^ serverId! !

!ZnServerLogEvent methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 11/6/2014 15:30'!
printContentsOn: stream
	super printContentsOn: stream.
	serverId ifNotNil: [ stream space; << serverId ].
	stream space.
	processId printOn: stream base: 10 length: 6 padded: true! !

!ZnServerReadErrorEvent commentStamp: 'SvenVanCaekenberghe 6/16/2014 15:13'!
ZnServerReadErrorEvent signals an error during the reading of a request. These errors are considered mostly benign and the connection gets closed.
!
!ZnServerReadErrorEvent methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 6/30/2014 17:06'!
printContentsOn: stream
	super printContentsOn: stream.
	stream << ' Server Read Error ';  print: exception! !

!ZnServerSession commentStamp: '<historical>'!
I am ZnServerSession.
I represent an HTTP session in the context of a ZnServer.

To get a reference to the current session, send #session to a ZnMessage (request or response).

Part of Zinc HTTP Components.!
!ZnServerSession methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/11/2012 08:01'!
created
	^ created! !

!ZnServerSession methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/10/2012 17:28'!
attributeAt: key ifAbsent: block
	^ attributes at: key ifAbsent: block! !

!ZnServerSession methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 11/10/2012 17:27'!
id: anObject
	id := anObject! !

!ZnServerSession methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/10/2012 17:28'!
attributeAt: key
	^ attributes at: key! !

!ZnServerSession methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/10/2012 17:29'!
attributeAt: key put: value
	^ attributes at: key put: value! !

!ZnServerSession methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/11/2012 20:06'!
age
	^ DateAndTime now - created! !

!ZnServerSession methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/10/2012 17:27'!
id
	^ id! !

!ZnServerSession methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 11/11/2012 08:01'!
initialize
	super initialize.
	attributes := SmallDictionary new.
	created := modified := DateAndTime now! !

!ZnServerSession methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/11/2012 08:01'!
modified
	^ modified! !

!ZnServerSession methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 11/10/2012 17:30'!
printOn: stream
	super printOn: stream.
	id
		ifNotNil: [ 
			stream
				nextPut: $(;
				print: id;
				nextPut: $) ]! !

!ZnServerSession methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/11/2012 08:01'!
touch
	modified := DateAndTime now! !

!ZnServerSession methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/11/2012 20:08'!
isValid
	^ self inactivity < 1 hour! !

!ZnServerSession methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/20/2012 23:35'!
removeAttribute: key
	attributes removeKey: key ifAbsent: [ ] ! !

!ZnServerSession methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/7/2012 12:21'!
attributeAt: key ifAbsentPut: block
	^ attributes at: key ifAbsentPut: block! !

!ZnServerSession methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/11/2012 20:08'!
inactivity
	^ DateAndTime now - modified ! !

!ZnServerSession methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/20/2012 23:53'!
attributeKeys
	^ attributes keys! !

!ZnServerSessionManager commentStamp: '<historical>'!
I am ZnServerSessionManager.
I manage a collection of ZnServerSession on behalf of a ZnServer.

Session ids are stored in cookies.

Part of Zinc HTTP Components.!
!ZnServerSessionManager methodsFor: 'initialization' stamp: 'SvenVanCaekenberghe 11/10/2012 19:06'!
initialize
	super initialize.
	sessions := Dictionary new! !

!ZnServerSessionManager methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/31/2012 16:34'!
newSessionForRequest: request
	| id session |
	id := self newSessionId.
	session := ZnServerSession new.
	session id: id.
	sessions at: id put: session.
	^ session! !

!ZnServerSessionManager methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/10/2012 22:57'!
setSession: session in: response
	"Bind session in response"

	| cookie |
	session ifNil: [ ^ self ].
	(cookie := ZnCookie name: self cookieName value: session id)
		path: '/'.
	response addCookie: cookie! !

!ZnServerSessionManager methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/31/2012 16:45'!
removeSessionWithId: id
	"Remove the session with id.
	If there is no such session, do nothing"
	
	^ sessions removeKey: id ifAbsent: [ nil ]! !

!ZnServerSessionManager methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/31/2012 16:45'!
cleanupInvalidSessions
	"Remove all expired sessions"
	
	sessions keysAndValuesRemove: [ :key :value | value isValid not ]! !

!ZnServerSessionManager methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/25/2012 21:26'!
sessionFor: request
	"Bind an existing session to request or create a new session"

	| id |
	id := self sessionIdFromRequest: request.
	sessions
		at: id
		ifPresent: [ :session | 
			session isValid
				ifTrue: [ ^ session touch; yourself ]
				ifFalse: [ sessions removeKey: id ] ].
	^ self newSessionForRequest: request! !

!ZnServerSessionManager methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/31/2012 16:40'!
sessionIdFromRequest: request
	| cookie |
	cookie := request cookies 
		detect: [ :each | each name = self cookieName ] 
		ifNone: [ ^ nil ].
	^ cookie value! !

!ZnServerSessionManager methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/10/2012 19:33'!
cookieName
	^ 'session-id'! !

!ZnServerSessionManager methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/31/2012 16:46'!
newSessionId
	"Create a new session id.
	If the server has a route, append it at the end with a dot as separator."
	
	^ ZnCurrentServer value route
		ifNil: [ UUID new asString36 ]
		ifNotNil: [ :route | 
			String
				streamContents: [ :stream | 
					stream
						<< UUID new asString36;
						nextPut: $.;
						<< route ] ]! !

!ZnServerSocketBoundEvent commentStamp: 'SvenVanCaekenberghe 6/16/2014 15:14'!
ZnServerSocketBoundEvent signals a new server socket on address:port is bound (opened).!
!ZnServerSocketBoundEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 11:10'!
address
	^ address! !

!ZnServerSocketBoundEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 11:10'!
address: anObject
	address := anObject! !

!ZnServerSocketBoundEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 11:10'!
port: anObject
	port := anObject! !

!ZnServerSocketBoundEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 11:10'!
port
	^ port! !

!ZnServerSocketBoundEvent methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 6/30/2014 17:06'!
printContentsOn: stream
	super printContentsOn: stream.
	stream << ' Server Socket Bound '.
	address do: [ :each | stream print: each ] separatedBy: [ stream nextPut: $. ].
	stream nextPut: $:; print: port
	! !

!ZnServerSocketReleasedEvent commentStamp: 'SvenVanCaekenberghe 6/16/2014 15:14'!
ZnServerSocketReleasedEvent signals a new server socket on address:port is released (closed).!
!ZnServerSocketReleasedEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 13:32'!
address
	^ address! !

!ZnServerSocketReleasedEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 13:32'!
address: anObject
	address := anObject! !

!ZnServerSocketReleasedEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 13:32'!
port: anObject
	port := anObject! !

!ZnServerSocketReleasedEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 13:32'!
port
	^ port! !

!ZnServerSocketReleasedEvent methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 6/30/2014 17:06'!
printContentsOn: stream
	super printContentsOn: stream.
	stream << ' Server Socket Released '.
	address do: [ :each | stream print: each ] separatedBy: [ stream nextPut: $. ].
	stream nextPut: $:; print: port! !

!ZnServerStartedEvent commentStamp: 'SvenVanCaekenberghe 6/16/2014 15:14'!
ZnServerStartedEvent notes the startup of an HTTP server is complete.
!
!ZnServerStartedEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 10:54'!
description: anObject
	description := anObject! !

!ZnServerStartedEvent methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 6/30/2014 17:06'!
printContentsOn: stream
	super printContentsOn: stream.
	stream << ' Started '; << description! !

!ZnServerStartedEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 10:54'!
description
	^ description! !

!ZnServerStoppedEvent commentStamp: 'SvenVanCaekenberghe 6/16/2014 15:15'!
ZnServerStoppedEvent notes the shutdown of an HTTP server is complete.!
!ZnServerStoppedEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 10:55'!
description: anObject
	description := anObject! !

!ZnServerStoppedEvent methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 6/30/2014 17:06'!
printContentsOn: stream
	super printContentsOn: stream.
	stream << ' Stopped '; << description! !

!ZnServerStoppedEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 10:55'!
description
	^ description! !

!ZnServerTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/31/2012 16:58'!
testSessionRoute
	self withServerDo: [ :server | | client sessionId |
		server route: 'r1'.
		self assert: server route equals: 'r1'.
		client := ZnClient new url: (server localUrl addPathSegment: #session); yourself.
		self assert: client session cookieJar cookies isEmpty.
		client get.
		self assert: client isSuccess.
		self assert: client session cookieJar cookies size = 1.
		sessionId := client session cookieJar cookies anyOne value.
		self assert: (client contents includesSubstring: sessionId).
		self assert: (sessionId endsWith: '.r1').
		client get.
		self assert: client isSuccess.
		self assert: client session cookieJar cookies size = 1.
		self assert: client session cookieJar cookies anyOne value equals: sessionId.
		self assert: (client contents includesSubstring: sessionId) ]
! !

!ZnServerTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/9/2013 12:23'!
testRequestLineTooLong
	self usingClassicSocketStreamsOnWindowsDo: [
		self withServerDo: [ :server |
		self deny: server debugMode.
		self assertRequestLineTooLong: server localUrl ] ]! !

!ZnServerTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/14/2013 09:27'!
testError
	self withServerDo: [ :server | | url response |
		self deny: server debugMode.
		url := server localUrl
					addPathSegment: #error;
					queryAt: #message put: 'Test Error';
					yourself.
		response := ZnEasy get: url.
		self deny: response isSuccess.
		self assert: response code equals: 500.
		self assert: response contentType equals: ZnMimeType textPlain.
		self assert: (response entity contents includesSubstring: 'Test Error') ]! !

!ZnServerTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/22/2014 10:17'!
testEchoLocalInterface
	| server response |
	(server := ZnServer on: self port)
		bindingAddress: NetNameResolver loopBackAddress.
	[ 
		server start.
		self 
			assert: server isRunning & server isListening
			description: ('Failed to start server on port {1}. Is there one already?' format: { server port }).
		response := ZnEasy get: (server localUrl addPathSegments: #('echo' 'foo'); yourself).
		self assert: (response contentType = ZnMimeType textPlain).
		self assert: (response statusLine code = 200).
		self assert: (response entity contents includesSubstring: 'Zinc').
		self assert: (response entity contents includesSubstring: 'foo')
	]
		ensure: [ server stop ]! !

!ZnServerTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
testAuthorizationFailed
	self withServerDo: [ :server | | response |
		server authenticator: (ZnBasicAuthenticator username: 'foo' password: 'secret').
		response := ZnEasy get: (server localUrl addPathSegment: 'echo'; yourself).
		self assert: (response headers contentType = ZnMimeType textPlain).
		self assert: (response statusLine code = 401).
		self assert: ((response headers at: 'WWW-Authenticate') includesSubstring: 'Basic').
		self assert: ((response headers at: 'WWW-Authenticate') includesSubstring: 'Zinc') ]! !

!ZnServerTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/14/2013 09:26'!
testLocalUrl
	self withServerDo: [ :server | 
		self assert: server localUrl scheme equals: #http.
		self assert: server localUrl host equals: NetNameResolver loopBackName.
		self assert: server localUrl port equals: server port ]! !

!ZnServerTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
testAuthorizationSuccessful
	self withServerDo: [ :server | | response |
		server authenticator: (ZnBasicAuthenticator username: 'foo' password: 'secret').
		response := ZnEasy get: (server localUrl addPathSegments: #('echo' 'foo'); yourself) username: 'foo' password: 'secret'.
		self assert: (response headers contentType = ZnMimeType textPlain).
		self assert: (response statusLine code = 200).
		self assert: (response entity string includesSubstring: 'Zinc').
		self assert: (response entity string includesSubstring: 'foo') ]! !

!ZnServerTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 1/22/2014 10:16'!
withServerDo: block
	| server |
	server := ZnServer on: self port.
	[ 
		server start.
		self 
			assert: server isRunning & server isListening
			description: ('Failed to start server on port {1}. Is there one already?' format: { server port }).
		block cull: server 
	]
		ensure: [ server stop ]! !

!ZnServerTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/9/2013 12:22'!
testEntityTooLarge
	self usingClassicSocketStreamsOnWindowsDo: [ 
		self withServerDo: [ :server | 
			server maximumEntitySize: self entitySizeLimit.
			self deny: server debugMode.
			self assertEntityTooLarge: server localUrl ] ]! !

!ZnServerTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/7/2013 20:18'!
assertRequestLineTooLong: serverUrl
	| url response |
	url := serverUrl
		addPathSegment: #echo;
		addPathSegment: (String new: ZnConstants maximumLineLength withAll: $X);
		yourself.
	response := ZnEasy get: url.
	self deny: response isSuccess.
	self assert: response code equals: 400.
	self assert: response contentType equals: ZnMimeType textPlain.
	self assert: (response entity contents includesSubstring: 'ZnLineTooLong')! !

!ZnServerTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 10/15/2014 22:28'!
testFormTest3
	| inputs client part |
	inputs := #( ('foo.txt' 'this is foo!!') ('français.txt' 'Je te dis: élèves français') ('Ελλάδα.txt' 'Ελλάδα is it!!') ).
	self withServerDo: [ :server |
		server debugMode: true.
		(client := ZnClient new)
			url: server localUrl;
			addPathSegment: 'form-test-3'.
		inputs do: [ :each  |
			part := ZnMimePart 
				fieldName: 'file' 
				fileName: each first 
				entity: (ZnEntity with: each second).
			client
				resetEntity;
				addPart: part;
				post.
			self assert: client isSuccess.
			self assert: (client contents includesSubstring: each first).
			self assert: (client contents includesSubstring: each second) ] ]! !

!ZnServerTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 10/15/2014 22:28'!
testFormTest3Unspecified
	"Simulate what most browsers seem to do: upload text files utf-8 encoded 
	without specifying the charset in the mime type of the mime part"
	
	| inputs client part entity |
	inputs := #( ('foo.txt' 'this is foo!!') ('français.txt' 'Je te dis: élèves français') ('Ελλάδα.txt' 'Ελλάδα is it!!') ).
	self withServerDo: [ :server |
		server debugMode: true.
		(client := ZnClient new)
			url: server localUrl;
			addPathSegment: 'form-test-3'.
		inputs do: [ :each  |
			entity := ZnEntity 
				with: each second utf8Encoded 
				type: ZnMimeType textPlain clearCharSet.
			part := ZnMimePart fieldName: 'file' fileName: each first entity: entity.
			client
				resetEntity;
				addPart: part;
				post.
			self assert: client isSuccess.
			self assert: (client contents includesSubstring: each first).
			self assert: (client contents includesSubstring: each second) ] ]! !

!ZnServerTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/7/2013 20:18'!
assertEntityTooLarge: serverUrl
	| response client |
	client := ZnClient new
		url: serverUrl;
		addPathSegment: #echo;
		entity: (ZnEntity with: (ByteArray new: self entitySizeLimit + 1));
		yourself.
	response := client
		post;
		response.
	client close.
	self deny: response isSuccess.
	self assert: response code equals: 400.
	self assert: response contentType equals: ZnMimeType textPlain.
	self assert: (response entity contents includesSubstring: 'ZnEntityTooLarge')! !

!ZnServerTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/19/2013 21:21'!
testGzipCompressionAndChunking
	self withServerDo: [ :server | | client |
		server useGzipCompressionAndChunking: true.
		(client := ZnClient new)
			url: server localUrl;
			addPathSegment: 'dw-bench';
			setAcceptEncodingGzip;
			get.
		self assert: client isSuccess.
		self assert: client response hasContentEncoding.
		self assert: (client response headers at: 'Content-Encoding') equals: 'gzip'.
		self assert: client response hasTransferEncoding.
		self assert: (client response headers at: 'Transfer-Encoding') equals: 'chunked' ]! !

!ZnServerTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/7/2013 20:18'!
assertHeaderLineTooLong: serverUrl
	| response client |
	client := ZnClient new
		url: serverUrl;
		addPathSegment: #echo;
		headerAt: 'X-Test' put: (String new: ZnConstants maximumLineLength withAll: $X);
		yourself.
	response := client
		get;
		response.
	client close.
	self deny: response isSuccess.
	self assert: response code equals: 400.
	self assert: response contentType equals: ZnMimeType textPlain.
	self assert: (response entity contents includesSubstring: 'ZnLineTooLong')! !

!ZnServerTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/7/2013 20:19'!
assertTooManyHeaders: serverUrl
	| response client |
	client := ZnClient new
		url: serverUrl;
		addPathSegment: #echo;
		yourself.
	client request headers unlimited.
	1 to: 256 do: [ :each | client headerAt: 'X-Test-' , each printString put: each printString ].
	response := client
		get;
		response.
	client close.
	self deny: response isSuccess.
	self assert: response code equals: 400.
	self assert: response contentType equals: ZnMimeType textPlain.
	self assert: (response entity contents includesSubstring: 'ZnTooManyDictionaryEntries')! !

!ZnServerTests methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/7/2013 20:06'!
entitySizeLimit
	^ 1024! !

!ZnServerTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
testGetUnicodeUtf8
	self withServerDo: [ :server | | response html |
		response := ZnEasy get: (server localUrl addPathSegment: 'unicode'; yourself).
		self assert: (response contentType = ZnMimeType textHtml).
		self assert: (response statusLine code = 200).
		self assert: response contentType isCharSetUTF8.
		html := response entity contents.
		self assert: (html includesSubstring: 'Unicode').
		0 to: 16r024F do: [ :each | self assert: (html includes: each asCharacter) ] ]! !

!ZnServerTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/9/2013 12:23'!
testTooManyHeaders
	self usingClassicSocketStreamsOnWindowsDo: [
		self withServerDo: [ :server |
			self deny: server debugMode.
			self assertTooManyHeaders: server localUrl ] ]! !

!ZnServerTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/10/2012 17:42'!
testEcho
	self withServerDo: [ :server | | response |
		response := ZnEasy get: (server localUrl addPathSegments: #('echo' 'foo'); yourself).
		self assert: (response contentType = ZnMimeType textPlain).
		self assert: (response statusLine code = 200).
		self assert: (response entity contents includesSubstring: 'Zinc').
		self assert: (response entity contents includesSubstring: 'foo').
		self assert: (response entity contents includesSubstring: server printString) ]! !

!ZnServerTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/6/2013 23:57'!
testGetConnectionClose
	self withServerDo: [ :server | | client |
		client := ZnClient new.
		client url: server localUrl; addPathSegment: #echo.
		client request setConnectionClose.
		client get.
		self assert: client isSuccess.
		self assert: (client contents includesSubstring: 'echo').
		self assert: client response isConnectionClose.
		client close ]! !

!ZnServerTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/12/2012 22:06'!
testDefault
	| port server |
	ZnServer stopDefault.
	self assert: ZnServer default isNil.
	port := self port.
	server := ZnServer startDefaultOn: port.
	self assert: ZnServer default notNil.
	self assert: ZnServer default == server.
	self assert: ZnServer default port = port.
	self assert: ZnServer default isRunning.
	self assert: (ZnServer managedServers includes: server).
	ZnServer stopDefault.
	self assert: ZnServer default isNil.
	self deny: server isRunning.
	self deny: (ZnServer managedServers includes: server).
	server := ZnServer startDefaultOn: port.
	"Starting the default again is actually a restart"
	ZnServer startDefaultOn: port.
	self assert: ZnServer default == server.
	ZnServer stopDefault! !

!ZnServerTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/31/2012 16:44'!
testSessionExpired
	self withServerDo: [ :server | | client sessionId |
		client := ZnClient new url: (server localUrl addPathSegment: #session); yourself.
		self assert: client session cookieJar cookies isEmpty.
		client get.
		self assert: client isSuccess.
		self assert: client session cookieJar cookies size = 1.
		sessionId := client session cookieJar cookies anyOne value.
		self assert: (client contents includesSubstring: sessionId).
		"Kill the server session as if it was expired"
		server sessionManager removeSessionWithId: sessionId.
		"The client still presents the old session id but should get a new one"
		client get.
		self assert: client isSuccess.
		self assert: client session cookieJar cookies size = 1.
		self deny: client session cookieJar cookies anyOne value = sessionId ]
! !

!ZnServerTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/15/2013 22:43'!
testReadEvalPrint
	self withServerDo: [ :server | | x y result |
		server delegate: ZnReadEvalPrintDelegate new.
		x := 100 atRandom.
		y := 100 atRandom.
		result := ZnClient new
			url: server localUrl;
			addPathSegment: #repl;
			contents: ('{1}+{2}' format: { x. y });
			post.
		self assert: result asInteger equals: x + y ]! !

!ZnServerTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/9/2013 12:23'!
testHeaderLineTooLong
	self usingClassicSocketStreamsOnWindowsDo: [
		self withServerDo: [ :server |
			self deny: server debugMode.
			self assertHeaderLineTooLong: server localUrl ] ]! !

!ZnServerTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/10/2012 23:47'!
testSession
	self withServerDo: [ :server | | client sessionId |
		client := ZnClient new url: (server localUrl addPathSegment: #session); yourself.
		self assert: client session cookieJar cookies isEmpty.
		client get.
		self assert: client isSuccess.
		self assert: client session cookieJar cookies size = 1.
		sessionId := client session cookieJar cookies anyOne value.
		self assert: (client contents includesSubstring: sessionId).
		client get.
		self assert: client isSuccess.
		self assert: client session cookieJar cookies size = 1.
		self assert: client session cookieJar cookies anyOne value equals: sessionId.
		self assert: (client contents includesSubstring: sessionId) ]
! !

!ZnServerTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 1/21/2014 20:48'!
runningOnWindows
	"Pharo 3+"
	[ ^ OSPlatform current isWindows ] on: MessageNotUnderstood do: [ ].
	"Pharo 2-"
	[ ^ OSPlatform isWin32 ] on: MessageNotUnderstood do: [ ].
	"Give up"
	^ false! !

!ZnServerTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 10/9/2014 15:01'!
testFormTest2
	| inputs client |
	inputs := #( '1+2=3 & 2+1=3 single '' double " - cool ?' 'élèves français' 'Ελλάδα' ).
	self withServerDo: [ :server |
		(client := ZnClient new)
			url: server localUrl;
			addPathSegment: 'form-test-2'.
		inputs do: [ :each  |
			client
				formAt: #input put: each;
				post.
			self assert: client isSuccess.
			self assert: (client contents includesSubstring: each) ] ]! !

!ZnServerTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/14/2013 09:26'!
testUrl
	self withServerDo: [ :server | 
		self assert: server url equals: server localUrl.
		server serverUrl:
					(ZnUrl new
						host: 'zn.stfx.eu';
						yourself).
		self assert: server url scheme equals: #http.
		self assert: server url host equals: 'zn.stfx.eu'.
		self assert: server url port equals: server port.
		server serverUrl: 'http://zn.stfx.eu:8080/zn'.
		self assert: server url scheme equals: #http.
		self assert: server url host equals: 'zn.stfx.eu'.
		self assert: server url port equals: 8080.
		self assert: server url path equals: 'zn' ]! !

!ZnServerTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 1/22/2014 10:12'!
port
	^ 1700 + 32 atRandom! !

!ZnServerTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 1/21/2014 20:45'!
usingClassicSocketStreamsOnWindowsDo: block
	| originalSocketStreamClass |
	originalSocketStreamClass := ZnNetworkingUtils default socketStreamClass.
	self runningOnWindows
		ifTrue: [ ZnNetworkingUtils default socketStreamClass: SocketStream ].
	block
		ensure: [ ZnNetworkingUtils default socketStreamClass: originalSocketStreamClass ]! !

!ZnServerTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
testEchoBinary
	self withServerDo: [ :server | | response entityIn entityOut |
		server reader: [ :stream | ZnRequest readBinaryFrom: stream ].
		entityIn := ZnEntity with: 'ABC' type: 'text/plain'.
		response := ZnEasy put: (server localUrl addPathSegment: 'echo'; yourself)  data: entityIn.
		self assert: (response contentType = ZnMimeType textPlain).
		self assert: (response statusLine code = 200).
		entityOut := ZnEntity with: entityIn string asByteArray type: entityIn contentType.
		self assert: (response entity contents includesSubstring: entityOut printString) ]! !

!ZnServerTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 10/9/2014 14:51'!
testFormTest1
	| inputs client |
	inputs := #( '1+2=3 & 2+1=3 single '' double " - cool ?' 'élèves français' 'Ελλάδα' ).
	self withServerDo: [ :server |
		(client := ZnClient new)
			url: server localUrl;
			addPathSegment: 'form-test-1'.
		inputs do: [ :each  |
			client
				queryAt: #input put: each;
				get.
			self assert: client isSuccess.
			self assert: (client contents includesSubstring: each) ] ]! !

!ZnServerTransactionEvent commentStamp: 'SvenVanCaekenberghe 6/16/2014 15:18'!
ZnServerTransactionEvent is a ZnServerLogEvent that notes the completion of a server side HTTP transaction (request/response).

Instance Variables
	request: a ZnRequest
	response:	a ZnResponse
	timing: a ZnServerTransactionTiming

Note that this can be quite large since it includes the entities transferred. See ZnSimplifiedServerTransactionEvent for a more compact representation.!
!ZnServerTransactionEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 16:02'!
timing: anObject
	timing := anObject! !

!ZnServerTransactionEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 16:02'!
timing
	^ timing! !

!ZnServerTransactionEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 16:02'!
request: anObject
	request := anObject! !

!ZnServerTransactionEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 16:02'!
response
	^ response! !

!ZnServerTransactionEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 16:02'!
response: anObject
	response := anObject! !

!ZnServerTransactionEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 16:03'!
duration
	^ timing totalDuration! !

!ZnServerTransactionEvent methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 6/30/2014 17:06'!
printContentsOn: stream
	super printContentsOn: stream.
	stream space.
	request requestLine printMethodAndUriOn: stream.
	stream space; print: response code.
	response hasEntity
		ifTrue: [ 
			stream space; print: response entity contentLength; nextPut: $B ].
	stream space; print: self duration; nextPutAll: 'ms'! !

!ZnServerTransactionEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 16:02'!
request
	^ request! !

!ZnServerTransactionTiming commentStamp: 'SvenVanCaekenberghe 6/13/2014 16:00'!
I am ZnServerTransactionTiming.

I hold timing information related to the handling of an HTTP transaction by a server.
!
!ZnServerTransactionTiming methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 16:00'!
handlerDuration: anObject
	handlerDuration := anObject! !

!ZnServerTransactionTiming methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 6/13/2014 16:01'!
initialize
	super initialize.
	requestDuration := handlerDuration := responseDuration := 0! !

!ZnServerTransactionTiming methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 16:00'!
handlerDuration
	^ handlerDuration! !

!ZnServerTransactionTiming methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 16:00'!
responseDuration
	^ responseDuration! !

!ZnServerTransactionTiming methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 16:00'!
requestDuration: anObject
	requestDuration := anObject! !

!ZnServerTransactionTiming methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 16:00'!
responseDuration: anObject
	responseDuration := anObject! !

!ZnServerTransactionTiming methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 16:00'!
requestDuration
	^ requestDuration! !

!ZnServerTransactionTiming methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 21:49'!
totalDuration
	"requestDuration is unreliable because it contains idle wait time"
	
	^ handlerDuration + responseDuration ! !

!ZnServerWriteErrorEvent commentStamp: 'SvenVanCaekenberghe 6/16/2014 15:13'!
ZnServerWriteErrorEvent signals an error during the writing of a response. These errors are considered mostly benign and the connection gets closed.
!
!ZnServerWriteErrorEvent methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 6/30/2014 17:06'!
printContentsOn: stream
	super printContentsOn: stream.
	stream << ' Server Write Error ';  print: exception! !

!ZnSignalProgress commentStamp: '<historical>'!
I am ZnSignalProgress.
I am a DynamicVariable and a ProcessSpecificVariable.

I can be used to indicate that Zn related code down the call stack has to signal HTTPProgress, for example:

ZnSignalProgress 
	value: true 
	during: [ ^ ZnClient new get: 'http://zn.stfx.eu/zn/small.html' ]!
!ZnSignalProgress class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 7/12/2012 21:52'!
enabled
	"Answer if HTTPProgress should be signalled.
	The default is false."
	
	^ self value
		ifNil: [ false ]
		ifNotNil: [ :value | value ]! !

!ZnSimplifiedClientTransactionEvent commentStamp: 'SvenVanCaekenberghe 6/16/2014 15:18'!
ZnSimplifiedClientTransactionEvent is a ZnClientLogEvent that notes the completion of a client side HTTP transaction (request/response). Only a limited number of simpler data is held. ZnClientTransactionEvent contains much more detailed data.

Instance Variables
	method: HTTP verb
	url: ZnUrl requested
	response:	numeric response code
	size: number of bytes in response
	duration: milliseconds

ZnSimplifiedClientTransactionEvent is ideal for classic HTTP logging with little overhead through its default string representation.!
!ZnSimplifiedClientTransactionEvent methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 6/12/2014 19:37'!
initialize
	super initialize.
	duration := 0! !

!ZnSimplifiedClientTransactionEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 16:06'!
size
	^ size! !

!ZnSimplifiedClientTransactionEvent methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 6/12/2014 19:40'!
request: aZnRequest
	method := aZnRequest method.
	url := aZnRequest url! !

!ZnSimplifiedClientTransactionEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/12/2014 19:38'!
method
	^ method! !

!ZnSimplifiedClientTransactionEvent methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 6/12/2014 19:41'!
requestDuration: requestDuration
	duration := duration + requestDuration ! !

!ZnSimplifiedClientTransactionEvent methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 6/12/2014 19:44'!
response: aZnResponse
	response := aZnResponse code.
	aZnResponse hasEntity
		ifTrue: [ size := aZnResponse entity contentLength ]! !

!ZnSimplifiedClientTransactionEvent methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 6/12/2014 19:41'!
responseDuration: responseDuration
	duration := duration + responseDuration ! !

!ZnSimplifiedClientTransactionEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/12/2014 19:38'!
url
	^ url! !

!ZnSimplifiedClientTransactionEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/12/2014 19:39'!
responseCode
	^ response! !

!ZnSimplifiedClientTransactionEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/12/2014 19:38'!
duration
	^ duration! !

!ZnSimplifiedClientTransactionEvent methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 6/30/2014 17:06'!
printContentsOn: stream
	super printContentsOn: stream.
	stream space; nextPutAll: method.
	stream space.
	url printPathQueryFragmentOn: stream.
	stream space; print: response.
	size ifNotNil: [ 
		stream space; print: size; nextPut: $B ].
	stream space; print: duration; nextPutAll: 'ms'! !

!ZnSimplifiedServerTransactionEvent commentStamp: 'SvenVanCaekenberghe 6/16/2014 15:20'!
ZnSimplifiedServerTransactionEvent is a ZnServerLogEvent that notes the completion of a served side HTTP transaction (request/response). Only a limited number of simpler data is held. ZnServerTransactionEvent contains much more detailed data.

Instance Variables
	method: HTTP verb
	url: ZnUrl requested
	response:	numeric response code
	size: number of bytes in response
	duration: milliseconds

ZnSimplifiedServerTransactionEvent is ideal for classic HTTP logging with little overhead through its default string representation.
!
!ZnSimplifiedServerTransactionEvent methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 6/13/2014 16:56'!
timing: timing
	duration := timing totalDuration ! !

!ZnSimplifiedServerTransactionEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 16:58'!
size
	^ size! !

!ZnSimplifiedServerTransactionEvent methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 6/13/2014 16:57'!
request: aZnRequest
	method := aZnRequest method.
	url := aZnRequest url! !

!ZnSimplifiedServerTransactionEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 16:58'!
method
	^ method! !

!ZnSimplifiedServerTransactionEvent methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 6/13/2014 16:57'!
response: aZnResponse
	response := aZnResponse code.
	aZnResponse hasEntity
		ifTrue: [ size := aZnResponse entity contentLength ]! !

!ZnSimplifiedServerTransactionEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 16:58'!
url
	^ url! !

!ZnSimplifiedServerTransactionEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 16:58'!
responseCode
	^ response! !

!ZnSimplifiedServerTransactionEvent methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 6/13/2014 16:58'!
duration
	^ duration! !

!ZnSimplifiedServerTransactionEvent methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 6/30/2014 17:06'!
printContentsOn: stream
	super printContentsOn: stream.
	stream space; nextPutAll: method.
	stream space.
	url printPathQueryFragmentOn: stream.
	stream space; print: response.
	size ifNotNil: [ 
		stream space; print: size; nextPut: $B ].
	stream space; print: duration; nextPutAll: 'ms'! !

!ZnSingleThreadedServer commentStamp: '<historical>'!
I am ZnSingleThreadedServer.
I can be customized with a delegate (#handleRequest:) and an authenticator (#authenticateRequest:do:).

  ZnSingleThreadedServer startDefaultOn: 1701.
  ZnSingleThreadedServer default authenticator: (ZnBasicAuthenticator username: 'foo' password: 'secret').
  ZnClient new username: 'foo' password: 'secret'; get: 'http://localhost:1701'.

I use ZnDefaultServerDelegate when no other delegate is set.
I am single threaded, I run in a single process.
I close connections after each request/response cycle.

Part of Zinc HTTP Components.!
!ZnSingleThreadedServer methodsFor: 'private logging' stamp: 'SvenVanCaekenberghe 6/13/2014 21:54'!
logServerHandlerError: exception
	^ (self newLogEvent: ZnServerHandlerErrorEvent)
		exception: exception;
		emit! !

!ZnSingleThreadedServer methodsFor: 'private' stamp: 'SvenVanCaekenberghe 6/13/2014 13:31'!
noteAcceptWaitTimedOut
	"The accept wait on a server socket timed out (see #acceptWaitTimeout).
	This can be used as an opportunity to do some periodic tasks."
	
	self periodicTasks! !

!ZnSingleThreadedServer methodsFor: 'constants' stamp: 'SvenVanCaekenberghe 12/31/2012 16:08'!
acceptWaitTimeout
	"How many seconds to wait for a server socket listening for an accept ?"
	
	^ 300! !

!ZnSingleThreadedServer methodsFor: 'logging' stamp: 'SvenVanCaekenberghe 6/13/2014 10:20'!
loggingOn
	"Turn full logging on - generate all log events"
	
	self logLevel: 3! !

!ZnSingleThreadedServer methodsFor: 'private logging' stamp: 'SvenVanCaekenberghe 6/13/2014 16:54'!
logServerTransactionRequest: request response: response timing: timing
	| logEventClass |
	logLevel < 1 ifTrue: [ ^ nil ].
	logEventClass := logLevel = 1
		ifTrue: [ ZnSimplifiedServerTransactionEvent ]
		ifFalse: [ ZnServerTransactionEvent ].
	^ (self newLogEvent: logEventClass)
		request: request;
		response: response;
		timing: timing;
		emit! !

!ZnSingleThreadedServer methodsFor: 'request handling' stamp: 'SvenVanCaekenberghe 6/13/2014 16:44'!
readRequest: stream timing: timing
	"Read a request from stream.
	We add a virtual header containing the remote IP address of the client"

	| request initialMilliseconds |
	initialMilliseconds := Time millisecondClockValue.
	request := self withMaximumEntitySizeDo: [ self reader value: stream ].
	request headers 
		at: ZnConstants remoteAddressHeader
		put: (ZnNetworkingUtils ipAddressToString: stream socket remoteAddress).
	timing requestDuration:  (self logRequestRead: request started: initialMilliseconds).
	^ request! !

!ZnSingleThreadedServer methodsFor: 'private' stamp: 'SvenVanCaekenberghe 6/13/2014 13:30'!
closeDelegate
	self delegate
		ifNotNil: [ :delegate | 
			(delegate respondsTo: #close)
				ifTrue: [ delegate close ] ]! !

!ZnSingleThreadedServer methodsFor: 'request handling' stamp: 'SvenVanCaekenberghe 6/13/2014 16:46'!
handleRequest: request timing: timing
	"Handle request and return a response.
	Do logging and timing. Set a dynamic variable referencing the server.
	If necessary do session management in the response."

	| response initialMilliseconds |
	initialMilliseconds := Time millisecondClockValue.
	ZnCurrentServerSession value: nil.
	response := self handleRequestProtected: request.
	request method = #HEAD
		ifTrue: [ response clearEntity ].
	timing handlerDuration: (self logRequest: request response: response handledStarted: initialMilliseconds).
	ZnCurrentServerSession value 
		ifNotNil: [ :session | self sessionManager setSession: session in: response ].
	^ response! !

!ZnSingleThreadedServer methodsFor: 'public' stamp: 'SvenVanCaekenberghe 6/13/2014 11:00'!
stop: unregister
	"Stop me. I will stop listening on my port for incoming HTTP connections.
	If unregister is true, unregister me from the list of managed instances.
	Does nothing when I am not running"
	
	self isRunning ifFalse: [ ^ self ].
	process terminate. 
	process := nil.
	unregister ifTrue: [ self unregister ].
	self closeDelegate.
	self logStopped! !

!ZnSingleThreadedServer methodsFor: 'private' stamp: 'SvenVanCaekenberghe 9/5/2012 12:49'!
withMaximumEntitySizeDo: block
	^ ZnMaximumEntitySize value
		ifNil: [
			ZnMaximumEntitySize 
				value: self maximumEntitySize  
				during: [ ^ block value ] ]
		ifNotNil: [ 
			block value ]! !

!ZnSingleThreadedServer methodsFor: 'private logging' stamp: 'SvenVanCaekenberghe 2/11/2015 15:28'!
logConnectionAccepted: socket
	logLevel < 3 ifTrue: [ ^ nil ].
	^ (self newLogEvent: ZnConnectionAcceptedEvent)
		address: ([ socket remoteAddress ] on: Error do: [ nil ]);
		emit! !

!ZnSingleThreadedServer methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/15/2010 21:24'!
isListening
	"Return true when I have a valid server socket listening at the correct port"
	
	^ self serverSocket notNil
		and: [ self serverSocket isValid and: [ self serverSocket localPort = self port ] ]! !

!ZnSingleThreadedServer methodsFor: 'private logging' stamp: 'SvenVanCaekenberghe 6/13/2014 16:37'!
logRequest: request response: response handledStarted: initialMilliseconds
	^ logLevel < 3
		ifTrue: [ Time millisecondsSince: initialMilliseconds ]
		ifFalse: [ 
			(self newLogEvent: ZnRequestResponseHandledEvent)
				request: request;
				response: response;
				duration: (Time millisecondsSince: initialMilliseconds);
				emit;
				duration ]! !

!ZnSingleThreadedServer methodsFor: 'private logging' stamp: 'SvenVanCaekenberghe 6/13/2014 16:35'!
logRequestRead: request started: initialMilliseconds
	^ logLevel < 3
		ifTrue: [ Time millisecondsSince: initialMilliseconds ]
		ifFalse: [ 
			(self newLogEvent: ZnRequestReadEvent)
				request: request;
				duration: (Time millisecondsSince: initialMilliseconds);
				emit;
				duration ]! !

!ZnSingleThreadedServer methodsFor: 'private logging' stamp: 'SvenVanCaekenberghe 6/13/2014 16:17'!
logStarted
	logLevel < 1 ifTrue: [ ^ nil ].
	^ (self newLogEvent: ZnServerStartedEvent)
		description: self serverProcessName;
		emit! !

!ZnSingleThreadedServer methodsFor: 'initialization' stamp: 'MarcusDenker 10/5/2014 18:05'!
initialize
	self loggingOn ! !

!ZnSingleThreadedServer methodsFor: 'request handling' stamp: 'SvenVanCaekenberghe 12/10/2010 16:00'!
listenLoop
	"We create a listening Socket, then wait for a connection.
	After each connection we also check that the listening Socket is still valid 
	- if not we just make a recursive call to this method to start over."

	self initializeServerSocket.
	[ [ 
		serverSocket isValid
			 ifFalse: [
				"will trigger #ifCurtailed: block and destroy socket"
				^ self listenLoop ].
		self serveConnectionOn: serverSocket ] repeat ]

		ifCurtailed: [ self releaseServerSocket ]! !

!ZnSingleThreadedServer methodsFor: 'private logging' stamp: 'SvenVanCaekenberghe 6/13/2014 21:59'!
logServerReadError: exception
	logLevel < 3 ifTrue: [ ^ nil ].
	^ (self newLogEvent: ZnServerReadErrorEvent)
		exception: exception;
		emit! !

!ZnSingleThreadedServer methodsFor: 'request handling' stamp: 'SvenVanCaekenberghe 5/19/2013 21:12'!
augmentResponse: response forRequest: request
	"Our handler has produced response for request, manipulate the response before writing it"
	
	(self useGzipCompressionAndChunking and: [ response contentType isBinary not ])
		ifTrue: [ 
			(request acceptsEncodingGzip and: [ response hasContentEncoding not ]) 
				ifTrue: [ response setContentEncodingGzip ].
			response hasTransferEncoding
				ifFalse: [ response setTransferEncodingChunked ] ]! !

!ZnSingleThreadedServer methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 1/10/2013 15:17'!
printOn: stream
	super printOn: stream.
	stream nextPut: $(.
	stream nextPutAll: (self isRunning ifTrue: [ 'running' ] ifFalse: [ 'stopped' ]).
	self port ifNotNil: [ :port | stream space; print: port ].
	self bindingAddress ifNotNil: [ :bindingAddress | stream space; print: bindingAddress ].
	stream nextPut: $)! !

!ZnSingleThreadedServer methodsFor: 'public' stamp: 'SvenVanCaekenberghe 6/13/2014 11:00'!
start
	"Start me. I will start listening on my port for incoming HTTP connections.
	If I am running, I will first stop and thus effectively restart"
	
	self stop.
	self class default = self ifTrue: [ self register ].
	process := [ [ self listenLoop ] repeat ]
		forkAt: Processor highIOPriority 
		named: self serverProcessName.
	self logStarted.
! !

!ZnSingleThreadedServer methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/10/2010 13:57'!
isRunning
	"Return true when I am running"
	
	^ self process notNil and: [ self serverSocket notNil ]! !

!ZnSingleThreadedServer methodsFor: 'request handling' stamp: 'SvenVanCaekenberghe 6/13/2014 21:55'!
handleRequestProtected: request
	"Handle request and return a response.
	If a Smalltalk Error is thrown, return a HTTP Server Error response."

	^ [ self authenticateAndDelegateRequest: request ]
		on: Error
		do: [ :exception | 
			self debugMode
				ifTrue: [ exception pass ]
				ifFalse: [
					self logServerHandlerError: exception.
					ZnResponse serverError: exception printString ] ]! !

!ZnSingleThreadedServer methodsFor: 'request handling' stamp: 'SvenVanCaekenberghe 6/13/2014 13:42'!
serveConnectionOn: listeningSocket
	"We wait up to acceptWaitTimeout seconds for an incoming connection.
	If we get one we wrap it in a SocketStream and #executeOneRequestResponseOn: on it.
	We do not fork a worker thread/process but stay in the current one for just one request/response cycle."

	| stream socket |
	socket := listeningSocket waitForAcceptFor: self acceptWaitTimeout.
	socket ifNil: [ ^ self noteAcceptWaitTimedOut ].
	stream := self socketStreamOn: socket.
	[ 
	[ self executeOneRequestResponseOn: stream ]
		ensure: [ 
			self logConnectionClosed: stream.
			stream close ] ]
		ifCurtailed: [ 
			socket destroy ]! !

!ZnSingleThreadedServer methodsFor: 'request handling' stamp: 'SvenVanCaekenberghe 6/13/2014 16:47'!
executeOneRequestResponseOn: stream
	"Execute one single HTTP request / response cycle on stream in 3 steps:
	#readRequest: #handleRequest: and #writeResponse:on:
	Indicate that we intend to close the connection afterwards"

	| request response timing|
	ZnCurrentServer
		value: self
		during: [ 
			timing := ZnServerTransactionTiming new.
			request := self readRequest: stream timing: timing.
			response := self handleRequest: request timing: timing.
			response setConnectionClose.
			self writeResponse: response on: stream timing: timing.
			self logServerTransactionRequest: request response: response timing: timing ]! !

!ZnSingleThreadedServer methodsFor: 'private logging' stamp: 'SvenVanCaekenberghe 2/11/2015 15:29'!
logConnectionClosed: socketStream
	logLevel < 3 ifTrue: [ ^ nil ].
	socketStream socket ifNil: [ ^ nil ].
	^ (self newLogEvent: ZnServerConnectionClosedEvent)
		address: ([ socketStream socket remoteAddress] on: Error do: [ nil ]);
		emit! !

!ZnSingleThreadedServer methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/13/2010 16:42'!
serverProcessName
	^ String streamContents: [ :stream |
		stream nextPutAll: self class name; nextPutAll: ' HTTP port '; print: self port ]! !

!ZnSingleThreadedServer methodsFor: 'private logging' stamp: 'SvenVanCaekenberghe 6/16/2014 11:39'!
logServerGeneric: subject
	^ (self newLogEvent: ZnServerGenericLogEvent)
		subject: subject;
		emit! !

!ZnSingleThreadedServer methodsFor: 'request handling' stamp: 'SvenVanCaekenberghe 6/13/2014 16:45'!
writeResponse: response on: stream timing: timing
	"Write response to stream and flush the stream"
	
	| initialMilliseconds |
	initialMilliseconds := Time millisecondClockValue.
	response writeOn: stream.
	stream flush.
	timing responseDuration: (self logResponseWritten: response started: initialMilliseconds)  ! !

!ZnSingleThreadedServer methodsFor: 'request handling' stamp: 'SvenVanCaekenberghe 1/10/2013 15:13'!
authenticateRequest: request do: block
	"Validate request and execute block.
	When our authenticator is not nil, pass the responsability"

	^ self authenticator
		ifNil: [ block value ]
		ifNotNil: [ :authenticator | authenticator authenticateRequest: request do: block ]! !

!ZnSingleThreadedServer methodsFor: 'private logging' stamp: 'SvenVanCaekenberghe 6/13/2014 21:59'!
logServerWriteError: exception
	logLevel < 3 ifTrue: [ ^ nil ].
	^ (self newLogEvent: ZnServerWriteErrorEvent)
		exception: exception;
		emit! !

!ZnSingleThreadedServer methodsFor: 'private' stamp: 'SvenVanCaekenberghe 2/11/2015 15:34'!
releaseServerSocket
	"Release our server socket"
	
	| address port |
	serverSocket ifNil: [ ^ self ].
	address := [ serverSocket address ] on: Error do: [ nil ].
	port := [ serverSocket port ]on: Error do: [ nil ].
	(Delay forMilliseconds: 10) wait.
	serverSocket destroy.
	serverSocket := nil.
	self logServerSocketReleasedAddress: address port: port ! !

!ZnSingleThreadedServer methodsFor: 'private logging' stamp: 'SvenVanCaekenberghe 6/13/2014 16:40'!
logResponseWritten: response started: initialMilliseconds
	^ logLevel < 3
		ifTrue: [ Time millisecondsSince: initialMilliseconds ]
		ifFalse: [ 
			(self newLogEvent: ZnResponseWrittenEvent)
				response: response;
				duration: (Time millisecondsSince: initialMilliseconds);
				emit;
				duration ]! !

!ZnSingleThreadedServer methodsFor: 'private' stamp: 'SvenVanCaekenberghe 11/11/2012 20:07'!
periodicTasks
	"Every #acceptWaitTimeout seconds this method is called.
	Note that during this time the server is not actively listening for connections."
	
	sessionManager ifNotNil: [ sessionManager cleanupInvalidSessions ]! !

!ZnSingleThreadedServer methodsFor: 'private logging' stamp: 'SvenVanCaekenberghe 6/13/2014 10:53'!
newLogEvent: logEventClass
	^ logEventClass new
		serverId: self route;
		yourself! !

!ZnSingleThreadedServer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 7/1/2011 14:07'!
onRequestRespond: block
	"Convenience method to quickly set up a delegate.
	On any incoming request, block will be executed with the request 
	as argument to produce a valid response."
	
	self delegate: (ZnValueDelegate with: block)  ! !

!ZnSingleThreadedServer methodsFor: 'private' stamp: 'SvenVanCaekenberghe 6/13/2014 11:44'!
socketStreamOn: socket
	self logConnectionAccepted: socket.
	^ ZnNetworkingUtils socketStreamOn: socket! !

!ZnSingleThreadedServer methodsFor: 'private logging' stamp: 'SvenVanCaekenberghe 6/13/2014 16:17'!
logStopped
	logLevel < 1 ifTrue: [ ^ nil ].
	^ (self newLogEvent: ZnServerStoppedEvent)
		description: self serverProcessName;
		emit! !

!ZnSingleThreadedServer methodsFor: 'request handling' stamp: 'SvenVanCaekenberghe 1/10/2013 15:12'!
authenticateAndDelegateRequest: request
	"Handle request and return a response.
	If we have a delegate, pass the responsability.
	If we have no delegate, we return a page not found.
	Make sure to pass via our authenticator."

	^ self
		authenticateRequest: request
		do: [ 
			self delegate
				ifNil: [ ZnResponse notFound: request uri ]
				ifNotNil: [ :delegate | delegate handleRequest: request ] ]! !

!ZnSingleThreadedServer methodsFor: 'logging' stamp: 'SvenVanCaekenberghe 6/16/2014 14:59'!
logToTranscript
	"Setup logging to the Transcript.
	If logging was completely off, turn it on"

	logLevel isZero ifTrue: [ self loggingOn ].
	ZnLogEvent logToTranscript ! !

!ZnSingleThreadedServer methodsFor: 'private logging' stamp: 'SvenVanCaekenberghe 6/13/2014 16:17'!
logServerSocketReleasedAddress: address port: port
	logLevel < 1 ifTrue: [ ^ nil ].
	^ (self newLogEvent: ZnServerSocketReleasedEvent)
		address: address;
		port: port;
		emit! !

!ZnSingleThreadedServer methodsFor: 'logging' stamp: 'SvenVanCaekenberghe 6/13/2014 10:20'!
loggingOff
	"Turn logging completely off - do not generate log events."
	
	self logLevel: 0! !

!ZnSingleThreadedServer methodsFor: 'private logging' stamp: 'SvenVanCaekenberghe 2/11/2015 15:31'!
logServerSocketBound
	logLevel < 1 ifTrue: [ ^ nil ].
	^ (self newLogEvent: ZnServerSocketBoundEvent)
		address: ([ serverSocket address ] on: Error do: [ nil ]);
		port: ([ serverSocket port ] on: Error do: [ nil ]);
		emit! !

!ZnSingleThreadedServer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/10/2010 13:54'!
serverSocket
	"Return the server socket that I am using.
	Will be nil when I am not running"
	
	^ serverSocket! !

!ZnSingleThreadedServer methodsFor: 'logging' stamp: 'SvenVanCaekenberghe 6/13/2014 10:19'!
logLevel: integer
	"Set the log level to integer.
	0 - no logging
	1 - simplified transaction logging
	2 - detailed transaction logging
	3 - log everything"
	
	logLevel := integer! !

!ZnSingleThreadedServer methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/10/2010 13:54'!
process
	"Return the process that is running my main listening loop.
	Will be nil when I am not running"
	
	^ process! !

!ZnSingleThreadedServer methodsFor: 'private' stamp: 'SvenVanCaekenberghe 6/13/2014 11:14'!
initializeServerSocket
	"Set up a new server socket and listen on it"
	
	serverSocket := self bindingAddress
		ifNil: [ ZnNetworkingUtils serverSocketOn: self port ]
		ifNotNil: [ ZnNetworkingUtils serverSocketOn: self port interface: self bindingAddress ].
	self logServerSocketBound! !

!ZnSingleThreadedServer class methodsFor: 'class initialization' stamp: 'SvenVanCaekenberghe 4/20/2011 12:12'!
initialize
	Default := nil! !

!ZnSingleThreadedServer class methodsFor: 'public' stamp: 'SvenVanCaekenberghe 12/22/2011 11:37'!
startOn: portNumber
	"Instanciate and return a new listener on a given port and start listening."

	^ (self on: portNumber) 
		start;
		yourself! !

!ZnSingleThreadedServer class methodsFor: 'public' stamp: 'SvenVanCaekenberghe 12/22/2011 11:59'!
stopDefault
	"Stop and unregister the Default instance, if any, and clear it.
	Return the stopped instance, if any."
	
	| server |
	(server := Default) ifNotNil: [ 
		Default stop.  
		Default := nil ].
	^ server! !

!ZnSingleThreadedServer class methodsFor: 'public' stamp: 'SvenVanCaekenberghe 12/22/2011 11:30'!
default
	"Return the default instance that we manage.
	Note that this is a class instance variable."
	
	^ Default! !

!ZnSingleThreadedServer class methodsFor: 'public' stamp: 'SvenVanCaekenberghe 12/22/2011 11:34'!
on: aNumber
	"Instantiate and return a new listener on a given port,
	send #start to it to start listening."

	^ self new 
		port: aNumber; 
		yourself! !

!ZnSingleThreadedServer class methodsFor: 'public' stamp: 'SvenVanCaekenberghe 12/22/2011 11:59'!
defaultOn: portNumber
	"Return the default instance on a given port,
	Keep a reference to it in a class instance variable.
	If there was no previous default instance, create a new one.
	If there was a previous default instance, reuse it:
	if it was running stop it, change the port if necessary."

	^ Default 
		ifNil: [
			Default := self on: portNumber ] 
		ifNotNil: [ 
			Default stop; port: portNumber; yourself ]! !

!ZnSingleThreadedServer class methodsFor: 'public' stamp: 'SvenVanCaekenberghe 12/22/2011 12:04'!
startDefaultOn: portNumber
	"Start and return the default instance on a given port.
	Keep a reference to it in a class instance variable.
	If there was no previous default instance, create a new one.
	If there was a previous default instance, reuse it:
	if it was running stop and start it, effectively restarting it.
	Change the port if necessary.
	Starting the default server will register it automatically."

	^ (self defaultOn: portNumber) 
		start; 
		yourself! !

!ZnStaticFileServerDelegate commentStamp: '<historical>'!
I am ZnStaticFileServerDelegate.
I am a simple proof of concept implementation of a web server serving static files.
I handle urls with an optional prefix as requests for files in a directory.
I serve index.html or index.htm when a directory is requested and these files exist.
I do a redirect when a path that is not does not end with a / refers to directory.
I function as a delegate for ZnServer.

ZnServer startDefaultOn: 1701.
ZnServer default delegate: ((ZnStaticFileServerDelegate new) 
									prefixFromString: 'apple/macosx'; 
									directory: '/Library/WebServer/Documents' asFileReference; 
									yourself).

Part of Zinc HTTP Components.!
!ZnStaticFileServerDelegate methodsFor: 'private' stamp: 'SvenVanCaekenberghe 7/3/2012 14:43'!
indexFileIn: fileDirectory
	#( 'index.html' 'index.htm' ) do: [ :each | | file |
			(file := fileDirectory / each) exists
				ifTrue: [ 
					^ file fullName ] ].
	^ nil
! !

!ZnStaticFileServerDelegate methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/26/2011 11:09'!
prefixFromString: string
	"Set the path prefix under which I should be serving files to string,
	interpreting each /-separated token as a path element"

	self prefix: (string findTokens: '/')! !

!ZnStaticFileServerDelegate methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/14/2012 09:39'!
mimeTypeExpirations: aDictionary
	"Set the mapping of ZnMimeTypes to their expiration time in seconds to aDictionary.
	Missing entries will have no expiration time."

	mimeTypeExpirations := aDictionary! !

!ZnStaticFileServerDelegate methodsFor: 'private' stamp: 'SvenVanCaekenberghe 4/26/2011 12:35'!
directoryRedirectFor: uri
	| directoryUri |
	directoryUri := uri copy addPathSegment: #/.  
	^ ZnResponse redirect: directoryUri ! !

!ZnStaticFileServerDelegate methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/14/2012 09:41'!
maxAgeFor: aMimeType
	| expiration |
	expiration := self mimeTypeExpirations at: aMimeType ifAbsent: [ ^ nil ].
	^ 'max-age=', expiration asString! !

!ZnStaticFileServerDelegate methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 7/15/2013 10:48'!
directory
	"The directory whose files I am serving"
	
	^ directory ! !

!ZnStaticFileServerDelegate methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/26/2011 12:46'!
prefix
	"The path prefix collection under which I am serving files"
	
	^ prefix ifNil: [ prefix := #() ]! !

!ZnStaticFileServerDelegate methodsFor: 'private' stamp: 'SvenVanCaekenberghe 7/15/2013 11:39'!
responseForFile: filename fromRequest: aRequest
	| file entry size time mimeType fileStream entity response modified |
	file := filename asFileReference.
	entry := file entry.
	size := entry size.
	time := entry modificationTime.
	modified := true.
	aRequest headers
		at: 'If-Modified-Since'
		ifPresent: [ modified := time > (ZnUtils parseHttpDate: (aRequest headers at: 'If-Modified-Since')) ].
	modified
		ifTrue: [ 
			mimeType := ZnMimeType forFilenameExtension: file extension.
			fileStream := file readStream.
			fileStream binary.
			(entity := ZnStreamingEntity type: mimeType length: size) 
				stream: fileStream.
			(response := ZnResponse ok: entity) 
				headers at: 'Modification-Date' put: (ZnUtils httpDate: time).
			(self maxAgeFor: mimeType) 
				ifNotNil: [ :maxAge | response headers at: 'Cache-Control' put: maxAge ].
			(self expirationDateFor: mimeType)
				ifNotNil: [ :expirationDate | response headers at: 'Expires' put: expirationDate ] ]
		ifFalse: [ response := ZnResponse notModified ].
	^ response! !

!ZnStaticFileServerDelegate methodsFor: 'private' stamp: 'SvenVanCaekenberghe 1/14/2013 11:37'!
redirectNeededFor: uri actualFilename: actualFilename
	uri isDirectoryPath ifTrue: [ ^ false ].  
	^ (actualFilename endsWith: uri lastPathSegment) not! !

!ZnStaticFileServerDelegate methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 4/26/2011 11:08'!
prefix: orderedCollection
	"Set the path prefix under which I should be serving files to orderedCollection containing path elements"
	
	prefix := orderedCollection! !

!ZnStaticFileServerDelegate methodsFor: 'public' stamp: 'SvenVanCaekenberghe 8/22/2012 14:41'!
value: request
	"I implement the generic #value: message as equivalent to #handleRequest:"
	
	^ self handleRequest: request! !

!ZnStaticFileServerDelegate methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 7/15/2013 10:48'!
directory: fileDirectory
	"Set the directory whose files I should be serving"

	directory := fileDirectory! !

!ZnStaticFileServerDelegate methodsFor: 'private' stamp: 'SvenVanCaekenberghe 7/3/2012 16:38'!
actualFilenameFor: uri
	| subElements subDir entry |
	(uri isEmpty and: [ self prefix isEmpty ]) ifTrue: [ ^ self indexFileIn: self directory ].
	(self prefix isEmpty or: [ uri isEmpty not and: [ uri pathSegments beginsWith: self prefix ] ]) ifFalse: [ ^ nil ].
	subElements := (uri pathSegments allButFirst: self prefix size) reject: [ :each | each = #/ ].
	subDir := subElements allButLast inject: self directory into: [ :parent :sub | | file |
		(file := parent / sub) exists
			ifTrue: [ file ]
			ifFalse: [ ^ nil ] ]. 
	subElements isEmpty
		ifTrue: [ entry := subDir entry ] 
		ifFalse: [ | file |
			 (file := subDir / subElements last) exists 
				ifTrue: [ entry := file entry ] 
				ifFalse: [ ^ nil ] ].
	^ entry isDirectory 
		ifTrue: [ self indexFileIn: entry reference ]
		ifFalse: [ entry reference fullName ]! !

!ZnStaticFileServerDelegate methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/14/2012 09:39'!
mimeTypeExpirations
	"Return a dictionary mapping ZnMimeTypes to their expiration time in seconds.
	Missing entries will have no expiration time."

	^ mimeTypeExpirations ifNil: [ mimeTypeExpirations := Dictionary new ]! !

!ZnStaticFileServerDelegate methodsFor: 'public' stamp: 'PaulDeBruicker 5/12/2012 09:56'!
handleRequest: request
	"Server delegate entry point"

	| actualFilename |
	(#(#GET #HEAD) includes: request method)
		ifFalse: [ ^ ZnResponse methodNotAllowed: request ].
	actualFilename := self actualFilenameFor: request uri.
	^ actualFilename notNil
		ifTrue: [ 
			(self redirectNeededFor: request uri actualFilename: actualFilename)
				ifTrue: [ self directoryRedirectFor: request uri ]
				ifFalse: [ self responseForFile: actualFilename fromRequest: request ] ]
		ifFalse: [ ZnResponse notFound: request uri ]! !

!ZnStaticFileServerDelegate methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/14/2012 10:30'!
expirationDateFor: aMimeType
	| expiration |
	expiration := self mimeTypeExpirations at: aMimeType ifAbsent: [ ^ nil ].
	^ ZnUtils httpDate: (DateAndTime now asUTC + expiration seconds)! !

!ZnStaticFileServerDelegate class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/14/2012 10:26'!
defaultMimeTypeExpirations
	"Return a default dictionary mapping ZnMimeTypes to their expiration time in seconds.
	Missing entries will have no expiration time."

	| dict |
	dict := Dictionary new.
	dict at: ZnMimeType textCss put: 30 days asSeconds.
	dict at: ZnMimeType textJavascript put: 30 days asSeconds.
	dict at: ZnMimeType textPlain put: 30 days asSeconds.
	dict at: ZnMimeType textHtml put: 30 days asSeconds.
	dict at: ZnMimeType imageGif put: 30 days asSeconds.
	dict at: ZnMimeType imageJpeg put: 30 days asSeconds.
	dict at: ZnMimeType imagePng put: 30 days asSeconds.
	dict at: ZnMimeType applicationJavascript put: 30 days asSeconds.
	^ dict! !

!ZnStaticFileServerDelegateTests methodsFor: 'tests' stamp: 'SvenVanCaekenberghe 3/2/2014 19:07'!
testBasicGetWide
	self withServerDo: [ :server | | client |
		(client := ZnClient new) 
			beOneShot;
			url: server localUrl;
			addPath: #('local-files' 'wide.html');
			get.
		self assert: client isSuccess.
		self assert: client response contentType = ZnMimeType textHtml.
		self assert: client contents equals: self wideHtml.
		self 
			assert: (ZnUtils parseHttpDate: (client response headers at: 'Modification-Date'))
			equals: (ZnFileSystemUtils modificationTimeFor: 'large.html') asUTC.
		self 
			assert: (ZnUtils parseHttpDate: (client response headers at: 'Expires')) > (DateAndTime now + 10 days).
		self 
			assert: (client response headers at: 'Cache-Control')
			equals: (server delegate maxAgeFor: ZnMimeType textHtml) ]! !

!ZnStaticFileServerDelegateTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 7/15/2013 14:12'!
largeHtml
	^ String streamContents: [ :out |
		out << '<html><body>'.
		out << 'Les élèves Français'.
		(1 to: 4000) do: [ :each | out print: each ] separatedBy: [ out space ]. 
		out << '</html></body>' ]! !

!ZnStaticFileServerDelegateTests methodsFor: 'tests' stamp: 'SvenVanCaekenberghe 3/2/2014 19:08'!
testBasicHead
	self withServerDo: [ :server | | client |
		(client := ZnClient new) 
			beOneShot;
			url: server localUrl;
			addPath: #('local-files' 'small.html');
			head.
		self assert: client isSuccess.
		self assert: client response contentType = ZnMimeType textHtml.
		self deny: client response hasEntity.
		self 
			assert: (ZnUtils parseHttpDate: (client response headers at: 'Modification-Date'))
			equals: (ZnFileSystemUtils modificationTimeFor: 'small.html') asUTC.
		self 
			assert: (ZnUtils parseHttpDate: (client response headers at: 'Expires')) > (DateAndTime now + 10 days).
		self 
			assert: (client response headers at: 'Cache-Control')
			equals: (server delegate maxAgeFor: ZnMimeType textHtml) ]! !

!ZnStaticFileServerDelegateTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/14/2012 10:08'!
smallHtml
	^ '<html>
<head><title>Small</title></head>
<body><h1>Small</h1><p>This is a small HTML document</p></body>
</html>
'! !

!ZnStaticFileServerDelegateTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 7/15/2013 14:16'!
wideHtml
	^ '<html><h1>Czech is in Czech {1}e{2}tina.</h1></html>' format: { 269 asCharacter. 353 asCharacter}.! !

!ZnStaticFileServerDelegateTests methodsFor: 'running' stamp: 'SvenVanCaekenberghe 7/15/2013 14:17'!
tearDown
	ZnFileSystemUtils 
		deleteIfExists: 'small.html'; 
		deleteIfExists: 'large.html'; 
		deleteIfExists: 'wide.html'
	! !

!ZnStaticFileServerDelegateTests methodsFor: 'tests' stamp: 'SvenVanCaekenberghe 3/2/2014 19:07'!
testBasicGet
	self withServerDo: [ :server | | client |
		(client := ZnClient new) 
			beOneShot;
			url: server localUrl;
			addPath: #('local-files' 'small.html');
			get.
		self assert: client isSuccess.
		self assert: client response contentType = ZnMimeType textHtml.
		self assert: client contents equals: self smallHtml.
		self 
			assert: (ZnUtils parseHttpDate: (client response headers at: 'Modification-Date'))
			equals: (ZnFileSystemUtils modificationTimeFor: 'small.html') asUTC.
		self 
			assert: (ZnUtils parseHttpDate: (client response headers at: 'Expires')) > (DateAndTime now + 10 days).
		self 
			assert: (client response headers at: 'Cache-Control')
			equals: (server delegate maxAgeFor: ZnMimeType textHtml) ]! !

!ZnStaticFileServerDelegateTests methodsFor: 'tests' stamp: 'SvenVanCaekenberghe 8/3/2012 22:47'!
testIfModifiedSinceNotModified
	self withServerDo: [ :server | | client |
		(client := ZnClient new) 
			beOneShot;
			url: server localUrl;
			addPath: #('local-files' 'small.html');
			"We have to cheat a little bit since our #setUp just created the file,
			it does not alter the semantics of what we try to test"
			setIfModifiedSince: (Date today addDays: 2);
			get.
		self assert: client response isNotModified.
		self deny: client response hasEntity ]! !

!ZnStaticFileServerDelegateTests methodsFor: 'private' stamp: 'SvenVanCaekenberghe 1/22/2014 10:16'!
withServerDo: block
	| server staticFileServerDelegate |
	server := ZnServer on: 1700 + 32 atRandom.
	[ 
		(staticFileServerDelegate := ZnStaticFileServerDelegate new)
			prefixFromString: 'local-files'; 
			directory: ZnFileSystemUtils defaultDirectory;
			mimeTypeExpirations: ZnStaticFileServerDelegate defaultMimeTypeExpirations. 
		server delegate: staticFileServerDelegate.
		server start.
		self 
			assert: server isRunning & server isListening
			description: ('Failed to start server on port {1}. Is there one already?' format: { server port }).
		block cull: server
	] 
		ensure: [ server stop ]! !

!ZnStaticFileServerDelegateTests methodsFor: 'running' stamp: 'SvenVanCaekenberghe 7/15/2013 14:16'!
setUp
	self tearDown.
	ZnFileSystemUtils
		newFileNamed: 'small.html' 
		do: [ :stream |
			stream nextPutAll: self smallHtml ].
	ZnFileSystemUtils
		newFileNamed: 'large.html' 
		do: [ :stream |
			stream nextPutAll: self largeHtml ].
	ZnFileSystemUtils
		newFileNamed: 'wide.html' 
		do: [ :stream |
			stream nextPutAll: self wideHtml ].! !

!ZnStaticFileServerDelegateTests methodsFor: 'tests' stamp: 'SvenVanCaekenberghe 3/2/2014 19:07'!
testBasicGetLarge
	self withServerDo: [ :server | | client |
		(client := ZnClient new) 
			beOneShot;
			url: server localUrl;
			addPath: #('local-files' 'large.html');
			get.
		self assert: client isSuccess.
		self assert: client response contentType = ZnMimeType textHtml.
		self assert: client contents equals: self largeHtml.
		self 
			assert: (ZnUtils parseHttpDate: (client response headers at: 'Modification-Date'))
			equals: (ZnFileSystemUtils modificationTimeFor: 'large.html') asUTC.
		self 
			assert: (ZnUtils parseHttpDate: (client response headers at: 'Expires')) > (DateAndTime now + 10 days).
		self 
			assert: (client response headers at: 'Cache-Control')
			equals: (server delegate maxAgeFor: ZnMimeType textHtml) ]! !

!ZnStatusLine commentStamp: '<historical>'!
I am an HTTP Status Line.
I consist of an HTTP protocol version, an integer HTTP status code and an HTTP reason string.
I can be used for generating and parsing.

Part of Zinc HTTP Components.!
!ZnStatusLine methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/6/2010 15:49'!
code
	^ code! !

!ZnStatusLine methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 5/22/2013 10:33'!
hash
	^ (self code hash bitXor: self version hash) bitXor: self reason hash! !

!ZnStatusLine methodsFor: 'accessing' stamp: 'DamienPollet 8/4/2011 14:04'!
code: integer
	(ZnConstants httpStatusCodes includesKey: integer) 
		ifFalse: [ 
			(ZnUnknownHttpStatusCode code: integer) signal ].
	code := integer! !

!ZnStatusLine methodsFor: 'initialize-release' stamp: 'DamienPollet 8/4/2011 14:04'!
readFrom: stream
	| line lineStream httpCode |
	line := (ZnLineReader on: stream) nextLine.
	lineStream := line readStream.
	self version: (lineStream upTo: Character space).
	httpCode := lineStream upTo: Character space.
	httpCode := Integer readFrom: httpCode ifFail: [ (ZnUnknownHttpStatusCode code: code) signal ].
	self code: httpCode.
	self reason: (lineStream upToEnd)
! !

!ZnStatusLine methodsFor: '*GT-InspectorExtensions-Core' stamp: 'SvenVanCaekenberghe 10/6/2014 15:19'!
gtInspectorTextIn: composite
	<gtInspectorPresentationOrder: 30>
	^ composite rubricText
		title: 'HTTP';
		format: [ String streamContents: [ :out | self writeOn: out ] ]! !

!ZnStatusLine methodsFor: 'writing' stamp: 'SvenVanCaekenberghe 12/3/2010 20:40'!
writeOn: stream
	| writeStream |
	writeStream := ZnBivalentWriteStream on: stream.
	writeStream nextPutAll: self version; space.
	self code printOn: writeStream.
	writeStream space; nextPutAll: self reason; nextPutAll: String crlf ! !

!ZnStatusLine methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 12/14/2010 10:57'!
printCodeAndReasonOn: stream
	self code notNil
		ifTrue: [
			stream print: self code; space; nextPutAll: self reason ]! !

!ZnStatusLine methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/6/2010 15:46'!
version
	^ version! !

!ZnStatusLine methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/6/2010 16:29'!
reason: string
	reason := string! !

!ZnStatusLine methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 5/22/2013 10:30'!
= other
	self class = other class ifFalse: [ ^ false ].
	^ self code = other code 
		and: [ self version = other version
			and: [ self reason = other reason ] ]! !

!ZnStatusLine methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:34'!
printOn: stream
	super printOn: stream.
	self code notNil
		ifFalse: [ ^ self ].
	stream nextPut: $(.
	self printCodeAndReasonOn: stream.
	stream nextPut: $)! !

!ZnStatusLine methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/20/2010 17:27'!
reason
	reason isNil 
		ifTrue: [ 
			reason := ZnConstants httpStatusCodes at: self code ifAbsent: [ 'Unknown Status Code' ] ].
	^ reason! !

!ZnStatusLine methodsFor: 'accessing' stamp: 'DamienPollet 8/4/2011 14:05'!
version: string
	version := ZnConstants knownHTTPVersions 
		detect: [ :each | each = string ] 
		ifNone: [ (ZnUnknownHttpVersion version: version) signal ] ! !

!ZnStatusLine class methodsFor: 'instance creation' stamp: 'NickAger 5/10/2011 09:05'!
created
	^ self code: 201! !

!ZnStatusLine class methodsFor: 'instance creation' stamp: 'NickAger 5/10/2011 09:09'!
methodNotAllowed
	^ self code: 405! !

!ZnStatusLine class methodsFor: 'instance creation' stamp: 'NickAger 5/10/2011 09:09'!
found
	^ self code: 302! !

!ZnStatusLine class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/6/2010 15:48'!
code: code
	^ self new
		code: code;
		version: ZnConstants defaultHTTPVersion;
		yourself! !

!ZnStatusLine class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/6/2010 15:47'!
readFrom: stream
	^ self new
		readFrom: stream;
		yourself! !

!ZnStatusLine class methodsFor: 'instance creation' stamp: 'NickAger 5/10/2011 09:02'!
internalServerError
	^ self code: 500! !

!ZnStatusLine class methodsFor: 'instance creation' stamp: 'NickAger 5/10/2011 08:58'!
ok
	^ self code: 200! !

!ZnStatusLine class methodsFor: 'instance creation' stamp: 'NickAger 5/10/2011 09:07'!
seeOther
	^ self code: 303! !

!ZnStatusLine class methodsFor: 'instance creation' stamp: 'NickAger 5/10/2011 08:59'!
notFound
	^ self code: 404! !

!ZnStatusLine class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 08:43'!
gtExampleForbidden
	<gtExample: 'Forbidden'>
	^ self forbidden! !

!ZnStatusLine class methodsFor: 'instance creation' stamp: 'NickAger 5/10/2011 09:00'!
badRequest
	^ self code: 400! !

!ZnStatusLine class methodsFor: 'instance creation' stamp: 'NickAger 5/10/2011 09:09'!
movedPermanently
	^ self code: 301! !

!ZnStatusLine class methodsFor: 'instance creation' stamp: 'NickAger 5/10/2011 09:08'!
notModified
	^ self code: 304! !

!ZnStatusLine class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 08:43'!
gtExampleOk
	<gtExample: 'Ok'>
	^ self ok! !

!ZnStatusLine class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 08:43'!
gtExampleNotFound
	<gtExample: 'Not Found'>
	^ self notFound! !

!ZnStatusLine class methodsFor: 'instance creation' stamp: 'NickAger 5/10/2011 09:02'!
unauthorized
	^ self code: 401! !

!ZnStatusLine class methodsFor: 'instance creation' stamp: 'NickAger 5/10/2011 09:07'!
redirect
	^ self code: 302! !

!ZnStatusLine class methodsFor: 'instance creation' stamp: 'NickAger 5/10/2011 09:10'!
forbidden
	^ self code: 403! !

!ZnStatusLine class methodsFor: 'instance creation' stamp: 'NickAger 5/10/2011 09:08'!
notImplemented
	^ self code: 501! !

!ZnStatusLineTests methodsFor: 'testing' stamp: 'NickAger 5/10/2011 09:03'!
testWriting
	| statusLine string |
	statusLine := ZnStatusLine ok.
	string := String streamContents: [ :stream | statusLine writeOn: stream ].
	self assert: string = ('HTTP/1.1 200 OK', String crlf)! !

!ZnStatusLineTests methodsFor: 'testing' stamp: 'DamienPollet 8/4/2011 14:05'!
testReadingWrongVersion2
	| string |
	string := 'HTTP/0.9 Foo OK', String crlf.
	self should: [ ZnStatusLine readFrom: string readStream ] raise: ZnUnknownHttpVersion! !

!ZnStatusLineTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/15/2010 14:09'!
testReading
	| statusLine string |
	string := 'HTTP/1.1 200 OK', String crlf.
	statusLine := ZnStatusLine readFrom: string readStream.
	self assert: statusLine code = 200.
	self assert: statusLine reason = 'OK'.
	self assert: statusLine version = ZnConstants defaultHTTPVersion ! !

!ZnStatusLineTests methodsFor: 'testing' stamp: 'DamienPollet 8/4/2011 14:04'!
testReadingWrongCode
	| string |
	string := 'HTTP/1.0 1000 OK', String crlf.
	self should: [ ZnStatusLine readFrom: string readStream ] raise: ZnUnknownHttpStatusCode ! !

!ZnStatusLineTests methodsFor: 'testing' stamp: 'DamienPollet 8/4/2011 14:05'!
testReadingWrongVersion
	| string |
	string := 'HTTP/0.9 200 OK', String crlf.
	self should: [ ZnStatusLine readFrom: string readStream ] raise: ZnUnknownHttpVersion! !

!ZnStreamingEntity commentStamp: 'SvenVanCaekenberghe 8/18/2011 14:48'!
I am ZnStreamingEntity, a concrete HTTP Entity based on a stream.
I am a ZnEntity.

When a ZnStreamingEntity is created using #readFrom: 
its content type and length are set but no body is actually read.
Instead, stream is set to a ZnLimitedReadStream that clients can/must
use to read from.

When the client is done, either all data must be read or #consumeContent must be called.
A client should normally not close the stream.

A ZnStreamingEntity can also be instanciated with an existing read stream.
During #writeOn: this stream is copied to the output stream.

Part of Zinc HTTP Components.!
!ZnStreamingEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/15/2010 17:04'!
stream 
	^ stream! !

!ZnStreamingEntity methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 7/13/2012 20:27'!
readFrom: readStream
	self contentLength isNil
		ifTrue: [ 
			self stream: readStream ]
		ifFalse: [ | limitedStream |
			limitedStream := ZnLimitedReadStream on: readStream limit: self contentLength.
			self stream: limitedStream ]! !

!ZnStreamingEntity methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/1/2011 18:25'!
isEmpty 
	"We actually don't know"
	
	^ false! !

!ZnStreamingEntity methodsFor: 'writing' stamp: 'SvenVanCaekenberghe 7/20/2012 12:01'!
writeOn: outputStream
	(self contentLength isNil or: [ self contentLength = 0 ])
		ifTrue: [ 
			ZnUtils 
				streamFrom: self stream 
				to: outputStream ]
		ifFalse: [
			ZnUtils 
				streamFrom: self stream 
				to: outputStream 
				size: self contentLength ].
	stream close! !

!ZnStreamingEntity methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 8/18/2011 12:51'!
close
	stream ifNotNil: [ 
		stream close. 
		stream := nil ]! !

!ZnStreamingEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/15/2010 17:10'!
consumeContent
	"To be improved later on using some kind of larger buffer"
	
	[ self stream atEnd ] 
		whileFalse: [ self stream next ]! !

!ZnStreamingEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/15/2010 17:04'!
stream: readStream
	stream := readStream! !

!ZnStreamingEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/25/2010 22:14'!
readStream 
	^ self stream! !

!ZnStreamingEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/31/2012 12:59'!
contents
	"Since this is a non-repeatable entity, 
	#contents will #consumeContent, 
	this can thus only be done once"
	
	^ ZnUtils readUpToEnd: self stream limit: ZnConstants maximumEntitySize! !

!ZnStreamingEntity class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/15/2010 17:13'!
readFrom: stream usingType: mimeType andLength: length
	"Create and return a new streaming entity of mimeType and length from stream.
	Clients can/must use the embedded ZnLimitedReadStream to read all content, 
	or call #consumeContent when they are done. They should not close the stream."
	
	^ (self type: mimeType length: length)
		readFrom: stream;
		yourself
! !

!ZnStreamingEntity class methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/4/2013 14:43'!
matches: mimeType
	"I have no designated mime type, I can handle all content.
	See #concreteSubclassForType: "
	
	^ false! !

!ZnStreamingEntity class methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/15/2010 19:23'!
designatedMimeType
	"I have no designated mime type, I can handle all content.
	See #concreteSubclassForType: "
	
	^ nil! !

!ZnStringEntity commentStamp: '<historical>'!
I am ZnStringEntity, a concrete HTTP Entity based on a String.
It is used to hold textual (non-binary) data.
I am a ZnEntity.

Optionally, an encoding is used to convert to and from bytes.
The default encoding it UTF-8.

Note that content length is the encoded byte count, not the number of characters in the string.

Part of Zinc HTTP Components.!
!ZnStringEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/14/2010 11:59'!
encoder
	self initializeEncoder.
	^ encoder! !

!ZnStringEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/27/2011 10:26'!
contentLength
	contentLength isNil ifTrue: [ self computeContentLength ].
	^ contentLength! !

!ZnStringEntity methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 5/22/2013 10:43'!
hash
	^ super hash bitXor: self string hash! !

!ZnStringEntity methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/14/2014 15:04'!
invalidateEncoder
	self encoder: nil! !

!ZnStringEntity methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 11/13/2013 13:53'!
readFrom: stream
	| buffer totalRead read readStream stringStream total |
	total := self contentLength.
	readStream := total ifNotNil: [ ZnLimitedReadStream on: stream limit: total ] ifNil: [ stream ].
	buffer := String new: (ZnUtils streamingBufferSize min: (total ifNil: [ ZnUtils streamingBufferSize ])).
	stringStream := nil.
	totalRead := 0.
	self initializeEncoder.
	[ readStream atEnd ] whileFalse: [
		[ read := encoder readInto: buffer startingAt: 1 count: buffer size fromStream: readStream ]
			on: ZnByteStringBecameWideString 
			do: [ :notification | 
					buffer := notification wideString.
					stringStream ifNotNil: [ | wideString position |
						position := stringStream position.
						wideString := WideString from: stringStream originalContents.
						stringStream on: wideString; setFrom: position + 1 to: position ].
					notification resume ].
		totalRead := totalRead + read.
		totalRead > ZnConstants maximumEntitySize
			ifTrue: [ ZnEntityTooLarge signal ].
		stringStream ifNil: [ 
			readStream atEnd
				ifTrue: [ ^ self string: (buffer copyFrom: 1 to: read) ]
				ifFalse: [ stringStream := (total ifNil: [ buffer species new ] ifNotNil: [ buffer species new: total ]) writeStream ] ].
		stringStream next: read putAll: buffer startingAt: 1.
		ZnUtils signalProgress: totalRead total: total ].
	self string: (stringStream ifNil: [ String new ] ifNotNil: [ stringStream contents ])! !

!ZnStringEntity methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/1/2011 17:54'!
isEmpty 
	^ self string isNil or: [ self string isEmpty ] ! !

!ZnStringEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/3/2010 15:11'!
string: aString
	(string notNil and: [ aString ~= string ]) ifTrue: [ self invalidateContentLength ].
	string := aString! !

!ZnStringEntity methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/14/2010 12:09'!
hasEncoder
	^ encoder notNil! !

!ZnStringEntity methodsFor: 'writing' stamp: 'SvenVanCaekenberghe 5/22/2013 10:25'!
writeOn: stream
	| totalWritten toWrite total  |
	self initializeEncoder.
	totalWritten := 0.
	total := string size.
	[ totalWritten < total ] whileTrue: [ 
		toWrite := ZnUtils streamingBufferSize min: (total - totalWritten).
		encoder next: toWrite putAll: string startingAt: totalWritten + 1 toStream: stream.
		totalWritten := totalWritten + toWrite.
		ZnUtils signalProgress: totalWritten total: total ]! !

!ZnStringEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/1/2010 20:57'!
string
	^ string! !

!ZnStringEntity methodsFor: '*GT-InspectorExtensions-Core' stamp: 'SvenVanCaekenberghe 10/6/2014 14:41'!
gtInspectorTextIn: composite
	<gtInspectorPresentationOrder: 30>
	composite rubricText
		title: 'Contents';
		format: self string! !

!ZnStringEntity methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/23/2013 12:27'!
computeContentLength
	self string isNil ifTrue: [ ^ self ].
	contentLength := self encoder encodedByteCountForString: string! !

!ZnStringEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/3/2010 15:11'!
encoder: anEncoding
	(encoder notNil and: [ anEncoding ~= encoder ]) ifTrue: [ self invalidateContentLength ].
	encoder := anEncoding! !

!ZnStringEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/1/2010 20:57'!
readStream
	^ self string readStream! !

!ZnStringEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 5/14/2014 15:40'!
contentType: object
	"We only allow assignment compatible with our designated mime type"
	
	| newType |
	newType := object asZnMimeType.
	contentType = newType 
		ifTrue: [ ^ self ]
		ifFalse: [ 
			newType isBinary
				ifFalse: [ 
					contentType := newType.
					self invalidateEncoder ] ]! !

!ZnStringEntity methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 5/22/2013 10:44'!
= other
	^ super = other and: [ self string = other string ]! !

!ZnStringEntity methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/14/2014 11:25'!
initializeEncoder
	| charSet newEncoder |
	self hasEncoder
		ifTrue: [ ^ self ].
	newEncoder := (charSet := contentType charSet) isNil
		ifTrue: [ ZnCharacterEncoder default ]
		ifFalse: [ 
			(ZnCharacterEncoder newForEncoding: charSet)
				beLenient;
				yourself ].
	self encoder: newEncoder! !

!ZnStringEntity methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/1/2010 20:57'!
contents
	^ self string! !

!ZnStringEntity methodsFor: 'private' stamp: 'SvenVanCaekenberghe 12/2/2010 12:20'!
invalidateContentLength
	self contentLength: nil! !

!ZnStringEntity methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 12/14/2010 11:20'!
printContentsOn: stream
	super printContentsOn: stream.
	self string notNil ifTrue: [ 
		stream space; nextPutAll: self string ]! !

!ZnStringEntity class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 08:44'!
gtExampleEmptyText
	<gtExample: 'Empty text'>
	^ self text: ''! !

!ZnStringEntity class methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/1/2010 20:58'!
designatedMimeType
	"I have no designated mime type, I can handle all non-binary content.
	See #concreteSubclassForType: "
	
	^ nil! !

!ZnStringEntity class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 08:49'!
gtExampleEmptyHtml
	<gtExample: 'Empty HTML'>
	^ self html: ''! !

!ZnStringEntity class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 08:49'!
gtExampleEmptyXml
	<gtExample: 'Empty XML'>
	^ self xml: ''! !

!ZnStringEntity class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 12/2/2010 12:22'!
html: string
	^ (self type: ZnMimeType textHtml)
		string: string;
		yourself! !

!ZnStringEntity class methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 6/4/2013 14:44'!
matches: mimeType
	"I have no designated mime type, I can handle all non-binary content.
	See #concreteSubclassForType: "
	
	^ false! !

!ZnStringEntity class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 08:49'!
gtExampleHtml
	<gtExample: 'HTML'>
	^ self html: '<p><b>Hello</b> <i>World<i></p>'! !

!ZnStringEntity class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 12/11/2011 18:12'!
xml: string
	^ (self type: ZnMimeType applicationXml)
		string: string;
		yourself! !

!ZnStringEntity class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 12/2/2010 12:22'!
text: string
	^ (self type: ZnMimeType textPlain)
		string: string;
		yourself! !

!ZnStringEntity class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 08:45'!
gtExampleText
	<gtExample: 'Text'>
	^ self text: 'Hello World'! !

!ZnStringEntity class methodsFor: '*GT-InspectorExtensions-Core' stamp: 'StefanReichhart 3/27/2015 08:49'!
gtExampleXml
	<gtExample: 'XML'>
	^ self xml: '<message>Hello World</message>'! !

!ZnTestRunnerDelegate commentStamp: '<historical>'!
I am ZnTestRunnerDelegate, a web service interface to run unit tests.

	ZnTestRunnerDelegate startInServerOn: 1701.
	
	ZnEasy get: 'http://localhost:1701/sunit/ZnUtilsTests'.
	ZnEasy get: 'http://localhost:1701/sunit/ZnUtilsTests/testBase64'.

Web Service API:

	GET /sunit/MyTestCase
	GET /sunit/MyTestCase/testOne

Part of Zinc HTTP Components!
!ZnTestRunnerDelegate methodsFor: 'request handling' stamp: 'SvenVanCaekenberghe 5/28/2013 10:29'!
handleGetRequest: request
	| testCaseClass selector result |
	testCaseClass := Smalltalk globals
		at: request uri pathSegments second asSymbol
		ifAbsent: [ ^ self notFoundResponse: 'No such class, ', request uri pathSegments second ].
	(testCaseClass inheritsFrom: TestCase)
		ifFalse: [ ^ self notFoundResponse: testCaseClass printString, ' is not a TestCase subclass' ]. 
	selector := request uri pathSegments size = 3
		ifTrue: [ request uri pathSegments third asSymbol ]
		ifFalse: [ nil ].
	(selector isNil or: [ testCaseClass canUnderstand: selector ])
		ifFalse: [ ^ self notFoundResponse: selector, ' is not a method of ', testCaseClass printString ].
	result := selector 
		ifNil: [ testCaseClass suite run ] 
		ifNotNil: [ testCaseClass run: selector ].
	^ result runCount = result passedCount
		ifTrue: [ ZnResponse ok: (ZnEntity textCRLF: result printString) ]
		ifFalse: [ ZnResponse serverError: result printString ]! !

!ZnTestRunnerDelegate methodsFor: 'request handling' stamp: 'SvenVanCaekenberghe 5/28/2013 10:28'!
notFoundResponse: message
	^ ZnResponse new
		statusLine: ZnStatusLine notFound;
		headers: ZnHeaders defaultResponseHeaders;
		entity: (ZnEntity textCRLF: 'Not Found: ', message);
		yourself.! !

!ZnTestRunnerDelegate methodsFor: 'public' stamp: 'SvenVanCaekenberghe 5/27/2013 17:16'!
value: request
	"I implement the generic #value: message as equivalent to #handleRequest:"
	
	^ self handleRequest: request! !

!ZnTestRunnerDelegate methodsFor: 'public' stamp: 'SvenVanCaekenberghe 5/27/2013 17:20'!
handleRequest: request
	(request method = #GET 
		and: [ 
			request uri firstPathSegment = #sunit 
				and: [ 
					request uri pathSegments size > 1 ] ])
		ifTrue: [ 
			^ self handleGetRequest: request ].
	^ ZnResponse notFound: request uri! !

!ZnTestRunnerDelegate class methodsFor: 'public' stamp: 'SvenVanCaekenberghe 5/27/2013 17:16'!
startInServerOn: port
	"Start a new server bound to port on the local network running a test runner web service"

	"self startInServerOn: 1701"
	
	 ^ (ZnServer on: port)
			bindingAddress: NetNameResolver loopBackAddress;
			delegate: self new;
			start;
			yourself! !

!ZnTooManyDictionaryEntries commentStamp: 'SvenVanCaekenberghe 1/2/2012 19:22'!
ZnTooManyDictionaryEntries is signalled when too many entries are added to a limited ZnMultiValueDictionary.

Part of Zinc HTTP Components. !
!ZnTooManyDictionaryEntries methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/2/2012 19:21'!
limit: anObject
	limit := anObject! !

!ZnTooManyDictionaryEntries methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/2/2012 19:21'!
limit
	^ limit! !

!ZnTooManyDictionaryEntries class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 1/2/2012 19:21'!
limit: limit
	^ self new 
		limit: limit; 
		yourself! !

!ZnTooManyRedirects commentStamp: 'SvenVanCaekenberghe 9/19/2011 09:59'!
ZnTooManyRedirects is signalled when an HTTP client has been following more redirects than allowed.

Part of Zinc HTTP Components. !
!ZnTooManyRedirects methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/3/2012 15:06'!
isResumable
	"Determine whether an exception is resumable."

	^ true! !

!ZnUTF16Encoder commentStamp: '<historical>'!
I am ZnUTF16Encoder, a concrete subclass of ZnCharacterEncoder.
I implement the variable length UTF-16 encoding and decoding of Unicode according to RFC 2781.

Wikipedia reference http://en.wikipedia.org/wiki/UTF-16

Part of Zinc HTTP Components.
!
!ZnUTF16Encoder methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 11/8/2013 13:56'!
nextPutByteOrderMarkToStream: stream
	self write16BitWord: self byteOrderMark toStream: stream ! !

!ZnUTF16Encoder methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/15/2014 09:49'!
identifier
	^ #utf16! !

!ZnUTF16Encoder methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/8/2013 13:07'!
isLittleEndian
	^ endianness = #little! !

!ZnUTF16Encoder methodsFor: 'private' stamp: 'SvenVanCaekenberghe 11/8/2013 15:55'!
processByteOrderMark: word
	^ (word = 16rFEFF or: [ word = 16rFFFE ])
		ifTrue: [ 
			word = 16rFFFE
				ifTrue: [ self swapEndianness ].
			true ]
		ifFalse: [ false ]! !

!ZnUTF16Encoder methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 11/8/2013 13:32'!
beBigEndian
	endianness := #big! !

!ZnUTF16Encoder methodsFor: 'private' stamp: 'SvenVanCaekenberghe 11/8/2013 13:33'!
write16BitWord: word toStream: stream
	self isBigEndian
		ifTrue: [ 
			stream
				nextPut: (word digitAt: 2);
				nextPut: (word digitAt: 1) ]
		ifFalse: [ 
			stream
				nextPut: (word digitAt: 1);
				nextPut: (word digitAt: 2) ]! !

!ZnUTF16Encoder methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 11/8/2013 13:32'!
beLittleEndian
	endianness := #little! !

!ZnUTF16Encoder methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/8/2013 15:47'!
byteOrderMark
	^ 16rFEFF! !

!ZnUTF16Encoder methodsFor: 'private' stamp: 'SvenVanCaekenberghe 11/8/2013 14:05'!
swapEndianness
	self isLittleEndian
		ifTrue: [ self beBigEndian ]
		ifFalse: [ self beLittleEndian ]! !

!ZnUTF16Encoder methodsFor: 'private' stamp: 'SvenVanCaekenberghe 2/24/2014 16:01'!
back16BitWordOnStream: stream
	| firstByte secondByte |
	firstByte := stream back.
	secondByte := stream back.
	^ self isBigEndian 
		ifTrue: [ secondByte + (firstByte << 8) ]
		ifFalse: [ firstByte + (secondByte << 8) ]! !

!ZnUTF16Encoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 2/24/2014 16:02'!
backOnStream: stream
	"Move back one character on stream"

	| word |
	word := self back16BitWordOnStream: stream.
	(word < 16rD800 or: [ word > 16rDBFF ])
		ifFalse: [ 
			self back16BitWordOnStream: stream ]! !

!ZnUTF16Encoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 11/8/2013 15:14'!
nextFromStream: stream
	"Read and return the next character from stream"

	| word leadSurrogate trailSurrogate code |
	word := self read16BitWordFromStream: stream.
	(self processByteOrderMark: word)
		ifTrue: [ word := self read16BitWordFromStream: stream ].
	^ (word < 16rD800 or: [ word > 16rDBFF ])
		ifTrue: [
			Character codePoint: word ]
		ifFalse: [ 
			leadSurrogate := word.
			trailSurrogate := self read16BitWordFromStream: stream.
			code := (leadSurrogate - 16rD800) * 16r400 + (trailSurrogate - 16rDC00).
			Character codePoint: 16r10000 + code ]! !

!ZnUTF16Encoder methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 11/8/2013 16:16'!
encodeStringWithByteOrderMark: string
	"Encode string and return the resulting byte array.
	Always add a Unicode byte order mark (BOM) in front."
	
	^ ByteArray streamContents: [ :stream |
		self nextPutByteOrderMarkToStream: stream.
		self next: string size putAll: string startingAt: 1 toStream: stream ]! !

!ZnUTF16Encoder methodsFor: 'initialize' stamp: 'SvenVanCaekenberghe 11/8/2013 13:27'!
initialize
	endianness := #big! !

!ZnUTF16Encoder methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 11/8/2013 13:08'!
isBigEndian
	^ endianness = #big! !

!ZnUTF16Encoder methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 11/8/2013 14:57'!
printOn: stream
	super printOn: stream.
	stream nextPut: $(.
	stream nextPutAll: endianness; nextPutAll: ' endian'.
	stream nextPut: $)! !

!ZnUTF16Encoder methodsFor: 'error handling' stamp: 'SvenVanCaekenberghe 11/8/2013 11:40'!
errorIncomplete
	self error: 'Incomplete utf-16 encoding'! !

!ZnUTF16Encoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 11/8/2013 14:59'!
nextPut: character toStream: stream
	"Write the encoding for character to stream"

	| code leadSurrogate trailSurrogate |
	code := character codePoint.
	code <= 65535
		ifTrue: [ 
			^ self write16BitWord: code toStream: stream ].
	code <= self maximumUTF16Code
		ifTrue: [
			code := code - 16r10000.
			leadSurrogate := 16rD800 + (code // 16r400).
			trailSurrogate := 16rDC00 + (code \\ 16r400).
			self write16BitWord: leadSurrogate toStream: stream.
			self write16BitWord: trailSurrogate toStream: stream ]
		ifFalse: [
			self errorOutsideRange ]! !

!ZnUTF16Encoder methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/8/2013 11:09'!
maximumUTF16Code
	^ 16r10FFFF! !

!ZnUTF16Encoder methodsFor: 'private' stamp: 'SvenVanCaekenberghe 11/8/2013 13:40'!
read16BitWordFromStream: stream
	| firstByte secondByte |
	firstByte := stream next.
	secondByte := stream next.
	(firstByte isNil or: [ secondByte isNil ])
		ifTrue: [ self errorIncomplete ].
	^ self isBigEndian 
		ifTrue: [ secondByte + (firstByte << 8) ]
		ifFalse: [ firstByte + (secondByte << 8) ]
	! !

!ZnUTF16Encoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 11/8/2013 11:08'!
encodedByteCountFor: character
	"Return how many bytes are needed to encode character"

	| code |
	code := character codePoint.
	code <= 65535 ifTrue: [ ^ 2 ].
	code <= self maximumUTF16Code ifTrue: [ ^ 4 ].
	self errorOutsideRange! !

!ZnUTF16Encoder class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/13/2014 22:11'!
handlesEncoding: string
	"Return true when my instances handle the encoding described by string"

	^ #( 'utf16' 'utf16be' 'utf16le' ) includes: (self canonicalEncodingIdentifier: string)! !

!ZnUTF16Encoder class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 9/13/2014 22:12'!
newForEncoding: string
	"Return a new character encoder object for an encoding described by string.
	Try to infer endianness from string, defaulting to big endian."
	
	| encoder |
	encoder := self new.
	(string asLowercase endsWith: 'be') ifTrue: [ encoder beBigEndian ].
	(string asLowercase endsWith: 'le') ifTrue: [ encoder beLittleEndian ].
	^ encoder! !

!ZnUTF8Encoder commentStamp: '<historical>'!
I am ZnUTF8Encoder, a concrete subclass of ZnCharacterEncoder.
I implement the variable length UTF-8 encoding and decoding of Unicode according to RFC 3629.

Wikipedia reference http://en.wikipedia.org/wiki/UTF-8

Part of Zinc HTTP Components.!
!ZnUTF8Encoder methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/15/2014 09:49'!
identifier
	^ #utf8! !

!ZnUTF8Encoder methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/23/2013 23:05'!
next: count putAllByteString: string startingAt: offset toStream: stream
	"A faster version when string is a ByteString"
	
	| lastIndex nextIndex |
	lastIndex := offset.
	nextIndex := self findFirstNonASCIIIn: string startingAt: lastIndex.
	(nextIndex = 0 or: [ offset + count <= nextIndex ]) 
		ifTrue: [ 
			^ self next: count putAllASCII: string startingAt: offset toStream: stream ].
	[	nextIndex > lastIndex 
			ifTrue: [
				self next: nextIndex - lastIndex putAllASCII: string startingAt: lastIndex toStream: stream ].
		stream nextPutAll: (ByteUTF8Encoding at: (string byteAt: nextIndex) + 1).
		lastIndex := nextIndex + 1.
		nextIndex := self findFirstNonASCIIIn: string startingAt: lastIndex.
		nextIndex = 0 or: [ offset + count <= nextIndex ] ] whileFalse.
	offset + count <= lastIndex 
		ifFalse: [ 
			self next: offset + count - lastIndex putAllASCII: string startingAt: lastIndex toStream: stream ]
	! !

!ZnUTF8Encoder methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/24/2013 21:12'!
next: count putAllASCII: string startingAt: offset toStream: stream
	"Write count bytes from string starting at offset to stream,
	assuming all characters are in the ASCII set and need no translation"
	
	"For now, we don't use the option of mixing ByteString and ByteArray as similar"
	
	| bytes |
	bytes := ByteArray new: count.
	bytes replaceFrom: 1 to: count with: string startingAt: offset.
	stream nextPutAll: bytes! !

!ZnUTF8Encoder methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 6/11/2013 15:18'!
readInto: string startingAt: offset count: requestedCount fromStream: stream
	"Read requestedCount characters into string starting at offset,
	returning the number read, there could be less available when stream is atEnd.
	The clean code is in my superclass"

	^ self optimizedReadInto: string startingAt: offset count: requestedCount fromStream: stream! !

!ZnUTF8Encoder methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 6/10/2013 20:52'!
decodeBytes: bytes
	"Overridden to prevent the automagic switch from ByteString to WideString 
	and the slow #becomeForward: in there. See also #decodeBytesIntoWideString:"
	
	| byteStream |
	byteStream := bytes readStream.
	^ String streamContents: [ :stream |
		[ byteStream atEnd ] whileFalse: [ | char |
			char := self nextFromStream: byteStream.
			(char isOctetCharacter not and: [ stream originalContents isWideString not ])
				ifTrue: [ | wideString position |
					position := stream position.
					wideString := WideString from: stream originalContents.
					stream on: wideString; setFrom: position + 1 to: position ].
			stream nextPut: char ] ] ! !

!ZnUTF8Encoder methodsFor: 'private' stamp: 'SvenVanCaekenberghe 6/11/2013 15:04'!
originalReadInto: string startingAt: offset count: requestedCount fromStream: stream
	"Read requestedCount characters into string starting at offset,
	returning the number read, there could be less available when stream is atEnd.
	I signal a ZnByteStringBecameWideString notification if necessary"

	| stringBuffer |
	stringBuffer := string.
	0 to: requestedCount - 1 do: [ :count |
		| char |
		stream atEnd ifTrue: [ ^ count ].
		char := self nextFromStream: stream.
		(char isOctetCharacter not and: [ stringBuffer isWideString not ])
			ifTrue: [ stringBuffer := ZnByteStringBecameWideString convert: stringBuffer ].
		stringBuffer at: offset + count put: char ].
	^ requestedCount! !

!ZnUTF8Encoder methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/29/2010 21:19'!
maximumUTF8Code
	^ 16r10FFFF! !

!ZnUTF8Encoder methodsFor: 'private' stamp: 'SvenVanCaekenberghe 5/23/2013 22:08'!
replace: string from: start to: stop with: replacement startingAt: repStart
	string isByteString
		ifTrue: [ 
			string replaceFrom: start to: stop with: replacement startingAt: repStart ]
		ifFalse: [ 
			| index repOff |
			repOff := repStart - start.
			index := start - 1.
			[ (index := index + 1) <= stop ] 
				whileTrue: [ 
					string at: index put: (replacement at: repOff + index) asCharacter ] ]! !

!ZnUTF8Encoder methodsFor: 'error handling' stamp: 'SvenVanCaekenberghe 11/6/2013 08:32'!
errorIllegalLeadingByte
	self error: 'Illegal leading byte for utf-8 encoding'! !

!ZnUTF8Encoder methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 6/10/2013 20:53'!
decodeBytesIntoWideString: bytes
	"Variant of #decodeBytes: that is faster when you know upfront 
	that a WideString is probably needed"

	| byteStream |
	byteStream := bytes readStream.
	^ WideString streamContents: [ :stream |
		[ byteStream atEnd ] whileFalse: [
			stream nextPut: (self nextFromStream: byteStream) ] ] ! !

!ZnUTF8Encoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 2/24/2014 15:38'!
backOnStream: stream
	[ (stream back bitAnd: 2r11000000) == 2r10000000 ] whileTrue! !

!ZnUTF8Encoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 11/8/2013 10:54'!
nextFromStream: stream
	| code byte next |
	(byte := stream next) < 128
		ifTrue: [ ^ Character codePoint: byte ].
	(byte bitAnd: 2r11100000) == 2r11000000
		ifTrue: [ 
			code := byte bitAnd: 2r00011111.
			((next := stream next ifNil: [ self errorIncomplete ]) bitAnd: 2r11000000) == 2r10000000
				ifTrue: [ code := (code bitShift: 6) + (next bitAnd: 2r00111111) ]
				ifFalse: [ ^ self errorIllegalContinuationByte ].
			code < 128 ifTrue: [ self errorOverlong ].
			^ Character codePoint: code ].
	(byte bitAnd: 2r11110000) == 2r11100000
		ifTrue: [ 
			code := byte bitAnd: 2r00001111.
			2 timesRepeat: [ 
				((next := stream next ifNil: [ self errorIncomplete ]) bitAnd: 2r11000000) == 2r10000000
					ifTrue: [ code := (code bitShift: 6) + (next bitAnd: 2r00111111) ]
					ifFalse: [ ^ self errorIllegalContinuationByte ] ].
			code < 2048 ifTrue: [ self errorOverlong ].
			code = 65279 "Unicode Byte Order Mark" ifTrue: [ 
				stream atEnd ifTrue: [ self errorIncomplete ].
				^ self nextFromStream: stream ].
			^ Character codePoint: code ].
	(byte bitAnd: 2r11111000) == 2r11110000
		ifTrue: [ 
			code := byte bitAnd: 2r00000111.
			3 timesRepeat: [ 
				((next := stream next ifNil: [ self errorIncomplete ]) bitAnd: 2r11000000) == 2r10000000
					ifTrue: [ code := (code bitShift: 6) + (next bitAnd: 2r00111111) ]
					ifFalse: [ ^ self errorIllegalContinuationByte ] ].
			code < 65535 ifTrue: [ self errorOverlong ].
			^ Character codePoint: code ].
	self errorIllegalLeadingByte! !

!ZnUTF8Encoder methodsFor: 'private' stamp: 'SvenVanCaekenberghe 11/5/2013 11:35'!
findFirstNonASCIIIn: string startingAt: offset
	"This calls a fast primitive. Note that string can be a ByteString or ByteArray"
	
	offset > string size ifTrue: [ ^ 0 ].
	^ ByteString 
		findFirstInString: string 
		inSet: ByteASCIISet 
		startingAt: offset! !

!ZnUTF8Encoder methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 5/23/2013 22:51'!
next: count putAll: string startingAt: offset toStream: stream
	"Write count characters from string starting at offset to stream."
	
	string isByteString
		ifTrue: [ self next: count putAllByteString: string startingAt: offset toStream: stream ]
		ifFalse: [ super next: count putAll: string startingAt: offset toStream: stream ]! !

!ZnUTF8Encoder methodsFor: 'error handling' stamp: 'SvenVanCaekenberghe 6/4/2013 16:58'!
errorOverlong
	self error: 'Overlong encoding (non-shortest form)'! !

!ZnUTF8Encoder methodsFor: 'private' stamp: 'SvenVanCaekenberghe 11/5/2013 23:22'!
optimizedReadInto: string startingAt: offset count: requestedCount fromStream: stream
	"Read requestedCount characters into string starting at offset,
	returning the number read, there could be less available when stream is atEnd.
	Optimized based on the assumption that most decoded characters will be ASCII.
	I signal a ZnByteStringBecameWideString notification if necessary."
	
	| stringBuffer byteBuffer bytesRead read last next count readStream bytesLeft char |
	stringBuffer := string.
	read := 0.
	"Start by reading the minimum amount of bytes for decoding requestedCount characters"
	byteBuffer := ByteArray new: requestedCount.
	bytesRead := stream readInto: byteBuffer startingAt: 1 count: requestedCount.
	readStream := byteBuffer readStream.
	last := 1.
	next := self findFirstNonASCIIIn: byteBuffer startingAt: last.
	(next = 0 or: [ bytesRead < next ]) 
		ifTrue: [
			"The whole input is ASCII"
			self replace: stringBuffer from: offset to: offset + bytesRead - 1 with: byteBuffer startingAt: 1. 
			^ bytesRead ].
	[	next > last 
			ifTrue: [
				"Copy the ASCII run from last to next"
				count := next - last.
				self replace: stringBuffer from: offset + read to: offset + read + count - 1 with: byteBuffer startingAt: last.
				read := read + count ].
		"Read one UTF-8 encoded non ASCII character"
		readStream position: next - 1.
		count := self encodingLengthFor: readStream peek.
		bytesLeft := bytesRead - next + 1.
		count <= bytesLeft
			ifTrue: [ 
				char := self nextFromStream: readStream ]
			ifFalse: [ | tmpBuffer extraRead |
				tmpBuffer := ByteArray new: count.
				readStream readInto: tmpBuffer startingAt: 1 count: bytesLeft.
				extraRead := stream readInto: tmpBuffer startingAt: bytesLeft + 1 count: count - bytesLeft.
				extraRead = (count - bytesLeft) ifFalse: [ self errorIncomplete ].
				char := self nextFromStream: tmpBuffer readStream ].
		(char isOctetCharacter not and: [ stringBuffer isWideString not ])
			ifTrue: [ stringBuffer := ZnByteStringBecameWideString convert: stringBuffer ].
		stringBuffer at: offset + read put: char.
		last := next + count.
		read := read + 1.
		"Iterate"
		next := self findFirstNonASCIIIn: byteBuffer startingAt: last.
		next = 0 or: [ bytesRead < next ] ] whileFalse.
	bytesRead < last 
		ifFalse: [
			"There is a last ASCII run left" 
			count := bytesRead - last + 1.
			self replace: stringBuffer from: offset + read to: offset + read + count - 1 with: byteBuffer startingAt: last.
			read := read + count ].
	"Try consuming enough input to reach requestedCount since we probably read too little"
	count := requestedCount - read.
	^ read + (self originalReadInto: stringBuffer startingAt: offset + read count: count fromStream: stream)! !

!ZnUTF8Encoder methodsFor: 'error handling' stamp: 'SvenVanCaekenberghe 6/3/2013 19:59'!
errorIncomplete
	self error: 'Incomplete utf-8 encoding'! !

!ZnUTF8Encoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 4/2/2014 13:44'!
nextPut: character toStream: stream
	| code |
	code := character codePoint.
	code < 128 ifTrue: [ 
		^ stream nextPut: code ].
	code < 2048 ifTrue: [ 
		^ stream 
			nextPut: (2r11000000 + (code bitShift: -6)); 
			nextPut: (2r10000000 + (code bitAnd: 2r111111)) ].
	code < 65536 ifTrue: [ 
		^ stream 
			nextPut: (2r11100000 + (code bitShift: -12));
			nextPut: (2r10000000 + ((code bitShift: -6) bitAnd: 2r111111)); 
			nextPut: (2r10000000 + (code bitAnd: 2r111111)) ].
	code <= self maximumUTF8Code ifTrue: [ 
		^ stream 
			nextPut: (2r11110000 + (code bitShift: -18));
			nextPut: (2r10000000 + ((code bitShift: -12) bitAnd: 2r111111));
			nextPut: (2r10000000 + ((code bitShift: -6) bitAnd: 2r111111)); 
			nextPut: (2r10000000 + (code bitAnd: 2r111111)) ].
	self errorOutsideRange
! !

!ZnUTF8Encoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 11/6/2013 08:32'!
encodingLengthFor: byte
	byte < 128 ifTrue: [ ^ 1 ].
	(byte bitAnd: 2r11100000) == 2r11000000 ifTrue: [ ^ 2 ].
	(byte bitAnd: 2r11110000) == 2r11100000 ifTrue: [ ^ 3 ].
	(byte bitAnd: 2r11111000) == 2r11110000 ifTrue: [ ^ 4 ].
	self errorIllegalLeadingByte! !

!ZnUTF8Encoder methodsFor: 'error handling' stamp: 'SvenVanCaekenberghe 11/8/2013 10:52'!
errorIllegalContinuationByte
	self error: 'Illegal continuation byte for utf-8 encoding'! !

!ZnUTF8Encoder methodsFor: 'error handling' stamp: 'SvenVanCaekenberghe 6/3/2013 19:52'!
error: message
	ZnInvalidUTF8 signal: message! !

!ZnUTF8Encoder methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 11/8/2013 11:05'!
encodedByteCountFor: character
	| code |
	code := character codePoint.
	code < 128 ifTrue: [ ^ 1 ].
	code < 2048 ifTrue: [ ^ 2 ].
	code < 65535 ifTrue: [ ^ 3 ].
	code <= self maximumUTF8Code ifTrue: [ ^ 4 ].
	self errorOutsideRange! !

!ZnUTF8Encoder class methodsFor: 'class initialization' stamp: 'SvenVanCaekenberghe 5/25/2013 13:58'!
initialize
	| encoder stream |
	ByteASCIISet := ByteArray new: 256.
	ByteUTF8Encoding := Array new: 256.
	encoder := self new.
	stream := ByteArray new writeStream.
	0 to: 255 do: [ :each |
		| bytes |
		stream reset.
		encoder nextPut: (Character value: each) toStream: stream.
		bytes := stream contents.
		(bytes size = 1 and: [ bytes first = each ])
			ifTrue: [
				ByteASCIISet at: each + 1 put: 0 ]
			ifFalse: [  
				ByteASCIISet at: each + 1 put: 1.
				ByteUTF8Encoding at: each + 1 put: bytes ] ] ! !

!ZnUTF8Encoder class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 9/13/2014 22:10'!
handlesEncoding: string
	"Return true when my instances handle the encoding described by string"
	
	^ (self canonicalEncodingIdentifier: string) = 'utf8'! !

!ZnUTF8Encoder class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 1/25/2011 11:19'!
newForEncoding: string
	"No further parametrization needed"
	
	^ self new! !

!ZnUnexpectedContentType commentStamp: 'SvenVanCaekenberghe 12/20/2011 12:52'!
ZnUnexpectedContentType is signalled when a different content type (mime type) was expected.

I hold the expected and actual content types.

Part of Zinc HTTP Components. !
!ZnUnexpectedContentType methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/20/2011 12:43'!
standardMessageText
	"Generate a standard textual description"
	
	^ String streamContents: [ :stream |
		self expectedContentType ifNotNil: [ :contentType |
			stream << 'expected '; print: contentType ].
		self actualContentType ifNotNil: [ :contentType |
			self expectedContentType ifNotNil: [ stream space ].
			stream << 'actual '; print: contentType ] ]! !

!ZnUnexpectedContentType methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/20/2011 12:39'!
actualContentType
	^ actualContentType! !

!ZnUnexpectedContentType methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/20/2011 12:45'!
messageText
	"Overwritten to initialiaze the message text to a standard text if it has not yet been set"
	
	^ messageText ifNil: [ messageText := self standardMessageText ]! !

!ZnUnexpectedContentType methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/20/2011 12:39'!
expectedContentType: anObject
	expectedContentType := anObject! !

!ZnUnexpectedContentType methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/20/2011 12:39'!
expectedContentType
	^ expectedContentType! !

!ZnUnexpectedContentType methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/20/2011 12:39'!
actualContentType: anObject
	actualContentType := anObject! !

!ZnUnexpectedContentType class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 12/20/2011 12:48'!
expected: expectedMimeType actual: actualMimeType
	^ self new
		expectedContentType: expectedMimeType;
		actualContentType: actualMimeType;
		yourself! !

!ZnUnknownHttpMethod commentStamp: 'SvenVanCaekenberghe 12/11/2011 18:09'!
ZnUnknownHttpMethod is signalled when an unknown/unsupported HTTP method is found while parsing a request.

I am resumable to allow non-standard methods.

Part of Zinc HTTP Components. !
!ZnUnknownHttpMethod methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/28/2011 14:33'!
method
	^ method! !

!ZnUnknownHttpMethod methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/28/2011 14:33'!
method: anObject
	method := anObject! !

!ZnUnknownHttpMethod methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/11/2011 18:09'!
isResumable
	^ true! !

!ZnUnknownHttpMethod class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 2/28/2011 14:34'!
method: method
	^ self new
		method: method;
		yourself! !

!ZnUnknownHttpStatusCode commentStamp: 'DamienPollet 8/4/2011 14:07'!
ZnUnknownHttpStatusCode is signalled when an unknown/unsupported HTTP status code is found.

Part of Zinc HTTP Components. !
!ZnUnknownHttpStatusCode methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/28/2011 14:33'!
code
	^ code! !

!ZnUnknownHttpStatusCode methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/28/2011 14:33'!
code: anObject
	code := anObject! !

!ZnUnknownHttpStatusCode class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 2/28/2011 14:34'!
code: code
	^ self new
		code: code;
		yourself! !

!ZnUnknownHttpVersion commentStamp: 'DamienPollet 8/4/2011 14:07'!
ZnUnknownHttpVersion is signalled when an unknown/unsupported HTTP version is found.

Part of Zinc HTTP Components. !
!ZnUnknownHttpVersion methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/28/2011 14:33'!
version
	^ version! !

!ZnUnknownHttpVersion methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 2/28/2011 14:33'!
version: anObject
	version := anObject! !

!ZnUnknownHttpVersion class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 2/28/2011 14:35'!
version: version
	^ self new
		version: version;
		yourself! !

!ZnUnknownScheme commentStamp: 'DamienPollet 8/4/2011 14:07'!
ZnUnknownScheme is signalled when an unknown/unsupported URL scheme is found.

Part of Zinc HTTP Components. !
!ZnUnknownScheme methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 3/18/2011 13:16'!
scheme: anObject
	scheme := anObject! !

!ZnUnknownScheme methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 3/18/2011 13:16'!
scheme
	^ scheme! !

!ZnUnknownScheme class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 3/18/2011 13:17'!
scheme: scheme
	^ self new
		scheme: scheme;
		yourself! !

!ZnUrl commentStamp: 'SvenVanCaekenberghe 2/5/2015 00:00'!
I am ZnUrl, an implementation of an interpreted URL/URI.
URLs are an element used in describing resources, more specifically to identify them.

I consist of the following parts:
  - scheme - like #http, #https, #ws, #wws, #file or nil
  - host - hostname string or nil
  - port - port integer or nil
  - segments - collection of path segments, ends with #/ for directories
  - query - query dictionary or nil
  - fragment - fragment string or nil
  - username - username string or nil
  - password - password string or nil

The syntax of my external representation informally looks like this

  scheme://username:password@host:port/segments?query#fragment

I am most often created by parsing my external representation using either my #fromString: class method or by sending the #asZnUrl convenience method to a String. Using #asZnUrl helps in accepting both Strings and ZnUrls arguments.

  ZnUrl fromString: 'http://www.google.com/search?q=Smalltalk'.

I can also be constucted programmatically.

  ZnUrl new 
    scheme: #https; 
    host: 'encrypted.google.com'; 
    addPathSegment: 'search'; 
    queryAt: 'q' put: 'Smalltalk'; 
    yourself.
  
My components can be manipulated destructively. Here is an example:

  'http://www.google.com/?one=1&two=2' asZnUrl
    queryAt: 'three' put: '3';
    queryRemoveKey: 'one';
    yourself.

Some characters of parts of a URL are illegal because they would interfere with the syntax and further processing and thus have to be encoded. The methods in accessing protocols do not do any encoding, those in parsing and printing do. Here is an example:

  'http://www.google.com' asZnUrl
    addPathSegment: 'some encoding here';
    queryAt: 'and some encoding' put: 'here, too';
    yourself

My parser is somewhat forgiving and accepts some unencoded URLs as well, like most browsers would.

  'http://www.example.com:8888/a path?q=a, b, c' asZnUrl.

I can parse in the context of a default scheme, like a browser would do.

  ZnUrl fromString: 'www.example.com' defaultScheme: #http

Given a scheme, I know its default port, try #portOrDefault.

A path defaults to what is commonly referred to as slash, test with #isSlash. Paths are most often (but don't have to be) interpreted as filesystem paths. To support this, I have #isFilePath and #isDirectoryPath tests and #file and #directory accessors.

I have some support to handle one URL in the context of another one, this is also known as a relative URL in the context of an absolute URL. Refer to #isAbsolute, #isRelative and #inContextOf:

  '/folder/file.txt' asZnUrl inContextOf: 'http://fileserver.example.net:4400' asZnUrl.

Incomplete relative references can be parsed and resolved in the context of a base URL using #withRelativeReference:

  'http://www.site.com/static/html/home.html' asZnUrl withRelativeReference: '../js/menu.js'.

Sometimes, the combination of my host and port are referred to as authority, see #authority.

URL/URI/URN (Uniform/Universal Resource Locator/Identifier/Name) are closely related and can be and are used as synonyms is many contexts. Refer to http://en.wikipedia.org/wiki/Url for more information.

There is a convenience method #retrieveContents to download the resource a ZnUrl points to,

  'http://zn.stfx.eu/zn/numbers.txt' asZnUrl retrieveContents.

This is implemented using a ZnUrlOperation.
 
Part of Zinc HTTP Components.!
!ZnUrl methodsFor: 'private' stamp: 'KrisGybels 6/11/2014 11:47'!
encodeQuery: string on: stream
	stream nextPutAll: (ZnResourceMetaUtils encodePercent: string safeSet: #querySafeSet encoder: ZnUTF8Encoder new)! !

!ZnUrl methodsFor: 'accessing-path' stamp: 'SvenVanCaekenberghe 7/9/2012 16:18'!
addPathSegments: pathSegments
	"Modify the receiver's path by adding the elements of pathSegments at the end"

	pathSegments do: [ :each | self addPathSegment: each ]! !

!ZnUrl methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 8/11/2011 12:05'!
asZnUrlWithDefaults
	^ self copy 
		setDefaults; 
		yourself! !

!ZnUrl methodsFor: 'accessing-path' stamp: 'SvenVanCaekenberghe 3/16/2013 19:43'!
path
	self hasPath ifFalse: [ ^ String new ].
	^ String streamContents: [ :stream | 
		segments 
			do: [ :each | 
				each == #/
					ifFalse: [ stream nextPutAll: each ] ]
			separatedBy: [ stream nextPut: $/ ] ]! !

!ZnUrl methodsFor: '*zinc-http' stamp: 'SvenVanCaekenberghe 11/6/2013 14:12'!
retrieveContents
	"Download and return the resource that I refer to.
	This will typically return a String or a ByteArray.
	If something goes wrong, an exception will be signalled."
	
	" 'http://zn.stfx.eu/zn/numbers.txt' asZnUrl retrieveContents. "
	
	^ self performOperation: #retrieveContents! !

!ZnUrl methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 1/30/2013 17:23'!
enforceKnownScheme
	(scheme isNil or: [ #(#http #https #ws #wss #file) includes: scheme ])
		ifFalse: [ (ZnUnknownScheme scheme: scheme) signal ]! !

!ZnUrl methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/3/2011 16:26'!
query
	^ query! !

!ZnUrl methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/3/2011 15:51'!
fragment: string
	fragment := string! !

!ZnUrl methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/3/2011 15:48'!
hasScheme
	^ scheme notNil! !

!ZnUrl methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/3/2011 15:09'!
scheme
	^ scheme! !

!ZnUrl methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 1/4/2011 10:59'!
equals: url
	self scheme = url scheme ifFalse: [ ^ false ].
	self host = url host ifFalse: [ ^ false ].
	self portOrDefault = url portOrDefault ifFalse: [ ^ false ].
	((self isSlash and: [ url isSlash ]) or: [ self segments = url segments ]) ifFalse: [ ^ false ].
	self query = url query ifFalse: [ ^ false ].
	self fragment = url fragment ifFalse: [ ^ false ].
	^ true! !

!ZnUrl methodsFor: 'parsing' stamp: 'SvenVanCaekenberghe 10/25/2013 17:00'!
parseHostPort: stream
	| hostString portNumber |
	self isFile
		ifTrue: [ 
			(hostString := stream upTo: $/) isEmpty
				ifFalse: [ self host: (self decodePercent: hostString) ] ]
		ifFalse: [ 
			(hostString := stream upTo: $:) isEmpty
				ifFalse: [ self host: (self decodePercent: hostString) ].
			stream atEnd
				ifFalse: [
					portNumber := Integer readFrom: stream ifFail: [ ZnPortNotANumber signal ].
					(portNumber between: 1 and: 65535) ifFalse: [ DomainError signalFrom: 1 to: 65535 ].
					self port: portNumber ] ]! !

!ZnUrl methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/11/2011 14:37'!
portOrDefault
	^ self hasPort
		ifTrue: [ self port ]
		ifFalse: [ self class defaultPortForScheme: self schemeOrDefault ]! !

!ZnUrl methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/25/2013 14:48'!
mailToAddress
	"Assuming my scheme is #mailto, return the address."
	
	^ self username, '@', self host ! !

!ZnUrl methodsFor: 'parsing' stamp: 'SvenVanCaekenberghe 8/11/2011 14:47'!
parseFrom: string
	self parseFrom: string defaultScheme: nil! !

!ZnUrl methodsFor: 'converting' stamp: 'MarcusDenker 11/14/2013 10:37'!
asUrl
	^ self! !

!ZnUrl methodsFor: 'accessing-path' stamp: 'SvenVanCaekenberghe 3/16/2013 19:32'!
clearPath
	self hasPath
		ifTrue: [ segments removeAll ]! !

!ZnUrl methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/30/2013 16:42'!
username
	^ username! !

!ZnUrl methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/3/2011 15:55'!
isRelative
	^ self isAbsolute not! !

!ZnUrl methodsFor: 'private' stamp: 'SvenVanCaekenberghe 1/4/2011 10:56'!
segments
	^ segments! !

!ZnUrl methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/4/2011 10:50'!
isHttp
	^ scheme == #http! !

!ZnUrl methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 7/9/2012 16:23'!
withPathSegments: pathSegments
	"Return a new URL equal to the receiver with its path extended with pathSegments"
	
	^ self copy
		addPathSegments: pathSegments;
		yourself! !

!ZnUrl methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/14/2013 11:37'!
isFilePath
	^ self isDirectoryPath not! !

!ZnUrl methodsFor: 'private' stamp: 'SvenVanCaekenberghe 8/11/2011 12:04'!
setDefaults
	self hasScheme 
		ifFalse: [ self scheme: self schemeOrDefault ].
	self hasPort 
		ifFalse: [ self port: self portOrDefault ]    ! !

!ZnUrl methodsFor: 'private' stamp: 'SvenVanCaekenberghe 1/30/2013 16:27'!
decodePercent: string
	^ ZnResourceMetaUtils decodePercent: string! !

!ZnUrl methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 7/9/2012 16:25'!
withQuery: association
	"Return a new URL equal to the receiver with the association's 
	key=value added as a query parameter.
	Note that #queryAt:add: is used."
	
	^ self copy
		queryAt: association key add: association value;
		yourself 
		! !

!ZnUrl methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 10/30/2013 14:38'!
isSchemeUsingPath
	^ (self class schemesNotUsingPath includes: self scheme) not! !

!ZnUrl methodsFor: 'private' stamp: 'KrisGybels 6/11/2014 11:47'!
encodePath: string on: stream
	stream nextPutAll: (ZnResourceMetaUtils encodePercent: string safeSet: #urlPathSafeSet encoder: ZnUTF8Encoder new)! !

!ZnUrl methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/3/2011 15:14'!
port: integer
	port := integer! !

!ZnUrl methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/25/2013 15:05'!
scheme: anObject
	anObject isNil
		ifTrue: [ scheme := nil ]
		ifFalse: [ scheme := anObject asLowercase asSymbol ]! !

!ZnUrl methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/18/2011 21:01'!
authority
	^ self hasNonDefaultPort 
		ifTrue: [ 
			String streamContents: [ :stream | 
				stream nextPutAll: self host; nextPut: $:; print: self port ] ]
		ifFalse: [ 
			self host ]! !

!ZnUrl methodsFor: 'private' stamp: 'KrisGybels 6/11/2014 11:47'!
encode: string on: stream
	stream nextPutAll: (ZnResourceMetaUtils encodePercent: string safeSet: #rfc3986SafeSet encoder: ZnUTF8Encoder new)! !

!ZnUrl methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/30/2013 16:19'!
hasPassword
	^ password notNil! !

!ZnUrl methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/3/2011 15:48'!
hasFragment
	^ fragment notNil! !

!ZnUrl methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/18/2011 21:01'!
hasNonDefaultPort
	^ self hasPort 
		and: [ self port ~= (self class defaultPortForScheme: self schemeOrDefault) ]! !

!ZnUrl methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 10/30/2013 14:34'!
printOn: stream
	self hasScheme ifTrue: [ 
		stream nextPutAll: self scheme; nextPut: $:.
		self isSchemeUsingDoubleSlash ifTrue: [ stream nextPut: $/; nextPut: $/ ] ].
	self printAuthorityOn: stream.
	self printPathQueryFragmentOn: stream! !

!ZnUrl methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 2/4/2015 23:57'!
inContextOf: absoluteUrl
	"Return a copy of the receiver where scheme, host and port
	are taken from absoluteUrl unless they are already in the receiver.
	Path merging is not supported. See also #withRelativeReference: "
	
	| copy |
	copy := self copy.
	copy hasScheme ifFalse: [ copy scheme: absoluteUrl scheme ].
	copy hasHost ifFalse: [ copy host: absoluteUrl host ].
	(copy hasPort not and: [ copy scheme = absoluteUrl scheme ]) 
		ifTrue: [ copy port: absoluteUrl port ].      
	^ copy! !

!ZnUrl methodsFor: 'accessing-path' stamp: 'SvenVanCaekenberghe 7/9/2012 16:18'!
addPathSegment: segment
	"Modify the receiver's path by adding segment at the end"
	
	segments isNil ifTrue: [ 
		segments := OrderedCollection new ].
	segments add: segment! !

!ZnUrl methodsFor: 'accessing-query' stamp: 'SvenVanCaekenberghe 3/26/2014 14:46'!
queryDo: block
	"Execute block for each query key/value pair in the receiver"
	
	self hasQuery ifTrue: [ 
		self query keysAndValuesDo: block ]! !

!ZnUrl methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/4/2011 10:50'!
isHttps
	^ scheme == #https! !

!ZnUrl methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/13/2011 10:41'!
isLocalHost
	^ self hasHost and: [ #('localhost' '127.0.0.1') includes: self host ]! !

!ZnUrl methodsFor: 'accessing-query' stamp: 'SvenVanCaekenberghe 3/26/2014 14:44'!
queryAt: key
	"Return the value of the query parameter key in the receiver.
	Signal a KeyNotFound exception if there is no such parameter"
	
	^ self queryAt: key ifAbsent: [ KeyNotFound signalFor: key printString ]! !

!ZnUrl methodsFor: 'parsing' stamp: 'SvenVanCaekenberghe 1/30/2013 16:28'!
parseUserInfo: stream
	| userString |
	(userString := stream upTo: $:) isEmpty 
		ifFalse: [  
			self username: (self decodePercent: userString) ].
	stream atEnd 
		ifFalse: [ 
			self password: (self decodePercent: stream upToEnd) ]! !

!ZnUrl methodsFor: 'accessing-query' stamp: 'SvenVanCaekenberghe 3/26/2014 14:46'!
queryRemoveAll
	"Modify the receiver by removing all query parameters"
	
	self hasQuery
		ifTrue: [ self query removeAll ]! !

!ZnUrl methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/6/2013 20:12'!
hasQuery
	^ query notNil and: [ query isEmpty not ]! !

!ZnUrl methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/5/2015 10:11'!
isAbsolute
	"We consider URLs with scheme://host as absolute (port is not relevant here).
	See also #inContextOf: and #withRelativeReference:"
	
	^ self hasScheme and: [ self hasHost ]! !

!ZnUrl methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/11/2011 11:05'!
schemeOrDefault
	^ self hasScheme 
		ifTrue: [ self scheme ]
		ifFalse: [ #http ]    ! !

!ZnUrl methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 3/16/2013 20:39'!
addedToZnUrl: url
	^ url withPathSegments: self pathSegments ! !

!ZnUrl methodsFor: 'accessing-path' stamp: 'SvenVanCaekenberghe 1/4/2011 14:46'!
firstPathSegment
	^ self isSlash
		ifTrue: [ nil ]
		ifFalse: [ segments first ]! !

!ZnUrl methodsFor: 'accessing-query' stamp: 'SvenVanCaekenberghe 3/26/2014 14:45'!
queryAt: key ifPresent: block
	"Execute block with the value of the query parameter named key as value.
	Return nil if there is no such parameter"
	
	^ self hasQuery
		ifTrue: [ self query at: key asString ifPresent: block ]! !

!ZnUrl methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 1/4/2011 11:00'!
= anObject
	^ self class == anObject class 
		and: [ self equals: anObject ]! !

!ZnUrl methodsFor: 'private' stamp: 'SvenVanCaekenberghe 1/4/2011 13:22'!
segments: collection
	segments := collection! !

!ZnUrl methodsFor: 'accessing-query' stamp: 'SvenVanCaekenberghe 3/26/2014 14:46'!
queryKeys
	"Return the collection of all query keys in the receiver"
	
	^ self hasQuery
		ifTrue: [ self query keys ]
		ifFalse: [ #() ]! !

!ZnUrl methodsFor: 'parsing' stamp: 'SvenVanCaekenberghe 2/4/2015 17:04'!
parsePath: stream
	stream peekFor: $/.
	[ stream atEnd ] whileFalse: [ | segment |
		segment := String streamContents: [ :stringStream |
			[ stream atEnd not and: [ stream peek ~= $/ ] ] whileTrue: [
				stringStream nextPut: stream next ] ].
		(segment isEmpty or: [ segment = '.' ])
			ifFalse: [
				segment = '..' 
					ifTrue: [ self removeLastPathSegment ]
					ifFalse: [ 
						segment = '.' 
							ifFalse: [ self addPathSegment: (self decodePercent: segment) ] ] ].
		((stream peekFor: $/) and: [ stream atEnd ])
			ifTrue: [ self closePath ] ]! !

!ZnUrl methodsFor: 'accessing-path' stamp: 'SvenVanCaekenberghe 3/16/2013 19:39'!
file
	^ self isDirectoryPath
		ifTrue: [ String new ]
		ifFalse: [ segments last ]! !

!ZnUrl methodsFor: 'private' stamp: 'SvenVanCaekenberghe 2/4/2015 23:50'!
processRelativeReference: reference
	"Parse & resolve the relative reference using myself as base URL, destructively"
	
	| index end |
	reference first = $/ ifTrue: [ self clearPath ].
	(self isFilePath and: [ ('?#' includes: reference first) not ] ) ifTrue: [ self removeLastPathSegment ].
	end := reference size.
	(index := reference indexOf: $#) > 0
		ifTrue: [ 
			self fragment: (self decodePercent: (reference copyFrom: index + 1 to: end)).
			end := index - 1 ].
	(index := reference indexOf: $?) > 0
		ifTrue: [
			self query: (ZnResourceMetaUtils parseQueryFrom: (ReadStream on: reference from: index + 1 to: end)).
			end := index - 1 ].
	self parsePath: (ReadStream on: reference from: 1 to: end).
	(reference = '.' ) | (reference = '..' ) | (reference endsWith: '/.') | (reference endsWith: '/..') 
		ifTrue: [ self closePath ]! !

!ZnUrl methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 1/4/2011 11:16'!
pathPrintString
	^ String streamContents: [ :stream | 
			self printPathOn: stream ]! !

!ZnUrl methodsFor: 'accessing-query' stamp: 'SvenVanCaekenberghe 3/26/2014 14:45'!
queryAt: key ifAbsent: block
	"Return the value of the query parameter key in the receiver.
	Execute block if there is no such parameter"
	
	^ self hasQuery
		ifTrue: [ self query at: key asString ifAbsent: block ]
		ifFalse: block! !

!ZnUrl methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 10/30/2013 14:39'!
printPathQueryFragmentOn: stream
	self isSchemeUsingPath 
		ifTrue: [ self printPathOn: stream ].
	self hasQuery
		ifTrue: [ self printQueryOn: stream ].
	self hasFragment
		ifFalse: [ ^ self ].
	stream nextPut: $#.
	self encodeQuery: self fragment on: stream! !

!ZnUrl methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 11/6/2013 14:13'!
performOperation: operation with: argument
	"Look for and execute a handler that can perform operation 
	on the receiver with the optional argument"
	
	^ ZnUrlOperation
		performOperation: operation 
		with: argument 
		on: self ! !

!ZnUrl methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 1/4/2011 11:24'!
asZnUrl
	^ self! !

!ZnUrl methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 7/9/2012 16:27'!
& association
	^ self withQuery: association ! !

!ZnUrl methodsFor: 'accessing-path' stamp: 'SvenVanCaekenberghe 3/16/2013 18:43'!
removeFirstPathSegment
	self hasPath
		ifTrue: [ segments removeFirst ]! !

!ZnUrl methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 10/24/2013 10:08'!
printPathOn: stream
	self hasPath ifFalse: [ ^ stream nextPut: $/ ].
 	segments do: [ :each | 
		stream nextPut: $/.
		each == #/
			ifFalse: [ 
				self encodePath: each on: stream ] ] ! !

!ZnUrl methodsFor: 'parsing' stamp: 'SvenVanCaekenberghe 1/15/2015 11:42'!
parseFrom: string defaultScheme: defaultScheme
	| start end index |
	start := 1.
	end := string size.
	(index := string indexOf: $#) > 0
		ifTrue: [ 
			self fragment: (self decodePercent: (string copyFrom: index + 1 to: end)).
			end := index - 1 ].
	(index := string indexOf: $?) > 0
		ifTrue: [
			self query: (ZnResourceMetaUtils parseQueryFrom: (ReadStream on: string from: index + 1 to: end)).
			end := index - 1 ].
	((index := string indexOfSubCollection: '://') > 0 and: [ index <= end ])
		ifTrue: [
			self scheme: (string copyFrom: 1 to: index - 1).
			start := index + 3 ]
		ifFalse: [ 
			((index := string indexOf: $:) > 0 
					and: [ index <= end 
						and: [ self isSchemeNotUsingDoubleSlash: (string copyFrom: 1 to: index - 1) ] ])
				ifTrue: [ 
					self scheme: (string copyFrom: 1 to: index - 1).
					start := index + 1 ]
				ifFalse: [ 
					defaultScheme ifNotNil: [ self scheme: defaultScheme ] ] ].
	self hasScheme 
		ifTrue: [  
			(index := string indexOf: $/ startingAt: start) > 0
				ifTrue: [
					self parseAuthority: string from: start to: index - 1.
					start := index ]
				ifFalse: [ 
					^ self parseAuthority: string from: start to: end ] ].
	self parsePath: (ReadStream on: string from: start to: end)! !

!ZnUrl methodsFor: '*gofer-core-accessing' stamp: 'EstebanLorenzano 12/17/2013 16:23'!
mcRepositoryAsUser: usernameString withPassword: passwordString
	self isHttp | self isHttps
		ifTrue: [ ^ MCHttpRepository location: self asString user: usernameString password: passwordString ].
	self isFile
		ifTrue: [ ^ MCDirectoryRepository new directory: self asFileReference ].
	self scheme = #filetree
		ifTrue: [ ^ MCFileTreeRepository new directory: self asFileReferenceWithRelativePath ].
	self scheme = #ftp
		ifTrue: [ ^ MCFtpRepository
			host: (self hasPort ifTrue: [ self host, ':', self port asString ] ifFalse: [ self host ])
			directory: self path "MCFtpRepository assumes NO prefixed / in the path"
			user: usernameString
			password: passwordString. ].
	self error: ('No Monticello repository for URL scheme {1}' format: {(self scheme)})! !

!ZnUrl methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/30/2013 17:15'!
isEmpty
	^ (self hasScheme | self hasHost | self hasPath | self hasQuery | self hasFragment | self hasUsername | self hasPassword) not! !

!ZnUrl methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/3/2011 15:51'!
fragment
	^ fragment! !

!ZnUrl methodsFor: 'accessing-query' stamp: 'SvenVanCaekenberghe 3/26/2014 14:43'!
queryAddAll: keyedCollection
	"Add all key/value pairs in keyedCollection as query parameters to the receiver.
	Note that we use #addAllMulti:"

	keyedCollection isEmpty
		ifFalse: [ 
			query ifNil: [ query := ZnMultiValueDictionary new ].
			query addAllMulti: keyedCollection ].
	^ keyedCollection! !

!ZnUrl methodsFor: 'parsing' stamp: 'SvenVanCaekenberghe 10/24/2013 10:20'!
parseAuthority: string from: start to: stop
	| index |
	((index := string indexOf: $@ startingAt: start) > 0 and: [ index < stop ])
		ifTrue: [
			self parseUserInfo: (ReadStream on: string from: start to: index - 1).
			self parseHostPort: (ReadStream on: string from: index + 1 to: stop) ]
		ifFalse: [ 
			self parseHostPort: (ReadStream on: string from: start to: stop) ]! !

!ZnUrl methodsFor: 'accessing-path' stamp: 'SvenVanCaekenberghe 3/16/2013 19:55'!
directory
	^ self isDirectoryPath
		ifTrue: [ self path ]
		ifFalse: [ 
			String streamContents: [ :stream |
				segments allButLast  
					do: [ :each | stream nextPutAll: each ]
					separatedBy: [ stream nextPut: $/ ] ] ]! !

!ZnUrl methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/4/2011 12:03'!
hasPath
	^ segments notNil and: [ segments isEmpty not ]! !

!ZnUrl methodsFor: 'accessing-path' stamp: 'SvenVanCaekenberghe 3/16/2013 18:42'!
removeLastPathSegment
	self hasPath
		ifTrue: [ segments removeLast ]! !

!ZnUrl methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/30/2013 16:19'!
password: string
	password := string! !

!ZnUrl methodsFor: 'copying' stamp: 'SvenVanCaekenberghe 4/26/2011 12:34'!
postCopy
	super postCopy.
	segments := segments copy.
	query := query copy! !

!ZnUrl methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 10/30/2013 14:33'!
isSchemeUsingDoubleSlash
	^ (self class schemesNotUsingDoubleSlash includes: self scheme) not! !

!ZnUrl methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/3/2011 15:48'!
hasPort
	^ port notNil! !

!ZnUrl methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/14/2013 11:42'!
isFile
	^ scheme = #file! !

!ZnUrl methodsFor: 'accessing-path' stamp: 'SvenVanCaekenberghe 1/4/2011 14:51'!
lastPathSegment
	^ self isSlash
		ifTrue: [ nil ]
		ifFalse: [ segments last ]! !

!ZnUrl methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/14/2013 11:36'!
isDirectoryPath
	^ self hasPath 
		ifTrue: [ segments last = #/ ]
		ifFalse: [ true ]
	! !

!ZnUrl methodsFor: 'private' stamp: 'SvenVanCaekenberghe 3/12/2014 14:20'!
isSchemeNotUsingDoubleSlash: schemeString
	^ self class schemesNotUsingDoubleSlash includes: schemeString asLowercase! !

!ZnUrl methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 3/16/2013 20:22'!
/ object
	^ object addedToZnUrl: self! !

!ZnUrl methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 11/6/2013 14:13'!
performOperation: operation
	"Look for and execute a handler that can perform operation on the receiver"
	
	^ self performOperation: operation with: nil! !

!ZnUrl methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 7/9/2012 16:22'!
withPathSegment: segment
	"Return a new URL equal to the receiver with its path extended with segment"
	
	^ self copy
		addPathSegment: segment;
		yourself! !

!ZnUrl methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 1/30/2013 16:21'!
printAuthorityOn: stream
	self hasUsername ifTrue: [
		self encode: self username on: stream.
		self hasPassword ifTrue: [
			stream nextPut: $:.
			self encode: self password on: stream ].
		stream nextPut: $@ ].
	self hasHost ifTrue: [ 
		self encode: self host on: stream ].
	self hasPort ifTrue: [ 
		stream nextPut: $:; print: self port ]
! !

!ZnUrl methodsFor: 'converting' stamp: 'SvenVanCaekenberghe 1/6/2013 19:21'!
asRelativeUrl
	"Copy the receiver, with scheme, host and port cleared"
	
	^ self copy
		scheme: nil;
		host: nil;
		port: nil;
		yourself! !

!ZnUrl methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/3/2011 15:48'!
hasHost
	^ host notNil! !

!ZnUrl methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/4/2011 10:54'!
isSlash
	^ self hasPath not or: [ segments size = 1 and: [ segments first = #/ ] ]! !

!ZnUrl methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/3/2011 20:15'!
query: dictionary
	query := dictionary! !

!ZnUrl methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/30/2013 16:19'!
username: string
	username := string! !

!ZnUrl methodsFor: 'accessing-path' stamp: 'SvenVanCaekenberghe 1/4/2011 11:56'!
closePath
	self isSlash
		ifFalse: [ self addPathSegment: #/ ]! !

!ZnUrl methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/6/2013 19:19'!
host: hostName
	host := hostName ifNil: [ nil ] ifNotNil: [ hostName asLowercase ]! !

!ZnUrl methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/3/2011 15:09'!
host
	^ host! !

!ZnUrl methodsFor: 'accessing-query' stamp: 'SvenVanCaekenberghe 3/26/2014 14:47'!
queryRemoveKey: key
	"Modify the receiver by remove the query parameter named key.
	Do nothing if there is no such parameter"
	
	self hasQuery
		ifTrue: [ self query removeKey: key asString ifAbsent: [ ] ]! !

!ZnUrl methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/30/2013 16:19'!
hasUsername
	^ username notNil! !

!ZnUrl methodsFor: 'comparing' stamp: 'SvenVanCaekenberghe 1/4/2011 10:43'!
hash
	^ self hasPath
		ifTrue: [ segments inject: host hash into: [ :sum :each | sum bitXor: each hash ] ]
		ifFalse: [ host hash ]! !

!ZnUrl methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 1/4/2011 11:17'!
pathQueryFragmentPrintString
	^ String streamContents: [ :stream | 
			self printPathQueryFragmentOn: stream ]! !

!ZnUrl methodsFor: 'parsing' stamp: 'SvenVanCaekenberghe 2/5/2015 22:24'!
withRelativeReference: reference
	"Return a new URL by parsing & resolving the relative reference using myself as base URL.
	This implements the process described in RFC 3986 Section 5"
	
	| resolved |
	[ (resolved := reference asZnUrl) isAbsolute 
		ifTrue: [ ^ resolved ] ] on: Error do: [ ].
	(reference beginsWith: '//')
		ifTrue: [ ^ self class fromString: (reference allButFirst: 2) defaultScheme: self scheme ].
	resolved := self copy.
	resolved fragment: nil.
	reference isEmpty ifTrue: [ ^ resolved ].
	reference first = $# ifFalse: [ resolved queryRemoveAll ].
	resolved processRelativeReference: reference.
	^ resolved! !

!ZnUrl methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 12/8/2012 21:02'!
printQueryOn: stream
	stream nextPut: $?. 
	ZnResourceMetaUtils writeQueryFields: self query on: 	stream! !

!ZnUrl methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/30/2013 16:42'!
password
	^ password! !

!ZnUrl methodsFor: '*gofer-core-accessing' stamp: 'EstebanLorenzano 12/17/2013 16:15'!
asFileReferenceWithRelativePath
	"Convert the receiver into a new FileReference object accepting relative paths.
	This works for filetree (a special pharo format).
	Note that for a FileReference a trailing slash is not relevant"
	| path |
	
	self 
		assert: self scheme = #filetree 
		description: 'Only filetree:// URL can be converted to a FileReference with relative Paths'.
	
	self isSlash ifTrue: [ ^ FileSystem root ].
	
	path := self host 
		ifNotNil: [ segments copyWithFirst: self host ]
		ifNil: [ segments copyWithFirst: FileSystem disk delimiter asString ].
		
	^ (String streamContents: [ :stream |
		path 
			asStringOn: stream 
			delimiter: FileSystem disk delimiter asString ])
		asFileReference! !

!ZnUrl methodsFor: '*zinc-resource-meta-filesystem' stamp: 'SvenVanCaekenberghe 1/14/2013 11:37'!
asFileReference
	"Convert the receiver into a new FileReference object.
	Note that for a FileReference a trailing slash is not relevant"

	| path |
	self assert: self scheme = #file description: 'Only a file:// URL can be converted to a FileReference'.
	self isSlash
		ifTrue: [ ^ FileSystem root ].
	path := self isDirectoryPath
		ifTrue: [ segments allButLast ]
		ifFalse: [ segments copy ].
	^ FileReference fileSystem: FileSystem disk path: (AbsolutePath withAll: path)! !

!ZnUrl methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 1/3/2011 15:09'!
port
	^ port! !

!ZnUrl methodsFor: 'accessing-path' stamp: 'SvenVanCaekenberghe 5/14/2014 11:52'!
pathSegments
	^ segments ifNil: [ #() ]! !

!ZnUrl methodsFor: 'accessing-query' stamp: 'KenTreis 01/19/2013 12:35'!
queryAt: key add: value
	"Modify the receiver by adding a query variable key=value.
	If key already exists, value is added to it."

	query isNil 
		ifTrue: [ query := ZnMultiValueDictionary new ].
	query at: key asString add: (value ifNotNil: [value asString])! !

!ZnUrl methodsFor: 'accessing-query' stamp: 'KenTreis 01/19/2013 12:35'!
queryAt: key put: value
	"Modify the receiver by setting a query variable key=value.
	If key is already exists, it is overwritten."

	query isNil 
		ifTrue: [ query := ZnMultiValueDictionary new ].
	query at: key asString put: (value ifNotNil: [value asString])! !

!ZnUrl methodsFor: '*zinc-http' stamp: 'SvenVanCaekenberghe 6/25/2014 17:15'!
saveContentsToFile: aFilename
	"Download and return a fileReference to the resource that I refer to.

	If something goes wrong, an exception will be signalled."
	
	" 'http://zn.stfx.eu/zn/numbers.txt' asZnUrl saveContentsToFile: Path * 'numbers.txt'. "
	
	^ self performOperation: #saveContentsToFile: with: aFilename! !

!ZnUrl methodsFor: 'convenience' stamp: 'SvenVanCaekenberghe 7/9/2012 16:27'!
? association
	^ self withQuery: association ! !

!ZnUrl class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 3/12/2014 14:20'!
schemesNotUsingDoubleSlash
	"Most URL schemes use a double slash, as in http://
	but some don't, return a list of those"
	
	^ #( #mailto #telnet )! !

!ZnUrl class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 3/13/2015 16:23'!
defaultPortForScheme: scheme
	(#(http ws) includes: scheme) ifTrue: [ ^ 80 ].
	(#(https wss) includes: scheme)  ifTrue: [ ^ 443 ].
	^ nil! !

!ZnUrl class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 1/3/2011 19:35'!
fromString: string
	^ (self new)
		parseFrom: string; 
		yourself ! !

!ZnUrl class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 8/11/2011 14:47'!
fromString: string defaultScheme: defaultScheme
	^ (self new)
		parseFrom: string defaultScheme: defaultScheme; 
		yourself ! !

!ZnUrl class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 10/30/2013 14:38'!
schemesNotUsingPath
	"Most URL schemes use a hierarchical path
	but some don't, return a list of those"
	
	^ #( #mailto )! !

!ZnUrlOperation commentStamp: 'SvenVanCaekenberghe 10/24/2014 15:13'!
I am ZnUrlOperation.
I am an abtract superclass of operations that can be performed on ZnUrl objects.

Some operations, like retrieving the contents of a resource described by a URL, depend on elements, most likely the scheme, of the URL. By creating the appropriate subclasses, this behavior can be added.

I implement searching/matching logic on my class side.

  #performOperation:with:on:

which defaults to matching the #operation and #schemes.

I am instanciated to be executed. 

  #performOperation

A concrete example is ZnUrl>>#retrieveContents with subclasses ZnHttpRetrieveContents and ZnFileRetrieveContents.

Part of Zinc HTTP Components.!
!ZnUrlOperation methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/6/2013 13:19'!
url
	
	^ url! !

!ZnUrlOperation methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/6/2013 13:27'!
url: aUrl
	
	url := aUrl! !

!ZnUrlOperation methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/6/2013 13:19'!
argument: anObject
	
	argument := anObject! !

!ZnUrlOperation methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 11/6/2013 13:28'!
performOperation
	"Perform the actual operation using url and the optional argument."
	
	self subclassResponsibility 
! !

!ZnUrlOperation methodsFor: 'printing' stamp: 'SvenVanCaekenberghe 11/6/2013 14:01'!
printOn: stream
	super printOn: stream.
	stream nextPut: $(; print: self class operation; space; print: self url.
	self argument ifNotNil: [ :arg | stream space; print: arg ].
	stream nextPut: $)! !

!ZnUrlOperation methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 11/6/2013 13:19'!
argument
	
	^ argument! !

!ZnUrlOperation class methodsFor: 'acccessing' stamp: 'SvenVanCaekenberghe 11/6/2013 13:26'!
operation
	"Return the operation that I implement.
	Subclasses can/should override this method."
	
	^ nil! !

!ZnUrlOperation class methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 11/6/2013 13:47'!
performOperation: operation with: argument on: url
	"Search for a subclass that can handle operation with argument on url.
	Instanciate the operation, execute it and return the result.
	Signal an Error when no matching handler is found."
	
	| handlerClass |
	handlerClass := self handlerForOperation: operation with: argument on: url.
	^ handlerClass new
		url: url;
		argument: argument;
		performOperation ! !

!ZnUrlOperation class methodsFor: 'acccessing' stamp: 'SvenVanCaekenberghe 11/6/2013 13:45'!
handlesOperation: operation with: argument on: url
	"Return true when my instances can handle operation with argument on url.
	This can optionally be overridden for a more specific test."
	
	^ self operation = operation and: [ self schemes includes: url scheme ]! !

!ZnUrlOperation class methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 10/24/2014 15:49'!
handlerForOperation: operation with: argument on: url
	"Search for a subclass that can handle operation with argument on url.
	Signal an Error when no matching handler is found."

	self subclassesDo: [ :each |
		(each handlesOperation: operation with: argument on: url)
			ifTrue: [ ^ each ] ].
	self error: 
		('No URL hander found for operation {1} on URL {2} with {3}' 
			format: { operation. url. argument })! !

!ZnUrlOperation class methodsFor: 'acccessing' stamp: 'SvenVanCaekenberghe 11/6/2013 13:27'!
schemes
	"Return a collection of scheme identifiers that I handle.
	Subclasses can/should override this method."
	
	^ #( )! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/16/2013 18:41'!
testBogusBackups
	self assert: '/../../../' asZnUrl isSlash! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/11/2011 15:20'!
testParsePathOnly
	| url |
	url := '/images/foo.png?size=large#center' asZnUrl.
	self assert: url hasScheme not.
	self assert: url hasHost not.
	self assert: url hasPort not.
	self assert: url isAbsolute not.
	self assert: url pathSegments = (OrderedCollection with: 'images' with: 'foo.png' ).
	self assert: url firstPathSegment = 'images'.
	self assert: url lastPathSegment = 'foo.png'.
	self assert: url hasQuery.
	self assert: (url queryAt: 'size') = 'large'.
	self assert: url hasFragment.
	self assert: url fragment = 'center'  ! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/30/2013 17:25'!
testParsingWrongScheme
	| url |
	url := ZnUrl fromString: 'git://user@foo.com/bar'.
	self assert: url scheme equals: #git.
	self assert: url username equals: 'user'.
	self assert: url host equals: 'foo.com'.
	self assert: url path equals: 'bar'.
	self should: [ url enforceKnownScheme ] raise: ZnUnknownScheme ! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/11/2011 15:10'!
testRelative
	| url |
	url := 'http://api.foo.com:8080' asZnUrl.
	self assert: url isAbsolute.
	url parseFrom: '/user/1?format=full'.
	self assert: url printString = 'http://api.foo.com:8080/user/1?format=full'! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/6/2013 20:53'!
testInContextOf
	| baseUrl url |
	baseUrl := 'http://zn.stfx.eu/foo.txt' asZnUrl.
	url := ZnUrl new addPathSegment: 'bar.txt'.
	self assert: (url inContextOf: baseUrl) equals: 'http://zn.stfx.eu/bar.txt' asZnUrl.
	"The following holds for all URLs"
	self assert: (baseUrl asRelativeUrl inContextOf: baseUrl) equals: baseUrl! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/15/2014 12:34'!
testPlusHandling
	"While percent decoding, a + is translated as a space only in the context of 
	application/x-www-form-urlencoded get/post requests:
	http://en.wikipedia.org/wiki/Percent-encoding#The_application.2Fx-www-form-urlencoded_type
	ZnUrl interprets its query part as key value pairs where this translation is applicable,
	even though strictly speaking + (and =, &) are plain unreserved characters in the query part"
	
	"$+ is not special in the path part of the URL and it remains itself"
	self 
		assert: 'http://localhost/foo+bar' asZnUrl firstPathSegment 
		equals: 'foo+bar'.
	self 
		assert: 'http://localhost/foo+bar' asZnUrl printString 
		equals: 'http://localhost/foo+bar'.
	"$+ gets decoded to space in the interpreted query part of the URL, 
	and becomes an encoded space if needed"
	self 
		assert: ('http://localhost/test?q=foo+bar' asZnUrl queryAt: #q)
		equals: 'foo bar'.
	self 
		assert: 'http://localhost/test?q=foo+bar' asZnUrl printString
		equals: 'http://localhost/test?q=foo%20bar'.
	"to pass $+ as $+ in a query, it has to be encoded"
	self 
		assert: 'http://localhost/test?q=foo%2Bbar' asZnUrl printString
		equals: 'http://localhost/test?q=foo%2Bbar'! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 4/17/2011 10:29'!
testEncodedSlash
	self assert: 'http://example.com/foo//' asZnUrl pathPrintString = '/foo/'.
	self assert: 'http://example.com/foo//bar/' asZnUrl pathPrintString = '/foo/bar/'.
	self assert: 'http://example.com/foo//bar/file.txt' asZnUrl pathPrintString = '/foo/bar/file.txt'.

	self assert: 'http://example.com/foo/%2F' asZnUrl pathPrintString = '/foo/%2F'.
	self assert: 'http://example.com/foo/%2Fbar/' asZnUrl pathPrintString = '/foo/%2Fbar/'.
	self assert: 'http://example.com/foo/%2F/bar/' asZnUrl pathPrintString = '/foo/%2F/bar/'.
	self assert: 'http://example.com/foo/%2Ffoo.txt' asZnUrl pathPrintString = '/foo/%2Ffoo.txt'.

! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 10/24/2013 10:24'!
testComponentSpecifcEncoding
	"In a URL the safe set of percent encoding depends on where we are"
	
	| url |
	url := 'http://foo.com/bar@xx=2?yy=/#$1'.
	self assert: url asZnUrl printString equals: url! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/17/2012 13:12'!
testParsingWrongEscapeQuery
	self should: [ ZnUrl fromString: 'http://foo:8080/foo?%%bar=1' ] raise: ZnCharacterEncodingError ! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/15/2015 11:46'!
testSchemeInQuery
	| url |
	url := '/foo/bar/file.txt?url=http://www.pharo.org' asZnUrl.
	self deny: url hasScheme.
	self deny: url hasHost.
	self assert: url isFilePath.
	self assert: (url queryAt: #url) equals: 'http://www.pharo.org'! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/13/2015 16:32'!
testDefaultPortUnknownScheme
	| url |
	url := 'gitfiletree://github.com/rohitsukhwal/HelloWorld.git?protocol=git' asZnUrl.
	self assert: url scheme equals: #gitfiletree.
	self assert: url host equals: 'github.com'.
	self assert: url authority equals: 'github.com'.
	self assert: url portOrDefault isNil.
	self deny: url hasPort.
	self assert: url equals: url.
	self should: [ url enforceKnownScheme ] raise: ZnUnknownScheme ! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/4/2011 15:26'!
testQuery
	| url |
	url := 'http://foo.com/test?q' asZnUrl.
	self assert: url printString = 'http://foo.com/test?q'! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/16/2013 20:41'!
testConvenienceMethods
	| baseUrl |
	baseUrl := 'http://api.host.com' asZnUrl.
	self 
		assert: baseUrl 
		equals: 'http://api.host.com' asZnUrl.
	self 
		assert: baseUrl / 'doc' / 'file.html'
		equals: 'http://api.host.com/doc/file.html' asZnUrl.
	self 
		assert: baseUrl / 'doc/file.html'
		equals: 'http://api.host.com/doc/file.html' asZnUrl.
	self 
		assert: baseUrl / #( 'doc' 'file.html' )
		equals: 'http://api.host.com/doc/file.html' asZnUrl.
	self 
		assert: baseUrl / 'doc/file.html' asZnUrl
		equals: 'http://api.host.com/doc/file.html' asZnUrl.
	self 
		assert: (baseUrl / 'search' ? (#q -> 'Smalltalk') & (#lang -> #en))
		equals: 'http://api.host.com/search?q=Smalltalk&lang=en' asZnUrl.
	self 
		assert: baseUrl 
		equals: 'http://api.host.com' asZnUrl! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/30/2013 16:45'!
testUserInfo
	| url |
	url := 'http://john:secret@www.foo.com:8888/foo/bar.txt' asZnUrl.
	self assert: url scheme equals: #http.
	self assert: url username equals: 'john'.
	self assert: url password equals: 'secret'.
	self assert: url host equals: 'www.foo.com'.
	self assert: url port equals: 8888.
	self assert: url pathSegments asArray equals: #('foo' 'bar.txt').
	url := 'http://john@www.foo.com:8888/foo/bar.txt' asZnUrl.
	self assert: url scheme equals: #http.
	self assert: url username equals: 'john'.
	self deny: url hasPassword.
	self assert: url host equals: 'www.foo.com'.
	self assert: url port equals: 8888.
	self assert: url pathSegments asArray equals: #('foo' 'bar.txt')! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/28/2011 15:36'!
testParsingEscape
	| url |
	url := ZnUrl fromString: 'http://localhost/foo%62%61%72'.
	self assert: url firstPathSegment = 'foobar'! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/26/2014 14:41'!
testQueryAccessing
	| url |
	url := 'http://www.google.com/?one=1&two=2' asZnUrl.
	self assert: url hasQuery.
	self assert: url queryKeys sorted equals: #(one two).
	self assert: (url queryAt: 'two' ifAbsent: [ self fail ]) equals: '2'.
	self assert: (url queryAt: 'three' ifAbsent: [ #missing ]) equals: #missing.
	url queryAt: 'one' ifPresent: [ :value | self assert: value equals: '1' ].
	self assert: (url queryAt: 'three' ifPresent: [ :value | self fail ]) isNil! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/4/2011 13:05'!
testAuthority
	self assert: 'http://localhost:8080/foo/bar/doc.txt' asZnUrl authority = 'localhost:8080'.
	self assert: 'http://www.google.com?q=Smalltalk' asZnUrl authority = 'www.google.com'! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/14/2013 11:42'!
testFileUrl
	| url |
	url := 'file://localhost/users/Sven/Desktop/foo.txt' asZnUrl.
	self assert: url isFile.
	self assert: url host equals: 'localhost'.
	self assert: url pathSegments equals: #( 'users' 'Sven' 'Desktop' 'foo.txt' ) asOrderedCollection ! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 10/24/2013 10:02'!
testQueryEncoding
	| url |
	url := 'http://www.google.com' asZnUrl.
	url addPathSegment: 'some encoding here'.
	url queryAt: 'and some encoding' put: 'here, too#'.
	self assert: url printString = 'http://www.google.com/some%20encoding%20here?and%20some%20encoding=here,%20too%23'.
	self assert: url path =  'some encoding here'.
	self assert: (url queryAt: 'and some encoding') = 'here, too#'
	! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/4/2011 13:57'!
testWriteUrlPathQueryFragmentOfOn
	| string |
	string := String streamContents: [ :stream |
		'http://host:7777/foo/bar/doc.txt?x=1#mark' asZnUrl printPathQueryFragmentOn:  stream ].
	self assert: string = '/foo/bar/doc.txt?x=1#mark'! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/13/2011 10:44'!
testLocalHost
	self assert: 'http://localhost:8080/foo' asZnUrl isLocalHost.
	self assert: 'http://127.0.0.1:8080/foo' asZnUrl isLocalHost.
	self assert: 'http://LOCALHOST:8080/foo' asZnUrl isLocalHost.
	self deny: 'http://zn.stx.eu' asZnUrl isLocalHost.
	self deny: '' asZnUrl isLocalHost.! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/13/2015 16:38'!
testNoScheme
	"When there is no scheme, there is no host:port interpretation, 
	but instead the input is seen a a path - externalize this in test code"
	
	#('foo' 'localhost' 'www.foo.com' 'foo.txt' 'foo:1')
		do: [ :input | 
			| url |
			url := input asZnUrl.
			self deny: url hasScheme.
			self deny: url hasHost.
			self deny: url hasPort.
			self deny: url hasQuery.
			self deny: url hasFragment.
			self assert: url hasPath.
			self assert: url isFilePath.
			self assert: url firstPathSegment equals: input ].

	#('/dir/foo.txt' 'dir/foo.txt')
		do: [ :input | 
			| url |
			url := input asZnUrl.
			self deny: url hasScheme.
			self deny: url hasHost.
			self deny: url hasPort.
			self deny: url hasQuery.
			self deny: url hasFragment.
			self assert: url hasPath.
			self assert: url isFilePath.
			self assert: url pathSegments equals: #('dir' 'foo.txt') asOrderedCollection ]! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/17/2012 13:12'!
testParsingWrongEscape
	self should: [ ZnUrl fromString: 'http://foo:8080/foo%%bar' ] raise: ZnCharacterEncodingError ! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/11/2011 15:14'!
testDefaultSchemeAndPort
	| url |
	url := '' asZnUrl.
	self assert: url hasScheme not.
	self assert: url hasPort not.
	self assert: url port isNil.
	self assert: url scheme isNil.
	self assert: url schemeOrDefault = #http.
	self assert: url portOrDefault = 80
	! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/11/2011 15:13'!
testDefaultScheme
	| url |
	url := ZnUrl fromString: 'www.example.com/foo.html' defaultScheme: #http.  
	self assert: url hasScheme.
	self assert: url scheme = #http.
	self assert: url host = 'www.example.com'.
	self assert: url pathSegments = (OrderedCollection with: 'foo.html')
	! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/14/2013 11:38'!
testParsingSimple
	| url |
	url := ZnUrl fromString: 'http://www.example.com:8080/foo/bar/baz.txt?x=1&y=2#m1'.
	self assert: url scheme = #http.
	self assert: url host = 'www.example.com'.
	self assert: url port = 8080.
	self assert: url hasPath.
	self assert: url isFilePath.
	self assert: url hasQuery.
	self assert: url hasFragment.
	self assert: url fragment = 'm1'! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/14/2013 11:38'!
testPrintingSimple
	| url |
	(url := ZnUrl new)
		scheme: #http;
		host: 'www.seaside.st';
		port: 8080;
		addPathSegment: 'example';
		addPathSegment: 'foo.html';
		queryAt: 'q' put: '100';
		fragment: 'mark'.
	self assert: url authority = 'www.seaside.st:8080'.
	self assert: url isAbsolute.
	self assert: url isFilePath.
	self assert: url printString = 'http://www.seaside.st:8080/example/foo.html?q=100#mark'.
	self assert: url file = 'foo.html'.
	self assert: url directory = 'example'.
	self assert: url pathPrintString = '/example/foo.html'.
	self assert: url pathQueryFragmentPrintString = '/example/foo.html?q=100#mark'! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/11/2011 15:14'!
testDefaults
	| url |
	url := '' asZnUrl asZnUrlWithDefaults.
	self assert: url hasScheme.
	self assert: url hasPort.
	self assert: url scheme = #http.
	self assert: url port = 80
	! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/4/2011 12:17'!
testParsingEmpty
	| url |
	url := ZnUrl fromString: ''.
	self assert: url isEmpty.
	url := ZnUrl fromString: '/'.
	self assert: url isEmpty.
	url := ZnUrl fromString: '//./foo/../'.
	self assert: url isEmpty! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/4/2011 13:42'!
testIsSlash
	self assert: '' asZnUrl isSlash.
	self assert: '/' asZnUrl isSlash.
	self assert: '/foo' asZnUrl isSlash not.
	self assert: 'http://host/foo' asZnUrl isSlash not.! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/6/2013 20:43'!
testAsRelativeUrl
	| url |
	url := 'http://api.foo.com:8080/foo/bar.txt' asZnUrl.
	self assert: url hasHost.
	self assert: url hasScheme.
	self assert: url hasPort.
	self assert: url path equals: 'foo/bar.txt'.
	url := url asRelativeUrl.
	self deny: url hasHost.
	self deny: url hasScheme.
	self deny: url hasPort.
	self assert: url path equals: 'foo/bar.txt'.
	self assert: url asString equals: '/foo/bar.txt'! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/6/2013 20:43'!
testPathRemoval
	| url |
	url := 'http://api.foo.com:8080/foo/123/bar.txt?x=1&y=2' asZnUrl.
	self assert: url path equals: 'foo/123/bar.txt'.
	url removeFirstPathSegment.
	self assert: url path equals: '123/bar.txt'.
	url removeLastPathSegment.
	self assert: url path equals: '123'.
	url clearPath.
	self deny: url hasPath.
	self assert: (url queryAt: #x) equals: '1'.
	self assert: (url queryAt: #y) equals: '2'.
	self assert: url scheme equals: #http.
	self assert: url host equals: 'api.foo.com'.
	self assert: url port equals: 8080! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/6/2013 20:11'!
testQueryManipulation
	| url |
	url := 'http://www.google.com/?one=1&two=2' asZnUrl.
	url queryAt: 'three' put: '3'.
	url queryRemoveKey: 'one'.
	self assert: url queryKeys sorted = #(three two).
	self assert: (url queryAt: 'two') = '2'.
	self assert: (url queryAt: 'three') = '3'.
	url queryRemoveAll.
	self deny: url hasQuery! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/6/2013 18:21'!
testWindowsFileUrl
	| url |
	url := 'file://localhost/C:/users/Sven/Desktop/foo.txt' asZnUrl.
	self assert: url isFile.
	self assert: url host equals: 'localhost'.
	self assert: url pathSegments equals: #( 'C:' 'users' 'Sven' 'Desktop' 'foo.txt' ) asOrderedCollection ! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/12/2013 21:26'!
testQueryEncodingExtended
	| url |
	url := 'http://server.com/foo' asZnUrl.
	url 
		queryAt: 'one' put: '1';
		queryAt: 'equalSign' put: 'a=0';
		queryAt: 'ampersand' put: 'm&m';
		queryAt: 'questionMark' put: 'x?-1'.
	url := url asString asZnUrl.
	self assert: (url queryAt: 'one') equals: '1'.
	self assert: (url queryAt: 'equalSign') equals: 'a=0'.
	self assert: (url queryAt: 'ampersand') equals: 'm&m'.
	self assert: (url queryAt: 'questionMark') equals: 'x?-1'
! !

!ZnUrlTests methodsFor: '*zinc-tests' stamp: 'SvenVanCaekenberghe 6/25/2014 21:55'!
testSaveContentsToFile
	| url target result numbers |
	url := 'http://zn.stfx.eu/zn/numbers.txt' asZnUrl.
	target := Path * 'numbers.txt'.
	ZnFileSystemUtils deleteIfExists: target .
	result := url saveContentsToFile: target.
	self assert: result exists.
	numbers := result readStreamDo: [ :in | in upToEnd ].
	numbers := numbers lines collect: [ :each | each asInteger ].
	self assert: (numbers allSatisfy: [ :each | each isInteger ]).
	ZnFileSystemUtils deleteIfExists: result ! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/5/2015 22:25'!
testReferenceResolution
	"RFC 3986 Section 5"
	
	| baseUri specification result succeeded failed |
	baseUri := 'http://a/b/c/d;p?q' asZnUrl.
	specification := {
		"Examples 5.4.1 - Normal" 
		" 'g:h' -> 'g:h'. " "we do not support unknown schemes without //"
		'mailto:john@acme.com' -> 'mailto:john@acme.com'. "this we can do"
		'g' -> 'http://a/b/c/g'.
		'./g' -> 'http://a/b/c/g'.
		'g/' -> 'http://a/b/c/g/'.
		'/g' -> 'http://a/g'.
		'//g' -> 'http://g/'.  "a trailing slash is added automatically"
		'//a.com/assets/img.jpg' -> 'http://a.com/assets/img.jpg'.
		'?y' -> 'http://a/b/c/d;p?y'.
		'g?y' -> 'http://a/b/c/g?y'.
		'#s' -> 'http://a/b/c/d;p?q#s'.
		'g#s' -> 'http://a/b/c/g#s'.
		'g?y#s' -> 'http://a/b/c/g?y#s'.
		';x' -> 'http://a/b/c/;x'.
		'g;x' -> 'http://a/b/c/g;x'.
		'g;x?y#s' -> 'http://a/b/c/g;x?y#s'.
		'' -> 'http://a/b/c/d;p?q'.
		'.' -> 'http://a/b/c/'.
		'./' -> 'http://a/b/c/'.
		'..' -> 'http://a/b/'.
		'../' -> 'http://a/b/'.
		'../g' -> 'http://a/b/g'.
		'../..' -> 'http://a/'.
		'../../' -> 'http://a/'.
		'../../g' -> 'http://a/g'.
		"Examples 5.4.2 - Abnormal" 
		'../../../g' -> 'http://a/g'.
		'../../../../g' -> 'http://a/g'.
		'/./g' -> 'http://a/g'.
		'/../g' -> 'http://a/g'.
		'g.' -> 'http://a/b/c/g.'.
		'.g' -> 'http://a/b/c/.g'.
		'g..' -> 'http://a/b/c/g..'.
		'..g' -> 'http://a/b/c/..g'.
		'./../g' -> 'http://a/b/g'.
		'./g/.' -> 'http://a/b/c/g/'.
		'g/./h' -> 'http://a/b/c/g/h'.
		'g/../h' -> 'http://a/b/c/h'.
		'g;x1/./y' -> 'http://a/b/c/g;x1/y'.
		'g;x1/../y' -> 'http://a/b/c/y'.
		'g?y/./x' -> 'http://a/b/c/g?y/./x'.
		'g?y/../x' -> 'http://a/b/c/g?y/../x'.
		'g#s/./x' -> 'http://a/b/c/g#s/./x'.
		'g#s/../x' -> 'http://a/b/c/g#s/../x'.
		'http://g' -> 'http://g/' "a trailing slash is added automatically"
	}.
	result := specification withIndexCollect: [ :spec :index | | resolved success |
		resolved := baseUri withRelativeReference: spec key.
		success := resolved asString = spec value.
		{ #input -> spec key. #expected -> spec value. #index -> index.
		#resolved -> resolved. #result -> success } asDictionary ].
	succeeded := result select: [ :each | each at: #result ].
	failed := result reject: [ :each | each at: #result ].
	self assert: failed isEmpty! !

!ZnUrlTests methodsFor: '*zinc-tests' stamp: 'SvenVanCaekenberghe 1/24/2012 11:44'!
testRetrieveContents
	| numbers |
	numbers := 'http://zn.stfx.eu/zn/numbers.txt' asZnUrl retrieveContents.
	numbers := numbers lines collect: [ :each | each asInteger ].
	self assert: (numbers allSatisfy: [ :each | each isInteger ]).
	self should: [ 'http://zn.stfx.eu/zn/numbers-wrong.txt' asZnUrl retrieveContents ] raise: Error! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/28/2011 15:28'!
testParsingWrongPort
	self should: [ ZnUrl fromString: 'http://foo:bar' ] raise: ZnPortNotANumber   ! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 10/30/2013 14:26'!
testMailto
	| url |
	url := 'mailto:sven@beta9.be?subject=test' asZnUrl.
	self assert: url scheme equals: #mailto.
	self assert: url mailToAddress equals: 'sven@beta9.be'.
	self assert: (url queryAt: 'subject') equals: 'test'.
	self assert: url printString equals: 'mailto:sven@beta9.be?subject=test'! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/14/2014 11:56'!
testPathSegments
	self 
		assert: 'http://foo.com/x/y/z' asZnUrl pathSegments 
		equals: #('x' 'y' 'z') asOrderedCollection.
	self assert: 'http://foo.com/' asZnUrl pathSegments isEmpty.
	self assert: 'http://foo.com' asZnUrl pathSegments isEmpty! !

!ZnUrlTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 2/13/2014 22:27'!
testNoSchemeColonInPath
	| url |
	url := '/foo:bar' asZnUrl.
	self deny: url hasScheme.
	self deny: url hasHost.
	self deny: url hasPort.
	self deny: url hasQuery.
	self deny: url hasFragment.
	self assert: url hasPath.
	self assert: url firstPathSegment equals: 'foo:bar'! !

!ZnUserAgentSession commentStamp: 'SvenVanCaekenberghe 12/6/2010 13:04'!
I represent a session store for an HTTP client instance of ZnUserAgent. 

I hold the cookie jar for the session and any authentication credentials used by the client.

Part of Zinc HTTP Components.!
!ZnUserAgentSession methodsFor: 'accessing' stamp: 'MattKennedy 9/28/2010 14:31'!
addCredential: aCredential
	self credentials at: aCredential domain, '@', aCredential realm put: aCredential ! !

!ZnUserAgentSession methodsFor: 'accessing' stamp: 'MattKennedy 9/28/2010 17:24'!
currentRealm: anObject
	currentRealm := anObject! !

!ZnUserAgentSession methodsFor: 'accessing' stamp: 'MattKennedy 9/28/2010 10:50'!
cookiejar: anObject
	cookiejar := anObject! !

!ZnUserAgentSession methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:24'!
credentialAt: aRealm forUrl: urlObject
	^ self credentials at: urlObject authority, '@', aRealm ifAbsent: [ nil ]! !

!ZnUserAgentSession methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/30/2011 22:00'!
cookieJar
	^ cookiejar ifNil: [ cookiejar := ZnCookieJar new ]! !

!ZnUserAgentSession methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/23/2012 14:34'!
credentialsForUrl: urlObject
	^ self credentials values select: [ :cred | urlObject authority includesSubstring: (cred domain) ]! !

!ZnUserAgentSession methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:14'!
credentials
	^ credentials ifNil: [ credentials := Dictionary new ]! !

!ZnUserAgentSession methodsFor: 'accessing' stamp: 'MattKennedy 9/28/2010 10:50'!
credentials: anObject
	credentials := anObject! !

!ZnUserAgentSession methodsFor: 'accessing' stamp: 'MattKennedy 9/28/2010 17:24'!
currentRealm
	^ currentRealm! !

!ZnUserAgentSession methodsFor: 'operations' stamp: 'SvenVanCaekenberghe 2/29/2012 17:40'!
resetCookies
	cookiejar ifNotNil: [ cookiejar removeAll ]! !

!ZnUserAgentSession class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 8/18/2011 14:24'!
withCookieJar: aCookieJar
	^ self new cookiejar: aCookieJar; yourself! !

!ZnUserAgentSessionTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 12/7/2010 00:00'!
testWithCookieJar
	self assert: ((ZnUserAgentSession withCookieJar: ZnCookieJar new) notNil)! !

!ZnUserAgentSessionTests methodsFor: 'testing' stamp: 'MattKennedy 9/28/2010 15:14'!
testAddCredential
	| session count |
	session := ZnUserAgentSession new.
	count := session credentials size.
	session addCredential: self dummyCredential.
	self assert: ((session credentials size) = (count + 1))! !

!ZnUserAgentSessionTests methodsFor: 'accessing' stamp: 'MattKennedy 9/28/2010 15:11'!
dummyCredential
	^ZnBasicCredential new 
		username: 'test'; 
		password: 'foobar';
		realm: 'dummy';
		domain: 'test.com';
		yourself! !

!ZnUserAgentSessionTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/30/2011 22:00'!
testAccessors
	| session |
	session := ZnUserAgentSession new.
	self assert: (session cookieJar isKindOf: ZnCookieJar).
	self assert: (session credentials notNil)! !

!ZnUtils commentStamp: 'SvenVanCaekenberghe 1/18/2011 11:03'!
I am ZnUtils holding various utilities related to HTTP handling.

Part of Zinc HTTP Components.!
!ZnUtils class methodsFor: 'streaming' stamp: 'SvenVanCaekenberghe 6/11/2013 14:04'!
readUpToEnd: inputStream limit: limit
	| species bufferSize buffer totalRead outputStream |
	bufferSize := limit ifNil: [ self streamingBufferSize ] ifNotNil: [ self streamingBufferSize min: limit ].
	species := inputStream isBinary ifTrue: [ ByteArray ] ifFalse: [ String ].
	buffer := species new: bufferSize.
	totalRead := 0.
	outputStream := nil.
	[ inputStream atEnd ] whileFalse: [ | readCount |
		readCount := inputStream readInto: buffer startingAt: 1 count: bufferSize.
		totalRead := totalRead + readCount.
		(limit notNil and: [ totalRead > limit ])
			ifTrue: [ ZnEntityTooLarge signal ].
		outputStream ifNil: [ 
			inputStream atEnd
				ifTrue: [ ^ buffer copyFrom: 1 to: readCount ] 
				ifFalse: [ outputStream := (species new: bufferSize) writeStream ] ].
		outputStream next: readCount putAll: buffer startingAt: 1.
		self signalProgress: totalRead total: limit ].
	^ outputStream ifNil: [ species new ] ifNotNil: [ outputStream contents ]! !

!ZnUtils class methodsFor: 'conversions' stamp: 'SvenVanCaekenberghe 10/5/2010 21:24'!
trimString: string
	"Until String>>#trimBoth is available everywhere"
	
	| left right |
	left := 1.
	right := string size.
	[ left <= right and: [ (string at: left) isSeparator ] ]
		whileTrue: [ left := left + 1 ].
	[ left <= right and: [ (string at: right) isSeparator ] ]
		whileTrue: [ right := right - 1 ].
	^ string copyFrom: left to: right! !

!ZnUtils class methodsFor: 'streaming' stamp: 'SvenVanCaekenberghe 5/18/2013 18:58'!
bufferedWriteStreamOn: stream
	^ (ZnBufferedWriteStream on: stream)
		sizeBuffer: self streamingBufferSize;
		yourself! !

!ZnUtils class methodsFor: 'streaming' stamp: 'SvenVanCaekenberghe 9/17/2012 14:47'!
streamFrom: inputStream to: outputStream size: totalSize
	| bufferSize buffer leftToRead |
	bufferSize := self streamingBufferSize min: totalSize.
	buffer := (inputStream isBinary ifTrue: [ ByteArray ] ifFalse: [ String ]) new: bufferSize.
	leftToRead := totalSize.
	[ leftToRead > 0 ]
		whileTrue: [ | readCount |
			readCount := bufferSize min: leftToRead.
			inputStream next: readCount into: buffer.
			leftToRead := leftToRead - readCount.
			outputStream next: readCount putAll: buffer startingAt: 1.
			leftToRead > 0 
				ifTrue: [
					self signalProgress: (totalSize - leftToRead) total: totalSize.
					outputStream flush ] ]! !

!ZnUtils class methodsFor: 'streaming' stamp: 'SvenVanCaekenberghe 9/17/2012 14:47'!
streamFrom: inputStream to: outputStream
	| buffer totalRead |
	buffer := (inputStream isBinary ifTrue: [ ByteArray ] ifFalse: [ String ]) new: self streamingBufferSize.
	totalRead := 0.
	[ inputStream atEnd ]
		whileFalse: [ | readCount |
			readCount := inputStream readInto: buffer startingAt: 1 count: buffer size.
			readCount > 0
				ifTrue: [
					totalRead := totalRead + readCount.
					outputStream next: readCount putAll: buffer startingAt: 1 ].
			inputStream atEnd
				ifFalse: [
					self signalProgress: totalRead total: nil. 
					outputStream flush ] ]! !

!ZnUtils class methodsFor: 'streaming' stamp: 'SvenVanCaekenberghe 5/28/2013 13:04'!
nextPutAll: collection on: stream
	| totalWritten toWrite total |
	total := collection size.
	"Do not enter the loop for small sizes"
	total < self streamingBufferSize
		ifTrue: [ ^ stream nextPutAll: collection ].
	totalWritten := 0.
	[ totalWritten < total ] whileTrue: [ 
		toWrite := self streamingBufferSize min: (total - totalWritten).
		stream next: toWrite putAll: collection startingAt: totalWritten + 1.
		totalWritten := totalWritten + toWrite.
		self signalProgress: totalWritten total: total ]! !

!ZnUtils class methodsFor: 'conversions' stamp: 'SvenVanCaekenberghe 3/2/2014 19:02'!
httpDate: object
	"Answers a string formatting object as time stamp for HTTP1.1 (RFC 1123). 
	Eg. Sun, 06 Nov 1994 08:49:37 GMT"

	| utc |
	utc := object asDateAndTime asUTC.
	^ String streamContents: [ :stream |
		stream nextPutAll: utc dayOfWeekAbbreviation; nextPut: $,; space.
		stream nextPutAll: (utc dayOfMonth printStringLength: 2 padded: true).
		stream space; nextPutAll: utc monthAbbreviation; space.
		utc year printOn: stream.
		stream space.
		utc printHMSOn: stream.
		stream nextPutAll: ' GMT' ]! !

!ZnUtils class methodsFor: 'conversions' stamp: 'SvenVanCaekenberghe 11/10/2013 11:28'!
parseHttpDate: string
	"self parseHttpDate: 'Tue, 13 Sep 2011 08:04:49 GMT'."
	"self parseHttpDate: 'Tue, 13-Sep-2011 08:04:51 GMT'."
	"self parseHttpDate: 'Tue Jan 01 00:00:01 2036 GMT'."
	
	| tokens day month year hour minute second months map yearToken |
	tokens := (string findTokens: #( $ $- $: $, )) allButFirst.
	tokens last = 'GMT' ifTrue: [ tokens := tokens allButLast ].
	months := #(jan feb mar apr may jun jul aug sep oct nov dec).
	(Integer readFrom: tokens first ifFail: [ 0 ]) isZero
		ifTrue: [ map := #(2 1 6 3 4 5) ]
		ifFalse: [ map := #(1 2 3 4 5 6) ].
	day := Integer readFrom: (tokens at: map first) ifFail: [ 0 ].
	month := months indexOf: (((tokens at: map second) asLowercase) copyFrom: 1 to: 3) ifAbsent: [ 0 ].
	yearToken := tokens at: map third.
	year := yearToken isAllDigits
		ifTrue: [
			year := yearToken asNumber.
			yearToken size = 2
				ifTrue: [
					year < 50
						ifTrue: [ year + 2000 ]
						ifFalse: [ year + 1900 ] ]
				ifFalse: [ year ] ]
		ifFalse: [ 0 ].
	hour := Integer readFrom: (tokens at: map fourth) ifFail: [ 0 ].
	minute := Integer readFrom: (tokens at: map fifth) ifFail: [ 0 ].
	second := Integer readFrom: (tokens at: map sixth) ifFail: [ 0 ].
	^ DateAndTime year: year month: month day: day hour: hour minute: minute second: second offset: Duration zero! !

!ZnUtils class methodsFor: 'streaming' stamp: 'SvenVanCaekenberghe 9/28/2013 18:00'!
signalProgress: amount total: total
	ZnSignalProgress enabled
		ifTrue: [ 
			total 
				ifNil: [ 
					HTTPProgress new 
						signal: ('Transferred {1} bytes ...' format: { amount asBytesDescription }) ]
				ifNotNil: [ 
					HTTPProgress new 
						total: total; 
						amount: amount;
						signal: 'Transferring...' ] ]! !

!ZnUtils class methodsFor: 'accessing' stamp: 'SvenVanCaekenberghe 12/14/2010 13:10'!
currentProcessID
	"Return a integer of at most 6 digits that can be used as a description for the current active process.
	This is a reduced hash that is not necessarily unique (but uniqueness is very probably)"
	
	^ Processor activeProcess hash \\ 999999! !

!ZnUtils class methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/18/2011 14:15'!
isCapitalizedString: string
	| capitalExpected |
	capitalExpected := true.
	string do: [ :each |
		each isAlphaNumeric
			ifTrue: [
				((capitalExpected and: [ each isUppercase ])
					or: [ capitalExpected not and: [ each isLowercase ] ])
					ifTrue: [ capitalExpected := false ]
					ifFalse: [ ^ false ] ] 
		 	ifFalse: [ capitalExpected := true ] ].
	^ true



! !

!ZnUtils class methodsFor: 'conversions' stamp: 'SvenVanCaekenberghe 2/24/2014 17:08'!
decodeBase64: string
	| bytes |
	bytes := ZnBase64Encoder new decode: string.
	^ ZnNullEncoder new decodeBytes: bytes! !

!ZnUtils class methodsFor: 'conversions' stamp: 'SvenVanCaekenberghe 2/24/2014 17:07'!
encodeBase64: string
	| bytes |
	bytes := ZnNullEncoder new encodeString: string.
	^ ZnBase64Encoder new encode: bytes! !

!ZnUtils class methodsFor: 'conversions' stamp: 'SvenVanCaekenberghe 9/10/2010 20:14'!
capitalizeString: string
	| capitalExpected |
	capitalExpected := true.
	^ String new: string size streamContents: [ :stream |
		string do: [ :each |
			each isAlphaNumeric
				ifTrue: [
					capitalExpected 
						ifTrue: [ 
							stream nextPut: each asUppercase.
							capitalExpected := false. ]
						ifFalse: [ 
							stream nextPut: each asLowercase ] ] 
		 		ifFalse: [ 
					stream nextPut: each.
					capitalExpected := true ] ] ]! !

!ZnUtils class methodsFor: 'conversions' stamp: 'SvenVanCaekenberghe 9/16/2010 15:52'!
httpDate
	^ self httpDate: DateAndTime now! !

!ZnUtils class methodsFor: 'streaming' stamp: 'SvenVanCaekenberghe 9/17/2012 14:27'!
streamingBufferSize
	"Return the byte count used as buffer size when streaming"
	
	^ 16384! !

!ZnUtilsTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/31/2012 12:56'!
testStreamingBinary
	| data in out |
	data := ByteArray streamContents: [ :stream | 
		1 to: 10000 do: [ :each |
			stream nextPut: #(1 2 3) atRandom ] ].
	in := data readStream.
	out := WriteStream on: (ByteArray new: data size).
	ZnUtils streamFrom: in to: out size: data size.
	self assert: in atEnd.
	self assert: out contents = data ! !

!ZnUtilsTests methodsFor: 'testing' stamp: 'SeanDeNigris 5/10/2012 11:58'!
testParseHttpDateAlternative1
	"ANSI C's asctime() format"
	
	| timeStamp |
	timeStamp := ZnUtils parseHttpDate: 'Tue Jan 01 00:00:01 2036'.
	self assert: timeStamp dayOfMonth = 1.
	self assert: timeStamp monthIndex = 1.
	self assert: timeStamp year = 2036.
	self assert: timeStamp hour = 0.
	self assert: timeStamp minute = 0.
	self assert: timeStamp second = 1.
	self assert: timeStamp offset = Duration zero! !

!ZnUtilsTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/3/2012 22:37'!
testStreamingNonBinaryWithoutSize
	| data in out |
	data := String streamContents: [ :stream | 
		1 to: 10000 do: [ :each | 
			stream nextPut: 'abc' atRandom ] ].
	in := data readStream.
	out := WriteStream on: (String new: data size).
	ZnUtils streamFrom: in to: out.
	self assert: in atEnd.
	self assert: out contents equals: data ! !

!ZnUtilsTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/31/2012 12:58'!
testReadUpToEndNonBinary
	| data |
	data := String streamContents: [ :stream | 
		1 to: 10000 do: [ :each | 
			stream nextPut: 'abc' atRandom ] ].
	self assert: (ZnUtils readUpToEnd: data readStream limit: nil) = data.
	self assert: (ZnUtils readUpToEnd: data readStream limit: 10000) = data.
	self should: [ ZnUtils readUpToEnd: data readStream limit: 9999 ] raise: ZnEntityTooLarge 
! !

!ZnUtilsTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/10/2010 20:09'!
testCapitalizeString
	self assert: (ZnUtils capitalizeString: 'content-type') = 'Content-Type'.
	self assert: (ZnUtils capitalizeString: 'CONTENT-type') = 'Content-Type'.
	self assert: (ZnUtils capitalizeString: 'content-TYPE') = 'Content-Type'.
	self assert: (ZnUtils capitalizeString: 'WWW-Authenticate') = 'Www-Authenticate'.
	self assert: (ZnUtils capitalizeString: 'Content-MD5') = 'Content-Md5'.! !

!ZnUtilsTests methodsFor: 'testing' stamp: 'SeanDeNigris 5/10/2012 11:58'!
testParseHttpDate
	"RFC 822, updated by RFC 1123"
	
	| timeStamp |
	timeStamp := ZnUtils parseHttpDate: 'Tue, 13 Sep 2011 08:04:49 GMT'.
	self assert: timeStamp dayOfMonth = 13.
	self assert: timeStamp monthIndex = 9.
	self assert: timeStamp year = 2011.
	self assert: timeStamp hour = 8.
	self assert: timeStamp minute = 4.
	self assert: timeStamp second = 49.
	self assert: timeStamp offset = Duration zero.! !

!ZnUtilsTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/10/2012 20:27'!
testParseHttpDateDashesAlternative1
	"RFC 850, obsoleted by RFC 1036"
	
	| timeStamp |
	timeStamp := ZnUtils parseHttpDate: 'Tue, 13-Sep-2011 08:04:49 GMT'.
	self assert: timeStamp dayOfMonth = 13.
	self assert: timeStamp monthIndex = 9.
	self assert: timeStamp year = 2011.
	self assert: timeStamp hour = 8.
	self assert: timeStamp minute = 4.
	self assert: timeStamp second = 49.
	self assert: timeStamp offset = Duration zero! !

!ZnUtilsTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 8/3/2012 22:36'!
testStreamingBinaryWithoutSize
	| data in out |
	data := ByteArray streamContents: [ :stream | 
		1 to: 10000 do: [ :each |
			stream nextPut: #(1 2 3) atRandom ] ].
	in := data readStream.
	out := WriteStream on: (ByteArray new: data size).
	ZnUtils streamFrom: in to: out.
	self assert: in atEnd.
	self assert: out contents equals: data ! !

!ZnUtilsTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/31/2012 12:57'!
testReadUpToEndBinary
	| data |
	data := ByteArray streamContents: [ :stream | 
		1 to: 10000 do: [ :each | 
			stream nextPut: #(1 2 3) atRandom ] ].
	self assert: (ZnUtils readUpToEnd: data readStream limit: nil) = data.
	self assert: (ZnUtils readUpToEnd: data readStream limit: 10000) = data.
	self should: [ ZnUtils readUpToEnd: data readStream limit: 9999 ] raise: ZnEntityTooLarge 
! !

!ZnUtilsTests methodsFor: 'testing' stamp: 'PaulDeBruicker 04/10/2011 10:48'!
testHttpDate
	| timestamp string |
	timestamp := (DateAndTime year: 2010 month: 9 day: 1 hour: 10 minute: 10 second: 10 offset: 0 seconds).
	string := ZnUtils httpDate: timestamp.
	self assert: (string = 'Wed, 01 Sep 2010 10:10:10 GMT')
	! !

!ZnUtilsTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 1/31/2012 12:56'!
testStreamingNonBinary
	| data in out |
	data := String streamContents: [ :stream | 
		1 to: 10000 do: [ :each | 
			stream nextPut: 'abc' atRandom ] ].
	in := data readStream.
	out := WriteStream on: (String new: data size).
	ZnUtils streamFrom: in to: out size: data size.
	self assert: in atEnd.
	self assert: out contents = data ! !

!ZnUtilsTests methodsFor: 'testing' stamp: 'SeanDeNigris 5/10/2012 11:58'!
testParseHttpDateDashes
	"RFC 850, obsoleted by RFC 1036"
	
	| timeStamp |
	timeStamp := ZnUtils parseHttpDate: 'Tuesday, 13-Sep-11 08:04:49 GMT'.
	self assert: timeStamp dayOfMonth = 13.
	self assert: timeStamp monthIndex = 9.
	self assert: timeStamp year = 2011.
	self assert: timeStamp hour = 8.
	self assert: timeStamp minute = 4.
	self assert: timeStamp second = 49.
	self assert: timeStamp offset = Duration zero! !

!ZnUtilsTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 9/10/2010 20:10'!
testIsCapitalizedString
	self assert: (ZnUtils isCapitalizedString: 'Content-Type').
	self assert: (ZnUtils isCapitalizedString: 'CONTENT-type') not.
	self assert: (ZnUtils isCapitalizedString: 'content-TYPE') not.
	self assert: (ZnUtils isCapitalizedString: 'WWW-Authenticate') not.
	self assert: (ZnUtils isCapitalizedString: 'Connection')! !

!ZnUtilsTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 3/21/2011 20:25'!
testBase64
	| short long encoded legalCharactes |
	legalCharactes := (String withAll: ($A to: $Z), ($a to: $z), ($0 to: $9)), '='.
	short := String withAll: ((1 to: 16) collect: [ :each | 'abc' atRandom ]).
	encoded := ZnUtils encodeBase64: short.
	self assert: (ZnUtils decodeBase64: encoded) = short.
	self assert: (encoded allSatisfy: [ :each | legalCharactes includes: each ]).
	"We don't want line breaks!!"
	long := String withAll: ((1 to: 64) collect: [ :each | 'abc' atRandom ]).
	encoded := ZnUtils encodeBase64: long.
	self assert: (ZnUtils decodeBase64: encoded) = long.
	self assert: (encoded allSatisfy: [ :each | legalCharactes includes: each ])
! !

!ZnUtilsTests methodsFor: 'testing' stamp: 'SvenVanCaekenberghe 5/22/2013 09:42'!
testNextPutAll
	| data result |
	data := String new: 64 * 1024 withAll: $A.
	result := String streamContents: [ :out | ZnUtils nextPutAll: data on: out ].
	self assert: result equals: data! !

!ZnValueDelegate commentStamp: 'SvenVanCaekenberghe 12/7/2010 16:14'!
I am ZnValueDelegate.
I forward #handleRequest: messages to the object that I wrap using #value:

ZnServer default delegate: 
	(ZnValueDelegate with: [ :request | 
		ZnResponse ok: (ZnEntity with: 'You asked for ', request uri printString) ] ).

Part of Zinc HTTP Components.!
!ZnValueDelegate methodsFor: 'initialize-release' stamp: 'SvenVanCaekenberghe 12/7/2010 16:15'!
object: anObject
	object := anObject! !

!ZnValueDelegate methodsFor: 'public' stamp: 'SvenVanCaekenberghe 12/7/2010 16:16'!
handleRequest: request
	^ object value: request! !

!ZnValueDelegate class methodsFor: 'instance creation' stamp: 'SvenVanCaekenberghe 3/2/2014 22:36'!
with: object
	^ self new
		object: object;
		yourself! !

!FLTGlobalClassOrTraitSerializationTest commentStamp: '<historical>'!
I test the serialization of classes and traits as *external* objects, i.e. the classes or traits have to be present in the image at materialization time.!
!FLTGlobalClassOrTraitSerializationTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 4/19/2012 12:59'!
testClassSideMethodNotFoundAfterRemoval
	"Tests that serializer does not tolarate when the method was removed between serialization and materialization"
	
	| classOrTrait |
	classOrTrait := self newClassOrTrait.
	classOrTrait classSide duringTestCompileSilently: 'you'.
	
	self serialize: classOrTrait classSide >> #you.
	classOrTrait classSide removeSelectorSilently: #you.
	
	self 
		should: [self materialized] 
		raise: FLMethodNotFound
		whoseDescriptionIncludes: classOrTrait classSide printString 
		description: 'Should raise an error when method is not present.' 
	
! !

!FLTGlobalClassOrTraitSerializationTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 4/19/2012 19:38'!
testClassSideObsolete
	"Tests that serializer does not serialize as global the class-side of an obsolete class or trait."
	
	| classOrTrait |
	classOrTrait := self newClassOrTrait.
	self removeFromSystem: classOrTrait.

	self 
		should: [self serialize: classOrTrait ] 
		raise: FLObsolete
		whoseDescriptionIncludes: classOrTrait name
		description: 'Should raise an error when serializing as global an obsolete class or trait.' ! !

!FLTGlobalClassOrTraitSerializationTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 4/19/2012 19:37'!
testObsolete
	"Tests that serializer does not serialize as global an obsolete class or trait."
	
	| classOrTrait |
	classOrTrait := self newClassOrTrait.
	self removeFromSystem: classOrTrait.

	self 
		should: [self serialize: classOrTrait ] 
		raise: FLObsolete
		whoseDescriptionIncludes: classOrTrait name
		description: 'Should raise an error when serializing as global an obsolete class or trait.' ! !

!FLTGlobalClassOrTraitSerializationTest methodsFor: 'tests' stamp: 'MartinDias 11/28/2011 01:03'!
testClassSidePreservesIdentity
	"Tests that serialization of the class side preserves identity"
	
	self assertSerializationIdentityOf: self newClassOrTrait classSide ! !

!FLTGlobalClassOrTraitSerializationTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 4/19/2012 12:59'!
testClassSideMethodPreservesIdentity
	"Tests that serialization of a method in the class-side of a class or trait preserves identity"
	
	| classOrTrait |
	classOrTrait := self newClassOrTrait.
	classOrTrait classSide duringTestCompileSilently: 'you'.
	self assertSerializationIdentityOf: classOrTrait classSide >> #you! !

!FLTGlobalClassOrTraitSerializationTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 4/19/2012 18:47'!
testNotFoundAfterRename
	"Tests that serializer does not tolarate when the class was renamed between serialization and materialization"
	
	| classOrTrait |
	classOrTrait := self newClassOrTrait.
	
	self serialize: classOrTrait.
	classOrTrait renameSilently: (classOrTrait name, 'Renamed') asSymbol.
	
	self should: [self materialized] raise: FLClassNotFound.! !

!FLTGlobalClassOrTraitSerializationTest methodsFor: 'tests' stamp: 'MartinDias 11/27/2011 21:08'!
testPreservesIdentity
	"Tests that serialization of the class or trait preserves identity"
	
	self assertSerializationIdentityOf: self newClassOrTrait! !

!FLTGlobalClassOrTraitSerializationTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 4/19/2012 12:59'!
testMethodNotFoundAfterRemoval
	"Tests that serializer does not tolarate when the method was removed between serialization and materialization"
	
	| classOrTrait |
	classOrTrait := self newClassOrTrait.
	classOrTrait duringTestCompileSilently: 'you'.
	
	self serialize: classOrTrait >> #you.
	classOrTrait removeSelectorSilently: #you.
	
	self 
		should: [self materialized] 
		raise: FLMethodNotFound
		whoseDescriptionIncludes: classOrTrait name, '>>#you' 
		description: 'Should raise an error when method is not present.' 
	
! !

!FLTGlobalClassOrTraitSerializationTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 4/19/2012 12:59'!
testMethodPreservesIdentity
	"Tests that serialization of a method in a class or trait preserves identity"
	
	| classOrTrait |
	classOrTrait := self newClassOrTrait.
	classOrTrait duringTestCompileSilently: 'you'.
	self assertSerializationIdentityOf: classOrTrait >> #you! !

!FLTGlobalClassOrTraitSerializationTest methodsFor: 'tests' stamp: 'MarianoMartinezPeck 4/19/2012 19:37'!
testNotFoundAfterRemoval
	"Tests that serializer does not tolarate when the class was removed between serialization and materialization"
	
	| classOrTrait |
	classOrTrait := self newClassOrTrait.
	
	self serialize: classOrTrait.
	self removeFromSystem: classOrTrait.
	
	self should: [self materialized] raise: FLClassNotFound.! !

!GLMBrickButtonStyle commentStamp: 'AliakseiSyrel 2/25/2015 20:59'!
I'm a style module related to the button and its componenets!
!GLMBrickButtonStyle methodsFor: 'brick-button' stamp: 'AliakseiSyrel 2/25/2015 21:47'!
buttonSelectedColor

	^ Color veryVeryLightGray lighter slightlyDarker! !

!GLMBrickButtonStyle methodsFor: 'brick-button' stamp: 'AliakseiSyrel 2/25/2015 21:44'!
buttonBorderWidth
	
	^ 1! !

!GLMBrickButtonStyle methodsFor: 'brick-button' stamp: 'AliakseiSyrel 2/25/2015 21:01'!
buttonBackgroundColor

	^ Color veryVeryLightGray lighter! !

!GLMBrickButtonStyle methodsFor: 'brick-button' stamp: 'AliakseiSyrel 2/25/2015 22:04'!
buttonMinHeight

	^ 26! !

!GLMBrickButtonStyle methodsFor: 'brick-button' stamp: 'AliakseiSyrel 2/25/2015 22:03'!
buttonPadding

	^ #(3 7)! !

!GLMBrickButtonStyle methodsFor: 'brick-button' stamp: 'AliakseiSyrel 2/25/2015 21:24'!
buttonMinWidth

	^ 70! !

!GLMBrickButtonStyle methodsFor: 'brick-button' stamp: 'AliakseiSyrel 2/25/2015 20:59'!
buttonBorderColor
	
	^ Color lightGray! !

!GLMBrickButtonStyle methodsFor: 'brick-button' stamp: 'AliakseiSyrel 2/25/2015 21:47'!
buttonPressedColor

	^ Color veryVeryLightGray lighter slightlyDarker slightlyDarker! !

!GLMBrickCheckBoxStyle commentStamp: 'AliakseiSyrel 3/17/2015 22:55'!
I'm a style module related to a checkbox and its componenets!
!GLMBrickCheckBoxStyle methodsFor: 'brick-checkbox' stamp: 'AliakseiSyrel 3/17/2015 22:55'!
checkboxBorderWidth

	^ 2! !

!GLMBrickCheckBoxStyle methodsFor: 'brick-checkbox' stamp: 'AliakseiSyrel 3/17/2015 22:55'!
checkboxCheckedImage

	^ GLMUIThemeExtraIcons glamorousAccept! !

!GLMBrickCheckBoxStyle methodsFor: 'brick-checkbox' stamp: 'AliakseiSyrel 3/17/2015 22:55'!
checkboxHeight

	^ 18! !

!GLMBrickCheckBoxStyle methodsFor: 'brick-checkbox' stamp: 'AliakseiSyrel 3/17/2015 22:55'!
checkboxWidth

	^ 18! !

!GLMBrickCheckBoxStyle methodsFor: 'brick-checkbox' stamp: 'AliakseiSyrel 3/17/2015 22:55'!
checkboxBorderColor

	^ Color lightGray! !

!GLMBrickExtensionTrait commentStamp: 'AliakseiSyrel 1/30/2015 10:47'!
I declare an api to store and read extention properties. It should be inplemented in any Brick UI to make it work.!
!GLMBrickExtensionTrait methodsFor: 'private-extension' stamp: 'AliakseiSyrel 1/20/2015 22:25'!
valueOfProperty: aSymbol
	
	^ self explicitRequirement! !

!GLMBrickExtensionTrait methodsFor: 'private-extension' stamp: 'AliakseiSyrel 1/26/2015 13:12'!
hasProperty: aSymbol

	^ self explicitRequirement! !

!GLMBrickExtensionTrait methodsFor: 'private-extension' stamp: 'AliakseiSyrel 1/20/2015 22:24'!
setProperty: aSymbol toValue: anObject
	
	^ self explicitRequirement! !

!GLMBrickExtensionTrait methodsFor: 'private-extension' stamp: 'AliakseiSyrel 1/20/2015 22:25'!
valueOfProperty: aSymbol ifAbsent: aBlock
	
	^ self explicitRequirement! !

!GLMBrickExtensionTrait methodsFor: 'private-extension' stamp: 'AliakseiSyrel 1/20/2015 22:24'!
removeProperty: aSymbol
	
	^ self explicitRequirement! !

!GLMBrickExtensionTrait methodsFor: 'private-extension' stamp: 'AliakseiSyrel 1/20/2015 22:25'!
valueOfProperty: aSymbol ifAbsentPut: aBlock 
	
	^ self explicitRequirement! !

!GLMBrickGeometryTrait commentStamp: 'AliakseiSyrel 1/30/2015 10:47'!
I declare api and logic to work with geometry of a Brick!
!GLMBrickGeometryTrait methodsFor: 'brick-geometry-properties' stamp: 'AliakseiSyrel 2/13/2015 17:47'!
paddingLeft: anObject
	<brickBuilderProperty: #Geometry name: 'Padding Left' as: #asInteger getter: #paddingLeft model: #GLMUIBuilderTextFieldProperty>

	self wrappedBounds paddingLeft: anObject! !

!GLMBrickGeometryTrait methodsFor: 'private-geometry' stamp: 'AliakseiSyrel 4/1/2015 18:03'!
customHeight

	^ self layout height brickValue: self! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry' stamp: 'AliakseiSyrel 1/21/2015 12:22'!
globalBounds
	"converts local bounds to global bounds on fly"
	
	^ self owner ifNotNil: [ self brickBounds translateBy: self owner globalBoundsTranslateFactor ] ifNil: [ self brickBounds ].! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-properties' stamp: 'AliakseiSyrel 2/3/2015 11:20'!
vPadding

	^ self paddingTop + self paddingBottom! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry' stamp: 'AliakseiSyrel 2/1/2015 22:33'!
innerBounds
	"can be used in layouts"
	^ self wrappedBounds innerBounds! !

!GLMBrickGeometryTrait methodsFor: 'private-extension' stamp: ''!
removeProperty: aSymbol
	
	^ self explicitRequirement! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry' stamp: 'AliakseiSyrel 2/8/2015 12:54'!
height

	^ self brickBounds height! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry' stamp: 'AliakseiSyrel 2/1/2015 22:34'!
outerBounds
	"can be used in layouts"
	^ self wrappedBounds outerBounds! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-transformations' stamp: 'AliakseiSyrel 2/8/2015 20:06'!
translateY: anInteger

	self wrappedBounds translateY: anInteger! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry' stamp: 'AliakseiSyrel 2/8/2015 16:53'!
brickBounds: aRectangle
	"directly sets brick bounds without layouting process"
	self wrappedBounds brickBounds: aRectangle! !

!GLMBrickGeometryTrait methodsFor: 'private-geometry' stamp: 'AliakseiSyrel 4/1/2015 18:03'!
privateWidth: anObject

	self layout width: anObject! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-properties' stamp: 'AliakseiSyrel 2/9/2015 23:00'!
maxWidth: anObject

	self layout maxWidth: anObject! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-properties' stamp: 'AliakseiSyrel 2/13/2015 17:47'!
marginLeft: anObject
	<brickBuilderProperty: #Geometry name: 'Margin Left' as: #asInteger getter: #marginLeft model: #GLMUIBuilderTextFieldProperty>

	self wrappedBounds marginLeft: anObject! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-properties' stamp: 'AliakseiSyrel 2/1/2015 22:39'!
marginBottom

	^ self wrappedBounds marginBottom! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-properties' stamp: 'AliakseiSyrel 2/13/2015 17:20'!
margin

	^ self wrappedBounds margin! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-transformations' stamp: 'AliakseiSyrel 2/14/2015 12:31'!
translateXTo: anInteger

	self translateX: (self brickBounds left negated + anInteger)! !

!GLMBrickGeometryTrait methodsFor: 'private-extension' stamp: ''!
valueOfProperty: aSymbol ifAbsent: aBlock
	
	^ self explicitRequirement! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-properties' stamp: 'AliakseiSyrel 2/13/2015 17:47'!
marginBottom: anObject
	<brickBuilderProperty: #Geometry name: 'Margin Bottom' as: #asInteger getter: #marginBottom model: #GLMUIBuilderTextFieldProperty>
	
	self wrappedBounds marginBottom: anObject! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-transformations' stamp: 'AliakseiSyrel 3/26/2015 18:09'!
position: aPoint

	self translateBy: (aPoint asNonFractionalPoint - self brickBounds topLeft)! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-properties' stamp: 'AliakseiSyrel 2/9/2015 23:01'!
minHeight: anObject

	self layout minHeight: anObject! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-properties' stamp: 'AliakseiSyrel 2/3/2015 11:20'!
hPadding

	^ self paddingLeft + self paddingRight! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry' stamp: 'AliakseiSyrel 4/2/2015 00:06'!
width: anObject
	<brickBuilderProperty: #Geometry name: 'Width' as: #asInteger getter: #width model: #GLMUIBuilderTextFieldProperty>

	self privateWidth: anObject.
	self updateWidth! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-properties' stamp: 'AliakseiSyrel 2/13/2015 17:47'!
paddingTop: anObject
	<brickBuilderProperty: #Geometry name: 'Padding Top' as: #asInteger getter: #paddingTop model: #GLMUIBuilderTextFieldProperty>

	self wrappedBounds paddingTop: anObject! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-properties' stamp: 'AliakseiSyrel 2/1/2015 22:40'!
paddingLeft

	^ self wrappedBounds paddingLeft! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-properties' stamp: 'AliakseiSyrel 2/1/2015 22:39'!
marginRight

	^ self wrappedBounds marginRight! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-transformations' stamp: 'AliakseiSyrel 2/8/2015 20:05'!
translateBy: aPoint

	self wrappedBounds translateBy: aPoint! !

!GLMBrickGeometryTrait methodsFor: 'private-extension' stamp: ''!
valueOfProperty: aSymbol ifAbsentPut: aBlock 
	
	^ self explicitRequirement! !

!GLMBrickGeometryTrait methodsFor: 'brick-layout' stamp: 'AliakseiSyrel 1/20/2015 22:36'!
layout

	^ self explicitRequirement! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry' stamp: 'AliakseiSyrel 2/8/2015 12:54'!
extent

	^ self brickBounds extent! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-properties' stamp: 'AliakseiSyrel 2/13/2015 17:20'!
padding

	^ self wrappedBounds padding! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-properties' stamp: 'AliakseiSyrel 2/13/2015 17:47'!
marginRight: anObject
	<brickBuilderProperty: #Geometry name: 'Margin Right' as: #asInteger getter: #marginRight model: #GLMUIBuilderTextFieldProperty>

	self wrappedBounds marginRight: anObject! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry' stamp: 'AliakseiSyrel 1/20/2015 22:42'!
globalInnerBounds
	"converts local inner bounds to global inner bounds on fly"
	
	^ self owner ifNotNil: [ self innerBounds translateBy: self owner globalBoundsTranslateFactor ] ifNil: [ self innerBounds ].! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-transformations' stamp: 'AliakseiSyrel 2/8/2015 20:06'!
translateX: anInteger

	self wrappedBounds translateX: anInteger! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-properties' stamp: 'AliakseiSyrel 2/13/2015 17:47'!
marginTop: anObject
	<brickBuilderProperty: #Geometry name: 'Margin Top' as: #asInteger getter: #marginTop model: #GLMUIBuilderTextFieldProperty>

	self wrappedBounds marginTop: anObject! !

!GLMBrickGeometryTrait methodsFor: 'private-extension' stamp: ''!
valueOfProperty: aSymbol
	
	^ self explicitRequirement! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-properties' stamp: 'AliakseiSyrel 2/3/2015 11:20'!
vMargin

	^ self marginTop + self marginBottom! !

!GLMBrickGeometryTrait methodsFor: 'private-geometry' stamp: 'AliakseiSyrel 3/24/2015 03:19'!
updateFoundationBounds

	self owner ifNotNil: [ :o | o isFoundationBrick ifTrue: [ 
		self doNotLayoutDuring: [
			(o isVShrinking | o isHShrinking) ifTrue: [ o privateExtent: self outerBounds extent ] ] ] ]! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry' stamp: 'AliakseiSyrel 2/8/2015 12:59'!
bounds: aRectangle
	"when you use this method, it changes brickBounds
	then recalculates layout and invalidates rectangle"
	self layoutAfter: [ :b | b wrappedBounds bounds: aRectangle ]! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-transformations' stamp: 'AliakseiSyrel 2/14/2015 12:31'!
translateYTo: anInteger

	self translateY: (self brickBounds top negated + anInteger)! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry' stamp: 'AliakseiSyrel 2/1/2015 22:35'!
brickBounds

	^ self wrappedBounds brickBounds! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-properties' stamp: 'AliakseiSyrel 2/13/2015 17:47'!
padding: aCollection
	<brickBuilderProperty: #Geometry name: 'Padding' as: #brickBuilderEvaluate getter: #padding model: #GLMUIBuilderTextFieldProperty>

	self wrappedBounds padding: aCollection! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry' stamp: 'AliakseiSyrel 4/2/2015 00:06'!
height: anObject
	<brickBuilderProperty: #Geometry name: 'Height' as: #asInteger getter: #height model: #GLMUIBuilderTextFieldProperty>

	self privateHeight: anObject.
	self updateHeight! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-properties' stamp: 'AliakseiSyrel 2/1/2015 22:40'!
paddingTop

	^ self wrappedBounds paddingTop! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-properties' stamp: 'AliakseiSyrel 2/13/2015 17:47'!
paddingRight: anObject
	<brickBuilderProperty: #Geometry name: 'Padding Right' as: #asInteger getter: #paddingRight model: #GLMUIBuilderTextFieldProperty>

	self wrappedBounds paddingRight: anObject! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-properties' stamp: 'AliakseiSyrel 2/1/2015 22:39'!
marginLeft

	^ self wrappedBounds marginLeft! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-transformations' stamp: 'AliakseiSyrel 2/10/2015 14:37'!
withHeight: anInteger

	self wrappedBounds height: anInteger! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-properties' stamp: 'AliakseiSyrel 2/9/2015 23:00'!
maxHeight: anObject

	self layout maxHeight: anObject! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry' stamp: 'AliakseiSyrel 1/20/2015 22:42'!
globalOuterBounds
	"converts local outer bounds to global inner bounds on fly"
	
	^ self owner ifNotNil: [ self outerBounds translateBy: self owner globalBoundsTranslateFactor ] ifNil: [ self outerBounds ].! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-properties' stamp: 'AliakseiSyrel 2/1/2015 22:39'!
paddingBottom

	^ self wrappedBounds paddingBottom! !

!GLMBrickGeometryTrait methodsFor: 'private-geometry' stamp: 'AliakseiSyrel 1/29/2015 23:55'!
privateBounds: aRectangle
	
	^ self explicitRequirement! !

!GLMBrickGeometryTrait methodsFor: 'private-geometry' stamp: 'AliakseiSyrel 4/1/2015 23:04'!
updateHeight
	"no need to care about height, when it's logic is not customized"
	self layout isHeightCustom ifFalse: [ ^ self ].
	[ self bounds: (self brickBounds withHeight: self customHeight) ]
		on: Exception
		do: [ "just skip and do nothing" ]! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-properties' stamp: 'AliakseiSyrel 2/13/2015 17:47'!
margin: aCollection
	<brickBuilderProperty: #Geometry name: 'Margin' as: #brickBuilderEvaluate getter: #margin model: #GLMUIBuilderTextFieldProperty>

	self wrappedBounds margin: aCollection! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry' stamp: 'AliakseiSyrel 2/1/2015 22:39'!
wrappedBounds

	^ self explicitRequirement! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-properties' stamp: 'AliakseiSyrel 2/3/2015 11:19'!
hMargin

	^ self marginLeft + self marginRight! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-properties' stamp: 'AliakseiSyrel 2/9/2015 23:01'!
minWidth: anObject

	self layout minWidth: anObject! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry' stamp: 'AliakseiSyrel 2/3/2015 11:13'!
extent: aPoint
	"actually works only if width or height are not custom"
	"updates layout"
	self changed.
	
	self width: aPoint x.
	self height: aPoint y.
	self wrappedBounds bounds: (self brickBounds origin extent: aPoint).
	
	self flag: 'do I need to layout morphs inside?'.
	self doLayout.
	
	self changed! !

!GLMBrickGeometryTrait methodsFor: 'private-geometry' stamp: 'AliakseiSyrel 1/21/2015 12:22'!
globalBoundsTranslateFactor

	^ self owner ifNotNil: [ self owner globalBoundsTranslateFactor + self brickBounds origin ] ifNil: [ 0@0 ]! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-properties' stamp: 'AliakseiSyrel 2/1/2015 22:39'!
marginTop

	^ self wrappedBounds marginTop! !

!GLMBrickGeometryTrait methodsFor: 'private-geometry' stamp: 'AliakseiSyrel 4/1/2015 23:00'!
updateWidth
	"no need to care about width, when it's logic is not customized"
	self layout isWidthCustom ifFalse: [ ^ self ].
	[ self bounds: (self brickBounds withWidth: self customWidth) ]
		on: Exception
		do: [ "just skip and do nothing" ]! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry' stamp: 'AliakseiSyrel 2/8/2015 12:54'!
width

	^ self brickBounds width! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-transformations' stamp: 'AliakseiSyrel 2/10/2015 14:37'!
withWidth: anInteger

	self wrappedBounds width: anInteger! !

!GLMBrickGeometryTrait methodsFor: 'private-geometry' stamp: 'AliakseiSyrel 4/1/2015 18:03'!
customWidth

	^ self layout width brickValue: self! !

!GLMBrickGeometryTrait methodsFor: 'private-extension' stamp: ''!
hasProperty: aSymbol

	^ self explicitRequirement! !

!GLMBrickGeometryTrait methodsFor: 'private-extension' stamp: ''!
setProperty: aSymbol toValue: anObject
	
	^ self explicitRequirement! !

!GLMBrickGeometryTrait methodsFor: 'private-geometry' stamp: 'AliakseiSyrel 4/1/2015 18:03'!
privateHeight: anObject
	
	self layout height: anObject! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-properties' stamp: 'AliakseiSyrel 2/1/2015 22:40'!
paddingRight

	^ self wrappedBounds paddingRight! !

!GLMBrickGeometryTrait methodsFor: 'brick-geometry-properties' stamp: 'AliakseiSyrel 2/13/2015 17:47'!
paddingBottom: anObject
	<brickBuilderProperty: #Geometry name: 'Padding Bottom' as: #asInteger getter: #paddingBottom model: #GLMUIBuilderTextFieldProperty>

	self wrappedBounds paddingBottom: anObject! !

!GLMBrickLayoutTrait commentStamp: 'AliakseiSyrel 1/30/2015 10:48'!
I declare api and logic to layout Bricks!
!GLMBrickLayoutTrait methodsFor: 'brick-layout' stamp: 'AliakseiSyrel 2/13/2015 20:19'!
layout: aLayout
	"Alias for layoutPolicy:"
	<brickBuilderProperty: #Layout name: 'Orientation' as: #brickBuilderLayout getter: #layoutPolicy model: #GLMUIBuilderTextFieldProperty>

	self layoutPolicy: aLayout! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 4/2/2015 00:07'!
hShrinkWrap

	self layout hShrinkWrap! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 3/22/2015 18:00'!
hSpaceFill

	self hSpaceFill: 100! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 4/2/2015 00:08'!
vShrinkWrap

	self layout vShrinkWrap! !

!GLMBrickLayoutTrait methodsFor: 'private-extension' stamp: ''!
valueOfProperty: aSymbol
	
	^ self explicitRequirement! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 4/2/2015 00:08'!
hSpaceFill: anInteger
	<brickBuilderProperty: #Layout name: 'Horizontal percent' as: #asInteger getter: #hPercent model: #GLMUIBuilderTextFieldProperty>

	self layout hSpaceFill: anInteger! !

!GLMBrickLayoutTrait methodsFor: 'brick-geometry' stamp: 'AliakseiSyrel 1/20/2015 22:37'!
innerBounds

	^ self explicitRequirement! !

!GLMBrickLayoutTrait methodsFor: 'private-extension' stamp: ''!
removeProperty: aSymbol
	
	^ self explicitRequirement! !

!GLMBrickLayoutTrait methodsFor: 'private-layout' stamp: 'AliakseiSyrel 2/13/2015 14:41'!
resetLayout

	self vResizing: #rigid.
	self hResizing: #rigid.
	self height: nil.
	self width: nil! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout' stamp: 'AliakseiSyrel 4/2/2015 15:44'!
layoutSubbricks

	self layoutPolicy layout: self brickApi in: self innerBounds! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 2/25/2015 22:11'!
floating

	^ self layout floating! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout' stamp: 'AliakseiSyrel 2/14/2015 12:59'!
doNotLayoutDuring: aBlock
	|wasAllowed|
	wasAllowed := self isLayotingAllowed.
	self isLayotingAllowed: false.
	[ aBlock cull: self ]
		ensure: [ wasAllowed ifTrue: [ self isLayotingAllowed: true ] ]! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 2/8/2015 17:36'!
useVerticalLinearLayout

	self layout: GLMVerticalLinearLayout uniqueInstance! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 2/25/2015 23:06'!
zIndex

	^ self layout zIndex! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 3/22/2015 18:00'!
vSpaceFill

	self vSpaceFill: 100! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout-events' stamp: 'AliakseiSyrel 1/20/2015 20:11'!
onLayoutEvent: aLayoutEvent
	"in case layout want's to trigger any specific event"! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout' stamp: 'AliakseiSyrel 4/2/2015 15:44'!
invalidateLayout

	self layoutPolicy layout: self brickApi in: self wrappedBounds innerBounds! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 2/13/2015 18:12'!
hAlign: aSymbol
	<brickBuilderProperty: #Layout name: 'Horizontal align' as: #asSymbol getter: #hAlign model: #GLMUIBuilderTextFieldProperty>

	self layout hAlign: aSymbol! !

!GLMBrickLayoutTrait methodsFor: 'private-extension' stamp: ''!
valueOfProperty: aSymbol ifAbsent: aBlock
	
	^ self explicitRequirement! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 2/8/2015 17:36'!
useHorizontalLinearLayout

	self layout: GLMHorizontalLinearLayout uniqueInstance! !

!GLMBrickLayoutTrait methodsFor: 'private-layout' stamp: 'AliakseiSyrel 2/14/2015 11:27'!
isLayotingAllowed: aBoolean

	self setProperty: #brickLayoutingAllowed toValue: aBoolean! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout' stamp: 'AliakseiSyrel 2/3/2015 16:28'!
doLayoutForce

	self wrappedBounds
		markHeightDirty;
		markWidthDirty.
	
	self doLayout! !

!GLMBrickLayoutTrait methodsFor: 'brick-structure' stamp: 'AliakseiSyrel 1/20/2015 22:37'!
subbricks

	^ self explicitRequirement! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 2/13/2015 18:11'!
hAlign

	^ self layout hAlign! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout' stamp: 'AliakseiSyrel 1/20/2015 22:37'!
layoutProperties

	^ self explicitRequirement! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 2/13/2015 18:12'!
vAlign: aSymbol
	<brickBuilderProperty: #Layout name: 'Vertical align' as: #asSymbol getter: #vAlign model: #GLMUIBuilderTextFieldProperty>

	self layout vAlign: aSymbol! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 2/25/2015 22:11'!
floating: aSymbol

	self layout floating: aSymbol! !

!GLMBrickLayoutTrait methodsFor: 'private-layout' stamp: 'AliakseiSyrel 2/14/2015 11:27'!
isLayotingAllowed

	^ self valueOfProperty: #brickLayoutingAllowed ifAbsent: [ true ]! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout' stamp: 'AliakseiSyrel 1/20/2015 18:54'!
layoutPolicy: aLayout

	self explicitRequirement! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout' stamp: 'AliakseiSyrel 4/1/2015 17:51'!
doLayout

	self isLayotingAllowed ifTrue: [
		GLMBrickLayouter uniqueInstance layoutIn: self brickApi ]! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout' stamp: 'AliakseiSyrel 1/20/2015 21:19'!
layout
	"Alias for layoutProperies"
	^ self layoutProperties! !

!GLMBrickLayoutTrait methodsFor: 'private-extension' stamp: ''!
valueOfProperty: aSymbol ifAbsentPut: aBlock 
	
	^ self explicitRequirement! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 2/13/2015 18:11'!
vAlign

	^ self layout vAlign! !

!GLMBrickLayoutTrait methodsFor: 'private-extension' stamp: ''!
setProperty: aSymbol toValue: anObject
	
	^ self explicitRequirement! !

!GLMBrickLayoutTrait methodsFor: 'private-extension' stamp: ''!
hasProperty: aSymbol

	^ self explicitRequirement! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout' stamp: 'AliakseiSyrel 2/14/2015 11:31'!
layoutAfter: aBlock

	self doNotLayoutDuring: aBlock.
	self doLayout! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 4/2/2015 00:08'!
vSpaceFill: anInteger
	<brickBuilderProperty: #Layout name: 'Vertical percent' as: #asInteger getter: #vPercent model: #GLMUIBuilderTextFieldProperty>

	self layout vSpaceFill: anInteger! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout' stamp: 'AliakseiSyrel 2/14/2015 10:35'!
invalidateWith: aBlock

	aBlock cull: self.
	self doLayoutForce.! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout' stamp: 'AliakseiSyrel 1/20/2015 18:54'!
layoutProperties: aLayoutProperties

	self explicitRequirement! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout-events' stamp: 'AliakseiSyrel 3/24/2015 02:56'!
onLayouted
	"called when I'm layouted in my parent"
	self updateFoundationBounds! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout' stamp: 'AliakseiSyrel 1/20/2015 22:37'!
layoutPolicy

	^ self explicitRequirement! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout-events' stamp: 'AliakseiSyrel 3/24/2015 02:56'!
onChildrenLayouted
	"called when all my children finished layouting"
	self updateFoundationBounds! !

!GLMBrickLayoutTrait methodsFor: 'brick-layout-properties' stamp: 'AliakseiSyrel 2/25/2015 23:06'!
zIndex: anInteger

	self layout zIndex: anInteger! !

!GLMBrickPropertiesTrait commentStamp: 'AliakseiSyrel 1/30/2015 10:49'!
I declare api and logic to work with properties of a Brick, such as color, shadow, renderer and more!
!GLMBrickPropertiesTrait methodsFor: 'private-extension' stamp: ''!
valueOfProperty: aSymbol
	
	^ self explicitRequirement! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 2/11/2015 11:24'!
border

	^ self valueOfProperty: #brickBorder ifAbsentPut: [ GLMBrickBorder new ]
	! !

!GLMBrickPropertiesTrait methodsFor: 'private-properties' stamp: 'AliakseiSyrel 1/26/2015 12:33'!
privateThemer

	^ self valueOfProperty: #brickThemer ifAbsentPut: [ nil ]! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties-events' stamp: 'AliakseiSyrel 1/26/2015 13:01'!
onThemerChanged
! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/20/2015 20:37'!
renderer

	^ self valueOfProperty: #brickRenderer ifAbsentPut: [ nil ]! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties-events' stamp: 'AliakseiSyrel 2/25/2015 21:49'!
when: aventName do: aBlock

	self announcer when: aventName do: aBlock! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties-events' stamp: 'AliakseiSyrel 3/24/2015 10:25'!
announce: aSymbol event: anEvent

	self announcer subscriptions glmSubscriptions do: [ :each |
		each announcementClass = aSymbol ifTrue: [
			(each handlesAnnouncement: aSymbol ) ifTrue: [
				[ each action cull: anEvent cull: self ] 
					on: UnhandledError fork: [:ex | ex pass ] ] ] ]! !

!GLMBrickPropertiesTrait methodsFor: 'private-extension' stamp: ''!
removeProperty: aSymbol
	
	^ self explicitRequirement! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 2/13/2015 17:47'!
color: aColor
	<brickBuilderProperty: #'Look&Feel' name: 'Color' as: #brickBuilderEvaluate getter: #color model: #GLMUIBuilderTextFieldProperty>

	self setProperty: #brickBackgroundColor toValue: aColor! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties-events' stamp: 'AliakseiSyrel 2/25/2015 16:29'!
announce: anAnnouncement

	self announcer announce: anAnnouncement! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/24/2015 00:37'!
shadowColor

	^ self valueOfProperty: #brickShadowColor ifAbsentPut: [ Color transparent ]! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/26/2015 13:00'!
themerChanged

	self onThemerChanged.
	self subbricks do: #themerChanged! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 2/13/2015 20:49'!
borderWidth: anObject
	<brickBuilderProperty: #'Look&Feel' name: 'Border width' as: #brickBuilderEvaluate getter: #borderWidth model: #GLMUIBuilderTextFieldProperty>

	self border width: anObject! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/20/2015 20:36'!
data

	^ self valueOfProperty: #brickDataObject ifAbsentPut: [ nil ]! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 2/13/2015 20:48'!
borderColor
	
	^ self border color! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 2/13/2015 21:40'!
markBorderColor: aColor width: anInteger

	self setProperty: #brickMarkBorderColor toValue: aColor.
	self setProperty: #brickMarkBorderWidth toValue: anInteger! !

!GLMBrickPropertiesTrait methodsFor: 'private-extension' stamp: ''!
valueOfProperty: aSymbol ifAbsent: aBlock
	
	^ self explicitRequirement! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 2/13/2015 17:47'!
shadowWidth: anInteger
	<brickBuilderProperty: #'Look&Feel' name: 'Shadow Width' as: #asInteger getter: #shadowWidth model: #GLMUIBuilderTextFieldProperty>

	self setProperty: #brickShadowWidth toValue: anInteger! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 2/13/2015 20:49'!
borderWidth

	^ self border width! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/26/2015 12:34'!
themer

	^ self privateThemer
		ifNotNil: [ self privateThemer ]
		ifNil: [ self hasOwner
			ifTrue: [ self owner themer ]
			ifFalse: [ self theme brickThemer ] ]! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/20/2015 20:38'!
renderer: aRenderer

	self setProperty: #brickRenderer toValue: aRenderer! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties-events' stamp: 'AliakseiSyrel 2/25/2015 16:34'!
when: aventName send: aSymbol to: aReceiver

	self announcer weak when: aventName send: aSymbol to: aReceiver! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties-testing' stamp: 'AliakseiSyrel 1/26/2015 13:13'!
isColorSet

	^ self hasProperty: #brickBackgroundColor! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 2/25/2015 16:27'!
announcer

	^ self explicitRequirement! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 2/12/2015 17:17'!
with: aBlock

	aBlock cull: self! !

!GLMBrickPropertiesTrait methodsFor: 'private-extension' stamp: ''!
valueOfProperty: aSymbol ifAbsentPut: aBlock 
	
	^ self explicitRequirement! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/20/2015 20:36'!
data: anObject

	^ self setProperty: #brickDataObject  toValue:  anObject! !

!GLMBrickPropertiesTrait methodsFor: 'private-extension' stamp: ''!
hasProperty: aSymbol

	^ self explicitRequirement! !

!GLMBrickPropertiesTrait methodsFor: 'private-extension' stamp: ''!
setProperty: aSymbol toValue: anObject
	
	^ self explicitRequirement! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 2/13/2015 17:47'!
shadowColor: aColor
	<brickBuilderProperty: #'Look&Feel' name: 'Shadow Color' as: #brickBuilderEvaluate getter: #shadowColor model: #GLMUIBuilderTextFieldProperty>

	self setProperty: #brickShadowColor toValue: aColor! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 2/11/2015 11:25'!
border: aBorder

	self setProperty: #brickBorder toValue: aBorder! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 2/11/2015 13:05'!
borderDo: aBlock

	aBlock cull: self border.
	^ self! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/26/2015 12:57'!
color

	^ self valueOfProperty: #brickBackgroundColor ifAbsent: [ self themer backgroundColor ]! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 2/13/2015 20:48'!
borderColor: anObject
	<brickBuilderProperty: #'Look&Feel' name: 'Border color' as: #brickBuilderEvaluate getter: #borderColor model: #GLMUIBuilderTextFieldProperty>

	self border color: anObject! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/26/2015 13:01'!
themer: aThemer

	self setProperty: #brickThemer toValue: aThemer.
	self themerChanged! !

!GLMBrickPropertiesTrait methodsFor: 'brick-properties' stamp: 'AliakseiSyrel 1/24/2015 00:38'!
shadowWidth

	^ self valueOfProperty: #brickShadowWidth ifAbsentPut: [ 0 ]! !

!GLMBrickRubricStyle commentStamp: 'AliakseiSyrel 1/30/2015 11:50'!
I'm a style module related to a rubric text fields and its componenets!
!GLMBrickRubricStyle methodsFor: 'brick-rubric' stamp: 'AliakseiSyrel 2/26/2015 23:44'!
rubricTextBackgroundColor

	^ Color transparent! !

!GLMBrickRubricStyle methodsFor: 'brick-rubric' stamp: 'AliakseiSyrel 1/30/2015 11:54'!
rubricBorderColor

	^ Color transparent! !

!GLMBrickRubricStyle methodsFor: 'brick-rubric' stamp: 'AliakseiSyrel 3/17/2015 23:09'!
rubricTextFamilyName
	
	^ StandardFonts codeFont familyName! !

!GLMBrickRubricStyle methodsFor: 'brick-rubric' stamp: 'AliakseiSyrel 1/30/2015 11:54'!
rubricBorderWidth

	^ 0! !

!GLMBrickRubricStyle methodsFor: 'brick-rubric' stamp: 'AliakseiSyrel 3/26/2015 16:19'!
rubricCursorColor

	^ self rubricTextColor! !

!GLMBrickRubricStyle methodsFor: 'brick-rubric' stamp: 'AliakseiSyrel 1/30/2015 11:52'!
rubricBackgroundColor

	^ self contentBackgroundColor! !

!GLMBrickRubricStyle methodsFor: 'brick-rubric' stamp: 'JurajKubelka 2/28/2015 19:35'!
rubricTextColor

	^ self textColor! !

!GLMBrickRubricStyle methodsFor: 'brick-rubric' stamp: 'AliakseiSyrel 3/17/2015 23:09'!
rubricTextFontSize
	
	^ StandardFonts codeFont pointSize! !

!GLMBrickScrollpaneStyle commentStamp: 'AliakseiSyrel 1/30/2015 11:04'!
I'm a style module related to a scrollpane and its component. !
!GLMBrickScrollpaneStyle methodsFor: 'brick-scrollbar' stamp: 'AliakseiSyrel 1/26/2015 12:27'!
scrollbarPosition

	^ #right! !

!GLMBrickScrollpaneStyle methodsFor: 'brick-scrollbar' stamp: 'AliakseiSyrel 1/26/2015 12:25'!
scrollbarOffset

	^ 1! !

!GLMBrickScrollpaneStyle methodsFor: 'brick-scrollbar' stamp: 'AliakseiSyrel 1/26/2015 12:26'!
scrollbarWidth

	^ 3! !

!GLMBrickScrollpaneStyle methodsFor: 'brick-scrollpane' stamp: 'AliakseiSyrel 1/30/2015 11:52'!
scrollpaneBackgroundColor

	^ self contentBackgroundColor! !

!GLMBrickScrollpaneStyle methodsFor: 'brick-scrollbar' stamp: 'AliakseiSyrel 1/26/2015 12:28'!
scrollbarCornerRadius

	^ 0! !

!GLMBrickScrollpaneStyle methodsFor: 'brick-scrollbar' stamp: 'AliakseiSyrel 1/26/2015 13:22'!
scrollbarColor

	^ Color lightGray alpha: 0.5! !

!GLMBrickStructureTrait commentStamp: 'AliakseiSyrel 1/30/2015 10:58'!
I declare api and logic to work with structure of a Brick as adding, removing, testing for existance and some more!
!GLMBrickStructureTrait methodsFor: 'private-structure' stamp: 'AliakseiSyrel 2/18/2015 11:14'!
privateAddBrick: aBrick after: otherBrick
	| brick link otherLink otherLinkSuccessor index|
	brick := aBrick asBrick.
	
	otherLink := otherBrick brickDoubleLink.
	otherLink = self lastSubbrick brickDoubleLink
		ifTrue: [ ^ self privateAddBrickBack: aBrick ].
		
	link := brick asDoubleLink.
	brick brickDoubleLink: link.
	otherLinkSuccessor := otherLink nextLink.
	otherLink nextLink: link.
	link previousLink: otherLink.
	link nextLink: otherLinkSuccessor.
	otherLinkSuccessor previousLink: link.
	
	index := (self subbricks indexOf: otherBrick) + 1.
	self privateSubbricks: (self subbricks copyReplaceFrom: index to: index - 1 with: (Array with: brick)).
	
	brick owner: self.
	
	^ aBrick! !

!GLMBrickStructureTrait methodsFor: 'brick-structure-opening' stamp: 'AliakseiSyrel 3/30/2015 11:56'!
window
	"Answer the receiver's window."
	#GLMWindowBrick asClassIfAbsent: [ 
		^ self ownerThatIsA: SystemWindow ].
	
	^ (self ownerThatIsA: #GLMWindowBrick asClass)
		ifNil: [ self ownerThatIsA: SystemWindow ]! !

!GLMBrickStructureTrait methodsFor: 'brick-structure-opening' stamp: 'AliakseiSyrel 3/3/2015 14:44'!
openInBrickWindow

	^ self openInBrickWindowLabeled: self! !

!GLMBrickStructureTrait methodsFor: 'brick-structure' stamp: 'AliakseiSyrel 2/26/2015 22:15'!
withAllOwnersDo: aBlock
	"Evaluate aBlock with the receiver and all of its owners"
	aBlock cull: self.
	self owner ifNotNil:[ ^ self owner withAllOwnersDo: aBlock ]! !

!GLMBrickStructureTrait methodsFor: 'brick-structure-converting' stamp: 'AliakseiSyrel 1/21/2015 16:17'!
asBrickedMorph

	^ GLMFoundationBrick new brickRoot: self! !

!GLMBrickStructureTrait methodsFor: 'brick-structure-testing' stamp: 'AliakseiSyrel 3/24/2015 02:54'!
isFoundationBrick

	^ false! !

!GLMBrickStructureTrait methodsFor: 'brick-structure-testing' stamp: 'StefanReichhart 2/26/2015 21:33'!
isLastInOwner

	^ self brickDoubleLink
		ifNotNilDo: [ :bdl | bdl hasSuccessor not ]
		ifNil: [ false ]! !

!GLMBrickStructureTrait methodsFor: 'brick-structure' stamp: 'AliakseiSyrel 1/20/2015 20:31'!
brickRoot

	^ self owner ifNotNil: [ self owner brickRoot ] ifNil: [ ^ self ]! !

!GLMBrickStructureTrait methodsFor: 'brick-structure-converting' stamp: 'AliakseiSyrel 1/20/2015 21:01'!
morph
	^ self! !

!GLMBrickStructureTrait methodsFor: 'brick-structure' stamp: 'AliakseiSyrel 1/31/2015 18:26'!
subbricksReverseDo: aBlock

	self subbricks reverseDo: aBlock! !

!GLMBrickStructureTrait methodsFor: 'brick-structure' stamp: 'AliakseiSyrel 2/26/2015 22:14'!
ownerThatIsA: aClass
	"Return the first enclosing morph that is a kind of aClass, or nil if none"

	^ self firstOwnerSuchThat: [:m | m isKindOf: aClass]! !

!GLMBrickStructureTrait methodsFor: 'brick-structure-converting' stamp: 'AliakseiSyrel 4/2/2015 01:04'!
brick

	^ self! !

!GLMBrickStructureTrait methodsFor: 'brick-structure' stamp: 'AliakseiSyrel 1/20/2015 22:16'!
subbrickAfter

	"Return the subbbrick after (behind) me, or nil"
	| link |
	link := self brickDoubleLink.
	link ifNil: [ ^ nil ].
	link nextLink ifNil: [ ^ nil ].
	^ link nextLink value! !

!GLMBrickStructureTrait methodsFor: 'brick-structure' stamp: 'AliakseiSyrel 2/26/2015 22:15'!
firstOwnerSuchThat: conditionBlock

	self allOwnersDo: [:m | (conditionBlock cull: m) ifTrue: [^ m]].
	^ nil
! !

!GLMBrickStructureTrait methodsFor: 'brick-structure' stamp: 'AliakseiSyrel 1/20/2015 22:38'!
subbricks

	^ self explicitRequirement! !

!GLMBrickStructureTrait methodsFor: 'private-structure' stamp: 'AliakseiSyrel 2/18/2015 11:08'!
privateAddBrick: aBrick before: otherBrick
	| brick link otherLink otherLinkPredeccessor index|
	brick := aBrick asBrick.
	
	otherLink := otherBrick brickDoubleLink.
	otherLink = self firstSubbrick brickDoubleLink
		ifTrue: [ ^ self privateAddBrickFirst: aBrick ].
		
	link := brick asDoubleLink.
	brick brickDoubleLink: link.
	otherLinkPredeccessor := otherLink previousLink.
	otherLink previousLink: link.
	link nextLink: otherLink.
	link previousLink: otherLinkPredeccessor.
	otherLinkPredeccessor nextLink: link.
	
	index := ((self subbricks indexOf: otherBrick) max: 1).
	self privateSubbricks: (self subbricks copyReplaceFrom: index to: index - 1 with: (Array with: brick)).
	
	brick owner: self.
	
	^ aBrick! !

!GLMBrickStructureTrait methodsFor: 'private-structure' stamp: 'AliakseiSyrel 3/24/2015 10:48'!
privateAddIntoWorld: aBrick

	self world == aBrick world
		ifFalse: [ self privateRemoveOutWorld: aBrick ].
	aBrick intoWorld: self world
	! !

!GLMBrickStructureTrait methodsFor: 'private-structure' stamp: 'AliakseiSyrel 2/8/2015 13:31'!
privateAddBrickFirst: aBrick
	| link head tail brick|
	
	brick := aBrick asBrick.
	head := nil.
	tail := nil.
	self hasSubbricks ifTrue: [
		head := self firstSubbrick brickDoubleLink.
		tail := self lastSubbrick brickDoubleLink ].
	
	link := brick asDoubleLink.
	brick brickDoubleLink: link.
	link nextLink: head.
	head ifNotNil: [ head previousLink: link ].
	
	self privateSubbricks: (self subbricks copyWithFirst: brick).
	brick owner: self.
	
	^ aBrick! !

!GLMBrickStructureTrait methodsFor: 'brick-structure' stamp: 'AliakseiSyrel 2/13/2015 17:45'!
allSubbricksDo: aBlock

	self subbricks do: [:each | 
		each isBrick ifTrue: [ aBlock value: each. each allSubbricksDo: aBlock ] ]! !

!GLMBrickStructureTrait methodsFor: 'brick-structure-adding/removing' stamp: 'AliakseiSyrel 3/27/2015 00:54'!
addBrickBack: aBrick
	|result|
	result := self privateAddBrickBack: aBrick asBrick.
	self privatePrepareBrickAfterAdding: result.
	self doLayoutForce.
	^ aBrick! !

!GLMBrickStructureTrait methodsFor: 'brick-structure' stamp: 'AliakseiSyrel 1/20/2015 19:15'!
firstSubbrick

	^ self subbricks first! !

!GLMBrickStructureTrait methodsFor: 'brick-structure-opening' stamp: 'AliakseiSyrel 3/26/2015 14:54'!
openInBrickWindowLabeled: aLabel
	
	#GLMSystemWindowBrick asClassIfAbsent: [ 
		^ self asMorph openInWindow ].
	
	^ #GLMSystemWindowBrick asClass new
		label: aLabel;
		color: Color transparent;
		addBrickBack: (
			GLMBrick new
				vSpaceFill
				hSpaceFill;
				addBrickBack: self;
				yourself);
		extent: 400@400;
		openCenteredInWorld! !

!GLMBrickStructureTrait methodsFor: 'brick-structure-testing' stamp: 'AliakseiSyrel 1/20/2015 19:23'!
hasSubbrick: aBrick

	^ aBrick owner = self! !

!GLMBrickStructureTrait methodsFor: 'brick-structure' stamp: 'AliakseiSyrel 1/20/2015 19:19'!
subbrickBefore

	"Return the subbrick before me, or nil"
	| link |
	link := self brickDoubleLink.
	link ifNil: [ ^ nil ].
	link previousLink ifNil: [ ^ nil ].
	^ link previousLink value! !

!GLMBrickStructureTrait methodsFor: 'brick-structure' stamp: 'AliakseiSyrel 2/1/2015 13:46'!
allSubbricks
	| all |
	all := OrderedCollection new.
	self allSubbricksDo: [:each | all add: each ].
	^ all! !

!GLMBrickStructureTrait methodsFor: 'private-structure' stamp: 'AliakseiSyrel 2/9/2015 14:58'!
privateRemoveBrick: aBrick
	| predecessor successor link head tail index|
	aBrick ifNil: [ ^ aBrick ].
	(self hasSubbrick: aBrick) ifFalse: [ ^ aBrick ].
	
	link := aBrick brickDoubleLink.
	
	head := self firstSubbrick brickDoubleLink.
	tail := self lastSubbrick brickDoubleLink.
	
	predecessor := link previousLink.
	successor := link nextLink.
	predecessor
		ifNotNil: [ predecessor nextLink: successor ].
	successor
		ifNotNil: [ successor previousLink: predecessor ].
	link clearLinks.
	
	aBrick brickDoubleLink: nil.
	
	index := self subbricks find: aBrick.
	self privateSubbricks: (self subbricks copyWithoutIndex: index).
	aBrick owner: nil.
	
	^ aBrick! !

!GLMBrickStructureTrait methodsFor: 'private-structure' stamp: 'AliakseiSyrel 3/26/2015 21:44'!
privateAddBrickLinkBack: aBrick
	|link brick|
	
	brick := aBrick asBrick.
	link := brick asDoubleLink.
	brick brickDoubleLink: link.
	
	self hasSubbricks ifTrue: [
		self lastSubbrick brickDoubleLink nextLink: link.	
		link previousLink: self lastSubbrick brickDoubleLink ].
	
	brick owner: self.
	
	^ aBrick! !

!GLMBrickStructureTrait methodsFor: 'private-structure' stamp: 'AliakseiSyrel 1/26/2015 12:46'!
privateOwner: aBrick

	^ self explicitRequirement! !

!GLMBrickStructureTrait methodsFor: 'private-structure' stamp: 'AliakseiSyrel 3/24/2015 10:48'!
privateRemoveOutWorld: aBrick

	aBrick outOfWorld: aBrick world
	! !

!GLMBrickStructureTrait methodsFor: 'brick-structure-adding/removing' stamp: 'AliakseiSyrel 3/27/2015 00:57'!
addBrick: aBrick before: otherBrick
	|result|
	result := self privateAddBrick: aBrick asBrick before: otherBrick.
	self privatePrepareBrickAfterAdding: result.
	self doLayoutForce.
	^ aBrick! !

!GLMBrickStructureTrait methodsFor: 'private-structure' stamp: 'AliakseiSyrel 3/26/2015 21:49'!
privateAddBrickBack: aBrick
	|brick|
	
	brick := aBrick asBrick.
	self privateAddBrickLinkBack: brick.
	self privateSubbricks: (self subbricks copyWith: brick).
	
	^ aBrick! !

!GLMBrickStructureTrait methodsFor: 'brick-structure' stamp: 'AliakseiSyrel 2/26/2015 22:15'!
allOwnersDo: aBlock
	"Evaluate aBlock with all owners of the receiver"
	self owner ifNotNil:[ ^ self owner withAllOwnersDo: aBlock ].! !

!GLMBrickStructureTrait methodsFor: 'brick-structure-adding/removing' stamp: 'AliakseiSyrel 3/27/2015 00:57'!
addBrickFirst: aBrick
	|result|
	result := self privateAddBrickFirst: aBrick asBrick.
	self privatePrepareBrickAfterAdding: result.
	self doLayoutForce.
	^ aBrick! !

!GLMBrickStructureTrait methodsFor: 'brick-structure-converting' stamp: 'AliakseiSyrel 1/20/2015 20:59'!
asBrick
	^ self! !

!GLMBrickStructureTrait methodsFor: 'private-structure' stamp: 'AliakseiSyrel 3/27/2015 00:56'!
privateAddAllBricks: aCollection
	|bricks|
	bricks := aCollection collect: #asBrick.
	bricks do: [ :each | self privateAddBrickLinkBack: each ].
	self privateSubbricks: (self subbricks, bricks).
	^ bricks! !

!GLMBrickStructureTrait methodsFor: 'brick-structure-adding/removing' stamp: 'AliakseiSyrel 3/27/2015 00:56'!
addBrick: aBrick after: otherBrick
	|result|
	result := self privateAddBrick: aBrick asBrick after: otherBrick.
	self privatePrepareBrickAfterAdding: result.
	self doLayoutForce.
	^ aBrick! !

!GLMBrickStructureTrait methodsFor: 'brick-structure-events' stamp: 'AliakseiSyrel 1/29/2015 00:46'!
onRemovedFrom: aBrick
	"is called when brick is removed from aBrick"
	self subbricks do: [ :each | each onRemovedFrom: aBrick ]! !

!GLMBrickStructureTrait methodsFor: 'brick-structure' stamp: 'AliakseiSyrel 1/20/2015 19:15'!
lastSubbrick

	^ self subbricks last! !

!GLMBrickStructureTrait methodsFor: 'brick-structure-testing' stamp: 'StefanReichhart 2/26/2015 21:26'!
isFirstInOwner

	^ self brickDoubleLink 
		ifNotNilDo: [ :bdl | bdl hasPredecessor not ]
		ifNil: [ false ]! !

!GLMBrickStructureTrait methodsFor: 'brick-structure-converting' stamp: 'AliakseiSyrel 2/26/2015 21:59'!
asFormValue

	^ nil! !

!GLMBrickStructureTrait methodsFor: 'brick-structure-testing' stamp: 'AliakseiSyrel 1/26/2015 12:31'!
hasOwner

	^ self owner isNotNil! !

!GLMBrickStructureTrait methodsFor: 'brick-structure-adding/removing' stamp: 'AliakseiSyrel 3/27/2015 00:57'!
addAllBricks: aCollection
	|bricks|
	bricks := self privateAddAllBricks: aCollection.
	bricks do: [ :b | self privatePrepareBrickAfterAdding: b ].
	self doLayoutForce.
	^ aCollection! !

!GLMBrickStructureTrait methodsFor: 'brick-structure-testing' stamp: 'AliakseiSyrel 1/20/2015 20:17'!
isBrick

	^ true! !

!GLMBrickStructureTrait methodsFor: 'private-structure' stamp: 'AliakseiSyrel 3/24/2015 10:50'!
privatePrepareBrickAfterAdding: aBrick

	aBrick wrappedBounds markWidthDirty; markHeightDirty.
	self privateAddIntoWorld: aBrick! !

!GLMBrickStructureTrait methodsFor: 'private-structure' stamp: 'AliakseiSyrel 3/24/2015 10:52'!
privatePrepareBrickAfterRemoving: aBrick

	self privateRemoveOutWorld: aBrick! !

!GLMBrickStructureTrait methodsFor: 'brick-structure' stamp: 'AliakseiSyrel 2/1/2015 13:47'!
withAllSubbricks

	^ self allSubbricks add: self;
		 yourself! !

!GLMBrickStructureTrait methodsFor: 'brick-structure-opening' stamp: 'AliakseiSyrel 2/26/2015 22:25'!
openCenteredInBrickWindowLabeled: aLabel

	self
		vAlign: #center;
		hAlign: #center;
		openInBrickWindowLabeled: aLabel! !

!GLMBrickStructureTrait methodsFor: 'brick-structure-adding/removing' stamp: 'AliakseiSyrel 3/24/2015 10:52'!
removeBrick: aBrick
	|result|
	aBrick ifNil: [ ^ aBrick ].
	result := self privateRemoveBrick: aBrick.
	self	privatePrepareBrickAfterRemoving: aBrick.
	self doLayoutForce.
	^ result! !

!GLMBrickStructureTrait methodsFor: 'brick-structure' stamp: 'AliakseiSyrel 1/20/2015 22:38'!
owner

	^ self explicitRequirement! !

!GLMBrickStructureTrait methodsFor: 'brick-structure-opening' stamp: 'AliakseiSyrel 2/26/2015 22:25'!
openCenteredInBrickWindow

	self openCenteredInBrickWindowLabeled: self! !

!GLMBrickStructureTrait methodsFor: 'brick-structure' stamp: 'AliakseiSyrel 1/20/2015 19:28'!
subbricksCount

	^ self subbricks size! !

!GLMBrickStructureTrait methodsFor: 'brick-structure-adding/removing' stamp: 'AliakseiSyrel 3/24/2015 10:56'!
removeAllBricks
	|copy|
	copy := self subbricks copy.
	self privateRemoveAllBricks.
	copy do: [ :b | self privatePrepareBrickAfterRemoving: b ].
	self doLayoutForce! !

!GLMBrickStructureTrait methodsFor: 'private-structure' stamp: 'AliakseiSyrel 1/20/2015 19:18'!
brickDoubleLink

	^ self valueOfProperty: #brickDoubleLink ifAbsentPut: [ nil ]! !

!GLMBrickStructureTrait methodsFor: 'private-structure' stamp: 'AliakseiSyrel 2/12/2015 23:34'!
privateRemoveAllBricks
	
	self hasSubbricks ifFalse: [ ^ self ].
	self subbricks do: [:each |
		each brickDoubleLink: nil.
		each owner: nil ].
	self subbricks removeAll! !

!GLMBrickStructureTrait methodsFor: 'private-structure' stamp: 'AliakseiSyrel 1/29/2015 00:46'!
owner: aBrick
	|oldOwner|
	oldOwner := self owner.
	self privateOwner: aBrick.
	aBrick
		ifNotNil: [ self themerChanged ]
		ifNil: [ self onRemovedFrom: oldOwner ]! !

!GLMBrickStructureTrait methodsFor: 'private-structure' stamp: 'AliakseiSyrel 1/25/2015 15:46'!
privateSubbricks: aCollection

	^ self explicitRequirement! !

!GLMBrickStructureTrait methodsFor: 'brick-structure-testing' stamp: 'AliakseiSyrel 1/20/2015 19:31'!
hasSubbricks

	^ self subbricks isEmpty not! !

!GLMBrickStructureTrait methodsFor: 'private-structure' stamp: 'AliakseiSyrel 1/20/2015 22:58'!
brickDoubleLink: aDoubleLink

	self setProperty: #brickDoubleLink toValue: aDoubleLink! !

!GLMBrickTextStyle commentStamp: 'AliakseiSyrel 3/17/2015 22:47'!
I'm a style module related to a string brick!
!GLMBrickTextStyle methodsFor: 'brick-text' stamp: 'AliakseiSyrel 3/17/2015 22:50'!
textFamilyName

	^ Smalltalk ui theme labelFont familyName! !

!GLMBrickTextStyle methodsFor: 'brick-text' stamp: 'AliakseiSyrel 3/17/2015 22:50'!
textFontSize

	^ Smalltalk ui theme labelFont pointSize! !

!GLMBrickWindowStyle commentStamp: 'AliakseiSyrel 2/17/2015 20:43'!
I'm a style module related to a brik windows and its componenets!
!GLMTBlockTags commentStamp: 'AndreiChis 4/20/2014 23:10'!
I provide an api for computing tags.!
!GLMTBlockTags methodsFor: 'scripting' stamp: 'AndreiChis 4/20/2014 22:50'!
tagsBlock: anObject
	self explicitRequirement! !

!GLMTBlockTags methodsFor: 'tags' stamp: 'AndreiChis 4/20/2014 22:51'!
computeTagsFor: aGlamourValue 

	^ self computeTagsFor: aGlamourValue from: self tagsBlock! !

!GLMTBlockTags methodsFor: 'scripting' stamp: 'AndreiChis 4/20/2014 22:53'!
tags: aBlock

	self tagsBlock: aBlock.
	self hasTagsFilter ifFalse:[ self tagsFilter: aBlock ]! !

!GLMTBlockTags methodsFor: 'tags' stamp: 'AndreiChis 4/20/2014 22:51'!
computeTagsFor: aGlamourValue from: aBlock
	| value |
	
	aBlock ifNil: [ ^ OrderedCollection new ].
	value := aBlock glamourValue: aGlamourValue.
	^ value isString
		ifTrue: [ OrderedCollection with: value ]
		ifFalse: [ value asOrderedCollection ]! !

!GLMTBlockTags methodsFor: 'accessing' stamp: 'AndreiChis 4/20/2014 22:50'!
tagsBlock
	self explicitRequirement! !

!GLMTBlockTags methodsFor: 'tags' stamp: 'AndreiChis 4/20/2014 22:51'!
computeTagsFilterFor: aGlamourValue 

	^ self computeTagsFor: aGlamourValue from: self tagsFilterBlock! !

!GLMTBlockTags methodsFor: 'testing' stamp: 'AndreiChis 4/20/2014 22:48'!
hasTags
	^ self tagsBlock notNil! !

!GLMTBlockTags methodsFor: 'testing' stamp: 'AndreiChis 4/20/2014 22:48'!
hasTagsFilter
	^ self tagsFilterBlock notNil! !

!GLMTBlockTags methodsFor: 'scripting' stamp: 'AndreiChis 4/20/2014 22:50'!
tagsFilter: anObject
	self explicitRequirement! !

!GLMTBlockTags methodsFor: 'accessing' stamp: 'AndreiChis 4/20/2014 22:50'!
tagsFilterBlock
	self explicitRequirement! !

!TAbleToRotate methodsFor: 't-rotating' stamp: 'AlainPlantec 5/7/2010 23:52'!
forwardDirection: newDirection
	"Set the receiver's forward direction (in eToy terms)"
	self setProperty: #forwardDirection toValue: newDirection.! !

!TAbleToRotate methodsFor: 't-rotating' stamp: 'AlainPlantec 5/7/2010 22:34'!
prepareForRotating
	"If I require a flex shell to rotate,
	then wrap it in one and return it.
	Polygons, eg, may override to do nothing."

	^ self addFlexShell! !

!TAbleToRotate methodsFor: 't-rotating' stamp: 'AlainPlantec 5/8/2010 00:03'!
rotationDegrees: degrees	
	"redefined in all morphs which are using myself"! !

!TAbleToRotate methodsFor: 't-rotating' stamp: 'AlainPlantec 5/7/2010 23:55'!
setDirectionFrom: aPoint
	| delta degrees |
	delta := (self transformFromWorld globalPointToLocal: aPoint) - self referencePosition.
	degrees := delta degrees + 90.0.
	self forwardDirection: (degrees \\ 360) rounded.
! !

!TAbleToRotate methodsFor: 't-rotating' stamp: 'AlainPlantec 5/7/2010 23:53'!
heading
	"Return the receiver's heading"
	^ self owner 
		ifNil: [self forwardDirection]
		ifNotNil: [self forwardDirection + self owner degreesOfFlex]! !

!TAbleToRotate methodsFor: 't-rotating' stamp: 'AlainPlantec 5/7/2010 23:52'!
forwardDirection
	"Return the receiver's forward direction (in eToy terms)"
	^self valueOfProperty: #forwardDirection ifAbsent:[0.0]! !

!TAbleToRotate methodsFor: 't-rotating' stamp: 'AlainPlantec 5/7/2010 22:59'!
rotationDegrees
	"Default implementation."

	^ 0.0
! !

!TAddForIdentityCollectionsTest commentStamp: 'TorstenBergmann 2/20/2014 15:32'!
A trait for test purposes!
!TAddForIdentityCollectionsTest methodsFor: 'requirements' stamp: 'delaunay 5/13/2009 14:00'!
identityCollectionWithElementsCopyNotIdentical
	"Returns a collection including elements for which #copy doesn't return the same object."
	^ self explicitRequirement! !

!TAddForIdentityCollectionsTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:34'!
test0FixtureAddForIdentityCollectionsTest
	
	self identityCollectionWithElementsCopyNotIdentical.
	self identityCollectionWithElementsCopyNotIdentical  do: [ : each | self deny: each == each copy ].! !

!TAddForIdentityCollectionsTest methodsFor: 'tests - adding for identity collections' stamp: 'delaunay 5/13/2009 14:01'!
testTAddIfNotPresentWithElementCopy
" test specific to IdentityCollections for wich #addIfNotPresent should use == check insted of =."
	| added oldSize collection element elementCopy |
	collection := self identityCollectionWithElementsCopyNotIdentical   .
	oldSize := collection  size.
	
	element := collection  anyOne .
	elementCopy := element copy.
	self deny: (collection  includes: elementCopy ).
	
	added := collection  addIfNotPresent: elementCopy  .
	self assert: added == elementCopy . "test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection  size = (oldSize + 1)).

	! !

!TAddForUniquenessTest commentStamp: 'TorstenBergmann 2/20/2014 15:32'!
A trait for test purposes!
!TAddForUniquenessTest methodsFor: 'tests - adding uniquely' stamp: 'Alexandre Bergel 5/22/2010 12:26'!
testTAddIfNotPresentWithElementAlreadyIn

	| added oldSize |
	oldSize := self collectionWithElement size.
	self assert: (self collectionWithElement includes: self element).

	added := self collectionWithElement addIfNotPresent: self element.
	
	self assert: added = self element.
	self assert: (self collectionWithElement includes: self element).
	self assert: self collectionWithElement size = oldSize.! !

!TAddForUniquenessTest methodsFor: 'requirements' stamp: 'stephane.ducasse 10/8/2008 15:40'!
element
	^ self explicitRequirement! !

!TAddForUniquenessTest methodsFor: 'tests - adding uniquely' stamp: 'delaunay 5/12/2009 15:18'!
testTAddIfNotPresentWithNewElement
	| added oldSize |
	oldSize := self collectionWithoutElement size.
	self deny: (self collectionWithoutElement includes: self element).
	added := self collectionWithoutElement addIfNotPresent: self element.
	self assert: added = self element.
	self assert: (self collectionWithoutElement includes: self element).
	self assert: self collectionWithoutElement size = (oldSize + 1)! !

!TAddForUniquenessTest methodsFor: 'requirements' stamp: 'delaunay 5/12/2009 15:18'!
collectionWithoutElement
	" return a collection that does not include 'element' "
	^ self explicitRequirement! !

!TAddForUniquenessTest methodsFor: 'tests - adding uniquely' stamp: 'delaunay 5/12/2009 15:18'!
testAddNewElementIncrementsSize
	| added oldSize |
	oldSize := self collectionWithoutElement size.
	self deny: (self collectionWithoutElement includes: self element).
	added := self collectionWithoutElement add: self element.
	self assert: added = self element.
	self assert: (self collectionWithoutElement includes: self element).
	self assert: self collectionWithoutElement size = (oldSize + 1)! !

!TAddForUniquenessTest methodsFor: 'requirements' stamp: 'delaunay 5/12/2009 15:12'!
collectionWithElement
" return a collection already including 'element'    "
	^ self explicitRequirement! !

!TAddForUniquenessTest methodsFor: 'tests - adding uniquely' stamp: 'stephane.ducasse 10/8/2008 15:31'!
testAddAlreadyThereDoesNotCount

	| added oldSize |
	oldSize := self collectionWithElement size.
	self assert: (self collectionWithElement includes: self element).

	added := self collectionWithElement add: self element.
	
	self assert: added = self element.
	self assert: (self collectionWithElement includes: self element).
	self assert: self collectionWithElement size = oldSize.! !

!TAddForUniquenessTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureAddForUniquenessTest
	self element.
	self collectionWithElement.
	self assert: (self collectionWithElement includes: self element).
	self collectionWithoutElement.
	self deny: (self collectionWithoutElement includes: self element)! !

!TAddTest commentStamp: 'TorstenBergmann 2/20/2014 15:32'!
A trait for test purposes!
!TAddTest methodsFor: 'tests - adding' stamp: 'Alexandre Bergel 5/22/2010 12:27'!
testTAddIfNotPresentWithElementAlreadyIn

	| added oldSize collection anElement |
	collection := self collectionWithElement .
	oldSize := collection size.
	anElement := self element .
	self assert: (collection  includes: anElement ).
	
	added := collection  addIfNotPresent: anElement .
	
	self assert: added == anElement .	"test for identiy because #add: has not reason to copy its parameter."
	self assert: collection  size = oldSize! !

!TAddTest methodsFor: 'tests - adding' stamp: 'CamilloBruni 9/8/2011 14:36'!
testTAddAll
	| added collection toBeAdded |
	collection := self collectionWithElement .
	toBeAdded := self otherCollection .
	added := collection addAll: toBeAdded .
	self assert: added == toBeAdded .	"test for identiy because #addAll: has not reason to copy its parameter."
	self assert: (collection includesAll: toBeAdded )! !

!TAddTest methodsFor: 'requirements' stamp: 'damiencassou 1/14/2009 10:29'!
element
	"Returns an object that can be added to the collection returned by #collection."
	^ self explicitRequirement! !

!TAddTest methodsFor: 'tests - adding' stamp: 'CamilloBruni 11/2/2012 15:24'!
testTAddIfNotPresentWithNewElement

	| added oldSize collection elem |
	collection := self otherCollection .
	oldSize := collection  size.
	elem := self element .
	self deny: (collection  includes: elem ).
	
	added := collection  addIfNotPresent: elem .
	self assert: added == elem . "test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection  size = (oldSize + 1)).

	! !

!TAddTest methodsFor: 'requirements' stamp: 'damiencassou 1/14/2009 10:29'!
otherCollection
	"Returns a collection that does not include what is returned by #element."
	^ self explicitRequirement! !

!TAddTest methodsFor: 'tests - adding' stamp: 'delaunay 5/4/2009 10:17'!
testTAdd
	| added collection |
	collection :=self otherCollection .
	added := collection add: self element.
	
	self assert: added == self element.	"test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection includes: self element)	.
	self assert: (self collectionWithElement includes: self element).
	
	! !

!TAddTest methodsFor: 'tests - adding' stamp: 'Alexandre Bergel 5/22/2010 12:27'!
testTAddWithOccurences
	| added oldSize collection anElement |
	collection := self collectionWithElement .
	anElement := self element .
	oldSize := collection  size.
	added := collection  add: anElement withOccurrences: 5.
	
	self assert: added == anElement.	"test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection  includes: anElement).
	self assert: collection  size = (oldSize + 5)! !

!TAddTest methodsFor: 'tests - adding' stamp: 'Alexandre Bergel 5/22/2010 12:43'!
testTAddTwice
	| added oldSize collection anElement |
	collection := self collectionWithElement .
	anElement := self element .
	oldSize := collection  size.
	added := collection 
		add: anElement ;
		add: anElement .
	self assert: added == anElement .	"test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection  includes: anElement ).
	self assert: collection  size = (oldSize + 2)! !

!TAddTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureRequirementsOfTAddTest
	self collectionWithElement.
	self otherCollection.
	self element.
	self assert: (self collectionWithElement includes: self element).
	self deny: (self otherCollection includes: self element)! !

!TAddTest methodsFor: 'requirements' stamp: 'damiencassou 1/20/2009 13:32'!
collectionWithElement
	"Returns a collection that already includes what is returned by #element."
	^ self explicitRequirement! !

!TAddTest methodsFor: 'tests - adding' stamp: 'Alexandre Bergel 5/22/2010 12:25'!
testTWrite
	| added collection elem |
	collection := self otherCollection  .
	elem := self element .
	added := collection  write: elem .
	
	self assert: added == elem .	"test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection  includes: elem )	.
	self assert: (collection  includes: elem ).
	
	! !

!TAddTest methodsFor: 'tests - adding' stamp: 'Alexandre Bergel 5/22/2010 12:26'!
testTWriteTwice
	| added oldSize collection elem |
	collection := self collectionWithElement .
	elem := self element .
	oldSize := collection  size.
	added := collection 
		write: elem ;
		write: elem .
	self assert: added == elem .	"test for identiy because #add: has not reason to copy its parameter."
	self assert: (collection  includes: elem ).
	self assert: collection  size = (oldSize + 2)! !

!TApplyingOnClassSide commentStamp: 'TorstenBergmann 2/4/2014 20:36'!
Kernel trait for applying on the class side!
!TApplyingOnClassSide methodsFor: 'class hierarchy' stamp: 'SebastianTleye 7/12/2013 18:04'!
subclasses
	"Answer the receiver's subclasses."
	self theNonMetaClass == nil ifTrue:[^#()].
	^self theNonMetaClass subclasses 
		select:[:aSubclass| aSubclass isMeta not] 
		thenCollect:[:aSubclass| aSubclass class]

	"Metaclass allInstancesDo:
		[:m | Compiler evaluate: 'subclasses:=nil' for: m logged: false]"! !

!TApplyingOnClassSide methodsFor: 'instance variables' stamp: 'SebastianTleye 7/12/2013 18:06'!
removeInstVarNamed: aString 
	"Remove the argument, aString, as one of the receiver's instance variables."

	| newArray newString |
	(self instVarNames includes: aString)
		ifFalse: [self error: aString , ' is not one of my instance variables'].
	newArray := self instVarNames copyWithout: aString.
	newString := ''.
	newArray do: [:aString2 | newString := aString2 , ' ' , newString].
	self instanceVariableNames: newString! !

!TApplyingOnClassSide methodsFor: 'class hierarchy' stamp: 'SebastianTleye 7/12/2013 18:06'!
removeSubclass: aClass
	"Do nothing."! !

!TApplyingOnClassSide methodsFor: 'compiling' stamp: 'SebastianTleye 7/12/2013 17:21'!
acceptsLoggingOfCompilation
	"Answer whether the receiver's method submisions and class defintions should be logged to the changes file and to the current change set.  The metaclass follows the rule of the class itself."

	^ self theNonMetaClass acceptsLoggingOfCompilation! !

!TApplyingOnClassSide methodsFor: 'testing' stamp: 'SebastianTleye 7/17/2013 13:50'!
isObsolete
	"Return true if the receiver is obsolete"
	^self soleInstance == nil "Either no thisClass"
		or:[self soleInstance classSide ~~ self "or I am not the class of thisClass"
			or:[self soleInstance isObsolete]] "or my instance is obsolete"! !

!TApplyingOnClassSide methodsFor: 'composition' stamp: 'al 7/30/2004 09:07'!
assertConsistantCompositionsForNew: aTraitComposition
	"Applying or modifying a trait composition on the class side
	of a behavior has some restrictions."

	| baseTraits notAddable message |
	baseTraits := aTraitComposition traits select: [:each | each isBaseTrait].
	baseTraits isEmpty ifFalse: [
		notAddable := (baseTraits reject: [:each | each classSide methodDict isEmpty]).
		notAddable isEmpty ifFalse: [
			message := String streamContents: [:stream |
				stream nextPutAll: 'You can not add the base trait(s)'; cr.
				notAddable
					do: [:each | stream nextPutAll: each name]
					separatedBy: [ stream nextPutAll: ', '].
				stream cr; nextPutAll: 'to this composition because it/they define(s) methods on the class side.'].
		^TraitCompositionException signal: message]].
		
	(self instanceSide traitComposition traits asSet =
			(aTraitComposition traits
				select: [:each | each isClassTrait]
				thenCollect: [:each | each baseTrait]) asSet) ifFalse: [
				^TraitCompositionException signal: 'You can not add or remove class side traits on
				the class side of a composition. (But you can specify aliases or exclusions
				for existing traits or add a trait which does not have any methods on the class side.)']! !

!TApplyingOnClassSide methodsFor: 'accessing' stamp: 'SebastianTleye 7/17/2013 13:32'!
soleInstance
	^self explicitRequirement.! !

!TApplyingOnClassSide methodsFor: '*Fuel' stamp: 'SebastianTleye 7/17/2013 13:34'!
fuelAccept: aGeneralMapper
	^self explicitRequirement.! !

!TApplyingOnClassSide methodsFor: 'class hierarchy' stamp: 'SebastianTleye 7/12/2013 18:08'!
obsoleteSubclasses
	"Answer the receiver's subclasses."
	self theNonMetaClass == nil ifTrue:[^#()].
	^self theNonMetaClass obsoleteSubclasses 
		select:[:aSubclass| aSubclass isMeta not] 
		thenCollect:[:aSubclass| aSubclass class]

	"Metaclass allInstancesDo:
		[:m | Compiler evaluate: 'subclasses:=nil' for: m logged: false]"! !

!TApplyingOnClassSide methodsFor: 'fileIn/Out' stamp: 'SebastianTleye 7/17/2013 14:33'!
fileOutInitializerOn: aStream
	(self includesSelector: #initialize) ifTrue: 
		[aStream cr.
		aStream nextChunkPut: self soleInstance name , ' initialize'].! !

!TApplyingOnClassSide methodsFor: 'initialize-release' stamp: 'SebastianTleye 7/12/2013 17:25'!
instanceVariableNames: instVarString
	^self explicitRequirement.! !

!TApplyingOnClassSide methodsFor: 'initialize-release' stamp: 'SebastianTleye 7/17/2013 13:39'!
adoptInstance: oldInstance from: oldMetaClass 
	^self explicitRequirement.! !

!TApplyingOnClassSide methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/12/2013 17:39'!
classVarNames
	"Answer a set of the names of the class variables defined in the receiver's instance."
	
	self theNonMetaClass ifNil: [ ^ Set new ].
	^self theNonMetaClass classVarNames! !

!TApplyingOnClassSide methodsFor: '*Manifest-Core' stamp: 'SebastianTleye 7/12/2013 17:40'!
criticTheNonMetaclassClass

	^self theNonMetaClass ! !

!TApplyingOnClassSide methodsFor: 'initialize' stamp: 'SebastianTleye 7/17/2013 15:08'!
initializeFrom: anotherClassTrait
	self traitComposition: self traitComposition copyTraitExpression.
	self methodDict: self methodDict copy.
	self localSelectors: self localSelectors copy.
	self basicOrganization: self organization copy.! !

!TApplyingOnClassSide methodsFor: '*OpalCompiler-Core' stamp: 'CamilleTeruel 9/1/2014 16:05'!
compilerClass
	"The compiler class is defined on instance-side to be able to customize it for *one* metaclass"
	^ self instanceSide classSideCompilerClass! !

!TApplyingOnClassSide methodsFor: '*Ring-Core-Kernel' stamp: 'SebastianTleye 7/11/2013 11:01'!
asFullRingDefinition

	^ self theNonMetaClass asFullRingDefinition theMetaClass! !

!TApplyingOnClassSide methodsFor: 'compiling' stamp: 'SebastianTleye 7/12/2013 17:34'!
bindingOf: varName

	^self theNonMetaClass classBindingOf: varName! !

!TApplyingOnClassSide methodsFor: 'composition' stamp: 'apb 8/24/2005 14:15'!
noteNewBaseTraitCompositionApplied: aTraitComposition
	"The argument is the new trait composition of my base trait - add
	the new traits or remove non existing traits on my class side composition.
	(Each class trait in my composition has its base trait on the instance side
	of the composition - manually added traits to the class side are always 
	base traits.)"
	
	| newComposition traitsFromInstanceSide |
	traitsFromInstanceSide := self traitComposition traits
		select: [:each | each isClassTrait]
		thenCollect: [:each | each baseTrait].
		
	newComposition := self traitComposition copyTraitExpression.
	(traitsFromInstanceSide copyWithoutAll: aTraitComposition traits) do: [:each |
		newComposition removeFromComposition: each classTrait].
	(aTraitComposition traits copyWithoutAll: traitsFromInstanceSide) do: [:each |
		newComposition add:  (each classTrait)].

	self setTraitComposition: newComposition! !

!TApplyingOnClassSide methodsFor: 'class hierarchy' stamp: 'SebastianTleye 7/12/2013 18:05'!
subclassesDo: aBlock
	"Evaluate aBlock for each of the receiver's immediate subclasses."
	self theNonMetaClass subclassesDo:[:aSubclass|
		"The following test is for Class class which has to exclude
		the Metaclasses being subclasses of Class."
		aSubclass isMeta ifFalse:[aBlock value: aSubclass class]].! !

!TApplyingOnClassSide methodsFor: 'accessing hierarchy protocol' stamp: 'SebastianTleye 7/12/2013 14:22'!
hasClassSide
	^false! !

!TApplyingOnClassSide methodsFor: 'class hierarchy' stamp: 'SebastianTleye 7/11/2013 11:15'!
addSubclass: aClass
	"Do nothing."! !

!TApplyingOnClassSide methodsFor: 'fileIn/Out' stamp: 'SebastianTleye 7/12/2013 20:57'!
definition
	^self explicitRequirement.! !

!TApplyingOnClassSide methodsFor: 'fileIn/Out' stamp: 'SebastianTleye 7/17/2013 14:40'!
nonTrivial 
	"Answer whether the receiver has any methods or instance variables."

	^ self instVarNames notEmpty or: [self hasMethods or: [self hasTraitComposition]]! !

!TApplyingOnClassSide methodsFor: 'accessing' stamp: 'SebastianTleye 7/12/2013 20:49'!
category
	^ self theNonMetaClass category! !

!TApplyingOnClassSide methodsFor: 'testing' stamp: 'SebastianTleye 7/12/2013 18:11'!
isMeta
	^ true! !

!TApplyingOnClassSide methodsFor: '*Tools' stamp: 'SebastianTleye 7/17/2013 14:19'!
canonicalArgumentName
	^self explicitRequirement.! !

!TApplyingOnClassSide methodsFor: 'compiling' stamp: 'SebastianTleye 7/12/2013 18:12'!
possibleVariablesFor: misspelled continuedFrom: oldResults

	^ self theNonMetaClass possibleVariablesFor: misspelled continuedFrom: oldResults
! !

!TApplyingOnClassSide methodsFor: 'composition' stamp: 'SebastianTleye 7/17/2013 15:01'!
uses: aTraitCompositionOrArray
	| copyOfOldTrait newComposition |
	copyOfOldTrait := self copy.
	newComposition := aTraitCompositionOrArray asTraitComposition.
	self assertConsistantCompositionsForNew: newComposition.
	self setTraitComposition: newComposition.
	SystemAnnouncer uniqueInstance
		traitDefinitionChangedFrom: copyOfOldTrait to: self.! !

!TApplyingOnClassSide methodsFor: 'instance variables' stamp: 'SebastianTleye 7/12/2013 17:21'!
addInstVarNamed: aString 
	"Add the argument, aString, as one of the receiver's instance variables."

	| fullString |
	fullString := String streamContents: [:strm |
		self instVarNames do: [:aString2 | strm nextPutAll: aString2; space].
		strm nextPutAll: aString].
	self instanceVariableNames: fullString! !

!TApplyingOnClassSide methodsFor: 'testing' stamp: 'SebastianTleye 7/17/2013 14:14'!
canZapMethodDictionary
	"Return true if it is safe to zap the method dictionary on #obsolete"
	self soleInstance == nil
		ifTrue:[^true]
		ifFalse:[^self soleInstance canZapMethodDictionary]! !

!TApplyingOnClassSide methodsFor: 'pool variables' stamp: 'SebastianTleye 7/12/2013 17:37'!
classPool
	"Answer the dictionary of class variables."

	^self theNonMetaClass classPool! !

!TApplyingOnClassSide methodsFor: 'compiling' stamp: 'SebastianTleye 7/12/2013 17:33'!
binding
	"return an association that can be used as the binding
	 To share it between methods, reuse an existing one if possible"
	^self methodDict 
		ifEmpty: [nil -> self]
		ifNotEmpty: [:dict | dict anyOne classBinding]! !

!TApplyingOnClassSide methodsFor: 'compiling' stamp: 'SebastianTleye 7/12/2013 18:02'!
wantsChangeSetLogging
	"Answer whether code submitted for the receiver should be remembered by the changeSet mechanism.The metaclass follows the rule of the class itself."

	^ self theNonMetaClass wantsChangeSetLogging! !

!TApplyingOnClassSide methodsFor: 'instance creation' stamp: 'SebastianTleye 7/17/2013 14:39'!
new
	^self explicitRequirement.! !

!TApplyingOnClassSide methodsFor: 'class hierarchy' stamp: 'SebastianTleye 7/12/2013 17:25'!
addObsoleteSubclass: aClass
	"Do nothing."! !

!TApplyingOnClassSide methodsFor: '*Ring-Core-Kernel' stamp: 'SebastianTleye 7/11/2013 11:01'!
asRingDefinition

	^ self theNonMetaClass asRingDefinition theMetaClass! !

!TApplyingOnClassSide methodsFor: 'compiling' stamp: 'SebastianTleye 7/12/2013 18:01'!
wantsRecompilationProgressReported
	"The metaclass follows the rule of the class itself."

	^ self theNonMetaClass wantsRecompilationProgressReported! !

!TApplyingOnClassSide methodsFor: '*OpalCompiler-Core' stamp: 'CamilleTeruel 9/1/2014 16:05'!
compiler
	"The compiler is defined on instance-side to be able to customize it for *one* metaclass"
	^ self instanceSide classSideCompiler! !

!TApplyingOnClassSide methodsFor: 'initialize-release' stamp: 'MarcusDenker 1/15/2015 16:00'!
slots: instVarString
	^self explicitRequirement.! !

!TApplyingOnClassSide methodsFor: 'initialize-release' stamp: 'SebastianTleye 7/17/2013 14:48'!
uses: aTraitCompositionOrArray instanceVariableNames: instVarString 
	| newComposition newMetaClass copyOfOldMetaClass |
	
	copyOfOldMetaClass := self copy.
	newMetaClass := self instanceVariableNames: instVarString.
	
	newComposition := aTraitCompositionOrArray asTraitComposition.
	newMetaClass assertConsistantCompositionsForNew: newComposition.
	newMetaClass setTraitComposition: newComposition.
	
	SystemAnnouncer uniqueInstance
		classDefinitionChangedFrom: copyOfOldMetaClass to: newMetaClass! !

!TApplyingOnClassSide methodsFor: 'testing' stamp: 'SebastianTleye 7/12/2013 18:10'!
isSelfEvaluating
	^self isObsolete not! !

!TApplyingOnClassSide methodsFor: 'accessing' stamp: 'SebastianTleye 7/12/2013 18:09'!
name
	^self explicitRequirement.! !

!TApplyingOnClassSide methodsFor: 'pool variables' stamp: 'SebastianTleye 7/19/2013 18:32'!
sharedPools
	^OrderedCollection new.! !

!TApplyingOnClassSide methodsFor: 'testing' stamp: 'SebastianTleye 7/17/2013 13:53'!
isAnonymous
	^self soleInstance isAnonymous ! !

!TAsStringCommaAndDelimiterSequenceableTest commentStamp: 'TorstenBergmann 2/20/2014 15:32'!
A trait for test purposes!
!TAsStringCommaAndDelimiterSequenceableTest methodsFor: 'tests - comma and delimiter' stamp: 'delaunay 4/8/2009 11:53'!
testAsStringOnDelimiterMore

	| delim multiItemStream result index |
	"delim := ', '.
	multiItemStream := '' readWrite.
	self oneTwoThreeItemCol asStringOn: multiItemStream delimiter: ', '.
	self assert: multiItemStream contents = '1, 2, 3'."
	
	delim := ', '.
	result:=''.
	multiItemStream := ReadWriteStream on:result.
	self nonEmpty  asStringOn: multiItemStream delimiter: ', '.
	
	index:=1.
	(result findBetweenSubStrs: ', ' )do:
		[:each |
		self assert: each= ((self nonEmpty at:index)asString).
		index:=index+1
		].! !

!TAsStringCommaAndDelimiterSequenceableTest methodsFor: 'tests - comma and delimiter' stamp: 'delaunay 4/9/2009 09:39'!
testAsStringOnDelimiterLastMore

	| delim multiItemStream result last allElementsAsString |
	
	delim := ', '.
	last := 'and'.
	result:=''.
	multiItemStream := ReadWriteStream on:result.
	self nonEmpty  asStringOn: multiItemStream delimiter: ', ' last: last.
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 )
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString)].
		i=(allElementsAsString size-1)
			ifTrue:[ self deny: (allElementsAsString at:i)=(last)asString].
		i=(allElementsAsString size)
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:(i-1))asString)].
			].
	
! !

!TAsStringCommaAndDelimiterSequenceableTest methodsFor: 'tests - comma and delimiter' stamp: 'delaunay 4/8/2009 11:38'!
testAsCommaStringOne
	
	"self assert: self oneItemCol asCommaString = '1'.
	self assert: self oneItemCol asCommaStringAnd = '1'."

	self assert: self nonEmpty1Element  asCommaString = (self nonEmpty1Element first asString).
	self assert: self nonEmpty1Element  asCommaStringAnd = (self nonEmpty1Element first asString).
	! !

!TAsStringCommaAndDelimiterSequenceableTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsStringOnDelimiterLastEmpty

	| delim emptyStream |
	delim := ', '.
	emptyStream := ReadWriteStream on: ''.
	self empty asStringOn: emptyStream delimiter: delim last:'and'.
	self assert: emptyStream contents = ''.
! !

!TAsStringCommaAndDelimiterSequenceableTest methodsFor: 'tests - comma and delimiter' stamp: 'delaunay 4/23/2009 14:41'!
testAsCommaStringMore

	"self assert: self oneTwoThreeItemCol asCommaString = '1, 2, 3'.
	self assert: self oneTwoThreeItemCol asCommaStringAnd = '1, 2 and 3'
"

	| result resultAnd index allElementsAsString |
	result:= self nonEmpty asCommaString .
	resultAnd:= self nonEmpty asCommaStringAnd .
 
	index := 1.
	(result findBetweenSubStrs: ',' )do:
		[:each |
		index = 1
			ifTrue: [self assert: each= ((self nonEmpty at:index)asString)]
			ifFalse: [self assert: each= (' ',(self nonEmpty at:index) asString)].
		index:=index+1
		].
	
	"verifying esultAnd :"
	allElementsAsString:=(resultAnd findBetweenSubStrs: ',' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size )
			ifTrue: [
			i = 1
				ifTrue:[self assert: (allElementsAsString at:i)=((self nonEmpty at:i) asString)]
				ifFalse:[self assert: (allElementsAsString at:i)=(' ',(self nonEmpty at:i) asString)]
				].
		i=(allElementsAsString size)
			ifTrue:[ 
			i = 1
				ifTrue:[self assert: (allElementsAsString at:i)=( (self nonEmpty at:i ) asString ,' and ', (self nonEmpty at: ( i + 1) ) asString )]
				ifFalse:[self assert: (allElementsAsString at:i)=( ' ' , (self nonEmpty at:i ) asString ,' and ', (self nonEmpty at: ( i + 1) ) asString )]
				].
		
		
			].! !

!TAsStringCommaAndDelimiterSequenceableTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureAsStringCommaAndDelimiterTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty.
	self nonEmpty1Element.
	self assert: self nonEmpty1Element size = 1! !

!TAsStringCommaAndDelimiterSequenceableTest methodsFor: 'tests - comma and delimiter' stamp: 'delaunay 4/9/2009 09:43'!
testAsStringOnDelimiterLastOne

	| delim oneItemStream result |
	
	delim := ', '.
	result:=''.
	oneItemStream := ReadWriteStream on: result.
	self nonEmpty1Element  asStringOn: oneItemStream delimiter: delim last: 'and'.
	oneItemStream do:[:each | self assert: each = (self nonEmpty1Element first asString)].
	

	! !

!TAsStringCommaAndDelimiterSequenceableTest methodsFor: 'requirements' stamp: ''!
empty

	^ self explicitRequirement ! !

!TAsStringCommaAndDelimiterSequenceableTest methodsFor: 'requirements' stamp: ''!
nonEmpty1Element
" return a collection of size 1 including one element"
	^ self explicitRequirement ! !

!TAsStringCommaAndDelimiterSequenceableTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsStringOnDelimiterEmpty

	| delim emptyStream |
	delim := ', '.
	emptyStream := ReadWriteStream on: ''.
	self empty asStringOn: emptyStream delimiter: delim.
	self assert: emptyStream contents = ''.
! !

!TAsStringCommaAndDelimiterSequenceableTest methodsFor: 'tests - comma and delimiter' stamp: 'delaunay 4/8/2009 14:43'!
testAsStringOnDelimiterOne

	| delim oneItemStream result |
	"delim := ', '.
	oneItemStream := '' readWrite.
	self oneItemCol asStringOn: oneItemStream delimiter: delim.
	self assert: oneItemStream contents = '1'."
	
	delim := ', '.
	result:=''.
	oneItemStream := ReadWriteStream on: result.
	self nonEmpty1Element  asStringOn: oneItemStream delimiter: delim.
	oneItemStream do:[:each | self assert: each = (self nonEmpty1Element first asString)].
	

	! !

!TAsStringCommaAndDelimiterSequenceableTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: ''!
testAsCommaStringEmpty

	self assert: self empty asCommaString = ''.
	self assert: self empty asCommaStringAnd = ''.
	
! !

!TAsStringCommaAndDelimiterSequenceableTest methodsFor: 'requirements' stamp: ''!
nonEmpty

	^ self explicitRequirement ! !

!TAsStringCommaAndDelimiterTest commentStamp: 'TorstenBergmann 2/20/2014 15:32'!
A trait for test purposes!
!TAsStringCommaAndDelimiterTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: 'delaunay 4/14/2009 15:12'!
testAsStringOnDelimiterMore

	| delim multiItemStream result allElementsAsString tmp |
	
	
	delim := ', '.
	result:=''.
	tmp:= self nonEmpty collect:[:each | each asString].
	multiItemStream := ReadWriteStream on:result.
	self nonEmpty  asStringOn: multiItemStream delimiter: ', '.
	
	allElementsAsString := (result findBetweenSubStrs: ', ' ).
	allElementsAsString do:
		[:each |
		self assert: (tmp occurrencesOf: each)=(allElementsAsString occurrencesOf: each).
		].! !

!TAsStringCommaAndDelimiterTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: 'delaunay 4/14/2009 15:16'!
testAsStringOnDelimiterLastMore

	| delim multiItemStream result last allElementsAsString tmp |
	
	delim := ', '.
	last := 'and'.
	result:=''.
	tmp := self nonEmpty collect: [:each | each asString].
	multiItemStream := ReadWriteStream on:result.
	self nonEmpty  asStringOn: multiItemStream delimiter: ', ' last: last.
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 ) | i= allElementsAsString size
			ifTrue: [self assert: (tmp occurrencesOf:(allElementsAsString at:i))=(allElementsAsString 			occurrencesOf:(allElementsAsString at:i))].
		i=(allElementsAsString size-1)
			ifTrue:[ self assert: (allElementsAsString at:i)=('and')].
			].
! !

!TAsStringCommaAndDelimiterTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: 'delaunay 4/14/2009 14:59'!
testAsCommaStringOne
	
	self nonEmpty1Element do: 
		[:each | 
		self assert: each asString =self nonEmpty1Element  asCommaString.
		self assert: each asString=self nonEmpty1Element  asCommaStringAnd.].

	! !

!TAsStringCommaAndDelimiterTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: 'delaunay 4/14/2009 14:42'!
testAsStringOnDelimiterLastEmpty

	| delim emptyStream |
	delim := ', '.
	emptyStream := ReadWriteStream on: ''.
	self empty asStringOn: emptyStream delimiter: delim last:'and'.
	self assert: emptyStream contents = ''.
! !

!TAsStringCommaAndDelimiterTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: 'delaunay 4/30/2009 12:00'!
testAsCommaStringMore

	| result resultAnd index allElementsAsString tmp |
	result:= self nonEmpty asCommaString .
	resultAnd:= self nonEmpty asCommaStringAnd .
	tmp :=OrderedCollection new. 
	self nonEmpty do: [ :each | tmp add: each asString].

	"verifying result  :"
	index := 1.
	allElementsAsString := (result findBetweenSubStrs: ', ' ).
	allElementsAsString do:
		[:each |
		self assert: (tmp occurrencesOf: each)=(allElementsAsString occurrencesOf: each).
		].
	
	"verifying esultAnd :"
	allElementsAsString:=(resultAnd findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 ) | i= allElementsAsString size
			ifTrue: [self assert: (tmp occurrencesOf:(allElementsAsString at:i))=(allElementsAsString  occurrencesOf:(allElementsAsString at:i))].
		i=(allElementsAsString size-1)
			ifTrue:[ self assert: (allElementsAsString at:i)=('and')].
			].! !

!TAsStringCommaAndDelimiterTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureAsStringCommaAndDelimiterTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty.
	self nonEmpty1Element.
	self assert: self nonEmpty1Element size = 1! !

!TAsStringCommaAndDelimiterTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: 'delaunay 4/14/2009 15:09'!
testAsStringOnDelimiterLastOne

	| delim oneItemStream result |
	
	delim := ', '.
	result:=''.
	oneItemStream := ReadWriteStream on: result.
	self nonEmpty1Element  asStringOn: oneItemStream delimiter: delim last: 'and'.
	oneItemStream  do:
		[:each1 |
		self nonEmpty1Element do: [:each2 |self assert: each1 = (each2 asString) ]
		 ].
	

! !

!TAsStringCommaAndDelimiterTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 09:57'!
empty

	^ self explicitRequirement ! !

!TAsStringCommaAndDelimiterTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 09:57'!
nonEmpty1Element
" return a collection of size 1 including one element"
	^ self explicitRequirement ! !

!TAsStringCommaAndDelimiterTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: 'delaunay 4/14/2009 14:42'!
testAsStringOnDelimiterEmpty

	| delim emptyStream |
	delim := ', '.
	emptyStream := ReadWriteStream on: ''.
	self empty asStringOn: emptyStream delimiter: delim.
	self assert: emptyStream contents = ''.
! !

!TAsStringCommaAndDelimiterTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: 'delaunay 4/14/2009 15:06'!
testAsStringOnDelimiterOne

	| delim oneItemStream result |

	delim := ', '.
	result:=''.
	oneItemStream := ReadWriteStream on: result.
	self nonEmpty1Element  asStringOn: oneItemStream delimiter: delim.
	oneItemStream  do:
		[:each1 |
		self nonEmpty1Element do: [:each2 |self assert: each1 = (each2 asString) ]
		 ].
	
! !

!TAsStringCommaAndDelimiterTest methodsFor: 'tests - as string comma delimiter sequenceable' stamp: 'delaunay 4/14/2009 14:41'!
testAsCommaStringEmpty

	self assert: self empty asCommaString = ''.
	self assert: self empty asCommaStringAnd = ''.
	
! !

!TAsStringCommaAndDelimiterTest methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 09:57'!
nonEmpty

	^ self explicitRequirement ! !

!TAssertable commentStamp: 'LaurentLaffont 4/15/2011 20:20'!
I think it is not used yet. I think it is a Trait so that we can make things assertable and not need to subclass from TestCase for example. I may expect that TestCase uses such Trait instead of implementing all those methods,  but it is not the case. Even more, TAssertable users size -> 0. 

So...seems a work half done. Adrian Kuhn introduce it. Check
http://forum.world.st/template/NamlServlet.jtp?macro=search_page&node=1294837&query=TAssertable!
!TAssertable methodsFor: 'asserting' stamp: 'AdrianKuhn 12/21/2009 14:56'!
shouldnt: aBlock
	self deny: aBlock value
			! !

!TAssertable methodsFor: 'extensions' stamp: 'CamilloBruni 8/24/2012 17:26'!
skip: aComment
	"Don't run this test, and don't mark it as failure"
	TestSkip signal: aComment! !

!TAssertable methodsFor: 'asserting' stamp: 'TorstenBergmann 10/24/2013 09:21'!
shouldnt: aBlock raise: anExceptionalEvent description: aString  
 
	^self
		assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) not
		description: aString
			! !

!TAssertable methodsFor: 'asserting' stamp: 'AdrianKuhn 12/21/2009 14:56'!
deny: aBooleanOrBlock

	self assert: aBooleanOrBlock value not
			! !

!TAssertable methodsFor: 'asserting' stamp: 'StephaneDucasse 6/9/2012 22:42'!
assert: aBooleanOrBlock description: aString resumable: resumableBoolean 
	| exception |
	aBooleanOrBlock value
		ifFalse: 
			[self classForTestResult failure new
				isResumable: resumableBoolean;
				signal: aString]
			! !

!TAssertable methodsFor: 'asserting' stamp: 'AdrianKuhn 12/21/2009 14:56'!
deny: aBooleanOrBlock description: aString
	self assert: aBooleanOrBlock value not description: aString
			! !

!TAssertable methodsFor: 'private' stamp: 'MarcusDenker 9/30/2012 09:53'!
comparingStringBetween: actual and: expected

	^ String streamContents: [:stream |
			stream
				nextPutAll: 'Got ';
				nextPutAll: actual fullPrintString;
				nextPutAll: ' instead of ';
				nextPutAll: expected fullPrintString;
				nextPutAll: '.']! !

!TAssertable methodsFor: 'asserting' stamp: 'AdrianKuhn 12/24/2009 01:26'!
executeShould: aBlock inScopeOf: anExceptionalEvent 
	^[aBlock value.
 	false] on: anExceptionalEvent
		do: [:ex | ex return: true]
			! !

!TAssertable methodsFor: 'asserting' stamp: 'StephaneDucasse 6/9/2012 22:42'!
assert: aBooleanOrBlock description: aStringOrBlock
	aBooleanOrBlock value ifFalse: [
		| message |
		message := aStringOrBlock value.
		self classForTestResult failure signal: message]
			! !

!TAssertable methodsFor: 'asserting' stamp: 'AdrianKuhn 12/21/2009 14:56'!
should: aBlock raise: anExceptionalEvent whoseDescriptionDoesNotInclude: subString description: aString 
	^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionNotContaining: subString)
		description: aString
! !

!TAssertable methodsFor: 'asserting' stamp: 'AdrianKuhn 12/24/2009 01:29'!
should: aBlock raise: anException withExceptionDo: anotherBlock 

	^self assert: (self executeShould: aBlock inScopeOf: anException withExceptionDo: anotherBlock)! !

!TAssertable methodsFor: 'asserting' stamp: 'AdrianKuhn 12/21/2009 14:56'!
should: aBlock
	self assert: aBlock value
			! !

!TAssertable methodsFor: 'asserting' stamp: 'AdrianKuhn 12/21/2009 14:56'!
should: aBlock raise: anExceptionalEvent 
	^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent)
			! !

!TAssertable methodsFor: 'asserting' stamp: 'TorstenBergmann 10/24/2013 09:22'!
shouldnt: aBlock raise: anExceptionalEvent whoseDescriptionDoesNotInclude: subString description: aString 
	 
	^self
		assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionNotContaining: subString) not
		description: aString
! !

!TAssertable methodsFor: 'asserting' stamp: 'TorstenBergmann 10/24/2013 09:22'!
shouldnt: aBlock raise: anExceptionalEvent whoseDescriptionIncludes: subString description: aString  
	 
	^self 
		assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionContaining: subString) not
		description: aString
! !

!TAssertable methodsFor: 'asserting' stamp: 'AdrianKuhn 12/24/2009 01:26'!
executeShould: aBlock inScopeOf: anException withExceptionDo: anotherBlock

	^[aBlock value.
 	false] 
		on: anException
		do: [:exception | 
			anotherBlock value: exception.
			exception return: true]! !

!TAssertable methodsFor: 'asserting' stamp: 'AdrianKuhn 12/21/2009 14:56'!
should: aBlock raise: anExceptionalEvent description: aString 
	^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent)
		description: aString
			! !

!TAssertable methodsFor: 'asserting' stamp: 'AdrianKuhn 12/21/2009 14:56'!
shouldnt: aBlock description: aString
	self deny: aBlock value description: aString
			! !

!TAssertable methodsFor: 'asserting' stamp: 'jannik.laval 5/2/2010 07:34'!
assert: aBoolean

	aBoolean ifFalse: [self signalFailure: 'Assertion failed']
			! !

!TAssertable methodsFor: 'asserting' stamp: 'AdrianKuhn 12/21/2009 14:56'!
should: aBlock description: aString
	self assert: aBlock value description: aString
			! !

!TAssertable methodsFor: 'asserting' stamp: 'SeanDeNigris 6/21/2012 22:33'!
assert: actual equals: expected
	^ self
		assert: expected = actual
		description: [self comparingStringBetween: actual and: expected]! !

!TAssertable methodsFor: 'asserting' stamp: 'CamilloBruni 8/24/2012 17:23'!
executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionNotContaining: aString
	^[aBlock value.
 	false] on: anExceptionalEvent
		do: [:ex | ex return: (ex description includesSubstring: aString) not ]
			! !

!TAssertable methodsFor: 'asserting' stamp: 'CamilloBruni 8/24/2012 16:43'!
shouldFix: aBlock 
	"Run the block expecting an Exception. Throw an assertion failure if the block does NOT throw an exception."
	^self should: aBlock raise: Exception! !

!TAssertable methodsFor: 'asserting' stamp: 'StephaneDucasse 6/9/2012 22:42'!
signalFailure: aString
	self classForTestResult failure signal: aString! !

!TAssertable methodsFor: 'asserting' stamp: 'TorstenBergmann 10/24/2013 09:21'!
shouldnt: aBlock raise: anExceptionalEvent  
	 
	^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) not
			! !

!TAssertable methodsFor: 'asserting' stamp: 'CamilloBruni 8/24/2012 17:26'!
skip
	"Don't run this test, and don't mark it as failure"
	TestSkip signal! !

!TAssertable methodsFor: 'private' stamp: 'CamilloBruni 10/15/2013 01:16'!
comparingCollectionBetween: left and: right
	| additionalLeft additionalRight sortBlock|
	
	"use a very slow sort block"
	sortBlock := [ :a :b | a asString <= b asString ].
	additionalLeft := (left difference: right) sorted: sortBlock.
	additionalRight := (right difference: left) sorted: sortBlock. 
	
	^ String streamContents: [:stream |
		stream
			nextPutAll: 'Given Collections do not match. Got '; lf;
			tab; nextPutAll: 'left := '; print: left; nextPut: $.; lf;
			nextPutAll: ' instead of ';
			tab; nextPutAll: ' right :='; print: left; nextPut: $.; lf.
		left size = right size
			ifFalse: [ 
				stream 
					nextPutAll: 'Collection size does not match: left='; 
					print: left size;
					nextPutAll: ' vs. right=';
					print: right size; lf ].
		additionalLeft isEmpty
			ifFalse: [ 
				stream 
					nextPutAll: 'Got ';
					print: additionalLeft size;
					nextPutAll: ' additional element(s) in the left collection: ';
					tab; print: additionalLeft  ].
		additionalRight isEmpty
			ifFalse: [ 
				stream 
					nextPutAll: 'Got ';
					print: additionalRight size;
					nextPutAll: ' additional element(s) in the right collection: ';
					tab; print: additionalRight  ]]! !

!TAssertable methodsFor: 'asserting' stamp: 'ChristopheDemarey 3/27/2015 13:04'!
assertCollection: actual hasSameElements: expected
	"Assert that a collection contains the same elements as the given collection. Order is not checked, only the presence/absence of elements."
	| missingElements additionalElements |
	
	additionalElements := actual difference: expected.
	missingElements := expected difference: (actual intersection: expected).
	self 
		assert: (additionalElements isEmpty and: [ missingElements isEmpty ])
		description: (String streamContents: 
			[:stream |
			stream
				nextPutAll: 'Given Collections do not match!!'; lf;
				tab; nextPutAll: 'additions : '; print: additionalElements asArray; lf;
				tab; nextPutAll: 'missing: '; print: missingElements asArray; lf ])! !

!TAssertable methodsFor: 'asserting' stamp: 'StephaneDucasse 6/9/2012 23:00'!
classForTestResult
	"Returns the class of the test result"
	^ TestResult! !

!TAssertable methodsFor: 'asserting' stamp: 'CamilloBruni 8/24/2012 17:14'!
should: aBlock notTakeMoreThan: aDuration
    "Evaluate aBlock and if it takes more than given duration
    to run we report a test failure. "

	^ aBlock valueWithin: aDuration onTimeout: [
		self 
			assert: false 
			description: ['Block evaluation took more than the expected <1p>' expandMacrosWith: aDuration]
	]
	
! !

!TAssertable methodsFor: 'asserting' stamp: 'AdrianKuhn 12/21/2009 14:56'!
deny: aBooleanOrBlock description: aString resumable: resumableBoolean 
	self
		assert: aBooleanOrBlock value not
		description: aString
		resumable: resumableBoolean
			! !

!TAssertable methodsFor: 'asserting' stamp: 'CamilloBruni 8/24/2012 17:23'!
executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionContaining: aString
	^[aBlock value.
 	false] on: anExceptionalEvent
		do: [:ex | ex return: (ex description includesSubstring: aString) ]
			! !

!TAssertable methodsFor: 'asserting' stamp: 'CamilloBruni 10/15/2013 01:03'!
assertCollection: actual equals: expected
	"Specialized test method that generates a proper error message for collection"
	^ self
		assert: expected = actual
		description: [ self comparingCollectionBetween: actual and: expected ]! !

!TAssertable methodsFor: 'asserting' stamp: 'AdrianKuhn 12/21/2009 14:56'!
should: aBlock raise: anExceptionalEvent whoseDescriptionIncludes: subString description: aString 
	^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionContaining: subString)
		description: aString
! !

!TAssertable methodsFor: 'asserting' stamp: 'AdrianKuhn 12/24/2009 01:28'!
fail

	^self assert: false! !

!TAssertable methodsFor: 'asserting' stamp: 'AdrianKuhn 12/24/2009 01:29'!
should: aBlock notTakeMoreThanMilliseconds: anInteger
    "For compatibility with other Smalltalks"

   self should: aBlock notTakeMoreThan: (Duration milliSeconds: anInteger).! !

!TAssertable methodsFor: 'asserting' stamp: 'CamilloBruni 10/20/2012 22:26'!
skipUnless: aBooleanOrBlock
	" If the assumption in aBooleanOrBlock is not true, abandon the running test
	and mark it as passed. "
	aBooleanOrBlock value ifFalse:
			[ TestSkip signal: 'Assumption in #skipUnless: failed' ]! !

!TAssertable methodsFor: 'asserting' stamp: 'CamilloBruni 1/25/2013 00:43'!
fail: aDescriptionString

	^self assert: false description: aDescriptionString! !

!TBeginsEndsWith commentStamp: 'TorstenBergmann 2/20/2014 15:32'!
A trait for test purposes!
!TBeginsEndsWith methodsFor: 'requirements' stamp: 'delaunay 4/9/2009 15:04'!
empty
	self explicitRequirement.! !

!TBeginsEndsWith methodsFor: 'tests - begins ends with' stamp: 'StephaneDucasse 3/28/2010 21:03'!
testsEndsWith
	
	self assert: (self nonEmpty endsWith: self nonEmpty copyWithoutFirst).
	self assert: (self nonEmpty endsWith: self nonEmpty).
	self deny: (self nonEmpty endsWith: (self nonEmpty copyWith: self nonEmpty first)).! !

!TBeginsEndsWith methodsFor: 'tests - begins ends with' stamp: 'StephaneDucasse 3/28/2010 21:03'!
testsEndsWithEmpty
	
	self deny: (self nonEmpty endsWith: self empty).
	self deny: (self empty endsWith: self nonEmpty).
	! !

!TBeginsEndsWith methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureBeginsEndsWithTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self assert: self nonEmpty size > 1.
	self empty.
	self assert: self empty isEmpty! !

!TBeginsEndsWith methodsFor: 'tests - begins ends with' stamp: 'delaunay 4/9/2009 15:11'!
testsBeginsWithEmpty
	
	self deny: (self nonEmpty beginsWith:(self empty)).
	self deny: (self empty beginsWith:(self nonEmpty )).
! !

!TBeginsEndsWith methodsFor: 'requirements' stamp: 'delaunay 4/9/2009 14:58'!
nonEmpty
	self explicitRequirement.! !

!TBeginsEndsWith methodsFor: 'tests - begins ends with' stamp: 'HenrikSperreJohansen 10/18/2009 12:21'!
testsBeginsWith
	
	self assert: (self nonEmpty beginsWith:(self nonEmpty copyUpTo: self nonEmpty last)).
	self assert: (self nonEmpty beginsWith:(self nonEmpty )).
	self deny: (self nonEmpty beginsWith:(self nonEmpty copyWith:self nonEmpty first)).! !

!TBehavior commentStamp: 'TorstenBergmann 2/4/2014 20:36'!
Kernel trait for Behavior!
!TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'!
noteChangedSelectors: aCollection
	"Start update of my methodDict (after changes to traits in traitComposition
	or after a local method was removed from my methodDict). The argument 
	is a collection of method selectors that may have been changed. Most of the time
	aCollection only holds one selector. But when there are aliases involved 
	there may be several method changes that have to be propagated to users."

	| affectedSelectors |
	affectedSelectors := IdentitySet new.
	aCollection do: [:selector |
		affectedSelectors addAll: (self updateMethodDictionarySelector: selector)].
	self notifyUsersOfChangedSelectors: affectedSelectors.
	^ affectedSelectors! !

!TBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 5/24/2013 17:04'!
allUnreferencedInstanceVariables
	"Return a list of the instance variables known to the receiver which are not referenced in the receiver or any of its subclasses OR superclasses"

	^ self allInstVarNames reject: [:ivn |
		| definingClass |		
		definingClass := self classThatDefinesInstanceVariable: ivn.
		definingClass withAllSubclasses anySatisfy: [:class |  
				(class whichSelectorsAccess: ivn asSymbol) notEmpty]]! !

!TBehavior methodsFor: 'private' stamp: 'maxmattone 3/5/2015 15:02'!
becomeCompact
	"Make me compact.
	This means: 
	- find a free slot in 'Smalltalk compactClassArray'
	- add me in that array
	- update my format with the index
	- update my instances
	"
	| compactClassesArray index |
	self isWeak 
		ifTrue: [^ self error: 'You must not make a weak class compact'].
	compactClassesArray := Smalltalk compactClassesArray.
	(self isCompact or: [compactClassesArray includes: self])
		ifTrue: [^ self error: self name , 'is already compact'].
	index := compactClassesArray indexOf: nil
		ifAbsent: [^ self error: 'compact class table is full'].
	"Install this class in the compact class table"
	compactClassesArray at: index put: self.

	"Update instspec so instances will be compact. 
	The layout has the responsibility for setting the format."
	self layout compactClassIndex: index.

	"Make up new instances and become old ones into them"
	self updateInstancesFrom: self.
	"Purge any old instances"
	Smalltalk garbageCollect.! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'MarcusDenker 12/20/2013 10:32'!
methodDictionary
	^self methodDict! !

!TBehavior methodsFor: 'testing' stamp: 'SebastianTleye 5/24/2013 17:04'!
isObsolete
	"Return true if the receiver is obsolete."
	^self instanceCount = 0! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'ClementBera 10/1/2013 11:04'!
compiledMethodAt: selector ifAbsent: aBlock
	"Answer the compiled method associated with the argument, selector (a Symbol), a message selector in the receiver's method dictionary. If the selector is not in the dictionary, return the value of aBlock"

	^ self methodDict at: selector ifAbsent: aBlock! !

!TBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 5/24/2013 17:42'!
allSuperclassesIncluding: aClass
	"Answer an OrderedCollection of the receiver's and the receiver's  ancestor's superclasses
	up to aClass included. If aClass is not part of the receiver's superclass, returns up to the root."
	| temp |
	self class == ProtoObject class ifTrue: [ ^ OrderedCollection new].
	^ self superclass == aClass
		ifTrue: [ OrderedCollection with: aClass]
		ifFalse: [temp := self superclass allSuperclassesIncluding: aClass.
			temp addFirst: self superclass.
			temp]! !

!TBehavior methodsFor: 'queries' stamp: 'SebastianTleye 5/24/2013 17:04'!
copiesFromSuperclass: method
	"Checks whether the receiver copied the argument,  method, from its superclasses"
	
	self allSuperclassesDo: [ :cls|
		(cls includesSelector: method selector)
			ifTrue: [ ^ (cls >> method selector) sourceCode  = method sourceCode]].
	^ false! !

!TBehavior methodsFor: 'testing method dictionary' stamp: 'MarcusDenker 9/4/2014 10:33'!
whichSelectorsReferTo: literal special: specialFlag byte: specialByte
	"Answer a set of selectors whose methods access the argument as a literal."

	| who |
	who := IdentitySet new.
	self selectorsAndMethodsDo: 
		[:sel :method |
		((method hasLiteral: literal) or: [specialFlag and: [method scanFor: specialByte]])
			ifTrue:
				[((literal isVariableBinding) not
					or: [method literals allButLast identityIncludes: literal])
						ifTrue: [who add: sel]]].
	^ who! !

!TBehavior methodsFor: 'initialization' stamp: 'MarcusDenker 3/10/2015 12:55'!
initializeSlots: anObject 
	self layout initializeInstance: anObject! !

!TBehavior methodsFor: 'initialization' stamp: 'SebastianTleye 7/9/2013 17:52'!
emptyMethodDictionary

	^ MethodDictionary new! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 5/24/2013 17:49'!
supermostPrecodeCommentFor: selector 
	"Answer a string representing the precode comment in the most distant 
	superclass's implementation of the selector. Return nil if none found."
	| aSuper superComment |
	(self == Behavior
			or: [self superclass == nil
					or: [(aSuper := self superclass whichClassIncludesSelector: selector) == nil]])
		ifFalse: ["There is a super implementor"
			superComment := aSuper supermostPrecodeCommentFor: selector].
	^ superComment
		ifNil: [self firstPrecodeCommentFor: selector
			"ActorState supermostPrecodeCommentFor: #printOn:"]! !

!TBehavior methodsFor: 'user interface' stamp: 'SebastianTleye 5/24/2013 17:04'!
withAllSubAndSuperclassesDo: aBlock

	self withAllSubclassesDo: aBlock.
	self allSuperclassesDo: aBlock.
! !

!TBehavior methodsFor: 'queries' stamp: 'SebastianTleye 5/24/2013 17:04'!
copiedFromSuperclass: method
	"Returns the methods that the receiver copied with its ancestors"
	
	self allSuperclassesDo: [ :cls|
		(cls includesSelector: method selector)
			ifTrue: [ 
				((cls >> method selector) sourceCode  = method sourceCode)
					ifTrue: [ ^ {cls >> method selector}]
					ifFalse: [ ^ #()]]].
	^ #().
	! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'MarcusDenker 11/3/2013 11:37'!
localSelectors: aSet 
	self basicLocalSelectors: aSet! !

!TBehavior methodsFor: 'initialization' stamp: 'SebastianTleye 7/4/2013 11:27'!
initialize
	"moved here from the class side's #new"
	super initialize.
	self superclass: Object.
	"no longer sending any messages, some of them crash the VM"
	self methodDict: self emptyMethodDictionary.
	self setFormat: Object format.
	self traitComposition: nil.
	self users: IdentitySet new.! !

!TBehavior methodsFor: 'queries' stamp: 'TommasoDalSasso 10/6/2013 01:36'!
whichSelectorsRead: aString
	
	| index |
	index := self
		instVarIndexFor: aString
		ifAbsent: [ ^ IdentitySet new ].
	^ self selectors select: [ :each |
		(self compiledMethodAt: each)
			readsField: index ]! !

!TBehavior methodsFor: 'system startup' stamp: 'SebastianTleye 5/24/2013 17:04'!
startUp
	"This message is sent to registered classes when the system is coming up."
 ! !

!TBehavior methodsFor: '*OpalCompiler-Core' stamp: 'SebastianTleye 7/9/2013 17:52'!
evaluate: aString
	^self compiler evaluate: aString! !

!TBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/16/2013 17:04'!
instSize
	^self explicitRequirement.! !

!TBehavior methodsFor: 'testing' stamp: 'SebastianTleye 5/24/2013 17:04'!
isPointers
	"Answer whether the receiver contains just pointers (not bits)."

	^self isBits not! !

!TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'!
setTraitComposition: aTraitComposition
	| oldComposition |
	(self hasTraitComposition not and: [aTraitComposition isEmpty]) ifTrue: [^self].
	aTraitComposition assertValidUser: self.

	oldComposition := self traitComposition.
	self traitComposition: aTraitComposition.
	self applyChangesOfNewTraitCompositionReplacing: oldComposition.
	
	oldComposition traits do: [:each | each removeUser: self].
	aTraitComposition traits do: [:each | each addUser: self]! !

!TBehavior methodsFor: '*ast-core' stamp: 'SebastianTleye 7/9/2013 11:05'!
parseTreeFor: aSymbol	
	^ RBParser parseMethod: (self sourceCodeAt: aSymbol) onError: [ :msg :pos | ^ nil ]! !

!TBehavior methodsFor: 'private' stamp: 'maxmattone 3/5/2015 15:09'!
becomeCompactSimplyAt: index
	"The same as #becomeCompact but without updating my instances."

	| compactClassesArray |

	self isWeak 
		ifTrue: [^ self error: 'You must not make a weak class compact'].
	compactClassesArray := Smalltalk compactClassesArray.
	(self isCompact or: [compactClassesArray includes: self])
		ifTrue: [^ self error: self name, 'is already compact'].		
	(compactClassesArray at: index) ifNotNil: [^ self error: 'compact table slot already in use'].
	"Install this class in the compact class table"
	compactClassesArray at: index put: self.

	"Update instspec so instances will be compact. 
	The layout has the responsibility for setting the format."
	self layout compactClassIndex: index.! !

!TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:52'!
addSelector: selector withMethod: compiledMethod notifying: requestor
	^ self addSelectorSilently: selector withMethod: compiledMethod! !

!TBehavior methodsFor: '*System-Support' stamp: 'SebastianTleye 7/9/2013 11:07'!
referencedClasses
	"Return the set of classes that are directly referenced by my methods"

	| answer |
	answer := Set new.
	self methods do: [ :cm |
		answer addAll: 
			( cm literals select: [ :l | l isKindOf: Association ] thenCollect: #value ) ].
		
	^ answer! !

!TBehavior methodsFor: 'accessing-properties' stamp: 'YuriyTymchuk 10/7/2014 19:21'!
properties
	^ self explicitRequirement
		! !

!TBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 5/24/2013 17:42'!
allSuperclasses
	"Answer an OrderedCollection of the receiver's and the receiver's  
	ancestor's superclasses. The first element is the receiver's immediate  
	superclass, followed by its superclass; the last element is Object."
	| temp |
	^ self superclass == nil
		ifTrue: [ OrderedCollection new]
		ifFalse: [temp := self superclass allSuperclasses.
			temp addFirst: self superclass.
			temp]! !

!TBehavior methodsFor: '*OpalCompiler-Core' stamp: 'MarcusDenker 8/10/2014 09:39'!
sourceCodeTemplate
	"Answer an expression to be edited and evaluated in order to define 
	methods in this class or trait."

	^ 'messageSelectorAndArgumentNames
	"comment stating purpose of message"

	| temporary variable names |
	statements'! !

!TBehavior methodsFor: '*OpalCompiler-Core' stamp: 'SebastianTleye 7/9/2013 17:52'!
recompileChanges
	"Compile all the methods that are in the changes file.
	This validates sourceCode and variable references and forces
	methods to use the current bytecode set"

	self selectorsAndMethodsDo:
		[:sel :meth | meth fileIndex > 1 ifTrue:
			[self recompile: sel from: self]]! !

!TBehavior methodsFor: 'testing' stamp: 'SebastianTleye 5/24/2013 17:04'!
isBits
	"Answer whether the receiver contains just bits (not pointers)."

	^ self instSpec >= 6! !

!TBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 5/24/2013 17:04'!
instanceCount
	"Answer the number of instances of the receiver that are currently in 
	use."

	| count |
	count := 0.
	self allInstancesDo: [:x | count := count + 1].
	^count! !

!TBehavior methodsFor: 'queries' stamp: 'ClementBera 7/30/2013 11:08'!
whichSuperclassSatisfies: aBlock 
	(aBlock value: self) ifTrue: [^self].
	^self superclass ifNotNil: [self superclass whichSuperclassSatisfies: aBlock]! !

!TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'!
removeFromComposition: aTrait
	self setTraitComposition: (self traitComposition copyTraitExpression
		removeFromComposition: aTrait)! !

!TBehavior methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/24/2015 14:46'!
spotterSuperclassesFor: aStep
	<spotterOrder: 40>
	aStep listProcessor
			title: 'All superclasses';
			allCandidates: [ self allSuperclasses ];
			itemIcon: #systemIcon;
			filter: GTFilterSubstring! !

!TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'!
purgeLocalSelectors
	self basicLocalSelectors: nil! !

!TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'!
isDisabledSelector: selector
	^ self classAndMethodFor: selector do: [:c :m | m isDisabled] ifAbsent: [false]! !

!TBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 5/24/2013 17:04'!
allSubclassesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the receiver's subclasses."

	self subclassesDo: 
		[:cl | 
		aBlock value: cl.
		cl allSubclassesDo: aBlock]! !

!TBehavior methodsFor: 'accessing' stamp: 'SebastianTleye 5/24/2013 17:04'!
numberOfInstanceVariables
	^ self instVarNames size
! !

!TBehavior methodsFor: '*Ring-Core-Kernel' stamp: 'MarcusDenker 12/2/2013 14:44'!
methodsInProtocol: aString

	^ (self organization listAtCategoryNamed: aString) 
			collect: [ :each | (self compiledMethodAt: each) ]! !

!TBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 5/24/2013 17:04'!
allSubInstancesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the current instances of the 
	receiver and all its subclasses."

	self allInstancesDo: aBlock.
	self allSubclassesDo: [:sub | sub allInstancesDo: aBlock]! !

!TBehavior methodsFor: 'queries' stamp: 'MarcusDenker 7/14/2014 12:32'!
methodsAccessingSlot: aSlot
	^self methods select: [ :method | method accessesSlot: aSlot ]! !

!TBehavior methodsFor: 'queries' stamp: 'SebastianTleye 5/24/2013 17:04'!
whichClassDefinesClassVar: aString 
	Symbol hasInterned: aString ifTrue: [ :aSymbol |
		^self whichSuperclassSatisfies: 
			[:aClass | 
			aClass classVarNames anySatisfy: [:each | each = aSymbol]]].
	^#()! !

!TBehavior methodsFor: 'testing' stamp: 'ST 6/21/2013 12:49'!
isAnonymous
	^true! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'!
changeRecordsAt: selector
	"Return a list of ChangeRecords for all versions of the method at selector. Source code can be retrieved by sending string to any one.  Return nil if the method is absent."

	"(Pen changeRecordsAt: #go:) collect: [:cRec | cRec string]"
	^ChangeSet 
		scanVersionsOf: (self compiledMethodAt: selector ifAbsent: [^ nil])
		class: self meta: self isMeta
		category: (self whichCategoryIncludesSelector: selector)
		selector: selector.! !

!TBehavior methodsFor: 'instance creation' stamp: 'SebastianTleye 7/17/2013 10:08'!
basicNew
	^self explicitRequirement.
! !

!TBehavior methodsFor: '*OpalCompiler-Core' stamp: 'MarcusDenker 11/3/2013 11:37'!
compileAllFrom: oldClass
	"Compile all the methods in the receiver's method dictionary.
	This validates sourceCode and variable references and forces
	all methods to use the current bytecode set"
	
	oldClass localSelectors do: [:sel | self recompile: sel from: oldClass].
	! !

!TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/3/2013 22:31'!
hasTraitComposition

	^ self traitComposition notEmpty.! !

!TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:52'!
removeSelectorSilently: selector 
	"Remove selector without sending system change notifications"

	^ SystemAnnouncer uniqueInstance suspendAllWhile: [self removeSelector: selector].! !

!TBehavior methodsFor: 'system startup' stamp: 'SebastianTleye 5/24/2013 17:04'!
shutDown
	"This message is sent on system shutdown to registered classes"
! !

!TBehavior methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/24/2015 14:47'!
spotterUsedTraitsFor: aStep
	<spotterOrder: 60>
	aStep listProcessor
			title: 'Uses Traits';
			allCandidates: [ self traits asArray ];
			itemIcon: #systemIcon;
			filter: GTFilterSubstring! !

!TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 5/24/2013 17:04'!
adoptInstance: anInstance
	"Change the class of anInstance to me.
	Primitive (found in Cog and new VMs)  follows the same rules as primitiveChangeClassTo:, but returns the 	class rather than the modified instance"
	<primitive: 160 error: ec>
	anInstance primitiveChangeClassTo: self basicNew.
	^self! !

!TBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 5/24/2013 17:04'!
allSubInstances 
	"Answer a list of all current instances of the receiver and all of its subclasses."
	| aCollection |
	aCollection := OrderedCollection new.
	self allSubInstancesDo:
		[:x | x == aCollection ifFalse: [aCollection add: x]].
	^ aCollection! !

!TBehavior methodsFor: 'printing' stamp: 'SebastianTleye 5/24/2013 17:04'!
printHierarchy
	"Answer a description containing the names and instance variable names 
	of all of the subclasses and superclasses of the receiver."

	| aStream index |
	index := 0.
	aStream := (String new: 16) writeStream.
	self allSuperclasses reverseDo: 
		[:aClass | 
		aStream crtab: index.
		index := index + 1.
		aStream nextPutAll: aClass name.
		aStream space.
		aStream print: aClass instVarNames].
	aStream cr.
	self printSubclassesOn: aStream level: index.
	^aStream contents! !

!TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'!
hasMethods
	"Answer whether the receiver has any methods in its method dictionary."

	^ self methodDict notEmpty! !

!TBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 5/24/2013 17:42'!
allSuperclassesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the receiver's superclasses."

	self superclass == nil
		ifFalse: [aBlock value: self superclass.
				self superclass allSuperclassesDo: aBlock]! !

!TBehavior methodsFor: 'accessing-properties' stamp: 'MarcusDenker 3/2/2015 18:21'!
propertyValueAt: propName put: propValue
	^ self ensureProperties
		at: propName
		ifAbsentPut: propValue
		! !

!TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'!
includesSelector: aSymbol 
	"Answer whether the message whose selector is the argument is in the 
	method dictionary of the receiver's class."

	^ self methodDict includesKey: aSymbol! !

!TBehavior methodsFor: 'traits' stamp: 'MarcusDenker 10/9/2014 15:32'!
addTraitSelector: aSymbol withMethod: aCompiledMethod
	"Add aMethod with selector aSymbol to my
	methodDict. aMethod must not be defined locally."

	| source method |
	[(self includesLocalSelector: aSymbol) not] assert.
	self ensureLocalSelectors.
		
	source := aCompiledMethod getSourceReplacingSelectorWith: aSymbol.
	method  := aCompiledMethod copy.
	method selector: aSymbol.
	method methodClass: self.
		
	method putSource: source inFile: 2
		withPreamble: [:f | f cr; nextPut: $!!; nextChunkPut: 'Trait method'; cr].
	
	self isTrait ifFalse: [ method properties at: #traitSource put: aCompiledMethod].
	
	self basicAddSelector: aSymbol withMethod: method! !

!TBehavior methodsFor: '*OpalCompiler-Core' stamp: 'SebastianTleye 7/9/2013 17:52'!
compileAll
	^ self compileAllFrom: self! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'!
deregisterLocalSelector: aSymbol
	self basicLocalSelectors notNil ifTrue: [
		self basicLocalSelectors remove: aSymbol ifAbsent: []]! !

!TBehavior methodsFor: '*System-Support' stamp: 'SebastianTleye 7/9/2013 11:07'!
allUnsentMessages
	"Answer an array of all the messages defined by the receiver that are not sent anywhere in the system."

	^ SystemNavigation new allUnsentMessagesIn: self selectors! !

!TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 18:00'!
traitComposition
	^self explicitRequirement.! !

!TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 5/24/2013 17:04'!
canPerform: selector
	"Answer whether the receiver can safely perform to the message whose selector 
	is the argument: it is not an abstract or cancelled method"

	^ self classAndMethodFor: selector do: [:c :m | m isProvided] ifAbsent: [false].! !

!TBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 5/24/2013 17:04'!
allInstancesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the current instances of the 
	receiver.
	
	Because aBlock might change the class of inst (for example, using become:),
	it is essential to compute next before aBlock value: inst."
	| inst next |
	inst := self someInstance.
	[inst == nil]
		whileFalse:
		[
		next := inst nextInstance.
		aBlock value: inst.
		inst := next]! !

!TBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 5/24/2013 17:42'!
allInstVarNames
	"Answer an Array of the names of the receiver's instance variables. The 
	Array ordering is the order in which the variables are stored and 
	accessed by the interpreter."

	| vars |
	self superclass == nil
		ifTrue: [vars := self instVarNames copy]	"Guarantee a copy is answered."
		ifFalse: [vars := self superclass allInstVarNames , self instVarNames].
	^vars! !

!TBehavior methodsFor: 'accessing-properties' stamp: 'YuriyTymchuk 10/7/2014 19:31'!
propertyValueAt: propName
	^ self
		propertyValueAt: propName
		ifAbsent: [ nil ]
		! !

!TBehavior methodsFor: 'private' stamp: 'SebastianTleye 7/4/2013 11:22'!
setFormat: aFormatInstanceDescription
	^self explicitRequirement.! !

!TBehavior methodsFor: 'dependencies' stamp: 'AlexandreBergel 1/21/2014 15:01'!
dependentClasses
	"Return the list of classes used myself"
	
	"Morph dependentClasses"
	| cll | 
	cll := Set new.
	"A class depends on its superclass"
	self superclass ifNotNil: [ cll add: self superclass ].
	
	"We unify a class and its metaclass"
	(self methods, self class methods) 
		do: [ :m | m literalsDo: [ :l | 
					"We also check if the method is not an extension"
					((((l isVariableBinding 
					and: [ l value notNil ]) 
					and: [ l value isBehavior ])
					and: [ m category notEmpty ] )
					and: [ m category first ~= $* ])  ifTrue: [ cll add: l value ] ]  ].
	^ cll asArray! !

!TBehavior methodsFor: 'queries' stamp: 'SebastianTleye 5/24/2013 17:04'!
copiesMethodsFromSuperclass
	"Checks whether the receiver copied some method from its superclass"

	self methodsDo: [ :method|
		(self copiesFromSuperclass: method)
			ifTrue: [ ^ true ]].
	^ false! !

!TBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 5/24/2013 17:42'!
allSharedPools
	"Answer an ordered collection of the shared pools that the receiver and the receiver's ancestors share."

	^self superclass allSharedPools! !

!TBehavior methodsFor: 'traits' stamp: 'NicolaiHess 11/27/2014 23:09'!
traitUsers
	^self explicitRequirement.! !

!TBehavior methodsFor: 'printing' stamp: 'ClementBera 7/30/2013 11:08'!
literalScannedAs: scannedLiteral notifying: requestor
	"Postprocesses a literal scanned by Scanner scanToken (esp. xLitQuote).
	If scannedLiteral is not an association, answer it.
	Else, if it is of the form:
		nil->#NameOfMetaclass
	answer nil->theMetaclass, if any has that name, else report an error.
	Else, if it is of the form:
		#NameOfGlobalVariable->anythiEng
	answer the global, class, or pool association with that nameE, if any, else
	add it to Undeclared a answer the new Association."

	| key value |
	(scannedLiteral isVariableBinding)
		ifFalse: [^ scannedLiteral].
	key := scannedLiteral key.
	value := scannedLiteral value.
	key ifNil: "###<metaclass soleInstance name>"
			[(self bindingOf: value) ifNotNil:[:assoc|
				 (assoc value isKindOf: Behavior)
					ifTrue: [^ nil->assoc value class]].
			 requestor notify: 'No such metaclass'.
			 ^false].
	(key isSymbol)
		ifTrue: "##<global var name>"
			[(self bindingOf: key) ifNotNil:[:assoc | ^assoc].
			Undeclared at: key put: nil.
			 ^Undeclared bindingOf: key].
	requestor notify: '## must be followed by a non-local variable name'.
	^false

"	Form literalScannedAs: 14 notifying: nil 14
	Form literalScannedAs: #OneBitForm notiEfying: nil  OneBitForm
	Form literalScannedAs: ##OneBitForm notifying: nil  OneBitForm->a Form
	Form literalScannedAs: ##Form notifying: nil   Form->Form
	Form literalScannedAs: ###Form notifying: nil   nilE->Form class
"! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'!
compress
	"Compact the method dictionary of the receiver."

	self methodDict rehash! !

!TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/4/2013 11:02'!
users
	^self explicitRequirement.! !

!TBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/4/2013 11:18'!
superclass
	^self explicitRequirement.! !

!TBehavior methodsFor: 'traits' stamp: 'VincentBlondeau 3/6/2015 16:39'!
classesComposedWithMe
	self isTrait
		ifTrue: [ ^ self traitUsers gather: [ :u | u classesComposedWithMe ] ]
		ifFalse: [ ^ {self} ]! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 5/24/2013 17:04'!
commentsIn: sourceString

	
	| commentStart nextQuotePos someComments aPos |
	('*"*' match: sourceString) ifFalse: [^#()].
	someComments:= OrderedCollection new.
	sourceString size = 0 ifTrue: [^ someComments].
	aPos:=1.
	nextQuotePos:= 0.
	[commentStart := sourceString findString: '"' startingAt: aPos.
	nextQuotePos:= self nextQuotePosIn: sourceString startingFrom: commentStart.
	(commentStart ~= 0 and: [nextQuotePos >commentStart])] whileTrue: [
		commentStart ~= nextQuotePos ifTrue: [
			someComments add: ((sourceString copyFrom: commentStart + 1 to: nextQuotePos - 1) copyReplaceAll: '""' with: '"').].
	aPos := nextQuotePos+1].
	^someComments! !

!TBehavior methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/24/2015 14:46'!
spotterSubclassesFor: aStep
	<spotterOrder: 50>
	aStep listProcessor
			title: 'All subclasses';
			allCandidates: [ self allSubclasses ];
			itemIcon: #systemIcon;
			filter: GTFilterSubstring! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 5/24/2013 17:04'!
allSelectors
	"Answer all selectors understood by instances of the receiver"

	^ self allSelectorsBelow: nil! !

!TBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 5/24/2013 17:04'!
subclassInstVarNames
	"Answer a Set of the names of the receiver's subclasses' instance 
	variables."
	| vars |
	vars := Set new.
	self allSubclasses do: [:aSubclass | vars addAll: aSubclass instVarNames].
	^vars! !

!TBehavior methodsFor: '*System-Support' stamp: 'SebastianTleye 7/9/2013 11:06'!
allCallsOn
	"Answer a SortedCollection of all the methods that refer to me by name or as part of an association in a global dict."
	
	^ (self allCallsOnIn: self systemNavigation)! !

!TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 18:00'!
traitComposition: aTraitComposition
	^self explicitRequirement.! !

!TBehavior methodsFor: 'traits' stamp: 'VincentBlondeau 3/6/2015 16:39'!
addUser: aClassOrTrait
	self traitUsers add: aClassOrTrait.! !

!TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 5/24/2013 17:04'!
classBindingOf: varName
	"Answer the binding of some variable resolved in the scope of the receiver's class"
	^self bindingOf: varName! !

!TBehavior methodsFor: 'queries' stamp: 'MarcusDenker 7/14/2014 13:57'!
methodsWritingSlot: aSlot
	^self methods select: [ :method | method writesSlot: aSlot ]! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 5/24/2013 17:50'!
zapAllMethods
	"Remove all methods in this class which is assumed to be obsolete"

	self methodDict: self emptyMethodDictionary.
	self class isMeta ifTrue: [self class zapAllMethods]! !

!TBehavior methodsFor: 'printing' stamp: 'SebastianTleye 7/9/2013 17:52'!
longPrintOn: aStream
	"Append to the argument, aStream, the names and values of all of the receiver's instance variables.  But, not useful for a class with a method dictionary."

	aStream nextPutAll: '<<too complex to show>>'; cr.! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'!
methodsDo: aBlock
	"Evaluate aBlock for all the compiled methods in my method dictionary."

	^ self methodDict valuesDo: aBlock! !

!TBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 5/24/2013 17:04'!
allInstances
	"Answer a collection of all current instances of the receiver."

	| all inst next |
	all := OrderedCollection new.
	inst := self someInstance.
	[inst == nil]
		whileFalse: [
		next := inst nextInstance.
		inst == all ifFalse: [all add: inst].
		inst := next].
	^ all asArray! !

!TBehavior methodsFor: 'compiling' stamp: 'ST 6/18/2013 15:16'!
instVarNamesAndOffsetsDo: aBinaryBlock
	"This is part of the interface between the compiler and a class's instance or field names.
	 The class should enumerate aBinaryBlock with the instance variable name strings and
	 their integer offsets.  The order is important. Names evaluated later will override the
	 same names occurring earlier."

	"Nothing to do here; ClassDescription introduces named instance variables"
	^self! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 5/24/2013 17:04'!
commentsAt:  selector
	"Answer a string representing the first comment in the method associated with selector.  Return an empty string if the relevant source file is not available, or if the method's source code does not contain a comment.  Not smart enough to bypass quotes in string constants, but does map doubled quote into a single quote."


	^self commentsIn:  (self sourceCodeAt: selector) asString.
	
"Behavior commentsAt: #commentsAt:"! !

!TBehavior methodsFor: 'system startup' stamp: 'SebastianTleye 5/24/2013 17:04'!
startUp: resuming
	"This message is sent to registered classes when the system is coming up."
	^self startUp! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/17/2013 11:21'!
removeSelector: aSelector
	"Assuming that the argument, selector (a Symbol), is a message selector 
	in my method dictionary, remove it and its method.
	
	If the method to remove will be replaced by a method from my trait composition,
	the current method does not have to be removed because we mark it as non-local.
	If it is not identical to the actual method from the trait it will be replaced automatically
	by #noteChangedSelectors:.
	
	This is useful to avoid bootstrapping problems when moving methods to a trait
	(e.g., from TBehavior to TMethodDictionaryBehavior). Manual moving (implementing
	the method in the trait and then remove it from the class) does not work if the methods
	themselves are used for this process (such as compiledMethodAt:, includesLocalSelector: or
	addTraitSelector:withMethod:)"
	
	| changeFromLocalToTraitMethod |
	changeFromLocalToTraitMethod := (self includesLocalSelector: aSelector)
		and: [self hasTraitComposition
				and: [self traitComposition includesMethod: aSelector]].

	changeFromLocalToTraitMethod
		ifFalse: [self basicRemoveSelector: aSelector]
		ifTrue: [self ensureLocalSelectors].
	self deregisterLocalSelector: aSelector.
	self noteChangedSelectors: (Array with: aSelector).
	
	self isTrait ifTrue: [ self notifyUsersOfChangedSelector: aSelector].! !

!TBehavior methodsFor: 'initialization' stamp: 'SebastianTleye 7/9/2013 17:52'!
obsolete
	"Invalidate and recycle local methods,
	e.g., zap the method dictionary if can be done safely."
	self canZapMethodDictionary
		ifTrue: [self methodDict: self emptyMethodDictionary].
	self hasTraitComposition ifTrue: [
		self traitComposition traits do: [:each |
			each removeUser: self]]! !

!TBehavior methodsFor: '*OpalCompiler-Core' stamp: 'MarcusDenker 10/1/2013 14:15'!
recompile
	self compileAll! !

!TBehavior methodsFor: '*System-Support' stamp: 'SebastianTleye 7/9/2013 11:07'!
allCallsOnIn: aSystemNavigation
	"Answer a SortedCollection of all the methods that refer to me by name or as part of an association in a global dict."

	^ (aSystemNavigation 
		allReferencesTo: (self environment associationAt: self theNonMetaClass name)), 
		(aSystemNavigation allCallsOn: self theNonMetaClass name)	! !

!TBehavior methodsFor: 'accessing' stamp: 'SebastianTleye 5/24/2013 17:44'!
classDepth

	self superclass ifNil: [^ 1].
	^ self superclass classDepth + 1! !

!TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'!
isLocalAliasSelector: aSymbol
	"Return true if the selector aSymbol is an alias defined
	in my trait composition."

	^(self includesLocalSelector: aSymbol) not
		and: [self hasTraitComposition
				and: [self traitComposition isLocalAliasSelector: aSymbol]]! !

!TBehavior methodsFor: 'compiling' stamp: 'SebastianTleye 5/24/2013 17:04'!
variablesAndOffsetsDo: aBinaryBlock
	"This is the interface between the compiler and a class's instance or field names.  The
	 class should enumerate aBinaryBlock with the field definitions (with nil offsets) followed
	 by the instance variable name strings and their integer offsets (1-relative).  The order is
	 important; names evaluated later will override the same names occurring earlier."

	"Only need to do instance variables here.  CProtoObject introduces field definitions."
	self instVarNamesAndOffsetsDo: aBinaryBlock! !

!TBehavior methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 17:52'!
postCopy
	super postCopy.
	self methodDict: self copyOfMethodDictionary! !

!TBehavior methodsFor: 'testing' stamp: 'ClementBera 6/28/2013 11:07'!
sourceMatchesBytecodeAt: selector
	"Answers true if the source code at the selector compiles to the bytecode at the selector, and false
	otherwise. Implemented to detect an error where Monticello did not recompile sources when the class
	shape changed"

	"This code was copied from #recompile:from:, with few changes. Several methods would benefit from a
	method which turned a selector and class into a CompiledMethod, without  installing it into the 
	methodDictionary"

	| method newMethod |

	method := self compiledMethodAt: selector.
	newMethod := self compiler
			source: (self sourceCodeAt: selector);
			class: self;
			failBlock: [^ false];
			compiledMethodTrailer: method trailer;
			compile.   "Assume OK after proceed from SyntaxError"
	selector == newMethod selector ifFalse: [self error: 'selector changed!!!!'].
	^ newMethod = method! !

!TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/4/2013 11:07'!
users: aCollection
	^self explicitRequirement.! !

!TBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/4/2013 11:18'!
superclass: aClass
	^self explicitRequirement.! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'ClementBera 10/1/2013 10:32'!
compiledMethodAt: selector ifPresent: anotherBlock ifAbsent: aBlock
	"Answer the compiled method associated with the argument, selector (a Symbol), a message selector in the receiver's method dictionary. If the selector is not in the dictionary, return the value of aBlock"

	^ self methodDict at: selector ifPresent: anotherBlock ifAbsent: aBlock! !

!TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'!
traitTransformations 
	^ self traitComposition transformations ! !

!TBehavior methodsFor: '*GT-SpotterExtensions-Core' stamp: 'AndreiChis 3/23/2015 14:12'!
spotterInstanceVariablesFor: aStep
	<spotterOrder: 20>
	self isTrait ifTrue: [ ^ self ].
	aStep listProcessor
			title: 'Instance variables';
			allCandidates: [ self layout allSlots ];
			itemName: [:each | each name asString];
			filter: GTFilterSubstring! !

!TBehavior methodsFor: 'private' stamp: 'ClementBera 5/27/2014 13:49'!
checkCanBeUncompact 
	"Certain classes cannot be uncompacted in CogVM.  If you download VMMaker and see the VM code, these are as defined by StackInterpreter>>#checkAssumedCompactClasses and the ones that can't be uncompacted are the following: "
	({ Array. LargeNegativeInteger. LargePositiveInteger. Float. Context } includes: self)
		 ifTrue: [ self error: 'Class ', self name, ' cannot be uncompact. ' ]
! !

!TBehavior methodsFor: 'testing method dictionary' stamp: 'YuriyTymchuk 9/6/2014 12:20'!
canUnderstand: selector
	"Answer whether the receiver can respond to the message whose selector 
	is the argument."

	^ self
		classAndMethodFor: selector
		do: [ :c :m | true ]
		ifAbsent: [ false ].! !

!TBehavior methodsFor: 'obsolete subclasses' stamp: 'ST 6/21/2013 10:13'!
obsoleteSubclasses
	"Return all the weakly remembered obsolete subclasses of the receiver"
	| obs |
	obs := self basicObsoleteSubclasses at: self ifAbsent: [^ #()].
	^ obs copyWithout: nil! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'!
firstPrecodeCommentFor:  selector
	"If there is a comment in the source code at the given selector that preceeds the body of the method, return it here, else return nil"

	| method |
	"Behavior firstPrecodeCommentFor: #firstPrecodeCommentFor:"
	(#(Comment Definition Hierarchy) includes: selector)
		ifTrue: [^ nil].
	method := self compiledMethodAt: selector asSymbol ifAbsent: [^ nil].
	^method ast firstPrecodeComment.
	! !

!TBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 5/24/2013 17:50'!
withAllSuperclassesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the receiver's superclasses."
	aBlock value: self.
	self superclass == nil
		ifFalse: [self superclass withAllSuperclassesDo: aBlock]! !

!TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'!
flattenDown: aTrait
	| selectors |
	[self hasTraitComposition and: [self traitComposition allTraits includes: aTrait]] assert.
	selectors := (self traitComposition transformationOfTrait: aTrait) selectors.
	self basicLocalSelectors: self basicLocalSelectors , selectors.
	self removeFromComposition: aTrait.! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 5/24/2013 17:04'!
allSelectorsAbove

	^ self allSelectorsAboveUntil: ProtoObject 
	

! !

!TBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 5/24/2013 17:04'!
someInstance
	"Primitive. Answer the first instance in the enumeration of all instances 
	of the receiver. Fails if there are none. Essential. See Object 
	documentation whatIsAPrimitive."

	<primitive: 77>
	^nil! !

!TBehavior methodsFor: 'testing' stamp: 'SebastianTleye 5/24/2013 17:04'!
isCompact

	^self indexIfCompact ~= 0! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 5/24/2013 17:49'!
ultimateSourceCodeAt: selector ifAbsent: aBlock
	"Return the source code at selector, deferring to superclass if necessary"
	^ self sourceCodeAt: selector ifAbsent:
		[self superclass
			ifNil:
				[aBlock value]
			 ifNotNil:
				[self superclass ultimateSourceCodeAt: selector ifAbsent: aBlock]]! !

!TBehavior methodsFor: 'accessing-properties' stamp: 'MarcusDenker 3/2/2015 18:23'!
removeProperty: propName ifAbsent: aBlock
	| property |
	self properties ifNil: [^aBlock value].
	property := self properties
		removeKey: propName
		ifAbsent: aBlock.
	self removePropertiesIfEmpty.
	^ property! !

!TBehavior methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 17:52'!
deepCopy
	"Classes should only be shallowCopied or made anew."

	^ self shallowCopy! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'MarcusDenker 12/20/2013 10:32'!
methodDictionary: aDictionary
	self methodDict: aDictionary! !

!TBehavior methodsFor: 'testing' stamp: 'SebastianTleye 5/24/2013 17:04'!
isMeta
	^ false! !

!TBehavior methodsFor: 'accessing' stamp: 'SebastianTleye 5/24/2013 17:04'!
isComposedBy: aTrait
	"Answers if this object includes trait aTrait into its composition"
	aTrait isTrait ifFalse: [ ^false].
	^self hasTraitComposition 
		ifTrue: [ self traitComposition includesTrait: aTrait ]
		ifFalse: [ false ]! !

!TBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 5/24/2013 17:04'!
withAllSuperAndSubclassesDo: aBlock
	self allSuperclassesDo: aBlock.
	aBlock value: self.
	self allSubclassesDo: aBlock! !

!TBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:52'!
canZapMethodDictionary
	"Return true if it is safe to zap the method dictionary on #obsolete"
	^true! !

!TBehavior methodsFor: '*Tools' stamp: 'CamilloBruni 10/15/2013 17:02'!
browseHierarchy
	self systemNavigation browseHierarchy: self! !

!TBehavior methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/26/2015 21:06'!
spotterUsedSlotsFor: aStep
	<spotterOrder: 70>
	aStep listProcessor
			title: 'Special Slots';
			allCandidates: [ self slots select: [ :slot | slot isSpecial ] ];
			itemName: [ :item | item definitionString ];
			filter: GTFilterSubstring! !

!TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'!
flattenDownAllTraits
	self traitComposition allTraits do: [:each | self flattenDown: each].
	[ self traitComposition isEmpty ] assert.
	self traitComposition: nil.! !

!TBehavior methodsFor: '*Refactoring-Environment' stamp: 'CamilloBruni 8/22/2013 12:02'!
asEnvironment
	^ RBClassEnvironment class: self! !

!TBehavior methodsFor: 'instance creation' stamp: 'SebastianTleye 5/24/2013 17:04'!
new
	"Answer a new initialized instance of the receiver (which is a class) with no indexable variables. Fail if the class is indexable."

	^ self basicNew initialize
! !

!TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/17/2013 11:23'!
addSelectorSilently: selector withMethod: compiledMethod
	self methodDictAddSelectorSilently: selector withMethod: compiledMethod.
	self registerLocalSelector: selector.
	self isTrait ifTrue: [ self notifyUsersOfChangedSelector: selector].! !

!TBehavior methodsFor: 'accessing' stamp: 'MarcusDenker 10/10/2014 17:44'!
basicLocalSelectors
	^nil! !

!TBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 5/24/2013 17:04'!
selectSubclasses: aBlock 
	"Evaluate the argument, aBlock, with each of the receiver's (next level) 
	subclasses as its argument. Collect into a Set only those subclasses for 
	which aBlock evaluates to true. In addition, evaluate aBlock for the 
	subclasses of each of these successful subclasses and collect into the set 
	those for which aBlock evaluates true. Answer the resulting set."

	| aSet |
	aSet := Set new.
	self allSubclasses do: 
		[:aSubclass | 
		(aBlock value: aSubclass) ifTrue: [aSet add: aSubclass]].
	^aSet! !

!TBehavior methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/26/2015 17:26'!
spotterTraitUsersFor: aStep
	<spotterOrder: 20>
	self isTrait ifFalse: [ ^ self ].
	aStep listProcessor
			title: 'Users';
			allCandidates: [ self traitUsers asArray ];
			itemIcon: #systemIcon;
			filter: GTFilterSubstring! !

!TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'!
setTraitCompositionFrom: aTraitExpression
	^ self setTraitComposition: aTraitExpression asTraitComposition! !

!TBehavior methodsFor: 'instance creation' stamp: 'SebastianTleye 5/24/2013 17:04'!
new: sizeRequested 
	"Answer an initialized instance of this class with the number of indexable
	variables specified by the argument, sizeRequested."

	^ (self basicNew: sizeRequested) initialize  ! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'MarcusDenker 11/20/2013 16:39'!
allSelectorsWithout: behaviors
	"Returns all the selectors of the receiver and its superclasses, except the ones define in behaviors"

	| selectors |
	selectors := IdentitySet new.
	self withAllSuperclassesDo: [ :class | 
			(behaviors includes: class)
				ifFalse: [ selectors addAll: class selectors ] ].
	^ selectors! !

!TBehavior methodsFor: '*Fuel' stamp: 'SebastianTleye 7/17/2013 10:09'!
fuelNew: sizeRequested 
	"Answer an instance of mine in which serialized references will be injected."

	^ self basicNew: sizeRequested! !

!TBehavior methodsFor: 'obsolete subclasses' stamp: 'ST 6/21/2013 10:14'!
removeAllObsoleteSubclasses
	"Remove all the obsolete subclasses of the receiver"
	self basicObsoleteSubclasses removeKey: self ifAbsent: [].
! !

!TBehavior methodsFor: 'testing class hierarchy' stamp: 'SebastianTleye 7/5/2013 16:12'!
includesBehavior: aClass
	
	self isTrait ifTrue: [ ^false ].
	^self == aClass or:[self inheritsFrom: aClass]! !

!TBehavior methodsFor: 'accessing instances and variables' stamp: 'ST 6/13/2013 11:21'!
instVarNames
	"Answer an Array of the instance variable names. Behaviors must make 
	up fake local instance variable names because Behaviors have instance 
	variables for the purpose of compiling methods, but these are not named 
	instance variables."

	| mySize superSize |
	mySize := self instSize.
	superSize := 
		self superclass == nil
			ifTrue: [0]
			ifFalse: [self superclass instSize].
	mySize = superSize ifTrue: [^#()].	
	^(superSize + 1 to: mySize) collect: [:i | 'inst' , i printString]! !

!TBehavior methodsFor: 'adding/removing methods' stamp: ''!
basicAddSelector: selector withMethod: compiledMethod 
	"Add the message selector with the corresponding compiled method to the 
	receiver's method dictionary.
	Do this without sending system change notifications"

	| oldMethodOrNil |	
	oldMethodOrNil := self lookupSelector: selector.
	self methodDict at: selector put: compiledMethod.
	compiledMethod methodClass: self.
	compiledMethod selector: selector.

	"Now flush Pharo's method cache, either by selector or by method"
	oldMethodOrNil ifNotNil: [oldMethodOrNil flushCache].
	selector flushCache.! !

!TBehavior methodsFor: 'accessing-properties' stamp: 'YuriyTymchuk 10/7/2014 19:30'!
removeProperty: propName
	^ self
		removeProperty: propName
		ifAbsent: [ nil ]! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 5/24/2013 17:04'!
classAndMethodFor: aSymbol do: binaryBlock ifAbsent: absentBlock
	"Looks up the selector aSymbol in the class chain. If it is found, binaryBlock is evaluated
	with the class that defines the selector and the associated method. Otherwise
	absentBlock is evaluated."

	
	self withAllSuperclassesDo: [:class | | method |
		method := class compiledMethodAt: aSymbol ifAbsent: [nil].
		method ifNotNil: [^ binaryBlock value: class value: method].
	].
	^ absentBlock value.! !

!TBehavior methodsFor: 'accessing-properties' stamp: 'NicolaiHess 3/10/2015 16:44'!
ensureProperties
	^ self explicitRequirement! !

!TBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/9/2013 17:52'!
withAllSubclassesDo: aBlock
	"Evaluate the argument, aBlock, for the receiver and each of its 
	subclasses."
	self withAllSubclasses do: [ :subclass | aBlock value: subclass ].! !

!TBehavior methodsFor: '*OpalCompiler-Core' stamp: 'SebastianTleye 7/9/2013 17:52'!
compile: code 
	"Compile the argument, code, as source code in the context of the 
	receiver. Create an error notification if the code can not be compiled. 
	The argument is either a string or an object that converts to a string or a 
	PositionableStream on an object that converts to a string."

	^self compile: code notifying: nil! !

!TBehavior methodsFor: 'instance creation' stamp: 'SebastianTleye 7/17/2013 10:08'!
basicNew: sizeRequested 
	^self explicitRequirement.! !

!TBehavior methodsFor: 'queries' stamp: 'SebastianTleye 5/24/2013 17:04'!
whichSelectorsAssign: instVarName 
	"Answer a Set of selectors whose methods store into the argument, 
	instVarName, as a named instance variable."
	^self whichSelectorsStoreInto: instVarName! !

!TBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/9/2013 17:52'!
withAllSubclasses
	"Answer a Set of the receiver, the receiver's descendent's, and the  
	receiver's descendent's subclasses."

	^ self allSubclasses add: self;
		 yourself! !

!TBehavior methodsFor: 'testing class hierarchy' stamp: 'SebastianTleye 5/24/2013 17:04'!
kindOfSubclass
	"Answer a String that is the keyword that describes the receiver's kind 
	of subclass, either a regular subclass, a variableSubclass, a  
	variableByteSubclass, a variableWordSubclass, or a weakSubclass."
	self isWeak
		ifTrue: [^ ' weakSubclass: '].
	^ self isVariable
		ifTrue: [self isBits
				ifTrue: [self isBytes
						ifTrue: [ ' variableByteSubclass: ']
						ifFalse: [ ' variableWordSubclass: ']]
				ifFalse: [ ' variableSubclass: ']]
		ifFalse: [ ' subclass: ']! !

!TBehavior methodsFor: 'initialize-release' stamp: 'ST 5/31/2013 19:29'!
superclass: aClass methodDictionary: mDict format: fmt
	"Basic initialization of the receiver.
	Must only be sent to a new instance; else we would need Object flushCache."
	self superclass: aClass.
	self setFormat: fmt.
	self methodDict: mDict.
	self traitComposition: nil! !

!TBehavior methodsFor: 'queries' stamp: 'SebastianTleye 5/24/2013 17:04'!
copiedMethodsFromSuperclass
	"Returns the methods that the receiver copied with its ancestors"
	
	| methods |
	methods := OrderedCollection new.
	self methodsDo: [ :method|
		methods addAll:  (self copiedFromSuperclass: method)].
	^ methods! !

!TBehavior methodsFor: '*OpalCompiler-Core' stamp: 'MarcusDenker 9/5/2013 15:39'!
compile: code notifying: requestor 
	"Compile the argument, code, as source code in the context of the 
	receiver and insEtall the result in the receiver's method dictionary. The 
	second argument, requestor, is to be notified if an error occurs. The 
	argument code is either a string or an object that converts to a string or 
	a PositionableStream. This method also saves the source code."
	
	| method |
	method  := self compiler
		source: code;
		requestor: requestor;
		failBlock: [ ^nil ];
		compile.
		
	method putSource: code inFile: 2
			withPreamble: [:f | f cr; nextPut: $!!; nextChunkPut: 'Behavior method'; cr].
	self addSelector: method selector withMethod: method notifying: requestor.
	^ method selector! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'!
methods
	
	^ self methodDict values! !

!TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:52'!
addSelector: selector withMethod: compiledMethod 
	^ self addSelector: selector withMethod: compiledMethod notifying: nil! !

!TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:52'!
methodDictAddSelectorSilently: selector withMethod: compiledMethod
	self basicAddSelector: selector withMethod: compiledMethod! !

!TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'!
traitOrClassOfSelector: aSymbol
	"Return the trait or the class which originally defines the method aSymbol
	or return self if locally defined or if it is a conflict marker method.
	This is primarly used by Debugger to determin the behavior in which a recompiled
	method should be put. If a conflict method is recompiled it should be put into
	the class, thus return self. Also see TraitComposition>>traitProvidingSelector:"
	
	((self includesLocalSelector: aSymbol) or: [
		self hasTraitComposition not]) ifTrue: [^self].
	^(self traitComposition traitProvidingSelector: aSymbol) ifNil: [self]! !

!TBehavior methodsFor: '*System-Support' stamp: 'SebastianTleye 7/9/2013 11:07'!
allCallsOn: aSymbol
	"Answer a SortedCollection of all the methods that call on aSymbol."

	^ self  systemNavigation allCallsOn: aSymbol from: self .
	! !

!TBehavior methodsFor: 'accessing class hierarchy' stamp: 'ST 6/17/2013 14:14'!
allSubclassesWithLevelDo: classAndLevelBlock startingLevel: level 
	"Walk the tree of subclasses, giving the class and its level"
	| subclassNames |
	classAndLevelBlock value: self value: level.
	self == Class ifTrue:  [^ self].  "Don't visit all the metaclasses"
	"Visit subclasses in alphabetical order"
	subclassNames := SortedCollection new.
	self subclassesDo: [:subC | subclassNames add: subC name].
	subclassNames do:
		[:name | (self environment at: name)
			allSubclassesWithLevelDo: classAndLevelBlock
			startingLevel: level+1]! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 5/24/2013 17:04'!
allSelectorsAboveUntil: aRootClass

	| coll |
	coll := IdentitySet new.
	(self allSuperclassesIncluding: aRootClass) 
		do: [:aClass | 
				aClass selectorsDo: [ :sel | coll add: sel ]].
	^ coll
	

! !

!TBehavior methodsFor: 'accessing-properties' stamp: 'YuriyTymchuk 10/7/2014 19:24'!
removePropertiesIfEmpty
	^ self explicitRequirement! !

!TBehavior methodsFor: '*Ring-Core-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'!
protocols
	
	^ self organization categories copy! !

!TBehavior methodsFor: 'obsolete subclasses' stamp: 'SebastianTleye 5/24/2013 17:04'!
allLocalCallsOn: aSymbol
	"Answer a SortedCollection of all the methods that call on aSymbol, anywhere in my class hierarchy."

	^(SystemNavigation new allLocalCallsOn: aSymbol ofClass: (self theNonMetaClass)).
! !

!TBehavior methodsFor: 'system startup' stamp: 'SebastianTleye 5/24/2013 17:04'!
shutDown: quitting
	"This message is sent on system shutdown to registered classes"
	^self shutDown.! !

!TBehavior methodsFor: 'accessing' stamp: 'MaxLeske 9/28/2014 22:26'!
sharedPoolNames
	^ self sharedPools collect: [:ea |
		ea isObsolete
			ifTrue: [ ea name ]
			ifFalse: [ self environment keyAtIdentityValue: ea ] ]! !

!TBehavior methodsFor: 'private' stamp: 'SebastianTleye 5/24/2013 17:04'!
flushCache
	"Tell the interpreter to remove the contents of its method lookup cache, if it has 
	one.  Essential.  See Object documentation whatIsAPrimitive."

	<primitive: 89>
	self primitiveFailed! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'MarcusDenker 12/2/2013 14:43'!
sourceCodeAt: selector

	^ (self compiledMethodAt: selector) sourceCode.! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'!
registerLocalSelector: aSymbol
	self basicLocalSelectors notNil ifTrue: [
		self basicLocalSelectors add: aSymbol]! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'!
firstCommentAt:  selector
	"Answer a string representing the first comment in the method associated with selector.  Return an empty string if the relevant source file is not available, or if the method's source code does not contain a comment.  Not smart enough to bypass quotes in string constants, but does map doubled quote into a single quote."

	|someComments|
	someComments := self commentsAt: selector.
	^someComments isEmpty ifTrue: [''] ifFalse: [someComments first]


"Behavior firstCommentAt: #firstCommentAt:"! !

!TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'!
addToComposition: aTrait
	self setTraitComposition: (self traitComposition copyTraitExpression
		add: aTrait;
		yourself)! !

!TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'!
applyChangesOfNewTraitCompositionReplacing: oldComposition
	| changedSelectors |
	changedSelectors := self traitComposition
		changedSelectorsComparedTo: oldComposition.
	changedSelectors isEmpty ifFalse: [
		self noteChangedSelectors: changedSelectors].
	self traitComposition isEmpty ifTrue: [
		self purgeLocalSelectors].
	^changedSelectors! !

!TBehavior methodsFor: '*Ring-Core-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'!
methodNamed: aSelector

	^ self methodDict at: aSelector! !

!TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'!
traitsProvidingSelector: aSymbol
	| result |
	result := OrderedCollection new.
	self hasTraitComposition ifFalse: [^result].
	(self traitComposition methodDescriptionsForSelector: aSymbol)
		do: [:methodDescription | methodDescription selector = aSymbol ifTrue: [
			result addAll: (methodDescription locatedMethods
				collect: [:each | each methodClass])]].
	^result! !

!TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'!
addExclusionOf: aSymbol to: aTrait
	self setTraitComposition: (
		self traitComposition copyWithExclusionOf: aSymbol to: aTrait)! !

!TBehavior methodsFor: '*OpalCompiler-Core' stamp: 'SebastianTleye 7/9/2013 17:52'!
compilerClass
	"Answer a compiler class appropriate for source methods of this class."

	^Smalltalk compilerClass! !

!TBehavior methodsFor: 'cleanup' stamp: 'SebastianTleye 5/24/2013 17:04'!
cleanUp: aggressive
	"Clean out any caches and other state that should be flushed when trying to get an image into a pristine state. The argument should be used to indicate how aggressive the cleanup should be. Some subclasses may act differently depending on its value - for example, ChangeSet will only delete all unused and reinitialize the current change set if we're asking it to be aggressive."

	^self cleanUp! !

!TBehavior methodsFor: 'testing' stamp: 'SebastianTleye 5/24/2013 17:04'!
isFixed
	"Answer whether the receiver does not have a variable (indexable) part."

	^self isVariable not! !

!TBehavior methodsFor: 'printing' stamp: 'SebastianTleye 5/24/2013 17:53'!
printOn: aStream 
	"Refer to the comment in Object|printOn:." 

	aStream nextPutAll: 'a descendent of '.
	self superclass printOn: aStream! !

!TBehavior methodsFor: 'traits' stamp: 'VincentBlondeau 3/6/2015 16:39'!
removeUser: aClassOrTrait
	self traitUsers remove: aClassOrTrait ifAbsent: []! !

!TBehavior methodsFor: '*Manifest-Core' stamp: 'ChristopheDemarey 11/20/2014 11:22'!
isManifest
	(self name beginsWith: 'Manifest')
		ifTrue: [ self deprecated: 'Package Manifest should now inherit from PackageManifest class' ].
	^ false! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'!
selectorsAndMethodsDo: selectorAndMethodBlock
	"Evaluate selectorAndMethodBlock with two arguments for each selector/method pair in my method dictionary."

	^ self methodDict keysAndValuesDo: selectorAndMethodBlock! !

!TBehavior methodsFor: 'testing' stamp: 'SebastianTleye 5/24/2013 17:04'!
isWeak
	"Answer whether the receiver has contains weak references."
	^ self instSpec = 4! !

!TBehavior methodsFor: 'enumerating' stamp: 'ST 6/14/2013 15:50'!
subclassesDo: aBlock
	"Evaluate the argument, aBlock, for each of the receiver's immediate subclasses."
	self subclasses do: aBlock! !

!TBehavior methodsFor: 'traits' stamp: 'ClementBera 7/30/2013 11:08'!
ensureLocalSelectors
	"Ensures that the instance variable localSelectors is effectively used to maintain
	the set of local selectors.
	This method must be called before any non-local selectors are added to the
	method dictionary!!"

	self basicLocalSelectors ifNil: [self basicLocalSelectors: self selectors asSet]! !

!TBehavior methodsFor: '*GT-SpotterExtensions-Core' stamp: 'AndreiChis 3/23/2015 14:12'!
spotterClassInstanceVariablesFor: aStep
	<spotterOrder: 25>
	self isTrait ifTrue: [ ^ self ].
	aStep listProcessor
			title: 'Class instance variables';
			allCandidates: [ self class layout allSlots ];
			itemName: [:each | each name asString];
			filter: GTFilterSubstring! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'MarcusDenker 10/25/2013 10:37'!
localSelectors
	"Return a set of selectors defined locally.
	The instance variable is lazily initialized. If it is nil then there
	are no non-local selectors"

	^ self basicLocalSelectors 
		ifNil: [self selectors asSet]
		ifNotNil: [self basicLocalSelectors].! !

!TBehavior methodsFor: 'printing' stamp: 'SebastianTleye 7/9/2013 17:52'!
storeLiteral: aCodeLiteral on: aStream
	"Store aCodeLiteral on aStream, changing an Association to ##GlobalName
	 or ###MetaclassSoleInstanceName format if appropriate"
	| key value |
	(aCodeLiteral isVariableBinding)
		ifFalse:
			[aCodeLiteral storeOn: aStream.
			 ^self].
	key := aCodeLiteral key.
	(key isNil and: [(value := aCodeLiteral value) isMemberOf: Metaclass])
		ifTrue:
			[aStream nextPutAll: '###'; nextPutAll: value soleInstance name.
			 ^self].
	(key isSymbol and: [(self bindingOf: key) notNil])
		ifTrue:
			[aStream nextPutAll: '##'; nextPutAll: key.
			 ^self].
	aCodeLiteral storeOn: aStream! !

!TBehavior methodsFor: 'accessing' stamp: 'SebastianTleye 7/9/2013 11:06'!
realClass

	^ self! !

!TBehavior methodsFor: '*OpalCompiler-Core' stamp: 'SebastianTleye 7/9/2013 17:52'!
recompile: selector
	"Compile the method associated with selector in the receiver's method dictionary."
	^self recompile: selector from: self! !

!TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'!
thoroughWhichSelectorsReferTo: literal special: specialFlag byte: specialByte
	"Answer a set of selectors whose methods access the argument as a 
	literal. Dives into the compact literal notation, making it slow but 
	thorough "
	| selectors |
	selectors := IdentitySet new.
	self selectorsAndMethodsDo: 
		[ :sel :method |
			((self isTrait ifTrue: [method hasLiteralThorough: literal]
				     		 ifFalse: [method refersToLiteral: literal]) or: [specialFlag and: [method scanFor: specialByte]]) ifTrue: [selectors add: sel]].
	^ selectors! !

!TBehavior methodsFor: '*Fuel' stamp: 'SebastianTleye 7/16/2013 17:02'!
fuelIgnoredInstanceVariableNames
	"Indicates which variables have to be ignored during serialization."

	^#()! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 5/24/2013 17:04'!
allSelectorsBelow: topClass 
	| coll |
	coll := IdentitySet new.
	self withAllSuperclassesDo: 
			[:aClass | 
			aClass = topClass
				ifTrue: [^ coll ]
				ifFalse: [aClass selectorsDo: [ :sel | coll add: sel ]]].
	^ coll
	

! !

!TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:52'!
basicRemoveSelector: selector 
	"Assuming that the argument, selector (a Symbol), is a message selector 
	in my method dictionary, remove it and its method."

	| oldMethod |
	oldMethod := self methodDict at: selector ifAbsent: [^ self].
	self methodDict removeKey: selector.

	"Now flush the method cache"
	oldMethod flushCache.
	selector flushCache.! !

!TBehavior methodsFor: '*OpalCompiler-Core' stamp: 'SebastianTleye 7/9/2013 17:52'!
compiler
	"Answer a compiler appropriate for source methods of this class."

	^self compilerClass new
		environment: self environment;
		class: self! !

!TBehavior methodsFor: 'user interface' stamp: 'SebastianTleye 5/24/2013 17:04'!
unreferencedInstanceVariables
	"Return a list of the instance variables defined in the receiver which are not referenced in the receiver or any of its subclasses."

	^ self instVarNames reject: [:ivn | 
		self withAllSubclasses anySatisfy: [:class | 
			(class whichSelectorsAccess: ivn) notEmpty]]! !

!TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'!
isAliasSelector: aSymbol
	"Return true if the selector aSymbol is an alias defined
	in my or in another composition somewhere deeper in 
	the tree of traits compositions."

	^(self includesLocalSelector: aSymbol) not
		and: [self hasTraitComposition
				and: [self traitComposition isAliasSelector: aSymbol]]! !

!TBehavior methodsFor: 'testing class hierarchy' stamp: 'SebastianTleye 5/24/2013 17:54'!
inheritsFrom: aClass 
	"Answer whether the argument, aClass, is on the receiver's superclass 
	chain."

	| aSuperclass |
	aSuperclass := self superclass.
	[aSuperclass == nil]
		whileFalse: 
			[aSuperclass == aClass ifTrue: [^true].
			aSuperclass := aSuperclass superclass].
	^false! !

!TBehavior methodsFor: 'accessing' stamp: 'SebastianTleye 5/24/2013 17:04'!
typeOfClass
	"Answer a symbol uniquely describing the type of the receiver"
	self instSpec = CompiledMethod instSpec ifTrue:[^#compiledMethod]. "Very special!!"
	self isBytes ifTrue:[^#bytes].
	(self isWords and:[self isPointers not]) ifTrue:[^#words].
	self isWeak ifTrue:[^#weak].
	self isVariable ifTrue:[^#variable].
	^#normal.! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 5/24/2013 17:04'!
allMethods
	"Return the collection of compiled method I and my superclasses are defining"
	"asArray is used to not bump into a bug when comparing compiled methods."
	
	^ self allSelectors asArray collect: [ :s | self lookupSelector: s ]! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'MarcusDenker 12/2/2013 14:43'!
sourceCodeAt: selector ifAbsent: aBlock

	^ (self compiledMethodAt: selector ifAbsent: [^ aBlock value]) sourceCode.! !

!TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'!
removeAlias: aSymbol of: aTrait
	self setTraitComposition: (
		self traitComposition copyWithoutAlias: aSymbol of: aTrait)! !

!TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'!
traits
	"Returns a collection of all traits used by the receiver"
	^ self traitComposition traits! !

!TBehavior methodsFor: 'testing method dictionary' stamp: 'ClementBera 7/30/2013 11:08'!
includesLocalSelector: aSymbol
	^self basicLocalSelectors 
		ifNil: [self includesSelector: aSymbol]
		ifNotNil: [self localSelectors includes: aSymbol]! !

!TBehavior methodsFor: '*Tools' stamp: 'MarcusDenker 10/23/2014 14:22'!
browse

	^  Smalltalk tools browser fullOnClass: self! !

!TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'!
notifyUsersOfChangedSelector: aSelector
	self notifyUsersOfChangedSelectors: (Array with: aSelector)! !

!TBehavior methodsFor: 'testing' stamp: 'SebastianTleye 5/24/2013 17:04'!
isBytes
	"Answer whether the receiver has 8-bit instance variables."

	^ self instSpec >= 8! !

!TBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 5/24/2013 17:42'!
allClassVarNames
	"Answer a Set of the names of the receiver's and the receiver's ancestor's 
	class variables."

	^self superclass allClassVarNames! !

!TBehavior methodsFor: 'testing' stamp: 'SebastianTleye 5/24/2013 17:04'!
isVariable
	"Answer whether the receiver has indexable variables."

	^ self instSpec >= 2! !

!TBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/5/2013 17:17'!
bindingOf: varName
	^self explicitRequirement.! !

!TBehavior methodsFor: 'queries' stamp: 'SebastianTleye 5/24/2013 17:04'!
whichClassDefinesInstVar: aString 
	^self 
		whichSuperclassSatisfies: [:aClass | aClass instVarNames includes: aString]! !

!TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'!
traitCompositionString
	^self hasTraitComposition
		ifTrue: [self traitComposition asString]
		ifFalse: ['{}']! !

!TBehavior methodsFor: 'testing' stamp: 'SebastianTleye 5/24/2013 17:04'!
isWords
	"Answer true if the receiver is made of 32-bit instance variables."

	^self isBytes not! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 5/24/2013 17:04'!
nextQuotePosIn: sourceString startingFrom: commentStart
	| pos nextQuotePos |
	pos := commentStart + 1.
	[((nextQuotePos := sourceString findString: '"' startingAt: pos) == (sourceString findString: '""' startingAt: pos)) and: [nextQuotePos ~= 0]]
		whileTrue:
			[pos := nextQuotePos + 2].
	^nextQuotePos! !

!TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'!
whichSelectorsReferTo: literal 
	"Answer a Set of selectors whose methods access the argument as a
literal."

	| special byte |
	special := Smalltalk hasSpecialSelector: literal ifTrueSetByte: [:b |
byte := b].
	^self whichSelectorsReferTo: literal special: special byte: byte

	"Rectangle whichSelectorsReferTo: #+."! !

!TBehavior methodsFor: 'memory usage' stamp: 'SebastianTleye 5/24/2013 17:04'!
instancesSizeInMemory
	"Answers the number of bytes consumed by all its instances including their object header"
	
	| bytes |
	bytes := 0.
	self allInstancesDo: [:each | bytes := bytes + each sizeInMemory  ].
	^ bytes! !

!TBehavior methodsFor: '*Tools' stamp: 'SebastianTleye 7/9/2013 11:07'!
inspectSubInstances 
	"Inspect all instances of the receiver and all its subclasses.  CAUTION - don't do this for something as generic as Object!!"

	| all allSize prefix |
	all := self allSubInstances.
	(allSize := all size) isZero ifTrue: [^ self inform: 'There are no 
instances of ', self name, '
or any of its subclasses'].
	prefix := allSize = 1
		ifTrue: 	['The lone instance']
		ifFalse:	['The ', allSize printString, ' instances'].
	
	all asArray inspectWithLabel: (prefix, ' of ', self name, ' & its subclasses')! !

!TBehavior methodsFor: 'private' stamp: 'SebastianTleye 5/24/2013 17:53'!
indexIfCompact
	"If these 5 bits are non-zero, then instances of this class
	will be compact.  It is crucial that there be an entry in
	Smalltalk compactClassesArray for any class so optimized.
	See the msgs becomeCompact and becomeUncompact."
	^ (self format bitShift: -11) bitAnd: 16r1F


"
Array indexIfCompact

Verify if the compactClassesArray and indexIfCompact are coheren
Smalltalk compactClassesArray doWithIndex: 
	[:c :i | c == nil ifFalse:
		[c indexIfCompact = i ifFalse: [self halt]]]
"! !

!TBehavior methodsFor: 'cleanup' stamp: 'SebastianTleye 5/24/2013 17:04'!
cleanUp
	"Clean out any caches and other state that should be flushed when trying to get an image into a pristine state. Subclasses may override #cleanUp: to provide different levels of cleanliness"
! !

!TBehavior methodsFor: '*Tools' stamp: 'SebastianTleye 7/9/2013 11:07'!
inspectAllInstances 
	"Inspect all instances of the receiver."

	| all allSize prefix |
	all := self allInstances.
	(allSize := all size) isZero ifTrue: [^ self inform: 'There are no 
instances of ', self name].
	prefix := allSize = 1
		ifTrue: 	['The lone instance']
		ifFalse:	['The ', allSize printString, ' instances'].
	
	all asArray inspectWithLabel: (prefix, ' of ', self name)! !

!TBehavior methodsFor: 'accessing' stamp: 'SebastianTleye 7/9/2013 17:52'!
binding
	^ nil -> self! !

!TBehavior methodsFor: 'private' stamp: 'maxmattone 3/5/2015 15:07'!
becomeUncompact
	"The inverse of #becomeCompact. However, some classes can not be uncompact see #checkCanBeUncompact."

	| compactClassesArray index |
	compactClassesArray := Smalltalk compactClassesArray.
	(index := self indexIfCompact) = 0
		ifTrue: [^ self].
	self assert:[compactClassesArray includes: self].
	self checkCanBeUncompact.

	"Update instspec so instances will be compact. 
	The layout has the responsibility for setting the format."
	self layout compactClassIndex: 0.
	
	"Make up new instances and become old ones into them"
	self updateInstancesFrom: self.
	"Make sure there are no compact ones left around"
	Smalltalk garbageCollect.
	"Remove this class from the compact class table"
	compactClassesArray at: index put: nil.
! !

!TBehavior methodsFor: 'accessing' stamp: 'MarcusDenker 10/10/2014 17:46'!
allSlots
	^#()! !

!TBehavior methodsFor: 'obsolete subclasses' stamp: 'ST 6/21/2013 10:13'!
addObsoleteSubclass: aClass
	"Weakly remember that aClass was a subclass of the receiver and is now obsolete"
	| obs |

	obs := self basicObsoleteSubclasses at: self ifAbsent:[WeakArray new].
	(obs includes: aClass) ifTrue:[^self].
	obs := obs copyWithout: nil.
	obs := obs copyWith: aClass.
	self basicObsoleteSubclasses at: self put: obs.! !

!TBehavior methodsFor: 'testing' stamp: 'SebastianTleye 5/24/2013 17:04'!
hasAbstractMethods
	"Tells whether the receiver locally defines an abstract method, i.e., a method sending subclassResponsibility"
	
	^ (self methods anySatisfy: [:cm | cm sendsSelector: #subclassResponsibility ])! !

!TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'!
notifyUsersOfChangedSelectors: aCollection! !

!TBehavior methodsFor: 'accessing' stamp: 'SebastianTleye 7/17/2013 11:31'!
name
	^self explicitRequirement.! !

!TBehavior methodsFor: 'queries' stamp: 'MarcusDenker 7/14/2014 14:00'!
allMethodsAccessingSlot: aSlot
	"return all methods that access aSlot in this class and subclasses"
	^self withAllSubclasses flatCollect: [ :class |
		class methodsAccessingSlot: aSlot.
	]! !

!TBehavior methodsFor: 'accessing-properties' stamp: 'MarcusDenker 3/2/2015 18:23'!
propertyValueAt: propName ifAbsent: aBlock
	self properties ifNil: [^aBlock value].
	^ self properties
		at: propName
		ifAbsent: aBlock
		! !

!TBehavior methodsFor: '*Fuel' stamp: 'SebastianTleye 7/17/2013 10:09'!
fuelNew
	"Answer an instance of mine in which serialized references will be injected."

	^ self basicNew! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'!
selectorsWithArgs: numberOfArgs
	"Return all selectors defined in this class that take this number of arguments"

	^ self selectors select: [:selector | selector numArgs = numberOfArgs]! !

!TBehavior methodsFor: 'traits' stamp: 'NicolaiHess 11/27/2014 23:09'!
traitUsers: aCollection
	^self explicitRequirement.! !

!TBehavior methodsFor: 'testing' stamp: 'SebastianTleye 5/24/2013 17:54'!
instSpec
	^ (self format bitShift: -7) bitAnd: 16rF! !

!TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'!
traitCompositionIncludes: aTrait
	^self == aTrait or: 
		[self hasTraitComposition and: 
			[self traitComposition allTraits includes: aTrait]]! !

!TBehavior methodsFor: '*OpalCompiler-Core' stamp: 'SebastianTleye 7/16/2013 17:05'!
recompile: selector from: oldClass
	^self explicitRequirement.! !

!TBehavior methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 17:52'!
copyOfMethodDictionary
	"Return a copy of the receiver's method dictionary"

	^ self methodDict copy! !

!TBehavior methodsFor: 'queries' stamp: 'MarcusDenker 7/14/2014 13:56'!
methodsReadingSlot: aSlot
	^self methods select: [ :method | method readsSlot: aSlot ]! !

!TBehavior methodsFor: 'naming' stamp: 'SebastianTleye 7/9/2013 17:52'!
environment
	"Return the environment in which the receiver is visible"
	^Smalltalk globals! !

!TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'!
thoroughHasSelectorReferringTo: literal special: specialFlag byte: specialByte
	"Answer true if any of my methods access the argument as a 
	literal. Dives into the compact literal notation, making it slow but 
	thorough "

	
	self methodsDo: [ :method |
		((method hasLiteralThorough: literal) or: [specialFlag and: [method scanFor: specialByte]])
			ifTrue: [^true]].
	^false! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 5/28/2013 10:14'!
lookupSelector: selector
	"Look up the given selector in my methodDictionary.
	Return the corresponding method if found.
	Otherwise chase the superclass chain and try again.
	Return nil if no method is found."
	| lookupClass |
	lookupClass := self.
	[lookupClass == nil]
		whileFalse: 
			[(lookupClass includesSelector: selector)
				ifTrue: [^ lookupClass compiledMethodAt: selector].
			lookupClass := lookupClass superclass].
	^ nil! !

!TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'!
updateMethodDictionarySelector: aSymbol
	"A method with selector aSymbol in myself or my traitComposition has been changed.
	Do the appropriate update to my methodDict (remove or update method) and
	return all affected selectors of me so that my useres get notified."

	| modifiedSelectors descriptions oldProtocol |
	modifiedSelectors := IdentitySet new.
	descriptions := self traitComposition methodDescriptionsForSelector: aSymbol.
	descriptions do: [:methodDescription | | effectiveMethod selector |
		selector := methodDescription selector.
		(self includesLocalSelector: selector) ifFalse: [
			methodDescription isEmpty
				ifTrue: [
					self removeTraitSelector: selector.
					modifiedSelectors add: selector]
				ifFalse: [
					effectiveMethod := methodDescription effectiveMethod.
					self addTraitSelector: selector withMethod: effectiveMethod.
					
					"If the method was not categorized yet, we categorize it "
					oldProtocol := self organization categoryOfElement: selector.
					(oldProtocol isNil or: [ oldProtocol = Protocol unclassified ]) 
						ifTrue: [ self organization classify: selector under: methodDescription effectiveMethodCategory. ].
					
					modifiedSelectors add: selector]]].
	^modifiedSelectors! !

!TBehavior methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/24/2015 14:46'!
spotterCompositionFor: aStep
	<spotterOrder: 25>
	aStep listProcessor
			title: 'Composing traits';
			allCandidates: [ self traitComposition allTraits ];
			itemIcon: #systemIcon;
			filter: GTFilterSubstring! !

!TBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 5/24/2013 17:04'!
classVarNames
	"Answer a collection of the receiver's class variable names."

	^#()! !

!TBehavior methodsFor: 'obsolete subclasses' stamp: 'SebastianTleye 7/5/2013 17:47'!
basicObsoleteSubclasses
	^self explicitRequirement.! !

!TBehavior methodsFor: 'testing method dictionary' stamp: 'MarcusDenker 7/14/2014 14:12'!
whichSelectorsAccess: instVarName 
	"Answer a set of selectors whose methods access the argument, 
	instVarName, as a named instance variable."

	| instVarIndex |
	instVarIndex := self instVarIndexFor: instVarName ifAbsent: [^IdentitySet new].
	^ self selectors select:  [:sel | 
		((self compiledMethodAt: sel)
			readsField: instVarIndex)
			or: [(self compiledMethodAt: sel) writesField: instVarIndex]]! !

!TBehavior methodsFor: 'initialize-release' stamp: 'SebastianTleye 5/24/2013 17:04'!
nonObsoleteClass
	"Attempt to find and return the current version of this obsolete class"

	| obsName |
	obsName := self name.
	[obsName beginsWith: 'AnObsolete']
		whileTrue: [obsName := obsName copyFrom: 'AnObsolete' size + 1 to: obsName size].
	^ self environment at: obsName asSymbol! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:59'!
methodDict
	^self explicitRequirement.! !

!TBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 5/24/2013 17:04'!
allSubclasses
	"Answer an orderedCollection of the receiver's and the receiver's descendent's subclasses. "

	| scan scanTop |
	scan := OrderedCollection withAll: self subclasses.
	scanTop := 1.
	[scanTop > scan size]
		whileFalse: [scan addAll: (scan at: scanTop) subclasses.
			scanTop := scanTop + 1].
	^ scan! !

!TBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/9/2013 17:52'!
withAllSuperclasses
	"Answer an OrderedCollection of the receiver and the receiver's 
	superclasses. The first element is the receiver, 
	followed by its superclass; the last element is Object."

	| temp |
	temp := self allSuperclasses.
	temp addFirst: self.
	^ temp! !

!TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'!
removeTraitSelector: aSymbol
	[(self includesLocalSelector: aSymbol) not] assert.
	self basicRemoveSelector: aSymbol! !

!TBehavior methodsFor: 'accessing' stamp: 'SebastianTleye 7/16/2013 17:04'!
subclassDefinerClass
	^self explicitRequirement.! !

!TBehavior methodsFor: '*Rpackage-Core' stamp: 'MartinDias 2/13/2014 14:56'!
originalName
	^ ((self isObsolete and: [ self name beginsWith: 'AnObsolete' ])
		ifTrue: [ (self name copyFrom:   'AnObsolete' size + 1 to: self name size ) ]
		ifFalse:  [ self name ]) asSymbol! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 5/24/2013 17:49'!
precodeCommentOrInheritedCommentFor: selector 
	"Answer a string representing the first comment in the method associated 
	with selector, considering however only comments that occur before the 
	beginning of the actual code. If the version recorded in the receiver is 
	uncommented, look up the inheritance chain. Return nil if none found."
	
	| aSuper aComment |
	^ (aComment := self firstPrecodeCommentFor: selector) isEmptyOrNil
		ifTrue: [(self == Behavior
					or: [self superclass == nil
							or: [(aSuper := self superclass whichClassIncludesSelector: selector) == nil]])
				ifFalse: [aSuper precodeCommentOrInheritedCommentFor: selector]]
		ifFalse: [aComment]! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:59'!
methodDict: aDictionary
	^self explicitRequirement.! !

!TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 5/24/2013 17:54'!
whichClassIncludesSelector: aSymbol 
	"Answer the class on the receiver's superclass chain where the 
	argument, aSymbol (a message selector), will be found. Answer nil if none found."
	"Rectangle whichClassIncludesSelector: #inspect."
	(self includesSelector: aSymbol)
		ifTrue: [^ self].
	self superclass == nil
		ifTrue: [^ nil].
	^ self superclass whichClassIncludesSelector: aSymbol! !

!TBehavior methodsFor: 'testing method dictionary' stamp: 'MarcusDenker 12/2/2013 14:48'!
whichSelectorsStoreInto: instVarName 
	"Answer a Set of selectors whose methods access the argument, 
	instVarName, as a named instance variable."
	| instVarIndex |
	instVarIndex := self instVarIndexFor: instVarName ifAbsent: [^IdentitySet new].
	^ self selectors select: [:sel | (self compiledMethodAt: sel) writesField: instVarIndex]

	"Point whichSelectorsStoreInto: 'x'."! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'!
compiledMethodAt: selector 
	"Answer the compiled method associated with the argument, selector (a 
	Symbol), a message selector in the receiver's method dictionary. If the 
	selector is not in the dictionary, create an error notification."

	^ self methodDict at: selector! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'!
>> selector 
	"Answer the compiled method associated with the argument, selector (a 
	Symbol), a message selector in the receiver's method dictionary. If the 
	selector is not in the dictionary, create an error notification."

	^self compiledMethodAt: selector
! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'!
selectors
	"Answer a Set of all the message selectors specified in the receiver's 
	method dictionary."

	^ self methodDict keys! !

!TBehavior methodsFor: 'private' stamp: 'SebastianTleye 7/9/2013 17:52'!
spaceUsed
	"Answer a rough estimate of number of bytes used by this class and its metaclass. Does not include space used by class variables."

	| space |
	space := 0.
	self methodsDo: [:method  |
		space := space + 16.  "dict and org'n space"
		space := space + (method size + 6 "hdr + avg pad").
		method literalsDo: [:lit |
			(lit isMemberOf: Array) ifTrue: [space := space + ((lit size + 1) * 4)].
			(lit isMemberOf: Float) ifTrue: [space := space + 12].
			(lit isMemberOf: ByteString) ifTrue: [space := space + (lit size + 6)].
			(lit isMemberOf: LargeNegativeInteger) ifTrue: [space := space + ((lit size + 1) * 4)].
			(lit isMemberOf: LargePositiveInteger) ifTrue: [space := space + ((lit size + 1) * 4)]]].
		^ space! !

!TBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 5/24/2013 17:04'!
selectSuperclasses: aBlock 
	"Evaluate the argument, aBlock, with the receiver's superclasses as the 
	argument. Collect into an OrderedCollection only those superclasses for 
	which aBlock evaluates to true. In addition, evaluate aBlock for the 
	superclasses of each of these successful superclasses and collect into the 
	OrderedCollection ones for which aBlock evaluates to true. Answer the 
	resulting OrderedCollection."

	| aSet |
	aSet := Set new.
	self allSuperclasses do: 
		[:aSuperclass | 
		(aBlock value: aSuperclass) ifTrue: [aSet add: aSuperclass]].
	^aSet! !

!TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'!
selectorsDo: selectorBlock
	"Evaluate selectorBlock for all the message selectors in my method dictionary."

	^ self methodDict keysDo: selectorBlock! !

!TBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 5/24/2013 17:04'!
includesSharedPoolNamed:  aSharedPoolString 
	"Answer whether the receiver uses the shared pool named aSharedPoolString"
	
	^ (self sharedPools anySatisfy: [:each | each name = aSharedPoolString])! !

!TBehavior classTrait methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/26/2015 17:51'!
gtExampleTraitUsers
	<gtExample: 'Trait Users'>
	^ TBehavior! !

!TBehavior classTrait methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/26/2015 17:50'!
gtExampleAllSubclasses
	<gtExample: 'All Subclasses'>
	^ Object! !

!TBehavior classTrait methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/26/2015 17:49'!
gtExampleSuperclasses
	<gtExample: 'Superclasses'>
	^ Metaclass! !

!TBehavior classTrait methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/26/2015 17:50'!
gtExampleClassVariables
	<gtExample: 'Class Variables'>
	^ Behavior! !

!TBehavior classTrait methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/26/2015 17:50'!
gtExampleInstanceVariables
	<gtExample: 'Instance Variables'>
	^ ClassDescription! !

!TBehavior classTrait methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/26/2015 17:49'!
gtExampleTraits
	<gtExample: 'Traits'>
	^ Class! !

!TBehavior classTrait methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/26/2015 17:51'!
gtExampleTraitComposition
	<gtExample: 'Trait Composition'>
	^ Class! !

!TBehaviorCategorization commentStamp: 'TorstenBergmann 2/4/2014 20:37'!
Kernel trait for Behavior categorization!
!TBehaviorCategorization methodsFor: 'organization' stamp: 'MaxLeske 11/1/2014 20:17'!
category
	"Answer the system organization category for the receiver. First check whether the
	category name stored in the ivar is still correct and only if this fails look it up
	(latter is much more expensive)"

	| result |
	self basicCategory ifNotNil: [ :symbol |
		((self environment organization listAtCategoryNamed: symbol) includes: self name)
			ifTrue: [ ^symbol ] ].
	result := (self environment organization categoryOfElement: self name)
		ifNil: [ #Unclassified ]
		ifNotNil: #yourself.
	self basicCategory: result.
	
	^ result! !

!TBehaviorCategorization methodsFor: 'organization' stamp: 'EstebanLorenzano 7/27/2012 16:32'!
category: aString 
	"Categorize the receiver under the system category, aString, removing it from 
	any previous categorization."

	| oldCategory |
	oldCategory := self basicCategory.
	aString isString
		ifTrue: [
			self basicCategory: aString asSymbol.
			self environment organization classify: self name under: self basicCategory ]
		ifFalse: [self errorCategoryName].
	SystemAnnouncer uniqueInstance
		class: self recategorizedFrom: oldCategory to: self basicCategory! !

!TCairoLibrary commentStamp: '<historical>'!
a simple trait used for NB callouts to cairo library functions!
!TCairoLibrary methodsFor: 'library path' stamp: 'IgorStasenko 12/20/2011 16:52'!
nbLibraryNameOrHandle
	^ self class nbLibraryNameOrHandle
! !

!TCairoLibrary classTrait methodsFor: 'library path' stamp: 'IgorStasenko 6/10/2012 05:43'!
nbLibraryNameOrHandle
	^ CairoLibraryLoader getLibraryHandle! !

!TClass commentStamp: 'TorstenBergmann 2/4/2014 20:37'!
Kernel trait for Class!
!TClass methodsFor: '*Deprecated40' stamp: 'MarcusDenker 7/2/2014 09:14'!
ensureClassPool
	self deprecated: 'just use the accessor for classPool' on: '2 July 2014' in: 'Pharo40'.
	^self classPool.! !

!TClass methodsFor: 'testing' stamp: 'MarcusDenker 2/17/2015 14:22'!
isObsolete
	"Return true if the receiver is obsolete."
	^self propertyValueAt: #obsolete ifAbsent: false! !

!TClass methodsFor: '*Deprecated40' stamp: 'MarcusDenker 7/2/2014 09:14'!
classPoolFrom: aClass
	"share the classPool with aClass."
	self deprecated: 'just use the accessor for classPool' on: '2 July 2014' in: 'Pharo40'.
	self classPool: aClass classPool.! !

!TClass methodsFor: 'class variables' stamp: 'MarcusDenker 1/8/2015 15:49'!
classVariableDefinitionString
	"Answer a string that evaluates to the definition of the class Variables"
	
	^String streamContents: [ :str | | special |
		str nextPutAll: '{ '.
		self classVariables do: [:global |
				str nextPutAll: global definitionString.
				special := global isSpecial]				
			separatedBy: [ 
				str nextPutAll: '. '.  
				special ifTrue: [ str cr;tab;tab;tab;tab ]].
		str nextPutAll: ' }'. ]! !

!TClass methodsFor: '*GT-SpotterExtensions-Core' stamp: 'AndreiChis 4/10/2015 09:28'!
spotterExamplesFor: aStep
	<spotterOrder: 50>
	aStep listProcessor
			title: 'Examples';
			allCandidates: [ self gtExamples ];
			itemName: [ :example | example title ];
			filter: GTFilterSubstring! !

!TClass methodsFor: 'initialize-release' stamp: 'ST 6/17/2013 13:34'!
name: aString traitComposition: aComposition methodDict: aMethodDict localSelectors: aSet organization: aClassOrganization

	"Used by copy"
	
	self name: aString.
	self localSelectors: aSet.
	self methodDict: aMethodDict.
	self traitComposition: aComposition.
	self organization: aClassOrganization! !

!TClass methodsFor: 'viewer' stamp: 'ST 5/7/2013 15:01'!
externalName
	"Answer a name by which the receiver can be known."

	^ self name! !

!TClass methodsFor: 'class variables' stamp: 'MarcusDenker 7/10/2014 16:24'!
classVariableNamed: aString
	"Answer the Class Variable"

	^self classPool associationAt: aString asSymbol ifAbsent: [self error: 'no such class var']! !

!TClass methodsFor: 'subclass creation - slots' stamp: 'MarcusDenker 1/6/2015 12:29'!
subclass: aSubclassSymbol  layout: layoutClass slots: slotDefinition classVariables: classVarDefinition category: aCategorySymbol

	^ PharoClassInstaller make: [ :builder |
		builder name: aSubclassSymbol;
		superclass: self;
		layoutClass: layoutClass;
		slots: slotDefinition;
		sharedVariables: classVarDefinition;
		category: aCategorySymbol ].
! !

!TClass methodsFor: '*FuelTests' stamp: 'SebastianTleye 7/11/2013 17:40'!
renameSilently: aName
	 [ self rename: aName] fuelValueWithoutNotifications! !

!TClass methodsFor: 'accessing' stamp: 'SebastianTleye 7/16/2013 17:25'!
environment: anEnvironment
	^self explicitRequirement.! !

!TClass methodsFor: 'subclass creation' stamp: 'MartinDias 1/31/2014 16:22'!
weakSubclass: aName uses: aTraitComposition instanceVariableNames: someInstanceVariableNames classVariableNames: someClassVariableNames poolDictionaries: someSharedPoolNames category: aCategory
	"Creates a new class as a subclass of an existing class (the receiver) 
	in which the subclass is to have weak indexable pointer variables."
	
	^ self
		subclass: aName
		uses: aTraitComposition
		with: [ 
			self
				weakSubclass: aName
				instanceVariableNames: someInstanceVariableNames
				classVariableNames: someClassVariableNames
				poolDictionaries: someSharedPoolNames
				category: aCategory ]! !

!TClass methodsFor: '*GT-SpotterExtensions-Core' stamp: 'TudorGirba 1/28/2015 21:04'!
spotterPreviewCodeIn: aComposite
	<spotterPreview: 10>
	aComposite pharoMethod
		title: [self name];
		display: #definitionForNautilus;
		smalltalkClass: [ nil ];
		entity: self.
		
	self flag: 'move "entity: self" somewhere else, maybe'! !

!TClass methodsFor: '*Ring-Core-Kernel' stamp: 'SebastianTleye 7/16/2013 11:18'!
asFullRingDefinition
	"A behavior is converted to a ring class including its variables, methods, direct superclass, direct subclasses and the package in which is loaded.
	Active methods are generated and each knows its package as well.
	Note that for its direct superclass and subclasses no full definitions are requested. If you need to traverse hierarchies use #asRingDefinitionWithMethods:withSuperclasses:withSubclasses:withPackages:"
	
	| rgClass rgSuper rgSub rgMethod packageKeys |
	rgClass:= self asRingDefinition.
	rgClass package: (RGContainer packageOfClass: rgClass).
	
	self superclass notNil 
		ifTrue: [ 
			rgSuper := self superclass asRingDefinition.
			rgClass superclass: rgSuper ]
		ifFalse: [  
			self isTrait ifTrue: [ 
				rgSuper := Trait asRingDefinition.
				rgClass superclass: rgSuper. ]
			].

	self subclasses do:[ :each |
		rgSub := each asRingDefinition.
		rgSub superclass: rgClass ].
	
	packageKeys := RGContainer packageKeys.
	self methodsDo:[ :mth|  
			rgMethod := mth asActiveRingDefinition.
			rgClass addMethod: rgMethod.
			rgMethod package: (RGContainer packageOfMethod: rgMethod using: packageKeys) ].
	self theMetaClass methodsDo:[ :mth|  
			rgMethod := mth asActiveRingDefinition.
			rgClass theMetaClass addMethod: rgMethod.
			rgMethod package: (RGContainer packageOfMethod: rgMethod using: packageKeys) ].
	
	^ rgClass! !

!TClass methodsFor: 'initialize-release' stamp: 'SebastianTleye 5/27/2013 15:35'!
superclass: aClass methodDictionary: mDict format: fmt
	"Basic initialization of the receiver"
	super superclass: aClass methodDictionary: mDict format: fmt.
	self subclasses: nil. ! !

!TClass methodsFor: 'subclass creation' stamp: 'ST 5/6/2013 16:06'!
subclass: t uses: aTraitComposition 
	| cls |
	cls := self
				subclass: t
				instanceVariableNames: ''
				classVariableNames: ''
				poolDictionaries: ''
				category: 'Unclassified'.
	cls setTraitComposition: aTraitComposition asTraitComposition.
	^ cls! !

!TClass methodsFor: 'class variables' stamp: 'MarcusDenker 7/10/2014 16:28'!
readClassVariableNamed: aString
	"Answer the content of the Class Variable"

	^(self classVariableNamed: aString) read! !

!TClass methodsFor: 'initialize-release' stamp: 'ST 5/6/2013 15:59'!
removeFromSystemUnlogged
	"Forget the receiver from the Smalltalk global dictionary. Any existing instances will refer to an obsolete version of the receiver.  Do not log the removal either to the current change set nor to the system changes log"
	^self removeFromSystem: false! !

!TClass methodsFor: 'subclass creation' stamp: 'MartinDias 6/24/2013 15:25'!
variableByteSubclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s category: cat
	"This is the standard initialization message for creating a new class as a 
	subclass of an existing class (the receiver) in which the subclass is to 
	have indexable byte-sized nonpointer variables."
	^self classBuilder
		superclass: self
		variableByteSubclass: t
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: cat! !

!TClass methodsFor: 'initialize-release' stamp: 'SebastianTleye 5/24/2013 16:44'!
superclass: sup methodDict: md format: ft name: nm organization: org instVarNames: nilOrArray classPool: pool sharedPools: poolSet 
	"Answer an instance of me, a new class, using the arguments of the 
	message as the needed information.
	Must only be sent to a new instance; else we would need Object flushCache."

	self superclass: sup.
	self methodDict: md.
	self setFormat: ft.
	self setName: nm.
	self instanceVariables: nilOrArray.
	self classPool: pool.
	self sharedPools: poolSet.
	self organization: org.! !

!TClass methodsFor: 'class variables' stamp: 'MarcusDenker 7/10/2014 16:26'!
writeClassVariableNamed: aString value: anObject
	"Store anObject in the class variable."
	
	(self classVariableNamed: aString) write: anObject! !

!TClass methodsFor: '*Monticello' stamp: 'SebastianTleye 7/16/2013 17:27'!
asClassDefinition
	^self explicitRequirement.! !

!TClass methodsFor: 'subclass creation - slots' stamp: 'MarcusDenker 1/6/2015 12:29'!
subclass: aSubclassSymbol  layout: layoutClass  slots: slotDefinition classVariables: classVarDefinition poolDictionaries: someSharedPoolNames category: aCategorySymbol

	^ PharoClassInstaller make: [ :builder |
		builder name: aSubclassSymbol;
		superclass: self;
		layoutClass: layoutClass;
		slots: slotDefinition;
		sharedVariables:  classVarDefinition;
		sharedPools: someSharedPoolNames;
		category: aCategorySymbol ].
! !

!TClass methodsFor: 'accessing' stamp: 'SebastianTleye 7/16/2013 17:31'!
name: aString
	^self explicitRequirement.! !

!TClass methodsFor: 'subclass creation' stamp: 'SebastianTleye 7/12/2013 14:19'!
subclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat 
	^self explicitRequirement.! !

!TClass methodsFor: 'class variables' stamp: 'MarcusDenker 7/13/2014 13:13'!
hasClassVariable: aGlobal
	"Return whether the receiver has a class variables (shared variables among its class and subclasses) named: aString"
	
	^ self classVariables identityIncludes: aGlobal! !

!TClass methodsFor: 'subclass creation - slots' stamp: 'MarcusDenker 1/6/2015 12:29'!
subclass: aSubclassSymbol uses: aTraitCompositionOrArray  layout: layoutClass slots: slotDefinition classVariables: classVarDefinition poolDictionaries: someSharedPoolNames category: aCategorySymbol
	^ self
		subclass: aSubclassSymbol
		uses: aTraitCompositionOrArray
		with: [ 
			PharoClassInstaller
				make: [ :builder | 
					builder
						name: aSubclassSymbol;
						superclass: self;
						layoutClass: layoutClass;
						slots: slotDefinition;
						sharedVariables: classVarDefinition;
						sharedPools: someSharedPoolNames;
						category: aCategorySymbol ] ]! !

!TClass methodsFor: '*Slot' stamp: 'MarcusDenker 3/8/2015 11:30'!
removeSlot: aSlot 

	(self layout slots includes: aSlot)
		ifFalse: [self error: aSlot name , ' is not one of my slots'].
		
	^PharoClassInstaller make: [ :builder |
		builder
			superclass:  self superclass;
			name:  self name;
			layoutClass: (OldClassBuilderAdapter new layoutForType: self typeOfClass);
			slots: (self layout slots copyWithout: aSlot);
			sharedVariablesFromString: self classVariablesString;
			sharedPools: self sharedPoolsString;
			category: self category;
			environment: self environment;
			copyTraitCompositionFromExistingClass;
			copyClassSlotsFromExistingClass]
	! !

!TClass methodsFor: 'pool variables' stamp: 'SebastianTleye 7/12/2013 15:41'!
sharedPools
	^self explicitRequirement.! !

!TClass methodsFor: 'testing' stamp: 'CamilloBruni 11/21/2013 19:18'!
isAnonymous
	^self getName isNil! !

!TClass methodsFor: 'organization' stamp: ''!
category: aString 
	"Categorize the receiver under the system category, aString, removing it from 
	any previous categorization."

	| oldCategory |
	oldCategory := self basicCategory.
	aString isString
		ifTrue: [
			self basicCategory: aString asSymbol.
			self environment organization classify: self name under: self basicCategory ]
		ifFalse: [self errorCategoryName].
	SystemAnnouncer uniqueInstance
		class: self recategorizedFrom: oldCategory to: self basicCategory! !

!TClass methodsFor: 'pool variables' stamp: 'ST 5/7/2013 14:56'!
removeSharedPool: aDictionary 
	"Remove the pool dictionary, aDictionary, as one of the receiver's pool 
	dictionaries. Create an error notification if the dictionary is not one of 
	the pools.
	: Note that it removes the wrong one if there are two empty Dictionaries in the list."

	| satisfiedSet workingSet aSubclass |
	(self sharedPools includes: aDictionary)
		ifFalse: [^self error: 'the dictionary is not in my pool'].

	"first see if it is declared in a superclass in which case we can remove it."
	(self selectSuperclasses: [:class | class sharedPools includes: aDictionary]) isEmpty
		ifFalse: [self sharedPools remove: aDictionary.
				self sharedPools isEmpty ifTrue: [self sharedPools: nil].
				^self]. 

	"second get all the subclasses that reference aDictionary through me rather than a 
	superclass that is one of my subclasses."

	workingSet := self subclasses asOrderedCollection.
	satisfiedSet := Set new.
	[workingSet isEmpty] whileFalse:
		[aSubclass := workingSet removeFirst.
		(aSubclass sharedPools includes: aDictionary)
			ifFalse: 
				[satisfiedSet add: aSubclass.
				workingSet addAll: aSubclass subclasses]].

	"for each of these, see if they refer to any of the variables in aDictionary because 
	if they do, we can not remove the dictionary."
	satisfiedSet add: self.
	satisfiedSet do: 
		[:sub | 
		aDictionary associationsDo: 
			[:aGlobal | 
			(sub whichSelectorsReferTo: aGlobal) isEmpty 
				ifFalse: [^self error: aGlobal key 
								, ' is still used in code of class '
								, sub name]]].
	self sharedPools remove: aDictionary.
	self sharedPools isEmpty ifTrue: [self sharedPools: nil]! !

!TClass methodsFor: 'class variables' stamp: 'ST 5/6/2013 15:53'!
usesClassVarNamed: aString
	"Return whether the receiver or its superclasses have a class variable named: aString"
	
	^ self allClassVarNames includes: aString! !

!TClass methodsFor: 'subclass creation - slots' stamp: 'MarcusDenker 1/6/2015 12:30'!
subclass: aSubclassSymbol uses: aTraitCompositionOrArray slots: slotDefinition classVariables: classVarDefinition poolDictionaries: someSharedPoolNames category: aCategorySymbol
	^ self
		subclass: aSubclassSymbol
		uses: aTraitCompositionOrArray
		with: [ 
			PharoClassInstaller
				make: [ :builder | 
					builder
						name: aSubclassSymbol;
						superclass: self;
						slots: slotDefinition;
						sharedVariables: classVarDefinition;
						sharedPools: someSharedPoolNames;
						category: aCategorySymbol ] ]! !

!TClass methodsFor: 'class name' stamp: 'ST 5/7/2013 14:59'!
rename: aString 
	"The new name of the receiver is the argument, aString."

	| oldName newName |
	(newName := aString asSymbol) = (oldName := self name)
		ifTrue: [^ self].
	(self environment includesKey: newName)
		ifTrue: [^ self error: newName , ' already exists'].
	self setName: newName.
	self environment renameClass: self from: oldName.
	(Undeclared includesKey: newName)
		ifTrue: [self inform: 'There are references to, ' , aString printString , '
from Undeclared. Check them after this change.'].! !

!TClass methodsFor: 'compiling' stamp: 'ST 5/6/2013 15:54'!
compileAllFrom: oldClass
	"Recompile all the methods in the receiver's method dictionary (not the
	subclasses). Also recompile the methods in the metaclass."

	super compileAllFrom: oldClass.
	self class compileAllFrom: oldClass class! !

!TClass methodsFor: 'fileIn/Out' stamp: 'ST 5/6/2013 15:57'!
shouldFileOutPool: aPoolName
	"respond with true if the user wants to file out aPoolName"
	^self confirm: ('FileOut the sharedPool ', aPoolName, '?')! !

!TClass methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/24/2015 14:47'!
spotterReferenceFor: aStep
	<spotterOrder: 30>
	aStep listProcessor
			title: 'References';
			allCandidates: [ (SystemNavigation default allReferencesTo: self binding) collect: #compiledMethod ];
			itemName: [ :method | method gtDisplayString ];
			filter: GTFilterSubstring! !

!TClass methodsFor: 'traits' stamp: 'ST 6/17/2013 10:25'!
applyChangesOfNewTraitCompositionReplacing: oldComposition

	| changedSelectors |
	changedSelectors := super applyChangesOfNewTraitCompositionReplacing: oldComposition.
	self classSide noteNewBaseTraitCompositionApplied: self traitComposition.
	^ changedSelectors! !

!TClass methodsFor: 'testing' stamp: 'ST 5/6/2013 16:08'!
hasMethods
	"Answer a Boolean according to whether any methods are defined for the 
	receiver (includes whether there are methods defined in the receiver's 
	metaclass)."

	^super hasMethods or: [self class hasMethods]! !

!TClass methodsFor: 'subclass creation' stamp: 'MartinDias 6/24/2013 15:24'!
classBuilder
		"Answer the object responsible of creating subclasses of myself in the system."
	
		^ Smalltalk classBuilder! !

!TClass methodsFor: 'pool variables' stamp: 'SebastianTleye 7/16/2013 17:29'!
sharedPools: aCollection
	^self explicitRequirement.! !

!TClass methodsFor: '*GT-SpotterExtensions-Core' stamp: 'NicolaiHess 2/5/2015 00:33'!
spotterActDefault
	^ self browse! !

!TClass methodsFor: '*Ring-Core-Kernel' stamp: 'SebastianTleye 7/16/2013 11:23'!
asRingDefinitionWithMethods: methodsBoolean withSuperclasses: supersBoolean withSubclasses: subsBoolean withPackages: packsBoolean
	"Retrieves a ring class/trait based on the receiver.
	The data loaded in the class/trait (active methods, superclasses, subclasses and packages) is requested by the users.
	As it may need to traverse hierarchies for retrieving super and subclasses a ring slice is created as the container for every class, method and package.
	To retrieve the slice:  aRGClass environment "
	| rgClass rgSlice  rgPackageKeys |
	
	rgSlice := RGSlice named: #fromImage.
	packsBoolean ifTrue: [ 
		rgPackageKeys := rgSlice loadPackagesFromImage ].
	rgClass := self asRingDefinitionWithMethods: methodsBoolean withSuperclasses: supersBoolean withSubclasses: subsBoolean withPackageKeys: rgPackageKeys in: rgSlice.
	rgSlice cleanEmptyPackages.
	rgSlice loadTraitUsers.
		
	^ rgClass! !

!TClass methodsFor: 'compiling' stamp: 'MarcusDenker 9/19/2014 10:54'!
compileAll
	super compileAll.
	self classSide compileAll.! !

!TClass methodsFor: '*GT-SpotterExtensions-Core' stamp: 'AliakseiSyrel 3/22/2015 15:42'!
spotterSuperClassMethodsFor: aStep
	<spotterOrder: 16>
	|superclasses|
	superclasses := self class withAllSuperclasses select: #isMeta.
	aStep listProcessor
			title: 'Super class methods';
			allCandidates: [ self classSide allMethods select: [ :each |(each methodClass = self classSide) not & (superclasses includes: each methodClass) ] ];
			filter: GTFilterSubstring! !

!TClass methodsFor: 'subclass creation' stamp: 'johanfabry 1/24/2014 10:06'!
variableSubclass: className instanceVariableNames: instVarNames classVariableNames: classVarNames category: cat
	"Added to allow for a simplified subclass creation experience. "

	^ self variableSubclass: className
		instanceVariableNames: instVarNames 
		classVariableNames: classVarNames 
		poolDictionaries: ''
		category: cat
! !

!TClass methodsFor: 'private' stamp: 'ST 6/17/2013 11:01'!
setName: aSymbol andRegisterInCategory: categorySymbol environment: aSystemDictionary
	(self isValidTraitName: aSymbol) ifFalse: [TraitException signal: 'Invalid trait name'].
	
	(self environment == aSystemDictionary
		and: [self name = aSymbol
			and: [self category = categorySymbol]]) ifTrue: [^self].
		
	((aSystemDictionary includes: aSymbol) and: [(aSystemDictionary at: aSymbol) ~~ self])
		ifTrue: [TraitException signal: 'The name ''' , aSymbol , ''' is already used'].

	(self environment notNil and: [self name notNil and: [self name ~= aSymbol]]) ifTrue: [
		self environment renameClass: self as: aSymbol].
	
	self name: aSymbol.
	self environment: aSystemDictionary.	
	self environment at: self name put: self.
	self environment organization classify: self name under: categorySymbol.
	^ true! !

!TClass methodsFor: 'accessing class hierarchy' stamp: 'ST 5/7/2013 14:20'!
subclassesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the receiver's immediate subclasses."
	self subclasses size == 0 
		ifFalse:[self subclasses do: aBlock]! !

!TClass methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/24/2015 14:47'!
spotterMethodsFor: aStep
	<spotterOrder: 10>
	aStep listProcessor
			title: 'Instance methods';
			allCandidates: [ self methods ];
			itemName: [ :method | method selector ];
			filter: GTFilterSubstring! !

!TClass methodsFor: 'class variables' stamp: 'MarcusDenker 7/13/2014 13:10'!
definesClassVariableNamed: aString
	"Return whether the receiver has a class variables (shared variables among its class and subclasses) named: aString"
	
	^ self classVarNames includes: aString! !

!TClass methodsFor: 'subclass creation' stamp: 'MartinDias 1/31/2014 16:15'!
variableWordSubclass: aName uses: aTraitComposition instanceVariableNames: someInstanceVariableNames classVariableNames: someClassVariableNames poolDictionaries: someSharedPoolNames category: aCategory
	"Creates a new class as a subclass of an existing class (the receiver) 
	in which the subclass is to have indexable word-sized nonpointer variables."
	
	^ self
		subclass: aName
		uses: aTraitComposition
		with: [ 
			self
				variableWordSubclass: aName
				instanceVariableNames: someInstanceVariableNames
				classVariableNames: someClassVariableNames
				poolDictionaries: someSharedPoolNames
				category: aCategory ]! !

!TClass methodsFor: 'fileIn/Out' stamp: 'SebastianTleye 7/12/2013 15:20'!
fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex initializing: aBool
	^self explicitRequirement.! !

!TClass methodsFor: 'compiling' stamp: 'ST 5/7/2013 14:37'!
possibleVariablesFor: misspelled continuedFrom: oldResults

	| results |
	results := misspelled correctAgainstDictionary: self classPool continuedFrom: oldResults.
	self sharedPools do: [:pool | 
		results := misspelled correctAgainstDictionary: pool continuedFrom: results ].
	self superclass == nil
		ifTrue: 
			[ ^ misspelled correctAgainstDictionary: self environment continuedFrom: results ]
		ifFalse:
			[ ^ self superclass possibleVariablesFor: misspelled continuedFrom: results ]! !

!TClass methodsFor: 'private' stamp: 'SebastianTleye 7/4/2013 17:19'!
setName: aSymbol
	self name: aSymbol.! !

!TClass methodsFor: 'pool variables' stamp: 'ST 5/6/2013 16:03'!
allSharedPools
	"Answer an ordered collection of the pools the receiver shares, including those defined  in the superclasses of the receiver."
	| aSet | 
	^self superclass == nil
		ifTrue: [self sharedPools copy]
		ifFalse: [aSet := self superclass allSharedPools.
			aSet addAll: self sharedPools.
			aSet]! !

!TClass methodsFor: 'subclass creation' stamp: 'johanfabry 1/24/2014 10:10'!
variableSubclass: aClassName uses: aTraitCompositionOrArray instanceVariableNames: instVarNames 
	classVariableNames: classVarNames category: cat
	"Added to allow for a simplified subclass creation experience. "
	
	^ self variableSubclass: aClassName 
		uses: aTraitCompositionOrArray
		instanceVariableNames: instVarNames  
		classVariableNames: classVarNames 
		poolDictionaries: ''
		category: cat! !

!TClass methodsFor: 'initialize-release' stamp: 'MarcusDenker 7/21/2014 15:32'!
replaceClassVariable: newVar 
	"replace an exisiting class var with the same name. used to wrap class vars for MetaLinks"
	
	(self classPool includesKey: newVar key) ifFalse: [ ^self ].
	self classPool removeKey: newVar key.
	self classPool add: newVar.! !

!TClass methodsFor: 'subclass creation' stamp: 'ST 5/6/2013 16:06'!
newSubclass
	| i className |
	i := 1.
	[className := (self name , i printString) asSymbol.
	 self environment includesKey: className]
		whileTrue: [i := i + 1].

	^ self subclass: className
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: 'Unclassified'

"Point newSubclass new"! !

!TClass methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/12/2013 14:36'!
subclasses
	^self explicitRequirement.! !

!TClass methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 10/12/2014 22:31'!
gtInspectorAllReferencesIn: composite
	"This provides a list of all methods provided by the current class"
	<gtInspectorPresentationOrder: 20>
	composite list 
		title: 'All Ref';
		display: [ (SystemNavigation default allReferencesTo: self binding) 
						sorted: [ :x :y | x name < y name ] ];
		format: #name;
		tags: [ :each | { each package name } ]! !

!TClass methodsFor: 'copying' stamp: 'EstebanLorenzano 5/6/2014 14:12'!
duplicateClassWithNewName: aSymbol
	| copysName class newDefinition |
	copysName := aSymbol asSymbol.
	copysName = self name
		ifTrue: [ ^ self ].
	(Smalltalk globals includesKey: copysName)
		ifTrue: [ ^ self error: copysName , ' already exists' ].
	newDefinition := self definition copyReplaceAll: '#' , self name asString with: '#' , copysName asString.
	class := self class compiler source: newDefinition; logged: true; evaluate.
	class classSide instanceVariableNames: self classSide instanceVariablesString.
	class copyAllCategoriesFrom: self.
	class class copyAllCategoriesFrom: self class.
	^ class! !

!TClass methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 10/12/2014 22:30'!
gtInspectorMethodsIn: composite
	"This provides a list of all methods provided by the current class"
	<gtInspectorPresentationOrder: 20>
	composite list 
		title: 'Methods';
		display: [ (self allMethods collect: #asRingDefinition) 
						sorted: [ :x :y | x selector < y selector ] ];
		format: #selector;
		tags: [ :each | {each methodClass name} ]! !

!TClass methodsFor: 'subclass creation' stamp: 'PabloHerrero 2/17/2014 16:27'!
variableSubclass: aName uses: aTraitComposition instanceVariableNames: someInstanceVariableNames classVariableNames: someClassVariableNames poolDictionaries: someSharedPoolNames category: aCategory
	"Creates a new class as a subclass of an existing class (the receiver) 
	in which the subclass is to have indexable pointer variables."
	
	^ self
		subclass: aName
		uses: aTraitComposition
		with: [ 
			self
				variableSubclass: aName
				instanceVariableNames: someInstanceVariableNames
				classVariableNames: someClassVariableNames
				poolDictionaries: someSharedPoolNames
				category: aCategory ]! !

!TClass methodsFor: 'subclass creation' stamp: 'johanfabry 11/28/2013 12:49'!
subclass: aSubclassSymbol instanceVariableNames: instVarNames classVariableNames: classVarNames category: aCategorySymbol
	"Added to allow for a simplified subclass creation experience. "
	^ self
		subclass: aSubclassSymbol
		instanceVariableNames: instVarNames
		classVariableNames: classVarNames
		poolDictionaries: ''
		category: aCategorySymbol! !

!TClass methodsFor: 'pool variables' stamp: 'ST 5/6/2013 16:04'!
usesLocalPoolVarNamed: aString
	"Return whether the receiver uses a pool variable named: aString which is defined locally"
	
	self hasSharedPools
		ifTrue: [ self sharedPools do: [:each | (each usesClassVarNamed: aString) 
												ifTrue: [ ^true ]]]
		ifFalse: [ ^false ].
	^false! !

!TClass methodsFor: 'private' stamp: 'CamilloBruni 11/21/2013 19:18'!
getName
	^ self name! !

!TClass methodsFor: 'class variables' stamp: 'ST 5/6/2013 15:52'!
hasClassVarNamed: aString
	"Return whether the receiver has a class variables (shared variables among its class and subclasses) named: aString"
	
	^ self classVarNames includes: aString! !

!TClass methodsFor: 'subclass creation' stamp: 'MartinDias 6/24/2013 15:23'!
weakSubclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s category: cat
	"This is the standard initialization message for creating a new class as a subclass of an existing class (the receiver) in which the subclass is to have weak indexable pointer variables."
	^self classBuilder
		superclass: self
		weakSubclass: t
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: cat! !

!TClass methodsFor: 'class variables' stamp: 'MarcusDenker 2/17/2014 13:44'!
removeClassVarNamed: aString
	"Remove the class variable whose name is the argument, aString, from 
    the names defined in the receiver, a class. Create an error notification if 
    aString is not a class variable or if it is still being used in the code of 
    the class."

	| aSymbol |
	aSymbol := aString asSymbol.
	(self classPool includesKey: aSymbol)
		ifFalse: [ ^ self error: aString , ' is not a class variable' ].
	self withAllSubclasses
		do: [ :subclass | 
			(Array with: subclass with: subclass class)
				do: [ :classOrMeta | 
					(classOrMeta whichSelectorsReferTo: (self classPool associationAt: aSymbol)) isEmpty
						ifFalse: [ 
							InMidstOfFileinNotification signal
								ifTrue: [ 
									self crTrace: self name , ' (' , aString , ' is Undeclared) '.
									^ Undeclared declare: aSymbol from: self classPool ]
								ifFalse: [ 
									(self
										confirm:
											(aString , ' is still used in code of class ' , classOrMeta name , '.\Is it okay to move it to Undeclared?') withCRs)
										ifTrue: [ ^ Undeclared declare: aSymbol from: self classPool ]
										ifFalse: [ ^ self ] ] ] ] ].
	self classPool removeKey: aSymbol.
	self classPool isEmpty
		ifTrue: [ self classPool: nil ]! !

!TClass methodsFor: 'class variables' stamp: 'MarcusDenker 7/18/2014 08:02'!
addClassVarNamed: aString 
	"Add the argument, aString, as a class variable of the receiver.
	Signal an error if the first character of aString is not capitalized,
	or if it is already a variable named in the class."
	
	self addClassVariable: (aString asSymbol => ClassVariable)! !

!TClass methodsFor: 'class variables' stamp: 'ST 5/6/2013 15:51'!
allClassVarNames
	"Answer a Set of the names of the receiver's class variables, including those
	defined in the superclasses of the receiver."

	| aSet |
	self superclass == nil
		ifTrue: 
			[^self classVarNames asSet]  "This is the keys so it is a new Set."
		ifFalse: 
			[aSet := self superclass allClassVarNames.
			aSet addAll: self classVarNames.
			^aSet]! !

!TClass methodsFor: '*Manifest-Core' stamp: 'SebastianTleye 7/11/2013 17:40'!
criticTheNonMetaclassClass

	"Return the class of the receiver for the critic browser. This behavior may be folded later by changing the name of this method or using another one."
	
	^ self ! !

!TClass methodsFor: 'compiling' stamp: 'ST 5/6/2013 15:54'!
bindingOf: varName
	"Answer the binding of some variable resolved in the scope of the receiver, or nil
	if variable with such name is not defined"

	"The lookup recurses up to superclasses looking inside their class and shared pools,
	but not the environment, since two classes, even if they have ancestry relationship,
	could use different environments.
	That's why we doing an environment lookup only as a last step of symbol lookup 
	and taking only the environment of receiver only, not any of it's superclass(es) "
	
	| aSymbol |
	aSymbol := varName asSymbol.

	^ (self innerBindingOf: aSymbol) ifNil: [
		 self environment bindingOf: aSymbol
	]! !

!TClass methodsFor: 'subclass creation' stamp: 'johanfabry 1/24/2014 10:54'!
variableWordSubclass: className instanceVariableNames: instVarNames
	classVariableNames: classVarNames category: cat
	"Added to allow for a simplified subclass creation experience. "
	 
	^ self variableWordSubclass: className
		instanceVariableNames: instVarNames  
		classVariableNames: classVarNames 
		poolDictionaries: ''
		category: cat! !

!TClass methodsFor: 'class variables' stamp: 'MarcusDenker 1/14/2015 15:16'!
addClassVariable: aGlobal
	"Add the argument, aString, as a class variable of the receiver.
	Signal an error if the first character of aString is not capitalized,
	or if it is already a variable named in the class."
	| symbol oldState |
	oldState := self copy.
	symbol := aGlobal name asSymbol.
	self withAllSubclasses do: 
		[:subclass | 
		(subclass bindingOf: symbol) ifNotNil:[
			^ self error: symbol asString 
				, ' is already used as a variable name in class ' 
				, subclass name]].
	(self classPool includesKey: symbol) ifFalse: 
		["Pick up any refs in Undeclared"
		self classPool declareVariable: aGlobal from: Undeclared.
		SystemAnnouncer uniqueInstance classDefinitionChangedFrom: oldState to: self]! !

!TClass methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/24/2015 14:47'!
spotterClassMethodsFor: aStep
	<spotterOrder: 15>
	aStep listProcessor
			title: 'Class methods';
			allCandidates: [ self classSide methods ];
			itemName: [ :method | method selector ];
			filter: GTFilterSubstring! !

!TClass methodsFor: 'subclass creation - slots' stamp: 'MarcusDenker 1/6/2015 12:29'!
subclass: aSubclassSymbol slots: slotDefinition classVariables: classVarDefinition poolDictionaries: someSharedPoolNames category: aCategorySymbol

	^ PharoClassInstaller make: [ :builder |
		builder name: aSubclassSymbol;
		superclass: self;
		slots: slotDefinition;
		sharedVariables:  classVarDefinition;
		sharedPools: someSharedPoolNames;
		category: aCategorySymbol ].
! !

!TClass methodsFor: 'class variables' stamp: 'MarcusDenker 7/10/2014 16:20'!
removeClassVariable: aGlobal
	"Remove the class variable"
	self removeClassVarNamed: aGlobal name

	! !

!TClass methodsFor: 'accessing class hierarchy' stamp: 'EstebanLorenzano 4/11/2014 15:48'!
addSubclass: aSubclass 
	"Make the argument, aSubclass, be one of the subclasses of the receiver. 
	Create an error notification if the argument's superclass is not the receiver."
	
	self explicitRequirement! !

!TClass methodsFor: 'initialize-release' stamp: 'MarcusDenker 2/17/2015 14:21'!
obsolete
	"Change the receiver and all of its subclasses to an obsolete class."
	self == Object 
		ifTrue: [^self error: 'Object is NOT obsolete'].
	self setName: 'AnObsolete' , self name.
	Object class instSize + 1 to: self classSide instSize do:
		[:i | self instVarAt: i put: nil]. "Store nil over class instVars."
	self classPool: nil.
	self sharedPools: nil.
	self hasClassSide ifTrue: [ self theMetaClass obsolete].
	self propertyValueAt: #obsolete put: true.
	super obsolete.! !

!TClass methodsFor: 'organization' stamp: ''!
category
	"Answer the system organization category for the receiver. First check whether the
	category name stored in the ivar is still correct and only if this fails look it up
	(latter is much more expensive)"

	| result |
	self basicCategory ifNotNil: [ :symbol |
		((self environment organization listAtCategoryNamed: symbol) includes: self name)
			ifTrue: [ ^symbol ] ].
	result := (self environment organization categoryOfElement: self name)
		ifNil: [ #Unclassified ]
		ifNotNil: #yourself.
	self basicCategory: result.
	
	^ result! !

!TClass methodsFor: '*OpalCompiler-Core' stamp: 'CamilleTeruel 9/2/2014 12:58'!
classSideCompiler
	"Redefine this method if you want to customize the compiler for class-side methods"
	^self classSideCompilerClass new
		environment: self classSide environment;
		class: self classSide! !

!TClass methodsFor: 'private' stamp: 'ST 6/17/2013 13:39'!
isValidTraitName: aSymbol
	^(aSymbol isEmptyOrNil
		or: [aSymbol first isLetter not
		or: [aSymbol anySatisfy: [:character | character isAlphaNumeric not]]]) not! !

!TClass methodsFor: 'initialize-release' stamp: 'ST 5/6/2013 15:58'!
removeFromSystem
	"Forget the receiver from the Smalltalk global dictionary. Any existing 
	instances will refer to an obsolete version of the receiver."
	self removeFromSystem: true.! !

!TClass methodsFor: 'initialize-release' stamp: 'BernardoContreras 3/8/2015 18:34'!
sharing: poolString 
	"Set up sharedPools. Answer whether recompilation is advisable."
	| oldPools |
	oldPools := self sharedPools.
	self sharedPools: OrderedCollection new.
	(poolString substrings: ' ') do: 
		[:poolName | 
		self sharedPools add: (self environment at: poolName asSymbol ifAbsent:[
			(self confirm: 'The pool dictionary ', poolName,' does not exist.',
						'\Do you want it automatically created?' withCRs)
				ifTrue: [ PharoClassInstaller make: [ :builder | 
							builder superclass: SharedPool;
							name: poolName;
							category: self category ]]
				ifFalse:[^self error: poolName,' does not exist']])].
	self sharedPools isEmpty ifTrue: [self sharedPools: nil].
	oldPools do: [:pool |
				| found |
				found := self sharedPools anySatisfy: [:p | p == pool].
				found ifFalse: [^ true "A pool got deleted"]].
	^ false! !

!TClass methodsFor: '*HelpSystem-Core' stamp: 'SebastianTleye 7/11/2013 17:41'!
asHelpTopic
	^SystemReference forClass: self! !

!TClass methodsFor: 'compiling' stamp: 'MarcusDenker 10/13/2013 08:32'!
innerBindingOf: aSymbol
	"Answer the binding of some variable resolved in the scope of the receiver, or one of its superclass
	but do not look up binding in receiver's environment.
	Use #bindingOf: for looking up the variable binding in a full scope, including receiver's environment"

	"First look in classVar dictionary."
	(self classPool bindingOf: aSymbol) ifNotNil: [:binding | ^binding].
	"Next look in shared pools."
	self sharedPools do: [:pool | (pool bindingOf: aSymbol) ifNotNil: [:binding | ^binding]].
	self superclass ifNotNil: [:supercl | ^ supercl innerBindingOf: aSymbol].	
	^ nil! !

!TClass methodsFor: 'subclass creation' stamp: 'johanfabry 1/24/2014 10:45'!
weakSubclass: className uses: aTraitCompositionOrArray instanceVariableNames: instVarNames 
	classVariableNames: classVarNames category: cat
	"Added to allow for a simplified subclass creation experience. "
	
	^ self weakSubclass: className
		uses: aTraitCompositionOrArray
		instanceVariableNames: instVarNames 
		classVariableNames: classVarNames 
		poolDictionaries: ''
		category: cat
! !

!TClass methodsFor: 'compiling' stamp: 'ST 6/14/2013 13:07'!
binding
       "Answer a binding for the receiver, sharing if possible"
      | binding |
	binding := self environment associationAt: self name ifAbsent: [nil -> self].
       ^binding value == self ifTrue: [binding] ifFalse: [nil -> self]! !

!TClass methodsFor: 'initialize-release' stamp: 'VincentBlondeau 3/6/2015 16:39'!
removeFromSystem: logged
	"Forget the receiver from the Smalltalk global dictionary. Any existing 
	instances will refer to an obsolete version of the receiver."
	
	"keep the class name and category for triggering the system change message. If we wait to long, then we get obsolete information which is not what we want."

	"tell class to deactivate and unload itself-- two separate events in the module system"
	self unload.
	self traitUsers do: [ :user | user removeFromComposition: self ].
	self superclass ifNotNil:
		["If we have no superclass there's nothing to be remembered"
		self superclass addObsoleteSubclass: self].
	self environment forgetClass: self logged: logged.
	self obsolete.! !

!TClass methodsFor: 'subclass creation' stamp: 'ST 5/6/2013 16:06'!
subclass: t
	^ self subclass: t instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Unclassified' ! !

!TClass methodsFor: 'pool variables' stamp: 'ST 5/6/2013 16:04'!
usesPoolVarNamed: aString
	"Return whether the receiver has a pool variable named: aString, taking into account superclasses too"
	
	self allSharedPools do: [:each | (each usesClassVarNamed: aString) ifTrue: [^true]].
	^false! !

!TClass methodsFor: '*Ring-Core-Kernel' stamp: 'SebastianTleye 7/16/2013 17:33'!
asRingDefinition
	^self explicitRequirement.! !

!TClass methodsFor: 'testing' stamp: 'ST 5/6/2013 16:07'!
hasAbstractMethods
	"Tells whether the receiver locally defines an abstract method, i.e., a method sending subclassResponsibility"
	^ super hasAbstractMethods or: [self class hasAbstractMethods]
! !

!TClass methodsFor: 'subclass creation - private' stamp: 'MartinDias 1/31/2014 16:43'!
subclass: aName uses: aTraitComposition with: aBlock 
	"Define (or redefine) a subclass by evaluating a block closure. 

	Note (MartinDias): 
		This is a workaround for the subclass creation API when a trait is specified. 
		To fix it well, in Pharo 4, a bit deeper refactoring is required, delegating this responsibility
		to SlotClassBuilder."

	^ self environment 
		at: aName
		ifPresent: [ :old | 
			| copyOfOld newClass |
			copyOfOld := old copy.

			"Modify the class and set the new trait composition"
			newClass := aBlock value. 
			newClass setTraitComposition: aTraitComposition asTraitComposition.

			"Announce that the definition changed when there is a new trait composution. 
			Note: It may be a re-announce if there was other change in the class definition, 
			e.g. an instace variable added."
			(newClass traitComposition syntacticallyEquals: copyOfOld traitComposition) ifFalse: [ 
				SystemAnnouncer uniqueInstance 
					classDefinitionChangedFrom: copyOfOld 
					to: newClass ].

			newClass ]
		ifAbsent: [
			"Create the class and set the trait composition"
			aBlock value
				setTraitComposition: aTraitComposition asTraitComposition;
				yourself ].! !

!TClass methodsFor: 'accessing' stamp: 'SebastianTleye 7/16/2013 17:31'!
name
	^self explicitRequirement.! !

!TClass methodsFor: 'accessing' stamp: 'SebastianTleye 7/12/2013 14:34'!
classPool: aDictionary
	^self explicitRequirement.! !

!TClass methodsFor: 'class variables' stamp: 'MarcusDenker 7/14/2014 09:53'!
classVariables
	"Answer the meta objects of all class variables"

	^self classPool associations! !

!TClass methodsFor: 'fileIn/Out' stamp: 'ST 5/6/2013 15:57'!
fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex 
	"File a description of the receiver on aFileStream. If the boolean argument,
	moveSource, is true, then set the trailing bytes to the position of aFileStream and
	to fileIndex in order to indicate where to find the source code."
	^self fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex initializing: true! !

!TClass methodsFor: 'instance variables' stamp: 'MartinDias 6/24/2013 15:25'!
removeInstVarNamed: aString 
	"Remove the argument, aString, as one of the receiver's instance variables."

	| newInstVarString |
	(self instVarNames includes: aString)
		ifFalse: [self error: aString , ' is not one of my instance variables'].
	newInstVarString := ''.
	(self instVarNames copyWithout: aString) do: 
		[:varName | newInstVarString := newInstVarString , ' ' , varName].
	^self classBuilder
		name: self name
		inEnvironment: self environment
		subclassOf: self superclass
		type: self typeOfClass
		instanceVariableNames: newInstVarString
		classVariableNames: self classVariablesString
		poolDictionaries: self sharedPoolsString
		category: self category! !

!TClass methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 5/27/2013 18:01'!
removeSubclass: aSubclass 
	"If the argument, aSubclass, is one of the receiver's subclasses, remove it."

	self subclasses == nil ifFalse:
		[self subclasses:  (self subclasses copyWithout: aSubclass).
		self subclasses isEmpty ifTrue: [self subclasses: nil]].! !

!TClass methodsFor: 'pool variables' stamp: 'SebastianTleye 5/24/2013 15:06'!
sharedPoolOfVarNamed: aString
	"Returns the SharedPool or nil from which the pool variable named aString is coming from."
	
	 ^ self sharedPools 
			detect: [:each | each usesClassVarNamed: aString ]
			ifNone: [
						self superclass == nil
							ifTrue: [nil]
							ifFalse: [self superclass sharedPoolOfVarNamed: aString]
						]! !

!TClass methodsFor: 'fileIn/Out' stamp: 'ST 5/6/2013 15:57'!
fileOutPool: aPool onFileStream: aFileStream 
	| aPoolName |
	(aPool  isKindOf: SharedPool class) ifTrue:[^self notify: 'we do not fileout SharedPool type shared pools for now'].
	aPoolName := self environment keyAtIdentityValue: aPool.
	self crTrace: aPoolName.
	aFileStream nextPutAll: 'Transcript show: ''' , aPoolName , '''; cr!!'; cr.
	aFileStream nextPutAll: 'Smalltalk at: #' , aPoolName , ' put: Dictionary new!!'; cr.
	aPool keys asSortedCollection do: [ :aKey | | aValue |
		aValue := aPool at: aKey.
		aFileStream nextPutAll: aPoolName , ' at: #''' , aKey asString , '''', ' put:  '.
		(aValue isKindOf: Number)
			ifTrue: [aValue printOn: aFileStream]
			ifFalse: [aFileStream nextPutAll: '('.
					aValue printOn: aFileStream.
					aFileStream nextPutAll: ')'].
		aFileStream nextPutAll: '!!'; cr].
	aFileStream cr! !

!TClass methodsFor: 'subclass creation - slots' stamp: 'MarcusDenker 1/6/2015 12:29'!
subclass: aSubclassSymbol uses: aTraitCompositionOrArray  layout: layoutClass slots: slotDefinition classVariables: classVarDefinition category: aCategorySymbol
	^ self
		subclass: aSubclassSymbol
		uses: aTraitCompositionOrArray
		with: [ 
			PharoClassInstaller
				make: [ :builder | 
					builder
						name: aSubclassSymbol;
						superclass: self;
						layoutClass: layoutClass;
						slots: slotDefinition;
						sharedVariables: classVarDefinition;
						category: aCategorySymbol ] ]! !

!TClass methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/12/2013 14:38'!
subclasses: aCollection
	^self explicitRequirement.! !

!TClass methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/24/2015 14:47'!
spotterSuperMethodsFor: aStep
	<spotterOrder: 11>
	aStep listProcessor
			title: 'Super instance methods';
			allCandidates: [ self allMethods reject: [ :each | each methodClass = self ] ];
			filter: GTFilterSubstring! !

!TClass methodsFor: '*Fuel' stamp: 'SebastianTleye 7/16/2013 17:35'!
fuelAccept: aGeneralMapper
	^self explicitRequirement.! !

!TClass methodsFor: 'testing' stamp: 'MarcusDenker 10/17/2013 12:06'!
isClassOrTrait
	^true! !

!TClass methodsFor: 'accessing' stamp: 'SebastianTleye 7/16/2013 17:24'!
environment
	^self explicitRequirement.! !

!TClass methodsFor: 'fileIn/Out' stamp: 'ST 5/6/2013 15:56'!
fileOutInitializerOn: aStream
	^self class fileOutInitializerOn: aStream! !

!TClass methodsFor: 'fileIn/Out' stamp: 'ST 5/6/2013 15:57'!
shouldFileOutPools
	"respond with true if the user wants to file out the shared pools"
	^self confirm: 'FileOut selected sharedPools?'! !

!TClass methodsFor: 'class variables' stamp: 'MarcusDenker 7/10/2014 16:23'!
classVarNames
	"Answer a collection of the names of the class variables defined in the receiver."

	^self classPool keys sort! !

!TClass methodsFor: 'fileIn/Out' stamp: 'ST 5/6/2013 15:57'!
removeFromChanges
	"References to the receiver, a class, and its metaclass should no longer be included in the system ChangeSet."

	ChangeSet current removeClassAndMetaClassChanges: self! !

!TClass methodsFor: 'subclass creation' stamp: 'MartinDias 6/24/2013 15:25'!
variableWordSubclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s category: cat
	"This is the standard initialization message for creating a new class as a 
	subclass of an existing class (the receiver) in which the subclass is to 
	have indexable word-sized nonpointer variables."
	^self classBuilder
		superclass: self
		variableWordSubclass: t
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: cat
! !

!TClass methodsFor: 'initialize-release' stamp: 'ST 6/14/2013 13:42'!
unload
	"Sent when a the class is removed.  Does nothing, but may be overridden by (class-side) subclasses."! !

!TClass methodsFor: 'compiling' stamp: 'ST 5/6/2013 15:55'!
reformatAll 
	"Reformat all methods in this class.
	Leaves old code accessible to version browsing"
	super reformatAll.		"me..."
	self class reformatAll	"...and my metaclass"! !

!TClass methodsFor: 'class variables' stamp: 'MarcusDenker 7/10/2014 16:33'!
classVarNamed: aString
	"for compatibility"

	^self readClassVariableNamed: aString! !

!TClass methodsFor: '*Monticello' stamp: 'SebastianTleye 7/16/2013 17:34'!
classDefinitions
	^self explicitRequirement.! !

!TClass methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/12/2013 14:21'!
hasClassSide
	^self classSide notNil.! !

!TClass methodsFor: 'fileIn/Out' stamp: 'ST 5/6/2013 15:57'!
hasSharedPools
	"Returns whether the receiver uses shared pools directly (Does not take into account that it may inherit shared pool uses."
	^ self sharedPools notEmpty! !

!TClass methodsFor: 'subclass creation' stamp: 'MartinDias 1/31/2014 16:05'!
subclass: aName uses: aTraitCompositionOrArray instanceVariableNames: someInstanceVariableNames classVariableNames: someClassVariableNames poolDictionaries: someSharedPoolNames category: aCategory

	^ self
		subclass: aName
		uses: aTraitCompositionOrArray
		with: [ 
			self
				subclass: aName
				instanceVariableNames: someInstanceVariableNames
				classVariableNames: someClassVariableNames
				poolDictionaries: someSharedPoolNames
				category: aCategory ]! !

!TClass methodsFor: 'subclass creation' stamp: 'MartinDias 6/24/2013 15:25'!
variableSubclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s category: cat
	"This is the standard initialization message for creating a new class as a 
	subclass of an existing class (the receiver) in which the subclass is to 
	have indexable pointer variables."
	^self classBuilder
		superclass: self
		variableSubclass: t
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: cat
! !

!TClass methodsFor: 'subclass creation - slots' stamp: 'MarcusDenker 1/6/2015 12:30'!
subclass: aSubclassSymbol uses: aTraitCompositionOrArray slots: slotDefinition classVariables: classVarDefinition category: aCategorySymbol
	^ self
		subclass: aSubclassSymbol
		uses: aTraitCompositionOrArray
		with: [ 
			PharoClassInstaller
				make: [ :builder | 
					builder
						name: aSubclassSymbol;
						superclass: self;
						slots: slotDefinition;
						sharedVariables: classVarDefinition;
						category: aCategorySymbol ] ]! !

!TClass methodsFor: '*OpalCompiler-Core' stamp: 'CamilleTeruel 9/1/2014 15:59'!
classSideCompilerClass 
	"Redefine this method if you want to customize the compiler class for class-side methods"
	^ Smalltalk compilerClass! !

!TClass methodsFor: 'class variables' stamp: 'MarcusDenker 7/10/2014 16:33'!
classVarNamed: aString put: anObject
	"for compatibility"
	
	self writeClassVariableNamed: aString value: anObject! !

!TClass methodsFor: 'pool variables' stamp: 'ST 5/7/2013 14:55'!
addSharedPool: aSharedPool 
	"Add the argument, aSharedPool, as one of the receiver's shared pools. 
	Create an error if the shared pool is already one of the pools.
	This method will work with shared pools that are plain Dictionaries or thenewer SharedPool subclasses"

	(self sharedPools includes: aSharedPool)
		ifTrue: [^self error: 'This is already in my shared pool list'].
	self sharedPools == nil
		ifTrue: [self sharedPools: (OrderedCollection with: aSharedPool)]
		ifFalse: [self sharedPools add: aSharedPool]! !

!TClass methodsFor: 'subclass creation' stamp: 'johanfabry 1/24/2014 10:43'!
weakSubclass: className instanceVariableNames: instVarNames 
	classVariableNames: classVarNames category: cat
	"Added to allow for a simplified subclass creation experience. "
	
	^ self weakSubclass: className 
		instanceVariableNames: instVarNames 
		classVariableNames: classVarNames 
		poolDictionaries: ''
		category: cat! !

!TClass methodsFor: 'subclass creation' stamp: 'ST 5/6/2013 16:06'!
subclass: t instanceVariableNames: ins
	^ self subclass: t instanceVariableNames: ins classVariableNames: '' poolDictionaries: '' category: 'Unclassified' ! !

!TClass methodsFor: 'subclass creation' stamp: 'MartinDias 1/31/2014 16:16'!
variableByteSubclass: aName uses: aTraitComposition instanceVariableNames: someInstanceVariableNames classVariableNames: someClassVariableNames poolDictionaries: someSharedPoolNames category: aCategory
	"Creates a new class as a subclass of an existing class (the receiver) 
	in which the subclass is to have indexable byte-sized nonpointer variables."
	
	^ self
		subclass: aName
		uses: aTraitComposition
		with: [ 
			self
				variableByteSubclass: aName
				instanceVariableNames: someInstanceVariableNames
				classVariableNames: someClassVariableNames
				poolDictionaries: someSharedPoolNames
				category: aCategory ]! !

!TClass methodsFor: 'copying' stamp: 'SebastianTleye 7/16/2013 17:28'!
copy
	^self explicitRequirement.! !

!TClass methodsFor: 'subclass creation' stamp: 'johanfabry 1/24/2014 10:01'!
variableByteSubclass: className instanceVariableNames: instvarNames 
	classVariableNames: classVarNames category: cat
	"Added to allow for a simplified subclass creation experience. "
	^self variableByteSubclass: className
		instanceVariableNames: instvarNames
		classVariableNames: classVarNames
		poolDictionaries: ''
		category: cat! !

!TClass methodsFor: 'accessing' stamp: 'SebastianTleye 7/12/2013 14:33'!
classPool
	^self explicitRequirement.! !

!TClass methodsFor: 'initialize-release' stamp: 'MarcusDenker 7/17/2014 17:03'!
declareClassVariables: newVars 
	"Declare class variables common to all instances. Answer whether 
	recompilation is advisable."
	|  conflicts |
	
	conflicts := false.	
	(self classVariables reject: [:x | newVars includes: x]) do: [:var | [self removeClassVariable: var] on: InMidstOfFileinNotification do: [:ex | ex resume: true]].
	
	(newVars reject: [:var | self classVariables includes: var]) do: [:var | "adding"
			"check if new vars defined elsewhere"
			(self innerBindingOf: var key) 
				ifNotNil: [(DuplicatedVariableError new) variable: var name;
						signal: var name , ' is defined elsewhere'.
					conflicts := true]].
	newVars notEmpty
		ifTrue: 
			[self classPool: self classPool.
			"in case it was nil"
			newVars do: [:var | self classPool declareVariable: var from: Undeclared]].
	^conflicts! !

!TClass methodsFor: 'subclass creation - slots' stamp: 'MarcusDenker 1/6/2015 12:29'!
subclass: aSubclassSymbol slots: slotDefinition classVariables: classVarDefinition category: aCategorySymbol

	^ PharoClassInstaller make: [ :builder |
		builder name: aSubclassSymbol;
		superclass: self;
		slots: slotDefinition;
		sharedVariables: classVarDefinition;
		category: aCategorySymbol ].
! !

!TClass methodsFor: 'fileIn/Out' stamp: 'ST 5/6/2013 15:57'!
fileOutSharedPoolsOn: aFileStream
	"file out the shared pools of this class after prompting the user about each pool"
	| poolsToFileOut |
	poolsToFileOut := self sharedPools select: 
		[:aPool | (self shouldFileOutPool: (self environment keyAtIdentityValue: aPool))].
	poolsToFileOut do: [:aPool | self fileOutPool: aPool onFileStream: aFileStream].
	! !

!TClass methodsFor: 'subclass creation' stamp: 'BenjaminVanRyseghem 1/23/2014 17:09'!
subclass: aTraitName uses: aTraitCompositionOrArray instanceVariableNames: instVarNames classVariableNames: classVarNames category: cat 

	^ self
		subclass: aTraitName
		uses: aTraitCompositionOrArray
		instanceVariableNames: instVarNames
		classVariableNames: classVarNames
		poolDictionaries: ''
		category: cat ! !

!TClass methodsFor: 'subclass creation' stamp: 'johanfabry 1/24/2014 10:04'!
variableByteSubclass: className uses: aTraitCompositionOrArray instanceVariableNames: instVarNames 
	classVariableNames: classVarNames category: cat
		"Added to allow for a simplified subclass creation experience. "
	
	^ self variableByteSubclass: className
		uses: aTraitCompositionOrArray
		instanceVariableNames: instVarNames
		classVariableNames: classVarNames 
		poolDictionaries: ''
		category: cat! !

!TClass methodsFor: 'subclass creation' stamp: 'johanfabry 1/24/2014 10:38'!
variableWordSubclass: className uses: aTraitCompositionOrArray instanceVariableNames: instVarNames
	classVariableNames: classVarNames category: cat
	"Added to allow for a simplified subclass creation experience. "

	^ self variableWordSubclass: className
		uses: aTraitCompositionOrArray
		instanceVariableNames: instVarNames
		classVariableNames: classVarNames
		poolDictionaries: ''
		category: cat! !

!TClass methodsFor: 'class variables' stamp: 'MarcusDenker 7/13/2014 13:10'!
definesClassVariable: aGlobal
	"Return whether the receiver has a class variables (shared variables among its class and subclasses) named: aString"
	
	^ self classVariables includes: aGlobal! !

!TClass methodsFor: 'self evaluating' stamp: 'ST 5/6/2013 16:05'!
isSelfEvaluating
	^self isObsolete not! !

!TClass methodsFor: '*GT-InspectorExtensions-Core' stamp: 'NicolaiHess 12/26/2014 14:11'!
gtInspectorCommentIn: composite
	"This provides an editable comment of the current class"
	<gtInspectorPresentationOrder: 20>
	composite text 
		title: 'Comment';
		display: [ self comment ];
		act: [ :text | 
			self comment: text text stamp: Author changeStamp]
			icon: GLMUIThemeExtraIcons glamorousAccept 
			on: $s
			entitled: 'Accept'! !

!TClass methodsFor: 'fileIn/Out' stamp: 'ST 5/6/2013 15:56'!
fileOut
	"Create a file whose name is the name of the receiver with '.st' as the 
	extension, and file a description of the receiver onto it."
	
	| internalStream |
	internalStream := (String new: 100) writeStream.
	internalStream header; timeStamp.

	self hasSharedPools ifTrue: [
		self shouldFileOutPools
			ifTrue: [self fileOutSharedPoolsOn: internalStream]].
	self fileOutOn: internalStream moveSource: false toFile: 0.
	internalStream trailer.

	FileStream writeSourceCodeFrom: internalStream baseName: self name isSt: true! !

!TClass methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 10/12/2014 22:32'!
gtInspectorAllReferencesOutsideIn: composite
	"This provides a list of all methods provided by the current class"
	<gtInspectorPresentationOrder: 20>
	composite list 
		title: 'All Ref Outside';
		display: [ ((SystemNavigation default allReferencesTo: self binding) 
							reject: [ :method | method package name == self package name ])
						sorted: [ :x :y | x name < y name ] ];
		format: #name;
		tags: [ :each | { each package name } ]! !

!TClass methodsFor: '*Ring-Core-Kernel' stamp: 'SebastianTleye 7/16/2013 17:33'!
asRingDefinitionWithMethods: methodsBoolean withSuperclasses: supersBoolean withSubclasses: subsBoolean withPackageKeys: packageKeys in: aRGSlice
	^self explicitRequirement.! !

!TClass classTrait methodsFor: 'inquiries' stamp: 'ST 5/6/2013 16:20'!
rootsOfTheWorld
	"return all classes that have a nil superclass"
	
	^(Smalltalk globals select: [:each | each isBehavior and: [each superclass isNil]]) asOrderedCollection! !

!TClass classTrait methodsFor: 'private' stamp: 'ST 5/6/2013 16:19'!
hasNoDependenciesFor: aClass in: unprocessedClasses cache: cache 
	^ (self hasNoSuperclassesOf: aClass in: unprocessedClasses cache: cache) and: [
		aClass isMeta not or: [
			self hasNoDependenciesForMetaclass: aClass in: unprocessedClasses cache: cache]] ! !

!TClass classTrait methodsFor: 'instance creation' stamp: 'ST 5/6/2013 16:20'!
template: aSystemCategoryName 
	"Answer an expression that can be edited and evaluated in order to define a new class."

	^ self templateForSubclassOf: Object name category: aSystemCategoryName ! !

!TClass classTrait methodsFor: 'fileIn/Out' stamp: 'ST 5/6/2013 16:19'!
doesNotIncludeInstanceOrSuperclassesFor: aClass in: unprocessedClasses cache: cache 
	| soleInstance |
	soleInstance := aClass soleInstance.
	^ (unprocessedClasses includes: soleInstance) not and: [
				self hasNoSuperclassesOf: soleInstance in: unprocessedClasses cache: cache]! !

!TClass classTrait methodsFor: 'fileIn/Out' stamp: 'ST 5/6/2013 16:20'!
superclassOrder: classes
	"Arrange the classes in the collection, classes, in superclass order so the 
	classes can be properly filed in. Do it in sets instead of ordered collections."

	| all unprocessedClasses cache |

	unprocessedClasses := classes asSet. 
	cache := Dictionary new.
	all := OrderedCollection new: unprocessedClasses size.
	unprocessedClasses size timesRepeat: [ |nextClass|
		nextClass := unprocessedClasses detect: [:aClass | self hasNoDependenciesFor: aClass in: unprocessedClasses cache: cache].
		all add: nextClass.
		unprocessedClasses remove: nextClass].
	^all! !

!TClass classTrait methodsFor: 'instance creation' stamp: 'ST 5/6/2013 16:20'!
templateForSubclassOf: priorClassName category: systemCategoryName 
	"Answer an expression that can be edited and evaluated in order to define a new class, given that the class previously looked at was as given"

	^priorClassName asString, ' subclass: #NameOfSubclass
	instanceVariableNames: ''''
	classVariableNames: ''''
	poolDictionaries: ''''
	category: ''' , systemCategoryName asString , ''''! !

!TClass classTrait methodsFor: 'fileIn/Out' stamp: 'ST 5/6/2013 16:20'!
hasNoSuperclassesOf: aClass in: unprocessedClasses cache: cache 
	^ (unprocessedClasses includesAnyOf: (self allSuperclassesFor: aClass cache: cache)) not
	! !

!TClass classTrait methodsFor: 'fileIn/Out' stamp: 'ST 5/6/2013 16:19'!
fileOutPool: aString
	"file out the global pool named aString"
	
	| internalStream |
	internalStream := (String new: 1000) writeStream.
	self new fileOutPool: (self environment at: aString asSymbol) onFileStream: internalStream.

	FileStream writeSourceCodeFrom: internalStream baseName: aString isSt: true.! !

!TClass classTrait methodsFor: 'fileIn/Out' stamp: 'ST 5/6/2013 16:20'!
hasNoDependenciesForMetaclass: aClass in: unprocessedClasses cache: cache 
	| soleInstance |
	soleInstance := aClass soleInstance.
	^ (unprocessedClasses includes: soleInstance) not and: [
				self hasNoSuperclassesOf: soleInstance in: unprocessedClasses cache: cache]! !

!TClass classTrait methodsFor: 'fileIn/Out' stamp: 'ST 5/6/2013 16:19'!
allSuperclassesFor: aClass cache: cache 	
	^ cache at: aClass ifAbsentPut: [aClass allSuperclasses asArray]! !

!TClassDescription commentStamp: 'TorstenBergmann 2/4/2014 20:37'!
Kernel trait for ClassDescription!
!TClassDescription methodsFor: 'printing' stamp: 'SebastianTleye 5/24/2013 16:28'!
instanceVariablesString
	"Answer a string of my instance variable names separated by spaces."

	^String streamContents: [ :stream |
		self instVarNames 
			do: [ :each | stream nextPutAll: each ]
			separatedBy: [ stream space ] ]! !

!TClassDescription methodsFor: 'accessing comment' stamp: 'SebastianTleye 7/9/2013 16:24'!
comment: aStringOrText
	"Set the receiver's comment to be the argument, aStringOrText."

	self instanceSide classComment: aStringOrText.! !

!TClassDescription methodsFor: 'organization updating' stamp: 'EstebanLorenzano 10/28/2014 12:19'!
notifyOfRecategorizedSelector: selector from: oldCategory to: newCategory
	"If compiled method is not there, it meens it has been removed, not recategorized... so I skip 
	 the method recategorized announce"
	(self compiledMethodAt: selector ifAbsent: [ nil ]) 
		ifNotNil: [ :method | 
			SystemAnnouncer uniqueInstance 
				methodRecategorized: method
				oldProtocol: oldCategory ].
	SystemAnnouncer uniqueInstance suspendAllWhile: [
		self 
			notifyUsersOfRecategorizedSelector: selector 
			from: oldCategory 
			to: newCategory ]! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
fileOutCategory: catName 

	| internalStream |
	internalStream := (String new: 1000) writeStream.
	internalStream header; timeStamp.
	self fileOutCategory: catName on: internalStream moveSource: false toFile: 0.
	internalStream trailer.

	^ FileStream writeSourceCodeFrom: internalStream baseName: (self name , '-' , catName) isSt: true.! !

!TClassDescription methodsFor: 'initialize-release' stamp: 'SebastianTleye 5/24/2013 16:28'!
updateInstancesFrom: oldClass
	"Recreate any existing instances of the argument, oldClass, as instances of 
	the receiver, which is a newly changed class. Permute variables as 
	necessary. Return the array of old instances (none of which should be
	pointed to legally by anyone but the array)."
	"ar 7/15/1999: The updating below is possibly dangerous. If there are any
	contexts having an old instance as receiver it might crash the system if
	the new receiver in which the context is executed has a different layout.
	See bottom below for a simple example:"
	| oldInstances |
	oldInstances := oldClass allInstances asArray.
	oldInstances := self updateInstances: oldInstances from: oldClass isMeta: self isMeta.
	^oldInstances

"	| crashingBlock class |
	class := Object subclass: #CrashTestDummy
		instanceVariableNames: 'instVar'
		classVariableNames: ''
		poolDictionaries: ''
		category: 'Crash-Test'.
	class compile:'instVar: value instVar := value'.
	class compile:'crashingBlock ^[instVar]'.
	crashingBlock := (class new) instVar: 42; crashingBlock.
	Object subclass: #CrashTestDummy
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: 'Crash-Test'.
	crashingBlock.
	crashingBlock value.
	"
! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
fileOutCategory: aSymbol on: aFileStream moveSource: moveSource toFile: fileIndex 
	"File a description of the receiver's category, aString, onto aFileStream. If 
	moveSource, is true, then set the method source pointer to the new file position.
	Note when this method is called with moveSource=true, it is condensing the
	.sources file, and should only write one preamble per method category."

	| selectors |
	aFileStream cr.
	selectors := self selectorsToFileOutCategory: aSymbol.

	"Overridden to preserve author stamps in sources file regardless"
	selectors do: [:sel |
		self printMethodChunk: sel 
			withPreamble: true
			on: aFileStream 
			moveSource: moveSource 
			toFile: fileIndex].
	^ self! !

!TClassDescription methodsFor: 'instance variables' stamp: 'MarcusDenker 6/25/2014 13:08'!
instVarNames
	"Answer an Array of the receiver's instance variable names."

	self instanceVariables
		ifNil: [^#()]
		ifNotNil: [^self instanceVariables]! !

!TClassDescription methodsFor: '*FuelTests' stamp: 'MaxLeske 11/6/2013 12:18'!
duringTestCompileSilently: code
	^ self 
		duringTestCompileSilently: code 
		storeSource: true! !

!TClassDescription methodsFor: 'accessing' stamp: 'SebastianTleye 7/4/2013 13:56'!
instanceVariables
	^self explicitRequirement.! !

!TClassDescription methodsFor: 'testing' stamp: 'SebastianTleye 7/4/2013 14:02'!
isTestCase
	^false! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
printCategoryChunk: category on: aFileStream withStamp: changeStamp priorMethod: priorMethod 
	"Print a method category preamble.  This must have a category name.
	It may have an author/date stamp, and it may have a prior source link.
	If it has a prior source link, it MUST have a stamp, even if it is empty."

"The current design is that changeStamps and prior source links are preserved in the changes file.  All fileOuts include changeStamps.  Condensing sources, however, eliminates all stamps (and links, natch)."

	aFileStream cr; nextPut: $!!.
	aFileStream nextChunkPut: (String streamContents:
		[:strm |
		strm nextPutAll: self name; nextPutAll: ' methodsFor: '; print: category asString.
		(changeStamp ~~ nil and:
			[changeStamp size > 0 or: [priorMethod ~~ nil]]) ifTrue:
			[strm nextPutAll: ' stamp: '; print: changeStamp].
		priorMethod ~~ nil ifTrue:
			[strm nextPutAll: ' prior: '; print: priorMethod sourcePointer]]).
	! !

!TClassDescription methodsFor: '*rpackage-core' stamp: 'SebastianTleye 7/12/2013 15:56'!
packageOrganizer
	"Returns the organizer of this class"
	^ RPackage organizer ! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
compileSilently: code classified: category
	"Compile the code and classify the resulting method in the given category, leaving no trail in the system log, nor in any change set, nor in the 'recent submissions' list. This should only be used when you know for sure that the compilation will succeed."

	^ self compileSilently: code classified: category notifying: nil.! !

!TClassDescription methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 5/24/2013 16:28'!
classesThatImplementAllOf: selectorSet
	"Return an array of any classes that implement all the messages in selectorSet."

	| found remaining |
	found := OrderedCollection new.
	selectorSet do:
		[:sel | (self includesSelector: sel) ifTrue: [found add: sel]].
	found isEmpty
		ifTrue: [^ self subclasses inject: Array new
						into: [:subsThatDo :sub |
							subsThatDo , (sub classesThatImplementAllOf: selectorSet)]]
		ifFalse: [remaining := selectorSet copyWithoutAll: found.
				remaining isEmpty ifTrue: [^ Array with: self].
				^ self subclasses inject: Array new
						into: [:subsThatDo :sub |
							subsThatDo , (sub classesThatImplementAllOf: remaining)]]! !

!TClassDescription methodsFor: '*NautilusRefactoring' stamp: 'SebastianTleye 8/13/2013 14:23'!
codeRewritingClass: aBuilder
	| target |
	target := aBuilder model.
	
	(aBuilder item: #'Rewrite Code')
		action: [ target refactor rewriteCode ];
		parent: #'Code Rewriting';
		order: 0.

	(aBuilder item: #'Search Code')
		action: [ target refactor searchCode ];
		parent: #'Code Rewriting';
		order: 100.
		
	(aBuilder item: #'Type class')
		action: [ target refactor typeClass ];
		parent: #'Code Rewriting';
		order: 200;
		withSeparatorAfter.
		
	(aBuilder item: #'Category Regex')
		action: [ target refactor categoryRegex ];
		parent: #'Code Rewriting';
		order: 300.
		
	(aBuilder item: #'Class Regex')
		action: [ target refactor classRegex ];
		parent: #'Code Rewriting';
		order: 400.
		
	(aBuilder item: #'Protocol Regex')
		action: [ target refactor protocolRegex ];
		parent: #'Code Rewriting';
		order: 500.
		
	(aBuilder item: #'Source Regex')
		action: [ target refactor sourceRegex ];
		parent: #'Code Rewriting';
		order: 600;
		withSeparatorAfter.! !

!TClassDescription methodsFor: 'slots' stamp: 'MarcusDenker 7/13/2014 13:05'!
definesSlotNamed: aString
	"Return true whether the receiver defines an instance variable named aString."
	
	^ self slotNames includes: aString! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
fileOutOn: aFileStream 
	"File a description of the receiver on aFileStream."

	self fileOutOn: aFileStream
		moveSource: false
		toFile: 0! !

!TClassDescription methodsFor: '*NautilusRefactoring' stamp: 'MarcusDenker 11/28/2014 10:29'!
renameMethodAllItem: aBuilder

	^ (aBuilder item: #'Rename method (all)')
			keyText: 'r, m' if: Nautilus useOldStyleKeys not;
			keyText: 'r' if: Nautilus useOldStyleKeys;
			action: [ | target |
				target := aBuilder model.
				"scroll := target methodWidget vScrollValue."
				target refactor renameMethodFor: target selectedMethod originMethod.
				"target methodWidget vScrollValue: scroll"
				 ].! !

!TClassDescription methodsFor: 'printing' stamp: 'MarcusDenker 1/8/2015 15:49'!
slotDefinitionString
	"Answer a string that contains an executable description of my Slots"

	"^self slots ifNotEmpty: [self slots asString] ifEmpty: ['{}']"
	
	^String streamContents: [ :str | | special |
		str nextPutAll: '{ '.
		self slots do: [:slot |
				str nextPutAll: slot definitionString.
				special := slot isSpecial]				
			separatedBy: [ 
				str nextPutAll: '. '.  
				special ifTrue: [ str cr;tab;tab;tab;tab ]].
		str nextPutAll: ' }'. ]
! !

!TClassDescription methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/9/2013 14:30'!
theNonMetaClass
	^self explicitRequirement.! !

!TClassDescription methodsFor: 'private' stamp: 'maxmattone 1/26/2015 14:16'!
newInstanceFrom: oldInstance variable: variable size: instSize
	"Create a new instance of the receiver based on the given old instance.
	The supplied map contains a mapping of the old instVar names into
	the receiver's instVars"

	| new  value |
	variable
		ifTrue: [ new := self basicNew: oldInstance basicSize ]
		ifFalse: [ new := self basicNew ].
		
	"Slot migration happens there"		
	self allSlots
		do: [ :newSlot | 
			oldInstance class
				slotNamed: newSlot name
				ifFound: [ :oldSlot | 
					value := oldSlot read: oldInstance.
					newSlot write: value to: new ] ].
	variable
		ifTrue: [ 1 to: oldInstance basicSize do: [ :offset | new basicAt: offset put: (oldInstance basicAt: offset) ] ].
	^ new! !

!TClassDescription methodsFor: 'initialize-release' stamp: 'VincentBlondeau 3/6/2015 17:41'!
updateInstances: oldInstances from: oldClass isMeta: isMeta
	"Recreate any existing instances of the argument, oldClass, as instances of the receiver, which is a newly changed class. Permute variables as necessary. Return the array of old instances (none of which should be pointed to legally by anyone but the array)."

	"If there are any contexts having an old instance as receiver it might crash the system because the layout has changed, and the method only knows about the old layout."

	| variable instSize newInstances |
	oldInstances isEmpty
		ifTrue: [ ^ #() ].	"no instances to convert"
	isMeta
		ifTrue: [ 
			oldInstances size = 1
				ifFalse: [ ^ self error: 'Metaclasses can only have one instance' ].
			self soleInstance class == self
				ifTrue: [ ^ self error: 'Metaclasses can only have one instance' ] ].
	variable := self isVariable.
	instSize := self instSize.
	newInstances := Array new: oldInstances size.
	1 to: oldInstances size do: [ :i | newInstances at: i put: (self newInstanceFrom: (oldInstances at: i) variable: variable size: instSize) ].	"Now perform a bulk mutation of old instances into new ones"
	oldInstances elementsExchangeIdentityWith: newInstances.
	^ newInstances	"which are now old"! !

!TClassDescription methodsFor: 'organization' stamp: 'SebastianTleye 7/9/2013 16:24'!
zapOrganization
	"Remove the organization of this class by message categories.
	This is typically done to save space in small systems.  Classes and methods
	created or filed in subsequently will, nonetheless, be organized"

	self organization: nil.
	self isClassSide ifFalse: [self classSide zapOrganization]! !

!TClassDescription methodsFor: 'slots' stamp: 'MarcusDenker 3/23/2015 14:47'!
slotNamed: aName ifFound: foundBlock ifNone: exceptionBlock
	self explicitRequirement! !

!TClassDescription methodsFor: 'initialize-release' stamp: 'ST 6/14/2013 14:22'!
superclass: aClass methodDictionary: mDict format: fmt
	"Basic initialization of the receiver"
	super superclass: aClass methodDictionary: mDict format: fmt.
	self instanceVariables: nil.
	self organization: nil.! !

!TClassDescription methodsFor: 'organization' stamp: 'MarcusDenker 10/13/2013 08:38'!
organization
	"Answer the instance of ClassOrganizer that represents the organization 
	of the messages of the receiver."

	self basicOrganization
		ifNil: [ self basicOrganization: (self isTrait
						ifTrue: [ ClassOrganization new ]
						ifFalse: [ ClassOrganization forClass: self ]) ].
	^self basicOrganization setSubject: self.	"Making sure that subject is set correctly. It should not be necessary."
	
	! !

!TClassDescription methodsFor: '*Nautilus' stamp: 'ST 8/13/2013 10:32'!
buildAnalyzeSubMenu: aBuilder
	self explicitRequirement.! !

!TClassDescription methodsFor: '*GT-Inspector-Examples' stamp: 'TudorGirba 3/28/2015 23:26'!
gtExamples

	^	self examplesProvider gtExamples! !

!TClassDescription methodsFor: 'accessing method dictionary' stamp: 'CamilleTeruel 9/4/2014 16:55'!
addSelector: selector withMethod: compiledMethod notifying: requestor
	| priorMethodOrNil oldProtocol |
	priorMethodOrNil := self compiledMethodAt: selector ifAbsent: [nil].
	oldProtocol := priorMethodOrNil ifNotNil: [ priorMethodOrNil protocol ].
	self addSelectorSilently: selector withMethod: compiledMethod.
	priorMethodOrNil 
		ifNil: [SystemAnnouncer uniqueInstance methodAdded: compiledMethod ]
		ifNotNil: [SystemAnnouncer uniqueInstance methodChangedFrom: priorMethodOrNil to: compiledMethod oldProtocol: oldProtocol ].! !

!TClassDescription methodsFor: 'accessing' stamp: 'SebastianTleye 7/12/2013 16:10'!
instanceVariables: anObject
	^self explicitRequirement.! !

!TClassDescription methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/9/2013 16:24'!
isClassSide
	^self == self classSide! !

!TClassDescription methodsFor: 'accessing method dictionary' stamp: 'StephaneDucasse 8/29/2013 19:37'!
allProtocolsUpTo: mostGenericClass
	"Answer a list of all the method protocols of the receiver and all its superclasses, up through mostGenericClass"

	| otherClassCategories thisClassCategories lowercaseSortBlock  |
		
	otherClassCategories := OrderedCollection new.
	lowercaseSortBlock  := [ :a :b | a asLowercase <= b asLowercase ].
	
	(self allSuperclassesIncluding: mostGenericClass) do: [ :aClass | 
		 otherClassCategories addAll: aClass organization categories ].
	otherClassCategories remove: 'no messages' ifAbsent: [  ].
	thisClassCategories := self organization categories sorted: lowercaseSortBlock.
													
	^ thisClassCategories , ((otherClassCategories asSet removeAllSuchThat: [ :each |
								thisClassCategories includes: each ]) sorted: lowercaseSortBlock)! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
compile: code notifying: requestor 
	"Refer to the comment in Behavior|compile:notifying:." 

	^self compile: code
		 classified: Protocol unclassified
		 notifying: requestor! !

!TClassDescription methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 16:24'!
noteAddedSelector: aSelector meta: isMeta
	"A hook allowing some classes to react to adding of certain selectors"! !

!TClassDescription methodsFor: '*System-Support' stamp: 'SebastianTleye 7/12/2013 15:59'!
allUnreferencedClassVariables
	"Answer a list of the names of all the receiver's unreferenced class vars, including those defined in superclasses"

	^ self systemNavigation allUnreferencedClassVariablesOf: self! !

!TClassDescription methodsFor: 'organization updating' stamp: 'ClementBera 7/30/2013 11:10'!
updateOrganizationDescription: each oldCategory: newCategoryOrNil newCategory: oldCategoryOrNil changed: changedCategories
	| sel effectiveCategory currentCategory |
	
	sel := each selector.
	(self includesLocalSelector: sel) ifTrue: [ ^ self ].
	
	currentCategory := self organization categoryOfElement: sel.
	effectiveCategory := each 
		effectiveMethodCategoryCurrent: currentCategory 
		new: newCategoryOrNil.
	
	effectiveCategory 
		ifNil: [ 
			currentCategory ifNotNil: [ changedCategories add: currentCategory ].
			self organization removeElement: sel.
			^ self ].
		
	(currentCategory isNil 
		or: [ currentCategory == Protocol ambiguous 
		or: [ currentCategory == oldCategoryOrNil ] ])
	ifFalse: [ ^ self ].
	
	(currentCategory ~~ effectiveCategory)
		ifTrue: [ 
			currentCategory ifNotNil: [ changedCategories add: currentCategory ].
			self organization classify: sel under: effectiveCategory suppressIfDefault: false ]! !

!TClassDescription methodsFor: 'instance variables' stamp: 'SebastianTleye 7/12/2013 16:08'!
addInstVarNamed: aString
	^self explicitRequirement.! !

!TClassDescription methodsFor: 'slots' stamp: 'MarcusDenker 3/23/2015 14:47'!
slotNamed: aName ifFound: foundBlock
	self explicitRequirement! !

!TClassDescription methodsFor: '*NautilusRefactoring' stamp: 'SebastianTleye 8/13/2013 14:24'!
methodRefactoring: aBuilder
	^self explicitRequirement.! !

!TClassDescription methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 16:24'!
copyCategory: cat from: class 
	"Specify that one of the categories of messages for the receiver is cat, as 
	found in the class, class. Copy each message found in this category."

	self copyCategory: cat
		from: class
		classified: cat! !

!TClassDescription methodsFor: 'accessing comment' stamp: 'StephaneDucasse 3/17/2015 09:31'!
classCommentBlank

	| existingComment stream |
	existingComment := self theNonMetaClass organization classComment.
	existingComment isEmpty
		ifFalse: [^existingComment].

	stream := (String new: 100) writeStream.
	
	stream nextPutAll: 'Please comment me using the following template inspired by Class Responsibility Collaborator (CRC) design:

For the Class part:  State the name of the class with one line description: For example, I''m xxx the root of the hierarchy of visitor objects.

For the Responsibility part: Three sentences about my main responsibility, what I''m doing, what services do I offer.

For the Collaborators Part: State my main collaborators and one line about how I interact with them. 

Public API and Key Messages

- message one   
- message two 
- what is the way to create instances is a plus.

   One simple example is simply gorgeous.
 
Internal Representation and Key Implementation Points.'.
			
	(self instVarNames size > 0)
		 ifTrue: [stream cr; cr; nextPutAll: '    Instance Variables'.  ].
		
	self instVarNames asSortedCollection do: [:each |
		stream
			cr; tab; nextPutAll: each;
			nextPut: $:;
			tab; tab;
			nextPutAll: '<Object>'].
	stream cr.
stream cr; cr; nextPutAll: '    Implementation Points'.
	^stream contents! !

!TClassDescription methodsFor: '*NautilusRefactoring' stamp: 'SebastianTleye 8/13/2013 14:24'!
refactoringMenu: aBuilder
	^self explicitRequirement.! !

!TClassDescription methodsFor: '*NautilusRefactoring' stamp: 'SebastianTleye 8/13/2013 14:23'!
groupRefactoring: aBuilder
	| target |
	target := aBuilder model.
	
	(aBuilder item: #'Rewrite Code')
		order:  100;
		withSeparatorAfter.
	
	(aBuilder item: #'Rewrite Code')
		action: [ target refactor rewriteCode ];
		parent: #'Rewrite Code';
		order: 0.

	(aBuilder item: #'Search Code')
		action: [ target refactor searchCode ];
		parent: #'Rewrite Code';
		order: 100.! !

!TClassDescription methodsFor: 'organization updating' stamp: 'CamilleTeruel 9/4/2014 16:56'!
noteMethodChanged: oldMethod to: newMethod
	self flag: #todo. "oldProtocol is not set properly here"
	SystemAnnouncer uniqueInstance methodChangedFrom: oldMethod to: newMethod oldProtocol: Protocol unclassified! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
methodsFor: categoryName 
	"Answer a ClassCategoryReader for compiling the messages in the category, categoryName, of the receiver."

	^ ClassCategoryReader new setClass: self category: categoryName asSymbol

	"(False methodsFor: 'logical operations') inspect"! !

!TClassDescription methodsFor: 'instance variables' stamp: 'SebastianTleye 5/24/2013 16:28'!
classThatDefinesInstanceVariable: instVarName
	(self instVarNames notNil and: [self instVarNames includes: instVarName asString]) ifTrue: [^ self]. 
	^self superclass ifNotNil: [self superclass classThatDefinesInstanceVariable: instVarName]! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
fileOutChangedMessages: aSet on: aFileStream 
	"File a description of the messages of the receiver that have been 
	changed (i.e., are entered into the argument, aSet) onto aFileStream."

	self fileOutChangedMessages: aSet
		on: aFileStream
		moveSource: false
		toFile: 0! !

!TClassDescription methodsFor: 'accessing comment' stamp: 'SebastianTleye 7/9/2013 16:24'!
hasComment
	"return whether this class truly has a comment other than the default"
	| org |
	org := self instanceSide organization.
	^org classComment isEmptyOrNil not! !

!TClassDescription methodsFor: '*NautilusRefactoring' stamp: 'SebastianTleye 8/13/2013 14:24'!
sourceCodeRefactoring: aBuilder
	| target |
	target := aBuilder model.
	
	(aBuilder item: #'Create cascade')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor createCascadeBetween: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 0.
			
	(aBuilder item: #'Extract method')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor extractBetween: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 100.
			
	(aBuilder item: #'Extract method to component')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor extractToComponentBetween: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 200.
		
	(aBuilder item: #'Extract to temporary')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor extractToTemporaryBetween: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 300.
			
	(aBuilder item: #'Inline method')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor inlineMethodBetween: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 400.
			
	(aBuilder item: #'Inline method from component')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor inlineMethodFromComponentBetween: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 500.
			
	(aBuilder item: #'Inline temporary')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor inlineTemporaryBetween: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 600.
			
	(aBuilder item: #'Move variable definition')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor moveVariableDefinitionBetween: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 700.
				
	(aBuilder item: #'Rename temporary')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor renameTemporaryNamed: target sourceTextArea selectedContents Between: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 800.	
						
	(aBuilder item: #'Split cascade')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor splitCascadeBetween: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 900.	
					
	(aBuilder item: #'Temporary to instvar')
			action: [ 
				target okToChange ifFalse: [ ^ target ].
				target refactor temporaryToInstanceVariableNamed: target sourceTextArea selectedContents asString Between: target sourceTextArea selectionInterval from: target selectedMethod ];
			parent: #'Source code refactoring';
			order: 1000;
			withSeparatorAfter.
			
		(aBuilder item: #'Undo')
			order: 1100;
			label: target refactor undoLabel;
			action: [ target refactor undoOperation ];
			enabled: target refactor undoEnabled;
			parent: #'Source code refactoring'.
	
	(aBuilder item: #'Redo')
			order: 1200;
			label: target refactor redoLabel;
			action: [ target refactor redoOperation ];
			enabled: target refactor redoEnabled;
			parent: #'Source code refactoring';
			withSeparatorAfter.! !

!TClassDescription methodsFor: 'printing' stamp: 'SebastianTleye 5/24/2013 16:28'!
classVariablesString
	"Answer a string of my class variable names separated by spaces."

	^String streamContents: [ :stream | 
		self classVarNames 
			do: [ :each | stream nextPutAll: each ]
			separatedBy: [ stream space ] ]! !

!TClassDescription methodsFor: 'instance variables' stamp: 'SebastianTleye 5/24/2013 16:28'!
hasInstVarNamed: aString
	"Return true whether the receiver defines an instance variable named aString."
	
	^ self instVarNames includes: aString! !

!TClassDescription methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/12/2013 16:47'!
addAndClassifySelector: selector withMethod: compiledMethod inProtocol: category notifying: requestor
	^self explicitRequirement.! !

!TClassDescription methodsFor: 'organization' stamp: 'SebastianTleye 7/4/2013 15:04'!
basicOrganization: aClassOrg
	^self explicitRequirement.! !

!TClassDescription methodsFor: 'organization updating' stamp: 'SebastianTleye 7/9/2013 16:24'!
applyChangesOfNewTraitCompositionReplacing: oldComposition
	| changedSelectors oldMethodDict |
	oldMethodDict := self methodDict copy.
	changedSelectors := super applyChangesOfNewTraitCompositionReplacing: oldComposition.
	self noteRecategorizedSelectors: changedSelectors oldComposition: oldComposition.
	self noteChangesFrom: oldMethodDict.
	^ changedSelectors.! !

!TClassDescription methodsFor: '*Manifest-Core' stamp: 'SebastianTleye 7/12/2013 15:53'!
manifestBuilderForRuleChecker: aRuleChecker
	"Return the manifestsince the rulechecker is keeping a cache, we ask it back"

	^ aRuleChecker manifestBuilderOfClass: self! !

!TClassDescription methodsFor: '*rpackage-core' stamp: 'SebastianTleye 7/12/2013 15:56'!
packages
	"the extending packages of a class are the packages that extend it."
	
	^  self extendingPackages asSet copy add: self package; yourself! !

!TClassDescription methodsFor: '*rpackage-core' stamp: 'SebastianTleye 7/12/2013 15:55'!
isExtended

	^ self extendingPackages isEmpty! !

!TClassDescription methodsFor: '*NautilusRefactoring' stamp: 'SebastianTleye 8/13/2013 14:17'!
instVarRefactoring: aBuilder
	^self explicitRequirement.! !

!TClassDescription methodsFor: 'slots' stamp: 'MarcusDenker 3/10/2015 12:48'!
usesSpecialSlot
	"retirn true if we define something else than InstanceVariableSlots"
	^self slots anySatisfy: [ :each | each isSpecial ]! !

!TClassDescription methodsFor: 'printing' stamp: 'SebastianTleye 7/9/2013 16:24'!
printOn: aStream 
	aStream nextPutAll: self name! !

!TClassDescription methodsFor: 'slots' stamp: 'MarcusDenker 7/2/2014 10:19'!
slotNamed: aName
	self explicitRequirement! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
compileSilently: code classified: category notifying: requestor
	"Compile the code and classify the resulting method in the given category, leaving no trail in the system log, nor in any change set, nor in the 'recent submissions' list. This should only be used when you know for sure that the compilation will succeed."

	^ SystemAnnouncer uniqueInstance 
		suspendAllWhile: [self compile: code classified: category notifying: requestor].! !

!TClassDescription methodsFor: 'organization updating' stamp: 'SebastianTleye 7/9/2013 16:24'!
noteRecategorizedSelectors: aCollection oldComposition: aTraitComposition
	
	aCollection do: [:each | | oldCategory newCategory | 
		oldCategory := self organization categoryOfElement: each.
		newCategory := (self traitComposition methodDescriptionForSelector: each) effectiveMethodCategory.
		self noteRecategorizedSelector: each from: oldCategory to: newCategory]! !

!TClassDescription methodsFor: '*rpackage-core' stamp: 'DamienPollet 9/26/2014 15:02'!
definedSelectors
	^ self package definedSelectorsForClass: self! !

!TClassDescription methodsFor: '*GT-Inspector-Examples' stamp: 'AndreiChis 1/14/2015 15:35'!
gtInspectorExamplesIn: composite
	"This provides a list of example objects for the current class"
	<gtInspectorPresentationOrder: 20>
	<gtInspectorTag: #examples>
	|exampleProvider|

	exampleProvider := self examplesProvider.
	(exampleProvider gtDisplayExamplesIn: composite)
			"when: [ self exampleProvider rootExamples notEmpty ];"
			morphicSelectionAct: [ :list | 
					list rawSelection methodReference browse ] 
				icon: GLMUIThemeExtraIcons glamorousBrowse 
				on: $b 
				entitled: 'Browse source'
! !

!TClassDescription methodsFor: 'slots' stamp: 'MarcusDenker 2/8/2015 19:25'!
hasSlot: aSlot
	"Return true whether the receivers hierarchy defines an instance variable named aString."
	
	^ self allSlots identityIncludes: aSlot! !

!TClassDescription methodsFor: 'organization updating' stamp: 'SebastianTleye 5/24/2013 16:28'!
noteMethodAdded: aMethod
	SystemAnnouncer uniqueInstance
		methodAdded: aMethod! !

!TClassDescription methodsFor: 'accessing class hierarchy' stamp: 'ST 6/14/2013 14:21'!
subclassesDo: aBlock
	"Evaluate the argument, aBlock, for each of the receiver's immediate subclasses."
	^self subclasses do: aBlock! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/12/2013 16:11'!
definition
	^self explicitRequirement.! !

!TClassDescription methodsFor: 'printing' stamp: 'SebastianTleye 7/9/2013 16:24'!
storeOn: aStream
	"Classes and Metaclasses have global names."

	aStream nextPutAll: self name! !

!TClassDescription methodsFor: 'instance variables' stamp: 'SebastianTleye 5/24/2013 16:28'!
forceNewFrom: anArray
    "Create a new instance of the class and fill
    its instance variables up with the array."
    | object max |

    object := self new.
    max := self instSize.
    anArray doWithIndex: [:each :index |
        index > max ifFalse:
            [object instVarAt: index put: each]].
    ^ object! !

!TClassDescription methodsFor: 'organization updating' stamp: 'CamilleTeruel 9/5/2014 12:12'!
noteMethodRemoved: oldMethod
	self flag: #todo. "protocol and origin are not set properly here"
	SystemAnnouncer uniqueInstance methodRemoved: oldMethod protocol: oldMethod protocol origin: oldMethod origin! !

!TClassDescription methodsFor: 'instance variables' stamp: 'ClementBera 7/30/2013 11:09'!
instVarNameForIndex: index
	"Answer the named instance variable with index index or nil if none."

	| superInstSize |
	index > self instSize ifTrue: [^nil].
	superInstSize := self superclass ifNil: [0] ifNotNil: [self superclass instSize].
	index > superInstSize ifTrue:
		[^self instanceVariables at: index - superInstSize].
	self superclass ifNil: [^nil].
	^self superclass instVarNameForIndex: index

	"(Object allSubclasses select:
		[:cls| cls instSize > cls superclass instSize and: [cls subclasses isEmpty and: [cls superclass instSize > 0]]]) collect:
			[:cls| (1 to: cls instSize) collect: [:i| cls instVarNameForIndex: i]]"! !

!TClassDescription methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 5/24/2013 16:28'!
commentInventory
	"Answer a string with a count of the classes with and without comments 
	for all the classes in the package of which this class is a member."

	"Morph commentInventory"

	^ self environment organization commentInventory: (self category copyUpTo: $-), '*'! !

!TClassDescription methodsFor: 'accessing method dictionary' stamp: 'StephaneDucasse 8/29/2013 19:26'!
removeProtocol: aString 
	"Remove each of the messages categorized under aString in the method 
	dictionary of the receiver. Then remove the category aString."
	| categoryName |
	categoryName := aString asSymbol.
	(self organization listAtCategoryNamed: categoryName) do:
		[:sel | self removeSelector: sel].
	self organization removeCategory: categoryName! !

!TClassDescription methodsFor: 'compiling' stamp: 'MarcusDenker 10/15/2014 08:53'!
compile: text classified: category withStamp: changeStamp notifying: requestor logSource: logSource
 
	| method selector |

	method := self compiler
		source: text;
		requestor: requestor;
		category: category;
		failBlock:  [ ^nil ];
		compile.
	
	selector := method selector.
	logSource ifTrue: [
		self 
			logMethodSource: (requestor ifNotNil: [ :r | r text ] ifNil: [ text ]) "the requestor text might have been changed by the compiler and may be different thant text argument"
			forMethod: method
			inCategory: category 
			withStamp: changeStamp].
		
	self 
		addAndClassifySelector: selector 
		withMethod: method 
		inProtocol: category 
		notifying: requestor.
			
	self instanceSide 
		noteCompilationOf: selector 
		meta: self isClassSide.

	^ selector! !

!TClassDescription methodsFor: '*FuelTests' stamp: 'MaxLeske 11/6/2013 12:20'!
duringTestCompileSilently: code storeSource: storeSource
	^ self
		duringTestCompileSilently: code
		storeSource: storeSource
		classified: ''! !

!TClassDescription methodsFor: 'pool variable' stamp: 'ST 6/14/2013 14:02'!
allSharedPools
	"Answer an ordered collection  of the shared pools the receiver shares, including those defined  in the superclasses of the receiver."
	
	^ OrderedCollection new! !

!TClassDescription methodsFor: 'private' stamp: 'SebastianTleye 5/24/2013 16:28'!
newInstanceFrom: oldInstance variable: variable size: instSize map: map
	"Create a new instance of the receiver based on the given old instance.
	The supplied map contains a mapping of the old instVar names into
	the receiver's instVars"
	| new |
	variable
		ifTrue: [new := self basicNew: oldInstance basicSize]
		ifFalse: [new := self basicNew].
	1 to: instSize do: 
		[:offset |  (map at: offset) > 0 ifTrue:
			[new instVarAt: offset
					put: (oldInstance instVarAt: (map at: offset))]].
	variable 
		ifTrue: [1 to: oldInstance basicSize do: 
					[:offset |
					new basicAt: offset put: (oldInstance basicAt: offset)]].
	^new! !

!TClassDescription methodsFor: 'organization updating' stamp: 'SebastianTleye 7/12/2013 16:46'!
updateOrganizationSelector: aSymbol oldCategory: oldCategoryOrNil newCategory: newCategoryOrNil
	^self explicitRequirement.! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
selectorsToFileOutCategory: aSymbol
	^ self organization listAtCategoryNamed: aSymbol! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
wantsChangeSetLogging
	"Answer whether code submitted for the receiver should be remembered by the changeSet mechanism."

	^ true! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
moveChangesTo: newFile 
	"Used in the process of condensing changes, this message requests that 
	the source code of all methods of the receiver that have been changed 
	should be moved to newFile."

	| changes |
	changes := self selectors select: [:sel | (self compiledMethodAt: sel) fileIndex > 1 ].
	self
		fileOutChangedMessages: changes
		on: newFile
		moveSource: true
		toFile: 2! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
compile: text classified: category notifying: requestor
	| stamp |
	stamp := self acceptsLoggingOfCompilation
		ifTrue: [ Author changeStamp ]
		ifFalse: [ nil ].
	^ self
		compile: text
		classified: category
		withStamp: stamp
		notifying: requestor! !

!TClassDescription methodsFor: 'private' stamp: 'SebastianTleye 5/24/2013 16:28'!
linesOfCode 
	"An approximate measure of lines of code.
	Includes comments, but excludes blank lines."
	| lines |
	lines := self localMethods inject: 0 into: [:sum :each | sum + each linesOfCode]. 
	^ self isMeta 
		ifTrue: [lines]
		ifFalse: [lines + self class linesOfCode]! !

!TClassDescription methodsFor: 'printing' stamp: 'MaxLeske 9/28/2014 22:10'!
sharedPoolsString
	"Answer a string of my shared pool names separated by spaces."

	^String streamContents: [ :stream |
		self sharedPools 
			do: [ :each |
				stream nextPutAll: (self environment 
					keyAtIdentityValue: each 
					ifAbsent: [ 
						each isObsolete
							ifTrue: [ each name ] "obsolete classes should be visible"
							ifFalse: [ 'private' ] ]) ] "if class is from different environment, mark it as private"
			separatedBy: [ stream space ] ]! !

!TClassDescription methodsFor: '*NautilusRefactoring' stamp: 'SebastianTleye 8/13/2013 14:23'!
refactoringMethod: aBuilder

	(aBuilder item: #'Refactoring')
		order: -100.
			
	(self renameMethodAllItem: aBuilder)
		order: -90;
		withSeparatorAfter! !

!TClassDescription methodsFor: 'users notification' stamp: 'VincentBlondeau 3/6/2015 16:40'!
notifyUsersOfRecategorizedSelector: element from: oldCategory to: newCategory
	self traitUsers do: [:each |
		each noteRecategorizedSelector: element from: oldCategory to: newCategory]! !

!TClassDescription methodsFor: 'organization' stamp: 'SebastianTleye 7/9/2013 16:24'!
addCategory: newName before: aCategory

	^ self organization addCategory: newName before: aCategory ! !

!TClassDescription methodsFor: '*NautilusRefactoring' stamp: 'RobertPergl 3/26/2015 17:34'!
sourceCodeRefactoringMenu: aBuilder
	| target |
	target := aBuilder model.
	
	(aBuilder item: #'Format')
		order: 1100;
		keyText: 'Shift f';
		action: [ target refactor formatSourceCode ].
		
	(aBuilder item: #'Source code refactoring')
			order: 1101;
			arguments: {};
			withSeparatorAfter.! !

!TClassDescription methodsFor: '*NautilusRefactoring' stamp: 'SebastianTleye 8/13/2013 14:21'!
varRefactoringSubMenu: aBuilder
	^self explicitRequirement.! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
noteCompilationOf: aSelector meta: isMeta
	"A hook allowing some classes to react to recompilation of certain selectors"! !

!TClassDescription methodsFor: '*GT-Inspector-Examples' stamp: 'TudorGirba 3/28/2015 23:26'!
examplesProvider

	^ GTExampleProvider on: self! !

!TClassDescription methodsFor: 'accessing method dictionary' stamp: 'StephaneDucasse 8/29/2013 20:39'!
allSelectorsInProtocol: aName 
	"Answer a list of all the methods of the receiver and all its 
	superclasses that are in the protocol named aName"
	
	| aColl |
	aColl := OrderedCollection new.
	self withAllSuperclasses do: [:aClass | 
		aColl addAll: (aClass organization listAtCategoryNamed: aName) ].
	^ aColl asSet asArray sort! !

!TClassDescription methodsFor: '*rpackage-core' stamp: 'SebastianTleye 7/12/2013 15:57'!
packagesWithoutExtensions
	^ Set new add: self package; yourself.! !

!TClassDescription methodsFor: 'instance variables' stamp: 'MarcusDenker 6/25/2014 13:10'!
instVarIndexFor: instVarName ifAbsent: aBlock
	"Answer the index of the named instance variable."

	| index |
	index := self instanceVariables == nil 
			ifTrue: [0]
			ifFalse: [self instanceVariables indexOf: instVarName ifAbsent: [0]].
	index = 0 ifTrue: 
		[^self superclass == nil 
			ifTrue: [aBlock value]
			ifFalse: [self superclass instVarIndexFor: instVarName ifAbsent: aBlock]].
	^self superclass == nil 	
		ifTrue: [index]
		ifFalse: [index + self superclass instSize]! !

!TClassDescription methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 16:24'!
copyCategory: cat from: aClass classified: newCat 
	"Specify that one of the categories of messages for the receiver is the 
	third argument, newCat. Copy each message found in the category cat in 
	class aClass into this new category."

	self copyAll: (aClass organization listAtCategoryNamed: cat)
		from: aClass
		classified: newCat! !

!TClassDescription methodsFor: 'slots' stamp: 'MarcusDenker 7/2/2014 10:16'!
slots
	self explicitRequirement! !

!TClassDescription methodsFor: '*Nautilus' stamp: 'MarcusDenker 7/4/2014 16:36'!
definitionForNautilusWithSlots

	^ self definition! !

!TClassDescription methodsFor: 'organization' stamp: 'SebastianTleye 7/9/2013 16:24'!
whichCategoryIncludesSelector: aSelector 
	"Answer the category of the argument, aSelector, in the organization of 
	the receiver, or answer nil if the receiver does not inlcude this selector."

	(self includesSelector: aSelector)
		ifTrue: [^ self organization categoryOfElement: aSelector]
		ifFalse: [^nil]! !

!TClassDescription methodsFor: 'accessing comment' stamp: 'SebastianTleye 7/9/2013 16:24'!
comment
	"Answer the receiver's comment. (If missing, supply a template) "
	| aString |
	aString := self instanceSide organization classComment.
	aString isEmpty ifFalse: [^ aString].
	^self classCommentBlank! !

!TClassDescription methodsFor: 'pool variable' stamp: 'SebastianTleye 7/4/2013 15:23'!
usesLocalPoolVarNamed: aString
	^false.! !

!TClassDescription methodsFor: 'filein/out' stamp: 'MarcusDenker 7/5/2014 18:58'!
classComment: aString stamp: aStamp
	"Store the comment, aString or Text or RemoteString, associated with the class we are organizing.  Empty string gets stored only if had a non-empty one before."

	| pointer header file oldCommentRemoteString oldComment oldStamp |
	oldComment := self organization classComment.
	oldStamp := self organization commentStamp.

	(aString isKindOf: RemoteString) ifTrue: [
		SystemAnnouncer uniqueInstance 
			class: self 
			oldComment: oldComment 
			newComment: aString string 
			oldStamp: oldStamp 
			newStamp: aStamp.
		^ self organization classComment: aString stamp: aStamp].

	oldCommentRemoteString := self organization commentRemoteString.
	(aString size = 0) & (oldCommentRemoteString isNil) ifTrue: [^ self organization classComment: nil].
		"never had a class comment, no need to write empty string out"

	pointer := oldCommentRemoteString 
			ifNil: [0] 
			ifNotNil: [oldCommentRemoteString sourcePointer].
	
	(file := SourceFiles at: 2) ifNotNil: [
		file setToEnd; cr; nextPut: $!!.	"directly"
		"Should be saying (file command: 'H3') for HTML, but ignoring it here"
		header := String streamContents: [:strm | strm nextPutAll: self name;
			nextPutAll: ' commentStamp: '.
			aStamp storeOn: strm.
			strm nextPutAll: ' prior: '; nextPutAll: pointer printString].
		file nextChunkPut: header].
	
	self organization 
		classComment: (RemoteString newString: aString onFileNumber: 2) 
		stamp: aStamp.
	
	SystemAnnouncer uniqueInstance 
		class: self 
		oldComment: oldComment 
		newComment: aString 
		oldStamp: oldStamp 
		newStamp: aStamp! !

!TClassDescription methodsFor: '*rpackage-core' stamp: 'SebastianTleye 7/12/2013 15:56'!
package
	^ RPackage organizer packageOf: self.	! !

!TClassDescription methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 5/24/2013 16:28'!
printSubclassesOn: aStream level: level 
	"As part of the algorithm for printing a description of the receiver, print the
	subclass on the file stream, aStream, indenting level times."

	| subclassNames |
	aStream crtab: level.
	aStream nextPutAll: self name.
	aStream space; print: self instVarNames.
	self == Class
		ifTrue: 
			[aStream crtab: level + 1; nextPutAll: '[ ... all the Metaclasses ... ]'.
			^self].
	subclassNames := self subclasses asSortedCollection:[:c1 :c2| c1 name <= c2 name].
	"Print subclasses in alphabetical order"
	subclassNames do:
		[:subclass | subclass printSubclassesOn: aStream level: level + 1]! !

!TClassDescription methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 16:24'!
copyAll: selArray from: class 
	"Install all the methods found in the method dictionary of the second 
	argument, class, as the receiver's methods. Classify the messages under 
	-As yet not classified-."

	self copyAll: selArray
		from: class
		classified: nil! !

!TClassDescription methodsFor: 'accessing method dictionary' stamp: 'StephaneDucasse 8/29/2013 19:24'!
uncategorizedSelectors
	^ self selectorsInProtocol: Protocol unclassified! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
compile: code classified: heading 
	"Compile the argument, code, as source code in the context of the 
	receiver and install the result in the receiver's method dictionary under 
	the classification indicated by the second argument, heading. nil is to be 
	notified if an error occurs. The argument code is either a string or an 
	object that converts to a string or a PositionableStream on an object that 
	converts to a string."

	^self
		compile: code
		classified: heading
		notifying: nil! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 5/24/2013 16:30'!
instVarNamesAndOffsetsDo: aBinaryBlock
	"This is part of the interface between the compiler and a class's instance or field names.
	 The class should enumerate aBinaryBlock with the instance variable name strings and
	 their integer offsets.  The order is important. Names evaluated later will override the
	 same names occurring earlier."

	| superInstSize |
	(superInstSize := self superclass notNil ifTrue: [self superclass instSize] ifFalse: [0]) > 0 ifTrue:
		[self superclass instVarNamesAndOffsetsDo: aBinaryBlock].
	1 to: self instSize - superInstSize do:
		[:i| aBinaryBlock value: (self instanceVariables at: i) value: i + superInstSize]! !

!TClassDescription methodsFor: 'accessing comment' stamp: 'SebastianTleye 7/9/2013 16:24'!
comment: aStringOrText stamp: aStamp
	"Set the receiver's comment to be the argument, aStringOrText."

	self instanceSide classComment: aStringOrText stamp: aStamp.! !

!TClassDescription methodsFor: 'private' stamp: 'SebastianTleye 5/24/2013 16:28'!
instVarMappingFrom: oldClass
	"Return the mapping from instVars of oldClass to new class that is used for converting old instances of oldClass."
	| oldInstVarNames |
	oldInstVarNames := oldClass allInstVarNames.
	^self allInstVarNames 
			collect: [:instVarName | oldInstVarNames indexOf: instVarName].! !

!TClassDescription methodsFor: 'accessing method dictionary' stamp: 'CamilleTeruel 9/5/2014 12:12'!
removeSelector: selector 
	"Remove the message whose selector is given from the method 
	dictionary of the receiver, if it is there. Answer nil otherwise."
	
	| priorMethod priorProtocol origin | 
	priorMethod := self compiledMethodAt: selector ifAbsent: [^ nil].
	origin := priorMethod origin.
	priorProtocol := self whichCategoryIncludesSelector: selector.
	super removeSelector: selector.
	SystemAnnouncer uniqueInstance 
		suspendAllWhile: [self updateOrganizationSelector: selector oldCategory: priorProtocol newCategory: nil].
	SystemAnnouncer uniqueInstance methodRemoved: priorMethod protocol: priorProtocol origin: origin! !

!TClassDescription methodsFor: '*NautilusCommon' stamp: 'SebastianTleye 7/9/2013 16:24'!
correspondingForTest
	"Return the unit test that correspond to me. If it does not exist, it returns myself. 
	 Return the tested class if sent to a class"
	
	| className |
	className := (self inheritsFrom: TestCase)
		ifTrue: [ self name copyReplaceAll: 'Test' with: '' ]
		ifFalse: [ self name, 'Test' ].
	^ Smalltalk 
		at: className asSymbol 
		ifAbsent: [ self ]
	! !

!TClassDescription methodsFor: 'initialize-release' stamp: 'SebastianTleye 5/24/2013 16:30'!
obsolete
	"Make the receiver obsolete."
	self superclass removeSubclass: self.
	self organization: nil.
	super obsolete.! !

!TClassDescription methodsFor: 'private' stamp: 'SebastianTleye 7/9/2013 16:24'!
errorCategoryName
	self error: 'Category name must be a String'! !

!TClassDescription methodsFor: '*NautilusRefactoring' stamp: 'SebastianTleye 8/13/2013 14:23'!
packageRefactoringMenu: aBuilder
	| target |
	target := aBuilder model.
	
	(aBuilder item: #'Rewrite Code')
		order:  100;
		withSeparatorAfter.
	
	(aBuilder item: #'Rewrite Code')
		action: [ target refactor rewriteCode ];
		parent: #'Rewrite Code';
		order: 0.

	(aBuilder item: #'Search Code')
		action: [ target refactor searchCode ];
		parent: #'Rewrite Code';
		order: 100.! !

!TClassDescription methodsFor: 'organization updating' stamp: 'SebastianTleye 7/9/2013 16:24'!
noteRecategorizedSelector: aSymbol from: oldCategoryOrNil to: newCategoryOrNil
	| changedCategories |
	changedCategories := self updateOrganizationSelector: aSymbol oldCategory: oldCategoryOrNil newCategory: newCategoryOrNil.
	changedCategories do: [:each |
		(self organization isEmptyCategoryNamed: each) ifTrue: [self organization removeCategory: each]]! !

!TClassDescription methodsFor: 'organization' stamp: 'ST 5/31/2013 16:09'!
organization: aClassOrg
	"Install an instance of ClassOrganizer that represents the organization of the messages of the receiver."

	aClassOrg ifNotNil: [aClassOrg setSubject: self].
	self basicOrganization: aClassOrg.! !

!TClassDescription methodsFor: 'instance variables' stamp: 'MarcusDenker 6/25/2014 13:10'!
instVarIndexFor: instVarName
	"Answer the index of the named instance variable."

	^self instVarIndexFor: instVarName ifAbsent: 0! !

!TClassDescription methodsFor: '*Nautilus' stamp: 'MarcusDenker 1/21/2014 13:38'!
definitionForNautilus

	^ self definition! !

!TClassDescription methodsFor: '*Manifest-Core' stamp: 'SebastianTleye 7/12/2013 15:52'!
criticClass
	"Return the class of the receiver for the critic browser. This behavior may be folded later by changing the name of this method or using another one."
	
	^ self! !

!TClassDescription methodsFor: 'slots' stamp: 'MarcusDenker 3/2/2015 20:52'!
allSlotsEverywhere
	"Answer the set of slots used by the receiver, all superclasses, and all subclasses"

	| aList |
	aList := OrderedCollection new.
	(self allSuperclasses , self withAllSubclasses asOrderedCollection) do:
		[:cls | aList addAll: cls slots].
	^ aList asSet! !

!TClassDescription methodsFor: 'accessing method dictionary' stamp: 'StephaneDucasse 8/29/2013 17:21'!
selectorsInCategory: aName 
	"Answer a list of the selectors of the receiver that are in category named aName"
	
	| aColl |
	aColl := Set withAll: (self organization listAtCategoryNamed: aName).
	^ aColl asArray sort! !

!TClassDescription methodsFor: '*GT-InspectorExtensions-Core' stamp: 'AndreiChis 1/8/2015 16:31'!
gtInspectorUsersIn: composite
	<gtInspectorPresentationOrder: 30>
	composite list 	
		title: 'Users';
		when: [ self isTrait ];
		display: [ 
			self traitUsers asArray
			"Smalltalk allClasses select: [ :class |
			   class traitComposition traits includes: self ]" ]! !

!TClassDescription methodsFor: 'filein/out' stamp: ''!
fileOutMethod: selector on: aStream
	
	(selector == #Comment) ifTrue: [^ self inform: 'Sorry, cannot file out class comment in isolation.'].
	(self includesSelector: selector) ifFalse: [^ self error: 'Selector ', selector asString, ' not found'].
	aStream header; timeStamp.
	self printMethodChunk: selector withPreamble: true
		on: aStream moveSource: false toFile: 0.! !

!TClassDescription methodsFor: '*rpackage-core' stamp: 'DamienPollet 9/26/2014 16:00'!
extensionSelectors
	^ self extendingPackages flatCollect: [ :each | each extensionSelectorsForClass: self ]! !

!TClassDescription methodsFor: '*Manifest-Core' stamp: 'SebastianTleye 7/12/2013 15:53'!
mcWorkingCopy
	MCWorkingCopy managersForClass:  self do: [: package | ^ package ]! !

!TClassDescription methodsFor: 'slots' stamp: 'MarcusDenker 7/2/2014 10:16'!
allSlots
	self explicitRequirement! !

!TClassDescription methodsFor: '*Glamour-Morphic-Brick' stamp: 'AndreiChis 3/24/2015 19:21'!
slotsDictionary
	^ self isTrait 
		ifTrue: [ Dictionary new ]
		ifFalse: [ self layout slotsDictionary ]! !

!TClassDescription methodsFor: 'authors' stamp: 'MarcusDenker 10/13/2013 11:16'!
authors
	"Returns a bag representing the author frequency based on the latest version of the methods of the receiver."

	^(self methods, self class methods) collect: [ :each | each author ] as: Bag .
	
	! !

!TClassDescription methodsFor: 'organization' stamp: 'SebastianTleye 7/9/2013 16:24'!
reorganize
	"During fileIn, !!Rectangle reorganize!! allows Rectangle to seize control and treat the next chunk as its organization.  See the transfer of control where ReadWriteStream fileIn calls scanFrom:"

	^self organization! !

!TClassDescription methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 16:24'!
copyAllCategoriesFrom: aClass 
	"Specify that the categories of messages for the receiver include all of 
	those found in the class, aClass. Install each of the messages found in 
	these categories into the method dictionary of the receiver, classified 
	under the appropriate categories."

	aClass organization categories do: [:cat | self copyCategory: cat from: aClass]! !

!TClassDescription methodsFor: 'instance variables' stamp: 'SebastianTleye 5/24/2013 16:28'!
allInstVarNamesEverywhere
	"Answer the set of inst var names used by the receiver, all superclasses, and all subclasses"

	| aList |
	aList := OrderedCollection new.
	(self allSuperclasses , self withAllSubclasses asOrderedCollection) do:
		[:cls | aList addAll: cls instVarNames].
	^ aList asSet

	"BorderedMorph allInstVarNamesEverywhere"! !

!TClassDescription methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 16:24'!
copy: sel from: class 
	"Install the method associated with the first argument, sel, a message 
	selector, found in the method dictionary of the second argument, class, 
	as one of the receiver's methods. Classify the message under -As yet not 
	classified-."

	self copy: sel
		from: class
		classified: nil! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
commentStamp: changeStamp prior: indexAndOffset
	"Prior source link ignored when filing in."

	^ ClassCommentReader new setClass: self
				category: #Comment
				changeStamp: changeStamp! !

!TClassDescription methodsFor: 'pool variable' stamp: 'SebastianTleye 5/24/2013 16:28'!
usesPoolVarNamed: aString
	"Only classes may use a pool variable named: aString"
	
	^ false! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
fileOutMethod: selector
	"Write source code of a single method on a file.  Make up a name for the file."
	
	| internalStream |
	internalStream := (String new: 1000) writeStream.
	self fileOutMethod: selector on: internalStream.
	FileStream writeSourceCodeFrom: internalStream baseName: (self name , '-' , (selector copyReplaceAll: ':' with: '')) isSt: true.! !

!TClassDescription methodsFor: 'users notification' stamp: 'VincentBlondeau 3/6/2015 16:40'!
notifyUsersOfChangedSelectors: aCollection
	self traitUsers do: [:each |
		each noteChangedSelectors: aCollection]! !

!TClassDescription methodsFor: 'instance variables' stamp: 'SebastianTleye 5/24/2013 16:28'!
classThatDefinesClassVariable: classVarName
	"Answer the class that defines the given class variable"

	(self classPool includesKey: classVarName asSymbol) ifTrue: [^ self]. 
	^self superclass ifNotNil: [self superclass classThatDefinesClassVariable: classVarName]! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
logMethodSource: aText forMethod: aCompiledMethod inCategory: category withStamp: changeStamp
	aCompiledMethod
		putSource: aText
		class: self
		category: category
		withStamp: changeStamp 
		inFile: 2
		priorMethod: (self
					compiledMethodAt: aCompiledMethod selector
					ifAbsent: [])! !

!TClassDescription methodsFor: 'organization' stamp: 'SebastianTleye 7/4/2013 15:03'!
basicOrganization
	^self explicitRequirement.! !

!TClassDescription methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 16:24'!
copyAll: selArray from: class classified: cat 
	"Install all the methods found in the method dictionary of the second 
	argument, class, as the receiver's methods. Classify the messages under 
	the third argument, cat."

	selArray do: [:s |
		(class includesLocalSelector: s) ifTrue: [
			self copy: s
				from: class
				classified: cat ] ]! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
acceptsLoggingOfCompilation
	"Answer whether the receiver's method submisions and class defintions should be logged to the changes file and to the current change set.  The metaclass follows the rule of the class itself
	Weird name is so that it will come lexically before #compile, so that a clean build can make it through."

	^ true! !

!TClassDescription methodsFor: 'filein/out' stamp: 'NicolaiHess 4/9/2014 14:35'!
fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex
	"File a description of the receiver on aFileStream. If the boolean 
	argument, moveSource, is true, then set the trailing bytes to the position 
	of aFileStream and to fileIndex in order to indicate where to find the 
	source code."

	aFileStream nextChunkPut: self definition.

	self organization
		putCommentOnFile: aFileStream
		numbered: fileIndex
		moveSource: moveSource
		forClass: self.
	self organization realCategories do: 
		[:heading |
		self fileOutCategory: heading
			on: aFileStream
			moveSource: moveSource
			toFile: fileIndex]! !

!TClassDescription methodsFor: 'pool variable' stamp: 'ST 6/14/2013 14:20'!
sharedPoolOfVarNamed: aString
	"Only classes may have shared pools"
	
	^ nil! !

!TClassDescription methodsFor: 'private' stamp: 'CamilleTeruel 9/5/2014 16:40'!
notifyRepackage: selector method: compiledMethod oldProtocol: oldProtocol newProtocol: newProtocol
	| oldPackage newPackage |
	
	(newProtocol = oldProtocol)
		ifTrue: [ ^ self ].
		
	"This indirection is because we need to abstract RPackage from the kernel"
	#RPackage asClassIfPresent: [ :rPackageClass | 
			newPackage := rPackageClass organizer 
				packageForProtocol: newProtocol 
				inClass: self.
			oldPackage := rPackageClass organizer 
				packageForProtocol: oldProtocol 
				inClass: self.
			
			"Announce recategorization"
			newPackage = oldPackage
				ifFalse: [ 
					SystemAnnouncer uniqueInstance 
						methodRepackaged: compiledMethod 
						from: oldPackage 
						to: newPackage ] ].	
	
	SystemAnnouncer uniqueInstance methodRecategorized: compiledMethod oldProtocol: oldProtocol! !

!TClassDescription methodsFor: '*rpackage-core' stamp: 'SebastianTleye 7/12/2013 15:55'!
isDefinedInPackage: aPackage
	"returns true if aPackage contains the definitino of this class"
	
	^ aPackage includesClass: self.! !

!TClassDescription methodsFor: 'filein/out' stamp: 'NicolaiHess 4/9/2014 14:35'!
fileOutChangedMessages: aSet on: aFileStream moveSource: moveSource toFile: fileIndex 
	"File a description of the messages of this class that have been 
	changed (i.e., are entered into the argument, aSet) onto aFileStream.  If 
	moveSource, is true, then set the method source pointer to the new file position.
	Note when this method is called with moveSource=true, it is condensing the
	.changes file, and should only write a preamble for every method."
	| org |
	(org := self organization) realCategories do: 
		[:cat | | sels | 
		sels := (org listAtCategoryNamed: cat) select: [:sel | aSet includes: sel].
		sels do:
			[:sel |  self printMethodChunk: sel withPreamble: true on: aFileStream
							moveSource: moveSource toFile: fileIndex]]! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
classComment: aString
	"Store the comment, aString or Text or RemoteString, associated with the class we are orgainzing.  Empty string gets stored only if had a non-empty one before."
	^ self classComment: aString stamp: '<historical>'! !

!TClassDescription methodsFor: 'instance variables' stamp: 'SebastianTleye 7/17/2013 11:46'!
removeInstVarNamed: aString 
	"Remove the argument, aString, as one of the receiver's instance 
	variables. Create an error notification if the argument is not found."

	^self subclassResponsibility! !

!TClassDescription methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 16:24'!
copy: sel from: class classified: cat 
	"Install the method associated with the first arugment, sel, a message 
	selector, found in the method dictionary of the second argument, class, 
	as one of the receiver's methods. Classify the message under the third 
	argument, cat."

	| code category |
	"Useful when modifying an existing class"
	code := class sourceCodeAt: sel.
	code ifNotNil: 
			[cat
				ifNil: [category := class organization categoryOfElement: sel]
				ifNotNil: [category := cat].
			(self includesLocalSelector: sel)
				ifTrue: [code asString = (self sourceCodeAt: sel) asString 
							ifFalse: [self error: self name 
										, ' ' 
										, sel 
										, ' will be redefined if you proceed.']].
			self compile: code classified: category]! !

!TClassDescription methodsFor: '*rpackage-core' stamp: 'SebastianTleye 7/12/2013 15:55'!
compileSilently: code 
	"Compile the code and classify the resulting method in the given category, leaving no trail in the system log, nor in any change set, nor in the 'recent submissions' list. This should only be used when you know for sure that the compilation will succeed."

	^ self compileSilently: code classified: 'not defined category' notifying: nil.! !

!TClassDescription methodsFor: '*NautilusRefactoring' stamp: 'SebastianTleye 8/13/2013 14:24'!
refactoringSubmenu: aBuilder
	^self explicitRequirement.! !

!TClassDescription methodsFor: '*Manifest-Core' stamp: 'SebastianTleye 7/12/2013 15:52'!
criticNameOn: aStream
	"This behavior may be folded later by changing the name of this method or using another one."
	
	aStream 
		<< self name 
		<< ' (' 
		<< self category 
		<< ')' ! !

!TClassDescription methodsFor: '*rpackage-core' stamp: 'SebastianTleye 7/12/2013 15:55'!
extendingPackages
	"the extending packages of a class are the packages that extend it."
	^ RPackage organizer extendingPackagesOf: self! !

!TClassDescription methodsFor: 'organization updating' stamp: 'EstebanLorenzano 6/26/2013 12:48'!
updateOrganizationDescription: aTraitMethodDescription oldCategory: oldCategoryOrNil newCategory: newCategoryOrNil changedCategories: changedCategories
	| sel effectiveCategory currentCategory |
	sel := aTraitMethodDescription selector.
	
	(self includesLocalSelector: sel) ifTrue: [ ^ self ].
	 
	currentCategory := self organization categoryOfElement: sel.
	effectiveCategory := aTraitMethodDescription effectiveMethodCategoryCurrent: currentCategory new: newCategoryOrNil.
	
	effectiveCategory ifNil: [ 
		currentCategory ifNotNil: [ changedCategories add: currentCategory ].
		^ self organization removeElement: sel ].
		
	((currentCategory isNil 
		or: [ 
				currentCategory == Protocol ambiguous 
				or: [ currentCategory == oldCategoryOrNil ] ])
		and: [ currentCategory ~~ effectiveCategory ])
		ifTrue: [ 
			currentCategory ifNotNil: [ changedCategories add: currentCategory ].
			self organization classify: sel under: effectiveCategory suppressIfDefault: false ]! !

!TClassDescription methodsFor: '*Fuel' stamp: 'SebastianTleye 7/12/2013 15:51'!
instanceVariableNamesDo: anUnaryBlock
	"This is part of the interface between the compiler and a class's instance or field names.
	 The class should enumerate anUnaryBlock with the instance variable name strings.  The order is important. Names evaluated later will override the
	 same names occurring earlier."

	| superInstSize |
	(superInstSize := self superclass notNil ifTrue: [self superclass instSize] ifFalse: [0]) > 0 ifTrue:
		[self superclass instanceVariableNamesDo: anUnaryBlock].
	1 to: self instSize - superInstSize do:
		[:i| anUnaryBlock value: (self instanceVariables at: i)]! !

!TClassDescription methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/9/2013 14:29'!
theMetaClass
	^self explicitRequirement.! !

!TClassDescription methodsFor: 'accessing method dictionary' stamp: 'StephaneDucasse 8/29/2013 17:24'!
selectorsInProtocol: aName 
	"Answer a list of the selectors of the receiver that are in category named aName"
	
	| aColl |
	aColl := Set withAll: (self organization listAtCategoryNamed: aName).
	^ aColl asArray sort! !

!TClassDescription methodsFor: '*FuelTests' stamp: 'MaxLeske 11/6/2013 12:20'!
duringTestCompileSilently: code classified: aCategory
	^ self 
		duringTestCompileSilently: code
		storeSource: true
		classified: aCategory! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
reformatAll
	"Reformat all methods in this class"
	self methods do: [:method | method reformat]! !

!TClassDescription methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/9/2013 16:24'!
isInstanceSide
	^self isClassSide not! !

!TClassDescription methodsFor: '*FuelTests' stamp: 'MaxLeske 11/6/2013 12:21'!
duringTestCompileSilently: code storeSource: storeSource classified: aCategory
	^ Author 
		useAuthor: 'TestsAuthor'
		during: [ [
			self 
				compile: code
				classified: (aCategory ifNil: [ '' ])
				withStamp: nil 
				notifying: nil 
				logSource: storeSource ] fuelValueWithoutNotifications ]! !

!TClassDescription methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/16/2013 17:16'!
hasClassSide
	^self subclassResponsibility.! !

!TClassDescription methodsFor: 'pool variable' stamp: 'ST 6/14/2013 14:03'!
hasSharedPools
	"Only a class may have shared pools"
	^ false! !

!TClassDescription methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/4/2013 14:28'!
instanceSide
	^ self theNonMetaClass! !

!TClassDescription methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 2/26/2015 21:01'!
spotterPackageFor: aStep
	<spotterOrder: 50>
	aStep listProcessor
			title: 'Package';
			allCandidates: [ {self package} ];
			itemName: [ :item | item packageName ];
			itemIcon: #systemIcon;
			filter: GTFilterSubstring! !

!TClassDescription methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/9/2013 16:24'!
isMeta
	^self isClassSide! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
commentStamp: changeStamp
	self organization commentStamp: changeStamp.
	^ self commentStamp: changeStamp prior: 0! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
compile: text classified: category withStamp: changeStamp notifying: requestor
	^ self
		compile: text
		classified: category
		withStamp: changeStamp
		notifying: requestor
		logSource: self acceptsLoggingOfCompilation! !

!TClassDescription methodsFor: 'filein/out' stamp: 'VincentBlondeau 3/6/2015 17:39'!
printMethodChunk: selector withPreamble: doPreamble on: outStream moveSource: moveSource toFile: fileIndex
	"Copy the source code for the method associated with selector onto the fileStream.  If moveSource true, then also set the source code pointer of the method."

	| preamble method oldPos newPos sourceFile |
	doPreamble
		ifTrue: [ preamble := self name , ' methodsFor: ' , (self organization categoryOfElement: selector) asString printString ]
		ifFalse: [ preamble := '' ].
	method := self methodDict
		at: selector
		ifAbsent: [ 
			outStream
				nextPutAll: selector;
				cr.
			outStream
				tab;
				nextPutAll: '** ERROR!!  THIS SCRIPT IS MISSING ** ' translated;
				cr;
				cr.
			outStream nextPutAll: '  '.
			^ outStream ].
	oldPos := method filePosition.
	sourceFile := SourceFiles at: method fileIndex.
	preamble size > 0
		ifTrue: [ 
			"Copy the preamble"
			outStream copyPreamble: preamble from: sourceFile at: oldPos ]
		ifFalse: [ sourceFile position: oldPos ].	"Copy the method chunk"
	newPos := outStream position.
	outStream copyMethodChunkFrom: sourceFile.
	sourceFile skipSeparators.	"The following chunk may have ]style["
	sourceFile peek == $]
		ifTrue: [ 
			outStream
				cr;
				copyMethodChunkFrom: sourceFile ].
	moveSource
		ifTrue: [ 
			"Set the new method source pointer"
			method setSourcePosition: newPos inFile: fileIndex ].
	preamble size > 0
		ifTrue: [ outStream nextChunkPut: ' ' ].
	^ outStream cr! !

!TClassDescription methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 16:24'!
copyMethodDictionaryFrom: donorClass
	"Copy the method dictionary of the donor class over to the receiver"

	self methodDict: donorClass copyOfMethodDictionary.
	self organization: donorClass organization deepCopy.! !

!TClassDescription methodsFor: 'organization updating' stamp: 'SebastianTleye 7/12/2013 16:50'!
noteChangesFrom: oldMethodDict
	^self explicitRequirement.
	! !

!TClassDescription methodsFor: '*rpackage-core' stamp: 'SebastianTleye 7/12/2013 15:56'!
packageFromOrganizer: anOrganizer
	"returns the package that defines this class"
	^ anOrganizer packageOf: self.! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
localMethods
	"returns the methods of classes including the ones of the traits that the class uses" 
	 
	^ self methods select: [:each | self includesLocalSelector: each selector].! !

!TClassDescription methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/4/2013 14:28'!
classSide
	^self theMetaClass.! !

!TClassDescription methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 16:24'!
addSelectorSilently: selector withMethod: compiledMethod
	super addSelectorSilently: selector withMethod: compiledMethod.
	self instanceSide noteAddedSelector: selector meta: self isMeta.! !

!TClassDescription methodsFor: 'slots' stamp: 'MarcusDenker 3/19/2015 16:42'!
definesSlot: aSlot
	"Return true whether the receiver defines an instance variable named aString"
	
	^ self slots identityIncludes: aSlot! !

!TClassDescription methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 16:24'!
wantsRecompilationProgressReported
	"Answer whether the receiver would like progress of its recompilation reported interactively to the user."

	^ true! !

!TClassDescription methodsFor: 'filein/out' stamp: 'SebastianTleye 7/9/2013 16:24'!
fileOutOrganizationOn: aFileStream
	"File a description of the receiver's organization on aFileStream."

	aFileStream cr; nextPut: $!!.
	aFileStream nextChunkPut: self name, ' reorganize'; cr.
	aFileStream nextChunkPut: self organization stringForFileOut ; cr! !

!TClassDescription methodsFor: 'private' stamp: 'SebastianTleye 7/12/2013 14:16'!
spaceUsed
	^super spaceUsed + (self hasClassSide
		ifTrue: [self classSide spaceUsed] 
		ifFalse: [0])! !

!TClassDescription methodsFor: 'slots' stamp: 'MarcusDenker 3/10/2015 12:47'!
usesSpecialVariables
	"retirn true if we define something else than InstanceVariableSlots"
	^self usesSpecialSlot or: [self classVariables anySatisfy: [ :each | each isSpecial ] ]! !

!TClassDescription methodsFor: 'slots' stamp: 'MarcusDenker 3/19/2015 16:20'!
hasSlotNamed: aString
	"Return true whether the receiver defines an instance variable named aString."
	
	^ self allSlots anySatisfy: [:slot | slot name = aString]! !

!TClassDescription methodsFor: 'private' stamp: 'SebastianTleye 5/24/2013 16:28'!
numberOfMethods
	"count all methods that are local (not comming from a trait)"
	| num |
	num := self localMethods size.
	^ self isMeta  
		ifTrue: [ num ]
		ifFalse: [ num + self class numberOfMethods ] ! !

!TClassDescription methodsFor: '*rpackage-core' stamp: 'SebastianTleye 7/12/2013 15:55'!
isExtendedInPackage: aPackage
	"returns true if aPackage defines an extension to this class"
	^ aPackage extendsClass: self.! !

!TClassDescription methodsFor: 'slots' stamp: 'MarcusDenker 6/25/2014 13:13'!
slotNames
	^self slots collect: [ :each | each name ]! !

!TClassDescription classTrait methodsFor: '*GT-SpotterExtensions-Core' stamp: 'StefanReichhart 3/26/2015 18:17'!
gtExamplePackage
	<gtExample: 'Package'>
	^ TClassDescription! !

!TCloneTest commentStamp: 'TorstenBergmann 2/20/2014 15:32'!
A trait for test purposes!
!TCloneTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureCloneTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!TCloneTest methodsFor: 'tests - copy - clone' stamp: 'stephane.ducasse 11/21/2008 15:57'!
testCopyNonEmpty
	"self debug: #testCopyNonEmpty"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: copy isEmpty.
	self assert: copy size = self nonEmpty size.
	self nonEmpty do: 
		[:each | copy includes: each]! !

!TCloneTest methodsFor: 'tests - copy - clone' stamp: 'stephane.ducasse 11/21/2008 15:43'!
testCopyCreatesNewObject
	"self debug: #testCopyCreatesNewObject"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: self nonEmpty == copy.
	! !

!TCloneTest methodsFor: 'helper' stamp: 'stephane.ducasse 1/12/2009 14:57'!
empty

	^ self explicitRequirement! !

!TCloneTest methodsFor: 'helper' stamp: 'stephane.ducasse 1/12/2009 14:57'!
nonEmpty

	^ self explicitRequirement! !

!TCloneTest methodsFor: 'tests - copy - clone' stamp: 'stephane.ducasse 11/21/2008 15:57'!
testCopyEmpty
	"self debug: #testCopyEmpty"
	
	| copy | 
	copy := self empty copy.
	self assert: copy isEmpty.! !

!TComparable commentStamp: '<historical>'!
This trait is a protocol for comparable objects. Classes using it must implement #<, #=, and #hash.!
!TComparable methodsFor: 'comparing' stamp: 'JAAyer 8/28/2010 23:41'!
min: aMin max: aMax 

	^ (self min: aMin) max: aMax! !

!TComparable methodsFor: 'comparing' stamp: 'JAAyer 8/28/2010 23:50'!
> aComparable 
	"Answer whether the receiver is greater than the argument."

	^aComparable < self! !

!TComparable methodsFor: 'comparing' stamp: 'JAAyer 8/28/2010 23:41'!
hash
	"Hash must be redefined whenever = is redefined."

	^self subclassResponsibility! !

!TComparable methodsFor: 'comparing' stamp: 'JAAyer 8/28/2010 23:50'!
= aComparable 
	"Compare the receiver with the argument and answer with true if the 
	receiver is equal to the argument. Otherwise answer false."

	^self subclassResponsibility! !

!TComparable methodsFor: 'comparing' stamp: 'JAAyer 8/28/2010 23:50'!
>= aComparable 
	"Answer whether the receiver is greater than or equal to the argument."

	^aComparable <= self! !

!TComparable methodsFor: 'comparing' stamp: 'JAAyer 8/28/2010 23:51'!
min: aComparable 
	"Answer the receiver or the argument, whichever is lesser."

	self < aComparable
		ifTrue: [^self]
		ifFalse: [^aComparable]! !

!TComparable methodsFor: 'comparing' stamp: 'JAAyer 8/28/2010 23:49'!
< aComparable
	"Answer whether the receiver is less than the argument."

	^self subclassResponsibility! !

!TComparable methodsFor: 'comparing' stamp: 'JAAyer 8/28/2010 23:51'!
max: aComparable 
	"Answer the receiver or the argument, whichever is greater."

	self > aComparable
		ifTrue: [^self]
		ifFalse: [^aComparable]! !

!TComparable methodsFor: 'comparing' stamp: 'JAAyer 8/28/2010 23:41'!
between: min and: max 
	"Answer whether the receiver is less than or equal to the argument, max, 
	and greater than or equal to the argument, min."

	^self >= min and: [self <= max]! !

!TComparable methodsFor: 'comparing' stamp: 'JAAyer 8/28/2010 23:50'!
<= aComparable 
	"Answer whether the receiver is less than or equal to the argument."

	^(self > aComparable) not! !

!TComposingDescription commentStamp: 'TorstenBergmann 2/4/2014 20:37'!
Kernel trait for ComposingDescription!
!TComposingDescription methodsFor: 'private' stamp: 'apb 8/22/2005 17:40'!
addOnTheLeft: aTraitExpression
	^TraitComposition with: aTraitExpression with: self! !

!TComposingDescription methodsFor: 'composition' stamp: 'apb 8/22/2005 17:12'!
- anArrayOfSelectors
	^TraitExclusion
		with: self
		exclusions: anArrayOfSelectors! !

!TComposingDescription methodsFor: 'private' stamp: 'apb 8/22/2005 17:53'!
addCompositionOnLeft: aTraitComposition
	^ aTraitComposition add: self! !

!TComposingDescription methodsFor: 'converting' stamp: 'apb 8/22/2005 15:47'!
asTraitComposition
	^TraitComposition with: self! !

!TComposingDescription methodsFor: 'composition' stamp: 'apb 8/22/2005 17:02'!
@ anArrayOfAssociations 
	^ TraitAlias with: self aliases: anArrayOfAssociations! !

!TComposingDescription methodsFor: 'composition' stamp: 'apb 8/22/2005 17:31'!
+ aTraitOrTraitComposition
	"Use double dispatch to avoid having nested composition in cases where
	parenthesis are used, such as T1 + (T2 + T3)"
	
	^aTraitOrTraitComposition addOnTheLeft: self! !

!TConcatenationEqualElementsRemovedTest commentStamp: 'TorstenBergmann 2/20/2014 15:32'!
A trait for test purposes!
!TConcatenationEqualElementsRemovedTest methodsFor: 'requirements' stamp: ''!
empty
	self explicitRequirement.! !

!TConcatenationEqualElementsRemovedTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureConcatenationTest
	self firstCollection.
	self deny: self firstCollection isEmpty.
	self firstCollection.
	self deny: self firstCollection isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!TConcatenationEqualElementsRemovedTest methodsFor: 'requirements' stamp: ''!
secondCollection
" return a collection that will be the second part of the concatenation"
	self explicitRequirement! !

!TConcatenationEqualElementsRemovedTest methodsFor: 'tests - concatenation' stamp: ''!
testConcatenationWithEmpty
	| result |
	result := self firstCollection , self empty.
	self assert: result = self firstCollection! !

!TConcatenationEqualElementsRemovedTest methodsFor: 'tests - concatenation' stamp: 'delaunay 5/11/2009 16:00'!
testConcatenation

| collection1 collection2 result |
collection1 := self firstCollection .
collection2 := self secondCollection .
result := collection1 , collection2.

collection1 do:[ :each | self assert: (result includes: each)].
collection2 do:[ :each | self assert: (result includes: each)].
! !

!TConcatenationEqualElementsRemovedTest methodsFor: 'tests - concatenation' stamp: 'delaunay 5/11/2009 16:02'!
testConcatenationWithDuplicate


| collection1 collection2 result |
collection1 := self firstCollection .
collection2 := self firstCollection  .
result := collection1 , collection2.

collection1 do:[ :each | self assert: (result includes: each)].
self assert: result size = collection1 size.! !

!TConcatenationEqualElementsRemovedTest methodsFor: 'requirements' stamp: ''!
firstCollection
" return a collection that will be the first part of the concatenation"
	self explicitRequirement! !

!TConcatenationTest commentStamp: 'TorstenBergmann 2/20/2014 15:32'!
A trait for test purposes!
!TConcatenationTest methodsFor: 'requirements' stamp: 'delaunay 4/14/2009 11:49'!
empty
	self explicitRequirement.! !

!TConcatenationTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureConcatenationTest
	self firstCollection.
	self deny: self firstCollection isEmpty.
	self firstCollection.
	self deny: self firstCollection isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!TConcatenationTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 11:46'!
secondCollection
" return a collection that will be the second part of the concatenation"
	self explicitRequirement! !

!TConcatenationTest methodsFor: 'tests - concatenation' stamp: 'delaunay 5/11/2009 11:45'!
testConcatenationWithEmpty
	| result |
	result := self firstCollection , self empty.
	self assert: result = self firstCollection! !

!TConcatenationTest methodsFor: 'tests - concatenation' stamp: 'delaunay 5/11/2009 15:57'!
testConcatenation

"| collection1 collection2 result |
collection1 := self firstCollection .
collection2 := self secondCollection .
result := collection1 , collection2.

collection1 do:[ :each | self assert: (result includes: each)].
collection2 do:[ :each | self assert: (result includes: each)]."

| collection1 collection2 result |
collection1 := self firstCollection .
collection2 := self secondCollection .
result := collection1 , collection2.

result do: [ :each | self assert: (result occurrencesOf: each) = (( collection1 occurrencesOf: each ) + ( collection2 occurrencesOf: each ) ). ].
self assert: result size = (collection1 size + collection2 size)! !

!TConcatenationTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 11:45'!
firstCollection
" return a collection that will be the first part of the concatenation"
	self explicitRequirement! !

!TConcatenationTest methodsFor: 'tests - concatenation' stamp: 'delaunay 5/11/2009 16:00'!
testConcatenationWithDuplicate


| collection1 collection2 result |
collection1 := self firstCollection .
collection2 := self firstCollection .
result := collection1 , collection2.

result do: [ :each | self assert: (result occurrencesOf: each) = (( collection1 occurrencesOf: each ) + ( collection2 occurrencesOf: each ) ). ].
self assert: result size = (collection1 size * 2)! !

!TConvertAsSetForMultiplinessIdentityTest commentStamp: 'TorstenBergmann 2/20/2014 15:32'!
A trait for test purposes!
!TConvertAsSetForMultiplinessIdentityTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 14:03'!
collectionWithCopy
	"return a collection of type 'self collectionWIithoutEqualsElements class' containing no elements equals ( with identity equality)
	but  2 elements only equals with classic equality"
	| result collection |
	collection := OrderedCollection withAll: self elementsCopyNonIdenticalWithoutEqualElements.
	collection add: collection first copy.
	result := self elementsCopyNonIdenticalWithoutEqualElements class withAll: collection.
	^ result! !

!TConvertAsSetForMultiplinessIdentityTest methodsFor: 'tests - as set tests' stamp: ''!
testAsSetWithEqualsElements
	| result |
	result := self withEqualElements asSet.
	self withEqualElements do: [ :each | self assert: (result occurrencesOf: each) = 1 ].
	self assert: result class = Set! !

!TConvertAsSetForMultiplinessIdentityTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureAsSetForIdentityMultiplinessTest
	"a collection (of elements for which copy is not identical ) without equal elements:"

	| anElement res |
	self elementsCopyNonIdenticalWithoutEqualElements.
	anElement := self elementsCopyNonIdenticalWithoutEqualElements anyOne.
	self deny: anElement copy == anElement.
	res := true.
	self elementsCopyNonIdenticalWithoutEqualElements
		detect: [ :each | (self elementsCopyNonIdenticalWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false! !

!TConvertAsSetForMultiplinessIdentityTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureTConvertAsSetForMultiplinessTest
	"a collection  with equal elements:"

	| res |
	self withEqualElements.
	res := true.
	self withEqualElements detect: [ :each | (self withEqualElements occurrencesOf: each) > 1 ] ifNone: [ res := false ].
	self assert: res = true! !

!TConvertAsSetForMultiplinessIdentityTest methodsFor: 'tests - as set tests' stamp: ''!
testAsIdentitySetWithEqualsElements
	| result collection |
	collection := self withEqualElements .
	result := collection asIdentitySet.
	collection do: [ :each | self assert: (result occurrencesOf: each) = 1 ].
	self assert: result class = IdentitySet.! !

!TConvertAsSetForMultiplinessIdentityTest methodsFor: 'requirements' stamp: 'CamilloBruni 11/2/2012 15:39'!
collectionWithIdentical
	"return a collection of type : 'self collectionWIithoutEqualsElements class containing two elements equals ( with identity equality)"
	| result collection anElement |
	collection := OrderedCollection withAll: self elementsCopyNonIdenticalWithoutEqualElements.
	anElement := collection first.
	collection add: anElement.
	result := self elementsCopyNonIdenticalWithoutEqualElements class withAll: collection.
	^ result! !

!TConvertAsSetForMultiplinessIdentityTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 14:00'!
elementsCopyNonIdenticalWithoutEqualElements
	" return a collection that does niot incllude equal elements ( classic equality )
	all elements included are elements for which copy is not identical to the element  "
	^ self explicitRequirement! !

!TConvertAsSetForMultiplinessIdentityTest methodsFor: 'requirements' stamp: ''!
withEqualElements
	" return a collection  including equal elements (classic equality)"
	^ self explicitRequirement! !

!TConvertAsSetForMultiplinessIdentityTest methodsFor: 'tests - as identity set' stamp: 'delaunay 4/28/2009 14:24'!
testAsIdentitySetWithoutIdentityEqualsElements
	| result collection |
	collection := self collectionWithCopy.
	result := collection asIdentitySet.
	" no elements should have been removed as no elements are equels with Identity equality"
	self assert: result size = collection size.
	collection do: 
		[ :each | 
		(collection occurrencesOf: each) = (result asOrderedCollection occurrencesOf: each) ].
	self assert: result class = IdentitySet! !

!TConvertAsSetForMultiplinessIdentityTest methodsFor: 'tests - as identity set' stamp: 'delaunay 4/28/2009 14:07'!
testAsIdentitySetWithIdentityEqualsElements
	| result |
	result := self collectionWithIdentical asIdentitySet.
	" Only one element should have been removed as two elements are equals with Identity equality"
	self assert: result size = (self collectionWithIdentical size - 1).
	self collectionWithIdentical do: 
		[ :each | 
		(self collectionWithIdentical occurrencesOf: each) > 1 
			ifTrue: 
				[ "the two elements equals only with classic equality shouldn't 'have been removed"
				self assert: (result asOrderedCollection occurrencesOf: each) = 1
				" the other elements are still here" ]
			ifFalse: [ self assert: (result asOrderedCollection occurrencesOf: each) = 1 ] ].
	self assert: result class = IdentitySet! !

!TConvertAsSetForMultiplinessTest commentStamp: 'TorstenBergmann 2/20/2014 15:32'!
A trait for test purposes!
!TConvertAsSetForMultiplinessTest methodsFor: 'tests - as set tests' stamp: 'delaunay 5/14/2009 15:06'!
testAsIdentitySetWithEqualsElements
	| result collection |
	collection := self withEqualElements .
	result := collection asIdentitySet.
	collection do: [ :each | self assert: (result occurrencesOf: each) = 1 ].
	self assert: result class = IdentitySet.! !

!TConvertAsSetForMultiplinessTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 14:11'!
withEqualElements
	" return a collection  including equal elements (classic equality)"
	^ self explicitRequirement! !

!TConvertAsSetForMultiplinessTest methodsFor: 'tests - as set tests' stamp: 'delaunay 4/28/2009 14:11'!
testAsSetWithEqualsElements
	| result |
	result := self withEqualElements asSet.
	self withEqualElements do: [ :each | self assert: (result occurrencesOf: each) = 1 ].
	self assert: result class = Set! !

!TConvertAsSetForMultiplinessTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureTConvertAsSetForMultiplinessTest
	"a collection  with equal elements:"

	| res |
	self withEqualElements.
	res := true.
	self withEqualElements detect: [ :each | (self withEqualElements occurrencesOf: each) > 1 ] ifNone: [ res := false ].
	self assert: res = true! !

!TConvertAsSortedTest commentStamp: 'TorstenBergmann 2/20/2014 15:33'!
A trait for test purposes!
!TConvertAsSortedTest methodsFor: 'requirements' stamp: 'delaunay 4/24/2009 10:14'!
collectionWithSortableElements
" return a collection elements that can be sorte ( understanding message ' < '  or ' > ')"
	^ self explicitRequirement! !

!TConvertAsSortedTest methodsFor: 'tests - as sorted collection' stamp: 'delaunay 4/24/2009 10:16'!
testAsSortedCollectionWithSortBlock
	| result tmp |
	result := self collectionWithSortableElements  asSortedCollection: [:a :b | a > b].
	self assert: (result class includesBehavior: SortedCollection).
	result do: 
		[ :each | 
		self assert: (self collectionWithSortableElements   occurrencesOf: each) = (result occurrencesOf: each) ].
	self assert: result size = self collectionWithSortableElements  size.
	tmp:=result at: 1.
	result do: [:each| self assert: tmp>=each. tmp:=each].
	! !

!TConvertAsSortedTest methodsFor: 'tests - as sorted collection' stamp: 'hfm 4/2/2010 13:41'!
testAsSortedArray
	| result collection |
	collection := self collectionWithSortableElements .
	result := collection  asArray sort.
	self assert: (result class includesBehavior: Array).
	self assert: result isSorted.
	self assert: result size = collection size! !

!TConvertAsSortedTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureConverAsSortedTest
	self collectionWithSortableElements.
	self deny: self collectionWithSortableElements isEmpty! !

!TConvertAsSortedTest methodsFor: 'tests - as sorted collection' stamp: 'delaunay 4/24/2009 10:19'!
testAsSortedCollection

	| aCollection result |
	aCollection := self collectionWithSortableElements .
	result := aCollection asSortedCollection.
	
	self assert: (result class includesBehavior: SortedCollection).
	result do: 
		[ :each | 
		self assert: (aCollection occurrencesOf: each) = (result occurrencesOf: each) ].
	
	self assert: result size = aCollection size.! !

!TConvertTest commentStamp: 'TorstenBergmann 2/20/2014 15:33'!
A trait for test purposes!
!TConvertTest methodsFor: 'tests - converting' stamp: 'delaunay 4/15/2009 15:33'!
testAsIdentitySet
	"test with a collection without equal elements :"
	self 
		assertSameContents: self collectionWithoutEqualElements
		whenConvertedTo: IdentitySet.
! !

!TConvertTest methodsFor: 'tests - converting' stamp: 'cyrille.delaunay 3/26/2009 12:37'!
assertSameContents: aCollection whenConvertedTo: aClass 
	| result |
	result := self assertNonDuplicatedContents: aCollection whenConvertedTo: aClass.
	self assert: result size = aCollection size! !

!TConvertTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 14:59'!
collectionWithoutEqualElements
" return a collection without equal elements"
	^ self explicitRequirement! !

!TConvertTest methodsFor: 'tests - converting' stamp: 'cyrille.delaunay 3/26/2009 14:55'!
testAsArray
	"self debug: #testAsArray3"
	self 
		assertSameContents: self collectionWithoutEqualElements
		whenConvertedTo: Array! !

!TConvertTest methodsFor: 'tests - converting' stamp: 'CamilloBruni 8/31/2013 20:43'!
testAsByteArray
	| res |
	self integerCollectionWithoutEqualElements.
	self integerCollectionWithoutEqualElements do: [ :each | self assert: each class = SmallInteger ].
	res := true.
	self integerCollectionWithoutEqualElements
		detect: [ :each | (self integerCollectionWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false.
	self assertSameContents: self integerCollectionWithoutEqualElements whenConvertedTo: ByteArray! !

!TConvertTest methodsFor: 'tests - converting' stamp: 'delaunay 4/15/2009 15:36'!
testAsSet
	| |
	"test with a collection without equal elements :"
	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: Set.
	! !

!TConvertTest methodsFor: 'tests - converting' stamp: 'cyrille.delaunay 3/26/2009 12:49'!
testAsBag

	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: Bag! !

!TConvertTest methodsFor: 'tests - converting' stamp: 'delaunay 3/27/2009 09:43'!
assertNoDuplicates: aCollection whenConvertedTo: aClass 
	| result |
	result := self collectionWithEqualElements asIdentitySet.
	self assert: (result class includesBehavior: IdentitySet).
	self collectionWithEqualElements do: [ :initial | self assert: (result occurrencesOf: initial) = 1 ]! !

!TConvertTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 15:00'!
integerCollectionWithoutEqualElements
" return a collection of integer without equal elements"
	^ self explicitRequirement! !

!TConvertTest methodsFor: 'tests - converting' stamp: 'cyrille.delaunay 3/26/2009 12:36'!
assertNonDuplicatedContents: aCollection whenConvertedTo: aClass 
	| result |
	result := aCollection perform: ('as' , aClass name) asSymbol.
	self assert: (result class includesBehavior: aClass).
	result do: 
		[ :each | 
		self assert: (aCollection occurrencesOf: each) = (result occurrencesOf: each) ].
	^ result! !

!TConvertTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureTConvertTest
	"a collection of number without equal elements:"

	| res |
	self collectionWithoutEqualElements.
	res := true.
	self collectionWithoutEqualElements
		detect: [ :each | (self collectionWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false! !

!TConvertTest methodsFor: 'tests - converting' stamp: 'cyrille.delaunay 3/26/2009 12:42'!
testAsOrderedCollection
	
	self assertSameContents: self collectionWithoutEqualElements whenConvertedTo: OrderedCollection! !

!TCopyPartOfSequenceable commentStamp: 'TorstenBergmann 2/20/2014 15:33'!
A trait for test purposes!
!TCopyPartOfSequenceable methodsFor: 'tests - copying part of sequenceable' stamp: 'CamilloBruni 9/9/2011 12:10'!
testCopyAfter
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyAfter: (collection  at:index ).
	
	"verifying content: "
	(1) to: result size do: 
		[:i |
		self assert: (collection   at:(i + index ))=(result at: (i))].

	"verify size: "
	self assert: result size = (collection   size - index).! !

!TCopyPartOfSequenceable methodsFor: 'requirements' stamp: 'CamilloBruni 9/9/2011 12:12'!
collectionWithoutEqualElements

" return a collection not including equal elements "
	self explicitRequirement! !

!TCopyPartOfSequenceable methodsFor: 'tests - copying part of sequenceable' stamp: 'CamilloBruni 9/9/2011 12:10'!
testCopyUpToLast
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyUpToLast: (collection  at:index).
	
	"verify content of 'result' :"
	1 to: result size do: [:i| self assert: (collection   at:i)=(result at:i)].
	
	"verify size of 'result' :"
	self assert: result size = (index-1).! !

!TCopyPartOfSequenceable methodsFor: 'tests - copying part of sequenceable' stamp: 'CamilloBruni 9/9/2011 12:10'!
testCopyUpToLastEmpty
	| result |
	result := self empty copyUpToLast: self collectionWithoutEqualElements first.
	self assert: result isEmpty.! !

!TCopyPartOfSequenceable methodsFor: 'tests - copying part of sequenceable' stamp: 'CamilloBruni 9/9/2011 12:10'!
testCopyAfterLast
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyAfterLast: (collection  at:index ).
	
	"verifying content: "
	(1) to: result size do: 
		[:i |
		self assert: (collection   at:(i + index ))=(result at: (i))].

	"verify size: "
	self assert: result size = (collection   size - index).! !

!TCopyPartOfSequenceable methodsFor: 'tests - copying part of sequenceable' stamp: 'CamilloBruni 9/9/2011 12:10'!
testCopyFromTo
	| result  index collection |
	collection := self collectionWithoutEqualElements .
	index :=self indexInForCollectionWithoutDuplicates .
	result := collection   copyFrom: index  to: collection  size .
	
	"verify content of 'result' : "
	1 to: result size do:
		[:i | 
		self assert: (result at:i)=(collection  at: (i + index - 1))].
	
	"verify size of 'result' : "
	self assert: result size = (collection  size - index + 1).! !

!TCopyPartOfSequenceable methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureCopyPartOfSequenceableTest
	self collectionWithoutEqualElements.
	self collectionWithoutEqualElements
		do: [ :each | self assert: (self collectionWithoutEqualElements occurrencesOf: each) = 1 ].
	self indexInForCollectionWithoutDuplicates.
	self
		assert:
			(self indexInForCollectionWithoutDuplicates > 0 & self indexInForCollectionWithoutDuplicates)
				< self collectionWithoutEqualElements size.
	self empty.
	self assert: self empty isEmpty! !

!TCopyPartOfSequenceable methodsFor: 'requirements' stamp: 'delaunay 4/16/2009 15:47'!
empty
	self explicitRequirement! !

!TCopyPartOfSequenceable methodsFor: 'tests - copying part of sequenceable' stamp: 'CamilloBruni 9/9/2011 12:10'!
testCopyAfterEmpty
	| result |
	result := self empty copyAfter: self collectionWithoutEqualElements first.
	self assert: result isEmpty.
	! !

!TCopyPartOfSequenceable methodsFor: 'tests - copying part of sequenceable' stamp: 'CamilloBruni 9/9/2011 12:10'!
testCopyUpTo
	| result index collection |
	collection := self collectionWithoutEqualElements .
	index:= self indexInForCollectionWithoutDuplicates .
	result := collection   copyUpTo: (collection  at:index).
	
	"verify content of 'result' :"
	1 to: result size do: [:i| self assert: (collection   at:i)=(result at:i)].
	
	"verify size of 'result' :"
	self assert: result size = (index-1).
	! !

!TCopyPartOfSequenceable methodsFor: 'tests - copying part of sequenceable' stamp: 'CamilloBruni 9/9/2011 12:10'!
testCopyAfterLastEmpty
	| result |
	result := self empty copyAfterLast: self collectionWithoutEqualElements first.
	self assert: result isEmpty.! !

!TCopyPartOfSequenceable methodsFor: 'tests - copying part of sequenceable' stamp: 'CamilloBruni 9/9/2011 12:10'!
testCopyEmptyMethod
	| result |
	result := self collectionWithoutEqualElements  copyEmpty .
	self assert: result isEmpty .
	self assert: result class= self nonEmpty class.! !

!TCopyPartOfSequenceable methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 14:32'!
indexInForCollectionWithoutDuplicates
" return an index between 'collectionWithoutEqualsElements'  bounds"
	self explicitRequirement! !

!TCopyPartOfSequenceable methodsFor: 'tests - copying part of sequenceable' stamp: 'CamilloBruni 9/9/2011 12:10'!
testCopyUpToEmpty
	| result |
	result := self empty copyUpTo: self collectionWithoutEqualElements first.
	self assert: result isEmpty.
	! !

!TCopyPartOfSequenceableForMultipliness commentStamp: 'TorstenBergmann 2/20/2014 15:33'!
A trait for test purposes!
!TCopyPartOfSequenceableForMultipliness methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureCopyPartOfForMultipliness
	self collectionWithSameAtEndAndBegining.
	self assert: self collectionWithSameAtEndAndBegining first = self collectionWithSameAtEndAndBegining last.
	self assert: self collectionWithSameAtEndAndBegining size > 1.
	1 to: self collectionWithSameAtEndAndBegining size do: [ :i | 
		i > 1 & (i < self collectionWithSameAtEndAndBegining size)
			ifTrue: [ self deny: (self collectionWithSameAtEndAndBegining at: i) = self collectionWithSameAtEndAndBegining first ] ]! !

!TCopyPartOfSequenceableForMultipliness methodsFor: 'tests - copying part of sequenceable for multipliness' stamp: 'delaunay 4/22/2009 11:03'!
testCopyAfterWithDuplicate
	| result element  collection |
	collection := self collectionWithSameAtEndAndBegining .
	element := collection  last.
	
	" collectionWithSameAtEndAndBegining first and last elements are equals.
	'copyAfter:' should copy after the first occurence :"
	result := collection   copyAfter: (element ).
	
	"verifying content: "
	1 to: result size do: 
		[:i |
		self assert: (collection  at:(i + 1 )) = (result at: (i))
		].

	"verify size: "
	self assert: result size = (collection size - 1).! !

!TCopyPartOfSequenceableForMultipliness methodsFor: 'tests - copying part of sequenceable for multipliness' stamp: 'delaunay 4/22/2009 11:14'!
testCopyUpToLastWithDuplicate
	| result element  collection |
	collection := self collectionWithSameAtEndAndBegining .
	element := collection  first.
	
	" collectionWithSameAtEndAndBegining first and last elements are equals.
	'copyUpToLast:' should copy until the last occurence :"
	result := collection   copyUpToLast: (element ).
	
	"verifying content: "
	1 to: result size do:
		[:i |
		self assert: (result at: i ) = ( collection at: i )  
		].
	
	self assert: result size = (collection size - 1).

! !

!TCopyPartOfSequenceableForMultipliness methodsFor: 'tests - copying part of sequenceable for multipliness' stamp: 'delaunay 4/22/2009 11:08'!
testCopyUpToWithDuplicate
	| result element  collection |
	collection := self collectionWithSameAtEndAndBegining .
	element := collection  last.
	
	" collectionWithSameAtEndAndBegining first and last elements are equals.
	'copyUpTo:' should copy until the first occurence :"
	result := collection   copyUpTo: (element ).
	
	"verifying content: "
	self assert: result isEmpty.

! !

!TCopyPartOfSequenceableForMultipliness methodsFor: 'requirements' stamp: 'delaunay 4/22/2009 10:56'!
collectionWithSameAtEndAndBegining
" return a collection with elements at end and begining equals .
(others elements of the collection are not equal to those elements)"
	self explicitRequirement! !

!TCopyPartOfSequenceableForMultipliness methodsFor: 'tests - copying part of sequenceable for multipliness' stamp: 'delaunay 4/22/2009 11:06'!
testCopyAfterLastWithDuplicate
	| result element  collection |
	collection := self collectionWithSameAtEndAndBegining .
	element := collection  first.
	
	" collectionWithSameAtEndAndBegining first and last elements are equals.
	'copyAfter:' should copy after the last occurence of element :"
	result := collection   copyAfterLast: (element ).
	
	"verifying content: "
	self assert: result isEmpty.

! !

!TCopyPreservingIdentityTest commentStamp: 'TorstenBergmann 2/20/2014 15:33'!
A trait for test purposes!
!TCopyPreservingIdentityTest methodsFor: 'tests - copy' stamp: 'stephane.ducasse 11/21/2008 15:46'!
testCopyReturnsIdentity
	"self debug: #testCopyReturnsIdentity"
	
	| copy | 
	copy := self nonEmpty copy.
	self assert: self nonEmpty == copy.
	! !

!TCopyPreservingIdentityTest methodsFor: 'requirements' stamp: 'AlexandreBergel 1/19/2009 18:08'!
nonEmpty
	self explicitRequirement! !

!TCopySequenceableSameContents commentStamp: 'TorstenBergmann 2/20/2014 15:33'!
A trait for test purposes!
!TCopySequenceableSameContents methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 11:24'!
collectionWithSortableElements
	" return a collection only including elements that can be sorted (understanding '<' )"
	self explicitRequirement! !

!TCopySequenceableSameContents methodsFor: 'requirements' stamp: 'delaunay 4/16/2009 14:44'!
empty
	self explicitRequirement! !

!TCopySequenceableSameContents methodsFor: 'tests - copying same contents' stamp: 'delaunay 4/16/2009 14:39'!
testShallowCopyEmpty
	| result |
	result := self empty shallowCopy .
	self assert: result isEmpty .! !

!TCopySequenceableSameContents methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureCopySameContentsTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!TCopySequenceableSameContents methodsFor: 'tests - copying same contents' stamp: 'StephaneDucasse 3/22/2010 21:16'!
testReverse

	| result |
	result := self nonEmpty reversed.	
	"verify content of 'result: '"
	1 to: result size do:
		[:i | self assert: ((result at: i) 
			= (self nonEmpty at: (self nonEmpty size - i + 1)))].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!TCopySequenceableSameContents methodsFor: 'requirements' stamp: 'delaunay 4/16/2009 14:44'!
nonEmpty
	self explicitRequirement! !

!TCopySequenceableSameContents methodsFor: 'tests - copying same contents' stamp: 'delaunay 4/16/2009 14:40'!
testShallowCopy
	| result |
	result := self nonEmpty shallowCopy .
	
	"verify content of 'result: '"
	1 to: self nonEmpty size do:
		[:i | self assert: ((result at:i)=(self nonEmpty at:i))].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!TCopySequenceableSameContents methodsFor: 'tests - copying same contents' stamp: 'delaunay 4/16/2009 14:40'!
testShuffled
	| result |
	result := self nonEmpty shuffled .
	
	"verify content of 'result: '"
	result do: [:each | self assert: (self nonEmpty occurrencesOf: each)=(result occurrencesOf: each)].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!TCopySequenceableSameContents methodsFor: 'tests - copying same contents' stamp: 'delaunay 4/21/2009 16:10'!
testReversed
	| result |
	result := self nonEmpty reversed .
	
	"verify content of 'result: '"
	1 to:  result size do:
		[:i | self assert: ((result at:i)=(self nonEmpty at:(self nonEmpty size-i+1)))].
	"verify size of 'result' :"
	self assert: result size=self nonEmpty size.! !

!TCopySequenceableWithOrWithoutSpecificElements commentStamp: 'TorstenBergmann 2/20/2014 15:33'!
A trait for test purposes!
!TCopySequenceableWithOrWithoutSpecificElements methodsFor: 'tests - copying with or without' stamp: 'delaunay 4/16/2009 16:50'!
testCopyWithoutIndex
	| result index |
	index := self indexInNonEmpty .
	result := self nonEmpty copyWithoutIndex: index .
	
	"verify content of 'result:'"
	1 to: result size do:
		[:i | 
		i<( index ) ifTrue: [self assert: ((result at:i )= (self nonEmpty at:i))].
		i>=( index ) ifTrue: [self assert: (result at:i )= (self nonEmpty at:(i+1))]].
	
	"verify size of result : "
	self assert: result size=(self nonEmpty size -1).! !

!TCopySequenceableWithOrWithoutSpecificElements methodsFor: 'tests - copying with or without' stamp: 'delaunay 4/16/2009 16:49'!
testCopyWithoutFirst

	| result |
	result := self nonEmpty copyWithoutFirst.
	
	self assert: result size = (self nonEmpty size - 1).
	
	1 to: result size do:
		[:i |
		self assert: (result at: i)= (self nonEmpty at: (i + 1))].! !

!TCopySequenceableWithOrWithoutSpecificElements methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureCopyWithOrWithoutSpecificElementsTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self indexInNonEmpty.
	self assert: self indexInNonEmpty > 0.
	self assert: self indexInNonEmpty <= self nonEmpty size! !

!TCopySequenceableWithOrWithoutSpecificElements methodsFor: 'tests - copying with or without' stamp: 'delaunay 4/16/2009 16:57'!
testCopyWithSequenceable

	| result index element |
	index := self indexInNonEmpty .
	element := self nonEmpty at: index.
	result := self nonEmpty copyWith: (element ).
	
	self assert: result size = (self nonEmpty size + 1).
	self assert: result last = element .
	
	1 to: (result size - 1) do:
	[ :i |
	self assert: (result at: i) = ( self nonEmpty at: ( i  ))].! !

!TCopySequenceableWithOrWithoutSpecificElements methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 14:43'!
indexInNonEmpty
" return an index between bounds of 'nonEmpty' "

	self explicitRequirement! !

!TCopySequenceableWithOrWithoutSpecificElements methodsFor: 'tests - copying with or without' stamp: 'delaunay 4/16/2009 16:54'!
testForceToPaddingWith

	| result element |
	element := self nonEmpty at: self indexInNonEmpty .
	result := self nonEmpty forceTo: (self nonEmpty size+2) paddingWith: ( element ).
	
	"verify content of 'result' : "
	1 to: self nonEmpty  size do:
		[:i | self assert: ( self nonEmpty at: i ) = ( result at:(i) ). ].
	
	(result size - 1) to: result size do:
		[:i | self assert: ( result at:i ) = ( element ) ].

	"verify size of 'result' :"
	self assert: result size = (self nonEmpty size + 2).! !

!TCopySequenceableWithOrWithoutSpecificElements methodsFor: 'tests - copying with or without' stamp: 'delaunay 4/16/2009 16:53'!
testForceToPaddingStartWith

	| result element |
	element := self nonEmpty at: self indexInNonEmpty .
	result := self nonEmpty forceTo: (self nonEmpty size+2) paddingStartWith: ( element ).
	
	"verify content of 'result' : "
	1 to: 2   do:
		[:i | self assert: ( element ) = ( result at:(i) ) ].
	
	3 to: result size do:
		[:i | self assert: ( result at:i ) = ( self nonEmpty at:(i-2) ) ].

	"verify size of 'result' :"
	self assert: result size = (self nonEmpty size + 2).! !

!TCopySequenceableWithOrWithoutSpecificElements methodsFor: 'requirements' stamp: 'delaunay 4/16/2009 16:31'!
nonEmpty
	self explicitRequirement! !

!TCopySequenceableWithOrWithoutSpecificElements methodsFor: 'tests - copying with or without' stamp: 'delaunay 4/16/2009 16:56'!
testCopyWithFirst

	| index element result |
	index:= self indexInNonEmpty .
	element:= self nonEmpty at: index.
	
	result := self nonEmpty copyWithFirst: element.	
	
	self assert: result size = (self nonEmpty size + 1).
	self assert: result first = element .
	
	2 to: result size do:
	[ :i |
	self assert: (result at: i) = ( self nonEmpty at: ( i - 1 ))].! !

!TCopySequenceableWithReplacement commentStamp: 'TorstenBergmann 2/20/2014 15:33'!
A trait for test purposes!
!TCopySequenceableWithReplacement methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 13:51'!
collectionWith2TimeSubcollection
" return a collection including 'oldSubCollection'  two or many time "
	self explicitRequirement! !

!TCopySequenceableWithReplacement methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 13:52'!
replacementCollection
" return a collection that will be used to replace 'oldSubcollection' in ' collectionWith1TimeSubcollection'  " 
	self explicitRequirement! !

!TCopySequenceableWithReplacement methodsFor: 'tests - copying with replacement' stamp: 'delaunay 4/17/2009 11:19'!
testCopyReplaceAllWith1Occurence
	| result  firstIndexesOfOccurrence index endPartIndexResult endPartIndexCollection |
	
	result := self collectionWith1TimeSubcollection  copyReplaceAll: self oldSubCollection with: self replacementCollection .
	
	"detecting indexes of olSubCollection"
	firstIndexesOfOccurrence  := self firstIndexesOf: self oldSubCollection in: self collectionWith1TimeSubcollection .
	index:= firstIndexesOfOccurrence at: 1.
	
	"verify content of 'result' : "
	"first part of 'result'' : '"

	1 to: (index -1) do: 
		[
		:i |  
		self assert: (self collectionWith1TimeSubcollection  at:i)=(result at: i)
		].

	" middle part containing replacementCollection : "
	
	index to: (index + self replacementCollection size-1) do: 
		[
		:i |
		self assert: ( result at: i )=(self replacementCollection at: ( i - index + 1 ))
		].
	
	" end part :"
	
	endPartIndexResult :=  index + self replacementCollection  size .
	endPartIndexCollection :=   index + self oldSubCollection size  .
	
	1 to: (result size - endPartIndexResult - 1 ) do:
		[ 
		:i |
		self assert: (result at: ( endPartIndexResult + i - 1 ) ) = (self collectionWith1TimeSubcollection  at: ( endPartIndexCollection + i - 1 ) ).
		].
	
	
	! !

!TCopySequenceableWithReplacement methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 13:51'!
collectionWith1TimeSubcollection
" return a collection including 'oldSubCollection'  only one time "
	self explicitRequirement! !

!TCopySequenceableWithReplacement methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 13:52'!
oldSubCollection
" return a subCollection included in collectionWith1TimeSubcollection .
ex :   subCollection := #( 2 3 4) and collectionWith1TimeSubcollection := #(1 2 3 4 5)"
	self explicitRequirement! !

!TCopySequenceableWithReplacement methodsFor: 'tests - copying with replacement' stamp: 'CamilloBruni 8/31/2013 20:43'!
testCopyReplaceAllWithManyOccurence
	| result firstIndexesOfOccurrence resultBetweenPartIndex collectionBetweenPartIndex diff |
	" testing fixture here as this method may be not used for collection that can't contain equals element :"
	self collectionWith2TimeSubcollection.
	self assert: (self howMany: self oldSubCollection in: self collectionWith2TimeSubcollection) = 2.	" test :"
	diff := self replacementCollection size - self oldSubCollection size.
	result := self collectionWith2TimeSubcollection copyReplaceAll: self oldSubCollection with: self replacementCollection.	"detecting indexes of olSubCollection"
	firstIndexesOfOccurrence := self firstIndexesOf: self oldSubCollection in: self collectionWith2TimeSubcollection.	" verifying that replacementCollection has been put in places of oldSubCollections "
	firstIndexesOfOccurrence
		do: [ :each | 
			(firstIndexesOfOccurrence indexOf: each) = 1
				ifTrue: [ each to: self replacementCollection size do: [ :i | self assert: (result at: i) = (self replacementCollection at: i - each + 1) ] ]
				ifFalse: [ each + diff to: self replacementCollection size do: [ :i | self assert: (result at: i) = (self replacementCollection at: i - each + 1) ] ] ].	" verifying that the 'between' parts correspond to the initial collection : "
	1 to: firstIndexesOfOccurrence size do: [ :i | 
		i = 1
			ifTrue: [ 1 to: (firstIndexesOfOccurrence at: i) - 1 do: [ :j | self assert: (result at: i) = (self collectionWith2TimeSubcollection at: i) ] ]
			ifFalse: [ 
				resultBetweenPartIndex := (firstIndexesOfOccurrence at: i - 1) + self replacementCollection size.
				collectionBetweenPartIndex := (firstIndexesOfOccurrence at: i - 1) + self oldSubCollection size.
				1 to: (firstIndexesOfOccurrence at: i) - collectionBetweenPartIndex - 1 do: [ :j | 
					self
						assert:
							(result at: resultBetweenPartIndex + i - 1)
								= (self collectionWith2TimeSubcollection at: collectionBetweenPartIndex + i - 1) ] ]	" specific comportement for the begining of the collection :"	" between parts till the end : " ].	"final part :"
	1 to: self collectionWith2TimeSubcollection size - (firstIndexesOfOccurrence last + self oldSubCollection size) do: [ :i | 
		self
			assert:
				(result at: firstIndexesOfOccurrence last + self replacementCollection size - 1 + i)
					= (self collectionWith2TimeSubcollection at: firstIndexesOfOccurrence last + self oldSubCollection size - 1 + i) ]! !

!TCopySequenceableWithReplacement methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureCopyWithReplacementTest
	self replacementCollection.
	self oldSubCollection.
	self collectionWith1TimeSubcollection.
	self assert: (self howMany: self oldSubCollection in: self collectionWith1TimeSubcollection) = 1! !

!TCopySequenceableWithReplacement methodsFor: 'tests - copying with replacement' stamp: 'delaunay 4/17/2009 13:48'!
testCopyReplaceFromToWith
	| result  indexOfSubcollection lastIndexOfOldSubcollection lastIndexOfReplacementCollection |
	
	indexOfSubcollection := (self firstIndexesOf: self oldSubCollection  in:  self collectionWith1TimeSubcollection) at: 1. 
	lastIndexOfOldSubcollection := indexOfSubcollection + self oldSubCollection size -1.
	lastIndexOfReplacementCollection := indexOfSubcollection + self replacementCollection  size -1.
	
	result := self collectionWith1TimeSubcollection  copyReplaceFrom: indexOfSubcollection  to: lastIndexOfOldSubcollection   with: self replacementCollection .
	
	"verify content of 'result' : "
	"first part of 'result'  "
	
	1 to: (indexOfSubcollection  - 1) do: 
		[ 
		:i | 
		self assert: (self collectionWith1TimeSubcollection  at:i) = (result at: i)
		].
	
	" middle part containing replacementCollection : "
	
	(indexOfSubcollection ) to: ( lastIndexOfReplacementCollection  ) do: 
		[
		:i |
		self assert: (result at: i)=(self replacementCollection at: (i - indexOfSubcollection +1))
		].
	
	" end part :"
	1 to: (result size - lastIndexOfReplacementCollection   ) do:
		[ 
		:i |
		self assert: (result at: ( lastIndexOfReplacementCollection  + i  ) ) = (self collectionWith1TimeSubcollection  at: ( lastIndexOfOldSubcollection  + i  ) ).
		].
	
	
	

	
	! !

!TCopySequenceableWithReplacement methodsFor: 'tests - fixture' stamp: 'MarcusDenker 6/24/2013 11:29'!
howMany: aSubCollection in: collection
" return an integer representing how many time 'subCollection'  appears in 'collection'  "
	| tmp nTime |
	tmp := collection.
	nTime:= 0.
	
	[tmp isEmpty ]whileFalse:
		[
		(tmp beginsWith: aSubCollection)
			ifTrue: [ 	
				nTime := nTime + 1.
				1 to: aSubCollection size do: [:i | tmp := tmp copyWithoutFirst.]
				]
			ifFalse: [tmp := tmp copyWithoutFirst.]
		 ].
	
	^ nTime.
	! !

!TCopySequenceableWithReplacement methodsFor: 'tests - copying with replacement' stamp: 'delaunay 4/17/2009 13:57'!
testCopyReplaceFromToWithInsertion
	| result  indexOfSubcollection |
	
	indexOfSubcollection := (self firstIndexesOf: self oldSubCollection  in:  self collectionWith1TimeSubcollection) at: 1. 
	
	result := self collectionWith1TimeSubcollection  copyReplaceFrom: indexOfSubcollection  to: ( indexOfSubcollection - 1 ) with: self replacementCollection .
	
	"verify content of 'result' : "
	"first part of 'result'' : '"
	
	1 to: (indexOfSubcollection -1) do: 
		[
		:i | 
		self assert: (self collectionWith1TimeSubcollection  at:i)=(result at: i)
		].
	
	" middle part containing replacementCollection : "
	indexOfSubcollection  to: (indexOfSubcollection  + self replacementCollection size-1) do: 
		[
		:i |
		self assert: ( result at: i )=(self replacementCollection at: ( i - indexOfSubcollection +1 ))
		].
	
	" end part :"
	(indexOfSubcollection  + self replacementCollection size) to: (result size) do:
		[:i|
		self assert: (result at: i)=(self collectionWith1TimeSubcollection  at: (i-self replacementCollection size))].
	
	" verify size: "	
	self assert: result size=(self collectionWith1TimeSubcollection  size + self replacementCollection size).
	

	

	
	! !

!TCopySequenceableWithReplacement methodsFor: 'tests - copying with replacement' stamp: 'MarcusDenker 6/24/2013 11:24'!
firstIndexesOf: aSubCollection in: collection
" return an OrderedCollection with the first indexes of the occurrences of subCollection in  collection "
	| tmp result currentIndex |
	tmp:= collection.
	result:= OrderedCollection new.
	currentIndex := 1.
	
	[tmp isEmpty ]whileFalse:
		[
		(tmp beginsWith: aSubCollection)
			ifTrue: [ 	
				result add: currentIndex.
				1 to: aSubCollection size do: 
					[:i | 
					tmp := tmp copyWithoutFirst.
					currentIndex := currentIndex + 1]
				]
			ifFalse: [
				tmp := tmp copyWithoutFirst.
				currentIndex := currentIndex +1.
				]
		 ].
	
	^ result.
	! !

!TCopySequenceableWithReplacementForSorted commentStamp: 'TorstenBergmann 2/20/2014 15:33'!
A trait for test purposes!
!TCopySequenceableWithReplacementForSorted methodsFor: 'tests - copying with replacement for sorted' stamp: 'delaunay 4/22/2009 13:44'!
testCopyFromToWithForSorted
| collection result |
collection := self collectionOfSize5 .

" testing that elements to be replaced are removed from the copy :"
result := collection copyReplaceFrom: 1 to: collection size with: self empty .
self assert: result isEmpty.

" testing that replacement elements  are all put into the copy :"
result := collection copyReplaceFrom: 1 to: collection size with: self replacementCollection .
 self replacementCollection do:
	[:each | 
	self assert: (result occurrencesOf: each) = ( self replacementCollection occurrencesOf: each )].

self assert: result size = self replacementCollection size.

! !

!TCopySequenceableWithReplacementForSorted methodsFor: 'tests - copying with replacement for sorted' stamp: 'delaunay 4/22/2009 13:40'!
testCopyReplaceAllWithForSorted

| collection result |
collection := self collectionOfSize5 .

" testing that elements to be replaced are removed from the copy :"
result := collection copyReplaceAll: collection with: self empty .
self assert: result isEmpty.

" testing that replacement elements  are all put into the copy :"
result := collection copyReplaceAll: collection with: self replacementCollection .
 self replacementCollection do:
	[:each | 
	self assert: (result occurrencesOf: each) = ( self replacementCollection occurrencesOf: each )].

self assert: result size = self replacementCollection size.

! !

!TCopySequenceableWithReplacementForSorted methodsFor: 'requirements' stamp: 'delaunay 4/22/2009 13:37'!
empty
self explicitRequirement.! !

!TCopySequenceableWithReplacementForSorted methodsFor: 'requirements' stamp: 'delaunay 4/22/2009 13:25'!
replacementCollection
" return a collection including elements of type 'collectionOfSize5' elements'type"
self explicitRequirement! !

!TCopySequenceableWithReplacementForSorted methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureCopyWithReplacementForSorted
	self collectionOfSize5.
	self assert: self collectionOfSize5 size = 5.
	self replacementCollection.
	self deny: self replacementCollection isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!TCopySequenceableWithReplacementForSorted methodsFor: 'requirements' stamp: 'delaunay 4/22/2009 13:22'!
collectionOfSize5
" return a collection of size 5"
self explicitRequirement! !

!TCopyTest commentStamp: 'stephane.ducasse 1/16/2009 19:07'!
Tests whether a copied object contains the same elements than its source.
Note that the order is not garanteed -- see TEqualityTest for that. 

!
!TCopyTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0CopyTest
	self empty.
	self assert: self empty size = 0.
	self nonEmpty.
	self assert: (self nonEmpty size = 0) not.
	self collectionWithElementsToRemove.
	self assert: (self collectionWithElementsToRemove size = 0) not.
	self collectionWithElementsToRemove do: [ :each | self assert: (self nonEmpty includes: each) ].
	self elementToAdd.
	self deny: (self nonEmpty includes: self elementToAdd).
	self collectionNotIncluded.
	self collectionNotIncluded do: [ :each | self deny: (self nonEmpty includes: each) ]! !

!TCopyTest methodsFor: 'tests - copy' stamp: 'delaunay 4/17/2009 15:24'!
testCopyEmptyWithoutAll
	"self debug: #testCopyEmptyWithoutAll"
	| res |
	res := self empty copyWithoutAll: self collectionWithElementsToRemove.
	self assert: res size = self empty size.
	self collectionWithElementsToRemove do: [ :each | self deny: (res includes: each) ]! !

!TCopyTest methodsFor: 'tests - copy' stamp: 'delaunay 4/29/2009 11:01'!
testCopyNonEmptyWithoutAll
	"self debug: #testCopyNonEmptyWithoutAll"
	| res |
	res := self nonEmpty copyWithoutAll: self collectionWithElementsToRemove.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self collectionWithElementsToRemove do: [ :each | self deny: (res includes: (each)) ].
	self nonEmpty do: 
		[ :each | 
		(self collectionWithElementsToRemove includes: each) ifFalse: [ self assert: (res includes: each) ] ]! !

!TCopyTest methodsFor: 'tests - copy' stamp: 'HenrikSperreJohansen 10/18/2009 00:57'!
testCopyNotSame
	"self debug: #testCopySameClass"
	"A copy of a collection should always be of the same class as the instance it copies"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: copy  == self nonEmpty.! !

!TCopyTest methodsFor: 'requirements' stamp: 'delaunay 4/22/2009 14:51'!
collectionNotIncluded
" return a collection for wich each element is not included in 'nonEmpty' "
	^ self explicitRequirement! !

!TCopyTest methodsFor: 'tests - copy' stamp: 'delaunay 4/17/2009 15:26'!
testCopyEmptyWithout
	"self debug: #testCopyEmptyWithout"
	| res |
	res := self empty copyWithout: self elementToAdd.
	self assert: res size = self empty size.
	self deny: (res includes: self elementToAdd)! !

!TCopyTest methodsFor: 'requirements' stamp: 'AlexandreBergel 1/19/2009 18:08'!
empty
	^ self explicitRequirement! !

!TCopyTest methodsFor: 'tests - copy' stamp: 'CamilloBruni 11/2/2012 15:41'!
testCopyNonEmptyWith
	"self debug: #testCopyNonEmptyWith"
	| res anElement |
	anElement := self elementToAdd .
	res := self nonEmpty copyWith: anElement.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self assert: (res includes: (anElement value)).
	self nonEmpty do: [ :each | res includes: each ]! !

!TCopyTest methodsFor: 'tests - copy' stamp: 'delaunay 4/29/2009 11:10'!
testCopyNonEmptyWithoutAllNotIncluded
	"self debug: #testCopyNonEmptyWithoutAllNotIncluded"
	| res |
	res := self nonEmpty copyWithoutAll: self collectionNotIncluded.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self nonEmpty do: [ :each | self assert: (res includes: each) ]! !

!TCopyTest methodsFor: 'tests - copy' stamp: 'CamilloBruni 11/2/2012 15:53'!
testCopyEmptyWith
	"self debug: #testCopyWith"
	| res anElement |
	anElement := self elementToAdd.
	res := self empty copyWith: anElement.
	self assert: res size = (self empty size + 1).
	self assert: (res includes: (anElement value))! !

!TCopyTest methodsFor: 'tests - copy' stamp: 'stephane.ducasse 11/21/2008 17:17'!
testCopyNonEmptyWithout
	"self debug: #testCopyNonEmptyWithout"
	
	| res anElementOfTheCollection |
	anElementOfTheCollection :=  self nonEmpty anyOne.
	res := (self nonEmpty copyWithout: anElementOfTheCollection).
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self deny: (res includes: anElementOfTheCollection).
	self nonEmpty do:
		[:each | (each = anElementOfTheCollection) 
					ifFalse: [self assert: (res includes: each)]].
	
! !

!TCopyTest methodsFor: 'tests - copy' stamp: 'delaunay 4/17/2009 15:26'!
testCopyNonEmptyWithoutNotIncluded
	"self debug: #testCopyNonEmptyWithoutNotIncluded"
	| res |
	res := self nonEmpty copyWithout: self elementToAdd.
	"here we do not test the size since for a non empty set we would get a problem.
	Then in addition copy is not about duplicate management. The element should 
	be in at the end."
	self nonEmpty do: [ :each | self assert: (res includes: each) ]! !

!TCopyTest methodsFor: 'requirements' stamp: 'delaunay 4/22/2009 14:51'!
nonEmpty
	^ self explicitRequirement! !

!TCopyTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 10:29'!
elementToAdd
" return an element of type 'nonEmpy' elements'type'  not  yet included in nonEmpty" 
	^ self explicitRequirement! !

!TCopyTest methodsFor: 'tests - copy' stamp: 'HenrikSperreJohansen 10/19/2009 14:44'!
testCopyEquals
	"self debug: #testCopySameClass"
	"A copy should be equivalent to the things it's a copy of"
	
	| copy | 
	copy := self nonEmpty copy.
	self assert: copy  = self nonEmpty.! !

!TCopyTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 11:21'!
collectionWithElementsToRemove
" return a collection of elements included in 'nonEmpty'  "
	^ self explicitRequirement! !

!TCopyTest methodsFor: 'tests - copy' stamp: 'HenrikSperreJohansen 10/18/2009 00:38'!
testCopySameClass
	"self debug: #testCopySameClass"
	"A copy of a collection should always be of the same class as the instance it copies"
	
	| copy | 
	copy := self empty copy.
	self assert: copy class == self empty class.! !

!TCreationWithTest commentStamp: 'TorstenBergmann 2/20/2014 15:33'!
A trait for test purposes!
!TCreationWithTest methodsFor: 'test - creation' stamp: 'delaunay 5/14/2009 13:53'!
testWithWithWith
	"self debug: #testWithWithWith"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom:1 to: 3 .
	aCol := self collectionClass with: (collection at:1) with: ( collection at:2 ) with: ( collection at: 3).

	1 to: 3 do: [ :i | self assert: ( aCol occurrencesOf: ( collection at: i ) ) = ( collection occurrencesOf: ( collection at: i ) ) ].! !

!TCreationWithTest methodsFor: 'test - creation' stamp: 'delaunay 5/14/2009 13:53'!
testWithWithWithWithWith
	"self debug: #testWithWithWithWithWith"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom: 1 to: 5 .
	aCol := self collectionClass with: (collection at:1) with: ( collection at:2 ) with: ( collection at: 3) with: (collection at: 4 ) with: ( collection at: 5 ).

	1 to: 3 do: [ :i | self assert: ( aCol occurrencesOf: ( collection at: i ) ) = ( collection occurrencesOf: ( collection at: i ) ) ].! !

!TCreationWithTest methodsFor: 'requirements' stamp: 'stephane.ducasse 12/9/2008 18:24'!
collectionClass 
	
	^ self explicitRequirement! !

!TCreationWithTest methodsFor: 'test - creation' stamp: 'Alexandre Bergel 5/22/2010 12:26'!
testWith
	"self debug: #testWith"
	
	| aCol anElement |
	anElement := self collectionMoreThan5Elements anyOne.
	aCol := self collectionClass with: anElement.
	self assert: (aCol includes: anElement).! !

!TCreationWithTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 11:49'!
collectionMoreThan5Elements
" return a collection including at least 5 elements"
	
	^ self explicitRequirement! !

!TCreationWithTest methodsFor: 'test - creation' stamp: 'nice 4/18/2011 23:47'!
testWithWith
	"self debug: #testWithWith"
	
	| aCol collection element1 element2 |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom: 1 to: 2  .
	element1 := collection at: 1.
	element2 := collection at:2.
	
	aCol := self collectionClass with: element1  with: element2 .
	self assert: (aCol occurrencesOf: element1 ) = ( collection occurrencesOf: element1).
	self assert: (aCol occurrencesOf: element2 ) = ( collection occurrencesOf: element2).
	
	! !

!TCreationWithTest methodsFor: 'test - creation' stamp: 'stephane.ducasse 12/9/2008 21:18'!
testOfSize
	"self debug: #testOfSize"
	
	| aCol |
	aCol := self collectionClass ofSize: 3.
	self assert: (aCol size = 3).
! !

!TCreationWithTest methodsFor: 'test - creation' stamp: 'delaunay 5/14/2009 13:53'!
testWithWithWithWith
	"self debug: #testWithWithWithWith"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection copyFrom: 1 to: 4.
	aCol := self collectionClass with: (collection at:1) with: ( collection at:2 ) with: ( collection at: 3) with: ( collection at: 4).

	1 to: 3 do: [ :i | self assert: ( aCol occurrencesOf: ( collection at: i ) ) = ( collection occurrencesOf: ( collection at: i ) ) ].! !

!TCreationWithTest methodsFor: 'test - creation' stamp: 'delaunay 5/14/2009 11:57'!
testWithAll
	"self debug: #testWithAll"
	
	| aCol collection |
	collection := self collectionMoreThan5Elements asOrderedCollection .
	aCol := self collectionClass withAll: collection  .
	
	collection do: [ :each | self assert: (aCol occurrencesOf: each ) = ( collection occurrencesOf: each ) ].
	
	self assert: (aCol size = collection size ).! !

!TCreationWithTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureCreationWithTest
	self collectionMoreThan5Elements.
	self assert: self collectionMoreThan5Elements size >= 5! !

!TDateTimeTest commentStamp: '<historical>'!
I am a helper Trait for date tests. By providing methods to locally change the time zones I simplify date and time tests.!
!TDateTimeTest methodsFor: 'helpers' stamp: 'SeanDeNigris 6/20/2012 01:12'!
useNonUtcTimeZoneDuring: aBlock

	self useTimeZone: 'EDT' during: aBlock.! !

!TDateTimeTest methodsFor: 'helpers' stamp: 'SeanDeNigris 6/20/2012 01:01'!
restoreLocalTimeZoneAfter: aBlock

	| realTimeZone |
	realTimeZone := DateAndTime localTimeZone.
	aBlock ensure: [ DateAndTime localTimeZone: realTimeZone ].! !

!TDateTimeTest methodsFor: 'helpers' stamp: 'PavelKrivanek 7/8/2012 19:38'!
useTimeZone: abbreviation during: aBlock

  | timeZone |
  timeZone := TimeZone abbreviated: abbreviation.
  self restoreLocalTimeZoneAfter: [ 
    DateAndTime localTimeZone: timeZone. 
    aBlock cull: timeZone ].! !

!TDictionaryAddingTest commentStamp: 'TorstenBergmann 2/20/2014 15:33'!
A trait for test purposes!
!TDictionaryAddingTest methodsFor: 'test - adding' stamp: 'delaunay 5/5/2009 12:11'!
testAddWithKeyAlreadyIn
	| dictionary result association oldSize |
	dictionary := self nonEmptyDict.
	oldSize := dictionary size.
	association := self associationWithKeyAlreadyInToAdd .
	result := dictionary add: association.
	
	self assert: result = association.
	self assert: (dictionary at: association key) = association value.
	self assert: dictionary size = oldSize .! !

!TDictionaryAddingTest methodsFor: 'requirement' stamp: 'delaunay 5/5/2009 12:10'!
associationWithKeyAlreadyInToAdd
	" return an association that will be used to add to nonEmptyDict (the key of this association is already included in nonEmptyDict)"
	self explicitRequirement! !

!TDictionaryAddingTest methodsFor: 'test - adding' stamp: 'CamilloBruni 3/23/2013 12:07'!
testAddAll
	
	| collectionToAdd collection result oldSize |
	collection := self nonEmptyDict .
	oldSize := collection size.
	collectionToAdd := self collectionClass new 
		add: self associationWithKeyAlreadyInToAdd ; 
		add: self associationWithKeyNotInToAdd ; 
		yourself.
	
	result := collection addAll: collectionToAdd .
	
	self assert: result = collectionToAdd .
	"  the association with the key already in should have replaced the oldest :"
	self assert: collection  size = (oldSize + 1).
	
	result associationsDo: [:assoc | self assert: (collection at:  (assoc key) ) = assoc value].! !

!TDictionaryAddingTest methodsFor: 'test - adding' stamp: 'CamilloBruni 3/23/2013 12:10'!
testDeclareFrom
	| newDict v dictionary keyIn associationKeyNotIn |
	dictionary := self nonEmptyDict.
	keyIn := dictionary keys anyOne.
	associationKeyNotIn := self associationWithKeyNotInToAdd .
	newDict := self collectionClass new add: associationKeyNotIn; yourself.
	
	
	
	"if the key already exist, nothing changes"
	v := dictionary  at: keyIn.
	dictionary  declare: keyIn  from: newDict.
	self assert: (dictionary  at: keyIn ) = v.
	
	"if the key does not exist, then it gets removed from newDict and is added to the receiver"
	self nonEmptyDict declare: associationKeyNotIn key from: newDict.
	self assert: (dictionary  at: associationKeyNotIn key) = associationKeyNotIn value.
	self assert: (newDict size = 0)! !

!TDictionaryAddingTest methodsFor: 'test - adding' stamp: 'delaunay 5/5/2009 12:10'!
testAddWithKeyNotIn
	| dictionary result association oldSize |
	dictionary := self nonEmptyDict.
	oldSize := dictionary size.
	association := self associationWithKeyNotInToAdd.
	result := dictionary add: association.
	
	self assert: result = association.
	self assert: (dictionary at: association key) = association value.
	self assert: dictionary size = oldSize  + 1.! !

!TDictionaryAddingTest methodsFor: 'requirement' stamp: 'AlexandreBergel 1/6/2009 14:32'!
nonEmptyDict
	self explicitRequirement! !

!TDictionaryAddingTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureDictionaryAddingTest
	self nonEmptyDict.
	self deny: self nonEmptyDict isEmpty.
	self associationWithKeyNotInToAdd.
	self deny: (self nonEmptyDict keys includes: self associationWithKeyNotInToAdd key).
	self associationWithKeyAlreadyInToAdd.
	self assert: (self nonEmptyDict keys includes: self associationWithKeyAlreadyInToAdd key)! !

!TDictionaryAddingTest methodsFor: 'requirement' stamp: 'delaunay 5/5/2009 12:08'!
associationWithKeyNotInToAdd
	" return an association that will be used to add to nonEmptyDict (the key of this association is not included in nonEmptyDict)"
	self explicitRequirement! !

!TDictionaryAssociationAccessTest commentStamp: 'TorstenBergmann 2/20/2014 15:33'!
A trait for test purposes!
!TDictionaryAssociationAccessTest methodsFor: 'tests - dictionary assocition access' stamp: 'CamilloBruni 11/2/2012 15:28'!
testAssociationAtError

	| collection nonExistantKey |
	collection := self nonEmpty.
	nonExistantKey := self keyNotIn .

	self should: [collection associationAt: nonExistantKey] raise: Error. 

! !

!TDictionaryAssociationAccessTest methodsFor: 'requirements' stamp: 'delaunay 5/5/2009 11:08'!
nonEmpty
^ self explicitRequirement! !

!TDictionaryAssociationAccessTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureDictionaryAssocitionAccess
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self keyNotIn.
	self deny: (self nonEmpty keys includes: self keyNotIn)! !

!TDictionaryAssociationAccessTest methodsFor: 'tests - dictionary assocition access' stamp: 'CamilloBruni 11/2/2012 15:28'!
testAssociationAtIfAbsent

	| collection keyIn result |
	collection := self nonEmpty.
	keyIn := collection keys anyOne.

	result := collection associationAt: keyIn ifAbsent: [888]. 

	self assert: (result key) = keyIn.
	self assert: (result value ) = (collection at: keyIn ).

	self assert: (collection associationAt: self keyNotIn  ifAbsent: [888] ) = 888! !

!TDictionaryAssociationAccessTest methodsFor: 'tests - dictionary assocition access' stamp: 'CamilloBruni 11/2/2012 15:28'!
testAssociationAt

	| collection keyIn result |
	collection := self nonEmpty.
	keyIn := collection keys anyOne.

	result := collection associationAt: keyIn. 

	self assert: (result key) = keyIn.
	self assert: (result value ) = (collection at: keyIn ).! !

!TDictionaryAssociationAccessTest methodsFor: 'requirements' stamp: 'delaunay 5/5/2009 11:07'!
keyNotIn
" return a key not included in nonEmpty"
self explicitRequirement! !

!TDictionaryComparingTest commentStamp: 'TorstenBergmann 2/20/2014 15:33'!
A trait for test purposes!
!TDictionaryComparingTest methodsFor: 'test - comparing' stamp: 'delaunay 5/5/2009 16:41'!
testEquality
	| nonEmptyDict2 |
	nonEmptyDict2 := self nonEmpty class new.
	self nonEmpty keysAndValuesDo:  [ :key :value | nonEmptyDict2 at: key put: value  ].
	
	self assert: (self nonEmptyDict = nonEmptyDict2)! !

!TDictionaryCopyingTest commentStamp: 'TorstenBergmann 2/20/2014 15:33'!
A trait for test purposes!
!TDictionaryCopyingTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyNonEmpty
	"self debug: #testCopyNonEmpty"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: copy isEmpty.
	self assert: copy size = self nonEmpty size.
	self nonEmpty do: 
		[:each | copy includes: each]! !

!TDictionaryCopyingTest methodsFor: 'requirements' stamp: 'AlexandreBergel 1/7/2009 11:55'!
emptyDict
	self explicitRequirement! !

!TDictionaryCopyingTest methodsFor: 'requirements' stamp: 'AlexandreBergel 1/7/2009 11:55'!
nonEmptyDict
	self explicitRequirement! !

!TDictionaryCopyingTest methodsFor: 'test - copying' stamp: 'delaunay 5/6/2009 10:23'!
testDictionaryConcatenationWithCommonKeysDifferentValues

	| dictionary1 dictionary2 result value |
	
	dictionary1 := self nonEmptyDict.
	value := self nonEmptyDifferentFromNonEmptyDict   values anyOne.
	dictionary2 := dictionary1 copy.
	dictionary2 keys do: [ :key | dictionary2 at: key put: value ].
	
	
	result := dictionary1 , dictionary2.
	self assert: result size = ( dictionary2 size).
	
	dictionary2 associationsDo: [ :assoc | self assert: (result at: assoc key) = assoc value ]! !

!TDictionaryCopyingTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureCloneTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!TDictionaryCopyingTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyEmpty
	"self debug: #testCopyEmpty"
	
	| copy | 
	copy := self empty copy.
	self assert: copy isEmpty.! !

!TDictionaryCopyingTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureDictionaryCopyingTest
	| duplicateKey |
	self nonEmptyDict.
	self deny: self nonEmptyDict isEmpty.
	self nonEmptyDifferentFromNonEmptyDict.
	self deny: self nonEmptyDifferentFromNonEmptyDict isEmpty.
	duplicateKey := true.
	self nonEmptyDict keys
		detect: [ :key | self nonEmptyDifferentFromNonEmptyDict includes: key ]
		ifNone: [ duplicateKey := false ].
	self assert: duplicateKey = false! !

!TDictionaryCopyingTest methodsFor: 'tests - copy - clone' stamp: ''!
testCopyCreatesNewObject
	"self debug: #testCopyCreatesNewObject"
	
	| copy | 
	copy := self nonEmpty copy.
	self deny: self nonEmpty == copy.
	! !

!TDictionaryCopyingTest methodsFor: 'helper' stamp: ''!
empty

	^ self explicitRequirement! !

!TDictionaryCopyingTest methodsFor: 'test - copying' stamp: 'delaunay 5/6/2009 10:16'!
testDictionaryConcatenationWithCommonKeys

	| dictionary1 dictionary2 result |
	dictionary1 := self nonEmptyDict.
	dictionary2 := self nonEmptyDict.
	result := dictionary1 , dictionary2.
	self assert: result size = ( dictionary2 size).
	
	dictionary2 associationsDo: [ :assoc | self assert: (result at: assoc key) = assoc value ]! !

!TDictionaryCopyingTest methodsFor: 'requirements' stamp: 'AlexandreBergel 1/7/2009 11:55'!
newEmptyDict
	self explicitRequirement! !

!TDictionaryCopyingTest methodsFor: 'test - copying' stamp: 'delaunay 5/6/2009 10:13'!
testDictionaryConcatenationWithoutCommonKeys

	| dictionary1 dictionary2 result |
	dictionary1 := self nonEmptyDict.
	dictionary2 := self nonEmptyDifferentFromNonEmptyDict.
	result := dictionary1 , dictionary2.
	self assert: result size = (dictionary1 size + dictionary2 size).
	dictionary1 associationsDo: [ :assoc | self assert: (result at: assoc key) = assoc value ].
	dictionary2 associationsDo: [ :assoc | self assert: (result at: assoc key) = assoc value ]! !

!TDictionaryCopyingTest methodsFor: 'requirements' stamp: 'delaunay 5/5/2009 16:50'!
nonEmptyDifferentFromNonEmptyDict
" return a dictionary for which all keys are not included in nonEmptyDict"
self explicitRequirement.! !

!TDictionaryCopyingTest methodsFor: 'helper' stamp: ''!
nonEmpty

	^ self explicitRequirement! !

!TDictionaryEnumeratingTest commentStamp: 'TorstenBergmann 2/20/2014 15:33'!
A trait for test purposes!
!TDictionaryEnumeratingTest methodsFor: 'requirements' stamp: 'AlexandreBergel 1/7/2009 11:58'!
emptyDict
	self explicitRequirement! !

!TDictionaryEnumeratingTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureDictionaryEnumeratingTest
	self nonEmptyDict.
	self deny: self nonEmptyDict isEmpty! !

!TDictionaryEnumeratingTest methodsFor: 'requirements' stamp: 'AlexandreBergel 1/7/2009 11:58'!
nonEmptyDict
	self explicitRequirement! !

!TDictionaryEnumeratingTest methodsFor: 'tests - dictionnary enumerating' stamp: 'delaunay 5/5/2009 15:49'!
testKeysDo
	| collection keys |
	collection := self nonEmptyDict .
	keys := OrderedCollection new.
	collection keysDo: [ :key  | 
		keys add: key.
		].
	
	collection keys do: [ :key | self assert: (collection keys occurrencesOf: key) = (keys occurrencesOf: key)]! !

!TDictionaryEnumeratingTest methodsFor: 'tests - dictionnary enumerating' stamp: 'delaunay 5/5/2009 16:12'!
testReject
	"Ensure that Dictionary>>reject: answers a dictionary not something else"
	
	| collection result |
	collection := self nonEmptyDict .
	result := collection reject: [ :each | false].
	
	self assert: result = collection. ! !

!TDictionaryEnumeratingTest methodsFor: 'tests - dictionnary enumerating' stamp: 'delaunay 5/5/2009 16:14'!
testValuesDo
	| collection values |
	collection := self nonEmptyDict .
	values := OrderedCollection new.
	collection valuesDo: [ :value  | 
		values add: value.
		].
	
	collection values do: [ :value | self assert: (collection values occurrencesOf: value) = (values occurrencesOf: value)]! !

!TDictionaryEnumeratingTest methodsFor: 'tests - dictionnary enumerating' stamp: 'delaunay 5/5/2009 16:00'!
testAssociationsSelect
	| collection keys result |
	collection := self nonEmptyDict .
	keys := OrderedCollection new.
	result := collection associationsSelect: [ :assoc  | 
		keys add: assoc key.
		true].
	
	collection keys do: [ :key | self assert: (collection keys occurrencesOf: key) = (keys occurrencesOf: key)].
	self assert: result = collection.! !

!TDictionaryEnumeratingTest methodsFor: 'tests - dictionnary enumerating' stamp: 'delaunay 5/5/2009 16:14'!
testAssociationsDo

	| collection keys |
	collection := self nonEmptyDict .

	keys := OrderedCollection new.
	
	collection associationsDo: [ :assoc | 
		keys add: assoc key.
		self assert: ( collection at: assoc key ) = assoc value.		
		].
	
	collection keys do: [:key | self assert: ( keys occurrencesOf: key ) = (collection keys occurrencesOf: key)].! !

!TDictionaryEnumeratingTest methodsFor: 'tests - dictionnary enumerating' stamp: 'delaunay 5/5/2009 16:04'!
testCollect
	| collection values result |
	collection := self nonEmptyDict .
	values := OrderedCollection new.
	result := collection collect: [ :value  | 
		values add: value.
		].
	
	collection values do: [ :value | self assert: (collection values occurrencesOf: value) = (values occurrencesOf: value)].
	self assert: result = collection.! !

!TDictionaryEnumeratingTest methodsFor: 'tests - dictionnary enumerating' stamp: 'delaunay 5/4/2009 14:20'!
testDo
	| t collection |
	collection := self nonEmptyDict .
	t := OrderedCollection new.
	collection do: [:
		value | t add: value
		].
	
	t do: [ :each | self assert: (t occurrencesOf: each ) = ( collection values occurrencesOf: each) ].! !

!TDictionaryEnumeratingTest methodsFor: 'requirements' stamp: 'AlexandreBergel 1/7/2009 11:58'!
newEmptyDict
	self explicitRequirement! !

!TDictionaryEnumeratingTest methodsFor: 'tests - dictionnary enumerating' stamp: 'delaunay 5/5/2009 16:01'!
testSelect
	| collection values result |
	collection := self nonEmptyDict .
	values := OrderedCollection new.
	result := collection select: [ :value  | 
		values add: value.
		true].
	
	collection values do: [ :value| self assert: (collection values occurrencesOf: value) = (values occurrencesOf: value)].
	self assert: result = collection.! !

!TDictionaryEnumeratingTest methodsFor: 'tests - dictionnary enumerating' stamp: 'delaunay 5/5/2009 16:05'!
testKeysAndValuesDo

	
	| collection keys |
	collection := self nonEmptyDict .
	keys := OrderedCollection new.
	collection keysAndValuesDo: [ :key :value | 
		keys add: key.
		self assert: (collection at: key) = value ].
	
	collection keys do: [ :key | self assert: (collection keys occurrencesOf: key) = (keys occurrencesOf: key)]! !

!TDictionaryImplementationTest commentStamp: 'TorstenBergmann 2/20/2014 15:33'!
A trait for test purposes!
!TDictionaryImplementationTest methodsFor: 'test - implementation' stamp: 'CamilloBruni 8/31/2013 20:43'!
testPseudo
	"(self run: #testPseudo)"

	"true and false are valid keys"

	| dict1 |
	dict1 := self emptyDict.
	dict1 at: true put: #true.
	self assert: (dict1 at: true) = #true.
	dict1 at: false put: #false.
	self assert: (dict1 at: false) = #false! !

!TDictionaryImplementationTest methodsFor: 'test - implementation' stamp: 'CamilloBruni 8/31/2013 20:43'!
testPseudoVariablesAreValidKeys
	"(self run: #testPseudoVariablesAreValidKeys)"

	"true and false are valid keys"

	| dict1 |
	dict1 := self emptyDict.
	dict1 at: true put: #true.
	self assert: (dict1 at: true) = #true.
	dict1 at: false put: #false.
	self assert: (dict1 at: false) = #false! !

!TDictionaryImplementationTest methodsFor: 'test - implementation' stamp: 'AlexandreBergel 1/7/2009 19:29'!
testFindElementOrNil
	"Set>>findElementOrNil: takes an associaiton (when called on a dictionary) an integer, the index of the first
	position at is either equal to the assocation or which is nil"
	| assoc indexForG |
	assoc := #g -> 100.
	self assert: (self nonEmptyDict findElementOrNil: assoc key) = (self nonEmptyDict array indexOf: nil).
	
	indexForG := (#g hash \\ self emptyDict array size) + 1.
	self assert: (self emptyDict findElementOrNil: assoc key) = ((self emptyDict array indexOf: nil) max: indexForG).! !

!TDictionaryImplementationTest methodsFor: 'test - implementation' stamp: 'AlexandreBergel 1/7/2009 19:29'!
testScanFor
	"Set>>scanFor: return an integer "
	| assoc indexForG |
	assoc := #g -> 100.
	self assert: (self nonEmptyDict scanFor: assoc) = (self nonEmptyDict array indexOf: nil).

	indexForG := (#g hash \\ self emptyDict array size) + 1.
	self assert: (self emptyDict scanFor: assoc) = ((self emptyDict array indexOf: nil) max: indexForG).
! !

!TDictionaryImplementationTest methodsFor: 'test - implementation' stamp: 'CamilloBruni 8/31/2013 20:43'!
testAtNil
	"(self run: #testAtNil)"

	"nil is a valid key in Pharo. In VW nil is not a valid key"

	"Ansi 1.9 p, 168
    		5.7.2.5 Message: at: key put: newElement
    		Synopsis
    			Store newElement at key in the receiver. Answer newElement.
    		Definition: <abstractDictionary>
    		If lookup succeeds for key, then newElement replaces the element previously stored at key.
    		Otherwise, the newElement is stored at the new key. In either case, subsequent successful
    		lookups for key will answer newElement.  Answer newElement.

    		The result is undefined if the key is nil.

		This clearly indicates that different smalltalks where doing different assumptions."

	| dict1 |
	dict1 := self emptyDict.
	dict1 at: nil put: #none.
	self assert: (dict1 at: nil) = #none! !

!TDictionaryImplementationTest methodsFor: 'test - implementation' stamp: 'AlexandreBergel 1/14/2009 15:15'!
testNew
	| d |
	d := self classToBeTested new: 10.
	self assert: d size = 0.
	
	"Why 14? Mysterious"
	self assert: d capacity = 14! !

!TDictionaryImplementationTest methodsFor: 'test - implementation' stamp: 'AlexandreBergel 1/7/2009 19:29'!
testSpecies
	self assert: self nonEmptyDict species == self nonEmptyDict class.
	self assert: self emptyDict species == self emptyDict class! !

!TDictionaryIncludesTest commentStamp: 'TorstenBergmann 2/20/2014 15:33'!
A trait for test purposes!
!TDictionaryIncludesTest methodsFor: 'tests - dictionary including' stamp: 'CamilloBruni 11/2/2012 15:27'!
testIncludesAssociation

	|  nonExistantAssociation associationIn keyIn valueIn |

	keyIn := self nonEmpty keys anyOne.
	valueIn := self nonEmpty values anyOne. 
	nonExistantAssociation := self keyNotInNonEmpty -> self valueNotInNonEmpty .
	associationIn := self nonEmpty associations anyOne.	

	self assert:  (self nonEmpty includesAssociation: associationIn ).
	self deny:  (self nonEmpty includesAssociation: nonExistantAssociation ).
	" testing the case where key is included but not with the same value :"
	self deny: (self nonEmpty includesAssociation: (keyIn-> self valueNotInNonEmpty )).
	" testing the case where value is included but not corresponding key :"
	self deny: (self nonEmpty includesAssociation: (self keyNotInNonEmpty -> valueIn  )).



! !

!TDictionaryIncludesTest methodsFor: 'tests - dictionary including' stamp: 'delaunay 4/30/2009 10:47'!
testIncludesComportementForDictionnary
	| valueIn collection keyIn |
	collection := self nonEmpty.
	valueIn := collection values anyOne.
	keyIn := collection keys anyOne.
	self assert: (collection includes: valueIn).
	self deny: (collection includes: self valueNotInNonEmpty).
	" testing that includes take only care of values :"
	self deny: (collection includes: keyIn)! !

!TDictionaryIncludesTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 14:41'!
keyNotInNonEmpty
	" return a key not included in nonEmpty"
	^ self explicitRequirement! !

!TDictionaryIncludesTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 14:41'!
valueNotInNonEmpty
	" return a value not included in nonEmpty"
	^ self explicitRequirement! !

!TDictionaryIncludesTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureDictionaryIncludes
	| in |
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self valueNotInNonEmpty.
	in := false.
	self nonEmpty
		valuesDo: [ :assoc | 
			assoc = self valueNotInNonEmpty
				ifTrue: [ in := true ] ].
	self assert: in = false.
	self keyNotInNonEmpty.
	in := false.
	self nonEmpty
		keysDo: [ :assoc | 
			assoc = self keyNotInNonEmpty
				ifTrue: [ in := true ] ].
	self assert: in = false! !

!TDictionaryIncludesTest methodsFor: 'tests - dictionary including' stamp: 'delaunay 5/12/2009 10:31'!
testIncludesIdentityBasicComportement

| valueIn collection |
collection := self nonEmpty .
valueIn := collection  values anyOne.

self assert: (collection includesIdentity: valueIn ) .
self deny: (collection includesIdentity: self valueNotInNonEmpty ).! !

!TDictionaryIncludesTest methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 14:25'!
nonEmpty

^self explicitRequirement! !

!TDictionaryIncludesTest methodsFor: 'tests - dictionary including' stamp: 'CamilloBruni 11/2/2012 15:27'!
testIncludesKey

	| collection keyIn nonExistantKey |

	collection := self nonEmpty .
	keyIn := collection keys anyOne.
	nonExistantKey := self keyNotInNonEmpty. 

	self assert: ( collection includesKey: keyIn ).
	self deny: ( collection includesKey: nonExistantKey ).! !

!TDictionaryIncludesWithIdentityCheckTest commentStamp: 'TorstenBergmann 2/20/2014 15:33'!
A trait for test purposes!
!TDictionaryIncludesWithIdentityCheckTest methodsFor: 'tests - dictionary including' stamp: ''!
testIncludesAssociation

	|  nonExistantAssociation associationIn keyIn valueIn |

	keyIn := self nonEmpty keys anyOne.
	valueIn := self nonEmpty values anyOne. 
	nonExistantAssociation := self keyNotInNonEmpty -> self valueNotInNonEmpty .
	associationIn := self nonEmpty associations anyOne.	

	self assert:  (self nonEmpty includesAssociation: associationIn ).
	self deny:  (self nonEmpty includesAssociation: nonExistantAssociation ).
	" testing the case where key is included but not with the same value :"
	self deny: (self nonEmpty includesAssociation: (keyIn-> self valueNotInNonEmpty )).
	" testing the case where value is included but not corresponding key :"
	self deny: (self nonEmpty includesAssociation: (self keyNotInNonEmpty -> valueIn  )).



! !

!TDictionaryIncludesWithIdentityCheckTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureDictionaryIncludesIdentity
	self nonEmptyWithCopyNonIdentical.
	self deny: self nonEmptyWithCopyNonIdentical isEmpty.
	self nonEmptyWithCopyNonIdentical do: [ :each | self deny: each == each copy ]! !

!TDictionaryIncludesWithIdentityCheckTest methodsFor: 'tests - dictionary including' stamp: ''!
testIncludesComportementForDictionnary
	| valueIn collection keyIn |
	collection := self nonEmpty.
	valueIn := collection values anyOne.
	keyIn := collection keys anyOne.
	self assert: (collection includes: valueIn).
	self deny: (collection includes: self valueNotInNonEmpty).
	" testing that includes take only care of values :"
	self deny: (collection includes: keyIn)! !

!TDictionaryIncludesWithIdentityCheckTest methodsFor: 'requirements' stamp: ''!
keyNotInNonEmpty
	" return a key not included in nonEmpty"
	^ self explicitRequirement! !

!TDictionaryIncludesWithIdentityCheckTest methodsFor: 'requirements' stamp: ''!
valueNotInNonEmpty
	" return a value not included in nonEmpty"
	^ self explicitRequirement! !

!TDictionaryIncludesWithIdentityCheckTest methodsFor: 'tests - dictionary including' stamp: 'delaunay 5/12/2009 11:10'!
testIncludesIdentitySpecificComportement

| valueIn collection |
collection := self nonEmptyWithCopyNonIdentical  .
valueIn := collection  values anyOne.

self assert: (collection includesIdentity: valueIn ) .
self deny: (collection includesIdentity: valueIn copy ) .
! !

!TDictionaryIncludesWithIdentityCheckTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureDictionaryIncludes
	| in |
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self valueNotInNonEmpty.
	in := false.
	self nonEmpty
		valuesDo: [ :assoc | 
			assoc = self valueNotInNonEmpty
				ifTrue: [ in := true ] ].
	self assert: in = false.
	self keyNotInNonEmpty.
	in := false.
	self nonEmpty
		keysDo: [ :assoc | 
			assoc = self keyNotInNonEmpty
				ifTrue: [ in := true ] ].
	self assert: in = false! !

!TDictionaryIncludesWithIdentityCheckTest methodsFor: 'tests - dictionary including' stamp: ''!
testIncludesIdentityBasicComportement

| valueIn collection |
collection := self nonEmpty .
valueIn := collection  values anyOne.

self assert: (collection includesIdentity: valueIn ) .
self deny: (collection includesIdentity: self valueNotInNonEmpty ).! !

!TDictionaryIncludesWithIdentityCheckTest methodsFor: 'requirements' stamp: 'delaunay 5/12/2009 11:02'!
nonEmptyWithCopyNonIdentical.
" return a collection including elements for wich copy is not identical to the initial element ( this is not the cas of Integer )"
^self explicitRequirement! !

!TDictionaryIncludesWithIdentityCheckTest methodsFor: 'requirements' stamp: ''!
nonEmpty

^self explicitRequirement! !

!TDictionaryIncludesWithIdentityCheckTest methodsFor: 'tests - dictionary including' stamp: ''!
testIncludesKey

	| collection keyIn nonExistantKey |

	collection := self nonEmpty .
	keyIn := collection keys anyOne.
	nonExistantKey := self keyNotInNonEmpty. 

	self assert: ( collection includesKey: keyIn ).
	self deny: ( collection includesKey: nonExistantKey ).! !

!TDictionaryKeyAccessTest commentStamp: 'TorstenBergmann 2/20/2014 15:34'!
A trait for test purposes!
!TDictionaryKeyAccessTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureDictionaryKeyAccess
	| collection equals |
	self nonEmptyWithoutEqualsValues.
	self deny: self nonEmptyWithoutEqualsValues isEmpty.
	equals := true.
	collection := self nonEmptyWithoutEqualsValues values.
	collection detect: [ :each | (collection occurrencesOf: each) > 1 ] ifNone: [ equals := false ].
	self assert: equals = false.
	self valueNotIn.
	self deny: (self nonEmptyWithoutEqualsValues values includes: self valueNotIn)! !

!TDictionaryKeyAccessTest methodsFor: 'tests - dictionary key access' stamp: 'delaunay 5/5/2009 10:31'!
testKeyAtValueIfAbsent
	"self run: #testKeyAtValue"
	"self debug: #testKeyAtValue"
	
	| dict value result |
	dict := self nonEmpty .
	value := dict values anyOne.
	
	result := dict keyAtValue: value ifAbsent: [nil].
	self assert: (dict at: result) = value.
		
	self assert: (dict keyAtValue: self valueNotIn ifAbsent: [nil] ) = nil. 
	
	! !

!TDictionaryKeyAccessTest methodsFor: 'requirements' stamp: 'delaunay 5/5/2009 11:07'!
valueNotIn
" return a value not included in nonEmptyWithoutEqualValues "
^self explicitRequirement! !

!TDictionaryKeyAccessTest methodsFor: 'requirements' stamp: 'delaunay 5/5/2009 10:34'!
nonEmptyWithoutEqualsValues
" return a dictionary that doesn't include equal values'"
^self explicitRequirement! !

!TDictionaryKeyAccessTest methodsFor: 'tests - dictionary key access' stamp: 'delaunay 5/5/2009 10:26'!
testKeyAtValue
	"self run: #testKeyAtValue"
	"self debug: #testKeyAtValue"
	
	| dict value result |
	dict := self nonEmpty .
	value := dict values anyOne.
	
	result := dict keyAtValue: value.
	self assert: (dict at: result) = value.
		
	self should: [dict keyAtValue: self valueNotIn ] raise: Error
	
	! !

!TDictionaryKeyAccessTest methodsFor: 'tests - dictionary key access' stamp: 'delaunay 5/5/2009 10:32'!
testKeyAtIdentityValue
	
	
	| dict value result |
	dict := self nonEmpty .
	value := dict values anyOne.
	
	result := dict keyAtIdentityValue: value.
	self assert: (dict at: result) = value.
		
	self should: [dict keyAtIdentityValue: self valueNotIn ] raise: Error
	
	! !

!TDictionaryKeyAccessTest methodsFor: 'tests - dictionary key access' stamp: 'delaunay 5/5/2009 10:33'!
testKeyAtIdentityValueIfAbsent
	"self run: #testKeyAtValue"
	"self debug: #testKeyAtValue"
	
	| dict value result |
	dict := self nonEmpty .
	value := dict values anyOne.
	
	result := dict keyAtIdentityValue: value ifAbsent: [nil].
	self assert: (dict at: result) = value.
		
	self assert: (dict keyAtIdentityValue: self valueNotIn ifAbsent: [nil] ) = nil. 
	! !

!TDictionaryKeysValuesAssociationsAccess commentStamp: 'TorstenBergmann 2/20/2014 15:34'!
A trait for test purposes!
!TDictionaryKeysValuesAssociationsAccess methodsFor: 'tests - Dictionary keys values associations access' stamp: 'CamilloBruni 8/31/2013 20:43'!
testKeysSortedSafely
	| collection result |
	collection := self nonEmpty.
	result := collection keysSortedSafely.
	result do: [ :key | collection at: key ].
	self assert: result size = collection size.
	self should: [ result detect: [ :each | (result occurrencesOf: each) > 1 ] ] raise: Error.
	self assert: result asArray isSorted! !

!TDictionaryKeysValuesAssociationsAccess methodsFor: 'tests - Dictionary keys values associations access' stamp: 'delaunay 5/5/2009 10:02'!
testAssociations

	| collection result  |
	collection := self nonEmpty .
	result := collection associations.
	
	self assert: result size = collection size.
	result do: [:assoc | self assert: (assoc value) = (collection at: assoc key) ].
	"keys do: [ :key | self assert: ( result at: key ) = ( collection at: key )] ."
	! !

!TDictionaryKeysValuesAssociationsAccess methodsFor: 'tests - Dictionary keys values associations access' stamp: 'CamilloBruni 8/31/2013 20:43'!
testKeys
	| collection result |
	collection := self nonEmpty.
	result := collection keys.
	result do: [ :key | collection at: key ].
	self assert: result size = collection size.
	self should: [ result detect: [ :each | (result occurrencesOf: each) > 1 ] ] raise: Error! !

!TDictionaryKeysValuesAssociationsAccess methodsFor: 'requirements' stamp: 'delaunay 5/4/2009 16:59'!
nonEmpty

self explicitRequirement.! !

!TDictionaryKeysValuesAssociationsAccess methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureDictionaryKeysValuesAssociationsAccess
	self nonEmpty.
	self deny: self nonEmpty isEmpty! !

!TDictionaryKeysValuesAssociationsAccess methodsFor: 'tests - Dictionary keys values associations access' stamp: 'delaunay 5/4/2009 16:58'!
testValues
	
	| collection result |
	collection := self nonEmpty .
	result := collection values.
	
	self assert: result size = collection size.
	result do: [:each | self assert: (collection occurrencesOf:each ) = (result occurrencesOf: each) ].
	! !

!TDictionaryPrintingTest commentStamp: 'TorstenBergmann 2/20/2014 15:34'!
A trait for test purposes!
!TDictionaryPrintingTest methodsFor: 'requirements' stamp: 'AlexandreBergel 1/7/2009 19:32'!
newEmptyDict
	self explicitRequirement! !

!TDictionaryPrintingTest methodsFor: 'requirements' stamp: 'AlexandreBergel 1/7/2009 19:32'!
emptyDict
	self explicitRequirement! !

!TDictionaryPrintingTest methodsFor: 'test - printing' stamp: 'PeterHugossonMiller 9/3/2009 11:33'!
testPrintElementsOn
	| str |
	str := String new writeStream.
	self nonEmptyDict printElementsOn: str.
	self assert: (str contents = '(#a->1 #b->30 #c->1 #d->-2 )')! !

!TDictionaryPrintingTest methodsFor: 'requirements' stamp: 'AlexandreBergel 1/7/2009 19:32'!
nonEmptyDict
	self explicitRequirement! !

!TDictionaryPrintingTest methodsFor: 'test - printing' stamp: 'PeterHugossonMiller 9/3/2009 11:33'!
testStoreOn
	| str |
	str := String new writeStream.
	self nonEmptyDict storeOn: str.
	self assert: str contents = '((Dictionary new) add: (#b->30); add: (#c->1); add: (#d->-2); add: (#a->1); yourself)'! !

!TDictionaryRemovingTest commentStamp: 'TorstenBergmann 2/20/2014 15:34'!
A trait for test purposes!
!TDictionaryRemovingTest methodsFor: 'requirements' stamp: 'AlexandreBergel 1/7/2009 19:43'!
emptyDict
	self explicitRequirement! !

!TDictionaryRemovingTest methodsFor: 'test - removing' stamp: 'stephane.ducasse 1/8/2009 14:36'!
testRemove

	self should: [self nonEmptyDict remove: nil] raise: Error.
	self should: [self nonEmptyDict remove: nil ifAbsent: ['What ever here']] raise: Error.! !

!TDictionaryRemovingTest methodsFor: 'test - removing' stamp: 'delaunay 5/5/2009 15:19'!
testKeysAndValuesRemove
	| oldSize collection keyIn |
	
	collection := self nonEmptyDict .
	oldSize := collection  size.
	keyIn := collection keys anyOne.
	
	collection  keysAndValuesRemove: [:key :value | key == self keyNotInNonEmptyDict ].
	self assert: (collection  size = (oldSize )).
	
	collection  keysAndValuesRemove: [:key :value | key == keyIn ].
	self assert: (collection  size = (oldSize - 1)).
	self should: [ collection at: keyIn  ] raise: Error.! !

!TDictionaryRemovingTest methodsFor: 'requirements' stamp: 'AlexandreBergel 1/7/2009 19:43'!
nonEmptyDict
	self explicitRequirement! !

!TDictionaryRemovingTest methodsFor: 'requirements' stamp: 'delaunay 5/5/2009 14:53'!
keyNotInNonEmptyDict
" return a key not included in nonEmptyDict"
	self explicitRequirement! !

!TDictionaryRemovingTest methodsFor: 'requirements' stamp: 'AlexandreBergel 1/7/2009 19:43'!
newEmptyDict
	self explicitRequirement! !

!TDictionaryRemovingTest methodsFor: 'test - removing' stamp: 'delaunay 5/5/2009 15:22'!
testRemoveKeyIfAbsent
	
	| collection oldSize keyIn value result |
	collection := self nonEmptyDict .
	oldSize := collection size.
	keyIn := collection  keys anyOne.
	value := collection at: keyIn .
	
	result := collection removeKey: keyIn ifAbsent: [888].
	
	self assert: result = value.
	self assert: (collection  size = (oldSize - 1)).
	self should: [ (collection  at: keyIn )] raise: Error.
	
	self assert: (collection removeKey: self keyNotInNonEmptyDict ifAbsent: [888] ) = 888.! !

!TDictionaryRemovingTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureDictionaryRemovingTest
	self nonEmptyDict.
	self deny: self nonEmptyDict isEmpty.
	self keyNotInNonEmptyDict.
	self deny: (self nonEmptyDict keys includes: self keyNotInNonEmptyDict)! !

!TDictionaryRemovingTest methodsFor: 'test - removing' stamp: 'delaunay 5/5/2009 15:22'!
testRemoveKey
	"self debug: #testRemoveKey"

	| collection oldSize keyIn |
	collection := self nonEmptyDict .
	oldSize := collection size.
	keyIn := collection  keys anyOne.
	
	collection removeKey: keyIn .
	self assert: (collection  size = (oldSize - 1)).
	self should: [ (collection  at: keyIn )] raise: Error.
	
	self should: [collection removeKey: self keyNotInNonEmptyDict ] raise: Error! !

!TDictionaryValueAccessTest commentStamp: 'TorstenBergmann 2/20/2014 15:34'!
A trait for test purposes!
!TDictionaryValueAccessTest methodsFor: 'tests - DictionaryIndexAccessing' stamp: 'CamilloBruni 8/31/2013 20:43'!
testAtError
	"self run: #testAtError"

	| dict nonExistantKey keyIn |
	dict := self nonEmpty.
	nonExistantKey := self keyNotIn.
	keyIn := dict keys anyOne.
	dict at: keyIn.
	self should: [ dict at: nonExistantKey ] raise: Error! !

!TDictionaryValueAccessTest methodsFor: 'tests - DictionaryIndexAccessing' stamp: 'CamilloBruni 11/2/2012 15:28'!
testAtIfPresent
	"self run: #testAtIfAbsent"
	
	| t collection association nonExistantKey |
	collection := self nonEmpty .
	association := collection associations anyOne.
	nonExistantKey := self keyNotIn . 
	
	t := false.
	self nonEmptyDict at: association key ifPresent: [:x | t := (x = association value)].
	self assert: t.
	
	self assert: (self nonEmptyDict at: association key ifPresent: [:x | 'ABCDEF']) =  'ABCDEF'.

	self assert: (self nonEmptyDict at: nonExistantKey  ifPresent: [:x | Error signal]) isNil
! !

!TDictionaryValueAccessTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureDictionaryElementAccess
	| in |
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self keyNotIn.
	in := true.
	self nonEmpty keys detect: [ :key | key = self keyNotIn ] ifNone: [ in := false ].
	self assert: in = false! !

!TDictionaryValueAccessTest methodsFor: 'tests - DictionaryIndexAccessing' stamp: 'delaunay 5/5/2009 10:52'!
testAtIfAbsentPut
	| collection association |
	collection := self nonEmpty .
	association := collection associations anyOne.
	
	collection at: association key ifAbsentPut: [ 888 ].
	self assert: (collection at: association key) = association value.
	
	collection at: self keyNotIn  ifAbsentPut: [ 888 ].
	self assert: ( collection at: self keyNotIn ) = 888.! !

!TDictionaryValueAccessTest methodsFor: 'tests - DictionaryIndexAccessing' stamp: 'CamilloBruni 11/2/2012 15:31'!
testAtPutNil
	"self run: #testAtPut"
	"self debug: #testAtPut"
	
	| aDictionary keyIn |
	aDictionary := self nonEmpty .
	keyIn := aDictionary keys anyOne.
	
	aDictionary at: nil put: 'new'.
	self assert: (aDictionary at: nil) = 'new'.
	
	aDictionary at: keyIn  put: nil.
	self assert: (aDictionary at: keyIn ) isNil.
	
	aDictionary at: self keyNotIn put: nil.
	self assert: ( aDictionary at: self keyNotIn ) isNil.
	
	aDictionary at: nil put: nil.
	self assert: (aDictionary at: nil) isNil.! !

!TDictionaryValueAccessTest methodsFor: 'requirements' stamp: 'delaunay 5/4/2009 15:33'!
nonEmpty

^ self explicitRequirement! !

!TDictionaryValueAccessTest methodsFor: 'tests - DictionaryIndexAccessing' stamp: 'delaunay 5/5/2009 11:41'!
testAtPutDict
	"self run: #testAtPutDict"
	"self debug: #testAtPutDict"
	
	| adictionary keyIn |
	adictionary := self nonEmpty .
	keyIn := adictionary keys anyOne.
	
	adictionary at: keyIn put: 'new'.
	self assert: (adictionary at: keyIn ) = 'new'.
	
	adictionary at: keyIn  put: 'newnew'.
	self assert: (adictionary at: keyIn ) = 'newnew'.
	
	adictionary at: self keyNotIn  put: 666.
	self assert: (adictionary at: self keyNotIn  ) = 666.! !

!TDictionaryValueAccessTest methodsFor: 'tests - DictionaryIndexAccessing' stamp: 'delaunay 5/4/2009 15:51'!
testAt
	| collection association |
	collection := self nonEmpty .
	association := collection associations anyOne.
	
	self assert: (collection at: association key) = association value.! !

!TDictionaryValueAccessTest methodsFor: 'tests - DictionaryIndexAccessing' stamp: 'delaunay 5/5/2009 10:48'!
testAtIfAbsent
	| collection association |
	collection := self nonEmpty .
	association := collection associations anyOne.
	
	self assert: (collection at: association key ifAbsent: [ 888 ]) = association value.
	self assert: (collection at: self keyNotIn  ifAbsent: [ 888 ]) = 888.! !

!TDictionaryValueAccessTest methodsFor: 'requirements' stamp: 'delaunay 5/4/2009 15:52'!
keyNotIn
" return a key not included in nonEmpty"
^ self explicitRequirement! !

!TEasilyThemed commentStamp: 'gvc 5/18/2007 11:55'!
Trait providing useful theme-related methods.!
!TEasilyThemed methodsFor: 'services' stamp: 'gvc 1/10/2007 14:46'!
questionWithoutCancel: aStringOrText
	"Open a question dialog."

	^self questionWithoutCancel: aStringOrText title: 'Question' translated! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 9/18/2006 12:51'!
newAutoAcceptTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/8/2007 16:34'!
newColorChooserFor: aModel getColor: getSel setColor: setSel help: helpText
	"Answer a color chooser with the given selectors."

	^self theme
		newColorChooserIn: self
		for: aModel
		getColor: getSel
		setColor: setSel
		getEnabled: nil
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'GaryChambers 10/5/2010 13:23'!
newWindowFor: aModel title: titleString
	"Answer a new window morph."
	
	^self theme
		newWindowIn: self
		for: aModel
		title: titleString! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/25/2006 15:56'!
newGroupbox
	"Answer a plain groupbox."

	^self theme
		newGroupboxIn: self! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 1/10/2007 11:13'!
deny: aStringOrText
	"Open a denial dialog."

	^self deny: aStringOrText title: 'Access Denied' translated! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 9/22/2006 09:24'!
newColorChooserFor: aModel getColor: getSel setColor: setSel getEnabled: enabledSel help: helpText
	"Answer a color chooser with the given selectors."

	^self theme
		newColorChooserIn: self
		for: aModel
		getColor: getSel
		setColor: setSel
		getEnabled: enabledSel
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 9/2/2009 15:00'!
newIncrementalSliderFor: aModel getValue: getSel setValue: setSel min: min max: max quantum: quantum getEnabled: enabledSel help: helpText
	"Answer an inremental slider with the given selectors."

	^self theme
		newIncrementalSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: min
		max: max
		quantum: quantum
		getEnabled: enabledSel
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'GaryChambers 1/20/2011 12:20'!
newLabelGroup: labelsAndControls font: aFont labelColor: aColor
	"Answer a morph laid out with a column of labels and a column of associated controls.
	Controls having a vResizing value of #spaceFill will
	cause their row to use #spaceFill also, otherwise #shrinkWrap."

	^self theme
		newLabelGroupIn: self
		for: labelsAndControls
		font: aFont
		labelColor: aColor
! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/25/2006 10:20'!
newCloseButton
	"Answer a new close button."

	^self newCloseButtonFor: self ! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/25/2006 10:21'!
newGroupbox: aString
	"Answer a groupbox with the given label."

	^self theme
		newGroupboxIn: self
		label: aString! !

!TEasilyThemed methodsFor: 'theme' stamp: 'EstebanLorenzano 5/14/2013 09:43'!
theme
	"Answer the ui theme that provides controls."

	^ Smalltalk ui theme! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/9/2007 11:30'!
newSliderFor: aModel getValue: getSel setValue: setSel getEnabled: enabledSel help: helpText
	"Answer a slider with the given selectors."

	^self theme
		newSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: 0
		max: 1
		quantum: nil
		getEnabled: enabledSel
		help: helpText! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 12/18/2006 11:21'!
fileOpen: title extensions: exts path: path
	"Answer the result of a file open dialog with the given title, extensions to show and path."

	^self 
		fileOpen: title
		extensions: exts
		path: path
		preview: nil! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 1/14/2009 15:38'!
newButtonFor: aModel getState: stateSel action: actionSel arguments: args getEnabled: enabledSel labelForm: aForm help: helpText
	"Answer a new button."

	^self theme
		newButtonIn: self for: aModel
		getState: stateSel
		action: actionSel
		arguments: args
		getEnabled: enabledSel 
		label: (AlphaImageMorph new image: aForm)
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 5/15/2007 17:40'!
newPanel
	"Answer a new panel."

	^self theme
		newPanelIn: self! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/2/2007 10:38'!
newPluggableDialogWindow: title
	"Answer a new pluggable dialog with the given content."

	^self
		newPluggableDialogWindow: title
		for: nil! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/8/2007 14:38'!
newSVSelector: aColor help: helpText
	"Answer a saturation-volume selector with the given color."

	^self theme
		newSVSelectorIn: self
		color: aColor
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/7/2007 11:48'!
newListFor: aModel list: listSelector selected: getSelector changeSelected: setSelector help: helpText
	"Answer a list for the given model."

	^self
		newListFor: aModel
		list: listSelector
		selected: getSelector
		changeSelected: setSelector
		getEnabled: nil
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 10/12/2006 16:09'!
newMenu
	"Answer a new menu."

	^self theme
		newMenuIn: self
		for: self! !

!TEasilyThemed methodsFor: 'services' stamp: 'BenjaminVanRyseghem 5/13/2011 14:21'!
centeredAlert: aStringOrText title: aString configure: aBlock
	"Open an alert dialog.
	Configure the dialog with the 1 argument block
	before opening modally."

	^self theme
		centeredAlertIn: self
		text: aStringOrText
		title: aString
		configure: aBlock! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 10/12/2006 16:09'!
newMenuFor: aModel
	"Answer a new menu."

	^self theme
		newMenuIn: self
		for: aModel! !

!TEasilyThemed methodsFor: 'controls' stamp: 'GaryChambers 12/21/2011 11:34'!
newBasicTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel menu: menuSelector
	"Answer a text editor for the given model."

	^self theme
		newBasicTextEditorIn: self
		for: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel
		menu: menuSelector! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/8/2007 16:58'!
newMorphDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel getEnabled: enabledSel useIndex: useIndex help: helpText
	"Answer a morph drop list for the given model."

	^self theme
		newMorphDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		useIndex: useIndex
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/8/2007 15:13'!
newAlphaImage: aForm help: helpText
	"Answer an alpha image morph."

	^self theme
		newAlphaImageIn: self
		image: aForm
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 10/17/2008 13:25'!
newRadioButtonFor: aModel getSelected: getSel setSelected: setSel getEnabled: enabledSel label: stringOrText help: helpText
	"Answer a checkbox (radio button appearance) with the given label."

	^self theme
		newRadioButtonIn: self
		for: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		label: stringOrText
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 10/21/2009 14:44'!
newStack: controls
	"Answer a morph laid out with a stack of controls."

	^self theme
		newStackIn: self
		for: controls! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 5/3/2007 13:38'!
chooseFont
	"Answer the result of a font selector dialog."

	^self chooseFont: nil! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 8/29/2006 16:51'!
message: aStringOrText
	"Open a message dialog."

	^self message: aStringOrText title: 'Information' translated! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 10/17/2008 13:24'!
newButtonFor: aModel action: actionSel getEnabled: enabledSel label: stringOrText help: helpText
	"Answer a new button."

	^self
		newButtonFor: aModel
		getState: nil
		action: actionSel
		arguments: nil
		getEnabled: enabledSel 
		label: stringOrText
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 9/26/2006 11:39'!
newAlphaSelector: aModel getAlpha: getSel setAlpha: setSel help: helpText
	"Answer an alpha channel selector with the given selectors."

	^self theme
		newAlphaSelectorIn: self
		for: aModel
		getAlpha: getSel
		setAlpha: setSel
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 1/30/2009 14:07'!
newBalloonHelp: aTextStringOrMorph for: aMorph corner: cornerSymbol
	"Answer a new balloon help with the given contents for aMorph
	at a given corner."

	^self theme
		newBalloonHelpIn: self
		contents: aTextStringOrMorph
		for: aMorph
		corner: cornerSymbol! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 1/15/2007 14:45'!
chooseDirectory: title path: path
	"Answer the result of a file dialog with the given title, answer a directory."

	^self theme
		chooseDirectoryIn: self
		title: title
		path: path! !

!TEasilyThemed methodsFor: 'controls' stamp: 'GaryChambers 12/21/2011 11:34'!
newBasicTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel
	"Answer a text editor for the given model."

	^self
		newBasicTextEditorFor: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel
		menu: nil! !

!TEasilyThemed methodsFor: 'controls' stamp: 'GaryChambers 12/21/2011 11:30'!
newTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel menu: menuSelector
	"Answer a text editor for the given model."

	^self theme
		newTextEditorIn: self
		for: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel
		menu: menuSelector! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 4/15/2008 22:58'!
longMessage: aStringOrText title: aString
	"Open a (long) message dialog."

	^self theme
		longMessageIn: self
		text: aStringOrText
		title: aString! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 10/17/2008 13:24'!
newCheckboxFor: aModel getSelected: getSel setSelected: setSel getEnabled: enabledSel label: stringOrText help: helpText
	"Answer a checkbox with the given label."

	^self theme
		newCheckboxIn: self
		for: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		label: stringOrText
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 9/3/2009 13:23'!
newAutoAcceptTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel font: aFont help: helpText
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel
		font: aFont
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 5/15/2007 17:39'!
newDialogPanel
	"Answer a new main dialog panel."

	^self theme
		newDialogPanelIn: self! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 9/22/2006 11:04'!
chooseColor: aColor title: title
	"Answer the result of a color selector dialog with the given title and initial colour."

	^self theme
		chooseColorIn: self
		title: title
		color: aColor! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 10/17/2008 13:24'!
newCheckboxFor: aModel getSelected: getSel setSelected: setSel label: stringOrText help: helpText
	"Answer a checkbox with the given label."

	^self theme
		newCheckboxIn: self
		for: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: nil
		label: stringOrText
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 10/17/2008 13:24'!
newButtonFor: aModel getState: stateSel action: actionSel arguments: args getEnabled: enabledSel label: stringOrText help: helpText
	"Answer a new button."

	^self theme
		newButtonIn: self for: aModel
		getState: stateSel
		action: actionSel
		arguments: args
		getEnabled: enabledSel 
		label: stringOrText
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/25/2006 10:33'!
newCancelButtonFor: aModel
	"Answer a new cancel button."

	^self theme
		newCancelButtonIn: self
		for: aModel! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/2/2007 10:38'!
newPluggableDialogWindow: title for: contentMorph
	"Answer a new pluggable dialog with the given content."

	^self theme
		newPluggableDialogWindowIn: self
		title: title
		for: contentMorph! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/25/2006 10:22'!
newGroupbox: aString for: control
	"Answer a groupbox with the given label and control."

	^self theme
		newGroupboxIn: self
		label: aString
		for: control! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/25/2006 10:23'!
newOKButton
	"Answer a new OK button."

	^self newOKButtonFor: self! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/9/2007 13:00'!
newFuzzyLabelFor: aModel label: aString getEnabled: enabledSel
	"Answer a new fuzzy label."

	^self theme
		newFuzzyLabelIn: self
		for: aModel
		label: aString
		offset: 1
		alpha: 0.5
		getEnabled: enabledSel! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 9/18/2006 12:56'!
newTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel 
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 1/10/2007 14:25'!
newYesButton
	"Answer a new Yes button."

	^self newYesButtonFor: self! !

!TEasilyThemed methodsFor: 'controls' stamp: 'AlainPlantec 11/26/2010 10:30'!
newAutoAcceptTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel help: helpText entryCompletion: anEntryCompletion
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel
		help: helpText
		entryCompletion: anEntryCompletion! !

!TEasilyThemed methodsFor: 'controls' stamp: 'GaryChambers 8/17/2010 15:57'!
newEditableDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel addToList: addSel class: aClass default: defaultValue ghostText: ghostText getEnabled: enabledSel useIndex: useIndex help: helpText
	"Answer an editable drop list for the given model."

	^self theme
		newEditableDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		addToList: addSel
		class: aClass
		default: defaultValue
		ghostText: ghostText
		getEnabled: enabledSel
		useIndex: useIndex
		help: helpText! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 5/3/2007 14:19'!
chooseColor
	"Answer the result of a color selector dialog ."

	^self chooseColor: Color black! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/9/2007 13:32'!
newMorphDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel help: helpText
	"Answer a morph drop list for the given model."

	^self 
		newMorphDropListFor: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: nil
		useIndex: true
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'GaryChambers 7/15/2011 10:18'!
newListFor: aModel list: listSelector selected: getSelector changeSelected: setSelector icon: iconSelector getEnabled: enabledSel help: helpText
	"Answer a list for the given model."

	^self theme
		newListIn: self
		for: aModel
		list: listSelector
		selected: getSelector
		changeSelected: setSelector
		icon: iconSelector
		getEnabled: enabledSel
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/9/2007 11:42'!
newString: aStringOrText font: aFont style: aStyle
	"Answer a new embossed string."

	^self theme
		newStringIn: self
		label: aStringOrText
		font: aFont
		style: aStyle! !

!TEasilyThemed methodsFor: 'controls' stamp: 'GaryChambers 4/24/2012 12:43'!
newCheckboxFor: aModel getSelected: getSel setSelected: setSel getEnabled: enabledSel getLabel: labelSel help: helpText
	"Answer a checkbox with the given label."

	^self theme
		newCheckboxIn: self
		for: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		getLabel: labelSel
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/9/2007 13:32'!
newMorphDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel getEnabled: enabledSel help: helpText
	"Answer a morph drop list for the given model."

	^self 
		newMorphDropListFor: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		useIndex: true
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/8/2007 16:03'!
newDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel getEnabled: enabledSel useIndex: useIndex help: helpText
	"Answer a drop list for the given model."

	^self theme
		newDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		useIndex: useIndex
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 9/18/2006 13:00'!
newTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel 
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 9/19/2006 10:06'!
newToolbar
	"Answer a toolbar."

	^self theme
		newToolbarIn: self! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/8/2007 16:03'!
newDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel help: helpText
	"Answer a drop list for the given model."

	^self
		newDropListFor: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: nil
		useIndex: true
		help: helpText! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 5/3/2007 13:38'!
chooseFont: aFont 
	"Answer the result of a font selector dialog with the given initial font."

	^self theme
		chooseFontIn: self
		title: 'Font Selector' translated
		font: aFont! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/25/2006 10:20'!
newCloseButtonFor: aModel
	"Answer a new close button."

	^self theme
		newCloseButtonIn: self
		for: aModel! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 8/31/2006 15:32'!
fileSave: title path: path
	"Answer the result of a file save open dialog with the given title."

	^self
		fileSave: title
		extensions: nil
		path: path! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/7/2007 11:55'!
newVerticalSeparator
	"Answer a vertical separator."

	^self theme
		newVerticalSeparatorIn: self! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 1/10/2007 14:28'!
proceed: aStringOrText
	"Open a proceed dialog."

	^self proceed: aStringOrText title: 'Proceed' translated! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/8/2007 14:59'!
newHSVASelector: aColor help: helpText
	"Answer a hue-saturation-volume selector with the given color."

	^self theme
		newHSVASelectorIn: self
		color: aColor
		help: helpText! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 5/3/2007 13:38'!
chooseColor: aColor 
	"Answer the result of a color selector dialog with the given color."

	^self theme
		chooseColorIn: self
		title: 'Colour Selector' translated
		color: aColor! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 1/10/2007 11:13'!
deny: aStringOrText title: aString
	"Open a denial dialog."

	^self theme
		denyIn: self
		text: aStringOrText
		title: aString! !

!TEasilyThemed methodsFor: 'controls' stamp: 'GaryChambers 8/10/2010 16:02'!
newButtonLabelFor: aModel label: aString getEnabled: enabledSel
	"Answer a new button text label."

	^self theme
		newButtonLabelIn: self
		for: aModel
		label: aString
		getEnabled: enabledSel! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/2/2007 10:39'!
newPluggableDialogWindow
	"Answer a new pluggable dialog."

	^self
		newPluggableDialogWindow: 'Dialog'! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 8/12/2009 18:15'!
alert: aStringOrText title: aString configure: aBlock
	"Open an alert dialog.
	Configure the dialog with the 1 argument block
	before opening modally."

	^self theme
		alertIn: self
		text: aStringOrText
		title: aString
		configure: aBlock! !

!TEasilyThemed methodsFor: 'controls' stamp: 'GaryChambers 10/5/2010 13:29'!
newScrollPaneFor: aMorph
	"Answer a new scroll pane morph to scroll the given morph."
	
	^self theme
		newScrollPaneIn: self
		for: aMorph! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/25/2006 10:20'!
newCancelButton
	"Answer a new cancel button."

	^self newCancelButtonFor: self! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 3/23/2007 15:58'!
newOKButtonFor: aModel
	"Answer a new OK button."

	^self
		newOKButtonFor: aModel
		getEnabled: nil! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/9/2007 11:43'!
newString: aStringOrText style: aStyle
	"Answer a new embossed string."

	^self theme
		newStringIn: self
		label: aStringOrText
		font: self theme labelFont
		style: aStyle! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/7/2007 16:28'!
newHueSelector: aModel getHue: getSel setHue: setSel help: helpText
	"Answer a hue selector with the given selectors."

	^self theme
		newHueSelectorIn: self
		for: aModel
		getHue: getSel
		setHue: setSel
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'GaryChambers 8/17/2010 16:02'!
newEditableDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel addToList: addSel ghostText: ghostText getEnabled: enabledSel help: helpText
	"Answer an editable drop list for the given model."

	^self theme
		newEditableDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		addToList: addSel
		class: String
		default: ''
		ghostText: ghostText
		getEnabled: enabledSel
		useIndex: false
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/25/2006 15:57'!
newGroupboxFor: control
	"Answer a plain groupbox with the given control."

	^self theme
		newGroupboxIn: self
		for: control! !

!TEasilyThemed methodsFor: 'controls' stamp: 'GaryChambers 10/5/2010 13:49'!
newOverflowRowForAll: aCollectionOfMorphs
	"Answer a new overflow row morph that provides a drop down for
	the given contents that are unable to fit the bounds."
	
	^self theme
		newOverflowRowIn: self
		forAll: aCollectionOfMorphs! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 1/16/2007 14:14'!
newEmbeddedMenu
	"Answer a new menu."

	^self theme
		newEmbeddedMenuIn: self
		for: self! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/9/2007 13:13'!
newSliderFor: aModel getValue: getSel setValue: setSel help: helpText
	"Answer a slider with the given selectors."

	^self theme
		newSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: 0
		max: 1
		quantum: nil
		getEnabled: nil
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 1/17/2007 15:22'!
newButtonFor: aModel getState: stateSel action: actionSel arguments: args getEnabled: enabledSel getLabel: labelSel help: helpText
	"Answer a new button."

	^self theme
		newButtonIn: self for: aModel
		getState: stateSel
		action: actionSel
		arguments: args
		getEnabled: enabledSel 
		getLabel: labelSel
		help: helpText! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 8/31/2006 15:32'!
fileOpen: title
	"Answer the result of a file open dialog with the given title."

	^self
		fileOpen: title
		extensions: nil! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 8/27/2006 10:24'!
message: aStringOrText title: aString
	"Open a message dialog."

	^self theme
		messageIn: self
		text: aStringOrText
		title: aString! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/9/2007 13:27'!
newMorphListFor: aModel list: listSelector getSelected: getSelector setSelected: setSelector getEnabled: enabledSel help: helpText
	"Answer a morph list for the given model."

	^self theme
		newMorphListIn: self
		for: aModel
		list: listSelector
		getSelected: getSelector
		setSelected: setSelector
		getEnabled: enabledSel
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 9/16/2006 08:41'!
newTabGroup: labelsAndPages
	"Answer a tab group with the given tab labels associated with pages."

	^self theme
		newTabGroupIn: self
		for: labelsAndPages! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 1/10/2007 14:26'!
newNoButtonFor: aModel
	"Answer a new No button."

	^self theme
		newNoButtonIn: self
		for: aModel! !

!TEasilyThemed methodsFor: 'controls' stamp: 'AlainPlantec 11/26/2010 10:30'!
newAutoAcceptTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel font: aFont help: helpText entryCompletion: anEntryCompletion
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel
		font: aFont
		help: helpText
		entryCompletion: anEntryCompletion
! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 1/12/2007 14:24'!
chooseDropList: aStringOrText list: aList
	"Open a drop list chooser dialog."

	^self
		chooseDropList: aStringOrText
		title: 'Choose' translated
		list: aList! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 10/11/2006 13:13'!
newImage: aForm size: aPoint
	"Answer a new image."

	^self theme
		newImageIn: self
		form: aForm
		size: aPoint! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 1/10/2007 10:43'!
textEntry: aStringOrText title: aString entryText: defaultEntryText
	"Open a text entry dialog."

	^self theme
		textEntryIn: self
		text: aStringOrText
		title: aString
		entryText: defaultEntryText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 9/25/2006 15:36'!
newImage: aForm
	"Answer a new image."

	^self theme
		newImageIn: self
		form: aForm! !

!TEasilyThemed methodsFor: 'controls' stamp: 'GaryChambers 12/21/2011 11:35'!
newBasicTextEditorFor: aModel getText: getSel setText: setSel
	"Answer a text editor for the given model."

	^self
		newBasicTextEditorFor: aModel
		getText: getSel
		setText: setSel
		getEnabled: nil! !

!TEasilyThemed methodsFor: 'controls' stamp: 'GaryChambers 8/30/2011 15:28'!
newImageFor: aModel get: getSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newImageIn: self
		for: aModel
		get: getSel
		help: helpText! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 8/30/2006 09:37'!
alert: aStringOrText
	"Open an alert dialog."

	^self alert: aStringOrText title: 'Alert' translated! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 8/12/2009 18:15'!
alert: aStringOrText title: aString
	"Open an alert dialog."

	^self
		alert: aStringOrText
		title: aString
		configure: [:d | ]! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 8/25/2006 16:20'!
proceed: aStringOrText title: aString
	"Open a proceed dialog and answer true if not cancelled, false otherwise."

	^self theme
		proceedIn: self
		text: aStringOrText
		title: aString! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 9/5/2006 14:44'!
newAutoAcceptTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel
	"Answer a text editor for the given model."

	^self theme
		newAutoAcceptTextEditorIn: self
		for: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 1/30/2009 14:07'!
newBalloonHelp: aTextStringOrMorph for: aMorph
	"Answer a new balloon help with the given contents for aMorph
	at a given corner."

	^self theme
		newBalloonHelpIn: self
		contents: aTextStringOrMorph
		for: aMorph
		corner: #bottomLeft! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/25/2006 10:28'!
newTreeFor: aModel list: listSelector selected: getSelector changeSelected: setSelector
	"Answer a new tree morph."
	
	^self theme
		newTreeIn: self
		for: aModel
		list: listSelector
		selected: getSelector
		changeSelected: setSelector! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 5/18/2007 14:55'!
abort: aStringOrText
	"Open an error dialog."

	^self abort: aStringOrText title: 'Error' translated! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 9/22/2006 09:44'!
newColorPresenterFor: aModel getColor: getSel help: helpText
	"Answer a color presenter with the given selectors."

	^self theme
		newColorPresenterIn: self
		for: aModel
		getColor: getSel
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 9/8/2009 13:09'!
newBracketSliderFor: aModel getValue: getSel setValue: setSel min: minValue max: maxValue quantum: quantum getEnabled: enabledSel help: helpText
	"Answer a bracket slider with the given selectors."

	^self theme
		newBracketSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: minValue
		max: maxValue
		quantum: quantum
		getEnabled: enabledSel
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 10/17/2008 13:24'!
newButtonFor: aModel action: actionSel label: stringOrText help: helpText
	"Answer a new button."

	^self
		newButtonFor: aModel
		getState: nil
		action: actionSel
		arguments: nil
		getEnabled: nil 
		label: stringOrText
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 3/23/2007 15:56'!
newOKButtonFor: aModel getEnabled: enabledSel
	"Answer a new OK button."

	^self theme
		newOKButtonIn: self
		for: aModel
		getEnabled: enabledSel! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/9/2007 13:28'!
newMorphListFor: aModel list: listSelector getSelected: getSelector setSelected: setSelector help: helpText
	"Answer a morph list for the given model."

	^self
		newMorphListFor: aModel
		list: listSelector
		getSelected: getSelector
		setSelected: setSelector
		getEnabled: nil
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 4/11/2007 16:25'!
newText: aStringOrText
	"Answer a new text."

	^self theme
		newTextIn: self
		text: aStringOrText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 1/10/2007 14:25'!
newNoButton
	"Answer a new No button."

	^self newNoButtonFor: self! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/27/2009 12:03'!
newAutoAcceptTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel font: aFont help: helpText
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel
		font: aFont
		help: helpText
! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 9/27/2006 10:33'!
fileSave: title extensions: exts path: path
	"Answer the result of a file save dialog with the given title, extensions to show and path."

	^self theme
		fileSaveIn: self
		title: title
		extensions: exts
		path: path! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/8/2007 16:03'!
newDropListFor: aModel list: listSel getSelected: getSel setSelected: setSel getEnabled: enabledSel help: helpText
	"Answer a drop list for the given model."

	^self theme
		newDropListIn: self
		for: aModel
		list: listSel
		getSelected: getSel
		setSelected: setSel
		getEnabled: enabledSel
		useIndex: true
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 1/16/2007 15:50'!
newLabelFor: aModel label: aString getEnabled: enabledSel
	"Answer a new text label."

	^self theme
		newLabelIn: self
		for: aModel
		label: aString
		getEnabled: enabledSel! !

!TEasilyThemed methodsFor: 'controls' stamp: 'AlainPlantec 11/26/2010 10:30'!
newAutoAcceptTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel help: helpText entryCompletion: anEntryCompletion
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel
		help: helpText
		entryCompletion: anEntryCompletion! !

!TEasilyThemed methodsFor: 'controls' stamp: 'AlainPlantec 11/25/2010 17:48'!
newTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel help: helpText entryCompletion: anEntryCompletion

	"Answer a text entry for the given model."

	^self theme
		newTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel 
		help: helpText
		entryCompletion: anEntryCompletion! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 1/16/2007 15:51'!
newLabel: aString
	"Answer a new text label."

	^self
		newLabelFor: nil
		label: aString
		getEnabled: nil! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/8/2007 14:46'!
newHSVSelector: aColor help: helpText
	"Answer a hue-saturation-volume selector with the given color."

	^self theme
		newHSVSelectorIn: self
		color: aColor
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 9/18/2006 13:00'!
newAutoAcceptTextEntryFor: aModel getText: getSel setText: setSel getEnabled: enabledSel help: helpText
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: enabledSel
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'GaryChambers 1/20/2011 12:20'!
newLabelGroup: labelsAndControls
	"Answer a morph laid out with a column of labels and a column of associated controls.
	Controls having a vResizing value of #spaceFill will
	cause their row to use #spaceFill also, otherwise #shrinkWrap."

	^self theme
		newLabelGroupIn: self
		for: labelsAndControls! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/25/2006 10:27'!
newRow: controls
	"Answer a morph laid out with a row of controls."

	^self theme
		newRowIn: self
		for: controls! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/9/2007 16:21'!
newExpander: aString
	"Answer an expander with the given label."

	^self theme
		newExpanderIn: self
		label: aString
		forAll: #()! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 9/27/2006 13:38'!
fileOpen: title extensions: exts path: path preview: preview
	"Answer the result of a file open dialog with the given title, extensions to show, path and preview type."

	^self theme
		fileOpenIn: self
		title: title
		extensions: exts
		path: path
		preview: preview! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/9/2007 16:20'!
newExpander: aString for: aControl
	"Answer an expander with the given label and control."

	^self theme
		newExpanderIn: self
		label: aString
		forAll: {aControl}! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/7/2007 12:50'!
newTextEditorFor: aModel getText: getSel setText: setSel
	"Answer a text editor for the given model."

	^self
		newTextEditorFor: aModel
		getText: getSel
		setText: setSel
		getEnabled: nil! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/25/2006 10:21'!
newColumn: controls
	"Answer a morph laid out with a column of controls."

	^self theme
		newColumnIn: self
		for: controls! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 1/10/2007 10:33'!
newGroupboxForAll: controls
	"Answer a plain groupbox with the given controls."

	^self theme
		newGroupboxIn: self
		forAll: controls! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/25/2006 10:28'!
newTitle: aString for: control
	"Answer a morph laid out with a column with a title."

	^self theme
		newTitleIn: self
		label: aString
		for: control! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 2/28/2007 12:35'!
question: aStringOrText title: aString
	"Open a question dialog and answer true if yes,
	false if no and nil if cancelled."

	^self theme
		questionIn: self
		text: aStringOrText
		title: aString! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 9/8/2009 13:10'!
newBracketSliderFor: aModel getValue: getSel setValue: setSel min: minValue max: maxValue quantum: quantum help: helpText
	"Answer a bracket slider with the given selectors."

	^self
		newBracketSliderFor: aModel
		getValue: getSel
		setValue: setSel
		min: minValue
		max: maxValue
		quantum: quantum 
		getEnabled: nil
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 6/20/2007 09:38'!
newToolDockingBar
	"Answer a tool docking bar."

	^self theme
		newToolDockingBarIn: self! !

!TEasilyThemed methodsFor: 'controls' stamp: 'GaryChambers 10/5/2010 13:40'!
newMultistateButton
	"Answer a new multistate button morph.
	To be usable it needs to have fill styles assigned to various states along
	with mouse-up/down actions."
	
	^self theme
		newMultistateButtonIn: self! !

!TEasilyThemed methodsFor: 'controls' stamp: 'GaryChambers 12/21/2011 11:31'!
newTextEditorFor: aModel getText: getSel setText: setSel getEnabled: enabledSel 
	"Answer a text editor for the given model."

	^self 
		newTextEditorFor: aModel
		getText: getSel
		setText: setSel
		getEnabled: enabledSel
		menu: nil! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 1/10/2007 10:45'!
textEntry: aStringOrText title: aString
	"Open a text entry dialog."

	^self
		textEntry: aStringOrText
		title: aString
		entryText: ''! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 4/2/2007 15:34'!
chooseDirectory: title 
	"Answer the result of a file dialog with the given title, answer a directory."

	^self
		chooseDirectory: title
		path: nil! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/7/2007 12:50'!
newTextEntryFor: aModel getText: getSel setText: setSel help: helpText
	"Answer a text entry for the given model."

	^self
		newTextEntryFor: aModel
		get: getSel
		set: setSel
		class: String
		getEnabled: nil 
		help: helpText! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 9/27/2006 10:33'!
fileSave: title extensions: exts
	"Answer the result of a file save dialog with the given title."

	^self
		fileSave: title
		extensions: exts
		path: nil! !

!TEasilyThemed methodsFor: 'controls' stamp: 'StephaneDucasse 8/17/2010 19:34'!
newLabelFor: aModel getLabel: labelSel getEnabled: enabledSel
	"Answer a new text label."

	^self theme
		newLabelIn: self
		for: aModel
		getLabel: labelSel
		getEnabled: enabledSel! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 9/27/2006 10:33'!
fileSave: title
	"Answer the result of a file save dialog with the given title."

	^self
		fileSave: title
		extensions: nil
		path: nil! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 1/15/2007 15:41'!
newSeparator
	"Answer an horizontal separator."

	^self theme
		newSeparatorIn: self! !

!TEasilyThemed methodsFor: 'controls' stamp: 'AlainPlantec 11/26/2010 10:29'!
newAutoAcceptTextEntryFor: aModel get: getSel set: setSel class: aClass getEnabled: enabledSel font: aFont help: helpText entryCompletion: anEntryCompletion
	"Answer a text entry for the given model."

	^self theme
		newAutoAcceptTextEntryIn: self
		for: aModel
		get: getSel
		set: setSel
		class: aClass
		getEnabled: enabledSel
		font: aFont
		help: helpText
		entryCompletion: anEntryCompletion! !

!TEasilyThemed methodsFor: 'controls' stamp: 'GaryChambers 8/10/2010 16:35'!
newCloseControlFor: aModel action: aValuable help: helpText
	"Answer a new cancel button."

	^self theme
		newCloseControlIn: self
		for: aModel
		action: aValuable
		help: helpText! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 1/12/2007 14:23'!
chooseDropList: aStringOrText title: aString list: aList
	"Open a drop list chooser dialog."

	^self theme
		chooseDropListIn: self
		text: aStringOrText
		title: aString
		list: aList! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/9/2007 11:28'!
newSliderFor: aModel getValue: getSel setValue: setSel min: min max: max quantum: quantum getEnabled: enabledSel help: helpText
	"Answer a slider with the given selectors."

	^self theme
		newSliderIn: self
		for: aModel
		getValue: getSel
		setValue: setSel
		min: min
		max: max
		quantum: quantum
		getEnabled: enabledSel
		help: helpText! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 1/10/2007 14:28'!
question: aStringOrText
	"Open a question dialog."

	^self question: aStringOrText title: 'Question' translated! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 1/10/2007 10:44'!
textEntry: aStringOrText
	"Open a text entry dialog."

	^self textEntry: aStringOrText title: 'Entry' translated! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/25/2006 10:22'!
newGroupbox: aString forAll: controls
	"Answer a groupbox with the given label and controls."

	^self theme
		newGroupboxIn: self
		label: aString
		forAll: controls! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/7/2007 11:45'!
newListFor: aModel list: listSelector selected: getSelector changeSelected: setSelector getEnabled: enabledSel help: helpText
	"Answer a list for the given model."

	^self theme
		newListIn: self
		for: aModel
		list: listSelector
		selected: getSelector
		changeSelected: setSelector
		getEnabled: enabledSel
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/9/2007 16:21'!
newExpander: aString forAll: controls
	"Answer an expander with the given label and controls."

	^self theme
		newExpanderIn: self
		label: aString
		forAll: controls! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/9/2007 11:42'!
newString: aStringOrText
	"Answer a new embossed string."

	^self theme
		newStringIn: self
		label: aStringOrText
		font: self theme labelFont
		style: #plain! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 2/28/2007 12:35'!
questionWithoutCancel: aStringOrText title: aString
	"Open a question dialog and answer true if yes,
	false if no and nil if cancelled."

	^self theme
		questionWithoutCancelIn: self
		text: aStringOrText
		title: aString! !

!TEasilyThemed methodsFor: 'controls' stamp: 'GaryChambers 8/10/2010 16:02'!
newButtonLabel: aString
	"Answer a new button text label."

	^self
		newButtonLabelFor: nil
		label: aString
		getEnabled: nil! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 9/19/2006 10:07'!
newToolbar: controls
	"Answer a toolbar with the given controls."

	^self theme
		newToolbarIn: self
		for: controls! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 9/19/2006 10:07'!
newToolSpacer
	"Answer a tool spacer."

	^self theme
		newToolSpacerIn: self! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/9/2007 13:00'!
newFuzzyLabel: aString
	"Answer a new fuzzy label."

	^self theme
		newFuzzyLabelIn: self
		for: nil
		label: aString
		offset: 1
		alpha: 0.5
		getEnabled: nil! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 1/15/2007 17:48'!
newRow
	"Answer a morph laid out as a row."

	^self theme
		newRowIn: self
		for: #()! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 9/27/2006 10:33'!
fileOpen: title extensions: exts
	"Answer the result of a file open dialog with the given title and extensions to show."

	^self
		fileOpen: title
		extensions: exts
		path: nil! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 10/21/2009 14:44'!
newStack
	"Answer a morph laid out as a stack."

	^self theme
		newStackIn: self
		for: #()! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 8/9/2007 13:00'!
newFuzzyLabelFor: aModel label: aString offset: offset alpha: alpha getEnabled: enabledSel
	"Answer a new fuzzy label."

	^self theme
		newFuzzyLabelIn: self
		for: aModel
		label: aString
		offset: offset
		alpha: alpha
		getEnabled: enabledSel! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 4/4/2007 16:08'!
chooseFileName: title extensions: exts path: path preview: preview
	"Answer the result of a file name chooser dialog with the given title, extensions
	to show, path and preview type."

	^self theme
		chooseFileNameIn: self
		title: title
		extensions: exts
		path: path
		preview: preview! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 10/17/2008 13:25'!
newRadioButtonFor: aModel getSelected: getSel setSelected: setSel label: stringOrText help: helpText
	"Answer a checkbox (radio button appearance) with the given label."

	^self
		newRadioButtonFor: aModel
		getSelected: getSel
		setSelected: setSel
		getEnabled: nil
		label: stringOrText
		help: helpText! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 1/10/2007 14:23'!
newYesButtonFor: aModel
	"Answer a new yes button."

	^self theme
		newYesButtonIn: self
		for: aModel! !

!TEasilyThemed methodsFor: 'controls' stamp: 'gvc 9/19/2006 10:08'!
newToolbarHandle
	"Answer a toolbar handle."

	^self theme
		newToolbarHandleIn: self! !

!TEasilyThemed methodsFor: 'services' stamp: 'gvc 5/18/2007 14:55'!
abort: aStringOrText title: aString
	"Open an error dialog."

	^self theme
		abortIn: self
		text: aStringOrText
		title: aString! !

!TEmptySequenceableTest commentStamp: 'TorstenBergmann 2/20/2014 15:34'!
A trait for test purposes!
!TEmptySequenceableTest methodsFor: 'parameters' stamp: 'stephane.ducasse 10/5/2008 13:06'!
valuePutIn
	"the value that we will put in the non empty collection"
	
	^ #x! !

!TEmptySequenceableTest methodsFor: 'requirements' stamp: 'AlexandreBergel 1/19/2009 18:12'!
empty
	
	^ self explicitRequirement! !

!TEmptySequenceableTest methodsFor: 'tests - sequence isempty' stamp: 'stephane.ducasse 10/5/2008 13:05'!
testSequenceIfNotEmptyifEmpty

	self assert: (self nonEmpty ifEmpty: [false] ifNotEmpty: [:s | (self accessValuePutInOn: s) = self valuePutIn])! !

!TEmptySequenceableTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureEmptySequenceableTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!TEmptySequenceableTest methodsFor: 'tests - sequence isempty' stamp: 'stephane.ducasse 10/5/2008 13:02'!
testSequenceIfNotEmpty

	self assert: (self nonEmpty 
					ifNotEmpty: [:s | self accessValuePutInOn: s]) = self valuePutIn! !

!TEmptySequenceableTest methodsFor: 'parameters' stamp: 'stephane.ducasse 10/5/2008 13:06'!
accessValuePutInOn: s

	"return access the element put in the non-empty collection"
	
	^ s perform: self selectorToAccessValuePutIn! !

!TEmptySequenceableTest methodsFor: 'parameters' stamp: 'stephane.ducasse 10/5/2008 13:06'!
accessValuePutIn
	"return access the element put in the non-empty collection"
	
	^ self perform: self selectorToAccessValuePutIn! !

!TEmptySequenceableTest methodsFor: 'requirements' stamp: 'stephane.ducasse 10/5/2008 13:05'!
selectorToAccessValuePutIn
	"return the selector of the method that should be invoked to access an element"
	
	^ self explicitRequirement! !

!TEmptySequenceableTest methodsFor: 'requirements' stamp: 'AlexandreBergel 1/19/2009 18:12'!
nonEmpty
	
	^ self explicitRequirement! !

!TEmptyTest commentStamp: 'stephane.ducasse 10/5/2008 12:25'!
I group a set of tests testing whether a collection is empty.
I do not do any assymption on the elements being added since it would
bind me to know how to access it. 
!
!TEmptyTest methodsFor: 'tests - empty' stamp: 'stephane.ducasse 10/5/2008 12:00'!
testIsEmptyOrNil

	self assert: (self empty isEmptyOrNil).
	self deny: (self nonEmpty isEmptyOrNil).! !

!TEmptyTest methodsFor: 'tests - empty' stamp: 'delaunay 4/2/2009 11:17'!
testNotEmpty

	self assert: (self nonEmpty  notEmpty).
	self deny: (self empty notEmpty).! !

!TEmptyTest methodsFor: 'requirements' stamp: 'stephane.ducasse 2/14/2009 17:25'!
empty
	
	^ self explicitRequirement! !

!TEmptyTest methodsFor: 'tests - empty' stamp: 'stephane.ducasse 10/5/2008 13:03'!
testIfNotEmpty

	self empty ifNotEmpty: [self assert: false].
	self nonEmpty ifNotEmpty: [self assert: true].
	self assert: (self nonEmpty ifNotEmpty: [:s | s ]) = self nonEmpty
	! !

!TEmptyTest methodsFor: 'tests - empty' stamp: 'delaunay 3/27/2009 11:42'!
testIfEmpty

	self nonEmpty ifEmpty: [ self assert: false] .
	self empty ifEmpty: [ self assert: true] .
	

	! !

!TEmptyTest methodsFor: 'tests - empty' stamp: 'stephane.ducasse 10/5/2008 12:23'!
testIfEmptyifNotEmpty

	self assert: (self empty ifEmpty: [true] ifNotEmpty: [false]).
	self assert: (self nonEmpty ifEmpty: [false] ifNotEmpty: [true]).
	! !

!TEmptyTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureEmptyTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self empty.
	self assert: self empty isEmpty! !

!TEmptyTest methodsFor: 'tests - empty' stamp: 'delaunay 4/8/2009 15:26'!
testIfNotEmptyifEmpty

	self assert: (self empty ifNotEmpty: [false] ifEmpty: [true]).
	self assert: (self nonEmpty ifNotEmpty: [true] ifEmpty: [false]).
	! !

!TEmptyTest methodsFor: 'tests - empty' stamp: 'stephane.ducasse 10/5/2008 11:59'!
testIsEmpty

	self assert: (self empty isEmpty).
	self deny: (self nonEmpty isEmpty).! !

!TEmptyTest methodsFor: 'requirements' stamp: 'stephane.ducasse 2/14/2009 17:25'!
nonEmpty
	
	^ self explicitRequirement! !

!TEnableOnHaloMenu commentStamp: 'gvc 5/18/2007 11:56'!
Trait providing an "enabled" option on the halo menu.!
!TEnableOnHaloMenu methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 4/22/2012 16:45'!
enabledString
	"Answer the string to be shown in a menu to represent the 'enabled' status"
	
	^ (self enabled) -> 'enabled' translated! !

!TEnableOnHaloMenu methodsFor: 'menu & halo' stamp: 'NicolaiHess 9/8/2014 22:04'!
addToggleItemsToHaloMenu: aCustomMenu 
	"Add toggle-items to the halo menu"
	
	super addToggleItemsToHaloMenu: aCustomMenu.
	aCustomMenu
		addUpdating: #enabledString
		target: self
		selector: #toggleEnabled! !

!TEnableOnHaloMenu methodsFor: 'accessing' stamp: 'gvc 9/6/2006 15:24'!
enabled
	"Answer the enabled state of the receiver."

	self requirement! !

!TEnableOnHaloMenu methodsFor: 'accessing' stamp: 'gvc 9/6/2006 15:24'!
enabled: aBoolean
	"Set the enabled state of the receiver."

	self requirement! !

!TEnableOnHaloMenu methodsFor: 'as yet unclassified' stamp: 'gvc 9/6/2006 15:23'!
toggleEnabled
	"Toggle the enabled state."

	self enabled: self enabled not! !

!TEnumeratingTest commentStamp: '<historical>'!
Test of basic functions in Collections that are in the protocol enumerating
!
!TEnumeratingTest methodsFor: 'requirements' stamp: 'SebastianTleye 6/28/2013 14:35'!
simpleCollection
	^self explicitRequirement.! !

!TEnumeratingTest methodsFor: 'tests - enumerating' stamp: 'SebastianTleye 6/28/2013 14:35'!
testFlattened

	self assert: self simpleCollection flattened equals: #(1 8 3).
	self assert: self collectionOfCollectionsOfInts flattened equals: #( 1 2 3 4 5 6 ).
	self assert: self collectionWithCharacters flattened equals: #($a $x $d $c $m).
	self assert: self collectionOfCollectionsOfStrings flattened equals: #('foo' 'bar' 'zorg').! !

!TEnumeratingTest methodsFor: 'tests - enumerating' stamp: 'TudorGirba 11/3/2013 12:14'!
testFlatCollect

	self assert: (self simpleCollection flatCollect: [ :x | { x } ]) equals: self simpleCollection.
	self assert: (self simpleCollection flatCollect: [ :x | { x } ]) species = self simpleCollection species.
	
	self 
		assert: (self collectionOfCollectionsOfInts flatCollect: [ :x | { x } ]) 
		equals: self collectionOfCollectionsOfInts.
	self 
		assert: (self collectionWithCharacters flatCollect: [ :x | { x } ]) 
		equals: self collectionWithCharacters.
	self 
		assert: (self collectionOfCollectionsOfStrings flatCollect: [ :x | { x } ]) 
		equals: self collectionOfCollectionsOfStrings! !

!TEnumeratingTest methodsFor: 'tests - enumerating' stamp: 'TudorGirba 11/3/2013 12:15'!
testFlatCollectAs

	self 
		assert: (self simpleCollection flatCollect: [ :x | { x }, { x } ] as: IdentitySet) 
		equals: self simpleCollection asIdentitySet! !

!TEnumeratingTest methodsFor: 'tests - enumerating' stamp: 'TudorGirba 11/3/2013 12:14'!
testFlatCollectAsSet

	self 
		assert: (self simpleCollection flatCollectAsSet: [ :x | { x }, { x } ]) 
		equals: self simpleCollection asSet! !

!TEnumeratingTest methodsFor: 'requirements' stamp: 'SebastianTleye 6/26/2013 11:15'!
collectionOfCollectionsOfInts
	^self explicitRequirement.! !

!TEnumeratingTest methodsFor: 'requirements' stamp: 'SebastianTleye 6/26/2013 11:05'!
collectionWithCharacters
	^self explicitRequirement.! !

!TEnumeratingTest methodsFor: 'requirements' stamp: 'SebastianTleye 6/26/2013 11:01'!
collectionOfCollectionsOfStrings
	^self explicitRequirement.! !

!TGrowableTest commentStamp: 'TorstenBergmann 2/20/2014 15:34'!
A trait for test purposes!
!TGrowableTest methodsFor: 'requirements' stamp: 'stephane.ducasse 1/19/2009 16:20'!
empty 

	^ self explicitRequirement! !

!TGrowableTest methodsFor: 'requirements' stamp: 'stephane.ducasse 1/19/2009 16:18'!
element

	^ self explicitRequirement ! !

!TGrowableTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureRequirementsOfTGrowableTest
	self empty.
	self nonEmpty.
	self element.
	self elementNotIn.
	self assert: self empty isEmpty.
	self deny: self nonEmpty isEmpty.
	self assert: (self nonEmpty includes: self element).
	self deny: (self nonEmpty includes: self elementNotIn)! !

!TGrowableTest methodsFor: 'tests - growable' stamp: 'delaunay 5/12/2009 14:49'!
testAddNonEmptyGrowsWhenNewElement
	"self debug: #testAddNonEmptyGrowsWhenNewElement"
	
	| oldSize |
	oldSize := self nonEmpty size.
	
	self nonEmpty add: self elementNotIn.
	self assert: (self nonEmpty size) > oldSize.! !

!TGrowableTest methodsFor: 'requirements' stamp: 'damiencassou 1/20/2009 10:41'!
nonEmpty 

	^ self explicitRequirement! !

!TGrowableTest methodsFor: 'tests - growable' stamp: 'cyrille.delaunay 3/20/2009 09:47'!
testAddEmptyGrows
	"self debug: #testAddEmptyGrows"
	
	| oldSize |
	oldSize := self empty size.
	self empty add: self element.
	self assert: (self empty size) = (oldSize + 1).! !

!TGrowableTest methodsFor: 'requirements' stamp: 'stephane.ducasse 1/19/2009 16:20'!
elementNotIn
	
	^ self explicitRequirement! !

!TIdentityAddTest commentStamp: 'TorstenBergmann 2/20/2014 15:34'!
A trait for test purposes!
!TIdentityAddTest methodsFor: 'requirements' stamp: 'AlexandreBergel 1/19/2009 18:22'!
collection
	^ self explicitRequirement! !

!TIdentityAddTest methodsFor: 'requirements' stamp: 'AlexandreBergel 1/19/2009 18:22'!
element
	^ self explicitRequirement! !

!TIdentityAddTest methodsFor: 'tests - identity adding' stamp: 'damienpollet 1/9/2009 17:47'!
equalNotIdenticalElement
	^ self element copy! !

!TIdentityAddTest methodsFor: 'tests - identity adding' stamp: 'damienpollet 1/9/2009 18:17'!
testIdentityAdd
	| added oldSize |
	oldSize := self collection size.
	self collection add: self element.
	self deny: (self collection includes: self equalNotIdenticalElement).
	
	added := self collection add: self equalNotIdenticalElement.
	self assert: added == self equalNotIdenticalElement.
	self assert: (self collection includes: self equalNotIdenticalElement)! !

!TIncludesForIdentityCollectionsTest commentStamp: 'TorstenBergmann 2/20/2014 15:34'!
A trait for test purposes!
!TIncludesForIdentityCollectionsTest methodsFor: 'tests - including for identity collections' stamp: 'delaunay 5/13/2009 13:56'!
testIdentityIncludesForIdentityCollections
	" test the comportement in presence of elements 'includes' but not 'identityIncludes' "
	" can not be used by collections that can't include elements for wich copy doesn't return another instance "
	| collection element |
	collection := self identityCollectionWithElementsCopyNotIdentical .
	element := collection anyOne copy.
	self deny: (collection identityIncludes: element)! !

!TIncludesForIdentityCollectionsTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureInludesForIdentityCollectionsTest
	self identityCollectionWithElementsCopyNotIdentical.
	self identityCollectionWithElementsCopyNotIdentical do: [ :each | self deny: each == each copy ]! !

!TIncludesForIdentityCollectionsTest methodsFor: 'tests - including for identity collections' stamp: 'CamilloBruni 9/8/2011 14:34'!
testIncludesAnyOfForIdentityCollections
	"self debug: #testIncludesAnyOfAllThere'"
	| collection copyCollection |
	collection := self identityCollectionWithElementsCopyNotIdentical .
	copyCollection := OrderedCollection new.
	collection do: [ :each | copyCollection add: each copy ].
	self deny: (collection includesAny: copyCollection).
	self assert: (collection includesAny: {  (collection anyOne)  })! !

!TIncludesForIdentityCollectionsTest methodsFor: 'tests - including for identity collections' stamp: 'delaunay 5/13/2009 13:56'!
testIncludesForIdentityCollections
	"self debug: #testIncludesElementIsThere"
	| collection element elementCopy |
	collection := self identityCollectionWithElementsCopyNotIdentical .
	element := collection anyOne.
	elementCopy := element copy.
	self assert: (collection includes: element).
	self deny: (collection includes: elementCopy)! !

!TIncludesForIdentityCollectionsTest methodsFor: 'requirements' stamp: 'delaunay 5/13/2009 13:56'!
identityCollectionWithElementsCopyNotIdentical
	" return a collection including elements for which #copy return a new object "
	^ self explicitRequirement! !

!TIncludesForIdentityCollectionsTest methodsFor: 'tests - including for identity collections' stamp: 'CamilloBruni 9/8/2011 14:36'!
testIncludesAllOfForIdentityCollections
	"self debug: #testIncludesAllOfAllThere'"
	| collection copyCollection |
	collection := self identityCollectionWithElementsCopyNotIdentical .
	copyCollection := OrderedCollection new.
	collection do: [ :each | copyCollection add: each copy ].
	self assert: (collection includesAll: collection).
	self deny: (collection includesAll: copyCollection).
	self deny: (collection includesAll: {  (copyCollection anyOne)  })! !

!TIncludesTest commentStamp: 'TorstenBergmann 2/20/2014 15:34'!
A trait for test purposes!
!TIncludesTest methodsFor: 'tests - includes' stamp: 'CamilloBruni 9/8/2011 14:29'!
testIncludesAnyNoneThere
	"self debug: #testIncludesAnyOfNoneThere'"
	
	self deny: (self nonEmpty includesAny: self empty).
	self deny: (self nonEmpty includesAny: { self elementNotIn. self anotherElementNotIn })! !

!TIncludesTest methodsFor: 'tests - includes' stamp: 'stephane.ducasse 11/21/2008 14:05'!
testIncludesElementIsThere
	"self debug: #testIncludesElementIsThere"
	
	self assert: (self nonEmpty includes: self nonEmpty anyOne).! !

!TIncludesTest methodsFor: 'requirements' stamp: 'stephane.ducasse 11/21/2008 14:11'!
empty
	^ self explicitRequirement! !

!TIncludesTest methodsFor: 'tests - includes' stamp: 'delaunay 4/24/2009 14:39'!
testIdentityIncludesNonSpecificComportement
	" test the same comportement than 'includes: '  "
	| collection |	
	collection := self nonEmpty  .
	
	self deny: (collection identityIncludes: self elementNotIn ).
	self assert:(collection identityIncludes: collection anyOne)
! !

!TIncludesTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureIncludeTest
	| anElementIn |
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self elementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self elementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self anotherElementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self anotherElementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self empty.
	self assert: self empty isEmpty! !

!TIncludesTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 10:47'!
anotherElementNotIn
" return an element different of 'elementNotIn'  not included in 'nonEmpty' "
	^ self explicitRequirement! !

!TIncludesTest methodsFor: 'tests - includes' stamp: 'CamilloBruni 9/8/2011 14:25'!
testIncludesAnyAllThere
	"self debug: #testIncludesAnyOfAllThere'"
	self deny: (self nonEmpty includesAny: self empty).
	self assert: (self nonEmpty includesAny: { self nonEmpty anyOne }).
	self assert: (self nonEmpty includesAny: self nonEmpty).! !

!TIncludesTest methodsFor: 'requirements' stamp: 'stephane.ducasse 11/21/2008 14:11'!
nonEmpty
	^ self explicitRequirement! !

!TIncludesTest methodsFor: 'tests - includes' stamp: 'stephane.ducasse 11/21/2008 14:05'!
testIncludesElementIsNotThere
	"self debug: #testIncludesElementIsNotThere"
	
	self deny: (self nonEmpty includes: self elementNotIn).
	self assert: (self nonEmpty includes: self nonEmpty anyOne).
	self deny: (self empty includes: self elementNotIn)! !

!TIncludesTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 10:46'!
elementNotIn
"return an element not included in 'nonEmpty' "

	^ self explicitRequirement! !

!TIncludesTest methodsFor: 'tests - includes' stamp: 'CamilloBruni 9/8/2011 14:25'!
testIncludesAllNoneThere
	"self debug: #testIncludesAllOfNoneThere'"
	self deny: (self empty includesAll: self nonEmpty ).
	self deny: (self nonEmpty includesAll: { self elementNotIn. self anotherElementNotIn })! !

!TIncludesWithIdentityCheckTest commentStamp: 'TorstenBergmann 2/20/2014 15:34'!
A trait for test purposes!
!TIncludesWithIdentityCheckTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAnyNoneThere
	"self debug: #testIncludesAnyOfNoneThere'"
	
	self deny: (self nonEmpty includesAny: self empty).
	self deny: (self nonEmpty includesAny: { self elementNotIn. self anotherElementNotIn })! !

!TIncludesWithIdentityCheckTest methodsFor: 'tests - includes' stamp: ''!
testIncludesElementIsThere
	"self debug: #testIncludesElementIsThere"
	
	self assert: (self nonEmpty includes: self nonEmpty anyOne).! !

!TIncludesWithIdentityCheckTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureIncludeTest
	| anElementIn |
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self elementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self elementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self anotherElementNotIn.
	anElementIn := true.
	self nonEmpty detect: [ :each | each = self anotherElementNotIn ] ifNone: [ anElementIn := false ].
	self assert: anElementIn = false.
	self empty.
	self assert: self empty isEmpty! !

!TIncludesWithIdentityCheckTest methodsFor: 'tests - includes' stamp: ''!
testIdentityIncludesNonSpecificComportement
	" test the same comportement than 'includes: '  "
	| collection |	
	collection := self nonEmpty  .
	
	self deny: (collection identityIncludes: self elementNotIn ).
	self assert:(collection identityIncludes: collection anyOne)
! !

!TIncludesWithIdentityCheckTest methodsFor: 'tests - including with identity' stamp: 'StephaneDucasse 5/22/2010 18:16'!
testIdentityIncludes
	" test the comportement in presence of elements 'includes' but not 'identityIncludes' "
	" can not be used by collections that can't include elements for wich copy doesn't return another instance "
	| collection anElement |
	
	collection := self collectionWithCopyNonIdentical.
	anElement := collection anyOne copy.

	self deny: (collection identityIncludes: anElement)! !

!TIncludesWithIdentityCheckTest methodsFor: 'tests - includes' stamp: ''!
testIncludesElementIsNotThere
	"self debug: #testIncludesElementIsNotThere"
	
	self deny: (self nonEmpty includes: self elementNotIn).
	self assert: (self nonEmpty includes: self nonEmpty anyOne).
	self deny: (self empty includes: self elementNotIn)! !

!TIncludesWithIdentityCheckTest methodsFor: 'requirements' stamp: ''!
elementNotIn
"return an element not included in 'nonEmpty' "

	^ self explicitRequirement! !

!TIncludesWithIdentityCheckTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 11:31'!
collectionWithCopyNonIdentical
	" return a collection that include elements for which 'copy' return a different object (this is not the case of SmallInteger)"
	^ self explicitRequirement! !

!TIncludesWithIdentityCheckTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAllNoneThere
	"self debug: #testIncludesAllOfNoneThere'"
	self deny: (self empty includesAll: self nonEmpty ).
	self deny: (self nonEmpty includesAll: { self elementNotIn. self anotherElementNotIn })! !

!TIncludesWithIdentityCheckTest methodsFor: 'requirements' stamp: ''!
empty
	^ self explicitRequirement! !

!TIncludesWithIdentityCheckTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureIncludeWithIdentityTest
	| anElement |
	self collectionWithCopyNonIdentical.
	anElement := self collectionWithCopyNonIdentical anyOne.
	self deny: anElement == anElement copy! !

!TIncludesWithIdentityCheckTest methodsFor: 'tests - includes' stamp: ''!
testIncludesAnyAllThere
	"self debug: #testIncludesAnyOfAllThere'"
	self deny: (self nonEmpty includesAny: self empty).
	self assert: (self nonEmpty includesAny: { self nonEmpty anyOne }).
	self assert: (self nonEmpty includesAny: self nonEmpty).! !

!TIncludesWithIdentityCheckTest methodsFor: 'requirements' stamp: ''!
anotherElementNotIn
" return an element different of 'elementNotIn'  not included in 'nonEmpty' "
	^ self explicitRequirement! !

!TIncludesWithIdentityCheckTest methodsFor: 'requirements' stamp: ''!
nonEmpty
	^ self explicitRequirement! !

!TIndexAccess commentStamp: 'TorstenBergmann 2/20/2014 15:34'!
A trait for test purposes!
!TIndexAccess methodsFor: 'tests - index access' stamp: 'delaunay 4/23/2009 15:14'!
testIndexOfSubCollectionStartingAt
	"self debug: #testIndexOfIfAbsent"
	| subcollection index collection |
	collection := self collectionMoreThan1NoDuplicates.
	subcollection := self collectionMoreThan1NoDuplicates.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 1.
	self assert: index = 1.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 2.
	self assert: index = 0! !

!TIndexAccess methodsFor: 'tests - index access' stamp: 'delaunay 4/23/2009 15:14'!
testIdentityIndexOf
	"self debug: #testIdentityIndexOf"
	| collection element |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection identityIndexOf: element) = (collection indexOf: element)! !

!TIndexAccess methodsFor: 'tests - index access' stamp: 'delaunay 4/23/2009 15:14'!
testIndexOfSubCollectionStartingAtIfAbsent
	"self debug: #testIndexOfIfAbsent"
	| index absent subcollection collection |
	collection := self collectionMoreThan1NoDuplicates.
	subcollection := self collectionMoreThan1NoDuplicates.
	absent := false.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 1
		ifAbsent: [ absent := true ].
	self assert: absent = false.
	absent := false.
	index := collection 
		indexOfSubCollection: subcollection
		startingAt: 2
		ifAbsent: [ absent := true ].
	self assert: absent = true! !

!TIndexAccess methodsFor: 'tests - index access' stamp: 'delaunay 4/23/2009 15:14'!
testLastIndexOf
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection lastIndexOf: element) = 1.
	self assert: (collection lastIndexOf: self elementNotInForIndexAccessing) = 0! !

!TIndexAccess methodsFor: 'tests - index access' stamp: 'delaunay 4/23/2009 15:14'!
testIndexOfIfAbsent
	"self debug: #testIndexOfIfAbsent"
	| collection |
	collection := self collectionMoreThan1NoDuplicates.
	self assert: (collection 
			indexOf: collection first
			ifAbsent: [ 33 ]) = 1.
	self assert: (collection 
			indexOf: self elementNotInForIndexAccessing
			ifAbsent: [ 33 ]) = 33! !

!TIndexAccess methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureIndexAccessTest
	| res collection element |
	self collectionMoreThan1NoDuplicates.
	self assert: self collectionMoreThan1NoDuplicates size > 1.
	res := true.
	self collectionMoreThan1NoDuplicates
		detect: [ :each | (self collectionMoreThan1NoDuplicates occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false.
	self elementInForIndexAccessing.
	self
		assert: ((collection := self collectionMoreThan1NoDuplicates) includes: (element := self elementInForIndexAccessing)).
	self elementNotInForIndexAccessing.
	self deny: (self collectionMoreThan1NoDuplicates includes: self elementNotInForIndexAccessing)! !

!TIndexAccess methodsFor: 'tests - index access' stamp: 'delaunay 4/23/2009 15:14'!
testIndexOfStartingAt
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			indexOf: element
			startingAt: 2
			ifAbsent: [ 99 ]) = 99.
	self assert: (collection 
			indexOf: element
			startingAt: 1
			ifAbsent: [ 99 ]) = 1.
	self assert: (collection 
			indexOf: self elementNotInForIndexAccessing
			startingAt: 1
			ifAbsent: [ 99 ]) = 99! !

!TIndexAccess methodsFor: 'requirements' stamp: 'delaunay 4/23/2009 15:14'!
collectionMoreThan1NoDuplicates
	" return a collection of size > 1 without equal elements"
	self explicitRequirement! !

!TIndexAccess methodsFor: 'tests - index access' stamp: 'delaunay 4/23/2009 15:14'!
testIndexOf
	"self debug: #testIndexOf"
	| tmp index collection |
	collection := self collectionMoreThan1NoDuplicates.
	tmp := collection size.
	collection reverseDo: 
		[ :each | 
		each = self elementInForIndexAccessing ifTrue: [ index := tmp ].
		tmp := tmp - 1 ].
	self assert: (collection indexOf: self elementInForIndexAccessing) = index! !

!TIndexAccess methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 15:10'!
elementInForIndexAccessing
" return an element included in 'collectionMoreThan1NoDuplicates' "
	self explicitRequirement! !

!TIndexAccess methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 15:11'!
elementNotInForIndexAccessing
" return an element not included in 'collectionMoreThan1NoDuplicates' "
	self explicitRequirement! !

!TIndexAccess methodsFor: 'tests - index access' stamp: 'delaunay 4/23/2009 15:14'!
testIdentityIndexOfIAbsent
	| collection element |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			identityIndexOf: element
			ifAbsent: [ 0 ]) = 1.
	self assert: (collection 
			identityIndexOf: self elementNotInForIndexAccessing
			ifAbsent: [ 55 ]) = 55! !

!TIndexAccess methodsFor: 'tests - index access' stamp: 'delaunay 4/23/2009 15:14'!
testLastIndexOfIfAbsent
	"self debug: #testIndexOfIfAbsent"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			lastIndexOf: element
			ifAbsent: [ 99 ]) = 1.
	self assert: (collection 
			lastIndexOf: self elementNotInForIndexAccessing
			ifAbsent: [ 99 ]) = 99! !

!TIndexAccess methodsFor: 'tests - index access' stamp: 'delaunay 4/23/2009 15:14'!
testLastIndexOfStartingAt
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection last.
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size
			ifAbsent: [ 99 ]) = collection size.
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size - 1
			ifAbsent: [ 99 ]) = 99.
	self assert: (collection 
			lastIndexOf: self elementNotInForIndexAccessing
			startingAt: collection size
			ifAbsent: [ 99 ]) = 99! !

!TIndexAccess methodsFor: 'tests - index access' stamp: 'delaunay 5/11/2009 16:27'!
testIndexOfStartingAtIfAbsent
	"self debug: #testLastIndexOf"
	| element collection |
	collection := self collectionMoreThan1NoDuplicates.
	element := collection first.
	self assert: (collection 
			indexOf: element
			startingAt: 2
			ifAbsent: [ 99 ]) = 99.
	self assert: (collection 
			indexOf: element
			startingAt: 1
			ifAbsent: [ 99 ]) = 1.
	self assert: (collection 
			indexOf: self elementNotInForIndexAccessing
			startingAt: 1
			ifAbsent: [ 99 ]) = 99! !

!TIndexAccessForMultipliness commentStamp: 'TorstenBergmann 2/20/2014 15:34'!
A trait for test purposes!
!TIndexAccessForMultipliness methodsFor: 'tests - index accessing for multipliness' stamp: 'delaunay 4/27/2009 14:00'!
testLastIndexOfDuplicate
	"self debug: #testLastIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection first.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'lastIndexOf: should return the position of the last occurrence :'"
	self assert: (collection lastIndexOf: element) = collection size! !

!TIndexAccessForMultipliness methodsFor: 'tests - index accessing for multipliness' stamp: 'delaunay 5/11/2009 10:07'!
testIdentityIndexOfIAbsentDuplicate
	"self debug: #testIdentityIndexOfIfAbsent"
	| collection element elementCopy |
	collection := self collectionWithNonIdentitySameAtEndAndBegining .
	element := collection last.
	elementCopy := element copy.
	self deny: element  == elementCopy .
	self assert: (collection 
			identityIndexOf: element
			ifAbsent: [ 0 ]) = collection size.
	self assert: (collection 
			identityIndexOf: elementCopy
			ifAbsent: [ 55 ]) = 55! !

!TIndexAccessForMultipliness methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 14:04'!
collectionWithSameAtEndAndBegining
	" return a collection with elements at end and begining equals .
(others elements of the collection are not equal to those elements)"
	self explicitRequirement! !

!TIndexAccessForMultipliness methodsFor: 'tests - index accessing for multipliness' stamp: 'delaunay 4/27/2009 14:00'!
testLastIndexOfStartingAtDuplicate
	"self debug: #testLastIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection last.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'lastIndexOf:ifAbsent:startingAt: should return the position of the last occurrence :'"
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size
			ifAbsent: [ 55 ]) = collection size.
	self assert: (collection 
			lastIndexOf: element
			startingAt: collection size - 1
			ifAbsent: [ 55 ]) = 1! !

!TIndexAccessForMultipliness methodsFor: 'tests - index accessing for multipliness' stamp: 'delaunay 4/27/2009 14:00'!
testLastIndexOfIfAbsentDuplicate
	"self debug: #testIndexOfIfAbsent"
	"self debug: #testLastIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection first.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'lastIndexOf: should return the position of the last occurrence :'"
	self assert: (collection 
			lastIndexOf: element
			ifAbsent: [ 55 ]) = collection size! !

!TIndexAccessForMultipliness methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureIndexAccessFotMultipliness
	self collectionWithSameAtEndAndBegining.
	self assert: self collectionWithSameAtEndAndBegining first = self collectionWithSameAtEndAndBegining last.
	self assert: self collectionWithSameAtEndAndBegining size > 1.
	1 to: self collectionWithSameAtEndAndBegining size do: [ :i | 
		i > 1 & (i < self collectionWithSameAtEndAndBegining size)
			ifTrue: [ self deny: (self collectionWithSameAtEndAndBegining at: i) = self collectionWithSameAtEndAndBegining first ] ]! !

!TIndexAccessForMultipliness methodsFor: 'tests - index accessing for multipliness' stamp: 'CamilloBruni 8/31/2013 20:43'!
testIdentityIndexOfDuplicate
	"self debug: #testIdentityIndexOf"

	| collection element |
	"testing fixture here as this method may not be used by some collections testClass"
	self collectionWithNonIdentitySameAtEndAndBegining.
	collection := self collectionWithNonIdentitySameAtEndAndBegining.
	self assert: collection first = collection last.
	self deny: collection first == collection last.
	1 to: collection size do: [ :i | 
		i > 1 & (i < collection size)
			ifTrue: [ self deny: (collection at: i) = collection first ] ].
	element := collection last.	" floatCollectionWithSameAtEndAndBegining first and last elements are equals but are not the same object"
	self assert: (collection identityIndexOf: element) = collection size! !

!TIndexAccessForMultipliness methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 14:02'!
collectionWithNonIdentitySameAtEndAndBegining
	" return a collection with elements at end and begining equals only with classic equality (they are not the same object).
(others elements of the collection are not equal to those elements)"
	self explicitRequirement! !

!TIndexAccessForMultipliness methodsFor: 'tests - index accessing for multipliness' stamp: 'delaunay 4/27/2009 14:00'!
testIndexOfStartingAtDuplicate
	"self debug: #testLastIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection last.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'indexOf:ifAbsent:startingAt: should return the position of the first occurrence :'"
	self assert: (collection 
			indexOf: element
			startingAt: 1
			ifAbsent: [ 55 ]) = 1.
	self assert: (collection 
			indexOf: element
			startingAt: 2
			ifAbsent: [ 55 ]) = collection size! !

!TIndexAccessForMultipliness methodsFor: 'tests - index accessing for multipliness' stamp: 'delaunay 4/27/2009 14:00'!
testIndexOfIfAbsentDuplicate
	"self debug: #testIndexOfIfAbsent"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection last.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'indexOf:ifAbsent: should return the position of the first occurrence :'"
	self assert: (collection 
			indexOf: element
			ifAbsent: [ 55 ]) = 1! !

!TIndexAccessForMultipliness methodsFor: 'tests - index accessing for multipliness' stamp: 'delaunay 4/27/2009 14:00'!
testIndexOfDuplicate
	"self debug: #testIndexOf"
	| collection element |
	collection := self collectionWithSameAtEndAndBegining.
	element := collection last.

	" floatCollectionWithSameAtEndAndBegining first and last elements are equals 
	'indexOf: should return the position of the first occurrence :'"
	self assert: (collection indexOf: element) = 1! !

!TInspectorActions commentStamp: '<historical>'!
I contain common actions for inspectors and inspector elements/wrappers!
!TInspectorActions methodsFor: 'actions' stamp: 'CamilloBruni 10/15/2013 18:16'!
browseSelectedObject
	self selectedObjectDo: [ :anObject | anObject browse ]! !

!TInspectorActions methodsFor: 'actions' stamp: 'CamilloBruni 10/15/2013 18:17'!
browseSelectedObjectClassHierarchy
	self selectedObjectDo: [ :anObject | anObject class browseHierarchy ]! !

!TInspectorActions methodsFor: 'actions' stamp: 'BenjaminVanRyseghem 11/8/2013 17:52'!
inspectInNewWindow: anObject

	anObject inspect! !

!TInspectorActions methodsFor: 'actions' stamp: 'CamilloBruni 10/15/2013 18:17'!
exploreSelectedObject
	self selectedObjectDo: [ :anObject | anObject explore ].! !

!TInspectorActions methodsFor: 'actions' stamp: 'BenjaminVanRyseghem 11/8/2013 17:52'!
inspectSelectedObjectInNewWindow
	self selectedObjectDo: [ :anObject | self inspectInNewWindow: anObject ].! !

!TInspectorActions methodsFor: 'actions' stamp: 'abc 10/18/2013 15:01'!
browseSelectedObjectClass
	self selectedObjectDo: [ :anObject | Smalltalk tools browser newOnClass: anObject class ]! !

!TIterateSequencedReadableTest commentStamp: 'TorstenBergmann 2/20/2014 15:34'!
A trait for test purposes!
!TIterateSequencedReadableTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: 'delaunay 4/8/2009 10:39'!
testCollectFromTo
	
	| result |
	result:=self nonEmptyMoreThan1Element 
		collect: [ :each | each ]
		from: 1
		to: (self nonEmptyMoreThan1Element size - 1).
		
	1 to: result size
		do: [ :i | self assert: (self nonEmptyMoreThan1Element at: i) = (result at: i) ].
	self assert: result size = (self nonEmptyMoreThan1Element size - 1)! !

!TIterateSequencedReadableTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: 'delaunay 4/2/2009 15:36'!
testReverseDoEmpty
	| result |
	result:= OrderedCollection new.
	self empty reverseDo: [: each | result add: each].
	
	self assert: result isEmpty .! !

!TIterateSequencedReadableTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: 'delaunay 4/7/2009 10:40'!
testAllButLastDo
	
	| result |
	result:= OrderedCollection  new.
	
	self nonEmptyMoreThan1Element  allButLastDo: [:each | result add: each].
	
	1 to: (result size) do:
		[:i|
		self assert: (self nonEmptyMoreThan1Element  at:(i ))=(result at:i)].
	
	self assert: result size=(self nonEmptyMoreThan1Element  size-1).! !

!TIterateSequencedReadableTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: 'HenrikSperreJohansen 10/18/2009 17:27'!
testWithCollect
	
	| result firstCollection secondCollection index  |

	firstCollection := self nonEmptyMoreThan1Element.
	secondCollection := firstCollection copy.
	index := 0.
	
	result := firstCollection  with: secondCollection collect:
		[:a :b |
		( index := index + 1).
		self assert: (firstCollection at: index) equals:  a. 
		self assert: (secondCollection at: index) equals:  b.
		b].
	
	1 to: result size do:[: i | self assert: (result at:i)= (secondCollection  at: i)].
	self assert: result size = secondCollection  size.! !

!TIterateSequencedReadableTest methodsFor: 'requirements' stamp: 'delaunay 4/2/2009 14:05'!
empty
	^self explicitRequirement.! !

!TIterateSequencedReadableTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: 'delaunay 5/14/2009 16:17'!
testPairsCollect
	
	| index result |
	index:=0.
	
	result:=self nonEmptyMoreThan1Element  pairsCollect: 
		[:each1 :each2 | 
		self assert: ( self nonEmptyMoreThan1Element indexOf: each2 ) = (index := index + 2).
		(self nonEmptyMoreThan1Element indexOf: each2) = ((self nonEmptyMoreThan1Element indexOf: each1) + 1).
		].
	
	result do: 
		[:each | self assert: each = true].
	
! !

!TIterateSequencedReadableTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: 'delaunay 4/2/2009 13:58'!
testDo! !

!TIterateSequencedReadableTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: 'delaunay 4/23/2009 13:29'!
testWithIndexDo
	
	"| result |
	result:=Array new: self nonEmptyMoreThan1Element size.
	self nonEmptyMoreThan1Element  withIndexDo: [:each :i | result at:i put:(each+i)].
	
	1 to: result size do:[: i | self assert: (result at:i)= ((self nonEmptyMoreThan1Element at: i) + i)]"
	|  indexes elements |
	indexes:= OrderedCollection new.
	elements := OrderedCollection new.
	
	self nonEmptyMoreThan1Element  withIndexDo: 
		[:value :i  |
		indexes  add: (i).
		elements add: value].
	
	(1 to: self nonEmptyMoreThan1Element size )do:
		[ :i |
		self assert: (indexes at: i) = i.
		self assert: (elements at: i) = (self nonEmptyMoreThan1Element at: i).	
		].
	
	self assert: indexes size = elements size. 
	self assert: indexes size = self nonEmptyMoreThan1Element size . 
	! !

!TIterateSequencedReadableTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: 'delaunay 4/2/2009 15:01'!
testReverseDo
	| result |
	result:= OrderedCollection new.
	self nonEmpty reverseDo: [: each | result add: each].
	
	1 to: result size do:
		[:i|
		self assert: (result at: i)=(self nonEmpty at:(self nonEmpty size-i+1))].! !

!TIterateSequencedReadableTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: 'delaunay 4/2/2009 15:30'!
testFindLastNotIn

	| result |
	
	 result:=self empty findFirst: [:each | true].
	
	self assert: result=0. ! !

!TIterateSequencedReadableTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: 'delaunay 4/2/2009 14:40'!
testFromToDo
	
	| result |
	result:= OrderedCollection  new.
	
	self nonEmptyMoreThan1Element  from: 1 to: (self nonEmptyMoreThan1Element  size -1) do: [:each | result add: each].
	
	1 to: (self nonEmptyMoreThan1Element  size -1) do:
		[:i|
		self assert: (self nonEmptyMoreThan1Element  at:i )=(result at:i)].
	self assert: result size=(self nonEmptyMoreThan1Element  size-1).! !

!TIterateSequencedReadableTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: 'delaunay 5/12/2009 14:09'!
testDetectSequenced
" testing that detect keep the first element returning true for sequenceable collections "

	| element result |
	element := self nonEmptyMoreThan1Element   at:1.
	result:=self nonEmptyMoreThan1Element  detect: [:each | each notNil ].
	self assert: result = element. ! !

!TIterateSequencedReadableTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: 'delaunay 4/23/2009 14:00'!
testFindFirst

	| element result |
	element := self nonEmptyMoreThan1Element   at:1.
	 result:=self nonEmptyMoreThan1Element  findFirst: [:each | each =element].
	
	self assert: result=1. ! !

!TIterateSequencedReadableTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: 'HenrikSperreJohansen 10/18/2009 18:34'!
testReverseWithDo
	
	| firstCollection secondCollection index |

	firstCollection := self nonEmptyMoreThan1Element.
	secondCollection := firstCollection copy.
	index := firstCollection size.
	
	firstCollection  reverseWith: secondCollection do:
		[:a :b |
	
		self assert: (firstCollection at: index) equals:  a. 
		self assert: (secondCollection at: index) equals:  b.
			( index := index - 1).]
	
	
	! !

!TIterateSequencedReadableTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: 'delaunay 5/14/2009 16:19'!
testWithIndexCollect
	
	| result index collection |
	index := 0.
	collection := self nonEmptyMoreThan1Element .
	result := collection  withIndexCollect: [:each :i | 
		self assert: i = (index := index + 1).	
		self assert: i = (collection  indexOf: each) .
		each] . 
	
	1 to: result size do:[: i | self assert: (result at:i)= (collection at: i)].
	self assert: result size = collection size.! !

!TIterateSequencedReadableTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: 'delaunay 4/2/2009 15:35'!
testKeysAndValuesDoEmpty
	| result |
	result:= OrderedCollection new.
	
	self empty  keysAndValuesDo: 
		[:i :value|
		result add: (value+i)].
	
	self assert: result isEmpty .! !

!TIterateSequencedReadableTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: 'HenrikSperreJohansen 10/18/2009 19:39'!
testWithDo
	
	| firstCollection secondCollection index |

	firstCollection := self nonEmptyMoreThan1Element.
	secondCollection := firstCollection copy.
	index := 0.
	
	firstCollection  with: secondCollection do:
		[:a :b |
		( index := index + 1).
		self assert: (firstCollection at: index) equals:  a. 
		self assert: (secondCollection at: index) equals:  b.]
	
	! !

!TIterateSequencedReadableTest methodsFor: 'requirements' stamp: 'delaunay 5/12/2009 14:10'!
nonEmptyMoreThan1Element
" return a collection that doesn't includes equal elements' and doesn't include nil elements'" 
	^self explicitRequirement.! !

!TIterateSequencedReadableTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: 'delaunay 4/7/2009 10:39'!
testAllButFirstDo
	
	| result |
	result:= OrderedCollection  new.
	
	self nonEmptyMoreThan1Element  allButFirstDo: [:each | result add: each].
	
	1 to: (result size) do:
		[:i|
		self assert: (self nonEmptyMoreThan1Element  at:(i +1))=(result at:i)].
	
	self assert: result size=(self nonEmptyMoreThan1Element  size-1).! !

!TIterateSequencedReadableTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: 'delaunay 4/2/2009 15:29'!
testFindFirstNotIn

	| result |
	
	 result:=self empty findFirst: [:each | true].
	
	self assert: result=0. ! !

!TIterateSequencedReadableTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: 'delaunay 4/7/2009 10:36'!
testWithDoError
	
	self should: [self nonEmptyMoreThan1Element with: self empty do:[:a :b | ]] raise: Error.! !

!TIterateSequencedReadableTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:53'!
test0FixtureIterateSequencedReadableTest

	| res |
	
	self nonEmptyMoreThan1Element.
	self assert: self nonEmptyMoreThan1Element  size > 1.
	
	
	self empty.
	self assert: self empty isEmpty .
	
	res := true.
	self nonEmptyMoreThan1Element    
	detect: [ :each | (self nonEmptyMoreThan1Element    occurrencesOf: each) > 1 ]
	ifNone: [ res := false ].
	self assert: res = false.! !

!TIterateSequencedReadableTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: 'delaunay 4/23/2009 14:04'!
testFindLast

	| element result |
	element := self nonEmptyMoreThan1Element  at:self nonEmptyMoreThan1Element  size.
	 result:=self nonEmptyMoreThan1Element  findLast: [:each | each =element].
	
	self assert: result=self nonEmptyMoreThan1Element  size. ! !

!TIterateSequencedReadableTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: 'delaunay 4/6/2009 17:12'!
testWithCollectError
	self should: [self nonEmptyMoreThan1Element with: self empty collect:[:a :b | ]] raise: Error.! !

!TIterateSequencedReadableTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: 'delaunay 4/23/2009 12:10'!
testKeysAndValuesDo
	"| result |
	result:= OrderedCollection new.
	
	self nonEmptyMoreThan1Element  keysAndValuesDo: 
		[:i :value|
		result add: (value+i)].
	
	1 to: result size do:
		[:i|
		self assert: (result at:i)=((self nonEmptyMoreThan1Element at:i)+i)]"
	|  indexes elements |
	indexes:= OrderedCollection new.
	elements := OrderedCollection new.
	
	self nonEmptyMoreThan1Element  keysAndValuesDo: 
		[:i :value|
		indexes  add: (i).
		elements add: value].
	
	(1 to: self nonEmptyMoreThan1Element size )do:
		[ :i |
		self assert: (indexes at: i) = i.
		self assert: (elements at: i) = (self nonEmptyMoreThan1Element at: i).	
		].
	
	self assert: indexes size = elements size. 
	self assert: indexes size = self nonEmptyMoreThan1Element size . 
	
	! !

!TIterateSequencedReadableTest methodsFor: 'tests - iterate on sequenced reable collections' stamp: 'delaunay 4/23/2009 13:04'!
testPairsDo
	| index |
	index:=1.
	
	self nonEmptyMoreThan1Element  pairsDo: 
		[:each1 :each2 | 
		self assert:(self nonEmptyMoreThan1Element at:index)=each1.
		self assert:(self nonEmptyMoreThan1Element at:(index+1))=each2.
		index:=index+2].
	
	self nonEmptyMoreThan1Element size odd
		ifTrue:[self assert: index=self nonEmptyMoreThan1Element size]
		ifFalse:[self assert: index=(self nonEmptyMoreThan1Element size+1)].! !

!TIterateTest commentStamp: 'stephane.ducasse 10/6/2008 17:49'!
I'm testing that high-order iterators are working.
Note however that I do not pay attention to the order of the elements.
Hence, my doTest is designed to not checking that. 
TIterateSequenceableTest is about this distinction and as such will not be applicable to test
Set, Bag, Dictionary. 


!
!TIterateTest methodsFor: 'tests - iterating' stamp: 'CamilloBruni 3/23/2013 10:58'!
testRejectThenDo

	| result index rejectIndex |
	
	index := 0.
	rejectIndex := 0.
	
	result := self collectionWithoutNilElements 
		reject: [ :each | 
			rejectIndex := rejectIndex + 1.
			"reject the first element"
			rejectIndex = 1 ]
		thenDo: [ :each | 
			self assert: each notNil.
			index := index + 1]	.
			
	self assert: result equals: self collectionWithoutNilElements.
	self assert: rejectIndex equals: self collectionWithoutNilElements size.
	self assert: index equals: self collectionWithoutNilElements size - 1.
	 ! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'delaunay 4/22/2009 16:01'!
testSelectOnEmpty

	self assert: (self empty select: [:e | self fail]) isEmpty
	! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'TudorGirba 11/19/2013 21:24'!
testSumNumbers
	|result|
	result:= self collectionWithoutNilElements 
		sumNumbers: [ :ele | ele notNil ifTrue: [ 1 ] ifFalse: [ 0 ]].
	
	self assert: self collectionWithoutNilElements size = result! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'delaunay 4/23/2009 10:38'!
testAllSatisfy

	| element |
	" when all element  satisfy the condition, should return true : "
	self assert: ( self collectionWithoutNilElements  allSatisfy: [:each | (each notNil) ] ).
	
	" when all element don't satisfy the condition, should return false : "
	self deny: ( self collectionWithoutNilElements  allSatisfy: [:each | (each notNil) not ] ).
	
	" when only one element doesn't satisfy the condition' should return false'"
	element := self collectionWithoutNilElements anyOne.
	self deny: ( self collectionWithoutNilElements  allSatisfy: [:each | (each = element) not] ).! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'delaunay 4/22/2009 15:58'!
testCollectOnEmpty
	self assert: (self empty collect: [:e | self fail]) isEmpty! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'CamilloBruni 3/23/2013 10:47'!
testSelectNoneThenDo
	| result |
	
	result := self collectionWithoutNilElements 
		select: [ :each | each isNil ] 
		thenDo: [ self fail ].
	
	self assert: result equals: self collectionWithoutNilElements! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'CamilloBruni 3/23/2013 10:36'!
testReject

	| res element |
	res := self collectionWithoutNilElements reject: [:each | each notNil not].
	self assert: res size = self collectionWithoutNilElements size.
	
	element := self collectionWithoutNilElements anyOne.
	res := self collectionWithoutNilElements  reject: [:each | each = element].
	self assert: res size = (self collectionWithoutNilElements size - 1).
	
	
	! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'CamilloBruni 3/23/2013 10:38'!
testSelectThenCollectOnEmpty

	self assert: (self empty select: [:e | self fail ] thenCollect: [ self fail ]) isEmpty! !

!TIterateTest methodsFor: 'requirements' stamp: 'delaunay 4/23/2009 10:22'!
empty

	self explicitRequirement! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'delaunay 4/22/2009 16:30'!
testRejectNoReject

	| res |
	res := self collectionWithoutNilElements  reject: [:each | each notNil not].
	self assert: res size = self collectionWithoutNilElements size.
	! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'delaunay 4/23/2009 10:09'!
testDetect

	| res element |
	element := self collectionWithoutNilElements anyOne .
	 
	res := self collectionWithoutNilElements  detect: [:each | each = element].
	self assert: (res  = element).

	
	! !

!TIterateTest methodsFor: 'requirements' stamp: 'delaunay 4/23/2009 10:11'!
collectionWithoutNilElements
" return a collection that doesn't includes a nil element  and that doesn't includes equal elements'"
	self explicitRequirement! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'CamilloBruni 3/23/2013 10:33'!
testBasicCollect

	| res index |
	index := 0.
	res := self collectionWithoutNilElements collect: [ :each | 
		index := index + 1.
		each ].
	
	res do: [ :each | 
		self assert: (self collectionWithoutNilElements occurrencesOf: each) = (res occurrencesOf: each)].
	self assert: index equals: self collectionWithoutNilElements size.
	 ! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'delaunay 4/22/2009 15:57'!
testAllSatisfyEmpty

	self assert: ( self empty allSatisfy: [:each | false]).
	! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'delaunay 4/23/2009 10:21'!
testInjectInto
	|result|
	result:= self collectionWithoutNilElements 
		inject: 0
		into: [:inj :ele | ele notNil ifTrue: [ inj + 1 ]].
	
	self assert: self collectionWithoutNilElements size = result .! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'CamilloBruni 3/23/2013 10:38'!
testSelectNoneThenCollect
	| result |
	
	result := self collectionWithoutNilElements 
		select: [ :each | each isNil ] 
		thenCollect: [ :each| self fail ].
	
	self assert: result isEmpty! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'delaunay 4/23/2009 10:34'!
testAnySastify

	| element |
	" when all elements satisty the condition, should return true :"
	self assert: ( self collectionWithoutNilElements anySatisfy: [:each | each notNil ]).
	
	" when only one element satisfy the condition, should return true :"
	element := self collectionWithoutNilElements anyOne.
	self assert: ( self collectionWithoutNilElements  anySatisfy: [:each | (each = element)  ]   ).
	
	" when all elements don't satisty the condition, should return false :"
	self deny: ( self collectionWithoutNilElements anySatisfy: [:each | (each notNil) not ]).
! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'delaunay 4/22/2009 15:58'!
testBasicCollectEmpty

	| res |
	res := self empty collect: [:each | each class].
	self assert: res isEmpty
	! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'CamilloBruni 3/23/2013 10:34'!
testCollectThenSelectOnEmpty

	self assert: (self empty collect: [:e | self fail] thenSelect: [:e | self fail ]) isEmpty! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'CamilloBruni 3/23/2013 10:47'!
testRejectAllThenDo
	| result |
	
	result := self collectionWithoutNilElements 
		reject: [ :each | each notNil ] 
		thenDo: [ :each | self fail ].
	
	self assert: result equals: self collectionWithoutNilElements! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'delaunay 5/14/2009 15:52'!
testDo2
	"dc: Bad test, it assumes that a new instance of #speciesClass allows addition with #add:. This is not the case of Interval for which species is Array."
	"res := self speciesClass new.  
	self collection do: [:each | res add: each class].
	self assert: res = self result. "
	| collection cptElementsViewed cptElementsIn |
	collection := self collectionWithoutNilElements.
	cptElementsViewed := 0.
	cptElementsIn := OrderedCollection new.
	collection do: 
		[ :each | 
		cptElementsViewed := cptElementsViewed + 1.
		" #do doesn't iterate with the same objects than those in the collection for FloatArray( I don' t know why ) . That's why I use #includes: and not #identityIncludes:  '"
		(collection includes: each) ifTrue: [
			" the collection used doesn't include equal elements. Therefore each element viewed should not have been viewed before "
			( cptElementsIn includes: each ) ifFalse: [ cptElementsIn add: each ] .
			]. 
		].
	self assert: cptElementsViewed = collection size.
	self assert: cptElementsIn size  = collection size.
	
	! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'delaunay 4/22/2009 16:01'!
testRejectEmpty

	| res |
	res := self empty reject: [:each | each odd].
	self assert: res size = self empty size
	! !

!TIterateTest methodsFor: 'test - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureIterateTest
	| res |
	self collectionWithoutNilElements.
	self assert: (self collectionWithoutNilElements occurrencesOf: nil) = 0.
	res := true.
	self collectionWithoutNilElements
		detect: [ :each | (self collectionWithoutNilElements occurrencesOf: each) > 1 ]
		ifNone: [ res := false ].
	self assert: res = false! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'delaunay 4/23/2009 10:10'!
testDetectIfNone

	| res element |
	res := self collectionWithoutNilElements  detect: [:each | each notNil not] ifNone: [100].
	self assert: res  = 100.
	
	element := self collectionWithoutNilElements anyOne.
	res := self collectionWithoutNilElements  detect: [:each | each = element] ifNone: [100].
	self assert: res  = element.

	
	! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'CamilloBruni 3/23/2013 10:34'!
testCollectThenDoOnEmpty

	self assert: (self empty collect: [:e | self fail] thenDo: [ self fail ]) isEmpty! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'CamilloBruni 3/23/2013 10:49'!
testRejectAllThenCollect
	| result |
	
	result := self collectionWithoutNilElements 
		reject: [ :each | each notNil ] 
		thenCollect: [ :each| self fail ].
	
	self assert: result isEmpty! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'CamilloBruni 4/9/2013 10:39'!
testRejectThenCollect

	| result index selectIndex pivot |
	
	index := 0.
	selectIndex := 0.
	pivot := self collectionWithoutNilElements anyOne.
	
	result := self collectionWithoutNilElements 
		reject: [ :each | 
			selectIndex := selectIndex + 1.
			"reject the first element"
			selectIndex = 1 ]
		thenCollect: [ :each | 
			self assert: each notNil.
			index := index + 1.
			pivot ].
			
	self assert: result ~= self collectionWithoutNilElements.
	self assert: selectIndex equals: self collectionWithoutNilElements size.
	self assert: index equals: self collectionWithoutNilElements size - 1.
	
	self assert: (self collectionWithoutNilElements occurrencesOf: pivot) equals: 1.
	"should be > 1 for standard collection and = 1 for those that do not allow exact duplicates"
	self assert: (result occurrencesOf: pivot) >= 1.
	 ! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'CamilloBruni 3/23/2013 10:35'!
testRejectThenCollectEmpty

	self assert: (self empty reject: [:e | self fail ] thenCollect: [ :each| self fail ]) isEmpty! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'delaunay 4/22/2009 16:22'!
testDoSeparatedBy
	| string expectedString beforeFirst |
	
	string := ''.
	self collectionWithoutNilElements  
		do: [ :each | string := string , each asString ]
		separatedBy: [ string := string , '|' ].
		
	expectedString := ''.
	beforeFirst := true.
	self collectionWithoutNilElements  do: 
		[ :each | 
		beforeFirst = true 
			ifTrue: [ beforeFirst := false ]
			ifFalse: [ expectedString := expectedString , '|' ].
		expectedString := expectedString , each asString ].
	self assert: expectedString = string! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'delaunay 4/23/2009 10:17'!
testNoneSatisfy

	| element |
	self assert: ( self collectionWithoutNilElements  noneSatisfy: [:each | each notNil not ] ).
	element := self collectionWithoutNilElements anyOne.
	self deny: ( self collectionWithoutNilElements  noneSatisfy: [:each | (each = element)not ] ).! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'CamilloBruni 4/9/2013 10:39'!
testSelectThenCollect

	| result index selectIndex pivot |
	
	index := 0.
	selectIndex := 0.
	pivot := self collectionWithoutNilElements anyOne.
	
	result := self collectionWithoutNilElements 
		select: [ :each | 
			selectIndex := selectIndex + 1.
			"reject the first element"
			selectIndex > 1 ]
		thenCollect: [ :each | 
			self assert: each notNil.
			index := index + 1.
			pivot ].
			
	self assert: result ~= self collectionWithoutNilElements.
	self assert: selectIndex equals: self collectionWithoutNilElements size.
	self assert: index equals: self collectionWithoutNilElements size - 1.
	
	self assert: (self collectionWithoutNilElements occurrencesOf: pivot) equals: 1.
	"should be > 1 for standard collection and = 1 for those that do not allow exact duplicates"
	self assert: (result occurrencesOf: pivot) >= 1.
	 ! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'delaunay 4/22/2009 16:00'!
testNoneSatisfyEmpty

	self assert: ( self empty noneSatisfy: [:each | false]).
	! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'CamilloBruni 3/23/2013 10:59'!
testSelect

	| result element |
	result := self collectionWithoutNilElements select: [ :each | each notNil].
	self assert: result size equals: self collectionWithoutNilElements size.
	
	element := self collectionWithoutNilElements anyOne.
	result := self collectionWithoutNilElements select: [ :each | (each = element) not].
	self assert: result size equals: (self collectionWithoutNilElements size - 1).
	! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'CamilloBruni 3/23/2013 10:34'!
testRejectThenDoOnEmpty

	self assert: (self empty reject: [:e | self fail ] thenDo: [ self fail ]) isEmpty! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'CamilloBruni 3/23/2013 10:38'!
testSelectThenDoOnEmpty

	self assert: (self empty select: [:e | self fail ] thenDo: [ self fail ]) isEmpty! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'delaunay 4/23/2009 10:26'!
testDoWithout
	"self debug: #testDoWithout"
	
	| res element collection |
	collection := self collectionWithoutNilElements .	
	res := OrderedCollection new.  
	element := self collectionWithoutNilElements anyOne .
	collection  do: [:each | res add: each] without: element  .
	" verifying result :"
	self assert: res size = (collection  size - (collection  occurrencesOf: element)).
	res do: [:each | self assert: (collection occurrencesOf: each) = ( res occurrencesOf: each ) ].
	! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'CamilloBruni 3/23/2013 10:53'!
testBasicCollectThenDo

	| result index |
	index := 0.
	result := self collectionWithoutNilElements 
		collect: [ :each | nil ]
		thenDo: [ :each | 
			self assert: each isNil.
			index := index + 1]	.
			
	self assert: result equals: self collectionWithoutNilElements.
	self assert: index equals: self collectionWithoutNilElements size.
	 ! !

!TIterateTest methodsFor: 'tests - iterating' stamp: 'CamilloBruni 3/23/2013 10:57'!
testSelectThenDo

	| result index selectIndex |
	
	index := 0.
	selectIndex := 0.
	
	result := self collectionWithoutNilElements 
		select: [ :each | 
			selectIndex := selectIndex + 1.
			"reject the first element"
			selectIndex > 1 ]
		thenDo: [ :each | 
			self assert: each notNil.
			index := index + 1]	.
			
	self assert: result equals: self collectionWithoutNilElements.
	self assert: selectIndex equals: self collectionWithoutNilElements size.
	self assert: index equals: self collectionWithoutNilElements size - 1.
	 ! !

!TNBMemoryAccessors methodsFor: 'memory access +' stamp: 'IgorStasenko 11/24/2012 17:02'!
nbUInt8AtOffset: zeroBasedOffset
	
	"Reads unsigned 8-bit integer from memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(uint8 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			mov: asm EAX ptr8 + asm ECX to: asm AL
	]
! !

!TNBMemoryAccessors methodsFor: 'memory access +' stamp: 'IgorStasenko 11/24/2012 17:00'!
nbUInt16AtOffset: zeroBasedOffset
	
	"Reads unsigned 16-bit integer from memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(uint16 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			mov: asm EAX ptr16 + asm ECX to: asm AX
	]
! !

!TNBMemoryAccessors methodsFor: 'memory access +' stamp: 'IgorStasenko 11/24/2012 17:01'!
nbUInt64AtOffset: zeroBasedOffset
	
	"Reads unsigned 64-bit integer from memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(uint64 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			mov: asm EAX ptr + asm ECX + 4 to: asm EDX;
			mov: asm EAX ptr + asm ECX to: asm EAX
	]
! !

!TNBMemoryAccessors methodsFor: 'memory access +' stamp: 'IgorStasenko 11/24/2012 17:02'!
nbUInt8AtOffset: zeroBasedOffset  put: value
	
	"Store unsigned 8-bit integer into memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong zeroBasedOffset, uint8 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX; "value"
			mov: asm DL to: asm EAX ptr8 + asm ECX
	] ! !

!TNBMemoryAccessors methodsFor: 'memory access +' stamp: 'IgorStasenko 11/24/2012 16:50'!
nbFloat64AtOffset: zeroBasedOffset put: value
	"Store 64-bit float at ZERO-based index.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong zeroBasedOffset, float64 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			add: asm EAX with: asm ECX;
			
			mov: asm ESP ptr to: asm ECX;
			mov: asm ECX to: asm EAX ptr;

			mov: asm ESP ptr +4 to: asm ECX;
			mov: asm ECX to: asm EAX ptr +4 
	] ! !

!TNBMemoryAccessors methodsFor: 'memory access +' stamp: 'IgorStasenko 11/24/2012 16:34'!
nbFloat32AtOffset: zeroBasedOffset put: value
	"Store 32-bit float at ZERO-based index.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong zeroBasedOffset, float32 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX;
			mov: asm EDX to: asm EAX ptr + asm ECX
	] ! !

!TNBMemoryAccessors methodsFor: 'memory access +' stamp: 'IgorStasenko 11/24/2012 17:01'!
nbUInt16AtOffset: zeroBasedOffset  put: value
	
	"Store unsigned 16-bit integer into memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong zeroBasedOffset, uint16 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX; "value"
			mov: asm DX to: asm EAX ptr16 + asm ECX
	] ! !

!TNBMemoryAccessors methodsFor: 'memory access +' stamp: 'IgorStasenko 11/24/2012 16:32'!
nbFloat32AtOffset: zeroBasedOffset
	"Read 32-bit float at ZERO-based index.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(float32 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			add: asm EAX with: asm ECX;
			fld: asm EAX ptr32. "load a floating point value from memory, at base address, held in EAX register into fp(0) register,
				we are using #ptr32, to indicate that memory operand size is 32bits long"
	] ! !

!TNBMemoryAccessors methodsFor: 'memory access +' stamp: 'IgorStasenko 11/24/2012 17:00'!
nbInt64AtOffset: zeroBasedOffset  put: value
	
	"Store signed 64-bit integer into memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong zeroBasedOffset, int64 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX; "value low word"
			mov: asm EDX to: asm EAX ptr32 + asm ECX;
			pop: asm EDX; "value high word"
			mov: asm EDX to: asm EAX ptr32 + asm ECX + 4
	]
! !

!TNBMemoryAccessors methodsFor: 'memory access +' stamp: 'IgorStasenko 11/24/2012 16:50'!
nbFloat64AtOffset: zeroBasedOffset
	"Read 64-bit float at ZERO-based index.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(float64 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "index"
			add: asm EAX with: asm ECX;
			fld: asm EAX ptr64. "load a floating point value from memory, at base address, held in EAX register into fp(0) register,
				we are using #ptr64, to indicate that memory operand size is 64bits long"
	] ! !

!TNBMemoryAccessors methodsFor: 'memory access +' stamp: 'IgorStasenko 11/24/2012 16:50'!
nbInt16AtOffset: zeroBasedOffset
	
	"Reads signed 16-bit integer from memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(int16 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			mov: asm EAX ptr16 + asm ECX to: asm AX
	]
! !

!TNBMemoryAccessors methodsFor: 'memory access +' stamp: 'IgorStasenko 11/24/2012 16:59'!
nbInt16AtOffset: zeroBasedOffset  put: value
	
	"Store signed 16-bit integer into memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong zeroBasedOffset, int16 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX; "value"
			mov: asm DX to: asm EAX ptr16 + asm ECX
	]
! !

!TNBMemoryAccessors methodsFor: 'memory access +' stamp: 'IgorStasenko 11/24/2012 17:00'!
nbInt8AtOffset: zeroBasedOffset  put: value
	
	"Store signed 8-bit integer into memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong zeroBasedOffset, int8 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX; "value"
			mov: asm DL to: asm EAX ptr8 + asm ECX
	]
! !

!TNBMemoryAccessors methodsFor: 'memory access +' stamp: 'IgorStasenko 11/24/2012 17:00'!
nbInt8AtOffset: zeroBasedOffset
	
	"Reads signed 8-bit integer from memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(int8 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			mov: asm EAX ptr8 + asm ECX to: asm AL
	]
! !

!TNBMemoryAccessors methodsFor: 'memory access +' stamp: 'IgorStasenko 11/24/2012 17:01'!
nbUInt32AtOffset: zeroBasedOffset
	
	"Reads unsigned 32-bit integer from memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(uint32 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			mov: asm EAX ptr32 + asm ECX to: asm EAX
	]
! !

!TNBMemoryAccessors methodsFor: 'memory access +' stamp: 'IgorStasenko 11/24/2012 16:59'!
nbInt32AtOffset: zeroBasedOffset
	
	"Reads signed 32-bit integer from memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(int32 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			mov: asm EAX ptr32 + asm ECX to: asm EAX
	]
! !

!TNBMemoryAccessors methodsFor: 'memory access +' stamp: 'IgorStasenko 11/24/2012 17:02'!
nbUInt64AtOffset: zeroBasedOffset  put: value
	
	"Store unsigned 64-bit integer into memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function:  #(void (self, ulong zeroBasedOffset, uint64 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX; "value low word"
			mov: asm EDX to: asm EAX ptr32 + asm ECX;
			pop: asm EDX; "value high word"
			mov: asm EDX to: asm EAX ptr32 + asm ECX + 4
	]
! !

!TNBMemoryAccessors methodsFor: 'memory access +' stamp: 'IgorStasenko 11/24/2012 16:59'!
nbInt32AtOffset: zeroBasedOffset  put: value
	
	"Store signed 32-bit integer into memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong zeroBasedOffset, int32 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX; "value"
			mov: asm EDX to: asm EAX ptr32 + asm ECX
	]
! !

!TNBMemoryAccessors methodsFor: 'memory access +' stamp: 'IgorStasenko 11/24/2012 16:59'!
nbInt64AtOffset: zeroBasedOffset
	
	"Reads signed 64-bit integer from memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(int64 (self, ulong zeroBasedOffset)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			mov: asm EAX ptr + asm ECX + 4 to: asm EDX;
			mov: asm EAX ptr + asm ECX to: asm EAX
	]
! !

!TNBMemoryAccessors methodsFor: 'memory access +' stamp: 'IgorStasenko 11/24/2012 17:01'!
nbUInt32AtOffset: zeroBasedOffset  put: value
	
	"Store unsigned 32-bit integer into memory at (receiver's address + ZERO-based offset) using native byte order.
	Note, there is no range checking "

	<primitive: #primitiveNativeCall module: #NativeBoostPlugin>
	
	^ self nbCallout function: #(void (self, ulong zeroBasedOffset, uint32 value)) emit: [:gen |
		| asm |
		
		asm := gen asm.
		asm 
			pop: asm EAX;  "pointer to receiver's first byte"
			pop: asm ECX; "offset"
			pop: asm EDX; "value"
			mov: asm EDX to: asm EAX ptr32 + asm ECX
	]
! !

!TOccurrencesForIdentityCollectionsTest commentStamp: 'TorstenBergmann 2/20/2014 15:34'!
A trait for test purposes!
!TOccurrencesForIdentityCollectionsTest methodsFor: 'requirements' stamp: 'delaunay 5/13/2009 14:22'!
identityCollectionWithElementsCopyNotIdentical
" return a collection including elements for which #copy return a new object "
^ self explicitRequirement! !

!TOccurrencesForIdentityCollectionsTest methodsFor: 'tests - occurrencesOf for identity collections' stamp: 'delaunay 5/13/2009 14:27'!
testOccurencesOfForIdentityCollections

| collection element elementCopy |
collection := self identityCollectionWithElementsCopyNotIdentical .
element := collection anyOne.
elementCopy := element copy.

self assert: (collection occurrencesOf: elementCopy ) = 0.! !

!TOccurrencesForIdentityCollectionsTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureOccurrencesForIdentityCollectionsTest
	self identityCollectionWithElementsCopyNotIdentical.
	self identityCollectionWithElementsCopyNotIdentical do: [ :each | self deny: each copy == each ]! !

!TOccurrencesForMultiplinessTest commentStamp: 'TorstenBergmann 2/20/2014 15:34'!
A trait for test purposes!
!TOccurrencesForMultiplinessTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOf
	| collection |
	collection := self collectionWithoutEqualElements .
	
	collection do: [ :each | self assert: (collection occurrencesOf: each) = 1 ].! !

!TOccurrencesForMultiplinessTest methodsFor: 'requirements' stamp: 'delaunay 5/13/2009 15:05'!
collectionWithEqualElements
" return a collecition including atLeast two elements equal"

^ self explicitRequirement.! !

!TOccurrencesForMultiplinessTest methodsFor: 'requirements' stamp: ''!
empty
	self explicitRequirement! !

!TOccurrencesForMultiplinessTest methodsFor: 'requirements' stamp: ''!
collectionWithoutEqualElements
	self explicitRequirement! !

!TOccurrencesForMultiplinessTest methodsFor: 'tests - occurrencesOf for multipliness' stamp: 'Alexandre Bergel 5/22/2010 12:25'!
testOccurrencesOfForMultipliness

| collection elem |
collection := self collectionWithEqualElements .
elem := self elementTwiceInForOccurrences .

self assert: (collection occurrencesOf: elem ) = 2.  ! !

!TOccurrencesForMultiplinessTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOfNotIn
	| result |
	result := self collectionWithoutEqualElements occurrencesOf: self elementNotInForOccurrences.
	self assert: result = 0! !

!TOccurrencesForMultiplinessTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureOccurrencesForMultiplinessTest
	| cpt anElement collection |
	self collectionWithEqualElements.
	self collectionWithEqualElements.
	self elementTwiceInForOccurrences.
	anElement := self elementTwiceInForOccurrences.
	collection := self collectionWithEqualElements.
	cpt := 0.	" testing with identity check ( == ) so that identy collections can use this trait : "
	self collectionWithEqualElements
		do: [ :each | 
			each == self elementTwiceInForOccurrences
				ifTrue: [ cpt := cpt + 1 ] ].
	self assert: cpt = 2! !

!TOccurrencesForMultiplinessTest methodsFor: 'tests - occurrencesOf' stamp: ''!
testOccurrencesOfEmpty
	| result |
	result := self empty occurrencesOf: (self collectionWithoutEqualElements anyOne).
	self assert: result = 0! !

!TOccurrencesForMultiplinessTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureOccurrencesTest
	| tmp |
	self empty.
	self assert: self empty isEmpty.
	self collectionWithoutEqualElements.
	self deny: self collectionWithoutEqualElements isEmpty.
	tmp := OrderedCollection new.
	self collectionWithoutEqualElements
		do: [ :each | 
			self deny: (tmp includes: each).
			tmp add: each ].
	self elementNotInForOccurrences.
	self deny: (self collectionWithoutEqualElements includes: self elementNotInForOccurrences)! !

!TOccurrencesForMultiplinessTest methodsFor: 'requirements' stamp: ''!
elementNotInForOccurrences
" return an element notIncluded in #collectionWithoutEqualElements"
	self explicitRequirement! !

!TOccurrencesForMultiplinessTest methodsFor: 'requirements' stamp: 'delaunay 5/13/2009 15:24'!
elementTwiceInForOccurrences
" return an element included exactly two time in # collectionWithEqualElements"
^ self explicitRequirement! !

!TOccurrencesTest commentStamp: 'TorstenBergmann 2/20/2014 15:34'!
A trait for test purposes!
!TOccurrencesTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 11:16'!
empty
	self explicitRequirement! !

!TOccurrencesTest methodsFor: 'requirements' stamp: 'delaunay 5/13/2009 14:51'!
collectionWithoutEqualElements
	self explicitRequirement! !

!TOccurrencesTest methodsFor: 'tests - occurrencesOf' stamp: 'delaunay 5/13/2009 14:51'!
testOccurrencesOfNotIn
	| result |
	result := self collectionWithoutEqualElements occurrencesOf: self elementNotInForOccurrences.
	self assert: result = 0! !

!TOccurrencesTest methodsFor: 'tests - occurrencesOf' stamp: 'delaunay 5/13/2009 14:55'!
testOccurrencesOfEmpty
	| result |
	result := self empty occurrencesOf: (self collectionWithoutEqualElements anyOne).
	self assert: result = 0! !

!TOccurrencesTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureOccurrencesTest
	| tmp |
	self empty.
	self assert: self empty isEmpty.
	self collectionWithoutEqualElements.
	self deny: self collectionWithoutEqualElements isEmpty.
	tmp := OrderedCollection new.
	self collectionWithoutEqualElements
		do: [ :each | 
			self deny: (tmp includes: each).
			tmp add: each ].
	self elementNotInForOccurrences.
	self deny: (self collectionWithoutEqualElements includes: self elementNotInForOccurrences)! !

!TOccurrencesTest methodsFor: 'requirements' stamp: 'delaunay 5/13/2009 14:52'!
elementNotInForOccurrences
" return an element notIncluded in #collectionWithoutEqualElements"
	self explicitRequirement! !

!TOccurrencesTest methodsFor: 'tests - occurrencesOf' stamp: 'delaunay 5/13/2009 14:55'!
testOccurrencesOf
	| collection |
	collection := self collectionWithoutEqualElements .
	
	collection do: [ :each | self assert: (collection occurrencesOf: each) = 1 ].! !

!TOne commentStamp: 'MartinDias 1/31/2014 15:49'!
I am a trait used for testing.!
!TOne methodsFor: 'testing' stamp: 'MartinDias 8/1/2012 00:06'!
one
	^ 1! !

!TOne classTrait methodsFor: 'testing' stamp: 'MartinDias 7/1/2013 12:39'!
classOne
	^ 1! !

!TPointAccess commentStamp: 'HenrikSperreJohansen 1/26/2011 15:54'!
Contains methods for accessing points stored in variable word classes.
Initially used by PointArray & ShortPointArray!
!TPointAccess methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 1/26/2011 15:49'!
bounds
	| min max |
	min := max := self at: 1.
	self do:[:pt|
		min := min min: pt.
		max := max max: pt].
	^min corner: max
		! !

!TPointAccess methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 1/26/2011 15:49'!
at: index put: aPoint

	super at: index * 2 - 1 put: aPoint x asInteger.
	super at: index * 2 put: aPoint y asInteger.
	^aPoint! !

!TPointAccess methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 1/26/2011 15:48'!
at: index

	^(super at: index * 2 - 1) @ (super at: index * 2)! !

!TPointAccess methodsFor: 'accessing' stamp: 'HenrikSperreJohansen 1/26/2011 15:49'!
defaultElement 

	"Return the default element of the receiver"
	^0@0! !

!TPrintOnSequencedTest commentStamp: 'TorstenBergmann 2/20/2014 15:35'!
A trait for test purposes!
!TPrintOnSequencedTest methodsFor: 'tests - printing' stamp: 'delaunay 4/10/2009 15:22'!
testPrintOn
	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printOn: aStream .
	allElementsAsString:=(result findBetweenSubStrs: ' ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i=1
			ifTrue:[
			self accessCollection class name first isVowel 
				ifTrue:[self assert: (allElementsAsString at:i)='an' ]
				ifFalse:[self assert: (allElementsAsString at:i)='a'].].
		i=2
			ifTrue:[self assert: (allElementsAsString at:i)=self accessCollection class name].
		i>2
			ifTrue:[self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString).].	
			].! !

!TPrintOnSequencedTest methodsFor: 'tests - printing' stamp: 'delaunay 4/10/2009 10:52'!
testPrintElementsOn

	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printElementsOn: aStream .
	allElementsAsString:=(result findBetweenSubStrs: ' ' ).
	1 to: allElementsAsString size do:
		[:i | 
		self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString).
			].! !

!TPrintOnSequencedTest methodsFor: 'tests - printing' stamp: 'delaunay 4/10/2009 10:28'!
testPrintOnDelimiterLast

	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printOn: aStream delimiter: ', ' last: 'and'.
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 )
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString)].
		i=(allElementsAsString size-1)
			ifTrue:[ self deny: (allElementsAsString at:i)=('and')asString].
		i=(allElementsAsString size)
			ifTrue: [self assert: (allElementsAsString at:i)=((self nonEmpty at:(i-1))asString)].
			].! !

!TPrintOnSequencedTest methodsFor: 'tests - printing' stamp: 'delaunay 4/10/2009 15:13'!
testPrintNameOn

	| aStream result |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printNameOn: aStream .
	Transcript show: result asString.
	self nonEmpty class name first isVowel
		ifTrue:[ self assert: aStream contents =('an ',self nonEmpty class name ) ]
		ifFalse:[self assert: aStream contents =('a ',self nonEmpty class name)].! !

!TPrintOnSequencedTest methodsFor: 'tests - printing' stamp: 'delaunay 4/10/2009 10:29'!
testPrintOnDelimiter
	| aStream result allElementsAsString |
	result:=''.
	aStream:= ReadWriteStream on: result.
	
	self nonEmpty printOn: aStream delimiter: ', ' .
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		self assert: (allElementsAsString at:i)=((self nonEmpty at:i)asString).
			].! !

!TPrintOnSequencedTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixturePrintTest
	self nonEmpty! !

!TPrintOnSequencedTest methodsFor: 'requirements' stamp: ''!
nonEmpty
 self explicitRequirement! !

!TPrintOnSequencedTest methodsFor: 'tests - printing' stamp: ''!
testStoreOn
" for the moment work only for collection that include simple elements such that Integer"

"| string str result cuttedResult index elementsAsStringExpected elementsAsStringObtained tmp |
string := ''.
str := ReadWriteStream  on: string.
elementsAsStringExpected := OrderedCollection new.
elementsAsStringObtained := OrderedCollection new.
self nonEmpty do: [ :each | elementsAsStringExpected  add: each asString].

self nonEmpty storeOn: str.
result := str contents .
cuttedResult := ( result findBetweenSubStrs: ';' ).

index := 1.

cuttedResult do:
	[ :each |
	index = 1 
		ifTrue: [ self assert: (each beginsWith: ( tmp := '((' , self nonEmpty class asString , ' new) add: '           )).
				tmp := each copyFrom: ( tmp size + 1) to: ( each size ).
				elementsAsStringObtained add: tmp.
				index := index + 1. ]
		ifFalse:  [ 
		 index < cuttedResult size
			ifTrue:[self assert: (each beginsWith: ( tmp:=  ' add: '   )).
				tmp := each copyFrom: ( tmp size + 1) to: ( each size ).
				elementsAsStringObtained add: tmp.
					index := index + 1.]
			ifFalse: [self assert: ( each = ' yourself)' ) ].
			]
	
	].


	elementsAsStringExpected do: [ :each | self assert: (elementsAsStringExpected occurrencesOf: each ) = ( elementsAsStringObtained occurrencesOf: each) ]"

! !

!TPrintTest commentStamp: 'TorstenBergmann 2/20/2014 15:35'!
A trait for test purposes!
!TPrintTest methodsFor: 'tests - printing' stamp: 'delaunay 4/27/2009 10:17'!
testPrintOn
	| aStream result allElementsAsString tmp |
	result:=''.
	aStream:= ReadWriteStream on: result.
	tmp:= OrderedCollection new.
	self nonEmpty do: [:each | tmp add: each asString].
	
	self nonEmpty printOn: aStream .
	allElementsAsString:=(result findBetweenSubStrs: ' ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i=1
			ifTrue:[
			self accessCollection class name first isVowel 
				ifTrue:[self assert: (allElementsAsString at:i)='an' ]
				ifFalse:[self assert: (allElementsAsString at:i)='a'].].
		i=2
			ifTrue:[self assert: (allElementsAsString at:i)=self accessCollection class name].
		i>2
			ifTrue:[self assert: (tmp occurrencesOf:(allElementsAsString at:i))=(allElementsAsString  occurrencesOf:(allElementsAsString at:i)).].	
			].! !

!TPrintTest methodsFor: 'tests - printing' stamp: 'delaunay 4/27/2009 10:16'!
testPrintElementsOn

	| aStream result allElementsAsString tmp |
	result:=''.
	aStream:= ReadWriteStream on: result.
	tmp:= OrderedCollection new.
	self nonEmpty do: [:each | tmp add: each asString].
	
	self nonEmpty printElementsOn: aStream .
	allElementsAsString:=(result findBetweenSubStrs: ' ' ).
	1 to: allElementsAsString size do:
		[:i | 
		self assert: (tmp occurrencesOf:(allElementsAsString at:i))=(allElementsAsString  occurrencesOf:(allElementsAsString at:i)).
			].! !

!TPrintTest methodsFor: 'tests - printing' stamp: 'delaunay 4/27/2009 10:17'!
testPrintOnDelimiterLast

	| aStream result allElementsAsString tmp |
	result:=''.
	aStream:= ReadWriteStream on: result.
	tmp:= OrderedCollection new.
	self nonEmpty do: [:each | tmp add: each asString].
	
	self nonEmpty printOn: aStream delimiter: ', ' last: 'and'.
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		i<(allElementsAsString size-1 )
			ifTrue: [self assert: (tmp occurrencesOf: (allElementsAsString at:i))=(allElementsAsString  occurrencesOf: (allElementsAsString at:i))].
		i=(allElementsAsString size-1)
			ifTrue:[ self deny: (allElementsAsString at:i)=('and')asString].
		i=(allElementsAsString size)
			ifTrue: [self assert: (tmp occurrencesOf: (allElementsAsString at:i))=(allElementsAsString  occurrencesOf: (allElementsAsString at:i))].
			].! !

!TPrintTest methodsFor: 'tests - printing' stamp: 'StephaneDucasse 8/19/2010 21:38'!
testPrintNameOn

	| aStream result |
	result:=''.
	aStream:= ReadWriteStream on: result.
	self nonEmpty printNameOn: aStream.
	self nonEmpty class name first isVowel
		ifTrue:[ self assert: aStream contents =('an ',self nonEmpty class name ) ]
		ifFalse:[self assert: aStream contents =('a ',self nonEmpty class name)].! !

!TPrintTest methodsFor: 'tests - printing' stamp: 'delaunay 4/27/2009 10:17'!
testPrintOnDelimiter
	| aStream result allElementsAsString tmp |
	result:=''.
	aStream:= ReadWriteStream on: result.
	tmp:= OrderedCollection new.
	self nonEmpty do: [:each | tmp add: each asString].
	
	
	
	self nonEmpty printOn: aStream delimiter: ', ' .
	
	allElementsAsString:=(result findBetweenSubStrs: ', ' ).
	1 to: allElementsAsString size do:
		[:i | 
		self assert: (tmp occurrencesOf:(allElementsAsString at:i))=(allElementsAsString  occurrencesOf:(allElementsAsString at:i))
			].! !

!TPrintTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixturePrintTest
	self nonEmpty.
	self deny: self nonEmpty isEmpty! !

!TPrintTest methodsFor: 'requirements' stamp: 'delaunay 4/14/2009 16:30'!
nonEmpty
 self explicitRequirement! !

!TPrintTest methodsFor: 'tests - printing' stamp: 'delaunay 5/6/2009 14:26'!
testStoreOn
" for the moment work only for collection that include simple elements such that Integer"

"| string str result cuttedResult index elementsAsStringExpected elementsAsStringObtained tmp |
string := ''.
str := ReadWriteStream  on: string.
elementsAsStringExpected := OrderedCollection new.
elementsAsStringObtained := OrderedCollection new.
self nonEmpty do: [ :each | elementsAsStringExpected  add: each asString].

self nonEmpty storeOn: str.
result := str contents .
cuttedResult := ( result findBetweenSubStrs: ';' ).

index := 1.

cuttedResult do:
	[ :each |
	index = 1 
		ifTrue: [ self assert: (each beginsWith: ( tmp := '((' , self nonEmpty class asString , ' new) add: '           )).
				tmp := each copyFrom: ( tmp size + 1) to: ( each size ).
				elementsAsStringObtained add: tmp.
				index := index + 1. ]
		ifFalse:  [ 
		 index < cuttedResult size
			ifTrue:[self assert: (each beginsWith: ( tmp:=  ' add: '   )).
				tmp := each copyFrom: ( tmp size + 1) to: ( each size ).
				elementsAsStringObtained add: tmp.
					index := index + 1.]
			ifFalse: [self assert: ( each = ' yourself)' ) ].
			]
	
	].


	elementsAsStringExpected do: [ :each | self assert: (elementsAsStringExpected occurrencesOf: each ) = ( elementsAsStringObtained occurrencesOf: each) ]"

! !

!TPutBasicTest commentStamp: 'TorstenBergmann 2/20/2014 15:35'!
A trait for test purposes!
!TPutBasicTest methodsFor: 'requirements' stamp: 'delaunay 4/24/2009 10:43'!
aValue
" return a value to put into nonEmpty"
	^ self explicitRequirement! !

!TPutBasicTest methodsFor: 'tests - at put' stamp: 'delaunay 3/27/2009 13:45'!
testAtPut
	"self debug: #testAtPut"
	
	self nonEmpty at: self anIndex put: self aValue.
	self assert: (self nonEmpty at: self anIndex) = self aValue.
	! !

!TPutBasicTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 11:07'!
empty
	^self explicitRequirement.! !

!TPutBasicTest methodsFor: 'tests - at put' stamp: 'stephane.ducasse 1/12/2009 17:17'!
testAtPutTwoValues
	"self debug: #testAtPutTwoValues"
	
	self nonEmpty at: self anIndex put: self aValue.
	self nonEmpty at: self anIndex put: self anotherValue.
	self assert: (self nonEmpty at: self anIndex) = self anotherValue.! !

!TPutBasicTest methodsFor: 'requirements' stamp: 'delaunay 4/24/2009 10:44'!
anIndex
" return an index in nonEmpty bounds"
	^ self explicitRequirement! !

!TPutBasicTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:53'!
test0FixturePutTest
	self aValue.
	self anotherValue.
	
	self anIndex.
	self nonEmpty isDictionary 
		ifFalse:[self assert: (self anIndex >=1 & self anIndex <= self nonEmpty size).].
	
	self empty.
	self assert: self empty isEmpty .
	
	self nonEmpty.
	self deny: self nonEmpty  isEmpty.! !

!TPutBasicTest methodsFor: 'tests - at put' stamp: 'stephane.ducasse 1/12/2009 17:23'!
testAtPutOutOfBounds
	"self debug: #testAtPutOutOfBounds"
	
	self should: [self empty at: self anIndex put: self aValue] raise: Error
	! !

!TPutBasicTest methodsFor: 'requirements' stamp: 'delaunay 4/24/2009 10:44'!
anotherValue
" return a value ( not eual to 'aValue' ) to put into nonEmpty "
	^ self explicitRequirement! !

!TPutBasicTest methodsFor: 'requirements' stamp: 'stephane.ducasse 1/12/2009 16:56'!
nonEmpty

	^ self explicitRequirement! !

!TPutTest commentStamp: 'TorstenBergmann 2/20/2014 15:35'!
A trait for test purposes!
!TPutTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 10:50'!
aValue
" return a value to put into nonEmpty"
	^ self explicitRequirement! !

!TPutTest methodsFor: 'tests - puting with indexes' stamp: 'delaunay 4/28/2009 11:01'!
testFromToPut
	
	| collection index |
	index := self indexArray anyOne.
	collection := self nonEmpty copy.
	collection from: 1 to: index  put: self aValue..
	1 to: index do:
		[:i | self assert: (collection at: i)= self aValue].
	(index +1) to: collection size do:
		[:i | self assert: (collection at:i)= (self nonEmpty at:i)].! !

!TPutTest methodsFor: 'tests - puting with indexes' stamp: 'delaunay 4/28/2009 10:54'!
testAtAllPut
	| |
	self nonEmpty atAll: self indexArray put: self aValue..
	
	self indexArray do:
		[:i | self assert: (self nonEmpty at: i)=self aValue ].
	! !

!TPutTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 10:51'!
indexArray
" return a Collection including indexes between bounds of 'nonEmpty' "

	self explicitRequirement.! !

!TPutTest methodsFor: 'tests - puting with indexes' stamp: 'Alexandre Bergel 5/22/2010 12:23'!
testAtAllPutAll

	| aValueArray |
	aValueArray := self valueArray .
	self nonEmpty atAll: self indexArray putAll: aValueArray  .
	
	1 to: self indexArray size do:
		[:i |
		self assert: (self nonEmpty at:(self indexArray at: i))= (aValueArray  at:i) ]! !

!TPutTest methodsFor: 'tests - puting with indexes' stamp: 'delaunay 4/28/2009 10:56'!
testAtAllIndexesPut
	
	self nonEmpty atAllPut: self aValue.
	self nonEmpty do:[ :each| self assert: each = self aValue].
	! !

!TPutTest methodsFor: 'tests - puting with indexes' stamp: 'delaunay 4/28/2009 11:23'!
testAtLastPut
	| result index |
	index := self indexArray anyOne.
	result := self nonEmpty atLast: index  put: self aValue.
	
	self assert: (self nonEmpty at: (self nonEmpty size +1 - index)) = self aValue .! !

!TPutTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 10:51'!
nonEmpty

	^ self explicitRequirement! !

!TPutTest methodsFor: 'tests - puting with indexes' stamp: 'delaunay 4/28/2009 11:00'!
testAtWrapPut
	"self debug: #testAtWrapPut"
	| index |
	index := self indexArray anyOne.
	
	self nonEmpty atWrap: 0 put: self aValue.
	self assert: (self nonEmpty at:(self nonEmpty size))=self aValue.
	
	self nonEmpty atWrap: (self nonEmpty size+1) put: self aValue.
	self assert: (self nonEmpty at:(1))=self aValue.
	
	self nonEmpty atWrap: (index  ) put: self aValue.
	self assert: (self nonEmpty at: index ) = self aValue.
	
	self nonEmpty atWrap: (self nonEmpty size+index  ) put: self aValue .
	self assert: (self nonEmpty at:(index ))=self aValue .! !

!TPutTest methodsFor: 'tests - puting with indexes' stamp: 'GuillermoPolito 5/24/2010 14:31'!
testSwapWith
	"self debug: #testSwapWith"
	| result index |
	index := self indexArray anyOne.
	result:= self nonEmpty copy .
	result swap: index with: 1.
	self assert: (result at: index) = (self nonEmpty at:1).
	self assert: (result at: 1) = (self nonEmpty at: index).
	! !

!TPutTest methodsFor: 'requirements' stamp: 'delaunay 4/28/2009 11:06'!
valueArray
" return a collection (with the same size than 'indexArray' )of values to be put in 'nonEmpty'  at indexes in 'indexArray' "
	| result |
	result := Array new: self indexArray size.
	1 to: result size do:
		[:i |
		result at:i put: (self aValue ).
		].
	^ result.! !

!TPutTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:53'!
test0FixturePutOneOrMoreElementsTest
	self aValue.

	
	self indexArray.
	self indexArray do: [
		:each| 
		self assert: each class = SmallInteger. 
		self assert: (each>=1 & each<= self nonEmpty size).
		].
	
	self assert: self indexArray size = self valueArray size.
	
	self empty.
	self assert: self empty isEmpty .
	
	self nonEmpty.
	self deny: self nonEmpty  isEmpty.! !

!TRBProgramNodeVisitor commentStamp: '<historical>'!
A TRBProgramNodeVisitor is a simple  that define visitor methods. !
!TRBProgramNodeVisitor methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:20'!
visitSuperNode: aSuperNode
	^ self visitVariableNode: aSuperNode! !

!TRBProgramNodeVisitor methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:20'!
visitThisContextNode: aThisContextNode
	^ self visitVariableNode: aThisContextNode! !

!TRBProgramNodeVisitor methodsFor: 'visiting' stamp: 'ClementBera 4/12/2013 15:59'!
visitArgumentNodes: aNodeCollection 
	"Sent *once* when visiting method and block nodes"
	^aNodeCollection do: [ :each | self visitArgumentNode: each ]! !

!TRBProgramNodeVisitor methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:18'!
visitCascadeNode: aCascadeNode 
	aCascadeNode messages do: [:each | self visitNode: each]! !

!TRBProgramNodeVisitor methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:19'!
visitMessageNode: aMessageNode 
	(aMessageNode isCascaded not or: [aMessageNode isFirstCascaded]) 
		ifTrue: [self visitNode: aMessageNode receiver].
	aMessageNode arguments do: [:each | self visitNode: each]! !

!TRBProgramNodeVisitor methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 16:20'!
visitMethodNode: aMethodNode 
	self visitArgumentNodes: aMethodNode arguments.
	aMethodNode pragmas
		do: [ :each | self visitNode: each ].
	self visitNode: aMethodNode body! !

!TRBProgramNodeVisitor methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:16'!
visitArrayNode: anArrayNode 

	anArrayNode children do: [:each | self visitNode: each]! !

!TRBProgramNodeVisitor methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 16:20'!
visitPatternBlockNode: aRBPatternBlockNode 
	self visitArgumentNodes: aRBPatternBlockNode arguments.
	self visitNode: aRBPatternBlockNode body! !

!TRBProgramNodeVisitor methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 16:20'!
visitBlockNode: aBlockNode 
	self visitArgumentNodes: aBlockNode arguments.
	self visitNode: aBlockNode body! !

!TRBProgramNodeVisitor methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:25'!
visitSelfNode: aSelfNode
	^ self visitVariableNode: aSelfNode! !

!TRBProgramNodeVisitor methodsFor: 'visiting' stamp: 'ClementBera 6/4/2013 14:55'!
visitTemporaryNode: aNode 
	"Sent *each time* a temporary node is found"
	^ self visitVariableNode: aNode! !

!TRBProgramNodeVisitor methodsFor: 'visiting' stamp: 'ClementBera 4/12/2013 16:27'!
visitVariableNode: aVariableNode
	^ aVariableNode! !

!TRBProgramNodeVisitor methodsFor: 'visiting' stamp: 'ClementBera 6/4/2013 14:53'!
visitTemporaryNodes: aNodeCollection 
	"This is triggered when defining the temporaries between the pipes"
	^self visitArgumentNodes: aNodeCollection! !

!TRBProgramNodeVisitor methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:19'!
visitParseErrorNode: anErrorNode! !

!TRBProgramNodeVisitor methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 16:21'!
visitSequenceNode: aSequenceNode 
	self visitTemporaryNodes: aSequenceNode temporaries.
	aSequenceNode statements do: [:each | self visitNode: each]! !

!TRBProgramNodeVisitor methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:18'!
visitLiteralArrayNode: aRBLiteralArrayNode 
	aRBLiteralArrayNode contents do: [:each | self visitNode: each]! !

!TRBProgramNodeVisitor methodsFor: 'visiting' stamp: 'CamilloBruni 10/31/2012 19:14'!
visitNode: aNode 
	^aNode acceptVisitor: self! !

!TRBProgramNodeVisitor methodsFor: 'visiting' stamp: 'ClementBera 4/12/2013 16:00'!
visitArgumentNode: anArgumentNode
	"Sent *each time* an argument node is found"
	^ self visitVariableNode: anArgumentNode! !

!TRBProgramNodeVisitor methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:18'!
visitAssignmentNode: anAssignmentNode

	self visitNode: anAssignmentNode variable.
	self visitNode: anAssignmentNode value! !

!TRBProgramNodeVisitor methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 16:20'!
visitPatternWrapperBlockNode: aRBPatternWrapperBlockNode 
	self visitNode: aRBPatternWrapperBlockNode wrappedNode.
	self visitArgumentNodes: aRBPatternWrapperBlockNode arguments.
	self visitNode: aRBPatternWrapperBlockNode body! !

!TRBProgramNodeVisitor methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:19'!
visitLiteralNode: aLiteralNode! !

!TRBProgramNodeVisitor methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:25'!
visitReturnNode: aReturnNode 
	^ self visitNode: aReturnNode value! !

!TRBProgramNodeVisitor methodsFor: 'visiting' stamp: 'StephaneDucasse 3/29/2013 15:19'!
visitPragmaNode: aPragmaNode
	aPragmaNode arguments do: [ :each | self visitNode: each ]! !

!TRemoveByIndexTest commentStamp: 'TorstenBergmann 2/20/2014 15:35'!
A trait for test purposes!
!TRemoveByIndexTest methodsFor: 'tests - removing by index' stamp: 'delaunay 4/22/2009 10:40'!
testRemoveFirstNotPresent

self should: [self empty removeFirst] raise: Error.! !

!TRemoveByIndexTest methodsFor: 'tests - removing by index' stamp: 'delaunay 4/22/2009 10:41'!
testRemoveLastNElementsNElements

self should: [self empty removeLast: 2] raise: Error.! !

!TRemoveByIndexTest methodsFor: 'tests - removing by index' stamp: 'delaunay 4/22/2009 10:37'!
testRemoveLastNElements

| collection  result oldSize elements |
collection := self collectionWith5Elements .
elements := {  (collection at: (4)). collection last. }.
oldSize := collection size.


result := (collection removeLast: 2).
self assert: result = elements.
self assert: collection size = (oldSize - 2).! !

!TRemoveByIndexTest methodsFor: 'tests - removing by index' stamp: 'delaunay 4/22/2009 10:40'!
testRemoveFirstNElementsNotPresent

self should: [self empty removeFirst: 2] raise: Error.! !

!TRemoveByIndexTest methodsFor: 'requirements' stamp: 'delaunay 4/22/2009 10:37'!
empty
" return an empty collection"
self explicitRequirement! !

!TRemoveByIndexTest methodsFor: 'tests - removing by index' stamp: 'delaunay 4/22/2009 10:40'!
testRemoveLastNotPresent

self should: [self empty removeLast] raise: Error.! !

!TRemoveByIndexTest methodsFor: 'tests - removing by index' stamp: 'delaunay 4/22/2009 10:38'!
testRemoveAtNotPresent

| |
self should: [self empty removeAt: 2] raise: Error.! !

!TRemoveByIndexTest methodsFor: 'tests - removing by index' stamp: 'delaunay 4/22/2009 10:24'!
testRemoveLast

| collection element result oldSize |
collection := self collectionWith5Elements .
element := collection last.
oldSize := collection size.

result := collection removeLast.
self assert: result = element .
self assert: collection size = (oldSize - 1).! !

!TRemoveByIndexTest methodsFor: 'tests - removing by index' stamp: 'delaunay 4/22/2009 10:24'!
testRemoveFirst

| collection element result oldSize |
collection := self collectionWith5Elements .
element := collection first.
oldSize := collection size.

result := collection removeFirst.
self assert: result = element .
self assert: collection size = (oldSize - 1).! !

!TRemoveByIndexTest methodsFor: 'tests - removing by index' stamp: 'delaunay 4/22/2009 10:24'!
testRemoveFirstNElements

| collection elements result oldSize |
collection := self collectionWith5Elements .
elements := {collection first. collection at:2}.
oldSize := collection size.

result := collection removeFirst: 2.
self assert: result = elements .
self assert: collection size = (oldSize - 2).! !

!TRemoveByIndexTest methodsFor: 'requirements' stamp: 'delaunay 4/22/2009 10:07'!
collectionWith5Elements
" return a collection of size 5 including 5 elements"
self explicitRequirement! !

!TRemoveByIndexTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureRemoveByIndexTest
	self collectionWith5Elements.
	self assert: self collectionWith5Elements size = 5! !

!TRemoveByIndexTest methodsFor: 'tests - removing by index' stamp: 'delaunay 4/22/2009 10:24'!
testRemoveAt

| collection element result oldSize |
collection := self collectionWith5Elements .
element := collection at: 3.
oldSize := collection size.

result := collection removeAt: 3.
self assert: result = element .
self assert: collection size = (oldSize - 1).! !

!TRemoveForMultiplenessTest commentStamp: 'TorstenBergmann 2/20/2014 15:35'!
A trait for test purposes!
!TRemoveForMultiplenessTest methodsFor: 'tests - remove' stamp: ''!
testRemoveAllFoundIn
	"self debug: #testRemoveElementThatExists"
	| el aSubCollection res |
	el := self nonEmptyWithoutEqualElements anyOne.
	aSubCollection := (self nonEmptyWithoutEqualElements copyWithout: el) copyWith: self elementNotIn.
	res := self nonEmptyWithoutEqualElements removeAllFoundIn: aSubCollection.
	self assert: self nonEmptyWithoutEqualElements size = 1.
	self nonEmptyWithoutEqualElements do: [ :each | self assert: each = el ]! !

!TRemoveForMultiplenessTest methodsFor: 'tests - remove' stamp: ''!
testRemoveElementThatExists
	"self debug: #testRemoveElementThatExists"

	| el res |
	el := self nonEmptyWithoutEqualElements anyOne.
	res := self nonEmptyWithoutEqualElements remove: el.
	self assert: res == el! !

!TRemoveForMultiplenessTest methodsFor: 'test - remove' stamp: 'adrian_lienhard 2/21/2009 13:46'!
elementTwiceIn
	^ self explicitRequirement! !

!TRemoveForMultiplenessTest methodsFor: 'tests - remove' stamp: ''!
testRemoveAllSuchThat
	"self debug: #testRemoveElementThatExists"
	| el aSubCollection |
	el := self nonEmptyWithoutEqualElements anyOne.
	aSubCollection := self nonEmptyWithoutEqualElements copyWithout: el.
	self nonEmptyWithoutEqualElements removeAllSuchThat: [ :each | aSubCollection includes: each ].
	self assert: self nonEmptyWithoutEqualElements size = 1.
	self nonEmptyWithoutEqualElements do: [ :each | self assert: each = el ]! !

!TRemoveForMultiplenessTest methodsFor: 'tests - remove' stamp: ''!
testRemoveElementReallyRemovesElement
	"self debug: #testRemoveElementReallyRemovesElement"
	| size |
	size := self nonEmptyWithoutEqualElements size.
	self nonEmptyWithoutEqualElements remove: self nonEmptyWithoutEqualElements anyOne.
	self assert: size - 1 = self nonEmptyWithoutEqualElements size! !

!TRemoveForMultiplenessTest methodsFor: 'test - remove' stamp: 'adrian_lienhard 2/21/2009 13:46'!
testRemoveElementThatExistsTwice
	"self debug: #testRemoveElementThatDoesExistsTwice"

	| size |
	size := self nonEmpty size.
	self assert: (self nonEmpty includes: self elementTwiceIn).
	self nonEmpty remove: self elementTwiceIn.
	self assert: size - 1 = self nonEmpty size.
	
	self assert: (self nonEmpty includes: self elementTwiceIn).
	self nonEmpty remove: self elementTwiceIn.
	self assert: size - 2 = self nonEmpty size! !

!TRemoveForMultiplenessTest methodsFor: 'tests - fixture' stamp: ''!
test0FixtureTRemoveTest
	| duplicate |
	self empty.
	self nonEmptyWithoutEqualElements.
	self deny: self nonEmptyWithoutEqualElements isEmpty.
	duplicate := true.
	self nonEmptyWithoutEqualElements
		detect: [ :each | (self nonEmptyWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ duplicate := false ].
	self assert: duplicate = false.
	self elementNotIn.
	self assert: self empty isEmpty.
	self deny: self nonEmptyWithoutEqualElements isEmpty.
	self deny: (self nonEmptyWithoutEqualElements includes: self elementNotIn)! !

!TRemoveForMultiplenessTest methodsFor: 'requirements' stamp: ''!
elementNotIn
" return an element not included in nonEmptyWithoutEqualElements"
	self explicitRequirement! !

!TRemoveForMultiplenessTest methodsFor: 'requirements' stamp: ''!
nonEmptyWithoutEqualElements
" return a collection without equal elements "
	self explicitRequirement! !

!TRemoveForMultiplenessTest methodsFor: 'requirements' stamp: ''!
empty
	self explicitRequirement! !

!TRemoveForMultiplenessTest methodsFor: 'tests - remove' stamp: ''!
testRemoveAll
	"self debug: #testRemoveElementThatExists"
	| el aSubCollection collection res |
	collection := self nonEmptyWithoutEqualElements.
	el := collection anyOne.
	aSubCollection := collection copyWithout: el.
	res := collection removeAll: aSubCollection.
	self assert: collection size = 1.
	self nonEmptyWithoutEqualElements do: [ :each | self assert: each = el ]! !

!TRemoveForMultiplenessTest methodsFor: 'tests - remove' stamp: ''!
testRemoveIfAbsent
	"self debug: #testRemoveElementThatExists"

	| el res |
	el := self elementNotIn.
	res := self nonEmptyWithoutEqualElements remove: el ifAbsent: [ 33 ].
	self assert: res = 33! !

!TRemoveForMultiplenessTest methodsFor: 'tests - remove' stamp: ''!
testRemoveElementFromEmpty
	"self debug: #testRemoveElementFromEmpty"
	self 
		should: [ self empty remove: self nonEmptyWithoutEqualElements anyOne ]
		raise: Error! !

!TRemoveForMultiplenessTest methodsFor: 'tests - remove' stamp: ''!
testRemoveAllError
	"self debug: #testRemoveElementThatExists"
	| el aSubCollection |
	el := self elementNotIn.
	aSubCollection := self nonEmptyWithoutEqualElements copyWith: el.
	self 
		should: [ | res | res := self nonEmptyWithoutEqualElements removeAll: aSubCollection ]
		raise: Error! !

!TRemoveTest commentStamp: 'TorstenBergmann 2/20/2014 15:35'!
A trait for test purposes!
!TRemoveTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 10:52'!
nonEmptyWithoutEqualElements
" return a collection without equal elements "
	self explicitRequirement! !

!TRemoveTest methodsFor: 'tests - remove' stamp: 'CamilloBruni 8/31/2013 20:45'!
testRemoveAllFoundIn
	"self debug: #testRemoveElementThatExists"
	| el aSubCollection res |
	el := self nonEmptyWithoutEqualElements anyOne.
	aSubCollection := (self nonEmptyWithoutEqualElements copyWithout: el) copyWith: self elementNotIn.
	res := self nonEmptyWithoutEqualElements removeAllFoundIn: aSubCollection.
	self assert: self nonEmptyWithoutEqualElements size = 1.
	self nonEmptyWithoutEqualElements do: [ :each | self assert: each = el ]! !

!TRemoveTest methodsFor: 'tests - remove' stamp: 'CamilloBruni 8/31/2013 20:43'!
testRemoveElementThatExists
	"self debug: #testRemoveElementThatExists"

	| el res |
	el := self nonEmptyWithoutEqualElements anyOne.
	res := self nonEmptyWithoutEqualElements remove: el.
	self assert: res == el! !

!TRemoveTest methodsFor: 'requirements' stamp: 'stephane.ducasse 11/29/2008 14:32'!
empty
	self explicitRequirement! !

!TRemoveTest methodsFor: 'tests - remove' stamp: 'CamilloBruni 11/2/2012 15:41'!
testRemoveAllSuchThat
	"self debug: #testRemoveElementThatExists"
	| el aSubCollection |
	el := self nonEmptyWithoutEqualElements anyOne.
	aSubCollection := self nonEmptyWithoutEqualElements copyWithout: el.
	self nonEmptyWithoutEqualElements removeAllSuchThat: [ :each | aSubCollection includes: each ].
	self assert: self nonEmptyWithoutEqualElements size = 1.
	self nonEmptyWithoutEqualElements do: [ :each | self assert: each = el ]! !

!TRemoveTest methodsFor: 'tests - remove' stamp: 'CamilloBruni 8/31/2013 20:45'!
testRemoveAll
	"self debug: #testRemoveElementThatExists"
	| el aSubCollection collection res |
	collection := self nonEmptyWithoutEqualElements.
	el := collection anyOne.
	aSubCollection := collection copyWithout: el.
	res := collection removeAll: aSubCollection.
	self assert: collection size = 1.
	self nonEmptyWithoutEqualElements do: [ :each | self assert: each = el ]! !

!TRemoveTest methodsFor: 'tests - remove' stamp: 'delaunay 5/11/2009 10:52'!
testRemoveElementReallyRemovesElement
	"self debug: #testRemoveElementReallyRemovesElement"
	| size |
	size := self nonEmptyWithoutEqualElements size.
	self nonEmptyWithoutEqualElements remove: self nonEmptyWithoutEqualElements anyOne.
	self assert: size - 1 = self nonEmptyWithoutEqualElements size! !

!TRemoveTest methodsFor: 'tests - remove' stamp: 'CamilloBruni 8/31/2013 20:43'!
testRemoveIfAbsent
	"self debug: #testRemoveElementThatExists"

	| el res |
	el := self elementNotIn.
	res := self nonEmptyWithoutEqualElements remove: el ifAbsent: [ 33 ].
	self assert: res = 33! !

!TRemoveTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureTRemoveTest
	| duplicate |
	self empty.
	self nonEmptyWithoutEqualElements.
	self deny: self nonEmptyWithoutEqualElements isEmpty.
	duplicate := true.
	self nonEmptyWithoutEqualElements
		detect: [ :each | (self nonEmptyWithoutEqualElements occurrencesOf: each) > 1 ]
		ifNone: [ duplicate := false ].
	self assert: duplicate = false.
	self elementNotIn.
	self assert: self empty isEmpty.
	self deny: self nonEmptyWithoutEqualElements isEmpty.
	self deny: (self nonEmptyWithoutEqualElements includes: self elementNotIn)! !

!TRemoveTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 10:53'!
elementNotIn
" return an element not included in nonEmptyWithoutEqualElements"
	self explicitRequirement! !

!TRemoveTest methodsFor: 'tests - remove' stamp: 'delaunay 5/11/2009 10:52'!
testRemoveElementFromEmpty
	"self debug: #testRemoveElementFromEmpty"
	self 
		should: [ self empty remove: self nonEmptyWithoutEqualElements anyOne ]
		raise: Error! !

!TRemoveTest methodsFor: 'tests - remove' stamp: 'CamilloBruni 11/2/2012 16:13'!
testRemoveAllError
	"self debug: #testRemoveElementThatExists"
	| el aSubCollection |
	el := self elementNotIn.
	aSubCollection := self nonEmptyWithoutEqualElements copyWith: el.
	self 
		should: [ | res | res := self nonEmptyWithoutEqualElements removeAll: aSubCollection ]
		raise: Error! !

!TReplacementSequencedTest commentStamp: 'TorstenBergmann 2/20/2014 15:35'!
A trait for test purposes!
!TReplacementSequencedTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:53'!
testOFixtureReplacementSequencedTest

	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	
	self elementInForReplacement.
	self assert: (self nonEmpty includes: self elementInForReplacement ) .
	
	self newElement.
	
	self firstIndex.
	self assert: (self firstIndex >= 1 & self firstIndex <= self nonEmpty size).
	
	self secondIndex.
	self assert: (self secondIndex >= 1 & self secondIndex <= self nonEmpty size).
	
	self assert: self firstIndex <=self secondIndex .
	
	self replacementCollection.
	
	self replacementCollectionSameSize.
	self assert: (self secondIndex  - self firstIndex +1)= self replacementCollectionSameSize size
	! !

!TReplacementSequencedTest methodsFor: 'requirements' stamp: 'delaunay 4/6/2009 09:49'!
nonEmpty
	^self explicitRequirement! !

!TReplacementSequencedTest methodsFor: 'tests - replacing' stamp: 'HenrikSperreJohansen 10/18/2009 19:38'!
testReplaceAllWith
	| result  collection oldElement newElement oldOccurrences |
	collection := self nonEmpty .
	result := collection  copy.
	oldElement := self elementInForReplacement .
	newElement := self newElement .
	oldOccurrences := (result occurrencesOf: oldElement) + (result occurrencesOf: newElement).
	result replaceAll: oldElement  with: newElement  .
	
	self assert: oldOccurrences = (result occurrencesOf: newElement)! !

!TReplacementSequencedTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 16:19'!
replacementCollection
" return a collection that will be put into 'nonEmpty' "
	^ self replacementCollectionSameSize, self 	replacementCollectionSameSize   ! !

!TReplacementSequencedTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 15:39'!
replacementCollectionSameSize
" return a collection of size (secondIndex - firstIndex + 1)"
	^self explicitRequirement! !

!TReplacementSequencedTest methodsFor: 'tests - replacing' stamp: 'Alexandre Bergel 5/22/2010 12:21'!
testReplaceFromToWith
	| result  collection replacementCollec firstInd secondInd |
	collection := self nonEmpty .
	replacementCollec := self replacementCollectionSameSize .
	firstInd := self firstIndex .
	secondInd := self secondIndex .
	result := collection  copy.
	result replaceFrom: firstInd  to: secondInd  with: replacementCollec .
	
	"verify content of 'result' : "
	"first part of 'result'' : '"
	
	1 to: ( firstInd - 1 ) do: [ :i | self assert: (collection  at:i ) = ( result at: i ) ].
	
	" middle part containing replacementCollection : "
	
	( firstInd ) to: ( firstInd  + replacementCollec size - 1 ) do: 
		[ :i |
		self assert: ( result at: i ) = ( replacementCollec  at: ( i - firstInd  +1 ) ) 
		].
	
	" end part :"
	( firstInd  + replacementCollec   size) to: (result size) do:
		[:i|
		self assert: ( result at: i ) = ( collection at: ( secondInd  + 1 - ( firstInd + replacementCollec size ) + i ) ) ].
	
	! !

!TReplacementSequencedTest methodsFor: 'tests - replacing' stamp: 'Alexandre Bergel 5/22/2010 12:17'!
testReplaceFromToWithStartingAt
	| result  repStart collection replacementCollec firstInd secondInd |
	collection := self nonEmpty .
	result := collection copy.
	replacementCollec := self replacementCollectionSameSize .
	firstInd := self firstIndex .
	secondInd := self secondIndex .
	repStart := replacementCollec  size - ( secondInd  - firstInd   + 1 ) + 1.
	result replaceFrom: firstInd  to: secondInd with: replacementCollec  startingAt: repStart   .
	
	"verify content of 'result' : "
	"first part of 'result'' : '" 
	
	1 to: ( firstInd  - 1 ) do: [ :i | self assert: ( collection  at:i ) = ( result at: i ) ].
	
	" middle part containing replacementCollection : "
	
	( firstInd ) to: ( replacementCollec   size - repStart +1 ) do: 
		[:i|
		self assert: (result at: i)=( replacementCollec   at: ( repStart  + ( i  - firstInd  ) ) ) ].
	
	" end part :"
	( firstInd  + replacementCollec   size ) to: ( result size ) do:
		[ :i |
		self assert: ( result at: i ) = ( collection  at: ( secondInd  + 1 - ( firstInd  + replacementCollec   size ) + i ) ) ].! !

!TReplacementSequencedTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 16:27'!
secondIndex
" return an index between 'nonEmpty' bounds that is > to 'first index' "
	^self explicitRequirement! !

!TReplacementSequencedTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 15:35'!
elementInForReplacement
" return an element included in 'nonEmpty' "
^ self nonEmpty anyOne.! !

!TReplacementSequencedTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 15:36'!
newElement
"return an element that will be put in the collection in place of another"
	self explicitRequirement! !

!TReplacementSequencedTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 15:38'!
firstIndex
" return an index between 'nonEmpty' bounds that is < to 'second index' "
	^self explicitRequirement! !

!TSequencedConcatenationTest commentStamp: 'TorstenBergmann 2/20/2014 15:35'!
A trait for test purposes!
!TSequencedConcatenationTest methodsFor: 'requirements' stamp: 'delaunay 4/2/2009 16:27'!
empty
	self explicitRequirement! !

!TSequencedConcatenationTest methodsFor: 'tests - streaming' stamp: 'CamilloBruni 9/23/2012 23:11'!
testStreamContentsProtocol
	| result index |
	result:= self collectionClass << [ :s|
		s 
			nextPutAll: self firstCollection;
			nextPutAll: self secondCollection ].
	self assert: result equals: self firstCollection, self secondCollection.! !

!TSequencedConcatenationTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 15:11'!
secondCollection
" return a collection that will be the second part of the concatenation"
	self explicitRequirement! !

!TSequencedConcatenationTest methodsFor: 'tests - streaming' stamp: 'CamilloBruni 9/23/2012 23:09'!
testStreamContents
	| result index |
	result:= self collectionClass streamContents: [ :s|
		s 
			nextPutAll: self firstCollection;
			nextPutAll: self secondCollection ].
	self assert: result equals: self firstCollection, self secondCollection.! !

!TSequencedConcatenationTest methodsFor: 'tests - concatenation' stamp: 'delaunay 4/2/2009 16:48'!
testConcatenationWithEmpty
	| result |
	result:= self empty,self secondCollection .
	
	1 to: self secondCollection size do:
		[:i | 
		self assert: (self secondCollection at:i)= (result at:i).
		].
	"size : "
	self assert: result size = ( self secondCollection size).! !

!TSequencedConcatenationTest methodsFor: 'tests - concatenation' stamp: 'delaunay 4/2/2009 16:42'!
testConcatenation
	| result index |
	result:= self firstCollection,self secondCollection .
	"first part : "
	index := 1.
	self firstCollection do: 
		[:each | 
		self assert: (self firstCollection at: index)=each.
		index := index+1.].
	"second part : "
	1 to: self secondCollection size do:
		[:i | 
		self assert: (self secondCollection at:i)= (result at:index).
		index:=index+1].
	"size : "
	self assert: result size = (self firstCollection size + self secondCollection size).! !

!TSequencedConcatenationTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:53'!
test0FixtureSequencedConcatenationTest
	self empty.
	self assert: self empty isEmpty.
	self firstCollection.
	self secondCollection! !

!TSequencedConcatenationTest methodsFor: 'requirements' stamp: 'delaunay 4/20/2009 15:11'!
firstCollection
" return a collection that will be the first part of the concatenation"
	self explicitRequirement! !

!TSequencedConcatenationTest methodsFor: 'tests - streaming' stamp: 'DamienCassou 9/26/2014 14:32'!
testNewStreamContentsReturnsCollectionOfCorrectSize
	| result item originalSize |
	originalSize := 10.
	item := self firstCollection first.
	result := self collectionClass
		new: originalSize
		streamContents: [ :stream | 
			1 to: originalSize + 1 do: [ :each | stream nextPut: item ].
			stream position: originalSize ].
	self assert: result size equals: originalSize! !

!TSequencedConcatenationTest methodsFor: 'tests - streaming' stamp: 'CamilloBruni 9/23/2012 23:10'!
testStreamContentsSized
	| result |
	result:= self collectionClass new: 1 streamContents: [ :s|
		s 
			nextPutAll: self firstCollection;
			nextPutAll: self secondCollection ].
	self assert: result equals: self firstCollection, self secondCollection.
	
	result:= self collectionClass new: 1000 streamContents: [ :s|
		s 
			nextPutAll: self firstCollection;
			nextPutAll: self secondCollection ].
	self assert: result equals: self firstCollection, self secondCollection.! !

!TSequencedElementAccessTest commentStamp: 'TorstenBergmann 2/20/2014 15:35'!
A trait for test purposes!
!TSequencedElementAccessTest methodsFor: 'tests - element accessing' stamp: 'delaunay 4/14/2009 13:46'!
testAtRandom
	| result |
	result := self nonEmpty atRandom .
	self assert: (self nonEmpty includes: result).! !

!TSequencedElementAccessTest methodsFor: 'tests - element accessing' stamp: 'delaunay 4/27/2009 10:38'!
testAfter
	"self debug: #testAfter"
	self assert: (self moreThan4Elements after: (self moreThan4Elements at: 1)) = (self moreThan4Elements at: 2).
	self 
		should: 
			[ self moreThan4Elements after: (self moreThan4Elements at: self moreThan4Elements size) ]
		raise: Error.
	self 
		should: [ self moreThan4Elements after: self elementNotInForElementAccessing ]
		raise: Error! !

!TSequencedElementAccessTest methodsFor: 'tests - element accessing' stamp: 'delaunay 4/27/2009 10:38'!
testAtPin
	"self debug: #testAtPin"
	self assert: (self moreThan4Elements atPin: 2) = self moreThan4Elements second.
	self assert: (self moreThan4Elements atPin: 99) = self moreThan4Elements last.
	self assert: (self moreThan4Elements atPin: -99) = self moreThan4Elements first! !

!TSequencedElementAccessTest methodsFor: 'tests - element accessing' stamp: 'delaunay 4/27/2009 10:37'!
testAtAll
	"self debug: #testAtAll"
	"	self flag: #theCollectionshouldbe102030intheFixture.
	
	self assert: (self accessCollection atAll: #(2 1)) first = self accessCollection second.
	self assert: (self accessCollection atAll: #(2)) first = self accessCollection second."
	| result |
	result := self moreThan4Elements atAll: #(2 1 2 ).
	self assert: (result at: 1) = (self moreThan4Elements at: 2).
	self assert: (result at: 2) = (self moreThan4Elements at: 1).
	self assert: (result at: 3) = (self moreThan4Elements at: 2).
	self assert: (self moreThan4Elements atAll: #()) = self moreThan4Elements species new! !

!TSequencedElementAccessTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 10:38'!
moreThan4Elements

" return a collection including at leat 4 elements"
	self explicitRequirement! !

!TSequencedElementAccessTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 10:40'!
elementInForElementAccessing
" return an element inculded in 'moreThan4Elements'"
	self explicitRequirement! !

!TSequencedElementAccessTest methodsFor: 'tests - element accessing' stamp: 'delaunay 4/27/2009 10:37'!
testAtLastError
	"self debug: #testAtLast"
	self 
		should: [ self moreThan4Elements atLast: self moreThan4Elements size + 1 ]
		raise: Error! !

!TSequencedElementAccessTest methodsFor: 'tests - element accessing' stamp: 'delaunay 4/27/2009 10:37'!
testAtLastIfAbsent
	"self debug: #testAtLastIfAbsent"
	self assert: (self moreThan4Elements 
			atLast: 1
			ifAbsent: [ nil ]) = self moreThan4Elements last.
	self assert: (self moreThan4Elements 
			atLast: self moreThan4Elements size + 1
			ifAbsent: [ 222 ]) = 222! !

!TSequencedElementAccessTest methodsFor: 'tests - element accessing' stamp: 'delaunay 4/27/2009 10:38'!
testAt
	"self debug: #testAt"
	"
	self assert: (self accessCollection at: 1) = 1.
	self assert: (self accessCollection at: 2) = 2.
	"
	| index |
	index := self moreThan4Elements indexOf: self elementInForElementAccessing.
	self assert: (self moreThan4Elements at: index) = self elementInForElementAccessing! !

!TSequencedElementAccessTest methodsFor: 'tests - element accessing' stamp: 'delaunay 4/27/2009 10:37'!
testAtIfAbsent
	"self debug: #testAt"
	| absent |
	absent := false.
	self moreThan4Elements 
		at: self moreThan4Elements size + 1
		ifAbsent: [ absent := true ].
	self assert: absent = true.
	absent := false.
	self moreThan4Elements 
		at: self moreThan4Elements size
		ifAbsent: [ absent := true ].
	self assert: absent = false! !

!TSequencedElementAccessTest methodsFor: 'tests - element accessing' stamp: 'delaunay 4/27/2009 10:38'!
testAtOutOfBounds
	"self debug: #testAtOutOfBounds"
	self 
		should: [ self moreThan4Elements at: self moreThan4Elements size + 1 ]
		raise: Error.
	self 
		should: [ self moreThan4Elements at: -1 ]
		raise: Error! !

!TSequencedElementAccessTest methodsFor: 'tests - element accessing' stamp: 'delaunay 4/27/2009 10:37'!
testFirstSecondThird
	"self debug: #testFirstSecondThird"
	self assert: self moreThan4Elements first = (self moreThan4Elements at: 1).
	self assert: self moreThan4Elements second = (self moreThan4Elements at: 2).
	self assert: self moreThan4Elements third = (self moreThan4Elements at: 3).
	self assert: self moreThan4Elements fourth = (self moreThan4Elements at: 4)! !

!TSequencedElementAccessTest methodsFor: 'tests - element accessing' stamp: 'delaunay 4/27/2009 10:38'!
testMiddle
	"self debug: #testMiddle"
	self assert: self moreThan4Elements middle = (self moreThan4Elements at: self moreThan4Elements size // 2 + 1)! !

!TSequencedElementAccessTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 10:40'!
elementNotInForElementAccessing
" return an element not included in 'moreThan4Elements' "
	self explicitRequirement! !

!TSequencedElementAccessTest methodsFor: 'tests - element accessing' stamp: 'delaunay 4/27/2009 10:37'!
testAtLast
	"self debug: #testAtLast"
	| index |
	self assert: (self moreThan4Elements atLast: 1) = self moreThan4Elements last.
	"tmp:=1.
	self do:
		[:each | 
		each =self elementInForIndexAccessing 
			ifTrue:[index:=tmp].
		tmp:=tmp+1]."
	index := self moreThan4Elements indexOf: self elementInForElementAccessing.
	self assert: (self moreThan4Elements atLast: index) = (self moreThan4Elements at: self moreThan4Elements size - index + 1)! !

!TSequencedElementAccessTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureSequencedElementAccessTest
	self moreThan4Elements.
	self assert: self moreThan4Elements size >= 4.
	self subCollectionNotIn.
	self subCollectionNotIn detect: [ :each | (self moreThan4Elements includes: each) not ] ifNone: [ self assert: false ].
	self elementNotInForElementAccessing.
	self deny: (self moreThan4Elements includes: self elementNotInForElementAccessing).
	self elementInForElementAccessing.
	self assert: (self moreThan4Elements includes: self elementInForElementAccessing)! !

!TSequencedElementAccessTest methodsFor: 'tests - element accessing' stamp: 'StephaneDucasse 5/28/2011 13:22'!
testAfterIfAbsent
	"self debug: #testAfterIfAbsent"
	self assert: (self moreThan4Elements 
			after: (self moreThan4Elements at: 1)
			ifAbsent: [ 33 ]) = (self moreThan4Elements at: 2).
	self assert: (self moreThan4Elements 
			after: (self moreThan4Elements at: self moreThan4Elements size)
			ifAbsent: [ 33 ]) = 33.
	self assert: (self moreThan4Elements 
			after: self elementNotInForElementAccessing
			ifAbsent: [ 33 ]) = 33! !

!TSequencedElementAccessTest methodsFor: 'tests - element accessing' stamp: 'delaunay 4/27/2009 10:38'!
testAtWrap
	"self debug: #testAt"
	"
	self assert: (self accessCollection at: 1) = 1.
	self assert: (self accessCollection at: 2) = 2.
	"
	| index |
	index := self moreThan4Elements indexOf: self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: index) = self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: index + self moreThan4Elements size) = self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: index - self moreThan4Elements size) = self elementInForElementAccessing.
	self assert: (self moreThan4Elements atWrap: 1 + self moreThan4Elements size) = (self moreThan4Elements at: 1)! !

!TSequencedElementAccessTest methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 10:40'!
subCollectionNotIn
" return a collection for which at least one element is not included in 'moreThan4Elements' "
	self explicitRequirement! !

!TSequencedElementAccessTest methodsFor: 'tests - element accessing' stamp: 'delaunay 4/27/2009 10:37'!
testBeforeIfAbsent
	"self debug: #testBefore"
	self assert: (self moreThan4Elements 
			before: (self moreThan4Elements at: 1)
			ifAbsent: [ 99 ]) = 99.
	self assert: (self moreThan4Elements 
			before: (self moreThan4Elements at: 2)
			ifAbsent: [ 99 ]) = (self moreThan4Elements at: 1)! !

!TSequencedElementAccessTest methodsFor: 'tests - element accessing' stamp: 'delaunay 4/27/2009 10:38'!
testLast
	"self debug: #testLast"
	self assert: self moreThan4Elements last = (self moreThan4Elements at: self moreThan4Elements size)! !

!TSequencedElementAccessTest methodsFor: 'tests - element accessing' stamp: 'delaunay 4/27/2009 10:38'!
testBefore
	"self debug: #testBefore"
	self assert: (self moreThan4Elements before: (self moreThan4Elements at: 2)) = (self moreThan4Elements at: 1).
	self 
		should: [ self moreThan4Elements before: (self moreThan4Elements at: 1) ]
		raise: Error.
	self 
		should: [ self moreThan4Elements before: 66 ]
		raise: Error! !

!TSequencedStructuralEqualityTest commentStamp: 'TorstenBergmann 2/20/2014 15:35'!
A trait for test purposes!
!TSequencedStructuralEqualityTest methodsFor: 'test - equality' stamp: ''!
testEqualSignOfIdenticalCollectionObjects
	"self debug: #testEqualSignOfIdenticalCollectionObjects"
	
	self assert: (self empty = self empty). 
	self assert: (self nonEmpty = self nonEmpty). 
	! !

!TSequencedStructuralEqualityTest methodsFor: 'test - equality' stamp: ''!
empty
	
	^ self explicitRequirement! !

!TSequencedStructuralEqualityTest methodsFor: 'tests - equality' stamp: 'damiencassou 1/20/2009 13:56'!
testHasEqualElementsOfIdenticalCollectionObjects
	"self debug: #testHasEqualElementsOfIdenticalCollectionObjects"
	
	self assert: (self empty hasEqualElements: self empty). 
	self assert: (self nonEmpty hasEqualElements: self nonEmpty). 
	! !

!TSequencedStructuralEqualityTest methodsFor: 'tests - equality' stamp: 'damiencassou 1/20/2009 14:01'!
testEqualSignForSequenceableCollections
	"self debug: #testEqualSign"

	self deny: (self nonEmpty = self nonEmpty asSet). 
	self deny: (self nonEmpty reversed = self nonEmpty).
	self deny: (self nonEmpty = self nonEmpty reversed).! !

!TSequencedStructuralEqualityTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0TSequencedStructuralEqualityTest
	self nonEmpty at: 1	"Ensures #nonEmpty is sequenceable"! !

!TSequencedStructuralEqualityTest methodsFor: 'tests - fixture' stamp: ''!
test0TStructuralEqualityTest
	self empty.
	self nonEmpty.
	self assert: self empty isEmpty.
	self deny: self nonEmpty isEmpty! !

!TSequencedStructuralEqualityTest methodsFor: 'test - equality' stamp: ''!
testEqualSignIsTrueForNonIdenticalButEqualCollections
	"self debug: #testEqualSignIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty = self empty copy). 
	self assert: (self empty copy = self empty).
	self assert: (self empty copy = self empty copy).
		
	self assert: (self nonEmpty = self nonEmpty copy). 
	self assert: (self nonEmpty copy = self nonEmpty).
	self assert: (self nonEmpty copy = self nonEmpty copy).! !

!TSequencedStructuralEqualityTest methodsFor: 'test - equality' stamp: 'HenrikSperreJohansen 10/18/2009 18:40'!
testEqualSignIsTrueForEmptyButNonIdenticalCollections
	"self debug: #testEqualSignIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty = self empty copy). 
	self assert: (self empty copy = self empty).
	self assert: (self empty copy = self empty copy).
		
! !

!TSequencedStructuralEqualityTest methodsFor: 'tests - equality' stamp: 'damiencassou 1/20/2009 13:56'!
testHasEqualElements
	"self debug: #testHasEqualElements"

	self deny: (self empty hasEqualElements: self nonEmpty).
	self deny: (self nonEmpty hasEqualElements: self nonEmpty asSet). 
	self deny: (self nonEmpty reversed hasEqualElements: self nonEmpty).
	self deny: (self nonEmpty hasEqualElements: self nonEmpty reversed).! !

!TSequencedStructuralEqualityTest methodsFor: 'test - equality' stamp: ''!
nonEmpty
	
	^ self explicitRequirement! !

!TSequencedStructuralEqualityTest methodsFor: 'tests - equality' stamp: 'damiencassou 1/20/2009 13:56'!
testHasEqualElementsIsTrueForNonIdenticalButEqualCollections
	"self debug: #testHasEqualElementsIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty hasEqualElements: self empty copy). 
	self assert: (self empty copy hasEqualElements: self empty).
	self assert: (self empty copy hasEqualElements: self empty copy).
		
	self assert: (self nonEmpty hasEqualElements: self nonEmpty copy). 
	self assert: (self nonEmpty copy hasEqualElements: self nonEmpty).
	self assert: (self nonEmpty copy hasEqualElements: self nonEmpty copy).! !

!TSequencedStructuralEqualityTest methodsFor: 'test - equality' stamp: ''!
testEqualSign
	"self debug: #testEqualSign"

	self deny: (self empty = self nonEmpty).! !

!TSetArithmetic commentStamp: 'TorstenBergmann 2/20/2014 15:35'!
A trait for test purposes!
!TSetArithmetic methodsFor: 'tests - set arithmetic' stamp: 'stephane.ducasse 11/21/2008 17:17'!
containsAll: union of: one andOf: another
			
	self assert: (one allSatisfy: [:each | union includes: each]).
	self assert: (another allSatisfy: [:each | union includes: each])! !

!TSetArithmetic methodsFor: 'tests - set arithmetic' stamp: 'CamilloBruni 3/23/2013 12:23'!
testDifferenceWithSeparateCollection
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifferenceWithSeparateCollection"
	| res separateCol |
	
	separateCol := self collectionClass with: self anotherElementOrAssociationNotIn.
	res := self collectionWithoutEqualElements difference: separateCol.
	
	self deny: (res includes: self anotherElementOrAssociationNotIn).
	self assert: res size equals: self collectionWithoutEqualElements size.
	
	self collectionWithoutEqualElements do: [ :each|
		self assert: (res includes: each)].
	
	res := separateCol difference: self collection.
	self deny: (res includes: self collection anyOne).
	self assert: res equals: separateCol! !

!TSetArithmetic methodsFor: 'tests - set arithmetic' stamp: 'delaunay 4/29/2009 11:52'!
numberOfSimilarElementsInIntersection
	^ self collection occurrencesOf: self anotherElementOrAssociationIn! !

!TSetArithmetic methodsFor: 'tests - set arithmetic' stamp: 'stephane.ducasse 11/21/2008 17:09'!
testUnionOfEmpties
	"self debug: #testUnionOfEmpties"
	
	self assert:  (self empty union: self empty) isEmpty.
	
	! !

!TSetArithmetic methodsFor: 'tests - set arithmetic' stamp: 'delaunay 4/29/2009 11:54'!
testDifferenceWithNonNullIntersection
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifferenceWithNonNullIntersection"
	"	#(1 2 3) difference: #(2 4) 
	->  #(1 3)"
	| res overlapping |
	overlapping := self collectionClass 
		with: self anotherElementOrAssociationNotIn
		with: self anotherElementOrAssociationIn.
	res := self collection difference: overlapping.
	self deny: (res includes: self anotherElementOrAssociationIn).
	overlapping do: [ :each | self deny: (res includes: each) ]! !

!TSetArithmetic methodsFor: 'requirements' stamp: 'delaunay 4/21/2009 16:25'!
collectionClass
" return the class to be used to create instances of the class tested"
	^ self explicitRequirement! !

!TSetArithmetic methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 11:54'!
anotherElementOrAssociationNotIn
	" return an element (or an association for Dictionary )not present  in 'collection' "
	^ self explicitRequirement! !

!TSetArithmetic methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureSetAritmeticTest
	self collection.
	self deny: self collection isEmpty.
	self nonEmpty.
	self deny: self nonEmpty isEmpty.
	self anotherElementOrAssociationNotIn.
	self collection isDictionary
		ifTrue: [ self deny: (self collection associations includes: self anotherElementOrAssociationNotIn key) ]
		ifFalse: [ self deny: (self collection includes: self anotherElementOrAssociationNotIn) ].
	self collectionClass! !

!TSetArithmetic methodsFor: 'tests - set arithmetic' stamp: 'stephane.ducasse 11/21/2008 17:26'!
testUnion
	"self debug: #testUnionOfEmpties"
	
	| union |
	union := self empty union: self nonEmpty.
	self containsAll: union of: self empty andOf: self nonEmpty.
	union := self nonEmpty union: self empty.
	self containsAll: union of: self empty andOf: self nonEmpty.
	union := self collection union: self nonEmpty.
	self containsAll: union of: self collection andOf: self nonEmpty.! !

!TSetArithmetic methodsFor: 'requirements' stamp: 'AlexandreBergel 1/19/2009 18:28'!
collection

	^ self explicitRequirement! !

!TSetArithmetic methodsFor: 'tests - set arithmetic' stamp: 'delaunay 4/29/2009 11:59'!
testIntersectionBasic
	"self debug: #testIntersectionBasic"
	| inter |
	inter := self collection intersection: (self collectionClass with: self anotherElementOrAssociationIn).
	self deny: inter isEmpty.
	self assert: (inter includes: self anotherElementOrAssociationIn value)! !

!TSetArithmetic methodsFor: 'tests - set arithmetic' stamp: 'CamilloBruni 9/9/2011 12:10'!
testDifference
	"Answer the set theoretic difference of two collections."
	"self debug: #testDifference"
	
	| difference |
	self assert: (self collectionWithoutEqualElements difference: self collectionWithoutEqualElements) isEmpty.
	self assert: (self empty difference: self collectionWithoutEqualElements) isEmpty.
	difference := (self collectionWithoutEqualElements difference: self empty).
	self assert: difference size = self collectionWithoutEqualElements	 size.
	self collectionWithoutEqualElements do: [ :each |
		self assert: (difference includes: each)].
! !

!TSetArithmetic methodsFor: 'requirements' stamp: 'delaunay 4/29/2009 11:52'!
anotherElementOrAssociationIn
	" return an element (or an association for Dictionary ) present  in 'collection' "
	^ self explicitRequirement! !

!TSetArithmetic methodsFor: 'requirements' stamp: 'AlexandreBergel 1/19/2009 18:28'!
nonEmpty

	^ self explicitRequirement! !

!TSetArithmetic methodsFor: 'tests - set arithmetic' stamp: 'delaunay 4/29/2009 11:44'!
testIntersectionEmpty
	"self debug: #testIntersectionEmpty"
	
	| inter |
	inter := self empty intersection: self empty.
	self assert: inter isEmpty. 
	inter := self empty intersection: self collection .
	self assert: inter =  self empty.
	! !

!TSetArithmetic methodsFor: 'tests - set arithmetic' stamp: 'CamilloBruni 9/9/2011 12:11'!
testIntersectionItself
	"self debug: #testIntersectionItself"
	
	| result |
	result :=  (self collectionWithoutEqualElements intersection: self collectionWithoutEqualElements).
	self assert: result size  = self collectionWithoutEqualElements size.
	self collectionWithoutEqualElements do: [ :each|
		self assert: (result includes: each) ].
	! !

!TSetArithmetic methodsFor: 'tests - set arithmetic' stamp: 'delaunay 4/29/2009 11:59'!
testIntersectionTwoSimilarElementsInIntersection
	"self debug: #testIntersectionBasic"
	| inter |
	inter := self collection intersection: (self collectionClass with: self anotherElementOrAssociationIn).
	self assert: (self collection occurrencesOf: self anotherElementOrAssociationIn) = self numberOfSimilarElementsInIntersection.
	self assert: (inter includes: self anotherElementOrAssociationIn value)! !

!TSizeTest commentStamp: 'TorstenBergmann 2/20/2014 15:35'!
A trait for test purposes!
!TSizeTest methodsFor: 'requirements' stamp: 'AlexandreBergel 1/19/2009 18:28'!
empty

	^ self explicitRequirement! !

!TSizeTest methodsFor: 'tests - size capacity' stamp: 'delaunay 5/14/2009 10:51'!
testSize

	| size |
	self assert: self empty size = 0.
	size := 0.
	self sizeCollection do: [ :each | size := size + 1].
	
	self assert: self sizeCollection size = size.! !

!TSizeTest methodsFor: 'requirements' stamp: 'delaunay 5/14/2009 10:50'!
sizeCollection
	"Answers a collection not empty"
	^ self explicitRequirement! !

!TSizeTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0TSizeTest
	self empty.
	self sizeCollection.
	self assert: self empty isEmpty.
	self deny: self sizeCollection isEmpty! !

!TSortTest commentStamp: 'TorstenBergmann 2/20/2014 15:35'!
A trait for test purposes!
!TSortTest methodsFor: 'tests - sorting' stamp: 'jannik.laval 5/2/2010 07:17'!
testIsSorted
	self assert: self sortedInAscendingOrderCollection isSorted.
	self deny: self unsortedCollection isSorted! !

!TSortTest methodsFor: 'as yet unclassified' stamp: 'DamienCassou 8/23/2013 10:27'!
testSorted
	| result tmp unsorted |
	unsorted := self unsortedCollection.
	result := unsorted sorted.
	self deny: unsorted == result.
	tmp := result at: 1.
	result
		do: [ :each | 
			self assert: each >= tmp.
			tmp := each ]! !

!TSortTest methodsFor: 'tests - sorting' stamp: 'delaunay 3/27/2009 15:22'!
testSortUsingSortBlock
	| result tmp |
	result := self unsortedCollection sort: [:a :b | a>b].
	tmp := result at: 1.
	result do:
		[:each | self assert: each<=tmp. tmp:= each. ].! !

!TSortTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 16:51'!
sortedInAscendingOrderCollection
" return a collection sorted in an acsending order"
	^self explicitRequirement
	! !

!TSortTest methodsFor: 'tests - sorting' stamp: 'delaunay 3/27/2009 14:43'!
testIsSortedBy
	self assert: (self sortedInAscendingOrderCollection isSortedBy: [:a :b | a<b]).
	self deny: (self sortedInAscendingOrderCollection isSortedBy: [:a :b | a>b]).
! !

!TSortTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0SortingArrayedTest
	| tmp sorted |
	" an unsorted collection of number "
	self unsortedCollection.
	self unsortedCollection do: [ :each | each isNumber ].
	sorted := true.
	self unsortedCollection
		pairsDo: [ :each1 :each2 | 
			each2 < each1
				ifTrue: [ sorted := false ] ].
	self assert: sorted = false.	" a collection of number sorted in an ascending order"
	self sortedInAscendingOrderCollection.
	self sortedInAscendingOrderCollection do: [ :each | each isNumber ].
	tmp := self sortedInAscendingOrderCollection at: 1.
	self sortedInAscendingOrderCollection
		do: [ :each | 
			self assert: each >= tmp.
			tmp := each ]! !

!TSortTest methodsFor: 'tests - sorting' stamp: 'HilaireFernandes 4/1/2010 09:31'!
testSortedUsingBlock
	| result tmp |
	result := self unsortedCollection sorted:  [:a :b | a>b]..
	tmp := result at: 1.
	result do:
		[:each | self assert: each<=tmp. tmp:= each. ].! !

!TSortTest methodsFor: 'tests - sorting' stamp: 'delaunay 3/27/2009 15:22'!
testSort
	| result tmp |
	result := self unsortedCollection sort.
	tmp := result at: 1.
	result do:
		[:each | self assert: each>=tmp. tmp:= each. ].! !

!TSortTest methodsFor: 'requirements' stamp: 'delaunay 5/11/2009 16:51'!
unsortedCollection
" retur a collection that is not yat sorted"
	^self explicitRequirement! !

!TSortable commentStamp: '<historical>'!
I represent a set of methods related to element sorting. 

My public api is composed of the messages:
        #sort, #isSorted, #isSortedBy:, and #sort: 

To get the behavior I define, my users should implement:
	#isEmpty, #size, #first, and #at: !
!TSortable methodsFor: 'sorting' stamp: 'MarcusDenker 3/5/2010 16:47'!
isSorted
	"Return true if the receiver is sorted by the given criterion.
	Optimization for isSortedBy: [:a :b | a <= b]."

	| lastElm elm |
	self isEmpty ifTrue: [^ true].
	lastElm := self first.
	2 to: self size do: 
		[:index | 
		elm := self at: index.
		lastElm <= elm ifFalse: [^ false].
		lastElm := elm].
	^ true! !

!TSortable methodsFor: 'sorting' stamp: 'LucFabresse 6/28/2013 10:36'!
sorted
	"Return a new sequenceable collection which contains the same elements as self but its 
elements are sorted in ascending order using the #'<=' operator."
	
	^self sorted: [ :a :b| a <= b ]! !

!TSortable methodsFor: 'sorting' stamp: 'jannik.laval 5/1/2010 16:34'!
mergeSortFrom: startIndex to: stopIndex by: aBlock
	"Sort the given range of indices using the mergesort algorithm.
	Mergesort is a worst-case O(N log N) sorting algorithm that usually
	does only half as many comparisons as heapsort or quicksort."

	"Details: recursively split the range to be sorted into two halves,
	mergesort each half, then merge the two halves together. An extra 
	copy of the data is used as temporary storage and successive merge 
	phases copy data back and forth between the receiver and this copy.
	The recursion is set up so that the final merge is performed into the
	receiver, resulting in the receiver being completely sorted."

	self size <= 1 ifTrue: [^ self].  "nothing to do"
	startIndex = stopIndex ifTrue: [^ self].
	[startIndex >= 1 and: [startIndex < stopIndex]] assert. "bad start index"
	[stopIndex <= self size] assert. "bad stop index"
	self
		mergeSortFrom: startIndex
		to: stopIndex 
		src: self copy 
		dst: self 
		by: aBlock! !

!TSortable methodsFor: 'sorting' stamp: 'MarcusDenker 3/5/2010 16:49'!
sort
	"Sort this collection into ascending order using the '<=' operator."

	self sort: [:a :b | a <= b]! !

!TSortable methodsFor: 'sorting' stamp: 'MarcusDenker 3/5/2010 16:48'!
isSortedBy: aBlock
	"Return true if the receiver is sorted by the given criterion."

	| lastElm elm |
	self isEmpty ifTrue: [^ true].
	lastElm := self first.
	2 to: self size do: 
		[:index | 
		elm := self at: index.
		(aBlock value: lastElm value: elm) ifFalse: [^ false].
		lastElm := elm].
	^ true! !

!TSortable methodsFor: 'sorting' stamp: 'MarcusDenker 3/5/2010 16:49'!
mergeSortFrom: first to: last src: src dst: dst by: aBlock
	"Private. Split the range to be sorted in half, sort each half, and 
	merge the two half-ranges into dst."

	| middle |
	first = last ifTrue: [^ self].
	middle := (first + last) // 2.
	self mergeSortFrom: first to: middle src: dst dst: src by: aBlock.
	self mergeSortFrom: middle + 1 to: last src: dst dst: src by: aBlock.
	src mergeFirst: first middle: middle last: last into: dst by: aBlock! !

!TSortable methodsFor: 'sorting' stamp: 'MarcusDenker 3/5/2010 16:49'!
sort: aSortBlock 
	"Sort this array using aSortBlock. The block should take two arguments
	and return true if the first element should preceed the second one."

	self
		mergeSortFrom: 1
		to: self size
		by: aSortBlock! !

!TSortable methodsFor: 'sorting' stamp: 'MarcusDenker 3/5/2010 16:48'!
mergeFirst: first middle: middle last: last into: dst by: aBlock
	"Private. Merge the sorted ranges [first..middle] and [middle+1..last] 
	of the receiver into the range [first..last] of dst."

	| i1 i2 val1 val2 out |
	i1 := first.
	i2 := middle + 1.
	val1 := self at: i1.
	val2 := self at: i2.
	out := first - 1.  "will be pre-incremented"

	"select 'lower' half of the elements based on comparator"
	[(i1 <= middle) and: [i2 <= last]] whileTrue:
		[(aBlock value: val1 value: val2)
			ifTrue: [dst at: (out := out + 1) put: val1.
					val1 := self at: (i1 := i1 + 1)]
			ifFalse: [dst at: (out := out + 1) put: val2.
					i2 := i2 + 1.
					i2 <= last ifTrue: [val2 := self at: i2]]].

	"copy the remaining elements"
	i1 <= middle
		ifTrue: [dst replaceFrom: out + 1 to: last with: self startingAt: i1]
		ifFalse: [dst replaceFrom: out + 1 to: last with: self startingAt: i2]! !

!TSortable methodsFor: 'sorting' stamp: 'DamienCassou 8/23/2013 10:22'!
sorted: aSortBlockOrNil
	"Return a new sequenceable collection which contains the same elements as self but its 
elements are sorted by aSortBlockOrNil. The block should take two arguments and return true if 
the first element should preceed the second one. If aSortBlock is nil then <= is used for 
comparison."
	
	^self copy sort: aSortBlockOrNil! !

!TStructuralEqualityTest commentStamp: 'stephane.ducasse 1/16/2009 19:08'!
Tests whether two objects are equals: they contain the same objects in the same order.!
!TStructuralEqualityTest methodsFor: 'test - equality' stamp: 'stephane.ducasse 1/16/2009 19:25'!
testEqualSignIsTrueForNonIdenticalButEqualCollections
	"self debug: #testEqualSignIsTrueForNonIdenticalButEqualCollections"
		
	self assert: (self empty = self empty copy). 
	self assert: (self empty copy = self empty).
	self assert: (self empty copy = self empty copy).
		
	self assert: (self nonEmpty = self nonEmpty copy). 
	self assert: (self nonEmpty copy = self nonEmpty).
	self assert: (self nonEmpty copy = self nonEmpty copy).! !

!TStructuralEqualityTest methodsFor: 'test - equality' stamp: 'stephane.ducasse 1/16/2009 19:25'!
testEqualSignOfIdenticalCollectionObjects
	"self debug: #testEqualSignOfIdenticalCollectionObjects"
	
	self assert: (self empty = self empty). 
	self assert: (self nonEmpty = self nonEmpty). 
	! !

!TStructuralEqualityTest methodsFor: 'test - equality' stamp: 'stephane.ducasse 1/19/2009 16:27'!
empty
	
	^ self explicitRequirement! !

!TStructuralEqualityTest methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0TStructuralEqualityTest
	self empty.
	self nonEmpty.
	self assert: self empty isEmpty.
	self deny: self nonEmpty isEmpty! !

!TStructuralEqualityTest methodsFor: 'test - equality' stamp: 'stephane.ducasse 1/19/2009 16:27'!
nonEmpty
	
	^ self explicitRequirement! !

!TStructuralEqualityTest methodsFor: 'test - equality' stamp: 'damiencassou 1/20/2009 14:02'!
testEqualSign
	"self debug: #testEqualSign"

	self deny: (self empty = self nonEmpty).! !

!TSubCollectionAccess commentStamp: 'TorstenBergmann 2/20/2014 15:35'!
A trait for test purposes!
!TSubCollectionAccess methodsFor: 'requirements' stamp: 'delaunay 4/27/2009 10:48'!
moreThan3Elements
	" return a collection including atLeast 3 elements"
	self explicitRequirement! !

!TSubCollectionAccess methodsFor: 'tests - subcollections access' stamp: 'delaunay 4/27/2009 10:48'!
testAllButLast
	"self debug: #testAllButLast"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButLast.
	self deny: abf last = col last.
	self assert: abf size + 1 = col size! !

!TSubCollectionAccess methodsFor: 'tests - subcollections access' stamp: 'delaunay 4/27/2009 10:48'!
testLastNElements
	"self debug: #testLastNElements"
	| result |
	result := self moreThan3Elements last: self moreThan3Elements size - 1.
	1 
		to: result size
		do: [ :i | self assert: (result at: i) = (self moreThan3Elements at: i + 1) ].
	self assert: result size = (self moreThan3Elements size - 1).
	self 
		should: [ self moreThan3Elements last: self moreThan3Elements size + 1 ]
		raise: Error! !

!TSubCollectionAccess methodsFor: 'tests - fixture' stamp: 'CamilloBruni 8/31/2013 20:43'!
test0FixtureSubcollectionAccessTest
	self moreThan3Elements.
	self assert: self moreThan3Elements size > 2! !

!TSubCollectionAccess methodsFor: 'tests - subcollections access' stamp: 'delaunay 4/27/2009 10:48'!
testAllButFirstNElements
	"self debug: #testAllButFirst"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButFirst: 2.
	1 
		to: abf size
		do: [ :i | self assert: (abf at: i) = (col at: i + 2) ].
	self assert: abf size + 2 = col size! !

!TSubCollectionAccess methodsFor: 'tests - subcollections access' stamp: 'delaunay 4/27/2009 10:48'!
testAllButFirst
	"self debug: #testAllButFirst"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButFirst.
	self deny: abf first = col first.
	self assert: abf size + 1 = col size! !

!TSubCollectionAccess methodsFor: 'tests - subcollections access' stamp: 'delaunay 4/27/2009 10:48'!
testAllButLastNElements
	"self debug: #testAllButFirst"
	| abf col |
	col := self moreThan3Elements.
	abf := col allButLast: 2.
	1 
		to: abf size
		do: [ :i | self assert: (abf at: i) = (col at: i) ].
	self assert: abf size + 2 = col size! !

!TSubCollectionAccess methodsFor: 'tests - subcollections access' stamp: 'delaunay 4/27/2009 10:48'!
testFirstNElements
	"self debug: #testFirstNElements"
	| result |
	result := self moreThan3Elements first: self moreThan3Elements size - 1.
	1 
		to: result size
		do: [ :i | self assert: (result at: i) = (self moreThan3Elements at: i) ].
	self assert: result size = (self moreThan3Elements size - 1).
	self 
		should: [ self moreThan3Elements first: self moreThan3Elements size + 1 ]
		raise: Error! !

!TTransformationCompatibility commentStamp: 'apb 8/22/2005 15:24'!
methods that make the user of this trait protocol-compatible with TraitTransformation.
When used in Trait and ClassTrait, this eliminates the need for TraitHolders.
!
!TTransformationCompatibility methodsFor: 'enquiries' stamp: 'apb 8/22/2005 15:36'!
allAliasesDict
	^IdentityDictionary new
! !

!TTransformationCompatibility methodsFor: 'enquiries' stamp: 'dvf 9/22/2005 18:15'!
subject
	"for compatibility with TraitTransformations"
	^ self
! !

!TTransformationCompatibility methodsFor: 'enquiries' stamp: 'apb 8/22/2005 15:36'!
trait
	"for compatibility with TraitTransformations"
	^ self
! !

!TTransformationCompatibility methodsFor: 'enquiries' stamp: 'apb 8/22/2005 15:35'!
aliasesForSelector: aSelector 
	^ OrderedCollection new
! !

!TTransformationCompatibility methodsFor: 'enquiries' stamp: 'mada 5/5/2012 11:40'!
collectMethodsFor: aSelector into: methodDescription
	(self includesSelector: aSelector) ifTrue: [ 
		methodDescription addLocatedMethod: 
			(self compiledMethodAt: aSelector)
		]! !

!TTransformationCompatibility methodsFor: 'enquiries' stamp: 'apb 8/22/2005 15:36'!
changedSelectorsComparedTo: aTraitTransformation
	| selectors otherSelectors changedSelectors aliases otherAliases |
	selectors := self allSelectors asIdentitySet.
	otherSelectors := aTraitTransformation allSelectors asIdentitySet.
	changedSelectors := IdentitySet withAll: (
		(selectors difference: otherSelectors) union: (otherSelectors difference: selectors)).
	aliases := self allAliasesDict.
	otherAliases := aTraitTransformation allAliasesDict.
	aliases keysAndValuesDo: [:key :value |
		(value ~~ (otherAliases at: key ifAbsent: [nil])) ifTrue: [changedSelectors add: key]].
	otherAliases keysAndValuesDo: [:key :value |
		(value ~~ (aliases at: key ifAbsent: [nil])) ifTrue: [changedSelectors add: key]].
	^ changedSelectors.
! !

!TTutorialTest commentStamp: 'TorstenBergmann 2/12/2014 22:49'!
Trait for testing tutorials!
!TTutorialTest methodsFor: 'tests' stamp: 'LaurentLaffont 2/1/2010 21:59'!
testLessonAtReturnsCorrespondingLesson
	| answer |
	1 to: (self testedTutorial tutorial size) do: [:index|
		answer := self testedTutorial lessonAt: index.
		self assert: (answer isKindOf: Lesson)
	]
	! !

!TTutorialTest methodsFor: 'requirements' stamp: 'LaurentLaffont 2/1/2010 22:04'!
testedTutorial
	"Returns an instance of an AbstractTutorial subclass"
	^ self explicitRequirement! !

!TTutorialTest methodsFor: 'tests' stamp: 'LaurentLaffont 2/1/2010 22:00'!
testNotEmpty
	self assert: self testedTutorial tutorial notEmpty.! !

!TTutorialTest methodsFor: 'tests' stamp: 'LaurentLaffont 2/1/2010 21:59'!
testEachSelectorReturnsALesson
	| answer |
	self testedTutorial tutorial do: [:aSelector|
		answer := (self testedTutorial perform: aSelector).
		self assert: (answer isKindOf: Lesson).
	]! !

!TTutorialTest methodsFor: 'tests' stamp: 'LaurentLaffont 2/1/2010 21:57'!
testEachSelectorExists
	self testedTutorial tutorial do: [:aSelector|
		self assert: (self tutorial respondsTo: aSelector) 
	]! !

!TTutorialTest methodsFor: 'tests' stamp: 'LaurentLaffont 2/1/2010 22:00'!
testSizeReturnsNumberOfSelectors
	self assert: (self testedTutorial tutorial size) equals: self testedTutorial size.! !

!TTwo commentStamp: 'MartinDias 1/31/2014 15:50'!
I am a trait used for testing.!
!TTwo methodsFor: 'as yet unclassified' stamp: 'MartinDias 8/1/2012 00:11'!
two
	^ 2! !

!Trait1 methodsFor: 'trait1 - c' stamp: 'stephane.ducasse 10/7/2008 15:26'!
c1

	^ 'Trait1>>c1'! !

!Trait1 methodsFor: 'trait1 - c' stamp: 'stephane.ducasse 10/6/2008 21:25'!
c

	^ 'Trait1>>c'! !

!Trait2 methodsFor: 'trait2 - c' stamp: 'stephane.ducasse 10/6/2008 22:35'!
c

	^ 'Trait2>>c'! !

!Trait2 methodsFor: 'trait2 - c' stamp: 'stephane.ducasse 10/7/2008 15:26'!
c2

	^ 'Trait2>>c2'! !

!Trait3 methodsFor: 'local' stamp: 'stephane.ducasse 10/7/2008 16:32'!
c3

	^ 'Trait3>>c3'! !

!Trait3 methodsFor: 'local' stamp: 'stephane.ducasse 10/7/2008 16:31'!
c

	^ 'Trait3>>c'! !

!Trait3 methodsFor: 'trait2 - c' stamp: ''!
c2

	^ 'Trait2>>c2'! !